commit 2d8d0cd44b87c724acbca9f835c2142778007da9
Author: jjgarcia <jjgarcia>
Date:   Tue Jun 26 17:14:44 2001 +0000

    Initial revision

diff --git a/Copyright b/Copyright
new file mode 100644
index 000000000..dc590ec98
--- /dev/null
+++ b/Copyright
@@ -0,0 +1,69 @@
+
+_______________________________________________________________________________
+
+  Copyright (c) 2000, Juan Jose Garcia Ripoll
+  Copyright (c) 1990, 1991, 1993 Giuseppe Attardi
+  Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
+	      All Rights Reserved
+_______________________________________________________________________________
+
+Summary:
+
+  Permission is granted to use, copy, modify this program,
+  EXCEPT that the copyright notice must be reproduced on copies, and
+  credit should be given to the authors where it is due.
+  WE MAKE NO WARRANTY AND ACCEPT NO LIABILITY FOR THIS PROGRAM.
+
+
+In detail:
+
+  1. Permission to use, copy, modify this software and its documentation
+     for any purpose is hereby granted without fee, provided that
+     - the above copyright notice appears in all copies,
+     - both that copyright notice and this permission notice appears in
+       supporting documentation, and that
+     - you cause modified files to carry prominent notices stating that
+       you changed the files and the date of any change.
+
+  2. Please notify us if you are going to sell this software or its
+     documentation for profit.
+
+  3. WE DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL
+     IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
+     WE BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+     ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+     WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+     ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+     SOFTWARE.
+
+
+Additionally:
+
+  ECLS is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published
+  by the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version; see file 'Copying'.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+Address:
+
+  Juan Jose Garcia Ripoll
+  Univ. de Castilla-La Mancha
+  E.T.S.I. Industriales
+  Departamento de Matematicas
+  c/Camilo Jose Cela, 3
+  Ciudad Real, E-13071
+  Spain
+
+
+Address for reporting bugs, comments, suggestions:
+
+  jjgarcia@ind-cr.uclm.es
diff --git a/LGPL b/LGPL
new file mode 100644
index 000000000..eb685a5ec
--- /dev/null
+++ b/LGPL
@@ -0,0 +1,481 @@
+		  GNU LIBRARY GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1991 Free Software Foundation, Inc.
+                    675 Mass Ave, Cambridge, MA 02139, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the library GPL.  It is
+ numbered 2 because it goes with version 2 of the ordinary GPL.]
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Library General Public License, applies to some
+specially designated Free Software Foundation software, and to any
+other libraries whose authors decide to use it.  You can use it for
+your libraries, 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 library, or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link a program with the library, you must provide
+complete object files to the recipients so that they can relink them
+with the library, after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  Our method of protecting your rights has two steps: (1) copyright
+the library, and (2) offer you this license which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  Also, for each distributor's protection, we want to make certain
+that everyone understands that there is no warranty for this free
+library.  If the library is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original
+version, 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 companies distributing free
+software will individually obtain patent licenses, thus in effect
+transforming the program into proprietary software.  To prevent this,
+we have made it clear that any patent must be licensed for everyone's
+free use or not licensed at all.
+
+  Most GNU software, including some libraries, is covered by the ordinary
+GNU General Public License, which was designed for utility programs.  This
+license, the GNU Library General Public License, applies to certain
+designated libraries.  This license is quite different from the ordinary
+one; be sure to read it in full, and don't assume that anything in it is
+the same as in the ordinary license.
+
+  The reason we have a separate public license for some libraries is that
+they blur the distinction we usually make between modifying or adding to a
+program and simply using it.  Linking a program with a library, without
+changing the library, is in some sense simply using the library, and is
+analogous to running a utility program or application program.  However, in
+a textual and legal sense, the linked executable is a combined work, a
+derivative of the original library, and the ordinary General Public License
+treats it as such.
+
+  Because of this blurred distinction, using the ordinary General
+Public License for libraries did not effectively promote software
+sharing, because most developers did not use the libraries.  We
+concluded that weaker conditions might promote sharing better.
+
+  However, unrestricted linking of non-free programs would deprive the
+users of those programs of all benefit from the free status of the
+libraries themselves.  This Library General Public License is intended to
+permit developers of non-free programs to use free libraries, while
+preserving your freedom as a user of such programs to change the free
+libraries that are incorporated in them.  (We have not seen how to achieve
+this as regards changes in header files, but we have achieved it as regards
+changes in the actual functions of the Library.)  The hope is that this
+will lead to faster development of free libraries.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, while the latter only
+works together with the library.
+
+  Note that it is possible for a library to be covered by the ordinary
+General Public License rather than by this special one.
+
+		  GNU LIBRARY GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library which
+contains a notice placed by the copyright holder or other authorized
+party saying it may be distributed under the terms of this Library
+General Public License (also called "this License").  Each licensee is
+addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+  
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+  6. As an exception to the Sections above, you may also compile or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    c) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    d) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the 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.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded.  In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Library General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+			    NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+     Appendix: How to Apply These Terms to Your New Libraries
+
+  If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change.  You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+  To apply these terms, attach the following notices to the library.  It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the library's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Library General Public License for more details.
+
+    You should have received a copy of the GNU Library General Public
+    License along with this library; if not, write to the Free
+    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
+That's all there is to it!
diff --git a/Makefile b/Makefile
new file mode 100644
index 000000000..092306d6e
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,166 @@
+# Generated automatically from Makefile.in by configure.
+# DIST: This is the distribution Makefile for ECL.  configure can
+# DIST: make most of the changes to this file you might want, so try
+# DIST: that first.
+
+# make all	to compile and build Emacs.
+# make install	to install it.
+# make TAGS	to update tags tables.
+#
+# make clean  or  make mostlyclean
+#      Delete all files from the current directory that are normally
+#      created by building the program.	 Don't delete the files that
+#      record the configuration.  Also preserve files that could be made
+#      by building, but normally aren't because the distribution comes
+#      with them.
+#
+#      Delete `.dvi' files here if they are not part of the distribution.
+# 
+# make distclean
+#      Delete all files from the current directory that are created by
+#      configuring or building the program.  If you have unpacked the
+#      source and built the program without creating any other files,
+#      `make distclean' should leave only the files that were in the
+#      distribution.
+# 
+# make realclean
+#      Delete everything from the current directory that can be
+#      reconstructed with this Makefile.  This typically includes
+#      everything deleted by distclean.
+
+SHELL = /bin/sh
+MAKE = make  # BSD doesn't have it as a default.
+MACHINE = freebsd
+
+# ========================= Last release ================================
+
+VERSION=0.2
+WWW=http://ecls.sourceforge.net/
+
+# ==================== Things `configure' Might Edit ====================
+
+CC=gcc
+CPP=gcc -E
+LN_S=ln -s
+CFLAGS=-g -O2
+
+#  Where to find the source code.
+#  This is set by the configure script's `--srcdir' option.
+srcdir=/home/jjgarcia/ecl/src
+
+bindir=/home/jjgarcia/bin
+infodir=/home/jjgarcia/info
+mandir=/home/jjgarcia/man/man1
+libdir=/home/jjgarcia/lib/ecls
+
+#  What to release
+TAR_CONTENTS=Makefile.in Copy* README.1st README.orig doc \
+	configure site.lsp src/c src/cmp src/crs src/clos src/lsp src/doc \
+	src/h src/etc src/gmp src/config* src/install.sh src/Makefile.in \
+	src/util contrib/ src/clx src/tk src/gc src/*.in src/gabriel
+
+# ==================== Utility Programs for the Build ====================
+
+#  Allow the user to specify the install program.
+INSTALL = /usr/bin/install -c
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL} -m 644
+
+# ============================= Build ==============================
+
+all: build/Makefile
+	cd build; $(MAKE)
+.PHONY:	all
+
+Makefile: Makefile.in build/config.status
+	(cd build; ./config.status)
+
+# ==================== Installation ====================
+
+install: build/Makefile
+	(cd build; make install)
+uninstall:
+	(cd build; make uninstall)
+
+# ==================== Documentation ====================
+
+info:
+	(cd ${srcdir}/doc; $(MAKE) info)
+dvi:
+	(cd ${srcdir}/doc; $(MAKE) dvi)
+
+# ==================== Cleaning up and miscellanea ====================
+
+#   `clean'
+#        Delete all files from the current directory that are normally
+#        created by building the program.  Don't delete the files that
+#        record the configuration.  Also preserve files that could be made
+#        by building, but normally aren't because the distribution comes
+#        with them.
+#   
+clean:
+	cd build; $(MAKE) clean
+
+#   `distclean'
+#        Delete all files from the current directory that are created by
+#        configuring or building the program.  If you have unpacked the
+#        source and built the program without creating any other files,
+#        `make distclean' should leave only the files that were in the
+#        distribution.
+
+distclean: clean
+	rm -fr build/config.status
+	rm -f Makefile
+
+#   `realclean'
+#        Delete everything from the current directory that can be
+#        reconstructed with this Makefile.
+#        One exception, however: `make realclean' should not delete
+#        `configure' even if `configure' can be remade using a rule in the
+#        Makefile.  More generally, `make realclean' should not delete
+#        anything that needs to exist in order to run `configure' and then
+#        begin to build the program.
+realclean: distclean
+
+TAGS tags:
+	(cd ${srcdir}/src; \
+	 etags c/*.[cd] h/*.h)
+
+check:
+	@echo "We don't have any tests for ECL yet."
+
+TAR_DIR=ecls-$(VERSION)
+
+doc: build/doc/index.html
+	-mkdir doc
+	cp build/doc/*.html doc
+build/doc/index.html:
+	cd build/doc; make
+
+source-dist: ecls.tgz ecls-tests.tgz
+
+ecls.tgz: doc
+	-rm -rf $(TAR_DIR)
+	mkdir $(TAR_DIR) $(TAR_DIR)/src && \
+	for i in $(TAR_CONTENTS); do cp -rf $$i $(TAR_DIR)/$$i; done && \
+	tar -cz --exclude '*~' --exclude '#*' --exclude 'CVS' -f ecls.tgz $(TAR_DIR)
+	-rm -rf $(TAR_DIR)
+ecls-tests.tgz:
+	-rm -rf $(TAR_DIR)
+	mkdir $(TAR_DIR) && \
+	mkdir $(TAR_DIR)/src && \
+	cp -rf src/ansi-tests $(TAR_DIR)/src && \
+	tar -cz --exclude '*~' --exclude '#*' --exclude 'CVS' -f ecls-tests.tgz $(TAR_DIR);
+	-rm -rf $(TAR_DIR)
+
+binary-dist: all
+	su -c "rm -rf tmp"
+	mkdir tmp
+	for i in $(bindir) $(infodir) $(mandir) $(libdir); do \
+	(echo $$i; IFS="/"; for k in tmp/$$i; do echo $$k; (test -d $$k || mkdir $$k); chmod 755 $$k; cd $$k; done); \
+	done
+	PREFIX=`pwd`/tmp; cd build; make install PREFIX="$${PREFIX}"
+	su -c "chown -R root.root tmp && cd tmp; tar czf ../ecls-$(VERSION)-$(MACHINE).tgz * && cd .. && rm -rf tmp"
+
+dist:
+	cd dist; make-dist
diff --git a/Makefile.in b/Makefile.in
new file mode 100644
index 000000000..e9306307c
--- /dev/null
+++ b/Makefile.in
@@ -0,0 +1,165 @@
+# DIST: This is the distribution Makefile for ECL.  configure can
+# DIST: make most of the changes to this file you might want, so try
+# DIST: that first.
+
+# make all	to compile and build Emacs.
+# make install	to install it.
+# make TAGS	to update tags tables.
+#
+# make clean  or  make mostlyclean
+#      Delete all files from the current directory that are normally
+#      created by building the program.	 Don't delete the files that
+#      record the configuration.  Also preserve files that could be made
+#      by building, but normally aren't because the distribution comes
+#      with them.
+#
+#      Delete `.dvi' files here if they are not part of the distribution.
+# 
+# make distclean
+#      Delete all files from the current directory that are created by
+#      configuring or building the program.  If you have unpacked the
+#      source and built the program without creating any other files,
+#      `make distclean' should leave only the files that were in the
+#      distribution.
+# 
+# make realclean
+#      Delete everything from the current directory that can be
+#      reconstructed with this Makefile.  This typically includes
+#      everything deleted by distclean.
+
+SHELL = /bin/sh
+MAKE = make  # BSD doesn't have it as a default.
+MACHINE = @MACHINE@
+
+# ========================= Last release ================================
+
+VERSION=@ECLS_VERSION@
+WWW=http://ecls.sourceforge.net/
+
+# ==================== Things `configure' Might Edit ====================
+
+CC=@CC@
+CPP=@CPP@
+LN_S=@LN_S@
+CFLAGS=@CFLAGS@
+
+#  Where to find the source code.
+#  This is set by the configure script's `--srcdir' option.
+srcdir=@srcdir@
+
+bindir=@bindir@
+infodir=@infodir@
+mandir=@mandir@
+libdir=@libdir@
+
+#  What to release
+TAR_CONTENTS=Makefile.in Copy* README.1st README.orig doc \
+	configure site.lsp src/c src/cmp src/crs src/clos src/lsp src/doc \
+	src/h src/etc src/gmp src/config* src/install.sh src/Makefile.in \
+	src/util contrib/ src/clx src/tk src/gc src/*.in src/gabriel
+
+# ==================== Utility Programs for the Build ====================
+
+#  Allow the user to specify the install program.
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+# ============================= Build ==============================
+
+all: build/Makefile
+	cd build; $(MAKE)
+.PHONY:	all
+
+Makefile: Makefile.in build/config.status
+	(cd build; ./config.status)
+
+# ==================== Installation ====================
+
+install: build/Makefile
+	(cd build; make install)
+uninstall:
+	(cd build; make uninstall)
+
+# ==================== Documentation ====================
+
+info:
+	(cd ${srcdir}/doc; $(MAKE) info)
+dvi:
+	(cd ${srcdir}/doc; $(MAKE) dvi)
+
+# ==================== Cleaning up and miscellanea ====================
+
+#   `clean'
+#        Delete all files from the current directory that are normally
+#        created by building the program.  Don't delete the files that
+#        record the configuration.  Also preserve files that could be made
+#        by building, but normally aren't because the distribution comes
+#        with them.
+#   
+clean:
+	cd build; $(MAKE) clean
+
+#   `distclean'
+#        Delete all files from the current directory that are created by
+#        configuring or building the program.  If you have unpacked the
+#        source and built the program without creating any other files,
+#        `make distclean' should leave only the files that were in the
+#        distribution.
+
+distclean: clean
+	rm -fr build/config.status
+	rm -f Makefile
+
+#   `realclean'
+#        Delete everything from the current directory that can be
+#        reconstructed with this Makefile.
+#        One exception, however: `make realclean' should not delete
+#        `configure' even if `configure' can be remade using a rule in the
+#        Makefile.  More generally, `make realclean' should not delete
+#        anything that needs to exist in order to run `configure' and then
+#        begin to build the program.
+realclean: distclean
+
+TAGS tags:
+	(cd ${srcdir}/src; \
+	 etags c/*.[cd] h/*.h)
+
+check:
+	@echo "We don't have any tests for ECL yet."
+
+TAR_DIR=ecls-$(VERSION)
+
+doc: build/doc/index.html
+	-mkdir doc
+	cp build/doc/*.html doc
+build/doc/index.html:
+	cd build/doc; make
+
+source-dist: ecls.tgz ecls-tests.tgz
+
+ecls.tgz: doc
+	-rm -rf $(TAR_DIR)
+	mkdir $(TAR_DIR) $(TAR_DIR)/src && \
+	for i in $(TAR_CONTENTS); do cp -rf $$i $(TAR_DIR)/$$i; done && \
+	tar -cz --exclude '*~' --exclude '#*' --exclude 'CVS' -f ecls.tgz $(TAR_DIR)
+	-rm -rf $(TAR_DIR)
+ecls-tests.tgz:
+	-rm -rf $(TAR_DIR)
+	mkdir $(TAR_DIR) && \
+	mkdir $(TAR_DIR)/src && \
+	cp -rf src/ansi-tests $(TAR_DIR)/src && \
+	tar -cz --exclude '*~' --exclude '#*' --exclude 'CVS' -f ecls-tests.tgz $(TAR_DIR);
+	-rm -rf $(TAR_DIR)
+
+binary-dist: all
+	su -c "rm -rf tmp"
+	mkdir tmp
+	for i in $(bindir) $(infodir) $(mandir) $(libdir); do \
+	(echo $$i; IFS="/"; for k in tmp/$$i; do echo $$k; (test -d $$k || mkdir $$k); chmod 755 $$k; cd $$k; done); \
+	done
+	PREFIX=`pwd`/tmp; cd build; make install PREFIX="$${PREFIX}"
+	su -c "chown -R root.root tmp && cd tmp; tar czf ../ecls-$(VERSION)-$(MACHINE).tgz * && cd .. && rm -rf tmp"
+
+dist:
+	cd dist; make-dist
diff --git a/README.1st b/README.1st
new file mode 100644
index 000000000..8c3629d38
--- /dev/null
+++ b/README.1st
@@ -0,0 +1 @@
+You can find the preprocessed documentation in ./doc in HTML format.
diff --git a/configure b/configure
new file mode 100755
index 000000000..c2b656b5f
--- /dev/null
+++ b/configure
@@ -0,0 +1,20 @@
+#!/bin/sh
+#
+# This is just a driver for configure, the real configure is in src.
+# This script identifies the machine, and creates a directory for
+# the installation, where it runs ${srcdir}/configure.
+
+srcdir=`pwd`/src
+buildir=build
+
+if [ ! -d ${buildir} ] ; then
+   echo Creating directory "\`${buildir}'"
+   mkdir ${buildir}
+fi
+
+# Now run the real configure script
+echo Switching to directory "\`${buildir}'" to continue configuration.
+cd ${buildir}
+${srcdir}/configure --srcdir=${srcdir} $*
+
+echo Configuration complete. To build ECL, issue 'make' in this directory.
diff --git a/contrib/logical-pathnames.ecl b/contrib/logical-pathnames.ecl
new file mode 100644
index 000000000..dbc028eb3
--- /dev/null
+++ b/contrib/logical-pathnames.ecl
@@ -0,0 +1,1951 @@
+;;; -*- Mode: LISP; Package: LOGICAL-PATHNAME; Syntax: Common-lisp;  -*- 
+;;; Tue Apr  9 19:17:01 1991 by Mark Kantrowitz <mkant@LION.OZ.CS.CMU.EDU>
+;;; logical-pathnames.lisp
+
+;;; ****************************************************************
+;;; Logical Pathnames System ***************************************
+;;; ****************************************************************
+;;;
+;;; Logical Pathnames provide a facility for referring to pathnames
+;;; in a portable manner. Logical pathnames are mapped to physical
+;;; pathnames by a set of implementation dependent and site-dependent
+;;; rules. 
+;;; 
+;;; This system is a Common Lisp portable implementation of logical
+;;; pathnames. It fulfills most of the X3J13 June 1989 specification
+;;; for logical pathnames, as documented in Guy Steele's "Common Lisp:
+;;; The Language" (2nd Edition), section 23.1.5 "Logical Pathnames".
+;;;
+;;; Written by Mark Kantrowitz, July 1990.
+;;;
+;;; Address: Carnegie Mellon University
+;;;          School of Computer Science
+;;;          Pittsburgh, PA 15213
+;;;
+;;; This code is in the public domain and is distributed without warranty
+;;; of any kind. 
+;;;
+;;; Use and copying of this software and preparation of derivative works
+;;; based upon this software are permitted, so long as the following
+;;; conditions are met:
+;;;      o no fees or compensation are charged for use, copies, or
+;;;        access to this software
+;;;      o this copyright notice is included intact.
+;;; This software is made available AS IS, and no warranty is made about 
+;;; the software or its performance. 
+;;;
+;;; Please send bug reports, comments and suggestions to mkant@cs.cmu.edu. 
+;;;
+;;;
+;;; Logical Pathnames are especially useful when coupled with a portable
+;;; system construction tool, such as the Defsystem facility written
+;;; by Mark Kantrowitz.
+;;;
+
+;;; ********************************
+;;; Change Log *********************
+;;; ********************************
+;;;
+;;; djc  = Daniel J. Clancy <clancy@cs.utexas.edu>
+;;;
+;;; 30-JUL-90  mk    Fixed logical pathnames for VAX-LISP (thanks to
+;;;                  Paul Werkowski). In VAX-LISP simple strings are not
+;;;                  sub-types of simple-vectors, so svref doesn't work
+;;;                  on strings. These calls have been fixed to read
+;;;                  #+:cmu svref #-:cmu aref.
+;;; 15-NOV-90  mk    Changed convert-file-function to better handle optional 
+;;;                  args. This should fix the problem of (ed) and (dribble)
+;;;                  returning errors like "argument NIL must be a number"
+;;;                  in parse-namestring. Note that some lisps seem to make
+;;;                  a distinction between (funcall #'foo) and (foo) with
+;;;                  respect to this error.
+;;; 29-JAN-91  mk    Defined LISP:NTH-VALUE if not already present (it is
+;;;                  a CLtL2 addition) and used it in LOAD-PHYSICAL-HOSTAB
+;;;                  to avoid needing a GARBAGE variable in 
+;;;                  (multiple-value-setq (garbage pos) ...) which we can
+;;;                  not declare ignore and yet causes a compiler warning
+;;;                  since we don't use it.
+;;; 29-JAN-91  mk    lisp::file-name is particular to CMU Common Lisp
+;;;                  and the #+:cmu's were accidentally left off.
+;;; 29-JAN-91  mk    Added :explorer physical namestring output to 
+;;;                  PHYSICAL-NAMESTRING.                
+;;; 29-JAN-91  mk    Warns about name collisions between physical and logical
+;;;                  host names.
+;;; 30-JAN-91  mk    Added :logical-pathnames-mk to the *features* list.
+;;; 25-FEB-91  mk    Added definition of LOAD-LOGICAL-PATHNAME-TRANSLATIONS.
+;;; 09-APR-91  mk    Export pathname-host-type, append-logical-directories.
+;;; 09-APR-91  mk    Translation rules now support :case :unchanged.
+;;; 09-APR-91  djc   Fixed so that (logical-pathname "") returns a 
+;;;                  logical-pathname structure.
+;;; 21-FEB-96  attardi
+;;;		     Added support for ECL
+
+;;; ********************************
+;;; To Do **************************
+;;; ********************************
+;;;
+;;; Support for Macintosh pathnames. Little tricky, since MACL uses a
+;;; colon (:) as the delimiter.
+;;;    
+;;; support for tops-20/tenex, multics, its, ms-dos
+;;; add host-type to pathnames
+;;; merge-pathnames, with-open-file 
+;;;
+;;; Define generic pathname parsing/printing definition interface.
+;;;
+;;; Redefine with-open-file?
+;;;
+;;; Port to emacs-lisp for gnu-emacs?
+;;;
+;;; Logical pathnames needs to case both on the physical host type and on
+;;; lisp type (e.g., for canonicalization). Fix this, and define lots of
+;;; canonical types. Dependency on lisp type can probably be handled using
+;;; #+ and #-. What about conflicts between canonicalization and the
+;;; translations (e.g., "L" vs :lisp)?
+;;;
+
+;;; ********************************
+;;; Notes **************************
+;;; ********************************
+;;;
+;;;    LOGICAL-PATHNAMES has been tested (successfully) in the following lisps:
+;;;       CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
+;;;       Macintosh Allegro Common Lisp (1.3.2)
+;;;       ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 3/30/90)
+;;;       Lucid CL (Version 2.1 6-DEC-87)
+;;;       Symbolics Common Lisp (8.0)
+;;;       Lucid Common Lisp (3.0, 4.0)
+;;;       VAXLisp (2.0, 3.1)
+;;;	  ECL (ECoLisp) Version(0.23)
+;;;
+;;;    LOGICAL-PATHNAMES needs to be tested in the following lisps:
+;;;       KCL (June 3, 1987 or later)
+;;;       AKCL (1.86, June 30, 1987 or later)
+;;;       TI (Release 4.1 or later)
+;;;       Ibuki Common Lisp (01/01, October 15, 1987)
+;;;       Golden Common Lisp (3.1 IBM-PC)
+;;;       HP Common Lisp (same as Lucid?)
+;;;       Procyon Common Lisp
+
+
+;;; ********************************
+;;; Documentation ******************
+;;; ********************************
+;;; 
+;;; Logical pathnames allow large programs to be moved between sites
+;;; by separating pathname reference from actual file location. The
+;;; program will refer to files using logical pathnames. At each site,
+;;; a user will specify a set of "translations" which map from the logical
+;;; pathnames to the physical pathnames used on the device.
+;;;
+;;; Logical pathnames provide a uniform convention for filesystem access,
+;;; with the following properties:
+;;;  1.  Pathname Portability: The program specifies a pathname in
+;;;      a conventional format (logical pathnames), which may be
+;;;      mapped reasonably literally (via the translations) to
+;;;      a variety of filesystems.
+;;;  2.  Pathname Aliasing: The files may exist in different locations
+;;;      in the various filesystems. For example, the root directory
+;;;      might change. The translations allow such a change easily.
+;;;  3.  Cross-host Access: The files need not all exist on the same
+;;;      physical host. 
+;;;
+;;; This definition of logical pathnames provides support for physical
+;;; pathnames for Unix, VMS/VAX, Symbolics, and TI Explorers, and is
+;;; easily extended to handle additional platforms. Code which may need
+;;; customization for particular Lisps and platforms has been commented
+;;; with three ampersands (&&&). In addition, the user probably should
+;;; define their own canonical types, translation rules, and
+;;; logical-pathname-translations. Examples are provided.
+;;;
+;;; Logical pathnames employ the following syntax:
+;;;     [host:] [;] {directory ;}* [name] [. type [. version]]
+;;; host      ::= word
+;;; directory ::= word | wildcard-word | wildcard-inferiors
+;;; name      ::= word | wildcard-word
+;;; type      ::= word | wildcard-word
+;;; version   ::= word | wildcard-word
+;;; word      ::= {letter | digit | -}*
+;;; wildcard-word ::= [word] * {word *}* [word]
+;;; wildcard-inferiors ::= **
+;;;
+;;; A wildcard-word of * parses as :wild; all others as strings. These
+;;; definitions may be extended (e.g., "newest" parsing as :newest) by
+;;; defining new canonical types.
+;;;
+;;; Incompatibilities with the X3J13 specification:
+;;;    -  LOGICAL-PATHNAME is not defined as a subclass of PATHNAME
+;;;       since we have no guarrantee about the format of PATHNAME
+;;;       (i.e., is it a defstruct or a class definition, what are
+;;;       its slots, etc.). Many Lisps will be able to replace the
+;;;       definition of PHYSICAL-PATHNAME with their definition of
+;;;       PATHNAME by doing a string-replace of "physical-pathname"
+;;;       with "pathname" and deleting some definitions from this file.
+;;;    -  CLtL does not specify the manner in which wildcards are
+;;;       translated. We use reversible wildcard pathname translation,
+;;;       similar to that used in the Symbolics logical pathnames.
+;;;    -  COMPILE-FILE-PATHNAME has not been defined, since it is
+;;;       highly implementation dependent.
+
+;;; ********************************
+;;; Examples ***********************
+;;; ********************************
+;;;
+;;; The following examples of the use of logical pathnames are taken
+;;; from Section 23.1.5.4 of Guy Steele CLtL 2nd Ed.
+
+#|
+(setf (lp:physical-host-type "MY-LISPM") :symbolics)
+(setf (lp:logical-pathname-translations "foo")
+      '(("**;*.*.*" "MY-LISPM:>library>foo>**>")))
+
+<cl> (lp:translate-logical-pathname "foo:bar;baz;mum.quux.3" :namestring)
+"MY-LISPM:>library>foo>bar>baz>mum.quux.3"
+
+(setf (lp:physical-host-type "U") :unix)
+(setf (lp:physical-host-type "V") :vms)
+(setf (lp:logical-pathname-translations "prog")
+      '(("RELEASED;*.*.*"    "U:/sys/bin/my-prog/")
+	("RELEASED;*;*.*.*"  "U:/sys/bin/my-prog/*/")
+	("EXPERIMENTAL;*.*.*" "U:/usr/Joe/development/prog/")
+	("EXPERIMENTAL;DOCUMENTATION;*.*.*" "V:SYS$DISK:[JOE.DOC]")
+	("EXPERIMENTAL;*;*.*.*" "U:/usr/Joe/development/prog/*/")
+	("MAIL;**;*.MAIL"       "V:SYS$DISK:[JOE.MAIL.PROG...]*.MBX")))
+
+<cl> (lp:translate-logical-pathname "prog:mail;save;ideas.mail.3" :namestring)
+"V:SYS$DISK:[JOE.MAIL.PROG.SAVE]IDEAS.MBX.3"
+<cl> (lp:translate-logical-pathname "prog:experimental;spreadsheet.c" :namestring)
+"U:/usr/Joe/development/prog/spreadsheet.c"
+
+(setf (lp:logical-pathname-translations "prog")
+      '(("CODE;*.*.*"    "/lib/prog/")))
+<cl> (lp:translate-logical-pathname "prog:code;documentation.lisp" :namestring)
+"/lib/prog/documentation.lisp"
+
+(setf (lp:logical-pathname-translations "prog")
+      '(("CODE;DOCUMENTATION.*.*"    "/lib/prog/docum.*")
+	("CODE;*.*.*"    "/lib/prog/")))
+<cl> (lp:translate-logical-pathname "prog:code;documentation.lisp" :namestring)
+"/lib/prog/docum.lisp"
+
+
+(setf (lp:logical-pathname-translations "prog")
+      `(("**;*.LISP.*"  ,(lp:logical-pathname "PROG:**;*.L.*"))
+	("**;*.FASL.*"  ,(lp:logical-pathname "PROG:**;*.B.*"))
+	("CODE;DOCUMENTATION.*.*" "/lib/prog/documentatio.*")
+	("CODE;*.*.*"             "/lib/prog/")))
+<cl> (lp:translate-logical-pathname "prog:code;documentation.lisp" :namestring)
+"/lib/prog/documentatio.l"
+
+|#
+
+;;; ****************************************************************
+;;; Logical Pathnames **********************************************
+;;; ****************************************************************
+;;; Putting this in a separate package doesn't prevent collisions
+;;; with the LISP package, since this package :uses the LISP
+;;; package.
+(in-package "LOGICAL-PATHNAME" :nicknames '("LP"))
+
+(export '(logical-pathname 
+	  translate-logical-pathname 
+	  logical-pathname-translations
+	  pathname-host-type
+	  append-logical-directories
+	  make-logical-pathname
+	  physical-host-type
+	  load-logical-pathname-translations
+	  load-physical-hostab
+	  define-translation-rule
+	  define-canonical))
+
+(pushnew :logical-pathnames-mk *features*)
+
+;;; ********************************
+;;; Global Variables ***************
+;;; ********************************
+(defvar *null-vector* (coerce nil 'simple-vector))
+
+(defvar *warn-about-host-type-collisions* t
+  "Warn user when a logical host type definition collides with a physical 
+   host type definition.")
+
+;;; ********************************
+;;; Primitives *********************
+;;; ********************************
+(defun parse-with-string-delimiter (delim string &key (start 0) end)
+  "Returns up to three values: the string up to the delimiter DELIM
+   in STRING (or NIL if the field is empty), the position of the beginning
+   of the rest of the string after the delimiter, and a value which, if
+   non-NIL (:delim-not-found), specifies that the delimiter was not found."
+  (declare (simple-string string))
+  ;; Conceivably, if DELIM is a string consisting of a single character,
+  ;; we could do this more efficiently using POSITION instead of SEARCH.
+  ;; However, any good implementation of SEARCH should optimize for that
+  ;; case, so nothing to worry about.
+  (setq end (or end (length string)))
+  (let ((delim-pos (search delim string :start2 start :end2 end))
+	(dlength (length delim)))
+    (cond ((null delim-pos)		
+	   ;; No delimiter was found. Return the rest of the string,
+	   ;; the end of the string, and :delim-not-found.
+	   (values (subseq string start end) end :delim-not-found))
+	  ((= delim-pos start)		
+	   ;; The field was empty, so return nil and skip over the delimiter.
+	   (values nil (+ start dlength)))
+	  ;; The following clause is subsumed by the last cond clause,
+	  ;; and hence should probably be eliminated.
+;	  ((= delim-pos (- end dlength))
+;	   ;; The delimiter is at the end of the string, so return the
+;	   ;; field and skip to the end.
+;	   (values (subseq string start delim-pos)
+;		   end))
+	  (t				
+	   ;; The delimiter is in the middle of the string. Return the
+	   ;; field and skip over the delimiter. 
+	   (values (subseq string start delim-pos)
+		   (+ delim-pos dlength))))))
+
+(defun parse-with-string-delimiter* (delim string &key (start 0) end
+					   include-last)
+  "Breaks STRING into a list of strings, each of which was separated
+   from the previous by DELIM. If INCLUDE-LAST is nil (the default),
+   will not include the last string if it wasn't followed by DELIM
+   (i.e., \"foo,bar,\" vs \"foo,bar\"). Otherwise includes it even if
+   not terminated by DELIM. Also returns the final position in the string."
+  (declare (simple-string string))
+  (setq end (or end (length string)))
+  (let (result)
+    (loop
+     (if (< start end)
+	 (multiple-value-bind (component new-start delim-not-found)
+	     (parse-with-string-delimiter delim string :start start :end end)
+	   (when delim-not-found 
+	     (when include-last
+	       (setq start new-start)
+	       (push component result))
+	     (return))
+	   (setq start new-start)
+	   (push component result))
+	 (return)))
+    (values (nreverse result) 
+	    start)))
+
+(defun get-host-string (string &optional (host-delimiter ":") (start 0) end)
+  "Strips the host name off the front of the string."
+  (setq end (or end (length string)))
+  (multiple-value-bind (host pos delim-not-found)
+      (parse-with-string-delimiter host-delimiter string :start start :end end)
+    (if delim-not-found
+	(values nil start)
+	(values host pos))))
+
+(defun parallel-substitute (alist string)
+  "Makes substitutions for characters in STRING according to the ALIST. 
+   In effect, PARALLEL-SUBSTITUTE can perform several SUBSTITUTE
+   operations simultaneously."
+  (declare (simple-string string))
+  ;; This function should be generalized to arbitrary sequences and
+  ;; have an arglist (alist sequence &key from-end (test #'eql) test-not
+  ;; (start 0) (count most-positive-fixnum) end key).
+  (if alist
+      (let* ((length (length string))
+	     (result (make-string length)))
+	(declare (simple-string result))
+	(dotimes (i length)
+	  (let ((old-char (schar string i)))
+	    (setf (schar result i)
+		  (or (second (assoc old-char alist :test #'char=))
+		      old-char))))
+	result)
+      string))
+
+(defun name-substitution (alist string)
+  "Replaces STRING by it's replacement in ALIST, if present."
+  (let ((new-string (second (assoc string alist :test #'string-equal))))
+    (or new-string string)))
+
+(unless (fboundp 'lisp::nth-value)
+  ;; NTH-VALUE is a CLtL2 addition, so not every lisp has it yet.
+  ;; This definition conses a lot, so we shouldn't use it in time-critical
+  ;; situations. It is fine for load-physical-hostab which is the only
+  ;; place we use it.
+  (defmacro lisp::nth-value (n form)
+    "Returns the nth value of the values returned by form."
+    `(nth ,n (multiple-value-list ,form)))
+  (export 'lisp::nth-value "LISP"))
+
+;;; ********************************
+;;; Logical Host Tables ************
+;;; ********************************
+(defvar *logical-pathname-translations-table* (make-hash-table :test #'equal))
+(defun canonicalize-logical-hostname (host)
+  (string-upcase host))
+(defun LOGICAL-PATHNAME-TRANSLATIONS (host)
+  "If HOST is the host component of a logical pathname and has been defined
+   as a logical pathname host name by SETF of LOGICAL-PATHNAME-TRANSLATIONS,
+   this function returns the list of translations for the specified HOST.
+   Each translation is a list of at least two elements, a from-wildname
+   and a to-wildname. The former is a logical pathname whose host is the
+   specified HOST. (I.e., the host of the from-pathname need not be 
+   explicitly specified.) The latter is any pathname. If to-wildname coerces to
+   a logical pathname, TRANSLATE-LOGICAL-PATHNAME will retranslate the
+   result, repeatedly if necessary. Translations are listed in
+   the order listed, so more specific from-wildnames must precede more
+   general ones."
+  ;; would be nice to have host:: specify logical host if physical host
+  ;; already exists, to distinguish from host:
+  (gethash (canonicalize-logical-hostname host)
+	   *logical-pathname-translations-table*))
+(defsetf logical-pathname-translations (host) (translations)
+  "(setf (logical-pathname-translations host) translations) sets the list
+   of translations for the logical pathname host to translations. If host
+   is a string that has not previously been used as a logical pathname
+   host, a new logical pathname host is defined; otherwise an existing
+   host's translations are replaced. Logical pathname host names are
+   compared with string-equal."
+  `(progn
+     (when (and *warn-about-host-type-collisions*
+		(physical-host-type ,host))
+       (format t "~&Warning in (SETF LOGICAL-PATHNAME-TRANSLATIONS):~
+                  ~&   ~S is defined as both a physical host and a logical host."
+	     ,host))
+     (setf (gethash (canonicalize-logical-hostname ,host)
+		    *logical-pathname-translations-table*)
+	   (eval-translations ,translations))))
+
+;;;  EVAL-TRANSLATIONS
+;;
+;;;   Will receive a list of translations and it will evaluate the physical
+;;;   translation if it is not a string.  This allows the user to put a format
+;;;   statement as the physical-translation.
+
+(defun eval-translations (translations)
+  (let (new_trans)
+    (nreverse
+     (dolist (translation translations new_trans)
+       (if (stringp (cadr translation))
+	   (setf new_trans (cons translation new_trans))
+	 (setf new_trans (cons (list (car translation) (eval (cadr translation))) new_trans)))))))
+
+;;; ********************************
+;;; Load Logical Translations ******
+;;; ********************************
+(defvar *logical-translations-directory* nil ; &&&
+  "Directory where logical pathname translations are stored.")
+;;; (setq *logical-translations-directory* "/usr/local/lisp/Registry/")
+
+(defun LOAD-LOGICAL-PATHNAME-TRANSLATIONS (host)
+  "Loads the logical pathname translations for host named HOST if the logical 
+   pathname translations are not already defined. First checks for a file
+   with the same name as the host (lowercase) and type \"translations\" in
+   the current directory, then the translations directory. If it finds such
+   a file it loads it and returns T, otherwise it signals an error."
+  (unless (logical-pathname-translations host)
+    (let* ((trans-fname (concatenate 'string (string-downcase host)
+				     ".translations"))
+	   (pathname (when *logical-translations-directory*
+		       (merge-pathnames *logical-translations-directory*
+					trans-fname))))
+      (cond ((probe-file trans-fname)
+	     (load trans-fname)
+	     t)
+	    ((and *logical-translations-directory*
+		  (probe-file pathname))
+	     (load pathname)
+	     t)
+	    (t
+	     (error "Logical pathname translations for host ~A not found."
+		    host))))))
+
+;;; ********************************
+;;; Physical Host Tables ***********
+;;; ********************************
+(defvar *physical-host-table* (make-hash-table :test #'equal)
+  "Table of physical hosts and system types for those hosts. 
+   Valid (implemented) types include :vms, :explorer, :symbolics, :unix.")
+(defun physical-host-type (host)
+  (gethash host *physical-host-table*))
+(defsetf physical-host-type (host) (type)
+  `(progn
+     (when (and *warn-about-host-type-collisions*
+		(logical-pathname-translations ,host))
+       (format t "~&Warning in (SETF PHYSICAL-HOST-TYPE):~
+                  ~&   ~S is defined as both a physical host and a logical host."
+	       ,host))
+     (setf (gethash ,host *physical-host-table*)
+	   ,type)))
+
+(defconstant local-host-table		; &&&
+  #+:vms "chaos$root:[host.tables]nethosts.txt"
+  #-:vms "nethosts.txt")
+
+(defun load-physical-hostab (&optional (local-hostab local-host-table))
+  "Loads the physical host namespace table. This is compatible with
+   vms and symbolics host tables. Hostab line format should look
+   something like:
+      HOST NAME,CHAOS-#,STATUS,SYSTEM-TYPE,MACHINE-TYPE,NICKNAMES
+   NAME and SYSTEM-TYPE are required; all others are optional (but delimiting
+   commas are still required). SYSTEM-TYPE specifies the operating system
+   run on the host. This information is used to figure out how to parse
+   pathnames for the host. Common values are: LISP, LISPM, UNIX, MACH,
+   VMS, and EXPLORER."
+  ;; What about SITE, SHORT-NAME, USER-PROPERTY, ADDRESS, PRETTY-NAME, 
+  ;; and other Symbolics host attributes?
+  (when local-hostab
+    (with-open-file (hostab local-hostab :direction :input)
+      (do* ((host (read hostab nil :eof)(read hostab nil :eof))
+	    ;; host should be NET or HOST.
+	    (line (read-line hostab nil :eof)(read-line hostab nil :eof)))
+	  ;; Exit on end of file.
+	  ((or (eq host :eof)(eq line :eof)))
+	;; For each line in the host table, do
+	(cond ((null line)
+	       (warn "Unexpected EOF in hostab ~S, exiting." local-hostab)
+	       (return))
+	      ((string-equal (symbol-name host) "HOST")
+	       ;; Delete spaces and tabs.
+	       (setq line (delete #\tab (delete #\space line)))
+	       (let ((pos 0) name system machine nicknames delim-not-found)
+		 ;; Snarf the machine NAME.
+		 (multiple-value-setq (name pos)
+		     (parse-with-string-delimiter "," line :start pos))
+		 ;; Throw away chaos host numbers.
+		 (setq pos
+		       (nth-value 1 (parse-with-string-delimiter 
+				     (if (char-equal #\( (char line pos))
+					 ")," ",")
+				     line :start pos)))
+		 ;; Throw away status.
+		 (setq pos
+		       (nth-value 1 (parse-with-string-delimiter "," line
+								 :start pos)))
+		 ;; Snarf the system and machine types.
+		 (multiple-value-setq (system pos)
+		     (parse-with-string-delimiter "," line :start pos))
+		 (multiple-value-setq (machine pos delim-not-found)
+		     (parse-with-string-delimiter "," line :start pos))
+		 (when (and (not delim-not-found)
+			    (> (length line) pos))
+		   ;; Snarf the nicknames.
+		   (setq nicknames
+			 (parse-with-string-delimiter* 
+			  ","
+			  (parse-with-string-delimiter "]" line 
+						       :start (1+ pos)))))
+		 (unless (or (equal "" system) (null system))
+		   (when (equal "LISP" system) (setq system machine))
+		   (setq system (intern system 'keyword))
+		   (case system
+		     ;; :vms, :ms-dos, etc are left alone.
+		     ((:mach :unix :unix42) (setq system :unix))
+		     ((:lisp :lispm) (setq system :symbolics))
+		     ((:appaloosa :explorer) (setq system :explorer)))
+		   (setf (physical-host-type name) system)
+		   (dolist (name nicknames)
+		     (setf (physical-host-type name) system))))))))))
+
+(defun host-type (host)
+  "Returns the type of the host. If HOST is a defined logical pathname
+   host (i.e., it has translations), returns :logical. Otherwise checks
+   the physical type of the host. If HOST is NIL, uses the type of the
+   default physical host (the one lisp is running in)."
+  ;; Note that logical hosts have priority over physical hosts...
+  ;; This is a bad situation, since we don't have any way of 
+  ;; distinguishing between host names that are both logical and physical.
+  ;; CLtL2 relies on the convention of naming them differently, but
+  ;; collisions are going to occur. It would be better to have some
+  ;; way of distinguishing the two in a pathname's printed representation.
+  (cond ((multiple-value-bind (ignore present)
+	     (logical-pathname-translations host)
+	   ;; Yet another use for nth-value.
+	   (declare (ignore ignore))
+	   present)
+	 :logical)
+	((physical-host-type host))))
+
+(defun pathname-host-type (pathname)
+  (cond ((typep pathname 'logical-pathname) :logical)
+	((typep pathname 'pathname)
+	 (host-type (pathname-host pathname)))
+	((stringp pathname) (host-type (get-host-string pathname ":")))))
+
+;;; Setup Default Physical Host
+(eval-when (load eval)  ; &&&
+(setf (physical-host-type nil)		; nil is default host
+      (or #+:vms        :vms
+	  #+:explorer   :explorer
+	  #+:symbolics  :symbolics
+	  #+:unix       :unix
+	  #+:hp         :unix
+	  #+:cmu        :unix
+	  :unix				; default. change if necessary
+	  ))
+(setf (physical-host-type "Default")
+      (physical-host-type nil))
+)
+
+;;; ********************************
+;;; Translation Rules **************
+;;; ********************************
+(defstruct translation-rule
+  host-type
+  case					; Default case of pathname
+  char-mappings				; Character substitutions 
+  component-mappings			; String substitutions
+  version-case				; Case for version component
+  type-case				; Case for type component
+  name-case				; Case for name
+  component-case			; Case for directory names
+  )
+
+(defvar *permanent-translation-rules* (make-hash-table :test #'equal)
+  "Hash table of default translation rules for each type of host.")
+
+(defvar *default-translation-rule* (make-translation-rule))
+
+(defmacro define-translation-rule (host-type 
+				   &key case char-mappings component-mappings
+				   version-case
+				   type-case
+				   name-case
+				   component-case)
+  "Defines translation rules for hosts of type host-type.
+   Case may be :unchanged, :upper, :lower, or :capitalize. This provides a
+   default case translation; version-case, type-case, name-case, and
+   component-case will shadow this value if non-nil.
+   Char-mappings is a list of character substitutions which occur in parallel.
+   Component-mappings is a list of string substitutions."
+  ;; Note: Currently there is only one rule per host-type.
+  `(setf (gethash ,host-type *permanent-translation-rules*)
+	 (make-translation-rule :host-type ',host-type 
+				:case ',case
+				:char-mappings ',char-mappings
+				:component-mappings ',component-mappings
+				:version-case ',version-case
+				:type-case ',type-case
+				:name-case ',name-case
+				:component-case ',component-case)))
+
+(defun find-translation-rule (host-type)
+  (or (gethash host-type *permanent-translation-rules*)
+      *default-translation-rule*))
+
+(defun choose-case (rule level)
+  (or (case level
+	(version (translation-rule-version-case rule))
+	(type (translation-rule-type-case rule))
+	(name (translation-rule-name-case rule))
+	(component (translation-rule-component-case rule)))
+      (translation-rule-case rule)))
+
+(defun casify (thing case)
+  (if (stringp thing)
+    (case case
+      (:upper (string-upcase thing))
+      (:lower (string-downcase thing))
+      (:capitalize (string-capitalize thing))
+      (:unchanged thing)
+      (otherwise thing))
+    thing))
+
+(define-translation-rule :vms
+  :case :upper :char-mappings ((#\- #\_)))
+
+(define-translation-rule :unix
+  :case :unchanged ; :lower
+  :type-case :lower
+  )
+
+(define-translation-rule :logical
+  :case :upper
+  :name-case :unchanged)
+
+;;; ********************************
+;;; Canonical Types ****************
+;;; ********************************
+(defvar *default-canonical-types* (make-hash-table :test #'equal)
+  "Alists of canonical types and default surface types.")
+(defvar *canonical-types-alist* (make-hash-table :test #'equal)
+  "Alists of canonical types and surface types for various hosts.")
+
+(defmacro define-canonical (level canonical default  &body specs)
+  "Defines a new canonical type. Level specifies whether it is a 
+   canonical type, version, name, or component. Default is a string
+   containing the default surface type for any kind of host not
+   mentioned explicitly. The body contains a list of specs that define
+   the surface types that indicate the new canonical type for each host.
+   For systems with more than one possible default surface form,
+   the form that appears first becomes the preferred form for the type."
+  `(progn
+     (setf (gethash ',level *default-canonical-types*)
+	   (cons (list ',canonical ',default)
+		 (remove ',canonical 
+			 (gethash ',level *default-canonical-types*)
+			 :key #'car)))
+;     (push (list ',canonical ',default) 
+;	   (gethash ',level *default-canonical-types*))
+     (setf (gethash ',level *canonical-types-alist*)
+	   (cons (list* ',canonical ',specs)
+		 (remove ',canonical 
+			 (gethash ',level *canonical-types-alist*)
+			 :key #'car)))
+;     (push (list* ',canonical ',specs) 
+;	   (gethash ',level *canonical-types-alist*))
+     ))
+
+(defun member-or-eq (x list-or-atom)
+  (cond ((listp list-or-atom) (member x list-or-atom))
+	(t (eq x list-or-atom))))
+
+(defun surface-form (canonical host-type &optional (level 'type))
+  "Given the canonical form of some canonical type, replaces it with
+   the appropriate surface form."
+  (let ((case (choose-case (find-translation-rule host-type) level)))
+    (casify (or (second (assoc host-type
+			       (cdr (assoc canonical
+					   (gethash level 
+						    *canonical-types-alist*)
+					   :test #'equal))
+			       :test #'member-or-eq))
+		(second (assoc canonical
+			       (gethash level *default-canonical-types*)
+			       :test #'equal))
+		canonical)
+	    case)))
+
+(defun canonicalize (surface-form host-type &optional (level 'type))
+  "Given the surface form of some canonical type, replaces it with
+   the appropriate canonical type."
+  (cond ((stringp surface-form)
+	 (or (first (find surface-form (gethash level *canonical-types-alist*)
+			  :key #'cdr
+			  :test #'(lambda (surf alist)
+				    (member surf
+					    (cdr (assoc host-type alist 
+							:test #'member-or-eq))
+					    :test #'string-equal))))
+	     (first (find surface-form 
+			  (gethash level *default-canonical-types*) 
+			  :key #'second :test #'string-equal))
+	     (coerce surface-form 'simple-string)))
+	(t surface-form)))
+
+
+;;; *** Some Sample Types ***
+
+(define-canonical host :default ""
+  (:unix #+:CMU "Mach" "" "Default"))
+
+(define-canonical host "Default" ""
+  (:unix nil "" "Default"))
+
+(define-canonical device :unspecific "")
+
+(define-canonical component :absolute ""
+  (:unix "/")
+  (:symbolics ">")
+  (:logical   "")
+  (:vms       ""))
+(define-canonical component :relative ""
+  (:unix "")
+  (:symbolics "")
+  (:logical   ";")
+  (:vms       "."))
+(define-canonical component :wild "*")
+(define-canonical component :wild-inferiors "**"
+  (:vms ".."))
+
+(define-canonical name :wild "*")
+
+(define-canonical type :unspecific "") ;; null type
+(define-canonical type :wild "*")      ;; wild type
+
+;; uncommented the "L" causes the last Steele example to break, of course.
+(define-canonical type :lisp "LISP" 
+  (:unix-ucb "LISP")
+  (:unix #+(and :sun :kcl :unix) "lsp"
+	 #+ecl "lsp"
+	 "lisp" ; "L" #+:excl "cl"
+)
+  (:vms "LSP" "LISP")
+  ;; (:vms4 "LSP" "LISP")
+  ((:tops-20 :tenex) "LISP" "LSP"))
+
+(define-canonical type :text "TEXT" 
+  (:unix "text" "txt" "tx")
+  (:vms "TXT")
+  ((:tops-20 :tenex) "TXT"))
+
+(define-canonical type :fasl "FASL" 
+  (:unix #+:hp "b"
+	 #+(and :sun :kcl :unix) "o"
+	 #+ecl "o"
+	 #+:cmu "fasl"
+	 "fasl" "bin" "BN")
+  (:vms "FAS" "BIN")
+  (:explorer "XLD")
+  (:symbolics "BIN")
+  ((:tops-20 :tenex) "BIN"))
+
+(define-canonical version :wild "*")
+(define-canonical version :newest "newest")
+
+#|
+;;; Examples:
+<cl> (lp::canonicalize "*" :unix)
+:WILD
+<cl> (lp::surface-form :fasl :unix)
+"fasl"
+<cl> (lp::surface-form :fasl :vms)
+"FAS"
+|#
+
+
+;;; ********************************
+;;; Pathname Defstruct *************
+;;; ********************************
+;;;
+;;; We define a generic physical pathname (physical-pathname defstruct) because
+;;; we have absolutely NO guarrantees about the structure of pathnames.
+;;; Pathnames may be defstructs or classes, and the slots may have arbitrary
+;;; types, especially with respect to the directory slot. Depending on the
+;;; lisp, the directory slot may be a list, vector, simple-vector,
+;;; string, keyword, or nil. If a list or vector, the items in the list
+;;; may be strings, keywords (for canonical types), or nil. The first item
+;;; in the list may or may not be a special keyword (e.g., :relative and
+;;; :absolute). 
+;;;
+;;; The lack of a common interface to pathnames means that any implementation
+;;; of logical pathnames must parse and generate the pathname (namestring)
+;;; formats for a variety of file-servers. We can't simply rely on the
+;;; lisp's implementation of the PATHNAME defstruct, because that does not
+;;; necessarily handle the formats of file-servers of a different type 
+;;; (translations may be in the format of the target file server). Also,
+;;; inconsistency in the implementation of the PATHNAME type means that we
+;;; would have to special case most of the code for each and every lisp.
+;;;
+;;; Instead, we parse the pathnames into a common format (the physical-pathname
+;;; defstruct), from which we generate a namestring in a format acceptable
+;;; to the underlying lisp. The namestring (which is a string in *all* the
+;;; lisps) serves as the interface to the lisp's implementation of pathnames.
+;;;
+;;; As it currently stands, X3J13's spec for logical pathnames tries to 
+;;; accomplish two distinct goals:
+;;;    (1) isolate pathname reference from actual file location (logical
+;;;        as opposed to physical pathnames) 
+;;;    (2) provide a common format for namestring syntax and 
+;;;        pathname structure
+;;; This is trying to accomplish too much within a single framework. Instead,
+;;; the second goal should be decoupled from logical pathnames and made a 
+;;; requirement for pathnames in general. 
+;;;
+;;; In other words, let there be a standard namestring syntax and a fully
+;;; specified structure for physical pathnames (not just logical pathnames).
+;;; This standard should subsume the requirements of all current lisps, and
+;;; the individual lisp implementation should worry about interfacing with
+;;; the file system. There is no good reason why a programmer should have
+;;; to know the peculiarities of a filesystem when writing software. The X3J13
+;;; spec just shoves it under the rug, forcing the programmer to deal with
+;;; it when writing the translations file. 
+;;;
+;;; Because there is no standard for pathnames, we're forced into a situation
+;;; where different lisps running on the same physical host may have
+;;; different namestring syntaxes, so knowing the physical host type is not
+;;; a guarrantee of the pathname syntax. 
+;;;
+(defstruct (physical-pathname
+	    (:conc-name %physical-pathname-)
+	    (:predicate physical-pathnamep))	     
+  "Physical-Pathname is the underlying structure for a pathname."
+  (host nil :type (or null keyword simple-string))
+  (device nil :type (or null keyword simple-string))
+  (directory nil :type (or null simple-vector))
+  (name nil :type (or null keyword simple-string))
+  (type nil :type (or null keyword simple-string))
+  version)
+
+(defun ensure-pathname (thing)
+  (if (pathnamep thing) thing (pathname thing)))
+
+;;; ********************************
+;;; Logical Pathname Defstruct *****
+;;; ********************************
+(defstruct (logical-pathname
+	    (:include physical-pathname)
+	    (:conc-name %logical-pathname-)
+	    (:print-function %print-logical-pathname)
+	    (:constructor %make-logical-pathname 
+			  (host device directory name type version))
+	    (:predicate logical-pathnamep))	     
+  "Logical-pathname is the underlying structure for a logical pathname.")
+
+(defun %print-logical-pathname (pname stream depth)
+  (declare (ignore depth))
+  (format stream "#.(logical-pathname ~S)" (logical-namestring pname)))
+
+(defun make-logical-pathname (&key host directory name type version)
+  (let ((host-type (host-type host)))
+    (when (stringp directory)
+      (setq directory 
+	    (%logical-pathname-directory (parse-generic-namestring directory
+								   host))))
+    (%make-logical-pathname 
+     (canonicalize host host-type 'host)
+     :unspecific
+     directory
+     (canonicalize name host-type 'name)
+     (canonicalize type host-type 'type)
+     (canonicalize version host-type 'version)
+     )))
+
+(defun ensure-logical-pathname (thing)
+  (if (logical-pathnamep thing) thing (logical-pathname thing)))
+
+;;; The following cannot be done by the accessors because the pathname
+;;; arg may be a string.
+
+(defun logical-pathname-host (logical-pathname)
+  "Returns the logical-pathname-host of LOGICAL-PATHNAME. 
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-host (ensure-logical-pathname logical-pathname)))
+
+(defun logical-pathname-directory (logical-pathname)
+  "Returns the logical-pathname-directory of LOGICAL-PATHNAME.
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-directory (ensure-logical-pathname logical-pathname)))
+
+(defun logical-pathname-name (logical-pathname)
+  "Returns the logical-pathname-name of LOGICAL-PATHNAME. 
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-name (ensure-logical-pathname logical-pathname)))
+
+(defun logical-pathname-type (logical-pathname)
+  "Returns the logical-pathname-type of LOGICAL-PATHNAME. 
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-type (ensure-logical-pathname logical-pathname)))
+
+(defun logical-pathname-version (logical-pathname)
+  "Returns the logical-pathname-type of LOGICAL-PATHNAME. 
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-version (ensure-logical-pathname logical-pathname)))
+
+
+;;; ********************************
+;;; Pathname Namestring Functions **
+;;; ********************************
+(defun logical-namestring (logical-pathname)
+  "Returns the full form of LOGICAL-PATHNAME as a string."
+  (setq logical-pathname (logical-pathname logical-pathname))
+  (let ((host      (%logical-pathname-host logical-pathname))
+	(directory (%logical-pathname-directory logical-pathname))
+	(name      (%logical-pathname-name logical-pathname))
+	(type      (%logical-pathname-type logical-pathname))
+	(version   (%logical-pathname-version logical-pathname))
+	result)
+    (declare (simple-string result))
+    ;; FORMAT would have been easier, but this is faster.
+    (when host
+      (setq result 
+	    (concatenate 'simple-string 
+			 (surface-form host :logical 'host) ":")))
+    (when directory
+      (setq result
+	    (concatenate 'simple-string 
+			 result
+			 (the simple-string (%directory-string directory)))))
+    (when name
+      (setq result
+	    (concatenate 'simple-string
+			 result
+			 (the simple-string (surface-form name :logical 'name)))))
+    (when type
+      (setq result
+	    (concatenate 'simple-string
+			 result "."
+			 (the simple-string (surface-form type :logical 'type)))))
+    (when version
+      (setq result
+	    (concatenate 'simple-string
+			 result "."
+			 (the simple-string
+			      (%version-to-string version)))))
+    result))
+
+(defun %directory-string (dirlist &optional (host-type :logical)
+				  (dir-delim #\;))
+  "Converts a vector of the form #(\"foo\" \"bar\" ... \"baz\") into
+   a string of the form \"foo;bar;...;baz;\""
+  (declare (simple-vector dirlist))
+  (let* ((numdirs (length dirlist))
+	 (length numdirs))
+    (declare (fixnum numdirs length))
+    (dotimes (i numdirs)
+      (let ((component (#+:cmu svref #-:cmu aref dirlist i)))
+	(case component
+	  ;; Do we have to worry about Lucid's :root here???
+	  ((:relative :absolute) 
+	   (incf length
+		 (the fixnum
+		      (1- (length (surface-form component
+						host-type 'component))))))
+	  (otherwise (incf length
+			   (the fixnum
+				(length (surface-form component host-type
+						      'component))))))))
+    (do ((result (make-string length))
+	 (index 0 (1+ index))
+	 (position 0))
+	((= index numdirs) result)
+      (declare (simple-string result))
+      (let* ((component (#+:cmu svref #-:cmu aref dirlist index))
+	     (string (surface-form component host-type 'component))
+	     (len (length string))
+	     (end (+ position len)))
+	(declare (simple-string string)
+		 (fixnum len end))
+	(replace result string :start1 position :end1 end :end2 len)
+	(unless (or (eq component :absolute)(eq component :relative))
+	  (setf (schar result end) dir-delim)
+	  (setq position (+ end 1)))))))
+
+(defun %version-to-string (version &optional (host-type :logical))
+  (cond ((surface-form version host-type 'version))
+	((zerop version) "0")
+	((eql version 1) "1")
+	(t
+	 ;; Using FORMAT would have been easier, but this is faster.
+	 (do* ((len (1+ (truncate (log version 10)))) ; base 10 num digits
+	       (res (make-string len))
+	       (i (1- len) (1- i))
+	       (q version) ; quotient
+	       (r)) ; residue
+	     ((zerop q) ; nothing left
+	      res)
+	   (declare (simple-string res)
+		    (fixnum len i r))
+	   (multiple-value-setq (q r) (truncate q 10))
+	   (setf (schar res i) (schar "0123456789" r))))))
+
+(defun physical-namestring (pathname)
+  ;; needs to get appropriate surface forms
+  (setq pathname (pathname pathname))
+  (let* ((host (%physical-pathname-host pathname))
+	 (host-type (host-type host))
+	(device    (%physical-pathname-device pathname))
+	(directory (coerce (%pathname-directory pathname) 'list))
+	(name      (%physical-pathname-name pathname))
+	(type      (%physical-pathname-type pathname))
+	(version   (%physical-pathname-version pathname))
+	(ptype (pathname-host-type pathname)))
+    (setq host (surface-form host host-type 'host)
+	  name (surface-form name host-type 'name)
+	  type (surface-form type host-type 'type)
+	  version (surface-form version host-type 'version))
+    ;; Does directory need to be mapcar'ed into surface-form?
+    ;; Yes, but we can probably ignore it for now, since the only
+    ;; canonical types defined so far are :wild and :wild-inferiors,
+    ;; which we don't have to support. Probably wouldn't hurt to
+    ;; uncomment this code.
+    ;;(setq directory 
+    ;;      (cons (car directory)
+    ;;            (mapcar #'(lambda (comp)
+    ;;			    (surface-form comp host-type 'component)) 
+    ;;			(cdr directory))))
+    (case ptype
+      (:logical
+       (logical-namestring pathname))
+      (:unix
+       (format nil "~@[~A:~]~A~{~A/~}~@[~A~@[.~A~@[.~A~]~]~]"
+	       host (case (car directory)
+		      (:absolute "/")
+		      (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      (:vms       
+       ;; was "~@[~A:~]~@[~A:~][~A~{~A.~}]~@[~A~@[.~A~@[.~A~]~]~]"
+       ;; which was adding an extra "." to path
+       ;; such as [a.b] => [a.b.]
+       (format nil 
+	       "~@[~A:~]~@[~A:~][~A~{~A~^.~}]~@[~A~@[.~A~@[.~A~]~]~]"
+	       host device (case (car directory)
+			     (:relative ".")
+			     (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      (:explorer
+       (format nil "~@[~A:~]~A~{~A~^.~};~@[~A~@[.~A~@[#~A~]~]~]"
+	       host (case (car directory)
+		      (:relative ".")
+		      (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      (:symbolics
+       (format nil "~@[~A:~]~A~{~A>~}~@[~A~@[.~A~@[.~A~]~]~]"
+	       host (case (car directory)
+		      (:absolute ">")
+		      (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      (otherwise
+       ;; Use UNIX as default.
+       (format nil "~@[~A:~]~A~{~A/~}~@[~A~@[.~A~@[.~A~]~]~]"
+	       host (case (car directory)
+		      (:absolute "/")
+		      (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      )))
+
+;;; ********************************
+;;; Pathname Parsing Functions *****
+;;; ********************************
+(defun logical-pathname (thing &optional host)
+  "Converts THING to a logical pathname and returns it. THING may be
+   a logical pathname, a logical pathname namestring containing a 
+   host component, or a stream for which the pathname function returns
+   a logical pathname."
+  (etypecase thing
+    (string
+     (values (parse-generic-namestring thing host
+				       *default-pathname-defaults* 
+				       :force-logical t)))
+    (pathname thing)
+    (logical-pathname thing)
+    #+:CMU(stream           (logical-pathname (lisp::file-name thing) host))))
+
+(defun physical-pathname (thing &optional host)
+  "Converts THING to a physical-pathname and returns it. THING may be
+   a pathname, a pathname namestring containing a 
+   host component, or a stream for which the file-name function returns
+   a pathname."
+  (typecase thing
+    (string           (values (parse-generic-namestring thing host)))
+    (logical-pathname thing)
+    (physical-pathname thing)
+    #+:CMU(stream           (physical-pathname (lisp::file-name thing) host))))
+
+(defun parse-generic-namestring (thing &optional host
+				       (defaults *default-pathname-defaults*)
+				       &key (start 0) end junk-allowed
+				       force-logical)
+  "Convert namestring into a pathname."
+  (declare (ignore junk-allowed))
+  (unless end (setf end (length thing)))
+  (let ((host-string (get-host-string thing ":"))
+	host-type)
+    (unless host-string (setq host-string host))
+    (when (and host host-string (not (string-equal host host-string)))
+      (cerror "Ignore it."
+	      "Host mismatch in ~S: ~S isn't ~S"
+	      'parse-generic-namestring
+	      host-string
+	      host))
+    (if force-logical
+	(setq host-type :logical)
+      (setq host-type (host-type host-string)))
+    (if host-type
+	(multiple-value-bind (parsed-host device directory name type version)
+	    (do-generic-pathname-parse thing host-type start end)
+	  (let ((defaults-p (and (typep defaults 'pathname)
+				 (equal host-type
+					(pathname-host-type defaults)))))
+	    (values
+	     (case host-type
+	       (:logical
+		(make-logical-pathname 
+		 :host	(or parsed-host host
+			    (and defaults-p (logical-pathname-host defaults))
+;			    (when directory "Default")
+			    )
+		 :directory (or directory
+				(and defaults-p
+				     (logical-pathname-directory defaults)))
+		 :name      (or name
+				(and defaults-p
+				     (logical-pathname-name defaults)))
+		 :type      (or type
+				(and defaults-p
+				     (logical-pathname-type defaults)))
+		 :version   (or version
+				(and defaults-p
+				     (logical-pathname-version defaults)))))
+	       (otherwise 
+		(make-pathname 
+		 :host	(or parsed-host host
+			    (and defaults-p (pathname-host defaults))
+;			    (when directory "Default")
+			    )
+		 :device    (or device
+				(and defaults-p
+				     (pathname-device defaults)))
+		 :directory (or directory
+				(and defaults-p
+				     (pathname-directory defaults)))
+		 :name      (or name
+				(and defaults-p
+				     (pathname-name defaults)))
+		 :type      (or type
+				(and defaults-p
+				     (pathname-type defaults)))
+		 :version   (or version
+				(and defaults-p
+				     (pathname-version defaults))))))
+	     end)))
+	;; Unknown host type, wing it with parse-namestring.
+      (when thing
+	(lisp:parse-namestring thing host defaults 
+			       :start start :end end)))))
+
+;;; ********************************
+;;; Parse Physical Pathnames *******
+;;; ********************************
+(defun do-generic-pathname-parse (string host-type &optional (start 0) end)
+  "Splits string into a logical host, a vector of directories, a file name,
+   a file type, and a file version."
+  (declare (simple-string string))
+  (case host-type
+    (:logical
+     ;; Parses Logical Pathnames of the following format:
+     ;;     host:dir1;dir2;name.type.version
+     (parse-generic-pathname string start end ":" nil ";" "." "." "."))
+    (:unix
+     ;; Parses Unix pathnames of the following format:
+     ;;     host:/dir1/dir2/*/name.type.version 
+     (parse-generic-pathname string start end ":" t "/" "." "." "."))
+    (:symbolics 
+     ;; Parses Symbolics Pathnames of the following format:
+     ;;     host:>dir1>dir2>**>name.type.version
+     (parse-generic-pathname string start end ":" t ">" "." "." "."))
+    (:vms       (parse-vms-pathname string start end))
+    (:explorer  (parse-explorer-pathname string start end))
+    (otherwise  (warn "~&PARSE-~A-PATHNAME not yet implemented.~%" host-type)
+		nil)))
+
+(defun parse-generic-pathname (string &optional (start 0) end
+				      (host-delim ":")(lead-is-abs t)
+				      (dir-delim "/")
+				      (name-delim ".")(type-delim ".")
+				      (version-delim "."))
+  "Splits string into a host, vector of directories, a file name, type,
+   and version. Parses generic pathnames."
+  (declare (simple-string string))
+  (setq end (or end (length string)))
+  (let (host a-vs-r directories name type version host-type)
+    (multiple-value-setq (host start)
+	(get-host-string string host-delim start end))
+    (setq host-type (host-type host))
+    ;; Absolute vs. Relative
+    (cond ((and (not (string-equal string "" :start1 start))
+		(char= (char dir-delim 0) (char string start))) 
+	   (setq a-vs-r (if lead-is-abs :absolute :relative))
+	   (incf start))
+	  (t (setq a-vs-r (if lead-is-abs :relative :absolute))))
+    ;; Split off the components
+    (multiple-value-bind (dirs new-start)
+	(parse-with-string-delimiter* dir-delim string :start start :end end)
+      (setq directories
+	    (cons a-vs-r 
+		  (mapcar #'(lambda (dir)
+			      (canonicalize dir host-type 'component))
+			  dirs))
+	    start new-start))
+    ;; Split off the name, type, and version
+    (when (< start end)
+      (multiple-value-setq (name start)
+	  (parse-with-string-delimiter name-delim string
+				       :start start :end end))
+      (when (< start end)
+	(multiple-value-setq (type start)
+	    (parse-with-string-delimiter type-delim string
+					 :start start :end end))
+	(when (< start end)
+	  (multiple-value-setq (version start)
+	      (parse-with-string-delimiter version-delim string
+					   :start start :end end)))))
+    ;; Return the values
+    (values host
+	    :unspecific
+	    (when (or host directories)
+	      (coerce directories 'vector))
+	    name
+	    type
+	    version
+	    ;; This last is the remaining cruft. Should be nil.
+	    (when (< start end) (subseq string start end)))))
+
+(defun parse-vms-pathname (string &optional (start 0) end)
+  "Splits string into a host, vector of directories, a file name, type,
+   and version. Parses VMS pathnames of the following formats:
+       host::device:[dir1.dir2...]name.type;version
+       host::device:<dir1.dir2...>name.type.version
+       host:device:<dir1.dir2...>name.type.version &c
+   .. = :wild-inferiors"
+  (declare (simple-string string))
+  (setq end (or end (length string)))
+  (let (host device a-vs-r (directories "") name type version)
+    (multiple-value-bind (new-host new-start)
+	(get-host-string string "::" start end)
+      (if new-host
+	  (setq host new-host start new-start)
+	  (multiple-value-setq (host start) (get-host-string string ":" start end))))
+    (multiple-value-setq (device start)	(get-host-string string ":" start end))
+    (when (plusp (length string))
+      (case (char string start)
+	(#\[  (multiple-value-setq (directories start)
+		  (parse-with-string-delimiter "]" string 
+					       :start (1+ start) :end end)))
+	(#\<  (multiple-value-setq (directories start)
+		  (parse-with-string-delimiter ">" string 
+					       :start (1+ start) :end end)))))
+    ;; Absolute vs. Relative
+    (cond ((and (not (zerop (length directories)))
+		(char= #\. (char directories 0)))
+	   (setq a-vs-r :relative))
+	  (t (setq a-vs-r :absolute)))
+    ;; Split off the components
+    (multiple-value-bind (dirs)
+	(parse-with-string-delimiter* "." directories 
+				      :start (if (eq a-vs-r :relative) 1 0)
+				      :include-last t) ; <<< fix
+      (let ((last2 (when (> (length dirs) 1)
+		     (nthcdr (- (length dirs) 2) dirs))))
+	(when (equal last2 '(nil nil))
+	  (rplaca last2 "..")
+	  (rplacd last2 nil)))
+      (setq directories
+	    (cons a-vs-r 
+		  (mapcar #'(lambda (dir) (canonicalize dir :vms 'component))
+			  dirs))))
+    ;; Split off the name, type, and version
+    (when (< start end)
+      (multiple-value-setq (name start)
+	  (parse-with-string-delimiter "." string :start start :end end))
+      (when (< start end)
+	(multiple-value-bind (new-type new-start delim-not-found)
+	    (parse-with-string-delimiter ";" string :start start :end end)
+	  (cond (delim-not-found
+		 (multiple-value-setq (type start)
+		     (parse-with-string-delimiter "." string
+						  :start start :end end)))
+		(t
+		 (setq type new-type start new-start))))
+	(when (< start end)
+	  (multiple-value-setq (version start)
+	      (parse-with-string-delimiter "." string :start start :end end)))))
+    ;; Return the values
+    (values host
+	    device
+	    (when (or host directories)
+	      (coerce directories 'vector))
+	    name
+	    type
+	    version
+	    ;; This last is the remaining cruft. Should be nil.
+	    (when (< start end) (subseq string start end)))))
+
+(defun parse-explorer-pathname (string &optional (start 0) end)
+  "Splits string into a host, vector of directories, a file name, type,
+   and version. Parses TI Explorer pathnames of the following format:
+       host:dir1.dir2...;name.type#version"
+  (declare (simple-string string))
+  (setq end (or end (length string)))
+  (let (host a-vs-r (directories "") name type version)
+    (multiple-value-setq (host start)
+	(get-host-string string ":" start end))
+    (multiple-value-setq (directories start)
+	(parse-with-string-delimiter ";" string 
+				     :start start :end end))
+    ;; Absolute vs. Relative
+    (cond ((and (not (zerop (length directories)))
+		(char= #\. (char directories 0)))
+	   (setq a-vs-r :relative))
+	  (t (setq a-vs-r :absolute)))
+    ;; Split off the components
+    (multiple-value-bind (dirs)
+	(parse-with-string-delimiter* "." directories 
+				      :start (if (eq a-vs-r :relative) 1 0)
+				      :end nil :include-last t)
+
+      (setq directories
+	    (cons a-vs-r 
+		  (mapcar #'(lambda (dir)
+			      (canonicalize dir :explorer 'component))
+			  dirs))))
+    ;; Split off the name, type, and version
+    (when (< start end)
+      (multiple-value-bind (new-name new-start delim-not-found)
+	  (parse-with-string-delimiter "." string :start start :end end)
+	(when (not delim-not-found)
+	  (setq name new-name start new-start)))
+      (when (< start end)
+	(multiple-value-setq (type start)
+	    (parse-with-string-delimiter "#" string :start start :end end))
+	(when (< start end)
+	  (multiple-value-setq (version start)
+	      (parse-with-string-delimiter "." string :start start :end end)))))
+    ;; Return the values
+    (values host
+	    :unspecific
+	    (when (or host directories)
+	      (coerce directories 'vector))
+	    name
+	    type
+	    version
+	    ;; This last is the remaining cruft. Should be nil.
+	    (when (< start end) (subseq string start end)))))
+
+
+;;; ********************************
+;;; Convert Generic Pathnames ******
+;;; ********************************
+;;; Converts a generic pathname to a format for standard lisp functions.
+
+(defvar *translation-output* :namestring
+  "Specifies whether the output of translate-logical-pathname
+   should be a :namestring or a :pathname made with lisp:make-pathname,
+   or :as-is.")
+
+(defconstant directory-structure-type ; &&&
+  #+:CMU 'simple-vector
+  #+:lispm 'list
+  #+:kcl   'list
+  #+:ecl   'list
+  #+:hp    'list
+  #-(or :cmu :lispm :kcl :ecl :hp)
+  (cond ((string-equal (lisp-implementation-type) "VAX LISP") 'list)
+	(t 'list)))
+
+(defun convert-generic-pathname (pathname 
+				 &optional (output-type *translation-output*))
+  (when pathname
+    (case output-type 
+      (:namestring        (physical-namestring pathname))
+      (:pathname
+       (let ((host       (%physical-pathname-host pathname))
+	     (device     (%physical-pathname-device pathname))
+	     (directory  (coerce (%physical-pathname-directory pathname)
+				 'list))
+	     (name       (%physical-pathname-name pathname))
+	     (type       (%physical-pathname-type pathname))
+	     (version    (%physical-pathname-version pathname))
+	     (target-host-type  (host-type nil))
+	     a-vs-r)
+	 ;; Handle :absolute/:relative crap.
+	 (setq a-vs-r (pop directory))
+	 (case a-vs-r
+	   (:absolute
+	    #+:cmu (setf device :absolute)
+	    #+(and :sun :kcl :unix) (setq a-vs-r :root)
+	    #+ecl (setq a-vs-r :root))
+	   (:relative
+	    #+:cmu (setf device "Default")))
+	 ;; Reverse canonicalizations
+	 (setq host (surface-form host target-host-type 'host)
+	       directory (mapcar #'(lambda (dir)
+				     (surface-form dir target-host-type
+						   'component))
+				 directory)
+	       name (surface-form name target-host-type 'name)
+	       type (surface-form type target-host-type 'type)
+	       version (surface-form version target-host-type 'version))
+	 ;; Fixup Host
+	 #+:cmu (setf host "Mach")
+	 ;; Fixup Directory
+	 #-:cmu (push a-vs-r directory)
+	 (setq directory (coerce directory directory-structure-type))
+       
+	 (when (string-equal (lisp-implementation-type) "VAX LISP")
+	   (setq directory
+		 (cond ((stringp directory) directory)
+		       ((eq (car directory) :absolute)
+			(format nil "[~{~A~^.~}]" (cdr directory)))
+		       ((eq (car directory) :relative)
+			(format nil "[.~{~A~^.~}]" (cdr directory)))
+		       (t (format nil "[~{~A~^.~}]" directory)))))
+
+	 ;; Return the new pathname
+	 (make-pathname :host host :device device :directory directory
+			:name name :type type :version version)
+	 ))
+      (otherwise pathname)))) 
+
+
+;;; ********************************
+;;; Translate Logical Pathnames ****
+;;; ********************************
+(defvar *circularity-check-table* (make-hash-table :test #'equal)
+  "This table is used to prevent infinite circular loops in the logical
+   pathname resolution. If a pathname's entry in this table is set
+   to T, it has already been \"seen\". Seeing such a pathname twice
+   is an error.")
+
+(defun translate-logical-pathname (logical-pathname
+				   &optional
+				   (output-format *translation-output*))
+  "Translates a logical pathname to the corresponding physical pathname.
+   The pathname argument is first coerced to a logical pathname [this 
+   should really be pathname, but for that we'd have to redefine
+   make-pathname and friends to check whether the host is a logical host].
+   If the coerced argument is a logical pathname, the first matching
+   translation (according to LOGICAL-PATHNAME-MATCH-P) of the logical pathname
+   host is applied, as if by calling TRANSLATE-LOGICAL-PATHNAME-AUX.
+   If the result is a logical pathname, this process is repeated. 
+   When the result is finally a physical pathname, it is returned. If no 
+   translation matches a logical pathname, or the resolution process loops,
+   an error is signaled.
+
+   TRANSLATE-LOGICAL-PATHNAME may perform additional translations,  
+   to provide translation of file types to local naming conventions, to
+   accommodate physical file systems with names of limited length, or to
+   deal with special character requirements such as translating hyphens
+   to underscores or uppercase letters to lowercase."
+
+  ;; Ensure that it is a logical pathname
+  (setq logical-pathname (logical-pathname logical-pathname))
+  (when (typep logical-pathname 'logical-pathname)
+    ;; To prevent circular loops...
+    (let ((namestring (logical-namestring logical-pathname)))
+      (setf (gethash namestring *circularity-check-table*) T))
+    (unwind-protect
+	(resolve-logical-pathname logical-pathname output-format)
+      (clrhash *circularity-check-table*))))
+
+(defun resolve-logical-pathname (logical-pathname 
+				 &optional
+				 (output-format *translation-output*))
+  "Resolve the logical pathname into a physical pathname using the
+   translations table."
+  (let ((logical-host (logical-pathname-host logical-pathname)))
+    (if logical-host
+	(let ((translated-pathname 
+	       (map-logical-pathname logical-pathname logical-host
+				     output-format)))
+	  (if translated-pathname
+	      (or (when (eq (pathname-host-type translated-pathname) :logical)
+		    ;; If the translation is itself a logical pathname,
+		    ;; repeat the process until a physical pathname is reached.
+		    (check-logical-pathname translated-pathname)
+		    (resolve-logical-pathname translated-pathname 
+					      output-format))
+		  translated-pathname)
+	      (error "No translation mapping for ~S." logical-pathname)))
+	(error "No such logical host in ~S:." logical-pathname))))
+
+(defun check-logical-pathname (pathname)
+  "Ensure that there are no cycles in the translations."
+  (let ((namestring (logical-namestring pathname)))
+    (if (gethash namestring *circularity-check-table*) 
+	(error "Circularity in translations for ~S." namestring)
+	(setf (gethash namestring *circularity-check-table*) T))))
+
+(defun map-logical-pathname (logical-pathname 
+			     host
+			     &optional (output-format *translation-output*))
+  "Find and execute the first matching translation."
+  (dolist (translation (logical-pathname-translations host))
+    (let ((from-pathname (logical-pathname (car translation) host))
+	  (to-pathname   (cadr translation)))
+      (when (logical-pathname-match-p logical-pathname from-pathname)
+	(return (translate-logical-pathname-aux logical-pathname
+						from-pathname
+						to-pathname
+						output-format))))))
+
+(defun logical-pathname-match-p (logical-pathname from-pathname)
+  "Return T if the logical pathname matches the test pathname."
+  (setq logical-pathname (logical-pathname logical-pathname)
+	from-pathname (logical-pathname from-pathname))
+  ;; ignore host. Match directories. Match name. Match type. Match version.
+  (and (match-directories (logical-pathname-directory from-pathname)
+			  (logical-pathname-directory logical-pathname))
+       (match-wildcard-word (logical-pathname-name from-pathname)
+			    (logical-pathname-name logical-pathname))
+       (match-wildcard-word (logical-pathname-type from-pathname)
+			    (logical-pathname-type logical-pathname))
+       (match-wildcard-word (logical-pathname-version from-pathname)
+			    (logical-pathname-version logical-pathname))))  
+
+(defun translate-logical-pathname-aux (logical-pathname 
+				       from-pathname to-pathname
+				       &optional
+				       (output-format *translation-output*))
+  "Translates the logical pathname using the substitution specified by
+   a particular translation."
+  (let* ((host (pathname-host to-pathname))
+	 (host-type (host-type host))
+	 (translation-rule (find-translation-rule host-type))
+	 (char-map (translation-rule-char-mappings translation-rule))
+	 (string-map (translation-rule-component-mappings translation-rule)))
+    (let ((device (pathname-device to-pathname))
+	  (directories (map-directories
+			(pathname-directory logical-pathname)
+			(pathname-directory from-pathname)
+			(pathname-directory to-pathname)
+			*null-vector* 0 0 0
+			(choose-case translation-rule 'component)
+			char-map string-map))
+	  (name (map-wildcard-word (pathname-name logical-pathname)
+				   (pathname-name from-pathname)
+				   (pathname-name to-pathname)
+				   (choose-case translation-rule 'name)
+				   char-map string-map))
+	  (type (map-wildcard-word (pathname-type logical-pathname)
+				   (pathname-type from-pathname)
+				   (pathname-type to-pathname)
+				   (choose-case translation-rule 'type)
+				   char-map string-map))
+	  (version (map-wildcard-word (pathname-version logical-pathname)
+				      (pathname-version from-pathname)
+				      (pathname-version to-pathname)
+				      (choose-case translation-rule 'version)
+				      char-map string-map)))
+      (cond ((eq (pathname-host-type to-pathname) :logical)
+	     (make-logical-pathname :host host 
+				    :directory directories
+				    :name name
+				    :type type
+				    :version version))
+	    (t 
+	     (convert-generic-pathname 
+	      (make-pathname :host host 
+				      :device device
+				      :directory directories
+				      :name name
+				      :type type
+				      :version version)
+	      output-format))))))
+
+;;; ********************************
+;;; Match and Map Wildcards ********
+;;; ********************************
+(defun wildcard-wordp (string)
+  (find #\* string))
+
+(defun must-match (thing)
+  (or (eq thing :wild)
+      (and (stringp thing)
+	   (wildcard-wordp thing))))
+
+(defun match-wildcard-word (template string)
+  ;; "*" standalone (:wild) is treated differently from "*" within
+  ;; a word.
+  (or (eq template :wild)
+      (null template)
+      (and (stringp string) (stringp template)
+	   (match-strings template string))
+      ;; e.g., :absolute :absolute
+      (eq template string)))
+
+(defun match-strings (template string &optional (t-start 0) (s-start 0))
+  (let* ((t-length (length template))
+	 (s-length (length string))
+	 (t-at-end (= t-length t-start))
+	 (s-at-end (= s-length s-start)))
+    (cond ((or t-at-end s-at-end) 	; if at end of template or string
+	   (and t-at-end s-at-end))     ; both must be at the end.
+	  ((char= #\* (char template t-start))
+	   (or (match-strings template string (1+ t-start) s-start)
+	       (match-strings template string t-start (1+ s-start))
+	       (match-strings template string (1+ t-start) (1+ s-start))))
+	  ((char-equal (char template t-start)
+		  (char string s-start)) ; includes * against *
+	   (match-strings template string (1+ t-start) (1+ s-start))))))
+
+(defun match-directories (template dirs &optional (t-start 0) (d-start 0))
+  (let* ((t-length (length template))
+	 (d-length (length dirs))
+	 (t-at-end (= t-length t-start))
+	 (d-at-end (= d-length d-start)))
+    (cond ((or t-at-end d-at-end)
+	   (and t-at-end d-at-end))
+	  ((eq (#+:cmu svref #-:cmu aref template t-start) :wild-inferiors)
+	   ;; :wild-inferiors matches any number of components, including
+	   ;; zero. First try skipping over the :wild-inferiors. If that fails,
+	   ;; try matching against one component without skipping over the
+	   ;; :wild-inferiors. Finally, try matching against one component
+	   ;; while skipping over the :wild-inferiors (the latter really
+	   ;; isn't necessary, since the first 2 cases include it).
+	   (or (match-directories template dirs (1+ t-start) d-start)
+	       (match-directories template dirs t-start (1+ d-start))
+	       (match-directories template dirs (1+ t-start) (1+ d-start))))
+	  ((match-wildcard-word (#+:cmu svref #-:cmu aref template t-start)
+				(#+:cmu svref #-:cmu aref dirs d-start))
+	   (match-directories template dirs (1+ t-start) (1+ d-start))))))
+
+(defun map-wildcard-word (string source target 
+				 &optional case char-mappings string-mappings)
+  (let ((result
+	 (cond ((and (stringp target)
+		     (not (wildcard-wordp target)))
+		;; If the target pattern does not contain *, copy the target
+		;; pattern component literally to the target instance.
+		target)
+	       ((or (eq target :wild) (null target))
+		;; If the target pattern is :wild, copy the source string
+		;; component to the target string literally with no further
+		;; analysis. This holds even for the type, which is 
+		;; represented internally in terms of canonical types,
+		;; and is "translated" when realized for the new host.
+		string)
+	       ((not (stringp target))
+		target)
+	       ((eq source :wild)
+		(map-strings string string target))
+	       (t (map-strings string source target)))))
+    (when (stringp result)
+      (setq result 
+	    (casify (parallel-substitute char-mappings
+					 (name-substitution string-mappings 
+							    result))
+		    case)))
+    result))
+
+(defun map-strings (string source target
+			   &optional (result "")
+			   (s-start 0) (st-start 0) (tt-start 0))
+  (let* ((s-length (length string))
+	 (st-length (length source))
+	 (tt-length (length target))
+	 (s-at-end (= s-length s-start))
+	 (st-at-end (= st-length st-start))
+	 (tt-at-end (= tt-length tt-start)))
+    (cond ((or s-at-end st-at-end)
+	   ;; When not enough matching values are available due to too few
+	   ;; * in the source pattern, use the null string as the matching
+	   ;; value for any * remaining in the target.
+	   (when (and s-at-end st-at-end)
+	     (concatenate 'simple-string 
+			  result
+			  (delete #\* (subseq target tt-start)))))
+	  (tt-at-end
+	   ;; When the source pattern has too many *, ignore the first
+	   ;; extra * and everything following it.
+	   result)
+	  ((char= #\* (char target tt-start))
+	   ;; Replace * in target pattern with the contents of the source
+	   ;; string specified by the next * in the source pattern.
+	   (cond ((char= #\* (char source st-start))
+		  (or (map-strings string source target result 
+				   s-start (1+ st-start) (1+ tt-start))
+		      (map-strings string source target 
+				   (concatenate 'simple-string result
+						(subseq string s-start 
+							(1+ s-start)))
+				   (1+ s-start) st-start tt-start)))
+		 ((char-equal (char source st-start) ; was char=
+			      (char string s-start))
+		  (map-strings string source target result 
+			       (1+ s-start) (1+ st-start) tt-start))))
+	  (t;; copy literal strings as is from the target
+	   (let ((next-* (position #\* target :start tt-start)))
+	     (if next-*
+		 (map-strings string source target
+			      (concatenate 'simple-string result
+					   (subseq target tt-start next-*))
+			      s-start st-start next-*)
+		 (when (match-strings source string st-start s-start)
+		   (concatenate 'simple-string
+				result (subseq target tt-start)))))))))
+
+(defun map-directories (dirs source target 
+			     &optional (result *null-vector*)
+			     (d-start 0) (s-start 0) (t-start 0)
+			     case char-map string-map)
+  (let* ((d-length (length dirs))
+	 (s-length (length source))
+	 (t-length (length target))
+	 (d-at-end (= d-length d-start))
+	 (s-at-end (= s-length s-start))
+	 (t-at-end (= t-length t-start)))
+    (cond ((or d-at-end s-at-end)
+	   (when (and d-at-end s-at-end)
+	     (concatenate 'simple-vector result
+			  (map 'simple-vector 
+			       #'(lambda (x) 
+				   (map-wildcard-word 
+				    "" "" x
+				    case char-map string-map))
+			       (delete :wild-inferiors 
+				       (subseq target t-start))))))
+	  (t-at-end
+	   (when (match-directories source dirs s-start d-start)
+	     result))
+	  ((eq :wild-inferiors (#+:cmu svref #-:cmu aref target t-start))
+	   (cond ((eq :wild-inferiors (#+:cmu svref
+				       #-:cmu aref source s-start))
+		  (or (map-directories dirs source target result
+				       d-start (1+ s-start) (1+ t-start)
+				       case char-map string-map)
+		      (map-directories dirs source target 
+				       (concatenate 'simple-vector result
+						    (list (map-wildcard-word
+							   (#+:cmu svref 
+							    #-:cmu aref
+							    dirs d-start)
+							   :wild :wild
+							   case char-map
+							   string-map)))
+				       (1+ d-start) s-start t-start
+				       case char-map string-map)
+		      (map-directories dirs source target 
+				       (concatenate 'simple-vector result
+						    (list (map-wildcard-word
+							   (#+:cmu svref 
+							    #-:cmu aref
+							    dirs d-start)
+							   :wild :wild
+							   case char-map
+							   string-map)))
+				       (1+ d-start) (1+ s-start) (1+ t-start)
+				       case char-map string-map)))
+		 ((string-equal (#+:cmu svref #-:cmu aref dirs d-start)
+				(#+:cmu svref #-:cmu aref source s-start))
+		  (map-directories dirs source target result
+				   (1+ d-start) (1+ s-start) t-start
+				   case char-map string-map))))
+	  ((must-match (#+:cmu svref #-:cmu aref target t-start))
+	   (cond ((must-match (#+:cmu svref #-:cmu aref source s-start))
+		  (map-directories dirs source target
+				   (concatenate 'simple-vector result
+						(list (map-wildcard-word 
+						 (#+:cmu svref 
+						  #-:cmu aref dirs d-start)
+						 (#+:cmu svref
+						  #-:cmu aref source s-start)
+						 (#+:cmu svref
+						  #-:cmu aref target t-start)
+						 case char-map string-map)))
+				   (1+ d-start) (1+ s-start) (1+ t-start)
+				   case char-map string-map))
+		 ((string-equal (#+:cmu svref #-:cmu aref dirs d-start)
+				(#+:cmu svref #-:cmu aref source s-start))
+		  (map-directories dirs source target result
+				   (1+ d-start) (1+ s-start) t-start
+				   case char-map string-map))))
+	  (t
+	   (map-directories dirs source target
+			    (concatenate 'simple-vector result
+					 (list
+					  (map-wildcard-word
+					   (#+:cmu svref 
+						   #-:cmu aref target t-start)
+					   :wild :wild
+					   case char-map
+					   string-map)))
+			    d-start s-start (1+ t-start)
+			    case char-map string-map)))))
+
+
+;;; ********************************
+;;; Common Lisp Redefinitions ******
+;;; ********************************
+;;; Not doing merge-pathnames or with-open-file. Parse-namestring not
+;;; really done well.
+
+;;; append-directories
+(defun append-logical-directories (absolute-dir relative-dir)
+  (when (or absolute-dir relative-dir)
+    (setq absolute-dir (logical-pathname (or absolute-dir ""))
+	  relative-dir (logical-pathname (or relative-dir "")))
+    (logical-namestring 
+     (make-logical-pathname
+      :host (or (logical-pathname-host absolute-dir)
+		(logical-pathname-host relative-dir))
+      :directory (concatenate 'simple-vector
+			      (logical-pathname-directory absolute-dir)
+			      (cdr (coerce (logical-pathname-directory
+					    relative-dir)
+					   'list)))
+      :name (or (logical-pathname-name absolute-dir)
+		(logical-pathname-name relative-dir))
+      :type (or (logical-pathname-type absolute-dir)
+		(logical-pathname-type relative-dir))
+      :version (or (logical-pathname-version absolute-dir)
+		   (logical-pathname-version relative-dir))))))
+	  
+(eval-when (compile load eval)
+(defun real-filename (filename)
+  (if (and filename
+	   (eq (pathname-host-type filename) :logical))
+      (translate-logical-pathname filename :namestring)
+      filename))
+
+#|
+(defmacro convert-file-function (name &optional optionalp)
+  (let ((old-name (intern (concatenate 'string "OLD-" (string name)))))
+    `(unless (fboundp ',old-name)
+	     (setf (symbol-function ',old-name)(symbol-function ',name))
+	     (setf (symbol-function ',name)
+		   #'(lambda ,(if optionalp 
+				  '(&optional filename &rest args)
+				'(filename &rest args))
+		       (apply #',old-name (real-filename filename) args))))))
+|#
+
+(defmacro convert-file-function (name &optional optionalp)
+  (let ((old-name (intern (concatenate 'string "OLD-" (string name)))))
+    `(unless (fboundp ',old-name)
+       ;; Yes, some lisps will give compiler warnings about OLD-name
+       ;; not being declared or defined as a function. But what can
+       ;; we do, with most lisps not yet recognizing CLtL2's ftype
+       ;; declaration?
+       (setf (symbol-function ',old-name)(symbol-function ',name))
+       (setf (symbol-function ',name)
+	     #'(lambda ,(if optionalp 
+			    '(&optional filename &rest args)
+			  '(filename &rest args))
+		 ,(if optionalp
+		      `(if filename
+			   (apply #',old-name (real-filename filename) args)
+			 (,old-name)) ; instead of (funcall #',old-name)
+		    `(apply #',old-name (real-filename filename) args)))))))
+
+(defmacro convert-file-function-2-args (name)
+  (let ((old-name (intern (concatenate 'string "OLD-" (string name)))))
+    `(unless (fboundp ',old-name)
+       (setf (symbol-function ',old-name)(symbol-function ',name))
+       (setf (symbol-function ',name)
+	     #'(lambda (filename1 filename2 &rest args)
+		 (apply #',old-name
+			(real-filename filename1)(real-filename filename2)
+			args))))))
+)
+
+(convert-file-function lisp::load)
+(convert-file-function lisp::open)
+(convert-file-function lisp::probe-file)
+(convert-file-function lisp::delete-file)
+(convert-file-function lisp::truename)
+(convert-file-function lisp::directory)
+(convert-file-function lisp::dribble t)
+(convert-file-function lisp::ed t)
+(convert-file-function lisp::file-author)
+(convert-file-function lisp::file-write-date)
+
+(convert-file-function-2-args lisp::rename-file)
+;; should take care of :output-file as well
+(convert-file-function lisp::compile-file)			  
+
+(unless (fboundp 'old-parse-namestring)
+  (setf (symbol-function 'old-parse-namestring)
+	(symbol-function 'lisp::parse-namestring))
+  (defun lisp::parse-namestring (thing &optional host
+				       (defaults *default-pathname-defaults*)
+				       &key (start 0) end junk-allowed)
+    "Convert THING (string, symbol, pathname, or stream) into a pathname."
+    (declare (ignore junk-allowed))
+    (cond ((null thing) nil) ; try to fix bug with (ed). probably not here.
+	  ((or (eq (pathname-host-type thing) :logical)
+	       (eq (pathname-host-type defaults) :logical)
+	       (eq (host-type host) :logical))
+	   ;; Tis a logical pathname
+	   (parse-generic-namestring thing host defaults 
+				     :start start :end end))
+	  (t (if end
+		 (funcall 'old-parse-namestring thing host defaults 
+			  :start start :end end)
+		 (funcall 'old-parse-namestring thing host defaults 
+			  :start start))))))
+
+;;; *EOF*
diff --git a/contrib/logical-pathnames.lsp b/contrib/logical-pathnames.lsp
new file mode 100644
index 000000000..b8f94624b
--- /dev/null
+++ b/contrib/logical-pathnames.lsp
@@ -0,0 +1,2000 @@
+;;; -*- Mode: LISP; Package: LOGICAL-PATHNAME; Syntax: Common-lisp;  -*- 
+;;; Tue Apr  9 19:17:01 1991 by Mark Kantrowitz <mkant@LION.OZ.CS.CMU.EDU>
+;;; logical-pathnames.lisp
+
+;;; ****************************************************************
+;;; Logical Pathnames System ***************************************
+;;; ****************************************************************
+;;;
+;;; Logical Pathnames provide a facility for referring to pathnames
+;;; in a portable manner. Logical pathnames are mapped to physical
+;;; pathnames by a set of implementation dependent and site-dependent
+;;; rules. 
+;;; 
+;;; This system is a Common Lisp portable implementation of logical
+;;; pathnames. It fulfills most of the X3J13 June 1989 specification
+;;; for logical pathnames, as documented in Guy Steele's "Common Lisp:
+;;; The Language" (2nd Edition), section 23.1.5 "Logical Pathnames".
+;;;
+;;; Written by Mark Kantrowitz, July 1990.
+;;;
+;;; Address: Carnegie Mellon University
+;;;          School of Computer Science
+;;;          Pittsburgh, PA 15213
+;;;
+;;; This code is in the public domain and is distributed without warranty
+;;; of any kind. 
+;;;
+;;; Use and copying of this software and preparation of derivative works
+;;; based upon this software are permitted, so long as the following
+;;; conditions are met:
+;;;      o no fees or compensation are charged for use, copies, or
+;;;        access to this software
+;;;      o this copyright notice is included intact.
+;;; This software is made available AS IS, and no warranty is made about 
+;;; the software or its performance. 
+;;;
+;;; Please send bug reports, comments and suggestions to mkant@cs.cmu.edu. 
+;;;
+;;;
+;;; Logical Pathnames are especially useful when coupled with a portable
+;;; system construction tool, such as the Defsystem facility written
+;;; by Mark Kantrowitz.
+;;;
+
+;;; ********************************
+;;; Change Log *********************
+;;; ********************************
+;;;
+;;; djc  = Daniel J. Clancy <clancy@cs.utexas.edu>
+;;;
+;;; 30-JUL-90  mk    Fixed logical pathnames for VAX-LISP (thanks to
+;;;                  Paul Werkowski). In VAX-LISP simple strings are not
+;;;                  sub-types of simple-vectors, so svref doesn't work
+;;;                  on strings. These calls have been fixed to read
+;;;                  #+:cmu svref #-:cmu aref.
+;;; 15-NOV-90  mk    Changed convert-file-function to better handle optional 
+;;;                  args. This should fix the problem of (ed) and (dribble)
+;;;                  returning errors like "argument NIL must be a number"
+;;;                  in parse-namestring. Note that some lisps seem to make
+;;;                  a distinction between (funcall #'foo) and (foo) with
+;;;                  respect to this error.
+;;; 29-JAN-91  mk    Defined LISP:NTH-VALUE if not already present (it is
+;;;                  a CLtL2 addition) and used it in LOAD-PHYSICAL-HOSTAB
+;;;                  to avoid needing a GARBAGE variable in 
+;;;                  (multiple-value-setq (garbage pos) ...) which we can
+;;;                  not declare ignore and yet causes a compiler warning
+;;;                  since we don't use it.
+;;; 29-JAN-91  mk    lisp::file-name is particular to CMU Common Lisp
+;;;                  and the #+:cmu's were accidentally left off.
+;;; 29-JAN-91  mk    Added :explorer physical namestring output to 
+;;;                  PHYSICAL-NAMESTRING.                
+;;; 29-JAN-91  mk    Warns about name collisions between physical and logical
+;;;                  host names.
+;;; 30-JAN-91  mk    Added :logical-pathnames-mk to the *features* list.
+;;; 25-FEB-91  mk    Added definition of LOAD-LOGICAL-PATHNAME-TRANSLATIONS.
+;;; 09-APR-91  mk    Export pathname-host-type, append-logical-directories.
+;;; 09-APR-91  mk    Translation rules now support :case :unchanged.
+;;; 09-APR-91  djc   Fixed so that (logical-pathname "") returns a 
+;;;                  logical-pathname structure.
+;;; 21-FEB-96  attardi
+;;;		     Added support for ECL
+
+;;; ********************************
+;;; To Do **************************
+;;; ********************************
+;;;
+;;; Support for Macintosh pathnames. Little tricky, since MACL uses a
+;;; colon (:) as the delimiter.
+;;;    
+;;; support for tops-20/tenex, multics, its, ms-dos
+;;; add host-type to pathnames
+;;; merge-pathnames, with-open-file 
+;;;
+;;; Define generic pathname parsing/printing definition interface.
+;;;
+;;; Redefine with-open-file?
+;;;
+;;; Port to emacs-lisp for gnu-emacs?
+;;;
+;;; Logical pathnames needs to case both on the physical host type and on
+;;; lisp type (e.g., for canonicalization). Fix this, and define lots of
+;;; canonical types. Dependency on lisp type can probably be handled using
+;;; #+ and #-. What about conflicts between canonicalization and the
+;;; translations (e.g., "L" vs :lisp)?
+;;;
+
+;;; ********************************
+;;; Notes **************************
+;;; ********************************
+;;;
+;;;    LOGICAL-PATHNAMES has been tested (successfully) in the following lisps:
+;;;       CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
+;;;       Macintosh Allegro Common Lisp (1.3.2)
+;;;       ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 3/30/90)
+;;;       Lucid CL (Version 2.1 6-DEC-87)
+;;;       Symbolics Common Lisp (8.0)
+;;;       Lucid Common Lisp (3.0, 4.0)
+;;;       VAXLisp (2.0, 3.1)
+;;;	  ECL (ECoLisp) Version(0.23)
+;;;
+;;;    LOGICAL-PATHNAMES needs to be tested in the following lisps:
+;;;       KCL (June 3, 1987 or later)
+;;;       AKCL (1.86, June 30, 1987 or later)
+;;;       TI (Release 4.1 or later)
+;;;       Ibuki Common Lisp (01/01, October 15, 1987)
+;;;       Golden Common Lisp (3.1 IBM-PC)
+;;;       HP Common Lisp (same as Lucid?)
+;;;       Procyon Common Lisp
+
+
+;;; ********************************
+;;; Documentation ******************
+;;; ********************************
+;;; 
+;;; Logical pathnames allow large programs to be moved between sites
+;;; by separating pathname reference from actual file location. The
+;;; program will refer to files using logical pathnames. At each site,
+;;; a user will specify a set of "translations" which map from the logical
+;;; pathnames to the physical pathnames used on the device.
+;;;
+;;; Logical pathnames provide a uniform convention for filesystem access,
+;;; with the following properties:
+;;;  1.  Pathname Portability: The program specifies a pathname in
+;;;      a conventional format (logical pathnames), which may be
+;;;      mapped reasonably literally (via the translations) to
+;;;      a variety of filesystems.
+;;;  2.  Pathname Aliasing: The files may exist in different locations
+;;;      in the various filesystems. For example, the root directory
+;;;      might change. The translations allow such a change easily.
+;;;  3.  Cross-host Access: The files need not all exist on the same
+;;;      physical host. 
+;;;
+;;; This definition of logical pathnames provides support for physical
+;;; pathnames for Unix, VMS/VAX, Symbolics, and TI Explorers, and is
+;;; easily extended to handle additional platforms. Code which may need
+;;; customization for particular Lisps and platforms has been commented
+;;; with three ampersands (&&&). In addition, the user probably should
+;;; define their own canonical types, translation rules, and
+;;; logical-pathname-translations. Examples are provided.
+;;;
+;;; Logical pathnames employ the following syntax:
+;;;     [host:] [;] {directory ;}* [name] [. type [. version]]
+;;; host      ::= word
+;;; directory ::= word | wildcard-word | wildcard-inferiors
+;;; name      ::= word | wildcard-word
+;;; type      ::= word | wildcard-word
+;;; version   ::= word | wildcard-word
+;;; word      ::= {letter | digit | -}*
+;;; wildcard-word ::= [word] * {word *}* [word]
+;;; wildcard-inferiors ::= **
+;;;
+;;; A wildcard-word of * parses as :wild; all others as strings. These
+;;; definitions may be extended (e.g., "newest" parsing as :newest) by
+;;; defining new canonical types.
+;;;
+;;; Incompatibilities with the X3J13 specification:
+;;;    -  LOGICAL-PATHNAME is not defined as a subclass of PATHNAME
+;;;       since we have no guarrantee about the format of PATHNAME
+;;;       (i.e., is it a defstruct or a class definition, what are
+;;;       its slots, etc.). Many Lisps will be able to replace the
+;;;       definition of PHYSICAL-PATHNAME with their definition of
+;;;       PATHNAME by doing a string-replace of "physical-pathname"
+;;;       with "pathname" and deleting some definitions from this file.
+;;;    -  CLtL does not specify the manner in which wildcards are
+;;;       translated. We use reversible wildcard pathname translation,
+;;;       similar to that used in the Symbolics logical pathnames.
+;;;    -  COMPILE-FILE-PATHNAME has not been defined, since it is
+;;;       highly implementation dependent.
+
+;;; ********************************
+;;; Examples ***********************
+;;; ********************************
+;;;
+;;; The following examples of the use of logical pathnames are taken
+;;; from Section 23.1.5.4 of Guy Steele CLtL 2nd Ed.
+
+#|
+(setf (lp:physical-host-type "MY-LISPM") :symbolics)
+(setf (lp:logical-pathname-translations "foo")
+      '(("**;*.*.*" "MY-LISPM:>library>foo>**>")))
+
+<cl> (lp:translate-logical-pathname "foo:bar;baz;mum.quux.3" :namestring)
+"MY-LISPM:>library>foo>bar>baz>mum.quux.3"
+
+(setf (lp:physical-host-type "U") :unix)
+(setf (lp:physical-host-type "V") :vms)
+(setf (lp:logical-pathname-translations "prog")
+      '(("RELEASED;*.*.*"    "U:/sys/bin/my-prog/")
+	("RELEASED;*;*.*.*"  "U:/sys/bin/my-prog/*/")
+	("EXPERIMENTAL;*.*.*" "U:/usr/Joe/development/prog/")
+	("EXPERIMENTAL;DOCUMENTATION;*.*.*" "V:SYS$DISK:[JOE.DOC]")
+	("EXPERIMENTAL;*;*.*.*" "U:/usr/Joe/development/prog/*/")
+	("MAIL;**;*.MAIL"       "V:SYS$DISK:[JOE.MAIL.PROG...]*.MBX")))
+
+<cl> (lp:translate-logical-pathname "prog:mail;save;ideas.mail.3" :namestring)
+"V:SYS$DISK:[JOE.MAIL.PROG.SAVE]IDEAS.MBX.3"
+<cl> (lp:translate-logical-pathname "prog:experimental;spreadsheet.c" :namestring)
+"U:/usr/Joe/development/prog/spreadsheet.c"
+
+(setf (lp:logical-pathname-translations "prog")
+      '(("CODE;*.*.*"    "/lib/prog/")))
+<cl> (lp:translate-logical-pathname "prog:code;documentation.lisp" :namestring)
+"/lib/prog/documentation.lisp"
+
+(setf (lp:logical-pathname-translations "prog")
+      '(("CODE;DOCUMENTATION.*.*"    "/lib/prog/docum.*")
+	("CODE;*.*.*"    "/lib/prog/")))
+<cl> (lp:translate-logical-pathname "prog:code;documentation.lisp" :namestring)
+"/lib/prog/docum.lisp"
+
+
+(setf (lp:logical-pathname-translations "prog")
+      `(("**;*.LISP.*"  ,(lp:logical-pathname "PROG:**;*.L.*"))
+	("**;*.FASL.*"  ,(lp:logical-pathname "PROG:**;*.B.*"))
+	("CODE;DOCUMENTATION.*.*" "/lib/prog/documentatio.*")
+	("CODE;*.*.*"             "/lib/prog/")))
+<cl> (lp:translate-logical-pathname "prog:code;documentation.lisp" :namestring)
+"/lib/prog/documentatio.l"
+
+|#
+
+;;; ****************************************************************
+;;; Logical Pathnames **********************************************
+;;; ****************************************************************
+;;; Putting this in a separate package doesn't prevent collisions
+;;; with the LISP package, since this package :uses the LISP
+;;; package.
+(in-package "LOGICAL-PATHNAME" :nicknames '("LP"))
+
+(export '(logical-pathname 
+	  translate-logical-pathname 
+	  logical-pathname-translations
+	  pathname-host-type
+	  append-logical-directories
+	  make-logical-pathname
+	  physical-host-type
+	  load-logical-pathname-translations
+	  load-physical-hostab
+	  define-translation-rule
+	  define-canonical))
+
+(pushnew :logical-pathnames-mk *features*)
+
+;;; ********************************
+;;; Global Variables ***************
+;;; ********************************
+(defvar *null-vector* (coerce nil 'simple-vector))
+
+(defvar *warn-about-host-type-collisions* t
+  "Warn user when a logical host type definition collides with a physical 
+   host type definition.")
+
+;;; ********************************
+;;; Primitives *********************
+;;; ********************************
+(defun parse-with-string-delimiter (delim string &key (start 0) end)
+  "Returns up to three values: the string up to the delimiter DELIM
+   in STRING (or NIL if the field is empty), the position of the beginning
+   of the rest of the string after the delimiter, and a value which, if
+   non-NIL (:delim-not-found), specifies that the delimiter was not found."
+  (declare (simple-string string))
+  ;; Conceivably, if DELIM is a string consisting of a single character,
+  ;; we could do this more efficiently using POSITION instead of SEARCH.
+  ;; However, any good implementation of SEARCH should optimize for that
+  ;; case, so nothing to worry about.
+  (setq end (or end (length string)))
+  (let ((delim-pos (search delim string :start2 start :end2 end))
+	(dlength (length delim)))
+    (cond ((null delim-pos)		
+	   ;; No delimiter was found. Return the rest of the string,
+	   ;; the end of the string, and :delim-not-found.
+	   (values (subseq string start end) end :delim-not-found))
+	  ((= delim-pos start)		
+	   ;; The field was empty, so return nil and skip over the delimiter.
+	   (values nil (+ start dlength)))
+	  ;; The following clause is subsumed by the last cond clause,
+	  ;; and hence should probably be eliminated.
+;	  ((= delim-pos (- end dlength))
+;	   ;; The delimiter is at the end of the string, so return the
+;	   ;; field and skip to the end.
+;	   (values (subseq string start delim-pos)
+;		   end))
+	  (t				
+	   ;; The delimiter is in the middle of the string. Return the
+	   ;; field and skip over the delimiter. 
+	   (values (subseq string start delim-pos)
+		   (+ delim-pos dlength))))))
+
+(defun parse-with-string-delimiter* (delim string &key (start 0) end
+					   include-last)
+  "Breaks STRING into a list of strings, each of which was separated
+   from the previous by DELIM. If INCLUDE-LAST is nil (the default),
+   will not include the last string if it wasn't followed by DELIM
+   (i.e., \"foo,bar,\" vs \"foo,bar\"). Otherwise includes it even if
+   not terminated by DELIM. Also returns the final position in the string."
+  (declare (simple-string string))
+  (setq end (or end (length string)))
+  (let (result)
+    (loop
+     (if (< start end)
+	 (multiple-value-bind (component new-start delim-not-found)
+	     (parse-with-string-delimiter delim string :start start :end end)
+	   (when delim-not-found 
+	     (when include-last
+	       (setq start new-start)
+	       (push component result))
+	     (return))
+	   (setq start new-start)
+	   (push component result))
+	 (return)))
+    (values (nreverse result) 
+	    start)))
+
+(defun get-host-string (string &optional (host-delimiter ":") (start 0) end)
+  "Strips the host name off the front of the string."
+  (setq end (or end (length string)))
+  (multiple-value-bind (host pos delim-not-found)
+      (parse-with-string-delimiter host-delimiter string :start start :end end)
+    (if delim-not-found
+	(values nil start)
+	(values host pos))))
+
+(defun parallel-substitute (alist string)
+  "Makes substitutions for characters in STRING according to the ALIST. 
+   In effect, PARALLEL-SUBSTITUTE can perform several SUBSTITUTE
+   operations simultaneously."
+  (declare (simple-string string))
+  ;; This function should be generalized to arbitrary sequences and
+  ;; have an arglist (alist sequence &key from-end (test #'eql) test-not
+  ;; (start 0) (count most-positive-fixnum) end key).
+  (if alist
+      (let* ((length (length string))
+	     (result (make-string length)))
+	(declare (simple-string result))
+	(dotimes (i length)
+	  (let ((old-char (schar string i)))
+	    (setf (schar result i)
+		  (or (second (assoc old-char alist :test #'char=))
+		      old-char))))
+	result)
+      string))
+
+(defun name-substitution (alist string)
+  "Replaces STRING by it's replacement in ALIST, if present."
+  (let ((new-string (second (assoc string alist :test #'string-equal))))
+    (or new-string string)))
+
+(unless (fboundp 'lisp::nth-value)
+  ;; NTH-VALUE is a CLtL2 addition, so not every lisp has it yet.
+  ;; This definition conses a lot, so we shouldn't use it in time-critical
+  ;; situations. It is fine for load-physical-hostab which is the only
+  ;; place we use it.
+  (defmacro lisp::nth-value (n form)
+    "Returns the nth value of the values returned by form."
+    `(nth ,n (multiple-value-list ,form)))
+  (export 'lisp::nth-value "LISP"))
+
+;;; ********************************
+;;; Logical Host Tables ************
+;;; ********************************
+(defvar *logical-pathname-translations-table* (make-hash-table :test #'equal))
+(defun canonicalize-logical-hostname (host)
+  (string-upcase host))
+(defun LOGICAL-PATHNAME-TRANSLATIONS (host)
+  "If HOST is the host component of a logical pathname and has been defined
+   as a logical pathname host name by SETF of LOGICAL-PATHNAME-TRANSLATIONS,
+   this function returns the list of translations for the specified HOST.
+   Each translation is a list of at least two elements, a from-wildname
+   and a to-wildname. The former is a logical pathname whose host is the
+   specified HOST. (I.e., the host of the from-pathname need not be 
+   explicitly specified.) The latter is any pathname. If to-wildname coerces to
+   a logical pathname, TRANSLATE-LOGICAL-PATHNAME will retranslate the
+   result, repeatedly if necessary. Translations are listed in
+   the order listed, so more specific from-wildnames must precede more
+   general ones."
+  ;; would be nice to have host:: specify logical host if physical host
+  ;; already exists, to distinguish from host:
+  (gethash (canonicalize-logical-hostname host)
+	   *logical-pathname-translations-table*))
+(defsetf logical-pathname-translations (host) (translations)
+  "(setf (logical-pathname-translations host) translations) sets the list
+   of translations for the logical pathname host to translations. If host
+   is a string that has not previously been used as a logical pathname
+   host, a new logical pathname host is defined; otherwise an existing
+   host's translations are replaced. Logical pathname host names are
+   compared with string-equal."
+  `(progn
+     (when (and *warn-about-host-type-collisions*
+		(physical-host-type ,host))
+       (format t "~&Warning in (SETF LOGICAL-PATHNAME-TRANSLATIONS):~
+                  ~&   ~S is defined as both a physical host and a logical host."
+	     ,host))
+     (setf (gethash (canonicalize-logical-hostname ,host)
+		    *logical-pathname-translations-table*)
+	   (eval-translations ,translations))))
+
+;;;  EVAL-TRANSLATIONS
+;;
+;;;   Will receive a list of translations and it will evaluate the physical
+;;;   translation if it is not a string.  This allows the user to put a format
+;;;   statement as the physical-translation.
+
+(defun eval-translations (translations)
+  (let (new_trans)
+    (nreverse
+     (dolist (translation translations new_trans)
+       (if (stringp (cadr translation))
+	   (setf new_trans (cons translation new_trans))
+	 (setf new_trans (cons (list (car translation) (eval (cadr translation))) new_trans)))))))
+
+;;; ********************************
+;;; Load Logical Translations ******
+;;; ********************************
+(defvar *logical-translations-directory* nil ; &&&
+  "Directory where logical pathname translations are stored.")
+;;; (setq *logical-translations-directory* "/usr/local/lisp/Registry/")
+
+(defun LOAD-LOGICAL-PATHNAME-TRANSLATIONS (host)
+  "Loads the logical pathname translations for host named HOST if the logical 
+   pathname translations are not already defined. First checks for a file
+   with the same name as the host (lowercase) and type \"translations\" in
+   the current directory, then the translations directory. If it finds such
+   a file it loads it and returns T, otherwise it signals an error."
+  (unless (logical-pathname-translations host)
+    (let* ((trans-fname (concatenate 'string (string-downcase host)
+				     ".translations"))
+	   (pathname (when *logical-translations-directory*
+		       (merge-pathnames *logical-translations-directory*
+					trans-fname))))
+      (cond ((probe-file trans-fname)
+	     (load trans-fname)
+	     t)
+	    ((and *logical-translations-directory*
+		  (probe-file pathname))
+	     (load pathname)
+	     t)
+	    (t
+	     (error "Logical pathname translations for host ~A not found."
+		    host))))))
+
+;;; ********************************
+;;; Physical Host Tables ***********
+;;; ********************************
+(defvar *physical-host-table* (make-hash-table :test #'equal)
+  "Table of physical hosts and system types for those hosts. 
+   Valid (implemented) types include :vms, :explorer, :symbolics, :unix.")
+(defun physical-host-type (host)
+  (gethash host *physical-host-table*))
+(defsetf physical-host-type (host) (type)
+  `(progn
+     (when (and *warn-about-host-type-collisions*
+		(logical-pathname-translations ,host))
+       (format t "~&Warning in (SETF PHYSICAL-HOST-TYPE):~
+                  ~&   ~S is defined as both a physical host and a logical host."
+	       ,host))
+     (setf (gethash ,host *physical-host-table*)
+	   ,type)))
+
+(defconstant local-host-table		; &&&
+  #+:vms "chaos$root:[host.tables]nethosts.txt"
+  #-:vms "nethosts.txt")
+
+(defun load-physical-hostab (&optional (local-hostab local-host-table))
+  "Loads the physical host namespace table. This is compatible with
+   vms and symbolics host tables. Hostab line format should look
+   something like:
+      HOST NAME,CHAOS-#,STATUS,SYSTEM-TYPE,MACHINE-TYPE,NICKNAMES
+   NAME and SYSTEM-TYPE are required; all others are optional (but delimiting
+   commas are still required). SYSTEM-TYPE specifies the operating system
+   run on the host. This information is used to figure out how to parse
+   pathnames for the host. Common values are: LISP, LISPM, UNIX, MACH,
+   VMS, and EXPLORER."
+  ;; What about SITE, SHORT-NAME, USER-PROPERTY, ADDRESS, PRETTY-NAME, 
+  ;; and other Symbolics host attributes?
+  (when local-hostab
+    (with-open-file (hostab local-hostab :direction :input)
+      (do* ((host (read hostab nil :eof)(read hostab nil :eof))
+	    ;; host should be NET or HOST.
+	    (line (read-line hostab nil :eof)(read-line hostab nil :eof)))
+	  ;; Exit on end of file.
+	  ((or (eq host :eof)(eq line :eof)))
+	;; For each line in the host table, do
+	(cond ((null line)
+	       (warn "Unexpected EOF in hostab ~S, exiting." local-hostab)
+	       (return))
+	      ((string-equal (symbol-name host) "HOST")
+	       ;; Delete spaces and tabs.
+	       (setq line (delete #\tab (delete #\space line)))
+	       (let ((pos 0) name system machine nicknames delim-not-found)
+		 ;; Snarf the machine NAME.
+		 (multiple-value-setq (name pos)
+		     (parse-with-string-delimiter "," line :start pos))
+		 ;; Throw away chaos host numbers.
+		 (setq pos
+		       (nth-value 1 (parse-with-string-delimiter 
+				     (if (char-equal #\( (char line pos))
+					 ")," ",")
+				     line :start pos)))
+		 ;; Throw away status.
+		 (setq pos
+		       (nth-value 1 (parse-with-string-delimiter "," line
+								 :start pos)))
+		 ;; Snarf the system and machine types.
+		 (multiple-value-setq (system pos)
+		     (parse-with-string-delimiter "," line :start pos))
+		 (multiple-value-setq (machine pos delim-not-found)
+		     (parse-with-string-delimiter "," line :start pos))
+		 (when (and (not delim-not-found)
+			    (> (length line) pos))
+		   ;; Snarf the nicknames.
+		   (setq nicknames
+			 (parse-with-string-delimiter* 
+			  ","
+			  (parse-with-string-delimiter "]" line 
+						       :start (1+ pos)))))
+		 (unless (or (equal "" system) (null system))
+		   (when (equal "LISP" system) (setq system machine))
+		   (setq system (intern system 'keyword))
+		   (case system
+		     ;; :vms, :ms-dos, etc are left alone.
+		     ((:mach :unix :unix42) (setq system :unix))
+		     ((:lisp :lispm) (setq system :symbolics))
+		     ((:appaloosa :explorer) (setq system :explorer)))
+		   (setf (physical-host-type name) system)
+		   (dolist (name nicknames)
+		     (setf (physical-host-type name) system))))))))))
+
+(defun host-type (host)
+  "Returns the type of the host. If HOST is a defined logical pathname
+   host (i.e., it has translations), returns :logical. Otherwise checks
+   the physical type of the host. If HOST is NIL, uses the type of the
+   default physical host (the one lisp is running in)."
+  ;; Note that logical hosts have priority over physical hosts...
+  ;; This is a bad situation, since we don't have any way of 
+  ;; distinguishing between host names that are both logical and physical.
+  ;; CLtL2 relies on the convention of naming them differently, but
+  ;; collisions are going to occur. It would be better to have some
+  ;; way of distinguishing the two in a pathname's printed representation.
+  (cond ((multiple-value-bind (ignore present)
+	     (logical-pathname-translations host)
+	   ;; Yet another use for nth-value.
+	   (declare (ignore ignore))
+	   present)
+	 :logical)
+	((physical-host-type host))))
+
+(defun pathname-host-type (pathname)
+  (cond ((typep pathname 'logical-pathname) :logical)
+	((typep pathname 'physical-pathname)
+	 (host-type (physical-pathname-host pathname)))
+	((stringp pathname) (host-type (get-host-string pathname ":")))))
+
+;;; Setup Default Physical Host
+(eval-when (load eval)  ; &&&
+(setf (physical-host-type nil)		; nil is default host
+      (or #+:vms        :vms
+	  #+:explorer   :explorer
+	  #+:symbolics  :symbolics
+	  #+:unix       :unix
+	  #+:hp         :unix
+	  #+:cmu        :unix
+	  :unix				; default. change if necessary
+	  ))
+(setf (physical-host-type "Default")
+      (physical-host-type nil))
+)
+
+;;; ********************************
+;;; Translation Rules **************
+;;; ********************************
+(defstruct translation-rule
+  host-type
+  case					; Default case of pathname
+  char-mappings				; Character substitutions 
+  component-mappings			; String substitutions
+  version-case				; Case for version component
+  type-case				; Case for type component
+  name-case				; Case for name
+  component-case			; Case for directory names
+  )
+
+(defvar *permanent-translation-rules* (make-hash-table :test #'equal)
+  "Hash table of default translation rules for each type of host.")
+
+(defvar *default-translation-rule* (make-translation-rule))
+
+(defmacro define-translation-rule (host-type 
+				   &key case char-mappings component-mappings
+				   version-case
+				   type-case
+				   name-case
+				   component-case)
+  "Defines translation rules for hosts of type host-type.
+   Case may be :unchanged, :upper, :lower, or :capitalize. This provides a
+   default case translation; version-case, type-case, name-case, and
+   component-case will shadow this value if non-nil.
+   Char-mappings is a list of character substitutions which occur in parallel.
+   Component-mappings is a list of string substitutions."
+  ;; Note: Currently there is only one rule per host-type.
+  `(setf (gethash ,host-type *permanent-translation-rules*)
+	 (make-translation-rule :host-type ',host-type 
+				:case ',case
+				:char-mappings ',char-mappings
+				:component-mappings ',component-mappings
+				:version-case ',version-case
+				:type-case ',type-case
+				:name-case ',name-case
+				:component-case ',component-case)))
+
+(defun find-translation-rule (host-type)
+  (or (gethash host-type *permanent-translation-rules*)
+      *default-translation-rule*))
+
+(defun choose-case (rule level)
+  (or (case level
+	(version (translation-rule-version-case rule))
+	(type (translation-rule-type-case rule))
+	(name (translation-rule-name-case rule))
+	(component (translation-rule-component-case rule)))
+      (translation-rule-case rule)))
+
+(defun casify (thing case)
+  (if (stringp thing)
+    (case case
+      (:upper (string-upcase thing))
+      (:lower (string-downcase thing))
+      (:capitalize (string-capitalize thing))
+      (:unchanged thing)
+      (otherwise thing))
+    thing))
+
+(define-translation-rule :vms
+  :case :upper :char-mappings ((#\- #\_)))
+
+(define-translation-rule :unix
+  :case :unchanged ; :lower
+  :type-case :lower
+  )
+
+(define-translation-rule :logical
+  :case :upper
+  :name-case :unchanged)
+
+;;; ********************************
+;;; Canonical Types ****************
+;;; ********************************
+(defvar *default-canonical-types* (make-hash-table :test #'equal)
+  "Alists of canonical types and default surface types.")
+(defvar *canonical-types-alist* (make-hash-table :test #'equal)
+  "Alists of canonical types and surface types for various hosts.")
+
+(defmacro define-canonical (level canonical default  &body specs)
+  "Defines a new canonical type. Level specifies whether it is a 
+   canonical type, version, name, or component. Default is a string
+   containing the default surface type for any kind of host not
+   mentioned explicitly. The body contains a list of specs that define
+   the surface types that indicate the new canonical type for each host.
+   For systems with more than one possible default surface form,
+   the form that appears first becomes the preferred form for the type."
+  `(progn
+     (setf (gethash ',level *default-canonical-types*)
+	   (cons (list ',canonical ',default)
+		 (remove ',canonical 
+			 (gethash ',level *default-canonical-types*)
+			 :key #'car)))
+;     (push (list ',canonical ',default) 
+;	   (gethash ',level *default-canonical-types*))
+     (setf (gethash ',level *canonical-types-alist*)
+	   (cons (list* ',canonical ',specs)
+		 (remove ',canonical 
+			 (gethash ',level *canonical-types-alist*)
+			 :key #'car)))
+;     (push (list* ',canonical ',specs) 
+;	   (gethash ',level *canonical-types-alist*))
+     ))
+
+(defun member-or-eq (x list-or-atom)
+  (cond ((listp list-or-atom) (member x list-or-atom))
+	(t (eq x list-or-atom))))
+
+(defun surface-form (canonical host-type &optional (level 'type))
+  "Given the canonical form of some canonical type, replaces it with
+   the appropriate surface form."
+  (let ((case (choose-case (find-translation-rule host-type) level)))
+    (casify (or (second (assoc host-type
+			       (cdr (assoc canonical
+					   (gethash level 
+						    *canonical-types-alist*)
+					   :test #'equal))
+			       :test #'member-or-eq))
+		(second (assoc canonical
+			       (gethash level *default-canonical-types*)
+			       :test #'equal))
+		canonical)
+	    case)))
+
+(defun canonicalize (surface-form host-type &optional (level 'type))
+  "Given the surface form of some canonical type, replaces it with
+   the appropriate canonical type."
+  (cond ((stringp surface-form)
+	 (or (first (find surface-form (gethash level *canonical-types-alist*)
+			  :key #'cdr
+			  :test #'(lambda (surf alist)
+				    (member surf
+					    (cdr (assoc host-type alist 
+							:test #'member-or-eq))
+					    :test #'string-equal))))
+	     (first (find surface-form 
+			  (gethash level *default-canonical-types*) 
+			  :key #'second :test #'string-equal))
+	     (coerce surface-form 'simple-string)))
+	(t surface-form)))
+
+
+;;; *** Some Sample Types ***
+
+(define-canonical host :default ""
+  (:unix #+:CMU "Mach" "" "Default"))
+
+(define-canonical host "Default" ""
+  (:unix nil "" "Default"))
+
+(define-canonical device :unspecific "")
+
+(define-canonical component :absolute ""
+  (:unix "/")
+  (:symbolics ">")
+  (:logical   "")
+  (:vms       ""))
+(define-canonical component :relative ""
+  (:unix "")
+  (:symbolics "")
+  (:logical   ";")
+  (:vms       "."))
+(define-canonical component :wild "*")
+(define-canonical component :wild-inferiors "**"
+  (:vms ".."))
+
+(define-canonical name :wild "*")
+
+(define-canonical type :unspecific "") ;; null type
+(define-canonical type :wild "*")      ;; wild type
+
+;; uncommented the "L" causes the last Steele example to break, of course.
+(define-canonical type :lisp "LISP" 
+  (:unix-ucb "LISP")
+  (:unix #+(and :sun :kcl :unix) "lsp"
+	 #+ecl "lsp"
+	 "lisp" ; "L" #+:excl "cl"
+)
+  (:vms "LSP" "LISP")
+  ;; (:vms4 "LSP" "LISP")
+  ((:tops-20 :tenex) "LISP" "LSP"))
+
+(define-canonical type :text "TEXT" 
+  (:unix "text" "txt" "tx")
+  (:vms "TXT")
+  ((:tops-20 :tenex) "TXT"))
+
+(define-canonical type :fasl "FASL" 
+  (:unix #+:hp "b"
+	 #+(and :sun :kcl :unix) "o"
+	 #+ecl "o"
+	 #+:cmu "fasl"
+	 "fasl" "bin" "BN")
+  (:vms "FAS" "BIN")
+  (:explorer "XLD")
+  (:symbolics "BIN")
+  ((:tops-20 :tenex) "BIN"))
+
+(define-canonical version :wild "*")
+(define-canonical version :newest "newest")
+
+#|
+;;; Examples:
+<cl> (lp::canonicalize "*" :unix)
+:WILD
+<cl> (lp::surface-form :fasl :unix)
+"fasl"
+<cl> (lp::surface-form :fasl :vms)
+"FAS"
+|#
+
+
+;;; ********************************
+;;; Pathname Defstruct *************
+;;; ********************************
+;;;
+;;; We define a generic physical pathname (physical-pathname defstruct) because
+;;; we have absolutely NO guarrantees about the structure of pathnames.
+;;; Pathnames may be defstructs or classes, and the slots may have arbitrary
+;;; types, especially with respect to the directory slot. Depending on the
+;;; lisp, the directory slot may be a list, vector, simple-vector,
+;;; string, keyword, or nil. If a list or vector, the items in the list
+;;; may be strings, keywords (for canonical types), or nil. The first item
+;;; in the list may or may not be a special keyword (e.g., :relative and
+;;; :absolute). 
+;;;
+;;; The lack of a common interface to pathnames means that any implementation
+;;; of logical pathnames must parse and generate the pathname (namestring)
+;;; formats for a variety of file-servers. We can't simply rely on the
+;;; lisp's implementation of the PATHNAME defstruct, because that does not
+;;; necessarily handle the formats of file-servers of a different type 
+;;; (translations may be in the format of the target file server). Also,
+;;; inconsistency in the implementation of the PATHNAME type means that we
+;;; would have to special case most of the code for each and every lisp.
+;;;
+;;; Instead, we parse the pathnames into a common format (the physical-pathname
+;;; defstruct), from which we generate a namestring in a format acceptable
+;;; to the underlying lisp. The namestring (which is a string in *all* the
+;;; lisps) serves as the interface to the lisp's implementation of pathnames.
+;;;
+;;; As it currently stands, X3J13's spec for logical pathnames tries to 
+;;; accomplish two distinct goals:
+;;;    (1) isolate pathname reference from actual file location (logical
+;;;        as opposed to physical pathnames) 
+;;;    (2) provide a common format for namestring syntax and 
+;;;        pathname structure
+;;; This is trying to accomplish too much within a single framework. Instead,
+;;; the second goal should be decoupled from logical pathnames and made a 
+;;; requirement for pathnames in general. 
+;;;
+;;; In other words, let there be a standard namestring syntax and a fully
+;;; specified structure for physical pathnames (not just logical pathnames).
+;;; This standard should subsume the requirements of all current lisps, and
+;;; the individual lisp implementation should worry about interfacing with
+;;; the file system. There is no good reason why a programmer should have
+;;; to know the peculiarities of a filesystem when writing software. The X3J13
+;;; spec just shoves it under the rug, forcing the programmer to deal with
+;;; it when writing the translations file. 
+;;;
+;;; Because there is no standard for pathnames, we're forced into a situation
+;;; where different lisps running on the same physical host may have
+;;; different namestring syntaxes, so knowing the physical host type is not
+;;; a guarrantee of the pathname syntax. 
+;;;
+(defstruct (physical-pathname
+	    (:conc-name %physical-pathname-)
+	    (:print-function %print-physical-pathname)
+	    (:constructor %make-physical-pathname 
+	     (host device directory name type version))
+	    (:predicate physical-pathnamep))	     
+  "Physical-Pathname is the underlying structure for a pathname."
+  (host nil :type (or null keyword simple-string))
+  (device nil :type (or null keyword simple-string))
+  (directory nil :type (or null simple-vector))
+  (name nil :type (or null keyword simple-string))
+  (type nil :type (or null keyword simple-string))
+  version)
+
+(defun %print-physical-pathname (pname stream depth)
+  (declare (ignore depth))
+  (format stream "#.(physical-pathname ~S)" (physical-namestring pname)))
+
+(defun make-physical-pathname (&key host device directory name type version)
+  (let ((host-type (host-type host)))
+    (when (stringp directory)
+      (setq directory 
+	    (%physical-pathname-directory (parse-generic-namestring directory
+								    host))))
+    (%make-physical-pathname 
+     (canonicalize host host-type 'host)
+     (canonicalize device host-type 'device)
+     directory
+     (canonicalize name host-type 'name)
+     (canonicalize type host-type 'type)
+     (canonicalize version host-type 'version)
+     )))
+
+(defun ensure-physical-pathname (thing)
+  (if (physical-pathnamep thing) thing (physical-pathname thing)))
+
+;;; The following cannot be done by the accessors because the pathname
+;;; arg may be a string.
+
+(defun physical-pathname-host (pathname)
+  "Returns the host of PATHNAME, which may be a string or pathname."
+  (%physical-pathname-host (ensure-physical-pathname pathname)))
+
+(defun physical-pathname-device (pathname)
+  "Returns the device of PATHNAME, which may be a string or pathname."
+  (%physical-pathname-device (ensure-physical-pathname pathname)))
+
+(defun physical-pathname-directory (pathname)
+  "Returns the directory of PATHNAME, which may be a string or pathname."
+  (%physical-pathname-directory (ensure-physical-pathname pathname)))
+
+(defun physical-pathname-name (pathname)
+  "Returns the name of PATHNAME, which may be a string or pathname."
+  (%physical-pathname-name (ensure-physical-pathname pathname)))
+
+(defun physical-pathname-type (pathname)
+  "Returns the type of PATHNAME, which may be a string or pathname."
+  (%physical-pathname-type (ensure-physical-pathname pathname)))
+
+(defun physical-pathname-version (pathname)
+  "Returns the version of PATHNAME, which may be a string or pathname."
+  (%physical-pathname-version (ensure-physical-pathname pathname)))
+
+;;; ********************************
+;;; Logical Pathname Defstruct *****
+;;; ********************************
+(defstruct (logical-pathname
+	    (:include physical-pathname)
+	    (:conc-name %logical-pathname-)
+	    (:print-function %print-logical-pathname)
+	    (:constructor %make-logical-pathname 
+			  (host device directory name type version))
+	    (:predicate logical-pathnamep))	     
+  "Logical-pathname is the underlying structure for a logical pathname.")
+
+(defun %print-logical-pathname (pname stream depth)
+  (declare (ignore depth))
+  (format stream "#.(logical-pathname ~S)" (logical-namestring pname)))
+
+(defun make-logical-pathname (&key host directory name type version)
+  (let ((host-type (host-type host)))
+    (when (stringp directory)
+      (setq directory 
+	    (%logical-pathname-directory (parse-generic-namestring directory
+								   host))))
+    (%make-logical-pathname 
+     (canonicalize host host-type 'host)
+     :unspecific
+     directory
+     (canonicalize name host-type 'name)
+     (canonicalize type host-type 'type)
+     (canonicalize version host-type 'version)
+     )))
+
+(defun ensure-logical-pathname (thing)
+  (if (logical-pathnamep thing) thing (logical-pathname thing)))
+
+;;; The following cannot be done by the accessors because the pathname
+;;; arg may be a string.
+
+(defun logical-pathname-host (logical-pathname)
+  "Returns the logical-pathname-host of LOGICAL-PATHNAME. 
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-host (ensure-logical-pathname logical-pathname)))
+
+(defun logical-pathname-directory (logical-pathname)
+  "Returns the logical-pathname-directory of LOGICAL-PATHNAME.
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-directory (ensure-logical-pathname logical-pathname)))
+
+(defun logical-pathname-name (logical-pathname)
+  "Returns the logical-pathname-name of LOGICAL-PATHNAME. 
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-name (ensure-logical-pathname logical-pathname)))
+
+(defun logical-pathname-type (logical-pathname)
+  "Returns the logical-pathname-type of LOGICAL-PATHNAME. 
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-type (ensure-logical-pathname logical-pathname)))
+
+(defun logical-pathname-version (logical-pathname)
+  "Returns the logical-pathname-type of LOGICAL-PATHNAME. 
+   LOGICAL-PATHNAME may be a string or logical pathname."
+  (%logical-pathname-version (ensure-logical-pathname logical-pathname)))
+
+
+;;; ********************************
+;;; Pathname Namestring Functions **
+;;; ********************************
+(defun logical-namestring (logical-pathname)
+  "Returns the full form of LOGICAL-PATHNAME as a string."
+  (setq logical-pathname (logical-pathname logical-pathname))
+  (let ((host      (%logical-pathname-host logical-pathname))
+	(directory (%logical-pathname-directory logical-pathname))
+	(name      (%logical-pathname-name logical-pathname))
+	(type      (%logical-pathname-type logical-pathname))
+	(version   (%logical-pathname-version logical-pathname))
+	result)
+    (declare (simple-string result))
+    ;; FORMAT would have been easier, but this is faster.
+    (when host
+      (setq result 
+	    (concatenate 'simple-string 
+			 (surface-form host :logical 'host) ":")))
+    (when directory
+      (setq result
+	    (concatenate 'simple-string 
+			 result
+			 (the simple-string (%directory-string directory)))))
+    (when name
+      (setq result
+	    (concatenate 'simple-string
+			 result
+			 (the simple-string (surface-form name :logical 'name)))))
+    (when type
+      (setq result
+	    (concatenate 'simple-string
+			 result "."
+			 (the simple-string (surface-form type :logical 'type)))))
+    (when version
+      (setq result
+	    (concatenate 'simple-string
+			 result "."
+			 (the simple-string
+			      (%version-to-string version)))))
+    result))
+
+(defun %directory-string (dirlist &optional (host-type :logical)
+				  (dir-delim #\;))
+  "Converts a vector of the form #(\"foo\" \"bar\" ... \"baz\") into
+   a string of the form \"foo;bar;...;baz;\""
+  (declare (simple-vector dirlist))
+  (let* ((numdirs (length dirlist))
+	 (length numdirs))
+    (declare (fixnum numdirs length))
+    (dotimes (i numdirs)
+      (let ((component (#+:cmu svref #-:cmu aref dirlist i)))
+	(case component
+	  ;; Do we have to worry about Lucid's :root here???
+	  ((:relative :absolute) 
+	   (incf length
+		 (the fixnum
+		      (1- (length (surface-form component
+						host-type 'component))))))
+	  (otherwise (incf length
+			   (the fixnum
+				(length (surface-form component host-type
+						      'component))))))))
+    (do ((result (make-string length))
+	 (index 0 (1+ index))
+	 (position 0))
+	((= index numdirs) result)
+      (declare (simple-string result))
+      (let* ((component (#+:cmu svref #-:cmu aref dirlist index))
+	     (string (surface-form component host-type 'component))
+	     (len (length string))
+	     (end (+ position len)))
+	(declare (simple-string string)
+		 (fixnum len end))
+	(replace result string :start1 position :end1 end :end2 len)
+	(unless (or (eq component :absolute)(eq component :relative))
+	  (setf (schar result end) dir-delim)
+	  (setq position (+ end 1)))))))
+
+(defun %version-to-string (version &optional (host-type :logical))
+  (cond ((surface-form version host-type 'version))
+	((zerop version) "0")
+	((eql version 1) "1")
+	(t
+	 ;; Using FORMAT would have been easier, but this is faster.
+	 (do* ((len (1+ (truncate (log version 10)))) ; base 10 num digits
+	       (res (make-string len))
+	       (i (1- len) (1- i))
+	       (q version) ; quotient
+	       (r)) ; residue
+	     ((zerop q) ; nothing left
+	      res)
+	   (declare (simple-string res)
+		    (fixnum len i r))
+	   (multiple-value-setq (q r) (truncate q 10))
+	   (setf (schar res i) (schar "0123456789" r))))))
+
+(defun physical-namestring (pathname)
+  ;; needs to get appropriate surface forms
+  (setq pathname (physical-pathname pathname))
+  (let* ((host (%physical-pathname-host pathname))
+	 (host-type (host-type host))
+	(device    (%physical-pathname-device pathname))
+	(directory (coerce (%physical-pathname-directory pathname) 'list))
+	(name      (%physical-pathname-name pathname))
+	(type      (%physical-pathname-type pathname))
+	(version   (%physical-pathname-version pathname))
+	(ptype (pathname-host-type pathname)))
+    (setq host (surface-form host host-type 'host)
+	  name (surface-form name host-type 'name)
+	  type (surface-form type host-type 'type)
+	  version (surface-form version host-type 'version))
+    ;; Does directory need to be mapcar'ed into surface-form?
+    ;; Yes, but we can probably ignore it for now, since the only
+    ;; canonical types defined so far are :wild and :wild-inferiors,
+    ;; which we don't have to support. Probably wouldn't hurt to
+    ;; uncomment this code.
+    ;;(setq directory 
+    ;;      (cons (car directory)
+    ;;            (mapcar #'(lambda (comp)
+    ;;			    (surface-form comp host-type 'component)) 
+    ;;			(cdr directory))))
+    (case ptype
+      (:logical
+       (logical-namestring pathname))
+      (:unix
+       (format nil "~@[~A:~]~A~{~A/~}~@[~A~@[.~A~@[.~A~]~]~]"
+	       host (case (car directory)
+		      (:absolute "/")
+		      (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      (:vms       
+       ;; was "~@[~A:~]~@[~A:~][~A~{~A.~}]~@[~A~@[.~A~@[.~A~]~]~]"
+       ;; which was adding an extra "." to path
+       ;; such as [a.b] => [a.b.]
+       (format nil 
+	       "~@[~A:~]~@[~A:~][~A~{~A~^.~}]~@[~A~@[.~A~@[.~A~]~]~]"
+	       host device (case (car directory)
+			     (:relative ".")
+			     (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      (:explorer
+       (format nil "~@[~A:~]~A~{~A~^.~};~@[~A~@[.~A~@[#~A~]~]~]"
+	       host (case (car directory)
+		      (:relative ".")
+		      (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      (:symbolics
+       (format nil "~@[~A:~]~A~{~A>~}~@[~A~@[.~A~@[.~A~]~]~]"
+	       host (case (car directory)
+		      (:absolute ">")
+		      (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      (otherwise
+       ;; Use UNIX as default.
+       (format nil "~@[~A:~]~A~{~A/~}~@[~A~@[.~A~@[.~A~]~]~]"
+	       host (case (car directory)
+		      (:absolute "/")
+		      (otherwise ""))
+	       (cdr directory)
+	       name type version))
+      )))
+
+;;; ********************************
+;;; Pathname Parsing Functions *****
+;;; ********************************
+(defun logical-pathname (thing &optional host)
+  "Converts THING to a logical pathname and returns it. THING may be
+   a logical pathname, a logical pathname namestring containing a 
+   host component, or a stream for which the pathname function returns
+   a logical pathname."
+  (etypecase thing
+    (string
+     (values (parse-generic-namestring thing host
+				       *default-pathname-defaults* 
+				       :force-logical t)))
+    (physical-pathname thing)
+    (logical-pathname thing)
+    #+:CMU(stream           (logical-pathname (lisp::file-name thing) host))))
+
+(defun physical-pathname (thing &optional host)
+  "Converts THING to a physical-pathname and returns it. THING may be
+   a pathname, a pathname namestring containing a 
+   host component, or a stream for which the file-name function returns
+   a pathname."
+  (typecase thing
+    (string           (values (parse-generic-namestring thing host)))
+    (logical-pathname thing)
+    (physical-pathname thing)
+    #+:CMU(stream           (physical-pathname (lisp::file-name thing) host))))
+
+(defun parse-generic-namestring (thing &optional host
+				       (defaults *default-pathname-defaults*)
+				       &key (start 0) end junk-allowed
+				       force-logical)
+  "Convert namestring into a pathname."
+  (declare (ignore junk-allowed))
+  (unless end (setf end (length thing)))
+  (let ((host-string (get-host-string thing ":"))
+	host-type)
+    (unless host-string (setq host-string host))
+    (when (and host host-string (not (string-equal host host-string)))
+      (cerror "Ignore it."
+	      "Host mismatch in ~S: ~S isn't ~S"
+	      'parse-generic-namestring
+	      host-string
+	      host))
+    (if force-logical
+	(setq host-type :logical)
+      (setq host-type (host-type host-string)))
+    (if host-type
+	(multiple-value-bind (parsed-host device directory name type version)
+	    (do-generic-pathname-parse thing host-type start end)
+	  (let ((defaults-p (and (typep defaults 'physical-pathname)
+				 (equal host-type
+					(pathname-host-type defaults)))))
+	    (values
+	     (case host-type
+	       (:logical
+		(make-logical-pathname 
+		 :host	(or parsed-host host
+			    (and defaults-p (logical-pathname-host defaults))
+;			    (when directory "Default")
+			    )
+		 :directory (or directory
+				(and defaults-p
+				     (logical-pathname-directory defaults)))
+		 :name      (or name
+				(and defaults-p
+				     (logical-pathname-name defaults)))
+		 :type      (or type
+				(and defaults-p
+				     (logical-pathname-type defaults)))
+		 :version   (or version
+				(and defaults-p
+				     (logical-pathname-version defaults)))))
+	       (otherwise 
+		(make-physical-pathname 
+		 :host	(or parsed-host host
+			    (and defaults-p (physical-pathname-host defaults))
+;			    (when directory "Default")
+			    )
+		 :device    (or device
+				(and defaults-p
+				     (physical-pathname-device defaults)))
+		 :directory (or directory
+				(and defaults-p
+				     (physical-pathname-directory defaults)))
+		 :name      (or name
+				(and defaults-p
+				     (physical-pathname-name defaults)))
+		 :type      (or type
+				(and defaults-p
+				     (physical-pathname-type defaults)))
+		 :version   (or version
+				(and defaults-p
+				     (physical-pathname-version defaults))))))
+	     end)))
+	;; Unknown host type, wing it with parse-namestring.
+      (when thing
+	(lisp:parse-namestring thing host defaults 
+			       :start start :end end)))))
+
+;;; ********************************
+;;; Parse Physical Pathnames *******
+;;; ********************************
+(defun do-generic-pathname-parse (string host-type &optional (start 0) end)
+  "Splits string into a logical host, a vector of directories, a file name,
+   a file type, and a file version."
+  (declare (simple-string string))
+  (case host-type
+    (:logical
+     ;; Parses Logical Pathnames of the following format:
+     ;;     host:dir1;dir2;name.type.version
+     (parse-generic-pathname string start end ":" nil ";" "." "." "."))
+    (:unix
+     ;; Parses Unix pathnames of the following format:
+     ;;     host:/dir1/dir2/*/name.type.version 
+     (parse-generic-pathname string start end ":" t "/" "." "." "."))
+    (:symbolics 
+     ;; Parses Symbolics Pathnames of the following format:
+     ;;     host:>dir1>dir2>**>name.type.version
+     (parse-generic-pathname string start end ":" t ">" "." "." "."))
+    (:vms       (parse-vms-pathname string start end))
+    (:explorer  (parse-explorer-pathname string start end))
+    (otherwise  (warn "~&PARSE-~A-PATHNAME not yet implemented.~%" host-type)
+		nil)))
+
+(defun parse-generic-pathname (string &optional (start 0) end
+				      (host-delim ":")(lead-is-abs t)
+				      (dir-delim "/")
+				      (name-delim ".")(type-delim ".")
+				      (version-delim "."))
+  "Splits string into a host, vector of directories, a file name, type,
+   and version. Parses generic pathnames."
+  (declare (simple-string string))
+  (setq end (or end (length string)))
+  (let (host a-vs-r directories name type version host-type)
+    (multiple-value-setq (host start)
+	(get-host-string string host-delim start end))
+    (setq host-type (host-type host))
+    ;; Absolute vs. Relative
+    (cond ((and (not (string-equal string "" :start1 start))
+		(char= (char dir-delim 0) (char string start))) 
+	   (setq a-vs-r (if lead-is-abs :absolute :relative))
+	   (incf start))
+	  (t (setq a-vs-r (if lead-is-abs :relative :absolute))))
+    ;; Split off the components
+    (multiple-value-bind (dirs new-start)
+	(parse-with-string-delimiter* dir-delim string :start start :end end)
+      (setq directories
+	    (cons a-vs-r 
+		  (mapcar #'(lambda (dir)
+			      (canonicalize dir host-type 'component))
+			  dirs))
+	    start new-start))
+    ;; Split off the name, type, and version
+    (when (< start end)
+      (multiple-value-setq (name start)
+	  (parse-with-string-delimiter name-delim string
+				       :start start :end end))
+      (when (< start end)
+	(multiple-value-setq (type start)
+	    (parse-with-string-delimiter type-delim string
+					 :start start :end end))
+	(when (< start end)
+	  (multiple-value-setq (version start)
+	      (parse-with-string-delimiter version-delim string
+					   :start start :end end)))))
+    ;; Return the values
+    (values host
+	    :unspecific
+	    (when (or host directories)
+	      (coerce directories 'vector))
+	    name
+	    type
+	    version
+	    ;; This last is the remaining cruft. Should be nil.
+	    (when (< start end) (subseq string start end)))))
+
+(defun parse-vms-pathname (string &optional (start 0) end)
+  "Splits string into a host, vector of directories, a file name, type,
+   and version. Parses VMS pathnames of the following formats:
+       host::device:[dir1.dir2...]name.type;version
+       host::device:<dir1.dir2...>name.type.version
+       host:device:<dir1.dir2...>name.type.version &c
+   .. = :wild-inferiors"
+  (declare (simple-string string))
+  (setq end (or end (length string)))
+  (let (host device a-vs-r (directories "") name type version)
+    (multiple-value-bind (new-host new-start)
+	(get-host-string string "::" start end)
+      (if new-host
+	  (setq host new-host start new-start)
+	  (multiple-value-setq (host start) (get-host-string string ":" start end))))
+    (multiple-value-setq (device start)	(get-host-string string ":" start end))
+    (when (plusp (length string))
+      (case (char string start)
+	(#\[  (multiple-value-setq (directories start)
+		  (parse-with-string-delimiter "]" string 
+					       :start (1+ start) :end end)))
+	(#\<  (multiple-value-setq (directories start)
+		  (parse-with-string-delimiter ">" string 
+					       :start (1+ start) :end end)))))
+    ;; Absolute vs. Relative
+    (cond ((and (not (zerop (length directories)))
+		(char= #\. (char directories 0)))
+	   (setq a-vs-r :relative))
+	  (t (setq a-vs-r :absolute)))
+    ;; Split off the components
+    (multiple-value-bind (dirs)
+	(parse-with-string-delimiter* "." directories 
+				      :start (if (eq a-vs-r :relative) 1 0)
+				      :include-last t) ; <<< fix
+      (let ((last2 (when (> (length dirs) 1)
+		     (nthcdr (- (length dirs) 2) dirs))))
+	(when (equal last2 '(nil nil))
+	  (rplaca last2 "..")
+	  (rplacd last2 nil)))
+      (setq directories
+	    (cons a-vs-r 
+		  (mapcar #'(lambda (dir) (canonicalize dir :vms 'component))
+			  dirs))))
+    ;; Split off the name, type, and version
+    (when (< start end)
+      (multiple-value-setq (name start)
+	  (parse-with-string-delimiter "." string :start start :end end))
+      (when (< start end)
+	(multiple-value-bind (new-type new-start delim-not-found)
+	    (parse-with-string-delimiter ";" string :start start :end end)
+	  (cond (delim-not-found
+		 (multiple-value-setq (type start)
+		     (parse-with-string-delimiter "." string
+						  :start start :end end)))
+		(t
+		 (setq type new-type start new-start))))
+	(when (< start end)
+	  (multiple-value-setq (version start)
+	      (parse-with-string-delimiter "." string :start start :end end)))))
+    ;; Return the values
+    (values host
+	    device
+	    (when (or host directories)
+	      (coerce directories 'vector))
+	    name
+	    type
+	    version
+	    ;; This last is the remaining cruft. Should be nil.
+	    (when (< start end) (subseq string start end)))))
+
+(defun parse-explorer-pathname (string &optional (start 0) end)
+  "Splits string into a host, vector of directories, a file name, type,
+   and version. Parses TI Explorer pathnames of the following format:
+       host:dir1.dir2...;name.type#version"
+  (declare (simple-string string))
+  (setq end (or end (length string)))
+  (let (host a-vs-r (directories "") name type version)
+    (multiple-value-setq (host start)
+	(get-host-string string ":" start end))
+    (multiple-value-setq (directories start)
+	(parse-with-string-delimiter ";" string 
+				     :start start :end end))
+    ;; Absolute vs. Relative
+    (cond ((and (not (zerop (length directories)))
+		(char= #\. (char directories 0)))
+	   (setq a-vs-r :relative))
+	  (t (setq a-vs-r :absolute)))
+    ;; Split off the components
+    (multiple-value-bind (dirs)
+	(parse-with-string-delimiter* "." directories 
+				      :start (if (eq a-vs-r :relative) 1 0)
+				      :end nil :include-last t)
+
+      (setq directories
+	    (cons a-vs-r 
+		  (mapcar #'(lambda (dir)
+			      (canonicalize dir :explorer 'component))
+			  dirs))))
+    ;; Split off the name, type, and version
+    (when (< start end)
+      (multiple-value-bind (new-name new-start delim-not-found)
+	  (parse-with-string-delimiter "." string :start start :end end)
+	(when (not delim-not-found)
+	  (setq name new-name start new-start)))
+      (when (< start end)
+	(multiple-value-setq (type start)
+	    (parse-with-string-delimiter "#" string :start start :end end))
+	(when (< start end)
+	  (multiple-value-setq (version start)
+	      (parse-with-string-delimiter "." string :start start :end end)))))
+    ;; Return the values
+    (values host
+	    :unspecific
+	    (when (or host directories)
+	      (coerce directories 'vector))
+	    name
+	    type
+	    version
+	    ;; This last is the remaining cruft. Should be nil.
+	    (when (< start end) (subseq string start end)))))
+
+
+;;; ********************************
+;;; Convert Generic Pathnames ******
+;;; ********************************
+;;; Converts a generic pathname to a format for standard lisp functions.
+
+(defvar *translation-output* :namestring
+  "Specifies whether the output of translate-logical-pathname
+   should be a :namestring or a :pathname made with lisp:make-pathname,
+   or :as-is.")
+
+(defconstant directory-structure-type ; &&&
+  #+:CMU 'simple-vector
+  #+:lispm 'list
+  #+:kcl   'list
+  #+:ecl   'list
+  #+:hp    'list
+  #-(or :cmu :lispm :kcl :ecl :hp)
+  (cond ((string-equal (lisp-implementation-type) "VAX LISP") 'list)
+	(t 'list)))
+
+(defun convert-generic-pathname (pathname 
+				 &optional (output-type *translation-output*))
+  (when pathname
+    (case output-type 
+      (:namestring        (physical-namestring pathname))
+      (:pathname
+       (let ((host       (%physical-pathname-host pathname))
+	     (device     (%physical-pathname-device pathname))
+	     (directory  (coerce (%physical-pathname-directory pathname)
+				 'list))
+	     (name       (%physical-pathname-name pathname))
+	     (type       (%physical-pathname-type pathname))
+	     (version    (%physical-pathname-version pathname))
+	     (target-host-type  (host-type nil))
+	     a-vs-r)
+	 ;; Handle :absolute/:relative crap.
+	 (setq a-vs-r (pop directory))
+	 (case a-vs-r
+	   (:absolute
+	    #+:cmu (setf device :absolute)
+	    #+(and :sun :kcl :unix) (setq a-vs-r :root)
+	    #+ecl (setq a-vs-r :root))
+	   (:relative
+	    #+:cmu (setf device "Default")))
+	 ;; Reverse canonicalizations
+	 (setq host (surface-form host target-host-type 'host)
+	       directory (mapcar #'(lambda (dir)
+				     (surface-form dir target-host-type
+						   'component))
+				 directory)
+	       name (surface-form name target-host-type 'name)
+	       type (surface-form type target-host-type 'type)
+	       version (surface-form version target-host-type 'version))
+	 ;; Fixup Host
+	 #+:cmu (setf host "Mach")
+	 ;; Fixup Directory
+	 #-:cmu (push a-vs-r directory)
+	 (setq directory (coerce directory directory-structure-type))
+       
+	 (when (string-equal (lisp-implementation-type) "VAX LISP")
+	   (setq directory
+		 (cond ((stringp directory) directory)
+		       ((eq (car directory) :absolute)
+			(format nil "[~{~A~^.~}]" (cdr directory)))
+		       ((eq (car directory) :relative)
+			(format nil "[.~{~A~^.~}]" (cdr directory)))
+		       (t (format nil "[~{~A~^.~}]" directory)))))
+
+	 ;; Return the new pathname
+	 (make-pathname :host host :device device :directory directory
+			:name name :type type :version version)
+	 ))
+      (otherwise pathname)))) 
+
+
+;;; ********************************
+;;; Translate Logical Pathnames ****
+;;; ********************************
+(defvar *circularity-check-table* (make-hash-table :test #'equal)
+  "This table is used to prevent infinite circular loops in the logical
+   pathname resolution. If a pathname's entry in this table is set
+   to T, it has already been \"seen\". Seeing such a pathname twice
+   is an error.")
+
+(defun translate-logical-pathname (logical-pathname
+				   &optional
+				   (output-format *translation-output*))
+  "Translates a logical pathname to the corresponding physical pathname.
+   The pathname argument is first coerced to a logical pathname [this 
+   should really be pathname, but for that we'd have to redefine
+   make-pathname and friends to check whether the host is a logical host].
+   If the coerced argument is a logical pathname, the first matching
+   translation (according to LOGICAL-PATHNAME-MATCH-P) of the logical pathname
+   host is applied, as if by calling TRANSLATE-LOGICAL-PATHNAME-AUX.
+   If the result is a logical pathname, this process is repeated. 
+   When the result is finally a physical pathname, it is returned. If no 
+   translation matches a logical pathname, or the resolution process loops,
+   an error is signaled.
+
+   TRANSLATE-LOGICAL-PATHNAME may perform additional translations,  
+   to provide translation of file types to local naming conventions, to
+   accommodate physical file systems with names of limited length, or to
+   deal with special character requirements such as translating hyphens
+   to underscores or uppercase letters to lowercase."
+
+  ;; Ensure that it is a logical pathname
+  (setq logical-pathname (logical-pathname logical-pathname))
+  (when (typep logical-pathname 'logical-pathname)
+    ;; To prevent circular loops...
+    (let ((namestring (logical-namestring logical-pathname)))
+      (setf (gethash namestring *circularity-check-table*) T))
+    (unwind-protect
+	(resolve-logical-pathname logical-pathname output-format)
+      (clrhash *circularity-check-table*))))
+
+(defun resolve-logical-pathname (logical-pathname 
+				 &optional
+				 (output-format *translation-output*))
+  "Resolve the logical pathname into a physical pathname using the
+   translations table."
+  (let ((logical-host (logical-pathname-host logical-pathname)))
+    (if logical-host
+	(let ((translated-pathname 
+	       (map-logical-pathname logical-pathname logical-host
+				     output-format)))
+	  (if translated-pathname
+	      (or (when (eq (pathname-host-type translated-pathname) :logical)
+		    ;; If the translation is itself a logical pathname,
+		    ;; repeat the process until a physical pathname is reached.
+		    (check-logical-pathname translated-pathname)
+		    (resolve-logical-pathname translated-pathname 
+					      output-format))
+		  translated-pathname)
+	      (error "No translation mapping for ~S." logical-pathname)))
+	(error "No such logical host in ~S:." logical-pathname))))
+
+(defun check-logical-pathname (pathname)
+  "Ensure that there are no cycles in the translations."
+  (let ((namestring (logical-namestring pathname)))
+    (if (gethash namestring *circularity-check-table*) 
+	(error "Circularity in translations for ~S." namestring)
+	(setf (gethash namestring *circularity-check-table*) T))))
+
+(defun map-logical-pathname (logical-pathname 
+			     host
+			     &optional (output-format *translation-output*))
+  "Find and execute the first matching translation."
+  (dolist (translation (logical-pathname-translations host))
+    (let ((from-pathname (logical-pathname (car translation) host))
+	  (to-pathname   (cadr translation)))
+      (when (logical-pathname-match-p logical-pathname from-pathname)
+	(return (translate-logical-pathname-aux logical-pathname
+						from-pathname
+						to-pathname
+						output-format))))))
+
+(defun logical-pathname-match-p (logical-pathname from-pathname)
+  "Return T if the logical pathname matches the test pathname."
+  (setq logical-pathname (logical-pathname logical-pathname)
+	from-pathname (logical-pathname from-pathname))
+  ;; ignore host. Match directories. Match name. Match type. Match version.
+  (and (match-directories (logical-pathname-directory from-pathname)
+			  (logical-pathname-directory logical-pathname))
+       (match-wildcard-word (logical-pathname-name from-pathname)
+			    (logical-pathname-name logical-pathname))
+       (match-wildcard-word (logical-pathname-type from-pathname)
+			    (logical-pathname-type logical-pathname))
+       (match-wildcard-word (logical-pathname-version from-pathname)
+			    (logical-pathname-version logical-pathname))))  
+
+(defun translate-logical-pathname-aux (logical-pathname 
+				       from-pathname to-pathname
+				       &optional
+				       (output-format *translation-output*))
+  "Translates the logical pathname using the substitution specified by
+   a particular translation."
+  (let* ((host (physical-pathname-host to-pathname))
+	 (host-type (host-type host))
+	 (translation-rule (find-translation-rule host-type))
+	 (char-map (translation-rule-char-mappings translation-rule))
+	 (string-map (translation-rule-component-mappings translation-rule)))
+    (let ((device (physical-pathname-device to-pathname))
+	  (directories (map-directories
+			(physical-pathname-directory logical-pathname)
+			(physical-pathname-directory from-pathname)
+			(physical-pathname-directory to-pathname)
+			*null-vector* 0 0 0
+			(choose-case translation-rule 'component)
+			char-map string-map))
+	  (name (map-wildcard-word (physical-pathname-name logical-pathname)
+				   (physical-pathname-name from-pathname)
+				   (physical-pathname-name to-pathname)
+				   (choose-case translation-rule 'name)
+				   char-map string-map))
+	  (type (map-wildcard-word (physical-pathname-type logical-pathname)
+				   (physical-pathname-type from-pathname)
+				   (physical-pathname-type to-pathname)
+				   (choose-case translation-rule 'type)
+				   char-map string-map))
+	  (version (map-wildcard-word (physical-pathname-version logical-pathname)
+				      (physical-pathname-version from-pathname)
+				      (physical-pathname-version to-pathname)
+				      (choose-case translation-rule 'version)
+				      char-map string-map)))
+      (cond ((eq (pathname-host-type to-pathname) :logical)
+	     (make-logical-pathname :host host 
+				    :directory directories
+				    :name name
+				    :type type
+				    :version version))
+	    (t 
+	     (convert-generic-pathname 
+	      (make-physical-pathname :host host 
+				      :device device
+				      :directory directories
+				      :name name
+				      :type type
+				      :version version)
+	      output-format))))))
+
+;;; ********************************
+;;; Match and Map Wildcards ********
+;;; ********************************
+(defun wildcard-wordp (string)
+  (find #\* string))
+
+(defun must-match (thing)
+  (or (eq thing :wild)
+      (and (stringp thing)
+	   (wildcard-wordp thing))))
+
+(defun match-wildcard-word (template string)
+  ;; "*" standalone (:wild) is treated differently from "*" within
+  ;; a word.
+  (or (eq template :wild)
+      (null template)
+      (and (stringp string) (stringp template)
+	   (match-strings template string))
+      ;; e.g., :absolute :absolute
+      (eq template string)))
+
+(defun match-strings (template string &optional (t-start 0) (s-start 0))
+  (let* ((t-length (length template))
+	 (s-length (length string))
+	 (t-at-end (= t-length t-start))
+	 (s-at-end (= s-length s-start)))
+    (cond ((or t-at-end s-at-end) 	; if at end of template or string
+	   (and t-at-end s-at-end))     ; both must be at the end.
+	  ((char= #\* (char template t-start))
+	   (or (match-strings template string (1+ t-start) s-start)
+	       (match-strings template string t-start (1+ s-start))
+	       (match-strings template string (1+ t-start) (1+ s-start))))
+	  ((char-equal (char template t-start)
+		  (char string s-start)) ; includes * against *
+	   (match-strings template string (1+ t-start) (1+ s-start))))))
+
+(defun match-directories (template dirs &optional (t-start 0) (d-start 0))
+  (let* ((t-length (length template))
+	 (d-length (length dirs))
+	 (t-at-end (= t-length t-start))
+	 (d-at-end (= d-length d-start)))
+    (cond ((or t-at-end d-at-end)
+	   (and t-at-end d-at-end))
+	  ((eq (#+:cmu svref #-:cmu aref template t-start) :wild-inferiors)
+	   ;; :wild-inferiors matches any number of components, including
+	   ;; zero. First try skipping over the :wild-inferiors. If that fails,
+	   ;; try matching against one component without skipping over the
+	   ;; :wild-inferiors. Finally, try matching against one component
+	   ;; while skipping over the :wild-inferiors (the latter really
+	   ;; isn't necessary, since the first 2 cases include it).
+	   (or (match-directories template dirs (1+ t-start) d-start)
+	       (match-directories template dirs t-start (1+ d-start))
+	       (match-directories template dirs (1+ t-start) (1+ d-start))))
+	  ((match-wildcard-word (#+:cmu svref #-:cmu aref template t-start)
+				(#+:cmu svref #-:cmu aref dirs d-start))
+	   (match-directories template dirs (1+ t-start) (1+ d-start))))))
+
+(defun map-wildcard-word (string source target 
+				 &optional case char-mappings string-mappings)
+  (let ((result
+	 (cond ((and (stringp target)
+		     (not (wildcard-wordp target)))
+		;; If the target pattern does not contain *, copy the target
+		;; pattern component literally to the target instance.
+		target)
+	       ((or (eq target :wild) (null target))
+		;; If the target pattern is :wild, copy the source string
+		;; component to the target string literally with no further
+		;; analysis. This holds even for the type, which is 
+		;; represented internally in terms of canonical types,
+		;; and is "translated" when realized for the new host.
+		string)
+	       ((not (stringp target))
+		target)
+	       ((eq source :wild)
+		(map-strings string string target))
+	       (t (map-strings string source target)))))
+    (when (stringp result)
+      (setq result 
+	    (casify (parallel-substitute char-mappings
+					 (name-substitution string-mappings 
+							    result))
+		    case)))
+    result))
+
+(defun map-strings (string source target
+			   &optional (result "")
+			   (s-start 0) (st-start 0) (tt-start 0))
+  (let* ((s-length (length string))
+	 (st-length (length source))
+	 (tt-length (length target))
+	 (s-at-end (= s-length s-start))
+	 (st-at-end (= st-length st-start))
+	 (tt-at-end (= tt-length tt-start)))
+    (cond ((or s-at-end st-at-end)
+	   ;; When not enough matching values are available due to too few
+	   ;; * in the source pattern, use the null string as the matching
+	   ;; value for any * remaining in the target.
+	   (when (and s-at-end st-at-end)
+	     (concatenate 'simple-string 
+			  result
+			  (delete #\* (subseq target tt-start)))))
+	  (tt-at-end
+	   ;; When the source pattern has too many *, ignore the first
+	   ;; extra * and everything following it.
+	   result)
+	  ((char= #\* (char target tt-start))
+	   ;; Replace * in target pattern with the contents of the source
+	   ;; string specified by the next * in the source pattern.
+	   (cond ((char= #\* (char source st-start))
+		  (or (map-strings string source target result 
+				   s-start (1+ st-start) (1+ tt-start))
+		      (map-strings string source target 
+				   (concatenate 'simple-string result
+						(subseq string s-start 
+							(1+ s-start)))
+				   (1+ s-start) st-start tt-start)))
+		 ((char-equal (char source st-start) ; was char=
+			      (char string s-start))
+		  (map-strings string source target result 
+			       (1+ s-start) (1+ st-start) tt-start))))
+	  (t;; copy literal strings as is from the target
+	   (let ((next-* (position #\* target :start tt-start)))
+	     (if next-*
+		 (map-strings string source target
+			      (concatenate 'simple-string result
+					   (subseq target tt-start next-*))
+			      s-start st-start next-*)
+		 (when (match-strings source string st-start s-start)
+		   (concatenate 'simple-string
+				result (subseq target tt-start)))))))))
+
+(defun map-directories (dirs source target 
+			     &optional (result *null-vector*)
+			     (d-start 0) (s-start 0) (t-start 0)
+			     case char-map string-map)
+  (let* ((d-length (length dirs))
+	 (s-length (length source))
+	 (t-length (length target))
+	 (d-at-end (= d-length d-start))
+	 (s-at-end (= s-length s-start))
+	 (t-at-end (= t-length t-start)))
+    (cond ((or d-at-end s-at-end)
+	   (when (and d-at-end s-at-end)
+	     (concatenate 'simple-vector result
+			  (map 'simple-vector 
+			       #'(lambda (x) 
+				   (map-wildcard-word 
+				    "" "" x
+				    case char-map string-map))
+			       (delete :wild-inferiors 
+				       (subseq target t-start))))))
+	  (t-at-end
+	   (when (match-directories source dirs s-start d-start)
+	     result))
+	  ((eq :wild-inferiors (#+:cmu svref #-:cmu aref target t-start))
+	   (cond ((eq :wild-inferiors (#+:cmu svref
+				       #-:cmu aref source s-start))
+		  (or (map-directories dirs source target result
+				       d-start (1+ s-start) (1+ t-start)
+				       case char-map string-map)
+		      (map-directories dirs source target 
+				       (concatenate 'simple-vector result
+						    (list (map-wildcard-word
+							   (#+:cmu svref 
+							    #-:cmu aref
+							    dirs d-start)
+							   :wild :wild
+							   case char-map
+							   string-map)))
+				       (1+ d-start) s-start t-start
+				       case char-map string-map)
+		      (map-directories dirs source target 
+				       (concatenate 'simple-vector result
+						    (list (map-wildcard-word
+							   (#+:cmu svref 
+							    #-:cmu aref
+							    dirs d-start)
+							   :wild :wild
+							   case char-map
+							   string-map)))
+				       (1+ d-start) (1+ s-start) (1+ t-start)
+				       case char-map string-map)))
+		 ((string-equal (#+:cmu svref #-:cmu aref dirs d-start)
+				(#+:cmu svref #-:cmu aref source s-start))
+		  (map-directories dirs source target result
+				   (1+ d-start) (1+ s-start) t-start
+				   case char-map string-map))))
+	  ((must-match (#+:cmu svref #-:cmu aref target t-start))
+	   (cond ((must-match (#+:cmu svref #-:cmu aref source s-start))
+		  (map-directories dirs source target
+				   (concatenate 'simple-vector result
+						(list (map-wildcard-word 
+						 (#+:cmu svref 
+						  #-:cmu aref dirs d-start)
+						 (#+:cmu svref
+						  #-:cmu aref source s-start)
+						 (#+:cmu svref
+						  #-:cmu aref target t-start)
+						 case char-map string-map)))
+				   (1+ d-start) (1+ s-start) (1+ t-start)
+				   case char-map string-map))
+		 ((string-equal (#+:cmu svref #-:cmu aref dirs d-start)
+				(#+:cmu svref #-:cmu aref source s-start))
+		  (map-directories dirs source target result
+				   (1+ d-start) (1+ s-start) t-start
+				   case char-map string-map))))
+	  (t
+	   (map-directories dirs source target
+			    (concatenate 'simple-vector result
+					 (list
+					  (map-wildcard-word
+					   (#+:cmu svref 
+						   #-:cmu aref target t-start)
+					   :wild :wild
+					   case char-map
+					   string-map)))
+			    d-start s-start (1+ t-start)
+			    case char-map string-map)))))
+
+
+;;; ********************************
+;;; Common Lisp Redefinitions ******
+;;; ********************************
+;;; Not doing merge-pathnames or with-open-file. Parse-namestring not
+;;; really done well.
+
+;;; append-directories
+(defun append-logical-directories (absolute-dir relative-dir)
+  (when (or absolute-dir relative-dir)
+    (setq absolute-dir (logical-pathname (or absolute-dir ""))
+	  relative-dir (logical-pathname (or relative-dir "")))
+    (logical-namestring 
+     (make-logical-pathname
+      :host (or (logical-pathname-host absolute-dir)
+		(logical-pathname-host relative-dir))
+      :directory (concatenate 'simple-vector
+			      (logical-pathname-directory absolute-dir)
+			      (cdr (coerce (logical-pathname-directory
+					    relative-dir)
+					   'list)))
+      :name (or (logical-pathname-name absolute-dir)
+		(logical-pathname-name relative-dir))
+      :type (or (logical-pathname-type absolute-dir)
+		(logical-pathname-type relative-dir))
+      :version (or (logical-pathname-version absolute-dir)
+		   (logical-pathname-version relative-dir))))))
+	  
+(eval-when (compile load eval)
+(defun real-filename (filename)
+  (if (and filename
+	   (eq (pathname-host-type filename) :logical))
+      (translate-logical-pathname filename :namestring)
+      filename))
+
+#|
+(defmacro convert-file-function (name &optional optionalp)
+  (let ((old-name (intern (concatenate 'string "OLD-" (string name)))))
+    `(unless (fboundp ',old-name)
+	     (setf (symbol-function ',old-name)(symbol-function ',name))
+	     (setf (symbol-function ',name)
+		   #'(lambda ,(if optionalp 
+				  '(&optional filename &rest args)
+				'(filename &rest args))
+		       (apply #',old-name (real-filename filename) args))))))
+|#
+
+(defmacro convert-file-function (name &optional optionalp)
+  (let ((old-name (intern (concatenate 'string "OLD-" (string name)))))
+    `(unless (fboundp ',old-name)
+       ;; Yes, some lisps will give compiler warnings about OLD-name
+       ;; not being declared or defined as a function. But what can
+       ;; we do, with most lisps not yet recognizing CLtL2's ftype
+       ;; declaration?
+       (setf (symbol-function ',old-name)(symbol-function ',name))
+       (setf (symbol-function ',name)
+	     #'(lambda ,(if optionalp 
+			    '(&optional filename &rest args)
+			  '(filename &rest args))
+		 ,(if optionalp
+		      `(if filename
+			   (apply #',old-name (real-filename filename) args)
+			 (,old-name)) ; instead of (funcall #',old-name)
+		    `(apply #',old-name (real-filename filename) args)))))))
+
+(defmacro convert-file-function-2-args (name)
+  (let ((old-name (intern (concatenate 'string "OLD-" (string name)))))
+    `(unless (fboundp ',old-name)
+       (setf (symbol-function ',old-name)(symbol-function ',name))
+       (setf (symbol-function ',name)
+	     #'(lambda (filename1 filename2 &rest args)
+		 (apply #',old-name
+			(real-filename filename1)(real-filename filename2)
+			args))))))
+)
+
+(convert-file-function lisp::load)
+(convert-file-function lisp::open)
+(convert-file-function lisp::probe-file)
+(convert-file-function lisp::delete-file)
+(convert-file-function lisp::truename)
+(convert-file-function lisp::directory)
+(convert-file-function lisp::dribble t)
+(convert-file-function lisp::ed t)
+(convert-file-function lisp::file-author)
+(convert-file-function lisp::file-write-date)
+
+(convert-file-function-2-args lisp::rename-file)
+;; should take care of :output-file as well
+(convert-file-function lisp::compile-file)			  
+
+(unless (fboundp 'old-parse-namestring)
+  (setf (symbol-function 'old-parse-namestring)
+	(symbol-function 'lisp::parse-namestring))
+  (defun lisp::parse-namestring (thing &optional host
+				       (defaults *default-pathname-defaults*)
+				       &key (start 0) end junk-allowed)
+    "Convert THING (string, symbol, pathname, or stream) into a pathname."
+    (declare (ignore junk-allowed))
+    (cond ((null thing) nil) ; try to fix bug with (ed). probably not here.
+	  ((or (eq (pathname-host-type thing) :logical)
+	       (eq (pathname-host-type defaults) :logical)
+	       (eq (host-type host) :logical))
+	   ;; Tis a logical pathname
+	   (parse-generic-namestring thing host defaults 
+				     :start start :end end))
+	  (t (if end
+		 (funcall 'old-parse-namestring thing host defaults 
+			  :start start :end end)
+		 (funcall 'old-parse-namestring thing host defaults 
+			  :start start))))))
+
+;;; *EOF*
diff --git a/contrib/make.lsp b/contrib/make.lsp
new file mode 100644
index 000000000..5843149be
--- /dev/null
+++ b/contrib/make.lsp
@@ -0,0 +1,2730 @@
+;;; -*- Mode: LISP; Syntax: Common-Lisp -*-
+;;; Wed May 22 19:33:59 1991 by Mark Kantrowitz <mkant@GLINDA.OZ.CS.CMU.EDU>
+;;; defsystem.lisp
+ 
+;;; ********************************************************************
+;;; Portable Mini-DefSystem ********************************************
+;;; ********************************************************************
+
+;;; This is a portable system definition facility for Common Lisp. 
+;;; Though home-grown, the syntax was inspired by fond memories of the
+;;; defsystem facility on Symbolics 3600's. The exhaustive lists of
+;;; filename extensions for various lisps and the idea to have one
+;;; "operate-on-system" function instead of separate "compile-system"
+;;; and "load-system" functions were taken from Xerox Corp.'s PCL 
+;;; system.
+
+;;; This system improves on both PCL and Symbolics defsystem utilities
+;;; by performing a topological sort of the graph of file-dependency 
+;;; constraints. Thus, the components of the system need not be listed
+;;; in any special order, because the defsystem command reorganizes them
+;;; based on their constraints. It includes all the standard bells and
+;;; whistles, such as not recompiling a binary file that is up to date
+;;; (unless the user specifies that all files should be recompiled).
+
+;;; Written by Mark Kantrowitz, School of Computer Science, 
+;;; Carnegie Mellon University, October 1989.
+
+;;; Copyright (c) 1989, 1990 by Mark Kantrowitz. All rights reserved.
+
+;;; Use and copying of this software and preparation of derivative works
+;;; based upon this software are permitted, so long as the following
+;;; conditions are met:
+;;;      o no fees or compensation are charged for use, copies, or
+;;;        access to this software
+;;;      o this copyright notice is included intact.
+;;; This software is made available AS IS, and no warranty is made about 
+;;; the software or its performance. 
+
+;;; Please send bug reports, comments and suggestions to mkant@cs.cmu.edu. 
+
+;;; ********************************
+;;; Change Log *********************
+;;; ********************************
+;;;
+;;; Note: Several of the fixes from 30-JAN-91 and 31-JAN-91 were done in
+;;; September and October 1990, but not documented until January 1991. 
+;;;
+;;; sb   = Sean Boisen <sboisen@bbn.com>
+;;; hkt = Rick Taube <hkt@cm-next-8.stanford.edu>
+;;; brad = Brad Miller <miller@cs.rochester.edu>
+;;; toni = Anton Beschta <toni%l4@ztivax.siemens.com>
+;;; bw   = Robert Wilhelm <wilhelm@rpal.rockwell.com>
+;;; rs   = Ralph P. Sobek <ralph@vega.laas.fr>
+;;; gi   = Gabriel Inaebnit <inaebnit@research.abb.ch>
+;;; djc  = Daniel J. Clancy <clancy@cs.utexas.edu>
+;;; mc   = Matthew Cornell <cornell@unix1.cs.umass.edu>
+;;; ik   = Ik Su Yoo <ik@ctt.bellcore.com>
+;;; gc   = Guillaume Cartier <cartier@math.uqam.ca>
+;;; Thanks to Steve Strassmann <straz@media-lab.media.mit.edu> and
+;;; Sean Boisen <sboisen@BBN.COM> for detailed bug reports and 
+;;; miscellaneous assistance. Thanks also to Gabriel Inaebnit
+;;; <inaebnit@research.abb.ch> for help with VAXLisp bugs.
+;;;
+;;; 05-NOV-90  hkt  Changed canonicalize-system-name to make system
+;;;                 names package independent. Interns them in the
+;;;                 keyword package. Thus either strings or symbols may
+;;;                 be used to name systems from the user's point of view.
+;;; 05-NOV-90  hkt  Added definition FIND-SYSTEM to allow OOS to
+;;;                 work on systems whose definition hasn't been loaded yet.
+;;; 05-NOV-90  hkt  Added definitions COMPILE-SYSTEM and LOAD-SYSTEM
+;;;                 as alternates to OOS for naive users.
+;;; 05-NOV-90  hkt  Shadowing-import of 'defsystem in Allegro CL 3.1 [NeXT]
+;;;                 into USER package instead of import.
+;;; 15-NOV-90  mk   Changed package name to "MAKE", eliminating "DEFSYSTEM"
+;;;                 to avoid conflicts with allegro, symbolics packages
+;;;                 named "DEFSYSTEM".
+;;; 30-JAN-91  mk   Modified append-directories to work with the 
+;;;                 logical-pathnames system.
+;;; 30-JAN-91  mk   Append-directories now works with Sun CL4.0. Also, fixed
+;;;                 bug wrt Lucid 4.0's pathnames (which changed from lcl3.0
+;;;                 -- 4.0 uses a list for the directory slot, whereas
+;;;                 3.0 required a string). Possible fix to symbolics bug.
+;;; 30-JAN-91  mk   Defined NEW-REQUIRE to make redefinition of REQUIRE
+;;;                 cleaner. Replaced all calls to REQUIRE in this file with
+;;;                 calls to NEW-REQUIRE, which should avoid compiler warnings.
+;;; 30-JAN-91  mk   In VAXLisp, when we redefine lisp:require, the compiler
+;;;                 no longer automatically executes require forms when it
+;;;                 encounters them in a file. The user can always wrap an
+;;;                 (eval-when (compile load eval) ...) around the require
+;;;                 form. Alternately, see commented out code near the
+;;;                 redefinition of lisp:require which redefines it as a
+;;;                 macro instead.
+;;; 30-JAN-91  mk   Added parameter :version to operate-on-system. If it is
+;;;                 a number, that number is used as part of the binary
+;;;                 directory name as the place to store and load files.
+;;;                 If NIL (the default), uses regular binary directory.
+;;;                 If T, tries to find the most recent version of the
+;;;                 binary directory.
+;;; 30-JAN-91  mk   Added global variable *use-timeouts* (default: t), which
+;;;                 specifies whether timeouts should be used in
+;;;                 Y-OR-N-P-WAIT. This is provided for users whose lisps
+;;;                 don't handle read-char-no-hang properly, so that they
+;;;                 can set it to NIL to disable the timeouts. Usually the
+;;;                 reason for this is the lisp is run on top of UNIX,
+;;;                 which buffers input LINES (and provides input editing).
+;;;                 To get around this we could always turn CBREAK mode
+;;;                 on and off, but there's no way to do this in a portable
+;;;                 manner.
+;;; 30-JAN-91  mk   Fixed bug where in :test t mode it was actually providing
+;;;                 the system, instead of faking it.
+;;; 30-JAN-91  mk   Changed storage of system definitions to a hash table.
+;;;                 Changed canonicalize-system-name to coerce the system
+;;;                 names to uppercase strings. Since we're no longer using
+;;;                 get, there's no need to intern the names as symbols,
+;;;                 and strings don't have packages to cause problems.
+;;;                 Added UNDEFSYSTEM, DEFINED-SYSTEMS, and DESCRIBE-SYSTEM.
+;;;                 Added :delete-binaries command. 
+;;; 31-JAN-91  mk   Franz Allegro CL has a defsystem in the USER package,
+;;;                 so we need to do a shadowing import to avoid name
+;;;                 conflicts.
+;;; 31-JAN-91  mk   Fixed bug in compile-and-load-operation where it was
+;;;                 only loading newly compiled files.
+;;; 31-JAN-91  mk   Added :load-time slot to components to record the
+;;;                 file-write-date of the binary/source file that was loaded.
+;;;                 Now knows "when" (which date version) the file was loaded.
+;;;                 Added keyword :minimal-load and global *minimal-load*
+;;;                 to enable defsystem to avoid reloading unmodified files.
+;;;                 Note that if B depends on A, but A is up to date and
+;;;                 loaded and the user specified :minimal-load T, then A
+;;;                 will not be loaded even if B needs to be compiled. So
+;;;                 if A is an initializations file, say, then the user should
+;;;                 not specify :minimal-load T.
+;;; 31-JAN-91  mk   Added :load-only slot to components. If this slot is
+;;;                 specified as non-NIL, skips over any attempts to compile
+;;;                 the files in the component. (Loading the file satisfies
+;;;                 the need to recompile.)
+;;; 31-JAN-91  mk   Eliminated use of set-alist-lookup and alist-lookup,
+;;;                 replacing it with hash tables. It was too much bother,
+;;;                 and rather brittle too.
+;;; 31-JAN-91  mk   Defined #@ macro character for use with AFS @sys
+;;;                 feature simulator. #@"directory" is then synonymous
+;;;                 with (afs-binary-directory "directory").
+;;; 31-JAN-91  mk   Added :private-file type of module. It is similar to
+;;;                 :file, but has an absolute pathname. This allows you
+;;;                 to specify a different version of a file in a system
+;;;                 (e.g., if you're working on the file in your home
+;;;                 directory) without completely rewriting the system
+;;;                 definition.
+;;; 31-JAN-91  mk   Operations on systems, such as :compile and :load,
+;;;                 now propagate to subsystems the system depends on
+;;;                 if *operations-propagate-to-subsystems* is T (the default)
+;;;                 and the systems were defined using either defsystem
+;;;                 or as a :system component of another system. Thus if
+;;;                 a system depends on another, it can now recompile the 
+;;;                 other.
+;;; 01-FEB-91  mk   Added default definitions of PROVIDE/REQUIRE/*MODULES*
+;;;                 for lisps that have thrown away these definitions in
+;;;                 accordance with CLtL2.
+;;; 01-FEB-91  mk   Added :compile-only slot to components. Analogous to
+;;;                 :load-only. If :compile-only is T, will not load the
+;;;                 file on operation :compile. Either compiles or loads
+;;;                 the file, but not both. In other words, compiling the
+;;;                 file satisfies the demand to load it. This is useful
+;;;                 for PCL defmethod and defclass definitions, which wrap  
+;;;                 an (eval-when (compile load eval) ...) around the body
+;;;                 of the definition -- we save time by not loading the
+;;;                 compiled code, since the eval-when forces it to be
+;;;                 loaded. Note that this may not be entirely safe, since
+;;;                 CLtL2 has added a :load keyword to compile-file, and
+;;;                 some lisps may maintain a separate environment for
+;;;                 the compiler. This feature is for the person who asked
+;;;                 that a :COMPILE-SATISFIES-LOAD keyword be added to
+;;;                 modules. It's named :COMPILE-ONLY instead to match 
+;;;                 :LOAD-ONLY.
+;;; 11-FEB-91  mk   Now adds :mk-defsystem to features list, to allow
+;;;                 special cased loading of defsystem if not already
+;;;                 present.
+;;; 19-FEB-91  duff Added filename extension for hp9000/300's running Lucid.
+;;; 26-FEB-91  mk   Distinguish between toplevel systems (defined with
+;;;                 defsystem) and systems defined as a :system module
+;;;                 of a defsystem. The former can depend only on systems,
+;;;                 while the latter can depend on anything at the same
+;;;                 level.
+;;; 12-MAR-91  mk   Added :subsystem component type to be a system with
+;;;                 pathnames relative to its parent component.
+;;; 12-MAR-91  mk   Uncommented :device :absolute for CMU pathnames, so
+;;;                 that the leading slash is included.
+;;; 12-MAR-91  brad Patches for Allegro 4.0.1 on Sparc. 
+;;; 12-MAR-91  mk   Changed definition of format-justified-string so that
+;;;                 it no longer depends on the ~<~> format directives,
+;;;                 because Allegro 4.0.1 has a bug which doesn't support
+;;;                 them. Anyway, the new definition is twice as fast
+;;;                 and conses half as much as FORMAT.
+;;; 12-MAR-91 toni  Remove nils from list in expand-component-components.
+;;; 12-MAR-91 bw    If the default-package and system have the same name,
+;;;                 and the package is not loaded, this could lead to
+;;;                 infinite loops, so we bomb out with an error.
+;;;                 Fixed bug in default packages.
+;;; 13-MAR-91 mk    Added global *providing-blocks-load-propagation* to
+;;;                 control whether system dependencies are loaded if they
+;;;                 have already been provided.
+;;; 13-MAR-91 brad  In-package is a macro in CLtL2 lisps, so we change
+;;;                 the package manually in operate-on-component.
+;;; 15-MAR-91 mk    Modified *central-registry* to be either a single
+;;;                 directory pathname, or a list of directory pathnames
+;;;                 to be checked in order.
+;;; 15-MAR-91 rs    Added afs-source-directory to handle versions when
+;;;                 compiling C code under lisp. Other minor changes to
+;;;                 translate-version and operate-on-system.
+;;; 21-MAR-91 gi    Fixed bug in defined-systems. 
+;;; 22-MAR-91 mk    Replaced append-directories with new version that works
+;;;                 by actually appending the directories, after massaging
+;;;                 them into the proper format. This should work for all
+;;;                 CLtL2-compliant lisps.
+;;; 09-APR-91 djc   Missing package prefix for lp:pathname-host-type.
+;;;                 Modified component-full-pathname to work for logical
+;;;                 pathnames.
+;;; 09-APR-91 mk    Added *dont-redefine-require* to control whether
+;;;                 REQUIRE is redefined. Fixed minor bugs in redefinition
+;;;                 of require.
+;;; 12-APR-91 mk    (pathname-host nil) causes an error in MCL 2.0b1
+;;; 12-APR-91 mc    Ported to MCL2.0b1.
+;;; 16-APR-91 mk    Fixed bug in needs-loading where load-time and
+;;;                 file-write-date got swapped.
+;;; 16-APR-91 mk    If the component is load-only, defsystem shouldn't
+;;;                 tell you that there is no binary and ask you if you
+;;;                 want to load the source.  
+;;; 17-APR-91 mc    Two additional operations for MCL.
+;;; 21-APR-91 mk    Added feature requested by ik. *files-missing-is-an-error*
+;;;                 new global variable which controls whether files (source
+;;;                 and binary) missing cause a continuable error or just a
+;;;                 warning.
+;;; 21-APR-91 mk    Modified load-file-operation to allow compilation of source
+;;;                 files during load if the binary files are old or
+;;;                 non-existent. This adds a :compile-during-load keyword to
+;;;                 oos, and load-system. Global *compile-during-load* sets
+;;;                 the default (currently :query).
+;;; 21-APR-91 mk    Modified find-system so that there is a preference for
+;;;                 loading system files from disk, even if the system is
+;;;                 already defined in the environment.
+;;; 25-APR-91 mk    Removed load-time slot from component defstruct and added
+;;;                 function COMPONENT-LOAD-TIME to store the load times in a
+;;;                 hash table. This is safer than the old definition because
+;;;                 it doesn't wipe out load times every time the system is
+;;;                 redefined.
+;;; 25-APR-91 mk    Completely rewrote load-file-operation. Fixed some bugs
+;;;                 in :compile-during-load and in the behavior of defsystem
+;;;                 when multiple users are compiling and loading a system
+;;;                 instead of just a single user.
+;;; 16-MAY-91 mk    Modified FIND-SYSTEM to do the right thing if the system
+;;;                 definition file cannot be found.
+;;; 16-MAY-91 mk    Added globals *source-pathname-default* and
+;;;                 *binary-pathname-default* to contain default values for
+;;;                 :source-pathname and :binary-pathname. For example, set
+;;;                 *source-pathname-default* to "" to avoid having to type
+;;;                 :source-pathname "" all the time.
+;;; 27-MAY-91 mk    Fixed bug in new-append-directories where directory
+;;;                 components of the form "foo4.0" would appear as "foo4",
+;;;                 since pathname-name truncates the type. Changed
+;;;                 pathname-name to file-namestring.
+;;;  3-JUN-91 gc    Small bug in new-append-directories; replace (when
+;;;                 abs-name) with (when (not (null-string abs-name)))
+;;;  4-JUN-91 mk    Additional small change to new-append-directories for
+;;;                 getting the device from the relative pname if the abs
+;;;                 pname is "". This is to fix a small behavior in CMU CL old
+;;;                 compiler. Also changed (when (not (null-string abs-name)))
+;;;                 to have an (and abs-name) in there.
+;;;  8-JAN-92 sb    Added filename extension for defsystem under Lucid Common
+;;;                 Lisp/SGO 3.0.1+.
+;;;  8-JAN-92 mk    Changed the definition of prompt-string to work around an
+;;;                 AKCL bug. Essentially, AKCL doesn't default the colinc to
+;;;                 1 if the colnum is provided, so we hard code it.
+;;;  8-JAN-92 rs    (pathname-directory (pathname "")) returns '(:relative) in
+;;;                 Lucid, instead of NIL. Changed new-append-directories and
+;;;                 test-new-append-directories to reflect this.
+;;;  8-JAN-92 mk    Fixed problem related to *load-source-if-no-binary*.
+;;;                 compile-and-load-source-if-no-binary wasn't checking for
+;;;                 the existence of the binary if this variable was true,
+;;;                 causing the file to not be compiled.
+;;;  8-JAN-92 mk    Fixed problem with null-string being called on a pathname.
+
+
+
+;;; ********************************
+;;; To Do **************************
+;;; ********************************
+;;;
+;;; Need way to load old binaries even if source is newer.
+;;;
+;;; Load a system (while not loading anything already loaded)
+;;; and inform the user of out of date fasls with the choice
+;;; to load the old fasl or recompile and then load the new
+;;; fasl?
+;;; 
+;;; modify compile-file-operation to handle a query keyword....
+;;;
+;;; Perhaps systems should keep around the file-write-date of the system
+;;; definition file, to prevent excessive reloading of the system definition?
+;;;
+;;; load-file-operation needs to be completely reworked to simplify the
+;;; logic of when files get loaded or not.
+;;;
+;;; Need to revamp output: Nesting and indenting verbose output doesn't
+;;; seem cool, especially when output overflows the 80-column margins.
+;;;
+;;; Document various ways of writing a system. simple (short) form
+;;; (where :components is just a list of filenames) in addition to verbose.
+;;; Put documentation strings in code.
+;;;
+;;; :load-time for modules and systems -- maybe record the time the system
+;;; was loaded/compiled here and print it in describe-system?
+;;;
+;;; Make it easy to define new functions that operate on a system. For 
+;;; example, a function that prints out a list of files that have changed, 
+;;; hardcopy-system, edit-system, etc.
+;;;
+;;; If a user wants to have identical systems for different lisps, do we 
+;;; force the user to use logical pathnames? Or maybe we should write a 
+;;; generic-pathnames package that parses any pathname format into a 
+;;; uniform underlying format (i.e., pull the relevant code out of
+;;; logical-pathnames.lisp and clean it up a bit).
+;;;
+;;;    Verify that Mac pathnames now work with append-directories.
+;;;
+;;; A common human error is to violate the modularization by making a file
+;;; in one module depend on a file in another module, instead of making
+;;; one module depend on the other. This is caught because the dependency
+;;; isn't found. However, is there any way to provide a more informative
+;;; error message? Probably not, especially if the system has multiple
+;;; files of the same name.
+;;; 
+;;; For a module none of whose files needed to be compiled, have it print out
+;;; "no files need recompilation".
+;;; 
+;;; Write a system date/time to a file? (version information) I.e., if the
+;;; filesystem supports file version numbers, write an auxiliary file to
+;;; the system definition file that specifies versions of the system and
+;;; the version numbers of the associated files. 
+;;; 
+;;; Add idea of a patch directory.
+;;; 
+;;; In verbose printout, have it log a date/time at start and end of
+;;; compilation: 
+;;;     Compiling system "test" on 31-Jan-91 21:46:47 
+;;;     by Defsystem version v2.0 01-FEB-91.
+;;; 
+;;; Define other :force options:
+;;;    :query    allows user to specify that a file not normally compiled
+;;;              should be. OR
+;;;    :confirm  allows user to specify that a file normally compiled
+;;;              shouldn't be. AND
+;;; 
+;;; We currently assume that compilation-load dependencies and if-changed
+;;; dependencies are identical. However, in some cases this might not be
+;;; true. For example, if we change a macro we have to recompile functions
+;;; that depend on it (except in lisps that automatically do this, such
+;;; as the new CMU Common Lisp), but not if we change a function. Splitting
+;;; these apart (with appropriate defaulting) would be nice, but not worth
+;;; doing immediately since it may save only a couple of file recompilations,
+;;; while making defsystem much more complex than it already is. 
+;;; 
+
+;;; ********************************
+;;; Notes **************************
+;;; ********************************
+;;;
+;;;    DEFSYSTEM has been tested (successfully) in the following lisps:
+;;;       CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
+;;;       CMU Common Lisp (14-Dec-90 beta, Python Compiler 0.0 PMAX/Mach)
+;;;       ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 3/30/90)
+;;;       ExCL (Franz Allegro CL 4.0.1 [SPARC])
+;;;       Lucid CL (Version 2.1 6-DEC-87)
+;;;       Lucid Common Lisp (3.0 [SPARC,SUN3]) 
+;;;       Lucid Common Lisp (4.0 [SPARC,SUN3])
+;;;       VAXLisp (v2.2) [VAX/VMS]
+;;;       VAXLisp (v3.1)
+;;;
+;;;    DEFSYSTEM needs to be tested in the following lisps:
+;;;       Symbolics Common Lisp (8.0)
+;;;       Macintosh Allegro Common Lisp (1.3.2)
+;;;       KCL (June 3, 1987 or later)
+;;;       AKCL (1.86, June 30, 1987 or later)
+;;;       TI (Release 4.1 or later)
+;;;       Ibuki Common Lisp (01/01, October 15, 1987)
+;;;       Golden Common Lisp (3.1 IBM-PC)
+;;;       HP Common Lisp (same as Lucid?)
+;;;       Procyon Common Lisp
+
+
+;;; ********************************************************************
+;;; How to Use this System *********************************************
+;;; ********************************************************************
+
+;;; To use this system,
+;;; 1. If you want to have a central registry of system definitions, 
+;;;    modify the value of the variable *central-registry* below.
+;;; 2. Load this file (defsystem.lisp) in either source or compiled form,
+;;; 3. Load the file containing the "defsystem" definition of your system,
+;;; 4. Use the function "operate-on-system" to do things to your system.
+
+;;; For more information, see the documentation and examples in 
+;;; lisp-utilities.ps.
+
+;;; ****************************************************************
+;;; Lisp Code ******************************************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Massage CLtL2 onto *features* **
+;;; ********************************
+;;; Let's be smart about CLtL2 compatible Lisps:
+(eval-when (compile load eval)
+  #+(or (and :excl :allegro-v4.0) :mcl)
+  (pushnew :cltl2 *features*))
+
+;;; ********************************
+;;; Provide/Require/*modules* ******
+;;; ********************************
+
+;;; Since CLtL2 has dropped require and provide from the language, some
+;;; lisps may not have the functions PROVIDE and REQUIRE and the
+;;; global *MODULES*. So if lisp::provide and user::provide are not
+;;; defined, we define our own.
+
+;;; Hmmm. CMU CL old compiler gives bogus warnings here about functions
+;;; and variables not being declared or bound, apparently because it
+;;; sees that (or (fboundp 'lisp::require) (fboundp 'user::require)) returns
+;;; T, so it doesn't really bother when compiling the body of the unless.
+;;; The new compiler does this properly, so I'm not going to bother
+;;; working around this.
+
+;;; KCL (and derivatives) complain about the following in-package, proved,
+;;; export and import forms being "in a bad place" if any non-package related
+;;; form preceeds it. So I moved them before all the other stuff and skip
+;;; the following conditional which is unnecessary in KCL anyway.
+;;; 							-- stolcke 10/22/93
+
+#-(or (and :CMU (not :new-compiler)) :vms :mcl :kcl :ECL)
+(eval-when (compile load eval)
+  (unless (or (fboundp 'lisp::require) (fboundp 'user::require)
+	      #+(and :excl :allegro-v4.0) (fboundp 'cltl1::require))
+    (in-package "LISP")
+    (export '(*modules* provide require))
+
+    ;; Documentation strings taken almost literally from CLtL1.
+  
+    (defvar *MODULES* ()
+      "List of names of the modules that have been loaded into Lisp so far.
+     It is used by PROVIDE and REQUIRE.")
+
+    ;; We provide two different ways to define modules. The default way
+    ;; is to put either a source or binary file with the same name
+    ;; as the module in the library directory. The other way is to define
+    ;; the list of files in the module with defmodule.
+
+    ;; The directory listed in *library* is implementation dependent,
+    ;; and is intended to be used by Lisp manufacturers as a place to
+    ;; store their implementation dependent packages. 
+    ;; Lisp users should use systems and *central-registry* to store
+    ;; their packages -- it is intended that *central-registry* is
+    ;; set by the user, while *library* is set by the lisp.
+
+    (defvar *library* nil		; "/usr/local/lisp/Modules/"
+      "Directory within the file system containing files, where the name
+     of a file is the same as the name of the module it contains.")
+
+    (defun canonicalize-module-name (name)
+      ;; if symbol, string-downcase the printrep to make nicer filenames.
+      (if (stringp name) name (string-downcase (string name))))
+
+    (defvar *module-files* (make-hash-table :test #'equal)
+      "Hash table mapping from module names to list of files for the
+     module. REQUIRE loads these files in order.")
+    (defmacro defmodule (name &rest files)
+      "Defines a module NAME to load the specified FILES in order."
+      `(setf (gethash (canonicalize-module-name ,name) *module-files*)
+	     ',files))
+    (defun module-files (name)
+      (gethash name *module-files*))
+
+    (defun PROVIDE (name)
+      "Adds a new module name to the list of modules maintained in the
+     variable *modules*, thereby indicating that the module has been 
+     loaded. Name may be a string or symbol -- strings are case-senstive,
+     while symbols are treated like lowercase strings. Returns T if
+     NAME was not already present, NIL otherwise."
+      (let ((module (canonicalize-module-name name)))
+	(unless (find module *modules* :test #'string=)
+	  ;; Module not present. Add it and return T to signify that it 
+	  ;; was added.
+	  (push module *modules*)
+	  t)))
+
+    (defun REQUIRE (name &optional pathname)
+      "Tests whether a module is already present. If the module is not
+     present, loads the appropriate file or set of files. The pathname
+     argument, if present, is a single pathname or list of pathnames
+     whose files are to be loaded in order, left to right. If the
+     pathname is nil, the system first checks if a module was defined
+     using defmodule and uses the pathnames so defined. If that fails,
+     it looks in the library directory for a file with name the same
+     as that of the module. Returns T if it loads the module."
+      (let ((module (canonicalize-module-name name)))
+	(unless (find module *modules* :test #'string=)
+	  ;; Module is not already present.
+	  (when (and pathname (not (listp pathname)))
+	    ;; If there's a pathname or pathnames, ensure that it's a list.
+	    (setf pathname (list pathname)))
+	  (unless pathname 
+	    ;; If there's no pathname, try for a defmodule definition.
+	    (setf pathname (module-files module)))
+	  (unless pathname
+	    ;; If there's still no pathname, try the library directory.
+	    (when *library*
+	      (setf pathname (concatenate 'string *library* module))
+	      ;; Test if the file exists.
+	      ;; We assume that the lisp will default the file type 
+	      ;; appropriately. If it doesn't, use #+".fasl" or some
+	      ;; such in the concatenate form above.
+	      (if (probe-file pathname)
+		  ;; If it exists, ensure we've got a list
+		  (setf pathname (list pathname))
+		  ;; If the library file doesn't exist, we don't want
+		  ;; a load error.
+		  (setf pathname nil))))
+	  ;; Now that we've got the list of pathnames, let's load them.
+	  (dolist (pname pathname T)
+	    (load pname :verbose nil)))))))
+
+;;; ********************************
+;;; Set up Package *****************
+;;; ********************************
+
+
+;;; Unfortunately, lots of lisps have their own defsystems, some more
+;;; primitive than others, all uncompatible, and all in the DEFSYSTEM
+;;; package. To avoid name conflicts, we've decided to name this the
+;;; MAKE package. A nice side-effect is that the short nickname
+;;; MK is my initials.
+
+#-:cltl2
+(in-package "MAKE" :nicknames '("MK"))
+
+;;; For CLtL2 compatible lisps...
+#+(and :excl :allegro-v4.0 :cltl2)
+(defpackage "MAKE" (:nicknames "MK") (:use "COMMON-LISP") 
+  (:import-from cltl1 *modules* provide require))
+#+:mcl                                  
+(defpackage "MAKE" (:nicknames "MK") (:use "COMMON-LISP") 
+  (:import-from ccl *modules* provide require))
+#+(and :cltl2 (not (or (and :excl :allegro-v4.0) :mcl)))   
+(unless (find-package "MAKE") 
+  (make-package "MAKE" :nicknames '("MK") :use '("COMMON-LISP")))
+
+#+:cltl2
+(in-package "MAKE")
+
+#+(and :excl :allegro-v4.0 :cltl2)
+(cltl1:provide 'make)
+#+:mcl
+(ccl:provide 'make)
+#+(and :cltl2 (not (or (and :excl :allegro-v4.0) :mcl)))
+(provide 'make)
+#-:cltl2
+(provide 'make)
+
+(pushnew :mk-defsystem *features*)
+
+(eval-when (compile load eval)
+  (defvar *special-exports*
+    '(defsystem compile-system load-system))
+   (defvar *exports*
+     '(operate-on-system oos afs-binary-directory afs-source-directory
+			 files-in-system))
+
+   (defvar *other-exports* 
+     '(*central-registry* *bin-subdir* 
+			  machine-type-translation software-type-translation
+					;require
+			  allegro-make-system-fasl 
+			  files-which-need-compilation  
+			  undefsystem
+			  defined-systems
+			  describe-system
+			  *defsystem-version*
+			  *compile-during-load*
+			  *minimal-load*
+			  *dont-redefine-require*
+			  *files-missing-is-an-error*
+			  *reload-systems-from-disk*
+			  *source-pathname-default*
+			  *binary-pathname-default*
+			  )))
+
+;;; The external interface consists of *exports* and *other-exports*.
+(eval-when (compile load eval)
+   (export *exports*)
+   (export *special-exports*)
+   (export *other-exports*))
+
+;;; We import these symbols into the USER package to make them
+;;; easier to use. Since some lisps have already defined defsystem
+;;; in the user package, we may have to shadowing-import it.
+#-(OR :CMU :CCL :ALLEGRO :EXCL)
+(eval-when (compile load eval)
+  (import *exports* #-:cltl2 "USER" #+:cltl2 "COMMON-LISP-USER")
+  (import *special-exports* #-:cltl2 "USER" #+:cltl2 "COMMON-LISP-USER"))
+#+(OR :CMU :CCL :ALLEGRO :EXCL)
+(eval-when (compile load eval)
+  (import *exports* #-:cltl2 "USER" #+:cltl2 "COMMON-LISP-USER")
+  (shadowing-import *special-exports* 
+		    #-:cltl2 "USER" 
+		    #+:cltl2 "COMMON-LISP-USER"))
+
+#-PCL(when (find-package "PCL") 
+       (pushnew :pcl *modules*)
+       (pushnew :pcl *features*))
+
+;;; ********************************
+;;; Defsystem Version **************
+;;; ********************************
+(defparameter *defsystem-version* "v2.5 08-JAN-92"
+  "Current version number/date for Defsystem.")
+
+;;; ********************************
+;;; Customizable System Parameters *
+;;; ********************************
+
+(defvar *dont-redefine-require* t ;nil
+  "If T, prevents the redefinition of REQUIRE. This is useful for
+   lisps that treat REQUIRE specially in the compiler.")
+
+;;; Change this variable to set up the location of a central
+;;; repository for system definitions if you want one.
+(defvar *central-registry* '() 
+  "Central directory of system definitions. May be either a single
+   directory pathname, or a list of directory pathnames to be checked
+   after the local directory.")
+(setq *central-registry* "../lisp/")
+
+(defvar *bin-subdir* ".bin/"
+  "The subdirectory of an AFS directory where the binaries are really kept.")
+
+;;; These variables set up defaults for operate-on-system, and are used 
+;;; for communication in lieu of parameter passing. Yes, this is bad,
+;;; but it keeps the interface small. Also, in the case of the -if-no-binary
+;;; variables, parameter passing would require multiple value returns
+;;; from some functions. Why make life complicated?
+(defvar *tell-user-when-done* nil
+  "If T, system will print ...DONE at the end of an operation")
+(defvar *oos-verbose* nil 
+  "Operate on System Verbose Mode")
+(defvar *oos-test* nil 
+  "Operate on System Test Mode")
+(defvar *load-source-if-no-binary* nil
+  "If T, system will try loading the source if the binary is missing")
+(defvar *bother-user-if-no-binary* t
+  "If T, the system will ask the user whether to load the source if 
+   the binary is missing")
+(defvar *load-source-instead-of-binary* nil
+  "If T, the system will load the source file instead of the binary.")
+(defvar *compile-during-load* :query
+  "If T, the system will compile source files during load if the
+   binary file is missing. If :query, it will ask the user for
+   permission first.")
+(defvar *minimal-load* nil
+  "If T, the system tries to avoid reloading files that were already loaded
+   and up to date.")
+
+(defvar *files-missing-is-an-error* t
+  "If both the source and binary files are missing, signal a continuable 
+   error instead of just a warning.")
+
+(defvar *operations-propagate-to-subsystems* t
+  "If T, operations like :COMPILE and :LOAD propagate to subsystems
+   of a system that are defined either using a component-type of :system
+   or by another defsystem form.")
+
+;;; Particular to CMULisp
+(defvar *compile-error-file-type* "err"
+  "File type of compilation error file in cmulisp")
+(defvar *cmu-errors-to-terminal* t
+  "Argument to :errors-to-terminal in compile-file in cmulisp")
+(defvar *cmu-errors-to-file* t
+  "If T, cmulisp will write an error file during compilation")
+
+;;; ********************************
+;;; Global Variables ***************
+;;; ********************************
+
+;;; Massage people's *features* into better shape.
+(eval-when (compile load eval)  
+  (dolist (feature *features*)
+    (when (and (symbolp feature)   ; 3600
+               (equal (symbol-name feature) "CMU"))
+      (pushnew :CMU *features*)))
+  
+  #+Lucid
+  (when (search "IBM RT PC" (machine-type))
+    (pushnew :ibm-rt-pc *features*))
+  )
+
+;;; *filename-extensions* is a cons of the source and binary extensions.
+(defvar *filename-extensions*
+  (car '(#+(and Symbolics Lispm)              ("lisp" . "bin")
+         #+(and dec common vax (not ultrix))  ("LSP"  . "FAS")
+         #+(and dec common vax ultrix)        ("lsp"  . "fas")
+         #+(or :kcl :ECL)                     ("lsp"  . "o")
+         #+IBCL                               ("lsp"  . "o")
+         #+Xerox                              ("lisp" . "dfasl")
+	 ;; Lucid on Silicon Graphics
+	 #+(and Lucid MIPS)                   ("lisp" . "mbin")   
+	 ;; the entry for (and lucid hp300) must precede
+	 ;; that of (and lucid mc68000) for hp9000/300's running lucid,
+	 ;; since *features* on hp9000/300's also include the :mc68000
+	 ;; feature.
+	 #+(and lucid hp300)                  ("lisp" . "6bin")
+         #+(and Lucid MC68000)                ("lisp" . "lbin")
+         #+(and Lucid Vax)                    ("lisp" . "vbin")   
+         #+(and Lucid Prime)                  ("lisp" . "pbin")
+         #+(and Lucid SUNRise)                ("lisp" . "sbin")
+         #+(and Lucid SPARC)                  ("lisp" . "sbin")
+         #+(and Lucid :IBM-RT-PC)              ("lisp" . "bbin")
+	 ;; PA is Precision Architecture, HP's 9000/800 RISC cpu
+	 #+(and Lucid PA)                    ("lisp" . "hbin")   
+         #+excl                               ("cl"   . "fasl")
+         #+(and :CMU :SPARC)                  ("lisp" . "sparcf")
+         #+:CMU                               ("lisp" . "fasl")
+	 #+PRIME                              ("lisp" . "pbin")
+         #+HP                                 ("l"    . "b")
+         #+TI ("lisp" . #.(string (si::local-binary-file-type)))
+         #+:gclisp                            ("LSP"  . "F2S")
+         #+pyramid                            ("clisp" . "o")
+         #+:coral                             ("lisp" . "fasl")
+	 ;; Harlequin LispWorks on Mips M2000
+	 #+(and :mips :lispworks) 	      ("lisp" . "mfasl")
+         
+         ;; Otherwise,
+         ("lisp" . "lbin")))
+  "Filename extensions for Common Lisp. A cons of the form
+   (Source-Extension . Binary-Extension). If the system is 
+   unknown (as in *features* not known), defaults to lisp and lbin.")
+
+;;; There is no real support for this variable being nil, so don't change it.
+;;; Note that in any event, the toplevel system (defined with defsystem)
+;;; will have its dependencies delayed. Not having dependencies delayed
+;;; might be useful if we define several systems within one defsystem.
+(defvar *system-dependencies-delayed* t 
+  "If T, system dependencies are expanded at run time")
+
+;;; Replace this with consp, dammit!
+(defun non-empty-listp (list)
+  (and list (listp list)))
+
+;;; ********************************
+;;; Component Operation Definition *
+;;; ********************************
+(defvar *component-operations* (make-hash-table :test #'equal)
+  "Hash table of (operation-name function) pairs.")
+(defun component-operation (name &optional operation)
+  (if operation
+      (setf (gethash name *component-operations*) operation)
+      (gethash name *component-operations*)))
+
+;;; ********************************
+;;; AFS @sys immitator *************
+;;; ********************************
+
+;;; mc 11-Apr-91: Bashes MCL's point reader, so commented out.
+#-:mcl 
+(eval-when (compile load eval)
+  ;; Define #@"foo" as a shorthand for (afs-binary-directory "foo").
+  ;; For example,
+  ;;    <cl> #@"foo"
+  ;;    "foo/.bin/rt_mach/"
+  (set-dispatch-macro-character 
+   #\# #\@ 
+   #'(lambda (stream char arg)
+       (declare (ignore char arg))
+       `(afs-binary-directory ',(read stream t nil t)))))
+
+(defun afs-binary-directory (root-directory)
+  ;; Function for obtaining the directory AFS's @sys feature would have
+  ;; chosen when we're not in AFS. This function is useful as the argument
+  ;; to :binary-pathname in defsystem. For example,
+  ;; :binary-pathname (afs-binary-directory "scanner/")
+  (let ((machine (machine-type-translation (machine-type)))
+	(software (software-type-translation (software-type))))
+    ;; pmax_mach rt_mach sun3_35 sun3_mach vax_mach
+    (setq root-directory (namestring root-directory))
+    (setq root-directory (ensure-trailing-slash root-directory))
+    (format nil "~A~@[~A~]~@[~A/~]" 
+	    root-directory
+	    *bin-subdir*
+	    (afs-component machine software))))
+
+(defun afs-source-directory (root-directory &optional version-flag)
+  ;; Function for obtaining the directory AFS's @sys feature would have
+  ;; chosen when we're not in AFS. This function is useful as the argument
+  ;; to :source-pathname in defsystem.
+  (setq root-directory (namestring root-directory))
+  (setq root-directory (ensure-trailing-slash root-directory))
+  (format nil "~A~@[~A/~]" 
+          root-directory
+          (and version-flag (translate-version *version*))))
+
+(defun null-string (s)
+  (when (stringp s)
+    (string-equal s "")))
+
+(defun ensure-trailing-slash (dir)
+  (if (and dir 
+	   (not (null-string dir))
+	   (not (char= (char dir
+			     (1- (length dir)))
+		       #\/)))
+      (concatenate 'string dir "/")
+      dir))
+
+(defun afs-component (machine software)
+  (format nil "~@[~A~]~@[_~A~]" 
+	    machine 
+	    (or software "mach")))
+
+(defvar *machine-type-alist* (make-hash-table :test #'equal)
+  "Hash table for retrieving the machine-type")
+(defun machine-type-translation (name &optional operation)
+  (if operation
+      (setf (gethash (string-upcase name) *machine-type-alist*) operation)
+      (gethash (string-upcase name) *machine-type-alist*)))
+
+(machine-type-translation "IBM RT PC"   "rt")
+(machine-type-translation "DEC 3100"    "pmax")
+(machine-type-translation "DEC VAX-11"  "vax")
+(machine-type-translation "Sun3"        "sun3")
+(machine-type-translation "Sun-4"       "sun4")
+#+(and :lucid :sun :mc68000)
+(machine-type-translation "unknown"     "sun3")
+ 
+
+(defvar *software-type-alist* (make-hash-table :test #'equal)
+  "Hash table for retrieving the software-type")
+(defun software-type-translation (name &optional operation)
+  (if operation
+      (setf (gethash (string-upcase name) *software-type-alist*) operation)
+      (gethash (string-upcase name) *software-type-alist*)))
+
+(software-type-translation "BSD UNIX" "mach") ; "unix"
+(software-type-translation "Ultrix" "mach") ; "ultrix"
+(software-type-translation "SunOS" "SunOS")
+(software-type-translation "MACH/4.3BSD" "mach")
+#+:lucid
+(software-type-translation "Unix" 
+			   #+:lcl4.0 "4.0"
+			   #+(and :lcl3.0 (not :lcl4.0)) "3.0")
+
+;;; ********************************
+;;; System Names *******************
+;;; ********************************
+(defun canonicalize-system-name (name)
+  ;; Originally we were storing systems using GET. This meant that the
+  ;; name of a system had to be a symbol, so we interned the symbols
+  ;; in the keyword package to avoid package dependencies. Now that we're
+  ;; storing the systems in a hash table, we've switched to using strings.
+  ;; Since the hash table is case sensitive, we use uppercase strings.
+  ;; (Names of modules and files may be symbols or strings.)
+  #|(if (keywordp name)
+      name
+      (intern (string-upcase (string name)) "KEYWORD"))|#
+  (if (stringp name) name (string-upcase (string name))))
+
+(defvar *defined-systems* (make-hash-table :test #'equal)
+  "Hash table containing the definitions of all known systems.")
+
+(defun get-system (name)
+  "Returns the definition of the system named NAME."
+  (gethash (canonicalize-system-name name) *defined-systems*))
+
+(defsetf get-system (name) (value)
+  `(setf (gethash (canonicalize-system-name ,name) *defined-systems*) ,value))
+
+(defun undefsystem (name)
+  "Removes the definition of the system named NAME."
+  (setf (get-system name) nil))
+
+(defun defined-systems ()
+  "Returns a list of defined systems."
+  (let ((result nil))
+    (maphash #'(lambda (key value)
+		 (declare (ignore key))
+		 (push value result))
+	     *defined-systems*)
+    result))
+
+;;; ********************************
+;;; Directory Pathname Hacking *****
+;;; ********************************
+
+;;; Unix example: An absolute directory starts with / while a 
+;;; relative directory doesn't. A directory ends with /, while
+;;; a file's pathname doesn't. This is important 'cause
+;;; (pathname-directory "foo/bar") will return "foo" and not "foo/".
+
+;;; I haven't been able to test the fix to the problem with symbolics
+;;; hosts. Essentially, append-directories seems to have been tacking
+;;; the default host onto the front of the pathname (e.g., mk::source-pathname
+;;; gets a "B:" on front) and this overrides the :host specified in the
+;;; component. The value of :host should override that specified in
+;;; the :source-pathname and the default file server. If this doesn't
+;;; fix things, specifying the host in the root pathname "F:>root-dir>"
+;;; may be a good workaround.
+
+;;; Need to verify that merging of pathnames where modules are located
+;;; on different devices (in VMS-based VAXLisp) now works.
+
+;;; Merge-pathnames works for VMS systems. In VMS systems, the directory
+;;; part is enclosed in square brackets, e.g.,
+;;; 	"[root.child.child_child]" or "[root.][child.][child_child]"
+;;; To concatenate directories merge-pathnames works as follows:
+;;; 	(merge-pathnames "" "[root]")               ==> "[root]"
+;;; 	(merge-pathnames "[root.]" "[son]file.ext") ==> "[root.son]file.ext"
+;;; 	(merge-pathnames "[root.]file.ext" "[son]") ==> "[root.son]file.ext"
+;;; 	(merge-pathnames "[root]file.ext" "[son]")  ==> "[root]file.ext"
+;;; Thus the problem with the #-VMS code was that it was merging x y into
+;;; [[x]][y] instead of [x][y] or [x]y. 
+
+;;; Miscellaneous notes:
+;;;   On GCLisp, the following are equivalent:
+;;;       "\\root\\subdir\\BAZ"
+;;;       "/root/subdir/BAZ"
+;;;   On VAXLisp, the following are equivalent:
+;;;       "[root.subdir]BAZ"
+;;;       "[root.][subdir]BAZ"
+;;; Use #+:vaxlisp for VAXLisp 3.0, #+(and vms dec common vax) for v2.2
+
+(defun new-append-directories (absolute-dir relative-dir)
+  ;; Version of append-directories for CLtL2-compliant lisps. In particular,
+  ;; they must conform to section 23.1.3 "Structured Directories". We are
+  ;; willing to fix minor aberations in this function, but not major ones.
+  ;; Tested in Allegro CL 4.0 [SPARC], Allegro CL 3.1.12 [DEC 3100], 
+  ;; CMU CL old and new compilers, Lucid 3.0, Lucid 4.0.
+  (setf absolute-dir (or absolute-dir "")
+	relative-dir (or relative-dir ""))
+  (let* ((abs-dir (pathname absolute-dir))
+	 (rel-dir (pathname relative-dir))
+	 (host (pathname-host abs-dir))
+	 (device (if (null-string absolute-dir) ; fix for CMU CL old compiler
+		     (pathname-device rel-dir)
+		   (pathname-device abs-dir)))
+	 (abs-directory (coerce (pathname-directory abs-dir) 'list))
+	 (abs-keyword (when (keywordp (car abs-directory))
+			(pop abs-directory)))
+	 (abs-name (file-namestring abs-dir)) ; was pathname-name
+	 (rel-directory (coerce (pathname-directory rel-dir) 'list))
+	 (rel-keyword (when (keywordp (car rel-directory))
+			(pop rel-directory)))
+	 (rel-file (file-namestring rel-dir))
+	 (directory nil))
+    ;; Allegro v4.0 parses "/foo" into :directory '(:absolute :root)
+    ;; and filename "foo". The namestring of a pathname with 
+    ;; directory '(:absolute :root "foo") ignores everything after the
+    ;; :root.
+    #+:allegro-v4.0(when (eq (car abs-directory) :root) (pop abs-directory))
+    #+:allegro-v4.0(when (eq (car rel-directory) :root) (pop rel-directory))
+    (when (and abs-name (not (null-string abs-name))) ; was abs-name
+      (cond ((and (null abs-directory) (null abs-keyword))
+	     #-(or :lucid :kcl :ECL) (setf abs-keyword :relative)
+	     (setf abs-directory (list abs-name)))
+	    (t
+	     (setf abs-directory (append abs-directory (list abs-name))))))
+    (when (and (null abs-directory) 
+	       (or (null abs-keyword) 
+		   ;; In Lucid, an abs-dir of nil gets a keyword of 
+		   ;; :relative since (pathname-directory (pathname ""))
+		   ;; returns (:relative) instead of nil.
+		   #+:lucid (eq abs-keyword :relative))
+	       rel-keyword)
+      (setf abs-keyword rel-keyword))
+    (setf directory (append abs-directory rel-directory))
+    (when abs-keyword (setf directory (cons abs-keyword directory)))
+    (namestring 
+     (make-pathname :host host
+		    :device device
+		    :directory #-:cmu directory
+		               #+:cmu (if (find-package :common-lisp)
+;; no longer required in CMUcl 16e -- stolcke 9/17/92
+					  directory
+					  (coerce directory 'simple-vector))
+		    :directory directory
+		    :name rel-file))))
+
+(defparameter *append-dirs-tests* 
+  '("~/foo/" "baz/bar.lisp"
+     "~/foo" "baz/bar.lisp"
+     "/foo/bar/" "baz/barf.lisp"
+     "/foo/bar/" "/baz/barf.lisp"
+     "foo/bar/" "baz/barf.lisp"
+     "foo/bar" "baz/barf.lisp"
+     "foo/bar" "/baz/barf.lisp"
+     "foo/bar/" "/baz/barf.lisp"
+     "/foo/bar/" nil
+     "foo/bar/" nil
+     "foo/bar" nil
+     "foo" "bar"
+     nil "baz/barf.lisp"
+     nil "/baz/barf.lisp"
+     nil nil))
+
+(defun test-new-append-directories (&optional (test-dirs *append-dirs-tests*))
+  (do* ((dir-list test-dirs (cddr dir-list))
+	(abs-dir (car dir-list) (car dir-list))
+	(rel-dir (cadr dir-list) (cadr dir-list)))
+      ((null dir-list) (values))
+    (format t "~&ABS: ~S ~18TREL: ~S ~41TResult: ~S"
+	    abs-dir rel-dir (new-append-directories abs-dir rel-dir))))
+
+#|
+<cl> (test-new-append-directories) 
+
+ABS: "~/foo/"     REL: "baz/bar.lisp"    Result: "/usr0/mkant/foo/baz/bar.lisp"
+ABS: "~/foo"      REL: "baz/bar.lisp"    Result: "/usr0/mkant/foo/baz/bar.lisp"
+ABS: "/foo/bar/"  REL: "baz/barf.lisp"   Result: "/foo/bar/baz/barf.lisp"
+ABS: "/foo/bar/"  REL: "/baz/barf.lisp"  Result: "/foo/bar/baz/barf.lisp"
+ABS: "foo/bar/"   REL: "baz/barf.lisp"   Result: "foo/bar/baz/barf.lisp"
+ABS: "foo/bar"    REL: "baz/barf.lisp"   Result: "foo/bar/baz/barf.lisp"
+ABS: "foo/bar"    REL: "/baz/barf.lisp"  Result: "foo/bar/baz/barf.lisp"
+ABS: "foo/bar/"   REL: "/baz/barf.lisp"  Result: "foo/bar/baz/barf.lisp"
+ABS: "/foo/bar/"  REL: NIL               Result: "/foo/bar/"
+ABS: "foo/bar/"   REL: NIL               Result: "foo/bar/"
+ABS: "foo/bar"    REL: NIL               Result: "foo/bar/"
+ABS: NIL          REL: "baz/barf.lisp"   Result: "baz/barf.lisp"
+ABS: NIL          REL: "/baz/barf.lisp"  Result: "/baz/barf.lisp"
+ABS: NIL          REL: NIL               Result: ""
+
+|#
+
+(defun append-directories (absolute-directory relative-directory)
+  "There is no CL primitive for tacking a subdirectory onto a directory.
+   We need such a function because defsystem has both absolute and
+   relative pathnames in the modules. This is a somewhat ugly hack which
+   seems to work most of the time. We assume that ABSOLUTE-DIRECTORY
+   is a directory, with no filename stuck on the end. Relative-directory,
+   however, may have a filename stuck on the end."
+  (when (or absolute-directory relative-directory)
+    (cond 
+     #+:logical-pathnames-mk
+     ((eq (lp:pathname-host-type absolute-directory) :logical)
+      ;; For use with logical pathnames package.
+      (lp:append-logical-directories absolute-directory relative-directory))
+     (t
+      ;; In VMS, merge-pathnames actually does what we want!!!
+      #+:VMS(namestring (merge-pathnames (or absolute-directory "")
+					 (or relative-directory "")))
+      #+:macl1.3.2(namestring (make-pathname :directory absolute-directory
+					     :name relative-directory))
+      ;; Cross your fingers and pray.
+      #-(or :VMS :macl1.3.2)
+      (new-append-directories absolute-directory relative-directory)))))
+
+#|
+(defun append-directories (absolute-directory relative-directory)
+  "There is no CL primitive for tacking a subdirectory onto a directory.
+   We need such a function because defsystem has both absolute and
+   relative pathnames in the modules. This is a very gross hack which
+   seems to work most of the time. We assume that ABSOLUTE-DIRECTORY
+   is a directory, with no filename stuck on the end. Relative-directory,
+   however, may have a filename stuck on the end. We assume that 
+   if we do a (make-pathname :directory abs-directory :name rel-directory)
+   it will do what we want. The #+ and #-'s that appear before this
+   form are used to massage abs-directory and rel-directory into a
+   format acceptable to make-pathname in the particular lisp."
+  (when (or absolute-directory relative-directory)
+    (cond 
+     #+:logical-pathnames-mk
+     ((eq (pathname-host-type absolute-directory) :logical)
+      ;; For use with logical pathnames package.
+      (lp::append-logical-directories absolute-directory relative-directory))
+     (t
+      ;; Allegro CL barfs if abs-dir is "", so we replace it with NIL.
+      #+:ExCL(when (and (stringp absolute-directory)
+			(null-string absolute-directory))
+	       (setq absolute-directory nil))
+      ;; CMU CL needs a / at the end of absolute directory, so we
+      ;; coerce abs-dir to a namestring and then check the last character
+      ;; of the namestring. An alternate method of doing this might
+      ;; be to break the directory into components, cons :absolute or
+      ;; :relative on the front, and hand that off to make-pathname.
+      #+:CMU(when (pathnamep absolute-directory) 
+	      (setq absolute-directory (namestring absolute-directory)))
+      #+:CMU(when (and absolute-directory 
+		       (not (null-string absolute-directory))
+		       (not (char= (char absolute-directory
+					 (1- (length absolute-directory)))
+				   #\/)))
+	      (setq absolute-directory 
+		    (concatenate 'string absolute-directory "/")))
+      #+:CMU(when (pathnamep relative-directory) 
+	      (setq relative-directory (namestring relative-directory)))
+      ;; In VMS, merge-pathnames actually does what we want!!!
+      #+:VMS(namestring (merge-pathnames (or absolute-directory "")
+					 (or relative-directory "")))
+      ;; For Sun Common Lisp 4.0, which is the same as Lucid 4.0.
+      ;; For this one, we need to break the string up into components,
+      ;; and tack a :ROOT on the front.
+      ;; The :lucid probably should be removed below for it to work properly
+      ;; in Lucid 3.0.
+      #+(or (and (not :excl) :SUN) :lcl4.0 :lucid)
+      (namestring (make-pathname 
+		   :directory (cons :ROOT
+				    (parse-slashed-pathname
+				     (merge-pathnames absolute-directory)))
+				 :name relative-directory))
+      #|(namestring (make-pathname
+		   :directory (list :ROOT (or absolute-directory ""))
+		   :name relative-directory))|#
+      ;; Cross your fingers and pray.
+      #-(or :VMS (and (not :excl) :SUN) :lcl4.0 :lucid)
+      (namestring (make-pathname :directory absolute-directory
+				 #+:cmu :device #+:cmu :absolute
+				 #+:symbolics :host #+:symbolics nil
+				 :name relative-directory))))))
+
+(defun parse-with-delimiter (line &optional (delim #\/))
+  (let ((pos (position delim line)))
+    (cond (pos
+           (cons (subseq line 0 pos)
+                 (parse-with-delimiter (subseq line (1+ pos)) delim)))
+          (t
+           (list line)))))
+
+(defun parse-slashed-pathname (directory)
+  "Parses strings like \"/usr/mkant/Public/\" into a list of
+   the directory components: '(\"usr\" \"mkant\" \"Public\"),
+   with null components (\"\") removed."
+  (if directory
+      (remove-if #'(lambda (string) (string-equal string ""))
+		 (parse-with-delimiter directory #\/))
+      (list "")))
+|#
+
+#|
+;;; This was a try at appending a subdirectory onto a directory.
+;;; It failed. We're keeping this around to prevent future mistakes
+;;; of a similar sort.
+(defun merge-directories (absolute-directory relative-directory)
+  ;; replace concatenate with something more intelligent
+  ;; i.e., concatenation won't work with some directories.
+  ;; it should also behave well if the parent directory 
+  ;; has a filename at the end, or if the relative-directory ain't relative
+  (when absolute-directory 
+    (setq absolute-directory (pathname-directory absolute-directory)))
+  (concatenate 'string 
+	       (or absolute-directory "")
+	       (or relative-directory "")))
+|#
+
+
+
+#|
+<cl> (defun d (d n) (namestring (make-pathname :directory d :name n)))
+
+D
+<cl> (d "~/foo/" "baz/bar.lisp")
+"/usr0/mkant/foo/baz/bar.lisp" 
+
+<cl> (d "~/foo" "baz/bar.lisp")
+"/usr0/mkant/foo/baz/bar.lisp" 
+
+<cl> (d "/foo/bar/" "baz/barf.lisp")
+"/foo/bar/baz/barf.lisp"
+
+<cl> (d "foo/bar/" "baz/barf.lisp")
+"foo/bar/baz/barf.lisp"
+
+<cl> (d "foo/bar" "baz/barf.lisp")
+"foo/bar/baz/barf.lisp"
+
+<cl> (d "foo/bar" "/baz/barf.lisp")
+"foo/bar//baz/barf.lisp"
+
+<cl> (d "foo/bar" nil)
+"foo/bar/"
+
+<cl> (d nil "baz/barf.lisp")
+"baz/barf.lisp"
+
+<cl> (d nil nil)
+""
+
+|#
+
+
+(defun namestring-or-nil (pathname)
+  (when pathname
+    (namestring pathname)))
+
+(defun new-file-type (pathname type)
+  (make-pathname
+   :host (pathname-host pathname)
+   :device (pathname-device pathname)
+   :directory (pathname-directory pathname)
+   :name (pathname-name pathname)
+   :type type
+   :version (pathname-version pathname)))
+
+
+
+;;; ********************************
+;;; Component Defstruct ************
+;;; ********************************
+(defvar *source-pathname-default* nil
+  "Default value of :source-pathname keyword in DEFSYSTEM. Set this to
+   \"\" to avoid having to type :source-pathname \"\" all the time.")
+(defvar *binary-pathname-default* nil
+  "Default value of :binary-pathname keyword in DEFSYSTEM.")
+
+(defstruct (topological-sort-node (:conc-name topsort-))
+  color
+  time)
+
+(defstruct (component (:include topological-sort-node)
+                      (:print-function print-component))
+  type                ; :defsystem, :system, :subsystem, :module, :file, or :private-file
+  name                ; a symbol or string
+  indent              ; number of characters of indent in verbose output to the user.
+  host                ; the pathname host (i.e., "/../a")
+  device              ; the pathname device
+  source-root-dir
+  ;; relative or absolute (starts with "/"), directory or file (ends with "/")
+  (source-pathname *source-pathname-default*)
+  source-extension    ; a string, e.g., "lisp". If nil, uses default for machine-type
+  (binary-pathname *binary-pathname-default*)
+  binary-root-dir
+  binary-extension    ; a string, e.g., "fasl". If nil, uses default for machine-type
+  package             ; package for use-package
+  components          ; a list of components comprising this component's definition
+  depends-on          ; a list of the components this one depends on. may refer only
+                      ; to the components at the same level as this one.
+  initially-do        ; form to evaluate before the operation
+  finally-do          ; form to evaluate after the operation
+  compile-form        ; for foreign libraries
+  load-form           ; for foreign libraries
+;  load-time           ; The file-write-date of the binary/source file loaded.
+  ;; If load-only is T, will not compile the file on operation :compile.
+  ;; In other words, for files which are :load-only T, loading the file
+  ;; satisfies any demand to recompile.
+  load-only           ; If T, will not compile this file on operation :compile.
+  ;; If compile-only is T, will not load the file on operation :compile.
+  ;; Either compiles or loads the file, but not both. In other words,
+  ;; compiling the file satisfies the demand to load it. This is useful
+  ;; for PCL defmethod and defclass definitions, which wrap a 
+  ;; (eval-when (compile load eval) ...) around the body of the definition.
+  ;; This saves time in some lisps.
+  compile-only        ; If T, will not load this file on operation :compile.
+)
+
+(defvar *file-load-time-table* (make-hash-table :test #'equal)
+  "Hash table of file-write-dates for the system definitions and 
+   files in the system definitions.")
+(defun component-load-time (component)
+  (when component
+    (etypecase component
+      (string    (gethash component *file-load-time-table*))
+      (pathname (gethash (namestring component) *file-load-time-table*))
+      (component 
+       (ecase (component-type component)
+	 (:defsystem
+	  (let ((name (component-name component))
+		(path nil))
+	    (when (and name
+		       (setf path (compute-system-path name nil)))
+	      (gethash (namestring path) *file-load-time-table*))))
+	 ((:file :private-file)
+	  ;; Use only :source pathname to identify component's
+	  ;; load time.
+	  (let ((path (component-full-pathname component :source)))
+	    (when path
+	      (gethash (namestring path) *file-load-time-table*)))))))))
+(defsetf component-load-time (component) (value)
+  `(when ,component
+    (etypecase ,component
+      (string   (setf (gethash ,component *file-load-time-table*) ,value))
+      (pathname (setf (gethash (namestring ,component) *file-load-time-table*)
+		      ,value))
+      (component 
+       (ecase (component-type ,component)
+	 (:defsystem
+	  (let ((name (component-name ,component))
+		(path nil))
+	    (when (and name
+		       (setf path (compute-system-path name nil)))
+	      (setf (gethash (namestring path) *file-load-time-table*)
+		    ,value))))
+	 ((:file :private-file)
+	  ;; Use only :source pathname to identify file.
+	  (let ((path (component-full-pathname ,component :source)))
+	    (when path
+	      (setf (gethash (namestring path) *file-load-time-table*)
+		    ,value)))))))))
+
+(defun compute-system-path (module-name definition-pname)
+  (let* ((filename (format nil "~A.system" 
+			   (if (symbolp module-name)
+			       (string-downcase (string module-name))
+			       module-name))))
+    (or (when definition-pname		; given pathname for system def
+	  (probe-file definition-pname))
+	(probe-file filename)		; try current dir
+	(when *central-registry*	; central registry
+	  (if (listp *central-registry*)
+	      (dolist (registry *central-registry*)
+		(let ((file (probe-file (append-directories registry
+							    filename))))
+		  (when file (return file))))
+	      (probe-file (append-directories *central-registry* filename)))) 
+	)))
+
+(defvar *reload-systems-from-disk* t
+  "If T, always tries to reload newer system definitions from disk.
+   Otherwise first tries to find the system definition in the current
+   environment.")
+
+(defun FIND-SYSTEM (system-name &optional (mode :ask) definition-pname)
+  "Returns the system named SYSTEM-NAME. If not already loaded, loads it.
+   This allows operate-on-system to work on non-loaded as well as
+   loaded system definitions. DEFINITION-PNAME is the pathname for
+   the system definition, if provided."
+  (ecase mode
+    (:ASK
+     (or (get-system system-name)
+	 (when (y-or-n-p-wait 
+		#\y 20
+		"System ~A not loaded. Shall I try loading it? "
+		system-name)
+	   (find-system system-name :load definition-pname))))
+    (:ERROR
+     (or (get-system system-name)
+	 (error "Can't find system named ~s." system-name)))
+    (:LOAD-OR-NIL
+     (let ((system (get-system system-name)))
+       (or (unless *reload-systems-from-disk* system)
+	   (let ((path (compute-system-path system-name definition-pname)))
+	     (when (and path
+			(or (null system)
+			    (null (component-load-time path))
+			    (< (component-load-time path)
+			       (file-write-date path))))
+		   (load path)
+		   (setf system (get-system system-name))
+		   (when system
+			 (setf (component-load-time path)
+			       (file-write-date path))))
+	     system)
+	   system)))
+    (:LOAD
+     (or (unless *reload-systems-from-disk* (get-system system-name))
+	 (or (find-system system-name :load-or-nil definition-pname)
+	     (error "Can't find system named ~s." system-name))))))
+
+(defun print-component (component stream depth)
+  (declare (ignore depth))
+  (format stream "#<~:@(~A~): ~A>"
+          (component-type component)
+          (component-name component)))
+
+(defun describe-system (name &optional (stream *standard-output*))
+  "Prints a description of the system to the stream. If NAME is the
+   name of a system, gets it and prints a description of the system.
+   If NAME is a component, prints a description of the component."
+  (let ((system (if (typep name 'component) name (find-system name :load))))
+    (format stream "~&~A ~A: ~
+                    ~@[~&   Host: ~A~]~
+                    ~@[~&   Device: ~A~]~
+                    ~@[~&   Package: ~A~]~
+                    ~&   Source: ~@[~A~] ~@[~A~] ~@[~A~]~
+                    ~&   Binary: ~@[~A~] ~@[~A~] ~@[~A~]~
+                    ~@[~&   Depends On: ~A ~]~&   Components: ~{~15T~A~&~}"
+	    (component-type system)
+	    (component-name system)
+	    (component-host system)
+	    (component-device system)
+	    (component-package system)
+	    (component-root-dir system :source)
+	    (component-pathname system :source)
+	    (component-extension system :source)
+	    (component-root-dir system :binary)
+	    (component-pathname system :binary)
+	    (component-extension system :binary)
+	    (component-depends-on system)
+	    (component-components system))
+    #|(when recursive
+      (dolist (component (component-components system))
+	(describe-system component stream recursive)))|#      
+    system))
+
+(defun canonicalize-component-name (component)
+  ;; Within the component, the name is a string.
+  (if (typep (component-name component) 'string)
+      ;; Unnecessary to change it, so just return it, same case
+      (component-name component)
+    ;; Otherwise, make it a downcase string
+    (setf (component-name component) 
+	  (string-downcase (string (component-name component))))))
+
+(defun component-pathname (component type)
+  (when component
+    (case type
+      (:source (component-source-pathname component))
+      (:binary (component-binary-pathname component))
+      (:error  (component-error-pathname component)))))
+(defun component-error-pathname (component)
+  (let ((binary (component-pathname component :binary)))
+    (new-file-type binary *compile-error-file-type*)))
+(defsetf component-pathname (component type) (value)
+  `(when ,component
+     (case ,type
+       (:source (setf (component-source-pathname ,component) ,value))
+       (:binary (setf (component-binary-pathname ,component) ,value)))))
+
+(defun component-root-dir (component type)
+  (when component
+    (case type
+      (:source (component-source-root-dir component))
+      ((:binary :error) (component-binary-root-dir component))
+      )))
+(defsetf component-root-dir (component type) (value)
+  `(when ,component
+     (case ,type
+       (:source (setf (component-source-root-dir ,component) ,value))
+       (:binary (setf (component-binary-root-dir ,component) ,value)))))
+
+(defvar *version-dir* nil
+  "The version subdir. bound in oos.")
+(defvar *version-replace* nil
+  "The version replace. bound in oos.")
+(defvar *version* nil
+  "Default version")
+(defun component-full-pathname (component type &optional (version *version*)
+					  &aux version-dir replace)
+  (when component
+    ;; If the pathname-type is :binary and the root pathname is null,
+    ;; distribute the binaries among the sources (= use :source pathname).
+    ;; This assumes that the component's :source pathname has been set
+    ;; before the :binary one.
+    (if version
+	(multiple-value-setq (version-dir replace) (translate-version version))
+      (setq version-dir *version-dir* replace *version-replace*))
+    (let ((pathname
+	   (append-directories 
+	    (if replace
+		version-dir
+	      (append-directories (component-root-dir component type)
+				  version-dir))
+	    (component-pathname component type))))
+      ;; When a logical pathname is used, it must first be translated to
+      ;; a physical pathname. This isn't strictly correct. What should happen
+      ;; is we fill in the appropriate slots of the logical pathname, and
+      ;; then return the logical pathname for use by compile-file & friends.
+      ;; But calling translate-logical-pathname to return the actual pathname
+      ;; should do for now.
+      #+:logical-pathnames-mk
+      (when (eq (lp:pathname-host-type pathname) :logical)
+	;;(setf (lp::%logical-pathname-type pathname)
+	;;      (component-extension component type))
+	(setf pathname (lp:translate-logical-pathname pathname)))
+
+      (make-pathname :name (pathname-name pathname)
+		     :type (component-extension component type)
+;; couldn't get this to work under CMUcl 16e -- stolcke 9/17/92
+		     #-:cmu :host #-:cmu (when (component-host component)
+			     ;; MCL2.0b1 causes an error on
+			     ;; (pathname-host nil)
+			     (pathname-host (component-host component)))
+;; in CMUcl 15d not needed -- stolcke 9/17/92
+		     ;; :device #+CMU :absolute
+		     ;; #-CMU (pathname-device (component-device component))
+;; but CMUcl 16e doesn't tolerate (pathname-device nil)
+		     :device (when (component-device component)
+			         (pathname-device (component-device component)))
+		     ;; :version :newest
+		     ;; Use :directory instead of :defaults
+		     :directory (pathname-directory pathname)))))
+
+(defun translate-version (version)
+  ;; Value returns the version directory and whether it replaces 
+  ;; the entire root (t) or is a subdirectory.
+  ;; Version may be nil to signify no subdirectory,
+  ;; a symbol, such as alpha, beta, omega, :alpha, mark, which
+  ;; specifies a subdirectory of the root, or
+  ;; a string, which replaces the root.
+  (cond ((null version) 
+	 (values "" nil))
+	((symbolp version)
+	 (values (let ((sversion (string version)))
+		   (if (find-if #'lower-case-p sversion)
+		       sversion
+		       (string-downcase sversion))) 
+		 nil))
+	((stringp version)
+	 (values version t))
+	(t (error "~&; Illegal version ~S" version))))
+
+(defun component-extension (component type)
+  (case type
+    (:source (component-source-extension component))
+    (:binary (component-binary-extension component))
+    (:error  *compile-error-file-type*)))
+(defsetf component-extension (component type) (value)
+  `(case ,type
+     (:source (setf (component-source-extension ,component) ,value))
+     (:binary (setf (component-binary-extension ,component) ,value))
+     (:error  (setf *compile-error-file-type* ,value))))
+
+;;; ********************************
+;;; System Definition **************
+;;; ********************************
+(defmacro defsystem (name &rest definition-body)    
+  `(create-component :defsystem ',name ',definition-body nil 0))
+
+(defun create-component (type name definition-body &optional parent (indent 0))
+  (let ((component (apply #'make-component :type type :name name :indent indent definition-body)))
+    ;; Set up :load-only attribute
+    (unless (find :load-only definition-body)
+      ;; If the :load-only attribute wasn't specified, 
+      ;; inherit it from the parent. If no parent, default it to nil.
+      (setf (component-load-only component) 
+	    (when parent
+	      (component-load-only parent))))
+    ;; Set up :compile-only attribute
+    (unless (find :compile-only definition-body)
+      ;; If the :compile-only attribute wasn't specified, 
+      ;; inherit it from the parent. If no parent, default it to nil.
+      (setf (component-compile-only component) 
+	    (when parent
+	      (component-compile-only parent))))
+
+    ;; Initializations/after makes
+    (canonicalize-component-name component)
+
+    ;; Inherit package from parent if not specified.
+    (setf (component-package component)
+	  (or (component-package component)
+	      (when parent (component-package parent))))
+
+    ;; Type specific setup:
+    (when (or (eq type :defsystem) (eq type :system) (eq type :subsystem))
+      (setf (get-system name) component))
+
+    ;; Set up the component's pathname
+    (create-component-pathnames component parent)
+
+    ;; If there are any components of the component, expand them too.
+    (expand-component-components component (+ indent 2))
+
+    ;; Make depends-on refer to structs instead of names.
+    (link-component-depends-on (component-components component))
+
+    ;; Design Decision: Topologically sort the dependency graph at
+    ;; time of definition instead of at time of use. Probably saves a
+    ;; little bit of time for the user.
+
+    ;; Topological Sort the components at this level.
+    (setf (component-components component)
+          (topological-sort (component-components component)))
+
+    ;; Return the component.
+    component))
+
+(defun create-component-pathnames (component parent)
+  ;; Evaluate the root dir arg
+  (setf (component-root-dir component :source)
+	(eval (component-root-dir component :source)))
+  (setf (component-root-dir component :binary)
+	(eval (component-root-dir component :binary)))
+  ;; Evaluate the pathname arg
+  (setf (component-pathname component :source)
+	(eval (component-pathname component :source)))
+  (setf (component-pathname component :binary)
+	(eval (component-pathname component :binary)))
+  ;; Pass along the host and devices
+  (setf (component-host component)
+	(or (component-host component)
+	    (when parent (component-host parent))))
+  (setf (component-device component)
+	(or (component-device component)
+	    (when parent (component-device parent))))
+  ;; Set up extension defaults
+  (setf (component-extension component :source)
+	(or (component-extension component :source) ; for local defaulting
+	    (when parent		; parent's default
+	      (component-extension parent :source))
+	    (car *filename-extensions*))) ; system default
+  (setf (component-extension component :binary)
+	(or (component-extension component :binary) ; for local defaulting
+	    (when parent		; parent's default
+	      (component-extension parent :binary))
+	    (cdr *filename-extensions*))) ; system default
+  ;; Set up pathname defaults -- expand with parent
+  ;; We must set up the source pathname before the binary pathname
+  ;; to allow distribution of binaries among the sources to work.
+  (generate-component-pathname component parent :source)
+  (generate-component-pathname component parent :binary))
+
+;; maybe file's inheriting of pathnames should be moved elsewhere?
+(defun generate-component-pathname (component parent pathname-type)
+  ;; Pieces together a pathname for the component based on its component-type.
+  ;; Assumes source defined first.
+  ;; Null binary pathnames inherit from source instead of the component's
+  ;; name. This allows binaries to be distributed among the source if
+  ;; binary pathnames are not specified. Or if the root directory is
+  ;; specified for binaries, but no module directories, it inherits
+  ;; parallel directory structure.
+  (case (component-type component)
+    ((:defsystem :system)		; Absolute Pathname
+     ;; Set the root-dir to be the absolute pathname
+     (setf (component-root-dir component pathname-type)
+	   (or (component-pathname component pathname-type)
+	       (when (eq pathname-type :binary)
+		 ;; When the binary root is nil, use source.
+		 (component-root-dir component :source))) )
+     ;; Set the relative pathname to be nil
+     (setf (component-pathname component pathname-type) 
+	   nil));; should this be "" instead?
+    ;; If the name of the component-pathname is nil, it
+    ;; defaults to the name of the component. Use "" to
+    ;; avoid this defaulting.
+    (:private-file                      ; Absolute Pathname
+     ;; Root-dir is the directory part of the pathname
+     (setf (component-root-dir component pathname-type)
+	   ""
+	   #+ignore(or (when (component-pathname component pathname-type)
+			 (pathname-directory 
+			  (component-pathname component pathname-type)))
+		       (when (eq pathname-type :binary)
+			 ;; When the binary root is nil, use source.
+			 (component-root-dir component :source)))
+	   )
+     ;; The relative pathname is the name part
+     (setf (component-pathname component pathname-type)
+	   (or (when (and (eq pathname-type :binary)
+			  (null (component-pathname component :binary)))
+		 ;; When the binary-pathname is nil use source.
+		 (component-pathname component :source))
+	       (or (when (component-pathname component pathname-type)
+;		     (pathname-name )
+		     (component-pathname component pathname-type))
+		   (component-name component)))))
+    ((:module :subsystem)			; Pathname relative to parent.
+     ;; Inherit root-dir from parent
+     (setf (component-root-dir component pathname-type)
+	   (component-root-dir parent pathname-type))
+     ;; Tack the relative-dir onto the pathname
+     (setf (component-pathname component pathname-type)
+	   (or (when (and (eq pathname-type :binary)
+			  (null (component-pathname component :binary)))
+		 ;; When the binary-pathname is nil use source.
+		 (component-pathname component :source))
+	       (append-directories
+		(component-pathname parent pathname-type)
+		(or (component-pathname component pathname-type)
+		    (component-name component))))))
+    (:file				; Pathname relative to parent.
+     ;; Inherit root-dir from parent
+     (setf (component-root-dir component pathname-type)
+	   (component-root-dir parent pathname-type))
+     ;; Tack the relative-dir onto the pathname
+     (setf (component-pathname component pathname-type)
+	   (or (append-directories
+		(component-pathname parent pathname-type)
+		(or (component-pathname component pathname-type)
+		    (component-name component)
+		    (when (eq pathname-type :binary)
+		      ;; When the binary-pathname is nil use source.
+		      (component-pathname component :source)))))))
+    ))	   
+
+(defun expand-component-components (component &optional (indent 0)) 
+  (setf (component-components component)
+	(remove-if #'null
+	   (mapcar #'(lambda (definition)
+		       (expand-component-definition definition
+						    component indent))
+		   (component-components component)))))
+
+(defun expand-component-definition (definition parent &optional (indent 0))
+  ;; Should do some checking for malformed definitions here.
+  (cond ((null definition) nil)
+        ((stringp definition) 
+         ;; Strings are assumed to be of type :file
+         (create-component :file definition nil parent indent))
+        ((and (listp definition)
+              (not (member (car definition) 
+			   '(:defsystem :system :subsystem
+			     :module :file :private-file))))
+         ;; Lists whose first element is not a component type
+         ;; are assumed to be of type :file
+         (create-component :file (car definition) (cdr definition) parent indent))
+        ((listp definition)
+         ;; Otherwise, it is (we hope) a normal form definition
+         (create-component (car definition)   ; type
+                           (cadr definition)  ; name
+                           (cddr definition)  ; definition body
+                           parent             ; parent
+			   indent)            ; indent
+         )))
+
+(defun link-component-depends-on (components)
+  (dolist (component components)
+    (unless (and *system-dependencies-delayed*
+                 (eq (component-type component) :defsystem))
+      (setf (component-depends-on component)
+            (mapcar #'(lambda (dependency)
+			(let ((parent (find (string dependency) components
+					    :key #'component-name 
+					    :test #'string-equal)))
+			  (cond (parent parent)
+				;; make it more intelligent about the following
+				(t (warn "Dependency ~S of component ~S not found."
+					 dependency component)))))
+			      
+                    (component-depends-on component))))))
+
+;;; ********************************
+;;; Topological Sort the Graph *****
+;;; ********************************
+(defun topological-sort (list &aux (time 0))
+  ;; The algorithm works by calling depth-first-search to compute the
+  ;; blackening times for each vertex, and then sorts the vertices into
+  ;; reverse order by blackening time.
+  (labels ((dfs-visit (node)
+	      (setf (topsort-color node) 'gray)
+	      (unless (and *system-dependencies-delayed*
+			   (eq (component-type node) :defsystem))
+		(dolist (child (component-depends-on node))
+		  (cond ((eq (topsort-color child) 'white)
+			 (dfs-visit child))
+			((eq (topsort-color child) 'gray)
+			 (format t "~&Detected cycle containing ~A" child)))))
+		      (setf (topsort-color node) 'black)
+		      (setf (topsort-time node) time)
+		      (incf time)))
+    (dolist (node list)
+      (setf (topsort-color node) 'white))
+    (dolist (node list)
+      (when (eq (topsort-color node) 'white)
+        (dfs-visit node)))
+    (sort list #'< :key #'topsort-time)))
+
+;;; ********************************
+;;; Output to User *****************
+;;; ********************************
+;;; All output to the user is via the tell-user functions.
+
+(defun split-string (string &key (item #\space) (test #'char=))
+  ;; Splits the string into substrings at spaces.
+  (let ((len (length string))
+	(index 0) result)
+    (dotimes (i len
+		(progn (unless (= index len)
+			 (push (subseq string index) result))
+		       (reverse result)))
+      (when (funcall test (char string i) item)
+	(unless (= index i);; two spaces in a row
+	  (push (subseq string index i) result))
+	(setf index (1+ i))))))
+
+;; probably should remove the ",1" entirely.
+(defun prompt-string (component)
+  (format nil "; ~:[~;TEST:~]~V,1@T "
+	  *oos-test*
+	  (component-indent component)))
+
+#|
+(defun format-justified-string (prompt contents)
+  (format t (concatenate 'string "~%" prompt "-~{~<~%" prompt " ~1,80:; ~A~>~^~}")
+	  (split-string contents))
+  (finish-output *standard-output*))
+|#
+
+(defun format-justified-string (prompt contents &optional (width 80)
+				       (stream *standard-output*))
+  (let ((prompt-length (+ 2 (length prompt))))
+    (cond ((< (+ prompt-length (length contents)) width)
+	   (format stream "~%~A- ~A" prompt contents))
+	  (t
+	   (format stream "~%~A-" prompt)
+	   (do* ((cursor prompt-length)
+		 (contents (split-string contents) (cdr contents))
+		 (content (car contents) (car contents))
+		 (content-length (1+ (length content)) (1+ (length content))))
+	       ((null contents))
+	     (cond ((< (+ cursor content-length) width)
+		    (incf cursor content-length)
+		    (format stream " ~A" content))
+		   (t
+		    (setf cursor (+ prompt-length content-length))
+		    (format stream "~%~A  ~A" prompt content)))))))
+  (finish-output stream))
+
+(defun tell-user (what component &optional type no-dots force)
+  (when (or *oos-verbose* force)
+    (format-justified-string (prompt-string component)
+     (format nil "~A ~(~A~) ~@[\"~A\"~] ~:[~;...~]"
+	     ;; To have better messages, wrap the following around the
+	     ;; case statement:
+	     ;;(if (find (component-type component) 
+	     ;;    '(:defsystem :system :subsystem :module))
+	     ;;  "Checking"
+	     ;;  (case ...))
+	     ;; This gets around the problem of DEFSYSTEM reporting
+	     ;; that it's loading a module, when it eventually never
+	     ;; loads any of the files of the module.
+	     (case what 
+	       ((compile :compile) 
+		(if (component-load-only component)
+		    ;; If it is :load-only t, we're loading.
+		    "Loading"
+		    ;; Otherwise we're compiling.
+		    "Compiling"))
+	       ((load :load) "Loading")
+	       (otherwise what))
+	     (component-type component)
+	     (or (when type
+		   (namestring-or-nil (component-full-pathname
+				       component type)))
+		 (component-name component))
+	     (and *tell-user-when-done*
+		  (not no-dots))))))
+
+(defun tell-user-done (component &optional force no-dots)
+  ;; test is no longer really used, but we're leaving it in.
+  (when (and *tell-user-when-done*
+	     (or *oos-verbose* force))
+    (format t "~&~A~:[~;...~] Done."
+	    (prompt-string component) (not no-dots))
+    (finish-output *standard-output*)))
+
+(defmacro with-tell-user ((what component &optional type no-dots force) &body body)
+  `(progn
+     (tell-user ,what ,component ,type ,no-dots ,force)
+     ,@body
+     (tell-user-done ,component ,force ,no-dots)))
+
+(defun tell-user-no-files (component &optional force)
+  (when (or *oos-verbose* force)
+    (format-justified-string (prompt-string component)
+      (format nil "Source file ~A ~
+             ~:[and binary file ~A ~;~]not found, not loading."
+	      (namestring (component-full-pathname component :source))
+	      (or *load-source-if-no-binary* *load-source-instead-of-binary*)
+	      (namestring (component-full-pathname component :binary))))))
+
+(defun tell-user-require-system (name parent)
+  (when *oos-verbose*
+    (format t "~&; ~:[~;TEST:~] - System ~A requires ~S"
+	    *oos-test* (component-name parent) name)
+    (finish-output *standard-output*)))
+
+(defun tell-user-generic (string)
+  (when *oos-verbose*
+    (format t "~&; ~:[~;TEST:~] - ~A"
+	    *oos-test* string)
+    (finish-output *standard-output*)))
+
+;;; ********************************
+;;; Y-OR-N-P-WAIT ******************
+;;; ********************************
+;;; y-or-n-p-wait is like y-or-n-p, but will timeout
+;;; after a specified number of seconds
+(defun internal-real-time-in-seconds ()
+  (float (/ (get-internal-real-time) 
+	    internal-time-units-per-second)))
+
+(defun read-char-wait (&optional (timeout 20) input-stream &aux char)
+  (do ((start (internal-real-time-in-seconds)))
+      ((or (setq char (read-char-no-hang input-stream)) ;(listen *query-io*)
+	   (< (+ start timeout) (internal-real-time-in-seconds)))
+       char)))
+
+;;; Lots of lisps, especially those that run on top of UNIX, do not get
+;;; their input one character at a time, but a whole line at a time because
+;;; of the buffering done by the UNIX system. This causes y-or-n-p-wait
+;;; to not always work as expected. 
+;;;
+;;; I wish lisp did all its own buffering (turning off UNIX input line
+;;; buffering by putting the UNIX into CBREAK mode). Of course, this means
+;;; that we lose input editing, but why can't the lisp implement this? 
+
+(defvar *use-timeouts* t
+  "If T, timeouts in Y-OR-N-P-WAIT are enabled. Otherwise it behaves
+   like Y-OR-N-P. This is provided for users whose lisps don't handle
+   read-char-no-hang properly.")
+
+(defvar *clear-input-before-query* t
+  "If T, y-or-n-p-wait will clear the input before printing the prompt
+   and asking the user for input.")
+
+(defun y-or-n-p-wait (&optional (default #\y) (timeout 20) 
+				format-string &rest args)
+  "Y-OR-N-P-WAIT prints the message, if any, and reads characters from
+   *QUERY-IO* until the user enters y, Y or space as an affirmative, or either
+   n or N as a negative answer, or the timeout occurs. It asks again if
+   you enter any other characters."
+  (when *clear-input-before-query* (clear-input *query-io*))
+  (when format-string
+    (fresh-line *query-io*)
+    (apply #'format *query-io* format-string args)
+    ;; FINISH-OUTPUT needed for CMU and other places which don't handle
+    ;; output streams nicely. This prevents it from continuing and
+    ;; reading the query until the prompt has been printed.
+    (finish-output *query-io*))
+  (loop
+   (let* ((read-char (if *use-timeouts*
+			 (read-char-wait timeout *query-io*)
+			 (read-char *query-io*)))
+	  (char (or read-char default)))
+     ;; We need to ignore #\newline because otherwise the bugs in 
+     ;; clear-input will cause y-or-n-p-wait to print the "Type ..."
+     ;; message every time... *sigh*
+     ;; Anyway, we might want to use this to ignore whitespace once
+     ;; clear-input is fixed.
+     (unless (find char '(#\tab #\newline #\return))
+       (when (null read-char) 
+	 (format *query-io* "~@[~A~]" default)
+	 (finish-output *query-io*))
+       (cond ((null char) (return t))
+	     ((find char '(#\y #\Y #\space) :test #'char=) (return t))
+	     ((find char '(#\n #\N) :test #'char=) (return nil))
+	     (t 
+	      (when *clear-input-before-query* (clear-input *query-io*))
+	      (format *query-io* "~&Type \"y\" for yes or \"n\" for no. ")
+	      (when format-string
+		(fresh-line *query-io*)
+		(apply #'format *query-io* format-string args))
+	      (finish-output *query-io*)))))))
+
+#|
+(y-or-n-p-wait #\y 20 "What? ")
+(progn (format t "~&hi") (finish-output)
+       (y-or-n-p-wait #\y 10 "1? ")
+       (y-or-n-p-wait #\n 10 "2? "))
+|#
+;;; ********************************
+;;; Operate on System **************
+;;; ********************************
+;;; Operate-on-system
+;; Operation is :compile, 'compile, :load or 'load
+;; Force is :all or :new-source or :new-source-and-dependents or a list of
+;; specific modules.
+;;    :all (or T) forces a recompilation of every file in the system
+;;    :new-source-and-dependents compiles only those files whose
+;;          sources have changed or who depend on recompiled files.
+;;    :new-source compiles only those files whose sources have changed
+;;    A list of modules means that only those modules and their dependents are recompiled.
+;; Test is T to print out what it would do without actually doing it. 
+;;      Note: it automatically sets verbose to T if test is T.
+;; Verbose is T to print out what it is doing (compiling, loading of
+;;      modules and files) as it does it.
+;; Dribble should be the pathname of the dribble file if you want to 
+;; dribble the compilation.
+;; Load-source-instead-of-binary is T to load .lisp instead of binary files.
+;; Version may be nil to signify no subdirectory,
+;; a symbol, such as alpha, beta, omega, :alpha, mark, which
+;; specifies a subdirectory of the root, or
+;; a string, which replaces the root.
+;;
+(defun operate-on-system (name operation &key force
+			       (version *version*)
+			       (test *oos-test*) (verbose *oos-verbose*)
+                               (load-source-instead-of-binary *load-source-instead-of-binary*)
+                               (load-source-if-no-binary *load-source-if-no-binary*) 
+			       (bother-user-if-no-binary *bother-user-if-no-binary*)
+			       (compile-during-load *compile-during-load*)
+			       dribble
+			       (minimal-load *minimal-load*))
+  (unwind-protect
+      ;; Protect the undribble.
+      (progn
+	(when dribble (dribble dribble))
+	(when test (setq verbose t))
+	(when (null force);; defaults
+	  (case operation
+	    ((load :load) (setq force :all))
+	    ((compile :compile) (setq force :new-source-and-dependents))
+	    (t (setq force :all))))
+	;; Some CL implementations have a variable called *compile-verbose*
+	;; or *compile-file-verbose*.
+	(multiple-value-bind (*version-dir* *version-replace*) 
+	    (translate-version version)
+	  ;; CL implementations may uniformly default this to nil
+	  (let ((*load-verbose* t) ; nil
+		;; avoid warning from CMUcl compiler -- stolcke 9/18/92
+		;; KCL also doesn't about these -- stolcke 10/22/93
+		#-(or :cmu :kcl :ECL) (*compile-file-verbose* t) ; nil
+		#-(or :kcl :ECL) (*compile-verbose* t) ; nil
+		(*version* version)
+		(*oos-verbose* verbose)
+		(*oos-test* test)
+		(*load-source-if-no-binary* load-source-if-no-binary)
+		(*compile-during-load* compile-during-load)
+		(*bother-user-if-no-binary* bother-user-if-no-binary)
+		(*load-source-instead-of-binary* load-source-instead-of-binary)
+		(*minimal-load* minimal-load)
+		(system (find-system name :load)))
+	    (unless (component-operation operation)
+	      (error "Operation ~A undefined." operation))
+	    (operate-on-component system operation force))))
+    (when dribble (dribble))))
+
+(defun COMPILE-SYSTEM (name &key force
+			    (version *version*)
+			    (test *oos-test*) (verbose *oos-verbose*)
+			    (load-source-instead-of-binary *load-source-instead-of-binary*)
+			    (load-source-if-no-binary *load-source-if-no-binary*) 
+			    (bother-user-if-no-binary *bother-user-if-no-binary*)
+			    (compile-during-load *compile-during-load*)
+			    dribble
+			    (minimal-load *minimal-load*))
+  ;; For users who are confused by OOS.
+  (operate-on-system 
+   name :compile
+   :force force
+   :version version
+   :test test
+   :verbose verbose
+   :load-source-instead-of-binary load-source-instead-of-binary
+   :load-source-if-no-binary load-source-if-no-binary
+   :bother-user-if-no-binary bother-user-if-no-binary
+   :compile-during-load compile-during-load
+   :dribble dribble
+   :minimal-load minimal-load))
+
+(defun LOAD-SYSTEM (name &key force
+			 (version *version*)
+			 (test *oos-test*) (verbose *oos-verbose*)
+			 (load-source-instead-of-binary *load-source-instead-of-binary*)
+			 (load-source-if-no-binary *load-source-if-no-binary*) 
+			 (bother-user-if-no-binary *bother-user-if-no-binary*)
+			 (compile-during-load *compile-during-load*)
+			 dribble
+			 (minimal-load *minimal-load*))
+  ;; For users who are confused by OOS.
+  (operate-on-system 
+   name :load
+   :force force
+   :version version
+   :test test
+   :verbose verbose
+   :load-source-instead-of-binary load-source-instead-of-binary
+   :load-source-if-no-binary load-source-if-no-binary
+   :bother-user-if-no-binary bother-user-if-no-binary
+   :compile-during-load compile-during-load
+   :dribble dribble
+   :minimal-load minimal-load))
+
+(defun operate-on-component (component operation force &aux changed)
+  ;; Returns T if something changed and had to be compiled.
+  (let ((type (component-type component))
+	(old-package (package-name *package*)))
+
+    (unwind-protect
+	;; Protect old-package.
+	(progn
+	  ;; Use the correct package.
+	  (when (component-package component)
+	    (tell-user-generic (format nil "Using package ~A" 
+				       (component-package component)))
+	    (unless *oos-test*
+	      (unless (find-package (component-package component))
+		;; If the package name is the same as the name of the system,
+		;; and the package is not defined, this would lead to an
+		;; infinite loop, so bomb out with an error.
+		(when (string-equal (string (component-package component)) 
+				    (component-name component))
+		  (format t "~%Component ~A not loaded:~%"
+			  (component-name component))
+		  (error  "  Package ~A is not defined"
+			  (component-package component)))
+		;; If package not found, try using REQUIRE to load it.
+		(new-require (component-package component)))
+	      ;; This was USE-PACKAGE, but should be IN-PACKAGE.
+	      ;; Actually, CLtL2 lisps define in-package as a macro,
+	      ;; so we'll set the package manually.
+	      ;; (in-package (component-package component))
+	      (let ((package (find-package (component-package component))))
+		(when package
+		  (setf *package* package)))))
+
+	  ;; Load any required systems
+	  (when (eq type :defsystem)	; maybe :system too?
+	    (operate-on-system-dependencies component operation force))
+
+	  ;; Do any initial actions
+	  (when (component-initially-do component)
+	    (tell-user-generic (format nil "Doing initializations for ~A"
+				       (component-name component)))
+	    (or *oos-test*
+		(eval (component-initially-do component))))
+
+	  ;; If operation is :compile and load-only is T, this would change
+	  ;; the operation to load. Only, this would mean that a module would
+	  ;; be considered to have changed if it was :load-only and had to be
+	  ;; loaded, and then dependents would be recompiled -- this doesn't
+	  ;; seem right. So instead, we propagate the :load-only attribute
+	  ;; to the components, and modify compile-file-operation so that
+	  ;; it won't compile the files (and modify tell-user to say "Loading"
+	  ;; instead of "Compiling" for load-only modules). 
+	  #|(when (and (find operation '(:compile compile))
+	       (component-load-only component))
+      (setf operation :load))|#
+
+	  ;; Do operation and set changed flag if necessary.
+	  (setq changed 
+		(case type
+		  ((:file :private-file)
+		   (funcall (component-operation operation) component force))
+		  ((:module :system :subsystem :defsystem)
+		   (operate-on-components component operation force changed))))
+
+	  ;; Do any final actions
+	  (when (component-finally-do component)
+	    (tell-user-generic (format nil "Doing finalizations for ~A"
+				       (component-name component)))
+	    (or *oos-test*
+		(eval (component-finally-do component)))))
+
+      ;; Reset the package. (Cleanup form of unwind-protect.)
+      ;;(in-package old-package)
+      (setf *package* (find-package old-package)))
+
+    ;; Provide the loaded system
+    (when (or (eq type :defsystem) (eq type :system) (eq type :subsystem))
+      (tell-user-generic (format nil "Providing system ~A"
+				 (component-name component)))
+      (or *oos-test*
+	  (provide (canonicalize-system-name (component-name component))))))
+
+  ;; Return t if something changed in this component and hence had to be recompiled.
+  changed)
+
+(defvar *force* nil)
+(defvar *providing-blocks-load-propagation* t
+  "If T, if a system dependency exists on *modules*, it is not loaded.")
+(defun operate-on-system-dependencies (component operation &optional force)
+  (when *system-dependencies-delayed*
+    (let ((*force* force))
+      (dolist (system (component-depends-on component))
+	;; For each system that this system depends on, if it is a
+	;; defined system (either via defsystem or component type :system),
+	;; and propagation is turned on, propagates the operation to the
+	;; subsystem. Otherwise runs require (my version) on that system
+	;; to load it (needed since we may be depending on a lisp
+	;; dependent package).
+	;; Explores the system tree in a DFS manner.
+	(cond ((and *operations-propagate-to-subsystems*
+		    (not (listp system))
+		    ;; The subsystem is a defined system.
+		    (find-system system :load-or-nil))
+	       ;; Call OOS on it. Since *system-dependencies-delayed* is
+	       ;; T, the :depends-on slot is filled with the names of
+	       ;; systems, not defstructs.
+	       ;; Aside from system, operation, force, for everything else
+	       ;; we rely on the globals.
+	       (unless (and *providing-blocks-load-propagation*
+			    ;; If *providing-blocks-load-propagation* is T,
+			    ;; the system dependency must not exist in the
+			    ;; *modules* for it to be loaded. Note that
+			    ;; the dependencies are implicitly systems.
+			    (find operation '(load :load))    
+			    ;; (or (eq force :all) (eq force t))
+			    (find (canonicalize-system-name system)
+				  *modules* :test #'string=))
+		 (operate-on-system system operation :force force)))
+	      ((listp system)
+	       (tell-user-require-system 
+		(cond ((and (null (car system)) (null (cadr system)))
+		       (caddr system))
+		      (t system))
+		component)
+	       (or *oos-test* (new-require (car system) nil
+					   (eval (cadr system))
+					   (caddr system) 
+					   (or (car (cdddr system))
+					       *version*))))
+	      (t
+	       (tell-user-require-system system component)
+	       (or *oos-test* (new-require system))))))))
+
+(defun operate-on-components (component operation force changed)
+  (with-tell-user (operation component)
+    (if (component-components component)
+	(dolist (module (component-components component))
+	  (when (operate-on-component module operation
+		  (cond ((and (dolist (dependent (component-depends-on module))
+				(when (member dependent changed)
+				  (return t)))
+			      #|(some #'(lambda (dependent)
+					(member dependent changed))
+				    (component-depends-on module))|#
+			      (or (non-empty-listp force)
+				  (eq force :new-source-and-dependents)))
+			 ;; The component depends on a changed file 
+			 ;; and force agrees.
+			 (if (eq force :new-source-and-dependents)
+			     :new-source-all
+			   :all))
+			((and (non-empty-listp force)
+			      (member (component-name module) force
+				      :test #'string-equal :key #'string))
+			 ;; Force is a list of modules 
+			 ;; and the component is one of them.
+			 :all)
+			(t force)))
+	    (push module changed)))
+	(case operation
+	  ((compile :compile)
+	   (eval (component-compile-form component)))
+	  ((load :load)
+	   (eval (component-load-form component))))))
+  changed)
+
+;;; ********************************
+;;; New Require ********************
+;;; ********************************
+(defvar *old-require* nil)
+
+;;; All calls to require in this file have been replaced with calls
+;;; to new-require to avoid compiler warnings and make this less of
+;;; a tangled mess.
+(defun new-require (module-name &optional pathname definition-pname
+				default-action (version *version*))
+  ;; If the pathname is present, this behaves like the old require.
+  (unless (and module-name 
+	       (find #-CMU (string module-name)
+		     #+CMU (string-downcase (string module-name))
+		     *modules* :test #'string=)) 
+    (cond (pathname
+	   (funcall *old-require* module-name pathname))
+	  ;; If the system is defined, load it.
+	  ((find-system module-name :load-or-nil definition-pname)
+	   (operate-on-system module-name :load
+	     :force *force*
+	     :version version
+	     :test *oos-test*
+	     :verbose *oos-verbose*
+	     :load-source-if-no-binary *load-source-if-no-binary*
+	     :bother-user-if-no-binary *bother-user-if-no-binary*
+	     :compile-during-load *compile-during-load*
+	     :load-source-instead-of-binary *load-source-instead-of-binary*
+	     :minimal-load *minimal-load*))
+	  ;; If there's a default action, do it. This could be a progn which
+	  ;; loads a file that does everything. 
+	  ((and default-action
+		(eval default-action)))
+	  ;; If no system definition file, try regular require.
+	  ;; had last arg  PATHNAME, but this wasn't really necessary.
+	  ((funcall *old-require* module-name)) 
+	  ;; If no default action, print a warning or error message.
+	  (t
+	   (format t "~&Warning: System ~A doesn't seem to be defined..." 
+		   module-name)))))
+
+;;; Note that in some lisps, when the compiler sees a REQUIRE form at
+;;; top level it immediately executes it. This is as if an 
+;;; (eval-when (compile load eval) ...) were wrapped around the REQUIRE
+;;; form. I don't see any easy way to do this without making REQUIRE
+;;; a macro. 
+;;;
+;;; For example, in VAXLisp, if a (require 'streams) form is at the top of
+;;; a file in the system, compiling the system doesn't wind up loading the
+;;; streams module. If the (require 'streams) form is included within an
+;;; (eval-when (compile load eval) ...) then everything is OK.
+;;;
+;;; So perhaps we should replace the redefinition of lisp:require
+;;; with the following macro definition:
+#|
+(unless *old-require*
+  (setf *old-require* 
+	(symbol-function #-(and :excl :allegro-v4.0) 'lisp:require
+			 #+(and :excl :allegro-v4.0) 'cltl1:require))
+
+  (let (#+:CCL (ccl:*warn-if-redefine-kernel* nil))
+    ;; Note that lots of lisps barf if we redefine a function from
+    ;; the LISP package. So what we do is define a macro with an
+    ;; unused name, and use (setf macro-function) to redefine 
+    ;; lisp:require without compiler warnings. If the lisp doesn't
+    ;; do the right thing, try just replacing require-as-macro 
+    ;; with lisp:require.
+    (defmacro require-as-macro (module-name 
+				&optional pathname definition-pname
+				default-action (version '*version*))
+      `(eval-when (compile load eval)
+	 (new-require ,module-name ,pathname ,definition-pname 
+		      ,default-action ,version)))
+    (setf (macro-function #-(and :excl :allegro-v4.0) 'lisp:require
+			  #+(and :excl :allegro-v4.0) 'cltl1:require)
+	  (macro-function 'require-as-macro))))
+|#
+;;; This will almost certainly fix the problem, but will cause problems
+;;; if anybody does a funcall on #'require.
+
+;;; Redefine old require to call the new require.
+(unless *old-require*
+  (setf *old-require* 
+	(symbol-function #-(or (and :excl :allegro-v4.0) :mcl) 'lisp:require
+			 #+(and :excl :allegro-v4.0) 'cltl1:require
+			 #+:mcl 'ccl:require))
+
+  (unless *dont-redefine-require*
+    (let (#+:CCL (ccl:*warn-if-redefine-kernel* nil))
+      (setf (symbol-function 
+	     #-(or (and :excl :allegro-v4.0) :mcl) 'lisp:require
+	     #+(and :excl :allegro-v4.0) 'cltl1:require
+	     #+:mcl 'ccl:require)
+	    (symbol-function 'new-require)))))
+
+
+;;; ********************************
+;;; Component Operations ***********
+;;; ********************************
+;;; Define :compile/compile and :load/load operations
+(component-operation :compile  'compile-and-load-operation)
+(component-operation 'compile  'compile-and-load-operation)
+(component-operation :load     'load-file-operation)
+(component-operation 'load     'load-file-operation)
+
+(defun compile-and-load-operation (component force)
+  ;; FORCE was CHANGED. this caused defsystem during compilation to only
+  ;; load files that it immediately compiled.
+  (let ((changed (compile-file-operation component force)))
+    ;; Return T if the file had to be recompiled and reloaded.
+    (if (and changed (component-compile-only component))
+	;; For files which are :compile-only T, compiling the file
+	;; satisfies the need to load. 
+	changed
+	;; If the file wasn't compiled, or :compile-only is nil,
+	;; check to see if it needs to be loaded.
+	(and (load-file-operation component force) ; FORCE was CHANGED ???
+	     changed))))
+
+(defun compile-file-operation (component force)
+  ;; Returns T if the file had to be compiled.
+  (let ((must-compile
+	 ;; For files which are :load-only T, loading the file
+	 ;; satisfies the demand to recompile.
+	 (and (null (component-load-only component)) ; not load-only
+	      (or (find force '(:all :new-source-all t) :test #'eq) 
+		  (and (find force '(:new-source :new-source-and-dependents)
+			     :test #'eq)
+		       (needs-compilation component))))))
+
+    (cond ((and must-compile
+		(probe-file (component-full-pathname component :source)))
+	   (with-tell-user ("Compiling source" component :source)
+	     (or *oos-test*
+		 (compile-file (component-full-pathname component :source)
+			       :output-file (component-full-pathname component :binary)
+			       #+CMU :error-file #+CMU (and *cmu-errors-to-file* 
+							    (component-full-pathname component :error))
+			       #+(and CMU (not :new-compiler))
+			       :errors-to-terminal
+			       #+(and CMU (not :new-compiler))
+			       *cmu-errors-to-terminal*
+			       )))
+	   must-compile)
+	  (must-compile
+	   (tell-user "Source file not found. Not compiling"
+		      component :source :no-dots :force)
+	   nil)
+	  (t nil))))
+
+(defun needs-compilation (component)
+  ;; If there is no binary, or it is older than the source
+  ;; file, then the component needs to be compiled.
+  ;; Otherwise we only need to recompile if it depends on a file that changed.
+  (and 
+   ;; source must exist
+   (probe-file (component-full-pathname component :source)) 
+   (or
+    ;; no binary
+    (null (probe-file (component-full-pathname component :binary))) 
+    ;; old binary
+    (< (file-write-date (component-full-pathname component :binary)) 
+       (file-write-date (component-full-pathname component :source))))))
+
+(defun needs-loading (component &optional (check-source t) (check-binary t))
+  ;; Compares the component's load-time against the file-write-date of
+  ;; the files on disk. 
+  (let ((load-time (component-load-time component)))
+    (or 
+     ;; File never loaded.
+     (null load-time)
+     ;; Binary is newer.
+     (when (and check-binary
+		(probe-file (component-full-pathname component :binary)))
+       (< load-time
+	  (file-write-date (component-full-pathname component :binary))))
+     ;; Source is newer.
+     (when (and check-source
+		(probe-file (component-full-pathname component :source)))
+       (< load-time
+	  (file-write-date (component-full-pathname component :source)))))))
+
+;;; Need to completely rework this function...
+(defun load-file-operation (component force)
+  ;; Returns T if the file had to be loaded
+  (let* ((binary-pname (component-full-pathname component :binary))
+	 (source-pname (component-full-pathname component :source))
+	 (binary-exists (probe-file binary-pname))
+	 (source-exists (probe-file source-pname))
+	 (source-needs-loading (needs-loading component t nil))
+	 (binary-needs-loading (needs-loading component nil t))
+	 ;; needs-compilation has an implicit source-exists in it.
+	 (needs-compilation (if (component-load-only component)
+				source-needs-loading
+				(needs-compilation component)))
+	 (check-for-new-source 
+	  ;; If force is :new-source*, we're checking for files
+	  ;; whose source is newer than the compiled versions.
+	  (find force '(:new-source :new-source-and-dependents :new-source-all)
+		:test #'eq))
+	 (load-binary (or (find force '(:all :new-source-all t) :test #'eq)
+			  binary-needs-loading))
+	 (load-source
+	  (or *load-source-instead-of-binary*
+	      (and load-binary (component-load-only component))
+	      (and check-for-new-source needs-compilation)))
+	 (compile-and-load
+	  (and needs-compilation (or load-binary check-for-new-source)
+	       (compile-and-load-source-if-no-binary component))))
+    ;; When we're trying to minimize the files loaded to only those
+    ;; that need be, restrict the values of load-source and load-binary
+    ;; so that we only load the component if the files are newer than
+    ;; the load-time.
+    (when *minimal-load*
+      (when load-source (setf load-source source-needs-loading))
+      (when load-binary (setf load-binary binary-needs-loading)))
+
+    (when (or load-source load-binary compile-and-load)
+      (cond (compile-and-load
+	     ;; If we're loading the binary and it is old or nonexistent,
+	     ;; and the user says yes, compile and load the source.
+	     (compile-file-operation component t)
+	     (with-tell-user ("Loading binary"   component :binary)
+	       (or *oos-test*
+		   (progn
+		     (load binary-pname)
+		     (setf (component-load-time component)
+			   (file-write-date binary-pname)))))
+	     T)
+	    ((and source-exists
+		  (or (and load-source	; implicit needs-comp...
+			   (or *load-source-instead-of-binary*
+			       (component-load-only component)
+			       (not *compile-during-load*)))
+		      (and load-binary (not binary-exists)
+			   (load-source-if-no-binary component))))
+	     ;; Load the source if the source exists and:
+	     ;;   o  we're loading binary and it doesn't exist
+	     ;;   o  we're forcing it
+	     ;;   o  we're loading new source and user wasn't asked to compile
+	     (with-tell-user ("Loading source" component :source)
+	       (or *oos-test*
+		   (progn 
+		     (load source-pname)
+		     (setf (component-load-time component)
+			   (file-write-date source-pname)))))
+	     T)
+	    ((and binary-exists load-binary)
+	     (with-tell-user ("Loading binary"   component :binary)
+	       (or *oos-test*
+		   (progn
+		     (load binary-pname)
+		     (setf (component-load-time component)
+			   (file-write-date binary-pname)))))
+	     T)
+	    ((and (not binary-exists) (not source-exists))
+	     (tell-user-no-files component :force)
+	     (when *files-missing-is-an-error*
+	       (cerror "Continue, ignoring missing files."
+		       "~&Source file ~S ~:[and binary file ~S ~;~]do not exist."
+		       (namestring source-pname)
+		       (or *load-source-if-no-binary* 
+			   *load-source-instead-of-binary*)
+		       (namestring binary-pname)))
+	     nil)
+	    (t 
+	     nil)))))
+
+(component-operation :delete-binaries     'delete-binaries-operation)
+(defun delete-binaries-operation (component force)
+  (when (or (eq force :all)
+	    (eq force t)
+	    (and (find force '(:new-source :new-source-and-dependents
+					   :new-source-all)
+		       :test #'eq)
+		 (needs-compilation component)))
+    (when (probe-file (component-full-pathname component :binary))
+      (with-tell-user ("Deleting binary"   component :binary)
+	(or *oos-test*
+	    (delete-file (component-full-pathname component :binary)))))))
+
+	
+;; when the operation = :compile, we can assume the binary exists in test mode.
+;;	((and *oos-test*
+;;	      (eq operation :compile)
+;;	      (probe-file (component-full-pathname component :source)))
+;;	 (with-tell-user ("Loading binary"   component :binary)))
+
+(defun binary-exists (component)
+  (probe-file (component-full-pathname component :binary)))
+
+;;; or old-binary
+(defun compile-and-load-source-if-no-binary (component)
+  (when (not (or *load-source-instead-of-binary*
+		 (and *load-source-if-no-binary* 
+		      (not (binary-exists component)))))
+    (cond ((component-load-only component)
+	   #|(let ((prompt (prompt-string component)))
+	     (format t "~A- File ~A is load-only, ~
+                      ~&~A  not compiling."
+		     prompt
+		     (namestring (component-full-pathname component :source))
+		     prompt))|#
+	   nil)
+	  ((eq *compile-during-load* :query)
+	   (let* ((prompt (prompt-string component))
+		  (compile-source
+		   (y-or-n-p-wait 
+		    #\y 30
+		    "~A- Binary file ~A is old or does not exist. ~
+                   ~&~A  Compile (and load) source file ~A instead? "
+		    prompt
+		    (namestring (component-full-pathname component :binary))
+		    prompt
+		    (namestring (component-full-pathname component :source)))))
+	     (unless (y-or-n-p-wait 
+		      #\y 30
+		      "~A- Should I bother you if this happens again? "
+		      prompt)
+	       (setq *compile-during-load* 
+		     (y-or-n-p-wait 
+		      #\y 30
+		      "~A- Should I compile and load or not? "
+		      prompt))) ; was compile-source, then t
+	     compile-source))
+	  (*compile-during-load*)
+	  (t nil))))
+
+(defun load-source-if-no-binary (component)
+  (and (not *load-source-instead-of-binary*)
+       (or (and *load-source-if-no-binary* 
+		(not (binary-exists component)))
+	   (component-load-only component)
+	   (when *bother-user-if-no-binary*
+	     (let* ((prompt (prompt-string component))
+		    (load-source
+		     (y-or-n-p-wait #\y 30
+		      "~A- Binary file ~A does not exist. ~
+                       ~&~A  Load source file ~A instead? "
+		      prompt
+		      (namestring (component-full-pathname component :binary))
+		      prompt
+		      (namestring (component-full-pathname component :source)))))
+	       (setq *bother-user-if-no-binary*
+		     (y-or-n-p-wait #\n 30
+		      "~A- Should I bother you if this happens again? "
+		      prompt ))
+	       (unless *bother-user-if-no-binary*
+		 (setq *load-source-if-no-binary* load-source))
+	       load-source)))))
+
+;;; ********************************
+;;; Allegro Make System Fasl *******
+;;; ********************************
+#+:excl
+(defun allegro-make-system-fasl (system destination)
+  (excl:shell
+   (format nil "rm -f ~A; cat~{ ~A~} > ~A" 
+	   destination
+	   (mapcar #'namestring
+		   (files-in-system system :all :binary)))))
+
+(defun files-which-need-compilation (system)
+  (mapcar #'(lambda (comp) (namestring (component-full-pathname comp :source)))
+	  (remove nil
+		  (file-components-in-component
+		   (find-system system :load) :new-source))))
+
+(defun files-in-system (name &optional (force :all) (type :source) version)
+  ;; Returns a list of the pathnames in system in load order.
+  (let ((system (find-system name :load)))
+    (multiple-value-bind (*version-dir* *version-replace*) 
+	(translate-version version)
+      (let ((*version* version))
+	(file-pathnames-in-component system type force)))))
+
+(defun file-pathnames-in-component (component type &optional (force :all))
+  (mapcar #'(lambda (comp) (component-full-pathname comp type))
+	  (file-components-in-component component force)))
+
+(defun file-components-in-component (component &optional (force :all) 
+					       &aux result changed)
+  (case (component-type component)
+    ((:file :private-file)
+     (when (setq changed 
+		 (or (find force '(:all t) :test #'eq) 
+		     (and (not (non-empty-listp force))
+			  (needs-compilation component))))
+       (setq result
+	     (list component))))
+    ((:module :system :subsystem :defsystem)
+     (dolist (module (component-components component))
+       (multiple-value-bind (r c)
+	   (file-components-in-component 
+	    module 
+	    (cond ((and (some #'(lambda (dependent)
+				  (member dependent changed))
+			      (component-depends-on module))
+			(or (non-empty-listp force)
+			    (eq force :new-source-and-dependents)))
+		   ;; The component depends on a changed file and force agrees.
+		   :all)
+		  ((and (non-empty-listp force)
+			(member (component-name module) force
+				:test #'string-equal :key #'string))
+		   ;; Force is a list of modules and the component is one of them.
+		   :all)
+		  (t force)))
+	 (when c
+	   (push module changed)
+	   (setq result (append result r)))))))
+  (values result changed))
+
+(setf (symbol-function 'oos) (symbol-function 'operate-on-system))
+
+;;; ********************************
+;;; Additional Component Operations 
+;;; ********************************
+
+;;; *** Edit Operation ***
+
+#+:ccl
+(defun edit-operation (component force)
+  "Always returns nil, i.e. component not changed."
+  (declare (ignore force))
+  ;;
+  (let* ((full-pathname (make::component-full-pathname component :source))
+         (already-editing\? #+:mcl (dolist (w (windows :class 'fred-window))
+                                    (when (equal (window-filename w)
+                                                 full-pathname)
+                                      (return w)))
+                           #-:mcl nil))
+    (if already-editing\?
+      #+:mcl (window-select already-editing\?) #-:mcl nil
+      (ed full-pathname)))
+  nil)
+
+#+:ccl
+(make::component-operation :edit 'edit-operation)
+#+:ccl
+(make::component-operation 'edit 'edit-operation)
+
+;;; *** System Source Size ***
+
+(defun system-source-size (system-name)
+  "Prints a short report and returns the size in bytes of the source files in
+   <system-name>."
+  (let* ((file-list (files-in-system system-name :all :source))
+         (total-size (file-list-size file-list)))
+    (format t "~&~S (~A files) totals ~A bytes (~A K)"
+            system-name (length file-list) total-size (round total-size 1024))
+    total-size))
+
+(defun file-list-size (file-list)
+  "Returns the size in bytes of the files in <file-list>."
+  ;;
+  (let ((total-size 0))
+    (dolist (file file-list)
+      (with-open-file (stream file)
+        (incf total-size (file-length stream))))
+    total-size))
+
+
+
+;;; ****************************************************************
+;;; Dead Code ******************************************************
+;;; ****************************************************************
+
+#|
+;;; ********************************
+;;; Alist Manipulation *************
+;;; ********************************
+;;; This is really gross. I've replaced it with hash tables.
+
+(defun alist-lookup (name alist &key (test #'eql) (key #'identity))
+  (cdr (assoc name alist :test test :key key)))
+
+(defmacro set-alist-lookup ((name alist &key (test '#'eql) (key '#'identity)) 
+			    value)
+  (let ((pair (gensym)))
+    `(let ((,pair (assoc ,name ,alist :test ,test :key ,key)))
+       (if ,pair
+	   (rplacd ,pair ,value)
+	 (push (cons ,name ,value) ,alist)))))
+
+(defun component-operation (name &optional operation)
+  (if operation
+      (set-alist-lookup (name *component-operations*) operation)
+    (alist-lookup name *component-operations*)))
+
+(defun machine-type-translation (name &optional operation)
+  (if operation
+      (set-alist-lookup (name *machine-type-alist* :test #'string-equal)
+			operation)
+    (alist-lookup name *machine-type-alist* :test #'string-equal)))
+
+(defun software-type-translation (name &optional operation)
+  (if operation
+      (set-alist-lookup (name *software-type-alist* :test #'string-equal)
+			operation)
+    (alist-lookup name *software-type-alist* :test #'string-equal)))
+
+|#
+
+;;; *END OF FILE*
+
+
+
+
diff --git a/contrib/metering.lsp b/contrib/metering.lsp
new file mode 100644
index 000000000..136fb6212
--- /dev/null
+++ b/contrib/metering.lsp
@@ -0,0 +1,347 @@
+From daemon Fri Jul  8 22:43:26 1994
+>From clisp-list@ma2s2.mathematik.uni-karlsruhe.de Fri Jul  8 22:43:16 1994
+Return-Path: <clisp-list@ma2s2.mathematik.uni-karlsruhe.de>
+Date: Fri, 8 Jul 94 22:45:40 +0200
+Errors-To: haible@ma2s2.mathematik.uni-karlsruhe.de
+Originator: clisp-list@ma2s2.mathematik.uni-karlsruhe.de
+Errors-To: haible@ma2s2.mathematik.uni-karlsruhe.de
+Reply-To: clisp-list <clisp-list@ma2s2.mathematik.uni-karlsruhe.de>
+Sender: clisp-list@ma2s2.mathematik.uni-karlsruhe.de
+Version: 5.5 -- Copyright (c) 1991/92, Anastasios Kotsikonas
+From: donc@ISI.EDU (Don Cohen)
+To: Multiple recipients of list <clisp-list@ma2s2.mathematik.uni-karlsruhe.de>
+Subject: recording function calls
+
+  From: "Edward G. Kovach" <kovach@franus.edu>
+  Is there a way to ... get a listing of..
+             A. How many times a particular function is called?
+             B. How much time it takes to run each function?
+
+I've seen several such facilities.  The one I like, though, is
+my own, included below.  At the cost of some extra space, it
+records not only the number of calls and total time, but each
+individual call, its inputs and outputs, its start/finish time.
+This is much more useful for debugging and tuning, since you get
+to see WHICH calls took a lot of time, which ones got the wrong
+inputs or computed the wrong results, etc.  
+
+;;; -*- Mode: LISP; Package: USER; Syntax: Common-lisp -*-
+(lisp::in-package "USER")
+; ----   Record the calls to given functions   ----
+#| 2/17/89 - try to avoid advice, not so much because it's not commonlisp
+  as because it's not compiled!  In fact, I want to be able to turn on and
+  off recording at high frequency and encapsulations seem to get in the way
+  of this.  For now I'll assume that one does not encapsulate and record the
+  same functions.
+
+  In order to monitor a function one first prepares it for monitoring, then
+  one can turn monitoring on and off at high frequency.  One can also reset
+  or read the monitoring data for a function.  Finally one can forget about
+  monitoring a function.
+
+  *monitored-fns* is a list of functions currently prepared for monitoring.
+  (prepare-record-calls '(f1 f2 f3)) prepares the functions named.
+    additional keyword arguments: entryforms, exitforms, test
+    The entryforms are evaluated at function entry, the exitforms at function
+    exit.  The results are recorded along with inputs, outputs, entry time
+    and exit time.  Test is a form (default is T) that determines whether
+    this particular call will be recorded.  It runs in an environment where
+    ARGS is bound to the argument list of the function.
+  (record-on '(f1 f2 f3)) turns on recording for these functions.
+  (record-off '(f1 f2 f3)) turns it off.
+  (initialize-records '(f1 f2 f3)) discards all monitoring data for the
+    functions (but does not turn recording off or on and does not forget
+    preparation).
+  (recorded-calls 'f1) returns a list of the call records for f1.
+    This is a list of records of the form
+    (inputs outputs start-time1 start-time2 end-time1 end-time2
+	<values of entry forms> <values of exit forms>)
+    Times are represented as 2 numbers since some clocks wrap around.
+    The second is a wrap around count that is incremented whenever the
+    finish time comes out lower than the start time.
+  (summarize-calls '(f1 f2 f3)) prints a summary of the calls.
+    The argument defaults to *monitored-fns*.
+    Additional optional argument: name-alist
+    Name-alist is something like ((f1 . "updating database") (f2 . "waiting"))
+    and is used to translate function names into something more meaningful.
+  (forget-record-calls '(f1 f2 f3)) discards all monitoring data and preparation
+
+  (longest-n-calls 'f2 3) lists the 3 longest recorded calls of f2
+   additional keyword arguments: start end filterfn
+   filterfn - a function of 1 arg (inputs outputs start finish)
+    should return T if the call is "interesting"
+   start/end are special cases - filter out anything that starts before start
+    or ends after end
+
+  (time-line '(f1 f2 f3) produces a time line of activity
+   additional keyword arguments: (width 80) filterfn start end name-alist
+
+  Both symbolics and TI have a fast short clock and a slow long one.
+  We use the fast one on symbolics, slow one on TI.
+                    time before wrap around / #usec to read clock
+                    --------------------------------------------
+                    symbolics 3600           TI explorer II
+             fast   >.5 hour / 67   *        16 sec. / 260
+             slow   >100 yrs / 218           >1 hour / 260   *
+
+  Actually we notice wrap around and record it - whenever a clock access
+  returns a smaller value than the previous one we increment a counter.
+  Therefore all events are ordered correctly, but if you fail to read the
+  clock for an hour or so, it's as if that time never passed.  This is bad
+  if you time things on such a coarse scale, but good if you time one thing
+  for a minute today and something else for a minute tomorrow - the time
+  line between such events never separates them by much more than an hour.
+  In practice I don't think this will matter much.
+
+  Since calls are recorded by pushing onto a list at exit, they are ordered
+  by decreasing exit time.  This is handy for finding the outermost calls
+  in the case where the calls all come from the same process (and must thus
+  be properly nested).
+  (outermost (recorded-calls 'foo))
+  returns the subset of the calls to foo that are outermost.
+
+|#
+
+(defvar *monitored-fns* nil)
+(defvar *clock-cycle* 0)
+(defvar *last-time* 0)
+(defun prepare-record-calls (fns &key entryforms exitforms (test t))
+  (loop for fn in fns do (prepare-record-call fn entryforms exitforms test)))
+
+; record-calls-fn prop is cons substitute and original fns
+(defun prepare-record-call (fn entryforms exitforms test &aux prop)
+  (cond ((not (fboundp fn)) (error "no such function as ~A" fn))
+	#+zetalisp
+	((and (si:function-encapsulated-p fn)
+	      (warn "~A is an encapsulation") nil))
+	#+ignore ; might be called with different entryforms/exitforms
+	((and (setf prop (get fn 'record-calls-fn))
+	      (eq (cdr prop) (symbol-function fn)))
+	 #+ignore (warn "~A already recorded" fn))
+	((eq (symbol-function fn) (car prop))
+	 #+ignore (warn "~A already prepared" fn))
+	(t ; not cached ...
+	 (setf (get fn 'record-calls-fn)
+	       (cons (make-record-fn fn entryforms exitforms test)
+		     (symbol-function fn)))
+	 (pushnew fn *monitored-fns*))))
+
+(defun make-record-fn (fn entryforms exitforms test)
+  (compile nil
+      `(lambda (&rest args &aux start start1 values finish finish1 entryvals)
+	 (if ,test
+	     (unwind-protect
+		 (progn (setq entryvals (list ,@entryforms)
+			      start (microsec-time)
+			      start1 *clock-cycle*
+			      values (multiple-value-list
+				       (apply ',(symbol-function fn) args))
+			      finish (microsec-time) finish1 *clock-cycle*)
+			(values-list values))
+	       (record-1-call ',fn (copy-list args)
+			      (if finish values :abnormal-exit)
+			      start start1
+			      (or finish (microsec-time))
+			      (or finish1 *clock-cycle*)
+			      entryvals
+			      (list ,@exitforms)))
+	     (apply ',(symbol-function fn) args)))))
+; perhaps we should try to correct for the time spent in the new function?
+
+(defun forget-record-calls (fns)
+  (record-off fns)
+  (loop for fn in fns do
+    (setq *monitored-fns* (delete fn *monitored-fns*))
+    (setf (get fn 'record-calls-fn) nil)
+    (setf (get fn 'recorded-calls) nil)))
+
+(defun record-on (fns)
+  (loop for fn in fns do
+        (let ((prop (get fn 'record-calls-fn)))
+	  (cond ((not prop) (cerror "skip turning on recording"
+				    "~A not prepared for recording" fn))
+		((eq (cdr prop) (symbol-function fn))
+		 (setf (symbol-function fn) (car prop)))
+		((eq (car prop) (symbol-function fn)))
+		(t (cerror "skip turning on recording"
+			   "~A has changed since last prepared for recording"
+			   fn))))))
+
+(defun record-off (fns)
+  (loop for fn in fns do
+        (let ((prop (get fn 'record-calls-fn)))
+	  (cond ((not prop)
+		 (cerror "continue" "~A not prepared for recording" fn))
+		((eq (car prop) (symbol-function fn))
+		 (setf (symbol-function fn) (cdr prop)))
+		((eq (cdr prop) (symbol-function fn)))
+		(t (cerror "continue"
+			   "~A has changed since recording last turned on"
+			   fn))))))
+
+(defun microsec-time (&aux time)
+  (setq time
+        #-(or symbolics ti) (get-internal-run-time)
+	#+symbolics (time:fixnum-microsecond-time)
+	#+TI (time:microsecond-time))
+  (when (< time *last-time*) (incf *clock-cycle*))
+  (setf *last-time* time))
+
+(defun record-1-call (fn inputs results t1 t11 t2 t21 entryvals exitvals)
+  (push (list inputs results t1 t11 t2 t21 entryvals exitvals)
+	(get fn 'recorded-calls)))
+
+(defun initialize-records (fns)
+  (loop for fn in fns do (setf (get fn 'recorded-calls) nil)))
+
+(defun recorded-calls (fn) (get fn 'recorded-calls))
+
+(defun summarize-calls (&optional (fns *monitored-fns*) name-alist)
+  (loop for fn in fns do
+    (summarize-record fn (get fn 'recorded-calls) name-alist)))
+
+(defun summarize-record (fn calls name-alist)
+  (when calls (loop for x in calls sum 1 into ncalls
+		    sum (elapsed (third x) (fourth x) (fifth x) (sixth x))
+		    into time finally
+		    (print-summarize-record fn ncalls time name-alist))))
+
+(defun print-summarize-record (fn ncalls time name-alist)
+  (multiple-value-bind (total tunits)
+      (standardized-time-units time)
+    (multiple-value-bind (avg aunits)
+      (standardized-time-units (float (/ time ncalls)))
+      (format *standard-output* "~%~A: ~A calls, ~A ~A (avg. ~A~:[ ~a~; ~])"
+	  (or (cdr (assoc fn name-alist)) fn)
+	  ncalls total tunits avg (eq aunits tunits) aunits))))
+
+(defun standardized-time-units (usec)
+  (cond ((> usec 999999) (values (float (/ usec 1000000)) "sec."))
+	((> usec 999) (values (float (/ usec 1000))  "msec."))
+	(t (values usec "usec."))))
+
+(defun elapsed (t1 t11 t2 t21)
+  (+ (- t2 t1) (* (- t21 t11) (* 1024 1024 2048 #+TI 2))))
+
+(defun longest-n-calls (fn n &key start end filterfn
+			&aux next time current
+			(candidates (recorded-calls fn)) (i 0))
+  ; filterfn decides whether a record is "interesting"
+  ; special cases: start/end filters out anything that starts before start
+  ; or ends after end
+  (flet ((filter (e) (and (or (null start)
+			      (plusp (elapsed start 0 (third e) (fourth e))))
+			  (or (null end)
+			      (plusp (elapsed (fifth e) (sixth e) end 0)))
+			  (or (null filterfn) (funcall filterfn e)))))
+    (loop while (and (< i n) (setq next (pop candidates)))
+	  when (filter next)
+	  do (incf i) (push (cons (elapsed (third next) (fourth next)
+					   (fifth next) (sixth next))
+				  next) current))
+    (setq current (sort current #'<= :key #'car))
+    (loop while (setq next (pop candidates))
+	  when (filter next)
+	  when (< (caar current)
+		  (setq time (elapsed (third next) (fourth next)
+				      (fifth next) (sixth next))))
+	  do (setq current (merge 'list (cdr current)
+				  (list (cons time next))
+				  #'<= :key #'car)))
+    (nreverse current)))
+
+(defvar *time-line-key*
+  "Start time = ~A, End time = ~A, Width = ~A, ~
+  ~& each column represents ~A ~A~
+  ~& Key: ( = 1 entry, ) = 1 exit, * = more than one entry/exit~
+  ~&      if no entry/exit, a digit indicates number of active calls,~
+  ~&         blank indicates no change, + indicates >9 ~% ")
+
+(defun time-line (fns &key (width 80) filterfn start end len name-alist
+		    &aux events)
+  (flet ((filter (e) (and (or (null start)
+			      (plusp (elapsed start 0 (third e) (fourth e))))
+			  (or (null end)
+			      (plusp (elapsed (fifth e) (sixth e) end 0)))
+			  (or (null filterfn) (funcall filterfn e)))))
+    (setq events (loop for f in fns collect
+	 	       (cons f (loop for e in (recorded-calls f)
+				     when (filter e) collect e))))
+    (unless (and start end)
+      (loop for e in events do
+	    (loop for r in (cdr e) do
+	          (when (or (null start)
+			    (minusp (elapsed start 0 (third r) (fourth r))))
+		    (setq start (totalt (third r) (fourth r))))
+		  (when (or (null end)
+			    (minusp (elapsed (fifth r) (sixth r) end 0)))
+		    (setq end (totalt (fifth r) (sixth r)))))))
+    (when (and start end) (setq len (- end start)))
+    (unless (and len (> len 0)) (return-from time-line "empty interval"))
+    (multiple-value-bind (number unit)
+	(when (and start end width)
+	  (standardized-time-units (/ (- end start 0.0) width)))
+      (apply #'concatenate 'string
+	     (format nil *time-line-key* start end width number unit)
+	     (loop for f in events collect
+		   (concatenate 'string
+		       (let ((string (make-string width
+						  :initial-element #\space))
+			     index
+			     (countstart
+			       (make-array (list width)
+					   :initial-element 0
+					   :element-type 'integer))
+			     (countend
+			       (make-array (list width) :initial-element 0
+					   :element-type 'integer)))
+			 (loop for e in (cdr f) do
+			   (setq index
+				 (min (1- width)
+				      (floor (* width (/ (- (totalt (third e)
+								    (fourth e))
+								  start)
+							       len)))))
+			   (incf (aref countstart index))
+			   (setf (aref string index)
+				 (if (char= #\space (aref string index))
+				     #\( #\*))
+			   (setq index
+				 (min (1- width)
+				      (floor (* width (/ (- (totalt (fifth e)
+								    (sixth e))
+								  start)
+							       len)))))
+			   (decf (aref countend index))
+			   (setf (aref string index)
+				 (if (char= #\space (aref string index))
+				     #\) #\*)))
+			 (loop for i below width with sum = 0 do
+			   (setf sum (+ sum (aref countstart i)
+					(aref countend i)))
+			   (when (and (/= i 0)
+				      (/= (aref countstart (1- i)) 0)
+				      (/= (aref countend (1- i)) 0)
+				      (char= #\space (aref string i))
+				      (> sum 0))
+			     (setf (aref string i)
+				   (if (> sum 9) #\+ (aref "0123456789" sum)))))
+			 string)
+		       (format nil "  ~A~& "
+			       (symbol-name (or (cdr (assoc (car f) name-alist))
+						(car f))))))))))
+
+
+(defun outermost (calls &aux outer)
+  (loop for c in calls
+	unless (and outer (<= (totalt (third outer) (fourth outer))
+			      (totalt (third c) (fourth c))
+			      (totalt (fifth c) (sixth c))
+			      (totalt (fifth outer) (sixth outer))))
+	collect (setf outer c)))
+
+; get the time represented by the two numbers x (low order) and y (high order)
+(defun totalt (x y) (elapsed 0 0 x y))
+
+
+
diff --git a/contrib/pvm/eclreader.lsp b/contrib/pvm/eclreader.lsp
new file mode 100644
index 000000000..8ea7c9ecf
--- /dev/null
+++ b/contrib/pvm/eclreader.lsp
@@ -0,0 +1,129 @@
+;;;-*-Mode: LISP; Syntax: Common LISP; Base: 10-*-
+;;;
+;;; File = eclreader.lsp
+;;; Definition of reader for ECoLISP.
+;;;
+;;; (c) 1994, I.D. Alexander-Craig, all rights reserved.
+;;;
+;;;
+
+
+
+;;;;****************************************************************;;;;
+;;;;                                                                ;;;;
+;;;; Definition of the basic reader that is needed by KCL.          ;;;;
+;;;; The following function should be called when loading the       ;;;;
+;;;; object reader for KCL. This is called the default reader       ;;;;
+;;;; for KCL.                                                       ;;;;
+;;;;                                                                ;;;;
+;;;;                                                                ;;;;
+;;;;****************************************************************;;;;
+
+(defparameter *default-reader* ())
+
+(defparameter *default-reader-specs*
+  (list
+   (list 'NULL
+          LISP_NIL_TYPE
+	  *
+         #'(lambda (rdr)
+              (declare (ignore rdr))
+             ()))
+   (list T
+         LISP_T_TYPE
+         '*
+         #'(lambda (rdr)
+             (declare (ignore rdr))
+             t))
+   (list 'STANDARD-CHAR ;; CHARACTER
+         LISP_CHAR_TYPE
+         #'(lambda (obj rdr)
+             (declare (ignore rdr))
+             (C-obuffer-char obj))
+         #'(lambda (rdr)
+             (declare (ignore rdr))
+             (C-ibuffer-char)))
+   (list 'FIXNUM
+          LISP_INT_TYPE
+         #'(lambda (obj rdr)
+             (declare (ignore rdr))
+             (C-obuffer-int obj))
+         #'(lambda (rdr)
+             (declare (ignore rdr))
+             (C-ibuffer-int)))
+   (list 'BIGNUM
+         LISP_LONGINT_TYPE
+         #'(lambda (obj rdr)
+             (declare (ignore rdr))
+             (C-obuffer-longint obj))
+         #'(lambda (rdr)
+             (declare (ignore rdr))
+             (C-ibuffer-longint)))
+   (list 'LONG-FLOAT ;;FLOAT
+          LISP_DOUBLE_TYPE
+         #'(lambda (obj rdr)
+             (declare (ignore rdr))
+             (C-obuffer-double obj))
+         #'(lambda (rdr)
+             (declare (ignore rdr))
+             (C-ibuffer-double)))
+   (list 'SYMBOL
+         LISP_SYMBOL_TYPE
+         #'(lambda (obj rdr)
+             (declare (ignore rdr))
+             (cond ((eq obj t)
+		    (C-obuffer-t))
+		   ((null obj)
+		    (C-obuffer-nil))
+		   (t
+		    (let ((pname (symbol-name obj)))
+		      (C-obuffer-symbol pname (length pname))))))
+         #'(lambda (rdr)
+             (declare (ignore rdr))
+             (C-ibuffer-symbol)))
+   (list 'STRING ;; SIMPLE-STRING
+         LISP_STRING_TYPE
+         #'(lambda (obj rdr)
+             (declare (ignore rdr))
+             (C-obuffer-string obj (length obj)))
+         #'(lambda (rdr)
+             (declare (ignore rdr))
+             (C-ibuffer-string)))
+   (list 'VECTOR
+         LISP_VECTOR_TYPE
+         #'(lambda (obj rdr)
+             (encode-vector obj rdr))
+         #'(lambda (rdr)
+             (decode-vector rdr)))
+   (list 'CONS
+         LISP_LIST_TYPE
+         #'(lambda (obj rdr)
+             (encode-list obj rdr))
+         #'(lambda (rdr)
+             (decode-list rdr)))))
+
+;; For testing only:
+
+(defparameter *rdr* ())
+
+(defun init-default-reader ()
+  (setq *default-reader* (make-object-reader))
+  (initialise-reader-object
+   *default-reader*
+   *default-reader-specs*)
+  (values))
+
+(format t "Creating reader:~%")
+(init-default-reader)
+(format t "Done.~%~%")
+
+;;; For testing only:
+
+(setq *rdr* *default-reader*)
+
+(defun restart-reader ()
+  (setq *default-reader* ()
+        rdr ())
+  (init-default-reader)
+  (setq *rdr* *default-reader*)
+  (values))
diff --git a/contrib/pvm/hostfile b/contrib/pvm/hostfile
new file mode 100644
index 000000000..dd06e6a42
--- /dev/null
+++ b/contrib/pvm/hostfile
@@ -0,0 +1,2 @@
+database
+igor
diff --git a/contrib/pvm/load.lsp b/contrib/pvm/load.lsp
new file mode 100644
index 000000000..2dd46e305
--- /dev/null
+++ b/contrib/pvm/load.lsp
@@ -0,0 +1,11 @@
+;;;-*-Mode: LISP; Syntax: Common LISP; Base: 10-*-
+;;;
+;;; File = load.lsp
+;;; Load file for ECL<->PVM interface modules.
+;;;
+
+(load "pvmconsts")
+(load "pvmlisp")
+(si:faslink "pvmecl" "-L/project/pvm/pvm3/lib/SUN4 -lgpvm3 -lpvm3 -lc")
+;(load "pvmecl")
+(load "eclreader")
diff --git a/contrib/pvm/pvm-test.lsp b/contrib/pvm/pvm-test.lsp
new file mode 100644
index 000000000..2c2f7354e
--- /dev/null
+++ b/contrib/pvm/pvm-test.lsp
@@ -0,0 +1,14 @@
+(defparameter *my-tid* ())
+
+(defun enroll ()
+  (setq *my-tid* (lpvm-my-tid)))
+
+(defun leave ()
+  (lpvm-exit)
+  (quit))
+
+(defun send-rec (msg msgtype)
+  (format t "about to send~%")
+  (lpvm-send-message msg *rdr*  msgtype *my-tid*)
+  (format t "about to receive~%")
+  (lpvm-nonblocking-recv *rdr* *my-tid* msgtype))
diff --git a/contrib/pvm/pvmconsts.lsp b/contrib/pvm/pvmconsts.lsp
new file mode 100644
index 000000000..98ed6676f
--- /dev/null
+++ b/contrib/pvm/pvmconsts.lsp
@@ -0,0 +1,109 @@
+;;;-*- Mode: LISP; Syntax: Common LISP; Base: 10 -*-
+;;;
+;;; File = pvmconsts.lisp
+;;;
+;;; PVM constant definitions.
+;;;
+
+;;
+;; Change log.
+;; 25 March 1994. LISP_X_TYPE constants have contiguous values.
+;;  This is to support the new representation for the read structure.
+;;
+
+;;;
+;;; Constant definitions for type tags used to define
+;;; message boundaries.
+;;; The tags are all ad hoc and tailored to the needs of LISP.
+;;; Each is represented by an integer.
+;;;
+;;;
+
+(defconstant MESSAGE_START        1)
+    ;; This says that there is going to be      
+    ;; a new structure type that follows.
+(defconstant LISP_NIL_TYPE        2) ; encode nil
+(defconstant LISP_T_TYPE          3) ; encode t
+(defconstant LISP_CHAR_TYPE       4)
+(defconstant LISP_SHORTINT_TYPE   5)
+(defconstant LISP_INT_TYPE        6)
+(defconstant LISP_LONGINT_TYPE    7)
+;(defconstant LISP_FLOAT_TYPE      8) not used in ECo or KCL
+(defconstant LISP_DOUBLE_TYPE     9)
+(defconstant LISP_SYMBOL_TYPE    10)
+(defconstant LISP_STRING_TYPE    11)
+(defconstant LISP_VECTOR_TYPE    12)
+(defconstant LISP_LIST_TYPE      13)
+ ;; If complex and rational are required, we can fit them in.
+(defconstant LISP_OPAQUE_TYPE    14)
+(defconstant LISP_MIN_USER_TYPE  15)
+
+ 
+;;; 
+;;; PVM constant definitions for error messages, together
+;;; with the error function for PVM routines.
+;;;
+
+(defconstant %PvmOk           0)
+(defconstant %PvmBadParam    -2)
+(defconstant %PvmMismatch    -3)
+(defconstant %PvmNoData      -5)
+(defconstant %PvmNoHost      -6)
+(defconstant %PvmNoFile      -7)
+(defconstant %PvmNoMem      -10)
+(defconstant %PvmBadMsg     -12)
+(defconstant %PvmSysErr     -14)
+(defconstant %PvmNoBuf      -15)
+(defconstant %PvmNoSuchBuf  -16)
+(defconstant %PvmNullGroup  -17)
+(defconstant %PvmDupGroup   -18)
+(defconstant %PvmNoGroup    -19)
+(defconstant %PvmNotInGroup -20)
+(defconstant %PvmNoInst     -21)
+(defconstant %PvmHostFail   -22)
+(defconstant %PvmNoParent   -23)
+(defconstant %PvmNotImpl    -24)
+(defconstant %PvmDSysErr    -25)
+(defconstant %PvmBadVersion -26)
+(defconstant %PvmOutOfRes   -27)
+(defconstant %PvmDupHost    -28)
+(defconstant %PvmCantStart  -29)
+(defconstant %PvmAlready    -30)
+(defconstant %PvmNoTask     -31)
+(defconstant %PvmNoEntry    -32)
+(defconstant %PvmDupEntry   -33)
+
+
+(defun pvm-error (errno where)
+  ;; quick hack for testing
+  (unless (= errno %PvmOk)
+	  (error "PVM error in ~s no. ~d~%" where errno)))
+
+
+;;;
+;;; Constants for pvm_advise
+;;;
+
+(defconstant %PvmDontRoute   1)
+(defconstant %PvmAllowDirect 2)
+(defconstant %PvmRouteDirect 3)
+
+;;;
+;;; Constants for pvm_initsend's encoding
+;;;
+
+(defconstant %PvmDataDefault 0) ; use XDR if heterogeneous
+(defconstant %PvmDataRaw     1) ; no encoding
+(defconstant %PvmDataInPlace 2) ; leave data in place.
+
+;;;
+;;; Constants for pvm_spawn.
+;;; See the PVM manual p. 13 for details.
+;;;
+
+(defconstant %PvmTaskDefault 0)
+(defconstant %PvmTaskHost    1)
+(defconstant %PvmTaskArch    2)
+(defconstant %PvmTaskDebug   4)
+(defconstant %PvmTaskTrace   8)
+
diff --git a/contrib/pvm/pvmecl.c b/contrib/pvm/pvmecl.c
new file mode 100644
index 000000000..2ba3ba0d6
--- /dev/null
+++ b/contrib/pvm/pvmecl.c
@@ -0,0 +1,1058 @@
+
+#include "pvmecl.h"
+init_code(int size, object data_stream)
+{VT2 CLSR2
+	volatile object VVprotect;
+	Cblock.cd_start=(char *)init_code; Cblock.cd_size=size;
+	VVprotect=Cblock.cd_data=read_VV(VV,VM1,data_stream);
+	MF0(VV[95],L1);
+	(void)putprop(VV[95],VV[Vdeb95],VV[96]);
+	MF0(VV[2],L2);
+	funcall(2,VV[97]->s.s_gfdef,VV[1])        /*  PROCLAIM        */;
+	putprop(VV[2],VV[4],VV[3]);
+	MF0(VV[98],L3);
+	(void)putprop(VV[98],VV[Vdeb98],VV[96]);
+	MF0(VV[99],L4);
+	(void)putprop(VV[99],VV[Vdeb99],VV[96]);
+	MF0(VV[100],L5);
+	(void)putprop(VV[100],VV[Vdeb100],VV[96]);
+	MF0(VV[101],L6);
+	(void)putprop(VV[101],VV[Vdeb101],VV[96]);
+	MF0(VV[8],L7);
+	funcall(2,VV[97]->s.s_gfdef,VV[7])        /*  PROCLAIM        */;
+	putprop(VV[8],VV[9],VV[3]);
+	MF0(VV[102],L8);
+	(void)putprop(VV[102],VV[Vdeb102],VV[96]);
+	MF0(VV[103],L9);
+	(void)putprop(VV[103],VV[Vdeb103],VV[96]);
+	MF0(VV[13],L10);
+	funcall(2,VV[97]->s.s_gfdef,VV[12])       /*  PROCLAIM        */;
+	putprop(VV[13],VV[14],VV[3]);
+	MF0(VV[104],L11);
+	(void)putprop(VV[104],VV[Vdeb104],VV[96]);
+	MF0(VV[17],L12);
+	funcall(2,VV[97]->s.s_gfdef,VV[16])       /*  PROCLAIM        */;
+	putprop(VV[17],VV[18],VV[3]);
+	MF0(VV[105],L13);
+	(void)putprop(VV[105],VV[Vdeb105],VV[96]);
+	MF0(VV[21],L14);
+	funcall(2,VV[97]->s.s_gfdef,VV[20])       /*  PROCLAIM        */;
+	putprop(VV[21],VV[22],VV[3]);
+	MF0(VV[106],L15);
+	(void)putprop(VV[106],VV[Vdeb106],VV[96]);
+	MF0(VV[107],L16);
+	(void)putprop(VV[107],VV[Vdeb107],VV[96]);
+	MF0(VV[108],L17);
+	(void)putprop(VV[108],VV[Vdeb108],VV[96]);
+	MF0(VV[109],L18);
+	(void)putprop(VV[109],VV[Vdeb109],VV[96]);
+	MF0(VV[110],L19);
+	MF0(VV[111],L20);
+	(void)putprop(VV[111],VV[Vdeb111],VV[96]);
+	MF0(VV[112],L21);
+	(void)putprop(VV[112],VV[Vdeb112],VV[96]);
+	MF0(VV[113],L21);
+	(void)putprop(VV[113],VV[Vdeb113],VV[96]);
+	MF0(VV[114],L23);
+	MF0(VV[115],L24);
+	(void)putprop(VV[115],VV[Vdeb115],VV[96]);
+	MF0(VV[116],L25);
+	MF0(VV[117],L26);
+	(void)putprop(VV[117],VV[Vdeb117],VV[96]);
+	MF0(VV[118],L27);
+	MF0(VV[119],L28);
+	(void)putprop(VV[119],VV[Vdeb119],VV[96]);
+	MF0(VV[120],L29);
+	MF0(VV[121],L30);
+	(void)putprop(VV[121],VV[Vdeb121],VV[96]);
+	MF0(VV[122],L31);
+	(void)putprop(VV[122],VV[Vdeb122],VV[96]);
+	MF0(VV[123],L32);
+	MF0(VV[124],L33);
+	(void)putprop(VV[124],VV[Vdeb124],VV[96]);
+	MF0(VV[125],L34);
+	(void)putprop(VV[125],VV[Vdeb125],VV[96]);
+	MF0(VV[126],L35);
+	(void)putprop(VV[126],VV[Vdeb126],VV[96]);
+	MF0(VV[127],L36);
+	(void)putprop(VV[127],VV[Vdeb127],VV[96]);
+	MF0(VV[34],L37);
+	funcall(2,VV[97]->s.s_gfdef,VV[33])       /*  PROCLAIM        */;
+	putprop(VV[34],VV[35],VV[3]);
+	MF0(VV[128],L38);
+	(void)putprop(VV[128],VV[Vdeb128],VV[96]);
+	MF0(VV[40],L39);
+	funcall(2,VV[97]->s.s_gfdef,VV[39])       /*  PROCLAIM        */;
+	putprop(VV[40],VV[41],VV[3]);
+	MF0(VV[129],L40);
+	(void)putprop(VV[129],VV[Vdeb129],VV[96]);
+	MF0(VV[130],L41);
+	(void)putprop(VV[130],VV[Vdeb130],VV[96]);
+	MF0(VV[45],L42);
+	funcall(2,VV[97]->s.s_gfdef,VV[44])       /*  PROCLAIM        */;
+	putprop(VV[45],VV[46],VV[3]);
+	MF0(VV[131],L43);
+	(void)putprop(VV[131],VV[Vdeb131],VV[96]);
+	MF0(VV[50],L44);
+	funcall(2,VV[97]->s.s_gfdef,VV[49])       /*  PROCLAIM        */;
+	putprop(VV[50],VV[51],VV[3]);
+	MF0(VV[132],L45);
+	(void)putprop(VV[132],VV[Vdeb132],VV[96]);
+	MF0(VV[54],L46);
+	funcall(2,VV[97]->s.s_gfdef,VV[53])       /*  PROCLAIM        */;
+	putprop(VV[54],VV[55],VV[3]);
+	MF0(VV[133],L47);
+	(void)putprop(VV[133],VV[Vdeb133],VV[96]);
+	MF0(VV[58],L48);
+	funcall(2,VV[97]->s.s_gfdef,VV[57])       /*  PROCLAIM        */;
+	putprop(VV[58],VV[59],VV[3]);
+	MF0(VV[134],L49);
+	(void)putprop(VV[134],VV[Vdeb134],VV[96]);
+	MF0(VV[62],L50);
+	funcall(2,VV[97]->s.s_gfdef,VV[61])       /*  PROCLAIM        */;
+	putprop(VV[62],VV[63],VV[3]);
+	MF0(VV[135],L51);
+	(void)putprop(VV[135],VV[Vdeb135],VV[96]);
+	MF0(VV[66],L52);
+	funcall(2,VV[97]->s.s_gfdef,VV[65])       /*  PROCLAIM        */;
+	putprop(VV[66],VV[67],VV[3]);
+	MF0(VV[136],L53);
+	(void)putprop(VV[136],VV[Vdeb136],VV[96]);
+	MF0(VV[70],L54);
+	funcall(2,VV[97]->s.s_gfdef,VV[69])       /*  PROCLAIM        */;
+	putprop(VV[70],VV[71],VV[3]);
+	MF0(VV[137],L55);
+	(void)putprop(VV[137],VV[Vdeb137],VV[96]);
+	MF0(VV[74],L56);
+	funcall(2,VV[97]->s.s_gfdef,VV[73])       /*  PROCLAIM        */;
+	putprop(VV[74],VV[75],VV[3]);
+	MF0(VV[138],L57);
+	(void)putprop(VV[138],VV[Vdeb138],VV[96]);
+	MF0(VV[139],L58);
+	MF0(VV[140],L59);
+	(void)putprop(VV[140],VV[Vdeb140],VV[96]);
+	MF0(VV[88],L60);
+	funcall(2,VV[97]->s.s_gfdef,VV[87])       /*  PROCLAIM        */;
+	putprop(VV[88],VV[89],VV[3]);
+	MF0(VV[141],L61);
+	(void)putprop(VV[141],VV[Vdeb141],VV[96]);
+	MF0(VV[92],L62);
+	funcall(2,VV[97]->s.s_gfdef,VV[91])       /*  PROCLAIM        */;
+	putprop(VV[92],VV[93],VV[3]);
+	MF0(VV[142],L63);
+	(void)putprop(VV[142],VV[Vdeb142],VV[96]);
+	Cblock.cd_start=(char *)end_init;
+	Cblock.cd_size-=(char *)end_init - (char *)init_code;
+	insert_contblock((char *)init_code,(char *)end_init - (char *)init_code);
+}
+static end_init() {}
+/*	function definition for PVM-ERROR                             */
+static L1(int narg, object V1, object V2)
+{ VT3 VLEX3 CLSR3
+TTL:
+	RETURN(Lerror(3,VV[0],(V1),(V2))          /*  ERROR           */);
+}
+
+#include "/project/pvm/pvm3/include/pvm3.h"
+
+/*	function definition for C_PVM_PKINT                           */
+static L2(int narg, object V1)
+{
+	int x;
+	x=pvm_pkint(&object_to_int(V1),1,1);
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for OBUFFER-INT                           */
+static L3(int narg, object V1)
+{ VT4 VLEX4 CLSR4
+TTL:
+	{int V2;                                  /*  INFO            */
+	V2= pvm_pkint(&fix((V1)),1,1);
+	if((0)==(V2)){
+	goto L35;}
+	L1(2,MAKE_FIXNUM(V2),VV[5])               /*  PVM-ERROR       */;
+	}
+L35:
+	RETURN(0);
+}
+/*	function definition for PACK-TYPE-TAG                         */
+static L4(int narg, object V1)
+{ VT5 VLEX5 CLSR5
+TTL:
+	{int V2;                                  /*  RETURN-CODE     */
+	V2= pvm_pkint(&fix((V1)),1,1);
+	if((0)==(V2)){
+	goto L39;}
+	L1(2,MAKE_FIXNUM(V2),VV[6])               /*  PVM-ERROR       */;
+	}
+L39:
+	RETURN(0);
+}
+/*	function definition for C-OBUFFER-NIL                         */
+static L5(int narg)
+{ VT6 VLEX6 CLSR6
+TTL:
+	RETURN(L4(1,MAKE_FIXNUM(2))               /*  PACK-TYPE-TAG   */);
+}
+/*	function definition for C-OBUFFER-T                           */
+static L6(int narg)
+{ VT7 VLEX7 CLSR7
+TTL:
+	RETURN(L4(1,MAKE_FIXNUM(3))               /*  PACK-TYPE-TAG   */);
+}
+/*	function definition for C_PVM_PKCHAR                          */
+static L7(int narg, object V1)
+{
+	int x;
+	x=pvm_pkbyte(&object_to_char(V1),1,1);
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for C-OBUFFER-CHAR                        */
+static L8(int narg, object V1)
+{ VT8 VLEX8 CLSR8
+TTL:
+	L4(1,MAKE_FIXNUM(4))                      /*  PACK-TYPE-TAG   */;
+	{int V2;                                  /*  INFO            */
+	V2= pvm_pkbyte(&char_code((V1)),1,1);
+	if((0)==(V2)){
+	goto L44;}
+	L1(2,MAKE_FIXNUM(V2),VV[10])              /*  PVM-ERROR       */;
+	}
+L44:
+	RETURN(0);
+}
+/*	function definition for C-OBUFFER-INT                         */
+static L9(int narg, object V1)
+{ VT9 VLEX9 CLSR9
+TTL:
+	L4(1,MAKE_FIXNUM(6))                      /*  PACK-TYPE-TAG   */;
+	{int V2;                                  /*  INFO            */
+	V2= pvm_pkint(&fix((V1)),1,1);
+	if((0)==(V2)){
+	goto L49;}
+	L1(2,MAKE_FIXNUM(V2),VV[11])              /*  PVM-ERROR       */;
+	}
+L49:
+	RETURN(0);
+}
+/*	function definition for C_PVM_PKFLOAT                         */
+static L10(int narg, object V1)
+{
+	int x;
+	x=pvm_pkfloat(&object_to_float(V1),1,1);
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for OBUFFER-FLOAT                         */
+static L11(int narg, object V1)
+{ VT10 VLEX10 CLSR10
+TTL:
+	{int V2;                                  /*  INFO            */
+	V2= pvm_pkfloat(&sf((V1)),1,1);
+	if((0)==(V2)){
+	goto L53;}
+	L1(2,MAKE_FIXNUM(V2),VV[15])              /*  PVM-ERROR       */;
+	}
+L53:
+	RETURN(0);
+}
+/*	function definition for C_PVM_PKDOUBLE                        */
+static L12(int narg, object V1)
+{
+	int x;
+	x=pvm_pkdouble(&object_to_double(V1),1,1);
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for C-OBUFFER-DOUBLE                      */
+static L13(int narg, object V1)
+{ VT11 VLEX11 CLSR11
+TTL:
+	{int V2;                                  /*  INFO            */
+	V2= pvm_pkdouble(&lf((V1)),1,1);
+	if((0)==(V2)){
+	goto L57;}
+	L1(2,MAKE_FIXNUM(V2),VV[19])              /*  PVM-ERROR       */;
+	}
+L57:
+	RETURN(0);
+}
+/*	function definition for C_PVM_PKSTR                           */
+static L14(int narg, object V1, object V2)
+{
+	int x;
+	x=(((object_to_int(V2) = pvm_pkint(&type,1,1)) == PvmOk) ?
+         pvm_pkstr((V1)->st.st_self) : object_to_int(V2));
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for C-OBUFFER-SYMBOL                      */
+static L15(int narg, object V1)
+{ VT12 VLEX12 CLSR12
+TTL:
+	{object V2;                               /*  PNAME           */
+	V2= symbol_name((V1));
+	{int V3;                                  /*  LEN             */
+	V3= ((V2))->v.v_fillp;
+	L4(1,MAKE_FIXNUM(10))                     /*  PACK-TYPE-TAG   */;
+	{int V4;                                  /*  INFO            */
+	V4= (((V3 = pvm_pkint(&type,1,1)) == PvmOk) ?
+         pvm_pkstr(((V2))->st.st_self) : V3);
+	if((0)==(V4)){
+	goto L61;}
+	L1(2,MAKE_FIXNUM(V4),VV[23])              /*  PVM-ERROR       */;
+	}
+	}
+	}
+L61:
+	RETURN(0);
+}
+/*	function definition for C-OBUFFER-STRING                      */
+static L16(int narg, object V1)
+{ VT13 VLEX13 CLSR13
+TTL:
+	{int V2;                                  /*  LEN             */
+	V2= length((V1));
+	L4(1,MAKE_FIXNUM(11))                     /*  PACK-TYPE-TAG   */;
+	{int V3;                                  /*  INFO            */
+	V3= (((V2 = pvm_pkint(&type,1,1)) == PvmOk) ?
+         pvm_pkstr(((V1))->st.st_self) : V2);
+	if((0)==(V3)){
+	goto L68;}
+	L1(2,MAKE_FIXNUM(V3),VV[24])              /*  PVM-ERROR       */;
+	}
+	}
+L68:
+	RETURN(0);
+}
+/*	function definition for C-OBUFFER-VECTOR-HEADER               */
+static L17(int narg, object V1)
+{ VT14 VLEX14 CLSR14
+TTL:
+	L4(1,MAKE_FIXNUM(12))                     /*  PACK-TYPE-TAG   */;
+	{int V2;                                  /*  INFO            */
+	V2= pvm_pkint(&fix((V1)),1,1);
+	if((0)==(V2)){
+	goto L75;}
+	L1(2,MAKE_FIXNUM(V2),VV[25])              /*  PVM-ERROR       */;
+	}
+L75:
+	RETURN(0);
+}
+/*	function definition for C-OBUFFER-LIST-HEADER                 */
+static L18(int narg)
+{ VT15 VLEX15 CLSR15
+TTL:
+	L4(1,MAKE_FIXNUM(13))                     /*  PACK-TYPE-TAG   */;
+	RETURN(0);
+}
+/*	function definition for C_PVM_UNPACK_TAG                      */
+static L19(int narg)
+{
+	object x;
+	x= Cnil;
+  { int tagval, info;
+    info = pvm_upkint(&tagval,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = MAKE_FIXNUM(tagval);
+    RETURN(2);
+  };
+	VALUES(0)=x;
+	RETURN(1);
+}
+/*	function definition for IBUFFER-TAG                           */
+static L20(int narg)
+{ VT16 VLEX16 CLSR16
+TTL:
+	{ int V1;
+	object V2;                                /*  INFO            */
+	object V3;                                /*  VALUE           */
+	V1=L23(0)                                 /*  C_PVM_UNPACK_INT*/;
+	if (V1--==0) goto L81;
+	V2= VALUES(0);
+	if (V1--==0) goto L82;
+	V3= VALUES(1);
+	goto L83;
+L81:
+	V2= Cnil;
+L82:
+	V3= Cnil;
+L83:
+	if(((V2))==Cnil){
+	goto L85;}
+	VALUES(0) = (V3);
+	RETURN(1);
+L85:
+	RETURN(L1(2,(V2),VV[26])                  /*  PVM-ERROR       */);}
+}
+/*	function definition for C-NEXT-MSG-TYPE                       */
+static L21(int narg)
+{ VT17 VLEX17 CLSR17
+TTL:
+	RETURN(L20(0)                             /*  IBUFFER-TAG     */);
+}
+/*	function definition for C_PVM_UNPACK_INT                      */
+static L23(int narg)
+{
+	object x;
+	x= Cnil;
+  { int ival, info;
+    info = pvm_upkint(&ival,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = MAKE_FIXNUM(ival);
+    RETURN(2);
+  };
+	VALUES(0)=x;
+	RETURN(1);
+}
+/*	function definition for C-IBUFFER-INT                         */
+static L24(int narg)
+{ VT18 VLEX18 CLSR18
+TTL:
+	{ int V1;
+	object V2;                                /*  INFO            */
+	object V3;                                /*  VALUE           */
+	V1=L23(0)                                 /*  C_PVM_UNPACK_INT*/;
+	if (V1--==0) goto L88;
+	V2= VALUES(0);
+	if (V1--==0) goto L89;
+	V3= VALUES(1);
+	goto L90;
+L88:
+	V2= Cnil;
+L89:
+	V3= Cnil;
+L90:
+	if(((V2))==Cnil){
+	goto L92;}
+	VALUES(0) = (V3);
+	RETURN(1);
+L92:
+	RETURN(L1(2,(V2),VV[27])                  /*  PVM-ERROR       */);}
+}
+/*	function definition for C_PVM_UNPACK_CHAR                     */
+static L25(int narg)
+{
+	object x;
+	x= Cnil;
+  { int info;
+    char chval;
+    info = pvm_upkbyte(&chval,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = code_char(chval);
+    RETURN(2);
+  };
+	VALUES(0)=x;
+	RETURN(1);
+}
+/*	function definition for C-IBUFFER-CHAR                        */
+static L26(int narg)
+{ VT19 VLEX19 CLSR19
+TTL:
+	{ int V1;
+	object V2;                                /*  INFO            */
+	object V3;                                /*  VALUE           */
+	V1=L25(0)                                 /*  C_PVM_UNPACK_CHAR*/;
+	if (V1--==0) goto L95;
+	V2= VALUES(0);
+	if (V1--==0) goto L96;
+	V3= VALUES(1);
+	goto L97;
+L95:
+	V2= Cnil;
+L96:
+	V3= Cnil;
+L97:
+	if(((V2))==Cnil){
+	goto L99;}
+	VALUES(0) = (V3);
+	RETURN(1);
+L99:
+	RETURN(L1(2,(V2),VV[28])                  /*  PVM-ERROR       */);}
+}
+/*	function definition for C_PVM_UNPACK_FLOAT                    */
+static L27(int narg)
+{
+	object x;
+	x= Cnil;
+  { int info;
+    float fval;
+    info = pvm_upkfloat(&fval,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = make_shortfloat(fval);
+    RETURN(2);
+  };
+	VALUES(0)=x;
+	RETURN(1);
+}
+/*	function definition for IBUFFER-FLOAT                         */
+static L28(int narg)
+{ VT20 VLEX20 CLSR20
+TTL:
+	{ int V1;
+	object V2;                                /*  INFO            */
+	object V3;                                /*  VALUE           */
+	V1=L27(0)                                 /*  C_PVM_UNPACK_FLOAT*/;
+	if (V1--==0) goto L102;
+	V2= VALUES(0);
+	if (V1--==0) goto L103;
+	V3= VALUES(1);
+	goto L104;
+L102:
+	V2= Cnil;
+L103:
+	V3= Cnil;
+L104:
+	if(((V2))==Cnil){
+	goto L106;}
+	VALUES(0) = (V3);
+	RETURN(1);
+L106:
+	RETURN(L1(2,(V2),VV[29])                  /*  PVM-ERROR       */);}
+}
+/*	function definition for C_PVM_UNPACK_DOUBLE                   */
+static L29(int narg)
+{
+	object x;
+	x= Cnil;
+  {
+    int info;
+    double dval;
+    info = pvm_upkdouble(&dval,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = make_longfloat(dval);
+    RETURN(2);
+  };
+	VALUES(0)=x;
+	RETURN(1);
+}
+/*	function definition for C-IBUFFER-DOUBLE                      */
+static L30(int narg)
+{ VT21 VLEX21 CLSR21
+TTL:
+	{ int V1;
+	object V2;                                /*  INFO            */
+	object V3;                                /*  VALUE           */
+	V1=L29(0)                                 /*  C_PVM_UNPACK_DOUBLE*/;
+	if (V1--==0) goto L109;
+	V2= VALUES(0);
+	if (V1--==0) goto L110;
+	V3= VALUES(1);
+	goto L111;
+L109:
+	V2= Cnil;
+L110:
+	V3= Cnil;
+L111:
+	if(((V2))==Cnil){
+	goto L113;}
+	VALUES(0) = (V3);
+	RETURN(1);
+L113:
+	RETURN(L1(2,(V2),VV[30])                  /*  PVM-ERROR       */);}
+}
+/*	function definition for SETSTRING                             */
+static L31(int narg, object V1, object V2, object V3)
+{ VT22 VLEX22 CLSR22
+TTL:
+	aset1((V3),fix((V2)),(V1));
+	RETURN(0);
+}
+/*	function definition for C_PVM_UNPACK_CHARS                    */
+static L32(int narg, object V1)
+{
+	object x;
+	x=
+  Cnil;
+  { char *strchrs;
+    int info;
+    info = pvm_upkstr(strchrs);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = make_simple_string(strchrs);
+    RETURN(2);
+  };
+	VALUES(0)=x;
+	RETURN(1);
+}
+/*	function definition for GET-LENGTH-AND-STRING                 */
+static L33(int narg)
+{ VT23 VLEX23 CLSR23
+TTL:
+	{object V1;                               /*  LEN             */
+	(*LK0)(0)                                 /*  IBUFFER-INT     */;
+	V1= VALUES(0);
+	{ int V2;
+	object V3;                                /*  INFO            */
+	object V4;                                /*  STR             */
+	V2=L32(1,(V1))                            /*  C_PVM_UNPACK_CHARS*/;
+	if (V2--==0) goto L118;
+	V3= VALUES(0);
+	if (V2--==0) goto L119;
+	V4= VALUES(1);
+	goto L120;
+L118:
+	V3= Cnil;
+L119:
+	V4= Cnil;
+L120:
+	if(((V3))==Cnil){
+	goto L122;}
+	if(!(number_compare(MAKE_FIXNUM(length((V4))),(V1))==0)){
+	goto L125;}
+	VALUES(0) = (V4);
+	RETURN(1);
+L125:
+	RETURN(Lformat(4,Ct,VV[31],MAKE_FIXNUM(length((V4))),(V1))/*  FORMAT*/);
+L122:
+	RETURN(L1(2,(V3),VV[32])                  /*  PVM-ERROR       */);}
+	}
+}
+/*	function definition for C-IBUFFER-SYMBOL                      */
+static L34(int narg)
+{ VT24 VLEX24 CLSR24
+TTL:
+	{object V1;                               /*  PNAME           */
+	L33(0)                                    /*  GET-LENGTH-AND-STRING*/;
+	V1= VALUES(0);
+	RETURN(Lmake_symbol(1,(V1))               /*  MAKE-SYMBOL     */);
+	}
+}
+/*	function definition for C-IBUFFER-STRING                      */
+static L35(int narg)
+{ VT25 VLEX25 CLSR25
+TTL:
+	RETURN(L33(0)                             /*  GET-LENGTH-AND-STRING*/);
+}
+/*	function definition for C-IBUFER-VECTOR-LENGTH                */
+static L36(int narg)
+{ VT26 VLEX26 CLSR26
+TTL:
+	RETURN(L24(0)                             /*  C-IBUFFER-INT   */);
+}
+/*	function definition for C_PVM_INITSEND                        */
+static L37(int narg, object V1)
+{
+	int x;
+	x=pvm_initsend(object_to_int(V1));
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-INIT-SEND                        */
+static L38(int narg, object V1)
+{ VT27 VLEX27 CLSR27
+TTL:
+	if(type_of((V1))==t_fixnum||type_of((V1))==t_bignum){
+	goto L129;}
+	RETURN(Lerror(2,VV[36],TYPE_OF((V1)))     /*  ERROR           */);
+L129:
+	if(!(number_compare(MAKE_FIXNUM(0),(V1))>0)){
+	goto L132;}
+	RETURN(Lerror(2,VV[37],(V1))              /*  ERROR           */);
+L132:
+	{register int V2;                         /*  BUFID           */
+	V2= pvm_initsend(fix((V1)));
+	if(!((V2)<0)){
+	goto L135;}
+	L1(2,MAKE_FIXNUM(V2),VV[38])              /*  PVM-ERROR       */;
+L135:
+	VALUES(0) = MAKE_FIXNUM(V2);
+	RETURN(1);
+	}
+}
+/*	function definition for C_PVM_SEND                            */
+static L39(int narg, object V1, object V2)
+{
+	int x;
+	x=pvm_send(object_to_int(V1), object_to_int(V2));
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-SEND-MESSAGE                     */
+static L40(int narg, object V1, object V2, object V3, object V4, ...)
+{ VT28 VLEX28 CLSR28
+	{int i=4;
+	object V5;
+	va_list args; va_start(args, V4);
+	if (i==narg) goto L138;
+	V5= va_arg(args, object);
+	i++;
+	goto L139;
+L138:
+	V5= MAKE_FIXNUM(0);
+L139:
+	L38(1,(V5))                               /*  LPVM-INIT-SEND  */;
+	(*LK1)(2,(V1),(V2))                       /*  WRITE-OBJECT    */;
+	{int V6;                                  /*  INFO            */
+	V6= pvm_send(fix((V4)), fix((V3)));
+	if(!((V6)<0)){
+	goto L143;}
+	L1(2,MAKE_FIXNUM(V6),VV[42])              /*  PVM-ERROR       */;
+	}
+L143:
+	RETURN(0);
+	}
+}
+/*	function definition for LPVM-MULTICAST                        */
+static L41(int narg, object V1, object V2, object V3, object V4, ...)
+{ VT29 VLEX29 CLSR29
+	{int i=4;
+	volatile object V5;
+	va_list args; va_start(args, V4);
+	if (i==narg) goto L147;
+	V5= va_arg(args, object);
+	i++;
+	goto L148;
+L147:
+	V5= MAKE_FIXNUM(0);
+L148:
+	L38(1,(V5))                               /*  LPVM-INIT-SEND  */;
+	(*LK1)(2,(V1),(V2))                       /*  WRITE-OBJECT    */;
+	{volatile object V6;
+	volatile object V7;                       /*  TID             */
+	V6= (V4);
+	V7= Cnil;
+L156:
+	if(!((V6)==Cnil)){
+	goto L157;}
+	goto L152;
+L157:
+	V7= CAR((V6));
+	{register int V9;                         /*  INFO            */
+	V9= pvm_send(fix((V7)), fix((V3)));
+	if(!((V9)<0)){
+	goto L162;}
+	L1(2,MAKE_FIXNUM(V9),VV[43])              /*  PVM-ERROR       */;
+	}
+L162:
+	V6= CDR((V6));
+	goto L156;
+	}
+L152:
+	RETURN(0);
+	}
+}
+/*	function definition for C_PVM_NRECV                           */
+static L42(int narg, object V1, object V2)
+{
+	int x;
+	x=pvm_nrecv(object_to_int(V1),object_to_int(V2));
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-NONBLOCKING-RECV                 */
+static L43(int narg, object V1, object V2, object V3)
+{ VT30 VLEX30 CLSR30
+TTL:
+	{register int V4;                         /*  BUFID           */
+	V4= pvm_nrecv(fix((V2)),fix((V3)));
+	if(!((V4)<0)){
+	goto L171;}
+	RETURN(L1(2,MAKE_FIXNUM(V4),VV[47])       /*  PVM-ERROR       */);
+L171:
+	if(!((0)==(V4))){
+	goto L174;}
+	VALUES(0) = Cnil;
+	RETURN(1);
+L174:
+	if(!((V4)>0)){
+	goto L177;}
+	RETURN((*LK2)(1,(V1))                     /*  READ-OBJECT     */);
+L177:
+	RETURN(Lerror(1,VV[48])                   /*  ERROR           */);
+	}
+}
+/*	function definition for C_PVM_RECV                            */
+static L44(int narg, object V1, object V2)
+{
+	int x;
+	x=pvm_recv(object_to_int(V1), object_to_int(V2));
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-BLOCKING-READ                    */
+static L45(int narg, object V1, object V2, object V3)
+{ VT31 VLEX31 CLSR31
+TTL:
+	{int V4;                                  /*  BUFID           */
+	V4= pvm_recv(fix((V2)), fix((V3)));
+	if(!((V4)<0)){
+	goto L180;}
+	L1(2,MAKE_FIXNUM(V4),VV[52])              /*  PVM-ERROR       */;
+L180:
+	RETURN((*LK2)(1,(V1))                     /*  READ-OBJECT     */);
+	}
+}
+/*	function definition for C_PVM_MYTID                           */
+static L46(int narg)
+{
+	int x;
+	x=pvm_mytid();
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-MY-TID                           */
+static L47(int narg)
+{ VT32 VLEX32 CLSR32
+TTL:
+	{register int V1;                         /*  INFO            */
+	V1= pvm_mytid();
+	if(!((V1)<0)){
+	goto L184;}
+	L1(2,MAKE_FIXNUM(V1),VV[56])              /*  PVM-ERROR       */;
+L184:
+	VALUES(0) = MAKE_FIXNUM(V1);
+	RETURN(1);
+	}
+}
+/*	function definition for C_PVM_EXIT                            */
+static L48(int narg)
+{
+	int x;
+	x=pvm_exit();
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-EXIT                             */
+static L49(int narg)
+{ VT33 VLEX33 CLSR33
+TTL:
+	{int V1;                                  /*  INFO            */
+	V1= pvm_exit();
+	if((0)==(V1)){
+	goto L187;}
+	L1(2,MAKE_FIXNUM(V1),VV[60])              /*  PVM-ERROR       */;
+	}
+L187:
+	RETURN(0);
+}
+/*	function definition for C_PVM_KILL                            */
+static L50(int narg, object V1)
+{
+	int x;
+	x=pvm_kill(object_to_int(V1));
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-KILL                             */
+static L51(int narg, object V1)
+{ VT34 VLEX34 CLSR34
+TTL:
+	{int V2;                                  /*  INFO            */
+	V2= pvm_kill(fix((V1)));
+	if(!((V2)<0)){
+	goto L191;}
+	L1(2,MAKE_FIXNUM(V2),VV[64])              /*  PVM-ERROR       */;
+	}
+L191:
+	RETURN(0);
+}
+/*	function definition for C_PVM_PARENT                          */
+static L52(int narg)
+{
+	int x;
+	x=pvm_parent();
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-PARENT                           */
+static L53(int narg)
+{ VT35 VLEX35 CLSR35
+TTL:
+	{int V1;                                  /*  INFO            */
+	V1= pvm_parent();
+	if(!((V1)==(-23))){
+	goto L195;}
+	L1(2,MAKE_FIXNUM(V1),VV[68])              /*  PVM-ERROR       */;
+	}
+L195:
+	RETURN(0);
+}
+/*	function definition for C_PVM_PSTAT                           */
+static L54(int narg, object V1)
+{
+	int x;
+	x=pvm_pstat(object_to_int(V1));
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-PSTAT                            */
+static L55(int narg, object V1)
+{ VT36 VLEX36 CLSR36
+TTL:
+	{register int V2;                         /*  INFO            */
+	V2= pvm_pstat(fix((V1)));
+	if(!((V2)==(0))){
+	goto L201;}
+	VALUES(0) = MAKE_FIXNUM(V2);
+	RETURN(1);
+L201:
+	if(!((V2)==(-31))){
+	goto L204;}
+	VALUES(0) = MAKE_FIXNUM(V2);
+	RETURN(1);
+L204:
+	RETURN(L1(2,MAKE_FIXNUM(V2),VV[72])       /*  PVM-ERROR       */);
+	}
+}
+/*	function definition for C_PVM_MSTAT                           */
+static L56(int narg, object V1)
+{
+	int x;
+	x=pvm_mstat(V1->st.st_self);
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-MSTAT                            */
+static L57(int narg, object V1)
+{ VT37 VLEX37 CLSR37
+TTL:
+	if(type_of((V1))==t_string){
+	goto L206;}
+	Lerror(2,VV[76],TYPE_OF((V1)))            /*  ERROR           */;
+L206:
+	{register int V2;                         /*  INFO            */
+	V2= pvm_mstat((V1)->st.st_self);
+	if(!((V2)==(0))){
+	goto L211;}
+	VALUES(0) = VV[77];
+	RETURN(1);
+L211:
+	if(!((V2)==(-6))){
+	goto L214;}
+	VALUES(0) = VV[78];
+	RETURN(1);
+L214:
+	if(!((V2)==(-22))){
+	goto L217;}
+	VALUES(0) = VV[79];
+	RETURN(1);
+L217:
+	RETURN(L1(2,MAKE_FIXNUM(V2),VV[80])       /*  PVM-ERROR       */);
+	}
+}
+/*	function definition for C_PVM_SPAWN                           */
+static L58(int narg, object V1, object V2, object V3, object V4)
+{
+	object x;
+	x=
+   Cnil;
+   {
+     int numt, tid, i;
+     int sz = object_to_int(V2);
+     object v;
+     extern object lisp_package;
+
+     siLmake_vector(7, intern("FIXNUM", lisp_package),
+                        MAKE_FIXNUM(sz), Cnil, Cnil, Cnil, Cnil, Cnil);
+     v = VALUES(0);
+     numt = pvm_spawn(V1->st.st_self, 0, object_to_int(V2), V3->st.st_self, object_to_int(V4), v->v_self);
+     if (numt < PvmOk) RETURN(1);
+     VALUES(0) = MAKE_FIXNUM(numt);
+     VALUES(1) = v;
+     RETURN(2);
+   };
+	VALUES(0)=x;
+	RETURN(1);
+}
+/*	function definition for LPVM-SPAWN                            */
+static L59(int narg, object V1, object V2, object V3, object V4)
+{ VT38 VLEX38 CLSR38
+TTL:
+	if(type_of((V1))==t_string){
+	goto L220;}
+	RETURN(Lerror(2,VV[81],TYPE_OF((V1)))     /*  ERROR           */);
+L220:
+	if(type_of((V2))==t_fixnum||type_of((V2))==t_bignum){
+	goto L223;}
+	RETURN(Lerror(2,VV[82],TYPE_OF((V2)))     /*  ERROR           */);
+L223:
+	if(type_of((V3))==t_string){
+	goto L226;}
+	RETURN(Lerror(2,VV[83],TYPE_OF((V3)))     /*  ERROR           */);
+L226:
+	if(type_of((V4))==t_fixnum||type_of((V4))==t_bignum){
+	goto L229;}
+	RETURN(Lerror(2,VV[84],TYPE_OF((V4)))     /*  ERROR           */);
+L229:
+	if(!(number_compare(MAKE_FIXNUM(1),(V4))<=0)){
+	goto L231;}
+	if(number_compare((V4),MAKE_FIXNUM(32))<=0){
+	goto L232;}
+L231:
+	RETURN(Lerror(2,VV[85],(V4))              /*  ERROR           */);
+L232:
+	{ int V5;
+	object V6;                                /*  NUM-SPAWNED     */
+	object V7;                                /*  TIDS            */
+	V5=L58(4,(V1),(V2),(V3),(V4))             /*  C_PVM_SPAWN     */;
+	if (V5--==0) goto L237;
+	V6= VALUES(0);
+	if (V5--==0) goto L238;
+	V7= VALUES(1);
+	goto L239;
+L237:
+	V6= Cnil;
+L238:
+	V7= Cnil;
+L239:
+	if(!(number_compare(MAKE_FIXNUM(0),(V6))>0)){
+	goto L241;}
+	RETURN(L1(2,(V6),VV[86])                  /*  PVM-ERROR       */);
+L241:
+	VALUES(1) = (V7);
+	VALUES(0) = (V6);
+	RETURN(2);}
+}
+/*	function definition for C_PVM_SENDSIG                         */
+static L60(int narg, object V1, object V2)
+{
+	int x;
+	x=pvm_sendsig(object_to_int(V1),object_to_int(V2));
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-SENDSIG                          */
+static L61(int narg, object V1, object V2)
+{ VT39 VLEX39 CLSR39
+TTL:
+	{int V3;                                  /*  INFO            */
+	V3= pvm_sendsig(fix((V1)),fix((V2)));
+	if(!((V3)<0)){
+	goto L243;}
+	L1(2,MAKE_FIXNUM(V3),VV[90])              /*  PVM-ERROR       */;
+	}
+L243:
+	RETURN(0);
+}
+/*	function definition for C_PVM_ADVISE                          */
+static L62(int narg, object V1)
+{
+	int x;
+	x=pvm_advise(object_to_int(V1));
+	VALUES(0)=MAKE_FIXNUM(x);
+	RETURN(1);
+}
+/*	function definition for LPVM-ADVISE                           */
+static L63(int narg, object V1)
+{ VT40 VLEX40 CLSR40
+TTL:
+	{int V2;                                  /*  INFO            */
+	V2= pvm_advise(fix((V1)));
+	if((V2)==(0)){
+	goto L247;}
+	L1(2,MAKE_FIXNUM(V2),VV[94])              /*  PVM-ERROR       */;
+	}
+L247:
+	RETURN(0);
+}
+static LKF2(int narg, ...) {TRAMPOLINK(VV[160],&LK2);}
+static LKF1(int narg, ...) {TRAMPOLINK(VV[157],&LK1);}
+static LKF0(int narg, ...) {TRAMPOLINK(VV[155],&LK0);}
diff --git a/contrib/pvm/pvmecl.lsp b/contrib/pvm/pvmecl.lsp
new file mode 100644
index 000000000..372739fcd
--- /dev/null
+++ b/contrib/pvm/pvmecl.lsp
@@ -0,0 +1,756 @@
+;;;-*-Mode:LISP; Syntax: Common LISP; Base: 10-*-
+;;;
+;;; File = pvmecl.lsp
+;;; Interface between ECoLISP and PVM.
+;;; This file contains the C function interface between ECoLisp and PVM.
+;;; It is not portable.
+;;;
+;;;
+;;; (c) 1994, I.D. Alexander-Craig, all rights reserved.
+;;;
+;;;
+
+;;;
+;;; pvmconsts.lsp must be loaded before this file.
+;;;
+
+;;;
+;;; Error function for PVM interface.
+;;;
+
+(defun pvm-error (errno routine)
+  (error "PVM interface error ~d in ~a~%" errno routine))
+
+
+(clines "
+#include \"/project/pvm/pvm3/include/pvm3.h\"
+")
+
+
+;;;
+;;; Begin with buffering routines.
+;;;
+
+;;
+;; Start with output buffering routines for simple types.
+;; Each C function is followed by the corresponding entry
+;; definition. Then comes the LISP function.
+;;
+
+
+(definline c_pvm_pkint (fixnum) fixnum
+   "({int x = #0; pvm_pkint(&x,1,1);})"
+)
+
+(defun obuffer-int (i)
+  (let ((info (c_pvm_pkint i)))
+    (unless (= %PvmOk info)
+      (pvm-error info "obuffer-int")))
+  (values))
+
+;;
+;; Packing routine for message types. This is a LISP function
+;; that calls c_pvm_pkint to pack the type.
+;;
+
+(defun pack-type-tag (typetag)
+  (let ((return-code (c_pvm_pkint typetag)))
+    (unless (= %PvmOk return-code)
+      (pvm-error return-code "pack-type-tag")))
+  (values))
+
+(defun C-obuffer-nil ()
+  (pack-type-tag LISP_NIL_TYPE))
+
+(defun C-obuffer-t ()
+  (pack-type-tag LISP_T_TYPE))
+
+(definline c_pvm_pkchar (character) fixnum
+   "({char x = #0; pvm_pkbyte(&x,1,1);})"
+)
+
+(defun C-obuffer-char (ch)
+  (pack-type-tag LISP_CHAR_TYPE)
+  (let ((info (c_pvm_pkchar ch)))
+    (unless (= %PvmOk info)
+	    (pvm-error info "pvm_pkchar call")))
+  (values))
+
+(defun C-obuffer-int (i)
+  (pack-type-tag LISP_INT_TYPE)
+  (let ((info (c_pvm_pkint i)))
+    (unless (= %PvmOk info)
+	    (pvm-error info "pvm_pkint call")))
+  (values))
+
+(definline c_pvm_pkfloat (short-float) fixnum
+  "({float x = #0; pvm_pkfloat(&x,1,1);})"
+)
+
+(defun obuffer-float (fl)
+  (let ((info (c_pvm_pkfloat fl)))
+    (unless (= %PvmOk info)
+	    (pvm-error info "obuffer-float")))
+  (values))
+
+(definline c_pvm_pkdouble (long-float) fixnum
+  "({double x = #0; pvm_pkdouble(&x,1,1);})"
+)
+
+(defun C-obuffer-double (db)
+  (let ((info (c_pvm_pkdouble db)))
+    (unless (= %PvmOk info)
+	    (pvm-error info "obuffer-double")))
+  (values))
+
+;;
+;; Packing routines for symbol and string.
+;; Both routines expect a string and a number (in that order)
+;; to be supplied to them.
+;; The number is the length of the string.
+;;
+;;
+;; The first function packs the length and the string into 
+;; the output buffer.
+;;
+(definline c_pvm_pkstr (string fixnum) fixnum
+  "({int type = #1;
+     type = pvm_pkint(&type,1,1);
+     ((type == PvmOk) ? pvm_pkstr((#0)->st.st_self) : type);})"
+)
+;;
+;; Now define the routines that manipulate symbols and strings.
+;;
+
+(defun C-obuffer-symbol (s)
+  (let ((pname (symbol-name s)))
+    (let ((len (length pname)))
+      (pack-type-tag LISP_SYMBOL_TYPE)
+      (let ((info (c_pvm_pkstr pname len)))
+	(unless (= %PvmOk info)
+		(pvm-error info "obuffer-symbol")))))
+  (values))
+
+(defun C-obuffer-string (str)
+  (let ((len (length str)))
+    (pack-type-tag LISP_STRING_TYPE)
+    (let ((info (c_pvm_pkstr str len)))
+      (unless (= %PvmOk info)
+	      (pvm-error info "obuffer-string"))))
+  (values))
+
+;;
+;; Packing routines for vector and list headers.
+;;
+
+(defun C-obuffer-vector-header (vector-length)
+  (pack-type-tag LISP_VECTOR_TYPE)
+  (let ((info (c_pvm_pkint vector-length)))
+    (unless (= %PvmOk info)
+	    (pvm-error info "obuffer-vector-header")))
+  (values))
+
+(defun C-obuffer-list-header ()
+  (pack-type-tag LISP_LIST_TYPE)
+  (values))
+
+;;
+;; Unpacking routines for scalar types.
+;;
+
+(defcbody c_pvm_unpack_tag () object
+" Cnil;
+  { int tagval, info;
+    info = pvm_upkint(&tagval,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = MAKE_FIXNUM(tagval);
+    RETURN(2);
+  }"
+)
+
+;(proclaim '(inline ibuffer-tag))
+(defun ibuffer-tag ()
+  (multiple-value-bind (info value)
+      (c_pvm_unpack_int)
+    (if info
+	value
+	(pvm-error info "ibuffer-tag"))))
+
+(defun C-next-msg-type ()
+  (ibuffer-tag))
+
+(defun C-next-type-name ()
+  (ibuffer-tag))
+
+(defcbody c_pvm_unpack_int () object
+" Cnil;
+  { int ival, info;
+    info = pvm_upkint(&ival,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = MAKE_FIXNUM(ival);
+    RETURN(2);
+  }"
+)
+
+(defun C-ibuffer-int ()
+  (multiple-value-bind (info value)
+      (c_pvm_unpack_int)
+    (if info
+	value
+	(pvm-error info "ibuffer-int"))))
+
+(defcbody c_pvm_unpack_char () object
+" Cnil;
+  { int info;
+    char chval;
+    info = pvm_upkbyte(&chval,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = code_char(chval);
+    RETURN(2);
+  }"
+)
+
+(defun C-ibuffer-char ()
+  (multiple-value-bind (info value)
+      (c_pvm_unpack_char)
+    (if info
+	value
+	(pvm-error info "ibuffer-char"))))
+
+(defcbody c_pvm_unpack_float () object
+" Cnil;
+  { int info;
+    float fval;
+    info = pvm_upkfloat(&fval,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = make_shortfloat(fval);
+    RETURN(2);
+  }"
+)
+
+(defun ibuffer-float ()
+  (multiple-value-bind (info value)
+      (c_pvm_unpack_float)
+    (if info
+	value
+	(pvm-error info "ibuffer-float"))))
+
+(defcbody c_pvm_unpack_double () object
+" Cnil;
+  {
+    int info;
+    double dval;
+    info = pvm_upkdouble(&dval,1,1);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = make_longfloat(dval);
+    RETURN(2);
+  }"
+)
+
+(defun C-ibuffer-double ()
+  (multiple-value-bind (info value)
+      (c_pvm_unpack_double)
+    (if info
+	value
+	(pvm-error info "ibuffer-double"))))
+
+
+;;
+;; Routines to get symbols and strings from the PVM
+;; buffer.
+;; This is a little tricky!
+;;
+
+;;
+;; First, a general unpacking routine for strings.
+;;
+
+(defun setstring (chr indx str)
+  (setf (aref str indx) chr)
+  (values))
+
+(defcbody c_pvm_unpack_chars (fixnum) object
+"
+  Cnil;
+  { char *strchrs;
+    int info;
+    info = pvm_upkstr(strchrs);
+    if (info != PvmOk) { VALUES(0) = Cnil; RETURN(1);}
+    VALUES(0) = MAKE_FIXNUM(info);
+    VALUES(1) = make_simple_string(strchrs);
+    RETURN(2);
+  }"
+)
+
+
+;;
+;; Now the routine which gets the length and the string
+;; from the buffer.
+;;
+
+(defun get-length-and-string ()
+  (let ((len (ibuffer-int)))
+    (multiple-value-bind (info str)
+	(c_pvm_unpack_chars len)
+      (if info
+	  (if (= (length str) len)
+	      str
+	      (format 
+	       t 
+	       "received string has length ~a, not ~a as promised.~%"
+	       (length str)
+	       len))
+	  (pvm-error info "get-length-and-string")))))
+
+(defun C-ibuffer-symbol ()
+  ; It might be useful sometimes just to return the string.
+  (let ((pname (get-length-and-string)))
+    (make-symbol pname)))
+
+(defun C-ibuffer-string ()
+  (get-length-and-string))
+
+
+(defun C-ibufer-vector-length ()
+  (C-ibuffer-int))
+
+
+;;;
+;;; Send and received routines (together with registration and exit).
+;;;
+
+(definline c_pvm_initsend (fixnum) fixnum
+  "pvm_initsend(#0)")
+
+(defun lpvm-init-send (encoding)
+  (cond ((not (integerp encoding))
+	 (error "lpvm-init-send expects an int, not a ~a~%"
+		(type-of encoding)))
+	((minusp encoding)
+	 (error
+	  "lpvm-init-send: encoding must be non-negative (~d)~%"
+	  encoding))
+	(t
+	 (let ((bufid (c_pvm_initsend encoding)))
+	   (when (minusp bufid)
+		 (pvm-error bufid "pvm_initsend call"))
+	   bufid))))
+
+(definline c_pvm_send (fixnum fixnum) fixnum
+  "pvm_send(#0, #1)")
+
+;;;
+;;; The send routine.
+;;;
+
+(defun lpvm-send-message (lisp-object
+			  reader-object
+			  message-type
+			  destination-task
+			  &optional (encoding %PvmDataDefault))
+  (lpvm-init-send encoding)
+  (write-object lisp-object reader-object)
+  (let ((info (c_pvm_send destination-task message-type)))
+    (when (minusp info)
+	  (pvm-error info "pvm_send call")))
+  (values))
+
+;;;
+;;; The multi-cast routine is similar, but we set up the buffer
+;;; once and then repeatedly send the message.
+;;;
+
+(defun lpvm-multicast (lisp-object
+		       reader-object
+		       message-type
+		       destination-tasks
+		       &optional (encoding %PvmDataDefault))
+  (lpvm-init-send encoding)
+  (write-object lisp-object reader-object)
+  (dolist (tid destination-tasks)
+	  (let ((info (c_pvm_send tid message-type)))
+	    (when (minusp info)
+		  (pvm-error info "pvm_multicast"))))
+  (values))
+
+;;;
+;;; Receive routines.
+;;;
+
+(definline c_pvm_nrecv (fixnum fixnum) fixnum
+  "pvm_nrecv(#0,#1)"
+)
+
+(defun lpvm-nonblocking-recv (object-reader tid msgtag)
+  (let ((bufid (c_pvm_nrecv tid msgtag)))
+    (cond ((minusp bufid)
+	   (pvm-error bufid "pvm_nrecv"))
+	  ((= %PvmOk bufid)
+	   ()) ; nothing there
+	  ((plusp bufid)
+	   (read-object object-reader))
+	  (t
+	   (error
+	    "something weird has happened---nonblocking-recv")))))
+
+(definline c_pvm_recv (fixnum fixnum) fixnum
+  "pvm_recv(#0, #1)"
+)
+
+(defun lpvm-blocking-read (object-reader tid msgtag)
+  (let ((bufid (c_pvm_recv tid msgtag)))
+    (when (minusp bufid)
+	  (pvm-error bufid "pvm_recv"))
+    (read-object object-reader)))
+
+
+;;;
+;;; Join PVM primitive.
+;;;
+
+(definline c_pvm_mytid () fixnum
+  "pvm_mytid()"
+)
+
+(defun lpvm-my-tid ()
+  (let ((info (c_pvm_mytid)))
+    (when (minusp info)
+	  (pvm-error info "pvm_mytid call"))
+    info))
+
+
+;;;
+;;; Leave PVM primitive.
+;;;
+
+(definline c_pvm_exit () fixnum
+  "pvm_exit()")
+
+(defun lpvm-exit ()
+  (let ((info (c_pvm_exit)))
+    (unless (= %PvmOk info)
+	    (pvm-error info "pvm_exit call")))
+  (values))
+
+
+(definline c_pvm_kill (fixnum) fixnum
+  "pvm_kill(#0)"
+)
+
+(defun lpvm-kill (tid)
+  (let ((info (c_pvm_kill tid)))
+    (when (minusp info)
+	  (pvm-error info "pvm_kill call")))
+  (values))
+
+(definline c_pvm_parent () fixnum
+  "pvm_parent()"
+)
+
+(defun lpvm-parent ()
+  (let ((info (c_pvm_parent)))
+    (when (= info %PvmNoParent)
+	  (pvm-error info "pvm_parent")))
+  (values))
+
+(definline c_pvm_pstat (fixnum) fixnum
+  "pvm_pstat(#0)"
+)
+
+(defun lpvm-pstat (tid)
+  (let ((info (c_pvm_pstat tid)))
+    (cond ((= info %PvmOk)
+	   info)
+	  ((= info %PvmNoTask)
+	   info)
+	  (t
+	   (pvm-error info "pvm_stat call")))))
+
+(definline c_pvm_mstat (string) fixnum
+  "pvm_mstat(#0->st.st_self)"
+)
+
+(defun lpvm-mstat (hostname)
+  (unless (stringp hostname)
+	  (error "lpvm-mstat: hostnames must be strings, not ~a~%"
+		 (type-of hostname)))
+  (let ((info (c_pvm_mstat hostname)))
+    (cond ((= info %PvmOk)
+	   'running)
+	  ((= info %PvmNoHost)
+	   'no-such-host)
+	  ((= info %PvmHostFail)
+	   'host-unreachable)
+	  (t
+	   (pvm-error info "pvm_mstat call")))))
+
+(defcbody c_pvm_spawn (string fixnum string fixnum) object
+"
+   Cnil;
+   {
+     int numt, tid, i;
+     int sz = #1;
+     object v;
+     extern object lisp_package;
+
+     siLmake_vector(7, intern(\"FIXNUM\", lisp_package),
+                        MAKE_FIXNUM(sz), Cnil, Cnil, Cnil, Cnil, Cnil);
+     v = VALUES(0);
+     numt = pvm_spawn(#0->st.st_self, 0, #1, #2->st.st_self, #3, v->v.v_self);
+     if (numt < PvmOk) RETURN(1);
+     VALUES(0) = MAKE_FIXNUM(numt);
+     VALUES(1) = v;
+     RETURN(2);
+   }"
+)
+
+(defun lpvm-spawn (taskname flag where numtasks)
+  (cond ((not (stringp taskname))
+	 (error "spawn -- wrong type: ~A" (type-of taskname)))
+	((not (integerp flag))
+	 (error "spawn -- wrong type: ~A" (type-of flag)))
+	((not (stringp where))
+	 (error "spawn -- wrong type: ~A" (type-of where)))
+	((not (integerp numtasks))
+	 (error "spawn -- wrong type: ~A" (type-of numtasks)))
+	((not (and (<= 1 numtasks)
+		   (<= numtasks 32)))
+	 (error "spawn -- wrong number of tasks: ~D" numtasks))
+	(t
+	 (multiple-value-bind (num-spawned tids)
+	     (c_pvm_spawn taskname flag where numtasks)
+	   (if (minusp num-spawned)
+	       (pvm-error num-spawned "pvm_spawn call")
+	       (values num-spawned tids))))))
+
+
+(definline c_pvm_sendsig (fixnum fixnum) fixnum
+  "pvm_sendsig(#0,#1)"
+)
+
+(defun lpvm-sendsig (tid signum)
+  (let ((info (c_pvm_sendsig tid signum)))
+    (when (minusp info)
+	  (pvm-error info "pvm_sendsig call")))
+  (values))
+
+(definline c_pvm_advise (fixnum) fixnum
+  "pvm_advise(#0)"
+)
+
+(defun lpvm-advise (route)
+  (let ((info (c_pvm_advise route)))
+    (unless (= info %PvmOk)
+	    (pvm-error info "pvm_advise call")))
+  (values))
+
+;;;;
+;;;; Group operations.
+;;;;
+
+
+(definline c_pvm_join_group (object) fixnum
+  "pvm_joingroup(#0->st.st_self)"
+)
+
+(defun lpvm-join-group (group)
+  (unless (stringp group)
+	  (error "lpvm-join-grou expects a string, not a ~a~%"
+		 (type-of group)))
+  (let ((inum (c_pvm_joingroup group)))
+    (when (minusp inum)
+	  (pvm-error inum "pvm_joingroup call"))
+    inum))
+
+(definline c_pvm_leave_group (object) fixnum
+  "pvm_lvgroup(#0->st.st_self)"
+)
+
+(defun lpvm-leave-group (group)
+  (unless (stringp group)
+	  (error
+	   "lpvm-leave-group expects a string, not a ~a~%"
+	   (type-of group)))
+  (let ((info (c_pvm_leave_group group)))
+    (when (minusp info)
+	  (pvm-error info "pvm_lvgroup call")))
+  (values))
+
+(definline c_pvm_get_tid (object fixnum) fixnum
+  "pvm_gettid(#0->st.st_self, #1)"
+)
+
+(defun lpvm-get-tid (group inum)
+  (unless (stringp group)
+	  (error
+	   "lpvm-get-tid expects arg 1 to be a string, not a ~a~%"
+	   (type-of group)))
+  (unless (integerp inum)
+	  (error
+	   "lpvm-get-tid expects arg 2 to be an int, not a ~a~%"
+	   (type-of inum)))
+  (let ((info (c_pvm_get_tid group inum)))
+    (cond ((plusp info)
+	   info)
+	  ((minusp info)
+	   (pvm-error info "pvm_gettid call"))
+	  (t
+	   (pvm-error 0 "pvm_gettid: should not happen")))))
+
+(definline c_pvm_get_inst (object fixnum) fixnum
+  "pvm_getinst(#0->st.st_self, #1)"
+)
+
+(defun lpvm-get-inst-no (group tid)
+  (cond ((not (stringp group))
+	 (error
+	  "lpvm-get-inst-no expects arg1 to be a string, not a ~a~%"
+	  (type-of group)))
+	((not (integerp tid))
+	 (error
+	  "lpvm-get-inst-no expects arg2 to be an int, not a ~a~%"
+	  (type-of tid)))
+	(t
+	 (let ((inum (c_pvm_get_inst group tid)))
+	   (when (minusp inum)
+		 (pvm-error inum "pvm_getinst call"))
+	   inum))))
+
+(definline c_pvm_grpsize (object) fixnum
+  "pvm_gsize(#0->st.st_self)"
+)
+
+(defun lpvm-group-size (group)
+  (unless (stringp group)
+	  (error
+	   "lpvm-group-size expects a string not a ~a~%"
+	   (type-of group)))
+  (let ((size (c_pvm_grpsize group)))
+    (when (minusp size)
+	  (pvm-error size "pvm_gsize call"))
+    size))
+
+(definline c_pvm_barrier (object fixnum) fixnum
+  "pvm_barrier(#0->st.st_self,#1)"
+)
+
+(defun lpvm-barrier (group count)
+  (cond ((not (stringp group))
+	 (error
+	  "lpvm-barrier expects arg 1 to be a string, not a ~a~%"
+	  (type-of group)))
+	((not (integerp count))
+	 (error
+	  "lpvm-barriet expects arg 2 to be an int, not a ~a~%"
+	  (type-of count)))
+	(t
+	 (let ((info (c_pvm_barrier group count)))
+	   (unless (= %PvmOk info)
+		   (pvm-error info "pvm_barrier call")))))
+  (values))
+
+(definline c_pvm_broadcast (object fixnum) fixnum
+  "pvm_bcast(#0->st.st_self,#1)"
+)
+
+(defun lpvm-broadcast (lisp-object
+		       reader-object
+		       message-type
+		       group-name
+		       &optional (encoding %PvmDataDefault))
+  (lpvm-init-send encoding)
+  (write-object lisp-object reader-object)
+  (let ((info (c_pvm_broadcast group-name message-type)))
+    (when (minusp info)
+	  (pvm-error info "pvm_bcast call")))
+  (values))
+
+
+(defCbody c_pvm_probe (fixnum fixnum) fixnum
+  "0;
+   { int bufid, info;
+     int *bytes;
+     int out_tid, out_tag;
+     VALUES(0) = Cnil;
+     bufid = pvm_probe(#0,#1);
+     if (bufid == 0) RETURN(1);
+     if (bufid < 0) { 
+       VALUES(0) = CONS(MAKE_FIXNUM(bufid), Cnil);
+       RETURN(1);
+     }
+     info = pvm_bufinfo(bufid,bytes,&out_tag,&out_tid);
+     VALUES(0) = list(3, MAKE_FIXNUM(info), MAKE_FIXNUM(out_tag),
+                         MAKE_FIXNUM(out_tid));
+     RETURN(1);
+   }"
+)
+
+(defun lpvm-probe (tid msgno)
+  (let ((return-val (c_pvm_probe tid msgno)))
+    (let ((num-returned (length return-val))
+	  (out-tid 0)
+	  (out-tag 0)
+	  (info    0))
+      (cond ((= num-returned 1)
+	     (pvm-error (car return-val) "pvm_probe call"))
+	    (t
+	     (setf info    (first  return-val))
+	     (setf out-tag (second return-val))
+	     (setf out-tid (third  return-val))
+	     (if (= info %PvmOk)
+		 (values out-tid out-tag)
+	       (pvm-error info "pvm_probe call")))))))
+	
+
+;;;;
+;;;; Add and delete hosts.
+;;;;
+
+;;
+;; add_host adds a single host to the machine. hostname is the
+;; string name of the host. The function returns a pair.
+
+(defCbody c_pvm_add_host (object) object
+  "Cnil;
+   { int host_info[1];
+     int info, hival;
+     info = pvm_addhosts(&(#0)->st.st_self,1,host_info);
+     hival = host_info[0];
+     VALUES(0) = list(2, MAKE_FIXNUM(info), MAKE_FIXNUM(hival));
+     RETURN(1);
+   }"
+)
+
+(defun add-hosts (hostnames)
+  (let ((results (make-array (length hostnames))))
+    (dotimes (host (length hostnames))
+      (let ((host (aref hostnames)))
+	(c_pvm_add_host host)
+	(setf (aref results host)(cadr host))))
+    results))
+	       
+
+(defCbody c_pvm_del_host (object) object
+  "Cnil;
+   { int host_info[1];
+     int info, hival;
+     info = pvm_delhosts(&(#0)->st.st_self,1,host_info);
+     hival = host_info[0];
+     VALUES(0) = list(2, MAKE_FIXNUM(info), MAKE_FIXNUM(hival));
+     RETURN(1);
+   }"
+)
+
+(defun del-hosts (hostnames)
+  (let ((results (make-array (length hostnames))))
+    (dotimes (host (length hostnames))
+      (let ((host (aref hostnames)))
+	(c_pvm_add_host host)
+	(setf (aref results host) (cadr host))))
+    results))
+
diff --git a/contrib/pvm/pvmlisp.lsp b/contrib/pvm/pvmlisp.lsp
new file mode 100644
index 000000000..67fb2e0b7
--- /dev/null
+++ b/contrib/pvm/pvmlisp.lsp
@@ -0,0 +1,620 @@
+;;;-*-Mode: LISP; Syntax: Common LISP; Base: 10-*-
+;;;
+;;; File = pvmlisp.lsp
+;;;
+;;; New version of reader structure using vectors.
+;;;
+;;;
+;;; This code only works with Common LISP. It should not be included
+;;; in a CLOS program (yet). It will also not work with CLiCC.
+;;;
+;;;
+;;; Message-start-p is used to detect the start of a complex message.
+;;; It is true if it is applied to a message tag.
+;;;
+
+(defun message-start-p (mty)
+  (and (integerp mty)
+       (= MESSAGE_START mty)))
+
+;;;;****************************************************************;;;;
+;;;;                                                                ;;;;
+;;;;                                                                ;;;;
+;;;;****************************************************************;;;;
+
+;;;;****************************************************************;;;;
+;;;;                                                                ;;;;
+;;;; We define the reader object. This is a structure containing    ;;;;
+;;;; the function closures which perform the encoding and decoding. ;;;;
+;;;; We begin by defining the encoder and decoder structures and    ;;;;
+;;;; manipulation functions (this will be a dream in CLOS or        ;;;;
+;;;; TELOS!)                                                        ;;;;
+;;;;                                                                ;;;;
+;;;;****************************************************************;;;;
+
+;;;
+;;; The encoder structure. 
+;;; The design of the encoder is such that it allows users to configure
+;;; their own encoders. For example, CMU CL calls a SIMPLE-STRING a 
+;;; SIMPLE-BASE-STRING. This can be accomodated within this organisation 
+;;; at the cost of a little effort.
+;;;
+(defstruct encoder-rec  
+  typename  ;; value returned by type-of and used to index the
+            ;; encoder function
+  msgtypeno ;; the numeric message type
+  encoder-fn)
+
+;;;
+;;; Encoders are held in hash tables. The following function (which
+;;; should be inline) creates such a table.
+;;;
+;(declaim (inline make-encoder-structure))
+(proclaim '(inline make-encoder-structure))
+
+(defun make-encoder-structure ()
+  (make-hash-table :test #'eq))
+
+;;;
+;;; encoder-present-p is true if there is an encoder for the
+;;; named type in the encoder table.
+;;;
+
+(defun encoder-present-p (enc-struc typename)
+  (multiple-value-bind (encrec there)
+                       (gethash typename enc-struc)
+    (declare (ignore encrec))
+    there))
+
+;;;
+;;; Retrieval function for encoders. Given a type name, it returns the
+;;; encoder function associated with the type.
+;;;
+
+(defun get-encoder (enc-struc typename)
+  (multiple-value-bind (encoder-rec known-type)
+                       (gethash typename enc-struc)
+    (if known-type
+      (encoder-rec-encoder-fn encoder-rec)
+      ())))
+
+;;;
+;;; Routine to store an encoder function.
+;;; Assumes that typename and typeno have been checked.
+;;;
+
+(defun put-encoder (enc-struc typename typeno encoder-fn)
+  (setf (gethash typename enc-struc)
+        (make-encoder-rec :encoder-fn encoder-fn
+                          :typename   typename
+                          :msgtypeno  typeno))
+  (values))
+
+;;;****************************************************************;;;
+;;;                                                                ;;;
+;;;                                                                ;;;
+;;; A routine to replace the encoder function and a routine to     ;;;
+;;; remove an encode could be added here.                          ;;;
+;;;                                                                ;;;
+;;;                                                                ;;;
+;;;****************************************************************;;;
+
+;;;
+;;; message-type-number returns the type number associated with a
+;;; symbolic type name. Its input is an encoder structure.
+;;;
+
+(defun message-type-number (enc-struc typename)
+  (multiple-value-bind (enc-rec known-type)
+                       (gethash typename enc-struc)
+    (if known-type
+      (encoder-rec-msgtypeno enc-rec)
+      (error "cannot return type number for type ~a: unknown type.~%"
+             typename))))
+
+;;;;****************************************************************;;;;
+;;;;                                                                ;;;;
+;;;; The decoder structure and containing object.                   ;;;;
+;;;;                                                                ;;;;
+;;;;                                                                ;;;;
+;;;;****************************************************************;;;;
+
+;;;
+;;; The decoder is indexed by its message type number.
+;;; Decoders have a symbolic identifier associated with them.
+;;;
+
+(defstruct decoder-rec
+  typename
+  decoder-fn)
+
+;;;
+;;; Decoders are held in a hash table. The table is indexed by the
+;;; message number. The hash table representation is used so that
+;;; users can have gaps in their message number sequences.
+;;;
+
+;(declaim (inline make-decoder-structure))
+(proclaim '(inline make-decoder-structure))
+
+(defun make-decoder-structure ()
+  (make-hash-table :test #'eql))
+   
+;;;
+;;; decoder-present-p is true if there is a decoder structure
+;;; in the decoder table at the point indexed by the numeric
+;;; message type.
+;;;
+
+(defun decoder-present-p (dec-struc msg-type-no)
+  (multiple-value-bind (decrec there)
+		       (gethash msg-type-no dec-struc)
+		       (declare (ignore decrec))
+     there))
+
+;;;
+;;; get-decoder returns the decoder function associated with a
+;;; message type number. If there is no such message, an error is raised.
+;;;
+
+(defun get-decoder (decoder-struc msg-no)
+  (multiple-value-bind (decrec there)
+		       (gethash msg-no decoder-struc)
+      (if there
+	  (decoder-rec-decoder-fn decrec)
+	())))
+
+;;;
+;;; put-decoder inserts a decoder record into the decoder vector.
+;;; If a decoder structure is already in the vector at the place 
+;;; indexed by the message number, an error is raised.
+;;;
+;;; Note that this function will expand the vector if there is 
+;;; insufficient room.
+;;;
+
+(defun put-decoder (decoder-struc msg-no msg-typename decoder-fn)
+  (setf (gethash msg-no decoder-struc)
+          (make-decoder-rec :typename msg-typename
+                            :decoder-fn decoder-fn))
+  (values))
+         
+
+;;;****************************************************************;;;
+;;;                                                                ;;;
+;;;                                                                ;;;
+;;; A routine to replace the decoder function and a routine to     ;;;
+;;; remove an encode could be added here.                          ;;;
+;;;                                                                ;;;
+;;;                                                                ;;;
+;;;****************************************************************;;;
+
+;;;
+;;; message-number-type returns the symbolic name associated with
+;;; a numeric message type.
+;;;
+
+(defun message-number-type (decoder-struc msg-type-no)
+  (decoder-rec-typename
+   (aref decoder-struc msg-type-no)))
+
+      
+;;;;****************************************************************;;;;
+;;;;                                                                ;;;;
+;;;; The reader object and its associated functions.                ;;;;
+;;;; Note that encoder and decoders can be added or removed at      ;;;;
+;;;; runtime.                                                       ;;;;
+;;;;                                                                ;;;;
+;;;;****************************************************************;;;;
+
+(defstruct reader-object
+  (encoders (make-encoder-structure))
+  (decoders (make-decoder-structure))
+  (known-type-names ()))
+
+;;;
+;;; A creation function for readers.
+;;;
+
+(defun make-object-reader ()
+  (make-reader-object))
+
+;;;
+;;; add-type-name adds a symbolic type name to the reader object.
+;;;
+
+;(declaim (inline add-type-name))
+(proclaim '(inline add-type-name))
+
+(defun add-type-name (reader-obj typename)
+  (pushnew typename
+            (reader-object-known-type-names reader-obj)
+           :test #'eq)
+  (values))
+
+;;;; A deletion function can easily be defined.
+
+;;;
+;;; valid-type-name-p is true iff the type name supplied as
+;;; the second argument is known to the reader supplied as the
+;;; first argument.
+;;;
+
+;(declaim (inline valid-type-name-p))
+(proclaim '(inline valid-type-name-p))
+
+(defun valid-type-namex-p (reader-obj typename)
+  (member typename
+	  (reader-object-known-type-names reader-obj)
+          :test #'eq))
+
+;(declaim (inline known-type-name-p))
+(proclaim '(inline known-type-name-p))
+
+(defun known-type-name-p (reader-obj typename)
+  (member typename
+          (reader-object-known-type-names reader-obj)
+          :test #'eq))
+
+;;;
+;;; valid-message-type-no-p is true if the message type number
+;;; supplied as the second argument is (i) positive and (ii) in the
+;;; range 0 .. (length decoders)
+;;;
+
+;(declaim (inline valid-message-type-no-p))
+(proclaim '(inline valid-message-type-no-p))
+
+(defun valid-message-type-no-p (reader-obj msg-typeno)
+  (multiple-value-bind (decrec present)
+		       (gethash msg-typeno
+				(reader-object-decoders reader-obj))
+		       (declare (ignore decrec))
+      present))
+
+;(declaim (inline known-type-number-p))
+(proclaim '(inline known-type-number-p))
+
+(defun known-type-number-p (reader-obj msg-typeno)
+  (multiple-value-bind (decrec present)
+		       (gethash msg-typeno
+				(reader-object-decoders reader-obj))
+		       (declare (ignore decrec))
+      present))
+
+;;;
+;;; Routines to add encoder and decoder functions to a reader object.
+;;; They can be called at runtime as well as at configuration time.
+;;; Procedures to replace readers and writers could be defined if
+;;; necessary---they won't be too difficult. 
+;;;
+
+(defun add-encoder (reader-obj         ;; the reader object
+                    message-type-no    ;; the numeric type of the
+                                       ;; message type
+                    message-type-name  ;; the symbolic name of the
+		                       ;; message type
+                    encoder-function)  ;; the encoder function proper
+  ; start by checking that the type is not already known.
+  (when (and (known-type-name-p reader-obj message-type-name)
+             (encoder-present-p (reader-object-encoders reader-obj)
+                                 message-type-name))
+    (error
+     "add-encoder: cannot add encoder for ~a -- one already present~%"
+     message-type-name))
+  ; try to add the type name (a decoder might have put it there already)
+  (add-type-name reader-obj message-type-name)
+  ; add the encoder function
+  (put-encoder (reader-object-encoders reader-obj)
+               message-type-name
+               message-type-no
+               encoder-function)
+  (values))
+
+  
+(defun add-decoder (reader-obj         ;; the reader object
+                    message-type-no    ;; the numeric type of the
+                                       ;; message type
+                    message-type-name  ;; the symbolic name of the
+                                        ;; message type
+                    decoder-function)  ;; the encoder function proper
+  ; start by checking that the type is not already known
+  (when (and (known-type-name-p reader-obj message-type-name)
+             (decoder-present-p (reader-object-decoders reader-obj)
+                                message-type-no))
+    (error
+     "add-decoder: cannot add decoder for ~a -- one already present~%"
+     message-type-name))
+  ; try to add the type name (an encoder might have already added it)
+  (add-type-name reader-obj message-type-name)
+  ; add the decoder function
+  (put-decoder (reader-object-decoders reader-obj)
+               message-type-no
+               message-type-name
+               decoder-function)
+  (values))
+
+;;;;****************************************************************;;;;
+;;;;                                                                ;;;;
+;;;; Some utility functions.                                        ;;;;
+;;;;                                                                ;;;;
+;;;;                                                                ;;;;
+;;;;****************************************************************;;;;
+
+;;;
+;;; Only proper lists can be transmitted and received -- sorry.
+;;;
+
+(defun proper-listp (l)
+  (and (not (null l))
+       (list l)
+       (null (cdr (last l)))))
+
+;;;
+;;; type-name is used in indexing the encoders.
+;;;
+
+(defun type-name (typ)
+  (if (symbolp typ)
+    typ
+    (car typ)))
+
+;;;
+;;; initialise-reader-object takes a reader object as its first
+;;; argument and a list of lists of the following form:
+;;; (typename -- a symbol
+;;;  typeno   -- a natural number (one of the LISP_X_TYPEs)
+;;;  encoder  -- a closure or the symbol '*
+;;;  decoder  -- a closure or the symbol '*
+;;; )
+;;;
+
+(defun initialise-reader-object (reader-obj  ;; the reader to be started.
+                                 specs)      ;; a list of reader and writer
+                                             ;; specifications
+  (dolist (spec specs)
+    (let ((typename (first  spec))
+          (typeno   (second spec))
+          (encfn    (third  spec))
+          (decfn    (fourth spec)))
+      (when (and (symbolp encfn)
+                 (eq encfn '*)
+                 (symbolp decfn)
+                 (eq decfn '*))
+        (error
+         "initialise reader: reader and writer for ~a both unspecified.~%"
+         typename))
+      (unless (and (symbolp encfn)
+                   (eq '*   encfn))
+        ; add an encoder.
+        (add-encoder reader-obj typeno typename encfn))
+      (unless (and (symbolp decfn)
+                   (eq '*   decfn))
+        (add-decoder reader-obj typeno typename decfn))))
+  (values))
+
+
+;;;;****************************************************************;;;;
+;;;;                                                                ;;;;
+;;;; Routines to apply encoders and decoders. These are the core    ;;;;
+;;;; of the module.                                                 ;;;;
+;;;;                                                                ;;;;
+;;;;****************************************************************;;;;
+
+(defun apply-encoder (objectreader  ;; reader in which to look for encoder
+                      lisp-object)  ;; object to encode
+  (let ((tname (type-name (type-of lisp-object))))
+    (cond ((not (known-type-name-p objectreader tname))
+           (error
+            "apply-encoder: cannot encode -- unknown type ~a for object ~a~%"
+            tname
+            lisp-object))
+          (t
+           (let ((encode-fn (get-encoder
+                             (reader-object-encoders objectreader)
+                             tname)))
+             (cond ((null encode-fn)
+                    (error
+                     "apply-encoder: no writer function for type ~a~%"
+                     tname))
+                   (t
+                     (funcall encode-fn lisp-object objectreader)))))))
+  (values))
+
+(defun apply-decoder (objectreader     ;; the reader in which to look
+                      message-type-no) ;; the number of the message
+  (cond ((not (known-type-number-p objectreader message-type-no))
+         (error
+          "apply-decoder: cannot decode -- unknown message type number ~d~%"
+          message-type-no))
+        (t
+         (let ((decoder-struc (reader-object-decoders objectreader)))
+           (let ((decoder-fn (get-decoder decoder-struc message-type-no)))
+             (if (null decoder-fn)
+               (error
+                "apply-decoder: no reader function for type ~a~%"
+                (message-number-type decoder-struc message-type-no))
+               (funcall decoder-fn objectreader)))))))
+
+
+
+;;;****************************************************************;;;
+;;;                                                                ;;;
+;;; User interface functions.                                      ;;;
+;;;                                                                ;;;
+;;;****************************************************************;;;
+
+(defun write-object (object reader)
+  (apply-encoder reader object))
+
+(defun write-user-object-type (object reader)
+  (let ((encoders (reader-object-encoders reader)))
+    (multiple-value-bind (encrec there)
+                         (gethash (type-name (type-of object))
+                                  encoders)
+      (if there
+        (let ((msgno (encoder-rec-msgtypeno encrec)))
+          (when (>= msgno LISP_MIN_USER_TYPE)
+            (C-set-message-type msgno)))
+        (error
+          "write-object: no encoder information for type ~a~%"
+         (type-name (type-of object)))))))
+
+(defun read-object (reader)
+  (let ((next-object-type (C-next-msg-type)))
+(format t "got next type: ~A~%" (type-of next-object-type))
+    (when (message-start-p next-object-type)
+      (setf next-object-type (C-next-type-name)))
+    (apply-decoder reader next-object-type)))
+
+(defun add-writer (reader type-no type-name writer-fn)
+  (add-encoder reader type-no type-name writer-fn))
+
+(defun add-reader (reader type-no type-name writer-fn)
+  (add-decoder reader type-no type-name writer-fn))
+
+
+
+;;;;****************************************************************;;;;
+;;;;                                                                ;;;;
+;;;; Readers and writers for vectors and lists.                     ;;;;
+;;;; These should be used as default (they are, in any case,        ;;;;
+;;;; portable).                                                     ;;;;
+;;;;                                                                ;;;;
+;;;;****************************************************************;;;;
+
+;(declaim (inline ok-message-type))
+(proclaim '(inline ok-message-type))
+
+(defun ok-message-type (rdr type-no)
+  (known-type-number-p rdr type-no))
+
+;;;
+;;; Writer (encoder) for vectors.
+;;; Vectors must be of type SIMPLE-VECTOR.
+;;;
+
+(defun encode-vector (vec objreader)
+  (let ((len (length vec))) ;; get the length for the header.
+    ;; call the C primitive for stuffing the length
+    ;; into the PVM buffer
+    (C-obuffer-vector-header len)
+    ;; iterate over the vector, encoding each item and
+    ;; stuffing it into the buffer.
+    (dotimes (i len)
+      (apply-encoder objreader (aref vec i)))
+    ;; when control drops out of the bottom of this loop,
+    ;; the vector has been encoded.
+    ))
+
+;;;
+;;; Reader (decoder) for vectors.
+;;;
+
+(defun decode-vector (objreader)
+  ;; we know we have a vector, so get the length by
+  ;; calling the C primitive.
+  (let ((vector-len (C-ibuffer-vector-length)))
+    (cond ((minusp vector-len)
+           (error "Cannot read vector: negative length ~d~%"
+                  vector-len))
+          ((zerop vector-len)
+           (make-array '(0)))
+          (t
+           (let ((vec (make-array (list vector-len))))
+             ;; create a new vector and try to fill its elements
+             (dotimes (i vector-len)
+               (let ((next-obj-type ;; get the type of the next
+                                    ;; object to be decoded from a C
+                                    ;; routine
+                      (C-next-msg-type)))
+                 (when (not (ok-message-type objreader next-obj-type))
+                   ;; call a routine to check that there is an object
+                   ;; that comes next.
+                   (error "Cannot read vector: invalid type ~s~%"
+			  next-obj-type))
+                 (when (message-start-p next-obj-type)
+                   (setq next-obj-type (C-next-type-name)))
+                 (let ((next-elem (apply-decoder objreader next-obj-type)))
+                   (setf (aref vec i) next-elem))))
+             vec)))))
+
+;;;
+;;; Writer (encoder) for lists.
+;;; Lists must be PROPER lists.
+;;;
+
+(defun encode-list (list-to-go objreader)
+  ;; First ensure that we have a proper list.
+  (unless (proper-listp list-to-go)
+    (error
+     "encode-list: input list is not proper~% ~s ~%-- cannot encode, sorry.~%"
+     list-to-go))
+  ;; The list header should have been put into the output buffer.
+  ;; Remember that the end of the list has to be a nil message object.
+  ;; So: mark the object to go as a list by calling the C routine.
+  ;; (Perhaps the length could also be encoded for extra checking---
+  ;; perhaps not.)
+  ;; OK. Run over the list and encode the elements.
+  (C-obuffer-list-header)
+  (mapc ; or dolist or explicit manipulation---it doesn't matter
+   #'(lambda (element)
+       (apply-encoder objreader element))
+   list-to-go)
+  ;; finally, put a NIL into the output buffer to say that it's the
+  ;; end: do this by calling the C routine.
+  (C-obuffer-nil)
+  (values))
+
+;;;
+;;; Reader (decoder) for lists.
+;;;
+
+(defun decode-list (objreader)
+  ;; When we're called, we know we have a list.
+  ;; We need to iterate until we get a nil object.
+  ;; (Problem: what happens if there is no nil at the end??)
+  (let ((newlist ()) ;; the list we're going to build.
+        (next-item-type ())) ;; the type of the next object in the
+                             ;; input buffer
+    (loop
+      (setq next-item-type (C-next-msg-type))
+      (when (not (ok-message-type objreader next-item-type))
+        (error "cannot decode list: invalid type ~s~%"
+               next-item-type))
+      (cond ((= next-item-type LISP_NIL_TYPE)
+             (return)) ; got the end of the list.
+            ((message-start-p next-item-type)
+             (setq next-item-type (C-next-type-name))
+             (push (apply-decoder objreader next-item-type) newlist))
+            (t
+             (push (apply-decoder objreader next-item-type) newlist))))
+    (reverse newlist)))
+
+
+;;;;****************************************************************;;;;
+;;;;                                                                ;;;;
+;;;; An example of how to define a reader and a writer for a        ;;;;
+;;;; structure (the same outline applies to classes).               ;;;;
+;;;;                                                                ;;;;
+;;;;****************************************************************;;;;
+#|
+
+(defparameter *rdr* (make-object-reader))
+
+(defstruct foo slot1 slot2)
+
+(defconstant foo-type 32)
+
+(defun write-foo (obj rdr)
+  (write-object (foo-slot1 obj) rdr)
+  (write-object (foo-slot2 obj) rdr))
+
+(defun read-foo (rdr)
+  (let ((s1 (read-object rdr))
+        (s2 (read-object rdr)))
+    (make-foo :slot1 s1 :slot2 s2)))
+
+(add-writer *rdr* foo-type 'foo #'write-foo)
+(add-reader *rdr* foo-type 'foo #'read-foo)
+|#
diff --git a/contrib/thread.patch b/contrib/thread.patch
new file mode 100644
index 000000000..8bb1c1361
--- /dev/null
+++ b/contrib/thread.patch
@@ -0,0 +1,2062 @@
+--- src/c/error.c	Mon Jun 24 04:19:09 1996
++++ zsrc/c/error.c	Mon Jul 22 18:13:48 1996
+@@ -103,10 +103,44 @@
+ 
+ object siSterminal_interrupt;
+ 
++/* This gets _hard_ in threaded systems... */
++/* remembering that we may be in any thread when we get this call... */
++/* we may also _not_ be in a thread. Fortunately we can tell which */
++/* thread we are in by examining 'active'. */
++/* First determine where we are, if we are scheduled, or descheduled */
++/* if descheduled, then we need to be rescheduled... */
++/* then we can */
++
++#ifdef THREADS
++static bool ti_corr = 0;
++extern void *override_redirect_fun;
++extern pd *override_redirect_process;
++extern pd main_pd;
++
++terminal_interrupt2()
++{
++	funcall(2, siSterminal_interrupt, ti_corr? Ct : Cnil);
++}
++
++terminal_interrupt(bool correctable)
++{
++	ti_corr = correctable;
++
++	start_critical_section();
++
++	override_redirect_process = &main_pd;
++	override_redirect_fun = terminal_interrupt2;
++
++	force_resumption(&main_pd);
++	end_critical_section();
++}
++
++#else
+ terminal_interrupt(bool correctable)
+ {
+ 	funcall(2, siSterminal_interrupt, correctable? Ct : Cnil);
+ }
++#endif /* THREADS */
+ 
+ object
+ ihs_function_name(object x)
+diff --recursive --unified=3 src/c/file.d zsrc/c/file.d
+--- src/c/file.d	Tue Mar 12 20:38:01 1996
++++ zsrc/c/file.d	Wed Jul 17 22:16:17 1996
+@@ -22,6 +22,11 @@
+ 
+ #include "config.h"
+ 
++#ifdef THREADS
++# include <fcntl.h>
++#endif
++
++
+ #if defined(BSD) && !defined(MSDOS)
+ #include <sys/ioctl.h>
+ #endif
+@@ -347,6 +352,9 @@
+ 	x->sm.sm_object0 = Sstring_char;
+ 	x->sm.sm_object1 = fn;
+ 	x->sm.sm_int0 = x->sm.sm_int1 = 0;
++#ifdef THREADS
++	fcntl(fileno(fp), F_SETFL, O_NONBLOCK);
++#endif
+ 	setbuf(fp, alloc_contblock(BUFSIZ));
+ 	return(x);
+ }
+@@ -509,6 +517,11 @@
+ 
+ #ifdef TK
+ bool no_input = FALSE;
++#ifdef THREADS
++# define PUTC(c, fp)	lwpputc(c, fp)
++#else
++# define PUTC(c, fp)	putc(c, fp)
++#endif
+ 
+ StdinEnableEvents()
+ {
+@@ -521,11 +534,24 @@
+ }
+ # define GETC(c, fp)	{ if (fp == stdin) \
+ 			   while (no_input) Tk_DoOneEvent(0); \
++#ifdef THREADS
++			  c = lwpgetc(fp); \
++#else
+ 			  c = getc(fp); \
++#endif /* THREADS */
+ 			  no_input = !FILE_CNT(fp); }
+ # define UNGETC(c, fp)	{ if (fp == stdin) no_input = FALSE; ungetc(c, fp); }
+ #else
++#ifdef THREADS
++# define PUTC(c, fp)	lwpputc(c, fp)
++#else
++# define PUTC(c, fp)	putc(c, fp)
++#endif
++#ifdef THREADS
++# define GETC(c, fp)	c = lwpgetc(fp)
++#else
+ # define GETC(c, fp)	c = getc(fp)
++#endif /* THREADS */
+ # define UNGETC(c, fp)	ungetc(c, fp)
+ #endif
+ 
+@@ -544,8 +570,11 @@
+ 		if (fp == NULL)
+ 			closed_stream(strm);
+ 		GETC(c, fp);
+-/*		c &= 0377; */
+-		if (feof(fp))
++/*		c &= 0377; 	*/
++/*		if (feof(fp))	*/
++		/*c &= 0x7f;
++		printf("<%d:%c>", c, c); fflush(stdout);*/
++		if (c == EOF)
+ 			end_of_stream(strm);
+ /* 		strm->sm.sm_int0++; useless in smm_io, Beppe */
+ 		return(c);
+@@ -612,6 +641,7 @@
+ 		if (fp == NULL)
+ 			closed_stream(strm);
+ 		UNGETC(c, fp);
++		/* c &= 0x7f;	/* hmm? */
+ /*		--strm->sm.sm_int0; useless in smm_io, Beppe */
+ 		break;
+ 
+@@ -678,7 +708,7 @@
+ 			strm->sm.sm_int1++;
+ 		if (fp == NULL)
+ 			closed_stream(strm);
+-		putc(c, fp);
++		PUTC(c, fp);
+ 		break;
+ 
+ 	case smm_synonym:
+@@ -921,7 +951,8 @@
+ 		if (fp == NULL)
+ 			closed_stream(strm);
+ 		GETC(c, fp);
+-		if (feof(fp))
++/*		if (feof(fp))	*/
++		if (c == EOF)
+ 			return(TRUE);
+ 		else {
+ 			UNGETC(c, fp);
+diff --recursive --unified=3 src/c/gbc.c zsrc/c/gbc.c
+--- src/c/gbc.c	Wed Jul  3 02:15:49 1996
++++ zsrc/c/gbc.c	Mon Jul 22 18:04:37 1996
+@@ -530,7 +530,7 @@
+ 		break;
+ #endif CLOS
+ 	default:
+-		if (debug)
++		if (1 || debug)
+ 			printf("\ttype = %d\n", type_of(x));
+ 		error("mark botch");
+ 	}
+@@ -588,10 +588,14 @@
+ 
+ #ifdef THREADS
+ 	{
+-	  pd *pdp;
++	  pd *pdp, *queue;
+ 	  lpd *old_clwp = clwp;
+ 
+-	  for (pdp = running_head; pdp != (pd *)NULL; pdp = pdp->pd_next) {
++	  queue = running_queue;
++	  do {
++	  pdp = queue;
++	  do {
++	  /*for (pdp = running_head; pdp != (pd *)NULL; pdp = pdp->pd_next) <*/
+ 
+ 	    clwp = pdp->pd_lpd;
+ #endif THREADS
+@@ -620,7 +624,7 @@
+ 	    mark_object(clwp->lwp_gensym_prefix);
+ 	    mark_object(clwp->lwp_gentemp_prefix);
+ 	    mark_object(clwp->lwp_token);
+-	    
++
+ 	    /* (current-thread) can return it at any time
+ 	     */
+ 	    mark_object(clwp->lwp_thread);
+@@ -654,7 +658,48 @@
+ 		mark_stack_conservative(cs_org, where);
+ 	    }
+ #ifdef THREADS
+-	  }
++	  pdp = pdp->pd_next;
++	  } while(pdp != queue);
++
++	
++	/* Now I have to wonder why I didn't use an array of queues... :] */
++
++	if (queue == running_queue) {
++		if (blocking_queue) queue = blocking_queue;
++		else if (delayed_queue) queue = delayed_queue;
++		else if (dead_queue) queue = dead_queue;
++		else if (stopped_queue) queue = stopped_queue;
++		else if (suspended_queue) queue = suspended_queue;
++		else if (waiting_queue) queue = waiting_queue;
++		else queue = NULL;
++	} else if (queue == blocking_queue) {
++		if (delayed_queue) queue = delayed_queue;
++		else if (dead_queue) queue = dead_queue;
++		else if (stopped_queue) queue = stopped_queue;
++		else if (suspended_queue) queue = suspended_queue;
++		else if (waiting_queue) queue = waiting_queue;
++		else queue = NULL;
++	} else if (queue == delayed_queue) {
++		if (dead_queue) queue = dead_queue;
++		else if (stopped_queue) queue = stopped_queue;
++		else if (suspended_queue) queue = suspended_queue;
++		else if (waiting_queue) queue = waiting_queue;
++		else queue = NULL;
++	} else if (queue == dead_queue) {
++		if (stopped_queue) queue = stopped_queue;
++		else if (suspended_queue) queue = suspended_queue;
++		else if (waiting_queue) queue = waiting_queue;
++		else queue = NULL;
++	} else if (queue == stopped_queue) {
++		if (suspended_queue) queue = suspended_queue;
++		else if (waiting_queue) queue = waiting_queue;
++		else queue = NULL;
++	} else if (queue == suspended_queue) {
++		if (waiting_queue) queue = waiting_queue;
++		else queue = NULL;
++	} else if (queue == waiting_queue)
++		queue = NULL;
++	} while(queue != NULL);
+ 	  clwp = old_clwp;
+ 	}
+ #endif THREADS
+@@ -853,9 +898,9 @@
+     if (val == 0) {
+       /* informations used by the garbage collector need to be updated */
+ # ifdef __linux
+-      running_head->pd_env[0].__jmpbuf[0].__sp = old_env[0].__jmpbuf[0].__sp;
++      running_queue->pd_env[0].__jmpbuf[0].__sp = old_env[0].__jmpbuf[0].__sp;
+ # else
+-      running_head->pd_env[JB_SP] = old_env[JB_SP];
++      running_queue->pd_env[JB_SP] = old_env[JB_SP];
+ # endif
+       old_clwp = clwp;
+       Values = main_lpd.lwp_Values;
+Only in zsrc/c: gbc.my
+diff --recursive --unified=3 src/c/load.d zsrc/c/load.d
+--- src/c/load.d	Tue Mar 12 20:40:01 1996
++++ zsrc/c/load.d	Wed Jul 17 17:55:13 1996
+@@ -31,7 +31,9 @@
+ extern object Kwild;
+ extern object Vdefault_pathname_defaults;
+ extern object Vpackage;
++#ifndef THREADS
+ extern object Vstandard_output;
++#endif
+ extern object readc();
+ 
+ /******************************* ------- ******************************/
+diff --recursive --unified=3 src/c/lwp.d zsrc/c/lwp.d
+--- src/c/lwp.d	Thu Jun 27 17:43:28 1996
++++ zsrc/c/lwp.d	Mon Jul 22 18:14:34 1996
+@@ -3,6 +3,7 @@
+ */
+ /*
+     Copyright (c) 1990, Giuseppe Attardi.
++    Copyright (c) 1996, Brian Spilsbury.
+ 
+     ECoLisp is free software; you can redistribute it and/or
+     modify it under the terms of the GNU Library General Public
+@@ -12,18 +13,43 @@
+     See file '../Copyright' for full details.
+ */
+ 
++/*
++    Rewritten to use a multiple queue scheme to reduce time, and
++    facilitate simulated blocking io, and sleeping without
++    busy-looping.
++    Changed timing to be millisecond standard.
++    Made (sleep) equivelent to (%delay).
++    added lwpgetc(), lwpputc(), lwpread(), lwpwrite() to provide
++    for transparent blocking character and sequence io. lwpread, and
++    lwpwrite aren't used yet.
++    Made all streams non-blocking.
++
++    Brian Spilsbury, 1996.
++*/
+ 
+ #include "config.h"
+ 
++#include <sys/timeb.h>
++
+ /******************************* EXPORTS ******************************/
+ 
+ lpd main_lpd;
+ lpd *clwp = &main_lpd;
+ int critical_level = 0;
+-pd *running_head;		/* front of running pd's  */
+-pd *running_tail;		/* back of running pd's   */
++
+ pd main_pd;
+ 
++pd *active = &main_pd;		/* the pd that is attached to clwp */
++
++	/* circular queues, no tails */
++pd *running_queue;		/* running pd's  */
++pd *blocking_queue;		/* blocking pd's */
++pd *delayed_queue;		/* delaying pd's */
++pd *dead_queue;			/* dead pd's */
++pd *stopped_queue;		/* stopped pd's */
++pd *suspended_queue;		/* suspended pd's */
++pd *waiting_queue;		/* waiting pd's */
++
+ /******************************* IMPORTS ******************************/
+ 
+ extern scheduler_interruption; /* in unixint.c */
+@@ -37,27 +63,41 @@
+ #define thread_switch()  { setTimer(0); enable_scheduler(); \
+ 			     scheduler(0, 0, NULL); }
+ 
+-static bool timer_active = FALSE;
+-static bool scheduler_disabled = FALSE;
++static int timer_active = FALSE;
++static int scheduler_disabled = FALSE;
+ static int scheduler_level = 0;            /* tito */
+-static bool reset_timer = FALSE;
++static int reset_timer = FALSE;
+ static int running_processes = 1;
++static int awake_processes = 1;
+ static int absolute_time = 0;
++static int housekeeping_time = 0;
++static int fd_hightide = 3;		   /* highest fd ever to block + 1 */
++static int wake_lowtide = -1;		   /* time to closest sleep-wake */
++
++/* hopefully this will work with DJGPP, but I really have no idea... */
++/* Sets for blocking threads, see housekeeping */
++static fd_set fd_rd, fd_wr, fd_ex;
+ 
+ object Srunning;
+ object Ssuspended;
+ object Swaiting;
+ object Sstopped;
+ object Sdead;
++object Sblocking;
++object Sdelayed;
+ object siSthread_top_level;
+ 
++void (*override_redirect_fun)() = NULL;
++pd *override_redirect_process = NULL;
++
+ static object main_thread;
+ 
+ static
+ setTimer(long time)
+ {
+-  struct itimerval oldtimer;
+-  struct itimerval itimer;
++  static struct itimerval oldtimer;
++  static struct itimerval itimer;
++
+   itimer.it_value.tv_sec = 0;
+   itimer.it_value.tv_usec = time;
+   itimer.it_interval.tv_sec = 0;
+@@ -66,32 +106,25 @@
+ }
+ 
+ pd *
+-dequeue()
+-{
+-  pd *tmp;
+-  tmp = running_head;
+-  if  (running_head != NULL)
+-    running_head = running_head->pd_next;
+-  return tmp;
+-}
+-
+-pd *
+-make_pd()
++make_pd(pd *o)
+ {
+   pd *new_pd; lpd *npd;
+   
+   /* Allocate a new descriptor for the new lwp */
+-  new_pd = (pd *)malloc(sizeof(pd));
++  /* if we already have one, then we have passed it in o... */
++
++  if (o) new_pd = o;
++  else new_pd = (pd *)malloc(sizeof(pd));
+   
+   /* create a new stack ... */
+-  new_pd->pd_base = (int *)malloc(STACK_SIZE * sizeof(int));
+-  new_pd->pd_status = SUSPENDED;
++  if (!o) new_pd->pd_base = (int *)malloc(STACK_SIZE * sizeof(int));
+ 
+   /* allocate a lisp descriptor:
+    * using the calloc here it's possible to avoid the
+    * critical section in the various push operations
+    */
+-  npd = new_pd->pd_lpd = (lpd *)calloc(sizeof(lpd), 1);
++  if (o) { npd = new_pd->pd_lpd; }
++  else	 npd = new_pd->pd_lpd = (lpd *)calloc(1, sizeof(lpd));
+ 
+   /* initialize it */
+ 
+@@ -117,11 +150,13 @@
+   npd->lwp_frs_top = npd->lwp_frame_stack - 1;
+   npd->lwp_frs_limit = npd->lwp_frame_stack + FRSSIZE;
+   
++  /* constants are fine for a reincarnatee */
+   npd->lwp_alloc_temporary = OBJNULL;
+   npd->lwp_backq_level = 0;
+   npd->lwp_eval1 = 0;
+   /* for gc */
+-  npd->lwp_fmt_temporary_stream = OBJNULL;
++  /* we need to rebuild temporary_stream for some reason */
++  if (!o) npd->lwp_fmt_temporary_stream = OBJNULL;
+   npd->lwp_fmt_temporary_string = OBJNULL;
+   
+   npd->lwp_PRINTstream = Cnil;
+@@ -153,7 +188,7 @@
+   npd->lwp_string_register = OBJNULL;
+   npd->lwp_gensym_prefix = OBJNULL;
+   npd->lwp_gentemp_prefix = OBJNULL;
+-  npd->lwp_token = OBJNULL;
++  if (!o) npd->lwp_token = OBJNULL;
+     
+   /* lex_env copy */
+   npd->lwp_lex[0] = lex_env[0];
+@@ -168,70 +203,30 @@
+   /* Now the allocation. If the gc is invoked we are able to mark
+    * the objects already allocated
+    */
+-  npd->lwp_fmt_temporary_stream = make_string_output_stream(64);
+-  npd->lwp_fmt_temporary_string =
+-    npd->lwp_fmt_temporary_stream->sm.sm_object0;
+-  
+-  npd->lwp_string_register = alloc_simple_string(0);
+-  npd->lwp_gensym_prefix = make_simple_string("G");
+-  npd->lwp_gentemp_prefix = make_simple_string("T");
+-  npd->lwp_token = alloc_simple_string(LISP_PAGESIZE);
+-  npd->lwp_token->st.st_self = alloc_contblock(LISP_PAGESIZE);
++
++  /* Hmm, this gets more complex with a reincarnatee */
++  /* ideally we just want to initialize these destructively */
++  /* and hope that this is good enough. */
++  /* The main problem is that if other things have been passed these */
++  /* and don't expect them to suddenly change, but I'm not sure that this */
++  /* can be the case, since these should be local to a thread... */
++
++  if (!o) npd->lwp_fmt_temporary_stream = make_string_output_stream(64);
++  /* might need some resetting here? */
++  npd->lwp_fmt_temporary_string = npd->lwp_fmt_temporary_stream->sm.sm_object0;
++  
++  if (!o) npd->lwp_string_register = alloc_simple_string(0);
++  if (!o) npd->lwp_gensym_prefix = make_simple_string("G");
++  if (!o) npd->lwp_gentemp_prefix = make_simple_string("T");
++  if (!o) npd->lwp_token = alloc_simple_string(LISP_PAGESIZE);
++  if (!o) npd->lwp_token->st.st_self = alloc_contblock(LISP_PAGESIZE);
+   npd->lwp_token->st.st_fillp = 0;
+   npd->lwp_token->st.st_hasfillp = TRUE;
+   npd->lwp_token->st.st_adjustable = TRUE;
+-  
+-  return new_pd;
+-}
+-
+-update_queue()
+-{
+-  register pd *dead_pd;
+-  pd *last = running_tail;
+-
+-  do
+-    switch (running_head->pd_status) {
+-
+-    case DEAD:
+-
+-      /* remove the dead process */
+-      dead_pd = dequeue();
+-      /* free the lisp descriptor */
+-      free(dead_pd->pd_lpd);
+-      /* free the memory allocated for the stack and the descriptor */
+-      free(dead_pd->pd_base);
+-      free(dead_pd);
+-      break;
+-
+-/*    case SUSPENDED: */
+-    case DELAYED:
+-
+-      if (running_head->pd_slice != 0) 
+-	if (absolute_time > running_head->pd_slice) {
+-
+-	  /* the time slice has expired */
+-	  running_head->pd_slice = 0;
+ 
+-	  if ((running_head->pd_thread->th.th_cont) != OBJNULL) {
+-	    /* in this case a continuation was created before %delay */
+-	    running_head->pd_thread->th.th_cont->cn.cn_timed_out = TRUE;
+-	    running_head->pd_thread->th.th_cont = OBJNULL;
+-	  }
+-	  running_head->pd_status = RUNNING;
+-	  return;		/* now you are a running process */
+-	}
+-      ROTQUEUE();
+-      break;
+-	  
+-    case WAITING:		/* waiting processes need to be scheduled  */
+-    case RUNNING:
+-      return;			/* found schedulable process */
+-	
+-    default:			/* currently is only STOPPED */
+-      ROTQUEUE();
+-      break;
+-    }
+-  while (running_head != last);
++  new_pd->pd_status = SUSPENDED;
++  ENQUEUE(new_pd, suspended_queue);	/* needs to be on a queue */
++  return new_pd;
+ }
+ 
+ activate_thread(object thread)
+@@ -275,33 +270,111 @@
+   sigsetmask(sigblock(0) & ~(sigmask(SIGALRM)));
+ #endif
+ 
++/* to get here we've been scheduled */
++/* so we aren't in someone else's bind stack */
++/* so we should get the defaults for the stdio */
++
++start_critical_section();
++
++for(;;) {	/* mortal coil */
++  /* set up local stdio bindings below everything else on the bind stack */
++  /* so that they shouldn't be take out of scope ever... */
++
++  bind_var(Vstandard_input, SYM_VAL(Vstandard_input), Cnil);
++  bind_var(Vstandard_output, SYM_VAL(Vstandard_output), Cnil);
++  bind_var(Verror_output, SYM_VAL(Verror_output), Cnil);
++  bind_var(Vquery_io, SYM_VAL(Vquery_io), Cnil);
++  bind_var(Vdebug_io, SYM_VAL(Vdebug_io), Cnil);
++  bind_var(Vterminal_io, SYM_VAL(Vterminal_io), Cnil);
++  bind_var(Vtrace_output, SYM_VAL(Vtrace_output), Cnil);
++
+   { int i;
+-    for (i = clwp->lwp_nValues; i > 0;)
++      for (i = clwp->lwp_nValues; i > 0;)
+       VALUES(i) = VALUES(--i);
+     VALUES(0) = clwp->lwp_thread->th.th_fun;
++    end_critical_section();
+     apply(clwp->lwp_nValues+1, siSthread_top_level, &VALUES(0));
++    start_critical_section();
+   }
+   /* Termination */
+-  
+-  terpri(Cnil);
+-  running_head->pd_status = DEAD;
+-  running_head->pd_thread->th.th_self = NULL;
++
++  {
++  pd *tmp = active;
++
++  tmp->pd_status = DEAD;
+   running_processes--;
++  awake_processes--;
++  DEQUEUE(tmp, running_queue);
++  ENQUEUE(tmp, dead_queue);
++  }
+ 
+-  update_queue();
+-  thread_next();		/* update_queue has freed our stack!!! */
++  end_critical_section();
++  thread_switch();	/* stack won't have been free'd yet... that's a */
++			/* job for housekeeping to think about. */
++			/* otherwise dead threads live in limbo waiting */
++			/* for reincarnation */
++  /* incase we are raised from the dead, we want to do it again */
++  start_critical_section();
++  }
+ }
+ 
+ /*
+- * switch to the first thread on queue
++ * switch to the next thread on queue
+  */
+ thread_next()
+ {
++  /* rotate the running-queue */
++
++  /* should devolve into an if, but *shrug* better to guarantee */
++  start_critical_section();
++
++  if (override_redirect_process == active) {
++	void (*fun)();
++
++	force_resumption(active);
++
++  	if (running_processes > 1) {
++    		timer_active = TRUE;
++    		setTimer(REALQUANTUM); 
++  	} else {
++    		timer_active = FALSE;
++    		absolute_time = 0;
++  		}
++	fun = override_redirect_fun;
++
++	override_redirect_fun = NULL;
++	override_redirect_process = NULL;
++
++	end_critical_section();
++	(*fun)();
++	start_critical_section();
++	}
++
+   /* unwind the bind stack */
+   lwp_bds_unwind(clwp->lwp_bind_stack, clwp->lwp_bds_top);
+ 
++  ROTQUEUE(running_queue);
++
++  end_critical_section();
++  /* housekeeping isn't actually critical */
++  /* and turns off the timer while its in there */
++  if (absolute_time > housekeeping_time)
++	housekeeping();
++
++  /* we need this incase a signal blew us out of the previous housekeeping */
++  /* and running_queue is void */
++
++  while(running_queue == NULL) {
++  	static struct timeb tb;
++  	ftime(&tb);		/* not sure how portable */
++  	absolute_time = tb.millitm + tb.time*1000;
++	housekeeping();
++	}
++  start_critical_section();
++
+   /* switch clwp */
+-  clwp = running_head->pd_lpd;
++  clwp = running_queue->pd_lpd;
++  active = running_queue;
+ 
+   /* restore Values pointer */
+   Values = clwp->lwp_Values;
+@@ -313,19 +386,253 @@
+   if (running_processes > 1) {
+     timer_active = TRUE;
+     setTimer(REALQUANTUM); 
+-  } else { 
++  } else {
+     timer_active = FALSE;
+     absolute_time = 0;
+   }
+-  siglongjmp(running_head->pd_env, 1); 
++
++  end_critical_section();
++  siglongjmp(active->pd_env, 1); 
+ }
+ 
+ /*
+  * Called when time slice expires or explicitily to switch thread
++ * New version...
+  */
+ scheduler(int sig, int code, struct sigcontext *scp)
+ {
+   int val;
++  static struct timeb tb;
++
++#if defined(SYSV) || defined(__svr4__) || defined(__linux)
++  signal(SIGALRM, scheduler);
++#endif SYSV
++
++  ftime(&tb);			/* not sure how portable */
++  absolute_time = tb.millitm + tb.time*1000;
++
++  if (critical_level > 0) {	/* within critical section */
++    scheduler_interrupted = TRUE;
++    scheduler_interruption = SCHEDULER_INT;
++    return;
++  }
++  if (scheduler_level > 0) {	/* abilitation  check */
++    scheduler_interrupted = TRUE;
++    return;
++  }
++
++  val = sigsetjmp(active->pd_env, 1);
++
++  if (val == 1)			/* resume interrupted thread execution */
++    return;			/* coming back from longjmp in thread_next */
++
++  if (val == 2)			/* coming back from longjmp in GC */
++    gc(garbage_parameter);	/* GC will return to the previous thread */
++
++  thread_next();
++}
++
++/* TODO: Add in waiting thread condition resolution */
++housekeeping()
++{
++	static struct timeval timeout;
++	static pd *p, *q;
++	static int tide;
++	static fd_set rd, wr, ex;
++	/* see if we are polling or lurking */
++
++	/* turn off that bloody timer... */
++	setTimer(0);
++
++	if ((running_processes > 1) && (awake_processes > 0)) {
++		/* poll */
++		/* set timeout to instant */
++		timeout.tv_sec = timeout.tv_usec = 0;
++		tide = 1;
++	} else {
++		/* is recovery possible? */
++
++		if (	(running_queue == NULL) &&
++			(blocking_queue == NULL) &&
++			(delayed_queue == NULL)) {
++			/* in a coma... can't awaken itself... */
++			/* there is a possibility that a signal */
++			/* will, but um, for now assume dead and buried */
++			exit(0);	/* bail w/out error */
++			}
++
++		/* ok, in theory we can wake up.... so lurk */
++		/* set timeout to the shortest sleep resumption time */
++		/* if there isn't a sleep resumption time */
++		/* block forever... */
++
++		if (wake_lowtide != -1) {
++			if (absolute_time >= wake_lowtide) {
++				timeout.tv_sec = timeout.tv_usec = 0;
++				tide = 1;
++			} else {
++				timeout.tv_sec = (wake_lowtide-absolute_time)/1000;
++				timeout.tv_usec = ((wake_lowtide-absolute_time)%1000)*1000;
++				tide = 1;
++				}
++		} else 	tide = 0;
++		}
++
++	memcpy(&rd, &fd_rd, sizeof(fd_set));
++	memcpy(&wr, &fd_wr, sizeof(fd_set));
++	memcpy(&ex, &fd_ex, sizeof(fd_set));
++
++	/* If there is an error, the sets are undefined, just bail out... */
++	/* we'll catch it next time, it was probably a signal interrupting */
++	/* us. */
++	if (select(fd_hightide, &rd, &wr, &ex, (tide ? &timeout : NULL)) == -1) {
++		/* we broke for some reason */
++		/* a signal handler may have been invoked... */
++		/* someone may have been woken up */
++		/* so schedule another housekeeping apointment */
++		/* and bail */
++		goto out;
++		}
++	
++	/* check for awakened threads */
++
++	if (p = blocking_queue)
++		do {
++			q = p->pd_next;
++			switch(p->pd_fp_mode) {
++				case PD_INPUT:
++					if (FD_ISSET(fileno(p->pd_fp), &rd)) {
++						FD_CLR(fileno(p->pd_fp), &fd_rd);
++						DEQUEUE(p, blocking_queue);
++						ENQUEUE(p, running_queue);
++						p->pd_status = RUNNING;
++						awake_processes++;
++						if (blocking_queue == NULL) goto endblk;
++						}
++					break;
++				case PD_OUTPUT:
++					if (FD_ISSET(fileno(p->pd_fp), &wr)) {
++						FD_CLR(fileno(p->pd_fp), &fd_wr);
++						DEQUEUE(p, blocking_queue);
++						ENQUEUE(p, running_queue);
++						p->pd_status = RUNNING;
++						awake_processes++;
++						if (blocking_queue == NULL) goto endblk;
++						}
++					break;
++				case PD_EXCEPTION:
++					if (FD_ISSET(fileno(p->pd_fp), &ex)) {
++						FD_CLR(fileno(p->pd_fp), &fd_ex);
++						DEQUEUE(p, blocking_queue);
++						ENQUEUE(p, running_queue);
++						p->pd_status = RUNNING;
++						awake_processes++;
++						if (blocking_queue == NULL) goto endblk;
++						}
++					break;
++				}
++			p = q;
++		} while(p != blocking_queue);
++
++	/* if sleeping, check for wakeup.... */
++
++endblk:	tide = -1;
++
++	/*putchar('.'); fflush(stdout);*/
++
++	if ((wake_lowtide != -1) && ((p = delayed_queue) != NULL))
++		do {
++			q = p->pd_next;
++			if (absolute_time >= p->pd_slice) {
++				DEQUEUE(p, delayed_queue);
++				ENQUEUE(p, running_queue);
++				p->pd_status = RUNNING;
++				awake_processes++;
++				if (delayed_queue == NULL) break;
++			} else {
++				/* get new low-tide */
++				if ((tide == -1) || (p->pd_slice < tide))
++					tide = p->pd_slice;
++				}
++
++			p = q;
++		} while(p != delayed_queue);
++
++	wake_lowtide = tide;
++
++  /* requeue waiting threads for resolution checking */
++  /* not a good solution, but the only one that I can see */
++  /* at least now we will only check them on housekeeping intervals */
++  /* just get the timeout cases to set the wake_lowtide on entry */
++  /* to prevent oversleeping. */
++
++  while(p = waiting_queue) {
++	DEQUEUE(p, waiting_queue);
++	ENQUEUE(p, running_queue);
++  	p->pd_status = RUNNING;
++	awake_processes++;
++	}
++
++out:	housekeeping_time = absolute_time + 1000;	/* one second */
++}
++
++/* this will mostly be used in conjunction with override_redirect */
++/* which should be set before entry here. */
++
++force_resumption(pd *p)
++{
++	start_critical_section();
++
++	switch(p->pd_status) {
++		case RUNNING: DEQUEUE(p, running_queue);
++				break;
++		case STOPPED: DEQUEUE(p, stopped_queue);
++				running_processes++;
++				awake_processes++;
++				break;
++		case SUSPENDED: DEQUEUE(p, stopped_queue);
++				running_processes++;
++				awake_processes++;
++				break;
++		case DEAD: /* hmmm... raising the dead might be dangerous */
++				running_processes++;
++				awake_processes++;
++				DEQUEUE(p, dead_queue);
++				break;
++		case WAITING:	DEQUEUE(p, waiting_queue);
++				awake_processes++;
++				break;
++		case DELAYED:	DEQUEUE(p, delayed_queue);
++				awake_processes++;
++				break;
++			/* don't worry about the magic, at worst this can */
++				running_processes++;
++			/* cause housekeeping to make a false check */
++		case BLOCKED:	DEQUEUE(p, blocking_queue);
++				/* this needs some fixing */
++				switch(p->pd_fp_mode) {
++					case PD_INPUT:
++						FD_CLR(fileno(p->pd_fp), &fd_rd);
++						break;
++					case PD_OUTPUT:
++						FD_CLR(fileno(p->pd_fp), &fd_wr);
++						break;
++					case PD_EXCEPTION:
++						FD_CLR(fileno(p->pd_fp), &fd_ex);
++						break;
++					}
++				awake_processes++;
++				break;
++		}
++
++	ENQUEUE(p, running_queue);
++	end_critical_section();
++}
++
++#ifdef 0
++scheduler(int sig, int code, struct sigcontext *scp)
++{
++  int val;
+ 
+ #if defined(SYSV) || defined(__svr4__) || defined(__linux)
+   signal(SIGALRM, scheduler);
+@@ -342,7 +649,7 @@
+     return;
+   }
+ 
+-  val = sigsetjmp(running_head->pd_env, 1);
++  val = sigsetjmp(running_dead->pd_env, 1);
+ 
+   if (val == 1)			/* resume interrupted thread execution */
+     return;			/* coming back from longjmp in thread_next */
+@@ -353,6 +660,7 @@
+   ROTQUEUE();
+   thread_next();
+ }
++#endif /* old version */
+ 
+ /*
+  * Handle signal received within critical section
+@@ -400,18 +708,34 @@
+   register pd *p;
+ 
+   start_critical_section();
+-  running_processes++;
++
++  if (rpd->pd_status == STOPPED) {
++  	DEQUEUE(rpd, stopped_queue);
++  	running_processes++;
++  	awake_processes++;
++  } else if (rpd->pd_status == DELAYED) {
++  	DEQUEUE(rpd, delayed_queue);
++	/* TODO: look for interaction with housekeeping problem for this case... */
++  	awake_processes++;
++  } else if (rpd->pd_status == SUSPENDED) {
++  	DEQUEUE(rpd, suspended_queue);
++  	running_processes++;
++  	awake_processes++;
++	}
++
++  /* else, should we be here? no. hmmm. */
++  /* where are the fucking arguments? */
+ 
+   rpd->pd_status = RUNNING;
+-  for (p = running_head; (p != rpd) && (p != NULL); p = p->pd_next) ;
+-  if (p == NULL)
+-    ENQUEUE(rpd);
++
++  ENQUEUE(rpd, running_queue);
++
+   end_critical_section();
+ 
+   if (!timer_active)  {
+     timer_active = TRUE;
+     setTimer(REALQUANTUM);
+-  }
++    }
+ }
+ 
+ /***********
+@@ -428,6 +752,11 @@
+   RETURN(1);
+ }
+ 
++/* Hmmmmm, what the hell is this supposed to do? */
++/* and why bother? */
++/* Put this in the TODO basket, as something of dubiousness */
++
++#ifdef 0
+ siLthread_break_quit(int narg)
+ {
+   /* reset everything in MT */
+@@ -443,17 +772,21 @@
+       critical_level = 0;
+       scheduler_interrupted = 0;
+ 
+-      for (p = running_head; (p != NULL); p = p->pd_next)
+-	if (p != &main_pd)
++      /*for (p = running_dead; (p != NULL); p = p->pd_next)*/
++      p = running_queue;
++      do {
++	if (p != &main_pd) {
+ 	  p->pd_status = DEAD;
+-	else {
++	} else {
+ 	  p->pd_status = RUNNING;
+ 	  p->pd_thread->th.th_cont = OBJNULL;
+-	}
++	  }
++	p = p->pd_next;
++      } while(running_queue->pd_next != running_queue);
+ 
+-      if (running_head != &main_pd) {
++      if (running_queue != &main_pd) {
+ 	update_queue();
+-	thread_next(); 
++	thread_dext(); 
+ 	/*  here one should deallocate the main-thread function     */
+       }
+       else
+@@ -462,6 +795,7 @@
+   VALUES(0) = Cnil;
+   RETURN(1);
+ }
++#endif
+ 
+ siLthread_break_resume(int narg)
+ {
+@@ -478,16 +812,70 @@
+ Lthread_list(int narg)
+ {
+   pd *p;
+-  object tmp, x = CONS(running_head->pd_thread, Cnil);
++  object tmp;
++  object tmp2 = CONS(running_queue->pd_thread, Srunning);
++  object x = CONS(tmp2, Cnil);
+ 
+   tmp = x;
+ 
+   start_critical_section();
+ 
+-  for (p = running_head->pd_next; (p != NULL); p = p->pd_next) {
+-      CDR(tmp) = CONS(p->pd_thread, Cnil);
+-      tmp = CDR(tmp);
+-    }
++  p = running_queue->pd_next;
++  while(p != running_queue) {
++	tmp2 = CONS(p->pd_thread, Srunning);
++	CDR(tmp) = CONS(tmp2, Cnil);
++	tmp = CDR(tmp);
++	p = p->pd_next;
++	}
++
++  if (p = blocking_queue)
++  	do {
++		tmp2 = CONS(p->pd_thread, Sblocking);
++		CDR(tmp) = CONS(tmp2, Cnil);
++		p = p->pd_next;
++		tmp = CDR(tmp);
++  	} while(p != blocking_queue);
++
++  if (p = delayed_queue)
++  	do {
++		tmp2 = CONS(p->pd_thread, Sdelayed);
++		CDR(tmp) = CONS(tmp2, Cnil);
++		p = p->pd_next;
++		tmp = CDR(tmp);
++  	} while(p != delayed_queue);
++
++	/* TODO: Should this queue be listed? */
++  if (p = dead_queue)
++  	do {
++		tmp2 = CONS(p->pd_thread, Sdead);
++		CDR(tmp) = CONS(tmp2, Cnil);
++		p = p->pd_next;
++		tmp = CDR(tmp);
++  	} while(p != dead_queue);
++
++  if (p = stopped_queue)
++  	do {
++		tmp2 = CONS(p->pd_thread, Sstopped);
++		CDR(tmp) = CONS(tmp2, Cnil);
++		p = p->pd_next;
++		tmp = CDR(tmp);
++  	} while(p != stopped_queue);
++	
++  if (p = suspended_queue)
++  	do {
++		tmp2 = CONS(p->pd_thread, Ssuspended);
++		CDR(tmp) = CONS(tmp2, Cnil);
++		p = p->pd_next;
++		tmp = CDR(tmp);
++  	} while(p != suspended_queue);
++
++  if (p = waiting_queue)
++  	do {
++		tmp2 = CONS(p->pd_thread, Swaiting);
++		CDR(tmp) = CONS(tmp2, Cnil);
++		p = p->pd_next;
++		tmp = CDR(tmp);
++  	} while(p != waiting_queue);
+ 
+   end_critical_section();
+ 
+@@ -511,20 +899,41 @@
+     /*  fun = SYM_FUN(fun); confusing */
+   }
+ 
+-  x = alloc_object(t_thread);
+-  x->th.th_fun = fun;
+-  x->th.th_size = sizeof(pd);
+-  x->th.th_self = npd = make_pd();
+-  x->th.th_cont = OBJNULL;
++start_critical_section();
++  /* see if there is a lost soul waiting for reincarnation */
++  if (dead_queue) {
++	/* ok, lets juice it up */
++
++	npd = dead_queue;
++	DEQUEUE(npd, dead_queue);
++
++  	x = npd->pd_lpd->lwp_thread;
++	/* enqueued in make_pd */
++
++	x->th.th_fun = fun;
++	x->th.th_size = sizeof(pd);
++	x->th.th_self = make_pd(npd);	/* reinitialize it */
++	x->th.th_cont = OBJNULL;
++  } else {
++	/* ok, no lost souls, better build a new one */
++  	x = alloc_object(t_thread);
++  	x->th.th_fun = fun;
++  	x->th.th_size = sizeof(pd);
++  	x->th.th_self = npd = make_pd(0);
++  	x->th.th_cont = OBJNULL;
+ 
+-  npd->pd_thread = x;
+-  npd->pd_slice = 0;
++  	npd->pd_thread = x;
++  	npd->pd_slice = 0;
+ 
+-  /* Backpointer to thread */
+-  npd->pd_lpd->lwp_thread = x;
++  	/* Backpointer to thread */
++  	npd->pd_lpd->lwp_thread = x;
+ 
+   activate_thread(x);
++  }
++
++  /* note: this is created as a suspended thread, and in that queue */
+ 
++end_critical_section();
+   VALUES(0) = x;
+   RETURN(1);
+ }
+@@ -542,12 +951,17 @@
+   start_critical_section();	/* tito */
+   thread->th.th_self->pd_status = STOPPED;
+   running_processes--;
+-  if (thread->th.th_self == running_head) {
+-    critical_level--; /* end_critical_section() */
+-    update_queue();
+-    thread_next();
+-  } else
+-    end_critical_section();
++  awake_processes--;
++  if (thread->th.th_self == active) {
++  	DEQUEUE(thread->th.th_self, running_queue);
++  	ENQUEUE(thread->th.th_self, stopped_queue);
++    	critical_level--; /* end_critical_section() */
++    	thread_switch();
++  } else {
++  	DEQUEUE(thread->th.th_self, running_queue);
++  	ENQUEUE(thread->th.th_self, stopped_queue);
++    	end_critical_section();
++	}
+   VALUES(0) = Cnil;
+   RETURN(1);
+ }
+@@ -568,6 +982,7 @@
+   start_critical_section();	/* tito */
+   thread->th.th_self->pd_status = RUNNING;
+   running_processes++;
++  awake_processes++;
+ 
+   if (!timer_active) {
+      timer_active = TRUE;
+@@ -582,11 +997,8 @@
+ 
+ Lkill_thread(int narg, object thread)
+ {
++  pd *tmp;
+ 
+-  /* The following code is not enough.
+-     Consider: The scheduler can be disabled
+-     What about killing the current thread?
+-     */
+   check_arg(1);
+ 
+   if (type_of(thread) != t_thread)
+@@ -597,13 +1009,17 @@
+     thread->th.th_self->pd_status = DEAD;
+     if (thread->th.th_self->pd_lpd == clwp) {
+        /* if a thread kills itself the scheduler is to be called */
+-       thread->th.th_self = NULL;
++       tmp = thread->th.th_self;
++       DEQUEUE(tmp, running_queue);
++       ENQUEUE(tmp, dead_queue);
+        critical_level--; /*  end_critical_section() */
+-       update_queue();
+-       thread_next();
++       thread_switch();
+      }
+      else {
+-       thread->th.th_self = NULL;
++       /*thread->th.th_self = NULL;*/
++       tmp = thread->th.th_self;
++       DEQUEUE(tmp, running_queue);
++       ENQUEUE(tmp, dead_queue);
+        end_critical_section();
+      }
+   }
+@@ -642,6 +1058,11 @@
+     case DEAD:
+       VALUES(0) = Sdead;
+       break;
++    case BLOCKED:
++      VALUES(0) = Sblocking;
++      break;
++    case DELAYED:
++      VALUES(0) = Sdelayed;
+     default:
+       FEerror("Unexpected type for thread ~A", 1, thread);
+     }
+@@ -663,6 +1084,7 @@
+   object x;
+   check_arg(1);
+ 
++
+   if (type_of(thread) != t_thread)
+     FEwrong_type_argument(Sthread, thread);
+ 
+@@ -797,91 +1219,206 @@
+   check_arg(0);
+ 
+   if (timer_active) {
+-       running_head->pd_status = SUSPENDED;
++       pd *tmp = active;
++       tmp->pd_status = SUSPENDED;
++       DEQUEUE(tmp, running_queue);
++       ENQUEUE(tmp, suspended_queue);
+        running_processes--;
++       awake_processes--;
+        thread_switch();
+        /* When resumed it will be provided with the Values to return */
+-       RETURN(running_head->pd_lpd->lwp_nValues);
++       RETURN(tmp->pd_lpd->lwp_nValues);
+      }
+   else 
+     FEerror("No other active thread.", 0);
+ }
+ 
++void lwpblockon(pd *who, FILE *fp, int mode)
++{
++	who->pd_fp = fp;
++	who->pd_fp_mode = mode;	/* in, out, execept */
++	who->pd_status = BLOCKED;
++
++	start_critical_section();
++
++	DEQUEUE(who, running_queue);
++	ENQUEUE(who, blocking_queue);
++	awake_processes--;
++
++	if (fd_hightide <= fileno(fp))
++		fd_hightide = fileno(fp)+1;
++
++	switch(mode) {
++		case PD_INPUT:
++			FD_SET(fileno(fp), &fd_rd);
++			break;
++		case PD_OUTPUT:
++			FD_SET(fileno(fp), &fd_wr);
++			break;
++		case PD_EXCEPTION:
++			FD_SET(fileno(fp), &fd_ex);
++			break;
++		}
++
++	end_critical_section();
++
++	thread_switch();
++}
++
++int inline lwpgetc(FILE *fp)
++{
++	int c;
++
++loop:	errno = 0;
++	c = getc(fp);
++	if (errno) {
++		lwpblockon(active, fp, PD_INPUT);
++		clearerr(fp);
++		goto loop;
++		}
++	return(c);
++}
++
++void inline lwpputc(char c, FILE *fp)
++{
++loop:	errno = 0;
++	putc(c, fp);
++	if (errno) {
++		lwpblockon(active, fp, PD_OUTPUT);
++		clearerr(fp);
++		goto loop;
++		}
++	return;
++}
++
++int inline lwpread(char *buf, int len, FILE *fp)
++{
++	int ind = 0, left = len, n;
++
++loop:	errno = 0;
++	n = read(&buf[ind], left, fileno(fp));
++	if (errno) {
++		ind += n;
++		left -= n;
++		lwpblockon(active, fp, PD_INPUT);
++		clearerr(fp);
++		goto loop;
++		}
++	return(ind+n);
++}
++
++int inline lwpwrite(char *buf, int len, FILE *fp)
++{
++	int ind = 0, left = len, n;
++
++loop:	errno = 0;
++	n = write(&buf[ind], left, fileno(fp));
++	if (errno) {
++		ind += n;
++		left -= n;
++		lwpblockon(active, fp, PD_OUTPUT);
++		clearerr(fp);
++		goto loop;
++		}
++	return(ind+n);
++}
++
+ Ldelay(int narg, object interval)
+ { int z;
+   
+   check_arg(1);
+   check_type_non_negative_integer(&interval);
+   z = fix(interval);
++
++  if (timer_active) {
++    pd *tmp = active;	/* remember who we are */
++    lwpsleep(z*1000);	/* lwpsleep is in milliseconds */
++    /* When resumed it will be provided with the Values to return */
++    RETURN(tmp->pd_lpd->lwp_nValues);
++  }
++  else
++  {
++    sleep(z);
++  }
++}
++
++/* Sleep for at least ms milliseconds */
++lwpsleep(int ms)
++{
+   
+   if (timer_active) {
+-    running_head->pd_status = DELAYED;
+-    running_processes--;
++    pd *tmp = active;
++
++    start_critical_section();
++    tmp->pd_status = DELAYED;
++    DEQUEUE(tmp, running_queue);
++    ENQUEUE(tmp, delayed_queue);
++    awake_processes--;
+        
+-    /* Translate seconds in number of scheduler slices    */
+-    running_head->pd_slice = z * 10 + absolute_time;
++    tmp->pd_slice = ms + absolute_time;
++
++    if ((wake_lowtide == -1) || (wake_lowtide > tmp->pd_slice))
++	wake_lowtide = tmp->pd_slice;
++
++    end_critical_section();
+ 
+     thread_switch();
+-       
+-    /* When resumed it will be provided with the Values to return */
+-    RETURN(running_head->pd_lpd->lwp_nValues);
+   }
+-  else
+-    sleep(z);
++  else usleep(ms*1000);	/* milli->micro */
+ }
+ 
++/* TODO: Find a way to move this functionality into housekeeping()
++   sigh */
++
+ Lthread_wait(int narg, object fun, ...)
+ { int nr;
++  pd *tmp = active;
+   va_list args;
+   va_start(args, fun);
+-
++  
+   if (narg < 1) FEtoo_few_arguments(&narg);
+ 
+-  start_critical_section();
+-  running_head->pd_status = WAITING;
+-  running_processes--;
+-  end_critical_section();
+-
+   for (;;) {
+     
+     nr = apply(narg-1, fun, args);
+     
+     if (VALUES(0) != Cnil)
+       break;
+-    else if (timer_active) {
+-      /* the time slice has not been used */
+-      absolute_time--;
+-      thread_switch();
+-    } else
+-      FEerror("The condition will never be satisfied for lack of active processes", 0);
++
++    start_critical_section();
++    tmp->pd_status = WAITING;
++
++    DEQUEUE(tmp, running_queue);
++    ENQUEUE(tmp, waiting_queue);
++
++    awake_processes--;
++
++    end_critical_section();
++    thread_switch();
+   }
+-  running_head->pd_status = RUNNING;
+-  running_processes++;
+-  end_critical_section();
++
+   RETURN(nr);
+ }
+   
+-      
++/* TODO: whack this into housekeeping() */
++
+ Lthread_wait_with_timeout(int narg, object timeout, object fun, ...)
+ {
+   int nr;
++  pd *tmp = active;
+   va_list args;
+   va_start(args, fun);
+ 
+   if (narg < 2) FEtoo_few_arguments(&narg);
+   check_type_non_negative_integer(&timeout);
+ 
+-  /* We have to translate seconds in scheduler call number */
+-  start_critical_section();
+-  running_head->pd_slice = fix(timeout) * 10 + absolute_time;
++  /* We have to translate seconds into milliseconds into the future */
++  tmp->pd_slice = fix(timeout) * 1000 + absolute_time;
+   
+-  running_head->pd_status = WAITING;
+-  running_processes--;
+-  end_critical_section();
+   
+   for (;;) {
+     
+-    if (absolute_time > running_head->pd_slice) {
++    if (absolute_time > tmp->pd_slice) {
+       /* the time slice has expired */
+       VALUES(0) = Cnil;
+       nr = 1;
+@@ -897,13 +1434,19 @@
+       absolute_time--;
+       thread_switch();
+     }
+-  }
++
++    tmp->pd_status = WAITING;
++    DEQUEUE(tmp, running_queue);
++    ENQUEUE(tmp, waiting_queue);
++    awake_processes--;
++
++    if ((wake_lowtide == -1) || (wake_lowtide > tmp->pd_slice))
++	wake_lowtide = tmp->pd_slice;
++
++    thread_switch();
++    }
+   
+-  start_critical_section();
+-  running_head->pd_slice = 0;
+-  running_head->pd_status = RUNNING;
+-  running_processes++;
+-  end_critical_section();
++  tmp->pd_slice = 0;
+   RETURN(nr);
+ }
+ 
+@@ -912,11 +1455,25 @@
+   signal(SIGALRM, scheduler);
+ }
+ 
++/* called when we start after a dump */
++linit_lwp()
++{
++	FD_ZERO(&fd_rd);
++	FD_ZERO(&fd_wr);
++	FD_ZERO(&fd_ex);
++}
++
+ init_lwp()
+ { pd *temp_pd;
+ 
+   temp_pd = &main_pd;
+-  PUSH(temp_pd);
++  /*PUSH(temp_pd);*/
++
++  FD_ZERO(&fd_rd);
++  FD_ZERO(&fd_wr);
++  FD_ZERO(&fd_ex);
++
++  ENQUEUE(temp_pd, running_queue);
+ 
+   main_thread = alloc_object(t_thread);
+   main_pd.pd_thread = main_thread;
+@@ -935,10 +1492,12 @@
+   Swaiting = make_ordinary("WAITING");
+   Sstopped = make_ordinary("STOPPED");
+   Sdead = make_ordinary("DEAD");
++  Sblocking = make_ordinary("BLOCKING");
++  Sdelayed = make_ordinary("DELAYED");
+   siSthread_top_level = make_si_ordinary("THREAD-TOP-LEVEL");
+ 
+   make_si_function("THREAD-BREAK-IN", siLthread_break_in);
+-  make_si_function("THREAD-BREAK-QUIT", siLthread_break_quit);
++/*  make_si_function("THREAD-BREAK-QUIT", siLthread_break_quit); */
+   make_si_function("THREAD-BREAK-RESUME", siLthread_break_resume);
+ 
+   make_function("MAKE-THREAD", Lmake_thread);
+Only in zsrc/c: lwp.my
+Only in zsrc/c: lwp.orig
+diff --recursive --unified=3 src/c/main.c zsrc/c/main.c
+--- src/c/main.c	Mon Apr 15 20:54:12 1996
++++ zsrc/c/main.c	Mon Jul 22 18:14:02 1996
+@@ -170,6 +170,11 @@
+ 	setbuf(stdin,  stdin_buf);
+ 	setbuf(stdout, stdout_buf);
+ 
++#ifdef THREADS
++	fcntl(fileno(stdin),  F_SETFL, O_NONBLOCK);
++	fcntl(fileno(stdout), F_SETFL, O_NONBLOCK);
++#endif
++
+ 	ARGC = argc;
+ 	ARGV = argv;
+ 	ecl_self = argv[0];
+@@ -185,6 +190,7 @@
+ 	gc_time = 0;
+ 
+ #ifdef THREADS
++	clwp = &main_lpd;
+ 	Values = main_lpd.lwp_Values;
+ #endif
+ 	frs_top = frs_org-1;
+@@ -226,6 +232,7 @@
+ 		enable_interrupt();
+ 		siLcatch_bad_signals(0);
+ #ifdef THREADS
++		linit_lwp();
+ 		enable_lwp();
+ #endif THREADS
+ 		SYM_VAL(siVlisp_maxpages) = MAKE_FIXNUM(real_maxpage);
+Only in zsrc/c: main.my
+diff --recursive --unified=3 src/c/print.d zsrc/c/print.d
+--- src/c/print.d	Fri Jul  5 02:41:09 1996
++++ zsrc/c/print.d	Wed Jul 17 16:38:16 1996
+@@ -2258,7 +2258,10 @@
+ 	    write_ch_fun = interactive_writec_stream;
+ 	  else
+ #endif CLOS
++	{
++		printf("type_of(strm) == %d, t_stream == %d\n", type_of(strm), t_stream); fflush(stdout);
+ 	    FEerror("~S is not a stream.", 1, strm);
++	}
+ 	write_ch('\n', strm);
+ 	FLUSH_STREAM(strm);
+ 	return(Cnil);
+diff --recursive --unified=3 src/c/read.d zsrc/c/read.d
+--- src/c/read.d	Thu Jun  6 03:50:15 1996
++++ zsrc/c/read.d	Wed Jul 17 02:20:29 1996
+@@ -253,12 +253,30 @@
+ 
+ #if TK
+ extern bool no_input;
++#ifdef THREADS
++# define PUTC(c, fp)	lwpputc(c, fp)
++#else
++# define PUTC(c, fp)	putc(c, fp)
++#endif
+ #define GETC(c, fp)	{ if (fp == stdin) \
+ 			   while (no_input) Tk_DoOneEvent(0); \
++#ifdef THREADS
++			  c = lwpgetc(fp); \
++#else
+ 			  c = getc(fp); \
++#endif /* THREADS */
+ 			  no_input = !FILE_CNT(fp); }
+ #else
++#ifdef THREADS
++# define PUTC(c, fp)	lwpputc(c, fp)
++#else
++# define PUTC(c, fp)	putc(c, fp)
++#endif
++#ifdef THREADS
++#define GETC(c, fp)	c = lwpgetc(fp)
++#else
+ #define GETC(c, fp)	c = getc(fp)
++#endif /* THREADS */
+ #endif /* TK */
+ 
+ /* Beppe: faster code for inner loop from file stream */
+diff --recursive --unified=3 src/c/tcp.c zsrc/c/tcp.c
+--- src/c/tcp.c	Wed May 31 18:36:36 1995
++++ zsrc/c/tcp.c	Wed Jul 17 21:22:12 1996
+@@ -12,6 +12,7 @@
+ */
+ 
+ #include "config.h"
++#include <fcntl.h>
+ 
+ object
+ make_stream(object host, int fd, enum smmode smm)
+@@ -35,6 +36,9 @@
+    stream = alloc_object(t_stream);
+    stream->sm.sm_mode = (short)smm;
+    stream->sm.sm_fp = fp;
++#ifdef THREADS
++   fcntl(fd, F_SETFL, O_NONBLOCK);
++#endif
+    fp->_IO_buf_base = NULL; /* BASEFF */; 
+    stream->sm.sm_object0 = Sstring_char;
+    stream->sm.sm_object1 = host; /* not really used */
+@@ -67,11 +71,11 @@
+      FEerror("~S is a too long file name.", 1, host);
+ 
+ #ifdef THREADS
+-   start_critical_section();
++/*   start_critical_section();	*/
+ #endif THREADS
+    fd = connect_to_server(host->st.st_self, fix(port)); 
+ #ifdef THREADS
+-   end_critical_section();
++/*   end_critical_section();	*/
+ #endif THREADS
+ 
+    if (fd == 0) {
+@@ -94,13 +98,7 @@
+    if (!FIXNUMP(port))
+      FEwrong_type_argument(TSpositive_number, port);
+ 
+-#ifdef THREADS
+-   start_critical_section();
+-#endif THREADS
+    fd = create_server_port(fix(port));
+-#ifdef THREADS
+-   end_critical_section();
+-#endif THREADS
+ 
+    if (fd == 0)
+      VALUES(0) = Cnil;
+@@ -116,4 +114,190 @@
+ {
+   make_si_function("OPEN-CLIENT-STREAM", Lopen_client_stream);
+   make_si_function("OPEN-SERVER-STREAM", Lopen_server_stream);
++}
++
++/*
++
++	Ok, maybe this shouldn't be here, but it really doesn't belong in
++	crs does it? Also moving it here makes life much easier.
++*/
++
++/*  socket.c  -- socket interface					*/
++/*  Maybe this shouldn't be here, but what the hell. */
++/*
++    Copyright (c) 1990, Giuseppe Attardi.
++
++    ECoLisp is free software; you can redistribute it and/or modify it
++    under the terms of the GNU General Library Public License as published
++    by the Free Software Foundation; either version 2 of the License, or
++    (at your option) any later version.
++
++    See file '../Copyright' for full details.
++*/
++
++#include <stdio.h>
++#include <sys/types.h>
++#include <errno.h>
++
++#include <netinet/in.h>
++#include <netdb.h> 
++#include <sys/socket.h>
++#include <string.h>
++
++#include <sys/ioctl.h>
++
++extern int errno;
++
++/***********************************************************************
++ * Client side
++ **********************************************************************/
++
++/* 
++ * Attempts to connect to server, given host and port. Returns file 
++ * descriptor (network socket) or 0 if connection fails.
++ */
++int connect_to_server(char *host, int port)
++{
++  struct sockaddr_in inaddr;	/* INET socket address. */
++  struct sockaddr *addr;	/* address to connect to */
++  struct hostent *host_ptr;
++  int addrlen;			/* length of address */
++  extern char *getenv();
++  extern struct hostent *gethostbyname();
++  int fd;			/* Network socket */
++
++  /* Get the statistics on the specified host. */
++  if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) {
++    if ((host_ptr = gethostbyname(host)) == NULL) {
++      /* No such host! */
++      errno = EINVAL;
++      return(0);
++    }
++    /* Check the address type for an internet host. */
++    if (host_ptr->h_addrtype != AF_INET) {
++      /* Not an Internet host! */
++      errno = EPROTOTYPE;
++      return(0);
++    }
++    /* Set up the socket data. */
++    inaddr.sin_family = host_ptr->h_addrtype;
++    memcpy((char *)&inaddr.sin_addr, (char *)host_ptr->h_addr,
++	   sizeof(inaddr.sin_addr));
++  } 
++  else
++    inaddr.sin_family = AF_INET;
++
++  addr = (struct sockaddr *) &inaddr;
++  addrlen = sizeof (struct sockaddr_in);
++  inaddr.sin_port = port;
++  inaddr.sin_port = htons(inaddr.sin_port);
++  /*
++   * Open the network connection.
++   */
++  if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0)
++    return(0);			/* errno set by system call. */
++
++#ifdef TCP_NODELAY
++  /* make sure to turn off TCP coalescence */
++  { int mi;
++    setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
++  }
++#endif
++
++#ifdef THREADS
++start_critical_section();
++#endif
++  if (connect(fd, addr, addrlen) == -1) {
++    (void) close (fd);
++#ifdef THREADS
++end_critical_section();
++#endif
++    return(0);		/* errno set by system call. */
++  }
++  /*
++   * Return the id if the connection succeeded.
++   */
++  return(fd);
++}
++
++
++/***********************************************************************
++ * Server side
++ **********************************************************************/
++/*
++ * Creates a server port. Returns file 
++ * descriptor (network socket) or 0 if connection fails.
++ */
++
++int create_server_port(int port)
++{
++  struct sockaddr_in inaddr;	/* INET socket address. */
++  struct sockaddr *addr;	/* address to connect to */
++  int addrlen;			/* length of address */
++  int request, conn;		/* Network socket */
++
++  /*
++   * Open the network connection.
++   */
++  if ((request = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
++    return(0);			/* errno set by system call. */
++  }
++
++#ifdef SO_REUSEADDR
++    /* Necesary to restart the server without a reboot */
++    {
++	int one = 1;
++	setsockopt(request, SOL_SOCKET, SO_REUSEADDR, &one, sizeof(int));
++    }
++#endif /* SO_REUSEADDR */
++#ifdef TCP_NODELAY
++  /* make sure to turn off TCP coalescence */
++  { int mi;
++    setsockopt(request, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
++  }
++#endif
++
++  /* Set up the socket data. */
++  memset((char *)&inaddr, 0, sizeof(inaddr));
++  inaddr.sin_family = AF_INET;
++  inaddr.sin_port = htons(port);
++  inaddr.sin_addr.s_addr = htonl(INADDR_ANY);
++
++  if (bind(request, (struct sockaddr *)&inaddr, sizeof (inaddr)))
++    FEerror("Binding TCP socket", 0);
++  if (listen(request, 1))
++    FEerror("TCP listening", 0);
++
++#ifdef THREADS
++  /* Don't make this file-descriptor non-blocking */
++  /* just block on it before we attempt to accept from it */
++  /* Think _hard_ about moving this out of here, into somewhere sane */
++  /* and creating an 'accepting' stream type, which is bound to a port */
++  /* on reading returns streams */
++  {
++	FILE *fp;	/* need to use FILE *'s rather than fd... *sigh* */
++	if ((fp = fdopen(request, "r")) == (FILE *)0) {
++		printf("fdopen didn't work on accept fd!\n"); fflush(stdout);
++		}
++	fcntl(request, F_SETFL, O_NONBLOCK);
++	clearerr(fp);
++
++loop:	errno = 0;
++#endif
++  if ((conn = accept(request, (struct sockaddr *)NULL, (int *)NULL)) < 0)
++#ifndef THREADS
++    FEerror("Accepting requests", 0);
++#else /* THREADS */
++	if (errno) {
++		lwpblockon(active, fp, PD_INPUT);
++		clearerr(fp);
++		goto loop;
++	} else {
++		fclose(fp);
++		FEerror("Accepting requests", 0);
++		}
++	fclose(fp);
++  }
++#endif	/* THREADS */
++  return(conn);
+ }
+diff --recursive --unified=3 src/c/unixint.c zsrc/c/unixint.c
+--- src/c/unixint.c	Sun Sep 24 01:05:26 1995
++++ zsrc/c/unixint.c	Sun Jul 21 13:26:47 1996
+@@ -38,12 +38,15 @@
+ void
+ sigint()
+ {
++  /* always reinit on entry, since there is a wee race condition that */
++  /* might bite unless you have BSD flavour signals... *sigh* */
++
++  signal(SIGINT, sigint);
+   if (!interrupt_enable || interrupt_flag) {
+     if (!interrupt_enable) {
+       fprintf(stdout, "\n;;;Interrupt delayed.\n"); fflush(stdout);
+       interrupt_flag = TRUE;
+     }
+-    signal(SIGINT, sigint);
+     return;
+   }
+   if (symbol_value(SVinterrupt_enable) == Cnil) {
+@@ -70,9 +73,11 @@
+ void
+ sigint()
+ {
+-#ifdef SYSV
++/*#ifdef SYSV*/
++  /* shouldn't hurt to reset it on entry... */
+   signal(SIGINT, sigint);
+-#endif
++/*#endif*/
++
+   if (critical_level > 0) {
+     scheduler_interrupted = TRUE;
+     scheduler_interruption = ERROR_INT;
+@@ -101,15 +106,17 @@
+ signal_catcher(int sig, int code, int scp)
+ {
+ 	char str[64];
++/* if not bsd... */
++	signal(sig, signal_catcher);
+ 
+ 	if (!interrupt_enable) {
+ 		sprintf(str, "signal %d caught (during GC)", sig);
+ 		error(str);
+ 	}
+-	else if (sig == SIGSEGV)
++	else if (sig == SIGSEGV) {
+ 	  FEerror("Segmentation violation.~%\
+ Wrong type argument to a compiled function.", 0);
+-	else {
++	} else {
+ 	  printf("System error. Trying to recover ...\n");
+ 	  fflush(stdout);
+ 	  FEerror("Signal ~D caught.~%\
+diff --recursive --unified=3 src/c/unixtime.c zsrc/c/unixtime.c
+--- src/c/unixtime.c	Wed Jul  5 04:12:07 1995
++++ zsrc/c/unixtime.c	Tue Jul 16 19:53:05 1996
+@@ -74,10 +74,18 @@
+ 	Lround(1, z);
+ 	z = VALUES(0);
+ 	if (FIXNUMP(z))
++#ifdef THREADS
++		lwpsleep(fix(z)*1000);
++#else
+ 		sleep(fix(z));
++#endif
+ 	else
+ 		for(;;)
++#ifdef THREADS
++			lwpsleep(1000000);
++#else
+ 			sleep(1000);
++#endif
+ 	VALUES(0) = Cnil;
+ 	RETURN(1);
+ }
+diff --recursive --unified=3 src/crs/Makefile.in zsrc/crs/Makefile.in
+--- src/crs/Makefile.in	Wed May 31 02:27:00 1995
++++ zsrc/crs/Makefile.in	Wed Jul 17 12:04:30 1996
+@@ -26,7 +26,7 @@
+ 
+ # Files
+ 
+-OBJS	= unexec.o dld.o @SETJMPO@ socket.o
++OBJS	= unexec.o dld.o @SETJMPO@
+ HFILES	= ../h/config.h $(srcdir)/objff.h
+ 
+ SYSDIR	= ..
+@@ -39,9 +39,6 @@
+ 
+ dld.o:	$(srcdir)/@DLD@.c $(HFILES)
+ 	$(CC) -c $(CFLAGS) $(srcdir)/@DLD@.c -o $@
+-
+-socket.o:	$(srcdir)/socket.c
+-	$(CC) -c $(CFLAGS) $(srcdir)/socket.c -o $@
+ 
+ unexec.o:	$(srcdir)/@UNEXEC@.c $(HFILES)
+ 	$(CC) -c $(CFLAGS) $(srcdir)/@UNEXEC@.c -o $@
+Only in src/crs: socket.c
+diff --recursive --unified=3 src/h/external.h zsrc/h/external.h
+--- src/h/external.h	Tue Mar 12 20:17:12 1996
++++ zsrc/h/external.h	Wed Jul 17 19:25:23 1996
+@@ -279,9 +279,15 @@
+ #ifdef THREADS
+ extern lpd main_lpd;
+ extern lpd *clwp;
+-extern pd *running_head;
+-extern pd *running_tail;
+ extern pd main_pd;
++extern pd *active;			/* active pd */
++extern pd *running_queue;		/* running pd's  */
++extern pd *blocking_queue;		/* blocking pd's */
++extern pd *delayed_queue;		/* delaying pd's */
++extern pd *dead_queue;			/* dead pd's */
++extern pd *stopped_queue;		/* stopped pd's */
++extern pd *suspended_queue;		/* suspended pd's */
++extern pd *waiting_queue;		/* waiting pd's */
+ #endif THREADS
+ 
+ /*  macros.c  */
+diff --recursive --unified=3 src/h/lwp.h zsrc/h/lwp.h
+--- src/h/lwp.h	Tue Feb  6 04:00:30 1996
++++ zsrc/h/lwp.h	Sat Jul 20 16:44:15 1996
+@@ -146,8 +146,8 @@
+   object lwp_gentemp_prefix;
+   object lwp_token;		/* They have to be initialized with
+ 			         * alloc_simple_string and */
+-} lpd;
+ 
++} lpd;
+ 
+ #define RUNNING		0
+ #define SUSPENDED	1
+@@ -155,6 +155,7 @@
+ #define DEAD		3
+ #define WAITING		4
+ #define DELAYED		5
++#define BLOCKED		6
+ 
+ typedef struct pd {
+   object pd_thread;             /* point back to its thread	 */
+@@ -166,14 +167,46 @@
+   sigjmp_buf  pd_env;		/* Stack Environment */ 
+ #endif VAX
+   int	 pd_slice;              /* time out			 */
++  int	 pd_fp_mode;		/* in, out, execpt */
+   FILE	 *pd_fp;		/* File pointer waiting input on */
+   lpd	 *pd_lpd;               /* lisp process descriptor */
+   struct pd *pd_next;
+ 
+ } pd;
+ 
++#define PD_INPUT	0
++#define PD_OUTPUT	1
++#define PD_EXCEPTION	2
++
++#define ENQUEUE(lpd, queue)					\
++		{ if (queue == NULL) {				\
++			lpd->pd_next = lpd;			\
++			queue = lpd;				\
++		} else {					\
++			lpd->pd_next = queue->pd_next;		\
++			queue->pd_next = lpd;			\
++			} }
++
++#define DEQUEUE(lpd, queue)					\
++		{ pd *TMP;					\
++		TMP = queue;					\
++		do {						\
++			if (TMP->pd_next == lpd) {		\
++				TMP->pd_next = lpd->pd_next;	\
++				lpd->pd_next = lpd;		\
++				if (lpd == queue)		\
++					queue = TMP;		\
++				break;				\
++				}				\
++			TMP = TMP->pd_next;			\
++		} while(TMP != queue);				\
++		if (lpd == queue) queue = NULL;			\
++		}
+ 
++#define ROTQUEUE(queue)						\
++		if (queue != NULL) queue = queue->pd_next
+ 
++/*
+ #define PUSH(lpd)     { if ( running_head == NULL)               \
+ 			  { running_head = lpd;                  \
+ 			   running_tail = lpd;                   \
+@@ -194,7 +227,7 @@
+ 			    running_head = running_head->pd_next; \
+ 			    running_tail = running_tail->pd_next; \
+ 			    running_tail->pd_next = NULL; }
+-
++*/
+ 
+ /*
+ #define PUSH(lpd)     ( running_head == NULL \
+Only in zsrc/h: lwp.orig
+diff --recursive --unified=3 src/h/machines.h zsrc/h/machines.h
+--- src/h/machines.h	Thu Jul  4 21:14:03 1996
++++ zsrc/h/machines.h	Mon Jul 15 22:01:57 1996
+@@ -209,7 +209,7 @@
+ #define	IEEEFLOAT
+ #define	DOWN_STACK
+ #define	BSD
+-# if __GNUC__ > 2 || __GNUC_MINOR__ > 6
++# if 0 /*__GNUC__ > 2 || __GNUC_MINOR__ > 6*/
+ # define ELF
+ # define UNEXEC unexelf
+ #define	DATA_START ELF_TEXT_BASE
+Only in zsrc: newthread.tgz
+Only in zsrc: socket.c
diff --git a/site.lsp b/site.lsp
new file mode 100644
index 000000000..4d142a289
--- /dev/null
+++ b/site.lsp
@@ -0,0 +1,4 @@
+;; Edit these with the name of your site:
+;;
+(defun short-site-name () "SHORT-SITE-NAME")
+(defun long-site-name ()  "LONG-SITE-NAME")
diff --git a/src/CHANGELOG b/src/CHANGELOG
new file mode 100644
index 000000000..9298cca6e
--- /dev/null
+++ b/src/CHANGELOG
@@ -0,0 +1,697 @@
+ECL-Spain v0.0
+==============
+
+* Removed all "break" from the configure script.
+
+* Added latexinfo.sty to help producing the manual.
+
+* src/configure.in: profile feature disable by default.
+
+* Conversion to ANSI prototypes of all files in the library (c/)
+  directory. Two headers, external.h and lisp_external.h, to keep the
+  prototypes of C and LISP functions.
+
+* Fixed lack of "extern" declaration for {short,long}float_zero and
+  lack of implementation.
+
+* Fixed lack of "extern" declaration of r frame_stack, frs_limit and
+  frs_top. Actual implementation added in main.c.
+
+* Fixed lack of "extern" declaration for Values in the THREADS case,
+  in vs.h
+
+* Removed OFLAG as the standard is using CFLAGS
+
+* Added test tree from CLISP
+
+* Removed 'break's from configure.
+
+* Grouped all keyword definitions in a single pool in the new file
+  all_keywords.c
+
+* Grouped all symbol definitions in a single pool in the new file
+  all_symbols.c
+
+* Removed all calls to register_root() for symbols from the
+  library. Instead the garbage collector uses the symbol/keyword
+  definition pools to mark these objects.
+
+* parse_number() failed when GC was triggered. The reason was that
+  GC did only reallocate num.size limbs when it should actually move
+  num.alloc limbs. This has been solved in three steps
+	+ The GC uses num.alloc (= big_dim)
+	+ The allocator clears the bignum
+	+ The bignum data is only relocated when the pointer is valid,
+	  that is, we assume that big_limbs may point to non
+	  collectable memory.
+
+* The allocator empties a region before returning it.
+
+* All big_*() functions now get lisp objects as input, in order to
+  make the interface more abstract.
+
+* Added #'nth-value
+
+* Now big_alloc(), alloc_contblock() and alloc_relblock() fail when
+  passed a negative argument.
+
+* Created a pool of three bignum registers. These registers may be
+  used to save consing, as the destination of mpz_* operations, as
+  follows
+	+ Perform a big_register?_get()
+	+ Perform elementary operations from the GMP library
+	+ Either discard the object, use big_register_copy() or use
+	  big_register_normalize().
+
+* Removed most preallocations of bignums, favoring the use of bignum
+  registers.
+
+* In integer_quotient_remainder, if both operands are bignums and the
+  divisor is larger, a bignum with negative size was allocated. The
+  use of bignum registers fixes this problem.
+
+* In parse_number() and parse_integer(), use the bignum registers to
+  store the intermediate result.
+
+* Implementation of a new stream mode, smm_closed.
+
+* Fresh streams from alloc_object() are smm_closed streams.
+
+* In file.d: 1) input_stream_p, output_stream_p, stream_element_type,
+  readc_stream, unreadc_stream, writec_stream, flush_stream,
+  clear_input_stream, clear_output_stream, stream_at_end,
+  listen_stream, file_position, file_position_set, file_length,
+  file_column fail on closed streams. 2) close_stream and
+  Lopen_stream_p work on closed streams.
+
+* In read.d, print.d: Lread_bytes and Lwrite_bytes which could have
+  tried to access a closed stream. Not a good fix, anyway.
+
+* array.tst, hashlong.tst, eval20.tst, iofkts.tst, lists152.tst: added #+ECL.
+
+* In pathname.d: coerce_to_pathname makes sense on closed streams.
+
+* In print.d: print() did not output a trailing space.
+
+* In read.d: #'read-char-no-hang now handles EOF and fails or returns
+  eof-value when appropiate.
+
+* In format.c: Lformat formerly output a string for non-nil first
+  argument.
+
+* In symbols.c, all_symbols.c, lisp_externals.h: implemented
+  *gensym-counter*
+
+* In symbols.tst: placed (setq *gensym-counter*...) right before
+  creating the symbol --otherwise a spurious gensym is produced by the
+  interpreter.
+
+* predlib.lsp: errata in subtypep caused failure for '(not ....) and
+  '(and ...) types.
+
+* predlib.lsp: #'normalized-type now turns (integer a (b)) into
+  `(integer a ,(1- b)), producing an output which is suitable for
+  sub-interval-p.
+
+* predlib.lsp: #'typep now rejects type specifiers that it doesn't
+  know about. For instance, '(symbol cons) is rejected.
+
+* predlib.lsp: #'typep on '(MEMBER ...) now only outputs T or NIL.
+
+* strings.tst: added #+ECL and now included in the test-suite.
+
+* string.d: member_char() hangs when the character bag has some
+  non-character objects.
+
+* string.d: nstring-{up,down}case now reject NIL as bound designator
+  when compiled in ANSI compatibility mode.
+
+* characters.tst: added #+ECL and included in the test-suite.
+
+* pack11.tst: the keyword :use from #'in-package needs a list, no
+  a single symbol. Added to the test.
+
+* package.d: packages must be case sensitive. This implies changes in
+  find_package()
+
+* package.d: #'package-name should also accept symbols and strings.
+
+* package.d: #'unexport should ignore internal symbols.
+
+* Makefile.in: makes tar file.
+
+* in system.lsp: new syntax for defsystem, takes care of multiple
+  source directories and separate path for library.
+
+* in {lsp,cmp,clos}/defsys.lsp.in: modified with new syntax.
+
+* in load.d: build_symbol_table is now a C function invoked from the
+  initialization code and not exported to lisp.
+
+* in cmpmain.lsp: new #'build-ecl function to build customized
+  executables. It generates the initialization code.
+
+
+ECL v0.0b
+=========
+
+* in lsp/predlib.lsp: extended #'typep to classes.
+
+* in cmp/cmpdefs.lsp: added types for all compiler structures.
+
+* in clos/standard.lsp: redefine-class should be evaluated at compile
+  time.
+
+* in clos/: fixed everything to allow generation of *.c files.
+
+* in lsp/predlib.lsp: subclassp now exported from LISP package.
+
+* in c/pathname.d:
+  + now pathnames are constructed according to ANSI. We support
+  :ABSOLUTE, :RELATIVE, :UP and :WILD, and we require their use when
+  constructing pathnames.
+  + All pathnames are considered relative except those which begin
+  with '/' or '~/'. The last case is expanded using the $HOME
+  environment variable.
+  + pathnames are merged according to ANSI CL. If 'pathname' is a
+  relative directory, it is merged with 'default's directory, no
+  matter whether this one is relative or not.
+  + tilde_expand() hidden as static -- it is far too low level.
+  + current_dir() and getcwd() substitutes all uses of getwd().
+  + fixed size buffers removed from most routines to avoid accidental
+  overflows. Use of current_dir() and siLstring_concatenate() prevents
+  this type of errors.
+
+* in c/unixfsys.c:
+  + truename() rewritten to detect only files and signal errors when
+  it finds directories.
+  + Ltruename() now returns the number of output values.
+  + Lrename_file() now outputs true names by checking the renamed file
+  after the operation.
+  + string_match() and siLstring_match() provide SH-like patterns.
+  + Ldirectory() only lists files and allows all wildcards that
+  siLstring_match() provides. The implementation dependent keyword,
+  :LIST-ALL, instructs Ldirectory() to list both files, directories
+  and special nodes such as devices, pipes, etc.
+
+* in c/read.d:
+  + Added Lsharp_P_reader() to read paths using #P.
+  + Ldefault_dispatch_macro() outputs clearer error message.
+
+* in lsp/defstruct.lsp,lsp/iolib.lsp: sharp-s-reader and
+  sharp-s-reader-si now ignore data when *read-suppress*.
+
+* in lsp/module.lsp: #"" replaced with #P"".
+
+* in c/lwp.d,c/big.c: per-thread allocation bignum registers.
+
+* in c/Makefile.in,gmp/Makefile.in: make use of './' to avoid the need
+  of exporting PATH with a '.' inside.
+
+* in c/print.d: Now paths are printed as #P.
+
+* in Makefile.in: BUILDIR mispelled caused failure of installation.
+
+ECLS v0.0c
+==========
+
+* in src/configure.in: make using CLOS the default.
+
+* in gmp/Makefile.in,gmp/mpz/Makefile.in: fixed recursive error in
+  cleaning.
+
+* in lsp/iolib.lsp,lsp/packlib.lsp: removed use of ". body" favoring
+  the use of "&rest body" because sys::expand-defmacro doesn't
+  understand it.
+
+* in c/gbc.c: added gc marking of objects in lexical envs.
+
+* in c/macros.c: define-macro now uses default values for last two
+  arguments when they are missing.
+
+* in c/clos.c,c/package.d,c/print.d,c/read.d: added register_root() to
+  some variables.
+
+* in lsp/builtin.lsp: removed make-instance on structure-metaclass,
+  since it does not exist.
+
+* in lsp/predlib.lsp:
+  + implemented sequence as a deftype
+  + removed sequence from subtypep
+  + built normalize-type to return multiple values
+  + recoded subtypep & coerce to use multiple values from normalize-type
+  + when using clos, deftype structure as STRUCTURE-OBJECT
+
+* in c/let.c: save values in Fmultiple_value_bind before performing
+  the actual let_bind. This prevents losing data within a GC.
+
+* Now a raw ecl_min file is built which uses no lisp compiled files,
+  to provide a tool for bootstraping ECL. This implies some changes
+  to avoid circular dependencies
+  + src/c/Makefile.in creates an init_min.o when bootstraping
+  + src/Makefile.in uses init_min.o,c/*.o and crs/*.o to create the
+    raw ECL which we will use to bootstrap.
+  + c/init.c now loads *.lsp files when bootstraping
+  + lsp/defmacro.lsp postpones definition of defmacro until
+    sys::expand-defmacro is defined
+  + lsp/defmacro.lsp does not use 'defvar because it is not defined.
+  + lsp/iolib.lsp,lsp/module.lsp,lsp/packlib.lsp now use &optional
+    instead of . in macros, as defmacro does not support '.'
+  + clos/method.lsp: when :ecl-min, replace *safe-compile* with t
+  + cmp/load.lsp: replace call to object-type with its result.
+  + new src/config_min.lsp which performs booting.
+
+* in cmp/cmpinline.lsp: inline-args adds a bogus arg when inlining
+  instance-ref. This problem only arised when *safe-compile*.
+
+* in lsp/defmacro.lsp:
+  + #'sys::destructure handles destructuring lambda lists
+  + #'defmacro reimplemented using #'sys::destructure, which now
+  handles '.' arguments properly.
+  + new #'destructuring-bind implemented using #'sys::destructure
+
+* in c/unixfsys.c: sys::chdir now outputs original directory.
+
+* in h/: lisp_external.h and unify.h were missing from CVS.
+  in c/: all_symbols.c and all_keywords.c were missing from CVS.
+  in contrib: ilisp removed, there are better versions around.
+
+* new src/compile.lsp.in, lsp/defsys.lsp.in, clos/defsys.lsp.in,
+  cmp/defsys.lsp.in, plus changes in src/config.lsp.in,
+  src/configure.in and src/Makefile.in: now the C files are
+  compiled on-the fly usin the bare feet ecl_min program.
+
+ECLS v0.0d
+==========
+
+* in clos/generic.lsp: implemented :method in #'defgeneric
+
+* in lsp/predlib.lsp: extended #'typep to classes and made #'subclassp
+  public.
+
+* New codeblock object which keeps all information about an object
+  file and its data. It replaces the old tagless structure and
+  introduces a new format for init_*() function when initializing an
+  object file.
+
+* Moved compiler data into object files as C string. This implies
+  changes in the loader (load.d), in the data stream reader
+  (read_VV) and in the compiler (cmpwt.lsp,cmpmain.lsp,cmptop.lsp)
+  which nows generates a different boot code for compiled lisp files.
+
+* in cmp/cmpmain.lsp: new #'make-library joins several object files
+  into an *.a file, adding a new object file which initializes them
+  all and exports an init_*() routine.
+
+* cmp/cmpmain.lsp: compiler-pass2 now upcases init_* names to avoid
+  name clashes with lisp code.
+
+* in src/util/system.lsp: new :LIBRARY target which uses
+  compiler::make-library to produce *.a libraries up from CLOS, LSP
+  and CMP subdirectories.
+
+* in src/c/Makefile.in: now a library libecls.a is built up from
+  all object files except cinit*.o
+
+* in src/Makefile.in, src/compile.lsp: ecl_min is built up only from
+  the core C library, while ecl is built with this core and all
+  required libraries liblsp.a, libcmp.a, libclos.a, etc, plus
+  config.o. To help in this compile.lsp is used to build all required
+  libraries.
+
+* load.d: siLbuild_symbol_table no longer removes ecl.sym
+
+* in c/main.c,c/cinit.c,c/load.d: removed system_directory C variable.
+  The lisp variable *system-directory* is used instead and points to
+  the system files (headers, libraries, initialization code). Default
+  value for this one is assigned during the configuration phase and
+  defaults to @libdir@
+
+* in cmp/cmpmain.lsp: <ecl.h> header is no longer copied onto the
+  compiled code, but #inlined from the system directory.
+
+* in c/package.d, c/assignment.c, c/macros.c, c/toplevel.c,
+  h/object.h: new function #'sys::package-lock locks a package and
+  subsequents redefefinitions of functions/macros produce a warning.
+
+* config.lsp moved to lsp/config.lsp and compiled into interpreter.
+
+* in Makefile.in, src/Makefile.in: primitive installation method,
+  which stores $(bindir)/ecl, $(mandir)/man.1, $(libdir)/ecl.sym,
+  $(libdir)/help.doc and $(libdir)/h/ecl.h
+
+ECLS v0.0e
+==========
+
+* Support for FreeBSD >= 4.0 using ELF.
+
+* Defined ANSI and #+ansi by default, except in number_atan(), which
+  needs fixing.
+
+* in package.d: lisp package renamed to common-lisp with nicknames
+  "lisp" and "cl", and user package renamed to common-lisp-user with
+  nicknames "cl-user" and "user".
+
+* in export.d: common-lisp-user, cl, cl-user, common-lisp added to
+  export list of common-lisp package.
+
+* in defsys.lsp: ansi.lsp, loop.lsp and defpackage.lsp incorporated.
+
+* in package.d: shadow did not shadow already interned objects.
+
+* in toplevel.c: added :execute, :compile-toplevel and :load-toplevel
+  to eval-when.
+
+* in list.d: fixed #'last adding optional argument
+
+* in src/util/system.lsp: new syntax which allows separate directory
+  for library.
+
+* src/config.lsp.in moved to src/lsp/config.lsp.in and incorporated
+  into liblsp.a
+
+* in cmp/cmpmain.lsp: new #'build-ecl to build customized executables.
+  {lsp,cmp,clos}/defsys.lsp.in updated accordingly.
+
+* in src/Makefile.in: new build process relying entirely on lisp and
+  defsystem to build executables.
+
+* in print.d: when *print-escape* is nil, pathnames are written as
+  addresses -- now the namestring is output.
+
+* in predicate.c: functionp = 't on symbols bound to functions.
+
+* in src/Makefile.in: strip executables.
+
+* in lsp/seq.lsp: #'make-sequence was broken due to new #'normalize-type.
+
+* in lsp/predlib.lsp: #'coerce was broken due to new #'normalize-type.
+  Plus a quick hack to handle 'LIST properly.
+
+* in cmp/cmpmain.lsp: #'build-ecl now also strips symbols using
+  "rsym", which gets installed into @libdir@
+
+* Simplified the set of headers. Now there is a ecls.h for base code
+  and ecls-cmp.h for lisp compiled code, both sharing the rest of
+  headers (stacks.h, object.h, etc), to simplify maintenance.
+
+ECLS v0.0g
+==========
+
+* Binding stack, invocation history stack and frame stack predate now
+  ordinary memory as a first step for future resizable stacks.
+
+* Built in C strings are better handled now: they can contain \000 and
+  make use of \n,\t,\\, and of special characters in octal notation.
+
+* Final problems with documentation solved. #'si::help no longer hangs
+  and the database is now properly generated (in v0.0e only a few
+  entries got in).
+
+* New online manual in texinfo format gets installed.
+
+* Support for character attributes removed, including #'char-bit,
+  #'char-font, #'make-character, #'string-char-p and 'string-char
+  type. Instead, the whole chapter of the ANSI spec is implemented
+  with types character = base-char > standard-char and extended-char
+  being an empty type.
+
+* Initialization of functions grouped in a single file all_functions.c.
+
+* Full ANSI compliance for CHARACTER and STRING sections of the spec.
+
+* (type-of nil) now returns 'NULL instead of 'SYMBOL.
+
+* Different hierarchy of tags in object.h saves some space & time.
+
+* Open-coded caar, cadr, etc, are faster & smaller.
+
+* In old garbage collector, flag *IGNORE-MAXIMUM-PAGES* turned into
+  function #'si:ignore-maximum-pages
+
+* Added support for Boehm-Weiser garbage collector with flag
+  --enable-boehm.
+
+* Removed support for relocatable blocks of memory from original
+  garbage collector. Unified allocation interface with alloc(),
+  alloc_align(), dealloc() and the alloc_atomic() and
+  alloc_atomic_align() variants.
+
+ECLS v0.0h
+==========
+
+* big_bitp() was broken due to the use of wrong limb sizes. Furthermore,
+  it did not consider the case of negative bignums.
+
+* gmp-3.1 takes the place of the original gmp-1.
+
+* Now it is possible to link ECLS with a local copy of the GMP library,
+  avoiding to compile and install the copy that comes with it.
+
+* New C functions floor1, floor2, ceiling1, ceiling2, truncate1,
+  truncate2, round1, round2 which correspond to #'floor, #'ceiling,
+  #'truncate and #'round with one or two arguments, but which are only
+  used internally. Lfloor, Lceiling and Ltruncate implemented using
+  them.
+
+* Rewritten many routines optimizing and removing or completing type
+  checks.  For instance, make_complex(),
+  number_{plus,minus,times,divide}(), integer_divide(), log_op(), etc.
+
+* At cost of some speed, the interpreter (i.e. not compiled code)
+  keeps track of all called functions for better error signaling.
+
+* Some failed type checks are now restartable in most cases in which
+  it is safe. This allows the user to dynamically supply a different
+  value
+	> (make-list 'a :initial-element 'b)
+	Correctable error: A is not of type (INTEGER 0 *).
+	                   Signalled by MAKE-LIST.
+	If continued: Enter new value.
+	;;; Warning: Clearing input from *debug-io*
+	Broken at MAKE-LIST.
+	>> :b
+	Backtrace: > MAKE-LIST
+	>> :continue
+	Enter new value> 10
+	(B B B B B B B B B B)
+	>
+  The jump to the debugger may be suppressed by binding *break-enable*
+  to nil.
+	> (setq *break-enable* nil)
+	NIL
+	> (make-list 'a :initial-element 'b)
+	Correctable error: A is not of type (INTEGER 0 *).
+	                   Signalled by MAKE-LIST.
+	Aborting:
+	>
+
+* Support for logical pathnames. The syntax for logical pathnames is
+	[hostname:][;][directory-item;][name][.type]
+  and the syntax for physical pathnames is extended to
+	[device:][[//hostname]/][directory-item/][name][.type]
+  where device defaults to "file". Pathname translation and matching
+  is also implemented, although wildcard expansion is not maximal
+  and works more like "sh" than like "regexp".
+
+* New set of C types which includes: cl_object for all lisp objects,
+  cl_fixnum for an integer large enough to hold a fixnum, cl_index for
+  an unsigned integer large enough to index an array, cl_hashkey for
+  hashing and cl_type for all type tags.
+
+* New macros LISTP(), ATOM(), CONSP(), SYMBOLP() optimize type checks
+  within the library code and within automatically generated C
+  compiled code.
+
+* Errors fixed:
+  + Removed non-standard keyword argument :staticp from #'make-array
+    and #'make-vector.
+  + A fixnum is no longer a valid string designator.
+  + #'butlast and #'nbutlast now work with dotted lists.
+  + Inlined #'tan now produces the right code.
+  + A fixnum cannot be coerced to a character.
+  + Character bags of type vector would produce erroneous results.
+  + #'equalp would fail to compare complex numbers
+  + #'char now only accepts strings
+  + in pathnames, namestrings, etc, symbols are not implicitely
+  coerced to strings.
+
+* The Common-Lisp reader has been reworked to allow an unlimited
+  number of #= and ## references in circular structures. Besides, this
+  also fixes the accidental deactivation of the #=/## readers in ECLS
+  v0.0g :(
+
+* Errors detected but not yet fixed throught all bit manipulating
+  functions: they fail to fake two's complement convention for
+  negative bignums.
+
+* Big change of names in structure members: ht.ht_size -> hash.size,
+  etc. Less redundant and more expressive.
+
+* Packages are now stored in a list. The link in the package object
+  has been removed. We make sure this list is garbage collected by
+  applying "register_root()" on it. Garbage collection of package
+  objects is now moved into the mark_object() routine.
+
+ECLS 0.0i
+=========
+
+* Replaced hashing function with a crc32.
+
+* Packages now use standard hashes for storing symbols. This seems
+  to reduce the amount of wasted memory at now speed cost. Besides,
+  future improvements to hashes will get in packages as well.
+
+* The interpreter is now capable of passing the whole suite of tests.
+  Just issue "make ecls_min_test" from within build/test directory.
+
+* Errors can be ignored by setting si:*ignore-errors* to true. If this
+  happens, a (throw si:*ignore-errors-tag* 'ERROR) is thrown. Hence
+  a useful construct for testing is
+  (defmacro with-ignored-errors (&rest forms)
+    `(catch si::*ignore-errors-tag*
+       (let ((si::*ignore-errors* t)) ,@forms)))
+
+* Improvements to the "dpp" preprocessor that generates code for the
+  core library:
+  + All C code is now run by the preprocessor.
+  + Simplified #line staments in the output make files more readable.
+  + It now exits with value != 0 when errors occurr, which means
+    makefiles now stop when the *.d file has errors.
+  + It accepts more flexible input as tokens. No need of [`] character,
+    use parenthesis instead; function names may contain packages
+    as in "si::unwind"
+  + It does not generate #define/#undefine pragma, but uses variables
+    instead.
+
+* Errors fixed:
+  + #'mapcan and #'mapcon failed to handle dotted lists.
+  + Inlined short-float/long-float values were truncated to ints.
+  + declaim's effects are now visible at compile time.
+  + proclaim causes no effect at compile time.
+  + declarations cannot arise as the result of a macro expansion.
+
+* CL package unpolluted:
+  + 'system, '*break-enable* and others now rest in the 'system package.
+  + function #'proclamation removed
+
+* New macro expanders help the compiler to produce the right code for
+	(do ((s "asbc") c (i 0 (1+ i)))
+	    ((= i 3) c)
+	  (declare (type character c))
+	  (setq c (char s i)))
+  Formerly, C would be initialized with "char_code(Cnil)" which is
+  probably not what the user wanted.
+
+* IN-PACKAGE is now a macro and DEFPACKAGE now expands to a shorter
+  expression with the help of an internal function SI:%DEFPACKAGE.
+
+* Evaluation of (LAMBDA (..) ...) expressions now conses less when in
+  an empty lexical environment.
+
+* The system now uses a different protocol for returning values.
+  + If a lisp function returns one single value, the C function
+    outputs that value directly and sets NValues=1.
+  + If N values are output, the function, sets NValues=N; it sets
+    VALUES(1..N-1) to the N-1 last values and outputs the first one.
+
+* The code walker in PCL now avoids macroexpanding DOTIMES, DOLIST,
+  WHEN and UNLESS. This gives smaller/faster code in the interpreter.
+
+ECLS 0.1a
+=========
+
+* Brand new interpreter based on a byte compiler. This implies major
+  changes to CLOS, the code walker and to the compiler.
+
+* Export COMPILE-FILE-PATHNAME.
+
+* Gabriel's benchmark incorporated to the source tree.
+
+* Ported to NetBSD.
+
+* Added support for SYMBOL-MACROLET in the interpreter.
+
+* New lisp object for loaded binary files. This helps in garbage
+  collection of FASL objects and serves as a base for DLL support.
+
+* Fixed documentation and doc/help.lsp.
+
+* Fixed benchmark, which now output results in right order.
+
+* SETF revised. Now it, and all accessors are implemented as macros
+  with no special support from the interpreter.
+
+ECLS 0.1b
+=========
+
+* Due to human errors, the bytecompiler shipped with 0.1a was not the
+  finished version. In 0.1b we shipped a more polished files. Some of
+  the errors which are fixed are
+    + Produce the right code for TAGBODY inside closures
+    + Activate compiler for SYMBOL-MACROLET    
+    + Allow non-keyword symbols as lambda-list-keywords
+    + Allow more than one :ALLOW-OTHER-KEYS to be supplied, but
+      discard other than the first one
+    + Process declarations in FLET/LABELS forms
+
+* Fixed the C compiler routines for TAGBODY: it would produce wrong
+  code when jumping out of a closure.
+
+* Rewrite the error system using KMP's condition system, CLOS and a
+  rudimentary interface to the toplevel.
+
+* Enclosing the bytecompiler in an UNWIND-PROTECT ensures that the
+  status of the compiler and of the interpreter is always consistent.
+
+* Port and incorporate Peter Van Eynde's test suite for ANSI
+  compliance.
+
+* Replace features ECL/ECL-MIN with ECLS and ECLS-MIN.
+
+* Add simple-program-error and simple-control-error to the hierarchy
+  of conditions, and try to ensure that all routines in libecls.a
+  signal the right type of condition.
+
+* Define COMPLEMENT and CONTINOUSLY.
+
+* Fix #'= between bignums.
+
+* NIL is no longer valid as the first of a pair of bounding index
+  designators, i.e. (nstring-upcase "aa" :start nil :end nil) causes
+  an error.
+
+
+TODO:
+=====
+
+* Selectively remove spices from read.d and object.h
+
+* Implement memory collection based on mmap()
+
+* Improve the garbage collector using kernel information about dirty
+  pages.
+
+* Improve fixnum_times.
+
+* #'unread-char does not fail when the character differs from the
+  original one.
+
+* vector-push-extend may succeed even if the vector is not
+  adjustable. Should we be more strict?
+
+* should we relax ASSOC? (See lists156.tst)
+
+* boost setf and generalized places -- the current implementation is
+  extremely faulty with respect to the standards.
+
+* expand parse_namestring() to accept scaped strings, spaces, etc.
+
+* fix FEerror* so that it accepts parameters.
+
+* Remove most property lists from standard symbols.
+
+;;; Local Variables: ***
+;;; mode:text ***
+;;; fill-column:70 ***
+;;; End: ***
diff --git a/src/Makefile.in b/src/Makefile.in
new file mode 100644
index 000000000..bedb4a64b
--- /dev/null
+++ b/src/Makefile.in
@@ -0,0 +1,169 @@
+#
+#		Makefile for ECoLisp
+#
+top_srcdir= @top_srcdir@
+srcdir	= @srcdir@
+VPATH	= @srcdir@
+
+MACHINE = @MACHINE@
+
+# Programs used by "make":
+#
+
+CC	= @CC@
+DEFS	= -D$(MACHINE)
+LIBS	= @LIBS@ @TKLIBS@ @CLIBS@
+CFLAGS	= @CFLAGS@
+LDFLAGS	= @LDFLAGS@
+
+#ifdef __GO32__
+EXE	= go32
+#elif defined(__EMX__)
+EXE	= emx
+#else
+EXE	=
+#endif
+
+SHELL	= /bin/sh
+RM	= @RM@
+
+# ==================== Where To Install Things ====================
+
+# The default location for installation.  Everything is placed in
+# subdirectories of this directory.  The default values for many of
+# the variables below are expressed in terms of this one, so you may
+# not need to change them.  This defaults to /usr/local.
+bindir=@bindir@
+libdir=@libdir@
+mandir=@mandir@
+manext=.1
+infodir=@infodir@
+
+# Programs used by "make install":
+#
+INSTALL	= @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+# Files
+
+SUBDIR	= c gmp crs
+LIBRARIES = libecls.a libcrs.a
+TARGETS = ecls
+#ifndef HAVE_LOCAL_GMP
+LIBRARIES += libgmp.a
+#endif
+#ifdef GBC_BOEHM
+SUBDIR += gc
+LIBRARIES += libgc.a
+#endif GBC_BOEHM
+LSP_LIBRARIES = liblsp.a
+#ifdef CLOS
+LSP_LIBRARIES += libclos.a
+#endif
+#ifndef RUNTIME
+LSP_LIBRARIES += libcmp.a
+#endif
+#ifdef CLX
+TARGETS += eclx
+LSP_LIBRARIES += libclx.a
+#endif
+
+# The makefiles of the directories in $SUBDIR.
+# Don't split this line: configure does grep on it
+SUBDIR_MAKEFILES= c/Makefile crs/Makefile tk/Makefile doc/Makefile gc/Makefile
+
+all:	$(TARGETS) doc
+.PHONY:	all
+
+%Makefile: $(srcdir)/%Makefile.in config.status
+	./config.status
+
+eclx: ecls compile_rest.lsp
+	./ecls < compile_rest.lsp
+
+ecls: ecls_min compile.lsp
+	./ecls_min < compile.lsp
+
+ecls_min: $(LIBRARIES) @RSYM@ .gdbinit
+	$(CC) $(LDFLAGS) -o $@ c/cinit.o -L./ $(LIBRARIES) $(LIBS)
+	test "@RSYM@" = "" || ./rsym ecls_min ecls_min.sym
+
+.gdbinit: $(srcdir)/util/gdbinit
+	cp $(srcdir)/util/gdbinit $@
+
+libecls.a:
+	cd c; $(MAKE)
+libgc.a:
+	cd gc; $(MAKE)
+libcrs.a @RSYM@:
+	cd crs; $(MAKE)
+	test "@RSYM@" = "" || cp crs/@RSYM@ .
+libgmp.a:
+	cd gmp; $(MAKE); cp .libs/libgmp.a ..
+
+BUILD-STAMP: config.status
+	(echo "#"; uname -a) > $@
+	head -8 config.status | tail -6 >> $@
+install: BUILD-STAMP
+	for i in $(TARGETS); do	$(INSTALL_PROGRAM) $$i $(PREFIX)$(bindir); strip $(PREFIX)$(bindir)/$$i; done
+	$(INSTALL_DATA) $(srcdir)/etc/ecls.1 $(PREFIX)$(mandir)
+	test -d $(PREFIX)$(libdir) || (mkdir $(PREFIX)$(libdir); chmod 755 $(PREFIX)$(libdir))
+	test -d $(PREFIX)$(libdir)/h || (mkdir $(PREFIX)$(libdir)/h; chmod 755 $(PREFIX)$(libdir)/h)
+	for i in $(TARGETS); do $(INSTALL_PROGRAM) $$i.sym $(PREFIX)$(libdir); done
+	$(INSTALL_DATA) BUILD-STAMP $(PREFIX)$(libdir)
+	$(INSTALL_DATA) h/config.h $(PREFIX)$(libdir)/h
+#ifndef HAVE_LOCAL_GMP
+	$(INSTALL_DATA) gmp/?*.h $(PREFIX)$(libdir)/h
+	$(INSTALL_DATA) $(srcdir)/gmp/?*.h $(PREFIX)$(libdir)/h
+#endif
+	for i in $(LSP_LIBRARIES) $(LIBRARIES); do \
+	$(INSTALL_DATA) $$i $(PREFIX)$(libdir); \
+	done
+#ifdef GBC_BOEHM
+	for i in $(srcdir)/gc/include/?*.h; do $(INSTALL_DATA) $$i $(PREFIX)$(libdir)/h/`basename $$i`; done
+	test -d $(PREFIX)$(libdir)/h/private  || (mkdir $(PREFIX)$(libdir)/h/private; chmod 755 $(PREFIX)$(libdir)/h/private)
+	for i in $(srcdir)/gc/include/private/?*.h; do $(INSTALL_DATA) $$i $(PREFIX)$(libdir)/h/private/`basename $$i`; done
+#endif GBC_BOEHM
+	test "@RSYM@" = "" || $(INSTALL_PROGRAM) @RSYM@ $(PREFIX)$(libdir)
+	cd c; $(MAKE) PREFIX="$(PREFIX)" install
+	cd doc; $(MAKE) PREFIX="$(PREFIX)" install
+
+uninstall:
+	rm -rf $(mandir)/ecls.1
+	rm -rf $(bindir)/ecls
+	rm -rf $(libdir)
+	cd doc; $(MAKE) uninstall
+
+doc: $(TARGETS)
+	cd doc; $(MAKE)
+
+clean: clean_lisp
+	for i in ${SUBDIR}; do (cd $$i; make clean); done
+	$(RM) ecls_min ecls_min.sym ecls ecls.sym help.doc core a.out
+	$(RM) config.version config.log config.cache
+	$(RM) *.c *.o *.a *.h *.data
+clean_lisp:
+	for i in lsp cmp clos clx tk; do rm -f lib$$i.a $$i/?*.o $$i/?*.c $$i/?*.data $$i/?*.h; done
+distclean: clean
+realclean: distclean
+test1:
+	cd c; make
+	make ecls_min
+	make ecls
+	cd tests; make
+	diff tests tests2
+test2:
+	make clean_lisp
+	cd c; make
+	make ecls_min
+	$(RM) ecls
+	make ecls
+	for i in lsp clos cmp; do diff --exclude=\*.o $$i old/$$i; done
+test3:
+	-mkdir stage2
+	cp -rf lsp clos cmp stage2
+	-for i in lsp cmp clos clx tk; do test -f lib$$i.a && mv lib$$i.a stage2; done
+	make clean_lisp
+	./ecls < compile2.lsp
+	for i in lsp clos cmp clx tk; do test -d $$i && diff --exclude=\*.o $$i stage2/$$i; done
\ No newline at end of file
diff --git a/src/ansi-tests/GNU-GPL b/src/ansi-tests/GNU-GPL
new file mode 100644
index 000000000..39b03e9a2
--- /dev/null
+++ b/src/ansi-tests/GNU-GPL
@@ -0,0 +1,340 @@
+                    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
+
+        Appendix: 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/src/ansi-tests/Makefile.in b/src/ansi-tests/Makefile.in
new file mode 100644
index 000000000..f20d3cb36
--- /dev/null
+++ b/src/ansi-tests/Makefile.in
@@ -0,0 +1,29 @@
+top_srcdir=@top_srcdir@
+srcdir=@srcdir@
+
+RM=rm -fr
+MV=mv -f
+MKDIR=mkdir -p
+
+.PHONY: clisp sbcl normal safe ecls ecls_min
+
+ecls:
+	ln -sf ../../src/h/*.h ../h/
+	(echo '(load "$(srcdir)/tests")'; \
+	 echo '(setq si::*system-directory* "../")'; \
+	 echo "(run-all-tests \"$(srcdir)/\")"; \
+	 echo "(quit)") | ../ecls
+	true
+
+ecls_min:
+	ln -sf ../../src/h/*.h ../h/
+	(echo '(load "bare.lsp")'; \
+	 echo '(setq si::*system-directory* "../")'; \
+	 echo '(sys::chdir "ansi-tests")'; \
+	 echo '(load "$(srcdir)/tests")'; \
+	 echo "(run-all-tests \"$(srcdir)/\")"; \
+	 echo "(quit)") | (cd ..; ./ecls_min)
+	true
+
+clean:
+	$(RM) *.erg *.o *.c *.h *.data
\ No newline at end of file
diff --git a/src/ansi-tests/README b/src/ansi-tests/README
new file mode 100644
index 000000000..89bd64e90
--- /dev/null
+++ b/src/ansi-tests/README
@@ -0,0 +1,28 @@
+This is a bunch of tests to test if a Common Lisp implementation
+conforms to Ansi standard X3J13 for Common Lisp.
+
+It is largely based on the clisp test-suite, examples from the HyperSpec and
+bugreports.
+
+This is a work in progress.
+
+Even though it's in the clocc package, the ansi-tests system
+is a standalone system. It can run without having anything else
+from clocc available; all you need is the ansi-test/ directory.
+
+There is a Makefile that should sort-of-work, please look at it 
+and adapt it to your situation.
+
+To run the tests manually, start your Lisp in the ansi-test/ 
+directory and type
+(load "tests.lisp")
+at the command prompt.
+
+The tests produce output on the console, with failed tests
+marked with "ERROR!!". They also produce error output files
+with extensions ".erg", where every entry in such a file
+is from a failed test. Thus, if ansi-test thinks your Lisp
+is compliant, it will still produce a lot of output on the
+console, but no "ERROR!!" messages; and it will produce
+only empty ".erg" files (that should get deleted away).
+
diff --git a/src/ansi-tests/alltest.lisp b/src/ansi-tests/alltest.lisp
new file mode 100644
index 000000000..7b5684c9b
--- /dev/null
+++ b/src/ansi-tests/alltest.lisp
@@ -0,0 +1,3309 @@
+;;; based on v1.7 -*- mode: lisp -*-
+;; ****************************************************************************
+;; *                      kurztest        xcl                                 *
+;; ****************************************************************************
+;; kap. 1 einfuehrung
+;; ----------------------------------------------------------------------------
+;; kap. 2  datentypen
+;; ----------------------------------------------------------------------------
+;; kap. 3  gueltigkeitsbereiche
+;; ----------------------------------------------------------------------------
+;; kap. 4  typspezifier
+;; ----------------------------------------------------------------------------
+;;
+;; deftype, coerce, type-of
+;;
+;; kap. 5  programmstrukturen
+;; ----------------------------------------------------------------------------
+;;
+;; lambda-listen
+(in-package :cl-user)
+
+(my-assert
+ ((lambda (a b)
+    (+ a (* b 3)))
+  4 5)
+ 19)
+
+(my-assert
+ ((lambda (a &optional (b 2))
+    (+ a (* b 3)))
+  4 5)
+ 19)
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x)
+    (list a b c d x)))
+ (2 nil 3 nil nil))
+
+(my-assert
+ ((lambda (a b &key c d)
+    (list a b c d))
+  1 2)
+ (1 2 nil nil))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x))
+  1)
+ (1 3 nil 1 nil))
+
+(my-assert
+ ((lambda (x &aux (a 3) (b 4))
+    (+ x (* a b)))
+  2)
+ 14)
+
+(my-assert
+ ((lambda (x y &optional a b &rest z &key c (d y) &aux (u 3) (v 4))
+    (+ x y a (* b (car z)) c (* d u) v))
+  3 4 5 2 7 :c 6 :d 8)
+ error)
+
+(my-assert
+ ((lambda (x y)
+    ((lambda (a b)
+       (list a b))
+     'u 'v))
+  5 6)
+ (u v))
+
+(my-assert
+ ((lambda (x &allow-other-keys)
+    (list x y))
+  2 :y 3)
+ error)
+
+(my-assert
+ lambda-list-keywords
+ #+xcl (&optional &rest &key &allow-other-keys &aux &body &whole system::&environment)
+ #+clisp (&optional &rest &key &allow-other-keys &aux &body &whole &environment)
+ #+(or akcl ecls)
+ (&optional &rest &key &allow-other-keys &aux &whole &environment &body)
+ #+(or allegro cmu sbcl)
+ (&optional &rest &key &aux &body &whole &allow-other-keys &environment)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (let ((s (prin1-to-string lambda-parameters-limit )))
+   (or #+xcl (equal s "128")
+       #+clisp (equal s "65536")
+       #+clisp (equal s "4294967296")
+       #+akcl (equal s "64")
+       #+allegro (equal s "16384")
+       #+(or cmu sbcl sbcl) (equal s "536870911")
+       ) )
+ t)
+
+;; defvar, defconstant, defparameter, eval-when
+
+;; kap 6 praedikate
+;; ----------------------------------------------------------------------------
+
+(my-assert
+ (typep 'nil 'null)
+ t)
+
+(my-assert
+ (typep (list 'a 'b 'c) 'null)
+ nil)
+
+(my-assert
+ (typep 'abc 'symbol)
+ t)
+
+(my-assert
+ (typep 4 'atom)
+ t)
+
+(my-assert
+ (typep 55 'cons)
+ nil)
+
+(my-assert
+ (typep (list 'a (list 'b 'c)) 'list)
+ t)
+
+(my-assert
+ (typep 5/8 'number)
+ t)
+
+(my-assert
+ (typep -800 'integer)
+ t)
+
+(my-assert
+ (typep 5/7 'rational)
+ t)
+
+(my-assert
+ (typep 2.718 'float)
+ t)
+
+(my-assert
+ (typep #c(1.23 3.56) 'float)
+ nil)
+
+(my-assert
+ (typep #\a 'character)
+ t)
+
+(my-assert
+ (typep "abc" 'string)
+ t)
+
+(my-assert
+ (typep '#(1 2 3) 'string)
+ nil)
+
+(my-assert
+ (typep '#(a b c) 'bit-vector)
+ nil)
+
+(my-assert
+ (typep '#(a b c) 'vector)
+ t)
+
+(my-assert
+ (typep "abc" 'vector)
+ t)
+
+(my-assert
+ (typep '#(1 2 3 4) 'simple-vector)
+ t)
+
+(my-assert
+ (typep 3 'simple-vector)
+ nil)
+
+(my-assert
+ (typep "a b cd" 'simple-string)
+ t)
+
+(my-assert
+ (typep 'abc 'simple-string)
+ nil)
+
+(my-assert
+ (typep #*1101 'simple-bit-vector)
+ t)
+
+(my-assert
+ (typep '#(1 0 0 1) 'simple-bit-vector)
+ nil)
+
+(my-assert
+ (typep '#2a((a b)(c d)) 'array)
+ t)
+
+(my-assert
+ (setq x 7)
+ 7)
+
+(my-assert
+ (typep x 'compiled-function)
+ nil)
+
+(my-assert
+ (typep x 'common)
+ error)
+
+(unintern 'x)
+
+(my-assert
+ (subtypep 'character 'number)
+ nil)
+
+(my-assert
+ (subtypep 'number 'character)
+ nil)
+
+(my-assert
+ (subtypep 'string 'number)
+ nil)
+
+(my-assert
+ (subtypep 'complex 'number)
+ t)
+
+(my-assert
+ (subtypep 'float 'number)
+ t)
+
+(my-assert
+ (subtypep 'fixnum 'number)
+ t)
+
+(my-assert
+ (subtypep 'rational 'number)
+ t)
+
+(my-assert
+ (subtypep 'float 'complex)
+ nil)
+
+(my-assert
+ (subtypep 'integer 'rational)
+ t)
+
+(my-assert
+ (subtypep 'number 'vector)
+ nil)
+
+(my-assert
+ (subtypep 'vector 'array)
+ t)
+
+(my-assert
+ (subtypep 'number 'array)
+ nil)
+
+(my-assert
+ (null 'nil)
+ t)
+
+(my-assert
+ (symbolp *standard-input*)
+ nil)
+
+(my-assert
+ (symbolp 'car)
+ t)
+
+(my-assert
+ (atom 'abc)
+ t)
+
+(my-assert
+ (consp (acons 'x 'y 'a))
+ #+xcl error
+ #+(or clisp akcl allegro cmu sbcl sbcl ecls) t
+ #-(or xcl clisp akcl allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ (listp (list (append (cons 'a 'b) 'c)))
+ t)
+
+(my-assert
+ (listp 'a)
+ nil)
+
+(my-assert
+ (listp nil)
+ t)
+
+(my-assert
+ (listp '(a b c))
+ t)
+
+(my-assert
+ (numberp #*101)
+ nil)
+
+(my-assert
+ (numberp -5)
+ t)
+
+(my-assert
+ (integerp 5)
+ t)
+
+(my-assert
+ (integerp #\+)
+ nil)
+
+(my-assert
+ (rationalp 0)
+ t)
+
+(my-assert
+ (floatp -5)
+ nil)
+
+(my-assert
+ (floatp (read-from-string "1.0e30"))
+ t)
+
+(my-assert
+ (floatp 123.4)
+ t)
+
+(my-assert
+ (complexp 1/2)
+ nil)
+
+(my-assert
+ (complexp #c(2 3))
+ t)
+
+(my-assert
+ (characterp #\1)
+ t)
+
+(my-assert
+ (stringp "abc")
+ t)
+
+(my-assert
+ (stringp :+*/-)
+ nil)
+
+(my-assert
+ (bit-vector-p (read-from-string "#5*01110"))
+ t)
+
+(my-assert
+ (vectorp "abc")
+ t)
+
+(my-assert
+ (simple-vector-p #*101)
+ nil)
+
+(my-assert
+ (simple-string-p "abc")
+ t)
+
+(my-assert
+ (simple-string-p :+*/-)
+ nil)
+
+(my-assert
+ (simple-bit-vector-p #*101)
+ t)
+
+(my-assert
+ (arrayp (read-from-string "#7(2 4 3)"))
+ t)
+
+(my-assert
+ (arrayp '(read-from-string "#1a 5.77"))
+ nil)
+
+(my-assert
+ (packagep (read-from-string "#5*01110"))
+ nil)
+
+(my-assert
+ (packagep *package*)
+ t)
+
+(my-assert
+ (functionp 'atom)
+ #-(or cltl2 clisp) t
+ #+(or cltl2 clisp) nil)
+
+(my-assert
+ (compiled-function-p 'do)
+ nil)
+
+;; commonp
+
+(my-assert
+ (eq (list 1 2 3 4 5)
+     (copy-list (list 1 2 3 4 5)))
+ nil)
+
+(my-assert
+ (setq x (list (cons 1 'a) (cons 2 'b) (cons 3 'c)) )
+ ((1 . a) (2 . b) (3 . c)))
+
+(my-assert
+ (eq (cadr x) (cadr (copy-alist x)))
+ nil)
+
+(unintern 'x)
+
+(my-assert
+ (eq #\a #\a)
+ t)
+
+(my-assert
+ (booleanp (eq "Foo" "Foo"))
+ t)
+
+(my-assert
+ (eq "Foo" (copy-seq "Foo"))
+ nil)
+
+(my-assert
+ (eql #c(3.0 -4.0) #c(3 -4))
+ nil)
+
+(my-assert
+ (eql (cons 'a 'b) (cons 'a 'c))
+ nil)
+
+(my-assert
+ (equal (list 1 2 3 4 5) (copy-list (list 1 2 3 4 5)))
+ t)
+
+(my-assert
+ (equal x (copy-alist x))
+ t)
+
+(my-assert
+ (equal 3 3)
+ t)
+
+(my-assert
+ (equal 3 3.0)
+ nil)
+
+(my-assert
+ (equal 3.0 3.0)
+ t)
+
+(my-assert
+ (equal #c(3 -4) #c(3 -4))
+ t)
+
+(my-assert
+ (equalp (list 1 2 3 4 5) (copy-list (list 1 2 3 4 5)))
+ t)
+
+(my-assert
+ (equalp "            foo" "            FOO")
+ t)
+
+(my-assert
+ (equalp "            fou" "            FOO")
+ nil)
+
+(my-assert
+ (not 1)
+ nil)
+
+(my-assert
+ (not nil)
+ t)
+
+(my-assert
+ (and (eq 1 2) (eq 2 3) (eq 3 4) (eq 4 4))
+ nil)
+
+(my-assert
+ (and (eq 1 2) (eq 3 3) (eq 3 4) (eq 4 4))
+ nil)
+
+(my-assert
+ (or (eq 2 2) (eq 3 3) (eq 3 4) (eq 4 4))
+ t)
+
+(my-assert
+ (or (eq 1 2) (eq 2 3) (eq 3 4) (eq 4 5))
+ nil)
+
+;; kap 7 kontrollstructuren
+;; ----------------------------------------------------------------------------
+
+;;  quote, function, symbol-value, symbol-function, boundp, fboundp,
+;;  special-form-p, setq, psetq, set, makunbound, fmakunbound,
+
+(my-assert
+ (setq li1 (list 'a (list 'b)
+		 (list (list 'c)
+		       (list 'd))))
+ (a (b) ((c) (d))))
+
+(my-assert
+ (setq vec1 (vector 0 1 2 3))
+ #(0 1 2 3))
+
+(my-assert
+ (setf (nth 1 li1) 'uu)
+ uu)
+
+(my-assert
+ (eval 'li1)
+ (a uu ((c) (d))))
+
+(my-assert
+ (setf (elt li1 1) 'oo)
+ oo)
+
+(my-assert
+ (setf (elt vec1 1) 'oo)
+ oo)
+
+(my-assert
+ (eval 'li1)
+ (a oo ((c) (d))))
+
+(my-assert
+ (eval 'vec1)
+ #(0 oo 2 3))
+
+(my-assert
+ (setf (rest li1) '((ww)))
+ ((ww)))
+
+(my-assert
+ (eval 'li1)
+ (a (ww)))
+
+(my-assert
+ (setf (first li1) 'aa)
+ aa)
+
+(my-assert
+ (first li1)
+ aa)
+
+(my-assert
+ (setf (second li1) 'bb)
+ bb)
+
+(my-assert
+ (eval 'li1)
+ (aa bb))
+
+(my-assert
+ (setf (rest li1) (list 2 3 4 5 6 7 8 9 10))
+ (2 3 4 5 6 7 8 9 10))
+
+(my-assert
+ (setf (second li1) 22)
+ 22)
+
+(my-assert
+ (eval 'li1)
+ (aa 22 3 4 5 6 7 8 9 10))
+
+(my-assert
+ (setf (third li1) '33)
+ 33)
+
+(my-assert
+ (setf (fourth li1) '44)
+ 44)
+
+(my-assert
+ (setf (fifth li1) '55)
+ 55)
+
+(my-assert
+ (setf (sixth li1) '66)
+ 66)
+
+(my-assert
+ (setf (seventh li1) '77)
+ 77)
+
+(my-assert
+ (setf (eighth li1) '88)
+ 88)
+
+(my-assert
+ (setf (ninth li1) '99)
+ 99)
+
+(my-assert
+ (setf (tenth li1) '1010)
+ 1010)
+
+(my-assert
+ (eval 'li1)
+ (aa 22 33 44 55 66 77 88 99 1010))
+
+(my-assert
+ (setf (first li1) '(((a))))
+ (((a))))
+
+(my-assert
+ (setf (caaar li1) 'uu)
+ uu)
+
+(my-assert
+ (caaar li1)
+ uu)
+
+(my-assert
+ (car li1)
+ ((uu)))
+
+(my-assert
+ (setf (caar li1) 'oo)
+ oo)
+
+(my-assert
+ (eval 'li1)
+ ((oo) 22 33 44 55 66 77 88 99 1010))
+
+(my-assert
+ (setf (car li1) 'ii)
+ ii)
+
+(my-assert
+ (eval 'li1)
+ (ii 22 33 44 55 66 77 88 99 1010))
+
+(my-assert
+ (setf (cdddr li1) 'pp)
+ pp)
+
+(my-assert
+ (eval 'li1)
+ (ii 22 33 . pp))
+
+(my-assert
+ (setf (caddr li1) '333)
+ 333)
+
+(my-assert
+ (eval 'li1)
+ (ii 22 333 . pp))
+
+(my-assert
+ (setf (svref vec1 2) 'kk)
+ kk)
+
+(my-assert
+ (eval 'vec1)
+ #(0 oo kk 3))
+
+(unintern 'vec1)
+(unintern 'li1)
+
+(my-assert
+ (setf (get 'a 'b) 'uu)
+ uu)
+
+(my-assert
+ (get 'a 'b)
+ uu)
+
+(my-assert
+ (setf (getf
+	(cadr
+	 (setq xx
+	       (list 'aaa
+		     (list 'i1 'v1 'i2 'v2))))
+	'i2)
+       'v222)
+ v222)
+
+(my-assert
+ (eval 'xx)
+ (aaa (i1 v1 i2 v222)))
+
+(my-assert
+ (getf (cadr xx) 'i2)
+ v222)
+
+(my-assert
+ (getf (cadr xx) 'i1)
+ v1)
+
+(unintern 'xx)
+
+(my-assert
+ (setf (documentation 'beispiel 'typ1) "doc 1")
+ "doc 1")
+
+(my-assert
+ (setf (documentation 'beispiel 'typ2) "doc 2")
+ "doc 2")
+
+(my-assert
+ (documentation 'beispiel 'typ2)
+ #+xcl (typ2 . "doc 2")
+ #-xcl "doc 2")
+
+(my-assert
+ (setf (documentation 'beispiel 'typ2) "doc 3")
+ "doc 3")
+
+(my-assert
+ (documentation 'beispiel 'typ2)
+ #+xcl (typ2 . "doc 3")
+ #-xcl "doc 3")
+
+(my-assert
+ (symbol-plist 'beispiel)
+ #+xcl (documentation ((typ2 . "doc 3") (typ1 . "doc 1")))
+ #+clisp (system::documentation-strings (typ2 "doc 3" typ1 "doc 1"))
+ #+allegro (excl::%documentation ((typ2 . "doc 3") (typ1 . "doc 1")))
+ #+(or cmu sbcl ecls) nil
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ (setf (symbol-value 'xx) 'voelligneu)
+ voelligneu)
+
+(my-assert
+ (eval 'xx)
+ voelligneu)
+
+(unintern 'xx)
+
+;; psetf, shiftf, rotatef, define-modify-macro, defsetf, define-setf-method,
+;; get-setf-method, get-setf-method-multiple-value, apply, funcall, progn,
+;; prog1, prog2,
+
+(my-assert
+ (let ((x (list 'a 'b 'c)))
+   (rplacd (last x) x)
+   (list-length x))
+ nil)
+
+;; let*, compiler-let, progv, flet, labels, macrolet, if, when, unless, cond,
+;; case, typecase, block, loop, do, do*, dolist, dotimes,
+
+(my-assert
+ (mapcar (function (lambda (x) (list x))) (list 'a 'b 'c))
+ ((a) (b) (c)))
+
+(my-assert
+ (mapc (function
+	(lambda (x y z)
+	  (list x y z)))
+       (list 'a 'b 'c)
+       (list 1 2 3)
+       (list 'u 'i 'v))
+ (a b c))
+
+(my-assert
+ (mapl (function (lambda (x y z) (list x y z))) (list 'a 'b 'c) (list 1 2 3)
+       (list 'u 'i 'v))
+ (a b c))
+
+(my-assert
+ (maplist (lambda (x y z) (list x y z))
+	  (list 'a 'b 'c)
+	  (list 1 2 3)
+	  (list 'u 'i 'v))
+ (((a b c) (1 2 3) (u i v)) ((b c) (2 3) (i v)) ((c) (3) (v))))
+
+(my-assert
+ (mapcon (lambda (x y z) (list x y z))
+	 (list 'a 'b)
+	 (list 1 2 3)
+	 (list 'u 'i 'v))
+ ((a b) (1 2 3) (u i v) (b) (2 3) (i v)))
+
+(my-assert
+ (mapcan (lambda (x y z) (list x y z))
+	 (list 'a 'b 'c)
+	 (list 1 2 3)
+	 (list 'u 'i 'v))
+ (a 1 u b 2 i c 3 v))
+
+;; tagbody, go, multiple-value-list, multiple-value-call, multiple-value-prog1,
+;; multiple-value-bind, multiple-value-setq, values, values-list, catch,
+
+;; unwind-protect, throw,
+
+;; kap 8 macros
+;; ----------------------------------------------------------------------------
+
+;; macro-function, defmacro, macroexpand, macroexpand-1,
+
+;; kap 9 declarationen
+;; ----------------------------------------------------------------------------
+
+;; declare, locally, proclaim, the,
+
+;; kap 10 symbole
+;; ----------------------------------------------------------------------------
+
+;; get, remprop, symbol-plist, getf, remf, get-properties, symbol-name,
+
+;; make-symbol, copy-symbol, gensym, gentemp, symbol-package,
+
+(my-assert
+ (keywordp 36)
+ nil)
+
+(my-assert
+ (keywordp :rename)
+ t)
+
+;; kap 11 pakete
+;; ----------------------------------------------------------------------------
+
+;; find-package, in-package, list-all-packages, make-package, package-name,
+;; package-nicknames, package-shadowing-symbols, package-use-list,
+;; package-used-by-list, rename-package, unuse-package, use-package, intern,
+;; unintern, find-symbol, export, unexport, import, shadowing-import, shadow,
+;; find-all-symbols, do-symbols, do-external-symbols, do-all-symbols,
+;; provide, require,
+
+;; kap 12 zahlen
+;; ----------------------------------------------------------------------------
+
+(my-assert
+ (zerop -456)
+ nil)
+
+(my-assert
+ (zerop 0)
+ t)
+
+(my-assert
+ (plusp 3)
+ t)
+
+(my-assert
+ (plusp 3453786543987565)
+ t)
+
+(my-assert
+ (minusp -456)
+ t)
+
+(my-assert
+ (oddp -1)
+ t)
+
+(my-assert
+ (oddp 0)
+ nil)
+
+(my-assert
+ (evenp -456)
+ t)
+
+(my-assert
+ (evenp -345)
+ nil)
+
+(my-assert
+ (= 5/2 2.5)
+ t)
+
+(my-assert
+ (/= 3.0 3)
+ nil)
+
+(my-assert
+ (/= 3.0 #c(3.0 1.0))
+ t)
+
+(my-assert
+ (< 3.0 3)
+ nil)
+
+(my-assert
+ (< 3 3.0 3 #c(3.0 0.0))
+ #+(or allegro cmu sbcl sbcl) nil
+ #-(or allegro cmu sbcl sbcl) error)
+
+(my-assert
+ (< -5 -4 -2 0 4 5)
+ t)
+
+(my-assert
+ (> 8 7 6 5 4)
+ t)
+
+(my-assert
+ (> 3 3.0 3 #c(3.0 0.0))
+ #+(or allegro cmu sbcl sbcl) nil
+ #-(or allegro cmu sbcl sbcl) error)
+
+(my-assert
+ (<= 3.0 3)
+ t)
+
+(my-assert
+ (<= 3 3)
+ t)
+
+(my-assert
+ (<= 1 3 3 2 5)
+ nil)
+
+(my-assert
+ (<= 5/2 2.5)
+ t)
+
+(my-assert
+ (>= -5 -4 -2 0 4 5)
+ nil)
+
+(my-assert
+ (max 1 3 2 -7)
+ 3)
+
+;; min,
+
+(my-assert
+ (+ 1 1/2 0.5 #c(3.0 5.5))
+ #c(5.0 5.5))
+
+(my-assert
+ (- 3 0 3 5 -6)
+ 1)
+
+(my-assert
+ (- #c(0 6) 1/4 0.5 7)
+ #c(-7.75 6.0))
+
+(my-assert
+ (* 7 6 5 4 3 2 1)
+ 5040)
+
+(my-assert
+ (* 2 2 2.0 2)
+ 16.0)
+
+(my-assert
+ (/ -8)
+ -1/8)
+
+(my-assert
+ (/ 4 2)
+ 2)
+
+(my-assert
+ (1+ 0)
+ 1)
+
+(my-assert
+ (1+ #c(0 1))
+ #c(1 1))
+
+(my-assert
+ (1- 5.0)
+ 4.0)
+
+;; incf, decf,
+
+(my-assert
+ (conjugate #c(3/5 4/5))
+ #c(3/5 -4/5))
+
+(my-assert
+ (gcd 91 -49)
+ 7)
+
+(my-assert
+ (lcm 14 35)
+ 70)
+
+(my-assert
+ (prin1-to-string (exp 1) )
+ "2.7182817")				; "2.718282"
+
+(my-assert
+ (expt #c(0 1) 2)
+ -1)
+
+(my-assert
+ (prin1-to-string (expt 2 #c(0 1)) )
+ "#C(0.7692389 0.63896126)")		; "#C(0.7692389 0.6389612)"
+
+(my-assert
+ (prin1-to-string (log -3 10) )
+ "#C(0.47712126 1.3643764)")		; "#C(0.4771213 1.364376)"
+
+(my-assert
+ (log 3 0)
+ #+(or xcl cmu sbcl sbcl) 0
+ #+allegro 0.0
+ #-(or xcl allegro cmu sbcl sbcl) error)
+
+(my-assert
+ (sqrt 9)
+ 3.0)
+
+(my-assert
+ (sqrt -9.0)
+ #c(0.0 3.0))
+
+(my-assert
+ (isqrt 9)
+ 3)
+
+(my-assert
+ (isqrt 26)
+ 5)
+
+(my-assert
+ (abs 6)
+ 6)
+
+(my-assert
+ (abs -6)
+ 6)
+
+;; phase,
+
+(my-assert
+ (signum 0)
+ 0)
+
+(my-assert
+ (signum -4)
+ -1)
+
+(my-assert
+ (signum 4)
+ 1)
+
+(my-assert
+ (prin1-to-string (sin (* 8 (/ pi 2))) )
+ #+xcl "-4.576950980887866D-17"
+ #+clisp "2.0066230454737344098L-19"
+ #+akcl "-4.898425415289509E-16"
+ #+(or allegro cmu sbcl sbcl ecls) "-4.898425415289509d-16"
+ #-(or xcl clisp akcl allegro cmu sbcl  ecls) unknown)
+
+(my-assert
+ (prin1-to-string (sin (expt 10 3)) )
+ "0.82687956")				; "0.8268796"
+
+(my-assert
+ (cos 0)
+ 1.0)
+
+(my-assert
+ (prin1-to-string (cos (/ pi 2)) )
+ #+xcl "5.721188726109832D-18"
+ #+clisp "-2.5082788076048218878L-20"
+ #+akcl "6.1230317691118863E-17"
+ #+(or allegro cmu sbcl sbcl ecls) "6.123031769111886d-17"
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string (tan 1) )
+ "1.5574077")				; "1.557408"
+
+(my-assert
+ (prin1-to-string (tan (/ pi 2)) )
+ #+xcl "1.747888503373944D17"
+ #+clisp "-3.986797629004264116L19"
+ #+akcl "1.6331778728383844E16"
+ #+ecls "1.6331778728383844d16"
+ #+(or allegro cmu sbcl sbcl) "1.6331778728383844d+16"
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string (cis -1) )
+ "#C(0.5403023 -0.84147096)")		; "#C(0.5403023 -0.8414709)"
+
+(my-assert
+ (cis 2.5)
+ #c(-0.8011436 0.5984721))
+
+(my-assert
+ (prin1-to-string (asin -1) )
+ "-1.5707964")				; "-1.570796"
+
+(my-assert
+ (asin 0)
+ 0.0)
+
+(my-assert
+ (asin 2)
+ #+(or cmu sbcl sbcll)
+ #c(1.5707964 -1.3169578)
+ #-(or cmu sbcl sbcll)
+ #c(1.5707964 -1.316958))
+
+(my-assert
+ (prin1-to-string (acos 0) )
+ "1.5707964")				; "1.570796"
+
+(my-assert
+ (prin1-to-string (acos -1) )
+ "3.1415927")				; "3.141593"
+
+(my-assert
+ (prin1-to-string (acos 2) )
+ #+xcl
+ "#C(0.0 1.316958)"
+ #+clisp
+ "#C(0 1.316958)"
+ #+allegro
+ "#c(0.0 1.316958)"
+ #+(or cmu sbcl sbcl ecls)
+ "#C(0.0 1.3169578)"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (acos 1.00001)
+ #+ganz-korrekt
+ #c(0.0 0.0044721322)
+ #+xcl
+ #c(0.0 0.004475157)
+ #+clisp-korrekt
+ #c(0.0 0.0044751678)	; da schon 1.00001 gerundet wurde
+ #+clisp
+ #c(0.0 0.0044751023)	; i * ln(x+sqrt(x^2-1))
+ #+clisp-anders
+ #c(0.0 0.0044752206)	; i * ln(x+sqrt((x-1)*(x+1)))
+ #+allegro
+ #c(0.0 0.004475168)
+ #+(or cmu sbcl sbcll)
+ #c(0.0 0.0044751678)
+ #-(or xcl clisp allegro cmu sbcl sbcl)
+ #c(0.0 0.0044721322))
+
+(my-assert
+ (atan 1)
+ #+(or xcl allegro cmu sbcl sbcl ecls) 0.7853982
+ #+clisp 0.7853981
+ #-(or xcl allegro clisp cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string pi )
+ #+xcl "3.141592653589793D0"
+ #+clisp "3.1415926535897932385L0"
+ #+(or allegro cmu sbcl sbcl ecls) "3.141592653589793d0"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (sinh 0)
+ 0.0)
+
+(my-assert
+ (prin1-to-string (sinh #c(5.0 -9.6)) )
+ #+(or cmu sbcl sbcll)
+ "#C(-73.06699 12.936809)"
+ #-(or cmu sbcl sbcll)
+ "#C(-73.06699 12.93681)")
+
+(my-assert
+ (cosh 0)
+ 1.0)
+
+(my-assert
+ (prin1-to-string (cosh 1) )
+ #+(or cmu sbcl sbcll) "1.5430807"	; round-off error
+ #-(or cmu sbcl sbcll) "1.5430806")	; "1.543081"
+
+(my-assert
+ (tanh 50)
+ 1.0)
+
+(my-assert
+ (prin1-to-string (tanh 0.00753) )
+ #-allegro "0.0075298576"
+ #+allegro "0.0075298795")		; "0.007529857"
+
+(my-assert
+ (prin1-to-string (asinh 0.5) )
+ #-(or allegro cmu sbcl sbcl) "0.48121184"
+ #+(or allegro cmu sbcl sbcl) "0.4812118") ; "0.4812118"
+
+(my-assert
+ (prin1-to-string (asinh 3/7) )
+ #-(or clisp allegro cmu sbcl sbcl) "0.4164308"
+ #+clisp "0.4164307"			; rundungsfehler
+ #+(or allegro cmu sbcl sbcl) "0.41643077")
+
+(my-assert
+ (acosh 0)
+ #c(0 1.5707964))
+
+(my-assert
+ (acosh 1)
+ 0)
+
+(my-assert
+ (acosh -1)
+ #c(0 3.1415927))
+
+(my-assert
+ (prin1-to-string (atanh 0.5) )
+ "0.54930615")				; "0.5493061"
+
+(my-assert
+ (prin1-to-string (atanh 3/7) )
+ #-(or clisp allegro cmu sbcl sbcl) "0.4581454"
+ #+clisp "0.4581453"			; rundungsfehler
+ #+(or allegro cmu sbcl sbcl) "0.45814538")
+
+(my-assert
+ (= (sin (* #c(0 1) 5)) (* #c(0 1) (sinh 5)))
+ t)
+
+(my-assert
+ (= (cos (* #c(0 1) 5)) (cosh 5))
+ t)
+
+(my-assert
+ (= (tan (* #c(0 1) 5)) (* #c(0 1) (tanh 5)))
+ t)
+
+(my-assert
+ (= (sinh (* #c(0 1) 5)) (* #c(0 1) (sin 5)))
+ t)
+
+(my-assert
+ (= (cosh (* #c(0 1) 5)) (cos 5))
+ t)
+
+(my-assert
+ (float 1)
+ 1.0)
+
+(my-assert
+ (float 0.5)
+ 0.5)
+
+(my-assert
+ (rational 2)
+ 2)
+
+(my-assert
+ (rational 2.0)
+ 2)
+
+(my-assert
+ (rational 2.5)
+ 5/2)
+
+(my-assert
+ (rationalize 2.5)
+ 5/2)
+
+(my-assert
+ (rationalize 7/3)
+ 7/3)
+
+(my-assert
+ (rationalize pi)
+ #+xcl 28296953155597409/9007199254740992
+ #+clisp 8717442233/2774848045
+ #+ecls 884279719003555/281474976710656
+ #+(or allegro cmu sbcl sbcl) 245850922/78256779
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ (numerator 5/2)
+ 5)
+
+(my-assert
+ (numerator (/ 8 -6))
+ -4)
+
+(my-assert
+ (denominator 5/2)
+ 2)
+
+(my-assert
+ (denominator (/ 8 -6))
+ 3)
+
+(my-assert
+ (gcd (numerator 7/9) (denominator 7/9))
+ 1)
+
+(my-assert
+ (floor 2.6)
+ 2)
+
+(my-assert
+ (floor 2.5)
+ 2)
+
+(my-assert
+ (ceiling 2.6)
+ 3)
+
+(my-assert
+ (ceiling 2.5)
+ 3)
+
+(my-assert
+ (ceiling 2.4)
+ 3)
+
+(my-assert
+ (truncate 2.6)
+ 2)
+
+(my-assert
+ (truncate 2.5)
+ 2)
+
+(my-assert
+ (truncate 2.4)
+ 2)
+
+(my-assert
+ (round 2.6)
+ 3)
+
+(my-assert
+ (round 2.5)
+ 2)
+
+(my-assert
+ (round 2.4)
+ 2)
+
+(my-assert
+ (mod 13 4)
+ 1)
+
+(my-assert
+ (mod -13 4)
+ 3)
+
+(my-assert
+ (prin1-to-string (rem 13.4 1) )
+ #-(or clisp allegro cmu sbcl sbcl) "0.4" ;
+ #+xcl "0.3999996"
+ #+(or clisp allegro cmu sbcl sbcl) "0.39999962") ; rundungsfehler
+
+(my-assert
+ (ffloor 2.6)
+ 2)
+
+(my-assert
+ (ffloor 2.5)
+ 2)
+
+(my-assert
+ (ffloor 2.4)
+ 2)
+
+(my-assert
+ (fceiling -0.3)
+ 0)
+
+(my-assert
+ (fceiling -0.7)
+ 0)
+
+(my-assert
+ (fceiling -2.4)
+ -2)
+
+(my-assert
+ (ftruncate 2.5)
+ 2.0)
+
+(my-assert
+ (ftruncate 2.4)
+ 2.0)
+
+(my-assert
+ (fround -0.7)
+ -1.0)
+
+(my-assert
+ (fround -2.4)
+ -2.0)
+
+(my-assert
+ (decode-float 35.0)
+ 0.546875)
+
+(my-assert
+ (decode-float 3.5s0)
+ 0.875s0)
+
+(my-assert
+ (scale-float 2.5 5)
+ 80.0)
+
+(my-assert
+ (scale-float 0.7541 2)
+ 3.0164)
+
+(my-assert
+ (float-radix 2.5)
+ 2)
+
+(my-assert
+ (float-radix 3.5d0)
+ 2)
+
+;; float-digits, float-precision, float-sign, integer-decode-float,
+
+(my-assert
+ (complex 1/4 7.3)
+ #c(0.25 7.3))
+
+(my-assert
+ (complex 1 0)
+ 1)
+
+(my-assert
+ (realpart 5)
+ 5)
+
+(my-assert
+ (realpart #c(1.4 0.0))
+ 1.4)
+
+(my-assert
+ (imagpart 5)
+ 0)
+
+(my-assert
+ (imagpart #c(1.4 0.0))
+ 0.0)
+
+;; logand, logandc1, logandc2, logeqv, logior, lognand, lognor, lognot,
+;; logorc1, logorc2, logtest, logxor, logbitp, ash,
+
+(my-assert
+ (logcount 13)
+ 3)
+
+(my-assert
+ (logcount -13)
+ 2)
+
+(my-assert
+ (integer-length 0)
+ 0)
+
+(my-assert
+ (integer-length 1)
+ 1)
+
+;; byte, byte-position, byte-size, ldb, ldb-test, mask-field, dpb, deposit-field,
+
+;; random,
+
+#+xcl
+(my-assert
+ (random-state-p
+  (eval (read-from-string "(sys::%set-type-pointer sys::%type-random-state 1)")))
+ t)
+
+;; make-random-state,
+
+(my-assert
+ boole-clr
+ 0)
+
+(my-assert
+ boole-set
+ #+(or xcl allegro cmu sbcl sbcl) 1
+ #+(or clisp ecls) 15
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ boole-1
+ #+(or xcl allegro cmu sbcl sbcl) 2
+ #+clisp 10
+ #+ecls 3
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ boole-2
+ #+(or xcl allegro cmu sbcl sbcl) 3
+ #+clisp 12
+ #+ecls 5
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ boole-c1
+ #+(or xcl allegro cmu sbcl sbcl) 4
+ #+clisp 5
+ #+ecls 12
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ boole-c2
+ #+(or xcl allegro cmu sbcl sbcl) 5
+ #+clisp 3
+ #+ecls 10
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ boole-and
+ #+(or xcl allegro cmu sbcl sbcl) 6
+ #+clisp 8
+ #+ecls 1
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ boole-ior
+ #+(or xcl allegro cmu sbcl sbcl) 7
+ #+clisp 14
+ #+ecls 7
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ boole-xor
+ #+(or xcl allegro cmu sbcl sbcl) 8
+ #+(or clisp ecls) 6
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ boole-eqv
+ #+(or xcl allegro cmu sbcl sbcl) 9
+ #+(or clisp ecls) 9
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ boole-nand
+ #+(or xcl allegro cmu sbcl sbcl) 10
+ #+clisp 7
+ #+ecls 14
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ boole-nor
+ #+(or xcl allegro cmu sbcl sbcl) 11
+ #+clisp 1
+ #+ecls 8
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ boole-andc1
+ #+(or xcl allegro cmu sbcl sbcl) 12
+ #+(or clisp ecls) 4
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ boole-andc2
+ #+(or xcl allegro cmu sbcl sbcl) 13
+ #+(or clisp ecls) 2
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ boole-orc1
+ #+(or xcl allegro cmu sbcl sbcl) 14
+ #+(or clisp ecls) 13
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ boole-orc2
+ #+(or xcl allegro cmu sbcl sbcl) 15
+ #+(or clisp ecls) 11
+ #-(or xcl clisp allegro cmu sbcl sbcl ecls) unknown)
+
+(my-assert
+ (let ((s (prin1-to-string most-positive-fixnum )))
+   (or #+(or xcl clisp) (equal s "16777215")
+       #+clisp (equal s "33554431")
+       #+clisp (equal s "67108863")
+       #+clisp (equal s "4294967295")
+       #+(or allegro cmu sbcl sbcl) (equal s "536870911")
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string most-negative-fixnum )))
+   (or #+(or xcl clisp) (equal s "-16777216")
+       #+clisp (equal s "-33554432")
+       #+clisp (equal s "-67108864")
+       #+clisp (equal s "-4294967296")
+       #+(or allegro cmu sbcl) (equal s "-536870912")
+       ) )
+ t)
+
+(my-assert
+ (prin1-to-string most-positive-short-float )
+ #+xcl "1.701S38"
+ #+clisp "1.7014s38"
+ #+allegro "3.4028232e+38"
+ #+(or cmu sbcl sbcll) "3.4028235e+38"
+ #+ecls "3.4028235e38"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string least-positive-short-float )
+ #+xcl "2.939S-39"
+ #+clisp "2.93874s-39"
+ #+(or allegro cmu sbcl sbcl) "1.4012985e-45"
+ #+ecls "1.401298E-45"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string least-negative-short-float )
+ #+xcl "-2.939S-39"
+ #+clisp "-2.93874s-39"
+ #+(or allegro cmu sbcl sbcl) "-1.4012985e-45"
+ #+ecls "-1.401298E-45"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string most-negative-short-float )
+ #+xcl "-1.701S38"
+ #+clisp "-1.7014s38"
+ #+allegro "-3.4028232e+38"
+ #+(or cmu sbcl sbcll) "-3.4028235e+38"
+ #+ecls "-3.402823E38"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (let ((s (prin1-to-string most-positive-single-float )))
+   (or #+xcl (equal s "1.701411E38")
+       #+clisp (equal s "1.7014117E38")
+       #+clisp (equal s "3.4028235E38")
+       #+allegro (equal s "3.4028232e+38")
+       #+(or cmu sbcl sbcll) (equal s "3.4028235e+38")
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string least-positive-single-float )))
+   (or #+(or xcl clisp) (equal s "2.938736E-39")
+       #+clisp (equal s "1.1754944E-38")
+       #+(or allegro cmu sbcl sbcl) (equal s "1.4012985e-45")
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string least-negative-single-float )))
+   (or #+(or xcl clisp) (equal s "-2.938736E-39")
+       #+clisp (equal s "-1.1754944E-38")
+       #+(or allegro cmu sbcl sbcl) (equal s "-1.4012985e-45")
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string most-negative-single-float )))
+   (or #+xcl (equal s "-1.701411E38")
+       #+clisp (equal s "-1.7014117E38")
+       #+clisp (equal s "-3.4028235E38")
+       #+allegro (equal s "-3.4028232e+38")
+       #+(or cmu sbcl sbcll) (equal s "-3.4028235e+38")
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string most-positive-double-float )))
+   (or #+xcl (equal s "1.701411834604692D38")
+       #+clisp (equal s "8.988465674311579d307")
+       #+clisp (equal s "1.7976931348623157d308")
+       #+allegro (equal s "4.494232837155787d+307")
+       #+(or cmu sbcl sbcll) (equal s "1.7976931348623157d+308")
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string least-positive-double-float )))
+   (or #+xcl (equal s "2.938735877055719D-39")
+       #+clisp (equal s "5.562684646268004d-309")
+       #+clisp (equal s "2.2250738585072014d-308")
+       #+allegro (equal s "4.9406564584124657d-324")
+       #+(or cmu sbcl sbcll) (equal s "4.940656458412465d-324")
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string least-negative-double-float )))
+   (or #+xcl (equal s "-2.938735877055719D-39")
+       #+clisp (equal s "-5.562684646268004d-309")
+       #+clisp (equal s "-2.2250738585072014d-308")
+       #+allegro (equal s "-4.9406564584124657d-324")
+       #+(or cmu sbcl sbcll) (equal s "-4.940656458412465d-324")
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string most-negative-double-float )))
+   (or #+xcl (equal s "-1.701411834604692D38")
+       #+clisp (equal s "-8.988465674311579d307")
+       #+clisp (equal s "-1.7976931348623157d308")
+       #+allegro (equal s "-4.494232837155787d+307")
+       #+(or cmu sbcl sbcll) (equal s "-1.7976931348623157d+308")
+       ) )
+ t)
+
+(my-assert
+ (prin1-to-string most-positive-long-float )
+ #+xcl "1.701411834604692D38"
+ #+clisp "8.8080652584198167656L646456992"
+ #+allegro "4.494232837155787d+307"
+ #+(or cmu sbcl sbcll) "1.7976931348623157d+308"
+ #+ecls "1.797693134862316d308"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string least-positive-long-float )
+ #+xcl "2.938735877055719D-39"
+ #+clisp "5.676615526003731344L-646456994"
+ #+allegro "4.9406564584124657d-324"
+ #+(or cmu sbcl ecls) "4.940656458412465d-324"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string least-negative-long-float )
+ #+xcl "-2.938735877055719D-39"
+ #+clisp "-5.676615526003731344L-646456994"
+ #+allegro "-4.9406564584124657d-324"
+ #+(or cmu sbcl ecls) "-4.940656458412465d-324"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string most-negative-long-float )
+ #+xcl "-1.701411834604692D38"
+ #+clisp "-8.8080652584198167656L646456992"
+ #+allegro "-4.494232837155787d+307"
+ #+(or cmu sbcl sbcll) "-1.7976931348623157d+308"
+ #+ecls "-1.797693134862316d308"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string short-float-epsilon )
+ #+xcl "1.526S-5"
+ #+clisp "7.6295s-6"
+ #+allegro "1.1920929e-7"
+ #+(or cmu sbcl sbcll) "5.960465e-8"
+ #+ecls "6.258487E-8"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string single-float-epsilon )
+ #+xcl "5.960464E-8"
+ #+clisp "5.960465E-8"
+ #+allegro "1.1920929e-7"
+ #+(or cmu sbcl sbcll) "5.960465e-8"
+ #+ecls "6.258487E-8"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string double-float-epsilon )
+ #+xcl "1.387778780781446D-17"
+ #+(or clisp cmu sbcl sbcl) "1.1102230246251568d-16"
+ #+allegro "2.220446049250313d-16"
+ #+ecls "1.165734175856414d-16"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string long-float-epsilon )
+ #+xcl "1.387778780781446D-17"
+ #+clisp "5.4210108624275221706L-20"
+ #+allegro "2.220446049250313d-16"
+ #+(or cmu sbcl sbcll) "1.1102230246251568d-16"
+ #+ecls "1.165734175856414d-16"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string short-float-negative-epsilon )
+ #+xcl "1.526S-5"
+ #+clisp "3.81476s-6"
+ #+allegro "1.1920929e-7"
+ #+(or cmu sbcl sbcll) "2.9802325e-8"
+ #+ecls "3.129244E-8"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string single-float-negative-epsilon )
+ #+xcl "5.960464E-8"
+ #+clisp "2.9802326E-8"
+ #+allegro "1.1920929e-7"
+ #+(or cmu sbcl sbcll) "2.9802325e-8"
+ #+ecls "3.129244E-8"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string double-float-negative-epsilon )
+ #+xcl "1.387778780781446D-17"
+ #+(or clisp cmu sbcl sbcl) "5.551115123125784d-17"
+ #+allegro "2.220446049250313d-16"
+ #+ecls "5.828670879282072d-17"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (prin1-to-string long-float-negative-epsilon )
+ #+xcl "1.387778780781446D-17"
+ #+clisp "2.7105054312137610853L-20"
+ #+allegro "2.220446049250313d-16"
+ #+(or cmu sbcl sbcll) "5.551115123125784d-17"
+ #+ecls "5.828670879282072d-17"
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (/ 1 0)
+ error)
+
+(my-assert
+ (/ 1 0.0s0)
+ error)
+
+(my-assert
+ (/ 1 0.0f0)
+ error)
+
+(my-assert
+ (/ 1 0.0d0)
+ error)
+
+(my-assert
+ (/ 1 0.0l0)
+ error)
+
+(my-assert
+ (expt 10.0s0 1000)
+ error)
+
+(my-assert
+ (expt 10.0f0 1000)
+ error)
+
+(my-assert
+ (expt 10.0d0 1000)
+ error)
+
+(my-assert
+ (expt 10.0l0 1000000000)
+ error)
+
+;; kap 13 zeichen
+;; ----------------------------------------------------------------------------
+
+(my-assert
+ (standard-char-p #\a)
+ t)
+
+(my-assert
+ (standard-char-p 1)
+ error)
+
+(my-assert
+ (graphic-char-p #\a)
+ t)
+
+(my-assert
+ (graphic-char-p 1)
+ error)
+
+(my-assert
+ (characterp
+    #\a)
+ t)
+
+(my-assert
+ (characterp
+    #\1)
+ t)
+
+(my-assert
+ (alpha-char-p #\a)
+ t)
+
+(my-assert
+ (alpha-char-p #\$)
+ nil)
+
+(my-assert
+ (upper-case-p #\a)
+ nil)
+
+(my-assert
+ (lower-case-p #\A)
+ nil)
+
+(my-assert
+ (both-case-p #\a)
+ t)
+
+(my-assert
+ (both-case-p #\$)
+ nil)
+
+(my-assert
+ (digit-char-p #\a)
+ nil)
+
+(my-assert
+ (digit-char-p #\5)
+ 5)
+
+(my-assert
+ (alphanumericp #\a)
+ t)
+
+(my-assert
+ (alphanumericp #\$)
+ nil)
+
+(my-assert
+ (char= #\d #\d)
+ t)
+
+(my-assert
+ (char/= #\d #\d)
+ nil)
+
+(my-assert
+ (char< #\z #\0)
+ nil)
+
+;; char>, char>=, char<=,
+
+(my-assert
+ (char-equal #\d #\d)
+ t)
+
+(my-assert
+ (char-not-equal #\d #\d)
+ nil)
+
+(my-assert
+ (char-lessp #\d #\x)
+ t)
+
+(my-assert
+ (char-lessp #\d #\d)
+ nil)
+
+(my-assert
+ (char-not-greaterp #\d #\d)
+ t)
+
+(my-assert
+ (char-greaterp #\e #\d)
+ t)
+
+(my-assert
+ (char-not-lessp #\e #\d)
+ t)
+
+;; char-code, code-char, character,
+
+(my-assert
+ (char-upcase #\a)
+ #\a)
+
+(my-assert
+ (char-upcase #\=)
+ #\=)
+
+(my-assert
+ (char= (char-downcase (char-upcase #\x)) #\x)
+ t)
+
+(my-assert
+ (char-downcase #\a)
+ #\a)
+
+(my-assert
+ (char= (char-upcase (char-downcase #\X)) #\X)
+ t)
+
+(my-assert
+ (digit-char 7)
+ #\7)
+
+(my-assert
+ (digit-char 12)
+ nil)
+
+;; char-int, int-char, char-name, name-char,
+
+(my-assert
+ char-code-limit
+ #+xcl 128
+ #+(or (and clisp (not unicode)) akcl sbcl cmu ecls) 256
+ #+(or (and clisp unicode) allegro) 655366
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+;; kap 14 sequenzen
+;; ----------------------------------------------------------------------------
+
+(my-assert
+ (elt (symbol-name 'abc) 0)
+ #\a)
+
+(my-assert
+ (subseq (list 'a 'b 'c 'd 'e) 2)
+ (c d e))
+
+(my-assert
+ (copy-seq '#(a b c))
+ #(a b c))
+
+(my-assert
+ (copy-seq (list (list 'a 'b) 'c (list 'd 'e)))
+ ((a b) c (d e)))
+
+(my-assert
+ (length #(a b c d e f))
+ 6)
+
+(my-assert
+ (length (list 'a 'b 'c 'd 'e 'f))
+ 6)
+
+(my-assert
+ (nreverse (list 'a
+		 (list 'b
+		       (list 'c)
+		       'd)))
+ ((b (c) d) a))
+
+(my-assert
+ (reverse (list 1 2 3 4))
+ (4 3 2 1))
+
+(my-assert
+ (make-sequence 'vector 4 :initial-element 'o)
+ #(o o o o))
+
+(my-assert
+ (make-sequence 'list 4 :initial-element 'o)
+ (o o o o))
+
+(my-assert
+ (concatenate 'list (list 'a 'b 'c) (list 1 2))
+ (a b c 1 2))
+
+(my-assert
+ (map 'list 'list
+      (list #\a #\b #\c)
+      (list #\1 #\2 #\3))
+ ((#\a #\1) (#\b #\2) (#\c #\3)))
+
+(my-assert
+ (map 'list 'list (list 'a 'b 'c) (list 1 2 3))
+ ((a 1) (b 2) (c 3)))
+
+(my-assert
+ (some 'null (list 'a 'b nil 't 'e))
+ t)
+
+(my-assert
+ (every 'atom (list 'a 8 #(a b)))
+ t)
+
+(my-assert
+ (notany 'eq
+	 (list 'a 'b 'c 'd 'e 4)
+	 (list 'i 'j 'k 'l 'm 4))
+ nil)					;? t
+
+(my-assert
+ (notevery 'eq '#(u)
+	   (list 'a 'x 'u))
+ t)
+
+(my-assert
+ (reduce 'list '(a) :from-end nil :initial-value nil)
+
+ (nil a))
+
+(my-assert
+ (reduce 'list
+	 (list 'a 'b 'c 'd)
+	 :from-end nil
+	 :initial-value 'iii)
+ ((((iii a) b) c) d))
+
+(my-assert
+ (reduce 'list (list 'a 'b 'c 'd) :from-end t)
+ (a (b (c d))))
+
+(my-assert
+ (fill '#(a b c d) 'i :start 1 :end 3)
+ #(a i i d))
+
+(my-assert
+ (replace '#(a b c d) '#(i j) :start1 1)
+ #(a i j d))
+
+(my-assert
+ (remove 'numberp '#(y a 4 a c 9 a d 2 3)
+	 :count 1 :from-end t)
+ #(y a 4 a c 9 a d 2 3))
+
+(my-assert
+ (remove 'a
+	 (list 'a 1 'b 'a '2 'a)
+	 :start 1)
+ (a 1 b 2))
+
+(my-assert
+ (remove-duplicates (list 'a 'b 'c 'a 'd 'a)
+		    :start 1)
+ (a b c d a))
+
+(my-assert
+ (remove-if 'numberp '#(y a 4 a c 9 a d 2 3))
+ #(y a a c a d))
+
+(my-assert
+ (remove-if-not 'numberp #(y a 4 a c 9 a d 2 3))
+ #(4 9 2 3))
+
+(my-assert
+ (remove-if-not 'numberp #(y a 4 a c 9 a d 2 3)
+		:count 2 :from-end nil)
+ #(4 a c 9 a d 2 3))
+
+(my-assert
+ (delete '(a) (list (list 'a 'b) (list 'c 'd) (list 'a))
+	 :test 'equal)
+ ((a b) (c d)))
+
+(my-assert
+ (delete-if (lambda (x) (eq (car x) 'a))
+	    (list (list 'a 'b)
+		  (list 'c 'd)
+		  (list 'a)))
+ ((c d)))
+
+(my-assert
+ (delete-if-not 'numberp (list 'a 3 'b 4))
+ (3 4))
+
+;; delete-duplicates,
+
+(my-assert
+ (nsubstitute 'new (list 1 'old)
+	      (list (list 0 'old) (list 1 'old) (list 2 'old))
+	      :test-not 'equal
+	      :from-end t)
+ (new (1 old) new))
+
+(my-assert
+ (nsubstitute 'new 'old (list 0 'old 1 'old 2 'old) :end 2)
+ (0 new 1 old 2 old))
+
+(my-assert
+ (nsubstitute-if 'new 'numberp (list 0 'a 1 'b 2 'c 3 'd)
+		 :count 2
+		 :end 5)
+ (new a new b 2 c 3 d))
+
+(my-assert
+ (nsubstitute-if-not 'new 'numberp
+		     (list 0 'a 1 'b 2 'c 3 'd)
+		     :count 2
+		     :from-end t)
+ (0 a 1 b 2 new 3 new))
+
+(my-assert
+ (substitute 'new (list 2 'old)
+	     (list (list 1 'old) (list 2 'old) (list 3 'old) (list 4 'old))
+	     :test 'equal
+	     :start 3)
+ ((1 old) (2 old) (3 old) (4 old)))
+
+(my-assert
+ (substitute-if 'new 'numberp
+		(list 'a 1 'b 2 'd 3))
+ (a new b new d new))
+
+(my-assert
+ (substitute-if-not 'new 'numberp (list 'a 1 'b 2 'd 3)
+		    :count 2
+		    :from-end t)
+ (a 1 new 2 new 3))
+
+(my-assert
+ (find '0 (list (list 0 'a) (list 1 'a) (list 2 'a) (list 0 'b))
+       :test '=
+       :from-end t
+       :key 'car
+       :start 1)
+ (0 b))
+
+(my-assert
+ (find-if 'numberp (list (list 'a 0) (list 'b 1) (list 'c 2))
+	  :key 'cadr
+	  :start 3)
+ nil)
+
+;; find-if-not,
+
+(my-assert
+ (position 'a (list (list 0 'a) (list 1 'b) (list 2 'a) (list 3 'b))
+	   :test #'(lambda (x y) (eq x (cadr y)))
+	   :start 1)
+ 2)
+
+(my-assert
+ (position 'a
+	   (list (list 0 'a) (list 1 'b) (list 2 'a) (list 3 'b))
+	   :key 'cadr)
+
+ 0)
+
+(my-assert
+ (position-if 'numberp
+	      (list (list 0 'x) (list 1 7.0) (list 2 8))
+	      :from-end t
+	      :start 1
+	      :key 'cadr)
+ 2)
+
+;; position-if-not,
+
+(my-assert
+ (count '(a)
+	(list 'a (list 'a) 'a (list 'a) 'a 'b)
+	:test-not 'equal
+	:key (lambda (x)
+	       (when (atom x)
+		 (list x))))
+ 3)
+
+(my-assert
+ (count-if-not 'numberp '#(a 3 b 5 7 c d) :start 2 :end 5)
+ 1)
+
+;; count-if-not,
+
+(my-assert
+ (mismatch (list 'a 'b 'c 3 4 5)
+	   (list 'a 'b 'x 3 4 'b)
+	   :start1 1
+	   :start2 5
+	   :end1 2
+	   :test-not 'eq)
+ 1)
+
+(my-assert
+ (mismatch (list 'a 'b 'c 3 4 5)
+	   (list 'u 'b 'x 3 4 5)
+	   :from-end t)
+ #+xcl 2
+ #-xcl 3)
+
+(my-assert
+ (search "ABCD" "0ABIABJBCBC"
+	 :end1 3
+	 :start1 1
+	 :start2 0
+	 :from-end t)
+ 9)
+
+(my-assert
+ (search (list #\A #\B #\C #\D)
+	 "0ABIABJBCBC"
+	 :end1 2
+	 :start2 0
+	 :from-end t)
+ 4)
+
+(my-assert
+ (search (list 'a 'b 'c 'd)
+	 (list 0 'a 'b 'i 'a 'b 'j 'b 'c 'b 'c)
+	 :end1 2
+	 :start2 2)
+ 4)
+
+(my-assert
+ (sort (list (list 'u 3) (list 'i 1)
+	     (list 'a 7) (list 'k 3)
+	     (list 'c 4) (list 'b 6))
+       '<
+       :key 'cadr)
+ ((i 1) (u 3) (k 3) (c 4) (b 6) (a 7)))
+
+(my-assert
+ (stable-sort (list (list 'b 4) (list 'a 3)
+		    (list 'a 2) (list 'b 1)
+		    (list 'c 9) (list 'b 2))
+	      'string<
+	      :key  'car)
+ ((a 3) (a 2) (b 4) (b 1) (b 2) (c 9)))
+
+(my-assert
+ (merge 'list
+	(list 5 1 4 4 7)
+	(list 2 3 5 6 8 9)
+	'<)
+ (2 3 5 1 4 4 5 6 7 8 9))		;? error
+
+(my-assert
+ (merge 'list
+	(list 1 4 4 7)
+	(list 2 3 5 6 8 9)
+	'<)
+ (1 2 3 4 4 5 6 7 8 9))			;? error
+
+;; kap 15 listen
+;; ----------------------------------------------------------------------------
+
+(my-assert
+ (car (list 'a 'b 'c 'd 'e 'f 'g))
+ a)
+
+(my-assert
+ (cdr (list 'a 'b 'c 'd 'e 'f 'g))
+ (b c d e f g))
+
+(my-assert
+ (cadr (list 'a 'b 'c 'd 'e 'f 'g))
+ b)
+
+(my-assert
+ (cddr (list 'a 'b 'c 'd 'e 'f 'g))
+ (c d e f g))
+
+(my-assert
+ (caddr (list 'a 'b 'c 'd 'e 'f 'g))
+ c)
+
+(my-assert
+ (cdddr (list 'a 'b 'c 'd 'e 'f 'g))
+ (d e f g))
+
+(my-assert
+ (cadddr (list 'a 'b 'c 'd 'e 'f 'g))
+ d)
+
+(my-assert
+ (cddddr (list 'a 'b 'c 'd 'e 'f 'g))
+ (e f g))
+
+(my-assert
+ (caadr
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ ((u v w) x))
+
+(my-assert
+ (cadar
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ (6 7))
+
+(my-assert
+ (cdaar
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ (5))
+
+(my-assert
+ (cdadr
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ (y))
+
+(my-assert
+ (cddar
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ nil)
+
+(my-assert
+ (caaaar
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ (1 2 3))
+
+(my-assert
+ (caadar
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ 6)
+
+(my-assert
+ (caaddr
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ (q w e))
+
+(my-assert
+ (cadaar
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ 5)
+
+(my-assert
+ (cadadr
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ y)
+
+(my-assert
+ (caddar
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ nil)
+
+(my-assert
+ (cadddr
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ (a b c))
+
+(my-assert
+ (cdaaar
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ (4))
+
+(my-assert
+ (cdaadr
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ (x))
+
+(my-assert
+ (cdadar
+  (list (list (list (list (list 1 2 3)
+			  4)
+		    5)
+	      (list 6 7))
+	(list (list (list 'u 'v 'w)
+		    'x)
+	      'y)
+	(list (list 'q 'w 'e)
+	      'r)
+	(list 'a 'b 'c)
+	'e 'f 'g))
+ (7))
+
+(my-assert
+ (cons 1 2)
+ (1 . 2))
+
+(my-assert
+ (cons 'a (cons 'b (cons 'c 'nil)))
+ (a b c))
+
+(my-assert
+ (cons 'a (list 'b 'c 'd))
+ (a b c d))
+
+(my-assert
+ (tree-equal 5 (+ 2 3) :test (function eql))
+ t)
+
+(my-assert
+ (endp 'nil)
+ t)
+
+(my-assert
+ (endp (cons 'a 'b))
+ nil)
+
+(my-assert
+ (list-length (list 'a 'b 'c 'd))
+ 4)
+
+(my-assert
+ (let ((x (list 'a 'b 'c))) (rplacd (last x) x)
+
+      (list-length x))
+ nil)
+
+(my-assert
+ (nth 0 (list 'a 'b 'c 'd))
+ a)
+
+(my-assert
+ (first (list 1 2 3 4 5 6 7 8 9 10 11))
+ 1)
+
+(my-assert
+ (second (list 1 2 3 4 5 6 7 8 9 10 11))
+ 2)
+
+(my-assert
+ (third (list 1 2 3 4 5 6 7 8 9 10 11))
+ 3)
+
+(my-assert
+ (fourth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 4)
+
+(my-assert
+ (fifth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 5)
+
+(my-assert
+ (sixth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 6)
+
+(my-assert
+ (seventh (list 1 2 3 4 5 6 7 8 9 10 11))
+ 7)
+
+(my-assert
+ (eighth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 8)
+
+(my-assert
+ (ninth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 9)
+
+(my-assert
+ (tenth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 10)
+
+(my-assert
+ (rest (cons 'a 'b))
+ b)
+
+(my-assert
+ (nthcdr 1 (list 'a 'b 'c 'd))
+ (b c d))
+
+(my-assert
+ (last (list 1 2 3 4 5))
+ (5))
+
+(my-assert
+ (last (append (list 1 2 3) 4))
+ (3 . 4))
+
+(my-assert
+ (list 'a 'b 'c 'd)
+ (a b c d))
+
+(my-assert
+ (list* 'a 'b 'c 'd)
+ (a b c . d))
+
+(my-assert
+ (make-list 4 :initial-element 'o)
+ (o o o o))
+
+(my-assert
+ (make-list 3 :initial-element 'rah)
+ (rah rah rah))
+
+(my-assert
+ (append (list 'a 'b 'c)
+	 (list 'd 'e 'f) 'nil '(g))
+ (a b c d e f g))
+
+(my-assert
+ (copy-list (list 1 2 3 4 5))
+ (1 2 3 4 5))
+
+(my-assert
+ (copy-list (append (list 1 2 3) 4))
+ (1 2 3 . 4))
+
+(my-assert
+ (copy-alist (list 'a 'b))
+ (a b))
+
+(my-assert
+ (copy-alist (list (cons 1 'a) (cons 2 'b) (cons 3 'c)))
+ ((1 . a) (2 . b) (3 . c)))
+
+(my-assert
+ (copy-alist (list (list 'a 'b) 'c (list 'd 'e)))
+ ((a b) c (d e)))
+
+(my-assert
+ (copy-tree (list 'a 'b
+		  (list 'c
+			(list 'd)
+			(list 'e 'f))
+		  'g))
+ (a b (c (d) (e f)) g))
+
+(my-assert
+ (revappend (list 'a 'b 'c) (list 'd 'e 'f))
+ (c b a d e f))
+
+(my-assert
+ (revappend (list 'a 'b 'c) 'i)
+ (c b a . i))				;? error
+
+(my-assert
+ (nreconc (list 'a 'b 'c) (list 'i 'j))
+ (c b a i j))
+
+;; nreconc
+
+(my-assert
+ (setq aa nil)
+ nil)
+
+(my-assert
+ (push '1 aa)
+ (1))
+
+(my-assert
+ (push '2 aa)
+ (2 1))
+
+(my-assert
+ (pop aa)
+ 2)
+
+(my-assert
+ (pop aa)
+ 1)
+
+(my-assert
+ (pop aa)
+ nil)
+
+(my-assert
+ (setq aa (list 'b 'a))
+ (b a))
+
+(my-assert
+ (pushnew 'a aa)
+ (b a))
+
+(my-assert
+ (pushnew 'c aa)
+ (c b a))
+
+(my-assert
+ (pushnew 'u (car (setq xx (list nil 'kkk))))
+ (u))
+
+(my-assert
+ (pushnew 'u (car xx))
+ (u))
+
+(my-assert
+ (pushnew 'v (car xx))
+ (v u))
+
+(my-assert
+ (eval 'xx)
+ ((v u) kkk))
+
+(my-assert
+ (butlast (list 'a 'b 'c) 2)
+ (a))
+
+(my-assert
+ (nbutlast (list 'a 'b 'c 'd) 6)
+ nil)
+
+(my-assert
+ (nbutlast (list 'a 'b 'c 'd) 1)
+ (a b c))
+
+(my-assert
+ (ldiff (setq xx (list 'a 'b 'c 'd 'e))
+	(cddr xx))
+ (a b))
+
+(my-assert
+ (ldiff (setq xx (append (list 'a 'b 'c 'd)
+			 'e))
+	(cddr xx))
+ (a b))
+
+(unintern 'xx)
+
+(my-assert
+ (ldiff (append (list 'a 'b 'c 'd)
+		'e)
+	'e)
+ (a b c d))
+
+;; rplaca, rplacd
+
+(my-assert
+ (nsubst 'a 'b
+	 (list 'u 'b (list 'b) 'c)
+	 :test-not (lambda (x y)
+		     (not (eql x y))))
+ (u a (a) c))
+
+(my-assert
+ (nsubst-if 'oo
+	    'numberp
+	    (list 'a 'b 'c (list 3 (list 4) 0)))
+ (a b c (oo (oo) oo)))
+
+(my-assert
+ (nsubst-if-not 'oo
+		#'(lambda (x)
+		    (or (list x)
+			(symbolp x)))
+		(list 'a 'b 'c (list 3 (list 4) 0)))
+ (a b c (3 (4) 0)))
+
+(my-assert
+ (subst 'a 'b (list 'u 'b (list 'b) 'c)
+	:test-not (lambda (x y)
+		    (not (eql x y)))
+	:key (lambda (u)
+	       (when (listp u)
+		 (car u))))
+ (u . a))
+
+(my-assert
+ (subst-if 'nummmer
+	   'numberp
+	   (list (list 'a (list 7 (list 'v 6)))))
+
+ ((a (nummmer (v nummmer)))))
+
+(my-assert
+ (subst-if-not 'nummmer
+	       #'(lambda (x)
+		   (or (listp x)
+		       (numberp x)))
+	       (list (list 'a (list 7 (list 'v 6)))))
+ ((nummmer (7 (nummmer 6)))))
+
+(my-assert
+ (nsublis (list (cons (list 'a) 'uu)
+		(cons 'a 'ii))
+	  (list 'i (list 'a) 'a)
+	  :test
+	  (lambda (x y)
+	    (when (listp y)
+	      (eql x (car y)))))
+ #+(or xcl allegro ecls) (i ii . ii)	; x aus der aliste, y ein blatt des baumes
+ #+(or clisp cmu sbcl lucid) (i (uu) uu) ; x ein blatt, y aus der aliste
+ #-(or xcl clisp cmu sbcl lucid allegro ecls) unknown)
+
+(my-assert
+ (SUBLIS (QUOTE (((A) . UU) (A . II)))
+	 (QUOTE (I (A) A))
+	 :TEST (LAMBDA (X Y)
+		       (IF (LISTP Y) (EQL X (CAR Y)))))
+ #+nil
+
+ (sublis (list (list (cons (list 'a) 'uu) (cons 'a 'ii)))
+	 (list 'i (list 'a) 'a)
+	 :test (lambda (x y)
+		 (when (listp y)
+		   (eql x (car y)))))
+ #+(or xcl allegro lucid ecls) (i ii . ii)	; x aus der aliste, y ein blatt des baumes
+ #+(or clisp cmu sbcl sbcl) (i (uu) uu) ; x ein blatt, y aus der aliste
+ #-(or xcl clisp cmu sbcl lucid allegro ecls) unknown)
+
+(my-assert
+ (member 'A
+	 (list (list 'A)
+	       (list 'B)
+	       (list 'A)
+	       (list 'C))
+	 :key
+	 'car)
+ ((a) (b) (a) (c)))
+
+(my-assert
+ (member-if 'numberp
+	    (list (list 'a)
+		  (list 'b)
+		  (list 3)
+		  (list 'c))
+	    :key 'car)
+
+ ((3) (c)))
+
+(my-assert
+ (member-if-not 'numberp
+		(list (list 8)
+		      (list 'a)
+		      (list 'b)
+		      (list 3)
+		      (list 'c))
+		:key 'car)
+ ((a) (b) (3) (c)))
+
+(my-assert
+ (tailp (cddr (setq xx (list 'u 'i 'a 'b))) xx)
+ t)
+
+(unintern 'xx)
+
+(my-assert
+ (tailp 'd (append (list 'a 'b 'c) 'd))
+ t)
+
+(my-assert
+ (adjoin 'a
+	 (list (list 'a)
+	       'b
+	       'c)
+	 :test 'equal)
+ (a (a) b c))
+
+(my-assert
+ (nunion (list 'a 'b 'c 'd)
+	 (list 'u 'i 'b 'a))
+ #+xcl (a b c d u i)
+ #+(or ecls clisp) (c d u i b a)
+ #+(or allegro cmu sbcl) (d c u i b a)
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (union (list 'a 'b 'c 'd)
+	(list 'a 'd 'i 'v))
+ #+xcl (v i a b c d)
+ #+(or ecls clisp) (b c a d i v)
+ #+(or allegro cmu sbcl) (c b a d i v)
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (intersection (list (list 'a 1)
+		     (list 'a 2)
+		     (list 'a 3))
+	       (list (list 'a 4)
+		     (list 'a 2)
+		     (list 'b 6)
+		     (list 'c 7))
+	       :test 'equal)
+ ((a 2)))
+
+(my-assert
+ (nintersection (list 'a 'b 'c 'd)
+		(list 'c 'd 'e 'f 'g)
+		:test-not (quote eql))
+ #-(or allegro cmu sbcl sbcl) (a b c d)
+ #+(or allegro cmu sbcl sbcl) (d c b a))
+
+(my-assert
+ (nset-difference (list 'a 'b 'c 'd)
+		  (list 'i 'j 'c))
+ #-(or allegro cmu sbcl sbcl) (a b d)
+ #+(or allegro cmu sbcl sbcl) (d b a))
+
+(my-assert
+ (nset-exclusive-or (list 'a 'b 'c)
+		    (list 'i 'a 'd 'c))
+ (b i d))
+
+(my-assert
+ (set-difference (list 'anton 'berta 'auto 'berlin)
+		 (list 'amerilla)
+		 :test (lambda (x y)
+			 (eql (elt (symbol-name x) 0)
+			      (elt (symbol-name y) 0))))
+ #+(or xcl allegro cmu sbcl sbcl) (berlin berta)
+ #+(or clisp akcl ecls) (berta berlin)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (set-exclusive-or (list 'anton 'anna 'emil)
+		   (list 'berta 'auto 'august)
+		   :test (lambda (x y)
+			   (eql (elt (symbol-name x) 0)
+				(elt (symbol-name y) 0))))
+ #-(or allegro cmu sbcl) (emil berta)
+ #+(or allegro cmu sbcl) (berta emil))
+
+(my-assert
+ (subsetp (list 'a 'b) (list 'b 'a 'u 'i 'c 'd))
+ t)
+
+(my-assert
+ (acons 'a 'b (list (cons 'c 'd)))
+ ((a . b) (c . d)))
+
+(my-assert
+ (acons 'a 'b nil)
+ ((a . b)))
+
+(my-assert
+ (assoc 'a (list (list 'b 'c)
+		 'a
+		 (list (list 'a) 'u)
+		 (list 'a 'i))
+	:test-not (lambda (x y)
+		    (when (atom y)
+		      (eql y x))))
+ #+allegro error
+ #-allegro (b c))
+
+(my-assert
+ (assoc-if 'symbolp
+	   (list (cons 'a 3)
+		 (cons 3 'a)))
+ (a . 3))
+
+(my-assert
+ (assoc-if-not 'numberp (list (cons 'a 3)
+			      (cons 3 'a)))
+ (a . 3))
+
+(my-assert
+ (pairlis (list 'a 'b 'c) (list 1 2 3))
+ ((c . 3) (b . 2) (a . 1)))
+
+(my-assert
+ (rassoc 'a (list (cons 1 'b) (cons 2 'a)))
+ (2 . a))
+
+(my-assert
+ (rassoc-if 'symbolp
+	    (list (cons 1 3) (cons 2 'a)))
+ (2 . a))
+
+(my-assert
+ (rassoc-if-not 'symbolp
+		(list (cons 1 3) (cons 2 'a)))
+ (1 . 3))
+
+;; kap 16 hash-tabellen
+;; ----------------------------------------------------------------------------
+
+(my-assert
+ (hash-table-p (make-hash-table :test #'eql
+				:rehash-size 2
+				:size 20))
+ t)
+
+(my-assert
+ (hash-table-p (make-hash-table :test #'eql
+				:rehash-size 1.1
+				:size 20))
+ t)
+;; clrhash, gethash, hash-table-count, maphash, remhash, sxhash,
+
+;; <hs>/body/mac_with-hash_ble-iterator.html
+(my-assert
+ (defun test-hash-table-iterator (hash-table)
+   (let ((all-entries '())
+	 (generated-entries '())
+	 (unique (list nil)))
+     (maphash #'(lambda (key value)
+		  (push (list key value)
+			all-entries))
+	      hash-table)
+     (with-hash-table-iterator
+      (generator-fn hash-table)
+      (loop
+	(multiple-value-bind (more? key value)
+	    (generator-fn)
+	  (unless more? (return))
+	  (unless (eql value (gethash key hash-table unique))
+	    (error "Key ~S not found for value ~S" key value))
+	  (push (list key value) generated-entries))))
+     (unless (= (length all-entries)
+		(length generated-entries)
+		(length (union all-entries
+			       generated-entries
+			       :key #'car
+			       :test (hash-table-test hash-table))))
+       (error "Generated entries and Maphash entries don't correspond"))
+     t))
+ test-hash-table-iterator)
+
+(my-assert
+ (let ((tab (make-hash-table :test #'equal)))
+   (setf (gethash "Richard" tab) "Gabriel")
+   (setf (gethash "Bruno" tab) "Haible")
+   (setf (gethash "Michael" tab) "Stoll")
+   (setf (gethash "Linus" tab) "Torvalds")
+   (setf (gethash "Richard" tab) "Stallman")
+   (test-hash-table-iterator tab)
+   )
+ t)
+
+;; kap 17 felder
+;; ----------------------------------------------------------------------------
+
+;; make-array, vector, aref, svref, array-element-type, array-rank,
+;; array-dimension, array-dimensions, array-total-size, array-in-bounds-p,
+;; array-row-major-index, adjustable-array-p,
+
+;; array-rank-limit, array-dimension-limit, array-total-size-limit,
+
+
+;; bit, sbit, bit-and, bit-andc1, bit-andc2, bit-eqv, bit-ior, bit-nand,
+;;; bit-nor, bit-not, bit-orc1, bit-orc2, bit-xor,
+
+;; array-has-fill-pointer-p, fill-pointer, vector-pop, vector-push,
+;; vector-push-extend, adjust-array,
+
+;; kap 18 strings
+;; ----------------------------------------------------------------------------
+
+;; char, schar, string=, string-equal, string/=, string<, string<=, string>,
+
+;; string>=, string-greaterp, string-lessp, string-not-equal,
+;; string-not-greaterp, string-not-lessp, make-string, string-left-trim,
+
+;; string-right-trim, string-trim, string-upcase, string-capitalize,
+
+;; string-downcase, nstring-capitalize, nstring-downcase, nstring-upcase,
+;; string,
+
+;; kap 19 strukturen
+;; ----------------------------------------------------------------------------
+
+;; defstruct,
+
+(my-assert
+ (defstruct (ice-cream-factory
+	     (:constructor make-factory)
+	     (:constructor fabricate-factory
+			   (&key (capacity 5)
+				 location
+				 (local-flavors
+				  (case location
+				    ((hawaii) '(pineapple macadamia guava))
+				    ((massachusetts) '(lobster baked-bean))
+				    ((california) '(ginger lotus avocado bean-sprout garlic))
+				    ((texas) '(jalapeno barbecue))))
+				 (flavors
+				  (subseq (append local-flavors
+						  '(vanilla chocolate strawberry pistachio
+							    maple-walnut peppermint))
+					  0 capacity)))))
+   (capacity 3)
+   (flavors '(vanilla chocolate strawberry mango)))
+ ice-cream-factory)
+
+(my-assert
+ (let ((houston (fabricate-factory :capacity 4 :location 'texas)))
+   (ice-cream-factory-flavors houston))
+ (jalapeno barbecue vanilla chocolate))
+
+(my-assert
+ (let ((cambridge (fabricate-factory :location 'massachusetts)))
+   (ice-cream-factory-flavors cambridge))
+ (lobster baked-bean vanilla chocolate strawberry))
+
+(my-assert
+ (let ((seattle (fabricate-factory :local-flavors '(salmon))))
+   (ice-cream-factory-flavors seattle))
+ (salmon vanilla chocolate strawberry pistachio))
+
+(my-assert
+ (let ((wheaton (fabricate-factory :capacity 4 :location 'illinois)))
+   (ice-cream-factory-flavors wheaton))
+ (vanilla chocolate strawberry pistachio))
+
+(my-assert
+ (let ((pittsburgh (fabricate-factory :capacity 4)))
+   (ice-cream-factory-flavors pittsburgh))
+ (vanilla chocolate strawberry pistachio))
+
+(my-assert
+ (let ((cleveland (make-factory :capacity 4)))
+   (ice-cream-factory-flavors cleveland))
+ (vanilla chocolate strawberry mango))
+
+;; kap 20 eval
+;; ----------------------------------------------------------------------------
+
+;; eval, evalhook, *evalhook*, applyhook, *applyhook*,
+
+(my-assert
+ (constantp -5)
+ t)
+
+(my-assert
+ (constantp (read-from-string "1.0e30"))
+ t)
+
+;; kap 21 streams
+;; ----------------------------------------------------------------------------
+
+;; make-synonym-stream, make-broadcast-stream, make-concatenated-stream,
+;; make-two-way-stream, make-echo-stream, make-string-input-stream,
+;; make-string-output-stream, get-output-stream-string, with-input-from-string,
+;; with-open-stream, with-output-to-string,
+
+(my-assert
+ (streamp *standard-input*)
+ t)
+
+(my-assert
+ (input-stream-p *terminal-io*)
+ t)
+
+;; output-stream-p, stream-element-type, close,
+
+;; kap 22 ein- und ausgabe
+;; ----------------------------------------------------------------------------
+
+(my-assert
+ (readtablep *readtable*)
+ t)
+
+(my-assert
+ (readtablep 'progn)
+ nil)
+
+;; copy-readtable, read, *read-base*, read-byte, read-char, read-char-no-hang,
+
+;; *read-default-float-format*, read-delimited-list, read-from-string, read-line,
+;; read-preserving-whitespace, *read-suppress*, *readtable*, unread-char,
+
+;; get-dispatch-macro-character, get-macro-character,
+;; set-dispatch-macro-character, set-macro-character, set-syntax-from-char,
+;; make-dispatch-macro-character,
+
+(my-assert
+ (get-dispatch-macro-character #\# #\0)
+ nil)
+
+;; pprint, prin1, prin1-to-string, princ, princ-to-string, print, *print-array*,
+;; *print-base*, *print-case*, *print-circle*, *print-escape*, *print-gensym*,
+
+;; *print-length*, *print-level*, *print-pretty*, *print-radix*,
+
+;; peek-char, listen, clear-input, clear-output, parse-integer,
+
+;; write, write-byte, write-char, write-line, write-string, write-to-string,
+;; y-or-n-p, yes-or-no-p,
+
+;; terpri, finish-output, force-output, format, fresh-line,
+
+;; kap 23 file-interface
+;; ----------------------------------------------------------------------------
+
+;; pathname, truename, parse-namestring, merge-pathnames,
+;; *default-pathname-defaults*, make-pathname, pathnamep, pathname-device,
+;; pathname-directory, pathname-host, pathname-name, pathname-type,
+;; pathname-version, namestring, file-namestring, directory-namestring,
+
+;; host-namestring, enough-namestring, user-homedir-pathname, open,
+;; with-open-file, rename-file, delete-file, probe-file, file-write-date,
+
+;; file-author, file-length, file-position, load, *load-verbose*, directory
+
+;; kap 24 fehler
+;; ----------------------------------------------------------------------------
+
+;; cerror, error, *break-on-warnings*, warn, break, check-type, assert, etypecase,
+;; ecase, ctypecase, ccase
+
+;; kap 25 erweiterungen
+;; ----------------------------------------------------------------------------
+
+;; compile, disassemble, compile-file, documentation, trace, untrace, step, time,
+;; describe, inspect, room, ed, dribble, apropos, apropos-list,
+;; get-decoded-time, get-internal-real-time, get-internal-run-time,
+;; get-universal-time, decode-universal-time, encode-universal-time,
+
+;; internal-time-units-per-second, sleep, lisp-implementation-type,
+;; lisp-implementation-version, machine-instance, machine-type, machine-version,
+
+;; software-type, software-version, short-site-name, long-site-name, *features*,
+;; identity
+
+;; kap i systeminterne praedikate
+;; ----------------------------------------------------------------------------
+;; ? (sequencep (type-specifier-p (bit-array-p
+;; ? (adjustable-vector-with-fill-pointer-p (alistp (declaration-specifier-p
+
+
+(my-assert
+ #-sbcl
+ (sys::fixnump 10)			;?
+ #+sbcl
+ (sb-kernel:fixnump 10)			;?
+ t)					;?
+
+;; kap ii systeminterne atome
+;; ----------------------------------------------------------------------------
+
+;; case-every, comment, cond-every, displace, return, return-from, access, boole,
+;; call-arguments-limit, defun, errset, *errset*, *macroexpand-hook*, *package*,
+;; *random-state*, *save-old-definition-when-redefined*,
diff --git a/src/ansi-tests/array.lisp b/src/ansi-tests/array.lisp
new file mode 100644
index 000000000..73f794678
--- /dev/null
+++ b/src/ansi-tests/array.lisp
@@ -0,0 +1,1006 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+;;erzeuge ein feld mit doppeltgenauen zahlen
+
+(my-assert
+ (setq da1
+       (make-array
+	(list 4 2 3)
+	:initial-contents
+	(list
+	 (list (list 1.0d0 2.0d0 3.0d0)
+	       (list 4.0d0 5.0d0 6.0d0))
+	 (list (list 7.0d0 8.0d0 9.0d0)
+	       (list 10.0d0 11.0d0 12.0d0))
+	 (list (list 13.0d0 14.0d0 15.0d0)
+	       (list 16.0d0 17.0d0 18.0d0))
+	 (list (list 19.0d0 20.0d0 21.0d0)
+	       (list 22.0d0 23.0d0 24.0d0)))
+	:element-type
+	(quote double-float)))
+ #3a(((1.0d0 2.0d0 3.0d0)   (4.0d0 5.0d0 6.0d0))
+     ((7.0d0 8.0d0 9.0d0)   (10.0d0 11.0d0 12.0d0))
+     ((13.0d0 14.0d0 15.0d0)(16.0d0 17.0d0 18.0d0))
+     ((19.0d0 20.0d0 21.0d0)(22.0d0 23.0d0 24.0d0))))
+
+(my-assert
+ (aref da1 0 0 0)
+ 1.0d0)
+
+(my-assert
+ (aref da1 0 0 1)
+ 2.0d0)
+
+(my-assert
+ (aref da1 0 0 2)
+ 3.0d0)
+
+(my-assert
+ (aref da1 0 1 0)
+ 4.0d0)
+
+(my-assert
+ (aref da1 0 1 1)
+ 5.0d0)
+
+(my-assert
+ (aref da1 0 1 2)
+ 6.0d0)
+
+(my-assert
+ (aref da1 1 0 0)
+ 7.0d0)
+
+(my-assert
+ (aref da1 1 0 1)
+ 8.0d0)
+
+(my-assert
+ (aref da1 1 0 2)
+ 9.0d0)
+
+(my-assert
+ (aref da1 1 1 0)
+ 10.0d0)
+
+(my-assert
+ (aref da1 1 1 1)
+ 11.0d0)
+
+(my-assert
+ (aref da1 1 1 2)
+ 12.0d0)
+
+(my-assert
+ (aref da1 2 0 0)
+ 13.0d0)
+
+(my-assert
+ (aref da1 2 0 1)
+ 14.0d0)
+
+(my-assert
+ (aref da1 2 0 2)
+ 15.0d0)
+
+(my-assert
+ (aref da1 2 1 0)
+ 16.0d0)
+
+(my-assert
+ (aref da1 2 1 1)
+ 17.0d0)
+
+(my-assert
+ (aref da1 2 1 2)
+ 18.0d0)
+
+(my-assert
+ (aref da1 3 0 0)
+ 19.0d0)
+
+(my-assert
+ (aref da1 3 0 1)
+ 20.0d0)
+
+(my-assert
+ (aref da1 3 0 2)
+ 21.0d0)
+
+(my-assert
+ (aref da1 3 1 0)
+ 22.0d0)
+
+(my-assert
+ (aref da1 3 1 1)
+ 23.0d0)
+
+(my-assert
+ (aref da1 3 1 1)
+ 23.0d0)
+
+;;erzeuge ein feld mit einfachgenauen zahlen
+
+(my-assert
+ (setq fa1
+       (make-array
+	(list 4 2 3)
+	:initial-contents
+	(list
+	 (list (list 1.0d0 2.0d0 3.0d0)
+	       (list 4.0d0 5.0d0 6.0d0))
+	 (list (list 7.0d0 8.0d0 9.0d0)
+	       (list 10.0d0 11.0d0 12.0d0))
+	 (list (list 13.0d0 14.0d0 15.0d0)
+	       (list 16.0d0 17.0d0 18.0d0))
+	 (list (list 19.0d0 20.0d0 21.0d0)
+	       (list 22.0d0 23.0d0 24.0d0)))
+	:element-type 'double-float))
+ #3a(((1.0 2.0 3.0)(4.0 5.0 6.0))
+     ((7.0 8.0 9.0)(10.0 11.0 12.0))
+     ((13.0 14.0 15.0)(16.0 17.0 18.0))
+     ((19.0 20.0 21.0)(22.0 23.0 24.0))))
+
+(my-assert
+ (aref fa1 0 0 0)
+ 1.0)
+
+(my-assert
+ (aref fa1 0 0 1)
+ 2.0)
+
+(my-assert
+ (aref fa1 0 0 2)
+ 3.0)
+
+(my-assert
+ (aref fa1 0 1 0)
+ 4.0)
+
+(my-assert
+ (aref fa1 0 1 1)
+ 5.0)
+
+(my-assert
+ (aref fa1 0 1 2)
+ 6.0)
+
+(my-assert
+ (aref fa1 1 0 0)
+ 7.0)
+
+(my-assert
+ (aref fa1 1 0 1)
+ 8.0)
+
+(my-assert
+ (aref fa1 1 0 2)
+ 9.0)
+
+(my-assert
+ (aref fa1 1 1 0)
+ 10.0)
+
+(my-assert
+ (aref fa1 1 1 1)
+ 11.0)
+
+(my-assert
+ (aref fa1 1 1 2)
+ 12.0)
+
+(my-assert
+ (aref fa1 2 0 0)   13.0)
+
+(my-assert
+ (aref fa1 2 0 1)
+ 14.0)
+
+(my-assert
+ (aref fa1 2 0 2)
+ 15.0)
+
+(my-assert
+ (aref fa1 2 1 0)   16.0)
+
+(my-assert
+ (aref fa1 2 1 1)
+ 17.0)
+
+(my-assert
+ (aref fa1 2 1 2)
+ 18.0)
+
+(my-assert
+ (aref fa1 3 0 0)
+ 19.0)
+
+(my-assert
+ (aref fa1 3 0 1)
+ 20.0)
+
+(my-assert
+ (aref fa1 3 0 2)
+ 21.0)
+
+(my-assert
+ (aref fa1 3 1 0)
+ 22.0)
+
+(my-assert
+ (aref fa1 3 1 1)
+ 23.0)
+
+(my-assert
+ (aref fa1 3 1 1)
+ 23.0)
+
+
+;; limits fuer felder
+
+(my-assert
+ (let ((s (prin1-to-string array-rank-limit )))
+   (or #+xcl (equal s "256")
+       #+clisp (equal s "4294967296")
+       #+clisp (equal s "65536")
+       #+akcl (equal s "64")
+       #+gcl (equal s "63")
+       #+allegro (equal s "65536")
+       #+(or cmu sbcl) (equal s "65529")
+       #+ecls (equal s "64")
+       #-(or xcl clisp akcl allegro cmu sbcl ecls) "unknown"
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string array-dimension-limit )))
+   (or #+xcl (equal s "17920")
+       #+akcl (equal s "16777216")
+       #+gcl (equal s "2147483647")
+       #+clisp (equal s (prin1-to-string (1+ most-positive-fixnum)))
+       #+allegro (equal s "16777216")
+       #+(or cmu sbcl) (equal s "536870911")
+       #+ecls (equal s "16777216")
+       #-(or xcl clisp akcl allegro cmu sbcl ecls) "unknown"
+       ) )
+ t)
+
+(my-assert
+ (let ((s (prin1-to-string array-total-size-limit )))
+   (or #+xcl (equal s "17920")
+       #+akcl (equal s "16777216")
+       #+clisp (equal s (prin1-to-string (1+ most-positive-fixnum)))
+       #+allegro (equal s "16777216")
+       #+(or cmu sbcl) (equal s "536870911")
+       #+ecls (equal s "16777216")
+       #-(or xcl clisp akcl allegro cmu sbcl ecls) "unknown"
+       ) )
+ t)
+
+;;erzeuge einen einfachen (simple) vector
+
+(my-assert
+ (equalp (setq sv (vector (quote a) (quote b) (quote c) 1.0s0 3.7d0
+			  4.1))
+	 #(a b c 1.0s0 3.7d0 4.1))   t)
+
+(my-assert
+ (svref sv 0)   a)
+
+(my-assert
+ (svref sv 1)   b)
+
+(my-assert
+ (svref sv 2)   c)
+
+(my-assert
+ (svref sv 3)   1.0s0)
+
+(my-assert
+ (svref sv 4)   3.7d0)
+
+;;pruefe setzen eines elements
+
+(my-assert
+ (setf (svref sv 0) (quote test))   test)
+
+(my-assert
+ (equalp sv #(test b c 1.0s0 3.7d0 4.1))   t)
+
+;;test array-element-typ ... da2 nicht def.
+
+(my-assert
+ (array-element-type sv)   t)
+
+(unintern 'sv)
+
+(my-assert
+ (array-element-type da1)
+ #+(or xcl allegro cmu sbcl) double-float
+ #+clisp t
+ #+(or akcl ecls) long-float
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+;;test rang
+
+(my-assert
+ (array-rank da1)   3)
+
+(my-assert
+ (array-rank fa1)   3)
+
+(unintern 'fa1)
+
+;;test der einzelnen dimensionen
+
+(my-assert
+ (array-dimension da1 0)   4)
+
+(my-assert
+ (array-dimension da1 1)   2)
+
+(my-assert
+ (array-dimension da1 2)   3)
+
+(my-assert
+ (array-dimension da1 3)   error)
+
+(unintern 'da1)
+;;erzeuge ein 0-dim. feld (pseudoscalar) mit inhalt mod 5
+
+(my-assert
+ (progn
+   (setq zero
+	 (make-array (quote nil)
+		     :element-type '(mod 5)))
+   t)
+ t)
+
+(my-assert
+ (array-rank zero)   0)
+
+(my-assert
+ (setf (aref zero) 4)   4)
+
+(my-assert
+ (setf (aref zero) 1.0)
+ #+(or xcl clisp akcl allegro cmu sbcl ecls) type-error
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(unintern 'zero)
+
+;;erzeuge ein 3-dim gen. feld
+
+(my-assert
+ (setq a1
+       (make-array (list 4 2 3)
+		   :initial-contents
+		   (list
+		    (list (list 'a 'b 'c)
+			  (list 1 2 3))
+		    (list (list 'd 'e 'f)
+			  (list 3 1 2))
+		    (list (list 'g 'h 'i)
+			  (list 2 3 1))
+		    (list (list 'j 'k 'l)
+			  (list 0 0 0)))))
+ #3a(((a b c)(1 2 3))
+     ((d e f)(3 1 2))
+     ((g h i)(2 3 1))
+     ((j k l)(0 0 0))))
+
+(my-assert
+ (aref a1 0 0 0)   a)
+
+(my-assert
+ (aref a1 0 0 1)   b)
+
+(my-assert
+ (aref a1 0 0 2)   c)
+
+(my-assert
+ (aref a1 0 1 0)   1)
+
+(my-assert
+ (aref a1 0 1 1)   2)
+
+(my-assert
+ (aref a1 0 1 2)   3)
+
+(my-assert
+ (aref a1 1 0 0)   d)
+
+(my-assert
+ (aref a1 1 0 1)   e)
+
+(my-assert
+ (aref a1 1 0 2)   f)
+
+(my-assert
+ (aref a1 1 1 0)   3)
+
+(my-assert
+ (aref a1 1 1 1)   1)
+
+(my-assert
+ (aref a1 1 1 2)   2)
+
+(my-assert
+ (aref a1 2 0 0)   g)
+
+(my-assert
+ (aref a1 2 0 1)   h)
+
+(my-assert
+ (aref a1 2 0 2)   i)
+
+(my-assert
+ (aref a1 2 1 0)   2)
+
+(my-assert
+ (aref a1 2 1 1)   3)
+
+(my-assert
+ (aref a1 2 1 2)   1)
+
+(my-assert
+ (aref a1 3 0 0)   j)
+
+(my-assert
+ (aref a1 3 0 1)   k)
+
+(my-assert
+ (aref a1 3 0 2)   l)
+
+(my-assert
+ (aref a1 3 1 0)   0)
+
+(my-assert
+ (aref a1 3 1 1)   0)
+
+(my-assert
+ (aref a1 3 1 1)   0)
+
+(unintern 'a1)
+
+;;erzeuge ein 2-dim adj.feld, das ueberlagert wird
+
+(my-assert
+ (progn (setq m (make-array (list 4 4)
+			    :adjustable t
+			    :initial-contents
+			    (list
+			     (list 'alpha 'beta 'gamma 'delta)
+			     (list 'epsilon 'zeta 'eta 'theta)
+			     (list 'iota 'kappa 'lambda 'mu)
+			     (list 'nu 'xi 'omicron 'pi))))
+	t)
+ t)
+
+(my-assert
+ (aref m 0 0)   alpha)
+
+(my-assert
+ (aref m 0 1)   beta)
+
+(my-assert
+ (aref m 0 2)   gamma)
+
+(my-assert
+ (aref m 0 3)   delta)
+
+(my-assert
+ (aref m 1 0)   epsilon)
+
+(my-assert
+ (aref m 1 1)   zeta)
+
+(my-assert
+ (aref m 1 2)   eta)
+
+(my-assert
+ (aref m 1 3)   theta)
+
+(my-assert
+ (aref m 2 0)   iota)
+
+(my-assert
+ (aref m 2 1)   kappa)
+
+(my-assert
+ (aref m 2 2)   lambda)
+
+(my-assert
+ (aref m 2 3)   mu)
+
+(my-assert
+ (aref m 3 0)   nu)
+
+(my-assert
+ (aref m 3 1)   xi)
+
+(my-assert
+ (aref m 3 2)   omicron)
+
+(my-assert
+ (aref m 3 3)   pi)
+
+;;erzeuge ueberl. der zeilen
+
+(my-assert
+ (equalp (setq md0 (make-array 4 :displaced-to m))   #(alpha beta gamma
+							     delta)) t)
+
+(my-assert
+ (equalp (setq md1 (make-array 4 :displaced-to m :displaced-index-offset4))
+	 #(epsilon zeta eta theta)) t)
+
+
+(my-assert
+ (equalp (setq md2 (make-array 4 :displaced-to m :displaced-index-offset8))
+	 #(iota kappa lambda mu)) t)
+
+
+(unintern 'md0)
+(unintern 'md1)
+(unintern 'md2)
+
+
+;;adjustiere feld m
+
+(my-assert
+ (progn (adjust-array m (quote (3 5)) :initial-element (quote baz))
+	t)   t)
+
+(my-assert
+ (aref m 0 0)   alpha)
+
+(my-assert
+ (aref m 0 1)   beta)
+
+(my-assert
+ (aref m 0 2)   gamma)
+
+(my-assert
+ (aref m 0 3)   delta)
+
+(my-assert
+ (aref m 0 4)   baz)
+
+(my-assert
+ (aref m 1 0)   epsilon)
+
+(my-assert
+ (aref m 1 1)   zeta)
+
+(my-assert
+ (aref m 1 2)   eta)
+
+(my-assert
+ (aref m 1 3)   theta)
+
+(my-assert
+ (aref m 1 4)   baz)
+
+(my-assert
+ (aref m 2 0)   iota)
+
+(my-assert
+ (aref m 2 1)   kappa)
+
+(my-assert
+ (aref m 2 2)   lambda)
+
+(unintern 'm)
+
+;;teste zusammenspiel der schluesselworte
+
+(my-assert
+ (progn
+   (setq dv (make-array 10 :element-type (quote double-float)
+			:initial-contents(quote (0.0d0 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0 6.0d0 7.0d0 8.0d0 9.0d0))))
+   t)
+ t)
+
+#| *************************************************************************** ;
+
+
+(setq dve (make-array (quote (2 2)) :element-type (quote double-float)
+
+		      :initial-contents (quote ((1.0d0 2.0d0) (3.0d0 4.0d0 5.0d0)))))   error
+
+(setq dve (make-array (quote (2 2)) :element-type (quote double-float)
+
+		      :initial-contents (quote
+					 ((1.0d0 2.0d0) (3.0d0 4.0d0) :displaced-to dv :displaced-index-offset
+					  8))))   error
+
+(setq dve (make-array (quote (2 2)) :element-type (quote double-float)
+
+		      :initial-contents (quote ((1.0d0 2.0d0) (3.0d0 4.0d0))) :displaced-to
+		      dv
+		      :displaced-index-offset 8))   error
+
+(setq dve (make-array (quote (2 2)) :element-type (quote double-float)
+
+		      :displaced-to dv :displaced-index-offset 8))   error
+
+***************************************************************************|#
+
+(my-assert
+ (aref dv 0)   0.0d0)
+
+(my-assert
+ (aref dv 1)   1.0d0)
+
+(my-assert
+ (aref dv 2)   2.0d0)
+
+(my-assert
+ (aref dv 3)   3.0d0)
+
+(my-assert
+ (aref dv 4)   4.0d0)
+
+(my-assert
+ (aref dv 5)   5.0d0)
+
+(my-assert
+ (aref dv 6)   6.0d0)
+
+(my-assert
+ (aref dv 7)   7.0d0)
+
+(my-assert
+ (aref dv 8)   8.0d0)
+
+(my-assert
+ (aref dv 9)   9.0d0)
+
+(my-assert
+ (setf (aref dv 5) -5.0d0)   -5.0d0)
+
+(unintern 'dv)
+
+;;definiere testfkt fuer indices
+
+(my-assert
+ (defun array-index-test (a &rest subs) (unless
+					    (apply (function array-in-bounds-p) a subs)
+					  (return-from array-index-test (quote error))) (=
+					  (apply (function array-row-major-index) a subs) (apply (function +)
+												 (maplist
+												  (function (lambda (x y) (* (car x) (apply (function *) (cdr y)))))
+												  subs
+												  (array-dimensions a)))))   array-index-test)
+
+(my-assert
+ (array-index-test (make-array (quote (5 4 3 2 1))) 4 2 2 1 0)   t)
+
+(my-assert
+ (array-index-test (make-array (quote (5 4 3 2 1))) 3 4 2 1 2)   error)
+
+;;test bitfelder
+
+(my-assert
+ (setq bvzero (make-array 100 :element-type (quote bit) :initial-element
+			  0))
+ #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)
+
+(my-assert
+ (setq bvone (make-array 100 :element-type (quote bit) :initial-element
+			 1))
+ #*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)
+
+(my-assert
+ (setq bv3 (make-array 100 :element-type (quote bit) :initial-element
+		       0))
+ #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)
+
+(my-assert
+ (setq bv2 (make-array 100 :element-type (quote bit) :initial-element
+		       0))
+ #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)
+
+(my-assert
+ (setq bv1 (make-array 100 :element-type (quote bit) :initial-element
+		       0))
+ #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)
+
+;;setze bitfelder
+
+(my-assert
+ (dotimes (i 50 bv1) (setf (sbit bv1 (* i 2)) 1))
+ #*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010)
+
+(my-assert
+ (dotimes (i 50 bv2) (setf (bit bv2 (* i 2)) 1))
+ #*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010)
+
+(my-assert
+ (equalp bv1 bv2)   t)
+
+(my-assert
+ (dotimes (i 25 bv3)
+   (setf (sbit bv3 (* i 4))
+	 1))
+ #*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000)
+
+(my-assert
+ (bit-and bv1 bv3)
+ #*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000)
+
+(my-assert
+ (bit-ior bv1 bv3)
+ #*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010)
+
+(my-assert
+ (bit-xor bv1 bv3)
+ #*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010)
+
+(my-assert
+ (bit-eqv bv1 bv3)
+ #*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101)
+
+(my-assert
+ (bit-nand bv1 bv3)
+ #*0111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111)
+
+(my-assert
+ (bit-andc1 bv1 bv3)
+ #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)
+
+(my-assert
+ (bit-andc2 bv1 bv3)
+ #*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010)
+
+(my-assert
+ (bit-orc1 bv1 bv3)
+ #*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101)
+
+(my-assert
+ (bit-orc2 bv1 bv3)
+ #*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)
+
+(my-assert
+ (bit-not bv1)
+ #*0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101)
+
+(my-assert
+ (bit-not bvzero)
+ #*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)
+
+(my-assert
+ (bit-not bvone)
+ #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)
+
+(unintern 'bv1)
+(unintern 'bv2)
+(unintern 'bv3)
+(unintern 'bvzero)
+(unintern 'bvone)
+
+;;teste operationen mit fillpointern
+
+(my-assert
+ (make-array (quote (3 4 5)) :fill-pointer t)   error)
+
+(my-assert
+ (equalp (make-array 5 :fill-pointer 5)
+	 #+(or xcl cmu sbcl)
+	 #(0 0 0 0 0)
+	 #-(or xcl cmu sbcl)
+	 #(nil nil nil nil nil))
+ t)
+
+(my-assert
+ (make-array 5 :fill-pointer -5)   error)
+
+;;allgem. vector mit fillpointer
+
+(my-assert
+ (progn (setq vmf (make-array 5 :fill-pointer 0)) t)   t)
+
+(my-assert
+ (fill-pointer vmf)   0)
+
+(my-assert
+ (vector-push (quote a) vmf)   0)
+
+(my-assert
+ (fill-pointer vmf)   1)
+
+(my-assert
+ (vector-push (quote b) vmf)   1)
+
+(my-assert
+ (vector-push (quote c) vmf)   2)
+
+(my-assert
+ (vector-push (quote d) vmf)   3)
+
+(my-assert
+ (vector-push (quote e) vmf)   4)
+
+(my-assert
+ (vector-push (quote voll) vmf)   nil)
+
+(my-assert
+ (vector-pop vmf)   e)
+
+(my-assert
+ (vector-pop vmf)   d)
+
+(my-assert
+ (vector-pop vmf)   c)
+
+(my-assert
+ (vector-pop vmf)   b)
+
+(my-assert
+ (vector-pop vmf)   a)
+
+(my-assert
+ (vector-pop vmf)   error)
+
+;;adjustabler allgem. vector mit fillpointer
+
+(unintern 'vmf)
+
+(my-assert
+ (progn (setq vmfa (make-array 5 :fill-pointer 0 :adjustable t)) t)
+ t)
+
+(my-assert
+ (fill-pointer vmfa)   0)
+
+(my-assert
+ (vector-push-extend (quote a) vmfa)   0)
+
+(my-assert
+ (fill-pointer vmfa)   1)
+
+(my-assert
+ (vector-push-extend (quote b) vmfa)   1)
+
+(my-assert
+ (vector-push-extend (quote c) vmfa)   2)
+
+(my-assert
+ (vector-push-extend (quote d) vmfa)   3)
+
+(my-assert
+ (vector-push-extend (quote e) vmfa)   4)
+
+(my-assert
+ (vector-push-extend (quote voll) vmfa)   5)
+
+(my-assert
+ (vector-pop vmfa)   voll)
+
+(my-assert
+ (vector-pop vmfa)   e)
+
+(my-assert
+ (vector-pop vmfa)   d)
+
+(my-assert
+ (vector-pop vmfa)   c)
+
+(my-assert
+ (vector-pop vmfa)   b)
+
+(my-assert
+ (vector-pop vmfa)   a)
+
+;;doppeltgen. vector mit fillpointer
+
+(unintern 'vmfa)
+
+(my-assert
+ (progn
+   (setq vmfd (make-array 5 :fill-pointer 0 :element-type (quote double-float)))
+   t)   t)
+
+(my-assert
+ (fill-pointer vmfd)   0)
+
+(my-assert
+ (vector-push 0.0d0 vmfd)   0)
+
+(my-assert
+ (fill-pointer vmfd)   1)
+
+(my-assert
+ (vector-push 1.0d0 vmfd)   1)
+
+(my-assert
+ (vector-push 2.0d0 vmfd)   2)
+
+(my-assert
+ (vector-push 3.0d0 vmfd)   3)
+
+(my-assert
+ (vector-push 4.0d0 vmfd)   4)
+
+(my-assert
+ (vector-push 5.0d0 vmfd)   nil)
+
+(my-assert
+ (vector-pop vmfd)   4.0d0)
+
+(my-assert
+ (vector-pop vmfd)   3.0d0)
+
+(my-assert
+ (vector-pop vmfd)   2.0d0)
+
+(my-assert
+ (vector-pop vmfd)   1.0d0)
+
+(my-assert
+ (vector-pop vmfd)   0.0d0)
+
+(my-assert
+ (vector-pop vmfd)   error)
+
+;;doppeltgen. adjust. vector mit fillpointer
+
+(unintern 'vmfd)
+
+(my-assert
+ (progn (setq vmfad
+	      (make-array 5 :fill-pointer 0 :element-type (quote double-float) :adjustable
+			  t))
+	t)   t)
+
+(my-assert
+ (fill-pointer vmfad)   0)
+
+(my-assert
+ (vector-push-extend 0.0d0 vmfad)   0)
+
+(my-assert
+ (fill-pointer vmfad)   1)
+
+(my-assert
+ (vector-push-extend 1.0d0 vmfad)   1)
+
+(my-assert
+ (vector-push-extend 2.0d0 vmfad)   2)
+
+(my-assert
+ (vector-push-extend 3.0d0 vmfad)   3)
+
+(my-assert
+ (vector-push-extend 4.0d0 vmfad)   4)
+
+(my-assert
+ (vector-push-extend 5.0d0 vmfad)   5)
+
+(my-assert
+ (vector-pop vmfad)   5.0d0)
+
+(my-assert
+ (vector-pop vmfad)   4.0d0)
+
+(my-assert
+ (vector-pop vmfad)   3.0d0)
+
+(my-assert
+ (vector-pop vmfad)   2.0d0)
+
+(my-assert
+ (vector-pop vmfad)   1.0d0)
+
+(my-assert
+ (vector-pop vmfad)   0.0d0)
+
+(my-assert
+ (vector-push-extend 5.0s0 vmfad)
+ #+(or xcl gcl allegro cmu sbcl) error
+ #+(or clisp ecls (and akcl (not gcl))) 0
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(unintern 'vmfad)
diff --git a/src/ansi-tests/backquot.lisp b/src/ansi-tests/backquot.lisp
new file mode 100644
index 000000000..b28e82427
--- /dev/null
+++ b/src/ansi-tests/backquot.lisp
@@ -0,0 +1,34 @@
+;;; Based on 1.1.1.1 -*- mode: lisp -*-
+;;; testen von backquote
+(in-package :cl-user)
+
+(my-assert
+ (setf x (list 'a 'b 'c))
+ (a b c))
+
+(my-assert
+ `(x ,x ,@x foo ,(cadr  x) bar ,(cdr x) baz ,@(cdr x) ,. x)
+ (X (A B C) A B C FOO B BAR (B C) BAZ B C A B C))
+
+(my-assert
+ (read-from-string "`,@x")
+ ERROR)
+
+(my-assert
+ `(,x . ,x)				; = (append (list x) x)
+ ((a b c) a b c))
+
+
+(my-assert
+ (read-from-string "`(,x . ,@x)")
+ ERROR)
+
+
+(my-assert
+ (read-from-string ",x")
+ ERROR)
+
+(my-assert
+ `#(1 2 3 4)
+ #(1 2 3 4))
+
diff --git a/src/ansi-tests/characters.lisp b/src/ansi-tests/characters.lisp
new file mode 100644
index 000000000..f1a1669d0
--- /dev/null
+++ b/src/ansi-tests/characters.lisp
@@ -0,0 +1,894 @@
+;;; based on v1.4 -*- mode: lisp -*-
+(in-package :cl-user)
+
+
+(my-assert
+ char-code-limit
+ #+xcl 128
+ #+(or (and clisp (not unicode)) akcl sbcl cmu ecls) 256
+ #+(or (and clisp unicode) allegro) 65536
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (standard-char-p #\a)
+ t)
+
+(my-assert
+ (standard-char-p #\$)
+ t)
+
+(my-assert
+ (standard-char-p #\.)
+ t)
+
+(my-assert
+ (standard-char-p #\A)
+ t)
+
+(my-assert
+ (standard-char-p 1)
+ type-error)
+
+(my-assert
+ (standard-char-p #\\)
+ t)
+
+(my-assert
+ (standard-char-p #\5)
+ t)
+
+(my-assert
+ (standard-char-p #\))
+ t)
+
+(my-assert
+ (standard-char-p #\%)
+ t)
+
+(my-assert
+ (standard-char-p #\Backspace)
+ #+xcl t
+ #-xcl nil)
+
+(my-assert
+ (standard-char-p #\Page)
+ #+xcl t
+ #-xcl nil)
+
+(my-assert
+ (standard-char-p #\Return)
+ #+xcl t
+ #-xcl nil)
+
+(my-assert
+ (graphic-char-p #\a)
+ t)
+
+(my-assert
+ (graphic-char-p #\$)
+ t)
+
+(my-assert
+ (graphic-char-p #\.)
+ t)
+
+(my-assert
+ (graphic-char-p #\A)
+ t)
+
+(my-assert
+ (graphic-char-p 1)
+ type-error)
+
+(my-assert
+ (graphic-char-p #\\)
+ t)
+
+(my-assert
+ (graphic-char-p #\5)
+ t)
+
+(my-assert
+ (graphic-char-p #\))
+ t)
+
+(my-assert
+ (graphic-char-p #\%)
+ t)
+
+(my-assert
+ (graphic-char-p #\Backspace)
+ nil)
+
+(my-assert
+ (graphic-char-p #\Page)
+ nil)
+
+(my-assert
+ (graphic-char-p #\Return)
+ nil)
+
+(my-assert
+ (characterp
+  #\a)
+ t)
+
+(my-assert
+ (characterp
+    #\$)
+ t)
+
+(my-assert
+ (characterp
+    #\.)
+ t)
+
+(my-assert
+ (characterp
+    #\A)
+ t)
+
+(my-assert
+ (characterp
+    #\\)
+ t)
+
+(my-assert
+ (characterp
+    #\5)
+ t)
+
+(my-assert
+ (characterp
+    #\))
+ t)
+
+(my-assert
+ (characterp
+    #\%)
+ t)
+
+(my-assert
+ (characterp
+    #\Backspace)
+ t)
+
+(my-assert
+ (characterp
+    #\Page)
+ t)
+
+(my-assert
+ (characterp
+    #\Return)
+ t)
+
+(my-assert
+ (alpha-char-p #\a)
+ t)
+
+(my-assert
+ (alpha-char-p #\$)
+ nil)
+
+(my-assert
+ (alpha-char-p #\.)
+ nil)
+
+(my-assert
+ (alpha-char-p #\A)
+ t)
+
+(my-assert
+ (alpha-char-p 1)
+ type-error)
+
+(my-assert
+ (alpha-char-p #\\)
+ nil)
+
+(my-assert
+ (alpha-char-p #\5)
+ nil)
+
+(my-assert
+ (alpha-char-p #\))
+ nil)
+
+(my-assert
+ (alpha-char-p #\%)
+ nil)
+
+(my-assert
+ (alpha-char-p #\Backspace)
+ nil)
+
+(my-assert
+ (alpha-char-p #\Page)
+ nil)
+
+(my-assert
+ (alpha-char-p #\Return)
+ nil)
+
+(my-assert
+ (upper-case-p #\a)
+ nil)
+
+(my-assert
+ (upper-case-p #\$)
+ nil)
+
+(my-assert
+ (upper-case-p #\.)
+ nil)
+
+(my-assert
+ (upper-case-p #\A)
+ t)
+
+(my-assert
+ (upper-case-p 1)
+ type-error)
+
+(my-assert
+ (upper-case-p #\\)
+ nil)
+
+(my-assert
+ (upper-case-p #\5)
+ nil)
+
+(my-assert
+ (upper-case-p #\))
+ nil)
+
+(my-assert
+ (upper-case-p #\%)
+ nil)
+
+(my-assert
+ (upper-case-p #\Backspace)
+ nil)
+
+(my-assert
+ (upper-case-p #\Page)
+ nil)
+
+(my-assert
+ (upper-case-p #\Return)
+ nil)
+
+(my-assert
+ (lower-case-p #\a)
+ t)
+
+(my-assert
+ (lower-case-p #\$)
+ nil)
+
+(my-assert
+ (lower-case-p #\.)
+ nil)
+
+(my-assert
+ (lower-case-p #\A)
+ nil)
+
+(my-assert
+ (lower-case-p 1)
+ type-error)
+
+(my-assert
+ (lower-case-p #\\)
+ nil)
+
+(my-assert
+ (lower-case-p #\5)
+ nil)
+
+(my-assert
+ (lower-case-p #\))
+ nil)
+
+(my-assert
+ (lower-case-p #\%)
+ nil)
+
+(my-assert
+ (lower-case-p #\Backspace)
+ nil)
+
+(my-assert
+ (lower-case-p #\Page)
+ nil)
+
+(my-assert
+ (lower-case-p #\Return)
+ nil)
+
+(my-assert
+ (both-case-p #\a)
+ t)
+
+(my-assert
+ (both-case-p #\$)
+ nil)
+
+(my-assert
+ (both-case-p #\.)
+ nil)
+
+(my-assert
+ (both-case-p #\A)
+ t)
+
+(my-assert
+ (both-case-p 1)
+ type-error)
+
+(my-assert
+ (both-case-p #\\)
+ nil)
+
+(my-assert
+ (both-case-p #\5)
+ nil)
+
+(my-assert
+ (both-case-p #\))
+ nil)
+
+(my-assert
+ (both-case-p #\%)
+ nil)
+
+(my-assert
+ (both-case-p #\Backspace)
+ nil)
+
+(my-assert
+ (both-case-p #\Page)
+ nil)
+
+(my-assert
+ (both-case-p #\Return)
+ nil)
+
+(my-assert
+ (digit-char-p #\a)
+ nil)
+
+(my-assert
+ (digit-char-p #\$)
+ nil)
+
+(my-assert
+ (digit-char-p #\.)
+ nil)
+
+(my-assert
+ (digit-char-p #\A)
+ nil)
+
+(my-assert
+ (digit-char-p 1)
+ type-error)
+
+(my-assert
+ (digit-char-p #\\)
+ nil)
+
+(my-assert
+ (digit-char-p #\5)
+ 5)
+
+(my-assert
+ (digit-char-p #\))
+ nil)
+
+(my-assert
+ (digit-char-p #\%)
+ nil)
+
+(my-assert
+ (digit-char-p #\Backspace)
+ nil)
+
+(my-assert
+ (digit-char-p #\Page)
+ nil)
+
+(my-assert
+ (digit-char-p #\Return)
+ nil)
+
+(my-assert
+ (digit-char-p #\5 4)
+ nil)
+
+(my-assert
+ (digit-char-p #\5 8)
+ 5)
+
+(my-assert
+ (digit-char-p #\E 16)
+ 14)
+
+(my-assert
+ (digit-char-p #\R 35)
+ 27)
+
+(my-assert
+ (digit-char-p #\5 4)
+ nil)
+
+(my-assert
+ (digit-char-p #\5 5)
+ nil)
+
+(my-assert
+ (digit-char-p #\5 6)
+ 5)
+
+(my-assert
+ (digit-char-p #\1 2)
+ 1)
+
+(my-assert
+ (alphanumericp #\a)
+ t)
+
+(my-assert
+ (alphanumericp #\$)
+ nil)
+
+(my-assert
+ (alphanumericp #\.)
+ nil)
+
+(my-assert
+ (alphanumericp #\A)
+ t)
+
+(my-assert
+ (alphanumericp 1)
+ type-error)
+
+(my-assert
+ (alphanumericp #\\)
+ nil)
+
+(my-assert
+ (alphanumericp #\5)
+ t)
+
+(my-assert
+ (alphanumericp #\))
+ nil)
+
+(my-assert
+ (alphanumericp #\%)
+ nil)
+
+(my-assert
+ (alphanumericp #\Backspace)
+ nil)
+
+(my-assert
+ (alphanumericp #\Page)
+ nil)
+
+(my-assert
+ (alphanumericp #\Return)
+ nil)
+
+(my-assert
+ (alphanumericp #\5 4)
+ error)
+
+(my-assert
+ (alphanumericp #\5 8)
+ error)
+
+(my-assert
+ (alphanumericp #\E 16)
+ error)
+
+(my-assert
+ (alphanumericp #\R 35)
+ error)
+
+(my-assert
+ (char= #\d #\d)
+ t)
+
+(my-assert
+ (char/= #\d #\d)
+ nil)
+
+(my-assert
+ (char= #\d #\x)
+ nil)
+
+(my-assert
+ (char/= #\d #\x)
+ t)
+
+(my-assert
+ (char= #\d #\D)
+ nil)
+
+(my-assert
+ (char/= #\d #\D)
+ t)
+
+(my-assert
+ (char= #\d #\d #\d #\d)
+ t)
+
+(my-assert
+ (char/= #\d #\d #\d #\d)
+ nil)
+
+(my-assert
+ (char= #\d #\d #\x #\d)
+ nil)
+
+(my-assert
+ (char/= #\d #\d #\x #\d)
+ nil)
+
+(my-assert
+ (char= #\d #\y #\x #\c)
+ nil)
+
+(my-assert
+ (char/= #\d #\y #\x #\c)
+ t)
+
+(my-assert
+ (char= #\d #\c #\d)
+ nil)
+
+(my-assert
+ (char/= #\d #\c #\d)
+ nil)
+
+(my-assert
+ (char< #\d #\x)
+ t)
+
+(my-assert
+ (char<= #\d #\x)
+ t)
+
+(my-assert
+ (char< #\d #\d)
+ nil)
+
+(my-assert
+ (char<= #\d #\d)
+ t)
+
+(my-assert
+ (char< #\a #\e #\y #\z)
+ t)
+
+(my-assert
+ (char<= #\a #\e #\y #\z)
+ t)
+
+(my-assert
+ (char< #\a #\e #\e #\y)
+ nil)
+
+(my-assert
+ (char<= #\a #\e #\e #\y)
+ t)
+
+(my-assert
+ (char> #\e #\d)
+ t)
+
+(my-assert
+ (char>= #\e #\d)
+ t)
+
+(my-assert
+ (char> #\d #\c #\b #\a)
+ t)
+
+(my-assert
+ (char>= #\d #\c #\b #\a)
+ t)
+
+(my-assert
+ (char> #\d #\d #\b #\a)
+ nil)
+
+(my-assert
+ (char>= #\d #\d #\b #\a)
+ t)
+
+(my-assert
+ (char> #\e #\d #\b #\c #\a)
+ nil)
+
+(my-assert
+ (char>= #\e #\d #\b #\c #\a)
+ nil)
+
+(my-assert
+ (char> #\z #\A)
+ t)
+
+(my-assert
+ (char> #\Z #\a)
+ nil)
+
+(my-assert
+ (char< #\9 #\a)
+ t)
+
+(my-assert
+ (char> #\9 #\a)
+ nil)
+
+(my-assert
+ (char> #\z #\0)
+ t)
+
+(my-assert
+ (char< #\z #\0)
+ nil)
+
+(my-assert
+ (char-equal #\d #\d)
+ t)
+
+(my-assert
+ (char-not-equal #\d #\d)
+ nil)
+
+(my-assert
+ (char-equal #\d #\x)
+ nil)
+
+(my-assert
+ (char-not-equal #\d #\x)
+ t)
+
+(my-assert
+ (char-equal #\d #\D)
+ t)
+
+(my-assert
+ (char-not-equal #\d #\D)
+ nil)
+
+(my-assert
+ (char-equal #\d #\d #\d #\d)
+ t)
+
+(my-assert
+ (char-not-equal #\d #\d #\d #\d)
+ nil)
+
+(my-assert
+ (char-equal #\d #\d #\x #\d)
+ nil)
+
+(my-assert
+ (char-not-equal #\d #\d #\x #\d)
+ nil)
+
+(my-assert
+ (char-equal #\d #\y #\x #\c)
+ nil)
+
+(my-assert
+ (char-not-equal #\d #\y #\x #\c)
+ t)
+
+(my-assert
+ (char-equal #\d #\c #\d)
+ nil)
+
+(my-assert
+ (char-not-equal #\d #\c #\d)
+ nil)
+
+(my-assert
+ (char-lessp #\d #\x)
+ t)
+
+(my-assert
+ (char-not-greaterp #\d #\x)
+ t)
+
+(my-assert
+ (char-lessp #\d #\d)
+ nil)
+
+(my-assert
+ (char-not-greaterp #\d #\d)
+ t)
+
+(my-assert
+ (char-lessp #\a #\e #\y #\z)
+ t)
+
+(my-assert
+ (char-not-greaterp #\a #\e #\y #\z)
+ t)
+
+(my-assert
+ (char-lessp #\a #\e #\e #\y)
+ nil)
+
+(my-assert
+ (char-not-greaterp #\a #\e #\e #\y)
+ t)
+
+(my-assert
+ (char-greaterp #\e #\d)
+ t)
+
+(my-assert
+ (char-not-lessp #\e #\d)
+ t)
+
+(my-assert
+ (char-greaterp #\d #\c #\b #\a)
+ t)
+
+(my-assert
+ (char-not-lessp #\d #\c #\b #\a)
+ t)
+
+(my-assert
+ (char-greaterp #\d #\d #\b #\a)
+ nil)
+
+(my-assert
+ (char-not-lessp #\d #\d #\b #\a)
+ t)
+
+(my-assert
+ (char-greaterp #\e #\d #\b #\c #\a)
+ nil)
+
+(my-assert
+ (char-not-lessp #\e #\d #\b #\c #\a)
+ nil)
+
+(my-assert
+ (char-greaterp #\z #\A)
+ t)
+
+(my-assert
+ (char-greaterp #\Z #\a)
+ t)
+
+(my-assert
+ (char-lessp #\9 #\a)
+ t)
+
+(my-assert
+ (char-greaterp #\9 #\a)
+ nil)
+
+(my-assert
+ (char-greaterp #\z #\0)
+ t)
+
+(my-assert
+ (char-lessp #\z #\0)
+ nil)
+
+(my-assert
+ (char-equal #\A #\a)
+ t)
+
+(my-assert
+ (char-upcase #\a)
+ #\A)
+
+(my-assert
+ (char-upcase #\A)
+ #\A)
+
+(my-assert
+ (char-upcase #\5)
+ #\5)
+
+(my-assert
+ (char-upcase #\;)
+ #\;)
+
+(my-assert
+ (char-upcase #\=)
+ #\=)
+
+(my-assert
+ (char= (char-downcase (char-upcase #\x)) #\x)
+ t)
+
+(my-assert
+ (char-downcase #\A)
+ #\a)
+
+(my-assert
+ (char-downcase #\a)
+ #\a)
+
+(my-assert
+ (char-downcase #\%)
+ #\%)
+
+(my-assert
+ (char-downcase #\+)
+ #\+)
+
+(my-assert
+ (char-downcase #\-)
+ #\-)
+
+(my-assert
+ (char= (char-upcase (char-downcase #\X)) #\X)
+ t)
+
+(my-assert
+ (digit-char 7)
+ #\7)
+
+(my-assert
+ (digit-char 12)
+ nil)
+
+(my-assert
+ (digit-char 'a)
+ error)
+
+(my-assert
+ (digit-char 12 16)
+ #\C)
+
+(my-assert
+ (digit-char 6 2)
+ nil)
+
+(my-assert
+ (digit-char 1 2)
+ #\1)
+
+;; evan though char-*-bit are not in the ANSI CL standard,
+;; they may be present as an extension
+
+;; (my-assert
+;;  char-control-bit
+;;  error)
+
+;; (my-assert
+;;  char-meta-bit
+;;  error)
+
+;; (my-assert
+;;  char-super-bit
+;;  error)
+
+;; (my-assert
+;;  char-hyper-bit
+;;  error)
+
+(my-assert
+ (char-name #\Space)
+ "Space")
+
+(my-assert
+ (char-name #\Newline)
+ #-cmu
+ "Newline"
+ #+cmu
+ "Linefeed")
diff --git a/src/ansi-tests/clos.lisp b/src/ansi-tests/clos.lisp
new file mode 100644
index 000000000..814be0647
--- /dev/null
+++ b/src/ansi-tests/clos.lisp
@@ -0,0 +1,468 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+
+#-(OR CMU SBCL)
+(my-assert
+ (use-package "CLOS")
+ T)
+
+#+SBCL
+(my-assert
+ (use-package "SB-PCL")
+ T)
+
+(my-assert
+ (unintern '<C1>)
+ T)
+
+(my-assert
+ (progn
+   (defclass <C1> ()
+     ((x :initform 0 :accessor x-val :reader get-x :writer set-x :initarg :x)
+      (y :initform 1 :accessor y-val :reader get-y :writer set-y :initarg :y)))
+   ())
+ NIL)
+
+(my-assert
+ (progn
+   (defclass <C2> (<C1>)
+     ((z :initform 0 :accessor z-val :reader get-z :writer set-z :initarg :z)))
+   ())
+ NIL)
+
+(my-assert
+ (defparameter a (make-instance (find-class '<C1>) :x 10))
+ A)
+
+(my-assert
+ (x-val a)
+ 10)
+
+(my-assert
+ (y-val a)
+ 1)
+
+(my-assert
+ (setf (x-val a) 20)
+ 20)
+
+(my-assert
+ (x-val a)
+ 20)
+
+(my-assert
+ (get-x a)
+ 20)
+
+(my-assert
+ (set-x 10 a)
+ 10)
+
+(my-assert
+ (x-val a)
+ 10)
+
+(my-assert
+ (defparameter b (make-instance (find-class '<C2>) :x 10 :y 20 :z 30))
+ B)
+
+(my-assert
+ (x-val b)
+ 10)
+
+(my-assert
+ (y-val b)
+ 20)
+
+(my-assert
+ (z-val b)
+ 30)
+
+(my-assert
+ (progn
+   (defgeneric f (x y)
+     (:method ((x t) (y t))
+	      (list x y)))
+   (defmethod f ((i integer) (j number))
+     (+ i j))
+   (defmethod f ((s1 string) (s2 string))
+     (concatenate 'string s1 s2))
+   ())
+ NIL)
+
+(my-assert
+ (f t t)
+ (T T))
+
+(my-assert
+ (f 2 3)
+ 5)
+
+(my-assert
+ (f 2 3.0)
+ 5.0)
+
+(my-assert
+ (f 2.0 3)
+ (2.0 3))
+
+(my-assert
+ (f "ab" "cd")
+ "abcd")
+
+(my-assert
+ (f 1 "abc")
+ (1 "abc"))
+
+(my-assert
+ (progn
+   (defgeneric f (x y)
+     (:method ((x t) (y t))
+	      (list x y))
+     (:method ((i number) (j integer))
+	      (list (call-next-method) (- i j)))
+     (:method ((i integer) (j number))
+	      (list (call-next-method) (+ i j))))
+   ())
+ NIL)
+
+(my-assert
+ (f 'x 'y)
+ (X Y))
+
+(my-assert
+ (f 1 2)
+ (((1 2) -1) 3))
+
+(my-assert
+ (f 1 2.0)
+ ((1 2.0) 3.0))
+
+(my-assert
+ (f 1.0 2)
+ ((1.0 2) -1.0))
+
+(my-assert
+ (progn
+   (defgeneric g (x)
+     (:method ((x null))
+	      (cons 'null (call-next-method)))
+     (:method ((x list))
+	      (if (next-method-p)
+		  (cons 'list (call-next-method))
+		  '(list$)))
+     (:method ((x symbol))
+	      (if (next-method-p)
+		  (cons 'symbol (call-next-method))
+		  '(symbol$))))
+   ())
+ NIL)
+
+(my-assert
+ (g 'x)
+ (SYMBOL$))
+
+(my-assert
+ (g '(x))
+ (LIST$))
+
+(my-assert
+ (g '())
+ (NULL SYMBOL LIST$)
+ "Class precedence list for NULL:
+
+null, symbol, list, sequence, t")
+
+(my-assert
+ (defvar hl)
+ HL)
+
+(my-assert
+ (progn
+   (defgeneric hgen (x)
+     (:method ((x integer))
+	      (setf hl (cons 'i-primary-1 hl))
+	      (call-next-method)
+	      (setf hl (cons 'i-primary-2 hl)))
+     (:method :before ((x integer))
+	      (setf hl (cons 'i-before hl)))
+     (:method :after ((x integer))
+	      (setf hl (cons 'i-after hl)))
+     (:method :around ((x integer))
+	      (setf hl (cons 'i-around-1 hl))
+	      (call-next-method)
+	      (setf hl (cons 'i-around-2 hl)))
+     (:method ((x number))
+	      (setf hl (cons 'n-primary-1 hl))
+	      (call-next-method)
+	      (setf hl (cons 'n-primary-2 hl)))
+     (:method :before ((x number))
+	      (setf hl (cons 'n-before hl)))
+     (:method :after ((x number))
+	      (setf hl (cons 'n-after hl)))
+     (:method :around ((x number))
+	      (setf hl (cons 'n-around-1 hl))
+	      (call-next-method)
+	      (setf hl (cons 'n-around-2 hl)))
+     (:method ((x t))
+	      (setf hl (cons 'innermost hl))))
+   (defun h (x)
+     (setf hl '()) (hgen x) (reverse hl))
+   )
+ H)
+
+(my-assert
+ (h 'abc)
+ (INNERMOST))
+
+(my-assert
+ (h 3.14)
+ (N-AROUND-1 N-BEFORE N-PRIMARY-1 INNERMOST N-PRIMARY-2 N-AFTER N-AROUND-2))
+
+(my-assert
+ (h 3)
+ (I-AROUND-1 N-AROUND-1 I-BEFORE N-BEFORE I-PRIMARY-1 N-PRIMARY-1 INNERMOST
+	     N-PRIMARY-2 I-PRIMARY-2 N-AFTER I-AFTER N-AROUND-2 I-AROUND-2
+	     ))
+
+(my-assert
+ (unintern '<C1>)
+ T)
+
+(my-assert
+ (progn
+   (defclass <C1> ()
+     ((x :initform 0 :accessor x-val :initarg :x)
+      (y :initform 1 :accessor y-val :initarg :y)))
+   ())
+ NIL)
+
+(my-assert
+ (defparameter a (make-instance (find-class '<C1>) :x 10))
+ A)
+
+(my-assert
+ (defparameter b (make-instance (find-class '<C1>) :y 20 :x 10))
+ B)
+
+(my-assert
+ (defparameter c (make-instance (find-class '<C1>)))
+ C)
+
+(my-assert
+ (x-val a)
+ 10)
+
+(my-assert
+ (y-val a)
+ 1)
+
+(my-assert
+ (x-val b)
+ 10)
+
+(my-assert
+ (y-val b)
+ 20)
+
+(my-assert
+ (x-val c)
+ 0)
+
+(my-assert
+ (y-val c)
+ 1)
+
+(my-assert
+ (unintern '<C1>)
+ T)
+
+(my-assert
+ (progn
+   (defclass <C1> ()
+     ((x :initform 0 :accessor x-val :initarg :x)
+      (y :initform 1 :accessor y-val :initarg :y)))
+   (defmethod initialize-instance :after ((instance <C1>) &rest initvalues)
+     (if (= (x-val instance) 0)
+	 (setf (x-val instance) (y-val instance))))
+   ())
+ NIL)
+
+(my-assert
+ (x-val (make-instance (find-class '<C1>)))
+ 1)
+
+(my-assert
+ (x-val (make-instance (find-class '<C1>) :x 10))
+ 10)
+
+(my-assert
+ (x-val (make-instance (find-class '<C1>) :y 20))
+ 20)
+
+(my-assert
+ (x-val (make-instance (find-class '<C1>) :x 10 :y 20))
+ 10)
+
+(my-assert
+ (unintern '<C1>)
+ T)
+
+(my-assert
+ (eq (class-of ())               (find-class 'null))
+ T)
+
+(my-assert
+ (eq (class-of t)                (find-class 'symbol))
+ T)
+
+(my-assert
+ (eq (class-of 10)
+     (find-class #+(or ALLEGRO cmu sbcl) 'fixnum
+		 #-(or ALLEGRO cmu sbcl) 'integer))
+ T)
+
+(my-assert
+ (eq (class-of 10.0)
+     (find-class #+(or ALLEGRO cmu sbcl) 'single-float
+		 #-(or ALLEGRO cmu sbcl) 'float))
+ T)
+
+(my-assert
+ (eq (class-of '(a b))
+     (find-class 'cons))
+ T)
+
+(my-assert
+ (eq (class-of "abc")
+     (find-class #+(OR CMU SBCL) 'simple-string
+		 #-(OR CMU SBCL) 'string))
+ T)
+
+(my-assert
+ (eq (class-of '#(1 2))
+     (find-class #+(OR CMU SBCL) 'simple-vector
+		 #-(OR CMU SBCL) 'vector))
+ T)
+
+(my-assert
+ (eq (class-of #'car)
+     (find-class 'function))
+ T)
+
+(my-assert
+ (eq (class-of #'make-instance)
+     (find-class 'standard-generic-function))
+ T)
+
+(my-assert
+ (eq (class-of '#2a((a) (b)))
+     (find-class #+(OR CMU SBCL) 'simple-array
+		 #-(OR CMU SBCL) 'array))
+ T)
+
+(my-assert
+ (eq (class-of *standard-input*)
+     (find-class 'stream))
+ NIL)
+
+(my-assert
+ (eq (class-of (lambda (x) x))
+     (find-class 'function))
+ T
+ "lambda should return a function.
+
+a function is:
+function n. 1. an object representing code, which can
+be called with zero or more arguments, and which produces
+zero or more values. 2. an object of type function.
+
+So class-of should return a function. Not?")
+
+(my-assert
+ (eq (class-of (find-class 't))
+     (find-class 'built-in-class))
+ T)
+
+(my-assert
+ (typep "abc" (find-class 't))
+ T)
+
+(my-assert
+ (typep "abc" (find-class 'array))
+ T)
+
+(my-assert
+ (typep "abc" (find-class 'vector))
+ T)
+
+(my-assert
+ (typep "abc" (find-class 'string))
+ T)
+
+(my-assert
+ (typep "abc" (find-class 'integer))
+ NIL)
+
+(my-assert
+ (typep 3 (find-class 't))
+ T)
+
+(my-assert
+ (typep 3 (find-class 'number))
+ T)
+
+(my-assert
+ (typep 3 (find-class 'float))
+ NIL)
+
+(my-assert
+ (typep 3 (find-class 'integer))
+ T)
+
+(my-assert
+ (typep 3 (find-class 'string))
+ NIL)
+
+(my-assert
+ (typep *standard-input* (find-class 'stream))
+ T)
+
+#+(or clisp allegro cmu sbcl)
+(my-assert
+ #+CLISP
+ (defun subclassp (class1 class2)
+   (clos::subclassp class1 class2)
+   )
+ #+ALLEGRO
+ (defun subclassp (class1 class2)
+   (finalize-inheritance class1)
+   (not (null (member class2 (class-precedence-list class1))))
+   )
+ #+CMU
+ (defun subclassp (class1 class2)
+   (not (null (member (car (pcl:class-precedence-list class2))
+		      (pcl:class-precedence-list class1)
+		      ) )    )     )
+ #+sbcl
+ (defun subclassp (class1 class2)
+   (not (null (member (car (sb-pcl:class-precedence-list class2))
+		      (sb-pcl:class-precedence-list class1)
+		      ) )    )     )
+ #+(or CLISP ALLEGRO cmu sbcl) SUBCLASSP)
+
+(my-assert
+ (subclassp (find-class 'number)
+	    (find-class 't))
+ T)
+
+(my-assert
+ (subclassp (find-class 'integer)
+	    (find-class 'number))
+ T)
+
+(my-assert
+ (subclassp (find-class 'float)
+	    (find-class 'number))
+ T)
diff --git a/src/ansi-tests/cmucl-bugs.lisp b/src/ansi-tests/cmucl-bugs.lisp
new file mode 100644
index 000000000..a0546d13e
--- /dev/null
+++ b/src/ansi-tests/cmucl-bugs.lisp
@@ -0,0 +1,640 @@
+;;; -*- mode: lisp -*-
+(in-package :cl-user)
+
+;; Your fd-stream-read-n-bytes (in 17e) crashes when reading from a
+;; pipe and it didn't get the requested byte-count (it should re-read
+;; because pipe-reads may be interrupted). You have done some changes
+;; in from 17c to 17e (I think) but it dosen't work yet. Here is a old
+;; patched version that works for us.
+
+
+;;An alist with SETF and a function name causes
+;;an error whenever it's used:
+
+(my-assert
+ (defparameter foo '((setf . sqrt)))
+ FOO)
+
+
+(my-assert
+ foo
+ ((SETF . SQRT)))
+
+
+(my-assert
+ (setq foo '((zut . 4)))
+ ((ZUT . 4)))
+
+
+(my-assert
+ foo
+ ((ZUT . 4)))
+
+
+(my-assert
+ (setq foo '((setf . 3)))
+ ((SETF . 3)))
+
+
+(my-assert
+ '(setq . 2)
+ (setq . 2))
+
+(unintern 'foo)
+
+;;
+
+
+(my-assert
+ (* 10000000000000000000000000000000000000000
+    10000000000000000000000000000000000000000)
+
+ 100000000000000000000000000000000000000000000000000000000000000000000000000000000)
+
+
+(my-assert
+ (time (+ 2 2))
+ 4)
+
+;; cltl2 p 727
+
+
+(my-assert
+ (let ((stack (copy-list '(a b c d e f))))
+   (loop for item = (length stack) then (pop stack) while stack
+     collect item))
+ (6 A B C D E))
+
+;; p 737
+
+(my-assert
+ (loop with ( a b c) (float integer float)
+   return (list a b c))
+ (0.0 0 0.0))
+
+
+(my-assert
+ (loop with ( a b c) float
+   return (list a b c))
+ (0.0 0.0 0.0))
+
+
+;; printing arrays
+
+
+(my-assert
+ (make-array '(22) :element-type 'single-float :initial-element 0.0)
+ #(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0))
+
+
+(my-assert
+ (make-array '(2 2))
+ #-clisp
+ #2A((0 0) (0 0))
+ #+clisp
+ #2A((NIL NIL) (NIL NIL)))
+
+
+(my-assert
+ (make-array '(2 2) :element-type 'single-float :initial-element 0.0)
+ #2A((0.0 0.0) (0.0 0.0)))
+
+;; without pretty-print?
+
+(my-assert
+ (make-array '(22) :element-type 'single-float :initial-element 0.0)
+ #(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0))
+
+
+(my-assert
+ (make-array '(2 2))
+ #-clisp
+ #2A((0 0) (0 0))
+ #+clisp
+ #2A((NIL NIL) (NIL NIL)))
+
+(my-assert
+ (make-array '(2 2) :element-type 'single-float :initial-element 0.0)
+ #2A((0.0 0.0) (0.0 0.0)))
+
+;; bignums
+
+
+(my-assert
+ (defun factorial (n &optional (i 1))
+   (if (plusp n) (factorial (1- n) (* i n)) i))
+ FACTORIAL)
+
+
+(my-assert
+ (/ (factorial 100) (factorial 99))
+ 100)
+
+
+(my-assert
+ (/ (factorial 1000) (factorial 999))
+ 1000)
+
+(unintern 'factorial)
+
+(my-assert
+ 1e-37
+ 10.0e-38)
+
+
+(my-assert
+ 1L-38
+ 10.0L-39)
+
+
+(my-assert
+ (flet ((print-result (x)
+	  (format nil "~&x is ~F (a ~S)." x (type-of x))))
+   (print-result "non-number"))
+ "x is non-number (a (SIMPLE-BASE-STRING 10))."
+ "Notice that ~3,2F does work.")
+
+(my-assert
+ (defun sigmoid (x)
+   (/ 1 (1+ (exp (- x)))))
+ SIGMOID)
+
+
+(my-assert
+ (compile 'sigmoid)			; in CMU Common Lisp 17f
+ SIGMOID)
+
+#-clisp
+(my-assert
+ (sigmoid 100)
+ 1.0)
+
+
+(unintern 'sigmoid)
+
+(my-assert
+ (setq X (copy-list '((1 2) (1 2 3) (3))))
+ ((1 2) (1 2 3) (3)))
+
+
+(my-assert
+ (remove-duplicates X :test #'subsetp)
+ ((1 2 3) (3)))
+
+
+(my-assert
+ (delete-duplicates X :test #'subsetp)
+ ((1 2 3) (3)))
+
+
+(unintern 'X)
+
+(my-assert
+ (progn
+   (run-program "/bin/date" '() :output t :error :stream)
+   t)
+ t)
+;; #<process 780 :EXITED>
+
+
+
+(my-assert
+ (- 0.0 #C( 1.0 1.0))
+ #C(-1.0 -1.0))
+
+
+(my-assert
+ (- #C(.5 .866) 0.0)
+ #C(0.5 0.866))
+
+
+
+(my-assert
+ (/ 2.0 #C(-1.0 -1.0))
+ #C(-1.0 1.0))
+
+
+(my-assert
+ (* 2.0 #C(-1.0 -1.0))
+ #C(-2.0 -2.0))
+
+
+
+(my-assert
+ (with-open-file
+  (foo "/tmp/foocl"
+       :direction :output
+       :element-type
+       (list 'signed-byte (1+ (integer-length
+			       most-positive-fixnum))))
+  (write-byte 17 foo)
+  (write-byte -17 foo)
+  (write-byte 4517 foo)
+  (write-byte -1217 foo))
+ -1217)
+
+
+(my-assert
+ (with-open-file
+  (foo "/tmp/foocl"
+       :direction :input
+       :element-type
+       (list 'signed-byte (1+ (integer-length
+			       most-positive-fixnum))))
+  (list (read-byte foo)
+	(read-byte foo)
+	(read-byte foo)
+	(read-byte foo)))
+ (17 -17 4517 -1217))
+
+
+(my-assert
+ (unless (ignore-errors (error "grr"))
+   (print "hi"))
+ "hi")
+
+
+(my-assert
+ (setf (elt '(a b c d) 2) 'x)
+ x)
+
+
+(my-assert
+ (acos 1.00001)
+ #+(or cmu sbcl)
+ #C(0.0 0.004475168)
+ #+clisp
+ #C(0 0.0044751023)
+ #-(or clisp cmu sbcl)
+ fill-this-in)
+
+
+(my-assert
+ (parse-namestring (make-pathname :defaults "tst"))
+ #p"tst")
+
+
+(my-assert
+ (string< "abcd" "012abcz" :start2 3 :end2 6)
+ NIL)
+
+
+(my-assert
+ (string> "abcd" "012abcd" :start2 3 :end2 5)
+ 2)
+
+
+(my-assert
+ (defun (setf foo) () t)
+ (setf foo))
+
+
+(my-assert
+ (compile '(setf foo))
+ (setf foo))
+
+
+(my-assert
+ (typep '(setf cons)
+	'generic-function)
+ NIL)
+
+
+(my-assert
+ (make-sequence '(vector float) 4  :initial-element 0.0)
+ #(0.0 0.0 0.0 0.0))
+
+
+(my-assert
+ (typep (complex 0.0d0) '(complex double-float))
+ t
+ "complex returns a number whose real part is realpart
+and whose imaginary part is imagpart.
+
+If realpart is a rational and imagpart is the rational
+number zero, the result of complex is realpart, a rational.
+Otherwise, the result is a complex.
+
+If either realpart or imagpart is a float, the non-float
+is converted to a float before the complex is created. If
+imagpart is not supplied, the imaginary part is a zero of
+ the same type as realpart; i.e., (coerce 0 (type-of
+realpart)) is effectively used.
+
+the second parameter is not supplied, the first is
+a double-float, so actually this is (complex 0.0d0 0.0d0)
+these are not rationals, so we get a complex number back.
+")
+
+
+;; From: Gary Bunting <gbunting@cantor.une.edu.au>
+(my-assert
+ (setf xx (expt 3 32))
+ 1853020188851841)
+
+(my-assert
+ (* xx xx)
+ 3433683820292512484657849089281)
+
+
+#|					;
+(defun bugged (x)
+  (labels ((f (y &optional trouble)	;  <<< or &key or &rest ..
+	      (if y
+		  (let ((a (pop y)))
+		    (f a)))))
+
+;;;; (f x) <<<
+;;;; Error in function COMMON-LISP::ASSERT-ERROR:
+;;;; The assertion (EQ (C::LAMBDA-TAIL-SET C::CALLER)
+;;;;               (C::LAMBDA-TAIL-SET (C::LAMBDA-HOME C::CALLEE)))
+;;;; failed.
+
+;;; However this works ok.
+    (f x nil)))
+|#
+(my-assert
+ (defun bugged (x)
+   (labels ((f (y &optional trouble)	;  <<< or &key or &rest ..
+	       (if y
+		   (let ((a (pop y)))
+		     (f a)))))
+     (f x)))
+ BUGGED)
+
+(my-assert
+ (bugged (list (list)))
+ NIL)
+
+(unintern 'bugged)
+
+(my-assert
+ (defun tst()
+   (with-open-file
+    (stream "does-not-exist" :if-does-not-exist nil)
+    (unless stream
+      'abacab)))
+ TST)
+
+(my-assert
+ (tst)
+ abacab)
+
+(unintern 'tst)
+
+(my-assert
+ (defun f (a b)
+   (declare (type (single-float  0.0 0.5) a)
+	    (type (single-float  0.0 0.2) b)
+	    (optimize (debug 0) (safety 0) (speed 3)))
+   (expt a b))
+ F)
+
+(my-assert
+ (progn
+   (compile 'f)
+   t)
+ t)
+
+;;; deltax^2 == deltat
+
+;;; from Paul Werkowski
+
+(my-assert
+ (progn
+   (compile-file "compile-bug5.lisp")
+   :ok)
+ :ok)
+
+(my-assert
+ (progn
+   (compile-file "compile-bug6.lisp")
+   :ok)
+ :ok)
+
+(my-assert
+ (progn
+   (defclass cl1 ()())
+   (defclass cl2 (cl1 missing)())
+   (defclass cl4 ()())
+
+   (defmethod foo ((c cl2))
+     c)
+   ;; method specializing on class with fwd reference
+   ;; ok so far
+
+   ;; then this dies
+
+   (defmethod foo ((c cl4))
+     c)   ;; add a new method to gf #'foo
+   t)
+ T)
+
+(my-assert
+ (progn
+   (defmethod foo ((f function))
+     f)
+   (defun zzz (x)
+     x)
+   (foo #'zzz)   ;; this is supposed to work.
+   t)
+ t)
+
+(unintern 'zzz)
+
+#+(or sbcl cmu)
+(my-assert
+ (progn
+   (compile-file "compile-bug1.lisp")
+   :ok)
+ :ok)
+
+
+
+;;; From: William Harold Newman <william.newman@airmail.net>
+
+(my-assert
+ (equalp #\a 'a)
+ nil)
+
+(defun my-sxhash (x)
+  (declare (type double-float x))
+  (sxhash x))
+
+(my-assert
+ (eq (my-sxhash 1.2d0)
+     (sxhash 1.2d0))
+ T)
+
+(my-assert
+ (progn
+   (compile 'my-sxhash)
+   (eq (my-sxhash 1.2d0)
+       (sxhash 1.2d0)))
+ T)
+
+
+;;; From: Raymond Toy <toy@rtp.ericsson.se>
+
+(defun tst2 (x n)
+  (declare (type (integer -134217728 134217728) x)
+           (type (integer -4 4) n)
+           (optimize (speed 3) (safety 0)))
+  (ash x n))
+
+(my-assert
+ (compile 'tst2)
+ tst2)
+
+;; From pvaneynd:
+
+(my-assert
+ (exp 1)
+ 2.7182817)
+
+(my-assert
+ (macrolet ((foobar (a b)
+		    `(+ ,a ,b)))
+   (foobar 2 4))
+ 6)
+
+(my-assert
+ (macrolet ((foobar (a b)
+		    `(+ ,a ,b)))
+   (foobar 2 4 5 6))
+ program-error)
+
+
+;;; From: Marco Antoniotti <marcoxa@parades.rm.cnr.it>
+
+(my-assert
+ (progn
+   (defclass ccc () ())
+   (setf (find-class 'ccc1) (find-class 'ccc))
+   :ok)
+ :ok)
+
+(my-assert
+ (progn
+   (defmethod zut ((c ccc1)) 123)
+   :ok)
+ :ok)
+
+
+;;; From: Fred Gilham <gilham@snapdragon.csl.sri.com>
+
+
+(my-assert
+ (progn
+   (compile-file "compile-bug2.lisp")
+   :ok)
+ :ok)
+
+;;; From: lyle@cogni.iaf.cnrs-gif.fr (Lyle Borg-Graham)
+
+(defun foo ()
+  (loop for x from 1.0 to 10.0
+    maximize x into max single-float))
+
+(my-assert
+ (compile 'foo)
+ foo)
+
+;;; From: Timothy Miller <tsm@cs.brown.edu>
+
+#+(or cmu sbcl)
+(my-assert
+ (> 2 single-float-positive-infinity)
+ NIL)
+
+;;; From: "Fernando D. Mato Mira" <matomira@iname.com>
+
+(defun prolog-length (p)
+  (let ((x (length (car p))))
+    (reduce #'(lambda (v1 v2)
+		(declare (ignore v1))
+		(setq x (+ x (length v2))))
+	    p)))
+
+(my-assert
+ (compile 'prolog-length)
+ prolog-length)
+
+(my-assert
+ (prolog-length (list (list 1 2)
+		      (list 3)))
+ 3)
+
+(my-assert
+ (progn
+   (compile-file "compile-bug3.lisp")
+   :ok)
+ :ok)
+
+(my-assert
+ (progn
+   (compile-file "compile-bug4.lisp")
+   :ok)
+ :ok)
+
+(my-assert
+ (progn
+   (compile-file "compile-bug4nt.lisp")
+   :ok)
+ :ok)
+
+(my-assert
+ (prolog-length (list (list 1 2)
+		      (list 3)))
+ 3)
+
+;;; From: Sam Steingold <sds@gnu.org>
+#+UNIX
+(my-assert
+ (let ((z (make-concatenated-stream
+	   (make-string-input-stream "abc")
+	   (open "/etc/hosts"))))
+   (read-line z)
+   (concatenated-stream-streams z)
+   :ok)
+ :ok)
+
+
+;;; From: Hannu Koivisto <azure@iki.fi>
+
+(my-assert
+ (case t)
+ nil)
+
+;;; From: Raymond Toy <toy@rtp.ericsson.se>
+
+(my-assert
+ (progn
+  (with-open-file (file "/tmp/foobar"
+			:direction :output
+			:if-exists :supersede)
+		  (princ #\F file))
+  (with-open-file (file "/tmp/foobar"
+			:direction :input)
+		  (let ((c (peek-char nil file nil 'eof t)))
+		    (list c (read file)
+			  (peek-char nil file nil 'eof t)))))
+ (#\F F EOF))
+
+;;; From Barry Margolin:
+
+#+cmu
+(my-assert
+ (> (length
+     (pcl:generic-function-lambda-list
+      (ensure-generic-function 'change-class)))
+    2)
+ T
+ "change-class (instance t) (new-class symbol) &rest initargs")
+
+;;; From the clisp CHANGES file:
+
+
+
+
+
diff --git a/src/ansi-tests/compile-bug1.lisp b/src/ansi-tests/compile-bug1.lisp
new file mode 100644
index 000000000..913bff00e
--- /dev/null
+++ b/src/ansi-tests/compile-bug1.lisp
@@ -0,0 +1,32 @@
+(in-package  :cl-user)
+
+;; from Douglas Thomas Crosher <dtc@seagull.cons.org> 
+
+;;; Compiling this file caused a type error in
+;;; maybe-convert-to-assignment due to a continuation-dest being
+;;; null. One of the refs to the inlined definition of nthcdr had been
+;;; marked for deletion, but this was seen. The path is ir1-optimize,
+;;; flush-dead-code; delete-ref; then maybe-convert-to-assignment.
+;;;
+;;; After patching maybe-convert-to-assignment to abort in this case,
+;;; the code compiles but compiles to a type error. Seems to be a
+;;; problem propagating the argument type to the inlined nthcdr
+;;; function?
+;;;
+
+(declaim (optimize (space 0) (debug 2)
+                   (c::compilation-speed 0) (speed 0)
+                   (c::brevity 0) (safety 0)))
+
+(proclaim '(inline wrappers (setf wrappers)))
+(defun wrappers (structure)
+  (declare (type list structure))
+  (elt structure 2))
+(defun (setf wrappers) (new-value structure)
+  (declare (type list structure))
+  (setf (elt structure 2) new-value))
+
+(defun tst (x)
+  (let ((wrappers (prog1 (wrappers x) (setf (wrappers x) nil)))
+        (fns (nthcdr 0 x)))
+    (car (nthcdr 0 x))))
diff --git a/src/ansi-tests/compile-bug2.lisp b/src/ansi-tests/compile-bug2.lisp
new file mode 100644
index 000000000..7f8be338d
--- /dev/null
+++ b/src/ansi-tests/compile-bug2.lisp
@@ -0,0 +1,33 @@
+(in-package :cl-user)
+;;; From: Fred Gilham <gilham@snapdragon.csl.sri.com>
+
+(let* ((original-read-table *readtable*)
+       (snepslog-read-table (copy-readtable nil))
+       (*readtable* snepslog-read-table))
+  (set-macro-character
+   #\,
+   #'(lambda (s c) (declare (ignore s c)) (quote \,)))
+  (set-macro-character
+   #\~
+   #'(lambda (s c) (declare (ignore s c)) (quote \~)))
+  (set-macro-character
+   #\.
+   #'(lambda (s c) (declare (ignore s c)) (quote \.)))
+  (set-macro-character
+   #\:
+   #'(lambda (s c) (declare (ignore s c)) (quote \:)))
+  (set-macro-character
+   #\{
+   #'(lambda (s c) (declare (ignore s c)) (quote \{)))
+  (set-macro-character
+   #\}
+   #'(lambda (s c) (declare (ignore s c)) (quote \})))
+
+  (defun snepslogreadon ()
+    "Sets the readtable to the snepslog read table"
+    (setq *readtable* snepslog-read-table))
+  
+  (defun snepslogreadoff ()
+    "Sets  the readtable to the original readtable
+(a copy of the initial readtable)"
+    (setq *readtable* original-read-table)))
diff --git a/src/ansi-tests/compile-bug3.lisp b/src/ansi-tests/compile-bug3.lisp
new file mode 100644
index 000000000..45c3b039a
--- /dev/null
+++ b/src/ansi-tests/compile-bug3.lisp
@@ -0,0 +1,11 @@
+(in-package :cl-user)
+
+;;; From: "Fernando D. Mato Mira" <matomira@iname.com>
+
+(defun prolog-length (p)
+  (let ((x (length (car p))))
+    (reduce #'(lambda (v1 v2)
+		(declare (ignore v1))
+		(setq x (+ x (length v2))))
+	    p)))
+
diff --git a/src/ansi-tests/compile-bug4.lisp b/src/ansi-tests/compile-bug4.lisp
new file mode 100644
index 000000000..559d59a2f
--- /dev/null
+++ b/src/ansi-tests/compile-bug4.lisp
@@ -0,0 +1,36 @@
+(in-package "CL-USER")
+
+(defun equal-terms (termx termy)
+  (labels
+    ((alpha-equal-bound-term-lists (listx listy)
+       (or (and (null listx) (null listy))
+           (and listx listy
+                (let ((bindings-x (bindings-of-bound-term (car listx)))
+                      (bindings-y (bindings-of-bound-term (car listy))))
+                  (if (and (null bindings-x) (null bindings-y))
+                      (alpha-equal-terms (term-of-bound-term (car listx))
+                                         (term-of-bound-term (car listy)))
+                      (and (= (length bindings-x) (length bindings-y))
+                           (prog2
+                               (enter-binding-pairs (bindings-of-bound-term (car listx))
+                                                    (bindings-of-bound-term (car listy)))
+                               (alpha-equal-terms (term-of-bound-term (car listx))
+                               (alpha-equal-terms (term-of-bound-term (car listx))
+                                                  (term-of-bound-term (car listy)))
+                             (exit-binding-pairs (bindings-of-bound-term (car listx))
+                                                 (bindings-of-bound-term (car listy)))))))
+                (alpha-equal-bound-term-lists (cdr listx) (cdr listy)))))
+
+     (alpha-equal-terms (termx termy)
+       (if (and (variable-p termx)
+                (variable-p termy))
+           (equal-bindings (id-of-variable-term termx)
+                           (id-of-variable-term termy))
+           (and (equal-operators-p (operator-of-term termx) (operator-of-term termy))
+                (alpha-equal-bound-term-lists (bound-terms-of-term termx)
+                                              (bound-terms-of-term termy))))))
+
+    (or (eq termx termy)
+        (and termx termy
+             (with-variable-invocation (alpha-equal-terms termx termy)))))))
+
diff --git a/src/ansi-tests/compile-bug4nt.lisp b/src/ansi-tests/compile-bug4nt.lisp
new file mode 100644
index 000000000..9a86d18ec
--- /dev/null
+++ b/src/ansi-tests/compile-bug4nt.lisp
@@ -0,0 +1,34 @@
+(in-package "USER")
+
+(defun equal-terms (termx termy)
+  (labels
+      ((alpha-equal-bound-term-lists (listx listy)
+	 (or (and (null listx) (null listy))
+	     (and listx listy
+		  (let ((bindings-x (bindings-of-bound-term (car listx)))
+			(bindings-y (bindings-of-bound-term (car listy))))
+		    (if (and (null bindings-x) (null bindings-y))
+		      (alpha-equal-terms (term-of-bound-term (car listx))
+					 (term-of-bound-term (car listy)))
+		      (and (= (length bindings-x) (length bindings-y))
+			   (prog2
+			       (enter-binding-pairs (bindings-of-bound-term (car listx))
+						    (bindings-of-bound-term (car listy)))
+			       (alpha-equal-terms (term-of-bound-term (car listx))
+						  (term-of-bound-term (car listy)))
+			     (exit-binding-pairs (bindings-of-bound-term (car listx))
+						 (bindings-of-bound-term (car listy)))))))
+		  (alpha-equal-bound-term-lists (cdr listx) (cdr listy)))))
+
+       (alpha-equal-terms (termx termy)
+	 (if (and (variable-p termx)
+		  (variable-p termy))
+	   (equal-bindings (id-of-variable-term termx)
+			   (id-of-variable-term termy))
+	   (and (equal-operators-p (operator-of-term termx) (operator-of-term termy))
+		(alpha-equal-bound-term-lists (bound-terms-of-term termx)
+					      (bound-terms-of-term termy))))))
+
+    (or (eq termx termy)
+	(and termx termy
+	     (with-variable-invocation (alpha-equal-terms termx termy))))))
diff --git a/src/ansi-tests/compile-bug5.lisp b/src/ansi-tests/compile-bug5.lisp
new file mode 100644
index 000000000..e0409066e
--- /dev/null
+++ b/src/ansi-tests/compile-bug5.lisp
@@ -0,0 +1,20 @@
+(in-package :cl-user)
+
+(defun tickle-bug ()
+  (labels ((fun1 ()
+             (fun2))
+           (fun2 ()
+             (when nil
+               (tagbody
+                tag   
+                  (fun2)
+                  (go tag)))
+             (when nil
+               (tagbody
+                tag
+                  (fun1)
+                  (go tag)))))
+    
+    (fun1)
+    nil))
+
diff --git a/src/ansi-tests/compile-bug6.lisp b/src/ansi-tests/compile-bug6.lisp
new file mode 100644
index 000000000..a3d4506f5
--- /dev/null
+++ b/src/ansi-tests/compile-bug6.lisp
@@ -0,0 +1,9 @@
+(in-package :cl-user)
+
+(defclass super1 () ())
+
+(defclass sub1 (super1)())
+
+(defun fooey ()
+  (make-instance 'sub1))
+
diff --git a/src/ansi-tests/conditions.lisp b/src/ansi-tests/conditions.lisp
new file mode 100644
index 000000000..3f9f6f085
--- /dev/null
+++ b/src/ansi-tests/conditions.lisp
@@ -0,0 +1,554 @@
+;;; based on v1.6 -*- mode: lisp -*-
+;;;; Test suite for the Common Lisp condition system
+;;;; Written by David Gadbois <gadbois@cs.utexas.edu> 30.11.1993
+(in-package :cl-user)
+
+;;;
+;;; Helpers
+;;;
+
+#+(or clisp allegro cmu sbcl)
+(my-assert
+ #+CLISP
+ (defun my-cpl (class)
+   (clos::class-precedence-list (clos:find-class class))
+   )
+ #+ALLEGRO
+ (defun my-cpl (class)
+   (clos:finalize-inheritance (find-class class))
+   (clos:class-precedence-list (find-class class))
+   )
+ #+cmu
+ (defun my-cpl (class)
+   (pcl:class-precedence-list (find-class class))
+   )
+ #+sbcl
+ (defun my-cpl (class)
+   (sb-pcl:class-precedence-list (find-class class))
+   )
+ MY-CPL)
+
+(my-assert
+ (defun check-superclasses (class expected)
+   (let ((expected (list* class 't
+			  #+CLISP 'clos:standard-object
+			  #+ALLEGRO 'standard-object
+			  #+(or cmu sbcl) 'instance
+			  'condition expected))
+	 (super (mapcar #' #+CLISP clos:class-name
+			   #+ALLEGRO class-name
+			   #+cmu pcl:class-name
+			   #+sbcl sb-pcl:class-name
+			   (my-cpl class))))
+     (and (null (set-difference super expected))
+	  (null (set-difference expected super)))))
+ CHECK-SUPERCLASSES)
+
+;;;
+;;; IGNORE-ERRORS
+;;;
+;;; If this does not work, none of the tests that check for getting an error
+;;; will.
+
+;;; IGNORE-ERRORS should work.
+(my-assert
+ (multiple-value-bind (value condition)
+     (ignore-errors (error "Foo"))
+   (list value (type-of condition)))
+ (nil simple-error))
+
+;;; IGNORE-ERRORS should not interfere with values in non-error situations.
+(my-assert
+ (multiple-value-list
+  (ignore-errors (values 23 42)))
+ (23 42))
+
+;;;
+;;; Predefined condition types.
+;;;
+
+(my-assert
+ (check-superclasses 'warning '()) T)
+
+
+(my-assert
+ (check-superclasses 'style-warning '(warning))
+ T)
+
+(my-assert
+ (check-superclasses 'serious-condition '())
+ T)
+
+(my-assert
+ (check-superclasses 'error '(serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'cell-error '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'parse-error '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'storage-condition '(serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'simple-error '(simple-condition error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'simple-condition '())
+ T)
+
+(my-assert
+ (check-superclasses 'simple-warning '(simple-condition warning))
+ T)
+
+(my-assert
+ (check-superclasses 'file-error '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'control-error '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'program-error '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'undefined-function '(cell-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'arithmetic-error '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'division-by-zero '(arithmetic-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'floating-point-invalid-operation '(arithmetic-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'floating-point-inexact '(arithmetic-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'floating-point-overflow '(arithmetic-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'floating-point-underflow '(arithmetic-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'unbound-slot '(cell-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'package-error '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'print-not-readable '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'reader-error '(parse-error stream-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'stream-error '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'end-of-file '(stream-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'unbound-variable '(cell-error error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'type-error '(error serious-condition))
+ T)
+
+(my-assert
+ (check-superclasses 'simple-type-error
+		     '(simple-condition
+		       type-error error serious-condition))
+ T
+ "Condition Type SIMPLE-TYPE-ERROR 
+
+Class Precedence List:
+
+simple-type-error, simple-condition, type-error, error, serious-condition, condition, t 
+")
+
+;;;
+;;; Defining conditions.
+;;;
+(my-assert
+ (progn (define-condition test () ()) t)
+ T)
+
+(my-assert
+ (check-superclasses  'test '())
+ T)
+
+(my-assert
+ (progn (define-condition test2 (test) ()) t)
+ T)
+
+(my-assert
+ (check-superclasses 'test2 '(test))
+ T)
+
+(my-assert
+ (progn (define-condition test3 (test2 simple-condition) ()) t)
+ T)
+
+(my-assert
+ (check-superclasses 'test3 '(test2 test simple-condition))
+ T)
+
+;;;
+;;; Making conditions
+;;;
+(my-assert
+ (progn (make-condition 'test) t)
+ T)
+
+(my-assert
+ (ignore-errors (progn (make-condition 'integer) t))
+ NIL)
+
+;;;
+;;; :REPORT option to DEFINE-CONDITION
+;;;
+(my-assert
+ (progn (define-condition test4 (test3)
+	  ()
+	  (:report (lambda (condition stream)
+		     (format stream "Yow! -- ~S" (type-of condition)))))
+	t)
+ T)
+
+(my-assert
+ (with-output-to-string (s) (princ (make-condition 'test4) s))
+ "Yow! -- TEST4")
+
+(my-assert
+ (progn (define-condition test5 (test4) ()) t)
+ T)
+
+(my-assert
+ (with-output-to-string (s) (princ (make-condition 'test5) s))
+ "Yow! -- TEST5")
+
+(my-assert
+ (with-output-to-string (s)
+   (princ (make-condition 'test3
+			  :format-control "And How! -- ~S"
+			  :format-arguments '(23)) s))
+ "And How! -- 23"
+ "From simple-condition:
+
+The type simple-condition represents conditions that are signaled by
+signal whenever a format-control is supplied as the function's first
+argument. The format control and format arguments are initialized with
+the initialization arguments named :format-control and
+:format-arguments to make-condition, and are accessed by the functions
+simple-condition-format-control and
+simple-condition-format-arguments. If format arguments are not
+supplied to make-condition, nil is used as a default. "
+ )
+
+;;;
+;;; Condition slots.
+;;;
+(my-assert
+ (progn (define-condition test6 (test4)
+	  ((foo :initarg :foo :initform 23 :accessor test6-foo))
+	  (:report (lambda (condition stream)
+		     (format stream "~S -- ~S"
+			     (type-of condition)
+			     (test6-foo condition)))))
+	t)
+ T)
+
+(my-assert
+ (test6-foo (make-condition 'test6))
+ 23)
+
+(my-assert
+ (test6-foo (make-condition 'test6 :foo 42))
+ 42)
+
+(my-assert
+ (setf (test6-foo (make-condition 'test6 :foo 42)) 17)
+ 17)
+
+(my-assert
+ (with-output-to-string (s) (princ (make-condition 'test6 :foo 42) s))
+ "TEST6 -- 42")
+
+;;;
+;;; HANDLER-BIND
+;;;
+
+;;; You do not have to bind handlers.
+(my-assert
+ (ignore-errors
+   (handler-bind
+    ()
+    (error "Foo")))
+ nil)
+
+;;; Handlers should not interfere with values in non-error situations.
+(my-assert
+ (multiple-value-list
+  (block foo
+    (handler-bind
+     ((error #'(lambda (c)
+		 (declare (ignore c))
+		 (return-from foo 23))))
+     (values 42 17))))
+ (42 17))
+
+;;; Handlers should work.
+(my-assert
+ (multiple-value-list
+  (block foo
+    (handler-bind
+     ((error #'(lambda (c)
+		 (declare (ignore c))
+		 (return-from foo (values 23 17)))))
+     (error "Foo"))))
+ (23 17))
+
+;;; Only the appropriate handlers should be called.
+(my-assert
+ (ignore-errors
+   (block foo
+     (handler-bind
+      ((type-error #'(lambda (c)
+		       (declare (ignore c))
+		       (return-from foo 23))))
+      (error "Foo"))))
+ nil)
+
+;;; Handlers can be specified type expressions.
+(my-assert
+ (block foo
+   (handler-bind
+    (((or type-error error)
+      #'(lambda (c)
+	  (declare (ignore c))
+	  (return-from foo 23))))
+    (error "Foo")))
+ 23
+ "typespecifier can be non-trivial.")
+
+;;; Handlers should be undone.
+(my-assert
+ (ignore-errors
+   (block foo
+     (let ((first-time t))
+       (handler-bind
+	((error
+	  #'(lambda (c)
+	      (declare (ignore c))
+	      (if first-time
+		  (progn
+		    (setq first-time nil)
+		    (error "Bar"))
+		  (return-from foo 23)))))
+	(error "Foo")))))
+ nil)
+
+;;; Handlers should be undone.
+(my-assert
+ (block foo
+   (let ((first-time t))
+     (handler-bind
+      ((error
+	#'(lambda (c)
+	    (declare (ignore c))
+	    (return-from foo 23))))
+      (handler-bind
+       ((error
+	 #'(lambda (c)
+	     (declare (ignore c))
+	     (if first-time
+		 (progn
+		   (setq first-time nil)
+		   (error "Bar"))
+		 (return-from foo 42)))))
+       (error "Foo")))))
+ 23)
+
+;;; Handlers in the same cluster should be accessible.
+(my-assert
+ (ignore-errors
+   (block foo
+     (handler-bind
+      ((error
+	#'(lambda (c) (declare (ignore c)) nil))
+       (error
+	#'(lambda (c)
+	    (declare (ignore c))
+	    (return-from foo 23))))
+      (error "Foo"))))
+ 23
+ "If a handler declines (ie. just return) the next available is used, so
+ the first one just returns nil, and the second, returning 23 is called")
+
+;;; Multiple handlers should work.
+(my-assert
+ (block foo
+   (handler-bind
+    ((type-error
+      #'(lambda (c)
+	  (declare (ignore c))
+	  (return-from foo 42)))
+     (error
+      #'(lambda (c)
+	  (declare (ignore c))
+	  (return-from foo 23))))
+    (error "Foo")))
+ 23)
+
+;;; Handlers should be undone.
+(my-assert
+ (block foo
+   (handler-bind
+    ((error #'(lambda (c)
+		(declare (ignore c))
+		(return-from foo 23))))
+    (block bar
+      (handler-bind
+       ((error #'(lambda (c)
+		   (declare (ignore c))
+		   (return-from foo 42))))
+       (return-from bar)))
+    (error "Foo")))
+ 23)
+
+;;;
+;;; HANDLER-CASE
+;;;
+
+;;; HANDLER-CASE should handle errors.
+(my-assert
+ (multiple-value-list
+  (handler-case
+   (error "Foo")
+   (error (c) (when (typep c 'error) (values 23 42)))))
+ (23 42))
+
+;;; Except those it doesn't handle.
+(my-assert
+ (ignore-errors
+   (handler-case
+    (error "Foo")
+    (type-error () 23)))
+ NIL)
+
+;;; You don't have to specify handlers.
+(my-assert
+ (ignore-errors
+   (handler-case
+    (error "Foo")))
+ NIL)
+
+;;; HANDLER-CASE should not interfere with values in non-error situations.
+(my-assert
+ (multiple-value-list
+  (handler-case
+   (values 42 17)
+   (error () 23)))
+ (42 17))
+
+;;; :NO-ERROR should return values.
+(my-assert
+ (multiple-value-list
+  (handler-case
+   (values 23 42)
+   (:no-error (a b)
+	      (values b a))))
+ (42 23))
+
+;;; Except when there is an error.
+(my-assert
+ (handler-case
+  (error "Foo")
+  (error () 23)
+  (:no-error (&rest args) (declare (ignore args)) 42))
+ 23)
+
+;;; Or if it is not the last clause.
+(my-assert
+ (handler-case
+  23
+  (:no-error (v) (1+ v))
+  (error () 42))
+ 24
+ "The spec is not 100% clear here...
+Macro HANDLER-CASE 
+
+Syntax:
+
+handler-case expression [[{error-clause}* | no-error-clause]] => result*
+
+clause::= error-clause | no-error-clause
+
+So in the cause thing the no-error-clause can be everwhere,
+in the real thing it looks like it can only be last.
+
+Need to ask comp.lang.lisp...
+
+")
+
+;;; Multiple handlers should be OK.
+(my-assert
+ (handler-case
+  (error "Foo")
+  (type-error () 23)
+  (error () 42))
+ 42)
+
+;;; Handlers should get undone.
+(my-assert
+ (ignore-errors
+   (progn
+     (block foo
+       (handler-case
+	(return-from foo 23)
+	(error () 42)))
+     (error "Foo")))
+ NIL)
+
+;;; Ditto.
+(my-assert
+ (ignore-errors
+   (block foo
+     (let ((first-time t))
+       (handler-case
+	(error "Foo")
+	(error ()
+	       (if first-time
+		   (progn
+		     (setf first-time nil)
+		     (error "Bar"))
+		   (return-from foo 23)))))))
+ NIL)
+
+
+
diff --git a/src/ansi-tests/eval20.lisp b/src/ansi-tests/eval20.lisp
new file mode 100644
index 000000000..b0e2959ee
--- /dev/null
+++ b/src/ansi-tests/eval20.lisp
@@ -0,0 +1,68 @@
+;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+;; testen abschitt 20
+
+
+;;  eval
+
+(my-assert
+ (eval (list 'cdr
+	     '(car (list (cons 'a 'b) 'c))))
+ b)
+
+(my-assert
+ (makunbound 'x)
+ x)
+
+(my-assert
+ (eval 'x)
+ UNBOUND-VARIABLE)
+
+(my-assert
+ (setf x 3)
+ 3)
+
+(my-assert
+ (eval 'x)
+ 3)
+
+;; constantp
+
+(my-assert
+ (constantp 2)
+ T)
+
+(my-assert
+ (constantp #\r)
+ T)
+
+(my-assert
+ (constantp "max")
+ T)
+
+(my-assert
+ (constantp '#(110))
+ T)
+
+(my-assert
+ (constantp :max)
+ T)
+
+(my-assert
+ (constantp T)
+ T)
+
+(my-assert
+ (constantp NIL)
+ T)
+
+(my-assert
+ (constantp 'PI)
+ #-CLISP T
+ #+CLISP NIL)
+
+(my-assert
+ (constantp '(quote foo))
+ T)
+
diff --git a/src/ansi-tests/excepsit.lisp b/src/ansi-tests/excepsit.lisp
new file mode 100644
index 000000000..e72674dea
--- /dev/null
+++ b/src/ansi-tests/excepsit.lisp
@@ -0,0 +1,1574 @@
+;;; based on 1.6 -*- mode: lisp -*-
+(in-package :cl-user)
+
+;;; Test "Exceptional situations" as specified by CLHS
+
+;; NB: CLHS section 1.4.2 implies that we have to verify only those
+;; specifications which have the wording "an error is signalled" or
+;; "an error should be signalled".
+
+#-(or cmu sbcl);; XXXX
+(my-assert
+ (abort)
+ control-error)
+
+(my-assert
+ (acos 'x)
+ type-error)
+
+(my-assert
+ (acosh 'x)
+ type-error)
+
+(my-assert
+ (progn
+   (defgeneric foo01 (x))
+   (defmethod foo01 ((x number)) t)
+   (let ((m (find-method #'foo01 nil (list (find-class 'number)))))
+     (remove-method #'foo01 m)
+     (defgeneric foo01 (x y))
+     (add-method #'foo01 m)
+     ) )
+ error)
+
+#-CLISP
+(my-assert
+ ;; documented behaviour of ADD-METHOD
+ (progn
+   (defgeneric foo02 (x))
+   (defmethod foo02 ((x number)) t)
+   (let ((m (find-method #'foo02 nil (list (find-class 'number)))))
+     ; wrong, not? (remove-method #'foo02 m)
+     (defgeneric foo03 (x))
+     (add-method #'foo03 m)
+     ) )
+ error
+ "add-method:...
+
+If method is a method object of another generic function,
+an error of type error is signaled. ")
+
+(my-assert
+ (let ((a (make-array 5 :adjustable t)))
+   (adjust-array a 4 :fill-pointer 1)
+   )
+ error)
+
+(my-assert
+ (adjustable-array-p '(x))
+ type-error)
+
+(my-assert
+ (alpha-char-p 33)
+ type-error)
+
+(my-assert
+ (alphanumericp 33)
+ type-error)
+
+(my-assert
+ (array-dimensions '(x))
+ type-error)
+
+(my-assert
+ (array-displacement '(x))
+ type-error)
+
+(my-assert
+ (array-element-type '(x))
+ type-error)
+
+(my-assert
+ (array-has-fill-pointer-p '(x))
+ type-error)
+
+(my-assert
+ (array-rank '(x))
+ type-error)
+
+(my-assert
+ (array-total-size '(x))
+ type-error)
+
+(my-assert
+ (ash 3/4 2)
+ type-error)
+
+(my-assert
+ (ash 3 4.0)
+ type-error)
+
+(my-assert
+ (asin 'x)
+ type-error)
+
+(my-assert
+ (asinh 'x)
+ type-error)
+
+(my-assert
+ (atan 'x)
+ type-error)
+
+(my-assert
+ (atan #c(0 0.4) 3.4)
+ type-error)
+
+(my-assert
+ (atan -4 #c(3 4))
+ type-error)
+
+(my-assert
+ (atanh 'x)
+ type-error)
+
+(my-assert
+ (boole 'x 3 4)
+ type-error)
+
+(my-assert
+ (boole boole-and 3/4 -7)
+ type-error)
+
+(my-assert
+ (boole boole-set 5 #c(-3 4))
+ type-error)
+
+(my-assert
+ (both-case-p 33)
+ type-error)
+
+(my-assert
+ (boundp 47)
+ type-error)
+
+(my-assert
+ (butlast '(a b c) -1)
+ type-error)
+
+(my-assert
+ (butlast '#(a b c))
+ type-error)
+
+(my-assert
+ (car 'x)
+ type-error)
+
+(my-assert
+ (cdr '#(a b c))
+ type-error)
+
+(my-assert
+ (cdadar '((x y)))
+ type-error)
+
+(my-assert
+ (progn
+   (defgeneric foo04 (x))
+   (defmethod foo04 ((x real)) 'ok)
+   (defmethod foo04 ((x integer)) (call-next-method (sqrt x)))
+   (foo04 -1))
+ error
+ "(sqrt -1) is not a real...")
+
+(my-assert
+ (progn
+   (defgeneric foo041 (x))
+   (defmethod foo041 ((x real)) 'ok)
+   (defmethod foo041 ((x integer)) (call-next-method (sqrt x)))
+   (foo041 2))
+ error
+ "CLHS:  When providing arguments to CALL-NEXT-METHOD, the following
+ rule must be satisfied or an error of type ERROR should be signaled:
+ the ordered set of applicable methods for a changed set of arguments
+ for CALL-NEXT-METHOD must be the same as the ordered set of applicable
+ methods for the original arguments to the generic function.")
+
+(my-assert
+ (ccase 'x)
+ type-error)
+
+(my-assert
+ (char-code 33)
+ type-error)
+
+(my-assert
+ (char-downcase 33)
+ type-error)
+
+(my-assert
+ (char-equal)
+ program-error)
+
+(my-assert
+ (char-greaterp)
+ program-error)
+
+(my-assert
+ (char-lessp)
+ program-error)
+
+(my-assert
+ (char-name 33)
+ type-error)
+
+(my-assert
+ (char-not-equal)
+ program-error)
+
+(my-assert
+ (char-not-greaterp)
+ program-error)
+
+(my-assert
+ (char-not-lessp)
+ program-error)
+
+(my-assert
+ (char-upcase 33)
+ type-error)
+
+(my-assert
+ (char/=)
+ program-error)
+
+(my-assert
+ (char<)
+ program-error)
+
+(my-assert
+ (char<=)
+ program-error)
+
+(my-assert
+ (char=)
+ program-error)
+
+(my-assert
+ (char>)
+ program-error)
+
+(my-assert
+ (char>=)
+ program-error)
+
+(my-assert
+ (character "abc")
+ type-error)
+
+(my-assert
+ (character "")
+ type-error)
+
+(my-assert
+ (character 33)
+ type-error)
+
+(my-assert
+ (clear-input '*terminal-io*)
+ type-error)
+
+(my-assert
+ (clear-output '*terminal-io*)
+ type-error)
+
+(my-assert
+ (coerce '(a b c) '(vector * 4))
+ type-error)
+
+(my-assert
+ (coerce '#(a b c) '(vector * 4))
+ type-error)
+
+(my-assert
+ (coerce '(a b c) '(vector * 2))
+ type-error)
+
+(my-assert
+ (coerce '#(a b c) '(vector * 2))
+ type-error)
+
+(my-assert
+ (coerce "foo" '(string 2))
+ type-error)
+
+(my-assert
+ (coerce '#(#\a #\b #\c) '(string 2))
+ type-error)
+
+(my-assert
+ (coerce '(0 1) '(simple-bit-vector 3))
+ type-error)
+
+(my-assert
+ (coerce nil 'nil)
+ type-error)
+
+(my-assert
+ (coerce '#:nonexistent 'function)
+ error)
+
+(my-assert
+ (coerce 'and 'function)
+ error)
+
+(my-assert
+ (compile-file "/tmp/12836123.lsp")
+ file-error)
+
+(my-assert
+ (concatenate 'symbol)
+ error)
+
+(my-assert
+ (concatenate '(string 3) "ab" "cd")
+ type-error)
+
+#-CLISP
+(my-assert
+ (copy-pprint-dispatch 'x)
+ type-error)
+
+(my-assert
+ (copy-seq 'x)
+ type-error)
+
+(my-assert
+ (copy-symbol #\x)
+ type-error)
+
+(my-assert
+ (cos 'x)
+ type-error)
+
+(my-assert
+ (cosh 'x)
+ type-error)
+
+(my-assert
+ (count #\x 'x)
+ type-error)
+
+(my-assert
+ (let ((x nil)) (ctypecase x))
+ type-error)
+
+(my-assert
+ (decode-float 2/3)
+ type-error)
+
+(my-assert
+ (defclass foo05 () (a b a))
+ program-error
+ "defclass:
+...
+If there are any duplicate slot names,
+an error of type program-error is signaled. ")
+
+(my-assert
+ (defclass foo06 () (a b) (:default-initargs x a x b))
+ program-error
+ "defclass:
+...
+If an initialization argument name appears more
+than once in :default-initargs class option, an
+error of typeprogram-error is signaled. ")
+
+(my-assert
+ (defclass foo07 () ((a :allocation :class :allocation :class)))
+ program-error
+ "defclass:
+...
+If any of the following slot options appears more than once in a
+single slot description, an error of type program-error is
+signaled: :allocation, :initform, :type, :documentation.")
+
+(my-assert
+ (defclass foo08 () ((a :initform 42 :initform 42)))
+ program-error
+ "defclass:
+...
+If any of the following slot options appears more than once in a
+single slot description, an error of type program-error is
+signaled: :allocation, :initform, :type, :documentation.")
+
+(my-assert
+ (defclass foo09 () ((a :type real :type real)))
+ program-error
+ "defclass:
+...
+If any of the following slot options appears more than once in a
+single slot description, an error of type program-error is
+signaled: :allocation, :initform, :type, :documentation.")
+
+(my-assert
+ (defclass foo10 () ((a :documentation "bla" :documentation "blabla")))
+ program-error
+ "defclass:
+...
+If any of the following slot options appears more than once in a
+single slot description, an error of type program-error is
+signaled: :allocation, :initform, :type, :documentation.")
+
+(my-assert
+ (defgeneric if (x))
+ program-error
+ "defgeneric:
+...
+If function-name names an ordinary function,
+a macro, or a special operator, an error of type
+program-error is signaled.")
+
+(my-assert
+ (progn
+   (defmacro foo11 (x) x)
+   (defgeneric foo11 (x)))
+ program-error
+ "defgeneric:
+...
+If function-name names an ordinary function,
+a macro, or a special operator, an error of type
+program-error is signaled.")
+
+(my-assert
+ (progn
+   (defun foo12 (x) x)
+   (defgeneric foo12 (x)))
+ program-error
+ "defgeneric:
+...
+If function-name names an ordinary function,
+a macro, or a special operator, an error of type
+program-error is signaled.")
+
+(my-assert
+ (defgeneric foo13 (x y &rest l)
+   (:method (x y))
+   )
+ error
+ "")
+
+(my-assert
+ (defgeneric foo14 (x)
+   (:documentation "bla")
+   (:documentation "blabla")
+   )
+ program-error)
+
+(my-assert
+ (defgeneric foo15 (x)
+   (:my-option t))
+ program-error)
+
+;;  define-method-combination is too complicated
+
+(my-assert
+ (progn
+   (defvar foo16)
+   (define-symbol-macro foo16 t))
+ program-error)
+
+(my-assert
+ (defmethod if (x) nil)
+ error)
+
+(my-assert
+ (progn
+   (defmacro foo17 (x) x)
+   (defmethod foo17 (x) nil))
+ error)
+
+(my-assert
+ (progn
+   (defun foo18 (x) x)
+   (defmethod foo18 (x) nil))
+ error)
+
+(my-assert
+ (progn
+   (defgeneric foo19 (x))
+   (defmethod foo19 (x y) nil))
+ error)
+
+(my-assert
+ (progn
+   (defpackage "FOO20")
+   (defpackage "FOO21" (:nicknames "FOO20")))
+ package-error)
+
+(my-assert
+ (defpackage "FOO22" (:size 20) (:size 20))
+ program-error)
+
+(my-assert
+ (defpackage "FOO23" (:documentation "bla") (:documentation "blabla"))
+ program-error)
+
+(my-assert
+ (defpackage "FOO24" (:my-option t))
+ program-error)
+
+(my-assert
+ (defpackage "FOO25" (:shadow "IF") (:intern "IF"))
+ program-error)
+
+(my-assert
+ (defpackage "FOO26" (:shadow "IF") (:import-from "USER" "IF"))
+ program-error)
+
+(my-assert
+ (defpackage "FOO27" (:shadow "IF") (:shadowing-import-from "USER" "IF"))
+ program-error)
+
+(my-assert
+ (defpackage "FOO28" (:intern "IF") (:import-from "USER" "IF"))
+ program-error)
+
+(my-assert
+ (defpackage "FOO29" (:intern "IF") (:shadowing-import-from "USER" "IF"))
+ program-error)
+
+(my-assert
+ (defpackage "FOO30" (:import-from "USER" "IF") (:shadowing-import-from "USER" "IF"))
+ program-error)
+
+(my-assert
+ (defpackage "FOO31" (:export "IF") (:intern "IF"))
+ program-error)
+
+#-sbcl
+(my-assert
+ (defstruct foo32 a system::a)
+ program-error)
+
+#-sbcl
+(my-assert
+ (progn
+   (defstruct foo33 a)
+   (defstruct (foo34 (:include foo33)) system::a))
+ program-error)
+
+(my-assert
+ (delete #\x 'x)
+ type-error)
+
+(my-assert
+ (delete-duplicates 'abba)
+ type-error)
+
+;; deleting a non-existing file can be successful!
+;; the results are not easily predictable across implementations
+;;(my-assert
+;; (progn
+;;   (with-open-file (s "/tmp/foo35.tmp" :direction :output))
+;;   (delete-file "/tmp/foo35.tmp/bar"))
+;; nil or file-error??)
+
+(my-assert
+ (destructuring-bind (a) '(1 2) a)
+ error)
+
+;;  directory - no way to make a directory search fail
+
+#-CLISP
+(my-assert
+ ;; documented behaviour of DISASSEMBLE
+ (disassemble #x123456)
+ type-error)
+
+;;  dribble - no way to force a file-error
+
+(my-assert
+ (ecase 'x)
+ type-error)
+
+(my-assert
+ (elt 'x 0)
+ type-error)
+
+(my-assert
+ (elt "abc" 4)
+ type-error)
+
+(my-assert
+ (elt '(a b c) 4)
+ type-error)
+
+(my-assert
+ (elt '#(a b c) 4)
+ type-error)
+
+(my-assert
+ (elt (make-array 3 :fill-pointer 3 :adjustable t) 4)
+ type-error)
+
+(my-assert
+ (endp 'x)
+ type-error)
+
+(my-assert
+ (ensure-directories-exist "/*/")
+ file-error)
+
+(my-assert
+ (error 42)
+ type-error)
+
+(my-assert
+ (let ((x nil)) (etypecase x))
+ type-error)
+
+(my-assert
+ (every '(lambda (x) x) nil)
+ type-error)
+
+(my-assert
+ (every #'identity 'x)
+ type-error)
+
+(my-assert
+ (fboundp '(psetf aref))
+ type-error)
+
+(my-assert
+ (fdefinition '(psetf aref))
+ type-error)
+
+(my-assert
+ (fdefinition '#:nonexistent)
+ undefined-function)
+
+(my-assert
+ (file-author "*")
+ file-error)
+
+(my-assert
+ (file-length *terminal-io*)
+ type-error)
+
+(my-assert
+ (with-open-file (s "/tmp/foo35.tmp" :direction :output)
+		 (file-position s 0.0))
+ error)
+
+(my-assert
+ (with-open-file (s "/tmp/foo35.tmp" :direction :output)
+		 (file-position s -1))
+ error)
+
+(my-assert
+ (with-open-file (s "/tmp/foo35.tmp" :direction :input)
+		 (file-position s (+ (file-length s) 1000)))
+ error)
+
+(my-assert
+ (not (delete-file "/tmp/foo35.tmp"))
+ nil)
+
+(my-assert
+ (file-write-date "*")
+ file-error)
+
+(my-assert
+ (fill 'x #\x)
+ type-error)
+
+(my-assert
+ (fill (make-list 3) 'x :start nil)
+ type-error)
+
+(my-assert
+ (fill (make-list 3) 'x :start -1)
+ type-error)
+
+(my-assert
+ (fill (make-list 3) 'x :start 1 :end -1)
+ type-error)
+
+(my-assert
+ (fill-pointer "abc")
+ type-error)
+
+(my-assert
+ (find #\x 'x)
+ type-error)
+
+(my-assert
+ (find-class '#:nonexistent t)
+ error)
+
+(my-assert
+ (progn
+   (defgeneric foo36 (x y))
+   (find-method #'foo36 nil (list (find-class 'number))))
+ error)
+
+(my-assert
+ (progn
+   (defgeneric foo37 (x))
+   (find-method #'foo37 nil (list (find-class 'number))))
+ error)
+
+(my-assert
+ (finish-output '*terminal-io*)
+ type-error)
+
+(my-assert
+ (float-digits 2/3)
+ type-error)
+
+(my-assert
+ (float-precision 2/3)
+ type-error)
+
+(my-assert
+ (float-radix 2/3)
+ type-error)
+
+(my-assert
+ (float-sign 2/3)
+ type-error)
+
+(my-assert
+ (float-sign -4.5 2/3)
+ type-error)
+
+(my-assert
+ (fmakunbound '(psetf aref))
+ type-error)
+
+(my-assert
+ (force-output '*terminal-io*)
+ type-error)
+
+(my-assert
+ (funcall 'foo38)
+ undefined-function)
+
+(my-assert
+ (funcall 'and)
+ undefined-function)
+
+(my-assert
+ (gcd 4 3/4)
+ type-error)
+
+(my-assert
+ (gensym #\x)
+ type-error)
+
+(my-assert
+ (gentemp 't)
+ type-error)
+
+(my-assert
+ (gentemp "X" 24)
+ type-error)
+
+(my-assert
+ (get "a" 'x)
+ type-error)
+
+(my-assert
+ (get-dispatch-macro-character #\0 #\#)
+ error)
+
+(my-assert
+ (graphic-char-p 33)
+ type-error)
+
+(my-assert
+ (hash-table-rehash-size *readtable*)
+ type-error)
+
+(my-assert
+ (hash-table-rehash-threshold *package*)
+ type-error)
+
+(my-assert
+ (hash-table-size *random-state*)
+ type-error)
+
+(my-assert
+ (hash-table-test '#(a b c))
+ type-error)
+
+(my-assert
+ (imagpart #\c)
+ type-error)
+
+(my-assert
+ #-CLISP
+ (in-package "FOO39")
+ #+CLISP
+ (common-lisp:in-package "FOO39")
+ package-error)
+
+(my-assert
+ (input-stream-p (pathname "abc"))
+ type-error)
+
+(my-assert
+ (integer-decode-float 2/3)
+ type-error)
+
+(my-assert
+ (integer-length 0.0)
+ type-error)
+
+(my-assert
+ (interactive-stream-p (pathname "abc"))
+ type-error)
+
+(my-assert
+ (invoke-restart 'foo40)
+ control-error)
+
+(my-assert
+ (invoke-restart-interactively 'foo41)
+ control-error)
+
+(my-assert
+ (isqrt -1)
+ type-error)
+
+(my-assert
+ (isqrt #c(3 4))
+ type-error)
+
+(my-assert
+ (last '(a b c) -1)
+ type-error)
+
+(my-assert
+ (lcm 4/7 8)
+ type-error)
+
+(my-assert
+ (length 'x)
+ type-error)
+
+(my-assert
+ (list-length 'x)
+ type-error)
+
+(my-assert
+ (list-length '(x . y))
+ type-error)
+
+(my-assert
+ (load "/tmp/128347234.lsp")
+ file-error)
+
+(my-assert
+ (load "*.lsp")
+ file-error)
+
+(my-assert
+ (load-logical-pathname-translations "FOO41")
+ error)
+
+(my-assert
+ (logand -3 2.3)
+ type-error)
+
+(my-assert
+ (logbitp -1 5)
+ type-error)
+
+(my-assert
+ (logbitp 2 3/7)
+ type-error)
+
+(my-assert
+ (logcount #*01010011)
+ type-error)
+
+(my-assert
+ (logical-pathname '#(#\A #\B))
+ type-error)
+
+(my-assert
+ (logical-pathname-translations '#(#\A #\B))
+ type-error)
+
+(my-assert
+ (lower-case-p 33)
+ type-error)
+
+(my-assert
+ (make-broadcast-stream (make-string-input-stream "abc"))
+ type-error)
+
+(my-assert
+ (make-concatenated-stream (make-string-output-stream))
+ type-error)
+
+(my-assert
+ (progn
+   (defclass foo42 () ())
+   (make-instance 'foo42 :x 1))
+ error)
+
+(my-assert
+ (make-list -1)
+ type-error)
+
+(my-assert
+ (progn
+   (defstruct foo43)
+   (make-load-form (make-foo43)))
+ error)
+
+(my-assert
+ (make-random-state 'x)
+ type-error)
+
+(my-assert
+ (make-sequence 'x 5)
+ type-error)
+
+(my-assert
+ (make-sequence 'sequence 5)
+ type-error)
+
+(my-assert
+ (make-sequence '(string 3) 4)
+ type-error)
+
+(my-assert
+ (make-symbol 'x)
+ type-error)
+
+(my-assert
+ (make-synonym-stream *terminal-io*)
+ type-error)
+
+(my-assert
+ (make-two-way-stream (make-string-input-stream "abc") (make-string-input-stream "def"))
+ type-error)
+
+(my-assert
+ (make-two-way-stream (make-string-output-stream) (make-string-output-stream))
+ type-error)
+
+(my-assert
+ (makunbound "xx")
+ type-error)
+
+(my-assert
+ (map 'x #'identity "abc")
+ type-error)
+
+(my-assert
+ (map '(string 3) #'identity "ab")
+ type-error)
+
+(my-assert
+ (max 3 #c(4 0.0))
+ type-error)
+
+(my-assert
+ (merge '(vector * 5) '(3 1) '(2 4) #'<)
+ type-error)
+
+(my-assert
+ (min 3 #c(4 0.0))
+ type-error)
+
+(my-assert
+ (minusp #c(4 -3/4))
+ type-error)
+
+(my-assert
+ (muffle-warning)
+ control-error)
+
+(my-assert
+ (name-char '#(#\N #\u #\l))
+ type-error)
+
+(my-assert
+ (nbutlast '(a b c) -1)
+ type-error)
+
+(my-assert
+ (nbutlast '#(a b c))
+ type-error)
+
+(my-assert
+ (no-applicable-method #'cons)
+ error)
+
+(my-assert
+ (no-next-method #'print-object (find-method #'print-object nil (list (find-class 'standard-object) (find-class 't))))
+ error)
+
+(my-assert
+ (notany '(lambda (x) x) nil)
+ type-error)
+
+(my-assert
+ (notany #'identity 'x)
+ type-error)
+
+(my-assert
+ (notevery '(lambda (x) x) nil)
+ type-error)
+
+(my-assert
+ (notevery #'identity 'x)
+ type-error)
+
+(my-assert
+ (nthcdr 2 '(a . b))
+ type-error)
+
+(my-assert
+ (oddp 3.5)
+ type-error)
+
+#+UNIX
+(my-assert
+ (progn (open "/etc/passwd" :direction :input :if-exists :error) (/ 0))
+ division-by-zero)
+
+#+UNIX
+(my-assert
+ (progn (open "/etc/nonexistent" :direction :input :if-exists :error) (/ 0))
+ file-error)
+
+(my-assert
+ (open "/tmp/foo44nonexistent" :direction :input :if-does-not-exist :error)
+ file-error)
+
+(my-assert
+ (open "/tmp/*" :direction :input)
+ file-error)
+
+#+UNIX
+(my-assert
+ (open "/etc/mtab" :direction :input :external-format 'mtab-entries)
+ error)
+
+(my-assert
+ (open-stream-p (pathname "foo45"))
+ type-error)
+
+(my-assert
+ (output-stream-p (pathname "foo46"))
+ type-error)
+
+(my-assert
+ (package-name 47)
+ type-error)
+
+(my-assert
+ (package-nicknames (pathname "foo47"))
+ type-error)
+
+(my-assert
+ (package-shadowing-symbols (vector 'a 'b 'c))
+ type-error)
+
+(my-assert
+ (package-use-list (list 'a 'b 'c))
+ type-error)
+
+(my-assert
+ (package-used-by-list (list 'a 'b 'c))
+ type-error)
+
+(my-assert
+ (parse-integer "x-y")
+ error)
+
+(my-assert
+ (parse-namestring (coerce (list #\f #\o #\o (code-char 0) #\4 #\8) 'string))
+ parse-error)
+
+(my-assert
+ (parse-namestring "foo48:a" (logical-pathname "foo49:"))
+ error)
+
+(my-assert
+ (pathname-match-p 34 "*")
+ type-error)
+
+(my-assert
+ (pathname-match-p "x" 34)
+ type-error)
+
+(my-assert
+ (peek-char nil (make-string-input-stream "") t)
+ end-of-file)
+
+(my-assert
+ (peek-char #\space (make-string-input-stream "") t)
+ end-of-file)
+
+#|					; It's not clear why peek-char should signal an error, where read-char and
+;;  read-line don't. Kent Pitman says: "Sounds like a mess."
+(peek-char nil (make-string-input-stream "") nil nil t)
+end-of-file
+|#
+
+(my-assert
+ (phase 'x)
+ type-error)
+
+(my-assert
+ (plusp #c(0 4.2))
+ type-error)
+
+#-CLISP
+(my-assert
+ (pprint-dispatch nil t)
+ type-error)
+
+#-CLISP
+(my-assert
+ (pprint-exit-if-list-exhausted)
+ error)
+
+#-CLISP
+(my-assert
+ (pprint-indent nil 2)
+ error)
+
+#-CLISP
+(my-assert
+ (let ((x (make-string-output-stream)))
+   (pprint-logical-block (x nil :prefix 24)))
+ type-error)
+
+#-CLISP
+(my-assert
+ (let ((x (make-string-output-stream)))
+   (pprint-logical-block (x nil :prefix "a" :per-line-prefix "b")))
+ error)
+
+#-CLISP
+(my-assert
+ (pprint-newline :fresh)
+ type-error)
+
+#-CLISP
+(my-assert
+ (pprint-pop)
+ error)
+
+(my-assert
+ (pprint-tab :paragraph 0 1)
+ error)
+
+(my-assert
+ (let ((*print-readably* t)) (print-unreadable-object (nil *standard-output*)))
+ print-not-readable)
+
+(my-assert
+ (probe-file "*")
+ file-error)
+
+(my-assert
+ (provide 25)
+ type-error)
+
+(my-assert
+ (random -2.3)
+ type-error)
+
+(my-assert
+ (rational #c(2.4 -0.3))
+ type-error)
+
+(my-assert
+ (rationalize #c(2.4 -0.3))
+ type-error)
+
+(my-assert
+ (read (make-string-input-stream "((a b)") nil)
+ end-of-file)
+
+(my-assert
+ (read (make-string-input-stream " ") t)
+ end-of-file)
+
+(my-assert
+ (read-byte (pathname "foo50"))
+ type-error)
+
+(my-assert
+ (read-byte (make-string-input-stream "abc"))
+ error)
+
+(my-assert
+ (let ((filename "/tmp/foo51.bin"))
+   (with-open-file (s filename :direction :output
+		      :if-exists :overwrite
+		      :if-does-not-exist :create))
+   (with-open-file (s filename :direction :input
+		      :element-type '(unsigned-byte 8))
+		   (read-byte s t)))
+ end-of-file)
+
+(my-assert
+ (not (delete-file "/tmp/foo51.bin"))
+ nil)
+
+(my-assert
+ (let ((filename "/tmp/foo52.txt"))
+   (with-open-file (s filename :direction :output
+		      :if-exists :overwrite
+		      :if-does-not-exist :create))
+   (with-open-file (s filename :direction :input)
+		   (read-char s t)))
+ end-of-file)
+
+(my-assert
+ (not (delete-file "/tmp/foo52.txt"))
+ nil)
+
+(my-assert
+ (let ((filename "/tmp/foo53.txt"))
+   (with-open-file (s filename :direction :output
+		      :if-exists :overwrite
+		      :if-does-not-exist :create))
+   (with-open-file (s filename :direction :input)
+		   (read-char-no-hang s t)))
+ end-of-file)
+
+(my-assert
+ (not (delete-file "/tmp/foo53.txt"))
+ nil)
+
+(my-assert
+ (read-from-string "((a b))" nil nil :end 6)
+ end-of-file)
+
+(my-assert
+ (read-from-string " () () " t nil :start 3 :end 4)
+ end-of-file)
+
+(my-assert
+ (read-line (make-string-input-stream "") t)
+ end-of-file)
+
+(my-assert
+ (read-sequence (list 1 2 3) (make-string-input-stream "") :start nil)
+ type-error)
+
+(my-assert
+ (read-sequence (list 1 2 3) (make-string-input-stream "") :end -1)
+ type-error)
+
+(my-assert
+ (readtable-case nil)
+ type-error)
+
+(my-assert
+ (setf (readtable-case *readtable*) ':unknown)
+ type-error)
+
+(my-assert
+ (realpart #\c)
+ type-error)
+
+(my-assert
+ (progn
+   (defclass foo54 () ())
+   (reinitialize-instance (make-instance 'foo54) :dummy 0))
+ error)
+
+(my-assert
+ (remove #\x 'x)
+ type-error)
+
+(my-assert
+ (remove-duplicates 'abba)
+ type-error)
+
+(my-assert
+ (remprop 55 'abc)
+ type-error)
+
+(my-assert
+ (rplaca nil 5)
+ type-error)
+
+(my-assert
+ (rplacd nil 5)
+ type-error)
+
+(my-assert
+ (scale-float 2/3 -1)
+ type-error)
+
+(my-assert
+ (scale-float 3.4 1.0)
+ type-error)
+
+(my-assert
+ (set-dispatch-macro-character #\0 #\# #'(lambda (s c n) (loop)))
+ error)
+
+(my-assert
+ (set-pprint-dispatch '(vector * 2) nil #c(3 4))
+ error)
+
+(my-assert
+ (sin 'x)
+ type-error)
+
+(my-assert
+ (sinh 'x)
+ type-error)
+
+(my-assert
+ (sleep -1)
+ type-error)
+
+(my-assert
+ (progn
+   (defclass foo55 () (a))
+   (slot-boundp (make-instance 'foo55) ':a))
+ error)
+
+(my-assert
+ (progn
+   (defclass foo56 () (a))
+   (slot-makunbound (make-instance 'foo56) ':a))
+ error)
+
+(my-assert
+ (slot-missing (find-class 't) nil ':a 'setf)
+ error)
+
+(my-assert
+ (slot-unbound (find-class 't) nil ':a)
+ unbound-slot)
+
+(my-assert
+ (progn
+   (defclass foo57 () (a))
+   (slot-value (make-instance 'foo57) ':a))
+ error)
+
+(my-assert
+ (some '(lambda (x) x) nil)
+ type-error)
+
+(my-assert
+ (some #'identity 'x)
+ type-error)
+
+(my-assert
+ (special-operator-p '(and x y))
+ type-error)
+
+(my-assert
+ (special-operator-p '(setf aref))
+ type-error)
+
+(my-assert
+ (sqrt 'x)
+ type-error)
+
+(my-assert
+ (standard-char-p 33)
+ type-error)
+
+(my-assert
+ (stream-element-type '*terminal-io)
+ type-error)
+
+(my-assert
+ (string 33)
+ type-error)
+
+(my-assert
+ (symbol-function 33)
+ type-error)
+
+(my-assert
+ (symbol-function ':compile)
+ undefined-function)
+
+(my-assert
+ (symbol-macrolet ((t true)))
+ program-error)
+
+(my-assert
+ (symbol-macrolet ((*print-pretty* (stream-print-pretty *standard-output*))))
+ program-error)
+
+(my-assert
+ (symbol-macrolet ((foo58 t)) (declare (special foo58)))
+ program-error)
+
+(my-assert
+ (symbol-name '(setf foo59))
+ type-error)
+
+(my-assert
+ (symbol-package '(setf foo59))
+ type-error)
+
+(my-assert
+ (symbol-plist '(setf foo59))
+ type-error)
+
+(my-assert
+ (symbol-value '(setf foo59))
+ type-error)
+
+(my-assert
+ (symbol-value '#:nonexistent)
+ unbound-variable)
+
+(my-assert
+ (tan 'x)
+ type-error)
+
+(my-assert
+ (tanh 'x)
+ type-error)
+
+(my-assert
+ (throw '#:nonexistent nil)
+ control-error)
+
+(my-assert
+ (translate-logical-pathname (make-broadcast-stream))
+ type-error)
+
+(my-assert
+ (translate-logical-pathname (logical-pathname "foo61:"))
+ file-error)
+
+#-CLISP
+(my-assert
+ ;; clisp explicitly allows symbols as pathnames
+ (translate-pathname 'x "x" "y")
+ type-error)
+
+#-CLISP
+(my-assert
+ ;; clisp explicitly allows symbols as pathnames
+ (translate-pathname "a" '* '*)
+ type-error)
+
+(my-assert
+ (translate-pathname "x" "y" "z")
+ error)
+
+(my-assert
+ (truename "/tmp/foo62nonexistent")
+ file-error)
+
+(my-assert
+ (truename "/tmp/*/x")
+ file-error)
+
+(my-assert
+ (typep nil 'values)
+ error)
+
+(my-assert
+ (typep #'cons '(values t))
+ error)
+
+(my-assert
+ (typep #'cons '(function (t t) list))
+ error)
+
+(my-assert
+ (unexport ':foo63)
+ package-error)
+
+(my-assert
+ (progn
+   (defpackage "FOO64" (:export "XYZ"))
+   (defpackage "FOO65" (:export "XYZ"))
+   (defpackage "FOO66" (:use "FOO64" "FOO65") (:shadow "XYZ"))
+   (unintern (find-symbol "XYZ" (find-package "FOO66")) (find-package "FOO66")))
+ error)
+
+;;  update-instance-for-different-class too complicated
+
+;;  update-instance-for-redefined-class too complicated
+
+(my-assert
+ (upper-case-p 33)
+ type-error)
+
+(my-assert
+ (values-list '(a b . c))
+ type-error)
+
+(my-assert
+ (vector-pop "foo67")
+ type-error)
+
+(my-assert
+ (vector-pop (make-array 10 :fill-pointer 0))
+ error)
+
+(my-assert
+ (vector-push 'x (make-array 10))
+ error)
+
+(my-assert
+ (let ((a (make-array 5
+		      :fill-pointer 0
+		      :adjustable nil)))
+   (if (adjustable-array-p a)
+       'error
+       (dotimes (i 100) (vector-push-extend 'x a))))
+ error)
+
+(my-assert
+ (warn (make-condition 'error))
+ type-error)
+
+(my-assert
+ (warn (make-condition 'warning) "x")
+ type-error)
+
+(my-assert
+ (warn 'error)
+ type-error)
+
+(my-assert
+ (wild-pathname-p #\x)
+ type-error)
+
+(my-assert
+ (write-byte 1 (pathname "foo67"))
+ type-error)
+
+(my-assert
+ (write-byte 1 (make-string-output-stream))
+ error)
+
+(my-assert
+ (write-sequence '(#\1 #\2 #\3) (make-string-output-stream) :start nil)
+ type-error)
+
+(my-assert
+ (write-sequence '(#\1 #\2 #\3) (make-string-output-stream) :end -1)
+ type-error)
+
+(my-assert
+ (zerop 'x)
+ type-error)
+
+;;  section 2.3.1.1
+(my-assert
+ (read-from-string "-35/000")
+ reader-error)				; not division-by-zero!
+
+(my-assert
+ (read-from-string "31e300")
+ reader-error)				; not floating-point-overflow!
+
diff --git a/src/ansi-tests/format.lisp b/src/ansi-tests/format.lisp
new file mode 100644
index 000000000..41aa43cf1
--- /dev/null
+++ b/src/ansi-tests/format.lisp
@@ -0,0 +1,1295 @@
+;;; based on v1.3 -*- mode: lisp -*-
+(in-package :cl-user)
+
+;; ****************************************************************************
+;; *      Rosenmueller            format.tst                                  *
+;; ****************************************************************************
+
+;;  ~< ------------------------------------------------------------------------
+(my-assert
+ (format nil "~10<foo~;bar~>")
+ "foo    bar")
+
+(my-assert
+ (format nil "~10:<foo~;bar~>")
+ "  foo  bar")
+
+(my-assert
+ (format nil "~10@<foo~;bar~>")
+ "foo  bar  ")
+
+(my-assert
+ (format nil "~10:@<foo~;bar~>")
+ #+(or XCL CLISP ALLEGRO) "  foo bar "
+ #+(or AKCL cmu sbcl ecls) " foo bar  "
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl ecls) UNKNOWN)
+
+(my-assert
+ (format nil "~10<foobar~>")
+ "    foobar")
+
+(my-assert
+ (format nil "~10:<foobar~>")
+ "    foobar")
+
+(my-assert
+ (format nil "~10@<foobar~>")
+ "foobar    ")
+
+(my-assert
+ (format nil "~10:@<foobar~>")
+ "  foobar  ")
+
+;;  ~< ~s ~^ ---------------------------------------------------------------------
+(my-assert
+ (format nil "~15<~S~>" 'foo)
+ "            foo")
+
+(my-assert
+ (format nil "~15<~S~;~^~S~>" 'foo)
+ "            foo")
+
+(my-assert
+ (format nil "~15<~S~;~^~S~;~^~S~>" 'foo)
+ "            foo")
+
+(my-assert
+ (format nil "~15<~S~;~^~S~>" 'foo 'bar)
+ "foo         bar")
+
+(my-assert
+ (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar)
+ "foo         bar")
+
+(my-assert
+ (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz)
+ "foo   bar   baz")
+
+(my-assert
+ (format nil "~12<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz)
+ #+(or CLISP ALLEGRO) "foo  bar baz"
+ #+(OR CMU SBCL) "foo bar  baz"
+ #-(or CLISP ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (progn
+   (setq liste '(aaaaaaa bbbbbb cccccccccccc dddddddddddddd eeee fffffffff
+			 gggggggg
+			 hhhhh iiii j kk lll mmmm nnnnnn oooooooooo ppppppppppppppp qqqqqqq
+			 rrrrrrrrrrrr
+			 s ttt uuuuuuuuu vvvvvvv wwwwwwwwww xxxxx yyyyyy zzzzzzzz)) ;26
+   T)
+ T)
+
+(my-assert
+ (format nil "~%;; ~<~%;; ~1:; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~;~
+ ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~;~
+ ~s~; ~s~; ~s~; ~s~;~>~%"
+	 ;; 2!
+	 'aaaaaaa 'bbbbbb 'cccccccccccc 'dddddddddddddd 'eeee 'fffffffff 'gggggggg
+	 'hhhhh 'iiii 'j 'kk 'lll 'mmmm 'nnnnnn 'oooooooooo 'ppppppppppppppp
+	 'qqqqqqq
+	 'rrrrrrrrrrrr 's 'ttt 'uuuuuuuuu 'vvvvvvv 'wwwwwwwwww 'xxxxx 'yyyyyy
+	 'zzzzzzzz)
+ #+XCL
+ "
+;;  AAAAAAA  BBBBBB CCCCCCCCCCCC DDDDDDDDDDDDDD EEEE FFFFFFFFF GGGGGGGG
+;;  HHHHH  IIII  JKK LLL MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ
+;;  RRRRRRRRRRRR    S    TTT   UUUUUUUUU   VVVVVVV   WWWWWWWWWW   XXXXX
+"
+ ;; 23456789;123456789;123456789;123456789;123456789;123456789;123456789;12
+ #-XCL
+ "
+;; 
+;;  AAAAAAA BBBBBB CCCCCCCCCCCC DDDDDDDDDDDDDD EEEE FFFFFFFFF GGGGGGGG HHHHH IIII JKK LLL MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ RRRRRRRRRRRR S TTTUUUUUUUUU VVVVVVV WWWWWWWWWW XXXXX
+")
+
+(my-assert
+ (format nil "~%;; ~<~%;; ~1,50:; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~;~
+ ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~;~
+ ~s~; ~s~; ~s~; ~s~;~>~%"                               ; 2!
+	 'aaaaaaa 'bbbbbb 'cccccccccccc 'dddddddddddddd 'eeee 'fffffffff 'gggggggg
+	 'hhhhh 'iiii 'j 'kk 'lll 'mmmm 'nnnnnn 'oooooooooo 'ppppppppppppppp
+	 'qqqqqqq
+	 'rrrrrrrrrrrr 's 'ttt 'uuuuuuuuu 'vvvvvvv 'wwwwwwwwww 'xxxxx 'yyyyyy
+	 'zzzzzzzz)
+ #+XCL
+ "
+;;  AAAAAAA  BBBBBB  CCCCCCCCCCCC  DDDDDDDDDDDDDD
+;;  EEEE  FFFFFFFFF  GGGGGGGG  HHHHH IIII JKK LLL
+;;  MMMM    NNNNNN   OOOOOOOOOO   PPPPPPPPPPPPPPP
+;;  QQQQQQQ  RRRRRRRRRRRR  S TTTUUUUUUUUU VVVVVVV
+;;  WWWWWWWWWW                              XXXXX
+"
+ ;; 23456789;123456789;123456789;123456789;123456789;
+ #-XCL
+ "
+;; 
+;;  AAAAAAA BBBBBB CCCCCCCCCCCC DDDDDDDDDDDDDD EEEE FFFFFFFFF GGGGGGGG HHHHH IIII JKK LLL MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ RRRRRRRRRRRR S TTTUUUUUUUUU VVVVVVV WWWWWWWWWW XXXXX
+")
+
+#-sbcl
+(my-assert
+ (defun format-blocksatz (stream parts prefix &optional line-length start-p end-p)
+   (if (null stream)
+       (let ((stream (make-string-output-stream)))
+	 (format-blocksatz stream parts prefix line-length start-p end-p)
+	 (get-output-stream-string stream)
+	 )
+       (unless (endp parts)
+	 (setq line-length (or line-length #|(sys::line-length stream)|# 72))
+	 (when start-p (format stream prefix))
+	 (loop
+	   ;;  Hier ist parts /= NIL
+	   (let ((pos (#+CLISP sys::line-position
+			       #+ALLEGRO excl::charpos
+			       #+(OR CMU SBCL) cl::charpos stream))
+		 (parts-now '()))
+	     (let ((pos-now pos))
+	       (loop
+		 (when (endp parts) (return))
+		 (let* ((part (first parts))
+			(part-length (length part)))
+		   (unless (null parts-now)
+		     (when (> (+ pos-now part-length) line-length)
+		       (return)
+		       ) )
+		   (pop parts)
+		   (push part parts-now)
+		   (incf pos-now part-length)
+		   ) ) )
+	     ;;  Hier ist parts-now /= NIL
+	     (apply #'format
+		    stream
+		    (if (and (endp parts) (not end-p))
+			(apply #'concatenate 'string
+			       (make-list (length parts-now) :initial-element "~A")
+			       )
+			(concatenate 'string
+				     "~"
+				     (write-to-string (max 0 (- line-length pos))
+						      :radix nil :base 10
+						      )
+				     (if (= (length parts-now) 1) "@" "")
+				     "<"
+				     (apply #'concatenate 'string
+					    "~A"
+					    (make-list (1- (length parts-now)) :initial-element "~;~A")
+					    )
+				     "~>"
+				     ) )
+		    (nreverse parts-now)
+		    ) )
+	   (when (endp parts) (return))
+	   (format stream prefix)
+	   ) ) ) )
+ FORMAT-BLOCKSATZ)
+
+#-sbcl
+(my-assert
+ (format-blocksatz nil
+		   (mapcar #'(lambda (x) (format nil " ~A" x))
+			   '(aaaaaaa bbbbbb cccccccccccc dddddddddddddd eeee fffffffff
+				     gggggggg hhhhh iiii j kk lll mmmm nnnnnn oooooooooo
+				     ppppppppppppppp qqqqqqq rrrrrrrrrrrr s ttt uuuuuuuuu vvvvvvv
+				     wwwwwwwwww xxxxx yyyyyy zzzzzzzz)
+			   )
+		   "~%;; "
+		   nil t nil
+		   )
+ #+(or CLISP ALLEGRO)
+ "
+;;  AAAAAAA  BBBBBB  CCCCCCCCCCCC DDDDDDDDDDDDDD EEEE FFFFFFFFF GGGGGGGG
+;;  HHHHH  IIII  J KK LLL MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ
+;;  RRRRRRRRRRRR   S  TTT  UUUUUUUUU  VVVVVVV  WWWWWWWWWW  XXXXX  YYYYYY
+;;  ZZZZZZZZ"
+ #+(OR CMU SBCL)
+ "
+;;  AAAAAAA BBBBBB CCCCCCCCCCCC DDDDDDDDDDDDDD EEEE  FFFFFFFFF  GGGGGGGG
+;;  HHHHH IIII J KK LLL MMMM NNNNNN OOOOOOOOOO  PPPPPPPPPPPPPPP  QQQQQQQ
+;;  RRRRRRRRRRRR  S  TTT  UUUUUUUUU  VVVVVVV  WWWWWWWWWW  XXXXX   YYYYYY
+;;  ZZZZZZZZ"
+ #-(or CLISP ALLEGRO cmu sbcl) UNKNOWN)
+;; 123456789;123456789;123456789;123456789;123456789;123456789;123456789;12
+
+#-sbcl
+(my-assert
+ (format-blocksatz nil
+		   (mapcar #'(lambda (x) (format nil " ~A" x))
+			   '(aaaaaaa bbbbbb cccccccccccc dddddddddddddd eeee fffffffff
+				     gggggggg hhhhh iiii j kk lll mmmm nnnnnn oooooooooo
+				     ppppppppppppppp qqqqqqq rrrrrrrrrrrr s ttt uuuuuuuuu vvvvvvv
+				     wwwwwwwwww xxxxx yyyyyy zzzzzzzz)
+			   )
+		   "~%;; "
+		   50 t t
+		   )
+ #+(or CLISP ALLEGRO)
+ "
+;;  AAAAAAA   BBBBBB  CCCCCCCCCCCC  DDDDDDDDDDDDDD
+;;  EEEE  FFFFFFFFF  GGGGGGGG  HHHHH IIII J KK LLL
+;;  MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ
+;;  RRRRRRRRRRRR    S    TTT   UUUUUUUUU   VVVVVVV
+;;  WWWWWWWWWW      XXXXX      YYYYYY     ZZZZZZZZ"
+ #+(OR CMU SBCL)
+ "
+;;  AAAAAAA  BBBBBB  CCCCCCCCCCCC   DDDDDDDDDDDDDD
+;;  EEEE FFFFFFFFF GGGGGGGG HHHHH IIII  J  KK  LLL
+;;  MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ
+;;  RRRRRRRRRRRR   S   TTT    UUUUUUUUU    VVVVVVV
+;;  WWWWWWWWWW     XXXXX      YYYYYY      ZZZZZZZZ"
+ #-(or CLISP ALLEGRO cmu sbcl) UNKNOWN)
+;; 123456789;123456789;123456789;123456789;123456789;
+
+;;; unklare Bedeutung (Fehler in Sprachbeschreibung?)
+;;; (format nil "~%;; ~{~<~%;; ~1:; ~s~>~^,~}.~%" liste) ""
+;;; (format nil "~%;; ~{~<~%;; ~1,50:; ~s~>~^,~}.~%" liste) ""
+
+(my-assert
+ (format nil "~%;; ~{~<~%;; ~1,50:; ~s~>~^,~}.~%"
+	 '(aaaaaaa bbbbbb cccccccccccc dddddddddddddd eeee fffffffff
+		   gggggggg hhhhh iiii j kk lll mmmm nnnnnn oooooooooo
+		   ppppppppppppppp qqqqqqq rrrrrrrrrrrr s ttt uuuuuuuuu vvvvvvv
+		   wwwwwwwwww xxxxx yyyyyy zzzzzzzz))
+ "
+;;  AAAAAAA, BBBBBB, CCCCCCCCCCCC, DDDDDDDDDDDDDD,
+;;  EEEE, FFFFFFFFF, GGGGGGGG, HHHHH, IIII, J, KK,
+;;  LLL, MMMM, NNNNNN, OOOOOOOOOO,
+;;  PPPPPPPPPPPPPPP, QQQQQQQ, RRRRRRRRRRRR, S,
+;;  TTT, UUUUUUUUU, VVVVVVV, WWWWWWWWWW, XXXXX,
+;;  YYYYYY, ZZZZZZZZ.
+")
+
+;;  ~f ------------------------------------------------------------------------
+;;  Format F
+
+(my-assert
+ (DEFUN FOO (X)
+   (FORMAT NIL "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" X X X X
+	   X X))
+ FOO)
+
+(my-assert
+ (FOO 3.14159)
+ ;;        "  3.14| 31.42|  3.14|3.1416|3.14|3.141590116672995328"
+ "  3.14| 31.42|  3.14|3.1416|3.14|3.14159")
+
+(my-assert
+ (FOO -3.14159)
+ ;;        " -3.14|-31.42| -3.14|-3.142|-3.14|-3.141590116672995328"
+ " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159")
+
+(my-assert
+ (FOO 100.0)
+ "100.00|******|100.00| 100.0|100.00|100.0")
+
+(my-assert
+ (FOO 1234.0)
+ "1234.00|******|??????|1234.0|1234.00|1234.0")
+
+(my-assert
+ (FOO 0.006)
+ "  0.01|  0.06|  0.01| 0.006|0.01|0.006")
+
+(my-assert
+ (format nil "~5,2,-13f" 1.1e13)
+ " 1.10")
+
+(my-assert
+ (format nil "~9,0,6f" 3.14159)
+ " 3141590.")
+
+(my-assert
+ (FORMAT NIL "~5D" (QUOTE A))
+ "    A"
+ "ANSI CL is not clear here whether the width is ignored or not,
+but it makes more sense to print non-numeric arguments properly alighned")
+
+(my-assert
+ (FORMAT NIL "~5,3F" (QUOTE A))
+ "    A"
+ "ANSI CL is not clear here whether the width is ignored or not,
+but it makes more sense to print non-numeric arguments properly alighned")
+
+(my-assert
+ (FORMAT NIL "~5,3F" #C(1.2 0.3))
+ "#C(1.2 0.3)")
+
+(my-assert
+ (FORMAT NIL "~5,3F" 2/3)
+ "0.667")
+
+;;  ~e ----------------------------- ------------------------------------------
+;;  Format E
+
+(my-assert
+ (defun foo (x)
+   (format nil
+	   "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@e|~9,2E"
+	   x x x x))
+ FOO)
+
+(my-assert
+ (foo 3.14159)
+ "  3.14E+0| 31.42$-01|+.003E+03|  3.14E+0")
+
+(my-assert
+ (foo -3.14159)
+ " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0")
+
+(my-assert
+ (foo 1100.0)
+ "  1.10E+3| 11.00$+02|+.001E+06|  1.10E+3")
+
+(my-assert
+ (foo 1100.0L0)
+ #+XCL "  1.10D+3| 11.00$+02|+.001D+06|  1.10D+3"
+ #+(or CLISP AKCL) "  1.10L+3| 11.00$+02|+.001L+06|  1.10L+3"
+ #+(or ALLEGRO cmu sbcl) "  1.10d+3| 11.00$+02|+.001d+06|  1.10d+3"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (foo 1.1E13)
+ "*********| 11.00$+12|+.001E+16| 1.10E+13")
+
+;;  ERROR beim read der zahl (foo 1.1L120)
+
+(my-assert
+ (FORMAT NIL "_~10,4E_" 1.2)
+ "_ 1.2000E+0_")
+
+(my-assert
+ (format nil "~9,2,1E" 0.0314159)
+ "  3.14E-2")
+
+;;  ~% ~d ~e (v) --------------------------------------------------------------
+(my-assert
+ (let (x)
+   (dotimes (k 13 x)
+     (setq x (cons (format nil "~%Scale factor ~2D: |~13,6,2,VE|"
+			   (- k 5) (- k 5) 3.14159) x))))
+ (
+  "
+Scale factor  7: | 3141590.E-06|" "
+Scale factor  6: | 314159.0E-05|" "
+Scale factor  5: | 31415.90E-04|" "
+Scale factor  4: | 3141.590E-03|" "
+Scale factor  3: | 314.1590E-02|" "
+Scale factor  2: | 31.41590E-01|" "
+Scale factor  1: | 3.141590E+00|" "
+Scale factor  0: | 0.314159E+01|" "
+Scale factor -1: | 0.031416E+02|" "
+Scale factor -2: | 0.003142E+03|" "
+Scale factor -3: | 0.000314E+04|" "
+Scale factor -4: | 0.000031E+05|" "
+Scale factor -5: | 0.000003E+06|"))
+
+
+;;  ~g ------------------------------------------------------------------------
+(my-assert
+ (defun foo (x)
+   (format nil "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G"
+	   x x x x))
+ foo)
+
+(my-assert
+ (foo 0.0314159)
+ "  3.14E-2|314.2$-04|0.314E-01|  3.14E-2")
+
+(my-assert
+ (foo 0.314159)
+ "  0.31   |0.314    |0.314    | 0.31    ")
+
+(my-assert
+ (foo 3.14159)
+ "   3.1   | 3.14    | 3.14    |  3.1    ")
+
+(my-assert
+ (foo 31.4159)
+ "   31.   | 31.4    | 31.4    |  31.    ")
+
+(my-assert
+ (foo 314.159)
+ "  3.14E+2| 314.    | 314.    |  3.14E+2")
+
+(my-assert
+ (foo 3141.59)
+ "  3.14E+3|314.2$+01|0.314E+04|  3.14E+3")
+
+(my-assert
+ (foo 3141.59L0)
+ #+XCL "  3.14D+3|314.2$+01|0.314D+04|  3.14D+3"
+ #+(or CLISP AKCL) "  3.14L+3|314.2$+01|0.314L+04|  3.14L+3"
+ #+(or ALLEGRO cmu sbcl) "  3.14d+3|314.2$+01|0.314d+04|  3.14d+3"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (foo 3.14E12)
+ "*********|314.0$+10|0.314E+13| 3.14E+12")
+
+;; (foo 3.14L120 und L1200) fehler in numerik
+
+;;  ~a ------------------------------------------------------------------------
+
+(my-assert
+ (FORMAT NIL "foo")
+ "foo")
+
+(my-assert
+ (FORMAT NIL "format-a:--~a--ende" (QUOTE AB\c))
+ "format-a:--ABc--ende")
+
+(my-assert
+ (SETQ Y "elephant")
+ "elephant")
+
+(my-assert
+ (FORMAT NIL "Look at the ~A!" Y)
+ "Look at the elephant!")
+
+(my-assert
+ (FORMAT NIL "format-%:--~%--1-newline-*")
+ "format-%:--
+--1-newline-*")
+
+(my-assert
+ (FORMAT NIL "format-%:--~3%--3-newline-*")
+ "format-%:--
+
+
+--3-newline-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~5a--ende-*" (QUOTE AB\c))
+ "format-a:--ABc  --ende-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~5,2a--ende-*" (QUOTE AB\c))
+ "format-a:--ABc  --ende-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~5,2,3a--ende-*" (QUOTE AB\c))
+ "format-a:--ABc   --ende-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~5,2,3,'*a--ende-*" (QUOTE AB\c))
+ "format-a:--ABc***--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~@a--ende-*" (QUOTE AB\c))
+ "format-a:--ABc--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~5@a--ende-*" (QUOTE AB\c))
+ "format-a:--  ABc--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~5,2@a--ende-*" (QUOTE AB\c))
+ "format-a:--  ABc--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~5,2,3@a--ende-*" (QUOTE AB\c))
+ "format-a:--   ABc--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~5,2,3,'*@a--ende-*" (QUOTE AB\c))
+ "format-a:--***ABc--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-a:--~:a--ende-*" (QUOTE (AB\c NIL XYZ)))
+ "format-a:--(ABc NIL XYZ)--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-s:--~s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:--AB\\c--ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--|ABc|--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~5s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:--AB\\c --ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--|ABc|--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~5,2s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:--AB\\c  --ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--|ABc|--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~5,2,3s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:--AB\\c   --ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--|ABc|   --ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~5,2,3,'*s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:--AB\\c***--ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--|ABc|***--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~@s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:--AB\\c--ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--|ABc|--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~5@s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:-- AB\\c--ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--|ABc|--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~5,2@s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:--  AB\\c--ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--|ABc|--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~5,2,3@s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:--   AB\\c--ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--   |ABc|--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~5,2,3,'*@s--ende-*" (QUOTE AB\c))
+ #+XCL "format-s:--***AB\\c--ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--***|ABc|--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "format-s:--~:s--ende-*" (QUOTE (AB\c NIL XYZ)))
+ #+XCL "format-s:--(AB\\c NIL XYZ)--ende-*"
+ #+(or CLISP AKCL ALLEGRO cmu sbcl) "format-s:--(|ABc| NIL XYZ)--ende-*"
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl) UNKNOWN)
+
+(my-assert
+ (SETQ X 5)
+ 5)
+
+(my-assert
+ (FORMAT NIL "The answer is ~D." X)
+ "The answer is 5.")
+
+(my-assert
+ (FORMAT NIL "The answer is ~3D." X)
+ "The answer is   5.")
+
+(my-assert
+ (FORMAT NIL "The answer is ~3,'0D." X)
+ "The answer is 005.")
+
+(my-assert
+ (FORMAT NIL "The answer is ~:D." (EXPT 47 X))
+ "The answer is 229,345,007.")
+
+(my-assert
+ (FORMAT NIL "decimal:~d, width=5:~5d-*" 10 10)
+ "decimal:10, width=5:   10-*")
+
+(my-assert
+ (FORMAT NIL "format-d:--~d--ende-*" 123)
+ "format-d:--123--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-d:--~10d--ende-*" 123)
+ "format-d:--       123--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-d:--~10,'?d--ende-*" 123)
+ "format-d:--???????123--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-d:--~@d--ende-*" 123)
+ "format-d:--+123--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-d:--~10@d--ende-*" 123)
+ "format-d:--      +123--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-d:--~10,'?@d--ende-*" 123)
+ "format-d:--??????+123--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~b--ende-*" 123)
+ "format-b:--1111011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~10b--ende-*" 123)
+ "format-b:--   1111011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~10,'?b--ende-*" 123)
+ "format-b:--???1111011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~:b--ende-*" 123)
+ "format-b:--1,111,011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~10:b--ende-*" 123)
+ "format-b:-- 1,111,011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~10,'?:b--ende-*" 123)
+ "format-b:--?1,111,011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~10,'?,'.:b--ende-*" 123)
+ "format-b:--?1.111.011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~@b--ende-*" 123)
+ "format-b:--+1111011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~10@b--ende-*" 123)
+ "format-b:--  +1111011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~10,'?@b--ende-*" 123)
+ "format-b:--??+1111011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-b:--~:@b--ende-*" 123)
+ "format-b:--+1,111,011--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-o:--~o--ende-*" 123)
+ "format-o:--173--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-o:--~10o--ende-*" 123)
+ "format-o:--       173--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-o:--~10,'?o--ende-*" 123)
+ "format-o:--???????173--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-o:--~@o--ende-*" 123)
+ "format-o:--+173--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-o:--~10@o--ende-*" 123)
+ "format-o:--      +173--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-x:--~x--ende-*" 123)
+ "format-x:--7B--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-x:--~10x--ende-*" 123)
+ "format-x:--        7B--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-x:--~10,'?x--ende-*" 123)
+ "format-x:--????????7B--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-x:--~10:x--ende-*" 123)
+ "format-x:--        7B--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-x:--~@x--ende-*" 123)
+ "format-x:--+7B--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-x:--~10@x--ende-*" 123)
+ "format-x:--       +7B--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-r:--~20r--ende-*" 123)
+ "format-r:--63--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-r:--~20,10r--ende-*" 123)
+ "format-r:--        63--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-r:--~20@r--ende-*" 123)
+ "format-r:--+63--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-r:--~r--ende-*" 9)
+ "format-r:--nine--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-r:--~:r--ende-*" 9)
+ "format-r:--ninth--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-r:--~@r--ende-*" 9)
+ "format-r:--IX--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-r:--~:@r--ende-*" 9)
+ "format-r:--VIIII--ende-*")
+
+(my-assert
+ (FORMAT NIL "format-p:--~d  object~p-*" 1 1)
+ "format-p:--1  object-*")
+
+(my-assert
+ (FORMAT NIL "format-p:--~d  object~p-*" 2 2)
+ "format-p:--2  objects-*")
+
+(my-assert
+ (FORMAT NIL "format-p:--~d  bab~@p-*" 1 1)
+ "format-p:--1  baby-*")
+
+(my-assert
+ (FORMAT NIL "format-p:--~d  bab~@p-*" 2 2)
+ "format-p:--2  babies-*")
+
+(my-assert
+ (FORMAT NIL "format-p:--~d  object~:p-*" 1)
+ "format-p:--1  object-*")
+
+(my-assert
+ (FORMAT NIL "format-p:--~d  object~:p-*" 2)
+ "format-p:--2  objects-*")
+
+(my-assert
+ (FORMAT NIL "format-p:--~d  bab~:@p-*" 1)
+ "format-p:--1  baby-*")
+
+(my-assert
+ (FORMAT NIL "format-&:--~%~&--1-newline-*")
+ "format-&:--
+--1-newline-*")
+
+(my-assert
+ (FORMAT NIL "format-&:--~%~3&--3-newline-*")
+ "format-&:--
+
+
+--3-newline-*")
+
+(my-assert
+ (FORMAT NIL "format-tilde:--~~--1-tilde-*")
+ "format-tilde:--~--1-tilde-*")
+
+(my-assert
+ (FORMAT NIL "format-tilde:--~3~--3-tilden-*")
+ "format-tilde:--~~~--3-tilden-*")
+
+(my-assert
+ (FORMAT NIL "format-|:--~|--1-ff-*")
+ "format-|:----1-ff-*")
+
+(my-assert
+ (FORMAT NIL "format-|:--~2|--2-ff-*")
+ "format-|:----2-ff-*")
+
+(my-assert
+ (FORMAT NIL
+	 "format-<nl>:~
+                         gl. zeile gl. angeschlossen trotz 2*<tab> und sp-*")
+ "format-<nl>:gl. zeile gl. angeschlossen trotz 2*<tab> und sp-*")
+
+(my-assert
+ (FORMAT NIL "format-<nl>:~@
+                         neue Zeile Anfang trotz <tab> + sp-*")
+ "format-<nl>:
+neue Zeile Anfang trotz <tab> + sp-*")
+
+(my-assert
+ (FORMAT NIL "format-<nl>:~:
+	gleiche Zeile aber ein tab vor Anfang-*")
+ "format-<nl>:	gleiche Zeile aber ein tab vor Anfang-*")
+
+(my-assert
+ (FORMAT NIL "format-?:***~a***~?***~a***-*" 1 "+++~s+++~s+++" (QUOTE
+								(A B)) 2)
+ "format-?:***1***+++A+++B+++***2***-*")
+
+(my-assert
+ (FORMAT NIL "format-?:***~a***~?***~a***-*" 1 "+++++++++++++" NIL 2)
+ "format-?:***1***+++++++++++++***2***-*")
+
+(my-assert
+ (FORMAT NIL "~(AAAAAAAA BBBBBB ccccccc dddddddd~)")
+ "aaaaaaaa bbbbbb ccccccc dddddddd")
+
+(my-assert
+ (FORMAT NIL "~:(AAAAAAAA BBBBBB ccccccc dddddddd~)")
+ "Aaaaaaaa Bbbbbb Ccccccc Dddddddd")
+
+(my-assert
+ (FORMAT NIL "~@(AAAAAAAA BBBBBB ccccccc dddddddd~)")
+ "Aaaaaaaa bbbbbb ccccccc dddddddd")
+
+(my-assert
+ (FORMAT NIL "~:@(AAAAAAAA BBBBBB ccccccc dddddddd~)")
+ "AAAAAAAA BBBBBB CCCCCCC DDDDDDDD")
+
+(my-assert
+ (FORMAT NIL "++~{-=~s=-~}++" (QUOTE (1 2 3)))
+ "++-=1=--=2=--=3=-++")
+
+(my-assert
+ (FORMAT NIL "++~2{-=~s=-~}++" (QUOTE (1 2 3)))
+ "++-=1=--=2=-++")
+
+(my-assert
+ (FORMAT NIL "++~@{-=~s=-~}++" 1 2 3)
+ "++-=1=--=2=--=3=-++")
+
+(my-assert
+ (FORMAT NIL "++~:{-=~s=~s=-~}++" (QUOTE ((1 2) (3 4 5) (6 7))))
+ "++-=1=2=--=3=4=--=6=7=-++")
+
+(my-assert
+ (FORMAT NIL "++~:@{-=~s=~s=-~}++" (QUOTE (1 2)) (QUOTE (3 4 5)) (QUOTE
+								  (6 7)))
+ "++-=1=2=--=3=4=--=6=7=-++")
+
+(my-assert
+ (FORMAT NIL "~{abc~:}")
+ #+XCL "abc"
+ #-XCL ERROR)
+
+(my-assert
+ (FORMAT NIL "~{~:}" "xyz")
+ #+XCL "xyz"
+ #-XCL ERROR)
+
+(my-assert
+ (FORMAT NIL "~1{~:}" "-~s-" (QUOTE (1 2)) 3)
+ "-1-")
+
+(my-assert
+ (FORMAT NIL "123456789012345678901234567890
+~10,4txx~10,4ty~10,4tzzz~10,4tende")
+ #+XCL
+ "123456789012345678901234567890
+         xx  y   zzz ende"
+ #-XCL
+ "123456789012345678901234567890
+          xx  y   zzz ende")
+
+(my-assert
+ (FORMAT NIL "123456789012345678901234567890
+~3,4@txx~3,4@ty~3,4@tzzz~3,4@tende")
+ #+XCL
+ "123456789012345678901234567890
+   xx      y   zzz     ende"
+ #-XCL
+ "123456789012345678901234567890
+    xx      y   zzz     ende")
+
+(my-assert
+ (FORMAT NIL "-~a-~a-~a-~a-" 1 2 3 4 5 6 7 8 9)
+ "-1-2-3-4-")
+
+(my-assert
+ (FORMAT NIL "-~a-~a-~*~a-~a-" 1 2 3 4 5 6 7 8 9)
+ "-1-2-4-5-")
+
+(my-assert
+ (FORMAT NIL "-~a-~a-~3*~a-~a-" 1 2 3 4 5 6 7 8 9)
+ "-1-2-6-7-")
+
+(my-assert
+ (FORMAT NIL "-~a-~a-~:*~a-~a-" 1 2 3 4 5 6 7 8 9)
+ "-1-2-2-3-")
+
+(my-assert
+ (FORMAT NIL "-~a-~a-~2:*~a-~a-" 1 2 3 4 5 6 7 8 9)
+ "-1-2-1-2-")
+
+(my-assert
+ (FORMAT NIL "-~a-~a-~@*~a-~a-" 1 2 3 4 5 6 7 8 9)
+ "-1-2-1-2-")
+
+(my-assert
+ (FORMAT NIL "-~a-~a-~6@*~a-~a-" 1 2 3 4 5 6 7 8 9)
+ "-1-2-7-8-")
+
+(my-assert
+ (FORMAT NIL "~[aa~;bb~;cc~]" 1)
+ "bb")
+
+(my-assert
+ (FORMAT NIL "~[aa~;bb~;cc~]" 10)
+ "")
+
+(my-assert
+ (FORMAT NIL "~2[aa~;bb~;cc~]" 10)
+ "cc")
+
+(my-assert
+ (FORMAT NIL "~@[aaa~]" NIL 10)
+ "")
+
+(my-assert
+ (FORMAT NIL "~@[aaa~]" 20 10)
+ "aaa")
+
+(my-assert
+ (FORMAT NIL "~@[aaa~d~]" NIL 10)
+ "")
+
+(my-assert
+ (FORMAT NIL "~@[aaa~d~]" 20 10)
+ "aaa20")
+
+(my-assert
+ (FORMAT NIL "~@[aaa~d~]bbb~d" NIL 10 30)
+ "bbb10")
+
+(my-assert
+ (FORMAT NIL "~@[aaa~d~]bbb~d" 20 10 30)
+ "aaa20bbb10")
+
+(my-assert
+ (FORMAT NIL "~:[-nil-~;-true-~d~]-ende~d" NIL 10 20)
+ "-nil--ende10")
+
+(my-assert
+ (FORMAT NIL "~:[-nil-~;-true-~d~]-ende~d" T 10 20)
+ "-true-10-ende20")
+
+(my-assert
+ (FORMAT NIL "Start test, newline:~%freshline:~&")
+ "Start test, newline:
+freshline:
+")
+
+(my-assert
+ (FORMAT NIL "decimal pad with period:~10,vd-*" #\. 12)
+ "decimal pad with period:........12-*")
+
+(my-assert
+ (FORMAT NIL "char normal:~c, as ~%# would read:~%~@c, human read:~:c-*"
+	 #\SPACE
+	 #\SPACE #\SPACE)
+ #+(or XCL cmu sbcl CLISP) "char normal: , as 
+# would read:
+#\\Space, human read:Space-*"
+ #+(or AKCL LUCID)    "char normal:Space, as 
+# would read:
+#\\Space, human read:Space-*"
+ #+ALLEGRO            "char normal: , as 
+# would read:
+#\\space, human read:space-*"
+ #-(or XCL cmu sbcl CLISP AKCL LUCID ALLEGRO) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL
+	 "cardinal:~r, roman new:~@r, roman-old:~:@r~
+                <same line I hope>~@
+                new line but at beginning~:
+   same line, but spaced out~@
+        new line and over two tabs-*" 4 4 4)
+ "cardinal:four, roman new:IV, roman-old:IIII<same line I hope>
+new line but at beginning   same line, but spaced out
+new line and over two tabs-*")
+
+(my-assert
+ (SETQ N 3)
+ 3)
+
+(my-assert
+ (FORMAT NIL "~D item~:P found." N)
+ "3 items found.")
+
+(my-assert
+ (FORMAT NIL "~R dog~:[s are~; is~] here." N (= N 1))
+ "three dogs are here.")
+
+(my-assert
+ (FORMAT NIL "~R dog~:*~[s are~; is~:;s are~] here." N)
+ "three dogs are here.")
+
+(my-assert
+ (FORMAT NIL "Here ~[are~;is~:;are~] ~:*~R pupp~:@p." N)
+ "Here are three puppies.")
+
+(my-assert
+ (SETQ N 1)
+ 1)
+
+(my-assert
+ (FORMAT NIL "~D item~:P found." N)
+ "1 item found.")
+
+(my-assert
+ (FORMAT NIL "~R dog~:[s are~; is~] here." N (= N 1))
+ "one dog is here.")
+
+(my-assert
+ (FORMAT NIL "~R dog~:*~[s are~; is~:;s are~] here." N)
+ "one dog is here.")
+
+(my-assert
+ (FORMAT NIL "Here ~[are~;is~:;are~] ~:*~R pupp~:@p." N)
+ "Here is one puppy.")
+
+(my-assert
+ (SETQ N 0)
+ 0)
+
+(my-assert
+ (FORMAT NIL "~D item~:P found." N)
+ "0 items found.")
+
+(my-assert
+ (FORMAT NIL "~R dog~:[s are~; is~] here." N (= N 1))
+ "zero dogs are here.")
+
+(my-assert
+ (FORMAT NIL "~R dog~:*~[s are~; is~:;s are~] here." N)
+ "zero dogs are here.")
+
+(my-assert
+ (FORMAT NIL "Here ~[are~;is~:;are~] ~:*~R pupp~:@p." N)
+ "Here are zero puppies.")
+
+(my-assert
+ (FORMAT NIL "~D tr~:@p/~D win~:P" 7 1)
+ "7 tries/1 win")
+
+(my-assert
+ (FORMAT NIL "~D tr~:@p/~D win~:P" 1 0)
+ "1 try/0 wins")
+
+(my-assert
+ (FORMAT NIL "~D tr~:@p/~D win~:P" 1 3)
+ "1 try/3 wins")
+
+(my-assert
+ (DEFUN TYPE-CLASH-ERROR (FN NARGS ARGNUM RIGHT-TYPE WRONG-TYPE) (FORMAT
+								  NIL
+								  "~&~S requires itts ~:[~:R~;~*~] ~
+           argument to be of type ~S,~%but it was called ~
+           with an argument of type ~S.-*" FN (EQL NARGS 1) ARGNUM
+								  RIGHT-TYPE
+								  WRONG-TYPE))
+ TYPE-CLASH-ERROR)
+
+(my-assert
+ (TYPE-CLASH-ERROR (QUOTE AREF) NIL 2 (QUOTE INTEGER) (QUOTE VECTOR))
+ "AREF requires itts second argument to be of type INTEGER,
+but it was called with an argument of type VECTOR.-*")
+
+(my-assert
+ (TYPE-CLASH-ERROR (QUOTE CAR) 1 1 (QUOTE LIST) (QUOTE SHORT-FLOAT))
+ "CAR requires itts  argument to be of type LIST,
+but it was called with an argument of type SHORT-FLOAT.-*")
+
+(my-assert
+ (FORMAT NIL "~? ~D" "<~A ~D>" (QUOTE ("Foo" 5)) 7)
+ "<Foo 5> 7")
+
+(my-assert
+ (FORMAT NIL "~? ~D" "<~A ~D>" (QUOTE (" Foo" 5 14)) 7)
+ "< Foo 5> 7")
+
+(my-assert
+ (FORMAT NIL "~@? ~d" "<~A ~D>" "Foo" 5 7)
+ "<Foo 5> 7")
+
+(my-assert
+ (FORMAT NIL "~@? ~D" "<~A ~D>" "Foo" 5 14 7)
+ "<Foo 5> 14")
+
+(my-assert
+ (FORMAT NIL "~@R ~(~@R~)" 14 14)
+ "XIV xiv")
+
+(my-assert
+ (DEFUN F (N) (FORMAT NIL "~@(~R~) error~:P detected." N))
+ F)
+
+(my-assert
+ (F 0)
+ "Zero errors detected.")
+
+(my-assert
+ (F 1)
+ "One error detected.")
+
+(my-assert
+ (F 23)
+ "Twenty-three errors detected.")
+
+(my-assert
+ (SETQ *PRINT-LEVEL* NIL *PRINT-LENGTH* 5)
+ 5)
+
+(my-assert
+ (FORMAT NIL "~@[ print level = ~D~]~@[ print length = ~D~]" *PRINT-LEVEL*
+
+	 *PRINT-LENGTH*)
+ " print length = 5")
+
+(my-assert
+ (SETQ *PRINT-LENGTH* NIL)
+ NIL)
+
+(my-assert
+ (SETQ FOO
+       "Items:~#[none~; ~s~; ~S and ~S~
+          ~:;~@{~#[~; and~] ~S~^,~}~].")
+ "Items:~#[none~; ~s~; ~S and ~S~
+          ~:;~@{~#[~; and~] ~S~^,~}~].")
+
+(my-assert
+ (FORMAT NIL FOO)
+ "Items:none.")
+
+(my-assert
+ (FORMAT NIL FOO (QUOTE FOO))
+ "Items: FOO.")
+
+(my-assert
+ (FORMAT NIL FOO (QUOTE FOO) (QUOTE BAR))
+ "Items: FOO and BAR.")
+
+(my-assert
+ (FORMAT NIL FOO (QUOTE FOO) (QUOTE BAR) (QUOTE BAZ))
+ "Items: FOO, BAR, and BAZ.")
+
+(my-assert
+ (FORMAT NIL FOO (QUOTE FOO) (QUOTE BAR) (QUOTE BAZ) (QUOTE QUUX))
+ "Items: FOO, BAR, BAZ, and QUUX.")
+
+(my-assert
+ (FORMAT NIL "The winners are:~{ ~S~}." (QUOTE (FRED HARRY JILL)))
+ "The winners are: FRED HARRY JILL.")
+
+(my-assert
+ (FORMAT NIL "Pairs:~{ <~S,~S>~}." (QUOTE (A 1 B 2 C 3)))
+ "Pairs: <A,1> <B,2> <C,3>.")
+
+(my-assert
+ (FORMAT NIL "Pairs:~:{ <~S,~S>~}." (QUOTE ((A 1) (B 2) (C 3))))
+ "Pairs: <A,1> <B,2> <C,3>.")
+
+(my-assert
+ (FORMAT NIL "Pairs:~@{ <~S,~S>~}." (QUOTE A) 1 (QUOTE B) 2 (QUOTE C)
+	 3)
+ "Pairs: <A,1> <B,2> <C,3>.")
+
+(my-assert
+ (FORMAT NIL "Pairs:~:@{ <~S,~S>~}." (QUOTE (A 1)) (QUOTE (B 2)) (QUOTE
+								  (C 3)))
+ "Pairs: <A,1> <B,2> <C,3>.")
+
+(my-assert
+ (SETQ DONESTR "done.~^ ~D warning~:P.~^ ~D error~:P.")
+ "done.~^ ~D warning~:P.~^ ~D error~:P.")
+
+(my-assert
+ (FORMAT NIL DONESTR)
+ "done.")
+
+(my-assert
+ (FORMAT NIL DONESTR 3)
+ "done. 3 warnings.")
+
+(my-assert
+ (FORMAT NIL DONESTR 1 5)
+ "done. 1 warning. 5 errors.")
+
+(my-assert
+ (SETQ TELLSTR "~@(~@[~R~]~^ ~A.~)")
+ "~@(~@[~R~]~^ ~A.~)")
+
+(my-assert
+ (FORMAT NIL TELLSTR 23)
+ "Twenty-three")
+
+(my-assert
+ (FORMAT NIL TELLSTR NIL "losers")
+ " Losers.")
+
+(my-assert
+ (FORMAT NIL TELLSTR 23 "losers")
+ "Twenty-three losers.")
+
+(my-assert
+ (FORMAT NIL "**~c**" #\SPACE)
+ #+(or XCL cmu sbcl CLISP ALLEGRO) "** **"
+ #+(or AKCL LUCID)            "**Space**"
+ #-(or XCL cmu sbcl CLISP AKCL LUCID ALLEGRO) UNKNOWN)
+
+(my-assert
+ (FORMAT NIL "**~:c**" #\SPACE)
+ "**Space**")
+
+(my-assert
+ (FORMAT NIL "**~:@c**" #\SPACE)
+ "**Space**")
+
+(my-assert
+ (FORMAT NIL "**~@c**" #\SPACE)
+ "**#\\Space**")
+
+(my-assert
+ (FORMAT NIL "**~c**" #\A)
+ "**A**")
+
+(my-assert
+ (FORMAT NIL "**~:c**" #\A)
+ "**A**")
+
+(my-assert
+ (FORMAT NIL "**~:@c**" #\A)
+ "**A**")
+
+(my-assert
+ (FORMAT NIL "**~@c**" #\A)
+ "**#\\A**")
+
+#+XCL
+(my-assert
+ (FORMAT NIL "**~c**" (CODE-CHAR 26))
+ "****")
+
+#+clisp
+(my-assert
+ (FORMAT NIL "**~c**" (CODE-CHAR 27))
+ "****")
+
+#+XCL
+(my-assert
+ (FORMAT NIL "**~:c**" (CODE-CHAR 26))
+ "**Z**")
+
+#+clisp
+(my-assert
+ (FORMAT NIL "**~:c**" (CODE-CHAR 27))
+ "**Escape**")
+
+#+XCL
+(my-assert
+ (FORMAT NIL "**~:@c**" (CODE-CHAR 26))
+ "**^Z**")
+
+#+clisp
+(my-assert
+ (FORMAT NIL "**~:@c**" (CODE-CHAR 27))
+ "**Escape**")
+
+#+XCL
+(my-assert
+ (FORMAT NIL "**~@c**" (CODE-CHAR 26))
+ "**#\\**")
+
+#+clisp
+(my-assert
+ (FORMAT NIL "**~@c**" (CODE-CHAR 27))
+ "**#\\Escape**")
+
+(my-assert
+ (progn (fmakunbound 'foo)
+	(makunbound 'liste)
+	t)
+ T)
+
diff --git a/src/ansi-tests/hash.lisp b/src/ansi-tests/hash.lisp
new file mode 100644
index 000000000..188d7d95e
--- /dev/null
+++ b/src/ansi-tests/hash.lisp
@@ -0,0 +1,269 @@
+;;; based on v1.3 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (progn (in-package (quote sys)) t)      t)
+
+(my-assert
+ (make-hash-table :test (quote eq) :size 20)
+ #s(hash-table test eq size 20 %%size 64 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 13 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (make-hash-table :test (quote eql) :size 2)
+ #s(hash-table test eql size 2 %%size 4 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 2 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (make-hash-table :test (quote equal) :size 2)
+ #s(hash-table test equal size 2 %%size 4 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 2 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (progn (make-hash-table :test (function eq) :size 2) t) t)
+
+(my-assert
+ (progn (make-hash-table :test (function eql) :size 2)t) t)
+
+(my-assert
+ (make-hash-table :size nil)
+ error)
+
+(my-assert
+ (make-hash-table :size -3)
+ error)
+
+(my-assert
+ (make-hash-table :size 2.0)
+ error)
+
+(my-assert
+ (make-hash-table :size 2 :rehash-size 1.5)
+ #s(hash-table test eql size 2 %%size 4 rehash-size 1.5 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 2 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (make-hash-table :size 2 :rehash-size -1.5)
+ error)
+
+(my-assert
+ (make-hash-table :size 2 :rehash-size 0.5)
+ error)
+
+(my-assert
+ (make-hash-table :size 2 :rehash-size 1.0)
+ #s(hash-table test eql size 2 %%size 4 rehash-size 1.0 %%rehash-size 4
+	       rehash-threshold 13 %%rehash-threshold 2 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (make-hash-table :size 2 :rehash-size 5)
+ #s(hash-table test eql size 2 %%size 4 rehash-size 5 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 2 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (make-hash-table :size 4 :rehash-size 5.0)
+ #s(hash-table test eql size 4 %%size 8 rehash-size 5.0 %%rehash-size 8
+	       rehash-threshold 13 %%rehash-threshold 3 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (make-hash-table :size 2 :rehash-size nil)
+ error)
+
+(my-assert
+ (make-hash-table :size 2 :rehash-threshold nil)
+ error)
+
+(my-assert
+ (make-hash-table :%%size 3)
+ #s(hash-table test eql size 16 %%size 3 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 13 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (setq tab (make-hash-table))
+ #s(hash-table test eql size 16 %%size 32 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 13 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (setf-gethash (quote hallo) tab (quote wiegwhts))
+ wiegwhts)
+
+(my-assert
+ (setf-gethash (quote uhu) tab (quote kauz))
+ kauz)
+
+(my-assert
+ (gethash (quote uhu) tab)
+ kauz)
+
+(my-assert
+ (gethash uhu tab)
+ error)
+
+(my-assert
+ (make-hash-table)
+ #s(hash-table test eql size 16 %%size 32 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 13 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (setq tab nil)
+ nil)
+
+(my-assert
+ (setf-gethash (quote uhu) tab (quote kaus))
+ error)
+
+(my-assert
+ (gethash (quote uhu) tab)
+ error)
+
+(my-assert
+ (gethash (quote otto) tab)
+ error)
+
+(my-assert
+ (setq tab (make-hash-table))
+ #s(hash-table test eql size 16 %%size 32 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 13 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (setf-gethash (quote uhu) tab (quote kaus))
+ kaus)
+
+(my-assert
+ (gethash (quote uhu) tab)
+ kaus)
+
+(my-assert
+ (gethash (quote otto) tab)
+ nil)
+
+(my-assert
+ (setf-gethash (quote uhu) tab (quote kauz))
+ kauz)
+
+(my-assert
+ (setf-gethash tab)
+ error)
+
+(my-assert
+ (remhash (quote uhu) tab)
+ t)
+
+(my-assert
+ tab
+ #s(hash-table test eql size 16 %%size 32 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 13 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (clrhash tab9)
+ error)
+
+(my-assert
+ (clrhash tab)
+ #s(hash-table test eql size 16 %%size 32 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 13 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element)))
+
+(my-assert
+ (hash-table-count tab)
+ 0)
+
+(my-assert
+ (setf-gethash (quote klak) tab (quote klase))
+ klase)
+
+(my-assert
+ (setf-gethash (quote kunze) tab (quote riese))
+ riese)
+
+(my-assert
+ (hash-table-p tab)
+ t)
+
+(my-assert
+ (hash-table-count tab)
+ 2)
+
+(my-assert
+ (remhash (quote kunze) tab)
+ t)
+
+(my-assert
+ (setf-gethash (quote wald) tab (quote khjgsfgjhdf))
+ khjgsfgjhdf)
+
+(my-assert
+ (gethash)
+ error)
+
+(my-assert
+ (remhash)
+ error)
+
+(my-assert
+ (clrhash tab)
+ #s(hash-table test eql size 16 %%size 32 rehash-size 2.0 %%rehash-size 2
+	       rehash-threshold 13 %%rehash-threshold 13 %%count 0 %%hash-vektor
+	       #(%%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element %%empty-element %%empty-element
+				 %%empty-element %%empty-element %%empty-element)))
+
diff --git a/src/ansi-tests/hashlong.lisp b/src/ansi-tests/hashlong.lisp
new file mode 100644
index 000000000..ce6e46826
--- /dev/null
+++ b/src/ansi-tests/hashlong.lisp
@@ -0,0 +1,63 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+#+clisp
+(setf (symbol-function 'setf-gethash)
+      (symbol-function 'sys::puthash))
+
+#+(or akcl ecls)
+(setf (symbol-function 'setf-gethash)
+      (symbol-function 'sys:hash-set)) t
+#+allegro
+(setf (symbol-function 'setf-gethash)
+      (symbol-function 'excl::%puthash)) t
+#+cmu
+(setf (symbol-function 'setf-gethash)
+      (symbol-function 'cl::%puthash)) t
+#+sbcl
+(setf (symbol-function 'setf-gethash)
+      (symbol-function 'sb-impl::%puthash)) t
+
+(my-assert
+ (defun symbole ()
+   (let ((b 0.)
+	 (hash-table (make-hash-table :size 20.
+				      :rehash-threshold
+				      #+xcl 15.
+				      #-xcl 0.75))
+	 (liste (make-list 50.))
+	 (liste2 (make-list 50.)))
+     (rplacd (last liste) liste)
+     (rplacd (last liste2) liste2)
+     (do-symbols (x (find-package #+xcl 'lisptest
+				  #-xcl "LISP"))
+       ;;      (print x) (finish-output)
+       (cond ((car liste)
+	      (let ((hval (gethash (car liste) hash-table))
+		    (lval (car liste2)))
+		(unless (eq hval lval)
+		  (print "mist, hash-tabelle kaputt")
+		  (print (car liste))
+		  (print hash-table)
+		  (print (hash-table-count hash-table))
+		  (print "hval:") (print hval)
+		  (print "lval:") (print lval)
+		  (return-from symbole 'error))
+		(remhash (car liste) hash-table)
+		#+xcl (when (< (room) 30000.) (system::%garbage-collection))
+		(setf-gethash x hash-table (setq b (+ 1. b)))
+		(rplaca liste x)
+		(rplaca liste2 b)
+		(setq liste (cdr liste))
+		(setq liste2 (cdr liste2))))
+	     (t (setf-gethash x hash-table (setq b (+ 1. b)))
+		(rplaca liste x)
+		(rplaca liste2 b)
+		(setq liste (cdr liste))
+		(setq liste2 (cdr liste2)))))))
+ symbole)
+
+
+(my-assert
+ (symbole) nil)
+
diff --git a/src/ansi-tests/iofkts.lisp b/src/ansi-tests/iofkts.lisp
new file mode 100644
index 000000000..295832bd5
--- /dev/null
+++ b/src/ansi-tests/iofkts.lisp
@@ -0,0 +1,967 @@
+;;; based on v1.3 -*- mode: lisp -*-
+(in-package :cl-user)
+
+;; ****************************************************************************
+;; *      test der i/o-funktionen                                             *
+;; ****************************************************************************
+
+#+xcl
+(my-assert
+ (progn (in-package (quote sys)) t)
+ t)
+
+;; --- let test ---------------------------------------------------------------
+;;  ewiger compiler-fehler
+;;
+
+(my-assert
+ (progn (setq bs (make-broadcast-stream)) t)
+ t)
+
+#+xcl
+(my-assert
+ *cur-broadcast-stream*
+ nil)
+
+(my-assert
+ (print 123. bs)
+ 123.)
+
+#+xcl
+(my-assert
+ *cur-broadcast-stream*
+ nil)
+
+;; -------------------------------------------------------------------------------
+;;  unread test mit structure-stream
+;;
+
+(my-assert
+ (setq str1 "test 123456")   "test 123456")
+
+(my-assert
+ (progn (setq s1 (make-two-way-stream (make-string-input-stream str1)
+				      *standard-output*)) t)
+ t)
+
+(my-assert
+ (read s1)   test)
+
+(my-assert
+ (read-char s1)   #\1)
+
+(my-assert
+ (read-char s1)   #\2)
+
+(my-assert
+ (unread-char #\2 s1)   nil)
+
+(my-assert
+ (read-char s1)   #\2)
+
+(my-assert
+ (read-char s1)   #\3)
+
+(my-assert
+ (read-char s1)   #\4)
+
+(my-assert
+ (unread-char #\a s1)   error
+ "I just read #\4 I cannot put #\a back")
+
+(my-assert
+ (read-char s1)   #\5 "The last unread should have failed, we're
+out of sync")
+
+(my-assert
+ (read-char s1)   #\6 "still out of sync?")
+
+(my-assert
+ (close s1)   t)
+
+(my-assert
+ str1   "test 123456")
+
+
+;; -------------------------------------------------------------------------------
+
+(my-assert
+ (multiple-value-list (parse-integer "abc"))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer "  abc  "))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer "123"))
+ (123 3))
+
+(my-assert
+ (multiple-value-list (parse-integer "  123  "))
+ #-(or cmu sbcl)
+ (123 7)
+ #+(or cmu sbcl)
+ (123 5))
+
+(my-assert
+ (multiple-value-list (parse-integer "123 t"))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer "  123   t  "))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer " ( 12 ) 43   t  "))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer "  abc  " :junk-allowed t))
+ (nil 2))
+
+(my-assert
+ (multiple-value-list (parse-integer "123" :junk-allowed t))
+ (123 3))
+
+(my-assert
+ (multiple-value-list (parse-integer "  123  " :junk-allowed t))
+ (123 #+xcl 7
+      #+(or clisp akcl allegro cmu sbcl ecls) 5
+      #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown))
+
+(my-assert
+ (multiple-value-list (parse-integer "123 t" :junk-allowed t))
+ (123 #+xcl 4
+      #+(or clisp akcl allegro cmu sbcl ecls) 3
+      #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown))
+
+(my-assert
+ (multiple-value-list (parse-integer "  123   t  " :junk-allowed t))
+ (123 #+xcl 8
+      #+(or clisp akcl allegro cmu sbcl ecls) 5
+      #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown))
+
+(my-assert
+ (multiple-value-list (parse-integer " ( 12 ) 43   t  " :junk-allowed
+				     t))
+ (nil 1))
+
+(my-assert
+ (setq a "q w e 1 2 r 4 d : :;;;")
+ "q w e 1 2 r 4 d : :;;;")
+
+(my-assert
+ (setq b "1 2 3 4 5 6 7")
+ "1 2 3 4 5 6 7")
+
+(my-assert
+ (setq c "1.3 4.223")
+ "1.3 4.223")
+
+(my-assert
+ (setq d "q w e r t z")
+ "q w e r t z")
+
+(my-assert
+ (multiple-value-list (parse-integer a))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer b))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer c))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer d))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer a :start 4 :end 6))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer b :start 2 :end 3))
+ (2 3))
+
+(my-assert
+ (multiple-value-list (parse-integer c :start 1))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer d :start 6))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer a :end 4))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer b :end 3))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer c :end 3))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer d :end 1))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer a :radix 1))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer b :radix 10))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer c :radix 20))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer d :radix 40))
+ error)
+
+(my-assert
+ (multiple-value-list (parse-integer a :junk-allowed t))
+ (nil 0))
+
+(my-assert
+ (multiple-value-list (parse-integer b :junk-allowed t))
+ (1 #+xcl 2
+    #+(or clisp akcl allegro cmu sbcl ecls) 1
+    #-(or xcl clisp akcl allegro cmu sbcl) unknown))
+
+(my-assert
+ (multiple-value-list (parse-integer c :junk-allowed t))
+ (1 1))
+
+(my-assert
+ (multiple-value-list (parse-integer d :junk-allowed t))
+ (nil 0))
+
+(my-assert
+ (stream-element-type #+xcl stdin
+		      #-xcl *terminal-io*)
+ character)
+
+(my-assert
+ (progn (setq a (make-string-input-stream "aaa bbb")) t)
+ t)
+
+(my-assert
+ (read a)
+ aaa)
+
+#+xcl
+(my-assert
+ (b-clear-input a)
+ nil)
+
+(my-assert
+ (read a)
+ #+xcl error
+ #-xcl bbb)
+
+(my-assert
+ (progn (setq a (make-string-output-stream))
+	(setq b (make-string-output-stream))
+	(setq c (make-broadcast-stream a b)) t)
+ t)
+
+(my-assert
+ (print "xxx" c)
+ "xxx")
+
+(my-assert
+ (clear-output c)
+ nil)
+
+(my-assert
+ (finish-output c)
+ #+xcl t
+ #-xcl nil)
+
+(my-assert
+ (get-output-stream-string a)
+ "
+\"xxx\" ")
+
+(my-assert
+ (get-output-stream-string b)
+ "
+\"xxx\" ")
+
+(my-assert
+ (print "yyy" c)
+ "yyy")
+
+(my-assert
+ (clear-output c)
+ nil)
+
+(my-assert
+ (finish-output c)
+ #+xcl t
+ #-xcl nil)
+
+(my-assert
+ (print "zzz" a)
+ "zzz")
+
+(my-assert
+ (clear-output a)
+ nil)
+
+(my-assert
+ (finish-output a)
+ #+xcl t
+ #-xcl nil)
+
+(my-assert
+ (get-output-stream-string a)
+ #+xcl ""
+ #-xcl "
+\"yyy\" 
+\"zzz\" ")
+
+(my-assert
+ (get-output-stream-string b)
+ "
+\"yyy\" ")
+
+(my-assert
+ (progn (setq a (make-string-input-stream "123")) t)
+ t)
+
+(my-assert
+ (listen a)
+ t)
+
+(my-assert
+ (read a)
+ 123)
+
+(my-assert
+ (listen a)
+ nil)
+
+(my-assert
+ *print-case*
+ :upcase)
+
+(my-assert
+ *print-gensym*
+ t)
+
+(my-assert
+ *print-level*
+ nil)
+
+(my-assert
+ *print-length*
+ nil)
+
+(my-assert
+ *print-array*
+ t)
+
+(my-assert
+ *print-escape*
+ t)
+
+(my-assert
+ *print-pretty*
+ nil)
+
+(my-assert
+ *print-circle*
+ nil)
+
+(my-assert
+ *print-base*
+ 10)
+
+(my-assert
+ *print-radix*
+ nil)
+
+(my-assert
+ (setq string1 "Das ist ein Test mit Print ")
+ "Das ist ein Test mit Print ")
+
+(my-assert
+ (prin1-to-string string1)
+ "\"das ist ein test mit print \"")
+
+(my-assert
+ (princ-to-string string1)
+ "Das ist ein Test mit Print ")
+
+(my-assert
+ (progn (setq a (make-string-input-stream "123")) t)
+ t)
+
+(my-assert
+ (read-char-no-hang a)
+ #\1)
+
+(my-assert
+ (read a)
+ 23)
+
+(my-assert
+ (read-char-no-hang a)
+ error)
+
+(my-assert
+ (read-char-no-hang a nil "EOF")
+ "EOF")
+
+(my-assert
+ (progn (setq a (make-string-input-stream "1   2   ;32  abA"))
+	(setq b (make-string-input-stream " 1 2 3 A x y z
+a b c")) t)
+ t)
+
+(my-assert
+ (read-delimited-list #\A b)
+ (1 2 3))
+
+(my-assert
+ (setq c (multiple-value-list (read-line b)))
+ (" x y z" nil))
+
+(my-assert
+ (length c)
+ 2)
+
+(my-assert
+ (multiple-value-list (read-line b))
+ ("a b c" t))
+
+(my-assert
+ (multiple-value-list (read-line b))
+ error)
+
+(my-assert
+ (multiple-value-list (read-line b nil "EOF"))
+ ("EOF" t)
+ "read-line &optional input-stream eof-error-p eof-value recursive-p
+
+=> line, missing-newline-p
+")
+
+(my-assert
+ (peek-char nil a)
+ #\1)
+
+(my-assert
+ (read-char a)
+ #\1)
+
+(my-assert
+ (peek-char t a)
+ #\2)
+
+(my-assert
+ (read-char a)
+ #\2)
+
+(my-assert
+ (peek-char t a)
+ #\;)
+
+(my-assert
+ (read-char a)
+ #\;)
+
+(my-assert
+ (peek-char #\A a)
+ #\A)
+
+(my-assert
+ (read-char a)
+ #\A)
+
+(my-assert
+ (peek-char nil a)
+ error)
+
+(my-assert
+ (peek-char nil a nil "EOF")
+ "EOF")
+
+(my-assert
+ (setq a (quote
+	  ((berlin (dresden frankfurt bonn muenchen)) (mueller (karl luise dieter
+								     aldo)))))
+ ((berlin (dresden frankfurt bonn muenchen)) (mueller (karl luise dieter
+							    aldo))))
+
+(my-assert
+ (progn (setq aa (make-string-input-stream "berlin d mueller :r")) t)
+ t)
+
+(my-assert
+ (defun ask (&optional (res nil))
+   "  (terpri)(terpri)(terpri)
+  (print '(*** Eingabe des  Keywortes ***))
+  (print '(- mit :r reset))
+  (terpri)" (setq x (read aa)) "  (print x)" (cond
+					      ((equal x (quote :r)) (cons "--- reset ---" res))
+					      (t (cons (cadr (assoc x a)) (ask res)))))
+ ask)
+
+(my-assert
+ (ask)
+ ((dresden frankfurt bonn muenchen) nil (karl luise dieter aldo) "--- reset ---"))
+
+(my-assert
+ (setq string1 "Das ist ein Teststring")
+ "Das ist ein Teststring")
+
+(my-assert
+ (setq string2 "Auch das 1 2 3 ist ein Teststring")
+ "Auch das 1 2 3 ist ein Teststring")
+
+(my-assert
+ (multiple-value-list (read-from-string string1))
+ (das 4))
+
+(my-assert
+ (multiple-value-list (read-from-string string2))
+ (auch 5))
+
+(my-assert
+ (multiple-value-list (read-from-string string1 t nil :start 2))
+ (s 4))
+
+(my-assert
+ (multiple-value-list
+  (read-from-string string1 t nil :start 2 :preserve-whitespace t))
+ (s 3))
+
+(my-assert
+ (multiple-value-list (read-from-string string2 t nil :start 5))
+ (das 9))
+
+(my-assert
+ (multiple-value-list (read-from-string string2 t nil :start 5 :end
+					6))
+ (d 6))
+
+(my-assert
+ (multiple-value-list (read-from-string string1 t nil :start 4 :end
+					3))
+ error)
+
+(my-assert
+ (multiple-value-list (read-from-string string1 t nil :end 0))
+ error)
+
+(my-assert
+ (multiple-value-list (read-from-string string1 t nil :start -2 :end
+					0))
+ error)
+
+(my-assert
+ (multiple-value-list (read-from-string string1 t nil :end 2))
+ (da 2))
+
+(my-assert
+ *read-suppress*
+ nil)
+
+(my-assert
+ (standard-char-p (quote a))
+ error)
+
+(my-assert
+ (standard-char-p (quote #\backspace))
+ #+xcl t
+ #-xcl nil)
+
+(my-assert
+ (standard-char-p (quote #\tab))
+ #+xcl t
+ #-xcl nil)
+
+(my-assert
+ (standard-char-p (quote #\newline))
+ t)
+
+(my-assert
+ (standard-char-p (quote #\page))
+ #+xcl t
+ #-xcl nil)
+
+(my-assert
+ (standard-char-p (quote #\return))
+ #+xcl t
+ #-xcl nil)
+
+#-(or cmu sbcl sbcl)
+(my-assert
+ (string-char-p (quote a))
+ error)
+
+(my-assert
+ (characterp (quote
+	      #\space))
+ t)
+
+(my-assert
+ (characterp (quote
+	      #\newline))
+ t)
+
+(my-assert
+ (characterp (quote
+				#\backspace))
+ t)
+
+(my-assert
+ (characterp (quote
+	      #\a))
+ t)
+
+(my-assert
+ (characterp (quote
+	      #\8))
+ t)
+
+(my-assert
+ (characterp (quote
+	      #\-))
+ t)
+
+(my-assert
+ (characterp (quote
+				#\n))
+ t)
+
+(my-assert
+ (characterp (quote
+				#\())
+ t)
+
+(my-assert
+ (stringp "das ist einer der Teststrings")
+ t)
+
+(my-assert
+ (stringp (quote (das ist natuerlich falsch)))
+ nil)
+
+(my-assert
+ (stringp "das ist die eine Haelfte" "und das die andere")
+ error)
+
+(my-assert
+ (setq j 0)
+ 0)
+
+(my-assert
+ (with-input-from-string (s "animal crackers" :start 6) (read s))
+ crackers)
+
+(my-assert
+ (with-input-from-string (s "animal crackers" :index j :start 6) (read s))
+ crackers)
+
+(my-assert
+ j
+ 15)
+
+(my-assert
+ (with-input-from-string (s "animal crackers" :index j :start 7) (read s))
+ crackers)
+
+(my-assert
+ j
+ 15)
+
+(my-assert
+ (with-input-from-string (s "animal crackers" :index j :start 2) (read s))
+ imal)
+
+(my-assert
+ j
+ 7)
+
+(my-assert
+ (with-input-from-string (s "animal crackers" :index j :start 0 :end 6) (read s))
+ animal)
+
+(my-assert
+ j
+ 6)
+
+(my-assert
+ (with-input-from-string (s "animal crackers"
+			    :index j
+			    :start 0 :end 12)
+			 (read s))
+ animal)
+
+(my-assert
+ j
+ 7)
+
+(my-assert
+ (with-input-from-string (s "animal crackers" :index j :start -1) (read s))
+ error)
+
+(my-assert
+ j
+ 7)
+
+(my-assert
+ (with-input-from-string (s "animal crackers"
+			    :index j
+			    :start 6 :end 20)
+			 (read s))
+ #+xcl
+ crackers
+ #+(or clisp akcl allegro sbcl cmu ecls)
+ error
+ #-(or xcl clisp akcl allegro sbcl cmu ecls)
+ unknown)
+
+(my-assert
+ j
+ #+xcl
+ 20
+ #+(or clisp akcl allegro sbcl cmu ecls)
+ 7
+ #-(or xcl clisp akcl allegro sbcl cmu ecls)
+ unknown)
+
+(my-assert
+ (setq a "Das ist wieder einmal einer der SUUPERTESTstrings.")
+ "Das ist wieder einmal einer der SUUPERTESTstrings.")
+
+(my-assert
+ (progn (setq b (make-string-output-stream)) t)
+ t)
+
+(my-assert
+ (write-string a b)
+ "Das ist wieder einmal einer der SUUPERTESTstrings.")
+
+(my-assert
+ (write-string a b :start 10)
+ "Das ist wieder einmal einer der SUUPERTESTstrings.")
+
+(my-assert
+ (write-string a b :start 80)
+ #+xcl "Das ist wieder einmal einer der SUUPERTESTstrings."
+ #-xcl error)
+
+(my-assert
+ (write-string a b :end 5)
+ "Das ist wieder einmal einer der SUUPERTESTstrings.")
+
+(my-assert
+ (write-string a b :end -2)
+ error)
+
+(my-assert
+ (write-string a b :end 100)
+ #+(or sbcl cmu xcl)
+ "Das ist wieder einmal einer der SUUPERTESTstrings."
+ #-(or sbcl cmu xcl)
+ error)
+
+(my-assert
+ (write-string a b :start 5 :end 20)
+ "Das ist wieder einmal einer der SUUPERTESTstrings.")
+
+(my-assert
+ (write-string a b :start 10 :end 5)
+ #+xcl "Das ist wieder einmal einer der SUUPERTESTstrings."
+ #-xcl error)
+
+(my-assert
+ (get-output-stream-string b)
+ #+(or sbcl cmu xcl)
+ "Das ist wieder einmal einer der SUUPERTESTstrings.eder einmal einer der SUUPERTESTstrings.Das iDas ist wieder einmal einer der SUUPERTESTstrings.st wieder einma"
+ #+(or clisp akcl ecls)
+ "Das ist wieder einmal einer der SUUPERTESTstrings.eder einmal einer der SUUPERTESTstrings.Das ist wieder einma"
+ #-(or xcl clisp akcl sbcl cmu ecls)
+ unknown)
+
+(my-assert
+ (write-string a b)
+ "Das ist wieder einmal einer der SUUPERTESTstrings.")
+
+(my-assert
+ (length (get-output-stream-string b))
+ 50)
+
+(my-assert
+ (write-line a b)
+ "Das ist wieder einmal einer der SUUPERTESTstrings.")
+
+(my-assert
+ (length (get-output-stream-string b))
+ 51)
+
+(my-assert
+ (with-output-to-string (s) (print (quote xxx) s))
+ "
+XXX ")
+
+(my-assert
+ (let ((a (make-array 10
+		      :element-type 'character
+		      :fill-pointer 0)))
+   a)
+ "")
+
+(my-assert
+  (let ((a (make-array 10
+		      :element-type 'character
+		      :fill-pointer 0)))
+    (with-output-to-string (s a) (princ 123 s)))
+ 123)
+
+(my-assert
+ (let ((a (make-array 10
+		      :element-type 'character
+		      :fill-pointer 0)))
+   (with-output-to-string (s a) (princ 123 s))
+    a)
+ "123")
+
+(my-assert
+  (let ((a (make-array 10
+		      :element-type 'character
+		      :fill-pointer 0)))
+   (with-output-to-string (s a) (princ 123 s))
+   (with-output-to-string (s a) (princ 4567 s)))
+ 4567)
+
+(my-assert
+ (let ((a (make-array 10
+		      :element-type 'character
+		      :fill-pointer 0)))
+   (with-output-to-string (s a) (princ 123 s))
+   (with-output-to-string (s a) (princ 4567 s))
+   a)
+ "1234567")
+
+(my-assert
+ (let ((a (make-array 10
+		      :element-type 'character
+		      :fill-pointer 0)))
+   (with-output-to-string (s a) (princ 123 s))
+   (with-output-to-string (s a) (princ 4567 s))
+   (with-output-to-string (s a)
+			  (princ 890 s)))
+ 890)
+
+(my-assert
+ (let ((a (make-array 10
+		      :element-type 'character
+		      :fill-pointer 0)))
+   (with-output-to-string (s a) (princ 123 s))
+   (with-output-to-string (s a) (princ 4567 s))
+   (with-output-to-string (s a)
+			  (princ 890 s))
+   a)
+ "1234567890")
+
+(my-assert
+ (let ((a (make-array 10
+		      :element-type 'character
+		      :fill-pointer 0)))
+   (with-output-to-string (s a) (princ 123 s))
+   (with-output-to-string (s a) (princ 4567 s))
+   (with-output-to-string (s a)
+			  (princ 890 s))
+   (with-output-to-string (s a)
+			  (princ (quote a) s)))
+ error
+ "All 10 characters are up. This should fail")
+
+(my-assert
+  (let ((a (make-array 10
+		      :element-type 'character
+		      :fill-pointer 0)))
+   (with-output-to-string (s a) (princ 123 s))
+   (with-output-to-string (s a) (princ 4567 s))
+   (with-output-to-string (s a)
+			  (princ 890 s))
+   (ignore-errors
+    (with-output-to-string (s a)
+			   (princ (quote a) s)))
+   a)
+ "1234567890")
+
+(my-assert
+ (setq a
+       (make-array 10 :element-type 'character
+		   :fill-pointer 0
+		   :adjustable t))
+ "")
+
+(my-assert
+ (with-output-to-string (s a) (princ 123 s))
+ 123)
+
+(my-assert
+ a
+ "123")
+
+(my-assert
+ (with-output-to-string (s a) (princ 4567 s))
+ 4567)
+
+(my-assert
+ a
+ "1234567")
+
+(my-assert
+ (with-output-to-string (s a) (princ 890 s))
+ 890)
+
+(my-assert
+ a
+ "1234567890")
+
+(my-assert
+ (with-output-to-string (s a) (princ (quote abcde) s))
+ abcde)
+
+(my-assert
+ a
+ "1234567890ABCDE")
+
+(my-assert
+ (with-output-to-string (s a) (princ (quote fghi) s))
+ fghi)
+
+(my-assert
+ a
+ "1234567890ABCDEFGHI")
+
+(makunbound 'bs)
+(makunbound 'a)
+(makunbound 'b)
+(makunbound 'c)
+(makunbound 'd)
+(makunbound 'aa)
+(makunbound 'string1)
+(makunbound 'string2)
+(makunbound 'x)
+(makunbound 'j)
+(makunbound 's1)
+(makunbound 'str1)
+
diff --git a/src/ansi-tests/lambda.lisp b/src/ansi-tests/lambda.lisp
new file mode 100644
index 000000000..d25f83a85
--- /dev/null
+++ b/src/ansi-tests/lambda.lisp
@@ -0,0 +1,279 @@
+;;; based on 1.1.1.1 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (makunbound 'b) b)
+
+(my-assert
+ (makunbound 'e) e)
+
+(my-assert
+ (setq z 2) 2)
+
+(my-assert
+ ((lambda (z) (declare (special z)) (list z (symbol-value 'z))) 3)
+ (3 3))
+
+(my-assert
+ (makunbound 'z) z)
+
+(my-assert
+ ((lambda (a b) (+ a (* b 3))) 4 5)
+ 19)
+
+(my-assert
+ ((lambda (a &optional (b 2)) (+ a (* b 3))) 4 5)
+ 19)
+
+(my-assert
+ ((lambda (a &optional (b 2)) (+ a (* b 3))) 4)
+ 10)
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)))
+ (2 nil 3 nil nil))
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6)
+ (6 t 3 nil nil))
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3)
+ (6 t 3 t nil))
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3
+  8)
+ (6 t 3 t (8)))
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3
+  8 9 10 11)
+ (6 t 3 t (8 9 10 11)))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2)
+ (1 2 nil nil))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :c 6)
+ (1 2 6 nil))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :d 8)
+ (1 2 nil 8))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :c 6 :d 8)
+ (1 2 6 8))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :d 8 :c 6)
+ (1 2 6 8))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) :a 1 :d 8 :c 6)
+ (:a 1 6 8))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) :a :b :c :d)
+ (:a :b :d nil))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a)) (list a b c d x))
+  1)
+ (1 3 nil 1 nil))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a)) (list a b c d x))
+  1 2)
+ (1 2 nil 1 nil))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a)) (list a b c d x))
+  :c 7)
+ (:c 7 nil :c nil))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a)) (list a b c d x))
+  1 6 :c 7)
+ (1 6 7 1 (:c 7)))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a)) (list a b c d x))
+  1 6 :d 8)
+ (1 6 nil 8 (:d 8)))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a)) (list a b c d x))
+  1 6 :d 8 :c
+  9 :d 10)
+ (1 6 9 8 (:d 8 :c 9 :d 10)))
+
+(my-assert
+ ((lambda (x &aux (a 3) (b 4)) (+ x (* a b))) 2)
+ 14)
+
+(my-assert
+ ((lambda (x y &optional a b &rest z &key c (d y) &aux (u 3) (v 4))
+	  (+ x y a (* b (car z)) c (* d u) v))
+  3 4 5 2 7 :c 6 :d 8)
+ program-error)
+
+(my-assert
+ ((lambda (x y &optional a b &rest z &key c (d y) &aux (u 3) (v 4))
+	  (+ x y a (* b (car z)) c (* d u) v))
+  3 4 5 2 7 :c 6)
+ program-error)
+
+(my-assert
+ ((lambda (x &aux c) (cons x c)) (quote a))
+ (a))
+
+(my-assert
+ ((lambda (x &rest y z) (list x y z)) 1 2 3)
+ error)
+
+(my-assert
+ ((lambda (5 a b) (list a b)) 1 2)
+ error)
+
+(my-assert
+ ((lambda ((length (quote (a b))) c) (list c)) 1)
+ error)
+
+(my-assert
+ ((lamda (x &key :y :z) (list x y z)) 1 :y 2 :z 3)
+ error)
+
+(my-assert
+ ((lambda (x y) (list x y z)) 1 2)
+ unbound-variable)
+
+(my-assert
+ ((lambda (x y) (list x y z)) 1 2 3)
+ error)
+
+(my-assert
+ ((lambda (&optional) (list a b c)) 1)
+ error)
+
+(my-assert
+ ((lambda (&optional (a)) (list a)) 1)
+ (1))
+
+(my-assert
+ ((lambda (&optional (a b)) (list a b)) 1)
+ unbound-variable)
+
+(my-assert
+ ((lambda (&optional (a 3 b)) (list a b)) 1)
+ (1 t))
+
+(my-assert
+ ((lambda (&optional (a 3)) (list a)) 1)
+ (1))
+
+(my-assert
+ ((lambda (&optional (a 3 b 4)) (list a b)) 1)
+ #+xcl (1 t)
+ #-xcl error)
+
+(my-assert
+ ((lambda (x) (list x y)) 1 2)
+ error)
+
+(my-assert
+ ((lambda (x) (list x)) 1 2)
+ error)
+
+(my-assert
+ ((lambda (#\a) (list a)) 1)
+ error)
+
+(my-assert
+ ((lambda (#*10) (list 1 2 3)))
+ error)
+
+(my-assert
+ ((lambda (x y) ((lambda (a b) (list a b)) (quote u) (quote v))) 5 6)
+ (u v))
+
+(my-assert
+ ((lambda (x y) (list x y)) 1)
+ error)
+
+(my-assert
+ ((lambda (x &rest y &optional (z 5)) (list x y z)) 1 3)
+ error)
+
+(my-assert
+ ((lambda (x &x) (list x)) 7)
+ error)
+
+(my-assert
+ ((lambda (x &aux) (list x)) 6)
+ (6))
+
+(my-assert
+ ((lambda (x &aux y) (list x y)) 6)
+ (6 nil))
+
+(my-assert
+ ((lambda (x &aux (y)) (list x y)) 6)
+ (6 nil))
+
+(my-assert
+ ((lambda (x &rest) (list x)) 2)
+ error)
+
+(my-assert
+ ((lambda (x &key) (list x)) 3)
+ (3))
+
+(my-assert
+ ((lambda (x &key y) (list x)) 3)
+ (3))
+
+(my-assert
+ ((lambda (x &key y) (list x)) 3 :y)
+ error)
+
+(my-assert
+ ((lambda (x &key y) (list x)) :\3)
+ (:\3))
+
+(my-assert
+ ((lambda nil (list 1 2 3)))
+ (1 2 3))
+
+(my-assert
+ ((lambda nil (list 1 2 3)) 4 5)
+ error)
+
+(my-assert
+ ((lambda (list 1 2 3)))
+ error)
+
+(my-assert
+ ((lambda (x)))
+ error)
+
+(my-assert
+ ((lambda (&aux &key &rest &optional)))
+ error)
+
+(my-assert
+ ((lambda (a b &key c d &allow-other-keys) (list a b c d e f)) 1 2 :c
+  6 :d 8 :e 5
+  :f 7)
+ error)
+
+(my-assert
+ ((lambda (x &allow-other-keys) (list x y)) 2 :y 3)
+ error)
+
+(my-assert
+ ((lambda))
+ error)
+
diff --git a/src/ansi-tests/lists151.lisp b/src/ansi-tests/lists151.lisp
new file mode 100644
index 000000000..0cafc7309
--- /dev/null
+++ b/src/ansi-tests/lists151.lisp
@@ -0,0 +1,837 @@
+;;; based on v1.1.1.1 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (makunbound 'a)
+ a)
+
+(my-assert
+ (makunbound 'x)
+ x)
+
+(my-assert
+ (car '(a b c d e f g))
+ a)
+
+(my-assert
+ (cdr '(a b c d e f g))
+ (b c d e f g))
+
+(my-assert
+ (caar '((a) b c d e f g))
+ a)
+
+(my-assert
+ (cadr '(a b c d e f g))
+ b)
+
+(my-assert
+ (cdar '((a b) c d e f g))
+ (b))
+
+(my-assert
+ (cddr '(a b c d e f g))
+ (c d e f g))
+
+(my-assert
+ (caaar '(((a)) b c d e f g))
+ a)
+
+(my-assert
+ (caadr '(a (b) c d e f g))
+ b)
+
+(my-assert
+ (cadar '((a b) c d e f g))
+ b)
+
+(my-assert
+ (caddr '(a b c d e f g))
+ c)
+
+(my-assert
+ (cdaar '(((a b)) c d e f g))
+ (b))
+
+(my-assert
+ (cdadr '(a (b c) d e f g))
+ (c))
+
+(my-assert
+ (cddar '((a b c) d e f g))
+ (c))
+
+(my-assert
+ (cdddr '(a b c d e f g))
+ (d e f g))
+
+(my-assert
+ (caaaar '((((a))) b c d e f g))
+ a)
+
+(my-assert
+ (caaadr '(a ((b)) c d e f g))
+ b)
+
+(my-assert
+ (caadar '((a (b)) c d e f g))
+ b)
+
+(my-assert
+ (caaddr '(a b (c) d e f g))
+ c)
+
+(my-assert
+ (cadaar '(((a b)) c d e f g))
+ b)
+
+(my-assert
+ (cadadr '(a (b c) d e f g))
+ c)
+
+(my-assert
+ (caddar '((a b c) d e f g))
+ c)
+
+(my-assert
+ (cadddr '(a b c d e f g))
+ d)
+
+(my-assert
+ (cdaaar '((((a b))) c d e f g))
+ (b))
+
+(my-assert
+ (cdaadr '(a ((b c)) d e f g))
+ (c))
+
+(my-assert
+ (cdadar '((a (b c)) d e f g))
+ (c))
+
+(my-assert
+ (cdaddr '(a b (c d) e f g))
+ (d))
+
+(my-assert
+ (cddaar '(((a b c)) d e f g))
+ (c))
+
+(my-assert
+ (cddadr '(a (b c d) e f g))
+ (d))
+
+(my-assert
+ (cdddar '((a b c d) e f g))
+ (d))
+
+(my-assert
+ (cddddr '(a b c d e f g))
+ (e f g))
+
+(my-assert
+ (car '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	e f g))
+ ((((1 2 3) 4) 5) (6 7)))
+
+(my-assert
+ (cdr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	e f g))
+ ((((u v w) x) y) ((q w e) r) (a b c) e f g))
+
+(my-assert
+ (caar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	 e f g))
+ (((1 2 3) 4) 5))
+
+(my-assert
+ (cadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	 e f g))
+ (((u v w) x) y))
+
+(my-assert
+ (cdar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	 e f g))
+ ((6 7)))
+
+(my-assert
+ (cddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	 e f g))
+ (((q w e) r) (a b c) e f g))
+
+(my-assert
+ (caaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	  e f g))
+ ((1 2 3) 4))
+
+(my-assert
+ (caadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	  e f g))
+ ((u v w) x))
+
+(my-assert
+ (cadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	  e f g))
+ (6 7))
+
+(my-assert
+ (caddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	  e f g))
+ ((q w e) r))
+
+(my-assert
+ (cdaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	  e f g))
+ (5))
+
+(my-assert
+ (cdadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	  e f g))
+ (y))
+
+(my-assert
+ (cddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	  e f g))
+ nil)
+
+(my-assert
+ (cdddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c)
+	  e f g))
+ ((a b c) e f g))
+
+(my-assert
+ (caaaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ (1 2 3))
+
+(my-assert
+ (caaadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ (u v w))
+
+(my-assert
+ (caadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ 6)
+
+(my-assert
+ (caaddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ (q w e))
+
+(my-assert
+ (cadaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ 5)
+
+(my-assert
+ (cadadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ y)
+
+(my-assert
+ (caddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ nil)
+
+(my-assert
+ (cadddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ (a b c))
+
+(my-assert
+ (cdaaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ (4))
+
+(my-assert
+ (cdaadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ (x))
+
+(my-assert
+ (cdadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ (7))
+
+(my-assert
+ (cdaddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ (r))
+
+(my-assert
+ (cddaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ nil)
+
+(my-assert
+ (cddadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ nil)
+
+(my-assert
+ (cdddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ nil)
+
+(my-assert
+ (cddddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b
+								  c) e f g))
+ (e f g))
+
+(my-assert
+ (car 'nil)
+ nil)
+
+(my-assert
+ (cdr 'nil)
+ nil)
+
+(my-assert
+ (caar 'nil)
+ nil)
+
+(my-assert
+ (cadr 'nil)
+ nil)
+
+(my-assert
+ (cdar 'nil)
+ nil)
+
+(my-assert
+ (cddr 'nil)
+ nil)
+
+(my-assert
+ (caaar 'nil)
+ nil)
+
+(my-assert
+ (caadr 'nil)
+ nil)
+
+(my-assert
+ (cadar 'nil)
+ nil)
+
+(my-assert
+ (caddr 'nil)
+ nil)
+
+(my-assert
+ (cdaar 'nil)
+ nil)
+
+(my-assert
+ (cdadr 'nil)
+ nil)
+
+(my-assert
+ (cddar 'nil)
+ nil)
+
+(my-assert
+ (cdddr 'nil)
+ nil)
+
+(my-assert
+ (caaaar 'nil)
+ nil)
+
+(my-assert
+ (caaadr 'nil)
+ nil)
+
+(my-assert
+ (caadar 'nil)
+ nil)
+
+(my-assert
+ (caaddr 'nil)
+ nil)
+
+(my-assert
+ (cadaar 'nil)
+ nil)
+
+(my-assert
+ (cadadr 'nil)
+ nil)
+
+(my-assert
+ (caddar 'nil)
+ nil)
+
+(my-assert
+ (cadddr 'nil)
+ nil)
+
+(my-assert
+ (cdaaar 'nil)
+ nil)
+
+(my-assert
+ (cdaadr 'nil)
+ nil)
+
+(my-assert
+ (cdadar 'nil)
+ nil)
+
+(my-assert
+ (cdaddr 'nil)
+ nil)
+
+(my-assert
+ (cddaar 'nil)
+ nil)
+
+(my-assert
+ (cddadr 'nil)
+ nil)
+
+(my-assert
+ (cdddar 'nil)
+ nil)
+
+(my-assert
+ (cddddr 'nil)
+ nil)
+
+(my-assert
+ (car '(a b c d e f g))
+ a)
+
+(my-assert
+ (cdr '(a b c d e f g))
+ (b c d e f g))
+
+(my-assert
+ (caar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cadr '(a b c d e f g))
+ b)
+
+(my-assert
+ (cdar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cddr '(a b c d e f g))
+ (c d e f g))
+
+(my-assert
+ (caaar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (caadr '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cadar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (caddr '(a b c d e f g))
+ c)
+
+(my-assert
+ (cdaar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cdadr '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cddar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cdddr '(a b c d e f g))
+ (d e f g))
+
+(my-assert
+ (caaaar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (caaadr '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (caadar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (caaddr '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cadaar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cadadr '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (caddar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cadddr '(a b c d e f g))
+ d)
+
+(my-assert
+ (cdaaar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cdaadr '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cdadar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cdaddr '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cddaar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cddadr '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cdddar '(a b c d e f g))
+ type-error)
+
+(my-assert
+ (cddddr '(a b c d e f g))
+ (e f g))
+
+(my-assert
+ (car '(a))
+ a)
+
+(my-assert
+ (cdr '(a))
+ nil)
+
+(my-assert
+ (caar '(a))
+ type-error)
+
+(my-assert
+ (cadr '(a))
+ nil)
+
+(my-assert
+ (cdar '(a))
+ type-error)
+
+(my-assert
+ (cddr '(a))
+ nil)
+
+(my-assert
+ (caaar '(a))
+ type-error)
+
+(my-assert
+ (caadr '(a))
+ nil)
+
+(my-assert
+ (cadar '(a))
+ type-error)
+
+(my-assert
+ (caddr '(a))
+ nil)
+
+(my-assert
+ (cdaar '(a))
+ type-error)
+
+(my-assert
+ (cdadr '(a))
+ nil)
+
+(my-assert
+ (cddar '(a))
+ type-error)
+
+(my-assert
+ (cdddr '(a))
+ nil)
+
+(my-assert
+ (caaaar '(a))
+ type-error)
+
+(my-assert
+ (caaadr '(a))
+ nil)
+
+(my-assert
+ (caadar '(a))
+ type-error)
+
+(my-assert
+ (caaddr '(a))
+ nil)
+
+(my-assert
+ (cadaar '(a))
+ type-error)
+
+(my-assert
+ (cadadr '(a))
+ nil)
+
+(my-assert
+ (caddar '(a))
+ type-error)
+
+(my-assert
+ (cadddr '(a))
+ nil)
+
+(my-assert
+ (cdaaar '(a))
+ type-error)
+
+(my-assert
+ (cdaadr '(a))
+ nil)
+
+(my-assert
+ (cdadar '(a))
+ type-error)
+
+(my-assert
+ (cdaddr '(a))
+ nil)
+
+(my-assert
+ (cddaar '(a))
+ type-error)
+
+(my-assert
+ (cddadr '(a))
+ nil)
+
+(my-assert
+ (cdddar '(a))
+ type-error)
+
+(my-assert
+ (cddddr '(a))
+ nil)
+
+(my-assert
+ (cons 1 2)
+ (1 . 2))
+
+(my-assert
+ (cons 'a 'b)
+ (a . b))
+
+(my-assert
+ (cons 'a 'b 'c)
+ program-error)
+
+(my-assert
+ (cons 'a)
+ program-error)
+
+(my-assert
+ (cons)
+ program-error)
+
+(my-assert
+ (cons 'a 'nil)
+ (a))
+
+(my-assert
+ (cons 'nil 'a)
+ (nil . a))
+
+(my-assert
+ (cons 'a (cons 'b (cons 'c 'nil)))
+ (a b c))
+
+(my-assert
+ (cons 'a '(b c d))
+ (a b c d))
+
+(my-assert
+ (tree-equal 1 1)
+ t)
+
+(my-assert
+ (tree-equal 'word 'word)
+ t)
+
+(my-assert
+ (tree-equal 'word1 'word2)
+ nil)
+
+(my-assert
+ (tree-equal '(a b) '(a b))
+ t)
+
+(my-assert
+ (tree-equal '(a (b c)) '((a b) c))
+ nil)
+
+(my-assert
+ (tree-equal 5 (+ 2 3))
+ t)
+
+(my-assert
+ (tree-equal '(a (b quote nil)) '(a (b)))
+ nil)
+
+(my-assert
+ (tree-equal '(a (b . 1.0)) '(a (b #c(1.0 0.0))))
+ nil)
+
+(my-assert
+ (tree-equal 1 1 :test #'eq)
+ t)
+
+(my-assert
+ (tree-equal 'word 'word :test #'eq)
+ t)
+
+(my-assert
+ (tree-equal 'word1 'word2 :test #'eq)
+ nil)
+
+(my-assert
+ (tree-equal '(a b) '(a b) :test #'eq)
+ t)
+
+(my-assert
+ (tree-equal '(a (b c)) '((a b) c) :test #'eq)
+ nil)
+
+(my-assert
+ (tree-equal 5 (+ 2 3) :test #'eq)
+ t)
+
+(my-assert
+ (tree-equal '(a (b)) '(a (b)) :test #'eq)
+ t)
+
+(my-assert
+ (tree-equal '(a (b . 1.0)) '(a (b #c(1.0 0.0))) :test #'eq)
+ nil)
+
+(my-assert
+ (tree-equal 1 1 :test #'eql)
+ t)
+
+(my-assert
+ (tree-equal 'word 'word :test #'eql)
+ t)
+
+(my-assert
+ (tree-equal 'word1 'word2 :test #'eql)
+ nil)
+
+(my-assert
+ (tree-equal '(a b) '(a b) :test #'eql)
+ t)
+
+(my-assert
+ (tree-equal '(a (b c)) '((a b) c) :test #'eql)
+ nil)
+
+(my-assert
+ (tree-equal 5 (+ 2 3) :test #'eql)
+ t)
+
+(my-assert
+ (tree-equal '(a (b)) '(a (b)) :test #'eql)
+ t)
+
+(my-assert
+ (tree-equal '(a (b . 1.0)) '(a (b #c(1.0 0.0))) :test #'eql)
+ nil)
+
+(my-assert
+ (tree-equal 1 1 :test #'equal)
+ t)
+
+(my-assert
+ (tree-equal 'word 'word :test #'equal)
+ t)
+
+(my-assert
+ (tree-equal 'word1 'word2 :test #'equal)
+ nil)
+
+(my-assert
+ (tree-equal '(a b) '(a b) :test #'equal)
+ t)
+
+(my-assert
+ (tree-equal '(a (b c)) '((a b) c) :test #'equal)
+ nil)
+
+(my-assert
+ (tree-equal 5 (+ 2 3) :test #'equal)
+ t)
+
+(my-assert
+ (tree-equal '(a (b)) '(a (b)) :test #'equal)
+ t)
+
+(my-assert
+ (tree-equal '(a (b . 1.0)) '(a (b #c(1.0 0.0))) :test #'equal)
+ nil)
+
+(my-assert
+ (tree-equal 1 1 :test-not #'eq)
+ nil)
+
+(my-assert
+ (tree-equal 'word 'word :test-not #'eq)
+ nil)
+
+(my-assert
+ (tree-equal 'word1 'word2 :test-not #'eq)
+ t)
+
+(my-assert
+ (tree-equal '(a b) '(a b) :test-not #'eq)
+ nil)
+
+(my-assert
+ (tree-equal '(a (b c)) '((a b) c) :test-not #'eq)
+ nil)
+
+(my-assert
+ (tree-equal 5 (+ 2 3) :test-not #'eq)
+ nil)
+
+(my-assert
+ (tree-equal '(a (b)) '(a (b)) :test-not #'eq)
+ nil)
+
+(my-assert
+ (tree-equal '(a (b . 1.0)) '(a (b #c(1.0 0.0))) :test-not #'eq)
+ nil)
+
diff --git a/src/ansi-tests/lists152.lisp b/src/ansi-tests/lists152.lisp
new file mode 100644
index 000000000..f7a1cb7e3
--- /dev/null
+++ b/src/ansi-tests/lists152.lisp
@@ -0,0 +1,1056 @@
+;;; based on v1.3 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (endp 'nil)
+ t)
+
+(my-assert
+ (endp (cons 'a 'b))
+ nil)
+
+(my-assert
+ (endp (append (list 'a 'b) 'c))
+ nil)
+
+(my-assert
+ (endp (list 'a 'b 'c))
+ nil)
+
+(my-assert
+ (endp (list 'a 'b 'c 'd))
+ nil)
+
+(my-assert
+ (endp (append (list 'a 'b 'c)  'd))
+ nil)
+
+(my-assert
+ (endp (list ''nil ''nil))
+ nil)
+
+(my-assert
+ (list-length 'nil)
+ 0)
+
+(my-assert
+ (list-length (cons 'a 'b))
+ #+xcl 1
+ #-xcl type-error)
+
+(my-assert
+ (list-length (list 'a 'b 'c 'd))
+ 4)
+
+(my-assert
+ (list-length
+  (list 'a (list 'b 'c) 'd))
+ 3)
+
+(my-assert
+ (let ((x (list 'a 'b 'c)))
+   (rplacd (last x)
+	   x)
+   (list-length x))
+ nil)
+
+(my-assert
+ (nth 0
+      (list 'a 'b 'c 'd))
+ a)
+
+(my-assert
+ (nth 1
+      (list 'a 'b 'c 'd))
+ b)
+
+(my-assert
+ (nth 3
+      (list 'a 'b 'c 'd))
+ d)
+
+(my-assert
+ (nth 5
+      (list 'a 'b 'c 'd))
+ nil)
+
+(my-assert
+ (nth -2
+      (list 'a 'b 'c 'd))
+ type-error)
+
+(my-assert
+ (nth 0 'nil)
+ nil)
+
+(my-assert
+ (nth 2 'nil)
+ nil)
+
+(my-assert
+ (first (list 1 2 3 4 5 6 7 8 9 10 11))
+ 1)
+
+(my-assert
+ (second (list 1 2 3 4 5 6 7 8 9 10 11))
+ 2)
+
+(my-assert
+ (third (list 1 2 3 4 5 6 7 8 9 10 11))
+ 3)
+
+(my-assert
+ (fourth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 4)
+
+(my-assert
+ (fifth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 5)
+
+(my-assert
+ (sixth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 6)
+
+(my-assert
+ (seventh (list 1 2 3 4 5 6 7 8 9 10 11))
+ 7)
+
+(my-assert
+ (eighth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 8)
+
+(my-assert
+ (ninth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 9)
+
+(my-assert
+ (tenth (list 1 2 3 4 5 6 7 8 9 10 11))
+ 10)
+
+(my-assert
+ (first (list 1 2 3))
+ 1)
+
+(my-assert
+ (second (list 1 2 3))
+ 2)
+
+(my-assert
+ (third (list 1 2 3))
+ 3)
+
+(my-assert
+ (fourth (list 1 2 3))
+ nil)
+
+(my-assert
+ (fifth (list 1 2 3))
+ nil)
+
+(my-assert
+ (sixth (list 1 2 3))
+ nil)
+
+(my-assert
+ (seventh (list 1 2 3))
+ nil)
+
+(my-assert
+ (eighth (list 1 2 3))
+ nil)
+
+(my-assert
+ (ninth (list 1 2 3))
+ nil)
+
+(my-assert
+ (tenth (list 1 2 3))
+ nil)
+
+(my-assert
+ (first 'nil)
+ nil)
+
+(my-assert
+ (second 'nil)
+ nil)
+
+(my-assert
+ (third 'nil)
+ nil)
+
+(my-assert
+ (fourth 'nil)
+ nil)
+
+(my-assert
+ (fifth 'nil)
+ nil)
+
+(my-assert
+ (sixth 'nil)
+ nil)
+
+(my-assert
+ (seventh 'nil)
+ nil)
+
+(my-assert
+ (eighth 'nil)
+ nil)
+
+(my-assert
+ (ninth 'nil)
+ nil)
+
+(my-assert
+ (tenth 'nil)
+ nil)
+
+(my-assert
+ (rest (list 1 2 3 4 5))
+ (2 3 4 5))
+
+(my-assert
+ (rest 'nil)
+ nil)
+
+(my-assert
+ (rest (cons 'a 'b))
+ b)
+
+(my-assert
+ (rest (append (list 1 2 3) 4))
+ (2 3 . 4))
+
+(my-assert
+ (nthcdr 0
+	 (list 'a 'b 'c 'd))
+ (a b c d))
+
+(my-assert
+ (nthcdr 1
+	 (list 'a 'b 'c 'd))
+ (b c d))
+
+(my-assert
+ (nthcdr 3
+	 (list 'a 'b 'c 'd))
+ (d))
+
+(my-assert
+ (nthcdr 5
+	 (list 'a 'b 'c 'd))
+ nil)
+
+(my-assert
+ (nthcdr -2
+	 (list 'a 'b 'c 'd))
+ type-error)
+
+(my-assert
+ (nthcdr 0 'nil)
+ nil)
+
+(my-assert
+ (nthcdr 2 'nil)
+ nil)
+
+(my-assert
+ (last (list 1 2 3 4 5))
+ (5))
+
+(my-assert
+ (last 'nil)
+ nil)
+
+(my-assert
+ (last (cons 'a 'b))
+ (a . b))
+
+(my-assert
+ (last (append (list 1 2 3) 4))
+ (3 . 4))
+
+(my-assert
+ (list 'a 'b 'c 'd)
+ (a b c d))
+
+(my-assert
+ (list 'a)
+ (a))
+
+(my-assert
+ (list (list 'a 'b)
+       (list 'c 'd))
+ ((a b)
+  (c d)))
+
+(my-assert
+ (list 'a 'nil)
+ (a nil))
+
+(my-assert
+ (list 'nil 'a)
+ (nil a))
+
+(my-assert
+ (list 'nil 'nil)
+ (nil nil))
+
+(my-assert
+ (list)
+ nil)
+
+(my-assert
+ (list 3 4 'a
+       (car (cons 'b 'c))
+       (+ 6 -2))
+ (3 4 a b 4))
+
+(my-assert
+ (list* 'a 'b 'c 'd)
+ (a b c . d))
+
+(my-assert
+ (list* 'a)
+ a)
+
+(my-assert
+ (list* (list 'a 'b)
+	(list 'c 'd))
+ ((a b)
+  c d))
+
+(my-assert
+ (list* 'a 'nil)
+ (a))
+
+(my-assert
+ (list* 'nil 'a)
+ (nil . a))
+
+(my-assert
+ (list* 'nil 'nil)
+ (nil))
+
+(my-assert
+ (list*)
+ program-error)
+
+(my-assert
+ (list* 3 4 'a
+	(car (cons 'b 'c))
+	(+ 6 -2))
+ (3 4 a b . 4))
+
+(my-assert
+ (list* 'a 'b 'c
+	(list 'd 'e 'f))
+ (a b c d e f))
+
+(my-assert
+ (list* x)
+ unbound-variable)
+
+(my-assert
+ (list* 'nil)
+ nil)
+
+(my-assert
+ (make-list 5)
+ (nil nil nil nil nil))
+
+(my-assert
+ (make-list 5 :initial-element)
+ program-error)
+
+(my-assert
+ (make-list 3 :initial-element 'rah)
+ (rah rah rah))
+
+(my-assert
+ (make-list 0)
+ nil)
+
+(my-assert
+ (make-list 0 :initial-element 'aaa)
+ nil)
+
+(my-assert
+ (make-list 5 :initial-element 'nil)
+ (nil nil nil nil nil))
+
+(my-assert
+ (make-list)
+ program-error)
+
+(my-assert
+ (append (list 'a 'b 'c)
+	 (list 'd 'e 'f)
+	 'nil
+	 (list 'g))
+ (a b c d e f g))
+
+(my-assert
+ (append (list 'a 'b 'c)
+	 'd)
+ (a b c . d))
+
+(my-assert
+ (append 'a 'b)
+ error)
+
+(my-assert
+ (append 'a 'nil)
+ error)
+
+(my-assert
+ (append 'nil 'nil)
+ nil)
+
+(my-assert
+ (append 'nil 'a)
+ #+xcl error
+ #-xcl a)
+
+(my-assert
+ (append 'nil
+	 (list 'a 'b 'c))
+ (a b c))
+
+(my-assert
+ (setq x
+       (list 'a 'b 'c))
+ (a b c))
+
+(my-assert
+ (setq y
+       (list 'd 'e 'f))
+ (d e f))
+
+(my-assert
+ (setq r
+       (append x y))
+ (a b c d e f))
+
+(my-assert
+ x
+ (a b c))
+
+(my-assert
+ y
+ (d e f))
+
+(my-assert
+ (eq (cdddr r)
+     y)
+ t)
+
+(my-assert
+ (copy-list (list 1 2 3 4 5))
+ (1 2 3 4 5))
+
+(my-assert
+ (copy-list 'nil)
+ nil)
+
+(my-assert
+ (copy-list (cons 'a 'b))
+ (a . b))
+
+(my-assert
+ (copy-list (append (list 1 2 3) 4))
+ (1 2 3 . 4))
+
+(my-assert
+ (setq l
+       (list 1 2 3 4 5))
+ (1 2 3 4 5))
+
+(my-assert
+ (eq l
+     (copy-list l))
+ nil)
+
+(my-assert
+ (eql l
+      (copy-list l))
+ nil)
+
+(my-assert
+ (equal l
+	(copy-list l))
+ t)
+
+(my-assert
+ (equalp l
+	 (copy-list l))
+ t)
+
+(my-assert
+ (copy-alist 'a)
+ #-clisp error
+ #+clisp a)
+
+(my-assert
+ (copy-alist 'nil)
+ nil)
+
+(my-assert
+ (copy-alist 5)
+ #-clisp error
+ #+clisp 5)
+
+(my-assert
+ (copy-alist (list 'a 'b))
+ #+(or xcl clisp allegro cmu sbcl) (a b)
+ #+(or ecls gcl) error
+ #-(or xcl clisp gcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (copy-alist (list (cons 1 'a)
+		   (cons 2 'b)
+		   (cons 3 'c)))
+ ((1 . a)
+  (2 . b)
+  (3 . c)))
+
+(my-assert
+ (setq x
+       (list (cons 1 'a)
+	     (cons 2 'b)
+	     (cons 3 'c)))
+ ((1 . a)
+  (2 . b)
+  (3 . c)))
+
+(my-assert
+ (eq x
+     (copy-alist x))
+ nil)
+
+(my-assert
+ (eql x
+      (copy-alist x))
+ nil)
+
+(my-assert
+ (equal x
+	(copy-alist x))
+ t)
+
+(my-assert
+ (eq (cadr x)
+     (cadr (copy-alist x)))
+ nil)
+
+(my-assert
+ (eql (cadr x)
+      (cadr (copy-alist x)))
+ nil)
+
+(my-assert
+ (equal (cadr x)
+	(cadr (copy-alist x)))
+ t)
+
+(my-assert
+ (copy-alist (list (cons 1 2))
+	     (list (cons a b)))
+ error)
+
+(my-assert
+ (copy-alist (list (list 'a 'b)
+		   'c
+		   (list 'd 'e)))
+ #+(or xcl clisp allegro cmu sbcl) ((a b) c (d e))
+ #+(or gcl ecls) error
+ #-(or xcl clisp gcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (copy-tree 'x)
+ x)
+
+(my-assert
+ (copy-tree 5)
+ 5)
+
+(my-assert
+ (copy-tree (list 'a 'b))
+ (a b))
+
+(my-assert
+ (copy-tree (list 'a 'b
+		  (list 'c
+			(list 'd)
+			(list 'e 'f))
+		  'g))
+ (a b
+    (c (d)
+       (e f))
+    g))
+
+(my-assert
+ (copy-tree (list (cons 1 'e)
+		  (cons 2 'f)))
+ ((1 . e)
+  (2 . f)))
+
+(my-assert
+ (copy-tree #*001)
+ #*001)
+
+(my-assert
+ (setq x
+       (list 'a 'b
+	     (list 'c 'd)
+	     'e))
+ (a b
+    (c d)
+    e))
+
+(my-assert
+ (eq x
+     (copy-tree x))
+ nil)
+
+(my-assert
+ (eql x
+      (copy-tree x))
+ nil)
+
+(my-assert
+ (equal x
+	(copy-tree x))
+ t)
+
+(my-assert
+ (eq (cdaddr x)
+     (cdaddr (copy-tree x)))
+ nil)
+
+(my-assert
+ (eql (cdaddr x)
+      (cdaddr (copy-tree x)))
+ nil)
+
+(my-assert
+ (equal (cdaddr x)
+	(cdaddr (copy-tree x)))
+ t)
+
+(my-assert
+ (revappend (list 'a 'b 'c)
+	    (list 'd 'e 'f)
+	    'nil
+	    (list 'g))
+ program-error)
+
+(my-assert
+ (revappend (list 'a 'b 'c)
+	    'd)
+ (c b a . d))
+
+(my-assert
+ (revappend 'a 'b)
+ #-clisp type-error
+ #+clisp b)
+
+(my-assert
+ (revappend 'a 'nil)
+ #-clisp type-error
+ #+clisp nil)
+
+(my-assert
+ (revappend 'nil 'nil)
+ nil)
+
+(my-assert
+ (revappend 'nil 'a)
+ a)
+
+(my-assert
+ (revappend 'nil
+	    (list 'a 'b 'c))
+ (a b c))
+
+(my-assert
+ (revappend (list 'a 'b 'c)
+	    (list 'd 'e 'f))
+ (c b a d e f))
+
+(my-assert
+ (revappend (list 'd 'e 'f)
+	    (list 'a 'b 'c))
+ (f e d a b c))
+
+(my-assert
+ (eql (revappend (list 'a 'b 'c)
+		 (list 'd 'e 'f))
+      (append (reverse (list 'a 'b 'c))
+	      (list 'd 'e 'f)))
+ nil)
+
+(my-assert
+ (equal (revappend (list 'a 'b 'c)
+		   (list 'd 'e 'f))
+	(append (reverse (list 'a 'b 'c))
+		(list 'd 'e 'f)))
+ t)
+
+(my-assert
+ (setq x
+       (list 'a 'b 'c))
+ (a b c))
+
+(my-assert
+ (setq y
+       (list 'd 'e 'f))
+ (d e f))
+
+(my-assert
+ (setq r
+       (revappend x y))
+ (c b a d e f))
+
+(my-assert
+ x
+ (a b c))
+
+(my-assert
+ y
+ (d e f))
+
+(my-assert
+ (eq (cdddr r)
+     y)
+ t)
+
+(my-assert
+ (setq x
+       (list 'a 'b 'c)
+       y
+       (list 'd 'e 'f))
+ (d e f))
+
+(my-assert
+ (nconc x y)
+ (a b c d e f))
+
+(my-assert
+ x
+ (a b c d e f))
+
+(my-assert
+ (eq (cdddr x)
+     y)
+ t)
+
+(my-assert
+ (setq x
+       (list 'a 'b 'c)
+       y
+       (list 'd 'e 'f)
+       z
+       (list 'g 'h 'i))
+ (g h i))
+
+(my-assert
+ (nconc)
+ nil)
+
+(my-assert
+ (nconc x)
+ (a b c))
+
+(my-assert
+ (nconc nil)
+ nil)
+
+(my-assert
+ (nconc nil nil)
+ nil)
+
+(my-assert
+ (nconc x nil)
+ (a b c))
+
+(my-assert
+ (nconc nil nil nil nil)
+ nil)
+
+(my-assert
+ (nconc nil nil x nil)
+ (a b c))
+
+(my-assert
+ (nconc x nil y nil z nil)
+ (a b c d e f g h i))
+
+(my-assert
+ x
+ (a b c d e f g h i))
+
+(my-assert
+ y
+ (d e f g h i))
+
+(my-assert
+ z
+ (g h i))
+
+(my-assert
+ (eq (cdddr x)
+     y)
+ t)
+
+(my-assert
+ (eq (cdddr y)
+     z)
+ t)
+
+(my-assert
+ (nconc (list 1 2)
+	'a)
+ #+xcl error
+ #+(or clisp akcl allegro cmu sbcl ecls) (1 2 . a)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (nconc 'a)
+ #+xcl error
+ #+(or clisp akcl allegro cmu sbcl ecls) a
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (setq x
+       (list 'a 'b 'c)
+       y
+       (list 'd 'e 'f))
+ (d e f))
+
+(my-assert
+ (nreconc x y)
+ (c b a d e f))
+
+(my-assert
+ x
+ #+xcl was-destroyed			; wo kommt denn so was her?
+ #+clisp (c b a d e f)
+ #+(or akcl allegro cmu sbcl ecls) (a d e f)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (tailp y x)
+ t)
+
+(my-assert
+ (setq x
+       (list 'a 'b 'c)
+       y
+       (list 'd 'e 'f)
+       z
+       (list 'g 'h 'i))
+ (g h i))
+
+(my-assert
+ (nreconc)
+ program-error)
+
+(my-assert
+ (nreconc x)
+ program-error)
+
+(my-assert
+ (nreconc nil)
+ program-error)
+
+(my-assert
+ (nreconc nil nil)
+ nil)
+
+(my-assert
+ (nreconc x nil)
+ (c b a))
+
+(my-assert
+ x
+ #+xcl was-destroyed
+ #+clisp (c b a)
+ #+(or akcl allegro cmu sbcl ecls) (a)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (nreconc nil nil nil nil)
+ program-error)
+
+(my-assert
+ (nconc nil 'x)
+ #+xcl error
+ #+(or clisp akcl allegro cmu sbcl ecls) x
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (setq aa nil)
+ nil)
+
+(my-assert
+ (push '1 aa)
+ (1))
+
+(my-assert
+ (push '2 aa)
+ (2 1))
+
+(my-assert
+ (push '2 aa)
+ (2 2 1))
+
+(my-assert
+ (setq aa
+       (list 'b 'a))
+ (b a))
+
+(my-assert
+ (pushnew 'a aa)
+ (b a))
+
+(my-assert
+ (pushnew 'c aa)
+ (c b a))
+
+(my-assert
+ (setq xxx nil)
+ nil)
+
+(my-assert
+ (pushnew 'c xxx :test 'equal)
+ (c))
+
+(my-assert
+ (pushnew 'c xxx :test 'equal)
+ (c))
+
+(my-assert
+ (pushnew (list 'c) xxx :test 'equal)
+ ((c) c))
+
+(my-assert
+ xxx
+ ((c) c))
+
+(my-assert
+ (setq xx (list nil
+		'kkk))
+ (nil kkk))
+
+(my-assert
+ (pushnew 'u (car xx))
+ (u))
+
+(my-assert
+ (pushnew 'u
+	  (car xx))
+ (u))
+
+(my-assert
+ (pushnew 'v
+	  (car xx))
+ (v u))
+
+(my-assert
+ xx
+ ((v u) kkk))
+
+(my-assert
+ (pushnew (list 'w)
+	  (car xx))
+ ((w)
+  v u))
+
+(my-assert
+ (pushnew (list 'w)
+	  (car xx))
+ ((w)
+  (w)
+  v u))
+
+(my-assert
+ (pushnew (list 'w)
+	  (car xx)
+	  :test 'equal)
+ ((w)
+  (w)
+  v u))
+
+(my-assert
+ (pushnew (list 'w)
+	  (car xx)
+	  :test-not 'equal)
+ ((w)
+  (w)
+  v u))
+
+(my-assert
+ (setq aa (list 1 2 3))
+ (1 2 3))
+
+(my-assert
+ (pop aa)
+ 1)
+
+(my-assert
+ aa
+ (2 3))
+
+(my-assert
+ (pop aa)
+ 2)
+
+(my-assert
+ (pop aa)
+ 3)
+
+(my-assert
+ (pop aa)
+ nil)
+
+(my-assert
+ (pop aa)
+ nil)
+
+(my-assert
+ (butlast (list 'a 'b 'c))
+ (a b))
+
+(my-assert
+ (butlast (list 'a 'b 'c)
+	  2)
+ (a))
+
+(my-assert
+ (nbutlast (list 'a 'b 'c 'd)
+	   3)
+ (a))
+
+(my-assert
+ (nbutlast (list 'a 'b 'c 'd)
+	   1)
+ (a b c))
+
+(my-assert
+ (nbutlast (list 'a 'b 'c 'd)
+	   0)
+ (a b c d))
+
+(my-assert
+ (nbutlast (list 'a 'b 'c 'd)
+	   4)
+ nil)
+
+(my-assert
+ (nbutlast (list 'a 'b 'c 'd)
+	   6)
+ nil)
+
diff --git a/src/ansi-tests/lists153.lisp b/src/ansi-tests/lists153.lisp
new file mode 100644
index 000000000..b97b9072b
--- /dev/null
+++ b/src/ansi-tests/lists153.lisp
@@ -0,0 +1,5 @@
+;;; based on v1.1.1.1 -*- mode: lisp -*-
+(in-package :cl-user)
+;; RPLACA
+;; RPLACD
+
diff --git a/src/ansi-tests/lists154.lisp b/src/ansi-tests/lists154.lisp
new file mode 100644
index 000000000..b41d168a8
--- /dev/null
+++ b/src/ansi-tests/lists154.lisp
@@ -0,0 +1,288 @@
+;;; based on v1.1.1.1 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (subst 'a 'b
+	'(u b
+	    (b)
+	    c))
+ (u a
+    (a)
+    c))
+
+(my-assert
+ (subst 'a 'b
+	'(u b
+	    (b)
+	    c)
+	:test-not
+	#'(lambda (x y)
+	    (if (atom y)
+		(eql x y)
+		t)))
+ (a b
+    (b . a)
+    a . a))
+
+(my-assert
+ (subst 'a 'b
+	'(u b
+	    (b)
+	    c)
+	:test
+	#'(lambda (x y)
+	    (not (eql x y))))
+ a)
+
+(my-assert
+ (subst 'a 'b
+	'(u b
+	    (b)
+	    c)
+	:test-not
+	#'(lambda (x y)
+	    (not (eql x y))))
+ (u a
+    (a)
+    c))
+
+(my-assert
+ (subst 'a 'b
+	'(u b
+	    (b)
+	    c)
+	:test-not
+	#'(lambda (x y)
+	    (not (eql x y)))
+	:key
+	#'(lambda (u)
+	    (if (listp u)
+		(car u))))
+ (u . a))
+
+(my-assert
+ (subst-if 'nummmer 'numberp
+	   '((a (7 (v 6)))))
+ ((a (nummmer (v nummmer)))))
+
+(my-assert
+ (subst-if-not 'nummmer 'numberp
+	       '((a (7 (v 6)))))
+ nummmer)
+
+(my-assert
+ (subst-if-not 'nummmer
+	       #'(lambda (x)
+		   (and (listp x)
+			(numberp x)))
+	       '((a (7 (v 6)))))
+ nummmer)
+
+(my-assert
+ (subst-if-not 'nummmer
+	       #'(lambda (x)
+		   (or (listp x)
+		       (numberp x)))
+	       '((a (7 (v 6)))))
+ ((nummmer (7 (nummmer 6)))))
+
+(my-assert
+ (nsubst 'a 'b
+	 '(u b
+	     (b)
+	     c)
+	 :test-not
+	 #'(lambda (x y)
+	     (if (atom y)
+		 (eql x y)
+		 t)))
+ (a b
+    (b . a)
+    a . a))
+
+(my-assert
+ (nsubst 'a 'b
+	 '(u b
+	     (b)
+	     c)
+	 :test-not
+	 #'(lambda (x y)
+	     (not (eql x y))))
+ (u a
+    (a)
+    c))
+
+(my-assert
+ (nsubst 'a 'b
+	 '(u b
+	     (b)
+	     c)
+	 :test
+	 #'(lambda (x y)
+	     (not (eql x y))))
+ a)
+
+(my-assert
+ (nsubst-if 'oo 'numberp
+	    '(a b c
+		(3 (4)
+		   0)))
+ (a b c
+    (oo (oo)
+	oo)))
+
+(my-assert
+ (nsubst-if-not 'oo 'numberp
+		'(a b c
+		    (3 (4)
+		       0)))
+ oo)
+
+(my-assert
+ (nsubst-if-not 'oo
+		#'(lambda (x)
+		    (or (atom x)
+			(numberp x)))
+		'(a b c
+		    (3 (4)
+		       0)))
+ oo)
+
+(my-assert
+ (nsubst-if-not 'oo
+		#'(lambda (x)
+		    (and (atom x)
+			 (numberp x)))
+		'(a b c
+		    (3 (4)
+		       0)))
+ oo)
+
+(my-assert
+ (nsubst-if-not 'oo
+		#'(lambda (x)
+		    (or (list x)
+			(numberp x)))
+		'(a b c
+		    (3 (4)
+		       0)))
+ (a b c
+    (3 (4)
+       0)))
+
+(my-assert
+ (nsubst-if-not 'oo
+		#'(lambda (x)
+		    (or (list x)
+			(symbolp x)))
+		'(a b c
+		    (3 (4)
+		       0)))
+ (a b c
+    (3 (4)
+       0)))
+
+(my-assert
+ (sublis '((a . a1)
+	   (b . b1))
+	 '(a b))
+ (a1 b1))
+
+(my-assert
+ (sublis '((a . a1)
+	   (b . b1))
+	 '(a b
+	     (b . c)))
+ (a1 b1
+     (b1 . c)))
+
+(my-assert
+ (sublis '((a . a1)
+	   (b . b1)
+	   (nil . nil1))
+	 '(a b
+	     (b . c)))
+ (a1 b1
+     (b1 . c) .
+     nil1))
+
+(my-assert
+ (sublis '((a . a1)
+	   (b . b1)
+	   (nil . nil1))
+	 '(a b
+	     (b c)))
+ (a1 b1
+     (b1 c . nil1) .
+     nil1))
+
+(my-assert
+ (sublis '((a . a1)
+	   (b . b1)
+	   (nil . nil1))
+	 '(a b
+	     (b c))
+	 :test-not 'eql)
+ a1)
+
+(my-assert
+ (sublis '((a . a1)
+	   (b . b1)
+	   (nil . nil1))
+	 '(a b
+	     (b c))
+	 :test-not
+	 #'(lambda (x y)
+	     (if (atom y)
+		 (eql x y))))
+ a1)
+
+(my-assert
+ (sublis '(((a) .
+	    uu)
+	   (a . ii))
+	 '(i (a)
+	     a))
+ (i (ii)
+    ii))
+
+(my-assert
+ (sublis '(((a) . uu) (a . ii))
+	 '(i (a) a)
+	 :key #'(lambda (x) (if (listp x) (car x))))
+ (i ii . ii))				; key wird angewandt auf: x ein blatt des baumes
+
+(my-assert
+ (sublis '(((a) . uu) (a . ii))
+	 '(i (a) a)
+	 :test #'(lambda (x y) (if (listp y) (eql x (car y)))))
+ #+(or xcl akcl lucid allegro ecls) (i ii . ii) ; x aus der aliste, y ein blatt des baumes
+ #+(or clisp cmu sbcl)              (i (uu) uu) ; x ein blatt, y aus der aliste
+ #-(or xcl clisp akcl cmu sbcl lucid allegro ecls) unknown)
+
+(my-assert
+ (nsublis '(((a) . uu) (a . ii))
+	  '(i (a) a)
+	  :key #'(lambda (x) (if (listp x) (car x))))
+ (i ii . ii))				; key wird angewandt auf: x ein blatt des baumes
+
+(my-assert
+ (nsublis '(((a) . uu) (a . ii))
+	  '(i (a) a)
+	  :test #'(lambda (x y) (if (listp x) (equal x y))))
+ (i uu . uu))
+
+(my-assert
+ (nsublis '(((a) . uu) (a . ii))
+	  '(i (a) a)
+	  :test #'(lambda (x y) (if (listp y) (equal x y))))
+ (i uu . uu))
+
+(my-assert
+ (nsublis '(((a) . uu) (a . ii))
+	  '(i (a) a)
+	  :test #'(lambda (x y) (if (listp y) (eql x (car y)))))
+ #+(or xcl akcl allegro ecls) (i ii . ii)	; x aus der aliste, y ein blatt des baumes
+ #+(or clisp cmu sbcl lucid)  (i (uu) uu) ; x ein blatt, y aus der aliste
+ #-(or xcl clisp akcl cmu sbcl lucid allegro ecls) unknown)
+
diff --git a/src/ansi-tests/lists155.lisp b/src/ansi-tests/lists155.lisp
new file mode 100644
index 000000000..b017c6045
--- /dev/null
+++ b/src/ansi-tests/lists155.lisp
@@ -0,0 +1,203 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (member 'a
+	 '((a)
+	   (b)
+	   (a)
+	   (c)))
+ nil)
+
+(my-assert
+ (member 'a
+	 '((a)
+	   (b)
+	   (a)
+	   (c))
+	 :key 'car)
+ ((a)
+  (b)
+  (a)
+  (c)))
+
+(my-assert
+ (member-if 'numberp
+	    '((a)
+	      (b)
+	      (3)
+	      (c))
+	    :key 'car)
+ ((3)
+  (c)))
+
+(my-assert
+ (member-if-not 'numberp
+		'((8)
+		  (a)
+		  (b)
+		  (3)
+		  (c))
+		:key 'car)
+ ((a)
+  (b)
+  (3)
+  (c)))
+
+(my-assert
+ (tailp '(a b)
+	'(u a b))
+ nil)
+
+(my-assert
+ (tailp (cddr (setq xx
+		    '(u i a b)))
+	xx)
+ t)
+
+(my-assert
+ (tailp (cddr (setq xx
+		    '(u i a b)))
+	xx)
+ t)
+
+(my-assert
+ (adjoin 'a
+	 '(a b c))
+ (a b c))
+
+(my-assert
+ (adjoin 'a
+	 '((a)
+	   b c)
+	 :test 'equal)
+ (a (a)
+    b c))
+
+(my-assert
+ (adjoin 'a
+	 '((a)
+	   b c)
+	 :test 'equal)
+ (a (a)
+    b c))
+
+(my-assert
+ (union '(a b c d)
+	'(a d i v))
+ #+xcl (v i a b c d)
+ #+(or clisp akcl ecls) (b c a d i v)
+ #+(or allegro cmu sbcl) (c b a d i v)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (nunion '(a b c d)
+	 '(u i b a))
+ #+xcl (a b c d u i)
+ #+(or clisp akcl ecls) (c d u i b a)
+ #+(or allegro cmu sbcl) (d c u i b a)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (nintersection '(a b c d)
+		'(c d e f g))
+ #+(or xcl clisp gcl ecls) (c d)
+ #+(or allegro cmu sbcl) (d c)
+ #-(or xcl clisp gcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (nintersection '(a b c d)
+		'(c d e f g)
+		:test-not 'eql)
+ #+(or xcl clisp gcl ecls) (a b c d)
+ #+(or allegro cmu sbcl) (d c b a)
+ #-(or xcl clisp gcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (set-difference '(a b c d e)
+		 '(d b e))
+ #+(or xcl allegro gcl cmu sbcl ecls) (c a)
+ #+(or clisp (and akcl (not gcl))) (a c)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (set-difference
+  '(auto anton berta berlin)
+  '(a)
+  :test
+  #'(lambda (x y)
+	    (eql (elt (symbol-name x)
+		      1)
+		 (elt (symbol-name y)
+		      1))))
+ #+(or xcl allegro)
+ (berlin berta anton auto)
+ #-(or xcl allegro)
+ type-error)
+
+(my-assert
+ (set-difference '(anton berta auto berlin)
+		 '(amerilla)
+		 :test
+		 #'(lambda (x y)
+			   (eql (elt (symbol-name x)
+				     0)
+				(elt (symbol-name y)
+				     0))))
+ #+(or xcl gcl allegro cmu sbcl) (berlin berta)
+ #+(or clisp (and akcl (not gcl)) ecls) (berta berlin)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (nset-difference '(a b c d)
+		  '(i j c))
+ #+(or xcl clisp gcl ecls) (a b d)
+ #+(or allegro cmu sbcl) (d b a)
+ #-(or xcl clisp gcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (set-exclusive-or '(a b c d)
+		   '(c a i l))
+ #+(or xcl gcl) (d b l i)
+ #+(or clisp (and akcl (not gcl)) ecls) (b d i l)
+ #+(or allegro cmu sbcl) (l i d b)
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (set-exclusive-or '(anton anna emil)
+		   '(berta auto august)
+		   :test
+		   #'(lambda (x y)
+			     (eql (elt (symbol-name x)
+				       0)
+				  (elt (symbol-name y)
+				       0))))
+ #+(or xcl clisp gcl ecls) (emil berta)
+ #+(or allegro cmu sbcl) (berta emil)
+ #-(or xcl clisp gcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (nset-exclusive-or '(a b c)
+		    '(i a d c))
+ (b i d))
+
+(my-assert
+ (subsetp '(a b)
+	  '(b u i a c d))
+ t)
+
+(my-assert
+ (subsetp '(a b)
+	  '(b u i c d))
+ nil)
+
+(my-assert
+ (subsetp '(a b)
+	  '(b a u i c d))
+ t)
+
+(my-assert
+ (subsetp '(a b)
+	  '(a u i c d))
+ nil)
+
diff --git a/src/ansi-tests/lists156.lisp b/src/ansi-tests/lists156.lisp
new file mode 100644
index 000000000..da92c84c4
--- /dev/null
+++ b/src/ansi-tests/lists156.lisp
@@ -0,0 +1,183 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (ACONS 'A 'B NIL)
+ ((A . B)))
+
+(my-assert
+ (ACONS 'A 'B
+	'((C . D)))
+ ((A . B)
+  (C . D)))
+
+(my-assert
+ (PAIRLIS '(A B C)
+	  '(1 2))
+ #+XCL
+ ((B . 2)
+  (A . 1))
+ #-XCL
+ ERROR)
+
+(my-assert
+ (PAIRLIS '(A B C)
+	  '(1 2 3))
+ #+(or XCL CLISP ALLEGRO cmu sbcl ecls)
+ ((C . 3)
+  (B . 2)
+  (A . 1))
+ #+AKCL ((A . 1) (B . 2) (C . 3))
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl ecls) UNKNOWN)
+
+(my-assert
+ (ASSOC 'A
+	'((B C)
+	  (A U)
+	  (A I)))
+ (A U))
+
+(my-assert
+ (ASSOC 'A
+	'((B C)
+	  ((A)
+	   U)
+	  (A I)))
+ (A I))
+
+(my-assert
+ (ASSOC 'A
+	'((B C)
+	  ((A)
+	   U)
+	  (A I))
+	:KEY
+	#'(LAMBDA (X)
+		  (IF (LISTP X)
+		      (CAR X))))
+ ((A)
+  U))
+
+(my-assert
+ (ASSOC 'A
+	'((B C)
+	  A
+	  ((A)
+	   U)
+	  (A I))
+	:KEY
+	#'(LAMBDA (X)
+		  (IF (LISTP X)
+		      (CAR X))))
+ #-(or GCL ALLEGRO cmu sbcl)
+ ((A) U)
+ #+(or GCL ALLEGRO cmu sbcl)
+ TYPE-ERROR)
+
+(my-assert
+ (ASSOC 'A
+	'((B C)
+	  A
+	  ((A)
+	   U)
+	  (A I))
+	:KEY
+	#'(LAMBDA (X)
+		  (IF (ATOM X)
+		      X)))
+ #-(or GCL ALLEGRO cmu sbcl) (A I)
+ #+(or GCL ALLEGRO cmu sbcl)
+ TYPE-ERROR)
+
+(my-assert
+ (ASSOC 'A
+	'((B C)
+	  A
+	  ((A)
+	   U)
+	  (A I))
+	:TEST
+	#'(LAMBDA (X Y)
+		  (IF (LISTP Y)
+		      (EQL (CAR Y)
+			   X))))
+ #-(or GCL ALLEGRO cmu sbcl) ((A) U)
+ #+(or GCL ALLEGRO cmu sbcl)
+ TYPE-ERROR)
+
+(my-assert
+ (ASSOC 'A
+	'((B C)
+	  A
+	  ((A)
+	   U)
+	  (A I))
+	:TEST
+	#'(LAMBDA (X Y)
+		  (IF (ATOM Y)
+		      (EQL Y X))))
+ #-(or GCL ALLEGRO cmu sbcl) (A I)
+ #+(or GCL ALLEGRO cmu sbcl) ERROR)
+
+(my-assert
+ (ASSOC 'A
+	'((B C)
+	  A
+	  ((A)
+	   U)
+	  (A I))
+	:TEST-NOT
+	#'(LAMBDA (X Y)
+		  (IF (ATOM Y)
+		      (EQL Y X))))
+ #-ALLEGRO (B C)
+ #+ALLEGRO ERROR)
+
+(my-assert
+ (ASSOC-IF 'NUMBERP
+	   '((A . 3)
+	     (3 . A)))
+ (3 . A))
+
+(my-assert
+ (ASSOC-IF 'SYMBOLP
+	   '((A . 3)
+	     (3 . A)))
+ (A . 3))
+
+(my-assert
+ (ASSOC-IF-NOT 'SYMBOLP
+	       '((A . 3)
+		 (3 . A)))
+ (3 . A))
+
+(my-assert
+ (ASSOC-IF-NOT 'NUMBERP
+	       '((A . 3)
+		 (3 . A)))
+ (A . 3))
+
+(my-assert
+ (RASSOC 'A
+	 '((1 . B)
+	   (2 . A)))
+ (2 . A))
+
+(my-assert
+ (RASSOC-IF 'SYMBOLP
+	    '((1 . B)
+	      (2 . A)))
+ (1 . B))
+
+(my-assert
+ (RASSOC-IF 'SYMBOLP
+	    '((1 . 3)
+	      (2 . A)))
+ (2 . A))
+
+(my-assert
+ (RASSOC-IF-NOT 'SYMBOLP
+		'((1 . 3)
+		  (2 . A)))
+ (1 . 3))
+
diff --git a/src/ansi-tests/loop.lisp b/src/ansi-tests/loop.lisp
new file mode 100644
index 000000000..3a285b149
--- /dev/null
+++ b/src/ansi-tests/loop.lisp
@@ -0,0 +1,937 @@
+;;; based on v1.5 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (loop for x from 1 to 9
+   for y = nil then x
+   collect (list x y)
+   )
+ ((1 NIL) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9)))
+
+(my-assert
+ (loop for x from 1 to 9
+   and y = nil then x
+   collect (list x y)
+   )
+ ((1 NIL) (2 1) (3 2) (4 3) (5 4) (6 5) (7 6) (8 7) (9 8)))
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop as i from 1 to 5
+			  do (print i)
+			  ) )
+ "
+1 
+2 
+3 
+4 
+5 ")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for i from 10 downto 1 by 3
+			  do (print i)
+			  ) )
+ "
+10 
+7 
+4 
+1 ")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop as i below 5
+			  do (print i)
+			  ) )
+ "
+0 
+1 
+2 
+3 
+4 ")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for item in '(1 2 3 4 5)
+			  do (print item)
+			  ) )
+ "
+1 
+2 
+3 
+4 
+5 ")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for item in '(1 2 3 4 5) by #'cddr
+			  do (print item)
+			  ) )
+ "
+1 
+3 
+5 ")
+
+(my-assert
+ (loop for (item . x) (t . fixnum) in '((A . 1) (B . 2) (C . 3))
+   unless (eq item 'B) sum x
+   )
+ 4)
+
+(my-assert
+ (loop for sublist on '(a b c d)
+   collect sublist
+   )
+ ((A B C D) (B C D) (C D) (D)))
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for (item) on '(1 2 3)
+			  do (print item)
+			  ) )
+ "
+1 
+2 
+3 ")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for item in '(1 2 3)
+			  do (print item)
+			  ) )
+ "
+1 
+2 
+3 ")
+
+(my-assert
+ (loop for i below 5
+   for j = 10 then i
+   collect j
+   )
+ (10 1 2 3 4))
+
+(my-assert
+ (loop for i below 5
+   for j = i
+   collect j
+   )
+ (0 1 2 3 4))
+
+(my-assert
+ (loop for item = 1 then (+ item 10)
+   repeat 5
+   collect item
+   )
+ (1 11 21 31 41))
+
+(my-assert
+ (loop for char across (the simple-string "Hello")
+   collect char
+   )
+ (#\H #\e #\l #\l #\o))
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop repeat 3
+			  do (write-line "What I say three times is true")
+			  ) )
+ "What I say three times is true
+What I say three times is true
+What I say three times is true
+")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop repeat -15
+			  do (write-line "What you see is what you expect")
+			  ) )
+ "")
+
+#|;; FOR clauses should come before WHILE clauses
+(let ((stack '(a b c d e f)))
+  (loop while stack
+    for item = (length stack) then (pop stack)
+    collect item
+    ) )
+(6 A B C D E F)
+|#
+
+(my-assert
+ (loop for i fixnum from 3
+   when (oddp i) collect i
+   while (< i 5)
+   )
+ (3 5))
+
+(my-assert
+ (loop for i from 0 to 10
+   always (< i 11)
+   )
+ T)
+
+(my-assert
+ (loop for i from 0 to 10
+   never (> i 11)
+   )
+ T)
+
+(my-assert
+ (loop for i from 0
+   thereis (when (> i 10) i)
+   )
+ 11)
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for i from 0 to 10
+			  always (< i 9)
+			  finally (print "You won't see this")
+			  ) )
+ "")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop never t
+			  finally (print "You won't see this")
+			  ) )
+ "")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop thereis "Here is my value"
+			  finally (print "You won't see this")
+			  ) )
+ "")
+
+(my-assert
+ (loop thereis "Here is my value"
+   finally (print "You won't see this")
+   )
+ "Here is my value")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for i from 1 to 10
+			  thereis (> i 11)
+			  finally (print i)
+			  ) )
+ "
+11 ")
+
+(my-assert
+ (let (everest chocorua sahara)
+   (defstruct mountain  height difficulty (why "because it is there"))
+   (setq everest (make-mountain :height '(2.86e-13 parsecs)))
+   (setq chocorua (make-mountain :height '(1059180001 microns)))
+   (defstruct desert  area (humidity 0))
+   (setq sahara (make-desert :area '(212480000 square furlongs)))
+   (loop for x in (list everest sahara chocorua)
+     thereis (and (mountain-p x) (mountain-height x))
+     ) )
+ (2.86e-13 parsecs))
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for (month date-list) in '((january (24 28)) (february (17 29 12)))
+			  do (loop for date in date-list
+			       do (case date
+				    (29 (when (eq month 'february) (loop-finish)))
+				    )
+			       do (format t "~:(~A~) ~A~%" month date)
+			       ) )        )
+ "January 24
+January 28
+February 17
+")
+
+(my-assert
+ (loop for i in '(1 2 3 stop-here 4 5 6)
+   when (symbolp i) do (loop-finish)
+   count i
+   )
+ 3)
+
+(my-assert
+ (loop for i in '(1 2 3 stop-here 4 5 6)
+   until (symbolp i)
+   count i
+   )
+ 3)
+
+(my-assert
+ (loop for name in '(fred sue alice joe june)
+   for kids in '((bob ken) () () (kris sunshine) ())
+   collect name
+   append kids
+   )
+ (FRED BOB KEN SUE ALICE JOE KRIS SUNSHINE JUNE))
+
+(my-assert
+ (multiple-value-list
+  (loop for name in '(fred sue alice joe june)
+    as age in '(22 26 19 20 10)
+    append (list name age) into name-and-age-list
+    count name into name-count
+    sum age into total-age
+    finally
+    (return (values (round total-age name-count) name-and-age-list))
+    ) )
+ (19 (FRED 22 SUE 26 ALICE 19 JOE 20 JUNE 10)))
+
+(my-assert
+ (loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
+   when (symbolp i) collect i
+   )
+ (BIRD TURTLE HORSE CAT))
+
+(my-assert
+ (loop for i from 1 to 10
+   if (oddp i) collect i
+   )
+ (1 3 5 7 9))
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for i in '(a b c d) by #'cddr
+			  collect i into my-list
+			  finally (print my-list)
+			  ) )
+ "
+(A C) ")
+
+(my-assert
+ (loop for x in '((a) (b) ((c)))
+   append x
+   )
+ (A B (C)))
+
+(my-assert
+ (loop for i upfrom 0
+   as x in '(a b (c))
+   nconc (if (evenp i) (list x) '())
+   )
+ (A (C)))
+
+(my-assert
+ (loop for i in '(a b nil c nil d e)
+   count i
+   )
+ 5)
+
+(my-assert
+ (loop for i fixnum in '(1 2 3 4 5)
+   sum i
+   )
+ 15)
+
+(my-assert
+ (let ((series '(1.2 4.3 5.7)))
+   (loop for v in series
+     sum (* 2.0 v)
+     ) )
+ 22.4)
+
+(my-assert
+ (loop for i in '(2 1 5 3 4)
+   maximize i
+   )
+ 5)
+
+(my-assert
+ (loop for i in '(2 1 5 3 4)
+   minimize i
+   )
+ 1)
+
+(my-assert
+ (let ((series '(1.2 4.3 5.7)))
+   (loop for v in series
+     maximize (round v) fixnum
+     ) )
+ 6)
+
+(my-assert
+ (let ((series '(1.2 4.3 5.7)))
+   (loop for v in series
+     minimize (round v) into result fixnum
+     finally (return result)
+     ) )
+ 1)
+
+(my-assert
+ (loop with a = 1
+   with b = (+ a 2)
+   with c = (+ b 3)
+   with d = (+ c 4)
+   return (list a b c d)
+   )
+ (1 3 6 10))
+
+(my-assert
+ (loop with a = 1
+   and b = 2
+   and c = 3
+   and d = 4
+   return (list a b c d)
+   )
+ (1 2 3 4))
+
+(my-assert
+ (let ((a 5) (b 10) (c 1729))
+   (loop with a = 1
+     and b = (+ a 2)
+     and c = (+ b 3)
+     and d = (+ c 4)
+     return (list a b c d)
+     ) )
+ (1 7 13 1733))
+
+(my-assert
+ (loop with (a b c) (float integer float)
+   return (format nil "~A ~A ~A" a b c)
+   )
+ "0.0 0 0.0")
+
+(my-assert
+ (loop with (a b c) float
+   return (format nil "~A ~A ~A" a b c)
+   )
+ "0.0 0.0 0.0")
+
+(my-assert
+ (let ((numbers-list '(3 2 4 6 1 7 8)) (results nil))
+   (cons
+    (with-output-to-string (*standard-output*)
+			   (loop for i in numbers-list
+			     when (oddp i)
+			     do (print i)
+			     and collect i into odd-numbers
+			     and do (terpri)
+			     else
+			     collect i into even-numbers
+			     finally (setq results (list odd-numbers even-numbers))
+			     ) )
+    results
+    ) )
+ ("
+3 
+
+1 
+
+7 
+"
+  (3 1 7) (2 4 6 8)))
+
+(my-assert
+ (loop for i in '(1 2 3 4 5 6)
+   when (and (> i 3) i)
+   collect it
+   )
+ (4 5 6))
+
+(my-assert
+ (loop for i in '(1 2 3 4 5 6)
+   when (and (> i 3) i)
+   return it
+   )
+ 4)
+
+(my-assert
+ (loop for i in '(1 2 3 4 5 6)
+   thereis (and (> i 3) i)
+   )
+ 4)
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for x from 0 to 3
+			  do (print x)
+			  if (zerop (mod x 2))
+			  do (write-string " a")
+			  and
+			  if (zerop (floor x 2))
+			  do (write-string " b")
+			  and
+			  do (write-string " c")
+			  ) )
+ "
+0  a b c
+1 
+2  a
+3 ")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for x from 0 to 3
+			  do (print x)
+			  if (zerop (mod x 2))
+			  do (write-string " a")
+			  and
+			  if (zerop (floor x 2))
+			  do (write-string " b")
+			  end
+			  and
+			  do (write-string " c")
+			  ) )
+ "
+0  a b c
+1 
+2  a c
+3 ")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for i from 1 to 5
+			  do (print i)
+			  ) )
+ "
+1 
+2 
+3 
+4 
+5 ")
+
+(my-assert
+ (with-output-to-string (*standard-output*)
+			(loop for i from 1 to 4
+			  do (print i)
+			  (print (* i i))
+			  ) )
+ "
+1 
+1 
+2 
+4 
+3 
+9 
+4 
+16 ")
+
+(my-assert
+ (loop for item in '(1 2 3 a 4 5)
+   when (not (numberp item))
+   return (format nil "non-numeric value: ~S" item)
+   )
+ "non-numeric value: A")
+
+(my-assert
+ (loop for item in '(1 2 3 a 4 5)
+   when (not (numberp item))
+   do (return (format nil "non-numeric value: ~S" item))
+   )
+ "non-numeric value: A")
+
+(my-assert
+ (loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+   for a integer = (first numlist)
+   for b integer = (second numlist)
+   for c float = (third numlist)
+   collect (list c b a)
+   )
+ ((4.0 2 1) (8.3 6 5) (10.4 9 8)))
+
+;; According to the BNF syntax, "and" must not be followed by "for". But
+;; ANSI CL section 6.1.1.5.1 contains ambiguous wording, and this example
+;; appears in CLtL2 p. 743, we keep it.
+(my-assert
+ (loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+   for a integer = (first numlist)
+   and for b integer = (second numlist)
+   and for c float = (third numlist)
+   collect (list c b a)
+   )
+ #-(OR CMU SBCL) ((4.0 2 1) (8.3 6 5) (10.4 9 8))
+ #+(OR CMU SBCL) ERROR)
+
+(my-assert
+ (loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+   for a integer = (first numlist)
+   and b integer = (second numlist)
+   and c float = (third numlist)
+   collect (list c b a)
+   )
+ ((4.0 2 1) (8.3 6 5) (10.4 9 8)))
+
+(my-assert
+ (loop for (a b c) (integer integer float) in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+   collect (list c b a)
+   )
+ ((4.0 2 1) (8.3 6 5) (10.4 9 8)))
+
+(my-assert
+ (loop for (a b c) float in '((1.0 2.0 4.0) (5.0 6.0 8.3) (8.0 9.0 10.4))
+   collect (list c b a)
+   )
+ ((4.0 2.0 1.0) (8.3 6.0 5.0) (10.4 9.0 8.0)))
+
+(my-assert
+ (loop with (a b) float = '(1.0 2.0)
+   and (c d) integer = '(3 4)
+   and (e f)
+   return (list a b c d e f)
+   )
+ (1.0 2.0 3 4 NIL NIL))
+
+(my-assert
+ (loop for (a nil b) = '(1 2 3)
+   do (return (list a b))
+   )
+ (1 3))
+
+(my-assert
+ (loop for (x . y) = '(1 . 2)
+   do (return y)
+   )
+ 2)
+
+(my-assert
+ (loop for ((a . b) (c . d)) of-type ((float . float) (integer . integer))
+   in '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6)))
+   collect (list a b c d)
+   )
+ ((1.2 2.4 3 4) (3.4 4.6 5 6)))
+
+(my-assert
+ (loop for buffer in '("\"Hello\"" "\"unterminated" "nothing")
+   collect
+   (loop initially (unless (char= (char buffer 0) #\") (loop-finish))
+     for i fixnum from 1 below (length buffer)
+     when (char= (char buffer i) #\")
+     return i
+     )       )
+ (6 NIL NIL))
+
+(my-assert
+ (let (result)
+   (list
+    (with-output-to-string (*standard-output*)
+			   (setq result
+				 (loop for i from 1 to 10
+				   when (> i 5)
+				   collect i
+				   finally (print i)
+				   ) ) )
+    result
+    ) )
+ ("
+11 " (6 7 8 9 10)))
+
+(my-assert
+ (multiple-value-list
+  (loop for i from 1 to 10
+    when (> i 5)
+    collect i into number-list
+    and count i into number-count
+    finally (return (values number-count number-list))
+    ) )
+ (5 (6 7 8 9 10)))
+
+(my-assert
+ (let (result)
+   (list
+    (with-output-to-string (*standard-output*)
+			   (setq result
+				 (loop named max
+				   for i from 1 to 10
+				   do (print i)
+				   do (return-from max 'done)
+				   ) ) )
+    result
+    ) )
+ ("
+1 " DONE))
+
+;;; The following tests are not mandatory according to dpANS or ANSI CL,
+;;; but that's how users expect the LOOP macro to work, so we check them.
+
+(my-assert
+ (loop for i = 0
+   for j to 2
+   collect j
+   )
+ (0 1 2))
+
+(my-assert
+ (loop for i in '(1 2)
+   for j = i
+   for k = j
+   collect (list i j k)
+   )
+ ((1 1 1) (2 2 2)))
+
+(my-assert
+ (loop for idx upfrom 0 below 5
+   for char = (aref "Error" idx)
+   collect char
+   )
+ (#\E #\r #\r #\o #\r))
+
+(my-assert
+ (let ((hash-table (make-hash-table)))
+   (setf (gethash 1 hash-table) 100)
+   (setf (gethash 2 hash-table) 200)
+   (sort
+    (loop for key being each hash-key in hash-table using (hash-value val)
+      for key+1 = (1+ key)
+      collect (list key key+1 val))
+    #'<
+    :key #'car
+    ) )
+ ((1 2 100) (2 3 200)))
+
+(my-assert
+ (loop for i across '#(1 2 3 4)
+   for j = (1+ i)
+   collect (list i j)
+   )
+ ((1 2) (2 3) (3 4) (4 5)))
+
+(my-assert
+ (loop for i in '()
+   for j = (1+ i)
+   collect j
+   )
+ nil)
+
+(my-assert
+ (loop for i across '#()
+   for j = (1+ i)
+   collect j
+   )
+ nil)
+
+(my-assert
+ (loop for x = t
+   for y in '(A B C)
+   for z = t
+   collect y
+   )
+ (A B C))
+
+(my-assert
+ (loop for x = t
+   for y across '#(A B C)
+   for z = t
+   collect y
+   )
+ (A B C))
+
+(my-assert
+ (loop for x = t
+   for y in ()
+   for z = t
+   collect y
+   )
+ nil)
+
+(my-assert
+ (loop for x = t
+   for y across '#()
+   for z = t
+   collect y
+   )
+ nil)
+
+(my-assert
+ (let ((hash-table (make-hash-table)))
+   (setf (gethash 1 hash-table) 100)
+   (setf (gethash 2 hash-table) 200)
+   (sort
+    (loop for x = t
+      for key being each hash-key in hash-table using (hash-value val)
+      for key+1 = (1+ key)
+      for z = t
+      collect (list key key+1 val))
+    #'<
+    :key #'car
+    ) )
+ ((1 2 100) (2 3 200)))
+
+(my-assert
+ (loop for i from 1 to 0
+   collect i
+   )
+ nil)
+
+(my-assert
+ (let ((hash-table (make-hash-table)))
+   (setf (gethash 1 hash-table) 100)
+   (setf (gethash 2 hash-table) 200)
+   (sort
+    (loop for val being each hash-value in hash-table
+      collect val)
+    #'<
+    ) )
+ (100 200))
+
+(my-assert
+ (let ((hash-table (make-hash-table)))
+   (setf (gethash 1 hash-table) 100)
+   (setf (gethash 2 hash-table) 200)
+   (sort
+    (loop for val being each hash-value in hash-table
+      for deriv-val = (/ 1 val)
+      collect deriv-val)
+    #'<
+    ) )
+ (1/200 1/100))
+
+(my-assert
+ (let ((hash-table (make-hash-table)))
+   (setq i 123456789)
+   (setf (gethash 1 hash-table) 100)
+   (setf (gethash 2 hash-table) 200)
+   (loop for i across '#(1 2 3 4 5 6)
+     collect i)
+   (loop for i in '(1 2 3 4 5 6)
+     collect i)
+   (loop for i being each hash-key of hash-table
+     collect i)
+   (loop for i being each present-symbol of *package*
+     collect i)
+   i
+   )
+ 123456789)
+
+(my-assert
+ (loop for x on '(3 4 5)
+   for y = (car x)
+   for z in '(a b c)
+   collect z
+   )
+ (a b c))
+
+(my-assert
+ (loop for x across '#(3 4 5)
+   for y = (1+ x)
+   for z across '#(a b c)
+   collect (list x y z)
+   )
+ ((3 4 a) (4 5 b) (5 6 c)))
+
+(my-assert
+ (loop for x across '#()
+   for y = x
+   for z across '#(a b c)
+   collect (list x y z)
+   )
+ nil)
+
+(my-assert
+ (loop for x across '#(1 2 3)
+   for y = x
+   for z across '#()
+   collect (list x y z)
+   )
+ nil)
+
+(my-assert
+ (loop for x across '#(1 2 3)
+   for y = (1+ x)
+   for z across '#(a b)
+   collect (list x y z)
+   )
+ ((1 2 a) (2 3 b)))
+
+(my-assert
+ (loop for x across '#(1 2)
+   for y = (1+ x)
+   for z across '#(a b c)
+   collect (list x y z)
+   )
+ ((1 2 a) (2 3 b)))
+
+(my-assert
+ (let ((package (make-package "LOOP-TEST")))
+   (intern "blah" package)
+   (let ((blah2 (intern "blah2" package)))
+     (export blah2 package)
+     )
+   (list
+    (sort
+     (loop for sym being each present-symbol of package
+       for sym-name = (symbol-name sym)
+       collect sym-name
+       )
+     #'string<
+     )
+    (sort
+     (loop for sym being each external-symbol of package
+       for sym-name = (symbol-name sym)
+       collect sym-name
+       )
+     #'string<
+     ) ) )
+ (("blah" "blah2") ("blah2")))
+
+(my-assert
+ (let ((ht (make-hash-table)))
+   (loop for key being each hash-key of ht
+     for value = (gethash key ht)
+     collect (list key value)
+     ) )
+ nil)
+
+(my-assert
+ (let ((ht (make-hash-table)))
+   (loop for dummy = (+ 1 2)
+     for key being each hash-key of ht
+     collect (list key)
+     ) )
+ nil)
+
+;;; Three more tests, found by Russell Senior.
+;;; They are justified by ANSI CL 6.1.1.4 and 6.1.2.1.5.
+
+(my-assert
+ (let ((list '(1 2 3)))
+   (loop for x in list
+     and y = nil then x
+     collect (list x y)))
+ ((1 NIL) (2 1) (3 2)))
+
+(my-assert
+ (let ((list '(1 2 3)))
+   (loop for x in list
+     for y = nil then x
+     collect (list x y)))
+ ((1 NIL) (2 2) (3 3)))
+
+(my-assert
+ (let ((list '(1 2 3)))
+   (loop for x in list
+     for y = nil then x
+     and z = nil then y
+     collect (list x y z)))
+ ((1 NIL NIL) (2 2 NIL) (3 3 2)))
+
+;;; One more test, found by Lennart Staflin.
+
+(my-assert
+ (loop repeat 4 for x = (+ 1 1) collect x)
+ (2 2 2 2))
+
+;;; Tests from ANSI CL section 6.1.2.1.1.
+
+(my-assert
+ (let ((x 1)) (loop for i from x by (incf x) to 10 collect i))
+ (1 3 5 7 9))
+
+(my-assert
+ (let ((x 1)) (loop for i by (incf x) from x to 10 collect i))
+ (2 4 6 8 10)
+ "This should be the same as:
+(let ((x 1)) (loop for i from x to 10 by (incf x)  collect i))
+it is legal to have by first:
+arithmetic-up::= [[{from | upfrom} form1 |   {to | upto | below} form2 |   by form3]]+ ")
+
+(my-assert
+ (loop for i from 1 to 5 collect i into c collect (copy-list c))
+ ((1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5)))
+
+;; Clean up.
+(my-assert
+ (progn (delete-package "LOOP-TEST") t)
+ T)
+
diff --git a/src/ansi-tests/macro8.lisp b/src/ansi-tests/macro8.lisp
new file mode 100644
index 000000000..d3b3099e5
--- /dev/null
+++ b/src/ansi-tests/macro8.lisp
@@ -0,0 +1,141 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+;; testen der macrofunktionen kapitel 8
+;; ------------------------------------
+
+
+;; 8.1
+;; macro-function | defmacro
+
+
+(my-assert
+ (and (macro-function 'push) T)
+ T)
+
+(my-assert
+ (and (macro-function 'member) T)
+ NIL)
+
+(my-assert
+ (defmacro arithmetic-if (test neg-form zero-form pos-form)
+   (let ((var (gensym)))
+     `(let ((,var ,test))
+	(cond ((< ,var 0) ,neg-form)
+	      ((= ,var 0) ,zero-form)
+	      (T ,pos-form)))))
+ arithmetic-if)
+
+
+(my-assert
+ (and (macro-function 'arithmetic-if) T)
+ T)
+
+(my-assert
+ (setf x 8)
+ 8)
+
+(my-assert
+ (arithmetic-if (- x 4)(- x)(LIST "ZERO") x)
+ 8)
+
+
+(my-assert
+ (setf x 4)
+ 4)
+
+(my-assert
+ (arithmetic-if (- x 4)(- x)(LIST "ZERO")x)
+ ("ZERO"))
+
+
+(my-assert
+ (setf x 3)
+ 3)
+
+(my-assert
+ (arithmetic-if (- x 4)(- x)(LIST "ZERO")x)
+ -3)
+
+
+
+(my-assert
+ (defmacro arithmetic-if (test neg-form &optional zero-form pos-form)
+   (let ((var (gensym)))
+     `(let ((,var ,test))
+	(cond ((< ,var 0) ,neg-form)
+	      ((= ,var 0) ,zero-form)
+	      (T ,pos-form)))))
+ arithmetic-if)
+
+
+(my-assert
+ (setf x 8)
+ 8)
+
+(my-assert
+ (arithmetic-if (- x 4)(- x))
+ nil)
+
+
+(my-assert
+ (setf x 4)
+ 4)
+
+(my-assert
+ (arithmetic-if (- x 4)(- x))
+ NIL)
+
+
+(my-assert
+ (setf x 3)
+ 3)
+
+(my-assert
+ (arithmetic-if (- x 4)(- x))
+ -3)
+
+(my-assert
+ (defmacro halibut ((mouth eye1 eye2)
+		    ((fin1 length1)(fin2 length2))
+		    tail)
+   `(list ,mouth ,eye1 ,eye2 ,fin1 ,length1 ,fin2 ,length2 ,tail))
+ halibut)
+
+(my-assert
+ (setf m 'red-mouth
+       eyes '(left-eye . right-eye)
+       f1 '(1 2 3 4 5)
+       f2 '(6 7 8 9 0)
+       my-favorite-tail '(list of all parts of tail))
+ (list of all parts of tail))
+
+
+
+(my-assert
+ (halibut (m (car eyes)(cdr eyes))
+	  ((f1 (length f1))(f2 (length f2)))
+	  my-favorite-tail)
+ (RED-MOUTH LEFT-EYE RIGHT-EYE (1 2 3 4 5) 5 (6 7 8 9 0) 5
+	    (LIST OF ALL PARTS OF TAIL)))
+
+;; 8.2
+;;  macroexpand | macroexpand-1
+
+
+(my-assert
+ (ecase 'otherwise
+   (otherwise 4))
+ 4
+ "This is bad style, but perfectly legal!!")
+
+;; Issue MACRO-FUNCTION-ENVIRONMENT:YES
+(my-assert
+ (macrolet ((foo (&environment env)
+		 (if (macro-function 'bar env)
+		     ''yes
+		     ''no)))
+   (list (foo)
+         (macrolet ((bar () :beep))
+	   (foo))))
+ (no yes))
diff --git a/src/ansi-tests/map.lisp b/src/ansi-tests/map.lisp
new file mode 100644
index 000000000..274439f56
--- /dev/null
+++ b/src/ansi-tests/map.lisp
@@ -0,0 +1,294 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (setf a-vector (make-array 10))
+ #+(or XCL cmu sbcl) #(0 0 0 0 0 0 0 0 0 0)
+ #+(or CLISP AKCL ALLEGRO ecls) #(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
+ #-(or XCL CLISP AKCL ALLEGRO cmu sbcl ecls) UNKNOWN)
+
+(my-assert
+ (do ((i 0 (1+ i))
+      (n (length a-vector)))
+     ((= i n))
+   (when (null (aref a-vector i))
+     (setf (aref a-vector i) 0)))
+ nil)
+
+(my-assert
+ (setq liste '(a b c d))
+ (a b c d))
+
+(my-assert
+ (setq x 'anfangswert-von-x)
+ anfangswert-von-x)
+
+(my-assert
+ (do ((x liste (cdr x))
+      (oldx x x))
+     ((null x))
+   (print oldx) (print x))
+ nil)
+
+(my-assert
+ (defun list-reverse(list)
+   (do ((x list (cdr x))
+	(y '() (cons (car x) y)))
+       ((endp x) y)))
+ list-reverse)
+
+(my-assert
+ (list-reverse '(a b c d))
+ (d c b a))
+
+(my-assert
+ (setq foo '(a b c d))
+ (a b c d))
+
+(my-assert
+ (setq bar '(1 2 3 4))
+ (1 2 3 4))
+
+(my-assert
+ (defun fkt(a b) (cons a b))
+ fkt)
+
+;; mapcar
+
+(my-assert
+ (mapcar #'abs '(3 -4 2 -5 -6))
+ (3 4 2 5 6))
+
+(my-assert
+ (mapcar #'cons '(a b c) '(1 2 3))
+ ((a . 1) (b . 2) (c . 3)))
+
+
+(my-assert
+ (mapcar #'fkt foo bar)
+ ((a . 1)(b . 2)(c . 3)(d . 4)))
+
+(my-assert
+ (do ((x foo (cdr x))
+      (y bar (cdr y))
+      (z '() (cons (fkt (car x) (car y)) z)))
+     ((or (null x) (null y))
+      (nreverse z)))
+ ((a . 1)(b . 2)(c . 3)(d . 4)))
+
+;; dolist
+(my-assert
+ (let    ((l '(1 2 3))
+	  (r 0))
+   (dolist (x l r)
+     (setf r (+ r  x)) ))
+ 6)
+
+
+;; dolist
+(my-assert
+ (let ((l '(1 2 3)))
+   (dolist (x l)(if (> 0 x)(incf x)(return 10))))
+ 10)
+
+(my-assert
+ (let ((l '(1 2 3)))
+   (dolist (x l )(incf x)))
+ nil)
+
+;; dotimes
+
+(my-assert
+ (let ((s 0))
+   (dotimes (i (+ 1 9)s)(setf s (+ s i))))
+ 45)
+
+
+(my-assert
+ (dolist (x '(a b c d)) (prin1 x) (princ " "))
+ nil)
+
+(my-assert
+ (defun palindromep (string &optional
+			    (start 0)
+			    (end (length string)))
+   (dotimes (k (floor (- end start) 2) t)
+     (unless (char-equal (char string (+ start k))
+			 (char string (- end k 1)))
+       (return nil))))
+ palindromep)
+
+(my-assert
+ (palindromep "Able was I ere I saw Elba")
+ t)
+
+(my-assert
+ (palindromep "einnegermitgazellezagtimregennie")
+ t)
+
+(my-assert
+ (palindromep "eisgekuehlter bommerlunder")
+ nil)
+
+(my-assert
+ (palindromep (remove-if-not #'alpha-char-p
+			     "A man, a plan, a canal -- Panama"))
+ t)
+
+(my-assert
+ (MAPCAR (FUNCTION (LAMBDA (X) (LIST X))) (QUOTE (A B C)))
+ ((A) (B) (C)))
+
+(my-assert
+ (MAPCAR (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+							       (1 2 3)))
+ ((A 1) (B 2) (C 3)))
+
+(my-assert
+ (MAPCAR (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+							       (1 2)))
+ ((A 1) (B 2)))
+
+(my-assert
+ (MAPCAR (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (C)) (QUOTE (1
+								  2)))
+ ((C 1)))
+
+(my-assert
+ (MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y))) (QUOTE (C)) (QUOTE (1
+								    2)) (U V W))
+ ERROR)
+
+(my-assert
+ (MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y))) (QUOTE (C)) (QUOTE (1
+								    2))
+	 (QUOTE (U V W)))
+ ((C 1)))
+
+(my-assert
+ (MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+								 (1 2 3))
+	 (QUOTE (U V W)))
+ ((A 1) (B 2) (C 3)))
+
+(my-assert
+ (MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+								   (1 2 3))
+	 (QUOTE (U V W)))
+ ((A 1 U) (B 2 V) (C 3 W)))
+
+;; mapc
+(my-assert
+ (mapc #'abs '(3 -4 2 -5 -6))
+ (3 -4 2 -5 -6))
+
+(my-assert
+ (MAPC (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+								 (1 2 3))
+       (QUOTE (U I V)))
+ (A B C))
+
+(my-assert
+ (MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+								   (1 2 3))
+	 (QUOTE (U I V)))
+ ((A 1 U) (B 2 I) (C 3 V)))
+
+(my-assert
+ (mapl #'(lambda (x y)(cons x y))'(a b c d)'(1 2 3 4))
+ (a b c d))
+
+(my-assert
+ (MAPL (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+								 (1 2 3))
+       (QUOTE (U I V)))
+ (A B C))
+
+;; maplist
+
+(my-assert
+ (maplist #'(lambda (x)(cons 'foo x))'(a b c d))
+ ((foo a b c d)(foo b c d)(foo c d)(foo d)))
+
+
+(my-assert
+ (maplist #'(lambda (x) (if (member (car x)(cdr x)) 0 1))
+	  '(a b a c d b c))
+ (0 0 1 0 1 1 1))
+
+
+(my-assert
+ (MAPLIST (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C))
+	  (QUOTE (1 2 3)) (QUOTE (U I V)))
+ (((A B C) (1 2 3) (U I V)) ((B C) (2 3) (I V)) ((C) (3) (V))))
+
+(my-assert
+ (MAPLIST (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C))
+	  (QUOTE (1 2 3)) (QUOTE (U I)))
+ (((A B C) (1 2 3) (U I)) ((B C) (2 3) (I))))
+
+(my-assert
+ (MAPLIST (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+								    (1 2))
+	  (QUOTE (U I V)))
+ (((A B C) (1 2) (U I V)) ((B C) (2) (I V))))
+
+(my-assert
+ (MAPLIST (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B)) (QUOTE
+								  (1 2 3))
+	  (QUOTE (U I V)))
+ (((A B) (1 2 3) (U I V)) ((B) (2 3) (I V))))
+
+;; mapcon
+
+(my-assert
+ (mapcon #'(lambda (x)(and (oddp (car x))(list (car x))))'(5 4 3 2 1))
+ (5 3 1))
+
+
+(my-assert
+ (MAPCON (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B)) (QUOTE
+								 (1 2 3))
+	 (QUOTE (U I V)))
+ ((A B) (1 2 3) (U I V) (B) (2 3) (I V)))
+
+(my-assert
+ (MAPCON (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+								   (1 2 3))
+	 (QUOTE (U I V)))
+ ((A B C) (1 2 3) (U I V) (B C) (2 3) (I V) (C) (3) (V)))
+
+;; mapcan
+
+(my-assert
+ (mapcan #'(lambda (x)(and (numberp x)(list x)))'(a 1 b c 3 4 d 5))
+ (1 3 4 5))
+
+(my-assert
+ (MAPCAN (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+								   (1 2 3))
+	 (QUOTE (U I V)))
+ (A 1 U B 2 I C 3 V))
+
+(my-assert
+ (MAPCAN (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+							       (1 2 3)))
+ (A 1 B 2 C 3))
+
+(my-assert
+ (MAPCAN (FUNCTION (LAMBDA (X) (LIST X))) (QUOTE (A B C)))
+ (A B C))
+
+(my-assert
+ (MAPCON (FUNCTION (LAMBDA (X) (LIST X))) (QUOTE (A B C)))
+ ((A B C) (B C) (C)))
+
+(my-assert
+ (MAPCON (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+							       (1 2)))
+ ((A B C) (1 2) (B C) (2)))
+
+(my-assert
+ (MAPCON (FUNCTION (LAMBDA (X) (LIST X))) (QUOTE (A B C)))
+ ((A B C) (B C) (C)))
+
diff --git a/src/ansi-tests/mop.lisp b/src/ansi-tests/mop.lisp
new file mode 100644
index 000000000..5fe33ef7d
--- /dev/null
+++ b/src/ansi-tests/mop.lisp
@@ -0,0 +1,34 @@
+;;; based on v1.1.1.1 -*- mode: lisp -*-
+(in-package :cl-user)
+;; Test some MOP-like CLOS features
+
+#+clisp
+(my-assert
+ (progn
+   (defstruct rectangle1 (x 0.0) (y 0.0))
+   (defclass counted1-class (structure-class)
+     ((counter :initform 0)) #+CLISP (:metaclass structure-class))
+   (defclass counted1-rectangle (rectangle1) () (:metaclass counted1-class))
+   (defmethod make-instance :after ((c counted1-class) &rest args)
+     (incf (slot-value c 'counter)))
+   (slot-value (find-class 'counted1-rectangle) 'counter)
+   (make-instance 'counted1-rectangle)
+   (slot-value (find-class 'counted1-rectangle) 'counter)
+   )
+ 1)
+
+#+clisp
+(my-assert
+ (progn
+   (defclass rectangle2 ()
+     ((x :initform 0.0 :initarg x) (y :initform 0.0 :initarg y)))
+   (defclass counted2-class (standard-class)
+     ((counter :initform 0)) #+CLISP (:metaclass structure-class))
+   (defclass counted2-rectangle (rectangle2) () (:metaclass counted2-class))
+   (defmethod make-instance :after ((c counted2-class) &rest args)
+     (incf (slot-value c 'counter)))
+   (slot-value (find-class 'counted2-rectangle) 'counter)
+   (make-instance 'counted2-rectangle)
+   (slot-value (find-class 'counted2-rectangle) 'counter)
+   )
+ 1)
diff --git a/src/ansi-tests/new-bugs.lisp b/src/ansi-tests/new-bugs.lisp
new file mode 100644
index 000000000..210ed03f1
--- /dev/null
+++ b/src/ansi-tests/new-bugs.lisp
@@ -0,0 +1,37 @@
+;;;  -*- mode: lisp -*-
+(proclaim '(special log))
+(in-package :cl-user)
+
+
+;; From: Gary Bunting <gbunting@cantor.une.edu.au>
+
+(my-assert
+ (setf xx (expt 3 32))
+ 1853020188851841)
+
+(my-assert
+ (* xx xx)
+ 3433683820292512484657849089281)
+
+;; paul
+
+(my-assert
+ (defun bugged (x)
+   (labels ((f (y &optional trouble)	;  <<< or &key or &rest ..
+	       (if y
+		   (let ((a (pop y)))
+		     (f a)))))))
+ BUGGED)
+
+(my-assert
+ (defun tst ()
+   (labels
+       ((eff (&key trouble)
+	     (eff)
+	     ))
+     ;;(eff :trouble nil)  ;<< this works
+     (eff);; << this causes assert failure
+     ))
+ tst)
+
+
diff --git a/src/ansi-tests/number.lisp b/src/ansi-tests/number.lisp
new file mode 100644
index 000000000..df3404291
--- /dev/null
+++ b/src/ansi-tests/number.lisp
@@ -0,0 +1,14696 @@
+;;; based on v1.1.1.1 -*- mode: lisp -*-
+(in-package :cl-user)
+
+;;; Michael Stoll  23. 3. 1993
+
+;; ==== B I G N U M S ====
+
+;;  ---- Test von + ---
+
+(my-assert
+ (+ 17009115185923538769 -12047631083067675031)
+ 4961484102855863738)
+
+(my-assert
+ (+ 12677011568664239747 3269056182420253574)
+ 15946067751084493321)
+
+(my-assert
+ (+ 9315504781982082433 13857624532376678678)
+ 23173129314358761111)
+
+(my-assert
+ (+ 15226508728194069537 11481952022080775416)
+ 26708460750274844953)
+
+(my-assert
+ (+ 7461641943684774743 12249026721402718630)
+ 19710668665087493373)
+
+(my-assert
+ (+ 1180469445886971055 -3208456171287181032)
+ -2027986725400209977)
+
+(my-assert
+ (+ 18358552990465743315 221529797579218180385160273426219343697)
+ 221529797579218180403518826416685087012)
+
+(my-assert
+ (+ -14819874956616484359 30498815629431206969122152847973230849)
+ 30498815629431206954302277891356746490)
+
+(my-assert
+ (+ -11781881800334342169 112219460388643619332860331282276228017)
+ 112219460388643619321078449481941885848)
+
+(my-assert
+ (+ 3570694277032201957 284821691832196381859344006870088122712)
+ 284821691832196381862914701147120324669)
+
+(my-assert
+ (+ -17005463295060938595 69162171850264911722979835561124066203)
+ 69162171850264911705974372266063127608)
+
+(my-assert
+ (+ 15647113311796203488 150750467185419235519670165664526735459)
+ 150750467185419235535317278976322938947)
+
+(my-assert
+ (+ -14330150541101371097 -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886421335353882155416908)
+ -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886435665504423256788005)
+
+(my-assert
+ (+ 7406427184711759740 -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336084100766391093756252)
+ -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336076694339206381996512)
+
+(my-assert
+ (+ 8819522415901031498 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363793325150672647162846)
+ 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363802144673088548194344)
+
+(my-assert
+ (+ -7242932332215698200 -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159009687703010657137320)
+ -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159016930635342872835520)
+
+(my-assert
+ (+ 9794320575955609492 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470325394342993771343357)
+ 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470335188663569726952849)
+
+(my-assert
+ (+ -18404048401680891243 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224482801864925665484770)
+ 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224464397816523984593527)
+
+(my-assert
+ (+ -10763220363947284865 -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521301209899829037444385)
+ -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521311973120192984729250)
+
+(my-assert
+ (+ -12742462236537568498 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747534683311506465130527)
+ 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747521940849269927562029)
+
+(my-assert
+ (+ 9991390529516174614 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538345749595968764873879)
+ 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538355740986498281048493)
+
+(my-assert
+ (+ 831234034418847630 -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606507809487462642341164)
+ -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606506978253428223493534)
+
+(my-assert
+ (+ -6996572501442843347 -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314889561060687692538144)
+ -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314896557633189135381491)
+
+(my-assert
+ (+ -8920936222630165483 -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973494705119572045938607)
+ -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973503626055794676104090)
+
+(my-assert
+ (+ -243510292488206214847646757340020705642 5940577100149745132)
+ -243510292488206214841706180239870960510)
+
+(my-assert
+ (+ 35446324064743728955945058978206455057 -6248622708755929572)
+ 35446324064743728949696436269450525485)
+
+(my-assert
+ (+ -285342226760657637664173494795024413673 -11942737781617905307)
+ -285342226760657637676116232576642318980)
+
+(my-assert
+ (+ 180790435817422032042321866247362452865 12401641959336396832)
+ 180790435817422032054723508206698849697)
+
+(my-assert
+ (+ -179994871947239535956826388240542999950 13573822506399140772)
+ -179994871947239535943252565734143859178)
+
+(my-assert
+ (+ -308198027295905163635866438671452347268 -8790069282378476990)
+ -308198027295905163644656507953830824258)
+
+(my-assert
+ (+ -139324757925833055762410227358605285566 -190622873846936719063564661032771271922)
+ -329947631772769774825974888391376557488)
+
+(my-assert
+ (+ 332866352618304570046318203427223999347 147978646177673305481282943528696833018)
+ 480844998795977875527601146955920832365)
+
+(my-assert
+ (+ -39471620476300923970352914034802271156 28992893610776120142668950821916856486)
+ -10478726865524803827683963212885414670)
+
+(my-assert
+ (+ 274120253734611965146455315763505869288 254675910805265090692978775702306142625)
+ 528796164539877055839434091465812011913)
+
+(my-assert
+ (+ -122086811464559635596206661886176775901 287312583034687582188356355813963609701)
+ 165225771570127946592149693927786833800)
+
+(my-assert
+ (+ 288576174771266329955482943556556984728 -57843540651903655425270706396868707777)
+ 230732634119362674530212237159688276951)
+
+(my-assert
+ (+ -47977736580820486006305788441965482221 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126881113426109906085249657168046936670489)
+ 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126833135689529085599243351379604971188268)
+
+(my-assert
+ (+ 21225484205143479814642328762121362291 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974867770082516862899595554460170417713940)
+ 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974888995566722006379410196788932539076231)
+
+(my-assert
+ (+ -193095363331703875886398909106293703000 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388168068485304437343508442251302846768269976)
+ 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388167875389941105639632555852393740474566976)
+
+(my-assert
+ (+ -14827657635864183514988182371035598180 -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660185258676369175307019300952192657194576)
+ -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660200086334005039490534289134563692792756)
+
+(my-assert
+ (+ 54301423175725658626298504084995819705 -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941312995898184903431893212829646845766101)
+ -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941258694475009177773266914325561849946396)
+
+(my-assert
+ (+ 195114404067053480147948948510253723990 -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176374041758276069255591562198514767063594)
+ -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176178927354209015775443613250004513339604)
+
+(my-assert
+ (+ -308030589512186791277525017840002670741 -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550454815591457829485684936036414823492160)
+ -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550762846180970016276962461054254826162901)
+
+(my-assert
+ (+ -172649878347923210775992373331623646864 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447760919715595005106669653475931803053499)
+ 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447588269837247081895893661102600179406635)
+
+(my-assert
+ (+ 17539006966816771902104329685391462527 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507917720426571969997513984360849930719808)
+ 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507935259433538786769416088690535322182335)
+
+(my-assert
+ (+ 244901855797156286376563377540855746602 -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760396535767621855642720080219960822554492)
+ -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760151633911824699356343516842419966807890)
+
+(my-assert
+ (+ -119403662992279138748600939857239307122 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953732384499190437432898387573320391878853)
+ 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953612980836198158294149786633463152571731)
+
+(my-assert
+ (+ 313963939617834410089002930298454269912 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864354021315490712575535559549015858088608)
+ 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864667985255108546985624562479314312358520)
+
+(my-assert
+ (+ 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160643580198590073658869 -17993015014355471903)
+ 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160625587183575718186966)
+
+(my-assert
+ (+ 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942609010590873980143878 15372278140141207703)
+ 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942624382869014121351581)
+
+(my-assert
+ (+ -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044148223082253439210893 -14793401891248640808)
+ -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044163016484144687851701)
+
+(my-assert
+ (+ 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149274871082481174186606 8699133332160461067)
+ 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149283570215813334647673)
+
+(my-assert
+ (+ -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146471920873844686294838 -13079925952361275418)
+ -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146485000799797047570256)
+
+(my-assert
+ (+ -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311445471793936775767736 -9381557743227419896)
+ -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311454853351680003187632)
+
+(my-assert
+ (+ -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094956858541960962483734293877093635361160 277811698220276334443479876776376776138)
+ -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094679046843740686149290814000317258585022)
+
+(my-assert
+ (+ 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240709059499894818265755197559390728940140016 -118940994129137705779355371753506018694)
+ 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240708940558900689128049418204018975434121322)
+
+(my-assert
+ (+ -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454778025302197744540571159656556971614966757 120224841184491944160266976391113485817)
+ -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454777905077356560048626999389580580501480940)
+
+(my-assert
+ (+ 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237448178553189381274150213236222139873594 106674783386899772113212633712093787897)
+ 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237554853336576281046263425869934233661491)
+
+(my-assert
+ (+ -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448907193562300482925125162731530249763801 192969103435503875767216559494769734726)
+ -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448714224458864979049357946172035480029075)
+
+(my-assert
+ (+ 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994228143957746922511631911996296931168332 -211230038021470285136061932161632203274)
+ 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994016913919725452226495850064135298965058)
+
+(my-assert
+ (+ -2935941510094051560788359387128767361559188973149773593522440619832472030019457317998381634585179453958737810428870232715146002408187749944694186205812791 -1221176156661231926164756142840452419679061324806989304452215660535991083923207702827717652226257158321829748247784282139952864899457896871473184473608543)
+ -4157117666755283486953115529969219781238250297956762897974656280368463113942665020826099286811436612280567558676654514855098867307645646816167370679421334)
+
+(my-assert
+ (+ -1338674579024795395027232680327531457830908239605718353094975139226848400289367913459076082700361212506196070727982446232782659114647371030398516119682505 -1298372177520411182435886041880377054374169787570856408996533471838082317927648953576721017727347029007573543972764860712708420553928791798580799809858729)
+ -2637046756545206577463118722207908512205078027176574762091508611064930718217016867035797100427708241513769614700747306945491079668576162828979315929541234)
+
+(my-assert
+ (+ -2072456075229532951804023218627137969798924912365258263779029006567941400203608770518731715660383378937120213112973528605594220795605977413985543331908189 -9744489461776287963808523409593616918248399004543154581056479712028497082820841423941781438667661074968238703192056877665754560746003512076830245760254982)
+ -11816945537005820915612546628220754888047323916908412844835508718596438483024450194460513154328044453905358916305030406271348781541609489490815789092163171)
+
+(my-assert
+ (+ -2570682164188734368809161664810917340861573482754788446510182252413437925852206735928397938304353826925422441004271229738766803460790995673395984247950088 656920705293329551826685120408221577679101260931105312141757138825917579070505267306626244216341686712802796891966598838285570807961966448181138356047523)
+ -1913761458895404816982476544402695763182472221823683134368425113587520346781701468621771694088012140212619644112304630900481232652829029225214845891902565)
+
+(my-assert
+ (+ 7846359203342053693101523606887617345982401999003795257520576318451663998927274759872692123323796450295314377046602880394071105863527900699633560551732837 3683380639347829102597675045842249667669675715600522157867595962635108482512780509393310714588544837398923613138772339053021025559943198965234376657126821)
+ 11529739842689882795699198652729867013652077714604317415388172281086772481440055269266002837912341287694237990185375219447092131423471099664867937208859658)
+
+(my-assert
+ (+ -11692323148567132684205145901751681947225824260005631214936266006610207543813382900867093989444659986091234552140689684476541703112098935301322850961583953 -8534276689564199122569555420819240948691777228327984555753862457592427992599992931175844172478864477440165366128106812103785256271256853749622592560655914)
+ -20226599838131331806774701322570922895917601488333615770690128464202635536413375832042938161923524463531399918268796496580326959383355789050945443522239867)
+
+(my-assert
+ (+ -10734754884168724884333968138739681643742524619139397687680049322697740991391014196697040576174049452737571835233123127815762146577096625434481167057340772 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797378799103456094203126081464905326203083057134061673694975250599375795827437561275156235513192978645909947341297774926450637694325145427434486258223666250272)
+ 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797368064348571925478241747496766586521439314609442534297287570550053098086446170260959538472616804596457209769462541803322821932178568330809051777056608909500)
+
+(my-assert
+ (+ 1982582032974021971225071139786536402936929744496433027195224299475980201425925452469321205602618940472354066218156609448199804973454183972974358405933935 -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565757325842468006824235119684861972224857533964558963441079998949499582965764591461900562931342373507763081479989957632695010603500633322408246084430203281475)
+ -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565755343260435032802263894613722185688454597034814467008052803725200106985563165536448093610136770888822609125923739476085562403695659868224273110071797347540)
+
+(my-assert
+ (+ 11532228364136654310006206557545352284448588590560137249197311142901246089838098630841794341370689745410654263817911440601934362503092628725755210859171724 -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425483901920822837775032295913486152631638908227467242772081310515646217115760180349854601959031626524004201825198439309850266508687796415478396821644422350208)
+ -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425472369692458701120722289706928607279354459638876682634832113204503315869670342251223760164690255834258791170934621398409664574325293322849671066433563178484)
+
+(my-assert
+ (+ -2603756427337798371354526130541868239006085657393372011847827118826669474695402075575479286172808099892726251004549675772420422527946534088483901153485670 -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463663570751134804664228918188923926951933302878771189484614604311920655871182974081898031051411394311700207305532216445616083858025977851570522763537300875989)
+ -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463666174507562142462600272715054468820172308964428582856626452139039482540657669483973606530697567119800100031783220995291856278448505798104611247438454361659)
+
+(my-assert
+ (+ -5929887196386997518766568868806997104240129372360669348628384183712406620199102166145939206783172815805659513128544493795329100599632286529420772709366102 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250682015641747568282510036326125505522447591703308661608718100933027549520132308555240654655887041040427813131621391320267698106519650611462269033902177180035)
+ 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250676085754551181284991269757256698525343351573936300939369472548843837113512109453074508716680257867612007472108262775773902777419050979175739613129467813933)
+
+(my-assert
+ (+ -8848084327536592532063677611386811805244460767433749071435930786126721080365289638381557872263825830664387392539638767251180242665642373539064690745095464 -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033893238864631158195280554850035949666897861529711006187241710164902350100555999894332438423857208747342184052953230247487231455921360593096823760117493579248)
+ -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033902086948958694787812618527647336478703105990478439936313146095688476821636365183970819981729472573172848440345769886254482636164026235470362824808238674712)
+
+(my-assert
+ (+ -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679396721657020438979754 12553426083939460917)
+ -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679384168230936499518837)
+
+(my-assert
+ (+ 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269660274683400619225321 11620128128044940816)
+ 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269671894811528664166137)
+
+(my-assert
+ (+ -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936248281049628734475702 2380166482232871816)
+ -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936245900883146501603886)
+
+(my-assert
+ (+ -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203373153221004361953729 -10586442965055062759)
+ -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203383739663969417016488)
+
+(my-assert
+ (+ 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642592954601418753021512 -12227722924075527556)
+ 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642580726878494677493956)
+
+(my-assert
+ (+ -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662935026125770444036994 -7349798942312432150)
+ -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662942375924712756469144)
+
+(my-assert
+ (+ 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391843039459733925494003066841874935048611 -66646390577667468207341453008390168215)
+ 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391776393069156258025795725388866544880396)
+
+(my-assert
+ (+ 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506419828208611247177336492131262918439281 -164048419232636429449474429717211197442)
+ 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506255779789378610747887017701545707241839)
+
+(my-assert
+ (+ -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300146993858360430784079225137421074839819 117460076430162201914796277915447781936)
+ -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300029533781930268582164428859505627057883)
+
+(my-assert
+ (+ 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707453499030166286828319347894538505334235 -59175168207571178843658955348404514921)
+ 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707394323861958715649475688939190100819314)
+
+(my-assert
+ (+ 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851829184120171969918537718488250577987049 -151873924489040812813761508259707631973)
+ 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851677310195682929105723956979990870355076)
+
+(my-assert
+ (+ 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821222597665222975816418433744748143385431 -43245950360315656184924888243641533635)
+ 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821179351714862660160233508856504501851796)
+
+(my-assert
+ (+ 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830415574905929299482373462584995162798576853564481617711234957058703455021082855018642616999836886763535412642684228990890160568207941504887072856663966242787 1954009743321912552050341299974626734964446274711484506734354360114801426013796892421541915293157994203607853436799102383078659985249097057923578528366737)
+ 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830417528915672621394925512926295137425311818010756329195741691413063569822508868815535038541752179921529616250537665789992543646867926753984130780242494609524)
+
+(my-assert
+ (+ 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730196110477118156871579503345757821268248575583821695674912517830056856597644827244194658166928026249459511837772775196175188368236573504643083995409774002567 -5513982495816270388232134254127393284677692173792609278582774509636977743203029647121158805174638642867428501907786521939155900331399058909602425073976766)
+ 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730190596494622340601191271211503693874963897891647903065633935055547219619901624214547537008122851610816644409270867409653249212336242105584174392984700025801)
+
+(my-assert
+ (+ -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550976844117943559190671369193871330514473741920389633762695829790016565565261170688485790141638094160105909405353382982945608773290740598479367828342651860878 3451570547959142767282758882796967240086418127970526029661337442068316209707489088420708984628065070358319478649952710478991064476168799556496237099109563)
+ -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550973392547395600047904086434988533547233655502261663236666168452574497249051463199397369432653466095035551085874733030235129782226264429679811332105552751315)
+
+(my-assert
+ (+ 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623397410528064697616617917065021866397277409044449982605591256067763430930720398889239414812509701319783809830072841056369381573100589260104551934136733317845 -9461623592584966196513107657889418526847060851423069480904645009418813160370721071067349946095573698635859409908288864150475056170059858850823883834932131)
+ 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623387948904472112650421403957363976978750561983598559536110351422754012117560028168168347462563605746085173970662932767505231098044419200245701110252898385714)
+
+(my-assert
+ (+ 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787710331228500533067546198458251241005176280410230146430275074766072259256583499095689284871987010372039977403712023630453400259082684930755893684499232318008 12330599952818018622104330691506128012101935028731995985677032980931398338453806827555760801312052792065671886621851470997557806941112316627790755867100463)
+ 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787722661828453351086168302788942747133188382345258878426260751799053190654921952902516840632788322424832043075598645481924397816889626043072521475255099418471)
+
+(my-assert
+ (+ -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027771176714559050403098437684091684851207513969915720607528045624635094984539637789113651579846373399975502788877555747414523231999341294756679330384323996 764238600803843266244444637050072967342049538611688895792923539838804953492110953673720766879606601435939162680753428779068917662740403667549850724878795)
+ -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027006938113755207136853993047041611883865464431304031711735122084796290031047526835439930812966766798539563626196802318635454314336600891089129479659445201)
+
+(my-assert
+ (+ 6243894672855694190803081952962387322599009058758027960092936187687064819462191583137945440936085088260632250436567758576422207449236613172605950116622271404444221039084346501796818945639456207912207604248991842124079786471250102192718092353598850889806607728696519257402580732995770031331187089424192803722612735557735028710899438934171272639518928194764526910590046378401600819132587804143949995694950116915803127294011661411525934100144319021440919928013617766507409909846670172516021888661284467975865076091834094160862228180625536450124272957206172214541444266874056050295270719541605687740822711659847211976891 11877496607682442993105675644902145742318375725225741293060927105303783712520284640625374957608051032540491531573337817824773543104969422017506696018037874641947740606655370938613842356322585858034851150595788166740174872996252792014218946552442572806242471174234462119454014379628228878122072189387777413014452140618318641689597452676091677588204537830401725113931418426919671512011822864583481449136550835952005765386885680701637038206002172218712504732572449659704181315669255320876647592649071711438131711904976335957846353867776093588236311654631696625859173554395714740218099921290128795607292259527492722462071)
+ 18121391280538137183908757597864533064917384783983769253153863292990848531982476223763320398544136120801123782009905576401195750554206035190112646134660146046391961645739717440410661301962042065947058754844780008864254659467502894206937038906041423696049078902930981376856595112623998909453259278811970216737064876176053670400496891610262950227723466025166252024521464805321272331144410668727431444831500952867808892680897342113162972306146491240153424660586067426211591225515925493392669481310356179413996787996810430118708582048401630038360584611837868840400617821269770790513370640831734483348114971187339934438962)
+
+(my-assert
+ (+ -24023960171862805266003610953999097357395283354964456554686635290239019705581779621120391229617494503580661676939681517550103414632840981987397485411400553792707518662609532504246677658012933762605038799352109564432278094548068984563394926376371580465135388578139331334464060067790936072127680597181415407099723844313625277987147283697141407959289588588489162704824409673099509423520008795428217612706997355591985894255450783091681112776112997887084157623388943538145736618168104404283342039105202585543852590302154958791010622670839015475427693311663800177428904406869645066988663292128104453773413982185343111560886 -31939808827732134714870375774276102357277346245583282398423150631754622253109692213928642228787888509211781331649081002266227303203259124984426497846441848502574293640959494009564992092503141598640200823656998243767453860939156780549404892392521391484933772285520949470194562525777116137058001008184603332597820522016200623301007194309404025522056113671560767212894303567191067178003014955596425115379852712737129325098876542459702682095445350281859042779889411325882123213577906096942649941285655935053362468972482748617111598313960198743596285343178242282172686940700127068972627110105953098737923773182254460772630)
+ -55963768999594939980873986728275199714672629600547738953109785921993641958691471835049033458405383012792443008588762519816330717836100106971823983257842402295281812303569026513811669750516075361245239623009107808199731955487225765112799818768892971950069160863660280804658622593568052209185681605366018739697544366329825901288154478006545433481345702260049929917718713240290576601523023751024642728086850068329115219354327325551383794871558348168943200403278354864027859831746010501225991980390858520597215059274637707408122220984799214219023978654842042459601591347569772135961290402234057552511337755367597572333516)
+
+(my-assert
+ (+ 14513652183174940741664411990199277445706189147726874603036586212536012746892966848269748909379750612027025331446918381470766609543142456872580466135425754204680927122749772612276850998180593344389487924747722210296498854143380696064338777945015153982467675141485724865534995199700908286263993697988986805404864429385840512740226775506122190698806967785494289035976495492863456705096841250592980439363856397663738211335801835896091823148249303370609165910779981271035234045185574995335952208702661648744928539539455138167482396767268362221492607154709559716065850417221174683768503217544145599044845325824451589309835 -12814535978730024053359592817368712576084646962861720729844389627130663192435154658607204342320327460695280260731620465435530495952836598646143907272825807563512741964987882356778796849529260646503692618525570185450780889283642116889481314560395290434301143877809550098309214046129802023655714098730144464028249594406616074059558969757405392170810220921023905546104487938441503430332099605473144930508420331873995741851604525954472341693863067199617721032815462094767522339305487934030130207039176659398466616780628644572276059410087128533031562978399689702766028716401176531098447698206272762966470643604141938670152)
+ 1699116204444916688304819172830564869621542184865153873192196585405349554457812189662544567059423151331745070715297916035236113590305858226436558862599946641168185157761890255498054148651332697885795306222152024845717964859738579174857463384619863548166531263676174767225781153571106262608279599258842341376614834979224438680667805748716798527996746864470383489872007554421953274764741645119835508855436065789742469484197309941619481454386236170991444877964519176267711705880087061305822001663484989346461922758826493595206337357181233688461044176309870013299821700819998152670055519337872836078374682220309650639683)
+
+(my-assert
+ (+ 11356479761814008572465147431830778885327227506593483181241437802252618729479905490826767363633131720717461693888023278837835457496021519184903984385091047829540007466025527592005114414671285638168997562037691602144751434208304408870143450743278437854754504713023422097017723330207792526222436928747286558205279330508360438281011315147578105966454344087225699378388309094140949428028313539634103047841948634832398526343605363013644180832752120081735152285507591096001749463421326282317713079361827765412853023201330345752038722069405404812511739634687282327711258974520622248165974215116400638833123609666501349513623 -2451734542868054449539778460457497703609327132304922810342762480808881050209276687756391911546806187586640918078231508181876445466503459873508196878629364924241891220686182517218825181707207808769770392864734466652524094735160185556148554260517746279303022469784592528209667497664672945900929888144529727881050106027775707933311860110618130543481573815538047460723253898548348335762406437618625388229555824532715231231491787570056329865617082709588903922431713098922691537317839185452018617461891748518176708607861270770493263960554805373552348256747200291438630960804647686832667981625018361034564086859426490014044)
+ 8904745218945954122925368971373281181717900374288560370898675321443737679270628803070375452086325533130820775809791770655959012029518059311395787506461682905298116245339345074786289232964077829399227169172957135492227339473144223313994896482760691575451482243238829568808055832543119580321507040602756830324229224480584730347699455036959975422972770271687651917665055195592601092265907102015477659612392810299683295112113575443587850967135037372146248363075877997079057926103487096865694461899936016894676314593469074981545458108850599438959391377940082036272628013715974561333306233491382277798559522807074859499579)
+
+(my-assert
+ (+ -1814184401790217165873937825605141478060935014868566665644215718762341535891730598045990231798382966074312671040257824056876679135909008140059087311700216658095793352051583071432744886316274989901835606602224927350560604355249919901932382803472476702792978322468747380191775778902733911968522382089332819162367884984027854067607561808704316828316820133400099093450636968732151876570835173932998599031643640476109466728761033062776578175554441947411139184426213290292577467587355369954997241091769769542810051228504545831588488726789173405585678190671534386784806998695797717346491308862362775748058331375692317599945 15466182953987394334491149436346080039471412309427279110582769586053943302670765125931570041904640518032832554998553018838321871748542118021556398569294085708441934948186080236498081517178574839977996802813431873543309853609838200338534343580791382510179184571852290959723696010410340740895530535423959476873857191548113125728667781953125153120447892632916574768078583174099545013854248664119997703948998871566374080719541931440495888606776561795893839624084254684939434035018741535261951124673664746010067859317726891535170781460914710499572006592206360512398012457295755926986236618644330364227754380084585899275327)
+ 13651998552197177168617211610740938561410477294558712444938553867291601766779034527885579810106257551958519883958295194781445192612633109881497311257593869050346141596134497165065336630862299850076161196211206946192749249254588280436601960777318905807386206249383543579531920231507606828927008153334626657711489306564085271661060220144420836292131072499516475674627946205367393137283413490186999104917355231090264613990780898377719310431222119848482700439658041394646856567431386165306953883581894976467257808089222345703582292734125537093986328401534826125613205458599958209639745309781967588479696048708893581675382)
+
+(my-assert
+ (+ -27127130599753372624001250456405972983012981437652156246797208697430661165612459362971759027335854588888552031022264244768883843080959804690580574272908031271224646245152017114094021048441971097191444782106551075175878815012595015584723250801765859461211934306789890718268168352614164589637346918581658850565274510502652089457352942736418509881708568727739912127781455473660768550022762222130489047215089836402367851853412705556570667960548570630054608024914653686223423908494006675057953013815512203710764854485332282975729323105427143207127239069826750682633272289409910001698385240596625059970587393681128674617278 5719655139276246085992066702308194672442413085748146924567717361937179810269300239821879673460959112727066470468217892213025828988023367028158410455624528688729907493639908638553730770145274142147983721694721139760883483821883267129411125364089207412089113869427479340283853501026803387874124668123626271531796990801822527792189514551888019206405597994403243358155410088320317141454525417323186389587327532772638942220300149829241141659063128602316305332848477566686425551944956989370838072872906293845914921103561360871571846865478762953536949621421094416539099628942010528483544062050170673327754206501716239719529)
+ -21407475460477126538009183754097778310570568351904009322229491335493481355343159123149879353874895476161485560554046352555858014092936437662422163817283502582494738751512108475540290278296696955043461060411829935414995331190711748455312125437676652049122820437362411377984314851587361201763222250458032579033477519700829561665163428184530490675302970733336668769626045385340451408568236804807302657627762303629728909633112555727329526301485442027738302692066176119536998356549049685687114940942605909864849933381770922104157476239948380253590289448405656266094172660467899473214841178546454386642833187179412434897749)
+
+;;  ---- Test von - ---
+
+(my-assert
+ (- 3872339191937382556 13437882608410293981)
+ -9565543416472911425)
+
+(my-assert
+ (- 12702320881720530101 13823645380834800545)
+ -1121324499114270444)
+
+(my-assert
+ (- 10222969257152373972 -3454292165863475982)
+ 13677261423015849954)
+
+(my-assert
+ (- 591233951053628288 -17639978232337836611)
+ 18231212183391464899)
+
+(my-assert
+ (- -7878405903223218778 9050739027069287469)
+ -16929144930292506247)
+
+(my-assert
+ (- 11347120771894057376 8443917396834074370)
+ 2903203375059983006)
+
+(my-assert
+ (- 7831959259127703467 -257470007821066702597399141202130667973)
+ 257470007821066702605231100461258371440)
+
+(my-assert
+ (- 1092406341647857980 -325710450166845666190895573961860069495)
+ 325710450166845666191987980303507927475)
+
+(my-assert
+ (- -4220606126689357919 73461013742902296577411907972196819778)
+ -73461013742902296581632514098886177697)
+
+(my-assert
+ (- -5112059189225304080 334306213789148650102245018234146620793)
+ -334306213789148650107357077423371924873)
+
+(my-assert
+ (- 3093346224554776175 -204967241927023874963787190016588249299)
+ 204967241927023874966880536241143025474)
+
+(my-assert
+ (- -5735747638156472357 -3881750746805128137401544408305666047)
+ 3881750746805128131665796770149193690)
+
+(my-assert
+ (- 17639095392510638323 13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131453861285495087665017)
+ -13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131436222190102577026694)
+
+(my-assert
+ (- 16304056910692545233 1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417465834928609990708982)
+ -1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417449530871699298163749)
+
+(my-assert
+ (- -10347586523508777315 12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173691528917744363375331)
+ -12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173701876504267872152646)
+
+(my-assert
+ (- 16875252323587344863 -10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527788318592431794213674)
+ 10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527805193844755381558537)
+
+(my-assert
+ (- 8574302739232756920 2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503759011790017443478716)
+ -2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503750437487278210721796)
+
+(my-assert
+ (- -17657597319577965851 -470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715357800461845632614015)
+ 470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715340142864526054648164)
+
+(my-assert
+ (- 11472336850218354926 16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290339231792790773612376)
+ -16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290327759455940555257450)
+
+(my-assert
+ (- 12682607562584942903 32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884157735553718792115929)
+ -32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884145052946156207173026)
+
+(my-assert
+ (- 14621880654476679971 -10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579655168106377696154728)
+ 10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579669789987032172834699)
+
+(my-assert
+ (- -3220156644655019630 -8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543667539444686619670713)
+ 8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543664319288041964651083)
+
+(my-assert
+ (- 11628988978410243120 21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111014116286675587727714)
+ -21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111002487297697177484594)
+
+(my-assert
+ (- -15960716439913426281 18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592227795474197104696127)
+ -18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592243756190637018122408)
+
+(my-assert
+ (- -181065640455671431985325539445069267017 14120143334024043377)
+ -181065640455671431999445682779093310394)
+
+(my-assert
+ (- -91295299684959299024846233061686623774 6891102275697080803)
+ -91295299684959299031737335337383704577)
+
+(my-assert
+ (- -252582289949155881579950873916766853744 883304029266526072)
+ -252582289949155881580834177946033379816)
+
+(my-assert
+ (- -10104159950635417603045689770006558103 17251490913777465304)
+ -10104159950635417620297180683784023407)
+
+(my-assert
+ (- 288463495341489091297108607960869684860 -16376960611483226267)
+ 288463495341489091313485568572352911127)
+
+(my-assert
+ (- 204661965092367792468062569536290631004 7774991291341524479)
+ 204661965092367792460287578244949106525)
+
+(my-assert
+ (- 174559967167400201536723778015754014369 168183438971818617783400303174116396891)
+ 6376528195581583753323474841637617478)
+
+(my-assert
+ (- -253300708624436983509156598368557395374 -77166863757693227553099778725240875400)
+ -176133844866743755956056819643316519974)
+
+(my-assert
+ (- -38587765028356074196061530813295290944 5999161273284748726648331130480323187)
+ -44586926301640822922709861943775614131)
+
+(my-assert
+ (- -236400856885875891058508662756360145662 222191413471626205952456600591947275777)
+ -458592270357502097010965263348307421439)
+
+(my-assert
+ (- 212937903940173587742882129816769611096 336470165768472077447806282475185249734)
+ -123532261828298489704924152658415638638)
+
+(my-assert
+ (- -264812595676159375893264580577855253845 -247068943830535581577267897204259299723)
+ -17743651845623794315996683373595954122)
+
+(my-assert
+ (- -1725732715479127274526681751197327660 -2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500508887739763323997191435566266331339917)
+ 2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500507162007047844869916908884515134012257)
+
+(my-assert
+ (- -220007189346579184019349894240059989979 9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517057595815179415042385175627374957565803)
+ -9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517277603004525994226404525521615017555782)
+
+(my-assert
+ (- 139683266109784685815165642637380856544 5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108688202931002414214353708335212597807345)
+ -5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108548519664892629528538542692575216950801)
+
+(my-assert
+ (- 239160165978290709841254489756277328273 5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464958986304380141364542178714472948085275)
+ -5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464719826138401850654700924224716670757002)
+
+(my-assert
+ (- 315772704643232632782106484978382006176 -3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184616218582046814434719444842678248982224)
+ 3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184931991286690047067501551327656630988400)
+
+(my-assert
+ (- 82735713197488344149642668226610301853 -12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097816492579684543651922277865558518876774)
+ 12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097899228292882031996071920533785129178627)
+
+(my-assert
+ (- 63472235942371758467270296983419551089 -7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656218937984504828452980698439495961392749596)
+ 7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656219001456740770824739165709792944812300685)
+
+(my-assert
+ (- -284018520801241078671538235859630240269 -5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682401429552174530714298081464588450842581)
+ 5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682117411031373289635626543228728820602312)
+
+(my-assert
+ (- -171812101820192353275910956459431262142 11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870235074909890698574792562001595287630131)
+ -11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870406887011710890928068472958054718892273)
+
+(my-assert
+ (- -243638660221338112796448050030955119997 -32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408826226326879491415484319411662301650468948)
+ 32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408825982688219270077371522963612270695348951)
+
+(my-assert
+ (- -126332081511349770866908261827634312283 31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799809203410103682003414364238243553515261)
+ -31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799935535491615031774281272500071187827544)
+
+(my-assert
+ (- 219979452670016849533060110266815720199 3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063325766995908926108582896362623757323811)
+ -3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063105787543238909259049836252356941603612)
+
+(my-assert
+ (- 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493643522748210870974797 -1855792162818946202)
+ 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493645378540373689920999)
+
+(my-assert
+ (- -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396746566100575461602162 18009081534399282710)
+ -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396764575182109860884872)
+
+(my-assert
+ (- -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580214088920441698992069 -4827559068742614723)
+ -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580209261361372956377346)
+
+(my-assert
+ (- 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693871318067007752043113 17597810481352184048)
+ 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693853720256526399859065)
+
+(my-assert
+ (- -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778775472609306735864748 -3892174127829225880)
+ -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778771580435178906638868)
+
+(my-assert
+ (- 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676743031117653237018365 -12861394200627120797)
+ 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676755892511853864139162)
+
+(my-assert
+ (- 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971731015312020770945603825344926844435936044 236396022362585261770052671762207864597)
+ 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971730778915998408360342055292255082228071447)
+
+(my-assert
+ (- 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903680828294561265828775791256812588754280222 -276673555533799047589626400978981416789)
+ 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903681104968116799627823380883213567735697011)
+
+(my-assert
+ (- -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565826229169313660087149542130819663319659 -157671440495648010763311068579191828684)
+ -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565668557728818012076386231062240471490975)
+
+(my-assert
+ (- 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053785280430612875488847226724390758938740 54361107931665215623681874454167019934)
+ 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053730919322681210273223544849936591918806)
+
+(my-assert
+ (- 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942391817131531474661895913650810587431606 -50508350367572393968128467319633674717)
+ 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942442325481899047055864042118130221106323)
+
+(my-assert
+ (- 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306794511840379704578900504784165956486985 170502882789371639987361620116696459267)
+ 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306624008957590332938913143164049260027718)
+
+(my-assert
+ (- -10859007735074693411217019392659638207496329895257318665547454149984863458541990037760564769787816800806064437172810158051442267508476778676439633382657890 -7558060977666720080449823996328496253877735754811271086853901493753796001778345391546991917892931500169890406340928835457635973812901681485438886367096185)
+ -3300946757407973330767195396331141953618594140446047578693552656231067456763644646213572851894885300636174030831881322593806293695575097191000747015561705)
+
+(my-assert
+ (- 9842028993407961669727766131360795288615020071102475108883839785397865740828387076847892646234215787999498419839351470775471313077046438080666908734795616 8259939762466350877481193620364896193464602165170783019804380181692322874550956777598992104871440502758410340359413403619753571535498118388286469082729503)
+ 1582089230941610792246572510995899095150417905931692089079459603705542866277430299248900541362775285241088079479938067155717741541548319692380439652066113)
+
+(my-assert
+ (- 3122315115429970622394662815735050825423438028108957393747131991771456957037829402044934484343765915727397519247940959221091465331254497476137639859816450 10737995515603450913722681305571315249864367824351372254572936648132763616823019940208526402092654554035074813865303483747097673960803093638463005072804384)
+ -7615680400173480291328018489836264424440929796242414860825804656361306659785190538163591917748888638307677294617362524526006208629548596162325365212987934)
+
+(my-assert
+ (- 11618335890332522671268040181306950825004789685088262996478365976802329054158653675768163009290064139158450983598701977173152384425333441365287895694522192 -13130287008197231017935223399369698658354829835061356451363818961959486828237111511740029441613108087354987794332115218978284937263725126538295501305403242)
+ 24748622898529753689203263580676649483359619520149619447842184938761815882395765187508192450903172226513438777930817196151437321689058567903583396999925434)
+
+(my-assert
+ (- -4829477140897377009195646150061276059814366801005389903693533021027427566117360765323647260121062827801190746646296803957067548167571028717513392985791293 10716557117391614298810040587314742187092120526669273567183969821384063434473189717686678450880765426943205955814024872764413373364846268902370055526485180)
+ -15546034258288991308005686737376018246906487327674663470877502842411491000590550483010325711001828254744396702460321676721480921532417297619883448512276473)
+
+(my-assert
+ (- 1560421244904974852620371975782132605421448226892487453928759432083522187778803424020804578027100625536441377609275030418285893555753560195716001014786650 -11797558308994912054526619290334311429749533070145154703018977152548370444659962978040151671210413666186432921816690953994784423526183449271023503069393845)
+ 13357979553899886907146991266116444035170981297037642156947736584631892632438766402060956249237514291722874299425965984413070317081937009466739504084180495)
+
+(my-assert
+ (- -7701347923966912534344428538744620884561375267012102797292378941649984539207353887059064943586048644516121387166836442084007442716291792933061162738380376 5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642478870844024835907350391770605391526921411004262446196112836319091260967898895009427182171643279100998182191816962677328417390867021108292139204864164048286)
+ -5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642486572191948802819884736199144136147805972379529458298910128698032910952438102363314241236586865149642698313204129513770501398309737400085072266026902428662)
+
+(my-assert
+ (- 9733743430220591762422540139212426729307515492818443460852332805653889275463385649305231919846970974905736816260992940027028218064265519723018527155353151 -29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453255593120138178690189726206775893096279000909079330468718593887702543025737308336025198677457129910473491269839827087491228569718246503140134413881896746751)
+ 29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453265326863568399281952148746915105523008308424572148912179446220508196915012771721674503909376976881448397006656088080431255597936310768659857432409052099902)
+
+(my-assert
+ (- -276731217243271862683214238489380950428392903790808046630969592255272629537001990355375434170910931115552132394269672247616298060929507021008951190291387 100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150102261744547461816282538319258966892339056695718919291240188920586288417893106046698069355647145603908383687239983874164793005765733782432717429040621674)
+ -100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150378992961790733678965752557748347842767449599509727337871158512841561047430108037053444789818056535023935819634253546412409303826663289453726380230913061)
+
+(my-assert
+ (- 8505070389896098095621766692413480203366379968950158493268895987250690600795955783113900096527432416791184386061684833478921638080978014176210898461637606 -16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728677459134022062202283647690649100602260948409511070624300011106517649666031530376191755817891213910847547809248990517666613043010292627100428536737652546738)
+ 16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728685964204411958300379269457341514082464314789480020782793280002504900356632326331974869717987741343264338993635052202500091964648373605114604747636114184344)
+
+(my-assert
+ (- -12618010259109779267590315037969998053964054382853891516547435925972388025118492931596200697357628900783311183940584302426381939302632641549019984810957030 -30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476306906983993748299291616038887011943864441807818857508443930272872365334665976442185494702520760793786640113779099219233665607521784524244604432396247693263)
+ 30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476294288973734638520024025723849041945810477753436003616927382836946392946640857949253898501823403164885856802595158634931239225582481891603055412411436736233)
+
+(my-assert
+ (- 793528769616879938852241178439496352527042950647521648629732169156958768358523029837406526207126598190786120139491813624819360632811627576064199559812277 -7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323018004882611048769247228828875493680284766874334247375868318795940759082324831733175858991629741478124633015067484305547002438816473086042218906532116413)
+ 7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323811533652227928708099470007314990032811809824981769024498050965097717850683354763013265517836868076315419135206976119171821799449284713618283106091928690)
+
+(my-assert
+ (- 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554199017672360091721648 9164115638960783470)
+ 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554189853556721130938178)
+
+(my-assert
+ (- -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769237154904791412049964 16928681651977808800)
+ -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769254083586443389858764)
+
+(my-assert
+ (- -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289916823063616573634058 -10755560408227106818)
+ -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289906067503208346527240)
+
+(my-assert
+ (- 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427134042574317487793 -126159569916621842)
+ 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427260202144234109635)
+
+(my-assert
+ (- -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617308447853505824391099 13449070890444925581)
+ -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617321896924396269316680)
+
+(my-assert
+ (- -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414447893892341891463988 4431555062692055371)
+ -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414452325447404583519359)
+
+(my-assert
+ (- 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637382775371488874447622330992324750207465 329466253508616383200261654231797136951)
+ 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637053309117980258064422069338092953070514)
+
+(my-assert
+ (- 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708269410828528742743794495302359380494607 126536164564464424337714470705049463978)
+ 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708142874663964278319456780831654331030629)
+
+(my-assert
+ (- 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199731850712255885395479903525322397561293553 -169494171680584797187706369710105239124)
+ 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199732020206427565980277091231692107666532677)
+
+(my-assert
+ (- -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152307499446188262820058714564165108542508 -26845770031559702758807696432929071597)
+ -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152280653676156703117299906867732179470911)
+
+(my-assert
+ (- -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789655406716271370732069643455590690035701 -321447426701397438572265325285879998363)
+ -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789333959289569973293497378130304810037338)
+
+(my-assert
+ (- -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955696690287600957842671916189752415855520 132223863177855649509430852484092802671)
+ -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955828914150778813492181347042236508658191)
+
+(my-assert
+ (- 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912743446197670724757690108283368934769626461285961947257397454619164856011847736479229692086038931510067165282571276049292116713101550911614590774659556899356 -6114512833799784097991148713266650451765474382378581896952003894922931741133332233338460555227243451198289670274036744955599177213449957470212981501678055)
+ 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912749560710504524541788099432082201420078226760344325839294406623059778943588869811463030546594158753518363572241550086037072312278764361572060987641058577411)
+
+(my-assert
+ (- -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912449969621455596132708975438173455827361542712483153981422051943690720556013580161324856788091093465837542336129629269227369781823515673967591796132853515009 3321161637038961370471515250185392889390643163295535903347391615170504064647249127732639364682803744773593849851778894972403397573953564801884397178069327)
+ -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912453290783092635094079446953423641220250933355646449517325399335305891060078227410452589427455776269582315929979481048122342185221089627532393680530031584336)
+
+(my-assert
+ (- 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741918196732794332451120218658490129307932187658010681746557120172585093207839141764683325214902696969028472942954863209641597556494684135445935915485525220911 204625459185084436546676461283890328511903949966691877662249903659689934813784661695047569885195881142676761876303280806728760511429260843727967794322777)
+ 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741917992107335147366683671982028845417603675754060715054679457922681433517904327980021630167332811773147330266192986906360790827734172706185092187517730898134)
+
+(my-assert
+ (- 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321037694842089561504643350632756961329867761604760788760440497535611072991056505806805291706178639395690245460397975614715123591611301423752799666149495108752 994321141213369910357526037382331323092462599623554452705525887587326552002660849455542761618020243106424015447778226642816634338781654345001677083881111)
+ 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321036700520948348134732993106719578998544669142161165205987792009723485664504503145955836163417021375447139036382527836488480774976962642098454664472411227641)
+
+(my-assert
+ (- -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316157215551931810740200836725504693738229444336470213883741520460842708733150362983831267583568258736572295448486287825894301201018490203520738439038977754991 -7402949251688548738762242219263594861535354011996392637087346760786292549376145193266590582054224293289596877537643409310483743293801574030358189880866069)
+ -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316149812602680122191462074483285430143367908982458217491104433114081922440600986838638000992986204512279005851608750182484990717275196401946708080849096888922)
+
+(my-assert
+ (- -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264269215878469013316796620921077244799814690434355127994011220041638393750697699141479399553359747084811371804524490919966410379714725200415331414459870271869 -9247155945465656153397925559476432992975541781462281935278489123804934847762489500833913193183733932905776020790478662969835879365116238125565077744775032)
+ -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264259968722523547660643222995517768366821714892573665712075941552514588815849936651978565640166563350878466028503700441303440543835360084177205849382125496837)
+
+(my-assert
+ (- -17010604274474750006607667808593883725990508452473783283717890546525148212376267233909567638545898628257361383837671935903199638230375408397752251127816717091041943873728526445398525706450929660366518707254053655364610471112296477865068960744948010561798109833411657930112293904378353445961131058136287425064317621271289456901138718557297733713446119244533144377470099270824020439428168481914824420861176457152299497728390918971852021025089592998997807574907789524112450146545688385954763667980124432645276563626082835790429598328230426471161191074551543308732791287559033843466623138171520961684959997180979203053477 -17319079025684619178510812811805110270463447771889107440996086020812918555191263705580533644731591929176480040622705607552852994906782176254877135818109655911838591767583157894999741648979817400330572419476101372927546509769818404491634583907246692993992514876697330603464497645633398167129555001859772111887143352351860130929715392173452396253437927361301990735683539169040916027268831202732178553152351117118606495416985612909248422655861312689027789401950549626643389790516560291620711705848717875304929186131258525831197192620523261738944873398924939726689336762464320190834794155527335576391767307110012289717973)
+ 308474751209869171903145003211226544472939319415324157278195474287770342814996471670966006185693300919118656785033671649653356676406767857124884690292938820796647893854631449601215942528887739964053712222047717562936038657521926626565623162298682432194405043285672673352203741255044721168423943723484686822825731080570674028576673616154662539991808116768846358213439898216895587840662720817354132291174659966306997688594693937396401630771719690029981827042760102530939643970871905665948037868593442659652622505175690040767594292292835267783682324373396417956545474905286347368171017355814614706807309929033086664496)
+
+(my-assert
+ (- -28362352496476494327713713233021518136860402239251781438945998574753662942796270292818595738100959519541952077905620088422871490191217157269435052965329201030095268586136492980900212955645939325800541690754639292707053269767151001292253701853012092829784482071789669480438026889625605099744553642207773753943711175375843649210118677569597324789367425691177169929576236753018329085700397911235750600921874606148324025962628852167093806152864269874177214562322576097931390470469397118268354868919899638376323751276807304678316688836173746719723312665764603485606350244811113608471530958617108833879194264695174468397461 -4081062111675377984305281082755054920741203741273067094307824323728798665450292976016160959354997082250970415737745853292134965575242789548167162064123232363464302136338349828801951197252612093077640695564825095503535921549690447893467349156939791370286866987224201115453216606688305427702274940837032716124925028835914047967887674858015919302546781010326385758988488478290741665427521820112231266659657169118374988259423444686317389869729817643396097464874333968181509317307320406521221309011946212308190273531009796563611621389720223920155554879800901239072885025170342349379379336047732368458185953903872634982504)
+ -24281290384801116343408432150266463216119198497978714344638174251024864277345977316802434778745962437290981662167874235130736524615974367721267890901205968666630966449798143152098261758393327232722900995189814197203517348217460553398786352696072301459497615084565468364984810282937299672042278701370741037818786146539929601242231002711581405486820644680850784170587748274727587420272876091123519334262217437029949037703205407480776416283134452230781117097448242129749881153162076711747133559907953426068133477745797508114705067446453522799567757785963702246533465219640771259092151622569376465421008310791301833414957)
+
+(my-assert
+ (- 10367142604728811799331249565431331488313655422005202933702176605382043644320209814639311439871418581341534233560256605231366966869093495784665834232350567124110194965198962966795893926025854156729633358240069116588609932539289897499402463770167927610848388138020589286461244557962368497723086593344721146859584146431437967506007518396464517349944129896971137720357645026281243138165214047233258394590454775153944241555543594427555914116439316287902470043292624597940465373006598913770411505099332700167695871387948271302951230983772351549087620538875967635100644404345317626621438913980275970160864401622986870735123 -13323117602411502623386235160326625769048477819798659261203460002048250420188223753407093545503703207645050883770850457071863684414849353264890601744588860687970804808452855795406182324143949747985869939791374195222513169904228914579995165180964917538177994190229733465224857616114628815752065632238207474599531507602861647623695058640735949593381112671690796335596142010430124683781417828023076027476816068202219709673411776556090962187853799456968290579708094595903778622705850818245685205707447012659247018940946510378371952655457988959551256869060428488498330109152756599450626641948447980234503249330875085656261)
+ 23690260207140314422717484725757957257362133241803862194905636607430294064508433568046404985375121788986585117331107062303230651283942849049556435976939427812080999773651818762202076250169803904715503298031443311811123102443518812079397628951132845149026382328250322751686102174076997313475152225582928621459115654034299615129702577037200466943325242568661934055953787036711367821946631875256334422067270843356163951228955370983646876304293115744870760623000719193844243995712449732016096710806779712826942890328894781681323183639230340508638877407936396123598974513498074226072065555928723950395367650953861956391384)
+
+(my-assert
+ (- -25321281404861286799950777949097462701962113587443565138655462269365151737118518315058035825695270231347401755128007072923189452859397209062457461602335603630181865680063451525170253746137368267674863889514153713728814272332433431604233690200451816570240227260445028630591376891139306370205846627093813889699170594185178241812081296510140572331372738998993116117098817936927692238682202717231675283209016857095739468507690090676681400453024293870135659990528969837132054786661560150259115734877162158755858653364070279937027014730947342216816307219127474721622123875699701715404820384545693058511056735799834754890692 -15870257059811626693754498423136372480069134596343998984549199283973854570508228359295418026089909378687774627821225399931314225867711515277913855368473873536462450935842786002269065816311054834857109074848803122494252885020527074586145467185882674518032764708782999568002770206995683800833252068328835778749976046128872525287656002968632147457840467536682726059599593635219947081138082647985895437016641903078766878782632503812736486529143041369932038649270950453231711525943737962179463585338023463992816994328519710963267459007592689204838965317062070771191372220277256094361390952025057574056586665509010902583686)
+ -9451024345049660106196279525961090221892978991099566154106262985391297166610289955762617799605360852659627127306781672991875226991685693784543606233861730093719414744220665522901187929826313432817754814665350591234561387311906357018088223014569142052207462551662029062588606684143622569372594558764978110949194548056305716524425293541508424873532271462310390057499224301707745157544120069245779846192374954016972589725057586863944913923881252500203621341258019383900343260717822188079652149539138694763041659035550568973759555723354653011977341902065403950430751655422445621043429432520635484454470070290823852307006)
+
+(my-assert
+ (- -10064759312484387184876313010284016458560725440641239737323234767636591183611201479885347260175161165340917225306019885202675573016295152797559983194160634880140345743489989007821872426587698574795394887035658449467358615185057180305109018898637903449135520486663185036663238956537895356325733583128141439025002140924158670346599492383552938312402521066705186885506193758499006001382444818328802338159713646715901977137011576113434170842422373328479181457354927400927267448788528116619711184792932525071391797130057189079431487557270366699175956757661488296856660145077706273571985222726397848614141194988258117115194 -3689074607001776735792882994440038588887963294487080609346609068733026224735369468180206799966728461935654851527895876039403151156669223687679382665269013769686991783531091821265184956524448064027733731862929686596729449196238312997460578818232100254940830907672953344544031914926653652310468671685310332327057444910423081752028857828828473637496272809899061573593874011995802487442092326045415689987885712749026491545159340468151000027397821404233369034594141219014219707193746581364791219277489927025992135462852894714639406751538919395016165215641239054420028872350709704191189169571752512626755385998505584006855)
+ -6375684705482610449083430015843977869672762146154159127976625698903564958875832011705140460208432703405262373778124009163272421859625929109880600528891621110453353959958897186556687470063250510767661155172728762870629165988818867307648440080405803194194689578990231692119207041611241704015264911442831106697944696013735588594570634554724464674906248256806125311912319746503203513940352492283386648171827933966875485591852235645283170815024551924245812422760786181913047741594781535254919965515442598045399661667204294364792080805731447304159791542020249242436631272726996569380796053154645335987385808989752533108339)
+
+(my-assert
+ (- -4621513851362114851854472268081584822344822740665629177305004335694395719163541988311496405455186973857145245414214464449674464879082042971313025249648887349614046805778335573547862191522938924075560443632614665169520240664970180760364771373836023824195690134618554368845612471858027311791638881380352344527105480173917778084361560336490212845414303819150625355111300877737042696291233444311426721588476948565949641149735838580313236869041013210454558557732497012037162735013212361842433337324577522358968152852532145622765032318936569346015498130151789662274686368870963891262060214274101000058555635785833724062234 20283847238128227963042817384468009365120280641032764409860857066215336820785816567924217697745867082423864450685360959383940995237907453126362378908108545669654749698030305432673477271848544313029448526561606175059997663752601262173667861202924953502866611309434183496911206954880840674239880495147451496219568787221129244201657487090244435562896841733049066453539864301122516559479757096183362477594406691085946787803323712522074578611082872627361465163804239673539339633332349145205596371287028267780080937728455742966681547897652607170788637996317683436193829274172400558140357237480809582038468874094877651383053)
+ -24905361089490342814897289652549594187465103381698393587165861401909732539949358556235714103201054056281009696099575423833615460116989496097675404157757433019268796503808641006221339463371483237105008970194220840229517904417571442934032632576760977327062301444052737865756819426738867986031519376527803840746674267395047022286019047426734648408311145552199691808651165178859559255770990540494789199182883639651896428953059551102387815480123885837816023721536736685576502368345561507048029708611605790139049090580987888589446580216589176516804136126469473098468515643043364449402417451754910582097024509880711375445287)
+
+;;  ---- Test von * ---
+
+(my-assert
+ (* -1412797070596191471 -15492755620416346417)
+ 21888119755986895161222137392796809407)
+
+(my-assert
+ (* 16686841096925954110 1491135775021813104)
+ 24882345731730524499708005167300657440)
+
+(my-assert
+ (* 13262412958100188045 -18379071970155621919)
+ -243750842254847872704698616507823758355)
+
+(my-assert
+ (* 889503034794263569 -16600674457216690894)
+ -14766350309325860687849239111838240686)
+
+(my-assert
+ (* 3148165694020236318 -11771070679825280729)
+ -37057280896113409834434531491271315822)
+
+(my-assert
+ (* -4443818546267181727 -12001052312087213799)
+ 53330498839175802532024121011435050873)
+
+(my-assert
+ (* 8305259347214213793 -229351169208067535459370186456659711595)
+ -1904820941859811670566233132773219565154696335396051029835)
+
+(my-assert
+ (* -18273334758510166901 290047155020180552782039318570071650475)
+ -5300128759437251944808204783222405076790289915320785927975)
+
+(my-assert
+ (* -703280433697652940 91110448009482115063492795153459771021)
+ -64076195390496041906141380919369524419358692517527451740)
+
+(my-assert
+ (* 15279634596127882146 -220998726467849290098339792307263567896)
+ -3376779786638352686104608499923871317791563686466157184816)
+
+(my-assert
+ (* -4472497681184076830 325612942672822430032905460436166528379)
+ -1456303131067722058341139305566346079551678140995111358570)
+
+(my-assert
+ (* -6180420673489141029 -161157288800853703711204405567379740552)
+ 996019839388256252540244286609069684717518686623358308008)
+
+(my-assert
+ (* 14044956603588468379 10163190459901171254101452124764637970005230126310661589196828892266636678427020930101076689732526935899135126391465178494895371156141265424428405590113790)
+ 142741568963316278148132287599703960511135825069792278910440475692913696263448088587778211787403889397993501704943449376875999977937418748662459138952952917221024170426846410)
+
+(my-assert
+ (* 2133283347509865817 10577710515843519541178984366353275630877942729579274295972091544607384358263130633386329706527832990861547566574369528634541156662300858851752195966167381)
+ 22565253698228972909216255630133478029433774404794962869038558824053350969301054394347471181756471783852326407546652836376109109470959746153989521923555764579738243072315277)
+
+(my-assert
+ (* 7812722507014599311 -5055959518947106416800910724733658104378582281318226107212861190073091017493970778425583956006925004399967175604321778956828368132273155364830637407968648)
+ -39500808728232764770485117356353304373275127104839804121600969932458363071148383405901570717732548020267052999198017578112731079638156026910705662052515278317807704170401528)
+
+(my-assert
+ (* -17560801708050275829 9842515227842383346577123873881045824143545509071137371075701856197189100217561683579562062872293951325890789283651221922663521213150065638405410634222129)
+ -172842458224605375239887212582262805312641302639067963604956593404910080268476692854082531021580381176489626536608405283010496488558204787140272050713264572452317265305619941)
+
+(my-assert
+ (* 16743386830114877156 7347065846171565625701636575261347705942035850951855454324853850791855951431141198155170102434274509450315416946729031216385536668189501958761688618635668)
+ 123014765528775807847206414290825117502032199391400884957413813554539073118943905948723779020186281150198999824020769031248882909461419778092564985979904308229718874140000208)
+
+(my-assert
+ (* 12697192948029671719 -11416780209809507417142822520376617951137069007568339428552592261458272400645205700952156716454820410468812274673183389934216970221062627926131479014990611)
+ -144961061169197993494569769162151457365959287966302572862364500950127981616038900865036521107816831702945678695331078399461327412574397914795455218447174498277798426197230309)
+
+(my-assert
+ (* 17005139720743105479 -29990519259587469661876904501488342396062731024702923152492275204626478246142153608222329335341363164148761307659972897552084842238285026253664841395295138667328930482145590159132144957515157474957872335043653264146346772142483721767458961320947069718037828473530001033848282453826154763424789967441239969918856795769965946388666154136004597297855416503729657013008165049478441197537144135384444157408972370236442813734429031404855591324183846423588871065272526864866155918285777640819778251612915859290336548446745308788013234099839998683451658620461972798204104633072664604846231692505409653434538208644416538994256)
+ -509992970306921990341332390474393215554862069848994183152714032617297815196921655222705396130464246880845576204295466273071779248718654338767559016551390771145212884412809612574391658668778295682412755916528976282396155832617323980694289208942491001345059122414240884660276842648466533488559879226195446807748573906940273568334343093922652142252689341425941673567630236228358747411926991658260241924294146562230425295426217833820067881064577380516936937782688004146531121831211284735538742160763820814174631414364095096099434285754767091040812242751724012532803037860394426031234340719537172735695313262283511554154662650333168783128624)
+
+(my-assert
+ (* -15877530153400521290 27863984127681242643954505352420303514833683768731313003271701952957204538094398204984051331105594788039352443762851136101330385230866919393696564428736685568762923746771275677491379334452751710169529933675128178840986001684425353245791752781476028565228371147542431713985092322787978914276414008774443194161599919167210582437024618824616489802661351916633993681556274980075051797120207655478780052593534285265078265845445633803877185868676955831374479850746658711791169579387317321983669227930929736238215792068273805543745311609083833407544342964285215427999724272264458975101474080574470499647168865409458531868592)
+ -442411248181132450919255517905812929771246981404050821923231762557171158858876183536414772404562764742655092127161703706239729646027465795612501446223663310668879007072125975886873343449629108246953385822769744013416908613100114754904323190537317463286500657291202287742354250227377164455244103312266617146454847578457073139633297517170508179596166314955134347046515455569689877574427319658085169791949003021426613961459610227430636932814700361914589752207776142403364490846294795496119883683491811246550808038342285518518431538295199537270236275774546666026424361019715280652576803278928827199810150387207105149968313623040090578323680)
+
+(my-assert
+ (* -14162897687527555611 -23016403916121951319848021112075986869602408568431399211927062304968548663313037929311574133954267816204873252195499803324830278637331653769648377216095499136975244697758388851688873078022850203685120154634090802825656419418077380419130449990938627982123188424119187922828250625318327074513352279785514062876718714640725789938556578327139793467832731546881422469843509318627826856881082450937188956068348931459011923844607158528494902828851692203126881727638511348944908726926619613375594042390434147948508706733126737304560579515324106834237197081860910657003346633962662773394999353766192391746258372744063777808796)
+ 325978973798843759388794644178802841408656469654887121096165875654577046313115917671847505813174070119516580105483409446057747653173640660143855580491229746795572929387698247460831363721394707501497262525550824977473864621747159715947297817600227665840640555029633517390896890601028716769035575763283168066843141870124768085499453574902575378368669494153555135898430469356384416638130459557518713454927909937610851489821263029886989981438507377741962130296498574556444168140838201069779040087521405032426995145166201901368032136008107323350679784004016321425234898132080844200202007395427054392280809376612533414505539109579739614954356)
+
+(my-assert
+ (* 10844738523441551664 13010289169828379103330191247192587220592807931898339555723704078985668371901953113936581573750666143303899278973814509164982887504269303358034042953769514772858989849512527461308415676004712388964136857232374888643347097138114199889581495448978914022318770898259317738823514820591042321773469959130347470144905381758960436645008051488666423115693738341045851119808222048272924385188356021826450267608127588500233526688704136268009202730309974485584784539415807259862449203760469406037505772435323036790641520939576046423540699016607317147689982042035523118533555744274806239272109508745089640043900389441390176681340)
+ 141093184161152226992592021994885140117836445291515772908453669279294934817987511015413332614094493905560980363483549300117114491702466085602279965168041684355125886388302948336158133555051817733078300668260616983283027038746214728386770752826764135491650323133831923154477800324207350667020747545837613879364064704092093040155243919335078139087599906324684688427176309081290932504214653249366429592335409761783188358003723753633106574740731573467850133547164922532633897844647383889253777956821171583261238607289172489135768839436605233457738153233579088224808850428203888700116300637190661108848906846940291749737998056247719674749760)
+
+(my-assert
+ (* -16402132873169057380 8202725117980211375579199554494319645475746305836527475507064811368616698686329266053570766100878145903342129595869654087772486685252653587846560946850102095086896668181099435964053041678323706849735936082196618754721606824996486473796843333331029865501790248862590712245450877098960007272754260813822886287008295409755783478345202299352891066800825979067590290793893933819913530599309037639082839491869155044147367415785329077864525961799400923643936705317921900308490987828345313709179960659814100113658528990241758360711799009722683007157350272749544178688961738222930753008443755881419398858537860612954576778456)
+ -134542187307192759584182063854799850608007421111316277594191532129597970622559949723743396309231347084450105499455916612009290113746722460358793168839937004812915757145655285798961178877391232945062437277255128401572171216279188126380587081673725314534095093062983435026047851041796084651601813918099532876684901239903769891552275465470747567830660442193995685219383258617057944010709906130655663966913354414611799232001438943448374556294933488875450563987147224709383408815994320229340710143082135667640802837699940654151297907451396297241124380508001357553893328703788960812706653503939250831164194874527033594779746890593262611805280)
+
+(my-assert
+ (* -12094905083549825231 -7303327854122277566083382629094740392048421584433028903125893639493993705575691832165314461496849401726460344615713884253150283931509897329926825128629833541892164122168618243719393446304446866677253728405617434021389128710195093788280203239300086905325641224801020413858421914412156234316517981228056539721130386645649016559425091470643854813419057026759188125291655398451427686659900364573485593902992038773538760663063071699966278379037038361219424927031644750173900916227834573604566165762753650347331082640552394430002401423199016978155236550541225512734287851807727860645247391524620773399994302380387697957581)
+ 88333057189654571362020288527489792875655269960629008914349561689924145109953656394378545526256758871407020025766992398117775520525507898420898102744530402370720932219749861094609497366188371774072368034971851022164946370916317410415503705484491514312339956381120953283812334833067601825812118392757289250628861166579446800637104996060739031010579056633535166403083327528575504427815713481850979373113173151813491831551023902022537957860211597622343157802805275942920911544696695931809085743355666792408029743911424760065578742910735408262758198787195579745280191859776661700139596074108035867940154338953640690242795671183308201526211)
+
+(my-assert
+ (* -81618231044418675360403541307856740187 9751573706924018395)
+ -795906195858402819552264165081526765614024708979523739865)
+
+(my-assert
+ (* -167600745660011044249531125104202473984 -12960244919927910377)
+ 2172146712516287908809731894157839567367040369214826131968)
+
+(my-assert
+ (* 90306383312124738690336097936949488486 156109477991590792)
+ 14097682358164298866835386043901377722456291173827620912)
+
+(my-assert
+ (* 126202800261728727198105694812165074067 -17404362862588500316)
+ -2196479330029905727399352310201914876903532806486592905172)
+
+(my-assert
+ (* -80093647977875266525946940496137725572 -9499399805878278852)
+ 760841584053111508349403804472960020663660465509267203344)
+
+(my-assert
+ (* 304052889577333477963637861956318521374 7233536405885618691)
+ 2199377646072361697737485358722028853038393128548297401434)
+
+(my-assert
+ (* -124787646062877233829165925777950698937 -125798384154373172164515376683173327013)
+ 15698084237137783175768362160964949930745617334715009097620154581879012485181)
+
+(my-assert
+ (* 259623502197082370239517374851053110076 307089583871541575627915295134832918432)
+ 79727673252974285068387698133566605944659309374400074880377824560177225320832)
+
+(my-assert
+ (* -245358177397026033963771466683003477163 -285087883756432161967673595037725276963)
+ 69948643556453419103498093570621669430956866597291662675473644085666220495969)
+
+(my-assert
+ (* 46731711386059374483493216849082745840 -216522280665540473581476116002923812173)
+ -10118456728713381305690589407461434638634240429858378588644634276171257110320)
+
+(my-assert
+ (* -301422430661955757433852743238845048860 -737194742467573013847855072675441356)
+ 222207031145790358162820429948896977201848379524899474475604149595884654160)
+
+(my-assert
+ (* 109781582310220385246795023904554278713 -273317662617851276579672019029762858338)
+ -30005245475518685175699313262818315773200953201653075289648004177366787958994)
+
+(my-assert
+ (* -312236719893391897821327608828679767006 -661158307192284418474080017860142217763949256471548515134335997907628404839044913830388499435166012788226998900468665646723366842553747501004752506346280)
+ 206437901167986463762021023207669068873036145952740267172145693855475451354717023377588805030022300923600718715029262618794758202955817341818233889201852381575043965927328029955969846754837680)
+
+(my-assert
+ (* -134379788461141842858846278268259347105 -5535479645589936472405910397299739073641612836770238183712206042659632410776896398062277742229906915852933418684231779996404071421767274180368154310128427)
+ 743856583805332082970350662728998610690268824090148728726850517499798631519601137183443104910590855501252539324674812560702657332874686395923181633958702249128106139207076314713649515720653835)
+
+(my-assert
+ (* 278271843790644800793473851247546123375 -3845690285506025443856370771250487683891303505653819308540635173436088084480277686684743918745832832765066355874381847690771330587033980524869033600561589)
+ -1070147326395532917564114389205677334125034378502074943828571411806344559859053091006175486397820822872698474899835730026158782698085673635033947150554253148685482702599776833910878579880042875)
+
+(my-assert
+ (* 22345490710865165412267189692679994671 -13168094845644809414256057134926669929759930873747535851687323456073141938879368460977723280750841588750507348317544461824280674332488497533955177541413394)
+ -294247541053147552931885013427268298282376074124656716577088212043667912662239091316191145352314750820026626159649861330384837204227899202392764926604802655267738710003310052268554637728023374)
+
+(my-assert
+ (* -223445051950608517881717261787296926498 -2609806601119499724524852022247741111662431776874117401343811680374867931883996125145979162937751368655661775097445043144114599069842524778189198926688379)
+ 583148371568187658089071213924575304457465978545376486297236105670932990897420147110485946155066725440999079357995678147717407410446012970360780626554347417807723098476525833332400212113766742)
+
+(my-assert
+ (* 12604140228725912459681435851589379433 10671266866958584640992033560488052420339425977492420594983497264069815016478448589306666811246532193922229713077112601565462530332258877522384022088660628)
+ 134502144009302626262781543880199144227907004673612064586081220538754991037447647926963488301214672345398823354945333417956344119228084327815583754032364976497975702972112644238248704660063924)
+
+(my-assert
+ (* -221289678591114384943252477126208006780 20020996887149770966522122735176842174467884990518978494604707026520269232864200848420530223248762875769520715632742683760311747174524709550334825291720803698613541109690224185041740294906022358446325921538593105347423518731748623037078340006459454656405997570119591344894717789372844612253617591807770017562530034107842444403952657949565007792107071767260484233194674888488789619319597151367813735192433631007526015463229060702510632792171187339118004038505860316305860704455466207113207893106982258864355430481457640304138738182009363353560090082819036973601710432437342931523433079941958203038050750205966472435692)
+ -4430439966231074415853738608900692925851705818190624801199561884242897308817127146763274284287396980593383317678766559004881552228480591814939402896201244425805503258878061459604511214900528594870260206969839682573246490602076070316760182753341371682323914671418233629420599310422437691170629449435494697829163966912842611408632129590129483811802031178053300073562716917597174161526976287351465154825036851645956354853960835948518860624747958440181683978083391663149733813297698623499283645627889274004656942800842013709298338912226207338477579862672216831422765369078886850523202897989792734789430796029206661261129141144642117177625405158700499049991760)
+
+(my-assert
+ (* 180785619668676509441152734583033930295 -11909038209406834057075682058438206007134213485822042209417443270921391661498900475635417780140585878716264253792335317341527677051828500780153492153490249297998660274828986996948999762620400587091118252205695562417522111840305140989214300921122857271717052213225664738544344394774362885331856170636862181712515248810239601812262573113794334115259873527539564296101166439562124016438281173202196876398090029995104489712272260608848551754611421227761245487365953257890749115194455096508613617028024932657498899001119282498614739316599704645009607294747043489655424155986912576002393048535846081096337705941547991821928)
+ -2152982852345560218506186041143281789706715672110278207735389192913214838321097754496849942223194392302524369156102301165660674797665128931611291246607346536492650554391248756408556789391955568308599431054809433808337036546281323840555452571430884302696950144068129601527530304907460164571704857360215834011779559395577299313379666503707563751314135201994045874159291100986903645360754621200008830207429980872071814202801994486961737459218017354210479544121100423399040398021780750351097082070296255480707530391964970754186799748521538525274241709676878827522138880241734356460339681718690408853314007343934035505873192699052380699509877559455199604508760)
+
+(my-assert
+ (* -196121729286794751535600080816329923561 31755463535476988506639447113088283661031267977524968610501132544098607201258848456920865390506381665724254592728643925608893982794532243733117636645689751360224314774452374503339856173343683819017479955914451013484169313685311530532055735999039466721411777061709328450052490025363788971916050033904534189719389237878257877112162843506491071470067738867693853480174965212750301808781573369342701195147083717623066339671595077736036738235636996351642097684597005928843274525502529735435418805821748637387888409663397547514467435322454217015563134545731593492200855670248739786405074231658957946422903165662016649229286)
+ -6227936422881500100190187768375947805694946596622670066116457374856427496311253030141271922822486386675428302332027411428470488965226898801659352566022706152307022438261392466548357753526474097246042956052374187605144719189465046544498482461077851578811186829094445089366592317045580466302238653533114619908864036973070346979261546801894831273337217021756025770590122176562027129481076270727248949609326868225755958667670279949371399535144788247565199415296122873444199709788941984099349149684384486618280260678252604631431089580057102263617056951788273430713908768738965854953667135156866028646584137788146112300214498814212865170902491169332389942607446)
+
+(my-assert
+ (* -149247491509558553673630984739524508601 -9241905448313719916485289537122695595500213295294799660583133638026091750542612875183284894676615989153030773719811347110864468582634048542108726080717551794580656021381515769591713295631818532114918070215760259364277583650102628486861397602958930509695263902920994329409932518607260720657755504091822028630927071374796474717671220452208310602827254296323761245420486376569048549643478954846020045263141546849795367522490793641049509748005893155533480849922847230018411440739584477452313387881413141538766185123978087175960946255649923135634987656065468774634483495944248865774633962770893338531522570776854773975281)
+ 1379331204929344851843348280532786532350930013132149419346606977890849868537539899667631713548510207947097949976792337278764045110931774279794402312944786743575421497528669859045492875676005849752425421867514661792129580445000023570590786705609341859529483054902802038173138834528021423393677908655442991197348183257271932188161681770513283703502340499171444058119260228931558784004778969491586252899270869275893402714040693571919281494643765571068045362364213060063345212881008657925426024923296369533374671614852576576041747836643356665301762059898161073609265572267138950725010661453917338098901465732991316661901878681888138048552901254914604845891881)
+
+(my-assert
+ (* -246070233154436622785727814428081917418 29761582253452470642591719346200231425423204062498655510037025199574178834762931489817919404889920159374886981199608181795387339523762458361385170203883094308920011218315748466148953320570427838912637152446837553950810011344492780712558515815917745810385725989241835877316836808088478276603934260581342710503593237081689944686263274319354100341139245512159619947319496638082702549196795236216458749363904150768879765280332386830831409591769966706351022328535490587838695167807967607003680703048770719240872629379640571077329748828739281770075441660330884779539288220944313294762143588847790653176774089774033399559617)
+ -7323439484151992757431054484912931979861244043627630118213112440051387392428853497035249623931234821362770902740177541812170377563064854590834087655133962963430877452052749127605572395112726398103244974178157574726551814002744001021805127518246639418981066588073652668879613252372759895389345727455380224104332342029151667860553645106555190741775758687650292791318963679857313030729683299101577207875499929500963723267185390425716927303375831321783415003339099100562942730763231688479910689887284950156875532151104047755803876078837921949287811575034368641167438367411569736575067233548122814012421044943430647665260439418887639347030312118291762161708906)
+
+(my-assert
+ (* 203826295936164259559522643510940430939 428315860474710981601019542870649234168732095026625500771233691514247613083810271191136212287636290276352210600151884730196161003906066671915478570992925366265552107746965374246537358349673161970290367972281768471743836339191023211359427335141701167253694144280251188008871929010775436125645541749886873478179599464478734149706121117222690271210887178499620737860802605991262799781279373870647695125320153193063528861104479576369448865373971847676465682752435142074973627172566791961541105525781297462635428308325033717669972726101583722868689418677558787287897456521530400671342257419067050354522203242849353639864)
+ 87302035331271280954456598486072605056704393103691656908943847729634903654600322194677794243221825233700566108459784062758955025931450719283517278054268553004951352280583820782976072352456972931479389375165173986780482062859853305469143408707179895843295115510597584169486406323435925707638987591151227843652210256611991940374072593149367903739596883229844326054223707236369465710416960023659329202073724249764308867733476242261506975691004092043954515337899900837434270833782490145948781128533218641649564543508314976001614187701395586824982250794852925954991265270537649691628899148413763865280007928191637215283244406869662872539567459561720369352296)
+
+(my-assert
+ (* -5899540498246269366107488541138263797694914692322476860852796858749106720144552037986906792251681094769894732746138541066810195167688318229720888479512583 5834015210744942902)
+ -34418009003174534626858248456163154666511779871358190892629413477534042866009573638264296461516598238780495750056279721797403178867717911762916049857737963922333901125535866)
+
+(my-assert
+ (* -7558198374656605586076446665394545534375963428962439959101805545423930654069723860456022097647139432324162475685494459942871728608277717748075653794546685 -2079670855873590264)
+ 15718564882684481784074014915267371190416032453294568239793060140651422710113447422494938907375595456199203928496644205320139985222135619659630853564447794621716315309474840)
+
+(my-assert
+ (* -9442744083812363570102321552182535031605446031706376100893354933468482520577272174689455502380973733378565213055641110431767353396963744600184737808983381 -7204974197101757391)
+ 68034727473703353914019458883709211780958983263702756416891835054494728840771498925306650413027883039860202168095834137357212487561983607389479135319040711944281262212918971)
+
+(my-assert
+ (* -10658732210276096534851972646242288663170038580488752611749460640657411087860047053151548660331707024718100598181073744715506934778234716535781332588396176 9193953347013373121)
+ -97995886679587166046252015742839992974979220158813197140160489510432960510418039749924861744197553021702396544307690217470606424904065359660871469041838900287446937257585296)
+
+(my-assert
+ (* 3330096979672637104536573277593029682675932033891010715180474877149733802060455951241981993421466123791200840797318740359792251505430948855600408060492000 -9413190658845804679)
+ -31346837782105095097578725347257193539696338226258990009265748336528353873277500144838721882313026604404426563737656928378230261942407473822851842589487713775609448642068000)
+
+(my-assert
+ (* 2224201331350479188470378485954814766783857696988331736807430786504130570570323948774102396158334805040994159865821844362926631687258969480929122732089195 10226747830478556903)
+ 22746346139936030910929166328517425029735137934434969334578972386859485783192993228082340012742115893176871887387993591191632260444955081663604449277961804869872353878963085)
+
+(my-assert
+ (* -12394770820700925077767705800588617445613665027183406054209162910642613421436080064653443098327137503596792411463268187212855350864330592654862321763110243 336135860956209890623046930607725140868)
+ -4166326961171213704571179876442248501325782360170764344978629523457550315208845439497110652079907652744850691289494398473488033083739905461347650605270023127087625641779424751335704552988710924)
+
+(my-assert
+ (* 11792778994619176404079667787533709801900490264171877873621265044313417667869688303207909681289642260521608966405181881416781694320672906600599581862090088 -197661229068721548419113517262926820105)
+ -2330975190212228827672814304508257223671550753091700552243633152084831515892056240354560520878171696176381845689952044935988868477421447557890739834031207059212175922089523097911477486879619240)
+
+(my-assert
+ (* 11608994516281296345925963401821217560860934641820086911326880657644311461955556832927259499969983808078591149768068360172431078248807463030805586293656663 -40654941048774156019243747229920736005)
+ -471962987694958552110784676392477007070112288398143925079396435246284471999814508543057304008480666763661066976653446723271982094424149279649226771823800871458389214002872916339341019732251315)
+
+(my-assert
+ (* 4821517917539756801293776911844480642406562140007084392649374723119190602353617113036081438891134008988421494142194891002983491670246762173236312873933599 -255528396376819316172341014108564420589)
+ -1232034741571035406264710387186737842510579499938716343220834781077329515145216794636313459582844773420679078031627466542930137302257934575129329529129776153159694412903937370462708576694469811)
+
+(my-assert
+ (* 7638751115643228563298483305056828584775811590562130101723525925933790010789130133831569153863129513189315440899053288261039147463032870669035935364282061 114438828287750304954799140618669114911)
+ 874169727255956505920153418854946321208907128396839975975317705220623267360648189969313978740314703015845506506608054761304647627635292132043887080298168302864314697920637105700927041824911571)
+
+(my-assert
+ (* -3653826017463740005170218884285271512636869606149686475539243914909566619638259666405831445823138528809165270360144267462878986866506114069923299116957450 215752050445782448772085819939961259625)
+ -788320455239949216234629350585027855111249573063377172522422069903710014529292638311216050777840734448624510386643245486023092483841464815987597578151663227035102742664709136512524899527956250)
+
+(my-assert
+ (* -43242564273985683175827997542883970694363047476880657467026050730764924897992516355909421962249292250047896135687573746158665836208681548975073555418266 4424346097667245771102179669235543742385176589624011161914909311078645828684936231569739522607200308028372644149306431599085361996722603718517735348761218)
+ -191320070498733614136284309000213964486426347688040889144514933290125387693498098446328694172047943298442181705949005984031677324306763731212307716485454004382079159622650481983102917517993601466178931324415483972311904823997211920702201161092866663969163567426868740120661073974542958600768774774949607988)
+
+(my-assert
+ (* -5093597555679260616199210906198149266592665304134802327659606846977583233938836318559188141955851256260954289429418183711191354912372372976165948043123133 -2240632735861652612028397136046974907251405868353380459030143407902436514978447480884513019736738955326732458088791830752499716417751919868492224207936623)
+ 11412881426559848135724717164530530041659963797467536748076144863846600718211858527283843975968920120508569299672573958424908957105703597501013710262110218780710678312197455759181436286391257283676806548463507528765947919856827004176416634630489598937924092540289712219714362500246928243091408698274649199859)
+
+(my-assert
+ (* 6049789822056553589237940133475342650218069231558204589924996117723031491205673061674252841792149409384720347601549237626288416453061224734057079515141650 -826416247951451524584060567988229017033981218652490450160817307801130685352465013890931297548015267655971295627931896259998420078888499206031390299169584)
+ -4999644605638856588581238481465237523157457201817697008198975191261856978252081380810200468420738807464233192102972784271159116426108806200426852134469939032473362689081653859652824862066224063273799612269941254948709760659691148103622071316554194507524610166457990087959160807415102946877307193349131573600)
+
+(my-assert
+ (* -1175978338162966145239180473229656000174129248706173549637767835154921467129547950144109700900405904250603515318348888619371004435353505449762899046094747 8633693716102199391202401198009047492431980605560930404972542822133579985462906768067706391388213605203282586546130434156768523403030127356256666478340720)
+ -10153036788469908062299722391986722149392791936544969945546931764708792252481931153733789787389051773529081688846141949513463792442701686406966696738286561777611293604311491896230769507535896070984747493738525389837795316954065260075941524322954935690803870500012809797698319359975893462672845329776468197840)
+
+(my-assert
+ (* -5083395547684319640767882199938390155755986838939007846911062687871291096073452055061784159768637502151635665247461348347470360218957222873087414506633886 10813098236568616588240471432239693891825284805405416395976866126102880121934298269375465735278296789484402954117593716698067735458182402220278016922449294)
+ -54967255432446073625448401244836956268872685687128644401372608170106281377801209665004925733448944141633739594240156882328181133879414641109484442890809130544146420476457200729843868300396656004198615619691952536924980482714767859804902602805398865249514544806725162402291122143659939645240358379962457176484)
+
+(my-assert
+ (* -8944626200084865988157251013718979706166428261352840753194709093968177704853157211364231059892647813839391802007588961807572842923682104089512428902387812 3814836951264415657788614449012480613328314590744410079075164918748648723114236698412482309581077603776489883375576245233128800002373843611668945838558629)
+ -34122290543331565327874124324135450224668275222811493728051290368641401807963502623692504750924543845019291736982354932620821594287780848608647686402233097059022704206628297180782771812500512744911371653368388270442874670230118309469599458827222162362901084328510647514081302476000779049412605744638457029748)
+
+(my-assert
+ (* 5186176030253526423885531264483408352469356233262336223619904269047786350470477526433506158542551137478071074193659876898065998079440819597952826155782068 21428324964794197485898135923805540163916541943812058590308650649384013587098638034673796533027113673143959572855470411726978105342739938341516634354246514986124789451866589211982659199267654387148420461876524076040233779391563396552267276880650559148637067641021059664960876301072636635299261389450890094318429077561092553337025096293793433968243940381587994428364726938534453507046761494257538813861046058298873206568935790790373886840765817404479239485444563488020955730741209738203470138117422899051269778988135668626686262669881048094388220931264751830393793846372816717368806996496715219806062282836392457741918)
+ 111131065300898907482632501071313138589398597291097276435916516379173430095773463468344138866282820740991088290299992221985607057347883717514843661030457396422379155394966857856069231504805779448809986906434617741485942621643754096548512120178021034054648207248963478122178145159262707381679354401629366698488021743300737044695960363216253889163551918513521913593214414139637549577618641974388739304727218804595402055185824193445089425262833385286117064481648652550355832014346131722965510192584901901111154083186713580209077544982897821477349293279848852596241762198202012197892321827305803333334823616660229870976569043453639028059771892706354703750763908127611939169337399882784092285804830644630059487027413697220038110815990084742241055099963659761569486906596326424)
+
+(my-assert
+ (* -12615422028124847936088012564413126213419674293830655240645918456932358053670311316461359727921727680491520480380615359506308571290338231702217134487397730 21538722931308708400287621200994476771789912594554241036641406577761480056366647329031140922034590767810855360008375309986798226712928670905618807986829790199948665185268081173685941421700542631395958882077936923141152528333121096909688700106365468854487023847026564219531968849793109908193037522063952753477768381591929787242143631287330811801315216116212154423972654430356675401769729358415036943501470085182304183033246682446978634892995900678975109490698283226559860736462409705544079080978470202336645384768211440438501339641775269445439018148409151795830925198162301321965042997632479354427154223366199106583051)
+ -271720079725309675925162538296715595434811519956795637977932956405490708202732964133816538801099235844279338645471102896234318181092598033040518838847055114923365599862266767493227393553801736813141780001130539648588341196802606083178208108557367013886856183999712817955194261262279080641101769944037282423238147653270651419282545398168930625797556638625301898893565965773914460998322350526545278664715332414172614761548301364063397364632709194713561073496860524124460861314674679928692398440036071116570829193414179054372604203478369755566003622621281005164747628075596444178089558747835994702060740334079222508147598079351187013336751322569865313532407367116553748939535664259669808534100091049960040092785009707220249025633808590643620557093069849490009472441113874230)
+
+(my-assert
+ (* 10381022953674450046578890619826448644067144294659610359943634722044183130638243233110364436029778310048006743033299956844491228999113516347401915490861208 -20974871685432829994714153210121536409377362402944992609230062091789259307033495284524234519701670462495676590513192861649457148897274608767543942797542628100823017887236899471151903799837558453043431373811892813126194662218472834650841742305925226558315372771353677064933578639099452438843500601586038910108679737480263349221244638463171088589123712367802373159421798288708123925853179931628847579314900787361946716531755600236755527982132768286927549323465697241340003870259800347640599467922823203446834792229595507968354687630029075884034263531531423883902851487995214646322431057626558858528344843531280263328354)
+ -217740624416854507100100919338835880277259264187442792458843251425095703739537223785767883764746809214920580060316177442387941385712712426957388995082877226019966428812240179251716274377143798847348759498926420314709056615470455134468678662646006408843897699718742372199854223008996321568642038054564397441209859567556502098420151667437837356649730396360374136203172669776530655738388121236079327354422138744456395348910073462618440421257604563050031602590345028438897601523520973759458890228893913090702884911857207117714231568437403212806578764580006787626657709435954760239671948147344463295520930250155876010414461245194991189183956653772752290656063730950237649394743456230607077768595983629559996700837383822873994717987698780007691157576205450973669241823945091632)
+
+(my-assert
+ (* -3984492646329789478973994496812455855595578196959138558282015917391108383154917581748539892089090551298072688793487597623310815918942283997753800645644511 22199897116873160263914990610762123553075230334116099569358672964060004245706770678771431369917479502828754815568950371273785689812698287446020480951417047185190067265849637510591502642000414540862689426343523077229502494771352820057572619644085930901096534031496492870227890836816886496090287321502805172125273822231241073590840684742085641304915656543831190976008986490532066597410386596132766422026234488163435487889876791504407434387555507637783709991326338482319227500686541368087892665100076351075069628862376686619537655838590687615291898971286325099164241688147975845320979841704002364545072665891829427213069)
+ -88455326811459002089798581395024759975871889172872668466370443703433800509268320055453743803627754859670391415348970278548381190662701716228279482045339649051139909543850883613464992501666524385524517648069873862957915620016943364950043289963237718026629805297916194484838158010754666017024585366330526135823515744339445036315966714684052345462172808299142368905939297220895721123725415007532441824406115746741972351142687017849809593982432484296719999502992792447259391592152463664807498752410740679664044620898308783634092355737296495489953554685938970593890496829484673393665321572846542839714620847185428664388282452532264810310019327395691530430185946743995669191791841546685206884247468693248673484055915613115527492005264289557719000245333079386593840592027314259)
+
+(my-assert
+ (* -10672574004830373997900438516438419278676753890756925443116289034080220708922677740383425352837266631691319394850521121221541344600832530724104047804922665 -7307684417326792807224298894786988180161884427390942431653062127076829842696634441114228528164049031680536693195116703321494895319862805505304314401000204515985676763063862569446064343853536464020413910728442475032187317639476018710375702206456631041987826826225461927793241495220512935434301833094232834266749666697332380140380619185254354273073522191066457437931022783436360434167505326773192959291779779370530770935758482422581712556111319611455306383173529090289274267200543081481693078804068524057891845603351773722737987393428313340760607600482724483853560340630587029610437280601010173185018227638972500038072)
+ 77991802747865927212086621295493124451256238920588746597961055391511562690441964216934615500942858653797884925704270904527938466874924049039962754703188019915846345804228044693122758075602494985337649496117180241872910247079655077012999375809878184011356481981590430241786534827516536543734645410817621964035091467871491521760928486006653992134635010794346993161329777270345449763927429735191213854873362673179799811714902439637861750855639857969259787075469241319618538795721956528400353086156169058060112255274542232054021662809196965752800525093125763127895334967094763817500702626282397394521201385439419885607578137159972521677923972708827090645776826953976605193554447841693259586575931864396484621463004541561908426383260772786784541411548146173991869741515701880)
+
+(my-assert
+ (* 1420855003086789510813111205540636553863493314684153860389816109865085846062678305775289632805233481596171530412925552158799875183492757047174905459819169 13897739053062356545217161606361735964779941697726983959749295377836209520566715597422965426908191354971972501742952706730523748574796773473606175934144970768662226027157110240776527834790487577863781140089347362129598158760833470434895693782503529955845076709376071972727346128409008293671217324995682020009675316075606538241192607139905488719485728099428376369506685875348346231688684483781160648420909364963718027571565217314827671844485031440079254478598236877074793221578612249882886835580737423192061550370069895525711885220268707201966615936769696379335772521903910689934596134239331592980694745008817040569590)
+ 19746672065138309742065153069587996891492444461032276894328314121573439684229636534026409362850111716212254549198595854140809664451286626009917828620279583631575940837712663100442879662416765138504151063632823014639305658882804073655537352377258786105147057375069447099908107785635606190515362082317465738205179108333064680370909383338688734129396788764959056886328471374018961975554190739706996184818378586233017775166959010668462907838359485424792026496574369912033757997469014639705459505746723512361959074802456098328538419933637295482429555127226978561859965498424173552676019033370307387047798600024901453757451579262061785051932535359410827170361533603618131510421439128567361259204833501190218719779570258541358012741265599985490513564378203502703406698160470710)
+
+(my-assert
+ (* -25117824099635104147178796272946098711514362630774369209876335291088434247131228189812265510495277875692804180473811834186270331245779845635089547499275113671007257221593872123397418355506777725721168216892830217596134983713752526559153149600553468865338887605949011743043425900799896245185282419637806859906582214420191794114207677635194054239563071023206500505880052007267243210206807805387341085613436600843317096291021780624738422589234020279836961194869688005260369009833026575446099544900581955685627511787510900479881434909308757027825050977932238481841909425598834367032841935054158448815026264505726593064239 7846111496222858966)
+ -197077248428250572361351389692146917243277049539013604789802566767174747369897711991559940484392921619974209620152008632450612546796556905740493507885376190913893140368029841033442857949219716681475253727058707723386016055991276120001690579154370788782636181079931076758384034193266737114305362492836167078199155929937891579224024229182935372106924021709421948701131654358516297806197381566809357458374057189773041520552821330635689748583803171230633654728360451100477472934847975252390985102859262992904778849652221553818627134153578436315973777720706502751232660284910468721430874674021521629540714057383398858244828214000543075116874)
+
+(my-assert
+ (* -12000343217458212092754251360179138661969968218789048702097501439124892987400633614429800307263114371624489988815324366411323242909652002510513570900627875514001409309670202055060404640758548257776155562167062337394219073071639153822126554525439988062676648294108951003012550815746564810508912122306190725453386412796036693387315128514162061147675205485143205925649214342646148112549805850530430229663418469577245456944558387628002442451042105749848177325651852669794048215063957689756465788955050513359977166122710392613631703123491357791351447110169966270916789849428298930624807758982400706608788793481972190953569 15463017349709835150)
+ -185561515374029078700596518575548896805308728003103939537818954646551372890610870275966055765608887701776880889777402229764948269089126750201922167386201171243298907675542965323275634529293654817279957832652909009385491998537031060285890512199675273422070784691446251899120095880199298512230290860589352290462643231396804350623684034400741386070220057232978556614620855818271117742675632435727751812101639747357642295230273344552327870600519422276996860893842363996198017494117619585153346745838853026029459826407782259598477529242420507010652705302341725948095720110508044256096963772599572721279996322424269691990173052929936294150350)
+
+(my-assert
+ (* 20244597897909303129995907707212050478823487084391413473821544089492035634291726811145005824559631386634261268723753786161463497881725871168747275110149007801865428978596190887145324535224079986377522166727137028753272158887188902047835658826867304220850429481233026043496635847568448251753504834367809877190895369288045026559783632709799678639927825194847005181499299410953860627694080906167346078299421796974815616608326704894611151743720515377248152215241639534004099341398238713597030368980166731393247619511322804984829747216779359780372801101821087516269912916462719248736442644433057333788741151270815989388229 17931151643499274580)
+ 363008954869078360197158713265773114114991766614027768774402465306840646219477262855625957403406166192075865834283840624408916170935610374573318606346031792128003204902147985329385955814330782527184421959263266167048755628089412213360508944817963403092490479480264538027768728303095523018598016863928762335410109567604756183580676503045557867957273324581082608248341332512325136675167966306268035077761004923732568405295901819511346235524577361289712297365403327125212199451099538443576479787130510546755789504852631291774614010584650672707483555436445926222945298928326313943231688436271883746272589347954697213098866117569339490918820)
+
+(my-assert
+ (* 18134862906191691435095953372467318196853760384894170022863300447691250350836421337333332682828557871096554531436829166444150586004379181099133295174348038948038399079336722004125999533719492457544642570217406286811480006881054375314838605871238868968956868878182133492469763282800195060849734382249696543089869191257451321764806079423169235271658993054867624410589213892458246001270123109841429271429275464249821855221014782727398959126117031823977229309775211695677345378510417534328974531801634095862859684508240122911023047425473036305928743193594967362216559973174709883576295373749738633873828863608550295977368 15082354452174510460)
+ 273516430292774638949326170314933525797985748367549139070674899956657807928629067317576809269188258819686207094298714770978509118959142516619521080722291318367607601498107007447014759288176261262818034997399866363248136237609824401265450913244758024085739876914482935655100890803279961929047974391299795570244708811454483314898873277493486428279875241232025231140855860469097028388778917980779775554139507550577255217032521719099071084956515691364008526064349956553916033914728254580848198941020806723485184338914882588931083516851849558411503129184026079582257756707601984686901646494090820169212279581209612798749779318126482639269280)
+
+(my-assert
+ (* 19213874382308276075905228027166553836726993832150876980655958901416537033385379180983129528081628446454583401834309285184752924794893846406622935494758142810049493348116192315865522516744262115026742103678965417868790607689989205765793528434388393584537260717130892518011447327847533083474230074174308157934463971640826422302901570010591182715932658037868980053012095115562188975692530473556182305847290196895478280679341869546292639446526021874910117953225154204035612531584978136604161393474554294315903436682283787080297348697922389355209790646124024053098888687638640826064745026930980189268652291562437512941810 3155416591710364359)
+ 60627778016974262766014671335614995348970065077989108071534610098195400001445248886220725085881796599270026085183075312353388418711598523030563716616967792282609748819081238929738105086199457414615236966895805539596649555457494710621217412773036416007129418290246899690911654008867819945724649185574237527152410775686803449108977881160831441280833577932476667657759420192656716352190871667386955409426879693856001112340390304980532208752863058384169885129364117656404549585836664647784765508649117301622797243353610345828189312360124462238989888436478381583689386509617357901461416012201469794664889076397809504626996523928173064949790)
+
+(my-assert
+ (* -6561903839860415551587224953276060627466820222543175464705113686962550773423611522044145975606965294164125376820288981286542044306677764776675868357117109664125730405280822770267329297542599719353907954399688197248115043785617436343303277493146049939491224480136371029084354063731401026459653680017632996944506546122253686805764620116169065663214526857151412139439538335533979733329962892417175374550305659302592107472151941922230309227785266745974334776462642676959433923828440435340579340133192678341787895007461237846313005612116885419002449356480017828933592324336731295317076205553526568668826499450826560670163 14908715577157091280)
+ -97829557993133908713082095435440645457469053259814412551982534425389603663024461131358343104414088618618030154957456050473312402460589893359522167472060177968099538846750606564761307960896264958539903740023783283814849937681270591589750181462708056758506230073751440847913386576449367635057595344744119561166438538811561109125506233466453974371464999669336530949393433719456191822836826214814780222021267726528396849558417851727452246676857867278196266042327956933753121947589485377148388716839519782819642328655117625818256334190717182923260613562191698788004591479576661108985313450029332968584240383859113741485244318702724563478640)
+
+(my-assert
+ (* -10378013547095983701124686671659666242518351347561698092030999302329372512356819420877395264401390796163955327080881297568412490286247154759694714275858127906305200295043241717769593877683535229411640745872559018085757273530771413156968541499388413497221629366848027355125816131586610997516488552323667400115617175682996681969687885201321292153656071894385242141321468096793766926179134511319941715949712230831768643024119693594235207988046511542691719002262040067921088838755337917414526554050602539873232518619281766327369577617796816586064895744680567067970817494102948032924671421242699225194947982378019119315136 30004910492448871409155105619400474385)
+ -311391367570036811050052853596227388481520279736812036769684195465110674594690412517879149770622679377262288447706750813509857551308594851067359841826754786725926298013483569424123912020079066150719085450400229896983461212531213110847425940968466564079253939695853896434719530729030897976597410468081535234663568150722646854183317007227669132983719314653861536414057481478039579810285535699518386214012059191958557306338432321511585867535008319640705419431310336566447165302011113284064246284641707577414470505948868362067233709611758700034131461348997580441628136979257037186480770286846026250437141175360847735150981343952303257191661069675154710791360)
+
+(my-assert
+ (* 6311357747888359229575837883366949670125882865462293491587368290797766017168248637163030339387377997726585769250585768079027576213724941259801478313127113803503561717311996500019522893295813684259416551410025111443510215766297835872165689077882298506134885487991732718254835036694083204758447948541157893533099634169589161496492972953698758234452126564385255035294546278732684663873459439615228706684138982066055370429797835904846166362278557095045056472775166294675997320598469599722704075215700819354957397052721573993997624711445698656580401684113096559767093466880001548887739825916626416328760047783071058963451 -212654096583990292869707082365869207538)
+ -1342136080095566600483524091094048745061145155430997807005186206704767933140306297188996797343723817220160636373424666345108189275851749622201429179882167381735732553825696482751584102093819432866729465599060815670807282181979889263381844726842751894916887860819210652174987999919869623292751389157233409465756974677789790982740267208982768450215563288024088369480574425410032306456026930809228182100949940216614156925537929648841127727165386031716586596638254705402653861723407930666152691102484352058909219619985877341630210918347460471644327858114815713557305185589162775699323253049631349906791700893878999711846225062306568467992135934882289075693638)
+
+(my-assert
+ (* 25104391676237653962996674810232896003857294806799086059884413856421530328279649263948893056601611073815235439115612155497964541323584159786678357898152394779494741995735881624055133443980324145256438160990490767324719276757840825641421547232460969806196141938571103617707677351907526127993230143577974386169402623023560579220343920203666762052525898442578990183400559087522259053245822827313206196194989095468393682721753147596892214609346047051670610252732846805143964713621673722554204896154742594858056891979146566683467510164875593192581407047920719605560716270697985110227952698114701527191421628561835164291236 -205991315859231724218751687295926841150)
+ -5171286675233738337789203670843122752625713948587464573381323151628930998435518250812603433784823922283042037694290795352461861058217142213862777203850665369756106838860420507328654214723398688455622487003912073924323587826356928211672752672052670663842775836967587150049181838707784871641183683742967716787111671792311389517753578360293551031540853470719098360013225516593755039537796518619542838794169319227197212817921098393499332268929332950035803734983497370378852859829228973012039890600437082235032378948656232679080766068869430262740600476498399803176452431728914806536862849281928869092524387549297345184969051926149006293586531930828748109161400)
+
+(my-assert
+ (* -25971587288596053786734900662696128734726180676323130693160397208008930123341700520454723462226657743365779183466120836187720332442041321870351823609046027805781414454998487673927365486893294110931852680018706479684281928396163669935417207859889405108139261480861908067489849403284000981453574189898304616775302917687860062501465417706095450121596418236563421425311420755550335597318818628123183624214438801254105808079227429950505879366254661664881055965092586612702279548151277733307180663770432418397550642136953750720624507617115504303570076531620003848642167562950736271141440609700821621532583527124386811144839 -182748557863603655835821910989658558236)
+ 4746270122419629115710902425435990509747636609113505336611751359043717100752575149404352359855260443259846554733621122684788488984010741203981300775978945529551335641218319619542248418128319220383298229263331638090009313676486209764655429828385994626323209879925281409485074778611946493692237774852428345451174837474328995186242262565013937544898941834362941815633750896882758939509605799422068815435202904271722442099465950700886702949580264958171808372530471918175963644209760378395316412115175988232945569517230829200985652504383431054550902852797293952515652017940918628980037316292352828228005975466732028971159947131994753006597870175664981312344004)
+
+(my-assert
+ (* 2117427896392849163304163145095251890404997781812823978967013619233450901604407363671467658244435728579079751353560538034596183240362499870272373308111405924505741579887345118857908796509418246599428633956038017783178050402412769812823236255234302205027282366926174916871858199918908361186936687654278623156607813451034087735179167324944824913226799346886951212979149617678949292799645035425029596869092844906629996914674904522806258932192931217652241231736891642224851547474205131131019084734780208254203537633402057673465583362982905095029133132240839391503135932501785844503813910210348239157828902668852795945482 -296778668392678698960782643314222141731)
+ -628407431508980610909134894336322264939705333430111861505965183839156278363647883745193463537783397824947515214540990712455315080515980803996660089847066076833542492719707493333185909990202372284811233272987993068106356248349054482194817336258302692039392400931536481136340269417905505366385505196886218794044229758585631131853635721528813397816307666671727692971421531381290925317161326036075629905443938124481334173158440927555118173661486114828362551889594188958723424604273078091320087897088472418346754088900034854230711982602435635574895960156993014703292551046970069204857846207328434544990709459402656908170089318995291341536347275682867153109342)
+
+(my-assert
+ (* 24743327715258194976385899813930363006464428087412805068703455203318769863096919192538751530954777047772548306936907016751357570434930538612382851621309732767199276228580401695793317612267605312672263736938703887622824117576912830029817460033437752668221355377879837833796222831371174014543622739933433581963103361464022058091243110136610854806189138108937004805781857031030005354158991203388998364340053773883952742645161560754545458260688560269655272249435540890073696261770299845722705104648358053080678920468895189601731801025555650490534399590288852165862135571140382055044665678298182909026026068995867606241201 309156501491030456401354118244509785044)
+ 7649560631695275371386748526795333430293346807872366006552933839286343590101586516802834568317627508914888989005968805867728947519409222814667350103434422356009252082456906520988877859152125402282765775845766265340707473525444185795403554160270722809642681642831847296672303556012796775586274347178092325226458743113317655523655255626670958156216225968018208281266858684283741496986683426354716284780229004376492833583965647875097951642088252875535823145900129967026856898970545720526282798418382467634180690243423325770596949644122541224189780082061715230852249880601371985342796525016176048518593825361248232406051886794538203297084423942036889326397844)
+
+(my-assert
+ (* 31345149697924857384985323414506591310628538098830133854928154990821019223495435414394178930529373634315044777562902565397455028894455733092896622048288278424884040917250546068175763309233883078972879622697667174865833277342334219810618450605650614585133187005110148963483824629405555603493157452295284935004578187488673124814714326405406894084902824045787647963172437833905574178160343833139650913077173865287057167288286708807322607983179910358234015596109655900840652230258122852488289951986129788952718105898226951651151495867246384586164892018870981480003722043190639707903266193064807571586900961788679579912089 2067227180806746570739122295766566373146995767544546241400900414826379465803168632854028593293108913670556431832056563218709444199286888840721753894461468)
+ 64797545442006646811970698282511426059102976298051534827345388707272469591333019870381858263624490336448197115781363489554169207652559213486772008013638214870324260793199674746523791257170452738018910619029072942848422098770309928561867618844814267276213608306045020686764830302020953883994906997293368193331696747777630621086600981981357507299729947717565760536305785574555255589190221698706036770081438750974356437738060098906046001271392354762036427049946092656701257615490057677558059955825843182799904828201890893555678855718728417223845757559310912618029462136640226686626513375024547351747669476392735304999046232068947570708757930233036922714350584650744960478326257916948676866148362166017752159953504981324652709881831381637989229842766220141292801807437886652)
+
+(my-assert
+ (* 1965759082776833678304908699214846485256126608825750175641683294458978302204367346739996602241053060915897480812220051082619942907491598551933638540412113496542245474287364500698693202553692963910123752514310355402167440783023542848697962967771951714434359320001430281377747193083851165947498546085410216620013287853719686698746328198021011905482303248172483782066908570502837009924228011993318265674390462360820566174204659723461994730913995303015012684826295802887547970851558451858623353950391701673651959262042520584275132971807158231859672678070714276061110616753309305801080136339206017351200193800253572481467 -11092241138073130060021642325471345789108575712118027611362686690749327689527135459714040658411176246054106270789083336195599640521602432629024562630323934)
+ -21804673765518097879589124792137157558586438669762099454880024920520894260754279593873244443852337739758694535682558790532827482894104906218015712179591886600693703465749571299271429989154199263793230178266758966678432691901731270899259065726530463438316383699558373053423999416350780342222940065486831353604365192968606300436304827279383661172824549131179471364227618431414928702407510473319879188990689163932586727702195573766225861364297410904859137393184592815970592502081722125458353280743087607273547490382023433724488604177909671497082747464946083901888849483505451426245881736990810339421864101129619181017696837017966116165703320918568645290788634265522956017905246042460811062666193790657969385648522736090098231379029903772234867701846824572274796526421531178)
+
+(my-assert
+ (* -4067457132547237558852016696244696525033953641638067592741078194074861352472861925779476293767777560910963786727886946479865734639031042985368829200802420611189793957001730656623744670821921724417176679009632346904384261431052972127975733031277489967119978909321422086102208644766894305071609385305464547231057263658903212521469801833214062476735046735467944834107695748433481665714184831786462886261252526036621257865158497049125410241033365487816324425563483999957660557670189397770488996359512245971368638615503320507431381893539767352426795415898379765583574977542068222040889423739693921998717145084904555464058 9635268828818063607505341812331931088336041632536136269505180222913464638532245578488168867093853062326136774925531196873279749483997619950077042084971972)
+ -39191042921786100943542578352486285322085069425292685238158202937549417928185097567102615300826629615520476316505465412722375794150552330462353356124896483739321653441446703127728441315609093330694305784991844511900128172079464896650958648496336601612657347012294121239821167759496102233234525084695798195547141521849769350204659392602605928907953707277320590923278178152903602506284861018886300148663530071056792375593665422754923886137410482547324901798328311927545105456397213670390651819229021443747424183114992653572959318104053511452473611466305149349027962240989590453237778130260105665310067480846969449221473610614214933278048389171979184119355459010233147440293881252851501522689209874112819966647846701257081192324007280573826673895648273593609466000383382376)
+
+(my-assert
+ (* -22047771987573494284336211037167956208924595972749016352929724093971147687332865088249749580556015503923927321586913446367676445848750229391300778587369581738560634537089081840938984779012854694220894920437076215176060179241185151442003472788530160589267677502568156006531439509890061829154786579353177129190813899423306499631144919702707240832059008168851983259611724134448165201725432622521420667808597545410136493805873769372831833878868603946583848422310946469083400330960925084024624317866822897278934924368888332618046649078771617892961267312226309927786691384460940015979582201446635756024251269978545916298961 7481502540911026808093162425787184755732317118387068406204973030847892995155568099553397887864257088525242568880427634318737874025160499293315047534753494)
+ -164950462146458057264341765173378248123415893870534274075422323606836246718538063890359159423074703472625232511667875897808555123518162244263016096627959208397334135559180524195701526029092734741010866589515172934676451385008535538102832400604699294088534999994990970130226363762230944961249818769566697211068918154629209895730969522747736738946126971914549491889482944152891334838234907190697109929512401661529882587076352559260375439428815896053844621297552401396168240947357044985051323834074355418902009161796886350497072010833513601114819625605048943438304411954380599728561071485061414856047768286383287807924135081902458690495890129203192613070824670256334683011083767124852354110322463725619194174195587835939047474059288568764831570274891727391545546467943319734)
+
+(my-assert
+ (* 22607201423790553279447786193696575272983924506336369475058795405894123712509544256099524616893423762658394830755129501447553593365768543361107397299007141714383407862976654294384881771985218996697067215804348472693636567074361380875512341556932579903687576929186215185312685712277482751425466251201421842248749944123326048360909954588266368306843116245625635467041934524547983478110533044085242847795585598341867070787331785945399446665919396062565614516404861115244243161694059679274045050270546536781907061002623188435269769778378780371158624481539046590932125320888745103158180784231722265376331553893647061533815 10075764395489719205294189472045365742345400155046712954334138069917417587273618147303160957788995022989479371576840422540097479703418600112174202202728054)
+ 227784835187493343385594867881830022845566753253174983274076326016001091958812135049265213053390506720261776960833046225700903422206015373488419693650378821159134369608830936915027161415300759990632038898164509761337714774392506802504397626551196717184785586630245704512525844329038355790338277254618639554796026366029578805283659986085947726260520495140332204643887370987929304924491772630534558682402396784510750317396488402942581973350428066695976988812610467654886227733900635715495731445319565054848075104982244316563526232071957624002266648721592744376122065531440026836549316222728280595228806728872537793522244957258060730038589170810090676474272044568671474692128168357087077816573419470273384256552275636517940058764711467508281344270125535855785388198570146010)
+
+(my-assert
+ (* 21997874907846585575969651776904015812729615626636027149446399573806943459105370044846476738175828244018281160136531735881270437472624605280356112191272531838028896521621800558410217146758345955334174583639352151367532676985598470747138461153212653362188252002768647808852054182649808145379073620834551216386805267446360709820441771932135218282126427988826945094538034579367527908530151926679515746133600376612899354099328788736038811470295396365432559354070365548930628714861826464935305416998192532029724853617023971964507955475554955277722555849603716733374588174421463022213135839490633927005539569058361144905451 -1400498192750070094581812894241996480373581610489471746158083224360249880335094841398529960182484181641387946900090289855375996313447832474435929084180606)
+ -30807984052781257825246153008277875918087659020905755686964119182052911551148620538090633516362197112383237624321406969368641524681503231262834662890145617622830207559490089313283375890353617292096501953380469351747504928597461154633889236826060654886877907382241867167198409355653371944304660938495445848950444683274236538890057643038410268234731745456035923559528706349316582901179686671568504971088561096469997823300883298811440849031903066114422309644669680078733839046643542078157684064686933779591609758494599988463628362190034612412739669041368897594110022347872452261447359402810277413572637740870748949093642723240662839444216981630862346445890780016393330114883270596630385367407921496982236074288475142085411632630374714528706189796772213264952893973677883306)
+
+(my-assert
+ (* -270155241925436273159477510619232592261228150696806729750247050 15545126743930076938536195287546926534964892301082800206802745964245668351235397 72127079799316080210744562119267314209211162112457416152560774669179705347659265 58427280233475514109627698916382980237252687770812483048907352594138577656301900 91336330475502063985843547526216808965829995610054777216888670176112782119332811 99495081134815818196404370468895496198561677002653930126818668800341380375657337 6904264296552316628911621065724553059847235903647375662685025031963599691416829398469283631386160328944460790101458427909545198569619131058877708293713734 -16074984786353617526516141164566295497596312655026144270863093715961484079732496604871734572736757225277596743795506589617891195569235287256031608792067121393492186703333733526879481948463529609113624075923052999494363547340563039654910799974388353472433635130983731604982117092991918514078659590068643956240711810902756784590442416249652077644077280371860780741318193975770906075446772544431670392964384669681404295839302410058434872964315897505894833409101781069230919347279857855594782111721176074849502391457684148683668165019969667481755384384017844104770253558111588611189351637275389688093074751942960310850074)
+ 17849860827147993486644896214424106325295064110723402251474432199595968349198253682890653243676378684005650871261983711134190416277366473221365848417375107498764965893729640224952922241531788638514200018520970345581414705756736222535562338748426356003659523260330725662384208724142177900990027225665451069059291754155591197426279006090296512196415617974140965334686090032257444820748820516976632201388937358434205022475303705442914044454220818215336283948743042841946229853366515552653568436171217572212088935263340599371830215580988184775240338748954666846379831467518505260487989636951404886967842600777836444030434816421999334066711024026401362115623932221335906548647785232855815515579448393689650116225664467056283988125816950714780486880294535933597118808163054631168063568847830481653855357008353733414826165759079092633441356914450038756281940532159493763482047244493174370100586359619040444818634156576789665732998111907245928253704097384811414269835758656988678207624731164159069547745777423464124959379113843649940896359346515513936964849811155238140671698227057228045173997904545787593258286212427476788605370334985423461194148838623911634821153061693257996982252745844329344589168264774527631972524787804330730506700000)
+
+(my-assert
+ (* 6411564443509812216548163965666668398784964137255201222920640150 65325385402074288043601436729391841747319174569548241717675134253657593233436152 63305037198546989906433329294566491017476837189978173607681765241525113921707860 72383582945810879300930057856704905379805338886592055772943486702915907397618845 35525980101796892634292856352740658817031405780112750352735419884048051630180860 47579150292602967366908574298176357632207539947399443701205872093150879604391127 7775494633965874654516687741429737470333189902121089184439228657893110997221737422210698789286625633365548095171257583020272703565350668755439139356570 -7847653632223099338936161226557020783515367997970448568586056286591257384101422312757649765574456754668588904917800060981155642916520580540801153603733496143328839018174649200566737789874193483124577734129346933208306772618814806884416239295732454033604210880463262467564639515484363761639994642888910703066277724414372379965872478153546766131136324967950786993982228851928269842355632200589446224738709869729930285189047112131897218464505263042012855229737941639093204086147932759923796947642895167078971517834730472596647456786099215405165290569214043431009370032818978995463168133051136053246705694337584724712230)
+ -197949741939898550383903354028842356745461597695099989904494711851411610441324234089773644533872304737431480244289438922163630848266242200711131210228027234579469457105291847132071566876246332653149194709623963836885480655282595345693084881617726426841183231475364991154699746506928116505297453355016975688761948609740314324443406930215518937775475617384099331839748494157863510168743547396262979908353122625808170296763676837551973930928848463398657587603606321137626467028732193151671337338929938959296176472483674270114824853018199281637976410726195357458134038379491704909997939715446657856320452698914513791221947734373322868574099599391493563479057703049036936132407025278683219316357543078875410080612067641232277376174351958080693019953378024732243763129075732499165068171168470237875348580987967740148512425201518758344757030205911031119619416763996490581551977913711646761182756531618786226541010835120092904291975494846126923510483263978074437667987560077422810120462938292680423746968095994108344184522240467647491991837793653579480334442342102339933473270535800619630342940590477752278184994533764839125736268376640933720554199782388890444619996919031351334561766248781813883867406045414518951152508504891407920000000)
+
+(my-assert
+ (* 1669833986019218156514274418186396165434871163342486930502417566 58528969848472951398118375496887849181512821636583415470809040929690124231959506 50098163184827557635697120379841225459445103589988345336880332217224622666020381 90445522698871905833766573423181067004916996574451008349087758531794463581708977 92366726802191504770638415639612204654473958526592425718659284841373421985393966 69096133232785816552402133765198624674167660496399099321713067612475604030259084 323971624832697152056406152359288553860210436839331005469891386690556929684663075996719803995137130737141925308417709520389528780839777347463558171582753 2635514624483961079560488004237441873979133312246005082134175818331132377114926863102436691793380965631848192666106793612266994709357524826644421074908075389316030912936338175907209987972553710900613011802455058538786723149316934049388525865455871552882282353445228425640452635081303490379594663330152071465360003249884180020993032086861074931796165970076448856988084523672973069824258299029863033098237556417571526135639288006133579174344589248428714474318969988990720790226604664141927030250855550010512291136517209169959021730625428868037074528890516086527430801590050720467893089085308995719513895962750896813152)
+ 2413207990093478676325592386500172980330574558867366638913149256222218924700401110600319869300256745035993991818342784487193857053589994816247466074246569162659879368383295411190237107255160498774228460295857931362161062884154872938368166514128474751716517750517217000290486110198899480877593169193610813452614906598055909439037075588626529658637140089909227353944313408987644743661503976835580507054926908821206921014266535160031749397432350114673787218438589065861056449106115395189057409933330355574558853874223262465965933679584884152813357065227868165556818717270584803360466149860292769520737249610469675917864449261901859162854558012721179400237645357401213337423255109839806528503425658270050436129019270883446965562683284298538825840361267548675967778385927410390726055957928634152514415917053614892441910675109517307682075989998558764742821214685548219206933043196677521610851950501225469125512893859254575460130829051324112015464552874242522140166275233893076603452098841950130740353331198999756316969161591691095397245996664755249875720008141774247384884623389430842799829690618405724986702942913150258769060684255363816662231923570491001519802836627028431389746450987110456127797025006251203111629141890634728548553728)
+
+;;  ---- Test von FLOOR ---
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7853255233330224291 -3336928547114505419))
+ (-3 -2157530408013291966))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 14068934522023857270 16292006600125740074))
+ (0 14068934522023857270))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 10985143198741137410 2820546847025452162))
+ (3 2523502657664780924))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8108344024060626734 17657489924906565585))
+ (-1 9549145900845938851))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9793321542618752251 18086526939764980195))
+ (0 9793321542618752251))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -17146297557940039430 12031974228591547856))
+ (-2 6917650899243056282))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -11002425733929018635 317353195315898710776749437474283191162))
+ (-1 317353195315898710765747011740354172527))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7045772845268193739 -89864936462331315327547597221973588375))
+ (0 -7045772845268193739))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3519209948682231610 336646025916394184314065151550367317320))
+ (-1 336646025916394184310545941601685085710))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -14043580588957562420 -222396907959379818229719625081455476397))
+ (0 -14043580588957562420))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9551193686327136711 75278849342865310446781730521816023755))
+ (-1 75278849342865310437230536835488887044))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5159693807678286583 -271047212583781769863421872046042817014))
+ (0 -5159693807678286583))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -468628810409465000 4096333242794181573565417750313678008664626221486481835906739336082806890901464399325558358976385254948318232837795406709018062193288308568894691407903633))
+ (-1 4096333242794181573565417750313678008664626221486481835906739336082806890901464399325558358976385254948318232837795406709018062193288308100265880998438633))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5244261521146873643 4921965954460062114436531997676458648483262898583452823054595308486273272424691697564822554202559195140246785942292198280651275061385828405859241079703409))
+ (-1 4921965954460062114436531997676458648483262898583452823054595308486273272424691697564822554202559195140246785942292198280651275061385823161597719932829766))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7155077620310044967 8812163272024170253854686552273644496512722723120222844613502711675792665532423218585794856067792762737333036865054171911349107383532358686613366666267909))
+ (-1 8812163272024170253854686552273644496512722723120222844613502711675792665532423218585794856067792762737333036865054171911349107383532351531535746356222942))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6816314458740361202 12075686527410596248188273566406493470578404199548730085391183041200273406509336777783445118538744079686672261898288597639090345296674064493442338947240247))
+ (-1 12075686527410596248188273566406493470578404199548730085391183041200273406509336777783445118538744079686672261898288597639090345296674057677127880206879045))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1890766085089344496 -7408951123352997019624764400646833541081866912262454311449242781355699966135127365870537542305320515188627454777019144990896651509964466134772403923321917))
+ (0 -1890766085089344496))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -17760474272160473768 10671898954663586353020741847122236830297651230263271051052178674502913972809415507874936117140992859978582852208528956402833042707438860216609301338079639))
+ (-1 10671898954663586353020741847122236830297651230263271051052178674502913972809415507874936117140992859978582852208528956402833042707438842456135029177605871))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 17203040353218460773 -2087162439393804055245476778327445230668947133920484097696589818636894139336038424853265430700117127209095408439503149361955520500062568298413951113007815520417010757436097548975086796164496676384718866185751276003374984886645837833063272909444571294955778352876647505220277070946109654595325494251711661808952794932834009121950804034627054856954463330684354292113876259596011570415522831755074832239680022834732540878425796300024337145992774113324576942861121693541507092307262607720008434123040550199401165667835993232451530119579950363100932584067714571588474895040209606410481479858029354372704983248137195749442))
+ (-1 -2087162439393804055245476778327445230668947133920484097696589818636894139336038424853265430700117127209095408439503149361955520500062568298413951113007815520417010757436097548975086796164496676384718866185751276003374984886645837833063272909444571294955778352876647505220277070946109654595325494251711661808952794932834009121950804034627054856954463330684354292113876259596011570415522831755074832239680022834732540878425796300024337145992774113324576942861121693541507092307262607720008434123040550199401165667835993232451530119579950363100932584067714571588474895040209606410481479858029354372687780207783977288669))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -669078238914427842 -2079683283534812796000190145696654156804430677578086735229530182730363039425073862859919937645919418081821481495275802097707156965850792454067873053943961704938117974314269568411834037549827330778321735965757574814268024643310969429104824266062514450939201453648232801402417276979456869834703061150723202264463831469016146310260625377771326468627250569024458585844135123967133684658903385261562998370487428947011971199332502829621504477139578507890165895257527873153869666215808793006714467381179632834850697420959155528830942491523671012905291756947015477293335637719271764878661266856465788562934083754663149622043))
+ (0 -669078238914427842))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7327608361251253460 -11696871058150243071087622230096689496181624466205249401376348902965608647385664229774648233384515557654898456058685820740766304363182039373157014626506361274439760335671626498691756724181737933201816787306863365879304649516313681157144055793349950077334014446025781487249267998958541998722387302987853596488202173446477234627919885268339967510098356435511938337505060706688248914394292741973765745281640737883810857064447143652281758869836897346742791897670275478332406904414773228555812810686551346417028168391700814494167715137071887755902595471083839770070956620494992791342919563605887139693691074220696797086954))
+ (-1 -11696871058150243071087622230096689496181624466205249401376348902965608647385664229774648233384515557654898456058685820740766304363182039373157014626506361274439760335671626498691756724181737933201816787306863365879304649516313681157144055793349950077334014446025781487249267998958541998722387302987853596488202173446477234627919885268339967510098356435511938337505060706688248914394292741973765745281640737883810857064447143652281758869836897346742791897670275478332406904414773228555812810686551346417028168391700814494167715137071887755902595471083839770070956620494992791342919563605887139693683746612335545833494))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 294675307927425004 -9548883545732446060252072829565833006884749934819836721462955213854827688043000170303649263042149519854567992890424662453846646328000352698376041008580371118805742958892669824820331301849741711055204656684075622499980143446475914450482604391515448002257899292716976191315018524528823574850034894770209999447615978958086058881855069519056370913875205852377738400734853568252684386414540818555760214483168738870291995504569592275824832746669965860852593991220739290892286776371571179317949624919667076576237866033103387061005489130212740740367035039239029315995502459013799346342754507246725497131746887762156527202924))
+ (-1 -9548883545732446060252072829565833006884749934819836721462955213854827688043000170303649263042149519854567992890424662453846646328000352698376041008580371118805742958892669824820331301849741711055204656684075622499980143446475914450482604391515448002257899292716976191315018524528823574850034894770209999447615978958086058881855069519056370913875205852377738400734853568252684386414540818555760214483168738870291995504569592275824832746669965860852593991220739290892286776371571179317949624919667076576237866033103387061005489130212740740367035039239029315995502459013799346342754507246725497131746593086848599777920))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 14347605674351973575 16781108313723465798753322947549009969874803839178924211234447140560213638432451682705091051257464849827979202356053729300113370530117630421654608371240669238603643549128642643200948947465613904905607632005913664436128507306181734648889038561843797684348733053132088104433891457988693229945931772136047702319895617567109469705064237812979865949533824478284021673220084274688077361876364538071423609125747407610677136416454538389383594373243559248761308999294417964846813960148782443892858983199711111035244418968070018974928177662516580063782128203214203321005133744081558995859628472663680467632605080081460859254457))
+ (0 14347605674351973575))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -13687180458303546035 -19965807258690898827399047857329749541944041888361526571512375013574840494217451526698619297248029675659091093507275385543103914023886879938416253663550378748995953654394575052030527774451712268159052917447058332864628753215292671454945836228787137495936035900814206996568155366945096185932229795907560606361081170245972586794828085080152240904698184990372898689089164281206741448028676272453255619644103230837682506759429084083781590844603079867247577101977877828608823440256009103689824572652465343135798570848914557962085239341382269526989381779235955669274286569338275810475113610787290242075588029043316765795281))
+ (0 -13687180458303546035))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -18925243707105550517292233464727657082 9190307209239173280))
+ (-2059261271274988371 2728041824926269798))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2268729715267556753620172461333386061 2091801429708129323))
+ (-1084581778674907194 1902605633041663601))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 240105871177433673480858499581307555362 -18137436669813972164))
+ (-13238136984210147236 -7622864679137983342))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -262280851402380072992262860428676408462 -16900353177245877861))
+ (15519252683754978805 -1413263307002672357))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 232088877459084367318095567773397104766 6879279671528853911))
+ (33737380734733937751 5401711328350210605))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 28127709642032836544705999676759725409 10932535648386303235))
+ (2572844081801336427 10537089091686284064))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -306937202176830380291551701368328539229 -296436198830834971825518518346845101512))
+ (1 -10501003345995408466033183021483437717))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 53182351345555180643155906117731554036 -239211638592486301383761475381736024507))
+ (-1 -186029287246931120740605569264004470471))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 280879521805922529084106054377533635149 86259942955448859132329436894499980462))
+ (3 22099692939575951687117743694033693763))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 270479016313808755540727122565065208981 324912300098276215771804552548480817149))
+ (0 270479016313808755540727122565065208981))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -36931767825051824504116995033958612864 319307981922121038618879980001580483695))
+ (-1 282376214097069214114762984967621870831))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 107405040163562716679444439233633957914 -141652913538112981614728925754765362880))
+ (-1 -34247873374550264935284486521131404966))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 184790583924323275311064238756309559899 9405763068924930772523308542613843828189472529194204592633223103364008985533829727911596099340788835060163612329614413033927995456162272921833539208882402))
+ (0 184790583924323275311064238756309559899))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -232146313651929815140292892576650425884 127874042542498530491272428412953321188339770863893691736473766303033699167382382296818126363236257463426694846772750451609560841554300961480864245159756))
+ (-1 127874042542498530491272428412953321188339770863893691736473766303033699167382382296818126363236257463426694846772518305295908911739160668588287594733872))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8728026917336931021644334642968359261 -4025737651718879467086249421940400743845718511565541383201031450532496911741243591880148294568060736532264934821412351158153056198557273134546519285439196))
+ (-1 -4025737651718879467086249421940400743845718511565541383201031450532496911741243591880148294568060736532264934821412342430126138861626251490211876317079935))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -21247806463473594155821742168531145877 9874623814693251335287095436063900170315895560443374584548447111313954604343515085076726174459237734570523327188441412904116251434030306488421699399082287))
+ (-1 9874623814693251335287095436063900170315895560443374584548447111313954604343515085076726174459237734570523327188441391656309787960436150666679530867936410))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 286071012976663674972497644839812778135 8117963470049102990205107814791130105126121536354646949522748212681559213640860255350655907507344188574393108661850973221437234442503731759547377868482253))
+ (0 286071012976663674972497644839812778135))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -31984072490103846239901254171623218449 5692584577100138206704178766874348327662006017031045734962382737701553237360572309466111381682998567474445884555969155997528896962520199289069413649945515))
+ (-1 5692584577100138206704178766874348327662006017031045734962382737701553237360572309466111381682998567474445884555969124013456406858673959387815242026727066))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -118786321298036108045826901623494422286 -13104687393529855246189161514016061367829206536234756076440701117699438900634808212710497707688898041370523685367660273492555927331371333817584456923437812254937564791326005224466260676246116823279440552837098144298072108885163702544652442198253976130758036230979750526665070549806140578651660117367824058664768255971820333797528263566114021182845197585116811208610765478558726491630221448907739229750716647693886681440731920621825762708622208585945445501310666367635378515829380161368994361558247741326227866296163878689192696502960274515396418704173356117106149549811507516298161494760216869495774889685228097554343))
+ (0 -118786321298036108045826901623494422286))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -243504960196882294351576664380857968998 -21587937181410571895883243216668490389074705797891859245233974857468088393972175783210897703383951091997858590608339069503309630378648345491373074180865032523580053667127292664354305946146706860083207200717386662398495588729927890691458790805600368902559075452315483293077820819619965677979632040202844747133012382862591603017396270452230496812292060122531819615885125296991557805051862986461441377986436031061301043809602913037623299360710776463563079053501286633046825608308134411478010516309133407298319800662521169341026639016773610132691088293480775753098006068864600975258749129292334356727402877150032641596013))
+ (0 -243504960196882294351576664380857968998))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -232153120215337418381368832017470265942 30369869998519160635038439385899036531726274899243107662193573776561025086030508184579231487739439638990032661366370630132003795988534362627493292132764049369361254377811101088096885616264297545296183017838644655031800075015262568240918564555865889092855166242732548296118581123607728694721796055009838837557999873738362196508994398492388283391000153200151108985088421583241872508945550713986000643154770628316896294096213588875028875159647959209523043158262383137987983806573391208706198841017176042216759223869369001945418516819972673432636326816040752486579776281338052626173120273068890045743383055115108151149136))
+ (-1 30369869998519160635038439385899036531726274899243107662193573776561025086030508184579231487739439638990032661366370630132003795988534362627493292132764049369361254377811101088096885616264297545296183017838644655031800075015262568240918564555865889092855166242732548296118581123607728694721796055009838837557999873738362196508994398492388283391000153200151108985088421583241872508945550713986000643154770628316896294096213588875028875159647959209523043158262383137987983806573391208706198841017176042216759223869369001945418516819972673432636326816040752486579776281338052626172888119948674708325001686283090680883194))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -259060284965774946595436776839639567158 -21169437398760148980356190208468018621145492999838564155598571671707045137252408058263155870788514173361612648418947991691931017566701206182096411121805142388703524692384188551391839307655250861401059757668540803453257330609840260191124331324376455691656017965418225557221321063048013134701879342357330536176553693912196231407222911508076200690973402778332647229863066211873019193191946948707769594605725700542299351271155436324879464212647734978854222464094486372144771948169422844206687239103281296767882465060755610256361348437002775612357787333990788742488962974294617778863800504758143312112916148210635178700875))
+ (0 -259060284965774946595436776839639567158))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -306407220440527520801126245152934343544 23776904469041910002999929986640006577749806048379780143306978176280330224333859620859305982085584460504452577150094943864349273103240498588108336792264540481132832425653265046674475461727185564436156797869482735166850827691928781085870354146365177855543550807539877079785312955597311473866546268560309551339704009052837019611095284429480282839060448969927393502922337023493529232757886223011597039473438267362519775173848264262428693937605086393282678388857244739695710639089112115821491015511241179389623611704128686301802869094211111183507607222840602723592206395532989319304742353354849715544201896997806941793031))
+ (-1 23776904469041910002999929986640006577749806048379780143306978176280330224333859620859305982085584460504452577150094943864349273103240498588108336792264540481132832425653265046674475461727185564436156797869482735166850827691928781085870354146365177855543550807539877079785312955597311473866546268560309551339704009052837019611095284429480282839060448969927393502922337023493529232757886223011597039473438267362519775173848264262428693937605086393282678388857244739695710639089112115821491015511241179389623611704128686301802869094211111183507607222840602723592206395532989319304435946134409188023400770752654007449487))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -195344089877883615473604540022799066156 3662747206396136814780716441352319011395583880744440623779519524132715621398922492090110915810914165138435343905061143614931233310311653264955206314385113727380922840781471233570237875610273247058183529977038444774890036917021403875269188605058323112809901006876685005810599540694986877767813641408707144817551209014119080068666341132956917595575721029282915413432788003670940873484464479035116187361986468817764174983360339341760904395062935668506379254915132158079325547293981795720009601997338615068852024788929328937759791477545407878160402653256560646902444406842976796122784294159073232675729939439754133572694))
+ (-1 3662747206396136814780716441352319011395583880744440623779519524132715621398922492090110915810914165138435343905061143614931233310311653264955206314385113727380922840781471233570237875610273247058183529977038444774890036917021403875269188605058323112809901006876685005810599540694986877767813641408707144817551209014119080068666341132956917595575721029282915413432788003670940873484464479035116187361986468817764174983360339341760904395062935668506379254915132158079325547293981795720009601997338615068852024788929328937759791477545407878160402653256560646902444406842976796122588950069195349060256334899731334506538))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9264891165355739565190184416501921531110089392234481682785663537978152834210043205322426048946857682928713233093454298987718151514375312698287977140085629 7037874176512351849))
+ (1316433191754927814343121270936699199595699278862016004420926865721433832616431797693201713416985056700387482358940219476958754936526117 3725966351458345296))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4200307032774171266112621290628586259036811354993551074625290503853725932886889027855146647188583607214617803535833936888841730747156500044307235280341823 1284895891758199540))
+ (3268986273297707492966046995014614916998242647231210827092764188090140439361457237468815188241626314878458369000334553644889671709204514 686385384999618263))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4633581426210593840116821588308941075113609939505374670564216205139790589811590001728944069668539972864711443927654873778749890460797761818777105143436310 -2962967916964005701))
+ (-1563831116658993795279542101101791208522139405163357327177345954575873595639420625598557391282445499923781922172975036467881769387028636 -2305528351410817526))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 12717552468498637611743035736272812618998169576927971614333302239794587794960622996075191568720328790968571121428403438724885597787608886055291630047062012 13314634913503466421))
+ (955155928128432692468469826248574845938797371431354312846155816839032798664341688948121282840353830287784283921940330056923616110441287 3054936783550538185))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 12062294501874959722722826646961478850437392058690935960962546316456440331759806886386062852332964852589981740852222339370133938328830299239599161668985128 -16763340409247566945))
+ (-719563894032763567901416565485723597235798340734444183600832520303761799320002945942723929422229544393458648487318438477478730610009081 -8784252901936442417))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3044847544275515285523698330617680562098304367055502952571345800359603621492376638228899902071703358030930686556600015395721763778348780143354036450288026 -346996692199522190))
+ (-8774860431593785670059820118794469144363980632658525112469174051232043754755411530275560319174086707639904288765947602493995823751245651 -238735003065207664))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2509912747961300370421908848463238376627618739583712646450568707494390365647434163992939257405972498499963653610934135188560348612028561201284997136414467 -103539220471632131715513528655357150478))
+ (-24241178719797015812049763065806339919024561304709065585003455368093218973185992185403749066840410575011438662859226 -96472873114015658715754743886276195561))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 903584156603757584665316743639288345339689627067279191353819345586609786559389840933430566508676924801215959188934167984436460131912383813696092800782502 331768089796013775863175470747253254043))
+ (2723541486944457282998823558887230609702011905460231484608706829329099534108144630923237396663979818212898288888162 206235332161320659528701690369799443536))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5673315779132616764913839385550510388979090539569302085655840858178135330568442902409259209441411672724870197775936862625748838206738247202566588717953664 174314453261637397091517016624017866910))
+ (32546445076572334426551736182476341541840123356058415149120265601377736759669652080905093959104527787429999911903291 116692109360780668718335531020688952854))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1042174796681883628708939541235268651605049912220225874766096393016094308719465113556241387514699104237113811358810257758037463299809921161083533137718034 -222161050831883826404696847740663687900))
+ (4691077903977550484144586938760520043889189188344556635834217114054282381408390083982959968194813858480017307031811 -99596643070173880773679158795261931134))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 514620852714641065399283188571474686623886013323210978774935263256584816823822985571618774823719005380283570413767760460152207111047429811764462688164598 -249379962778237023348159084806351533829))
+ (-2063601449697349844851896329155481297775287042332288194884672211603708613220802144442049441368964502372230090742486 -95322380544583572818596570976868394296))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4269600385716644031357008587416832262633392539755787971157199376810061034292825362806383550016756143465036715717235613514913396047178769910869994174370663 285417980748490192096950554131180300340))
+ (14959114960171371128118740711875740516756226597819143207915053559296218628291049058344647983358827408473567791787490 241314195989544958480263376470519624063))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6257762944066060502889009610562625466881502649685643619949901701091938859953222566838296129679249506961399045004819501125771060525963805468605899184284857 2403901388951678895074087838271029994884292204266026258064846860089259517515609086601789420041871201768080771502802345608184755582676267305500365461987443))
+ (2 1449960166162702712740833934020565477112918241153591103820207980913419824922004393634717289595507103425237501999214809909401549360611270857605168260309971))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -11993484600336960787296361130458404039545119394875472848786275539588308627572632551925095053909141197737731742215007587172062102742960429155637516154567478 -10601606227266649325153572936490025724316912773656025997862708934485961793376598665748396482615905529759961488391911046336857148489489874009257983913322770))
+ (1 -1391878373070311462142788193968378315228206621219446850923566605102346834196033886176698571293235667977770253823096540835204954253470555146379532241244708))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8099353584218727402496117482244315513694479151831901237119469501251316930293170263154474101121202090352876083340578448720444998702069748972927117400667238 3544314361305784888681580682051379178614889611356920001389193108853540699763802421224233206957629368752496825814976307915371579698349690086107445288844845))
+ (-3 2533589499698627263548624563909822022150189682238858767048109825309305168998237000518225519751686015904614394104350475025669740392979321285395218465867297))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2978635751180326260478380464684854159186938695694356726729544155114559498149136630265180287452727795680214540092030170434165319182046797389540988376220992 -11044560433803724847345327269572156674554851849210901400046696801586678634230888624140822828361962132102290537138655249676050009778590939633587416463610415))
+ (0 -2978635751180326260478380464684854159186938695694356726729544155114559498149136630265180287452727795680214540092030170434165319182046797389540988376220992))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 13340538348613289212198643243040710073441733600226599862111857175429956610033827913042723029883753278922272401272143183977342753296395660841047710386806625 -12505012580354283714273335370179473407347376833608196161777727706326565713505585671787333065372262611606233460666323939469037058474587043990269917174242835))
+ (-2 -11669486812095278216348027497318236741253020066989792461443598237223174816977343430531943100860771944290194520060504694960731363652778427139492123961679045))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3452499360915990528305851079744650498637858290301947784400848134276013289408593218875969649149167701046100505360083493320272180164238716241369492874982856 -2841735595132421145030480470066423226109731223189024018875906078709951146850527470934664784555907173906888591079310297248898808599295604861461544021697908))
+ (1 -610763765783569383275370609678227272528127067112923765524942055566062142558065747941304864593260527139211914280773196071373371564943111379907948853284948))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -12837726014506093148099404481188410844577204272048603185395045047349565142592994407238657335674129551317417810603584063833795494760777857363295221929632592 -5400672038070763758928059302309515863608512780764658336296609520612929827128710430832496604060142364086061442480255889774184624927820479974807630834638627053061502551989845184646873008822134065011205730341955561862333543891572685472831543459711809182159609688999832404181689665081467086838440500602969410420032314939424736094367166550148605570451238900811316075091818613634658092771400323953464835124475741159313252328998401218032670762735091435255199537815920258090766640501899817468173756745613666544200642455036991967916355826412137450931256645775349763991939102903236911444655964118925598580974976427195132959063))
+ (0 -12837726014506093148099404481188410844577204272048603185395045047349565142592994407238657335674129551317417810603584063833795494760777857363295221929632592))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6578123342051874578301723989032639872736755816906003001838468752363433436477439123182015773040480790196872643618542950300401093404997067180920740266777136 30227534847135453106177887048045830910966009330493682541426640262878585964314188306388368740002450969080153107270718818194095421631888634061517731024627240634873991685067246458822125591350775226166707968203074411304172314390138208453777131423508042090910198631120304798774511984974823253005683386272038346156403540545900138637964682890471751795844957640450350739073841005154467987598913264762974403365908691068629911370262907886883158252280853615622312950774196097179304856495254526220900137020823369927850276669023897589972466867500466273084668060310345544901231841857904496215091732346299276586847479136514947400671))
+ (0 6578123342051874578301723989032639872736755816906003001838468752363433436477439123182015773040480790196872643618542950300401093404997067180920740266777136))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 12403944923950846249231475663107427245396603223802100275104415443763524399953865335344297718622152249002880852792246968794311649331174399649925724682365691 -12888526328266820415927145054786787145889555649382608442248161845973745960691528655550360088202102799744537495406020539568745771467756467183613368156733378808019164713600978887019905699871417123365613340681673916006626966649924170996253273073733852663021384681382051909095614154557333966638418401258055946731820806422207820872515345183005729150326803604361512295955159943694411555067679327842378949865992521340416781113735936437694218150384351520004302169462501770232864597266654390198260481651327159066598217103147752784312005857617885666670915444340917773878003125490279146098981790584757296196254721882965728596834))
+ (-1 -12888526328266820415927145054786787145889555649382608442248161845973745960691528655550360088202102799744537495406020539568745771467756467183613368156733378808019164713600978887019905699871417123365613340681673916006626966649924170996253273073733852663021384681382051909095614154557333966638418401258055946731820806422207820872515345183005729150326803604361512295955159943694411555067679327842378949865992521340416781113735936437694218150384351520004302169462501757828919673315808140966784818543899913669994993301047477679896562094093485712805580100043199151725754122609426353852012996273107965021855071957241046231143))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 10948926687039959668263034501276830818625159748756208667794639002017960671515169323966433371280908617310031465455790806503858320395456591407286777524363944 15489368888944605373650389556533647343231613227589912336942045556008797399070972592836944702007913599282985878262526911196097512734678645706417084706692047107683744531285802197270639216129852640210205547180574081479052109734758880839510339349237982383997307379952940072013079809351763653427560483156946719035644278683384662348499193303099798764213152890786143522348717903997482162057330324665060570551176318195643585920374603137371921517627526609290876303058743280212715019326447206678291320236859616579863769668727778545628289338458285997742887048186232356815344233169348134282594953756462483528235310248146271138654))
+ (0 10948926687039959668263034501276830818625159748756208667794639002017960671515169323966433371280908617310031465455790806503858320395456591407286777524363944))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 11464576772189320419261665628466949872551044398628568459420638211702970737332076526558331636045640676437486199912474581890841933557822038200509907802936313 -22467560825853172479037421968188386486420879368653733048793951227030601094142939166908251610058992921146938740897141065727494001469172869273657374887890530345239013255211792126218659779037493454354985213639803588241949068595974842726845550080803721118359501094994460828504625140423100683538018569820187798018489678377090273255263020908779694768888896507998040871877361662889436371169588814603494476932238384716309803290555316924487478792149178773379217766514013266795383492328680695659480010501872205935050314706513127406414046031915649062646891311739001532048668245929929298605152418405630093221583825629790103566902))
+ (-1 -22467560825853172479037421968188386486420879368653733048793951227030601094142939166908251610058992921146938740897141065727494001469172869273657374887890530345239013255211792126218659779037493454354985213639803588241949068595974842726845550080803721118359501094994460828504625140423100683538018569820187798018489678377090273255263020908779694768888896507998040871877361662889436371169588814603494476932238384716309803290555316924487478792149178773379217766514013255330806720139360276397814382034922333384005916077944667985775834328944911730570364753407365486407991808443729386130570527563696535399545625119882300630589))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8938867625495530153186421114297747048040597826172184076413640033054738602015847458230139602813250873350372960139469151926251587994978713194477868118851140 32078375072910127937267277353555359769886046039319229674839329288579279294400524798815635423380870475101996161416889444654312193048344262195882716890119398121411812112449203794619431500846260449790771355510015457009235934372609093350279916863051987911050185220414029935306290325311701907978862607656115228781358052463349741922708496995681137879712967466047121123132315277071458202185149672157950295326835513685167006326116804121841993768353882369640078584371838201520000042076939249781755766637255305083290727182613012935978235950698890245889658464214791358409590524627630419359189066595841389501082705783042993303059))
+ (0 8938867625495530153186421114297747048040597826172184076413640033054738602015847458230139602813250873350372960139469151926251587994978713194477868118851140))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8722682937170431050833187146084378340001260037987475887522226657702929497643381574300242436757970258082372353322466430729560481174965555877218498123235127972650642792093407571195465205419575987213014443482975328738475261835806620444520634849116095235065774422144459742716160248838471185163698000228745859478158104063095766855794756463409807333016407203497851105737138480852953389782284594500871170431951978989370255765328498664056929197514187424012915608945460596104718351333193752820591185791608965252963085687083606400804224201063308456591357967802486377986437493144904666736661926951141864058594174814702200209409 17412472792254218853))
+ (500944526446044913245854704095754296476914947449773601840238266000641308362538841153234090543298285278030309320940403936325404298435972916448525262079072487832742313980507689645024811947475736929391921911894727993931203210832413457668815952782782949239897550712034201783959782842323270598876666346488371315244615931371511266927466746002593260083813695350859233907674818312186201150675556646229110170730257749054381148001252368819048293261475322932890858943640868603051493461480912552795132518076648186629059596407623028993206501153697237322059149347109211519809718392500920402797396035977014151301 13717640401691531656))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 28355649069936648964480577421600521514076854589748655538478527484386692848040560920378270353295750065522502408426901852657385194373002516782134462463403619404085937808470896616603996134884288656277511001166614643845546560002367982733683422291378278295503032478358197654941019479109634084898326003113897170044006328598213579789377859798284810297339455100733353158770429621612618690067430491463355522146151298846940191011096497912423339688256950368577997428204387561345591508638698782496102293891198658979297125431373501637906166414269821235570899541062164735301390814949753951678580623524363615439367796948526661114273 8633859053023126034))
+ (3284238125245742016855698157684933898976923158153988299571059835059738533454483417199061360717949675767825259147742326435714596823475742487511565640155717557287585352355724513814056546156034557507060565711152037955657280498048473524523497495066421726381315710512047045674071154161308957202034177182801687183543929989744017034272683534975659632492076519296858840261469439577557507171156150551483889412665000065287799665100306570592222219949067222441707356112651967102951988787499729560738632591896472356839552808850928783757605816255738706660766653939585897846868373880810762740938652879077841365007 8480542101902822035))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 695804210379264643979583966247939985121477063798866833769029083451619832314943028815111717357207629373097980486420088049066444875218919515464168730784010670913213630418336413807551517181427706050442981412812560910674568907086122536915068847926867597666432252300779682993163510641754139318056267379096886236384894321926559804092457910184502775704660359338939407870665678723351102313495695271753077268239934810069567863069912893064736153816317584230084541663742856849855885433861537874945479324326871485256528265492542514387227516996450338546971631790859699133015684902494112907242906699969802617955900147949678000702 6681774530135049718))
+ (104134643759851814351147451693200005177949603843035721223567744815305881538588822665583702468671678158123657386652154620049781061631961328262453617035662063853637317024464861861946266314086911857166878173456014196637218631863393572542109069255296051532325807248516303174349857623773438852122643289226264801658953137748153296436411578898337203701260654377419646372368642303334799023574274991890918545934625239992964365706183254509198057965378271765137299881104144690382322308740670412140492093203922319672781421992523823019735773183797196153517598307995654976625437636949948229208840097078305544042 753510048969320546))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 23793846839231724395641481096168600821165863841834871677817770057997115862268350281729411419898015728222764385314741974298570203231459954889026804768374989204737469979104608191592488617915776065920825549826544170491376474603565313317103382409887303248767928207436610335921923003830631904883475966155908755916279914050461058817604412376332860234542206749755476863494453482771627934874030957391163592500144106720406855489772599751499515034904792907346159848425450017939743424553771285003901024075692162881112993617392057913260097840038314973483416617082316428401467936188718832437149607288888734084245887947167600476942 14251636779665730013))
+ (1669551870223134151303903342674455433642542678166026329327716199552424270739267924882373474967130314854205248773422856606186537084529373808518256136223710801915037299873741750309033582768093390015183894640465684163714303454407585554851774795653260663343812169894506517621409762650950455752948417517702896344204545008148927831629685230911115972567815995382195887880974480058637498609515045000261275580213450984765289759768577989085446697886224919418538617830152205807256503108619376475835548388022966261347231830397100233962945745245326537590040744120991719469590787920917431072137837209281279829978 13846244437708747228))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5157109352853249971318864071100809054313778706912280725237530653514718017885603638808994268309662830522966266131723296476071219223553003512249189605920498878997009866938158487186969488205976122254188731320527219934117903279062529020046834522969499499006879142996400588997334123741485390256248878878301063076286830584096271875934275097457786951285271567141607668681320623976130528011279831938224824782139301311433982239041406699687231975177586985955350651094601995816681979048980035660883809964491229857363116776116215144288428315817606755704237448380042774619545204701291306469557276264456990236770565662987790837189 -10013270743141522218))
+ (-515027455577944332776599219259294388811187969682242219239790206822600106136108551964834930674442778634657645567794824061780492131991288077428371773780758138983535394992930162959647831148714333399217585802721010849103285390761891312665489859363343081240130486926587552859706337223282598959658826457912110150229463850079329163597771797337822709730777565370953422223408595882843118286956939988955846229075579330815290845722563420243422752650828997772215730429207767090119357203878107337884921705286570049639435686342039828502912430702417787311741719990865608911989344378016685337998208215872207554274 -920760231421022543))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6494479986256116541104296929948745881595810377963953264991072983439840586308068782167240611739100078965050725068818882183756338815160036859027539278041681781661292616356111680897493765185363894557565156777508945778492400417041556530072176186473028646756075186621344659621007329706013704866019055199752880400583535752226648517005237843095412900402261752786336175778761394870284838510406493285835836510084377115102990988520712094164167646661458280428910514014249834132126729469995977022911113044853980749549364759880528586645949565758303087716543654543586861828638440479331739588108393797432477382024670823562517526646 5646044948886972124))
+ (1150270684178027997729638025310141697535651329313468129284627631873742535270359534840413194117215304029010709513909008920532146218787185595227269977210380838656683242728568521891853665038056999715825712357842110695616824097006318159870253326008969365677078769387050477555367309756230306675796151995910498740461667569866473279089249936015985131524549691332989894205425117195925594673141706705491188937755834316410829046680432307112608812689099288880996341318638564624566449876699247700823589547245730672763432749619618807750355174780947014272103851229064036660484535227006468477136474311066305263226 3785857158573214622))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -31360864680221422030140415094508859225037184177278863690330048646310966010764143021431123151508104188281687033827937090369965061135751835578522568620174870624326364591751719134017727476315825913896303730502231987133828454596458972192605628269836766485752863341723932456882638706013143064500915331711791221807863285445277518932935928879510111580179238430718068897684115464091110803073393785115849134031970572952341156248906594900067269723116623961645695573540685417690666812895681389324387236630659047254288574908905115640816788218380202062908240234242061857266935270268131606785945960533363545765413571210356588614272 158731480268028865375787109312788454557))
+ (-197571802564094255018835618501836237470451780852464910702917947610328490115600879542277218044587953977482033832066853445897949746594340123621010571525423525283265694134335278880857970722363261435835440841138075424370755023622549046990506755720823389094963930373207384718204282462412342807880786115573288541223692700693236309165845190755419998468567231783954117079063183652374494384463667165956585068985935341133217173168221529758860606207789154326413767211275484817995028454435144966634656180655573506329003296926488159246532512031996848763667993503525898127688305577417054301089 22128982064863884081225183621483498301))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6972688127252138459564959519023672734797720350352562732688801457617542500099509865574973489633915033719003377224851429368921013349700580153017928134596084737004044411366993842119504403376959959480789333673755655063117787017101298662107070542628327980482897959181812093955456006698786827411711446400770298021381400926276799694253767942575674933967663793055141073318481678170963516082521833862017762649825976536694779299584090771859213561628651925244725218133964348562464473355036335901024895778660125505334188112559810228121975479770611339038859346371817450184722764849484125019138077786325611240207689562646177214862 212229494710249959442576275005814060115))
+ (32854472639496801513625266171869868980490382632885983229822011721729192329270622778562010916862699719016516950898363598128121229189750116863530046554995732003476968354657890095157193194509736774942176733534056571834590366060961121671289385934253368995757730753667329275656966343378668081666905678760988072374390324867142186156887369444294667350127131255070935565628787125782523108523608392770938414227072810340675454608542379054058487857197652824285799185253955626498482144435788461420918351383205430463919873128183751743772403931916447474872579786344165522578418757820262494633 202602247999430336716424978770050352067))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 16146477881044981814872185978005786543642189695578037880128585850657582227346785609949631520306446259385630057714250080634804935779512167368598228578137970013047546260870411704532863029107179381174130047754949458719207263855344249323475379597824225167477700328511898116621808311449385399905867898699564040099050435706021172544369947305690899952295406293447506146823515423102232662385522802025721933657658703659553626211653699561780784625213816227416468145185123310306319508640423290747072654284738002434784128270456278391972933415297337582959158202392632248570451671740383769937167912379559021602080900933189192375421 -20310422672054016316639412907518719590))
+ (-794984828319777650694385094127543908631549711061207837016795411776676915426259473368853160688756737034823729254185786121643208845684214393842790938031685686187522759314947140818495607328399712740082388950671812621562726517214947696883370445215206445278987678057453772575168165658852145270562955365137991966349779422574705948837912807073553643238677887356778699590679423929808592396737386221680984966466476609537799000714595283015387280145210362603689829188312020767177147038887361232908826207585485585717770550283815412266616448789002231614634998653868395118016500112836083648523 -11799925147898511149643800539362290149))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -13333386402689284528955650425278647711888918022382802858930735354762601039626630790596510115878972126652469762677159574447095103432811719733783031083771953511074739306201836852090205483055377050725227473420407492132102122918222222661174330427122421429872287465154597256840268514193104109407101719163350519145025605863849817679140939130213133277602018019855074419919415918787364400403970284236218639542926948339939839929520062948689163759711059171596722904754429438151009753108425737178467425999202826949155777669899192519705543679208977557190789421238295365156644743397621766685402593133067165504533347334868817548870 107895899863035416090758241115761545328))
+ (-123576395577726995467509810094692559795501216776624732643654929468261569953970620516962817836961555200657486752392956631475337670018968072148956742753944568338154539759184635744464807131713977468703479999463417456632584312098725347773265375061594795112459950102134313707118281441803361728717545150343139196161174674989680811767284271234273952364761695483244122531302983909975719498713709629935106791776293856798291478157380963024628448230576871460269799644149756524167414024818290038046315016119726155391403548599527926110598142014566712845146844517328059271906387663525750970076 88916219636034843584282198824028056058))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 17396957313719309181655810621342598276769983942993211094806395284201495622288603530182348401034532670779772026613959220329662328631746748840677422913897389222211979435071300283979361385673923168895608787064277711550661080470385607194607715097404666355341496134600730286695020337462621706659365279865288817231582460135505994785679557826378614057840182487774381015927951405829305139118747627556929090278010945530871104877221509669969637405745641517281958386251071953311649218819211648218403974139963448683937267881136641329201897530450274203549882462469989176813129608929688681288830465486480047730094845155570312862849 104186547224209978415781641589908237686))
+ (166978921724711432713743436094800137505239032223722714964309089009506614535895519867110422644603923287110323367280581626196181748165083370852210731028149827924135420402322644021166934074442323617970930798783252483767604446788478644579242675426052418474560530381252273076756647943610269802844827006798614570113552490465455602498689920520721194207399033534120048155924790694559525815508064767545247429922864279482054330586837508112647624007190343625308333109186981945018060033849826856038685383194624273212670683254990051450794748656874003602039616482791671154071071940218956513118 9689041137085346765396894259391897901))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 26296668029363560180578472840636347646283515109787546573773133131169235303278230292620358193183994696837168281782424510501462932715289179113988102147665778902989371433141498385910026219307721742927641650208826808587628688330897125412814594284814050899367007933796796475217266168539594147019546294897573039387284123267787652073296654465797846788961105602455421819896924940988943972769457383697764285807789932427485615761627567609238909525216550007481876466503244451415718439500787125259366798747857812030734235875561021422659158282642054300429948383202431010170473103089719168265166132037042278884136592980721399898848 -145151976679874338336058059363314537))
+ (-181166447959297097309632649706277310462287087273328158550559504514077025970552462585976881228509338936991115036681066334762526041621219901153411893847383132947014037561714726163730996723689359625350327562359371926025189504119439124542211108302015324941630060663441114185165191476531119095379776949183747807676488899740428054170566283213350742091333006110702325305863276507428847828894436119391753135134140918882254262557249907254757481730047992171259860818951015886963391969368286964814563381601392580107247382831740092922947642920341973871311541502943677603328463821550096331015449 -110577937214275422567781046193383265))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -19994387832358687564296482880955715923586831477222916410597818184152857711804843023778287694318724091304456899035183525127967566364649938785565453184727547598671504088541688780249133503129117660562371945085803761853547276588271572826270417538713473845464667687405215144939251922714172491714494707146884856110703801489923219443900691887441959990915961809557008130581221371957930424791112777130507507175854695038524747304496126685506502272017923871345301904089286401283977464945598827719321374155830270851832155999413594990591210770207211404582078047399265487243377424091264415562555479103296829671606309227114918559411 -12290727751262531359522445814787932748157034294075544178515373320704162497192584943859172528304649072004548036058435558708785921268699678655127651925033127))
+ (1626786325187686206254527912536268233229423573477257270053889346415589499220953871015742625081244397640382477041911954315181713027690095532216560352291641519082404655148801601548476351855968135320238312168182690718232048560912434032449056943124604465352409935769208624710904989903415445402236977791654195811881494578919123294926181940156782515461241607944723498957864382829554865120206763098110715049165623436566759235599826844834593966722456940122296028858654743 -9304614710679256891239598861411560332304324920434685965899525875715186019084445758952863067134832791421060008856516918122255022315420901512824783987888050))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 29916764548363516315213840380698377536192609328827808911066465815108876776179490417834258307994776308911573596103626976278007330105709262864909645777842169226871227147054313657605129607087589187123503174807369386299991859056839377153696490642393964375926230602462747312790529261100240727992473466712957240583216041201088172946856263144111813006598318253235946940685055230369936673556047728831107329646718919450916347559724523856479721600705891348359262178740659519774585983326669798219391447115538287743254388570949370216658299333436961807924794235560183973249587386381643272943817567729138289488897133971529039695757 8476334091496252719253471844340714224307718865976339399900779938495486609491382968889867250990569753004524377073297071391348967807704774866029247355531618))
+ (3529446129120492576886933802306348265603546401021071145489371491655402978871242160302127070993421776756377896228018319062438889879832901903630775379375474362476945682118589732246954574638082665328364641573132346715748566497144048040413137331852635046499249704620713985392482170976329565026453768403409435575238922748145312555307402543771398751056417238642358386670853730480256387244547289563589645563705382910276075835741806800308617595407635175179549186349623407 1121598720662440742988451944089192258208677258393969079460095922943603039995215206852920630773807538691962340221388452566848135314318278502721876458313231))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -30744743258986840974825934925400463284355151584175701001085034454282509186617636999187209301942468580138651572968436145883508307958710953672541548503099036345172087541186583358599035971842953063792288589346835317805238011836025866089112384348158834439025788655670125182111347815257445264926636792871229400549827577321670531162443103810493815924151448637886392962948822485797619344455378736429734156821345757186019132123507024835777255364976075865806996283635073664232613154449751312293463363442122204887362535000774934247468263702545257658938264075634847752288018235968497021028555508346290918717339789336670514080457 9934634309555858804270980126309615970053320780519373855793924975583204316518242194797388422238716941854010764960600214725109000476250489194524103405530739))
+ (-3094703066162616114961725586598761886126440000450319657542750158557542422972265973994772432239434133706930345695126019787070526540238058168248601279554005834087067802027491094801318957724338773860374084056857766237802500357570852135835098188033303615905411388899090151866056131910609183545491275118194384669083917607888152562507000146957250511707959497676133004912560741040750644659008842081402439245159076407113469036885418577123982203712293205143214370192534124 4583596897489701137708573201509728063693689464812281935974761545728663079569821440573072545991527054461975034582959468944964678550288258358252037074357179))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 24643502519803888691586762836893695554672668882609252497967357925433058477865049537403781351424439957461939549800248300068008928283760882152105280755728186165336818042947891471506568092832294726444765034759769551554808855491501013689374698042749154404230203678454785382207604303955330803002216399957247238380783055267792042696128953561495320963977422797650867160007702447898131066450706964885725041540562948429789541526915479497874153956586286026740960933319749986950590370162278200833957789772606366304927219928607487195862425188567871883130961914293433624774413725427494180502314592349900074269004608052919421088368 2717450167284225996753981867457220829510500841312068511238048532529427648370573174539553585183069673827813696207263846346713773366926177883038970327669336))
+ (9068612486988930041452615817812610262395413380750714216172624755617167719146150429506179809229439286481063525474263171526993584649905549895379552966354856688607031124385144196292585204982548068977456744404073207215088901248836694827956726571697679223311674675917482789361649212542123782029147076771863216074461137218175127751607336902080642274682219411530926094644805942929937073627694007279189212959755881318530033893691479717411893927131774283641886860168845194 2630363844657415178536247490974293939778607568925570410250370678327072798984411202414449734187268017772490491616031334354084510652181851150192386816317184))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1857471144762621226078309760048781819853808902834007243224510947324703640579895884811355396539307768563652552656687272466757001311647739575925654454617797724205998847128737511426204839085303003071906438273332520201294499647651016586411018765198623236956366866836742835368817430092030307634950795461633849978479504285561783793523293571899866834127333885745234267982498066548934305641020559144124243564372784715821253591393010485777361901806233522170298666402318233462164642692695586402286093353406704474285764942607399336515494566976327035651095257443119526233432484730549923908643983835638400244551332963304703341991 362612878824948204766041465498605121983038344328923889813821008133012829955553725429013872301357114460102737976404433762806451909620639548491755012601032))
+ (5122463247256360173380682454830667735994909336257131094636868172398931453441644851286253058553683806107714242214425234484025628771776577335533690016729030113210376620329656025707882934177847398968795670307669192526890837607471635669459016090183544133427748745285201703705268883110778706355536331762965138118319801447738265213248123408984033840769670544118622199016226728679039309116650227118501163822195946867970684116882706924781160720494209768961175300546225784 299760236823448232299335077352435634442705524236228994156709162318327253866985319237312495500717724311867426639654094420477947147244359720759776119932903))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -15512250050509017569431653406374218468191654707236673402325185299702995515514048891881128604127259128940966966514594946451486134694476273851559935124397715410737724278746590654901453457150411276548615199767807502093455391898384739629715289928761836102897197661380120487438391395985221415090269132778914962364055598932950972975325423902250870789291669816092405224971234605691036355433974706922342506063057313987759468269851537540937400869685698983579620650290591582484180497444639057157757973753179907365231695893268694300775677678977541920955165836544926807198464657683328635157477957240884116233992874779933793654204 3358541127950670805593397985550958371637657834938091938230318311713415017140090677340291997759883758478618605945079413061265904587739160855880393703427541))
+ (-4618746491270258642196486131268015112521835423420717615093174172980857448220383551186758990917205762587881579670823547496170992786073126440511182401809159567300795932372630208424356476743332043619346311088384079059435373790499576304419282368802375623485321283238175405485184862968207039638749406944454331623523507687428477960605913568521627594126207284882249627708423470608914416155986620408793531083231293214124556072929628635430705354422888702360112306375650944 3005102575063606384680566102915562580638230938191281335082512965430334791588194853068845397234960243041587407778382851298719244486316278864423824018594500))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7795907266149417935880848054805638357926463272237741460640947569644048588447722511612181517607450880049915905557897989678236704307693907736247058983016545076253121570693500226105057772914231058133990872553093077477246778482972908671114493634160355090012802248700706280069417479488180111886570768297449284497993155476453139747448123977064178202693174347058572053686548952330935409613585349836865130827901523001778569465270141666026392762544863707172069660941583975586471593214627992137708766736399392527511202198595607734119123667475481080585901379489987633325665012548140296404667154265922084962379380813206642961141 3266322496024458154155982586177367205241879884975448114046439840444265881425140636480586339953113858345978121218157346057285955670573379845528853928778649121198573716895875372950665878135491926664618467827249347334921049358968885123014320008238518111491029267663871866232098994215220584035091470875989416180732388925174422587186795087858194659347743269411322176680238569785902471836835335166112452646235228206195081915725782645939016905926964169376697807870023636080042287120562847150399762713196525578131013908505157176421364232903071413436786302567498639276925676203136397430977438669196132229839190136276524068288))
+ (-3 2003060221923956526587099703726463257799176382688602881498371951688749055827699397829577502251890694988018458096574048493621162704026231800339502803319402287342599579994125892746939861492244721859864530928654964527516369593933746697928466390555199244460285554290909318626879503157481640218703644330518964044204011299070128014112261286510405775350055461175394476354166757026772005896920655661472227110804161616806676281907206271790657955236028800958023762668486932653655268147060549313490521403190184206881839526919863795144969031233733159724457528212508284505112016061268895888265161741666311727138189595622929243723))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 11613527140000568192482756738253388762224453894786686024705324634643336086154640452808765642911437980109688560443031730927780624431102238262306897218656077453053740901919490705730434109001630505554615644472687423755323577388664893480041595787444776915986509240983988768996984961291424649229547505632144971266842770877960364848817464904515794389771780820407027606373375049573795106795237627834701205331678265805568350911815774813018183599320960878173351437520785364220474506113269284418886794765499703487689302735252054649064328797761871733823998210784410557300554983737071496100764692702245794941065431902323619975581 7587249511488455291481574592043097850017617150850944854151430663857438629054661904725186504711545142985024178310267212940242316767124495452290378757849233879415880641974894427201010329762690544890887138507664079244754338469394276854749839357593153274763991475638253761900794536890806900100092838214316658164432730592513062527370014192403678448098350118128696785002089891158354556141292773760767431084006166964515144211080310413063362654706066932594296395740249062444674285627590937186704887659632200604451417990996813320236575100574875972599186794102474813935877205799664448604353627460661673753990274449050152179527))
+ (1 4026277628512112901001182146210290912206836743935741170553893970785897457099978548083579138199892837124664382132764517987538307663977742810016518460806843573637860259944596278529423779238939960663728505965023344510569238919270616625291756429851623641222517765345735007096190424400617749129454667417828313102410040285447302321447450712112115941673430702278330821371285158415440550653944854073933774247672098841053206700735464399954820944614893945579055041780536301775800220485678347232181907105867502883237884744255241328827753697186995761224811416681935743364677777937407047496411065241584121187075157453273467796054))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7305781671042805086205879027901218372025263744748476920370936801215407682690507181906856060500614379569331564964369672229742583709815447579920249246854986585035499467980872113078927984775191185433409825799075510115669850322522523768142598684481781858254267858499128954637862215107851239397355311785880257523971110240017078879170794103136756816178851155500522519324993786026829680880063502983144325993463559477297984845168078230705008144229777150602704982383890956566628052218375163513110904344758464487972471262152773773566261138354198738738504010228322403241824600361830597196538559114936352203702189317843297305612 -11937423884971453925821024083751259499642447259766781297912835275709052311299551864192658177304486399283699058384364751376568714457361090099824205847610164922413207048832164141112741434740690851620879666916091683114805059397520385319965609291355819302668926633114618391597972110270104195729524521712155052417250364832858246777602394209216012243471719585422463867924602236259070514326289155605995143153426519592268534452020820494702940294360007255909971183689215427975382460838239606147437401771039532404179010791325434773433170447691511043481857627662741058910094855501029573945308325534013127380693322055343068093073))
+ (0 -7305781671042805086205879027901218372025263744748476920370936801215407682690507181906856060500614379569331564964369672229742583709815447579920249246854986585035499467980872113078927984775191185433409825799075510115669850322522523768142598684481781858254267858499128954637862215107851239397355311785880257523971110240017078879170794103136756816178851155500522519324993786026829680880063502983144325993463559477297984845168078230705008144229777150602704982383890956566628052218375163513110904344758464487972471262152773773566261138354198738738504010228322403241824600361830597196538559114936352203702189317843297305612))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 17209502052655993695999949678678881817732805080961191774214537634467104669997820051278559964292611469011761231649311262525642916746094372962648405298787080759403024379693612743720557853611946286870304197122036126838107226222151419136402861650399432372524638862075613534601535719033760228742681750726602275976151585576407980278472053570791272866409613117043122126348697545507835143620584132787128003876247255766444872271317786602207376422907474443135464267851639815814827163426470735478362760843575789201717413221027220343295978806345517086041608240978720520050196395624694268550345436208830801369557317350938753101681 -25492366031674865714603800130440722297248675391454036922399382654290017832413394991423912006244487394226853780856833445493556957899686872020567315114599762113500546176766623020864155665149937580279148318691466089932874147998457966225079089491216886106456935347049916843309661581230809710698689198580162954443484103521650233141750002940462046212610545804018834324858009370780731978549694951052575612824613445810777717659953126577086301947235560041125102454055651800601741899891885690488712713049609045874194541526013910595588271596050758340197535035493872183554373796733932414738278642683363241812520579194986842248406))
+ (-1 -8282863979018872018603850451761840479515870310492845148184845019822913162415574940145352041951875925215092549207522182967914041153592499057918909815812681354097521797073010277143597811537991293408844121569429963094766921776306547088676227840817453733932296484974303308708125862197049481956007447853560678467332517945242252863277949369670773346200932686975712198509311825272896834929110818265447608948366190044332845388635339974878925524328085597989638186204011984786914736465414955010349952206033256672477128304986690252292292789705241254155926794515151663504177401109238146187933206474532440442963261844048089146725))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8264418404762904935971540586212553189369665581268178138984287355704267971035469114147004054957406066365602520300857203610010249719556414712966642864630190534880504909484466848336120976452116710282569157883499369927614177722612839620755683557142607127318366680113418741529273669250116389195268121444810596743918472573214391707744942602210637166261703132552343842498400457951297867678005414165609775233338084350550320105330065321705398390488050253072298385134487973139665686164664754618413684815943926055617247418686500187322182211450203615430634564054858334306443836925011966962933359925972720453678168762605413687214 5659270408666391096654451960229302202479994399681938594290004159630195588392730314741316662127233421095165804881532974934939182755121225362126950700260935754690609887023434283325604581248499606543036334396521593447377999307285561199879892626309791285854660250329582118972672086769638010239857182094917068742207521552140484875546416914612991626798295801703343486711676899362639653362756374154843829963089403048720579483739833657436575344900585844370562669493206999896738589003961397524062927929845521761767153927579517203070144813897742036471334901681673999002492983666998353060616069539877603853178826800408499832716))
+ (-2 3054122412569877257337363334246051215590323218095699049595720963556123205749991515335629269297060775824729089462208746259868115790686036011287258535891680974500714864562401718315088186044882502803503510909543816967141820891958282779004101695476975444390953820545745496416070504289159631284446242745023540740496570531066578043347891227015346087334888470854343130924953340773981439047507334144077884692840721746890838862149601993167752299313121435668826953851926026653811491843258040429712171043747117467917060436472534218818107416345280457512035239308489663698542130408984739158298779153782487252679484838211585978218))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4195250682093770808206657488351701663023767531608220002369022288787894743733460069813218793361969185403525213558437941222523116136985128137372308027033996674188008302853626391013869026313385724383785051935256506784450227965020957296318645208598488161413279403683346821629439117327209071527878791167163980953326296620631874274522101994118890706372879111377721965738161511000396672294975037034526549811513789043244305969633354034500541113123255063232374386942908997046756046017320772897856114275234707703184161983806610888947627465435762937561231247173215724615365040435541390265704981699351563837340527277633975576176 -11523670060248463390302653643248573080204626895667435502164973305972185748470395654926094006744012148505197326052121545710242241891352369937317053719774706293090545099894988182012473466703170157783937873302934404896538337261995680454862441735502556865637909145839304694688324140057229642104588273654096346180116632418345589170248829444934471179206795690822184585196864577932274205101316913141872261673241280391442045565990088555353753789476615480189520529331131737084431448177942371080785938641454814169544682945510387155405628842164935394830439534834414364899293061798829902686953424000191565445443376301466821322836))
+ (-1 -7328419378154692582095996154896871417180859364059215499795951017184291004736935585112875213382042963101672112493683604487719125754367241799944745692740709618902536797041361790998604440389784433400152821367677898112088109296974723158543796526904068704224629742155957873058885022730020570576709482486932365226790335797713714895726727450815580472833916579444462619458703066931877532806341876107345711861727491348197739596356734520853212676353360416957146142388222740037675402160621598182929824366220106466360520961703776266458001376729172457269208287661198640283928021363288512421248442300840001608102849023832845746660))
+
+;;  ---- Test von / ---
+
+(my-assert
+ (/ 10105597264942543888 14352488138967388642)
+ 5052798632471271944/7176244069483694321)
+
+(my-assert
+ (/ -17631701977702695093 3931860028646338313)
+ -17631701977702695093/3931860028646338313)
+
+(my-assert
+ (/ -1606495881715082381 16324360910828438638)
+ -1606495881715082381/16324360910828438638)
+
+(my-assert
+ (/ -7960193178071300653 -10280747961248435844)
+ 7960193178071300653/10280747961248435844)
+
+(my-assert
+ (/ -11544909483975853384 -16041992360613233027)
+ 11544909483975853384/16041992360613233027)
+
+(my-assert
+ (/ -5758820541298901548 -2596462557714095861)
+ 5758820541298901548/2596462557714095861)
+
+(my-assert
+ (/ -13056342734667572546 46502284983183419157350605242474199851)
+ -13056342734667572546/46502284983183419157350605242474199851)
+
+(my-assert
+ (/ 12668118634717482325 -338544675918656078399121171905238525746)
+ -12668118634717482325/338544675918656078399121171905238525746)
+
+(my-assert
+ (/ -16738429327795346815 164053836541028518093058940786011794219)
+ -16738429327795346815/164053836541028518093058940786011794219)
+
+(my-assert
+ (/ -9884600460121235549 -53914696297933680001835530599748561584)
+ 9884600460121235549/53914696297933680001835530599748561584)
+
+(my-assert
+ (/ 6753521264659576004 71759828079371803409570464915096122874)
+ 3376760632329788002/35879914039685901704785232457548061437)
+
+(my-assert
+ (/ -6072478784520825268 83641961138289700975241455431547940418)
+ -3036239392260412634/41820980569144850487620727715773970209)
+
+(my-assert
+ (/ -6708950756971973620 -9847903810677323447803434015107261150885944735136350527205856921771320298384705376646797569973415403097847060539915279223391112430240736564839483430569706)
+ 3354475378485986810/4923951905338661723901717007553630575442972367568175263602928460885660149192352688323398784986707701548923530269957639611695556215120368282419741715284853)
+
+(my-assert
+ (/ 11263779860755455072 2292311486393743282743453705144070351222990311578446825826935237655927864700827857707370158936582804478427014131790879562565658386819339761919809732496450)
+ 1877296643459242512/382051914398957213790575617524011725203831718596407804304489206275987977450137976284561693156097134079737835688631813260427609731136556626986634955416075)
+
+(my-assert
+ (/ 9956488981426387585 -12351244248621474338537656633137999145154500022264356186225225426288301330225259889671144104952158102155582320296061124840400655528634050137479515338944145)
+ -1991297796285277517/2470248849724294867707531326627599829030900004452871237245045085257660266045051977934228820990431620431116464059212224968080131105726810027495903067788829)
+
+(my-assert
+ (/ -14875992781716065391 4906952781757522095285156014969507916562921709689447567404076064849249737893410245743456952512717420040816186768213920574809530298070437840356629617118643)
+ -2125141825959437913/700993254536788870755022287852786845223274529955635366772010866407035676841915749391922421787531060005830883824030560082115647185438633977193804231016949)
+
+(my-assert
+ (/ 16043178952268979636 -4962728781666935768923030490263743715131420507991284894489828489607808897271220927863958149140648859077934323268424257800724618076505149638049461104621679)
+ -5347726317422993212/1654242927222311922974343496754581238377140169330428298163276163202602965757073642621319383046882953025978107756141419266908206025501716546016487034873893)
+
+(my-assert
+ (/ -14889985628902581941 3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361)
+ -14889985628902581941/3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361)
+
+(my-assert
+ (/ -1719613957783789857 19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758)
+ -1719613957783789857/19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758)
+
+(my-assert
+ (/ -10969623867482498359 1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595)
+ -10969623867482498359/1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595)
+
+(my-assert
+ (/ -3716891004757979686 -19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987)
+ 3716891004757979686/19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987)
+
+(my-assert
+ (/ -4863232114852441787 -22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720)
+ 4863232114852441787/22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720)
+
+(my-assert
+ (/ -16248276650501285553 -3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159)
+ 16248276650501285553/3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159)
+
+(my-assert
+ (/ 18296946401228630959 3302341071702763311560113831030141639804425031433511503765833897787925467295486187687396312611805794369889470239777040624530990622212474466940548049117664906468330871893337410618797113677420975837622378808494314918471282099855916016026079371666730617071364751834080179173620476977670099126230223862266413091012344741482772771219725893630556702028108027870656512750807359335108428687238687397060104669074315031780019301768744978815422943986587389425726602444937024004102212071953113581935989741954695450085391443134273670514145585869912689150728183940456773133212037846765421397201956541430155664614978559762638030787)
+ 494512064898071107/89252461397371981393516590027841665940660135984689500101779294534808796413391518586145846286805562009997012709183163260122459206005742553160555352678855808282927861402522632719426949018308675022638442670499846349147872489185295027460164307342344070731658506806326491329016769648045137814222438482763957110567901209229264128951884483611636667622381298050558284128400198900948876451006451010731354180245251757615676197345101215643660079567205064579073691957971270919029789515458192258971242965998775552705010579544169558662544475293781424031100761728120453327924649671534200578302755582200815017962566988101692919751)
+
+(my-assert
+ (/ -60488682170925814337492051725122486652 14880088785789146426)
+ -30244341085462907168746025862561243326/7440044392894573213)
+
+(my-assert
+ (/ 126617729996196635247771282957911941277 -7166506344996883172)
+ -126617729996196635247771282957911941277/7166506344996883172)
+
+(my-assert
+ (/ -278675896803726074870988122161067771390 7744689831802931490)
+ -27867589680372607487098812216106777139/774468983180293149)
+
+(my-assert
+ (/ -283351838662873779255871649630248958879 6912311315831153835)
+ -14913254666467041013466928927907839941/363805858727955465)
+
+(my-assert
+ (/ -9715584046609700027352634666499181378 3368831995960494221)
+ -9715584046609700027352634666499181378/3368831995960494221)
+
+(my-assert
+ (/ -137493547985106345282009151869389470397 -1916381539906956855)
+ 137493547985106345282009151869389470397/1916381539906956855)
+
+(my-assert
+ (/ -328662747577960331872949773416436800743 -231069430804205460334599495337085157308)
+ 328662747577960331872949773416436800743/231069430804205460334599495337085157308)
+
+(my-assert
+ (/ 213595640581249636406536485951630735277 -48492294677143227478357598229530842959)
+ -213595640581249636406536485951630735277/48492294677143227478357598229530842959)
+
+(my-assert
+ (/ 85922846498729014445816145204889624189 193533957681757355413031965695625196813)
+ 85922846498729014445816145204889624189/193533957681757355413031965695625196813)
+
+(my-assert
+ (/ 24053342958857142686054803491202486471 196417511107100936775397820630955772553)
+ 24053342958857142686054803491202486471/196417511107100936775397820630955772553)
+
+(my-assert
+ (/ 102038936612518756467074084117019701214 -111946989731587760700903475996379168167)
+ -102038936612518756467074084117019701214/111946989731587760700903475996379168167)
+
+(my-assert
+ (/ -3006867214208872584699983438179656913 -234257597822744479264249663225224173340)
+ 3006867214208872584699983438179656913/234257597822744479264249663225224173340)
+
+(my-assert
+ (/ -279839802710533516603863620922251878907 -3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219)
+ 279839802710533516603863620922251878907/3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219)
+
+(my-assert
+ (/ 123635964546481689465778244982425098404 7701433613491146708866098469269971554817017737111287276993583150548359764165526640986060909954451793171933304569726872785964805121981749276421956645830854)
+ 61817982273240844732889122491212549202/3850716806745573354433049234634985777408508868555643638496791575274179882082763320493030454977225896585966652284863436392982402560990874638210978322915427)
+
+(my-assert
+ (/ 166158110049010486343321316578688184578 4093720847216792748840371965199135052196058344862447621818024731938681519017878880275303125899149558774718190527651555811733139227128378041055212888819294)
+ 83079055024505243171660658289344092289/2046860423608396374420185982599567526098029172431223810909012365969340759508939440137651562949574779387359095263825777905866569613564189020527606444409647)
+
+(my-assert
+ (/ 147416259636838312272435267341375281181 -11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801)
+ -147416259636838312272435267341375281181/11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801)
+
+(my-assert
+ (/ 102557200511608632541115941654031896919 3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511)
+ 102557200511608632541115941654031896919/3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511)
+
+(my-assert
+ (/ 47794953079190110032282671989549362415 3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667)
+ 47794953079190110032282671989549362415/3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667)
+
+(my-assert
+ (/ -169956065319483471022234920202991103615 -9934427489865644196610501807375648335352544234206717324511161205173460054921759084767897792996557220898467288533128078406604709773449948420404563411793533441010236017064154469575084055359823982786110746700747423674942932421964955746280671982635899487781780756099620799397239156211815110739544719746684712086075069101799537802834839550142629064374734870047412916259754010150500874430055034366305216104752636211802195447299210332237598443674867760860326529472901775427058078447963316168327741049511844237329137194533000697525539835371015163158135757326482343130221118201740819963770851200676279882978581431999960842565)
+ 33991213063896694204446984040598220723/1986885497973128839322100361475129667070508846841343464902232241034692010984351816953579558599311444179693457706625615681320941954689989684080912682358706688202047203412830893915016811071964796557222149340149484734988586484392991149256134396527179897556356151219924159879447831242363022147908943949336942417215013820359907560566967910028525812874946974009482583251950802030100174886011006873261043220950527242360439089459842066447519688734973552172065305894580355085411615689592663233665548209902368847465827438906600139505107967074203032631627151465296468626044223640348163992754170240135255976595716286399992168513)
+
+(my-assert
+ (/ -83006311763073652927964071041666508273 13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690)
+ -83006311763073652927964071041666508273/13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690)
+
+(my-assert
+ (/ -312626207169475064151212222217866488926 6989069923898656093413456232544365450599471748502878018530391549015151484336014906416216966193568842618920902504390187814247729346977677905224098932673981665869061845335443588666641982676550205160521286690015544764015602751932938178737949961754714143180917985455875095030469699198116593730005119922928175789172042067281849364217595912265452199938281052984802042194034638773435768458457616208103331213440768472281882976004050012769415198321241810008696147179275528426468408383757692656341606162350211696837361434874035354680073309142183699892959618671515841112321607728427286289324836870027735590091451421689980776552)
+ -52104367861579177358535370369644414821/1164844987316442682235576038757394241766578624750479669755065258169191914056002484402702827698928140436486817084065031302374621557829612984204016488778996944311510307555907264777773663779425034193420214448335924127335933791988823029789658326959119023863486330909312515838411616533019432288334186653821362631528673677880308227369599318710908699989713508830800340365672439795572628076409602701350555202240128078713647162667341668794902533053540301668116024529879254737744734730626282109390267693725035282806226905812339225780012218190363949982159936445252640185386934621404547714887472811671289265015241903614996796092)
+
+(my-assert
+ (/ -151709660794612786408772973806200383563 -26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443)
+ 151709660794612786408772973806200383563/26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443)
+
+(my-assert
+ (/ 138834496986391136939574372853300933725 -8052690543272184576133758511645801940246473546142520821850130421981395129853341888352999304040698251945886555605291324954368612109314080471658982022831338507499254609048475429862437003158379101603576571787302167207044118847876475134352180874260998595377014195145760071923429129767580115085764485254455919915567128572731355497418831212259648020550107573824886521471697331410754043280744066090848295906051303624846301488010249980896364883452154860562864255354208802313850527991005497484253401461375477060954782095047043919500670383372218536999834862885439984085848342867301834247551832677237328664699302165347765799113)
+ -15426055220710126326619374761477881525/894743393696909397348195390182866882249608171793613424650014491331266125539260209816999922671188694660654061733921258328263179123257120052406553558092370945277694956560941714429159667017597677955952952420811351911893790983097386126039131208251222066153001577238417785769269903307508901676196053917161768879507458730303483944157647912473294224505567508202765169052410814601194893697860451787872032878450144847205144609778916664544040542605794984506984917261578755812650058665667277498250377940152830784550531343894115991055630042596913170777759429209493331565094260318589092694172425853026369851633255796149751755457)
+
+(my-assert
+ (/ 276499207940187081393841843387608369874 27347897028734618663428054896349668572244941195143856840032842195489553215406302254043947382368793914074147314353589439281000471813879502242851166670252197853998033813694814376228360691543987661407996785043637351295817024680721181205269262470473172181965930243852520386958529041036476807810647578694133804796395977642274699322030062940721165202488695975750512485574440928370802874677938542169620505668128224812441566912043326338714451629730522324228356364241376445033028898865300103247057378058702233150414643818049655628999871012383236520330575609745427181485617250755214922048672375947942288446974485524776744246517)
+ 8919329288393131657865865915729302254/882190226733374795594453383753215115233707780488511510968801361144824297271171040453030560721573997228198300463019014170354853929479983943317779570008135414645097864957897237942850344888515731013161186614310882299865065312281328425976427821628166844579546136898468399579307388420531509929375728344972058219238579923944345139420324610991005329112538579862919757599175513818412995957352856199020016311875104026207792481033655688345627471926791042717043753685205691775258996737590325911195399292216201069368214316711279213838705516528491500655825019669207328435019911314684352324150721804772331885386273726605701427307)
+
+(my-assert
+ (/ -8979365591106781219797187096315899769868799444656824967426553299158070014074001230883484015880186603742048949313393413640240595706939311540002219411120389 -1698360947072008877)
+ 1282766513015254459971026728045128538552685634950974995346650471308295716296285890126212002268598086248864135616199059091462942243848473077143174201588627/242622992438858411)
+
+(my-assert
+ (/ -12831814656788829919185319784994714617782749504716966706877579983082880759985031662545957372565411439648298939198657738497464024214657609856476819270030801 454910754379715)
+ -273017333123166594025219569893504566335803180951424823550586808150699590637979397075445901543944924247836147642524632733988596259886332124605889771702783/9678952220845)
+
+(my-assert
+ (/ -7834266257250691217409788323211914445703052638619784568844628449769010091330019095736167988675873769434766592786720961949649685040028101508217441360672222 -428418418877192732)
+ 3917133128625345608704894161605957222851526319309892284422314224884505045665009547868083994337936884717383296393360480974824842520014050754108720680336111/214209209438596366)
+
+(my-assert
+ (/ 5737805823029931079838944835405107564434908634489801628049345331760087020955028323378020396677249341204498685189403657652738071833877470777083253103936452 9588993061977446661)
+ 5737805823029931079838944835405107564434908634489801628049345331760087020955028323378020396677249341204498685189403657652738071833877470777083253103936452/9588993061977446661)
+
+(my-assert
+ (/ -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045 15760991890495426717)
+ -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045/15760991890495426717)
+
+(my-assert
+ (/ 2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499 -6788234478844960330)
+ -2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499/6788234478844960330)
+
+(my-assert
+ (/ 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333 190237375887614033974333796608341639595)
+ 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333/190237375887614033974333796608341639595)
+
+(my-assert
+ (/ -12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472 -41681385674896602840749705069663453185)
+ 12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472/41681385674896602840749705069663453185)
+
+(my-assert
+ (/ 13185465843955116174925558412278612918939024395488172088108029202384613698982949554556435640011161663974075894844304583900497170806796813871943782330552768 -155202352609947911537719051033334010254)
+ -6592732921977558087462779206139306459469512197744086044054014601192306849491474777278217820005580831987037947422152291950248585403398406935971891165276384/77601176304973955768859525516667005127)
+
+(my-assert
+ (/ 12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044 -249441012384365373362771955533424187237)
+ -12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044/249441012384365373362771955533424187237)
+
+(my-assert
+ (/ 8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433 -23101645464137481399279134347982485126)
+ -8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433/23101645464137481399279134347982485126)
+
+(my-assert
+ (/ -10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192 -25611473771508763579433379623726126173)
+ 10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192/25611473771508763579433379623726126173)
+
+(my-assert
+ (/ -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974 5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627)
+ -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974/5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627)
+
+(my-assert
+ (/ 7706102251141221799524762336156378964168657337573751909064577951085535246905735244239132983582998872001001594454632956803416956154262109939446710205558308 6334400709835247308796432875490978646658012545184955441452799118298109610816693049400832749087993843490999852355789914065232784070007399786089389453289854)
+ 3853051125570610899762381168078189482084328668786875954532288975542767623452867622119566491791499436000500797227316478401708478077131054969723355102779154/3167200354917623654398216437745489323329006272592477720726399559149054805408346524700416374543996921745499926177894957032616392035003699893044694726644927)
+
+(my-assert
+ (/ 12609622044672092190084693450911157599596799695538449568681964257744962273690941575572590166273187189250007688411096790312605666562908125521094386992971478 -8237858212652788898158635047388584411011830102060269605835391741772914864422465141467281143809161251942948659243584296367296559912373856433388249393853968)
+ -6304811022336046095042346725455578799798399847769224784340982128872481136845470787786295083136593594625003844205548395156302833281454062760547193496485739/4118929106326394449079317523694292205505915051030134802917695870886457432211232570733640571904580625971474329621792148183648279956186928216694124696926984)
+
+(my-assert
+ (/ -9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785 -1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086)
+ 9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785/1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086)
+
+(my-assert
+ (/ -10729942326579120947061030583094707809945059776287551713953926998992375520903658867971835616518813070294302895655369081976222497359056962112544408591462495 -4917625712783289245414023733273041940212797202855299465496072729329693853584860839801663152618595377553772371725021213143455497822882736730281253858119747)
+ 10729942326579120947061030583094707809945059776287551713953926998992375520903658867971835616518813070294302895655369081976222497359056962112544408591462495/4917625712783289245414023733273041940212797202855299465496072729329693853584860839801663152618595377553772371725021213143455497822882736730281253858119747)
+
+(my-assert
+ (/ 8114113595157517238445304590338354472776364877475201453112450680537221171989478096363668912966343706408770932684807802285529572133696646343108263717309148 5443953102973235688784499815692116502566847594605098596244123647428188581304528525010862185203718640610834003873728718183528722470626702382993497913086105)
+ 8114113595157517238445304590338354472776364877475201453112450680537221171989478096363668912966343706408770932684807802285529572133696646343108263717309148/5443953102973235688784499815692116502566847594605098596244123647428188581304528525010862185203718640610834003873728718183528722470626702382993497913086105)
+
+(my-assert
+ (/ -7125100205152691887479515774712530950031072786448635736036405923401522078562323494262148946679985384635556474075282302608446439950458673260234175964199684 -23871420315894180764743988478670341498770583257649869670486332228804693253344466615199983955886679924409910043885402198203427975742868174334723967563526738510726448815413356678504144193747696164586135745786501041060322480940451156015256191962506052700295351077719851275026974629635679531161390660244641370183176979934485671396035404817388717005746812037357500295693454623478902942336087760288091719793968445716246099043828787040340339906538864570506773535078524092440112404847904632624419421052178754041718790915772437556681684830937503838434712179830722395832238257078212535157309743054115702650740005055678387806081)
+ 7125100205152691887479515774712530950031072786448635736036405923401522078562323494262148946679985384635556474075282302608446439950458673260234175964199684/23871420315894180764743988478670341498770583257649869670486332228804693253344466615199983955886679924409910043885402198203427975742868174334723967563526738510726448815413356678504144193747696164586135745786501041060322480940451156015256191962506052700295351077719851275026974629635679531161390660244641370183176979934485671396035404817388717005746812037357500295693454623478902942336087760288091719793968445716246099043828787040340339906538864570506773535078524092440112404847904632624419421052178754041718790915772437556681684830937503838434712179830722395832238257078212535157309743054115702650740005055678387806081)
+
+(my-assert
+ (/ 4801495919363827077158204249631885157347198552733998896638174958434968555935827788499392382851493568264006507028024783408190862186734863708684652212703744 29234959990138609668202089052356468732793041824333219340488007351402997202222578434579705387840772390513345507274006495462445058795870182760749392281528881636623188890883479914921272700981309656920982410970774047916714087713562927554033500521877735827036675598267184309367127514966388636440710253467328441763131873309183205727440365838789320851968108312559316922678357314418486932673434031479515016224407618177089903730349114511598373251388750023508633761000320088841886505077453257141723747388913336375142897897501529451618927178835485127020789481918641637409265186365292847057986276062625965612268181771076051892980)
+ 1200373979840956769289551062407971289336799638183499724159543739608742138983956947124848095712873392066001626757006195852047715546683715927171163053175936/7308739997534652417050522263089117183198260456083304835122001837850749300555644608644926346960193097628336376818501623865611264698967545690187348070382220409155797222720869978730318175245327414230245602742693511979178521928390731888508375130469433956759168899566796077341781878741597159110177563366832110440782968327295801431860091459697330212992027078139829230669589328604621733168358507869878754056101904544272475932587278627899593312847187505877158440250080022210471626269363314285430936847228334093785724474375382362904731794708871281755197370479660409352316296591323211764496569015656491403067045442769012973245)
+
+(my-assert
+ (/ 10769619761532897875307527770350128978615798426116103116325434914975512103385205123955114305107607195469345895102375220593168903042839441996791318999499708 -7224105715967976893083374742254251507019823877014718307738328810406361200631626366722837314776666720638271529652546975342143108973422364041422652163016078890272393678677152791565494865444430757858556891645947268886646732022748338160528677218733159766121781240328812893374941548395710123982510227501927393735585082736583984561348450061452997663109932611188779299623613963995350679177776686423432406091192517292522853783968685873925548901506191291253596763183277703635837071862492572256145656312023955675669362656148946145528559574994353884313568526553663370513565393821926602014407548325293145102073923450066319746913)
+ -10769619761532897875307527770350128978615798426116103116325434914975512103385205123955114305107607195469345895102375220593168903042839441996791318999499708/7224105715967976893083374742254251507019823877014718307738328810406361200631626366722837314776666720638271529652546975342143108973422364041422652163016078890272393678677152791565494865444430757858556891645947268886646732022748338160528677218733159766121781240328812893374941548395710123982510227501927393735585082736583984561348450061452997663109932611188779299623613963995350679177776686423432406091192517292522853783968685873925548901506191291253596763183277703635837071862492572256145656312023955675669362656148946145528559574994353884313568526553663370513565393821926602014407548325293145102073923450066319746913)
+
+(my-assert
+ (/ 1505915608160301518246681692927442986955390537144107830770082927276722640395785957392652130911646706470337068266772174699405268120590454296080828168261019 31152879253507543898583880698200027990847289346701738353567402100527465991154555548630544962150902011282973749886327325250084401181379196961322399337408341296727915922288276602390334861175305055229766353672502691855637668618950047400571070157436221479289152631256433294884836727331457389922838951144187501751190662594278336543502171639899940796536926507796271202659224890656712231014450702948847764643603683153113663072089256293587951842007583210791100743318865647555912543508324790181772321217524164822106191538518498016236866957803105254555578252294418243701672226181762763332992886540089416888889135117147250495261)
+ 1505915608160301518246681692927442986955390537144107830770082927276722640395785957392652130911646706470337068266772174699405268120590454296080828168261019/31152879253507543898583880698200027990847289346701738353567402100527465991154555548630544962150902011282973749886327325250084401181379196961322399337408341296727915922288276602390334861175305055229766353672502691855637668618950047400571070157436221479289152631256433294884836727331457389922838951144187501751190662594278336543502171639899940796536926507796271202659224890656712231014450702948847764643603683153113663072089256293587951842007583210791100743318865647555912543508324790181772321217524164822106191538518498016236866957803105254555578252294418243701672226181762763332992886540089416888889135117147250495261)
+
+(my-assert
+ (/ -4912349668310730778272626761660101328812783790262451913449395750351147048676353891314609774894027305081515542385381430403698808605768281804457186380542764 6582102431028556562269167182029950958541569095123705594954788174046339660437206159173417583841743892857066740116322758515837624700881569925244230209567223461401193316695082415261197843574563450002486582967745135870782254839990479649574452750850133306720341823136645982650022199634379361313745598455049448887744206616434903460504591098363901961758069797933831934878649993183747273660007900662110776570580293994733189753806312784239743585453090900671308673380802381312083077891736513388250097195232616017027333586286786139736783210630705878401429301217589001317082952461701571026008195534878902572422952568763551674434)
+ -2456174834155365389136313380830050664406391895131225956724697875175573524338176945657304887447013652540757771192690715201849404302884140902228593190271382/3291051215514278281134583591014975479270784547561852797477394087023169830218603079586708791920871946428533370058161379257918812350440784962622115104783611730700596658347541207630598921787281725001243291483872567935391127419995239824787226375425066653360170911568322991325011099817189680656872799227524724443872103308217451730252295549181950980879034898966915967439324996591873636830003950331055388285290146997366594876903156392119871792726545450335654336690401190656041538945868256694125048597616308008513666793143393069868391605315352939200714650608794500658541476230850785513004097767439451286211476284381775837217)
+
+(my-assert
+ (/ -11503235648135220410087372678575470255397243144180272745183844970864347348074104828328211521698012119761674096067066173927209129755062269068090560678650614 -5548338218081690289723998288742945948643693817491921699797822887914665364835947234564530865119623677435878746610856459141463506776423054050179729345956931675338102809929977610828639446535095411122377961067651902947030310564736893080382424590568134091858634304377553326990788802662029347894499019277621467098333287442862683493159356014650672092060912274570436879076161496563079759704321556494898013269338428360856068237785049960484767969682269790642298701577934519452927652996671267126348627432295779183359417597868330923329974640383630473044712419371517153268338860560601603043892503067815822312755611206254762903436)
+ 5751617824067610205043686339287735127698621572090136372591922485432173674037052414164105760849006059880837048033533086963604564877531134534045280339325307/2774169109040845144861999144371472974321846908745960849898911443957332682417973617282265432559811838717939373305428229570731753388211527025089864672978465837669051404964988805414319723267547705561188980533825951473515155282368446540191212295284067045929317152188776663495394401331014673947249509638810733549166643721431341746579678007325336046030456137285218439538080748281539879852160778247449006634669214180428034118892524980242383984841134895321149350788967259726463826498335633563174313716147889591679708798934165461664987320191815236522356209685758576634169430280300801521946251533907911156377805603127381451718)
+
+(my-assert
+ (/ -22964048032108117904633365483799091488990853392670636861794813863757795874434768543212887316456319246155824842161717179767513360050328383696194174741889496306018655333450647372293193335577883672679165775070112770359697627614883420620410888137853011387271594559450892054491963940112235887802995117234918878648066362268919389271696465517050425727202664230530633207566444357393843669758809938086228366322548799235049875711702216182219182908217345405023677260470015666831191434586902791186444958476491096759363292487221288620810273243009200212776634572092195691654105986099646006756823055390654876878195583529521482548988 10644501761877612307)
+ -22964048032108117904633365483799091488990853392670636861794813863757795874434768543212887316456319246155824842161717179767513360050328383696194174741889496306018655333450647372293193335577883672679165775070112770359697627614883420620410888137853011387271594559450892054491963940112235887802995117234918878648066362268919389271696465517050425727202664230530633207566444357393843669758809938086228366322548799235049875711702216182219182908217345405023677260470015666831191434586902791186444958476491096759363292487221288620810273243009200212776634572092195691654105986099646006756823055390654876878195583529521482548988/10644501761877612307)
+
+(my-assert
+ (/ -19058897134776675884737764093896349427183484738023061956638485191239529906311503740032626797095131123523175909943402828257449376045336777553758951620699386266853663342003969442142858702229701661125904623724248177901462857013835790939020450746503125344631958534655024089231193396521561965297735217497608287565163852923704017958259400904834287026933197193592591423799328167149965328232560408884408251535373934831244856695227539243433290481951528897142697352526450162440279318507285454432916819060795455956931254810171588139618689138022062041222735056137988435900866680084665165131313435515187611756148824388549448126467 -8326067459929079652)
+ 19058897134776675884737764093896349427183484738023061956638485191239529906311503740032626797095131123523175909943402828257449376045336777553758951620699386266853663342003969442142858702229701661125904623724248177901462857013835790939020450746503125344631958534655024089231193396521561965297735217497608287565163852923704017958259400904834287026933197193592591423799328167149965328232560408884408251535373934831244856695227539243433290481951528897142697352526450162440279318507285454432916819060795455956931254810171588139618689138022062041222735056137988435900866680084665165131313435515187611756148824388549448126467/8326067459929079652)
+
+(my-assert
+ (/ 25828007361450952719858846443651616751980622231808382804245407702688699228397920589229449608543284896555585501243582045708656531815385828908740757435341854996277769645696261182122648194952548457487178342682313459444433667556195761154944956714756269417591048771194019245925463541886773351873002480266654825771525233808830260734678788520487541379982691221386179066818743751876186761036101255542680066874888848011074569355779905086056095043888696435054884292698783753890317487209955316141370052511469715869816445031102161253514609763532756500340262263800747279044587806090353812452308490155782240390040070679663451429071 -16419739031141199968)
+ -25828007361450952719858846443651616751980622231808382804245407702688699228397920589229449608543284896555585501243582045708656531815385828908740757435341854996277769645696261182122648194952548457487178342682313459444433667556195761154944956714756269417591048771194019245925463541886773351873002480266654825771525233808830260734678788520487541379982691221386179066818743751876186761036101255542680066874888848011074569355779905086056095043888696435054884292698783753890317487209955316141370052511469715869816445031102161253514609763532756500340262263800747279044587806090353812452308490155782240390040070679663451429071/16419739031141199968)
+
+(my-assert
+ (/ -1669696848499325185991294008037906453080648048592518700324899343297324898656645662186964240087582483813312797482298159224575128489696846451225871663856944749639170892311973606684486632224811435175199158920841554176114937196187087530038509898368755036744105403511353564606301040888877621412514452110348953863172547944175251415725815533087344857665837809749724257466399374547882097484009980477192931829030533366309859182367479867549644502538060694266048652224732348150866071381652452605392696555259221463464108413747443898588713629829490175098280805280460168541344102200890646453100478450456898359263676257882174308268 -3154577849943484396)
+ 417424212124831296497823502009476613270162012148129675081224835824331224664161415546741060021895620953328199370574539806143782122424211612806467915964236187409792723077993401671121658056202858793799789730210388544028734299046771882509627474592188759186026350877838391151575260222219405353128613027587238465793136986043812853931453883271836214416459452437431064366599843636970524371002495119298232957257633341577464795591869966887411125634515173566512163056183087037716517845413113151348174138814805365866027103436860974647178407457372543774570201320115042135336025550222661613275119612614224589815919064470543577067/788644462485871099)
+
+(my-assert
+ (/ -2215504974719141921873290809898041836016933916943403987778356628123168736190963062169230280020568365292362281642280014010817115943641228422541948070912910166283758843455538187697141038676028739959626556519808411324617157646799936128314485433146912658200236754847332237438334421065771940922444296618134121662770699950019164632463150784605652351782139277998735272280336096528241168196650073301607171613955878761317417480490869592669781417658461696905996344800864447403426286476662235990122025654999230690604488053668524888833992415515434190712628587043474760836969696399229242018051635699746048823240033842587927229964 -11305319675542865070)
+ 1107752487359570960936645404949020918008466958471701993889178314061584368095481531084615140010284182646181140821140007005408557971820614211270974035456455083141879421727769093848570519338014369979813278259904205662308578823399968064157242716573456329100118377423666118719167210532885970461222148309067060831385349975009582316231575392302826175891069638999367636140168048264120584098325036650803585806977939380658708740245434796334890708829230848452998172400432223701713143238331117995061012827499615345302244026834262444416996207757717095356314293521737380418484848199614621009025817849873024411620016921293963614982/5652659837771432535)
+
+(my-assert
+ (/ 24358677073350645219370308521851912760304925518671532565724702185818845784332554892130070740233218685874351979772556877899278790031132507391155876157108663291716896413773711734271947599485714147026138105714458778787734198938526335256418673319464023475137997251085298903419563039860433435847755093653670989129405749785476487449599232956305952768800154351414655365461746574761818724131185410194605648466196476174400166047788352670171627261342369793028465418799251589432585363577887467959594667618177199696618852093807640490831859585621198048572586882398004957371434677752931134884039120875470266936204172511104679441462 8754800987327220648)
+ 12179338536675322609685154260925956380152462759335766282862351092909422892166277446065035370116609342937175989886278438949639395015566253695577938078554331645858448206886855867135973799742857073513069052857229389393867099469263167628209336659732011737568998625542649451709781519930216717923877546826835494564702874892738243724799616478152976384400077175707327682730873287380909362065592705097302824233098238087200083023894176335085813630671184896514232709399625794716292681788943733979797333809088599848309426046903820245415929792810599024286293441199002478685717338876465567442019560437735133468102086255552339720731/4377400493663610324)
+
+(my-assert
+ (/ -26302114071841994464108666310942614602208671348774320769941579409198660404735714925432808094014718434192516800374483192192707032773903982752997957629389083405320034044554226640590549491188742685901503166669355807243735533977994184111229208270447279559478659750835531593667003322059717930484363943660175452777363121025595100592911646539549735930625865256846706785601753749996181113742254145758187876411260965175520035400453360390392991183382425735199046574346992179663247011131958270717402007532256308394559029768974932620173103778338779940189812875680687510582798628982957687329572431433891809534332514765287899172737 196971971351558855568201373145365478995)
+ -26302114071841994464108666310942614602208671348774320769941579409198660404735714925432808094014718434192516800374483192192707032773903982752997957629389083405320034044554226640590549491188742685901503166669355807243735533977994184111229208270447279559478659750835531593667003322059717930484363943660175452777363121025595100592911646539549735930625865256846706785601753749996181113742254145758187876411260965175520035400453360390392991183382425735199046574346992179663247011131958270717402007532256308394559029768974932620173103778338779940189812875680687510582798628982957687329572431433891809534332514765287899172737/196971971351558855568201373145365478995)
+
+(my-assert
+ (/ -25700334917103749626396366612061842558162882395534131493737229591609654899446089376271023701490708870843231350129849819430092002268875830384992877382393956173037794109904701961390126146975281052960293513473777226100954163054292968509501976296424278813632162404905591038465215586347229260479401862039805429711982871702185657527199220459658257385112793877259572278229045135617281858788415643567614198333459934599272409406206213115625226065750113120833933806486512117533453281522448845990642550827848765145774541658722594353290694745164913189694785762218575339370800538946514325662656804799046877175035545715523049884960 56325873113907570153638933263921340484)
+ -6425083729275937406599091653015460639540720598883532873434307397902413724861522344067755925372677217710807837532462454857523000567218957596248219345598489043259448527476175490347531536743820263240073378368444306525238540763573242127375494074106069703408040601226397759616303896586807315119850465509951357427995717925546414381799805114914564346278198469314893069557261283904320464697103910891903549583364983649818102351551553278906306516437528280208483451621628029383363320380612211497660637706962191286443635414680648588322673686291228297423696440554643834842700134736628581415664201199761719293758886428880762471240/14081468278476892538409733315980335121)
+
+(my-assert
+ (/ -25716495567761925495340309269248196976121711927176026606462843116646034561721958499564011513233986043633061335866265799467020807570689498961190839877265773450484494789052182300993137822542881883769593344810286970036960228835955266304979090841345697560418139960733748874044680214388098802745248923989851173047158103142988835055585349795022662576576434371181693607267864646932929998659458265265400181839509356921460222604661909947838434113964465769102604033848276159366897885013231683417270877512514679528402888899725431524867260144325739317224922955028035417867933390409466302057857579158202739536568407090965929352402 -92089830031261826185903006947297196357)
+ 25716495567761925495340309269248196976121711927176026606462843116646034561721958499564011513233986043633061335866265799467020807570689498961190839877265773450484494789052182300993137822542881883769593344810286970036960228835955266304979090841345697560418139960733748874044680214388098802745248923989851173047158103142988835055585349795022662576576434371181693607267864646932929998659458265265400181839509356921460222604661909947838434113964465769102604033848276159366897885013231683417270877512514679528402888899725431524867260144325739317224922955028035417867933390409466302057857579158202739536568407090965929352402/92089830031261826185903006947297196357)
+
+(my-assert
+ (/ 6427758281007308443295844679532867042370757542760390680622584758338041709910068192973790897624827722686313216884084305612889554116246627679267186323854642904894988936981064543865794245002470271142875081223308666588659587718561791667575945670118263124267218395749059879636505504607358472659126298770422135028955713148882314050530771750859372048576074912599265823577267962213046012777760882389021047579367276198483178024744924299929585515193595330026399302022065656106472153858484998010254767462854235008343139218888170221421046454280858208068658907389288543063912721882521711363713136166478126504226820360347652405439 80854661163518168674595213426641201760)
+ 6427758281007308443295844679532867042370757542760390680622584758338041709910068192973790897624827722686313216884084305612889554116246627679267186323854642904894988936981064543865794245002470271142875081223308666588659587718561791667575945670118263124267218395749059879636505504607358472659126298770422135028955713148882314050530771750859372048576074912599265823577267962213046012777760882389021047579367276198483178024744924299929585515193595330026399302022065656106472153858484998010254767462854235008343139218888170221421046454280858208068658907389288543063912721882521711363713136166478126504226820360347652405439/80854661163518168674595213426641201760)
+
+(my-assert
+ (/ 1960728263483597985471065015024594804771170333646104429205729831998416939777820080209106943861368202560376682136488253096512360698625765514606930980274938979705620987031595592685578710084284618125325617453699875318678007463857705931376750632972266553809944621631324385690517092215690694024807784270742388108802858889381036105223858467345514041786882957807868961085072340965930749117411726729713477739990680381647988935514765113077094375924848051541167125595015542791382355149166582367766443782842193396221676952668624805183924877889696428989259842153378327156342464279071638070457876940165186524833987190050817072048 91266493124541431873557009470479491083)
+ 1960728263483597985471065015024594804771170333646104429205729831998416939777820080209106943861368202560376682136488253096512360698625765514606930980274938979705620987031595592685578710084284618125325617453699875318678007463857705931376750632972266553809944621631324385690517092215690694024807784270742388108802858889381036105223858467345514041786882957807868961085072340965930749117411726729713477739990680381647988935514765113077094375924848051541167125595015542791382355149166582367766443782842193396221676952668624805183924877889696428989259842153378327156342464279071638070457876940165186524833987190050817072048/91266493124541431873557009470479491083)
+
+(my-assert
+ (/ 4941680418946960910262990974014623728051861920391294141439502190044830922127013115391726343950340163023958511659132792063033185693862678433421115681422259770928656196358763089894449447854011668445981430826871764812047994423858851467292757304285634515474652989618200442851239459073981986390515468331839802701176644729973346052528164203299481240263263697394061787580128379398464090163611942724580936445878570184925290925246112514015572149640886198984723311273144361235138411362294735799814160816806773736605477503201836095726740734281001021071803299510239436683913500734680524381145064985356627091311888606290704759943 291575320383555320391938911470370670502)
+ 1647226806315653636754330324671541242683953973463764713813167396681610307375671038463908781316780054341319503886377597354344395231287559477807038560474086590309552065452921029964816482618003889481993810275623921604015998141286283822430919101428544838491550996539400147617079819691327328796838489443946600900392214909991115350842721401099827080087754565798020595860042793132821363387870647574860312148626190061641763641748704171338524049880295399661574437091048120411712803787431578599938053605602257912201825834400612031908913578093667007023934433170079812227971166911560174793715021661785542363770629535430234919981/97191773461185106797312970490123556834)
+
+(my-assert
+ (/ -17803449239532304707372697093467431202778585961066204978641168716990033159088600623106396534094218402005803618121159982050197012697237961155375180768349707725936023283589475384693590539312637333226292265409814019687105755522332846972859860649558844229320481883408457674560284773922666633054564243260924189551494368660033292970122831009582038986061326503238023206238467592238752824663935316307653075615249537594229930297642710570473007696494702367783692850946455203144153509057520651038068881755863521371187245025834292163874467913915588768778393773565536027848586260129438664753479013894698439967637389690509120223682 -10962227285754340409566802000064407225866105372406170304563353147415988225079632767886653994299800743521362563345682593189107807948342418743229049299449088)
+ 8901724619766152353686348546733715601389292980533102489320584358495016579544300311553198267047109201002901809060579991025098506348618980577687590384174853862968011641794737692346795269656318666613146132704907009843552877761166423486429930324779422114660240941704228837280142386961333316527282121630462094775747184330016646485061415504791019493030663251619011603119233796119376412331967658153826537807624768797114965148821355285236503848247351183891846425473227601572076754528760325519034440877931760685593622512917146081937233956957794384389196886782768013924293130064719332376739506947349219983818694845254560111841/5481113642877170204783401000032203612933052686203085152281676573707994112539816383943326997149900371760681281672841296594553903974171209371614524649724544)
+
+(my-assert
+ (/ -11349783565099575757929584771389010505157850113880084607145768380886038854233583951229136273631022011781914171912628263930864052254964518914857757025547156428098062812984733912827827545722979442676567330004437902674729872754963478834939047061999292143602525229120558979819117729589695377623970606315287270030693151486803968345724658003068961239204812937084581894755863859944500186226990319892122692007317326534880413455575446314965159569830188583093978564829748603480193166063624130610256395632946002879039047154077629561745862713628266069928068634042545592328263646730943717246953000457159714049930890865576634096206 -5169948998417532948043886408019867395123131165917923418040862036041756675786217242743410895008311710518018466892169868028617239526646914529999134517417939)
+ 11349783565099575757929584771389010505157850113880084607145768380886038854233583951229136273631022011781914171912628263930864052254964518914857757025547156428098062812984733912827827545722979442676567330004437902674729872754963478834939047061999292143602525229120558979819117729589695377623970606315287270030693151486803968345724658003068961239204812937084581894755863859944500186226990319892122692007317326534880413455575446314965159569830188583093978564829748603480193166063624130610256395632946002879039047154077629561745862713628266069928068634042545592328263646730943717246953000457159714049930890865576634096206/5169948998417532948043886408019867395123131165917923418040862036041756675786217242743410895008311710518018466892169868028617239526646914529999134517417939)
+
+(my-assert
+ (/ -4372008041495429462966226028389793326873997497126815043214338280101332483009650104005998792061125254101227371430911497751865710691604158789733634394053254604723940088324934622768312096370232736965692181452463495731681105253628558429524788376108667441329817524961077744083376843098018692898745743361309486938506049017980865957895278210133305721083115513131884239744064081819033733041876411992332060293539102545847193260167588667810376670587099064558298380310132769718526554738650709745767046942440481512965138461694790645096012018276362849398785863823724642554436182185786302301222529261914437437947741031113015699315 -13213007132248918651858333568248204618745148942720942572088217188768868803339938910599097839075045781852237705726227293430250507070717570662238736211897310)
+ 874401608299085892593245205677958665374799499425363008642867656020266496601930020801199758412225050820245474286182299550373142138320831757946726878810650920944788017664986924553662419274046547393138436290492699146336221050725711685904957675221733488265963504992215548816675368619603738579749148672261897387701209803596173191579055642026661144216623102626376847948812816363806746608375282398466412058707820509169438652033517733562075334117419812911659676062026553943705310947730141949153409388488096302593027692338958129019202403655272569879757172764744928510887236437157260460244505852382887487589548206222603139863/2642601426449783730371666713649640923749029788544188514417643437753773760667987782119819567815009156370447541145245458686050101414143514132447747242379462)
+
+(my-assert
+ (/ -24003371850945507239307096734506644624830254935119140199726507920301383328662376914775504920527918338079792692943250446679097229950654636321252144129692109999375967030689211646504258922323499994340282315270808545865248969923421472430657741998787024263629527291510416193284540865950122841477102934165296344839654902079279846705581902668360663987722715177845485423354226653585575109653937253382583158263755381721094429734122004436184054214443676096492583897635497699417294183504529284810360226314491839533303380490277211336049582128602304906849999737224506976061216780230350942535246958957024226614847691329767208211525 10686139440491678930358521446524488461285005495304677740436234635584738003880529034339295291091217655777627375148264449580064000634364863951333061091724053)
+ -1263335360576079328384584038658244453938434470269428431564553048436914912034861942882921311606732544109462773312802655088373538418455507174802744427878532105230314054246800612973908364332815789175804332382674133992907840522285340654245144315725632855980501436395285062804449519260532781130373838640278754991560784319962097195030626456229508630932774483044499232808117192293977637350207223862241218855987125353741812091269579180851792327075982952446978099875552510495647062289712067621597906648131149449121230552119853228213135901505384468781578933538131946108485093696334260133434050471422327716570931122619326747975/562428391604825206860974812974973076909737131331825144233486033451828315993712054438910278478485139777769861849908655241056000033387624418491213741669687)
+
+(my-assert
+ (/ 11114571678097117920369007866358540243142633567044843952020632081573546909920632543585596494530749645890342978505657174505155646987551523455565703297238406590291026899487431109110746657023874064284362499621762851387854720746040865741433394111425240861542892218169985953747711593827913014379823797703717216676877313898809377467394109623799717556800777662963842899812297087284510893865429864819927951428138755600792987191034272014681606301885821862650098620488569288170357746018556395309910262410994899971436293672676949544989196526035130226777567220128838888396668158456237490064462262193759918857287915854681904206680 4808076329737968688023887165061921594706561818755147855784713748545995818001333418509444774306288638038607173052166709335820929501845348060033808100812677)
+ 11114571678097117920369007866358540243142633567044843952020632081573546909920632543585596494530749645890342978505657174505155646987551523455565703297238406590291026899487431109110746657023874064284362499621762851387854720746040865741433394111425240861542892218169985953747711593827913014379823797703717216676877313898809377467394109623799717556800777662963842899812297087284510893865429864819927951428138755600792987191034272014681606301885821862650098620488569288170357746018556395309910262410994899971436293672676949544989196526035130226777567220128838888396668158456237490064462262193759918857287915854681904206680/4808076329737968688023887165061921594706561818755147855784713748545995818001333418509444774306288638038607173052166709335820929501845348060033808100812677)
+
+(my-assert
+ (/ -27971792815424016824370019866875377333122266892537700816201893161065327053508379094007350664178576160161460501442627646041422270472469587140689725524176629653056006769618104516779694726446739085332330345789012312708713495757968594985567285237456431009983022526625885024663335598317191838389804118084831445251467492693688286258834282078888862754754572546522075833632779922232880101875914894393005204887265821991459415144492487189071888581048779385051174007698853920104709378859053075296413813207007405843448595681090932498329066591349910723578718333092115184652723310842559914379989208301125396793101430807658654849482 3169580893680227534064172567436590084742349042688765883461923377455374714865282199177755353861979892274552092801376364846717140845237173266602633583445110)
+ -4661965469237336137395003311145896222187044482089616802700315526844221175584729849001225110696429360026910083573771274340237045078744931190114954254029438275509334461603017419463282454407789847555388390964835385451452249292994765830927880872909405168330503754437647504110555933052865306398300686347471907541911248782281381043139047013148143792459095424420345972272129987038813350312652482398834200814544303665243235857415414531511981430174796564175195667949808986684118229809842179216068968867834567640574765946848488749721511098558318453929786388848685864108787218473759985729998201383520899465516905134609775808247/528263482280037922344028761239431680790391507114794313910320562909229119144213699862959225643663315379092015466896060807786190140872862211100438930574185)
+
+(my-assert
+ (/ -138888658164471549506154385143989713534453638138516110941977029 48484067562152384719540184707188444570280914254129306788137384972303743285284814 56428088099244342456240635263153370817851703737803685168591843059886944388583310 6984617762898435035101945891920384937438416626357047934508608980105797822504000 90193136183227859939744547239819443586783276313678017953708293432043879247302040 70539472782976230144489157899475475029273447055080677052149474853222128626227832 2525164589393997980217929709704832829968554364529060039097810436136432713906553063644429644328565051224269893261942396763235990073001625976866246420775436 15614337547041181126817477188043219628044963126229393225781917631975649438502836750353253851523795212263078850399716875892512719059737913422781999218667136371648316387382440793865460028660248325297931269646982047533754121791358966254514009830876592200454797694143082163294323565673200905929297174223061890100210054105027025488322289599106119653451218493916291922340123640475500240519924011764050880374885136181582395113140580448936759383024305870622004464940344826337458060607492042593813585998516868215921180540240201095202617277388950504036371411600204964284568597705251929695275183521036281637399204541958859605054)
+ -138888658164471549506154385143989713534453638138516110941977029/4793535847709521198063287553243915170068914691727215964454867625024011698922303669226389748584276840530192157568469968220857898703102351955898913589325705637953049380748829567692600765708909637920797057370082064005557328769108356548100875674196976079597658854339583183901899349355521527519781721778545444496852540362424465770767219571362842157786846795990148969989617793004579188905882473140017509154008696803103206996067638134383708975696867028865870695941933200225325283190379262695816923376790224594063264297952504481719779782130509306530621779762254864669078635401870023086312919956154224782043667754741333688780367667466505233610011253346902821033707597517691608103391952937194719540981992469020284583499872663129517095879706480339710037976698298522952071766717472040399518290905103777436461474880898550115925718887748413534479076504168236430697214654069473800915087572730747027455509241250627470590715812698745630545585772046458363388764449879417348554556621640336029897762172500880501074103433267444717053504878282494505367980026597725927414511391047010801407870379019921551218005714825277162504166028680939100225793768617321830389705750902850499916610355200000)
+
+(my-assert
+ (/ 2902267908619179684129536324641634394442732593027015198805855082 4748067699021154152763168285921806700655154833226062437593302484475663167752990 92172802787151156076284963978247829387076983213530315481815585776147505007251090 15808981285029107672090190966349736198141855760941720122983980047623201110025085 60559202289239963744584432021634662330089323842876293477363484160210450706125345 20641717016962556495214267565148984505293698026059157698737040675346468206231142 142380249473014630955299439077662853963947100833592874440361316474000948841420058017600161066408668117933232436922811486348705081331372574460204309908598 22418721268614574393232189860262616514600143215945007038687873335656746730488694050883006164427390756358558140145027011322151188565843290717535647848841274550496431839061217253488169143292339455650565906288959125935798633464526818546688779845699340483771625364583343140648892889571715648295855169294054985996834093294240640072029711789359793649773566295329912082241637482772608479106201840565936084243727069954911883243252762742415647868355726139789907900798435783365130277592703989608678774745914668128791639635886550753850811717805962562157686110637810320436812644047534536168343578232389700410352900247092236175044)
+ 1451133954309589842064768162320817197221366296513507599402927541/13803211377640454778526029288269623376813125655593684775595099045285713415153039020789267800416616529908688645478733023490751981264976732618374046330204398361829051480928696426688037404239513603403603849882719851670264413777889524531938606364925013854252374108222701436535488401321603495905123597139234414735397259257280679663147039651553472142280954446675036289021783142392760217244908768132158498744301278889276778209560846418263599491357632762902447742083022806085077053406738681250354036208472026046315736408632370478801849290705001622808552373129971427533249307210975612625050706661691322027927380443494854794852235813844542319971019369687589916047377092369702778251658652143114091304960406840026816351348391618676357634544120732441610431417230403811846208113160343697557236265319994702483700922393762500190362776377442551539417224595247790865885105594005740401824824367904020732469833438717527758468635665777261969819260766044978137909489986407113029460354144391595512642835261443393260585888868936164331461486646676578398836326366036777321522851855085808626766493197635871100152761464712744017549919220291986785134521319127277292845352756807452050073157340000)
+
+(my-assert
+ (/ 7798204144688205291220879078360728451593323170355809361079096742 35808393784851478122520372074317359817820799318259895240196875729073154197251420 58532175726063855694248618287185551673975962776708803423334853085996022345828434 97834368697888769536063057370864051207348099191057106781292664602519775900739777 92489021460656714290092899983209031746574776013841975324837145038810562509209529 71083733375588666647468985607775761710974844539643116636307037921671845148256816 6123989271760127932230015643359630675168106436173654465119508990415235040641894537960236511442249258231302028977221206744158863083898145166446430168108 -27418900206398855942064397259705713102524342707255992250395147550519659429645343464288092288218160406382406024735131578979728501208163782063519839258876833755387025755815673514708453862847139552613587001235204464673999898312854941659541050445981594990466469147364579547089805525464252876345032296745312923488525701877655352034887018931755379078328147999631937419977103372927428613463482328465834563846802083044643719319690088670748858904291298575733560600669924511028715689681303059001186388754140003746463568171428267337107394361025465082282061651196456268663181772211292647101192148287507051053367729008997838464209)
+ -3899102072344102645610439539180364225796661585177904680539548371/113184205287561573324139833190653102440730360395399197973956984769580868365256138025034414373155098575475566747215877030265786675432252675717351889433714136838615056208470421665419618669892136317438270826178251174708190860235979949204785938786562420189510825909814566675745650194525647207897976611434325225523578368855952217879373499055292850828774005130267218801086474623429504045290678320168493275019256514768273116059350700654655821674309331585233552793659038912697151359657915391954687630783641745610431060563252789714638916120291482852533638921356624929690158752601417722733222880768367060672103351737811624242610815140332559619520810810999145535251960674284283045907801934328911198563750515779896457101601178888594882087326241517566336011980952110586199881600553269825310575512911473547251704677890770772166895623118832621335417348044312911888377718725944255218219811801447500167145561774582342171995333086224230231746597452848775656030037837271428187450747141983599129861631612369300880722326218963779650411119279310045263996988089484063433088077868691314162108392639864773907107325220582413508233901954483499166402135445110435112499264825479433389003494762240)
+
+(my-assert
+ (/ 6291885367078853457481986049409245691302078375827782321496819120 20959289231548357352292073342856567687394126070322865796282035211176720583560298 24366038587110130209541647226271577368736240640393242419005751016119649778306566 40118119174220166901790237425673316895032570534639145502274313654443256239236466 73598137358602854818844747625643480865061277528564461120022408463105339470504117 36695182446520138181079917512512743290981469731336486456411609014364293489978544 8671667981598505073194269824535189054936442262459158402875147736469644925300845122881093216273840895555488593258562684601176239455526568314028830532770 15920064019095473156324398162334173238735268739049399738654357508344572552411935473846021991360836375685872129737682603096450566258725052013769725919038955505690389573813769125933987978360857342250911865713011888064725725934341157729878064563080803955584985269499994186472079783942404183377695242296289152788154908185130552013951432753148997632323578507137074131845177376689609114975253308906745794984371839952312988353950198030866538756253618535421214253194954603293145507537939731320546686208032528588232652963255550963088571344119439249328480867640436815434047309164687808223851012490130534705427647158409623238123)
+ 1439421788255379275215959765325419043929720157723371200401/1747562187028503746686299553853635643553063923188506902759251937250022196751705340155682655202720363192751787186892107863159676381018035068965958466119538181810433273947829904580526582292369320932134048728374142501965682147541817431447933591106030690334465450755701191781243754499216697336293783127396687916725975251100500896467549458036395977769801208905203001097425041200299917628353220804629035768571072498715030261324138691471497255335498185741379289492513543474304524261634247519034231348033379344777678679950561777846684978640375273167561174451700942154388980887510088060818147834369595669846115248027925007288445161871535514130090907585140894883683709507099726386549038354860875469377442908932714711235823032704493155679240378374325069782368108779247450762222838197717507164088182062062215767468125843278459189085290703729281279344184417197883359351058003644499215541300350121854220342250451978930421772367851329849662028719768708399155817754711362398236471946313773603716759409265530444582884661320404389499624411965234669344882203618613097197387901166904575791500958722726774956950592290330175936039556139052663816485140080963740296685158607671768592)
+
+(my-assert
+ (/ 7377598052472799909620353419322603137723415431070641423056433630 50990728761110292768803869421408199244526424730838143228662194914314857136430737 89434155113971221138805303763480423496687322824531744020762041598590716339098287 91343386111124700155689622654961840380754244946720984970313893805578518003516073 5641075230099727784981579696383316732450130418277879081291954534985607255267932 91040802121912074401640073226003257602385910518707524375098380810792151468159323 59272268188012925764499414539835790113036863511169317924034366016920114706179376837448098952655862721652129333873020625135398431500899131874782270590048 26690053756452308398721390096804652429111408747235998849320348549870126230712525274708597346508961935323823048352116439255386668122483555236157562141222434006899926132549352821247340442387991613448730451171206857242290791156220288682675982609964518905569737166444127835826079348146626921864776959482079234994631361894786436656768739968380067890165160954836874044821979903056957225885565092422439358816023307475581832942250031121721325840673134241504501661692722633100336840768527354183989544434614842654682324213774503456414914613412547380720171088896588158750436205804689590730033393056191028424154915201435563063992)
+ 3688799026236399954810176709661301568861707715535320711528216815/169215718032454146095901737002485678790901914179482864125777331106759302744215797822810809511498045518338288799757661725047129775976254373463314416017128993811694804386237923340900604770406784566473173755998386770282409830097844352035251738093305402541509197084964701114515390028814839744480965823142680384744649624767291550851759670297818996073873968006960956353033659153219390871979066743795530136868490210455800714335529013059123604101460242870160400211866883478263106349349114199154533363251799944090298252763172390952446660627602934622584400932001701907172000401485323481964448487312714644861543740014645407417493588261100128985848137181719614326345024112347151970444057551896842474702539258687521054961314443551837168457190568932765925484427579811571491887599619302241390226818415165012748654917331557679228501007751078584244340346651276906088856205294333241792044902850102153793417101337667969641035858108457362954650972654353600494166650067557014544136240962457086782865870886529792004619668808741311540795514394731398977642092124679638585188974746423756335151669217754388004341907440529525288302872368689364872785975840444000802518095138062596107983803117056)
+
+(my-assert
+ (/ -239344771695510351349291992975349015183687755312261264640655565 59880027487583466136533364102518649070390160795136023810470091681171428955831193 48344457085007359228086666145324485903333773379391455489556219681156342646858065 96824393663737121700189215323825147927318524415097221824671795011444303522438090 73240728471954064253765051525185557601431281145369716902120469411886093226662465 53476482728312567840603110355495270554470432250981685279567813448298175801364992 2468459436652089730331798017030410049989399340882712030505584719342958436741536069714790640546086933185494149096286590992747248311590137695839482679011866 -20583944357058654336975302336113341974001469085102805363209530168831840401111182124827636905521584509677325966689931599005216123375088335255672290604710305325984961984791919524676460851699284525672773368217606895110240237523696098521003978238685169880199868729577660354717875890521074505342309726366304528678619465048659607726264456481345739318939431629704180230985397408136331466856633265343276511285483458860216756106887559724757372775728879136089013590836231272961497930729470443491032308329051560641396901204040829291495325588896591482909336032903587307512310970849256645908744180630660878534263566681640143534823)
+ 15956318113034023423286132865023267678912517020817417642710371/3718709813392127924163278362562751486187605430152002432053108623099406465632705761508167478249438322470295467114170871555665890539409511492475240415534629792791729596612426725326976353265532166735941330128195885206087665506220364347120981130748862937276841801804372097254983242962029582754709606117339082763083905960784323141929645331591164015455383939302728076410053178677168172481507115685831178503426055335630689722163467637005123748113214310366231893390818795405612007113310547901224920768646006621130651182788173442625298859454337696280614462941186626306295514630883052819172301830539345633711941340491653447613466053205836875456839023743314390098829184111583809697328393569588632000669468187410368485286035179259523632217543401146996259011916302393091677624838641658623073752023082344005134299104409908004250830639232078441523519412192782367689826532215394196055149255026188549091956300108740792221660678858924234682223183500313556198187095251404633698868186071148295957994257417049500872570631774233307260384902571112475241073598945295745287525486108978093728296107260155093397986671349139935376427469718767763295900745932105722655724205000829205748307261900800)
+
+;; ==== R A T I O S ====
+
+;;  ---- Test von + ---
+
+(my-assert
+ (+ -6069217517368004039/4076344942716985944 -399587800008780737/578697755310708616)
+ -321318766345655960630110128852941297/147435729263904928853096856396980844)
+
+(my-assert
+ (+ -41285036778370718/305793940074617155 -1396094619926552183/15846027887642356854)
+ -1081121118676718273499338028514700537/4845619302294419132297197085940230370)
+
+(my-assert
+ (+ 15975644088444536091/18063939613598316583 17501188199168431305/2979264551795273683)
+ 363736076920798535449296038324193823968/53817254956563877935003279344562385189)
+
+(my-assert
+ (+ 10197734562406803221/17452826108659293487 14639450560606090654/236781760961536951)
+ 257914422508077920978698094723491089669/4132510899763835955061848877304138137)
+
+(my-assert
+ (+ -16810360766832230069/13652857552883800956 5011749175730438558/4169057419710079215)
+ -184295743992738197672588473692806043/6324394120121667288243293659228081060)
+
+(my-assert
+ (+ 2234573531734039025/1128831476977636536 5842177084459535064/10255356071975483971)
+ 29511180623959738330730559435115466579/11576568741659658592450950022331964456)
+
+(my-assert
+ (+ 2268894928233321367/45672733521488298991909987382109984899 -10510750087507287356/187832098427494353069556175466145198255)
+ -53883392376116199828369509984040539934420061636271022459/8578805378260910951788610598591490227836321974082207035230408675959411151245)
+
+(my-assert
+ (+ 14273433611429514043/7774518083776389556784045601066955324 17247074371340283485/225579726714102822702316919752160926694)
+ 1676942472465190408518249346164012571239098147062478293991/876886832336064155131767120243155911448808491410701588797601053820468509428)
+
+(my-assert
+ (+ -384768590020206817/26284423885474502132625533495652664626 -913687410374243983/254477371735734658619949996700223764026)
+ -10160887225658731404416073535892287983824191154410167550/557399258996959835387173465565070652935481894323496556880024318994528462023)
+
+(my-assert
+ (+ -4465222504572200650/89674568206322981678158378582739708537 4148550863841320780/74302497820894496090312266744880513261)
+ 2118016946376507498169590394563632549990739165791772590/350686547828419379316750498534703170285368675911953477374458878558215968903)
+
+(my-assert
+ (+ -4466938407638238142/281859125741189685767904931589784285893 7302241525893379697/204618108204962312932373858463395271264)
+ 1144186926000295881841982161759159994442430111060328362933/57673481089466829503954266461746705742702466399988738560842837126631263478752)
+
+(my-assert
+ (+ 6692616266348342275/280491911593106290120490189988812804382 5414100524539959087/183579771905991028181574615911067652873)
+ 2747240373316006570071525025488180559154305534334705425309/51492641151737853299832848099101317109893853469394209716061486746077629289486)
+
+(my-assert
+ (+ -2794289802081124319/15768464977850217600859580216291365931410230647587457388598921425875331529149 10869776169503285673/33805119742344157512165738805682358903614971418053290198565741206390317449856)
+ 76938383491719886409504555688515759257937029058461512747558964579607347503639994773101488934213/533054846729186819415263583890627325668798847177803707144003483502948153457972377767011992167761176556555806720273883868208938866192358148729990609852544)
+
+(my-assert
+ (+ -253222140119290489/2123024034843473393742534167007121513293496410591072104903085284304117612082 17957334013642389787/32058972871090153103034645121513493401113378486125580864856088310966601405847)
+ 30005809992231287609744177955201962181880644831204431411802631067134766877061419104162728517351/68061969937719269465960475690278941280799593161143759512261685488134507341176789799765185182008442410081522124548392827986923668912612728349293792643454)
+
+(my-assert
+ (+ -13318881947309618/3105936147298438543619802738126617974207009907186580731552500517452462642139 1850968757748704519/36469179946212878965111748233319050931475015876401494718861814560453153824935)
+ 5263262069792987469108717688485565287648879759118200779949761992573778798556738644541735401311/113270944257273905484832818286307416845956086746130199501242465128236430928807948126409718436237517505516279133169796919230385184900609912160483959935965)
+
+(my-assert
+ (+ -9937822914683494298/36414156259035675966580098631253549474580108307284844243190992829476777586283 -13712605099585970325/17758145954890657915358548152198427387923366136638180213650029984340849686198)
+ -675810254607579372158951115566887998278519717754376916387787672973408477396668549189167387350979/646647901672150721610792561233068038707362067627156669418022102308446036384411330678972562863413004325878365438890328206637571985169324874284800419222034)
+
+(my-assert
+ (+ 2479135971595944301/28169711053558469409458629766960029324030958129245230797895768033968717159836 3427244662960653095/28446538857424788738244844756675951434179713170118835630969510829753715142438)
+ 83533664807147783700314944003289704497366290621039272787320536148072960487262393639109696219129/400665390043739792096386856839000624247597803909916773326187593475005945995926511155915226239317839405221783416485999405286913042389632370302962776360084)
+
+(my-assert
+ (+ 14865500635281371370/56222262470894935247131881777606182311286871927285650835673424014252462156319 6436092572090050725/19282524131572095520593158313261757267758159099923763177708581262473988426947)
+ 648496060602737474174747620183913927791943082591316359990137585798909535115053578637078811588665/1084107132826611778585714784136700465449309125114745313342842325649687943726086785657821763235618936882528385000712567133180567926723616940173290425928093)
+
+(my-assert
+ (+ 340196811925805824067049620503247332111/14422464039094716975 51285507111580975533385007190438537498/3230944134273302873)
+ 1838820276033673324738967436225477772648372110186756083453/46598175588880723338390245118389369175)
+
+(my-assert
+ (+ -210449319160504160992731982827917332322/5436857856220342451 251628249079137248539965770847855056283/4323109210037952829)
+ 458271632943884346915405609513071881239303671882386130695/23504130271893362375786510953364243879)
+
+(my-assert
+ (+ -40984360445255688839942109197081457275/6593417935076565019 -138094174027187773198981391229349265879/7135512300754720691)
+ -1202957011856131413678873259651070808566709454882536663726/47047414779755620074837011989046108129)
+
+(my-assert
+ (+ -289704472880230079383856507128133962457/10452740760651010288 -55251460678415911958671096669490155237/10333740726609314202)
+ -1785630052601050832889834016432677758176770083879794496285/54007956451514283340719766211063255088)
+
+(my-assert
+ (+ 276702099951674677215621541062877777467/3899918017008359516 42623843937285717338660228144403811741/1973785812353331893)
+ 712380176058162142132059442064597996057720566915757732387/7697602851312240113570356856612843788)
+
+(my-assert
+ (+ -323480614013303716597188084301661616596/12957985934572321773 -72966206939397711493108854138997499334/4539020357040680881)
+ -2413780175334213399707013296172687953960842714316410700258/58816561943270580900205343368941122013)
+
+(my-assert
+ (+ 65443777543319569578713907336699651721/218804857459609839540825438673960136766 -61986861924091374470669233802827103921/65997977315012279293170493460332070399)
+ -9243869541956614722377007489838492339200370508580665293676272508698701352807/14440678019033825487758061900150103876633207457375858942267120523885980189634)
+
+(my-assert
+ (+ 75417845823236070411341994633288547531/70553457686181702397810927701121800017 -7132208259849175775323757110664708879/24379326462014713478002790304943339422)
+ 1335434330716260509518880689691257567128541829706203586134358870209350816139/1720045777955364955754847231620711706115121721983605654691934662747636370174)
+
+(my-assert
+ (+ -144692585186931942602350348772472248638/135233395864627580439431775527364081053 282512666765911374279543408363363928190/317835040256607665191397469890906044457)
+ -7783226336195038987381961251409043080655184208289882004756343793157154115496/42981911818671667582796085276418080952868666330715445603855323471628969373221)
+
+(my-assert
+ (+ 44888992584766727877549626240272070725/30583318432547259097085073976959329092 8004917623696885952432014881247978821/22005016116109025986417835664774768346)
+ 616299974987760892931461886440810919939264155149950328291076750435394215691/336493207496148335911511951044490614757807556827643881435283379298939260916)
+
+(my-assert
+ (+ 78378756441281199312006031491361997668/175125578595003447448566412156266355477 41128705932035853424044828385766740319/216359823601433445464965619660717081261)
+ 24160702340946845080381231961736762955784254747832931999121777482667650876511/37890139292913914697800186893609983979783140570423836226844401085057321416497)
+
+(my-assert
+ (+ -36669293296367265584135816683983780855/7341750629088488427994322429098120058 -110335983484012479290765295565662258281/5944410911181873015545360879141666465)
+ -1028036623331099574157832708037007047972965676333418398303213384036005227873/43642382546729990922161061763293407461832155878510163500678954788762454970)
+
+(my-assert
+ (+ 228535455883892721240720366651075744967/13353170075841095813026701300679754576855418298534901819672803635370738730013 50622643250826426975012800479360461693/18462345430382979738234695697296360785230118465695284267226773073149552698303)
+ 4895273294635392498665165879164922265508724130843670837390305811645771221742112327485665544066552056189958877583010/246530838530831602270074647792752210668736478466245992891169449973883874207653264921203783108295835419855394180777469634862446033810927048792871560267939)
+
+(my-assert
+ (+ 11355068601761731966774720678777239425/4604724775053993730579400400679579947095967462408565975449642189823843820753 140083339434585694465706029861026468774/44667214322013486680993684507177513903616004462434123967566781106229226297333)
+ 1152244506542792151980649054527153167035843960949499862764543674633978109831264344257976000890169981044543787620347/205680228421222079539939271800361418862113882206694593495620042859527547538342323521609420336002641308832164587573546802806916292021672743366881933951749)
+
+(my-assert
+ (+ -1347509007210283053816302848714698886/1127513773036247565111791991337919355855664936242166138889250311777351432819 -29464928273311615445392112247506626497/61933028109313748081628643142485450090725737246358993405254280723087421657760)
+ -116677425670791909053501267317366054796703074907755330120413752187834449333299886015456661052906469074533366060403/69830342199092322009251417145364324484174202256910311362396720371574344280505889954115533896831727771442604285956749924105078563356474162416148250025440)
+
+(my-assert
+ (+ -324250487660721070279458563122233299722/81069650926979269606211148691445887485067008319429991878657612702576019034861 221744296343315457943731256980089803078/69422237643162665956763790134527973903052044485041686255401689654420090859107)
+ -1511153903564243978242173323335554031611949546418082039382510246845821774680210236992700372319944685567533765722032/1876012190766999122356500320654631447623282613780323887424324139799202291067983209550065997185860196433399782230215269625922714982832188312141580824109709)
+
+(my-assert
+ (+ -5518324152042099343909980322067306333/114786626838714403445081775763480415805466836213320421844559660900880511042496 -34415425451618992284220085078832944671/96012285963709194218263616278916829663708037691620330613749177799086889040577)
+ -121088040955051148243092870850103339772063863319219725752028251933576579890093496821887384992074112246777968211161/297862876779681729593084954525306275464788137269287692384941959703420459939692410434239827100068259769782676124741025632728203586961467995819025176090816)
+
+(my-assert
+ (+ -14763921690861243371082340598041267817/5580497386043551028888310256097864185640794395615400088682607872958152738111 -37917865546640067592937379176813765341/6460563866107795917092814416816176677900242086501650458839130903088333290440)
+ -306983808565398982164654624310995401934900925070311336095043743767915008644459192438083753301097540174379867380331/36053159767181973313125557585868206969047484351694148822117591172786449966899079869470557965303954072842600790897257698854023751399649072014440219958840)
+
+(my-assert
+ (+ -50167218239107621378232529938205077788547946059832391744348095230748591585676/15685777859540025727 2959973815535345735348053015389999235839609978295604181643547897863515739931/7556072538495923601)
+ -332637648328710384664787658442281566361265475773778265650094684540358159241317316408573560734439/118522875329417757148187346888166482927)
+
+(my-assert
+ (+ 36275100136090483878026478935942224245036692059657264537598788566553406654319/7192442039871568876 31833552596558882106090352174644817045294359487590746360517241517440556146007/5115621724114081523)
+ 6795584791386081942310910570767193224876510928834120433155946649367201608618436115134135392229/603177258173744207443043238127434068)
+
+(my-assert
+ (+ 1518304705177739493483387141342904186483658277690975456045607777812450680478/1837349761252804045 -98159070764971437450169149833809835519268242923913777966502463698396945141091/17238232824535200528)
+ -154179655228376218743158291724235398278770272999447263973992852061897564252670941977524115620711/31672662964580000612902147746364535760)
+
+(my-assert
+ (+ -16820231344048323866426670709751443650129113909724546927974450301780935205864/4879137683452153951 41987219452495799378686134495924115238909423831017150785452046648616005475639/10470103987572807938)
+ 28751853386830083847297108941057082854166610198448421498169760256533906032780671559334244751257/51085078915429149801779227663330863038)
+
+(my-assert
+ (+ 106981694162678522688926793970551228214793665448093395251834862896418045995969/12359470989873920972 57736849967187961211538031441400807467468650239660040144967046985609433512403/9148121311784151716)
+ 211534804819567028232303054650327703050869189253958355919997046592895748577556985792570078031065/14133242495605447754080611005730273494)
+
+(my-assert
+ (+ 32477400086615533920132766925666506741908300936974348739732763951610256880146/9045135183308696243 -27444990730472195954051975667481893116650518055101159075033425831129583042846/14815776448343565085)
+ 232934248044934592851252865496377968609159820017147884670610366058217203617961573611006127074832/134010700820948737148715427669965475655)
+
+(my-assert
+ (+ -110053921687226074580746319073262192216481755737797790655164396095655530752161/255625377233605953547425802301922658850 104095037267817888539158192425982072195078148060302393917025130946535913363779/52156238014583575190277280296975732513)
+ 20869334635774913818120011435677143948904421430726712952150525645851498022294865158343391008006649321440592131083557/13332458017563665620865770931104425383051282278510599570476131200251352190050)
+
+(my-assert
+ (+ -29732769078100192507326444863945498799317005912797369958801703828462203585495/153426302667449722633466432797809987061 36094569840376017510791155197897623093337784636438580042046806320700826250193/73286165979315961333009750429763545174)
+ 3358855747298609357265422062476767573626163217619249414656940907348235709105513077913806378841119674678021275101643/11244025482879487592663298816607141776071841230792806495601092332558428993614)
+
+(my-assert
+ (+ -5942892427460131788264792587455286675871284855854073854440582948253436001319/42136930106315714728428443448730580823 4013357443728612356640061171485791666303136232331145404661874650095235381569/4039594279673425548586623641599574814)
+ 48367895947790658831309709091377784501687363167039737892874371817395083020674648576881857510385191335175551957207/56738700606823969419119152217721454504573192499839513549171731025354063974)
+
+(my-assert
+ (+ 83833896550100013648317056712064289497247852876055488793078639582729685477353/188580876675619574786621140720273228537 -94310653397371924313725082402708514144086936359594289802762093989853507835016/223423274286761439988276492107364036191)
+ 945257965914081840217765265999453398105151083284254483307155736205796420255026737575918161700355729594975143830831/42133356934734885127066999419230498520039134905254787577957770920054881982567)
+
+(my-assert
+ (+ -14753992026457621496269953958381833108089826525439816493815533773338622353285/187171041855711408638339193132645929319 41340837577662628944845446369855468662228665858415210386857356535970453143469/322471558852595372991189266479896691326)
+ 993354944176102401496932276511264091214577507066786487301109889019709943488537161608732610457423116833164991120567/20119112546425211128699888199278894685207186285215928241217590790016852128998)
+
+(my-assert
+ (+ 1370528773439579327226257222995383030603284075640526658282329726447335048230/305600505683287165495713194488435114383 65450762047588146235054351616480175308174618406941901794570541085963681607527/78934496562987400429145916504112602768)
+ 2234440886428442112499564751364146150136438855986167755259621093816030535881959724370423862435538502079424185584609/2680269118389404699570998335430047660909241475691839354273569734988880268016)
+
+(my-assert
+ (+ -76890617375308981455205142622328108690129081798840077873315966300000409208129/15716637731576156581128288257209679492686622162926707938907282962815471734862 38716252217351070567267262306332875768795464072349655597599997486613800623507/8966639693620677733207403249675415446338239705879120765911896990394928596139)
+ -80961151400006413290662155450270992168701818633203071886556882897757813544592915596861717853520674107309124394292702460320442121704840951425284048212897/140925427734207212133604717335369986754855062343668899363006574618520848268718851310007161609443093589067206438198588881828988648068282656538084484897818)
+
+(my-assert
+ (+ -43290760758277846058307167265569849910514905939554272559141355223092464986939/39390771697068809730875092892395235497943839933482798653607450783947201796777 -34021960935937170163894986285771504067448629886312440795733904794894095253649/106500928228745564800818258673435811176493306775154643113582742982704678574998)
+ -5950657500399238361998292872481533631424138885403498309639150240712482075115081624153513501886127772738596607451116548616099047843190357858736503567640395/4195153749384427435979718872073512266029328962522899010907363614544821318917440413166534226890289043064894115954085809567292470182917919104836361549181446)
+
+(my-assert
+ (+ 17906146982204022925114071077515882010955693727109005464426577098738402001871/11978213712662686419384559301746021856683603106261241838035626618416021524231 37108371752538653389309509075248119316034595087990649061240232817571629131708/23044877611981158676785639370406786635050056158699399001947422631523989139615)
+ 857136973087880657664203854652754375000000796400911171478039451763440064550649429609696307332611304395324153178602635490321877797571177424460384122636213/276036469018466057777760709173569478463866562650149880633721199971933767458324034017734890892482223472007882939609440193626728031771767304374122564511065)
+
+(my-assert
+ (+ -77062185592993847534024832256462395143306675613123510837298699277378172890089/108133793614758275822883834459865239455798743725021300772336023406871185253111 11169356025540464491224577661206910726665825152149521753528516637690366838655/6369000033300801574913390611244042297918207179453133439308688067382050608197)
+ 716975776667538986425481530620118513423964367153518065425241139444161780269039780459555836804116752462325735011822817367819625929553250251515977390346172/688704135133337463423649074673019029541747166391680122270752018123634233590688096940261480888455237095078029621363428114402137147558304641222314936350867)
+
+(my-assert
+ (+ 13583698920327742567560325715281067532806062839142769830536738488850089822247/37364394142255392010559408553278838878570049727027927213977555360874308098434 89809462356450792524214360688853318641058652796345720882094866396911421360072/67457610947238032712889230619376608100793287037427539672885124981055281513463)
+ 4272000026182362299819817378001862956001381379478285995446709640464951377212652125169846305230835604666564953883168949950485767679005929254184987140738609/2520512763327523955464432226120154092742373168521113224665257966793820057379494860454732800329019773731110452438496395974166220481124541266348389100216942)
+
+(my-assert
+ (+ -56124163112538495128545947597589743957824668875494126834084658670528264380488/4752969512023182700122983723156599300062332404522277372984645779569746369511 -24794747728228571193100294011820993825205231022194400752319729320185378063197/98168688073468429337427023004226732413974455700654808087001957859427678524065)
+ -5627484141989830997868845457242226973925524393512774885292323552602180052845805156311097870316601631410500655735815037997645271136502511615781690896430387/466592781448509275992390948177487068548424631274164031114910250651063315574511979617153568070687706304645818907382693929886654490427484894987856595782215)
+
+;;  ---- Test von - ---
+
+(my-assert
+ (- 8229768172162771789/4094631553683915058 14916542302144281688/9648520391570031013)
+ 18327341244785642013243791303754634353/39507136041685332578233153660317693754)
+
+(my-assert
+ (- 13554976081719376860/5850035209629724601 -6813034992928443315/16012083383654426278)
+ 256899901877002811987490932642058619395/93671251573905451634945335611797465078)
+
+(my-assert
+ (- -221798849980968127/896588178875000428 -10118632981534633697/16809799818197706916)
+ 333990778095757160537366868413422249/941966737890699707694484674257410003)
+
+(my-assert
+ (- -10398409463665680242/10672871071680021919 908300169382593227/1663860017749090135)
+ -2076589873614048366639515256135965791/1366012573135328609279238070700513005)
+
+(my-assert
+ (- -2198518713248421187/494031967775171833 162489257999262168/3608560229859558061)
+ -8013762081101965644053022173225152351/1782744111192743850497670941715295813)
+
+(my-assert
+ (- 4025149216228566945/640594137312937394 5467380276809034025/15813352732084653151)
+ 60148732603712157399679443099667862845/10129941051434949990590527231467828494)
+
+(my-assert
+ (- 45649282670476595/278386580761220266717341154184065537 -8637266763647548631/320617180101036447149595031898805939080)
+ 17040443444897688379155017841073877168061229451634462447/89255520501631886327999278515127058459530587144975987720686743155549485960)
+
+(my-assert
+ (- 5648415331928005377/86815630814151297970860026950116430492 -3858618729527320883/27855468652821710859204555976171379400)
+ 123081918822962876101148539477322308270739795776139149559/604572520679633516300271119677141637780408278090307422820905500994965166200)
+
+(my-assert
+ (- 9781572955588417059/112881800445343004034168709823458687843 -5059688483724168531/4577416283528891230944530353546966748)
+ 615921077060787960354561606126348783111829996215681822765/516706991472571912574910836774186280180852506048696459094758451180832844564)
+
+(my-assert
+ (- -4967914039344839478/238170260180199675500515253723794945205 1851848905279976507/5731170327270969184071911155742503278)
+ -469527297115675955424190428047537920421409443442551107819/1364994327983166854234805393053180119374354994464588574791772715189542881990)
+
+(my-assert
+ (- -16853061581795824324/96404437352723357070647888504166371117 2887610208906060444/32980643277330946266739822018299212963)
+ -834203249643667606680245846951263316484378801689149307960/3179480358681967952651970543397987660141008737601948320258541111852875189671)
+
+(my-assert
+ (- -10766003534404571638/1736320411127247334175538439020437437 -220564366893542891/24024005562370344889629855466198025799)
+ -11228676451427374102904112111967705085778332338188090365/1813624835433832784217556253227924899981441517333394378436857197512671181)
+
+(my-assert
+ (- -4039872531792560303/2717817538621352660433068255065439787147153801016478776178010367557953211548 -17969900169229544519/10371230759745501411127733226376204123221866394120596070959771442399588297129)
+ 6940459580028931824293913174633904994365279610168782399332846513086074139209123514834476635325/28187112855925579976299840753672542065528422968220885043792832460046226866036339425358907691441054924266606457279617295071355282523744922239122018045692)
+
+(my-assert
+ (- 11905720953886477738/26349991043344773150817457299711471013733618033386232710348739943906972457535 -1868508269239354100/7915113871665192715310471309271830385175189228544536787145345883401181858893)
+ 15941145914794937177093386304443205602552827651536706608400845076162777444155363739893353329726/23173686625047977587990304423741788120258508897732978034793987736019678129860415537604628640859289817332994555163435451240013483415438259775849311623195)
+
+(my-assert
+ (- -2449440712560236858/3924161613720467738425590715321110829708355586356453490516463081317902575263 3313932993860824279/18392642760231276916239249302906853654153090246504347205856270072174622214792)
+ -19352032211145724571420568734409847660231095572377236173431089875006133635431666731719362137971/24058567564857748536604240288023690440577404826273237225585673569644473540232022448230431237781096357243673961302816983638647478040822458289501843963432)
+
+(my-assert
+ (- 2375854596996813469/17171542567603713573317138241061150416263899780234956304631913156611236192733 -1690236091628058998/115698505401619203741389026136939663329574241316722960060260525901879106902321)
+ 303906786920788985464713527121698374469813384178920405503303785899916213843318155692692663023083/1986721810512032345893371071989737461519340072368099757524397292434629497187713075053126253107235936414498803590298681018206068059043963268488989361033293)
+
+(my-assert
+ (- -9066703779833220052/53996509329904595759286231403247566365148374715934463324003880626270687736687 10104829441267883881/34350188217372122913844475743718288066233853695548819225257606841719829170673)
+ -857068498550946301314281599902676812596945461499639532351672507051201056365247232693696093577243/1854790258563312749374056592838765632813507083399863975139987272744324437901043103651094837595789610803765303659351781344942305171362498886075754606580351)
+
+(my-assert
+ (- -712905705954993103/38361275706852471555340413672243335795384295466685977818182375699688812583403 -3487523845474404757/24004509207225606167828624323100421869226668573968691661898194620137716910067)
+ 116672912187985693533424614379662678476187446315443107971581372764612623068602629062267386180170/920843595906060126846114857872490000269306626188013726759480780006531676144330596572087176480154495471428384288229491172449159350622326294294528887818001)
+
+(my-assert
+ (- -104068455909264700529593875361271227125/3443783531459345396 94266182755532992545775726171008609186/10986871169556601787)
+ -1468019045636814162670978305715811638938423723806410280031/37836405995984502494576730289263822652)
+
+(my-assert
+ (- 6250188382163250356218308848100308290/74975517450841979 10057222263694104272437942231238950849/1377150882331486572)
+ 7853407001895533030925726629648778749078643531548391709/103252600010686800286181264132405988)
+
+(my-assert
+ (- -325869560300902552275820653500571757882/6390430580148850471 94468553562411191993094256419298214695/11908765973274803007)
+ -4484399064985071999330976874105690617426359030318059422519/76102142247451389303559481900024166297)
+
+(my-assert
+ (- -93570528036598407567281714804477572547/1681213810574384291 -244906502561054838674546679498356325029/6878656438675875801)
+ -231899320744132980638168050942881155823492361410591515708/11564492202898292712047439710761442091)
+
+(my-assert
+ (- -81411835730261219386583131450337332863/716127167248934 305772198898084305417824619321954306670/5852119619187572757)
+ -476650772889757879179369019399921041943854248979406203071/4190861845290706865359628655691038)
+
+(my-assert
+ (- 8378821874364768218652992773582270365/264620166167099506 -235085292482743132422942426826553295351/5218853722286899445)
+ 105936154887632142427944491040385766054707164161382644031/1381013939193345109641609957531174170)
+
+(my-assert
+ (- -46932041053326337601984043288899377207/83004348019257810472659105973646518650 -172752976692389001100875729845538600392/64697064048458368935602368307247306331)
+ 11302882932785858045495103305619355060523322049764297548269071809310077113283/5370137620102451116225827082734739449691101289924623877117727128768254573150)
+
+(my-assert
+ (- -5215113722152182902641295804790889582/37267147737183802417372262122851319461 -174324915479281952095382231256728338942/198797486533978895289571841018885549001)
+ 1819946959828587625889363843813156766676787993042778284071188313098762447560/2469538433480866339929667414220581052912334718874062150193407525506073469487)
+
+(my-assert
+ (- -308468863588547635528373349890793262605/277175417813474671446046438490775760091 -88071245580784145343997181342216325733/109042592277517238289414020635536175644)
+ -9225060231388102579469362745283215538990500777711808852192407359260779270917/30223926073985207174135233898799350451872811382182855106546181559011381423604)
+
+(my-assert
+ (- -139281160373255540085888405052544101003/21590054032847718908692432707921390245 -175128181843395150044469443628898278945/101874815793501611839718166887463701141)
+ -10408215647857282226079103083273257459322595128147732742048301223816698452898/2199482777568107961766315941206227462112836158088743951492692685709912769545)
+
+(my-assert
+ (- -13653637423911886957204229566898836211/6724361745919744069899921221745423919 60537422461958273742622747790343370991/323722395245687564470126807800714703749)
+ -4827063738484690108652046326448960810791170812913084889649499536314520788768/2176826490887613088066161490358401961235974091796973399049221882998503572331)
+
+(my-assert
+ (- 207284509647982883454717074874778610186/315575836476247924963087075944676754095 59454580888278446469281150437143941047/3799382139920332759258392540934029749)
+ -17974876032324524053425850245755672169670471578477359535347261991433397414151/1198993196898275844180025803639723883733761367273976879884312817813487572155)
+
+(my-assert
+ (- -149255714031984711085009662216310611563/61209488724728410476016289765233999883959861482512968048939594260689484910535 -206353007879160639705730135450663155/12341134377195982958424940281067948493740598784362073339140017508008773524522)
+ -1829354061323966095884091779117676852909282652562065419187935424186237303685407507859167669375269438805585201409961/755394525511335693198081866608161950899365908489933659716533239785460293292606918153507868614180865950008697266433342863460741791684603303270127798639270)
+
+(my-assert
+ (- 286228990947356503137685907205210886138/64525193112922470913382853022276019736227442678252533126077234112153953877503 -93778927468512815169462456699065596479/70019706577332037325570327903202382111804035215024271930215402736305222068556)
+ 26092773364888269343302672267572690894453186378630697330693315371426642609003667116358459590920104883240139740188665/4518035088612517412858008269349176355736855744033363257986123715832709510554983209440815107866748014413528943649032845277041680450752670951433682692095668)
+
+(my-assert
+ (- 128067958966292694713545212085241612749/50804897676960765097908813878456128842417954009101908722816951877006748778869 -331437715897535092432788513322484606485/102911257177761006574263802557003927106564530572416215828322919550454967864323)
+ 30018293903870953799879886574342637699455128356488843398998059810000258259055116602688738404467489640369684487419392/5228395890723542025866546462435908982096651119675992137235094920338650164475761939608730060759309002063498665792819192135030537577109853650729817121390687)
+
+(my-assert
+ (- 27065789167947870065829490227927612633/10795458608984562931374526676297845621730864739104955678079256994070639461197 53314096352440087811254806167289750292/44807028208492548064750449353871285104149154384082409595945081934090139448067)
+ 637187458285170434834128234123875152637450428605039275620795715002449318075555518355578432548587274399560043210887/483712418416385035748598509413117409273155809870339120248356475239836262578288026980177669113025449532258001487616187498682131415946755647640047843156199)
+
+(my-assert
+ (- 275528434092876314751862670579225752027/23290954563951481764306221308726902093226107549717031306984541394996363441752 118398743375843543978994815511147957868/26050691402435592629863948804505350954161759382372519491414484055670238339031)
+ 4420086456754111377514058698455330162869575963826459083894390154200727636413353382047981846196341965799691593361101/606745469813648893293125236863835131523556569847025597910312571817347251611730291043895952533706547565767925058454286630395458711598751591845070996622312)
+
+(my-assert
+ (- -263828172858355421790882308711676546531/27836884730007976814146538035133148053942251062564400015534567388490010158584 31580638196736633522674344981675107601/26210154715367115936541726366619494863883445533448748701891278370021519416412)
+ -1948520953518189888695889830515156795224640917019574042614412953331052369986548949517168001067643449389746489215939/182402263891837359872743630675214135004512597266032306942151126033873543370078488920825920736994254287019873146147276876145783659805845233146169813070152)
+
+(my-assert
+ (- 43029409555492054023102681165249027816896930295612442385573977041111849786681/17478431621804970398 -63831159286570708329826084149841946467426290005331979697932225104261019322894/15909114936773208135)
+ 1800228375210677909820927489860838061135888931548234366640994061734196466170531105718785437541747/278066377585826623354880511023167787730)
+
+(my-assert
+ (- -34677827126365037739221949705076349308552841821108642369491195428278121711851/12321935233094032355 2466652720703038662112375481129216761044838204088317060529010755963314905661/458077759838279587)
+ -46279076433142446690218423399092373290016631287423134630356063713373023144989129659854095947192/5644404488448083755690706619714037385)
+
+(my-assert
+ (- 75657421640076548917316021979547903196453821552146142751737530624725671569062/5416811919979369403 -51031635143911513328361770575139950616395278082588474953679149885798666896870/16274277637120569843)
+ 1507698654622877634185545368063085304919907004898369478770589865697455127479301592176158803465876/88154701093808389139357381843158713729)
+
+(my-assert
+ (- -86696779369804422745383183615836359604633179506005810847902134850836986706763/15354752711854066426 83875579121692496325618937810567731584819474189441279434601944065565889174333/1890321146489013312)
+ -725886765676185953186290796464189476910148783977596698524963064505627422317719186476684911836457/14512706875163632554860591439823131456)
+
+(my-assert
+ (- -2824584270835350806110810310308644313069326027498380007733023821989145840779/3128200028313826545 -16485532380752962986834975164722153533427821569516340079793116204530103476885/4044901389917631001)
+ 40144878017198534388242075435853869853984060096218401720566307902396394251666454424383286522546/12653260642466969643085415999628721545)
+
+(my-assert
+ (- -71140717297594692514165816539390347954764512441693085945645019026357644035048/15130773661553937219 106518314860779634188990156539381479314908411240039365434170935270962911954978/11202282371121185733)
+ -267626990691150539404999353980899804835901788880218020004516046839225745741587662342920970677374/18833244338916713919008552672213388503)
+
+(my-assert
+ (- -31372444086039981530710911528326367048894875160807395940269724829549418985367/149682691887362386596593782520991059630 13980025800771566396092717430902170466939197897483207383178768135899198010674/143215924045734814208985239450703841431)
+ -6585601463869631351127457963734548845246885851328680299125624347680443020577881573937479731612385878788264587830797/21436945032301618223045694723696447349670080755369221855700055538448185530530)
+
+(my-assert
+ (- 60002561005149795132492915799111287923312170708430066011808292212167201814322/16346766380600148228286881361520329811 104734497917913613491539581495799848702023341599268915776996571583385896191203/61937476024742321910315674059586179787)
+ 19844918952732846654680216616282727016967753441473733514766184661191061075852141231786969917096326062063227788681/10024529215648371311559365663430434349900555024451481776473735938354274557)
+
+(my-assert
+ (- 78980655687309201443760271907411093305339297143458162112992101000746746121121/24094471248783344167514231679460830840 10562090177736342378322146805187203837437609238688017154037816697523731420573/74961473522415640988394298626742882726)
+ 2833009175986364875175323375606672657538996734036576482627590142336455915129629838687125527863027857335645122892263/903078534276138789186206765245648729133926893901427360507431923032322034920)
+
+(my-assert
+ (- 96507496069338193466683209170737942070468924698476218759487496209308948365/19252547784216386872197161331387216893 12563973560096321588715986952435909079270363887929001032891628645353358046011/79879611474172059435223762585596250921)
+ -234179520035021783886726161079163865833895106001667476480293126893061678147610754451356994012799045797572757769658/1537886036891137155393554113191390737924110193971845147480358562685078008453)
+
+(my-assert
+ (- -95307376781556674397571761484869767912211504027346871580288574968524683908606/128329921725822403056205582017133271311 36170894925879686192917617159219095595164782822289198001474013555499918728596/240886887357120796976726436320063138705)
+ -27600105449672599524131749634403660999916186956076872373762346977331203119722064380924286397976905109959929163304586/30912995399316310109755266138690547023211992922143297688759057498082990192255)
+
+(my-assert
+ (- -22104893896795356297688360407985617971036912713007110938688208155601366216839/5790727918973991999188987227357894380 -2339372311396919406471876113751500811577555408710269902369834593304924842262/12937689744925498650506694361349920911)
+ -90813196841584888136609582546105640167792279132393576014002859436259486025871518847027719826829986116492656710923/24972880404321196721702428178050372850585634300866259560981343234830460060)
+
+(my-assert
+ (- -3426218098660813853559652497557253942819662042768623922183022792185928242671/2077407536662385613357832628600529321326686191757127715026249042748302985178 102639297566540827510784861997871251414598617775200449087621943894148321803293/83089038429507982364103335021257902316010144851865721965726693103637274338545)
+ -497904817589969304680335736144278473886197067420059149312627956679073246109792679236301202959163792633927112737045328517845259242265445360227131779644849/172609794647490471018785535271654901168315737813115654161745630290269473799997219289162551586864155467201760250711449118429648095083028041134558889086010)
+
+(my-assert
+ (- 1543899448831604569141696144740105016328586790221799945430718394112623114412/1094690716976737526626281319975432667416762320123576900412499904933271786567 -101835025746074730017715423582062511397387458863000475669454309217160145993/55116548932808468782187525862059393507883043749327746382569396580129398962)
+ 196572266866178229534134252625134989714563665559807019513454337864363053729628560611312158082929567528955985669620113192156991984486011150099776316375/60335574468539540262844259780498204139853746803235564167348945699931512713417761400790104247218084745081610815218855896912895393599203789305655343454)
+
+(my-assert
+ (- -37581128364300495505521143552535972339959603365602244668159915869829949338997/42947503543372015019662104425995959382231280059683481488692141811517675950053 -64888994735350842409379226446854438865448614840503930577860382883594178287934/83188698741706753136718468601650233481619465918167616089202536622553688681087)
+ -339504834548876267781536981106771553482515399809961247195394672491113984585270709765073243997043174508213253440272888923497173265137136111635177948889237/3572746933977957867604303713153220827104741303667912510494658617478381525690274918494624922428110123336345510454960178899375325287131764283538305257747611)
+
+(my-assert
+ (- -16230533405187239318665866908175768720879595131719076634847964191318368133798/22572606803697929681675696479626869642065470042484269772607381297011844085929 -3238806615045730440879378702226410558103197865253164974472379309242480970831/7167633180423354812410246140643720752789573307606828791458541239290047771821)
+ -43226201536346598702395278529841763047400215735214225929426206339139243925579733185594282160061132691154727543083543034702325848468839969037250195569159/161792165494835249202675342837643048016103040739685489755239980324180308179745586573032524649518850731442178659412287492012066453331740508600962908806709)
+
+(my-assert
+ (- -58154703770626762920775801228739843350302933064569814497417973139312614069763/25655935043535628671780902110427599603857741303802203417196105196580175051005 2291927744682353823611191393035210406213286149316388597509251757479544491322/2075117977066796442381930295725401140983312287419314083032058820231519915051)
+ -2848879691864593463404526996418656511058536739346277043463623510210968076493148319480555434626780964688210750895957968447300033820091387019574369485421/845064952814266442598400897276554701819815257830830535600041451476645443978805142044657833921127247033533628716506571358424324423237490438402971304385)
+
+(my-assert
+ (- 16233726784138742204308718138203086218138595789383817317246449554340898453104/16370584482945481446847872945862788646563748664837147378940234530469832625057 14431071141710676049963542765626402177344958369162454874051268130438178883381/21166786163219212747261378458659387864767326410261049063051557406799162784072)
+ 107370754167217929909136144689909613387440429633745577224054233373886366171618903318258855919060113440621302505589923655976636732694637334616990468681771/346512661117421566971293748815177161526095870176610277140325665174756629068111228154091043637596506814557119477231243643171068111260010676990408227692104)
+
+;;  ---- Test von * ---
+
+(my-assert
+ (* -6520062188352981842/3213004995534018829 -3812444292971845716/15284944374811818089)
+ 24857373879807849010516976362973488872/49110602632729971801355498746248797781)
+
+(my-assert
+ (* -844583948128454879/4750740551331102615 -1309778567130405125/4885884698278749707)
+ 221243590680205607733892613510570975/4642314113048197066962569716783636761)
+
+(my-assert
+ (* -4579815856418431271/16947444571374397297 7990245706938186906/12540719430158043191)
+ -36593853985314806270746820601513137526/212533147427761354206383017714519654727)
+
+(my-assert
+ (* -3587966953201943536/3194797554208122281 975954052071387816/2707062718507963111)
+ -3501690886675668292903668827990357376/8648517352177231144330968693325176191)
+
+(my-assert
+ (* 710265334225408429/567023629756400552 -5578988760400430103/4131535930210536898)
+ -3962562316545608552741467762441538187/2342678499616965424161446427863567696)
+
+(my-assert
+ (* 18305319006789031727/4480148641441744463 -1641093267260986094/16028097657311023719)
+ -30040735777106040963634910981471804338/71808259944297590021537032075729917897)
+
+(my-assert
+ (* 522499067029593907/142530390958606446621834761330018829110 1567459634764499377/31663510497342378306792964160850079086)
+ 818996196770998943862055820464495939/4513012530308148429025282037949729145117603192483641232823845248212618993460)
+
+(my-assert
+ (* 6214041481074460220/139497414619784295310756757536261769729 12187470171919324678/129216394212432939561557938117593031955)
+ 15146689039532873328968703771155061832/3605070583825050709361064709099418651298807367637359842488375232197429738039)
+
+(my-assert
+ (* 10022419596195177499/91129297586760817507648681092594591108 239769653037576215/24086455608554015268646156321002022494)
+ 104481394312031409685890479072416795/95433990476618390508514520731482064738017476445225501421324446942302103624)
+
+(my-assert
+ (* 127731839927226607/59760640855511386051149338950192132591 3679984267166095161/269870724770589242613062477043917992045)
+ 470051161348371979221331000573148727/16127647460431744118786930146746069875784110572380855085272434637353123238595)
+
+(my-assert
+ (* 4919926511230586366/29288587285987487013553554568227355149 -2914615432991234299/34407808954885309804037535414452526052)
+ -7169846869407694119621783007930483717/503878057947370143933800273784055481319429768630967123178484618174989420874)
+
+(my-assert
+ (* -4322680734125283661/246950524730861178141734701180345535020 11581515233057355754/82204027418720951285150957025638971309)
+ -3575942340708251875937466941988609671/1450023407574517046920597087724458064116343346221474061477327267648859624370)
+
+(my-assert
+ (* -5552456004563371781/36434418778024040927761226774271610950778609263056622471030041615086459120568 233319937833204741/228703279535756717601739981368829304509550463672786894384479957768850829340)
+ -1295498689806330283646616799874813721/8332671062513255913250553083541810221054209355142441164334390514659539371361850837178162594438925276666798780352514152276296209564179606228713851865120)
+
+(my-assert
+ (* 7279569964232187047/36316165899095632459738478614507512808578186173163489609755035948221062420580 4568992288187244990/18279847281938710983382796940666233712517527808023718591530848159479207220137)
+ 1108676634263212048809114991909788151/22128465550033953372731954247755694375180631486898426116907313824243654714198100644737500721615620412852035450119116976232805701601749863504629937973982)
+
+(my-assert
+ (* -8689289043809733973/34365105035540924847908154205433563929060132734873649554594240958996510665976 281724695877043289/3383396067954681850718083474385093262190311835985400909911383280975222535225)
+ -2447987313255021583629117408894957197/116270761252098802423406562021935246701911690887646043563899994409915142686943691634418411056232663942535537938126289647041118885713303684881867869004600)
+
+(my-assert
+ (* -4176416206981759902/47077361360975682486641492558477246171356187409295624938308162261216397376441 -10870319933050648575/51626085927005484523186190379579228801774286705829757742503501130303410401261)
+ 2670528255498212232918897515060496450/142965876637554026205455979922464979254073063785755559223760631646970673683621524411341782655829702451013418009338618833412062193643308417898164204593653)
+
+(my-assert
+ (* 4496049401725150702/8024116634872885909638996643719901973664008349644172107626390134736213108465 -5231341280619167012/99267989241776204190444307671763754306088564051099822830201760217121508089279)
+ -23520368834947889555464127765407042424/796537923785319116837266627763277272873506235001122453584405648384893204423914484193595265931840447141766909166026026228531619859740155558402735330646735)
+
+(my-assert
+ (* -2488955833769033882/80573015130339486598712021266263458487997757617589137912729682647628329090307 17723590657579960683/79078600039601362101827108583564759878924923849842119643649415446502020994810)
+ -22056617181258995266120581914227430703/3185800618738432636378738398589185111057563002909241393794402306079667392482341108052833514927720630087013771419748846412352850012097731569487991234153335)
+
+(my-assert
+ (* 24410613567363183821142175154197794689/2233491913446620869 -289777146895293391500645889398422195537/12394177861163531771)
+ -7073637953514043162500219088395995153310329907185649946877180402954938102993/27682296026727883467940485833673128999)
+
+(my-assert
+ (* 15029397898618080393623393093137341347/9939158597399833599 268484092305118852707129202725716126526/9752180454987984749)
+ 1345051417567645337656755504737828287428006597367109244226136136424901090174/32309489404196149853047846865649927217)
+
+(my-assert
+ (* 175291724581304230067306380062677652261/4791591464449055089 -207911166974886786162808240992513636954/957635297799905137)
+ -36445107018739410292029741836217649994267718828374576884161821761303211252994/4588597118993154438342028473487092193)
+
+(my-assert
+ (* 208446980882041538439350888438428103817/11756453246592156788 -99855903858077543170703702663212319708/7775813092266901197)
+ -1734555140205305628415286772698507060801514301420325900368570916304368260453/7617998589456250715053087609460739603)
+
+(my-assert
+ (* -49595797981179247160347259926801311825/16426101929443877636 104499598328969971414586784725010079457/3085074725343747115)
+ -1036548193567594227670217621556353400490405002875929378150074378019016735805/10135150379689493069951723318357604028)
+
+(my-assert
+ (* -288919818051255959565698296502103975540/9373352185361138021 77343596824463059344208562767410464067/8355013728778983070)
+ -319229970313622361785032672064391711775428287673147624981393545586243098874/1118778374191039878067165437747032921)
+
+(my-assert
+ (* 301194765217764762175383920433701358543/150076401641721289621709469985978858175 -109319143590504335906407585568245068241/158084148208214805386290412276525928977)
+ -32926353787549066990014316879429253235742017240010356390402491456481443332863/23724700119685440084214937112355810539035473428177368317381421021523605836975)
+
+(my-assert
+ (* 14575317438235510996984657523859363247/6747043355688580686998987940004831062 -98472042392613093668204392119412188287/152397803267436514292317070561082866275)
+ -1435261276663720115408306632770383012566806521695455296458086302958691687889/1028234585957093005711368462502470683211464374115746651290896689614112234050)
+
+(my-assert
+ (* 7543367187310376010646193530301789591/61115754966424662873097894247178344192 309940239796651595482411737112678240799/200261667764086238794802895148430893795)
+ 2337993034909171213000031444662193658341848356694420878002930517675329723209/12239143016237439360279809707749702660797878084581096344749106125186707088640)
+
+(my-assert
+ (* 306232835922656327867425959604977465100/55646521674811091128956181530575055283 45245255551837746690160535427248646677/3669533234425940180962041078287629087)
+ 13855582919684583969821610044729507626133731299765443289084519977056998472700/204196760665922729081584465192637337445710456706084552841012480810023816621)
+
+(my-assert
+ (* -280037880297253633994139513185953058494/23798550327416056573646642830182072429 13967268482262630670960486883264178489/7947215947745048068401387767511847243)
+ -434596028812829556627014314125713048434599389957141408329542154357763726174/21014690966139335562014814134594464675233042588696546668504776333756662583)
+
+(my-assert
+ (* 87160410649223805266866345018804635271/204719779683096591635231158476535039583 91197762560765392928084914476898132964/277206223024759381433146631560580134513)
+ 7948834435086720002947247338196997812861466884983039250681993725808882173244/56749596904412078223459353928850191672356004665473536520452927516595919428079)
+
+(my-assert
+ (* 272801380449749740391855824723351316848/2170368723435176720708253536680067463416474841046765138040214254204061862261 14545537787709209389572055399030228996/8381323291479119825335849511027103148981778425333781230074116361235206363821)
+ 3968042787871071204066360146704950989545352280096012736206796950415592924608/18190561932825050861659739926693806725838682397154479213760300500132465705680046683155463862909993066621811136554677896021527098482779305371951555659281)
+
+(my-assert
+ (* 58980225701104541897366713189611773567/10973700523953435846969235385386214078292603476932194022615006557054104506344 21633357583056027790037764923811848217/41236459355840549300942497778444413350482341379076368704834339005347182486274)
+ 1275940312921345964633100864283753667394719832288287163056787891633576680039/452516555639171997520308257003811683819837367444947027711901120987864272999978391252372420644671039873982401560595091423172287702745925783369137325922256)
+
+(my-assert
+ (* -39569537110370574225194522625562874655/36290593978404925051095380486087641410218299612051669925683823165483928853304 39273660356839128453616088747231247259/28875229647500294680887983884278577441525691250738380954940513956990510132534)
+ -1554040560950035541902707236381071410695075315482961522429891905381129320645/1047899235170633560739863801929205639611958070150694189488499584527041043137082563721218908614201921449076002548982308540689571766482794493357171683792336)
+
+(my-assert
+ (* 8957762734053174688386697837976422606/712105675122280831038408324375785815130945929819518342973925027507219300067 118977607972668646264715307919875588738/36563306353035936296510796886853084280648109576589600551753305930842020963283)
+ 355257727628119695756412145322380851760544279491883270008434507085780737076/8678979318410478400681656718586483785992423192579006235728835173903750764880944673586689792087386144715446501744012435157310426693657188196381455479987)
+
+(my-assert
+ (* 114386050140129336980347743358441052599/11994188887964574384037137314302737861703229337059619512751326848591488081229 -50822174853799566513638003084407139228/97406657802317796912648600328217961853548397771614449630742570869667560514587)
+ -5813347841057137571369557065847591420664634372223088557679866032754664253572/1168313852626327929522799656188055465298138284154709873285311568978496136227795809646907486798429717114923178357702460243511883684964123937654308495387423)
+
+(my-assert
+ (* -22147677230189664783449572410799931501/75580058176304394102183955194485040346816524663599269056794063928343401057143 -127672554664595215026114551202414743739/35777311684781371234035985601066874920871049301826919955489852676067316906014)
+ 2827650531865200718433745248471704607394596478050653604940563621773668622239/2704051298527551014378337257898371613519363350219566689647796093438747503077807722203668806231503452508016974614236112792032033672965127824348803574358002)
+
+(my-assert
+ (* 3468729773587632113679855593063165286551216344725198121609354788619580819847/7106612002452012151 20863200733446307102600190583661606839853255577505815215312643683864543217073/5700246487811068117)
+ 72368805556440529088812813715602124890901251289457147618293618526488567540302416253970205832659523238561757581481150988870947074663135867252252227647831/40509440107213064064897416415172689667)
+
+(my-assert
+ (* 43306673717838918980731699770600730039727453611468399058203483818093233880231/6173575908538565981 106634227988568775671050783423559067905086861634892257032833451008548321218936/17988169594879808463)
+ 1539324572884864883885215269788177741067901747630436643318399808029602335378536990210735234944615096105103848497832537965483619535769637171783464984418072/37017110149885307295697375341989232401)
+
+(my-assert
+ (* 61636028396239445662576777415312348317278054920190931147781159688109244233565/149659999183936017 50280832809996410949441105432174396823883728565382915986396125237655209339731/3406752842984125790)
+ 206607389257567119017662603624829733217835095238758046754428174885007999774491792658838812826043033826701244157167565054600950156595290052398436186551401/33990308513391731439280046802638562)
+
+(my-assert
+ (* -100579490802304807750359433955474958462342659278486016345156932756807754105945/15683759624513404963 7314396152134987983181095955389244247502417255088677055075146925285457081540/950287995699608967)
+ -735678240508074701153113537069655056596152436111651040530896921701439724727486696483134676487497031899584038731663111390949471467249259023050011663755300/14904088498613295322494450308817103221)
+
+(my-assert
+ (* 25984831699359211750216710442693374608159925357093100400945034699383345074385/10463598404993207796 -2395913226491242076662067669730978955981403048697660449593722338244504668974/7015215522730452775)
+ -6225740195664363384298636893730784883811595661227613249243163802476751022407971476247993440178871949687923603921101094083879668063131450147131783163099/7340439795432595812648347200273983390)
+
+(my-assert
+ (* 5173661857391320950903772549611256023540539838210520778403003347430938670915/2590493168574884173 100300641976357496491877756123729102910724064566692821682523911939220592349990/15304416107565779147)
+ 518921605664943617990486317157527087053001312760892500249127957517476408720600460633868004681188890038115877413554399588737851074382787744833707113540850/39645985375676570588146199684023740431)
+
+(my-assert
+ (* 30299639015164203561126609159677900559022306879488518544803392527841364186955/97638167801975054493877206805944332747 -50150465496280036231382225902610460555496341860773955714344071185921583266663/170117675960786609061777750278261277482)
+ -1519541000979732808188648781832621044050652591754537200855596768903085847105531546641139177813880505696192826380113425984545675787584857974943247950981165/16609978191541300835961154615181304582159561006676548938424954151558306303054)
+
+(my-assert
+ (* -34494394944257769716276791009665812125094062960425641316440943461722789694119/69239821080832171466311153221314488591 -68027404272124217088707268142523090163964888591405843143848585935878552833247/257149529774225346004390673137885895872)
+ 2346564149995340998782934409780604815295734898030424565252099571337345550054284934036215402972664245125313098735082896555892607540059632597741979943574393/17804987432587488254198543762235568841018786223139145264591718687823557996352)
+
+(my-assert
+ (* 22330754509472350470460807673039908304726422770752644988051418230315708975569/141163736844241522445115344332946835969 -3776092949566234532895208849184634613770861313997034923686862122594334787771/22367110097535579962848998753563258272)
+ -9369222740190326741203615957382420344247102784278353165345406236082475331042528539717966581690645628370939381978953360215380653092335198860022382107411/350824982641632215769272917522017419782283768012468846380070797128085153952)
+
+(my-assert
+ (* 1376215273451682681102140384578115142238259557166158859699272578561460124263/3593386179017642636485249017714833669104405991325015697577507088650274886871 37146275008876311604039415809582675415172661567487888072055609579242279390723/55424998453085285819414374477780690192979527887019008768378662580126754826472)
+ 51121271019052119686352858568900325361226598163234091421115939503875711782442415328681175322030659510284806538410228985354770913411724825992699509412149/199163423413390889071651575953261174839972499014963134990506980080139461063269751906284862132821075544766093817070661266293471833091996501160433036049112)
+
+(my-assert
+ (* -88175289711320073148300791156190227927348022787624424521937188958291199926437/38194742314758366741668899229532351990874883495690656157862650973602784662629 93421911195279228911508870033119580111709458306921869937709821511660370035352/66371395138592894543765954603571534463846496049156722497129962530412046587003)
+ -8237504085028962150049531747535213236460729066521397582683209771842938254589363802757604921456170821878391951762499073662677974506165863935238701489400824/2535038334389561782321790943041741331416028402594806464107449488311138037598457377927652600804722340759363172755193254192462811091332303758223034251210887)
+
+(my-assert
+ (* -88364214910455569163017945328431687038422451206033411348821431934742389780753/43010507830592044720656702803904712217809857004582018186125828892174875808576 10405170283887792832024806983921158923908589830001636723872220129826733402834/4055629711949631304631599195955105801456753694558712994574702123032807265321)
+ -459722351572673455425943766571506569631562018487574498847133029199411842205331593858852090421782204158679934054007027833206633183796877753882057444427001/87217346741895687976684378003169607737518608233754137677854312677618987931466495788077930577814677920791330694741284253568592140275298729115088619596448)
+
+;;  ---- Test von FLOOR ---
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 13918288150951705093/1401140429528746218 8037346830653401534/12140087246062147767))
+ (15 15819536596165521240797345101333717/5669989019487990500153722689252798402))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3027396677293618661/17394867614909941317 -2291333958125929004/3188627451035828949))
+ (0 -3027396677293618661/17394867614909941317))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2672347537044132983/1242644867650938739 -18408840898134373335/10231522001278674776))
+ (-2 -9204560351304414094275545654164256161/6357074151573303338260935869140273732))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2909960574201625242/1140661215026522267 13303037060238089383/18166352033245030796))
+ (3 7340592943788470245594328177983578849/20721653182840810059519494723194734532))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8198662690782244017/1375380265264517299 -9940234650829186147/17690753691491997765))
+ (-11 -486100547007747193780627302695509498/2211955773175772955922986386719257885))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3966139130172032305/18040321970861620778 152082737803043526/946729689784517957))
+ (1 1011240112172972726360628393816617657/17079308423086645837394450304465310546))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 10199468022732280591/121419468943382552600797741323914786260 -2627475271750260665/95465240194344921114274153619846654671))
+ (-4 -302411943986468199606823674581501024373007929237189061039/11591338766949818909386523271402122174353420293128216789558932652732995620460))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8471401573321747185/5927836485002954534423728282157030389 -10006560123550811854/209494971446104969537769985569938393355))
+ (29 -54515717208483066409886298754350924985999966734110450701/1241851935162873209670541996670866824232223815534136678858726178724570665095))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3041516402669280559/23467966340832028705164128018098446335 6098690148519419819/74694157223362514640536233319542912231))
+ (1 12008521321399654679364472921217933270209469640706386252/250417138224955291159963090840561809997874350767164909187205124534624089055))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 12371726101368968041/23093272201098893335944386552801821150 552920335555268471/59704833009801809998987650097493815639))
+ (57 10833671498697672110331389655963519805471190684307179149/1378779960416507709477447168250340219220272308941040290894608990101550964850))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3936278768643199217/61530125725985401304656961990591319570 -4622522820386904221/99931589582562481620405120529601200875))
+ (-2 -11699348415245273343366505594272785590391481515341739671/409920218067509498701508662179031915635595553469094563928706113041525908250))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3378221394828629408/57360271731094852990248264232533113197 -4121489923477642292/582636574825978160767401314647264235))
+ (-1 -234441506605160102966099186988989055202999923102442904644/33420192252492486160839993475212088893408362946965395344436948483624609295))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3136864170660359113/44018155426864484368550814560728963265607376469242388043913852619483671810359 7592249764621265399/61218932554330370729612969835045191215382261653025522947071546902482986859295))
+ (-1 142161354082922159316702479104046765633220994190482626315401062617857980099757409386379034462906/2694744488243248258380889922671073488004909384816885899374920518252041793957332742201117787314100221762775952924983170065632438581816845330037820256436905))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8388845076992722039/113324439625023255923060004687633012536810961583168953468887128369059333869915 29270787347930250/338347801532036561796340241450622341080868991428994657767799334610272208941))
+ (0 8388845076992722039/113324439625023255923060004687633012536810961583168953468887128369059333869915))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4061469742865314937/64801603451247667482343238717974543532449298971352747107214551636724513855613 1344403291462061700/38470586305356068360716898225197866224089081322833216143931662358746898751411))
+ (1 759644321951821493138045865317431182965861074290543254824595494322779964610920583206631767077/27395117343919593983759778902763691133722708413625034340026933459895718790907695509798551507285536033282436777270923749566119049487283571076783727846373))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6300876868463754766/63495830134457398131576869576746882401947668656296419431644557856865817622371 2683373787654434721/32958906466135519543294750118994566579246721224880398401534853634103601897753))
+ (-2 133096081053989316587079956940067402118415059770888001584265696499152144351877946562766899046184/2092753126391210514581307904104631961415819403699771474276457943469530908829049497503906750315560161637143522534287446520082226490203274292567625907432363))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -472307136668592250/36283411370339306010717878389083492352344779970196813667782297535345620767127 -3180306511295187523/75166923119981694900512094733973876755239261156251968596129974579413418042019))
+ (0 -472307136668592250/36283411370339306010717878389083492352344779970196813667782297535345620767127))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3148795985647001686/64429795462330994424525695145310698340316900821860011346129307089831843824641 -11298596415200487525/56650030835870774988744337125832477562271330606264442454925440669251648355512))
+ (0 -3148795985647001686/64429795462330994424525695145310698340316900821860011346129307089831843824641))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -102545151309532699273956369870862301497/6030775709520909501 -3288683205470962892631604702141093469/1221554251153305018))
+ (6 -348033375896483356529697355308057680498851424685117674/409273316984297575168605808523732001))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 262657016871433510082498751402781174749/7573480743368102221 51080528722906667824171406466289726452/1601607284756767193))
+ (1 33815990969774126823949725673411671713268069951579559665/12129741929543448973808409847523235653))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 138482489784362691982393629835416135309/3631852344347114410 -24756007176022054565783765242491988918/219932185588761813))
+ (-1 -59453406054861418860933161489781197608471921856017953163/798761223827929241442393231350025330))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -212217151846170123039362268732482984696/11596630494102963285 157767757347916893207763952109296030356/10257360923209581435))
+ (-2 32941352246943117620876731374547894383947184420447916448/2643351654913607911070701558622724755))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -66747006612989726802598039638160699571/2655077042212383298 40811355885089157404164119163071734769/5571784139947382276))
+ (-4 15382315863254661753182362315746357118308047043239937263/3698379038534340915097856546560906562))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 68762140087929702254258676232660238758/15300356027061891153 -35857327153107467171153230588794581375/12686181688605082704))
+ (-2 -37488456798327399439537660212002603897618511901320984853/32350516076608496130809185423035152952))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 242045811640213090811968332747485173382/200549144102874156362839425688475328049 -14720899626826592765120758929463878529/55362986404688226126571951930830517493))
+ (-5 -1360940123773119189782995319087829718305547957827775584170427519233923828279/11102999538439281856672090511521389719230333671905312848993361013013608061157))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -119845294654504250162135973476212065855/100235561394484311088266800183679226574 80594461105267736432364594799413149425/61631997559252488378599155330559465978))
+ (-1 173031536634535211165479230108382118112369885610634326444128663790131209690/1544429468803790002857581373808877159258315141389178393568445604388376624843))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -230485693234637510798211679560546639349/52735224446003804525152654032694494673 -216057981617610709644611545583688426965/260006637986112259187147152181319007048))
+ (5 -2958479432060194175681245276352090941756054532611547690395592385359334844527/13711508411648488620980405764270377927416829995446554240961159998044485455304))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6594316542549343232263525515993767282/10217421010314527320204876001269664067 150738011702184633072457541580514087744/135040956724953232085930818414328999685))
+ (-1 216550304321963092517168155612888510209814057236150214483836375316700196226/459923436164837338339599279302608001719626738369225259576013169605366272965))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 215280935061082631947114960623303029323/207354325693067193327551969107966799241 79751059907103262336474674983968289237/4337760464235769010513178238272088134))
+ (0 215280935061082631947114960623303029323/207354325693067193327551969107966799241))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 310160128112311271225164732000676894965/86670395306350722800942425502835485142 178141651878134061724955020964246844473/148821875093870378260620578385076958277))
+ (2 5093132355806944300558276298272344941234347692198850733707837927916021244991/4299483581539365588748720077960621199296398702837049138084337644406995806778))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -108659820552054791199784298344597956614/11790531032698157780195997261827578010352156078055016836768011974016954903741 -92538322534416259700833065660026629223/19585963177324586927996277066630337817907750129846119872015696245293090497388))
+ (1 -1037131280631376361623284528995684848351041247146708940120596004521550738167239284685366257725745514224913041700989/230928906647528953486003129436653219142752591225509660589870619206780147714239888278154624266956202529317853226309156501996262035307639197627615351928508))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5394706491096230323847274166255447931/10999333470518091906908673737442830723710024941373839628113269063387717150756 105688652677006186461732590041930264063/21972728496093720326374563200555762299989227113998910666496198593694363180514))
+ (0 5394706491096230323847274166255447931/10999333470518091906908673737442830723710024941373839628113269063387717150756))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -191689412702065586724423672263415136270/93810201821180445246181740077575222573046098171118578720996957721548578622199 -96035306478379345278597023485459703599/90477882577875726723065337577743037040931870384035502080606137411367114071296))
+ (1 -8334560691183765714134253806956288712175511004636349604358505688696669629914037375584956898475941052209595993911719/8487748424983587977143569651002086894691875550521839392659856872027244953584789975128015403703285861633097358090901236825413778659897331594626425134299904))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -23269937861894460494044792238228308465/36609152344338882339480850660297061488131282119857763060331849352205685148721 325068909216594106686082320524489871331/91177237475655724082435461235746167562462517272459785633509544221351873775622))
+ (-1 9778808569440655820425835535754928474979020881405653286273845718180424961228320899578451645656486131670752875977421/3337921377082244749772660717107363339434489502423902307989133990817960972244485458695718522007125256227586389900645261310720433804087640398154830854279462))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -238326953836192259685740729837504392751/14355772111692545517089448796014758311054554297101342377064555342044509505629 -2243842813596041779461072557214411973/26977869328891440663623277939723739398284518432434090329689171706564354694000))
+ (199 -6448765647740977471904737113847651808330060639815597135148713750030489976324569684096986913258458168828297495539/129096048048195144296601029799754739460578975322841318685536300111243981862070688561642588911885232705019881753766051653025282618058049676501115190842000))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -154358049055187385619395426022892405693/9651466522903571511806795329901971873531573523740147689205585933143787251744 234831599528611417562275088467151900111/23212020955553784427152057042945842586938059290340162186208579138883161355663))
+ (-2 316658791137724604029754690574124702890700231484127998714230110560397057808441246896564869593555547226559779365903/74676681060487840411987924431521223169933844488425876950176937169482763523750924018302125631058404128587876741120722730563623397211887516476096033675424))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -43654015885600226452139253734240763904114948357839504394635758939147918485226/8959421350865475053 -71396498978827369985021009185210519228191289633806094987720268011017813959395/5118659875263168828))
+ (0 -43654015885600226452139253734240763904114948357839504394635758939147918485226/8959421350865475053))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 30206748063040753946799836869317684942154090322823467523870425873885298155111/10481539418044277488 47024848487236673350978260730205414416590483746605328718368229684499622280474/7191921838593099535))
+ (0 30206748063040753946799836869317684942154090322823467523870425873885298155111/10481539418044277488))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -78297878369391722158254897331818780133560455296543117876032852961696240531334/3439835335342974343 -12036259456916995957158314961009661904873237837146662571140339452059150719867/7648180594799196815))
+ (14 -19197805765101853520494699712598051602631126933023081616555585309855479307669655742300981287876/26308481861074724148503061769552317545))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -11644466368871135752271367372638717312589950278007329817169736850185519100737/1311440431008130360 16666792145043036974187190230561351375866940864814143604767927371030164658327/1190204555866760523))
+ (-1 7998208151350462202845967149504108047636942539158206705970028049633264098721802988652183702269/1560882375733744790369742288085778280))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -79973663368880337215592714973251653953011156710750446016524362581184906490344/13217906252057303539 58550120458525994168414457422879483045080411293174816365332363703279727325517/11983119832054095608))
+ (-2 294743007488634911900879023610601157709203210196036764662698142539282328840165292825377976700087/79195877273629847756913363266891378356))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -41283916983957018057492477658728498328100012640087810269690534262888976961251/890401703093780527 37905097813993829793947873722213455441729327992618875876994782685865871567157/6801392244603328629))
+ (-9 7656253348038361960592683452946138937700391767097248361228404271354846832369355003597180736924/2018657079334544839920956083927269161))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -18621387073793741287833632061282985993236184599525107084971126746444001531559/112377251064249742125143336262406044187 -80344252057643577515390451958447799739023169996897035042227858478107352127859/16565237077789941458934656364080562722))
+ (0 -18621387073793741287833632061282985993236184599525107084971126746444001531559/112377251064249742125143336262406044187))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -11067278490740390186400140048488373691939192899502978554850454064301747327289/279730468938850077684950205987597341304 10742600231685337944302634339424380376867728558611903252501449407612160123471/85514692364145379323997472383947484080))
+ (-1 85775736874497976296219552104494263998937714945890467644689458878788010379480929901293727971077618208617170461961/996711041507662039484243506170638972651237308243642442559705598573661101680))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 60114400703399744178227904113253512958642740092037841351403601970012663733574/137652538688206271590219421417082587275 48818636606796573849225811493965362933035106650390076441334389457476994620122/53029693036557887125608655547988906029))
+ (0 60114400703399744178227904113253512958642740092037841351403601970012663733574/137652538688206271590219421417082587275))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3914498366778062569843980805049542971189141573995351572704819538012574198620/2893535793927099250376915741311683101565016171163532500028982710856616653543 -64455977862771995990556362474021252617135665526576459531278423102067698175925/3427268293660091333898426457103031174054024747619806545506815375759964110507))
+ (-1 -173089642940460836493548201378493831666834527213381638819285816422714170656111775323359444521902045952676537769939820706047335458029055584112252141651935/9916923483096927116177052980173451074387932639677487416966276325060341893415045555506102924285291258490295955820662010134773377007870870750288985076301))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 88685468991633001080737925907185943038820418099572822599681084512202985499349/12356339561700478684701129356342132279853496560835988907745653698832814553183 6529471572210817352014560971376587702394496047549533959161274051805568907/3739659250056306079416159597801009351379164652345884310988690700223397485))
+ (4 8931962841313470806790103494237286341563410404854617106114803081793820819240374925219641539537617481113314045913411523358730270170471325648745013341/46208499538749877879324553712339970407875860449933229680283463405247211324108302788607460717099015088790299594129098751336540918286885704752480944755))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5294621876959552948152278397535786930445255402598688035901577017296377116948/5881250468392395166026135319241737823103911942970361556821993967308880332607 -65630221834131781450865541487035630878349246622282004360445526978282263449249/98696808137715829282209856003081855629375417101578635063186137762415694777903))
+ (-2 -249413266253338816038191146071217173249587815937933968995202267999853691656986532179554523041282106904325952906300316562845535251623832095499430051524242/580460649088775579832453445973177920831893989101100068436102498480125976298386547626652311003668489010795846489626845062951616643824353457996671633983121))
+
+;;  ---- Test von / ---
+
+(my-assert
+ (/ 7013212896988366906/12397903473277899947 818833870013215068/2125577647443895255)
+ 7453564285301859120853045020886215515/5075911640537211768265804260348400698)
+
+(my-assert
+ (/ -15781329068048599432/14942574238341613337 4388772934226358350/2640112802717985697)
+ -20832244458230302534551181278529162052/32789782692450857054331267544650656975)
+
+(my-assert
+ (/ -9015230453321124271/17425619133302730035 -10422000746814766599/14972344381173680534)
+ 134979135022768387806775446187867640714/181609815620990738305316999098032100965)
+
+(my-assert
+ (/ -14741075237791868512/12448692140900938227 -1090381863721238817/1060836378253796023)
+ 15637868866825840780217685066084527776/13573828137487503515304766902031557459)
+
+(my-assert
+ (/ -7371815071140740177/4722722556038701367 3872455829192658988/994203944294825175)
+ -7329087620340161131469364260313555975/18288534491791723206480607737200436596)
+
+(my-assert
+ (/ -9856364379969390509/7988230468709836259 -7208901117187058135/7430860779232874136)
+ 1093153305924514768551484985555671272/859497963436269188803272225817371895)
+
+(my-assert
+ (/ -16740689272507881147/56924866550406451570641164619431212169 -14712532880452686095/143481612520580129383584255576273223983)
+ 2401981091525408257128502717450566513166280001357873948501/837508970838236191644285394369194561392491093277901090055)
+
+(my-assert
+ (/ 1874027699956565000/65960003455647360668413772300355814843 -172394881832672950/2006879686300828197846469567507151887)
+ -75218962452157875130617756878839223573611935155763100/227423340028380523596387094039260091189651621559491937)
+
+(my-assert
+ (/ 851521912886492079/58839621451933520132430725102159653727 -5525838657334730480/268863138354222710211869290179088409033)
+ -228942853876053297959532391872114722003932597144466549607/325138254802036127673497464266072288930584674567672498960)
+
+(my-assert
+ (/ 2130823024472312937/30463932363736038600114358208342163020 413938864244113775/131673792970459944919771618253738144891)
+ 280573549781056638388629087822719475587456644826399754867/12610205563054396144647765193069861697742251186477600500)
+
+(my-assert
+ (/ 17234694073181371137/253506951459931119968572673772742357160 8407879684613951161/42697666588937447817581914537644794355)
+ 147176244259806896721181660841298454615950364713859506327/426291189417673978158704851675227114861497071554451732552)
+
+(my-assert
+ (/ 14739301038477826821/4801125431810347467140397350459581435 -1752125940488995048/127905197451270157484305628763539243969)
+ -1885233209620217720514367144506571751170505057476450692549/8412176412616337518572109406238500578932979745867733880)
+
+(my-assert
+ (/ 9194848570227974720/45448499872046683203864930109076126035374684748838016011669264943000310475483 -4572473918523931944/28941042619577200519536336906341131911598596429670188136734086846500956354149)
+ -33263563043940787786171015409141766453199063320923723716765930467953050399983260590187417389160/25976510037621464639740779963549572814837984766154635046133743883024710122710674726552171566119)
+
+(my-assert
+ (/ -2662376868940711929/2674240208804755702377222409224408783678596883960539287029565653749020338064 -5046618244273151929/26826013625152995057141957222948811537350409769204161465077735924332004069058)
+ 35710479080747854012875521001477955195584454274704368888444222736697434540936425667291700196441/6747934713661461716612153292457811722283965560031580498434684530869001786777260513409206862728)
+
+(my-assert
+ (/ 646980248518054663/28444849537262537816809349756569888989442483441699293309597267649158853799707 -10174938507557455325/16470612178414296088079890015341965945714023680627341561729034923083435428747)
+ -10656160760434978971303471120231114671340660575734505071429575384684610862775940451177787597261/289424594898370460244167952344748286246980979584479610186308309369583658143095854438992150589775)
+
+(my-assert
+ (/ 1268676597518744714/6024937921458004492480888468749320142603908196076058575752452561172018490893 17823595902143962912/85935047374548136904062562443188289405155329832270007415035044821925251080203)
+ 18170630585125644385503771892175817370913744757273904248648000044618805359154885235028182716157/17897676474595109057512045856227678061218241143085827332930191066967148125532813505892133626736)
+
+(my-assert
+ (/ -3035741006152688190/58890268425224581569217175195410848521985674465189565646495474378301884202047 -4870935665435665519/47998868922405332801456101880162843269583282603435159879276723163289928325531)
+ 145712134636693761356266465698326002831562744975420904782663360472436650653549187025441059178890/286850708819506259357726384810790881448875152111132928069815447961129371272624891025817707117393)
+
+(my-assert
+ (/ -4420263280205408439/38682162086456801604593696710774835436326970692840048042132553053971380151628 -758651402628235427/1755534012040040367913026343944696058732638465867705260088080517539506722166)
+ 3879961265286134914514096239640695384126081133972137242327715997675029567458817030555062379437/14673138261791601182714628661554161812345431143865809776872034934342213839184709418896670662578)
+
+(my-assert
+ (/ -312487180249669742743295380499853180353/9828632991038934281 -86131955660561774942466932680637336739/10268762916730341592)
+ 3208856768501438660232746468300370677374054716853273141976/846559380988100144557815474234956961169507773676687849659)
+
+(my-assert
+ (/ 105376075880566042097567073713047434893/11411565636673693365 -220737802783327232867818580441304577024/5817406274606660773)
+ -613015445021032499619145665530563205764250055719854552289/2518963924957071797477174332253152325843619212749200245760)
+
+(my-assert
+ (/ -311533429150518992652072799089375050497/4403073054828470603 -320230219907951760832723580313293021909/1370493254961533625)
+ 426954463345823097468320537904981772054351338526938461625/1409997052618498081840381197699863669488222338862641441127)
+
+(my-assert
+ (/ 305676222727436457375950609916137360009/2001517485431820526 324338803123828318219640932070020543912/11123178903397935211)
+ 3400091311912189654145957985944153094384781502787164376899/649169785656371151621897383467144093766684841422885937712)
+
+(my-assert
+ (/ 8845112929712368402815105446090151026/8124751572615311799 -107609110538267962880281203537194473336/8714443449141779053)
+ -38540118213625599008519681983731393728094066419546629189/437148645036763776481446937412401903340367189496615845732)
+
+(my-assert
+ (/ 152921217721894690043853278309581658066/11705615305395353865 184187448038871874764725486848823516773/4171619104693691390)
+ 127585814672335876029018138907883882524550368713261650348/431205482165106014329333719781838993214328411764819575529)
+
+(my-assert
+ (/ 16414254293541341780725162107696242521/155838132618727968561620486302365154071 323320173010032367023620851618405869489/49801924105617352177018959505967933104)
+ 817461446577249670665800625691379410535771218196808189195363718417488315184/50385611999847495177988476252475899813264458225659097815552272081452203039719)
+
+(my-assert
+ (/ -188149667625860588508273820953820709614/21438745582767797684161462130971215025 128458309657689922121539794960212789849/134174286369366827879740776978166655691)
+ -25244847384333405496229128525982900130397411994350175944375943735942831513274/2753985018743617742875555653653797261370358442640799457019039857068516281225)
+
+(my-assert
+ (/ 1218460641064115152742257147372113443/1773382194117714970762642066492794929 -105212349758139121832338365854603836112/35045896682356785176328011712384921341)
+ -42702045738251194875426595475683618047253961691478453648029952948483687063/186581707662369193907913729212042024270164277319717456729276609131940676048)
+
+(my-assert
+ (/ 1467722271775252460214852151179762687/1747611358981474614363356529179985509 25495740211005247928144692929451604259/29615224810946461612486375021101910565)
+ 14488975012885720730598332784736375353299643425098519766594278819666029385/14852215066131169889445443721709162270198753408805825268529301698140894277)
+
+(my-assert
+ (/ 6278399735526726207674375684072448068/13890681759576280617381650633747782321 -112063146811220963294237186476216238443/46495820670393894026441353693945662660)
+ -291919348200099113895651901892723884699250237261456280525601785996696740880/1556633509331345870779770006255469001211806559199158615405344674499795966203)
+
+(my-assert
+ (/ 248406099260780863433196593538936526373/315762135750029127758352280023694126018 -24578051912523675039725210046249323571/3033769619337997374435389027823294736)
+ -376803438597807975522050212312559316811899647514236724224019181136008036264/3880409082236781853269738100403484871805889674074731389226471480469265885139)
+
+(my-assert
+ (/ -305871752543087256004326578375555909668/80170799467978436032303243749692785696371676780847080230403479135749775915991 -208573266832391890136462745593008906685/96016271562601269514856687672805175650907293023094157826925793080307407361434)
+ 29368665255505841438632782694581946057561031972462112644657516768267440383833513431444679871238206541553985530943912/16721485549600848123731461311227384049611071114404954309505697259277905994635125654414916826332204568970567318299835)
+
+(my-assert
+ (/ -171651126582338417143004525987733942986/48126955023093310081685702171788275811688444573315712039582092051531229683107 32570134112026732491936310765048378699/18584159151613423191553551933672204731023422884196280183931777685641069715348)
+ -3189991854959918631828923606391779823799241149346421336570141741355492000935500642040047513113849334779592681149128/1567501379505627719887579027549074087653888429037997616626567546431482074522690424133509833932668944596793898937793)
+
+(my-assert
+ (/ -31304786393644787215292629624842492472/10539846271603297974613179098685212701091372728582260780054561526149580513583 43496364289252206338797704034889660065/966865502932307025364733802774045297740949567802356684866342045679773834966)
+ -30267518040679809082934454680954168768135550720881039440573156734314284479043791824457029301083428211405425375952/458444992982373700837242411005687390212275114474481688646320865335043970683786989531994936463047685893258985162895)
+
+(my-assert
+ (/ 124366625369659591476708994326732418029/107684759001536292829359995221778346870065030877016948429894748600664800488759 -90949754058598173499067700725927605729/79727020098830307921496202496061295138733611655702270828135321391380898414003)
+ -9915380440470549523296226431396644117384598256053664887332801972488440466568616812942647849957495261151611303260087/9793902347049141646079571573977765974008832433473016883117384010293158932212528563016145547341801740792289848500311)
+
+(my-assert
+ (/ 26792084925762094333829722201654015569/6815899891200140342329613369008754659665480100088941978786466272502677117648 179968988142253715757129058636648023126/97033837835570527321466682927970125702018459951415339098532052222053589117353)
+ 866579607987744230609336186273867662887766686833260209925103055244528379635362816895584608387230956963010276689619/408883535566062149539621907018509777969515872715944952500700527207173412646715462423653890585029605025758308909216)
+
+(my-assert
+ (/ 320794852821756057819990044473359503428/42380074203350930293358543616207018031675687905746455222111844144668904183229 -11813439835454851567822019323728871339/51852159737956631156972450987013128151750117741949546305537111598356497409240)
+ -5544635317209327550045071802859986261979158492907374734760649234578367469399038563605323839330681533705071632958240/166884818941132804535892580774781586387104334774784737031184369589400544303785250219152004898392301479219940857877)
+
+(my-assert
+ (/ 63160395612932962868082774785156358041658469338654564454114468396132462549944/5671929772244157797 19541045450680948617094710246839287171374470593288265457341382295544977156173/10827756125123268218)
+ 227961786821047895774887365257727015864174017882302289602409601101722343657899277052494444293264/36945145824164509580938949252327087600266044162541122809277442696583642758457532273140841543627)
+
+(my-assert
+ (/ 31389399613343712511677734270541516183531975055644318154870016415582858008412/11320913214023484367 -95931706646769408081251897664360951854776052790951374912970042200868629796051/14301831604104230477)
+ -149641969141325406602881756591195860220337618158488775091717625369334526143115090325362684257508/362011508473745439254610688691597507367516106821889963803421575701854031622412859179610532278239)
+
+(my-assert
+ (/ -50845041077039215658764589763556935122444212169574762080162289087527164772395/482986173890811026 -51342299909113507561385579724776151277474630060658338514843664853027455595538/3864573616937705869)
+ 196494404298439669659681446421686066898686292162412914850963937042669022612531239234324840686255/24797620991857267698917294149872672843409173617406514673128342148521539559341861421304646801988)
+
+(my-assert
+ (/ 76283614020376921713154299810619585257752996149145061806263596894412414185408/337890011287912517039286436540240936661 70530558237421368381589233382700323659036925075366138096846582768833233488577/12121510300837787759729092713205686989)
+ 924672613133132744522463879340347327755455994321131972145048214329608890428265966744607561005512244129921459256512/23831571118985077324412202325831974453532679575894228007993082738742295289254461850021038245882565939546151124021397)
+
+(my-assert
+ (/ 13518475961402756750057330871273933874583566313800024119371308450919239424622/71146816100737230880567880716110051085 -11914742388051168959634071864657967837347162591767656949770878950409478930980/166466796775669753065110807850377519909)
+ -1125188695291804746273664719520877594103080002716204716437885631737502681157239448228517736957154781558316254899699/423847992785167635691798025732868758201476408654527740579259436528169254792708107390082891890404030666159494556650)
+
+(my-assert
+ (/ -53624051286117226406327700847140806598091981633622544805551583455315188018537/149060170957501829683988930330276188371 -49540630291338976658332195799658601133012561780540500265134312414843218811481/313014990314092319823049811442768272842)
+ 16785131893926373429171158665038393627227592608630727377590747943991201054188961463248027101037470630205119769672154/7384534820569381535972144752572408048556227885764547207137140227958732266609348654686668662110083737942669493487451)
+
+(my-assert
+ (/ 2634758410586745842739353561704344884865889793873131750193619887157306355755/83106075320614705363810122092414199463231740446254118542567688658288107572919 10787649314660479714744029413883607304719873485501736976813666398631455642569/2439964488756696481271244145022481444549967702052558191280867337292105066432)
+ 2142905652761565172685487282499186838096673751132490328620490049367034561455889328384026705096013173825469773464105722689198047146574263705663366838720/298839732158850477765824602476778580028064205733214070073086531571837859351705342746223206218407306637658483098569582239416197836311325170250187389329637)
+
+(my-assert
+ (/ -1907320079310938642409293211056905401889419041722087613680756850005726714712/10387378553621846874105702088597026076825105075730032753153301604042569998683 113647247724474559442709588703965365251731833799417671287796250968092484717057/58756890421232187224353930678527831208703723187770044891160428018937233424397)
+ -37356065632762902117955690133395145368676268194116097031480521390942668514422835237280325034441435052929702455487858500299401976652159912902024146542888/393498994563785425899168694480259206994308562177080555315323154941891277193612821825931878224565302417504072329241812530787363937691786269618438039211977)
+
+(my-assert
+ (/ -54987418627898620923060954379316763081930842855917193391807940070173620336071/17370345837184638879794373707261631548922174314274224219546763452439685451597 107349939397731511365417710412808670916754334908520065561311453951414109180973/7800708635318451621630266369706695626474649690647985662113853436261704078874)
+ -428940831324519456770429889832838610542119304716244392653623661175655561457214418178921042544524225772650432309479656622489393939407340321261255371264054/1864705572939408818246392762570376592749103793151936455808919833872532407312841098160841844995663367019074328670998871082130543124576872890789577304863881)
+
+;; ==== S H O R T - F L O A T S ====
+
+;;  ---- Test von + ---
+
+(my-assert
+ (+ 0.52019s0 0.98203s0)
+ 1.50223s0)
+
+(my-assert
+ (+ 0.026268s0 0.6137s0)
+ 0.63997s0)
+
+(my-assert
+ (+ -0.338943s0 0.450523s0)
+ 0.11158s0)
+
+(my-assert
+ (+ -0.032799s0 0.995186s0)
+ 0.96239s0)
+
+(my-assert
+ (+ 0.249222s0 0.96463s0)
+ 1.21385s0)
+
+(my-assert
+ (+ -0.46177s0 -0.80114s0)
+ -1.26291s0)
+
+(my-assert
+ (+ -0.127754s0 -1.88775s9)
+ -1.88775s9)
+
+(my-assert
+ (+ -0.65572s0 -9.1112s9)
+ -9.1112s9)
+
+(my-assert
+ (+ -0.99359s0 -7.6134s9)
+ -7.6134s9)
+
+(my-assert
+ (+ 0.0169907s0 -5.9027s9)
+ -5.9027s9)
+
+(my-assert
+ (+ 0.77272s0 -9.5384s9)
+ -9.5384s9)
+
+(my-assert
+ (+ -0.50671s0 1.95366s9)
+ 1.95366s9)
+
+(my-assert
+ (+ -0.281487s0 -1.4109s-13)
+ -0.281487s0)
+
+(my-assert
+ (+ 0.86259s0 -1.8225s-13)
+ 0.86259s0)
+
+(my-assert
+ (+ 0.42874s0 6.326s-14)
+ 0.42874s0)
+
+(my-assert
+ (+ -0.53545s0 3.607s-14)
+ -0.53545s0)
+
+(my-assert
+ (+ 0.63671s0 -4.723s-14)
+ 0.63671s0)
+
+(my-assert
+ (+ 0.34449s0 -4.873s-14)
+ 0.34449s0)
+
+(my-assert
+ (+ -0.480698s0 3.03292s19)
+ 3.03292s19)
+
+(my-assert
+ (+ 0.85132s0 -6.325s19)
+ -6.325s19)
+
+(my-assert
+ (+ -0.54742s0 -2.83806s19)
+ -2.83806s19)
+
+(my-assert
+ (+ 0.45269s0 1.62964s19)
+ 1.62964s19)
+
+(my-assert
+ (+ -0.5122s0 -3.6148s18)
+ -3.6148s18)
+
+(my-assert
+ (+ 0.192093s0 5.3618s19)
+ 5.3618s19)
+
+(my-assert
+ (+ -0.43486s0 -8.918s-24)
+ -0.43486s0)
+
+(my-assert
+ (+ 0.289955s0 -5.911s-24)
+ 0.289955s0)
+
+(my-assert
+ (+ 0.274345s0 -1.6779s-23)
+ 0.274345s0)
+
+(my-assert
+ (+ 0.392723s0 -7.441s-24)
+ 0.392723s0)
+
+(my-assert
+ (+ -0.62215s0 3.521s-24)
+ -0.62215s0)
+
+(my-assert
+ (+ -0.5406s0 -7.718s-24)
+ -0.5406s0)
+
+(my-assert
+ (+ 6.5444s9 -0.060898s0)
+ 6.5444s9)
+
+(my-assert
+ (+ -8.541s9 -0.181755s0)
+ -8.541s9)
+
+(my-assert
+ (+ 3.02993s9 0.694534s0)
+ 3.02993s9)
+
+(my-assert
+ (+ 9.3926s9 -0.77226s0)
+ 9.3926s9)
+
+(my-assert
+ (+ -6.4481s9 0.252235s0)
+ -6.4481s9)
+
+(my-assert
+ (+ -1.1734s8 0.94104s0)
+ -1.1734s8)
+
+(my-assert
+ (+ -5.1049s9 1.28059s9)
+ -3.82435s9)
+
+(my-assert
+ (+ -7.39554s9 8.9347s9)
+ 1.53911s9)
+
+(my-assert
+ (+ 3.11457s9 1.71478s9)
+ 4.82935s9)
+
+(my-assert
+ (+ -8.0461s9 9.0508s9)
+ 1.00467s9)
+
+(my-assert
+ (+ -8.58006s8 -2.82289s7)
+ -8.86235s8)
+
+(my-assert
+ (+ 1.82954s9 -1.83914s9)
+ -9601000.0s0)
+
+(my-assert
+ (+ 7.6292s9 1.3988s-13)
+ 7.6292s9)
+
+(my-assert
+ (+ -1.43837s9 -2.482s-15)
+ -1.43837s9)
+
+(my-assert
+ (+ -6.4696s9 -1.3269s-13)
+ -6.4696s9)
+
+(my-assert
+ (+ 9.6744s9 -3.132s-14)
+ 9.6744s9)
+
+(my-assert
+ (+ -1.18927s9 -1.9405s-13)
+ -1.18927s9)
+
+(my-assert
+ (+ -3.81462s9 -8.602s-14)
+ -3.81462s9)
+
+(my-assert
+ (+ 5.5761s9 1.32286s19)
+ 1.32286s19)
+
+(my-assert
+ (+ 7.1631s9 -9.3184s19)
+ -9.3184s19)
+
+(my-assert
+ (+ 4.7921s9 -5.8008s19)
+ -5.8008s19)
+
+(my-assert
+ (+ 7.792s9 9.7695s19)
+ 9.7695s19)
+
+(my-assert
+ (+ 8.9575s9 7.0198s19)
+ 7.0198s19)
+
+(my-assert
+ (+ 4.4688s9 7.2066s19)
+ 7.2066s19)
+
+(my-assert
+ (+ 8.9222s9 -1.3243s-23)
+ 8.9222s9)
+
+(my-assert
+ (+ -9.7717s9 3.434s-24)
+ -9.7717s9)
+
+(my-assert
+ (+ -4.22478s9 -7.938s-24)
+ -4.22478s9)
+
+(my-assert
+ (+ 3.9261s8 7.916s-24)
+ 3.9261s8)
+
+(my-assert
+ (+ -3.239s9 -8.986s-24)
+ -3.239s9)
+
+(my-assert
+ (+ -4.6268s9 -1.0129s-23)
+ -4.6268s9)
+
+(my-assert
+ (+ 1.1171s-13 0.73372s0)
+ 0.73372s0)
+
+(my-assert
+ (+ -3.575s-14 0.94588s0)
+ 0.94588s0)
+
+(my-assert
+ (+ 3.176s-14 -0.160759s0)
+ -0.160759s0)
+
+(my-assert
+ (+ 5.055s-15 -0.0258102s0)
+ -0.0258102s0)
+
+(my-assert
+ (+ 6.371s-14 0.480484s0)
+ 0.480484s0)
+
+(my-assert
+ (+ -9.257s-14 0.698975s0)
+ 0.698975s0)
+
+(my-assert
+ (+ -1.0281s-13 -9.4453s9)
+ -9.4453s9)
+
+(my-assert
+ (+ 5.960s-14 -1.71395s9)
+ -1.71395s9)
+
+(my-assert
+ (+ 6.805s-14 -5.8515s9)
+ -5.8515s9)
+
+(my-assert
+ (+ 1.1645s-13 7.4758s9)
+ 7.4758s9)
+
+(my-assert
+ (+ -1.0064s-13 -1.86868s9)
+ -1.86868s9)
+
+(my-assert
+ (+ 8.912s-15 -8.4908s9)
+ -8.4908s9)
+
+(my-assert
+ (+ 4.036s-14 3.308s-15)
+ 4.3668s-14)
+
+(my-assert
+ (+ -2.503s-15 -7.642s-14)
+ -7.8923s-14)
+
+(my-assert
+ (+ 4.653s-14 -4.612s-14)
+ 4.10262s-16)
+
+(my-assert
+ (+ 4.700s-14 -8.456s-14)
+ -3.756s-14)
+
+(my-assert
+ (+ 8.181s-14 -4.658s-14)
+ 3.52305s-14)
+
+(my-assert
+ (+ -1.5467s-13 2.3608s-13)
+ 8.1409s-14)
+
+(my-assert
+ (+ -4.341s-14 -5.14576s19)
+ -5.14576s19)
+
+(my-assert
+ (+ -3.159s-14 -9.4925s19)
+ -9.4925s19)
+
+(my-assert
+ (+ -7.325s-14 3.49983s19)
+ 3.49983s19)
+
+(my-assert
+ (+ 4.134s-14 7.07955s19)
+ 7.07955s19)
+
+(my-assert
+ (+ 4.080s-15 -3.7832s19)
+ -3.7832s19)
+
+(my-assert
+ (+ 1.1577s-13 3.30522s19)
+ 3.30522s19)
+
+(my-assert
+ (+ -6.838s-14 2.739s-24)
+ -6.838s-14)
+
+(my-assert
+ (+ 5.050s-14 6.768s-24)
+ 5.05s-14)
+
+(my-assert
+ (+ -1.9477s-13 -6.657s-24)
+ -1.9477s-13)
+
+(my-assert
+ (+ -6.348s-14 -5.222s-24)
+ -6.348s-14)
+
+(my-assert
+ (+ -8.770s-14 -1.58234s-22)
+ -8.77s-14)
+
+(my-assert
+ (+ 7.906s-14 4.9202s-22)
+ 7.906s-14)
+
+(my-assert
+ (+ 3.7985s19 0.8199s0)
+ 3.7985s19)
+
+(my-assert
+ (+ 9.891s19 0.79037s0)
+ 9.891s19)
+
+(my-assert
+ (+ -1.49583s19 -0.360153s0)
+ -1.49583s19)
+
+(my-assert
+ (+ -7.36023s19 0.8185s0)
+ -7.36023s19)
+
+(my-assert
+ (+ 3.62075s19 -0.364594s0)
+ 3.62075s19)
+
+(my-assert
+ (+ 8.0477s19 -0.531815s0)
+ 8.0477s19)
+
+(my-assert
+ (+ 3.62182s19 -7.2661s9)
+ 3.62182s19)
+
+(my-assert
+ (+ -3.23868s19 -9.6806s9)
+ -3.23868s19)
+
+(my-assert
+ (+ -6.08735s19 2.89138s9)
+ -6.08735s19)
+
+(my-assert
+ (+ 5.00175s19 -6.3548s9)
+ 5.00175s19)
+
+(my-assert
+ (+ 2.82944s19 4.7262s9)
+ 2.82944s19)
+
+(my-assert
+ (+ 4.6168s19 -6.8772s9)
+ 4.6168s19)
+
+(my-assert
+ (+ 1.15555s19 -3.786s-14)
+ 1.15555s19)
+
+(my-assert
+ (+ 8.1897s19 -8.971s-14)
+ 8.1897s19)
+
+(my-assert
+ (+ 4.32734s19 -4.794s-14)
+ 4.32734s19)
+
+(my-assert
+ (+ -9.4559s19 -1.9717s-13)
+ -9.4559s19)
+
+(my-assert
+ (+ -4.20726s19 -8.657s-14)
+ -4.20726s19)
+
+(my-assert
+ (+ 9.7697s19 -3.376s-14)
+ 9.7697s19)
+
+(my-assert
+ (+ 6.09264s19 -7.5608s18)
+ 5.33654s19)
+
+(my-assert
+ (+ -5.2828s19 6.8924s18)
+ -4.59356s19)
+
+(my-assert
+ (+ 5.73685s19 -1.4978s19)
+ 4.23907s19)
+
+(my-assert
+ (+ -1.30897s19 4.8593s19)
+ 3.55036s19)
+
+(my-assert
+ (+ -8.5586s19 -9.712s19)
+ -1.82707s20)
+
+(my-assert
+ (+ 3.8772s19 -8.6355s19)
+ -4.75833s19)
+
+(my-assert
+ (+ -1.03845s19 6.88s-24)
+ -1.03845s19)
+
+(my-assert
+ (+ 8.4716s19 9.614s-24)
+ 8.4716s19)
+
+(my-assert
+ (+ -4.3023s19 -7.649s-24)
+ -4.3023s19)
+
+(my-assert
+ (+ 5.9593s19 -2.552s-24)
+ 5.9593s19)
+
+(my-assert
+ (+ 9.8934s19 1.3093s-23)
+ 9.8934s19)
+
+(my-assert
+ (+ -5.70567s19 7.918s-24)
+ -5.70567s19)
+
+(my-assert
+ (+ -2.893s-24 -0.93898s0)
+ -0.93898s0)
+
+(my-assert
+ (+ 8.795s-24 -0.030014s0)
+ -0.030014s0)
+
+(my-assert
+ (+ -9.366s-24 0.200493s0)
+ 0.200493s0)
+
+(my-assert
+ (+ -9.3102s-22 -0.28704s0)
+ -0.28704s0)
+
+(my-assert
+ (+ 7.142s-24 -0.45701s0)
+ -0.45701s0)
+
+(my-assert
+ (+ 9.420s-24 0.957794s0)
+ 0.957794s0)
+
+(my-assert
+ (+ 2.975s-24 -6.84104s9)
+ -6.84104s9)
+
+(my-assert
+ (+ 2.26822s-22 -8.9898s9)
+ -8.9898s9)
+
+(my-assert
+ (+ -1.531s-23 8.1961s9)
+ 8.1961s9)
+
+(my-assert
+ (+ 1.7221s-23 -1.53725s9)
+ -1.53725s9)
+
+(my-assert
+ (+ -9.488s-24 -4.77676s8)
+ -4.77676s8)
+
+(my-assert
+ (+ -1.5077s-23 2.8251s9)
+ 2.8251s9)
+
+(my-assert
+ (+ 3.410s-24 -4.701s-14)
+ -4.701s-14)
+
+(my-assert
+ (+ -3.361s-24 -4.947s-15)
+ -4.947s-15)
+
+(my-assert
+ (+ 9.026s-24 7.353s-14)
+ 7.353s-14)
+
+(my-assert
+ (+ -6.385s-24 7.789s-14)
+ 7.789s-14)
+
+(my-assert
+ (+ 1.8237s-23 8.517s-14)
+ 8.517s-14)
+
+(my-assert
+ (+ 3.4439s-22 -4.345s-14)
+ -4.345s-14)
+
+(my-assert
+ (+ -6.817s-24 -9.8611s19)
+ -9.8611s19)
+
+(my-assert
+ (+ 6.213s-24 -2.7257s19)
+ -2.7257s19)
+
+(my-assert
+ (+ -1.9353s-23 -2.71446s19)
+ -2.71446s19)
+
+(my-assert
+ (+ -3.653s-24 -7.7565s19)
+ -7.7565s19)
+
+(my-assert
+ (+ 1.2298s-23 -1.56532s19)
+ -1.56532s19)
+
+(my-assert
+ (+ 2.905s-24 2.334s19)
+ 2.334s19)
+
+(my-assert
+ (+ 3.182s-24 -5.727s-24)
+ -2.545s-24)
+
+(my-assert
+ (+ -1.0745s-23 3.640s-24)
+ -7.1049s-24)
+
+(my-assert
+ (+ -9.7145s-22 8.77s-24)
+ -9.6267s-22)
+
+(my-assert
+ (+ 1.3734s-23 3.225s-24)
+ 1.69588s-23)
+
+(my-assert
+ (+ 2.745s-24 1.0505s-23)
+ 1.325s-23)
+
+(my-assert
+ (+ 2.780s-24 2.747s-24)
+ 5.527s-24)
+
+;;  ---- Test von - ---
+
+(my-assert
+ (- 0.57362s0 -0.0545654s0)
+ 0.62819s0)
+
+(my-assert
+ (- -0.121063s0 -0.157204s0)
+ 0.0361404s0)
+
+(my-assert
+ (- 0.75334s0 -0.186554s0)
+ 0.939896s0)
+
+(my-assert
+ (- 0.879036s0 -0.54558s0)
+ 1.42462s0)
+
+(my-assert
+ (- -0.245338s0 -0.003891s0)
+ -0.241447s0)
+
+(my-assert
+ (- -0.89576s0 0.61608s0)
+ -1.51184s0)
+
+(my-assert
+ (- -0.59227s0 6.61s9)
+ -6.61s9)
+
+(my-assert
+ (- 0.381363s0 1.88003s9)
+ -1.88003s9)
+
+(my-assert
+ (- 0.858986s0 1.31028s9)
+ -1.31028s9)
+
+(my-assert
+ (- 0.56377s0 -3.26553s9)
+ 3.26553s9)
+
+(my-assert
+ (- 0.80342s0 -1.46217s9)
+ 1.46217s9)
+
+(my-assert
+ (- 0.093941s0 8.30203s9)
+ -8.30203s9)
+
+(my-assert
+ (- 0.266243s0 4.980s-14)
+ 0.266243s0)
+
+(my-assert
+ (- -0.169983s0 8.01s-15)
+ -0.169983s0)
+
+(my-assert
+ (- 0.77925s0 -2.777s-15)
+ 0.77925s0)
+
+(my-assert
+ (- -0.379807s0 3.990s-15)
+ -0.379807s0)
+
+(my-assert
+ (- -0.392517s0 1.1080s-13)
+ -0.392517s0)
+
+(my-assert
+ (- -0.26274s0 -7.575s-14)
+ -0.26274s0)
+
+(my-assert
+ (- 0.72031s0 4.1223s19)
+ -4.1223s19)
+
+(my-assert
+ (- 0.589775s0 -2.9271s19)
+ 2.9271s19)
+
+(my-assert
+ (- 0.205704s0 -8.4906s19)
+ 8.4906s19)
+
+(my-assert
+ (- 0.362556s0 6.8624s19)
+ -6.8624s19)
+
+(my-assert
+ (- -0.604004s0 -1.42777s19)
+ 1.42777s19)
+
+(my-assert
+ (- -0.53121s0 2.3539s19)
+ -2.3539s19)
+
+(my-assert
+ (- -0.684906s0 8.179s-24)
+ -0.684906s0)
+
+(my-assert
+ (- 0.43084s0 -5.849s-24)
+ 0.43084s0)
+
+(my-assert
+ (- 0.153358s0 3.633s-24)
+ 0.153358s0)
+
+(my-assert
+ (- 0.93678s0 9.13s-24)
+ 0.93678s0)
+
+(my-assert
+ (- 0.78924s0 -7.766s-24)
+ 0.78924s0)
+
+(my-assert
+ (- 0.33867s0 3.510s-24)
+ 0.33867s0)
+
+(my-assert
+ (- 8.0573s9 -0.86206s0)
+ 8.0573s9)
+
+(my-assert
+ (- 9.3318s9 -0.93273s0)
+ 9.3318s9)
+
+(my-assert
+ (- -4.26515s9 0.464104s0)
+ -4.26515s9)
+
+(my-assert
+ (- -3.35557s9 -0.93267s0)
+ -3.35557s9)
+
+(my-assert
+ (- -6.81614s9 -0.64528s0)
+ -6.81614s9)
+
+(my-assert
+ (- -5.099s9 0.67011s0)
+ -5.099s9)
+
+(my-assert
+ (- -4.2206s9 4.9182s9)
+ -9.1389s9)
+
+(my-assert
+ (- -5.18173s9 2.267s9)
+ -7.4487s9)
+
+(my-assert
+ (- 5.53314s9 6.08856s9)
+ -5.5542s8)
+
+(my-assert
+ (- 9.88s9 -3.3333s9)
+ 1.32132s10)
+
+(my-assert
+ (- 4.87404s9 7.17075s9)
+ -2.2967s9)
+
+(my-assert
+ (- -2.9911s9 -1.37177s8)
+ -2.85393s9)
+
+(my-assert
+ (- -8.1379s9 3.023s-15)
+ -8.1379s9)
+
+(my-assert
+ (- 4.8877s9 -1.1596s-13)
+ 4.8877s9)
+
+(my-assert
+ (- -1.89071s9 -4.330s-14)
+ -1.89071s9)
+
+(my-assert
+ (- 8.7563s9 -4.676s-14)
+ 8.7563s9)
+
+(my-assert
+ (- -4.4533s9 2.743s-15)
+ -4.4533s9)
+
+(my-assert
+ (- 4.0261s9 2.1618s-13)
+ 4.0261s9)
+
+(my-assert
+ (- 9.1731s9 -8.0954s19)
+ 8.0954s19)
+
+(my-assert
+ (- 6.984s9 1.09772s19)
+ -1.09772s19)
+
+(my-assert
+ (- -9.8832s9 -8.0905s19)
+ 8.0905s19)
+
+(my-assert
+ (- -8.5769s9 -6.24565s19)
+ 6.24565s19)
+
+(my-assert
+ (- 8.5486s9 2.77396s19)
+ -2.77396s19)
+
+(my-assert
+ (- -9.4026s9 -3.5611s19)
+ 3.5611s19)
+
+(my-assert
+ (- 5.1003s9 -1.9535s-23)
+ 5.1003s9)
+
+(my-assert
+ (- 1.88706s9 -1.6304s-23)
+ 1.88706s9)
+
+(my-assert
+ (- -9.4567s9 -1.9848s-23)
+ -9.4567s9)
+
+(my-assert
+ (- 9.6498s9 -1.57531s-21)
+ 9.6498s9)
+
+(my-assert
+ (- -5.733s9 1.23215s-21)
+ -5.733s9)
+
+(my-assert
+ (- -4.0567s9 -5.229s-24)
+ -4.0567s9)
+
+(my-assert
+ (- -4.379s-14 -0.0201035s0)
+ 0.0201035s0)
+
+(my-assert
+ (- -4.036s-14 0.82034s0)
+ -0.82034s0)
+
+(my-assert
+ (- 1.6661s-13 -0.70753s0)
+ 0.70753s0)
+
+(my-assert
+ (- 3.360s-14 0.60217s0)
+ -0.60217s0)
+
+(my-assert
+ (- 4.977s-14 -0.95905s0)
+ 0.95905s0)
+
+(my-assert
+ (- -2.967s-14 0.55465s0)
+ -0.55465s0)
+
+(my-assert
+ (- 4.394s-14 2.01859s9)
+ -2.01859s9)
+
+(my-assert
+ (- 3.683s-14 4.77836s9)
+ -4.77836s9)
+
+(my-assert
+ (- -6.887s-14 -9.26s9)
+ 9.26s9)
+
+(my-assert
+ (- -2.643s-15 -5.6812s9)
+ 5.6812s9)
+
+(my-assert
+ (- -8.498s-14 -9.3728s9)
+ 9.3728s9)
+
+(my-assert
+ (- 9.033s-14 2.18002s9)
+ -2.18002s9)
+
+(my-assert
+ (- 3.113s-14 -9.207s-14)
+ 1.232s-13)
+
+(my-assert
+ (- -3.239s-15 -1.2957s-13)
+ 1.26331s-13)
+
+(my-assert
+ (- 3.098s-15 -6.117s-15)
+ 9.2151s-15)
+
+(my-assert
+ (- 1.7706s-13 4.829s-14)
+ 1.2877s-13)
+
+(my-assert
+ (- 2.793s-15 8.620s-14)
+ -8.3407s-14)
+
+(my-assert
+ (- -5.019s-14 4.125s-14)
+ -9.144s-14)
+
+(my-assert
+ (- -9.495s-14 -6.06994s18)
+ 6.06994s18)
+
+(my-assert
+ (- 9.385s-14 -7.9288s19)
+ 7.9288s19)
+
+(my-assert
+ (- -3.099s-14 -6.64095s19)
+ 6.64095s19)
+
+(my-assert
+ (- 3.397s-15 2.92222s19)
+ -2.92222s19)
+
+(my-assert
+ (- -8.463s-14 -4.9708s19)
+ 4.9708s19)
+
+(my-assert
+ (- -2.735s-15 -9.2672s19)
+ 9.2672s19)
+
+(my-assert
+ (- -2.974s-14 -7.975s-24)
+ -2.974s-14)
+
+(my-assert
+ (- -2.1853s-13 2.736s-24)
+ -2.1853s-13)
+
+(my-assert
+ (- 3.243s-15 -6.867s-24)
+ 3.243s-15)
+
+(my-assert
+ (- 4.792s-14 -2.659s-24)
+ 4.792s-14)
+
+(my-assert
+ (- 4.672s-14 7.831s-24)
+ 4.672s-14)
+
+(my-assert
+ (- 2.0285s-13 2.741s-24)
+ 2.0285s-13)
+
+(my-assert
+ (- -9.1884s19 -0.22573s0)
+ -9.1884s19)
+
+(my-assert
+ (- 3.32245s19 0.7651s0)
+ 3.32245s19)
+
+(my-assert
+ (- 4.13513s17 0.85135s0)
+ 4.13513s17)
+
+(my-assert
+ (- 2.2249s19 0.45778s0)
+ 2.2249s19)
+
+(my-assert
+ (- 4.9103s19 0.84862s0)
+ 4.9103s19)
+
+(my-assert
+ (- 4.27386s19 -0.06662s0)
+ 4.27386s19)
+
+(my-assert
+ (- -6.725s19 5.11246s8)
+ -6.725s19)
+
+(my-assert
+ (- -2.40906s19 7.2238s9)
+ -2.40906s19)
+
+(my-assert
+ (- 6.1667s19 -7.4303s9)
+ 6.1667s19)
+
+(my-assert
+ (- -7.746s19 -4.29687s8)
+ -7.746s19)
+
+(my-assert
+ (- -1.81419s19 -5.68164s9)
+ -1.81419s19)
+
+(my-assert
+ (- 7.0665s19 -8.9546s8)
+ 7.0665s19)
+
+(my-assert
+ (- 2.47788s19 -2.2961s-13)
+ 2.47788s19)
+
+(my-assert
+ (- -7.4962s19 -3.378s-14)
+ -7.4962s19)
+
+(my-assert
+ (- 1.72135s19 7.168s-14)
+ 1.72135s19)
+
+(my-assert
+ (- 8.3699s19 4.887s-14)
+ 8.3699s19)
+
+(my-assert
+ (- -4.5701s19 -8.009s-14)
+ -4.5701s19)
+
+(my-assert
+ (- -2.845s18 1.1087s-13)
+ -2.845s18)
+
+(my-assert
+ (- 6.4084s19 -4.569s19)
+ 1.09774s20)
+
+(my-assert
+ (- 1.33888s19 -6.8446s19)
+ 8.1835s19)
+
+(my-assert
+ (- -4.0631s19 1.50864s19)
+ -5.57174s19)
+
+(my-assert
+ (- -5.61754s18 2.6413s18)
+ -8.2588s18)
+
+(my-assert
+ (- -9.0749s19 6.21626s19)
+ -1.5291s20)
+
+(my-assert
+ (- -8.5269s19 6.2002s19)
+ -1.47271s20)
+
+(my-assert
+ (- 3.15773s19 5.433s-24)
+ 3.15773s19)
+
+(my-assert
+ (- 5.1563s19 -1.6366s-23)
+ 5.1563s19)
+
+(my-assert
+ (- -5.8449s19 3.282s-24)
+ -5.8449s19)
+
+(my-assert
+ (- 4.70947s19 1.5640s-23)
+ 4.70947s19)
+
+(my-assert
+ (- -4.32334s19 -1.0593s-23)
+ -4.32334s19)
+
+(my-assert
+ (- 7.9621s19 5.610s-24)
+ 7.9621s19)
+
+(my-assert
+ (- 8.164s-24 0.133362s0)
+ -0.133362s0)
+
+(my-assert
+ (- -1.57089s-21 0.3154s0)
+ -0.3154s0)
+
+(my-assert
+ (- -3.736s-24 -0.66536s0)
+ 0.66536s0)
+
+(my-assert
+ (- -6.923s-24 -0.431366s0)
+ 0.431366s0)
+
+(my-assert
+ (- 3.345s-24 0.77436s0)
+ -0.77436s0)
+
+(my-assert
+ (- -1.4322s-23 0.799644s0)
+ -0.799644s0)
+
+(my-assert
+ (- -1.3249s-23 -4.22035s9)
+ 4.22035s9)
+
+(my-assert
+ (- 2.707s-24 -6.5029s9)
+ 6.5029s9)
+
+(my-assert
+ (- -3.490s-24 -2.5205s9)
+ 2.5205s9)
+
+(my-assert
+ (- -1.0086s-23 1.35048s9)
+ -1.35048s9)
+
+(my-assert
+ (- 1.4406s-23 1.55487s9)
+ -1.55487s9)
+
+(my-assert
+ (- 3.370s-24 -4.3973s9)
+ 4.3973s9)
+
+(my-assert
+ (- -1.31249s-21 3.448s-14)
+ -3.448s-14)
+
+(my-assert
+ (- -7.706s-24 -1.9488s-13)
+ 1.9488s-13)
+
+(my-assert
+ (- -9.8403s-22 2.2940s-13)
+ -2.294s-13)
+
+(my-assert
+ (- -3.355s-24 1.0187s-13)
+ -1.0187s-13)
+
+(my-assert
+ (- 9.5635s-22 -8.663s-14)
+ 8.663s-14)
+
+(my-assert
+ (- -5.713s-24 -3.169s-14)
+ 3.169s-14)
+
+(my-assert
+ (- 2.645s-24 -5.2307s19)
+ 5.2307s19)
+
+(my-assert
+ (- -9.960s-24 -9.2854s19)
+ 9.2854s19)
+
+(my-assert
+ (- 8.036s-24 -7.11434s19)
+ 7.11434s19)
+
+(my-assert
+ (- 3.475s-24 -4.845s19)
+ 4.845s19)
+
+(my-assert
+ (- -3.062s-24 4.91714s19)
+ -4.91714s19)
+
+(my-assert
+ (- -2.541s-24 -2.91276s19)
+ 2.91276s19)
+
+(my-assert
+ (- 1.4371s-23 1.1606s-23)
+ 2.76508s-24)
+
+(my-assert
+ (- -1.8769s-23 2.965s-24)
+ -2.1734s-23)
+
+(my-assert
+ (- 3.713s-24 -1.7581s-23)
+ 2.1294s-23)
+
+(my-assert
+ (- -5.954s-24 -2.764s-24)
+ -3.19s-24)
+
+(my-assert
+ (- 3.21502s-22 8.56s-24)
+ 3.12942s-22)
+
+(my-assert
+ (- 9.969s-24 5.912s-24)
+ 4.057s-24)
+
+;;  ---- Test von * ---
+
+(my-assert
+ (* -0.56581s0 -0.117477s0)
+ 0.06647s0)
+
+(my-assert
+ (* 0.73841s0 0.08886s0)
+ 0.065615s0)
+
+(my-assert
+ (* -0.75174s0 -0.173615s0)
+ 0.130512s0)
+
+(my-assert
+ (* 0.557236s0 -0.105034s0)
+ -0.0585284s0)
+
+(my-assert
+ (* -0.62105s0 0.828835s0)
+ -0.51475s0)
+
+(my-assert
+ (* -0.54287s0 -0.92243s0)
+ 0.50076s0)
+
+(my-assert
+ (* -0.2173s0 5.5084s9)
+ -1.19698s9)
+
+(my-assert
+ (* 0.467354s0 -7.9517s9)
+ -3.71625s9)
+
+(my-assert
+ (* -0.95485s0 5.6451s9)
+ -5.3902s9)
+
+(my-assert
+ (* 0.0472946s0 -6.774s9)
+ -3.20373s8)
+
+(my-assert
+ (* 0.196037s0 7.3548s8)
+ 1.44181s8)
+
+(my-assert
+ (* -0.25535s0 4.91907s9)
+ -1.25608s9)
+
+(my-assert
+ (* 0.047058s0 6.612s-14)
+ 3.11147s-15)
+
+(my-assert
+ (* -0.35054s0 3.764s-14)
+ -1.31943s-14)
+
+(my-assert
+ (* 0.372635s0 1.0613s-13)
+ 3.9548s-14)
+
+(my-assert
+ (* 0.627266s0 -9.519s-14)
+ -5.971s-14)
+
+(my-assert
+ (* -0.0293884s0 1.1626s-13)
+ -3.41667s-15)
+
+(my-assert
+ (* -0.88304s0 -1.1160s-13)
+ 9.8547s-14)
+
+(my-assert
+ (* 0.318016s0 -6.86827s19)
+ -2.18422s19)
+
+(my-assert
+ (* 0.605064s0 3.4281s19)
+ 2.07422s19)
+
+(my-assert
+ (* -0.65415s0 -8.185s19)
+ 5.3542s19)
+
+(my-assert
+ (* 0.87548s0 6.72325s19)
+ 5.8861s19)
+
+(my-assert
+ (* 0.45806s0 -9.503s19)
+ -4.35295s19)
+
+(my-assert
+ (* -0.995384s0 1.62797s19)
+ -1.62045s19)
+
+(my-assert
+ (* 0.26301s0 -1.3169s-23)
+ -3.46357s-24)
+
+(my-assert
+ (* 0.82762s0 -3.411s-24)
+ -2.82304s-24)
+
+(my-assert
+ (* -0.042412s0 -3.339s-24)
+ 1.41613s-25)
+
+(my-assert
+ (* 0.858284s0 -7.610s-24)
+ -6.53157s-24)
+
+(my-assert
+ (* 0.75574s0 1.0518s-23)
+ 7.9488s-24)
+
+(my-assert
+ (* 0.977s0 -5.944s-24)
+ -5.8073s-24)
+
+(my-assert
+ (* 1.1316s9 0.87906s0)
+ 9.9474s8)
+
+(my-assert
+ (* 9.7596s9 0.58181s0)
+ 5.67824s9)
+
+(my-assert
+ (* 5.5896s9 -0.91708s0)
+ -5.12616s9)
+
+(my-assert
+ (* -7.677s9 -0.67695s0)
+ 5.19694s9)
+
+(my-assert
+ (* -4.73655s9 0.65572s0)
+ -3.10588s9)
+
+(my-assert
+ (* -3.2158s9 -0.30076s0)
+ 9.6717s8)
+
+(my-assert
+ (* 5.94916s9 -1.02867s9)
+ -6.1197s18)
+
+(my-assert
+ (* -3.19098s9 8.125s9)
+ -2.59267s19)
+
+(my-assert
+ (* -6.57215s9 9.4253s9)
+ -6.1944s19)
+
+(my-assert
+ (* -5.2792s9 3.93547s9)
+ -2.0776s19)
+
+(my-assert
+ (* 2.502s9 4.1275s9)
+ 1.0327s19)
+
+(my-assert
+ (* -8.9462s9 -4.72174s9)
+ 4.22415s19)
+
+(my-assert
+ (* -8.9588s9 -1.4190s-14)
+ 1.27126s-4)
+
+(my-assert
+ (* -3.56218s9 -9.982s-14)
+ 3.5558s-4)
+
+(my-assert
+ (* -3.4449s9 4.582s-15)
+ -1.57845s-5)
+
+(my-assert
+ (* -3.7047s9 1.2985s-14)
+ -4.8105s-5)
+
+(my-assert
+ (* -8.9172s8 -7.294s-14)
+ 6.5043s-5)
+
+(my-assert
+ (* 1.64864s9 1.8344s-13)
+ 3.02427s-4)
+
+(my-assert
+ (* -9.935s8 -7.9116s19)
+ 7.8602s28)
+
+(my-assert
+ (* -7.0441s9 -6.3448s19)
+ 4.4693s29)
+
+(my-assert
+ (* 7.72866s9 1.44264s19)
+ 1.11497s29)
+
+(my-assert
+ (* 3.7816s9 -3.16285s19)
+ -1.19606s29)
+
+(my-assert
+ (* -1.06926s9 6.67816s19)
+ -7.1407s28)
+
+(my-assert
+ (* 4.04482s9 -3.52235s19)
+ -1.42473s29)
+
+(my-assert
+ (* -8.77s8 -3.499s-24)
+ 3.06864s-15)
+
+(my-assert
+ (* -9.5508s9 1.0006s-23)
+ -9.5566s-14)
+
+(my-assert
+ (* -2.98736s9 -7.070s-24)
+ 2.11207s-14)
+
+(my-assert
+ (* 9.9779s9 1.2683s-23)
+ 1.26548s-13)
+
+(my-assert
+ (* 7.4813s9 -1.3730s-23)
+ -1.02719s-13)
+
+(my-assert
+ (* 8.5804s9 6.999s-24)
+ 6.0054s-14)
+
+(my-assert
+ (* 4.637s-14 0.895805s0)
+ 4.15384s-14)
+
+(my-assert
+ (* 1.0125s-13 -0.322685s0)
+ -3.26718s-14)
+
+(my-assert
+ (* 2.310s-16 0.0601425s0)
+ 1.38928s-17)
+
+(my-assert
+ (* 1.0579s-13 -0.27089s0)
+ -2.86576s-14)
+
+(my-assert
+ (* 9.540s-14 -0.21251s0)
+ -2.02735s-14)
+
+(my-assert
+ (* -4.463s-14 -0.96336s0)
+ 4.2995s-14)
+
+(my-assert
+ (* 3.270s-14 -5.9141s9)
+ -1.93391s-4)
+
+(my-assert
+ (* -6.515s-14 1.01791s9)
+ -6.6318s-5)
+
+(my-assert
+ (* 3.695s-14 8.7417s9)
+ 3.23005s-4)
+
+(my-assert
+ (* -1.0900s-13 -6.75794s9)
+ 7.3662s-4)
+
+(my-assert
+ (* 4.551s-14 -7.1112s9)
+ -3.2363s-4)
+
+(my-assert
+ (* 5.456s-15 -5.44014s9)
+ -2.96813s-5)
+
+(my-assert
+ (* -3.377s-14 3.358s-15)
+ -1.13399s-28)
+
+(my-assert
+ (* 3.862s-14 7.278s-14)
+ 2.81079s-27)
+
+(my-assert
+ (* 9.449s-14 3.170s-14)
+ 2.99533s-27)
+
+(my-assert
+ (* 7.051s-14 -4.234s-14)
+ -2.98537s-27)
+
+(my-assert
+ (* -8.955s-14 9.895s-14)
+ -8.861s-27)
+
+(my-assert
+ (* -1.6752s-13 -7.341s-14)
+ 1.22977s-26)
+
+(my-assert
+ (* 9.420s-14 4.50844s19)
+ 4246900.0s0)
+
+(my-assert
+ (* 2.0183s-13 9.598s19)
+ 1.93715s7)
+
+(my-assert
+ (* -7.441s-14 -5.7324s19)
+ 4265500.0s0)
+
+(my-assert
+ (* 7.241s-14 -5.79135s19)
+ -4193500.0s0)
+
+(my-assert
+ (* 7.987s-14 8.1113s19)
+ 6478500.0s0)
+
+(my-assert
+ (* -1.1603s-13 7.4468s19)
+ -8640500.0s0)
+
+(my-assert
+ (* -4.432s-14 -6.851s-24)
+ 3.03637s-37)
+
+(my-assert
+ (* -5.064s-14 -8.119s-24)
+ 4.1115s-37)
+
+(my-assert
+ (* 3.553s-15 -6.404s-24)
+ -2.27533s-38)
+
+(my-assert
+ (* 8.699s-14 -3.558s-24)
+ -3.0951s-37)
+
+(my-assert
+ (* 9.820s-14 -5.771s-24)
+ -5.6671s-37)
+
+(my-assert
+ (* -3.477s-14 7.723s-24)
+ -2.6853s-37)
+
+(my-assert
+ (* 7.9082s19 0.71604s0)
+ 5.6626s19)
+
+(my-assert
+ (* -6.83905s19 -0.36905s0)
+ 2.52396s19)
+
+(my-assert
+ (* -7.7697s19 -0.34073s0)
+ 2.64736s19)
+
+(my-assert
+ (* -2.10557s19 -0.58961s0)
+ 1.24146s19)
+
+(my-assert
+ (* 9.0963s19 -0.37693s0)
+ -3.42865s19)
+
+(my-assert
+ (* -4.24076s19 0.91147s0)
+ -3.8653s19)
+
+(my-assert
+ (* -3.5865s19 -6.4046s9)
+ 2.297s29)
+
+(my-assert
+ (* 7.19225s18 -7.7232s9)
+ -5.5547s28)
+
+(my-assert
+ (* 1.98907s19 -9.9239s9)
+ -1.97393s29)
+
+(my-assert
+ (* -4.27195s19 7.0734s9)
+ -3.02173s29)
+
+(my-assert
+ (* -8.3115s19 5.2947s9)
+ -4.40073s29)
+
+(my-assert
+ (* 9.4386s19 8.6548s8)
+ 8.169s28)
+
+(my-assert
+ (* 6.21677s19 -3.135s-14)
+ -1948960.0s0)
+
+(my-assert
+ (* -6.30774s19 1.5884s-13)
+ -1.00192s7)
+
+(my-assert
+ (* 7.6073s19 3.922s-14)
+ 2983550.0s0)
+
+(my-assert
+ (* -1.44485s19 -3.355s-14)
+ 484748.0s0)
+
+(my-assert
+ (* 3.39653s19 -7.679s-14)
+ -2608200.0s0)
+
+(my-assert
+ (* -6.0072s19 1.7825s-13)
+ -1.07078s7)
+
+(my-assert
+ (* 1.06812s16 -1.19583s19)
+ -1.2773s35)
+
+(my-assert
+ (* 1.1438s19 2.616s-24)
+ 2.99218s-5)
+
+(my-assert
+ (* -5.79304s18 -3.095s-24)
+ 1.79296s-5)
+
+(my-assert
+ (* -7.6387s19 8.607s-24)
+ -6.5746s-4)
+
+(my-assert
+ (* 4.03933s19 3.058s-24)
+ 1.23523s-4)
+
+(my-assert
+ (* -2.06994s19 -1.1381s-23)
+ 2.3558s-4)
+
+(my-assert
+ (* 3.7857s18 -3.590s-24)
+ -1.35906s-5)
+
+(my-assert
+ (* 5.656s-24 -0.096458s0)
+ -5.4557s-25)
+
+(my-assert
+ (* -5.799s-24 -0.148445s0)
+ 8.6083s-25)
+
+(my-assert
+ (* -9.041s-24 0.86431s0)
+ -7.8143s-24)
+
+(my-assert
+ (* -2.645s-24 -0.911865s0)
+ 2.41187s-24)
+
+(my-assert
+ (* -9.758s-24 -0.397186s0)
+ 3.87574s-24)
+
+(my-assert
+ (* -5.345s-24 -0.27215s0)
+ 1.45463s-24)
+
+(my-assert
+ (* -3.713s-24 9.11335s8)
+ -3.38382s-15)
+
+(my-assert
+ (* -3.010s-24 -9.5278s9)
+ 2.86784s-14)
+
+(my-assert
+ (* -1.6904s-23 -8.37655s9)
+ 1.41599s-13)
+
+(my-assert
+ (* -5.074s-24 -9.2804s9)
+ 4.7089s-14)
+
+(my-assert
+ (* -6.942s-22 -8.7038s9)
+ 6.04217s-12)
+
+(my-assert
+ (* -7.643s-24 -3.1665s9)
+ 2.42018s-14)
+
+(my-assert
+ (* -2.659s-24 -9.238s-14)
+ 2.4564s-37)
+
+(my-assert
+ (* -1.7036s-23 3.138s-14)
+ -5.34586s-37)
+
+(my-assert
+ (* 7.684s-24 8.639s-14)
+ 6.6383s-37)
+
+(my-assert
+ (* -3.424s-24 -6.046s-14)
+ 2.07014s-37)
+
+(my-assert
+ (* 9.3102s-22 -1.1344s-13)
+ -1.05614s-34)
+
+(my-assert
+ (* 8.070s-24 3.573s-14)
+ 2.8834s-37)
+
+(my-assert
+ (* 3.557s-24 7.9957s19)
+ 2.84407s-4)
+
+(my-assert
+ (* 7.281s-24 -3.45443s19)
+ -2.5152s-4)
+
+(my-assert
+ (* -1.6093s-23 3.22463s19)
+ -5.1894s-4)
+
+(my-assert
+ (* -1.8628s-23 4.95593s19)
+ -9.2319s-4)
+
+(my-assert
+ (* 3.463s-24 -4.44685s19)
+ -1.53994s-4)
+
+(my-assert
+ (* -8.081s-24 -1.54701s19)
+ 1.25013s-4)
+
+;;  ---- Test von FLOOR ---
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.403114s0 0.64293s0))
+ (-1 0.239813s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.538574s0 0.74157s0))
+ (-1 0.202993s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.59919s0 -0.433258s0))
+ (-2 -0.26733s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.62148s0 -0.185875s0))
+ (3 -0.063861s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.298317s0 -0.79534s0))
+ (-1 -0.49703s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.84822s0 9.519s9))
+ (0 0.84822s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.185059s0 -4.4452s9))
+ (-1 -4.4452s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.442635s0 -4.64486s9))
+ (0 -0.442635s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.78401s0 -8.4401s9))
+ (-1 -8.4401s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.300156s0 -4.4083s9))
+ (-1 -4.4083s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.67763s0 2.54755s9))
+ (0 0.67763s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.189995s0 -1.9236s-13))
+ (987708260352 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.442696s0 -4.184s-15))
+ (-105806519336960 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.175987s0 -5.055s-15))
+ (-34814468030464 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.30565s0 -4.296s-14))
+ (-7114747543552 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.256264s0 4.541s-14))
+ (5643318591488 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.51656s0 4.057s-14))
+ (-12732698984448 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.221672s0 -5.9783s19))
+ (0 -0.221672s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.441925s0 -8.1227s19))
+ (0 -0.441925s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.73287s0 -3.99683s19))
+ (-1 -3.99683s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.376198s0 9.1146s19))
+ (-1 9.1146s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.61628s0 -5.83824s19))
+ (-1 -5.83824s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.072037s0 4.40705s19))
+ (-1 4.40705s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.378708s0 3.258s-24))
+ (116238699015966918967296 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.98937s0 -7.698s-24))
+ (-128524230569057480343552 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.94075s0 -1.0053s-23))
+ (93579179764423948500992 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.263123s0 -3.060s-24))
+ (-85988344578092468011008 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.58892s0 -1.1106s-23))
+ (53027471682887319814144 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.38977s0 -2.812s-24))
+ (138609987891358177689600 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.46599s9 0.338676s0))
+ (-4328587264 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.326s9 0.91743s0))
+ (-6895370240 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.63617s9 -0.569855s0))
+ (6380847104 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.45737s9 0.9508s0))
+ (-1532788736 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.24714s9 0.45768s0))
+ (11464605696 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.1693s9 0.69472s0))
+ (11759255552 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.7664s9 -1.9246s9))
+ (1 -8.418s8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.29057s9 -7.18694s9))
+ (-2 -6.0833s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.7409s9 8.9158s9))
+ (0 6.7409s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.4039s9 -1.80932s9))
+ (-6 -1.45206s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.4432s9 -7.587s9))
+ (-1 -3.14373s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.8365s9 -3.4401s8))
+ (14 -2.03249s7))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.70575s9 2.813s-15))
+ (1672861433068424397848576 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.37706s8 1.1696s-13))
+ (7162308674587923054592 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.9421s9 3.384s-15))
+ (1460410281571511491887104 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.4391s8 6.964s-14))
+ (13554177553722320617472 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.56217s8 3.380s-14))
+ (10538999588799264063488 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.53166s9 7.011s-14))
+ (107426919956256787529728 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.3385s9 -7.8903s19))
+ (0 -5.3385s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.5786s8 -6.5112s19))
+ (0 -5.5786s8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.0502s9 -2.57187s18))
+ (0 -7.0502s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.48724s9 3.0864s19))
+ (0 3.48724s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.195s9 6.9068s19))
+ (-1 6.9068s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.40785s9 6.1696s19))
+ (0 6.40785s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.9772s9 -3.455s-24))
+ (2887787295482420840947083445796864 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.3337s9 -2.757s-24))
+ (-2297319607304237298946798769930240 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.24916s9 8.958s-24))
+ (251078998767860827355040375111680 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.695s9 -9.695s-24))
+ (484267288087969338977238606938112 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.84457s9 -7.7713s-22))
+ (7520717852416051178813723246592 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.01576s9 6.682s-24))
+ (-301671132293375748429617783898112 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.7042s-13 -0.80732s0))
+ (-1 -0.80732s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.959s-14 0.9918s0))
+ (0 4.959s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.0820s-13 0.75837s0))
+ (0 2.08202s-13))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.808s-14 0.89121s0))
+ (0 4.808s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.005s-14 0.71084s0))
+ (-1 0.71084s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.497s-14 -0.83223s0))
+ (-1 -0.83223s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.538s-14 3.81524s9))
+ (-1 3.81524s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.0888s-13 2.5705s9))
+ (-1 2.5705s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.0445s-15 3.9579s9))
+ (-1 3.9579s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.399s-14 3.8115s9))
+ (-1 3.8115s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.889s-14 1.02951s9))
+ (0 8.889s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.408s-14 -5.5562s9))
+ (0 -4.40806s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.4679s-13 -1.9105s-13))
+ (-1 -4.426s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.2740s-14 -4.935s-14))
+ (-1 -3.661s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.321s-14 -8.355s-14))
+ (0 -4.32102s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.1228s-13 -3.641s-14))
+ (3 -3.0501s-15))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.643s-14 9.809s-14))
+ (0 4.643s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.832s-14 1.2918s-13))
+ (0 6.832s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.186s-15 7.2502s19))
+ (-1 7.2502s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.570s-14 -6.8838s19))
+ (-1 -6.8838s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.5446s-14 -8.6798s19))
+ (0 -1.5446s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.2496s-13 -8.0029s19))
+ (0 -1.24963s-13))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.303s-15 -9.7969s19))
+ (0 -3.303s-15))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.832s-14 5.17976s19))
+ (-1 5.17976s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.1039s-13 1.1031s-23))
+ (-10007216128 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.303s-14 -1.61171s-21))
+ (20493824 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.660s-14 -1.3664s-23))
+ (-2678554624 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.9574s-13 -6.864s-24))
+ (28516810752 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.285s-14 -3.329s-24))
+ (-9867755520 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.291s-15 4.2038s-23))
+ (-78285824 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.18707s19 0.231445s0))
+ (-310527697906823069696 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.5173s19 -0.0566254s0))
+ (-1680761395333178589184 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.6524s19 -0.697136s0))
+ (95424520704539754496 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.42423s19 0.68306s0))
+ (50130693352167833600 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.2388s19 0.0522995s0))
+ (-1384100280679029276672 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.9235s18 -0.24643s0))
+ (-24037400061136601088 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.63137s18 -1.6819s9))
+ (1564524544 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.4749s19 -2.36457s9))
+ (-10466623488 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.07847s19 6.4981s9))
+ (-3198582784 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.54907s19 4.4446s9))
+ (-5735186432 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.34573s19 3.0757s9))
+ (7626620928 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.93055s19 4.8192s9))
+ (-4005953536 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.4928s19 9.588s-14))
+ (468585063670302141654816501268480 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.17698s19 -3.259s-14))
+ (667992445198391196335567431270400 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.3605s19 -1.2702s-13))
+ (658197863607565267600565560410112 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.2775s19 3.555s-15))
+ (14845297722947765992252704150257664 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.0371s19 6.922s-15))
+ (-7276948270610150879291824750460928 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.3107s18 -1.0201s-13))
+ (-81468833985370875891111365181440 0.0s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.8796s19 3.8685s19))
+ (-2 3.85733s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.11224s18 -7.757s19))
+ (-1 -7.34577s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.7228s19 -6.0107s19))
+ (0 -1.72278s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.1191s19 -4.49645s19))
+ (-3 -4.3702s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.2755s19 8.9417s19))
+ (0 4.2755s19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.3237s19 -1.9687s19))
+ (2 -3.86314s18))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.109s-24 0.00614166s0))
+ (0 3.109s-24))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.2027s-23 0.0328217s0))
+ (-1 0.0328217s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.017s-24 0.76966s0))
+ (-1 0.76966s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.628s-24 0.47249s0))
+ (-1 0.47249s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.323s-24 -0.86671s0))
+ (-1 -0.86671s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.302s-24 0.0245514s0))
+ (-1 0.0245514s0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.342s-24 6.0717s9))
+ (0 5.34194s-24))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.664s-24 5.573s9))
+ (-1 5.573s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.830s-24 7.0363s9))
+ (-1 7.0363s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.176s-24 1.12686s9))
+ (-1 1.12686s9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.2026s-22 -3.99255s9))
+ (0 -2.2026s-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.994s-24 5.81167s9))
+ (0 6.994s-24))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.054s-24 -8.915s-14))
+ (-1 -8.915s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.875s-24 3.652s-14))
+ (0 2.875s-24))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.57853s-22 -4.501s-14))
+ (0 -1.57853s-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.3880s-23 -1.0479s-13))
+ (0 -1.388s-23))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.879s-24 3.974s-14))
+ (-1 3.974s-14))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.14395s-21 -4.527s-14))
+ (0 -1.14395s-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.149s-24 9.418s-24))
+ (0 6.149s-24))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.661s-24 -2.956s-24))
+ (-3 -1.20701s-24))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.254s-24 1.2764s-22))
+ (0 3.254s-24))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.4542s-22 5.574s-24))
+ (-98 8.2738s-25))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.4523s-23 3.091s-24))
+ (-5 9.3198s-25))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.913s-24 8.419s-24))
+ (-1 2.506s-24))
+
+;;  ---- Test von / ---
+
+(my-assert
+ (/ 0.4319s0 0.279747s0)
+ 1.5439s0)
+
+(my-assert
+ (/ 0.58111s0 0.474937s0)
+ 1.22354s0)
+
+(my-assert
+ (/ 0.95817s0 -0.209396s0)
+ -4.57587s0)
+
+(my-assert
+ (/ -0.30497s0 -0.182861s0)
+ 1.66777s0)
+
+(my-assert
+ (/ -0.69316s0 -0.32908s0)
+ 2.10635s0)
+
+(my-assert
+ (/ -0.87152s0 0.518326s0)
+ -1.68141s0)
+
+(my-assert
+ (/ -0.81208s0 3.27736s9)
+ -2.47784s-10)
+
+(my-assert
+ (/ 0.88465s0 2.15492s9)
+ 4.10527s-10)
+
+(my-assert
+ (/ -0.96446s0 8.0971s9)
+ -1.19112s-10)
+
+(my-assert
+ (/ -0.65258s0 -3.98033s9)
+ 1.6395s-10)
+
+(my-assert
+ (/ 0.663826s0 -7.88726s8)
+ -8.41645s-10)
+
+(my-assert
+ (/ -0.31185s0 4.1015s9)
+ -7.6033s-11)
+
+(my-assert
+ (/ -0.89607s0 -3.887s-14)
+ 2.3053s13)
+
+(my-assert
+ (/ -0.670135s0 -5.027s-14)
+ 1.33306s13)
+
+(my-assert
+ (/ 0.94663s0 -6.153s-14)
+ -1.5385s13)
+
+(my-assert
+ (/ -0.76772s0 4.033s-14)
+ -1.90358s13)
+
+(my-assert
+ (/ -0.446358s0 -1.9017s-13)
+ 2.34713s12)
+
+(my-assert
+ (/ -0.157814s0 -2.0401s-13)
+ 7.73555s11)
+
+(my-assert
+ (/ 0.636185s0 -3.78516s19)
+ -1.68073s-20)
+
+(my-assert
+ (/ -0.90556s0 7.7192s19)
+ -1.17314s-20)
+
+(my-assert
+ (/ 0.85053s0 8.3134s19)
+ 1.02309s-20)
+
+(my-assert
+ (/ -0.3058s0 3.00674s19)
+ -1.01705s-20)
+
+(my-assert
+ (/ 0.219429s0 -8.1184s19)
+ -2.70286s-21)
+
+(my-assert
+ (/ 0.319603s0 -2.0739s19)
+ -1.54106s-20)
+
+(my-assert
+ (/ 0.58943s0 -5.280s-24)
+ -1.11635s23)
+
+(my-assert
+ (/ 0.72955s0 7.852s-24)
+ 9.2914s22)
+
+(my-assert
+ (/ -0.66327s0 -3.124s-24)
+ 2.12315s23)
+
+(my-assert
+ (/ -0.0137558s0 -7.918s-24)
+ 1.73729s21)
+
+(my-assert
+ (/ 0.35823s0 5.467s-24)
+ 6.55263s22)
+
+(my-assert
+ (/ 0.93861s0 9.968s-24)
+ 9.4163s22)
+
+(my-assert
+ (/ 3.83346s9 0.99782s0)
+ 3.84185s9)
+
+(my-assert
+ (/ 8.7033s9 -0.81822s0)
+ -1.06369s10)
+
+(my-assert
+ (/ 3.52326s8 -0.79994s0)
+ -4.4044s8)
+
+(my-assert
+ (/ 8.0525s9 -0.91803s0)
+ -8.7715s9)
+
+(my-assert
+ (/ -2.12784s9 -0.761246s0)
+ 2.7952s9)
+
+(my-assert
+ (/ 1.18805s9 -0.903534s0)
+ -1.3149s9)
+
+(my-assert
+ (/ -6.50556s9 -5.4642s9)
+ 1.19058s0)
+
+(my-assert
+ (/ 3.3333s8 1.8341s8)
+ 1.81738s0)
+
+(my-assert
+ (/ 3.70934s9 9.1957s8)
+ 4.03375s0)
+
+(my-assert
+ (/ -8.0459s9 4.5511s9)
+ -1.76791s0)
+
+(my-assert
+ (/ 3.54982s9 4.6631s8)
+ 7.6126s0)
+
+(my-assert
+ (/ -6.27016s9 -3.42858s9)
+ 1.8288s0)
+
+(my-assert
+ (/ -4.3213s9 7.223s-15)
+ -5.98274s23)
+
+(my-assert
+ (/ -2.57753s9 -2.533s-15)
+ 1.01759s24)
+
+(my-assert
+ (/ 3.8858s9 -4.505s-14)
+ -8.6256s22)
+
+(my-assert
+ (/ 3.5946s9 -5.067s-14)
+ -7.0941s22)
+
+(my-assert
+ (/ 2.94434s9 8.333s-14)
+ 3.53333s22)
+
+(my-assert
+ (/ 5.6178s9 -8.241s-14)
+ -6.81694s22)
+
+(my-assert
+ (/ 4.9591s8 3.9972s19)
+ 1.24064s-11)
+
+(my-assert
+ (/ 2.4166s9 -9.2141s19)
+ -2.62272s-11)
+
+(my-assert
+ (/ -1.484s9 2.0281s19)
+ -7.3172s-11)
+
+(my-assert
+ (/ 2.2339s8 1.96374s19)
+ 1.13758s-11)
+
+(my-assert
+ (/ -6.6306s9 -2.414s19)
+ 2.7467s-10)
+
+(my-assert
+ (/ 9.9114s9 9.6187s19)
+ 1.03043s-10)
+
+(my-assert
+ (/ 4.4579s9 5.343s-24)
+ 8.3434s32)
+
+(my-assert
+ (/ -6.35994s9 -6.301s-24)
+ 1.00936s33)
+
+(my-assert
+ (/ 5.49677s9 -1.9306s-25)
+ -2.84717s34)
+
+(my-assert
+ (/ -5.007s9 3.692s-24)
+ -1.35617s33)
+
+(my-assert
+ (/ 8.6837s9 -1.6358s-23)
+ -5.3085s32)
+
+(my-assert
+ (/ 5.5898s9 -5.435s-24)
+ -1.02849s33)
+
+(my-assert
+ (/ -5.042s-14 0.79081s0)
+ -6.3758s-14)
+
+(my-assert
+ (/ -6.231s-14 0.96946s0)
+ -6.4273s-14)
+
+(my-assert
+ (/ 6.016s-14 0.418983s0)
+ 1.43587s-13)
+
+(my-assert
+ (/ -1.1682s-13 0.70944s0)
+ -1.64663s-13)
+
+(my-assert
+ (/ -1.7485s-13 0.83207s0)
+ -2.1014s-13)
+
+(my-assert
+ (/ 7.831s-15 -0.083374s0)
+ -9.3926s-14)
+
+(my-assert
+ (/ 3.947s-14 9.2342s9)
+ 4.2744s-24)
+
+(my-assert
+ (/ -1.1537s-13 -6.44075s9)
+ 1.79124s-23)
+
+(my-assert
+ (/ 6.751s-14 5.8395s8)
+ 1.1561s-22)
+
+(my-assert
+ (/ -5.026s-14 7.9677s9)
+ -6.308s-24)
+
+(my-assert
+ (/ -1.0105s-13 -1.71082s9)
+ 5.9066s-23)
+
+(my-assert
+ (/ -4.996s-14 9.426s9)
+ -5.30024s-24)
+
+(my-assert
+ (/ -6.837s-14 -3.573s-14)
+ 1.91351s0)
+
+(my-assert
+ (/ -7.736s-14 -4.898s-14)
+ 1.57942s0)
+
+(my-assert
+ (/ 3.777s-14 8.025s-14)
+ 0.470657s0)
+
+(my-assert
+ (/ -6.239s-14 8.518s-15)
+ -7.32446s0)
+
+(my-assert
+ (/ -7.548s-15 -4.573s-14)
+ 0.165056s0)
+
+(my-assert
+ (/ 1.6293s-14 4.712s-14)
+ 0.345776s0)
+
+(my-assert
+ (/ -4.47s-14 2.73658s19)
+ -1.63342s-33)
+
+(my-assert
+ (/ 1.0583s-13 2.52534s19)
+ 4.19073s-33)
+
+(my-assert
+ (/ 4.351s-15 2.70326s19)
+ 1.60955s-34)
+
+(my-assert
+ (/ 3.699s-14 -6.00707s19)
+ -6.1577s-34)
+
+(my-assert
+ (/ 6.358s-14 5.18274s19)
+ 1.22677s-33)
+
+(my-assert
+ (/ -2.971s-14 6.153s19)
+ -4.8286s-34)
+
+(my-assert
+ (/ -4.968s-14 7.699s-24)
+ -6.4528s9)
+
+(my-assert
+ (/ -3.654s-14 8.434s-24)
+ -4.3325s9)
+
+(my-assert
+ (/ -9.276s-14 -7.079s-24)
+ 1.31035s10)
+
+(my-assert
+ (/ -4.556s-14 1.3900s-23)
+ -3.27772s9)
+
+(my-assert
+ (/ 3.832s-14 1.55715s-22)
+ 2.4609s8)
+
+(my-assert
+ (/ 1.4186s-13 1.64482s-21)
+ 8.6246s7)
+
+(my-assert
+ (/ -7.0974s19 -0.705536s0)
+ 1.00596s20)
+
+(my-assert
+ (/ -7.687s19 -0.241531s0)
+ 3.1826s20)
+
+(my-assert
+ (/ 3.37013s19 -0.425987s0)
+ -7.9114s19)
+
+(my-assert
+ (/ 6.56473s19 -0.60696s0)
+ -1.08158s20)
+
+(my-assert
+ (/ 4.1598s19 0.60135s0)
+ 6.9175s19)
+
+(my-assert
+ (/ 8.8312s19 0.93547s0)
+ 9.4404s19)
+
+(my-assert
+ (/ 2.81357s19 -2.62832s9)
+ -1.07048s10)
+
+(my-assert
+ (/ 5.9243s19 -4.5189s8)
+ -1.311s11)
+
+(my-assert
+ (/ -8.3887s19 9.5761s9)
+ -8.7601s9)
+
+(my-assert
+ (/ 7.7606s19 -8.5369s9)
+ -9.0906s9)
+
+(my-assert
+ (/ -7.9868s19 5.0173s9)
+ -1.59186s10)
+
+(my-assert
+ (/ 7.4128s19 -6.7781s9)
+ -1.09364s10)
+
+(my-assert
+ (/ 1.27472s19 1.1699s-13)
+ 1.0896s32)
+
+(my-assert
+ (/ 2.97578s19 4.448s-14)
+ 6.6901s32)
+
+(my-assert
+ (/ 7.19416s19 1.3834s-13)
+ 5.20034s32)
+
+(my-assert
+ (/ 6.61843s19 -4.268s-14)
+ -1.55071s33)
+
+(my-assert
+ (/ 2.8579s19 4.364s-14)
+ 6.5488s32)
+
+(my-assert
+ (/ 8.2451s18 -6.532s-14)
+ -1.26227s32)
+
+(my-assert
+ (/ 4.63364s19 9.4305s19)
+ 0.491344s0)
+
+(my-assert
+ (/ -1.81999s19 1.05424s19)
+ -1.72636s0)
+
+(my-assert
+ (/ -1.41579s19 -4.03517s19)
+ 0.350864s0)
+
+(my-assert
+ (/ -1.88523s18 -3.3165s18)
+ 0.568436s0)
+
+(my-assert
+ (/ 8.4152s17 -7.3293s19)
+ -0.0114815s0)
+
+(my-assert
+ (/ -8.674s19 -3.63595s19)
+ 2.38562s0)
+
+(my-assert
+ (/ -1.64643s-22 0.78035s0)
+ -2.10986s-22)
+
+(my-assert
+ (/ -7.455s-24 -0.63174s0)
+ 1.18009s-23)
+
+(my-assert
+ (/ -3.259s-24 -0.89363s0)
+ 3.64694s-24)
+
+(my-assert
+ (/ 1.5803s-23 -0.11338s0)
+ -1.39382s-22)
+
+(my-assert
+ (/ -3.534s-24 0.407562s0)
+ -8.6711s-24)
+
+(my-assert
+ (/ -7.221s-24 0.90274s0)
+ -7.999s-24)
+
+(my-assert
+ (/ 1.0479s-23 5.66256s8)
+ 1.85059s-32)
+
+(my-assert
+ (/ 1.62856s-21 -1.9551s9)
+ -8.3298s-31)
+
+(my-assert
+ (/ -8.102s-24 9.7896s9)
+ -8.2761s-34)
+
+(my-assert
+ (/ 9.693s-24 -8.777s9)
+ -1.10437s-33)
+
+(my-assert
+ (/ 8.643s-24 -1.25557s9)
+ -6.8837s-33)
+
+(my-assert
+ (/ 3.224s-24 9.8161s9)
+ 3.2844s-34)
+
+(my-assert
+ (/ 1.06582s-21 -1.0408s-13)
+ -1.02405s-8)
+
+(my-assert
+ (/ 1.6738s-23 9.851s-14)
+ 1.69914s-10)
+
+(my-assert
+ (/ -1.1514s-23 -6.509s-14)
+ 1.76893s-10)
+
+(my-assert
+ (/ 9.171s-24 9.292s-14)
+ 9.8698s-11)
+
+(my-assert
+ (/ 1.8589s-23 -4.213s-14)
+ -4.4123s-10)
+
+(my-assert
+ (/ 1.2837s-23 1.1034s-13)
+ 1.16341s-10)
+
+(my-assert
+ (/ 3.671s-24 1.0091s-23)
+ 0.363792s0)
+
+(my-assert
+ (/ -3.373s-24 -1.7017s-23)
+ 0.198214s0)
+
+(my-assert
+ (/ -2.0157s-23 1.0021s-23)
+ -2.01147s0)
+
+(my-assert
+ (/ 8.041s-24 -1.3974s-23)
+ -0.575424s0)
+
+(my-assert
+ (/ -5.391s-24 1.1762s-23)
+ -0.458344s0)
+
+(my-assert
+ (/ 1.7735s-23 -3.313s-24)
+ -5.3531s0)
+
+;; ==== S I N G L E - F L O A T S ====
+
+;;  ---- Test von + ---
+
+(my-assert
+ (+ 0.79351956 0.07393837)
+ 0.8674579)
+
+(my-assert
+ (+ -0.52145976 -0.14409256)
+ -0.6655523)
+
+(my-assert
+ (+ -0.094845235 -0.091273725)
+ -0.18611896)
+
+(my-assert
+ (+ -0.11106694 -0.90595967)
+ -1.0170267)
+
+(my-assert
+ (+ 0.46902913 0.6453068)
+ 1.114336)
+
+(my-assert
+ (+ -0.30989015 0.6634996)
+ 0.35360944)
+
+(my-assert
+ (+ -0.58887166 -3.1150198E9)
+ -3.1150198E9)
+
+(my-assert
+ (+ 0.08032262 -8.451643E9)
+ -8.451643E9)
+
+(my-assert
+ (+ -0.734433 7.601292E9)
+ 7.601292E9)
+
+(my-assert
+ (+ 0.77958024 -4.2334996E9)
+ -4.2334996E9)
+
+(my-assert
+ (+ -0.5492505 4.4427484E9)
+ 4.4427484E9)
+
+(my-assert
+ (+ -0.45681345 4.7386803E9)
+ 4.7386803E9)
+
+(my-assert
+ (+ -0.5951412 7.866326E-11)
+ -0.5951412)
+
+(my-assert
+ (+ 0.8511461 8.396644E-11)
+ 0.8511461)
+
+(my-assert
+ (+ -0.94777477 -7.635105E-11)
+ -0.94777477)
+
+(my-assert
+ (+ -0.20783025 -1.7222382E-11)
+ -0.20783025)
+
+(my-assert
+ (+ 0.82520634 -5.3449255E-11)
+ 0.82520634)
+
+(my-assert
+ (+ 0.7797032 3.7409843E-11)
+ 0.7797032)
+
+(my-assert
+ (+ 0.9915549 5.16192E19)
+ 5.16192E19)
+
+(my-assert
+ (+ -0.6311349 2.1599532E19)
+ 2.1599532E19)
+
+(my-assert
+ (+ 0.42801672 4.8533796E18)
+ 4.8533796E18)
+
+(my-assert
+ (+ -0.11165339 6.518633E19)
+ 6.518633E19)
+
+(my-assert
+ (+ -0.5133993 -5.5200484E19)
+ -5.5200484E19)
+
+(my-assert
+ (+ 0.11643493 -1.0541451E19)
+ -1.0541451E19)
+
+(my-assert
+ (+ -0.7063649 8.243067E-21)
+ -0.7063649)
+
+(my-assert
+ (+ 8.4728E-4 -7.5151976E-21)
+ 8.4728E-4)
+
+(my-assert
+ (+ -0.47157037 -8.748518E-21)
+ -0.47157037)
+
+(my-assert
+ (+ 0.7662331 -5.6591384E-21)
+ 0.7662331)
+
+(my-assert
+ (+ -0.9418909 -4.455382E-21)
+ -0.9418909)
+
+(my-assert
+ (+ -0.88412094 6.6664897E-21)
+ -0.88412094)
+
+(my-assert
+ (+ 5.5891533E9 -0.11624104)
+ 5.5891533E9)
+
+(my-assert
+ (+ -8.760519E9 0.22073412)
+ -8.760519E9)
+
+(my-assert
+ (+ 6.8390047E9 -0.6434584)
+ 6.8390047E9)
+
+(my-assert
+ (+ 5.1620844E9 -0.93939686)
+ 5.1620844E9)
+
+(my-assert
+ (+ 9.21372E9 -0.93054956)
+ 9.21372E9)
+
+(my-assert
+ (+ -2.7403366E9 -0.9354063)
+ -2.7403366E9)
+
+(my-assert
+ (+ 6.4755876E9 7.780013E9)
+ 1.4255601E10)
+
+(my-assert
+ (+ 3.6402857E9 -4.6589404E9)
+ -1.0186547E9)
+
+(my-assert
+ (+ 9.858497E9 -3.1216233E9)
+ 6.7368735E9)
+
+(my-assert
+ (+ -5.199144E9 -8.3410964E9)
+ -1.354024E10)
+
+(my-assert
+ (+ -2.2145843E9 7.4088115E9)
+ 5.194227E9)
+
+(my-assert
+ (+ 3.6034734E9 -4.7355105E9)
+ -1.1320371E9)
+
+(my-assert
+ (+ -3.974853E9 8.344858E-11)
+ -3.974853E9)
+
+(my-assert
+ (+ 9.633741E9 9.879035E-11)
+ 9.633741E9)
+
+(my-assert
+ (+ -5.84563E9 -2.8054357E-11)
+ -5.84563E9)
+
+(my-assert
+ (+ 1.6814709E8 -6.702281E-11)
+ 1.6814709E8)
+
+(my-assert
+ (+ 6.627381E8 8.1083654E-11)
+ 6.627381E8)
+
+(my-assert
+ (+ 6.617609E9 -7.74835E-11)
+ 6.617609E9)
+
+(my-assert
+ (+ -4.325255E9 7.48992E19)
+ 7.48992E19)
+
+(my-assert
+ (+ 8.963769E9 5.6527995E19)
+ 5.6527995E19)
+
+(my-assert
+ (+ 3.2307428E9 -3.772047E19)
+ -3.772047E19)
+
+(my-assert
+ (+ -1.5719092E9 9.119215E19)
+ 9.119215E19)
+
+(my-assert
+ (+ -3.1338138E9 2.7048826E19)
+ 2.7048826E19)
+
+(my-assert
+ (+ -4.4506363E9 9.624759E19)
+ 9.624759E19)
+
+(my-assert
+ (+ 1.8499094E9 4.968932E-21)
+ 1.8499094E9)
+
+(my-assert
+ (+ 1.1302281E9 1.590079E-21)
+ 1.1302281E9)
+
+(my-assert
+ (+ 5.7261727E9 -3.3212954E-21)
+ 5.7261727E9)
+
+(my-assert
+ (+ 1.8314988E9 -6.247946E-21)
+ 1.8314988E9)
+
+(my-assert
+ (+ -7.301286E9 -8.870309E-21)
+ -7.301286E9)
+
+(my-assert
+ (+ 8.0970737E9 -6.944993E-21)
+ 8.0970737E9)
+
+(my-assert
+ (+ 9.076142E-11 0.79629874)
+ 0.79629874)
+
+(my-assert
+ (+ -2.5569331E-11 -0.11109424)
+ -0.11109424)
+
+(my-assert
+ (+ 5.817238E-11 0.8669617)
+ 0.8669617)
+
+(my-assert
+ (+ 5.0001194E-11 0.1629681)
+ 0.1629681)
+
+(my-assert
+ (+ -5.314657E-11 0.33499128)
+ 0.33499128)
+
+(my-assert
+ (+ 3.4244614E-11 0.7846571)
+ 0.7846571)
+
+(my-assert
+ (+ 5.016508E-11 1.2850774E9)
+ 1.2850774E9)
+
+(my-assert
+ (+ -6.236206E-11 -3.9463657E9)
+ -3.9463657E9)
+
+(my-assert
+ (+ -9.461717E-11 -2.86016E9)
+ -2.86016E9)
+
+(my-assert
+ (+ 9.271425E-11 9.936099E9)
+ 9.936099E9)
+
+(my-assert
+ (+ -9.330213E-12 4.2810826E9)
+ 4.2810826E9)
+
+(my-assert
+ (+ 8.8110796E-11 -7.967343E9)
+ -7.967343E9)
+
+(my-assert
+ (+ -3.252064E-11 9.310712E-11)
+ 6.058648E-11)
+
+(my-assert
+ (+ 9.2616026E-11 -4.2321837E-11)
+ 5.029419E-11)
+
+(my-assert
+ (+ -6.138445E-11 2.0083374E-11)
+ -4.130108E-11)
+
+(my-assert
+ (+ -1.672895E-11 -4.1673078E-11)
+ -5.8402026E-11)
+
+(my-assert
+ (+ -5.054619E-11 -1.9569606E-11)
+ -7.0115795E-11)
+
+(my-assert
+ (+ -6.765585E-11 6.200571E-11)
+ -5.65014E-12)
+
+(my-assert
+ (+ -8.958499E-11 9.627367E18)
+ 9.627367E18)
+
+(my-assert
+ (+ -3.639458E-11 -6.774422E19)
+ -6.774422E19)
+
+(my-assert
+ (+ 5.885664E-11 7.710968E19)
+ 7.710968E19)
+
+(my-assert
+ (+ -2.8348934E-11 -6.8805507E19)
+ -6.8805507E19)
+
+(my-assert
+ (+ 3.783013E-11 -4.363011E19)
+ -4.363011E19)
+
+(my-assert
+ (+ 9.9192224E-11 7.840148E19)
+ 7.840148E19)
+
+(my-assert
+ (+ 1.5157771E-11 -6.578477E-21)
+ 1.5157771E-11)
+
+(my-assert
+ (+ 3.269849E-11 -1.5641468E-21)
+ 3.269849E-11)
+
+(my-assert
+ (+ -2.4697334E-11 -5.9471063E-21)
+ -2.4697334E-11)
+
+(my-assert
+ (+ -7.226034E-11 -8.027814E-21)
+ -7.226034E-11)
+
+(my-assert
+ (+ 6.705153E-12 1.3146739E-21)
+ 6.705153E-12)
+
+(my-assert
+ (+ -9.281199E-11 1.940757E-22)
+ -9.281199E-11)
+
+(my-assert
+ (+ 6.841885E19 0.29873258)
+ 6.841885E19)
+
+(my-assert
+ (+ -7.487633E19 -0.41199452)
+ -7.487633E19)
+
+(my-assert
+ (+ 9.324847E19 -0.12986994)
+ 9.324847E19)
+
+(my-assert
+ (+ 1.7454827E19 -0.9480438)
+ 1.7454827E19)
+
+(my-assert
+ (+ -2.2794772E19 -0.85242146)
+ -2.2794772E19)
+
+(my-assert
+ (+ -1.4789046E18 -0.3244334)
+ -1.4789046E18)
+
+(my-assert
+ (+ -1.0913384E19 6.2691034E8)
+ -1.0913384E19)
+
+(my-assert
+ (+ 9.054158E19 6.7361736E9)
+ 9.054158E19)
+
+(my-assert
+ (+ -2.404365E19 2.819194E9)
+ -2.404365E19)
+
+(my-assert
+ (+ 3.0628145E19 3.8188636E9)
+ 3.0628145E19)
+
+(my-assert
+ (+ -3.7020847E19 -4.248917E8)
+ -3.7020847E19)
+
+(my-assert
+ (+ 8.556466E19 -5.431256E9)
+ 8.556466E19)
+
+(my-assert
+ (+ 4.8590555E19 -4.0259546E-11)
+ 4.8590555E19)
+
+(my-assert
+ (+ -1.990289E19 -3.2150872E-11)
+ -1.990289E19)
+
+(my-assert
+ (+ -1.5843934E19 5.37822E-11)
+ -1.5843934E19)
+
+(my-assert
+ (+ 1.596058E19 2.465645E-11)
+ 1.596058E19)
+
+(my-assert
+ (+ 8.179266E19 -8.080585E-11)
+ 8.179266E19)
+
+(my-assert
+ (+ 8.673572E19 -2.1405459E-11)
+ 8.673572E19)
+
+(my-assert
+ (+ -4.5302206E19 4.4819714E19)
+ -4.824921E17)
+
+(my-assert
+ (+ 2.1413618E19 -7.160984E19)
+ -5.0196224E19)
+
+(my-assert
+ (+ 9.760235E19 -7.810464E19)
+ 1.949771E19)
+
+(my-assert
+ (+ -7.518544E19 -5.7398474E19)
+ -1.32583915E20)
+
+(my-assert
+ (+ -2.459352E19 6.0089863E19)
+ 3.5496343E19)
+
+(my-assert
+ (+ -9.009707E19 1.9710512E19)
+ -7.0386556E19)
+
+(my-assert
+ (+ 4.9167807E19 -1.261897E-21)
+ 4.9167807E19)
+
+(my-assert
+ (+ -8.647001E18 -1.4144885E-21)
+ -8.647001E18)
+
+(my-assert
+ (+ -6.2763383E19 6.69688E-21)
+ -6.2763383E19)
+
+(my-assert
+ (+ 1.6851938E19 -4.9109547E-21)
+ 1.6851938E19)
+
+(my-assert
+ (+ -7.0371058E19 -9.246501E-21)
+ -7.0371058E19)
+
+(my-assert
+ (+ -2.8498996E19 3.3614294E-21)
+ -2.8498996E19)
+
+(my-assert
+ (+ -4.8211753E-21 0.5153807)
+ 0.5153807)
+
+(my-assert
+ (+ -9.730312E-21 0.3705088)
+ 0.3705088)
+
+(my-assert
+ (+ -8.83036E-21 0.21063423)
+ 0.21063423)
+
+(my-assert
+ (+ 1.8688595E-21 -0.38304192)
+ -0.38304192)
+
+(my-assert
+ (+ -7.9137435E-21 -0.9482965)
+ -0.9482965)
+
+(my-assert
+ (+ -5.7913193E-21 -0.16538233)
+ -0.16538233)
+
+(my-assert
+ (+ -4.667948E-21 5.69782E9)
+ 5.69782E9)
+
+(my-assert
+ (+ -1.6254025E-21 1.100067E9)
+ 1.100067E9)
+
+(my-assert
+ (+ 5.4919865E-21 9.125866E9)
+ 9.125866E9)
+
+(my-assert
+ (+ 2.1973532E-21 -5.218964E9)
+ -5.218964E9)
+
+(my-assert
+ (+ -4.018586E-21 -6.5943096E9)
+ -6.5943096E9)
+
+(my-assert
+ (+ -7.7845274E-22 4.172669E9)
+ 4.172669E9)
+
+(my-assert
+ (+ -2.843846E-21 9.243441E-12)
+ 9.243441E-12)
+
+(my-assert
+ (+ 1.1533075E-21 3.327943E-11)
+ 3.327943E-11)
+
+(my-assert
+ (+ 5.977113E-21 6.507544E-11)
+ 6.507544E-11)
+
+(my-assert
+ (+ 1.1817801E-21 -4.1877824E-11)
+ -4.1877824E-11)
+
+(my-assert
+ (+ 1.932947E-21 9.4013144E-11)
+ 9.4013144E-11)
+
+(my-assert
+ (+ 8.526454E-21 8.396772E-11)
+ 8.396772E-11)
+
+(my-assert
+ (+ -4.8870485E-21 5.9277504E19)
+ 5.9277504E19)
+
+(my-assert
+ (+ -4.7174987E-21 2.5545484E19)
+ 2.5545484E19)
+
+(my-assert
+ (+ -8.818029E-21 1.2602901E19)
+ 1.2602901E19)
+
+(my-assert
+ (+ -1.2268113E-21 -9.071741E19)
+ -9.071741E19)
+
+(my-assert
+ (+ -7.0568975E-21 -6.9825405E19)
+ -6.9825405E19)
+
+(my-assert
+ (+ 8.723312E-21 -5.802767E19)
+ -5.802767E19)
+
+(my-assert
+ (+ 7.1661314E-21 4.10364E-21)
+ 1.1269772E-20)
+
+(my-assert
+ (+ 8.181265E-21 -4.6898657E-21)
+ 3.4913997E-21)
+
+(my-assert
+ (+ -8.570217E-21 -5.5145446E-21)
+ -1.4084761E-20)
+
+(my-assert
+ (+ 1.3507604E-23 -7.152723E-21)
+ -7.139215E-21)
+
+(my-assert
+ (+ -7.859527E-21 -9.369602E-21)
+ -1.7229128E-20)
+
+(my-assert
+ (+ -4.9014434E-21 1.4580911E-21)
+ -3.443352E-21)
+
+;;  ---- Test von - ---
+
+(my-assert
+ (- -0.41894162 0.23777992)
+ -0.65672153)
+
+(my-assert
+ (- 0.74937063 0.4803756)
+ 0.26899505)
+
+(my-assert
+ (- 0.46964037 -0.94880456)
+ 1.4184449)
+
+(my-assert
+ (- 0.16453332 0.035123527)
+ 0.12940979)
+
+(my-assert
+ (- 0.7353321 -0.3952883)
+ 1.1306204)
+
+(my-assert
+ (- -0.33693552 -0.6941588)
+ 0.35722327)
+
+(my-assert
+ (- -0.61853 -9.25498E9)
+ 9.25498E9)
+
+(my-assert
+ (- 0.5172653 -6.728693E9)
+ 6.728693E9)
+
+(my-assert
+ (- 0.1268478 -1.8808037E9)
+ 1.8808037E9)
+
+(my-assert
+ (- 0.29479754 -3.4643973E9)
+ 3.4643973E9)
+
+(my-assert
+ (- 0.34332883 1.4258218E9)
+ -1.4258218E9)
+
+(my-assert
+ (- -0.4093976 -1.6698813E9)
+ 1.6698813E9)
+
+(my-assert
+ (- 0.10942185 -2.015636E-11)
+ 0.10942185)
+
+(my-assert
+ (- 0.30351585 4.4276416E-11)
+ 0.30351585)
+
+(my-assert
+ (- -0.41279083 6.5274E-11)
+ -0.41279083)
+
+(my-assert
+ (- 0.7813598 -5.028443E-11)
+ 0.7813598)
+
+(my-assert
+ (- -0.72214615 2.5959075E-11)
+ -0.72214615)
+
+(my-assert
+ (- -0.8924311 -5.2076333E-11)
+ -0.8924311)
+
+(my-assert
+ (- -0.26128495 6.8887236E19)
+ -6.8887236E19)
+
+(my-assert
+ (- 0.906616 -2.0519019E18)
+ 2.0519019E18)
+
+(my-assert
+ (- 0.96452767 -1.6347343E19)
+ 1.6347343E19)
+
+(my-assert
+ (- -0.99801517 8.383864E19)
+ -8.383864E19)
+
+(my-assert
+ (- -0.60573876 -4.890489E19)
+ 4.890489E19)
+
+(my-assert
+ (- -0.004701972 6.3981E18)
+ -6.3981E18)
+
+(my-assert
+ (- 0.34311903 3.52871E-21)
+ 0.34311903)
+
+(my-assert
+ (- -0.38159567 -2.3400748E-21)
+ -0.38159567)
+
+(my-assert
+ (- -0.6719565 -5.4333447E-21)
+ -0.6719565)
+
+(my-assert
+ (- -0.21363729 8.021308E-21)
+ -0.21363729)
+
+(my-assert
+ (- 0.5275244 -4.88554E-21)
+ 0.5275244)
+
+(my-assert
+ (- 0.9064559 -6.5840867E-21)
+ 0.9064559)
+
+(my-assert
+ (- -3.0312538E8 0.26249015)
+ -3.0312538E8)
+
+(my-assert
+ (- -9.217122E9 0.22172129)
+ -9.217122E9)
+
+(my-assert
+ (- -1.157806E9 -0.95704305)
+ -1.157806E9)
+
+(my-assert
+ (- 6.743087E9 -0.37863714)
+ 6.743087E9)
+
+(my-assert
+ (- -4.0819942E8 -0.068549395)
+ -4.0819942E8)
+
+(my-assert
+ (- 4.586502E9 0.29215187)
+ 4.586502E9)
+
+(my-assert
+ (- 5.091125E9 -2.971223E9)
+ 8.0623483E9)
+
+(my-assert
+ (- -2.1147072E8 -8.537374E9)
+ 8.3259034E9)
+
+(my-assert
+ (- -9.075735E9 -9.072693E9)
+ -3041280.0)
+
+(my-assert
+ (- 1.4614451E9 3.0213921E9)
+ -1.559947E9)
+
+(my-assert
+ (- 8.960645E9 5.4822825E9)
+ 3.4783626E9)
+
+(my-assert
+ (- -3.7246787E9 -2.823592E9)
+ -9.010867E8)
+
+(my-assert
+ (- -3.4256804E9 -1.8245674E-11)
+ -3.4256804E9)
+
+(my-assert
+ (- 7.0777057E9 3.6826153E-11)
+ 7.0777057E9)
+
+(my-assert
+ (- 3.4600579E9 -5.207135E-11)
+ 3.4600579E9)
+
+(my-assert
+ (- 9.57872E9 8.222393E-11)
+ 9.57872E9)
+
+(my-assert
+ (- 8.388926E9 -1.1216945E-11)
+ 8.388926E9)
+
+(my-assert
+ (- 3.8273395E8 1.153788E-11)
+ 3.8273395E8)
+
+(my-assert
+ (- -1.2011469E8 -9.879852E19)
+ 9.879852E19)
+
+(my-assert
+ (- 3.850388E9 4.8155957E19)
+ -4.8155957E19)
+
+(my-assert
+ (- 5.5329756E9 -5.067925E19)
+ 5.067925E19)
+
+(my-assert
+ (- 3.3222902E9 5.2892763E19)
+ -5.2892763E19)
+
+(my-assert
+ (- 4.431185E9 -8.005187E19)
+ 8.005187E19)
+
+(my-assert
+ (- -7.307553E8 -6.8217897E19)
+ 6.8217897E19)
+
+(my-assert
+ (- 7.9813893E9 9.68989E-21)
+ 7.9813893E9)
+
+(my-assert
+ (- -5.7208223E9 9.790913E-21)
+ -5.7208223E9)
+
+(my-assert
+ (- -5.9564112E7 9.217466E-21)
+ -5.9564112E7)
+
+(my-assert
+ (- 5.4524237E9 4.947411E-21)
+ 5.4524237E9)
+
+(my-assert
+ (- 1.4269632E9 -5.1552662E-21)
+ 1.4269632E9)
+
+(my-assert
+ (- 3.7555832E9 -4.168443E-21)
+ 3.7555832E9)
+
+(my-assert
+ (- -4.1575327E-11 -0.38582206)
+ 0.38582206)
+
+(my-assert
+ (- -5.810516E-11 -0.5456566)
+ 0.5456566)
+
+(my-assert
+ (- -1.2386638E-11 -0.6209788)
+ 0.6209788)
+
+(my-assert
+ (- 2.0245033E-11 -0.7418727)
+ 0.7418727)
+
+(my-assert
+ (- 3.7671637E-11 0.1772576)
+ -0.1772576)
+
+(my-assert
+ (- -2.2774244E-11 -0.5959606)
+ 0.5959606)
+
+(my-assert
+ (- -5.6623112E-11 6.8330056E9)
+ -6.8330056E9)
+
+(my-assert
+ (- -9.2078116E-11 -3.4236897E9)
+ 3.4236897E9)
+
+(my-assert
+ (- -3.317883E-11 -3.2438755E8)
+ 3.2438755E8)
+
+(my-assert
+ (- 6.711307E-11 -7.9204526E9)
+ 7.9204526E9)
+
+(my-assert
+ (- -5.1150143E-11 9.1128E9)
+ -9.1128E9)
+
+(my-assert
+ (- -7.3234044E-11 -8.067016E9)
+ 8.067016E9)
+
+(my-assert
+ (- -3.217777E-11 -1.6301262E-11)
+ -1.5876508E-11)
+
+(my-assert
+ (- 9.6583325E-11 5.882668E-11)
+ 3.7756645E-11)
+
+(my-assert
+ (- -7.573351E-11 6.3386435E-11)
+ -1.3911994E-10)
+
+(my-assert
+ (- -4.5759726E-11 8.069604E-11)
+ -1.2645576E-10)
+
+(my-assert
+ (- -9.538651E-11 -9.01152E-11)
+ -5.271311E-12)
+
+(my-assert
+ (- 6.2486766E-11 -3.414284E-11)
+ 9.662961E-11)
+
+(my-assert
+ (- 5.530477E-13 -3.1361222E18)
+ 3.1361222E18)
+
+(my-assert
+ (- 1.7998643E-11 1.5437615E19)
+ -1.5437615E19)
+
+(my-assert
+ (- -4.7948378E-11 2.6669319E19)
+ -2.6669319E19)
+
+(my-assert
+ (- -6.8626884E-12 -5.7713735E19)
+ 5.7713735E19)
+
+(my-assert
+ (- 6.195949E-11 2.8851469E19)
+ -2.8851469E19)
+
+(my-assert
+ (- 2.4957127E-11 -2.661574E18)
+ 2.661574E18)
+
+(my-assert
+ (- 9.8157565E-11 -4.561507E-21)
+ 9.8157565E-11)
+
+(my-assert
+ (- -9.332288E-11 -9.280375E-21)
+ -9.332288E-11)
+
+(my-assert
+ (- -9.916877E-11 -1.6945641E-21)
+ -9.916877E-11)
+
+(my-assert
+ (- -6.460804E-11 -3.6695186E-21)
+ -6.460804E-11)
+
+(my-assert
+ (- 6.712223E-11 -2.5360524E-21)
+ 6.712223E-11)
+
+(my-assert
+ (- 2.3824066E-11 -7.439168E-21)
+ 2.3824066E-11)
+
+(my-assert
+ (- -5.189389E19 0.01453203)
+ -5.189389E19)
+
+(my-assert
+ (- 7.0132006E19 0.45530832)
+ 7.0132006E19)
+
+(my-assert
+ (- 2.9365046E19 0.36346745)
+ 2.9365046E19)
+
+(my-assert
+ (- -4.1377934E19 0.37368965)
+ -4.1377934E19)
+
+(my-assert
+ (- -1.891423E19 0.159002)
+ -1.891423E19)
+
+(my-assert
+ (- 1.8096083E19 -0.6511793)
+ 1.8096083E19)
+
+(my-assert
+ (- 6.4361307E19 6.6511677E9)
+ 6.4361307E19)
+
+(my-assert
+ (- -1.8698508E19 1.1925399E9)
+ -1.8698508E19)
+
+(my-assert
+ (- 7.75824E19 7.7361823E9)
+ 7.75824E19)
+
+(my-assert
+ (- -7.2570015E19 3.0842496E9)
+ -7.2570015E19)
+
+(my-assert
+ (- -1.9014525E19 -3.8941514E9)
+ -1.9014525E19)
+
+(my-assert
+ (- 3.2787157E19 -8.612244E9)
+ 3.2787157E19)
+
+(my-assert
+ (- 6.4268583E19 -1.2707472E-11)
+ 6.4268583E19)
+
+(my-assert
+ (- -6.5179933E19 8.61941E-11)
+ -6.5179933E19)
+
+(my-assert
+ (- -8.106952E19 2.1709537E-11)
+ -8.106952E19)
+
+(my-assert
+ (- 2.5455064E19 3.5653924E-11)
+ 2.5455064E19)
+
+(my-assert
+ (- 1.574235E19 -2.7033407E-11)
+ 1.574235E19)
+
+(my-assert
+ (- -1.1099541E19 -8.620364E-12)
+ -1.1099541E19)
+
+(my-assert
+ (- -6.346294E19 2.9902512E19)
+ -9.336545E19)
+
+(my-assert
+ (- 4.9783164E19 -2.079425E19)
+ 7.0577414E19)
+
+(my-assert
+ (- -7.149202E19 1.4282865E19)
+ -8.577488E19)
+
+(my-assert
+ (- 6.0978866E19 5.256896E19)
+ 8.409905E18)
+
+(my-assert
+ (- -9.961146E19 -1.9834548E19)
+ -7.977691E19)
+
+(my-assert
+ (- 2.5196015E18 5.0534214E19)
+ -4.8014613E19)
+
+(my-assert
+ (- -3.6981453E19 -1.005367E-21)
+ -3.6981453E19)
+
+(my-assert
+ (- 8.881044E19 -9.717088E-22)
+ 8.881044E19)
+
+(my-assert
+ (- 4.9637263E19 -7.544846E-21)
+ 4.9637263E19)
+
+(my-assert
+ (- -4.2414725E19 1.3904184E-21)
+ -4.2414725E19)
+
+(my-assert
+ (- 7.844454E18 -8.659333E-21)
+ 7.844454E18)
+
+(my-assert
+ (- 1.5733016E19 8.638849E-21)
+ 1.5733016E19)
+
+(my-assert
+ (- 1.7531192E-21 -0.8690463)
+ 0.8690463)
+
+(my-assert
+ (- 9.449351E-21 0.7848489)
+ -0.7848489)
+
+(my-assert
+ (- 5.5016538E-21 -0.8998171)
+ 0.8998171)
+
+(my-assert
+ (- -6.977279E-21 -0.9815793)
+ 0.9815793)
+
+(my-assert
+ (- -7.9253305E-21 -0.21357381)
+ 0.21357381)
+
+(my-assert
+ (- 4.026555E-21 0.5610563)
+ -0.5610563)
+
+(my-assert
+ (- -7.080433E-21 -1.9501078E9)
+ 1.9501078E9)
+
+(my-assert
+ (- -8.152211E-21 8.164317E9)
+ -8.164317E9)
+
+(my-assert
+ (- 2.177096E-21 -8.591886E9)
+ 8.591886E9)
+
+(my-assert
+ (- 9.387247E-21 3.5730028E9)
+ -3.5730028E9)
+
+(my-assert
+ (- -7.589234E-21 -4.9193774E9)
+ 4.9193774E9)
+
+(my-assert
+ (- 1.5755653E-21 -2.3484498E9)
+ 2.3484498E9)
+
+(my-assert
+ (- 9.3034425E-21 8.28104E-11)
+ -8.28104E-11)
+
+(my-assert
+ (- -6.417297E-21 -8.352926E-11)
+ 8.352926E-11)
+
+(my-assert
+ (- 8.728735E-21 9.160732E-11)
+ -9.160732E-11)
+
+(my-assert
+ (- 3.8984202E-21 6.5116944E-12)
+ -6.5116944E-12)
+
+(my-assert
+ (- 6.288995E-21 -5.6701328E-11)
+ 5.6701328E-11)
+
+(my-assert
+ (- -2.7652023E-22 -1.01428276E-11)
+ 1.01428276E-11)
+
+(my-assert
+ (- 4.7200214E-21 -3.726995E18)
+ 3.726995E18)
+
+(my-assert
+ (- -2.2945808E-21 -7.3098524E19)
+ 7.3098524E19)
+
+(my-assert
+ (- -9.493033E-21 3.4235436E19)
+ -3.4235436E19)
+
+(my-assert
+ (- 3.7946773E-21 -5.126768E18)
+ 5.126768E18)
+
+(my-assert
+ (- -1.2865209E-21 3.5096026E19)
+ -3.5096026E19)
+
+(my-assert
+ (- -8.403449E-21 5.704743E18)
+ -5.704743E18)
+
+(my-assert
+ (- 2.928304E-21 -5.574477E-21)
+ 8.502781E-21)
+
+(my-assert
+ (- -9.46122E-21 -3.858943E-21)
+ -5.602277E-21)
+
+(my-assert
+ (- 7.296878E-22 1.8123137E-21)
+ -1.0826259E-21)
+
+(my-assert
+ (- 5.866651E-21 2.4605584E-21)
+ 3.4060923E-21)
+
+(my-assert
+ (- -7.633577E-21 9.915102E-21)
+ -1.7548679E-20)
+
+(my-assert
+ (- -8.7881085E-24 3.001468E-21)
+ -3.0102563E-21)
+
+;;  ---- Test von * ---
+
+(my-assert
+ (* 0.3098436 0.0057770014)
+ 0.001789967)
+
+(my-assert
+ (* -0.14583993 -0.028087378)
+ 0.004096261)
+
+(my-assert
+ (* 0.21399558 0.96054405)
+ 0.20555218)
+
+(my-assert
+ (* 0.7590452 0.8427266)
+ 0.6396676)
+
+(my-assert
+ (* -0.34523207 0.20272356)
+ -0.06998668)
+
+(my-assert
+ (* -0.98096234 0.98158866)
+ -0.96290153)
+
+(my-assert
+ (* 0.40309322 4.0009994E9)
+ 1.6127757E9)
+
+(my-assert
+ (* 0.15507132 9.481803E9)
+ 1.4703557E9)
+
+(my-assert
+ (* 0.5218476 -2.1933102E9)
+ -1.1445737E9)
+
+(my-assert
+ (* 0.17258328 2.6295781E8)
+ 4.538212E7)
+
+(my-assert
+ (* 0.25962013 8.699164E9)
+ 2.258478E9)
+
+(my-assert
+ (* 0.47902477 -1.4075732E9)
+ -6.7426246E8)
+
+(my-assert
+ (* 0.9642294 -1.6256952E-11)
+ -1.5675431E-11)
+
+(my-assert
+ (* 0.6098744 -8.802921E-12)
+ -5.3686764E-12)
+
+(my-assert
+ (* -0.25792134 4.804327E-11)
+ -1.2391385E-11)
+
+(my-assert
+ (* -0.8724403 -9.101418E-11)
+ 7.940444E-11)
+
+(my-assert
+ (* -0.13318628 8.1157005E-11)
+ -1.08089995E-11)
+
+(my-assert
+ (* -0.54116476 -9.353639E-11)
+ 5.0618596E-11)
+
+(my-assert
+ (* 0.9018487 7.411783E19)
+ 6.6843068E19)
+
+(my-assert
+ (* -0.6835444 -7.590606E19)
+ 5.188516E19)
+
+(my-assert
+ (* -0.9896146 5.195105E18)
+ -5.141152E18)
+
+(my-assert
+ (* -0.4838531 1.88174E19)
+ -9.1048573E18)
+
+(my-assert
+ (* -0.31826657 -3.3103586E19)
+ 1.0535765E19)
+
+(my-assert
+ (* 0.6818549 -9.227651E19)
+ -6.2919192E19)
+
+(my-assert
+ (* 0.7676919 7.320194E-21)
+ 5.6196534E-21)
+
+(my-assert
+ (* 0.49369502 4.9805288E-21)
+ 2.4588622E-21)
+
+(my-assert
+ (* 0.9599328 7.903804E-21)
+ 7.58712E-21)
+
+(my-assert
+ (* 0.13215566 7.603894E-21)
+ 1.0048976E-21)
+
+(my-assert
+ (* -0.35744518 -9.408464E-21)
+ 3.36301E-21)
+
+(my-assert
+ (* -0.79346496 9.006081E-21)
+ -7.146009E-21)
+
+(my-assert
+ (* 4.1775434E9 -0.13509268)
+ -5.643555E8)
+
+(my-assert
+ (* 7.27846E9 -0.8181822)
+ -5.9551063E9)
+
+(my-assert
+ (* 2.9669427E9 0.7082195)
+ 2.1012467E9)
+
+(my-assert
+ (* 7.609933E9 -0.33963126)
+ -2.5845711E9)
+
+(my-assert
+ (* 3.4241843E9 0.3924479)
+ 1.3438139E9)
+
+(my-assert
+ (* -3.8366538E9 0.56461394)
+ -2.1662282E9)
+
+(my-assert
+ (* 3.7237007E9 1.2646783E9)
+ 4.7092836E18)
+
+(my-assert
+ (* -2.7657871E9 -3.6314278E9)
+ 1.0043756E19)
+
+(my-assert
+ (* -4.753982E9 -5.8879616E8)
+ 2.7991263E18)
+
+(my-assert
+ (* 8.877933E9 7.973602E9)
+ 7.07891E19)
+
+(my-assert
+ (* -8.312081E9 -8.941637E9)
+ 7.432361E19)
+
+(my-assert
+ (* -4.297749E9 9.913122E9)
+ -4.260411E19)
+
+(my-assert
+ (* -7.893335E9 -4.7961794E-11)
+ 0.3785785)
+
+(my-assert
+ (* -4.1332334E9 7.221582E-11)
+ -0.29848483)
+
+(my-assert
+ (* 1.9981688E9 2.8169871E-11)
+ 0.056288157)
+
+(my-assert
+ (* -5.8555295E9 -7.562528E-11)
+ 0.44282603)
+
+(my-assert
+ (* 7.377872E9 -1.5020383E-11)
+ -0.11081846)
+
+(my-assert
+ (* 8.891134E9 -7.035395E-11)
+ -0.6255264)
+
+(my-assert
+ (* -7.1412096E9 5.1873507E19)
+ -3.7043958E29)
+
+(my-assert
+ (* 8.0983844E9 9.136914E19)
+ 7.399425E29)
+
+(my-assert
+ (* -6.1437537E9 -9.398771E19)
+ 5.7743737E29)
+
+(my-assert
+ (* -2.3000973E9 6.8743785E19)
+ -1.5811739E29)
+
+(my-assert
+ (* 3.5817969E9 -6.0353143E19)
+ -2.161727E29)
+
+(my-assert
+ (* 6.544234E9 8.265139E19)
+ 5.4089003E29)
+
+(my-assert
+ (* 2.1273733E8 -2.3684083E-21)
+ -5.0384886E-13)
+
+(my-assert
+ (* -4.2644698E9 2.956708E-21)
+ -1.2608792E-11)
+
+(my-assert
+ (* -5.1238026E9 5.341445E-21)
+ -2.7368509E-11)
+
+(my-assert
+ (* -3.0125368E9 5.201843E-21)
+ -1.5670742E-11)
+
+(my-assert
+ (* -4.4709827E9 -1.5399217E-22)
+ 6.8849635E-13)
+
+(my-assert
+ (* -4.934225E9 5.9229795E-21)
+ -2.9225313E-11)
+
+(my-assert
+ (* -2.1100623E-11 0.9615048)
+ -2.028835E-11)
+
+(my-assert
+ (* 6.6090705E-12 0.4100405)
+ 2.7099865E-12)
+
+(my-assert
+ (* -9.541609E-11 0.82497185)
+ -7.871559E-11)
+
+(my-assert
+ (* -2.7884627E-11 -0.5218528)
+ 1.4551671E-11)
+
+(my-assert
+ (* 9.180904E-13 -0.26436818)
+ -2.4271386E-13)
+
+(my-assert
+ (* 2.6154882E-11 0.2004636)
+ 5.2431015E-12)
+
+(my-assert
+ (* 9.751009E-11 -7.0098227E9)
+ -0.6835284)
+
+(my-assert
+ (* -1.312651E-11 1.9450307E8)
+ -0.0025531466)
+
+(my-assert
+ (* -4.591856E-11 -4.6141565E8)
+ 0.021187542)
+
+(my-assert
+ (* -4.1950752E-11 -9.55923E9)
+ 0.4010169)
+
+(my-assert
+ (* -2.1888996E-11 9.976215E9)
+ -0.21836932)
+
+(my-assert
+ (* 4.2696267E-11 -7.927695E9)
+ -0.33848298)
+
+(my-assert
+ (* 1.9615304E-11 -5.3584637E-12)
+ -1.05107896E-22)
+
+(my-assert
+ (* -8.7289814E-11 3.4389686E-11)
+ -3.0018693E-21)
+
+(my-assert
+ (* 6.8621386E-11 -1.4248663E-11)
+ -9.77763E-22)
+
+(my-assert
+ (* -9.5643375E-11 -7.7591066E-11)
+ 7.421071E-21)
+
+(my-assert
+ (* -6.3313584E-11 5.173857E-11)
+ -3.2757542E-21)
+
+(my-assert
+ (* -6.968663E-11 -4.966581E-12)
+ 3.461043E-22)
+
+(my-assert
+ (* 7.942278E-11 -3.1309486E19)
+ -2.4866865E9)
+
+(my-assert
+ (* 1.7023414E-11 2.5512804E19)
+ 4.34315E8)
+
+(my-assert
+ (* 2.6554937E-11 9.146128E19)
+ 2.4287485E9)
+
+(my-assert
+ (* 9.309172E-13 -3.6298406E19)
+ -3.3790812E7)
+
+(my-assert
+ (* -6.106873E-11 3.5271824E18)
+ -2.1540056E8)
+
+(my-assert
+ (* -2.8420502E-11 -6.6643682E19)
+ 1.8940468E9)
+
+(my-assert
+ (* -5.84991E-11 1.5304011E-21)
+ -8.952709E-32)
+
+(my-assert
+ (* 6.30787E-11 -9.366236E-21)
+ -5.9081004E-31)
+
+(my-assert
+ (* 1.9745445E-11 7.034156E-21)
+ 1.3889253E-31)
+
+(my-assert
+ (* 2.440728E-11 6.50959E-22)
+ 1.5888139E-32)
+
+(my-assert
+ (* 6.0243255E-11 -1.7734902E-21)
+ -1.0684082E-31)
+
+(my-assert
+ (* 1.0381073E-11 7.167948E-21)
+ 7.441099E-32)
+
+(my-assert
+ (* 6.3378214E18 0.022634745)
+ 1.43454966E17)
+
+(my-assert
+ (* 5.4942345E19 0.26696533)
+ 1.4667702E19)
+
+(my-assert
+ (* 9.807893E19 -0.99720424)
+ -9.780473E19)
+
+(my-assert
+ (* -7.1504E18 0.045440495)
+ -3.249177E17)
+
+(my-assert
+ (* -7.265508E19 0.37276286)
+ -2.7083115E19)
+
+(my-assert
+ (* 9.3705245E19 0.6617385)
+ 6.200837E19)
+
+(my-assert
+ (* 7.768628E19 1.37205E9)
+ 1.0658947E29)
+
+(my-assert
+ (* 1.5640021E18 9.344063E9)
+ 1.4614135E28)
+
+(my-assert
+ (* 3.8593804E19 -9.424651E8)
+ -3.6373312E28)
+
+(my-assert
+ (* -9.23689E19 -6.980498E9)
+ 6.447809E29)
+
+(my-assert
+ (* 7.926599E19 5.0871127E9)
+ 4.0323505E29)
+
+(my-assert
+ (* 3.540541E19 -5.11486E9)
+ -1.810937E29)
+
+(my-assert
+ (* -7.023858E19 6.959093E-11)
+ -4.8879683E9)
+
+(my-assert
+ (* -2.0809586E19 -4.045683E-12)
+ 8.418899E7)
+
+(my-assert
+ (* 5.3608545E19 -7.0354486E-11)
+ -3.7716017E9)
+
+(my-assert
+ (* 8.974303E19 -6.383404E-11)
+ -5.72866E9)
+
+(my-assert
+ (* -6.8900017E19 9.845904E-11)
+ -6.7838295E9)
+
+(my-assert
+ (* 9.325442E19 -3.9829796E-11)
+ -3.7143045E9)
+
+(my-assert
+ (* 5.9436735E19 -5.713992E-21)
+ -0.33962104)
+
+(my-assert
+ (* 7.266224E18 8.9780915E-21)
+ 0.06523682)
+
+(my-assert
+ (* -3.6717237E18 3.3338123E-21)
+ -0.012240837)
+
+(my-assert
+ (* 4.119367E19 -7.309974E-21)
+ -0.30112466)
+
+(my-assert
+ (* -8.453134E19 4.6281215E-22)
+ -0.03912213)
+
+(my-assert
+ (* -3.7493624E19 5.480264E-21)
+ -0.20547494)
+
+(my-assert
+ (* 6.3693945E-21 -0.25352144)
+ -1.6147781E-21)
+
+(my-assert
+ (* -8.51531E-21 0.6031129)
+ -5.135693E-21)
+
+(my-assert
+ (* -9.771993E-21 0.2740926)
+ -2.678431E-21)
+
+(my-assert
+ (* -4.2903415E-21 0.5916119)
+ -2.5382172E-21)
+
+(my-assert
+ (* -3.7330673E-21 0.9738175)
+ -3.6353263E-21)
+
+(my-assert
+ (* 5.860415E-21 -0.9997709)
+ -5.8590725E-21)
+
+(my-assert
+ (* -9.4827234E-21 7.6195564E9)
+ -7.225415E-11)
+
+(my-assert
+ (* 5.9501194E-21 9.102942E9)
+ 5.4163594E-11)
+
+(my-assert
+ (* 2.8867428E-21 -9.615872E9)
+ -2.7758549E-11)
+
+(my-assert
+ (* 5.0077543E-21 7.8715663E9)
+ 3.941887E-11)
+
+(my-assert
+ (* 7.082003E-21 4.5221494E9)
+ 3.2025875E-11)
+
+(my-assert
+ (* -2.9215627E-21 5.131017E9)
+ -1.4990589E-11)
+
+(my-assert
+ (* -9.1914904E-21 -2.3301847E-11)
+ 2.141787E-31)
+
+(my-assert
+ (* 1.3389891E-21 -7.032628E-11)
+ -9.4166125E-32)
+
+(my-assert
+ (* -8.540776E-21 3.052019E-11)
+ -2.6066613E-31)
+
+(my-assert
+ (* -2.7608417E-21 -6.8345785E-12)
+ 1.886919E-32)
+
+(my-assert
+ (* 1.2978333E-21 -2.1870255E-12)
+ -2.8383944E-33)
+
+(my-assert
+ (* 8.2235335E-23 -3.5080876E-11)
+ -2.8848876E-33)
+
+(my-assert
+ (* -3.958064E-21 8.038726E19)
+ -0.3181779)
+
+(my-assert
+ (* 7.752178E-21 1.0747784E19)
+ 0.08331874)
+
+(my-assert
+ (* -5.5964265E-21 -8.700492E19)
+ 0.48691663)
+
+(my-assert
+ (* 3.2236927E-21 3.6203593E19)
+ 0.116709255)
+
+(my-assert
+ (* -6.308517E-21 -3.8032156E19)
+ 0.2399265)
+
+(my-assert
+ (* 4.8663387E-21 9.008218E19)
+ 0.43837038)
+
+;;  ---- Test von FLOOR ---
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.8227301 -0.25283414))
+ (3 -0.06422769))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.6686161 0.4833234))
+ (-2 0.29803064))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.57436657 0.52642506))
+ (-2 0.47848356))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.60395426 -0.61624163))
+ (-1 -0.012287392))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.21636301 0.90365344))
+ (-1 0.68729043))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.8705054 -0.7953333))
+ (-2 -0.72016126))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.4544462 -9.890925E9))
+ (-1 -9.890925E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.4954149 -3.8786918E9))
+ (0 -0.49541488))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.692049 6.4791506E9))
+ (-1 6.4791506E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.75464755 -3.618496E9))
+ (-1 -3.618496E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.5929247 -5.442471E9))
+ (0 -0.5929247))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.30383867 9.262864E9))
+ (-1 9.262864E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.9345329 3.26737E-11))
+ (28601991168 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.3772617 -7.991702E-11))
+ (-4720667648 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.74438447 -1.0977978E-11))
+ (-67807064064 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.9220973 -1.2655998E-11))
+ (72858525696 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.4615329 6.48833E-11))
+ (-7113276928 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.2851941 -8.262349E-11))
+ (-3451731456 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.61539984 3.5826177E19))
+ (0 0.61539984))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.8195054 8.793426E19))
+ (-1 8.793426E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.26412165 7.015103E18))
+ (-1 7.015103E18))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.527393 8.434833E19))
+ (-1 8.434833E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.1846056 1.8252128E19))
+ (-1 1.8252128E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.6079822 6.106683E19))
+ (-1 6.106683E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.5564819 5.953872E-21))
+ (93465542827563810816 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.52575815 -1.8358678E-21))
+ (286381261476583178240 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.6321403 -5.830945E-21))
+ (108411292344853200896 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.9675891 -9.936226E-21))
+ (97379936163841703936 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.63503754 -5.0137436E-21))
+ (126659359065470140416 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.8053654 -3.4055888E-22))
+ (-2364834534832713236480 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.784645E9 0.9775517))
+ (8986374144 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.314413E9 -0.8318871))
+ (11196726272 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.4695936E9 -0.9823455))
+ (-8621807616 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.8406625E9 -0.031723082))
+ (184113971200 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.325545E9 0.93169844))
+ (-7862571008 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.2999526E9 0.11515945))
+ (-46022733824 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.680458E9 7.170729E9))
+ (0 6.680458E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.2146278E9 5.2909993E9))
+ (-1 3.0763715E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.4947005E9 3.1265188E9))
+ (2 2.4166298E8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.947109E9 2.464481E9))
+ (3 5.53666E8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.899791E9 3.5788132E9))
+ (2 1.7421644E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.272568E9 -5.3260964E9))
+ (-1 -5.3528532E7))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.729838E8 8.6379175E-11))
+ (11264101901890748416 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.210882E9 -4.412428E-11))
+ (-27442532596777484288 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.169561E9 -9.41537E-11))
+ (-97389277614631288832 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.289745E9 3.1269442E-11))
+ (297087021478284623872 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.334722E9 2.0158666E-11))
+ (-264636651022615314432 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.910798E9 -2.985589E-11))
+ (-331954558296456691712 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.7169357E9 2.220112E19))
+ (-1 2.220112E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.9906683E9 6.857979E19))
+ (0 4.9906683E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.90463E9 -2.342953E19))
+ (0 -9.90463E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.4878054E8 5.438576E19))
+ (-1 5.438576E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.1080986E9 9.25119E19))
+ (-1 9.25119E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.4138286E9 -9.682224E19))
+ (0 -8.4138286E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.7084977E9 2.542436E-23))
+ (106531597407755826831748572905472 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.720767E9 9.438407E-21))
+ (-606115738076318963177881600000 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.4958034E9 9.250327E-21))
+ (-377911344579488968728001904640 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.3702047E9 6.0186186E-21))
+ (-1390718493086361392338557730816 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.517619E9 -9.417701E-21))
+ (798243593937800371539149848576 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.1220838E9 3.931208E-21))
+ (-539804494597454582830132625408 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.9606828E-11 0.34267086))
+ (-1 0.34267086))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.495503E-11 -0.4518087))
+ (-1 -0.4518087))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.98698E-11 -0.5665642))
+ (0 -7.98698E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.1465689E-11 0.17276591))
+ (0 2.146569E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.9463066E-11 -0.5659616))
+ (-1 -0.5659616))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.8961567E-11 -0.7758364))
+ (0 -1.8961567E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.8871874E-11 -5.768549E9))
+ (-1 -5.768549E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.079439E-11 -3.807195E9))
+ (0 -9.079439E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.879919E-12 -1.9198149E9))
+ (-1 -1.9198149E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.389072E-11 -8.657572E9))
+ (-1 -8.657572E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.430157E-11 -3.8599355E9))
+ (-1 -3.8599355E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.8839114E-11 -5.3409536E9))
+ (0 -5.8839114E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.3353615E-11 8.9096924E-11))
+ (-1 5.574331E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.335122E-11 3.606541E-11))
+ (1 2.7285809E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.6885465E-11 7.070333E-12))
+ (-9 6.7475353E-12))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.581576E-11 -3.4334775E-11))
+ (2 -7.1462155E-12))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.6686505E-11 -1.9221425E-11))
+ (-2 -1.7563462E-12))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.066395E-11 -2.3198866E-11))
+ (-2 -1.573378E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.1089344E-11 7.429058E19))
+ (0 9.1089344E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.2265194E-11 -6.5831596E19))
+ (0 -7.2265194E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.9087675E-11 1.9182038E19))
+ (-1 1.9182038E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.907188E-11 4.405831E19))
+ (-1 4.405831E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.118759E-11 3.4342181E19))
+ (0 6.118759E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.4731882E-11 -5.861447E19))
+ (-1 -5.861447E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.121101E-11 -1.8234462E-21))
+ (-33568860160 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.788758E-11 -2.65478E-21))
+ (-36872200192 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.827001E-11 -8.5754775E-21))
+ (-9127189504 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.738018E-11 -7.810784E-21))
+ (4785714176 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.31308E-11 -2.0431058E-21))
+ (-35793936384 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.4578095E-11 -3.0466443E-21))
+ (-31043366912 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.8186137E19 -0.95250696))
+ (50588749896299315200 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.548003E18 -0.9061317))
+ (-10537102614582001664 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.5254813E19 0.51959753))
+ (106341562860634636288 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.2787504E19 0.14769173))
+ (-289708190148186865664 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.27109E17 -0.03677529))
+ (11614021477430460416 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.9238043E19 0.26663417))
+ (-147160597790283792384 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.0174873E19 -6.7035556E7))
+ (300957794304 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.6296811E19 -7.2014956E9))
+ (-2262976000 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.794499E19 -7.412829E9))
+ (-10514876416 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.2546485E19 6.1565005E9))
+ (-2037924864 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.4549757E18 -4.778849E9))
+ (-1141483264 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.9214324E18 3.0002557E9))
+ (-2973557248 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.790958E19 -8.224902E-11))
+ (-1068822197453670185020302557184 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.029222E18 1.3127345E-11))
+ (687817816164697187548814901248 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.7356843E19 -9.1816894E-11))
+ (-733599685837775742566290948096 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.0346153E19 2.0593792E-11))
+ (1959141510822234462049892564992 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.3402778E19 -4.8733902E-11))
+ (-275019611403690085233016700928 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.3005549E19 5.6579824E-11))
+ (-229861963021783171398467846144 0.0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.550302E19 6.4624324E19))
+ (1 2.0878699E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.7897585E19 -1.5724218E19))
+ (-4 -1.4999288E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.6050445E19 1.4007867E19))
+ (-7 1.2004627E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.0799387E19 -5.667626E19))
+ (1 -4.1231221E18))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.847746E19 -3.972193E19))
+ (1 -3.875553E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.425414E19 3.0601436E19))
+ (-3 2.7550168E19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.8220074E-21 -0.9401483))
+ (-1 -0.9401483))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.867747E-21 0.86288685))
+ (0 9.867747E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.2856053E-21 -0.5235996))
+ (-1 -0.5235996))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.709991E-22 0.42678982))
+ (0 8.709991E-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.0493481E-21 0.9355661))
+ (0 1.0493481E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.137466E-21 0.4328317))
+ (-1 0.4328317))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.5872774E-21 -8.80464E9))
+ (-1 -8.80464E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.0479629E-22 -9.353607E9))
+ (0 -1.0479629E-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.636932E-21 9.794678E9))
+ (-1 9.794678E9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.912024E-21 -2.9102356E9))
+ (0 -7.912024E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.0071349E-21 8.762459E9))
+ (0 1.0071349E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.795979E-21 -9.445545E9))
+ (0 -6.795979E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.0598967E-22 -3.961637E-11))
+ (-1 -3.961637E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.481348E-21 -7.485006E-11))
+ (-1 -7.485006E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.610974E-21 -4.073898E-11))
+ (0 -5.610974E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.2362584E-21 8.403202E-11))
+ (-1 8.403202E-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.2029927E-21 7.823452E-11))
+ (0 4.2029927E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.765272E-21 -8.502908E-11))
+ (0 -7.765272E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.7845436E-21 3.490416E-21))
+ (0 2.7845436E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.4630091E-21 9.193901E-21))
+ (-1 7.730892E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.1823826E-21 8.941324E-21))
+ (-1 7.5894165E-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.8218875E-21 3.8057304E-21))
+ (-1 1.9838427E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.8037763E-21 -5.1721612E-21))
+ (-2 -4.5405462E-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.179982E-21 6.2204556E-21))
+ (-2 4.2609293E-21))
+
+;;  ---- Test von / ---
+
+(my-assert
+ (/ 0.73739415 0.6416277)
+ 1.1492554)
+
+(my-assert
+ (/ 0.6736158 -0.25522494)
+ -2.6393025)
+
+(my-assert
+ (/ -0.44216943 0.31134832)
+ -1.420176)
+
+(my-assert
+ (/ -0.7041118 -0.26929635)
+ 2.6146355)
+
+(my-assert
+ (/ 0.3573562 0.73521775)
+ 0.4860549)
+
+(my-assert
+ (/ -0.7661392 0.77110463)
+ -0.9935606)
+
+(my-assert
+ (/ -0.91306114 1.6586358E9)
+ -5.504892E-10)
+
+(my-assert
+ (/ -0.68994707 4.0230333E8)
+ -1.7149921E-9)
+
+(my-assert
+ (/ 0.28498656 -7.617844E9)
+ -3.7410394E-11)
+
+(my-assert
+ (/ -0.72419757 -9.226896E9)
+ 7.848767E-11)
+
+(my-assert
+ (/ 0.8352187 8.3102536E9)
+ 1.00504605E-10)
+
+(my-assert
+ (/ 0.9707725 3.3669448E9)
+ 2.8832445E-10)
+
+(my-assert
+ (/ 0.50785017 6.048824E-11)
+ 8.3958497E9)
+
+(my-assert
+ (/ -0.17675805 4.1391092E-11)
+ -4.270437E9)
+
+(my-assert
+ (/ -0.42162335 -4.4007357E-11)
+ 9.580747E9)
+
+(my-assert
+ (/ -7.945299E-4 -5.4965265E-11)
+ 1.4455128E7)
+
+(my-assert
+ (/ -0.65178335 -9.78151E-12)
+ 6.6634228E10)
+
+(my-assert
+ (/ -0.6209788 -3.8544803E-11)
+ 1.611057E10)
+
+(my-assert
+ (/ 0.94332725 -4.9823833E19)
+ -1.8933253E-20)
+
+(my-assert
+ (/ 0.30150706 -4.9741757E19)
+ -6.061448E-21)
+
+(my-assert
+ (/ -0.8478371 -9.85865E18)
+ 8.5999306E-20)
+
+(my-assert
+ (/ -0.28524554 3.1389898E19)
+ -9.087176E-21)
+
+(my-assert
+ (/ -0.5260848 -7.936286E19)
+ 6.6288534E-21)
+
+(my-assert
+ (/ -0.12941593 -5.3575864E19)
+ 2.415564E-21)
+
+(my-assert
+ (/ -0.20859545 -9.867267E-21)
+ 2.1140145E19)
+
+(my-assert
+ (/ 0.35158414 -8.2825064E-22)
+ -4.2449002E20)
+
+(my-assert
+ (/ -0.05635804 -2.2999601E-21)
+ 2.450392E19)
+
+(my-assert
+ (/ -0.003138721 -3.3988403E-21)
+ 9.234682E17)
+
+(my-assert
+ (/ -0.91386896 -5.8199337E-21)
+ 1.5702395E20)
+
+(my-assert
+ (/ -0.5374476 2.256708E-21)
+ -2.3815556E20)
+
+(my-assert
+ (/ 1.9669795E9 -0.58137333)
+ -3.3833329E9)
+
+(my-assert
+ (/ -8.9879334E8 0.35829848)
+ -2.5085046E9)
+
+(my-assert
+ (/ -9.057627E9 0.4849478)
+ -1.867753E10)
+
+(my-assert
+ (/ 3.687799E8 -0.34055912)
+ -1.082866E9)
+
+(my-assert
+ (/ -5.1049994E9 -0.16858816)
+ 3.0280888E10)
+
+(my-assert
+ (/ -4.512774E9 0.9385354)
+ -4.8083154E9)
+
+(my-assert
+ (/ -1.9312024E9 -8.3940613E9)
+ 0.2300677)
+
+(my-assert
+ (/ -8.2104387E9 6.769607E9)
+ -1.2128383)
+
+(my-assert
+ (/ -6.9613486E9 4.576518E9)
+ -1.5211015)
+
+(my-assert
+ (/ -1.486333E9 1.2476433E9)
+ -1.1913126)
+
+(my-assert
+ (/ -7.653413E9 5.167656E9)
+ -1.4810221)
+
+(my-assert
+ (/ -2.9815204E9 8.942396E9)
+ -0.33341402)
+
+(my-assert
+ (/ 9.304549E9 -5.8002263E-11)
+ -1.60417E20)
+
+(my-assert
+ (/ -2.0750719E9 1.272735E-11)
+ -1.6304037E20)
+
+(my-assert
+ (/ -1.1557549E9 -7.2220556E-11)
+ 1.6003129E19)
+
+(my-assert
+ (/ -3.3273495E9 -9.9207274E-11)
+ 3.353937E19)
+
+(my-assert
+ (/ -3.2167434E9 7.7474506E-11)
+ -4.1520026E19)
+
+(my-assert
+ (/ 4.4169416E9 -4.638272E-11)
+ -9.5228166E19)
+
+(my-assert
+ (/ -3.732909E9 -2.2763849E18)
+ 1.6398409E-9)
+
+(my-assert
+ (/ -6.243126E9 -4.1274483E19)
+ 1.5125873E-10)
+
+(my-assert
+ (/ 4.7162563E9 -7.524631E19)
+ -6.267758E-11)
+
+(my-assert
+ (/ -1.3657349E9 7.728982E19)
+ -1.7670308E-11)
+
+(my-assert
+ (/ -4.6216906E8 -7.972877E19)
+ 5.7967663E-12)
+
+(my-assert
+ (/ 4.4542986E9 3.1531836E19)
+ 1.4126353E-10)
+
+(my-assert
+ (/ 1.4738977E9 -9.8130876E-21)
+ -1.5019714E29)
+
+(my-assert
+ (/ -5.918336E9 2.9877495E-21)
+ -1.9808676E30)
+
+(my-assert
+ (/ -3.7166292E9 -1.0826009E-21)
+ 3.433056E30)
+
+(my-assert
+ (/ 7.390683E9 -2.1678685E-22)
+ -3.4091935E31)
+
+(my-assert
+ (/ 6.2302886E8 8.9466635E-21)
+ 6.963812E28)
+
+(my-assert
+ (/ 5.2357125E9 4.854464E-22)
+ 1.0785356E31)
+
+(my-assert
+ (/ -2.7721167E-11 0.99550104)
+ -2.7846447E-11)
+
+(my-assert
+ (/ 5.754337E-11 -0.6344538)
+ -9.06975E-11)
+
+(my-assert
+ (/ -7.663363E-11 0.020810604)
+ -3.6824317E-9)
+
+(my-assert
+ (/ 3.2576632E-11 0.6209498)
+ 5.2462586E-11)
+
+(my-assert
+ (/ -9.507874E-11 -0.19174337)
+ 4.958645E-10)
+
+(my-assert
+ (/ -9.681176E-11 -0.82680905)
+ 1.1709084E-10)
+
+(my-assert
+ (/ 6.458532E-11 3.442031E8)
+ 1.8763725E-19)
+
+(my-assert
+ (/ 1.9113166E-11 -7.0712125E9)
+ -2.7029546E-21)
+
+(my-assert
+ (/ -2.0099402E-12 2.600844E9)
+ -7.7280303E-22)
+
+(my-assert
+ (/ -4.9634992E-12 8.041176E9)
+ -6.1726036E-22)
+
+(my-assert
+ (/ 3.2738747E-12 7.299675E9)
+ 4.484959E-22)
+
+(my-assert
+ (/ 9.133733E-12 -2.6318538E9)
+ -3.470456E-21)
+
+(my-assert
+ (/ -3.4146054E-11 -1.5331155E-11)
+ 2.227233)
+
+(my-assert
+ (/ 6.06336E-11 4.3750472E-11)
+ 1.385896)
+
+(my-assert
+ (/ -4.229064E-11 -9.169808E-11)
+ 0.4611944)
+
+(my-assert
+ (/ 6.166104E-11 -3.5474658E-11)
+ -1.7381715)
+
+(my-assert
+ (/ -3.979801E-11 -1.9510412E-11)
+ 2.0398343)
+
+(my-assert
+ (/ 9.726933E-11 -5.6926824E-11)
+ -1.7086731)
+
+(my-assert
+ (/ 8.041786E-11 2.3718388E19)
+ 3.3905282E-30)
+
+(my-assert
+ (/ -6.747094E-11 -6.7324465E19)
+ 1.0021756E-30)
+
+(my-assert
+ (/ -3.0713255E-11 -4.8310887E19)
+ 6.357419E-31)
+
+(my-assert
+ (/ -2.8496396E-11 -4.9017306E19)
+ 5.813538E-31)
+
+(my-assert
+ (/ -9.354275E-12 -9.035095E19)
+ 1.0353266E-31)
+
+(my-assert
+ (/ 4.9274265E-12 7.241873E19)
+ 6.8040775E-32)
+
+(my-assert
+ (/ -4.377009E-11 7.138917E-21)
+ -6.131195E9)
+
+(my-assert
+ (/ 9.422678E-12 -5.8862136E-21)
+ -1.6008046E9)
+
+(my-assert
+ (/ -6.83782E-11 -3.6098812E-21)
+ 1.8941952E10)
+
+(my-assert
+ (/ -8.1755075E-11 -6.8725736E-21)
+ 1.1895846E10)
+
+(my-assert
+ (/ -6.360949E-11 4.2976342E-21)
+ -1.4801049E10)
+
+(my-assert
+ (/ 3.3879413E-11 -1.7169743E-21)
+ -1.9732044E10)
+
+(my-assert
+ (/ -9.948093E18 -0.8695114)
+ 1.1441014E19)
+
+(my-assert
+ (/ 6.2748975E19 -0.94829553)
+ -6.6170272E19)
+
+(my-assert
+ (/ -6.204444E18 0.6874813)
+ -9.0248915E18)
+
+(my-assert
+ (/ 6.7599936E19 -0.45808762)
+ -1.4756988E20)
+
+(my-assert
+ (/ 7.624068E19 0.008471012)
+ 9.0001855E21)
+
+(my-assert
+ (/ 8.342225E19 -0.3031574)
+ -2.7517803E20)
+
+(my-assert
+ (/ -6.3366795E19 -1.4882481E9)
+ 4.2578113E10)
+
+(my-assert
+ (/ -1.7335874E19 -7.42875E9)
+ 2.3336195E9)
+
+(my-assert
+ (/ -8.662651E19 1.0327226E9)
+ -8.388168E10)
+
+(my-assert
+ (/ -4.9590965E19 8.334462E9)
+ -5.95011E9)
+
+(my-assert
+ (/ 8.191562E18 5.930472E9)
+ 1.3812664E9)
+
+(my-assert
+ (/ -3.5910857E19 -7.342098E9)
+ 4.8910894E9)
+
+(my-assert
+ (/ -3.6083056E19 5.7372277E-11)
+ -6.2892843E29)
+
+(my-assert
+ (/ 2.2896613E19 -4.541202E-11)
+ -5.0419717E29)
+
+(my-assert
+ (/ 6.1438805E19 8.512014E-11)
+ 7.217893E29)
+
+(my-assert
+ (/ 6.3211746E19 -6.185377E-12)
+ -1.0219547E31)
+
+(my-assert
+ (/ 4.5452835E18 2.0429606E-11)
+ 2.2248514E29)
+
+(my-assert
+ (/ 9.226608E19 1.3297486E-11)
+ 6.9386104E30)
+
+(my-assert
+ (/ 1.8852943E19 -1.623413E19)
+ -1.1613153)
+
+(my-assert
+ (/ -3.117305E18 -9.5760065E19)
+ 0.03255329)
+
+(my-assert
+ (/ -7.719376E19 3.3627052E19)
+ -2.295585)
+
+(my-assert
+ (/ 3.1309093E19 -7.820006E19)
+ -0.4003717)
+
+(my-assert
+ (/ 3.941958E19 -9.51598E19)
+ -0.41424614)
+
+(my-assert
+ (/ -3.6364467E19 -1.0757047E19)
+ 3.380525)
+
+(my-assert
+ (/ 2.906561E17 -8.595159E-21)
+ -3.3816258E37)
+
+(my-assert
+ (/ -7.826226E-21 -0.21695328)
+ 3.6073327E-20)
+
+(my-assert
+ (/ -1.888169E-21 0.5031878)
+ -3.7524144E-21)
+
+(my-assert
+ (/ 8.304594E-21 -0.3528648)
+ -2.3534775E-20)
+
+(my-assert
+ (/ -8.441606E-21 -0.3639353)
+ 2.3195348E-20)
+
+(my-assert
+ (/ -7.815205E-21 0.38263506)
+ -2.0424697E-20)
+
+(my-assert
+ (/ -3.2837188E-21 0.46961308)
+ -6.992392E-21)
+
+(my-assert
+ (/ -5.1739832E-21 -3.8917279E9)
+ 1.3294822E-30)
+
+(my-assert
+ (/ -5.3318596E-21 -7.1995423E9)
+ 7.405831E-31)
+
+(my-assert
+ (/ -7.4979364E-22 9.148773E9)
+ -8.195565E-32)
+
+(my-assert
+ (/ 4.6800053E-21 3.9532006E8)
+ 1.1838522E-29)
+
+(my-assert
+ (/ 4.914653E-22 -2.414465E9)
+ -2.035504E-31)
+
+(my-assert
+ (/ 5.4722133E-21 -9.977777E9)
+ -5.484401E-31)
+
+(my-assert
+ (/ 9.815656E-21 6.059642E-11)
+ 1.619841E-10)
+
+(my-assert
+ (/ 7.660357E-21 9.7074675E-11)
+ 7.891201E-11)
+
+(my-assert
+ (/ 9.77743E-21 2.5170428E-11)
+ 3.8844908E-10)
+
+(my-assert
+ (/ 8.818017E-21 1.18070545E-11)
+ 7.468431E-10)
+
+(my-assert
+ (/ 5.445426E-21 9.6208916E-11)
+ 5.6600016E-11)
+
+(my-assert
+ (/ 4.6823916E-21 -1.9853067E-11)
+ -2.358523E-10)
+
+(my-assert
+ (/ 9.347429E-21 -7.285392E-22)
+ -12.830372)
+
+(my-assert
+ (/ -7.304412E-21 6.766496E-21)
+ -1.079497)
+
+(my-assert
+ (/ -2.6850204E-21 6.894023E-21)
+ -0.38947076)
+
+(my-assert
+ (/ -2.24644E-21 -9.533858E-21)
+ 0.23562758)
+
+(my-assert
+ (/ -8.525939E-21 -9.961187E-22)
+ 8.559159)
+
+(my-assert
+ (/ 8.145676E-21 4.304153E-22)
+ 18.925154)
+
+;; ==== D O U B L E - F L O A T S ====
+
+;;  ---- Test von + ---
+
+(my-assert
+ (+ 0.6049332056786565d0 -0.9611373574853808d0)
+ -0.35620415180672427d0)
+
+(my-assert
+ (+ -0.4763715667865308d0 0.25936932107685584d0)
+ -0.21700224570967497d0)
+
+(my-assert
+ (+ 0.2666481927718355d0 -0.04984768063142031d0)
+ 0.21680051214041518d0)
+
+(my-assert
+ (+ -0.29478659758474846d0 0.3371004337672615d0)
+ 0.042313836182513054d0)
+
+(my-assert
+ (+ 0.8203063910979178d0 0.28968607542857916d0)
+ 1.109992466526497d0)
+
+(my-assert
+ (+ -0.08207985138263585d0 0.4368723951711785d0)
+ 0.35479254378854264d0)
+
+(my-assert
+ (+ -0.8659875373355486d0 -6.631430771196765d9)
+ -6.631430772062753d9)
+
+(my-assert
+ (+ 0.15071385783307878d0 -7.154424279496395d9)
+ -7.154424279345681d9)
+
+(my-assert
+ (+ -0.8969642760814789d0 -2.4070067380831727d8)
+ -2.4070067470528156d8)
+
+(my-assert
+ (+ -0.9610362081435054d0 9.070410778399954d9)
+ 9.070410777438917d9)
+
+(my-assert
+ (+ 0.5129052501104072d0 -7.47841120327471d9)
+ -7.478411202761805d9)
+
+(my-assert
+ (+ 0.3840242289740675d0 7.793048210060242d9)
+ 7.793048210444266d9)
+
+(my-assert
+ (+ 0.07603066126204616d0 5.215008470388369d-11)
+ 0.07603066131419625d0)
+
+(my-assert
+ (+ -0.17187858025312586d0 -5.116645189173968d-11)
+ -0.17187858030429232d0)
+
+(my-assert
+ (+ 0.2521315816245864d0 8.603210607505339d-11)
+ 0.2521315817106185d0)
+
+(my-assert
+ (+ -0.3557185853193914d0 -2.0371324697272998d-11)
+ -0.3557185853397627d0)
+
+(my-assert
+ (+ 0.7142792289542045d0 -7.106356053331326d-11)
+ 0.7142792288831409d0)
+
+(my-assert
+ (+ 0.4380415886629452d0 -3.069969538383403d-11)
+ 0.43804158863224546d0)
+
+(my-assert
+ (+ 0.24798614227178573d0 3.972393639614975d19)
+ 3.972393639614975d19)
+
+(my-assert
+ (+ -0.5210677288128815d0 4.846393336901129d19)
+ 4.846393336901129d19)
+
+(my-assert
+ (+ 0.5825404819115d0 1.9710987361264255d19)
+ 1.9710987361264255d19)
+
+(my-assert
+ (+ 0.9105175208730549d0 2.391166552096775d19)
+ 2.391166552096775d19)
+
+(my-assert
+ (+ 0.48414423368371695d0 -9.696117779740095d19)
+ -9.696117779740095d19)
+
+(my-assert
+ (+ 0.25780758450697716d0 6.094683117025535d19)
+ 6.094683117025535d19)
+
+(my-assert
+ (+ 0.9824539149570484d0 -5.4680066990812835d-21)
+ 0.9824539149570484d0)
+
+(my-assert
+ (+ -0.9520982941158654d0 3.2513564801568073d-21)
+ -0.9520982941158654d0)
+
+(my-assert
+ (+ 0.0630170624560149d0 -9.858852595793203d-21)
+ 0.0630170624560149d0)
+
+(my-assert
+ (+ 0.24705141169888878d0 1.4582081178692862d-22)
+ 0.24705141169888878d0)
+
+(my-assert
+ (+ 0.7440948700757135d0 -3.0932442581890818d-21)
+ 0.7440948700757135d0)
+
+(my-assert
+ (+ -0.5055970869515372d0 4.0277457257516025d-21)
+ -0.5055970869515372d0)
+
+(my-assert
+ (+ 1.672355787134947d9 0.0064909681594120805d0)
+ 1.672355787141438d9)
+
+(my-assert
+ (+ -9.694504381396599d9 -0.8925470085542831d0)
+ -9.694504382289146d9)
+
+(my-assert
+ (+ -1.6695005924298635d9 -0.34426964741306d0)
+ -1.6695005927741332d9)
+
+(my-assert
+ (+ -6.085591212594774d9 0.5107956920100049d0)
+ -6.085591212083979d9)
+
+(my-assert
+ (+ 7.457486660952688d9 -0.4323787588338597d0)
+ 7.457486660520309d9)
+
+(my-assert
+ (+ -8.790796444526546d9 0.911415263281967d0)
+ -8.790796443615131d9)
+
+(my-assert
+ (+ 9.667548804251982d9 -1.266547751029956d8)
+ 9.540894029148987d9)
+
+(my-assert
+ (+ -6.169561898845145d9 9.627911197121864d9)
+ 3.458349298276719d9)
+
+(my-assert
+ (+ -9.870287253215279d9 9.004242781937655d8)
+ -8.969862975021513d9)
+
+(my-assert
+ (+ -8.175630881172554d9 -4.08632236263908d9)
+ -1.2261953243811634d10)
+
+(my-assert
+ (+ 2.9069444232153206d9 -7.961831315741894d9)
+ -5.054886892526573d9)
+
+(my-assert
+ (+ -7.003647401371184d9 -1.768371514817526d9)
+ -8.772018916188711d9)
+
+(my-assert
+ (+ -6.418847599138249d9 2.755257250162372d-11)
+ -6.418847599138249d9)
+
+(my-assert
+ (+ 2.3093152687241793d9 1.2205440142364766d-11)
+ 2.3093152687241793d9)
+
+(my-assert
+ (+ 8.634577667577518d9 -9.065714034538668d-11)
+ 8.634577667577518d9)
+
+(my-assert
+ (+ 1.711283212591781d9 -3.235019197733951d-11)
+ 1.711283212591781d9)
+
+(my-assert
+ (+ 2.583886638357791d9 -8.199109798920928d-11)
+ 2.583886638357791d9)
+
+(my-assert
+ (+ -7.517123950474774d9 5.2057802142431697d-11)
+ -7.517123950474774d9)
+
+(my-assert
+ (+ 3.266571938086574d9 -4.4782768261898355d19)
+ -4.478276825863179d19)
+
+(my-assert
+ (+ 2.1000389219899452d9 -8.547158903365463d19)
+ -8.54715890315546d19)
+
+(my-assert
+ (+ -3.9140926801217155d9 7.387959860641422d19)
+ 7.387959860250013d19)
+
+(my-assert
+ (+ -7.087607465790431d9 7.96875093387599d19)
+ 7.96875093316723d19)
+
+(my-assert
+ (+ -8.341000808926519d9 6.9360028397637304d19)
+ 6.93600283892963d19)
+
+(my-assert
+ (+ -5.507940634743809d9 9.760028858210094d19)
+ 9.7600288576593d19)
+
+(my-assert
+ (+ 8.492522971238823d9 -2.8253881864964467d-22)
+ 8.492522971238823d9)
+
+(my-assert
+ (+ 1.2731765723336241d9 -5.8473937102910264d-21)
+ 1.2731765723336241d9)
+
+(my-assert
+ (+ 9.654280758878323d9 -4.2332114049658973d-22)
+ 9.654280758878323d9)
+
+(my-assert
+ (+ -6.864618926120946d9 -1.245648314796599d-21)
+ -6.864618926120946d9)
+
+(my-assert
+ (+ -3.9916044043798673d8 1.697737588450543d-21)
+ -3.9916044043798673d8)
+
+(my-assert
+ (+ -7.818041624198686d9 4.635421587404246d-21)
+ -7.818041624198686d9)
+
+(my-assert
+ (+ 2.0609929543990767d-12 -0.2126306554359736d0)
+ -0.2126306554339126d0)
+
+(my-assert
+ (+ -1.5923091695877845d-11 0.515731533720818d0)
+ 0.515731533704895d0)
+
+(my-assert
+ (+ 4.794527092905871d-11 -0.9066947202676092d0)
+ -0.9066947202196639d0)
+
+(my-assert
+ (+ -8.63854477728633d-11 0.3122982022565777d0)
+ 0.3122982021701922d0)
+
+(my-assert
+ (+ -7.577966666552416d-11 -0.24137602092437593d0)
+ -0.2413760210001556d0)
+
+(my-assert
+ (+ -4.971730475882754d-11 -0.8202688719750202d0)
+ -0.8202688720247375d0)
+
+(my-assert
+ (+ -5.249369194379291d-11 -8.546120620321186d9)
+ -8.546120620321186d9)
+
+(my-assert
+ (+ 8.280786962526793d-11 5.758373397436368d9)
+ 5.758373397436368d9)
+
+(my-assert
+ (+ 6.370323595535815d-11 -8.470663335712393d9)
+ -8.470663335712393d9)
+
+(my-assert
+ (+ 3.59771226839467d-11 3.5042505440266216d8)
+ 3.5042505440266216d8)
+
+(my-assert
+ (+ -3.945501687396375d-11 -5.082779978069177d9)
+ -5.082779978069177d9)
+
+(my-assert
+ (+ 9.780590963267516d-11 -5.05591945120475d9)
+ -5.05591945120475d9)
+
+(my-assert
+ (+ 6.323293597096768d-11 -7.208898910487284d-11)
+ -8.85605313390516d-12)
+
+(my-assert
+ (+ -4.549781732354749d-11 -6.095452636416357d-11)
+ -1.0645234368771105d-10)
+
+(my-assert
+ (+ -5.372680267837374d-11 2.0748354219485134d-11)
+ -3.297844845888861d-11)
+
+(my-assert
+ (+ 3.550879553916665d-11 -4.374873254056574d-11)
+ -8.23993700139909d-12)
+
+(my-assert
+ (+ -6.746002242414832d-11 3.0803985031459436d-11)
+ -3.665603739268888d-11)
+
+(my-assert
+ (+ -7.902512161494214d-11 -8.907842858073236d-11)
+ -1.681035501956745d-10)
+
+(my-assert
+ (+ -4.1465935469350415d-11 6.244210696961323d19)
+ 6.244210696961323d19)
+
+(my-assert
+ (+ 4.921297536286578d-11 -1.694436650099881d19)
+ -1.694436650099881d19)
+
+(my-assert
+ (+ -7.879478980672654d-11 6.41757969360492d19)
+ 6.41757969360492d19)
+
+(my-assert
+ (+ -8.200749317872953d-11 -9.490225542618815d19)
+ -9.490225542618815d19)
+
+(my-assert
+ (+ -7.572981329795812d-11 -3.350367078181029d19)
+ -3.350367078181029d19)
+
+(my-assert
+ (+ -5.955255565125549d-11 -5.009913629288125d19)
+ -5.009913629288125d19)
+
+(my-assert
+ (+ -9.818180775332558d-11 -7.926156011681593d-21)
+ -9.818180776125174d-11)
+
+(my-assert
+ (+ -5.2466438379505935d-12 8.468830229031857d-21)
+ -5.246643829481763d-12)
+
+(my-assert
+ (+ 3.582774358441715d-11 3.6865211729351863d-22)
+ 3.58277435847858d-11)
+
+(my-assert
+ (+ 7.169296413565744d-11 -9.974881413980864d-21)
+ 7.169296412568256d-11)
+
+(my-assert
+ (+ -9.615073655516977d-11 4.9552491300097786d-21)
+ -9.615073655021452d-11)
+
+(my-assert
+ (+ 6.7696956269187d-11 4.1431488006404866d-21)
+ 6.769695627333016d-11)
+
+(my-assert
+ (+ -4.663397365185298d19 0.9758464195927673d0)
+ -4.663397365185298d19)
+
+(my-assert
+ (+ -4.77977261393851d19 0.04145189313162445d0)
+ -4.77977261393851d19)
+
+(my-assert
+ (+ 7.195364554121596d19 0.5169917736820715d0)
+ 7.195364554121596d19)
+
+(my-assert
+ (+ -7.766254779507882d19 0.5919134938460356d0)
+ -7.766254779507882d19)
+
+(my-assert
+ (+ -8.411122653901408d19 -0.14463225181516137d0)
+ -8.411122653901408d19)
+
+(my-assert
+ (+ -9.101920591747218d19 0.23349918704239836d0)
+ -9.101920591747218d19)
+
+(my-assert
+ (+ 7.037477746142529d18 -3.250947575909365d9)
+ 7.037477742891581d18)
+
+(my-assert
+ (+ -6.864341752972099d19 -4.0510449339565725d9)
+ -6.864341753377203d19)
+
+(my-assert
+ (+ -5.329540273290228d19 8.14869777458878d9)
+ -5.329540272475358d19)
+
+(my-assert
+ (+ -9.726234388247201d19 2.053976989398215d9)
+ -9.726234388041803d19)
+
+(my-assert
+ (+ -1.910324088450308d19 6.247052535748024d9)
+ -1.910324087825603d19)
+
+(my-assert
+ (+ -6.079933001949367d18 6.316829148809886d9)
+ -6.079932995632539d18)
+
+(my-assert
+ (+ -4.499107911798452d19 9.659763881732633d-11)
+ -4.499107911798452d19)
+
+(my-assert
+ (+ -3.0972208018542522d19 -9.077209886078653d-11)
+ -3.0972208018542522d19)
+
+(my-assert
+ (+ -2.3000547840875442d19 -3.2043634522621155d-11)
+ -2.3000547840875442d19)
+
+(my-assert
+ (+ 2.124555308489292d19 2.252166800652451d-11)
+ 2.124555308489292d19)
+
+(my-assert
+ (+ -7.74280238703686d19 1.7289553748884322d-11)
+ -7.74280238703686d19)
+
+(my-assert
+ (+ -8.119446783121816d19 -4.3461802389685114d-11)
+ -8.119446783121816d19)
+
+(my-assert
+ (+ -4.70848534032654d18 -4.698316648967506d19)
+ -5.169165183000161d19)
+
+(my-assert
+ (+ 2.853799842810312d19 -5.56805968603395d19)
+ -2.7142598432236384d19)
+
+(my-assert
+ (+ -2.9128622996090335d19 -5.153369106520702d19)
+ -8.066231406129735d19)
+
+(my-assert
+ (+ -5.415993984772977d19 4.481932558278175d19)
+ -9.340614264948015d18)
+
+(my-assert
+ (+ -1.4652301908531261d19 7.89284449966826d19)
+ 6.427614308815133d19)
+
+(my-assert
+ (+ -8.241911630479252d19 5.377001886877124d19)
+ -2.8649097436021277d19)
+
+(my-assert
+ (+ -6.923631123395076d19 7.100129853298664d-22)
+ -6.923631123395076d19)
+
+(my-assert
+ (+ -5.864213410820717d19 -2.649878514627326d-21)
+ -5.864213410820717d19)
+
+(my-assert
+ (+ 8.660575002861176d19 2.751926085897399d-21)
+ 8.660575002861176d19)
+
+(my-assert
+ (+ -3.0252871646631318d19 6.852831573716124d-21)
+ -3.0252871646631318d19)
+
+(my-assert
+ (+ -9.155476807340938d19 -5.552907466957205d-21)
+ -9.155476807340938d19)
+
+(my-assert
+ (+ -4.03382621358461d19 6.670808279457885d-21)
+ -4.03382621358461d19)
+
+(my-assert
+ (+ 8.842980509187577d-21 0.5028466982188534d0)
+ 0.5028466982188534d0)
+
+(my-assert
+ (+ 1.7292043381396136d-21 0.19490424064972922d0)
+ 0.19490424064972922d0)
+
+(my-assert
+ (+ -5.854820918836103d-21 -0.6700030154364615d0)
+ -0.6700030154364615d0)
+
+(my-assert
+ (+ -2.152396491682048d-21 0.5002930268902921d0)
+ 0.5002930268902921d0)
+
+(my-assert
+ (+ -1.0897149666610629d-21 0.16555534170490604d0)
+ 0.16555534170490604d0)
+
+(my-assert
+ (+ 6.321421497987867d-24 -0.08008112131564671d0)
+ -0.08008112131564671d0)
+
+(my-assert
+ (+ -6.1552667309563055d-21 7.235074489769488d9)
+ 7.235074489769488d9)
+
+(my-assert
+ (+ -2.2311335001219955d-22 1.220011008333989d9)
+ 1.220011008333989d9)
+
+(my-assert
+ (+ 8.523565724937177d-23 -4.1650242034123087d9)
+ -4.1650242034123087d9)
+
+(my-assert
+ (+ -2.4400041303825447d-21 4.435554678685388d9)
+ 4.435554678685388d9)
+
+(my-assert
+ (+ -3.4479065449345757d-22 8.491084033112451d8)
+ 8.491084033112451d8)
+
+(my-assert
+ (+ -7.919939059912893d-21 -7.610637842585286d9)
+ -7.610637842585286d9)
+
+(my-assert
+ (+ 4.4958602369105625d-21 5.758376768873417d-11)
+ 5.7583767693230034d-11)
+
+(my-assert
+ (+ 2.4375297386412195d-21 9.417086717671841d-11)
+ 9.417086717915595d-11)
+
+(my-assert
+ (+ 1.0040647133383462d-21 3.4701016271268983d-12)
+ 3.470101628130963d-12)
+
+(my-assert
+ (+ -3.885093055726793d-21 -8.523534862249969d-11)
+ -8.523534862638479d-11)
+
+(my-assert
+ (+ 1.027951323422187d-21 -7.65508060829868d-11)
+ -7.655080608195885d-11)
+
+(my-assert
+ (+ -9.83813940552434d-21 -5.048380063082019d-11)
+ -5.0483800640658324d-11)
+
+(my-assert
+ (+ -7.640856498925806d-21 -5.743808556015994d19)
+ -5.743808556015994d19)
+
+(my-assert
+ (+ 8.053891045717591d-21 4.0840032650134725d19)
+ 4.0840032650134725d19)
+
+(my-assert
+ (+ -4.794782783871528d-21 -3.431216587740782d18)
+ -3.431216587740782d18)
+
+(my-assert
+ (+ 1.860870988390988d-21 -3.757945694933625d19)
+ -3.757945694933625d19)
+
+(my-assert
+ (+ 5.445498222566789d-21 7.575823566817991d19)
+ 7.575823566817991d19)
+
+(my-assert
+ (+ 2.631896745307223d-21 4.906449817201212d19)
+ 4.906449817201212d19)
+
+(my-assert
+ (+ -6.61689881073516d-21 5.357007670385275d-21)
+ -1.2598911403498852d-21)
+
+(my-assert
+ (+ 3.0173001109587537d-21 5.2947222461350496d-21)
+ 8.312022357093803d-21)
+
+(my-assert
+ (+ -8.792518441030627d-21 -1.0516787854168774d-21)
+ -9.844197226447504d-21)
+
+(my-assert
+ (+ 7.349451992884509d-21 -8.427997362671486d-21)
+ -1.0785453697869767d-21)
+
+(my-assert
+ (+ -7.881179611953633d-21 3.2080446524364824d-21)
+ -4.6731349595171506d-21)
+
+(my-assert
+ (+ -9.614117725927607d-21 -5.35667712698602d-21)
+ -1.4970794852913628d-20)
+
+;;  ---- Test von - ---
+
+(my-assert
+ (- -0.011326914400453525d0 -0.6668141757661364d0)
+ 0.6554872613656829d0)
+
+(my-assert
+ (- -0.46185382764946437d0 0.7488210697846337d0)
+ -1.2106748974340982d0)
+
+(my-assert
+ (- -0.35834120541234993d0 -0.30919976341834987d0)
+ -0.04914144199400006d0)
+
+(my-assert
+ (- 0.44705025064976966d0 -0.9277893553610955d0)
+ 1.3748396060108652d0)
+
+(my-assert
+ (- -0.47647537517067917d0 0.29158058381073604d0)
+ -0.7680559589814152d0)
+
+(my-assert
+ (- -0.021697999002707746d0 0.1779871773524142d0)
+ -0.19968517635512195d0)
+
+(my-assert
+ (- 0.4179484378019861d0 9.9990307469939d9)
+ -9.999030746575953d9)
+
+(my-assert
+ (- -0.7475415524823718d0 1.3993312799214797d9)
+ -1.3993312806690214d9)
+
+(my-assert
+ (- 0.2519442433861928d0 -6.699632771871848d9)
+ 6.699632772123793d9)
+
+(my-assert
+ (- -0.5124988631497671d0 2.7959244812290273d9)
+ -2.795924481741526d9)
+
+(my-assert
+ (- -0.6870193827604301d0 4.851102442573468d9)
+ -4.851102443260488d9)
+
+(my-assert
+ (- 0.7609656780357723d0 7.481252865855436d8)
+ -7.481252858245779d8)
+
+(my-assert
+ (- -0.6301276042170191d0 -7.099314875214215d-11)
+ -0.630127604146026d0)
+
+(my-assert
+ (- -0.4139053484357884d0 -2.897413526398709d-11)
+ -0.41390534840681426d0)
+
+(my-assert
+ (- -0.6944623060197281d0 -3.291569879873739d-11)
+ -0.6944623059868125d0)
+
+(my-assert
+ (- -0.2057822500703933d0 3.6505182026159854d-11)
+ -0.2057822501068985d0)
+
+(my-assert
+ (- -0.8792706674467908d0 8.094527736950817d-11)
+ -0.8792706675277361d0)
+
+(my-assert
+ (- -0.6888184243601332d0 9.127622796988807d-11)
+ -0.6888184244514094d0)
+
+(my-assert
+ (- -0.980711030497252d0 8.752272461345245d19)
+ -8.752272461345245d19)
+
+(my-assert
+ (- 0.8035082489836539d0 -3.903355151264917d19)
+ 3.903355151264917d19)
+
+(my-assert
+ (- -0.7537841372394811d0 -5.879942447417834d19)
+ 5.879942447417834d19)
+
+(my-assert
+ (- -0.6877475951546845d0 -2.3972266191169642d19)
+ 2.3972266191169642d19)
+
+(my-assert
+ (- -0.43128282112433525d0 -5.422824998003439d19)
+ 5.422824998003439d19)
+
+(my-assert
+ (- 0.29538116818276694d0 1.1291858990580939d19)
+ -1.1291858990580939d19)
+
+(my-assert
+ (- 0.9166687388673976d0 6.395175407123937d-21)
+ 0.9166687388673976d0)
+
+(my-assert
+ (- 0.41840538498193025d0 -2.6655662412599155d-21)
+ 0.41840538498193025d0)
+
+(my-assert
+ (- -0.8036940092501853d0 6.7473779576832565d-21)
+ -0.8036940092501853d0)
+
+(my-assert
+ (- 0.8555054025209989d0 -7.939970418096797d-21)
+ 0.8555054025209989d0)
+
+(my-assert
+ (- 0.3365495704567003d0 8.694519827555395d-21)
+ 0.3365495704567003d0)
+
+(my-assert
+ (- -0.7430322011471231d0 7.430332379292914d-22)
+ -0.7430322011471231d0)
+
+(my-assert
+ (- 5.102372414731216d9 -0.5073635765350494d0)
+ 5.10237241523858d9)
+
+(my-assert
+ (- 4.629827365822252d9 0.6534380055543355d0)
+ 4.629827365168815d9)
+
+(my-assert
+ (- 7.218192507117569d9 0.9781542046565127d0)
+ 7.218192506139415d9)
+
+(my-assert
+ (- 6.595760326622413d8 0.7339510561932947d0)
+ 6.595760319282902d8)
+
+(my-assert
+ (- 7.191166637703489d9 0.80792475493853d0)
+ 7.191166636895564d9)
+
+(my-assert
+ (- -7.95531405213956d9 0.5353636841430115d0)
+ -7.955314052674924d9)
+
+(my-assert
+ (- 5.438904545553836d8 6.533536518165114d9)
+ -5.989646063609731d9)
+
+(my-assert
+ (- -7.389650313101625d8 -9.983943153365381d9)
+ 9.244978122055218d9)
+
+(my-assert
+ (- 8.364404619492165d9 -7.600563055115287d9)
+ 1.5964967674607452d10)
+
+(my-assert
+ (- 2.070813748323649d9 6.421052769114957d9)
+ -4.350239020791307d9)
+
+(my-assert
+ (- -2.8555256820439434d9 -3.4077342921686625d8)
+ -2.514752252827077d9)
+
+(my-assert
+ (- 9.147878229420991d8 8.439982790150545d9)
+ -7.5251949672084465d9)
+
+(my-assert
+ (- -4.315772980070098d9 -6.48869466068404d-11)
+ -4.315772980070098d9)
+
+(my-assert
+ (- -3.5186299785635023d9 3.990046539849716d-11)
+ -3.5186299785635023d9)
+
+(my-assert
+ (- 2.5645532837267537d9 8.566645694205622d-13)
+ 2.5645532837267537d9)
+
+(my-assert
+ (- 6.145110896031829d9 -9.242734002954773d-11)
+ 6.145110896031829d9)
+
+(my-assert
+ (- -6.6836855975624d9 9.117930361283473d-11)
+ -6.6836855975624d9)
+
+(my-assert
+ (- -1.7472828462085754d8 -5.125838712019503d-11)
+ -1.7472828462085754d8)
+
+(my-assert
+ (- 9.05675399397055d9 9.086705650502484d19)
+ -9.08670564959681d19)
+
+(my-assert
+ (- -5.834806594586836d9 9.981576053842906d19)
+ -9.981576054426386d19)
+
+(my-assert
+ (- 3.047010922754272d9 1.1715352070471352d19)
+ -1.1715352067424342d19)
+
+(my-assert
+ (- 7.294295638574767d9 2.845702947515113d19)
+ -2.8457029467856835d19)
+
+(my-assert
+ (- 8.264143132493019d9 -1.6322956072452289d19)
+ 1.6322956080716431d19)
+
+(my-assert
+ (- -9.597823287256088d9 3.954126758718671d19)
+ -3.954126759678453d19)
+
+(my-assert
+ (- 3.229389511771705d9 -4.329831377266493d-21)
+ 3.229389511771705d9)
+
+(my-assert
+ (- 6.897089200279753d9 2.4428208790287663d-21)
+ 6.897089200279753d9)
+
+(my-assert
+ (- 2.3579775300187545d9 4.729400988996349d-21)
+ 2.3579775300187545d9)
+
+(my-assert
+ (- 1.6718929117460046d9 5.8162277016717065d-21)
+ 1.6718929117460046d9)
+
+(my-assert
+ (- 2.537177500868296d9 1.4856605280697543d-21)
+ 2.537177500868296d9)
+
+(my-assert
+ (- 6.117674696930935d9 -1.6187214719634357d-21)
+ 6.117674696930935d9)
+
+(my-assert
+ (- 4.1877888304549216d-11 -0.06920550501017497d0)
+ 0.06920550505205286d0)
+
+(my-assert
+ (- 9.61054846124015d-11 0.885309193732889d0)
+ -0.8853091936367835d0)
+
+(my-assert
+ (- 2.5559085051828467d-11 -0.8112181469812297d0)
+ 0.8112181470067888d0)
+
+(my-assert
+ (- -1.4549570208293283d-12 -0.5049325945871657d0)
+ 0.5049325945857107d0)
+
+(my-assert
+ (- -7.091628047158497d-11 0.61946884965934d0)
+ -0.6194688497302563d0)
+
+(my-assert
+ (- 2.877466355456826d-11 0.4496491857374d0)
+ -0.44964918570862533d0)
+
+(my-assert
+ (- 1.3041612488449928d-12 5.408018587130755d9)
+ -5.408018587130755d9)
+
+(my-assert
+ (- -5.379752339715717d-11 -4.009594691514288d9)
+ 4.009594691514288d9)
+
+(my-assert
+ (- 7.023042501342336d-12 -3.4153434285746374d9)
+ 3.4153434285746374d9)
+
+(my-assert
+ (- 6.968174934871611d-11 4.713087404332662d9)
+ -4.713087404332662d9)
+
+(my-assert
+ (- -5.153562653896506d-11 -8.44732228013254d8)
+ 8.44732228013254d8)
+
+(my-assert
+ (- -8.424177457818745d-11 1.6817117809824567d9)
+ -1.6817117809824567d9)
+
+(my-assert
+ (- 3.374755984316538d-11 8.893678266883364d-11)
+ -5.5189222825668264d-11)
+
+(my-assert
+ (- -8.684123447823306d-11 -7.888825869147879d-11)
+ -7.952975786754267d-12)
+
+(my-assert
+ (- 7.788477523205632d-11 1.741674745286914d-11)
+ 6.046802777918718d-11)
+
+(my-assert
+ (- 6.546622477606044d-11 -4.7719651007530584d-11)
+ 1.1318587578359101d-10)
+
+(my-assert
+ (- -1.8595152377503265d-11 5.7288738553553045d-11)
+ -7.588389093105631d-11)
+
+(my-assert
+ (- -8.184033550427558d-11 -8.834399228929296d-11)
+ 6.503656785017376d-12)
+
+(my-assert
+ (- 5.749469292140762d-11 7.493129199779113d19)
+ -7.493129199779113d19)
+
+(my-assert
+ (- -5.2285095120702066d-11 -2.0611179974216552d19)
+ 2.0611179974216552d19)
+
+(my-assert
+ (- -8.84727820032067d-11 4.7423077384022024d19)
+ -4.7423077384022024d19)
+
+(my-assert
+ (- 3.437676989338625d-11 -3.5368755480277647d19)
+ 3.5368755480277647d19)
+
+(my-assert
+ (- 2.2665031619145437d-11 -6.072845659234921d19)
+ 6.072845659234921d19)
+
+(my-assert
+ (- -8.429070146313393d-11 5.134329153614969d18)
+ -5.134329153614969d18)
+
+(my-assert
+ (- -9.009531819191212d-11 2.301790665456671d-22)
+ -9.00953181921423d-11)
+
+(my-assert
+ (- -2.706942469371907d-11 9.282350542107287d-21)
+ -2.706942470300142d-11)
+
+(my-assert
+ (- 5.358266626996117d-11 -4.409057695582885d-22)
+ 5.358266627040208d-11)
+
+(my-assert
+ (- -7.189537285608088d-11 9.569273217393917d-21)
+ -7.189537286565016d-11)
+
+(my-assert
+ (- -4.160295905335358d-11 5.930867524794025d-21)
+ -4.160295905928445d-11)
+
+(my-assert
+ (- 6.7922062777334035d-12 -7.747524338474154d-22)
+ 6.792206278508156d-12)
+
+(my-assert
+ (- -9.038821102045805d19 0.04779131019959271d0)
+ -9.038821102045805d19)
+
+(my-assert
+ (- 2.2020595055495963d19 -0.424631558292516d0)
+ 2.2020595055495963d19)
+
+(my-assert
+ (- -8.164003027214308d19 0.6832198147365239d0)
+ -8.164003027214308d19)
+
+(my-assert
+ (- -3.878233560364984d19 -0.28756619113600546d0)
+ -3.878233560364984d19)
+
+(my-assert
+ (- 7.0829003521450525d19 -0.6071548125948544d0)
+ 7.0829003521450525d19)
+
+(my-assert
+ (- 5.968540808784698d19 0.7674294173432648d0)
+ 5.968540808784698d19)
+
+(my-assert
+ (- -2.2143621795153547d19 -2.443529365769125d9)
+ -2.2143621792710017d19)
+
+(my-assert
+ (- -9.77092538926342d18 5.903189771537687d8)
+ -9.77092538985374d18)
+
+(my-assert
+ (- 9.974714452399537d19 -6.980456691485629d9)
+ 9.974714453097582d19)
+
+(my-assert
+ (- 1.7428950527159094d18 3.68843657888816d9)
+ 1.742895049027473d18)
+
+(my-assert
+ (- -1.1094381875350845d19 -7.157723640671709d9)
+ -1.1094381868193122d19)
+
+(my-assert
+ (- -3.638795590369631d19 6.9246542750294075d9)
+ -3.6387955910620963d19)
+
+(my-assert
+ (- -5.66543282261991d19 -5.1005028153082024d-11)
+ -5.66543282261991d19)
+
+(my-assert
+ (- -3.901527864456216d19 -1.064153465992923d-12)
+ -3.901527864456216d19)
+
+(my-assert
+ (- 1.1477489418879848d19 3.327888063907735d-11)
+ 1.1477489418879848d19)
+
+(my-assert
+ (- 3.508978072054437d19 9.238453417997638d-11)
+ 3.508978072054437d19)
+
+(my-assert
+ (- -4.7642024461416964d19 -4.758309941438892d-11)
+ -4.7642024461416964d19)
+
+(my-assert
+ (- -8.307715835429606d19 3.313910202186439d-11)
+ -8.307715835429606d19)
+
+(my-assert
+ (- 2.704675010192592d18 -2.6840207147078365d19)
+ 2.954488215727096d19)
+
+(my-assert
+ (- -9.860969100714668d18 -4.719594638795429d19)
+ 3.7334977287239614d19)
+
+(my-assert
+ (- 7.87799781828944d18 -6.657221298850535d19)
+ 7.44502108067948d19)
+
+(my-assert
+ (- -3.3937781740759863d19 4.783805995045389d19)
+ -8.177584169121376d19)
+
+(my-assert
+ (- -1.0747572720102216d19 -1.7144708598072445d19)
+ 6.397135877970229d18)
+
+(my-assert
+ (- 1.3938845733158445d19 5.604369854609131d19)
+ -4.210485281293287d19)
+
+(my-assert
+ (- 6.0938348303695315d19 1.1005522580049531d-21)
+ 6.0938348303695315d19)
+
+(my-assert
+ (- -2.4870844028694925d19 1.5391650322730598d-22)
+ -2.4870844028694925d19)
+
+(my-assert
+ (- 7.323118607079343d19 6.637280375859432d-21)
+ 7.323118607079343d19)
+
+(my-assert
+ (- -4.181201584825501d19 4.768935182006663d-21)
+ -4.181201584825501d19)
+
+(my-assert
+ (- 4.1225910279381205d19 6.117191687463543d-21)
+ 4.1225910279381205d19)
+
+(my-assert
+ (- 6.438313875980151d17 -1.4883489002691529d-21)
+ 6.438313875980151d17)
+
+(my-assert
+ (- -4.573961206963222d-21 0.3586300020381973d0)
+ -0.3586300020381973d0)
+
+(my-assert
+ (- 7.74206782371325d-22 0.23168389210368656d0)
+ -0.23168389210368656d0)
+
+(my-assert
+ (- 8.572446613640605d-21 0.6114581963443891d0)
+ -0.6114581963443891d0)
+
+(my-assert
+ (- -8.539467934859551d-21 0.33474735899049d0)
+ -0.33474735899049d0)
+
+(my-assert
+ (- -5.55811309570968d-21 -0.9637216018651454d0)
+ 0.9637216018651454d0)
+
+(my-assert
+ (- -6.705839413964189d-21 0.3787619614522374d0)
+ -0.3787619614522374d0)
+
+(my-assert
+ (- 1.338539206480238d-22 6.683968625235106d9)
+ -6.683968625235106d9)
+
+(my-assert
+ (- -9.64078167549023d-21 3.291420859310843d9)
+ -3.291420859310843d9)
+
+(my-assert
+ (- -9.26536204591093d-22 2.9839295142529476d8)
+ -2.9839295142529476d8)
+
+(my-assert
+ (- -3.647737608953592d-21 6.115300020921433d8)
+ -6.115300020921433d8)
+
+(my-assert
+ (- 1.4069763806331204d-21 -1.183109060480878d9)
+ 1.183109060480878d9)
+
+(my-assert
+ (- -6.0037865798761924d-21 -7.442246743849378d9)
+ 7.442246743849378d9)
+
+(my-assert
+ (- -5.994118986299138d-21 -9.091558282012836d-11)
+ 9.091558281413425d-11)
+
+(my-assert
+ (- 6.969393585974241d-21 3.435352867093995d-11)
+ -3.435352866397056d-11)
+
+(my-assert
+ (- -6.278554484817533d-22 -4.7211920270841604d-11)
+ 4.721192027021375d-11)
+
+(my-assert
+ (- -8.603262886304741d-21 1.7296517702077242d-11)
+ -1.7296517710680505d-11)
+
+(my-assert
+ (- 4.104502790901735d-21 -4.8473213720301105d-11)
+ 4.847321372440561d-11)
+
+(my-assert
+ (- -4.449725859444968d-21 -8.944265568403936d-11)
+ 8.944265567958964d-11)
+
+(my-assert
+ (- 4.828216540804827d-21 -1.1712152029346877d19)
+ 1.1712152029346877d19)
+
+(my-assert
+ (- -5.65034940464881d-21 -9.445303840982011d19)
+ 9.445303840982011d19)
+
+(my-assert
+ (- -7.24107519738777d-21 2.340578690102746d19)
+ -2.340578690102746d19)
+
+(my-assert
+ (- 1.7659593956231534d-21 -8.048768257390671d18)
+ 8.048768257390671d18)
+
+(my-assert
+ (- -3.0538518255248124d-21 8.834631867521575d19)
+ -8.834631867521575d19)
+
+(my-assert
+ (- 8.57952908388053d-21 -5.730742870111307d19)
+ 5.730742870111307d19)
+
+(my-assert
+ (- -4.5090103564928485d-21 1.8907114777916313d-21)
+ -6.399721834284479d-21)
+
+(my-assert
+ (- -3.8487625143236447d-22 5.354282198078924d-21)
+ -5.739158449511288d-21)
+
+(my-assert
+ (- 2.6660110440404615d-22 3.833744224501756d-22)
+ -1.1677331804612944d-22)
+
+(my-assert
+ (- -7.503762004261027d-22 -9.623906576475644d-21)
+ 8.873530376049542d-21)
+
+(my-assert
+ (- -9.113431042260725d-21 -3.5516521546085545d-21)
+ -5.56177888765217d-21)
+
+(my-assert
+ (- -3.4813735333296525d-21 -2.6602650182385188d-21)
+ -8.211085150911337d-22)
+
+;;  ---- Test von * ---
+
+(my-assert
+ (* -0.2554913394465045d0 0.27042187315261135d0)
+ -0.0690904465873934d0)
+
+(my-assert
+ (* -0.4489211233229662d0 -0.42892136850270857d0)
+ 0.19255186256545986d0)
+
+(my-assert
+ (* -0.44586465919973783d0 -0.15168042462027043d0)
+ 0.0676289408305884d0)
+
+(my-assert
+ (* 0.5509395670465355d0 0.3577558280766836d0)
+ 0.19710184102894285d0)
+
+(my-assert
+ (* -0.42780066410606965d0 0.22704747885906007d0)
+ -0.0971310622395147d0)
+
+(my-assert
+ (* 0.20955388816500042d0 0.605628751935113d0)
+ 0.12691185975251945d0)
+
+(my-assert
+ (* 0.9993471610818964d0 -4.363771855901198d9)
+ -4.360923015803941d9)
+
+(my-assert
+ (* 0.10502219375257282d0 3.425205053451057d9)
+ 3.5972254876582843d8)
+
+(my-assert
+ (* 0.7768651149081368d0 1.666066330143864d9)
+ 1.2943088110117908d9)
+
+(my-assert
+ (* -0.6438389801759042d0 2.8922130868526487d9)
+ -1.8621195242906134d9)
+
+(my-assert
+ (* -0.7427680566504474d0 6.763974500466173d9)
+ -5.02406419494444d9)
+
+(my-assert
+ (* -0.8563035843259611d0 2.9100478627456827d9)
+ -2.4918844154292307d9)
+
+(my-assert
+ (* 0.6219502737119671d0 2.8868752190811842d-11)
+ 1.7954928326798375d-11)
+
+(my-assert
+ (* 0.6767479505813657d0 2.9324524289075574d-11)
+ 1.9845311714405376d-11)
+
+(my-assert
+ (* 0.7944531541461581d0 8.282076647859848d-11)
+ 6.579721915772496d-11)
+
+(my-assert
+ (* -0.4662914070981966d0 -6.921260263903422d-11)
+ 3.227324187348362d-11)
+
+(my-assert
+ (* 0.037804762510578516d0 -3.044514833184461d-11)
+ -1.1509716022847211d-12)
+
+(my-assert
+ (* -0.5364168049485208d0 -3.695280705974925d-11)
+ 1.9822106696869836d-11)
+
+(my-assert
+ (* 0.10343751426551051d0 4.8902635121181385d19)
+ 5.058367017968255d18)
+
+(my-assert
+ (* -0.45511004829813784d0 1.8210069906740634d19)
+ -8.287585794769196d18)
+
+(my-assert
+ (* -0.9675158737162977d0 8.097401718869682d19)
+ -7.83436469886405d19)
+
+(my-assert
+ (* -0.06573561186185628d0 2.6049125586869125d19)
+ -1.712355208919178d18)
+
+(my-assert
+ (* -0.5574365795036731d0 -8.822383181882661d19)
+ 4.917919103979403d19)
+
+(my-assert
+ (* -0.4222667103024276d0 -1.8561723355961213d19)
+ 7.837997859065477d18)
+
+(my-assert
+ (* -0.8412207478192143d0 2.3416069046402696d-22)
+ -1.9698083114201234d-22)
+
+(my-assert
+ (* 0.24291385591230452d0 -9.448120185342916d-21)
+ -2.295079305344525d-21)
+
+(my-assert
+ (* -0.37792600430678414d0 -2.3929024368177364d-21)
+ 9.043400566424941d-22)
+
+(my-assert
+ (* -0.007648867433060369d0 -5.3162210182098465d-21)
+ 4.066306981313633d-23)
+
+(my-assert
+ (* -0.7631807323096114d0 -4.534410248041209d-21)
+ 3.4605745336922964d-21)
+
+(my-assert
+ (* 0.4735366300649959d0 -1.3895270471326203d-21)
+ -6.579919552833457d-22)
+
+(my-assert
+ (* -8.64834403600587d9 -0.14057280586223464d0)
+ 1.215721987203268d9)
+
+(my-assert
+ (* -1.5525713051163936d9 0.10621224657238759d0)
+ -1.64902086280236d8)
+
+(my-assert
+ (* 3.297132746298694d9 0.05318660311813239d0)
+ 1.7536329080518654d8)
+
+(my-assert
+ (* 2.1659831568875275d9 0.11704159596099262d0)
+ 2.5351012550674528d8)
+
+(my-assert
+ (* -5.533403510176525d9 0.37778599060251605d0)
+ -2.0904423264954782d9)
+
+(my-assert
+ (* -2.4217306331294374d9 0.6051350227557695d0)
+ -1.465474021787126d9)
+
+(my-assert
+ (* 1.4048311850866513d9 -4.304799039580996d9)
+ -6.047515936334449d18)
+
+(my-assert
+ (* -5.070278162013437d9 -9.116233758795675d9)
+ 4.622184094703138d19)
+
+(my-assert
+ (* 8.452801605894673d9 -9.002885976919611d9)
+ -7.609960904339272d19)
+
+(my-assert
+ (* 6.352601599408395d9 -4.484034289922495d9)
+ -2.848528340196373d19)
+
+(my-assert
+ (* -6.565407710101401d8 -6.718825369609182d9)
+ 4.4111827884457016d18)
+
+(my-assert
+ (* -9.37193973536698d9 9.577576231327314d9)
+ -8.976046725088279d19)
+
+(my-assert
+ (* -1.7766859308675253d9 -4.079350537765101d-11)
+ 0.0724772470752413d0)
+
+(my-assert
+ (* 2.3810136983742104d9 9.195156930614704d-11)
+ 0.2189379461049417d0)
+
+(my-assert
+ (* -3.313966320976337d9 -3.44704749912067d-11)
+ 0.11423399318891611d0)
+
+(my-assert
+ (* 6.598963960681895d9 -2.4298605961767928d-11)
+ -0.1603456250365168d0)
+
+(my-assert
+ (* 7.908258993705348d9 1.528909719631646d-11)
+ 0.12091014040840486d0)
+
+(my-assert
+ (* -5.906667889594469d9 5.917852809041966d-11)
+ -0.3495479116251461d0)
+
+(my-assert
+ (* 4.86261281419926d9 -2.3925611132123714d19)
+ -1.1634098327861323d29)
+
+(my-assert
+ (* -9.753392818607462d9 -2.5653634777279775d18)
+ 2.502099772078992d28)
+
+(my-assert
+ (* 1.5861252889272392d9 5.12939252547053d19)
+ 8.135859201483165d28)
+
+(my-assert
+ (* -8.422142961023593d8 1.0428099441045047d19)
+ -8.782694430425161d27)
+
+(my-assert
+ (* -3.109042783121446d9 -4.138252722536039d19)
+ 1.286600476173335d29)
+
+(my-assert
+ (* -6.459303282089468d8 1.8408981660472957d19)
+ -1.189091956594178d28)
+
+(my-assert
+ (* -1.432764110232635d9 8.98766033001457d-21)
+ -1.2877197155806476d-11)
+
+(my-assert
+ (* 8.539623949953406d9 -3.498784805440049d-21)
+ -2.987830652026891d-11)
+
+(my-assert
+ (* 7.336784327799637d9 -1.048985206018761d-21)
+ -7.696178219612119d-12)
+
+(my-assert
+ (* -4.320357143553698d9 2.591531476439043d-21)
+ -1.119634152697768d-11)
+
+(my-assert
+ (* -9.374098076239548d9 5.5773248420603045d-21)
+ -5.228239007252054d-11)
+
+(my-assert
+ (* 9.118926580475056d9 -1.379170270330765d-21)
+ -1.2576552437120181d-11)
+
+(my-assert
+ (* 8.145792307872788d-11 -0.06511382435429458d0)
+ -5.304036895613926d-12)
+
+(my-assert
+ (* -6.1928426627437d-11 0.2526275616632321d0)
+ -1.5644827416529785d-11)
+
+(my-assert
+ (* -8.555119338859813d-11 -0.8366318482083728d0)
+ 7.157485304113478d-11)
+
+(my-assert
+ (* 8.243060442429263d-12 0.3939656708074719d0)
+ 3.2474828367081808d-12)
+
+(my-assert
+ (* 8.600529286105945d-11 -0.891441509265547d0)
+ -7.666868807288822d-11)
+
+(my-assert
+ (* -7.531046724969747d-11 0.24398797995196886d0)
+ -1.8374848773492595d-11)
+
+(my-assert
+ (* -3.7666526619188126d-12 4.659322150343885d9)
+ -0.017550048180330083d0)
+
+(my-assert
+ (* 3.032501107241211d-11 -9.592046453776636d9)
+ -0.2908789149178678d0)
+
+(my-assert
+ (* 7.311626957349528d-11 -9.061108567148174d9)
+ -0.6625144566303135d0)
+
+(my-assert
+ (* 4.898078204161461d-11 8.88014689134599d9)
+ 0.4349565393825394d0)
+
+(my-assert
+ (* 1.278207138618518d-11 -4.279966992086118d9)
+ -0.05470684362336102d0)
+
+(my-assert
+ (* -8.538580654966055d-11 -5.191059833953482d8)
+ 0.0443242830769665d0)
+
+(my-assert
+ (* 4.0761422500127225d-11 1.527607426117321d-11)
+ 6.226745171030001d-22)
+
+(my-assert
+ (* -9.186363051001198d-11 8.557763803549676d-11)
+ -7.861472520412421d-21)
+
+(my-assert
+ (* -9.89183505930065d-11 9.717968160611499d-11)
+ -9.612853815630427d-21)
+
+(my-assert
+ (* 7.440627873114725d-12 -4.535521332601712d-11)
+ -3.374712644646274d-22)
+
+(my-assert
+ (* 8.701410920357686d-11 -7.032883383151379d-12)
+ -6.119600827175551d-22)
+
+(my-assert
+ (* 9.866226673114161d-11 -2.814669610817353d-11)
+ -2.777016839025002d-21)
+
+(my-assert
+ (* 5.192240545105114d-11 -3.366056660574579d19)
+ -1.747737587015645d9)
+
+(my-assert
+ (* -1.372355669576939d-11 -4.819955130360066d19)
+ 6.61469275025609d8)
+
+(my-assert
+ (* 3.637511103766519d-11 -4.071776382810416d19)
+ -1.4811131804527159d9)
+
+(my-assert
+ (* 7.446388208685151d-13 2.7760294268649034d19)
+ 2.0671392791169815d7)
+
+(my-assert
+ (* 6.267855179410938d-11 7.471751480940298d19)
+ 4.683185621908299d9)
+
+(my-assert
+ (* -4.336562006766369d-11 8.143188451558233d19)
+ -3.5313441652966094d9)
+
+(my-assert
+ (* -1.0432655006975122d-11 -9.379512413340694d-21)
+ 9.785321714202411d-32)
+
+(my-assert
+ (* -8.167646898574611d-11 -5.810795749825724d-21)
+ 4.746052788431461d-31)
+
+(my-assert
+ (* -4.33805459341994d-11 -2.4289860591796017d-21)
+ 1.053707413137707d-31)
+
+(my-assert
+ (* -1.384613082275421d-11 2.2174009100764947d-21)
+ -3.070242308741339d-32)
+
+(my-assert
+ (* -4.910905591314494d-11 -5.456657623752349d-21)
+ 2.679713043437427d-31)
+
+(my-assert
+ (* 1.3653011366548008d-11 -3.925911962906968d-21)
+ -5.360052065363564d-32)
+
+(my-assert
+ (* 7.641468950470222d19 0.9034599537348024d0)
+ 6.903761184457755d19)
+
+(my-assert
+ (* 5.146778093125584d19 -0.2791459460022878d0)
+ -1.436702239669392d19)
+
+(my-assert
+ (* -8.874303077863696d19 -0.23153988023519345d0)
+ 2.054755071819369d19)
+
+(my-assert
+ (* 7.10798162637783d19 -0.4719034863212067d0)
+ -3.354281310194779d19)
+
+(my-assert
+ (* -9.820386602197546d19 0.03346146041258036d0)
+ -3.286044775256677d18)
+
+(my-assert
+ (* -5.210458089116161d19 0.11173798093222442d0)
+ -5.822060666098161d18)
+
+(my-assert
+ (* 3.257626718953688d18 -6.150510855712356d9)
+ -2.0036068498783283d28)
+
+(my-assert
+ (* -7.755105754004988d19 5.514896832715505d9)
+ -4.27686081601359d29)
+
+(my-assert
+ (* 2.426235084788384d19 8.685431434428486d9)
+ 2.1072898472734294d29)
+
+(my-assert
+ (* -2.847383850475709d19 -2.412830829567453d9)
+ 6.870255538040273d28)
+
+(my-assert
+ (* 1.4664659669727164d19 -4.8673539253155d9)
+ -7.1378088806862425d28)
+
+(my-assert
+ (* -4.24770317054668d19 1.3102543269150825d9)
+ -5.5655714586597015d28)
+
+(my-assert
+ (* 2.17116835964837d19 -3.654789326884115d-11)
+ -7.935162947711353d8)
+
+(my-assert
+ (* -1.8125809977916906d17 -5.944782899600832d-11)
+ 1.0775400519813456d7)
+
+(my-assert
+ (* -7.915462827540546d19 9.762153025588201d-11)
+ -7.727195939080587d9)
+
+(my-assert
+ (* -4.360953588949649d19 -7.152431005584812d-11)
+ 3.119141966351983d9)
+
+(my-assert
+ (* 3.550776271395866d19 -6.387656982922894d-11)
+ -2.268114084477872d9)
+
+(my-assert
+ (* -8.278954580496595d19 -7.359178231519021d-11)
+ 6.092630232852524d9)
+
+(my-assert
+ (* -5.5022682113038156d19 -8.979630229039327d19)
+ 4.940833395850589d39)
+
+(my-assert
+ (* 1.1716230943203277d19 5.5764415854118265d19)
+ 6.533487745596758d38)
+
+(my-assert
+ (* 7.462799608352103d19 6.061883497941003d19)
+ 4.523862179431019d39)
+
+(my-assert
+ (* -3.2160334983646097d19 -3.8817785710003675d19)
+ 1.2483929917571087d39)
+
+(my-assert
+ (* 5.868090263060238d19 -8.37300331667736d19)
+ -4.91335392351655d39)
+
+(my-assert
+ (* -7.3652924769962656d19 9.725738480757314d19)
+ -7.163290846555493d39)
+
+(my-assert
+ (* -6.447063647969567d19 4.0587529685661844d-21)
+ -0.2616703871973161d0)
+
+(my-assert
+ (* -3.1999317568381926d17 3.015031281949113d-21)
+ -9.647894346969533d-4)
+
+(my-assert
+ (* -1.5005852398726605d19 5.391316601974659d-21)
+ -0.080901301164036d0)
+
+(my-assert
+ (* 1.0084552719733576d19 2.78150956101201d-21)
+ 0.02805027980846861d0)
+
+(my-assert
+ (* -7.171404412051077d19 1.4733392992015492d-21)
+ -0.10565911950742231d0)
+
+(my-assert
+ (* -5.909802783283228d19 5.356071274587122d-21)
+ -0.31653324926018317d0)
+
+(my-assert
+ (* 8.272641144282955d-22 -0.16191056182923802d0)
+ -1.3394279754825238d-22)
+
+(my-assert
+ (* 8.410471541398583d-21 -0.43256058128353736d0)
+ -3.63803845881602d-21)
+
+(my-assert
+ (* -7.887238384137063d-22 0.5589746137044918d0)
+ -4.408766028968254d-22)
+
+(my-assert
+ (* 4.778995446616728d-21 0.21608373898977795d0)
+ 1.0326632047200663d-21)
+
+(my-assert
+ (* 3.992449163872154d-21 0.9593422165456676d0)
+ 3.830125030315009d-21)
+
+(my-assert
+ (* -9.700320218813958d-21 -0.42620535269852766d0)
+ 4.134328400148262d-21)
+
+(my-assert
+ (* -1.7901566262876555d-21 9.461674014776534d8)
+ -1.6937878433325936d-12)
+
+(my-assert
+ (* 1.0928019952544443d-22 8.279199780524873d9)
+ 9.047526039267738d-13)
+
+(my-assert
+ (* 9.942869097320962d-21 9.523169242022762d9)
+ 9.468762516506561d-11)
+
+(my-assert
+ (* -2.7432601692209267d-21 -4.922145522647528d9)
+ 1.3502725759388083d-11)
+
+(my-assert
+ (* -5.97929682563092d-21 -6.147792689359443d8)
+ 3.6759477312123895d-12)
+
+(my-assert
+ (* -1.3564305221188254d-21 1.0862842413758955d9)
+ -1.473469100698958d-12)
+
+(my-assert
+ (* -5.446806293721964d-21 -1.5358504316888942d-11)
+ 8.365479797538665d-32)
+
+(my-assert
+ (* -1.0222776562632463d-21 -1.9781477525280056d-11)
+ 2.0222162481967376d-32)
+
+(my-assert
+ (* 8.192540157543917d-21 3.3215076993103644d-11)
+ 2.7211585210191467d-31)
+
+(my-assert
+ (* 9.685592607330157d-21 6.034805605641166d-11)
+ 5.8450668560672665d-31)
+
+(my-assert
+ (* 6.671870463340688d-21 -9.07657686679269d-11)
+ -6.055774510579552d-31)
+
+(my-assert
+ (* -1.109409648670322d-21 -4.7905821901849965d-11)
+ 5.314718104539439d-32)
+
+(my-assert
+ (* -3.9052432481663676d-22 2.0306112771345453d19)
+ -0.007930030979680168d0)
+
+(my-assert
+ (* 8.596834841113507d-21 -9.453548987989818d19)
+ -0.8127059931212419d0)
+
+(my-assert
+ (* 3.946325780779758d-21 -9.084484011754447d19)
+ -0.35850333460668093d0)
+
+(my-assert
+ (* 5.3518824877647604d-21 -6.814116447592617d19)
+ -0.36468350485460743d0)
+
+(my-assert
+ (* -7.456278485417833d-22 9.61914445493285d19)
+ -0.07172301984744206d0)
+
+(my-assert
+ (* -5.0781537010216826d-21 9.216915512986622d19)
+ -0.4680491362427718d0)
+
+(my-assert
+ (* 3.2906792172396555d-22 4.571445785546992d-21)
+ 1.50431616392373d-42)
+
+(my-assert
+ (* 5.39814714322422d-21 6.687033308557664d-21)
+ 3.6097589751235757d-41)
+
+(my-assert
+ (* 4.3506183844841724d-21 7.266196706225928d-21)
+ 3.1612448975384865d-41)
+
+(my-assert
+ (* 6.910763289107986d-21 3.910584203890238d-21)
+ 2.702512175521024d-41)
+
+(my-assert
+ (* -4.6131515924393325d-21 5.228174479773633d-21)
+ -2.411836142691841d-41)
+
+(my-assert
+ (* -2.1886866436065787d-21 6.29322016055891d-22)
+ -1.3773886910690934d-42)
+
+;;  ---- Test von FLOOR ---
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.6173351962722496d0 -0.11820538775792844d0))
+ (-6 -0.09189713027532098d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.17517225806171177d0 0.1118228341753209d0))
+ (-2 0.04847341028893004d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.9387909021047899d0 -0.16826318310698907d0))
+ (5 -0.09747498656984459d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.8036728904567848d0 0.6774308237913269d0))
+ (1 0.1262420666654578d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.6882568422881421d0 0.3302150266778784d0))
+ (2 0.02782678893238538d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.3618917435888378d0 0.5454396894763598d0))
+ (0 0.3618917435888378d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.478470818234076d0 9.035797971846054d9))
+ (-1 9.035797971367584d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.6423779722022549d0 2.0589504447793393d9))
+ (0 0.6423779722022549d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.21698095744051404d0 1.570908384361449d9))
+ (0 0.21698095744051404d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.24033995915823747d0 6.968395233824382d9))
+ (0 0.24033995915823747d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.8531247643149816d0 -5.299783511441018d9))
+ (0 -0.8531247643149817d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.5134978162655872d0 2.297671112225289d9))
+ (-1 2.297671111711791d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.6192405432591311d0 5.4403538407469436d-11))
+ (11382357864 3.744539199218032d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.20340731452742233d0 5.44351944436815d-12))
+ (-37366875715 2.4681729170135434d-12))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.29394735220898527d0 -3.6328318262890404d-12))
+ (80914109505 -3.3847154436219604d-12))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.8359336184185098d0 6.064791537508077d-11))
+ (-13783385847 1.2432123964511977d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.9762544843227843d0 2.2086465633336306d-11))
+ (-44201480696 1.1997821346734454d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.2919696169517234d0 6.922295436251983d-11))
+ (-4217815025 3.3402028237741715d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.9452118035872986d0 -1.1093667270485797d19))
+ (-1 -1.1093667270485797d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.3379784391207531d0 -3.0106029588222304d19))
+ (-1 -3.0106029588222304d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.3907483945162724d0 -9.823409070968835d19))
+ (-1 -9.823409070968835d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.4293216868359586d0 5.965415751655242d19))
+ (-1 5.965415751655242d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.13727607148241305d0 -8.310631671228052d19))
+ (-1 -8.310631671228052d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.7478116595122868d0 7.235991436975452d19))
+ (-1 7.235991436975452d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.9425796643098138d0 -1.7749544068364875d-21))
+ (531044437355311857664 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.20835281321620536d0 2.7983277403481253d-21))
+ (74456186890490986496 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.5404541167071248d0 9.266841531614177d-22))
+ (-583212861537931100160 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.06796825059990208d0 -6.350644782153893d-21))
+ (10702574767038046208 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.30647600932087793d0 -9.704243038852408d-21))
+ (-31581650221851901952 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.7939481974521416d0 -7.44148349933678d-21))
+ (106692193501860495360 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.622471924924206d9 0.3428958732728865d0))
+ (7648012499 0.2776496600055352d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.96303133513731d9 -0.6839887200892081d0))
+ (-14566075496 -0.09450688719173875d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.438132647041376d8 -0.9350840745499996d0))
+ (-1009335193 -0.15301271996267998d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.031281076435459d9 0.8566679205528436d0))
+ (-5873082155 0.5244045303768723d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.504293159523993d9 -0.17779074115973026d0))
+ (53457750935 -0.058079864158457416d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.593337221858664d8 0.6365106532159245d0))
+ (878749977 0.3121177083383602d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.849085830660753d9 5.465582064164139d9))
+ (-2 1.0820782976675239d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.254242990207708d9 1.9986128256161973d9))
+ (3 2.5840451335911673d8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.644949290710447d9 3.677515142398587d9))
+ (-3 1.3875961364853137d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.966654669106707d9 3.622741134738514d9))
+ (2 2.7211723996296782d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.024110605080818d9 -1.3131548351819434d9))
+ (5 -4.583364291711011d8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.5982831731090415d8 -4.587607917895467d9))
+ (0 -4.5982831731090415d8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.779683583609543d9 -8.732134194560264d-11))
+ (-77640625218895380480 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.040910010354103d8 -6.386892985922651d-11))
+ (-4761172634419539968 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.081490496057175d9 -8.389512916135551d-11))
+ (108248125807050637312 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.3391140718625803d9 4.078343101769488d-11))
+ (-57354519065541566464 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.740679130260033d9 -4.1307299498162d-11))
+ (-235810117064018001920 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.630742761978566d9 -8.36053471494181d-11))
+ (-55388117146413842432 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.607827158404311d8 1.9791074337467208d19))
+ (0 6.607827158404311d8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.5835379695092866d9 -5.599741962857091d19))
+ (-1 -5.599741962698737d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.972337740404726d9 -1.4833907125668299d19))
+ (0 -9.972337740404726d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.8545208802037845d9 5.460276762513134d19))
+ (-1 5.4602767622276825d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.4574292483978963d9 8.177006210253868d19))
+ (0 3.4574292483978963d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.94800692720856d9 5.400944544004402d19))
+ (-1 5.400944543309601d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.2301147741459103d9 4.352417825189536d-22))
+ (5123852680777023531125296857088 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.855798499915275d9 -2.1597757039453335d-21))
+ (-1322266240285272897749142994944 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.247757812861889d9 -8.000803060408911d-21))
+ (-780891338743010366964468023296 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.41352264607702d8 2.4583479152659926d-21))
+ (-342242958933120698647142465536 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.08798064415713d9 -4.6826703076651156d-21))
+ (-1940768844921862497464005689344 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.450923950975804d9 -8.516681149015905d-21))
+ (287779230910741073293637320704 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.535114995775952d-11 -0.4217447234387455d0))
+ (0 -6.535114995775952d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.91351782048677d-13 -0.8578740601420116d0))
+ (-1 -0.8578740601413203d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.879448244992307d-11 -0.6016918305263045d0))
+ (0 -9.879448244992307d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.820572196574365d-11 -0.8508242256358738d0))
+ (-1 -0.8508242255576681d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.4420680878896835d-11 0.6509799475016377d0))
+ (-1 0.650979947457217d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.35377304874932d-11 -0.7623592484047194d0))
+ (0 -8.35377304874932d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.697219220983554d-11 -2.0199834401398075d9))
+ (0 -4.697219220983554d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.027899822164905d-11 -3.0043885624092436d8))
+ (-1 -3.0043885624092436d8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.473748837497406d-11 -6.081705720880249d8))
+ (0 -9.473748837497406d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.257060775257221d-11 4.479345462936419d9))
+ (-1 4.479345462936419d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.076402998599221d-11 3.0379052042471523d9))
+ (-1 3.0379052042471523d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.2516054170046405d-11 9.075782126517027d9))
+ (0 3.2516054170046405d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.77186165285192d-12 -7.011585244893556d-11))
+ (-1 -6.234399079608364d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.129939073543463d-11 -4.398862671531905d-11))
+ (0 -4.129939073543463d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.986332353670153d-11 4.056354917830567d-11))
+ (-2 3.126377481990981d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.358815251785654d-11 3.044610839789864d-11))
+ (-3 2.7750172675839383d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.5218538547762808d-11 -4.9239841620755075d-11))
+ (0 -1.5218538547762808d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.714719523899548d-11 -3.338962509681127d-11))
+ (1 -3.757570142184203d-12))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.7559900032627426d-11 -7.103620895893612d19))
+ (0 -3.7559900032627426d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.442771371655891d-11 3.2650979291930292d19))
+ (0 3.442771371655891d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.026236668129701d-11 -7.030175018925641d19))
+ (0 -8.026236668129701d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.0245932625540036d-11 9.919022649131396d19))
+ (0 4.0245932625540036d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.558019989897738d-11 9.805879474847002d19))
+ (0 6.558019989897738d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.950419173616613d-11 7.8967335533488d19))
+ (-1 7.8967335533488d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.2555105814142415d-11 -7.367149245343951d-22))
+ (57763327980 -5.012024424412273d-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.125466497249949d-11 -9.625683307253578d-21))
+ (7402556545 -6.2922712544984485d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.076311292972551d-11 5.7198456178965606d-21))
+ (14119806429 1.262169607592943d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.024787982764915d-11 1.5125149703168537d-21))
+ (-46444419531 6.648179051963393d-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.3153240875994985d-11 -1.5025822462858028d-21))
+ (-15408967419 -1.3907844732195436d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.445189938981536d-11 -1.8886893988697117d-21))
+ (-50009228329 -8.218058303553574d-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.982223463756733d19 0.20677548795071854d0))
+ (-434394983311440412672 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.6872844858317455d19 0.00946240694180256d0))
+ (-2839958693765316083712 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.566658458393646d19 -0.38847162936974444d0))
+ (246264018659858710528 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.235085548018657d19 -0.06527446136754045d0))
+ (648812025299173376000 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.8443413501845017d19 -0.04996947402848739d0))
+ (-569215787335074643968 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.484750058861429d19 -0.2338784192921971d0))
+ (191755616975433072640 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.986802109112903d19 5.923385648786668d9))
+ (-5042390090 3.561083576852057d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.088567504347222d18 9.070536452627407d9))
+ (891740807 8.158341046664973d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.09688480137261d19 -6.508291621550677d9))
+ (4758368219 -1.75538588669977d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.226418080435591d19 7.892147197133178d9))
+ (5355219530 6.335538696917366d8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.4013831972690205d19 -2.4924246236187544d9))
+ (-5622570023 -6.556610185422871d8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.1838203826708914d19 8.941814127664919d9))
+ (6915621700 8.062833976289089d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.916774706038343d18 3.120694095597196d-11))
+ (-221642189018039718512504602624 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.435687674071892d19 -3.149833308668829d-11))
+ (-2995614926067172775889444274176 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.212546775235241d19 3.239266009361982d-11))
+ (-1917887187183768183263136317440 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.749482734068419d19 -5.5235623432819116d-11))
+ (-859858627258009608103722483712 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.0587261660909548d19 4.4929685621578874d-11))
+ (680780674018761986414328414208 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.141754743467259d19 5.235000122629564d-11))
+ (791166121575339566219965497344 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.2481803107227873d19 7.39878580568375d18))
+ (-2 2.3157685041396265d18))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.5884453212818639d19 -8.336283910718495d19))
+ (0 -1.5884453212818639d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.000368279611168d19 -5.031778160332162d19))
+ (-1 -3.1409880720993677d17))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.6360612893747024d19 4.7875734964388405d19))
+ (-1 1.1515122070641383d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.357251757890727d19 -4.493498319637942d19))
+ (-1 -2.136246561747215d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.0747068626287395d19 8.591364094011977d19))
+ (0 5.0747068626287395d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.1440483442615423d19 9.668454918695627d-21))
+ (2217570813838780736509865871750106972160 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.818664212173065d19 -8.186497379734964d-21))
+ (-10772206724212702608743560617665161592832 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.376250633760416d19 -6.382238421048869d-21))
+ (11557466435965877316178494055246213414912 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.374244855009332d19 3.864539687646209d-21))
+ (-11318928536282082575630148538694692241408 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.578656580690454d19 9.103502086399884d-22))
+ (83249902166909342613269419960118328426496 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.759312769216988d19 -9.830658049049094d-21))
+ (-5858522125865295462884970652182979280896 0.0d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.091696063135083d-21 0.3220521420236615d0))
+ (-1 0.3220521420236615d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.472975994693659d-21 -0.06404310380828848d0))
+ (0 -7.472975994693657d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.2994935284804662d-21 0.8294627436562217d0))
+ (0 2.2994935284804662d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.098532726052559d-21 -0.5103342535054871d0))
+ (0 -6.098532726052559d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.8237727943808d-21 0.20193503990844952d0))
+ (-1 0.20193503990844952d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.357065560054238d-21 0.535324456368991d0))
+ (-1 0.535324456368991d0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.67862366495009d-23 5.869284875063336d9))
+ (0 8.67862366495009d-23))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.913399519946995d-21 4.645302733766437d9))
+ (-1 4.645302733766437d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.256033435453117d-21 3.5904533516671333d9))
+ (0 6.2560334354531166d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.970558626381476d-21 4.548434922363557d9))
+ (-1 4.548434922363557d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.442840440717647d-21 -3.3266294818989463d9))
+ (-1 -3.3266294818989463d9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.6732789449833775d-21 5.614289998802058d8))
+ (-1 5.614289998802058d8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.136201304639634d-21 -1.152382297069954d-12))
+ (-1 -1.1523822899337527d-12))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.575364316308001d-21 -4.790622052171537d-11))
+ (0 -7.575364316308001d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.212759331893804d-21 -6.41398602124991d-11))
+ (-1 -6.413986020328634d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.9103188467401064d-21 -5.1860189481412404d-11))
+ (0 -1.9103188467401064d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.473075242507236d-21 2.3036197131739102d-11))
+ (-1 2.303619712726603d-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.138595152941494d-21 2.9424719822474346d-11))
+ (0 5.138595152941494d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.137698996313833d-22 2.2468745456943227d19))
+ (-1 2.2468745456943227d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.229848882029144d-21 -3.031606285079872d19))
+ (0 -7.229848882029144d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.85451854164106d-21 1.7676693722776926d19))
+ (-1 1.7676693722776926d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.372223270507929d-21 -7.439745956384552d19))
+ (-1 -7.439745956384552d19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.598138480271164d-21 5.149401801116799d19))
+ (0 5.598138480271163d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.285618896860432d-21 6.546424273112694d19))
+ (0 9.285618896860432d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.511556502656318d-21 4.2351039143592516d-21))
+ (1 3.2764525882970666d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.050106800286075d-21 -1.187392681676287d-21))
+ (-6 -1.0742492897716469d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.274671258683056d-21 8.647095729321104d-21))
+ (0 4.274671258683056d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.344809600387072d-21 6.305446958850813d-21))
+ (1 1.039362641536258d-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.753544125648588d-21 9.227661371269332d-21))
+ (1 5.258827543792571d-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.227362780459908d-21 -6.70179577363263d-21))
+ (1 -5.255670068272766d-22))
+
+;;  ---- Test von / ---
+
+(my-assert
+ (/ -0.651381628953465d0 -0.9237050214744277d0)
+ 0.7051835962889135d0)
+
+(my-assert
+ (/ 0.5067986732438687d0 0.6260017267692811d0)
+ 0.8095803119575966d0)
+
+(my-assert
+ (/ -0.8399445051045212d0 0.1829250718359493d0)
+ -4.591740742120902d0)
+
+(my-assert
+ (/ -0.5987041550692662d0 -0.4124053212463479d0)
+ 1.4517372211878756d0)
+
+(my-assert
+ (/ 0.5861382519823647d0 -0.7560374696447822d0)
+ -0.7752767230673855d0)
+
+(my-assert
+ (/ -0.012882644582824954d0 -0.4671067448591679d0)
+ 0.02757965866390787d0)
+
+(my-assert
+ (/ -0.7830198970435231d0 2.1690164135025935d9)
+ -3.610022921767931d-10)
+
+(my-assert
+ (/ -0.2339206226652567d0 2.729373380002701d9)
+ -8.57048817062271d-11)
+
+(my-assert
+ (/ -0.2285806315782951d0 -2.602073870582813d9)
+ 8.784555817667759d-11)
+
+(my-assert
+ (/ -0.5298716781559242d0 1.3509547453340487d9)
+ -3.9222015392151683d-10)
+
+(my-assert
+ (/ 0.7287190523338418d0 -8.244205871151566d9)
+ -8.839166121309548d-11)
+
+(my-assert
+ (/ 0.18973054487786212d0 6.557593452200545d9)
+ 2.893295326415727d-11)
+
+(my-assert
+ (/ 0.5084032300982587d0 4.5431682148621014d-11)
+ 1.119049980221105d10)
+
+(my-assert
+ (/ 0.6621212705475221d0 -1.838873437953206d-11)
+ -3.600689731450519d10)
+
+(my-assert
+ (/ -0.4041791750277005d0 7.707875701307648d-11)
+ -5.243716825365141d9)
+
+(my-assert
+ (/ -0.09569063343466655d0 4.789751448902253d-11)
+ -1.9978204392338054d9)
+
+(my-assert
+ (/ -0.6471008513340974d0 1.890250884404079d-11)
+ -3.4233596009563705d10)
+
+(my-assert
+ (/ -0.4301276572683971d0 9.134844738134672d-11)
+ -4.708647706651978d9)
+
+(my-assert
+ (/ -0.5061027989171409d0 4.246468515299164d19)
+ -1.1918204434902915d-20)
+
+(my-assert
+ (/ -0.9601783702217944d0 7.495754288877955d19)
+ -1.2809629734615065d-20)
+
+(my-assert
+ (/ -0.6477754868655262d0 -8.507334914535449d19)
+ 7.614317449272521d-21)
+
+(my-assert
+ (/ 0.1934462826116784d0 3.6173521417193476d19)
+ 5.347731573618163d-21)
+
+(my-assert
+ (/ -0.7794308505212441d0 4.172217291786081d19)
+ -1.8681453913144062d-20)
+
+(my-assert
+ (/ -0.8462346361305484d0 7.378170819620111d19)
+ -1.1469436759043748d-20)
+
+(my-assert
+ (/ 0.9783005897625496d0 6.175045007596078d-21)
+ 1.584280905740958d20)
+
+(my-assert
+ (/ -0.9700832605850568d0 -1.7695051741124812d-21)
+ 5.482229013948009d20)
+
+(my-assert
+ (/ 0.07062591404368701d0 -8.855398515753737d-21)
+ -7.975464223100028d18)
+
+(my-assert
+ (/ 0.4751383409805402d0 -8.1371029771106d-21)
+ -5.8391585103087485d19)
+
+(my-assert
+ (/ -0.5103510786836052d0 8.302178001281015d-21)
+ -6.14719509271975d19)
+
+(my-assert
+ (/ 0.7148807879199733d0 4.338856119331781d-21)
+ 1.6476250151158982d20)
+
+(my-assert
+ (/ 4.180670608983218d9 -0.8621420131862095d0)
+ -4.849167010818503d9)
+
+(my-assert
+ (/ 3.202209376555907d9 0.008113117870009012d0)
+ 3.9469528581523615d11)
+
+(my-assert
+ (/ 7.767843042272955d9 -0.04145956871894663d0)
+ -1.8735947532235483d11)
+
+(my-assert
+ (/ 1.1937839884817846d9 0.45557753834605563d0)
+ 2.6203749921818776d9)
+
+(my-assert
+ (/ -2.4205138097471213d9 -0.3737757916008485d0)
+ 6.475844247109412d9)
+
+(my-assert
+ (/ -7.534066568550288d9 -0.3609372553147958d0)
+ 2.0873618496321087d10)
+
+(my-assert
+ (/ 6.098867840095913d9 3.0464612528039427d9)
+ 2.0019515542771322d0)
+
+(my-assert
+ (/ 4.956687716396978d9 7.035407926465974d9)
+ 0.704534515724495d0)
+
+(my-assert
+ (/ 6.969049109639194d9 -8.115758334653503d9)
+ -0.8587058438990264d0)
+
+(my-assert
+ (/ -8.0699835500126705d9 -1.1896420666819375d9)
+ 6.783539163608158d0)
+
+(my-assert
+ (/ -2.229793060172571d9 -2.658809828346301d9)
+ 0.8386433043838396d0)
+
+(my-assert
+ (/ 3.0672739776038485d9 -7.988270854370873d9)
+ -0.3839722054398737d0)
+
+(my-assert
+ (/ 2.477055391151669d9 -1.3522358047779648d-11)
+ -1.8318220700851785d20)
+
+(my-assert
+ (/ 1.1318646612469008d9 -8.457695758685169d-11)
+ -1.3382659929385544d19)
+
+(my-assert
+ (/ -7.978772126259147d9 6.210468872769038d-11)
+ -1.2847294286013678d20)
+
+(my-assert
+ (/ -9.057338243339752d9 7.364415429198257d-11)
+ -1.2298787772658011d20)
+
+(my-assert
+ (/ -5.341117220720213d9 4.7359651161519756d-11)
+ -1.1277779902779204d20)
+
+(my-assert
+ (/ 5.838003830912871d9 -5.0625478501901024d-11)
+ -1.153175042225754d20)
+
+(my-assert
+ (/ 6.407156672927742d9 5.006339136594536d19)
+ 1.279808758079079d-10)
+
+(my-assert
+ (/ 4.687485139826675d8 -3.5561755068968083d19)
+ -1.3181253655045475d-11)
+
+(my-assert
+ (/ -5.838044723576891d9 -6.843985743599882d19)
+ 8.530182473036721d-11)
+
+(my-assert
+ (/ 3.9279221543350096d9 -5.882918042982924d19)
+ -6.67682623765291d-11)
+
+(my-assert
+ (/ -9.686323716926361d9 -3.44800215666902d19)
+ 2.8092568614527606d-10)
+
+(my-assert
+ (/ 7.301304808910639d9 1.2845297359643038d19)
+ 5.684029419085038d-10)
+
+(my-assert
+ (/ 4.380345662298534d9 -4.352751895415198d-21)
+ -1.0063393842668593d30)
+
+(my-assert
+ (/ 8.239490918139045d9 3.2397577733346748d-21)
+ 2.5432428886984834d30)
+
+(my-assert
+ (/ 3.8980499504872713d9 8.311650110069505d-21)
+ 4.689862901910189d29)
+
+(my-assert
+ (/ -9.425472285331268d9 -3.294031046828316d-21)
+ 2.861379310436876d30)
+
+(my-assert
+ (/ 2.517833161624173d9 3.6891560299469316d-21)
+ 6.824957093669991d29)
+
+(my-assert
+ (/ -5.463519676339016d9 -7.298583081866205d-22)
+ 7.485726496576409d30)
+
+(my-assert
+ (/ 1.39357009199772d-11 0.417842407627649d0)
+ 3.335157146709649d-11)
+
+(my-assert
+ (/ 8.58494900746665d-11 -0.6481371063028898d0)
+ -1.3245575548724563d-10)
+
+(my-assert
+ (/ -9.310282234439046d-11 0.9146343299129254d0)
+ -1.0179239866631073d-10)
+
+(my-assert
+ (/ -8.800556770159418d-11 -0.9305573406536135d0)
+ 9.45729659601417d-11)
+
+(my-assert
+ (/ -1.3361456473382827d-11 0.06420301636905124d0)
+ -2.081125970247039d-10)
+
+(my-assert
+ (/ 6.1406425153971765d-12 -0.3082496074575478d0)
+ -1.992100676476244d-11)
+
+(my-assert
+ (/ -3.6962256202372035d-11 3.089420488573177d9)
+ -1.1964139015418631d-20)
+
+(my-assert
+ (/ -6.145126590884831d-11 -6.225608984106817d9)
+ 9.870723661849874d-21)
+
+(my-assert
+ (/ 9.052281678541901d-11 -6.9187138778508625d9)
+ -1.3083763598782874d-20)
+
+(my-assert
+ (/ -3.4950245360118636d-11 7.543342567738434d9)
+ -4.633257080169575d-21)
+
+(my-assert
+ (/ -3.482822570743636d-11 -3.87599225187502d9)
+ 8.985628309909062d-21)
+
+(my-assert
+ (/ -9.42226868788213d-11 7.501937454180854d9)
+ -1.2559780383974101d-20)
+
+(my-assert
+ (/ -4.8165035309367155d-11 9.484620130429997d-11)
+ -0.5078225026096383d0)
+
+(my-assert
+ (/ 6.880022773725747d-11 -9.699156104509544d-11)
+ -0.7093424107822056d0)
+
+(my-assert
+ (/ 1.5817962388036865d-11 -7.11651152335492d-11)
+ -0.22227129593095693d0)
+
+(my-assert
+ (/ -7.0140750853949335d-12 -4.4677941652531186d-11)
+ 0.15699190307254357d0)
+
+(my-assert
+ (/ -2.6947489262085355d-11 8.365454450205894d-11)
+ -0.3221282169723859d0)
+
+(my-assert
+ (/ 8.703167674410303d-11 -4.88739813223768d-11)
+ -1.7807363834354917d0)
+
+(my-assert
+ (/ 1.165112061543483d-12 -5.899528740399518d19)
+ -1.9749239520860124d-32)
+
+(my-assert
+ (/ 7.126386981630328d-12 5.091741402945837d19)
+ 1.3995971942933598d-31)
+
+(my-assert
+ (/ -7.132349854872655d-13 7.70347159367981d19)
+ -9.258617712985763d-33)
+
+(my-assert
+ (/ 4.507266517270466d-11 -1.6192737232544485d19)
+ -2.7835111831566513d-30)
+
+(my-assert
+ (/ -3.025128309814261d-11 -5.606736896306867d19)
+ 5.395523930874836d-31)
+
+(my-assert
+ (/ -5.390258677516223d-11 6.628750121976767d18)
+ -8.131636550373976d-30)
+
+(my-assert
+ (/ -8.484515181627938d-11 6.226893371743352d-21)
+ -1.3625598954575508d10)
+
+(my-assert
+ (/ 5.110456708789676d-11 -7.434814854731122d-21)
+ -6.873683889434922d9)
+
+(my-assert
+ (/ -7.784815533665352d-11 -8.942884975553875d-21)
+ 8.705038200698988d9)
+
+(my-assert
+ (/ 6.06871371776654d-11 -8.4720755768444d-21)
+ -7.163195916657484d9)
+
+(my-assert
+ (/ 6.395725883763629d-11 3.2465500186809204d-21)
+ 1.970006883295217d10)
+
+(my-assert
+ (/ 8.23766365482318d-11 3.5665958051648335d-21)
+ 2.3096712116618633d10)
+
+(my-assert
+ (/ -6.882125490660233d19 0.680553203393516d0)
+ -1.0112545876418106d20)
+
+(my-assert
+ (/ -8.955858402134752d19 0.11144092291315044d0)
+ -8.03641801236189d20)
+
+(my-assert
+ (/ 4.517225460957592d19 -0.5804969398143229d0)
+ -7.781652496570381d19)
+
+(my-assert
+ (/ -9.741926397385082d19 -0.9037000739789977d0)
+ 1.0780043819728059d20)
+
+(my-assert
+ (/ 9.654390326446178d19 -0.061963385089831124d0)
+ -1.558079874501655d21)
+
+(my-assert
+ (/ 9.50855454738802d19 0.30375471599023185d0)
+ 3.130339727036138d20)
+
+(my-assert
+ (/ 4.323538184184934d19 -2.6027608151521606d9)
+ -1.661135421670383d10)
+
+(my-assert
+ (/ 4.0554081767557594d17 4.814123702784068d9)
+ 8.423979995384136d7)
+
+(my-assert
+ (/ 5.12727309625028d19 1.761988796449604d9)
+ 2.9099351293162037d10)
+
+(my-assert
+ (/ -7.335661993746345d19 -4.961351435504d9)
+ 1.4785612527368061d10)
+
+(my-assert
+ (/ 3.7135994768593306d18 3.273427798269768d8)
+ 1.1344681189614824d10)
+
+(my-assert
+ (/ 1.3911083524706402d19 8.651242909451927d9)
+ 1.6079866985942366d9)
+
+(my-assert
+ (/ 6.473382688386894d19 -3.700509647679497d-11)
+ -1.7493219325738552d30)
+
+(my-assert
+ (/ 7.25328632809461d19 6.793518758100849d-11)
+ 1.0676773828651782d30)
+
+(my-assert
+ (/ 7.053090091571119d19 8.009021819073383d-11)
+ 8.806431360661643d29)
+
+(my-assert
+ (/ -1.6322872380348074d19 -1.234889420758779d-11)
+ 1.3218084231637898d30)
+
+(my-assert
+ (/ -7.716951191497702d19 -2.473367210466666d-11)
+ 3.12001839388891d30)
+
+(my-assert
+ (/ -2.1174708383466066d19 -9.66632270128099d-11)
+ 2.1905650202077337d29)
+
+(my-assert
+ (/ 4.0902039392392786d18 -5.029423690873208d19)
+ -0.08132549951322827d0)
+
+(my-assert
+ (/ 1.4562115759233494d17 4.2665150414889705d19)
+ 0.0034131171735308037d0)
+
+(my-assert
+ (/ -3.309692589578652d19 1.1329455009949342d19)
+ -2.9213166799922274d0)
+
+(my-assert
+ (/ 3.059130103268258d19 -7.719433592654628d19)
+ -0.3962894513632647d0)
+
+(my-assert
+ (/ 5.622979366632147d19 -8.407251901594788d19)
+ -0.6688248945610293d0)
+
+(my-assert
+ (/ -7.457587910839625d18 1.102755747735572d19)
+ -0.6762683328700153d0)
+
+(my-assert
+ (/ 1.2026615920578564d19 -3.77964792582931d-21)
+ -3.1819407935832407d39)
+
+(my-assert
+ (/ -2.74643694419756d19 2.538907641816601d-22)
+ -1.0817396028760112d41)
+
+(my-assert
+ (/ 8.267361397156658d18 -4.986401395715489d-21)
+ -1.6579815263689556d39)
+
+(my-assert
+ (/ 9.876393891158812d19 -5.792612775193684d-22)
+ -1.7049981199250076d41)
+
+(my-assert
+ (/ 3.927461252713038d17 4.810589424292295d-21)
+ 8.164199656866003d37)
+
+(my-assert
+ (/ 7.29943837795987d19 -4.8820727437034755d-21)
+ -1.4951514983823475d40)
+
+(my-assert
+ (/ -7.837850970911807d-21 0.41514160181315674d0)
+ -1.8879945870708947d-20)
+
+(my-assert
+ (/ 1.1499234744049124d-21 0.4643166529612681d0)
+ 2.4765932194571437d-21)
+
+(my-assert
+ (/ -1.094368243984769d-21 0.9008053219044149d0)
+ -1.2148776404552516d-21)
+
+(my-assert
+ (/ 2.4821206327531197d-21 0.22988631081892086d0)
+ 1.0797165885654937d-20)
+
+(my-assert
+ (/ -4.56226662576732d-22 0.6695285124602162d0)
+ -6.814148375851899d-22)
+
+(my-assert
+ (/ 6.442796853653397d-21 -0.0419134640377401d0)
+ -1.5371663978553802d-19)
+
+(my-assert
+ (/ -5.584403218169678d-21 -8.092869169805251d9)
+ 6.9003997235062955d-31)
+
+(my-assert
+ (/ -9.796722996869492d-21 -3.2988270899833827d9)
+ 2.9697594719700335d-30)
+
+(my-assert
+ (/ 9.441829923771915d-22 5.464575083746736d9)
+ 1.7278250877830762d-31)
+
+(my-assert
+ (/ -6.419360319610147d-21 -7.333962810289677d9)
+ 8.752921831841952d-31)
+
+(my-assert
+ (/ 7.973734412555454d-21 -9.367577614661436d9)
+ -8.512055880994846d-31)
+
+(my-assert
+ (/ 8.105484193881594d-21 -8.664550975192905d9)
+ -9.354765431108951d-31)
+
+(my-assert
+ (/ -5.3151708182942476d-21 -3.406928289732576d-11)
+ 1.560106455516696d-10)
+
+(my-assert
+ (/ -7.026602845639829d-21 -9.92483846943868d-11)
+ 7.079815824989677d-11)
+
+(my-assert
+ (/ -5.901970468193158d-21 2.074489043942647d-11)
+ -2.8450236868815825d-10)
+
+(my-assert
+ (/ -6.40466723844613d-21 -2.551008177490094d-11)
+ 2.510641594550906d-10)
+
+(my-assert
+ (/ 8.056066940872177d-21 4.645883100460603d-11)
+ 1.7340227394170724d-10)
+
+(my-assert
+ (/ 7.453765056481805d-21 6.956136187014756d-11)
+ 1.0715381148511711d-10)
+
+(my-assert
+ (/ 7.357434693258832d-21 -7.093525088486332d19)
+ -1.0372042956753416d-40)
+
+(my-assert
+ (/ -3.3759558579798473d-21 9.991075630444324d19)
+ -3.3789713769084054d-41)
+
+(my-assert
+ (/ 6.908026973557955d-21 -4.20805893397862d19)
+ -1.6416183998227845d-40)
+
+(my-assert
+ (/ 5.181767322756247d-21 7.46986056263721d19)
+ 6.936899664063931d-41)
+
+(my-assert
+ (/ -5.7217313601659264d-21 5.604979023134118d19)
+ -1.0208301113260054d-40)
+
+(my-assert
+ (/ -9.340193892824771d-21 9.147101848766205d19)
+ -1.021109641857176d-40)
+
+(my-assert
+ (/ 8.331002176099931d-21 2.0276444314093977d-21)
+ 4.108709617449606d0)
+
+(my-assert
+ (/ -3.747505523684784d-21 4.394623185543803d-21)
+ -0.8527478615259381d0)
+
+(my-assert
+ (/ -3.310403953328861d-21 2.3420390876737627d-21)
+ -1.413470838617356d0)
+
+(my-assert
+ (/ 6.23845405853013d-21 -8.933620117412232d-21)
+ -0.6983119918397873d0)
+
+(my-assert
+ (/ -4.276770609150315d-21 6.853299965034864d-21)
+ -0.624045442483205d0)
+
+(my-assert
+ (/ -8.847946637724495d-21 6.33827952828724d-21)
+ -1.3959539963860554d0)
+
+;; ==== L O N G - F L O A T S ====
+
+;;  ---- Test von + ---
+
+(my-assert
+ (+ 0.31465012912061093874L0 -0.07221963987249409544L0)
+ 0.2424304892481168433L0)
+
+(my-assert
+ (+ 0.7168586654865411176L0 -0.19348808923554474066L0)
+ 0.52337057625099637695L0)
+
+(my-assert
+ (+ -0.64115701400120904706L0 0.70535558267169594756L0)
+ 0.0641985686704869005L0)
+
+(my-assert
+ (+ -0.8607621650923123159L0 0.8368256394262067108L0)
+ -0.023936525666105605082L0)
+
+(my-assert
+ (+ 0.44168990042410450855L0 -0.6041911435521196045L0)
+ -0.16250124312801509594L0)
+
+(my-assert
+ (+ 0.0234267775301613878L0 -0.43594485933986284478L0)
+ -0.41251808180970145698L0)
+
+(my-assert
+ (+ -0.99559578594307881024L0 -9.836107054378142702L9)
+ -9.836107055373738488L9)
+
+(my-assert
+ (+ -0.72423071295455899397L0 9.238843039595790172L9)
+ 9.238843038871559459L9)
+
+(my-assert
+ (+ -0.20719390117857393156L0 -9.029224604657100362L9)
+ -9.029224604864294263L9)
+
+(my-assert
+ (+ 0.20816015380514039224L0 -7.4782571284307568003L9)
+ -7.4782571282225966468L9)
+
+(my-assert
+ (+ -0.16613875159201114463L0 -1.203554507952656804L9)
+ -1.2035545081187955556L9)
+
+(my-assert
+ (+ -0.9837368636729942673L0 7.5892747601936916704L9)
+ 7.5892747592099548066L9)
+
+(my-assert
+ (+ -0.92391870362276300936L0 -5.309205414965326826L-11)
+ -0.9239187036758550635L0)
+
+(my-assert
+ (+ -0.2308075581152660786L0 -2.5400598439608570973L-11)
+ -0.23080755814066667704L0)
+
+(my-assert
+ (+ 0.5668336039528930528L0 1.9300606943253841182L-12)
+ 0.56683360395482311353L0)
+
+(my-assert
+ (+ -0.19685144163870526662L0 -8.548847281762266571L-11)
+ -0.19685144172419373944L0)
+
+(my-assert
+ (+ 0.053837363417219887007L0 -8.4734948552444605444L-11)
+ 0.053837363332484938454L0)
+
+(my-assert
+ (+ 0.24539562474220232599L0 -1.3753029433519360674L-11)
+ 0.24539562472844929655L0)
+
+(my-assert
+ (+ -0.83198492765474177585L0 -1.0728971972413839207L19)
+ -1.0728971972413839208L19)
+
+(my-assert
+ (+ 0.58494670591273850794L0 -2.6078285749436068966L19)
+ -2.6078285749436068966L19)
+
+(my-assert
+ (+ -0.6489422625947265175L0 5.675479528094312524L19)
+ 5.675479528094312524L19)
+
+(my-assert
+ (+ 0.82416783003308421654L0 3.4337105673864461624L19)
+ 3.4337105673864461624L19)
+
+(my-assert
+ (+ 0.5977825969561704576L0 9.447212597358366985L19)
+ 9.447212597358366985L19)
+
+(my-assert
+ (+ 0.81709616259702447027L0 1.8840697606071622024L19)
+ 1.8840697606071622024L19)
+
+(my-assert
+ (+ 0.99140689029640294337L0 -7.9441986163714183364L-21)
+ 0.99140689029640294337L0)
+
+(my-assert
+ (+ 0.49487318874207713882L0 -2.377409962381832069L-21)
+ 0.49487318874207713882L0)
+
+(my-assert
+ (+ 0.050320977002567080524L0 -1.3329877923173878127L-21)
+ 0.050320977002567080524L0)
+
+(my-assert
+ (+ -0.25724170819862546218L0 7.609825486664252559L-22)
+ -0.25724170819862546218L0)
+
+(my-assert
+ (+ 0.3667308347763138993L0 4.077152141636570548L-21)
+ 0.3667308347763138993L0)
+
+(my-assert
+ (+ 0.5130660492586603372L0 -5.091230019243679202L-21)
+ 0.5130660492586603372L0)
+
+(my-assert
+ (+ 8.916053557053472733L8 0.59999700846599703845L0)
+ 8.916053563053442818L8)
+
+(my-assert
+ (+ 1.250980635471676891L9 -0.46325398810664378442L0)
+ 1.2509806350084229029L9)
+
+(my-assert
+ (+ -5.548594356609427516L9 -0.21577258386321002115L0)
+ -5.5485943568252001L9)
+
+(my-assert
+ (+ 1.06508055885340104636L9 0.8422978396429581549L0)
+ 1.065080559695698886L9)
+
+(my-assert
+ (+ 6.225756677310580186L9 0.49531151031004978726L0)
+ 6.2257566778058916964L9)
+
+(my-assert
+ (+ -2.273191688409860673L9 -0.80983784631745405196L0)
+ -2.2731916892196985192L9)
+
+(my-assert
+ (+ 5.688674258485728496L8 8.2409948814224157357L9)
+ 8.809862307270988585L9)
+
+(my-assert
+ (+ -2.7544302700606018156L9 9.230174236450698873L9)
+ 6.4757439663900970574L9)
+
+(my-assert
+ (+ -4.588747139238971857L9 6.342892129519977196L9)
+ 1.7541449902810053392L9)
+
+(my-assert
+ (+ 1.5275587581475159762L9 4.3720035959575018324L9)
+ 5.8995623541050178087L9)
+
+(my-assert
+ (+ 2.8881760807020099163L9 7.5622154923755766074L9)
+ 1.0450391573077586524L10)
+
+(my-assert
+ (+ 6.1044519092512786468L9 1.3858854402983849103L9)
+ 7.490337349549663557L9)
+
+(my-assert
+ (+ 4.8767035174458515886L9 6.3051681974292703475L-11)
+ 4.8767035174458515886L9)
+
+(my-assert
+ (+ -9.4188975960705796466L8 -8.975187577611984141L-12)
+ -9.4188975960705796466L8)
+
+(my-assert
+ (+ -9.689819354179956828L9 -9.7453604450079548966L-11)
+ -9.689819354179956828L9)
+
+(my-assert
+ (+ 4.987209054002559248L9 9.284991248759031191L-11)
+ 4.987209054002559248L9)
+
+(my-assert
+ (+ -3.5572071813296941216L9 -6.261737879308894803L-11)
+ -3.5572071813296941216L9)
+
+(my-assert
+ (+ -7.5872628366112743053L9 2.2152240842834943001L-11)
+ -7.5872628366112743053L9)
+
+(my-assert
+ (+ 7.0206128338340270845L9 5.9246012493594508704L19)
+ 5.9246012500615121536L19)
+
+(my-assert
+ (+ 5.3017367315254228474L9 -1.0933628665004153848L19)
+ -1.0933628659702417116L19)
+
+(my-assert
+ (+ -6.339538144593375358L9 -8.0543624921112893224L19)
+ -8.054362492745243137L19)
+
+(my-assert
+ (+ -1.6010717980362600647L9 9.973849926670833376L19)
+ 9.973849926510726196L19)
+
+(my-assert
+ (+ 3.2030522063397198562L9 -2.4396867565423101768L19)
+ -2.4396867562220049562L19)
+
+(my-assert
+ (+ 8.8622195973163761245L9 -6.4961266512803550736L19)
+ -6.496126650394133114L19)
+
+(my-assert
+ (+ 5.45529926142043848L9 6.939479435912862762L-21)
+ 5.45529926142043848L9)
+
+(my-assert
+ (+ -4.484627189114150671L9 -1.6571134694524616111L-21)
+ -4.484627189114150671L9)
+
+(my-assert
+ (+ 8.813820141949620774L9 -2.8267147580155665537L-21)
+ 8.813820141949620774L9)
+
+(my-assert
+ (+ -9.972890003927356798L9 -3.0273462676816521264L-21)
+ -9.972890003927356798L9)
+
+(my-assert
+ (+ 6.792889851253184185L9 -5.937539083879130763L-21)
+ 6.792889851253184185L9)
+
+(my-assert
+ (+ -3.2663407400779399923L9 -4.0747082067253115984L-21)
+ -3.2663407400779399923L9)
+
+(my-assert
+ (+ -3.4242541190221825202L-11 -0.71988400153646663195L0)
+ -0.71988400157070917316L0)
+
+(my-assert
+ (+ -7.8906347145510431055L-11 -0.22021321631029436988L0)
+ -0.22021321638920071702L0)
+
+(my-assert
+ (+ -7.486719858997914782L-11 0.38102237422222776873L0)
+ 0.38102237414736057013L0)
+
+(my-assert
+ (+ -2.6956794925506179954L-12 -0.49627581161649902356L0)
+ -0.49627581161919470304L0)
+
+(my-assert
+ (+ -8.312064814531952837L-11 0.5797009072836515581L0)
+ 0.57970090720053090995L0)
+
+(my-assert
+ (+ -4.0305959593285763394L-11 0.16233584979062195143L0)
+ 0.16233584975031599183L0)
+
+(my-assert
+ (+ 3.731977491280278192L-11 3.0305998235716452734L9)
+ 3.0305998235716452734L9)
+
+(my-assert
+ (+ 2.7847304030282320388L-11 -6.146190065628934066L9)
+ -6.146190065628934066L9)
+
+(my-assert
+ (+ -1.1797664511795163538L-11 1.4888590774768513251L9)
+ 1.4888590774768513251L9)
+
+(my-assert
+ (+ -3.736849276790130025L-11 1.9988395869145483342L9)
+ 1.9988395869145483342L9)
+
+(my-assert
+ (+ 5.7818526942690563386L-12 3.5155514714363584847L9)
+ 3.5155514714363584847L9)
+
+(my-assert
+ (+ 1.8183862272066184134L-11 -4.635399960322760982L9)
+ -4.635399960322760982L9)
+
+(my-assert
+ (+ 3.5539523819420841283L-11 4.3044646394847154864L-11)
+ 7.858417021426799615L-11)
+
+(my-assert
+ (+ 8.719537619908441472L-11 -8.580989797275158101L-11)
+ 1.3854782263328337111L-12)
+
+(my-assert
+ (+ 2.49701168436805957L-12 -2.6066406246366064513L-11)
+ -2.3569394561998004944L-11)
+
+(my-assert
+ (+ 4.2774640500882048993L-11 3.7620100241760410496L-11)
+ 8.039474074264245949L-11)
+
+(my-assert
+ (+ 3.9907211434460210612L-11 9.72066373418363098L-11)
+ 1.3711384877629652041L-10)
+
+(my-assert
+ (+ -7.851637932849992129L-11 4.9296626910685147652L-11)
+ -2.9219752417814773637L-11)
+
+(my-assert
+ (+ 3.14874349918113769L-11 -1.8148353890339025639L19)
+ -1.8148353890339025639L19)
+
+(my-assert
+ (+ -8.444922682942673745L-11 -5.0034364072191331772L19)
+ -5.0034364072191331772L19)
+
+(my-assert
+ (+ 4.762299619586316462L-12 -1.3412404578328588061L19)
+ -1.3412404578328588061L19)
+
+(my-assert
+ (+ -9.22833351501850052L-12 3.1000370791158631634L19)
+ 3.1000370791158631634L19)
+
+(my-assert
+ (+ 6.1164399913981911425L-11 6.1863455383782109436L19)
+ 6.1863455383782109436L19)
+
+(my-assert
+ (+ -8.413645565754525347L-11 -2.5034082588556447364L19)
+ -2.5034082588556447364L19)
+
+(my-assert
+ (+ 3.4875247204061292656L-11 -7.8682893445087250245L-21)
+ 3.487524719619300331L-11)
+
+(my-assert
+ (+ -2.1647610944488691768L-11 -8.371089558230910183L-21)
+ -2.1647610952859781326L-11)
+
+(my-assert
+ (+ 5.7598234760228848032L-11 2.8011007358408259187L-21)
+ 5.7598234763029948767L-11)
+
+(my-assert
+ (+ -9.268425959344303144L-11 -6.4655012698265179856L-21)
+ -9.2684259599908532713L-11)
+
+(my-assert
+ (+ 7.067467072298381137L-11 -3.8206328350148818058L-21)
+ 7.0674670719163178536L-11)
+
+(my-assert
+ (+ 7.8912028748606542386L-11 8.456364925917236866L-21)
+ 7.891202875706290731L-11)
+
+(my-assert
+ (+ -6.976183652817340798L18 0.08822040416435015717L0)
+ -6.976183652817340798L18)
+
+(my-assert
+ (+ -1.2414457404200743984L19 -0.85791705029429396234L0)
+ -1.2414457404200743985L19)
+
+(my-assert
+ (+ -8.9687515173878579424L19 -0.3328210335620137057L0)
+ -8.9687515173878579424L19)
+
+(my-assert
+ (+ -5.438581645592863998L19 -0.67774278184358142436L0)
+ -5.438581645592863998L19)
+
+(my-assert
+ (+ -5.4350840695201649084L19 -0.72739900682842943577L0)
+ -5.4350840695201649084L19)
+
+(my-assert
+ (+ 7.814697448090367615L19 0.24326892882624165414L0)
+ 7.814697448090367615L19)
+
+(my-assert
+ (+ -2.4356768540932142124L19 6.5169042447583127604L9)
+ -2.435676853441523788L19)
+
+(my-assert
+ (+ -8.7464253032141704904L19 6.8315507162032823036L9)
+ -8.7464253025310154184L19)
+
+(my-assert
+ (+ -2.4810334273518910993L18 -7.638114077520272164L9)
+ -2.4810334349900051768L18)
+
+(my-assert
+ (+ -9.80334620432051716L19 4.474822777555302305L9)
+ -9.8033462038730348824L19)
+
+(my-assert
+ (+ -1.5185085475715921137L19 8.496315073274781452L9)
+ -1.5185085467219606064L19)
+
+(my-assert
+ (+ -9.3842548893937585184L19 -9.948865349103608366L9)
+ -9.3842548903886450536L19)
+
+(my-assert
+ (+ 5.9391253980818643888L19 5.6213951287112563564L-11)
+ 5.9391253980818643888L19)
+
+(my-assert
+ (+ -4.8270749631022207188L19 6.506986668488438766L-11)
+ -4.8270749631022207188L19)
+
+(my-assert
+ (+ 8.953940231252599753L19 -1.7735448342981541823L-11)
+ 8.953940231252599753L19)
+
+(my-assert
+ (+ -6.1065165153181616235L18 -1.8103764902203059955L-11)
+ -6.1065165153181616235L18)
+
+(my-assert
+ (+ -9.6224955477275161216L19 9.4659333494557267205L-11)
+ -9.6224955477275161216L19)
+
+(my-assert
+ (+ -9.2620034246522033504L19 -8.920063409062509698L-11)
+ -9.2620034246522033504L19)
+
+(my-assert
+ (+ 5.9633456897700879935L18 4.0390945943970882336L19)
+ 4.6354291633740970328L19)
+
+(my-assert
+ (+ -6.1420542659063065884L19 -3.9869088703267959336L19)
+ -1.01289631362331025216L20)
+
+(my-assert
+ (+ 7.804124970286546613L19 8.061318173712112305L19)
+ 1.5865443143998658918L20)
+
+(my-assert
+ (+ -7.763817772329800516L19 -4.9349702057713961232L19)
+ -1.2698787978101196639L20)
+
+(my-assert
+ (+ -3.1480955091040648274L19 -4.706529024129812914L19)
+ -7.8546245332338777416L19)
+
+(my-assert
+ (+ -4.7131343507844737428L19 5.4602299451983202032L19)
+ 7.470955944138464604L18)
+
+(my-assert
+ (+ 5.9403761194093478956L19 -6.280541343011718101L-21)
+ 5.9403761194093478956L19)
+
+(my-assert
+ (+ -3.763295388652278206L19 -9.963494853851408371L-21)
+ -3.763295388652278206L19)
+
+(my-assert
+ (+ 2.5136958358030666948L19 5.335607709622335287L-21)
+ 2.5136958358030666948L19)
+
+(my-assert
+ (+ 6.2273952762016960176L19 -5.6012630121574213906L-21)
+ 6.2273952762016960176L19)
+
+(my-assert
+ (+ -9.3934610912833028936L19 -2.59552531586503232L-21)
+ -9.3934610912833028936L19)
+
+(my-assert
+ (+ 2.9584554660239488776L19 6.875837450751388893L-21)
+ 2.9584554660239488776L19)
+
+(my-assert
+ (+ -8.4905558825256936576L-21 0.112912972443893420624L0)
+ 0.11291297244389342062L0)
+
+(my-assert
+ (+ -5.3259362300699140443L-21 0.44064771529278198132L0)
+ 0.44064771529278198132L0)
+
+(my-assert
+ (+ -9.245572241572266517L-21 0.043497459079983070442L0)
+ 0.043497459079983070432L0)
+
+(my-assert
+ (+ 7.6311333407948593004L-22 0.74437178299084331024L0)
+ 0.74437178299084331024L0)
+
+(my-assert
+ (+ -7.71114100404407176L-21 -0.30667849853816871164L0)
+ -0.30667849853816871164L0)
+
+(my-assert
+ (+ 3.544120177696956032L-21 0.79322122717232419205L0)
+ 0.79322122717232419205L0)
+
+(my-assert
+ (+ 7.7913861181291523115L-21 8.526554352243632931L9)
+ 8.526554352243632931L9)
+
+(my-assert
+ (+ -3.9196632415032070805L-21 -2.5228304289307799614L9)
+ -2.5228304289307799614L9)
+
+(my-assert
+ (+ 7.643174046933518012L-22 2.9248526891356128762L9)
+ 2.9248526891356128762L9)
+
+(my-assert
+ (+ 1.8801815336593227227L-21 6.8178694125314363L9)
+ 6.8178694125314363L9)
+
+(my-assert
+ (+ -2.6985037225367287349L-21 -4.5571976978858014136L9)
+ -4.5571976978858014136L9)
+
+(my-assert
+ (+ 6.0444611510506986126L-21 -8.64585025875790907L9)
+ -8.64585025875790907L9)
+
+(my-assert
+ (+ -1.250177749198396931L-21 6.428634063301101147L-11)
+ 6.428634063176083372L-11)
+
+(my-assert
+ (+ -1.5666058964343815161L-21 3.552568414787808555L-11)
+ 3.5525684146311479653L-11)
+
+(my-assert
+ (+ -5.8078119773790503857L-21 8.896395897015492877L-12)
+ 8.8963958912076809L-12)
+
+(my-assert
+ (+ 6.7472260162031965506L-21 -6.617115409846031908L-11)
+ -6.617115409171309306L-11)
+
+(my-assert
+ (+ -4.16121984125470857L-21 -3.095053467302410671L-11)
+ -3.095053467718532655L-11)
+
+(my-assert
+ (+ -2.114411383443366621L-21 9.716046816037651671L-11)
+ 9.716046815826210533L-11)
+
+(my-assert
+ (+ -2.3406730990296292957L-21 7.900725768498098123L18)
+ 7.900725768498098123L18)
+
+(my-assert
+ (+ -4.1514248667302411754L-21 -8.4325334951006246184L19)
+ -8.4325334951006246184L19)
+
+(my-assert
+ (+ 8.433933541545648577L-21 -4.9459088765496691632L19)
+ -4.9459088765496691632L19)
+
+(my-assert
+ (+ 2.2922577085250648752L-21 7.813245819908182463L19)
+ 7.813245819908182463L19)
+
+(my-assert
+ (+ 8.887270525300553388L-21 8.651116139112459977L19)
+ 8.651116139112459977L19)
+
+(my-assert
+ (+ 1.1406539199130032192L-21 2.3931812472136783544L19)
+ 2.3931812472136783544L19)
+
+(my-assert
+ (+ -3.778523001798117503L-21 2.0779948578933832532L-22)
+ -3.5707235160087791776L-21)
+
+(my-assert
+ (+ -1.6066062689688361383L-21 -3.5232009896946632975L-21)
+ -5.1298072586634994358L-21)
+
+(my-assert
+ (+ 3.9703618511174300454L-21 -8.036088455194107478L-21)
+ -4.0657266040766774324L-21)
+
+(my-assert
+ (+ 6.46657477279861825L-21 2.6384883907642781157L-21)
+ 9.105063163562896366L-21)
+
+(my-assert
+ (+ 4.9706631077050274314L-21 2.3628052244020145395L-21)
+ 7.333468332107041971L-21)
+
+(my-assert
+ (+ 7.065951142271372955L-21 3.1965272324939519L-21)
+ 1.02624783747653248544L-20)
+
+;;  ---- Test von - ---
+
+(my-assert
+ (- 0.3211111183819802968L0 -0.7024866236309383056L0)
+ 1.0235977420129186024L0)
+
+(my-assert
+ (- -0.29770116676264721836L0 0.8494818768850108081L0)
+ -1.1471830436476580264L0)
+
+(my-assert
+ (- -0.7677860965279355367L0 0.9474539728585997539L0)
+ -1.7152400693865352905L0)
+
+(my-assert
+ (- -0.25414380069764370257L0 0.82619594943351718565L0)
+ -1.0803397501311608883L0)
+
+(my-assert
+ (- 0.21685951051311267031L0 0.13084151170902027524L0)
+ 0.08601799880409239507L0)
+
+(my-assert
+ (- -0.6658362643286463323L0 -0.101768362258000388376L0)
+ -0.56406790207064594393L0)
+
+(my-assert
+ (- -0.8594165074009265017L0 3.58724520062188585L9)
+ -3.5872452014813023575L9)
+
+(my-assert
+ (- -0.58779846333918551446L0 -2.8410824560251060135L9)
+ 2.84108245543730755L9)
+
+(my-assert
+ (- 0.37819983918255152712L0 1.75837003745458279L9)
+ -1.7583700370763829509L9)
+
+(my-assert
+ (- -0.19345242719447268632L0 -8.900743696911070234L9)
+ 8.900743696717617807L9)
+
+(my-assert
+ (- 0.9170636757513836193L0 -5.181144559509726756L9)
+ 5.1811445604267904316L9)
+
+(my-assert
+ (- 0.20643137049004858552L0 3.3215544303850617772L9)
+ -3.3215544301786304067L9)
+
+(my-assert
+ (- -0.4014437452394343757L0 4.7898418688154180505L-11)
+ -0.40144374528733279438L0)
+
+(my-assert
+ (- 0.0725076594551243524L0 -3.5321788599004111594L-11)
+ 0.072507659490446140996L0)
+
+(my-assert
+ (- -0.65551702819898271043L0 3.1653130032883009534L-11)
+ -0.6555170282306358405L0)
+
+(my-assert
+ (- 0.9237105409310637695L0 -8.9028024814928743296L-11)
+ 0.9237105410200917943L0)
+
+(my-assert
+ (- 0.8779771368966066218L0 7.399233988536237696L-12)
+ 0.8779771368892073878L0)
+
+(my-assert
+ (- 0.51385216558296334914L0 -3.3989256599054576304L-11)
+ 0.51385216561695260575L0)
+
+(my-assert
+ (- 0.74939199427992763254L0 -6.6998781480191798724L19)
+ 6.6998781480191798724L19)
+
+(my-assert
+ (- 0.8073774220299670944L0 2.0433771569275457978L18)
+ -2.043377156927545797L18)
+
+(my-assert
+ (- -0.75286822781531276375L0 -7.7011647701976081504L19)
+ 7.7011647701976081504L19)
+
+(my-assert
+ (- -0.6361916050116532222L0 1.2717052281488651182L19)
+ -1.2717052281488651183L19)
+
+(my-assert
+ (- 0.08977643006115956575L0 1.2624046205072289204L19)
+ -1.2624046205072289204L19)
+
+(my-assert
+ (- -0.4220171145412169327L0 8.9155115345908061576L19)
+ -8.9155115345908061576L19)
+
+(my-assert
+ (- 0.397772867452284942L0 5.7785851646148710778L-21)
+ 0.397772867452284942L0)
+
+(my-assert
+ (- -0.53062845978690011166L0 -3.648685738612220277L-21)
+ -0.53062845978690011166L0)
+
+(my-assert
+ (- 0.25409096540159836552L0 -7.8088660109317384514L-21)
+ 0.25409096540159836552L0)
+
+(my-assert
+ (- 0.78038095936361252965L0 5.166705522400390383L-21)
+ 0.78038095936361252965L0)
+
+(my-assert
+ (- 0.2384997171475220939L0 9.580584601627251829L-21)
+ 0.23849971714752209389L0)
+
+(my-assert
+ (- 0.38777493167494073L0 -7.930455614605653916L-22)
+ 0.38777493167494073L0)
+
+(my-assert
+ (- 9.34906594120583919L8 -0.06276538462885111519L0)
+ 9.349065941833493036L8)
+
+(my-assert
+ (- 3.8000098261497040978L9 0.08156195452126583918L0)
+ 3.8000098260681421433L9)
+
+(my-assert
+ (- -8.5084000619874580647L9 -0.49084164337509169664L0)
+ -8.5084000614966164213L9)
+
+(my-assert
+ (- -9.367354572017391158L9 0.7369625068937909906L0)
+ -9.367354572754353665L9)
+
+(my-assert
+ (- 6.810025547716964613L9 -0.65456201729278556224L0)
+ 6.8100255483715266306L9)
+
+(my-assert
+ (- -2.0476539871173359762L9 -0.61684944260168028793L0)
+ -2.0476539865004865336L9)
+
+(my-assert
+ (- 7.927587886187347037L9 -9.075678068210342653L9)
+ 1.700326595439768969L10)
+
+(my-assert
+ (- 8.3881162961959078424L9 -8.168276983460029623L9)
+ 1.6556393279655937465L10)
+
+(my-assert
+ (- -9.837108887605194379L9 -5.518197215327419734L9)
+ -4.3189116722777746445L9)
+
+(my-assert
+ (- 6.0530403690423784372L9 -4.794777582812792957L9)
+ 1.0847817951855171394L10)
+
+(my-assert
+ (- -7.6786817362598780694L8 3.0685743382723052597L9)
+ -3.8364425118982930668L9)
+
+(my-assert
+ (- -1.035869943077157163L9 6.964469962306024778L8)
+ -1.7323169393077596407L9)
+
+(my-assert
+ (- -5.236689202734255992L9 -3.2118444581504684365L-12)
+ -5.236689202734255992L9)
+
+(my-assert
+ (- -5.374622629137047618L9 6.0449117144963868685L-11)
+ -5.374622629137047618L9)
+
+(my-assert
+ (- -1.03444332932187716727L9 -7.849504746710041045L-11)
+ -1.0344433293218771672L9)
+
+(my-assert
+ (- 5.1103879354813158946L8 6.53093826849017485L-11)
+ 5.110387935481315894L8)
+
+(my-assert
+ (- -9.748335199611953219L9 -1.0598402609119659922L-11)
+ -9.748335199611953219L9)
+
+(my-assert
+ (- -7.3482164921795502603L9 7.644598674874161005L-11)
+ -7.3482164921795502603L9)
+
+(my-assert
+ (- -7.4770248834652064083L8 -6.510822784079429222L19)
+ 6.5108227840046589732L19)
+
+(my-assert
+ (- 8.3114910321533068423L9 -6.2387352982669333472L19)
+ 6.2387352990980824504L19)
+
+(my-assert
+ (- -1.0718584220381511548L9 8.521462332927085385L19)
+ -8.521462333034271227L19)
+
+(my-assert
+ (- -1.9155322368803175137L8 1.3150623743950738752L19)
+ -1.3150623744142291976L19)
+
+(my-assert
+ (- 3.8652241507510457716L9 8.702412273358053775L19)
+ -8.70241227297153136L19)
+
+(my-assert
+ (- 2.922009617968977308L8 -8.409184530486676791L19)
+ 8.409184530515896887L19)
+
+(my-assert
+ (- -7.3431860804237713437L9 9.020687655591526829L-21)
+ -7.3431860804237713437L9)
+
+(my-assert
+ (- -1.1188563145822172016L9 -2.7575065881283248758L-21)
+ -1.1188563145822172016L9)
+
+(my-assert
+ (- 2.5835681218682880315L9 -3.786022710650191692L-21)
+ 2.5835681218682880315L9)
+
+(my-assert
+ (- 4.3854765424506375063L9 1.8847509423241615905L-21)
+ 4.3854765424506375063L9)
+
+(my-assert
+ (- -3.4713769831512517224L9 -2.322290027198980782L-21)
+ -3.4713769831512517224L9)
+
+(my-assert
+ (- 414355.71501652302632L0 3.5411352752491676944L-21)
+ 414355.71501652302632L0)
+
+(my-assert
+ (- 9.032857346451659148L-11 0.45111022909893884074L0)
+ -0.45111022900861026729L0)
+
+(my-assert
+ (- -6.5860623447077106086L-11 -0.16349916999618723413L0)
+ 0.16349916993032661068L0)
+
+(my-assert
+ (- -9.239429491581222244L-11 0.34742997377809253703L0)
+ -0.34742997387048683193L0)
+
+(my-assert
+ (- -1.3189202177704638207L-11 0.6447775025861344695L0)
+ -0.64477750259932367166L0)
+
+(my-assert
+ (- -8.6095719029859522596L-11 0.36611643318066821885L0)
+ -0.3661164332667639379L0)
+
+(my-assert
+ (- -7.9284738631391966236L-11 -0.28883099180012157807L0)
+ 0.28883099172083683944L0)
+
+(my-assert
+ (- -9.9602023259578447484L-11 8.944817052366967221L9)
+ -8.944817052366967221L9)
+
+(my-assert
+ (- -4.7036434158090755064L-11 -7.652311009876441256L9)
+ 7.652311009876441256L9)
+
+(my-assert
+ (- -7.237899450242616437L-11 -2.0865196011945540415L9)
+ 2.0865196011945540414L9)
+
+(my-assert
+ (- 1.619466049424876382L-11 5.1184733211578935236L9)
+ -5.1184733211578935236L9)
+
+(my-assert
+ (- 4.1799408897021043963L-11 7.3289378733409777703L9)
+ -7.3289378733409777703L9)
+
+(my-assert
+ (- -7.1652994078281664426L-11 -8.756819754593247181L9)
+ 8.756819754593247181L9)
+
+(my-assert
+ (- -3.7074082585707708083L-11 7.8185038704847907146L-11)
+ -1.1525912129055561523L-10)
+
+(my-assert
+ (- -6.236585731179139659L-11 7.2778046100364844843L-11)
+ -1.3514390341215624144L-10)
+
+(my-assert
+ (- 4.435573645212270856L-11 -5.0777570123416204425L-11)
+ 9.5133306575538912986L-11)
+
+(my-assert
+ (- -8.308776483243665939L-11 9.147453931535851365L-11)
+ -1.7456230414779517304L-10)
+
+(my-assert
+ (- 9.9047307392438733836L-11 -2.5521271062995892868L-11)
+ 1.245685784554346267L-10)
+
+(my-assert
+ (- 7.964304540045338675L-11 -8.2763721216842256806L-11)
+ 1.6240676661729564355L-10)
+
+(my-assert
+ (- 6.3981149909251410836L-11 -8.199461198383311753L19)
+ 8.199461198383311753L19)
+
+(my-assert
+ (- 3.2676777703423324814L-11 4.4068061681801047868L19)
+ -4.4068061681801047868L19)
+
+(my-assert
+ (- -6.239367423070186989L-11 3.6883672788938434168L19)
+ -3.6883672788938434168L19)
+
+(my-assert
+ (- -2.2122757699951901351L-11 2.1264312306673926188L19)
+ -2.1264312306673926188L19)
+
+(my-assert
+ (- 8.873182931301984606L-11 1.6930709481447417272L19)
+ -1.6930709481447417272L19)
+
+(my-assert
+ (- -6.88393272917067128L-11 9.590650870092490293L19)
+ -9.590650870092490293L19)
+
+(my-assert
+ (- 6.858643038376546876L-11 7.344128953107545512L-21)
+ 6.858643037642133981L-11)
+
+(my-assert
+ (- 2.6458055358368033053L-11 5.403788941414579396L-21)
+ 2.6458055352964244111L-11)
+
+(my-assert
+ (- -2.0808117056914325832L-11 -9.598437242399057154L-21)
+ -2.080811704731588859L-11)
+
+(my-assert
+ (- -6.7475294377176982065L-11 7.066634775850918749L-21)
+ -6.747529438424361684L-11)
+
+(my-assert
+ (- -9.3542684131795074026L-11 -2.671834604826394793L-22)
+ -9.354268413152789057L-11)
+
+(my-assert
+ (- -3.656675383727620855L-11 -5.7226858095399702763L-21)
+ -3.656675383155352274L-11)
+
+(my-assert
+ (- 4.4004114393746579576L19 0.9981645829158248139L0)
+ 4.4004114393746579576L19)
+
+(my-assert
+ (- -2.1157157847974045162L19 -0.73136590134089295135L0)
+ -2.1157157847974045162L19)
+
+(my-assert
+ (- -6.58288354566033103L19 0.6435204448077814454L0)
+ -6.58288354566033103L19)
+
+(my-assert
+ (- -6.1300052513232283715L18 0.37782114066015354996L0)
+ -6.130005251323228372L18)
+
+(my-assert
+ (- -8.3428987469650376416L19 0.092302889297602909923L0)
+ -8.3428987469650376416L19)
+
+(my-assert
+ (- 4.478146018721476673L18 -0.7594367116407568048L0)
+ 4.4781460187214766738L18)
+
+(my-assert
+ (- 3.9553793567888621644L19 7.272309486263127643L9)
+ 3.9553793560616312156L19)
+
+(my-assert
+ (- 8.4985452245750157485L18 -8.180191224624705388L9)
+ 8.498545232755206973L18)
+
+(my-assert
+ (- -4.9006940756698268444L19 5.635530637330344937L9)
+ -4.900694076233379908L19)
+
+(my-assert
+ (- 3.321094625885548145L19 7.739325488496469393L9)
+ 3.3210946251116155962L19)
+
+(my-assert
+ (- -4.094717236852398814L19 2.8833151826524522544L9)
+ -4.0947172371407303324L19)
+
+(my-assert
+ (- -7.297938416992967256L19 1.7849049534461509205L9)
+ -7.2979384171714577512L19)
+
+(my-assert
+ (- -1.6274534493365811085L19 -7.214220253590898893L-11)
+ -1.6274534493365811085L19)
+
+(my-assert
+ (- -8.8349360721401487896L19 4.4201546048906225832L-11)
+ -8.8349360721401487896L19)
+
+(my-assert
+ (- 2.1193875854469716176L19 5.4852102858193519493L-11)
+ 2.1193875854469716176L19)
+
+(my-assert
+ (- 5.8956188285652689564L19 5.2591781987716878005L-12)
+ 5.8956188285652689564L19)
+
+(my-assert
+ (- 3.8130742288947136824L19 -6.2032926048476626596L-11)
+ 3.8130742288947136824L19)
+
+(my-assert
+ (- -8.2648264381835919784L19 5.240041099543619651L-11)
+ -8.2648264381835919784L19)
+
+(my-assert
+ (- -8.9795702979594840016L19 5.3071479395700422216L19)
+ -1.4286718237529526223L20)
+
+(my-assert
+ (- 7.4902067869555502376L19 8.527286348112666809L18)
+ 6.6374781521442835568L19)
+
+(my-assert
+ (- -9.945686226441305483L19 -7.164943842935287866L19)
+ -2.7807423835060176172L19)
+
+(my-assert
+ (- -6.9451908461424534725L18 1.7337328244166615333L19)
+ -2.4282519090309068806L19)
+
+(my-assert
+ (- -7.2554820480127785552L19 -3.6345553532831870424L19)
+ -3.6209266947295915128L19)
+
+(my-assert
+ (- 4.80739562024854996L19 -9.8058600290712759904L19)
+ 1.46132556493198259504L20)
+
+(my-assert
+ (- -2.2910115296639597206L19 3.7450560231732721633L-21)
+ -2.2910115296639597206L19)
+
+(my-assert
+ (- 6.3398397438838205245L18 5.9452907771459291318L-21)
+ 6.3398397438838205245L18)
+
+(my-assert
+ (- -3.6223171453314706578L19 -7.3897558037422565484L-21)
+ -3.6223171453314706578L19)
+
+(my-assert
+ (- -5.253323265732561348L19 -2.4894382246759080012L-21)
+ -5.253323265732561348L19)
+
+(my-assert
+ (- 8.706482285826808214L18 -5.353671688426432468L-21)
+ 8.706482285826808214L18)
+
+(my-assert
+ (- 2.2257683364797036278L18 -8.640543721759613242L-21)
+ 2.2257683364797036278L18)
+
+(my-assert
+ (- 4.793610535063041737L-21 -0.46707949288138879385L0)
+ 0.46707949288138879385L0)
+
+(my-assert
+ (- -8.1177127707349576126L-22 -0.524723160625887566L0)
+ 0.524723160625887566L0)
+
+(my-assert
+ (- 4.3845050204409245572L-21 0.25137862247046227512L0)
+ -0.25137862247046227512L0)
+
+(my-assert
+ (- 9.521149905664397992L-21 -0.8412363166750659234L0)
+ 0.8412363166750659234L0)
+
+(my-assert
+ (- 9.174773471390805996L-21 -0.101196005202611894716L0)
+ 0.10119600520261189472L0)
+
+(my-assert
+ (- 7.109559498077443181L-21 0.9205539164614073537L0)
+ -0.9205539164614073537L0)
+
+(my-assert
+ (- 4.698785699006337068L-21 -2.1800327611972026394L9)
+ 2.1800327611972026394L9)
+
+(my-assert
+ (- 5.613624265510662971L-21 -9.950548243828975189L9)
+ 9.950548243828975189L9)
+
+(my-assert
+ (- 4.6909741937286841078L-21 -1.7837781830572891826L9)
+ 1.7837781830572891826L9)
+
+(my-assert
+ (- -4.846242463794952647L-21 -8.0162418694778434667L9)
+ 8.0162418694778434667L9)
+
+(my-assert
+ (- 2.40959428070040729L-21 -8.889381116534260471L9)
+ 8.889381116534260471L9)
+
+(my-assert
+ (- 3.767840665510686708L-21 -6.5742819327593306936L9)
+ 6.5742819327593306936L9)
+
+(my-assert
+ (- -4.2984578582437655097L-21 -7.11707524430297521L-11)
+ 7.117075243873129424L-11)
+
+(my-assert
+ (- -8.2197602823824843314L-21 5.6157517586290544195L-11)
+ -5.6157517594510304478L-11)
+
+(my-assert
+ (- 9.693403466151038911L-21 -2.4790192993953556532L-11)
+ 2.4790193003646959998L-11)
+
+(my-assert
+ (- -1.7473025967684817638L-21 -6.763791909706180161L-11)
+ 6.763791909531449901L-11)
+
+(my-assert
+ (- -4.545821853960128388L-21 -2.0149758755990572603L-11)
+ 2.0149758751444750749L-11)
+
+(my-assert
+ (- -6.727743751498960878L-21 4.6105155267302345166L-11)
+ -4.6105155274030088917L-11)
+
+(my-assert
+ (- 3.1693009676315354841L-21 -8.292132887357976433L19)
+ 8.292132887357976433L19)
+
+(my-assert
+ (- -1.5197222855116101305L-21 -6.8790212191073234628L19)
+ 6.8790212191073234628L19)
+
+(my-assert
+ (- 9.221684449614781083L-21 -5.9085200983462461748L19)
+ 5.9085200983462461748L19)
+
+(my-assert
+ (- 8.784720275148798145L-21 -3.507151222326700691L19)
+ 3.507151222326700691L19)
+
+(my-assert
+ (- 3.824100155304652155L-21 1.2903444775641864255L19)
+ -1.2903444775641864255L19)
+
+(my-assert
+ (- -1.0750770892330241413L-21 2.516785805333378789L19)
+ -2.516785805333378789L19)
+
+(my-assert
+ (- -9.607606672669937465L-21 2.8158700323501294737L-21)
+ -1.2423476705020066939L-20)
+
+(my-assert
+ (- 7.9685140548406097L-21 -1.4252185339263422407L-21)
+ 9.393732588766951941L-21)
+
+(my-assert
+ (- -3.1900732903251523987L-21 1.30212230775860485605L-21)
+ -4.4921955980837572548L-21)
+
+(my-assert
+ (- 2.845180721925488069L-21 9.0340678136597289194L-21)
+ -6.1888870917342408505L-21)
+
+(my-assert
+ (- -5.1500491616497403683L-21 -5.4818765813663490764L-21)
+ 3.3182741971660870814L-22)
+
+(my-assert
+ (- 5.3946808417918276896L-21 2.1630450195342998269L-21)
+ 3.2316358222575278627L-21)
+
+;;  ---- Test von * ---
+
+(my-assert
+ (* 0.49162375558276684976L0 -0.27595139770835290185L0)
+ -0.13566426249969417521L0)
+
+(my-assert
+ (* -0.43085705615141429406L0 0.76537655129782028376L0)
+ -0.32976788773950077688L0)
+
+(my-assert
+ (* -0.34725675573811781168L0 -0.44040731024013641718L0)
+ 0.15293441375734052306L0)
+
+(my-assert
+ (* -0.47158645084591665022L0 -0.5531952534025612003L0)
+ 0.26087938617692133303L0)
+
+(my-assert
+ (* -0.86377959068682791106L0 -0.8711108145957097161L0)
+ 0.7524477428743513754L0)
+
+(my-assert
+ (* 0.07688091831246728666L0 -0.727039245375017451L0)
+ -0.055895444833634576195L0)
+
+(my-assert
+ (* -0.65693719777446694155L0 -5.4929597366864347663L9)
+ 3.6085295769067602507L9)
+
+(my-assert
+ (* 0.9553509506606886749L0 2.7316499794256227606L9)
+ 2.609684404716519364L9)
+
+(my-assert
+ (* 0.86245066819702621825L0 -5.6471738746979076876L9)
+ -4.8704088816580000957L9)
+
+(my-assert
+ (* -0.0011095142242845852372L0 3.5868904614046262004L9)
+ -3979705.9878791318615L0)
+
+(my-assert
+ (* -0.07537979049336559763L0 8.268739091555253606L9)
+ -6.2329582036573719373L8)
+
+(my-assert
+ (* -0.67924101443000006024L0 -4.2094803212494913754L9)
+ 2.8592516836286270604L9)
+
+(my-assert
+ (* 0.30774277681107480866L0 -2.7334742019139702906L-11)
+ -8.412069412384417957L-12)
+
+(my-assert
+ (* -0.35713749207523871768L0 -6.5398928539622633783L-11)
+ 2.3356409323048581577L-11)
+
+(my-assert
+ (* -0.14801577485738927266L0 -9.963460779718656755L-11)
+ 1.474749367571264873L-11)
+
+(my-assert
+ (* 0.3104124542612814659L0 -2.9286317751062608258L-11)
+ -9.09083776938307737L-12)
+
+(my-assert
+ (* -0.11446530018625016218L0 6.4232974401995419684L-11)
+ -7.352446696780128213L-12)
+
+(my-assert
+ (* -0.96939447601348607505L0 4.1094462170225605183L-11)
+ -3.9836744622561876338L-11)
+
+(my-assert
+ (* 0.051486415762180288123L0 9.676829213398296352L19)
+ 4.9822525214063672425L18)
+
+(my-assert
+ (* 0.6313327973134614946L0 3.2653448877462378072L19)
+ 2.06151932217404323L19)
+
+(my-assert
+ (* -0.37403303660944479204L0 9.102796469067070187L19)
+ -3.4047466049628882508L19)
+
+(my-assert
+ (* 0.8707828063294901403L0 -5.5603708853312765524L19)
+ -4.8418753637615606188L19)
+
+(my-assert
+ (* -0.21026381134874289964L0 -8.2572592232280544185L18)
+ 1.7362027955704909688L18)
+
+(my-assert
+ (* -0.77817271482774886984L0 -5.862569134483721118L19)
+ 4.5620913392465632268L19)
+
+(my-assert
+ (* 0.10774233598980040668L0 8.42277329172514105L-21)
+ 9.074892699629673044L-22)
+
+(my-assert
+ (* 0.25190108887664378198L0 9.9261121984538427104L-21)
+ 2.5003984711022594346L-21)
+
+(my-assert
+ (* -0.6756036645959631085L0 9.531794528346356556L-21)
+ -6.4397153135265482465L-21)
+
+(my-assert
+ (* -0.6857203923976410447L0 -1.6874445000752253093L-21)
+ 1.1571151047408247225L-21)
+
+(my-assert
+ (* -0.44633489376857998266L0 2.2805928928283052886L-21)
+ -1.0179081865499001544L-21)
+
+(my-assert
+ (* 0.6194914893234261562L0 6.122106446320417613L-21)
+ 3.7925928402275834338L-21)
+
+(my-assert
+ (* 6.0914569120648219218L9 -0.13082334282848865785L0)
+ -7.969047559320230858L8)
+
+(my-assert
+ (* 3.6214037646489572409L9 -0.42724054260765242458L0)
+ -1.5472105094100157093L9)
+
+(my-assert
+ (* -2.3587970682548096273L9 0.30389573937962490564L0)
+ -7.168283791037869264L8)
+
+(my-assert
+ (* -1.2092840284272862272L9 -0.9464357317324953064L0)
+ 1.1445096143169982957L9)
+
+(my-assert
+ (* 9.742195251878672378L9 -0.8436238049826486367L0)
+ -8.2187478272737786206L9)
+
+(my-assert
+ (* -1.6670311480587791415L9 -0.7664626357070004785L0)
+ 1.277717087546798815L9)
+
+(my-assert
+ (* -9.63709082566058824L8 3.5038182805272664595L9)
+ -3.376661500605117691L18)
+
+(my-assert
+ (* -6.819958133674458717L9 5.570090504807835795L9)
+ -3.7987784043567071428L19)
+
+(my-assert
+ (* 5.7990616985027046753L9 5.7633314369957429715L9)
+ 3.3421914592058566914L19)
+
+(my-assert
+ (* -8.4466610113280742876L9 -8.965949996407538079L9)
+ 7.5732340264172639616L19)
+
+(my-assert
+ (* -7.670563670654851578L9 -6.431751468798164421L9)
+ 4.9335159155244181172L19)
+
+(my-assert
+ (* 8.268803418474998627L9 -6.6310260568279516366L9)
+ -5.4830650926695757004L19)
+
+(my-assert
+ (* -9.461472353405244053L9 -3.3101188730107237675L-11)
+ 0.31318598203475886787L0)
+
+(my-assert
+ (* 6.8579221981166585744L9 -8.515361268298587097L-11)
+ -0.5839768506684770405L0)
+
+(my-assert
+ (* 1.6137913170162297342L9 -8.897666779537493419L-11)
+ -0.14358977390521366923L0)
+
+(my-assert
+ (* 8.022366744559274285L9 6.8759798363047156095L-11)
+ 0.5516163197503107306L0)
+
+(my-assert
+ (* 6.268637730252729325L8 3.8798987053952144677L-13)
+ 2.4321679414199160154L-4)
+
+(my-assert
+ (* 8.165455714479826517L9 -7.748491839935670887L-11)
+ -0.6326996697300302909L0)
+
+(my-assert
+ (* -9.245309913477613381L9 -2.7267702243723164598L19)
+ 2.5209835787164953515L29)
+
+(my-assert
+ (* 9.113617507957836761L9 -3.6781774780542862056L19)
+ -3.3521502661371744663L29)
+
+(my-assert
+ (* 3695599.756951605604L0 -4.4160607831464309996L19)
+ -1.6319993156879467502L26)
+
+(my-assert
+ (* -3.1080975558777002585L9 4.5635619314557275256L19)
+ -1.41839956852540638L29)
+
+(my-assert
+ (* 4.379846040113489209L9 -2.380244519018666713L19)
+ -1.0425104531125744157L29)
+
+(my-assert
+ (* 7.799437686108443071L9 -8.213835920178370665L19)
+ -6.40633014233504056L29)
+
+(my-assert
+ (* -5.0032293022496024175L9 3.9947928432298324106L-21)
+ -1.9986864609664499789L-11)
+
+(my-assert
+ (* 5.1002825856458055377L9 -8.630588067810955288L-21)
+ -4.4018438026138695895L-11)
+
+(my-assert
+ (* -1.4798783656292287931L9 -2.1821599778945012917L-21)
+ 3.2293313416280286032L-12)
+
+(my-assert
+ (* 6.2153176651245460436L9 -4.842239650508967686L-21)
+ -3.009605763857489489L-11)
+
+(my-assert
+ (* 1.1476929860538426329L9 8.143327858153323155L-21)
+ 9.34604026593943011L-12)
+
+(my-assert
+ (* -6.8097130569212408313L9 -4.5006072118169309446L-21)
+ 3.0647843694383655263L-11)
+
+(my-assert
+ (* -8.088711469864653681L-11 0.55856748494727835656L0)
+ -4.518091222186502735L-11)
+
+(my-assert
+ (* 4.4880121763658923538L-11 0.14537105272497022953L0)
+ 6.52427054720794526L-12)
+
+(my-assert
+ (* 2.0273639671422034382L-11 0.5267742506127895251L0)
+ 1.0679631345107062621L-11)
+
+(my-assert
+ (* -9.078881981481347403L-11 0.86040896737522678964L0)
+ -7.811551470607918988L-11)
+
+(my-assert
+ (* -7.2713602444015266416L-11 0.029963115152720655096L0)
+ -2.1787260431991794891L-12)
+
+(my-assert
+ (* 5.8587076221559354985L-11 0.39205420166003709617L0)
+ 2.2969309395639195554L-11)
+
+(my-assert
+ (* 9.465227148840012531L-12 -8.4020295562921954743L9)
+ -0.07952711826157309293L0)
+
+(my-assert
+ (* -9.156088652050785426L-11 -7.272635024207867507L9)
+ 0.66588891015656744834L0)
+
+(my-assert
+ (* 3.6865969618651574387L-11 4.532198690564411727L9)
+ 0.16708389923204005057L0)
+
+(my-assert
+ (* -7.773548969171738747L-11 6.487140494299404015L9)
+ -0.5042810430233337584L0)
+
+(my-assert
+ (* 3.181536837232243521L-12 -8.8275599983550392825L8)
+ -0.0028085207317644360498L0)
+
+(my-assert
+ (* 3.512130320642090343L-11 -6.775467122704530228L9)
+ -0.23796323518164203024L0)
+
+(my-assert
+ (* -7.489684894543042722L-11 1.3562671200654034619L-11)
+ -1.015801336211924759L-21)
+
+(my-assert
+ (* -6.615171167169027831L-11 6.4492881876773102747L-11)
+ -4.2663145267886736825L-21)
+
+(my-assert
+ (* 5.9969037329081164062L-12 6.979117807067958578L-11)
+ 4.1853097629611348155L-22)
+
+(my-assert
+ (* -9.1419010578306515213L-11 -3.0321662473944421986L-11)
+ 2.7719763824573648138L-21)
+
+(my-assert
+ (* 8.653994294784604749L-11 -2.618325063862645785L-12)
+ -2.2658970164558872502L-22)
+
+(my-assert
+ (* 3.778177082827084054L-11 5.7986141594804582746L-11)
+ 2.1908191129505701787L-21)
+
+(my-assert
+ (* 9.107023861930220456L-11 -8.1609888558011610015L18)
+ -7.432232024672778029L8)
+
+(my-assert
+ (* -6.185675579794400257L-11 8.145498215172660237L19)
+ -5.0385409394852397568L9)
+
+(my-assert
+ (* -5.0086846264250856304L-12 7.333671928137704804L19)
+ -3.6732049841708537418L8)
+
+(my-assert
+ (* -6.133300578664362783L-11 -4.647031661618042392L19)
+ 2.8501641979273554706L9)
+
+(my-assert
+ (* 4.014159298839782726L-12 7.077385833663047478L18)
+ 2.8409754155675469803L7)
+
+(my-assert
+ (* 3.9529027598797003857L-11 3.1931221840357166776L19)
+ 1.2622101493907881026L9)
+
+(my-assert
+ (* 5.2407793550579649295L-11 8.178146405814506225L-21)
+ 4.2859860846234161862L-31)
+
+(my-assert
+ (* -4.5792905534935737864L-11 -1.1970719995732820388L-21)
+ 5.481740499497593831L-32)
+
+(my-assert
+ (* 4.113879746633747024L-11 5.1093090279978304893L-21)
+ 2.1019082929573231173L-31)
+
+(my-assert
+ (* 1.9918804321687295055L-11 1.8243807936344826748L-21)
+ 3.6339484036649830696L-32)
+
+(my-assert
+ (* -6.1549842617771214656L-11 7.210193834294849238L-22)
+ -4.4378629574447235495L-32)
+
+(my-assert
+ (* -3.483482946766538465L-12 7.8771698631837073084L-22)
+ -2.743998688718375137L-33)
+
+(my-assert
+ (* -3.0540130142847980374L19 -0.08015004741507677209L0)
+ 2.4477928790118809798L18)
+
+(my-assert
+ (* -7.721729897125586787L19 -0.71282981020428696123L0)
+ 5.5042792570168003116L19)
+
+(my-assert
+ (* 6.855667806362567159L18 0.83087248440613607433L0)
+ 5.69618574253563119L18)
+
+(my-assert
+ (* -1.0247670372283575993L17 -0.21215039186338500874L0)
+ 2.1740472851667611836L16)
+
+(my-assert
+ (* -4.2451902701279432204L19 0.363650960045267158L0)
+ -1.5437675173068535736L19)
+
+(my-assert
+ (* -2.3286355030172533736L19 0.49713327148260372132L0)
+ -1.1576421857055056984L19)
+
+(my-assert
+ (* -6.1529172975127592432L19 -7.1685660040728041152L9)
+ 4.4107593764821477366L29)
+
+(my-assert
+ (* 6.7120643409032119372L19 -2.1673488299796731996L9)
+ -1.45473847960048627434L29)
+
+(my-assert
+ (* 8.1354429987417636456L19 -7.205222753181797397L9)
+ -5.861767900174770815L29)
+
+(my-assert
+ (* 7.1263614941049137416L19 5.4835530180135407083L8)
+ 3.907778107845448494L28)
+
+(my-assert
+ (* 5.0833800113097826724L19 -6.2188724451883454807L9)
+ -3.1612891880755627472L29)
+
+(my-assert
+ (* -7.0947371956905508468L19 -2.434705753418370145L9)
+ 1.7273597469339097183L29)
+
+(my-assert
+ (* 6.6532780031620346828L19 -5.126482819920582625L-11)
+ -3.4107915379365690604L9)
+
+(my-assert
+ (* 3.3916052110984390742L19 1.2477416554656457027L-11)
+ 4.2318471007818771302L8)
+
+(my-assert
+ (* -2.0596546301412947634L18 1.4681903489886446838L-11)
+ -3.0239650502232254483L7)
+
+(my-assert
+ (* 5.4448198096650564945L18 -8.328351500006325204L-11)
+ -4.534637322908812735L8)
+
+(my-assert
+ (* -9.0101064221252591136L19 -8.313725422339249255L-11)
+ 7.4907550819604901853L9)
+
+(my-assert
+ (* 9.807792586975021252L19 -8.1013942555768171325L-11)
+ -7.9456794524008327797L9)
+
+(my-assert
+ (* -6.569928333884882197L17 1.8031274577764523257L19)
+ -1.1846418174451330701L37)
+
+(my-assert
+ (* 9.966374081256518232L19 1.1925741835931471136L18)
+ 1.1885640433338393863L38)
+
+(my-assert
+ (* -5.1958776350000747272L19 9.541066943279536452L19)
+ -4.957421634462466998L39)
+
+(my-assert
+ (* 3.0864687811444473814L19 -7.292720897062086383L17)
+ -2.2508755378381858676L37)
+
+(my-assert
+ (* -4.9023499593352016396L19 -7.837521201177228469L19)
+ 3.8422271741879966693L39)
+
+(my-assert
+ (* 1.1092141282192635266L19 -8.705681388875638857L19)
+ -9.656464792316359058L38)
+
+(my-assert
+ (* 9.719341608862581484L18 3.910223765755272544L-21)
+ 0.038004800546468552602L0)
+
+(my-assert
+ (* 9.0834836835472717744L19 2.3217130663560934873L-22)
+ 0.021089242756124079488L0)
+
+(my-assert
+ (* -8.9569500426805542816L19 -6.8114530414478270673L-22)
+ 0.061009844610312705923L0)
+
+(my-assert
+ (* -6.250871904307721917L18 -1.7897852706103755451L-21)
+ 0.01118771846280218958L0)
+
+(my-assert
+ (* -4.8350255195162635852L19 -5.4114390027140489403L-21)
+ 0.26164445675428065787L0)
+
+(my-assert
+ (* -3.787718813779143278L19 4.715777953310022763L-22)
+ -0.017862040875357275534L0)
+
+(my-assert
+ (* -9.6946973380533561685L-21 0.29842171245928506197L0)
+ -2.8931081813963549629L-21)
+
+(my-assert
+ (* -1.5138229787560283214L-21 -0.63587548364028950173L0)
+ 9.626029187622732088L-22)
+
+(my-assert
+ (* 6.9088409628577453984L-21 0.6675889882861618064L0)
+ 4.6122661486241942486L-21)
+
+(my-assert
+ (* -5.9331491274547789645L-21 0.1840021396402183602L0)
+ -1.0917121342561739605L-21)
+
+(my-assert
+ (* 6.5714942924276749333L-21 0.042451475976117785684L0)
+ 2.789696320821885891L-22)
+
+(my-assert
+ (* 8.381861494201174241L-21 -0.14355711097860731382L0)
+ -1.2032758207303532943L-21)
+
+(my-assert
+ (* 2.014342763215141127L-21 -1.2338457666735291661L9)
+ -2.4853882910224610282L-12)
+
+(my-assert
+ (* -5.670580024618139724L-21 -8.0192486381311308156L8)
+ 4.5473791139832611237L-12)
+
+(my-assert
+ (* -1.9225557816894129732L-21 7.9269598913745234357L9)
+ -1.5240022570382171054L-11)
+
+(my-assert
+ (* 4.0368254062037218916L-21 -9.5325393449487114215L8)
+ -3.848119701332554298L-12)
+
+(my-assert
+ (* 4.2776037356780859957L-21 -5.1221437260809706463L9)
+ -2.1910501137364030878L-11)
+
+(my-assert
+ (* -6.7334467986153699064L-21 -7.7745493828541701813L9)
+ 5.2349514652656512034L-11)
+
+(my-assert
+ (* -4.315187380180362795L-21 1.3410692406986483366L-11)
+ -5.786965063410868682L-32)
+
+(my-assert
+ (* 3.343397258359340776L-21 3.0757040339096610197L-12)
+ 1.0283300434498325547L-32)
+
+(my-assert
+ (* 8.5537743863632264L-21 7.5263454541513394514L-11)
+ 6.4378660968641032133L-31)
+
+(my-assert
+ (* -2.842610565794174946L-21 3.153716909493170071L-11)
+ -8.9647890084490369953L-32)
+
+(my-assert
+ (* 2.8400800161467519014L-22 2.0497242686367281441L-11)
+ 5.8213809339661880995L-33)
+
+(my-assert
+ (* 9.982896581447590365L-21 1.6568727649785948007L-11)
+ 1.654038946139843086L-31)
+
+(my-assert
+ (* 4.678227176611232891L-21 8.297236114758786796L19)
+ 0.38816355482824754693L0)
+
+(my-assert
+ (* -2.7181316933272033506L-21 -7.7081523870452907184L19)
+ 0.20951773300223540615L0)
+
+(my-assert
+ (* 3.755562697893016061L-21 -9.043255746258523336L19)
+ -0.33962513948155180184L0)
+
+(my-assert
+ (* -6.788248742851763723L-21 -2.3639021583849588926L19)
+ 0.16046755854881268057L0)
+
+(my-assert
+ (* -4.100847017987407598L-21 -3.6481227061862975968L19)
+ 0.14960393120916230025L0)
+
+(my-assert
+ (* -2.001548479939126796L-21 -8.705055796099425971L19)
+ 0.17423591196468091344L0)
+
+(my-assert
+ (* -3.670443367722997441L-21 3.6588667206894740936L-22)
+ -1.34296630883370731296L-42)
+
+(my-assert
+ (* -6.6783435670093499397L-22 -8.113066551196750321L-21)
+ 5.4181845810903550342L-42)
+
+(my-assert
+ (* 4.816859192586505112L-21 -1.1868626619923445382L-22)
+ -5.716950323755514841L-43)
+
+(my-assert
+ (* 4.6402358755296483015L-21 -4.244356902115351796L-22)
+ -1.9694817165747535215L-42)
+
+(my-assert
+ (* 9.3247068197076461794L-21 3.5271238356611001996L-21)
+ 3.288939568434245211L-41)
+
+(my-assert
+ (* 8.7860048755888267426L-21 7.187872989134290154L-21)
+ 6.315268712764710716L-41)
+
+;;  ---- Test von FLOOR ---
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.9677507664075728311L0 0.09829392666835353511L0))
+ (-10 0.015188500275962520004L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.084596576622269801105L0 -0.78271578747309396924L0))
+ (0 -0.084596576622269801105L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.97785517019559092334L0 -0.24687352093087197807L0))
+ (-4 -0.009638913527896988987L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.36348468689259258175L0 0.5156866254701831051L0))
+ (0 0.36348468689259258175L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.51463186192345608164L0 0.8683136279312965567L0))
+ (-1 0.35368176600784047506L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.36128372948365635348L0 -0.5061584717303788097L0))
+ (-1 -0.1448747422467224562L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.83188875677783952054L0 -6.988497329115560525L9))
+ (0 -0.83188875677783952054L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.09110744229488624391L0 -9.792597852253288497L9))
+ (0 -0.09110744229488624391L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.23616060202132526459L0 -1.5882829404848723914L9))
+ (-1 -1.5882829402487117894L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.09652925723903261584L0 6.2261024177069773893L9))
+ (-1 6.226102417610448132L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.5413601234707634158L0 9.144943549323542538L9))
+ (0 0.5413601234707634158L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.57037258938648310115L0 4.436821091919698621L9))
+ (-1 4.4368210913493260317L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.9973297751770725278L0 3.4051851548139874998L-11))
+ (-29288562291 1.4506986275662661537L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.6604979952397203417L0 -4.3497555374342239963L-11))
+ (-15184715315 -1.8114827519649365006L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.38589975187928444138L0 1.0289103184336123803L-12))
+ (375056742036 3.5046726009323829848L-13))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.9402638162334174371L0 4.2262799834524861567L-11))
+ (22248024738 1.7766010468098603481L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.8642082843541437474L0 8.911777256338402297L-11))
+ (-9697373033 6.304376014060421794L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.7435773981922973139L0 5.910629837324535378L-11))
+ (12580341159 1.1224045374678474888L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.7898063255151059068L0 1.2757118849664610875L18))
+ (0 0.7898063255151059068L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.19544684487626281231L0 -3.6071314846523434156L19))
+ (-1 -3.6071314846523434156L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.032130218136830583316L0 -3.367647816525978896L18))
+ (0 -0.032130218136830583316L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.25693079625787854222L0 2.3815464531684079734L19))
+ (-1 2.3815464531684079734L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -0.3975875412090936933L0 3.9957351306215043416L19))
+ (-1 3.9957351306215043416L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.16223305219726616216L0 -5.3922124894358790612L19))
+ (-1 -5.3922124894358790612L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.14869268750642991106L0 -4.676414410846522305L-21))
+ (-31796302560686368198 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.4848921957991629974L0 7.275052251851656838L-21))
+ (66651369504012501536 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.44996459510190342355L0 -3.96515259272563559L-21))
+ (-113479767696052002376 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.7246909129638354568L0 -1.2540349367528059089L-21))
+ (-577887339279675740320 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.83383904440522878455L0 3.5186204165781412753L-21))
+ (236978970643311773536 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 0.26779759740636464572L0 -6.954613119627800336L-21))
+ (-38506469418200611672 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.4845680268023566543L9 -0.2629469688312594538L0))
+ (28464173061 -0.1240146549242767677L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.1612132433805581187L9 -0.09975641287987705455L0))
+ (-61762578120 -0.083822638930812785824L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.6629628120558108524L9 0.35361739315194823028L0))
+ (-10358548203 0.32784699422401302726L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.999024858613990497L9 -0.6086338795192380592L0))
+ (11499564999 -0.48897756390533489348L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.2927999071819381092L9 -0.8483437666321241058L0))
+ (-5060212707 -0.6341788853647631104L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.377925687006929662L9 0.3220507356662819166L0))
+ (-13593900595 0.18712780555802854961L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.5387759396672939425L9 7.7154581598602048657L9))
+ (-2 5.892140380053115789L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.64339842966998351L9 4.025489717604319313L9))
+ (-2 2.4075810055386551162L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.811594948157823536L9 -7.834071766040306942L9))
+ (0 -4.811594948157823536L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.4476035118893197435L9 3.0450117757143498866L9))
+ (1 1.4025917361749698569L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.3465328576805684287L9 -4.603589573313564281L9))
+ (1 -2.7429432843670041477L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.956277095163508632L9 -6.664438280281275845L9))
+ (-1 -1.708161185117767213L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.367757792316331005L9 -7.8163461329531150714L-11))
+ (-55879789840705743024 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.7778036898247465523L8 3.4933422750724630952L-11))
+ (-13676883951274541565 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.667353710605079077L9 5.3863219342714070564L-11))
+ (-123783052553596643928 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.6004002390836614547L9 -9.313678706634845693L-11))
+ (70867811173061956036 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.439278803200832958L9 -6.7075776392225367144L-11))
+ (140725598880953434976 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.207319097846486017L9 -5.7812820689283059893L-11))
+ (159260852317369718528 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.564134292866958547L9 6.4508269927189105468L19))
+ (-1 6.4508269919624971176L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.7520914080101070246L9 -4.4901662701989554116L17))
+ (0 -5.7520914080101070246L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.801170739094381102L9 9.482698257311007893L19))
+ (-1 9.482698256330890819L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.471594576665974082L8 3.1667053210759199935L18))
+ (0 7.471594576665974081L8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.4762144691604037974L9 -8.2417624342716462896L19))
+ (0 -6.4762144691604037974L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.5263312844382694187L9 9.5950716135522835064L19))
+ (-1 9.5950716129996503776L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.1312033848911460338L9 -8.61316266389637687L-21))
+ (-363537008074414891396807786496 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.6279029713558476835L9 -4.516664720059022692L-21))
+ (-581823786849847663134534270976 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.502075635961923785L9 -9.685834626464620576L-21))
+ (-464810293545679143271024033792 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.4031562604294053729L9 3.412866773725220897L-21))
+ (411137132932332056394984325120 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.3024038761755407723L9 2.485284435684751149L-21))
+ (-1731151498959165530746191347712 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.136473603422627364L9 5.6959828635137213127L-21))
+ (1077333578850898685241017237504 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.202208473677937235L-11 0.12393605769441814725L0))
+ (-1 0.123936057612396062516L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.6757073154686102475L-11 -0.37237633673270687662L0))
+ (0 -8.675707315468610247L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.6028622390057924218L-11 0.6499341232771672055L0))
+ (0 5.6028622390057924218L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.5783899320025937576L-11 -0.7229560019811405793L0))
+ (-1 -0.7229560019353566799L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.224213822400873615L-11 -0.87051303270552073176L0))
+ (-1 -0.87051303263327859354L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.5008008233955830292L-11 -0.45974678868400245752L0))
+ (0 -5.5008008233955830295L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.949553569817051437L-11 -4.9088361621296460857L9))
+ (0 -5.949553569817051437L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.068981360820356321L-11 3.9567179334666110438L9))
+ (0 9.068981360820356321L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.4621680776088405294L-13 4.3691679646970805987L9))
+ (0 3.4621680776088405294L-13))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.005939678622022073L-11 -9.2132271371400602936L8))
+ (-1 -9.213227137140060293L8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.8015601712459487755L-11 -4.769849366969915586L9))
+ (-1 -4.769849366969915586L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.736177705951390388L-11 8.3701230195943479203L9))
+ (0 8.736177705951390388L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.8368349664293751446L-11 1.7247862508910726963L-11))
+ (-6 1.5118825389170610328L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.0922301210797840822L-11 2.9157326021078492393L-11))
+ (-1 8.235024810280651572L-12))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.929248815922456709L-11 -6.9934608623319373425L-11))
+ (1 -2.9357879535905193665L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.809298490106908006L-11 2.521478295865126635L-11))
+ (3 1.244863602511528101L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.3620267190952160604L-11 -5.0806267993123045533L-11))
+ (-2 -2.7992268795293930463L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.070716461299934103L-11 1.372581158818204212L-11))
+ (-7 5.3735165042749538097L-12))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.459630170957188741L-11 -3.429772398019229389L19))
+ (0 -7.459630170957188741L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.9725650506989118904L-11 -1.7770668980460508816L19))
+ (-1 -1.7770668980460508816L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.3974118251214889016L-12 -5.69117448017374684L19))
+ (-1 -5.69117448017374684L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.080192761938897539L-11 5.1550284925054312868L19))
+ (0 9.080192761938897539L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.694299339180548789L-11 3.1601030797220572842L19))
+ (0 7.694299339180548789L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.5788554873601060938L-11 5.5699367746931070664L19))
+ (0 5.5788554873601060938L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.087371164243010522L-11 1.7025318283693090775L-21))
+ (-24007605005 1.5007203773756006028L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.3575974688385316083L-11 -1.6670029902289832508L-21))
+ (44136678290 -1.8066891019200848581L-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.0850282868697332469L-11 5.7344803128377181472L-21))
+ (1892112672 1.4425616831217755076L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.848519351300913193L-11 -7.121687974823219785L-21))
+ (13828911609 -2.300608125189343731L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.0260591554314098406L-12 1.7303586387117179437L-22))
+ (17488046048 9.689796116124082976L-23))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.867643793784483945L-11 2.9831220978672803306L-21))
+ (19669472456 9.594326475082730988L-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.453252855247919707L19 0.3964594556008910194L0))
+ (238441856328540902016 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.9865852464762410773L17 0.8745495786051183551L0))
+ (227155245977568008 0.08198902299422984579L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.8003655986843771616L19 -0.57075967601329721915L0))
+ (-101625357264188433960 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 6.5463855676706502812L19 0.5124698839969514896L0))
+ (127741859026189966704 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.053368905864221505L19 0.40679331708739617821L0))
+ (197972006116659527920 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.5722362029533885376L19 0.1793174966141533504L0))
+ (478047952085719142240 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.6056603867132043536L19 1.8364346532401849241L9))
+ (-35970026895 8.274070785684816422L8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.473965171745108034L19 5.5749126908032718576L9))
+ (4437675186 5.356910410798194379L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.405924011882179756L19 -6.4568556406242929674L9))
+ (6823637165 -4.1798826632701602209L8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.1093676314099077168L19 5.727620773112868108L8))
+ (36827990451 1.8408274540307780489L8))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.0962340119185741432L19 -8.173187675545835245L9))
+ (1341256380 -4.422519927692124746L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.664836922872330681L19 -4.5461452948374001435L9))
+ (21259410546 -4.0088028420210172099L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.9654629946168490416L19 -6.27691916031617149L-11))
+ (-1587636026543136775574879469568 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.2700534905234296955L19 -7.6392648594402208417L-11))
+ (166253365198349054807791108096 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.837735447773461618L18 -8.6041613252133785413L-11))
+ (91092381366746282195935035392 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.849306367034469812L19 -8.744903371098252931L-11))
+ (-554529439749024491444258209792 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.3895751736590951245L18 -8.9218106166526971406L-11))
+ (71617471477514379195326660608 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.1249006547358954392L19 -3.749899421128778124L-11))
+ (299981553744522252727485464576 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.8298889769606521412L19 3.2897859420995047714L19))
+ (-2 1.7496829072383574016L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.618272569239742257L19 -2.4246730847406800364L19))
+ (3 -3.4425331501770214745L18))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.9344217376670949096L19 -2.187787768895506888L19))
+ (4 -1.1832706620850673572L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.9222824564168688912L19 -9.476307993509074433L19))
+ (-1 -5.5540255370922055412L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -2.012988112115775752L19 -1.01146191266402097525L18))
+ (19 -9.1210478054135899006L17))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.6136075623649245696L19 -9.374471951386232653L19))
+ (-1 -7.6086438902130808345L18))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.0954879593227223964L19 3.4785793369902262412L-21))
+ (-11773449913223093127289481096658923028480 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.7633820540313762628L19 -6.9799216943629666126L-21))
+ (8257086979479904139315172946770002968576 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -4.5945941433359568196L19 -9.26874309885338918L-21))
+ (4957084357969034092339972319162935541760 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.069653875532044557L19 1.1607862998892810815L-21))
+ (78133708817868823323292026086376001765376 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.9663881236128118596L19 -7.53224056983834607L-21))
+ (-2610628411799403924128603371383036051456 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.8155182638858600344L19 -9.78280482738867461L-21))
+ (-3900229362854759958152852242692868931584 0.0L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 2.0785751397779279812L-21 0.84874462118484074924L0))
+ (0 2.0785751397779279812L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.468679817093889512L-22 -0.14230041428757812886L0))
+ (-1 -0.14230041428757812886L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.5329587582370771722L-21 -0.75145077780984780047L0))
+ (0 -3.5329587582370771722L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.0147425004279850959L-21 0.55049889413410685307L0))
+ (0 1.0147425004279850959L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -9.214176537319943048L-21 -0.45008902557926736644L0))
+ (0 -9.214176537319943048L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.146684367801419132L-21 0.3317375182580383851L0))
+ (-1 0.3317375182580383851L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.8958965362796452575L-23 -8742129.925142999928L0))
+ (-1 -8742129.925142999928L0))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -8.629925553125559817L-22 1.4904768761159059732L9))
+ (-1 1.4904768761159059732L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.7636696713810751494L-21 1.2803675755746476424L9))
+ (-1 1.2803675755746476424L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.8572218293550540256L-21 7.311951574932556098L9))
+ (0 7.8572218293550540256L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.8831628670454666175L-21 -2.430599936529262355L9))
+ (-1 -2.430599936529262355L9))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.891885696934149925L-21 6.0077688200842341403L9))
+ (0 5.891885696934149925L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.5378511525885539255L-21 -4.317564477957860586L-11))
+ (0 -5.5378511525885539255L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.9525004120740256159L-21 9.454884961900014292L-11))
+ (-1 9.454884961704764251L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 5.461359828153347278L-21 -9.7061135180917529105L-11))
+ (-1 -9.706113517545616928L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 9.644530490453124287L-21 8.28693431641614359L-11))
+ (0 9.644530490453124287L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 8.997549905605484822L-21 5.2672865249640494307L-11))
+ (0 8.997549905605484822L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -1.55338435917637846L-21 5.9708770769690056966L-11))
+ (-1 5.9708770768136672606L-11))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.9285675924255819076L-21 5.674913585946206864L19))
+ (0 3.9285675924255819076L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.6185336116295331734L-21 -9.043926006483480333L19))
+ (0 -3.6185336116295331734L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.32672036508508268L-21 1.205614654464109627L19))
+ (-1 1.205614654464109627L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -3.3565132746900103151L-21 8.585503247975515849L19))
+ (-1 8.585503247975515849L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.9204354176156616745L-21 -3.6158709669328356396L19))
+ (0 -6.9204354176156616745L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -7.5176747956103960436L-21 9.3440027997860057096L19))
+ (-1 9.3440027997860057096L19))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -6.302622462978502841L-21 8.1107309029375862425L-21))
+ (-1 1.8081084399590834014L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 1.4803054325001667241L-22 6.3345497995208400772L-21))
+ (0 1.4803054325001667241L-22))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR -5.7089861270321677843L-21 9.540482421100450586L-21))
+ (-1 3.831496294068282802L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 3.3765199428161524112L-21 9.669802014415968729L-21))
+ (0 3.3765199428161524112L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 7.52101063082155294L-21 8.827949370572986921L-21))
+ (0 7.52101063082155294L-21))
+
+(my-assert
+ (MULTIPLE-VALUE-LIST (FLOOR 4.196504310402249954L-23 3.785428476220113075L-21))
+ (0 4.196504310402249954L-23))
+
+;;  ---- Test von / ---
+
+(my-assert
+ (/ 0.8476517865511829377L0 0.14598720922015648169L0)
+ 5.8063428370144327317L0)
+
+(my-assert
+ (/ -0.16515392772872533974L0 0.2885771921352848653L0)
+ -0.5723041606534907598L0)
+
+(my-assert
+ (/ -0.25791761734650428572L0 -0.17472849542471660309L0)
+ 1.4761050664322265015L0)
+
+(my-assert
+ (/ -0.9418668871216534004L0 -0.25801526180943099573L0)
+ 3.6504309106230792821L0)
+
+(my-assert
+ (/ -0.25726582509610465451L0 0.7704327058756196045L0)
+ -0.33392381078074095957L0)
+
+(my-assert
+ (/ -0.021409432992321506645L0 -0.44293479613874918959L0)
+ 0.048335405524597819813L0)
+
+(my-assert
+ (/ -0.26771090178828336857L0 -7.7011892538310270067L9)
+ 3.4762280599078659542L-11)
+
+(my-assert
+ (/ 0.82867609196336006595L0 -3.0042819216966844948L9)
+ -2.7583166745395210866L-10)
+
+(my-assert
+ (/ 0.40732354689187331287L0 -7.559832309976744222L9)
+ -5.387997116739304149L-11)
+
+(my-assert
+ (/ -0.53349543673778000914L0 -5.104278761341346705L8)
+ 1.045192595628502556L-9)
+
+(my-assert
+ (/ 0.17669669311850475256L0 -9.181879875841464834L9)
+ -1.9244064996255633173L-11)
+
+(my-assert
+ (/ -0.38525727576606363245L0 -4.8936643582468263693L9)
+ 7.872572525674472248L-11)
+
+(my-assert
+ (/ 0.028580272067667963345L0 -7.9841173999044091L-11)
+ -3.5796407587907142282L8)
+
+(my-assert
+ (/ 0.72167998280372380157L0 -3.6437273419914776347L-12)
+ -1.980609181391958688L11)
+
+(my-assert
+ (/ -0.5863461999919387516L0 7.881986348526466578L-11)
+ -7.4390664239294943926L9)
+
+(my-assert
+ (/ 0.54541403791059564303L0 -2.6107257402815120583L-11)
+ -2.089128051619026705L10)
+
+(my-assert
+ (/ 0.7985324354238058011L0 9.752737902348257611L-12)
+ 8.187777047012979847L10)
+
+(my-assert
+ (/ 0.14104671220162837288L0 -1.679932803469743255L-11)
+ -8.3959734526470136372L9)
+
+(my-assert
+ (/ 0.84226961154302812054L0 -3.7790325979515268584L19)
+ -2.2287968936801211454L-20)
+
+(my-assert
+ (/ -0.17023320737807742781L0 -7.0544793122604881768L19)
+ 2.4131222141684768152L-21)
+
+(my-assert
+ (/ 0.51147038234753495475L0 7.2890488826322506176L19)
+ 7.01697012303244035L-21)
+
+(my-assert
+ (/ 0.15424860911694467965L0 -9.2121691156562017736L19)
+ -1.6744005367291526718L-21)
+
+(my-assert
+ (/ 0.18043991101271504866L0 -1.5135729370916590423L19)
+ -1.1921454631676461953L-20)
+
+(my-assert
+ (/ -0.8669749687756526617L0 8.7133495928438747096L19)
+ -9.949961946754488136L-21)
+
+(my-assert
+ (/ -0.6448505560111598971L0 3.636469578348857873L-21)
+ -1.7732873659951112376L20)
+
+(my-assert
+ (/ -0.81857582399766609004L0 5.2916132942068490006L-21)
+ -1.546930545536701092L20)
+
+(my-assert
+ (/ 0.77524450276763022L0 -7.652595302708246449L-21)
+ -1.0130478250865714831L20)
+
+(my-assert
+ (/ 0.627858729575384142L0 9.627326573065363056L-21)
+ 6.5216311590796329432L19)
+
+(my-assert
+ (/ -0.42943946308533227006L0 -2.2414950519882640498L-21)
+ 1.9158617490786266339L20)
+
+(my-assert
+ (/ -0.34220208112358558038L0 -7.4545803279812700505L-21)
+ 4.5904942473972275588L19)
+
+(my-assert
+ (/ 5.560943842255079481L9 -0.55841023848214400133L0)
+ -9.958527725728472542L9)
+
+(my-assert
+ (/ -8.661678305761957921L9 -0.87958882986448744696L0)
+ 9.847417351919312785L9)
+
+(my-assert
+ (/ 3.6954900583503502368L9 -0.36989453222048823558L0)
+ -9.9906587863470431315L9)
+
+(my-assert
+ (/ 6.740385471899914443L8 -0.2745720588185960522L0)
+ -2.454869406924301959L9)
+
+(my-assert
+ (/ -5.1381279403866914758L9 -0.32555782051482221485L0)
+ 1.578253574821668073L10)
+
+(my-assert
+ (/ -3.2065087686035281697L9 0.50505516522796299416L0)
+ -6.3488287802308291444L9)
+
+(my-assert
+ (/ -7.7979994067331648055L9 -6.4459990751639263853L9)
+ 1.2097425574847536075L0)
+
+(my-assert
+ (/ -4.7272619195621447717L9 -3.825695015629283172L8)
+ 12.356609453314103588L0)
+
+(my-assert
+ (/ -3.5376744034596315073L9 2.7483444719369282795L9)
+ -1.2872019645217230068L0)
+
+(my-assert
+ (/ -2.2400216393287578975L9 -3.7058330823204350567L9)
+ 0.6044583200509807153L0)
+
+(my-assert
+ (/ 3.0621742151056386386L9 -8.846101104908494769L9)
+ -0.34616088814613589822L0)
+
+(my-assert
+ (/ 7.5149875074517868906L9 4.423024956398348232L9)
+ 1.6990606161017937287L0)
+
+(my-assert
+ (/ 7.6970261502618782055L9 -9.7716080626747355186L-11)
+ -7.876928854384493259L19)
+
+(my-assert
+ (/ -8.725835744855911806L8 8.409822932470646079L-11)
+ -1.0375766309139670758L19)
+
+(my-assert
+ (/ 5.820797723708174118L9 -2.882166534035175912L-11)
+ -2.0195910454760464445L20)
+
+(my-assert
+ (/ 1.207852991950790034L9 5.840354579417081103L-11)
+ 2.068115857567237665L19)
+
+(my-assert
+ (/ 3.1046967393071541823L9 -5.5642977043818474125L-11)
+ -5.5796740294147564416L19)
+
+(my-assert
+ (/ 4.392532668212736406L9 -7.535498815249885942L-11)
+ -5.8291199771983175508L19)
+
+(my-assert
+ (/ 1.3280881496906639524L9 -1.766515912740190632L19)
+ -7.518121632035316941L-11)
+
+(my-assert
+ (/ 1.4277961930808139626L9 -8.986506745304867108L19)
+ -1.5888222571321021114L-11)
+
+(my-assert
+ (/ -7.9134656119390343763L9 -3.4095849226963530828L19)
+ 2.3209469162249057589L-10)
+
+(my-assert
+ (/ -8.7882725472722691335L9 -5.186325400713441962L19)
+ 1.6945085138821670647L-10)
+
+(my-assert
+ (/ 3.8930727351090315925L9 -7.3980221641298868864L19)
+ -5.2623155875161027887L-11)
+
+(my-assert
+ (/ 9.998404421166073569L9 -8.1317115085820412065L18)
+ -1.2295571984586471158L-9)
+
+(my-assert
+ (/ 4.623792381028250544L9 6.996281129080973142L-21)
+ 6.6089287947690416075L29)
+
+(my-assert
+ (/ 8.472924939037688662L9 -4.3460987737519244214L-22)
+ -1.9495472560839050376L31)
+
+(my-assert
+ (/ 1.9551595642940545935L9 -7.5324972045717692564L-21)
+ -2.5956326450508222435L29)
+
+(my-assert
+ (/ -8.5478772651240992225L9 -2.4212066230883777513L-21)
+ 3.5304204042779411337L30)
+
+(my-assert
+ (/ 6.881700625121950854L9 -8.203099619911879591L-21)
+ -8.389146717684109215L29)
+
+(my-assert
+ (/ 6.097099876947129031L9 -4.76850418677518328L-21)
+ -1.2786189627046213921L30)
+
+(my-assert
+ (/ -5.0358061432469478737L-11 -0.6780392915138573621L0)
+ 7.427012278305451381L-11)
+
+(my-assert
+ (/ -1.49762284327640383L-11 0.15227257119521089694L0)
+ -9.835145171066142436L-11)
+
+(my-assert
+ (/ -7.1678035946969115934L-11 0.75360681415553320054L0)
+ -9.511330656861051013L-11)
+
+(my-assert
+ (/ 4.583894304978394541L-12 0.68934670181533335835L0)
+ 6.6496210004445016106L-12)
+
+(my-assert
+ (/ -3.8885547056166489716L-12 -0.010643810658165133798L0)
+ 3.6533482513930678043L-10)
+
+(my-assert
+ (/ 9.49880444227161124L-11 -0.122629749019578004226L0)
+ -7.745921783428843474L-10)
+
+(my-assert
+ (/ 2.1990660545226500317L-11 -1.4161745224867819854L9)
+ -1.552821364602098501L-20)
+
+(my-assert
+ (/ 9.951737846856727225L-11 -6.0164204240154494783L9)
+ -1.6540961477912788069L-20)
+
+(my-assert
+ (/ -5.873282338412930208L-11 2.3788798751415933107L9)
+ -2.4689276662460085614L-20)
+
+(my-assert
+ (/ 2.2209512664584027642L-11 5.1944018613813348683L9)
+ 4.2756631576205975403L-21)
+
+(my-assert
+ (/ -6.722318330051584872L-11 6.7936247801916195024L9)
+ -9.895039169151724367L-21)
+
+(my-assert
+ (/ -7.528877773200399613L-12 -9.535757813603057891L9)
+ 7.89541630604357328L-22)
+
+(my-assert
+ (/ -2.0857643618410047184L-11 2.701544718271986855L-11)
+ -0.77206360780699598463L0)
+
+(my-assert
+ (/ 2.5510439626733908612L-11 1.6734405694946451074L-11)
+ 1.5244305708709866576L0)
+
+(my-assert
+ (/ 3.048460642905138835L-11 5.1568899955161432057L-11)
+ 0.5911432366321058725L0)
+
+(my-assert
+ (/ 9.876491787625061464L-12 8.667781903943973216L-11)
+ 0.113944858062604306884L0)
+
+(my-assert
+ (/ 1.1166642175553123016L-11 -7.759981600144040302L-11)
+ -0.14390036923986841014L0)
+
+(my-assert
+ (/ -2.7282824760136843772L-11 -9.160281916489131182L-11)
+ 0.2978382653379466574L0)
+
+(my-assert
+ (/ -3.1587174777348029438L-11 -4.9090150171793744104L19)
+ 6.4345239659701453497L-31)
+
+(my-assert
+ (/ -4.512784364891002838L-11 5.9600731551720265308L19)
+ -7.571692909465218857L-31)
+
+(my-assert
+ (/ -1.431681316436341718L-11 -4.22349605246125618L19)
+ 3.3898014788057508284L-31)
+
+(my-assert
+ (/ -6.719040537613210677L-11 -4.545488183802435408L19)
+ 1.47817797911258332435L-30)
+
+(my-assert
+ (/ 2.5092238442261623676L-11 3.3004591427193857704L19)
+ 7.602650830449936487L-31)
+
+(my-assert
+ (/ -6.198495042920933878L-12 1.8747110273916984954L19)
+ -3.306373596972410786L-31)
+
+(my-assert
+ (/ 8.3326031863190006605L-11 6.3679312781687389584L-21)
+ 1.3085259281747860217L10)
+
+(my-assert
+ (/ 2.228308172351851791L-11 -4.6204647093882084617L-22)
+ -4.822692764700068564L10)
+
+(my-assert
+ (/ 9.7676469315043868665L-11 -6.6370355345926113967L-21)
+ -1.4716882078745621587L10)
+
+(my-assert
+ (/ -8.9713798012161717115L-11 -3.669192301028840519L-21)
+ 2.445055768459069116L10)
+
+(my-assert
+ (/ 7.214258511983827207L-11 -1.5195990661514104949L-21)
+ -4.7474749574931692373L10)
+
+(my-assert
+ (/ 1.4822028144092954099L-12 2.269595713994387529L-21)
+ 6.530690929974856047L8)
+
+(my-assert
+ (/ -4.6354687290142894644L19 0.032331325634476806982L0)
+ -1.4337391486574910728L21)
+
+(my-assert
+ (/ -2.389352438897577318L19 0.8660312577952003013L0)
+ -2.7589678979723536864L19)
+
+(my-assert
+ (/ -2.4109458405628950432L19 0.26688102636777617506L0)
+ -9.0337851040803631776L19)
+
+(my-assert
+ (/ 8.961066349333904704L19 -0.66178143682771294813L0)
+ -1.35408245844568974384L20)
+
+(my-assert
+ (/ 6.6419769467305502364L19 -0.8456142496793601811L0)
+ -7.854618047471472417L19)
+
+(my-assert
+ (/ 3.7389082257286159308L19 0.56261989685796304976L0)
+ 6.645531462021022254L19)
+
+(my-assert
+ (/ 7.814283695666500025L19 -4.6620013293904720047L9)
+ -1.6761650509199167363L10)
+
+(my-assert
+ (/ 6.6434731737611309404L19 -2.858805223329136325L9)
+ -2.323863521567472329L10)
+
+(my-assert
+ (/ -1.3409334390407788129L19 6.1497605350647401055L9)
+ -2.1804644772671013651L9)
+
+(my-assert
+ (/ 7.0858597943822241668L19 -2.58410378455919273L9)
+ -2.7420956684179617314L10)
+
+(my-assert
+ (/ -6.6455998228898640428L19 -7.7545004942277582046L9)
+ 8.569990843171226794L9)
+
+(my-assert
+ (/ 2.9602494058183339616L19 -5.7169856186590364077L9)
+ -5.1779899465842692843L9)
+
+(my-assert
+ (/ -6.698311323164055808L19 -6.553232827426109497L-11)
+ 1.02213846197113193186L30)
+
+(my-assert
+ (/ -7.554561034956199475L19 6.4764910162760040714L-11)
+ -1.1664589692120175174L30)
+
+(my-assert
+ (/ 6.7796490729162210612L19 9.9915237995070190003L-11)
+ 6.785400514434773617L29)
+
+(my-assert
+ (/ -6.9067747658009050975L18 -2.5761632749585983355L-11)
+ 2.681031452058062687L29)
+
+(my-assert
+ (/ 1.629413698021581386L19 -8.612780517302459862L-11)
+ -1.8918555915226283107L29)
+
+(my-assert
+ (/ 8.8732593909692189064L19 -4.0536919536865455935L-12)
+ -2.1889328277398133904L31)
+
+(my-assert
+ (/ 4.8426213700963381164L19 7.883038261101094331L19)
+ 0.61430900240485778846L0)
+
+(my-assert
+ (/ -5.2968355222513127376L19 1.5071497411718048594L19)
+ -3.5144719715328600349L0)
+
+(my-assert
+ (/ -6.2610887651422622925L18 1.0358424497888766788L19)
+ -0.60444411854509194816L0)
+
+(my-assert
+ (/ -2.4670994205369878408L19 6.9747461294856021948L19)
+ -0.3537188844920639511L0)
+
+(my-assert
+ (/ 6.9460731069354980812L19 3.1486762233902586798L19)
+ 2.2060296499639734035L0)
+
+(my-assert
+ (/ 8.8228286449463631936L19 6.7354354317536527728L19)
+ 1.3099121406987093833L0)
+
+(my-assert
+ (/ 3.2098388728662261428L19 -2.6305167886064038438L-21)
+ -1.2202312818412901165L40)
+
+(my-assert
+ (/ -7.144492994496515916L19 -2.0335028635662185032L-21)
+ 3.5133921483478965099L40)
+
+(my-assert
+ (/ -6.3695870249569899508L19 1.9319318539671607067L-21)
+ -3.2970039869042198792L40)
+
+(my-assert
+ (/ -5.4056057590545112688L19 6.6371220252553042967L-21)
+ -8.144502599899959829L39)
+
+(my-assert
+ (/ -4.5534797093596626272L19 9.223324048915255164L-21)
+ -4.9369182793650108047L39)
+
+(my-assert
+ (/ 3.9206183123968272208L19 -1.6559061178638737343L-21)
+ -2.3676573629998072004L40)
+
+(my-assert
+ (/ -8.768637785982664131L-21 -0.18184176456694917492L0)
+ 4.8221253279547290195L-20)
+
+(my-assert
+ (/ 2.6823352573966718016L-21 -0.55524799130252431824L0)
+ -4.830877912956219511L-21)
+
+(my-assert
+ (/ -4.0350541003620172524L-21 0.27000304046926068644L0)
+ -1.4944476526446376082L-20)
+
+(my-assert
+ (/ 6.332356861830292899L-21 0.65544003241974460534L0)
+ 9.6612299350294242524L-21)
+
+(my-assert
+ (/ 3.5603120340723305693L-21 -0.124100556644984066966L0)
+ -2.86889288035778711L-20)
+
+(my-assert
+ (/ 5.5961094005028721084L-21 0.47201702367299511838L0)
+ 1.18557363820414998006L-20)
+
+(my-assert
+ (/ 1.7187188076305931646L-21 8.3685668129856246863L9)
+ 2.0537791548292745125L-31)
+
+(my-assert
+ (/ -2.7220241842791803757L-21 2.2892422122227956846L9)
+ -1.1890503196846804849L-30)
+
+(my-assert
+ (/ -6.028203796038167925L-21 -5.415224539645905615L9)
+ 1.1131955382282900156L-30)
+
+(my-assert
+ (/ 6.6310444174308960725L-21 9.461342958972558645L9)
+ 7.0085657460946591684L-31)
+
+(my-assert
+ (/ -8.8033709586752979635L-21 2.8098765759657792274L9)
+ -3.1330098389284241575L-30)
+
+(my-assert
+ (/ -3.4027974212452472475L-21 6.219628754500815959L8)
+ -5.4710619484849846614L-30)
+
+(my-assert
+ (/ 8.388977931970215088L-21 2.8213325814913435694L-11)
+ 2.9734097947204223302L-10)
+
+(my-assert
+ (/ -9.3496400462478483586L-21 -9.381494249123695733L-11)
+ 9.966045704415559596L-11)
+
+(my-assert
+ (/ -6.936639418470504025L-21 5.6618206553549859367L-11)
+ -1.2251605694909792675L-10)
+
+(my-assert
+ (/ -2.3667892015182913211L-21 -7.1545639578577691874L-11)
+ 3.3080830857887236957L-11)
+
+(my-assert
+ (/ -9.576766108065157562L-21 -6.4350290609494113365L-11)
+ 1.4882242204905008798L-10)
+
+(my-assert
+ (/ -2.5955914883538434001L-22 5.8091383646322322124L-11)
+ -4.4681178609147595716L-12)
+
+(my-assert
+ (/ -2.9619491950657497217L-21 -5.3730670726011346488L19)
+ 5.512585558757694777L-41)
+
+(my-assert
+ (/ 2.5726455340193007026L-22 3.0037766865540527038L19)
+ 8.564703047118500122L-42)
+
+(my-assert
+ (/ -2.8277317971003367574L-21 -4.4068191966128705184L19)
+ 6.4167184332721487087L-41)
+
+(my-assert
+ (/ 7.503784949731224261L-21 5.9540210967055505192L19)
+ 1.2602886062804146604L-40)
+
+(my-assert
+ (/ 1.4876876016319254574L-22 8.6818746213386148185L18)
+ 1.7135557313571827969L-41)
+
+(my-assert
+ (/ 2.699544264870480357L-21 3.6796341400587007856L19)
+ 7.3364474893892979093L-41)
+
+(my-assert
+ (/ -7.285812539718203862L-21 5.700589904684711396L-21)
+ -1.2780804551000530294L0)
+
+(my-assert
+ (/ 3.6474102791520560028L-21 -6.343773677116707765L-21)
+ -0.574959080319812269L0)
+
+(my-assert
+ (/ -4.2510720089860863712L-21 -8.281980897162330288L-21)
+ 0.51329169455614642465L0)
+
+(my-assert
+ (/ 5.770684998505203844L-21 6.5700291863604419324L-21)
+ 0.8783347584642853315L0)
+
+(my-assert
+ (/ -4.8018196973750014744L-21 -7.3250029580209059804L-21)
+ 0.6555382605159211192L0)
+
+(my-assert
+ (/ -3.9261100835261094614L-21 -8.986577968334144672L-21)
+ 0.436885997913830856L0)
diff --git a/src/ansi-tests/number2.lisp b/src/ansi-tests/number2.lisp
new file mode 100644
index 000000000..89985d27a
--- /dev/null
+++ b/src/ansi-tests/number2.lisp
@@ -0,0 +1,35 @@
+;;; based on v1.4 -*- mode: lisp -*-
+(in-package :user)
+
+(my-assert
+ (gcd 2346026393680644703525505657 17293822570713318399)
+ 11)
+
+(my-assert
+ (multiple-value-list (xgcd 77874422 32223899))
+ (1 -9206830 22249839))
+
+(my-assert
+ (multiple-value-list (xgcd 560014183 312839871))
+ (1 77165803 -138134388))
+
+(my-assert
+ (multiple-value-list (xgcd 3 2))
+ (1 1 -1))
+
+(my-assert
+ (multiple-value-list (xgcd 2 3))
+ (1 -1 1))
+
+(my-assert
+ (let ((a 974507656412513757857315037382926980395082974811562770185617915360)
+       (b -1539496810360685510909469177732386446833404488164283))
+   (multiple-value-bind (g u v) (xgcd a b)
+     (and (eql g 1) (eql g (+ (* a u) (* b v))))
+     ) )
+ T)
+
+(my-assert
+ (isqrt #x3FFFFFFFC000000000007F)
+ #x7FFFFFFFBFF)
+
diff --git a/src/ansi-tests/path.lisp b/src/ansi-tests/path.lisp
new file mode 100644
index 000000000..9fb9048f7
--- /dev/null
+++ b/src/ansi-tests/path.lisp
@@ -0,0 +1,583 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (setf string "test-pathname.abc" symbol 'test-pathname.abc)
+ test-pathname.abc)
+
+;;pathname -mögl. Argumenttypen: pathname,string,symbol,stream
+;;         -resultat: pathname
+
+(my-assert
+ (SETF PATHSTRING (PATHNAME STRING))
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST NIL
+	     SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+	     TYPE "ABC" SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME "test-pathname" :TYPE "abc" :VERSION NIL))
+
+(my-assert
+ (SETF PATHSYMBOL (PATHNAME symbol))
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST
+	     NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+	     "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME "test-pathname" :TYPE "abc" :VERSION NIL))
+
+(my-assert
+ (SETF PATHPATH (PATHNAME PATHSYMBOL))
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST NIL
+	     SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+	     TYPE "ABC" SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME "test-pathname" :TYPE "abc" :VERSION NIL))
+
+(my-assert
+ (SETF STREAM (OPEN STRING :DIRECTION :OUTPUT)
+       a nil)
+ nil)
+
+;; (SETF PATHSTREAM (PATHNAME STREAM))
+;; "test-pathname.lsp"
+
+(my-assert
+ (MAPCAR (FUNCTION PATHNAMEP)
+	 (LIST PATHSTRING PATHSYMBOL PATHPATH ;PATHSTREAM
+	       ))
+ (T T T					;T
+    ))
+
+
+;; funktion truename liefert filename fuer pathname oder stream
+;;                   einen Pfadnamen
+;;
+;; (MAPCAR (FUNCTION TRUENAME) (LIST PATHSTRING PATHSYMBOL PATHPATH STREAM
+;;                                                                ;PATHSTREAM
+;;                                                                  ))
+;;   ERROR
+
+
+
+(my-assert
+ (PARSE-NAMESTRING STRING)
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST NIL
+	     SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+	     TYPE "ABC" SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME "test-pathname" :TYPE "abc" :VERSION NIL))
+
+(my-assert
+ (PARSE-NAMESTRING SYMBOL)
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST NIL
+	     SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+	     TYPE "ABC" SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME "test-pathname" :TYPE "abc" :VERSION NIL))
+
+#+XCL
+
+(my-assert
+ (PARSE-NAMESTRING "bab:test-pathname.abc")
+ #S(PATHNAME SYSTEM::HOST NIL
+	     SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2" SYSTEM::NAME
+	     "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL))
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "bab:test-pathname.abc;3")
+ #S(PATHNAME SYSTEM::HOST NIL
+	     SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2" SYSTEM::NAME
+	     "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION 3))
+
+(my-assert
+ (PARSE-NAMESTRING PATHSTRING)
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
+	     "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME" TYPE "ABC"
+	     SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME "test-pathname" :TYPE "abc" :VERSION NIL))
+
+(my-assert
+ (PARSE-NAMESTRING "test-pathname.abc" NIL)
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST NIL
+	     SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+	     TYPE "ABC" SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME "test-pathname" :TYPE "abc" :VERSION NIL))
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "sirius::disk00$abt43:[heicking]test-pathname.abc")
+ #S(PATHNAME
+    SYSTEM::HOST "SIRIUS" SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "HEICKING"
+    SYSTEM::NAME "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL))
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "sirius::disk00$abt43:[heicking]test-pathname.abc" "sirius")
+ #S(PATHNAME
+    SYSTEM::HOST "SIRIUS" SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "HEICKING"
+    SYSTEM::NAME "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL))
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "sirius::disk00$abt43:[heicking]test-pathname.abc" "orion")
+ ERROR)
+
+(my-assert
+ (PARSE-NAMESTRING "abc.123" NIL NIL :START 0 :END 5)
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST
+	     NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "ABC" TYPE
+	     "1" SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME "abc" :TYPE "1" :VERSION NIL))
+
+(my-assert
+ (PARSE-NAMESTRING "abc.123" NIL NIL :START 2 :END 5)
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST
+	     NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "C" TYPE "1"
+	     SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME "c" :TYPE "1" :VERSION NIL))
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "babylon" NIL NIL :START 0 :END 3)
+ #S(PATHNAME SYSTEM::HOST
+	     NIL SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2" SYSTEM::NAME NIL TYPE
+	     NIL SYSTEM::VERSION NIL))
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "babylon" NIL NIL :START 0 :END 7)
+ #S(PATHNAME SYSTEM::HOST
+	     NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "BABYLON"
+	     TYPE NIL SYSTEM::VERSION NIL))
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "babylon" NIL *DEFAULT-PATHNAME-DEFAULTS* :START 0 :END 7)
+ #S(PATHNAME
+    SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+    "BABYLON" TYPE NIL SYSTEM::VERSION NIL))
+
+(my-assert
+ *DEFAULT-PATHNAME-DEFAULTS*
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE NIL
+	     DIRECTORY NIL SYSTEM::NAME NIL TYPE "lsp" SYSTEM::VERSION :NEWEST)
+ #+(and CLISP (or win32 os2))
+ #S(PATHNAME :HOST NIL :DEVICE "C" :DIRECTORY (:RELATIVE)
+	     :NAME NIL :TYPE NIL :VERSION NIL)
+ #+(and CLISP unix)
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME NIL :TYPE NIL :VERSION NIL))
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "babylon" NIL *DEFAULT-PATHNAME-DEFAULTS* :START 0 :END 3)
+ #S(PATHNAME
+    SYSTEM::HOST NIL SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2"
+    SYSTEM::NAME NIL TYPE NIL SYSTEM::VERSION NIL))
+
+;; (PARSE-NAMESTRING "babylon.c.c" NIL NIL :JUNK-ALLOWED T)
+;; #S(PATHNAME
+;; SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+;; "BABYLON" TYPE "C" SYSTEM::VERSION NIL)
+
+;; (PARSE-NAMESTRING "babylon;c.c" NIL NIL :JUNK-ALLOWED T)
+;; #S(PATHNAME
+;; SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+;; "BABYLON" TYPE NIL SYSTEM::VERSION NIL)
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "babylon;c.c" NIL NIL :JUNK-ALLOWED NIL)
+ ERROR)
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "babylon.c.c" NIL NIL :JUNK-ALLOWED NIL)
+ ERROR)
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "babylon.c;c" NIL NIL :JUNK-ALLOWED NIL)
+ ERROR)
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "babylon.c;" NIL NIL :JUNK-ALLOWED NIL)
+ #S(PATHNAME
+    SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+    "BABYLON" TYPE "C" SYSTEM::VERSION NIL))
+
+#+XCL
+(my-assert
+ (PARSE-NAMESTRING "babylon.c;5" NIL NIL :JUNK-ALLOWED NIL)
+ #S(PATHNAME
+    SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+    "BABYLON" TYPE "C" SYSTEM::VERSION 5))
+
+;; (MERGE-PATHNAME "test$$" SYMBOL 10)   ERROR
+;;
+;; (MERGE-PATHNAME "test$$" SYMBOL)   ERROR
+;;
+;; (MERGE-PATHNAME "test$$" PATH)   ERROR
+;;
+;; (MERGE-PATHNAME "test$$")   ERROR
+
+#+XCL
+(my-assert
+ (MERGE-PATHNAMES "test$$")
+ #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
+	     "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE "lsp"
+	     SYSTEM::VERSION :NEWEST))
+
+#+XCL
+(my-assert
+ (MERGE-PATHNAMES "test$$" SYMBOL)
+ #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
+	     "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE "ABC"
+	     SYSTEM::VERSION :NEWEST))
+
+#+XCL
+(my-assert
+ (MERGE-PATHNAMES "test$$" SYMBOL 2)
+ #S(PATHNAME SYSTEM::HOST NIL
+	     SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE
+	     "ABC" SYSTEM::VERSION 2))
+
+#+XCL
+(my-assert
+ (MERGE-PATHNAMES "test$$" (PATHNAME SYMBOL) 2)
+ #S(PATHNAME SYSTEM::HOST NIL
+	     SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE
+	     "ABC" SYSTEM::VERSION 2))
+
+#+XCL
+(my-assert
+ (MERGE-PATHNAMES "test$$" STREAM 2)
+ #S(PATHNAME SYSTEM::HOST 16 SYSTEM::DEVICE
+	     "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE :ESCAPE
+	     SYSTEM::VERSION 2))
+
+
+;; (MERGE-PATHNAME STRING SYMBOL)   ERROR
+
+#+XCL
+(my-assert
+ (MAKE-PATHNAME :NAME "a" :HOST (QUOTE ORION))
+ #S(PATHNAME SYSTEM::HOST ORION
+	     SYSTEM::DEVICE NIL DIRECTORY NIL SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION
+	     :NEWEST))
+
+#+XCL
+(my-assert
+ (DEFMACRO TEST (&REST BODY) (\` (APPLY (FUNCTION MAKE-PATHNAME) (\,@ BODY))))
+ TEST)
+
+#+XCL
+(my-assert
+ (setf a '(:host "sirius" :name "a"))
+ (:host "sirius" :name "a"))
+
+#+XCL
+(my-assert
+ (TEST A)
+ #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE NIL DIRECTORY NIL
+	     SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION :NEWEST))
+
+#+XCL
+(my-assert
+ (SETF A (LIST* :DEVICE "disk00$abt43" A))
+ (:DEVICE "disk00$abt43" :HOST "sirius" :NAME "a"))
+
+#+XCL
+(my-assert
+ (TEST A)
+ #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
+	     DIRECTORY NIL SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION :NEWEST))
+
+#+XCL
+(my-assert
+ (SETF A (LIST* :DIRECTORY "[heicking.comlisp]" A))
+ (:DIRECTORY
+  "[heicking.comlisp]" :DEVICE "disk00$abt43" :HOST "sirius" :NAME "a"))
+
+#+XCL
+(my-assert
+ (TEST A)
+ #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
+	     DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION
+	     :NEWEST))
+
+#+XCL
+(my-assert
+ (SETF A (LIST* :TYPE "raf" A))
+ (:TYPE "raf" :DIRECTORY "[heicking.comlisp]"
+	:DEVICE "disk00$abt43" :HOST "sirius" :NAME "a"))
+
+#+XCL
+(my-assert
+ (TEST A)
+ #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
+	     DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE "raf" SYSTEM::VERSION
+	     :NEWEST))
+
+#+XCL
+(my-assert
+ (SETF A (LIST* :VERSION 3 A))
+ (:VERSION 3 :TYPE "raf" :DIRECTORY
+	   "[heicking.comlisp]" :DEVICE "disk00$abt43" :HOST "sirius" :NAME "a"))
+
+#+XCL
+(my-assert
+ (TEST A)
+ #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
+	     DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE "raf" SYSTEM::VERSION 3))
+
+(my-assert
+ (MAPCAR (FUNCTION PATHNAMEP) (LIST PATHSYMBOL PATHPATH PATHSTRING))
+ (T T T))
+
+#+XCL
+(my-assert
+ (SETF PATH (TEST A))
+ #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE
+	     "disk00$abt43" DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE "raf"
+	     SYSTEM::VERSION 3))
+
+#+XCL
+(my-assert
+ (MAPCAR (FUNCTION PATHNAME-HOST) (LIST SYMBOL STRING STREAM PATH))
+ (NIL NIL NIL NIL))
+
+#+XCL
+(my-assert
+ (MAPCAR (FUNCTION PATHNAME-DEVICE) (LIST SYMBOL STRING STREAM PATH))
+ ("DISK00$ABT43" "DISK00$ABT43" "DISK00$ABT43" "DISK00$ABT43"))
+
+#+XCL
+(my-assert
+ (MAPCAR (FUNCTION PATHNAME-DIRECTORY) (LIST SYMBOL STRING STREAM PATH))
+ ("XCL.MAIN" "XCL.MAIN" "XCL.MAIN" "XCL.MAIN"))
+
+(my-assert
+ (PROGN (CLOSE STREAM) T)
+ T)
+
+#+XCL
+(my-assert
+ (USER-HOMEDIR-PATHNAME)
+ #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
+	     "DISK00$ABT43" DIRECTORY "HEICKING" SYSTEM::NAME NIL TYPE NIL SYSTEM::VERSION
+	     NIL))
+
+(my-assert
+ (PATHNAME "*.*")
+ #+XCL
+ #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43"
+	     DIRECTORY "HEICKING" SYSTEM::NAME "*" TYPE :WILD SYSTEM::VERSION NIL)
+ #+CLISP
+ #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+	     :NAME :WILD :TYPE :WILD :VERSION NIL)
+ #-(or XCL CLISP)
+ #P"*.*")
+
+(my-assert
+ (progn (setf file (open "nicht-vorhandenes-file.non"
+			 :direction :input
+			 :element-type 'character
+			 :if-does-not-exist :create)) t)
+ t
+ "")
+
+(my-assert
+ (null (probe-file "nicht-vorhandenes-file.non"))
+ NIL)
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (setf file (open "nicht-vorhandenes-file.non"
+		  :direction :io
+		  :element-type 'string-char
+		  :if-exists :error))
+ error)
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'character
+                        :if-exists :new-version)))
+ nil
+ "")
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'character
+                        :if-exists :rename)))
+ nil)
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'character
+                        :if-exists :rename-and-delete)))
+ nil)
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'character
+                        :if-exists :overwrite)))
+ nil)
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'character
+                        :if-exists :append)))
+ nil)
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'character
+                        :if-exists :supersede)))
+ nil)
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (setf file (open "nicht-vorhandenes-file.non"
+		  :direction :io
+		  :element-type 'character
+		  :if-exists nil))
+ nil)
+
+(my-assert
+ (progn (close file) t)
+ error)
+
+(my-assert
+ (setf file (open "nicht-vorhandenes-file.new"
+		  :direction :io
+		  :element-type 'character
+		  :if-does-not-exist :error))
+ error)
+
+(my-assert
+ (progn (close file) t)
+ error)
+
+(my-assert
+ (null (setf file (open "nicht-vorhandenes-file.new"
+                        :direction :io
+                        :element-type 'character
+                        :if-does-not-exist :create)))
+ nil)
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'character
+                        :if-does-not-exist nil)))
+ nil)
+
+(my-assert
+ (progn (close file) t)
+ t)
+
+(my-assert
+ (namestring
+  (multiple-value-setq (new-name pathname truename)
+    (rename-file "nicht-vorhandenes-file.non" "file.da")))
+ "file.da")
+
+(my-assert
+ (namestring new-name)
+ "file.da")
+
+(my-assert
+ (null pathname)
+ nil)
+
+(my-assert
+ (null truename)
+ nil)
+
+(my-assert
+ (progn (delete-file "test-pathname.abc") t)
+ t)
+
+(my-assert
+ (progn (mapc #'delete-file (directory "nicht-vorhandenes-file.*")) t)
+ t)
+
+(my-assert
+ (progn (delete-file "file.da") t)
+ t)
+
+(my-assert
+ (progn
+   (setf (logical-pathname-translations "clocc")
+	 '(("**;*" "/usr/local/src/clocc/**/*")))
+   nil)
+ nil)
+
+(my-assert
+ (translate-logical-pathname "clocc:src;port;")
+ #P"/usr/local/src/clocc/src/port/")
diff --git a/src/ansi-tests/readtable.lisp b/src/ansi-tests/readtable.lisp
new file mode 100644
index 000000000..4a33d9e8e
--- /dev/null
+++ b/src/ansi-tests/readtable.lisp
@@ -0,0 +1,651 @@
+;;; based on v1.1.1.1 -*- mode: lisp -*-
+(in-package :cl-user)
+
+;; ****************************************************************************
+;; *      Rosenmueller  tel.340 Testquelle READTABLE.que    23.03.1988        *
+;; ****************************************************************************
+
+(my-assert
+ (prin1-to-string (setq *readtable* (copy-readtable nil)))
+ "#<SYSTEM::%TYPE-READTABLE #<SYSTEM::%TYPE-SIMPLE-VECTOR SYSTEM::%TYPE-UNSIGNED-WORD-POINTER
+ 00000000 00000000 00000000 00000000 00040001 00000004 00040004 00000000
+ 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000
+ 00010004 011E0075 00010001 02250001 00A50395 0C010401 14010535 00010B41
+ 06010601 06010601 06010601 06010601 06010601 00850701 08010001 00010001
+ 0D010061 12010E01 00011501 00010001 00010001 00010001 00010001 0F010001
+ 00010001 13011101 00010001 00010001 00011001 00010001 00010902 00010001
+ 0D010055 12010E01 00011501 00010001 00010001 00010001 00010001 0F010001
+ 00010001 13011101 00010001 00010001 00011001 00C50001 00B50A03 00010001>
+NIL>")
+
+(my-assert
+ (setq $ 23)
+ 23)
+
+(my-assert
+ (defun single-dollar-reader (stream char)
+   (declare (ignore stream))
+   (intern (string char)))
+ SINGLE-DOLLAR-READER)
+
+(my-assert
+ (set-macro-character #\$ #'single-dollar-reader)
+ T)
+
+(my-assert
+ $
+ 23)
+
+(my-assert
+ 45
+ 45
+ ;;  => 23 => 45
+ (prin1-to-string (get-macro-character #\$))
+ "#<SYSTEM::%TYPE-CLOSURE SINGLE-DOLLAR-READER
+NIL
+NIL
+(LAMBDA (STREAM CHAR) (DECLARE (IGNORE STREAM)) (INTERN (STRING CHAR)))>")
+
+
+(my-assert
+ (progn (setq *readtable* (copy-readtable nil)) t)
+ t)
+
+(my-assert
+ (sys::rt-bitmask-char #\" )
+ 117)
+
+(my-assert
+ (sys::rt-bitmask-char #\( )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) )
+ 165)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ )
+ 2306)
+
+(my-assert
+ (sys::rt-bitmask-char #\x )
+ 4097)
+
+(my-assert
+ (sys::rt-bitmask-char #\y )
+ 1)
+
+(my-assert
+ (set-syntax-from-char #\" #\( )
+ T)
+
+(my-assert
+ (sys::rt-bitmask-char #\" )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\( )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) )
+ 165)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ )
+ 2306
+ ;;  *readtable* nil
+ ;;  *readtable* cl-standard
+ (progn (setq doppelquote-liston-readtable (copy-readtable)) t)
+ t)
+
+(my-assert
+ (sys::rt-bitmask-char #\" doppelquote-liston-readtable )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\( doppelquote-liston-readtable )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) doppelquote-liston-readtable )
+ 165)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ doppelquote-liston-readtable )
+ 2306)
+
+(my-assert
+ '"1 2 3)
+(1 2 3))
+
+(my-assert
+ (set-syntax-from-char #\" #\\ )
+T)
+
+(my-assert
+ (sys::rt-bitmask-char #\" )
+2306)
+
+(my-assert
+ (sys::rt-bitmask-char #\( )
+917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) )
+165)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ )
+2306)
+
+(my-assert
+ (progn (setq doppelquote-backslash-readtable (copy-readtable)) t)
+T)
+
+(my-assert
+ (sys::rt-bitmask-char #\" doppelquote-backslash-readtable )
+2306)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ doppelquote-backslash-readtable )
+2306)
+
+(my-assert
+ (sys::rt-bitmask-char #\( doppelquote-backslash-readtable )
+917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) doppelquote-backslash-readtable )
+165)
+
+(my-assert
+ #"<
+ #\<)
+
+(my-assert
+ (progn (setq 2.-doppelquote-backslash-readtable
+	      (copy-readtable doppelquote-backslash-readtable)) t)
+ t)
+
+(my-assert
+ (sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
+ 2306)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
+ 2306)
+
+(my-assert
+ (sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
+ 165)
+
+(my-assert
+ (progn (setq 2.-doppelquote-liston-readtable
+	      (copy-readtable doppelquote-liston-readtable)) t)
+ t)
+
+(my-assert
+ (sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
+ 165)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
+ 2306)
+
+(my-assert
+ (progn (setq cl-standard-readtable
+	      (copy-readtable nil))
+	(setq *readtable* cl-standard-readtable) t)
+ t)
+
+(my-assert
+ (sys::rt-bitmask-char #\" cl-standard-readtable )
+ 117)
+
+(my-assert
+ (sys::rt-bitmask-char #\( cl-standard-readtable )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) cl-standard-readtable )
+ 165)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ cl-standard-readtable )
+ 2306)
+
+(my-assert
+ (sys::rt-bitmask-char #\" )
+ 117)
+
+(my-assert
+ (sys::rt-bitmask-char #\( )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) )
+ 165)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ )
+ 2306)
+
+(my-assert
+ "1234"
+ "1234")
+
+(my-assert
+ (progn (setq *readtable* 2.-doppelquote-liston-readtable) t)
+ t)
+
+(my-assert
+ (sys::rt-bitmask-char #\" )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\( )
+ 917)
+
+(my-assert
+ (sys::rt-bitmask-char #\) )
+ 165)
+
+(my-assert
+ (sys::rt-bitmask-char #\\ )
+ 2306)
+
+(my-assert
+ '"1 2 3)
+(1 2 3)
+
+(progn (setq *readtable* doppelquote-backslash-readtable) t)
+T
+
+(sys::rt-bitmask-char #\" )
+2306
+
+(sys::rt-bitmask-char #\( )
+917
+
+(sys::rt-bitmask-char #\) )
+165
+
+(sys::rt-bitmask-char #\\ )
+2306
+
+#"<
+ #\<)
+
+(my-assert
+ (readtablep 2.-doppelquote-backslash-readtable )
+ T)
+
+(readtablep 1)
+NIL
+
+
+(set-syntax-from-char #\" #\" 2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
+117
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
+917
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
+165
+
+
+(set-syntax-from-char #\) #\( 2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
+117
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
+917
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
+917
+
+
+(set-syntax-from-char #\( #\) 2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
+117
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
+165
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
+917
+
+
+(set-syntax-from-char #\( #\( 2.-doppelquote-liston-readtable
+		      2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
+165
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
+165
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
+2306
+
+
+(set-syntax-from-char #\) #\) 2.-doppelquote-liston-readtable
+		      2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
+165
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
+2306
+
+
+(progn (setq *readtable* 2.-doppelquote-backslash-readtable ) t)
+t
+
+)sys::rt-bitmask-char #\( (
+165
+
+)sys::rt-bitmask-char #\) (
+917
+
+)sys::rt-bitmask-char #\\ (
+2306
+
+"1234"
+"1234"
+
+')1 2 3(
+(1 2 3)
+
+)progn )setq *readtable* 2.-doppelquote-liston-readtable ( t(
+t
+
+
+)sys::rt-bitmask-char #\( (
+165
+
+)sys::rt-bitmask-char #\) (
+917
+
+)sys::rt-bitmask-char #\\ (
+2306
+
+'"1234(
+(1234)
+
+')1 2 3(
+(1 2 3)
+;;  ) muesste listen-anfang-sein
+)progn )setq *readtable* )copy-readtable nil(( t(
+t
+
+(sys::rt-bitmask-char #\" )
+117
+
+(sys::rt-bitmask-char #\( )
+917
+
+(sys::rt-bitmask-char #\) )
+165
+
+(sys::rt-bitmask-char #\\ )
+2306
+
+(sys::rt-bitmask-char #\x )
+4097
+
+(sys::rt-bitmask-char #\y )
+1
+
+
+(make-dispatch-macro-character #\x)
+T
+
+(sys::rt-bitmask-char #\x )
+4109
+
+(sys::rt-bitmask-char #\y )
+1
+
+(defun d1 (a b c) (princ "1.dmacro"))
+D1
+
+(d1 1 2 3)
+"1.dmacro"
+
+(set-dispatch-macro-character #\x #\. #'d1)
+T
+
+(sys::rt-bitmask-char #\x )
+4109
+
+(prin1-to-string (get-dispatch-macro-character #\x #\.))
+"#<SYSTEM::%TYPE-CLOSURE D1
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
+
+(multiple-value-list (read-from-string "123x.45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123x.45" t nil :start 3))
+(   "1.dmacro" 5)
+
+(multiple-value-list (read-from-string "123x.45" t nil :start 5))
+(45 7)
+
+
+(make-dispatch-macro-character #\y)
+T
+
+(s\Ys::rt-bitmask-char #\x )
+4109
+
+(s\Ys::rt-bitmask-char #\y )
+13
+
+(defun d2 (a b c) (princ "2.dmacro"))
+D2
+
+(d2 1 2 3)
+"2.dmacro"
+
+(set-dispatch-macro-character #\y #\, #'d2)
+T
+
+(s\Ys::rt-bitmask-char #\x )
+4109
+
+(s\Ys::rt-bitmask-char #\y )
+13
+
+(prin1-to-string (get-dispatch-macro-character #\x #\.))
+"#<SYSTEM::%TYPE-CLOSURE D1
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
+
+(prin1-to-string (get-dispatch-macro-character #\y #\,))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(multiple-value-list (read-from-string "123y,45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123y,45" t nil :start 3))
+(   "2.dmacro" 5)
+
+(multiple-value-list (read-from-string "123y,45" t nil :start 5))
+(45 7)
+
+(set-dispatch-macro-character #\x #\. #'d2)
+T
+
+(s\Ys::rt-bitmask-char #\x )
+4109
+
+(s\Ys::rt-bitmask-char #\y )
+13
+
+(prin1-to-string (get-dispatch-macro-character #\y #\,))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(prin1-to-string (get-dispatch-macro-character #\x #\.))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(multiple-value-list (read-from-string "123x.45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123x.45" t nil :start 3))
+(   "2.dmacro" 5)
+
+(multiple-value-list (read-from-string "123x.45" t nil :start 5))
+(45 7)
+
+(set-dispatch-macro-character #\y #\. #'d1)
+T
+
+(s\Ys::rt-bitmask-char #\x )
+4109
+
+(s\Ys::rt-bitmask-char #\y )
+13
+
+(prin1-to-string (get-dispatch-macro-character #\x #\.))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(prin1-to-string (get-dispatch-macro-character #\y #\,))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(prin1-to-string (get-dispatch-macro-character #\y #\.))
+"#<SYSTEM::%TYPE-CLOSURE D1
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
+
+(multiple-value-list (read-from-string "123y.45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123y.45" t nil :start 3))
+(   "1.dmacro" 5)
+
+(multiple-value-list (read-from-string "123y.45" t nil :start 5))
+(45 7)
+
+(multiple-value-list (read-from-string "123y,45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123y,45" t nil :start 3))
+(   "2.dmacro" 5)
+
+(multiple-value-list (read-from-string "123y,45" t nil :start 5))
+(45 7)
+
+(progn (setq *readtable* (cop\Y-readtable nil nil)) t)
+t
+
+(sys::rt-bitmask-char #\x )
+4097
+
+(sys::rt-bitmask-char #\y )
+1
+
+(get-dispatch-macro-character #\x #\.)
+ERROR
+
+(get-dispatch-macro-character #\y #\,)
+ERROR
+
+(get-dispatch-macro-character #\y #\.)
+ERROR
+
+(defun |#{-reader| (stream char arg)
+  (declare (ignore char arg))
+  (mapcon #'(lambda (x)
+              (mapcar #'(lambda (y)(list (car x) y))(cdr x)))
+          (read-delimited-list #\} stream)))
+|#{|-|reader|
+
+(set-dispatch-macro-character #\# #\{ #'|#{-reader|)
+T
+
+;;      (set-macro-character #\} (get-macro-character #\)) nil))
+;;      geht bei uns nicht !
+;;      dafuer :
+(set-syntax-from-char #\} #\) )
+;;      nicht notwendig, da superklammer
+(progn
+(setq read-st (make-string-input-stream "#{p q z a} #{a b c d}")) t)
+T
+
+(read read-st)
+((P Q) (P Z) (P A) (Q Z) (Q A) (Z A))
+
+(read read-st)
+((A B) (A C) (A D) (B C) (B D) (C D))
+
+(progn (setq *readtable* (copy-readtable nil nil))
+       (makunbound 'doppelquote-liston-readtable)
+       (makunbound 'doppelquote-backslash-readtable)
+       (makunbound '2.-doppelquote-liston-readtable)
+       (makunbound '2.-doppelquote-backslash-readtable)
+       (makunbound 'cl-standard-readtable)
+       (makunbound 'read-st)
+       (makunbound '$)
+t)
+T
+
diff --git a/src/ansi-tests/section10.lisp b/src/ansi-tests/section10.lisp
new file mode 100644
index 000000000..1d33dc314
--- /dev/null
+++ b/src/ansi-tests/section10.lisp
@@ -0,0 +1,960 @@
+;;; section 10: symbols -*- mode: lisp -*-
+(in-package :cl-user)
+
+;;; symbolp
+
+(my-assert
+ (symbolp 'elephant)
+ t)
+
+
+(my-assert
+ (symbolp 12)
+ nil)
+
+
+(my-assert
+ (symbolp nil)
+ t)
+
+
+(my-assert
+ (symbolp '())
+ t)
+
+
+(my-assert
+ (symbolp :test)
+ t)
+
+
+(my-assert
+ (symbolp "hello")
+ nil)
+
+;;; keywordp
+
+(my-assert
+ (keywordp 'elephant)
+ nil)
+
+
+(my-assert
+ (keywordp 12)
+ nil)
+
+
+(my-assert
+ (keywordp :test)
+ t)
+
+
+(my-assert
+ (keywordp ':test)
+ t)
+
+
+(my-assert
+ (keywordp nil)
+ nil)
+
+
+(my-assert
+ (keywordp :nil)
+ t)
+
+
+(my-assert
+ (keywordp '(:test))
+ nil)
+
+
+(my-assert
+ (keywordp "hello")
+ nil)
+
+
+(my-assert
+ (keywordp ":hello")
+ nil)
+
+
+(my-assert
+ (keywordp '&optional)
+ nil)
+
+;;; make-symbol
+
+
+(my-assert
+ (setq temp-string "temp")
+ "temp")
+
+
+(my-assert
+ (progn
+   (setq temp-symbol (make-symbol temp-string))
+   t)
+ t)
+
+
+(my-assert
+ (symbol-name temp-symbol)
+ "temp")
+
+
+(my-assert
+ (eq (symbol-name temp-symbol) temp-string)
+ #+(or cmu sbcl clisp ecls) t
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+
+
+(my-assert
+ (multiple-value-bind (a b)
+     (find-symbol "temp")
+   (list a b))
+ ( NIL NIL))
+
+
+(my-assert
+ (eq (make-symbol temp-string) (make-symbol temp-string))
+ nil)
+
+;;; copy-symbol
+
+
+(my-assert
+ (setq fred 'fred-smith)
+ FRED-SMITH)
+
+
+(my-assert
+ (setf (symbol-value fred) 3)
+ 3)
+
+
+(my-assert
+ (progn
+   (setq fred-clone-1a (copy-symbol fred nil))
+   t)
+ t)
+
+
+(my-assert
+ (progn
+   (setq fred-clone-1b (copy-symbol fred nil))
+   t)
+ t)
+
+
+(my-assert
+ (progn
+   (setq fred-clone-2a (copy-symbol fred t))
+   t)
+ t)
+
+
+(my-assert
+ (progn
+   (setq fred-clone-2b (copy-symbol fred t))
+   t)
+ t)
+
+
+(my-assert
+ (eq fred fred-clone-1a)
+ nil)
+
+
+(my-assert
+ (eq fred-clone-1a fred-clone-1b)
+ nil)
+
+
+(my-assert
+ (eq fred-clone-2a fred-clone-2b)
+ nil)
+
+
+(my-assert
+ (eq fred-clone-1a fred-clone-2a)
+ nil)
+
+
+(my-assert
+ (symbol-value fred)
+ 3)
+
+
+(my-assert
+ (boundp fred-clone-1a)
+ nil)
+
+
+(my-assert
+ (symbol-value fred-clone-2a)
+ 3)
+
+
+(my-assert
+ (setf (symbol-value fred-clone-2a) 4)
+ 4)
+
+
+(my-assert
+ (symbol-value fred)
+ 3)
+
+
+(my-assert
+ (symbol-value fred-clone-2a)
+ 4)
+
+
+(my-assert
+ (symbol-value fred-clone-2b)
+ 3)
+
+
+(my-assert
+ (boundp fred-clone-1a)
+ nil)
+
+
+(my-assert
+ (progn
+   (setf (symbol-function fred) #'(lambda (x) x))
+   t)
+ t)
+
+
+(my-assert
+ (fboundp fred)
+ t)
+
+
+(my-assert
+ (fboundp fred-clone-1a)
+ nil)
+
+
+(my-assert
+ (fboundp fred-clone-2a)
+ nil)
+
+;;; symbol-function
+
+
+(my-assert
+ (progn
+   (symbol-function 'car)
+   t)
+ t)
+
+(my-assert
+ (symbol-function 'twice)
+ UNDEFINED-FUNCTION)
+
+
+(my-assert
+ (defun twice (n) (* n 2))
+ TWICE)
+
+
+(my-assert
+ (progn
+   (symbol-function 'twice)
+   t)
+ t)
+
+
+(my-assert
+ (list (twice 3)
+       (funcall (function twice) 3)
+       (funcall (symbol-function 'twice) 3))
+ (6 6 6))
+
+
+(my-assert
+ (flet ((twice (x) (list x x)))
+   (list (twice 3)
+	 (funcall (function twice) 3)
+	 (funcall (symbol-function 'twice) 3)))
+ ((3 3) (3 3) 6)   )
+
+
+(my-assert
+ (progn
+   (setf (symbol-function 'twice) #'(lambda (x) (list x x)))
+   t)
+ t)
+
+
+(my-assert
+ (list (twice 3)
+       (funcall (function twice) 3)
+       (funcall (symbol-function 'twice) 3))
+ ((3 3) (3 3) (3 3)))
+
+
+(my-assert
+ (fboundp 'defun)
+ t)
+
+
+(my-assert
+ (progn
+   (symbol-function 'defun)
+   t)
+ t)
+
+
+(my-assert
+ (progn
+   (functionp (symbol-function 'defun))
+   t)
+ t)
+
+
+(my-assert
+ (defun symbol-function-or-nil (symbol)
+   (if (and (fboundp symbol)
+	    (not (macro-function symbol))
+	    (not (special-operator-p symbol)))
+       (symbol-function symbol)
+       nil))
+ SYMBOL-FUNCTION-OR-NIL)
+
+
+(my-assert
+ (progn
+   (symbol-function-or-nil 'car)
+   t)
+ t)
+
+
+(my-assert
+ (symbol-function-or-nil 'defun)
+ NIL)
+
+;;; symbol-name
+
+
+(my-assert
+ (symbol-name 'temp)
+ "TEMP" )
+
+
+(my-assert
+ (symbol-name :start)
+ "START")
+
+;;; symbol-package
+
+
+(my-assert
+ (progn
+   (in-package "CL-USER")
+   t)
+ t)
+
+
+
+(my-assert
+ (progn
+   (symbol-package 'car)
+   t)
+ t)
+
+
+
+(my-assert
+ (progn
+   (symbol-package 'bus)
+   t)
+ t)
+
+
+(my-assert
+ (progn
+   (symbol-package :optional)
+   t)
+ t)
+
+
+;; Gensyms are uninterned, so have no home package.
+
+(my-assert
+ (symbol-package (gensym))
+ NIL)
+
+
+(if (find-package "PK2")
+    (delete-package
+     (find-package "PK2")))
+
+(if (find-package "PK1")
+    (delete-package
+     (find-package "PK1")))
+
+(my-assert
+ (find-package "PK1")
+ nil)
+
+(my-assert
+ (progn
+   (make-package 'pk1)
+   t)
+ t)
+
+
+(my-assert
+ (multiple-value-bind (a b)
+     (intern "SAMPLE1" "PK1")
+   (list a b))
+ (PK1::SAMPLE1 :internal))
+
+
+(my-assert
+ (export (find-symbol "SAMPLE1" "PK1") "PK1")
+ T)
+
+
+(my-assert
+ (progn
+   (make-package 'pk2 :use '(pk1))
+   t)
+ t)
+
+
+(my-assert
+ (multiple-value-bind (a b)
+     (find-symbol "SAMPLE1" "PK2")
+   (list a b))
+ (PK1:SAMPLE1 :INHERITED))
+
+
+(my-assert
+ (progn
+   (symbol-package 'pk1::sample1)
+   t)
+ t)
+
+
+(my-assert
+ (progn
+   (symbol-package 'pk2::sample1)
+   t)
+ t)
+
+
+(my-assert
+ (progn
+   (symbol-package 'pk1::sample2)
+   t)
+ t)
+
+
+(my-assert
+ (progn
+   (symbol-package 'pk2::sample2)
+   t)
+ t)
+
+;; The next several forms create a scenario in which a symbol
+;; is not really uninterned, but is "apparently uninterned",
+;; and so SYMBOL-PACKAGE still returns NIL.
+
+(my-assert
+ (setq s3 'pk1::sample3)
+ PK1::SAMPLE3)
+
+
+(my-assert
+ (import s3 'pk2)
+ T)
+
+
+(my-assert
+ (unintern s3 'pk1)
+ T)
+
+
+(my-assert
+ (symbol-package s3)
+ NIL)
+
+
+(my-assert
+ (eq s3 'pk2::sample3)
+ T)
+
+;;; symbol-plist
+
+
+(setq sym (gensym))
+
+(my-assert
+ (symbol-plist sym)
+ ())
+
+
+(my-assert
+ (setf (get sym 'prop1) 'val1)
+ VAL1)
+
+
+(my-assert
+ (symbol-plist sym)
+ (PROP1 VAL1))
+
+
+(my-assert
+ (setf (get sym 'prop2) 'val2)
+ VAL2)
+
+
+(my-assert
+ (symbol-plist sym)
+ (PROP2 VAL2 PROP1 VAL1))
+
+
+(my-assert
+ (setf (symbol-plist sym) (list 'prop3 'val3))
+ (PROP3 VAL3))
+
+
+(my-assert
+ (symbol-plist sym)
+ (PROP3 VAL3))
+
+;;; setf
+
+
+(my-assert
+ (setf (symbol-value 'a) 1)
+ 1)
+
+
+(my-assert
+ (symbol-value 'a)
+ 1)
+
+;; SYMBOL-VALUE can see dynamic variables.
+
+(my-assert
+ (let ((a 2))
+   (declare (special a))
+   (symbol-value 'a))
+ 2)
+
+
+(my-assert
+ (let ((a 2))
+   (declare (special a))
+   (setq a 3)
+   (symbol-value 'a))
+ 3)
+
+
+(my-assert
+ (let ((a 2))
+   (setf (symbol-value 'a) 3)
+   t)
+ t)
+
+
+					;(my-assert
+					;a
+					;3)
+
+
+					;(my-assert
+					;(symbol-value 'a)
+					;3)
+
+
+(my-assert
+ (multiple-value-bind (h j)
+     (let ((a 4))
+       (declare (special a))
+       (let ((b (symbol-value 'a)))
+	 (setf (symbol-value 'a) 5)
+	 (values a b)))
+   (list h j))
+ (5 4))
+
+
+					;(my-assert
+					;a
+					;3)
+
+
+(my-assert
+ (symbol-value :any-keyword)
+ :ANY-KEYWORD)
+
+
+(my-assert
+ (symbol-value 'nil)
+ NIL)
+
+
+(my-assert
+ (symbol-value '())
+ NIL)
+
+;; The precision of this next one is implementation-dependent.
+
+(my-assert
+ (symbol-value 'pi)
+ #-clisp
+ 3.141592653589793d0
+ #+clisp
+ 3.1415926535897932385L0)
+
+;;; get
+
+
+(my-assert
+ (defun make-person (first-name last-name)
+   (let ((person (gensym "PERSON")))
+     (setf (get person 'first-name) first-name)
+     (setf (get person 'last-name) last-name)
+     person))
+ MAKE-PERSON)
+
+
+(my-assert
+ (defvar *john* (make-person "John" "Dow"))
+ *JOHN*)
+
+
+(my-assert
+ (progn
+   *john*
+   t)
+ t)
+
+
+(my-assert
+ (defvar *sally* (make-person "Sally" "Jones"))
+ *SALLY*)
+
+
+(my-assert
+ (get *john* 'first-name)
+ "John")
+
+
+(my-assert
+ (get *sally* 'last-name)
+ "Jones")
+
+
+(my-assert
+ (defun marry (man woman married-name)
+   (setf (get man 'wife) woman)
+   (setf (get woman 'husband) man)
+   (setf (get man 'last-name) married-name)
+   (setf (get woman 'last-name) married-name)
+   married-name)
+ MARRY)
+
+
+(my-assert
+ (marry *john* *sally* "Dow-Jones")
+ "Dow-Jones")
+
+
+(my-assert
+ (get *john* 'last-name)
+ "Dow-Jones")
+
+
+(my-assert
+ (get (get *john* 'wife) 'first-name)
+ "Sally")
+
+
+(my-assert
+ (progn
+   (symbol-plist *john*)
+   t)
+ t)
+
+
+(my-assert
+ (defmacro age (person &optional (default ''thirty-something))
+   `(get ,person 'age ,default))
+ AGE)
+
+
+(my-assert
+ (age *john*)
+ THIRTY-SOMETHING)
+
+
+(my-assert
+ (age *john* 20)
+ 20)
+
+
+(my-assert
+ (setf (age *john*) 25)
+ 25)
+
+
+(my-assert
+ (age *john*)
+ 25)
+
+
+(my-assert
+ (age *john* 20)
+ 25)
+
+;;; remprop
+
+
+(my-assert
+ (progn
+   (setq test (make-symbol "PSEUDO-PI"))
+   t)
+ t)
+
+
+(my-assert
+ (symbol-plist test)
+ ())
+
+
+(my-assert
+ (setf (get test 'constant) t)
+ T)
+
+
+(my-assert
+ (setf (get test 'approximation) 3.14)
+ 3.14)
+
+
+(my-assert
+ (setf (get test 'error-range) 'noticeable)
+ NOTICEABLE)
+
+
+(my-assert
+ (symbol-plist test)
+ (ERROR-RANGE NOTICEABLE APPROXIMATION 3.14 CONSTANT T))
+
+
+(my-assert
+ (setf (get test 'approximation) nil)
+ NIL)
+
+
+(my-assert
+ (symbol-plist test)
+ (ERROR-RANGE NOTICEABLE APPROXIMATION NIL CONSTANT T))
+
+
+(my-assert
+ (get test 'approximation)
+ NIL)
+
+
+(my-assert
+ (not (remprop test 'approximation))
+ nil)
+
+
+(my-assert
+ (get test 'approximation)
+ NIL)
+
+
+(my-assert
+ (symbol-plist test)
+ (ERROR-RANGE NOTICEABLE CONSTANT T))
+
+
+(my-assert
+ (remprop test 'approximation)
+ NIL)
+
+
+(my-assert
+ (symbol-plist test)
+ (ERROR-RANGE NOTICEABLE CONSTANT T))
+
+
+(my-assert
+ (not (remprop test 'error-range))
+ nil)
+
+
+(my-assert
+ (setf (get test 'approximation) 3)
+ 3)
+
+
+(my-assert
+ (symbol-plist test)
+ (APPROXIMATION 3 CONSTANT T))
+
+
+;;; boundp
+
+
+(my-assert
+ (setq x 1)
+ 1)
+
+
+(my-assert
+ (boundp 'x)
+ t)
+
+
+(my-assert
+ (makunbound 'x)
+ X)
+
+
+(my-assert
+ (boundp 'x)
+ nil)
+
+
+
+(my-assert
+ (let ((x 2)) (declare (special x)) (boundp 'x))
+ t)
+
+;;; mkunbound
+
+
+(my-assert
+ (setf (symbol-value 'a) 1)
+ 1)
+
+
+(my-assert
+ (boundp 'a)
+ t)
+
+
+(my-assert
+ a
+ 1)
+
+
+(my-assert
+ (makunbound 'a)
+ A)
+
+
+(my-assert
+ (boundp 'a)
+ nil)
+
+;;; set
+
+
+(my-assert
+ (setf (symbol-value 'n) 1)
+ 1)
+
+
+(my-assert
+ (set 'n 2)
+ 2)
+
+
+(my-assert
+ (symbol-value 'n)
+ 2)
+
+
+					;(my-assert
+					;(let ((n 3))
+					;  (declare (special n))
+					;  (setq n (+ n 1))
+					;  (setf (symbol-value 'n) (* n 10))
+					;  (set 'n (+ (symbol-value 'n) n))
+					;   n)
+					;80)
+
+
+					;(my-assert
+					;n
+					;2)
+
+
+					;(my-assert
+					;(let ((n 3))
+					;  (setq n (+ n 1))
+					;  (setf (symbol-value 'n) (* n 10))
+					;  (set 'n (+ (symbol-value 'n) n))
+					;  n)
+					;4)
+
+
+					;(my-assert
+					;n
+					;44)
+
+
+(my-assert
+ (defvar *n* 2)
+ *N*)
+
+
+(my-assert
+ (let ((*n* 3))
+   (setq *n* (+ *n* 1))
+   (setf (symbol-value '*n*) (* *n* 10))
+   (set '*n* (+ (symbol-value '*n*) *n*))
+   *n*)
+ 80)
+
+
+(my-assert
+ *n*
+ 2)
+
+
+(my-assert
+ (defvar *even-count* 0)
+ *EVEN-COUNT*)
+
+
+(my-assert
+ (defvar *odd-count* 0)
+ *ODD-COUNT*)
+
+
+(my-assert
+ (defun tally-list (list)
+   (dolist (element list)
+     (set (if (evenp element) '*even-count* '*odd-count*)
+	  (+ element (if (evenp element) *even-count* *odd-count*)))))
+ tally-list)
+
+
+(my-assert
+ (tally-list '(1 9 4 3 2 7))
+ NIL)
+
+
+(my-assert
+ *even-count*
+ 6)
+
+
+
+(my-assert
+ *odd-count*
+ 20)
+
diff --git a/src/ansi-tests/section11.lisp b/src/ansi-tests/section11.lisp
new file mode 100644
index 000000000..0afe742ed
--- /dev/null
+++ b/src/ansi-tests/section11.lisp
@@ -0,0 +1,5 @@
+;;; section 11: packages -*- mode: lisp -*-
+(in-package :cl-user)
+
+
+;;; bah
diff --git a/src/ansi-tests/section12.lisp b/src/ansi-tests/section12.lisp
new file mode 100644
index 000000000..b7133d462
--- /dev/null
+++ b/src/ansi-tests/section12.lisp
@@ -0,0 +1,861 @@
+;;; 12: numbers -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+;;; 12.1.4.1.1
+
+;;;; Combining rationals with floats.
+;;; This example assumes an implementation in which
+;;; (float-radix 0.5) is 2 (as in IEEE) or 16 (as in IBM/360),
+;;; or else some other implementation in which 1/2 has an exact
+;;;  representation in floating point.
+(my-assert
+ (+ 1/2 0.5)
+ 1.0)
+
+
+(my-assert
+ (- 1/2 0.5d0)
+ 0.0d0)
+
+
+(my-assert
+ (+ 0.5 -0.5 1/2)
+ 0.5)
+
+;;;; Comparing rationals with floats.
+;;; This example assumes an implementation in which the default float
+;;; format is IEEE single-float, IEEE double-float, or some other format
+;;; in which 5/7 is rounded upwards by FLOAT.
+
+(my-assert
+ (< 5/7 (float 5/7))
+ t)
+
+
+(my-assert
+ (< 5/7 (rational (float 5/7)))
+ t)
+
+
+(my-assert
+ (< (float 5/7) (float 5/7))
+ nil)
+
+;;; 12.1.5.3.1
+
+
+(my-assert
+ #c(1.0 1.0)
+ #C(1.0 1.0))
+
+(my-assert
+ #c(0.0 0.0)
+ #C(0.0 0.0))
+
+(my-assert
+ #c(1.0 1)
+ #C(1.0 1.0))
+
+(my-assert
+ #c(0.0 0)
+ #C(0.0 0.0))
+
+(my-assert
+ #c(1 1)
+ #C(1 1))
+
+(my-assert
+ #c(0 0)
+ 0)
+
+(my-assert
+ (typep #c(1 1) '(complex (eql 1)))
+ t)
+
+
+(my-assert
+ (typep #c(0 0) '(complex (eql 0)))
+ nil)
+
+;;; number
+
+
+(my-assert
+ (subtypep 'real  'number)
+ t)
+
+
+(my-assert
+ (subtypep 'complex 'number)
+ t)
+
+
+(my-assert
+ (subtypep 'rational 'real)
+ t)
+
+
+(my-assert
+ (subtypep 'float 'real)
+ t)
+
+
+;;; float
+
+
+(my-assert
+ (subtypep 'short-float 'float)
+ t)
+
+
+(my-assert
+ (subtypep 'single-float 'float)
+ t)
+
+
+(my-assert
+ (subtypep 'double-float 'float)
+ t)
+
+
+(my-assert
+ (subtypep 'long-float  'float)
+ t)
+
+;;; rational
+
+
+(my-assert
+ (subtypep 'integer 'rational)
+ t)
+
+
+(my-assert
+ (subtypep 'ratio 'rational)
+ t)
+
+;;; integer
+
+
+(my-assert
+ (subtypep 'fixnum 'integer)
+ t)
+
+
+(my-assert
+ (subtypep 'bignum 'integer)
+ t)
+;;; fixnum
+
+(my-assert
+ (subtypep '(signed-byte 16) 'fixnum)
+ t)
+;;; = /= < > <= >=
+
+(my-assert
+ (= 3 3)
+ t)
+
+(my-assert
+ (/= 3 3)
+ nil)
+
+(my-assert
+ (= 3 5)
+ nil)
+
+(my-assert
+ (/= 3 5)
+ t)
+
+(my-assert
+ (= 3 3 3 3)
+ t)
+
+(my-assert
+ (/= 3 3 3 3)
+ nil)
+
+(my-assert
+ (= 3 3 5 3)
+ nil)
+
+(my-assert
+ (/= 3 3 5 3)
+ nil)
+
+(my-assert
+ (= 3 6 5 2)
+ nil)
+
+(my-assert
+ (/= 3 6 5 2)
+ t)
+
+(my-assert
+ (= 3 2 3)
+ nil)
+
+(my-assert
+ (/= 3 2 3)
+ nil)
+
+(my-assert
+ (< 3 5)
+ t)
+
+(my-assert
+ (<= 3 5)
+ t)
+
+(my-assert
+ (< 3 -5)
+ nil)
+
+(my-assert
+ (<= 3 -5)
+ nil)
+
+(my-assert
+ (< 3 3)
+ nil)
+
+(my-assert
+ (<= 3 3)
+ t)
+
+(my-assert
+ (< 0 3 4 6 7)
+ t)
+
+(my-assert
+ (<= 0 3 4 6 7)
+ t)
+
+(my-assert
+ (< 0 3 4 4 6)
+ nil)
+
+(my-assert
+ (<= 0 3 4 4 6)
+ t)
+
+(my-assert
+ (> 4 3)
+ t)
+
+(my-assert
+ (>= 4 3)
+ t)
+
+(my-assert
+ (> 4 3 2 1 0)
+ t)
+
+(my-assert
+ (>= 4 3 2 1 0)
+ t)
+
+(my-assert
+ (> 4 3 3 2 0)
+ nil)
+
+(my-assert
+ (>= 4 3 3 2 0)
+ t)
+
+(my-assert
+ (> 4 3 1 2 0)
+ nil)
+
+(my-assert
+ (>= 4 3 1 2 0)
+ nil)
+
+(my-assert
+ (= 3)
+ t)
+
+(my-assert
+ (/= 3)
+ t)
+
+(my-assert
+ (< 3)
+ t)
+
+(my-assert
+ (<= 3)
+ t)
+
+(my-assert
+ (= 3.0 #c(3.0 0.0))
+ t)
+
+(my-assert
+ (/= 3.0 #c(3.0 1.0))
+ t)
+
+(my-assert
+ (= 3 3.0)
+ t)
+
+(my-assert
+ (= 3.0s0 3.0d0)
+ t)
+
+(my-assert
+ (= 0.0 -0.0)
+ t)
+
+(my-assert
+ (= 5/2 2.5)
+ t)
+(my-assert
+ (> 0.0 -0.0)
+ nil)
+(my-assert
+ (= 0 -0.0)
+ t)
+
+
+;;; min max
+
+
+(my-assert
+ (max 3)
+ 3 )
+
+
+(my-assert
+ (min 3)
+ 3)
+
+
+(my-assert
+ (max 6 12)
+ 12 )
+
+
+(my-assert
+ (min 6 12)
+ 6)
+
+
+(my-assert
+ (max -6 -12)
+ -6 )
+
+
+(my-assert
+ (min -6 -12)
+ -12)
+
+
+(my-assert
+ (max 1 3 2 -7)
+ 3 )
+
+
+(my-assert
+ (min 1 3 2 -7)
+ -7)
+
+
+(my-assert
+ (max -2 3 0 7)
+ 7 )
+
+
+(my-assert
+ (min -2 3 0 7)
+ -2)
+
+
+(my-assert
+ (max 5.0 2)
+ 5.0 )
+
+
+(my-assert
+ (min 5.0 2)
+ #+(or cmu sbcl clisp ecls) 2
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  2 OR  2.0
+
+
+(my-assert
+ (max 3.0 7 1)
+ #+(or cmu sbcl clisp ecls) 7
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  7 OR  7.0
+
+
+(my-assert
+ (min 3.0 7 1)
+ #+(or cmu sbcl clisp ecls) 1
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					; 1 OR  1.0
+
+
+(my-assert
+ (max 1.0s0 7.0d0)
+ 7.0d0)
+
+
+(my-assert
+ (min 1.0s0 7.0d0)
+ #+(or cmu sbcl ecls) 1.0		;hmm in fact an error?
+ #+clisp 1.0s0
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  1.0s0 OR  1.0d0
+
+
+(my-assert
+ (max 3 1 1.0s0 1.0d0)
+ #+(or cmu sbcl clisp ecls) 3
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  3 OR 3.0d0
+
+
+(my-assert
+ (min 3 1 1.0s0 1.0d0)
+ #+(or cmu sbcl clisp ecls) 1
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  1 OR  1.0s0  OR  1.0d0
+
+;;; plusp minusp
+
+
+(my-assert
+ (minusp -1)
+ t)
+
+
+(my-assert
+ (plusp 0)
+ nil)
+
+
+(my-assert
+ (plusp least-positive-single-float)
+ t)
+
+
+(my-assert
+ (plusp least-positive-double-float)
+ t)
+
+
+(my-assert
+ (minusp least-positive-single-float)
+ nil)
+
+
+(my-assert
+ (minusp least-positive-double-float)
+ nil)
+
+
+(my-assert
+ (plusp least-negative-single-float)
+ nil)
+
+
+(my-assert
+ (plusp least-negative-double-float)
+ nil)
+
+
+(my-assert
+ (minusp least-negative-single-float)
+ t)
+
+
+(my-assert
+ (minusp least-negative-double-float)
+ t)
+
+
+(my-assert
+ (minusp 0)
+ nil)
+
+
+(my-assert
+ (minusp -0.0)
+ nil)
+
+
+(my-assert
+ (minusp +0.0)
+ nil)
+
+
+(my-assert
+ (plusp 0)
+ nil)
+
+
+(my-assert
+ (plusp -0.0)
+ nil)
+
+
+(my-assert
+ (plusp +0.0)
+ nil)
+
+
+;;; zerop
+
+
+(my-assert
+ (zerop 0)
+ t)
+
+
+(my-assert
+ (zerop 0.0)
+ t)
+
+
+(my-assert
+ (zerop +0.0)
+ t)
+
+
+(my-assert
+ (zerop -0.0)
+ t)
+
+
+(my-assert
+ (zerop -1)
+ nil)
+
+
+(my-assert
+ (zerop 1)
+ nil)
+
+
+(my-assert
+ (zerop 0/100)
+ t)
+
+
+(my-assert
+ (zerop #c(0 0.0))
+ t)
+
+;;; random-state-p
+
+
+(my-assert
+ (random-state-p *random-state*)
+ t)
+
+
+(my-assert
+ (random-state-p (make-random-state))
+ t)
+
+
+(my-assert
+ (random-state-p 'test-function)
+ nil)
+
+;;; number-p
+
+
+(my-assert
+ (numberp 12)
+ t)
+
+
+(my-assert
+ (numberp (expt 2 130))
+ t)
+
+
+(my-assert
+ (numberp #c(5/3 7.2))
+ t)
+
+
+(my-assert
+ (numberp nil)
+ nil)
+
+
+(my-assert
+ (numberp (cons 1 2))
+ nil)
+
+;;; most-positive-fixnum
+
+
+
+(my-assert
+ (>= most-positive-fixnum (- (expt 2 15) 1))
+ t)
+
+
+(my-assert
+ (>= most-positive-fixnum array-dimension-limit)
+ t
+ "
+most-positive-fixnum is that fixnum closest in value
+to positive infinity provided by the implementation, and
+greater than or equal to both 2^15 - 1 and array-dimension-limit.
+")
+
+
+(my-assert
+ (<= most-negative-fixnum (- (expt 2 15)))
+ t)
+
+;;; most-positive bla bla
+
+
+(my-assert
+ (plusp MOST-POSITIVE-SHORT-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp  LEAST-POSITIVE-SHORT-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp  LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp  MOST-POSITIVE-DOUBLE-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp LEAST-POSITIVE-DOUBLE-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp  LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp MOST-POSITIVE-LONG-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp LEAST-POSITIVE-LONG-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp LEAST-POSITIVE-NORMALIZED-LONG-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp  MOST-POSITIVE-SINGLE-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp LEAST-POSITIVE-SINGLE-FLOAT)
+ t)
+
+
+(my-assert
+ (plusp  LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp MOST-NEGATIVE-SHORT-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp  LEAST-NEGATIVE-SHORT-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp  MOST-NEGATIVE-SINGLE-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp LEAST-NEGATIVE-SINGLE-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp  LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp MOST-NEGATIVE-DOUBLE-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp  LEAST-NEGATIVE-DOUBLE-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp  MOST-NEGATIVE-LONG-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp LEAST-NEGATIVE-LONG-FLOAT)
+ t)
+
+
+(my-assert
+ (minusp  LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT)
+ t)
+
+;;; epsilons
+
+
+
+(my-assert
+ (not (= (float 1 short-float-epsilon)
+	 (+ (float 1 short-float-epsilon) short-float-epsilon)))
+ t
+ "The value of each of the constants short-float-epsilon,
+single-float-epsilon, double-float-epsilon, and
+long-float-epsilon is the smallest positive float
+<EPSILON> of the given format, such that the following
+expression is true when evaluated: 
+
+(not (= (float 1 <EPSILON>) (+ (float 1 <EPSILON>) <EPSILON>))
+     ")
+
+
+(my-assert
+ (not (= (float 1 single-float-epsilon)
+	 (+ (float 1 single-float-epsilon) single-float-epsilon)))
+ t
+ "The value of each of the constants short-float-epsilon,
+single-float-epsilon, double-float-epsilon, and
+long-float-epsilon is the smallest positive float
+<EPSILON> of the given format, such that the following
+expression is true when evaluated: 
+
+(not (= (float 1 <EPSILON>) (+ (float 1 <EPSILON>) <EPSILON>))
+     ")
+
+
+(my-assert
+ (not (= (float 1 double-float-epsilon)
+	 (+ (float 1 double-float-epsilon) double-float-epsilon)))
+ t
+ "The value of each of the constants short-float-epsilon,
+single-float-epsilon, double-float-epsilon, and
+long-float-epsilon is the smallest positive float
+<EPSILON> of the given format, such that the following
+expression is true when evaluated: 
+
+(not (= (float 1 <EPSILON>) (+ (float 1 <EPSILON>) <EPSILON>))
+     ")
+
+
+(my-assert
+ (not (= (float 1 long-float-epsilon )
+	 (+ (float 1 long-float-epsilon ) long-float-epsilon )))
+ t
+ "The value of each of the constants short-float-epsilon,
+single-float-epsilon, double-float-epsilon, and
+long-float-epsilon is the smallest positive float
+<EPSILON> of the given format, such that the following
+expression is true when evaluated: 
+
+(not (= (float 1 <EPSILON>) (+ (float 1 <EPSILON>) <EPSILON>))
+     ")
+
+
+(my-assert
+ (not (= (float 1 short-float-negative-epsilon)
+	 (- (float 1 short-float-negative-epsilon)
+	    short-float-negative-epsilon)))
+ t
+ "The value of each of the constants short-float-negative-epsilon,
+single-float-negative-epsilon,
+double-float-negative-epsilon, and long-float-negative-epsilon
+is the smallest positive float <EPSILON> of
+the given format, such that the following expression
+is true when evaluated: 
+
+(not (= (float 1 <EPSILON>) (- (float 1 <EPSILON>) <EPSILON>))) ")
+
+
+(my-assert
+ (not (= (float 1 single-float-negative-epsilon)
+	 (- (float 1 single-float-negative-epsilon)
+	    single-float-negative-epsilon)))
+ t
+ "The value of each of the constants short-float-negative-epsilon,
+single-float-negative-epsilon,
+double-float-negative-epsilon, and long-float-negative-epsilon
+is the smallest positive float <EPSILON> of
+the given format, such that the following expression
+is true when evaluated: 
+
+(not (= (float 1 <EPSILON>) (- (float 1 <EPSILON>) <EPSILON>))) ")
+
+
+(my-assert
+ (not (= (float 1 double-float-negative-epsilon)
+	 (- (float 1 double-float-negative-epsilon)
+	    double-float-negative-epsilon)))
+ t
+ "The value of each of the constants short-float-negative-epsilon,
+single-float-negative-epsilon,
+double-float-negative-epsilon, and long-float-negative-epsilon
+is the smallest positive float <EPSILON> of
+the given format, such that the following expression
+is true when evaluated: 
+
+(not (= (float 1 <EPSILON>) (- (float 1 <EPSILON>) <EPSILON>))) ")
+
+
+
+(my-assert
+ (not (= (float 1 long-float-negative-epsilon)
+	 (- (float 1 long-float-negative-epsilon)
+	    long-float-negative-epsilon)))
+ t
+ "The value of each of the constants short-float-negative-epsilon,
+single-float-negative-epsilon,
+double-float-negative-epsilon, and long-float-negative-epsilon
+is the smallest positive float <EPSILON> of
+the given format, such that the following expression
+is true when evaluated: 
+
+(not (= (float 1 <EPSILON>) (- (float 1 <EPSILON>) <EPSILON>))) ")
diff --git a/src/ansi-tests/section13.lisp b/src/ansi-tests/section13.lisp
new file mode 100644
index 000000000..1ccd24e1a
--- /dev/null
+++ b/src/ansi-tests/section13.lisp
@@ -0,0 +1,583 @@
+;;; 13 characters -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+(my-assert
+ (subtypep 'base-char 'character)
+ T)
+
+
+(my-assert
+ (subtypep 'standard-char 'base-char)
+ t)
+
+
+(my-assert
+ (subtypep 'extended-char 'character)
+ t
+ "Type EXTENDED-CHAR
+
+Supertypes:
+
+extended-char, character, t")
+
+;;; char= etc
+
+
+(my-assert
+ (char= #\d #\d)
+ t)
+
+
+(my-assert
+ (char= #\A #\a)
+ nil)
+
+
+(my-assert
+ (char= #\d #\x)
+ nil)
+
+
+(my-assert
+ (char= #\d #\D)
+ nil)
+
+
+(my-assert
+ (char/= #\d #\d)
+ nil)
+
+
+(my-assert
+ (char/= #\d #\x)
+ t)
+
+
+(my-assert
+ (char/= #\d #\D)
+ t)
+
+
+(my-assert
+ (char= #\d #\d #\d #\d)
+ t)
+
+
+(my-assert
+ (char/= #\d #\d #\d #\d)
+ nil)
+
+
+(my-assert
+ (char= #\d #\d #\x #\d)
+ nil)
+
+
+(my-assert
+ (char/= #\d #\d #\x #\d)
+ nil)
+
+
+(my-assert
+ (char= #\d #\y #\x #\c)
+ nil)
+
+
+(my-assert
+ (char/= #\d #\y #\x #\c)
+ t)
+
+
+(my-assert
+ (char= #\d #\c #\d)
+ nil)
+
+
+(my-assert
+ (char/= #\d #\c #\d)
+ nil)
+
+
+(my-assert
+ (char< #\d #\x)
+ t)
+
+
+(my-assert
+ (char<= #\d #\x)
+ t)
+
+
+(my-assert
+ (char< #\d #\d)
+ nil)
+
+
+(my-assert
+ (char<= #\d #\d)
+ t)
+
+
+(my-assert
+ (char< #\a #\e #\y #\z)
+ t)
+
+
+(my-assert
+ (char<= #\a #\e #\y #\z)
+ t)
+
+
+(my-assert
+ (char< #\a #\e #\e #\y)
+ nil)
+
+
+(my-assert
+ (char<= #\a #\e #\e #\y)
+ t)
+
+
+(my-assert
+ (char> #\e #\d)
+ t)
+
+
+(my-assert
+ (char>= #\e #\d)
+ t)
+
+
+(my-assert
+ (char> #\d #\c #\b #\a)
+ t)
+
+
+(my-assert
+ (char>= #\d #\c #\b #\a)
+ t)
+
+
+(my-assert
+ (char> #\d #\d #\c #\a)
+ nil)
+
+
+(my-assert
+ (char>= #\d #\d #\c #\a)
+ t)
+
+
+(my-assert
+ (char> #\e #\d #\b #\c #\a)
+ nil)
+
+
+(my-assert
+ (char>= #\e #\d #\b #\c #\a)
+ nil)
+
+
+(my-assert
+ (char> #\z #\A)
+ #+(or cmu sbcl clisp ecls) T
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+
+
+(my-assert
+ (char> #\Z #\a)
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+
+
+(my-assert
+ (char-equal #\A #\a)
+ t)
+
+
+(my-assert
+ (stable-sort (list #\b #\A #\B #\a #\c #\C) #'char-lessp)
+ (#\A #\a #\b #\B #\c #\C))
+
+
+(my-assert
+ (stable-sort (list #\b #\A #\B #\a #\c #\C) #'char<)
+ #+(or cmu sbcl clisp ecls) (#\A #\B #\C #\a #\b #\c)
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  (#\A #\B #\C #\a #\b #\c) ;Implementation A
+					;  (#\a #\b #\c #\A #\B #\C) ;Implementation B
+					;  (#\a #\A #\b #\B #\c #\C) ;Implementation C
+					;  (#\A #\a #\B #\b #\C #\c) ;Implementation D
+					;  (#\A #\B #\a #\b #\C #\c) ;Implementation E
+
+;;; character
+
+
+(my-assert
+ (character #\a)
+ #\a)
+
+
+(my-assert
+ (character "a")
+ #\a)
+
+(my-assert
+ (character 'a)
+ #\A)
+
+
+(my-assert
+ (character '\a)
+ #\a)
+
+
+(my-assert
+ (character 65.0)
+ TYPE-ERROR)
+
+
+(my-assert
+ (character 'apple)
+ TYPE-ERROR)
+
+
+;;; alpha-char-p
+
+
+(my-assert
+ (alpha-char-p #\a)
+ t)
+
+
+(my-assert
+ (alpha-char-p #\5)
+ nil)
+
+
+(my-assert
+ (alpha-char-p #\Newline)
+ nil)
+
+;;; alphanumericp
+
+
+(my-assert
+ (alphanumericp #\Z)
+ t)
+
+
+(my-assert
+ (alphanumericp #\9)
+ t)
+
+
+(my-assert
+ (alphanumericp #\Newline)
+ nil)
+
+
+(my-assert
+ (alphanumericp #\#)
+ nil)
+
+;;; digit-char
+
+
+(my-assert
+ (digit-char 0)
+ #\0)
+
+
+(my-assert
+ (digit-char 10 11)
+ #\A)
+
+
+(my-assert
+ (digit-char 10 10)
+ nil)
+
+
+(my-assert
+ (digit-char 7)
+ #\7)
+
+
+(my-assert
+ (digit-char 12)
+ nil)
+
+
+(my-assert
+ (digit-char 12 16)
+ #\C)
+
+
+(my-assert
+ (digit-char 6 2)
+ nil)
+
+
+(my-assert
+ (digit-char 1 2)
+ #\1)
+
+;;; digit-char-p
+
+
+(my-assert
+ (digit-char-p #\5)
+ 5)
+
+
+(my-assert
+ (digit-char-p #\5 2)
+ nil)
+
+
+(my-assert
+ (digit-char-p #\A)
+ nil)
+
+
+(my-assert
+ (digit-char-p #\a)
+ nil)
+
+
+(my-assert
+ (digit-char-p #\A 11)
+ 10)
+
+
+(my-assert
+ (digit-char-p #\a 11)
+ 10)
+
+
+(my-assert
+ (mapcar #'(lambda (radix)
+	     (map 'list #'(lambda (x) (digit-char-p x radix))
+		  "059AaFGZ"))
+	 '(2 8 10 16 36))
+ ((0 NIL NIL NIL NIL NIL NIL NIL)
+  (0 5 NIL NIL NIL NIL NIL NIL)
+  (0 5 9 NIL NIL NIL NIL NIL)
+  (0 5 9 10 10 15 NIL NIL)
+  (0 5 9 10 10 15 16 35)))
+
+;;; graphic-char
+
+
+(my-assert
+ (graphic-char-p #\G)
+ t)
+
+
+(my-assert
+ (graphic-char-p #\#)
+ t)
+
+
+(my-assert
+ (graphic-char-p #\Space)
+ t)
+
+
+(my-assert
+ (graphic-char-p #\Newline)
+ nil)
+
+;;; standard-char-p
+
+
+(my-assert
+ (standard-char-p #\Space)
+ t)
+
+
+(my-assert
+ (standard-char-p #\~)
+ t)
+
+;;; char-upcase
+
+
+(my-assert
+ (char-upcase #\a)
+ #\A)
+
+
+(my-assert
+ (char-upcase #\A)
+ #\A)
+
+
+(my-assert
+ (char-downcase #\a)
+ #\a)
+
+
+(my-assert
+ (char-downcase #\A)
+ #\a)
+
+
+(my-assert
+ (char-upcase #\9)
+ #\9)
+
+
+(my-assert
+ (char-downcase #\9)
+ #\9)
+
+
+(my-assert
+ (char-upcase #\@)
+ #\@)
+
+
+(my-assert
+ (char-downcase #\@)
+ #\@)
+
+;; Note that this next example might run for a very long time in
+;; some implementations if CHAR-CODE-LIMIT happens to be very large
+;; for that implementation.
+
+(my-assert
+ (dotimes (code char-code-limit)
+   (let ((char (code-char code)))
+     (when char
+       (unless (cond ((upper-case-p char)
+		      (char= (char-upcase
+			      (char-downcase char)) char))
+		     ((lower-case-p char)
+		      (char= (char-downcase
+			      (char-upcase char)) char))
+		     (t (and (char= (char-upcase
+				     (char-downcase char)) char)
+			     (char= (char-downcase
+				     (char-upcase char)) char))))
+	 (return char)))))
+ NIL)
+
+;;; upper-case-p
+
+(my-assert
+ (upper-case-p #\A)
+ t)
+
+
+(my-assert
+ (upper-case-p #\a)
+ nil)
+
+
+(my-assert
+ (both-case-p #\a)
+ t)
+
+
+(my-assert
+ (both-case-p #\5)
+ nil)
+
+
+(my-assert
+ (lower-case-p #\5)
+ nil)
+
+
+(my-assert
+ (upper-case-p #\5)
+ nil)
+
+;;; char-code-limit
+
+
+(my-assert
+ (>= char-code-limit 96)
+ t)
+
+;;; char-name
+
+
+(my-assert
+ (char-name #\ )
+ "Space")
+
+
+(my-assert
+ (char-name #\Space)
+ "Space")
+
+
+(my-assert
+ (char-name #\Page)
+ "Page")
+
+
+(my-assert
+ (char-name #\a)
+ #+(or cmu sbcl ecls) nil
+ #+clisp "LATIN_SMALL_LETTER_A"
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+;; NIL OR "LOWERCASE-a" OR  "Small-A" OR  "LA01"
+
+
+(my-assert
+ (char-name #\A)
+ #+(or cmu sbcl ecls) nil
+ #+clisp "LATIN_CAPITAL_LETTER_A"
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+;;  NIL OR "UPPERCASE-A" OR  "Capital-A" OR  "LA02"
+
+;; Even though its CHAR-NAME can vary, #\A prints as #\A
+
+(my-assert
+ (prin1-to-string (read-from-string (format nil "#\\~A" (or (char-name #\A) "A"))))
+ "#\\A")
+
+;;; name-char
+
+
+(my-assert
+ (name-char 'space)
+ #\Space)
+
+
+(my-assert
+ (name-char "space")
+ #\Space)
+
+
+(my-assert
+ (name-char "Space")
+ #\Space)
+
+
+
+(my-assert
+ (let ((x (char-name #\a)))
+   (or (not x) (eql (name-char x) #\a)))
+ t)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/ansi-tests/section14.lisp b/src/ansi-tests/section14.lisp
new file mode 100644
index 000000000..076f7a803
--- /dev/null
+++ b/src/ansi-tests/section14.lisp
@@ -0,0 +1,1934 @@
+;;; section 14 conses -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+;;; cons
+
+(my-assert
+ (cons 1 2)
+ (1 . 2))
+
+(my-assert
+ (cons 1 nil)
+ (1))
+
+(my-assert
+ (cons nil 2)
+ (NIL . 2))
+
+(my-assert
+ (cons nil nil)
+ (NIL))
+
+(my-assert
+ (cons 1 (cons 2 (cons 3 (cons 4 nil))))
+ (1 2 3 4))
+
+(my-assert
+ (cons 'a 'b)
+ (A . B))
+
+(my-assert
+ (cons 'a (cons 'b (cons 'c '())))
+ (A B C))
+
+(my-assert
+ (cons 'a (list 'b 'c 'd))
+ (A B C D))
+
+
+;;; consp
+
+(my-assert
+ (consp nil)
+ nil)
+
+(my-assert
+ (consp (cons 1 2))
+ t)
+
+(my-assert
+ (consp '())
+ nil)
+
+(my-assert
+ (consp 'nil)
+ nil)
+
+;;; atom
+
+(my-assert
+ (atom 'sss)
+ t)
+
+(my-assert
+ (atom (cons 1 2))
+ nil)
+
+(my-assert
+ (atom nil)
+ t)
+
+(my-assert
+ (atom '())
+ t)
+
+(my-assert
+ (atom 3)
+ t)
+
+;;; rplaca
+
+(my-assert
+ (defparameter *some-list* (list* 'one 'two 'three 'four))
+ *some-list*)
+
+(my-assert
+ *some-list*
+ (ONE TWO THREE . FOUR))
+
+(my-assert
+ (rplaca *some-list* 'uno)
+ (UNO TWO THREE . FOUR))
+
+(my-assert
+ *some-list*
+ (UNO TWO THREE . FOUR))
+
+(my-assert
+ (rplacd (last *some-list*) (list 'IV))
+ (THREE IV))
+
+(my-assert
+ *some-list*
+ (UNO TWO THREE IV))
+
+;;; copy-tree
+
+(my-assert
+ (let* ((object (list (cons 1 "one")
+		      (cons 2 (list 'a 'b 'c))))
+	(object-too object)
+	(copy-as-list (copy-list object))
+	(copy-as-alist (copy-alist object))
+	(copy-as-tree (copy-tree object)))
+   (list 
+    (eq object object-too) ;; T
+    (eq copy-as-tree object) ;; NIL
+    (eql copy-as-tree object) ;; NIL
+    (equal copy-as-tree object) ;; T
+    )
+   )
+ (t nil nil t))
+
+(my-assert
+  (let* ((object (list (cons 1 "one")
+		       (cons 2 (list 'a 'b 'c)))))
+    
+    (setf (first (cdr (second object))) "a"
+	  (car (second object)) "two"
+	  (car object) (cons 'one  1)))
+  (ONE . 1))
+
+(my-assert
+   (let* ((object (list (cons 1 "one")
+		       (cons 2 (list 'a 'b 'c)))))
+    
+    (setf (first (cdr (second object))) "a"
+	  (car (second object)) "two"
+	  (car object) (cons 'one  1))
+    object)
+   ((ONE . 1) ("two" "a" B C)))
+
+(my-assert
+  (let* ((object (list (cons 1 "one")
+		      (cons 2 (list 'a 'b 'c))))
+	 (object-too object))
+    (setf (first (cdr (second object))) "a"
+	  (car (second object)) "two"
+	  (car object) (cons 'one  1))
+    object-too)
+ ((ONE . 1) ("two" "a" B C)))
+
+(my-assert
+   (let* ((object (list (cons 1 "one")
+		      (cons 2 (list 'a 'b 'c))))
+	  (copy-as-list (copy-list object)))
+     (setf (first (cdr (second object))) "a"
+	   (car (second object)) "two"
+	   (car object) (cons 'one  1))
+     copy-as-list)
+   ((1 . "one") ("two" "a" B C)))
+
+(my-assert
+    (let* ((object (list (cons 1 "one")
+		      (cons 2 (list 'a 'b 'c))))
+		(copy-as-alist (copy-alist object)))
+    (setf (first (cdr (second object))) "a"
+	  (car (second object)) "two"
+	  (car object) (cons 'one  1))
+    copy-as-alist)
+ ((1 . "one") (2 "a" B C)))
+
+(my-assert
+ (let* ((object (list (cons 1 "one")
+		      (cons 2 (list 'a 'b 'c))))
+	(copy-as-tree (copy-tree object)))
+    (setf (first (cdr (second object))) "a"
+	  (car (second object)) "two"
+	  (car object) (cons 'one  1))
+    copy-as-tree)
+ ((1 . "one") (2 A B C)) )
+
+;;; sublis
+
+(my-assert
+ (sublis (list (cons 'x  100)
+	       (cons 'z 'zprime))
+	 (append (list 'plus 'x
+		       (list 'minus 'g 'z 'x 'p)
+		       4)
+		 'x))
+ (PLUS 100 (MINUS G ZPRIME 100 P) 4 . 100))
+
+(my-assert
+ (sublis (list (cons (list '+ 'x 'y)
+		     (list '- 'x 'y))
+	       (cons (list '- 'x 'y)
+		     (list '+ 'x 'y)))
+         (list '*
+	       (list '/
+		     (list '+ 'x 'y)
+		     (list '+ 'x 'p))
+	       (list '- 'x 'y))
+         :test #'equal)
+ (* (/ (- X Y) (+ X P)) (+ X Y)))
+
+(my-assert
+ (let ((tree1 (list 1
+		    (list 1 2)
+		    (list (list 1 2 3))
+		    (list (list (list 1 2 3 4))))))
+   tree1)
+ (1 (1 2) ((1 2 3)) (((1 2 3 4)))))
+
+(my-assert
+  (let ((tree1 (list 1
+		    (list 1 2)
+		    (list (list 1 2 3))
+		    (list (list (list 1 2 3 4))))))
+    (sublis (list (cons 3 "three"))
+	    tree1))
+ (1 (1 2) ((1 2 "three")) (((1 2 "three" 4)))))
+
+(my-assert
+ (let ((tree1 (list 1
+		    (list 1 2)
+		    (list (list 1 2 3))
+		    (list (list (list 1 2 3 4))))))
+   (sublis (list (cons t  "string"))
+	   (sublis (list (cons 1 "") (cons 4 44))
+		   tree1)
+	   :key #'stringp))
+ ("string" ("string" 2) (("string" 2 3)) ((("string" 2 3 44)))))
+
+(my-assert
+   (let ((tree1 (list 1
+		    (list 1 2)
+		    (list (list 1 2 3))
+		    (list (list (list 1 2 3 4))))))
+    (sublis (list (cons 3 "three"))
+	    tree1)
+    (sublis (list (cons t  "string"))
+	    (sublis (list (cons 1 "") (cons 4 44))
+		    tree1)
+	    :key #'stringp)
+    tree1)
+ (1 (1 2) ((1 2 3)) (((1 2 3 4)))))
+
+(my-assert
+ (let ((tree2 (list "one" (list "one" "two")
+		   (list (list "one" "Two" "three")))))
+   tree2)
+ ("one" ("one" "two") (("one" "Two" "three"))) )
+
+(my-assert
+ (let ((tree2 (list (string "one")
+		    (list (string "one")
+				(string "two"))
+		   (list (list (string "one")
+			       (string "Two")
+			       (string "three")
+			       )))))
+   (sublis (list (cons (copy-seq "two")
+		       2))
+	   tree2))
+ ("one" ("one" "two") (("one" "Two" "three"))))
+
+(my-assert
+  (let ((tree2 (list (string "one")
+		     (list (string "one")
+			   (string "two")
+			   )
+		   (list (list (string "one")
+			       (string "Two")
+			       (string "three")
+			       )))))
+   (sublis (list (cons (string "two")
+		       2))
+	   tree2)
+   tree2)
+ ("one" ("one" "two") (("one" "Two" "three"))) )
+
+(my-assert
+  (let ((tree2 (list "one" (list "one" "two")
+		   (list (list "one" "Two" "three")))))
+    (sublis (list (cons "two" 2)) tree2 :test 'equal))
+ ("one" ("one" 2) (("one" "Two" "three"))) )
+
+(my-assert
+ (let ((tree1 (list 1
+		    (list 1 2)
+		    (list (list 1 2 3))
+		    (list (list (list 1 2 3 4))))))
+   (nsublis (list (cons t '(quote temp)))
+	    tree1
+	    :key #'(lambda (x) (or (atom x) (< (list-length x) 3)))))
+ ((QUOTE TEMP) (QUOTE TEMP) QUOTE TEMP) )
+
+;;; subst
+
+(my-assert
+ (let  ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4))))
+   tree1)
+ (1 (1 2) (1 2 3) (1 2 3 4)))
+
+(my-assert
+  (let  ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4))))
+    (subst "two" 2 tree1))
+ (1 (1 "two") (1 "two" 3) (1 "two" 3 4)))
+
+(my-assert
+  (let  ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4))))
+    (subst "five" 5 tree1))
+ (1 (1 2) (1 2 3) (1 2 3 4)))
+
+(my-assert
+  (let  ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4))))
+    (eq tree1 (subst "five" 5 tree1)))
+  #+(or sbcl cmu sbcl clisp) T
+  #+ecls nil
+  #-(or sbcl cmu sbcl clisp ecls) fill-this-in)
+
+(my-assert
+ (subst 'tempest 'hurricane
+	(list 'shakespeare 'wrote (list 'the 'hurricane)))
+ (SHAKESPEARE WROTE (THE TEMPEST)))
+
+(my-assert
+ (subst 'foo 'nil (list 'shakespeare 'wrote (list 'twelfth 'night)))
+ (SHAKESPEARE WROTE (TWELFTH NIGHT . FOO) . FOO))
+
+(my-assert
+ (subst (cons 'a 'cons)
+	(cons 'old 'pair)
+	(list (cons 'old 'spice)
+	      (append (list (cons 'old 'shoes) 'old)
+		      'pair)
+	      (cons 'old 'pair))
+	:test #'equal)
+ ((OLD . SPICE) ((OLD . SHOES) A . CONS) (A . CONS)))
+
+(my-assert
+ (let  ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4))))
+   (subst-if 5 #'listp tree1))
+ 5)
+
+(subst-if-not (list 'x)
+	      #'consp
+	      (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4)))
+
+(my-assert
+  (let  ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4))))
+    (subst-if-not (list 'x) #'consp tree1))
+					;(1 (X))
+ ((X) ((X) (X) X) ((X) (X) (X) X) ((X) (X) (X) (X) X) X))
+
+(my-assert
+ (let  ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4))))
+   (subst-if-not (list 'x) #'consp tree1)
+   tree1)
+ (1 (1 2) (1 2 3) (1 2 3 4)))
+
+(my-assert
+ (let  ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4))))
+   (nsubst 'x 3 tree1 :key #'(lambda (y) (and (listp y) (third y)))))
+ (1 (1 2) X X))
+
+(my-assert
+  (let  ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4))))
+   (nsubst 'x 3 tree1 :key #'(lambda (y) (and (listp y) (third y))))
+   tree1)
+ (1 (1 2) X X))
+
+;;; tree-equal
+
+(my-assert
+ (let ((tree1 (list 1 (list 1 2)))
+       (tree2 (list 1 (list 1 2))))
+   tree2)
+ (1 (1 2)))
+
+(my-assert
+ (let ((tree1 (list 1 (list 1 2)))
+       (tree2 (list 1 (list 1 2)))) 
+   (tree-equal tree1 tree2))
+ t)
+
+(my-assert
+ (let ((tree1 (list 1 (list 1 2)))
+       (tree2 (list 1 (list 1 2)))) 
+   (eql tree1 tree2))
+ nil)
+
+(my-assert 
+ (let ((tree1 (list ''a (list ''b ''c)))
+       (tree2 (list ''a (list ''b ''c))))
+   tree2)
+ ('a ('b 'c)) )
+
+(my-assert
+  (let ((tree1 (list ''a (list ''b ''c)))
+       (tree2 (list ''a (list ''b ''c))))
+    (tree-equal tree1 tree2 :test 'eq))
+ t)
+
+;;; copy-list
+
+(my-assert
+ (let ((lst (list 1 (list 2 3))))
+   lst)
+ (1 (2 3)))
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst))
+    slst)
+ (1 (2 3)))
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+    clst)
+ (1 (2 3)))
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (eq slst lst))
+ t)
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (eq clst lst))
+ nil)
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (equal clst lst))
+ t)
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (rplaca lst "one"))
+ ("one" (2 3)))
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (rplaca lst "one")
+   slst)
+ ("one" (2 3)))
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (rplaca lst "one")  
+   clst)
+ (1 (2 3)))
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (rplaca lst "one")  
+   (setf (caadr lst) "two"))
+ "two")
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (rplaca lst "one")  
+   (setf (caadr lst) "two")
+   lst)
+ ("one" ("two" 3)))
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (rplaca lst "one")  
+   (setf (caadr lst) "two")
+   slst)
+ ("one" ("two" 3)))
+
+(my-assert
+ (let* ((lst (list 1 (list 2 3)))
+	(slst lst)
+	(clst (copy-list lst)))
+   (rplaca lst "one")  
+   (setf (caadr lst) "two")
+   clst)
+ (1 ("two" 3)))
+
+;;; list list*
+
+(my-assert
+ (list 1)
+ (1))
+
+(my-assert
+ (list* 1)
+ 1)
+
+(my-assert
+ (let (( a 1))
+   a)
+ 1)
+
+(my-assert
+ (let (( a 1))
+   (list a 2))
+ (1 2))
+
+(my-assert
+ (let (( a 1))
+   (list 'a '2))
+ (A 2))
+
+(my-assert
+ (let (( a 1))
+   (list 'a 2))
+ (A 2))
+
+(my-assert
+  (let (( a 1))
+    (list* a 2))
+ (1 . 2))
+
+(my-assert
+ (list)
+ NIL)
+
+(my-assert
+ (let ((a (list 1 2)))
+   a)
+ (1 2))
+
+(my-assert
+ (let ((a (list 1 2)))
+   (eq a (list* a)))
+ t)
+
+(my-assert
+ (let ((a (list 1 2)))
+   (list 3 4 'a (car (cons 'b 'c)) (+ 6 -2)))
+ (3 4 A B 4))
+
+(my-assert
+ (let ((a (list 1 2)))
+   (list* 'a 'b 'c 'd))
+ (A B C . D))
+
+(my-assert
+ (cons 'a (cons 'b (cons 'c 'd)))
+ (A B C . D))
+
+(my-assert
+ (list* 'a 'b 'c (list 'd 'e 'f))
+ (A B C D E F))
+
+;;; list-length
+
+(my-assert
+ (list-length (list 'a 'b 'c 'd))
+ 4)
+
+(my-assert
+ (list-length (list 'a (list 'b 'c) 'd))
+ 3)
+
+(my-assert
+ (list-length '())
+ 0)
+
+(my-assert
+ (list-length nil)
+ 0)
+
+(my-assert
+ (defun circular-list (&rest elements)
+   (let ((cycle (copy-list elements)))
+     (nconc cycle cycle)))
+ CIRCULAR-LIST)
+
+(my-assert
+ (list-length (circular-list 'a 'b))
+ NIL)
+
+(my-assert
+ (list-length (circular-list 'a))
+ NIL)
+
+(my-assert
+ (list-length (circular-list))
+ 0)
+
+;;; listp
+
+(my-assert
+ (listp nil)
+ t)
+
+(my-assert
+ (listp (cons 1 2))
+ t)
+
+(my-assert
+ (listp (make-array 6))
+ nil)
+
+(my-assert
+ (listp t)
+ nil)
+
+;;; make-list
+
+(my-assert
+ (make-list 5)
+ (NIL NIL NIL NIL NIL))
+
+(my-assert
+ (make-list 3 :initial-element 'rah)
+ (RAH RAH RAH))
+
+(my-assert
+ (make-list 2 :initial-element (list 1 2 3))
+ ((1 2 3) (1 2 3)))
+
+(my-assert
+ (make-list 0)
+ NIL)					;i.e.,  ())
+
+(my-assert
+ (make-list 0 :initial-element 'new-element)
+ NIL )
+
+;;; push
+
+(my-assert
+ (let ((llst (list nil)))
+   llst)
+ (NIL))
+
+(my-assert
+ (let ((llst (list nil)))
+   (push 1 (car llst)))
+ (1))
+
+(my-assert
+ (let ((llst (list nil)))
+   (push 1 (car llst))
+   llst)
+ ((1)))
+
+(my-assert
+ (let ((llst (list nil)))
+   (push 1 (car llst))
+   (push 1 (car llst)))
+ (1 1))
+
+(my-assert
+ (let ((llst (list nil)))
+   (push 1 (car llst))
+   (push 1 (car llst))
+   llst)
+ ((1 1)))
+
+(my-assert
+ (let ((x (list 'a
+		 (list 'b 'c)
+		 'd)))
+   x)
+ (A (B C) D))
+
+(my-assert
+ (let ((x (list 'a
+		(list 'b 'c)
+		'd)))
+   (push 5 (cadr x)))
+ (5 B C)  )
+
+(my-assert
+ (let ((x (list 'a
+		(list 'b 'c)
+		'd)))
+   (push 5 (cadr x))
+   x)
+ (A (5 B C) D))
+
+;;; pop
+
+(my-assert
+ (let ((stack (list 'a 'b 'c)))
+   stack)
+ (A B C))
+
+(my-assert
+  (let ((stack (list 'a 'b 'c)))
+    (pop stack))
+ A)
+
+(my-assert
+  (let ((stack (list 'a 'b 'c)))
+    (pop stack)
+    stack)
+ (B C))
+
+(my-assert
+ (let ((llst (list (list 1 2 3 4))))
+   llst)
+ ((1 2 3 4)))
+
+(my-assert
+  (let ((llst (list (list 1 2 3 4))))
+    (pop (car llst)))
+ 1)
+
+(my-assert
+  (let ((llst (list (list 1 2 3 4))))
+    (pop (car llst))
+    llst)
+ ((2 3 4)))
+
+;;; nth
+
+(my-assert
+ (nth 0 (list 'foo 'bar 'baz))
+ FOO)
+
+(my-assert
+ (nth 1 (list 'foo 'bar 'baz))
+ BAR)
+
+(my-assert
+ (nth 3 (list 'foo 'bar 'baz))
+ NIL)
+
+(my-assert
+ (let ((0-to-3 (list 0 1 2 3)))
+   0-to-3)
+ (0 1 2 3))
+
+(my-assert
+  (let ((0-to-3 (list 0 1 2 3)))
+    (setf (nth 2 0-to-3) "two"))
+ "two")
+
+(my-assert
+  (let ((0-to-3 (list 0 1 2 3)))
+    (setf (nth 2 0-to-3) "two")
+    0-to-3)
+ (0 1 "two" 3))
+
+;;; endp
+
+(my-assert
+ (endp nil)
+ t)
+
+(my-assert
+ (endp (list 1 2))
+ nil)
+
+(my-assert
+ (endp (cddr (list 1 2)))
+ t)
+
+;;; null
+
+(my-assert
+ (null '())
+ T)
+
+(my-assert
+ (null nil)
+ T)
+
+(my-assert
+ (null t)
+ NIL)
+
+(my-assert
+ (null 1)
+ NIL)
+
+;;; nconc
+
+(my-assert
+ (nconc)
+ NIL)
+
+(my-assert
+ (setq x (list 'a 'b 'c))
+ (A B C))
+
+(my-assert
+ (setq y (list 'd 'e 'f))
+ (D E F))
+
+(my-assert
+ (nconc x y)
+ (A B C D E F))
+
+(my-assert
+ x
+ (A B C D E F))
+
+(my-assert
+ (setq foo (list 'a 'b 'c 'd 'e)
+       bar (list 'f 'g 'h 'i 'j)
+       baz (list 'k 'l 'm))
+ (K L M))
+
+(my-assert
+ (setq foo (nconc foo bar baz))
+ (A B C D E F G H I J K L M))
+
+(my-assert
+ foo
+ (A B C D E F G H I J K L M))
+
+(my-assert
+ bar
+ (F G H I J K L M))
+
+(my-assert
+ baz
+ (K L M))
+
+(my-assert
+ (setq foo (list 'a 'b 'c 'd 'e)
+       bar (list 'f 'g 'h 'i 'j)
+       baz (list 'k 'l 'm))
+ (K L M))
+
+(my-assert
+ (setq foo (nconc nil foo bar nil baz))
+ (A B C D E F G H I J K L M) )
+
+(my-assert
+ foo
+ (A B C D E F G H I J K L M))
+
+(my-assert
+ bar
+ (F G H I J K L M))
+
+(my-assert
+ baz
+ (K L M))
+
+;;; append
+
+(my-assert
+ (append (list 'a 'b 'c)
+	 (list 'd 'e 'f)
+	 '()
+	 (list 'g))
+ (A B C D E F G))
+
+(my-assert
+ (append (list 'a 'b 'c)
+	 'd)
+ (A B C . D))
+
+(my-assert
+ (setq lst (list 'a 'b 'c))
+ (A B C))
+
+(my-assert
+ (append lst (list 'd))
+ (A B C D))
+
+(my-assert
+ lst
+ (A B C))
+
+(my-assert
+ (append)
+ NIL)
+
+(my-assert
+ (append 'a)
+ A)
+
+;;; revappend
+
+(my-assert
+ (let ((list-1 (list 1 2 3))
+       (list-2 (list 'a 'b 'c)))
+   (list (revappend list-1 list-2)
+	 (equal list-1 (list 1 2 3))
+	 (equal list-2 (list 'a 'b 'c))))
+ ((3 2 1 A B C)  T  T))
+
+
+(my-assert
+ (revappend (list 1 2 3) '())
+ (3 2 1))
+
+(my-assert
+ (revappend (list 1 2 3)
+	    (cons 'a 'b))
+ (3 2 1 A . B))
+
+(my-assert
+ (revappend '()
+	    (list 'a 'b 'c))
+ (A B C))
+
+(my-assert
+ (revappend (list 1 2 3)
+	    'a)
+ (3 2 1 . A))
+
+(my-assert
+ (revappend '() 'a)
+ A )					;degenerate case)
+
+(my-assert
+ (let ((list-1 (copy-list (list 1 2 3)))
+       (list-2 (list 'a 'b 'c)))
+   (list (nreconc list-1 list-2)
+	 (equal list-1 (list 1 2 3))
+	 (equal list-2 (list 'a 'b 'c))))
+ ((3 2 1 A B C) NIL T))
+
+
+;;; butlast
+
+(my-assert
+ (setq lst (list 1 2 3 4 5 6 7 8 9))
+ (1 2 3 4 5 6 7 8 9))
+
+(my-assert
+ (butlast lst)
+ (1 2 3 4 5 6 7 8))
+
+(my-assert
+ (butlast lst 5)
+ (1 2 3 4))
+
+(my-assert
+ (butlast lst (+ 5 5))
+ NIL)
+
+(my-assert
+ lst
+ (1 2 3 4 5 6 7 8 9))
+
+(my-assert
+ (nbutlast lst 3)
+ (1 2 3 4 5 6))
+
+(my-assert
+ lst
+ (1 2 3 4 5 6))
+
+(my-assert
+ (nbutlast lst 99)
+ NIL)
+
+(my-assert
+ lst
+ (1 2 3 4 5 6))
+
+(my-assert
+ (butlast (list 'a 'b 'c 'd))
+ (A B C))
+
+(my-assert
+ (butlast (list (list 'a 'b)
+		(list 'c 'd)))
+ ((A B)))
+
+(my-assert
+ (butlast (list 'a))
+ NIL)
+
+(my-assert
+ (butlast nil)
+ NIL)
+
+(my-assert
+ (setq foo (list 'a 'b 'c 'd))
+ (A B C D))
+
+(my-assert
+ (nbutlast foo)
+ (A B C))
+
+(my-assert
+ foo
+ (A B C))
+
+(my-assert
+ (nbutlast (list 'a))
+ NIL)
+
+(my-assert
+ (nbutlast '())
+ NIL)
+
+;;; last
+
+(my-assert
+ (last nil)
+ NIL)
+
+(my-assert
+ (last (list 1 2 3))
+ (3))
+
+(my-assert
+ (last (append (list 1 2)
+	       3))
+ (2 . 3))
+
+(my-assert
+ (setq x (list 'a 'b 'c 'd))
+ (A B C D))
+
+(my-assert
+ (last x)
+ (D))
+
+(my-assert
+ (progn
+   (rplacd (last x) (list 'e 'f))
+   t)
+ t)
+
+(my-assert
+ x
+ (A B C D E F))
+
+(my-assert
+ (last x)
+ (F))
+
+(my-assert
+ (last (list 'a 'b 'c))
+ (C))
+
+(my-assert
+ (last (list 'a 'b 'c) 0)
+ ())
+
+(my-assert
+ (last (list 'a 'b 'c) 1)
+ (C))
+
+(my-assert
+ (last (list 'a 'b 'c) 2)
+ (B C))
+
+(my-assert
+ (last (list 'a 'b 'c) 3)
+ (A B C))
+
+(my-assert
+ (last (list 'a 'b 'c) 4)
+ (A B C))
+
+(my-assert
+ (last (cons 'a 'b) 0)
+ B)
+
+(my-assert
+ (last (cons 'a 'b) 1)
+ (A . B))
+
+(my-assert
+ (last (cons 'a 'b) 2)
+ (A . B))
+
+;;; nthcdr
+
+(my-assert
+ (nthcdr 0 '())
+ NIL)
+
+(my-assert
+ (nthcdr 3 '())
+ NIL)
+
+(my-assert
+ (nthcdr 0 (list 'a 'b 'c))
+ (A B C))
+
+(my-assert
+ (nthcdr 2 (list 'a 'b 'c))
+ (C))
+
+(my-assert
+ (nthcdr 4 (list 'a 'b 'c))
+ ())
+
+(my-assert
+ (nthcdr 1 (cons 0 1))
+ 1)
+
+(my-assert
+ (locally (declare (optimize (safety 3)))
+	  (nthcdr 3 (cons 0 1)))
+ TYPE-ERROR)
+
+;;; rest
+
+(my-assert
+ (rest (list 1 2))
+ (2))
+
+(my-assert
+ (rest (cons 1 2))
+ 2)
+
+(my-assert
+ (rest (list 1))
+ NIL)
+
+(my-assert
+ (setq *cons* (cons 1 2))
+ (1 . 2))
+
+(my-assert
+ (setf (rest *cons*) "two")
+ "two")
+
+(my-assert
+ *cons*
+ (1 . "two"))
+
+;;; member
+
+(my-assert
+ (member 2 (list 1 2 3))
+ (2 3))
+
+(my-assert
+ (member 2 (list (cons 1 2)
+		 (cons 3 4))
+	 :test-not #'=
+	 :key #'cdr)
+ ((3 . 4)))
+
+(my-assert
+ (member 'e (list 'a 'b 'c 'd))
+ NIL)
+
+(my-assert
+ (member-if #'listp (list 'a 'b nil 'c 'd))
+ (NIL C D))
+
+(my-assert
+ (member-if #'numberp (list 'a #\Space 5/3 'foo))
+ (5/3 FOO))
+
+(my-assert
+ (member-if-not #'zerop
+		(append (list 3 6 9 11)
+			12)
+		:key #'(lambda (x) (mod x 3)))
+ (11 . 12))
+
+;;; mapc and co
+
+(my-assert
+ (mapcar #'car (list (list 1 'a)
+		     (list 2 'b)
+		     (list 3 'c)))
+ (1 2 3) )
+
+(my-assert
+ (mapcar #'abs (list 3 -4 2 -5 -6))
+ (3 4 2 5 6))
+
+(my-assert
+ (mapcar #'cons (list 'a 'b 'c) (list 1 2 3))
+ ((A . 1) (B . 2) (C . 3)))
+
+(my-assert
+ (maplist #'append (list 1 2 3 4) (list 1 2) (list 1 2 3))
+ ((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3)))
+
+(my-assert
+ (maplist #'(lambda (x) (cons 'foo x)) (list 'a 'b 'c 'd))
+ ((FOO A B C D) (FOO B C D) (FOO C D) (FOO D)))
+
+(my-assert
+ (maplist #'(lambda (x) (if (member (car x) (cdr x)) 0 1))
+	  (list 'a 'b 'a 'c 'd 'b 'c))
+ (0 0 1 0 1 1 1))
+
+(my-assert
+ (setq dummy nil)
+ NIL )
+
+(my-assert
+ (mapc #'(lambda (&rest x) (setq dummy (append dummy x)))
+       (list 1 2 3 4)
+       (list 'a 'b 'c 'd 'e)
+       (list 'x 'y 'z))
+ (1 2 3 4) )
+
+(my-assert
+ dummy
+ (1 A X 2 B Y 3 C Z)                   )
+
+(my-assert
+ (setq dummy nil)
+ NIL )
+
+(my-assert
+ (mapl #'(lambda (x) (push x dummy))
+       (list 1 2 3 4))
+ (1 2 3 4) )
+
+(my-assert
+ dummy
+ ((4) (3 4) (2 3 4) (1 2 3 4)) )
+
+(my-assert
+ (mapcan #'(lambda (x y) (if (null x) nil (list x y)))
+	 (list nil nil nil 'd 'e)
+	 (list 1 2 3 4 5 6))
+ (D 4 E 5) )
+
+(my-assert
+ (mapcan #'(lambda (x) (and (numberp x) (list x)))
+	 (list 'a 1 'b 'c 3 4 'd 5))
+ (1 3 4 5))
+
+(my-assert
+ (mapcon #'list (list 1 2 3 4))
+ ((1 2 3 4) (2 3 4) (3 4) (4)) )
+
+
+;;; acons
+
+(my-assert
+ (setq alist '())
+ NIL)
+
+(my-assert
+ (acons 1 "one" alist)
+ ((1 . "one")))
+
+(my-assert
+ alist
+ NIL)
+
+(my-assert
+ (setq alist (acons 1 "one" (acons 2 "two" alist)))
+ ((1 . "one") (2 . "two")))
+
+(my-assert
+ (assoc 1 alist)
+ (1 . "one"))
+
+(my-assert
+ (setq alist (acons 1 "uno" alist))
+ ((1 . "uno") (1 . "one") (2 . "two")))
+
+(my-assert
+ (assoc 1 alist)
+ (1 . "uno"))
+
+;;; assoc
+
+(my-assert
+ (setq values
+       (list (cons 'x 100)
+	     (cons 'y 200)
+	     (cons 'z 50)))
+ ((X . 100) (Y . 200) (Z . 50)))
+
+(my-assert
+ (assoc 'y values)
+ (Y . 200))
+
+(my-assert
+ (rplacd (assoc 'y values) 201)
+ (Y . 201))
+
+(my-assert
+ (assoc 'y values)
+ (Y . 201))
+
+(my-assert
+ (setq alist
+       (list (cons 1 "one")
+	     (cons 2 "two")
+	     (cons 3 "three")))
+ ((1 . "one") (2 . "two") (3 . "three")))
+
+(my-assert
+ (assoc 2 alist)
+ (2 . "two"))
+
+(my-assert
+ (assoc-if #'evenp alist)
+ (2 . "two"))
+
+(my-assert
+ (assoc-if-not #'(lambda(x) (< x 3)) alist)
+ (3 . "three"))
+
+(my-assert
+ (setq alist (list (cons "one" 1)
+		   (cons "two" 2)))
+ (("one" . 1) ("two" . 2)))
+
+(my-assert
+ (assoc "one" alist)
+ NIL)
+
+(my-assert
+ (assoc "one" alist :test #'equalp)
+ ("one" . 1))
+
+(my-assert
+ (assoc "two" alist :key #'(lambda(x) (char x 2)))
+ NIL )
+
+(my-assert
+ (assoc #\o alist :key #'(lambda(x) (char x 2)))
+ ("two" . 2))
+
+(my-assert
+ (assoc 'r (list (cons 'a 'b)
+		 (cons 'c 'd)
+		 (cons 'r 'x)
+		 (cons 's 'y)
+		 (cons 'r 'z)))
+ (R . X))
+
+(my-assert
+ (assoc 'goo (list (cons 'foo 'bar)
+		   (cons 'zoo 'goo)))
+ NIL)
+
+(my-assert
+ (assoc '2 (list (list 1 'a 'b 'c)
+		 (list 2 'b 'c 'd)
+		 (list -7 'x 'y 'z)))
+ (2 B C D))
+
+(my-assert
+ (setq alist (list (cons "one" 1)
+		   (cons "2" 2)
+		   (cons "three" 3)))
+ (("one" . 1) ("2" . 2) ("three" . 3)))
+
+(my-assert
+ (assoc-if-not #'alpha-char-p alist
+	       :key #'(lambda (x) (char x 0)))
+ ("2" . 2))
+
+;;; copy-alist
+
+(my-assert
+ (progn
+   (defparameter *alist* (acons 1 "one" (acons 2 "two" '())))
+   t)
+ t)
+
+(my-assert
+ *alist*
+ ((1 . "one") (2 . "two")))
+
+(my-assert
+ (progn
+   (defparameter *list-copy* (copy-list *alist*))
+   t)
+ t)
+
+(my-assert
+ *list-copy*
+ ((1 . "one") (2 . "two")))
+
+(my-assert
+ (progn
+   (defparameter *alist-copy* (copy-alist *alist*))
+   t)
+ t)
+
+(my-assert
+ *alist-copy*
+ ((1 . "one") (2 . "two")))
+
+(my-assert
+ (setf (cdr (assoc 2 *alist-copy*)) "deux")
+ "deux")
+
+(my-assert
+ *alist-copy*
+ ((1 . "one") (2 . "deux")))
+
+(my-assert
+ *alist*
+ ((1 . "one") (2 . "two")))
+
+(my-assert
+ (setf (cdr (assoc 1 *list-copy*)) "uno")
+ "uno")
+
+(my-assert
+ *list-copy*
+ ((1 . "uno") (2 . "two")))
+
+(my-assert
+ *alist*
+ ((1 . "uno") (2 . "two")))
+
+;;; pairlis
+
+(my-assert
+ (setq keys (list 1 2 3)
+       data (list "one" "two" "three")
+       alist (list (cons 4 "four")))
+ ((4 . "four")))
+
+(my-assert
+ (pairlis keys data)
+ ((3 . "three") (2 . "two") (1 . "one")))
+
+(my-assert
+ (pairlis keys data alist)
+ ((3 . "three") (2 . "two") (1 . "one") (4 . "four")))
+
+(my-assert
+ alist
+ ((4 . "four")))
+
+;;; rassoc
+
+(my-assert
+ (setq alist (list (cons 1 "one")
+		   (cons 2 "two")
+		   (cons 3 3)))
+ ((1 . "one") (2 . "two") (3 . 3)))
+
+(my-assert
+ (rassoc 3 alist)
+ (3 . 3))
+
+(my-assert
+ (rassoc "two" alist)
+ NIL)
+
+(my-assert
+ (rassoc "two" alist :test 'equal)
+ (2 . "two"))
+
+(my-assert
+ (rassoc 1 alist :key #'(lambda (x) (if (numberp x) (/ x 3))))
+ (3 . 3))
+
+(my-assert
+ (rassoc 'a
+	 (list (cons 'a 'b)
+	       (cons 'b 'c)
+	       (cons 'c 'a)
+	       (cons 'z 'a)))
+ (C . A))
+
+(my-assert
+ (rassoc-if #'stringp alist)
+ (1 . "one"))
+
+(my-assert
+ (rassoc-if-not #'vectorp alist)
+ (3 . 3))
+
+;;; get-properties
+
+(my-assert
+ (setq x '())
+ NIL)
+
+(my-assert
+ (setq *indicator-list* (list 'prop1 'prop2))
+ (PROP1 PROP2))
+
+(my-assert
+ (getf x 'prop1)
+ NIL)
+
+(my-assert
+ (setf (getf x 'prop1) 'val1)
+ VAL1)
+
+(my-assert
+ (eq (getf x 'prop1) 'val1)
+ t)
+
+(my-assert
+ (multiple-value-bind (a b c)
+     (get-properties x *indicator-list*)
+   (list a b c))
+ (PROP1  VAL1 (PROP1 VAL1)))
+
+(my-assert
+ x
+ (PROP1 VAL1))
+
+;;; getf
+
+(my-assert
+ (setq x '())
+ NIL)
+
+(my-assert
+ (getf x 'prop1)
+ NIL)
+
+(my-assert
+ (getf x 'prop1 7)
+ 7)
+
+(my-assert
+ (getf x 'prop1)
+ NIL)
+
+(my-assert
+ (setf (getf x 'prop1) 'val1)
+ VAL1)
+
+(my-assert
+ (eq (getf x 'prop1) 'val1)
+ t)
+
+(my-assert
+ (getf x 'prop1)
+ VAL1)
+
+(my-assert
+ (getf x 'prop1 7)
+ VAL1)
+
+(my-assert
+ x
+ (PROP1 VAL1))
+
+;;; remf
+
+(my-assert
+ (setq x (cons () ()))
+ (NIL))
+
+(my-assert
+ (setf (getf (car x) 'prop1) 'val1)
+ VAL1)
+
+(my-assert
+ (remf (car x) 'prop1)
+ t)
+
+(my-assert
+ (remf (car x) 'prop1)
+ nil)
+
+;;; intersection
+
+(my-assert
+ (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" (string #\B) "C" "d"))
+       (list2 (list 1 4 5 'b 'c 'd "a" (string #\B) "c" "D")))
+   (intersection list1 list2))
+ #-clisp
+ (C B 4 1 1)
+ #+clisp
+ (1 1 4 B C))
+
+(my-assert
+ (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" (string #\B) "C" "d"))
+       (list2 (list 1 4 5 'b 'c 'd "a" (string #\B) "c" "D")))
+   (intersection list1 list2 :test 'equal))
+ #-clisp
+ ("B" C B 4 1 1)
+ #+clisp
+ (1 1 4 B C "B"))
+
+(my-assert
+ (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
+       (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
+   (intersection list1 list2 :test #'equalp))
+  #-clisp
+  ("d" "C" "B" "A" C B 4 1 1)
+  #+clisp
+  (1 1 4 B C "A" "B" "C" "d"))
+
+(my-assert
+ (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
+       (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
+   (nintersection list1 list2))
+ #-clisp
+ (C B 4 1 1)
+ #+clisp
+ (1 1 4 B C))
+					;(1 1 4 B C))
+
+(my-assert
+  (let ((list1 (copy-list (list (cons 1 2)
+				 (cons 2 3)
+				 (cons 3 4)
+			      (cons 4 5))))
+	(list2 (copy-list (list (cons 1 3)
+			      (cons 2 4)
+			      (cons 3 6)
+			      (cons 4 8)))))
+    (nintersection list1 list2 :key #'cdr))
+ #+(or sbcl cmu) ((3 . 4) (2 . 3))
+ #-(or sbcl cmu) ((2 . 3) (3 . 4)) )
+
+;;; adjoin
+
+(my-assert
+ (setq slist '())
+ NIL )
+
+(my-assert
+ (adjoin 'a slist)
+ (A) )
+
+(my-assert
+ slist
+ NIL )
+
+(my-assert
+ (setq slist (adjoin (list 'test-item
+			   '1)
+		     slist))
+ ((TEST-ITEM 1)) )
+
+(my-assert
+ (adjoin (list 'test-item 1)
+	 slist)
+ ((TEST-ITEM 1) (TEST-ITEM 1)) )
+
+(my-assert
+ (adjoin (list 'test-item 1)
+	 slist
+	 :test 'equal)
+ ((TEST-ITEM 1)) )
+
+(my-assert
+ (adjoin (list 'new-test-item 1)
+	 slist
+	 :key #'cadr)
+ ((TEST-ITEM 1)) )
+
+(my-assert
+ (adjoin (list 'new-test-item 1)
+	 slist)
+ ((NEW-TEST-ITEM 1) (TEST-ITEM 1)) )
+
+;;; pushnew
+
+(my-assert
+ (setq x (list 'a (list 'b 'c) 'd))
+ (A (B C) D))
+
+(my-assert
+ (pushnew 5 (cadr x))
+ (5 B C)   )
+
+(my-assert
+ x
+ (A (5 B C) D))
+
+(my-assert
+ (pushnew 'b (cadr x))
+ (5 B C)  )
+
+(my-assert
+ x
+ (A (5 B C) D))
+
+(my-assert
+ (setq lst (list (list 1)
+		 (list 1 2)
+		 (list 1 2 3)))
+ ((1) (1 2) (1 2 3)))
+
+(my-assert
+ (pushnew (list 2) lst)
+ ((2) (1) (1 2) (1 2 3)))
+
+(my-assert
+ (pushnew (list 1) lst)
+ ((1) (2) (1) (1 2) (1 2 3)))
+
+(my-assert
+ (pushnew (list 1) lst :test 'equal)
+ ((1) (2) (1) (1 2) (1 2 3)))
+
+(my-assert
+ (pushnew (list 1) lst :key #'car)
+ ((1) (2) (1) (1 2) (1 2 3)) )
+
+;;; set-difference
+
+(my-assert
+ (let ((lst1 (mapcar #'string (list #\A #\b #\C #\d)))
+       (lst2 (mapcar #'string (list #\a #\B #\C #\d))))
+      (set-difference lst1 lst2))
+ #-clisp
+ ("d" "C" "b" "A")
+ #+clisp
+ ("A" "b" "C" "d"))
+
+(my-assert
+ (let ((lst1 (list "A" "b" "C" "d"))
+       (lst2 (list "a" "B" "C" "d")))
+    (set-difference lst1 lst2 :test 'equal))
+ #-clisp
+ ("b" "A")
+ #+clisp
+ ("A" "b"))
+
+(my-assert
+  (let ((lst1 (list "A" "b" "C" "d"))
+       (lst2 (list "a" "B" "C" "d")))
+    (set-difference lst1 lst2 :test #'equalp))
+ NIL )
+
+(my-assert
+  (let ((lst1 (list "A" "b" "C" "d"))
+       (lst2 (list "a" "B" "C" "d")))
+    (nset-difference lst1 lst2 :test #'string=))
+ #+(or sbcl cmu)
+ ("b" "A")
+ #-(or sbcl cmu)
+ ("A" "b"))
+
+(my-assert
+ (let ((lst1 (list (cons "a" "b")
+		   (cons "c" "d")
+		   (cons "e" "f")))
+       (lst2 (list (cons "c" "a")
+		   (cons "e" "b")
+		   (cons "d" "a"))))
+   (nset-difference lst1 lst2 :test #'string= :key #'cdr))
+ #+(or sbcl cmu)
+ (("e" . "f") ("c" . "d"))
+ #-(or sbcl cmu)
+ (("c" . "d") ("e" . "f")))
+
+(my-assert
+  (let ((lst1 (list (cons "a" "b")
+		   (cons "c" "d")
+		   (cons "e" "f")))
+       (lst2 (list (cons "c" "a")
+		   (cons "e" "b")
+		   (cons "d" "a"))))
+   (nset-difference lst1 lst2 :test #'string= :key #'cdr)
+   lst1)
+ #+(or sbcl cmu) (("a" . "b") ("c" . "d"))
+ #-(or sbcl cmu) (("a" . "b") ("c" . "d") ("e" . "f")) )
+
+
+(my-assert
+  (let ((lst1 (list (cons "a" "b")
+		   (cons "c" "d")
+		   (cons "e" "f")))
+       (lst2 (list (cons "c" "a")
+		   (cons "e" "b")
+		   (cons "d" "a"))))
+   (nset-difference lst1 lst2 :test #'string= :key #'cdr)
+   lst2)
+ (("c" . "a") ("e" . "b") ("d" . "a")) )
+
+;; Remove all flavor names that contain "c" or "w".
+(my-assert
+ (set-difference (list
+		  "strawberry" "chocolate" "banana"
+		  "lemon" "pistachio" "rhubarb")
+		 '(#\c #\w)
+		 :test #'(lambda (s c) (find c s)))
+ #+(or sbcl cmu) ("rhubarb" "lemon" "banana")
+ #+clisp ("banana" "lemon" "rhubarb")
+ #-(or sbcl cmu sbcl clisp) ("banana" "rhubarb" "lemon"))
+;;One possible ordering.)
+
+;;; set-exclusive-or
+
+(my-assert
+ (let ((lst1 (list 1 (string #\a) (string #\b)))
+       (lst2 (list 1 (string #\A) (string #\b))))
+   (set-exclusive-or lst1 lst2))
+  #-clisp
+  ("b" "A" "b" "a")
+  #+clisp
+  ("a" "b" "A" "b"))
+
+(my-assert
+ (let ((lst1 (list 1 (string #\a) (string #\b)))
+       (lst2 (list 1 (string #\A) (string #\b))))
+    (set-exclusive-or lst1 lst2 :test #'equal))
+ ("A" "a"))
+
+(my-assert
+ (let ((lst1 (list 1 (string #\a) (string #\b)))
+       (lst2 (list 1 (string #\A) (string #\b))))
+    (set-exclusive-or lst1 lst2 :test 'equalp))
+ NIL )
+
+(my-assert
+  (let ((lst1 (list 1 (string #\a) (string #\b)))
+	(lst2 (list 1 (string #\A) (string #\b))))
+    (nset-exclusive-or lst1 lst2))
+ ("a" "b" "A" "b") )
+
+
+(my-assert
+ (let ((lst1 (list (cons "a" "b")
+		   (cons "c" "d")
+		   (cons "e" "f")))
+       (lst2 (list (cons "c" "a")
+		   (cons "e" "b")
+		   (cons "d" "a"))))
+   (nset-exclusive-or lst1 lst2 :test #'string= :key #'cdr))
+ (("c" . "d") ("e" . "f") ("c" . "a") ("d" . "a")))
+
+(my-assert
+  (let ((lst1 (list (cons "a" "b")
+		   (cons "c" "d")
+		   (cons "e" "f")))
+       (lst2 (list (cons "c" "a")
+		   (cons "e" "b")
+		   (cons "d" "a"))))
+   (nset-exclusive-or lst1 lst2 :test #'string= :key #'cdr)
+   lst1)
+ #-(or sbcl cmu) (("a" . "b") ("c" . "d") ("e" . "f"))
+ #+(or sbcl cmu) (("a" . "b") ("c" . "d") ("e" . "f") ("c" . "a") ("d" . "a")))
+
+(my-assert
+  (let ((lst1 (list (cons "a" "b")
+		   (cons "c" "d")
+		   (cons "e" "f")))
+       (lst2 (list (cons "c" "a")
+		   (cons "e" "b")
+		   (cons "d" "a"))))
+   (nset-exclusive-or lst1 lst2 :test #'string= :key #'cdr)
+   lst2)
+ (("c" . "a") ("d" . "a")))
+
+;;; subsetp
+
+(my-assert
+ (setq cosmos (list 1 "a" (list 1 2)))
+ (1 "a" (1 2)))
+
+(my-assert
+ (subsetp (list 1) cosmos)
+ t)
+
+(my-assert
+ (subsetp (list (list 1 2)) cosmos)
+ nil)
+
+(my-assert
+ (subsetp (list (list 1 2)) cosmos :test 'equal)
+ t)
+
+(my-assert
+ (subsetp (list 1 "A") cosmos :test #'equalp)
+ t)
+
+(my-assert
+ (subsetp (list (list 1) (list 2))
+	  (list (list 1) (list 2)))
+ nil)
+
+(my-assert
+ (subsetp (list (list 1) (list 2))
+	  (list (list 1) (list 2)) :key #'car)
+ t)
+
+;;; union
+
+(my-assert
+ (union (list 'a 'b 'c) (list 'f 'a 'd))
+ #+(or sbcl cmu) (C B F A D)
+ #+(or clisp ecls) (B C F A D)
+ #-(or sbcl cmu sbcl clisp ecls) fill-this-in)
+
+;; (A B C F D) OR  (B C F A D) OR  (D F A B C)
+
+(my-assert
+ (union (list (list 'x 5)
+	      (list 'y 6))
+	(list (list 'z 2)
+	      (list 'x 4))
+	:key #'car)
+ #+(or sbcl cmu sbcl clisp ecls) ((Y 6) (Z 2) (X 4))
+ #-(or sbcl cmu sbcl clisp ecls) fill-this-in)
+;;  ((X 5) (Y 6) (Z 2)) OR  ((X 4) (Y 6) (Z 2))
+
+(my-assert
+ (let ((lst1 (list 1 2 (list 1 2) "a" "b"))
+       (lst2 (list 2 3 (list 2 3) "B" "C")))
+   (nunion lst1 lst2))
+ #+(or sbcl cmu)
+ ("b" "a" (1 2) 1 2 3 (2 3) "B" "C")
+ #+(or clisp ecls)
+ (1 (1 2) "a" "b" 2 3 (2 3) "B" "C")
+ #-(or sbcl cmu sbcl clisp ecls)
+ fill-this-in)
+
+;;  (1 (1 2) "a" "b" 2 3 (2 3) "B" "C")  OR  (1 2 (1 2) "a" "b" "C" "B" (2 3) 3)
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/ansi-tests/section15.lisp b/src/ansi-tests/section15.lisp
new file mode 100644
index 000000000..7c2d19d90
--- /dev/null
+++ b/src/ansi-tests/section15.lisp
@@ -0,0 +1,766 @@
+;;; section 15: arrays -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+(my-assert
+ (subtypep 'simple-array 'array)
+ t)
+
+;;; make-array
+
+(my-assert
+ (make-array 4 :initial-element nil)
+ #(NIL NIL NIL NIL))
+
+(my-assert
+ (make-array '(2 4)
+	     :element-type '(unsigned-byte 2)
+	     :initial-contents '((0 1 2 3) (3 2 1 0)))
+ #2A((0 1 2 3) (3 2 1 0)))
+
+(my-assert
+ (make-array 6
+	     :element-type 'character
+	     :initial-element #\a
+	     :fill-pointer 3)
+ "aaa")
+
+(my-assert
+ (progn
+   (setq a (make-array '(4 3)))
+   t)
+ t)
+
+(my-assert
+ (dotimes (i 4)
+   (dotimes (j 3)
+     (setf (aref a i j) (list i 'x j '= (* i j)))))
+ NIL)
+
+(my-assert
+ (progn
+   (setq b (make-array 8 :displaced-to a
+		       :displaced-index-offset 2))
+   t)
+ t)
+
+(my-assert
+ (let ((a '()))
+   (dotimes (i 8)
+     (setq a (append a (list i (aref b i)))))
+   a)
+ (0 (0 X 2 = 0)
+    1 (1 X 0 = 0)
+    2 (1 X 1 = 1)
+    3 (1 X 2 = 2)
+    4 (2 X 0 = 0)
+    5 (2 X 1 = 2)
+    6 (2 X 2 = 4)
+    7 (3 X 0 = 0)))
+
+(my-assert
+ (progn
+   (setq a1 (make-array 50))
+   t)
+ t)
+
+(my-assert
+ (progn
+   (setq b1 (make-array 20 :displaced-to a1 :displaced-index-offset 10))
+   t)
+ t)
+
+(my-assert
+ (length b1)
+ 20)
+
+(my-assert
+ (progn
+   (setq a2 (make-array 50 :fill-pointer 10))
+   t)
+ t)
+
+(my-assert
+ (progn
+   (setq b2 (make-array 20 :displaced-to a2 :displaced-index-offset 10))
+   t)
+ t)
+
+(my-assert
+ (length a2)
+ 10)
+
+(my-assert
+ (length b2)
+ 20)
+
+(my-assert
+ (progn
+   (setq a3 (make-array 50 :fill-pointer 10))
+   t)
+ t)
+
+(my-assert
+ (progn
+   (setq b3 (make-array 20 :displaced-to a3 :displaced-index-offset 10
+			:fill-pointer 5))
+   t)
+ t)
+
+(my-assert
+ (length a3)
+ 10)
+
+(my-assert
+ (length b3)
+ 5)
+
+
+;;; adjust-array
+
+(my-assert
+ (adjustable-array-p
+  (setq ada (adjust-array
+	     (make-array '(2 3)
+			 :adjustable t
+			 :initial-contents '((a b c) (1 2 3)))
+	     '(4 6))))
+ T )
+
+(my-assert
+ (array-dimensions ada)
+ (4 6) )
+
+(my-assert
+ (aref ada 1 1)
+ 2 )
+
+(my-assert
+ (setq beta (make-array '(2 3) :adjustable t))
+ #+(or cmu sbcl) #2A((0 0 0) (0 0 0))
+ #-(or cmu sbcl) #2A((NIL NIL NIL) (NIL NIL NIL)))
+
+(my-assert
+ (adjust-array beta '(4 6) :displaced-to ada)
+ #+(or cmu sbcl) #2A((A B C 0 0 0)
+		     (1 2 3 0 0 0)
+		     (0 0 0 0 0 0)
+		     (0 0 0 0 0 0))
+ #-(or cmu sbcl) #2A((A B C NIL NIL NIL)
+		     (1 2 3 NIL NIL NIL)
+		     (NIL NIL NIL NIL NIL NIL)
+		     (NIL NIL NIL NIL NIL NIL)))
+
+(my-assert
+ (array-dimensions beta)
+ (4 6))
+
+(my-assert
+ (aref beta 1 1)
+ 2 )
+
+(my-assert
+ (let ((m
+	(make-array '(4 4)
+		    :adjustable t
+		    :initial-contents
+		    '(( alpha     beta      gamma     delta )
+		      ( epsilon   zeta      eta       theta )
+		      ( iota      kappa     lambda    mu    )
+		      ( nu        xi        omicron   pi    )))))
+   m)
+ #2A(( alpha     beta      gamma     delta )
+     ( epsilon   zeta      eta       theta )
+     ( iota      kappa     lambda    mu    )
+     ( nu        xi        omicron   pi    )))
+
+(my-assert
+  (let ((m
+	(make-array '(4 4)
+		    :adjustable t
+		    :initial-contents
+		    '(( alpha     beta      gamma     delta )
+		      ( epsilon   zeta      eta       theta )
+		      ( iota      kappa     lambda    mu    )
+		      ( nu        xi        omicron   pi    )))))
+    (adjust-array m '(3 5) :initial-element 'baz))
+ #2A(( alpha     beta      gamma     delta     baz )
+     ( epsilon   zeta      eta       theta     baz )
+     ( iota      kappa     lambda    mu        baz )))
+
+;;; adjustable-array-p
+
+(my-assert
+ (adjustable-array-p
+  (make-array 5
+	      :element-type 'character
+	      :adjustable t
+	      :fill-pointer 3))
+ t)
+
+;;; aref
+
+(my-assert
+ (aref (setq alpha (make-array 4)) 3)
+ #+(or cmu sbcl) 0
+ #+(or clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+
+(my-assert
+ (setf (aref alpha 3) 'sirens)
+ SIRENS)
+
+(my-assert
+ (aref alpha 3)
+ SIRENS)
+
+(my-assert
+ (aref (setq beta (make-array '(2 4)
+			      :element-type '(unsigned-byte 2)
+			      :initial-contents '((0 1 2 3) (3 2 1 0))))
+       1 2)
+ 1)
+
+(my-assert
+ (setq gamma '(0 2))
+ (0 2))
+
+(my-assert
+ (apply #'aref beta gamma)
+ 2)
+
+(my-assert
+ (setf (apply #'aref beta gamma) 3)
+ 3)
+
+(my-assert
+ (apply #'aref beta gamma)
+ 3)
+
+(my-assert
+ (aref beta 0 2)
+ 3)
+
+;;; array-dimension
+
+(my-assert
+ (array-dimension (make-array 4) 0)
+ 4)
+
+(my-assert
+ (array-dimension (make-array '(2 3)) 1)
+ 3)
+
+;;; array-dimensions
+
+(my-assert
+ (array-dimensions (make-array 4))
+ (4))
+
+(my-assert
+ (array-dimensions (make-array '(2 3)))
+ (2 3))
+
+(my-assert
+ (array-dimensions (make-array 4 :fill-pointer 2))
+ (4))
+
+;;; array-element-type
+
+(my-assert
+ (array-element-type (make-array 4))
+ T)
+
+(my-assert
+ (array-element-type (make-array 12 :element-type '(unsigned-byte 8)))
+ #+(or cmu sbcl clisp) (unsigned-byte 8)
+ #+ecls fixnum
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+
+(my-assert
+ (array-element-type (make-array 12 :element-type '(unsigned-byte 5)))
+ #+(or cmu sbcl clisp) (unsigned-byte 8)
+ #+ecls fixnum
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+
+(my-assert
+ (array-element-type (make-array 5 :element-type '(mod 5)))
+ #+(or cmu sbcl clisp) (UNSIGNED-BYTE 4)
+ #+ecls fixnum
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					; (mod 5), (mod 8), fixnum, t, or any other type of which (mod 5) is a subtype.
+
+;;; array-has-fill-pointer
+
+(my-assert
+ (array-has-fill-pointer-p (make-array 4))
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+
+(my-assert
+ (array-has-fill-pointer-p (make-array '(2 3)))
+ nil)
+
+(my-assert
+ (array-has-fill-pointer-p
+  (make-array 8
+	      :fill-pointer 2
+	      :initial-element 'filler))
+ t)
+
+;;; array-displacement
+
+(my-assert
+ (progn
+   (setq a1 (make-array 5))
+   t)
+ t)
+
+(my-assert
+ (progn
+   (setq a2 (make-array 4 :displaced-to a1
+                        :displaced-index-offset 1))
+   t)
+ t)
+
+(my-assert
+ (progn
+   (multiple-value-bind (a b)
+       (array-displacement a2)
+     (list a b))
+   t)
+ t)
+
+(my-assert
+ (progn
+   (setq a3 (make-array 2 :displaced-to a2
+			:displaced-index-offset 2))
+   t)
+ t)
+
+(my-assert
+ (progn
+   (array-displacement a3)
+   t)
+ t)
+
+;;; array-in-bounds
+
+(my-assert
+ (progn
+   (setq a (make-array '(7 11) :element-type 'string-char))
+   t)
+ t)
+
+(my-assert
+ (array-in-bounds-p a 0  0)
+ t)
+
+(my-assert
+ (array-in-bounds-p a 6 10)
+ t)
+
+(my-assert
+ (array-in-bounds-p a 0 -1)
+ nil)
+
+(my-assert
+ (array-in-bounds-p a 0 11)
+ nil)
+
+(my-assert
+ (array-in-bounds-p a 7  0)
+ nil)
+
+;;; array-rank
+
+(my-assert
+ (array-rank (make-array '()))
+ 0)
+
+(my-assert
+ (array-rank (make-array 4))
+ 1)
+
+(my-assert
+ (array-rank (make-array '(4)))
+ 1)
+
+(my-assert
+ (array-rank (make-array '(2 3)))
+ 2)
+
+;;; array-row-major-index
+
+(my-assert
+ (progn
+   (setq a (make-array '(4 7) :element-type '(unsigned-byte 8)))
+   t)
+ t)
+
+(my-assert
+ (array-row-major-index a 1 2)
+ 9)
+
+(my-assert
+ (array-row-major-index
+  (make-array '(2 3 4)
+	      :element-type '(unsigned-byte 8)
+	      :displaced-to a
+	      :displaced-index-offset 4)
+  0 2 1)
+ 9)
+
+;;; array-total-size
+
+(my-assert
+ (array-total-size (make-array 4))
+ 4)
+
+(my-assert
+ (array-total-size (make-array 4 :fill-pointer 2))
+ 4)
+
+(my-assert
+ (array-total-size (make-array 0))
+ 0)
+
+(my-assert
+ (array-total-size (make-array '(4 2)))
+ 8)
+
+(my-assert
+ (array-total-size (make-array '(4 0)))
+ 0)
+
+(my-assert
+ (array-total-size (make-array '()))
+ 1)
+
+;;; arrayp
+
+(my-assert
+ (arrayp (make-array '(2 3 4) :adjustable t))
+ t)
+
+(my-assert
+ (arrayp (make-array 6))
+ t)
+
+(my-assert
+ (arrayp #*1011)
+ t)
+
+(my-assert
+ (arrayp "hi")
+ t)
+
+(my-assert
+ (arrayp 'hi)
+ nil)
+
+(my-assert
+ (arrayp 12)
+ nil)
+
+;;; fill-pointer
+
+(my-assert
+ (setq a (make-array 8 :fill-pointer 4))
+ #+(or cmu sbcl) #(0 0 0 0)
+ #-(or cmu sbcl) #(NIL NIL NIL NIL))
+
+(my-assert
+ (fill-pointer a)
+ 4)
+
+(my-assert
+ (dotimes (i (length a)) (setf (aref a i) (* i i)))
+ NIL)
+
+(my-assert
+ a
+ #(0 1 4 9))
+
+(my-assert
+ (setf (fill-pointer a) 3)
+ 3)
+
+(my-assert
+ (fill-pointer a)
+ 3)
+
+(my-assert
+ a
+ #(0 1 4))
+
+(my-assert
+ (setf (fill-pointer a) 8)
+ 8)
+
+(my-assert
+ a
+ #+(or cmu sbcl) #(0 1 4 9 0 0 0 0)
+ #-(or cmu sbcl) #(0 1 4 9 NIL NIL NIL NIL))
+
+(my-assert
+ (>= ARRAY-DIMENSION-LIMIT 1024)
+ t)
+
+(my-assert
+ (>= ARRAY-RANK-LIMIT  8)
+ t)
+
+(my-assert
+ (>= ARRAY-TOTAL-SIZE-LIMIT 1024)
+ t)
+
+;;; simple-vector-p
+
+(my-assert
+ (simple-vector-p (make-array 6))
+ t)
+
+(my-assert
+ (simple-vector-p "aaaaaa")
+ nil)
+
+(my-assert
+ (simple-vector-p (make-array 6 :fill-pointer t))
+ nil)
+
+;;; svref
+
+(my-assert
+ (simple-vector-p (setq v (vector 1 2 'sirens)))
+ t)
+
+(my-assert
+ (svref v 0)
+ 1)
+
+(my-assert
+ (svref v 2)
+ SIRENS)
+
+(my-assert
+ (setf (svref v 1) 'newcomer)
+ NEWCOMER               )
+
+(my-assert
+ v
+ #(1 NEWCOMER SIRENS))
+
+;;; vector
+
+(my-assert
+ (arrayp (setq v (vector 1 2 'sirens)))
+ t)
+
+(my-assert
+ (vectorp v)
+ t)
+
+(my-assert
+ (simple-vector-p v)
+ t         )
+
+(my-assert
+ (length v)
+ 3)
+
+;;; vector-pop
+
+(my-assert
+ (vector-push (setq fable (list 'fable))
+	      (setq fa (make-array 8
+				   :fill-pointer 2
+				   :initial-element 'sisyphus)))
+ 2 )
+
+(my-assert
+ (fill-pointer fa)
+ 3 )
+
+(my-assert
+ (eq (vector-pop fa) fable)
+ t)
+
+(my-assert
+ (vector-pop fa)
+ SISYPHUS )
+
+(my-assert
+ (fill-pointer fa)
+ 1 )
+
+;;; vector-push
+
+(my-assert
+ (vector-push (setq fable (list 'fable))
+	      (setq fa (make-array 8
+				   :fill-pointer 2
+				   :initial-element 'first-one)))
+ 2)
+
+(my-assert
+ (fill-pointer fa)
+ 3 )
+
+(my-assert
+ (eq (aref fa 2) fable)
+ t)
+
+(my-assert
+ (vector-push-extend #\X
+		     (setq aa
+			   (make-array 5
+				       :element-type 'character
+				       :adjustable t
+				       :fill-pointer 3)))
+ 3)
+
+(my-assert
+ (fill-pointer aa)
+ 4 )
+
+(my-assert
+ (vector-push-extend #\Y aa 4)
+ 4 )
+
+(my-assert
+ (>= (array-total-size aa) 5)
+ t)
+
+(my-assert
+ (vector-push-extend #\Z aa 4)
+ 5 )
+
+(my-assert
+ (>= (array-total-size aa) 9)
+ t)
+
+;;; vectorp
+
+(my-assert
+ (vectorp "aaaaaa")
+ t)
+
+(my-assert
+ (vectorp (make-array 6 :fill-pointer t))
+ t)
+
+(my-assert
+ (vectorp (make-array '(2 3 4)))
+ nil)
+
+(my-assert
+ (vectorp #*11)
+ t)
+
+(my-assert
+ (vectorp #b11)
+ nil)
+
+;;; bit
+
+(my-assert
+ (bit (setq ba (make-array 8
+			   :element-type 'bit
+			   :initial-element 1))
+      3)
+ 1)
+
+(my-assert
+ (setf (bit ba 3) 0)
+ 0)
+
+(my-assert
+ (bit ba 3)
+ 0)
+
+(my-assert
+ (sbit ba 5)
+ 1)
+
+(my-assert
+ (setf (sbit ba 5) 1)
+ 1)
+
+(my-assert
+ (sbit ba 5)
+ 1)
+
+;;; bit-and etc
+
+(my-assert
+ (bit-and (setq ba #*11101010) #*01101011)
+ #*01101010)
+
+(my-assert
+ (bit-and #*1100 #*1010)
+ #*1000      )
+
+(my-assert
+ (bit-andc1 #*1100 #*1010)
+ #*0010)
+
+(my-assert
+ (setq rba (bit-andc2 ba #*00110011 t))
+ #*11001000)
+
+(my-assert
+ (eq rba ba)
+ t)
+
+(my-assert
+ (bit-not (setq ba #*11101010))
+ #*00010101)
+
+(my-assert
+ (setq rba (bit-not ba
+		    (setq tba (make-array 8
+					  :element-type 'bit))))
+ #*00010101)
+
+(my-assert
+ (equal rba tba)
+ t)
+
+(my-assert
+ (bit-xor #*1100 #*1010)
+ #*0110)
+
+;;; bit-vector-p
+
+(my-assert
+ (bit-vector-p (make-array 6
+			   :element-type 'bit
+			   :fill-pointer t))
+ t)
+
+(my-assert
+ (bit-vector-p #*)
+ t)
+
+(my-assert
+ (bit-vector-p (make-array 6))
+ nil)
+
+;;; simple-bit-vector
+
+(my-assert
+ (simple-bit-vector-p (make-array 6))
+ nil)
+
+(my-assert
+ (simple-bit-vector-p #*)
+ t)
+
+
+
+
+
+
+
diff --git a/src/ansi-tests/section16.lisp b/src/ansi-tests/section16.lisp
new file mode 100644
index 000000000..2263e6143
--- /dev/null
+++ b/src/ansi-tests/section16.lisp
@@ -0,0 +1,240 @@
+;;; section 16: strings -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+;;; simple-string-p
+
+(my-assert
+ (simple-string-p "aaaaaa")
+ t)
+
+(my-assert
+ (simple-string-p (make-array 6
+			      :element-type 'character
+			      :fill-pointer t))
+ nil)
+
+;;; char
+
+(my-assert
+ (setq my-simple-string (make-string 6 :initial-element #\A))
+ "AAAAAA")
+
+(my-assert
+ (schar my-simple-string 4)
+ #\A)
+
+(my-assert
+ (setf (schar my-simple-string 4) #\B)
+ #\B)
+
+(my-assert
+ my-simple-string
+ "AAAABA")
+
+(my-assert
+ (setq my-filled-string
+       (make-array 6 :element-type 'character
+		   :fill-pointer 5
+		   :initial-contents my-simple-string))
+ "AAAAB")
+
+(my-assert
+ (char my-filled-string 4)
+ #\B)
+
+(my-assert
+ (char my-filled-string 5)
+ #\A
+ "char: ...
+
+char ignores fill pointers when accessing elements. ")
+
+(my-assert
+ (setf (char my-filled-string 3) #\C)
+ #\C)
+
+(my-assert
+ (setf (char my-filled-string 5) #\D)
+ #\D
+ "char: ...
+
+char ignores fill pointers when accessing elements. ")
+
+(my-assert
+ (setf (fill-pointer my-filled-string) 6)
+ 6)
+
+(my-assert
+ my-filled-string
+ "AAACBD")
+
+;;; string
+
+(my-assert
+ (string "already a string")
+ "already a string")
+
+(my-assert
+ (string 'elm)
+ "ELM")
+
+(my-assert
+ (string #\c)
+ "c")
+
+;;; string-upcase
+
+(my-assert
+ (string-upcase "abcde")
+ "ABCDE")
+
+(my-assert
+ (string-upcase "Dr. Livingston, I presume?")
+ "DR. LIVINGSTON, I PRESUME?")
+
+(my-assert
+ (string-upcase "Dr. Livingston, I presume?" :start 6 :end 10)
+ "Dr. LiVINGston, I presume?")
+
+(my-assert
+ (string-downcase "Dr. Livingston, I presume?")
+ "dr. livingston, i presume?")
+
+(my-assert
+ (string-capitalize "elm 13c arthur;fig don't")
+ "Elm 13c Arthur;Fig Don'T")
+
+(my-assert
+ (string-capitalize " hello ")
+ " Hello ")
+
+(my-assert
+ (string-capitalize "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")
+ "Occluded Casements Forestall Inadvertent Defenestration")
+
+(my-assert
+ (string-capitalize 'kludgy-hash-search)
+ "Kludgy-Hash-Search")
+
+(my-assert
+ (string-capitalize "DON'T!")
+ "Don'T!")				;not "Don't!"
+
+(my-assert
+ (string-capitalize "pipe 13a, foo16c")
+ "Pipe 13a, Foo16c")
+
+(my-assert
+ (setq str (copy-seq "0123ABCD890a"))
+ "0123ABCD890a")
+
+(my-assert
+ (nstring-downcase str :start 5 :end 7)
+ "0123AbcD890a")
+
+(my-assert
+ str
+ "0123AbcD890a")
+
+;;; string-trim
+
+(my-assert
+ (string-trim "abc" "abcaakaaakabcaaa")
+ "kaaak")
+
+(my-assert
+ (string-trim '(#\Space #\Tab #\Newline) " garbanzo beans
+        ")
+ "garbanzo beans")
+
+(my-assert
+ (string-trim " (*)" " ( *three (silly) words* ) ")
+ "three (silly) words")
+
+(my-assert
+ (string-left-trim "abc" "labcabcabc")
+ "labcabcabc")
+
+(my-assert
+ (string-left-trim " (*)" " ( *three (silly) words* ) ")
+ "three (silly) words* ) ")
+
+(my-assert
+ (string-right-trim " (*)" " ( *three (silly) words* ) ")
+ " ( *three (silly) words")
+
+;;; string=
+
+(my-assert
+ (string= "foo" "foo")
+ t)
+
+(my-assert
+ (string= "foo" "Foo")
+ nil)
+
+(my-assert
+ (string= "foo" "bar")
+ nil)
+
+(my-assert
+ (string= "together" "frog" :start1 1 :end1 3 :start2 2)
+ t)
+
+(my-assert
+ (string-equal "foo" "Foo")
+ t)
+
+(my-assert
+ (string= "abcd" "01234abcd9012" :start2 5 :end2 9)
+ t)
+
+(my-assert
+ (string< "aaaa" "aaab")
+ 3)
+
+(my-assert
+ (string>= "aaaaa" "aaaa")
+ 4)
+
+(my-assert
+ (string-not-greaterp "Abcde" "abcdE")
+ 5)
+
+(my-assert
+ (string-lessp "012AAAA789" "01aaab6" :start1 3 :end1 7
+	       :start2 2 :end2 6)
+ 6)
+
+(my-assert
+ (string-not-equal "AAAA" "aaaA")
+ nil)
+
+;;; stringp
+
+(my-assert
+ (stringp "aaaaaa")
+ t)
+
+(my-assert
+ (stringp #\a)
+ nil)
+
+;;; make-string
+
+(my-assert
+ (make-string 10 :initial-element #\5)
+ "5555555555")
+
+(my-assert
+ (length (make-string 10))
+ 10)
+
+
+
+
+
+
+
diff --git a/src/ansi-tests/section17.lisp b/src/ansi-tests/section17.lisp
new file mode 100644
index 000000000..ba91ff430
--- /dev/null
+++ b/src/ansi-tests/section17.lisp
@@ -0,0 +1,846 @@
+;;; section 17: sequences -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+;;; 17.2.1.1
+
+(my-assert
+ (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'equal)
+ (foo bar "BAR" "foo" "bar"))
+
+(my-assert
+ (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'equalp)
+ (foo bar "BAR" "bar"))
+
+(my-assert
+ (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'string-equal)
+ (bar "BAR" "bar"))
+
+(my-assert
+ (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'string=)
+ (BAR "BAR" "foo" "bar"))
+
+(my-assert
+ (remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test-not #'eql)
+ (1))
+
+(my-assert
+ (remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test-not #'=)
+ (1 1.0 #C(1.0 0.0)))
+
+(my-assert
+ (remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test (complement #'=))
+ (1 1.0 #C(1.0 0.0)))
+
+(my-assert
+ (count 1 '((one 1) (uno 1) (two 2) (dos 2)) :key #'cadr)
+ 2)
+
+(my-assert
+ (count 2.0 '(1 2 3) :test #'eql :key #'float)
+ 1)
+
+(my-assert
+ (count "FOO" (list (make-pathname :name "FOO" :type "X")
+                    (make-pathname :name "FOO" :type "Y"))
+	:key #'pathname-name
+	:test #'equal)
+ 2)
+
+;;; 17.2.2.1
+
+(my-assert
+ (count-if #'zerop '(1 #C(0.0 0.0) 0 0.0d0 0.0s0 3))
+ 4)
+
+(my-assert
+ (remove-if-not #'symbolp '(0 1 2 3 4 5 6 7 8 9 A B C D E F))
+ (A B C D E F))
+
+(my-assert
+ (remove-if (complement #'symbolp) '(0 1 2 3 4 5 6 7 8 9 A B C D E F))
+ (A B C D E F))
+
+(my-assert
+ (count-if #'zerop '("foo" "" "bar" "" "" "baz" "quux") :key #'length)
+ 3)
+
+;;; copy-seq
+
+(my-assert
+ (let ((str "a string"))
+   str)
+ "a string")
+
+(my-assert
+ (let ((str "a string"))
+   (equalp str (copy-seq str)))
+ t)
+
+(my-assert
+ (let ((str "a string"))
+   (eql str (copy-seq str)))
+ nil)
+
+;;; elt
+
+(my-assert
+ (let ((str "a string"))
+   (setq str (copy-seq "0123456789")))
+ "0123456789")
+
+(my-assert
+ (let ((str "a string"))
+   (setq str (copy-seq "0123456789"))
+   (elt str 6))
+ #\6)
+
+(my-assert
+ (let ((str "a string"))
+   (setq str (copy-seq "0123456789"))
+   (setf (elt str 0) #\#))
+ #\#)
+
+(my-assert
+ (let ((str "a string"))
+   (setq str (copy-seq "0123456789"))
+   (setf (elt str 0) #\#)
+   str)
+ "#123456789")
+
+;;; fill
+
+(my-assert
+ (fill (list 0 1 2 3 4 5) '(444))
+ ((444) (444) (444) (444) (444) (444)))
+
+(my-assert
+ (fill (copy-seq "01234") #\e :start 3)
+ "012ee")
+
+(my-assert
+ (setq x (vector 'a 'b 'c 'd 'e))
+ #(A B C D E))
+
+(my-assert
+ (fill x 'z :start 1 :end 3)
+ #(A Z Z D E))
+
+(my-assert
+ x
+ #(A Z Z D E))
+
+(my-assert
+ (fill x 'p)
+ #(P P P P P))
+
+(my-assert
+ x
+ #(P P P P P))
+
+;;; make-sequence
+
+(my-assert
+ (make-sequence 'list 0)
+ ())
+
+(my-assert
+ (make-sequence 'string 26 :initial-element #\.)
+ "..........................")
+
+(my-assert
+ (make-sequence '(vector double-float) 2
+		:initial-element 1d0)
+ #(1.0d0 1.0d0))
+
+(my-assert
+ (make-sequence '(vector * 2) 3)
+ TYPE-ERROR)
+
+(my-assert
+ (make-sequence '(vector * 4) 3)
+ TYPE-ERROR)
+
+;;; subseq
+
+(my-assert
+ (let ((str (copy-seq "012345")))
+   str)
+ "012345")
+
+(my-assert
+  (let ((str (copy-seq "012345")))
+    (subseq str 2))
+ "2345")
+
+(my-assert
+  (let ((str (copy-seq "012345")))
+    (subseq str 3 5))
+ "34")
+
+(my-assert
+  (let ((str (copy-seq "012345")))
+    (setf (subseq str 4) "abc"))
+ "abc")
+
+(my-assert
+ (let ((str (copy-seq "012345")))
+   (setf (subseq str 4) "abc")
+   str)
+ "0123ab")
+
+(my-assert
+  (let ((str (copy-seq "012345")))
+    (setf (subseq str 4) "abc")
+    (setf (subseq str 0 2) "A"))
+ "A")
+
+(my-assert
+  (let ((str (copy-seq "012345")))
+    (setf (subseq str 4) "abc")
+    (setf (subseq str 0 2) "A")
+    str)
+ "A123ab")
+
+;;; map
+
+(my-assert
+ (map 'string #'(lambda (x y)
+		  (char "01234567890ABCDEF" (mod (+ x y) 16)))
+      '(1 2 3 4)
+      '(10 9 8 7))
+ "AAAA")
+
+(my-assert
+ (let ((seq (map 'list #'copy-seq
+		 '("lower" "UPPER" "" "123"))))
+   seq)
+ ("lower" "UPPER" "" "123"))
+
+(my-assert
+  (let ((seq (map 'list #'copy-seq
+		 '("lower" "UPPER" "" "123"))))
+    (map nil #'nstring-upcase seq))
+ NIL)
+
+(my-assert
+  (let ((seq (map 'list #'copy-seq
+		 '("lower" "UPPER" "" "123"))))
+    (map nil #'nstring-upcase seq)
+    seq)
+ ("LOWER" "UPPER" "" "123"))
+
+(my-assert
+ (map 'list #'- '(1 2 3 4))
+ (-1 -2 -3 -4))
+
+(my-assert
+ (map 'string
+      #'(lambda (x) (if (oddp x) #\1 #\0))
+      '(1 2 3 4))
+ "1010")
+
+(my-assert
+ (map '(vector * 4) #'cons "abc" "de")
+ TYPE-ERROR)
+
+;;; map-into
+
+(my-assert
+ (setq a (list 1 2 3 4) b (list 10 10 10 10))
+ (10 10 10 10))
+
+(my-assert
+ (map-into a #'+ a b)
+ (11 12 13 14))
+
+(my-assert
+ a
+ (11 12 13 14))
+
+(my-assert
+ b
+ (10 10 10 10))
+
+(my-assert
+ (setq k '(one two three))
+ (ONE TWO THREE))
+
+(my-assert
+ (map-into a #'cons k a)
+ ((ONE . 11) (TWO . 12) (THREE . 13) 14))
+
+;;; reduce
+
+(my-assert
+ (reduce #'* '(1 2 3 4 5))
+ 120)
+
+(my-assert
+ (reduce #'append '((1) (2)) :initial-value '(i n i t))
+ (I N I T 1 2))
+
+(my-assert
+ (reduce #'append '((1) (2)) :from-end t
+	 :initial-value '(i n i t))
+ (1 2 I N I T))
+
+(my-assert
+ (reduce #'- '(1 2 3 4))
+ -8)
+
+(my-assert
+ (reduce #'- '(1 2 3 4) :from-end t)
+ -2)
+
+(my-assert
+ (reduce #'+ '())
+ 0)
+
+(my-assert
+ (reduce #'+ '(3))
+ 3)
+
+(my-assert
+ (reduce #'+ '(foo))
+ FOO)
+
+(my-assert
+ (reduce #'list '(1 2 3 4))
+ (((1 2) 3) 4))
+
+(my-assert
+ (reduce #'list '(1 2 3 4) :from-end t)
+ (1 (2 (3 4))))
+
+(my-assert
+ (reduce #'list '(1 2 3 4) :initial-value 'foo)
+ ((((foo 1) 2) 3) 4))
+
+(my-assert
+ (reduce #'list '(1 2 3 4)
+	 :from-end t :initial-value 'foo)
+ (1 (2 (3 (4 foo)))))
+
+;;; count
+
+(my-assert
+ (count #\a "how many A's are there in here?")
+ 2)
+
+(my-assert
+ (count-if-not #'oddp '((1) (2) (3) (4)) :key #'car)
+ 2)
+
+(my-assert
+ (count-if #'upper-case-p "The Crying of Lot 49" :start 4)
+ 2)
+
+;; length
+
+(my-assert
+ (length "abc")
+ 3)
+
+(my-assert
+ (setq str (make-array '(3) :element-type 'character
+		       :initial-contents "abc"
+		       :fill-pointer t))
+ "abc")
+
+(my-assert
+ (length str)
+ 3)
+
+(my-assert
+ (setf (fill-pointer str) 2)
+ 2)
+
+(my-assert
+ (length str)
+ 2)
+
+;;; reverse
+
+(my-assert
+ (setq str "abc")
+ "abc")
+
+(my-assert
+ (reverse str)
+ "cba")
+
+(my-assert
+ str
+ "abc")
+
+(my-assert
+ (setq str (copy-seq str))
+ "abc")
+
+(my-assert
+ (nreverse str)
+ "cba")
+
+(my-assert
+ str
+ #+(or cmu sbcl clisp ecls) "cba"
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+
+(my-assert
+ (let ((l (list 1 2 3)))
+   l)
+ (1 2 3))
+
+(my-assert
+ (let ((l (list 1 2 3)))
+   (nreverse l))
+ (3 2 1))
+
+(my-assert
+ (let ((l (list 1 2 3)))
+   (nreverse l)
+   l)
+ #+(or cmu sbcl ecls) (1)
+ #+clisp (3 2 1)
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+
+;;; sort
+
+(my-assert
+ (setq tester (copy-seq "lkjashd"))
+ "lkjashd")
+
+(my-assert
+ (sort tester #'char-lessp)
+ "adhjkls")
+
+(my-assert
+ (setq tester (list '(1 2 3) '(4 5 6) '(7 8 9)))
+ ((1 2 3) (4 5 6) (7 8 9)))
+
+(my-assert
+ (sort tester #'> :key #'car)
+ ((7 8 9) (4 5 6) (1 2 3)))
+
+(my-assert
+ (setq tester (list 1 2 3 4 5 6 7 8 9 0))
+ (1 2 3 4 5 6 7 8 9 0))
+
+(my-assert
+ (stable-sort tester #'(lambda (x y) (and (oddp x) (evenp y))))
+ (1 3 5 7 9 2 4 6 8 0))
+
+(my-assert
+ (sort (setq committee-data
+             (vector (list (list "JonL" "White") "Iteration")
+                     (list (list "Dick" "Waters") "Iteration")
+                     (list (list "Dick" "Gabriel") "Objects")
+                     (list (list "Kent" "Pitman") "Conditions")
+                     (list (list "Gregor" "Kiczales") "Objects")
+                     (list (list "David" "Moon") "Objects")
+                     (list (list "Kathy" "Chapman") "Editorial")
+                     (list (list "Larry" "Masinter") "Cleanup")
+                     (list (list "Sandra" "Loosemore") "Compiler")))
+       #'string-lessp :key #'cadar)
+ #((("Kathy" "Chapman") "Editorial")
+   (("Dick" "Gabriel") "Objects")
+   (("Gregor" "Kiczales") "Objects")
+   (("Sandra" "Loosemore") "Compiler")
+   (("Larry" "Masinter") "Cleanup")
+   (("David" "Moon") "Objects")
+   (("Kent" "Pitman") "Conditions")
+   (("Dick" "Waters") "Iteration")
+   (("JonL" "White") "Iteration")))
+
+;; Note that individual alphabetical order within `committees'
+;; is preserved.
+
+(my-assert
+ (setq committee-data
+       (stable-sort committee-data #'string-lessp :key #'cadr))
+ #((("Larry" "Masinter") "Cleanup")
+   (("Sandra" "Loosemore") "Compiler")
+   (("Kent" "Pitman") "Conditions")
+   (("Kathy" "Chapman") "Editorial")
+   (("Dick" "Waters") "Iteration")
+   (("JonL" "White") "Iteration")
+   (("Dick" "Gabriel") "Objects")
+   (("Gregor" "Kiczales") "Objects")
+   (("David" "Moon") "Objects")))
+
+;;; find
+
+(my-assert
+ (find #\d "here are some letters that can be looked at" :test #'char>)
+ #\Space)
+
+(my-assert
+ (find-if #'oddp '(1 2 3 4 5) :end 3 :from-end t)
+ 3)
+
+(my-assert
+ (find-if-not #'complexp
+	      '#(3.5 2 #C(1.0 0.0) #C(0.0 1.0))
+	      :start 2)
+ NIL)
+
+
+;;; position
+
+(my-assert
+ (position #\a "baobab" :from-end t)
+ 4)
+
+(my-assert
+ (position-if #'oddp '((1) (2) (3) (4)) :start 1 :key #'car)
+ 2)
+
+(my-assert
+ (position 595 '())
+ NIL)
+
+(my-assert
+ (position-if-not #'integerp '(1 2 3 4 5.0))
+ 4)
+
+;;; search
+
+(my-assert
+ (search "dog" "it's a dog's life")
+ 7)
+
+(my-assert
+ (search '(0 1) '(2 4 6 1 3 5) :key #'oddp)
+ 2)
+
+;;; mismatch
+
+(my-assert
+ (mismatch "abcd" "ABCDE" :test #'char-equal)
+ 4)
+
+(my-assert
+ (mismatch '(3 2 1 1 2 3) '(1 2 3) :from-end t)
+ 3)
+
+(my-assert
+ (mismatch '(1 2 3) '(2 3 4) :test-not #'eq :key #'oddp)
+ NIL)
+
+(my-assert
+ (mismatch '(1 2 3 4 5 6) '(3 4 5 6 7) :start1 2 :end2 4)
+ NIL)
+
+;;; replace
+
+(my-assert
+ (replace (copy-seq "abcdefghij")
+	  "0123456789" :start1 4 :end1 7 :start2 4)
+ "abcd456hij")
+
+(my-assert
+ (let ((lst (copy-seq "012345678")))
+   lst)
+ "012345678")
+
+(my-assert
+  (let ((lst (copy-seq "012345678")))
+    (replace lst lst :start1 2 :start2 0))
+ "010123456")
+
+(my-assert
+  (let ((lst (copy-seq "012345678")))
+    (replace lst lst :start1 2 :start2 0)
+    lst)
+ "010123456")
+
+;;; substitute
+
+(my-assert
+ (substitute #\. #\SPACE "0 2 4 6")
+ "0.2.4.6")
+
+(my-assert
+ (substitute 9 4 '(1 2 4 1 3 4 5))
+ (1 2 9 1 3 9 5))
+
+(my-assert
+ (substitute 9 4 '(1 2 4 1 3 4 5) :count 1)
+ (1 2 9 1 3 4 5))
+
+(my-assert
+ (substitute 9 4 '(1 2 4 1 3 4 5) :count 1 :from-end t)
+ (1 2 4 1 3 9 5))
+
+(my-assert
+ (substitute 9 3 '(1 2 4 1 3 4 5) :test #'>)
+ (9 9 4 9 3 4 5))
+
+(my-assert
+ (substitute-if 0 #'evenp '((1) (2) (3) (4)) :start 2 :key #'car)
+ ((1) (2) (3) 0))
+
+(my-assert
+ (substitute-if 9 #'oddp '(1 2 4 1 3 4 5))
+ (9 2 4 9 9 4 9))
+
+(my-assert
+ (substitute-if 9 #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t)
+ (1 2 4 1 3 9 5))
+
+(my-assert
+ (setq some-things (list 'a 'car 'b 'cdr 'c))
+ (A CAR B CDR C))
+
+(my-assert
+ (nsubstitute-if "function was here" #'fboundp some-things
+                 :count 1 :from-end t)
+ (A CAR B "function was here" C))
+
+(my-assert
+ some-things
+ (A CAR B "function was here" C))
+
+(my-assert
+ (setq alpha-tester (copy-seq "ab "))
+ "ab ")
+
+(my-assert
+ (nsubstitute-if-not #\z #'alpha-char-p alpha-tester)
+ "abz")
+
+(my-assert
+ alpha-tester
+ "abz")
+
+;;; concatenate
+
+(my-assert
+ (concatenate 'string "all" " " "together" " " "now")
+ "all together now")
+
+(my-assert
+ (concatenate 'list "ABC" '(d e f) #(1 2 3) #*1011)
+ (#\A #\B #\C D E F 1 2 3 1 0 1 1))
+
+(my-assert
+ (concatenate 'list)
+ NIL)
+
+(my-assert
+ (concatenate '(vector * 2) "a" "bc")
+ TYPE-ERROR)
+
+;;; merge
+
+(my-assert
+ (setq test1 (list 1 3 4 6 7))
+ (1 3 4 6 7))
+
+(my-assert
+ (setq test2 (list 2 5 8))
+ (2 5 8))
+
+(my-assert
+ (merge 'list test1 test2 #'<)
+ (1 2 3 4 5 6 7 8))
+
+(my-assert
+ (setq test1 (copy-seq "BOY"))
+ "BOY")
+
+(my-assert
+ (setq test2 (copy-seq "nosy"))
+ "nosy")
+
+(my-assert
+ (merge 'string test1 test2 #'char-lessp)
+ "BnOosYy")
+
+(my-assert
+ (setq test1 (vector '(red . 1) '(blue . 4)))
+ #((RED . 1) (BLUE . 4)))
+
+(my-assert
+ (setq test2 (vector '(yellow . 2) '(green . 7)))
+ #((YELLOW . 2) (GREEN . 7)))
+
+(my-assert
+ (merge 'vector test1 test2 #'< :key #'cdr)
+ #((RED . 1) (YELLOW . 2) (BLUE . 4) (GREEN . 7)))
+
+(my-assert
+ (merge '(vector * 4) '(1 5) '(2 4 6) #'<)
+ TYPE-ERROR)
+
+
+;;; remove
+
+(my-assert
+ (remove 4 '(1 3 4 5 9))
+ (1 3 5 9))
+
+(my-assert
+ (remove 4 '(1 2 4 1 3 4 5))
+ (1 2 1 3 5))
+
+(my-assert
+ (remove 4 '(1 2 4 1 3 4 5) :count 1)
+ (1 2 1 3 4 5))
+
+(my-assert
+ (remove 4 '(1 2 4 1 3 4 5) :count 1 :from-end t)
+ (1 2 4 1 3 5))
+
+(my-assert
+ (remove 3 '(1 2 4 1 3 4 5) :test #'>)
+ (4 3 4 5))
+
+(my-assert
+ (setq lst '(list of four elements))
+ (LIST OF FOUR ELEMENTS))
+
+(my-assert
+ (setq lst2 (copy-seq lst))
+ (LIST OF FOUR ELEMENTS))
+
+(my-assert
+ (setq lst3 (delete 'four lst))
+ (LIST OF ELEMENTS))
+
+(my-assert
+ (equal lst lst2)
+ nil)
+
+(my-assert
+ (remove-if #'oddp '(1 2 4 1 3 4 5))
+ (2 4 4))
+
+(my-assert
+ (remove-if #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t)
+ (1 2 4 1 3 5))
+
+(my-assert
+ (remove-if-not #'evenp '(1 2 3 4 5 6 7 8 9) :count 2 :from-end t)
+ (1 2 3 4 5 6 8))
+
+(my-assert
+ (setq tester (list 1 2 4 1 3 4 5))
+ (1 2 4 1 3 4 5))
+
+(my-assert
+ (delete 4 tester)
+ (1 2 1 3 5))
+
+(my-assert
+ (setq tester (list 1 2 4 1 3 4 5))
+ (1 2 4 1 3 4 5))
+
+(my-assert
+ (delete 4 tester :count 1)
+ (1 2 1 3 4 5))
+
+(my-assert
+ (setq tester (list 1 2 4 1 3 4 5))
+ (1 2 4 1 3 4 5))
+
+(my-assert
+ (delete 4 tester :count 1 :from-end t)
+ (1 2 4 1 3 5))
+
+(my-assert
+ (setq tester (list 1 2 4 1 3 4 5))
+ (1 2 4 1 3 4 5))
+
+(my-assert
+ (delete 3 tester :test #'>)
+ (4 3 4 5))
+
+(my-assert
+ (setq tester (list 1 2 4 1 3 4 5))
+ (1 2 4 1 3 4 5))
+
+(my-assert
+ (delete-if #'oddp tester)
+ (2 4 4))
+
+(my-assert
+ (setq tester (list 1 2 4 1 3 4 5))
+ (1 2 4 1 3 4 5))
+
+(my-assert
+ (delete-if #'evenp tester :count 1 :from-end t)
+ (1 2 4 1 3 5))
+
+(my-assert
+ (setq tester (list 1 2 3 4 5 6))
+ (1 2 3 4 5 6))
+
+(my-assert
+ (delete-if #'evenp tester)
+ (1 3 5))
+
+(my-assert
+ tester
+ #+(or cmu sbcl clisp ecls) (1 3 5)
+ #-(or cmu sbcl clisp ecls)  fill-this-in)
+
+(my-assert
+ (setq foo (list 'a 'b 'c))
+ (A B C))
+
+(my-assert
+ (setq bar (cdr foo))
+ (B C))
+
+(my-assert
+ (setq foo (delete 'b foo))
+ (A C))
+
+(my-assert
+ bar
+ #+(or cmu sbcl clisp ecls) (B C)
+ #-(or cmu sbcl clisp ecls)  fill-this-in)
+					; ((C))) or ...
+
+(my-assert
+ (eq (cdr foo) (car bar))
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					; T or ...
+
+
+;;; remove-duplicates
+
+(my-assert
+ (remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t)
+ "aBcD")
+
+(my-assert
+ (remove-duplicates '(a b c b d d e))
+ (A C B D E))
+
+(my-assert
+ (remove-duplicates '(a b c b d d e) :from-end t)
+ (A B C D E))
+
+(my-assert
+ (remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
+		    :test #'char-equal :key #'cadr)
+ ((BAR #\%) (BAZ #\A)))
+
+(my-assert
+ (remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
+		    :test #'char-equal :key #'cadr :from-end t)
+ ((FOO #\a) (BAR #\%)))
+
+(my-assert
+ (setq tester (list 0 1 2 3 4 5 6))
+ (0 1 2 3 4 5 6))
+
+(my-assert
+ (delete-duplicates tester :key #'oddp :start 1 :end 6)
+ (0 4 5 6))
+
diff --git a/src/ansi-tests/section18-errors.lisp b/src/ansi-tests/section18-errors.lisp
new file mode 100644
index 000000000..1a2ced6b9
--- /dev/null
+++ b/src/ansi-tests/section18-errors.lisp
@@ -0,0 +1,43 @@
+;;; section 18 hash tables -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+(my-assert
+ (defvar *counters* (make-hash-table))
+ *COUNTERS*)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 'foo *counters*)
+   (list a b))
+ (NIL nil))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 'foo *counters* 0)
+   (list a b))
+ (0 nil))
+
+(my-assert				; XXX
+ (defmacro how-many (obj) `(values (gethash ,obj *counters* 0)))
+ HOW-MANY)
+
+(my-assert				; XXX
+ (defun count-it (obj) (incf (how-many obj)))
+ COUNT-IT)
+
+(dolist (x '(bar foo foo bar bar baz)) (count-it x))
+
+(my-assert
+ (how-many 'foo)
+ 2)
+
+(my-assert
+ (how-many 'bar)
+ 3)
+
+(my-assert
+ (how-many 'quux)
+ 0)
+
diff --git a/src/ansi-tests/section18.lisp b/src/ansi-tests/section18.lisp
new file mode 100644
index 000000000..6687ef612
--- /dev/null
+++ b/src/ansi-tests/section18.lisp
@@ -0,0 +1,385 @@
+;;; section 18 hash tables -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+(my-assert
+ (progn
+   (setq a (make-hash-table))
+   t)
+ t)
+;; #<HASH-TABLE EQL 0/120 32536573>
+
+(my-assert
+ (setf (gethash 'color a) 'brown)
+ BROWN)
+
+(my-assert
+ (setf (gethash 'name a) 'fred)
+ FRED)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 'color a)
+   (list a b))
+ (BROWN t))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 'name a)
+   (list a b))
+ ( FRED t))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 'pointy a)
+   (list a b))
+ ( NIL nil))
+
+;;;make-hash-table
+
+(my-assert
+ (progn
+   (setq table (make-hash-table))
+   t)
+ t)
+;;  #<HASH-TABLE EQL 0/120 46142754>
+
+(my-assert
+ (setf (gethash "one" table) 1)
+ 1)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash "one" table)
+   (list a b))
+ (  NIL nil))
+
+(my-assert
+ (progn
+   (setq table (make-hash-table :test 'equal))
+   t)
+ t)
+					;  #<HASH-TABLE EQUAL 0/139 46145547>
+
+(my-assert
+ (setf (gethash "one" table) 1)
+ 1)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash "one" table)
+   (list a b))
+ (  1 T))
+
+(my-assert
+ (progn
+   (make-hash-table :rehash-size 1.5 :rehash-threshold 0.7)
+   t)
+ t)
+					;  #<HASH-TABLE EQL 0/120 46156620>
+
+;;; hash-table-p
+
+(my-assert
+ (progn
+   (setq table (make-hash-table))
+   t)
+ t)
+					; #<HASH-TABLE EQL 0/120 32511220>
+
+(my-assert
+ (hash-table-p table)
+ t)
+
+(my-assert
+ (hash-table-p 37)
+ nil)
+
+(my-assert
+ (hash-table-p '((a . 1) (b . 2)))
+ nil)
+
+;; hash-table-count
+
+(my-assert
+ (progn
+   (setq table (make-hash-table))
+   t)
+ t)
+					;  #<HASH-TABLE EQL 0/120 32115135>
+
+(my-assert
+ (hash-table-count table)
+ 0)
+
+(my-assert
+ (setf (gethash 57 table) "fifty-seven")
+ "fifty-seven")
+
+(my-assert
+ (hash-table-count table)
+ 1)
+
+(my-assert
+ (dotimes (i 100) (setf (gethash i table) i))
+ NIL)
+
+(my-assert
+ (hash-table-count table)
+ 100)
+
+;;; hash-table-rehash-size
+
+(my-assert
+ (progn (setq table (make-hash-table :size 100 :rehash-size 1.4))
+	t)
+ t)
+					;  #<HASH-TABLE EQL 0/100 2556371>
+
+(my-assert
+ (hash-table-rehash-size table)
+ #-clisp 1.4
+ #+clisp 1.4s0)
+
+;;; HASH-TABLE-REHASH-THRESHOLD
+
+(my-assert
+ (progn
+   (setq table (make-hash-table :size 100 :rehash-threshold 0.5))
+   t)
+ t)
+					;  #<HASH-TABLE EQL 0/100 2562446>
+
+(my-assert
+ (hash-table-rehash-threshold table)
+ #-clisp 0.5
+ #+clisp 0.75s0)
+
+
+;;; get-hash
+
+(my-assert
+ (progn
+   (setq table (make-hash-table))
+   t)
+ t)
+
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 1 table)
+   (list a b))
+ (NIL nil))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 1 table 2)
+   (list a b))
+ (2 nil))
+
+(my-assert
+ (setf (gethash 1 table) "one")
+ "one")
+
+(my-assert
+ (setf (gethash 2 table "two") "two")
+ "two")
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 1 table)
+   (list a b))
+ ("one" t))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 2 table)
+   (list a b))
+ ("two" t))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash nil table)
+   (list a b))
+ (NIL nil))
+
+(my-assert
+ (setf (gethash nil table) nil)
+ NIL)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash nil table)
+   (list a b))
+ (NIL t))
+
+(unintern '*counters*)
+
+(my-assert
+ (defvar *counters* (make-hash-table))
+ *COUNTERS*)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 'foo *counters*)
+   (list a b))
+ (NIL nil))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 'foo *counters* 0)
+   (list a b))
+ (0 nil))
+
+;;; remhash
+
+(setq table (make-hash-table))
+
+(my-assert
+ (setf (gethash 100 table) "C")
+ "C")
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 100 table)
+   (list a b))
+ ("C" t))
+
+(my-assert
+ (remhash 100 table)
+ t)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 100 table)
+   (list a b))
+ (NIL nil))
+
+(my-assert
+ (remhash 100 table)
+ nil)
+
+;;; maphash
+
+(setq table (make-hash-table))
+
+(my-assert
+ (dotimes (i 10) (setf (gethash i table) i))
+ NIL)
+
+(my-assert
+ (let ((sum-of-squares 0))
+   (maphash #'(lambda (key val)
+		(let ((square (* val val)))
+		  (incf sum-of-squares square)
+		  (setf (gethash key table) square)))
+	    table)
+   sum-of-squares)
+ 285)
+
+(my-assert
+ (hash-table-count table)
+ 10)
+
+(my-assert
+ (maphash #'(lambda (key val)
+	      (when (oddp val) (remhash key table)))
+	  table)
+ NIL)
+
+(my-assert
+ (hash-table-count table)
+ 5)
+
+(my-assert
+ (let ((a nil))
+   (maphash #'(lambda (k v) (setq a (cons  (list k v) a ))) table)
+   a)
+ #-clisp
+ ((8 64) (6 36) (4 16) (2 4) (0 0))
+ #+clisp
+ ((0 0) (2 4) (4 16) (6 36) (8 64)))
+
+;;; with-hash-table-iterator
+
+(my-assert
+ (defun test-hash-table-iterator (hash-table)
+   (let ((all-entries '())
+	 (generated-entries '())
+	 (unique (list nil)))
+     (maphash #'(lambda (key value) (push (list key value) all-entries))
+	      hash-table)
+     (with-hash-table-iterator (generator-fn hash-table)
+			       (loop
+				 (multiple-value-bind (more? key value) (generator-fn)
+				   (unless more? (return))
+				   (unless (eql value (gethash key hash-table unique))
+				     (error "Key ~S not found for value ~S" key value))
+				   (push (list key value) generated-entries))))
+     (unless (= (length all-entries)
+		(length generated-entries)
+		(length (union all-entries generated-entries
+			       :key #'car :test (hash-table-test hash-table))))
+       (error "Generated entries and Maphash entries don't correspond"))
+     t))
+ test-hash-table-iterator)
+
+(my-assert
+ (test-hash-table-iterator table)
+ t)
+
+;;; clrhash
+
+(setq table (make-hash-table))
+
+(my-assert
+ (dotimes (i 100) (setf (gethash i table) (format nil "~R" i)))
+ NIL)
+
+(my-assert
+ (hash-table-count table)
+ 100)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 57 table)
+   (list a b))
+ ("fifty-seven" t))
+
+(clrhash table)
+
+(my-assert
+ (hash-table-count table)
+ 0)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (gethash 57 table)
+   (list a b))
+ ( NIL nil))
+
+;;; sxhash
+
+(my-assert
+ (= (sxhash (list 'list "ab")) (sxhash (list 'list "ab")))
+ t)
+
+
+(my-assert
+ (= (sxhash "a") (sxhash (make-string 1 :initial-element #\a)))
+ t)
+
+
+(my-assert
+ (let ((r (make-random-state)))
+   (= (sxhash r) (sxhash (make-random-state r))))
+ t)
+
+
+
+
+
+
+
+
+
diff --git a/src/ansi-tests/section19.lisp b/src/ansi-tests/section19.lisp
new file mode 100644
index 000000000..c30bcf82d
--- /dev/null
+++ b/src/ansi-tests/section19.lisp
@@ -0,0 +1,6 @@
+;;; section 19: filenames -*- mode: lisp -*-
+(in-package :cl-user)
+
+
+;; nothing that meaningfull to test...
+
diff --git a/src/ansi-tests/section2.lisp b/src/ansi-tests/section2.lisp
new file mode 100644
index 000000000..0d50293ab
--- /dev/null
+++ b/src/ansi-tests/section2.lisp
@@ -0,0 +1,162 @@
+;;; 2.1.4.5.1 examples of mutiple escape characters -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+(my-assert
+ (eq 'abc 'ABC)
+ T)
+
+(my-assert
+ (eq 'abc '|ABC|)
+ T)
+
+(my-assert
+ (eq 'abc 'a|B|c)
+ T)
+
+(my-assert
+ (eq 'abc '|abc|)
+ nil)
+
+;;; 2.1.4.6.1
+(my-assert
+ (eq 'abc '\A\B\C)
+ T)
+
+(my-assert
+ (eq 'abc 'a\Bc)
+ T)
+
+(my-assert
+ (eq 'abc '\ABC)
+ T)
+
+(my-assert
+ (eq 'abc '\abc)
+ nil)
+
+;;; 2.1.4.7.1
+(my-assert
+ (length '(this-that))
+ 1)
+
+(my-assert
+ (length '(this - that))
+ 3)
+
+(my-assert
+ (length '(a
+           b))
+ 2)
+
+(my-assert
+ (+ 34)
+ 34)
+
+(my-assert
+ (+ 3 4)
+ 7)
+
+;;; 2.4.1
+
+(my-assert
+ (cons 'this-one 'that-one)
+ (this-one . that-one))
+
+
+;;; 2.4.3.1
+
+(my-assert
+ 'foo
+ FOO)
+
+(my-assert
+ ''foo
+ (QUOTE FOO))
+
+(my-assert
+ (car ''foo)
+ QUOTE)
+
+;;; 2.4.4.1
+
+(my-assert
+ (+ 3					; three
+    4)
+ 7)
+
+;;; 2.4.8.7
+
+(my-assert
+ #B1101
+ 13 )
+
+(my-assert
+ #b101/11
+ 5/3)
+
+;;; 2.4.8.8
+(my-assert
+ #o37/15
+ 31/13)
+
+(my-assert
+ #o777
+ 511)
+
+(my-assert
+ #o105
+ 69)
+
+;;; 2.4.8.9
+(my-assert
+ #xF00
+ 3840             )
+
+(my-assert
+ #x105
+ 261 )
+
+;;; 2.4.8.10
+(my-assert
+ #2r11010101
+ 213)
+
+(my-assert
+ #b11010101
+ 213)
+
+(my-assert
+ #b+11010101
+ 213)
+
+(my-assert
+ #o325
+ 213)
+
+(my-assert
+ #xD5
+ 213)
+
+(my-assert
+ #16r+D5
+ 213)
+
+(my-assert
+ #o-300
+ -192)
+
+(my-assert
+ #3r-21010
+ -192)
+
+(my-assert
+ #25R-7H
+ -192)
+
+(my-assert
+ #xACCEDED
+ 181202413)
+
+
diff --git a/src/ansi-tests/section20.lisp b/src/ansi-tests/section20.lisp
new file mode 100644
index 000000000..2adc76d35
--- /dev/null
+++ b/src/ansi-tests/section20.lisp
@@ -0,0 +1,6 @@
+;;; section 20 : files -*- mode: lisp -*-
+(in-package :cl-user)
+
+
+;;;  too much trouble. too much external stuff
+
diff --git a/src/ansi-tests/section21.lisp b/src/ansi-tests/section21.lisp
new file mode 100644
index 000000000..7230f0131
--- /dev/null
+++ b/src/ansi-tests/section21.lisp
@@ -0,0 +1,116 @@
+;;; section 21: streams -*- mode: lisp -*-
+(in-package :cl-user)
+
+
+(my-assert
+ (subtypep 'stream 't)
+ t)
+
+(my-assert
+ (subtypep 'broadcast-stream 'stream)
+ t)
+
+(my-assert
+ (subtypep 'concatenated-stream 'stream)
+ t)
+
+(my-assert
+ (subtypep 'echo-stream 'stream)
+ t)
+
+(my-assert
+ (subtypep 'file-stream 'stream)
+ t)
+
+(my-assert
+ (subtypep 'string-stream 'stream)
+ t)
+
+(my-assert
+ (subtypep 'synonym-stream 'stream)
+ t)
+
+(my-assert
+ (subtypep 'two-way-stream 'stream)
+ t)
+
+
+;;; input-stream-p
+
+(my-assert
+ (input-stream-p *standard-input*)
+ t)
+
+(my-assert
+ (input-stream-p *terminal-io*)
+ t)
+
+(my-assert
+ (input-stream-p (make-string-output-stream))
+ nil)
+
+(my-assert
+ (output-stream-p *standard-output*)
+ t)
+
+(my-assert
+ (output-stream-p *terminal-io*)
+ t)
+
+(my-assert
+ (output-stream-p (make-string-input-stream "jr"))
+ nil)
+
+;;; open-stream-p
+
+(my-assert
+ (open-stream-p *standard-input*)
+ t)
+
+;;; read-byte
+
+(my-assert
+ (with-open-file (s "/tmp/temp-bytes"
+		    :direction :output
+		    :element-type 'unsigned-byte)
+		 (write-byte 101 s))
+ 101)
+
+(my-assert
+ (with-open-file (s "/tmp/temp-bytes" :element-type 'unsigned-byte)
+		 (list (read-byte s) (read-byte s nil 'eof)))
+ (101 EOF))
+
+;;; peek-char
+
+(my-assert
+ (with-input-from-string (input-stream "    1 2 3 4 5")
+			 (list (peek-char t input-stream)
+			       (peek-char #\4 input-stream)
+			       (peek-char nil input-stream)))
+ (#\1 #\4 #\4))
+
+;;; read-char
+
+(my-assert
+ (with-input-from-string (is "0123")
+			 (let ((a nil))
+			   (do ((c (read-char is) (read-char is nil 'the-end)))
+			       ((not (characterp c)))
+			     (setq a (cons c a)))
+			   a))
+ (#\3 #\2 #\1 #\0))
+
+;;; make-concatenated-stream
+
+(my-assert
+ (read (make-concatenated-stream
+	(make-string-input-stream "1")
+	(make-string-input-stream "2")))
+ 12)
+
+
+
+
+
+
diff --git a/src/ansi-tests/section22.lisp b/src/ansi-tests/section22.lisp
new file mode 100644
index 000000000..f46189b71
--- /dev/null
+++ b/src/ansi-tests/section22.lisp
@@ -0,0 +1,203 @@
+;;; section 22: printer -*- mode: lisp -*-
+(in-package :cl-user)
+
+
+;;; from : Raymond Toy <toy@rtp.ericsson.se>
+(my-assert
+ (format nil "~V,,,'-A" 10 "abc")
+ "abc-------")
+					; 0123456789
+
+(my-assert
+ (format nil "foo")
+ "foo")
+
+(my-assert
+ (setq x 5)
+ 5)
+
+(my-assert
+ (format nil "The answer is ~D." x)
+ "The answer is 5.")
+
+(my-assert
+ (format nil "The answer is ~3D." x)
+ "The answer is   5.")
+
+(my-assert
+ (format nil "The answer is ~3,'0D." x)
+ "The answer is 005.")
+
+(my-assert
+ (format nil "The answer is ~:D." (expt 47 x))
+ "The answer is 229,345,007.")
+
+(my-assert
+ (setq y "elephant")
+ "elephant")
+
+(my-assert
+ (format nil "Look at the ~A!" y)
+ "Look at the elephant!")
+
+(my-assert
+ (setq n 3)
+ 3)
+
+(my-assert
+ (format nil "~D item~:P found." n)
+ "3 items found.")
+
+(my-assert
+ (format nil "~R dog~:[s are~; is~] here." n (= n 1))
+ "three dogs are here.")
+
+(my-assert
+ (format nil "~R dog~:*~[s are~; is~:;s are~] here." n)
+ "three dogs are here.")
+
+(my-assert
+ (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n)
+ "Here are three puppies.")
+
+(my-assert
+ (defun foo (x)
+   (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F"
+           x x x x x x))
+ FOO)
+
+(my-assert
+ (foo 3.14159)
+ "  3.14| 31.42|  3.14|3.1416|3.14|3.14159")
+
+(my-assert
+ (foo -3.14159)
+ " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159")
+
+(my-assert
+ (foo 100.0)
+ "100.00|******|100.00| 100.0|100.00|100.0")
+
+(my-assert
+ (foo 1234.0)
+ "1234.00|******|??????|1234.0|1234.00|1234.0")
+
+(my-assert
+ (foo 0.006)
+ "  0.01|  0.06|  0.01| 0.006|0.01|0.006")
+
+(my-assert
+ (defun foo (x)
+   (format nil
+           "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~
+            ~9,3,2,-2,'%@E|~9,2E"
+           x x x x))
+ FOO)
+
+(my-assert
+ (foo 3.14159)
+ "  3.14E+0| 31.42$-01|+.003E+03|  3.14E+0")
+
+(my-assert
+ (foo -3.14159)
+ " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0")
+
+(my-assert
+ (foo 1100.0)
+ "  1.10E+3| 11.00$+02|+.001E+06|  1.10E+3")
+
+(my-assert
+ (foo 1100.0L0)
+ #-(or cmu sbcl) "  1.10L+3| 11.00$+02|+.001L+06|  1.10L+3"
+ #+(or cmu sbcl) "  1.10d+3| 11.00$+02|+.001d+06|  1.10d+3")
+
+(my-assert
+ (foo 1.1E13)
+ "*********| 11.00$+12|+.001E+16| 1.10E+13")
+
+(my-assert
+ (foo 1.1L120)
+ #-(or cmu sbcl) "*********|??????????|%%%%%%%%%|1.10L+120"
+ #+(or cmu sbcl) "*********|??????????|%%%%%%%%%|1.10d+120")
+
+(my-assert
+ (defun foo (x)
+   (format nil "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G"
+	   x x x x))
+ foo)
+
+(my-assert
+ (foo 0.0314159)
+ "  3.14E-2|314.2$-04|0.314E-01|  3.14E-2")
+
+(my-assert
+ (foo 0.314159)
+ "  0.31   |0.314    |0.314    | 0.31    ")
+
+(my-assert
+ (foo 3.14159)
+ "   3.1   | 3.14    | 3.14    |  3.1    ")
+
+(my-assert
+ (foo 31.4159)
+ "   31.   | 31.4    | 31.4    |  31.    ")
+
+(my-assert
+ (foo 314.159)
+ "  3.14E+2| 314.    | 314.    |  3.14E+2")
+
+(my-assert
+ (foo 3141.59)
+ "  3.14E+3|314.2$+01|0.314E+04|  3.14E+3")
+
+(my-assert
+ (foo 3141.59L0)
+ #-(or cmu sbcl) "  3.14L+3|314.2$+01|0.314L+04|  3.14L+3"
+ #+(or cmu sbcl) "  3.14d+3|314.2$+01|0.314d+04|  3.14d+3")
+
+(my-assert
+ (foo 3.14E12)
+ "*********|314.0$+10|0.314E+13| 3.14E+12")
+
+(my-assert
+ (foo 3.14L120)
+ #-(or cmu sbcl) "*********|?????????|%%%%%%%%%|3.14L+120"
+ #+(or cmu sbcl) "*********|?????????|%%%%%%%%%|3.14d+120")
+
+(my-assert
+ (format nil "~10<foo~;bar~>")
+ "foo    bar")
+
+(my-assert
+ (format nil "~10:<foo~;bar~>")
+ "  foo  bar")
+
+(my-assert
+ (format nil "~10<foobar~>")
+ "    foobar")
+
+(my-assert
+ (format nil "~10:<foobar~>")
+ "    foobar")
+
+(my-assert
+ (format nil "~10:@<foo~;bar~>")
+ #+(or sbcl cmu ecls)
+ " foo bar  "
+ #+clisp
+ "  foo bar "
+ #-(or sbcl cmu clisp ecls)
+ fill-this-in)
+ 
+(my-assert
+ (format nil "~10@<foobar~>")
+ "foobar    ")
+
+(my-assert
+ (format nil "~10:@<foobar~>")
+ "  foobar  ")
+
+(my-assert
+ (FORMAT NIL "Written to ~A." #P"foo.bin")
+ "Written to foo.bin.")
+
diff --git a/src/ansi-tests/section3.lisp b/src/ansi-tests/section3.lisp
new file mode 100644
index 000000000..6a1658731
--- /dev/null
+++ b/src/ansi-tests/section3.lisp
@@ -0,0 +1,1073 @@
+;;; 3.1.2.1.1.4 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+(if (boundp 'x2q) (makunbound 'x2q) 'ok)
+
+(my-assert
+ (let ((x2q 1))				;Binds a special variable X
+   (declare (special x2q))
+   (let ((x2q 2))			;Binds a lexical variable X
+     (+ x2q				;Reads a lexical variable X
+	(locally (declare (special x2q))
+                 x2q))))		;Reads a special variable X
+ 3)
+
+(if (boundp 'x3q) (makunbound 'x3q) 'ok)
+
+(my-assert
+ (progn
+   (defun two-funs (x3q)
+     (list (function (lambda () x3q))
+	   (function (lambda (y) (setq x3q y)))))
+   (setq funs (two-funs 6))
+   T)
+ T)
+
+(my-assert
+ (funcall (car funs))
+ 6)
+
+(my-assert
+ (funcall (cadr funs) 43)
+ 43)
+
+(my-assert
+ (funcall (car funs))
+ 43)
+
+;;; 3.1.5
+(my-assert
+ (progn
+   (defun contorted-example (f g x)
+     (if (= x 0)
+	 (funcall f)
+	 (block here
+	   (+ 5 (contorted-example g
+				   #'(lambda () (return-from here 4))
+				   (- x 1))))))
+   t)
+ T)
+
+(my-assert
+ (contorted-example nil nil 2)
+ 4)
+
+
+(my-assert
+ (progn
+   (defun contorted-example (f g x)
+     (if (= x 0)
+	 (funcall g)
+	 (block here
+	   (+ 5 (contorted-example g
+				   #'(lambda () (return-from here 4))
+				   (- x 1))))))
+   t)
+ T)
+
+(my-assert
+ (contorted-example nil nil 2)
+ 9)
+
+;;; 3.1.6
+
+(my-assert
+ (progn
+   (defun invalid-example ()
+     (let ((y (block here #'(lambda (z) (return-from here z)))))
+       (if (numberp y) y (funcall y 5))))
+   T)
+ T)
+
+(my-assert
+ (invalid-example)
+ CONTROL-ERROR)
+
+(my-assert
+ (progn
+   (defun fun1 (x)
+     (catch 'trap (+ 3 (fun2 x))))
+   (defun fun2 (y)
+     (catch 'trap (* 5 (fun3 y))))
+   (defun fun3 (z)
+     (throw 'trap z))
+   T)
+ T)
+
+(my-assert
+ (fun1 7)
+ 10)
+
+;;; 3.3.4.1
+
+(unintern 'x)
+
+(my-assert
+ (let ((x 1))
+   (declare (special x))
+   (let ((x 2))
+     (let ((old-x x)
+           (x 3))
+       (declare (special x))
+       (list old-x x))))
+ (2 3)
+ "The first declare is only valid in it's
+block. The (let ((x 2)) is a new block,
+where x is not special anymore.")
+
+(if (boundp 'x) (makunbound 'x) 'ok)
+
+(my-assert
+ (let ((x4q  1))			;[1]
+   (declare (special x4q))		;[2]
+   (let ((x4q 2))			;[3]
+     (dotimes (i x4q x4q)		;[4]
+       (declare (special x4q)))))	;[5]
+ 1)
+
+
+(if (boundp 'x) (makunbound 'x) 'ok)
+
+;;; 3.4.1.4.1.1
+
+
+(my-assert
+ ((lambda (&key x) x) :x 1 :y 2 :allow-other-keys t)
+ 1)
+
+(my-assert
+ ((lambda (&key x &allow-other-keys) x) :x 1 :y 2)
+ 1)
+
+(my-assert
+ ((lambda (&key) t) :allow-other-keys nil)
+ T)
+
+(my-assert
+ ((lambda (&key x) x)
+  :x 1 :y 2 :allow-other-keys t :allow-other-keys nil)
+ 1)
+
+(my-assert
+ ((lambda (&key x) x)                   ;This call is not valid
+  :x 1 :y 2 :allow-other-keys nil :allow-other-keys t)
+ PROGRAM-ERROR
+ "See 3.5.1.4:
+If this situation occurs in a safe call, an error of type
+program-error must be signaled; and in an unsafe call the
+situation has undefined consequences. ");; from 3.5.1.4
+
+;;; 3.4.1.6
+
+
+(my-assert
+ ((lambda (a b) (+ a (* b 3))) 4 5)
+ 19)
+
+(my-assert
+ ((lambda (a &optional (b 2)) (+ a (* b 3))) 4 5)
+ 19)
+
+(my-assert
+ ((lambda (a &optional (b 2)) (+ a (* b 3))) 4)
+ 10)
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)))
+ (2 NIL 3 NIL NIL))
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6)
+ (6 T 3 NIL NIL))
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3)
+ (6 T 3 T NIL))
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3 8)
+ (6 T 3 T (8)))
+
+(my-assert
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x))
+  6 3 8 9 10 11)
+ (6 t 3 t (8 9 10 11)))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2)
+ (1 2 NIL NIL))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :c 6)
+ (1 2 6 NIL))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :d 8)
+ (1 2 NIL 8))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :c 6 :d 8)
+ (1 2 6 8))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :d 8 :c 6)
+ (1 2 6 8))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) :a 1 :d 8 :c 6)
+ (:a 1 6 8))
+
+(my-assert
+ ((lambda (a b &key c d) (list a b c d)) :a :b :c :d)
+ (:a :b :d NIL))
+
+(my-assert
+ ((lambda (a b &key ((:sea c)) d) (list a b c d)) 1 2 :sea 6)
+ (1 2 6 NIL))
+
+(my-assert
+ ((lambda (a b &key ((c c)) d) (list a b c d)) 1 2 'c 6)
+ (1 2 6 NIL)
+ "3.4.1.4: ...
+If the notation ((keyword-name var) init-form) is used,
+then the keyword name used to match arguments to
+parameters is keyword-name, which may
+be a symbol in any package. ...
+")
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1)
+ (1 3 NIL 1 ()) )
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1 2)
+ (1 2 NIL 1 ()))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) :c 7)
+ (:c 7 NIL :c ()))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1 6 :c 7)
+ (1 6 7 1 (:c 7)))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1 6 :d 8)
+ (1 6 NIL 8 (:d 8)))
+
+(my-assert
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1 6 :d 8 :c 9 :d 10)
+ (1 6 9 8 (:d 8 :c 9 :d 10)))
+
+;;;; eval function
+					;(let ((form2p5 nil)
+					;      (a2p5 nil))
+
+					;  (my-assert
+					;   (setq form2p5 '(1+ a2p5) a2p5 999)
+					;   999)
+
+					;  (my-assert
+					;   (eval form2p5)
+					;   1000)
+
+					;  (my-assert
+					;   (eval 'form2p5)
+					;   (1+ A2p5))
+
+					;  (my-assert
+					;   (let ((a2p5 '(this would break if eval used local value)))
+					;     (eval form2p5))
+					;   1000))
+
+;;; quote
+(my-assert
+ (let ((a 1)) 
+   a)
+ 1)
+
+(my-assert
+ (let ((a 1)) 
+ (quote (setq a 3)))
+ (SETQ A 3))
+
+(my-assert
+ (let ((a 1)) 
+ (quote (setq a 3)))
+ a)
+ 1)
+
+(my-assert
+ (let ((a 1)) 
+ (quote (setq a 3)))
+ 'a)
+ A)
+
+(my-assert
+ (let ((a 1)) 
+ (quote (setq a 3)))
+ ''a)
+ (QUOTE A) )
+
+(my-assert
+ (let ((a 1)) 
+ (quote (setq a 3)))
+ '''a)
+ (QUOTE (QUOTE A)))
+
+(my-assert
+ (let ((a 43))
+   a)
+ 43)
+
+(my-assert
+ (let ((a 43))
+  (list a (cons a 3)))
+ (43 (43 . 3)))
+
+(my-assert
+ (let ((a 43))
+  (list a (cons a 3))
+  (list (quote a) (quote (cons a 3))))
+ (A (CONS A 3)) )
+
+
+(my-assert
+ 1
+ 1)
+
+(my-assert
+ '1
+ 1)
+
+(my-assert
+ '"foo"
+ "foo")
+
+(my-assert
+ (car '(a b))
+ A)
+
+(my-assert
+ '(car '(a b))
+ (CAR (QUOTE (A B))))
+
+(my-assert
+ #(car '(a b))
+ #(CAR (QUOTE (A B))))
+
+(my-assert
+ '#(car '(a b))
+ #(CAR (QUOTE (A B))))
+
+;;; define-compiler-macro
+(my-assert
+ (defun square (x) (expt x 2))
+ SQUARE)
+
+(my-assert
+ (define-compiler-macro square (&whole form arg)
+   (if (atom arg)
+       `(expt ,arg 2)
+       (case (car arg)
+	 (square (if (= (length arg) 2)
+		     `(expt ,(nth 1 arg) 4)
+		     form))
+	 (expt   (if (= (length arg) 3)
+		     (if (numberp (nth 2 arg))
+			 `(expt ,(nth 1 arg) ,(* 2 (nth 2 arg)))
+			 `(expt ,(nth 1 arg) (* 2 ,(nth 2 arg))))
+		     form))
+	 (otherwise `(expt ,arg 2)))))
+ SQUARE)
+
+(my-assert
+ (square (square 3))
+ 81)
+
+(my-assert
+ (macroexpand '(square x))
+ (SQUARE X))				;  f
+
+(if (boundp 'x) (makunbound 'x) 'ok)
+
+(my-assert
+ (funcall (compiler-macro-function 'square) '(square x) nil)
+ (EXPT X 2))
+
+(my-assert
+ (funcall (compiler-macro-function 'square) '(square (square x)) nil)
+ (EXPT X 4))
+
+(my-assert
+ (funcall (compiler-macro-function 'square) '(funcall #'square x) nil)
+ (EXPT X 2)
+ "define-compiler-macro:
+... but if the car of the actual form is the symbol funcall,
+then the destructuring of the arguments
+is actually performed using its cddr instead")
+
+;;; defmacro
+(my-assert
+ (defmacro mac1 (a b) "Mac1 multiplies and adds"
+   `(+ ,a (* ,b 3)))
+ MAC1 )
+
+(my-assert
+ (mac1 4 5)
+ 19 )
+
+(my-assert
+ (documentation 'mac1 'function)
+ "Mac1 multiplies and adds" )
+
+(my-assert
+ (defmacro mac2 (&optional (a 2 b) (c 3 d) &rest x)
+   `'(,a ,b ,c ,d ,x))
+ MAC2 )
+
+(my-assert
+ (mac2 6)
+ (6 T 3 NIL NIL) )
+
+(my-assert
+ (mac2 6 3 8)
+ (6 T 3 T (8)) )
+
+(my-assert
+ (defmacro mac3 (&whole r a &optional (b 3) &rest x &key c (d a))
+   `'(,r ,a ,b ,c ,d ,x))
+ MAC3 )
+
+(my-assert
+ (mac3 1 6 :d 8 :c 9 )
+ ((MAC3 1 6 :D 8 :C 9 ) 1 6 9 8 (:D 8 :C 9)) )
+
+;;; part II
+(my-assert
+ (progn
+   (defmacro dm1a (&whole x) `',x)
+   t)
+ t)
+
+(my-assert
+ (macroexpand '(dm1a))
+ (QUOTE (DM1A)))
+
+(my-assert
+ (macroexpand '(dm1a a))
+ ERROR)
+
+(my-assert
+ (progn
+   (defmacro dm1b (&whole x a &optional b) `'(,x ,a ,b))
+   t)
+ t)
+
+(my-assert
+ (macroexpand '(dm1b))
+ ERROR)
+
+(my-assert
+ (macroexpand '(dm1b q))
+ (QUOTE ((DM1B Q) Q NIL)))
+
+(my-assert
+ (macroexpand '(dm1b q r))
+ (QUOTE ((DM1B Q R) Q R)))
+
+(my-assert
+ (macroexpand '(dm1b q r s))
+ ERROR)
+
+(my-assert
+ (progn
+   (defmacro dm2a (&whole form a b) `'(form ,form a ,a b ,b))
+   t)
+ t)
+
+(my-assert
+ (macroexpand '(dm2a x y))
+ (QUOTE (FORM (DM2A X Y) A X B Y)))
+
+(my-assert
+ (dm2a x y)
+ (FORM (DM2A X Y) A X B Y))
+
+(my-assert
+ (progn
+   (defmacro dm2b (&whole form a (&whole b (c . d) &optional (e 5))
+			  &body f &environment env)
+     ``(,',form ,,a ,',b ,',(macroexpand c env) ,',d ,',e ,',f))
+   t)
+ t)
+
+					;Note that because backquote is involved, implementations may differ
+					;slightly in the nature (though not the functionality) of the expansion.
+
+					;(my-assert
+					;(macroexpand '(dm2b x1 (((incf x2) x3 x4)) x5 x6))
+					;#+(or cmu sbcl sbcl) `((DM2B X1 (((INCF X2) X3 X4)) X5 X6) ,X1 (((INCF X2) X3 X4))
+					;	(LET* ((#:G411 (+ X2 1)))
+					;	      (SETQ X2 #:G411))
+					;	(X3 X4) 5 (X5 X6))
+					;#-(or cmu sbcl sbcl) (LIST* '(DM2B X1 (((INCF X2) X3 X4))
+					;                   X5 X6)
+					;            X1
+					;            '((((INCF X2) X3 X4)) (SETQ X2 (+ X2 1)) (X3 X4) 5 (X5 X6))))
+
+(my-assert
+ (let ((x1 5))
+   (macrolet ((segundo (x) `(cadr ,x)))
+     (dm2b x1 (((segundo x2) x3 x4)) x5 x6)))
+ ((DM2B X1 (((SEGUNDO X2) X3 X4)) X5 X6)
+  5 (((SEGUNDO X2) X3 X4)) (CADR X2) (X3 X4) 5 (X5 X6)))
+
+;;; macrofunction
+
+(my-assert
+ (defmacro macfun (x) '(macro-function 'macfun))
+ MACFUN )
+
+(my-assert
+ (not (macro-function 'macfun))
+ nil)
+
+(my-assert
+ (macrolet ((foo (&environment env)
+		 (if (macro-function 'bar env)
+		     ''yes
+		     ''no)))
+   (list (foo)
+	 (macrolet ((bar () :beep))
+	   (foo))))
+ (NO YES))
+
+;;; macroexpand
+
+(my-assert
+ (defmacro alpha (x y) `(beta ,x ,y))
+ ALPHA)
+
+(my-assert
+ (defmacro beta (x y) `(gamma ,x ,y))
+ BETA)
+
+(my-assert
+ (defmacro delta (x y) `(gamma ,x ,y))
+ DELTA)
+
+(my-assert
+ (defmacro expand (form &environment env)
+   (multiple-value-bind (expansion expanded-p)
+       (macroexpand form env)
+     `(values ',expansion ',expanded-p)))
+ EXPAND)
+
+(my-assert
+ (defmacro expand-1 (form &environment env)
+   (multiple-value-bind (expansion expanded-p)
+       (macroexpand-1 form env)
+     `(values ',expansion ',expanded-p)))
+ EXPAND-1)
+
+;; Simple examples involving just the global environment
+(my-assert
+ (multiple-value-bind (a b)
+     (macroexpand-1 '(alpha a b))
+   (list a b))
+ ((BETA A B) T))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (expand-1 (alpha a b))
+   (list a b))
+ ((BETA A B) T))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (macroexpand '(alpha a b))
+   (list a b))
+ ((GAMMA A B) T))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (expand (alpha a b))
+   (list a b))
+ ((GAMMA A B) T))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (macroexpand-1 'not-a-macro)
+   (list a b))
+ (NOT-A-MACRO nil))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (expand-1 not-a-macro)
+   (list a b))
+ (NOT-A-MACRO nil) )
+
+(my-assert
+ (multiple-value-bind (a b)
+     (macroexpand '(not-a-macro a b))
+   (list a b))
+ ((NOT-A-MACRO A B) nil))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (expand (not-a-macro a b))
+   (list a b))
+ ((NOT-A-MACRO A B) nil))
+
+;; Examples involving lexical environments
+
+(my-assert
+ (multiple-value-bind (n h)
+     (macrolet ((alpha (x y) `(delta ,x ,y)))
+       (macroexpand-1 '(alpha a b)))
+   (list n h))
+ ((BETA A B) T))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (macrolet ((alpha (x y) `(delta ,x ,y)))
+       (expand-1 (alpha a b)))
+   (list n h))
+ ((DELTA A B) T))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (macrolet ((alpha (x y) `(delta ,x ,y)))
+       (macroexpand '(alpha a b)))
+   (list n h))
+ ((GAMMA A B) T))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (macrolet ((alpha (x y) `(delta ,x ,y)))
+       (expand (alpha a b)))
+   (list n h))
+ ((GAMMA A B) T))
+
+
+(my-assert
+ (multiple-value-bind (n h)
+     (macrolet ((beta (x y) `(epsilon ,x ,y)))
+       (expand (alpha a b)))
+   (list n h))
+ ((EPSILON A B) T))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (let ((x (list 1 2 3)))
+       (symbol-macrolet ((a (first x)))
+	 (expand a)))
+   (list n h))
+ error
+ "A has been declared special, thus SYMBOL-MACROLET may not bind it")
+
+(my-assert
+ (multiple-value-bind (n h)
+     (let ((x (list 1 2 3)))
+       (symbol-macrolet ((a-new (first x)))
+	 (expand a-new)))
+   (list n h))
+ ((FIRST X) T))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (let ((x (list 1 2 3)))
+       (symbol-macrolet ((a (first x)))
+	 (macroexpand 'a)))
+   (list n h))
+ error
+ "A has been declared special, thus SYMBOL-MACROLET may not bind it")
+
+(my-assert
+ (multiple-value-bind (n h)
+     (let ((x (list 1 2 3)))
+       (symbol-macrolet ((a-new (first x)))
+	 (macroexpand 'a-new)))
+   (list n h))
+ (a-new nil))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (symbol-macrolet ((b (alpha x y)))
+       (expand-1 b))
+   (list n h))
+ error
+ "B has been declared special, thus SYMBOL-MACROLET may not bind it")
+
+(my-assert
+ (multiple-value-bind (n h)
+     (symbol-macrolet ((b-new (alpha x y)))
+       (expand-1 b-new))
+   (list n h))
+ ((ALPHA X Y)  T))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (symbol-macrolet ((b (alpha x y)))
+       (expand b))
+   (list n h))
+ error
+ "B has been declared special, thus SYMBOL-MACROLET may not bind it")
+
+(my-assert
+ (multiple-value-bind (n h)
+     (symbol-macrolet ((b-new (alpha x y)))
+       (expand b-new))
+   (list n h))
+ ((GAMMA X Y) T))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (symbol-macrolet ((b (alpha x y))
+		       (a b))
+       (expand-1 a))
+   (list n h))
+ error
+ "A and B have been declared special, thus SYMBOL-MACROLET may not bind them")
+
+(my-assert
+ (multiple-value-bind (n h)
+     (symbol-macrolet ((b-new (alpha x y))
+		       (a-new b-new))
+       (expand-1 a-new))
+   (list n h))
+ (B-NEW T))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (symbol-macrolet ((b (alpha x y))
+		       (a b))
+       (expand a))
+   (list n h))
+ error
+ "A and B have been declared special, thus SYMBOL-MACROLET may not bind them")
+
+(my-assert
+ (multiple-value-bind (n h)
+     (symbol-macrolet ((b-new (alpha x y))
+		       (a-new b-new))
+       (expand a-new))
+   (list n h))
+ ((GAMMA X Y) T))
+
+;; Examples of shadowing behavior
+(my-assert
+ (multiple-value-bind (n h)
+     (flet ((beta (x y) (+ x y)))
+       (expand (alpha a b)))
+   (list n h))
+ ((BETA A B) T))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (macrolet ((alpha (x y) `(delta ,x ,y)))
+       (flet ((alpha (x y) (+ x y)))
+	 (expand (alpha a b))))
+   (list n h))
+ ((ALPHA A B) nil))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (let ((x (list 1 2 3)))
+       (symbol-macrolet ((a (first x)))
+	 (let ((a x))
+	   (expand a))))
+   (list n h))
+ error
+ "A has been declared special, thus SYMBOL-MACROLET may not bind it")
+
+(my-assert
+ (multiple-value-bind (n h)
+     (let ((x (list 1 2 3)))
+       (symbol-macrolet ((a-new (first x)))
+	 (let ((a-new x))
+	   (expand a-new))))
+   (list n h))
+ (a-new nil))
+
+;;; define-symbol-macro
+(my-assert
+ (defvar *things* (list 'alpha 'beta 'gamma))
+ *THINGS*)
+
+(my-assert
+ (fboundp 'define-symbol-macro)
+ T
+ "The macro DEFINE-SYMBOL-MACRO should exist")
+
+(my-assert
+ (define-symbol-macro thing1 (first *things*))
+ THING1)
+
+(my-assert
+ (define-symbol-macro thing2 (second *things*))
+ THING2)
+
+(my-assert
+ (define-symbol-macro thing3 (third *things*))
+ THING3)
+
+(my-assert
+ thing1
+ ALPHA)
+
+(my-assert
+ (setq thing1 'ONE)
+ ONE)
+
+(my-assert
+ *things*
+ (ONE BETA GAMMA))
+
+(my-assert
+ (multiple-value-setq (thing2 thing3) (values 'two 'three))
+ TWO)
+
+(my-assert
+ thing3
+ THREE)
+
+(my-assert
+ *things*
+ (ONE TWO THREE))
+
+(my-assert
+ (list thing2 (let ((thing2 2)) thing2))
+ (TWO 2))
+
+;;; *macrexpand-hook*
+
+(my-assert
+ (defun hook (expander form env)
+   (format t "Now expanding: ~S~%" form)
+   (funcall expander form env))
+ HOOK )
+
+(my-assert
+ (defmacro machook (x y) `(/ (+ ,x ,y) 2))
+ MACHOOK )
+
+(my-assert
+ (macroexpand '(machook 1 2))
+ (/ (+ 1 2) 2))				; true
+
+(my-assert
+ (let ((*macroexpand-hook* #'hook)) (macroexpand '(machook 1 2)))
+ (/ (+ 1 2) 2))				; true
+
+;;; special opperator
+
+(my-assert
+ (special-operator-p 'if)
+ T)
+
+(my-assert
+ (special-operator-p 'car)
+ nil)
+
+(my-assert
+ (special-operator-p 'one)
+ nil)
+
+
+(my-assert
+ (special-operator-p 'block)
+ T)
+
+(my-assert
+ (special-operator-p 'let*)
+ T)
+
+(my-assert
+ (special-operator-p 'return-from)
+ T)
+
+(my-assert
+ (special-operator-p 'catch)
+ T)
+
+(my-assert
+ (special-operator-p 'load-time-value)
+ T)
+
+(my-assert
+ (special-operator-p 'setq)
+ T)
+
+(my-assert
+ (special-operator-p 'eval-when)
+ T)
+
+(my-assert
+ (special-operator-p 'locally)
+ T
+ "locally is a special operator")
+
+(my-assert
+ (special-operator-p 'symbol-macrolet)
+ T)
+
+(my-assert
+ (special-operator-p 'flet)
+ T)
+
+(my-assert
+ (special-operator-p 'macrolet)
+ T)
+
+(my-assert
+ (special-operator-p 'tagbody)
+ T)
+
+(my-assert
+ (special-operator-p 'function)
+ T)
+
+(my-assert
+ (special-operator-p 'multiple-value-call)
+ T)
+
+(my-assert
+ (special-operator-p 'the)
+ T)
+
+(my-assert
+ (special-operator-p 'go)
+ T)
+
+(my-assert
+ (special-operator-p 'multiple-value-prog1)
+ T)
+
+(my-assert
+ (special-operator-p 'throw)
+ T)
+
+(my-assert
+ (special-operator-p 'progn)
+ T)
+
+(my-assert
+ (special-operator-p 'unwind-protect)
+ T)
+
+(my-assert
+ (special-operator-p 'labels)
+ T)
+
+(my-assert
+ (special-operator-p 'progv)
+ T)
+
+(my-assert
+ (special-operator-p 'let)
+ T)
+
+(my-assert
+ (special-operator-p 'quote)
+ T)
+
+;;; constantp
+
+(my-assert
+ (constantp 1)
+ T)
+
+(my-assert
+ (constantp 'temp)
+ nil)
+
+(my-assert
+ (constantp ''temp)
+ t)
+
+(my-assert
+ (defconstant this-is-a-constant 'never-changing)
+ THIS-IS-A-CONSTANT )
+
+(my-assert
+ (constantp 'this-is-a-constant)
+ t)
+
+(my-assert
+ (constantp "temp")
+ t)
+
+(my-assert
+ (let ((a 6))
+   a)
+ 6 )
+
+(my-assert
+ (let ((a 6))
+ (constantp a))
+ t)
+
+(my-assert
+ (constantp (values 37 Pi 'foo))
+ #+(or cmu sbcl sbcl clisp ecls) t
+ #-(or cmu sbcl sbcl clisp ecls) FILL-THIS-IN)
+
+
+(my-assert
+ (constantp '(sin pi))
+ #+(or cmu sbcl sbcl clisp ecls) nil
+ #-(or cmu sbcl sbcl clisp ecls) FILL-THIS-IN)
+
+(my-assert
+ (constantp '(car '(x)))
+ #+(or cmu sbcl sbcl clisp ecls) nil
+ #-(or cmu sbcl sbcl clisp ecls) FILL-THIS-IN)
+
+(my-assert
+ (constantp '(eql x x))
+ #+(or cmu sbcl sbcl clisp ecls) nil
+ #-(or cmu sbcl sbcl clisp ecls) FILL-THIS-IN)
+
+(my-assert
+ (constantp '(typep x 'nil))
+ #+(or cmu sbcl sbcl clisp ecls) nil
+ #-(or cmu sbcl sbcl clisp ecls) FILL-THIS-IN)
+
+(my-assert
+ (constantp '(typep x 't))
+ #+(or cmu sbcl sbcl clisp ecls) nil
+ #-(or cmu sbcl sbcl clisp ecls) FILL-THIS-IN)
+
+(my-assert
+ (constantp '(values this-is-a-constant))
+ #+(or cmu sbcl sbcl clisp ecls) nil
+ #-(or cmu sbcl sbcl clisp ecls) FILL-THIS-IN)
+
+(my-assert
+ (constantp '(values 'x 'y))
+ #+(or cmu sbcl sbcl clisp ecls) nil
+ #-(or cmu sbcl sbcl clisp ecls) FILL-THIS-IN)
+
+(my-assert
+ (constantp '(let ((a '(a b c))) (+ (length a) 6)))
+ #+(or cmu sbcl sbcl clisp ecls) nil
+ #-(or cmu sbcl sbcl clisp ecls) FILL-THIS-IN)
+
+
+
+
+
+
+
+
+
diff --git a/src/ansi-tests/section4.lisp b/src/ansi-tests/section4.lisp
new file mode 100644
index 000000000..1ac85a1e0
--- /dev/null
+++ b/src/ansi-tests/section4.lisp
@@ -0,0 +1,355 @@
+;;; types -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+;;coerce
+(my-assert
+ (coerce '(a b c) 'vector)
+ #(A B C))
+
+(my-assert
+ (coerce '(a b c) 'list)
+ (A B C))
+
+(my-assert
+ (coerce '(#\A #\B #\C) 'string)
+ "ABC")
+
+(my-assert
+ (coerce #(a b c) 'vector)
+ #(A B C))
+
+(my-assert
+ (coerce #(a b c) 'list)
+ (A B C))
+
+(my-assert
+ (coerce #(#\A #\B #\C) 'string)
+ "ABC")
+
+(my-assert
+ (coerce "ABC" 'vector)
+ #(#\A #\B #\C))
+
+(my-assert
+ (coerce "ABC" 'list)
+ (#\A #\B #\C))
+
+(my-assert
+ (coerce "ABC" 'string)
+ "ABC")
+
+(my-assert
+ (coerce '(a b c) '(vector * 3))
+ #(A B C))
+
+(my-assert
+ (coerce '(a b c) 'list)
+ (A B C))
+
+(my-assert
+ (coerce '(#\A #\B #\C) '(string 3))
+ "ABC")
+
+(my-assert
+ (coerce #(a b c) '(vector * 3))
+ #(A B C))
+
+(my-assert
+ (coerce #(a b c) 'list)
+ (A B C))
+
+(my-assert
+ (coerce #(#\A #\B #\C) '(string 3))
+ "ABC")
+
+(my-assert
+ (coerce "ABC" '(vector * 3))
+ #(#\A #\B #\C))
+
+(my-assert
+ (coerce "ABC" 'list)
+ (#\A #\B #\C))
+
+(my-assert
+ (coerce "ABC" '(string 3))
+ "ABC")
+
+(my-assert
+ (coerce 'a 'character)
+ #\A)
+
+(my-assert
+ (coerce 4.56 'complex)
+ #C(4.56 0.0))
+
+(my-assert
+ (coerce 4.5s0 'complex)
+ #C(4.5s0 0.0s0))
+
+(my-assert
+ (coerce 7/2 'complex)
+ 7/2)
+
+(my-assert
+ (coerce 0 'short-float)
+ 0.0s0)
+
+(my-assert
+ (coerce 3.5L0 'float)
+ 3.5L0)
+
+(my-assert
+ (coerce 7/2 'float)
+ 3.5)
+
+(my-assert
+ (coerce (cons 1 2) t)
+ (1 . 2))
+
+(my-assert
+ (coerce '(a b c) '(vector * 4))
+ type-error)
+
+(my-assert
+ (coerce #(a b c) '(vector * 4))
+ type-error)
+
+(my-assert
+ (coerce '(a b c) '(vector * 2))
+ type-error)
+
+(my-assert
+ (coerce #(a b c) '(vector * 2))
+ type-error)
+
+(my-assert
+ (coerce "foo" '(string 2))
+ type-error)
+
+(my-assert
+ (coerce #(#\a #\b #\c) '(string 2))
+ type-error)
+
+(my-assert
+ (coerce '(0 1) '(simple-bit-vector 3))
+ type-error)
+
+;; subtypep
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep 'compiled-function 'function)
+   (list a b))
+ (T T)
+ "Type COMPILED-FUNCTION 
+
+Supertypes:
+
+compiled-function, function, t
+...
+")
+
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep 'null 'list)
+   (list a b))
+ (T T))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep 'null 'symbol)
+   (list a b))
+ (T T))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep 'integer 'string)
+   (list a b))
+ (nil #-clisp T
+      #+clisp nil))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep '(satisfies dummy) nil)
+   (list a b))
+ (nil #-clisp t
+      #+clisp nil))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep '(integer 1 3) '(integer 1 4))
+   (list a b))
+ (T T))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep '(member) 'nil)
+   (list a b))
+ (T T))					;   true, true ;or false, false
+
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep 'nil '(member))
+   (list a b))
+ (T T))					; true, true ;or false, false
+
+;;; type-of
+
+(my-assert
+ (type-of 'a)
+ SYMBOL          )
+
+(my-assert
+ (type-of '(1 . 2))
+ CONS)
+					; OR=>  (CONS FIXNUM FIXNUM)
+
+(my-assert
+ (type-of #c(0 1))
+ #-cmu COMPLEX
+ #+cmu (COMPLEX BIT))
+					; OR=>  (COMPLEX INTEGER)
+
+(my-assert
+ (defstruct temp-struct x y z)
+ TEMP-STRUCT)
+
+(my-assert
+ (type-of (make-temp-struct))
+ TEMP-STRUCT)
+
+(my-assert
+ (type-of "abc")
+ #+(or cmu sbcl clisp)
+ (SIMPLE-BASE-STRING 3)
+ #-(or cmu sbcl clisp)
+ STRING)
+					; OR=>  (STRING 3)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep (type-of "abc") 'string)
+   (list a b))
+ (T T))
+
+(my-assert
+ (type-of (expt 2 40))
+ BIGNUM)
+					; OR=>  INTEGER
+					; OR=>  (INTEGER 1099511627776 1099511627776)
+					; OR=>  SYSTEM::TWO-WORD-BIGNUM
+					; OR=>  FIXNUM
+
+(my-assert
+ (multiple-value-bind (a b)
+     (subtypep (type-of 112312) 'integer)
+   (list a b))
+ (T T))
+
+(my-assert
+ (defvar *foo* (make-array 5 :element-type t))
+ *FOO*)
+
+(my-assert
+ (class-name (class-of *foo*))
+ #+(or cmu sbcl) SIMPLE-VECTOR
+ #-(or cmu sbcl) VECTOR)
+
+(my-assert
+ (type-of *foo*)
+ #+(or cmu sbcl clisp)
+ (SIMPLE-VECTOR 5)
+ #-(or cmu sbcl clisp)
+ VECTOR)
+					; OR=>  (VECTOR T 5)
+
+;;; typep
+
+(my-assert
+ (typep 12 'integer)
+ T)
+
+(my-assert
+ (typep (1+ most-positive-fixnum) 'fixnum)
+ nil)
+
+(my-assert
+ (typep nil t)
+ t)
+
+(my-assert
+ (typep nil nil)
+ nil)
+
+(my-assert
+ (typep 1 '(mod 2))
+ t )
+
+(my-assert
+ (typep #c(1 1) '(complex (eql 1)))
+ t )
+
+;; To understand this next example, you might need to refer to
+;; Section 12.1.5.3 (Rule of Canonical Representation for Complex Rationals).
+(my-assert
+ (typep #c(0 0) '(complex (eql 0)))
+ nil
+ "(upgraded-complex-part-type '(eql 0)) -> RATIONAL
+a subtype of REAL. So it should work.
+
+12.1.5.3:
+also #C(5 0) is eql to 5
+     #C(5.0 0.0) is not eql to 5.0
+CMUCL bombs here because of the eql. We give two
+replacement tests below:
+")
+
+(my-assert
+ (typep #c(1 1) 'complex)
+ T
+ "Because #C(1 1) remains an complex")
+
+(my-assert
+ (typep #c(3/2 0) 'complex)
+ NIL
+ "Because #C(3/2 0) is eql to 3/2")
+
+(my-assert
+ (typep #c(1 0) 'complex)
+ NIL
+ "Because #c(0 0) is eql to 0")
+
+(my-assert
+ (typep #c(0.0 0.0) 'complex)
+ T
+ "Because #c(0.0 0.0) remains a complex")
+
+;;; type-error-datum
+;;(my-assert
+;;(progn
+;;  (defun fix-digits (condition)
+;;    (check-type condition type-error)
+;;    (let* ((digits '(zero one two three four
+;;			  five six seven eight nine))
+;;	   (val (position (type-error-datum condition) digits)))
+;;      (if (and val (subtypep 'number (type-error-expected-type condition)))
+;;	  (store-value 7))))
+
+;;  (defun foo (x)
+;;    (handler-bind ((type-error #'fix-digits))
+;;		  (check-type x number)
+;;		  (+ x 3)))
+;;  t)
+;;t)
+
+;;(my-assert
+;;(foo 'seven)
+;;10)
+
+
+
+
+
+
+
diff --git a/src/ansi-tests/section5.lisp b/src/ansi-tests/section5.lisp
new file mode 100644
index 000000000..45659c968
--- /dev/null
+++ b/src/ansi-tests/section5.lisp
@@ -0,0 +1,2102 @@
+;;; section 5 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+;;; 5.1.1.1.1
+
+(my-assert
+ (let ((ref2 (list '())))
+   (push (progn (princ "1") 'ref1)
+	 (car (progn (princ "2") ref2))))
+ (REF1))
+
+#+nil
+(my-assert
+ (let (x)
+   (push (setq x (list 'a))
+	 (car (setq x (list 'b))))
+   x)
+ (((A) . B)))				;possible bug in hyperspec
+
+
+;;; apply
+(my-assert
+ (setq f '+)
+ +)
+
+(my-assert
+ (apply f '(1 2))
+ 3)
+
+(my-assert
+ (progn
+   (setq f #'-)
+   t)
+ t)
+
+(my-assert
+ (apply f '(1 2))
+ -1)
+
+(my-assert
+ (apply #'max 3 5 '(2 7 3))
+ 7)
+
+(my-assert
+ (apply 'cons '((+ 2 3) 4))
+ ((+ 2 3) . 4))
+
+(my-assert
+ (apply #'+ '())
+ 0)
+
+(my-assert
+ (defparameter *some-list* '(a b c))
+ *SOME-LIST*)
+
+(my-assert
+ (defun strange-test (&rest x) (eq x *some-list*))
+ STRANGE-TEST)
+
+(my-assert
+ (apply #'strange-test *some-list*)
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in )
+
+;;(my-assert
+;;(defun foo (size &rest keys &key double &allow-other-keys)
+;;   (let ((v (apply #'make-array size :allow-other-keys t keys)))
+;;     (if double (concatenate (type-of v) v v) v)))
+;;FOO)
+
+;;(my-assert
+;;(foo 4 :initial-contents '(a b c d) :double t)
+;;#(A B C D A B C D))
+
+;;; defun
+
+(my-assert
+ (defun recur (x)
+   (when (> x 0)
+     (recur (1- x))))
+ RECUR )
+
+(my-assert
+ (defun ex (a b &optional c (d 66) &rest keys &key test (start 0))
+   (list a b c d keys test start))
+ EX )
+
+(my-assert
+ (ex 1 2)
+ (1 2 NIL 66 NIL NIL 0))
+
+(my-assert
+ (ex 1 2 3 4 :test 'equal :start 50)
+ (1 2 3 4 (:TEST EQUAL :START 50) EQUAL 50))
+
+(my-assert
+ (ex :test 1 :start 2)
+ (:TEST 1 :START 2 NIL NIL 0))
+
+;; This function assumes its callers have checked the types of the
+;; arguments, and authorizes the compiler to build in that assumption.
+(my-assert
+ (defun discriminant (a b c)
+   (declare (number a b c))
+   "Compute the discriminant for a quadratic equation."
+   (- (* b b) (* 4 a c)))
+ DISCRIMINANT)
+
+(my-assert
+ (discriminant 1 2/3 -2)
+ 76/9)
+
+;; This function assumes its callers have not checked the types of the
+;; arguments, and performs explicit type checks before making any assumptions.
+
+(my-assert
+ (defun careful-discriminant (a b c)
+   "Compute the discriminant for a quadratic equation."
+   (check-type a number)
+   (check-type b number)
+   (check-type c number)
+   (locally (declare (number a b c))
+	    (- (* b b) (* 4 a c))))
+ CAREFUL-DISCRIMINANT)
+
+(my-assert
+ (careful-discriminant 1 2/3 -2)
+ 76/9)
+
+;;; fboundp
+
+(my-assert
+ (fboundp 'car)
+ t)
+
+(my-assert
+ (fboundp 'nth-value)
+ #+(or cmu sbcl clisp) t
+ #-(or cmu sbcl clisp) nil)
+
+(my-assert
+ (fboundp 'with-open-file)
+ t)
+
+(my-assert
+ (fboundp 'unwind-protect)
+ t)
+
+(my-assert
+ (defun my-function (x) x)
+ MY-FUNCTION)
+
+(my-assert
+ (fboundp 'my-function)
+ t)
+
+(my-assert
+ (let ((saved-definition (symbol-function 'my-function)))
+   (unwind-protect (progn (fmakunbound 'my-function)
+			  (fboundp 'my-function))
+     (setf (symbol-function 'my-function) saved-definition)))
+ nil)
+
+(my-assert
+ (fboundp 'my-function)
+ t)
+
+(my-assert
+ (defmacro my-macro (x) `',x)
+ MY-MACRO)
+
+(my-assert
+ (fboundp 'my-macro)
+ t)
+
+(my-assert
+ (fmakunbound 'my-function)
+ MY-FUNCTION)
+
+(my-assert
+ (fboundp 'my-function)
+ nil)
+
+(my-assert
+ (flet ((my-function (x) x))
+   (fboundp 'my-function))
+ nil)
+
+;;; fmakunbound
+
+(my-assert
+ (defun add-some (x) (+ x 19))
+ ADD-SOME)
+
+(my-assert
+ (fboundp 'add-some)
+ t)
+
+(my-assert
+ (flet ((add-some (x) (+ x 37)))
+   (fmakunbound 'add-some)
+   (add-some 1))
+ 38)
+
+(my-assert
+ (fboundp 'add-some)
+ nil)
+
+;;; macroletjes
+
+(my-assert
+ (flet ((flet1 (n) (+ n n)))
+   (flet ((flet1 (n) (+ 2 (flet1 n))))
+     (flet1 2)))
+ 6)
+
+(my-assert
+ (defun dummy-function () 'top-level)
+ DUMMY-FUNCTION )
+
+(my-assert
+ (funcall #'dummy-function)
+ TOP-LEVEL )
+
+(my-assert
+ (flet ((dummy-function () 'shadow))
+   (funcall #'dummy-function))
+ SHADOW )
+
+(my-assert
+ (eq (funcall #'dummy-function) (funcall 'dummy-function))
+ t )
+
+(my-assert
+ (flet ((dummy-function () 'shadow))
+   (eq (funcall #'dummy-function)
+       (funcall 'dummy-function)))
+ nil)
+
+(my-assert
+ (defun recursive-times (k n)
+   (labels ((temp (n)
+		  (if (zerop n) 0 (+ k (temp (1- n))))))
+     (temp n)))
+ RECURSIVE-TIMES)
+
+(my-assert
+ (recursive-times 2 3)
+ 6)
+
+(my-assert
+ (defmacro mlets (x &environment env)
+   (let ((form `(babbit ,x)))
+     (macroexpand form env)))
+ MLETS)
+
+(my-assert
+ (macrolet ((babbit (z) `(+ ,z ,z))) (mlets 5))
+ 10)
+
+(my-assert
+ (flet ((safesqrt (x) (sqrt (abs x))))
+   ;; The safesqrt function is used in two places.
+   (safesqrt (apply #'+ (map 'list #'safesqrt '(1 2 3 4 5 6)))))
+ 3.2911735)
+
+(my-assert
+ (defun integer-power (n k)
+   (declare (integer n))
+   (declare (type (integer 0 *) k))
+   (labels ((expt0 (x k a)
+		   (declare (integer x a) (type (integer 0 *) k))
+		   (cond ((zerop k) a)
+			 ((evenp k) (expt1 (* x x) (floor k 2) a))
+			 (t (expt0 (* x x) (floor k 2) (* x a)))))
+	    (expt1 (x k a)
+		   (declare (integer x a) (type (integer 0 *) k))
+		   (cond ((evenp k) (expt1 (* x x) (floor k 2) a))
+			 (t (expt0 (* x x) (floor k 2) (* x a))))))
+     (expt0 n k 1)))
+ INTEGER-POWER)
+
+(my-assert
+ (defun example (y l)
+   (flet ((attach (x)
+		  (setq l (append l (list x)))))
+     (declare (inline attach))
+     (dolist (x y)
+       (unless (null (cdr x))
+	 (attach x)))
+     l))
+ EXAMPLE)
+
+(my-assert
+ (example '((a apple apricot) (b banana) (c cherry) (d) (e))
+          '((1) (2) (3) (4 2) (5) (6 3 2)))
+ ((1) (2) (3) (4 2) (5) (6 3 2) (A APPLE APRICOT) (B BANANA) (C CHERRY)))
+
+
+;;; funcall
+
+(my-assert
+ (funcall #'+ 1 2 3)
+ 6)
+
+(my-assert
+ (funcall 'car '(1 2 3))
+ 1)
+
+(my-assert
+ (funcall 'position 1 '(1 2 3 2 1) :start 1)
+ 4)
+
+(my-assert
+ (cons 1 2)
+ (1 . 2))
+
+(my-assert
+ (flet ((cons (x y) `(kons ,x ,y)))
+   (let ((cons (symbol-function '+)))
+     (funcall #'cons
+              (funcall 'cons 1 2)
+              (funcall cons 1 2))))
+ (KONS (1 . 2) 3))
+
+;;; functionp
+
+(my-assert
+ (functionp 'append)
+ nil)
+
+(my-assert
+ (functionp #'append)
+ t)
+
+(my-assert
+ (functionp (symbol-function 'append))
+ t)
+
+(my-assert
+ (flet ((f () 1)) (functionp #'f))
+ t)
+
+(my-assert
+ (functionp (compile nil '(lambda () 259)))
+ t)
+
+(my-assert
+ (functionp nil)
+ nil)
+
+(my-assert
+ (functionp 12)
+ nil)
+
+(my-assert
+ (functionp '(lambda (x) (* x x)))
+ nil)
+
+(my-assert
+ (functionp #'(lambda (x) (* x x)))
+ t)
+
+;;; compiled-function-p
+
+
+(my-assert
+ (defun f (x) x)
+ F)
+
+(my-assert
+ (compiled-function-p #'f)
+ #+(or cmu sbcl ecls) t
+ #+clisp nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+;;  false OR true
+
+(my-assert
+ (compiled-function-p 'f)
+ nil)
+
+(my-assert
+ (compile 'f)
+ F)
+
+(my-assert
+ (compiled-function-p #'f)
+ t)
+
+(my-assert
+ (compiled-function-p 'f)
+ nil)
+
+(my-assert
+ (compiled-function-p (compile nil '(lambda (x) x)))
+ t)
+
+(my-assert
+ (compiled-function-p #'(lambda (x) x))
+ #+(or cmu sbcl ecls) t
+ #+clisp nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  false OR true
+
+(my-assert
+ (compiled-function-p '(lambda (x) x))
+ nil)
+
+;;; CALL-ARGUMENTS-LIMIT
+
+(my-assert
+ (>= CALL-ARGUMENTS-LIMIT  50)
+ t)
+
+;;; LAMBDA-LIST-KEYWORDS
+
+(my-assert
+ (not (member '&ALLOW-OTHER-KEYS LAMBDA-LIST-KEYWORDS))
+ nil)
+
+(my-assert
+ (not (member '&AUX LAMBDA-LIST-KEYWORDS))
+ nil)
+
+(my-assert
+ (not (member '&ENVIRONMENT LAMBDA-LIST-KEYWORDS))
+ nil)
+
+(my-assert
+ (not (member '&OPTIONAL LAMBDA-LIST-KEYWORDS))
+ nil)
+
+(my-assert
+ (not (member '&REST LAMBDA-LIST-KEYWORDS))
+ nil)
+
+(my-assert
+ (not (member '&WHOLE LAMBDA-LIST-KEYWORDS))
+ nil)
+
+;;; LAMBDA-PARAMETERS-LIMIT
+
+(my-assert
+ (>= LAMBDA-PARAMETERS-LIMIT 50)
+ t)
+
+;;; defconstant
+
+(my-assert
+ (defconstant this-is-a-constant 'never-changing "for a test")
+ THIS-IS-A-CONSTANT)
+
+(my-assert
+ this-is-a-constant
+ NEVER-CHANGING)
+
+(my-assert
+ (documentation 'this-is-a-constant 'variable)
+ "for a test")
+
+(my-assert
+ (constantp 'this-is-a-constant)
+ t)
+
+;;; defparameter
+
+(my-assert
+ (defparameter *p* 1)
+ *P*)
+
+(my-assert
+ *p*
+ 1)
+
+(my-assert
+ (constantp '*p*)
+ nil)
+
+(my-assert
+ (setq *p* 2)
+ 2)
+
+(my-assert
+ (defparameter *p* 3)
+ *P*)
+
+(my-assert
+ *p*
+ 3)
+
+(unintern '*V*)
+
+(my-assert
+ (defvar *v* 1)
+ *V*)
+
+(my-assert
+ *v*
+ 1)
+
+(my-assert
+ (constantp '*v*)
+ nil)
+
+(my-assert
+ (setq *v* 2)
+ 2)
+
+(my-assert
+ (defvar *v* 3)
+ *V*)
+
+(my-assert
+ *v*
+ 2)
+
+(my-assert
+ (defun foo ()
+   (let ((*p* 'p) (*v* 'v))
+     (bar)))
+ FOO)
+
+(my-assert
+ (defun bar () (list *p* *v*))
+ BAR)
+
+(my-assert
+ (foo)
+ (P V))
+
+;;; destructuring-bind
+
+(my-assert
+ (defun iota (n) (loop for i from 1 to n collect i)) ;helper
+ IOTA)
+
+(my-assert
+ (destructuring-bind ((a &optional (b 'bee)) one two three)
+     `((alpha) ,@(iota 3))
+   (list a b three two one))
+ (ALPHA BEE 3 2 1))
+
+;;; let & let*
+
+					;(let ((a 'top))
+
+					;  (my-assert
+					;   (defun dummy-function () a)
+					;   DUMMY-FUNCTION)
+
+					;  (my-assert
+					;   (let ((a 'inside) (b a))
+					;     (format nil "~S ~S ~S" a b (dummy-function)))
+					;   "INSIDE TOP TOP" )
+
+					;  (my-assert
+					;   (let* ((a 'inside) (b a))
+					;     (format nil "~S ~S ~S" a b (dummy-function)))
+					;   "INSIDE INSIDE TOP" ))
+
+					;(setf a 'top)
+
+					;(my-assert
+					; (let ((a 'inside) (b a))
+					;   (declare (special a))
+					;   (format nil "~S ~S ~S" a b (dummy-function)))
+					; "INSIDE TOP INSIDE")
+
+;;; progv
+
+(my-assert
+ (let ((*x* 3))
+   (progv '(*x*) '(4)
+     (list *x* (symbol-value '*x*))))
+ (3 4))
+
+(my-assert
+ (setq *x* 1)
+ 1)
+
+(my-assert
+ (progv '(*x*) '(2) *x*)
+ 2)
+
+(my-assert
+ *x*
+ 1)
+
+
+;;; setq
+(my-assert
+ (setq a 1 b 2 c 3)
+ 3)
+
+(my-assert
+ a
+ 1)
+
+(my-assert
+ b
+ 2)
+
+(my-assert
+ c
+ 3)
+
+;; Use of SETQ to update values by sequential assignment.
+(my-assert
+ (setq a (1+ b) b (1+ a) c (+ a b))
+ 7)
+
+(my-assert
+ a
+ 3)
+
+(my-assert
+ b
+ 4)
+
+(my-assert
+ c
+ 7)
+
+;; This illustrates the use of SETQ on a symbol macro.
+(my-assert
+ (let ((x (list 10 20 30)))
+   (symbol-macrolet ((y (car x)) (z (cadr x)))
+     (setq y (1+ z) z (1+ y))
+     (list x y z)))
+ ((21 22 30) 21 22))
+
+;;; psetq
+(my-assert
+ (psetq a 1 b 2 c 3)
+ NIL)
+
+(my-assert
+ a
+ 1)
+
+(my-assert
+ b
+ 2)
+
+(my-assert
+ c
+ 3)
+
+;; Use of PSETQ to update values by parallel assignment.
+;; The effect here is very different than if SETQ had been used.
+(my-assert
+ (psetq a (1+ b) b (1+ a) c (+ a b))
+ NIL)
+
+(my-assert
+ a
+ 3)
+
+(my-assert
+ b
+ 2)
+
+(my-assert
+ c
+ 3)
+
+;; Use of PSETQ on a symbol macro.
+(my-assert
+ (let ((x (list 10 20 30)))
+   (symbol-macrolet ((y (car x)) (z (cadr x)))
+     (psetq y (1+ z) z (1+ y))
+     (list x y z)))
+ ((21 11 30) 21 11))
+
+;; Use of parallel assignment to swap values of A and B.
+(my-assert
+ (multiple-value-bind (n h)
+     (let ((a 1) (b 2))
+       (psetq a b  b a)
+       (values a b))
+   (list n h))
+ (2 1))
+
+
+;;; block
+
+(my-assert
+ (block empty)
+ NIL)
+
+(my-assert
+ (multiple-value-bind (n h)
+     (block whocares (values 1 2) (values 3 4))
+   (list n h))
+ (3 4))
+
+(my-assert
+ (let ((x 1))
+   (block stop (setq x 2) (return-from stop) (setq x 3))
+   x)
+ 2)
+
+(my-assert
+ (multiple-value-bind (n h)
+     (block early
+       (return-from early (values 1 2))
+       (values 3 4))
+   (list n h))
+ (1  2))
+
+(my-assert
+ (block outer (block inner (return-from outer 1)) 2)
+ 1)
+
+(my-assert
+ (block twin (block twin (return-from twin 1)) 2)
+ 2)
+
+;; Contrast behavior of this example with corresponding example of CATCH.
+(my-assert
+ (block b
+   (flet ((b1 () (return-from b 1)))
+     (block b (b1) (print 'unreachable))
+     2))
+ 1)
+
+;; catch
+
+(my-assert
+ (catch 'dummy-tag 1 2 (throw 'dummy-tag 3) 4)
+ 3)
+
+(my-assert
+ (catch 'dummy-tag 1 2 3 4)
+ 4)
+
+(my-assert
+ (defun throw-back (tag) (throw tag t))
+ THROW-BACK)
+
+(my-assert
+ (catch 'dummy-tag (throw-back 'dummy-tag) 2)
+ T)
+
+;; Contrast behavior of this example with corresponding example of BLOCK.
+(my-assert
+ (catch 'c
+   (flet ((c1 () (throw 'c 1)))
+     (catch 'c (c1) (print 'unreachable))
+     2))
+ 2)
+
+;;; go
+(my-assert
+ (tagbody
+  (setq val 2)
+  (go lp)
+  (incf val 3)
+  lp (incf val 4))
+ NIL)
+
+(my-assert
+ val
+ 6 )
+
+;;; return-from
+(my-assert
+ (block alpha (return-from alpha) 1)
+ NIL)
+
+(my-assert
+ (block alpha (return-from alpha 1) 2)
+ 1)
+
+(my-assert
+ (multiple-value-bind (n h)
+     (block alpha (return-from alpha (values 1 2)) 3)
+   (list n h))
+ (1  2))
+
+(my-assert
+ (let ((a 0))
+   (dotimes (i 10) (incf a) (when (oddp i) (return)))
+   a)
+ 2)
+
+(my-assert
+ (defun temp (x)
+   (if x (return-from temp 'dummy))
+   44)
+ TEMP)
+
+(my-assert
+ (temp nil)
+ 44)
+
+(my-assert
+ (temp t)
+ DUMMY)
+
+(my-assert
+ (block out
+   (flet ((exit (n) (return-from out n)))
+     (block out (exit 1)))
+   2)
+ 1)
+
+(my-assert
+ (block nil
+   (unwind-protect (return-from nil 1)
+     (return-from nil 2)))
+ 2)
+
+;;; return
+
+(my-assert
+ (block nil (return) 1)
+ NIL)
+
+(my-assert
+ (block nil (return 1) 2)
+ 1)
+
+(my-assert
+ (multiple-value-bind (n h)
+     (block nil (return (values 1 2)) 3)
+   (list n h))
+ (1 2))
+
+(my-assert
+ (block nil (block alpha (return 1) 2))
+ 1)
+
+(my-assert
+ (block alpha (block nil (return 1)) 2)
+ 2)
+
+(my-assert
+ (block nil (block nil (return 1) 2))
+ 1)
+
+;;; tagbody
+
+(my-assert
+ (let (val)
+   (tagbody
+    (setq val 1)
+    (go point-a)
+    (incf val 16)
+    point-c
+    (incf val 04)
+    (go point-b)
+    (incf val 32)
+    point-a
+    (incf val 02)
+    (go point-c)
+    (incf val 64)
+    point-b
+    (incf val 08))
+   val)
+ 15)
+
+(my-assert
+ (defun f1 (flag)
+   (let ((n 1))
+     (tagbody
+      (setq n (f2 flag #'(lambda () (go out))))
+      out
+      (prin1 n))))
+ F1)
+
+(my-assert
+ (defun f2 (flag escape)
+   (if flag (funcall escape) 2))
+ F2)
+
+(my-assert
+ (f1 nil)
+ NIL)
+
+(my-assert
+ (f1 t)
+ NIL)
+
+;;; trow
+
+(my-assert
+ (multiple-value-bind (n h)
+     (catch 'result
+       (setq i 0 j 0)
+       (loop (incf j 3) (incf i)
+	 (if (= i 3) (throw 'result (values i j)))))
+   (list n h))
+ (3 9))
+
+
+(my-assert
+ (catch nil
+   (unwind-protect (throw nil 1)
+     (throw nil 2)))
+ 2)
+
+;;; unwind-protect
+
+(my-assert
+ (defun dummy-function (x)
+   (setq state 'running)
+   (unless (numberp x) (throw 'abort 'not-a-number))
+   (setq state (1+ x)))
+ DUMMY-FUNCTION)
+
+(my-assert
+ (catch 'abort (dummy-function 1))
+ 2)
+
+(my-assert
+ state
+ 2)
+
+(my-assert
+ (catch 'abort (dummy-function 'trash))
+ NOT-A-NUMBER)
+
+(my-assert
+ state
+ RUNNING)
+
+(my-assert
+ (catch 'abort (unwind-protect (dummy-function 'trash)
+		 (setq state 'aborted)))
+ NOT-A-NUMBER)
+
+(my-assert
+ state
+ ABORTED)
+
+;;; not
+
+(my-assert
+ (not nil)
+ T)
+
+(my-assert
+ (not '())
+ T)
+
+(my-assert
+ (not (integerp 'sss))
+ T)
+
+(my-assert
+ (not (integerp 1))
+ NIL)
+
+(my-assert
+ (not 3.7)
+ NIL)
+
+(my-assert
+ (not 'apple)
+ NIL)
+
+;;; eq
+
+(my-assert
+ (eq 'a 'b)
+ nil)
+
+(my-assert
+ (eq 'a 'a)
+ t)
+
+(my-assert
+ (eq 3 3)
+ #+(or cmu sbcl clisp ecls) t
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  true OR false
+
+(my-assert
+ (eq 3 3.0)
+ nil)
+
+(my-assert
+ (eq 3.0 3.0)
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  true OR  false
+
+(my-assert
+ (eq #c(3 -4) #c(3 -4))
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					; true OR  false
+
+(my-assert
+ (eq #c(3 -4.0) #c(3 -4))
+ nil)
+
+(my-assert
+ (eq (cons 'a 'b) (cons 'a 'c))
+ nil)
+
+(my-assert
+ (eq (cons 'a 'b) (cons 'a 'b))
+ nil)
+
+(my-assert
+ (eq '(a . b) '(a . b))
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  true OR  false
+
+(my-assert
+ (progn (setq x (cons 'a 'b)) (eq x x))
+ T)
+
+(my-assert
+ (progn (setq x '(a . b)) (eq x x))
+ T)
+
+(my-assert
+ (eq #\A #\A)
+ #+(or cmu sbcl clisp ecls) t
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  true OR  false
+
+(my-assert
+ (let ((x "Foo")) (eq x x))
+ T)
+
+(my-assert
+ (eq "Foo" "Foo")
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					;  true OR  false
+
+(my-assert
+ (eq "Foo" (copy-seq "Foo"))
+ nil)
+
+(my-assert
+ (eq "FOO" "foo")
+ nil)
+
+(my-assert
+ (eq "string-seq" (copy-seq "string-seq"))
+ nil)
+
+(my-assert
+ (let ((x 5)) (eq x x))
+ #+(or cmu sbcl clisp ecls) t
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					; true OR false
+
+;;; eql
+
+(my-assert
+ (eql 'a 'b)
+ nil)
+
+(my-assert
+ (eql 'a 'a)
+ t)
+
+(my-assert
+ (eql 3 3)
+ t)
+
+(my-assert
+ (eql 3 3.0)
+ nil)
+
+(my-assert
+ (eql 3.0 3.0)
+ t)
+
+(my-assert
+ (eql #c(3 -4) #c(3 -4))
+ t)
+
+(my-assert
+ (eql #c(3 -4.0) #c(3 -4))
+ nil)
+
+(my-assert
+ (eql (cons 'a 'b) (cons 'a 'c))
+ nil)
+
+(my-assert
+ (eql (cons 'a 'b) (cons 'a 'b))
+ nil)
+
+(my-assert
+ (eql '(a . b) '(a . b))
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					; true OR  false
+
+(my-assert
+ (progn (setq x (cons 'a 'b)) (eql x x))
+ t)
+
+(my-assert
+ (progn (setq x '(a . b)) (eql x x))
+ t)
+
+(my-assert
+ (eql #\A #\A)
+ t)
+
+(my-assert
+ (eql "Foo" "Foo")
+ #+(or cmu sbcl clisp ecls) nil
+ #-(or cmu sbcl clisp ecls) fill-this-in)
+					; true OR  false
+
+(my-assert
+ (eql "Foo" (copy-seq "Foo"))
+ nil)
+
+(my-assert
+ (eql "FOO" "foo")
+ nil)
+
+;;; equal
+
+(my-assert
+ (equal 'a 'b)
+ nil)
+
+(my-assert
+ (equal 'a 'a)
+ T)
+
+(my-assert
+ (equal 3 3)
+ t)
+
+(my-assert
+ (equal 3 3.0)
+ nil)
+
+(my-assert
+ (equal 3.0 3.0)
+ t)
+
+(my-assert
+ (equal #c(3 -4) #c(3 -4))
+ t)
+
+(my-assert
+ (equal #c(3 -4.0) #c(3 -4))
+ nil)
+
+(my-assert
+ (equal (cons 'a 'b) (cons 'a 'c))
+ nil)
+
+(my-assert
+ (equal (cons 'a 'b) (cons 'a 'b))
+ t)
+
+(my-assert
+ (equal #\A #\A)
+ t)
+
+(my-assert
+ (equal #\A #\a)
+ nil)
+
+(my-assert
+ (equal "Foo" "Foo")
+ t)
+
+(my-assert
+ (equal "Foo" (copy-seq "Foo"))
+ t)
+
+(my-assert
+ (equal "FOO" "foo")
+ nil)
+
+(my-assert
+ (equal "This-string" "This-string")
+ t)
+
+(my-assert
+ (equal "This-string" "this-string")
+ nil)
+
+;;; equalp
+
+(my-assert
+ (equalp 'a 'b)
+ nil)
+
+(my-assert
+ (equalp 'a 'a)
+ t)
+
+(my-assert
+ (equalp 3 3)
+ t)
+
+(my-assert
+ (equalp 3 3.0)
+ t)
+
+(my-assert
+ (equalp 3.0 3.0)
+ t)
+
+(my-assert
+ (equalp #c(3 -4) #c(3 -4))
+ t)
+
+(my-assert
+ (equalp #c(3 -4.0) #c(3 -4))
+ t)
+
+(my-assert
+ (equalp (cons 'a 'b) (cons 'a 'c))
+ nil)
+
+(my-assert
+ (equalp (cons 'a 'b) (cons 'a 'b))
+ t)
+
+(my-assert
+ (equalp #\A #\A)
+ t)
+
+(my-assert
+ (equalp #\A #\a)
+ t)
+
+(my-assert
+ (equalp "Foo" "Foo")
+ t)
+
+(my-assert
+ (equalp "Foo" (copy-seq "Foo"))
+ t)
+
+(my-assert
+ (equalp "FOO" "foo")
+ t)
+
+(my-assert
+ (setq array1 (make-array 6 :element-type 'integer
+			  :initial-contents '(1 1 1 3 5 7)))
+ #(1 1 1 3 5 7))
+
+(my-assert
+ (setq array2 (make-array 8 :element-type 'integer
+			  :initial-contents '(1 1 1 3 5 7 2 6)
+			  :fill-pointer 6))
+ #(1 1 1 3 5 7))
+
+(my-assert
+ (equalp array1 array2)
+ t)
+
+(my-assert
+ (setq vector1 (vector 1 1 1 3 5 7))
+ #(1 1 1 3 5 7))
+
+(my-assert
+ (equalp array1 vector1)
+ t )
+
+;; hashtables etc?
+
+;;; identity
+
+(my-assert
+ (identity 101)
+ 101)
+
+(my-assert
+ (mapcan #'identity (list (list 1 2 3) '(4 5 6)))
+ (1 2 3 4 5 6))
+
+;;; complement
+
+(my-assert
+ (funcall (complement #'zerop) 1)
+ t)
+
+(my-assert
+ (funcall (complement #'characterp) #\A)
+ nil)
+
+(my-assert
+ (funcall (complement #'member) 'a '(a b c))
+ nil)
+
+(my-assert
+ (funcall (complement #'member) 'd '(a b c))
+ t)
+
+
+;;; constantly
+
+(my-assert
+ (mapcar (constantly 3) '(a b c d))
+ (3 3 3 3))
+
+(my-assert
+ (defmacro with-vars (vars &body forms)
+   `((lambda ,vars ,@forms) ,@(mapcar (constantly nil) vars)))
+ WITH-VARS)
+
+(my-assert
+ (multiple-value-bind (n h)
+     (macroexpand '(with-vars (a b)
+			      (setq a 3 b (* a a))
+			      (list a b)))
+   (list n h))
+ (((LAMBDA (A B) (SETQ A 3 B (* A A)) (LIST A B)) NIL NIL) t))
+
+;;; every en co
+
+(my-assert
+ (every #'characterp "abc")
+ t)
+
+(my-assert
+ (some #'= '(1 2 3 4 5) '(5 4 3 2 1))
+ t)
+
+(my-assert
+ (notevery #'< '(1 2 3 4) '(5 6 7 8) '(9 10 11 12))
+ nil)
+
+(my-assert
+ (notany #'> '(1 2 3 4) '(5 6 7 8) '(9 10 11 12))
+ t)
+
+;;; and
+
+(my-assert
+ (setq temp1 1 temp2 1 temp3 1)
+ 1 )
+
+(my-assert
+ (and (incf temp1) (incf temp2) (incf temp3))
+ 2 )
+
+(my-assert
+ (and (eql 2 temp1) (eql 2 temp2) (eql 2 temp3))
+ t)
+
+(my-assert
+ (decf temp3)
+ 1 )
+
+(my-assert
+ (and (decf temp1) (decf temp2) (eq temp3 'nil) (decf temp3))
+ NIL )
+
+(my-assert
+ (and (eql temp1 temp2) (eql temp2 temp3))
+ t)
+
+(my-assert
+ (and)
+ T )
+
+;;; cond
+
+(my-assert
+ (defun select-options ()
+   (cond ((= a 1) (setq a 2))
+	 ((= a 2) (setq a 3))
+	 ((and (= a 3) (floor a 2)))
+	 (t (floor a 3))))
+ SELECT-OPTIONS)
+
+(my-assert
+ (setq a 1)
+ 1)
+
+(my-assert
+ (select-options)
+ 2)
+
+(my-assert
+ a
+ 2)
+
+(my-assert
+ (select-options)
+ 3)
+
+(my-assert
+ a
+ 3)
+
+(my-assert
+ (select-options)
+ 1)
+
+(my-assert
+ (setq a 5)
+ 5)
+
+(my-assert
+ (multiple-value-bind (n h)
+     (select-options)
+   (list n h))
+ (1 2))
+
+;;; or
+
+(my-assert
+ (or)
+ NIL )
+
+(my-assert
+ (setq temp0 nil temp1 10 temp2 20 temp3 30)
+ 30)
+
+(my-assert
+ (or temp0 temp1 (setq temp2 37))
+ 10)
+
+(my-assert
+ temp2
+ 20)
+
+(my-assert
+ (or (incf temp1) (incf temp2) (incf temp3))
+ 11)
+
+(my-assert
+ temp1
+ 11)
+
+(my-assert
+ temp2
+ 20)
+
+(my-assert
+ temp3
+ 30)
+
+(my-assert
+ (or (values) temp1)
+ 11)
+
+(my-assert
+ (or (values temp1 temp2) temp3)
+ 11)
+
+(my-assert
+ (multiple-value-bind (n h)
+     (or temp0 (values temp1 temp2))
+   (list n h))
+ (11 20))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (or (values temp0 temp1) (values temp2 temp3))
+   (list n h))
+ (20 30))
+
+;;; when
+
+(my-assert
+ (when t 'hello)
+ HELLO)
+
+(my-assert
+ (unless t 'hello)
+ NIL)
+
+(my-assert
+ (when nil 'hello)
+ NIL)
+
+(my-assert
+ (unless nil 'hello)
+ HELLO)
+
+(my-assert
+ (when t)
+ NIL)
+
+(my-assert
+ (unless nil)
+ NIL)
+
+(my-assert
+ (when t (prin1 1) (prin1 2) (prin1 3))
+ 3)
+
+(my-assert
+ (unless t (prin1 1) (prin1 2) (prin1 3))
+ NIL)
+
+(my-assert
+ (when nil (prin1 1) (prin1 2) (prin1 3))
+ NIL)
+
+(my-assert
+ (unless nil (prin1 1) (prin1 2) (prin1 3))
+ 3)
+
+(my-assert
+ (let ((x 3))
+   (list (when (oddp x) (incf x) (list x))
+	 (when (oddp x) (incf x) (list x))
+	 (unless (oddp x) (incf x) (list x))
+	 (unless (oddp x) (incf x) (list x))
+	 (if (oddp x) (incf x) (list x))
+         (if (oddp x) (incf x) (list x))
+         (if (not (oddp x)) (incf x) (list x))
+         (if (not (oddp x)) (incf x) (list x))))
+ ((4) NIL (5) NIL 6 (6) 7 (7)))
+
+;;; multiple-value-bind
+
+(my-assert
+ (multiple-value-bind (f r)
+     (floor 130 11)
+   (list f r))
+ (11 9))
+
+;;; multiple-value-call
+
+(my-assert
+ (multiple-value-call #'list 1 '/ (values 2 3) '/ (values) '/ (floor 2.5))
+ (1 / 2 3 / / 2 0.5))
+
+(my-assert
+ (+ (floor 5 3) (floor 19 4))
+ 5)
+
+(my-assert
+ (multiple-value-call #'+ (floor 5 3) (floor 19 4))
+ 10)
+
+;;; multiple-value-list
+
+(my-assert
+ (multiple-value-list (floor -3 4))
+ (-1 1))
+
+;;; multiple-value-prog1
+
+(my-assert
+ (setq temp '(1 2 3))
+ (1 2 3))
+
+(my-assert
+ (multiple-value-bind (n h j)
+     (multiple-value-prog1
+      (values-list temp)
+      (setq temp nil)
+      (values-list temp))
+   (list n h j))
+ (1 2 3))
+
+;;; multiple-value-setq
+
+(my-assert
+ (multiple-value-setq (quotient remainder) (truncate 3.2 2))
+ 1)
+
+(my-assert
+ quotient
+ 1)
+
+(my-assert
+ remainder
+ 1.2)
+
+(my-assert
+ (multiple-value-setq (a b c) (values 1 2))
+ 1)
+
+(my-assert
+ a
+ 1)
+
+(my-assert
+ b
+ 2)
+
+(my-assert
+ c
+ NIL)
+
+(my-assert
+ (multiple-value-setq (a b) (values 4 5 6))
+ 4)
+
+(my-assert
+ a
+ 4)
+
+(my-assert
+ b
+ 5)
+
+;;; values
+
+(my-assert
+ (values 1)
+ 1)
+
+(my-assert
+ (multiple-value-bind (n h)
+     (values 1 2)
+   (list n h))
+ (1 2))
+
+(my-assert
+ (multiple-value-bind (n h j)
+     (values 1 2 3)
+   (list n h j))
+ (1 2 3))
+
+(my-assert
+ (multiple-value-bind (n h j)
+     (values (values 1 2 3) 4 5)
+   (list n h j))
+ (1 4 5))
+
+(my-assert
+ (defun polar (x y)
+   (values (sqrt (+ (* x x) (* y y))) (atan y x)))
+ POLAR)
+
+(my-assert
+ (multiple-value-bind (r theta) (polar 3.0 4.0)
+   (vector r theta))
+ #(5.0 0.9272952))
+
+;;; values-list
+
+(my-assert
+ (values-list '(1))
+ 1)
+
+(my-assert
+ (multiple-value-bind (n h)
+     (values-list '(1 2))
+   (list n h))
+ (1 2))
+
+(my-assert
+ (multiple-value-bind (n h j)
+     (values-list '(1 2 3))
+   (list n h j))
+ (1 2 3))
+
+;;; multiple-values-limit
+
+(my-assert
+ (>= MULTIPLE-VALUES-LIMIT 20)
+ T)
+
+
+;;; nth-value
+
+(my-assert
+ (nth-value 0 (values 'a 'b))
+ A)
+
+(my-assert
+ (nth-value 1 (values 'a 'b))
+ B)
+
+(my-assert
+ (nth-value 2 (values 'a 'b))
+ NIL)
+
+(my-assert
+ (multiple-value-bind (n h j)
+     (let* ((x 83927472397238947423879243432432432)
+	    (y 32423489732)
+	    (a (nth-value 1 (floor x y)))
+	    (b (mod x y)))
+       (values a b (= a b)))
+   (list n h j))
+ (3332987528 3332987528 t))
+
+;;; prog
+
+(my-assert
+ (setq a 1)
+ 1)
+
+(my-assert
+ (prog ((a 2) (b a)) (return (if (= a b) '= '/=)))
+ /=)
+
+(my-assert
+ (prog* ((a 2) (b a)) (return (if (= a b) '= '/=)))
+ =)
+
+(my-assert
+ (prog () 'no-return-value)
+ NIL)
+
+;;; prog1
+
+(my-assert
+ (setq temp 1)
+ 1)
+
+(my-assert
+ (prog1 temp (print temp) (incf temp) (print temp))
+ 1)
+
+(my-assert
+ (prog1 temp (setq temp nil))
+ 2)
+
+(my-assert
+ temp
+ NIL)
+
+(my-assert
+ (prog1 (values 1 2 3) 4)
+ 1 )
+
+(my-assert
+ (setq temp (list 'a 'b 'c))
+ (A B C))
+
+(my-assert
+ (prog1 (car temp) (setf (car temp) 'alpha))
+ A)
+
+(my-assert
+ temp
+ (ALPHA B C))
+
+(my-assert
+ (multiple-value-bind (n h)
+     (flet ((swap-symbol-values (x y)
+				(setf (symbol-value x)
+				      (prog1 (symbol-value y)
+					(setf (symbol-value y) (symbol-value x))))))
+       (let ((*foo* 1) (*bar* 2))
+	 (declare (special *foo* *bar*))
+	 (swap-symbol-values '*foo* '*bar*)
+	 (values *foo* *bar*)))
+   (list n h))
+ (2 1))
+
+(my-assert
+ (setq temp 1)
+ 1)
+
+(my-assert
+ (prog2 (incf temp) (incf temp) (incf temp))
+ 3)
+
+(my-assert
+ temp
+ 4)
+
+(my-assert
+ (prog2 1 (values 2 3 4) 5)
+ 2)
+
+;;; progn
+
+(my-assert
+ (progn)
+ NIL)
+
+(my-assert
+ (progn 1 2 3)
+ 3)
+
+(my-assert
+ (multiple-value-bind (n h j)
+     (progn (values 1 2 3))
+   (list n h j))
+ (1 2 3))
+
+(my-assert
+ (setq a 1)
+ 1)
+
+(my-assert
+ (if a
+     (progn (setq a nil) 'here)
+     (progn (setq a t) 'there))
+ HERE)
+
+(my-assert
+ a
+ NIL)
+
+;;; define-modify-macro
+
+(my-assert
+ (define-modify-macro appendf (&rest args)
+   append "Append onto list")
+ APPENDF)
+
+(my-assert
+ (setq x '(a b c) y x)
+ (A B C))
+
+(my-assert
+ (appendf x '(d e f) '(1 2 3))
+ (A B C D E F 1 2 3))
+
+(my-assert
+ x
+ (A B C D E F 1 2 3))
+
+(my-assert
+ y
+ (A B C))
+
+;;; defsetf
+
+(my-assert
+ (defun middleguy (x) (nth (truncate (1- (list-length x)) 2) x))
+ MIDDLEGUY)
+
+(my-assert
+ (defun set-middleguy (x v)
+   (unless (null x)
+     (rplaca (nthcdr (truncate (1- (list-length x)) 2) x) v))
+   v)
+ SET-MIDDLEGUY)
+
+(my-assert
+ (defsetf middleguy set-middleguy)
+ MIDDLEGUY)
+
+(my-assert
+ (setq a (list 'a 'b 'c 'd)
+       b (list 'x)
+       c (list 1 2 3 (list 4 5 6) 7 8 9))
+ (1 2 3 (4 5 6) 7 8 9))
+
+(my-assert
+ (setf (middleguy a) 3)
+ 3)
+
+(my-assert
+ (setf (middleguy b) 7)
+ 7)
+
+(my-assert
+ (setf (middleguy (middleguy c)) 'middleguy-symbol)
+ MIDDLEGUY-SYMBOL)
+
+(my-assert
+ a
+ (A 3 C D))
+
+(my-assert
+ b
+ (7))
+
+(my-assert
+ c
+ (1 2 3 (4 MIDDLEGUY-SYMBOL 6) 7 8 9))
+
+(my-assert
+ (defsetf subseq (sequence start &optional end) (new-sequence)
+   `(progn (replace ,sequence ,new-sequence
+                    :start1 ,start :end1 ,end)
+           ,new-sequence))
+ SUBSEQ)
+
+(unintern '*XY*)
+
+(my-assert
+ (defvar *xy* (make-array '(10 10) :initial-element NIL))
+ *XY*)
+
+(defun xy (&key ((:x x) 0) ((:y y) 0))
+  (aref *xy* x y))
+
+(defun set-xy (new-value &key ((:x x) 0) ((:y y) 0))
+   (setf (aref *xy* x y) new-value))
+
+(defsetf xy (&key ((:x x) 0) ((:y y) 0)) (store)
+  `(set-xy ,store :x ,x :y ,y))
+
+(my-assert
+ (progn
+   (get-setf-expansion '(xy :x a :y b))
+   t)
+ t)
+
+(my-assert
+ (xy :x 1)
+ NIL)
+
+(my-assert
+ (setf (xy :x 1) 1)
+ 1)
+
+(my-assert
+ (xy :x 1)
+ 1)
+
+(my-assert
+ (setf (xy :x 1 :y 2) 3)
+ 3)
+
+(my-assert
+ (setf (xy :y 5 :x 9) 14)
+ 14)
+
+(my-assert
+ (xy :y 0 :x 1)
+ 1)
+
+(my-assert
+ (xy :x 1 :y 2)
+ 3)
+
+;;; define-setf-expander
+
+(my-assert
+ (defun lastguy (x) (car (last x)))
+ LASTGUY)
+
+(my-assert
+ (define-setf-expander lastguy (x &environment env)
+   "Set the last element in a list to the given value."
+   (multiple-value-bind (dummies vals newval setter getter)
+       (get-setf-expansion x env)
+     (let ((store (gensym)))
+       (values dummies
+	       vals
+	       `(,store)
+	       `(progn (rplaca (last ,getter) ,store) ,store)
+	       `(lastguy ,getter)))))
+ LASTGUY)
+
+(my-assert
+ (setq a (list 'a 'b 'c 'd)
+       b (list 'x)
+       c (list 1 2 3 (list 4 5 6)))
+ (1 2 3 (4 5 6)))
+
+(my-assert
+ (setf (lastguy a) 3)
+ 3)
+
+(my-assert
+ (setf (lastguy b) 7)
+ 7)
+
+(my-assert
+ (setf (lastguy (lastguy c)) 'lastguy-symbol)
+ LASTGUY-SYMBOL)
+
+(my-assert
+ a
+ (A B C 3))
+
+(my-assert
+ b
+ (7))
+
+(my-assert
+ c
+ (1 2 3 (4 5 LASTGUY-SYMBOL)))
+
+;;; setf
+
+(my-assert
+ (setq x (cons 'a 'b) y (list 1 2 3))
+ (1 2 3) )
+
+(my-assert
+ (setf (car x) 'x (cadr y) (car x) (cdr x) y)
+ (1 X 3) )
+
+(my-assert
+ x
+ (X 1 X 3) )
+
+(my-assert
+ y
+ (1 X 3) )
+
+(my-assert
+ (setq x (cons 'a 'b) y (list 1 2 3))
+ (1 2 3) )
+
+(my-assert
+ (psetf (car x) 'x (cadr y) (car x) (cdr x) y)
+ NIL )
+
+(my-assert
+ x
+ (X 1 A 3) )
+
+(my-assert
+ y
+ (1 A 3) )
+
+;;; shiftf
+
+(my-assert
+ (setq x (list 1 2 3) y 'trash)
+ TRASH)
+
+(my-assert
+ (shiftf y x (cdr x) '(hi there))
+ TRASH)
+
+(my-assert
+ x
+ (2 3))
+
+(my-assert
+ y
+ (1 HI THERE))
+
+(my-assert
+ (setq x (list 'a 'b 'c))
+ (A B C))
+
+(my-assert
+ (shiftf (cadr x) 'z)
+ B)
+
+(my-assert
+ x
+ (A Z C))
+
+(my-assert
+ (shiftf (cadr x) (cddr x) 'q)
+ Z)
+
+(my-assert
+ x
+ (A (C) . Q))
+
+(my-assert
+ (setq n 0)
+ 0)
+
+(my-assert
+ (setq x (list 'a 'b 'c 'd))
+ (A B C D))
+
+(my-assert
+ (shiftf (nth (setq n (+ n 1)) x) 'z)
+ B)
+
+(my-assert
+ x
+ (A Z C D))
+
+;;; rotatef
+
+(my-assert
+ (let ((n 0)
+       (x (list 'a 'b 'c 'd 'e 'f 'g)))
+   (rotatef (nth (incf n) x)
+	    (nth (incf n) x)
+	    (nth (incf n) x))
+   x)
+ (A C D B E F G))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/ansi-tests/section6.lisp b/src/ansi-tests/section6.lisp
new file mode 100644
index 000000000..26c558d70
--- /dev/null
+++ b/src/ansi-tests/section6.lisp
@@ -0,0 +1,626 @@
+;;; 6.1.1.7 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+;; Collect values by using FOR constructs.
+(my-assert
+ (loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+   for a of-type integer = (first numlist)
+   and b of-type integer = (second numlist)
+   and c of-type float = (third numlist)
+   collect (list c b a))
+ ((4.0 2 1) (8.3 6 5) (10.4 9 8)))
+
+
+
+;; Destructuring simplifies the process.
+(my-assert
+ (loop for (a b c) of-type (integer integer float) in
+   '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+   collect (list c b a))
+ ((4.0 2 1) (8.3 6 5) (10.4 9 8)))
+
+
+;; If all the types are the same, this way is even simpler.
+(my-assert
+ (loop for (a b c) of-type float in
+   '((1.0 2.0 4.0) (5.0 6.0 8.3) (8.0 9.0 10.4))
+   collect (list c b a))
+ ((4.0 2.0 1.0) (8.3 6.0 5.0) (10.4 9.0 8.0)))
+
+;; Initialize and declare variables in parallel by using the AND construct.
+
+(my-assert
+ (loop for (a nil b) = '(1 2 3)
+   do (return (list a b)))
+ (1 3))
+
+(my-assert
+ (loop for (x . y) = '(1 . 2)
+   do (return y))
+ 2)
+
+
+(my-assert
+ (loop for ((a . b) (c . d)) of-type ((float . float) (integer . integer)) in
+   '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6)))
+   collect (list a b c d))
+ ((1.2 2.4 3 4) (3.4 4.6 5 6)))
+
+;;; 6.1.2.1.1
+
+
+(my-assert
+ (let ((xo 1)) (loop for i from xo by (incf xo) to 10 collect i))
+ (1 3 5 7 9))
+
+
+;;; 6.1.2.1.2.1
+
+(my-assert
+ (loop for (item . x) of-type (t . fixnum) in '((A . 1) (B . 2) (C . 3))
+   unless (eq item 'B) sum x)
+ 4)
+
+;;; 6.1.2.1.3.1
+
+;; Collect successive tails of a list.
+(my-assert
+ (loop for sublist on '(a b c d)
+   collect sublist)
+ ((A B C D) (B C D) (C D) (D)))
+
+;;; 6.1.2.1.4.1
+
+;; Collect some numbers.
+(my-assert
+ (loop for item = 1 then (+ item 10)
+   for iteration from 1 to 5
+   collect item)
+ (1 11 21 31 41))
+
+;;;; 6.1.2.2
+
+(my-assert
+ (loop with a = 1
+   with b = (+ a 2)
+   with c = (+ b 3)
+   return (list a b c))
+ (1 3 6))
+
+(my-assert
+ (loop with a = 1
+   and b = 2
+   and c = 3
+   return (list a b c))
+ (1 2 3))
+
+;;; 6.1.2.2.1
+
+;; These bindings occur in sequence.
+(my-assert
+ (loop with a = 1
+   with b = (+ a 2)
+   with c = (+ b 3)
+   return (list a b c))
+ (1 3 6))
+
+;; These bindings occur in parallel.
+(my-assert
+ (setq a 5 b 10)
+ 10)
+
+
+(my-assert
+ (loop with a = 1
+   and b = (+ a 2)
+   and c = (+ b 3)
+   return (list a b c))
+ (1 7 13))
+
+;; This example shows a shorthand way to declare local variables
+;; that are of different types.
+(my-assert
+ (loop with (a b c) of-type (float integer float)
+   return (format nil "~A ~A ~A" a b c))
+ "0.0 0 0.0")
+
+;; This example shows a shorthand way to declare local variables
+;; that are the same type.
+(my-assert
+ (loop with (a b c) of-type float
+   return (format nil "~A ~A ~A" a b c))
+ "0.0 0.0 0.0")
+
+;;; 6.1.3
+
+;; Collect every name and the kids in one list by using
+;; COLLECT and APPEND.
+(my-assert
+ (loop for name in '(fred sue alice joe june)
+   for kids in '((bob ken) () () (kris sunshine) ())
+   collect name
+   append kids)
+ (FRED BOB KEN SUE ALICE JOE KRIS SUNSHINE JUNE))
+
+;;; 6.1.3.1
+
+;; Collect all the symbols in a list.
+(my-assert
+ (loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
+   when (symbolp i) collect i)
+ (BIRD TURTLE HORSE CAT))
+
+;; Collect and return odd numbers.
+(my-assert
+ (loop for i from 1 to 10
+   if (oddp i) collect i)
+ (1 3 5 7 9))
+
+;; Collect items into local variable, but don't return them.
+(my-assert
+ (loop for i in '(a b c d) by #'cddr
+   collect i into my-list
+   finally  my-list) ;;; hmm
+ nil )
+
+;;; 6.1.3.2
+
+;; Use APPEND to concatenate some sublists.
+(my-assert
+ (loop for x in '((a) (b) ((c)))
+   append x)
+ (A B (C)))
+
+;; NCONC some sublists together.  Note that only lists made by the
+;; call to LIST are modified.
+(my-assert
+ (loop for i upfrom 0
+   as x in '(a b (c))
+   nconc (if (evenp i) (list x) nil))
+ (A (C)))
+
+;;; 6.1.3.3
+
+(my-assert
+ (loop for i in '(a b nil c nil d e)
+   count i)
+ 5)
+
+;;; 6.1.3.4
+
+(my-assert
+ (loop for i in '(2 1 5 3 4)
+   maximize i)
+ 5)
+
+(my-assert
+ (loop for i in '(2 1 5 3 4)
+   minimize i)
+ 1)
+
+;; In this example, FIXNUM applies to the internal variable that holds
+;; the maximum value.
+(my-assert
+ (setq series '(1.2 4.3 5.7))
+ (1.2 4.3 5.7))
+
+(my-assert
+ (loop for v in series
+   maximize (round v) of-type fixnum)
+ 6)
+
+;; In this example, FIXNUM applies to the variable RESULT.
+(my-assert
+ (loop for v of-type float in series
+   minimize (round v) into result of-type fixnum
+   finally (return result))
+ 1)
+
+;;; 6.1.3.5
+
+(my-assert
+ (loop for i of-type fixnum in '(1 2 3 4 5)
+   sum i)
+ 15)
+
+(my-assert
+ (setq series '(1.2 4.3 5.7))
+ (1.2 4.3 5.7))
+
+(my-assert
+ (loop for v in series
+   sum (* 2.0 v))
+ 22.4)
+
+;;; 6.1.4.2
+
+;; Make sure I is always less than 11 (two ways).
+;; The FOR construct terminates these loops.
+(my-assert
+ (loop for i from 0 to 10
+   always (< i 11))
+ T)
+
+(my-assert
+ (loop for i from 0 to 10
+   never (> i 11))
+ T)
+
+;; If I exceeds 10 return I; otherwise, return NIL.
+;; The THEREIS construct terminates this loop.
+(my-assert
+ (loop for i from 0
+   thereis (when (> i 10) i) )
+ 11)
+
+;;; The FINALLY clause is not evaluated in these examples.
+(my-assert
+ (loop for i from 0 to 10
+   always (< i 9)
+   finally (format nil "you won't see this"))
+ NIL)
+
+(my-assert
+ (loop never t
+   finally (format nil "you won't see this"))
+ NIL)
+
+(my-assert
+ (loop thereis "Here is my value"
+   finally (format nil "you won't see this"))
+ "Here is my value")
+
+;;; 6.1.4.3
+
+;; Collect the length and the items of STACK.
+(my-assert
+ (let ((stack '(a b c d e f)))
+   (loop for item = (length stack) then (pop stack)
+     collect item
+     while stack))
+ (6 A B C D E F))
+
+;; Use WHILE to terminate a loop that otherwise wouldn't terminate.
+;; Note that WHILE occurs after the WHEN.
+(my-assert
+ (loop for i fixnum from 3
+   when (oddp i) collect i
+   while (< i 5))
+ (3 5))
+
+;;; 6.1.6.1
+
+;; Signal an exceptional condition.
+(my-assert
+ (loop for item in '(1 2 3 a 4 5)
+   when (not (numberp item))
+   return (cerror "enter new value" "non-numeric value: ~s" item))
+ ERROR)
+
+;; The previous example is equivalent to the following one.
+(my-assert
+ (loop for item in '(1 2 3 a 4 5)
+   when (not (numberp item))
+   do (return
+       (cerror "Enter new value" "non-numeric value: ~s" item)))
+ ERROR)
+
+;; This example parses a simple printed string representation from
+;; BUFFER (which is itself a string) and returns the index of the
+;; closing double-quote character.
+(my-assert
+ (let ((buffer "\"a\" \"b\""))
+   (loop initially (unless (char= (char buffer 0) #\")
+		     (loop-finish))
+     for i of-type fixnum from 1 below (length (the string buffer))
+     when (char= (char buffer i) #\")
+     return i))
+ 2)
+
+;; The collected value is returned.
+(my-assert
+ (loop for i from 1 to 10
+   when (> i 5)
+   collect i
+   finally (prin1 'got-here))
+ (6 7 8 9 10) )
+
+;; Return both the count of collected numbers and the numbers.
+
+(my-assert
+ (multiple-value-bind (a b)
+     (loop for i from 1 to 10
+       when (> i 5)
+       collect i into number-list
+       and count i into number-count
+       finally (return (values number-count number-list)))
+   (list a b))
+ (5 (6 7 8 9 10)))
+
+;;; 6.1.7.1.1
+
+;; Just name and return.
+(my-assert
+ (loop named max
+   for i from 1 to 10
+   do (print i)
+   do (return-from max 'done))
+ DONE)
+
+
+
+;;; 6.1.8
+
+(my-assert
+ (let ((i 0))				; no loop keywords are used
+   (loop (incf i) (if (= i 3) (return i))))
+ 3)
+
+(my-assert
+ (let ((i 0)(j 0))
+   (tagbody
+    (loop (incf j 3) (incf i) (if (= i 3) (go exit)))
+    exit)
+   j)
+ 9)
+
+(my-assert
+ (loop for x from 1 to 10
+   for y = nil then x
+   collect (list x y))
+ ((1 NIL) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (10 10)))
+
+(my-assert
+ (loop for x from 1 to 10
+   and y = nil then x
+   collect (list x y))
+ ((1 NIL) (2 1) (3 2) (4 3) (5 4) (6 5) (7 6) (8 7) (9 8) (10 9)))
+
+;;; 6.1.8.1
+
+;; Group conditional clauses.
+
+(my-assert
+ (multiple-value-bind (a b)
+     (loop for i in '(1 324 2345 323 2 4 235 252)
+       when (oddp i)
+       do (print i)
+       and collect i into odd-numbers
+       and do (terpri)
+       else				; I is even.
+       collect i into even-numbers
+       finally
+       (return (values odd-numbers even-numbers)))
+   (list a b))
+ ((1 2345 323 235) (324 2 4 252)))
+
+;; Collect numbers larger than 3.
+(my-assert
+ (loop for i in '(1 2 3 4 5 6)
+   when (and (> i 3) i)
+   collect it)				; IT refers to (and (> i 3) i).
+ (4 5 6))
+
+;; Find a number in a list.
+(my-assert
+ (loop for i in '(1 2 3 4 5 6)
+   when (and (> i 3) i)
+   return it)
+ 4)
+
+;; The above example is similar to the following one.
+(my-assert
+ (loop for i in '(1 2 3 4 5 6)
+   thereis (and (> i 3) i))
+ 4)
+
+
+;; Nest conditional clauses.
+(my-assert
+ (multiple-value-bind (a b c)
+     (let ((list '(0 3.0 apple 4 5 9.8 orange banana)))
+       (loop for i in list
+	 when (numberp i)
+	 when (floatp i)
+	 collect i into float-numbers
+	 else				; Not (floatp i)
+	 collect i into other-numbers
+	 else				; Not (numberp i)
+	 when (symbolp i)
+	 collect i into symbol-list
+	 else				; Not (symbolp i)
+	 do (error "found a funny value in list ~S, value ~S~%" list i)
+	 finally (return (values float-numbers other-numbers symbol-list))))
+   (list a b c))
+ ((3.0 9.8) (0 4 5) (APPLE ORANGE BANANA)))
+
+;;; do
+
+(my-assert
+ (do ((temp-one 1 (1+ temp-one))
+      (temp-two 0 (1- temp-two)))
+     ((> (- temp-one temp-two) 5) temp-one))
+ 4)
+
+(my-assert
+ (do ((temp-one 1 (1+ temp-one))
+      (temp-two 0 (1+ temp-one)))
+     ((= 3 temp-two) temp-one))
+ 3)
+
+(my-assert
+ (do* ((temp-one 1 (1+ temp-one))
+       (temp-two 0 (1+ temp-one)))
+     ((= 3 temp-two) temp-one))
+ 2                     )
+
+(my-assert
+ (setq a-vector (vector 1 nil 3 nil))
+ #(1 nil 3 nil))
+
+(my-assert
+ (do ((i 0 (+ i 1))			;Sets every null element of a-vector to zero.
+      (n (array-dimension a-vector 0)))
+     ((= i n))
+   (when (null (aref a-vector i))
+     (setf (aref a-vector i) 0)))
+ NIL)
+
+(my-assert
+ a-vector
+ #(1 0 3 0))
+
+;;; dotimes
+
+(my-assert
+ (dotimes (temp-one 10 temp-one))
+ 10)
+
+(my-assert
+ (setq temp-two 0)
+ 0)
+
+(my-assert
+ (dotimes (temp-one 10 t) (incf temp-two))
+ T)
+
+(my-assert
+ temp-two
+ 10)
+
+;;; True if the specified subsequence of the string is a
+;;; palindrome (reads the same forwards and backwards).
+(my-assert
+ (defun palindromep (string &optional
+			    (start 0)
+			    (end (length string)))
+   (dotimes (k (floor (- end start) 2) t)
+     (unless (char-equal (char string (+ start k))
+			 (char string (- end k 1)))
+       (return nil))))
+ PALINDROMEP)
+
+(my-assert
+ (palindromep "Able was I ere I saw Elba")
+ T)
+
+(my-assert
+ (palindromep "A man, a plan, a canal--Panama!")
+ NIL)
+
+(my-assert
+ (remove-if-not #'alpha-char-p          ;Remove punctuation.
+		"A man, a plan, a canal--Panama!")
+ "AmanaplanacanalPanama")
+
+(my-assert
+ (palindromep
+  (remove-if-not #'alpha-char-p
+		 "A man, a plan, a canal--Panama!"))
+ T)
+
+(my-assert
+ (palindromep
+  (remove-if-not
+   #'alpha-char-p
+   "Unremarkable was I ere I saw Elba Kramer, nu?"))
+ T)
+
+(my-assert
+ (palindromep
+  (remove-if-not
+   #'alpha-char-p
+   "A man, a plan, a cat, a ham, a yak,
+                  a yam, a hat, a canal--Panama!"))
+ T)
+
+
+;;; dolist
+
+(my-assert
+ (setq temp-two '())
+ NIL)
+
+(my-assert
+ (dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two))
+ (4 3 2 1))
+
+(my-assert
+ (setq temp-two 0)
+ 0)
+
+(my-assert
+ (dolist (temp-one '(1 2 3 4)) (incf temp-two))
+ NIL)
+
+(my-assert
+ temp-two
+ 4)
+
+;;; loop-finish
+
+;; Terminate the loop, but return the accumulated count.
+(my-assert
+ (loop for i in '(1 2 3 stop-here 4 5 6)
+   when (symbolp i) do (loop-finish)
+   count i)
+ 3)
+
+;; The preceding loop is equivalent to:
+(my-assert
+ (loop for i in '(1 2 3 stop-here 4 5 6)
+   until (symbolp i)
+   count i)
+ 3)
+
+;; While LOOP-FINISH can be used can be used in a variety of
+;; situations it is really most needed in a situation where a need
+;; to exit is detected at other than the loop's `top level'
+;; (where UNTIL or WHEN often work just as well), or where some
+;; computation must occur between the point where a need to exit is
+;; detected and the point where the exit actually occurs.  For example:
+(my-assert
+ (defun tokenize-sentence (string)
+   (macrolet ((add-word (wvar svar)
+			`(when ,wvar
+			   (push (coerce (nreverse ,wvar) 'string) ,svar)
+			   (setq ,wvar nil))))
+     (loop with word = '() and sentence = '() and endpos = nil
+       for i below (length string)
+       do (let ((char (aref string i)))
+	    (case char
+	      (#\Space (add-word word sentence))
+	      (#\. (setq endpos (1+ i)) (loop-finish))
+	      (otherwise (push char word))))
+       finally (add-word word sentence)
+       (return (values (nreverse sentence) endpos)))))
+ TOKENIZE-SENTENCE)
+
+(my-assert
+ (multiple-value-bind (a b)
+     (tokenize-sentence
+      "this is a sentence. this is another sentence.")
+   (list a b))
+ (("this" "is" "a" "sentence")  19))
+
+(my-assert
+ (multiple-value-bind (a b)
+     (tokenize-sentence "this is a sentence")
+   (list a b))
+ (("this" "is" "a" "sentence")  NIL))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/ansi-tests/section7.lisp b/src/ansi-tests/section7.lisp
new file mode 100644
index 000000000..7ba601397
--- /dev/null
+++ b/src/ansi-tests/section7.lisp
@@ -0,0 +1,48 @@
+;;; section 7: objects -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+;;; function-keywords
+(my-assert
+ (progn
+   (defmethod gf1 ((a integer) &optional (b 2)
+		   &key (c 3) ((:dee d) 4) e ((eff f)))
+     (list a b c d e f))
+   t)
+ T)
+
+(my-assert
+ (eq (find-method #'gf1 '() (list (find-class 'integer)))  'nil)
+ nil)					; XXX
+
+(my-assert
+ (multiple-value-list
+  (function-keywords (find-method #'gf1 '()
+                                  (list (find-class 'integer)))))
+ ((:C :DEE :E EFF) nil))
+
+(my-assert
+ (eq (defmethod gf2 ((a integer))
+       (list a b c d e f)) 'nil)
+ nil)					; XXX
+
+(my-assert
+ (multiple-value-list
+  (function-keywords (find-method #'gf2 '() (list (find-class 'integer)))))
+ (() nil))
+
+(my-assert
+ (progn
+   (defmethod gf3 ((a integer) &key b c d &allow-other-keys)
+     (list a b c d e f))
+   t)
+ t)
+
+(my-assert
+ (multiple-value-list
+  (function-keywords (find-method #'gf3 '() (list (find-class 'integer)))))
+ ((:B :C :D) t))
+
+;;; if only i knew more about clos
+
diff --git a/src/ansi-tests/section8.lisp b/src/ansi-tests/section8.lisp
new file mode 100644
index 000000000..887f82105
--- /dev/null
+++ b/src/ansi-tests/section8.lisp
@@ -0,0 +1,200 @@
+;;; section 8 structures -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+;;;
+;;; Example 1
+;;; define town structure type
+;;; area, watertowers, firetrucks, population, elevation are its components
+;;;
+(my-assert
+ (defstruct town
+   area
+   watertowers
+   (firetrucks 1 :type fixnum)		;an initialized slot
+   population
+   (elevation 5128 :read-only t))	;a slot that can't be changed
+ TOWN)
+
+					;create a town instance
+(my-assert
+ (progn
+   (setq town1 (make-town :area 0 :watertowers 0))
+   t)
+ t )
+
+					;town's predicate recognizes the new instance
+(my-assert
+ (town-p town1)
+ t)
+
+					;new town's area is as specified by make-town
+(my-assert
+ (town-area town1)
+ 0)
+
+					;new town's elevation has initial value
+(my-assert
+ (town-elevation town1)
+ 5128)
+
+					;setf recognizes reader function
+(my-assert
+ (setf (town-population town1) 99)
+ 99)
+
+(my-assert
+ (town-population town1)
+ 99)
+
+					;copier function makes a copy of town1
+(my-assert
+ (progn
+   (setq town2 (copy-town town1))
+   t)
+ t)
+
+(my-assert
+ (= (town-population town1) (town-population town2))
+ t)
+
+					;since elevation is a read-only slot, its value can be set only
+					;when the structure is created
+(my-assert
+ (progn
+   (setq town3 (make-town :area 0 :watertowers 3 :elevation 1200))
+   t)
+ t)
+
+;;;
+;;; Example 2
+;;; define clown structure type
+;;; this structure uses a nonstandard prefix
+;;;
+(my-assert
+ (defstruct (clown (:conc-name bozo-))
+   (nose-color 'red)
+   frizzy-hair-p polkadots)
+ CLOWN)
+
+(my-assert
+ (progn
+   (setq funny-clown (make-clown))
+   t)
+ t)
+
+					;use non-default reader name
+(my-assert
+ (bozo-nose-color funny-clown)
+ RED        )
+
+(my-assert
+ (defstruct (klown (:constructor make-up-klown) ;similar def using other
+		   (:copier clone-klown) ;customizing keywords
+		   (:predicate is-a-bozo-p))
+   nose-color frizzy-hair-p polkadots)
+ klown)
+
+					;custom constructor now exists
+(my-assert
+ (fboundp 'make-up-klown)
+ t)
+
+;;;
+;;; Example 3
+;;; define a vehicle structure type
+;;; then define a truck structure type that includes
+;;; the vehicle structure
+;;;
+(my-assert
+ (defstruct vehicle name year (diesel t :read-only t))
+ VEHICLE)
+
+(my-assert
+ (defstruct (truck (:include vehicle (year 79)))
+   load-limit
+   (axles 6))
+ TRUCK)
+
+(my-assert
+ (progn
+   (setq x (make-truck :name 'mac :diesel t :load-limit 17))
+   t)
+ t)
+
+					;vehicle readers work on trucks
+(my-assert
+ (vehicle-name x)
+ MAC)
+
+					;default taken from :include clause
+(my-assert
+ (vehicle-year x)
+ 79 )
+
+(my-assert
+ (defstruct (pickup (:include truck))	;pickup type includes truck
+   camper long-bed four-wheel-drive)
+ PICKUP)
+
+(my-assert
+ (progn
+   (setq x (make-pickup :name 'king :long-bed t))
+   t)
+ t)
+
+					;:include default inherited
+(my-assert
+ (pickup-year x)
+ 79)
+
+;;;
+;;; Example 4
+;;; use of BOA constructors
+;;;
+(my-assert
+ (defstruct (dfs-boa			;BOA constructors
+	     (:constructor make-dfs-boa (a b c))
+	     (:constructor create-dfs-boa
+			   (a &optional b (c 'cc) &rest d &aux e (f 'ff))))
+   a b c d e f)
+ DFS-BOA)
+
+					;a, b, and c set by position, and the rest are uninitialized
+(my-assert
+ (progn
+   (setq x (make-dfs-boa 1 2 3))
+   t)
+ t)
+
+(my-assert
+ (dfs-boa-a x)
+ 1)
+
+					;a and b set, c and f defaulted
+(my-assert
+ (progn
+   (setq x (create-dfs-boa 1 2))
+   t)
+ t)
+
+(my-assert
+ (dfs-boa-b x)
+ 2)
+
+(my-assert
+ (eq (dfs-boa-c x) 'cc)
+ t)
+
+					;a, b, and c set, and the rest are collected into d
+(my-assert
+ (progn
+   (setq x (create-dfs-boa 1 2 3 4 5 6))
+   t)
+ t)
+
+(my-assert
+ (dfs-boa-d x)
+ (4 5 6))
+
diff --git a/src/ansi-tests/section9.lisp b/src/ansi-tests/section9.lisp
new file mode 100644
index 000000000..25801d1d8
--- /dev/null
+++ b/src/ansi-tests/section9.lisp
@@ -0,0 +1,127 @@
+;;; section 9: conditions -*- mode: lisp -*-
+(in-package :cl-user)
+
+(proclaim '(special log))
+
+
+(my-assert
+ (subtypep 'arithmetic-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'floating-point-overflow 'condition)
+ t)
+
+(my-assert
+ (subtypep 'simple-type-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'cell-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'floating-point-underflow 'condition)
+ t)
+
+(my-assert
+ (subtypep 'simple-warning 'condition)
+ t)
+
+(my-assert
+ (subtypep 'condition 'condition)
+ t)
+
+(my-assert
+ (subtypep 'package-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'storage-condition 'condition)
+ t)
+
+(my-assert
+ (subtypep 'control-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'parse-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'stream-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'division-by-zero 'condition)
+ t)
+
+(my-assert
+ (subtypep 'print-not-readable 'condition)
+ t)
+
+(my-assert
+ (subtypep 'style-warning 'condition)
+ t)
+
+(my-assert
+ (subtypep 'end-of-file 'condition)
+ t)
+
+(my-assert
+ (subtypep 'program-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'type-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'reader-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'unbound-slot 'condition)
+ t)
+
+(my-assert
+ (subtypep 'file-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'serious-condition 'condition)
+ t)
+
+(my-assert
+ (subtypep 'unbound-variable 'condition)
+ t)
+
+(my-assert
+ (subtypep 'floating-point-inexact 'condition)
+ t)
+
+(my-assert
+ (subtypep 'simple-condition 'condition)
+ t)
+
+(my-assert
+ (subtypep 'undefined-function 'condition)
+ t)
+
+(my-assert
+ (subtypep 'floating-point-invalid-operation 'condition)
+ t)
+
+(my-assert
+ (subtypep 'simple-error 'condition)
+ t)
+
+(my-assert
+ (subtypep 'warning   'condition)
+ t)
+
+
diff --git a/src/ansi-tests/setf.lisp b/src/ansi-tests/setf.lisp
new file mode 100644
index 000000000..2ec43a0b2
--- /dev/null
+++ b/src/ansi-tests/setf.lisp
@@ -0,0 +1,528 @@
+;;; based on v1.4 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (setf li1 '(a (b) ((c) (d)) )  vec1 '#(0 1 2 3))
+ #(0 1 2 3))
+
+(my-assert
+ (setf pa 'old)
+ old)
+
+(my-assert
+ (psetf pa 'new pao pa)
+ nil)
+
+(my-assert
+ pa
+ new)
+
+(my-assert
+ pao
+ old)
+
+(my-assert
+ (setf (nth 1 li1) (quote uu))
+ uu)
+
+(my-assert
+ (eval (quote li1))
+ (a uu ((c) (d))))
+
+(my-assert
+ (setf (elt li1 1) (quote oo))
+ oo)
+
+(my-assert
+ (setf (elt vec1 1) (quote oo))
+ oo)
+
+(my-assert
+ (eval (quote li1))
+ (a oo ((c) (d))))
+
+(my-assert
+ (eval (quote vec1))
+ #(0 oo 2 3))
+
+(my-assert
+ (setf (rest li1) (quote ((ww))))
+ ((ww)))
+
+(my-assert
+ (eval (quote li1))
+ (a (ww)))
+
+(my-assert
+ (setf (first li1) (quote aa))
+ aa)
+
+(my-assert
+ (first li1)
+ aa)
+
+(my-assert
+ (setf (second li1) (quote bb))
+ bb)
+
+(my-assert
+ (eval (quote li1))
+ (aa bb))
+
+(my-assert
+ (setf (third li1) (quote bb))
+ type-error)
+
+(my-assert
+ (eval (quote li1))
+ (aa bb))
+
+
+(my-assert
+ (setf (rest li1) (quote (2 3 4 5 6 7 8 9 10)))
+ (2 3 4 5 6 7 8 9 10))
+
+(my-assert
+ (setf (second li1) 22)
+ 22)
+
+(my-assert
+ (eval (quote li1))
+ (aa 22 3 4 5 6 7 8 9 10))
+
+(my-assert
+ (setf (third li1) (quote 33))
+ 33)
+
+(my-assert
+ (setf (fourth li1) (quote 44))
+ 44)
+
+(my-assert
+ (setf (fifth li1) (quote 55))
+ 55)
+
+(my-assert
+ (setf (sixth li1) (quote 66))
+ 66)
+
+(my-assert
+ (setf (seventh li1) (quote 77))
+ 77)
+
+(my-assert
+ (setf (eighth li1) (quote 88))
+ 88)
+
+(my-assert
+ (setf (ninth li1) (quote 99))
+ 99)
+
+(my-assert
+ (setf (tenth li1) (quote 1010))
+ 1010)
+
+(my-assert
+ (eval (quote li1))
+ (aa 22 33 44 55 66 77 88 99 1010))
+
+(my-assert
+ (setf (first li1) (quote (((a)))))
+ (((a))))
+
+(my-assert
+ (setf (caaar li1) (quote uu))
+ uu)
+
+(my-assert
+ (caaar li1)
+ uu)
+
+(my-assert
+ (car li1)
+ ((uu)))
+
+(my-assert
+ (setf (caar li1) (quote oo))
+ oo)
+
+(my-assert
+ (eval (quote li1))
+ ((oo) 22 33 44 55 66 77 88 99 1010))
+
+(my-assert
+ (setf (car li1) (quote ii))
+ ii)
+
+(my-assert
+ (eval (quote li1))
+ (ii 22 33 44 55 66 77 88 99 1010))
+
+(my-assert
+ (setf (cdddr li1) (quote pp))
+ pp)
+
+(my-assert
+ (eval (quote li1))
+ (ii 22 33 . pp))
+
+(my-assert
+ (setf (caddr li1) (quote 333))
+ 333)
+
+(my-assert
+ (eval (quote li1))
+ (ii 22 333 . pp))
+
+(my-assert
+ (setf (svref vec1 2) (quote kk))
+ kk)
+
+(my-assert
+ (eval (quote vec1))
+ #(0 oo kk 3))
+
+(my-assert
+ (setf (get (quote a) (quote b)) (quote uu))
+ uu)
+
+(my-assert
+ (get (quote a) (quote b))
+ uu)
+
+(my-assert
+ (setf (getf (cadr (setq xx (quote (aaa (i1 v1 i2 v2))))) (quote i2))
+
+       (quote v222))
+ v222)
+
+(my-assert
+ (eval (quote xx))
+ (aaa (i1 v1 i2 v222)))
+
+(my-assert
+ (getf (cadr xx) (quote i2))
+ v222)
+
+(my-assert
+ (getf (cadr xx) (quote i1))
+ v1)
+
+(my-assert
+ (setf (documentation (quote beispiel) (quote typ1)) "doc 1")
+ "doc 1")
+
+(my-assert
+ (setf (documentation (quote beispiel) (quote typ2)) "doc 2")
+ "doc 2")
+
+(my-assert
+ (documentation (quote beispiel) (quote typ2))
+ #+xcl (typ2 . "doc 2")
+ #-xcl "doc 2")
+
+(my-assert
+ (setf (documentation (quote beispiel) (quote typ2)) "doc 3")
+ "doc 3")
+
+(my-assert
+ (documentation (quote beispiel) (quote typ2))
+ #+xcl (typ2 . "doc 3")
+ #-xcl "doc 3")
+
+(my-assert
+ (symbol-plist 'beispiel)
+ #+xcl (documentation ((typ2 . "doc 3") (typ1 . "doc 1")))
+ #+clisp (system::documentation-strings (typ2 "doc 3" typ1 "doc 1"))
+ #+allegro (excl::%documentation ((typ2 . "doc 3") (typ1 . "doc 1")))
+ #+(or cmu ecls) nil
+ #-(or xcl clisp allegro cmu ecls) unknown)
+
+(my-assert
+ (setf (symbol-value (quote xx)) (quote voelligneu))
+ voelligneu)
+
+(my-assert
+ (eval (quote xx))
+ voelligneu)
+
+(my-assert
+ (progn
+   (setf (symbol-function (quote ff))
+	 (coerce (quote (lambda (x) (print x) (quote hello))) (quote function)))
+   nil)
+ nil)
+
+(my-assert
+ (ff 5)
+ hello)
+
+(my-assert
+ (defun xx nil 'a)
+ xx)
+
+(my-assert
+ (progn (setf (symbol-function 'xx1) (symbol-function 'xx)) nil)
+ nil)
+
+(my-assert
+ (xx1)
+ a)
+
+(my-assert
+ (setq l '(a 1 c d))
+ (a 1 c d))
+
+(my-assert
+ (setf (the integer (cadr l)) 100)
+ 100)
+
+(my-assert
+ l
+ (a 100 c d))
+
+(my-assert
+ (progn (setf a (make-hash-table)) t)
+ t)
+
+(my-assert
+ (setf (gethash 'color a) 'brown)
+ brown)
+
+(my-assert
+ (gethash 'color a)
+ brown)
+
+(my-assert
+ (defstruct schiff masse)
+ schiff)
+
+(my-assert
+ (progn (setf s1 (make-schiff)) nil)
+ nil)
+
+(my-assert
+ (setf (schiff-masse s1) 500)
+ 500)
+
+(my-assert
+ (schiff-masse s1)
+ 500)
+
+(my-assert
+ (defmacro setf-test (v) `(svref ,v 3))
+ setf-test)
+
+(my-assert
+ (progn (setf (macro-function 'setf-test1) (macro-function 'setf-test)) nil)
+ nil)
+
+(my-assert
+ (setf (setf-test vec1) 'oho)
+ oho)
+
+(my-assert
+ (eval 'vec1)
+ #(0 oo kk oho))
+
+(my-assert
+ (setf (setf-test1 vec1) 'hihi)
+ hihi)
+
+(my-assert
+ (eval 'vec1)
+ #(0 oo kk hihi))
+
+;;  (setf (displace ?? (svref vec1 3)) "aha")
+;;  aha
+
+;;  (eval 'vec1)
+;;  #(0 oo kk aha)
+
+(my-assert
+ (progn (setf a (make-array '(4 3))) nil)
+ nil)
+
+(my-assert
+ (aref a 2 2)
+ #+(or xcl cmu) 0
+ #+(or clisp akcl allegro ecls) nil
+ #-(or xcl clisp akcl allegro cmu ecls) unknown)
+
+(my-assert
+ (setf (apply #'aref a '(2 2)) 'xxxx)
+ xxxx)
+
+(my-assert
+ (aref a 2 2)
+ xxxx)
+
+(my-assert
+ (setf (aref '#(a b c) 1) (quote ii))
+ ii)
+
+(my-assert
+ (setf b #*101010)
+ #*101010)
+
+(my-assert
+ (bit b 2)
+ 1)
+
+(my-assert
+ (setf (bit b 2) 0)
+ 0)
+
+(my-assert
+ (bit b 2)
+ 0)
+
+(my-assert
+ (setf (sbit b 2) 1)
+ 1)
+
+(my-assert
+ (sbit b 2)
+ 1)
+
+(my-assert
+ (progn (setf a (make-array 5 :fill-pointer t)) t)
+ t)
+
+(my-assert
+ (fill-pointer a)
+ 5)
+
+(my-assert
+ (setf (fill-pointer a) 3)
+ 3)
+
+(my-assert
+ (fill-pointer a)
+ 3)
+
+(my-assert
+ (let ((str (copy-seq "hose")))
+   str)
+ "hose")
+
+(my-assert
+ (let ((str (copy-seq "hose")))
+   (setf (char str 0) #\d))
+ #\d)
+
+(my-assert
+  (let ((str (copy-seq "hose")))
+   (setf (char str 0) #\d)
+   str)
+ "dose")
+
+(my-assert
+ (let ((str (copy-seq "hose")))
+   (setf (char str 0) #\d)
+   (setf str "aaaxxxccc"))
+ "aaaxxxccc")
+
+(my-assert
+ (let ((str (copy-seq "hose")))
+   (setf (char str 0) #\d)
+   (setf str (copy-seq "aaaxxxccc"))
+   (setf (subseq str 3 6) "bbb"))
+ "bbb")
+
+(my-assert
+ (let ((str (copy-seq "hose")))
+   (setf (char str 0) #\d)
+   (setf str (copy-seq "aaaxxxccc"))
+   (setf (subseq str 3 6) "bbb")
+   str)
+ "aaabbbccc")
+
+(my-assert
+ (setq x (list 'a 'b 'c))
+ (a b c))
+
+(my-assert
+ (shiftf (cadr x) 'z)
+ b)
+
+(my-assert
+ x
+ (a z c))
+
+(my-assert
+ (shiftf (cadr x) (cddr x) 'q)
+ z)
+
+(my-assert
+ x
+ (a (c) . q))
+
+(my-assert
+ (progn
+   (defun ad (x) (values (car x) (cdr x)))
+   (defsetf ad (x) (a b) `(setf (values (car ,x) (cdr ,x)) (values ,a ,b)))
+   (setq x (cons 1 2) y 3 z 4 w 5 v 6 u 7))
+ 7)
+
+(my-assert
+ (rotatef (ad x) (values y z) (values w v u))
+ nil)
+
+(my-assert
+ x
+ (3 . 4))
+
+(my-assert
+ (list y z w v u)
+ (5 6 1 2 nil))
+
+(my-assert 
+ (multiple-value-list
+  (shiftf (ad x)
+	  (values y z w)
+	  (values v u)
+	  (floor 89 10)))
+ (3 4)
+ "(ad x) ->  3 and  4)
+ (y -> 5 z -> 6 w -> 1)
+ (v -> 2 u-> nil)
+ (floor 89 10) -> 8 and 9
+
+so after shifting we expect:
+x -> (5 . 6)
+(y -> 2 z-> nil w -> nil)
+(v -> 8 u -> 9)
+
+and we return 3 and 4")
+
+(my-assert
+ x
+ (5 . 6)
+ "check the shiftf result")
+
+(my-assert
+ (list y z w v u)
+ (2 nil nil 8 9)
+ "check the shiftf result")
+
+(my-assert
+ (progn (defsetf subseq (sequence start &optional end) (new-sequence)
+	  `(progn (replace ,sequence ,new-sequence
+			   :start1 ,start :end1 ,end)
+		  ,new-sequence)) t)
+ t)
+
+(my-assert
+ (let (s)
+   (setf s (copy-seq "asdfg")
+	 (subseq s 1 3) "xy"))
+ "xy")
+
+(my-assert
+  (let (s)
+   (setf s (copy-seq "asdfg")
+	 (subseq s 1 3) "xy")
+   s)
+ "axyfg")
+
diff --git a/src/ansi-tests/steele7.lisp b/src/ansi-tests/steele7.lisp
new file mode 100644
index 000000000..2e6e24638
--- /dev/null
+++ b/src/ansi-tests/steele7.lisp
@@ -0,0 +1,560 @@
+;;; based on v1.3 -*- mode: lisp -*-
+(in-package :cl-user)
+;;;
+;;; testfile nach steele-beispielen
+;;;
+
+;; 7.3
+
+
+(my-assert
+ (let ((f '+))
+   (apply f '(1 2)))
+ 3)
+
+(my-assert
+ (let    ((f #'-))
+   (apply f '(1 2)))
+ -1)
+
+(my-assert
+ (apply #'max 3 5 '(2 7 3))
+ 7)
+
+(my-assert
+ (apply 'cons '((+ 2 3) 4))
+ ((+ 2 3) . 4))
+
+
+(my-assert
+ (apply #'+ '())
+ 0)
+
+(my-assert
+ (apply #'(lambda (&key a b)(list a b)) '(:b 3))
+ (nil 3))
+
+
+(my-assert
+ (funcall '+ 2 3)
+ 5)
+
+(my-assert
+ (let    ((c (symbol-function '+)))
+   (funcall c 1 2 3 4))
+ 10)
+
+
+;;abschnitt 7.4
+
+;; progn
+(my-assert
+ (progn 1 2 3)
+ 3)
+
+(my-assert
+ (progn (+ 2 1) 2)
+ 2)
+
+(my-assert
+ (progn 1 2 (values  2 3))
+ 2)
+
+(my-assert
+ (progn)
+ nil)
+
+
+;; prog1
+(my-assert
+ (prog1 1 2 3)
+ 1)
+
+(my-assert
+ (prog1 3 (+ 1 2) 2)
+ 3)
+
+(my-assert
+ (prog1 (values  2 3) 1 2 )
+ 2)
+
+(my-assert
+ (let ((x '(a b c)))
+   (prog1 (car x)(rplaca x 'foo)))
+ a)
+
+;; prog2
+
+(my-assert
+ (prog2 1 2 3)
+ 2)
+
+(my-assert
+ (prog2  (+ 1 2) 2 3)
+ 2)
+
+(my-assert
+ (prog2 1 (values  2 3) 4)
+ 2)
+
+;; 7.5
+
+;; let
+(setf a 0)
+
+(my-assert
+ (let ((a 1)(b 2) c)
+   (declare (integer a b))
+   (list a b c))
+ (1 2 nil))
+
+
+(my-assert
+ (let ((a 1)
+       (b a))
+   (declare (integer a b))
+   (list a b))
+ (1 0))
+
+(my-assert
+ (let (x239)
+   (declare (special x239))
+   (symbol-value 'x239))
+ nil)
+
+;; let*
+(my-assert
+ (let* ((a 1)(b 2) c )
+   (declare (integer a b))
+   (list a b c))
+ (1 2 nil))
+
+
+(my-assert
+ (let* ((a 1)(b a))
+   (declare (integer a b))
+   (list a b))
+ (1 1))
+
+;; compiler-let (?)
+
+
+;; progv
+
+(my-assert
+ (progv
+     '(a b c)
+     '(1 2 3)
+
+   (+ a b c))
+ 6)
+
+(unintern 'a)
+(unintern 'b)
+(unintern 'c)
+
+(my-assert
+ (progv
+     '(a b c)
+     '(1 2)
+
+   (list a b c))
+ error)
+
+(my-assert
+ (let ((v '(a b c))
+       (val '(3 2 1)))
+   (progv v val (mapcar #'eval v)))
+ (3 2 1))
+
+
+;; flet
+
+(my-assert
+ (flet ((plus (a b)(+ a b))
+	(minus (a b)(- a b)))
+   (list (plus 1 2)(minus 1 2)))
+ (3 -1))
+
+
+(my-assert
+ (list (flet ( (+ (a b)(- a b)))(+ 3 2))(+ 3 2))
+ (1 5))
+
+(my-assert
+ (flet ((+ (a b)(+ (+ a b a) b)))(+ 3 2))
+ 10)
+
+;; labels
+(my-assert
+ (labels ((queue (l)(if (car l)(queue (cdr l))'ende)))(queue '(1 2 3)))
+ ende)
+
+(my-assert
+ (labels ((+ (a b)(* a (+ a a b))))(+ 1 2 3))
+ error)
+
+;; macrolet ?
+
+
+;; 7.6
+
+;; if
+
+(my-assert
+ (let ((a t)(b nil))(list (if a 1 2)(if b 1 2)(if a 1)(if b 1)))
+ (1 2 1 nil))
+
+
+;; when
+(my-assert
+ (let ((a t)(b nil))(list (when a 1 2)(when b 1 2)(when a 1)))
+ (2 nil 1))
+
+
+;; unless
+(my-assert
+ (let ((a t)(b nil))(list (unless a 1 2)(unless b 1 2)(unless a 1)))
+ (nil 2 nil))
+
+
+;; cond
+(my-assert
+ (let ((a t)(b 10)(c nil))
+   (list (cond (a 1)(t 'end))(cond (b)(t 'end))(cond (c 1)(t 'end))))
+ (1 10 end))
+
+
+;; case
+(my-assert
+ (case (+  1 2)
+   (1 -1)
+   (2 -2)
+   (3 -3))
+ -3)
+
+(my-assert
+ (case (+  1 2)
+   (1 -1)
+   (2 -2))
+ nil)
+
+
+;; (case (+  1 2)
+;;       (1 -1)
+;;       (2 -2)
+;;       (1 -1)
+;;       (3 -3))
+;; error
+
+
+(my-assert
+ (case (+  1 2)
+   ((1 3) -1)
+   (2 -2)
+   (otherwise 100))
+ -1)
+
+
+;;
+;; (case (+  1 2)
+;;       ((1 3) -1)
+;;       ((2 1) -2)
+;;       (t 100))
+;; error          ;weil ein key nur einmal erscheinen darf!
+;;
+
+
+
+;; typecase
+
+(my-assert
+ (typecase (+  1 2)
+   (list -2)
+   (null -3)
+   (integer -1))
+ -1)
+
+;; 7.7
+
+;; block
+
+(my-assert
+ (block blocktest (if t (return 0) ) 1)
+ error)
+
+(my-assert
+ (block blocktest (if t (return-from blocktest 0) ) 1)
+ 0)
+
+
+(my-assert
+ (block blocktest (if nil (return-from blocktest 0) ) 1)
+ 1)
+
+
+(my-assert
+ (block blocktest (catch 'catcher
+		    (if t (throw 'catcher 0) ) 1))
+ 0)
+
+
+;; 7.8
+
+;; 7.8.1
+
+;; loop
+
+(my-assert
+ (let ((i 10))
+   (loop (if (< (decf i) 1)(return i))))
+ 0)
+
+
+(my-assert
+ (let ((i 10))
+   (catch 'catcher
+     (loop (if (< (decf i) 1)(return i)))))
+ 0)
+
+;; 7.8.2
+;; do,do*
+
+(setf a 0)
+
+(my-assert
+ (do ((a 1 (+ a 1))(b a))
+     ((> a 9) (list b c))
+   (setf c (+ a b)))
+ (0 9))
+
+(my-assert
+ (do* ((a 1 (+ a 1))(b a))
+     ((> a 9) b)
+   )
+ 1)
+
+(my-assert
+ (let ((a 0))
+   (do* ((a 1 (+ a 1))(b a))
+       ((> a 9) a)
+     (declare (integer a b)))
+   a)
+ 0)
+
+
+
+;; 7.8.3
+
+
+;; dolist
+(my-assert
+ (let    ((l '(1 2 3))
+	  (r 0))
+   (dolist (x l r)
+     (setf r (+ r  x)) ))
+ 6)
+
+
+;; dolist
+(my-assert
+ (let ((l '(1 2 3)))
+   (dolist (x l)(if (> 0 x)(incf x)(return 10))))
+ 10)
+
+(my-assert
+ (let ((l '(1 2 3)))
+   (dolist (x l )(incf x)))
+ nil)
+
+;; dotimes
+
+(my-assert
+ (let ((s 0))
+   (dotimes (i (+ 1 9)s)
+     (setf s (+ s i))))
+ 45)
+
+
+;; 7.8.4
+
+
+;; mapcar
+
+(my-assert
+ (mapcar #'abs '(3 -4 2 -5 -6))
+ (3 4 2 5 6))
+
+(my-assert
+ (mapcar #'cons '(a b c) '(1 2 3))
+ ((a . 1) (b . 2) (c . 3)))
+
+
+;; maplist
+
+(my-assert
+ (maplist #'(lambda (x)(cons 'foo x))'(a b c d))
+ ((foo a b c d)(foo b c d)(foo c d)(foo d)))
+
+
+(my-assert
+ (maplist #'(lambda (x) (if (member (car x)(cdr x)) 0 1))
+	  '(a b a c d b c))
+ (0 0 1 0 1 1 1))
+
+
+;; mapc
+(my-assert
+ (mapc #'abs '(3 -4 2 -5 -6))
+ (3 -4 2 -5 -6))
+
+;; mapc
+
+(my-assert
+ (mapl #'(lambda (x y)(cons x y))'(a b c d)'(1 2 3 4))
+ (a b c d))
+
+;; mapcan
+
+(my-assert
+ (mapcan #'(lambda (x)(and (numberp x)(list x)))'(a 1 b c 3 4 d 5))
+ (1 3 4 5))
+
+;; mapcon
+
+(my-assert
+ (mapcon #'(lambda (x)(and (oddp (car x))(list (car x))))'(5 4 3 2 1))
+ (5 3 1))
+
+;; 7.8.5
+
+;; tagbody
+(my-assert
+ (let ((a 0))
+   (tagbody (if nil (go tag0) (go tag1))
+	    (this will never be reached)
+	    tag0
+	    (setf a 1)
+	    tag1
+	    (setf a 2))
+   a)
+ 2)
+
+(my-assert
+ (let ((a 0))
+   (tagbody (if t (go tag0) (go tag1))
+	    (this will never be reached)
+	    tag0
+	    (setf a 1)
+	    )
+   a)
+ ;;  cmucl compiles on the fly and therefore signals an error
+ #-(or cmu sbcl) 1
+ #+(or cmu sbcl) error)
+
+
+
+;; prog*
+
+(my-assert
+ (let ((z '(1 0)))
+   (prog* ((y z)(x (car y)))
+	  (return x)))
+ 1)
+
+(my-assert
+ (prog  (a (b 1))
+	(if a (go tag0) (go tag1))
+	(this will never be reached)
+	tag0
+	(setf a 1)
+	(this will never be reached)
+	tag1
+	(setf a 2))
+ nil)
+
+
+
+(my-assert
+ (prog  (a (b 1))
+	(if a (return nil) (go tag1))
+	(this will never be reached)
+	tag0
+	(return (list a 1))
+	tag1
+	(setf a 2)
+	(go tag0))
+ (2 1))
+
+
+;; 7.9
+
+;; multiple-value-bind
+(my-assert
+ (defun adder (x y)(values (+ 1 x)(+ 1 y) ) )
+ adder)
+
+
+(my-assert
+ (multiple-value-bind (a b)(adder 1 2)(+ a b))
+ 5)
+
+(my-assert
+ (defun adder (x y)(values-list (list  (+ 1 x)(+ 1 y))))
+ adder)
+
+
+(my-assert
+ (multiple-value-bind (a b)(adder 1 2)(+ a b))
+ 5)
+
+
+(my-assert
+ (multiple-value-list (floor -3 4))
+ (-1 1))
+
+
+(my-assert
+ (multiple-value-call #'+ (floor 5 3)(floor 19 4))
+ 10)
+
+(my-assert
+ (multiple-value-bind (c d)
+     (multiple-value-prog1 (floor -3 4) (+ 1 2))
+   (list c d))
+ (-1 1))
+
+
+(my-assert
+ (multiple-value-bind (x)(floor 5 3)(list x))
+ (1))
+
+
+(my-assert
+ (multiple-value-bind (x y)(floor 5 3)(list x y))
+ (1 2))
+
+
+(my-assert
+ (multiple-value-bind (x y z)(floor 5 3)(list x y z))
+ (1 2 nil))
+
+
+
+
+(my-assert
+ (multiple-value-setq
+     (a b)
+   (values 10 20))
+ 10)
+
+(my-assert
+ b
+ 20)
+
+(unintern 'a)
+(unintern 'b)
+;; 7.10
+
+;; catch/throw/unwind-protect
+
diff --git a/src/ansi-tests/streams.lisp b/src/ansi-tests/streams.lisp
new file mode 100644
index 000000000..ff3e11bf1
--- /dev/null
+++ b/src/ansi-tests/streams.lisp
@@ -0,0 +1,1379 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+#+xcl
+(my-assert
+ (progn (in-package 'sys) t)
+ t)
+
+#-(or akcl allegro)
+(my-assert
+ (prin1-to-string (make-broadcast-stream))
+ #+xcl "#<%TYPE-STRUCTURE-STREAM NIL>"
+ #+clisp "#<BROADCAST-STREAM>"
+ #+(or cmu sbcl) "#<Broadcast Stream>"
+ #+ecls "#<broadcast stream 8>"
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (progn (setq s1 (open "d1.plc" :direction :output))
+	(setq s2 (open "d2.plc" :direction :output))
+	(setq s3 (open "d3.plc" :direction :output))
+	(setq b1 (make-broadcast-stream s1 s2 s3 *standard-output*)) t)
+ t)
+
+(my-assert
+ (print "test broadcast satz 1" b1)
+ "test broadcast satz 1")
+
+(my-assert
+ (print "test broadcast satz 2" b1)
+ "test broadcast satz 2")
+
+(my-assert
+ (print "test broadcast satz 3" b1)
+ "test broadcast satz 3")
+
+(my-assert
+ (close s1)
+ t)
+
+(my-assert
+ (close s2)
+ t)
+
+(my-assert
+ (close s3)
+ t)
+
+(my-assert
+ (progn (setq s (open "d1.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "test broadcast satz 1")
+
+(my-assert
+ (read s)
+ "test broadcast satz 2")
+
+(my-assert
+ (read s)
+ "test broadcast satz 3")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "d2.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "test broadcast satz 1")
+
+(my-assert
+ (read s)
+ "test broadcast satz 2")
+
+(my-assert
+ (read s)
+ "test broadcast satz 3")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "d3.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "test broadcast satz 1")
+
+(my-assert
+ (read s)
+ "test broadcast satz 2")
+
+(my-assert
+ (read s)
+ "test broadcast satz 3")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t0.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print (quote read1) s)
+ read1)
+
+(my-assert
+ (print (quote read2) s)
+ read2)
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq inptw (open "t0.plc"))
+	(setq s1 (open "d1.plc" :direction :output))
+	(setq s2 (open "d2.plc" :direction :output))
+	(setq sy (make-synonym-stream (quote s2)))
+	(setq s3 (open "d3.plc" :direction :output))
+	(setq tw (make-two-way-stream inptw s3))
+	(setq s4 (open "d4.plc" :direction :output))
+	(setq ec (make-echo-stream inptw s4))
+	(setq s5 (open "d5.plc" :direction :output))
+	(setq s6 (open "d6.plc" :direction :output))
+	(setq b1 (make-broadcast-stream s5 s6))
+	(setq s7 (open "d7.plc" :direction :output))
+	(setq b2 (make-broadcast-stream s1 sy tw ec b1 s7)) t)
+ t)
+
+(my-assert
+ (print "w to b2 1.satz" b2)
+ "w to b2 1.satz")
+
+(my-assert
+ (print "w to sy" sy)
+ "w to sy")
+
+(my-assert
+ (print "w to b2 2.satz" b2)
+ "w to b2 2.satz")
+
+(my-assert
+ (print "w to tw" tw)
+ "w to tw")
+
+(my-assert
+ (print "w to b2 3.satz" b2)
+ "w to b2 3.satz")
+
+(my-assert
+ (print "w to ec" ec)
+ "w to ec")
+
+(my-assert
+ (print "w to b2 4.satz" b2)
+ "w to b2 4.satz")
+
+(my-assert
+ (print "w to b1" b1)
+ "w to b1")
+
+(my-assert
+ (print "w to b2 5.satz" b2)
+ "w to b2 5.satz")
+
+(my-assert
+ (print "w to s7" s7)
+ "w to s7")
+
+(my-assert
+ (print "w to b2 6.satz" b2)
+ "w to b2 6.satz")
+
+(my-assert
+ (read tw)
+ read1)
+
+(my-assert
+ (read ec)
+ read2)
+
+(my-assert
+ (print "w to b2 7.satz" b2)
+ "w to b2 7.satz")
+
+(my-assert
+ (print "w to b2 8.satz" b2)
+ "w to b2 8.satz")
+
+(my-assert
+ (close inptw)
+ t)
+
+(my-assert
+ (close s1)
+ t)
+
+(my-assert
+ (close s2)
+ t)
+
+(my-assert
+ (close s3)
+ t)
+
+(my-assert
+ (close s4)
+ t)
+
+(my-assert
+ (close s5)
+ t)
+
+(my-assert
+ (close s6)
+ t)
+
+(my-assert
+ (close s7)
+ t)
+
+(my-assert
+ (progn (setq s (open "d1.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "w to b2 1.satz")
+
+(my-assert
+ (read s)
+ "w to b2 2.satz")
+
+(my-assert
+ (read s)
+ "w to b2 3.satz")
+
+(my-assert
+ (read s)
+ "w to b2 4.satz")
+
+(my-assert
+ (read s)
+ "w to b2 5.satz")
+
+(my-assert
+ (read s)
+ "w to b2 6.satz")
+
+(my-assert
+ (read s)
+ "w to b2 7.satz")
+
+(my-assert
+ (read s)
+ "w to b2 8.satz")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "d2.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "w to b2 1.satz")
+
+(my-assert
+ (read s)
+ "w to sy")
+
+(my-assert
+ (read s)
+ "w to b2 2.satz")
+
+(my-assert
+ (read s)
+ "w to b2 3.satz")
+
+(my-assert
+ (read s)
+ "w to b2 4.satz")
+
+(my-assert
+ (read s)
+ "w to b2 5.satz")
+
+(my-assert
+ (read s)
+ "w to b2 6.satz")
+
+(my-assert
+ (read s)
+ "w to b2 7.satz")
+
+(my-assert
+ (read s)
+ "w to b2 8.satz")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "d3.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "w to b2 1.satz")
+
+(my-assert
+ (read s)
+ "w to b2 2.satz")
+
+(my-assert
+ (read s)
+ "w to tw")
+
+(my-assert
+ (read s)
+ "w to b2 3.satz")
+
+(my-assert
+ (read s)
+ "w to b2 4.satz")
+
+(my-assert
+ (read s)
+ "w to b2 5.satz")
+
+(my-assert
+ (read s)
+ "w to b2 6.satz")
+
+(my-assert
+ (read s)
+ "w to b2 7.satz")
+
+(my-assert
+ (read s)
+ "w to b2 8.satz")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "d4.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "w to b2 1.satz")
+
+(my-assert
+ (read s)
+ "w to b2 2.satz")
+
+(my-assert
+ (read s)
+ "w to b2 3.satz")
+
+(my-assert
+ (read s)
+ "w to ec")
+
+(my-assert
+ (read s)
+ "w to b2 4.satz")
+
+(my-assert
+ (read s)
+ "w to b2 5.satz")
+
+(my-assert
+ (read s)
+ "w to b2 6.satz")
+
+(my-assert
+ (read s)
+ read2)
+
+(my-assert
+ (read s)
+ "w to b2 7.satz")
+
+(my-assert
+ (read s)
+ "w to b2 8.satz")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "d5.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "w to b2 1.satz")
+
+(my-assert
+ (read s)
+ "w to b2 2.satz")
+
+(my-assert
+ (read s)
+ "w to b2 3.satz")
+
+(my-assert
+ (read s)
+ "w to b2 4.satz")
+
+(my-assert
+ (read s)
+ "w to b1")
+
+(my-assert
+ (read s)
+ "w to b2 5.satz")
+
+(my-assert
+ (read s)
+ "w to b2 6.satz")
+
+(my-assert
+ (read s)
+ "w to b2 7.satz")
+
+(my-assert
+ (read s)
+ "w to b2 8.satz")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "d6.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "w to b2 1.satz")
+
+(my-assert
+ (read s)
+ "w to b2 2.satz")
+
+(my-assert
+ (read s)
+ "w to b2 3.satz")
+
+(my-assert
+ (read s)
+ "w to b2 4.satz")
+
+(my-assert
+ (read s)
+ "w to b1")
+
+(my-assert
+ (read s)
+ "w to b2 5.satz")
+
+(my-assert
+ (read s)
+ "w to b2 6.satz")
+
+(my-assert
+ (read s)
+ "w to b2 7.satz")
+
+(my-assert
+ (read s)
+ "w to b2 8.satz")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "d7.plc")) t)
+ t)
+
+(my-assert
+ (read s)
+ "w to b2 1.satz")
+
+(my-assert
+ (read s)
+ "w to b2 2.satz")
+
+(my-assert
+ (read s)
+ "w to b2 3.satz")
+
+(my-assert
+ (read s)
+ "w to b2 4.satz")
+
+(my-assert
+ (read s)
+ "w to b2 5.satz")
+
+(my-assert
+ (read s)
+ "w to s7")
+
+(my-assert
+ (read s)
+ "w to b2 6.satz")
+
+(my-assert
+ (read s)
+ "w to b2 7.satz")
+
+(my-assert
+ (read s)
+ "w to b2 8.satz")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t1.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t1" s)
+ "1.satz t1")
+
+(my-assert
+ (print "2.satz t1" s)
+ "2.satz t1")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t2.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t2" s)
+ "1.satz t2")
+
+(my-assert
+ (print "2.satz t2" s)
+ "2.satz t2")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t3.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t3" s)
+ "1.satz t3")
+
+(my-assert
+ (print "2.satz t3" s)
+ "2.satz t3")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t4.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t4" s)
+ "1.satz t4")
+
+(my-assert
+ (print "2.satz t4" s)
+ "2.satz t4")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t5.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t5" s)
+ "1.satz t5")
+
+(my-assert
+ (print "2.satz t5" s)
+ "2.satz t5")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t6.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t6" s)
+ "1.satz t6")
+
+(my-assert
+ (print "2.satz t6" s)
+ "2.satz t6")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t7.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t7" s)
+ "1.satz t7")
+
+(my-assert
+ (print "2.satz t7" s)
+ "2.satz t7")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t8.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t8" s)
+ "1.satz t8")
+
+(my-assert
+ (print "2.satz t8" s)
+ "2.satz t8")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t9.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t9" s)
+ "1.satz t9")
+
+(my-assert
+ (print "2.satz t9" s)
+ "2.satz t9")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s (open "t10.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (print "1.satz t10" s)
+ "1.satz t10")
+
+(my-assert
+ (print "2.satz t10" s)
+ "2.satz t10")
+
+(my-assert
+ (close s)
+ t)
+
+(my-assert
+ (progn (setq s1 (open "t1.plc")) (setq s2 (open "t2.plc"))
+	(setq s3 (open "t3.plc")) (setq s4 (open "t4.plc")) (setq s5 (open
+								      "t5.plc"))
+	(setq c1 (make-concatenated-stream s1 s2 s3))
+	(setq c2 (make-concatenated-stream s4 s5)) t)
+ t)
+
+(my-assert
+ (read c1)
+ "1.satz t1")
+
+(my-assert
+ (read c2)
+ "1.satz t4")
+
+(my-assert
+ (read c1)
+ "2.satz t1")
+
+(my-assert
+ (read c1)
+ "1.satz t2")
+
+(my-assert
+ (read c2)
+ "2.satz t4")
+
+(my-assert
+ (read c2)
+ "1.satz t5")
+
+(my-assert
+ (read c1)
+ "2.satz t2")
+
+(my-assert
+ (read c1)
+ "1.satz t3")
+
+(my-assert
+ (read c1)
+ "2.satz t3")
+
+(my-assert
+ (read c2)
+ "2.satz t5")
+
+(my-assert
+ (close s1)
+ t)
+
+(my-assert
+ (close s2)
+ t)
+
+(my-assert
+ (close s3)
+ t)
+
+(my-assert
+ (close s4)
+ t)
+
+(my-assert
+ (close s5)
+ t)
+
+(my-assert
+ (progn (setq s1 (open "t1.plc")) (setq s2 (open "t2.plc"))
+	(setq s3 (open "t3.plc")) (setq s4 (open "t4.plc")) (setq s5 (open
+								      "t5.plc"))
+	(setq s6 (open "t6.plc")) (setq s7 (open "t7.plc")) (setq s8 (open
+								      "t8.plc"))
+	(setq s9 (open "t9.plc")) (setq s10 (open "t10.plc"))
+	(setq c1 (make-concatenated-stream s1 s2))
+	(setq c2 (make-concatenated-stream s3))
+	(setq c3 (make-concatenated-stream c1 c2 s4))
+	(setq c4 (make-concatenated-stream s5 s6 s7 s8 s9 s10)) t)
+ t)
+
+(my-assert
+ (read c4)
+ "1.satz t5")
+
+(my-assert
+ (read c3)
+ "1.satz t1")
+
+(my-assert
+ (read c4)
+ "2.satz t5")
+
+(my-assert
+ (read c4)
+ "1.satz t6")
+
+(my-assert
+ (read c3)
+ "2.satz t1")
+
+(my-assert
+ (read c3)
+ "1.satz t2")
+
+(my-assert
+ (read c4)
+ "2.satz t6")
+
+(my-assert
+ (read c4)
+ "1.satz t7")
+
+(my-assert
+ (read c4)
+ "2.satz t7")
+
+(my-assert
+ (read c3)
+ "2.satz t2")
+
+(my-assert
+ (read c3)
+ "1.satz t3")
+
+(my-assert
+ (read c3)
+ "2.satz t3")
+
+(my-assert
+ (read c4)
+ "1.satz t8")
+
+(my-assert
+ (read c4)
+ "2.satz t8")
+
+(my-assert
+ (read c4)
+ "1.satz t9")
+
+(my-assert
+ (read c4)
+ "2.satz t9")
+
+(my-assert
+ (read c3)
+ "1.satz t4")
+
+(my-assert
+ (read c3)
+ "2.satz t4")
+
+(my-assert
+ (read c4)
+ "1.satz t10")
+
+(my-assert
+ (read c4)
+ "2.satz t10")
+
+(my-assert
+ (close s1)
+ t)
+
+(my-assert
+ (close s2)
+ t)
+
+(my-assert
+ (close s3)
+ t)
+
+(my-assert
+ (close s4)
+ t)
+
+(my-assert
+ (close s5)
+ t)
+
+(my-assert
+ (close s6)
+ t)
+
+(my-assert
+ (close s7)
+ t)
+
+(my-assert
+ (close s8)
+ t)
+
+(my-assert
+ (close s9)
+ t)
+
+(my-assert
+ (close s10)
+ t)
+
+(my-assert
+ (setq str1 "test 123456")
+ "test 123456")
+
+(my-assert
+ (progn (setq s1 (make-string-input-stream str1)) t)
+ t)
+
+(my-assert
+ (read s1)
+ test)
+
+(my-assert
+ (read-char s1)
+ #\1)
+
+(my-assert
+ (read-char s1)
+ #\2)
+
+(my-assert
+ (unread-char #\2 s1)
+ nil)
+
+(my-assert
+ (read-char s1)
+ #\2)
+
+(my-assert
+ (read-char s1)
+ #\3)
+
+(my-assert
+ (read-char s1)
+ #\4)
+
+(my-assert
+ (unread-char #\a s1)
+ error
+ "We previously read #\4 from S1, we are not allowed to
+put #\a back in!")
+
+(my-assert
+ (read-char s1)
+ #\5
+ "The previous unread-char should have failed, so
+we expect to see #\5 here. If the unread-char worked
+we will (wrongly!) see #\4 or #\a")
+
+(my-assert
+ (read-char s1)
+ #\6
+ "Likewise the unread-char should have failed")
+
+(my-assert
+ (close s1)
+ t)
+
+(my-assert
+ str1
+ "test 123456")
+
+(my-assert
+ (multiple-value-list (read-from-string "012345 789"))
+ (12345 7))
+
+(my-assert
+ (multiple-value-list (read-from-string "012345 789" t nil
+					:preserve-whitespace t))
+ (12345 6))
+
+(my-assert
+ (multiple-value-list (read-from-string "012345 789" t nil :end 4))
+ (123 4))
+
+(my-assert
+ (multiple-value-list (read-from-string "012345 789" t nil :start 2))
+ (2345 7))
+
+(my-assert
+ (progn (setq strgstream (make-string-input-stream "0123456789" 5 8))
+	t)
+ t)
+
+(my-assert
+ (read strgstream)
+ 567)
+
+(my-assert
+ (progn (setq strgstream
+	      (make-string-input-stream "wenn alles gut geht ist das ein stream 012"))
+	t)
+ t)
+
+(my-assert
+ (read strgstream)
+ wenn)
+
+(my-assert
+ (read strgstream)
+ alles)
+
+(my-assert
+ (read strgstream)
+ gut)
+
+(my-assert
+ (read strgstream)
+ geht)
+
+(my-assert
+ (read strgstream)
+ ist)
+
+(my-assert
+ (read strgstream)
+ das)
+
+(my-assert
+ (read strgstream)
+ ein)
+
+(my-assert
+ (read strgstream)
+ stream)
+
+(my-assert
+ (read strgstream)
+ 12)
+
+(my-assert
+ (progn (setq strgstream (make-string-output-stream)) t)
+ t)
+
+(my-assert
+ (princ "das " strgstream)
+ "das ")
+
+(my-assert
+ (princ "ist " strgstream)
+ "ist ")
+
+(my-assert
+ (princ "ein " strgstream)
+ "ein ")
+
+(my-assert
+ (princ "string " strgstream)
+ "string ")
+
+(my-assert
+ (princ "output " strgstream)
+ "output ")
+
+(my-assert
+ (princ "stream " strgstream)
+ "stream ")
+
+(my-assert
+ (get-output-stream-string strgstream)
+ "das ist ein string output stream ")
+
+(my-assert
+ (get-output-stream-string strgstream)
+ "")
+
+(my-assert
+ (princ "das ist ein neuer string output stream" strgstream)
+ "das ist ein neuer string output stream")
+
+(my-assert
+ (get-output-stream-string strgstream)
+ "das ist ein neuer string output stream")
+
+(my-assert
+ (setq *print-length* 50)
+ 50)
+
+(my-assert
+ (write-to-string 123456789)
+ "123456789")
+
+(my-assert
+ "(write-to-string '#1=(123456789 . #1#))"
+ "(write-to-string '#1=(123456789 . #1#))")
+
+(my-assert
+ (prin1-to-string "abc")
+ "\"abc\"")
+
+(my-assert
+ (princ-to-string "abc")
+ "abc")
+
+(my-assert
+ (progn (setq os (make-string-output-stream)) t)
+ t)
+
+(my-assert
+ (setq s50 "123456789A123456789B123456789C123456789D12345678
+E")
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (setq s49 "123456789A123456789B123456789C123456789D1234567
+*")
+ "123456789A123456789B123456789C123456789D1234567
+*")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s49 os)
+ "123456789A123456789B123456789C123456789D1234567
+*")
+
+(my-assert
+ (princ "A" os)
+ "A")
+
+(my-assert
+ (princ "B" os)
+ "B")
+
+(my-assert
+ (princ "C" os)
+ "C")
+
+(my-assert
+ (length (princ (get-output-stream-string os)))
+ 402)
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s50 os)
+ "123456789A123456789B123456789C123456789D12345678
+E")
+
+(my-assert
+ (princ s49 os)
+ "123456789A123456789B123456789C123456789D1234567
+*")
+
+(my-assert
+ (princ s49 os)
+ "123456789A123456789B123456789C123456789D1234567
+*")
+
+(my-assert
+ (princ s49 os)
+ "123456789A123456789B123456789C123456789D1234567
+*")
+
+(my-assert
+ (princ s49 os)
+ "123456789A123456789B123456789C123456789D1234567
+*")
+
+(my-assert
+ (length (princ (get-output-stream-string os)))
+ 496)
+
+(my-assert
+ (progn (setq os (open "d0.plc" :direction :output))
+	(setq os1 (open "d1.plc" :direction :output))
+	(setq is (open "t0.plc" :direction :output)) t)
+ t)
+
+(my-assert
+ (princ "'(a b #.(print \"1.zwischenwert\" os1) c d)" is)
+ "'(a b #.(print \"1.zwischenwert\" os1) c d)")
+
+(my-assert
+ (princ "'(a b #.(prin1-to-string \"2.zwischenwert\") c d)" is)
+ "'(a b #.(prin1-to-string \"2.zwischenwert\") c d)")
+
+(my-assert
+ (princ "'(a b #.(format nil  \"3.zwischenwert\") c d)" is)
+ "'(a b #.(format nil  \"3.zwischenwert\") c d)")
+
+(my-assert
+ (close is)
+ t)
+
+(my-assert
+ (progn (setq is (open "t0.plc")) (setq es (make-echo-stream is os))
+	t)
+ t)
+
+(my-assert
+ (print "ausgabe os1" os1)
+ "ausgabe os1")
+
+(my-assert
+ (read es)
+ (quote (a b "1.zwischenwert" c d)))
+
+(my-assert
+ (print "ausgabe os1" os1)
+ "ausgabe os1")
+
+(my-assert
+ (read es)
+ (quote (a b "\"2.zwischenwert\"" c d)))
+
+(my-assert
+ (print "ausgabe os1" os1)
+ "ausgabe os1")
+
+(my-assert
+ (read es)
+ (quote (a b "3.zwischenwert" c d)))
+
+(my-assert
+ (print "ausgabe os1" os1)
+ "ausgabe os1")
+
+(my-assert
+ (close is)
+ t)
+
+(my-assert
+ (close os)
+ t)
+
+(my-assert
+ (progn (setq is (open "d0.plc")) t)
+ t)
+
+(my-assert
+ (read is)
+ (quote (a b "1.zwischenwert" c d)))
+
+(my-assert
+ (read is)
+ (quote (a b "\"2.zwischenwert\"" c d)))
+
+(my-assert
+ (read is)
+ (quote (a b "3.zwischenwert" c d)))
+
+(my-assert
+ (close is)
+ t)
+
+(my-assert
+ (close os1)
+ t)
+
+(my-assert
+ (progn (setq is (open "d1.plc")) t)
+ t)
+
+(my-assert
+ (read is)
+ "ausgabe os1")
+
+(my-assert
+ (read is)
+ "1.zwischenwert")
+
+(my-assert
+ (read is)
+ "ausgabe os1")
+
+(my-assert
+ (read is)
+ "ausgabe os1")
+
+(my-assert
+ (read is)
+ "ausgabe os1")
+
+(my-assert
+ (read is)
+ "1.zwischenwert")
+
+(my-assert
+ (close is)
+ t)
+
+(my-assert
+ (progn (mapc #'delete-file (directory "*.plc")) t)
+ t)
+
+(my-assert
+ (progn
+   (makunbound 's)
+   (makunbound 's1)
+   (makunbound 's2)
+   (makunbound 's3)
+   (makunbound 's4)
+   (makunbound 's5)
+   (makunbound 's6)
+   (makunbound 's7)
+   (makunbound 's8)
+   (makunbound 's9)
+   (makunbound 's10)
+   (makunbound 'b1)
+   (makunbound 'b2)
+   (makunbound 'c1)
+   (makunbound 'c2)
+   (makunbound 'c3)
+   (makunbound 'c4)
+   (makunbound 'inptw)
+   (makunbound 'sy)
+   (makunbound 'tw)
+   (makunbound 'ec)
+   (makunbound 'str1)
+   (makunbound 'strgstream)
+   (makunbound 'os)
+   (makunbound 'os1)
+   (makunbound 'is)
+   (makunbound 'es)
+   (makunbound 's50)
+   (makunbound 's49)
+   (setq *print-length* nil)
+   t)
+ t)
+
diff --git a/src/ansi-tests/streamslong.lisp b/src/ansi-tests/streamslong.lisp
new file mode 100644
index 000000000..50daee978
--- /dev/null
+++ b/src/ansi-tests/streamslong.lisp
@@ -0,0 +1,31 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (read-from-string "123")
+ 123)
+
+(my-assert
+ (prin1-to-string 123)
+ "123")
+
+(my-assert
+ (let ((*a*
+	(make-array 10. :element-type 'character
+		    :fill-pointer 0)))
+   (format *a* "XXX"))
+ nil)
+
+(my-assert
+ (let ((*a*
+	(make-array 10. :element-type 'character
+		    :fill-pointer 0)))
+   (format *a* "XXX")   
+   *a*)
+ "XXX")
+
+#+xcl
+(my-assert
+ (sys::check-stream-system)
+ #+xcl t)
+
diff --git a/src/ansi-tests/strings.lisp b/src/ansi-tests/strings.lisp
new file mode 100644
index 000000000..9e1246e44
--- /dev/null
+++ b/src/ansi-tests/strings.lisp
@@ -0,0 +1,1600 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (char  "abcdef-dg1ndh" 0)
+ #\a)
+
+(my-assert
+ (char  "abcdef-dg1ndh" 1)
+ #\b)
+
+(my-assert
+ (char  "abcdef-dg1ndh" 6)
+ #\-)
+
+(my-assert
+ (char  "abcdef-dg1ndh" 20)
+ error)
+
+(my-assert
+ (char  "abcdef-dg1ndh")
+ program-error)
+
+(my-assert
+ (char  "abcdef-dg1ndh" -3)
+ error)
+
+(my-assert
+ (char)
+ program-error)
+
+(my-assert
+ (char 2)
+ program-error)
+
+(my-assert
+ (char  "abcde" 2 4)
+ error)
+
+(my-assert
+ (char 'a 0)
+ #+xcl #\a
+ #-xcl error)
+
+(my-assert
+ (char 'anna 0)
+ #+xcl #\a
+ #-xcl error)
+
+(my-assert
+ (schar 'a 0)
+ #+xcl #\a
+ #-xcl error)
+
+(my-assert
+ (schar 'anna 0)
+ #+xcl #\a
+ #-xcl error)
+
+(my-assert
+ (schar  "abcdef-dg1ndh" 0)
+ #\a)
+
+(my-assert
+ (schar  "abcdef-dg1ndh" 1)
+ #\b)
+
+(my-assert
+ (schar  "abcdef-dg1ndh" 6)
+ #\-)
+
+(my-assert
+ (schar  "abcdef-dg1ndh" 20)
+ error)
+
+(my-assert
+ (schar  "abcdef-dg1ndh")
+ program-error)
+
+(my-assert
+ (schar  "abcdef-dg1ndh" -3)
+ error)
+
+(my-assert
+ (schar 2)
+ program-error)
+
+(my-assert
+ (schar 2 2)
+ error)
+
+(my-assert
+ (schar  "abcde" 2 4)
+ program-error)
+
+(my-assert
+ (string=  "foo" "foo")
+ t)
+
+(my-assert
+ (string=  "foo" "Foo")
+ nil)
+
+(my-assert
+ (string=  "foo" "FOO")
+ nil)
+
+(my-assert
+ (string=  "foo" "bar")
+ nil)
+
+(my-assert
+ (string=  "together" "frog" :start1 1 :end1 3 :start2 2)
+ t)
+
+(my-assert
+ (string=  "abcdef" "defghi" :start1 3 :end2 3)
+ t)
+
+(my-assert
+ (string=  "abcdefghi" "uvdefmgnj" :start1 3 :end1 6 :start2 2 :end2
+	   5)
+ t)
+
+(my-assert
+ (string=  "abcdefg" "abcdefg" :end2 4)
+ nil)
+
+(my-assert
+ (string=  "abcdef" "abcdef" :start1 1 :end1 4 :start2 4 :end2 1)
+ error)
+
+(my-assert
+ (string-equal  "foo" "foo")
+ t)
+
+(my-assert
+ (string-equal  "foo" "Foo")
+ t)
+
+(my-assert
+ (string-equal  "foo" "FOO")
+ t)
+
+(my-assert
+ (string-equal  "foo" "bar")
+ nil)
+
+(my-assert
+ (string-equal  "absDEfg-HijM1#r" "udEFG-hIfvd" :start1 3 :end1 10 :start2
+		1 :end2
+		8)
+ t)
+
+(my-assert
+ (string-equal  "ABCdefg" "abcDEFG")
+ t)
+
+(my-assert
+ (string-equal  "ABCdefg" "abcDEFG" :start1 3)
+ nil)
+
+(my-assert
+ (string-equal  "AbCdEf" "aBcDeF" :start1 5 :end1 3)
+ error)
+
+(my-assert
+ (string<  "" "abcdefgh")
+ 0)
+
+(my-assert
+ (string<  "a" "abcdefgh")
+ 1)
+
+(my-assert
+ (string<  "abc" "abcdefgh")
+ 3)
+
+(my-assert
+ (string<  "cabc" "abcdefgh")
+ nil)
+
+(my-assert
+ (string<  "abcdefgh" "abcdefgh")
+ nil)
+
+(my-assert
+ (string<  "xyzabc" "abcdefgh")
+ nil)
+
+(my-assert
+ (string<  "abc" "xyzabcdefgh")
+ 0)
+
+(my-assert
+ (string<  "abcdefgh" "abcdefgh" :end1 4)
+ 4)
+
+(my-assert
+ (string<  "xyzabc" "abcdefgh" :start1 3)
+ 6)
+
+(my-assert
+ (string<  "abc" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string<  "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string<  "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ nil)
+
+(my-assert
+ (string<  "abcdefgh" "")
+ nil)
+
+(my-assert
+ (string<  "abcdefgh" "a")
+ nil)
+
+(my-assert
+ (string<  "abcdefgh" "abc")
+ nil)
+
+(my-assert
+ (string<  "abcdefgh" "cabc")
+ 0)
+
+(my-assert
+ (string<  "abcdefgh" "xyzabc")
+ 0)
+
+(my-assert
+ (string<  "xyzabcdefgh" "abc")
+ nil)
+
+(my-assert
+ (string<  "abcdefgh" "abcdefgh" :end2 4)
+ nil)
+
+(my-assert
+ (string<  "xyzabc" "abcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string<  "abc" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string<  "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string<  "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ nil)
+
+(my-assert
+ (string<  "abcdef" "bcdefgh")
+ 0)
+
+(my-assert
+ (string<  "abcdef" "abcdefgh" :start2 2)
+ 0)
+
+(my-assert
+ (string<  "abcdef" "bngdabcdef" :start2 9 :end2 5)
+ error)
+
+(my-assert
+ (string>  "" "abcdefgh")
+ nil)
+
+(my-assert
+ (string>  "a" "abcdefgh")
+ nil)
+
+(my-assert
+ (string>  "abc" "abcdefgh")
+ nil)
+
+(my-assert
+ (string>  "cabc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string>  "abcdefgh" "abcdefgh")
+ nil)
+
+(my-assert
+ (string>  "xyzabc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string>  "abc" "xyzabcdefgh")
+ nil)
+
+(my-assert
+ (string>  "abcdefgh" "abcdefgh" :end1 4)
+ nil)
+
+(my-assert
+ (string>  "xyzabc" "abcdefgh" :start1 3)
+ nil)
+
+(my-assert
+ (string>  "abc" "xyzabcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string>  "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ nil)
+
+(my-assert
+ (string>  "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string>  "abcdefgh" "")
+ 0)
+
+(my-assert
+ (string>  "abcdefgh" "a")
+ 1)
+
+(my-assert
+ (string>  "abcdefgh" "abc")
+ 3)
+
+(my-assert
+ (string>  "abcdefgh" "cabc")
+ nil)
+
+(my-assert
+ (string>  "abcdefgh" "xyzabc")
+ nil)
+
+(my-assert
+ (string>  "xyzabcdefgh" "abc")
+ 0)
+
+(my-assert
+ (string>  "abcdefgh" "abcdefgh" :end2 4)
+ 4)
+
+(my-assert
+ (string>  "xyzabc" "abcdefgh" :start2 3)
+ 0)
+
+(my-assert
+ (string>  "abc" "xyzabcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string>  "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ nil)
+
+(my-assert
+ (string>  "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string>  "abcde" "bc")
+ nil)
+
+(my-assert
+ (string>  "bcdef" "abcde")
+ 0)
+
+(my-assert
+ (string>  "bcdef" "abcdef")
+ 0)
+
+(my-assert
+ (string>  "abcdefghij" "abcdefgh" :start1 1)
+ 1)
+
+(my-assert
+ (string>  "ghijkl" "xyzabcd" :start2 6 :end2 4)
+ error)
+
+(my-assert
+ (string<  "" "abcdefgh")
+ 0)
+
+(my-assert
+ (string<=  "a" "abcdefgh")
+ 1)
+
+(my-assert
+ (string<=  "abc" "abcdefgh")
+ 3)
+
+(my-assert
+ (string<=  "aaabce" "aaabcdefgh")
+ nil)
+
+(my-assert
+ (string<=  "cabc" "abcdefgh")
+ nil)
+
+(my-assert
+ (string<=  "abcdefgh" "abcdefgh")
+ 8)
+
+(my-assert
+ (string<=  "xyzabc" "abcdefgh")
+ nil)
+
+(my-assert
+ (string<=  "abc" "xyzabcdefgh")
+ 0)
+
+(my-assert
+ (string<=  "abcdefgh" "abcdefgh" :end1 4)
+ 4)
+
+(my-assert
+ (string<=  "xyzabc" "abcdefgh" :start1 3)
+ 6)
+
+(my-assert
+ (string<=  "abc" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string<=  "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string<=  "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ nil)
+
+(my-assert
+ (string<=  "abcdefgh" "")
+ nil)
+
+(my-assert
+ (string<=  "abcdefgh" "a")
+ nil)
+
+(my-assert
+ (string<=  "abcdefgh" "abc")
+ nil)
+
+(my-assert
+ (string<=  "abcdefgh" "cabc")
+ 0)
+
+(my-assert
+ (string<=  "abcdefgh" "xyzabc")
+ 0)
+
+(my-assert
+ (string<=  "xyzabcdefgh" "abc")
+ nil)
+
+(my-assert
+ (string<=  "abcdefgh" "abcdefgh" :end2 4)
+ nil)
+
+(my-assert
+ (string<=  "xyzabc" "abcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string<=  "abc" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string<=  "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string<=  "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ nil)
+
+(my-assert
+ (string<=  "abcdef" "bcdefgh")
+ 0)
+
+(my-assert
+ (string<=  "abcdef" "abcdefgh" :start2 2)
+ 0)
+
+(my-assert
+ (string<=  "abcdef" "bngdabcdef" :start2 9 :end2 5)
+ error)
+
+
+(my-assert
+ (string>= "" "abcdefgh")
+ nil)
+
+(my-assert
+ (string>= "a" "abcdefgh")
+ nil)
+
+(my-assert
+ (string>= "abc" "abcdefgh")
+ nil)
+
+(my-assert
+ (string>= "cabc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string>= "abcdefgh" "abcdefgh")
+ 8)
+
+(my-assert
+ (string>= "xyzabc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string>= "abc" "xyzabcdefgh")
+ nil)
+
+(my-assert
+ (string>= "abcdefgh" "abcdefgh" :end1 4)
+ nil)
+
+(my-assert
+ (string>= "xyzabc" "abcdefgh" :start1 3)
+ nil)
+
+(my-assert
+ (string>= "abc" "xyzabcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string>= "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ nil)
+
+(my-assert
+ (string>= "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string>= "abcdefgh" "")
+ 0)
+
+(my-assert
+ (string>= "abcdefgh" "a")
+ 1)
+
+(my-assert
+ (string>= "abcdefgh" "abc")
+ 3)
+
+(my-assert
+ (string>= "abcdefgh" "cabc")
+ nil)
+
+(my-assert
+ (string>= "abcdefgh" "xyzabc")
+ nil)
+
+(my-assert
+ (string>= "xyzabcdefgh" "abc")
+ 0)
+
+(my-assert
+ (string>= "abcdefgh" "abcdefgh" :end2 4)
+ 4)
+
+(my-assert
+ (string>= "xyzabc" "abcdefgh" :start2 3)
+ 0)
+
+(my-assert
+ (string>= "xyzabc" "abcdefgh" :start1 3)
+ nil)
+
+(my-assert
+ (string>= "abc" "xyzabcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string>= "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ nil)
+
+(my-assert
+ (string>= "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string>= "bcdef" "abcdef")
+ 0)
+
+(my-assert
+ (string>= "abcdefghij" "abcdefgh" :start1 1)
+ 1)
+
+(my-assert
+ (string>= "ghijkl" "xyzabcd" :start2 6 :end2 4)
+ error)
+
+(my-assert
+ (string/= "" "abcdefgh")
+ 0)
+
+(my-assert
+ (string/= "a" "abcdefgh")
+ 1)
+
+(my-assert
+ (string/= "abc" "abcdefgh")
+ 3)
+
+(my-assert
+ (string/= "cabc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string/= "abcdefgh" "abcdefgh")
+ nil)
+
+(my-assert
+ (string/= "xyzabc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string/= "abc" "xyzabcdefgh")
+ 0)
+
+(my-assert
+ (string/= "abcdefgh" "abcdefgh" :end1 4)
+ 4)
+
+(my-assert
+ (string/= "xyzabc" "abcdefgh" :start1 3)
+ 6)
+
+(my-assert
+ (string/= "abc" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string/= "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string/= "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string/= "abcdefgh" "")
+ 0)
+
+(my-assert
+ (string/= "abcdefgh" "a")
+ 1)
+
+(my-assert
+ (string/= "abcdefgh" "abc")
+ 3)
+
+(my-assert
+ (string/= "abcdefgh" "cabc")
+ 0)
+
+(my-assert
+ (string/= "abcdefgh" "xyzabc")
+ 0)
+
+(my-assert
+ (string/= "xyzabcdefgh" "abc")
+ 0)
+
+(my-assert
+ (string/= "abcdefgh" "abcdefgh" :end2 4)
+ 4)
+
+(my-assert
+ (string/= "xyzabc" "abcdefgh" :start2 3)
+ 0)
+
+(my-assert
+ (string/= "abc" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string/= "abc" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string/= "abc" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string/= "abcdefghi" "uvdefmgnj" :start1 3 :end1 6 :start2 2 :end2 5)
+ nil)
+
+(my-assert
+ (string/= "abcdefg" "abcdefg" :end2 4)
+ 4)
+
+(my-assert
+ (string/= "abcdef" "abcdef" :start1 1 :end1 4 :start2 4 :end2 1)
+ error)
+
+(my-assert
+ (string-lessp "" "abcDEFgh")
+ 0)
+
+(my-assert
+ (string-lessp "a" "Abcdefgh")
+ 1)
+
+(my-assert
+ (string-lessp "abc" "aBcDEfgh")
+ 3)
+
+(my-assert
+ (string-lessp "cABc" "aBCDefgh")
+ nil)
+
+(my-assert
+ (string-lessp "abCDeFgh" "abCDEfgh")
+ nil)
+
+(my-assert
+ (string-lessp "xyzAbc" "ABcCDfgh")
+ nil)
+
+(my-assert
+ (string-lessp "aBC" "xYZAbcdEfgh")
+ 0)
+
+(my-assert
+ (string-lessp "abcDEfgh" "abcDEfgh" :end1 4)
+ 4)
+
+(my-assert
+ (string-lessp "XYZabc" "ABcdefgh" :start1 3)
+ 6)
+
+(my-assert
+ (string-lessp "aBc" "xyZABcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string-lessp "abc" "xyzabCDEcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string-lessp "abc" "xyzABcdefgh" :start2 3 :end2 5)
+ nil)
+
+(my-assert
+ (string-lessp "abcdefgh" "")
+ nil)
+
+(my-assert
+ (string-lessp "Abcdefgh" "a")
+ nil)
+
+(my-assert
+ (string-lessp "ABCdefgh" "abc")
+ nil)
+
+(my-assert
+ (string-lessp "ABCdefgh" "cabc")
+ 0)
+
+(my-assert
+ (string-lessp "abcdefgh" "xyzABC")
+ 0)
+
+(my-assert
+ (string-lessp "xyzABCdefgh" "abc")
+ nil)
+
+(my-assert
+ (string-lessp "abcdEFgh" "abcdeFGh" :end2 4)
+ nil)
+
+(my-assert
+ (string-lessp "xyzaBC" "abCDefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string-lessp "ABC" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string-lessp "ABC" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string-lessp "ABC" "xyzabcdefgh" :start2 3 :end2 5)
+ nil)
+
+(my-assert
+ (string-lessp "aBCDef" "bcdefgh")
+ 0)
+
+(my-assert
+ (string-lessp "aBCDef" "abcdefgh" :start2 2)
+ 0)
+
+(my-assert
+ (string-lessp "aBCDef" "bngdabcdef" :start2 9 :end2 5)
+ error)
+
+(my-assert
+ (string-greaterp "" "abcdefgh")
+ nil)
+
+(my-assert
+ (string-greaterp "A" "abcdefgh")
+ nil)
+
+(my-assert
+ (string-greaterp "ABc" "abcdefgh")
+ nil)
+
+(my-assert
+ (string-greaterp "CAbc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string-greaterp "abcdefgh" "abcDEFgh")
+ nil)
+
+(my-assert
+ (string-greaterp "xyzabc" "abCDEfgh")
+ 0)
+
+(my-assert
+ (string-greaterp "ABC" "xyzabcdefgh")
+ nil)
+
+(my-assert
+ (string-greaterp "ABCdefgh" "abcdefgh" :end1 4)
+ nil)
+
+(my-assert
+ (string-greaterp "xyzaBc" "ABCdefgh" :start1 3)
+ nil)
+
+(my-assert
+ (string-greaterp "abc" "xyzABcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string-greaterp "abc" "xyzABcdefgh" :start2 3 :end2 8)
+ nil)
+
+(my-assert
+ (string-greaterp "abc" "xyZAbcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string-greaterp "abcdefgh" "")
+ 0)
+
+(my-assert
+ (string-greaterp "Abcdefgh" "a")
+ 1)
+
+(my-assert
+ (string-greaterp "ABCdefgh" "abc")
+ 3)
+
+(my-assert
+ (string-greaterp "ABCdefgh" "cabc")
+ nil)
+
+(my-assert
+ (string-greaterp "ABCdefgh" "xyzabc")
+ nil)
+
+(my-assert
+ (string-greaterp "xyzabcdefgh" "Abc")
+ 0)
+
+(my-assert
+ (string-greaterp "abcdefgh" "aBCDefgh" :end2 4)
+ 4)
+
+(my-assert
+ (string-greaterp "xyzabc" "abcdEFgh" :start2 3)
+ 0)
+
+(my-assert
+ (string-greaterp "ABC" "xyzabcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string-greaterp "ABC" "xyzabcdefgh" :start2 3 :end2 8)
+ nil)
+
+(my-assert
+ (string-greaterp "ABC" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string-greaterp "bCDEf" "abcde")
+ 0)
+
+(my-assert
+ (string-greaterp "bcDEF" "abcdef")
+ 0)
+
+(my-assert
+ (string-greaterp "abCDEfghij" "abcdefgh" :start1 1)
+ 1)
+
+(my-assert
+ (string-greaterp "ghijKl" "xyzabcd" :start2 6 :end2 4)
+ error)
+
+(my-assert
+ (string-not-greaterp  "" "abcdefgh")
+ 0)
+
+(my-assert
+ (string-not-greaterp  "A" "abcdefgh")
+ 1)
+
+(my-assert
+ (string-not-greaterp  "aBC" "abcdefgh")
+ 3)
+
+(my-assert
+ (string-not-greaterp  "CABc" "abcdefgh")
+ nil)
+
+(my-assert
+ (string-not-greaterp  "abcDEFgh" "abcdefgh")
+ 8)
+
+(my-assert
+ (string-not-greaterp  "xyzabc" "ABcdefgh")
+ nil)
+
+(my-assert
+ (string-not-greaterp  "abc" "xyzABcdefgh")
+ 0)
+
+(my-assert
+ (string-not-greaterp  "ABCDEFgh" "abcdefgh" :end1 4)
+ 4)
+
+(my-assert
+ (string-not-greaterp  "xyzabc" "aBCDefgh" :start1 3)
+ 6)
+
+(my-assert
+ (string-not-greaterp  "ABC" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string-not-greaterp  "ABC" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string-not-greaterp  "ABC" "xyzabcdefgh" :start2 3 :end2 5)
+ nil)
+
+(my-assert
+ (string-not-greaterp  "abcdefgh" "")
+ nil)
+
+(my-assert
+ (string-not-greaterp  "Abcdefgh" "a")
+ nil)
+
+(my-assert
+ (string-not-greaterp  "ABCdefgh" "abc")
+ nil)
+
+(my-assert
+ (string-not-greaterp  "ABCdefgh" "cabc")
+ 0)
+
+(my-assert
+ (string-not-greaterp  "ABCdefgh" "xyzabc")
+ 0)
+
+(my-assert
+ (string-not-greaterp  "xyzABCdefgh" "abc")
+ nil)
+
+(my-assert
+ (string-not-greaterp  "abcdeFgh" "abcdefgh" :end2 4)
+ nil)
+
+(my-assert
+ (string-not-greaterp  "xyzABC" "abcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string-not-greaterp  "ABC" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string-not-greaterp  "ABC" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string-not-greaterp  "ABC" "xyzabcdefgh" :start2 3 :end2 5)
+ nil)
+
+(my-assert
+ (string-not-greaterp  "abcDEF" "bcdefgh")
+ 0)
+
+(my-assert
+ (string-not-greaterp  "abcDEF" "abcdefgh" :start2 2)
+ 0)
+
+(my-assert
+ (string-not-greaterp  "abcdef" "bngDAbcdef" :start2 9 :end2 5)
+ error)
+
+(my-assert
+ (string-not-lessp  "" "abcdefgh")
+ nil)
+
+(my-assert
+ (string-not-lessp  "a" "Abcdefgh")
+ nil)
+
+(my-assert
+ (string-not-lessp  "ABC" "abcdefgh")
+ nil)
+
+(my-assert
+ (string-not-lessp  "CABc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string-not-lessp  "ABCdefgh" "abcdefgh")
+ 8)
+
+(my-assert
+ (string-not-lessp  "xyzABC" "abcdefgh")
+ 0)
+
+(my-assert
+ (string-not-lessp  "ABC" "xyzabcdefgh")
+ nil)
+
+(my-assert
+ (string-not-lessp  "ABCdefgh" "abcdefgh" :end1 4)
+ nil)
+
+(my-assert
+ (string-not-lessp  "xyzABC" "abcdefgh" :start1 3)
+ nil)
+
+(my-assert
+ (string-not-lessp  "ABC" "xyzabcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string-not-lessp  "ABC" "xyzabcdefgh" :start2 3 :end2 8)
+ nil)
+
+(my-assert
+ (string-not-lessp  "ABC" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string-not-lessp  "abcdefgh" "")
+ 0)
+
+(my-assert
+ (string-not-lessp  "Abcdefgh" "a")
+ 1)
+
+(my-assert
+ (string-not-lessp  "ABCdefgh" "abc")
+ 3)
+
+(my-assert
+ (string-not-lessp  "abCDEfgh" "cabc")
+ nil)
+
+(my-assert
+ (string-not-lessp  "aBCdefgh" "xyzabc")
+ nil)
+
+(my-assert
+ (string-not-lessp  "xyzABcdefgh" "abc")
+ 0)
+
+(my-assert
+ (string-not-lessp  "abCDEfgh" "abcdefgh" :end2 4)
+ 4)
+
+(my-assert
+ (string-not-lessp  "xyzABc" "abcdefgh" :start2 3)
+ 0)
+
+(my-assert
+ (string-not-lessp  "ABC" "xyzabcdefgh" :start2 3)
+ nil)
+
+(my-assert
+ (string-not-lessp  "ABC" "xyzabcdefgh" :start2 3 :end2 8)
+ nil)
+
+(my-assert
+ (string-not-lessp  "ABC" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string-not-lessp  "bCDef" "abcdef")
+ 0)
+
+(my-assert
+ (string-not-lessp  "ABCdefghij" "abcdefgh" :start1 1)
+ 1)
+
+(my-assert
+ (string-not-lessp  "ghIjkl" "xyzabcd" :start2 6 :end2 4)
+ error)
+
+(my-assert
+ (string-not-equal  "" "abcdefgh")
+ 0)
+
+(my-assert
+ (string-not-equal  "A" "abcdefgh")
+ 1)
+
+(my-assert
+ (string-not-equal  "ABc" "abcdefgh")
+ 3)
+
+(my-assert
+ (string-not-equal  "cABc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string-not-equal  "ABCdefgh" "abcdefgh")
+ nil)
+
+(my-assert
+ (string-not-equal  "xyzABc" "abcdefgh")
+ 0)
+
+(my-assert
+ (string-not-equal  "ABC" "xyzabcdefgh")
+ 0)
+
+(my-assert
+ (string-not-equal  "ABCdefgh" "abcdefgh" :end1 4)
+ 4)
+
+(my-assert
+ (string-not-equal  "xyzaBC" "abcdefgh" :start1 3)
+ 6)
+
+(my-assert
+ (string-not-equal  "ABC" "xyzabcdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string-not-equal  "ABC" "xyzabcdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string-not-equal  "ABC" "xyzabcdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string-not-equal  "abcdefgh" "")
+ 0)
+
+(my-assert
+ (string-not-equal  "Abcdefgh" "a")
+ 1)
+
+(my-assert
+ (string-not-equal  "aBCdefgh" "abc")
+ 3)
+
+(my-assert
+ (string-not-equal  "abcdefgh" "cABc")
+ 0)
+
+(my-assert
+ (string-not-equal  "abcdefgh" "xyzAbc")
+ 0)
+
+(my-assert
+ (string-not-equal  "xyzabcdefgh" "ABC")
+ 0)
+
+(my-assert
+ (string-not-equal  "abcdefgh" "abcDEFgh" :end2 4)
+ 4)
+
+(my-assert
+ (string-not-equal  "xyzabc" "aBCDefgh" :start2 3)
+ 0)
+
+(my-assert
+ (string-not-equal  "abc" "xyzABCdefgh" :start2 3)
+ 3)
+
+(my-assert
+ (string-not-equal  "abc" "xyzABCdefgh" :start2 3 :end2 8)
+ 3)
+
+(my-assert
+ (string-not-equal  "abc" "xyzABCdefgh" :start2 3 :end2 5)
+ 2)
+
+(my-assert
+ (string/=  "abcdefghi" "uvdEFmgnj" :start1 3 :end1 6 :start2 2 :end2 5)
+ 4)
+
+(my-assert
+ (string/=  "abcdefg" "abcDEfg" :end2 4)
+ 3)
+
+(my-assert
+ (string/=  "abcdef" "abCDef" :start1 1 :end1 4 :start2 4 :end2 1)
+ error)
+
+(my-assert
+ (string-trim   (quote (#\space #\tab #\newline)) " garbanzo beans
+   ")
+ "garbanzo beans")
+
+(my-assert
+ (string-trim   " (*)" " ( *three(siily) words* ) ")
+ "three(siily) words")
+
+(my-assert
+ (string-trim   (quote a) "ababa")
+ error)
+
+(my-assert
+ (string-trim   (quote (a)) "ababa")
+ #+xcl error
+ #+(or clisp gcl allegro cmu ecls) "ababa"
+ #-(or xcl clisp gcl allegro cmu ecls) unknown)
+
+(my-assert
+ (string-trim   "a" "ababa")
+ "bab")
+
+(my-assert
+ (string-trim   "c e" "    ceabceabce    c")
+ "abceab")
+
+(my-assert
+ (string-trim   (quote (#\a)) "abcd")
+ "bcd")
+
+(my-assert
+ (string-trim   (quote (#\a)) "xyzabcd")
+ "xyzabcd")
+
+(my-assert
+ (string-trim   (quote (#\a)) "abcda")
+ "bcd")
+
+(my-assert
+ (string-left-trim   (quote (#\space #\tab #\newline)) " garbanzo beans
+   ")
+ "garbanzo beans
+   ")
+
+(my-assert
+ (string-left-trim   " (*)" " ( *three(siily) words* ) ")
+ "three(siily) words* ) ")
+
+(my-assert
+ (string-left-trim   (quote a) "ababa")
+ error)
+
+(my-assert
+ (string-left-trim   (quote (a)) "ababa")
+ #+xcl error
+ #+(or clisp gcl allegro cmu ecls) "ababa"
+ #-(or xcl clisp gcl allegro cmu ecls) unknown)
+
+(my-assert
+ (string-left-trim   "a" "ababa")
+ "baba")
+
+(my-assert
+ (string-left-trim   "c e" "    ceabceabce    c")
+ "abceabce    c")
+
+(my-assert
+ (string-left-trim   (quote (#\a)) "abcd")
+ "bcd")
+
+(my-assert
+ (string-left-trim   (quote (#\a)) "xyzabcd")
+ "xyzabcd")
+
+(my-assert
+ (string-left-trim   (quote (#\a)) "abcda")
+ "bcda")
+
+(my-assert
+ (string-right-trim   (quote (#\space #\tab #\newline)) " garbanzo beans
+   ")
+ " garbanzo beans")
+
+(my-assert
+ (string-right-trim   " (*)" " ( *three(siily) words* ) ")
+ " ( *three(siily) words")
+
+(my-assert
+ (string-right-trim   (quote a) "ababa")
+ error)
+
+(my-assert
+ (string-right-trim   (quote (a)) "ababa")
+ #+xcl error
+ #+(or clisp gcl allegro cmu ecls) "ababa"
+ #-(or xcl clisp gcl allegro cmu ecls) unknown)
+
+(my-assert
+ (string-right-trim   "a" "ababa")
+ "abab")
+
+(my-assert
+ (string-right-trim   "c e" "    ceabceabce    c")
+ "    ceabceab")
+
+(my-assert
+ (string-right-trim   (quote (#\a)) "abcd")
+ "abcd")
+
+(my-assert
+ (string-right-trim   (quote (#\a)) "xyzabcd")
+ "xyzabcd")
+
+(my-assert
+ (string-right-trim   (quote (#\a)) "abcda")
+ "abcd")
+
+(my-assert
+ (string-upcase  "abCD efGh-ij")
+ "ABCD EFGH-IJ")
+
+(my-assert
+ (string-upcase  "abCD efGh-ij" :start 5)
+ "abCD EFGH-IJ")
+
+(my-assert
+ (string-upcase  "abCD efGh-ij" :end 5)
+ "ABCD efGh-ij")
+
+(my-assert
+ (string-upcase  "abCD efGh-ij" :start 1 :end 6)
+ "aBCD EfGh-ij")
+
+(my-assert
+ (string-upcase  "abCD efGh-ij" :start 6 :end 1)
+ error)
+
+(my-assert
+ (string-upcase  "abCD efGh-ij" :start 3 :end 3)
+ "abCD efGh-ij")
+
+(my-assert
+ (string-downcase  "abCD efGh-ij")
+ "abcd efgh-ij")
+
+(my-assert
+ (string-downcase  "abCD efGh-ij" :start 3)
+ "abCd efgh-ij")
+
+(my-assert
+ (string-downcase  "abCD efGh-ij" :end 3)
+ "abcD efGh-ij")
+
+(my-assert
+ (string-downcase  "abCD efGh-ij" :start 3 :end 3)
+ "abCD efGh-ij")
+
+(my-assert
+ (string-downcase  "abCD efGh-ij" :start 1 :end 6)
+ "abcd efGh-ij")
+
+(my-assert
+ (string-downcase  "abCD efGh-ij" :start 6 :end 1)
+ error)
+
+(my-assert
+ (string-capitalize  "abcd def g hi")
+ "Abcd Def G Hi")
+
+(my-assert
+ (string-capitalize  "abCd dEf G hi")
+ "Abcd Def G Hi")
+
+(my-assert
+ (string-capitalize  "Abcd Def G Hi")
+ "Abcd Def G Hi")
+
+(my-assert
+ (string-capitalize  "abcd def g hi" :start 6)
+ "abcd dEf G Hi")
+
+(my-assert
+ (string-capitalize  "abcd def g hi" :end 6)
+ "Abcd Def g hi")
+
+(my-assert
+ (string-capitalize  "abcd def g hi" :start 2 :end 10)
+ "abCd Def G hi")
+
+(my-assert
+ (string-capitalize  "abcd def g hi" :start 10 :end 2)
+ error)
+
+(my-assert
+ (string-capitalize  "don't")
+ "Don'T")
+
+(my-assert
+ (string-capitalize  "DON'T")
+ "Don'T")
+
+(my-assert
+ (string-capitalize  "34a 5BC")
+ "34a 5bc")
+
+(my-assert
+ (string  1)
+ error)
+
+(my-assert
+ (string  (quote a))
+ "A")
+
+(my-assert
+ (string  #\a)
+ "a")
+
+(my-assert
+ (string  "abc")
+ "abc")
+
+(my-assert
+ (nstring-upcase
+  (copy-seq "abCD efGh-ij"))
+ "ABCD EFGH-IJ")
+
+(my-assert
+ (nstring-upcase
+  (copy-seq "abCD efGh-ij")
+  :start 5)
+ "abCD EFGH-IJ")
+
+(my-assert
+ (nstring-upcase  (copy-seq "abCD efGh-ij")
+		  :end 5)
+ "ABCD efGh-ij")
+
+(my-assert
+ (nstring-upcase  (copy-seq "abCD efGh-ij")
+		  :start6 :end 1)
+ error)
+
+(my-assert
+ (nstring-upcase  (copy-seq "abCD efGh-ij")
+		  :start 3 :end 3)
+ "abCD efGh-ij")
+
+(my-assert
+ (nstring-downcase  (copy-seq "abCD efGh-ij"))
+ "abcd efgh-ij")
+
+(my-assert
+ (nstring-downcase  (copy-seq "abCD efGh-ij")
+		    :start 3)
+ "abCd efgh-ij")
+
+(my-assert
+ (nstring-upcase  (copy-seq "abCD efGh-ij")
+		  :start 1 :end 6)
+ "aBCD EfGh-ij")
+
+(my-assert
+ (nstring-downcase  (copy-seq "abCD efGh-ij")
+		    :end 3)
+ "abcD efGh-ij")
+
+(my-assert
+ (nstring-downcase  (copy-seq "abCd efGh-ij")
+		    :start 3 :end 3)
+ "abCd efGh-ij")
+
+(my-assert
+ (nstring-downcase  (copy-seq "abCd efGh-ij")
+		    :start 1 :end 6)
+ "abcd efGh-ij")
+
+(my-assert
+ (nstring-downcase  (copy-seq "abCD efGh-ij")
+		    :start 6 :end 1)
+ error)
+
+(my-assert
+ (nstring-downcase  (copy-seq "abCD efGh-ij")
+		    :start nil :end nil)
+ #+(or xcl akcl) "abcd efgh-ij"
+ #-(or xcl akcl) error)
+
+(my-assert
+ (nstring-upcase  (copy-seq "abDC efGh-oj"))
+ "ABDC EFGH-OJ")
+
+(my-assert
+ (nstring-upcase (copy-seq "abCD efGh-ij")
+		 :start 1 :end 6)
+ "aBCD EfGh-ij")
+
+(my-assert
+ (nstring-upcase  (copy-seq "abCD efGh-fg")
+		  :start 1 :end 6)
+ "aBCD EfGh-fg")
+
+(my-assert
+ (nstring-upcase (copy-seq "abCD efGh-ef")
+		 :start 3 :end 3)
+ "abCD efGh-ef")
+
+(my-assert
+ (nstring-upcase  (copy-seq "abCD efGh-ef")
+		  :start 3 :end 3)
+ "abCD efGh-ef")
+
+(my-assert
+ (nstring-upcase  (copy-seq "abCD efGh-ef")
+		  :start 3 :end 3)
+ "abCD efGh-ef")
+
+(my-assert
+ (nstring-upcase  (copy-seq "abCD efGh-ef")
+		  :start 3 :end 1)
+ error)
+
+(my-assert
+ (nstring-upcase  (copy-seq "abCD efGh-ef")
+		  :start nil :end nil)
+ #+(or xcl akcl) "ABCD EFGH-EF"
+ #-(or xcl akcl) error)
+
+(my-assert
+ (nstring-downcase  (copy-seq "saBG efGh-ef"))
+ "sabg efgh-ef")
+
+(my-assert
+ (nstring-downcase  (copy-seq "dfGV efGh-ef")
+		    :start 1 :end 6)
+ "dfgv efGh-ef")
+
+(my-assert
+ (nstring-downcase  (copy-seq "fgCD efGf-ef")
+		    :start 1 :end 3)
+ "fgcD efGf-ef")
+
+(my-assert
+ (nstring-downcase  (copy-seq "dfCF edFg-fg")
+		    :start nil :end nil)
+ #+(or xcl akcl) "dfcf edfg-fg"
+ #-(or xcl akcl) error)
+
+(my-assert
+ (nstring-downcase  (copy-seq "fgHG edgf-fg")
+		    :start 5 :end 1)
+ error)
+
+(my-assert
+ (nstring-downcase  (copy-seq "scDF edFG-ef")
+		    :start 1)
+ "scdf edfg-ef")
+
+(my-assert
+ (nstring-downcase  (copy-seq "fgHG edFG-ef")
+		    :end 4)
+ "fghg edFG-ef")
+
+(my-assert
+ (nstring-capitalize  (copy-seq "fg hgf fgh"))
+ "Fg Hgf Fgh")
+
+(my-assert
+ (let ((x (copy-seq "ABCDEF")))
+   (nstring-downcase x)
+   x)
+ "abcdef")
+
diff --git a/src/ansi-tests/symbol10.lisp b/src/ansi-tests/symbol10.lisp
new file mode 100644
index 000000000..f56f1ae30
--- /dev/null
+++ b/src/ansi-tests/symbol10.lisp
@@ -0,0 +1,706 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (progn (in-package :cl-user) nil)
+ nil
+ "in-package expects a 'string designator'
+this is or a character, a symbol or a string.")
+;; test der neuen valuezelle
+
+;;; 1. ungebundenes symbol
+
+
+(my-assert
+ (defun testvar (var)
+   (list (boundp var)			; gebunden
+         (if (boundp var)
+	     (symbol-value var)
+	     nil)			; wert/nil
+         (constantp var)		; konstante
+         #+xcl
+	 (eq (sys::%p-get-cdr var 0)
+	     sys::%cdr-specsym)		; specvar
+         #+clisp
+	 (and (sys::special-variable-p var)
+	      (not (constantp var)))	; specvar
+         #+allegro
+	 (and (not (constantp var))
+	      (eval `(let ((,var (list nil)))
+		       (and (boundp ',var)
+			    (eq (symbol-value ',var)
+				,var)))))
+         #+cmu	 
+	 (eq (ext:info variable kind var)
+	     ':special);; like clisp
+	 #+ecls
+	 (si::specialp var)
+         #+sbcl	 
+	 (eq (sb-int::info variable kind var)
+	     ':special);; like clisp
+         (and (fboundp var) t)		; funktion. eigenschaft
+         (and (fboundp var) (macro-function var) t) ; macro?
+         (and (fboundp var)
+	      (special-operator-p var)
+	      t)			; spezialform?
+         #-clisp
+	 (and (symbol-plist var) t)	; p-liste?
+         #+clisp
+	 (and (or (get var 'i1)
+		  (get var 'i2)
+		  (get var 'i3))
+	      t)			; p-liste?
+         (get var 'i1)			; i1
+         (get var 'i2)			; i2
+         (get var 'i3)			; i3
+	 )  )
+ testvar)
+
+(my-assert
+ (defun clrvar (var)
+   #+xcl
+   (subr 84				;sys::%p-set-cdr-content
+	 var 0 (sys::%p-get-content 'sys::%void-value 0) 0)
+   #-xcl
+   (progn (makunbound var) (fmakunbound var)
+	  (setf (symbol-plist var) '()))
+   #+allegro
+   (setf (excl::symbol-bit var 'excl::.globally-special.) nil)
+   #+cmu
+   (setf (ext:info variable kind var) ':global)
+   #+sbcl
+   (setf (sb-int::info variable kind var) ':global)
+   var)
+ clrvar)
+
+#+(or xcl clisp allegro cmu sbcl)
+(my-assert
+ (progn (setf (symbol-function 'setf-get)
+	      (symbol-function #+xcl 'sys::setf-get
+			       #+clisp 'sys::%put
+			       #+allegro 'excl::.inv-get
+			       #+(or cmu sbcl) 'cl::%put)) t)
+ t)
+
+;;; begin breitentest
+
+(my-assert
+ (clrvar 'v1)
+ v1)
+
+;;;; value - umbinden - macro - umbinden - props - umbinden
+
+;;; value
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val konst svar func mac spec plist i1  i2  i3
+ (nil nil nil   nil  nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (setq v1 'val)
+ val)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val konst svar func mac spec plist i1  i2  i3
+ (t   val nil   nil  nil  nil nil  nil   nil nil nil))
+
+;;; umbinden
+
+(my-assert
+ (makunbound 'v1)
+ v1)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val konst svar func mac spec plist i1  i2  i3
+ (nil nil nil   nil  nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (setq v1 'val2)
+ val2)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   val2 nil   nil  nil  nil nil  nil   nil nil nil))
+
+;;; macro
+
+(my-assert
+ (defmacro v1 (x) (list 'quote x))
+ v1)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   val2 nil   nil  t    t   nil  nil   nil nil nil))
+
+;;; umbinden
+
+(my-assert
+ (fmakunbound 'v1)
+ v1)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   val2 nil   nil  nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (defmacro v1 (x) (list 'quote (list x x)))
+ v1)
+
+(my-assert
+ (v1 33)
+ (33 33))
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   val2 nil   nil  t    t   nil  nil   nil nil nil))
+
+(my-assert
+ (makunbound 'v1)
+ v1)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  t    t   nil  nil   nil nil nil))
+
+(my-assert
+ (setq v1 'val3)
+ val3)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   val3 nil   nil  t    t   nil  nil   nil nil nil))
+
+;;; props
+
+(my-assert
+ (setf-get 'v1 'i1 11)
+ 11)
+
+(my-assert
+ (setf-get 'v1 'i2 22)
+ 22)
+
+(my-assert
+ (setf-get 'v1 'i3 33)
+ 33)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   val3 nil   nil  t    t   nil  t     11  22  33))
+
+;;; umbinden
+
+(my-assert
+ (not (null (remprop 'v1 'i2)))
+ t)
+(my-assert
+ (not (null (remprop 'v1 'i1)))
+ t)
+(my-assert
+ (not (null (remprop 'v1 'i3)))
+ t)
+(my-assert
+ (fmakunbound 'v1)
+ v1)
+(my-assert
+ (makunbound 'v1)
+ v1)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (setf-get 'v1 'i1 99)
+ 99)
+(my-assert
+ (defmacro v1 (x) (list 'quote (list x x x)))
+ v1)
+(my-assert
+ (v1 a)
+ (a a a))
+(my-assert
+ (setq v1 'val4)
+ val4)
+
+(my-assert
+ (testvar 'v1)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   val4 nil   nil  t    t   nil  t     99  nil nil))
+
+;;; --- ende test1 -----
+
+(my-assert
+ (clrvar 'v2)
+ v2)
+
+;;; specvar - props - rebind - function
+
+(my-assert
+ (defvar v2 'v2a)
+ v2)
+
+(my-assert
+ (testvar 'v2)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   v2a  nil   t    nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (setf-get 'v2 'i3 33)
+ 33)
+(my-assert
+ (setf-get 'v2 'i2 22)
+ 22)
+(my-assert
+ (setf-get 'v2 'i1 11)
+ 11)
+
+(my-assert
+ (testvar 'v2)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   v2a  nil   t    nil  nil nil  t     11  22  33))
+
+;;; rebind
+
+(my-assert
+ (makunbound 'v2)
+ v2)
+(my-assert
+ (not (null (remprop 'v2 'i1)))
+ t)
+(my-assert
+ (not (null (remprop 'v2 'i2)))
+ t)
+(my-assert
+ (not (null (remprop 'v2 'i3)))
+ t)
+
+(my-assert
+ (testvar 'v2)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ #+xcl
+ (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+ #-xcl
+ (nil nil  nil   t    nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (defvar v2 'v2b)
+ v2)
+(my-assert
+ (setf-get 'v2 'i1 111)
+ 111)
+(my-assert
+ (setf-get 'v2 'i2 222)
+ 222)
+(my-assert
+ (setf-get 'v2 'i3 333)
+ 333)
+
+(my-assert
+ (testvar 'v2)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   v2b  nil   t    nil  nil nil  t     111 222 333))
+
+;;; function
+
+(my-assert
+ (defun v2 (x) (list x x))
+ v2)
+(my-assert
+ (v2 44)
+ (44 44))
+
+(my-assert
+ (testvar 'v2)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   v2b  nil   t    t    nil nil  t     111 222 333 ))
+
+
+(my-assert
+ (clrvar 'v3)
+ v3)
+
+;;;;; function - con - rebind - prop
+
+;;; function
+
+(my-assert
+ (defun v3 (x y) (list x y))
+ v3)
+
+(my-assert
+ (testvar 'v3)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  t    nil nil  nil   nil nil nil))
+
+;;; constant
+
+(my-assert
+ (defconstant v3 99)
+ v3)
+
+(my-assert
+ v3
+ 99)
+(my-assert
+ (v3 'a 'b)
+ (a b))
+
+(my-assert
+ (testvar 'v3)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t    99  t     nil  t    nil nil  nil   nil nil nil))
+
+;;; rebind
+
+(my-assert
+ (makunbound 'v3)
+ #+(or xcl allegro cmu sbcl) v3
+ #+(or clisp ecls) error)
+
+(my-assert
+ (fmakunbound 'v3)
+ v3)
+
+#+xcl
+(my-assert
+ (testvar 'v3)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (defconstant v3 999)
+ v3)
+
+(my-assert
+ (defun v3 (x) (list x x))
+ v3)
+
+(my-assert
+ (v3 'c)
+ (c c))
+
+(my-assert
+ v3
+ 999)
+
+(my-assert
+ (testvar 'v3)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   999  t     nil  t    nil nil  nil   nil nil nil))
+
+;;;defparameter
+
+(my-assert
+ (defparameter var33)
+ error)
+
+(my-assert
+ (defparameter var3 99)
+ var3)
+
+(my-assert
+ var3
+ 99)
+
+(my-assert
+ (testvar 'var3)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t    99  nil   t    nil  nil nil  nil   nil nil nil))
+
+;;; rebind
+
+(my-assert
+ (makunbound 'var3)
+ var3)
+
+(my-assert
+ (testvar 'var3)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ #+xcl
+ (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+ #-xcl
+ (nil nil  nil   t    nil  nil nil  nil   nil nil nil))
+
+;;; props
+
+(my-assert
+ (setf-get 'v3 'i2 222)
+ 222)
+
+(my-assert
+ (setf-get 'v3 'i1 111)
+ 111)
+
+(my-assert
+ (testvar 'v3)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   999  t     nil  t    nil nil  t     111 222 nil))
+
+
+(my-assert
+ (clrvar 'v4)
+ v4)
+
+;;;;  function - rebind - prop - rebind - specvar
+
+(my-assert
+ (defun v4 (x) x)
+ v4)
+
+(my-assert
+ (v4 55)
+ 55)
+
+(my-assert
+ (testvar 'v4)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  t    nil nil  nil   nil nil nil))
+
+;;; rebind
+
+(my-assert
+ (fmakunbound 'v4)
+ v4)
+
+(my-assert
+ (testvar 'v4)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (defun v4 (x) (list x))
+ v4)
+
+(my-assert
+ (v4 88)
+ (88))
+
+(my-assert
+ (testvar 'v4)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  t    nil nil  nil   nil nil nil))
+
+(my-assert
+ (setf-get 'v4 'i1 11)
+ 11)
+
+(my-assert
+ (setf-get 'v4 'i2 22)
+ 22)
+
+(my-assert
+ (testvar 'v4)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  t    nil nil  t     11  22  nil))
+
+;;; rebind
+
+(my-assert
+ (fmakunbound 'v4)
+ v4)
+(my-assert
+ (not (null (remprop 'v4 'i1)))
+ t)
+(my-assert
+ (not (null (remprop 'v4 'i2)))
+ t)
+(my-assert
+ (testvar 'v4)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (defun v4 (x) (list x x x))
+ v4)
+
+(my-assert
+ (v4 44)
+ (44 44 44))
+
+(my-assert
+ (setf-get 'v4 'i2 222)
+ 222)
+
+(my-assert
+ (setf-get 'v4 'i3 333)
+ 333)
+
+(my-assert
+ (testvar 'v4)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  t    nil nil  t     nil 222 333))
+
+(my-assert
+ (defvar v4 'v4-value)
+ v4)
+
+(my-assert
+ (testvar 'v4)
+ ;; geb val     konst svar func mac spec plist i1  i2  i3
+ (t  v4-value nil   t    t    nil nil  t     nil 222 333))
+
+(my-assert
+ (clrvar 'v5)
+ v5)
+
+;;;;; prop - rebind - con - rebind - fun
+
+(my-assert
+ (setf-get 'v5 'i1 1)
+ 1)
+(my-assert
+ (setf-get 'v5 'i2 2)
+ 2)
+
+(my-assert
+ (testvar 'v5)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  nil  nil nil  t     1   2  nil))
+
+;;; rebind
+
+(my-assert
+ (not (null (remprop 'v5 'i1)))
+ t)
+(my-assert
+ (not (null (remprop 'v5 'i2)))
+ t)
+
+(my-assert
+ (testvar 'v5)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  nil  nil nil  nil   nil nil nil))
+
+(my-assert
+ (setf-get 'v5 'i1 11)
+ 11)
+(my-assert
+ (setf-get 'v5 'i2 22)
+ 22)
+
+(my-assert
+ (testvar 'v5)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  nil  nil nil  t     11  22  nil))
+
+;;; con
+
+(my-assert
+ (defconstant v5 '123)
+ v5)
+
+(my-assert
+ (testvar 'v5)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   123  t     nil  nil  nil nil  t     11  22  nil))
+
+;;; rebind
+
+(my-assert
+ (makunbound 'v5)
+ #+(or xcl allegro cmu sbcl) v5
+ #+(or clisp ecls) error)
+
+(my-assert
+ (not (null (remprop 'v5 'i2)))
+ t)
+
+(my-assert
+ (not (null (remprop 'v5 'i1)))
+ t)
+
+#+xcl
+(my-assert
+ (testvar 'v5)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  nil  nil nil  nil   nil nil nil))
+
+;;; das ging schief !!
+
+(my-assert
+ (defconstant v5 321)
+ v5)
+
+(my-assert
+ (setf-get 'v5 'i3 333)
+ 333)
+
+(my-assert
+ (setf-get 'v5 'i2 222)
+ 222)
+
+(my-assert
+ (testvar 'v5)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   321  t     nil  nil  nil nil  t     nil 222 333))
+
+(my-assert
+ (defun v5 (x) x)
+ v5)
+
+(my-assert
+ (v5 666)
+ 666)
+
+(my-assert
+ (testvar 'v5)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   321  t     nil  t    nil nil  t     nil 222 333))
+
+(my-assert
+ (clrvar 'v6)
+ v6)
+
+;;;;; prop mac con
+
+(my-assert
+ (setf-get 'v6 'i1 1)
+ 1)
+
+(my-assert
+ (setf-get 'v6 'i3 3)
+ 3)
+
+(my-assert
+ (testvar 'v6)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  nil  nil nil  t     1   nil 3))
+
+(my-assert
+ (defmacro v6 (x) (list 'quote x))
+ v6)
+
+(my-assert
+ (v6 a)
+ a)
+
+(my-assert
+ (testvar 'v6)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (nil nil  nil   nil  t    t   nil  t     1   nil 3))
+
+(my-assert
+ (defconstant v6 234)
+ v6)
+
+(my-assert
+ (testvar 'v6)
+ ;; geb val  konst svar func mac spec plist i1  i2  i3
+ (t   234  t     nil  t    t   nil  t     1   nil 3))
+
+
+;;  aufraeumen
+(mapc #'unintern '(v1 v2 v3 v4 v5 v6))
+
diff --git a/src/ansi-tests/symbols.lisp b/src/ansi-tests/symbols.lisp
new file mode 100644
index 000000000..b22e317d7
--- /dev/null
+++ b/src/ansi-tests/symbols.lisp
@@ -0,0 +1,21 @@
+;;; based on v1.2 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (symbol-name (quote xyz))
+ "XYZ")
+
+(my-assert
+ (let ((*gensym-counter* 32))
+   (gensym)
+   (prin1-to-string (gensym "FOO-")))
+ "#:FOO-33")
+
+(my-assert
+ (let ((*gensym-counter* 32))
+   (gensym)
+   (prin1-to-string (gensym "garbage-")))
+ #+xcl "#:|garbage|-33"
+ #+(or clisp akcl allegro cmu sbcl ecls) "#:|garbage-33|"
+ #-(or xcl clisp akcl allegro cmu sbcl ecls) UNKNOWN)
+
diff --git a/src/ansi-tests/symboltest.lisp b/src/ansi-tests/symboltest.lisp
new file mode 100644
index 000000000..d128dc5f5
--- /dev/null
+++ b/src/ansi-tests/symboltest.lisp
@@ -0,0 +1,509 @@
+;;; Peter Van Eynde, 1 March 2000 -*- mode: lisp -*-
+
+(in-package :cl-user)
+
+
+(defvar *the-cl-package* (find-package :common-lisp))
+
+(my-assert
+ (packagep *the-cl-package*)
+ t)
+
+(my-assert
+ (package-name *the-cl-package*)
+ "COMMON-LISP")
+
+(my-assert
+ (not
+  (member "CL"
+	  (package-nicknames *the-cl-package*)
+	  :test #'string-equal))
+ NIL)
+
+
+(defvar *allowed-exported-symbols*
+  '("&allow-other-keys"            "*print-miser-width*"
+   "&aux"                         "*print-pprint-dispatch*"
+   "&body"                        "*print-pretty*"
+   "&environment"                 "*print-radix*"
+   "&key"                         "*print-readably*"
+   "&optional"                    "*print-right-margin*"
+   "&rest"                        "*query-io*"
+   "&whole"                       "*random-state*"
+   "*"                            "*read-base*"
+   "**"                           "*read-default-float-format*"
+   "***"                          "*read-eval*"
+   "*break-on-signals*"           "*read-suppress*"
+   "*compile-file-pathname*"      "*readtable*"
+   "*compile-file-truename*"      "*standard-input*"
+   "*compile-print*"              "*standard-output*"
+   "*compile-verbose*"            "*terminal-io*"
+   "*debug-io*"                   "*trace-output*"
+   "*debugger-hook*"              "+"
+   "*default-pathname-defaults*"  "++"
+   "*error-output*"               "+++"
+   "*features*"                   "-"
+   "*gensym-counter*"             "/"
+   "*load-pathname*"              "//"
+   "*load-print*"                 "///"
+   "*load-truename*"              "/="
+   "*load-verbose*"               "1+"
+   "*macroexpand-hook*"           "1-"
+   "*modules*"                    "<"
+   "*package*"                    "<="
+   "*print-array*"                "="
+   "*print-base*"                 ">"
+   "*print-case*"                 ">="
+   "*print-circle*"               "abort"
+   "*print-escape*"               "abs"
+   "*print-gensym*"               "acons"
+   "*print-length*"               "acos"
+   "*print-level*"                "acosh"
+   "*print-lines*"                "add-method"
+   "adjoin"                      "atom"          "boundp"
+   "adjust-array"                "base-char"     "break"
+   "adjustable-array-p"          "base-string"   "broadcast-stream"
+   "allocate-instance"           "bignum"        "broadcast-stream-streams"
+   "alpha-char-p"                "bit"           "built-in-class"
+   "alphanumericp"               "bit-and"       "butlast"
+   "and"                         "bit-andc1"     "byte"
+   "append"                      "bit-andc2"     "byte-position"
+   "apply"                       "bit-eqv"       "byte-size"
+   "apropos"                     "bit-ior"       "caaaar"
+   "apropos-list"                "bit-nand"      "caaadr"
+   "aref"                        "bit-nor"       "caaar"
+   "arithmetic-error"            "bit-not"       "caadar"
+   "arithmetic-error-operands"   "bit-orc1"      "caaddr"
+   "arithmetic-error-operation"  "bit-orc2"      "caadr"
+   "array"                       "bit-vector"    "caar"
+   "array-dimension"             "bit-vector-p"  "cadaar"
+   "array-dimension-limit"       "bit-xor"       "cadadr"
+   "array-dimensions"            "block"         "cadar"
+   "array-displacement"          "boole"         "caddar"
+   "array-element-type"          "boole-1"       "cadddr"
+   "array-has-fill-pointer-p"    "boole-2"       "caddr"
+   "array-in-bounds-p"           "boole-and"     "cadr"
+   "array-rank"                  "boole-andc1"   "call-arguments-limit"
+   "array-rank-limit"            "boole-andc2"   "call-method"
+   "array-row-major-index"       "boole-c1"      "call-next-method"
+   "array-total-size"            "boole-c2"      "car"
+   "array-total-size-limit"      "boole-clr"     "case"
+   "arrayp"                      "boole-eqv"     "catch"
+   "ash"                         "boole-ior"     "ccase"
+   "asin"                        "boole-nand"    "cdaaar"
+   "asinh"                       "boole-nor"     "cdaadr"
+   "assert"                      "boole-orc1"    "cdaar"
+   "assoc"                       "boole-orc2"    "cdadar"
+   "assoc-if"                    "boole-set"     "cdaddr"
+   "assoc-if-not"                "boole-xor"     "cdadr"
+   "atan"                        "boolean"       "cdar"
+   "atanh"                       "both-case-p"   "cddaar"
+   "cddadr"             "clear-input"                  "copy-tree"
+   "cddar"              "clear-output"                 "cos"
+   "cdddar"             "close"                        "cosh"
+   "cddddr"             "clrhash"                      "count"
+   "cdddr"              "code-char"                    "count-if"
+   "cddr"               "coerce"                       "count-if-not"
+   "cdr"                "compilation-speed"            "ctypecase"
+   "ceiling"            "compile"                      "debug"
+   "cell-error"         "compile-file"                 "decf"
+   "cell-error-name"    "compile-file-pathname"        "declaim"
+   "cerror"             "compiled-function"            "declaration"
+   "change-class"       "compiled-function-p"          "declare"
+   "char"               "compiler-macro"               "decode-float"
+   "char-code"          "compiler-macro-function"      "decode-universal-time"
+   "char-code-limit"    "complement"                   "defclass"
+   "char-downcase"      "complex"                      "defconstant"
+   "char-equal"         "complexp"                     "defgeneric"
+   "char-greaterp"      "compute-applicable-methods"   "define-compiler-macro"
+   "char-int"           "compute-restarts"             "define-condition"
+   "char-lessp"         "concatenate"                  "define-method-combination"
+   "char-name"          "concatenated-stream"          "define-modify-macro"
+   "char-not-equal"     "concatenated-stream-streams"  "define-setf-expander"
+   "char-not-greaterp"  "cond"                         "define-symbol-macro"
+   "char-not-lessp"     "condition"                    "defmacro"
+   "char-upcase"        "conjugate"                    "defmethod"
+   "char/="             "cons"                         "defpackage"
+   "char<"              "consp"                        "defparameter"
+   "char<="             "constantly"                   "defsetf"
+   "char="              "constantp"                    "defstruct"
+   "char>"              "continue"                     "deftype"
+   "char>="             "control-error"                "defun"
+   "character"          "copy-alist"                   "defvar"
+   "characterp"         "copy-list"                    "delete"
+   "check-type"         "copy-pprint-dispatch"         "delete-duplicates"
+   "cis"                "copy-readtable"               "delete-file"
+   "class"              "copy-seq"                     "delete-if"
+   "class-name"         "copy-structure"               "delete-if-not"
+   "class-of"           "copy-symbol"                  "delete-package"
+   "denominator"                    "eq"
+   "deposit-field"                  "eql"
+   "describe"                       "equal"
+   "describe-object"                "equalp"
+   "destructuring-bind"             "error"
+   "digit-char"                     "etypecase"
+   "digit-char-p"                   "eval"
+   "directory"                      "eval-when"
+   "directory-namestring"           "evenp"
+   "disassemble"                    "every"
+   "division-by-zero"               "exp"
+   "do"                             "export"
+   "do*"                            "expt"
+   "do-all-symbols"                 "extended-char"
+   "do-external-symbols"            "fboundp"
+   "do-symbols"                     "fceiling"
+   "documentation"                  "fdefinition"
+   "dolist"                         "ffloor"
+   "dotimes"                        "fifth"
+   "double-float"                   "file-author"
+   "double-float-epsilon"           "file-error"
+   "double-float-negative-epsilon"  "file-error-pathname"
+   "dpb"                            "file-length"
+   "dribble"                        "file-namestring"
+   "dynamic-extent"                 "file-position"
+   "ecase"                          "file-stream"
+   "echo-stream"                    "file-string-length"
+   "echo-stream-input-stream"       "file-write-date"
+   "echo-stream-output-stream"      "fill"
+   "ed"                             "fill-pointer"
+   "eighth"                         "find"
+   "elt"                            "find-all-symbols"
+   "encode-universal-time"          "find-class"
+   "end-of-file"                    "find-if"
+   "endp"                           "find-if-not"
+   "enough-namestring"              "find-method"
+   "ensure-directories-exist"       "find-package"
+   "ensure-generic-function"        "find-restart"
+   "find-symbol"                       "get-internal-run-time"
+   "finish-output"                     "get-macro-character"
+   "first"                             "get-output-stream-string"
+   "fixnum"                            "get-properties"
+   "flet"                              "get-setf-expansion"
+   "float"                             "get-universal-time"
+   "float-digits"                      "getf"
+   "float-precision"                   "gethash"
+   "float-radix"                       "go"
+   "float-sign"                        "graphic-char-p"
+   "floating-point-inexact"            "handler-bind"
+   "floating-point-invalid-operation"  "handler-case"
+   "floating-point-overflow"           "hash-table"
+   "floating-point-underflow"          "hash-table-count"
+   "floatp"                            "hash-table-p"
+   "floor"                             "hash-table-rehash-size"
+   "fmakunbound"                       "hash-table-rehash-threshold"
+   "force-output"                      "hash-table-size"
+   "format"                            "hash-table-test"
+   "formatter"                         "host-namestring"
+   "fourth"                            "identity"
+   "fresh-line"                        "if"
+   "fround"                            "ignorable"
+   "ftruncate"                         "ignore"
+   "ftype"                             "ignore-errors"
+   "funcall"                           "imagpart"
+   "function"                          "import"
+   "function-keywords"                 "in-package"
+   "function-lambda-expression"        "incf"
+   "functionp"                         "initialize-instance"
+   "gcd"                               "inline"
+   "generic-function"                  "input-stream-p"
+   "gensym"                            "inspect"
+   "gentemp"                           "integer"
+   "get"                               "integer-decode-float"
+   "get-decoded-time"                  "integer-length"
+   "get-dispatch-macro-character"      "integerp"
+   "get-internal-real-time"            "interactive-stream-p"
+   "intern"                                  "lisp-implementation-type"
+   "internal-time-units-per-second"          "lisp-implementation-version"
+   "intersection"                            "list"
+   "invalid-method-error"                    "list*"
+   "invoke-debugger"                         "list-all-packages"
+   "invoke-restart"                          "list-length"
+   "invoke-restart-interactively"            "listen"
+   "isqrt"                                   "listp"
+   "keyword"                                 "load"
+   "keywordp"                                "load-logical-pathname-translations"
+   "labels"                                  "load-time-value"
+   "lambda"                                  "locally"
+   "lambda-list-keywords"                    "log"
+   "lambda-parameters-limit"                 "logand"
+   "last"                                    "logandc1"
+   "lcm"                                     "logandc2"
+   "ldb"                                     "logbitp"
+   "ldb-test"                                "logcount"
+   "ldiff"                                   "logeqv"
+   "least-negative-double-float"             "logical-pathname"
+   "least-negative-long-float"               "logical-pathname-translations"
+   "least-negative-normalized-double-float"  "logior"
+   "least-negative-normalized-long-float"    "lognand"
+   "least-negative-normalized-short-float"   "lognor"
+   "least-negative-normalized-single-float"  "lognot"
+   "least-negative-short-float"              "logorc1"
+   "least-negative-single-float"             "logorc2"
+   "least-positive-double-float"             "logtest"
+   "least-positive-long-float"               "logxor"
+   "least-positive-normalized-double-float"  "long-float"
+   "least-positive-normalized-long-float"    "long-float-epsilon"
+   "least-positive-normalized-short-float"   "long-float-negative-epsilon"
+   "least-positive-normalized-single-float"  "long-site-name"
+   "least-positive-short-float"              "loop"
+   "least-positive-single-float"             "loop-finish"
+   "length"                                  "lower-case-p"
+   "let"                                     "machine-instance"
+   "let*"                                    "machine-type"
+   "machine-version"                "mask-field"
+   "macro-function"                 "max"
+   "macroexpand"                    "member"
+   "macroexpand-1"                  "member-if"
+   "macrolet"                       "member-if-not"
+   "make-array"                     "merge"
+   "make-broadcast-stream"          "merge-pathnames"
+   "make-concatenated-stream"       "method"
+   "make-condition"                 "method-combination"
+   "make-dispatch-macro-character"  "method-combination-error"
+   "make-echo-stream"               "method-qualifiers"
+   "make-hash-table"                "min"
+   "make-instance"                  "minusp"
+   "make-instances-obsolete"        "mismatch"
+   "make-list"                      "mod"
+   "make-load-form"                 "most-negative-double-float"
+   "make-load-form-saving-slots"    "most-negative-fixnum"
+   "make-method"                    "most-negative-long-float"
+   "make-package"                   "most-negative-short-float"
+   "make-pathname"                  "most-negative-single-float"
+   "make-random-state"              "most-positive-double-float"
+   "make-sequence"                  "most-positive-fixnum"
+   "make-string"                    "most-positive-long-float"
+   "make-string-input-stream"       "most-positive-short-float"
+   "make-string-output-stream"      "most-positive-single-float"
+   "make-symbol"                    "muffle-warning"
+   "make-synonym-stream"            "multiple-value-bind"
+   "make-two-way-stream"            "multiple-value-call"
+   "makunbound"                     "multiple-value-list"
+   "map"                            "multiple-value-prog1"
+   "map-into"                       "multiple-value-setq"
+   "mapc"                           "multiple-values-limit"
+   "mapcan"                         "name-char"
+   "mapcar"                         "namestring"
+   "mapcon"                         "nbutlast"
+   "maphash"                        "nconc"
+   "mapl"                           "next-method-p"
+   "maplist"                        "nil"
+   "nintersection"         "package-error"
+   "ninth"                 "package-error-package"
+   "no-applicable-method"  "package-name"
+   "no-next-method"        "package-nicknames"
+   "not"                   "package-shadowing-symbols"
+   "notany"                "package-use-list"
+   "notevery"              "package-used-by-list"
+   "notinline"             "packagep"
+   "nreconc"               "pairlis"
+   "nreverse"              "parse-error"
+   "nset-difference"       "parse-integer"
+   "nset-exclusive-or"     "parse-namestring"
+   "nstring-capitalize"    "pathname"
+   "nstring-downcase"      "pathname-device"
+   "nstring-upcase"        "pathname-directory"
+   "nsublis"               "pathname-host"
+   "nsubst"                "pathname-match-p"
+   "nsubst-if"             "pathname-name"
+   "nsubst-if-not"         "pathname-type"
+   "nsubstitute"           "pathname-version"
+   "nsubstitute-if"        "pathnamep"
+   "nsubstitute-if-not"    "peek-char"
+   "nth"                   "phase"
+   "nth-value"             "pi"
+   "nthcdr"                "plusp"
+   "null"                  "pop"
+   "number"                "position"
+   "numberp"               "position-if"
+   "numerator"             "position-if-not"
+   "nunion"                "pprint"
+   "oddp"                  "pprint-dispatch"
+   "open"                  "pprint-exit-if-list-exhausted"
+   "open-stream-p"         "pprint-fill"
+   "optimize"              "pprint-indent"
+   "or"                    "pprint-linear"
+   "otherwise"             "pprint-logical-block"
+   "output-stream-p"       "pprint-newline"
+   "package"               "pprint-pop"
+   "pprint-tab"                 "read-char"
+   "pprint-tabular"             "read-char-no-hang"
+   "prin1"                      "read-delimited-list"
+   "prin1-to-string"            "read-from-string"
+   "princ"                      "read-line"
+   "princ-to-string"            "read-preserving-whitespace"
+   "print"                      "read-sequence"
+   "print-not-readable"         "reader-error"
+   "print-not-readable-object"  "readtable"
+   "print-object"               "readtable-case"
+   "print-unreadable-object"    "readtablep"
+   "probe-file"                 "real"
+   "proclaim"                   "realp"
+   "prog"                       "realpart"
+   "prog*"                      "reduce"
+   "prog1"                      "reinitialize-instance"
+   "prog2"                      "rem"
+   "progn"                      "remf"
+   "program-error"              "remhash"
+   "progv"                      "remove"
+   "provide"                    "remove-duplicates"
+   "psetf"                      "remove-if"
+   "psetq"                      "remove-if-not"
+   "push"                       "remove-method"
+   "pushnew"                    "remprop"
+   "quote"                      "rename-file"
+   "random"                     "rename-package"
+   "random-state"               "replace"
+   "random-state-p"             "require"
+   "rassoc"                     "rest"
+   "rassoc-if"                  "restart"
+   "rassoc-if-not"              "restart-bind"
+   "ratio"                      "restart-case"
+   "rational"                   "restart-name"
+   "rationalize"                "return"
+   "rationalp"                  "return-from"
+   "read"                       "revappend"
+   "read-byte"                  "reverse"
+   "room"                          "simple-bit-vector"
+   "rotatef"                       "simple-bit-vector-p"
+   "round"                         "simple-condition"
+   "row-major-aref"                "simple-condition-format-arguments"
+   "rplaca"                        "simple-condition-format-control"
+   "rplacd"                        "simple-error"
+   "safety"                        "simple-string"
+   "satisfies"                     "simple-string-p"
+   "sbit"                          "simple-type-error"
+   "scale-float"                   "simple-vector"
+   "schar"                         "simple-vector-p"
+   "search"                        "simple-warning"
+   "second"                        "sin"
+   "sequence"                      "single-float"
+   "serious-condition"             "single-float-epsilon"
+   "set"                           "single-float-negative-epsilon"
+   "set-difference"                "sinh"
+   "set-dispatch-macro-character"  "sixth"
+   "set-exclusive-or"              "sleep"
+   "set-macro-character"           "slot-boundp"
+   "set-pprint-dispatch"           "slot-exists-p"
+   "set-syntax-from-char"          "slot-makunbound"
+   "setf"                          "slot-missing"
+   "setq"                          "slot-unbound"
+   "seventh"                       "slot-value"
+   "shadow"                        "software-type"
+   "shadowing-import"              "software-version"
+   "shared-initialize"             "some"
+   "shiftf"                        "sort"
+   "short-float"                   "space"
+   "short-float-epsilon"           "special"
+   "short-float-negative-epsilon"  "special-operator-p"
+   "short-site-name"               "speed"
+   "signal"                        "sqrt"
+   "signed-byte"                   "stable-sort"
+   "signum"                        "standard"
+   "simple-array"                  "standard-char"
+   "simple-base-string"            "standard-char-p"
+   "standard-class"             "sublis"
+   "standard-generic-function"  "subseq"
+   "standard-method"            "subsetp"
+   "standard-object"            "subst"
+   "step"                       "subst-if"
+   "storage-condition"          "subst-if-not"
+   "store-value"                "substitute"
+   "stream"                     "substitute-if"
+   "stream-element-type"        "substitute-if-not"
+   "stream-error"               "subtypep"
+   "stream-error-stream"        "svref"
+   "stream-external-format"     "sxhash"
+   "streamp"                    "symbol"
+   "string"                     "symbol-function"
+   "string-capitalize"          "symbol-macrolet"
+   "string-downcase"            "symbol-name"
+   "string-equal"               "symbol-package"
+   "string-greaterp"            "symbol-plist"
+   "string-left-trim"           "symbol-value"
+   "string-lessp"               "symbolp"
+   "string-not-equal"           "synonym-stream"
+   "string-not-greaterp"        "synonym-stream-symbol"
+   "string-not-lessp"           "t"
+   "string-right-trim"          "tagbody"
+   "string-stream"              "tailp"
+   "string-trim"                "tan"
+   "string-upcase"              "tanh"
+   "string/="                   "tenth"
+   "string<"                    "terpri"
+   "string<="                   "the"
+   "string="                    "third"
+   "string>"                    "throw"
+   "string>="                   "time"
+   "stringp"                    "trace"
+   "structure"                  "translate-logical-pathname"
+   "structure-class"            "translate-pathname"
+   "structure-object"           "tree-equal"
+   "style-warning"              "truename"
+   "truncate"                             "values-list"
+   "two-way-stream"                       "variable"
+   "two-way-stream-input-stream"          "vector"
+   "two-way-stream-output-stream"         "vector-pop"
+   "type"                                 "vector-push"
+   "type-error"                           "vector-push-extend"
+   "type-error-datum"                     "vectorp"
+   "type-error-expected-type"             "warn"
+   "type-of"                              "warning"
+   "typecase"                             "when"
+   "typep"                                "wild-pathname-p"
+   "unbound-slot"                         "with-accessors"
+   "unbound-slot-instance"                "with-compilation-unit"
+   "unbound-variable"                     "with-condition-restarts"
+   "undefined-function"                   "with-hash-table-iterator"
+   "unexport"                             "with-input-from-string"
+   "unintern"                             "with-open-file"
+   "union"                                "with-open-stream"
+   "unless"                               "with-output-to-string"
+   "unread-char"                          "with-package-iterator"
+   "unsigned-byte"                        "with-simple-restart"
+   "untrace"                              "with-slots"
+   "unuse-package"                        "with-standard-io-syntax"
+   "unwind-protect"                       "write"
+   "update-instance-for-different-class"  "write-byte"
+   "update-instance-for-redefined-class"  "write-char"
+   "upgraded-array-element-type"          "write-line"
+   "upgraded-complex-part-type"           "write-sequence"
+   "upper-case-p"                         "write-string"
+   "use-package"                          "write-to-string"
+   "use-value"                            "y-or-n-p"
+   "user-homedir-pathname"                "yes-or-no-p"
+   "values"                               "zerop"))
+
+;; test there aren't any symbols too much
+(my-assert
+ (set-difference
+  (loop for symbol being
+    the external-symbol
+    of *the-cl-package*
+    collect symbol)
+  *allowed-exported-symbols*
+  :test #'string-equal)
+ nil
+ "This is the list of symbols that are exported but should not be exported
+from the :cl package")
+
+;; test there aren't any symbols missing
+(my-assert
+ (set-difference
+  *allowed-exported-symbols*
+  (loop for symbol being
+    the external-symbol
+    of *the-cl-package*
+    collect symbol)
+  :test #'string-equal)
+ nil
+ "This is the list of symbols that are missing or not exported
+from the :cl package")
+
+
+(makunbound '*allowed-exported-symbols*)
+(unintern '*allowed-exported-symbols*)
+
+
+
+
diff --git a/src/ansi-tests/tests.lisp b/src/ansi-tests/tests.lisp
new file mode 100644
index 000000000..bf8485a38
--- /dev/null
+++ b/src/ansi-tests/tests.lisp
@@ -0,0 +1,228 @@
+;; Test-Suiten ablaufen lassen: -*- mode: lisp -*-
+(in-package :user)
+
+(declaim (optimize (speed 0)
+		   (safety 3)
+		   (debug 3)))
+
+(defmacro with-ignored-errors (&rest forms)
+  "This macro will evaluate the forms and return
+the returnvalues or the type of the condition used."
+  (let ((tag (gensym)))
+    `(block ,tag
+       (handler-bind
+	((serious-condition
+	  #'(lambda (condition)
+	      (return-from ,tag
+		(values :ERROR
+			condition)))))
+	,@forms))))
+
+(defvar *log* nil)
+(defvar *output-generated* nil)
+(defvar *lisp-type*
+  #+ecls "ECLS"
+  #+CLISP "CLISP"
+  #+AKCL "AKCL"
+  #+CMU "CMUCL"
+  #+sbcl "SBCL")
+
+(defun check-and-puke (mode form result my-result condition why)
+  (flet ((safe-format (stream string &rest args)
+		      (unless (ignore-errors
+				(progn
+				  (apply #'format stream string args)
+				  t))
+			(format stream "~&~%format of ~S failed!"
+				string))))
+    (cond
+     ((eql result my-result)
+      (safe-format t "~%EQL-OK: ~S" my-result))
+     ((equal result my-result)
+      (safe-format t "~%EQUAL-OK: ~S" my-result))
+     ((equalp result my-result)
+      (safe-format t "~%EQUALP-OK: ~S" my-result))
+     ((eq my-result :ERROR)
+      (cond
+       ((ignore-errors
+	  (typep condition result))
+	(safe-format t "~%TYPEP-OK, is of the expected error :~S"
+		     result))
+       (t
+	(safe-format
+	 t
+	 "~&~%ERROR!! Got an error ~S (~A) I expected a instance of ~S~%"
+	 condition condition
+	 result)
+	(safe-format
+	 t
+	 "~%Form: ~S~%Should be an error of type: ~S~%~A: ~S (~A)~%Why: ~S~%"
+	 form result *lisp-type*
+	 condition condition
+	 why)
+	(setf *output-generated* t)
+	(safe-format
+	 *log*
+	 "~&~%~A Form: ~S~%Should be an error of type: ~S~%~A: ~S (~A) ~%Why: ~S~%"
+	 mode form result *lisp-type*
+	 condition condition
+	 why))))
+     (t
+      (safe-format t
+		   "~&~%ERROR!! Got ~S solution ~S expected!"
+		   my-result result)
+      (safe-format t
+		   "~%~A Form: ~S~%Should be: ~S~%~A: ~S~%Why: ~S~%"
+		   mode form result *lisp-type*
+		   my-result why)
+      (setf *output-generated* t)
+      (safe-format *log*
+		   "~&~%~A Form: ~S~%Should be: ~S~%~A: ~S~%Why : ~S~%"
+		   mode form result *lisp-type*
+		   my-result why)))))
+
+(defmacro my-assert (form result &optional (why ""))
+  `(progn
+     (format t "~&~%testing : ~S~%"
+	     ',form)
+
+     ;;; first we check if it work in interpreted mode
+
+     (multiple-value-bind (my-result condition)
+	 (with-ignored-errors
+	  (eval ',form))
+       (check-and-puke "interpreted"
+		       ',form ',result
+		       my-result condition
+		       ,why))
+
+     (force-output)
+
+     ;;; now we try to compile...
+     #+nil ; HACK
+     (multiple-value-bind (my-result condition)
+	 (with-ignored-errors
+	  (multiple-value-bind (function warnings-p failure-p)
+	      (compile nil
+		       #'(lambda ()
+			   ,form))
+	    (format t "~&compiled  ~S ~S ~S"
+		    function warnings-p failure-p)
+
+	    (multiple-value-bind (my-result condition)
+		(with-ignored-errors
+		 (funcall function))
+	      (check-and-puke "compiled"
+			      ',form ',result
+			      my-result condition
+			      ,why))))
+       (when (eq my-result :error)
+	 (check-and-puke "while compiling"
+			 ',form ',result
+			 my-result condition
+			 ,why)))))
+
+(defun run-test (testname &optional (source-path nil))
+  (let ((*package* *package*)
+	(*print-pretty* nil)
+	(*print-circle* nil)
+	;; to make the system quiet:
+	#+(or cmu sbcl)
+	(*gc-verbose* nil)
+	#+(or cmu sbcl)
+	(*compile-verbose* nil)
+	#+(or cmu sbcl)
+	(*compile-print* nil)
+	#+(or cmu sbcl)
+	(*compile-progress* nil)
+	#+(or cmu sbcl)
+	(*TOP-LEVEL-AUTO-DECLARE* nil)
+	(err-file (merge-pathnames testname "foo.erg"))
+	(source-file (merge-pathnames testname "foo.lisp")))
+    (when source-path
+      (setq source-file (merge-pathnames source-file source-path)))
+    (with-open-file (*log* err-file :direction :output)
+		    (setf *output-generated* nil)
+		    (load source-file)
+		    (force-output *log*))
+    (unless *output-generated*
+      (delete-file err-file)))
+  (values))
+
+(defun run-all-tests (&optional source-path)
+  (mapc #'(lambda (x) (print x) (run-test x source-path))
+	'(
+	  "symboltest"
+	  #-akcl "alltest"
+	  "array"
+	  "backquot"
+	  #-akcl "characters"
+	  #+(or CLISP ALLEGRO CMU SBCL)"clos"
+	  #-ECLS
+	  "cmucl-bugs"
+	  #+(or CLISP ALLEGRO CMU SBCL ECLS) "conditions"
+	  "eval20"
+	  #-ecls
+	  "excepsit"
+	  "format"
+	  #+xcl "hash"
+	  "hashlong"
+	  "iofkts"
+	  "lambda"
+	  "lists151"
+	  "lists152"
+	  "lists153"
+	  "lists154"
+	  "lists155"
+	  "lists156"
+	  #+(or CLISP ALLEGRO CMU SBCL) "loop"
+	  "macro8"
+	  "map"
+	  #+(or CLISP ALLEGRO CMU SBCL) "mop"
+	  "new-bugs"
+	  #-(or cmu sbcl ecls) "number"
+	  #+clisp "number2"
+	  #+(or XCL CLISP) "path"
+	  #+xcl "readtable"
+	  "section10"
+	  "section11"
+	  "section12"
+	  "section13"
+	  "section14"
+	  "section15"
+	  "section16"
+	  "section17"
+	  #-ecls
+	  "section18-errors"
+	  "section18"
+	  "section19"
+	  "section2"
+	  "section20"
+	  "section21"
+	  "section22"
+	  "section3"
+	  "section4"
+	  "section5"
+	  "section6"
+	  "section7"
+	  "section8"
+	  "section9"
+	  "setf"
+	  "steele7"
+	  #-allegro "streams"
+	  "streamslong"
+	  "strings"
+	  #-akcl "symbol10"
+	  "symbols"
+	  "type"
+	  #+(or sbcl cmu)
+	  "unix-tests"
+	  ))
+  t)
+
+;(run-test "unix-tests")
+;(run-test "steele7")
+;(quit)
+;(run-all-tests)
+;(format t "~%~%alles ok...~%")
+;(quit)
diff --git a/src/ansi-tests/type.lisp b/src/ansi-tests/type.lisp
new file mode 100644
index 000000000..11bcf579a
--- /dev/null
+++ b/src/ansi-tests/type.lisp
@@ -0,0 +1,516 @@
+;;; based on v1.3 -*- mode: lisp -*-
+(in-package :cl-user)
+
+(my-assert
+ (typep (quote a) (quote symbol))
+ t)
+
+(my-assert
+ (typep (quote nil) (quote symbol))
+ t)
+
+(my-assert
+ (typep (quote (nil)) (quote symbol))
+ nil)
+
+(my-assert
+ (typep 3 (quote integer))
+ t)
+
+(my-assert
+ (typep 3 (quote (integer 0 4)))
+ t)
+
+(my-assert
+ (typep 3 (quote (integer 0 3)))
+ t)
+
+(my-assert
+ (typep 3 (quote (integer 0 2)))
+ nil)
+
+(my-assert
+ (typep 3 (quote (float 0.0 2.0)))
+ nil)
+
+(my-assert
+ (typep 3 (quote (float 0.0 2.0)))
+ nil)
+
+(my-assert
+ (typep 3 (quote (float 0.0 4.0)))
+ nil)
+
+(my-assert
+ (typep 3.2 (quote (float 0.0 4.0)))
+ t)
+
+(my-assert
+ (typep 3.2 (quote (float 0.0 3.2)))
+ t)
+
+(my-assert
+ (typep 3.2 (quote (float 0.0 (3.2))))
+ nil)
+
+(my-assert
+ (typep 3.2 (quote (short-float 0.0s0 3.2s0)))
+ #+(or allegro cmu sbcl) t
+ #-(or allegro cmu sbcl) nil)
+
+(my-assert
+ (typep 3.2 (quote (single-float 0.0f0 3.2f0)))
+ t)
+
+(my-assert
+ (typep 3.2 (quote (double-float 0.0d0 3.2d0)))
+ nil)
+
+(my-assert
+ (typep 3.2 (quote (double-float 0.0d0 3.2d0)))
+ nil)
+
+(my-assert
+ (typep 3.2 (quote (double-float 0.0d0 3.2d0)))
+ nil)
+
+(my-assert
+ (typep 3.2s0 (quote (double-float 0.0d0 3.2d0)))
+ nil)
+
+(my-assert
+ (typep 3.2 (quote (double-float 0.0d0 3.2d0)))
+ nil)
+
+(my-assert
+ (typep 3.2 (quote (float 0.0 3.2)))
+ t)
+
+(my-assert
+ (typep 3.2s0 (quote (float 0.0s0 3.2s0)))
+ t)
+
+(my-assert
+ (typep 2.0s0 (quote (short-float 0.0s0 3.0s0)))
+ t)
+
+(my-assert
+ (typep 2.0s0 (quote (single-float 0.0f0 3.0f0)))
+ #+(or allegro cmu sbcl) t
+ #-(or allegro cmu sbcl) nil)
+
+(my-assert
+ (typep 2.0 (quote (single-float 0.0f0 3.0f0)))
+ t)
+
+(my-assert
+ (typep 2.0d0 (quote (double-float 0.0d0 3.0d0)))
+ t)
+
+(my-assert
+ (typep 3.0d0 (quote (double-float 0.0d0 3.0d0)))
+ t)
+
+(my-assert
+ (typep 3.0d0 (quote (double-float 0.0d0 (3.0d0))))
+ nil)
+
+(my-assert
+ (typep 4 (quote (mod 4)))
+ nil)
+
+(my-assert
+ (typep 4 (quote (mod 5)))
+ t)
+
+(my-assert
+ (typep 4 (quote (rational 2 5)))
+ t)
+
+(my-assert
+ (typep 4 (quote (rational 2 7/2)))
+ nil)
+
+(my-assert
+ (typep 4 (quote (rational 2 9/2)))
+ t)
+
+(my-assert
+ (typep 4 (quote (rational 2 4)))
+ t)
+
+(my-assert
+ (typep 4/3 (quote (rational 2 4)))
+ nil)
+
+(my-assert
+ (typep 2 (quote (rational 2 4)))
+ t)
+
+(my-assert
+ (typep "abcd" (quote string))
+ t)
+
+(my-assert
+ (typep "abcd" (quote (string 4)))
+ t)
+
+(my-assert
+ (typep "abcd" (quote (string 43)))
+ nil)
+
+(my-assert
+ (typep '#(2 3) (quote (complex integer)))
+ nil)
+
+(my-assert
+ (typep '#(2 3) (quote complex))
+ nil)
+
+(my-assert
+ (typep #c(2 3) (quote complex))
+ t)
+
+(my-assert
+ (typep #c(2 3) (quote (complex integer)))
+ t)
+
+(my-assert
+ (typep #c(2 3) (quote (complex float)))
+ nil)
+
+(my-assert
+ (typep #c(2 3) (quote (complex symbol)))
+ #+(or cmu sbcl) error
+ #-(or cmu sbcl) nil)
+
+(my-assert
+ (typep '#(a b c d) (quote vector))
+ t)
+
+(my-assert
+ (typep '#(a b c d) (quote (vector * 4)))
+ t)
+
+#|
+;;
+;; hängt von (upgraded-array-element-type 'symbol) ab!
+(typep '#(a b c d) (quote (vector symbol 4)))
+nil
+|#
+
+(my-assert
+ (typep (quote a) (quote (symbol cons)))
+ error)
+
+(my-assert
+ (typep (quote a) (quote (or cons symbol)))
+ t)
+
+(my-assert
+ (typep (quote a) (quote (or cons number)))
+ nil)
+
+(my-assert
+ (typep (quote a) (quote (or atom number)))
+ t)
+
+(my-assert
+ (typep (quote a) (quote (and atom number)))
+ nil)
+
+(my-assert
+ (typep (quote 2) (quote (and atom number)))
+ t)
+
+(my-assert
+ (typep (quote 2) (quote (member 1 2 3)))
+ t)
+
+(my-assert
+ (typep (quote 2) (quote (member 1 3)))
+ nil)
+
+(my-assert
+ (typep (quote 2) (quote (not (member 1 3))))
+ t)
+
+(my-assert
+ (typep (quote 2) (quote (not (member 1 2 3))))
+ nil)
+
+(my-assert
+ (typep 2 (quote (and number (not symbol))))
+ t)
+
+(my-assert
+ (typep 2 (quote (and string (not symbol))))
+ nil)
+
+(my-assert
+ (typep 2 (quote (or string (not symbol))))
+ t)
+
+(my-assert
+ (typep (quote cons) (quote function))
+ nil)
+
+(my-assert
+ (typep (quote cons) (quote (satisfies functionp)))
+ nil)
+
+(my-assert
+ (typep (quote cons) (quote (satisfies not)))
+ nil)
+
+(my-assert
+ (typep (quote nil) (quote (satisfies not)))
+ t)
+
+(my-assert
+ (typep (quote nil) nil)
+ nil)
+
+(my-assert
+ (typep (quote t) nil)
+ nil)
+
+(my-assert
+ (subtypep (quote cons) t)
+ t)
+
+(my-assert
+ (subtypep nil (quote cons))
+ t)
+
+(my-assert
+ (subtypep (quote cons) (quote list))
+ t)
+
+(my-assert
+ (subtypep (quote cons) (quote (or atom cons)))
+ t)
+
+(my-assert
+ (subtypep (quote cons) (quote (and atom cons)))
+ nil)
+
+(my-assert
+ (subtypep (quote cons) (quote (not atom)))
+ #-(or clisp akcl allegro) t
+ #+(or clisp akcl allegro) nil
+ "Type atom: is equivalent to (not cons)")
+
+(my-assert
+ (subtypep (quote list) (quote (not atom)))
+ nil)
+
+(my-assert
+ (subtypep (quote (integer 1 5)) (quote (integer 0 7)))
+ t)
+
+(my-assert
+ (subtypep (quote (integer 1 5)) (quote (integer 0 (5))))
+ nil)
+
+(my-assert
+ (subtypep (quote (integer 1 5)) (quote (integer 0 5)))
+ t)
+
+(my-assert
+ (subtypep (quote (integer 1 5)) (quote (mod 5)))
+ nil)
+
+(my-assert
+ (subtypep (quote (integer 1 (5))) (quote (mod 5)))
+ t)
+
+(my-assert
+ (subtypep '(or (integer 1 (5) float))
+	   '(or float (mod 5)))
+ #+(or xcl clisp ecls) t
+ #+(or allegro cmu sbcl) error
+ #-(or xcl clisp allegro cmu sbcl ecls) unknown)
+
+(my-assert
+ (subtypep '(or (integer 1 (5)) float)
+	   '(or float (mod 5)))
+ t)
+
+(my-assert
+ (subtypep '(and number (float 1.0 (5.0)))
+	   '(or float (mod 5)))
+ t)
+
+(my-assert
+ (subtypep '(and number (not (float 1.0 (5.0))))
+	   '(or float (mod 5)))
+ nil)
+
+
+(my-assert
+ (subtypep '(and float (not (float 1.0 (5.0))))
+	   '(or float (mod 5)))
+ t
+ "a float that is not in [1-5[ is a subtype of float")
+
+(my-assert
+ (subtypep '(and float (not (float 1.0 (5.0))))
+	   '(or (float * 1.0) (float * 5.0)))
+ nil)
+
+(my-assert
+ (subtypep '(satisfies consp)
+	   'list)
+ nil)
+
+(my-assert
+ (subtypep (quote simple-string) (quote array))
+ t)
+
+(my-assert
+ (deftype mod1 (n) `(and number (float 0.0 (,n))))
+ mod1)
+
+(my-assert
+ (typep 4.1 (quote (mod1 5.0)))
+ t)
+
+(my-assert
+ (typep 4.1 (quote (mod1 4.1)))
+ nil)
+
+(my-assert
+ (subtypep (quote (float 2.3 6.7)) (quote (mod1 6.8)))
+ t)
+
+(my-assert
+ (subtypep (quote (float 2.3 6.7)) (quote (mod1 6.7)))
+ nil)
+
+(my-assert
+ (defun beliebiger-test (a) (member a (quote (u i v x))))
+ beliebiger-test)
+
+(my-assert
+ (not (null (typep (quote u) (quote (satisfies beliebiger-test)))))
+ t)
+
+(my-assert
+ (typep (quote a) (quote (satisfies beliebiger-test)))
+ nil)
+
+;; This looks like asking a bit _too_ much
+;; of the type system [pve]
+(my-assert
+ (subtypep (quote (member u i)) (quote (satisfies beliebiger-test)))
+ #-(or cmu sbcl) t
+ #+(or cmu sbcl) nil)
+
+(my-assert
+ (subtypep (quote (or (member u i))) (quote (satisfies beliebiger-test)))
+ #-(or cmu sbcl) t
+ #+(or cmu sbcl) nil)
+
+
+(my-assert
+ (subtypep (quote (or (member u i a))) (quote (satisfies beliebiger-test)))
+ nil)
+
+(my-assert
+ (subtypep (quote (satisfies beliebiger-test))
+	   (quote (member u i v x y)))
+ nil)
+
+(my-assert
+ (deftype beliebiger-typ nil (quote (satisfies beliebiger-test)))
+ beliebiger-typ)
+
+(my-assert
+ (not (null (typep (quote u) (quote beliebiger-typ))))
+ t)
+
+(my-assert
+ (typep (quote a) (quote beliebiger-typ))
+ nil)
+
+(my-assert
+ (subtypep (quote (member u i)) (quote beliebiger-typ))
+ #-(or cmu sbcl) t
+ #+(or cmu sbcl) nil)
+
+
+(my-assert
+ (subtypep (quote beliebiger-typ) (quote (member u i v x y)))
+ nil)
+
+(my-assert
+ (subtypep nil 'fixnum) t)
+
+(my-assert
+ (subtypep 'short-float 'float ) t)
+
+(my-assert
+ (subtypep 'single-float 'float ) t)
+
+(my-assert
+ (subtypep 'double-float 'float ) t)
+
+(my-assert
+ (subtypep 'long-float 'float ) t)
+
+(my-assert
+ (subtypep 'null 'symbol) t)
+
+(my-assert
+ (subtypep 'null 'list) t)
+
+(my-assert
+ (subtypep 'cons 'list) t)
+
+(my-assert
+ (subtypep 'string 'vector) t)
+
+(my-assert
+ (subtypep 'bit-vector 'vector) t)
+(my-assert
+ (subtypep 'vector 'array) t)
+
+(my-assert
+ (subtypep 'simple-array 'array) t)
+
+(my-assert
+ (subtypep 'simple-vector 'simple-array) t)
+
+(my-assert
+ (subtypep 'simple-vector 'vector) t)
+
+(my-assert
+ (subtypep 'simple-string 'simple-array) t)
+
+(my-assert
+ (subtypep 'simple-bit-vector 'simple-array) t)
+
+(my-assert
+ (subtypep 'simple-string 'string) t)
+
+(my-assert
+ (subtypep 'simple-string 'vector) t)
+
+(my-assert
+ (subtypep 'simple-string 'simple-vector) nil)
+
+(my-assert
+ (subtypep 'simple-bit-vector 'bit-vector) t)
+
+(my-assert
+ (subtypep 'bit-vector 'vector) t)
+
+(my-assert
+ (subtypep 'simple-bit-vector 'simple-vector) nil)
+
+(my-assert
+ (subtypep 'unsigned-byte 'integer) t)
+
+(my-assert
+ (subtypep 'signed-byte 'integer) t)
diff --git a/src/ansi-tests/unix-tests.lisp b/src/ansi-tests/unix-tests.lisp
new file mode 100644
index 000000000..f39142c7e
--- /dev/null
+++ b/src/ansi-tests/unix-tests.lisp
@@ -0,0 +1,52 @@
+(in-package :cl-user)
+
+(my-assert
+ (progn (ensure-directories-exist "test-dir/") t)
+ T)
+
+(my-assert
+ (#+cmu unix:unix-access
+	#+sbcl sb-unix:unix-access "test-dir"
+	#+cmu unix:r_ok
+	#+sbcl sb-unix:r_ok)
+ T)
+
+(my-assert
+ (#+cmu unix:unix-access #+sbcl sb-unix:unix-access "test-dir" #+cmu unix:w_ok #+sbcl sb-unix:w_ok)
+ T)
+
+(my-assert
+ (#+cmu unix:unix-access #+sbcl sb-unix:unix-access "test-dir" #+cmu unix:x_ok #+sbcl sb-unix:x_ok)
+ T)
+
+(my-assert
+ (#+cmu unix:unix-access #+sbcl sb-unix:unix-access "test-dir" #+cmu unix:f_ok #+sbcl sb-unix:f_ok)
+ T)
+
+(with-open-file (file "test-dir/a"
+		      :direction :output
+		      :if-exists :supersede)
+  (princ "hello world" file))
+		      
+(my-assert
+ (#+cmu unix:unix-access #+sbcl sb-unix:unix-access "test-dir/a" #+cmu unix:r_ok #+sbcl sb-unix:r_ok)
+ T)
+
+(my-assert
+ (#+cmu unix:unix-access #+sbcl sb-unix:unix-access "test-dir/a" #+cmu unix:w_ok #+sbcl sb-unix:w_ok)
+ T)
+
+(my-assert
+ (#+cmu unix:unix-access #+sbcl sb-unix:unix-access "test-dir/a" #+cmu unix:x_ok #+sbcl sb-unix:x_ok)
+ NIL)
+
+(my-assert
+ (#+cmu unix:unix-access #+sbcl sb-unix:unix-access "test-dir/a" #+cmu unix:f_ok #+sbcl sb-unix:f_ok)
+ T)
+
+(my-assert
+ (progn
+   (#+cmu unix:unix-gettimeofday #+sbcl sb-unix:unix-gettimeofday)
+   t)
+ t)
+
diff --git a/src/bare.lsp.in b/src/bare.lsp.in
new file mode 100644
index 000000000..119faf1a5
--- /dev/null
+++ b/src/bare.lsp.in
@@ -0,0 +1,56 @@
+;;;
+;;; Configuration file for the bootstrapping version of ECLS
+;;;
+;;; * Set ourselves in the 'SYSTEM package
+;;;
+(setq *package* (find-package "SYSTEM"))
+
+;;;
+;;; * Load Common-Lisp base library
+;;;
+(load "lsp/load.lsp")
+
+#ifdef CLOS
+;;;
+;;; * Load PCL-based Common-Lisp Object System
+;;;
+(setf sys::*gc-verbose* nil)
+(load "clos/load.lsp")
+#endif
+
+;;;
+;;; * Load the compiler.
+;;;
+(load "cmp/load.lsp")
+
+;;;
+;;; * By redefining *system-directory* ECLS will be able to
+;;;   find headers and libraries in the build directory.
+;;;
+(setq si::*system-directory* (namestring (sys::chdir "./")))
+
+;;;
+;;; * Add include path to not yet installed headers
+;;;
+(setq compiler::*cc-flags* (concatenate 'string compiler::*cc-flags* " -I@srcdir@/h -I@srcdir@/gmp "))
+
+;;;
+;;; * Beppe's defsystem utility
+;;;
+(load "@srcdir@/util/system.lsp")
+
+;;;
+;;; * We redefine this to force generation of source files
+;;; in the object directory -- source files help debugging
+;;; with GDB.
+;;;
+(defun sbt::sbt-compile-file (&rest s)
+  (apply #'compiler::compile-file
+	   (car s)
+	   :c-file t :h-file t :data-file t :system-p t
+	   (cdr s)))
+
+;;;
+;;; * Go back to build directory to start compiling
+;;;
+(setq *features* (remove :ecls-min *features*))
diff --git a/src/c/Makefile.in b/src/c/Makefile.in
new file mode 100644
index 000000000..d6f0faa8b
--- /dev/null
+++ b/src/c/Makefile.in
@@ -0,0 +1,131 @@
+#
+#			Makefile for ECLS core library
+#
+top_srcdir= @top_srcdir@
+srcdir	= @srcdir@
+VPATH	= @srcdir@
+
+MACHINE = @MACHINE@
+
+# Programs used by "make":
+#
+CC	= @CC@
+DEFS	= -D$(MACHINE)
+CFLAGS	= -c -I../h -I$(HDIR) -I$(top_srcdir)/gc @CFLAGS@ $(DEFS)
+#ifndef HAVE_LOCAL_GMP
+CFLAGS +=  -I$(top_srcdir)/gmp
+#endif
+
+SHELL	= /bin/sh
+RM	= @RM@
+
+#ifdef MSDOS
+DPP	= dpp.exe
+#else
+DPP	= ./dpp
+#endif
+
+# Data for installation
+#
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+libdir	= @libdir@
+
+# Files
+
+HDIR	= $(top_srcdir)/h
+HFILES	= ../h/config.h $(HDIR)/ecls.h $(HDIR)/ecls-cmp.h\
+	$(HDIR)/machines.h $(HDIR)/object.h $(HDIR)/cs.h $(HDIR)/stacks.h\
+	$(HDIR)/external.h $(HDIR)/lisp_external.h $(HDIR)/eval.h\
+	$(HDIR)/number.h $(HDIR)/page.h $(HDIR)/unify.h\
+	$(HDIR)/lwp.h $(HDIR)/critical.h
+#ifdef GBC_BOEHM
+ALLOC   = alloc_2.o
+#else
+ALLOC   = alloc.o gbc.o
+#endif
+OBJS	= main.o $(ALLOC) symbol.o package.o list.o\
+	apply.o eval.o interpreter.o compiler.o disassembler.o \
+	lex.o reference.o character.o\
+	file.o read.o print.o error.o string.o cfun.o\
+	typespec.o assignment.o \
+	predicate.o big.o number.o\
+	num_pred.o num_comp.o num_arith.o num_sfun.o num_co.o\
+	num_log.o num_rand.o array.o sequence.o cmpaux.o\
+	macros.o backq.o stacks.o \
+	time.o unixint.o\
+	mapfun.o multival.o hash.o format.o pathname.o\
+	structure.o load.o unixfsys.o unixsys.o \
+	all_keywords.o all_symbols.o all_functions.o init.o
+#ifdef THREADS
+OBJS	+= lwp.o
+#endif
+#ifdef LOCATIVE
+OBJS	+= unify.o
+#endif
+#if defined(TCP) || defined(CLX)
+OBJS	+= tcp.o
+#endif
+#ifdef CLOS
+OBJS	+= clos.o instance.o gfun.o
+#endif
+#ifdef TK
+OBJS	+= tclBasic.o tkMain.o
+#endif
+#ifdef PROFILE
+OBJS	+= profile.o
+#endif
+#ifdef MSDOS
+OBJS	+= dostimes.o dosdummy.o
+#endif
+
+.SUFFIXES: .c .o .d
+
+.c.o: $(HFILES)
+	$(CC) $(CFLAGS) -o $@ $<
+.d.c: $(DPP) $(HFILES)
+	$(DPP) $< $@
+
+all:	$(DPP) ../libecls.a cinit.o
+.PHONY:	all
+
+install: $(HFILES)
+	for i in $(HFILES); do $(INSTALL_DATA) $$i $(PREFIX)$(libdir)/h; done
+
+../libecls.a: $(OBJS)
+	ar cr $@ $(OBJS)
+	ranlib $@
+
+clean:
+	$(RM) *.c $(OBJS) ../libecls.a cinit.o core a.out
+
+# Build rules
+
+./dpp	: $(srcdir)/dpp.c
+	$(CC) @CFLAGS@ -I$(HDIR) $(srcdir)/dpp.c  -o $@
+
+dpp.exe	: $(srcdir)/dpp.c
+	make dpp
+	coff2exe dpp
+	$(RM) dpp
+
+#
+# Some files may break due to gcc optimizations
+#
+#apply.o: apply.c $(HFILES) $(HDIR)/cs.h
+# dangerous to optimize due to assembler hack
+#	$(CC) $(CFLAGS) -O0 -g apply.c -o $@
+#ifdef sgi
+# gcc optimization causes trouble
+assignment.o: assignment.c $(HFILES)
+	$(CC) $(CFLAGS) -g assignment.c -o $@
+#else
+#	$(CC) $(CFLAGS) assignment.c -o $@
+#endif
+#ifdef sgi
+# gcc optimization causes trouble
+gbc.o: gbc.c $(HFILES)
+	$(CC) $(CFLAGS) -g gbc.c -o $@
+#else
+#	$(CC) $(CFLAGS) gbc.c -o $@
+#endif
diff --git a/src/c/all_functions.d b/src/c/all_functions.d
new file mode 100644
index 000000000..7ff0706f6
--- /dev/null
+++ b/src/c/all_functions.d
@@ -0,0 +1,889 @@
+#define _ARGS(x) (int n, ...)
+
+#include "ecls.h"
+#include "page.h"
+
+struct function_info {
+  const char *name;
+  cl_object (*f)(int, ...);
+  short type;
+};
+
+#define form 2
+#define cl 0
+#define si 1
+
+static const struct function_info all_functions[] = {
+
+	/* alloc.c */
+
+#if !defined(GBC_BOEHM)
+	{"ALLOCATE", siLallocate, si},
+	{"ALLOCATED-PAGES", siLallocated_pages, si},
+	{"MAXIMUM-ALLOCATABLE-PAGES", siLmaxpage, si},
+	{"ALLOCATE-CONTIGUOUS-PAGES", siLalloc_contpage, si},
+	{"ALLOCATED-CONTIGUOUS-PAGES", siLncbpage, si},
+	{"MAXIMUM-CONTIGUOUS-PAGES", siLmaxcbpage, si},
+	{"GET-HOLE-SIZE", siLget_hole_size, si},
+	{"SET-HOLE-SIZE", siLset_hole_size, si},
+	{"IGNORE-MAXIMUM-PAGES", siLignore_maximum_pages, si},
+#endif /* !GBC_BOEHM */
+
+	/* alloc_2.c */
+
+#ifdef GBC_BOEHM
+	{"GC", Lgc, cl},
+#endif
+
+	/* array.c */
+
+	{"MAKE-PURE-ARRAY", siLmake_pure_array, si},
+	{"MAKE-VECTOR", siLmake_vector, si},
+	{"AREF", Laref, cl},
+	{"ASET", siLaset, si},
+	{"ARRAY-ELEMENT-TYPE", Larray_element_type, cl},
+	{"ARRAY-RANK", Larray_rank, cl},
+	{"ARRAY-DIMENSION", Larray_dimension, cl},
+	{"ARRAY-TOTAL-SIZE", Larray_total_size, cl},
+	{"ADJUSTABLE-ARRAY-P", Ladjustable_array_p, cl},
+	{"DISPLACED-ARRAY-P", siLdisplaced_array_p, si},
+
+	{"SVREF", Lsvref, cl},
+	{"SVSET", siLsvset, si},
+
+	{"ARRAY-HAS-FILL-POINTER-P", Larray_has_fill_pointer_p, cl},
+	{"FILL-POINTER", Lfill_pointer, cl},
+	{"FILL-POINTER-SET", siLfill_pointer_set, si},
+
+	{"REPLACE-ARRAY", siLreplace_array, si},
+
+	/* assignment.c */
+
+	{"CLEAR-COMPILER-PROPERTIES", siLclear_compiler_properties, si},
+	{"SETQ", NULL, form},
+	{"PSETQ", NULL, form},
+	{"SET", Lset, cl},
+	{"FSET", siLfset, si},
+	{"MULTIPLE-VALUE-SETQ", NULL, form},
+	{"MAKUNBOUND", Lmakunbound, cl},
+	{"FMAKUNBOUND", Lfmakunbound, cl},
+#if 0
+	{"SETF", NULL, form},
+	{"PUSH", NULL, form},
+	{"POP", NULL, form},
+	{"INCF", NULL, form},
+	{"DECF", NULL, form},
+#endif
+	{"SETF-NAMEP", siLsetf_namep, si},
+
+	/* block.c */
+
+	{"BLOCK", NULL, form},
+	{"RETURN-FROM", NULL, form},
+	{"RETURN", NULL, form},
+
+	/* catch.c */
+
+	{"CATCH", NULL, form},
+	{"UNWIND-PROTECT", NULL, form},
+	{"THROW", NULL, form},
+
+	/* cfun.c */
+
+	{"COMPILED-FUNCTION-NAME", siLcompiled_function_name, si},
+	{"COMPILED-FUNCTION-BLOCK", siLcompiled_function_block, si},
+
+	/* character.d */
+
+	{"STANDARD-CHAR-P", Lstandard_char_p, cl},
+	{"GRAPHIC-CHAR-P", Lgraphic_char_p, cl},
+	{"ALPHA-CHAR-P", Lalpha_char_p, cl},
+	{"UPPER-CASE-P", Lupper_case_p, cl},
+	{"LOWER-CASE-P", Llower_case_p, cl},
+	{"BOTH-CASE-P", Lboth_case_p, cl},
+	{"DIGIT-CHAR-P", Ldigit_char_p, cl},
+	{"ALPHANUMERICP", Lalphanumericp, cl},
+	{"CHAR=", Lchar_eq, cl},
+	{"CHAR/=", Lchar_neq, cl},
+	{"CHAR<", Lchar_l, cl},
+	{"CHAR>", Lchar_g, cl},
+	{"CHAR<=", Lchar_le, cl},
+	{"CHAR>=", Lchar_ge, cl},
+	{"CHAR-EQUAL", Lchar_equal, cl},
+	{"CHAR-NOT-EQUAL", Lchar_not_equal, cl},
+	{"CHAR-LESSP", Lchar_lessp, cl},
+	{"CHAR-GREATERP", Lchar_greaterp, cl},
+	{"CHAR-NOT-GREATERP", Lchar_not_greaterp, cl},
+	{"CHAR-NOT-LESSP", Lchar_not_lessp, cl},
+	{"CHARACTER", Lcharacter, cl},
+	{"CHAR-CODE", Lchar_code, cl},
+	{"CODE-CHAR", Lcode_char, cl},
+	{"CHAR-UPCASE", Lchar_upcase, cl},
+	{"CHAR-DOWNCASE", Lchar_downcase, cl},
+	{"DIGIT-CHAR", Ldigit_char, cl},
+	{"CHAR-INT", Lchar_int, cl},
+	{"INT-CHAR", Lint_char, cl},
+	{"CHAR-NAME", Lchar_name, cl},
+	{"NAME-CHAR", Lname_char, cl},
+
+	/* cmpaux.c */
+
+	{"SPECIALP", siLspecialp, si},
+
+	/* conditional.c */
+
+	{"IF", NULL, form},
+	{"COND", NULL, form},
+	{"CASE", NULL, form},
+	{"WHEN", NULL, form},
+	{"UNLESS", NULL, form},
+
+	/* disassembler.c */
+	{"BC-DISASSEMBLE", siLbc_disassemble, si},
+	{"BC-SPLIT", siLbc_split, si},
+
+	/* error.c */
+
+#if defined(FRAME_CHAIN) && !defined(RUNTIME)
+	{"BT", siLbacktrace, si},
+#endif
+	{"ERROR", Lerror, cl},
+	{"CERROR", Lcerror, cl},
+	{"UNIVERSAL-ERROR-HANDLER", siLuniversal_error_handler, si},
+
+	/* eval.c */
+
+	{"EVAL", Leval, cl},
+	{"EVALHOOK", Levalhook, cl},
+	{"APPLYHOOK", Lapplyhook, cl},
+	{"CONSTANTP", Lconstantp, cl},
+	{"UNLINK-SYMBOL", siLunlink_symbol, si},
+	{"APPLY", Lapply, cl},
+	{"FUNCALL", Lfuncall, cl},
+
+	/* file.d */
+
+	{"MAKE-SYNONYM-STREAM", Lmake_synonym_stream, cl},
+	{"MAKE-BROADCAST-STREAM", Lmake_broadcast_stream, cl},
+	{"MAKE-CONCATENATED-STREAM", Lmake_concatenated_stream, cl},
+	{"MAKE-TWO-WAY-STREAM", Lmake_two_way_stream, cl},
+	{"MAKE-ECHO-STREAM", Lmake_echo_stream, cl},
+	{"MAKE-STRING-INPUT-STREAM", Lmake_string_input_stream, cl},
+	{"MAKE-STRING-OUTPUT-STREAM", Lmake_string_output_stream, cl},
+	{"GET-OUTPUT-STREAM-STRING", Lget_output_stream_string, cl},
+
+	{"OUTPUT-STREAM-STRING", siLoutput_stream_string, si},
+
+	{"STREAMP", Lstreamp, cl},
+	{"INPUT-STREAM-P", Linput_stream_p, cl},
+	{"OUTPUT-STREAM-P", Loutput_stream_p, cl},
+	{"STREAM-ELEMENT-TYPE", Lstream_element_type, cl},
+	{"CLOSE", Lclose, cl},
+	{"OPEN", Lopen, cl},
+	{"FILE-POSITION", Lfile_position, cl},
+	{"FILE-LENGTH", Lfile_length, cl},
+	{"OPEN-STREAM-P", Lopen_stream_p, cl},
+	{"GET-STRING-INPUT-STREAM-INDEX", siLget_string_input_stream_index, si},
+	{"MAKE-STRING-OUTPUT-STREAM-FROM-STRING", siLmake_string_output_stream_from_string, si},
+	{"COPY-STREAM", siLcopy_stream, si},
+
+	/* format. c */
+
+	{"FORMAT", Lformat, cl},
+
+	/* gbc.c */
+
+#if !defined(GBC_BOEHM)
+	{"ROOM-REPORT", siLroom_report, si},
+	{"RESET-GC-COUNT", siLreset_gc_count, si},
+	{"GC", Lgc, cl},
+	{"GC-TIME", siLgc_time, si},
+#endif
+
+	/* gfun.c */
+#ifdef CLOS
+	{"ALLOCATE-GFUN", siLallocate_gfun, si},
+	{"GFUN-NAME", siLgfun_name, si},
+	{"GFUN-NAME-SET", siLgfun_name_set, si},
+	{"GFUN-METHOD-HT", siLgfun_method_ht, si},
+	{"GFUN-METHOD-HT-SET", siLgfun_method_ht_set, si},
+	{"GFUN-SPEC-HOW-REF", siLgfun_spec_how_ref, si},
+	{"GFUN-SPEC-HOW-SET", siLgfun_spec_how_set, si},
+	{"GFUN-INSTANCE", siLgfun_instance, si},
+	{"GFUN-INSTANCE-SET", siLgfun_instance_set, si},
+	{"GFUNP", siLgfunp, si},
+	{"METHOD-HT-GET", siLmethod_ht_get, si},
+	{"SET-COMPILED-FUNCTION-NAME", siLset_compiled_function_name, si},
+#endif CLOS
+
+	/* hash.d */
+
+	{"MAKE-HASH-TABLE", Lmake_hash_table, cl},
+	{"HASH-TABLE-P", Lhash_table_p, cl},
+	{"GETHASH", Lgethash, cl},
+	{"REMHASH", Lremhash, cl},
+   	{"MAPHASH", Lmaphash, cl},
+	{"CLRHASH", Lclrhash, cl},
+	{"HASH-TABLE-COUNT", Lhash_table_count, cl},
+   	{"SXHASH", Lsxhash, cl},
+	{"HASH-SET", siLhash_set, si},
+	{"HASH-TABLE-REHASH-SIZE", Lhash_table_rehash_size, cl},
+	{"HASH-TABLE-REHASH-THRESHOLD", Lhash_table_rehash_threshold, cl},
+
+	/* instance.c */
+#ifdef CLOS
+	{"ALLOCATE-INSTANCE", siLallocate_instance, si},
+	{"CHANGE-INSTANCE", siLchange_instance, si},
+	{"INSTANCE-REF-SAFE", siLinstance_ref_safe, si},
+	{"INSTANCE-REF", siLinstance_ref, si},
+	{"INSTANCE-SET", siLinstance_set, si},
+	{"INSTANCE-CLASS", siLinstance_class, si},
+	{"INSTANCE-CLASS-SET", siLinstance_class_set, si},
+	{"INSTANCEP", siLinstancep, si},
+	{"SL-BOUNDP", siLsl_boundp, si},
+	{"SL-MAKUNBOUND", siLsl_makunbound, si},
+#endif CLOS
+
+	/* interpreter.c */
+	{"INTERPRETER-STACK", siLinterpreter_stack, si},
+	{"MAKE-LAMBDA", siLmake_lambda, si},
+
+	/* iteration.c */
+
+	{"DO", NULL, form},
+	{"DO*", NULL, form},
+	{"DOLIST", NULL, form},
+	{"DOTIMES", NULL, form},
+
+	/* lex.c */
+
+	{"LEX-ENV", siLlex_env, si},
+
+	/* let.c */
+
+	{"LET", NULL, form},
+	{"LET*", NULL, form},
+	{"MULTIPLE-VALUE-BIND", NULL, form},
+	{"COMPILER-LET", NULL, form},
+	{"FLET", NULL, form},
+	{"LABELS", NULL, form},
+	{"MACROLET", NULL, form},
+	{"SYMBOL-MACROLET", NULL, form},
+
+	/* list.d */
+
+	{"CAR", Lcar, cl},
+	{"CDR", Lcdr, cl},
+	{"CAAR", Lcaar, cl},
+	{"CADR", Lcadr, cl},
+	{"CDAR", Lcdar, cl},
+	{"CDDR", Lcddr, cl},
+	{"CAAAR", Lcaaar, cl},
+	{"CAADR", Lcaadr, cl},
+	{"CADAR", Lcadar, cl},
+	{"CADDR", Lcaddr, cl},
+	{"CDAAR", Lcdaar, cl},
+	{"CDADR", Lcdadr, cl},
+	{"CDDAR", Lcddar, cl},
+	{"CDDDR", Lcdddr, cl},
+	{"CAAAAR", Lcaaaar, cl},
+	{"CAAADR", Lcaaadr, cl},
+	{"CAADAR", Lcaadar, cl},
+	{"CAADDR", Lcaaddr, cl},
+	{"CADAAR", Lcadaar, cl},
+	{"CADADR", Lcadadr, cl},
+	{"CADDAR", Lcaddar, cl},
+	{"CADDDR", Lcadddr, cl},
+	{"CDAAAR", Lcdaaar, cl},
+	{"CDAADR", Lcdaadr, cl},
+	{"CDADAR", Lcdadar, cl},
+	{"CDADDR", Lcdaddr, cl},
+	{"CDDAAR", Lcddaar, cl},
+	{"CDDADR", Lcddadr, cl},
+	{"CDDDAR", Lcdddar, cl},
+	{"CDDDDR", Lcddddr, cl},
+
+	{"CONS", Lcons, cl},
+	{"TREE-EQUAL", Ltree_equal, cl},
+	{"ENDP", Lendp, cl},
+	{"LIST-LENGTH", Llist_length, cl},
+	{"NTH", Lnth, cl},
+
+	{"FIRST", Lcar, cl},
+	{"SECOND", Lcadr, cl},
+	{"THIRD", Lcaddr, cl},
+	{"FOURTH", Lcadddr, cl},
+	{"FIFTH", Lfifth, cl},
+	{"SIXTH", Lsixth, cl},
+	{"SEVENTH", Lseventh, cl},
+	{"EIGHTH", Leighth, cl},
+	{"NINTH", Lninth, cl},
+	{"TENTH", Ltenth, cl},
+
+	{"REST", Lcdr, cl},
+	{"NTHCDR", Lnthcdr, cl},
+	{"LAST", Llast, cl},
+	{"LIST", Llist, cl},
+	{"LIST*", LlistA, cl},
+	{"MAKE-LIST", Lmake_list, cl},
+	{"APPEND", Lappend, cl},
+	{"COPY-LIST", Lcopy_list, cl},
+	{"COPY-ALIST", Lcopy_alist, cl},
+	{"COPY-TREE", Lcopy_tree, cl},
+	{"REVAPPEND", Lrevappend, cl},
+	{"NCONC", Lnconc, cl},
+	{"NRECONC", Lreconc, cl},
+
+	{"BUTLAST", Lbutlast, cl},
+	{"NBUTLAST", Lnbutlast, cl},
+	{"LDIFF", Lldiff, cl},
+	{"RPLACA", Lrplaca, cl},
+	{"RPLACD", Lrplacd, cl},
+	{"SUBST", Lsubst, cl},
+	{"SUBST-IF", Lsubst_if, cl},
+	{"SUBST-IF-NOT", Lsubst_if_not, cl},
+	{"NSUBST", Lnsubst, cl},
+	{"NSUBST-IF", Lnsubst_if, cl},
+	{"NSUBST-IF-NOT", Lnsubst_if_not, cl},
+	{"SUBLIS", Lsublis, cl},
+	{"NSUBLIS", Lnsublis, cl},
+	{"MEMBER", Lmember, cl},
+	{"MEMBER-IF", Lmember_if, cl},
+	{"MEMBER-IF-NOT", Lmember_if_not, cl},
+	{"MEMBER1", Lmember1, si},
+	{"TAILP", Ltailp, cl},
+	{"ADJOIN", Ladjoin, cl},
+
+	{"ACONS", Lacons, cl},
+	{"PAIRLIS", Lpairlis, cl},
+	{"ASSOC", Lassoc, cl},
+	{"ASSOC-IF", Lassoc_if, cl},
+	{"ASSOC-IF-NOT", Lassoc_if_not, cl},
+	{"RASSOC", Lrassoc, cl},
+	{"RASSOC-IF", Lrassoc_if, cl},
+	{"RASSOC-IF-NOT", Lrassoc_if_not, cl},
+
+	{"MEMQ", siLmemq, si},
+
+	/* load.d */
+
+	{"LOAD", Lload, cl},
+	{"LOAD-BINARY", siLload_binary, si},
+	{"LOAD-SOURCE", siLload_source, si},
+#if 0
+	{"FASLINK", siLfaslink, si},
+#endif
+
+	/* lwp.d */
+#ifdef THREADS
+	{"THREAD-BREAK-IN", siLthread_break_in, si},
+	{"THREAD-BREAK-QUIT", siLthread_break_quit, si},
+	{"THREAD-BREAK-RESUME", siLthread_break_resume, si},
+	{"MAKE-THREAD", Lmake_thread, cl},
+	{"DEACTIVATE", Ldeactivate, cl},
+	{"REACTIVATE", Lreactivate, cl},
+	{"KILL-THREAD", Lkill_thread, cl},
+	{"CURRENT-THREAD", Lcurrent_thread, cl},
+	{"THREAD-STATUS", Lthread_status, cl},
+	{"THREAD-LIST", Lthread_list, cl},
+	{"MAKE-CONTINUATION", Lmake_continuation, cl},
+	{"THREAD-OF", Lthread_of, cl},
+	{"CONTINUATION-OF", Lcontinuation_of, cl},
+	{"RESUME", Lresume, cl},
+
+	{"%DISABLE-SCHEDULER", Ldisable_scheduler, cl},
+	{"%ENABLE-SCHEDULER", Lenable_scheduler, cl},
+	{"%SUSPEND", Lsuspend, cl},
+	{"%DELAY", Ldelay, cl},
+	{"%THREAD-WAIT", Lthread_wait, cl},
+	{"%THREAD-WAIT-WITH-TIMEOUT", Lthread_wait_with_timeout, cl},
+#endif THREADS
+
+	/* macros.c */
+
+	{"MACROEXPAND", Lmacroexpand, cl},
+	{"MACROEXPAND-1", Lmacroexpand_1, cl},
+
+	/* main.c */
+
+	{"QUIT", Lquit, cl},
+	{"ARGC", siLargc, si},
+	{"ARGV", siLargv, si},
+	{"GETENV", siLgetenv, si},
+	{"POINTER", siLaddress, si},
+#if !defined(MSDOS) && !defined(__NeXT)
+	{"MACHINE-INSTANCE", Lmachine_instance, cl},
+	{"MACHINE-VERSION", Lmachine_version, cl},
+	{"SOFTWARE-TYPE", Lsoftware_type, cl},
+	{"SOFTWARE-VERSION", Lsoftware_version, cl},
+#endif MSDOS
+
+	/* mapfun.c */
+
+	{"MAPCAR", Lmapcar, cl},
+	{"MAPLIST", Lmaplist, cl},
+	{"MAPC", Lmapc, cl},
+	{"MAPL", Lmapl, cl},
+	{"MAPCAN", Lmapcan, cl},
+	{"MAPCON", Lmapcon, cl},
+
+	/* multival.c */
+
+	{"VALUES", Lvalues, cl},
+	{"VALUES-LIST", Lvalues_list, cl},
+	{"MULTIPLE-VALUE-CALL", NULL, form},
+	{"MULTIPLE-VALUE-PROG1", NULL, form},
+	{"MULTIPLE-VALUE-LIST", NULL, form},
+	{"NTH-VALUE", NULL, form},
+
+
+	/* num-arith.c */
+
+	{"+", Lplus, cl},
+	{"-", Lminus, cl},
+	{"*", Ltimes, cl},
+	{"/", Ldivide, cl},
+	{"1+", Lone_plus, cl},
+	{"1-", Lone_minus, cl},
+	{"CONJUGATE", Lconjugate, cl},
+	{"GCD", Lgcd, cl},
+	{"LCM", Llcm, cl},
+
+
+	/* num_co.c */
+
+	{"FLOAT", Lfloat, cl},
+	{"NUMERATOR", Lnumerator, cl},
+	{"DENOMINATOR", Ldenominator, cl},
+	{"FLOOR", Lfloor, cl},
+	{"CEILING", Lceiling, cl},
+	{"TRUNCATE", Ltruncate, cl},
+	{"ROUND", Lround, cl},
+	{"MOD", Lmod, cl},
+	{"REM", Lrem, cl},
+	{"DECODE-FLOAT", Ldecode_float, cl},
+	{"SCALE-FLOAT", Lscale_float, cl},
+	{"FLOAT-RADIX", Lfloat_radix, cl},
+	{"FLOAT-SIGN", Lfloat_sign, cl},
+	{"FLOAT-DIGITS", Lfloat_digits, cl},
+	{"FLOAT-PRECISION", Lfloat_precision, cl},
+	{"INTEGER-DECODE-FLOAT", Linteger_decode_float, cl},
+	{"COMPLEX", Lcomplex, cl},
+	{"REALPART", Lrealpart, cl},
+	{"IMAGPART", Limagpart, cl},
+
+	/* num_comp.c */
+
+	{"=", Lall_the_same, cl},
+	{"/=", Lall_different, cl},
+	{"<", Lmonotonically_increasing, cl},
+	{">", Lmonotonically_decreasing, cl},
+	{"<=", Lmonotonically_nondecreasing, cl},
+	{">=", Lmonotonically_nonincreasing, cl},
+	{"MAX", Lmax, cl},
+	{"MIN", Lmin, cl},
+
+	/* num_log.c */
+
+	{"LOGIOR", Llogior, cl},
+	{"LOGXOR", Llogxor, cl},
+	{"LOGAND", Llogand, cl},
+	{"LOGEQV", Llogeqv, cl},
+	{"BOOLE", Lboole, cl},
+	{"LOGBITP", Llogbitp, cl},
+	{"ASH", Lash, cl},
+	{"LOGCOUNT", Llogcount, cl},
+	{"INTEGER-LENGTH", Linteger_length, cl},
+	{"BIT-ARRAY-OP", siLbit_array_op, si},
+
+	/* num_pred.c */
+
+	{"ZEROP", Lzerop, cl},
+	{"PLUSP", Lplusp, cl},
+	{"MINUSP", Lminusp, cl},
+	{"ODDP", Loddp, cl},
+	{"EVENP", Levenp, cl},
+	{"NANI", siLnani, si},
+
+	/* num_rand.c */
+
+	{"RANDOM", Lrandom, cl},
+	{"MAKE-RANDOM-STATE", Lmake_random_state, cl},
+	{"RANDOM-STATE-P", Lrandom_state_p, cl},
+
+	/* num_sfun.c */
+
+	{"EXP", Lexp, cl},
+	{"EXPT", Lexpt, cl},
+	{"LOG", Llog, cl},
+	{"SQRT", Lsqrt, cl},
+	{"SIN", Lsin, cl},
+	{"COS", Lcos, cl},
+	{"TAN", Ltan, cl},
+	{"ATAN", Latan, cl},
+	{"SINH", Lsinh, cl},
+	{"COSH", Lcosh, cl},
+	{"TANH", Ltanh, cl},
+
+	/* package.d */
+
+	{"MAKE-PACKAGE", Lmake_package, cl},
+	{"SELECT-PACKAGE", siLselect_package, si},
+	{"FIND-PACKAGE", Lfind_package, cl},
+	{"PACKAGE-NAME", Lpackage_name, cl},
+	{"PACKAGE-NICKNAMES", Lpackage_nicknames, cl},
+	{"RENAME-PACKAGE", Lrename_package, cl},
+	{"PACKAGE-USE-LIST", Lpackage_use_list, cl},
+	{"PACKAGE-USED-BY-LIST", Lpackage_used_by_list, cl},
+	{"PACKAGE-SHADOWING-SYMBOLS", Lpackage_shadowing_symbols, cl},
+	{"LIST-ALL-PACKAGES", Llist_all_packages, cl},
+	{"INTERN", Lintern, cl},
+	{"FIND-SYMBOL", Lfind_symbol, cl},
+	{"UNINTERN", Lunintern, cl},
+	{"EXPORT", Lexport, cl},
+	{"UNEXPORT", Lunexport, cl},
+	{"IMPORT", Limport, cl},
+	{"SHADOWING-IMPORT", Lshadowing_import, cl},
+	{"SHADOW", Lshadow, cl},
+	{"USE-PACKAGE", Luse_package, cl},
+	{"UNUSE-PACKAGE", Lunuse_package, cl},
+	{"DELETE-PACKAGE", Ldelete_package, cl},
+
+	{"PACKAGE-SIZE", siLpackage_size, si},
+	{"PACKAGE-INTERNAL", siLpackage_internal, si},
+	{"PACKAGE-EXTERNAL", siLpackage_external, si},
+	{"PACKAGE-LOCK", siLpackage_lock, si},
+
+	/* pathname.d */
+
+	{"PATHNAME", Lpathname, cl},
+	{"PARSE-NAMESTRING", Lparse_namestring, cl},
+	{"MERGE-PATHNAMES", Lmerge_pathnames, cl},
+	{"MAKE-PATHNAME", Lmake_pathname, cl},
+	{"PATHNAMEP", Lpathnamep, cl},
+	{"PATHNAME-HOST", Lpathname_host, cl},
+	{"PATHNAME-DEVICE", Lpathname_device, cl},
+	{"PATHNAME-DIRECTORY", Lpathname_directory, cl},
+	{"PATHNAME-NAME", Lpathname_name, cl},
+	{"PATHNAME-TYPE", Lpathname_type, cl},
+	{"PATHNAME-VERSION", Lpathname_version, cl},
+	{"NAMESTRING", Lnamestring, cl},
+	{"FILE-NAMESTRING", Lfile_namestring, cl},
+	{"DIRECTORY-NAMESTRING", Ldirectory_namestring, cl},
+	{"HOST-NAMESTRING", Lhost_namestring, cl},
+	{"ENOUGH-NAMESTRING", Lenough_namestring, cl},
+	{"LOGICAL-PATHNAME-P", siLlogical_pathname_p, si},
+	{"PATHNAME-MATCH-P", Lpathname_match_p, cl},
+	{"TRANSLATE-PATHNAME", Ltranslate_pathname, cl},
+	{"TRANSLATE-LOGICAL-PATHNAME", Ltranslate_logical_pathname, cl},
+	{"PATHNAME-TRANSLATIONS", siLpathname_translations, si},
+
+	/* predicate.c */
+
+	{"IDENTITY", Lidentity, cl},
+	{"NULL", Lnull, cl},
+	{"SYMBOLP", Lsymbolp, cl},
+	{"ATOM", Latom, cl},
+	{"CONSP", Lconsp, cl},
+	{"LISTP", Llistp, cl},
+	{"NUMBERP", Lnumberp, cl},
+	{"INTEGERP", Lintegerp, cl},
+	{"RATIONALP", Lrationalp, cl},
+	{"FLOATP", Lfloatp, cl},
+	{"REALP", Lrealp, cl},
+	{"COMPLEXP", Lcomplexp, cl},
+	{"CHARACTERP", Lcharacterp, cl},
+	{"STRINGP", Lstringp, cl},
+	{"BIT-VECTOR-P", Lbit_vector_p, cl},
+	{"VECTORP", Lvectorp, cl},
+	{"SIMPLE-STRING-P", Lsimple_string_p, cl},
+	{"SIMPLE-BIT-VECTOR-P", Lsimple_bit_vector_p, cl},
+	{"SIMPLE-VECTOR-P", Lsimple_vector_p, cl},
+	{"ARRAYP", Larrayp, cl},
+	{"PACKAGEP", Lpackagep, cl},
+	{"FUNCTIONP", Lfunctionp, cl},
+	{"COMPILED-FUNCTION-P", Lcompiled_function_p, cl},
+	{"COMMONP", Lcommonp, cl},
+
+	{"EQ", Leq, cl},
+	{"EQL", Leql, cl},
+	{"EQUAL", Lequal, cl},
+	{"EQUALP", Lequalp, cl},
+
+	{"NOT", Lnull, cl},
+
+	{"CONTAINS-SHARP-COMMA", siLcontains_sharp_comma, si},
+
+	{"FIXNUMP", siLfixnump, si},
+
+	/* print.d */
+
+	{"WRITE", Lwrite, cl},
+	{"PRIN1", Lprin1, cl},
+	{"PRINT", Lprint, cl},
+	{"PPRINT", Lpprint, cl},
+	{"PRINC", Lprinc, cl},
+	{"WRITE-CHAR", Lwrite_char, cl},
+	{"WRITE-STRING", Lwrite_string, cl},
+	{"WRITE-LINE", Lwrite_line, cl},
+	{"WRITE-BYTE", Lwrite_byte, cl},
+	{"WRITE-BYTES", Lwrite_bytes, si},
+	{"TERPRI", Lterpri, cl},
+	{"FRESH-LINE", Lfresh_line, cl},
+	{"FINISH-OUTPUT", Lforce_output, cl},
+	{"FORCE-OUTPUT", Lforce_output, cl},
+	{"CLEAR-OUTPUT", Lclear_output, cl},
+
+	/* profile.c */
+#ifdef PROFILE
+	{"PROFILE", siLprofile, si},
+	{"CLEAR-PROFILE", siLclear_profile, si},
+	{"DISPLAY-PROFILE", siLdisplay_profile, si},
+#endif PROFILE
+
+	/* prog.c */
+
+	{"TAGBODY", NULL, form},
+	{"PROG", NULL, form},
+	{"PROG*", NULL, form},
+	{"GO", NULL, form},
+	{"PROGV", NULL, form},
+	{"PROGN", NULL, form},
+	{"PROG1", NULL, form},
+	{"PROG2", NULL, form},
+
+	/* read.d */
+
+	{"READ", Lread, cl},
+	{"READ-PRESERVING-WHITESPACE", Lread_preserving_whitespace, cl},
+	{"READ-DELIMITED-LIST", Lread_delimited_list, cl},
+	{"READ-LINE", Lread_line, cl},
+	{"READ-CHAR", Lread_char, cl},
+	{"UNREAD-CHAR", Lunread_char, cl},
+	{"PEEK-CHAR", Lpeek_char, cl},
+	{"LISTEN", Llisten, cl},
+	{"READ-CHAR-NO-HANG", Lread_char_no_hang, cl},
+	{"CLEAR-INPUT", Lclear_input, cl},
+
+	{"PARSE-INTEGER", Lparse_integer, cl},
+
+	{"READ-BYTE", Lread_byte, cl},
+	{"READ-BYTES", Lread_bytes, si},
+
+	{"COPY-READTABLE", Lcopy_readtable, cl},
+	{"READTABLEP", Lreadtablep, cl},
+	{"SET-SYNTAX-FROM-CHAR", Lset_syntax_from_char, cl},
+	{"SET-MACRO-CHARACTER", Lset_macro_character, cl},
+	{"GET-MACRO-CHARACTER", Lget_macro_character, cl},
+	{"MAKE-DISPATCH-MACRO-CHARACTER", Lmake_dispatch_macro_character, cl},
+	{"SET-DISPATCH-MACRO-CHARACTER", Lset_dispatch_macro_character, cl},
+	{"GET-DISPATCH-MACRO-CHARACTER", Lget_dispatch_macro_character, cl},
+	{"SHARP-COMMA-READER-FOR-COMPILER", siLsharp_comma_reader_for_compiler, si},
+	{"STRING-TO-OBJECT", siLstring_to_object, si},
+	{"STANDARD-READTABLE", siLstandard_readtable, si},
+
+	/* reference.c */
+
+	{"SYMBOL-FUNCTION", Lsymbol_function, cl},
+	{"FBOUNDP", Lfboundp, cl},
+	{"QUOTE", NULL, form},
+	{"SYMBOL-VALUE", Lsymbol_value, cl},
+	{"BOUNDP", Lboundp, cl},
+	{"MACRO-FUNCTION", Lmacro_function, cl},
+	{"SPECIAL-FORM-P", Lspecial_form_p, cl},
+	{"COERCE-TO-FUNCTION", siLcoerce_to_function, si},
+	{"FUNCTION", NULL, form},
+	{"PROCESS-DECLARATIONS", siLprocess_declarations, si},
+	{"PROCESS-LAMBDA-LIST", siLprocess_lambda_list, si},
+
+	/* sequence.d */
+
+	{"ELT", Lelt, cl},
+	{"ELT-SET", siLelt_set, si},
+	{"SUBSEQ", Lsubseq, cl},
+	{"COPY-SEQ", Lcopy_seq, cl},
+	{"LENGTH", Llength, cl},
+	{"REVERSE", Lreverse, cl},
+	{"NREVERSE", Lnreverse, cl},
+
+	/* stacks.c */
+
+	{"IHS-TOP", siLihs_top, si},
+	{"IHS-FUN", siLihs_fun, si},
+	{"IHS-ENV", siLihs_env, si},
+	{"FRS-TOP", siLfrs_top, si},
+	{"FRS-BDS", siLfrs_bds, si},
+	{"FRS-CLASS", siLfrs_class, si},
+	{"FRS-TAG", siLfrs_tag, si},
+	{"FRS-IHS", siLfrs_ihs, si},
+	{"BDS-TOP", siLbds_top, si},
+	{"BDS-VAR", siLbds_var, si},
+	{"BDS-VAL", siLbds_val, si},
+	{"SCH-FRS-BASE", siLsch_frs_base, si},
+	{"RESET-STACK-LIMITS", siLreset_stack_limits, si},
+
+	/* string.d */
+
+	{"CHAR", Lchar, cl},
+	{"CHAR-SET", siLchar_set, si},
+	{"SCHAR", Lchar, cl},
+	{"SCHAR-SET", siLchar_set, si},
+	{"STRING=", Lstring_eq, cl},
+	{"STRING-EQUAL", Lstring_equal, cl},
+	{"STRING<", Lstring_l, cl},
+	{"STRING>", Lstring_g, cl},
+	{"STRING<=", Lstring_le, cl},
+	{"STRING>=", Lstring_ge, cl},
+	{"STRING/=", Lstring_neq, cl},
+	{"STRING-LESSP", Lstring_lessp, cl},
+	{"STRING-GREATERP", Lstring_greaterp, cl},
+	{"STRING-NOT-LESSP", Lstring_not_lessp, cl},
+	{"STRING-NOT-GREATERP", Lstring_not_greaterp, cl},
+	{"STRING-NOT-EQUAL", Lstring_not_equal, cl},
+	{"MAKE-STRING", Lmake_string, cl},
+	{"STRING-TRIM", Lstring_trim, cl},
+	{"STRING-LEFT-TRIM", Lstring_left_trim, cl},
+	{"STRING-RIGHT-TRIM", Lstring_right_trim, cl},
+	{"STRING-UPCASE", Lstring_upcase, cl},
+	{"STRING-DOWNCASE", Lstring_downcase, cl},
+	{"STRING-CAPITALIZE", Lstring_capitalize, cl},
+	{"NSTRING-UPCASE", Lnstring_upcase, cl},
+	{"NSTRING-DOWNCASE", Lnstring_downcase, cl},
+	{"NSTRING-CAPITALIZE", Lnstring_capitalize, cl},
+	{"STRING", Lstring, cl},
+	{"STRING-CONCATENATE", siLstring_concatenate, si},
+
+	/* structure.c */
+
+	{"MAKE-STRUCTURE", siLmake_structure, si},
+	{"COPY-STRUCTURE", siLcopy_structure, si},
+	{"STRUCTURE-NAME", siLstructure_name, si},
+	{"STRUCTURE-REF", siLstructure_ref, si},
+	{"STRUCTURE-SET", siLstructure_set, si},
+	{"STRUCTUREP", siLstructurep, si},
+	{"STRUCTURE-SUBTYPE-P", siLstructure_subtype_p, si},
+	{"RPLACA-NTHCDR", siLrplaca_nthcdr, si},
+	{"LIST-NTH", siLlist_nth, si},
+
+	/* symbol.d */
+
+	{"GET", Lget, cl},
+	{"REMPROP", Lremprop, cl},
+	{"SYMBOL-PLIST", Lsymbol_plist, cl},
+	{"GETF", Lgetf, cl},
+	{"GET-PROPERTIES", Lget_properties, cl},
+	{"SYMBOL-NAME", Lsymbol_name, cl},
+	{"MAKE-SYMBOL", Lmake_symbol, cl},
+	{"COPY-SYMBOL", Lcopy_symbol, cl},
+	{"GENSYM", Lgensym, cl},
+	{"GENTEMP", Lgentemp, cl},
+	{"SYMBOL-PACKAGE", Lsymbol_package, cl},
+	{"KEYWORDP", Lkeywordp, cl},
+	{"PUT-F", siLput_f, si},
+	{"REM-F", siLrem_f, si},
+	{"SET-SYMBOL-PLIST", siLset_symbol_plist, si},
+	{"PUTPROP", siLputprop, si},
+	{"PUT-PROPERTIES", siLput_properties, si},
+
+	/* tcp.c */
+#ifdef TCP
+	{"OPEN-CLIENT-STREAM", Lopen_client_stream, si},
+	{"OPEN-SERVER-STREAM", Lopen_server_stream, si},
+#endif
+
+	/* time.c */
+
+	{"GET-UNIVERSAL-TIME", Lget_universal_time, cl},
+	{"SLEEP", Lsleep, cl},
+	{"GET-INTERNAL-RUN-TIME", Lget_internal_run_time, cl},
+	{"GET-INTERNAL-REAL-TIME", Lget_internal_real_time, cl},
+	{"GET-LOCAL-TIME-ZONE", Lget_local_time_zone, si},
+	{"DAYLIGHT-SAVING-TIME-P", Ldaylight_saving_timep, si},
+
+	/* toplevel.c */
+
+	{"LAMBDA", NULL, form},
+	{"NAMED-LAMBDA", NULL, form},
+	{"*MAKE-SPECIAL", siLAmake_special, si},
+	{"*MAKE-CONSTANT", siLAmake_constant, si},
+	{"EVAL-WHEN", NULL, form},
+	{"THE", NULL, form},
+	{"DECLARE", NULL, form},
+	{"LOCALLY", NULL, form},
+
+	/* typespec.c */
+
+	{"TYPE-OF", Ltype_of, cl},
+
+	/* unify.d */
+#ifdef LOCATIVE
+	{"TRAIL-MARK", Ltrail_mark, si},
+	{"TRAIL-UNMARK", Ltrail_unmark, si},
+	{"TRAIL-RESTORE", Ltrail_restore, si},
+	{"GET-VARIABLE", NULL, form},
+	{"GET-VALUE", Lget_value, si},
+	{"GET-CONSTANT", Lget_constant, si},
+	{"GET-NIL", Lget_nil, si},
+	{"GET-CONS", Lget_cons, si},
+	{"GET-INSTANCE", Lget_instance, si}, /* Mauro */
+	{"UNIFY-SLOT", Lunify_slot, si},
+	{"UNIFY-VALUE", Lunify_value, si},
+	{"UNIFY-CONSTANT", Lunify_constant, si},
+	{"UNIFY-NIL", Lunify_nil, si},
+	{"MAKE-LOCATIVE", Lmake_locative, si},
+	{"LOCATIVEP", Llocativep, si},
+	{"UNBOUNDP", Lunboundp, si},
+	{"MAKE-VARIABLE", Lmake_variable, si},
+	{"DEREFERENCE", Ldereference, si},
+#endif LOCATIVE
+
+	/* unixint.c */
+
+#ifdef unix
+	{"CATCH-BAD-SIGNALS", siLcatch_bad_signals, si},
+	{"UNCATCH-BAD-SIGNALS", siLuncatch_bad_signals, si},
+#endif unix
+
+	/* unixfsys.c */
+
+	{"TRUENAME", Ltruename, cl},
+	{"RENAME-FILE", Lrename_file, cl},
+	{"DELETE-FILE", Ldelete_file, cl},
+	{"PROBE-FILE", Lprobe_file, cl},
+	{"FILE-WRITE-DATE", Lfile_write_date, cl},
+	{"FILE-AUTHOR", Lfile_author, cl},
+	{"USER-HOMEDIR-PATHNAME", Luser_homedir_pathname, cl},
+	{"STRING-MATCH", siLstring_match, si},
+	{"DIRECTORY", Ldirectory, cl},
+	{"CHDIR", siLchdir, si},
+
+	/* unixsys.c */
+
+	{"SYSTEM", siLsystem, si},
+	{"OPEN-PIPE", siLopen_pipe, si},
+
+	/* end of list */
+	{NULL, NULL, 0}
+};
+
+
+void
+init_all_functions(void) {
+  const struct function_info *f = all_functions;
+
+  for (f = all_functions; f->name != NULL; f++) {
+    switch (f->type) {
+    case cl:
+      make_function(f->name, f->f);
+      break;
+    case si:
+      make_si_function(f->name, f->f);
+      break;
+    case form: {
+      cl_object s = make_ordinary(f->name);
+      s->symbol.isform = TRUE;
+      s->symbol.mflag = FALSE;
+    }
+    }
+  }
+}
diff --git a/src/c/all_keywords.d b/src/c/all_keywords.d
new file mode 100644
index 000000000..0b372df5b
--- /dev/null
+++ b/src/c/all_keywords.d
@@ -0,0 +1,141 @@
+/*
+    all_keywords.d -- All named keywords.
+*/
+/*
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include "page.h"
+
+const struct keyword_info all_keywords[] = {
+/* bind.c */
+{&Kallow_other_keys, "ALLOW-OTHER-KEYS"},
+
+/* error.c */
+{&Kpathname, "PATHNAME"},
+{&Kdatum, "DATUM"},
+{&Kexpected_type, "EXPECTED-TYPE"},
+{&Kformat_control, "FORMAT-CONTROL"},
+{&Kformat_arguments, "FORMAT-ARGUMENTS"},
+
+/* file.c */
+{&Kerror, "ERROR"},
+{&Kabort, "ABORT"},
+{&Kdirection, "DIRECTION"},
+{&Kinput, "INPUT"},
+{&Koutput, "OUTPUT"},
+{&Kio, "IO"},
+{&Kprobe, "PROBE"},
+{&Kelement_type, "ELEMENT-TYPE"},
+{&Kdefault, "DEFAULT"},
+{&Kif_exists, "IF-EXISTS"},
+{&Knew_version, "NEW-VERSION"},
+{&Krename, "RENAME"},
+{&Krename_and_delete, "RENAME-AND-DELETE"},
+{&Koverwrite, "OVERWRITE"},
+{&Kappend, "APPEND"},
+{&Ksupersede, "SUPERSEDE"},
+{&Kcreate, "CREATE"},
+{&Kprint, "PRINT"},
+{&Kif_does_not_exist, "IF-DOES-NOT-EXIST"},
+{&Kset_default_pathname, "SET-DEFAULT-PATHNAME"},
+
+/* hash.c */
+{&Ksize, "SIZE"},
+{&Krehash_size, "REHASH-SIZE"},
+{&Krehash_threshold, "REHASH-THRESHOLD"},
+
+/* list.c */
+{&Ktest, "TEST"},
+{&Ktest_not, "TEST-NOT"},
+{&Kkey, "KEY"},
+{&Kinitial_element, "INITIAL-ELEMENT"},
+
+/* load.c */
+{&Kverbose, "VERBOSE"},
+
+/* package.c */
+{&Kinternal, "INTERNAL"},
+{&Kexternal, "EXTERNAL"},
+{&Kinherited, "INHERITED"},
+{&Knicknames, "NICKNAMES"},
+{&Kuse, "USE"},
+
+/* pathname.c */
+{&Kwild, "WILD"},
+{&Kwild_inferiors, "WILD-INFERIORS"},
+{&Knewest, "NEWEST"},
+{&Khost, "HOST"},
+{&Kdevice, "DEVICE"},
+{&Kdirectory, "DIRECTORY"},
+{&Kname, "NAME"},
+{&Ktype, "TYPE"},
+{&Kversion, "VERSION"},
+{&Kdefaults, "DEFAULTS"},
+{&Kabsolute, "ABSOLUTE"},
+{&Krelative, "RELATIVE"},
+{&Kup, "UP"},
+
+/* print.c */
+{&Kupcase, "UPCASE"},
+{&Kdowncase, "DOWNCASE"},
+{&Kcapitalize, "CAPITALIZE"},
+{&Kstream, "STREAM"},
+{&Kescape, "ESCAPE"},
+{&Kpretty, "PRETTY"},
+{&Kcircle, "CIRCLE"},
+{&Kbase, "BASE"},
+{&Kradix, "RADIX"},
+{&Kcase, "CASE"},
+{&Kgensym, "GENSYM"},
+{&Klevel, "LEVEL"},
+{&Klength, "LENGTH"},
+{&Karray, "ARRAY"},
+
+/* read.c */
+{&Kjunk_allowed, "JUNK-ALLOWED"},
+
+/* stacks.d */
+{&Kcatch, "CATCH"},
+{&Kcatchall, "CATCHALL"},
+{&Kprotect, "PROTECT"},
+
+/* string.c */
+{&Kstart1, "START1"},
+{&Kend1, "END1"},
+{&Kstart2, "START2"},
+{&Kend2, "END2"},
+{&Kstart, "START"},
+{&Kend, "END"},
+
+/* toplevel */
+{&Kexecute, "EXECUTE"},
+{&Kcompile_toplevel, "COMPILE-TOPLEVEL"},
+{&Kload_toplevel, "LOAD-TOPLEVEL"},
+
+/* unixfsys.c */
+{&Klist_all, "LIST-ALL"},
+
+/* END */
+{NULL, (const char*)NULL}};
+
+void
+init_all_keywords(void)
+{
+  const struct keyword_info *k = all_keywords;
+  cl_object *keyword_loc;
+
+  while (k->name != NULL) {
+    keyword_loc = k->loc;
+    *keyword_loc = make_keyword(k->name);
+    k++;
+  }
+}
diff --git a/src/c/all_symbols.d b/src/c/all_symbols.d
new file mode 100644
index 000000000..a3ba30ddf
--- /dev/null
+++ b/src/c/all_symbols.d
@@ -0,0 +1,343 @@
+#include "ecls.h"
+#include "page.h"
+
+const struct symbol_info all_symbols[] = {
+/* assignment.c */
+{&Ssetf, "SETF", CL_ORDINARY},
+{&Spsetf, "PSETF", CL_ORDINARY},
+{&siSsetf_symbol, "SETF-SYMBOL", SI_ORDINARY},
+{&siSclear_compiler_properties, "CLEAR-COMPILER-PROPERTIES", SI_ORDINARY},
+#ifdef PDE
+{&siVrecord_source_pathname_p, "*RECORD-SOURCE-PATHNAME-P*", SI_SPECIAL},
+{&siSrecord_source_pathname, "RECORD-SOURCE-PATHNAME", SI_ORDINARY},
+#endif
+
+/* backq.c */
+{&siScomma, ",", SI_ORDINARY},
+{&siScomma_at, ",@@", SI_ORDINARY},
+{&siScomma_dot, ",.", SI_ORDINARY},
+{&SlistX, "LIST*", CL_ORDINARY},
+{&Sappend, "APPEND", CL_ORDINARY},
+{&Snconc, "NCONC", CL_ORDINARY},
+
+/* bind.c */
+{&SAoptional, "&OPTIONAL", CL_ORDINARY},
+{&SArest, "&REST", CL_ORDINARY},
+{&SAkey, "&KEY", CL_ORDINARY},
+{&SAallow_other_keys, "&ALLOW-OTHER-KEYS", CL_ORDINARY},
+{&SAaux, "&AUX", CL_ORDINARY},
+
+/* block.c */
+{&Sblock, "BLOCK", CL_ORDINARY},
+
+/* clos.c */
+#ifdef CLOS
+{&siSXclass_name_hash_tableX, "*CLASS-NAME-HASH-TABLE*", SI_SPECIAL},
+{&Sclass, "CLASS", CL_ORDINARY},
+{&Sbuilt_in, "BUILT-IN", CL_ORDINARY},
+#endif
+
+/* compiler.c */
+{&siSlambda_block, "LAMBDA-BLOCK", CL_ORDINARY},
+
+/* conditional.c */
+{&Sotherwise, "OTHERWISE", CL_ORDINARY},
+
+/* error.c */
+{&Sarithmetic_error, "ARITHMETIC-ERROR", CL_ORDINARY},
+{&Scell_error, "CELL-ERROR", CL_ORDINARY},
+{&Scondition, "CONDITION", CL_ORDINARY},
+{&Sdivision_by_zero, "DIVISION-BY-ZERO", CL_ORDINARY},
+{&Send_of_file, "END-OF-FILE", CL_ORDINARY},
+{&Serror, "ERROR", CL_ORDINARY},
+{&Sfile_error, "FILE-ERROR", CL_ORDINARY},
+{&Sfloating_point_inexact, "FLOATING-POINT-INEXACT", CL_ORDINARY},
+{&Sfloating_point_invalid_operation, "FLOATING-POINT-INVALID-OPERATION", CL_ORDINARY},
+{&Sfloating_point_overflow, "FLOATING-POINT-OVERFLOW", CL_ORDINARY},
+{&Sfloating_point_underflow, "FLOATING-POINT-UNDERFLOW", CL_ORDINARY},
+{&Spackage_error, "PACKAGE-ERROR", CL_ORDINARY},
+{&Sparse_error, "PARSE-ERROR", CL_ORDINARY},
+{&Sprint_not_readable, "PRINT-NOT-READABLE", CL_ORDINARY},
+{&Sprogram_error, "PROGRAM-ERROR", CL_ORDINARY},
+{&Sreader_error, "READER-ERROR", CL_ORDINARY},
+{&Sserious_condition, "SERIOUS-CONDITION", CL_ORDINARY},
+{&Ssimple_condition, "SIMPLE-CONDITION", CL_ORDINARY},
+{&Ssimple_error, "SIMPLE-ERROR", CL_ORDINARY},
+{&Ssimple_type_error, "SIMPLE-TYPE-ERROR", CL_ORDINARY},
+{&Ssimple_warning, "SIMPLE-WARNING", CL_ORDINARY},
+{&Sstorage_condition, "STORAGE-CONDITION", CL_ORDINARY},
+{&Sstream_error, "STREAM-ERROR", CL_ORDINARY},
+{&Sstyle_warning, "STYLE-WARNING", CL_ORDINARY},
+{&Stype_error, "TYPE-ERROR", CL_ORDINARY},
+{&Sunbound_slot, "UNBOUND-SLOT", CL_ORDINARY},
+{&Sunbound_variable, "UNBOUND-VARIABLE", CL_ORDINARY},
+{&Sundefined_function, "UNDEFINED-FUNCTION", CL_ORDINARY},
+{&Swarning, "WARNING", CL_ORDINARY},
+
+{&siSsimple_program_error, "SIMPLE-PROGRAM-ERROR", SI_ORDINARY},
+{&siSsimple_control_error, "SIMPLE-CONTROL-ERROR", SI_ORDINARY},
+
+{&siSuniversal_error_handler, "UNIVERSAL-ERROR-HANDLER", SI_ORDINARY},
+{&siSterminal_interrupt, "TERMINAL-INTERRUPT", SI_ORDINARY},
+
+/* eval.c */
+{&Sapply, "APPLY", CL_ORDINARY},
+{&Sfuncall, "FUNCALL", CL_ORDINARY},
+{&Vevalhook, "*EVALHOOK*", CL_SPECIAL},
+{&Vapplyhook, "*APPLYHOOK*", CL_SPECIAL},
+
+/* file.c */
+{&Vstandard_input, "*STANDARD-INPUT*", CL_SPECIAL},
+{&Vstandard_output, "*STANDARD-OUTPUT*", CL_SPECIAL},
+{&Verror_output, "*ERROR-OUTPUT*", CL_SPECIAL},
+{&Vquery_io, "*QUERY-IO*", CL_SPECIAL},
+{&Vdebug_io, "*DEBUG-IO*", CL_SPECIAL},
+{&Vterminal_io, "*TERMINAL-IO*", CL_SPECIAL},
+{&Vtrace_output, "*TRACE-OUTPUT*", CL_SPECIAL},
+{&siVignore_eof_on_terminal_io, "*IGNORE-EOF-ON-TERMINAL-IO*", SI_SPECIAL},
+
+/* format.c */
+{&siVindent_formatted_output, "*INDENT-FORMATTED-OUTPUT*", SI_SPECIAL},
+
+/* gbc.c */
+#if 0 && !defined(GBC_BOEHM)
+{&siVgc_verbose, "*GC-VERBOSE*", SI_SPECIAL},
+{&siVgc_message, "*GC-MESSAGE*", SI_SPECIAL},
+#endif /* !GBC_BOEHM */
+
+/* gfun.c */
+{&siScompute_applicable_methods, "COMPUTE-APPLICABLE-METHODS", SI_ORDINARY},
+{&siScompute_effective_method, "COMPUTE-EFFECTIVE-METHOD", SI_ORDINARY},
+{&siSgeneric_function_method_combination, "GENERIC-FUNCTION-METHOD-COMBINATION", SI_ORDINARY},
+{&siSgeneric_function_method_combination_args, "GENERIC-FUNCTION-METHOD-COMBINATION-ARGS", SI_ORDINARY},
+
+/* hash.c */
+{&Seq, "EQ", CL_ORDINARY},
+{&Seql, "EQL", CL_ORDINARY},
+{&Sequal, "EQUAL", CL_ORDINARY},
+
+/* instance.c */
+{&Sprint_object, "PRINT-OBJECT", CL_ORDINARY},
+
+/* lex.c */
+{&Smacro, "MACRO", CL_ORDINARY},
+{&siSsymbol_macro, "SYMBOL-MACRO", SI_ORDINARY},
+{&Stag, "TAG", CL_ORDINARY},
+
+/* load.c */
+{&Vload_verbose, "*LOAD-VERBOSE*", CL_SPECIAL},
+{&Vload_print, "*LOAD-PRINT*", CL_SPECIAL},
+{&siVload_hooks, "*LOAD-HOOKS*", SI_SPECIAL},
+#ifdef PDE
+{&siVsource_pathname, "*SOURCE-PATHNAME*", CL_SPECIAL},
+#endif
+#ifdef RSYM
+{&siVsymbol_table, "*SYMBOL-TABLE*", CL_SPECIAL},
+#endif
+
+/* lwp.c */
+#ifdef THREADS
+{&Srunning, "RUNNING", CL_ORDINARY},
+{&Ssuspended, "SUSPENDED", CL_ORDINARY},
+{&Swaiting, "WAITING", CL_ORDINARY},
+{&Sstopped, "STOPPED", CL_ORDINARY},
+{&Sdead, "DEAD", CL_ORDINARY},
+{&siSthread_top_level, "THREAD-TOP-LEVEL", SI_ORDINARY},
+#endif
+
+/* macros.c */
+{&Vmacroexpand_hook, "*MACROEXPAND-HOOK*", CL_SPECIAL},
+{&siSexpand_defmacro, "EXPAND-DEFMACRO", SI_ORDINARY},
+{&siVinhibit_macro_special, "*INHIBIT-MACRO-SPECIAL*", SI_SPECIAL},
+
+/* main.c */
+{&siVsystem_directory, "*SYSTEM-DIRECTORY*", SI_SPECIAL},
+{&Vfeatures, "*FEATURES*", CL_SPECIAL},
+
+/* num_rand.c */
+{&Vrandom_state, "*RANDOM-STATE*", CL_SPECIAL},
+
+/* package.c */
+{&Vpackage, "*PACKAGE*", CL_SPECIAL},
+
+/* pathname.c */
+{&Vdefault_pathname_defaults, "*DEFAULT-PATHNAME-DEFAULTS*", CL_SPECIAL},
+
+/* print.c */
+{&Vprint_escape, "*PRINT-ESCAPE*", CL_SPECIAL},
+{&Vprint_pretty, "*PRINT-PRETTY*", CL_SPECIAL},
+{&Vprint_circle, "*PRINT-CIRCLE*", CL_SPECIAL},
+{&Vprint_base, "*PRINT-BASE*", CL_SPECIAL},
+{&Vprint_radix, "*PRINT-RADIX*", CL_SPECIAL},
+{&Vprint_case, "*PRINT-CASE*", CL_SPECIAL},
+{&Vprint_gensym, "*PRINT-GENSYM*", CL_SPECIAL},
+{&Vprint_level, "*PRINT-LEVEL*", CL_SPECIAL},
+{&Vprint_length, "*PRINT-LENGTH*", CL_SPECIAL},
+{&Vprint_array, "*PRINT-ARRAY*", CL_SPECIAL},
+{&siSpretty_print_format, "PRETTY-PRINT-FORMAT", SI_ORDINARY},
+{&siSsharp_exclamation, "#!", SI_ORDINARY},
+{&siVprint_package, "*PRINT-PACKAGE*", SI_SPECIAL},
+{&siVprint_structure, "*PRINT-STRUCTURE*", SI_SPECIAL},
+#ifdef CLOS
+{&Sstream_write_char, "STREAM-WRITE-CHAR", CL_ORDINARY},
+{&Sstream_write_string, "STREAM-WRITE-STRING", CL_ORDINARY},
+{&Sstream_fresh_line, "STREAM-FRESH-LINE", CL_ORDINARY},
+{&Sstream_clear_output, "STREAM-CLEAR-OUTPUT", CL_ORDINARY},
+{&Sstream_force_output, "STREAM-FORCE-OUTPUT", CL_ORDINARY},
+#endif
+
+/* profile.c */
+#ifdef PROFILE
+{&sSAprofile_arrayA, "*PROFILE-ARRAY*", SI_SPECIAL},
+#endif PROFILE
+
+/* read.c */
+{&Vreadtable, "*READTABLE*", CL_SPECIAL},
+{&Vread_default_float_format, "*READ-DEFAULT-FLOAT-FORMAT*", CL_SPECIAL},
+{&Vread_base, "*READ-BASE*", CL_SPECIAL},
+{&Vread_suppress, "*READ-SUPPRESS*", CL_SPECIAL},
+{&siSsharp_comma, "#,", SI_ORDINARY},
+#ifdef CLOS
+{&Sstream_read_line, "STREAM-READ-LINE", CL_ORDINARY},
+{&Sstream_read_char, "STREAM-READ-CHAR", CL_ORDINARY},
+{&Sstream_unread_char, "STREAM-UNREAD-CHAR", CL_ORDINARY},
+{&Sstream_peek_char, "STREAM-PEEK-CHAR", CL_ORDINARY},
+{&Sstream_listen, "STREAM-LISTEN", CL_ORDINARY},
+{&Sstream_clear_input, "STREAM-CLEAR-INPUT", CL_ORDINARY},
+#endif
+
+/* structure.c */
+{&siSstructure_print_function, "STRUCTURE-PRINT-FUNCTION", SI_ORDINARY},
+{&siSstructure_slot_descriptions, "STRUCTURE-SLOT-DESCRIPTIONS", SI_ORDINARY},
+#ifndef CLOS
+{&siSstructure_include, "STRUCTURE-INCLUDE", SI_ORDINARY},
+#else
+{&Sstructure_object, "STRUCTURE-OBJECT", CL_ORDINARY},
+#endif
+
+/* symbol.c */
+{&siSpname, "PNAME", SI_ORDINARY},
+{&Vgensym_counter, "*GENSYM-COUNTER*", CL_SPECIAL},
+
+/* toplevel.c */
+{&Sdeclare, "DECLARE", CL_ORDINARY},
+{&Scompile, "COMPILE", CL_ORDINARY},
+{&Sload, "LOAD", CL_ORDINARY},
+{&Seval, "EVAL", CL_ORDINARY},
+{&Sprogn, "PROGN", CL_ORDINARY},
+{&Swarn, "WARN", CL_ORDINARY},
+{&Stypep, "TYPEP", CL_ORDINARY},
+
+/* typespec.c */
+{&Squote, "QUOTE", CL_ORDINARY},
+{&Slambda, "LAMBDA", CL_ORDINARY},
+{&Sspecial, "SPECIAL", CL_ORDINARY},
+{&St, "T", CL_ORDINARY},
+{&Snil, "NIL", CL_ORDINARY},
+{&Scommon, "COMMON", CL_ORDINARY},
+{&Ssequence, "SEQUENCE", CL_ORDINARY},
+{&Snull, "NULL", CL_ORDINARY},
+{&Scons, "CONS", CL_ORDINARY},
+{&Slist, "LIST", CL_ORDINARY},
+{&Ssymbol, "SYMBOL", CL_ORDINARY},
+{&Sarray, "ARRAY", CL_ORDINARY},
+{&Svector, "VECTOR", CL_ORDINARY},
+{&Sbit_vector, "BIT-VECTOR", CL_ORDINARY},
+{&Sstring, "STRING", CL_ORDINARY},
+{&Ssimple_array, "SIMPLE-ARRAY", CL_ORDINARY},
+{&Ssimple_vector, "SIMPLE-VECTOR", CL_ORDINARY},
+{&Ssimple_string, "SIMPLE-STRING", CL_ORDINARY},
+{&Ssimple_bit_vector, "SIMPLE-BIT-VECTOR", CL_ORDINARY},
+{&Sfunction, "FUNCTION", CL_ORDINARY},
+{&Spathname, "PATHNAME", CL_ORDINARY},
+{&Slogical_pathname, "LOGICAL-PATHNAME", CL_ORDINARY},
+{&Scharacter, "CHARACTER", CL_ORDINARY},
+{&Sbase_char, "BASE-CHAR", CL_ORDINARY},
+{&Sextended_char, "EXTENDED-CHAR", CL_ORDINARY},
+{&Scompiled_function, "COMPILED-FUNCTION", CL_ORDINARY},
+{&Snumber, "NUMBER", CL_ORDINARY},
+{&Sreal, "REAL", CL_ORDINARY},
+{&Srational, "RATIONAL", CL_ORDINARY},
+{&Sfloat, "FLOAT", CL_ORDINARY},
+{&Sinteger, "INTEGER", CL_ORDINARY},
+{&Sratio, "RATIO", CL_ORDINARY},
+{&Sshort_float, "SHORT-FLOAT", CL_ORDINARY},
+{&Sstandard_char, "STANDARD-CHAR", CL_ORDINARY},
+{&Sfixnum, "FIXNUM", CL_ORDINARY},
+{&Scomplex, "COMPLEX", CL_ORDINARY},
+{&Ssingle_float, "SINGLE-FLOAT", CL_ORDINARY},
+{&Spackage, "PACKAGE", CL_ORDINARY},
+{&Sbignum, "BIGNUM", CL_ORDINARY},
+{&Srandom_state, "RANDOM-STATE", CL_ORDINARY},
+{&Sdouble_float, "DOUBLE-FLOAT", CL_ORDINARY},
+{&Sstream, "STREAM", CL_ORDINARY},
+{&Sbit, "BIT", CL_ORDINARY},
+{&Sreadtable, "READTABLE", CL_ORDINARY},
+{&Slong_float, "LONG-FLOAT", CL_ORDINARY},
+{&Shash_table, "HASH-TABLE", CL_ORDINARY},
+{&Ssigned_char, "SIGNED-CHAR", CL_ORDINARY},
+{&Sunsigned_char, "UNSIGNED-CHAR", CL_ORDINARY},
+{&Ssigned_short, "SIGNED-SHORT", CL_ORDINARY},
+{&Sunsigned_short, "UNSIGNED-SHORT", CL_ORDINARY},
+#ifdef CLOS
+{&Sinstance, "INSTANCE", CL_ORDINARY},
+{&Sdispatch_function, "DISPATCH-FUNCTION", CL_ORDINARY},
+{&Sstructure, "STRUCTURE", CL_ORDINARY},
+#endif
+{&Ssatisfies, "SATISFIES", CL_ORDINARY},
+{&Smember, "MEMBER", CL_ORDINARY},
+{&Snot, "NOT", CL_ORDINARY},
+{&Sor, "OR", CL_ORDINARY},
+{&Sand, "AND", CL_ORDINARY},
+{&Svalues, "VALUES", CL_ORDINARY},
+{&Smod, "MOD", CL_ORDINARY},
+{&Ssigned_byte, "SIGNED-BYTE", CL_ORDINARY},
+{&Sunsigned_byte, "UNSIGNED-BYTE", CL_ORDINARY},
+{&SX, "*", CL_ORDINARY},
+{&Splusp, "PLUSP", CL_ORDINARY},
+{&Skeyword, "KEYWORD", CL_ORDINARY},
+#ifdef THREADS
+{&Scont, "CONT", CL_ORDINARY},
+{&Sthread, "THREAD", CL_ORDINARY},
+#endif
+#ifdef LOCATIVE
+{&Slocative, "LOCATIVE", CL_ORDINARY},
+#endif
+{&Ssubtypep, "SUBTYPEP", CL_ORDINARY},
+
+/* unify.c */
+#ifdef LOCATIVE
+{&Ssetq, "SETQ", CL_ORDINARY},
+{&Sunify_slot, "UNIFY-SLOT", CL_ORDINARY},
+#endif
+
+{NULL, (const char*)NULL, CL_ORDINARY}};
+
+void
+init_all_symbols(void) {
+  const struct symbol_info *s = all_symbols;
+  cl_object *loc;
+
+  /* This must keep the garbage collector happy */
+  for (s = all_symbols; s->name != NULL; s++)
+    *(s->loc) = OBJNULL;
+
+  for (s = all_symbols; s->name != NULL; s++) {
+    loc = s->loc;
+    switch (s->type) {
+    case CL_ORDINARY:
+      *loc = make_ordinary(s->name);
+      break;
+    case CL_SPECIAL:
+      *loc = make_special(s->name, Cnil);
+      break;
+    case SI_ORDINARY:
+      *loc = make_si_ordinary(s->name);
+      break;
+    case SI_SPECIAL:
+      *loc = make_si_special(s->name, Cnil);
+      break;
+    }
+    /*    register_root(loc);*/
+  }
+}
diff --git a/src/c/alloc.d b/src/c/alloc.d
new file mode 100644
index 000000000..dff8f61bb
--- /dev/null
+++ b/src/c/alloc.d
@@ -0,0 +1,900 @@
+
+/*
+    alloc.c --	Memory allocation.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+/*
+  			Heap and Relocatable Area
+
+	                 heap_end    data_end
+    +------+--------------------+ - - - + - - --------+
+    | text |        heap        | hole  |      stack  |
+    +------+--------------------+ - - - + - - --------+
+
+   The type_map array covers all pages of memory: those not used for objects
+   are marked as type t_other.
+
+   The tm_table array holds a struct typemanager for each type, which contains
+   the first element of the free list for the type, and other bookkeeping
+   information.
+*/
+
+#include "ecls.h"
+#include "page.h"
+#ifdef BSD
+#include <sys/resource.h>
+#endif BSD
+#ifdef SYSV
+#include <ulimit.h>
+#endif SYSV
+
+/******************************* EXPORTS ******************************/
+
+size_t real_maxpage;
+size_t new_holepage;
+char type_map[MAXPAGE];
+struct typemanager tm_table[(int)t_end];
+struct contblock *cb_pointer = NULL;
+
+size_t ncb;			/*  number of contblocks  */
+size_t ncbpage;			/*  number of contblock pages  */
+size_t maxcbpage;		/*  maximum number of contblock pages  */
+size_t cbgccount;		/*  contblock gc count  */
+size_t holepage;		/*  hole pages  */
+
+char *heap_end;			/*  heap end  */
+char *heap_start;		/*  heap start  */
+char *data_end;			/*  end of data space  */
+
+/******************************* ------- ******************************/
+
+#define SIGINTENTRY 6
+
+static bool ignore_maximum_pages = TRUE;
+
+#ifdef unix
+# ifdef __MACH__
+# define  sbrk my_sbrk
+# endif
+extern void *sbrk(int);
+#endif unix
+
+#ifdef NEED_MALLOC
+static cl_object malloc_list;
+#endif
+
+/*
+   Allocates n pages starting at heap end, without worring about the
+   hole.  Basically just get the space from the Operating System.
+*/
+
+void
+resize_hole(size_t n)
+{
+	char *e;
+	size_t m;
+	m = (data_end - heap_end)/LISP_PAGESIZE;
+	if (n <= m)
+	  return;
+
+	/* Create the hole */
+#ifdef unix
+	e = sbrk(0);
+	if (data_end == e)
+	  n -= m;
+	else {
+ 	  dealloc(heap_end, data_end - heap_end);
+	  /* FIXME! Horrible hack! */
+	  /* mark as t_other pages not allocated by us */
+	  heap_end = e;
+	  while (data_end < heap_end) {
+	    type_map[page(data_end)] = t_other;
+	    data_end += LISP_PAGESIZE;
+	  }
+	  holepage = 0;
+	}
+	if ((int)sbrk(LISP_PAGESIZE * n) < 0)
+	  error("Can't allocate.  Good-bye!");
+#endif unix
+	data_end += LISP_PAGESIZE*(n);
+	holepage += n;
+}
+
+/* Allocates n pages from the hole.  */
+void *
+alloc_page(size_t n)
+{
+	char *e = heap_end;
+	if (n >= holepage) {
+	  gc(t_contiguous);
+	  resize_hole(new_holepage+n);
+	}
+	holepage -= n;
+	heap_end += LISP_PAGESIZE*n;
+	return e;
+}
+
+static void
+add_page_to_freelist(char *p, struct typemanager *tm)
+{ enum type t;
+  cl_object x, f;
+  size_t i;
+  t = tm->tm_type;
+  type_map[page(p)] = t;
+  f = tm->tm_free;
+  for (i = tm->tm_nppage; i > 0; --i, p += tm->tm_size) {
+    x = (cl_object)p;
+    ((struct freelist *)x)->t = (short)t;
+    ((struct freelist *)x)->m = FREE;
+    ((struct freelist *)x)->f_link = f;
+    f = x;
+  }
+  tm->tm_free = f;
+  tm->tm_nfree += tm->tm_nppage;
+  tm->tm_npage++;
+}
+
+cl_object
+alloc_object(enum type t)
+{
+	register cl_object obj;
+	register struct typemanager *tm;
+	register char *p;
+
+	switch (t) {
+	case t_fixnum:
+	  return MAKE_FIXNUM(0); /* Immediate fixnum */
+	case t_character:
+	  return code_char(' '); /* Immediate character */
+	default:
+	}
+	
+	start_critical_section(); 
+
+ONCE_MORE:
+	tm = tm_of(t);
+
+	if (interrupt_flag) {
+		interrupt_flag = FALSE;
+#ifdef unix
+		alarm(0);
+#endif unix
+		terminal_interrupt(TRUE);
+	}
+
+	obj = tm->tm_free;
+	if (obj == OBJNULL) {
+		size_t available = available_pages();
+		if (tm->tm_npage >= tm->tm_maxpage)
+			goto CALL_GC;
+		if (available < 1) {
+			ignore_maximum_pages = FALSE;
+			goto CALL_GC;
+		}
+		p = alloc_page(1);
+		add_page_to_freelist(p, tm);
+		obj = tm->tm_free;
+		/* why this? Beppe
+		if (tm->tm_npage >= tm->tm_maxpage)
+			goto CALL_GC; */
+	}
+	tm->tm_free = ((struct freelist *)obj)->f_link;
+	--(tm->tm_nfree);
+	(tm->tm_nused)++;
+	obj->d.t = (short)t;
+	obj->d.m = FALSE;
+	/* Now initialize the object so that it can be correctly marked
+	 * by the GC
+	 */
+	switch (t) {
+	case t_bignum:
+	  obj->big.big_dim = obj->big.big_size = 0;
+	  obj->big.big_limbs = NULL;
+	  break;
+	case t_ratio:
+	  obj->ratio.num = OBJNULL;
+	  obj->ratio.den = OBJNULL;
+	  break;
+	case t_shortfloat:
+	case t_longfloat:
+	  break;
+	case t_complex:
+	  obj->complex.imag = OBJNULL;
+	  obj->complex.real = OBJNULL;
+	  break;
+	case t_symbol:
+	  obj->symbol.plist = OBJNULL;
+	  SYM_FUN(obj) = OBJNULL;
+	  SYM_VAL(obj) = OBJNULL;
+	  obj->symbol.name = OBJNULL;
+	  break;
+	case t_package:
+	  obj->pack.name = OBJNULL;
+	  obj->pack.nicknames = OBJNULL;
+	  obj->pack.shadowings = OBJNULL;
+	  obj->pack.uses = OBJNULL;
+	  obj->pack.usedby = OBJNULL;
+	  obj->pack.internal = OBJNULL;
+	  obj->pack.external = OBJNULL;
+	  break;
+	case t_cons:
+	  CAR(obj) = OBJNULL;
+	  CDR(obj) = OBJNULL;
+	  break;
+	case t_hashtable:
+	  obj->hash.rehash_size = OBJNULL;
+	  obj->hash.threshold = OBJNULL;
+	  obj->hash.data = NULL;
+	  break;
+	case t_array:
+	  obj->array.displaced = Cnil;
+	  obj->array.elttype = (short)aet_object;
+	  obj->array.self.t = NULL;
+	  break;
+	case t_vector:
+	  obj->array.displaced = Cnil;
+	  obj->array.elttype = (short)aet_object;
+	  obj->array.self.t = NULL;
+	  break;
+	case t_string:
+	  obj->string.displaced = Cnil;
+	  obj->string.self = NULL;
+	  break;
+	case t_bitvector:
+	  obj->vector.displaced = Cnil;
+	  obj->vector.self.bit = NULL;
+	  break;
+#ifndef CLOS
+	case t_structure:
+	  obj->str.name = OBJNULL;
+	  obj->str.self = NULL;
+	  break;
+#endif CLOS
+	case t_stream:
+	  obj->stream.mode = (short)smm_closed;
+	  obj->stream.file = NULL;
+	  obj->stream.object0 = OBJNULL;
+	  obj->stream.object1 = OBJNULL;
+	  obj->stream.buffer = NULL;
+	  break;
+	case t_random:
+	  break;
+	case t_readtable:
+	  obj->readtable.table = NULL;
+	  break;
+	case t_pathname:
+	  obj->pathname.host = OBJNULL;
+	  obj->pathname.device = OBJNULL;
+	  obj->pathname.directory = OBJNULL;
+	  obj->pathname.name = OBJNULL;
+	  obj->pathname.type = OBJNULL;
+	  obj->pathname.version = OBJNULL;
+	  break;
+	case t_bytecodes:
+	  obj->bytecodes.lex = Cnil;
+	  obj->bytecodes.size = 0;
+	  obj->bytecodes.data = NULL;
+	  break;
+	case t_cfun:
+	  obj->cfun.name = OBJNULL;
+	  obj->cfun.block = NULL;
+	  break;
+	case t_cclosure:
+	  obj->cclosure.env = OBJNULL;
+	  obj->cclosure.block = NULL;
+	  break;
+/*
+	case t_spice:
+	  break;
+*/
+#ifdef THREADS
+	case t_cont:
+	  obj->cn.cn_thread = OBJNULL;
+	  break;
+	case t_thread:
+	  obj->thread.entry = OBJNULL;
+	  break;
+#endif
+#ifdef CLOS
+	case t_instance:
+	  obj->instance.class = OBJNULL;
+	  obj->instance.slots = NULL;
+	  break;
+	case t_gfun:
+	  obj->gfun.name = OBJNULL;
+	  obj->gfun.method_hash = OBJNULL;
+	  obj->gfun.instance = OBJNULL;
+	  obj->gfun.specializers = NULL;
+	  break;
+#endif CLOS
+	case t_codeblock:
+	  obj->cblock.name = Cnil;
+	  obj->cblock.start = NULL;
+	  obj->cblock.size = 0;
+	  obj->cblock.data = NULL;
+	  obj->cblock.data_size = 0;
+	  obj->cblock.data_text = NULL;
+	  obj->cblock.data_text_size = 0;
+	  break;
+	default:
+	  printf("\ttype = %d\n", t);
+	  error("alloc botch.");
+	}
+#ifdef THREADS
+	clwp->lwp_alloc_temporary = obj;
+#endif THREADS
+	end_critical_section();
+	return(obj);
+
+CALL_GC:
+	gc(tm->tm_type);
+	if (tm->tm_nfree != 0 &&
+		(float)tm->tm_nfree * 10.0 >= (float)tm->tm_nused)
+		goto ONCE_MORE;
+
+/*	EXHAUSTED:	*/
+	if (ignore_maximum_pages) {
+		if (tm->tm_maxpage/2 <= 0)
+			tm->tm_maxpage += 1;
+		else
+			tm->tm_maxpage += tm->tm_maxpage/2;
+		goto ONCE_MORE;
+	}
+	GC_disable();
+	{ cl_object s = make_simple_string(tm_table[(int)t].tm_name+1);
+	GC_enable();
+	CEerror("The storage for ~A is exhausted.~%\
+Currently, ~D pages are allocated.~%\
+Use ALLOCATE to expand the space.",
+		2, s, MAKE_FIXNUM(tm->tm_npage));
+	}
+	goto ONCE_MORE;
+}
+
+cl_object
+make_cons(cl_object a, cl_object d)
+{
+	register cl_object obj;
+	register char *p;
+	struct typemanager *tm=(&tm_table[(int)t_cons]);
+
+	start_critical_section(); 
+
+ONCE_MORE:
+	if (interrupt_flag) {
+		interrupt_flag = FALSE;
+#ifdef unix
+		alarm(0);
+#endif unix
+		terminal_interrupt(TRUE);
+	}
+	obj = tm->tm_free;
+	if (obj == OBJNULL) {
+		if (tm->tm_npage >= tm->tm_maxpage)
+			goto CALL_GC;
+		if (available_pages() < 1) {
+			ignore_maximum_pages = FALSE;
+			goto CALL_GC;
+		}
+		p = alloc_page(1);
+		add_page_to_freelist(p,tm);
+		obj = tm->tm_free;
+		if (tm->tm_npage >= tm->tm_maxpage)
+			goto CALL_GC;
+	}
+	tm->tm_free = ((struct freelist *)obj)->f_link;
+	--(tm->tm_nfree);
+	(tm->tm_nused)++;
+	obj->d.t = (short)t_cons;
+	obj->d.m = FALSE;
+	CAR(obj) = a;
+	CDR(obj) = d;
+
+	end_critical_section();
+	return(obj);
+
+CALL_GC:
+	gc(t_cons);
+	if ((tm->tm_nfree != 0) && (tm->tm_nfree * 10.0 >= tm->tm_nused))
+		goto ONCE_MORE;
+
+/*	EXHAUSTED:	*/
+	if (ignore_maximum_pages) {
+		if (tm->tm_maxpage/2 <= 0)
+			tm->tm_maxpage += 1;
+		else
+			tm->tm_maxpage += tm->tm_maxpage/2;
+		goto ONCE_MORE;
+	}
+	CEerror("The storage for CONS is exhausted.~%\
+Currently, ~D pages are allocated.~%\
+Use ALLOCATE to expand the space.",
+		1, MAKE_FIXNUM(tm->tm_npage));
+	goto ONCE_MORE;
+#undef	tm
+}
+
+cl_object
+alloc_instance(cl_index slots)
+{
+	cl_object i = alloc_object(t_instance);
+	/* INV: slots > 0 */
+	i->instance.slots = alloc(sizeof(cl_object) * slots);
+	i->instance.length = slots;
+	return i;
+}
+
+void *
+alloc(size_t n)
+{
+	register char *p;
+	register struct contblock **cbpp;
+	register size_t i;
+	register size_t m;
+	register bool g;
+	bool gg;
+
+	g = FALSE;
+	n = round_up(n);
+
+	start_critical_section(); 
+
+ONCE_MORE:
+	if (interrupt_flag) {
+		interrupt_flag = FALSE;
+		gg = g;
+		terminal_interrupt(TRUE);
+		g = gg;
+	}
+
+	/* Use extra indirection so that cb_pointer can be updated */
+	for (cbpp = &cb_pointer; (*cbpp) != NULL; cbpp = &(*cbpp)->cb_link) 
+		if ((*cbpp)->cb_size >= n) {
+			p = (char *)(*cbpp);
+			i = (*cbpp)->cb_size - n;
+			*cbpp = (*cbpp)->cb_link;
+			--ncb;
+			dealloc(p+n, i);
+
+			end_critical_section();
+			return(p);
+		}
+	m = round_to_page(n);
+	if (ncbpage + m > maxcbpage || available_pages() < m) {
+		if (available_pages() < m)
+			ignore_maximum_pages = FALSE;
+		if (!g) {
+			gc(t_contiguous);
+			g = TRUE;
+			goto ONCE_MORE;
+		}
+		if (ignore_maximum_pages) {
+			if (maxcbpage/2 <= 0)
+				maxcbpage += 1;
+			else
+				maxcbpage += maxcbpage/2;
+			g = FALSE;
+			goto ONCE_MORE;
+		}
+		CEerror("Contiguous blocks exhausted.~%\
+Currently, ~D pages are allocated.~%\
+Use ALLOCATE-CONTIGUOUS-PAGES to expand the space.",
+			1, MAKE_FIXNUM(ncbpage));
+		g = FALSE;
+		goto ONCE_MORE;
+	}
+	p = alloc_page(m);
+
+	for (i = 0;  i < m;  i++)
+		type_map[page(p) + i] = (char)t_contiguous;
+	ncbpage += m;
+	dealloc(p+n, LISP_PAGESIZE*m - n);
+
+	end_critical_section();
+	return(p);
+}
+
+/*
+ * adds a contblock to the list of available ones, pointed by cb_pointer,
+ * sorted by increasing size.
+ */
+void
+dealloc(void *p, size_t s)
+{
+	struct contblock **cbpp, *cbp;
+
+	if (s < CBMINSIZE)
+		return;
+	ncb++;
+	cbp = (struct contblock *)p;
+	cbp->cb_size = s;
+	for (cbpp = &cb_pointer; *cbpp != NULL; cbpp = &((*cbpp)->cb_link))
+		if ((*cbpp)->cb_size >= s) {
+			cbp->cb_link = *cbpp;
+			*cbpp = cbp;
+			return;
+		}
+	cbp->cb_link = NULL;
+	*cbpp = cbp;
+}
+
+/*
+ * align must be a power of 2 representing the alignment boundary
+ * required for the block.
+ */
+void *
+alloc_align(size_t size, size_t align)
+{
+	void *output;
+	start_critical_section();
+	align--;
+	output = (void*)(((cl_fixnum)alloc(size + align) + align - 1) & ~align)
+	end_critical_section();
+	return output;
+}
+
+static void
+init_tm(enum type t, char *name, size_t elsize, size_t maxpage)
+{
+	int i, j;
+	struct typemanager *tm = &tm_table[(int)t];
+
+	tm->tm_name = name;
+	for (i = (int)t_start, j = i-1;  i < (int)t_end;  i++)
+	  if (tm_table[i].tm_size >= elsize &&
+	      (j < (int)t_start || tm_table[j].tm_size > tm_table[i].tm_size))
+	    j = i;
+	if (j >= (int)t_start) {
+		tm->tm_type = (enum type)j;
+		tm_table[j].tm_maxpage += maxpage;
+		return;
+	}
+	tm->tm_type = t;
+	tm->tm_size = round_up(elsize);
+	tm->tm_nppage = LISP_PAGESIZE/round_up(elsize);
+	tm->tm_free = OBJNULL;
+	tm->tm_nfree = 0;
+	tm->tm_nused = 0;
+	tm->tm_npage = 0;
+	tm->tm_maxpage = maxpage;
+	tm->tm_gccount = 0;
+}
+
+static int alloc_initialized = FALSE;
+
+void
+init_alloc(void)
+{
+	cl_index i;
+
+	if (alloc_initialized) return;
+	alloc_initialized = TRUE;
+
+	holepage = 0;
+	new_holepage = HOLEPAGE;
+
+#ifdef MSDOS
+	real_maxpage = MAXPAGE;
+#elif defined(BSD)
+	{
+	  struct rlimit data_rlimit;
+# ifdef __MACH__
+	  extern int mach_maplimit;
+	  sbrk(0);
+	  real_maxpage = mach_maplimit/LISP_PAGESIZE;
+	  /* alternative
+	  getrlimit(RLIMIT_DATA, &data_rlimit);
+	  real_maxpage = ((unsigned)get_etext() +
+			  (unsigned)data_rlimit.rlim_cur)/LISP_PAGESIZE;
+			  */
+# else
+	  extern etext;
+
+	  getrlimit(RLIMIT_DATA, &data_rlimit);
+	  real_maxpage = ((unsigned int)&etext +
+			  (unsigned)data_rlimit.rlim_cur)/LISP_PAGESIZE;
+# endif
+	  if (real_maxpage > MAXPAGE) real_maxpage = MAXPAGE;
+	}
+#elif defined(SYSV)
+	real_maxpage= ulimit(UL_GMEMLIM)/LISP_PAGESIZE;
+	if (real_maxpage > MAXPAGE) real_maxpage = MAXPAGE;
+#endif MSDOS
+
+#ifdef unix
+	heap_end = sbrk(0);
+	i = (int)heap_end & (LISP_PAGESIZE - 1);
+	if (i)
+	  sbrk(LISP_PAGESIZE - i);
+	heap_end = heap_start = data_end = sbrk(0);
+#else
+#error "Non unix allocation scheme not defined"
+#endif unix
+
+	resize_hole(INIT_HOLEPAGE);
+	for (i = 0;  i < MAXPAGE;  i++)
+		type_map[i] = (char)t_other;
+
+/*	Initialization must be done in increasing size order:	*/
+	init_tm(t_shortfloat, "FSHORT-FLOAT", /* 8 */
+		sizeof(struct shortfloat_struct), 1);
+	init_tm(t_cons, ".CONS", sizeof(struct cons), 384); /* 12 */
+	init_tm(t_longfloat, "LLONG-FLOAT", /* 16 */
+		sizeof(struct longfloat_struct), 1);
+	init_tm(t_bytecodes, "bBYTECODES", sizeof(struct bytecodes), 64);
+	init_tm(t_string, "\"STRING", sizeof(struct string), 64); /* 20 */
+	init_tm(t_array, "aARRAY", sizeof(struct array), 64); /* 24 */
+	init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 1); /* 28 */
+	init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 64); /* 32 */
+	init_tm(t_package, ":PACKAGE", sizeof(struct package), 1); /* 36 */
+	init_tm(t_codeblock, "#CODEBLOCK", sizeof(struct codeblock), 1);
+	init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 16);
+	init_tm(t_ratio, "RRATIO", sizeof(struct ratio), 1);
+	init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 1);
+	init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 1);
+	init_tm(t_vector, "vVECTOR", sizeof(struct vector), 2);
+	init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct vector), 1);
+	init_tm(t_stream, "sSTREAM", sizeof(struct stream), 1);
+	init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 1);
+	init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 1);
+	init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 32);
+	init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 1);
+#ifndef CLOS
+	init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 32);
+#else
+	init_tm(t_instance, "IINSTANCE", sizeof(struct instance), 32);
+	init_tm(t_gfun, "GGFUN", sizeof(struct gfun), 32);
+#endif CLOS
+#ifdef THREADS
+	init_tm(t_cont, "?CONT", sizeof(struct cont), 2);
+	init_tm(t_thread, "tTHREAD", sizeof(struct thread), 2);
+#endif THREADS
+
+	ncb = 0;
+	ncbpage = 0;
+#ifdef THREADS
+	maxcbpage = 2048;
+#else
+	maxcbpage = 512;
+#endif THREADS
+
+#ifdef NEED_MALLOC
+	malloc_list = Cnil;
+	register_root(&malloc_list);
+#endif
+}
+
+static int
+t_from_type(cl_object type)
+{  int t;
+
+   type = coerce_to_string(type);
+   for (t = (int)t_start ; t < (int)t_end ; t++) {
+     struct typemanager *tm = &tm_table[t];
+     if (tm->tm_name &&
+	 strncmp((tm->tm_name)+1, type->string.self, type->string.fillp) == 0)
+       return(t);
+   }
+   FEerror("Unrecognized type", 0);
+}
+
+@(defun si::allocate (type qty &optional (now Cnil))
+	struct typemanager *tm;
+	char *pp;
+	size_t i;
+@
+	tm = tm_of(t_from_type(type));
+	i = fixnnint(qty);
+	if (tm->tm_npage > i) i = tm->tm_npage;
+	tm->tm_maxpage = i;
+	if (now == Cnil || tm->tm_maxpage <= tm->tm_npage)
+	  @(return Ct)
+	if (available_pages() < tm->tm_maxpage - tm->tm_npage ||
+	    (pp = alloc_page(tm->tm_maxpage - tm->tm_npage)) == NULL)
+	  FEerror("Can't allocate ~D pages for ~A.", 2, type,
+		  make_simple_string(tm->tm_name+1));
+	for (;  tm->tm_npage < tm->tm_maxpage;  pp += LISP_PAGESIZE)
+	  add_page_to_freelist(pp, tm);
+	@(return Ct)
+@)
+
+@(defun si::maxpage (type)
+@
+	@(return MAKE_FIXNUM(tm_of(t_from_type(type))->tm_maxpage))
+@)
+
+@(defun si::allocated_pages (type)
+@
+	@(return MAKE_FIXNUM(tm_of(t_from_type(type))->tm_npage))
+@)
+
+@(defun si::alloc_contpage (qty &optional (now Cnil))
+	size_t i, m;
+	char *p;
+@
+	i = fixnnint(qty);
+	if (ncbpage > i)
+	  FEerror("Can't set the limit for contiguous blocks to ~D,~%\
+since ~D pages are already allocated.",
+			2, qty, MAKE_FIXNUM(ncbpage));
+	maxcbpage = i;
+	if (Null(now))
+	  @(return Ct)
+	m = maxcbpage - ncbpage;
+	if (available_pages() < m || (p = alloc_page(m)) == NULL)
+		FEerror("Can't allocate ~D pages for contiguous blocks.",
+			1, qty);
+	for (i = 0;  i < m;  i++)
+		type_map[page(p + LISP_PAGESIZE*i)] = (char)t_contiguous;
+	ncbpage += m;
+	dealloc(p, LISP_PAGESIZE*m);
+	@(return Ct)
+@)
+
+@(defun si::ncbpage ()
+@
+	@(return MAKE_FIXNUM(ncbpage))
+@)
+
+@(defun si::maxcbpage ()
+@
+	@(return MAKE_FIXNUM(maxcbpage))
+@)
+
+@(defun si::get_hole_size ()
+@
+	@(return MAKE_FIXNUM(new_holepage))
+@)
+
+@(defun si::set_hole_size (size)
+	size_t i;
+@
+	i = fixnnint(size);
+	if (i == 0 || i > available_pages() + new_holepage)
+	  FEerror("Illegal value for the hole size.", 0);
+	new_holepage = i;
+	@(return size)
+@)
+
+@(defun si::ignore_maximum_pages (&optional (flag OBJNULL))
+@
+	if (flag == OBJNULL)
+		@(return (ignore_maximum_pages? Ct : Cnil))
+	ignore_maximum_pages = Null(flag);
+	@(return flag)
+@)
+
+static cl_object siVlisp_maxpages, siClisp_pagesize;
+
+void
+init_alloc_function(void)
+{
+	ignore_maximum_pages = TRUE;
+	siVlisp_maxpages = make_si_special("*LISP-MAXPAGES*", MAKE_FIXNUM(real_maxpage));
+	siClisp_pagesize = make_si_constant("LISP-PAGESIZE", MAKE_FIXNUM(LISP_PAGESIZE));
+	SYM_VAL(siVlisp_maxpages) = MAKE_FIXNUM(real_maxpage);
+}
+
+#ifdef NEED_MALLOC
+/*
+	UNIX malloc simulator.
+
+	Used by
+		getwd, popen, etc.
+*/
+
+#undef malloc
+#undef calloc
+#undef free
+#undef cfree
+#undef realloc
+
+void *
+malloc(size_t size)
+{
+  cl_object x;
+
+#ifdef __GNUC__
+  if (!GC_enabled() && !alloc_initialized)
+    init_alloc();
+#endif __GNUC__
+
+  x = alloc_simple_string(size-1);
+  x->string.self = alloc(size);
+  malloc_list = make_cons(x, malloc_list);
+  return(x->string.self);
+}
+
+void
+free(void *ptr)
+{
+  cl_object *p;
+
+  if (ptr) {
+    for (p = &malloc_list;  !endp(*p);  p = &(CDR((*p))))
+      if ((CAR((*p)))->string.self == ptr) {
+	dealloc(CAR((*p))->string.self, CAR((*p))->string.dim);
+	CAR((*p))->string.self = NULL;
+	*p = CDR((*p));
+	return;
+      }
+    FEerror("free(3) error.", 0);
+  }
+}
+
+void *
+realloc(void *ptr, size_t size)
+{
+  cl_object x;
+  size_t i, j;
+
+  for (x = malloc_list;  !endp(x);  x = CDR(x))
+    if (CAR(x)->string.self == ptr) {
+      x = CAR(x);
+      if (x->string.dim >= size) {
+	x->string.fillp = size;
+	return(ptr);
+      } else {
+	j = x->string.dim;
+	x->string.self = alloc(size);
+	x->string.fillp = x->string.dim = size;
+	memcpy(x->string.self, ptr, j);
+	dealloc(ptr, j);
+	return(x->string.self);
+      }
+    }
+  FEerror("realloc(3) error.", 0);
+}
+
+void *
+calloc(size_t nelem, size_t elsize)
+{
+  char *ptr;
+  size_t i = nelem*elsize;
+  ptr = malloc(i);
+  memset(ptr, 0 , i);
+  return(ptr);
+}
+
+void cfree(void *ptr)
+{
+  free(ptr);
+}
+
+/* make f allocate enough extra, so that we can round
+   up, the address given to an even multiple.   Special
+   case of size == 0 , in which case we just want an aligned
+   number in the address range
+   */
+
+#define ALLOC_ALIGNED(f, size, align) \
+	((align) <= 4 ? (int)(f)(size) : \
+	   ((align) * (((unsigned)(f)(size + (size ? (align) - 1 : 0)) + (align) - 1)/(align))))
+
+void *
+memalign(size_t align, size_t size)
+{ cl_object x = alloc_simple_string(size);
+  x->string.self = (char *)ALLOC_ALIGNED(alloc, size, align);
+  malloc_list = make_cons(x, malloc_list);
+  return x->string.self;
+}
+
+# ifdef WANT_VALLOC
+char *
+valloc(size_t size)
+{ return memalign(getpagesize(), size);}
+# endif WANT_VALLOC
+#endif NEED_MALLOC
diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d
new file mode 100644
index 000000000..1f5c8ec32
--- /dev/null
+++ b/src/c/alloc_2.d
@@ -0,0 +1,291 @@
+/*
+    alloc_2.c -- Memory allocation based on the Boehmn GC.
+*/
+/*
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include "page.h"
+
+/**********************************************************
+ *		OBJECT ALLOCATION			  *
+ **********************************************************/
+
+struct typemanager tm_table[(int)t_end];
+
+#ifdef alloc_object
+#undef alloc_object
+#endif
+
+cl_object
+alloc_object(enum type t)
+{
+	register cl_object obj;
+	register struct typemanager *tm;
+
+	switch (t) {
+	case t_fixnum:
+	  return MAKE_FIXNUM(0); /* Immediate fixnum */
+	case t_character:
+	  return code_char(' '); /* Immediate character */
+	default:
+	}
+	if (t < t_start || t >= t_end) {
+	  printf("\ttype = %d\n", t);
+	  error("alloc botch.");
+	}
+	tm = tm_of(t);
+
+	start_critical_section(); 
+	obj = GC_malloc(tm->tm_size);
+	obj->d.t = t;
+	/* GC_malloc already resets objects */
+	end_critical_section();
+
+	return obj;
+}
+
+#ifdef make_cons
+#undef make_cons
+#endif
+
+cl_object
+make_cons(cl_object a, cl_object d)
+{
+	cl_object obj;
+
+	start_critical_section(); 
+
+	obj = GC_malloc(sizeof(struct cons));
+	obj->d.t = (short)t_cons;
+	CAR(obj) = a;
+	CDR(obj) = d;
+
+	end_critical_section();
+
+	return obj;
+}
+
+cl_object
+alloc_instance(cl_index slots)
+{
+	cl_object i;
+	i = alloc_object(t_instance);
+	i->instance.slots = alloc_align(sizeof(cl_object) * slots, sizeof(cl_object));
+	i->instance.length = slots;
+	return i;
+}
+
+void *
+alloc(size_t n)
+{
+	void *output;
+	start_critical_section(); 
+	output = GC_malloc(n);
+	end_critical_section();
+	return output;
+}
+
+void *
+alloc_atomic(size_t n)
+{
+	void *output;
+	start_critical_section(); 
+	output = GC_malloc_atomic(n);
+	end_critical_section();
+	return output;
+}
+
+/*
+ * adds a contblock to the list of available ones, pointed by cb_pointer,
+ * sorted by increasing size.
+ */
+void
+dealloc(void *p, size_t s)
+{
+	GC_free(p);	
+}
+
+/*
+ * align must be a power of 2 representing the alignment boundary
+ * required for the block.
+ */
+void *
+alloc_align(size_t size, size_t align)
+{
+	char *output;
+	start_critical_section();
+	align--;
+	output = GC_malloc(size + align);
+	output = (char*)(((cl_fixnum)output + align) & ~align);
+	end_critical_section();
+	return output;
+}
+
+/*
+ * align must be a power of 2 representing the alignment boundary
+ * required for the block.
+ */
+void *
+alloc_atomic_align(size_t size, size_t align)
+{
+	char *output;
+	start_critical_section();
+	align--;
+	output = GC_malloc(size + align);
+	output = (char*)(((cl_fixnum)output + align) & ~align);
+	end_critical_section();
+	return output;
+}
+
+static void
+init_tm(enum type t, char *name, size_t elsize)
+{
+	struct typemanager *tm = &tm_table[(int)t];
+	tm->tm_name = name;
+	tm->tm_size = elsize;
+}
+
+static int alloc_initialized = FALSE;
+
+void
+init_alloc(void)
+{
+	if (alloc_initialized) return;
+	alloc_initialized = TRUE;
+
+	init_tm(t_shortfloat, "SHORT-FLOAT", /* 8 */
+		sizeof(struct shortfloat_struct));
+	init_tm(t_cons, "CONS", sizeof(struct cons)); /* 12 */
+	init_tm(t_longfloat, "LONG-FLOAT", /* 16 */
+		sizeof(struct longfloat_struct));
+	init_tm(t_bytecodes, "bBYTECODES", sizeof(struct bytecodes));
+	init_tm(t_string, "STRING", sizeof(struct string)); /* 20 */
+	init_tm(t_array, "ARRAY", sizeof(struct array)); /* 24 */
+	init_tm(t_pathname, "PATHNAME", sizeof(struct pathname)); /* 28 */
+	init_tm(t_symbol, "SYMBOL", sizeof(struct symbol)); /* 32 */
+	init_tm(t_package, "PACKAGE", sizeof(struct package)); /* 36 */
+	init_tm(t_codeblock, "CODEBLOCK", sizeof(struct codeblock), 1);
+	init_tm(t_bignum, "BIGNUM", sizeof(struct bignum));
+	init_tm(t_ratio, "RATIO", sizeof(struct ratio));
+	init_tm(t_complex, "COMPLEX", sizeof(struct complex));
+	init_tm(t_hashtable, "HASH-TABLE", sizeof(struct hashtable));
+	init_tm(t_vector, "VECTOR", sizeof(struct vector));
+	init_tm(t_bitvector, "BIT-VECTOR", sizeof(struct vector));
+	init_tm(t_stream, "STREAM", sizeof(struct stream));
+	init_tm(t_random, "RANDOM-STATE", sizeof(struct random));
+	init_tm(t_readtable, "READTABLE", sizeof(struct readtable));
+	init_tm(t_cfun, "CFUN", sizeof(struct cfun));
+	init_tm(t_cclosure, "CCLOSURE", sizeof(struct cclosure));
+#ifndef CLOS
+	init_tm(t_structure, "STRUCTURE", sizeof(struct structure));
+#else
+	init_tm(t_instance, "INSTANCE", sizeof(struct instance));
+	init_tm(t_gfun, "GFUN", sizeof(struct gfun));
+#endif CLOS
+#ifdef THREADS
+	init_tm(t_cont, "CONT", sizeof(struct cont));
+	init_tm(t_thread, "THREAD", sizeof(struct thread));
+#endif THREADS
+}
+
+/**********************************************************
+ *		MALLOC SUBSTITUTION			  *
+ **********************************************************/
+
+#ifdef NEED_MALLOC
+#undef malloc
+#undef calloc
+#undef free
+#undef cfree
+#undef realloc
+
+/* FIXME! Shouldn't this be thread safe? */
+void *
+malloc(size_t size)
+{
+	return GC_malloc(size);
+}
+
+void
+free(void *ptr)
+{
+	GC_free(ptr);
+}
+
+void *
+realloc(void *ptr, size_t size)
+{
+	return GC_realloc(ptr, size);
+}
+
+void *
+calloc(size_t nelem, size_t elsize)
+{
+	char *ptr;
+	size_t i;
+	ptr = GC_malloc(i = nelem*elsize);
+	memset(ptr, 0 , i);
+	return ptr;
+}
+
+void
+cfree(void *ptr)
+{
+	GC_free(ptr);
+}
+
+#define ALLOC_ALIGNED(f, size, align) \
+	((align) <= 4 ? (int)(f)(size) : \
+	   ((align) * (((unsigned)(f)(size + (size ? (align) - 1 : 0)) + (align) - 1)/(align))))
+
+void *
+memalign(size_t align, size_t size)
+{
+	return (void *)ALLOC_ALIGNED(GC_malloc, size, align);
+}
+
+# ifdef WANT_VALLOC
+char *
+valloc(size_t size)
+{
+	return memalign(getpagesize(), size);
+}
+# endif WANT_VALLOC
+#endif NEED_MALLOC
+
+
+/**********************************************************
+ *		GARBAGE COLLECTION			  *
+ **********************************************************/
+
+cl_object siVgc_verbose;
+cl_object siVgc_message;
+
+void
+register_root(cl_object *p)
+{
+	GC_add_roots(p, p+1);
+}
+
+@(defun gc (area)
+@
+	gc(0);
+	@(return)
+@)
+
+void
+gc(enum type new_name)
+{
+	start_critical_section();
+	GC_gcollect();
+	end_critical_section();
+}
diff --git a/src/c/apply.d b/src/c/apply.d
new file mode 100644
index 000000000..433b85cd3
--- /dev/null
+++ b/src/c/apply.d
@@ -0,0 +1,675 @@
+/*
+    apply.c -- Interface to C call mechanism.
+*/
+/*
+    Copyright (c) 1993, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+cl_object
+APPLY(int n, cl_object (*fn)(), cl_object *x)
+#ifdef ARGCALL
+{ int i; ARGSTACK(n);
+  for (i = 0; i < n; i++)
+    CPUSH(*x++);
+  return ARGCALL(n, fn);
+}
+#else
+{
+  switch (n) {
+  case 0:  return (*fn)(n);
+  case 1:  return (*fn)(n, x[0]);
+  case 2:  return (*fn)(n, x[0],x[1]);
+  case 3:  return (*fn)(n, x[0],x[1],x[2]);
+  case 4:  return (*fn)(n, x[0],x[1],x[2],x[3]);
+  case 5:  return (*fn)(n, x[0],x[1],x[2],x[3],x[4]);
+  case 6:  return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5]);
+  case 7:  return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6]);
+  case 8:  return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7]);
+  case 9:  return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		     x[8]);
+  case 10: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9]);
+  case 11: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10]);
+  case 12: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11]);
+  case 13: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12]);
+  case 14: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13]);
+  case 15: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14]);
+  case 16: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15]);
+  case 17: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16]);
+  case 18: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17]);
+  case 19: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18]);
+  case 20: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19]);
+  case 21: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20]);
+  case 22: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21]);
+  case 23: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22]);
+  case 24: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23]);
+  case 25: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24]);
+  case 26: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25]);
+  case 27: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26]);
+  case 28: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27]);
+  case 29: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28]);
+  case 30: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29]);
+  case 31: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30]);
+  case 32: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31]);
+  case 33: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32]);
+  case 34: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33]);
+  case 35: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34]);
+  case 36: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35]);
+  case 37: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36]);
+  case 38: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37]);
+  case 39: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38]);
+  case 40: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39]);
+  case 41: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40]);
+  case 42: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41]);
+  case 43: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42]);
+  case 44: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43]);
+  case 45: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44]);
+  case 46: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45]);
+  case 47: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46]);
+  case 48: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47]);
+  case 49: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48]);
+  case 50: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49]);
+  case 51: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50]);
+  case 52: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51]);
+  case 53: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52]);
+  case 54: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53]);
+  case 55: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54]);
+  case 56: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55]);
+  case 57: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56]);
+  case 58: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57]);
+  case 59: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58]);
+  case 60: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59]);
+  case 61: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59],x[60]);
+  case 62: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59],x[60],x[61]);
+  case 63: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59],x[60],x[61],x[62]);
+  case 64: return (*fn)(n, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59],x[60],x[61],x[62],x[63]);
+  default: FEprogram_error("Exceeded call-arguments-limit.", 0);
+  } 
+}
+#endif ARGCALL
+
+cl_object
+APPLY_closure(int n, cl_object (*fn)(), cl_object cl, cl_object *x)
+#ifdef ARGCALL
+{ int i; ARGSTACK(n+1);
+  CPUSH(cl);
+  for (i = 0; i < n; i++)
+    CPUSH(*x++);
+  return ARGCALL(n++, fn);
+}
+#else
+{
+  switch (++n) {
+  case 1:  return (*fn)(n, cl);
+  case 2:  return (*fn)(n, cl, x[0]);
+  case 3:  return (*fn)(n, cl, x[0],x[1]);
+  case 4:  return (*fn)(n, cl, x[0],x[1],x[2]);
+  case 5:  return (*fn)(n, cl, x[0],x[1],x[2],x[3]);
+  case 6:  return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4]);
+  case 7:  return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5]);
+  case 8:  return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6]);
+  case 9:  return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7]);
+  case 10: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		     x[8]);
+  case 11: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9]);
+  case 12: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10]);
+  case 13: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11]);
+  case 14: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12]);
+  case 15: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13]);
+  case 16: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14]);
+  case 17: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15]);
+  case 18: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16]);
+  case 19: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17]);
+  case 20: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18]);
+  case 21: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19]);
+  case 22: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20]);
+  case 23: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21]);
+  case 24: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22]);
+  case 25: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23]);
+  case 26: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24]);
+  case 27: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25]);
+  case 28: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26]);
+  case 29: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27]);
+  case 30: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28]);
+  case 31: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29]);
+  case 32: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30]);
+  case 33: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31]);
+  case 34: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32]);
+  case 35: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33]);
+  case 36: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34]);
+  case 37: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35]);
+  case 38: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36]);
+  case 39: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37]);
+  case 40: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38]);
+  case 41: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39]);
+  case 42: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40]);
+  case 43: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41]);
+  case 44: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42]);
+  case 45: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43]);
+  case 46: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44]);
+  case 47: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45]);
+  case 48: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46]);
+  case 49: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47]);
+  case 50: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48]);
+  case 51: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49]);
+  case 52: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50]);
+  case 53: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51]);
+  case 54: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52]);
+  case 55: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53]);
+  case 56: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54]);
+  case 57: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55]);
+  case 58: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56]);
+  case 59: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57]);
+  case 60: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58]);
+  case 61: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59]);
+  case 62: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59],x[60]);
+  case 63: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59],x[60],x[61]);
+  case 64: return (*fn)(n, cl, x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59],x[60],x[61],x[62]);
+  default: FEprogram_error("Exceeded call-arguments-limit.", 0);
+  } 
+}
+#endif ARGCALL
diff --git a/src/c/array.d b/src/c/array.d
new file mode 100644
index 000000000..ee2f6b5d0
--- /dev/null
+++ b/src/c/array.d
@@ -0,0 +1,724 @@
+/*
+    array.c --  Array routines
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+static void displace (cl_object from, cl_object to, cl_object offset);
+static void check_displaced (cl_object dlist, cl_object orig, cl_index newdim);
+extern enum aelttype get_aelttype (cl_object x);
+
+cl_index
+object_to_index(cl_object n)
+{
+	switch (type_of(n)) {
+	case t_fixnum: {
+		cl_fixnum out = fix(n);
+		if (out < 0 || out >= ADIMLIM)
+			FEtype_error_index(n);
+		return out;
+	}
+	case t_bignum:
+		FEtype_error_index(n);
+	default:
+		FEtype_error_integer(n);
+	}
+}
+
+@(defun aref (x &rest indx)
+  cl_index r, s, i, j;
+  cl_object index;
+@
+  r = narg - 1;
+  switch (type_of(x)) {
+  case t_array:
+    if (r != x->array.rank)
+      FEerror("Wrong number of indices.", 0);
+    for (i = j = 0;  i < r;  i++) {
+      index = va_arg(indx, cl_object);
+      if ((s = fixnnint(index)) >= x->array.dims[i])
+        FEerror("The ~:R index, ~S, to the array~%\
+~S is too large.", 3, MAKE_FIXNUM(i+1), index, x);
+      j = j*(x->array.dims[i]) + s;
+    }
+    break;
+
+  case t_vector:
+  case t_string:
+  case t_bitvector:
+    if (r != 1)
+      FEerror("Wrong number of indices.", 0);
+    index = va_arg(indx, cl_object);
+    j = fixnnint(index);
+    if (j >= x->vector.dim)
+      FEerror("The first index, ~S, to the array ~S is too large.",
+              2, index, x);
+    break;
+
+  default:
+    FEwrong_type_argument(Sarray, x);
+  }
+  @(return aref(x, j))
+@)
+
+cl_object
+aref(cl_object x, cl_index index)
+{
+  if (index >= x->array.dim)
+    FEerror("The index, ~D, is too large.", 1, MAKE_FIXNUM(index));
+  switch ((enum aelttype)array_elttype(x)) {
+  case aet_object:
+    return(x->array.self.t[index]);
+
+  case aet_ch:
+    return(code_char(x->string.self[index]));
+
+  case aet_bit:
+    index += x->vector.offset;
+    if (x->vector.self.bit[index/CHAR_BIT] & (0200>>index%CHAR_BIT))
+      return(MAKE_FIXNUM(1));
+    else
+      return(MAKE_FIXNUM(0));
+  case aet_fix:
+    return(MAKE_FIXNUM(x->array.self.fix[index]));
+
+  case aet_sf:
+    return(make_shortfloat(x->array.self.sf[index]));
+
+  case aet_lf:
+    return(make_longfloat(x->array.self.lf[index]));
+
+  default:
+    internal_error("aref");
+  }
+}
+
+cl_object
+aref1(cl_object v, cl_index index)
+{
+  switch (type_of(v)) {
+  case t_vector:
+  case t_bitvector:
+    return(aref(v, index));
+
+  case t_string:
+    if (index >= v->string.dim)
+      FEerror("The index, ~D, is too large.", 1, MAKE_FIXNUM(index));
+    return(code_char(v->string.self[index]));
+
+  default:
+    FEerror("~S is not a vector.", 1, v);
+  }
+}
+
+/*
+	Internal function for setting array elements:
+
+		(si:aset value array dim0 ... dimN)
+*/
+@(defun si::aset (v x &rest dims)
+  cl_index r, s, i, j;
+  cl_object index;
+@
+  r = narg - 2;
+  switch (type_of(x)) {
+  case t_array:
+    if (r != x->array.rank)
+      FEerror("Wrong number of indices.", 0);
+    for (i = j = 0;  i < r;  i++) {
+      index = va_arg(dims, cl_object);
+      if ((s = fixnnint(index)) >= x->array.dims[i])
+	FEerror("The ~:R index, ~S, to the array ~S is too large.",
+		3, MAKE_FIXNUM(i+1), index, x);
+      j = j*(x->array.dims[i]) + s;
+    }
+    break;
+
+  case t_vector:
+  case t_string:
+  case t_bitvector:
+    if (r != 1)
+      FEerror("Wrong number of indices.", 0);
+    index = va_arg(dims, cl_object);
+    j = fixnnint(index);
+    if (j >= x->vector.dim)
+      FEerror("The first index, ~S, to the array ~S is too large.",
+	      2, index, x);
+    break;
+
+  default:
+    FEwrong_type_argument(Sarray, x);
+  }
+  @(return aset(x, j, v))
+@)
+
+cl_object
+aset(cl_object x, cl_index index, cl_object value)
+{
+  if (index >= x->array.dim)
+    FEerror("The index, ~D, too large.", 1, MAKE_FIXNUM(index));
+  switch (array_elttype(x)) {
+  case aet_object:
+    x->array.self.t[index] = value;
+    break;
+
+  case aet_ch:
+    /* INV: char_code() checks the type of `value' */
+    x->string.self[index] = char_code(value);
+    break;
+
+  case aet_bit: {
+    cl_fixnum i = fixint(value);
+    if (i != 0 && i != 1)
+      FEerror("~S is not a bit.", 1, value);
+    index += x->vector.offset;
+    if (i == 0)
+      x->vector.self.bit[index/CHAR_BIT] &= ~(0200>>index%CHAR_BIT);
+    else
+      x->vector.self.bit[index/CHAR_BIT] |= 0200>>index%CHAR_BIT;
+    break;
+  }
+  case aet_fix:
+    x->array.self.fix[index] = fixint(value);
+    break;
+
+  case aet_sf:
+    x->array.self.sf[index] = object_to_float(value);
+    break;
+
+  case aet_lf:
+    x->array.self.lf[index] = object_to_double(value);
+    break;
+  }
+  return(value);
+}
+
+cl_object
+aset1(cl_object v, cl_index index, cl_object val)
+{
+  switch (type_of(v)) {
+  case t_vector:
+  case t_bitvector:
+    return(aset(v, index, val));
+
+  case t_string:
+    if (index >= v->string.dim)
+      FEerror("The index, ~D, is too large", 1, MAKE_FIXNUM(index));
+    /* INV: char_code() checks the type of `val' */
+    v->string.self[index] = char_code(val);
+    return(val);
+
+  default:
+    FEerror("~S is not a vector.", 1, v);
+  }
+
+}
+
+/*
+	Internal function for making arrays of more than one dimension:
+
+		(si:make-pure-array element-type adjustable
+			            displaced-to displaced-index-offset
+			            dim0 dim1 ... )
+*/
+@(defun si::make_pure_array (etype adj displ disploff &rest dims)
+  cl_index r, s, i, j;
+  cl_object x;
+@
+  r = narg - 4;
+  x = alloc_object(t_array);
+  x->array.displaced = Cnil;
+  x->array.self.t = NULL;		/* for GC sake */
+  x->array.rank = r;
+  x->array.elttype = (short)get_aelttype(etype);
+  x->array.dims = alloc_atomic_align(sizeof(int)*r, sizeof(int));
+  if (r >= ARANKLIM)
+    FEerror("The array rank, ~R, is too large.", 1, MAKE_FIXNUM(r));
+  for (i = 0, s = 1;  i < r;  i++) {
+    cl_object index = va_arg(dims, cl_object);
+    if ((j = fixnnint(index)) > ADIMLIM)
+      FEerror("The ~:R array dimension, ~D, is too large.",
+	      2, MAKE_FIXNUM(i+1), index);
+    s *= (x->array.dims[i] = j);
+    if (s > ATOTLIM)
+      FEerror("The array total size, ~D, is too large.", 1, MAKE_FIXNUM(s));
+  }
+  x->array.dim = s;
+  x->array.adjustable = adj != Cnil;
+  if (Null(displ))
+    array_allocself(x);
+  else
+    displace(x, displ, disploff);
+  @(return x)
+@)
+
+/*
+	Internal function for making vectors:
+
+		(si:make-vector element-type dimension adjustable fill-pointer
+				displaced-to displaced-index-offset)
+*/
+@(defun si::make_vector (etype dim adj fillp displ disploff)
+  cl_index d, f;
+  cl_object x;
+  enum aelttype aet;
+@
+  aet = get_aelttype(etype);
+  if ((d = fixnnint(dim)) > ADIMLIM)
+    FEerror("The vector dimension, ~D, is too large.", 1, dim);
+  f = d;
+  if (aet == aet_ch) {
+    x = alloc_object(t_string);
+    d++;			/* extra for null terminator */
+  }
+  else if (aet == aet_bit)
+    x = alloc_object(t_bitvector);
+  else {
+    x = alloc_object(t_vector);
+    x->vector.elttype = (short)aet;
+  }
+  x->vector.self.t = NULL;		/* for GC sake */
+  x->vector.displaced = Cnil;
+  x->vector.dim = d;
+  x->vector.adjustable = adj != Cnil;
+
+  if (Null(fillp))
+    x->vector.hasfillp = FALSE;
+  else if (fillp == Ct)
+    x->vector.hasfillp = TRUE;
+  else if ((f = fixnnint(fillp)) > d)
+    FEerror("The fill-pointer ~S is too large.", 1, fillp);
+  else
+    x->vector.hasfillp = TRUE;
+  x->vector.fillp = f;
+
+  if (Null(displ))
+    array_allocself(x);
+  else
+    displace(x, displ, disploff);
+  @(return x)
+@)
+
+void
+array_allocself(cl_object x)
+{
+	cl_index i, d;
+
+	d = x->array.dim;
+#ifdef THREADS
+	start_critical_section(); /* avoid losing elts */
+#endif THREADS
+	switch (array_elttype(x)) {
+
+	/* assign self field only after it has been filled, for GC sake  */
+	case aet_object: {
+		cl_object *elts;
+		elts = alloc_align(sizeof(cl_object)*d, sizeof(cl_object));
+		for (i = 0;  i < d;  i++)
+			elts[i] = Cnil;
+		x->array.self.t = elts;
+		break;
+	      }
+	case aet_ch: {
+		char *elts;
+		elts = alloc_atomic(d);
+		for (i = 0;  i < d;  i++)
+			elts[i] = ' ';
+		if (type_of(x) == t_string) elts[d-1] = '\0';
+		x->string.self = elts;
+		break;
+	      }
+	case aet_bit: {
+		char *elts;
+		d = (d+(CHAR_BIT-1))/CHAR_BIT;
+		elts = alloc_atomic(d);
+		for (i = 0;  i < d;  i++)
+			elts[i] = '\0';
+		x->vector.offset = 0;
+		x->vector.self.bit = elts;
+		break;
+	      }
+	case aet_fix: {
+		cl_fixnum *elts;
+		elts = alloc_atomic_align(sizeof(cl_fixnum)*d, sizeof(cl_fixnum));
+		for (i = 0;  i < d;  i++)
+			elts[i] = 0;
+		x->array.self.fix = elts;
+		break;
+	      }
+	case aet_sf: {
+		float *elts;
+		elts = alloc_atomic_align(sizeof(float)*d, sizeof(float));
+		for (i = 0;  i < d;  i++)
+			elts[i] = 0.0;
+		x->array.self.sf = elts;
+		break;
+	      }
+	case aet_lf: {
+		double *elts;
+		elts = alloc_atomic_align(sizeof(double)*d, sizeof(double));
+		for (i = 0;  i < d;  i++)
+			elts[i] = 0.0;
+		x->array.self.lf = elts;
+		break;
+	      }
+	}
+#ifdef THREADS
+	end_critical_section();
+#endif THREADS
+}
+
+enum aelttype
+get_aelttype(cl_object x)
+{
+	if (x == Sbase_char)
+		return(aet_ch);
+	else if (x == Sbit)
+		return(aet_bit);
+	else if (x == Sfixnum)
+		return(aet_fix);
+	else if (x == Ssingle_float || x == Sshort_float)
+		return(aet_sf);
+	else if (x == Slong_float || x == Sdouble_float)
+		return(aet_lf);
+/*	else if (x == Ssigned_char)
+		return(aet_char);
+	else if (x == Sunsigned_char)
+		return(aet_uchar);
+	else if (x == Ssigned_short)
+		return(aet_short);
+	else if (x == Sunsigned_short)
+		return(aet_ushort);
+*/	else
+		return(aet_object);
+}
+
+void *
+array_address(cl_object x, cl_index inc)
+{
+	switch(array_elttype(x)) {
+	case aet_object:
+		return x->array.self.t + inc;
+	case aet_fix:
+		return x->array.self.fix + inc;
+	case aet_sf:
+		return x->array.self.t + inc;
+	case aet_ch:
+		return x->string.self + inc;
+	case aet_lf:
+		return x->array.self.lf + inc;
+
+	default:
+		FEerror("Bad array type", 0);
+	}
+}
+
+@(defun array_element_type (a)
+	cl_object output;
+@
+	switch (array_elttype(a)) {
+	case aet_object:	output = Ct; break;
+	case aet_ch:		output = Sbase_char; break;
+	case aet_bit:		output = Sbit; break;
+	case aet_fix:		output = Sfixnum; break;
+	case aet_sf:		output = Sshort_float; break;
+	case aet_lf:		output = Slong_float; break;
+	}
+	@(return output)
+@)
+
+/*
+	Displace(from, to, offset) displaces the from-array
+	to the to-array (the original array) by the specified offset.
+	It changes the a_displaced field of both arrays.
+	The field is a cons; the car of the from-array points to
+	the to-array and the cdr of the to-array is a list of arrays
+	displaced to the to-array, so the from-array is pushed to the
+	cdr of the to-array's a_displaced.
+*/
+static void
+displace(cl_object from, cl_object to, cl_object offset)
+{
+	cl_index j;
+	enum aelttype totype, fromtype;
+
+	j = fixnnint(offset);
+	totype = array_elttype(to);
+	fromtype = array_elttype(from);
+	if (totype != fromtype)
+		FEerror("Cannot displace the array,~%\
+because the element types don't match.", 0);
+	if (j + from->array.dim > to->array.dim)
+		FEerror("Cannot displace the array,~%\
+because the total size of the to-array is too small.", 0);
+	from->array.displaced = CONS(to, Cnil);
+	if (Null(to->array.displaced))
+		to->array.displaced = CONS(Cnil, Cnil);
+	CDR(to->array.displaced) =
+	CONS(from, CDR(to->array.displaced));
+	if (fromtype == aet_bit) {
+		j += to->vector.offset;
+		from->vector.self.bit = to->vector.self.bit + j/CHAR_BIT;
+		from->vector.offset = j%CHAR_BIT;
+	}
+#ifndef BYTE_ADDRESS
+	else if (fromtype != aet_ch)
+		from->array.self.t = (cl_object *)(array_address(to, j));
+#endif
+	else
+		from->string.self = array_address(to, j);
+}
+
+/*
+	Check_displaced(dlist, orig, newdim) checks if the displaced
+	arrays can keep the displacement when the original array is
+	adjusted.
+	Dlist is the list of displaced arrays, orig is the original array
+	and newdim is the new dimension of the original array.
+*/
+static void
+check_displaced(cl_object dlist, cl_object orig, cl_index newdim)
+{
+	cl_object x;
+
+	for (;  dlist != Cnil;  dlist = CDR(dlist)) {
+		x = CAR(dlist);
+		if (x->array.self.t == NULL)
+			continue;
+		if (array_elttype(x) != aet_bit) {
+			if (array_address(x, x->array.dim) >
+			    array_address(orig, newdim))
+				FEerror("Can't keep displacement.", 0);
+		} else {
+			if ((x->vector.self.bit - orig->vector.self.bit)*CHAR_BIT +
+			    x->vector.dim - newdim +
+			    x->vector.offset - orig->vector.offset > 0)
+				FEerror("Can't keep displacement.", 0);
+		}
+		check_displaced(CDR(x->array.displaced), orig, newdim);
+	}
+}
+
+/*
+	Adjust_displaced(x, diff) adds the int value diff
+	to the a_self field of the array x and all the arrays displaced to x.
+	This function is used in siLreplace_array (ADJUST-ARRAY) and
+	the garbage collector.
+*/
+void adjust_displaced(cl_object x, ptrdiff_t diff)
+{
+	if (x->array.self.t != NULL)
+		x->array.self.t = (cl_object *)((char*)(x->array.self.t) + diff);
+	for (x = CDR(x->array.displaced);  x != Cnil;  x = CDR(x))
+		adjust_displaced(CAR(x), diff);
+}
+
+enum aelttype
+array_elttype(cl_object x)
+{
+	switch(type_of(x)) {
+	case t_array:
+	case t_vector:
+		return((enum aelttype)x->array.elttype);
+
+	case t_string:
+		return(aet_ch);
+
+	case t_bitvector:
+		return(aet_bit);
+
+	default:
+		FEwrong_type_argument(Sarray, x);
+	}
+}
+
+@(defun array_rank (a)
+@
+	assert_type_array(a);
+	@(return ((type_of(a) == t_array) ? MAKE_FIXNUM(a->array.rank)
+					  : MAKE_FIXNUM(1)))
+@)
+
+@(defun array_dimension (a index)
+	cl_index i, dim;
+@
+	i = fixnnint(index);
+	switch (type_of(a)) {
+	case t_array:
+		if (i >= a->array.rank)
+			goto ILLEGAL;
+		dim  = a->array.dims[i];
+		break;
+	case t_string:
+		if (i != 0)
+			goto ILLEGAL;
+		dim = a->string.fillp;
+		break;
+	case t_vector:
+	case t_bitvector:
+		if (i != 0)
+ILLEGAL:		FEerror("~S is an illegal axis-number to the array ~S.",
+				2, index, a);
+		dim = a->vector.dim;
+		break;
+	default:
+		FEwrong_type_argument(Sarray, a);
+	}
+	@(return MAKE_FIXNUM(dim))
+@)
+
+@(defun array_total_size (a)
+@
+	assert_type_array(a);
+	@(return MAKE_FIXNUM(a->array.dim))
+@)
+
+@(defun adjustable_array_p (a)
+@
+	assert_type_array(a);
+	@(return (a->array.adjustable ? Ct : Cnil))
+@)
+
+/*
+	Internal function for checking if an array is displaced.
+*/
+@(defun si::displaced_array_p (a)
+@
+	assert_type_array(a);
+	@(return ((CAR(a->array.displaced) != Cnil) ? Ct : Cnil))
+@)
+
+@(defun svref (x index)
+  cl_index i;
+@
+  if (type_of(x) != t_vector ||
+      x->vector.adjustable ||
+      x->vector.hasfillp ||
+      CAR(x->vector.displaced) != Cnil ||
+      (enum aelttype)x->vector.elttype != aet_object)
+    FEwrong_type_argument(Ssimple_vector, x);
+  if ((i = fixnnint(index)) >= x->vector.dim)
+    illegal_index(x, index);
+  @(return x->vector.self.t[i])
+@)
+
+@(defun si::svset (x index v)
+  cl_index i;
+@
+  if (type_of(x) != t_vector ||
+      x->vector.adjustable ||
+      x->vector.hasfillp ||
+      CAR(x->vector.displaced) != Cnil ||
+      (enum aelttype)x->vector.elttype != aet_object)
+    FEwrong_type_argument(Ssimple_vector, x);
+  if ((i = fixnnint(index)) >= x->vector.dim)
+    illegal_index(x, index);
+  @(return (x->vector.self.t[i] = v))
+@)
+
+@(defun array_has_fill_pointer_p (a)
+	cl_object r;
+@
+	switch (type_of(a)) {
+	case t_array:
+		r = Cnil; break;
+	case t_vector:
+	case t_bitvector:
+	case t_string:
+		r = a->vector.hasfillp? Ct : Cnil;
+		break;
+	default:
+		FEwrong_type_argument(Sarray, a);
+	}
+	@(return r)
+@)
+
+@(defun fill_pointer (a)
+@
+  assert_type_vector(a);
+  if (a->vector.hasfillp)
+    @(return MAKE_FIXNUM(a->vector.fillp))
+  FEerror("The vector ~S has no fill pointer.", 1, a);
+@)
+
+/*
+	Internal function for setting fill pointer.
+*/
+@(defun si::fill_pointer_set (a fp)
+  cl_index i;
+@
+  assert_type_vector(a);
+  i = fixnnint(fp);
+  if (a->vector.hasfillp)
+    if (i > a->vector.dim)
+      FEerror("The fill-pointer ~S is too large", 1, fp);
+    else
+      a->vector.fillp = i;
+  else
+    FEerror("The vector ~S has no fill pointer.", 1, a);
+  @(return fp)
+@)
+
+/*
+	Internal function for replacing the contents of arrays:
+
+		(si:replace-array old-array new-array).
+
+	Used in ADJUST-ARRAY.
+*/
+@(defun si::replace_array (old new)
+  cl_object displaced, dlist;
+  ptrdiff_t diff;
+@
+  if (type_of(old) != type_of(new)
+      || (type_of(old) == t_array && old->array.rank != new->array.rank))
+    goto CANNOT;
+  if (!old->array.adjustable)
+    FEerror("~S is not adjustable.", 1, old);
+  diff = (char*)(new->array.self.t) - (char*)(old->array.self.t);
+  dlist = CDR(old->array.displaced);
+  displaced = CONS(CAR(new->array.displaced), dlist);
+  check_displaced(dlist, old, new->array.dim);
+  adjust_displaced(old, diff);
+/*  undisplace(old); */
+  switch (type_of(old)) {
+  case t_array:
+  case t_vector:
+  case t_bitvector:
+    old->array = new->array;
+    break;
+
+  case t_string:
+    old->string = new->string;
+    break;
+
+  default:
+    goto CANNOT;
+  }
+  old->array.displaced = displaced;
+  @(return old)
+
+ CANNOT:
+  FEerror("Cannot replace the array ~S by the array ~S.", 2, old, new);
+@)
+
+void
+init_array(void)
+{
+	make_constant("ARRAY-RANK-LIMIT", MAKE_FIXNUM(ARANKLIM));
+	make_constant("ARRAY-DIMENSION-LIMIT", MAKE_FIXNUM(ADIMLIM));
+	make_constant("ARRAY-TOTAL-SIZE-LIMIT", MAKE_FIXNUM(ATOTLIM));
+}
diff --git a/src/c/assignment.d b/src/c/assignment.d
new file mode 100644
index 000000000..48db12d10
--- /dev/null
+++ b/src/c/assignment.d
@@ -0,0 +1,179 @@
+/*
+    assignment.c  -- Assignment.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include <string.h>
+
+cl_object Ssetf, Spsetf, siSsetf_symbol;
+cl_object siSclear_compiler_properties;
+
+#ifdef PDE
+cl_object siVrecord_source_pathname_p, siSrecord_source_pathname;
+extern cl_object Sdefun;
+#endif PDE
+
+cl_object
+set(cl_object var, cl_object val)
+{
+	if (!SYMBOLP(var))
+		FEtype_error_symbol(var);
+	if (var->symbol.stype == stp_constant)
+		FEinvalid_variable("Cannot assign to the constant ~S.", var);
+	return (SYM_VAL(var) = val);
+}
+
+@(defun set (var val)
+@
+	@(return set(var, val))
+@)
+
+cl_object
+setf_namep(cl_object fun_spec)
+{	cl_object cdr;
+	if (CONSP(fun_spec) && !endp(cdr = CDR(fun_spec)) &&
+	    endp(CDR(cdr)) && CAR(fun_spec) == Ssetf) {
+	  cl_object fn_name, sym;
+	  fn_name = CAR(cdr);
+	  sym = getf(fn_name->symbol.plist, siSsetf_symbol, Cnil);
+	  if (Null(sym) || !SYMBOLP(sym)) {
+	    cl_object fn_str = fn_name->symbol.name;
+	    int l = fn_str->string.fillp + 7;
+	    cl_object string = alloc_simple_string(l);
+	    char *str = alloc_atomic(l+1);
+	    string->string.self = str;
+	    strncpy(str, "(SETF ", 6);
+	    strncpy(str + 6, fn_str->string.self, fn_str->string.fillp);
+	    str[l-1] = ')';
+	    str[l] = '\0';
+	    sym = intern(string, fn_name->symbol.hpack);
+	    fn_name->symbol.plist =
+	      putf(fn_name->symbol.plist, sym, siSsetf_symbol);
+	  }
+	  return(sym);
+	} else return(OBJNULL);
+}
+
+@(defun si::setf_namep (arg)
+	cl_object x;
+@
+	x = setf_namep(arg);
+	@(return ((x != OBJNULL) ? x : Cnil))
+@)
+
+@(defun si::fset (fun def &optional macro pprint)
+	enum type t;
+@
+	if (!SYMBOLP(fun)) {
+		cl_object sym;
+		if ((sym=setf_namep(fun)) != OBJNULL)
+			fun = sym;
+		else
+			FEtype_error_symbol(fun); 
+	}
+	if (fun->symbol.isform) {
+		if (fun->symbol.mflag) {
+			if (symbol_value(siVinhibit_macro_special) != Cnil)
+				fun->symbol.isform = FALSE;
+		} else if (symbol_value(siVinhibit_macro_special) != Cnil)
+			FEerror("~S, a special form, cannot be redefined.", 1, fun);
+	}
+	clear_compiler_properties(fun);
+	if (fun->symbol.hpack->pack.locked && SYM_FUN(fun) != OBJNULL)
+	  funcall(3, Swarn, make_simple_string("~S is being redefined."), fun);
+	t = type_of(def);
+	if (t == t_bytecodes || t == t_cfun || t == t_cclosure) {
+	        SYM_FUN(fun) = def;
+#ifdef CLOS
+	} else if (t == t_gfun) {
+		SYM_FUN(fun) = def;
+#endif
+	} else {
+		FEinvalid_function(def);
+	}
+	fun->symbol.mflag = !Null(macro);
+	if (pprint != Cnil)
+		fun->symbol.plist
+		= putf(fun->symbol.plist, pprint, siSpretty_print_format);
+	@(return fun)
+@)
+
+@(defun makunbound (sym)
+@
+	if (!SYMBOLP(sym))
+		FEtype_error_symbol(sym);
+	if ((enum stype)sym->symbol.stype == stp_constant)
+		FEinvalid_variable("Cannot unbind the constant ~S.", sym);
+	SYM_VAL(sym) = OBJNULL;
+	@(return sym)
+@)
+	
+@(defun fmakunbound (sym)
+@
+	if (!SYMBOLP(sym)) {
+		cl_object sym1;
+		if ((sym1=setf_namep(sym)) != OBJNULL)
+			sym = sym1;
+		else
+			FEtype_error_symbol(sym);
+	}
+	if (sym->symbol.isform) {
+	  if (sym->symbol.mflag) {
+	    if (symbol_value(siVinhibit_macro_special) != Cnil)
+	      sym->symbol.isform = FALSE;
+	  } else if (symbol_value(siVinhibit_macro_special) != Cnil)
+	    FEerror("~S, a special form, cannot be redefined.", 1, sym);
+	}
+	clear_compiler_properties(sym);
+#ifdef PDE
+	remprop(sym, Sdefun);
+#endif PDE
+	if (sym->symbol.hpack->pack.locked && SYM_FUN(sym) != OBJNULL)
+	  funcall(3, Swarn, make_simple_string("~S is being redefined."), sym);
+	SYM_FUN(sym) = OBJNULL;
+	sym->symbol.mflag = FALSE;
+	@(return sym)
+@)
+
+void
+clear_compiler_properties(cl_object sym)
+{
+	siLunlink_symbol(1, sym);
+	if (symbol_value(siVinhibit_macro_special) != Cnil)
+		(void)funcall(2, siSclear_compiler_properties, sym);
+}
+
+@(defun si::clear_compiler_properties (sym)
+@
+	@(return sym)
+@)
+
+#ifdef PDE
+void
+record_source_pathname(cl_object sym, cl_object def)
+{
+  if (symbol_value(siVrecord_source_pathname_p) != Cnil)
+    (void)funcall(3, siSrecord_source_pathname, sym, def);
+}
+#endif PDE
+
+void
+init_assignment(void)
+{
+#ifdef PDE
+	SYM_VAL(siVrecord_source_pathname_p) = Cnil;
+#endif PDE
+}
diff --git a/src/c/backq.d b/src/c/backq.d
new file mode 100644
index 000000000..ff7836c04
--- /dev/null
+++ b/src/c/backq.d
@@ -0,0 +1,306 @@
+/*
+    backq.c -- Backquote mechanism.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+/******************************* EXPORTS ******************************/
+#ifndef THREADS
+int backq_level;
+#endif
+/******************************* ------- ******************************/
+
+#define	read_char(in)	(*read_ch_fun)(in)
+
+/* #define attach(x)	(*px = CONS(x, *px)) */
+#define attach(s)	CDR(x) = CONS(s, CDR(x));
+
+#define	QUOTE	1
+#define	EVAL	2
+#define	LIST	3
+#define	LISTA	4
+#define	APPEND	5
+#define	NCONC	6
+
+cl_object siScomma;
+cl_object siScomma_at;
+cl_object siScomma_dot;
+
+cl_object SlistX;
+cl_object Sappend;
+cl_object Snconc;
+
+static cl_object
+kwote(cl_object x)
+{
+	enum cl_type t = type_of(x);
+	if ((t == t_symbol &&
+	     ((enum stype)x->symbol.stype != stp_constant || SYM_VAL(x) != x))
+	    || t == t_cons || t == t_vector)
+	   return(CONS(Squote, CONS(x, Cnil)));
+	else return(x);
+}
+
+/*
+	Backq_cdr(&x) puts result into x and returns one of
+
+		QUOTE		the form should be quoted
+		EVAL		the form should be evaluated
+		LIST		the form should be applied to LIST
+		LISTA		the form should be applied to LIST*
+		APPEND		the form should be applied to APPEND
+		NCONC		the form should be applied to NCONC
+*/
+int
+backq_cdr(cl_object *px)
+{
+	cl_object x = *px;
+	int a, d;
+
+	cs_check(px);
+
+	if (ATOM(x))
+		return(QUOTE);
+	if (CAR(x) == siScomma) {
+		*px = CDR(x);
+		return(EVAL);
+	}
+	if (CAR(x) == siScomma_at || CAR(x) == siScomma_dot)
+		FEerror(",@@ or ,. has appeared in an illegal position.", 0);
+	{ cl_object ax, dx;
+	  a = backq_car(&CAR(x));
+	  d = backq_cdr(&CDR(x));
+	  ax = CAR(x); dx = CDR(x);
+	  if (d == QUOTE)
+		switch (a) {
+		case QUOTE:
+			return(QUOTE);
+
+		case EVAL:
+			if (Null(dx))
+				return(LIST);
+			if (CONSP(dx) && Null(CDR(dx))) {
+				CDR(x) = CONS(kwote(CAR(dx)), Cnil);
+				return(LIST);
+			}
+			CDR(x) = CONS(kwote(dx), Cnil);
+			return(LISTA);
+
+		case APPEND:
+		case NCONC:
+			if (Null(dx)) {
+				*px = ax;
+				return(EVAL);
+			      }
+			CDR(x) = CONS(kwote(dx), Cnil);
+			return(a);
+
+		default:
+			error("backquote botch");
+		}
+	  if (d == EVAL)
+		switch (a) {
+		case QUOTE:
+			CAR(x) = kwote(ax);
+			CDR(x) = CONS(dx, Cnil);
+			return(LISTA);
+
+		case EVAL:
+			CDR(x) = CONS(dx, Cnil);
+			return(LISTA);
+
+		case APPEND:
+		case NCONC:
+			CDR(x) = CONS(dx, Cnil);
+			return(a);
+
+		default:
+			error("backquote botch");
+		}
+	  if (d == a)
+		return(d);
+	  switch (d) {
+	  case LIST:
+		if (a == QUOTE) {
+			CAR(x) = kwote(ax);
+			return(LIST);
+		}
+		if (a == EVAL)
+			return(LIST);
+		attach(Slist);
+		break;
+
+	  case LISTA:
+		if (a == QUOTE) {
+			CAR(x) = kwote(ax);
+			return(LISTA);
+		}
+		if (a == EVAL)
+			return(LISTA);
+		attach(SlistX);
+		break;
+
+	  case APPEND:
+		attach(Sappend);
+		break;
+
+	  case NCONC:
+		attach(Snconc);
+		break;
+
+	  default:
+		error("backquote botch");
+	  }
+	  switch (a) {
+	  case QUOTE:
+		CAR(x) = kwote(ax);
+		CDR(x) = CONS(CDR(x), Cnil);
+		return(LISTA);
+
+	  case EVAL:
+		CDR(x) = CONS(CDR(x), Cnil);
+		return(LISTA);
+
+	  case APPEND:
+	  case NCONC:
+		CDR(x) = CONS(CDR(x), Cnil);
+		return(a);
+
+	  default:
+		error("backquote botch");
+	  }
+	}
+}
+
+/*
+	Backq_car(&x) puts result into x and returns one of
+
+		QUOTE		the form should be quoted
+		EVAL		the form should be evaluated
+		APPEND		the form should be appended
+				into the outer form
+		NCONC		the form should be nconc'ed
+				into the outer form
+*/
+int
+backq_car(cl_object *px)
+{
+	cl_object x = *px;
+	int d;
+
+	cs_check(px);
+
+	if (ATOM(x))
+		return(QUOTE);
+	if (CAR(x) == siScomma) {
+		*px = CDR(x);
+		return(EVAL);
+	}
+	if (CAR(x) == siScomma_at) {
+		*px = CDR(x);
+		return(APPEND);
+	}
+	if (CAR(x) == siScomma_dot) {
+		*px = CDR(x);
+		return(NCONC);
+	}
+	d = backq_cdr(px);
+	switch (d) {
+	case QUOTE:
+	case EVAL:
+		return(d);
+
+	case LIST:
+/*		attach(Slist); */
+		*px = CONS(Slist, *px);
+		break;
+
+	case LISTA:
+/*		attach(SlistX); */
+		*px = CONS(SlistX, *px);
+		break;
+
+	case APPEND:
+/*		attach(Sappend); */
+		*px = CONS(Sappend, *px);
+		break;
+
+	case NCONC:
+/*		attach(Snconc); */
+		*px = CONS(Snconc, *px);
+		break;
+
+	default:
+		error("backquote botch");
+	}
+	return(EVAL);
+}
+
+cl_object
+backq(cl_object x)
+{
+	int a;
+
+	a = backq_car(&x);
+	if (a == APPEND || a == NCONC)
+		FEerror(",@@ or ,. has appeared in an illegal position.", 0);
+	if (a == QUOTE)
+		return(kwote(x));
+	return(x);
+}
+
+@(defun comma_reader (in c)
+	cl_object x, y;
+@
+	if (backq_level <= 0)
+		FEerror("A comma has appeared out of a backquote.", 0);
+	c = peek_char(FALSE, in);
+	if (c == code_char('@@')) {
+		x = siScomma_at;
+		read_char(in);
+	} else if (c == code_char('.')) {
+		x = siScomma_dot;
+		read_char(in);
+	} else
+		x = siScomma;
+	--backq_level;
+	y = read_object(in);
+	backq_level++;
+	@(return CONS(x, y))
+@)
+
+@(defun backquote_reader (in c)
+@
+	backq_level++;
+	in = read_object(in);
+	--backq_level;
+	@(return backq(in))
+@)
+
+#define	make_cf(f)	make_cfun((f), Cnil, NULL);
+
+void
+init_backq(void)
+{
+	cl_object r;
+
+	r = standard_readtable;
+	r->readtable.table['`'].syntax_type = cat_terminating;
+	r->readtable.table['`'].macro = make_cf(Lbackquote_reader);
+	r->readtable.table[','].syntax_type = cat_terminating;
+	r->readtable.table[','].macro = make_cf(Lcomma_reader);
+
+	backq_level = 0;
+}
diff --git a/src/c/big.d b/src/c/big.d
new file mode 100644
index 000000000..ebf37a559
--- /dev/null
+++ b/src/c/big.d
@@ -0,0 +1,269 @@
+/*
+    big.c -- Bignum routines.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+#ifndef THREADS
+cl_object bignum_register[3];
+mp_limb_t bignum_register_limbs[3][BIGNUM_REGISTER_SIZE];
+#endif THREADS
+
+/* 
+ * Using GMP multiple precision integers:
+ *
+ * typedef struct
+ * {
+ *  long int alloc;		// Number of limbs allocated and pointed
+ *				//   to by the D field.
+ *  long int size;		// abs(SIZE) is the number of limbs
+ *				//   the last field points to.  If SIZE
+ *				//   is negative this is a negative number.
+ *  unsigned long int *d;	// Pointer to the limbs,
+ *				//   d[0] is the least significative.
+ * } MP_INT;
+ *
+ * typedef unsigned long int	mp_limb_t;
+ *
+ */
+
+void
+big_register_free(cl_object x)
+{
+	/* FIXME! Is this thread safe? */
+	if (x == bignum_register[0])
+	  x->big.big_limbs = bignum_register_limbs[0];
+	else if (x == bignum_register[1])
+	  x->big.big_limbs = bignum_register_limbs[1];
+	else if (x == bignum_register[2])
+	  x->big.big_limbs = bignum_register_limbs[2];
+	else
+	  error("big_register_free: unknown register");
+	x->big.big_size = 0;
+	x->big.big_dim = BIGNUM_REGISTER_SIZE;
+}
+
+cl_object
+big_register_copy(cl_object old)
+{
+	cl_object new = alloc_object(t_bignum);
+	if (old->big.big_dim > BIGNUM_REGISTER_SIZE) {
+	  /* The object already has suffered a mpz_realloc() so
+	     we can use the pointer */
+	  new->big = old->big;
+	  big_register_free(old);
+	} else {
+	  /* As the bignum points to the bignum_register_limbs[] area
+	     we must duplicate its contents. */
+	  mpz_init_set(new->big.big_num,old->big.big_num);
+	}
+	return new;
+}
+
+cl_object
+big_register_normalize(cl_object x)
+{
+	int s = x->big.big_size;
+	mp_limb_t y;
+	if (s == 0)
+	  return(MAKE_FIXNUM(0));
+	y = x->big.big_limbs[0];
+	if (s == 1 && y <= MOST_POSITIVE_FIX)
+	  return(MAKE_FIXNUM(y));
+	if (s == -1 && y <= MOST_POSITIVE_FIX + 1)
+	  return(MAKE_FIXNUM(-y));
+	return big_register_copy(x);
+}
+
+/*
+ * Different from mpz_init since we initialize with NULL limbs
+ */
+
+cl_object
+big_alloc(int size)
+{
+  volatile cl_object x = alloc_object(t_bignum);
+  if (size <= 0)
+    error("negative or zero size for bignum in big_alloc");
+  x->big.big_dim = size;
+  x->big.big_size = 0;
+  x->big.big_limbs = alloc_atomic_align(size * sizeof(mp_limb_t), sizeof(mp_limb_t));
+  return(x);
+}
+
+cl_object
+bignum1(int val)
+{
+  volatile cl_object z = alloc_object(t_bignum);
+  mpz_init_set_si(z->big.big_num, val);
+  return(z);
+}
+
+cl_object
+bignum2(mp_limb_t hi, mp_limb_t lo)
+{
+  cl_object z;
+
+  z = big_alloc(2);
+  z->big.big_size = 2;
+  z->big.big_limbs[0] = lo;
+  z->big.big_limbs[1] = hi;
+  return(z);
+}
+
+cl_object
+big_copy(cl_object x)
+{
+	volatile cl_object y = alloc_object(t_bignum);
+	mpz_init_set(y->big.big_num, x->big.big_num);
+	return(y);
+}
+
+/*
+	big_zerop(x) tells whether bignum x is zero or not.
+
+#define big_zerop(x)	(mp_size(x->big.big_num) == 0)
+*/
+
+/*
+	big_sign(x) returns
+		something < 0	if x < 0
+		0		if x = 0
+		something > 0	if x > 0.
+
+#define big_sign(x)	(x->big.big_size)
+*/
+
+/*
+	big_compare(x, y) returns
+		-1	if x < y
+		0	if x = y
+		1	if x > y.
+
+#define big_compare(x, y)	mpz_cmp(x->big.big_num, y->big.big_num)
+*/
+
+/*
+	big_complement(x) destructively takes
+	the complement of bignum x.
+
+#define big_complement(x)	mpz_neg(x->big.big_num, x->big.num);
+*/
+
+/*
+	big_minus(x) returns the complement of bignum x.
+*/
+cl_object
+big_minus(cl_object x)
+{
+	volatile cl_object y = big_copy(x);
+	mpz_neg(y->big.big_num, y->big.big_num);
+	return y;
+}
+
+/*
+	big_add_ui(x, i) destructively adds non-negative int i
+	to bignum x.
+	I should be non-negative.
+
+	mpz_add_ui(x->big.big_num, x->big.big_num, i)
+*/
+
+/*
+	big_sub_ui(x, i) destructively subtracts non-negative int i
+	from bignum x.
+	I should be non-negative.
+
+	mpz_sub_ui(x->big.big_num, x->big.big_num, i)
+*/
+
+/*
+	big_mul_ui(x, i) destructively multiplies non-negative bignum x
+	by non-negative int i.
+	I should be non-negative.
+	X should be non-negative.
+
+	mpn_mul(&x->big.big_limbs, &x->big.big_limbs, x->big.big_size, &i, 1)
+*/
+
+/*
+	big_div_ui(x, i) destructively divides non-negative bignum x
+	by positive int i.
+	X will hold the remainder of the division.
+	div_int_big(i, x) returns the remainder of the division.
+	I should be positive.
+	X should be non-negative.
+
+	mp_limb_t q[x->big.big_size];
+	mpn_div(q, &x->big.big_limbs, &x->big.big_size, &i, 1), x
+*/
+
+/*
+	big_plus(x, y) returns the sum of bignum x and bignum y.
+	X and y may be any bignum.
+*/
+cl_object
+big_plus(cl_object x, cl_object y)
+{
+	volatile cl_object z = big_register0_get();
+	mpz_add(z->big.big_num, x->big.big_num, y->big.big_num);
+	return(big_register_copy(z));
+}
+
+cl_object
+big_normalize(cl_object x)
+{
+  int s = x->big.big_size;
+  mp_limb_t y;
+  if (s == 0)
+    return(MAKE_FIXNUM(0));
+  y = x->big.big_limbs[0];
+  if (s == 1 && y <= MOST_POSITIVE_FIX)
+    return(MAKE_FIXNUM(y));
+  if (s == -1 && y <= MOST_POSITIVE_FIX + 1)
+    return(MAKE_FIXNUM(-y));
+  return(x);
+}
+
+static void *
+mp_alloc(size_t size)
+{
+	return alloc_atomic_align(size, sizeof(mp_limb_t));
+}
+
+static void *
+mp_realloc(void *ptr, size_t osize, size_t nsize)
+{
+	void *p = alloc_atomic_align(nsize, sizeof(mp_limb_t));
+	memcpy(p, ptr, osize);
+	return p;
+}
+
+static void
+mp_free(void *ptr, size_t size)
+{
+  /*dealloc(ptr,size);*/
+}
+
+void
+init_big(void)
+{
+	int i;
+	for (i = 0; i < 3; i++) {
+	  bignum_register[i] = alloc_object(t_bignum);
+	  register_root(&bignum_register[i]);
+	  big_register_free(bignum_register[i]);
+	}
+	mp_set_memory_functions(mp_alloc, mp_realloc, mp_free);
+}
diff --git a/src/c/bind.d b/src/c/bind.d
new file mode 100644
index 000000000..a31f0595d
--- /dev/null
+++ b/src/c/bind.d
@@ -0,0 +1,126 @@
+/*
+    bind.c -- Lambda bindings.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "ecls-inl.h"
+
+#define NOT_YET         10
+#define FOUND           11
+#define NOT_KEYWORD     1
+
+void
+parse_key(
+     int narg,			/* number of actual args */
+     cl_object *args,		/* actual args */
+     int nkey,			/* number of keywords */
+     cl_object *keys,		/* keywords for the function */
+     cl_object *vars,		/* where to put values (vars[0..nkey-1])
+				   and suppliedp (vars[nkey..2*nkey-1]) */
+     cl_object rest,		/* rest variable or NULL */
+     bool allow_other_keys)	/* whether other key are allowed */
+{ cl_object *p;
+  int i;
+  cl_object k;
+
+  /* fill in the rest arg list */
+  if (rest != OBJNULL)
+    for (i = narg, p = args; i > 0; i--) {
+      CAR(rest) = *p++;
+      rest = CDR(rest);
+    }
+
+  for (i = 0; i < 2*nkey; i++)
+    vars[i] = Cnil;             /* default values: NIL, supplied: NIL */
+  if (narg <= 0) return;
+
+  /* scan backwards, so that if a keyword is duplicated, first one is used */
+  args = args + narg;
+  top:
+    while (narg >= 2) {
+     args = args - 2;
+     k = args[0];
+     for (i = 0; i < nkey; i++) {
+       if (keys[i] == k) {
+	 vars[i] = args[1];
+	 vars[nkey+i] = Ct;
+	 narg = narg-2;
+	 goto top;
+       }
+     }
+     /* the key is a new one */
+     if (allow_other_keys)
+	 narg = narg-2;
+     else {
+       /* look for :allow-other-keys t */
+       for ( i = narg-2, p = args; i >= 0; i -= 2, p -=2)
+	 if (*p == Kallow_other_keys) {
+	   allow_other_keys = (p[1] != Cnil); break;
+	 }
+       if (allow_other_keys) narg = narg-2;
+       else FEerror("Unrecognized key ~a", 1, k);
+     }
+   }
+  if (narg != 0) FEerror("Odd number of keys", 0);
+}
+
+/* Used in compiled macros */
+void
+check_other_key(cl_object l, int n, ...)
+{
+	cl_object other_key = OBJNULL;
+	cl_object k;
+	int i;
+	bool allow_other_keys = FALSE;
+	va_list ap;
+	va_start(ap, n);                /* extracting arguments */
+
+	for (;  !endp(l);  l = CDDR(l)) {
+		k = CAR(l);
+		if (!keywordp(k))
+			FEerror("~S is not a keyword.", 1, k);
+		if (endp(CDR(l)))
+			FEerror("Odd number of arguments for keywords.", 0);
+		if (k == Kallow_other_keys && CADR(l) != Cnil) {
+			allow_other_keys = TRUE;
+		} else {
+#ifndef NO_ARG_ARRAY
+		        cl_object *ktab = (cl_object *)ap;
+			for (i = 0;  i < n;  i++)
+				if (ktab[i] == k) {
+				  ktab[i] = Cnil; /* remember seen */
+				  break;
+				}
+			if (i >= n) other_key = k;
+#else
+			Rewrite this!
+#endif NO_ARG_ARRAY
+		}
+	}
+	if (other_key != OBJNULL && !allow_other_keys)
+		FEerror("The keyword ~S is not allowed or is duplicated.",
+			1, other_key);
+}
+
+void
+init_bind(void)
+{
+	make_constant("LAMBDA-LIST-KEYWORDS",
+	list(8, SAoptional, SArest, SAkey, SAallow_other_keys, SAaux,
+		make_ordinary("&WHOLE"), make_ordinary("&ENVIRONMENT"), make_ordinary("&BODY")));
+
+	make_constant("LAMBDA-PARAMETERS-LIMIT", MAKE_FIXNUM(64));
+}
diff --git a/src/c/cfun.d b/src/c/cfun.d
new file mode 100644
index 000000000..603941bf1
--- /dev/null
+++ b/src/c/cfun.d
@@ -0,0 +1,259 @@
+/*
+    cfun.c -- Compiled functions.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include <string.h>	/* for memmove() */
+
+#ifdef PDE
+extern cl_object Sdefun, Sdefmacro;
+#endif PDE
+
+static void record_fun_entry (cl_object sym, void *addr);
+
+cl_object
+make_cfun(cl_object (*self)(), cl_object name, cl_object cblock)
+{
+	cl_object cf;
+
+	cf = alloc_object(t_cfun);
+	cf->cfun.entry = self;
+	cf->cfun.name = name;
+	cf->cfun.block = cblock;
+	return(cf);
+}
+
+cl_object
+make_cclosure(cl_object (*self)(), cl_object env, cl_object block)
+{
+	cl_object cc;
+
+	cc = alloc_object(t_cclosure);
+	cc->cclosure.entry = self;
+	cc->cclosure.env = env;
+	cc->cclosure.block = block;
+	return(cc);
+}
+
+void
+MF(cl_object sym, cl_object (*self)(), cl_object block)
+{
+	cl_object cf;
+
+	if (!SYMBOLP(sym))
+		FEtype_error_symbol(sym);
+	if (sym->symbol.isform && sym->symbol.mflag)
+		sym->symbol.isform = FALSE;
+	clear_compiler_properties(sym);
+#ifndef RUNTIME
+	record_fun_entry(sym, self);
+#endif
+#ifdef PDE
+	record_source_pathname(sym, Sdefun);
+#endif PDE
+	cf = alloc_object(t_cfun);
+	cf->cfun.entry = self;
+	cf->cfun.name = sym;
+	cf->cfun.block = block;
+	SYM_FUN(sym) = cf;
+	sym->symbol.mflag = FALSE;
+}
+
+void
+MM(cl_object sym, cl_object (*self)(), cl_object block)
+{
+	cl_object cf;
+
+	if (!SYMBOLP(sym))
+		FEtype_error_symbol(sym);
+	if (sym->symbol.isform && sym->symbol.mflag)
+		sym->symbol.isform = FALSE;
+	clear_compiler_properties(sym);
+#ifndef RUNTIME
+	record_fun_entry(sym, self);
+#endif
+#ifdef PDE
+	record_source_pathname(sym, Sdefmacro);
+#endif PDE
+	cf = alloc_object(t_cfun);
+	cf->cfun.entry = self;
+	cf->cfun.name = sym;
+	cf->cfun.block = block;
+	SYM_FUN(sym) = cf;
+	sym->symbol.mflag = TRUE;
+}
+
+cl_object
+make_function(char *s, cl_object (*f)())
+{
+	cl_object x;
+
+	x = make_ordinary(s);
+	SYM_FUN(x) = make_cfun(f, x, NULL);
+	x->symbol.mflag = FALSE;
+#ifndef RUNTIME
+	record_fun_entry(x, f);
+#endif
+	return(x);
+}
+
+cl_object
+make_si_function(char *s, cl_object (*f)())
+{
+	cl_object x;
+
+	x = make_si_ordinary(s);
+	SYM_FUN(x) = make_cfun(f, x, NULL);
+	x->symbol.mflag = FALSE;
+#ifndef RUNTIME
+	record_fun_entry(x, f);
+#endif
+	return(x);
+}
+
+@(defun si::compiled_function_name (fun)
+	cl_object output;
+@
+	switch(type_of(fun)) {
+	case t_bytecodes:
+		output = fun->bytecodes.data[0]; break;
+	case t_cfun:
+		output = fun->cfun.name; break;
+	case t_cclosure:
+		output = Cnil; break;
+	default:
+		FEerror("~S is not a compiled-function.", 1, fun);
+	}
+	@(return output)
+@)
+
+@(defun si::compiled_function_block (fun)
+       cl_object output;
+@
+       switch(type_of(fun)) {
+	case t_cfun:
+		output = fun->cfun.block; break;
+	case t_cclosure:
+		output = fun->cclosure.block; break;
+	default:
+		FEerror("~S is not a compiled-function.", 1, fun);
+	}
+	@(return output)
+@)
+
+
+#ifndef RUNTIME
+
+#define FUN_TABLE_INC 256
+void **function_entry_table;
+int function_entries_max;
+int function_entries;
+
+/*----------------------------------------------------------------------
+ * fun_entry_search --
+ *	function_entry_table is an array containing alternated addr, sym values
+ *	sorted in increasing addr value.
+ * Result:
+ *	  the index of the largest addr which is smaller than key
+ *	  -2 if no such addr is present
+ *----------------------------------------------------------------------
+ */
+static int
+fun_entry_search(char *key)
+{
+  void **table = function_entry_table;
+  int len = function_entries;
+  int low = 0;
+  int high = len;
+  int mid, probe;
+  char *entry;
+  if (len == 0)
+    return(-2);
+  while (TRUE) {
+    mid = (low + high) / 2;
+    probe = mid * 2;
+    entry = (char *)table[probe];
+    if (entry == key)
+      return(probe);
+    if (entry < key) {
+      if (mid + 1 == len || (char*)table[probe+2] > key)
+	return(probe);
+      else
+	low = mid;
+    } else {
+      if (probe == 0)
+	return(-2);
+      else
+	high = mid;
+    }
+  }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * record_fun_entry --
+ *	records the code start of function bound to symbol, so that
+ *	one can determine which function is executing
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+record_fun_entry(cl_object sym, void *addr)
+{
+  cl_object def;
+  register int i, end;
+
+  end = 2*function_entries;
+  def = SYM_FUN(sym);
+  if (def != OBJNULL && type_of(def) == t_cfun) {
+    /* clear previous definition */
+    void *prevaddr = (void *)def->cfun.entry;
+    i = fun_entry_search(prevaddr);
+    if (i >= 0 && function_entry_table[i] == prevaddr) {
+      function_entries--;
+      end -= 2;
+      memmove(&function_entry_table[i], &function_entry_table[i+2],
+	      sizeof(void *) * (end - i));
+    }
+  }
+  i = fun_entry_search(addr);
+  if (i < 0 || function_entry_table[i] != (char*)addr) {
+    if (2*function_entries_max == end) {
+      function_entries_max += FUN_TABLE_INC;
+      function_entry_table = realloc(function_entry_table,
+				     2 * function_entries_max * sizeof(void *));
+    }
+    i += 2;
+    memmove(&function_entry_table[i+2], &function_entry_table[i],
+	   sizeof(void *) * (end - i));
+    function_entries++;
+  }
+  function_entry_table[i++] = (char *)addr;
+  function_entry_table[i++] = (char *)sym;
+}
+
+cl_object
+get_function_entry(void *addr)
+{
+  int i;
+  i = fun_entry_search(addr);
+  if (i >= 0)
+    return((cl_object)function_entry_table[i+1]);
+  else
+    return(OBJNULL);
+}
+
+#endif RUNTIME
diff --git a/src/c/character.d b/src/c/character.d
new file mode 100644
index 000000000..d9609a627
--- /dev/null
+++ b/src/c/character.d
@@ -0,0 +1,464 @@
+/*
+    character.d -- Character routines.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include <ctype.h>
+
+/******************************* EXPORTS ******************************/
+
+cl_object STreturn;
+cl_object STspace;
+cl_object STrubout;
+cl_object STpage;
+cl_object STtab;
+cl_object STbackspace;
+cl_object STlinefeed;
+cl_object STnewline;
+cl_object STnull;
+
+/******************************* ------- ******************************/
+
+cl_fixnum
+char_code(cl_object c)
+{
+	if (CHARACTERP(c))
+		return CHAR_CODE(c);
+	FEtype_error_character(c);
+}
+
+@(defun standard_char_p (c)
+	cl_fixnum i;
+@
+	/* INV: char_code() checks the type */
+	i = char_code(c);
+	if ((' ' <= i && i < '\177') || i == '\n')
+		@(return Ct)
+	@(return Cnil)
+@)
+
+@(defun graphic_char_p (c)
+	cl_fixnum i;
+@
+	/* INV: char_code() checks the type */
+	i = char_code(c);
+	if (' ' <= i && i < '\177')     /* ' ' < '\177'  ??? Beppe*/
+		@(return Ct)
+	@(return Cnil)
+@)
+
+@(defun alpha_char_p (c)
+	cl_fixnum i;
+@
+	/* INV: char_code() checks the type */
+	i = char_code(c);
+	if (isalpha(i))
+		@(return Ct)
+	else
+		@(return Cnil)
+@)
+
+@(defun upper_case_p (c)
+@
+	/* INV: char_code() checks the type */
+	if (isupper(char_code(c)))
+		@(return Ct)
+	@(return Cnil)
+@)
+
+@(defun lower_case_p (c)
+@
+	/* INV: char_code() checks the type */
+	if (islower(char_code(c)))
+		@(return Ct)
+	@(return Cnil)
+@)
+
+@(defun both_case_p (c)
+	cl_fixnum code;
+@
+	/* INV: char_code() checks the type */
+	code = char_code(c);
+	@(return ((isupper(code) || islower(code)) ? Ct : Cnil))
+@)
+
+#define basep(d)	(d <= 36)
+
+@(defun digit_char_p (c &optional (r MAKE_FIXNUM(10)))
+	cl_fixnum d;
+@
+	/* INV: char_code() checks `c' and fixnnint() checks `r' */
+	if (type_of(r) == t_bignum)
+		@(return Cnil)
+	d = fixnnint(r);
+	if (!basep(d) || (d = digitp(char_code(c), d)) < 0)
+		@(return Cnil)
+	@(return MAKE_FIXNUM(d))
+@)
+
+/*
+	Digitp(i, r) returns the weight of code i
+	as a digit of radix r, which must be 1 < r <= 36.
+	If i is not a digit, -1 is returned.
+*/
+int
+digitp(int i, int r)
+{
+	if (('0' <= i) && (i <= '9') && (i < '0' + r))
+		return(i - '0');
+	if (('A' <= i) && (10 < r) && (i < 'A' + (r - 10)))
+		return(i - 'A' + 10);
+	if (('a' <= i) && (10 < r) && (i < 'a' + (r - 10)))
+		return(i - 'a' + 10);
+	return(-1);
+}
+
+@(defun alphanumericp (c)
+	cl_fixnum i;
+@
+	/* INV: char_code() checks type of `c' */
+	i = char_code(c);
+	if (isalnum(i))
+		@(return Ct)
+	else
+		@(return Cnil)
+@)
+
+@(defun char_eq (c &rest cs)
+	cl_fixnum i;
+@
+	/* INV: char_eq() checks types of `c' and `cs' */
+	for (narg--, i = 0;  i < narg;  i++) {
+		if (!char_eq(c, ((cl_object *)cs)[i]))
+			@(return Cnil)
+	}
+	@(return Ct)
+@)
+
+bool
+char_eq(cl_object x, cl_object y)
+{
+	return char_code(x) == char_code(y);
+}
+
+@(defun char_neq (&rest cs)
+	int i, j;
+@
+	/* INV: char_eq() checks types of its arguments */
+	if (narg == 0)
+		@(return Ct)
+	for (i = 0;  i < narg;  i++) {
+		for (j = 0;  j < i;  j++)
+			if (char_eq(((cl_object *)cs)[j], ((cl_object *)cs)[i]))
+				@(return Cnil)
+	}
+	@(return Ct)
+@)
+
+static cl_return
+Lchar_cmp(int narg, int s, int t, cl_object *args)
+{
+	int i;
+
+	if (narg == 0)
+		FEtoo_few_arguments(&narg);
+	for (i = 1; i < narg; i++)
+		if (s*char_cmp(args[i], args[i-1]) < t)
+			return1(Cnil);
+	return1(Ct);
+}
+
+int
+char_cmp(cl_object x, cl_object y)
+{
+	cl_fixnum cx = char_code(x);
+	cl_fixnum cy = char_code(y);
+	if (cx < cy)
+		return(-1);
+	if (cx > cy)
+		return(1);
+	return(0);
+}
+
+cl_return
+Lchar_l(int narg, ...)
+{ va_list(args); va_start(args, narg);
+  return Lchar_cmp(narg, 1, 1, (cl_object *)args);}
+cl_return
+Lchar_g(int narg, ...)
+{ va_list(args); va_start(args, narg);
+  return Lchar_cmp(narg,-1, 1, (cl_object *)args);}
+cl_return
+Lchar_le(int narg, ...)
+{ va_list(args); va_start(args, narg);
+  Lchar_cmp(narg, 1, 0, (cl_object *)args);}
+cl_return
+Lchar_ge(int narg, ...)
+{ va_list(args); va_start(args, narg);
+  Lchar_cmp(narg,-1, 0, (cl_object *)args);}
+
+@(defun char_equal (c &rest cs)
+	int i;
+@
+	/* INV: char_equal() checks the type of its arguments */
+	for (narg--, i = 0;  i < narg;  i++) {
+		if (!char_equal(c, ((cl_object *)cs)[i]))
+			@(return Cnil)
+	}
+	@(return Ct)
+@)
+
+bool
+char_equal(cl_object x, cl_object y)
+{
+	cl_fixnum i = char_code(x);
+	cl_fixnum j = char_code(y);
+
+	if (islower(i))
+		i = toupper(i);
+	if (islower(j))
+		j = toupper(j);
+	return(i == j);
+}
+
+@(defun char_not_equal (&rest cs)
+	int i, j;
+@
+	/* INV: char_equal() checks the type of its arguments */
+	for (i = 0;  i < narg;  i++) {
+		for (j = 0;  j < i;  j++)
+			if (char_equal(((cl_object *)cs)[j], ((cl_object *)cs)[i]))
+				@(return Cnil)
+	}
+	@(return Ct)
+@)
+
+static cl_return
+Lchar_compare(int narg, int s, int t, cl_object *args)
+{
+	int i;
+
+	/* INV: char_compare() checks the types of its arguments */
+	if (narg == 0)
+		FEtoo_few_arguments(&narg);
+	for (i = 1; i < narg; i++)
+		if (s*char_compare(args[i], args[i-1]) < t)
+			return1(Cnil);
+	return1(Ct);
+}
+
+int
+char_compare(cl_object x, cl_object y)
+{
+	cl_fixnum i = char_code(x);
+	cl_fixnum j = char_code(y);
+
+	if (islower(i))
+		i = toupper(i);
+	if (islower(j))
+		j = toupper(j);
+	if (i < j)
+		return(-1);
+	else if (i == j)
+		return(0);
+	else
+		return(1);
+}
+
+cl_return
+Lchar_lessp(int narg, ...)
+{ va_list(args); va_start(args, narg);
+  return Lchar_compare(narg, 1, 1, (cl_object *)args);}
+cl_return
+Lchar_greaterp(int narg, ...)
+{ va_list(args); va_start(args, narg);
+  return Lchar_compare(narg,-1, 1, (cl_object *)args);}
+cl_return
+Lchar_not_greaterp(int narg, ...)
+{ va_list(args); va_start(args, narg);
+  return Lchar_compare(narg, 1, 0, (cl_object *)args);}
+cl_return
+Lchar_not_lessp(int narg, ...)
+{ va_list(args); va_start(args, narg);
+  return Lchar_compare(narg,-1, 0, (cl_object *)args);}
+
+
+@(defun character (x)
+@
+	@(return coerce_to_character(x))
+@)
+
+cl_object
+coerce_to_character(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_character:
+		return x;
+	case t_symbol:
+		x = x->symbol.name;
+	case t_string:
+		if (x->string.fillp == 1)
+			return(code_char(x->string.self[0]));
+	default:
+		FEtype_error_character(x);
+	}
+}
+
+@(defun char_code (c)
+@
+	/* INV: char_code() checks the type of `c' */
+	@(return MAKE_FIXNUM(char_code(c)))
+@)
+
+@(defun code_char (c)
+	cl_fixnum fc;
+@
+	/* INV: fixnnint() checks the type of `c' */
+	if (type_of(c) == t_bignum)
+		@(return Cnil)
+	if ((fc = fixnnint(c)) >= CHCODELIM)
+		@(return Cnil)
+	@(return code_char(fc))
+@)
+
+@(defun char_upcase (c)
+	cl_fixnum code;
+@
+	/* INV: char_code() checks the type of `c' */
+	code = char_code(c);
+	@(return (islower(char_code(c)) ?
+				code_char(toupper(char_code(c))) :
+				c))
+@)
+
+@(defun char_downcase (c)
+	cl_fixnum code;
+@
+	/* INV: char_code() checks the type of `c' */
+	code = char_code(c);
+	@(return (isupper(char_code(c)) ?
+				code_char(tolower(char_code(c))) :
+				c))
+@)
+
+@(defun digit_char (w &optional (r MAKE_FIXNUM(10)))
+	int dw;
+@
+	/* INV: fixnnint() checks the types of `w' and `r' */
+	if (type_of(w) == t_bignum || type_of(r) == t_bignum)
+		@(return Cnil)
+	dw = digit_weight(fixnnint(w), fixnnint(r));
+	if (dw < 0)
+		@(return Cnil)
+	@(return code_char(dw))
+@)
+
+short
+digit_weight(int w, int r)
+{
+	if (r < 2 || r > 36 || w < 0 || w >= r)
+		return(-1);
+	if (w < 10)
+		return(w + '0');
+	else
+		return(w - 10 + 'A');
+}
+
+@(defun char_int (c)
+@
+	/* INV: char_int() checks the type of `c' */
+	@(return MAKE_FIXNUM(char_int(c)))
+@)
+
+@(defun int_char (x)
+@
+	/* INV: fixnnint(x) checks the type of `c' */
+	if (type_of(x) == t_bignum)
+		@(return Cnil)
+	@(return int_char(fixnnint(x)))
+@)
+
+@(defun char_name (c)
+@
+	/* INV: char_code() checks the type of `c' */
+	switch (char_code(c)) {
+	case '0':
+		@(return STnull)
+	case '\r':
+		@(return STreturn)
+	case ' ':
+		@(return STspace)
+	case '\177':
+		@(return STrubout)
+	case '\f':
+		@(return STpage)
+	case '\t':
+		@(return STtab)
+	case '\b':
+		@(return STbackspace)
+	case '\n':
+		@(return STnewline)
+	}
+	@(return Cnil)
+@)
+
+@(defun name_char (s)
+	char c;
+@
+	s = coerce_to_string(s);
+	if (string_equal(s, STreturn))
+		c = '\r'; else
+	if (string_equal(s, STspace))
+		c = ' '; else
+	if (string_equal(s, STrubout))
+		c = '\177'; else
+	if (string_equal(s, STpage))
+		c = '\f'; else
+	if (string_equal(s, STtab))
+		c = '\t'; else
+	if (string_equal(s, STbackspace))
+		c = '\b'; else
+	if (string_equal(s, STlinefeed) || string_equal(s, STnewline))
+		c = '\n'; else
+	if (string_equal(s, STnull))
+		c = '\000'; else
+		@(return Cnil)
+	@(return code_char(c))
+@)
+
+void
+init_character(void)
+{
+	make_constant("CHAR-CODE-LIMIT", MAKE_FIXNUM(CHCODELIM));
+
+	STreturn = make_simple_string("RETURN");
+	register_root(&STreturn);
+	STspace = make_simple_string("SPACE");
+	register_root(&STspace);
+	STrubout = make_simple_string("RUBOUT");
+	register_root(&STrubout);
+	STpage = make_simple_string("PAGE");
+	register_root(&STpage);
+	STtab = make_simple_string("TAB");
+	register_root(&STtab);
+	STbackspace = make_simple_string("BACKSPACE");
+	register_root(&STbackspace);
+	STlinefeed = make_simple_string("LINEFEED");
+	register_root(&STlinefeed);
+	STnull = make_simple_string("NULL");
+	register_root(&STnull);
+	STnewline = make_simple_string("NEWLINE");
+	register_root(&STnewline);
+}
diff --git a/src/c/cinit.d b/src/c/cinit.d
new file mode 100644
index 000000000..85d28ae21
--- /dev/null
+++ b/src/c/cinit.d
@@ -0,0 +1,53 @@
+/*
+    init.c  -- Lisp Initialization.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+static
+@(defun si::simple_toplevel ()
+	cl_object sentence;
+	cl_object lex_old = lex_env;
+@
+	/* Simple minded top level loop */
+	printf(";*** Lisp core booted ****\nECLS (Embeddable Common Lisp)  %d pages\n", MAXPAGE);
+	fflush(stdout);
+#ifdef TK
+	StdinResume();
+#endif
+	lex_new();
+	while (1) {
+	  cl_object bytecodes = Cnil;
+	  printf("\n> ");
+	  sentence = Lread(3, Cnil, Cnil, OBJNULL);
+	  if (sentence == OBJNULL)
+	    @(return);
+	  prin1(eval(sentence, &bytecodes), Cnil);
+#ifdef TK
+	  StdinResume();
+#endif
+	}
+	lex_env = lex_old;
+@)
+
+void
+init_lisp_libs(void)
+{
+	SYM_VAL(Vpackage) = system_package;
+	SYM_VAL(Vfeatures) = CONS(make_keyword("ECLS-MIN"), SYM_VAL(Vfeatures));
+#ifdef RSYM
+	SYM_VAL(siVsymbol_table) = make_simple_string("ecls_min.sym");
+#endif
+	make_si_function("TOP-LEVEL", siLsimple_toplevel);
+}
diff --git a/src/c/clos.d b/src/c/clos.d
new file mode 100644
index 000000000..a4c129fa5
--- /dev/null
+++ b/src/c/clos.d
@@ -0,0 +1,115 @@
+/*
+    clos.c -- CLOS bootstrap.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+
+#include "ecls.h"
+
+/******************************* EXPORTS ******************************/
+
+cl_object class_class, class_object, class_built_in;
+
+/******************************* ------- ******************************/
+
+cl_object siSXclass_name_hash_tableX;
+cl_object Sclass;
+cl_object Sbuilt_in;
+
+static cl_object
+make_our_hash_table(cl_object test, int size)
+{
+	enum httest htt;
+	int i;
+	cl_object rehash_size, rehash_threshold, h;
+
+	rehash_size = make_shortfloat(1.5);
+	rehash_threshold = make_shortfloat(0.7);
+
+	if (test == Seq)
+		htt = htt_eq;
+	else if (test == Seql)
+		htt = htt_eql;
+	else if (test == Sequal)
+		htt = htt_equal;
+
+	h = alloc_object(t_hashtable);
+	h->hash.data = NULL;	/* for GC sake */
+	h->hash.test = (short)htt;
+	h->hash.size = size;
+	h->hash.rehash_size = rehash_size;
+	h->hash.threshold = rehash_threshold;
+        h->hash.entries = 0;
+	h->hash.data = alloc_align(size * sizeof(struct hashtable_entry), sizeof(int));
+	for(i = 0;  i < size;  i++) {
+		h->hash.data[i].key = OBJNULL;
+		h->hash.data[i].value = OBJNULL;
+	}
+	return(h);
+}
+
+static void
+clos_boot(void)
+{
+
+	SYM_VAL(siSXclass_name_hash_tableX) = make_our_hash_table(Seq, 1024);
+
+	/* booting Class CLASS */
+	
+  	class_class = alloc_instance(4);
+	register_root(&class_class);
+	class_class->instance.class = class_class;
+	CLASS_NAME(class_class) = Sclass;
+	CLASS_SUPERIORS(class_class) = Cnil;
+	CLASS_INFERIORS(class_class) = Cnil;
+	CLASS_SLOTS(class_class) = OBJNULL;	/* filled later */
+
+	sethash(Sclass, SYM_VAL(siSXclass_name_hash_tableX), class_class);
+
+	/* booting Class BUILT-IN */
+	
+  	class_built_in = alloc_instance(4);
+	register_root(&class_built_in);
+	class_built_in->instance.class = class_class;
+	CLASS_NAME(class_built_in) = Sbuilt_in;
+	CLASS_SUPERIORS(class_built_in) = CONS(class_class, Cnil);
+	CLASS_INFERIORS(class_built_in) = Cnil;
+	CLASS_SLOTS(class_built_in) = OBJNULL;	/* filled later */
+
+	sethash(Sbuilt_in, SYM_VAL(siSXclass_name_hash_tableX), class_built_in);
+
+	/* booting Class T (= OBJECT) */
+	
+  	class_object = alloc_instance(4);
+	register_root(&class_object);
+	class_object->instance.class = class_built_in;
+	CLASS_NAME(class_object) = St;
+	CLASS_SUPERIORS(class_object) = Cnil;
+	CLASS_INFERIORS(class_object) = CONS(class_class, Cnil);
+	CLASS_SLOTS(class_object) = Cnil;
+
+	sethash(St, SYM_VAL(siSXclass_name_hash_tableX), class_object);
+
+	/* complete now Class CLASS */
+	CLASS_SUPERIORS(class_class) = CONS(class_object, Cnil);
+	CLASS_INFERIORS(class_class) = CONS(class_built_in, Cnil);
+}
+
+void
+init_clos(void)
+{
+	SYM_VAL(siSXclass_name_hash_tableX) = OBJNULL;
+
+	clos_boot();
+}
diff --git a/src/c/cmpaux.d b/src/c/cmpaux.d
new file mode 100644
index 000000000..414945ec6
--- /dev/null
+++ b/src/c/cmpaux.d
@@ -0,0 +1,328 @@
+/*
+    cmpaux.c -- Auxiliaries used in compiled Lisp code.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "ecls-inl.h"
+
+cl_object SAoptional;
+cl_object SArest;
+cl_object SAkey;
+cl_object SAallow_other_keys;
+cl_object SAaux;
+cl_object Kallow_other_keys;
+
+cl_object
+make_list(int i)
+{
+  cl_object x = Cnil;
+  while (i-- > 0)
+    x = CONS(Cnil, x);
+  return x;
+}
+
+@(defun si::specialp (sym)
+@
+	@(return ((SYMBOLP(sym) && sym->symbol.stype == stp_special) ?
+		   Ct : Cnil))
+@)
+
+int
+ifloor(int x, int y)
+{
+	if (y == 0)
+		FEerror("Zero divizor", 0);
+	else if (y > 0)
+		if (x >= 0)
+			return(x/y);
+		else
+			return(-((-x+y-1))/y);
+	else
+		if (x >= 0)
+			return(-((x-y-1)/(-y)));
+		else
+			return((-x)/(-y));
+}
+
+int
+imod(int x, int y)
+{
+	return(x - ifloor(x, y)*y);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *	Conversions to C
+ * ----------------------------------------------------------------------
+ */
+
+char
+object_to_char(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+		return fix(x);
+	case t_bignum:
+		return big_to_long(x) & (CHCODELIM - 1);
+	case t_character:
+		return CHAR_CODE(x);
+	default:
+		FEerror("~S cannot be coerced to a C char.", 1, x);
+	}
+}
+
+int
+object_to_int(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+		return fix(x);
+	case t_character:
+		return CHAR_CODE(x);
+	case t_bignum:
+		return big_to_long(x);
+	case t_ratio:
+		return number_to_double(x);
+	case t_shortfloat:
+		return sf(x);
+	case t_longfloat:
+		return lf(x);
+	default:
+		FEerror("~S cannot be coerced to a C int.", 1, x);
+	}
+}
+
+char *
+object_to_string(cl_object x)
+{
+  extern VOID *malloc(size_t size);
+  switch (type_of(x)) {
+  case t_string:
+  case t_symbol:
+    return(x->string.self);
+  case t_fixnum: {
+    char *num = malloc(12);
+    sprintf(num, "%ld", (long)fix(x));
+    return(num);
+  }
+  case t_character: {
+    char *c = malloc(2);
+    c[0] = CHAR_CODE(x);
+    c[1] = '\0';
+    return c;
+  }
+  case t_pathname:
+    return namestring(x)->string.self;
+  default:
+    FEerror("~S cannot be coerced to a C string.", 1, x);
+  }
+}
+
+float
+object_to_float(cl_object x)
+{
+	if (FIXNUMP(x)) return(fix(x));	/* Immediate fixnum */
+
+	switch (type_of(x)) {
+	  /*	case t_fixnum: return fix(x);	*/
+	case t_character:
+		return CHAR_CODE(x);
+	case t_bignum:
+	case t_ratio:
+		return number_to_double(x);
+	case t_shortfloat:
+		return sf(x);
+	case t_longfloat:
+		return lf(x);
+	default:
+		FEerror("~S cannot be coerced to a C float.", 1, x);
+	}
+}
+
+double
+object_to_double(cl_object x)
+{
+
+	if (FIXNUMP(x)) return(fix(x));	/* Immediate fixnum */
+
+	switch (type_of(x)) {
+	  /*	case t_fixnum: return fix(x);	*/
+	case t_character:
+		return CHAR_CODE(x);
+	case t_bignum:
+	case t_ratio:
+		return number_to_double(x);
+	case t_shortfloat:
+		return sf(x);
+	case t_longfloat:
+		return lf(x);
+	default:
+		FEerror("~S cannot be coerced to a C double.", 1, x);
+	}
+}
+
+int
+aref_bv(cl_object x, cl_index index)
+{
+  index += x->vector.offset;
+  return ((x->vector.self.bit[index/CHAR_BIT] & (0200>>index%CHAR_BIT)) != 0);
+}
+
+int
+aset_bv(cl_object x, cl_index index, int value)
+{
+  index += x->vector.offset;
+  if (value == 0)
+    x->vector.self.bit[index/CHAR_BIT] &= ~(0200>>index%CHAR_BIT);
+  else
+    x->vector.self.bit[index/CHAR_BIT] |= 0200>>index%CHAR_BIT;
+  return value;
+}
+
+void
+throw(cl_object tag)
+{
+  frame_ptr fr = frs_sch_catch(tag);
+  if (fr == NULL)
+    FEcontrol_error("THROW: The catch ~S is undefined.", 1, tag);
+  unwind(fr, tag);
+}
+
+void
+return_from(cl_object block_id, cl_object block_name)
+{
+  frame_ptr fr = frs_sch(block_id);
+  if (fr == NULL)
+    FEcontrol_error("RETURN-FROM: The block ~S with id ~S is missing.",
+		    2, block_name, block_id);
+  unwind(fr, block_name);
+}
+
+void
+go(cl_object tag_id, cl_object label)
+{
+  frame_ptr fr = frs_sch(tag_id);
+  if (fr == NULL)
+    FEcontrol_error("GO: The tagbody ~S is missing.", 1, tag_id);
+  unwind(fr, label);
+}
+
+#define NOT_YET         10
+#define FOUND           11
+#define NOT_KEYWORD     1
+
+void
+parse_key(
+     int narg,			/* number of actual args */
+     cl_object *args,		/* actual args */
+     int nkey,			/* number of keywords */
+     cl_object *keys,		/* keywords for the function */
+     cl_object *vars,		/* where to put values (vars[0..nkey-1])
+				   and suppliedp (vars[nkey..2*nkey-1]) */
+     cl_object rest,		/* rest variable or NULL */
+     bool allow_other_keys)	/* whether other key are allowed */
+{ cl_object *p;
+  int i;
+  cl_object k;
+
+  /* fill in the rest arg list */
+  if (rest != OBJNULL)
+    for (i = narg, p = args; i > 0; i--) {
+      CAR(rest) = *p++;
+      rest = CDR(rest);
+    }
+
+  for (i = 0; i < 2*nkey; i++)
+    vars[i] = Cnil;             /* default values: NIL, supplied: NIL */
+  if (narg <= 0) return;
+
+  /* scan backwards, so that if a keyword is duplicated, first one is used */
+  args = args + narg;
+  top:
+    while (narg >= 2) {
+     args = args - 2;
+     k = args[0];
+     for (i = 0; i < nkey; i++) {
+       if (keys[i] == k) {
+	 vars[i] = args[1];
+	 vars[nkey+i] = Ct;
+	 narg = narg-2;
+	 goto top;
+       }
+     }
+     /* the key is a new one */
+     if (allow_other_keys)
+	 narg = narg-2;
+     else {
+       /* look for :allow-other-keys t */
+       for ( i = narg-2, p = args; i >= 0; i -= 2, p -=2)
+	 if (*p == Kallow_other_keys) {
+	   allow_other_keys = (p[1] != Cnil); break;
+	 }
+       if (allow_other_keys) narg = narg-2;
+       else FEprogram_error("Unrecognized key ~a", 1, k);
+     }
+   }
+  if (narg != 0) FEprogram_error("Odd number of keys", 0);
+}
+
+/* Used in compiled macros */
+void
+check_other_key(cl_object l, int n, ...)
+{
+	cl_object other_key = OBJNULL;
+	cl_object k;
+	int i;
+	bool allow_other_keys = FALSE;
+	va_list ap;
+	va_start(ap, n);                /* extracting arguments */
+
+	for (;  !endp(l);  l = CDDR(l)) {
+		k = CAR(l);
+		if (!keywordp(k))
+			FEprogram_error("~S is not a keyword.", 1, k);
+		if (endp(CDR(l)))
+			FEprogram_error("Odd number of arguments for keywords.",0);
+		if (k == Kallow_other_keys && CADR(l) != Cnil) {
+			allow_other_keys = TRUE;
+		} else {
+#ifndef NO_ARG_ARRAY
+		        cl_object *ktab = (cl_object *)ap;
+			for (i = 0;  i < n;  i++)
+				if (ktab[i] == k) {
+				  ktab[i] = Cnil; /* remember seen */
+				  break;
+				}
+			if (i >= n) other_key = k;
+#else
+			Rewrite this!
+#endif NO_ARG_ARRAY
+		}
+	}
+	if (other_key != OBJNULL && !allow_other_keys)
+		FEprogram_error("The keyword ~S is not allowed or is duplicated.",
+				1, other_key);
+}
+
+void
+init_cmpaux(void)
+{
+	make_constant("LAMBDA-LIST-KEYWORDS",
+	list(8, SAoptional, SArest, SAkey, SAallow_other_keys, SAaux,
+		make_ordinary("&WHOLE"), make_ordinary("&ENVIRONMENT"), make_ordinary("&BODY")));
+
+	make_constant("LAMBDA-PARAMETERS-LIMIT", MAKE_FIXNUM(64));
+}
diff --git a/src/c/compiler.d b/src/c/compiler.d
new file mode 100644
index 000000000..4a5835797
--- /dev/null
+++ b/src/c/compiler.d
@@ -0,0 +1,2100 @@
+/*
+    compiler.c -- Bytecode compiler
+*/
+/*
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include "ecls-inl.h"
+#include "bytecodes.h"
+
+/********************* EXPORTS *********************/
+
+cl_object siSlambda_block;
+cl_object Sdeclare;
+cl_object Sdefun;
+cl_object Scompile, Sload, Seval, Sprogn, Swarn, Stypep, Sotherwise;
+cl_object Kexecute, Kcompile_toplevel, Kload_toplevel;
+cl_object siVinhibit_macro_special;
+
+cl_object SAoptional;
+cl_object SArest;
+cl_object SAkey;
+cl_object SAallow_other_keys;
+cl_object SAaux;
+
+cl_object Kallow_other_keys;
+
+cl_object bytecodes;
+
+/********************* PRIVATE ********************/
+
+static cl_index asm_begin(void);
+static cl_object asm_end(cl_index);
+static void asm_clear(cl_index);
+static void asm_grow(void);
+static void asm1(register cl_object op);
+static void asm_op(register int n);
+static void asm_list(register cl_object l);
+static void asmn(int narg, ...);
+static void asm_at(register cl_index where, register cl_object what);
+static cl_index asm_jmp(register int op);
+static void asm_complete(register int op, register cl_index original);
+static cl_index current_pc();
+static void set_pc(cl_index pc);
+static cl_object asm_ref(register cl_index where);
+
+static void c_and(cl_object args);
+static void c_block(cl_object args);
+static void c_case(cl_object args);
+static void c_catch(cl_object args);
+static void c_cond(cl_object args);
+static void c_do(cl_object args);
+static void c_doa(cl_object args);
+static void c_dolist(cl_object args);
+static void c_dotimes(cl_object args);
+static void c_eval_when(cl_object args);
+static void c_flet(cl_object args);
+static void c_function(cl_object args);
+static void c_go(cl_object args);
+static void c_if(cl_object args);
+static void c_labels(cl_object args);
+static void c_let(cl_object args);
+static void c_leta(cl_object args);
+static void c_macrolet(cl_object args);
+static void c_multiple_value_bind(cl_object args);
+static void c_multiple_value_call(cl_object args);
+static void c_multiple_value_prog1(cl_object args);
+static void c_multiple_value_setq(cl_object args);
+static void c_nth_value(cl_object args);
+static void c_or(cl_object args);
+static void c_progv(cl_object args);
+static void c_psetq(cl_object args);
+static void c_values(cl_object args);
+static void c_setq(cl_object args);
+static void c_return(cl_object args);
+static void c_return_from(cl_object args);
+static void c_symbol_macrolet(cl_object args);
+static void c_tagbody(cl_object args);
+static void c_throw(cl_object args);
+static void c_unless(cl_object args);
+static void c_unwind_protect(cl_object args);
+static void c_when(cl_object args);
+static void compile_body(cl_object args);
+static void compile_form(cl_object args, bool push);
+
+static void FEillegal_variable_name(cl_object) __attribute__((noreturn));
+static void FEill_formed_input() __attribute__((noreturn));
+
+/* -------------------- SAFE LIST HANDLING -------------------- */
+
+static cl_object
+pop(cl_object *l) {
+	cl_object head, list = *l;
+	if (ATOM(list))
+		FEill_formed_input();
+	head = CAR(list);
+	*l = CDR(list);
+	return head;
+}
+
+static cl_object
+pop_maybe_nil(cl_object *l) {
+	cl_object head, list = *l;
+	if (list == Cnil)
+		return Cnil;
+	if (ATOM(list))
+		FEill_formed_input();
+	head = CAR(list);
+	*l = CDR(list);
+	return head;
+}
+
+/* ------------------------------ ASSEMBLER ------------------------------ */
+
+static cl_index
+asm_begin(void) {
+	/* Save beginning of bytecodes for this session */
+	return current_pc();
+}
+
+static void
+asm_clear(cl_index beginning) {
+	cl_index i;
+	/* Remove data from this session */
+	bytecodes->vector.fillp = beginning;
+}
+
+static cl_object
+asm_end(cl_index beginning) {
+	cl_object new_bytecodes;
+	cl_index length, bytes, i;
+
+	/* Save bytecodes from this session in a new vector */
+	length = current_pc() - beginning;
+	bytes = length * sizeof(cl_object);
+	new_bytecodes = alloc_object(t_bytecodes);
+	new_bytecodes->bytecodes.lex = Cnil;
+	new_bytecodes->bytecodes.data = alloc(bytes);
+	new_bytecodes->bytecodes.size = length;
+	memcpy(new_bytecodes->bytecodes.data,
+	       &bytecodes->vector.self.t[beginning],
+	       bytes);
+
+	asm_clear(beginning);
+	return new_bytecodes;
+}
+
+static void
+asm_grow(void) {
+	cl_object *old_data = bytecodes->vector.self.t;
+	cl_index old_size = bytecodes->vector.fillp;
+	bytecodes->vector.dim += 128;
+	array_allocself(bytecodes);
+	memcpy(bytecodes->vector.self.t, old_data, old_size*sizeof(cl_object));
+}
+
+static void
+asm1(register cl_object op) {
+	int where = bytecodes->vector.fillp;
+	if (where >= bytecodes->vector.dim)
+		asm_grow();
+	bytecodes->vector.self.t[where] = op;
+	bytecodes->vector.fillp++;
+}
+
+static void
+asm_op(register int n) {
+	asm1(MAKE_FIXNUM(n));
+}
+
+static void
+asm_op2(register int code, register cl_fixnum n) {
+	cl_object op = MAKE_FIXNUM(code);
+	cl_object new_op = SET_OPARG(op, n);
+	if (n < -MAX_OPARG || MAX_OPARG < n)
+		FEprogram_error("Argument to bytecode is too large", 0);
+	else
+		asm1(new_op);
+}
+
+static inline cl_object
+make_op(int code) {
+	return MAKE_FIXNUM(code);
+}
+
+static cl_object
+make_op2(int code, cl_fixnum n) {
+	cl_object volatile op = MAKE_FIXNUM(code);
+	cl_object new_op = SET_OPARG(op, n);
+	if (n < -MAX_OPARG || MAX_OPARG < n)
+		FEprogram_error("Argument to bytecode is too large", 0);
+	return new_op;
+}
+
+static void
+asm_insert(cl_fixnum where, cl_object op) {
+	cl_fixnum end = bytecodes->vector.fillp;
+	if (where > end)
+		FEprogram_error("asm1_insert: position out of range", 0);
+	if (end >= bytecodes->vector.dim)
+		asm_grow();
+	memmove(&bytecodes->vector.self.t[where+1],
+		&bytecodes->vector.self.t[where],
+		(end - where) * sizeof(cl_object));
+	bytecodes->vector.fillp++;
+	bytecodes->vector.self.t[where] = op;
+}
+
+static void
+asm_list(register cl_object l) {
+	if (ATOM(l))
+		asm1(l);
+	while(!endp(l)) {
+		asm1(CAR(l));
+		l = CDR(l);
+	}
+}
+
+static void
+asmn(int narg, ...) {
+	va_list args;
+
+	va_start(args, narg);
+	while (narg-- > 0)
+		asm1(va_arg(args, cl_object));
+}
+
+static void
+asm_at(register cl_index where, register cl_object what) {
+	if (where > bytecodes->vector.fillp)
+		FEprogram_error("Internal error at asm_at()",0);
+	bytecodes->vector.self.t[where] = what;
+}
+
+static cl_index
+asm_block(void) {
+	cl_index output;
+	output = current_pc();
+	asm1(MAKE_FIXNUM(0));
+	return output;
+}	
+
+static cl_index
+asm_jmp(register int op) {
+	cl_index output = current_pc();
+	asm_op(op);
+	return output;
+}
+
+static void
+asm_complete(register int op, register cl_index original) {
+	cl_fixnum delta = current_pc() - original;
+	cl_object code = asm_ref(original);
+	cl_object new_code = SET_OPARG(code, delta);
+	if (code != MAKE_FIXNUM(op))
+		FEprogram_error("Non matching codes in ASM-COMPLETE2", 0);
+	else if (delta < -MAX_OPARG || delta > MAX_OPARG)
+		FEprogram_error("Too large jump", 0);
+	else
+		asm_at(original, new_code);
+}
+
+static cl_index
+current_pc(void) {
+	return bytecodes->vector.fillp;
+}
+
+static void
+set_pc(cl_index pc) {
+	bytecodes->vector.fillp = pc;
+}
+
+static cl_object
+asm_ref(register cl_index n) {
+	return bytecodes->vector.self.t[n];
+}
+
+/* ------------------------------ COMPILER ------------------------------ */
+
+typedef struct {
+  cl_object symbol;
+  const char *const name;
+  void (*compiler)(cl_object);
+} compiler_record;
+
+static compiler_record database[] = {
+  {OBJNULL, "AND", c_and},
+  {OBJNULL, "BLOCK", c_block},
+  {OBJNULL, "CASE", c_case},
+  {OBJNULL, "CATCH", c_catch},
+  {OBJNULL, "COND", c_cond},
+  {OBJNULL, "DO", c_do},
+  {OBJNULL, "DO*", c_doa},
+  {OBJNULL, "DOLIST", c_dolist},
+  {OBJNULL, "DOTIMES", c_dotimes},
+  {OBJNULL, "EVAL-WHEN", c_eval_when},
+  {OBJNULL, "FLET", c_flet},
+  {OBJNULL, "FUNCTION", c_function},
+  {OBJNULL, "GO", c_go},
+  {OBJNULL, "IF", c_if},
+  {OBJNULL, "LABELS", c_labels},
+  {OBJNULL, "LET", c_let},
+  {OBJNULL, "LET*", c_leta},
+  {OBJNULL, "MACROLET", c_macrolet},
+  {OBJNULL, "MULTIPLE-VALUE-BIND", c_multiple_value_bind},
+  {OBJNULL, "MULTIPLE-VALUE-CALL", c_multiple_value_call},
+  {OBJNULL, "MULTIPLE-VALUE-PROG1", c_multiple_value_prog1},
+  {OBJNULL, "MULTIPLE-VALUE-SETQ", c_multiple_value_setq},
+  {OBJNULL, "NTH-VALUE", c_nth_value},
+  {OBJNULL, "OR", c_or},
+  {OBJNULL, "PROGN", compile_body},
+  {OBJNULL, "PROGV", c_progv},
+  {OBJNULL, "PSETQ", c_psetq},
+  {OBJNULL, "RETURN", c_return},
+  {OBJNULL, "RETURN-FROM", c_return_from},
+  {OBJNULL, "SETQ", c_setq},
+  {OBJNULL, "SYMBOL-MACROLET", c_symbol_macrolet},
+  {OBJNULL, "TAGBODY", c_tagbody},
+  {OBJNULL, "THROW", c_throw},
+  {OBJNULL, "UNWIND-PROTECT", c_unwind_protect},
+  {OBJNULL, "UNLESS", c_unless},
+  {OBJNULL, "VALUES", c_values},
+  {OBJNULL, "WHEN", c_when},
+  {OBJNULL, "", c_when}
+};
+
+/* ----------------- LEXICAL ENVIRONMENT HANDLING -------------------- */
+
+static void
+FEillegal_variable_name(cl_object v)
+{
+	FEprogram_error("Not a valid variable name ~S.", 1, v);
+}
+
+static void
+FEill_formed_input()
+{
+	FEprogram_error("Unproper list handled to the compiler.", 0);
+}
+
+static void
+c_register_var(register cl_object var, bool special)
+{
+	CAR(lex_env) = CONS(CONS(var, special? Sspecial : Cnil), CAR(lex_env));
+}
+
+static bool
+special_variablep(register cl_object var, register cl_object specials)
+{
+	return ((var->symbol.stype == stp_special) || member_eq(var, specials));
+}
+
+static void
+c_pbind(cl_object var, cl_object specials)
+{
+	if (!SYMBOLP(var))
+		FEillegal_variable_name(var);
+	else if (special_variablep(var, specials)) {
+		c_register_var(var, TRUE);
+		asm_op(OP_PBINDS);
+	} else {
+		c_register_var(var, FALSE);
+		asm_op(OP_PBIND);
+	}
+	asm1(var);
+}
+
+static void
+c_bind(cl_object var, cl_object specials)
+{
+	if (!SYMBOLP(var))
+		FEillegal_variable_name(var);
+	else if (special_variablep(var, specials)) {
+		c_register_var(var, TRUE);
+		asm_op(OP_BINDS);
+	} else {
+		c_register_var(var, FALSE);
+		asm_op(OP_BIND);
+	}
+	asm1(var);
+}
+
+static void
+compile_setq(int op, cl_object var)
+{
+	cl_object ndx;
+
+	if (!SYMBOLP(var))
+		FEillegal_variable_name(var);
+	ndx = lex_var_sch(var);
+	if (!Null(ndx) && CDR(ndx) != Sspecial)
+		asm_op(op); /* Lexical variable */
+	else if (var->symbol.stype == stp_constant)
+		FEassignment_to_constant(var);
+	else if (op == OP_SETQ)
+		asm_op(OP_SETQS); /* Special variable */
+	else
+		asm_op(OP_PSETQS); /* Special variable */
+	asm1(var);
+}
+
+/* -------------------- THE COMPILER -------------------- */
+
+static void
+c_and(cl_object args) {
+	if (Null(args)) {
+		asm1(Ct);
+		return;
+	} else if (ATOM(args)) {
+		FEill_formed_input();
+	} else {
+		compile_form(pop(&args),FALSE);
+		if (!endp(args)) {
+			cl_index label = asm_jmp(OP_JNIL);
+			c_and(args);
+			asm_complete(OP_JNIL, label);
+		}
+	}
+}
+
+/*
+	The OP_BLOCK operator encloses several forms within a block
+	named BLOCK_NAME, thus catching any OP_RETFROM whose argument
+	matches BLOCK_NAME. The end of this block is marked both by
+	the OP_EXIT operator and the LABELZ which is packed within
+	the OP_BLOCK operator.
+	
+		[OP_BLOCK + labelz]
+		block_name
+		....
+		OP_EXIT
+	labelz:	...
+*/
+
+static void
+c_block(cl_object body) {
+	cl_object name = pop(&body);
+	cl_index labelz = asm_jmp(OP_BLOCK);
+	if (!SYMBOLP(name))
+		FEprogram_error("BLOCK: Not a valid block name, ~S", 1, name);
+	asm1(name);
+	compile_body(body);
+	asm_op(OP_EXIT);
+	asm_complete(OP_BLOCK, labelz);
+}
+
+/*
+	There are several ways to invoke functions and to handle the
+	output arguments. These are
+
+		[OP_CALL + nargs]
+		function_name
+
+		[OP_PCALL + nargs]
+		function_name
+
+		[OP_FCALL + nargs]
+
+		[OP_PFCALL + nargs]
+
+	 OP_CALL and OP_FCALL leave all arguments in the VALUES() array,
+	 while OP_PCALL and OP_PFCALL leave the first argument in the
+	 stack.
+
+	 OP_CALL and OP_PCALL use the following symbol to retrieve the
+	 function, while OP_FCALL and OP_PFCALL use the value in VALUES(0).
+ */
+static void
+c_call(cl_object args, bool push) {
+	cl_object name;
+	cl_index nargs;
+
+	name = pop(&args);
+	for (nargs = 0; !endp(args); nargs++) {
+		compile_form(pop(&args),TRUE);
+	}
+	if (ATOM(name)) {
+		asm_op2(push? OP_PCALL : OP_CALL, nargs);
+		asm1(name);
+	} else if (CAR(name) == Slambda) {
+		asm_op(OP_CLOSE);
+		asm1(make_lambda(Cnil, CDR(name)));
+		asm_op2(push? OP_PFCALL : OP_FCALL, nargs);
+	} else {
+		cl_object aux = setf_namep(name);
+		if (aux == OBJNULL)
+			FEprogram_error("FUNCALL: Invalid function name ~S.",
+					1, name);
+		asm_op2(push? OP_PCALL : OP_CALL, nargs);
+		asm1(aux);
+	}
+}
+
+static void
+perform_c_case(cl_object args) {
+	cl_object test, clause, conseq;
+	cl_fixnum label1, label2;
+
+	if (Null(args)) {
+		asm_op(OP_NOP);
+		return;
+	}
+
+	clause = pop(&args);
+	if (ATOM(clause))
+		FEprogram_error("CASE: Illegal clause ~S.",1,clause);
+	test = pop(&clause);
+	if (Sotherwise == test || test == Ct) {
+		compile_body(clause);
+	} else {
+		cl_index labeln, labelz;
+		if (CONSP(test)) {
+			cl_index n = length(test);
+			while (n > 1) {
+				cl_object v = pop(&test);
+				cl_fixnum jump = (n--) * 2;
+				asm_op2(OP_JEQ, jump);
+				asm1(v);
+			}
+			test = CAR(test);
+		}
+		labeln = asm_jmp(OP_JNEQ);
+		asm1(test);
+		compile_body(clause);
+		labelz = asm_jmp(OP_JMP);
+		asm_complete(OP_JNEQ, labeln);
+		perform_c_case(args);
+		asm_complete(OP_JMP, labelz);
+	}
+}
+
+static void
+c_case(cl_object clause) {
+	compile_form(pop(&clause), FALSE);
+	perform_c_case(clause);
+}
+
+/*
+	The OP_CATCH takes the object in VALUES(0) and uses it to catch
+	any OP_THROW operation which uses that value as argument. If a
+	catch occurs, or when all forms have been properly executed, it
+	jumps to LABELZ. LABELZ is packed within the OP_CATCH operator.
+		[OP_CATCH + labelz]
+		...
+		"forms to be caught"
+		...
+	       	OP_EXIT
+	labelz:	...
+*/
+
+static void
+c_catch(cl_object args) {
+	cl_index labelz;
+
+	/* Compile evaluation of tag */
+	compile_form(pop(&args), FALSE);
+
+	/* Compile jump point */
+	labelz = asm_jmp(OP_CATCH);
+
+	/* Compile body of CATCH */
+	compile_body(args);
+	asm_op(OP_EXIT);
+	asm_complete(OP_CATCH, labelz);
+}
+
+/*
+	There are three operators which perform explicit jumps, but
+	almost all other operators use labels in one way or
+	another.
+
+	1) Jumps are always relative to the place where the jump label
+	is retrieved so that if the label is in vector[0], then the
+	destination is roughly vector + vector[0].
+
+	2) There are two types of labels, "packed labels" and "simple
+	labels". The first ones are packed in the upper bits of an
+	operator so that
+		destination = vector + vector[0]>>16
+	Simple labels take the whole word and thus
+		destination = vector + fix(vector[0])
+
+	3) The three jump forms are
+
+		[OP_JMP + label]	; Unconditional jump
+		[OP_JNIL + label]	; Jump if VALUES(0) == Cnil
+		[OP_JT + label]		; Jump if VALUES(0) != Cnil
+
+	It is important to remark that both OP_JNIL and OP_JT truncate
+	the values stack, so that always NValues = 1 after performing
+	any of these operations.
+*/
+static void
+c_cond(cl_object args) {
+	cl_object test, clause, conseq;
+	cl_fixnum label_nil, label_exit;
+
+	clause = pop(&args);
+	if (ATOM(clause))
+		FEprogram_error("COND: Illegal clause ~S.",1,clause);
+	test = pop(&clause);
+	if (Ct == test) {
+		/* Default sentence. If no forms, just output T. */
+		if (Null(clause))
+			compile_form(Ct, FALSE);
+		else
+			compile_body(clause);
+	} else {
+		/* Compile the test. If no more forms, just output
+		   the first value (this is guaranteed by OP_JNIL */
+		compile_form(test, FALSE);
+		label_nil = asm_jmp(OP_JNIL);
+		if (!Null(clause))
+			compile_body(clause);
+		if (Null(args))
+			asm_complete(OP_JNIL, label_nil);
+		else {
+			label_exit = asm_jmp(OP_JMP);
+			asm_complete(OP_JNIL, label_nil);
+			c_cond(args);
+			asm_complete(OP_JMP, label_exit);
+		}
+	}
+}
+
+/*	The OP_DO operator saves the lexical environment and establishes
+	a NIL block to execute the enclosed forms, which are typically
+	like the ones shown below. At the exit of the block, either by
+	means of a OP_RETFROM jump or because of normal termination,
+	the lexical environment is restored, and all bindings undone.
+
+		[OP_DO + labelz]
+		labelz
+		...	; bindings
+	labelb:	...	; body
+		...	; stepping forms
+	labelt:	...	; test form
+		[JNIL + label]
+		...	; output form
+		OP_EXIT
+	labelz:
+
+*/
+static void
+c_do_doa(int op, cl_object args) {
+	cl_object bindings, test, specials, body, l;
+	cl_object stepping = Cnil, vars = Cnil;
+	cl_index labelb, labelt, labelz;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	bindings = pop(&args);
+	test = pop(&args);
+
+	siLprocess_declarations(1, args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	labelz = asm_jmp(OP_DO);
+
+	/* Compile initial bindings */
+	if (length(bindings) == 1)
+		op = OP_BIND;
+	for (l=bindings; !endp(l); ) {
+		cl_object aux = pop(&l);
+		cl_object var, value;
+		if (ATOM(aux)) {
+			var = aux;
+			value = Cnil;
+		} else {
+			var = pop(&aux);
+			value = pop_maybe_nil(&aux);
+			if (!endp(aux))
+				stepping = CONS(CONS(var,pop(&aux)),stepping);
+			if (!Null(aux))
+				FEprogram_error("LET: Ill formed declaration.", 0);
+		}
+		if (!SYMBOLP(var))
+			FEillegal_variable_name(var);
+		if (op == OP_PBIND) {
+			compile_form(value, TRUE);
+			vars = CONS(var, vars);
+		} else {
+			compile_form(value, FALSE);
+			c_bind(var, specials);
+		}
+	}
+	while (!endp(vars))
+		c_pbind(pop(&vars), specials);
+
+	/* Jump to test */
+	labelt = asm_jmp(OP_JMP);
+
+	/* Compile body */
+	labelb = current_pc();
+	c_tagbody(body);
+
+	/* Compile stepping clauses */
+	if (length(stepping) == 1)
+		op = OP_BIND;
+	for (vars = Cnil, stepping=nreverse(stepping); !endp(stepping); ) {
+		cl_object pair = pop(&stepping);
+		cl_object var = CAR(pair);
+		cl_object value = CDR(pair);
+		if (op == OP_PBIND) {
+			compile_form(value, TRUE);
+			vars = CONS(var, vars);
+		} else {
+			compile_form(value, FALSE);
+			compile_setq(OP_SETQ, var);
+		}
+	}
+	while (!endp(vars))
+		compile_setq(OP_PSETQ, pop(&vars));
+
+	/* Compile test */
+	asm_complete(OP_JMP, labelt);
+	compile_form(pop(&test), FALSE);
+	asm_op2(OP_JNIL, labelb - current_pc());
+
+	/* Compile output clauses */
+	compile_body(test);
+	asm_op(OP_EXIT);
+
+	/* Compile return point of block */
+	asm_complete(OP_DO, labelz);
+
+	lex_env = lex_old;
+}
+
+
+static void
+c_doa(cl_object args) {
+	c_do_doa(OP_BIND, args);
+}
+
+static void
+c_do(cl_object args) {
+	c_do_doa(OP_PBIND, args);
+}
+
+/*
+	The OP_DOLIST & OP_DOTIMES operators save the lexical
+	environment and establishes a NIL block to execute the
+	enclosed forms, which iterate over the elements in a list or
+	over a range of integer numbers. At the exit of the block,
+	either by means of a OP_RETFROM jump or because of normal
+	termination, the lexical environment is restored, and all
+	bindings undone.
+
+		[OP_DOTIMES/OP_DOLIST + labelz]
+		...	; bindings
+		[OP_EXIT + labelo]
+		...	; body
+		...	; stepping forms
+		OP_EXIT
+	labelo:	...	; output form
+		OP_EXIT
+	labelz:
+
+ */
+
+static void
+c_dolist_dotimes(int op, cl_object args) {
+	cl_object head = pop(&args);
+	cl_object var = pop(&head);
+	cl_object list = pop(&head);
+	cl_object specials, body;
+	cl_index labelz, labelo;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	siLprocess_declarations(1, args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	if (!SYMBOLP(var))
+		FEillegal_variable_name(var);
+
+	/* Compute list and enter loop */
+	compile_form(list, FALSE);
+	labelz = asm_jmp(op);
+
+	/* Initialize the variable */
+	compile_form((op == OP_DOLIST)? Cnil : MAKE_FIXNUM(0), FALSE);
+	c_bind(var, specials);
+	labelo = asm_jmp(OP_EXIT);
+
+	/* Variable assignment and iterated body */
+	compile_setq(OP_SETQ, var);
+	c_tagbody(body);
+	asm_op(OP_EXIT);
+
+	/* Output */
+	asm_complete(OP_EXIT, labelo);
+	if (CDR(head) != Cnil)
+		FEprogram_error("DOLIST: Too many output forms.", 0);
+	if (Null(head))
+		compile_body(Cnil);
+	else {
+		compile_setq(OP_SETQ, var);
+		compile_form(pop(&head), FALSE);
+	}
+	asm_op(OP_EXIT);
+
+	/* Exit point for block */
+	asm_complete(op, labelz);
+
+	lex_env = lex_old;
+}
+
+
+static void
+c_dolist(cl_object args) {
+	c_dolist_dotimes(OP_DOLIST, args);
+}
+
+static void
+c_dotimes(cl_object args) {
+	c_dolist_dotimes(OP_DOTIMES, args);
+}
+
+static void
+c_eval_when(cl_object args) {
+	cl_object situation = pop(&args);
+
+	if (member_eq(Seval, situation) || member_eq(Kexecute, situation))
+		compile_body(args);
+	else
+		compile_body(Cnil);
+}
+
+
+/*
+	The OP_FLET/OP_FLABELS operators change the lexical environment
+	to add a few local functions.
+
+		[OP_FLET/OP_FLABELS + nfun]
+		fun1
+		...
+		funn
+		...
+		OP_EXIT
+	labelz:
+*/
+static void
+c_labels_flet(int op, cl_object args) {
+	cl_object def_list = pop(&args);
+	int nfun = length(def_list);
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	/* Remove declarations */
+	siLprocess_declarations(1, args);
+	args = VALUES(1);
+	if (nfun == 0) {
+		compile_body(args);
+		return;
+	}
+	asm_op2(op, nfun);
+	do {
+		cl_object definition = pop(&def_list);
+		cl_object name = pop(&definition);
+		asm1(make_lambda(name, definition));
+	} while (!endp(def_list));
+	compile_body(args);
+	asm_op(OP_EXIT);
+
+	lex_env = lex_old;
+}
+
+
+static void
+c_flet(cl_object args) {
+	c_labels_flet(OP_FLET, args);
+}
+
+
+/*
+	There are two operators that produce functions. The first one
+	is
+		OP_FUNCTION
+		symbol
+	which takes the function binding of SYMBOL. The second one is
+		OP_CLOSE
+		interpreted
+	which encloses the INTERPRETED function in the current lexical
+	environment.
+*/
+static void
+c_function(cl_object args) {
+	cl_object function = pop(&args);
+	if (!endp(args))
+		FEprogram_error("FUNCTION: Too many arguments.", 0);
+	if (SYMBOLP(function)) {
+		asm_op(OP_FUNCTION);
+		asm1(function);
+	} else if (CONSP(function) && CAR(function) == Slambda) {
+		asm_op(OP_CLOSE);
+		asm1(make_lambda(Cnil, CDR(function)));
+	} else if (CONSP(function) && CAR(function) == siSlambda_block) {
+		cl_object name = CADR(function);
+		cl_object body = CDDR(function);
+		asm_op(OP_CLOSE);
+		asm1(make_lambda(name, body));
+	} else
+		FEprogram_error("FUNCTION: Not a valid argument ~S.", 1, function);
+}
+
+
+static void
+c_go(cl_object args) {
+	asm_op(OP_GO);
+	asm1(pop(&args));
+	if (!Null(args))
+		FEprogram_error("GO: Too many arguments.",0);
+}
+
+
+/*
+	To get an idea of what goes on
+
+		...		; test form
+		JNIL	labeln
+		...		; form for true case
+		JMP	labelz
+		...		; form fro nil case
+	labelz:
+*/
+static void
+c_if(cl_object form) {
+	cl_fixnum label_nil, label_true;
+
+	/* Compile test */
+	compile_form(pop(&form), FALSE);
+	label_nil = asm_jmp(OP_JNIL);
+
+	/* Compile THEN clause */
+	compile_form(pop(&form), FALSE);
+	label_true = asm_jmp(OP_JMP);
+
+	/* Compile ELSE clause */
+	asm_complete(OP_JNIL, label_nil);
+	if (!endp(form))
+		compile_form(pop(&form), FALSE);
+	asm_complete(OP_JMP, label_true);
+
+	if (!Null(form))
+		FEprogram_error("IF: Too many arguments.", 0);
+}
+
+
+static void
+c_labels(cl_object args) {
+	c_labels_flet(OP_LABELS, args);
+}
+
+
+/*
+	The OP_PUSHENV saves the current lexical environment to allow
+	several bindings.
+		OP_PUSHENV
+		...		; binding forms
+		...		; body
+		OP_EXIT
+
+	There are four forms which perform bindings
+		OP_PBIND	; Bind NAME in the lexical env. using
+		name		; a value from the stack
+		OP_PBINDS	; Bind NAME as special variable using
+		name		; a value from the stack
+		OP_BIND		; Bind NAME in the lexical env. using
+		name		; VALUES(0)
+		OP_BINDS	; Bind NAME as special variable using
+		name		; VALUES(0)
+
+	After a variable has been bound, there are several ways to
+	refer to it.
+
+	1) Refer to the n-th variable in the lexical environment
+		[SYMVAL + n]
+
+	2) Refer to the value of a special variable or constant
+		SYMVALS
+		name
+
+        3) Push the value of the n-th variable of the lexical environment
+		[PUSHV + n]
+
+	4) Push the value of a special variable or constant
+		PUSHVS
+		name
+*/
+
+static void
+c_let_leta(int op, cl_object args) {
+	cl_object bindings, specials, body, l, vars;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	bindings = car(args);
+	siLprocess_declarations(1, CDR(args));
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	/* Optimize some common cases */
+	switch(length(bindings)) {
+	case 0:		compile_body(body); return;
+	case 1:		op = OP_BIND; break;
+	default:
+	}
+
+	asm_op(OP_PUSHENV);
+	for (vars=Cnil, l=bindings; !endp(l); ) {
+		cl_object aux = pop(&l);
+		cl_object var, value;
+		if (ATOM(aux)) {
+			var = aux;
+			value = Cnil;
+		} else {
+			var = pop(&aux);
+			value = pop_maybe_nil(&aux);
+			if (!Null(aux))
+				FEprogram_error("LET: Ill formed declaration ~S.",0);
+		}
+		if (!SYMBOLP(var))
+			FEillegal_variable_name(var);
+		if (op == OP_PBIND) {
+			compile_form(value, TRUE);
+			vars = CONS(var, vars);
+		} else {
+			compile_form(value, FALSE);
+			c_bind(var, specials);
+		}
+	}
+	while (!endp(vars))
+		c_pbind(pop(&vars), specials);
+	compile_body(body);
+	asm_op(OP_EXIT);
+
+	lex_env = lex_old;
+}
+
+static void
+c_let(cl_object args) {
+	c_let_leta(OP_PBIND, args);
+}
+
+static void
+c_leta(cl_object args) {
+	c_let_leta(OP_BIND, args);
+}
+
+/*
+	MACROLET
+
+	The current lexical environment is saved. A new one is prepared with
+	the definitions of these macros, and this environment is used to
+	compile the body.
+ */
+static void
+c_macrolet(cl_object args)
+{
+	cl_object def_list, def, name;
+	int nfun = 0;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	/* Pop the list of definitions */
+	for (def_list = pop(&args); !endp(def_list); ) {
+		cl_object definition = pop(&def_list);
+		cl_object name = pop(&definition);
+		cl_object arglist = pop(&definition);
+		cl_object macro, function;
+		macro = funcall(4, siSexpand_defmacro, name, arglist,
+				definition);
+		function = make_lambda(name, CDR(macro));
+		lex_macro_bind(name, function);
+	}
+	compile_body(args);
+	lex_env = lex_old;
+}	
+
+
+static void
+c_multiple_value_bind(cl_object args)
+{
+	cl_object vars, value, body, specials;
+	cl_index save_pc, n;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	vars = pop(&args);
+	value = pop(&args);
+	siLprocess_declarations(1,args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	compile_form(value, FALSE);
+	n = length(vars);
+	if (n == 0) {
+		compile_body(body);
+	} else {
+		asm_op(OP_PUSHENV);
+		asm_op2(OP_MBIND, n);
+		for (vars=reverse(vars); n; n--){
+			cl_object var = pop(&vars);
+			if (!SYMBOLP(var))
+				FEillegal_variable_name(var);
+			if (special_variablep(var, specials)) {
+				asm1(MAKE_FIXNUM(1));
+				c_register_var(var, TRUE);
+			} else
+				c_register_var(var, FALSE);
+			asm1(var);
+		}
+		compile_body(body);
+		asm_op(OP_EXIT);
+	}
+	lex_env = lex_old;
+}
+
+
+static void
+c_multiple_value_call(cl_object args) {
+	cl_object name;
+
+	name = pop(&args);
+	if (endp(args)) {
+		/* If no arguments, just use ordinary call */
+		c_call(list(1, name), FALSE);
+		return;
+	}
+	asm_op(OP_MCALL);
+	do {
+		compile_form(pop(&args), FALSE);
+		asm_op(OP_PUSHVALUES);
+	} while (!endp(args));
+	compile_form(name, FALSE);
+	asm_op(OP_EXIT);
+}
+
+
+static void
+c_multiple_value_prog1(cl_object args) {
+	compile_form(pop(&args), FALSE);
+	if (!endp(args)) {
+		asm_op(OP_MPROG1);
+		compile_body(args);
+		asm_op(OP_EXIT);
+	}
+}
+
+
+static void
+c_multiple_value_setq(cl_object args) {
+	cl_object orig_vars;
+	cl_object vars = Cnil;
+	cl_object temp_vars = Cnil;
+	cl_object late_assignment = Cnil;
+	cl_index nvars = 0;
+
+	/* Look for symbol macros, building the list of variables
+	   and the list of late assignments. */
+	for (orig_vars = reverse(pop(&args)); !endp(orig_vars); ) {
+		cl_object aux, v = pop(&orig_vars);
+		if (!SYMBOLP(v))
+			FEillegal_variable_name(v);
+		v = macro_expand1(v, lex_env);
+		if (!SYMBOLP(v)) {
+			aux = v;
+			v = Lgensym(0);
+			temp_vars = CONS(v, temp_vars);
+			late_assignment = CONS(list(3, Ssetf, aux, v),
+					       late_assignment);
+		}
+		vars = CONS(v, vars);
+		nvars++;
+	}
+
+	if (!Null(temp_vars)) {
+		asm_op(OP_PUSHENV);
+		do {
+			compile_form(Cnil, FALSE);
+			c_bind(CAR(temp_vars), Cnil);
+			temp_vars = CDR(temp_vars);
+		} while (!Null(temp_vars));
+	}
+
+	/* Compile values */
+	compile_form(pop(&args), FALSE);
+	if (args != Cnil)
+		FEprogram_error("MULTIPLE-VALUE-SETQ: Too many arguments.", 0);
+	if (nvars == 0)
+		/* No variables */
+		return;
+
+	/* Compile variables */
+	asm_op2(OP_MSETQ, nvars);
+	vars = reverse(vars);
+	while (nvars--) {
+		cl_object ndx, var = pop(&vars);
+		if (!SYMBOLP(var))
+			FEillegal_variable_name(var);
+		ndx = lex_var_sch(var);
+		if (!Null(ndx) && CDR(ndx) != Sspecial)
+			asm1(var); /* Lexical variable */
+		else if (var->symbol.stype == stp_constant)
+			FEassignment_to_constant(var);
+		else {
+			asm1(MAKE_FIXNUM(1));
+			asm1(var);
+		}
+	}
+
+	/* Assign to symbol-macros */
+	if (!Null(late_assignment)) {
+		compile_body(late_assignment);
+		asm_op(OP_EXIT);
+	}
+}
+
+
+/*
+	The OP_NTHVAL operator moves a value from VALUES(ndx) to
+	VALUES(0). The index NDX is taken from the stack.
+
+		OP_NTHVAL
+*/
+static void
+c_nth_value(cl_object args) {
+	compile_form(pop(&args), TRUE);		/* INDEX */
+	compile_form(pop(&args), FALSE);	/* VALUES */
+	if (args != Cnil)
+		FEprogram_error("NTH-VALUE: Too many arguments.",0);
+	asm_op(OP_NTHVAL);
+}
+
+
+static void
+c_or(cl_object args) {
+	if (Null(args)) {
+		asm1(Cnil);
+		return;
+	} else if (ATOM(args)) {
+		FEill_formed_input();
+	} else {
+		compile_form(pop(&args), FALSE);
+		if (!endp(args)) {
+			cl_index label = asm_jmp(OP_JT);
+			c_or(args);
+			asm_complete(OP_JT, label);
+		}
+	}
+}
+
+
+/*
+	The OP_PROGV operator exectures a set of statements in a lexical
+	environment that has been extended with special variables. The
+	list of special variables is taken from the top of the stack,
+	while the list of values is in VALUES(0).
+
+		...		; list of variables
+		OP_PUSH
+		...		; list of values
+		OP_PROGV
+		...		; body of progv
+		OP_EXIT
+*/
+static void
+c_progv(cl_object args) {
+	cl_object vars = pop(&args);
+	cl_object values = pop(&args);
+
+	/* The list of variables is in the stack */
+	compile_form(vars, TRUE);
+
+	/* The list of values is in VALUES(0) */
+	compile_form(values, FALSE);
+
+	/* The body is interpreted within an extended lexical
+	   environment. However, as all the new variables are
+	   special, the compiler need not take care of them
+	*/
+	asm_op(OP_PROGV);
+	compile_body(args);
+	asm_op(OP_EXIT);
+}
+
+
+/*
+	There are four assignment operators. They are
+
+	1) Assign VALUES(0) to the lexical variable which occupies the
+	   N-th position
+		[OP_SETQ + n]
+
+	2) Assign VALUES(0) to the special variable NAME
+		OP_SETQS
+		name
+
+	3) Pop a value from the stack and assign it to the lexical
+	   variable in the N-th position.
+		[OP_PSETQ + n]
+
+	4) Pop a value from the stack and assign it to the special
+	   variable denoted by NAME
+		OP_PSETQS
+		name
+*/
+static void
+c_psetq(cl_object old_args) {
+	cl_object args = Cnil, vars = Cnil;
+	bool use_psetf = FALSE;
+	cl_index nvars = 0;
+
+	/* We have to make sure that non of the variables which
+	   are to be assigned is actually a symbol macro. If that
+	   is the case, we invoke (PSETF ...) to handle the
+	   macro expansions.
+	*/
+	while (!endp(old_args)) {
+		cl_object var = pop(&old_args);
+		cl_object value = pop(&old_args);
+		if (!SYMBOLP(var))
+			FEillegal_variable_name(var);
+		var = macro_expand1(var, lex_env);
+		if (!SYMBOLP(var))
+			use_psetf = TRUE;
+		args = CONS(var, CONS(value, args));
+		nvars++;
+	}
+	if (use_psetf) {
+		compile_form(CONS(Spsetf, args), FALSE);
+		return;
+	}
+	while (!endp(args)) {
+		cl_object var = pop(&args);
+		cl_object value = pop(&args);
+		vars = CONS(var, vars);
+		compile_form(value, TRUE);
+	}
+	while (!endp(vars))
+		compile_setq(OP_PSETQ, pop(&vars));
+}
+
+
+/*
+	The OP_RETFROM operator returns from a block using the objects
+	in VALUES() as output values.
+
+		...		; output form
+		OP_RETFROM
+		tag		; object which names the block
+*/
+static void
+c_return(cl_object stmt) {
+	cl_object output = pop_maybe_nil(&stmt);
+
+	compile_form(output, FALSE);
+	asm_op(OP_RETURN);
+	asm1(Cnil);
+	if (stmt != Cnil)
+		FEprogram_error("RETURN: Too many arguments.", 0);
+}
+
+
+static void
+c_return_from(cl_object stmt) {
+	cl_object name = pop(&stmt);
+	cl_object output = pop_maybe_nil(&stmt);
+
+	compile_form(output, FALSE);
+	asm_op(OP_RETURN);
+	if (!SYMBOLP(name))
+		FEprogram_error("RETURN-FROM: Not a valid tag ~S.", 1, name);
+	asm1(name);
+	if (stmt != Cnil)
+		FEprogram_error("RETURN-FROM: Too many arguments.", 0);
+}
+
+
+static void
+c_setq(cl_object args) {
+	while (!endp(args)) {
+		cl_object var = pop(&args);
+		cl_object value = pop(&args);
+		if (!SYMBOLP(var))
+			FEillegal_variable_name(var);
+		var = macro_expand1(var, lex_env);
+		if (SYMBOLP(var)) {
+			compile_form(value, FALSE);
+			compile_setq(OP_SETQ, var);
+		} else {
+			compile_form(list(3, Ssetf, var, value), FALSE);
+		}
+	}
+}
+
+
+static void
+c_symbol_macrolet(cl_object args)
+{
+	cl_object def_list, def, name, specials, body;
+	cl_object lex_old = lex_env;
+	int nfun = 0;
+
+	/* Set a new lexical environment where we will bind
+	   our macrology */
+	lex_copy();
+
+	def_list = pop(&args);
+	siLprocess_declarations(1,args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	/* Scan the list of definitions */
+	for (; !endp(def_list); ) {
+		cl_object definition = pop(&def_list);
+		cl_object name = pop(&definition);
+		cl_object expansion = pop(&definition);
+		cl_object arglist = list(2, Lgensym(0), Lgensym(0));
+		cl_object function;
+		if (special_variablep(name, specials))
+			FEprogram_error("SYMBOL-MACROLET: Symbol ~A cannot be \
+declared special and appear in a symbol-macrolet.", 1, name);
+		definition = list(2, arglist, list(2, Squote, expansion));
+		function = make_lambda(name, definition);
+		lex_symbol_macro_bind(name, function);
+	}
+	compile_body(body);
+	lex_env = lex_old;
+}
+
+static void
+c_tagbody(cl_object args)
+{
+	cl_fixnum tag_base;
+	cl_object label, body;
+	enum type item_type;
+	int nt;
+
+	/* count the tags */
+	for (nt = 0, body = args; !endp(body); body = CDR(body)) {
+		label = CAR(body);
+		item_type = type_of(CAR(body));
+		if (item_type == t_symbol || item_type == t_fixnum ||
+	            item_type == t_bignum) {
+			nt += 1;
+		}
+	}
+	if (nt == 0) {
+		compile_body(args);
+		compile_form(Cnil, FALSE);
+		return;
+	}
+	asm_op2(OP_TAGBODY, nt);
+	tag_base = current_pc();
+	set_pc(tag_base + 2 * nt);
+
+	for (body = args; !endp(body); body = CDR(body)) {
+		label = CAR(body);
+		item_type = type_of(label);
+		if (item_type == t_symbol || item_type == t_fixnum ||
+	            item_type == t_bignum) {
+			asm_at(tag_base, label);
+			tag_base++;
+			asm_at(tag_base, MAKE_FIXNUM(current_pc()-tag_base));
+			tag_base++;
+		} else {
+			compile_form(label, FALSE);
+		}
+	}
+	asm_op(OP_EXIT);
+}
+
+
+/*
+	The OP_THROW jumps to an enclosing OP_CATCH whose tag
+	matches the one of the throw. The tag is taken from the
+	stack, while the output values are left in VALUES().
+*/
+static void
+c_throw(cl_object stmt) {
+	/* FIXME! Do we apply the right protocol here? */
+	cl_object tag = pop(&stmt);
+	cl_object form = pop(&stmt);
+	if (stmt != Cnil)
+		FEprogram_error("THROW: Too many arguments.",0);
+	compile_form(tag, TRUE);
+	compile_form(form, FALSE);
+	asm_op(OP_THROW);
+}
+
+
+static void
+c_unless(cl_object form) {
+	cl_fixnum label_true, label_false;
+
+	/* Compile test */
+	compile_form(pop(&form), FALSE);
+	label_true = asm_jmp(OP_JT);
+
+	/* Compile body */
+	compile_body(form);
+	label_false = asm_jmp(OP_JMP);
+	asm_complete(OP_JT, label_true);
+
+	/* When test failed, output NIL */
+	asm1(Cnil);
+	asm_complete(OP_JMP, label_false);
+}
+
+
+static void
+c_unwind_protect(cl_object args) {
+	cl_index label = asm_jmp(OP_UNWIND);
+
+	/* Compile form to be protected */
+	compile_form(pop(&args), FALSE);
+	asm_op(OP_EXIT);
+
+	/* Compile exit clause */
+	asm_complete(OP_UNWIND, label);
+	compile_body(args);
+	asm_op(OP_EXIT);
+}
+
+
+/*
+	The OP_VALUES moves N values from the stack to VALUES().
+
+		[OP_VALUES + n]
+*/
+static void
+c_values(cl_object args) {
+	int n = 0;
+
+	while (!endp(args)) {
+		compile_form(pop_maybe_nil(&args), TRUE);
+		n++;
+	}
+	asm_op2(OP_VALUES, n);
+}
+
+
+static void
+c_when(cl_object form) {
+	cl_fixnum label;
+
+	/* Compile test */
+	compile_form(pop(&form), FALSE);
+	label = asm_jmp(OP_JNIL);
+
+	/* Compile body */
+	compile_body(form);
+	asm_complete(OP_JNIL, label);
+}
+
+
+static void
+compile_form(cl_object stmt, bool push) {
+	compiler_record *l;
+	cl_object function;
+	cl_object macro;
+
+	/* FIXME! We should protect this region with error handling */
+ BEGIN:
+	/*
+	 * First try with variable references and quoted constants
+	 */
+	if (ATOM(stmt)) {
+		if (SYMBOLP(stmt)) {
+			cl_object stmt1 = macro_expand1(stmt, lex_env);
+			if (stmt1 != stmt) {
+				stmt = stmt1;
+				goto BEGIN;
+			}
+			if (push) asm_op(OP_PUSHV);
+			asm1(stmt);
+			goto OUTPUT;
+		}
+	QUOTED:
+		if (push)
+			asm_op(OP_PUSHQ);
+		else if (FIXNUMP(stmt) || SYMBOLP(stmt))
+			asm_op(OP_QUOTE);
+		asm1(stmt);
+		goto OUTPUT;
+	}
+ LIST:
+	/*
+	 * Next try with special forms.
+	 */
+	function = CAR(stmt);
+	if (!SYMBOLP(function))
+		goto ORDINARY_CALL;
+	if (function == Squote) {
+		stmt = CDR(stmt);
+		if (CDR(stmt) != Cnil)
+			FEprogram_error("QUOTE: Too many arguments.",0);
+		stmt = CAR(stmt);
+		goto QUOTED;
+	}
+	for (l = database; l->symbol != OBJNULL; l++)
+		if (l->symbol == function) {
+			(*(l->compiler))(CDR(stmt));
+			if (push) asm_op(OP_PUSH);
+			goto OUTPUT;
+		}
+	/*
+	 * Next try to macroexpand
+	 */
+	{
+		cl_object new_stmt = macro_expand1(stmt, lex_env);
+		if (new_stmt != stmt){
+			stmt = new_stmt;
+			goto BEGIN;
+		}
+	}
+	if (function->symbol.isform)
+		FEprogram_error("BYTECOMPILE-FORM: Found no macroexpander \
+for special form ~S.", 1, function);
+ ORDINARY_CALL:
+	/*
+	 * Finally resort to ordinary function calls.
+	 */
+	c_call(stmt, push);
+ OUTPUT:
+}
+
+
+static void
+compile_body(cl_object body) {
+	if (endp(body))
+		asm_op(OP_NOP);
+	else do {
+		compile_form(CAR(body), FALSE);
+		body = CDR(body);
+	} while (!endp(body));
+}
+
+/* ----------------------------- PUBLIC INTERFACE ---------------------------- */
+
+/* ------------------------------------------------------------
+   LAMBDA OBJECTS: An interpreted function is a vector made of
+	the following components
+
+      #(LAMBDA
+	{block-name | NIL}
+	{variable-env | NIL}
+	{function-env | NIL}
+	{block-env | NIL}
+	(list of variables declared special)
+	Nreq {var}*			; required arguments
+	Nopt {var value flag}*		; optional arguments
+	{rest-var NIL}			; rest variable
+	{T | NIL}			; allow other keys?
+	Nkey {key var value flag}*	; keyword arguments
+	Naux {var init}			; auxiliary variables
+	documentation-string
+	list-of-declarations
+	{form}*				; body)
+
+   ------------------------------------------------------------ */
+
+#define push(v,l) l = CONS(v, l)
+#define push_var(v, list) \
+	check_symbol(v); \
+	if (v->symbol.stype == stp_constant) \
+		FEillegal_variable_name(v); \
+	push(v, list);
+
+/*
+  Handles special declarations, removes declarations from body
+ */
+@(defun si::process_declarations (body &optional doc)
+	cl_object documentation = Cnil, declarations = Cnil, form, specials = Cnil;
+	cl_object decls, vars, v;
+@
+	/* BEGIN: SEARCH DECLARE */
+	for (; !endp(body); body = CDR(body)) {
+	  form = CAR(body);
+
+	  if (!Null(doc) && type_of(form) == t_string) {
+	    if (documentation == Cnil)
+	      documentation = form;
+	    else
+	      break;
+	    continue;
+	  }
+
+	  if (ATOM(form) || (CAR(form) != Sdeclare))
+	    break;
+
+	  for (decls = CDR(form); !endp(decls); decls = CDR(decls)) {
+	    cl_object sentence = CAR(decls);
+	    if (ATOM(sentence))
+	      FEill_formed_input();
+	    push(sentence, declarations);
+	    if (CAR(sentence) == Sspecial)
+	      for (vars = CDR(sentence); !endp(vars); vars = CDR(vars)) {
+		v = CAR(vars);
+		check_symbol(v);
+		push(v,specials);
+	      }
+	  }
+	}
+	/* END: SEARCH DECLARE */
+
+	@(return declarations body documentation specials)
+@)
+
+@(defun si::process_lambda_list (lambda)
+	cl_object documentation, declarations, specials;
+	cl_object lambda_list, body, form;
+	cl_object x, v, key, init, spp;
+	cl_object reqs = Cnil, opts = Cnil, keys = Cnil, rest = Cnil, auxs = Cnil;
+	int nreq = 0, nopt = 0, nkey = 0, naux = 0;
+	cl_object allow_other_keys = Cnil;
+@
+	bds_check;
+	if (ATOM(lambda))
+		FEprogram_error("LAMBDA: No lambda list.", 0);
+	lambda_list = CAR(lambda);
+
+	declarations = siLprocess_declarations(2, CDR(lambda), Ct);
+	body = VALUES(1);
+	documentation = VALUES(2);
+	specials = VALUES(3);
+
+REQUIRED:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		v = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		if (v == SAallow_other_keys)
+			goto ILLEGAL_LAMBDA;
+		if (v == SAoptional)
+			goto OPTIONAL;
+		if (v == SArest)
+			goto REST;
+		if (v == SAkey)
+			goto KEYWORD;
+		if (v == SAaux)
+			goto AUX;
+		nreq++;
+		push_var(v, reqs);
+	}
+OPTIONAL:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		x = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		spp = Cnil;
+		init = Cnil;
+		if (ATOM(x)) {
+			if (x == SAoptional || x == SAallow_other_keys)
+				goto ILLEGAL_LAMBDA;
+			if (x == SArest)
+				goto REST;
+			if (x == SAkey)
+				goto KEYWORD;
+			if (x == SAaux)
+				goto AUX;
+			v = x;
+		} else {
+			v = CAR(x);
+			if (!endp(x = CDR(x))) {
+				init = CAR(x);
+				if (!endp(x = CDR(x))) {
+					spp = CAR(x);
+					if (!endp(CDR(x)))
+						goto ILLEGAL_LAMBDA;
+				}
+			}
+		}
+		nopt++;
+		push_var(v, opts);
+		push(init, opts);
+		if (spp != Cnil) {
+			push_var(spp, opts);
+		} else {
+			push(Cnil, opts);
+		}
+	}
+
+REST:
+	if (endp(lambda_list))
+		goto ILLEGAL_LAMBDA;
+	v = CAR(lambda_list);
+	push_var(v, rest);
+
+	lambda_list = CDR(lambda_list);
+	if (endp(lambda_list))
+		goto OUTPUT;
+	v = CAR(lambda_list);
+	lambda_list = CDR(lambda_list);
+	if (v == SAoptional || v == SArest || v == SAallow_other_keys)
+		goto ILLEGAL_LAMBDA;
+	if (v == SAkey)
+		goto KEYWORD;
+	if (v == SAaux)
+		goto AUX;
+	goto ILLEGAL_LAMBDA;
+
+KEYWORD:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		init = Cnil;
+		spp = Cnil;
+		x = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		if (ATOM(x)) {
+			if (x == SAallow_other_keys) {
+				if (!Null(allow_other_keys))
+					goto ILLEGAL_LAMBDA;
+				allow_other_keys = Ct;
+				if (endp(lambda_list))
+					goto OUTPUT;
+				x = CAR(lambda_list);
+				lambda_list = CDR(lambda_list);
+				if (key != SAaux)
+					goto ILLEGAL_LAMBDA;
+				goto AUX;
+			} else if (x == SAoptional || x == SArest || x == SAkey)
+				goto ILLEGAL_LAMBDA;
+			else if (x == SAaux)
+				goto AUX;
+			v = x;
+		} else {
+			v = CAR(x);
+			if (!endp(x = CDR(x))) {
+				init = CAR(x);
+				if (!endp(x = CDR(x))) {
+					spp = CAR(x);
+					if (!endp(CDR(x)))
+						goto ILLEGAL_LAMBDA;
+				}
+			}
+		}
+		if (CONSP(v)) {
+			key = CAR(v);
+			if (endp(CDR(v)) || !endp(CDDR(v)))
+				goto ILLEGAL_LAMBDA;
+			v = CADR(v);
+			check_symbol(v);
+			check_symbol(key);
+		} else {
+			check_symbol(v);
+			key = intern(v->symbol.name, keyword_package);
+		}
+		nkey++;
+		push(key, keys);
+		push_var(v, keys);
+		push(init, keys);
+		if (Null(spp)) {
+			push(Cnil, keys);
+		} else {
+			push_var(spp, keys);
+		}
+	}
+
+AUX:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		x = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		if (ATOM(x)) {
+			if (x == SAoptional || x == SArest ||
+			    x == SAkey || x == SAallow_other_keys ||
+			    x == SAaux)
+				goto ILLEGAL_LAMBDA;
+			v = x;
+			init = Cnil;
+		} else if (endp(CDDR(x))) {
+			v = CAR(x);
+			init = CADR(x);
+		} else
+			goto ILLEGAL_LAMBDA;
+		naux++;
+		push_var(v, auxs);
+		push(init, auxs);
+	}
+
+OUTPUT:
+	@(return CONS(MAKE_FIXNUM(nreq), nreverse(reqs))
+		 CONS(MAKE_FIXNUM(nopt), nreverse(opts))
+		 nreverse(rest)
+		 allow_other_keys
+		 CONS(MAKE_FIXNUM(nkey), nreverse(keys))
+		 nreverse(auxs)
+		 documentation
+		 specials
+		 declarations
+		 body)
+
+ILLEGAL_LAMBDA:
+	FEprogram_error("LAMBDA: Illegal lambda list ~S.", 0);
+@)
+
+static void
+c_default(cl_index deflt_pc) {
+	cl_object deflt = asm_ref(deflt_pc);
+	enum cl_type t = type_of(deflt);
+	if ((t == t_symbol) && (deflt->symbol.stype == stp_constant))
+		/* FIXME! Shouldn't this happen only in unsafe mode */
+		asm_at(deflt_pc, SYM_VAL(deflt));
+	else if ((t == t_symbol) || (t == t_cons) || (t == t_fixnum)) {
+		cl_index pc = current_pc();
+		asm_at(deflt_pc, MAKE_FIXNUM(pc-deflt_pc));
+		compile_form(deflt, FALSE);
+		asm_op(OP_EXIT);
+	}
+}
+
+static void
+c_register_var2(register cl_object var, register cl_object *specials)
+{
+	if (Null(var))
+		return;
+	if (member_eq(var, *specials))
+		c_register_var(var, TRUE);
+	else if (var->symbol.stype == stp_special) {
+		*specials = CONS(var, *specials);
+		c_register_var(var, TRUE);
+	} else if (var->symbol.stype == stp_constant)
+		FEassignment_to_constant(var);
+	else
+		c_register_var(var, FALSE);
+}
+
+cl_object
+make_lambda(cl_object name, cl_object lambda) {
+	cl_object reqs, opts, rest, keys, auxs, allow_other_keys;
+	cl_object specials, doc, decl, body, l;
+	cl_index specials_pc, opts_pc, keys_pc, label;
+	int nopts, nkeys;
+	cl_index handle;
+	cl_object lex_old = lex_env;
+
+	lex_copy();
+
+	reqs = siLprocess_lambda_list(1,lambda);
+	opts = VALUES(1);
+	rest = VALUES(2);
+	allow_other_keys = VALUES(3);
+	keys = VALUES(4);
+	auxs = VALUES(5);
+	doc  = VALUES(6);
+	specials = VALUES(7);
+	decl = VALUES(8);
+	body = VALUES(9);
+
+	handle = asm_begin();
+
+	asm1(name);			/* Name of the function */
+	specials_pc = current_pc();	/* Which variables are declared special */
+	asm1(specials);
+
+	asm_list(reqs);			/* Special arguments */
+	reqs = CDR(reqs);
+	while (!endp(reqs)) {
+		cl_object v = pop(&reqs);
+		c_register_var2(v, &specials);
+	}
+
+	opts_pc = current_pc()+1;	/* Optional arguments */
+	nopts = fix(CAR(opts));
+	asm_list(opts);
+
+	asm_list(rest);			/* Name of &rest argument */
+
+	asm1(allow_other_keys);		/* Value of &allow-other-keys */
+
+	keys_pc = current_pc()+1;	/* Keyword arguments */
+	nkeys = fix(CAR(keys));
+	asm_list(keys);
+	asmn(2, doc, decl);
+
+	label = asm_jmp(OP_JMP);
+
+	while (nopts--) {
+		c_default(opts_pc+1);
+		c_register_var2(asm_ref(opts_pc), &specials);
+		c_register_var2(asm_ref(opts_pc+2), &specials);
+		opts_pc+=3;
+	}
+	c_register_var2(car(rest), &specials);
+	while (nkeys--) {
+		c_default(keys_pc+2);
+		c_register_var2(asm_ref(keys_pc+1), &specials);
+		c_register_var2(asm_ref(keys_pc+3), &specials);
+		keys_pc+=4;
+	}
+	
+	if ((current_pc() - label) == 1)
+		set_pc(label);
+	else
+		asm_complete(OP_JMP, label);
+	while (!endp(auxs)) {		/* Local bindings */
+		cl_object var = pop(&auxs);
+		cl_object value = pop(&auxs);
+		compile_form(value, FALSE);
+		c_bind(var, specials);
+	}
+	asm_at(specials_pc, specials);
+	compile_body(body);
+	asm_op(OP_HALT);
+
+	lex_env = lex_old;
+
+	return asm_end(handle);
+}
+
+static cl_object
+alloc_bytecodes()
+{
+	cl_object vector = alloc_simple_vector(128, aet_object);
+	array_allocself(vector);
+	vector->vector.hasfillp = TRUE;
+	vector->vector.fillp = 0;
+	return vector;
+}
+
+@(defun si::make_lambda (name rest)
+	cl_object lambda, old_bytecodes = bytecodes;
+	cl_object lex_old = lex_env;
+@
+	lex_new();
+	if (frs_push(FRS_PROTECT, Cnil)) {
+		lex_env = lex_old;
+		bytecodes = old_bytecodes;
+		frs_pop();
+		unwind(nlj_fr, nlj_tag);
+	}
+	bytecodes = alloc_bytecodes();
+	lambda = make_lambda(name,rest);
+	frs_pop();
+	bytecodes = old_bytecodes;
+	lex_env = lex_old;
+	@(return lambda)
+@)
+
+cl_object
+eval(cl_object form, cl_object *new_bytecodes)
+{
+	cl_object old_bytecodes = bytecodes;
+	cl_index handle;
+	bool unwinding;
+
+	if (new_bytecodes == NULL)
+		bytecodes = alloc_bytecodes();
+	else if (*new_bytecodes != Cnil) {
+		bytecodes = *new_bytecodes;
+	} else {
+		bytecodes = *new_bytecodes = alloc_bytecodes();
+	}
+	if (frs_push(FRS_PROTECT, Cnil)) {
+		bytecodes = old_bytecodes;
+		frs_pop();
+		unwind(nlj_fr, nlj_tag);
+	}
+	handle = asm_begin();
+	compile_form(form, FALSE);
+	asm_op(OP_EXIT);
+	asm_op(OP_HALT);
+/*  	Lprint(1,bytecodes); */
+	VALUES(0) = Cnil;
+	NValues = 0;
+	interpret(&bytecodes->vector.self.t[handle]);
+	asm_clear(handle);
+	frs_pop();
+	bytecodes = old_bytecodes;
+	return VALUES(0);
+}
+
+void
+init_compiler(void)
+{
+	compiler_record *l;
+
+	register_root(&bytecodes);
+
+	for (l = database; l->name[0] != 0; l++)
+	  l->symbol = _intern(l->name, lisp_package);
+}
diff --git a/src/c/disassembler.d b/src/c/disassembler.d
new file mode 100644
index 000000000..4ee47ddaa
--- /dev/null
+++ b/src/c/disassembler.d
@@ -0,0 +1,513 @@
+/*
+    disassembler.c -- Byte compiler and function evaluator
+*/
+/*
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include "ecls-inl.h"
+#include "bytecodes.h"
+
+#define next_code(v) (*(v++))
+
+static cl_object *disassemble(cl_object *vector);
+
+static cl_object *base = NULL;
+
+static cl_object *
+disassemble_vars(const char *message, cl_object *vector, cl_index step) {
+	cl_index n = fix(next_code(vector));
+
+	if (n) {
+	  Lterpri(0);
+	  printf(message);
+	  for (; n; n--, vector+=step) {
+	    Lprin1(1,vector[0]);
+	    if (n > 1) printf(", ");
+	  }
+	}
+	return vector;
+}
+
+static void
+disassemble_lambda(cl_object *vector) {
+	cl_object specials;
+	cl_index n;
+
+	Lterpri(0);
+	/* Name of LAMBDA */
+	printf("Name:\t\t");
+	Lprin1(1, next_code(vector));
+
+	/* Variables that have been declared special */
+	specials = next_code(vector);
+
+	/* Print required arguments */
+	vector = disassemble_vars("Required:\t", vector, 1);
+
+	/* Print optional arguments */
+	vector = disassemble_vars("Optionals:\t", vector, 3);
+
+	/* Print rest argument */
+	if (vector[0] != Cnil) {
+		Lterpri(0);
+		printf("Rest:\t\t%s");
+		Lprin1(1, vector[0]);
+	}
+	vector++;
+
+	/* Print keyword arguments */
+	if (vector[0] != Cnil) {
+		Lterpri(0);
+		printf("Other keys:\t");
+		Lprin1(1, vector[0]);
+	}
+	vector++;
+	vector = disassemble_vars("Keywords:\t", vector, 4);
+
+	/* Print aux arguments */
+	Lterpri(0);
+	printf("\nDocumentation:\t");
+	Lprin1(1, next_code(vector));
+	printf("\nDeclarations:\t");
+	Lprin1(1, next_code(vector));
+
+	base = vector;
+	while (vector[0] != MAKE_FIXNUM(OP_HALT))
+		vector = disassemble(vector);
+}
+
+/* -------------------- DISASSEMBLER AIDS -------------------- */
+
+static inline cl_fixnum
+get_oparg(cl_object o) {
+	return GET_OPARG(o);
+}
+
+static inline cl_fixnum
+packed_label(cl_object *v) {
+	return v + get_oparg(v[0]) - base;
+}
+
+static inline cl_fixnum
+simple_label(cl_object *v) {
+	return v + fix(v[0]) - base;
+}
+
+static cl_object
+search_symbol(register cl_object s) {
+	return s;
+}
+		
+/* -------------------- DISASSEMBLER CORE -------------------- */
+
+static cl_object *
+disassemble_block(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	cl_fixnum exit = packed_label(vector-1);
+
+	printf("BLOCK\t");
+	Lprin1(1, next_code(vector));
+	printf(",%d", exit);
+	vector = disassemble(vector);
+	printf("\t\t\t; block");
+
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+disassemble_catch(cl_object *vector) {
+	printf("CATCH\t%d", packed_label(vector - 1));
+	vector = disassemble(vector);
+	printf("\t\t\t; catch");
+	return vector;
+}
+
+static cl_object *
+disassemble_do(cl_object *vector) {
+	cl_fixnum exit;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	exit = packed_label(vector-1);
+	printf("DO\t%d", exit);
+	vector = disassemble(vector);
+	printf("\t\t\t; do");
+
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+disassemble_dolist(cl_object *vector) {
+	cl_fixnum exit;
+	cl_object lex_old = lex_env;
+
+	lex_copy();
+	exit = packed_label(vector-1);
+	printf("DOLIST\t%d", exit);
+	vector = disassemble(vector);
+	printf("\t\t\t; dolist binding");
+	vector = disassemble(vector);
+	printf("\t\t\t; dolist body");
+	vector = disassemble(vector);
+	printf("\t\t\t; dolist");
+
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+disassemble_dotimes(cl_object *vector) {
+	cl_fixnum exit;
+	cl_object lex_old = lex_env;
+
+	lex_copy();
+	exit = packed_label(vector-1);
+	printf("DOTIMES\t%d", exit);
+	vector = disassemble(vector);
+	printf("\t\t\t; dotimes times");
+	vector = disassemble(vector);
+	printf("\t\t\t; dotimes body");
+	vector = disassemble(vector);
+	printf("\t\t\t; dotimes");
+
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+disassemble_flet(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	cl_index nfun = get_oparg(vector[-1]);
+
+	printf("FLET");
+	lex_copy();
+	while (nfun--) {
+		cl_object fun = next_code(vector);
+		Lterpri(0);
+		printf("\tFLET\t");
+		Lprin1(1, fun->bytecodes.data[0]);
+	}
+	vector = disassemble(vector);
+	printf("\t\t\t; flet");
+
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+disassemble_labels(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	cl_index nfun = get_oparg(vector[-1]);
+
+	printf("LABELS");
+	lex_copy();
+	while (nfun--) {
+		cl_object fun = next_code(vector);
+		Lterpri(0);
+		printf("\tLABELS\t");
+		Lprin1(1, fun->bytecodes.data[0]);
+	}
+	vector = disassemble(vector);
+	printf("\t\t\t; labels");
+
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+disassemble_mbind(cl_object *vector)
+{
+	int i = get_oparg(vector[-1]);
+	bool newline = FALSE;
+	while (i--) {
+		cl_object var = next_code(vector);
+		if (newline) {
+			Lterpri(0);
+			printf("\t");
+		} else
+			newline = TRUE;
+		if (var == MAKE_FIXNUM(1)) {
+			printf("MBINDS\t");
+			var = next_code(vector);
+		} else {
+			printf("MBIND\t");
+		}
+		Lprin1(1, var);
+		printf(", VALUES(%d)", i);
+	}
+	return vector;
+}
+
+static cl_object *
+disassemble_mprog1(cl_object *vector) {
+	printf("MPROG1");
+	vector = disassemble(vector);
+	printf("\t\t\t; mprog1");
+	return vector;
+}
+
+
+static cl_object *
+disassemble_msetq(cl_object *vector)
+{
+	int i = get_oparg(vector[-1]);
+	bool newline = FALSE;
+	while (i--) {
+		cl_object var = next_code(vector);
+		if (newline) {
+			Lterpri(0);
+			printf("\t");
+		} else
+			newline = TRUE;
+		if (var == MAKE_FIXNUM(1)) {
+			printf("MSETQS\t");
+			var = next_code(vector);
+		} else {
+			printf("MSETQ\t");
+		}
+		Lprin1(1, var);
+		printf(", VALUES(%d)", i);
+	}
+	return vector;
+}
+
+
+static cl_object *
+disassemble_progv(cl_object *vector) {
+	printf("PROGV");
+	vector = disassemble(vector);
+	printf("\t\t\t; progv");
+	return vector;
+}
+
+static cl_object *
+disassemble_pushenv(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	printf("PUSHENV");
+	vector = disassemble(vector);
+	printf("\t\t\t; pushenv");
+
+	lex_env = lex_old;
+	return vector;
+}
+
+/*	OP_TAGBODY n-tags
+	tag1 addr1
+	tag2 addr2
+	...  ...
+	tagn addrn
+	{form}*
+	OP_EXIT
+*/
+
+static cl_object *
+disassemble_tagbody(cl_object *vector) {
+	cl_index ntags = get_oparg(vector[-1]);
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	printf("TAGBODY");
+	while (ntags--) {
+		Lterpri(0);
+		printf("\tTAG\t'");
+		Lprin1(1, vector[0]);
+		printf(" @@ %d", simple_label(vector+1));
+		vector+=2;
+	}
+	vector = disassemble(vector);
+	printf("\t\t\t; tagbody");
+
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+disassemble_unwind_protect(cl_object *vector) {
+	cl_fixnum exit = packed_label(vector-1);
+
+	printf("PROTECT\t%d", exit);
+	vector = disassemble(vector);
+	vector = disassemble(vector);
+	printf("\t\t\t; protect");
+
+	return vector;
+}
+
+static cl_object *
+disassemble(cl_object *vector) {
+	const char *string;
+	enum cl_type t;
+	cl_object s;
+	cl_fixnum n;
+
+ BEGIN:
+	Lterpri(0);
+	printf("%4d\t", vector - base);
+	s = next_code(vector);
+	t = type_of(s);
+	if (t == t_symbol) {
+		Lprin1(1, search_symbol(s));
+		goto BEGIN;
+	}
+	if (t != t_fixnum) {
+		Lprin1(1, s);
+		goto BEGIN;
+	}
+	switch (GET_OP(s)) {
+	case OP_PUSHQ:		printf("PUSH\t'");
+				Lprin1(1, next_code(vector));
+				break;
+	case OP_PUSH:		string = "PUSH\tVALUES(0)";
+				goto NOARG;
+	case OP_PUSHV:		string = "PUSHV";
+				s = search_symbol(next_code(vector));
+				goto ARG;
+	case OP_QUOTE:		string = "QUOTE";
+				s = next_code(vector);
+				goto ARG;
+	case OP_NOP:		string = "NOP";
+				goto NOARG;
+	case OP_BLOCK:		vector = disassemble_block(vector);
+				break;
+	case OP_PUSHVALUES:	string = "PUSH\tVALUES";
+				goto NOARG;
+	case OP_MCALL:		string = "MCALL";
+				goto NOARG;
+	case OP_CALL:		string = "CALL";
+				n = get_oparg(s);
+				s = next_code(vector);
+				goto OPARG_ARG;
+	case OP_PCALL:		string = "PCALL";
+				n = get_oparg(s);
+				s = next_code(vector);
+				goto OPARG_ARG;
+	case OP_FCALL:		string = "FCALL";
+				n = get_oparg(s);
+				goto OPARG;
+	case OP_PFCALL:		string = "PFCALL";
+				n = get_oparg(s);
+				goto OPARG;
+	case OP_CATCH:		vector = disassemble_catch(vector);
+				break;
+	case OP_EXIT:		printf("EXIT");
+				return vector;
+	case OP_HALT:		printf("HALT");
+				return vector-1;
+	case OP_FLET:		vector = disassemble_flet(vector);
+				break;
+	case OP_LABELS:		vector = disassemble_labels(vector);
+				break;
+	case OP_FUNCTION:	string = "SYMFUNC";
+				s = next_code(vector);
+				goto ARG;
+	case OP_CLOSE:		string = "CLOSE";
+				s = next_code(vector);
+				goto ARG;
+	case OP_GO:		string = "GO";
+				s = next_code(vector);
+				goto ARG;
+	case OP_RETURN:		string = "RETFROM";
+				s = next_code(vector);
+				goto ARG;
+	case OP_THROW:		string = "THROW";
+				goto NOARG;
+	case OP_JMP:		string = "JMP";
+				n = packed_label(vector-1);
+				goto OPARG;
+	case OP_JNIL:		string = "JNIL";
+				n = packed_label(vector-1);
+				goto OPARG;
+	case OP_JT:		string = "JT";
+				n = packed_label(vector-1);
+				goto OPARG;
+	case OP_JEQ:		string = "JEQ";
+				s = next_code(vector);
+				n = packed_label(vector-2);
+				goto OPARG_ARG;
+	case OP_JNEQ:		string = "JNEQ";
+				s = next_code(vector);
+				n = packed_label(vector-2);
+				goto OPARG_ARG;
+	case OP_BIND:		string = "BIND"; goto SETQ;
+	case OP_BINDS:		string = "BINDS"; goto SETQS;
+	case OP_PBIND:		string = "PBIND"; goto SETQ;
+	case OP_PBINDS:		string = "PBINDS"; goto SETQS;
+	case OP_PSETQ:		string = "PSETQ"; goto SETQ;
+	case OP_PSETQS:		string = "PSETQS"; goto SETQS;
+	case OP_SETQ:		string = "SETQ";
+		SETQ:		s = next_code(vector);
+				goto ARG;
+	case OP_SETQS:		string = "SETQS";
+		SETQS:		s = next_code(vector);
+				goto ARG;
+	case OP_MSETQ:		vector = disassemble_msetq(vector);
+				break;
+	case OP_MBIND:		vector = disassemble_mbind(vector);
+				break;
+	case OP_MPROG1:		vector = disassemble_mprog1(vector);
+				break;
+	case OP_PROGV:		vector = disassemble_progv(vector);
+				break;
+	case OP_PUSHENV:	vector = disassemble_pushenv(vector);
+				break;
+	case OP_VALUES:		string = "VALUES";
+				n = get_oparg(s);
+				goto OPARG;
+	case OP_NTHVAL:		string = "NTHVAL";
+				goto NOARG;
+	case OP_DOLIST:		vector = disassemble_dolist(vector);
+				break;
+	case OP_DOTIMES:	vector = disassemble_dotimes(vector);
+				break;
+	case OP_DO:		vector = disassemble_do(vector);
+				break;
+	case OP_TAGBODY:	vector = disassemble_tagbody(vector);
+				break;
+	case OP_UNWIND:		vector = disassemble_unwind_protect(vector);
+				break;
+	default:
+		FEerror("Unknown code ~S", 1, MAKE_FIXNUM(*(vector-1)));
+		return;
+	NOARG:			printf(string);
+				break;
+	ARG:			printf("%s\t", string);
+				Lprin1(1, s);
+				break;
+	OPARG:			printf("%s\t%d", string, n);
+				break;
+	OPARG_ARG:		printf("%s\t%d,", string, n);
+				Lprin1(1, s);
+				break;
+	}
+	goto BEGIN;
+}
+
+@(defun si::bc_disassemble (v)
+@
+	if (type_of(v) == t_bytecodes)
+		disassemble_lambda(v->bytecodes.data);
+	@(return v)
+@)
+
+@(defun si::bc_split (b)
+	cl_object vector;
+@
+	if (type_of(b) != t_bytecodes)
+		@(return Cnil Cnil)
+	vector = alloc_simple_vector(b->bytecodes.size, aet_object);
+	vector->vector.self.t = b->bytecodes.data;
+	@(return b->bytecodes.lex vector)
+@)
diff --git a/src/c/dosdummy.d b/src/c/dosdummy.d
new file mode 100644
index 000000000..bba9a6943
--- /dev/null
+++ b/src/c/dosdummy.d
@@ -0,0 +1,9 @@
+#define DUM(a) int a(int n) {}
+
+DUM(alarm)
+DUM(getpid)
+DUM(getuid)
+DUM(popen)
+DUM(pclose)
+DUM(getpwuid)
+DUM(getpwnam)
diff --git a/src/c/dostimes.d b/src/c/dostimes.d
new file mode 100644
index 000000000..062e8dc83
--- /dev/null
+++ b/src/c/dostimes.d
@@ -0,0 +1,18 @@
+#include <sys/times.h>
+#include <sys/resource.h>
+
+#ifdef __ZTC__
+#define HZ 100
+#endif
+
+times(struct tms *x)
+{ int hz;
+  struct rusage ru;
+  getrusage(RUSAGE_SELF,&ru);
+  hz =  ru.ru_utime.tv_sec * HZ +
+    (ru.ru_utime.tv_usec * HZ)/1000000;
+  x->tms_utime = hz;
+  x->tms_stime = hz;
+  return 0;
+}
+
diff --git a/src/c/dpp.c b/src/c/dpp.c
new file mode 100644
index 000000000..ff4022805
--- /dev/null
+++ b/src/c/dpp.c
@@ -0,0 +1,701 @@
+/*
+    dpp.c -- Defun preprocessor.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+/*
+	Usage:
+		dpp [in-file [out-file]]
+
+	The file named in-file is preprocessed and the output will be
+	written to the file whose name is out-file. If in-file is "-"
+	program is read from standard input, while if out-file is "-"
+	C-program is written to standard output.
+
+
+	The function definition:
+
+	@(defun name ({var}*
+		      [&optional {var | (var [initform [svar]])}*]
+		      [&rest var]
+		      [&key {var |
+			     ({var | (keyword var)} [initform [svar]])}*
+			    [&allow_other_keys]]
+		      [&aux {var | (var [initform])}*])
+
+		C-declaration
+
+	@
+
+		C-body
+
+	@)
+
+	name can be either an identifier or a full C procedure header
+	enclosed in quotes (').
+
+	&optional may be abbreviated as &o.
+	&rest may be abbreviated as &r.
+	&key may be abbreviated as &k.
+	&allow_other_keys may be abbreviated as &aok.
+	&aux may be abbreviated as &a.
+
+	Each variable becomes a C variable.
+
+	Each supplied-p parameter becomes a boolean C variable.
+
+	Initforms are C expressions.
+	It an expression contain non-alphanumeric characters,
+	it should be surrounded by backquotes (`).
+
+
+	Function return:
+
+		@(return {form}*)
+
+*/
+
+#include <stdio.h>
+#include <ctype.h>
+#include <string.h>
+
+#define POOLSIZE        2048
+#define MAXREQ          16
+#define MAXOPT          16
+#define MAXKEY          16
+#define MAXAUX          16
+#define MAXRES          16
+
+#define TRUE            1
+#define FALSE           0
+
+typedef int bool;
+
+FILE *in, *out;
+
+char filename[BUFSIZ];
+int lineno;
+int tab;
+int tab_save;
+
+char pool[POOLSIZE];
+char *poolp;
+
+char *function;
+
+char *required[MAXREQ];
+int nreq;
+
+struct optional {
+	char *o_var;
+	char *o_init;
+	char *o_svar;
+} optional[MAXOPT];
+int nopt;
+
+bool rest_flag;
+char *rest_var;
+
+bool key_flag;
+struct keyword {
+	char *k_key;
+	char *k_var;
+	char *k_init;
+	char *k_svar;
+} keyword[MAXKEY];
+int nkey;
+bool allow_other_keys_flag;
+
+struct aux {
+	char *a_var;
+	char *a_init;
+} aux[MAXAUX];
+int naux;
+
+char *result[MAXRES];
+int nres;
+
+put_lineno(void)
+{
+	static int flag = 0;
+	if (flag)
+		fprintf(out, "#line %d\n", lineno);
+	else {
+		flag++;
+		fprintf(out, "#line %d \"%s\"\n", lineno, filename);
+	}
+}
+
+error(char *s)
+{
+	printf("Error in line %d: %s.\n", lineno, s);
+	exit(1);
+}
+
+error_symbol(char *s)
+{
+	printf("Error in line %d: illegal symbol %s.\n", lineno, s);
+	exit(1);
+}
+
+readc(void)
+{
+	int c;
+
+	c = getc(in);
+	if (feof(in)) {
+		if (function != NULL)
+			error("unexpected end of file");
+		exit(0);
+	}
+	if (c == '\n') {
+		lineno++;
+		tab = 0;
+	} else if (c == '\t')
+		tab++;
+	return(c);
+}
+
+nextc(void)
+{
+	int c;
+
+	while (isspace(c = readc()))
+		;
+	return(c);
+}
+
+unreadc(int c)
+{
+	if (c == '\n')
+		--lineno;
+	else if (c == '\t')
+		--tab;
+	ungetc(c, in);
+}
+
+put_tabs(int n)
+{
+	put_lineno();
+	while (n--)
+		putc('\t', out);
+}
+
+pushc(int c)
+{
+	if (poolp >= &pool[POOLSIZE])
+		error("buffer pool overflow");
+	*poolp++ = c;
+}
+
+char *
+read_token(void)
+{
+	int c;
+	int stop = 0;
+	int left_paren = 0;
+	char *p;
+
+	p = poolp;
+	if ((c = nextc()) == '`') {
+		while ((c = readc()) != '`')
+			pushc(c);
+	} else {
+		do
+			if (c == '(') {
+				left_paren++;
+				pushc(c);
+				c = readc();
+			} else if (c == ')') {
+				if (left_paren == 0)
+					stop = 1;
+				else {
+					left_paren--;
+					pushc(c);
+					c = readc();
+				}
+			} else if (isspace(c) && left_paren == 0) {
+				stop = 1;
+			} else {
+				pushc(c);
+				c = readc();
+			}
+		while (!stop);
+		unreadc(c);
+	}
+	pushc('\0');
+	return(p);
+}
+
+reset(void)
+{
+	int i;
+
+	poolp = pool;
+	function = NULL;
+	nreq = 0;
+	for (i = 0;  i < MAXREQ;  i++)
+		required[i] = NULL;
+	nopt = 0;
+	for (i = 0;  i < MAXOPT;  i++)
+		optional[i].o_var
+		= optional[i].o_init
+		= optional[i].o_svar
+		= NULL;
+	rest_flag = FALSE;
+	rest_var = "ARGS";
+	key_flag = FALSE;
+	nkey = 0;
+	for (i = 0;  i < MAXKEY;  i++)
+		keyword[i].k_key
+		= keyword[i].k_var
+		= keyword[i].k_init
+		= keyword[i].k_svar
+		= NULL;
+	allow_other_keys_flag = FALSE;
+	naux = 0;
+	for (i = 0;  i < MAXAUX;  i++)
+		aux[i].a_var
+		= aux[i].a_init
+		= NULL;
+}
+
+get_function(void)
+{
+	function = read_token();
+}
+
+get_lambda_list(void)
+{
+	int c;
+	char *p;
+
+	if ((c = nextc()) != '(')
+		error("( expected");
+	for (;;) {
+		if ((c = nextc()) == ')')
+			return;
+		if (c == '&') {
+			p = read_token();
+			goto OPTIONAL;
+		}
+		unreadc(c);
+		p = read_token();
+		if (nreq >= MAXREQ)
+			error("too many required variables");
+		required[nreq++] = p;
+	}
+
+OPTIONAL:
+	if (strcmp(p, "optional") != 0 && strcmp(p, "o") != 0)
+		goto REST;
+	for (;;  nopt++) {
+		if ((c = nextc()) == ')')
+			return;
+		if (c == '&') {
+			p = read_token();
+			goto REST;
+		}
+		if (nopt >= MAXOPT)
+			error("too many optional argument");
+		if (c == '(') {
+			optional[nopt].o_var = read_token();
+			if ((c = nextc()) == ')')
+				continue;
+			unreadc(c);
+			optional[nopt].o_init = read_token();
+			if ((c = nextc()) == ')')
+				continue;
+			unreadc(c);
+			optional[nopt].o_svar = read_token();
+			if (nextc() != ')')
+				error(") expected");
+		} else {
+			unreadc(c);
+			optional[nopt].o_var = read_token();
+		}
+	}
+
+REST:
+	if (strcmp(p, "rest") != 0 && strcmp(p, "r") != 0)
+		goto KEYWORD;
+	rest_flag = TRUE;
+	if ((c = nextc()) == ')' || c == '&')
+		error("&rest var missing");
+	unreadc(c);
+	rest_var = read_token();
+	if ((c = nextc()) == ')')
+		return;
+	if (c != '&')
+		error("& expected");
+	p = read_token();
+	goto KEYWORD;
+
+KEYWORD:
+	if (strcmp(p, "key") != 0 && strcmp(p, "k") != 0)
+		goto AUX;
+	key_flag = TRUE;
+	for (;;  nkey++) {
+		if ((c = nextc()) == ')')
+			return;
+		if (c == '&') {
+			p = read_token();
+			if (strcmp(p, "allow_other_keys") == 0 ||
+			    strcmp(p, "aok") == 0) {
+				allow_other_keys_flag = TRUE;
+				if ((c = nextc()) == ')')
+					return;
+				if (c != '&')
+					error("& expected");
+				p = read_token();
+			}
+			goto AUX;
+		}
+		if (nkey >= MAXKEY)
+			error("too many optional argument");
+		if (c == '(') {
+			if ((c = nextc()) == '(') {
+				p = read_token();
+				if (p[0] != ':' || p[1] == '\0')
+					error("keyword expected");
+				keyword[nkey].k_key = p + 1;
+				keyword[nkey].k_var = read_token();
+				if (nextc() != ')')
+					error(") expected");
+			} else {
+				unreadc(c);
+				keyword[nkey].k_key
+				= keyword[nkey].k_var
+				= read_token();
+			}
+			if ((c = nextc()) == ')')
+				continue;
+			unreadc(c);
+			keyword[nkey].k_init = read_token();
+			if ((c = nextc()) == ')')
+				continue;
+			unreadc(c);
+			keyword[nkey].k_svar = read_token();
+			if (nextc() != ')')
+				error(") expected");
+		} else {
+			unreadc(c);
+			keyword[nkey].k_key
+			= keyword[nkey].k_var
+			= read_token();
+		}
+	}
+
+AUX:
+	if (strcmp(p, "aux") != 0 && strcmp(p, "a") != 0)
+		error("illegal lambda-list keyword");
+	for (;;) {
+		if ((c = nextc()) == ')')
+			return;
+		if (c == '&')
+			error("illegal lambda-list keyword");
+		if (naux >= MAXAUX)
+			error("too many auxiliary variable");
+		if (c == '(') {
+			aux[naux].a_var = read_token();
+			if ((c = nextc()) == ')')
+				continue;
+			unreadc(c);
+			aux[naux].a_init = read_token();
+			if (nextc() != ')')
+				error(") expected");
+		} else {
+			unreadc(c);
+			aux[naux].a_var = read_token();
+		}
+		naux++;
+	}
+}
+
+get_return(void)
+{
+	int c;
+
+	nres = 0;
+	for (;;) {
+		if ((c = nextc()) == ')')
+			return;
+		unreadc(c);
+		result[nres++] = read_token();
+	}
+}
+
+put_fhead(void)
+{
+  bool b = FALSE; char *q, *p = function;
+  int i;
+  put_lineno();
+  fprintf(out, "cl_object\n");
+  for (p = function; *p != '\0' && *p != ':' && *p != '('; p++);
+  if (*p != ':')
+    p = function;
+  else {
+    for(q = function; q < p; q++)
+      fputc(*q, out);
+    while (*p == ':') p++;
+  }
+  fputc('L',out);
+  while (!b && *p != '\0') {
+    fputc(*p, out);
+    b = (*p++ == '(');
+  }
+  if (b) {
+	/*
+	@(defun `assoc_or_rassoc(cl_object (*car_or_cdr)())`
+	     (item a_list &key test test_not key)
+	must become:
+	Lassoc_or_rassoc(int narg, cl_object (*car_or_cdr)(),
+	      cl_object item, cl_object a_list, ...)
+	*/
+	fprintf(out, "int narg, ");
+	while (*p != ')' || p[1] != '\0')
+		fputc(*p++, out);
+	}
+  else
+    fprintf(out, "(int narg", function);
+	
+  for (i = 0; i < nreq; i++)
+		fprintf(out, ", cl_object %s", required[i]);
+  if (nopt > 0 || rest_flag || key_flag)
+		fprintf(out, ", ...");
+  fprintf(out, ")\n");
+  if (b) {
+	while (*p++ != ')') ;
+	fprintf(out, "%s", p);  /* declaration of extra first arg */
+	}
+  fprintf(out, "{\n");
+}
+
+put_declaration(void)
+{
+  int i;
+
+  for (i = 0;  i < nopt;  i++) {
+    put_lineno();
+    fprintf(out, "\tcl_object %s;\n", optional[i].o_var);
+  }
+  for (i = 0;  i < nopt;  i++)
+    if (optional[i].o_svar != NULL) {
+      put_lineno();
+      fprintf(out, "\tbool %s;\n", optional[i].o_svar);
+    }
+  if (nkey > 0) {
+    put_lineno();
+    fprintf(out, "\tcl_object KEYS[%d];\n", nkey);
+  }
+  for (i = 0;  i < nkey;  i++) {
+    fprintf(out, "\tcl_object %s;\n", keyword[i].k_var);
+    if (keyword[i].k_svar != NULL)
+      fprintf(out, "\tbool %s;\n", keyword[i].k_svar);
+  }
+  for (i = 0;  i < naux;  i++) {
+    put_lineno();
+    fprintf(out, "\tcl_object %s;\n", aux[i].a_var);
+  }
+  if (nopt == 0 && !rest_flag && !key_flag) {
+    put_lineno();
+    fprintf(out, "\tcheck_arg(%d);\n", nreq);
+  } else {
+    if (key_flag) {
+      put_lineno();
+      fprintf(out, "\tcl_object KEY_VARS[%d];\n", 2*nkey);
+    }
+    put_lineno();
+    fprintf(out, "\tva_list %s;\n\tva_start(%s, %s);\n", rest_var, rest_var,
+	    ((nreq > 0) ? required[nreq-1] : "narg"));
+    put_lineno();
+    fprintf(out, "\tif (narg < %d) FEtoo_few_arguments(&narg);\n", nreq);
+    if (nopt > 0 && !rest_flag && !key_flag) {
+      put_lineno();
+      fprintf(out, "\tif (narg > %d) FEtoo_many_arguments(&narg);\n", nreq + nopt);
+    }
+    for (i = 0;  i < nopt;  i++) {
+      put_lineno();
+      fprintf(out, "\tif (narg > %d) {\n", nreq+i, optional[i].o_var);
+      put_lineno();
+      fprintf(out, "\t\t%s = va_arg(%s, cl_object);\n",
+	      optional[i].o_var, rest_var);
+      if (optional[i].o_svar) {
+	put_lineno();
+	fprintf(out, "\t\t%s = TRUE;\n", optional[i].o_svar);
+      }
+      put_lineno();
+      fprintf(out, "\t} else {\n");
+      put_lineno();
+      fprintf(out, "\t\t%s = %s;\n",
+	      optional[i].o_var,
+	      optional[i].o_init == NULL ? "Cnil" : optional[i].o_init);
+      if (optional[i].o_svar) {
+	put_lineno();
+	fprintf(out, "\t\t%s = FALSE;\n", optional[i].o_svar);
+      }
+      put_lineno();
+      fprintf(out, "\t}\n");
+    }
+    if (key_flag) {
+      for (i = 0; i < nkey; i++) {
+	put_lineno();
+	fprintf(out, "\tKEYS[%d]=K%s;\n", i, keyword[i].k_key);
+      }
+      put_lineno();
+      fprintf(out, "\tparse_key(narg-%d, (cl_object*)ARGS, %d, KEYS, KEY_VARS, %s, %d);\n",
+	      nreq+nopt, nkey, rest_flag ? rest_var : "OBJNULL", allow_other_keys_flag);
+      for (i = 0;  i < nkey;  i++) {
+	put_lineno();
+	fprintf(out, "\tif (KEY_VARS[%d]==Cnil) {\n", nkey+i);
+	if (keyword[i].k_init != NULL) {
+	  put_lineno();
+	  fprintf(out, "\t  %s = %s;\n", keyword[i].k_var, keyword[i].k_init);
+	} else {
+	  put_lineno();
+	  fprintf(out, "\t  %s = Cnil;\n", keyword[i].k_var);
+	}
+	if (keyword[i].k_svar != NULL) {
+	  put_lineno();
+	  fprintf(out, "\t  %s = FALSE;\n", keyword[i].k_svar);
+	}
+	fprintf(out, "\t} else {\n");
+	if (keyword[i].k_svar != NULL) {
+	  put_lineno();
+	  fprintf(out, "\t  %s = TRUE;\n", keyword[i].k_svar);
+	}
+	put_lineno();
+	fprintf(out, "\t  %s = KEY_VARS[%d];\n\t}\n", keyword[i].k_var, i);
+      }
+    }
+  }
+  for (i = 0;  i < naux;  i++) {
+    put_lineno();
+    fprintf(out, "\t%s = %s;\n", aux[i].a_var,
+	    aux[i].a_init == NULL ? "Cnil" : aux[i].a_init);
+  }
+}
+
+put_return(void)
+{
+	int i, t;
+
+	t = tab_save+1;
+	if (nres == 0) {
+	  fprintf(out, "return0();");
+	} else if (nres == 1) {
+	  fprintf(out, "return1(%s);", result[0]);
+	} else {
+	  fprintf(out, "{\n");
+	  put_tabs(t);
+	  fprintf(out, "cl_object saved_value = %s;\n", result[0]);
+	  for (i = 1;  i < nres;  i++) {
+		put_tabs(t);
+		fprintf(out, "VALUES(%d) = %s;\n", i, result[i]);
+	  }
+	  put_tabs(t);
+	  fprintf(out, "NValues = %d;\n", nres);
+	  put_tabs(t);
+	  fprintf(out, "return saved_value;\n");
+	  put_tabs(tab_save);
+	  fprintf(out, "}\n");
+	}
+}
+
+char
+jump_to_at(void)
+{
+	char c;
+ GO_ON:
+	while ((c = readc()) != '@')
+		putc(c, out);
+	if ((c = readc()) == '@') {
+		putc(c, out);
+		goto GO_ON;
+	}
+	return c;
+}
+
+main_loop(void)
+{
+	int c;
+	int in_defun=0;
+	char *p;
+
+	lineno = 1;
+
+	reset();
+	put_lineno();
+LOOP:
+	c = jump_to_at();
+	if (c == ')') {
+		if (!in_defun)
+			error("unmatched @) found");
+		in_defun = 0;
+		putc('}',out);
+		reset();
+		goto LOOP;
+	}
+	if (c != '(')
+		error("@( expected");
+	p = read_token();
+	if (strcmp(p, "defun") == 0) {
+		if (in_defun)
+			error("@) expected before new function definition");
+		in_defun = 1;
+		get_function();
+		get_lambda_list();
+		put_fhead();
+		put_lineno();
+		c = jump_to_at();
+		put_declaration();
+		put_lineno();
+	} else if (strcmp(p, "return") == 0) {
+		if (!in_defun)
+			error("@(return) found outside @(defun)");
+		tab_save = tab;
+		get_return();
+		put_return();
+	} else
+		error_symbol(p);
+	goto LOOP;
+}
+
+main(int argc, char **argv)
+{
+	char *p, *q;
+	char outfile[BUFSIZ];
+
+	if (argc < 2 || !strcmp(argv[1],"-")) {
+	  in = stdin;
+	  strcpy(filename, "-");
+	} else {
+	  in = fopen(argv[1],"r");
+	  strncpy(filename, argv[1], BUFSIZ);
+	}
+	if (argc < 3 || !strcmp(argv[2],"-")) {
+	  out = stdout;
+	  strncpy(outfile, "-", BUFSIZ);
+	} else {
+	  out = fopen(argv[2],"w");
+	  strncpy(outfile, argv[2], BUFSIZ);
+	}
+	if (in == NULL)
+		error("can't open input file");
+	if (out == NULL)
+		error("can't open output file");
+	printf("dpp: %s -> %s\n", filename, outfile);
+	main_loop();
+}
diff --git a/src/c/earith.d b/src/c/earith.d
new file mode 100644
index 000000000..574f44907
--- /dev/null
+++ b/src/c/earith.d
@@ -0,0 +1,493 @@
+/*
+    earith.c -- Support for bignum arithmetic.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+
+	EXTENDED_MUL and EXTENDED_DIV perform 32 bit multiplication and
+	division, respectively.
+
+	EXTENDED_MUL(D,Q,R,HP,LP) 
+	calculates D*Q+R and saves the result into the locations HP and LP.
+	D, Q, and R are 32 bit non-negative integers and HP and LP are
+	word addresses.  The word at LP will contain the lower 31 (not 32)
+	bits of the result and its most significant bit is set 0. The word
+	at HP will contain the rest of the result and its MSB is also set 0.
+
+	EXTENDED_DIV(D,H,L,QP,RP)
+	divides [H:L] by D and saves the quotient and the remainder into
+	the locations QP and RP, respectively.  D, H, L are 32 bit non-negative
+	integers and QP and RP are word addresses.  Here, [H:L] means the
+	64 bit integer (imaginary) represented by H and L as follows.
+
+	  63 62                  31 30                 0
+	  |0|0|<lower 31 bits of H>|<lower 31 bits of L>|
+
+	Although [H:L] is 64 bits, you can assume that the quotient is always
+	represented as 32 bit non-negative integer.
+*/
+
+#include "ecls.h"
+
+#ifdef CONVEX
+
+static void
+extended_mul(int d, int q, int r, int *hp, int *lp)
+{
+	long long int ld, lq, lr, z;
+        int zh, zl;
+
+        ld = d;
+        lq = q;
+        lr = r;
+        z = ld*lq+lr;
+        zl = (z & 0x000000007fffffffLL);
+        zh = (z >> 31LL);
+        *hp = zh;
+        *lp = zl;
+}
+
+static void
+extended_div(int d, int h, int l, int *qp, int *rp)
+{
+	long long int lh, ld, ll;
+
+	ld = d;
+	lh = h;
+	ll = l;
+	lh = (lh << 31LL);
+	lh = (lh | ll);
+	*qp = (lh/ld);
+	*rp = (lh%ld);
+      }
+#endif CONVEX
+
+#ifdef i386
+
+static void
+extended_mul(int d, int q, int r, int *hp, int *lp)
+{ asm("pushl    %ecx");
+  asm("movl	8(%ebp),%eax");
+  asm("mull	12(%ebp)");
+  asm("addl	16(%ebp),%eax");
+  asm("adcl	$0,%edx");
+  asm("shll	$1,%edx");
+  asm("btrl	$31,%eax");
+  asm("adcl	$0,%edx");
+  asm("movl	20(%ebp),%ecx");
+  asm("movl	%edx, (%ecx)");
+  asm("movl	24(%ebp), %ecx");
+  asm("movl	%eax, (%ecx)");
+  asm("popl	%ecx");
+}
+
+static void
+extended_div(int d, int h, int l, int *qp, int *rp)
+{ 
+  asm("pushl	%ebx");
+  asm("movl	12(%ebp),%edx");
+  asm("movl	16(%ebp),%eax");
+  asm("btl	$0,%edx");
+  asm("jae	1f");
+  asm("btsl	$31,%eax");
+  asm("1: shrl	$1,%edx");
+  asm("idivl	8(%ebp)");
+  asm("movl	20(%ebp),%ebx");
+  asm("movl	%eax,(%ebx)");
+  asm("movl	24(%ebp),%ebx");
+  asm("movl	%edx,(%ebx)");
+  asm("popl	%ebx");
+}
+#endif i386
+
+#ifdef IBMRT
+
+static void
+extended_mul(int d, int q, int r, int *hp, int *lp)
+{
+  /* d=L750+20, q=L750+24, etc. */
+  asm(" get r0,L750+20(r13)");	/* get an argument */
+  asm(" mts r10,r0");		/* put in MQ */
+  asm(" get r2,L750+24(r13)");	/* get the other argument */
+  asm(" s r0,r0");		/* zero partial product. set carry to 1. */
+  asm(" m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2
+	 m r0,r2");
+  /* Now (r0)//mq has the 64 bit product; overflow is ignored. */
+  asm(" mfs r10,r2");		/* set r2 = low order word of result
+				 * so product is in (r0)//(r2).
+				 */
+  /*
+   * Force product into two single precision words.
+   */
+
+  asm(" get r3,$1f
+	 sli r0,1
+	 ar2,r2
+	 bnc0r r3");      /* branch if carry = 0 */
+  asm(" oil r0,r0,1
+	1:
+	 sri r2,1");
+  /* Now add in the third argument. */
+  asm(" get r4,$2f
+	 get r3,L750+28(r13)
+	 a r2,r3
+
+	 bnmr r4");      /* branch if not minus */
+  asm(" clrbu r2,0
+	 lis r3,1
+	 a r0,r3
+	2:
+
+	 get r3,L750+32(r13)
+	 put r0,0(r3)
+	 get r3,L750+36(r13)
+	 put r2,0(r3)
+	 ");
+}
+
+static void
+extended_div(int d, int h, int l, int *qp, int *rp)
+{
+  /* d=L754+20, h=L754+24, etc. */
+  /* Move arguments into registers. */
+  asm(" get r0,L754+28(r13)");	/* Low order word of dividend. */
+  asm(" get r2,L754+24(r13)");	/* High order word of dividend. */
+  asm(" mttbil r2,15
+	 mftbiu r0,0
+	 sri r2,1
+	 mts r10,r0
+	 get r3,L754+20(r13)")		/* Divisor. */
+    /* Perform 32 steps of division. */
+    asm(" d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3
+	 d r2,r3");
+  /* Now MQ has the quotient, R2 the remainder, and R3 is
+   * the unchanged divisor. */
+  asm(" mttbiu r2,0");		/* Do add-back if necessary. */
+  asm(" jntb 1f
+	 a r2,r3
+	1:
+	 mfs r10,r0
+	 c r2,r3");		/* Remainder : divisor. */
+  asm(" jne 2f
+	 inc r0,1
+	 x r2,r2
+	2:");
+  /* Now r0 has the quotient and r2 has the remainder. */
+  asm(" get r3,L754+32(r13)");	/* Quotient address. */
+  asm(" put r0,0(r3)");
+  asm(" get r3,L754+36(r13)");	/* Remainder address. */
+  asm(" put r2,0(r3)");
+}
+
+#endif IBMRT
+
+#if defined(NEWS) || defined(MAC)
+
+static void
+extended_mul(int d, int q, int r, int *hp, int *lp)
+{
+	asm("	move.l	d2,-(sp)
+		clr.l	d2
+		move.l	(8,fp),d0
+		mulu.l	(12,fp),d1:d0
+		add.l	(16,fp),d0
+		addx.l	d2,d1
+		lsl.l	#1,d0
+		roxl.l	#1,d1
+		lsr.l	#1,d0
+		move.l	(20,fp),a0
+		move.l	d1,(a0)
+		move.l	(24,a6),a0
+		move.l	d0,(a0)");
+}
+
+static void
+extended_div(int d, int h, int l, int *qp, int *rp)
+{
+	asm("movem.l	(12,fp),#0x303
+	lsl.l	#1,d1
+	lsr.l	#1,d0
+	roxr.l	#1,d1
+	divu.l	(8,fp),d0:d1
+	move.l	d0,(a1)
+	move.l	d1,(a0)
+	");
+}
+
+#endif NEWS
+
+#ifdef __mips
+
+ /*  earith.s for MIPS R2000 processor
+      by Doug Katzman
+      version 2.1.d dated 7/13/89 15:31 EDT */
+
+/* Register names:
+#define v0	$2	return value
+#define v1	$3
+#define a0	$4	argument registers
+#define a1	$5
+#define a2	$6
+#define a3	$7
+#define t7	$15
+*/
+
+static void
+extended_mul(unsigned int d, unsigned int q, unsigned int r, unsigned int *hp,
+	     unsigned int *lp)
+{
+  asm("mult	$4, $5");	/* [hi:lo] = d * q */
+  asm("mfhi	$5");		/* a1 = hi	   */
+  asm("sll	$5, 1");
+  asm("mflo	$4");
+  asm("srl	$15, $4, 31");
+  asm("and	$4, 0x7fffffff");
+  asm("or	$5, $15");
+  asm("addu	$4, $6");	/* [a1:a0] += r */
+  asm("srl	$15, $4, 31");
+  asm("and	$4, 0x7fffffff");
+  asm("addu	$5, $15");
+  asm("sw	$5, 0($7)"); 	/* *hp = a1 */
+#ifdef __GNUC__
+  asm("lw	$7, %0" :: "g" (lp));
+#else
+  asm("lw	$7, 16($sp)");	/* fetch fifth actual argument from stack */
+#endif __GNUC__
+  asm("sw	$4, 0($7)"); 	/* *lp = a0 */
+}
+
+static void
+extended_div(unsigned int d, unsigned int h, unsigned int l, unsigned int *qp,
+	     unsigned int *rp)
+{
+
+  asm("sll	$6, 1");
+  asm("li	$2, 31");	/* v0 holds number of shifts */
+  asm("loop:
+       srl	$15, $6, 31");
+  asm("sll	$5, 1");
+  asm("or	$5, $15");
+  asm("sll	$6, 1");
+  asm("subu	$15, $5, $4");	/* t = h - d */
+  asm("bltz	$15, underflow");
+  asm("move	$5, $15");
+  asm("or	$6, 1");
+  asm("underflow:
+       subu	$2, 1");
+  asm("bnez	$2, loop");
+  asm("sw	$6, 0($7)");	/* *qp = l */
+#ifdef __GNUC__
+  asm("lw	$7, %0" :: "g" (rp));
+#else
+  asm("lw	$7, 16($sp)");	/* fetch fifth actual argument from stack */
+#endif __GNUC__
+  asm("sw	$5, 0($7)");	/* *rp = h */
+}
+#endif __mips
+
+#if defined(sun3) || (defined __NeXT)
+
+static void
+extended_mul(int d, int q, int r, int *hp, int *lp)
+{
+	asm("
+		movl	d2,a7@-
+		clrl	d2
+		movl	a6@(8),d0
+		mulul	a6@(12),d1:d0
+		addl	a6@(16),d0
+		addxl	d2,d1
+		lsll	#1,d0
+		roxll	#1,d1
+		lsrl	#1,d0
+		movl	a6@(20),a0
+		movl	d1,a0@
+		movl	a6@(24),a0
+		movl	d0,a0@
+		movl	a7@+,d2
+		");
+}
+
+static void
+extended_div(int d, int h, int l, int *qp, int *rp)
+{
+	asm("moveml	a6@(12),#0x303
+	lsll	#1,d1
+	lsrl	#1,d0
+	roxrl	#1,d1
+	divul	a6@(8),d0:d1
+	movl	d0,a1@
+	movl	d1,a0@
+	");
+}
+
+#endif sun3
+
+/* Possible assembler version: 
+#ifdef sparc
+_extended_mul:
+!#PROLOGUE# 0
+!#PROLOGUE# 1
+	save	%sp,-96,%sp
+	mov	%i0,%o0
+	call	.umul,2
+	mov	%i1,%o1
+	addcc	%o0,%i2,%i0
+	addx    %o1,0,%o1
+	sll	%o1,1,%o1
+	tst	%i0
+	bge	L77003
+	sethi	%hi(0x7fffffff),%o3
+	or	%o3,%lo(0x7fffffff),%o3	! [internal]
+	and	%i0,%o3,%i0
+	inc	%o1
+L77003:
+	st	%i0,[%i4]
+	st	%o1,[%i3]
+	ret
+	restore	%g0,0,%o0
+
+#endif sparc
+*/
+
+#if defined(sparc) || defined(APOLLO) || defined(hpux) || defined(UNIGRAPH)n
+
+/* for the time being use the C version:*/
+
+static void
+extended_mul(unsigned int d, unsigned int q, unsigned int r, unsigned int *hp,
+	     unsigned int *lp)
+{
+  register unsigned short dlo = d & 0xffff,
+  	dhi = d >> 16,
+	qlo = q & 0xffff,
+	qhi = q >> 16;
+  unsigned int d0 = dhi * qlo + dlo * qhi,
+  	d1 = dhi * qhi,
+  	d2 = dlo * qlo;
+
+  d1 = (d1 << 1) + (d0 >> 15);	/* add 17 MSB of d0 */
+  d1 += d2 >> 31;		/* add MSB of d2 */
+  d2 &= 0x7fffffff;		/* clear MSB of d2 */
+  d2 += (d0 & 0x7fff) << 16;	/* add 15 LSB of d0: no overflow occurs */
+  d1 += d2 >> 31;		/* add MSB of d2 */
+  d2 &= 0x7fffffff;		/* clear MSB of d2 */
+  d2 += r;
+  d1 += d2 >> 31;		/* add MSB of d2 */
+  d2 &= 0x7fffffff;		/* clear MSB of d2 */
+
+  *hp = d1;
+  *lp = d2;
+}
+
+static void
+extended_div(unsigned int d, unsigned int h, unsigned int l, unsigned int *qp,
+	     unsigned int *rp)
+{
+  int i;
+  int borrow;
+
+  l = (l << 1) | 1;
+
+  for (i = 31; i >= 0;) { 
+
+    if (h >= d) {
+      h -= d;
+      borrow = 0;
+    }
+    else
+      borrow = 1;
+
+    if (i--)
+	h = (h << 1) | ((unsigned)l >> 31);
+
+    l = (l << 1) | borrow;
+
+  }
+
+  l = - l - 1;
+
+  *qp = l;
+  *rp = h;
+}
+
+#endif sparc
+
+#ifdef vax
+
+static void
+extended_mul(int d, int q, int r, int *hp, int *lp)
+{
+	asm("	emul	4(ap),8(ap),12(ap),r0");
+	asm("	ashq	$1,r0,r0");
+	asm("	rotl	$-1,r0,r0");
+	asm("	movl	r0,*20(ap)");
+	asm("	movl	r1,*16(ap)");
+}
+
+static void
+extended_div(int d, int h, int l, int *qp, int *rp)
+{
+	asm("	clrl	r0");
+	asm("	movl	8(ap),r1");
+	asm("	ashq	$-1,r0,r0");
+	asm("	addl2	12(ap),r0");
+	asm("	ediv	4(ap),r0,*16(ap),*20(ap)");
+}
+#endif vax
diff --git a/src/c/error.d b/src/c/error.d
new file mode 100644
index 000000000..cda422537
--- /dev/null
+++ b/src/c/error.d
@@ -0,0 +1,379 @@
+/*
+    error.c -- Error handling.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+/******************************* EXPORTS ******************************/
+
+cl_object Sarithmetic_error, Scell_error, Scondition;
+cl_object Scontrol_error, Sdivision_by_zero, Send_of_file;
+cl_object Serror, Sfile_error, Sfloating_point_inexact;
+cl_object Sfloating_point_invalid_operation, Sfloating_point_overflow;
+cl_object Sfloating_point_underflow, Spackage_error, Sparse_error;
+cl_object Sprint_not_readable, Sprogram_error, Sreader_error;
+cl_object Sserious_condition, Ssimple_condition, Ssimple_error;
+cl_object Ssimple_type_error, Ssimple_warning, Sstorage_condition;
+cl_object Sstream_error, Sstyle_warning, Stype_error, Sunbound_slot;
+cl_object Sunbound_variable, Sundefined_function, Swarning;
+
+cl_object siSsimple_program_error, siSsimple_control_error;
+
+cl_object Kpathname;			/* file-error */
+cl_object Kdatum, Kexpected_type;	/* type-error */
+cl_object Kformat_control, Kformat_arguments;	/* simple-condition */
+
+/******************************* ------- ******************************/
+
+void
+cs_overflow(void)
+{
+#ifdef DOWN_STACK
+	if (cs_limit < cs_org - cssize)
+	  cs_limit -= CSGETA;
+#else
+	if (cs_limit > cs_org + cssize)
+	  cs_limit += CSGETA;
+#endif
+	FEerror("Control stack overflow.", 0);
+}
+
+void
+error(const char *s)
+{
+	printf("\nUnrecoverable error: %s\n", s);
+	fflush(stdout);
+#ifdef SIGIOT
+	signal(SIGIOT, SIG_DFL); /* avoid getting into a loop with abort */
+#endif
+	abort();
+}
+
+void
+internal_error(const char *s)
+{
+	printf("\nInternal error in %s()\n", s);
+	fflush(stdout);
+#ifdef SIGIOT
+	signal(SIGIOT, SIG_DFL); /* avoid getting into a loop with abort */
+#endif
+	abort();
+}
+
+/*****************************************************************************/
+/*		Support for Lisp Error Handler				     */
+/*****************************************************************************/
+
+cl_object siSuniversal_error_handler;
+
+cl_object null_string;
+
+cl_object siSterminal_interrupt;
+
+void
+terminal_interrupt(bool correctable)
+{
+	funcall(2, siSterminal_interrupt, correctable? Ct : Cnil);
+}
+
+void
+FEerror(char *s, int narg, ...)
+{
+	va_list args;
+	cl_object rest = Cnil, *r = &rest;
+
+	va_start(args, narg);
+	while (narg--)
+	  r = &CDR(*r = CONS(va_arg(args, cl_object), Cnil));
+	funcall(4, siSuniversal_error_handler,
+		Cnil,                    /*  not correctable  */
+		make_simple_string(s),	 /*  condition text  */
+		rest);
+}
+
+cl_object
+CEerror(char *err, int narg, ...)
+{
+	int i = narg;
+	va_list args;
+	cl_object rest = Cnil, *r = &rest;
+
+	va_start(args, narg);
+	while (i--)
+	  r = &CDR(*r = CONS(va_arg(args, cl_object), Cnil));
+	return funcall(4, siSuniversal_error_handler,
+		       Ct,			/*  correctable  */
+		       make_simple_string(err),	/*  continue-format-string  */
+		       rest);
+}
+
+/***********************
+ * Conditions signaler *
+ ***********************/
+
+void
+FEcondition(int narg, cl_object name, ...)
+{
+	va_list args;
+	cl_object rest = Cnil, *r = &rest;
+
+	va_start(args, name);
+	while (--narg) {
+		*r = CONS(va_arg(args, cl_object), Cnil);
+		r = &CDR(*r);
+	}
+	funcall(4, siSuniversal_error_handler,
+		Cnil,                    /*  not correctable  */
+		name,                    /*  condition name  */
+		rest);
+}
+
+void
+FEprogram_error(const char *s, int narg, ...)
+{
+	va_list args;
+	cl_object rest = Cnil, *r = &rest;
+
+	gc(t_contiguous);
+	va_start(args, narg);
+	while (narg--) {
+		*r = CONS(va_arg(args, cl_object), Cnil);
+		printf("%d\n",type_of(CAR(*r)));
+		r = &CDR(*r);
+	}
+	funcall(4, siSuniversal_error_handler,
+		Cnil,                    /*  not correctable  */
+		siSsimple_program_error, /*  condition name  */
+		list(4, Kformat_control, make_simple_string(s),
+		     Kformat_arguments, rest));
+}
+
+void
+FEcontrol_error(const char *s, int narg, ...)
+{
+	va_list args;
+	cl_object rest = Cnil, *r = &rest;
+
+	va_start(args, narg);
+	while (narg--) {
+		*r = CONS(va_arg(args, cl_object), Cnil);
+		r = &CDR(*r);
+	}
+	funcall(4, siSuniversal_error_handler,
+		Cnil,                    /*  not correctable  */
+		siSsimple_control_error, /*  condition name  */
+		list(4, Kformat_control, make_simple_string(s),
+		     Kformat_arguments, rest));
+}
+
+void
+FEcannot_open(cl_object fn)
+{
+	FEcondition(3, Sfile_error, Kpathname, fn);
+}
+
+void
+FEend_of_file(cl_object strm)
+{
+	FEcondition(3, Send_of_file, Kstream, strm);
+}
+
+void
+FEwrong_type_argument(cl_object type, cl_object value)
+{
+	FEcondition(5, Stype_error, Kdatum, value, Kexpected_type, type);
+}
+
+void
+FEunbound_variable(cl_object sym)
+{
+	FEcondition(3, Sunbound_variable, Kname, sym);
+}
+
+void
+FEundefined_function(cl_object fname)
+{
+	FEcondition(3, Sundefined_function, Kname, fname);
+}
+
+/*************
+ * Shortcuts *
+ *************/
+
+void
+FEtoo_few_arguments(int *nargp)
+{
+	cl_object fname = ihs_top_function_name();
+	FEprogram_error("Function ~S requires more than ~R argument~:p.",
+			2, fname, MAKE_FIXNUM(*nargp));
+}
+
+void
+FEtoo_many_arguments(int *nargp)
+{
+	cl_object fname = ihs_top_function_name();
+	FEprogram_error("Function ~S requires less than ~R argument~:p.",
+			2, fname, MAKE_FIXNUM(*nargp));
+}
+
+void
+FEinvalid_macro_call(cl_object name)
+{
+	FEerror("Invalid macro call to ~S.", 1, name);
+}
+
+void
+FEinvalid_variable(char *s, cl_object obj)
+{
+	FEerror(s, 1, obj);
+}
+
+void
+FEassignment_to_constant(cl_object v)
+{
+	FEprogram_error("SETQ: Tried to assign a value to the constant ~S.", 1, v);
+}
+
+void
+FEinvalid_function(cl_object obj)
+{
+	FEwrong_type_argument(Sfunction, obj);
+}
+
+/*      bootstrap version                */
+@(defun si::universal_error_handler (c err args)
+@
+	printf("\nLisp initialization error.\n");
+	Lprint(1, err);
+	Lprint(1, args);
+#ifndef ALFA
+	exit(0);
+#endif
+@)
+
+void
+check_arg_failed(int narg, int req)
+{
+	cl_object fname = ihs_top_function_name();
+	FEprogram_error((narg < req)
+			? "Function ~S requires ~R argument~:p,~%\
+but only ~R ~:*~[were~;was~:;were~] supplied."
+			: "Function ~S requires only ~R argument~:p,~%\
+but ~R ~:*~[were~;was~:;were~] supplied.",
+			3, fname, MAKE_FIXNUM(req), MAKE_FIXNUM(narg));
+}
+
+void
+illegal_index(cl_object x, cl_object i)
+{
+	FEerror("~S is an illegal index to ~S.", 2, i, x);
+}
+
+void
+FEtype_error_symbol(cl_object obj)
+{
+	FEwrong_type_argument(Ssymbol, obj);
+}
+
+void
+not_a_variable(cl_object obj)
+{
+	FEinvalid_variable("~S is not a variable.", obj);
+}
+
+/************************************
+ * Higher level interface to errors *
+ ************************************/
+
+@(defun error (eformat &rest args)
+	int i;
+	cl_object rest = Cnil, *r = &rest;
+@
+	for (i=narg-1; i; i--) {
+	  *r = CONS(va_arg(args, cl_object), Cnil);
+	  r = &CDR(*r);
+	}
+	funcall(4, siSuniversal_error_handler,
+		Cnil,
+		eformat,
+		rest);
+@)
+
+@(defun cerror (cformat eformat &rest args)
+	int i;
+	cl_object rest = Cnil, *r = &rest;
+@
+	for (i=narg-2; i; i--) {
+	  *r = CONS(va_arg(args, cl_object), Cnil);
+	  r = &CDR(*r);
+	}
+	return(funcall(4, siSuniversal_error_handler,
+		       cformat,
+		       eformat,
+		       rest));
+@)
+
+#if defined(FRAME_CHAIN) && !defined(RUNTIME)
+static char *
+get_current_frame(void)
+{
+  char *frame;
+  GET_CURRENT_FRAME(frame);
+  return frame;
+}
+
+@(defun si::backtrace ()
+  char *this_frame, *next_frame, *next_pc;
+  bool first = TRUE;
+  cl_object sym;
+  jmp_buf buf;
+@
+  /* ensure flushing of register caches */
+  if (ecls_setjmp(buf) == 0) ecls_longjmp(buf, 1);
+
+  this_frame = get_current_frame();
+  while (TRUE) {
+      next_frame = FRAME_CHAIN(this_frame);
+      next_pc = FRAME_SAVED_PC(this_frame);
+#ifdef DOWN_STACK
+      if (next_frame == 0 || next_frame > (char *)cs_org) break;
+#else
+      if (next_frame < (char *)cs_org) break;
+#endif
+      sym = (cl_object)get_function_entry(next_pc);
+      if (sym) {
+	if (!first)
+	  printf(" < ");
+	else
+	  first = FALSE;
+	princ(sym, Cnil);
+      }
+/*
+      else
+	printf("FP: 0x%x, PC: 0x%x\n", next_frame, next_pc);
+*/
+      this_frame = next_frame;
+  }
+  @(return)
+@)
+#endif
+
+void
+init_error(void)
+{
+	null_string = make_simple_string("");
+	register_root(&null_string);
+}
diff --git a/src/c/eval.d b/src/c/eval.d
new file mode 100644
index 000000000..b789f228c
--- /dev/null
+++ b/src/c/eval.d
@@ -0,0 +1,293 @@
+/*
+    eval.c -- Eval.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "ecls-inl.h"
+
+/******************************* EXPORTS ******************************/
+
+cl_object Sapply;
+cl_object Sfuncall;
+
+/******************************* ------- ******************************/
+
+static struct nil3 { cl_object nil3_self[3]; } three_nils;
+
+#define SYMBOL_FUNCTION(sym)    (SYM_FUN(sym) == OBJNULL ? \
+				 (FEundefined_function(sym),Cnil) : SYM_FUN(sym))
+
+#ifdef THREADS
+#define eval1            clwp->lwp_eval1
+#else
+static int eval1 = 0;          /*  = 1 during one-shot bypass of evalhook/applyhook  */
+#endif THREADS
+
+cl_object Vevalhook;
+cl_object Vapplyhook;
+
+/* Calling conventions:
+   Compiled C code calls lisp function supplying #args, and args.
+   Linking function performs check_args, gets jmp_buf with _setjmp, then
+    if cfun then stores C code address into function link location
+	    and transfers to jmp_buf at cf_self
+    if cclosure then replaces #args with cc_env and calls cc_self
+    otherwise, it emulates funcall.
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ *     apply --
+ *	    applies a Lisp function to the arguments in array args.
+ *	    narg is their count.
+ *
+ *     Results:
+ *	    number of values
+ *
+ *     Side Effect:
+ *	    values are placed into the array Values
+ *----------------------------------------------------------------------
+ */
+cl_object
+apply(int narg, cl_object fun, cl_object *args)
+{
+	cl_object x = fun;
+
+      AGAIN:
+	if (fun == OBJNULL)
+		FEundefined_function(x);
+
+	switch (type_of(fun)) {
+	case t_cfun:
+		return APPLY(narg, fun->cfun.entry, args);
+
+	case t_cclosure:
+		return APPLY_closure(narg, fun->cclosure.entry, fun->cclosure.env, args);
+		
+#ifdef CLOS
+	case t_gfun:
+		return gcall(narg, fun, args);
+#endif
+
+	case t_symbol:
+		fun = SYM_FUN(fun);
+		goto AGAIN;
+
+	case t_bytecodes:
+		{
+		  cl_object mv_values[narg]; /* __GNUC__ */
+		  /* move args out of VALUES, or macroexpand of fun's body
+		     will clobber them */
+		  memcpy(mv_values, args, narg * sizeof(cl_object));
+		  return lambda_apply(narg, fun, mv_values);
+		}
+		break;
+	default:
+	}
+	FEinvalid_function(fun);
+}
+
+cl_return
+funcall(int narg, ...)
+{
+	cl_object fun, x;
+	va_list funargs;
+	va_start(funargs, narg);
+	fun = va_arg(funargs, cl_object);
+
+      AGAIN:
+	if (fun == OBJNULL) {
+		va_start(funargs, narg);
+		FEundefined_function(va_arg(funargs, cl_object));
+	      }
+	switch (type_of(fun)) {
+	case t_cfun:
+		return APPLY(narg-1, fun->cfun.entry, funargs);
+
+	case t_cclosure:
+		return APPLY_closure(narg-1, fun->cclosure.entry, fun->cclosure.env, funargs);
+
+#ifdef CLOS
+	case t_gfun:
+		return gcall(narg-1, fun, funargs);
+#endif
+
+	case t_symbol:
+		fun = SYM_FUN(fun);
+		goto AGAIN;
+
+	case t_bytecodes:
+		return lambda_apply(narg-1, fun, (cl_object *)funargs);
+
+	default:
+	}
+	FEinvalid_function(fun);
+}
+
+/*----------------------------------------------------------------------*
+ *	Linking mechanism						*
+ *----------------------------------------------------------------------*/
+
+static cl_object siSlink_to;
+static cl_object siSlink_from;
+
+cl_object
+#ifdef CLOS
+link_call(cl_object sym, cl_object (**pLK)(), cl_object *gfun, cl_object *args)
+#else
+link_call(cl_object sym, cl_object (**pLK)(), cl_object *args)
+#endif CLOS
+{       int narg = (int)args[0];
+	cl_object fun = symbol_function(sym);
+
+	if (fun == OBJNULL) FEerror("Undefined function.", 0);
+
+	switch (type_of(fun)) {
+	case t_cfun:
+	  putprop(sym, CONS(CONS(MAKE_FIXNUM((int)pLK),
+				 MAKE_FIXNUM((int)*pLK)),
+			    getf(sym->symbol.plist, siSlink_from, Cnil)),
+		  siSlink_from);
+	  *pLK = fun->cfun.entry;
+	  return APPLY(narg, fun->cfun.entry, &args[1]);
+#ifdef CLOS
+	case t_gfun:
+	  putprop(sym, CONS(CONS(MAKE_FIXNUM((int)gfun),
+				 MAKE_FIXNUM((int)OBJNULL)),
+			    getf(sym->symbol.plist, siSlink_from, Cnil)),
+		  siSlink_from);
+	  *gfun = fun;
+	  return gcall(narg, fun, &args[1]);
+#endif CLOS
+	case t_cclosure:
+		args[0] = (cl_object)fun->cclosure.env;
+		return APPLY(narg+1, fun->cclosure.entry, args);
+
+	case t_bytecodes:
+		return lambda_apply(narg, fun, &args[1]);
+
+	default:
+		FEinvalid_function(fun);
+	}
+}
+
+@(defun si::unlink_symbol (s)
+	cl_object pl;
+@
+	if (!SYMBOLP(s))
+		FEtype_error_symbol(s);
+	pl = getf(s->symbol.plist, siSlink_from, Cnil);
+	if (!endp(pl)) {
+		for (; !endp(pl); pl = CDR(pl))
+			*(int *)(fix(CAAR(pl))) = fix(CDAR(pl));
+		remf(&s->symbol.plist, siSlink_from);
+	}
+	@(return)
+@)
+
+@(defun funcall (fun &rest args)
+@
+	return(apply(narg-1, fun, (cl_object *)args));
+@)
+
+@(defun apply (fun lastarg &rest args)
+	int i;
+@
+	narg -= 2;
+	for (i = 0; narg; narg--) {
+		VALUES(i++) = lastarg;
+		lastarg = va_arg(args, cl_object);
+	}
+	loop_for_in (lastarg) {
+		VALUES(i++) = CAR(lastarg);
+	} end_loop_for_in;
+ 	{
+ 	cl_object savargs[i];
+ 	memcpy(savargs, &VALUES(0), i*sizeof(cl_object));
+ 	return apply(i, fun, savargs);
+ 	}
+@)
+
+@(defun eval (form)
+	cl_object output, lex_old = lex_env;
+@
+	lex_new();
+	output = eval(form, NULL);
+	lex_env = lex_old;
+	returnn(output);
+@)
+
+@(defun evalhook (form evalhookfn applyhookfn &optional (env Cnil))
+	cl_object output, lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+@
+	lex_env = env;
+	lex_copy();
+	bds_bind(Vevalhook, evalhookfn);
+	bds_bind(Vapplyhook, applyhookfn);
+	eval1 = 1;
+	output = eval(form, NULL);
+	bds_unwind(old_bds_top);
+	lex_env = lex_old;
+	returnn(output);
+@)
+
+@(defun applyhook (fun args evalhookfn applyhookfn)
+	bds_ptr old_bds_top = bds_top;
+@
+	bds_bind(Vevalhook, evalhookfn);
+	bds_bind(Vapplyhook, applyhookfn);
+	VALUES(0) = Lapply(2, fun, args);
+	bds_unwind(old_bds_top);
+	returnn(VALUES(0));
+@)
+
+@(defun constantp (arg)
+	cl_object flag;
+@
+	switch (type_of(arg)) {
+	case t_cons:
+		flag = (CAR(arg) == Squote) ? Ct : Cnil;
+		break;
+	case t_symbol:
+		flag = (arg->symbol.stype == stp_constant) ? Ct : Cnil;
+		break;
+	default:
+		flag = Ct;
+	}
+	@(return flag)
+@)
+
+void
+init_eval(void)
+{
+	make_constant("CALL-ARGUMENTS-LIMIT", MAKE_FIXNUM(64));
+
+	SYM_VAL(Vevalhook) = Cnil;
+	SYM_VAL(Vapplyhook) = Cnil;
+
+	eval1 = 0;
+
+	three_nils.nil3_self[0] = Cnil;
+	three_nils.nil3_self[1] = Cnil;
+	three_nils.nil3_self[2] = Cnil;
+
+	siSlink_from = make_si_ordinary("LINK-FROM");
+	register_root(&siSlink_from);
+	siSlink_to = make_si_ordinary("LINK-TO");
+	register_root(&siSlink_to);
+}
diff --git a/src/c/file.d b/src/c/file.d
new file mode 100644
index 000000000..ad56d0854
--- /dev/null
+++ b/src/c/file.d
@@ -0,0 +1,1601 @@
+/*
+    file.d -- File interface.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+	IMPLEMENTATION-DEPENDENT
+
+	The file contains code to reclaim the I/O buffer
+	by accessing the FILE structure of C.
+*/
+
+#include <ecls.h>
+
+#if defined(BSD) && !defined(MSDOS)
+#include <sys/ioctl.h>
+#endif
+
+/******************************* EXPORTS ******************************/
+cl_object Vstandard_input;
+cl_object Vstandard_output;
+cl_object Verror_output;
+cl_object Vquery_io;
+cl_object Vdebug_io;
+cl_object Vterminal_io;
+cl_object Vtrace_output;
+
+cl_object Kabort;
+cl_object Kdirection;
+cl_object Kinput;
+cl_object Koutput;
+cl_object Kio;
+cl_object Kprobe;
+cl_object Kelement_type;
+cl_object Kdefault;
+cl_object Kif_exists;
+cl_object Kerror;
+cl_object Knew_version;
+cl_object Krename;
+cl_object Krename_and_delete;
+cl_object Koverwrite;
+cl_object Kappend;
+cl_object Ksupersede;
+cl_object Kcreate;
+cl_object Kprint;
+cl_object Kif_does_not_exist;
+cl_object Kset_default_pathname;
+
+/******************************* ------- ******************************/
+
+static cl_object terminal_io;
+
+cl_object siVignore_eof_on_terminal_io;
+
+static bool
+feof1(FILE *fp)
+{
+	if (!feof(fp))
+		return(FALSE);
+	if (fp == terminal_io->stream.object0->stream.file) {
+		if (Null(symbol_value(siVignore_eof_on_terminal_io)))
+			return(TRUE);
+#ifdef unix
+		fp = freopen("/dev/tty", "r", fp);
+#endif
+		if (fp == NULL)
+			error("can't reopen the console");
+		return(FALSE);
+	}
+	return(TRUE);
+}
+
+#undef  feof
+#define feof    feof1
+
+/*----------------------------------------------------------------------
+ *	Input_stream_p(strm) answers
+ *	if stream strm is an input stream or not.
+ *	It does not check if it really is possible to read
+ *	from the stream,
+ *	but only checks the mode of the stream (sm_mode).
+ *----------------------------------------------------------------------
+ */
+bool
+input_stream_p(cl_object strm)
+{
+BEGIN:
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		break;
+
+	case smm_io:
+	case smm_input:
+	case smm_concatenated:
+	case smm_two_way:
+	case smm_echo:
+	case smm_string_input:
+		return(TRUE);
+
+	case smm_output:
+	case smm_probe:
+	case smm_string_output:
+	case smm_broadcast:
+		return(FALSE);
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+/*----------------------------------------------------------------------
+ *	Output_stream_p(strm) answers
+ *	if stream strm is an output stream.
+ *	It does not check if it really is possible to write
+ *	to the stream,
+ *	but only checks the mode of the stream (sm_mode).
+ *----------------------------------------------------------------------
+ */
+bool
+output_stream_p(cl_object strm)
+{
+BEGIN:
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		return(FALSE);
+
+	case smm_input:
+	case smm_probe:
+	case smm_concatenated:
+	case smm_string_input:
+		return(FALSE);
+
+	case smm_output:
+	case smm_io:
+	case smm_two_way:
+	case smm_echo:
+	case smm_broadcast:
+	case smm_string_output:
+		return(TRUE);
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+cl_object
+stream_element_type(cl_object strm)
+{
+	cl_object x;
+
+BEGIN:
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		return(FALSE);
+
+	case smm_input:
+	case smm_output:
+	case smm_io:
+	case smm_probe:
+		return(strm->stream.object0);
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_broadcast:
+		x = strm->stream.object0;
+		if (endp(x))
+			return(Ct);
+		return(stream_element_type(CAR(x)));
+
+	case smm_concatenated:
+		x = strm->stream.object0;
+		if (endp(x))
+			return(Ct);
+		return(stream_element_type(CAR(x)));
+
+	case smm_two_way:
+	case smm_echo:
+		return(stream_element_type(strm->stream.object0));
+
+	case smm_string_input:
+	case smm_string_output:
+		return(Sbase_char);
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+/*----------------------------------------------------------------------
+ *	Error messages
+ *----------------------------------------------------------------------
+ */
+
+static void cannot_create(cl_object fn) __attribute__((noreturn));
+static void cannot_read(cl_object fn) __attribute__((noreturn));
+static void cannot_write(cl_object fn) __attribute__((noreturn));
+static void internal_stream_error(const char *routine, cl_object strm) __attribute__((noreturn));
+
+static void
+cannot_create(cl_object fn)
+{
+	FEerror("Cannot create the file ~A.", 1, fn);
+}
+
+static void
+cannot_read(cl_object strm)
+{
+	FEerror("Cannot read the stream ~S.", 1, strm);
+}
+
+static void
+cannot_write(cl_object strm)
+{
+	FEerror("Cannot write to the stream ~S.", 1, strm);
+}
+
+static void
+internal_stream_error(const char *routine, cl_object strm)
+{
+	FEerror("~A : internal error, closed stream ~S without smm_mode flag.",
+		2, make_simple_string(routine), strm);
+}
+
+void
+closed_stream(cl_object strm)
+{
+	FEerror("The stream ~S is already closed.", 1, strm);
+}
+
+/*----------------------------------------------------------------------
+ *	Open_stream(fn, smm, if_exists, if_does_not_exist)
+ *	opens file fn with mode smm.
+ *	Fn is a pathname designator.
+ *----------------------------------------------------------------------
+ */
+cl_object
+open_stream(cl_object fn, enum smmode smm, cl_object if_exists,
+	    cl_object if_does_not_exist)
+{
+	cl_object x;
+	FILE *fp;
+	char *fname = coerce_to_filename(fn)->string.self;
+
+	if (smm == smm_input || smm == smm_probe) {
+		fp = fopen(fname, OPEN_R);
+		if (fp == NULL) {
+			if (if_does_not_exist == Kerror)
+				FEcannot_open(fn);
+			else if (if_does_not_exist == Kcreate) {
+				fp = fopen(fname, OPEN_W);
+				if (fp == NULL)
+					cannot_create(fn);
+				fclose(fp);
+				fp = fopen(fname, OPEN_R);
+				if (fp == NULL)
+					FEcannot_open(fn);
+			} else if (Null(if_does_not_exist))
+				return(Cnil);
+			else
+			 FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",
+				 1, if_does_not_exist);
+		}
+	} else if (smm == smm_output || smm == smm_io) {
+		if (if_exists == Knew_version && if_does_not_exist == Kcreate)
+			goto CREATE;
+		fp = fopen(fname, OPEN_R);
+		if (fp != NULL) {
+			fclose(fp);
+			if (if_exists == Kerror)
+				FEerror("The file ~A already exists.", 1, fn);
+			else if (if_exists == Krename) {
+				fp = backup_fopen(fname, (smm == smm_output)
+						  ? OPEN_W
+						  : OPEN_RW);
+				if (fp == NULL)
+					cannot_create(fn);
+			} else if (if_exists == Krename_and_delete ||
+				   if_exists == Knew_version ||
+				   if_exists == Ksupersede) {
+				fp = fopen(fname, (smm == smm_output)
+					   ? OPEN_W
+					   : OPEN_RW);
+				if (fp == NULL)
+					cannot_create(fn);
+			} else if (if_exists == Koverwrite) {
+				fp = fopen(fname, OPEN_RW);
+				if (fp == NULL)
+					FEcannot_open(fn);
+			} else if (if_exists == Kappend) {
+				fp = fopen(fname, (smm == smm_output)
+					   ? OPEN_A
+					   : OPEN_RA);
+				if (fp == NULL)
+				FEerror("Cannot append to the file ~A.",1,fn);
+			} else if (Null(if_exists))
+				return(Cnil);
+			else
+				FEerror("~S is an illegal IF-EXISTS option.",
+					1, if_exists);
+		} else {
+			if (if_does_not_exist == Kerror)
+				FEerror("The file ~A does not exist.", 1, fn);
+			else if (if_does_not_exist == Kcreate) {
+			CREATE:
+				fp = fopen(fname, (smm == smm_output)
+					   ? OPEN_W
+					   : OPEN_RW);
+				if (fp == NULL)
+					cannot_create(fn);
+			} else if (Null(if_does_not_exist))
+				return(Cnil);
+			else
+			 FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",
+				 1, if_does_not_exist);
+		}
+	} else
+		error("illegal stream mode");
+	x = alloc_object(t_stream);
+	x->stream.mode = (short)smm;
+	x->stream.file = fp;
+	x->stream.object0 = Sbase_char;
+	x->stream.object1 = fn;
+	x->stream.int0 = x->stream.int1 = 0;
+#if !defined(GBC_BOEHM)
+	fp->_IO_buf_base = NULL; /* BASEFF; */
+	setbuf(fp, x->stream.buffer = alloc(BUFSIZ));
+#endif
+	return(x);
+}
+
+
+/*----------------------------------------------------------------------
+ *	Close_stream(strm, abort_flag) closes stream strm.
+ *	The abort_flag is not used now.
+ *----------------------------------------------------------------------
+ */
+void
+close_stream(cl_object strm, bool abort_flag)        /*  Not used now!  */
+{
+	FILE *fp;
+
+	fp = strm->stream.file;
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+	  /* It is permissible to close a closed stream, although the output
+	     is unspecified in those cases. */
+		break;
+
+	case smm_output:
+	    if (fp == stdout)
+	      FEerror("Cannot close the standard output.", 0);
+	    if (fp == NULL)
+	      internal_stream_error("close_stream", strm);
+	    fflush(fp);
+	    fclose(fp);
+#if !defined(GBC_BOEHM)
+	    dealloc(strm->stream.buffer, BUFSIZ);
+	    strm->stream.buffer = NULL;
+#endif
+	    strm->stream.file = NULL;
+	    break;
+
+	case smm_input:
+		if (fp == stdin)
+			FEerror("Cannot close the standard input.", 0);
+
+	case smm_io:
+	case smm_probe:
+	    if (fp == NULL)
+	      internal_stream_error("close_stream", strm);
+	    fclose(fp);
+#if !defined(GBC_BOEHM)
+	    dealloc(strm->stream.buffer, BUFSIZ);
+	    strm->stream.file = NULL;
+#endif
+	    break;
+#if 0
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_broadcast:
+		for (x = strm->stream.object0; !endp(x); x = CDR(x))
+			close_stream(CAR(x), abort_flag);
+		strm->stream.object0 = Cnil;
+		break;
+
+	case smm_concatenated:
+		for (x = strm->stream.object0; !endp(x); x = CDR(x))
+			close_stream(CAR(x), abort_flag);
+		break;
+
+	case smm_two_way:
+		close_stream(strm->stream.object0, abort_flag);
+		close_stream(strm->stream.object1, abort_flag);
+		break;
+
+	case smm_echo:
+		close_stream(strm->stream.object0, abort_flag);
+		close_stream(strm->stream.object1, abort_flag);
+		break;
+
+	case smm_string_input:
+		break;          /*  There is nothing to do.  */
+
+	case smm_string_output:
+		break;          /*  There is nothing to do.  */
+#else
+	case smm_synonym:
+	case smm_broadcast:
+	case smm_concatenated:
+	case smm_two_way:
+	case smm_echo:
+	case smm_string_input:
+	case smm_string_output:
+	  /* The elements of a composite stream are not closed. For
+	     composite streams we zero object1. For files we do not,
+	     as it might contain an useful pathname */
+		strm->stream.object1 = OBJNULL;
+		break;
+#endif
+	default:
+		error("illegal stream mode");
+	}
+	strm->stream.mode = smm_closed;
+	strm->stream.file = NULL;
+	strm->stream.object0 = OBJNULL;
+}
+
+cl_object
+make_two_way_stream(cl_object istrm, cl_object ostrm)
+{
+	cl_object strm;
+
+	strm = alloc_object(t_stream);
+	strm->stream.mode = (short)smm_two_way;
+	strm->stream.file = NULL;
+	strm->stream.object0 = istrm;
+	strm->stream.object1 = ostrm;
+	strm->stream.int0 = strm->stream.int1 = 0;
+	return(strm);
+}
+
+cl_object
+make_echo_stream(cl_object istrm, cl_object ostrm)
+{
+	cl_object strm;
+
+	strm = make_two_way_stream(istrm, ostrm);
+	strm->stream.mode = (short)smm_echo;
+	return(strm);
+}
+
+cl_object
+make_string_input_stream(cl_object strng, cl_index istart, cl_index iend)
+{
+	cl_object strm;
+
+	strm = alloc_object(t_stream);
+	strm->stream.mode = (short)smm_string_input;
+	strm->stream.file = NULL;
+	strm->stream.object0 = strng;
+	strm->stream.object1 = OBJNULL;
+	strm->stream.int0 = istart;
+	strm->stream.int1 = iend;
+	return(strm);
+}
+
+cl_object
+make_string_output_stream(cl_index line_length)
+{
+	cl_object strng, strm;
+
+	line_length++;
+	strng = alloc_object(t_string);
+	strng->string.hasfillp = TRUE;
+	strng->string.adjustable = TRUE;
+	strng->string.displaced = Cnil;
+	strng->string.dim = line_length;
+	strng->string.fillp = 0;
+	strng->string.self = NULL; /*  For GC sake  */
+	strng->string.self = alloc(line_length);
+	strng->string.self[0] = '\0';
+	strm = alloc_object(t_stream);
+	strm->stream.mode = (short)smm_string_output;
+	strm->stream.file = NULL;
+	strm->stream.object0 = strng;
+	strm->stream.object1 = OBJNULL;
+	strm->stream.int0 = strm->stream.int1 = 0;
+	return(strm);
+}
+
+cl_object
+get_output_stream_string(cl_object strm)
+{
+	cl_object strng;
+
+	strng = copy_simple_string(strm->stream.object0);
+	strm->stream.object0->string.fillp = 0;
+	return(strng);
+}
+
+
+
+#ifdef TK
+bool no_input = FALSE;
+
+StdinEnableEvents()
+{
+  no_input = TRUE;
+}
+
+StdinResume()
+{
+  no_input = FALSE;
+}
+# define GETC(c, fp)	{ if (fp == stdin) \
+			   while (no_input) Tk_DoOneEvent(0); \
+			  c = getc(fp); \
+			  no_input = !FILE_CNT(fp); }
+# define UNGETC(c, fp)	{ if (fp == stdin) no_input = FALSE; ungetc(c, fp); }
+#else
+# define GETC(c, fp)	c = getc(fp)
+# define UNGETC(c, fp)	ungetc(c, fp)
+#endif
+
+int
+readc_stream(cl_object strm)
+{
+	int c;
+	FILE *fp;
+
+BEGIN:
+	fp = strm->stream.file;
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		break;
+
+	case smm_input:
+	case smm_io:
+		if (fp == NULL)
+			internal_stream_error("readc_stream",strm);
+		GETC(c, fp);
+/*		c &= 0377; */
+		if (feof(fp))
+			FEend_of_file(strm);
+/* 		strm->stream.int0++; useless in smm_io, Beppe */
+		return(c);
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_concatenated:
+		{ cl_object strmi = strm->stream.object0;
+		  while (!endp(strmi)) {
+		    if (!stream_at_end(CAR(strmi)))
+		      return(readc_stream(CAR(strmi)));
+		    strm->stream.object0 = strmi = CDR(strmi);
+		  }
+		  FEend_of_file(strm);
+		}
+
+	case smm_two_way:
+#ifdef unix
+		if (strm == terminal_io)                                /**/
+			flush_stream(terminal_io->stream.object1);       /**/
+#endif
+		strm->stream.int1 = 0;
+		strm = strm->stream.object0;
+		goto BEGIN;
+
+	case smm_echo:
+		c = readc_stream(strm->stream.object0);
+		if (strm->stream.int0 == 0)
+			writec_stream(c, strm->stream.object1);
+		else		/* don't echo twice if it was unread */
+			--(strm->stream.int0);
+		return(c);
+
+	case smm_string_input:
+		if (strm->stream.int0 >= strm->stream.int1)
+			FEend_of_file(strm);
+		return(strm->stream.object0->string.self[strm->stream.int0++]);
+
+	case smm_output:
+	case smm_probe:
+	case smm_broadcast:
+	case smm_string_output:
+		cannot_read(strm);
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+void
+unreadc_stream(int c, cl_object strm)
+{
+	FILE *fp;
+
+BEGIN:
+	fp = strm->stream.file;
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		break;
+
+	case smm_input:
+	case smm_io:
+		if (fp == NULL)
+			internal_stream_error("unreadc_stream",strm);
+		UNGETC(c, fp);
+/*		--strm->stream.int0; useless in smm_io, Beppe */
+		break;
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_concatenated:
+		if (endp(strm->stream.object0))
+			goto UNREAD_ERROR;
+		strm = CAR(strm->stream.object0);
+		goto BEGIN;
+
+	case smm_two_way:
+		strm = strm->stream.object0;
+		goto BEGIN;
+
+	case smm_echo:
+		unreadc_stream(c, strm->stream.object0);
+		(strm->stream.int0)++;
+		break;
+
+	case smm_string_input:
+		if (strm->stream.int0 <= 0)
+			goto UNREAD_ERROR;
+		--strm->stream.int0;
+		break;
+
+	case smm_output:
+	case smm_probe:
+	case smm_broadcast:
+	case smm_string_output:
+		goto UNREAD_ERROR;
+
+	default:
+		error("illegal stream mode");
+	}
+	return;
+
+UNREAD_ERROR:
+	FEerror("Cannot unread the stream ~S.", 1, strm);
+}
+
+int
+writec_stream(int c, cl_object strm)
+{
+	cl_object x;
+	unsigned char *p;
+	cl_index i;
+	FILE *fp;
+
+BEGIN:
+	fp = strm->stream.file;
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		break;
+
+	case smm_output:
+	case smm_io:
+/*		strm->stream.int0++; useless in smm_io, Beppe */
+		if (c == '\n')
+			strm->stream.int1 = 0;
+		else if (c == '\t')
+			strm->stream.int1 = (strm->stream.int1&~07) + 8;
+		else
+			strm->stream.int1++;
+		if (fp == NULL)
+			internal_stream_error("writec",strm);
+		putc(c, fp);
+		break;
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_broadcast:
+		for (x = strm->stream.object0; !endp(x); x = CDR(x))
+			writec_stream(c, CAR(x));
+		break;
+
+	case smm_two_way:
+		strm->stream.int0++;
+		if (c == '\n')
+			strm->stream.int1 = 0;
+		else if (c == '\t')
+			strm->stream.int1 = (strm->stream.int1&~07) + 8;
+		else
+			strm->stream.int1++;
+		strm = strm->stream.object1;
+		goto BEGIN;
+
+	case smm_echo:
+		strm = strm->stream.object1;
+		goto BEGIN;
+
+	case smm_string_output:
+		strm->stream.int0++;
+		if (c == '\n')
+			strm->stream.int1 = 0;
+		else if (c == '\t')
+			strm->stream.int1 = (strm->stream.int1&~07) + 8;
+		else
+			strm->stream.int1++;
+		x = strm->stream.object0;
+		if (x->string.fillp >= x->string.dim) {
+			if (!x->string.adjustable)
+				FEerror("The string ~S is not adjustable.",
+					1, x);
+#ifdef THREADS
+			start_critical_section(); /* avoid losing p */
+#endif THREADS
+			p = alloc(x->string.dim * 2 + 16);
+			for (i = 0;  i < x->string.dim;  i++)
+				p[i] = x->string.self[i];
+			i = x->string.dim * 2 + 16;
+#define ADIMLIM         16*1024*1024
+			if (i >= ADIMLIM)
+				FEerror("Can't extend the string.", 0);
+			x->string.dim = i;
+			adjust_displaced(x, p - x->string.self);
+#ifdef THREADS
+			end_critical_section();
+#endif THREADS
+		}
+		x->string.self[x->string.fillp++] = c;
+		break;
+
+	case smm_input:
+	case smm_probe:
+	case smm_concatenated:
+	case smm_string_input:
+		cannot_write(strm);
+
+	default:
+		error("illegal stream mode");
+	}
+	return(c);
+}
+
+void
+writestr_stream(const char *s, cl_object strm)
+{
+	while (*s != '\0')
+		writec_stream(*s++, strm);
+}
+
+void
+flush_stream(cl_object strm)
+{
+	cl_object x;
+	FILE *fp;
+
+BEGIN:
+	fp = strm->stream.file;
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		break;
+
+	case smm_output:
+	case smm_io:
+		if (fp == NULL)
+			internal_stream_error("flush_stream",strm);
+		fflush(fp);
+		break;
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_broadcast:
+		for (x = strm->stream.object0; !endp(x); x = CDR(x))
+			flush_stream(CAR(x));
+		break;
+
+	case smm_two_way:
+	case smm_echo:
+		strm = strm->stream.object1;
+		goto BEGIN;
+
+	case smm_string_output: {
+	  	cl_object strng = strm->stream.object0;
+		strng->string.self[strng->string.fillp] = '\0';
+		break;
+	      }
+	case smm_input:
+	case smm_probe:
+	case smm_concatenated:
+	case smm_string_input:
+		FEerror("Cannot flush the stream ~S.", 1, strm);
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+void
+clear_input_stream(cl_object strm)
+{
+	cl_object x;
+	FILE *fp;
+
+BEGIN:
+	fp = strm->stream.file;
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		break;
+
+	case smm_input:
+		if (fp == NULL)
+			internal_stream_error("clear_input_stream",strm);
+		fseek(fp, 0L, 2);
+		break;
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_broadcast:
+		for (x = strm->stream.object0; !endp(x); x = CDR(x))
+			flush_stream(CAR(x));
+		break;
+
+	case smm_two_way:
+	case smm_echo:
+		strm = strm->stream.object0;
+		goto BEGIN;
+
+	case smm_string_output:
+	  break;
+
+	case smm_io:
+	case smm_output:
+	case smm_probe:
+	case smm_concatenated:
+	case smm_string_input:
+	  FEerror("Cannot clear the input of the stream ~S.", 1, strm);
+	  break;
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+void
+clear_output_stream(cl_object strm)
+{
+	cl_object x;
+	FILE *fp;
+
+BEGIN:
+	fp = strm->stream.file;
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		break;
+
+	case smm_output:
+		if (fp == NULL)
+			internal_stream_error("clear_output_stream",strm);
+		fseek(fp, 0L, 2);
+		break;
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_broadcast:
+		for (x = strm->stream.object0; !endp(x); x = CDR(x))
+			flush_stream(CAR(x));
+		break;
+
+	case smm_two_way:
+	case smm_echo:
+		strm = strm->stream.object1;
+		goto BEGIN;
+
+	case smm_string_output:
+	  break;
+
+	case smm_io:
+	case smm_input:
+	case smm_probe:
+	case smm_concatenated:
+	case smm_string_input:
+	  FEerror("Cannot clear the output of the stream ~S.", 1, strm);
+	  break;
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+bool
+stream_at_end(cl_object strm)
+{
+	int c;
+	FILE *fp;
+
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	  return(FALSE);
+#endif
+
+BEGIN:
+	fp = strm->stream.file;
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		return(TRUE);
+
+	case smm_io:
+	case smm_input:
+		if (fp == NULL)
+			closed_stream(strm);
+		GETC(c, fp);
+		if (feof(fp))
+			return(TRUE);
+		else {
+			UNGETC(c, fp);
+			return(FALSE);
+		}
+
+	case smm_output:
+	case smm_probe:
+	case smm_broadcast:
+	case smm_string_output:
+		return(FALSE);
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_concatenated:
+		{ cl_object strmi = strm->stream.object0;
+		  while (!endp(strmi)) {
+		    if (!stream_at_end(CAR(strmi)))
+		      return(FALSE);
+		    strm->stream.object0 = strmi = CDR(strmi);
+		  }
+		  return(TRUE);
+		}
+
+	case smm_two_way:
+#ifdef unix
+		if (strm == terminal_io)                                /**/
+			flush_stream(terminal_io->stream.object1);       /**/
+#endif
+		strm = strm->stream.object0;
+		goto BEGIN;
+
+	case smm_echo:
+		strm = strm->stream.object0;
+		goto BEGIN;
+
+	case smm_string_input:
+		if (strm->stream.int0 >= strm->stream.int1)
+			return(TRUE);
+		else
+			return(FALSE);
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+bool
+listen_stream(cl_object strm)
+{
+	FILE *fp;
+
+BEGIN:
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		return(FALSE);
+
+	case smm_input:
+	case smm_io:
+		fp = strm->stream.file;
+		if (fp == NULL)
+			internal_stream_error("listen_stream",strm);
+		if (feof(fp))
+		  return(FALSE);
+		if (FILE_CNT(fp) > 0)
+		  return(TRUE);
+#ifdef FIONREAD
+		{ long c = 0;
+		  ioctl(fileno(fp), FIONREAD, &c);
+		  if (c <= 0)
+		    return(FALSE);
+		}
+#endif FIONREAD
+		return(TRUE);
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_concatenated:
+		if (endp(strm->stream.object0))
+			return(FALSE);
+		strm = CAR(strm->stream.object0);        /* Incomplete! */
+		goto BEGIN;
+
+	case smm_two_way:
+	case smm_echo:
+		strm = strm->stream.object0;
+		goto BEGIN;
+
+	case smm_string_input:
+		return(strm->stream.int0 < strm->stream.int1);
+
+	case smm_output:
+	case smm_probe:
+	case smm_broadcast:
+	case smm_string_output:
+		FEerror("Can't listen to ~S.", 1, strm);
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+long
+file_position(cl_object strm)
+{
+	FILE *fp;
+
+BEGIN:
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		return(-1);
+
+	case smm_input:
+	case smm_output:
+	case smm_io:
+		/*  return(strm->stream.int0);  */
+		fp = strm->stream.file;
+		if (fp == NULL)
+			internal_stream_error("file_position",strm);
+		return(ftell(fp));
+
+	case smm_string_output:
+		return(strm->stream.object0->string.fillp);
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_probe:
+	case smm_broadcast:
+	case smm_concatenated:
+	case smm_two_way:
+	case smm_echo:
+	case smm_string_input:
+		return(-1);
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+long
+file_position_set(cl_object strm, long disp)
+{
+	FILE *fp;
+
+BEGIN:
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		return(-1);
+
+	case smm_input:
+	case smm_output:
+	case smm_io:
+		fp = strm->stream.file;
+		if (fp == NULL)
+			internal_stream_error("file_position_set",strm);
+		if (fseek(fp, disp, 0) < 0)
+			return(-1);
+/*		strm->stream.int0 = disp; useless in smm_io, Beppe */
+		return(0);
+
+	case smm_string_output:
+		if (disp < strm->stream.object0->string.fillp) {
+			strm->stream.object0->string.fillp = disp;
+			strm->stream.int0 = disp;
+		} else {
+			disp -= strm->stream.object0->string.fillp;
+			while (disp-- > 0)
+				writec_stream(' ', strm);
+		}
+		return(0);
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_probe:
+	case smm_broadcast:
+	case smm_concatenated:
+	case smm_two_way:
+	case smm_echo:
+	case smm_string_input:
+		return(-1);
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+long
+file_length(cl_object strm)
+{
+	FILE *fp;
+
+BEGIN:
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		return(-1);
+
+	case smm_input:
+	case smm_output:
+	case smm_io:
+		fp = strm->stream.file;
+		if (fp == NULL)
+			internal_stream_error("file_length",strm);
+		return(file_len(fp));
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	/* FIXME! Should signal an error of type-error */
+	case smm_probe:
+	case smm_broadcast:
+	case smm_concatenated:
+	case smm_two_way:
+	case smm_echo:
+	case smm_string_input:
+	case smm_string_output:
+		return(-1);
+
+	default:
+		error("illegal stream mode");
+	}
+}
+
+int
+file_column(cl_object strm)
+{
+
+BEGIN:
+	switch ((enum smmode)strm->stream.mode) {
+	case smm_closed:
+		closed_stream(strm);
+		return(-1);
+
+	case smm_output:
+	case smm_io:
+	case smm_two_way:
+	case smm_string_output:
+		return(strm->stream.int1);
+
+	case smm_synonym:
+		strm = symbol_value(strm->stream.object0);
+		if (type_of(strm) != t_stream)
+			FEwrong_type_argument(Sstream, strm);
+		goto BEGIN;
+
+	case smm_echo:
+		strm = strm->stream.object1;
+		goto BEGIN;
+
+	case smm_input:
+	case smm_probe:
+	case smm_string_input:
+		return(-1);
+
+	case smm_concatenated:
+		if (endp(strm->stream.object0))
+			return(-1);
+		strm = CAR(strm->stream.object0);
+		goto BEGIN;
+
+	case smm_broadcast:
+		{
+		  int i;
+		  cl_object x;
+
+		  for (x = strm->stream.object0; !endp(x); x = CDR(x)) {
+		    i = file_column(CAR(x));
+		    if (i >= 0)
+		      return(i);
+		  }
+		  return(-1);
+		}
+	default:
+		error("illegal stream mode");
+	}
+}
+
+@(defun make_synonym_stream (sym)
+	cl_object x;
+@
+	assert_type_symbol(sym);
+	x = alloc_object(t_stream);
+	x->stream.mode = (short)smm_synonym;
+	x->stream.file = NULL;
+	x->stream.object0 = sym;
+	x->stream.object1 = OBJNULL;
+	x->stream.int0 = x->stream.int1 = 0;
+	@(return x)
+@)
+
+
+@(defun make_broadcast_stream (&rest ap)
+	cl_object x, streams;
+	int i;
+@
+	streams = Cnil;
+	for (i = 0; i < narg; i++) {
+		x = va_arg(ap, cl_object);
+		if (type_of(x) != t_stream || !output_stream_p(x))
+			cannot_write(x);
+		streams = CONS(x, streams);
+	}
+	x = alloc_object(t_stream);
+	x->stream.mode = (short)smm_broadcast;
+	x->stream.file = NULL;
+	x->stream.object0 = nreverse(streams);
+	x->stream.object1 = OBJNULL;
+	x->stream.int0 = x->stream.int1 = 0;
+	@(return x)
+@)
+
+@(defun make_concatenated_stream (&rest ap)
+	cl_object x, streams;
+	int i;
+@
+	streams = Cnil;
+	for (i = 0; i < narg; i++) {
+		x = va_arg(ap, cl_object);
+		if (type_of(x) != t_stream || !input_stream_p(x))
+			cannot_read(x);
+		streams = CONS(x, streams);
+	}
+	x = alloc_object(t_stream);
+	x->stream.mode = (short)smm_concatenated;
+	x->stream.file = NULL;
+	x->stream.object0 = nreverse(streams);
+	x->stream.object1 = OBJNULL;
+	x->stream.int0 = x->stream.int1 = 0;
+	@(return x)
+@)
+
+@(defun make_two_way_stream (strm1 strm2)
+@
+	if (type_of(strm1) != t_stream || !input_stream_p(strm1))
+		cannot_read(strm1);
+	if (type_of(strm2) != t_stream || !output_stream_p(strm2))
+		cannot_write(strm2);
+	@(return make_two_way_stream(strm1, strm2))
+@)
+
+@(defun make_echo_stream (strm1 strm2)
+@
+	if (type_of(strm1) != t_stream || !input_stream_p(strm1))
+		cannot_read(strm1);
+	if (type_of(strm2) != t_stream || !output_stream_p(strm2))
+		cannot_write(strm2);
+	@(return make_echo_stream(strm1, strm2))
+@)
+
+@(defun make_string_input_stream (strng &o istart iend)
+	cl_index s, e;
+@
+	assert_type_string(strng);
+	if (Null(istart))
+		s = 0;
+	else if (!FIXNUMP(istart) || FIXNUM_MINUSP(istart))
+		goto E;
+	else
+		s = (cl_index)fix(istart);
+	if (Null(iend))
+		e = strng->string.fillp;
+	else if (!FIXNUMP(iend) || FIXNUM_MINUSP(iend))
+		goto E;
+	else
+		e = (cl_index)fix(iend);
+	if (e > strng->string.fillp || s > e)
+		goto E;
+	@(return `make_string_input_stream(strng, s, e)`)
+
+E:
+	FEerror("~S and ~S are illegal as :START and :END~%\
+for the string ~S.",
+		3, istart, iend, strng);
+@)
+
+@(defun make_string_output_stream ()
+@
+	@(return make_string_output_stream(64))
+@)
+
+@(defun get_output_stream_string (strm)
+@
+	if (type_of(strm) != t_stream ||
+	    (enum smmode)strm->stream.mode != smm_string_output)
+		FEerror("~S is not a string-output stream.", 1, strm);
+	@(return get_output_stream_string(strm))
+@)
+
+/*----------------------------------------------------------------------
+ *	(SI:OUTPUT-STREAM-STRING string-output-stream)
+ *
+ *		extracts the string associated with the given
+ *		string-output-stream.
+ *----------------------------------------------------------------------
+ */
+@(defun si::output_stream_string (strm)
+@
+	if (type_of(strm) != t_stream ||
+	    (enum smmode)strm->stream.mode != smm_string_output)
+		FEerror("~S is not a string-output stream.", 1, strm);
+	@(return strm->stream.object0)
+@)
+
+@(defun streamp (strm)
+@
+	@(return ((type_of(strm) == t_stream) ? Ct : Cnil))
+@)
+
+@(defun input_stream_p (strm)
+@
+	assert_type_stream(strm);
+	@(return (input_stream_p(strm) ? Ct : Cnil))
+@)
+
+@(defun output_stream_p (strm)
+@
+	assert_type_stream(strm);
+	@(return (output_stream_p(strm) ? Ct : Cnil))
+@)
+
+@(defun stream_element_type (strm)
+@
+	assert_type_stream(strm);
+	@(return stream_element_type(strm))
+@)
+
+@(defun close (strm &key abort)
+@
+	assert_type_stream(strm);
+	close_stream(strm, abort != Cnil);
+	@(return Ct)
+@)
+
+@(defun open (filename
+	      &key (direction Kinput)
+		   (element_type Sbase_char)
+		   (if_exists Cnil iesp)
+		   (if_does_not_exist Cnil idnesp)
+	      &aux strm)
+	enum smmode smm;
+@
+	/* INV: open_stream() checks types */
+	if (direction == Kinput) {
+		smm = smm_input;
+		if (!idnesp)
+			if_does_not_exist = Kerror;
+	} else if (direction == Koutput) {
+		smm = smm_output;
+		if (!iesp)
+			if_exists = Knew_version;
+		if (!idnesp) {
+			if (if_exists == Koverwrite ||
+			    if_exists == Kappend)
+				if_does_not_exist = Kerror;
+			else
+				if_does_not_exist = Kcreate;
+		}
+	} else if (direction == Kio) {
+		smm = smm_io;
+		if (!iesp)
+			if_exists = Knew_version;
+		if (!idnesp) {
+			if (if_exists == Koverwrite ||
+			    if_exists == Kappend)
+				if_does_not_exist = Kerror;
+			else
+				if_does_not_exist = Kcreate;
+		}
+	} else if (direction == Kprobe) {
+		smm = smm_probe;
+		if (!idnesp)
+			if_does_not_exist = Cnil;
+	} else
+		FEerror("~S is an illegal DIRECTION for OPEN.",
+			1, direction);
+	strm = open_stream(filename, smm, if_exists, if_does_not_exist);
+	@(return strm)
+@)
+
+@(defun file_position (file_stream &o position)
+	int i;
+@
+	assert_type_stream(file_stream);
+	if (Null(position)) {
+		i = file_position(file_stream);
+		if (i < 0)
+			@(return Cnil)
+		@(return `MAKE_FIXNUM(i)`)
+	} else {
+		if (position == Kstart)
+			i = 0;
+		else if (position == Kend)
+			i = file_length(file_stream);
+		else if (!FIXNUMP(position) ||
+		    (i = fix((position))) < 0)
+			FEerror("~S is an illegal file position~%\
+for the file-stream ~S.",
+				2, position, file_stream);
+		if (file_position_set(file_stream, i) < 0)
+			@(return Cnil)
+		@(return Ct)
+	}       
+@)
+
+@(defun file_length (strm)
+	int i;
+@
+	assert_type_stream(strm);
+	i = file_length(strm);
+	@(return ((i < 0) ? Cnil : MAKE_FIXNUM(i)))
+@)
+
+@(defun open_stream_p (strm)
+@
+	assert_type_stream(strm);
+	/* ANSI and Cltl2 specify that open-stream-p should work
+	   on closed streams, and that a stream is only closed
+	   when #'close has been applied on it */
+	@(return (strm->stream.mode != smm_closed ? Ct : Cnil))
+@)
+
+@(defun si::get_string_input_stream_index (strm)
+@
+	assert_type_stream(strm);
+	if ((enum smmode)strm->stream.mode != smm_string_input)
+		FEerror("~S is not a string-input stream.", 1, strm);
+	@(return MAKE_FIXNUM(strm->stream.int0))
+@)
+
+@(defun si::make_string_output_stream_from_string (strng)
+	cl_object strm;
+@
+	if (type_of(strng) != t_string || !strng->string.hasfillp)
+		FEerror("~S is not a string with a fill-pointer.", 1, strng);
+	strm = alloc_object(t_stream);
+	strm->stream.mode = (short)smm_string_output;
+	strm->stream.file = NULL;
+	strm->stream.object0 = strng;
+	strm->stream.object1 = OBJNULL;
+	strm->stream.int0 = strng->string.fillp;
+	strm->stream.int1 = 0;
+	@(return strm)
+@)
+
+@(defun si::copy_stream (in out)
+@
+	assert_type_stream(in);
+	assert_type_stream(out);
+	while (!stream_at_end(in))
+		writec_stream(readc_stream(in), out);
+	flush_stream(out);
+	@(return Ct)
+@)
+
+void
+init_file(void)
+{
+	cl_object standard_input;
+	cl_object standard_output;
+	cl_object standard;
+	cl_object x;
+
+	standard_input = alloc_object(t_stream);
+	standard_input->stream.mode = (short)smm_input;
+	standard_input->stream.file = stdin;
+	standard_input->stream.object0 = Sbase_char;
+	standard_input->stream.object1 = make_simple_string("stdin");
+	standard_input->stream.int0 = 0;
+	standard_input->stream.int1 = 0;
+
+	standard_output = alloc_object(t_stream);
+	standard_output->stream.mode = (short)smm_output;
+	standard_output->stream.file = stdout;
+	standard_output->stream.object0 = Sbase_char;
+	standard_output->stream.object1= make_simple_string("stdout");
+	standard_output->stream.int0 = 0;
+	standard_output->stream.int1 = 0;
+
+	terminal_io = standard
+	= make_two_way_stream(standard_input, standard_output);
+	register_root(&terminal_io);
+
+	SYM_VAL(Vterminal_io) = standard;
+
+	x = alloc_object(t_stream);
+	x->stream.mode = (short)smm_synonym;
+	x->stream.file = NULL;
+	x->stream.object0 = Vterminal_io;
+	x->stream.object1 = OBJNULL;
+	x->stream.int0 = x->stream.int1 = 0;
+	standard = x;
+
+	SYM_VAL(Vstandard_input)  = standard;
+	SYM_VAL(Vstandard_output) = standard;
+	SYM_VAL(Verror_output) = standard;
+
+	SYM_VAL(Vquery_io) = standard;
+	SYM_VAL(Vdebug_io) = standard;
+	SYM_VAL(Vtrace_output) = standard;
+
+	SYM_VAL(siVignore_eof_on_terminal_io) = Cnil;
+}
diff --git a/src/c/format.d b/src/c/format.d
new file mode 100644
index 000000000..1ed388b18
--- /dev/null
+++ b/src/c/format.d
@@ -0,0 +1,2089 @@
+/*
+    format.c -- Format.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include <ctype.h>
+
+cl_object siVindent_formatted_output;
+
+/******************* WITH CLOS ************************/
+#ifdef CLOS
+#define	WRITEC_STREAM(c, strm)		(*fmt_writec)(c, strm)
+#define WRITESTR_STREAM(s, strm) \
+  { if (type_of(strm) == t_stream) \
+       writestr_stream(s, strm);\
+    else {\
+       const char* t=s; \
+       while (*t != '\0') interactive_writec_stream(*t++, strm); \
+  }}
+#define FLUSH_STREAM(strm) {\
+  if (type_of(strm) == t_stream) flush_stream(strm); \
+     else flush_interactive_stream(strm);\
+  }
+#define FILE_COLUMN(strm) \
+  ((type_of(strm) == t_instance) ? -1 : file_column(strm))
+#endif CLOS
+
+/******************* WITHOUT CLOS *********************/
+#ifndef CLOS
+#define	WRITEC_STREAM(c, strm)		writec_stream(c, strm)
+#define WRITESTR_STREAM(s, strm)	writestr_stream(s, strm);
+#define FLUSH_STREAM(strm)		flush_stream(strm)
+#define FILE_COLUMN(strm) 		file_column(strm)
+#endif !CLOS
+
+/******************* WITH THREADS *********************/
+#ifdef THREADS
+#define fmt_writec	clwp->lwp_fmt_ch_fun
+#define fmt_stream	clwp->lwp_fmt_stream
+#define ctl_origin	clwp->lwp_ctl_origin
+#define ctl_index	clwp->lwp_ctl_index
+#define ctl_end		clwp->lwp_ctl_end
+#define fmt_base	clwp->lwp_fmt_base
+#define fmt_index	clwp->lwp_fmt_index
+#define fmt_end		clwp->lwp_fmt_end
+#define fmt_jmp_buf	clwp->lwp_fmt_jmp_buf
+#define fmt_indents	clwp->lwp_fmt_indents
+#define fmt_string	clwp->lwp_fmt_string
+#define fmt_temporary_stream clwp->lwp_fmt_temporary_stream
+#define fmt_temporary_string clwp->lwp_fmt_temporary_string
+#define fmt_nparam	clwp->lwp_fmt_nparam
+#define fmt_param	clwp->lwp_fmt_param
+#define fmt_spare_spaces clwp->lwp_fmt_spare_spaces
+#define fmt_line_length clwp->lwp_fmt_line_length
+#endif
+
+/******************* WITHOUT THREADS ******************/
+#ifndef THREADS
+static int (*fmt_writec)();
+static cl_object fmt_stream;
+static int ctl_origin;
+static int ctl_index;
+static int ctl_end;
+static cl_object *fmt_base;
+static int fmt_index;
+static int fmt_end;
+static int *fmt_jmp_buf;
+static int fmt_indents;
+static cl_object fmt_string;
+static cl_object fmt_temporary_stream;
+static cl_object fmt_temporary_string;
+static int fmt_nparam;
+struct {
+	int fmt_param_type;
+	int fmt_param_value;
+} fmt_param[100];
+static int fmt_spare_spaces;
+static int fmt_line_length;
+#endif !THREADS
+
+/******************* COMMON ***************************/
+
+#define	ctl_string	(fmt_string->string.self + ctl_origin)
+
+#define	fmt_old		volatile cl_object old_fmt_stream; \
+			volatile int old_ctl_origin; \
+			volatile int old_ctl_index; \
+			volatile int old_ctl_end; \
+			cl_object * volatile old_fmt_base; \
+			volatile int old_fmt_index; \
+			volatile int old_fmt_end; \
+			int * volatile old_fmt_jmp_buf; \
+			volatile int old_fmt_indents; \
+			volatile cl_object old_fmt_string
+#define	fmt_save	old_fmt_stream = fmt_stream; \
+			old_ctl_origin = ctl_origin; \
+			old_ctl_index = ctl_index; \
+			old_ctl_end = ctl_end; \
+			old_fmt_base = fmt_base; \
+			old_fmt_index = fmt_index; \
+			old_fmt_end = fmt_end; \
+			old_fmt_jmp_buf = fmt_jmp_buf; \
+			old_fmt_indents = fmt_indents; \
+			old_fmt_string = fmt_string
+#define	fmt_restore	fmt_stream = old_fmt_stream; \
+			ctl_origin = old_ctl_origin; \
+			ctl_index = old_ctl_index; \
+			ctl_end = old_ctl_end; \
+			fmt_base = old_fmt_base; \
+			fmt_index = old_fmt_index; \
+			fmt_end = old_fmt_end; \
+			fmt_jmp_buf = old_fmt_jmp_buf; \
+			fmt_indents = old_fmt_indents; \
+			fmt_string = old_fmt_string
+#define	fmt_restore1	fmt_stream = old_fmt_stream; \
+			ctl_origin = old_ctl_origin; \
+			ctl_index = old_ctl_index; \
+			ctl_end = old_ctl_end; \
+			fmt_jmp_buf = old_fmt_jmp_buf; \
+			fmt_indents = old_fmt_indents; \
+			fmt_string = old_fmt_string
+
+#define NONE	0
+#define	INT	1
+#define	CHAR	2
+
+static const char *fmt_big_numeral[] = {
+	"thousand",
+	"million",
+	"billion",
+	"trillion",
+	"quadrillion",
+	"quintillion",
+	"sextillion",
+	"septillion",
+	"octillion"
+};
+
+static const char *fmt_numeral[] = {
+	"zero", "one", "two", "three", "four",
+	"five", "six", "seven", "eight", "nine",
+	"ten", "eleven", "twelve", "thirteen", "fourteen",
+	"fifteen", "sixteen", "seventeen", "eighteen", "nineteen",
+	"zero", "ten", "twenty", "thirty", "forty",
+	"fifty", "sixty", "seventy", "eighty", "ninety"
+};
+
+static const char *fmt_ordinal[] = {
+	"zeroth", "first", "second", "third", "fourth",
+	"fifth", "sixth", "seventh", "eighth", "ninth",
+	"tenth", "eleventh", "twelfth", "thirteenth", "fourteenth",
+	"fifteenth", "sixteenth", "seventeenth", "eighteenth", "nineteenth",
+	"zeroth", "tenth", "twentieth", "thirtieth", "fortieth",
+	"fiftieth", "sixtieth", "seventieth", "eightieth", "ninetieth"
+};
+
+static void format(cl_object, int, int);
+
+static void
+fmt_error(char *s)
+{
+	FEerror("Format error: ~A.~%~V@@TV~%\"~A\"~%",
+		3, make_simple_string(s),
+		MAKE_FIXNUM(&ctl_string[ctl_index] - fmt_string->string.self),
+		fmt_string);
+}
+
+static int
+fmt_tempstr(int s)
+{
+	return(fmt_temporary_string->string.self[s]);
+}
+
+static int
+ctl_advance(void)
+{
+	if (ctl_index >= ctl_end)
+		fmt_error("unexpected end of control string");
+	return(ctl_string[ctl_index++]);
+}
+
+static cl_object
+fmt_advance(void)
+{
+	if (fmt_index >= fmt_end)
+		fmt_error("arguments exhausted");
+	return(fmt_base[fmt_index++]);
+}
+
+static int
+fmt_skip(void)
+{
+	int c, level = 0;
+	
+LOOP:
+	if (ctl_advance() != '~')
+		goto LOOP;
+	for (;;)
+		switch (c = ctl_advance()) {
+		case '\'':
+			ctl_advance();
+
+		case ',':
+		case '0':  case '1':  case '2':  case '3':  case '4':
+		case '5':  case '6':  case '7':  case '8':  case '9':
+		case '+':
+		case '-':
+		case 'v':  case 'V':
+		case '#':
+		case ':':  case '@@':
+			continue;
+
+		default:
+			goto DIRECTIVE;
+		}
+
+DIRECTIVE:
+	switch (c) {
+	case '(':  case '[':  case '<':  case '{':
+		level++;
+		break;
+
+	case ')':  case ']':  case '>':  case '}':
+		if (level == 0)
+			return(ctl_index);
+		else
+			--level;
+		break;
+
+	case ';':
+		if (level == 0)
+			return(ctl_index);
+		break;
+	}
+	goto LOOP;
+}
+
+static void
+fmt_max_param(int n)
+{
+	if (fmt_nparam > n)
+		fmt_error("too many parameters");
+}
+
+static void
+fmt_not_colon(bool colon)
+{
+	if (colon)
+		fmt_error("illegal :");
+}
+
+static void
+fmt_not_atsign(bool atsign)
+{
+	if (atsign)
+		fmt_error("illegal @@");
+}
+
+static void
+fmt_not_colon_atsign(bool colon, bool atsign)
+{
+	if (colon && atsign)
+		fmt_error("illegal :@@");
+}
+
+static void
+fmt_set_param(int i, int *p, int t, int v)
+{
+	if (i >= fmt_nparam || fmt_param[i].fmt_param_type == 0)
+		*p = v;
+	else if (fmt_param[i].fmt_param_type != t)
+		fmt_error("illegal parameter type");
+	else
+		*p = fmt_param[i].fmt_param_value;
+}	
+
+static void
+fmt_set_param_positive(int i, int *p, const char *message)
+{
+	if (i >= fmt_nparam || fmt_param[i].fmt_param_type == 0)
+		*p = -1;
+	else if (fmt_param[i].fmt_param_type != INT)
+		fmt_error("illegal parameter type");
+	else {
+		*p = fmt_param[i].fmt_param_value;
+		if (*p < 0) fmt_error(message);
+	}
+}	
+
+static void
+fmt_ascii(bool colon, bool atsign)
+{
+	int mincol, colinc, minpad, padchar;
+	cl_object x;
+	int l, i;
+
+	fmt_max_param(4);
+	fmt_set_param(0, &mincol, INT, 0);
+	fmt_set_param(1, &colinc, INT, 1);
+	fmt_set_param(2, &minpad, INT, 0);
+	fmt_set_param(3, &padchar, CHAR, ' ');
+
+	fmt_temporary_string->string.fillp = 0;
+	fmt_temporary_stream->stream.int0 = FILE_COLUMN(fmt_stream);
+	fmt_temporary_stream->stream.int1 = FILE_COLUMN(fmt_stream);
+	x = fmt_advance();
+	if (colon && Null(x))
+		writestr_stream("()", fmt_temporary_stream);
+	else if (mincol == 0 && minpad == 0) {
+		princ(x, fmt_stream);
+		return;
+	} else
+		princ(x, fmt_temporary_stream);
+	l = fmt_temporary_string->string.fillp;
+	for (i = minpad;  l + i < mincol;  i += colinc)
+		;
+	if (!atsign) {
+		write_string(fmt_temporary_string, fmt_stream);
+		while (i-- > 0)
+			WRITEC_STREAM(padchar, fmt_stream);
+	} else {
+		while (i-- > 0)
+			WRITEC_STREAM(padchar, fmt_stream);
+		write_string(fmt_temporary_string, fmt_stream);
+	}
+}
+
+static void
+fmt_S_expression(bool colon, bool atsign)
+{
+	int mincol, colinc, minpad, padchar;
+	cl_object x;
+	int l, i;
+
+	fmt_max_param(4);
+	fmt_set_param(0, &mincol, INT, 0);
+	fmt_set_param(1, &colinc, INT, 1);
+	fmt_set_param(2, &minpad, INT, 0);
+	fmt_set_param(3, &padchar, CHAR, ' ');
+
+	fmt_temporary_string->string.fillp = 0;
+	fmt_temporary_stream->stream.int0 = FILE_COLUMN(fmt_stream);
+	fmt_temporary_stream->stream.int1 = FILE_COLUMN(fmt_stream);
+	x = fmt_advance();
+	if (colon && Null(x))
+		writestr_stream("()", fmt_temporary_stream);
+	else if (mincol == 0 && minpad == 0) {
+		prin1(x, fmt_stream);
+		return;
+	} else
+		prin1(x, fmt_temporary_stream);
+	l = fmt_temporary_string->string.fillp;
+	for (i = minpad;  l + i < mincol;  i += colinc)
+		;
+	if (!atsign) {
+		write_string(fmt_temporary_string, fmt_stream);
+		while (i-- > 0)
+			WRITEC_STREAM(padchar, fmt_stream);
+	} else {
+		while (i-- > 0)
+			WRITEC_STREAM(padchar, fmt_stream);
+		write_string(fmt_temporary_string, fmt_stream);
+	}
+}
+
+
+static void
+fmt_integer(cl_object x, bool colon, bool atsign,
+	    int radix, int mincol, int padchar, int commachar)
+{
+	int l, l1;
+	int s;
+
+	if (!FIXNUMP(x) && type_of(x) != t_bignum) {
+		fmt_temporary_string->string.fillp = 0;
+		fmt_temporary_stream->stream.int0 = FILE_COLUMN(fmt_stream);
+		fmt_temporary_stream->stream.int1 = FILE_COLUMN(fmt_stream);
+		setupPRINT(x, fmt_temporary_stream);
+		PRINTescape = FALSE;
+		PRINTbase = radix;
+		write_object(x, 0);
+		cleanupPRINT();
+		l = fmt_temporary_string->string.fillp;
+		mincol -= l;
+		while (mincol-- > 0)
+			WRITEC_STREAM(padchar, fmt_stream);
+		for (s = 0;  l > 0;  --l, s++)
+			WRITEC_STREAM(fmt_tempstr(s), fmt_stream);
+		return;
+	}
+	fmt_temporary_string->string.fillp = 0;
+	fmt_temporary_stream->stream.int0 = FILE_COLUMN(fmt_stream);
+	fmt_temporary_stream->stream.int1 = FILE_COLUMN(fmt_stream);
+	PRINTstream = fmt_temporary_stream;
+	PRINTradix = FALSE;
+	PRINTbase = radix;
+	write_ch_fun = writec_PRINTstream;
+	write_object(x, 0);
+	l = l1 = fmt_temporary_string->string.fillp;
+	s = 0;
+	if (fmt_tempstr(s) == '-')
+		--l1;
+	mincol -= l;
+	if (colon)
+		mincol -= (l1 - 1)/3;
+	if (atsign && fmt_tempstr(s) != '-')
+		--mincol;
+	while (mincol-- > 0)
+		WRITEC_STREAM(padchar, fmt_stream);
+	if (fmt_tempstr(s) == '-') {
+		s++;
+		WRITEC_STREAM('-', fmt_stream);
+	} else if (atsign)
+		WRITEC_STREAM('+', fmt_stream);
+	while (l1-- > 0) {
+		WRITEC_STREAM(fmt_tempstr(s++), fmt_stream);
+		if (colon && l1 > 0 && l1%3 == 0)
+			WRITEC_STREAM(commachar, fmt_stream);
+	}
+}
+
+static void
+fmt_decimal(bool colon, bool atsign)
+{
+	int mincol, padchar, commachar;
+
+	fmt_max_param(3);
+	fmt_set_param(0, &mincol, INT, 0);
+	fmt_set_param(1, &padchar, CHAR, ' ');
+	fmt_set_param(2, &commachar, CHAR, ',');
+	fmt_integer(fmt_advance(), colon, atsign,
+		    10, mincol, padchar, commachar);
+}
+
+static void
+fmt_binary(bool colon, bool atsign)
+{
+	int mincol, padchar, commachar;
+
+	fmt_max_param(3);
+	fmt_set_param(0, &mincol, INT, 0);
+	fmt_set_param(1, &padchar, CHAR, ' ');
+	fmt_set_param(2, &commachar, CHAR, ',');
+	fmt_integer(fmt_advance(), colon, atsign,
+		    2, mincol, padchar, commachar);
+}
+
+static void
+fmt_octal(bool colon, bool atsign)
+{
+	int mincol, padchar, commachar;
+
+	fmt_max_param(3);
+	fmt_set_param(0, &mincol, INT, 0);
+	fmt_set_param(1, &padchar, CHAR, ' ');
+	fmt_set_param(2, &commachar, CHAR, ',');
+	fmt_integer(fmt_advance(), colon, atsign,
+		    8, mincol, padchar, commachar);
+}
+
+static void
+fmt_hexadecimal(bool colon, bool atsign)
+{
+	int mincol, padchar, commachar;
+
+	fmt_max_param(3);
+	fmt_set_param(0, &mincol, INT, 0);
+	fmt_set_param(1, &padchar, CHAR, ' ');
+	fmt_set_param(2, &commachar, CHAR, ',');
+	fmt_integer(fmt_advance(), colon, atsign,
+		    16, mincol, padchar, commachar);
+}
+
+static void
+fmt_write_numeral(int s, int i)
+{
+	WRITESTR_STREAM(fmt_numeral[fmt_tempstr(s) - '0' + i], fmt_stream)
+}
+
+static void
+fmt_write_ordinal(int s, int i)
+{
+	WRITESTR_STREAM(fmt_ordinal[fmt_tempstr(s) - '0' + i], fmt_stream)
+}
+
+static bool
+fmt_thousand(int s, int i, bool b, bool o, int t)
+{
+	if (i == 3 && fmt_tempstr(s) > '0') {
+		if (b)
+			WRITEC_STREAM(' ', fmt_stream);
+		fmt_write_numeral(s, 0);
+		WRITESTR_STREAM(" hundred", fmt_stream)
+		--i;
+		s++;
+		b = TRUE;
+		if (o && (s > t))
+			WRITESTR_STREAM("th", fmt_stream)
+	}
+	if (i == 3) {
+		--i;
+		s++;
+	}
+	if (i == 2 && fmt_tempstr(s) > '0') {
+		if (b)
+			WRITEC_STREAM(' ', fmt_stream);
+		if (fmt_tempstr(s) == '1') {
+			if (o && (s + 2 > t))
+				fmt_write_ordinal(++s, 10);
+			else
+				fmt_write_numeral(++s, 10);
+			return(TRUE);
+		} else {
+			if (o && (s + 1 > t))
+				fmt_write_ordinal(s, 20);
+			else
+				fmt_write_numeral(s, 20);
+			s++;
+			if (fmt_tempstr(s) > '0') {
+				WRITEC_STREAM('-', fmt_stream);
+				if (o && s + 1 > t)
+					fmt_write_ordinal(s, 0);
+				else
+					fmt_write_numeral(s, 0);
+			}
+			return(TRUE);
+		}
+	}
+	if (i == 2)
+		s++;
+	if (fmt_tempstr(s) > '0') {
+		if (b)
+			WRITEC_STREAM(' ', fmt_stream);
+		if (o && s + 1 > t)
+			fmt_write_ordinal(s, 0);
+		else
+			fmt_write_numeral(s, 0);
+		return(TRUE);
+	}
+	return(b);
+}
+
+static bool
+fmt_nonillion(int s, int i, bool b, bool o, int t)
+{
+	int j;
+
+	for (;  i > 3;  i -= j) {
+		b = fmt_thousand(s, j = (i+2)%3+1, b, FALSE, t);
+		if (j != 3 || fmt_tempstr(s) != '0' ||
+		    fmt_tempstr(s+1) != '0' || fmt_tempstr(s+2) != '0') {
+			WRITEC_STREAM(' ', fmt_stream);
+			WRITESTR_STREAM(fmt_big_numeral[(i - 1)/3 - 1],
+					fmt_stream)
+			s += j;
+			if (o && s > t)
+				WRITESTR_STREAM("th", fmt_stream)
+		} else
+			s += j;
+	}
+	return(fmt_thousand(s, i, b, o, t));
+}		
+
+static void
+fmt_roman(int i, int one, int five, int ten, bool colon)
+{
+	int j;
+
+	if (i == 0)
+		return;
+	if ((!colon && i < 4) || (colon && i < 5))
+		for (j = 0;  j < i;  j++)
+			WRITEC_STREAM(one, fmt_stream);
+	else if (!colon && i == 4) {
+		WRITEC_STREAM(one, fmt_stream);
+		WRITEC_STREAM(five, fmt_stream);
+	} else if ((!colon && i < 9) || colon) {
+		WRITEC_STREAM(five, fmt_stream);
+		for (j = 5;  j < i;  j++)
+			WRITEC_STREAM(one, fmt_stream);
+	} else if (!colon && i == 9) {
+		WRITEC_STREAM(one, fmt_stream);
+		WRITEC_STREAM(ten, fmt_stream);
+	}
+}
+
+static void
+fmt_radix(bool colon, bool atsign)
+{
+	int radix, mincol, padchar, commachar;
+	cl_object x;
+	int i, j, k;
+	int s, t;
+	bool b;
+
+	if (fmt_nparam == 0) {
+		x = fmt_advance();
+		assert_type_integer(x);
+		if (atsign) {
+			if (FIXNUMP(x))
+				i = fix(x);
+			else
+				i = -1;
+			if ((!colon && (i <= 0 || i >= 4000)) ||
+			    (colon && (i <= 0 || i >= 5000))) {
+				fmt_integer(x, FALSE, FALSE, 10, 0, ' ', ',');
+				return;
+			}
+			fmt_roman(i/1000, 'M', '*', '*', colon);
+			fmt_roman(i%1000/100, 'C', 'D', 'M', colon);
+			fmt_roman(i%100/10, 'X', 'L', 'C', colon);
+			fmt_roman(i%10, 'I', 'V', 'X', colon);
+			return;
+		}
+		fmt_temporary_string->string.fillp = 0;
+		fmt_temporary_stream->stream.int0 = FILE_COLUMN(fmt_stream);
+		fmt_temporary_stream->stream.int1 = FILE_COLUMN(fmt_stream);
+		PRINTstream = fmt_temporary_stream;
+		PRINTradix = FALSE;
+		PRINTbase = 10;
+		write_ch_fun = writec_PRINTstream;
+		write_object(x, 0);
+		s = 0;
+		i = fmt_temporary_string->string.fillp;
+		if (i == 1 && fmt_tempstr(s) == '0') {
+			WRITESTR_STREAM("zero", fmt_stream)
+			if (colon)
+				WRITESTR_STREAM("th", fmt_stream)
+			return;
+		} else if (fmt_tempstr(s) == '-') {
+			WRITESTR_STREAM("minus ", fmt_stream)
+			--i;
+			s++;
+		}
+		t = fmt_temporary_string->string.fillp;
+		for (; fmt_tempstr(--t) == '0' ;) ;
+		for (b = FALSE;  i > 0;  i -= j) {
+			b = fmt_nonillion(s, j = (i+29)%30+1, b,
+					  i<=30&&colon, t);
+			s += j;
+			if (b && i > 30) {
+				for (k = (i - 1)/30;  k > 0;  --k)
+					WRITESTR_STREAM(" nonillion",
+							fmt_stream)
+				if (colon && s > t)
+					WRITESTR_STREAM("th", fmt_stream)
+			}
+		}
+		return;
+	}
+	fmt_max_param(4);
+	fmt_set_param(0, &radix, INT, 10);
+	fmt_set_param(1, &mincol, INT, 0);
+	fmt_set_param(2, &padchar, CHAR, ' ');
+	fmt_set_param(3, &commachar, CHAR, ',');
+	x = fmt_advance();
+	assert_type_integer(x);
+	if (radix < 0 || radix > 36)
+		FEerror("~D is illegal as a radix.", 1, MAKE_FIXNUM(radix));
+	fmt_integer(x, colon, atsign, radix, mincol, padchar, commachar);
+}	
+
+static void
+fmt_plural(bool colon, bool atsign)
+{
+	fmt_max_param(0);
+	if (colon) {
+		if (fmt_index == 0)
+			fmt_error("can't back up");
+		--fmt_index;
+	}
+	if (eql(fmt_advance(), MAKE_FIXNUM(1))) {
+		if (atsign)
+			WRITEC_STREAM('y', fmt_stream);
+	      }
+	else
+		if (atsign)
+			WRITESTR_STREAM("ies", fmt_stream)
+		else
+			WRITEC_STREAM('s', fmt_stream);
+}
+
+static void
+fmt_character(bool colon, bool atsign)
+{
+	cl_object x;
+	cl_index i;
+
+	fmt_max_param(0);
+	fmt_temporary_string->string.fillp = 0;
+	fmt_temporary_stream->stream.int0 = 0;
+	fmt_temporary_stream->stream.int1 = 0;
+	x = fmt_advance();
+	assert_type_character(x);
+	prin1(x, fmt_temporary_stream);
+	if (!colon && atsign)
+		i = 0;
+	else
+		i = 2;
+	for (;  i < fmt_temporary_string->string.fillp;  i++)
+		WRITEC_STREAM(fmt_tempstr(i), fmt_stream);
+}
+
+static void
+fmt_fix_float(bool colon, bool atsign)
+{
+	int w, d, k, overflowchar, padchar;
+	double f;
+	int sign;
+	char buff[256], *b, buff1[256];
+	int exp;
+	int i, j;
+	cl_object x;
+	int n, m;
+
+	b = buff1 + 1;
+
+	fmt_not_colon(colon);
+	fmt_max_param(5);
+	fmt_set_param_positive(0, &w, "illegal width");
+	fmt_set_param_positive(1, &d, "illegal number of digits");
+	fmt_set_param(2, &k, INT, 0);
+	fmt_set_param(3, &overflowchar, CHAR, -1);
+	fmt_set_param(4, &padchar, CHAR, ' ');
+
+	x = fmt_advance();
+	if (FIXNUMP(x) ||
+	    type_of(x) == t_bignum ||
+	    type_of(x) == t_ratio)
+		x = make_shortfloat(object_to_float(x));
+	if (!REAL_TYPE(type_of(x))) {
+		if (fmt_nparam > 1) fmt_nparam = 1;
+		--fmt_index;
+		fmt_decimal(colon, atsign);
+		return;
+	}
+	if (type_of(x) == t_longfloat)
+		n = 16;
+	else
+		n = 7;
+	f = number_to_double(x);
+	edit_double(n, f, &sign, buff, &exp);
+	if (exp + k > 100 || exp + k < -100 || d > 100) {
+		prin1(x, fmt_stream);
+		return;
+	}
+	if (d >= 0)
+		m = d + exp + k + 1;
+	else if (w >= 0) {
+		if (exp + k >= 0)
+			m = w - 1;
+		else
+			m = w + exp + k - 2;
+		if (sign < 0 || atsign)
+			--m;
+		if (m == 0)
+			m = 1;
+	} else
+		m = n;
+	if (m <= 0) {
+		if (m == 0 && buff[0] >= '5') {
+			exp++;
+			n = m = 1;
+			buff[0] = '1';
+		} else
+			n = m = 0;
+	} else if (m < n) {
+		n = m;
+		edit_double(n, f, &sign, buff, &exp);
+	}
+	while (n >= 0)
+		if (buff[n - 1] == '0')
+			--n;
+		else
+			break;
+	exp += k;
+	j = 0;
+	if (exp >= 0) {
+		for (i = 0;  i <= exp;  i++)
+			b[j++] = i < n ? buff[i] : '0';
+		b[j++] = '.';
+		if (d >= 0)
+			for (m = i + d;  i < m;  i++)
+				b[j++] = i < n ? buff[i] : '0';
+		else
+			for (;  i < n;  i++)
+				b[j++] = buff[i];
+	} else {
+		b[j++] = '.';
+		if (d >= 0) {
+			for (i = 0;  i < (-exp) - 1 && i < d;  i++)
+				b[j++] = '0';
+			for (m = d - i, i = 0;  i < m;  i++)
+				b[j++] = i < n ? buff[i] : '0';
+		} else if (n > 0) {
+			for (i = 0;  i < (-exp) - 1;  i++)
+				b[j++] = '0';
+			for (i = 0;  i < n;  i++)
+				b[j++] = buff[i];
+		}
+	}
+	b[j] = '\0';
+	if (w >= 0) {
+		if (sign < 0 || atsign)
+			--w;
+		if (j > w && overflowchar >= 0) {
+			fmt_set_param(0, &w, INT, 0);
+			for (i = 0;  i < w;  i++)
+				WRITEC_STREAM(overflowchar, fmt_stream);
+			return;
+		}
+		if (j < w && b[j-1] == '.') {
+			b[j++] = '0';
+			b[j] = '\0';
+		}
+		if (j < w && b[0] == '.') {
+			*--b = '0';
+			j++;
+		}
+		for (i = j;  i < w;  i++)
+			WRITEC_STREAM(padchar, fmt_stream);
+	} else {
+		if (b[0] == '.') {
+			*--b = '0';
+			j++;
+		}
+		if (d < 0 && b[j-1] == '.') {
+			b[j++] = '0';
+			b[j] = '\0';
+		}
+	}
+	if (sign < 0)
+		WRITEC_STREAM('-', fmt_stream);
+	else if (atsign)
+		WRITEC_STREAM('+', fmt_stream);
+	WRITESTR_STREAM(b, fmt_stream)
+}
+
+static int
+fmt_exponent_length(int e)
+{
+	int i;
+
+	if (e == 0)
+		return(1);
+	if (e < 0)
+		e = -e;
+	for (i = 0;  e > 0;  i++, e /= 10)
+		;
+	return(i);
+}
+
+static void
+fmt_exponent1(int e)
+{
+	if (e == 0)
+		return;
+	fmt_exponent1(e/10);
+	WRITEC_STREAM('0' + e%10, fmt_stream);
+}
+
+static void
+fmt_exponent(int e)
+{
+	if (e == 0) {
+		WRITEC_STREAM('0', fmt_stream);
+		return;
+	}
+	if (e < 0)
+		e = -e;
+	fmt_exponent1(e);
+}
+
+static void
+fmt_exponential_float(bool colon, bool atsign)
+{
+	int w, d, e, k, overflowchar, padchar, exponentchar;
+	double f;
+	int sign;
+	char buff[256], *b, buff1[256];
+	int exp;
+	int i, j;
+	cl_object x, y;
+	int n, m;
+	enum type t;
+
+	b = buff1 + 1;
+
+	fmt_not_colon(colon);
+	fmt_max_param(7);
+	fmt_set_param_positive(0, &w, "illegal width");
+	fmt_set_param_positive(1, &d, "illegal number of digits");
+	fmt_set_param_positive(2, &e, "illegal number of digits in exponent");
+	fmt_set_param(3, &k, INT, 1);
+	fmt_set_param(4, &overflowchar, CHAR, -1);
+	fmt_set_param(5, &padchar, CHAR, ' ');
+	fmt_set_param(6, &exponentchar, CHAR, -1);
+
+	x = fmt_advance();
+	if (FIXNUMP(x) ||
+	    type_of(x) == t_bignum ||
+	    type_of(x) == t_ratio)
+		x = make_shortfloat(object_to_float(x));
+	if (!REAL_TYPE(type_of(x))) {
+		if (fmt_nparam > 1) fmt_nparam = 1;
+		--fmt_index;
+		fmt_decimal(colon, atsign);
+		return;
+	}
+	if (type_of(x) == t_longfloat)
+		n = 16;
+	else
+		n = 7;
+	f = number_to_double(x);
+	edit_double(n, f, &sign, buff, &exp);
+	if (d >= 0) {
+		if (k > 0) {
+			if (!(k < d + 2))
+				fmt_error("illegal scale factor");
+			m = d + 1;
+		} else {
+			if (!(k > -d))
+				fmt_error("illegal scale factor");
+			m = d + k;
+		}
+	} else if (w >= 0) {
+		if (k > 0)
+			m = w - 1;
+		else
+			m = w + k - 1;
+		if (sign < 0 || atsign)
+			--m;
+		if (e >= 0)
+			m -= e + 2;
+		else
+			m -= fmt_exponent_length(e - k + 1) + 2;
+	} else
+		m = n;
+	if (m <= 0) {
+		if (m == 0 && buff[0] >= '5') {
+			exp++;
+			n = m = 1;
+			buff[0] = '1';
+		} else
+			n = m = 0;
+	} else if (m < n) {
+		n = m;
+		edit_double(n, f, &sign, buff, &exp);
+	}
+	while (n >= 0)
+		if (buff[n - 1] == '0')
+			--n;
+		else
+			break;
+	exp = exp - k + 1;
+	j = 0;
+	if (k > 0) {
+		for (i = 0;  i < k;  i++)
+			b[j++] = i < n ? buff[i] : '0';
+		b[j++] = '.';
+		if (d >= 0)
+			for (m = i + (d - k + 1);  i < m;  i++)
+				b[j++] = i < n ? buff[i] : '0';
+		else
+			for (;  i < n;  i++)
+				b[j++] = buff[i];
+	} else {
+		b[j++] = '.';
+		if (d >= 0) {
+			for (i = 0;  i < -k && i < d;  i++)
+				b[j++] = '0';
+			for (m = d - i, i = 0;  i < m;  i++)
+				b[j++] = i < n ? buff[i] : '0';
+		} else if (n > 0) {
+			for (i = 0;  i < -k;  i++)
+				b[j++] = '0';
+			for (i = 0;  i < n;  i++)
+				b[j++] = buff[i];
+		}
+	}
+	b[j] = '\0';
+	if (w >= 0) {
+		if (sign < 0 || atsign)
+			--w;
+		i = fmt_exponent_length(exp);
+		if (e >= 0) {
+			if (i > e) {
+				if (overflowchar >= 0)
+					goto OVER;
+				else
+					e = i;
+			}
+			w -= e + 2;
+		} else
+			w -= i + 2;
+		if (j > w && overflowchar >= 0)
+			goto OVER;
+		if (j < w && b[j-1] == '.') {
+			b[j++] = '0';
+			b[j] = '\0';
+		}
+		if (j < w && b[0] == '.') {
+			*--b = '0';
+			j++;
+		}
+		for (i = j;  i < w;  i++)
+			WRITEC_STREAM(padchar, fmt_stream);
+	} else {
+		if (b[j-1] == '.') {
+			b[j++] = '0';
+			b[j] = '\0';
+		}
+		if (d < 0 && b[0] == '.') {
+			*--b = '0';
+			j++;
+		}
+	}
+	if (sign < 0)
+		WRITEC_STREAM('-', fmt_stream);
+	else if (atsign)
+		WRITEC_STREAM('+', fmt_stream);
+	WRITESTR_STREAM(b, fmt_stream)
+	y = symbol_value(Vread_default_float_format);
+	if (exponentchar < 0) {
+		if (y == Slong_float || y == Sdouble_float)
+			t = t_longfloat;
+		else
+			t = t_shortfloat;
+		if (type_of(x) == t)
+			exponentchar = 'E';
+		else if (type_of(x) == t_shortfloat)
+			exponentchar = 'S';
+		else
+			exponentchar = 'L';
+	}
+	WRITEC_STREAM(exponentchar, fmt_stream);
+	if (exp < 0)
+		WRITEC_STREAM('-', fmt_stream);
+	else
+		WRITEC_STREAM('+', fmt_stream);
+	if (e >= 0)
+		for (i = e - fmt_exponent_length(exp);  i > 0;  --i)
+			WRITEC_STREAM('0', fmt_stream);
+	fmt_exponent(exp);
+	return;
+
+OVER:
+	fmt_set_param(0, &w, INT, -1);
+	for (i = 0;  i < w;  i++)
+		WRITEC_STREAM(overflowchar, fmt_stream);
+	return;
+}
+
+static void
+fmt_general_float(bool colon, bool atsign)
+{
+	int w, d, e, k, overflowchar, padchar, exponentchar;
+	int sign, exp;
+	char buff[256];
+	cl_object x;
+	int n, ee, ww, q, dd;
+
+	fmt_not_colon(colon);
+	fmt_max_param(7);
+	fmt_set_param_positive(0, &w, "illegal width");
+	fmt_set_param_positive(1, &d, "illegal number of digits");
+	fmt_set_param_positive(2, &e, "illegal number of digits in exponent");
+	fmt_set_param(3, &k, INT, 1);
+	fmt_set_param(4, &overflowchar, CHAR, -1);
+	fmt_set_param(5, &padchar, CHAR, ' ');
+	fmt_set_param(6, &exponentchar, CHAR, -1);
+
+	x = fmt_advance();
+	if (!REAL_TYPE(type_of(x))) {
+		if (fmt_nparam > 1) fmt_nparam = 1;
+		--fmt_index;
+		fmt_decimal(colon, atsign);
+		return;
+	}
+	if (type_of(x) == t_longfloat)
+		q = 16;
+	else
+		q = 7;
+	edit_double(q, number_to_double(x), &sign, buff, &exp);
+	n = exp + 1;
+	while (q >= 0)
+		if (buff[q - 1] == '0')
+			--q;
+		else
+			break;
+	if (e >= 0)
+		ee = e + 2;
+	else
+		ee = 4;
+	ww = w - ee;
+	if (d < 0) {
+		d = n < 7 ? n : 7;
+		d = q > d ? q : d;
+	}
+	dd = d - n;
+	if (0 <= dd && dd <= d) {
+		fmt_nparam = 5;
+		fmt_param[0].fmt_param_value = ww;
+		fmt_param[1].fmt_param_value = dd;
+		fmt_param[1].fmt_param_type = INT;
+		fmt_param[2].fmt_param_type = NONE;
+		fmt_param[3] = fmt_param[4];
+		fmt_param[4] = fmt_param[5];
+		--fmt_index;
+		fmt_fix_float(colon, atsign);
+		if (w >= 0)
+			while (ww++ < w)
+				WRITEC_STREAM(padchar, fmt_stream);
+		return;
+	}
+	fmt_param[1].fmt_param_value = d;
+	fmt_param[1].fmt_param_type = INT;
+	--fmt_index;
+	fmt_exponential_float(colon, atsign);
+}
+
+static void
+fmt_dollars_float(bool colon, bool atsign)
+{
+	int d, n, w, padchar;
+	double f;
+	int sign;
+	char buff[256];
+	int exp;
+	int q, i;
+	cl_object x;
+
+	fmt_max_param(4);
+	fmt_set_param(0, &d, INT, 2);
+	if (d < 0)
+		fmt_error("illegal number of digits");
+	fmt_set_param(1, &n, INT, 1);
+	if (n < 0)
+		fmt_error("illegal number of digits");
+	fmt_set_param(2, &w, INT, 0);
+	if (w < 0)
+		fmt_error("illegal width");
+	fmt_set_param(3, &padchar, CHAR, ' ');
+	x = fmt_advance();
+	if (!REAL_TYPE(type_of(x))) {
+		if (fmt_nparam < 3)
+			fmt_nparam = 0;
+		else {
+			fmt_nparam = 1;
+			fmt_param[0] = fmt_param[2];
+		}
+		--fmt_index;
+		fmt_decimal(colon, atsign);
+		return;
+	}
+	q = 7;
+	if (type_of(x) == t_longfloat)
+		q = 16;
+	f = number_to_double(x);
+	edit_double(q, f, &sign, buff, &exp);
+	if ((q = exp + d + 1) > 0)
+		edit_double(q, f, &sign, buff, &exp);
+	exp++;
+	if (w > 100 || exp > 100 || exp < -100) {
+		fmt_nparam = 6;
+		fmt_param[0] = fmt_param[2];
+		fmt_param[1].fmt_param_value = d + n - 1;
+		fmt_param[1].fmt_param_type = INT;
+		fmt_param[2].fmt_param_type =
+		fmt_param[3].fmt_param_type =
+		fmt_param[4].fmt_param_type = NONE;
+		fmt_param[5] = fmt_param[3];
+		--fmt_index;
+		fmt_exponential_float(colon, atsign);
+	}
+	if (exp > n)
+		n = exp;
+	if (sign < 0 || atsign)
+		--w;
+	if (colon) {
+		if (sign < 0)
+			WRITEC_STREAM('-', fmt_stream);
+		else if (atsign)
+			WRITEC_STREAM('+', fmt_stream);
+		while (--w > n + d)
+			WRITEC_STREAM(padchar, fmt_stream);
+	} else {
+		while (--w > n + d)
+			WRITEC_STREAM(padchar, fmt_stream);
+		if (sign < 0)
+			WRITEC_STREAM('-', fmt_stream);
+		else if (atsign)
+			WRITEC_STREAM('+', fmt_stream);
+	}
+	for (i = n - exp;  i > 0;  --i)
+		WRITEC_STREAM('0', fmt_stream);
+	for (i = 0;  i < exp;  i++)
+		WRITEC_STREAM((i < q ? buff[i] : '0'), fmt_stream);
+	WRITEC_STREAM('.', fmt_stream);
+	for (d += i;  i < d;  i++)
+		WRITEC_STREAM((i < q ? buff[i] : '0'), fmt_stream);
+}
+
+static void
+fmt_percent(bool colon, bool atsign)
+{
+	int n, i;
+
+	fmt_max_param(1);
+	fmt_set_param(0, &n, INT, 1);
+	fmt_not_colon(colon);
+	fmt_not_atsign(atsign);
+	while (n-- > 0) {
+		WRITEC_STREAM('\n', fmt_stream);
+		if (n == 0)
+			for (i = fmt_indents;  i > 0;  --i)
+				WRITEC_STREAM(' ', fmt_stream);
+	}
+}
+
+static void
+fmt_ampersand(bool colon, bool atsign)
+{
+	int n;
+
+	fmt_max_param(1);
+	fmt_set_param(0, &n, INT, 1);
+	fmt_not_colon(colon);
+	fmt_not_atsign(atsign);
+	if (n == 0)
+		return;
+	if (FILE_COLUMN(fmt_stream) != 0)
+		WRITEC_STREAM('\n', fmt_stream);
+	while (--n > 0)
+		WRITEC_STREAM('\n', fmt_stream);
+	fmt_indents = 0;
+}
+
+static void
+fmt_bar(bool colon, bool atsign)
+{
+	int n;
+
+	fmt_max_param(1);
+	fmt_set_param(0, &n, INT, 1);
+	fmt_not_colon(colon);
+	fmt_not_atsign(atsign);
+	while (n-- > 0)
+		WRITEC_STREAM('\f', fmt_stream);
+}
+
+static void
+fmt_tilde(bool colon, bool atsign)
+{
+	int n;
+
+	fmt_max_param(1);
+	fmt_set_param(0, &n, INT, 1);
+	fmt_not_colon(colon);
+	fmt_not_atsign(atsign);
+	while (n-- > 0)
+		WRITEC_STREAM('~', fmt_stream);
+}
+
+static void
+fmt_newline(bool colon, bool atsign)
+{
+	fmt_max_param(0);
+	fmt_not_colon_atsign(colon, atsign);
+	if (atsign)
+		WRITEC_STREAM('\n', fmt_stream);
+	while (ctl_index < ctl_end && isspace(ctl_string[ctl_index])) {
+		if (colon)
+			WRITEC_STREAM(ctl_string[ctl_index], fmt_stream);
+		ctl_index++;
+	}
+}
+
+static void
+fmt_tabulate(bool colon, bool atsign)
+{
+	int colnum, colinc;
+	int c, i;
+	
+	fmt_max_param(2);
+	fmt_not_colon(colon);
+	fmt_set_param(0, &colnum, INT, 1);
+	fmt_set_param(1, &colinc, INT, 1);
+	if (!atsign) {
+		c = FILE_COLUMN(fmt_stream);
+		if (c < 0) {
+			WRITESTR_STREAM("  ", fmt_stream)
+			return;
+		}
+		if (c > colnum && colinc <= 0)
+			return;
+		while (c > colnum)
+			colnum += colinc;
+		for (i = colnum - c;  i > 0;  --i)
+			WRITEC_STREAM(' ', fmt_stream);
+	} else {
+		for (i = colnum;  i > 0;  --i)
+			WRITEC_STREAM(' ', fmt_stream);
+		c = FILE_COLUMN(fmt_stream);
+		if (c < 0 || colinc <= 0)
+			return;
+		colnum = 0;
+		while (c > colnum)
+			colnum += colinc;
+		for (i = colnum - c;  i > 0;  --i)
+			WRITEC_STREAM(' ', fmt_stream);
+	}
+}
+
+static void
+fmt_asterisk(bool colon, bool atsign)
+{
+	int n;
+
+	fmt_max_param(1);
+	fmt_not_colon_atsign(colon, atsign);
+	if (atsign) {
+		fmt_set_param(0, &n, INT, 0);
+		if (n < 0 || n >= fmt_end)
+			fmt_error("can't goto");
+		fmt_index = n;
+	} else if (colon) {
+		fmt_set_param(0, &n, INT, 1);
+		if (n > fmt_index)
+			fmt_error("can't back up");
+		fmt_index -= n;
+	} else {
+		fmt_set_param(0, &n, INT, 1);
+		while (n-- > 0)
+			fmt_advance();
+	}
+}	
+
+static void
+fmt_indirection(bool colon, bool atsign)
+{
+	cl_object s, l;
+	fmt_old;
+	jmp_buf fmt_jmp_buf0;
+	int up_colon;
+
+	fmt_max_param(0);
+	fmt_not_colon(colon);
+	s = fmt_advance();
+	if (type_of(s) != t_string)
+		fmt_error("control string expected");
+	if (atsign) {
+		fmt_save;
+		fmt_jmp_buf = (int *)fmt_jmp_buf0;
+		fmt_string = s;
+		if ((up_colon = ecls_setjmp(fmt_jmp_buf))) {
+			if (--up_colon)
+				fmt_error("illegal ~:^");
+		} else
+			format(fmt_stream, 0, s->string.fillp);
+		fmt_restore1;
+	} else {
+		l = fmt_advance();
+		fmt_save;
+		fmt_base = alloca(length(l) * sizeof(cl_object));
+		fmt_index = 0;
+		for (fmt_end = 0;  !endp(l);  fmt_end++, l = CDR(l))
+			fmt_base[fmt_end] = CAR(l);
+		fmt_jmp_buf = (int *)fmt_jmp_buf0;
+		fmt_string = s;
+		if ((up_colon = ecls_setjmp(fmt_jmp_buf))) {
+			if (--up_colon)
+				fmt_error("illegal ~:^");
+		} else
+			format(fmt_stream, 0, s->string.fillp);
+		fmt_restore;
+	}
+}
+
+static void
+fmt_case(bool colon, bool atsign)
+{
+	cl_object x;
+	cl_index i;
+	int j;
+	fmt_old;
+	jmp_buf fmt_jmp_buf0;
+	int up_colon;
+	bool b;
+
+	x = make_string_output_stream(64);
+	i = ctl_index;
+	j = fmt_skip();
+	if (ctl_string[--j] != ')' || ctl_string[--j] != '~')
+		fmt_error("~) expected");
+	fmt_save;
+	fmt_jmp_buf = (int *)fmt_jmp_buf0;
+	if ((up_colon = ecls_setjmp(fmt_jmp_buf)))
+		;
+	else
+		format(x, ctl_origin + i, j - i);
+	fmt_restore1;
+	x = x->stream.object0;
+	if (!colon && !atsign)
+		for (i = 0;  i < x->string.fillp;  i++) {
+			if (isupper(j = x->string.self[i]))
+				j = tolower(j);
+			WRITEC_STREAM(j, fmt_stream);
+		}
+	else if (colon && !atsign)
+		for (b = TRUE, i = 0;  i < x->string.fillp;  i++) {
+			if (islower(j = x->string.self[i])) {
+				if (b)
+					j = toupper(j);
+				b = FALSE;
+			} else if (isupper(j)) {
+				if (!b)
+					j = tolower(j);
+				b = FALSE;
+			} else if (!isdigit(j))
+				b = TRUE;
+			WRITEC_STREAM(j, fmt_stream);
+		}
+	else if (!colon && atsign)
+		for (b = TRUE, i = 0;  i < x->string.fillp;  i++) {
+			if (islower(j = x->string.self[i])) {
+				if (b)
+					j = toupper(j);
+				b = FALSE;
+			} else if (isupper(j)) {
+				if (!b)
+					j = tolower(j);
+				b = FALSE;
+			}
+			WRITEC_STREAM(j, fmt_stream);
+		}
+	else
+		for (i = 0;  i < x->string.fillp;  i++) {
+			if (islower(j = x->string.self[i]))
+				j = toupper(j);
+			WRITEC_STREAM(j, fmt_stream);
+		}
+	if (up_colon)
+		ecls_longjmp(fmt_jmp_buf, up_colon);
+}
+
+static void
+fmt_conditional(bool colon, bool atsign)
+{
+	int i, j, k;
+	cl_object x;
+	int n;
+	bool done;
+	fmt_old;
+
+	fmt_not_colon_atsign(colon, atsign);
+	if (colon) {
+		fmt_max_param(0);
+		i = ctl_index;
+		j = fmt_skip();
+		if (ctl_string[--j] != ';' || ctl_string[--j] != '~')
+			fmt_error("~; expected");
+		k = fmt_skip();
+		if (ctl_string[--k] != ']' || ctl_string[--k] != '~')
+			fmt_error("~] expected");
+		if (Null(fmt_advance())) {
+			fmt_save;
+			format(fmt_stream, ctl_origin + i, j - i);
+			fmt_restore1;
+		} else {
+			fmt_save;
+			format(fmt_stream, ctl_origin + j + 2, k - (j + 2));
+			fmt_restore1;
+		}
+	} else if (atsign) {
+		i = ctl_index;
+		j = fmt_skip();
+		if (ctl_string[--j] != ']' || ctl_string[--j] != '~')
+			fmt_error("~] expected");
+		if (Null(fmt_advance()))
+			;
+		else {
+			--fmt_index;
+			fmt_save;
+			format(fmt_stream, ctl_origin + i, j - i);
+			fmt_restore1;
+		}
+	} else {
+		fmt_max_param(1);
+		if (fmt_nparam == 0) {
+			x = fmt_advance();
+			if (!FIXNUMP(x))
+				fmt_error("illegal argument for conditional");
+			n = fix(x);
+		} else
+			fmt_set_param(0, &n, INT, 0);
+		i = ctl_index;
+		for (done = FALSE;;  --n) {
+			j = fmt_skip();
+			for (k = j;  ctl_string[--k] != '~';)
+				;
+			if (n == 0) {
+				fmt_save;
+				format(fmt_stream, ctl_origin + i, k - i);
+				fmt_restore1;
+				done = TRUE;
+			}
+			i = j;
+			if (ctl_string[--j] == ']') {
+				if (ctl_string[--j] != '~')
+					fmt_error("~] expected");
+				return;
+			}
+			if (ctl_string[j] == ';') {
+				if (ctl_string[--j] == '~')
+					continue;
+				if (ctl_string[j] == ':')
+					goto ELSE;
+			}
+			fmt_error("~; or ~] expected");
+		}
+	ELSE:
+		if (ctl_string[--j] != '~')
+			fmt_error("~:; expected");
+		j = fmt_skip();
+		if (ctl_string[--j] != ']' || ctl_string[--j] != '~')
+			fmt_error("~] expected");
+		if (!done) {
+			fmt_save;
+			format(fmt_stream, ctl_origin + i, j - i);
+			fmt_restore1;
+		}
+	}
+}
+
+static void
+fmt_iteration(bool colon, bool atsign)
+{
+	int n, i, o;
+	volatile int j;
+	bool colon_close = FALSE;
+	cl_object l;
+	fmt_old;
+	jmp_buf fmt_jmp_buf0;
+	int up_colon;
+
+	fmt_max_param(1);
+	fmt_set_param(0, &n, INT, 1000000);
+	i = ctl_index;
+	j = fmt_skip();
+	if (ctl_string[--j] != '}')
+		fmt_error("~} expected");
+	if (ctl_string[--j] == ':') {
+		colon_close = TRUE;
+		--j;
+	}
+	if (ctl_string[j] != '~')
+		fmt_error("syntax error");
+	o = ctl_origin;
+	if (!colon && !atsign) {
+		l = fmt_advance();
+		fmt_save;
+		fmt_base = (cl_object *)alloca(length(l) * sizeof(cl_object));
+		fmt_index = 0;
+		for (fmt_end = 0;  !endp(l);  fmt_end++, l = CDR(l))
+			fmt_base[fmt_end] = CAR(l);
+		fmt_jmp_buf = (int *)fmt_jmp_buf0;
+		if (colon_close)
+			goto L1;
+		while (fmt_index < fmt_end) {
+		L1:
+			if (n-- <= 0)
+				break;
+			if ((up_colon = ecls_setjmp(fmt_jmp_buf))) {
+				if (--up_colon)
+					fmt_error("illegal ~:^");
+				break;
+			}
+			format(fmt_stream, o + i, j - i);
+		}
+		fmt_restore;
+	} else if (colon && !atsign) {
+	  	int fl = 0;
+		volatile cl_object l0;
+		l0 = fmt_advance();
+		fmt_save;
+		for (l = l0; !endp(l); l = CDR(l))
+		  fl += length(CAR(l));
+		fmt_base = (cl_object *)alloca(fl * sizeof(cl_object));
+		fmt_jmp_buf = (int *)fmt_jmp_buf0;
+		if (colon_close)
+			goto L2;
+		while (!endp(l0)) {
+		L2:
+			if (n-- <= 0)
+				break;
+			l = CAR(l0);
+			l0 = CDR(l0);
+			fmt_index = 0;
+			for (fmt_end = 0; !endp(l); fmt_end++, l = CDR(l))
+				fmt_base[fmt_end] = CAR(l);
+			if ((up_colon = ecls_setjmp(fmt_jmp_buf))) {
+				if (--up_colon)
+					break;
+				else
+					continue;
+			}
+			format(fmt_stream, o + i, j - i);
+		}
+		fmt_restore;
+	} else if (!colon && atsign) {
+		fmt_save;
+		fmt_jmp_buf = (int *)fmt_jmp_buf0;
+		if (colon_close)
+			goto L3;
+		while (fmt_index < fmt_end) {
+		L3:
+			if (n-- <= 0)
+				break;
+			if ((up_colon = ecls_setjmp(fmt_jmp_buf))) {
+				if (--up_colon)
+					fmt_error("illegal ~:^");
+				break;
+			}
+			format(fmt_stream, o + i, j - i);
+		}
+		fmt_restore1;
+	} else if (colon && atsign) {
+		if (colon_close)
+			goto L4;
+		while (fmt_index < fmt_end) {
+		L4:
+			if (n-- <= 0)
+				break;
+			l = fmt_advance();
+			fmt_save;
+			fmt_base = (cl_object *)alloca(length(l) * sizeof(cl_object));
+			fmt_index = 0;
+			for (fmt_end = 0; !endp(l); fmt_end++, l = CDR(l))
+				fmt_base[fmt_end] = CAR(l);
+			fmt_jmp_buf = (int *)fmt_jmp_buf0;
+			if ((up_colon = ecls_setjmp(fmt_jmp_buf))) {
+				fmt_restore;
+				if (--up_colon)
+					break;
+				else
+					continue;
+			}
+			format(fmt_stream, o + i, j - i);
+			fmt_restore;
+		}
+	}
+}
+
+static void
+fmt_justification(volatile bool colon, bool atsign)
+{
+	int mincol, colinc, minpad, padchar;
+	cl_object fields[16];
+	fmt_old;
+	jmp_buf fmt_jmp_buf0;
+	volatile int i, j, k, l, m, n, j0, l0;
+	int up_colon;
+	volatile int special = 0;
+	volatile int spare_spaces, line_length;
+
+	fmt_max_param(4);
+	fmt_set_param(0, &mincol, INT, 0);
+	fmt_set_param(1, &colinc, INT, 1);
+	fmt_set_param(2, &minpad, INT, 0);
+	fmt_set_param(3, &padchar, CHAR, ' ');
+
+	n = 0;
+	for (;;) {
+		if (n >= 16)
+			fmt_error("too many fields");
+		i = ctl_index;
+		j0 = j = fmt_skip();
+		while (ctl_string[--j] != '~')
+			;
+		fields[n] = make_string_output_stream(64);
+		fmt_save;
+		fmt_jmp_buf = (int *)fmt_jmp_buf0;
+		if ((up_colon = ecls_setjmp(fmt_jmp_buf))) {
+			--n;
+			if (--up_colon)
+				fmt_error("illegal ~:^");
+			fmt_restore1;
+			while (ctl_string[--j0] != '>')
+				j0 = fmt_skip();
+			if (ctl_string[--j0] != '~')
+				fmt_error("~> expected");
+			break;
+		}
+		format(fields[n++], ctl_origin + i, j - i);
+		fmt_restore1;
+		if (ctl_string[--j0] == '>') {
+			if (ctl_string[--j0] != '~')
+				fmt_error("~> expected");
+			break;
+		} else if (ctl_string[j0] != ';')
+			fmt_error("~; expected");
+		else if (ctl_string[--j0] == ':') {
+			if (n != 1)
+				fmt_error("illegal ~:;");
+			special = 1;
+			for (j = j0;  ctl_string[j] != '~';  --j)
+				;
+			fmt_save;
+			format(fmt_stream, ctl_origin + j, j0 - j + 2);
+			fmt_restore1;
+			spare_spaces = fmt_spare_spaces;
+			line_length = fmt_line_length;
+		} else if (ctl_string[j0] != '~')
+			fmt_error("~; expected");
+	}
+	for (i = special, l = 0;  i < n;  i++)
+		l += fields[i]->stream.object0->string.fillp;
+	m = n - 1 - special;
+	if (m <= 0 && !colon && !atsign) {
+		m = 0;
+		colon = TRUE;
+	}
+	if (colon)
+		m++;
+	if (atsign)
+		m++;
+	l0 = l;
+	l += minpad * m;
+	for (k = 0;  mincol + k * colinc < l;  k++)
+		;
+	l = mincol + k * colinc;
+	if (special != 0 &&
+	    FILE_COLUMN(fmt_stream) + l + spare_spaces >= line_length)
+		princ(fields[0]->stream.object0, fmt_stream);
+	l -= l0;
+	for (i = special;  i < n;  i++) {
+		if (i > 0 || colon)
+			for (j = l / m, l -= j, --m;  j > 0;  --j)
+				WRITEC_STREAM(padchar, fmt_stream);
+		princ(fields[i]->stream.object0, fmt_stream);
+	}
+	if (atsign)
+		for (j = l;  j > 0;  --j)
+			WRITEC_STREAM(padchar, fmt_stream);
+}
+
+static void
+fmt_up_and_out(bool colon, bool atsign)
+{
+	int i, j, k;
+
+	fmt_max_param(3);
+	fmt_not_atsign(atsign);
+	if (fmt_nparam == 0) {
+		if (fmt_index >= fmt_end)
+			ecls_longjmp(fmt_jmp_buf, ++colon);
+	} else if (fmt_nparam == 1) {
+		fmt_set_param(0, &i, INT, 0);
+		if (i == 0)
+			ecls_longjmp(fmt_jmp_buf, ++colon);
+	} else if (fmt_nparam == 2) {
+		fmt_set_param(0, &i, INT, 0);
+		fmt_set_param(1, &j, INT, 0);
+		if (i == j)
+			ecls_longjmp(fmt_jmp_buf, ++colon);
+	} else {
+		fmt_set_param(0, &i, INT, 0);
+		fmt_set_param(1, &j, INT, 0);
+		fmt_set_param(2, &k, INT, 0);
+		if (i <= j && j <= k)
+			ecls_longjmp(fmt_jmp_buf, ++colon);
+	}
+}
+
+static void
+fmt_semicolon(bool colon, bool atsign)
+{
+	fmt_not_atsign(atsign);
+	if (!colon)
+		fmt_error("~:; expected");
+	fmt_max_param(2);
+	fmt_set_param(0, &fmt_spare_spaces, INT, 0);
+	fmt_set_param(1, &fmt_line_length, INT, 72);
+}
+
+@(defun format (strm string &rest args)
+	cl_object x = OBJNULL;
+	jmp_buf fmt_jmp_buf0;
+	bool colon;
+	fmt_old;
+@
+	if (Null(strm)) {
+		strm = make_string_output_stream(64);
+		x = strm->stream.object0;
+	} else if (strm == Ct)
+		strm = symbol_value(Vstandard_output);
+	else if (type_of(strm) == t_string) {
+		x = strm;
+		if (!x->string.hasfillp)
+		  FEerror("The string ~S doesn't have a fill-pointer.", 1, x);
+		strm = make_string_output_stream(0);
+		strm->stream.object0 = x;
+		x = OBJNULL;
+	}
+	fmt_save;
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+ 		strm = symbol_value(strm->stream.object0);
+		goto RETRY;
+	      }
+	  else
+	    fmt_writec = writec_stream;
+	} else
+#ifdef CLOS
+	  if (type_of(strm) == t_instance)
+	    fmt_writec = interactive_writec_stream;
+	else
+#endif CLOS
+	  FEerror("~S is not a stream.", 1, strm);
+	assert_type_string(string);
+	if (frs_push(FRS_PROTECT, Cnil)) {
+		frs_pop();
+		fmt_restore;
+		unwind(nlj_fr, nlj_tag);
+	}
+	fmt_base = (cl_object *)args;
+	fmt_index = 0;
+	fmt_end = narg - 2;
+	fmt_jmp_buf = (int *)fmt_jmp_buf0;
+	if (symbol_value(siVindent_formatted_output) != Cnil)
+		fmt_indents = FILE_COLUMN(strm);
+	else
+		fmt_indents = 0;
+	fmt_string = string;
+	if ((colon = ecls_setjmp(fmt_jmp_buf))) {
+		if (--colon)
+			fmt_error("illegal ~:^");
+	} else {
+		format(strm, 0, string->string.fillp);
+		FLUSH_STREAM(strm);
+	}
+	frs_pop();
+	fmt_restore;
+	@(return (x == OBJNULL? Cnil : x))
+@)
+
+static void
+format(cl_object fmt_stream0, int ctl_origin0, int ctl_end0)
+{
+	int c, i, n;
+	bool colon, atsign;
+	cl_object x;
+
+	fmt_stream = fmt_stream0;
+	ctl_origin = ctl_origin0;
+	ctl_index = 0;
+	ctl_end = ctl_end0;
+
+LOOP:
+	if (ctl_index >= ctl_end)
+		return;
+	if ((c = ctl_advance()) != '~') {
+		WRITEC_STREAM(c, fmt_stream);
+		goto LOOP;
+	}
+	n = 0;
+	for (;;) {
+		switch (c = ctl_advance()) {
+		case ',':
+			fmt_param[n].fmt_param_type = NONE;
+			break;
+
+		case '0':  case '1':  case '2':  case '3':  case '4':
+		case '5':  case '6':  case '7':  case '8':  case '9':
+		DIGIT:
+			i = 0;
+			do {
+				i = i*10 + (c - '0');
+				c = ctl_advance();
+			} while (isdigit(c));
+			fmt_param[n].fmt_param_type = INT;
+			fmt_param[n].fmt_param_value = i;
+			break;
+
+		case '+':
+			c = ctl_advance();
+			if (!isdigit(c))
+				fmt_error("digit expected");
+			goto DIGIT;
+
+		case '-':
+			c = ctl_advance();
+			if (!isdigit(c))
+				fmt_error("digit expected");
+			i = 0;
+			do {
+				i = i*10 + (c - '0');
+				c = ctl_advance();
+			} while (isdigit(c));
+			fmt_param[n].fmt_param_type = INT;
+			fmt_param[n].fmt_param_value = -i;
+			break;
+
+		case '\'':
+			fmt_param[n].fmt_param_type = CHAR;
+			fmt_param[n].fmt_param_value = ctl_advance();
+			c = ctl_advance();
+			break;
+
+		case 'v':  case 'V':
+			x = fmt_advance();
+			if (FIXNUMP(x)) {
+				fmt_param[n].fmt_param_type = INT;
+				fmt_param[n].fmt_param_value = fix(x);
+			} else if (type_of(x) == t_character) {
+				fmt_param[n].fmt_param_type = CHAR;
+				fmt_param[n].fmt_param_value = CHAR_CODE(x);
+			} else
+				fmt_error("illegal V parameter");
+			c = ctl_advance();
+			break;
+
+		case '#':
+			fmt_param[n].fmt_param_type = INT;
+			fmt_param[n].fmt_param_value = fmt_end - fmt_index;
+			c = ctl_advance();
+			break;
+
+		default:
+			if (n > 0)
+				fmt_error("illegal ,");
+			else
+				goto DIRECTIVE;
+		}
+		n++;
+		if (c != ',')
+			break;
+	}
+
+DIRECTIVE:
+	colon = atsign = FALSE;
+	if (c == ':') {
+		colon = TRUE;
+		c = ctl_advance();
+	}
+	if (c == '@@') {
+		atsign = TRUE;
+		c = ctl_advance();
+	}
+	fmt_nparam = n;
+	switch (c) {
+	case 'a':  case 'A':
+		fmt_ascii(colon, atsign);
+		break;
+
+	case 's':  case 'S':
+		fmt_S_expression(colon, atsign);
+		break;
+
+	case 'd':  case 'D':
+		fmt_decimal(colon, atsign);
+		break;
+
+	case 'b':  case 'B':
+		fmt_binary(colon, atsign);
+		break;
+
+	case 'o':  case 'O':
+		fmt_octal(colon, atsign);
+		break;
+
+	case 'x':  case 'X':
+		fmt_hexadecimal(colon, atsign);
+		break;
+
+	case 'r':  case 'R':
+		fmt_radix(colon, atsign);
+		break;
+
+	case 'p':  case 'P':
+		fmt_plural(colon, atsign);
+		break;
+
+	case 'c':  case 'C':
+		fmt_character(colon, atsign);
+		break;
+
+	case 'f':  case 'F':
+		fmt_fix_float(colon, atsign);
+		break;
+
+	case 'e':  case 'E':
+		fmt_exponential_float(colon, atsign);
+		break;
+
+	case 'g':  case 'G':
+		fmt_general_float(colon, atsign);
+		break;
+
+	case '$':
+		fmt_dollars_float(colon, atsign);
+		break;
+
+	case '%':
+		fmt_percent(colon, atsign);
+		break;
+
+	case '&':
+		fmt_ampersand(colon, atsign);
+		break;
+
+	case '|':
+		fmt_bar(colon, atsign);
+		break;
+
+	case '~':
+		fmt_tilde(colon, atsign);
+		break;
+
+	case '\n':
+	case '\r':
+		fmt_newline(colon, atsign);
+		break;
+
+	case 't':  case 'T':
+		fmt_tabulate(colon, atsign);
+		break;
+
+	case '*':
+		fmt_asterisk(colon, atsign);
+		break;
+
+	case '?':
+		fmt_indirection(colon, atsign);
+		break;
+
+	case '(':
+		fmt_case(colon, atsign);
+		break;
+
+	case '[':
+		fmt_conditional(colon, atsign);
+		break;
+
+	case '{':
+		fmt_iteration(colon, atsign);
+		break;
+
+	case '<':
+		fmt_justification(colon, atsign);
+		break;
+
+	case '^':
+		fmt_up_and_out(colon, atsign);
+		break;
+
+	case ';':
+		fmt_semicolon(colon, atsign);
+		break;
+
+	default:
+		fmt_error("illegal directive");
+	}
+	goto LOOP;
+}
+
+void
+init_format(void)
+{
+	fmt_temporary_stream = make_string_output_stream(64);
+	register_root(&fmt_temporary_stream);
+	fmt_temporary_string = fmt_temporary_stream->stream.object0;
+
+	SYM_VAL(siVindent_formatted_output) = Cnil;
+}
diff --git a/src/c/gbc-new.d b/src/c/gbc-new.d
new file mode 100644
index 000000000..a27113000
--- /dev/null
+++ b/src/c/gbc-new.d
@@ -0,0 +1,989 @@
+/*
+    gbc.c -- Garbage collector.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi and William F. Schelter.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "page.h"
+
+/******************************* EXPORTS ******************************/
+
+bool GC_enable;
+int gc_time;			/* Beppe */
+
+/******************************* ------- ******************************/
+
+/*
+   mark_table[m]:i represents word w = 128*m + 4*i, where m = addr-DATA_START.
+   Therefore m = w >> 7, i = (w / 4) % 32 = (w >> 2) & 0x1f.
+*/
+
+static int	*mark_table;
+
+static void inline
+set_mark_bit(void *x) {
+	int w = (int)x;
+	int m = (w - DATA_START) >> 7;
+	int i = (w >> 2) & 0x1f;
+	mark_table[m] |= (1 << i);
+}
+static int inline
+get_mark_bit(void *x) {
+	int w = (int)x;
+	int m = (w - DATA_START) >> 7;
+	int i = (w >> 2) & 0x1f;
+	return (mark_table[m] >> i) & 1;
+}
+
+#define	inheap(pp)	((unsigned long)(pp) < (unsigned long)heap_end)
+#define VALID_DATA_ADDRESS(pp) \
+  !IMMEDIATE(pp) && (cl_index)DATA_START <= (cl_index)(pp) && (cl_index)(pp) < (cl_index)heap_end
+
+cl_object siVgc_verbose;
+cl_object siVgc_message;
+
+static bool	debug = FALSE;
+static int	maxpage;
+
+#define	GC_ROOT_MAX		200
+static cl_object	*gc_root[GC_ROOT_MAX];
+static int	gc_roots;
+
+static bool	collect_blocks;
+
+/*
+   We must register location, since value may be reassigned (e.g. malloc_list)
+ */
+
+static void _mark_object (cl_object x);
+static void _mark_contblock (void *p, size_t s);
+extern void sigint (void);
+
+void
+register_root(cl_object *p)
+{
+	if (gc_roots >= GC_ROOT_MAX)
+		error("too many roots");
+	gc_root[gc_roots++] = p;
+}
+
+@(defun gc (area)
+@
+	if (!GC_enabled())
+		error("GC is not enabled");
+	if (Null(area))
+		gc(t_cons);
+	else
+		gc(t_contiguous);
+	@(return)
+@)
+
+/*----------------------------------------------------------------------
+ * Mark phase
+ *----------------------------------------------------------------------
+ */
+
+/* Whenever two arrays are linked together by displacement,
+   if one is live, the other will be made live */
+#define mark_displaced(ar) mark_object(ar)
+#define mark_contblock(x,s) {if (collect_blocks) _mark_contblock(x,s); }
+#if 1
+#define mark_object(x) if ((x != OBJNULL) && !IMMEDIATE(x)) _mark_object(x)
+#define mark_next(a) if ((a != OBJNULL) && !IMMEDIATE(a)) { x=(a); goto BEGIN; }
+#else
+#define mark_object(x) _mark_object(x)
+#define mark_next(a) x=(a); goto BEGIN
+#endif
+
+/* We make bitvectors multiple of sizeof(int) in size allocated
+ Assume 8 = number of bits in char */
+#define W_SIZE (8*sizeof(int))
+
+static void
+_mark_object(cl_object x)
+{
+	size_t i, j;
+	cl_object *p, y;
+	char *cp;
+
+	cs_check(x);
+BEGIN:
+#if 0
+	/* We cannot get here because mark_object() and mark_next() already check this */
+	if (IMMEDIATE(x)) return;	/* fixnum, character or locative */
+	if (x == OBJNULL)
+		return;
+#endif
+	if (get_mark_bit(x))
+		return;
+	set_mark_bit(x);
+
+	switch (type_of(x)) {
+
+	case t_bignum:
+		if (collect_blocks) {
+		  /* GMP may set num.alloc before actually allocating anything.
+		     With these checks we make sure we do not move anything
+		     we don't have to. Besides, we use big_dim as the size
+		     of the object, because big_size might even be smaller.
+		  */
+		  char *limbs = (char *)x->big.big_limbs;
+		  size_t size = x->big.big_dim * sizeof(mp_limb_t);
+		  if (size) mark_contblock(limbs, size);
+		}
+		break;
+
+	case t_ratio:
+		mark_object(x->ratio.num);
+		mark_next(x->ratio.den);
+		break;
+
+	case t_shortfloat:
+	case t_longfloat:
+		break;
+
+	case t_complex:
+		mark_object(x->complex.imag);
+		mark_next(x->complex.real);
+		break;
+
+	case t_character:
+		break;
+
+	case t_symbol:
+		mark_object(x->symbol.name);
+		mark_object(x->symbol.plist);
+		mark_object(SYM_FUN(x));
+		mark_next(SYM_VAL(x));
+		break;
+
+	case t_package:
+		mark_object(x->pack.name);
+		mark_object(x->pack.nicknames);
+		mark_object(x->pack.shadowings);
+		mark_object(x->pack.uses);
+		mark_object(x->pack.usedby);
+		mark_object(x->pack.internal);
+		mark_next(x->pack.external);
+		break;
+
+	case t_cons:
+		mark_object(CAR(x));
+		mark_next(CDR(x));
+		break;
+
+	case t_hashtable:
+		mark_object(x->hash.rehash_size);
+		mark_object(x->hash.threshold);
+		if (x->hash.data == NULL)
+			break;
+		for (i = 0, j = x->hash.size;  i < j;  i++) {
+			mark_object(x->hash.data[i].key);
+			mark_object(x->hash.data[i].value);
+		}
+		mark_contblock(x->hash.data, j * sizeof(struct hashtable_entry));
+		break;
+
+	case t_array:
+		mark_contblock(x->array.dims, sizeof(x->array.dims[0])*x->array.rank);
+	case t_vector:
+		if ((y = x->array.displaced) != Cnil)
+			mark_displaced(y);
+		cp = (char *)x->array.self.t;
+		if (cp == NULL)
+			break;
+		switch ((enum aelttype)x->array.elttype) {
+		case aet_object:
+			if (x->array.displaced == Cnil || CAR(x->array.displaced) == Cnil) {
+				cl_object *p = x->array.self.t;
+				cl_index i;
+				if (x->array.t == t_vector && x->vector.hasfillp)
+					i = x->vector.fillp;
+				else
+					i = x->vector.dim;
+				while (i-- > 0)
+					mark_object(p[i]);
+			}
+			j = sizeof(cl_object)*x->array.dim;
+			break;
+		case aet_ch:
+			j = x->array.dim;
+			break;
+		case aet_bit:
+			j = sizeof(int) * ((x->vector.offset + x->vector.dim + W_SIZE -1)/W_SIZE);
+			break;
+		case aet_fix:
+			j = x->array.dim * sizeof(cl_fixnum);
+			break;
+		case aet_sf:
+			j = x->array.dim * sizeof(float);
+			break;
+		case aet_lf:
+			j = x->array.dim * sizeof(double);
+			break;
+		default:
+			error("Allocation botch: unknown array element type");
+		}
+		goto COPY_ARRAY;
+	case t_string:
+		if ((y = x->string.displaced) != Cnil)
+			mark_displaced(y);
+		cp = x->string.self;
+		if (cp == NULL)
+			break;
+		j = x->string.dim;
+	COPY_ARRAY:
+		mark_contblock(cp, j);
+		break;
+	case t_bitvector:
+		if ((y = x->vector.displaced) != Cnil)
+			mark_displaced(y);
+		cp = x->vector.self.bit;
+		if (cp == NULL)
+			break;
+		j= sizeof(int) * ((x->vector.offset + x->vector.dim + W_SIZE -1)/W_SIZE);
+		goto COPY_ARRAY;
+
+#ifndef CLOS
+	case t_structure:
+		mark_object(x->str.name);
+		p = x->str.self;
+		if (p == NULL)
+			break;
+		for (i = 0, j = x->str.length;  i < j;  i++)
+			mark_object(p[i]);
+		mark_contblock(p, j*sizeof(cl_object));
+		break;
+#endif CLOS
+
+	case t_stream:
+		switch ((enum smmode)x->stream.mode) {
+		case smm_closed:
+			/* Rest of fields are NULL */
+			mark_next(x->stream.object1);
+			break;
+		case smm_input:
+		case smm_output:
+		case smm_io:
+		case smm_probe:
+			mark_object(x->stream.object0);
+			mark_object(x->stream.object1);
+			mark_contblock(x->stream.buffer, BUFSIZ);
+			break;
+
+		case smm_synonym:
+			mark_next(x->stream.object0);
+			break;
+
+		case smm_broadcast:
+		case smm_concatenated:
+			mark_next(x->stream.object0);
+			break;
+
+		case smm_two_way:
+		case smm_echo:
+			mark_object(x->stream.object0);
+			mark_next(x->stream.object1);
+			break;
+
+		case smm_string_input:
+		case smm_string_output:
+			mark_next(x->stream.object0);
+			break;
+
+		default:
+			error("mark stream botch");
+		}
+		break;
+
+	case t_random:
+		break;
+
+	case t_readtable:
+		if (x->readtable.table == NULL)
+			break;
+		mark_contblock((char *)(x->readtable.table), RTABSIZE*sizeof(struct readtable_entry));
+		for (i = 0;  i < RTABSIZE;  i++) {
+			cl_object *p = x->readtable.table[i].dispatch_table;
+			mark_object(x->readtable.table[i].macro);
+			if (p != NULL) {
+			  mark_contblock(p, RTABSIZE*sizeof(cl_object));
+			  for (j = 0;  j < RTABSIZE;  j++)
+			    mark_object(p[j]);
+			}
+		}
+		break;
+
+	case t_pathname:
+		mark_object(x->pathname.host);
+		mark_object(x->pathname.device);
+		mark_object(x->pathname.directory);
+		mark_object(x->pathname.name);
+		mark_object(x->pathname.type);
+		mark_object(x->pathname.version);
+		break;
+
+	case t_bytecodes: {
+		cl_index i, size;
+		size = x->bytecodes.size;
+		mark_object(x->bytecodes.lex);
+		mark_contblock(x->bytecodes.data, size * sizeof(cl_object));
+		for (i=0; i<size; i++)
+			mark_object(x->bytecodes.data[i]);
+		break;
+	}
+	case t_cfun:
+		mark_object(x->cfun.block);
+		mark_object(x->cfun.name);
+		break;
+
+	case t_cclosure:
+		mark_object(x->cfun.block);
+		mark_object(x->cclosure.env);
+		break;
+
+#ifdef THREADS
+	case t_cont:
+		mark_next(x->cn.cn_thread);
+		break;
+
+	case t_thread:
+/* Already marked by malloc
+ 		mark_contblock(x->thread.data, x->thread.size);
+ */
+		mark_next(x->thread.entry);
+		break;
+#endif THREADS
+#ifdef CLOS
+	case t_instance:
+		mark_object(x->instance.class);
+		p = x->instance.slots;
+		if (p == NULL)
+			break;
+		for (i = 0, j = x->instance.length;  i < j;  i++)
+			mark_object(p[i]);
+		mark_contblock(p, j*sizeof(cl_object));
+		break;
+
+	case t_gfun:
+		mark_object(x->gfun.name);
+		mark_object(x->gfun.method_hash);
+		mark_object(x->gfun.instance);
+		p = x->gfun.specializers;
+		if (p == NULL)
+			break;
+		for (i = 0, j = x->gfun.arg_no;  i < j;  i++)
+			mark_object(p[i]);
+		mark_contblock(p, j*sizeof(cl_object));
+		break;
+#endif CLOS
+	case t_codeblock:
+		mark_object(x->cblock.name);
+		mark_contblock(x->cblock.start, x->cblock.size);
+		if (x->cblock.data) {
+			cl_index i = x->cblock.data_size;
+			cl_object *p = x->cblock.data;
+			while (i--)
+				mark_object(p[i]);
+		}
+		break;
+	default:
+		if (debug)
+			printf("\ttype = %d\n", type_of(x));
+		error("mark botch");
+	}
+}
+
+static void
+mark_stack_conservative(int *top, int *bottom)
+{
+  int p, m;
+  cl_object x;
+  struct typemanager *tm;
+  register int *j;
+
+  if (debug) { printf("Traversing C stack .."); fflush(stdout); }
+
+  /* On machines which align local pointers on multiple of 2 rather
+     than 4 we need to mark twice
+
+  if (offset) mark_stack_conservative(bottom, ((char *) top) + offset, 0);
+     */
+  for (j = top ; j >= bottom ; j--) {
+    /* improved Beppe: */
+    if (VALID_DATA_ADDRESS(*j) && type_map[p = page(*j)] < (char)t_end) {
+      tm = tm_of((enum type)type_map[p]);
+      x = (cl_object)(*j - (*j - (int)pagetochar(p)) % tm->tm_size);
+      if (!get_mark_bit(x))
+	  mark_object(x);
+    }
+  }
+  if (debug) {printf(". done.\n"); fflush(stdout); }
+}
+
+static void
+mark_phase(void)
+{
+	register int i;
+	register struct package *pp;
+	register bds_ptr bdp;
+	register frame_ptr frp;
+	register ihs_ptr ihsp;
+
+	mark_object(Cnil);
+	mark_object(Ct);
+
+#ifdef THREADS
+	{
+	  pd *pdp;
+	  lpd *old_clwp = clwp;
+
+	  for (pdp = running_head; pdp != (pd *)NULL; pdp = pdp->pd_next) {
+
+	    clwp = pdp->pd_lpd;
+#endif THREADS
+	    
+	    for (i=0; i<NValues; i++)
+	      mark_object(VALUES(i));
+
+	    for (bdp = bds_org;  bdp <= bds_top;  bdp++) {
+	      mark_object(bdp->bds_sym);
+	      mark_object(bdp->bds_val);
+	    }
+	    
+	    for (frp = frs_org;  frp <= frs_top;  frp++) {
+	      mark_object(frp->frs_val);
+	      mark_object(frp->frs_lex);
+	    }
+	    
+	    for (ihsp = ihs_org;  ihsp <= ihs_top;  ihsp++) {
+	      mark_object(ihsp->ihs_function);
+	      mark_object(ihsp->ihs_base);
+	    }
+
+	    mark_object(lex_env);
+
+#ifdef THREADS	      
+	    /* added to mark newly allocated objects */
+	    mark_object(clwp->lwp_alloc_temporary);
+	    mark_object(clwp->lwp_fmt_temporary_stream);
+	    mark_object(clwp->lwp_PRINTstream);
+	    mark_object(clwp->lwp_PRINTcase);
+	    mark_object(clwp->lwp_READtable);
+	    mark_object(clwp->lwp_delimiting_char);
+	    mark_object(clwp->lwp_gensym_prefix);
+	    mark_object(clwp->lwp_gentemp_prefix);
+	    mark_object(clwp->lwp_token);
+
+	    /* (current-thread) can return it at any time
+	     */
+	    mark_object(clwp->lwp_thread);
+#endif THREADS	      
+	    
+	    /* now collect from the c-stack of the thread ... */
+	    
+	    { int *where;
+	      volatile jmp_buf buf;
+
+	      /* ensure flushing of register caches */
+	      if (ecls_setjmp(buf) == 0) ecls_longjmp(buf, 1);
+
+#ifdef THREADS
+	      if (clwp != old_clwp) /* is not the executing stack */
+# ifdef __linux
+		where = (int *)pdp->pd_env[0].__jmpbuf[0].__sp;
+# else
+		where = (int *)pdp->pd_env[JB_SP];
+# endif
+	      else
+#endif THREADS
+		where = (int *)&where ;
+	      
+	      /* If the locals of type object in a C function could be
+		 aligned other than on multiples of sizeof (char *)
+		 we would have to mark twice */
+	      
+	      if (where > cs_org)
+		mark_stack_conservative(where, cs_org);
+	      else
+		mark_stack_conservative(cs_org, where);
+	    }
+#ifdef THREADS
+	  }
+	  clwp = old_clwp;
+	}
+#endif THREADS
+
+	/* mark roots */
+	for (i = 0; i < gc_roots;  i++)
+		mark_object(*gc_root[i]);
+
+	/* mark registered symbols & keywords */
+	{
+	const struct keyword_info *k;
+	const struct symbol_info *s;
+	for (k = all_keywords; k->loc != NULL; k++)
+		mark_object(*(k->loc));
+	for (s = all_symbols; s->loc != NULL; s++)
+		mark_object(*(s->loc));
+	}
+
+	if (debug) {
+		printf("symbol navigation\n");
+		fflush(stdout);
+	}
+}
+
+static void
+sweep_phase(void)
+{
+	register int i, j, k;
+	register cl_object x;
+	register char *p;
+	register struct typemanager *tm;
+	register cl_object f;
+
+	Cnil->symbol.m = FALSE;
+	Ct->symbol.m = FALSE;
+
+	if (debug)
+		printf("type map\n");
+
+	for (i = 0;  i < maxpage;  i++) {
+		if (type_map[i] == (int)t_contiguous) {
+			if (debug) {
+				printf("-");
+				continue;
+			}
+		}
+		if (type_map[i] >= (int)t_end)
+			continue;
+
+		tm = tm_of((enum type)type_map[i]);
+
+	/*
+		general sweeper
+	*/
+
+		if (debug)
+			printf("%c", tm->tm_name[0]);
+
+		p = pagetochar(i);
+		f = tm->tm_free;
+		k = 0;
+		for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) {
+			x = (cl_object)p;
+			if (!get_mark_bit(x)) {
+			  ((struct freelist *)x)->f_link = f;
+			  f = x;
+			  k++;
+			}
+		}
+		tm->tm_free = f;
+		tm->tm_nfree += k;
+		tm->tm_nused -= k;
+	}
+
+	if (debug) {
+		putchar('\n');
+		fflush(stdout);
+	}
+}
+
+static void
+contblock_sweep_phase(void)
+{
+	register int i, j;
+	register char *s, *e, *p, *q;
+	register struct contblock *cbp;
+
+	cb_pointer = NULL;
+	ncb = 0;
+	for (i = 0;  i < maxpage;) {
+		if (type_map[i] != (int)t_contiguous) {
+			i++;
+			continue;
+		}
+		for (j = i+1;
+		     j < maxpage && type_map[j] == (int)t_contiguous;
+		     j++)
+			;	
+		s = pagetochar(i);
+		e = pagetochar(j);
+		for (p = s;  p < e;) {
+			if (get_mark_bit((int *)p)) {
+				p += 4;
+				continue;
+			}
+			q = p + 4;
+			while (q < e && !get_mark_bit((int *)q))
+				q += 4;
+			dealloc(p, q - p);
+			p = q + 4;
+		}
+		i = j + 1;
+	}
+
+	if (debug) {
+		for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)
+			printf("0x%p %d\n", cbp, cbp->cb_size);
+		fflush(stdout);
+	}
+}
+
+cl_object (*GC_enter_hook)() = NULL;
+cl_object (*GC_exit_hook)() = NULL;
+
+
+#ifdef THREADS
+/* 
+ * We execute the GC routine in the main stack.
+ * The idea is to switch over the main stack that is stopped in the intha
+ * and to call the GC from there on garbage_parameter. Then you can switch 
+ * back after.
+ * In addition the interrupt is disabled.
+ */
+static int i, j;
+static sigjmp_buf old_env;
+static int val;
+static lpd *old_clwp;
+static enum type t;
+static bool stack_switched = FALSE;
+
+static enum type garbage_parameter;
+
+void
+gc(enum type new_name)
+{
+	int tm;
+	int gc_start = runtime();
+
+	start_critical_section();
+	t = new_name;
+        garbage_parameter = new_name;
+#else
+
+void
+gc(enum type t)
+{
+  int i, j;
+  int tm;
+  int gc_start = runtime();
+#endif THREADS
+
+  if (!GC_enabled())
+    return;
+
+  if (SYM_VAL(siVgc_verbose) != Cnil) {
+    printf("\n[GC ..");
+    /* To use this should add entries in tm_table for reloc and contig.
+       fprintf(stdout, "\n[GC for %d %s pages ..",
+       tm_of(t)->tm_npage,
+       tm_table[(int)t].tm_name + 1); */
+    fflush(stdout);
+  }
+
+  debug = symbol_value(siVgc_message) != Cnil;
+
+#ifdef THREADS
+  if (clwp != &main_lpd)  {
+    if (debug) {
+      printf("*STACK SWITCH*\n");
+      fflush (stdout);
+    }
+
+    stack_switched = TRUE;
+    val = sigsetjmp(old_env, 1);
+    if (val == 0) {
+      /* informations used by the garbage collector need to be updated */
+# ifdef __linux
+      running_head->pd_env[0].__jmpbuf[0].__sp = old_env[0].__jmpbuf[0].__sp;
+# else
+      running_head->pd_env[JB_SP] = old_env[JB_SP];
+# endif
+      old_clwp = clwp;
+      Values = main_lpd.lwp_Values;
+      clwp = &main_lpd;
+      siglongjmp(main_pd.pd_env, 2); /* new line */
+    }
+  }
+
+  else val = 1;
+
+  if (val == 1) {
+
+#endif THREADS
+
+    if (GC_enter_hook != NULL)
+      (*GC_enter_hook)(0);
+
+    interrupt_enable = FALSE;
+
+    collect_blocks = t > t_end;
+    if (collect_blocks)
+      cbgccount++;
+    else
+      tm_table[(int)t].tm_gccount++;
+
+    if (debug) {
+      if (collect_blocks)
+	printf("GC entered for collecting blocks\n");
+      else
+	printf("GC entered for collecting %s\n", tm_table[(int)t].tm_name);
+      fflush(stdout);
+    }
+
+    maxpage = page(heap_end);
+
+    if (collect_blocks) {
+      /*
+	1 page = 512 word
+	512 bit = 16 word
+      */
+      int mark_table_size = maxpage * (LISP_PAGESIZE / 32);
+      extern void resize_hole(size_t);
+
+      if (holepage < mark_table_size*sizeof(int)/LISP_PAGESIZE + 1)
+	new_holepage = mark_table_size*sizeof(int)/LISP_PAGESIZE + 1;
+      if (new_holepage < HOLEPAGE)
+	new_holepage = HOLEPAGE;
+      resize_hole(new_holepage);
+
+      mark_table = (int*)heap_end;
+      for (i = 0;  i < mark_table_size; i++)
+	mark_table[i] = 0;
+    }
+
+    if (debug) {
+      printf("mark phase\n");
+      fflush(stdout);
+      tm = runtime();
+    }
+    mark_phase();
+    if (debug) {
+      printf("mark ended (%d)\n", runtime() - tm);
+      printf("sweep phase\n");
+      fflush(stdout);
+      tm = runtime();
+    }
+    sweep_phase();
+    if (debug) {
+      printf("sweep ended (%d)\n", runtime() - tm);
+      fflush(stdout);
+    }
+
+    if (t == t_contiguous) {
+      if (debug) {
+	printf("contblock sweep phase\n");
+	fflush(stdout);
+	tm = runtime();
+      }
+      contblock_sweep_phase();
+      if (debug)
+	printf("contblock sweep ended (%d)\n", runtime() - tm);
+    }
+
+    if (debug) {
+      for (i = 0, j = 0;  i < (int)t_end;  i++) {
+	if (tm_table[i].tm_type == (enum type)i) {
+	  printf("%13s: %8d used %8d free %4d/%d pages\n",
+		 tm_table[i].tm_name,
+		 tm_table[i].tm_nused,
+		 tm_table[i].tm_nfree,
+		 tm_table[i].tm_npage,
+		 tm_table[i].tm_maxpage);
+	  j += tm_table[i].tm_npage;
+	} else
+	  printf("%13s: linked to %s\n",
+		 tm_table[i].tm_name,
+		 tm_table[(int)tm_table[i].tm_type].tm_name);
+      }
+      printf("contblock: %d blocks %d pages\n", ncb, ncbpage);
+      printf("hole: %d pages\n", holepage);
+      printf("GC ended\n");
+      fflush(stdout);
+    }
+
+    interrupt_enable = TRUE;
+
+    if (GC_exit_hook != NULL)
+      (*GC_exit_hook)();
+
+#ifdef THREADS
+
+    /* 
+     * Back in the right stack
+     */
+
+    if (stack_switched) {
+      if (debug) {
+	printf("*STACK BACK*\n");
+	fflush (stdout);
+      }
+
+      stack_switched = FALSE;
+
+      end_critical_section();	/* we get here from the GC call in scheduler */
+	  
+      clwp = old_clwp;
+      Values = clwp->lwp_Values;
+      siglongjmp(old_env, 2);
+    }
+  }
+#endif THREADS
+
+  gc_time += (gc_start = runtime() - gc_start);
+
+  if (SYM_VAL(siVgc_verbose) != Cnil) {
+    /* Don't use fprintf since on Linux it calls malloc() */
+    printf(". finished in %.2f\"]", gc_start/60.0);
+    fflush(stdout);
+  }
+
+#ifdef unix
+  if (interrupt_flag) sigint();
+#endif unix
+
+#ifdef THREADS
+  end_critical_section();
+#endif THREADS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * mark_contblock --
+ *     sets the mark bit for words from address p to address p+s.
+ *     Both p and p+s are rounded to word boundaries.
+ *
+ * Results:
+ *	none.
+ *
+ * Side effects:
+ *	mark_table
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+_mark_contblock(void *x, size_t s)
+{
+	register char *p = x, *q;
+	register ptrdiff_t pg = page(p);
+
+	if (pg < 0 || (enum type)type_map[pg] != t_contiguous)
+		return;
+#if 1
+	q = p + s;
+	p = (char *)((int)p&~3);
+	q = (char *)(((int)q+3)&~3);
+	for (;  p < q;  p+= 4)
+	  set_mark_bit(p);
+#elif 0
+	{
+	int bit_start = ((int)p - DATA_START) >> 2;
+	int bit_end = ((int)p + s + 3 - DATA_START) >> 2;
+	int *w = &mark_table[bit_start >> 5];
+	int b = bit_start & (32 - 1);
+	int mask = ~0 << b;
+	int bits = b + bit_end - bit_start;
+	while (bits >= 32) {
+	  *w |= mask;
+	  w++;
+	  bits -= 32;
+	  mask = ~0;
+	}
+	mask &= ~(~0 << bits);
+	*w |= mask;
+	}
+#else
+	{
+	int bit_start = ((int)p - DATA_START) >> 2;
+	int bits = ((int)p + s + 3 - DATA_START) >> 2 - bit_start;
+	int mask = 1 << bit_start & (32 - 1);
+	int *w = &mark_table[bit_start >> 5];
+	while (bits) {
+	  *w |= mask;
+	  mask <<= 1;
+	  if (!mask) {
+	    mask = 1;
+	    w++;
+	  }
+	}
+	}
+#endif
+}
+
+/*----------------------------------------------------------------------
+ * Utilities
+ *----------------------------------------------------------------------
+ */
+
+@(defun si::room_report ()
+	int i;
+	cl_object *tl;
+@
+	NValues = 8;
+	VALUES(0) = MAKE_FIXNUM(real_maxpage);
+	VALUES(1) = MAKE_FIXNUM(available_pages());
+	VALUES(2) = MAKE_FIXNUM(ncbpage);
+	VALUES(3) = MAKE_FIXNUM(maxcbpage);
+	VALUES(4) = MAKE_FIXNUM(ncb);
+	VALUES(5) = MAKE_FIXNUM(cbgccount);
+	VALUES(6) = MAKE_FIXNUM(holepage);
+	VALUES(7) = Cnil;
+	tl = &VALUES(7);
+	for (i = 0;  i < (int)t_end;  i++) {
+	  if (tm_table[i].tm_type == (enum type)i) {
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_nused), Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_nfree), Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_npage), Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_maxpage), Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_gccount), Cnil));
+	  } else {
+	    tl = &CDR(*tl = CONS(Cnil, Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_type), Cnil));
+	    tl = &CDR(*tl = CONS(Cnil, Cnil));
+	    tl = &CDR(*tl = CONS(Cnil, Cnil));
+	    tl = &CDR(*tl = CONS(Cnil, Cnil));
+	  }
+	}
+	return VALUES(0);
+@)
+
+@(defun si::reset_gc_count ()
+	int i;
+@
+	cbgccount = 0;
+	for (i = 0;  i < (int)t_end;  i++)
+		tm_table[i].tm_gccount = 0;
+	@(return)
+@)
+
+@(defun si::gc_time ()
+@
+	@(return MAKE_FIXNUM(gc_time))
+@)
+
+void
+init_GC(void)
+{
+	register_root(&siVgc_verbose);
+	register_root(&siVgc_message);
+	siVgc_verbose = make_si_special("*GC-VERBOSE*", Cnil);
+	siVgc_message = make_si_special("*GC-MESSAGE*", Cnil);
+	GC_enable();
+	gc_time = 0;
+}
diff --git a/src/c/gbc.d b/src/c/gbc.d
new file mode 100644
index 000000000..5302fec32
--- /dev/null
+++ b/src/c/gbc.d
@@ -0,0 +1,1017 @@
+/*
+    gbc.c -- Garbage collector.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi and William F. Schelter.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "page.h"
+
+/******************************* EXPORTS ******************************/
+
+bool GC_enable;
+int gc_time;			/* Beppe */
+
+/******************************* ------- ******************************/
+
+/*
+   mark_table[m]:i represents word w = 128*m + 4*i, where m = addr-DATA_START.
+   Therefore m = w >> 7, i = (w / 4) % 32 = (w >> 2) & 0x1f.
+*/
+
+static int	*mark_table;
+
+#define MTbit(x)	(((((int)(char*)x) >> 2) & 0x1f))
+#define MTword(x)	mark_table[((int)(char*)x - DATA_START) >> 7]
+#if 1
+#define get_mark_bit(x) (MTword(x) >> MTbit(x) & 1)
+#define set_mark_bit(x) (MTword(x) |= (1 << MTbit(x)))
+#define clear_mark_bit(x) (MTword(x) ~= (~1 << MTbit(x)))
+#else /* !__GNUC__ */
+static void inline
+set_mark_bit(int *x) {
+	int w = (int)x;
+	int m = (w - DATA_START) >> 7;
+	int i = (w >> 2) & 0x1f;
+	mark_table[m] |= (1 << i);
+}
+static int inline
+get_mark_bit(int *x) {
+	int w = (int)x;
+	int m = (w - DATA_START) >> 7;
+	int i = (w >> 2) & 0x1f;
+	return (mark_table[m] >> i) & 1;
+}
+#endif /* __GNUC__ */
+
+
+#define	inheap(pp)	((unsigned long)(pp) < (unsigned long)heap_end)
+#define VALID_DATA_ADDRESS(pp) \
+  !IMMEDIATE(pp) && (cl_index)DATA_START <= (cl_index)(pp) && (cl_index)(pp) < (cl_index)heap_end
+
+cl_object siVgc_verbose;
+cl_object siVgc_message;
+
+static bool	debug = FALSE;
+static int	maxpage;
+
+#define	GC_ROOT_MAX		200
+static cl_object	*gc_root[GC_ROOT_MAX];
+static int	gc_roots;
+
+static bool	collect_blocks;
+
+/*
+   We must register location, since value may be reassigned (e.g. malloc_list)
+ */
+
+static void _mark_object (cl_object x);
+static void _mark_contblock (void *p, size_t s);
+extern void sigint (void);
+
+void
+register_root(cl_object *p)
+{
+	if (gc_roots >= GC_ROOT_MAX)
+		error("too many roots");
+	gc_root[gc_roots++] = p;
+}
+
+@(defun gc (area)
+@
+	if (!GC_enabled())
+		error("GC is not enabled");
+	if (Null(area))
+		gc(t_cons);
+	else
+		gc(t_contiguous);
+	@(return)
+@)
+
+/*----------------------------------------------------------------------
+ * Mark phase
+ *----------------------------------------------------------------------
+ */
+
+/* Whenever two arrays are linked together by displacement,
+   if one is live, the other will be made live */
+#define mark_displaced(ar) mark_object(ar)
+#define mark_contblock(x,s) {if (collect_blocks) _mark_contblock(x,s); }
+#if 1
+#define mark_object(x) if ((x != OBJNULL) && !IMMEDIATE(x)) _mark_object(x)
+#define mark_next(a) if ((a != OBJNULL) && !IMMEDIATE(a)) { x=(a); goto BEGIN; }
+#else
+#define mark_object(x) _mark_object(x)
+#define mark_next(a) x=(a); goto BEGIN
+#endif
+
+/* We make bitvectors multiple of sizeof(int) in size allocated
+ Assume 8 = number of bits in char */
+#define W_SIZE (8*sizeof(int))
+
+static void
+_mark_object(cl_object x)
+{
+	size_t i, j;
+	cl_object *p, y;
+	char *cp;
+
+	cs_check(x);
+BEGIN:
+#if 0
+	/* We cannot get here because mark_object() and mark_next() already check this */
+	if (IMMEDIATE(x)) return;	/* fixnum, character or locative */
+	if (x == OBJNULL)
+		return;
+#endif
+	if (x->d.m) {
+	  if (x->d.m == FREE)
+	    error("mark_object: pointer to free object.");
+	  else
+	    return;
+	}
+	x->d.m = TRUE;
+
+	switch (type_of(x)) {
+
+	case t_bignum:
+		if (collect_blocks) {
+		  /* GMP may set num.alloc before actually allocating anything.
+		     With these checks we make sure we do not move anything
+		     we don't have to. Besides, we use big_dim as the size
+		     of the object, because big_size might even be smaller.
+		  */
+		  char *limbs = (char *)x->big.big_limbs;
+		  size_t size = x->big.big_dim * sizeof(mp_limb_t);
+		  if (size) mark_contblock(limbs, size);
+		}
+		break;
+
+	case t_ratio:
+		mark_object(x->ratio.num);
+		mark_next(x->ratio.den);
+		break;
+
+	case t_shortfloat:
+	case t_longfloat:
+		break;
+
+	case t_complex:
+		mark_object(x->complex.imag);
+		mark_next(x->complex.real);
+		break;
+
+	case t_character:
+		break;
+
+	case t_symbol:
+		mark_object(x->symbol.name);
+		mark_object(x->symbol.plist);
+		mark_object(SYM_FUN(x));
+		mark_next(SYM_VAL(x));
+		break;
+
+	case t_package:
+		mark_object(x->pack.name);
+		mark_object(x->pack.nicknames);
+		mark_object(x->pack.shadowings);
+		mark_object(x->pack.uses);
+		mark_object(x->pack.usedby);
+		mark_object(x->pack.internal);
+		mark_next(x->pack.external);
+		break;
+
+	case t_cons:
+		mark_object(CAR(x));
+		mark_next(CDR(x));
+		break;
+
+	case t_hashtable:
+		mark_object(x->hash.rehash_size);
+		mark_object(x->hash.threshold);
+		if (x->hash.data == NULL)
+			break;
+		for (i = 0, j = x->hash.size;  i < j;  i++) {
+			mark_object(x->hash.data[i].key);
+			mark_object(x->hash.data[i].value);
+		}
+		mark_contblock(x->hash.data, j * sizeof(struct hashtable_entry));
+		break;
+
+	case t_array:
+		mark_contblock(x->array.dims, sizeof(x->array.dims[0])*x->array.rank);
+	case t_vector:
+		if ((y = x->array.displaced) != Cnil)
+			mark_displaced(y);
+		cp = (char *)x->array.self.t;
+		if (cp == NULL)
+			break;
+		switch ((enum aelttype)x->array.elttype) {
+		case aet_object:
+			if (x->array.displaced == Cnil || CAR(x->array.displaced) == Cnil) {
+				cl_object *p = x->array.self.t;
+				cl_index i;
+				if (x->array.t == t_vector && x->vector.hasfillp)
+					i = x->vector.fillp;
+				else
+					i = x->vector.dim;
+				while (i-- > 0)
+					mark_object(p[i]);
+			}
+			j = sizeof(cl_object)*x->array.dim;
+			break;
+		case aet_ch:
+			j = x->array.dim;
+			break;
+		case aet_bit:
+			j = sizeof(int) * ((x->vector.offset + x->vector.dim + W_SIZE -1)/W_SIZE);
+			break;
+		case aet_fix:
+			j = x->array.dim * sizeof(cl_fixnum);
+			break;
+		case aet_sf:
+			j = x->array.dim * sizeof(float);
+			break;
+		case aet_lf:
+			j = x->array.dim * sizeof(double);
+			break;
+		default:
+			error("Allocation botch: unknown array element type");
+		}
+		goto COPY_ARRAY;
+	case t_string:
+		if ((y = x->string.displaced) != Cnil)
+			mark_displaced(y);
+		cp = x->string.self;
+		if (cp == NULL)
+			break;
+		j = x->string.dim;
+	COPY_ARRAY:
+		mark_contblock(cp, j);
+		break;
+	case t_bitvector:
+		if ((y = x->vector.displaced) != Cnil)
+			mark_displaced(y);
+		cp = x->vector.self.bit;
+		if (cp == NULL)
+			break;
+		j= sizeof(int) * ((x->vector.offset + x->vector.dim + W_SIZE -1)/W_SIZE);
+		goto COPY_ARRAY;
+
+#ifndef CLOS
+	case t_structure:
+		mark_object(x->str.name);
+		p = x->str.self;
+		if (p == NULL)
+			break;
+		for (i = 0, j = x->str.length;  i < j;  i++)
+			mark_object(p[i]);
+		mark_contblock(p, j*sizeof(cl_object));
+		break;
+#endif CLOS
+
+	case t_stream:
+		switch ((enum smmode)x->stream.mode) {
+		case smm_closed:
+			/* Rest of fields are NULL */
+			mark_next(x->stream.object1);
+			break;
+		case smm_input:
+		case smm_output:
+		case smm_io:
+		case smm_probe:
+			mark_object(x->stream.object0);
+			mark_object(x->stream.object1);
+			mark_contblock(x->stream.buffer, BUFSIZ);
+			break;
+
+		case smm_synonym:
+			mark_next(x->stream.object0);
+			break;
+
+		case smm_broadcast:
+		case smm_concatenated:
+			mark_next(x->stream.object0);
+			break;
+
+		case smm_two_way:
+		case smm_echo:
+			mark_object(x->stream.object0);
+			mark_next(x->stream.object1);
+			break;
+
+		case smm_string_input:
+		case smm_string_output:
+			mark_next(x->stream.object0);
+			break;
+
+		default:
+			error("mark stream botch");
+		}
+		break;
+
+	case t_random:
+		break;
+
+	case t_readtable:
+		if (x->readtable.table == NULL)
+			break;
+		mark_contblock((char *)(x->readtable.table), RTABSIZE*sizeof(struct readtable_entry));
+		for (i = 0;  i < RTABSIZE;  i++) {
+			cl_object *p = x->readtable.table[i].dispatch_table;
+			mark_object(x->readtable.table[i].macro);
+			if (p != NULL) {
+			  mark_contblock(p, RTABSIZE*sizeof(cl_object));
+			  for (j = 0;  j < RTABSIZE;  j++)
+			    mark_object(p[j]);
+			}
+		}
+		break;
+
+	case t_pathname:
+		mark_object(x->pathname.host);
+		mark_object(x->pathname.device);
+		mark_object(x->pathname.directory);
+		mark_object(x->pathname.name);
+		mark_object(x->pathname.type);
+		mark_object(x->pathname.version);
+		break;
+
+	case t_bytecodes: {
+		cl_index i, size;
+		size = x->bytecodes.size;
+		mark_object(x->bytecodes.lex);
+		mark_contblock(x->bytecodes.data, size * sizeof(cl_object));
+		for (i=0; i<size; i++)
+			mark_object(x->bytecodes.data[i]);
+		break;
+	}
+	case t_cfun:
+		mark_object(x->cfun.block);
+		mark_object(x->cfun.name);
+		break;
+
+	case t_cclosure:
+		mark_object(x->cfun.block);
+		mark_object(x->cclosure.env);
+		break;
+
+#ifdef THREADS
+	case t_cont:
+		mark_next(x->cn.cn_thread);
+		break;
+
+	case t_thread:
+/* Already marked by malloc
+ 		mark_contblock(x->thread.data, x->thread.size);
+ */
+		mark_next(x->thread.entry);
+		break;
+#endif THREADS
+#ifdef CLOS
+	case t_instance:
+		mark_object(x->instance.class);
+		p = x->instance.slots;
+		if (p == NULL)
+			break;
+		for (i = 0, j = x->instance.length;  i < j;  i++)
+			mark_object(p[i]);
+		mark_contblock(p, j*sizeof(cl_object));
+		break;
+
+	case t_gfun:
+		mark_object(x->gfun.name);
+		mark_object(x->gfun.method_hash);
+		mark_object(x->gfun.instance);
+		p = x->gfun.specializers;
+		if (p == NULL)
+			break;
+		for (i = 0, j = x->gfun.arg_no;  i < j;  i++)
+			mark_object(p[i]);
+		mark_contblock(p, j*sizeof(cl_object));
+		break;
+#endif CLOS
+	case t_codeblock:
+		mark_object(x->cblock.name);
+		mark_contblock(x->cblock.start, x->cblock.size);
+		if (x->cblock.data) {
+			cl_index i = x->cblock.data_size;
+			cl_object *p = x->cblock.data;
+			while (i--)
+				mark_object(p[i]);
+		}
+		break;
+	default:
+		if (debug)
+			printf("\ttype = %d\n", type_of(x));
+		error("mark botch");
+	}
+}
+
+static void
+mark_stack_conservative(int *top, int *bottom)
+{
+  int p, m;
+  cl_object x;
+  struct typemanager *tm;
+  register int *j;
+
+  if (debug) { printf("Traversing C stack .."); fflush(stdout); }
+
+  /* On machines which align local pointers on multiple of 2 rather
+     than 4 we need to mark twice
+
+  if (offset) mark_stack_conservative(bottom, ((char *) top) + offset, 0);
+     */
+  for (j = top ; j >= bottom ; j--) {
+    /* improved Beppe: */
+    if (VALID_DATA_ADDRESS(*j) && type_map[p = page(*j)] < (char)t_end) {
+      tm = tm_of((enum type)type_map[p]);
+      x = (cl_object)(*j - (*j - (int)pagetochar(p)) % tm->tm_size);
+      m = x->d.m;
+      if (m != FREE && m != TRUE) {
+	if (m) {
+	  fprintf(stderr,
+		  "** bad value %d of d.m in gc page %d skipping mark **",
+		  m, p); fflush(stderr);
+	} else
+	  mark_object(x);
+      }
+    }}
+  if (debug) {printf(". done.\n"); fflush(stdout); }
+}
+
+static void
+mark_phase(void)
+{
+	register int i;
+	register struct package *pp;
+	register bds_ptr bdp;
+	register frame_ptr frp;
+	register ihs_ptr ihsp;
+
+	mark_object(Cnil);
+	mark_object(Ct);
+
+#ifdef THREADS
+	{
+	  pd *pdp;
+	  lpd *old_clwp = clwp;
+
+	  for (pdp = running_head; pdp != (pd *)NULL; pdp = pdp->pd_next) {
+
+	    clwp = pdp->pd_lpd;
+#endif THREADS
+	    
+	    for (i=0; i<NValues; i++)
+	      mark_object(VALUES(i));
+
+	    mark_contblock(frs_org, frs_size * sizeof(*frs_org));
+	    mark_contblock(bds_org, frs_size * sizeof(*bds_org));
+	    mark_contblock(ihs_org, frs_size * sizeof(*ihs_org));
+
+	    for (bdp = bds_org;  bdp <= bds_top;  bdp++) {
+	      mark_object(bdp->bds_sym);
+	      mark_object(bdp->bds_val);
+	    }
+	    
+	    for (frp = frs_org;  frp <= frs_top;  frp++) {
+	      mark_object(frp->frs_val);
+	      mark_object(frp->frs_lex);
+	    }
+	    
+	    for (ihsp = ihs_org;  ihsp <= ihs_top;  ihsp++) {
+	      mark_object(ihsp->ihs_function);
+	      mark_object(ihsp->ihs_base);
+	    }
+
+	    mark_object(lex_env);
+
+#ifdef THREADS	      
+	    /* added to mark newly allocated objects */
+	    mark_object(clwp->lwp_alloc_temporary);
+	    mark_object(clwp->lwp_fmt_temporary_stream);
+	    mark_object(clwp->lwp_PRINTstream);
+	    mark_object(clwp->lwp_PRINTcase);
+	    mark_object(clwp->lwp_READtable);
+	    mark_object(clwp->lwp_delimiting_char);
+	    mark_object(clwp->lwp_gensym_prefix);
+	    mark_object(clwp->lwp_gentemp_prefix);
+	    mark_object(clwp->lwp_token);
+
+	    /* (current-thread) can return it at any time
+	     */
+	    mark_object(clwp->lwp_thread);
+#endif THREADS	      
+	    
+	    /* now collect from the c-stack of the thread ... */
+	    
+	    { int *where;
+	      volatile jmp_buf buf;
+
+	      /* ensure flushing of register caches */
+	      if (ecls_setjmp(buf) == 0) ecls_longjmp(buf, 1);
+
+#ifdef THREADS
+	      if (clwp != old_clwp) /* is not the executing stack */
+# ifdef __linux
+		where = (int *)pdp->pd_env[0].__jmpbuf[0].__sp;
+# else
+		where = (int *)pdp->pd_env[JB_SP];
+# endif
+	      else
+#endif THREADS
+		where = (int *)&where ;
+	      
+	      /* If the locals of type object in a C function could be
+		 aligned other than on multiples of sizeof (char *)
+		 we would have to mark twice */
+	      
+	      if (where > cs_org)
+		mark_stack_conservative(where, cs_org);
+	      else
+		mark_stack_conservative(cs_org, where);
+	    }
+#ifdef THREADS
+	  }
+	  clwp = old_clwp;
+	}
+#endif THREADS
+
+	/* mark roots */
+	for (i = 0; i < gc_roots;  i++)
+		mark_object(*gc_root[i]);
+
+	/* mark registered symbols & keywords */
+	{
+	const struct keyword_info *k;
+	const struct symbol_info *s;
+	for (k = all_keywords; k->loc != NULL; k++)
+		mark_object(*(k->loc));
+	for (s = all_symbols; s->loc != NULL; s++)
+		mark_object(*(s->loc));
+	}
+
+	if (debug) {
+		printf("symbol navigation\n");
+		fflush(stdout);
+	}
+}
+
+static void
+sweep_phase(void)
+{
+	register int i, j, k;
+	register cl_object x;
+	register char *p;
+	register struct typemanager *tm;
+	register cl_object f;
+
+	Cnil->symbol.m = FALSE;
+	Ct->symbol.m = FALSE;
+
+	if (debug)
+		printf("type map\n");
+
+	for (i = 0;  i < maxpage;  i++) {
+		if (type_map[i] == (int)t_contiguous) {
+			if (debug) {
+				printf("-");
+				continue;
+			}
+		}
+		if (type_map[i] >= (int)t_end)
+			continue;
+
+		tm = tm_of((enum type)type_map[i]);
+
+	/*
+		general sweeper
+	*/
+
+		if (debug)
+			printf("%c", tm->tm_name[0]);
+
+		p = pagetochar(i);
+		f = tm->tm_free;
+		k = 0;
+		for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) {
+			x = (cl_object)p;
+			if (x->d.m == FREE)
+				continue;
+			else if (x->d.m) {
+				x->d.m = FALSE;
+				continue;
+			}
+			((struct freelist *)x)->f_link = f;
+			x->d.m = FREE;
+			f = x;
+			k++;
+		}
+		tm->tm_free = f;
+		tm->tm_nfree += k;
+		tm->tm_nused -= k;
+	}
+
+	if (debug) {
+		putchar('\n');
+		fflush(stdout);
+	}
+}
+
+static void
+contblock_sweep_phase(void)
+{
+	register int i, j;
+	register char *s, *e, *p, *q;
+	register struct contblock *cbp;
+
+	cb_pointer = NULL;
+	ncb = 0;
+	for (i = 0;  i < maxpage;) {
+		if (type_map[i] != (int)t_contiguous) {
+			i++;
+			continue;
+		}
+		for (j = i+1;
+		     j < maxpage && type_map[j] == (int)t_contiguous;
+		     j++)
+			;	
+		s = pagetochar(i);
+		e = pagetochar(j);
+		for (p = s;  p < e;) {
+			if (get_mark_bit((int *)p)) {
+				p += 4;
+				continue;
+			}
+			q = p + 4;
+			while (q < e && !get_mark_bit((int *)q))
+				q += 4;
+			dealloc(p, q - p);
+			p = q + 4;
+		}
+		i = j + 1;
+	}
+
+	if (debug) {
+		for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)
+			printf("0x%p %d\n", cbp, cbp->cb_size);
+		fflush(stdout);
+	}
+}
+
+cl_object (*GC_enter_hook)() = NULL;
+cl_object (*GC_exit_hook)() = NULL;
+
+
+#ifdef THREADS
+/* 
+ * We execute the GC routine in the main stack.
+ * The idea is to switch over the main stack that is stopped in the intha
+ * and to call the GC from there on garbage_parameter. Then you can switch 
+ * back after.
+ * In addition the interrupt is disabled.
+ */
+static int i, j;
+static sigjmp_buf old_env;
+static int val;
+static lpd *old_clwp;
+static enum type t;
+static bool stack_switched = FALSE;
+
+static enum type garbage_parameter;
+
+void
+gc(enum type new_name)
+{
+	int tm;
+	int gc_start = runtime();
+
+	start_critical_section();
+	t = new_name;
+        garbage_parameter = new_name;
+#else
+
+void
+gc(enum type t)
+{
+  int i, j;
+  int tm;
+  int gc_start = runtime();
+#endif THREADS
+
+  if (!GC_enabled())
+    return;
+
+  if (SYM_VAL(siVgc_verbose) != Cnil) {
+    printf("\n[GC ..");
+    /* To use this should add entries in tm_table for reloc and contig.
+       fprintf(stdout, "\n[GC for %d %s pages ..",
+       tm_of(t)->tm_npage,
+       tm_table[(int)t].tm_name + 1); */
+    fflush(stdout);
+  }
+
+  debug = symbol_value(siVgc_message) != Cnil;
+
+#ifdef THREADS
+  if (clwp != &main_lpd)  {
+    if (debug) {
+      printf("*STACK SWITCH*\n");
+      fflush (stdout);
+    }
+
+    stack_switched = TRUE;
+    val = sigsetjmp(old_env, 1);
+    if (val == 0) {
+      /* informations used by the garbage collector need to be updated */
+# ifdef __linux
+      running_head->pd_env[0].__jmpbuf[0].__sp = old_env[0].__jmpbuf[0].__sp;
+# else
+      running_head->pd_env[JB_SP] = old_env[JB_SP];
+# endif
+      old_clwp = clwp;
+      Values = main_lpd.lwp_Values;
+      clwp = &main_lpd;
+      siglongjmp(main_pd.pd_env, 2); /* new line */
+    }
+  }
+
+  else val = 1;
+
+  if (val == 1) {
+
+#endif THREADS
+
+    if (GC_enter_hook != NULL)
+      (*GC_enter_hook)(0);
+
+    interrupt_enable = FALSE;
+
+    collect_blocks = t > t_end;
+    if (collect_blocks)
+      cbgccount++;
+    else
+      tm_table[(int)t].tm_gccount++;
+
+    if (debug) {
+      if (collect_blocks)
+	printf("GC entered for collecting blocks\n");
+      else
+	printf("GC entered for collecting %s\n", tm_table[(int)t].tm_name);
+      fflush(stdout);
+    }
+
+    maxpage = page(heap_end);
+
+    if (collect_blocks) {
+      /*
+	1 page = 512 word
+	512 bit = 16 word
+      */
+      int mark_table_size = maxpage * (LISP_PAGESIZE / 32);
+      extern void resize_hole(size_t);
+
+      if (holepage < mark_table_size*sizeof(int)/LISP_PAGESIZE + 1)
+	new_holepage = mark_table_size*sizeof(int)/LISP_PAGESIZE + 1;
+      if (new_holepage < HOLEPAGE)
+	new_holepage = HOLEPAGE;
+      resize_hole(new_holepage);
+
+      mark_table = (int*)heap_end;
+      for (i = 0;  i < mark_table_size; i++)
+	mark_table[i] = 0;
+    }
+
+    if (debug) {
+      printf("mark phase\n");
+      fflush(stdout);
+      tm = runtime();
+    }
+    mark_phase();
+    if (debug) {
+      printf("mark ended (%d)\n", runtime() - tm);
+      printf("sweep phase\n");
+      fflush(stdout);
+      tm = runtime();
+    }
+    sweep_phase();
+    if (debug) {
+      printf("sweep ended (%d)\n", runtime() - tm);
+      fflush(stdout);
+    }
+
+    if (t == t_contiguous) {
+      if (debug) {
+	printf("contblock sweep phase\n");
+	fflush(stdout);
+	tm = runtime();
+      }
+      contblock_sweep_phase();
+      if (debug)
+	printf("contblock sweep ended (%d)\n", runtime() - tm);
+    }
+
+    if (debug) {
+      for (i = 0, j = 0;  i < (int)t_end;  i++) {
+	if (tm_table[i].tm_type == (enum type)i) {
+	  printf("%13s: %8d used %8d free %4d/%d pages\n",
+		 tm_table[i].tm_name,
+		 tm_table[i].tm_nused,
+		 tm_table[i].tm_nfree,
+		 tm_table[i].tm_npage,
+		 tm_table[i].tm_maxpage);
+	  j += tm_table[i].tm_npage;
+	} else
+	  printf("%13s: linked to %s\n",
+		 tm_table[i].tm_name,
+		 tm_table[(int)tm_table[i].tm_type].tm_name);
+      }
+      printf("contblock: %d blocks %d pages\n", ncb, ncbpage);
+      printf("hole: %d pages\n", holepage);
+      printf("GC ended\n");
+      fflush(stdout);
+    }
+
+    interrupt_enable = TRUE;
+
+    if (GC_exit_hook != NULL)
+      (*GC_exit_hook)();
+
+#ifdef THREADS
+
+    /* 
+     * Back in the right stack
+     */
+
+    if (stack_switched) {
+      if (debug) {
+	printf("*STACK BACK*\n");
+	fflush (stdout);
+      }
+
+      stack_switched = FALSE;
+
+      end_critical_section();	/* we get here from the GC call in scheduler */
+	  
+      clwp = old_clwp;
+      Values = clwp->lwp_Values;
+      siglongjmp(old_env, 2);
+    }
+  }
+#endif THREADS
+
+  gc_time += (gc_start = runtime() - gc_start);
+
+  if (SYM_VAL(siVgc_verbose) != Cnil) {
+    /* Don't use fprintf since on Linux it calls malloc() */
+    printf(". finished in %.2f\"]", gc_start/60.0);
+    fflush(stdout);
+  }
+
+#ifdef unix
+  if (interrupt_flag) sigint();
+#endif unix
+
+#ifdef THREADS
+  end_critical_section();
+#endif THREADS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * mark_contblock --
+ *     sets the mark bit for words from address p to address p+s.
+ *     Both p and p+s are rounded to word boundaries.
+ *
+ * Results:
+ *	none.
+ *
+ * Side effects:
+ *	mark_table
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+_mark_contblock(void *x, size_t s)
+{
+	register char *p = x, *q;
+	register ptrdiff_t pg = page(p);
+
+	if (pg < 0 || (enum type)type_map[pg] != t_contiguous)
+		return;
+#if 1
+	q = p + s;
+	p = (char *)((int)p&~3);
+	q = (char *)(((int)q+3)&~3);
+	for (;  p < q;  p+= 4)
+	  set_mark_bit(p);
+#elif 0
+	{
+	int bit_start = ((int)p - DATA_START) >> 2;
+	int bit_end = ((int)p + s + 3 - DATA_START) >> 2;
+	int *w = &mark_table[bit_start >> 5];
+	int b = bit_start & (32 - 1);
+	int mask = ~0 << b;
+	int bits = b + bit_end - bit_start;
+	while (bits >= 32) {
+	  *w |= mask;
+	  w++;
+	  bits -= 32;
+	  mask = ~0;
+	}
+	mask &= ~(~0 << bits);
+	*w |= mask;
+	}
+#else
+	{
+	int bit_start = ((int)p - DATA_START) >> 2;
+	int bits = ((int)p + s + 3 - DATA_START) >> 2 - bit_start;
+	int mask = 1 << bit_start & (32 - 1);
+	int *w = &mark_table[bit_start >> 5];
+	while (bits) {
+	  *w |= mask;
+	  mask <<= 1;
+	  if (!mask) {
+	    mask = 1;
+	    w++;
+	  }
+	}
+	}
+#endif
+}
+
+/*----------------------------------------------------------------------
+ * Utilities
+ *----------------------------------------------------------------------
+ */
+
+@(defun si::room_report ()
+	int i;
+	cl_object *tl;
+@
+	NValues = 8;
+	VALUES(0) = MAKE_FIXNUM(real_maxpage);
+	VALUES(1) = MAKE_FIXNUM(available_pages());
+	VALUES(2) = MAKE_FIXNUM(ncbpage);
+	VALUES(3) = MAKE_FIXNUM(maxcbpage);
+	VALUES(4) = MAKE_FIXNUM(ncb);
+	VALUES(5) = MAKE_FIXNUM(cbgccount);
+	VALUES(6) = MAKE_FIXNUM(holepage);
+	VALUES(7) = Cnil;
+	tl = &VALUES(7);
+	for (i = 0;  i < (int)t_end;  i++) {
+	  if (tm_table[i].tm_type == (enum type)i) {
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_nused), Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_nfree), Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_npage), Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_maxpage), Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_gccount), Cnil));
+	  } else {
+	    tl = &CDR(*tl = CONS(Cnil, Cnil));
+	    tl = &CDR(*tl = CONS(MAKE_FIXNUM(tm_table[i].tm_type), Cnil));
+	    tl = &CDR(*tl = CONS(Cnil, Cnil));
+	    tl = &CDR(*tl = CONS(Cnil, Cnil));
+	    tl = &CDR(*tl = CONS(Cnil, Cnil));
+	  }
+	}
+	return VALUES(0);
+@)
+
+@(defun si::reset_gc_count ()
+	int i;
+@
+	cbgccount = 0;
+	for (i = 0;  i < (int)t_end;  i++)
+		tm_table[i].tm_gccount = 0;
+	@(return)
+@)
+
+@(defun si::gc_time ()
+@
+	@(return MAKE_FIXNUM(gc_time))
+@)
+
+void
+init_GC(void)
+{
+	register_root(&siVgc_verbose);
+	register_root(&siVgc_message);
+	siVgc_verbose = make_si_special("*GC-VERBOSE*", Cnil);
+	siVgc_message = make_si_special("*GC-MESSAGE*", Cnil);
+	GC_enable();
+	gc_time = 0;
+}
diff --git a/src/c/gfun.d b/src/c/gfun.d
new file mode 100644
index 000000000..9fb0755cc
--- /dev/null
+++ b/src/c/gfun.d
@@ -0,0 +1,262 @@
+/*
+    gfun.c -- Dispatch for generic functions.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+cl_object siScompute_applicable_methods;
+cl_object siScompute_effective_method;
+cl_object siSgeneric_function_method_combination;
+cl_object siSgeneric_function_method_combination_args;
+
+@(defun si::allocate_gfun (name arg_no ht)
+	cl_object x;
+	int n, i;
+@
+	if (type_of(ht) != t_hashtable)
+		FEwrong_type_argument(Shash_table, ht);
+
+	x = alloc_object(t_gfun);
+	x->gfun.specializers = NULL; /* for GC sake */
+	x->gfun.name = name;
+	x->gfun.method_hash = ht;
+	n = fixnnint(arg_no);
+	x->gfun.arg_no = n;
+	x->gfun.specializers = alloc_align(sizeof(cl_object)*n, sizeof(cl_object));
+	for (i = 0;  i < n;  i++)
+		x->gfun.specializers[i] = OBJNULL;
+	x->gfun.instance = Cnil;
+	@(return x)
+@)
+
+@(defun si::gfun_name (x)
+@
+	if (type_of(x) != t_gfun)
+		FEwrong_type_argument(Sdispatch_function, x);
+	@(return x->gfun.name)
+@)
+
+@(defun si::gfun_name_set (x name)
+@
+	if (type_of(x) != t_gfun)
+		FEwrong_type_argument(Sdispatch_function, x);
+	x->gfun.name = name;
+	@(return x)
+@)
+
+@(defun si::gfun_method_ht (x)
+@
+	if (type_of(x) != t_gfun)
+		FEwrong_type_argument(Sdispatch_function, x);
+	@(return x->gfun.method_hash)
+@)
+
+@(defun si::gfun_method_ht_set (x y)
+@
+	if (type_of(x) != t_gfun)
+		FEwrong_type_argument(Sdispatch_function, x);
+	if (type_of(y) != t_hashtable)
+		FEwrong_type_argument(Shash_table, y);
+	x->gfun.method_hash = y;
+	@(return x)
+@)
+
+@(defun si::gfun_spec_how_ref (x y)
+	int i;
+@
+	if (type_of(x) != t_gfun)
+		FEwrong_type_argument(Sdispatch_function, x);
+	if (!FIXNUMP(y) ||
+	    (i = fix(y)) < 0 || i >= x->gfun.arg_no)
+		FEerror("~S is an illegal spec_how index.", 1, y);
+	@(return x->gfun.specializers[i])
+@)
+
+@(defun si::gfun_spec_how_set (x y spec)
+	int i;
+@
+	if (type_of(x) != t_gfun)
+		FEwrong_type_argument(Sdispatch_function, x);
+	if (!FIXNUMP(y) || (i = fix(y)) >= x->gfun.arg_no)
+		FEerror("~S is an illegal spec_how index.", 1, y);
+	x->gfun.specializers[i] = spec;
+	@(return spec)
+@)
+
+@(defun si::gfun_instance (x)
+@
+	if (type_of(x) != t_gfun)
+		FEwrong_type_argument(Sdispatch_function, x);
+	@(return x->gfun.instance)
+@)
+
+@(defun si::gfun_instance_set (x y)
+@
+	if (type_of(x) != t_gfun)
+		FEwrong_type_argument(Sdispatch_function, x);
+	if (type_of(y) != t_instance)
+		FEwrong_type_argument(Sinstance, y);
+	x->gfun.instance = y;
+	@(return x)
+@)
+
+@(defun si::gfunp (x)
+@
+	@(return ((type_of(x) == t_gfun)? Ct : Cnil))
+@)
+
+
+/*
+ * variation of gethash from hash.d, which takes an array of objects as key
+ * It also assumes that entries are never removed except by clrhash.
+ */
+
+static struct hashtable_entry *
+get_meth_hash(cl_object *keys, int argno, cl_object hashtable)
+{
+	int hsize;
+	struct hashtable_entry *e, *htable;
+	cl_object hkey, tlist;
+	register int i = 0;
+	int k, n; /* k added by chou */
+	bool b = 1;
+
+	hsize = hashtable->hash.size;
+	htable = hashtable->hash.data;
+	for (n = 0; n < argno; n++)
+	  i += (int)keys[n] / 4; /* instead of:
+				   i += hash_eql(keys[n]);
+				   i += hash_eql(Cnil);
+				 */
+	for (i %= hsize, k = 0; k < hsize;  i = (i + 1) % hsize, k++) {
+	  e = &htable[i];
+	  hkey = e->key;
+	  if (hkey == OBJNULL)
+	    return(e);
+	  for (n = 0, tlist = hkey; b && (n < argno);
+	       n++, tlist = CDR(tlist))
+	    b &= (keys[n] == CAR(tlist));
+	  if (b)
+	    return(&htable[i]);
+	}
+	internal_error("get_meth_hash");
+}
+
+@(defun si::method_ht_get (keylist table)
+	struct hashtable_entry *e;
+@
+	{  int i, argn = length(keylist);
+	   cl_object keys[argn];	/* __GNUC__ */
+
+	   for (i = 0; i < argn; i++, keylist = CDR(keylist))
+	     keys[i] = CAR(keylist);
+	   e = get_meth_hash(keys, argn, table);
+	}
+	@(return ((e->key == OBJNULL)? Cnil : e->value))
+@)
+
+static void
+set_meth_hash(cl_object *keys, int argno, cl_object hashtable, cl_object value)
+{
+	struct hashtable_entry *e;
+	cl_object keylist, *p;
+	
+	if (hashtable->hash.entries + 1 >= fix(hashtable->hash.threshold))
+		extend_hashtable(hashtable);
+	e = get_meth_hash(keys, argno, hashtable);
+	if (e->key == OBJNULL)
+		hashtable->hash.entries++;
+	keylist = Cnil;
+	for (p = keys + argno; p > keys; p--) keylist = CONS(p[-1], keylist);
+	e->key = keylist;
+	e->value = value;
+}
+
+cl_object
+gcall(int narg, cl_object fun, cl_object *args)
+{
+	cl_object func;
+
+	{ int i, spec_no;
+	  struct hashtable_entry *e;
+	  cl_object *spec_how = fun->gfun.specializers;
+	  cl_object argtype[narg]; /* __GNUC__ */
+
+	  if (narg < fun->gfun.arg_no)
+	    FEerror("Generic function ~S requires more than ~R argument~:p.",
+		    2, fun->gfun.name, MAKE_FIXNUM(narg));
+	  for (i = 0, spec_no = 0; i < fun->gfun.arg_no; i++, spec_how++) {
+	    if (*spec_how != Cnil)
+	      argtype[spec_no++] = (ATOM(*spec_how) ||
+				    !member_eq(args[i], *spec_how)) ?
+				      TYPE_OF(args[i]) :
+					args[i];
+	  }
+
+	  e = get_meth_hash(argtype, spec_no, fun->gfun.method_hash);
+
+	  if (e->key == OBJNULL)  { 
+	    /* method not cached */
+	    register cl_object gf = fun->gfun.instance;
+	    cl_object methods, meth_comb, meth_args, arglist = Cnil;
+
+	    i = narg;
+	    while (i-- > 0)
+	      arglist = CONS(args[i], arglist);
+	    methods = _funcall(3, siScompute_applicable_methods, gf, arglist);
+	    meth_comb = _funcall(2, siSgeneric_function_method_combination, gf);
+	    meth_args = _funcall(2, siSgeneric_function_method_combination_args,
+				 gf);
+	    func = _funcall(5, siScompute_effective_method, gf, methods,
+			    meth_comb, meth_args);
+	  
+	    /* update cache */
+	    set_meth_hash(argtype, spec_no, fun->gfun.method_hash, func);
+	  } else
+	    /* method is already cached */
+	    func = e->value;
+	}
+	switch (type_of(func)) {
+
+	case t_cfun:
+	  return APPLY(narg, *func->cfun.entry, args);
+
+	case t_cclosure:
+	  { int i; CSTACK(narg+1);
+	    CPUSH(func->cclosure.env);
+	    for (i = 0; i < narg; i++)
+	      CPUSH(*args++);
+#ifdef CCALL
+	    return CCALL(narg+1, func->cclosure.entry);
+#else
+	    return APPLY(narg+1, func->cclosure.entry, CSTACK_BOT);
+#endif CCALL
+	  }
+	case t_bytecodes:
+	  return apply(narg, func, args);
+
+	default:
+	  FEinvalid_function(func);
+	}
+}
+
+@(defun si::set_compiled_function_name (fn new_name)
+	enum cl_type t = type_of(fn);
+@
+	if (t == t_cfun)
+		@(return (fn->cfun.name = new_name))
+	if (t == t_bytecodes)
+		@(return (fn->bytecodes.data[0] = new_name))
+	FEerror("~S is not a compiled-function.", 1, fn);
+@)
diff --git a/src/c/hash.d b/src/c/hash.d
new file mode 100644
index 000000000..091d3f28c
--- /dev/null
+++ b/src/c/hash.d
@@ -0,0 +1,540 @@
+/*
+    hash.d  -- Hash tables.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+cl_object Seq;
+cl_object Seql;
+cl_object Sequal;
+
+cl_object Ksize;
+cl_object Krehash_size;
+cl_object Krehash_threshold;
+
+
+/*******************
+ * CRC-32 ROUTINES *
+ *******************/
+
+/*
+ * Lookup table for CRC-32 codes
+ */
+
+static const cl_hashkey crc_table[256] = {
+  0x00000000L, 0x77073096L, 0xee0e612cL, 0x990951baL, 0x076dc419L,
+  0x706af48fL, 0xe963a535L, 0x9e6495a3L, 0x0edb8832L, 0x79dcb8a4L,
+  0xe0d5e91eL, 0x97d2d988L, 0x09b64c2bL, 0x7eb17cbdL, 0xe7b82d07L,
+  0x90bf1d91L, 0x1db71064L, 0x6ab020f2L, 0xf3b97148L, 0x84be41deL,
+  0x1adad47dL, 0x6ddde4ebL, 0xf4d4b551L, 0x83d385c7L, 0x136c9856L,
+  0x646ba8c0L, 0xfd62f97aL, 0x8a65c9ecL, 0x14015c4fL, 0x63066cd9L,
+  0xfa0f3d63L, 0x8d080df5L, 0x3b6e20c8L, 0x4c69105eL, 0xd56041e4L,
+  0xa2677172L, 0x3c03e4d1L, 0x4b04d447L, 0xd20d85fdL, 0xa50ab56bL,
+  0x35b5a8faL, 0x42b2986cL, 0xdbbbc9d6L, 0xacbcf940L, 0x32d86ce3L,
+  0x45df5c75L, 0xdcd60dcfL, 0xabd13d59L, 0x26d930acL, 0x51de003aL,
+  0xc8d75180L, 0xbfd06116L, 0x21b4f4b5L, 0x56b3c423L, 0xcfba9599L,
+  0xb8bda50fL, 0x2802b89eL, 0x5f058808L, 0xc60cd9b2L, 0xb10be924L,
+  0x2f6f7c87L, 0x58684c11L, 0xc1611dabL, 0xb6662d3dL, 0x76dc4190L,
+  0x01db7106L, 0x98d220bcL, 0xefd5102aL, 0x71b18589L, 0x06b6b51fL,
+  0x9fbfe4a5L, 0xe8b8d433L, 0x7807c9a2L, 0x0f00f934L, 0x9609a88eL,
+  0xe10e9818L, 0x7f6a0dbbL, 0x086d3d2dL, 0x91646c97L, 0xe6635c01L,
+  0x6b6b51f4L, 0x1c6c6162L, 0x856530d8L, 0xf262004eL, 0x6c0695edL,
+  0x1b01a57bL, 0x8208f4c1L, 0xf50fc457L, 0x65b0d9c6L, 0x12b7e950L,
+  0x8bbeb8eaL, 0xfcb9887cL, 0x62dd1ddfL, 0x15da2d49L, 0x8cd37cf3L,
+  0xfbd44c65L, 0x4db26158L, 0x3ab551ceL, 0xa3bc0074L, 0xd4bb30e2L,
+  0x4adfa541L, 0x3dd895d7L, 0xa4d1c46dL, 0xd3d6f4fbL, 0x4369e96aL,
+  0x346ed9fcL, 0xad678846L, 0xda60b8d0L, 0x44042d73L, 0x33031de5L,
+  0xaa0a4c5fL, 0xdd0d7cc9L, 0x5005713cL, 0x270241aaL, 0xbe0b1010L,
+  0xc90c2086L, 0x5768b525L, 0x206f85b3L, 0xb966d409L, 0xce61e49fL,
+  0x5edef90eL, 0x29d9c998L, 0xb0d09822L, 0xc7d7a8b4L, 0x59b33d17L,
+  0x2eb40d81L, 0xb7bd5c3bL, 0xc0ba6cadL, 0xedb88320L, 0x9abfb3b6L,
+  0x03b6e20cL, 0x74b1d29aL, 0xead54739L, 0x9dd277afL, 0x04db2615L,
+  0x73dc1683L, 0xe3630b12L, 0x94643b84L, 0x0d6d6a3eL, 0x7a6a5aa8L,
+  0xe40ecf0bL, 0x9309ff9dL, 0x0a00ae27L, 0x7d079eb1L, 0xf00f9344L,
+  0x8708a3d2L, 0x1e01f268L, 0x6906c2feL, 0xf762575dL, 0x806567cbL,
+  0x196c3671L, 0x6e6b06e7L, 0xfed41b76L, 0x89d32be0L, 0x10da7a5aL,
+  0x67dd4accL, 0xf9b9df6fL, 0x8ebeeff9L, 0x17b7be43L, 0x60b08ed5L,
+  0xd6d6a3e8L, 0xa1d1937eL, 0x38d8c2c4L, 0x4fdff252L, 0xd1bb67f1L,
+  0xa6bc5767L, 0x3fb506ddL, 0x48b2364bL, 0xd80d2bdaL, 0xaf0a1b4cL,
+  0x36034af6L, 0x41047a60L, 0xdf60efc3L, 0xa867df55L, 0x316e8eefL,
+  0x4669be79L, 0xcb61b38cL, 0xbc66831aL, 0x256fd2a0L, 0x5268e236L,
+  0xcc0c7795L, 0xbb0b4703L, 0x220216b9L, 0x5505262fL, 0xc5ba3bbeL,
+  0xb2bd0b28L, 0x2bb45a92L, 0x5cb36a04L, 0xc2d7ffa7L, 0xb5d0cf31L,
+  0x2cd99e8bL, 0x5bdeae1dL, 0x9b64c2b0L, 0xec63f226L, 0x756aa39cL,
+  0x026d930aL, 0x9c0906a9L, 0xeb0e363fL, 0x72076785L, 0x05005713L,
+  0x95bf4a82L, 0xe2b87a14L, 0x7bb12baeL, 0x0cb61b38L, 0x92d28e9bL,
+  0xe5d5be0dL, 0x7cdcefb7L, 0x0bdbdf21L, 0x86d3d2d4L, 0xf1d4e242L,
+  0x68ddb3f8L, 0x1fda836eL, 0x81be16cdL, 0xf6b9265bL, 0x6fb077e1L,
+  0x18b74777L, 0x88085ae6L, 0xff0f6a70L, 0x66063bcaL, 0x11010b5cL,
+  0x8f659effL, 0xf862ae69L, 0x616bffd3L, 0x166ccf45L, 0xa00ae278L,
+  0xd70dd2eeL, 0x4e048354L, 0x3903b3c2L, 0xa7672661L, 0xd06016f7L,
+  0x4969474dL, 0x3e6e77dbL, 0xaed16a4aL, 0xd9d65adcL, 0x40df0b66L,
+  0x37d83bf0L, 0xa9bcae53L, 0xdebb9ec5L, 0x47b2cf7fL, 0x30b5ffe9L,
+  0xbdbdf21cL, 0xcabac28aL, 0x53b39330L, 0x24b4a3a6L, 0xbad03605L,
+  0xcdd70693L, 0x54de5729L, 0x23d967bfL, 0xb3667a2eL, 0xc4614ab8L,
+  0x5d681b02L, 0x2a6f2b94L, 0xb40bbe37L, 0xc30c8ea1L, 0x5a05df1bL,
+  0x2d02ef8dL
+};
+
+/*
+ * CRC-32 Updater
+ */
+
+#define DO1ch(crc,c) crc = crc_table[((int)crc ^ (c)) & 0xff] ^ (crc >> 8)
+#define DO1(crc,buf) crc = crc_table[((int)crc ^ (*buf++)) & 0xff] ^ (crc >> 8)
+#define DO2(crc,buf) DO1(crc,buf); DO1(crc,buf);
+#define DO4(crc,buf) DO2(crc,buf); DO2(crc,buf);
+#define DO8(crc,buf) DO4(crc,buf); DO4(crc,buf);
+
+cl_hashkey
+update_crc32(cl_hashkey crc, const char *buf, cl_index len)
+{
+    while (len >= 8) {
+      DO8(crc,buf);
+      len -= 8;
+    }
+    if (len) do {
+      DO1(crc,buf);
+    } while (--len);
+    return crc;
+}
+
+
+static void corrupted_hash(cl_object hashtable) __attribute__((noreturn));
+
+static void
+corrupted_hash(cl_object hashtable)
+{
+  FEerror("internal error, corrupted hashtable ~S", 1, hashtable);
+}
+
+cl_hashkey
+hash_eql(cl_object x)
+{
+	register char *buffer;
+	register cl_index len;
+	register cl_hashkey h = 0;
+ BEGIN:
+	switch (type_of(x)) {
+	case t_bignum:
+		buffer = (char*)x->big.big_limbs;
+		len = abs(x->big.big_size) * sizeof(mp_limb_t);
+		break;
+	case t_ratio:
+		h = hash_eql(x->ratio.num);
+		x = x->ratio.den;
+		goto BEGIN;
+	case t_shortfloat:
+		buffer = (char*)&sf(x);
+		len = sizeof(sf(x));
+		break;
+	case t_longfloat:
+		buffer = (char*)&lf(x);
+		len = sizeof(lf(x));
+		break;
+	case t_complex:
+		h = hash_eql(x->complex.real);
+		x = x->complex.imag;
+		goto BEGIN;
+	case t_character:
+		return CHAR_CODE(x);
+	default:
+		return (cl_hashkey)x >> 2;
+	}
+	while (len >= 4) {
+		DO4(h, buffer);
+		len -= 4;
+	}
+	while (len--)
+		DO1(h, buffer);
+	return h;
+}
+
+static cl_hashkey
+_hash_equal(cl_hashkey h, int depth, cl_object x)
+{
+	char *buffer;
+	cl_index len;
+
+	cs_check(x);
+BEGIN:
+	if (depth++ > 3) return h;
+	switch (type_of(x)) {
+	case t_cons:
+		h = _hash_equal(h, depth, CAR(x));
+		x = CDR(x);
+		goto BEGIN;
+	case t_symbol:
+		x = x->symbol.name;
+	case t_string:
+		buffer = x->string.self;
+		len = x->string.fillp;
+		break;
+	case t_pathname:
+		h = _hash_equal(h, depth, x->pathname.host);
+		h = _hash_equal(h, depth, x->pathname.device);
+		h = _hash_equal(h, depth, x->pathname.directory);
+		h = _hash_equal(h, depth, x->pathname.name);
+		h = _hash_equal(h, depth, x->pathname.type);
+		x = x->pathname.name;
+		goto BEGIN;
+#if 0 /* !ANSI */
+#ifdef CLOS
+	case t_instance:
+		h += _hash_equal(CLASS_NAME(x), depth);
+		for (i = 0;  i < x->instance.length;  i++)
+			h += _hash_equal(x->instance.slots[i], depth);
+		return(h);
+#else
+	case t_structure:
+		h += _hash_equal(x->str.name, depth);
+		for (i = 0;  i < x->str.length;  i++)
+			h += _hash_equal(x->str.self[i], depth);
+		return(h);
+#endif CLOS
+#endif /* !ANSI */
+        case t_package:		/* These two should actually */
+	case t_bitvector:	/* have visible changes under equal */
+	default:
+		return h ^ hash_eql(x);
+	}
+	while (len >= 4) {
+		DO4(h, buffer);
+		len -= 4;
+	}
+	while (len--)
+		DO1(h, buffer);
+	return h;
+}
+
+cl_hashkey
+hash_equal(cl_object key)
+{
+	return _hash_equal(~(cl_hashkey)0, 0, key);
+}
+
+static struct hashtable_entry *
+search_hash(cl_object key, cl_object hashtable)
+{
+	cl_hashkey h;
+	cl_index hsize, i, j, k;
+	struct hashtable_entry *e;
+	cl_object hkey;
+	int htest;
+	bool b;
+
+	htest = hashtable->hash.test;
+	hsize = hashtable->hash.size;
+	j = hsize;
+	switch (htest) {
+	case htt_eq:	h = (cl_hashkey)key >> 2; break;
+	case htt_eql:	h = hash_eql(key); break;
+	case htt_equal:	h = _hash_equal(~(cl_hashkey)0, 0, key); break;
+	case htt_pack:	h = _hash_equal(~(cl_hashkey)0, 0, key); break;
+	default:	corrupted_hash(hashtable);
+	}
+	i = h % hsize;
+	h = h & 0xFFFF;
+	for (k = 0; k < hsize;  i = (i + 1) % hsize, k++) {
+		e = &hashtable->hash.data[i];
+		hkey = e->key;
+		if (hkey == OBJNULL) {
+			if (e->value == OBJNULL)
+				if (j == hsize)
+					return(e);
+				else
+					return(&hashtable->hash.data[j]);
+			else
+				if (j == hsize)
+					j = i;
+				else if (j == i)
+				  /* this was never returning --wfs
+				     but looping around with j=0 */
+				  return(e);
+			continue;
+		}
+		switch (htest) {
+		case htt_eq:	b = key == hkey; break;
+		case htt_eql:	b = eql(key, hkey); break;
+		case htt_equal: b = equal(key, hkey); break;
+		case htt_pack:	b = (h==fix(hkey)) && string_eq(key,e->value->symbol.name);
+				break;
+		default:	corrupted_hash(hashtable);
+		}
+		if (b)
+			return(&hashtable->hash.data[i]);
+	}
+	return(&hashtable->hash.data[j]);
+}
+
+cl_object
+gethash(cl_object key, cl_object hashtable)
+{
+	return search_hash(key, hashtable)->value;
+}
+
+cl_object
+gethash_safe(cl_object key, cl_object hashtable, cl_object def)
+{
+	struct hashtable_entry *e;
+	e = search_hash(key, hashtable);
+	if (e->key == OBJNULL)
+		return def;
+	else
+		return e->value;
+}
+
+static void
+add_new_to_hash(cl_object key, cl_object hashtable, cl_object value)
+{
+	int htest;
+	cl_hashkey h;
+	cl_index i, hsize;
+	struct hashtable_entry *e;
+
+	htest = hashtable->hash.test;
+	hsize = hashtable->hash.size;
+	switch (htest) {
+	case htt_eq:	h = (cl_hashkey)key / 4; break;
+	case htt_eql:	h = hash_eql(key); break;
+	case htt_equal: h = _hash_equal(~(cl_hashkey)0, 0, key); break;
+	case htt_pack:	h = _hash_equal(~(cl_hashkey)0, 0, key); break;
+	default:	corrupted_hash(hashtable);
+	}
+	e = hashtable->hash.data;
+	for (i = h % hsize; ; i = (i + 1) % hsize)
+		if (e[i].key == OBJNULL) {
+			hashtable->hash.entries++;
+			if (htest == htt_pack)
+				e[i].key = MAKE_FIXNUM(h & 0xFFFF);
+			else
+				e[i].key = key;
+			e[i].value = value;
+			return;
+		}
+	corrupted_hashtable();
+}
+
+void
+sethash(cl_object key, cl_object hashtable, cl_object value)
+{
+	cl_index i;
+	bool over;
+	struct hashtable_entry *e;
+	e = search_hash(key, hashtable);
+	if (e->key != OBJNULL) {
+		e->value = value;
+		return;
+	}
+	i = hashtable->hash.entries + 1;
+	if (i >= hashtable->hash.size)
+		over = TRUE;
+	else if (FIXNUMP(hashtable->hash.threshold))
+		over = i >= (cl_index)fix(hashtable->hash.threshold);
+	else if (type_of(hashtable->hash.threshold) == t_shortfloat)
+		over = i >= hashtable->hash.size * sf(hashtable->hash.threshold);
+	else if (type_of(hashtable->hash.threshold) == t_longfloat)
+		over = i >= hashtable->hash.size * lf(hashtable->hash.threshold);
+	else
+		corrupted_hash(hashtable);
+	if (over)
+		extend_hashtable(hashtable);
+	add_new_to_hash(key, hashtable, value);
+}
+
+void
+extend_hashtable(cl_object hashtable)
+{
+	cl_object old, key;
+	cl_index old_size, new_size, i;
+	struct hashtable_entry *e;
+	old_size = hashtable->hash.size;
+	if (FIXNUMP(hashtable->hash.rehash_size))
+		new_size = old_size + fix(hashtable->hash.rehash_size);
+	else if (type_of(hashtable->hash.rehash_size) == t_shortfloat)
+		new_size = old_size * sf(hashtable->hash.rehash_size);
+	else if (type_of(hashtable->hash.rehash_size) == t_longfloat)
+		new_size = old_size * lf(hashtable->hash.rehash_size);
+	else
+		corrupted_hash(hashtable);
+	if (new_size <= old_size)
+		new_size = old_size + 1;
+	old = alloc_object(t_hashtable);
+	old->hash = hashtable->hash;
+	hashtable->hash.data = NULL; /* for GC sake */
+	hashtable->hash.size = new_size;
+	if (FIXNUMP(hashtable->hash.threshold))
+		hashtable->hash.threshold =
+		MAKE_FIXNUM(fix(hashtable->hash.threshold) +
+			    (new_size - old->hash.size));
+	hashtable->hash.data = alloc_align(new_size * sizeof(struct hashtable_entry),
+					    sizeof(cl_object));
+	for (i = 0;  i < new_size;  i++) {
+		hashtable->hash.data[i].key = OBJNULL;
+		hashtable->hash.data[i].value = OBJNULL;
+	}
+	for (i = 0;  i < old_size;  i++)
+		if ((key = old->hash.data[i].key) != OBJNULL) {
+			if (hashtable->hash.test == htt_pack)
+				key = old->hash.data[i].value;
+			add_new_to_hash(key, hashtable, old->hash.data[i].value);
+		}
+}
+
+
+@(defun make_hash_table (&key (test Seql)
+			      (size MAKE_FIXNUM(1024))
+			      (rehash_size make_shortfloat(1.5))
+			      (rehash_threshold make_shortfloat(0.7))
+			 &aux h)
+	enum httest htt;
+	cl_index i, hsize;
+@
+	if (test == Seq || test == SYM_FUN(Seq))
+		htt = htt_eq;
+	else if (test == Seql || test == SYM_FUN(Seql))
+		htt = htt_eql;
+	else if (test == Sequal || test == SYM_FUN(Sequal))
+		htt = htt_equal;
+	else
+		FEerror("~S is an illegal hash-table test function.",
+			1, test);
+  	if (!FIXNUMP(size) || FIXNUM_MINUSP(size))
+		FEerror("~S is an illegal hash-table size.", 1, size);
+	hsize = fix(size);
+	if ((FIXNUMP(rehash_size) && 0 < fix(rehash_size)) ||
+	    (type_of(rehash_size) == t_shortfloat && 1.0 < sf(rehash_size)) ||
+	    (type_of(rehash_size) == t_longfloat && 1.0 < lf(rehash_size)))
+		;
+	else
+		FEerror("~S is an illegal hash-table rehash-size.",
+			1, rehash_size);
+	if ((FIXNUMP(rehash_threshold) &&
+	     0 < fix(rehash_threshold) && fix(rehash_threshold) < fix(size)) ||
+	    (type_of(rehash_threshold) == t_shortfloat &&
+	     0.0 < sf(rehash_threshold) && sf(rehash_threshold) < 1.0) ||
+	    (type_of(rehash_threshold) == t_longfloat &&
+	     0.0 < lf(rehash_threshold) && lf(rehash_threshold) < 1.0))
+		;
+	else
+		FEerror("~S is an illegal hash-table rehash-threshold.",
+			1, rehash_threshold);
+	h = alloc_object(t_hashtable);
+	h->hash.test = htt;
+	h->hash.size = hsize;
+	h->hash.rehash_size = rehash_size;
+	h->hash.threshold = rehash_threshold;
+        h->hash.entries = 0;
+	h->hash.data = NULL;	/* for GC sake */
+	h->hash.data = alloc_align(hsize * sizeof(struct hashtable_entry),
+				    sizeof(cl_object));
+	for(i = 0;  i < hsize;  i++) {
+		h->hash.data[i].key = OBJNULL;
+		h->hash.data[i].value = OBJNULL;
+	}
+	@(return h)
+@)
+
+@(defun hash_table_p (ht)
+@
+	@(return ((type_of(ht) == t_hashtable) ? Ct : Cnil))
+@)
+
+@(defun gethash (key ht &optional (no_value Cnil))
+	struct hashtable_entry *e;
+@
+	assert_type_hash_table(ht);
+	e = search_hash(key, ht);
+	if (e->key != OBJNULL)
+		@(return e->value Ct)
+	else
+		@(return no_value Cnil)
+@)
+
+@(defun si::hash_set (key ht val)
+@
+	assert_type_hash_table(ht);
+	sethash(key, ht, val);
+	@(return val)
+@)
+
+bool
+remhash(cl_object key, cl_object hashtable)
+{
+	struct hashtable_entry *e;
+	assert_type_hash_table(hashtable);
+	e = search_hash(key, hashtable);
+	if (e->key != OBJNULL) {
+		e->key = OBJNULL;
+		e->value = Cnil;
+		hashtable->hash.entries--;
+		return TRUE;
+	}
+	return FALSE;
+}
+
+@(defun remhash (key ht)
+	struct hashtable_entry *e;
+@
+	@(return (remhash(key, ht)? Ct : Cnil));
+@)
+
+@(defun clrhash (ht)
+	cl_index i;
+@
+	assert_type_hash_table(ht);
+	for(i = 0; i < ht->hash.size; i++) {
+		ht->hash.data[i].key = OBJNULL;
+		ht->hash.data[i].value = OBJNULL;
+	}
+	ht->hash.entries = 0;
+	@(return ht)
+@)
+
+@(defun hash_table_count (ht)
+@
+	assert_type_hash_table(ht);
+	@(return (MAKE_FIXNUM(ht->hash.entries)))
+@)
+
+@(defun hash_table_rehash_size (ht)
+@
+	assert_type_hash_table(ht);
+	@(return ht->hash.rehash_size)
+@)
+
+@(defun hash_table_rehash_threshold (ht)
+@
+	assert_type_hash_table(ht);
+	@(return ht->hash.threshold)
+@)
+
+@(defun sxhash (key)
+@
+	@(return (MAKE_FIXNUM(_hash_equal(~(cl_hashkey)0, 0, key) & 0x7fffffff)))
+@)
+
+@(defun maphash (fun ht)
+	cl_index i;
+@
+	assert_type_hash_table(ht);
+	for (i = 0;  i < ht->hash.size;  i++) {
+		if(ht->hash.data[i].key != OBJNULL)
+			funcall(3, fun,
+				  ht->hash.data[i].key,
+				  ht->hash.data[i].value);
+	}
+	@(return Cnil)
+@)
diff --git a/src/c/init.d b/src/c/init.d
new file mode 100644
index 000000000..b2461a79a
--- /dev/null
+++ b/src/c/init.d
@@ -0,0 +1,113 @@
+/*
+    init.c  -- Lisp Initialization.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+/******************************* ------- ******************************/
+
+extern void init_lisp_libs(void);
+
+void
+init_lisp(void)
+{
+#ifndef RUNTIME
+	function_entry_table = (void *)malloc(2 * function_entries_max * sizeof(void *));
+#endif
+	init_symbol();
+	init_package();
+
+#if !defined(GBC_BOEHM)
+	/* We need this because a lot of stuff is to be created */
+	init_GC();
+#endif
+
+	/* These must come _after_ init_symbol() and init_package() */
+	init_all_keywords();
+	init_all_symbols();
+	init_all_functions();
+
+	SYM_VAL(Vpackage) = lisp_package;
+	SYM_VAL(Vgensym_counter) = MAKE_FIXNUM(0);
+
+	init_typespec();
+	init_number();
+	init_character();
+	init_file();
+	init_read();
+	init_print();
+	init_pathname();
+#ifdef unix
+	init_load();
+/*  	init_unixsys(); */
+#endif unix
+	init_array();
+/*  	init_list(); */
+/*  	init_predicate(); */
+/*  	init_cfun(); */
+/*  	init_sequence(); */
+/*  	init_structure(); */
+/*  	init_string(); */
+#if !defined(GBC_BOEHM)
+	init_alloc_function();
+#endif
+#ifdef TCP
+/*  	init_tcp(); */
+#endif TCP
+#ifdef THREADS
+	init_lwp();
+#endif THREADS
+#ifdef CLOS
+/*  	init_instance(); */
+	init_clos();
+/*  	init_gfun(); */
+#endif CLOS
+#ifdef TK
+	init_tk();
+#endif TK
+#ifdef LOCATIVE
+	init_unify();
+#endif LOCATIVE
+/*  	init_hash(); */
+#ifdef unix
+/*  	init_unixfsys(); */
+	init_unixtime();
+#endif unix
+	init_compiler();
+	init_interpreter();
+	init_eval();
+/*  	init_lex(); */
+/*  	init_reference(); */
+	init_assignment();
+/*  	init_stacks(); */
+	init_error();
+/*  	init_toplevel(); */
+/*  	init_conditional(); */
+/*  	init_catch(); */
+	init_macros();
+/*  	init_let(); */
+/*  	init_prog(); */
+/*  	init_block(); */
+	init_multival();
+/*  	init_mapfun(); */
+/*  	init_iteration(); */
+  	init_cmpaux();
+	init_main();
+	init_format();
+	init_interrupt();
+#ifdef RUNTIME
+	SYM_VAL(Vfeatures) = CONS(make_keyword("RUNTIME"), SYM_VAL(Vfeatures));
+#endif
+	init_lisp_libs();
+}
diff --git a/src/c/instance.d b/src/c/instance.d
new file mode 100644
index 000000000..8785622b2
--- /dev/null
+++ b/src/c/instance.d
@@ -0,0 +1,167 @@
+/*
+    instance.c -- CLOS interface.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+/******************************* EXPORTS ******************************/
+
+cl_object Sprint_object;
+
+/******************************* ------- ******************************/
+
+cl_object
+allocate_instance(cl_object class, int size)
+{
+	cl_object x = alloc_instance(size);
+	int i;
+	x->instance.class = class;
+	for (i = 0;  i < size;  i++)
+		x->instance.slots[i] = OBJNULL;
+	return(x);
+}
+
+@(defun si::allocate_instance (class size)
+@
+	if (type_of(class) != t_instance)
+	  FEwrong_type_argument(Sinstance, class);
+
+	@(return allocate_instance(class, fixnnint(size)))
+@)
+
+/* corr is a list of (newi . oldi) describing which of the new slots
+   retains a value from an old slot
+ */
+@(defun si::change_instance (x class size corr)
+	int nslot, i;
+	cl_object * oldslots;
+@
+	if (type_of(x) != t_instance)
+	  FEwrong_type_argument(Sinstance, x);
+
+	if (type_of(class) != t_instance)
+	  FEwrong_type_argument(Sinstance, class);
+
+	nslot = fixnnint(size);
+	x->instance.class = class;
+	x->instance.length = nslot;
+	oldslots = x->instance.slots;
+	x->instance.slots = alloc_align(sizeof(cl_object)*nslot,sizeof(cl_object));
+	for (i = 0;  i < nslot;  i++) {
+	  if (!Null(corr) && fix(CAAR(corr)) == i) {
+	    x->instance.slots[i] = oldslots[fix(CDAR(corr))];
+	    corr = CDR(corr);
+	  }
+	  else
+	    x->instance.slots[i] = OBJNULL;
+	}
+	@(return) /* FIXME! Is this what we need? */
+@)
+
+@(defun si::instance_class (x)
+@
+	if (type_of(x) != t_instance)
+		FEwrong_type_argument(Sinstance, x);
+	@(return x->instance.class)
+@)
+
+@(defun si::instance_class_set (x y)
+@
+	if (type_of(x) != t_instance)
+		FEwrong_type_argument(Sinstance, x);
+	if (type_of(y) != t_instance)
+		FEwrong_type_argument(Sinstance, y);
+	x->instance.class = y;
+	@(return x)
+@)
+
+cl_object
+instance_ref(cl_object x, int i)
+{
+	if (type_of(x) != t_instance)
+		FEwrong_type_argument(Sinstance, x);
+	if (i >= x->instance.length || i < 0)
+	        FEerror("~S is an illegal slot index1.",1,i);
+	return(x->instance.slots[i]);
+}
+
+@(defun si::instance_ref (x index)
+	cl_fixnum i;
+@
+	if (type_of(x) != t_instance)
+		FEwrong_type_argument(Sinstance, x);
+	if (!FIXNUMP(index) ||
+	    (i = fix(index)) < 0 || i >= x->instance.length)
+		FEerror("~S is an illegal slot index.", 1, index);
+	@(return x->instance.slots[i])
+@)
+
+@(defun si::instance_ref_safe (x index)
+	cl_fixnum i;
+@
+	if (type_of(x) != t_instance)
+		FEwrong_type_argument(Sinstance, x);
+	if (!FIXNUMP(index) ||
+	    (i = fix(index)) < 0 || i >= x->instance.length)
+		FEerror("~S is an illegal slot index.", 1, index);
+	x = x->instance.slots[i];
+	if (x == OBJNULL)
+		FEerror("Slot index ~S unbound", 1, index);
+	@(return x->instance.slots[i])
+@)
+
+cl_object
+instance_set(cl_object x, int i, cl_object v)
+{
+        if (type_of(x) != t_instance)
+                FEwrong_type_argument(Sinstance, x);
+	if (i >= x->instance.length || i < 0)
+	        FEerror("~S is an illegal slot index2.", 1, i);
+	x->instance.slots[i] = v;
+	return(v);
+}
+
+@(defun si::instance_set (x index value)
+	cl_fixnum i;
+@
+	if (type_of(x) != t_instance)
+		FEwrong_type_argument(Sinstance, x);
+	if (!FIXNUMP(index) ||
+	    (i = fix(index)) >= x->instance.length || i < 0)
+		FEerror("~S is an illegal slot index.", 1, index);
+	x->instance.slots[i] = value;
+	@(return value)
+@)
+
+@(defun si::instancep (x)
+@
+	@(return ((type_of(x) == t_instance) ? Ct : Cnil))
+@)
+
+@(defun si::sl_boundp (x)
+@
+	@(return ((x == OBJNULL) ? Cnil : Ct))
+@)
+
+@(defun si::sl_makunbound (x index)
+	cl_fixnum i;
+@
+	if (type_of(x) != t_instance)
+		FEwrong_type_argument(Sinstance, x);
+	if (!FIXNUMP(index) ||
+	    (i = fix(index)) >= x->instance.length || i < 0)
+		FEerror("~S is an illegal slot index.", 1, index);
+	x->instance.slots[i] = OBJNULL;
+	@(return x)
+@)
diff --git a/src/c/interpreter.d b/src/c/interpreter.d
new file mode 100644
index 000000000..3d0cd91db
--- /dev/null
+++ b/src/c/interpreter.d
@@ -0,0 +1,881 @@
+/*
+    interpreter.c -- Bytecode interpreter.
+*/
+/*
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include "ecls-inl.h"
+#include "bytecodes.h"
+
+#define next_code(v) *(v++)
+#undef frs_pop
+#define frs_pop() { stack->vector.fillp = frs_top->frs_sp; frs_top--; }
+
+static void
+lambda_bind_var(cl_object var, cl_object val, cl_object specials)
+{
+	if (!member_eq(var, specials))
+		CAR(lex_env) = CONS(CONS(var, CONS(val, Cnil)), CAR(lex_env));
+	else {
+		CAR(lex_env) = CONS(CONS(var, Cnil), CAR(lex_env));
+		bds_bind(var, val);
+	}
+}
+
+static void
+bind_var(register cl_object var, register cl_object val)
+{
+	CAR(lex_env) = CONS(CONS(var, CONS(val, Cnil)), CAR(lex_env));
+}
+
+static void
+bind_special(register cl_object var, register cl_object val)
+{
+	CAR(lex_env) = CONS(CONS(var, Cnil), CAR(lex_env));
+	bds_bind(var, val);
+}
+
+static cl_object *
+lambda_bind(int narg, cl_object lambda_list, cl_object *args)
+{
+	cl_object *data = &lambda_list->bytecodes.data[2];
+	cl_object specials = lambda_list->bytecodes.data[1];
+	cl_object aux;
+	int i, n;
+	bool other_keys = FALSE;
+	bool check_remaining = TRUE;
+	bool allow_other_keys_found = FALSE;
+
+	/* 1) REQUIRED ARGUMENTS:  N var1 ... varN */
+	n = fix(next_code(data));
+	if (narg < n)
+	  check_arg_failed(narg, n);
+	for (; n; n--, narg--)
+	  lambda_bind_var(next_code(data), next_code(args), specials);
+
+	/* 2) OPTIONAL ARGUMENTS:  N var1 value1 flag1 ... varN valueN flagN */
+	for (n = fix(next_code(data)); n; n--, data+=3) {
+	  if (narg) {
+	    lambda_bind_var(data[0], args[0], specials);
+	    args++; narg--;
+	    if (!Null(data[2]))
+	      lambda_bind_var(data[2], Ct, specials);
+	  } else {
+	    cl_object defaults = data[1];
+	    if (FIXNUMP(defaults)) {
+	      interpret(&data[1] + fix(defaults));
+	      defaults = VALUES(0);
+	    }
+	    lambda_bind_var(data[0], defaults, specials);
+	    if (!Null(data[2]))
+	      lambda_bind_var(data[2], Cnil, specials);
+	  }
+	}
+
+	/* 3) REST ARGUMENT: {rest-var | NIL} */
+	if (!Null(data[0])) {
+	  cl_object rest = Cnil;
+	  check_remaining = FALSE;
+	  for (i=narg; i; )
+	    rest = CONS(args[--i], rest);
+	  lambda_bind_var(data[0], rest, specials);
+	}
+	data++;
+
+	/* 4) ALLOW-OTHER-KEYS: { T | NIL } */
+	other_keys = !Null(next_code(data));
+
+	/* 5) KEYWORDS: N key1 var1 value1 flag1 ... keyN varN valueN flagN */
+	n = fix(next_code(data));
+	if (n != 0 || other_keys) {
+	  cl_object *keys;
+	  cl_object spp[n];
+	  bool other_found = FALSE;
+	  for (i=0; i<n; i++)
+	    spp[i] = OBJNULL;
+	  for (; narg; args+=2, narg-=2) {
+	    if (!SYMBOLP(args[0]))
+	      FEprogram_error("LAMBDA: Keyword expected, got ~S.", 1, args[0]);
+	    keys = data;
+	    for (i = 0; i < n; i++, keys += 4) {
+	      if (args[0] == keys[0]) {
+		if (spp[i] == OBJNULL)
+		  spp[i] = args[1];
+		goto FOUND;
+	      }
+	    }
+	    if (args[0] != Kallow_other_keys)
+	      other_found = TRUE;
+	    else if (!allow_other_keys_found) {
+	      allow_other_keys_found = TRUE;
+	      other_keys = !Null(args[1]);
+	    }
+	  FOUND:
+	  }
+	  if (other_found && !other_keys)
+	    FEprogram_error("LAMBDA: Unknown keys found in function ~S.",
+			    1, lambda_list->bytecodes.data[0]);
+	  for (i=0; i<n; i++, data+=4) {
+	    if (spp[i] != OBJNULL)
+	      lambda_bind_var(data[1],spp[i],specials);
+	    else {
+	      cl_object defaults = data[2];
+	      if (FIXNUMP(defaults)) {
+		      interpret(&data[2] + fix(defaults));
+		      defaults = VALUES(0);
+	      }
+	      lambda_bind_var(data[1],defaults,specials);
+	    }
+	    if (!Null(data[3]))
+	      lambda_bind_var(data[3],(spp[i] != OBJNULL)? Ct : Cnil,specials);
+	  }
+	}
+	if (narg && !other_keys && check_remaining)
+	  FEprogram_error("LAMBDA: Too many arguments to function ~S.", 1,
+			  lambda_list->bytecodes.data[0]);
+
+	return &data[2];
+}
+
+cl_object
+lambda_apply(int narg, cl_object fun, cl_object *args)
+{       cl_object lex_old = lex_env;
+	cl_object output, name, *body;
+	bds_ptr old_bds_top;
+	volatile bool block, closure;
+
+	if (type_of(fun) != t_bytecodes)
+		FEinvalid_function(fun);
+
+	/* Set the lexical environment of the function */
+	ihs_check;
+	if (Null(fun->bytecodes.lex))
+		lex_env = CONS(Cnil, Cnil);
+	else
+		lex_env = CONS(CAR(fun->bytecodes.lex),CDR(fun->bytecodes.lex));
+	ihs_push(fun, lex_env);
+	old_bds_top = bds_top;
+
+	/* Establish bindings */
+	body = lambda_bind(narg, fun, args);
+
+	/* If it is a named lambda, set a block for RETURN-FROM */
+	block = FALSE;
+	name = fun->bytecodes.data[0];
+	if (Null(fun->bytecodes.data[0]))
+		block = FALSE;
+	else {
+		block = TRUE;
+		fun = new_frame_id();
+		lex_block_bind(name, fun);
+		if (frs_push(FRS_CATCH, fun)) {
+			output = VALUES(0);
+			goto END;
+		}
+	}
+
+	/* Process statements */
+	VALUES(0) = Cnil;
+	NValues = 0;
+	interpret(body);
+
+END:    if (block) frs_pop();
+	bds_unwind(old_bds_top);
+	lex_env = lex_old;
+	ihs_pop();
+	returnn(VALUES(0));
+}
+
+
+/* ----------------- BYTECODE STACK --------------- */
+
+cl_object stack = OBJNULL;
+
+static void
+stack_grow(void) {
+	cl_object *old_data = stack->vector.self.t;
+	cl_index old_size = stack->vector.fillp;
+	stack->vector.dim += 128;
+	array_allocself(stack);
+	memcpy(stack->vector.self.t, old_data, old_size*sizeof(cl_object));
+}
+
+static void
+push1(register cl_object op) {
+	cl_index where;
+	where = stack->vector.fillp;
+	if (where >= stack->vector.dim)
+		stack_grow();
+	stack->vector.self.t[where] = op;
+	stack->vector.fillp++;
+}
+
+static cl_object
+pop1() {
+	return stack->vector.self.t[--stack->vector.fillp];
+}
+
+static cl_index
+get_sp_index() {
+	return stack->vector.fillp;
+}
+
+static void
+dec_sp_index(register cl_index delta) {
+	stack->vector.fillp -= delta;
+}
+
+static void
+set_sp_index(register cl_index sp) {
+	if (stack->vector.fillp < sp)
+		FEerror("Tried to advance stack", 0);
+	stack->vector.fillp = sp;
+}
+
+static cl_object *
+get_sp() {
+	return stack->vector.self.t + stack->vector.fillp;
+}
+
+static cl_object *
+get_sp_at(cl_index where) {
+	return stack->vector.self.t + where;
+}
+
+/* -------------------- AIDS TO THE INTERPRETER -------------------- */
+
+static inline cl_fixnum
+get_oparg(cl_object o) {
+	return GET_OPARG(o);
+}
+
+static inline cl_object *
+packed_label(cl_object *v) {
+	return v + GET_OPARG(v[0]);
+}
+
+static inline cl_object *
+simple_label(cl_object *v) {
+	return v + fix(v[0]);
+}
+
+static cl_object
+search_symbol_function(register cl_object fun) {
+	cl_object output = lex_fun_sch(fun);
+	if (!Null(output))
+		return output;
+	output = SYM_FUN(fun);
+	if (output == OBJNULL || fun->symbol.mflag)
+		FEundefined_function(fun);
+	return output;
+}
+
+static cl_object
+search_symbol_value(register cl_object s) {
+	cl_object x;
+	/*  x = lex_var_sch(form);  */
+	for (x = CAR(lex_env);  CONSP(x);  x = CDR(x))
+		if (CAAR(x) == s) {
+			x = CDAR(x);
+			if (ENDP(x)) break;
+			return CAR(x);
+		}
+	x = SYM_VAL(s);
+	if (x == OBJNULL)
+		FEunbound_variable(s);
+	return x;
+}
+		
+static cl_object
+interpret_apply(int narg, cl_object fun, cl_object *args) {
+	cl_object x;
+
+ AGAIN:
+	switch (type_of(fun)) {
+	case t_cfun:
+		ihs_push_funcall(fun->cfun.name);
+		x = APPLY(narg, fun->cfun.entry, args);
+		ihs_pop();
+		return x;
+	case t_cclosure:
+		/* FIXME! Shouldn't we register this call somehow? */
+		return APPLY_closure(narg, fun->cclosure.entry, fun->cclosure.env, args);
+#ifdef CLOS
+	case t_gfun:
+		ihs_push_funcall(fun->gfun.name);
+		x = gcall(narg, fun, args);
+		ihs_pop();
+		return x;
+#endif
+	case t_bytecodes:
+		return lambda_apply(narg, fun, args);
+	case t_symbol:
+		fun = search_symbol_function(fun);
+		goto AGAIN;
+	default:
+	}
+	FEinvalid_function(fun);
+}
+
+/* -------------------- THE INTERPRETER -------------------- */
+
+static cl_object *
+interpret_block(cl_object *vector) {
+	cl_object * volatile exit, name;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	exit = packed_label(vector - 1);
+	lex_block_bind(next_code(vector), id);
+	if (frs_push(FRS_CATCH,id) == 0)
+		vector = interpret(vector);
+	frs_pop();
+	lex_env = lex_old;
+	return exit;
+}
+
+static cl_object *
+interpret_catch(cl_object *vector) {
+	cl_object * volatile exit;
+	exit = packed_label(vector - 1);
+	if (frs_push(FRS_CATCH,VALUES(0)) == 0)
+		interpret(vector);
+	frs_pop();
+	return exit;
+}
+
+static cl_object *
+interpret_tagbody(cl_object *vector) {
+	cl_index i, ntags = get_oparg(vector[-1]);
+	cl_object lex_old = lex_env;
+	cl_object id = new_frame_id();
+	cl_object *aux, *tag_list = vector;
+
+	lex_copy();
+	aux = vector;
+	for (i=0; i<ntags; i++, aux+=2)
+		lex_tag_bind(*aux, id);
+
+	if (frs_push(FRS_CATCH, id) != 0) {
+		for (aux = vector, i=0; i<ntags; i++, aux+=2)
+			if (eql(aux[0], nlj_tag)) {
+				aux++;
+				break;
+			}
+		if (i >= ntags)
+			FEerror("Internal error: TAGBODY id used for RETURN-FROM.",0);
+		else
+			aux = simple_label(aux);
+	}
+	vector = interpret(aux);
+	frs_pop();
+	lex_env = lex_old;
+	VALUES(0) = Cnil;
+	NValues = 0;
+	return vector;
+}
+
+static cl_object *
+interpret_unwind_protect(cl_object *vector) {
+	bool unwinding;
+	int nr;
+	cl_object * volatile exit;
+
+	exit = packed_label(vector-1);
+	if (frs_push(FRS_PROTECT, Cnil))
+		unwinding = TRUE;
+	else {
+		interpret(vector);
+		unwinding = FALSE;
+	}
+	frs_pop();
+	nr = NValues;
+	MV_SAVE(nr);
+	exit = interpret(exit);
+	MV_RESTORE(nr);
+	if (unwinding)
+		unwind(nlj_fr, nlj_tag);
+	return exit;
+}
+
+static cl_object *
+interpret_do(cl_object *vector) {
+	cl_object *volatile exit;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+	lex_copy();
+	lex_block_bind(Cnil, id);
+
+	exit = packed_label(vector-1);
+	if (frs_push(FRS_CATCH,id) == 0)
+		interpret(vector);
+	frs_pop();
+
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return exit;
+}
+
+static cl_object *
+interpret_dolist(cl_object *vector) {
+	cl_object *output, *volatile exit;
+	cl_object list, var;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+	lex_copy();
+	lex_block_bind(Cnil, id);
+
+	list = VALUES(0);
+	exit = packed_label(vector - 1);
+	if (frs_push(FRS_CATCH,id) == 0) {
+		/* Build list & bind variable*/
+		vector = interpret(vector);
+		output = packed_label(vector-1);
+		while (!endp(list)) {
+			NValues = 1;
+			VALUES(0) = CAR(list);
+			interpret(vector);
+			list = CDR(list);
+		}
+		VALUES(0) = Cnil;
+		NValues = 1;
+		interpret(output);
+	}
+	frs_pop();
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return exit;
+}
+
+static cl_object *
+interpret_dotimes(cl_object *vector) {
+	cl_object *output, *volatile exit;
+	cl_fixnum length, i;
+	cl_object var;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+	lex_copy();
+	lex_block_bind(Cnil, id);
+
+	length = fix(VALUES(0));
+	exit = packed_label(vector - 1);
+	if (frs_push(FRS_CATCH,id) == 0) {
+		/* Bind variable */
+		vector = interpret(vector);
+		output = packed_label(vector-1);
+		for (i = 0; i < length;) {
+			interpret(vector);
+			NValues = 1;
+			VALUES(0) = MAKE_FIXNUM(++i);
+		}
+		interpret(output);
+	}
+	frs_pop();
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return exit;
+}
+
+static cl_object
+close_around(cl_object fun, cl_object lex) {
+	cl_object v = alloc_object(t_bytecodes);
+	v->bytecodes.size = fun->bytecodes.size;
+	v->bytecodes.data = fun->bytecodes.data;
+	if (!Null(CAR(lex)) || !Null(CDR(lex)))
+		v->bytecodes.lex = CONS(CAR(lex),CDR(lex));
+	else
+		v->bytecodes.lex = Cnil;
+	return v;
+}
+
+static cl_object *
+interpret_flet(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	cl_index nfun = get_oparg(vector[-1]);
+
+	lex_copy();
+	while (nfun--) {
+		cl_object fun = next_code(vector);
+		cl_object f = close_around(fun,lex_old);
+		lex_fun_bind(f->bytecodes.data[0], f);
+	}
+	vector = interpret(vector);
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+interpret_labels(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	cl_index i, nfun = get_oparg(vector[-1]);
+	cl_object l;
+
+	lex_copy();
+	for (i=0; i<nfun; i++) {
+		cl_object f = next_code(vector);
+		lex_fun_bind(f->bytecodes.data[0], f);
+	}
+	/* Update the closures so that all functions can call each other */
+	for (i=0, l=CDR(lex_env); i<nfun; i++) {
+		cl_object f = CADDAR(l);
+		CADDAR(l) = close_around(f, lex_env);
+		l = CDR(l);
+	}
+	vector = interpret(vector);
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+interpret_mbind(cl_object *vector)
+{
+	int i = get_oparg(vector[-1]);
+	while (i--) {
+		cl_object var = next_code(vector);
+		cl_object value = (i < NValues) ? VALUES(i) : Cnil;
+		if (var == MAKE_FIXNUM(1))
+			bind_special(next_code(vector), value);
+		else
+			bind_var(var, value);
+	}
+	return vector;
+}
+
+static cl_object *
+interpret_mcall(cl_object *vector) {
+	cl_index sp = get_sp_index();
+	vector = interpret(vector);
+	VALUES(0) = interpret_apply(get_sp_index()-sp, VALUES(0), get_sp_at(sp));
+	set_sp_index(sp);
+	return vector;
+}
+
+static cl_object *
+interpret_mprog1(cl_object *vector) {
+	cl_index i,n = NValues;
+	for (i=0; i<n; i++) {
+		push1(VALUES(i));
+	}
+	vector = interpret(vector);
+	for (i=n; i;) {
+		VALUES(--i) = pop1();
+	}
+	NValues = n;
+	return vector;
+}
+
+static cl_object *
+interpret_msetq(cl_object *vector)
+{
+	cl_object var, value;
+	int i = get_oparg(vector[-1]);
+	while (i--) {
+		var = next_code(vector);
+		value = (i < NValues) ? VALUES(i) : Cnil;
+		if (var != MAKE_FIXNUM(1))
+			CADR(lex_var_sch(var)) = value;
+		else {
+			var = next_code(vector);
+			if (var->symbol.stype == stp_constant)
+				FEassignment_to_constant(var);
+			else
+				SYM_VAL(var) = value;
+		}
+	}
+	if (NValues > 1) NValues = 1;
+	return vector;
+}
+
+static cl_object *
+interpret_progv(cl_object *vector) {
+	cl_object values = VALUES(0);
+	cl_object vars = pop1();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+
+	lex_copy();
+	while (!endp(vars)) {
+		if (values == Cnil)
+			bds_bind(CAR(vars), OBJNULL);
+		else {
+			bds_bind(CAR(vars), car(values));
+			values = CDR(values);
+		}
+		vars = CDR(vars);
+	}
+	vector = interpret(vector);
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return vector;
+}
+
+static cl_object *
+interpret_pushenv(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+
+	lex_copy();
+	vector = interpret(vector);
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return vector;
+}
+
+cl_object *
+interpret(cl_object *vector) {
+	enum cl_type t;
+	cl_object s;
+	cl_fixnum n;
+
+ BEGIN:
+	s = next_code(vector);
+	t = type_of(s);
+	if (t == t_symbol) {
+		VALUES(0) = search_symbol_value(s);
+		NValues = 1;
+		goto BEGIN;
+	}
+	if (t != t_fixnum) {
+		VALUES(0) = s;
+		NValues = 1;
+		goto BEGIN;
+	}
+	switch (GET_OP(s)) {
+	case OP_PUSHQ:
+		push1(next_code(vector));
+		break;
+	case OP_PUSH:
+		push1(VALUES(0));
+		break;
+	case OP_PUSHV:
+		push1(search_symbol_value(next_code(vector)));
+		break;
+	case OP_QUOTE:
+		VALUES(0) = next_code(vector);
+		NValues = 1;
+		break;
+	case OP_NOP:
+		VALUES(0) = Cnil;
+		NValues = 0;
+		break;
+	case OP_BLOCK:
+		vector = interpret_block(vector);
+		break;
+	case OP_PUSHVALUES: {
+		int i;
+		for (i=0; i<NValues; i++)
+			push1(VALUES(i));
+		break;
+	}
+	case OP_MCALL:
+		vector = interpret_mcall(vector);
+		break;
+	case OP_CALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object name = next_code(vector);
+		VALUES(0) = interpret_apply(n, name, get_sp()-n);
+		dec_sp_index(n);
+		break;
+	}
+	case OP_PCALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object name = next_code(vector);
+		VALUES(0) = interpret_apply(n, name, get_sp()-n);
+		dec_sp_index(n);
+		push1(VALUES(0));
+		break;
+	}
+	case OP_FCALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object fun = VALUES(0);
+		VALUES(0) = interpret_apply(n, fun, get_sp()-n);
+		dec_sp_index(n);
+		break;
+	}
+	case OP_PFCALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object fun = VALUES(0);
+		VALUES(0) = interpret_apply(n, fun, get_sp()-n);
+		dec_sp_index(n);
+		push1(VALUES(0));
+		break;
+	}
+	case OP_CATCH:
+		vector = interpret_catch(vector);
+		break;
+	case OP_EXIT:
+		return vector;
+	case OP_HALT:
+		return vector-1;
+	case OP_FLET:
+		vector = interpret_flet(vector);
+		break;
+	case OP_LABELS:
+		vector = interpret_labels(vector);
+		break;
+	case OP_FUNCTION:
+		VALUES(0) = search_symbol_function(next_code(vector));
+		NValues = 1;
+		break;
+	case OP_CLOSE:
+		VALUES(0) = close_around(next_code(vector), lex_env);
+		NValues = 1;
+		break;
+	case OP_GO: {
+		cl_object tag = next_code(vector);
+		cl_object id = lex_tag_sch(tag);
+		if (Null(id))
+			FEcontrol_error("GO: Undefined tag ~S.", 1, tag);
+		VALUES(0) = Cnil;
+		NValues = 0;
+		go(id, tag);
+		break;
+	}
+	case OP_RETURN: {
+		cl_object tag = next_code(vector);
+		cl_object id = lex_block_sch(tag);
+		if (Null(id))
+			FEcontrol_error("RETURN-FROM: Unknown block ~S.", 1, tag);
+		return_from(id, tag);
+		break;
+	}
+	case OP_THROW:
+		throw(pop1());
+		break;
+	case OP_JMP:
+		vector = vector - 1 + get_oparg(s);
+		break;
+	case OP_JNIL:
+		NValues = 1;
+		if (Null(VALUES(0))) vector = vector - 1 + get_oparg(s);
+		break;
+	case OP_JT:
+		NValues = 1;
+		if (!Null(VALUES(0))) vector = vector - 1 + get_oparg(s);
+		break;
+	case OP_JEQ:
+		if (VALUES(0) == next_code(vector))
+			vector = vector + get_oparg(s) - 2;
+		break;
+	case OP_JNEQ:
+		if (VALUES(0) != next_code(vector))
+			vector = vector + get_oparg(s) - 2;
+		break;
+	case OP_BIND:
+		bind_var(next_code(vector), VALUES(0));
+		break;
+	case OP_BINDS:
+		bind_special(next_code(vector), VALUES(0));
+		break;
+	case OP_SETQ:
+		CADR(lex_var_sch(next_code(vector))) = VALUES(0);
+		break;
+	case OP_SETQS: {
+		cl_object var = next_code(vector);
+		if (var->symbol.stype == stp_constant)
+			FEassignment_to_constant(var);
+		else
+			SYM_VAL(var) = VALUES(0);
+		break;
+	}
+	case OP_PBIND:
+		bind_var(next_code(vector), pop1());
+		break;
+	case OP_PBINDS:
+		bind_special(next_code(vector), pop1());
+		break;
+	case OP_PSETQ:
+		CADR(lex_var_sch(next_code(vector))) = pop1();
+		Values[0] = Cnil;
+		NValues = 1;
+		break;
+	case OP_PSETQS: {
+		cl_object var = next_code(vector);
+		if (var->symbol.stype == stp_constant)
+			FEassignment_to_constant(var);
+		else
+			SYM_VAL(var) = pop1();
+		Values[0] = Cnil;
+		NValues = 1;
+		break;
+	}
+	case OP_MSETQ:
+		vector = interpret_msetq(vector);
+		break;
+	case OP_MBIND:
+		vector = interpret_mbind(vector);
+		break;
+	case OP_MPROG1:
+		vector = interpret_mprog1(vector);
+		break;
+	case OP_PROGV:
+		vector = interpret_progv(vector);
+		break;
+	case OP_PUSHENV:
+		vector = interpret_pushenv(vector);
+		break;
+	case OP_VALUES: {
+		cl_fixnum n = get_oparg(s);
+		NValues = n;
+		while (n)
+			VALUES(--n) = pop1();
+		break;
+	}
+	case OP_NTHVAL: {
+		cl_index n = fix(pop1());
+		if (n < 0 || n >= NValues)
+			VALUES(0) = Cnil;
+		else
+			VALUES(0) = VALUES(n);
+		NValues = 1;
+		break;
+	}
+	case OP_DOLIST:
+		vector = interpret_dolist(vector);
+		break;
+	case OP_DOTIMES:
+		vector = interpret_dotimes(vector);
+		break;
+	case OP_DO:
+		vector = interpret_do(vector);
+		break;
+	case OP_TAGBODY:
+		vector = interpret_tagbody(vector);
+		break;
+	case OP_UNWIND:
+		vector = interpret_unwind_protect(vector);
+		break;
+	default:
+		FEerror("Internal error: Unknown code ~S",
+			1, MAKE_FIXNUM(*(vector-1)));
+	}
+	goto BEGIN;
+}
+
+@(defun si::interpreter_stack ()
+@
+	@(return stack)
+@)
+
+void
+init_interpreter(void)
+{
+	register_root(&stack);
+	stack = alloc_simple_vector(128, aet_object);
+	array_allocself(stack);
+	stack->vector.hasfillp = TRUE;
+	stack->vector.fillp = 0;
+}
diff --git a/src/c/lex.d b/src/c/lex.d
new file mode 100644
index 000000000..5c05c3b6b
--- /dev/null
+++ b/src/c/lex.d
@@ -0,0 +1,77 @@
+/*
+    lex.c -- Lexical environment.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+/******** EXPORTS ********/
+
+#ifndef THREADS
+cl_object lex_env = OBJNULL;
+#endif
+
+cl_object siSsymbol_macro;
+cl_object Smacro;
+cl_object Sblock;
+cl_object Stag;
+
+/******** ------- ********/
+
+void
+lex_fun_bind(cl_object name, cl_object fun)
+{
+	CDR(lex_env) = CONS(list(3, name, Sfunction, fun), CDR(lex_env));
+}
+
+void
+lex_symbol_macro_bind(cl_object name, cl_object exp_fun)
+{
+	CAR(lex_env) = CONS(list(3, name, siSsymbol_macro, exp_fun), CAR(lex_env));
+}
+
+void
+lex_macro_bind(cl_object name, cl_object exp_fun)
+{
+	CDR(lex_env) = CONS(list(3, name, Smacro, exp_fun), CDR(lex_env));
+}
+
+void
+lex_tag_bind(cl_object tag, cl_object id)
+{
+	CDR(lex_env) = CONS(list(3, tag, Stag, id), CDR(lex_env));
+}
+
+void
+lex_block_bind(cl_object name, cl_object id)
+{
+	CDR(lex_env) = CONS(list(3, name, Sblock, id), CDR(lex_env));
+}
+
+cl_object
+lex_sch(cl_object alist, cl_object name, cl_object type)
+{
+	while (!endp(alist)) {
+		if (CAAR(alist) == name && CADAR(alist) == type)
+			return(CADDAR(alist));
+		alist = CDR(alist);
+	}
+	return(Cnil);
+}
+
+@(defun si::lex_env ()
+@
+	@(return lex_env)
+@)
diff --git a/src/c/list.d b/src/c/list.d
new file mode 100644
index 000000000..5e8d7d8b5
--- /dev/null
+++ b/src/c/list.d
@@ -0,0 +1,1013 @@
+/*
+    list.d -- List manipulating routines.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "ecls-inl.h"
+
+/******************************* EXPORTS ******************************/
+
+cl_object Ktest;
+cl_object Ktest_not;
+cl_object Kkey;
+cl_object Kinitial_element;
+
+/******************************* ------- ******************************/
+
+#ifdef THREADS
+#define test_function   clwp->lwp_test_function
+#define item_compared   clwp->lwp_item_compared
+#define tf              clwp->lwp_tf
+#define key_function    clwp->lwp_key_function
+#define kf              clwp->lwp_kf
+#else
+static cl_object test_function;
+static cl_object item_compared;
+static bool (*tf)();
+static cl_object key_function;
+static cl_object (*kf)();
+#endif THREADS
+
+#define TEST(x)         (*tf)(x)
+
+#define saveTEST  \
+	cl_object old_test_function = test_function;  \
+	cl_object old_item_compared = item_compared;  \
+	bool (*old_tf)() = tf;  \
+	cl_object old_key_function = key_function;  \
+	cl_object (*old_kf)() = kf;  \
+	volatile bool eflag = FALSE
+
+#define protectTEST  \
+	if (frs_push(FRS_PROTECT, Cnil)) {  \
+		eflag = TRUE;  \
+		goto L;  \
+	}
+
+#define restoreTEST  \
+L:  \
+	frs_pop();  \
+	test_function = old_test_function;  \
+	item_compared = old_item_compared;  \
+	tf = old_tf;  \
+	key_function = old_key_function;  \
+	kf = old_kf;  \
+	if (eflag) unwind(nlj_fr, nlj_tag);
+
+static bool
+test_compare(cl_object x)
+{
+	cl_object test = _funcall(3, test_function, item_compared, (*kf)(x));
+	return (test != Cnil);
+}
+
+static bool
+test_compare_not(cl_object x)
+{
+	cl_object test = _funcall(3, test_function, item_compared, (*kf)(x));
+	return (test == Cnil);
+}
+
+static bool
+test_eql(cl_object x)
+{
+	return(eql(item_compared, (*kf)(x)));
+}
+
+static cl_object
+apply_key_function(cl_object x)
+{
+	return _funcall(2, key_function, x);
+}
+
+cl_object
+identity(cl_object x)
+{
+	return(x);
+}
+
+static void
+setupTEST(cl_object item, cl_object test, cl_object test_not, cl_object key)
+{
+	item_compared = item;
+	if (test != Cnil) {
+		if (test_not != Cnil)
+		    FEerror("Both :TEST and :TEST-NOT are specified.", 0);
+		test_function = test;
+		tf = test_compare;
+	} else if (test_not != Cnil) {
+		test_function = test_not;
+		tf = test_compare_not;
+	} else
+		tf = test_eql;
+	if (key != Cnil) {
+		key_function = key;
+		kf = apply_key_function;
+	} else
+		kf = identity;
+}
+
+#define PREDICATE2(f)  \
+cl_return f ## _if(int narg, cl_object pred, cl_object arg, cl_object key, cl_object val) \
+{  \
+	if (narg < 2)  \
+		FEtoo_few_arguments(&narg);  \
+	return f(narg+2, pred, arg, Ktest, Sfuncall, key, val);  \
+}  \
+\
+cl_return f ## _if_not(int narg, cl_object pred, cl_object arg, cl_object key, cl_object val) \
+{  \
+	if (narg < 2)  \
+		FEtoo_few_arguments(&narg);  \
+	return f(narg+2, pred, arg, Ktest_not, Sfuncall, key, val);  \
+}
+
+#define PREDICATE3(f)  \
+cl_return f ## _if(int narg, cl_object arg1, cl_object pred, cl_object arg3, cl_object key, cl_object val) \
+{  \
+	if (narg < 3)  \
+		FEtoo_few_arguments(&narg);  \
+	return f(narg+2, arg1, pred, arg3, Ktest, Sfuncall, key, val);  \
+}  \
+\
+cl_return f ## _if_not(int narg, cl_object arg1, cl_object pred, cl_object arg3, cl_object key, \
+	cl_object val)  \
+{  \
+	if (narg < 3)  \
+		FEtoo_few_arguments(&narg);  \
+	return f(narg+2, arg1, pred, arg3, Ktest_not, Sfuncall, key, val);  \
+}
+
+@(defun car (x)
+@
+	if (Null(x))
+		@(return Cnil)
+	if (ATOM(x))
+		FEtype_error_list(x);
+	@(return CAR(x))
+@)
+
+cl_object
+car(cl_object x)
+{
+	if (Null(x))
+		return(x);
+	if (CONSP(x))
+		return(CAR(x));
+	FEtype_error_list(x);
+}
+
+@(defun cdr (x)
+@
+	if (Null(x))
+		@(return Cnil)
+	if (ATOM(x))
+		FEtype_error_list(x);
+	@(return CDR(x))
+@)
+
+cl_object
+cdr(cl_object x)
+{
+	if (Null(x))
+		return(x);
+	if (CONSP(x))
+		return(CDR(x));
+	FEtype_error_list(x);
+}
+
+@(defun list (&rest args)
+	cl_object list = Cnil, z;
+@
+	if (narg-- != 0) {
+		list = z = CONS(va_arg(args, cl_object), Cnil);
+		while (narg-- > 0) 
+			z = CDR(z) = CONS(va_arg(args, cl_object), Cnil);
+		}
+	@(return list)
+@)
+
+cl_object
+list(int narg, ...)
+{
+	cl_object p = Cnil, *z = &p;
+	va_list args;
+
+	va_start(args, narg);
+	while (narg-- > 0)
+		z = &CDR(*z = CONS(va_arg(args, cl_object), Cnil));
+	return(p);
+}
+
+@(defun listA (&rest args)
+	cl_object p = Cnil, *z=&p;
+@
+	if (narg == 0)
+		FEtoo_few_arguments(&narg);
+	while (--narg > 0)
+	  z = &CDR( *z = CONS(va_arg(args, cl_object), Cnil));
+	*z = va_arg(args, cl_object);
+	@(return p)
+@)
+
+cl_object
+listA(int narg, ...)
+{
+	cl_object p = Cnil, *z = &p;
+	va_list args;
+
+	va_start(args, narg);
+	while (--narg > 0)
+	  z = &CDR( *z = CONS(va_arg(args, cl_object), Cnil));
+	*z = va_arg(args, cl_object);
+	return(p);
+}
+
+static void
+copy_list_to(cl_object x, cl_object **z)
+{
+	cl_object *y;
+
+	y = *z;
+	loop_for_in(x) {
+		y = &CDR(*y = CONS(CAR(x), Cnil));
+	} end_loop_for_in;
+	*z = y;
+}
+
+@(defun append (&rest rest)
+	cl_object x, *lastcdr;
+@
+	if (narg == 0)
+		x = Cnil;
+	else {
+		lastcdr = &x;
+		va_start(rest, narg);
+		while (narg-- > 1)
+			copy_list_to(va_arg(rest, cl_object), &lastcdr);
+		*lastcdr = va_arg(rest, cl_object);
+	}
+	@(return x)
+@)
+
+cl_object
+append(cl_object x, cl_object y)
+{
+	cl_object w, *z;
+
+	z = &w;
+	copy_list_to(x, &z);
+	*z = y;
+	return(w);
+}
+
+#if 1
+/* Open coded CARs and CDRs */
+#define car(foo) \
+	(void)foo; \
+	if (x != Cnil) { \
+	   if (CONSP(x)) \
+	     x = x->cons.car; \
+	   else \
+	     goto E; \
+	}
+#define cdr(foo) \
+	(void)foo; \
+	if (x != Cnil) { \
+	   if (CONSP(x)) \
+	     x = x->cons.cdr; \
+	   else \
+	     goto E; \
+	}
+#define defcxr(name, arg, code) \
+cl_object name(cl_object foo) { \
+	cl_object arg = foo; \
+	code; return x; \
+E:	FEtype_error_list(arg);} \
+cl_return L##name(int narg, cl_object arg) { \
+	check_arg(1); \
+	return1(name(arg)); \
+}
+#else
+#define defcxr(name, arg, code) \
+cl_object name(cl_object arg) { return code; } \
+cl_return L##name(int narg, cl_object arg) { \
+	check_arg(1); \
+	return1(name(arg)); \
+}
+#endif
+
+defcxr(caar, x, car(car(x)))
+defcxr(cadr, x, car(cdr(x)))
+defcxr(cdar, x, cdr(car(x)))
+defcxr(cddr, x, cdr(cdr(x)))
+defcxr(caaar, x, car(car(car(x))))
+defcxr(caadr, x, car(car(cdr(x))))
+defcxr(cadar, x, car(cdr(car(x))))
+defcxr(caddr, x, car(cdr(cdr(x))))
+defcxr(cdaar, x, cdr(car(car(x))))
+defcxr(cdadr, x, cdr(car(cdr(x))))
+defcxr(cddar, x, cdr(cdr(car(x))))
+defcxr(cdddr, x, cdr(cdr(cdr(x))))
+defcxr(caaaar, x, car(car(car(car(x)))))
+defcxr(caaadr, x, car(car(car(cdr(x)))))
+defcxr(caadar, x, car(car(cdr(car(x)))))
+defcxr(caaddr, x, car(car(cdr(cdr(x)))))
+defcxr(cadaar, x, car(cdr(car(car(x)))))
+defcxr(cadadr, x, car(cdr(car(cdr(x)))))
+defcxr(caddar, x, car(cdr(cdr(car(x)))))
+defcxr(cadddr, x, car(cdr(cdr(cdr(x)))))
+defcxr(cdaaar, x, cdr(car(car(car(x)))))
+defcxr(cdaadr, x, cdr(car(car(cdr(x)))))
+defcxr(cdadar, x, cdr(car(cdr(car(x)))))
+defcxr(cdaddr, x, cdr(car(cdr(cdr(x)))))
+defcxr(cddaar, x, cdr(cdr(car(car(x)))))
+defcxr(cddadr, x, cdr(cdr(car(cdr(x)))))
+defcxr(cdddar, x, cdr(cdr(cdr(car(x)))))
+defcxr(cddddr, x, cdr(cdr(cdr(cdr(x)))))
+#undef car
+#undef cdr
+
+#define LENTH(n) (int narg, cl_object x) {\
+	check_arg(1);\
+	return1(nth(n, x));\
+}
+cl_return Lfifth	LENTH(4)
+cl_return Lsixth	LENTH(5)
+cl_return Lseventh	LENTH(6)
+cl_return Leighth	LENTH(7)
+cl_return Lninth	LENTH(8)
+cl_return Ltenth	LENTH(9)
+#undef LENTH
+
+@(defun cons (car cdr)
+@
+	@(return CONS(car, cdr))
+@)
+
+static bool
+tree_equal(cl_object x, cl_object y)
+{
+	cs_check(x);
+
+BEGIN:
+	if (CONSP(x))
+		if (CONSP(y))
+			if (tree_equal(CAR(x), CAR(y))) {
+				x = CDR(x);
+				y = CDR(y);
+				goto BEGIN;
+			} else
+				return(FALSE);
+		else
+			return(FALSE);
+	else {
+		item_compared = x;
+		if (TEST(y))
+			return(TRUE);
+		else
+			return(FALSE);
+	}
+}
+
+@(defun tree_equal (x y &key test test_not)
+@
+	setupTEST(Cnil, test, test_not, Cnil);
+	if (tree_equal(x, y))
+		@(return Ct)
+	else
+		@(return Cnil)
+@)
+
+@(defun endp (x)
+@
+	if (Null(x))
+		@(return Ct)
+	if (CONSP(x))
+		@(return Cnil)
+	FEtype_error_list(x);
+@)
+
+bool
+endp1(cl_object x)
+{
+	if (CONSP(x))
+		return(FALSE);
+	if (Null(x))
+		return(TRUE);
+	FEtype_error_list(x);
+}
+
+cl_object
+list_length(cl_object x)
+{
+	cl_fixnum n;
+	cl_object fast, slow;
+
+	/* INV: A list's length always fits in a fixnum */
+	fast = slow = x;
+	for (n = 0; CONSP(fast); n++, fast = CDR(fast)) {
+		if (n & 1) {
+			/* Circular list? */
+			if (slow == fast) return Cnil;
+			slow = CDR(slow);
+		}
+	}
+	if (fast != Cnil)
+		FEtype_error_proper_list(x);
+	return MAKE_FIXNUM(n);
+}
+
+@(defun list_length (x)
+@
+	@(return list_length(x))
+@)
+
+@(defun nth (n x)
+@
+	@(return nth(fixint(n), x))
+@)
+
+cl_object
+nth(cl_fixnum n, cl_object x)
+{
+	if (n < 0)
+		FEtype_error_index(MAKE_FIXNUM(n));
+	/* INV: No need to check for circularity since we visit
+	   at most `n' conses */
+	for (; n > 0 && CONSP(x); n--)
+		x = CDR(x);
+	if (x == Cnil)
+		return Cnil;
+	if (CONSP(x))
+		return CAR(x);
+	FEtype_error_list(x);
+}
+
+@(defun nthcdr (n x)
+@
+	@(return nthcdr(fixint(n), x))
+@)
+
+cl_object
+nthcdr(cl_fixnum n, cl_object x)
+{
+	if (n < 0)
+		FEtype_error_index(MAKE_FIXNUM(n));
+	while (n-- > 0 && !ENDP(x))
+		x = CDR(x);
+	return(x);
+}
+
+@(defun last (l &optional (k MAKE_FIXNUM(1)))
+	cl_object r;
+	cl_fixnum n;
+@
+	n = fixnnint(k);
+	r = l;
+	loop_for_on(l) {
+		if (n) n--; else r = CDR(r);
+	} end_loop_for_on;
+	@(return r)
+@)
+
+@(defun make_list (size &key initial_element &aux x)
+	cl_fixnum i;
+@
+	if (!FIXNUMP(size))
+		FEerror("Cannot make a list of the size ~D.", 1, size);
+	i = fixnnint(size);
+	while (i-- > 0)
+		x = CONS(initial_element, x);
+	@(return x)
+@)
+
+@(defun copy_list (x)
+@
+	@(return copy_list(x))
+@)
+
+/*
+	Copy_list(x) copies list x.
+*/
+cl_object
+copy_list(cl_object x)
+{
+	cl_object copy;
+	cl_object *y = &copy;
+
+	loop_for_on(x) {
+		y = &CDR(*y = CONS(CAR(x), Cnil));
+	} end_loop_for_on;
+	*y = x;
+	return copy;
+}
+
+@(defun copy_alist (x)
+@
+	@(return copy_alist(x))
+@)
+
+/*
+	Copy_alist(x) copies alist x.
+*/
+cl_object
+copy_alist(cl_object x)
+{
+	cl_object copy;
+	cl_object *y = &copy;
+
+	loop_for_on(x) {
+		cl_object pair = CAR(x);
+		if (ATOM(pair))
+			FEtype_error_alist(x);
+		*y = CONS(CONS(CAR(pair), CDR(pair)), Cnil);
+		y = &CDR(*y);
+	} end_loop_for_on;
+	*y = x;
+	return copy;
+}
+
+@(defun copy_tree (x)
+@
+	@(return copy_tree(x))
+@)
+
+/*
+	Copy_tree(x) returns a copy of tree x.
+*/
+cl_object
+copy_tree(cl_object x)
+{
+	cs_check(x);
+	if (ATOM(x))
+		return x;
+	return CONS(copy_tree(CAR(x)), copy_tree(CDR(x)));
+}
+
+@(defun revappend (x y)
+@
+	loop_for_in(x) {
+		y = CONS(CAR(x),y);
+	} end_loop_for_in;
+	@(return y)
+@)
+
+@(defun nconc (&rest lists)
+	cl_object x, l,*lastcdr;
+@	
+	if (narg < 1)
+		@(return Cnil)
+	lastcdr = &x;
+	while (narg-- > 1) {
+		*lastcdr = l = va_arg(lists, cl_object);
+		loop_for_on(l) {
+			lastcdr = &CDR(l);
+		} end_loop_for_on;
+	}
+	*lastcdr = va_arg(lists, cl_object);
+	@(return x)
+@)
+
+cl_object
+nconc(cl_object l, cl_object y)
+{
+	cl_object x = l, x1;
+
+	if (x == Cnil)
+		return y;
+	/* INV: This loop is run at least once */
+	loop_for_on(x) {
+		x1 = x;
+	} end_loop_for_on;
+	CDR(x1) = y;
+	return l;
+}
+
+@(defun reconc (l y)
+	cl_object x, z;
+@
+	/* INV: when a circular list is "reconc'ed", the pointer ends
+	   up at the beginning of the original list, hence we need no
+	   slow pointer */
+	for (x = l; CONSP(x); ) {
+		z = x;
+		x = CDR(x);
+		if (x == l) FEcircular_list(l);
+		CDR(z) = y;
+		y = z;
+	}
+	if (x != Cnil)
+		FEtype_error_proper_list(l);
+	@(return y)
+@)
+
+/* CONTINUE HERE!!!! */
+@(defun butlast (lis &optional (nn MAKE_FIXNUM(1)))
+	cl_object r, res = Cnil, *fill = &res;
+	cl_fixnum delay;
+@
+	/* INV: No list has more than MOST_POSITIVE_FIX elements */
+	if (!FIXNUMP(nn))
+		@(return Cnil)
+	delay = fixnnint(nn);
+	r = lis;
+	loop_for_on(lis) {
+		if (delay)
+			delay--;
+		else {
+			fill = &CDR(*fill = CONS(CAR(r), Cnil));
+			r = CDR(r);
+		}
+	} end_loop_for_on;
+	@(return res)
+@)
+
+@(defun nbutlast (lis &optional (nn MAKE_FIXNUM(1)))
+	cl_fixnum delay;
+	cl_object x, r;
+@
+	/* INV: No list has more than MOST_POSITIVE_FIX elements */
+	if (!FIXNUMP(nn))
+		@(return Cnil)
+	/* We add 1 because at the end `r' must point to the
+	   cons that must be modified */
+	delay = fixnnint(nn)+1;
+	r = x = lis;
+	loop_for_on(x) {
+		if (delay) delay--; else r = CDR(r);
+	} end_loop_for_on;
+	if (delay > 0)
+		/* nn > length(lis) */
+		lis = Cnil;
+	else
+		CDR(r) = Cnil;
+	@(return lis)
+@)
+
+@(defun ldiff (x y)
+	cl_object res = Cnil, *fill = &res;
+@
+	loop_for_on(x) {
+		if (x == y)
+			break;
+		else
+			fill = &CDR(*fill = CONS(CAR(x), Cnil));
+	} end_loop_for_on;
+	@(return res)
+@)
+
+@(defun rplaca (x v)
+@
+	assert_type_cons(x);
+	CAR(x) = v;
+	@(return x)
+@)
+
+@(defun rplacd (x v)
+@
+	assert_type_cons(x);
+	CDR(x) = v;
+	@(return x)
+@)
+
+@(defun subst (new old tree &key test test_not key)
+	saveTEST;
+@
+	protectTEST;
+	setupTEST(old, test, test_not, key);
+	tree = subst(new, tree);
+	restoreTEST;
+	@(return tree)
+@)
+
+
+/*
+	Subst(new, tree) returns
+	the result of substituting new in tree.
+*/
+cl_object
+subst(cl_object new, cl_object tree)
+{
+	cs_check(new);
+
+	if (TEST(tree))
+		return(new);
+	else if (CONSP(tree))
+		return(CONS(subst(new, CAR(tree)), subst(new, CDR(tree))));
+	else
+		return(tree);
+}
+
+PREDICATE3(Lsubst)
+
+@(defun nsubst (new old tree &key test test_not key)
+	saveTEST;
+@
+	protectTEST;
+	setupTEST(old, test, test_not, key);
+	nsubst(new, &tree);
+	restoreTEST;
+	@(return tree)
+@)
+
+/*
+	Nsubst(new, treep) stores
+	the result of nsubstituting new in *treep
+	to *treep.
+*/
+void
+nsubst(cl_object new, cl_object *treep)
+{
+	cs_check(new);
+
+	if (TEST(*treep))
+		*treep = new;
+	else if (CONSP(*treep)) {
+		nsubst(new, &CAR(*treep));
+		nsubst(new, &CDR(*treep));
+	}
+}
+
+PREDICATE3(Lnsubst)
+
+@(defun sublis (alist tree &key test test_not key)
+	saveTEST;
+@
+	protectTEST;
+	setupTEST(Cnil, test, test_not, key);
+	tree = sublis(alist, tree);
+	restoreTEST;
+	@(return tree)
+@)
+
+/*
+	Sublis(alist, tree) returns
+	result of substituting tree by alist.
+*/
+cl_object
+sublis(cl_object alist, cl_object tree)
+{
+	cl_object x = alist;
+
+	cs_check(alist);
+	loop_for_in(x) {
+		item_compared = car(CAR(x));
+		if (TEST(tree)) return(cdr(CAR(x)));
+	} end_loop_for_in;
+	if (CONSP(tree))
+		return(CONS(sublis(alist, CAR(tree)), sublis(alist, CDR(tree))));
+	else
+		return(tree);
+}
+
+@(defun nsublis (alist tree &key test test_not key)
+	saveTEST;
+@
+	protectTEST;
+	setupTEST(Cnil, test, test_not, key);
+	nsublis(alist, &tree);
+	restoreTEST;
+	@(return tree)
+@)
+
+/*
+	Nsublis(alist, treep) stores
+	the result of substiting *treep by alist
+	to *treep.
+*/
+void
+nsublis(cl_object alist, cl_object *treep)
+{
+	cl_object x = alist;
+
+	cs_check(alist);
+	loop_for_in(x) {
+		item_compared = car(CAR(x));
+		if (TEST(*treep)) {
+			*treep = CDAR(x);
+			return;
+		}
+	} end_loop_for_in;
+	if (CONSP(*treep)) {
+		nsublis(alist, &CAR(*treep));
+		nsublis(alist, &CDR(*treep));
+	}
+}
+
+@(defun member (item list &key test test_not key)
+	saveTEST;
+@
+	protectTEST;
+	setupTEST(item, test, test_not, key);
+	loop_for_in(list) {
+		if (TEST(CAR(list)))
+			goto L;
+	} end_loop_for_in;
+	restoreTEST;
+	@(return list)
+@)
+
+bool
+member_eq(cl_object x, cl_object l)
+{
+	loop_for_in(l) {
+		if (x == CAR(l))
+			return(TRUE);
+	} end_loop_for_in;
+	return(FALSE);
+}
+
+@(defun si::memq (x l)
+@
+	loop_for_in(l) {
+		if (x == CAR(l))
+			@(return l)
+	} end_loop_for_in;
+	@(return Cnil)
+@)
+
+/* Added for use by the compiler, instead of open coding them. Beppe */
+cl_object
+memq(cl_object x, cl_object l)
+{
+	loop_for_in(l) {
+		if (x == CAR(l))
+			return(l);
+	} end_loop_for_in;
+	return(Cnil);
+}
+
+cl_object
+memql(cl_object x, cl_object l)
+{
+	loop_for_in(l) {
+		if (eql(x, CAR(l)))
+			return(l);
+	} end_loop_for_in;
+	return(Cnil);
+}
+
+cl_object
+member(cl_object x, cl_object l)
+{
+	loop_for_in(l) {
+		if (equal(x, CAR(l)))
+			return(l);
+	} end_loop_for_in;
+	return(Cnil);
+}
+/* End of addition. Beppe */
+
+PREDICATE2(Lmember)
+
+@(defun member1 (item list &key test test_not key)
+	saveTEST;
+@
+	protectTEST;
+	if (key != Cnil)
+		item = _funcall(2, key, item);
+	setupTEST(item, test, test_not, key);
+	loop_for_in(list) {
+		if (TEST(CAR(list)))
+			goto L;
+	} end_loop_for_in;
+	restoreTEST;
+	@(return list)
+@)
+
+@(defun tailp (y x)
+@
+	loop_for_on(x) {
+		if (x == y)
+			@(return Ct)
+	} end_loop_for_on;
+	@(return ((x == y)? Ct : Cnil))
+@)
+
+cl_return
+Ladjoin(int narg, cl_object item, cl_object list, cl_object k1, cl_object v1,
+	 cl_object k2, cl_object v2, cl_object k3, cl_object v3)
+{
+	cl_object output;
+
+	if (narg < 2)
+		FEtoo_few_arguments(&narg);
+	output = Lmember1(narg, item, list, k1, v1, k2, v2, k3, v3);
+	if (Null(output))
+		output = CONS(item, list);
+	else
+		output = list;
+	return1(output);
+}
+
+@(defun acons (x y z)
+@
+	@(return CONS(CONS(x, y), z))
+@)
+
+@(defun pairlis (keys data &optional a_list)
+	cl_object k, d;
+@
+	k = keys;
+	d = data;
+	loop_for_in(k) {
+		if (ENDP(d))
+			goto error;
+		a_list = CONS(CONS(CAR(k), CAR(d)), a_list);
+		d = CDR(d);
+	} end_loop_for_in;
+	if (!ENDP(d))
+error:	    FEerror("The keys ~S and the data ~S are not of the same length",
+		    2, keys, data);
+	@(return a_list)
+@)
+
+
+@(defun assoc_or_rassoc(cl_object (*car_or_cdr)())
+		       (item a_list &key test test_not key)
+	saveTEST;
+@
+	protectTEST;
+	setupTEST(item, test, test_not, key);
+	loop_for_in(a_list) {
+	  cl_object pair = CAR(a_list);
+	  if (Null(pair))
+	    ;
+	  else if (ATOM(pair))
+	    FEtype_error_alist(pair);
+	  else if (TEST((*car_or_cdr)(CAR(a_list)))) {
+	    a_list = CAR(a_list);
+	    goto L;
+	  }
+	} end_loop_for_in;
+	restoreTEST;
+	@(return a_list)
+@)
+
+cl_return
+Lrassoc(int narg, cl_object item, cl_object alist, cl_object k1, cl_object v1,
+	 cl_object k2, cl_object v2)
+	{ return Lassoc_or_rassoc(narg, cdr, item, alist, k1, v1, k2, v2); }
+cl_return
+Lassoc(int narg, cl_object item, cl_object alist, cl_object k1, cl_object v1,
+	 cl_object k2, cl_object v2)
+	{ return Lassoc_or_rassoc(narg, car, item, alist, k1, v1, k2, v2); }
+
+/* Added for use by the compiler, instead of open coding them. Beppe */
+cl_object
+assq(cl_object x, cl_object l)
+{
+	loop_for_in(l) {
+		if (x == CAAR(l))
+			return(CAR(l));
+	} end_loop_for_in;
+	return(Cnil);
+}
+
+cl_object
+assql(cl_object x, cl_object l)
+{
+	loop_for_in(l) {
+		if (eql(x, CAAR(l)))
+			return(CAR(l));
+	} end_loop_for_in;
+	return(Cnil);
+}
+
+cl_object
+assoc(cl_object x, cl_object l)
+{
+	loop_for_in(l) {
+		if (equal(x, CAAR(l)))
+			return(CAR(l));
+	} end_loop_for_in;
+	return(Cnil);
+}
+
+cl_object
+assqlp(cl_object x, cl_object l)
+{
+	loop_for_in(l) {
+		if (equalp(x, CAR(CAR(l))))
+			return(CAR(l));
+	} end_loop_for_in;
+	return(Cnil);
+}
+/* End of addition. Beppe */
+
+PREDICATE2(Lassoc)
+PREDICATE2(Lrassoc)
diff --git a/src/c/load.d b/src/c/load.d
new file mode 100644
index 000000000..2b652842c
--- /dev/null
+++ b/src/c/load.d
@@ -0,0 +1,257 @@
+/*
+    load.d -- Binary loader (contains also open_fasl_data).
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi and William F. Schelter.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "ecls-inl.h"
+
+#ifdef __mips
+#include <sys/cachectl.h>
+#endif __mips
+
+/******************************* ------- ******************************/
+
+cl_object Kverbose;
+cl_object Vload_verbose;
+cl_object Vload_print;
+cl_object siVload_hooks;
+#ifdef PDE
+cl_object siVsource_pathname;
+#endif PDE
+#ifdef RSYM
+cl_object siVsymbol_table;
+#endif
+
+@(defun si::load_binary (filename verbose print)
+	cl_object block;
+@
+	block = alloc_object(t_codeblock);
+	block->cblock.name = filename;
+	dld(filename->string.self, &block->cblock.start, &block->cblock.size);
+
+	if (!Null(verbose)) {
+		write_str(";;; Address = ");
+		PRINTescape = FALSE;
+		write_addr(block->cblock.start);
+		write_str("\n");
+	}
+	/* call the init_code function */
+#ifdef __mips
+	cacheflush(block->cblock.start, block->cblock.size, BCACHE);
+#endif __mips
+#ifdef __NeXT__
+	asm("trap #2");		/* MC68040-specific */
+#endif __NeXT__
+	read_VV(block, block->cblock.start);
+	@(return Ct)
+@)
+
+@(defun si::load_source (filename verbose print)
+	cl_object x, strm;
+	cl_object (*old_read_ch_fun)() = read_ch_fun;
+@
+	strm = open_stream(filename, smm_input, Cnil, Cnil);
+	if (Null(strm))
+		@(return Cnil)
+	if (frs_push(FRS_PROTECT, Cnil)) {
+		close_stream(strm, TRUE);
+		frs_pop();
+		unwind(nlj_fr, nlj_tag);
+	}
+	bds_bind(Vstandard_input, strm);
+	for (;;) {
+		preserving_whitespace_flag = FALSE;
+		detect_eos_flag = TRUE;
+		read_ch_fun = readc; /* setup for read. Beppe */
+		x = read_object_non_recursive(strm);
+		read_ch_fun = old_read_ch_fun;
+		if (x == OBJNULL)
+			break;
+		{
+			cl_object lex_old = lex_env;
+			cl_object bytecodes = Cnil;
+
+			lex_new();
+			eval(x, &bytecodes);
+			lex_env = lex_old;
+		}
+		if (print != Cnil) {
+			setupPRINT(x, symbol_value(Vstandard_output));
+			write_object(x, 0);
+			write_str("\n");
+			cleanupPRINT();
+			flush_stream(PRINTstream);
+		}
+	}
+	close_stream(strm, TRUE);
+	frs_pop();
+@)	
+
+@(defun load (pathname
+	      &key (verbose symbol_value(Vload_verbose))
+		   (print symbol_value(Vload_print))
+		   (if_does_not_exist Kerror)
+	      &aux pntype hooks filename function defaults)
+	bds_ptr old_bds_top;
+@
+	pathname = coerce_to_physical_pathname(pathname);
+	defaults = symbol_value(Vdefault_pathname_defaults);
+	defaults = coerce_to_physical_pathname(defaults);
+	pathname = merge_pathnames(pathname, defaults, Knewest);
+	pntype   = pathname->pathname.type;
+
+	filename = Cnil;
+	hooks = symbol_value(siVload_hooks);
+	if (!Null(pntype) && (pntype != Kwild)) {
+		/* If filename already has an extension, make sure
+		   that the file exists */
+		filename = coerce_to_filename(pathname);
+		if (!file_exists(filename))
+			FEcannot_open(filename);
+		function = cdr(assoc(pathname->pathname.type, hooks));
+	} else loop_for_in(hooks) {
+		/* Otherwise try with known extensions until a matching
+		   file is found */
+		pathname->pathname.type = CAAR(hooks);
+		filename = coerce_to_filename(pathname);
+		function = CDAR(hooks);
+		if (file_exists(filename))
+			break;
+		else
+			filename = Cnil;
+	} end_loop_for_in;
+	if (Null(filename)) {
+		if (Null(if_does_not_exist))
+			@(return Cnil)
+		else
+			FEcannot_open(pathname);
+	}
+
+	if (verbose != Cnil) {
+		setupPRINT(filename, symbol_value(Vstandard_output));
+		if (file_column(PRINTstream) != 0)
+			write_str("\n");
+		write_str(";;; Loading ");
+		PRINTescape = FALSE;
+		write_object(filename, 0);
+		write_str("\n");
+		cleanupPRINT();
+		flush_stream(PRINTstream);
+	}
+	old_bds_top = bds_top;
+	bds_bind(Vpackage, symbol_value(Vpackage));
+#ifdef PDE
+	bds_bind(siVsource_pathname, filename);
+#endif PDE
+	if (frs_push(FRS_PROTECT, Cnil)) {
+		frs_pop();
+		bds_unwind(old_bds_top); /* Beppe says this is necessary */
+		unwind(nlj_fr, nlj_tag);
+	}
+	if (Null(function))
+		siLload_source(3, filename, verbose, print);
+	else
+		funcall(4, function, filename, verbose, print);
+	frs_pop();
+	bds_unwind(old_bds_top);
+	if (print != Cnil) {
+		setupPRINT(filename, symbol_value(Vstandard_output));
+		if (file_column(PRINTstream) != 0)
+			write_str("\n");
+		write_str(";;; Finished loading ");
+		PRINTescape = FALSE;
+		write_object(filename, 0);
+		write_str("\n");
+		cleanupPRINT();
+		flush_stream(PRINTstream);
+	}
+	@(return pathname)
+@)
+
+
+/* ----------------------------------------------------------------------
+ * Binary file loader utilities
+ * ----------------------------------------------------------------------
+ */
+#ifdef RSYM
+static int symbol_table_built = 0;
+extern int read_special_symbols(const char *);
+void
+build_symbol_table()
+{
+   cl_object file;
+   const char *tmpfile;
+   file = namestring(Lmerge_pathnames(2, SYM_VAL(siVsymbol_table),
+				      SYM_VAL(siVsystem_directory)));
+   tmpfile = file->string.self;
+   if (!symbol_table_built)
+     if (read_special_symbols(tmpfile) < 0)
+       FEerror("Could not read symbol table from ~A", 1, make_string_copy(tmpfile));
+}
+#endif
+
+const char *
+system_directory()
+{
+  cl_object dir = SYM_VAL(siVsystem_directory);
+  while (type_of(dir) != t_string)
+    FEerror("The value of sys::*system-directory* is not a string, ~A", 1, dir);
+  return dir->string.self;
+}
+
+/* ---------------------------------------------------------------------- */
+#if 0
+
+@(defun si::faslink (file lib)
+	bds_ptr old_bds_top;
+	cl_object package;
+@
+	check_type_string(&lib);
+	/* INV: coerce_to_physical_pathname() checks types */
+	file = coerce_to_filename(file);
+	file->pathname.type = FASL_string;
+	file = namestring(file);
+	package = symbol_value(Vpackage);
+	old_bds_top = bds_top;
+	bds_bind(Vpackage, package);
+	faslink(file, lib);
+	bds_unwind(old_bds_top);
+	@(return Cnil)
+@)
+#endif unix
+
+void
+init_load(void)
+{
+  cl_object load_source, load_binary;
+
+  SYM_VAL(Vload_verbose) = Ct;
+  SYM_VAL(Vload_print) = Cnil;
+#ifdef PDE
+  SYM_VAL(siVsource_pathname) = Cnil;
+#endif PDE
+
+  load_source = make_si_ordinary("LOAD-SOURCE");
+  load_binary = make_si_ordinary("LOAD-BINARY");
+  SYM_VAL(siVload_hooks) = list(4,
+				CONS(make_simple_string("o"), load_binary),
+				CONS(make_simple_string("lsp"), load_source),
+				CONS(make_simple_string("lisp"), load_source),
+				CONS(Cnil, load_source));
+
+#ifdef RSYM
+  SYM_VAL(siVsymbol_table) = make_simple_string("ecl.sym");
+#endif
+}
diff --git a/src/c/lwp.d b/src/c/lwp.d
new file mode 100644
index 000000000..1909f1b73
--- /dev/null
+++ b/src/c/lwp.d
@@ -0,0 +1,871 @@
+/*
+    lwp.d -- Light weight processes.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+/******************************* EXPORTS ******************************/
+
+lpd main_lpd;
+lpd *clwp = &main_lpd;
+int critical_level = 0;
+pd *running_head;		/* front of running pd's  */
+pd *running_tail;		/* back of running pd's   */
+pd main_pd;
+
+/******************************* IMPORTS ******************************/
+
+extern scheduler_interruption; /* in unixint.c */
+extern int writec_PRINTstream();
+extern cl_object readc();
+extern gc();
+extern enum type garbage_parameter;
+
+/******************************* ------- ******************************/
+
+#define thread_switch()  { setTimer(0); enable_scheduler(); \
+			     scheduler(0, 0, NULL); }
+
+static bool timer_active = FALSE;
+static bool scheduler_disabled = FALSE;
+static int scheduler_level = 0;            /* tito */
+static bool reset_timer = FALSE;
+static int running_processes = 1;
+static int absolute_time = 0;
+
+cl_object Srunning;
+cl_object Ssuspended;
+cl_object Swaiting;
+cl_object Sstopped;
+cl_object Sdead;
+cl_object siSthread_top_level;
+
+static cl_object main_thread;
+
+static
+setTimer(long time)
+{
+  struct itimerval oldtimer;
+  struct itimerval itimer;
+  itimer.it_value.tv_sec = 0;
+  itimer.it_value.tv_usec = time;
+  itimer.it_interval.tv_sec = 0;
+  itimer.it_interval.tv_usec = 0;
+  setitimer(ITIMER_REAL, &itimer, &oldtimer);
+}
+
+pd *
+dequeue()
+{
+  pd *tmp;
+  tmp = running_head;
+  if  (running_head != NULL)
+    running_head = running_head->pd_next;
+  return tmp;
+}
+
+pd *
+make_pd()
+{
+  pd *new_pd; lpd *npd;
+  int i;
+  
+  /* Allocate a new descriptor for the new lwp */
+  new_pd = (pd *)malloc(sizeof(pd));
+  
+  /* create a new stack ... */
+  new_pd->pd_base = (int *)malloc(STACK_SIZE * sizeof(int));
+  new_pd->pd_status = SUSPENDED;
+
+  /* allocate a lisp descriptor:
+   * using the calloc here it's possible to avoid the
+   * critical section in the various push operations
+   */
+  npd = new_pd->pd_lpd = (lpd *)calloc(sizeof(lpd), 1);
+
+  /* initialize it */
+
+  /* bind stack */
+  npd->lwp_bdssize = BDSSIZE + 2*BDSGETA;
+  npd->lwp_bdsorg = malloc(npd->lwp_bdssize * sizeof(*npd->lwp_bdsorg));
+  npd->lwp_bdstop = npd->lwp_bdsorg-1;
+  npd->lwp_bdslimit = &npd->lwp_bdsorg[npd->lwp_bdssize - 2*BDSGETA];
+
+  /* C stack */
+  /* cssize is different now for the main thread only, but you might
+     want to create threads with different stack sizes             */
+
+#ifdef DOWN_STACK
+  npd->lwp_cs_org = new_pd->pd_base + STACK_SIZE - 1;
+  npd->lwp_cs_limit = new_pd->pd_base - 1;
+#else
+  npd->lwp_cs_org = new_pd->pd_base;
+  npd->lwp_cs_limit = npd->lwp_cs_org + STACK_SIZE;
+#endif    
+  /* invocation history stack */
+  npd->lwp_ihssize = IHSSIZE + 2*IHSGETA;
+  npd->lwp_ihsorg = malloc(npd->lwp_ihssize * sizeof(*npd->lwp_ihsorg));
+  npd->lwp_ihstop = npd->lwp_ihsorg-1;
+  npd->lwp_ihslimit = &npd->lwp_ihsorg[npd->lwp_ihssize - 2*IHSGETA];
+  /* frame stack */
+  npd->lwp_frs_size = FRSSIZE + 2*FRSGETA;
+  npd->lwp_frs_org = malloc(npd->lwp_frs_size * sizeof(*npd->lwp_frs_org));
+  npd->lwp_frs_top = npd->lwp_frs_org-1;
+  npd->lwp_frs_limit = &npd->lwp_frs_org[npd->lwp_frs_size - 2*FRSGETA];
+  
+  npd->lwp_alloc_temporary = OBJNULL;
+  npd->lwp_backq_level = 0;
+  npd->lwp_eval1 = 0;
+  /* for gc */
+  npd->lwp_fmt_temporary_stream = OBJNULL;
+  npd->lwp_fmt_temporary_string = OBJNULL;
+  
+  npd->lwp_PRINTstream = Cnil;
+  npd->lwp_PRINTescape = TRUE;
+  npd->lwp_PRINTpretty = FALSE;
+  npd->lwp_PRINTcircle = FALSE;
+  npd->lwp_PRINTbase = 10;
+  npd->lwp_PRINTradix = FALSE;
+  npd->lwp_PRINTcase = Kdowncase;
+  npd->lwp_PRINTgensym = TRUE;
+  npd->lwp_PRINTlevel = -1;
+  npd->lwp_PRINTlength = -1;
+  npd->lwp_PRINTarray = FALSE;
+  npd->lwp_write_ch_fun = writec_PRINTstream;
+  npd->lwp_output_ch_fun = writec_PRINTstream;
+  npd->lwp_read_ch_fun = readc;
+  
+  npd->lwp_READtable  = symbol_value(Vreadtable);
+  npd->lwp_READdefault_float_format = 'S';
+  npd->lwp_READbase = 10;
+  npd->lwp_READsuppress = FALSE;
+  npd->lwp_delimiting_char = OBJNULL;
+  npd->lwp_detect_eos_flag = FALSE;
+  npd->lwp_in_list_flag = FALSE;
+  npd->lwp_dot_flag = FALSE;
+  npd->lwp_sharp_eq_context_max = 0;
+  
+  /* for gc */
+  npd->lwp_gensym_prefix = OBJNULL;
+  npd->lwp_gentemp_prefix = OBJNULL;
+  npd->lwp_token = OBJNULL;
+    
+  /* lex_env copy */
+  npd->lwp_lex_env = npd->lwp_lex;
+  
+  /* ihs_push(Cnil) */
+  (++npd->lwp_ihs_top)->ihs_function = Cnil;
+  npd->lwp_ihs_top->ihs_base = npd->lwp_lex_env;
+
+  /* Now the allocation. If the gc is invoked we are able to mark
+   * the objects already allocated
+   */
+  npd->lwp_fmt_temporary_stream = make_string_output_stream(64);
+  npd->lwp_fmt_temporary_string =
+    npd->lwp_fmt_temporary_stream->stream.object0;
+  
+  npd->lwp_gentemp_prefix = make_simple_string("T");
+  npd->lwp_token = alloc_simple_string(LISP_PAGESIZE);
+  npd->lwp_token->string.self = alloc_atomic(LISP_PAGESIZE);
+  npd->lwp_token->string.fillp = 0;
+  npd->lwp_token->string.hasfillp = TRUE;
+  npd->lwp_token->string.adjustable = TRUE;
+
+  for (i=0; i<3; i++)
+    npd->lwp_bignum_register[i] = alloc_object(t_bignum);
+  
+  return new_pd;
+}
+
+update_queue()
+{
+  register pd *dead_pd;
+  pd *last = running_tail;
+
+  do
+    switch (running_head->pd_status) {
+
+    case DEAD:
+
+      /* remove the dead process */
+      dead_pd = dequeue();
+      /* free the lisp descriptor */
+      free(dead_pd->pd_lpd);
+      /* free the memory allocated for the stack and the descriptor */
+      free(dead_pd->pd_base);
+      free(dead_pd);
+      break;
+
+/*    case SUSPENDED: */
+    case DELAYED:
+
+      if (running_head->pd_slice != 0) 
+	if (absolute_time > running_head->pd_slice) {
+
+	  /* the time slice has expired */
+	  running_head->pd_slice = 0;
+
+	  if ((running_head->pd_thread->thread.cont) != OBJNULL) {
+	    /* in this case a continuation was created before %delay */
+	    running_head->pd_thread->thread.cont->cn.cn_timed_out = TRUE;
+	    running_head->pd_thread->thread.cont = OBJNULL;
+	  }
+	  running_head->pd_status = RUNNING;
+	  return;		/* now you are a running process */
+	}
+      ROTQUEUE();
+      break;
+	  
+    case WAITING:		/* waiting processes need to be scheduled  */
+    case RUNNING:
+      return;			/* found schedulable process */
+	
+    default:			/* currently is only STOPPED */
+      ROTQUEUE();
+      break;
+    }
+  while (running_head != last);
+}
+
+activate_thread(cl_object thread)
+{
+  pd *npd = thread->thread.data;
+
+  /* jump on the new C stack */
+  if (sigsetjmp(npd->pd_env, 1) == 0) {
+#define STACK_MARGIN 160	/* longjmp writes also under the sp level */
+#ifdef DOWN_STACK
+# ifdef __linux
+    npd->pd_env[0].__jmpbuf[0].__sp =
+      stack_align((int)(npd->pd_base) + sizeof(int)*STACK_SIZE - STACK_MARGIN);
+    npd->pd_lpd->lwp_cssize =
+      npd->pd_env[0].__jmpbuf[0].__sp - (int)npd->pd_base;
+# else
+    npd->pd_env[JB_SP] =
+      stack_align((int)(npd->pd_base) + sizeof(int)*STACK_SIZE - STACK_MARGIN);
+    npd->pd_lpd->lwp_cssize =
+      npd->pd_env[JB_SP] - (int)npd->pd_base;
+# endif
+#else
+    npd->pd_env[JB_SP] =
+      stack_align((int)(npd->pd_base));
+    npd->pd_lpd->lwp_cssize = sizeof(int) * STACK_SIZE - STACK_MARGIN;
+#endif DOWN_STACK
+#ifdef JB_FP
+    npd->pd_env[JB_FP] = npd->pd_env[JB_SP];
+#endif
+    return;
+  }
+
+  /* Back here when thread is first resumed.
+   *
+   * WARNING: args and locals are no more accessible from here on,
+   * since we reenter with longjmp onto a new stack.
+   */
+  
+#ifndef sun4sol2
+  /* on SunOS sigmask is 0x82001 here */
+  sigsetmask(sigblock(0) & ~(sigmask(SIGALRM)));
+#endif
+
+  { int i;
+    for (i = clwp->lwp_nValues; i > 0;)
+      VALUES(i) = VALUES(--i);
+    VALUES(0) = clwp->lwp_thread->thread.entry;
+    apply(clwp->lwp_nValues+1, siSthread_top_level, &VALUES(0));
+  }
+  /* Termination */
+  
+  terpri(Cnil);
+  running_head->pd_status = DEAD;
+  running_head->pd_thread->thread.data = NULL;
+  running_processes--;
+
+  update_queue();
+  thread_next();		/* update_queue has freed our stack!!! */
+}
+
+/*
+ * switch to the first thread on queue
+ */
+thread_next()
+{
+  /* unwind the bind stack */
+  lwp_bds_unwind(clwp->lwp_bind_stack, clwp->lwp_bds_top);
+
+  /* switch clwp */
+  clwp = running_head->pd_lpd;
+
+  /* restore Values pointer */
+  Values = clwp->lwp_Values;
+
+  /* wind the bind stack */
+  lwp_bds_wind(clwp->lwp_bind_stack, clwp->lwp_bds_top);
+
+  /* reset the timer */
+  if (running_processes > 1) {
+    timer_active = TRUE;
+    setTimer(REALQUANTUM); 
+  } else { 
+    timer_active = FALSE;
+    absolute_time = 0;
+  }
+  siglongjmp(running_head->pd_env, 1); 
+}
+
+/*
+ * Called when time slice expires or explicitily to switch thread
+ */
+scheduler(int sig, int code, struct sigcontext *scp)
+{
+  int val;
+
+#if defined(SYSV) || defined(__svr4__) || defined(__linux)
+  signal(SIGALRM, scheduler);
+#endif SYSV
+
+  absolute_time++;
+  if (critical_level > 0) {	/* within critical section */
+    scheduler_interrupted = TRUE;
+    scheduler_interruption = SCHEDULER_INT;
+    return;
+  }
+  if (scheduler_level > 0) {	/* abilitation  check */
+    scheduler_interrupted = TRUE;
+    return;
+  }
+
+  val = sigsetjmp(running_head->pd_env, 1);
+
+  if (val == 1)			/* resume interrupted thread execution */
+    return;			/* coming back from longjmp in thread_next */
+
+  if (val == 2)			/* coming back from longjmp in GC */
+    gc(garbage_parameter);	/* GC will return to the previous thread */
+
+  ROTQUEUE();
+  thread_next();
+}
+
+/*
+ * Handle signal received within critical section
+ */
+interruption_handler()
+{
+  scheduler_interrupted = FALSE;
+
+  switch (scheduler_interruption) {
+
+  case SCHEDULER_INT:
+    thread_switch();
+    break;
+
+  case ERROR_INT:
+    sigint();
+    break;
+  }
+}
+
+lwp_bds_wind(bds_ptr base, bds_ptr top)
+{
+  cl_object temp;
+
+  for (; top >= base; base++) {
+    temp = SYM_VAL(base->bds_sym);
+    SYM_VAL(base->bds_sym) = base->bds_val;
+    base->bds_val = temp;
+  }
+}
+
+lwp_bds_unwind(bds_ptr base, bds_ptr top)
+{
+  cl_object temp;
+
+  for (; top >= base; top--) {
+    temp = SYM_VAL(top->bds_sym);
+    SYM_VAL(top->bds_sym) = top->bds_val;
+    top->bds_val = temp;
+  }
+}
+
+resume(pd *rpd)
+{
+  register pd *p;
+
+  start_critical_section();
+  running_processes++;
+
+  rpd->pd_status = RUNNING;
+  for (p = running_head; (p != rpd) && (p != NULL); p = p->pd_next) ;
+  if (p == NULL)
+    ENQUEUE(rpd);
+  end_critical_section();
+
+  if (!timer_active)  {
+    timer_active = TRUE;
+    setTimer(REALQUANTUM);
+  }
+}
+
+/***********
+ *
+ * THREADS
+ *
+ ***********/
+
+
+@(defun si::thread_break_in ()
+@
+	alarm(0);
+	@(return Cnil)
+@)
+
+@(defun si::thread_break_quit ()
+  /* reset everything in MT */
+  pd *p;
+@
+  /* this is done in any case to remedy the problem with C-c handling */
+  signal(SIGALRM, scheduler);
+
+  if (timer_active) {
+     /* reset the critical and disable-scheduler environment    */
+      scheduler_disabled = FALSE;
+      scheduler_level = 0;
+      critical_level = 0;
+      scheduler_interrupted = 0;
+
+      for (p = running_head; (p != NULL); p = p->pd_next)
+	if (p != &main_pd)
+	  p->pd_status = DEAD;
+	else {
+	  p->pd_status = RUNNING;
+	  p->pd_thread->thread.cont = OBJNULL;
+	}
+
+      if (running_head != &main_pd) {
+	update_queue();
+	thread_next(); 
+	/*  here one should deallocate the main-thread function     */
+      }
+      else
+	thread_switch();
+    }
+  @(return Cnil)
+@)
+
+@(defun si::thread_break_resume ()
+@
+  /* Restart the timer that might have been
+   * changed by the interrupt handling
+   */
+  signal(SIGALRM, scheduler);  
+  if (timer_active)
+    thread_switch();
+  @(return Cnil)
+@)
+
+@(defun thread_list ()
+  pd *p;
+  cl_object tmp, x = CONS(running_head->pd_thread, Cnil);
+@
+  tmp = x;
+  start_critical_section();
+
+  for (p = running_head->pd_next; (p != NULL); p = p->pd_next) {
+      CDR(tmp) = CONS(p->pd_thread, Cnil);
+      tmp = CDR(tmp);
+    }
+
+  end_critical_section();
+
+  @(return x)
+@)
+
+@(defun make_thread (fun)
+  cl_object x;
+  pd *npd;
+@
+  /* Just one argument for the time being */
+
+  if (SYMBOLP(fun)) {
+    if (fun->symbol.isform || fun->symbol.mflag)
+      FEinvalid_function(fun);
+    if (SYM_FUN(fun) == OBJNULL)
+      FEundefined_function(fun);
+    /*  fun = SYM_FUN(fun); confusing */
+  }
+
+  x = alloc_object(t_thread);
+  x->thread.entry = fun;
+  x->thread.size = sizeof(pd);
+  x->thread.data = npd = make_pd();
+  x->thread.cont = OBJNULL;
+
+  npd->pd_thread = x;
+  npd->pd_slice = 0;
+
+  /* Backpointer to thread */
+  npd->pd_lpd->lwp_thread = x;
+
+  activate_thread(x);
+
+  @(return x)
+@)
+
+@(defun deactivate (thread)
+@
+  if (type_of(thread) != t_thread)
+    FEwrong_type_argument(Sthread, thread);
+
+  if (thread->thread.data == NULL ||
+      thread->thread.data->pd_status != RUNNING)
+    FEerror("Cannot deactivate a thread not running", 0);
+
+  start_critical_section();	/* tito */
+  thread->thread.data->pd_status = STOPPED;
+  running_processes--;
+  if (thread->thread.data == running_head) {
+    critical_level--; /* end_critical_section() */
+    update_queue();
+    thread_next();
+  } else
+    end_critical_section();
+  @(return Cnil)
+@)
+
+@(defun reactivate (thread)
+@
+  start_critical_section();
+
+  if (type_of(thread) != t_thread) {
+    FEwrong_type_argument(Sthread, thread);
+  }
+
+  if (thread->thread.data == NULL ||
+      thread->thread.data->pd_status != STOPPED)
+    FEerror("Cannot reactivate a thread not stopped", 0);
+
+  start_critical_section();	/* tito */
+  thread->thread.data->pd_status = RUNNING;
+  running_processes++;
+
+  if (!timer_active) {
+     timer_active = TRUE;
+     setTimer(REALQUANTUM);
+   }
+
+  end_critical_section();
+  @(return Cnil)
+@)
+
+@(defun kill_thread (thread)
+@
+  /* The following code is not enough.
+     Consider: The scheduler can be disabled
+     What about killing the current thread?
+     */
+  if (type_of(thread) != t_thread)
+    FEwrong_type_argument(Sthread, thread);
+
+  if (thread->thread.data != NULL) {
+    start_critical_section();
+    thread->thread.data->pd_status = DEAD;
+    if (thread->thread.data->pd_lpd == clwp) {
+       /* if a thread kills itself the scheduler is to be called */
+       thread->thread.data = NULL;
+       critical_level--; /*  end_critical_section() */
+       update_queue();
+       thread_next();
+     }
+     else {
+       thread->thread.data = NULL;
+       end_critical_section();
+     }
+  }
+  @(return)
+@)
+
+@(defun current_thread ()
+@
+  @(return clwp->lwp_thread)
+@)
+
+@(defun thread_status (thread)
+  cl_object output;
+@
+  if (type_of(thread) != t_thread)
+    FEwrong_type_argument(Sthread, thread);
+
+  if (thread->thread.data != NULL)
+    switch (thread->thread.data->pd_status) {
+    case RUNNING:
+      output = Srunning;
+      break;
+    case SUSPENDED:
+      output = Ssuspended;
+      break;
+    case WAITING:
+      output = Swaiting;
+      break;
+    case STOPPED:
+      output = Sstopped;
+      break;
+    case DEAD:
+      output = Sdead;
+      break;
+    default:
+      FEerror("Unexpected type for thread ~A", 1, thread);
+    }
+  else
+    output = Sdead;
+  @(return output)
+@)
+
+
+/***************
+ *
+ * CONTINUATIONS
+ *
+ ***************/
+
+@(defun make_continuation (thread)
+  cl_object x;
+@
+  if (type_of(thread) != t_thread)
+    FEwrong_type_argument(Sthread, thread);
+
+  if (thread->thread.cont)
+    FEerror("A continuation for thread ~A already exists.", 1, thread);
+
+  if (thread->thread.data == NULL ||
+      thread->thread.data->pd_status == DEAD) {
+    FEerror("Thread ~A is DEAD.", 1, thread);
+  }
+
+  x = alloc_object(t_cont);
+
+  x->cn.cn_thread = thread;
+  x->cn.cn_resumed = FALSE;
+  x->cn.cn_timed_out = FALSE;
+
+  thread->thread.cont = x;
+  @(return x)
+@)
+
+/* Returns the thread associated to a continuation */
+@(defun thread_of (cont)
+@
+  if (type_of(cont) != t_cont)
+    FEwrong_type_argument(Scont, cont);
+  @(return cont->cn.cn_thread)
+@)
+
+/* Returns the continuation associated to a thread, if it exists */
+@(defun continuation_of (thread)
+@
+  if (type_of(thread) != t_thread)
+    FEwrong_type_argument(Sthread, thread);
+  @(return (thread->thread.cont? thread->thread.cont : Cnil))
+@)
+
+@(defun resume (cont &rest args)
+  int i;
+  cl_object *thread_Values;
+@
+  if (Null(cont))
+    @(return Cnil)
+
+  if (type_of(cont) != t_cont)
+    FEwrong_type_argument(Scont, cont);
+
+  if (cont->cn.cn_resumed)
+    FEerror("The continuation has already been resumed.", 0);
+  
+  if (cont->cn.cn_timed_out)
+    FEerror("The continuation has been timed out.", 0);
+
+  if (cont->cn.cn_thread->thread.data == NULL)
+    FEerror("The continuation cannot be resumed. Its thread is DEAD.", 0);
+
+  if (cont->cn.cn_thread->thread.data->pd_status != SUSPENDED &&
+      cont->cn.cn_thread->thread.data->pd_status != DELAYED)
+    FEerror("The continuation cannot be resumed. Its thread isn't suspended", 0);
+
+  /* Push the arguments on the value stack of thread */
+
+  thread_Values = cont->cn.cn_thread->thread.data->pd_lpd->lwp_Values;
+
+  for (i = 1; i < narg; i++)
+    *(thread_Values++) = va_arg(args, cl_object);
+  cont->cn.cn_thread->thread.data->pd_lpd->lwp_nValues = narg-1;
+
+  cont->cn.cn_resumed = TRUE;
+  cont->cn.cn_thread->thread.cont = OBJNULL;
+
+  /* If you are waiting on a slice expiring I reset your slice    */
+  cont->cn.cn_thread->thread.data->pd_slice = 0;
+
+  resume(cont->cn.cn_thread->thread.data);
+
+  @(return cont->cn.cn_thread)
+@)
+
+
+/***************
+ *
+ * SCHEDULING
+ *
+ ***************/
+
+@(defun disable_scheduler ()
+@
+  scheduler_level++;
+  @(return Cnil)
+@)
+
+@(defun enable_scheduler ()
+@
+  enable_scheduler();
+  @(return Cnil)
+@)
+
+enable_scheduler()
+{
+   scheduler_level = 0;
+
+   if (scheduler_interrupted) {
+     scheduler_interrupted = FALSE;
+     thread_switch();
+   }
+}
+
+@(defun suspend ()
+@
+  if (timer_active) {
+       running_head->pd_status = SUSPENDED;
+       running_processes--;
+       thread_switch();
+       /* When resumed it will be provided with the Values to return */
+#error "This is very very wrong!"
+       RETURN(running_head->pd_lpd->lwp_nValues);
+     }
+  else 
+    FEerror("No other active thread.", 0);
+@)
+
+@(defun delay (interval)
+  int z;
+@
+  z = fixnnint(interval);
+  
+  if (timer_active) {
+    running_head->pd_status = DELAYED;
+    running_processes--;
+       
+    /* Translate seconds in number of scheduler slices    */
+    running_head->pd_slice = z * 10 + absolute_time;
+
+    thread_switch();
+       
+    /* When resumed it will be provided with the Values to return */
+#error "This is very very wrong!"
+    RETURN(running_head->pd_lpd->lwp_nValues);
+  }
+  else
+    sleep(z);
+@)
+
+@(defun thread_wait (fun &rest args)
+@
+  start_critical_section();
+  running_head->pd_status = WAITING;
+  running_processes--;
+  end_critical_section();
+
+  for (;;) {
+    if (_apply(narg-1, fun, args) != Cnil)
+      break;
+    else if (timer_active) {
+      /* the time slice has not been used */
+      absolute_time--;
+      thread_switch();
+    } else
+      FEerror("The condition will never be satisfied for lack of active processes", 0);
+  }
+  running_head->pd_status = RUNNING;
+  running_processes++;
+  end_critical_section();
+  returnn();
+@)
+  
+@(defun thread_wait_with_timeout (timeout fun &rest args)
+@
+  /* We have to translate seconds in scheduler call number */
+  start_critical_section();
+  running_head->pd_slice = fixnnint(timeout) * 10 + absolute_time;
+  
+  running_head->pd_status = WAITING;
+  running_processes--;
+  end_critical_section();
+  
+  for (;;) {
+    
+    if (absolute_time > running_head->pd_slice) {
+      /* the time slice has expired */
+      VALUES(0) = Cnil;
+      NValues = 1;
+      break;
+    }
+
+    if (_apply(narg-1, fun, args) != Cnil)
+      break;
+    else {
+      /* the time slice has not been used */
+      absolute_time--;
+      thread_switch();
+    }
+  }
+  
+  start_critical_section();
+  running_head->pd_slice = 0;
+  running_head->pd_status = RUNNING;
+  running_processes++;
+  end_critical_section();
+  returnn();
+@)
+
+enable_lwp()
+{
+  signal(SIGALRM, scheduler);
+}
+
+init_lwp()
+{ pd *temp_pd;
+
+  temp_pd = &main_pd;
+  PUSH(temp_pd);
+
+  main_thread = alloc_object(t_thread);
+  main_pd.pd_thread = main_thread;
+  main_thread->thread.entry = Cnil;
+  main_thread->thread.size = sizeof (pd);
+  main_thread->thread.data = &main_pd;
+  main_thread->thread.cont = OBJNULL;
+  /* Backpointer to thread */
+  main_pd.pd_status = RUNNING;
+  main_pd.pd_lpd = &main_lpd;
+  main_lpd.lwp_thread = main_thread;
+  register_root(&main_thread);
+}
diff --git a/src/c/macros.d b/src/c/macros.d
new file mode 100644
index 000000000..cb2c07ad0
--- /dev/null
+++ b/src/c/macros.d
@@ -0,0 +1,137 @@
+/*
+    macros.c -- Macros.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+/******************************* REQUIRES ******************************/
+
+/* Requires expand-defmacro, from lsp/defmacro.lsp */
+
+/******************************* EXPORTS ******************************/
+
+cl_object Vmacroexpand_hook;
+cl_object siSexpand_defmacro;
+cl_object siVinhibit_macro_special;
+
+/******************************* ------- ******************************/
+
+/*
+	MACRO_DEF is an internal function which, given a form, returns
+	the expansion function if the form is a macro form.  Otherwise,
+	MACRO_DEF returns NIL.
+*/
+cl_object
+search_symbol_macro(cl_object name, cl_object env)
+{
+	cl_object record = assq(name, CAR(env));
+	if (CONSP(record) && CADR(record) == siSsymbol_macro)
+	  return CADDR(record);
+	return Cnil;
+}
+
+cl_object
+search_macro(cl_object name, cl_object env)
+{
+	return lex_sch(CDR(env), name, Smacro);
+}
+
+cl_object
+macro_def(cl_object form, cl_object env)
+{
+	cl_object head, fd;
+
+	if (ATOM(form)) {
+		if (!SYMBOLP(form))
+			return Cnil;
+		/* First look for SYMBOL-MACROLET definitions */
+		fd = search_symbol_macro(form, env);
+		return fd;
+	}
+	head = CAR(form);
+	if (!SYMBOLP(head))
+		return(Cnil);
+	fd = search_macro(head, env);
+	if (!Null(fd))
+		return fd;
+	else if (head->symbol.mflag)
+		return(SYM_FUN(head));
+	else
+		return(Cnil);
+}
+
+@(defun macroexpand (form &optional (env Cnil))
+	cl_object new_form = OBJNULL;
+	cl_object done = Cnil;
+@
+	new_form = macro_expand1(form, env);
+	while (new_form != form) {
+		done = Ct;
+		form = new_form;
+		new_form = macro_expand(form, env);
+	}
+	@(return new_form done)
+@)
+
+@(defun macroexpand_1 (form &optional (env Cnil))
+	cl_object new_form;
+@
+	new_form = macro_expand1(form, env);
+	@(return new_form (new_form == form? Cnil : Ct))
+@)
+
+/*
+	MACRO_EXPAND1 is an internal function which simply applies the
+	function EXP_FUN to FORM.  On return, the expanded form is stored
+	in VALUES(0).
+*/
+cl_object
+macro_expand1(cl_object form, cl_object env)
+{
+	cl_object hook, lex;
+	cl_object exp_fun;
+
+	exp_fun = macro_def(form, env);
+	if (Null(exp_fun))
+		return form;
+	hook = symbol_value(Vmacroexpand_hook);
+	if (hook == Sfuncall)
+		return funcall(3, exp_fun, form, env);
+	else
+		return funcall(4, hook, exp_fun, form, env);
+}
+
+/*
+	MACRO_EXPAND expands a form as many times as possible and returns
+	the finally expanded form.
+*/
+cl_object
+macro_expand(cl_object form, cl_object env)
+{
+	cl_object new_form;
+
+	for (new_form = OBJNULL; new_form != form; form = new_form) {
+		new_form = macro_expand1(form, env);
+	}
+	return new_form;
+}
+
+void
+init_macros(void)
+{
+	SYM_VAL(Vmacroexpand_hook) = Sfuncall;
+	SYM_VAL(siVinhibit_macro_special) = Cnil;
+}
diff --git a/src/c/main.d b/src/c/main.d
new file mode 100644
index 000000000..26b06a882
--- /dev/null
+++ b/src/c/main.d
@@ -0,0 +1,258 @@
+/*
+    main.c --
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*		********  WARNING ********
+    Do not insert any data definitions before data_start!
+    Since this is the first file linked, the address of the following
+    variable should correspond to the start of initialized data space.
+    On some systems this is a constant that is independent of the text
+    size for shared executables.  On others, it is a function of the
+    text size. In short, this seems to be the most portable way to
+    discover the start of initialized data space dynamically at runtime,
+    for either shared or unshared executables, on either swapping or
+    virtual systems.  It only requires that the linker allocate objects
+    in the order encountered, a reasonable model for most Unix systems.
+      Fred Fish, UniSoft Systems Inc.  */
+
+/*  On SGI one could use extern _fdata[] instead */
+
+int data_start = (int)&data_start;
+
+/******************************** IMPORTS *****************************/
+
+#include "ecls.h"
+#ifdef HAVE_SYS_UTSNAME_H
+# include <sys/utsname.h>
+#endif
+#ifdef TK
+# include "tk.h"
+#endif
+
+/******************************* EXPORTS ******************************/
+
+cl_object Vfeatures;
+cl_object siVsystem_directory;
+const char *ecl_self;
+
+/******************************* ------- ******************************/
+
+static int	ARGC;
+static char	**ARGV;
+
+#ifdef THREADS
+static cl_object siVthread_top;
+#endif THREADS
+static cl_object siStop_level;
+
+#if !defined(GBC_BOEHM)
+static char stdin_buf[BUFSIZ];
+static char stdout_buf[BUFSIZ];
+#endif
+
+int
+main(int argc, char **argv)
+{
+#if !defined(GBC_BOEHM)
+	setbuf(stdin,  stdin_buf);
+	setbuf(stdout, stdout_buf);
+#endif
+
+	ARGC = argc;
+	ARGV = argv;
+	ecl_self = argv[0];
+
+	init_alloc();
+	alloc_stacks(&argc);
+
+#ifndef MSDOS
+	ecl_self = expand_pathname(ecl_self);
+#endif MSDOS
+
+	/*ihs_push(Cnil, lex);*/
+	lex_new();
+
+	/* Initialize library */
+	init_lisp();
+
+	/* Jump to top level */
+	SYM_VAL(Vpackage) = user_package;
+	enable_interrupt();
+	siLcatch_bad_signals(0);
+#ifdef THREADS
+	enable_lwp();
+#endif THREADS
+#ifdef TK
+	if (getenv("DISPLAY")) {
+	  Tk_main(FALSE, /* sync */
+		  "ECL/Tk", /* name */
+		  NULL, /* file */
+		  getenv("DISPLAY"), /* Xdisplay */
+		  NULL); /* geometry */
+	}
+#endif
+	ihs_push(_intern("TOP-LEVEL", system_package), Cnil);
+	funcall(1, siStop_level);
+	return(0);
+}
+
+@(defun quit (&optional (code MAKE_FIXNUM(0)))
+	cl_fixnum i;
+@
+	if (!FIXNUMP(code))
+		FEerror("Illegal exit code: ~S.", 1, code);
+	i = fix(code);
+#ifdef THREADS
+	if (clwp != &main_lpd) {
+	  VALUES(0) = Cnil;
+	  NValues = 0;
+	  throw(siVthread_top);
+	  /* never reached */
+	}
+#endif THREADS
+	printf("Bye.\n");
+	exit(i);
+@)
+
+@(defun si::argc ()
+@
+	@(return MAKE_FIXNUM(ARGC))
+@)
+
+@(defun si::argv (index)
+	cl_fixnum i;
+@
+	if (!FIXNUMP(index) || (i = fix(index)) < 0 || i >= ARGC)
+		FEerror("Illegal argument index: ~S.", 1, index);
+	@(return make_string_copy(ARGV[i]))
+@)
+
+@(defun si::getenv (var)
+	char name[256], *value;
+	cl_index i;
+@
+	assert_type_string(var);
+	if (var->string.fillp >= 256)
+		FEerror("Too long name: ~S.", 1, var);
+	for (i = 0;  i < var->string.fillp;  i++)
+		name[i] = var->string.self[i];
+	name[i] = '\0';
+	value = getenv(name);
+	@(return ((value == NULL)? Cnil : make_string_copy(value)))
+@)
+
+@(defun si::address (x)
+@
+	@(return MAKE_FIXNUM((int)x))
+@)
+
+#ifdef HAVE_SYS_UTSNAME_H
+@(defun machine_instance ()
+	struct utsname uts;
+@
+	uname(&uts);
+	@(return make_string_copy(uts.nodename))
+@)
+
+@(defun machine_version ()
+	struct utsname uts;
+@
+	uname(&uts);
+	@(return make_string_copy(uts.machine))
+@)
+
+@(defun software_type ()
+	struct utsname uts;
+@
+	uname (&uts);
+	@(return make_string_copy(uts.sysname))
+@)
+
+@(defun software_version ()
+	struct utsname uts;
+@
+	uname (&uts);
+	@(return make_string_copy(uts.release))
+@)
+#endif
+
+void
+init_main(void)
+{
+	siStop_level=make_si_ordinary("TOP-LEVEL");
+	register_root(&siStop_level);
+
+	make_ordinary("LISP-IMPLEMENTATION-VERSION");
+
+	SYM_VAL(siVsystem_directory) = make_simple_string("./");
+
+	{ cl_object features;
+	  features =
+	    CONS(make_keyword("ECLS"),
+		 CONS(make_keyword("COMMON"), Cnil));
+
+#define ADD_FEATURE(name)	features = CONS(make_keyword(name),features)
+
+#if defined(GBC_BOEHM)
+	 ADD_FEATURE("BOEHM-GC");
+#endif
+
+#ifdef LOCATIVE
+	 ADD_FEATURE("LOCATIVE");
+#endif LOCATIVE
+
+#ifdef THREADS
+	 ADD_FEATURE("THREADS");
+#endif THREADS
+	
+#ifdef CLOS
+	 ADD_FEATURE("CLOS");
+#endif CLOS
+
+	 ADD_FEATURE("ANSI-CL");
+
+#ifdef PDE
+	 ADD_FEATURE("PDE");
+#endif PDE
+
+/* ---------- Operating System ---------- */
+#ifdef unix
+	 ADD_FEATURE("UNIX");
+#endif
+#ifdef BSD
+	 ADD_FEATURE("BSD");
+#endif
+#ifdef SYSV
+	 ADD_FEATURE("SYSTEM-V");
+#endif
+#ifdef MSDOS
+	 ADD_FEATURE("MS-DOS");
+#endif
+
+	 ADD_FEATURE(ARCHITECTURE);
+	 ADD_FEATURE(BRAND);
+
+#ifdef IEEEFLOAT
+	 ADD_FEATURE("IEEE-FLOATING-POINT");
+#endif
+
+	 SYM_VAL(Vfeatures) = features;
+       }
+#ifdef THREADS
+	siVthread_top = make_si_ordinary("THREAD-TOP");
+#endif THREADS
+
+	make_si_constant("+OBJNULL+", OBJNULL);
+}
diff --git a/src/c/mapfun.d b/src/c/mapfun.d
new file mode 100644
index 000000000..f5ab11dcd
--- /dev/null
+++ b/src/c/mapfun.d
@@ -0,0 +1,145 @@
+/*
+    mapfun.c -- Mapping.
+*/
+/*
+    Copyright (c) 1993, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+@(defun mapcar (fun onelist &rest lists)
+	cl_object res, *val = &res;
+	cl_object cdrs[narg-1];
+	cl_object cars[narg-1];	/* __GNUC__ */
+	int i;
+@
+	cdrs[0] = onelist;
+	for (--narg, i = 1; i < narg; i++)
+		cdrs[i] = va_arg(lists, cl_object);
+	res = Cnil;
+	while (TRUE) {
+		for (i = 0;  i < narg;  i++) {
+			if (endp(cdrs[i]))
+				@(return res)
+			cars[i] = CAR(cdrs[i]);
+			cdrs[i] = CDR(cdrs[i]);
+		}
+		*val = CONS(_apply(narg, fun, cars), Cnil);
+		val = &CDR(*val);
+	}
+@)
+
+@(defun maplist (fun onelist &rest lists)
+	cl_object res, *val = &res;
+	cl_object cdrs[narg-1];
+	cl_object cars[narg-1];	/* __GNUC__ */
+	int i;
+@
+	cdrs[0] = onelist;
+	for (--narg, i = 1; i < narg; i++)
+		cdrs[i] = va_arg(lists, cl_object);
+	res = Cnil;
+	while (TRUE) {
+		for (i = 0;  i < narg;  i++) {
+			if (endp(cdrs[i]))
+				@(return res)
+			cars[i] = cdrs[i];
+			cdrs[i] = CDR(cdrs[i]);
+		}
+		*val = CONS(_apply(narg, fun, cars), Cnil);
+		val = &CDR(*val);
+	}
+@)
+
+@(defun mapc (fun onelist &rest lists)
+	cl_object cdrs[narg-1];
+	cl_object cars[narg-1];	/* __GNUC__ */
+	int i;
+@
+	cdrs[0] = onelist;
+	for (--narg, i = 1; i < narg; i++)
+		cdrs[i] = va_arg(lists, cl_object);
+	while (TRUE) {
+		for (i = 0;  i < narg;  i++) {
+			if (endp(cdrs[i]))
+				@(return onelist)
+			cars[i] = CAR(cdrs[i]);
+			cdrs[i] = CDR(cdrs[i]);
+		}
+		apply(narg, fun, cars);
+	}
+@)
+
+@(defun mapl (fun onelist &rest lists)
+	cl_object cdrs[narg-1];
+	cl_object cars[narg-1];	/* __GNUC__ */
+	int i;
+@
+	cdrs[0] = onelist;
+	for (--narg, i = 1; i < narg; i++)
+		cdrs[i] = va_arg(lists, cl_object);
+	while (TRUE) {
+		for (i = 0;  i < narg;  i++) {
+			if (endp(cdrs[i]))
+				@(return onelist)
+			cars[i] = cdrs[i];
+			cdrs[i] = CDR(cdrs[i]);
+		}
+		apply(narg, fun, cars);
+	}
+@)
+
+@(defun mapcan (fun onelist &rest lists)
+	cl_object *x, res, *val = &res;
+	cl_object cdrs[narg-1];
+	cl_object cars[narg-1];	/* __GNUC__ */
+	int i;
+@
+	cdrs[0] = onelist;
+	for (--narg, i = 1; i < narg; i++)
+		cdrs[i] = va_arg(lists, cl_object);
+	res = Cnil;
+	while (TRUE) {
+		for (i = 0;  i < narg;  i++) {
+			if (endp(cdrs[i]))
+				@(return res)
+			cars[i] = CAR(cdrs[i]);
+			cdrs[i] = CDR(cdrs[i]);
+		}
+		*val = _apply(narg, fun, cars);
+		while (CONSP(*val))
+			val = &CDR(*val);
+	}
+@)
+
+@(defun mapcon (fun onelist &rest lists)
+	cl_object res, *val = &res;
+	cl_object cdrs[narg-1];
+	cl_object cars[narg-1];	/* __GNUC__ */
+	int i;
+@
+	cdrs[0] = onelist;
+	for (--narg, i = 1; i < narg; i++)
+		cdrs[i] = va_arg(lists, cl_object);
+	res = Cnil;
+	while (TRUE) {
+		for (i = 0;  i < narg;  i++) {
+			if (endp(cdrs[i]))
+				@(return res)
+			cars[i] = cdrs[i];
+			cdrs[i] = CDR(cdrs[i]);
+		}
+		*val = _apply(narg, fun, cars);
+		while (CONSP(*val))
+			val = &CDR(*val);
+	}
+@)
diff --git a/src/c/multival.d b/src/c/multival.d
new file mode 100644
index 000000000..31aa402c9
--- /dev/null
+++ b/src/c/multival.d
@@ -0,0 +1,46 @@
+/*
+    multival.c -- Multiple Values.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+@(defun values (&rest args)
+	int i;
+@
+	/* INV: the number of arguments never exceeds VSSIZE */
+	NValues = narg;
+	if (narg == 0)
+		VALUES(0) = Cnil;
+	else for (i = 0; i < narg; i++)
+		VALUES(i) = va_arg(args, cl_object);
+	returnn(VALUES(0));
+@)
+
+@(defun values_list (list)
+@
+	VALUES(0) = Cnil;
+	for (NValues=0; !endp(list); list=CDR(list)) {
+		if (NValues == VSSIZE)
+			FEerror("Too many values in VALUES-LIST",0);
+		VALUES(NValues++) = CAR(list);
+	}
+	returnn(VALUES(0));
+@)
+
+void
+init_multival(void)
+{
+	make_constant("MULTIPLE-VALUES-LIMIT",MAKE_FIXNUM(32));
+}
diff --git a/src/c/new/all_symbols.d b/src/c/new/all_symbols.d
new file mode 100644
index 000000000..0f45fe444
--- /dev/null
+++ b/src/c/new/all_symbols.d
@@ -0,0 +1,308 @@
+#include "ecls.h"
+#include "page.h"
+
+const struct symbol_info all_symbols[] = {
+/* assignment.c */
+{&Ssetf, "SETF", CL_ORDINARY},
+{&Spsetf, "PSETF", CL_ORDINARY},
+{&siSsetf_symbol, "SETF-SYMBOL", SI_ORDINARY},
+{&siSclear_compiler_properties, "CLEAR-COMPILER-PROPERTIES", SI_ORDINARY},
+#ifdef PDE
+{&siVrecord_source_pathname_p, "*RECORD-SOURCE-PATHNAME-P*", SI_SPECIAL},
+{&siSrecord_source_pathname, "RECORD-SOURCE-PATHNAME", SI_ORDINARY},
+#endif
+
+/* backq.c */
+{&siScomma, ",", SI_ORDINARY},
+{&siScomma_at, ",@@", SI_ORDINARY},
+{&siScomma_dot, ",.", SI_ORDINARY},
+{&SlistX, "LIST*", CL_ORDINARY},
+{&Sappend, "APPEND", CL_ORDINARY},
+{&Snconc, "NCONC", CL_ORDINARY},
+
+/* bind.c */
+{&SAoptional, "&OPTIONAL", CL_ORDINARY},
+{&SArest, "&REST", CL_ORDINARY},
+{&SAkey, "&KEY", CL_ORDINARY},
+{&SAallow_other_keys, "&ALLOW-OTHER-KEYS", CL_ORDINARY},
+{&SAaux, "&AUX", CL_ORDINARY},
+
+/* block.c */
+{&Sblock, "BLOCK", CL_ORDINARY},
+
+/* clos.c */
+#ifdef CLOS
+{&siSXclass_name_hash_tableX, "*CLASS-NAME-HASH-TABLE*", SI_SPECIAL},
+{&Sclass, "CLASS", CL_ORDINARY},
+{&Sbuilt_in, "BUILT-IN", CL_ORDINARY},
+#endif
+
+/* compiler.c */
+{&siSlambda_block, "LAMBDA-BLOCK", CL_ORDINARY},
+
+/* conditional.c */
+{&Sotherwise, "OTHERWISE", CL_ORDINARY},
+
+/* error.c */
+{&siSuniversal_error_handler, "UNIVERSAL-ERROR-HANDLER", SI_ORDINARY},
+{&siSterminal_interrupt, "TERMINAL-INTERRUPT", SI_ORDINARY},
+
+/* eval.c */
+{&Sapply, "APPLY", CL_ORDINARY},
+{&Sfuncall, "FUNCALL", CL_ORDINARY},
+{&Vevalhook, "*EVALHOOK*", CL_SPECIAL},
+{&Vapplyhook, "*APPLYHOOK*", CL_SPECIAL},
+
+/* file.c */
+{&Vstandard_input, "*STANDARD-INPUT*", CL_SPECIAL},
+{&Vstandard_output, "*STANDARD-OUTPUT*", CL_SPECIAL},
+{&Verror_output, "*ERROR-OUTPUT*", CL_SPECIAL},
+{&Vquery_io, "*QUERY-IO*", CL_SPECIAL},
+{&Vdebug_io, "*DEBUG-IO*", CL_SPECIAL},
+{&Vterminal_io, "*TERMINAL-IO*", CL_SPECIAL},
+{&Vtrace_output, "*TRACE-OUTPUT*", CL_SPECIAL},
+{&siVignore_eof_on_terminal_io, "*IGNORE-EOF-ON-TERMINAL-IO*", SI_SPECIAL},
+
+/* format.c */
+{&siVindent_formatted_output, "*INDENT-FORMATTED-OUTPUT*", SI_SPECIAL},
+
+/* gbc.c */
+#if 0 && !defined(GBC_BOEHM)
+{&siVgc_verbose, "*GC-VERBOSE*", SI_SPECIAL},
+{&siVgc_message, "*GC-MESSAGE*", SI_SPECIAL},
+#endif /* !GBC_BOEHM */
+
+/* gfun.c */
+{&siScompute_applicable_methods, "COMPUTE-APPLICABLE-METHODS", SI_ORDINARY},
+{&siScompute_effective_method, "COMPUTE-EFFECTIVE-METHOD", SI_ORDINARY},
+{&siSgeneric_function_method_combination, "GENERIC-FUNCTION-METHOD-COMBINATION", SI_ORDINARY},
+{&siSgeneric_function_method_combination_args, "GENERIC-FUNCTION-METHOD-COMBINATION-ARGS", SI_ORDINARY},
+
+/* hash.c */
+{&Seq, "EQ", CL_ORDINARY},
+{&Seql, "EQL", CL_ORDINARY},
+{&Sequal, "EQUAL", CL_ORDINARY},
+
+/* instance.c */
+{&Sprint_object, "PRINT-OBJECT", CL_ORDINARY},
+
+/* lex.c */
+{&Smacro, "MACRO", CL_ORDINARY},
+{&siSsymbol_macro, "SYMBOL-MACRO", SI_ORDINARY},
+{&Stag, "TAG", CL_ORDINARY},
+
+/* load.c */
+{&Vload_verbose, "*LOAD-VERBOSE*", CL_SPECIAL},
+#ifdef PDE
+{&siVsource_pathname, "*SOURCE-PATHNAME*", CL_SPECIAL},
+#endif
+#ifdef RSYM
+{&siVsymbol_table, "*SYMBOL-TABLE*", CL_SPECIAL},
+#endif
+
+/* lwp.c */
+#ifdef THREADS
+{&Srunning, "RUNNING", CL_ORDINARY},
+{&Ssuspended, "SUSPENDED", CL_ORDINARY},
+{&Swaiting, "WAITING", CL_ORDINARY},
+{&Sstopped, "STOPPED", CL_ORDINARY},
+{&Sdead, "DEAD", CL_ORDINARY},
+{&siSthread_top_level, "THREAD-TOP-LEVEL", SI_ORDINARY},
+#endif
+
+/* macros.c */
+{&Vmacroexpand_hook, "*MACROEXPAND-HOOK*", CL_SPECIAL},
+{&siSexpand_defmacro, "EXPAND-DEFMACRO", SI_ORDINARY},
+{&siVinhibit_macro_special, "*INHIBIT-MACRO-SPECIAL*", SI_SPECIAL},
+
+/* main.c */
+{&siVsystem_directory, "*SYSTEM-DIRECTORY*", SI_SPECIAL},
+{&Vfeatures, "*FEATURES*", CL_SPECIAL},
+
+/* num_rand.c */
+{&Vrandom_state, "*RANDOM-STATE*", CL_SPECIAL},
+
+/* package.c */
+{&Vpackage, "*PACKAGE*", CL_SPECIAL},
+
+/* pathname.c */
+{&Vdefault_pathname_defaults, "*DEFAULT-PATHNAME-DEFAULTS*", CL_SPECIAL},
+
+/* print.c */
+{&Vprint_escape, "*PRINT-ESCAPE*", CL_SPECIAL},
+{&Vprint_pretty, "*PRINT-PRETTY*", CL_SPECIAL},
+{&Vprint_circle, "*PRINT-CIRCLE*", CL_SPECIAL},
+{&Vprint_base, "*PRINT-BASE*", CL_SPECIAL},
+{&Vprint_radix, "*PRINT-RADIX*", CL_SPECIAL},
+{&Vprint_case, "*PRINT-CASE*", CL_SPECIAL},
+{&Vprint_gensym, "*PRINT-GENSYM*", CL_SPECIAL},
+{&Vprint_level, "*PRINT-LEVEL*", CL_SPECIAL},
+{&Vprint_length, "*PRINT-LENGTH*", CL_SPECIAL},
+{&Vprint_array, "*PRINT-ARRAY*", CL_SPECIAL},
+{&siSpretty_print_format, "PRETTY-PRINT-FORMAT", SI_ORDINARY},
+{&siSsharp_exclamation, "#!", SI_ORDINARY},
+{&siVprint_package, "*PRINT-PACKAGE*", SI_SPECIAL},
+{&siVprint_structure, "*PRINT-STRUCTURE*", SI_SPECIAL},
+#ifdef CLOS
+{&Sstream_write_char, "STREAM-WRITE-CHAR", CL_ORDINARY},
+{&Sstream_write_string, "STREAM-WRITE-STRING", CL_ORDINARY},
+{&Sstream_fresh_line, "STREAM-FRESH-LINE", CL_ORDINARY},
+{&Sstream_clear_output, "STREAM-CLEAR-OUTPUT", CL_ORDINARY},
+{&Sstream_force_output, "STREAM-FORCE-OUTPUT", CL_ORDINARY},
+#endif
+
+/* profile.c */
+#ifdef PROFILE
+{&sSAprofile_arrayA, "*PROFILE-ARRAY*", SI_SPECIAL},
+#endif PROFILE
+
+/* read.c */
+{&Vreadtable, "*READTABLE*", CL_SPECIAL},
+{&Vread_default_float_format, "*READ-DEFAULT-FLOAT-FORMAT*", CL_SPECIAL},
+{&Vread_base, "*READ-BASE*", CL_SPECIAL},
+{&Vread_suppress, "*READ-SUPPRESS*", CL_SPECIAL},
+{&siSsharp_comma, "#,", SI_ORDINARY},
+#ifdef CLOS
+{&Sstream_read_line, "STREAM-READ-LINE", CL_ORDINARY},
+{&Sstream_read_char, "STREAM-READ-CHAR", CL_ORDINARY},
+{&Sstream_unread_char, "STREAM-UNREAD-CHAR", CL_ORDINARY},
+{&Sstream_peek_char, "STREAM-PEEK-CHAR", CL_ORDINARY},
+{&Sstream_listen, "STREAM-LISTEN", CL_ORDINARY},
+{&Sstream_clear_input, "STREAM-CLEAR-INPUT", CL_ORDINARY},
+#endif
+
+/* structure.c */
+{&siSstructure_print_function, "STRUCTURE-PRINT-FUNCTION", SI_ORDINARY},
+{&siSstructure_slot_descriptions, "STRUCTURE-SLOT-DESCRIPTIONS", SI_ORDINARY},
+#ifndef CLOS
+{&siSstructure_include, "STRUCTURE-INCLUDE", SI_ORDINARY},
+#else
+{&Sstructure_object, "STRUCTURE-OBJECT", CL_ORDINARY},
+#endif
+
+/* symbol.c */
+{&siSpname, "PNAME", SI_ORDINARY},
+{&Vgensym_counter, "*GENSYM-COUNTER*", CL_SPECIAL},
+
+/* toplevel.c */
+{&Sdeclare, "DECLARE", CL_ORDINARY},
+{&Scompile, "COMPILE", CL_ORDINARY},
+{&Sload, "LOAD", CL_ORDINARY},
+{&Seval, "EVAL", CL_ORDINARY},
+{&Sprogn, "PROGN", CL_ORDINARY},
+{&Swarn, "WARN", CL_ORDINARY},
+{&Stypep, "TYPEP", CL_ORDINARY},
+
+/* typespec.c */
+{&Squote, "QUOTE", CL_ORDINARY},
+{&Slambda, "LAMBDA", CL_ORDINARY},
+{&Sspecial, "SPECIAL", CL_ORDINARY},
+{&St, "T", CL_ORDINARY},
+{&Snil, "NIL", CL_ORDINARY},
+{&Scommon, "COMMON", CL_ORDINARY},
+{&Ssequence, "SEQUENCE", CL_ORDINARY},
+{&Snull, "NULL", CL_ORDINARY},
+{&Scons, "CONS", CL_ORDINARY},
+{&Slist, "LIST", CL_ORDINARY},
+{&Ssymbol, "SYMBOL", CL_ORDINARY},
+{&Sarray, "ARRAY", CL_ORDINARY},
+{&Svector, "VECTOR", CL_ORDINARY},
+{&Sbit_vector, "BIT-VECTOR", CL_ORDINARY},
+{&Sstring, "STRING", CL_ORDINARY},
+{&Ssimple_array, "SIMPLE-ARRAY", CL_ORDINARY},
+{&Ssimple_vector, "SIMPLE-VECTOR", CL_ORDINARY},
+{&Ssimple_string, "SIMPLE-STRING", CL_ORDINARY},
+{&Ssimple_bit_vector, "SIMPLE-BIT-VECTOR", CL_ORDINARY},
+{&Sfunction, "FUNCTION", CL_ORDINARY},
+{&Spathname, "PATHNAME", CL_ORDINARY},
+{&Slogical_pathname, "LOGICAL-PATHNAME", CL_ORDINARY},
+{&Scharacter, "CHARACTER", CL_ORDINARY},
+{&Sbase_char, "BASE-CHAR", CL_ORDINARY},
+{&Sextended_char, "EXTENDED-CHAR", CL_ORDINARY},
+{&Scompiled_function, "COMPILED-FUNCTION", CL_ORDINARY},
+{&Snumber, "NUMBER", CL_ORDINARY},
+{&Sreal, "REAL", CL_ORDINARY},
+{&Srational, "RATIONAL", CL_ORDINARY},
+{&Sfloat, "FLOAT", CL_ORDINARY},
+{&Sinteger, "INTEGER", CL_ORDINARY},
+{&Sratio, "RATIO", CL_ORDINARY},
+{&Sshort_float, "SHORT-FLOAT", CL_ORDINARY},
+{&Sstandard_char, "STANDARD-CHAR", CL_ORDINARY},
+{&Sfixnum, "FIXNUM", CL_ORDINARY},
+{&Scomplex, "COMPLEX", CL_ORDINARY},
+{&Ssingle_float, "SINGLE-FLOAT", CL_ORDINARY},
+{&Spackage, "PACKAGE", CL_ORDINARY},
+{&Sbignum, "BIGNUM", CL_ORDINARY},
+{&Srandom_state, "RANDOM-STATE", CL_ORDINARY},
+{&Sdouble_float, "DOUBLE-FLOAT", CL_ORDINARY},
+{&Sstream, "STREAM", CL_ORDINARY},
+{&Sbit, "BIT", CL_ORDINARY},
+{&Sreadtable, "READTABLE", CL_ORDINARY},
+{&Slong_float, "LONG-FLOAT", CL_ORDINARY},
+{&Shash_table, "HASH-TABLE", CL_ORDINARY},
+{&Ssigned_char, "SIGNED-CHAR", CL_ORDINARY},
+{&Sunsigned_char, "UNSIGNED-CHAR", CL_ORDINARY},
+{&Ssigned_short, "SIGNED-SHORT", CL_ORDINARY},
+{&Sunsigned_short, "UNSIGNED-SHORT", CL_ORDINARY},
+#ifdef CLOS
+{&Sinstance, "INSTANCE", CL_ORDINARY},
+{&Sdispatch_function, "DISPATCH-FUNCTION", CL_ORDINARY},
+{&Sstructure, "STRUCTURE", CL_ORDINARY},
+#endif
+{&Ssatisfies, "SATISFIES", CL_ORDINARY},
+{&Smember, "MEMBER", CL_ORDINARY},
+{&Snot, "NOT", CL_ORDINARY},
+{&Sor, "OR", CL_ORDINARY},
+{&Sand, "AND", CL_ORDINARY},
+{&Svalues, "VALUES", CL_ORDINARY},
+{&Smod, "MOD", CL_ORDINARY},
+{&Ssigned_byte, "SIGNED-BYTE", CL_ORDINARY},
+{&Sunsigned_byte, "UNSIGNED-BYTE", CL_ORDINARY},
+{&SX, "*", CL_ORDINARY},
+{&Splusp, "PLUSP", CL_ORDINARY},
+{&Skeyword, "KEYWORD", CL_ORDINARY},
+#ifdef THREADS
+{&Scont, "CONT", CL_ORDINARY},
+{&Sthread, "THREAD", CL_ORDINARY},
+#endif
+#ifdef LOCATIVE
+{&Slocative, "LOCATIVE", CL_ORDINARY},
+#endif
+{&Ssubtypep, "SUBTYPEP", CL_ORDINARY},
+
+/* unify.c */
+#ifdef LOCATIVE
+{&Ssetq, "SETQ", CL_ORDINARY},
+{&Sunify_slot, "UNIFY-SLOT", CL_ORDINARY},
+#endif
+
+{NULL, (const char*)NULL, CL_ORDINARY}};
+
+void
+init_all_symbols(void) {
+  const struct symbol_info *s = all_symbols;
+  cl_object *loc;
+
+  /* This must keep the garbage collector happy */
+  for (s = all_symbols; s->name != NULL; s++)
+    *(s->loc) = OBJNULL;
+
+  for (s = all_symbols; s->name != NULL; s++) {
+    loc = s->loc;
+    switch (s->type) {
+    case CL_ORDINARY:
+      *loc = make_ordinary(s->name);
+      break;
+    case CL_SPECIAL:
+      *loc = make_special(s->name, Cnil);
+      break;
+    case SI_ORDINARY:
+      *loc = make_si_ordinary(s->name);
+      break;
+    case SI_SPECIAL:
+      *loc = make_si_special(s->name, Cnil);
+      break;
+    }
+    /*    register_root(loc);*/
+  }
+}
diff --git a/src/c/new/compiler.d b/src/c/new/compiler.d
new file mode 100644
index 000000000..9cbae7526
--- /dev/null
+++ b/src/c/new/compiler.d
@@ -0,0 +1,2148 @@
+/*
+    compiler.c -- Bytecode compiler
+*/
+/*
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include "ecls-inl.h"
+#include "bytecodes.h"
+
+/********************* EXPORTS *********************/
+
+cl_object siSlambda_block;
+cl_object Sdeclare;
+cl_object Sdefun;
+cl_object Scompile, Sload, Seval, Sprogn, Swarn, Stypep, Sotherwise;
+cl_object Kexecute, Kcompile_toplevel, Kload_toplevel;
+cl_object siVinhibit_macro_special;
+
+cl_object SAoptional;
+cl_object SArest;
+cl_object SAkey;
+cl_object SAallow_other_keys;
+cl_object SAaux;
+
+cl_object Kallow_other_keys;
+
+cl_object bytecodes;
+
+/********************* PRIVATE ********************/
+
+static cl_index asm_begin(void);
+static cl_object asm_end(cl_index);
+static void asm_clear(cl_index);
+static void asm_grow(void);
+static void asm1(register cl_object op);
+static void asm_op(register int n);
+static void asm_list(register cl_object l);
+static void asmn(int narg, ...);
+static void asm_at(register cl_index where, register cl_object what);
+static cl_index asm_jmp(register int op);
+static void asm_complete(register int op, register cl_index original);
+static cl_index current_pc();
+static void set_pc(cl_index pc);
+static cl_object asm_ref(register cl_index where);
+
+static void c_and(cl_object args);
+static void c_block(cl_object args);
+static void c_case(cl_object args);
+static void c_catch(cl_object args);
+static void c_cond(cl_object args);
+static void c_do(cl_object args);
+static void c_doa(cl_object args);
+static void c_dolist(cl_object args);
+static void c_dotimes(cl_object args);
+static void c_eval_when(cl_object args);
+static void c_flet(cl_object args);
+static void c_function(cl_object args);
+static void c_go(cl_object args);
+static void c_if(cl_object args);
+static void c_labels(cl_object args);
+static void c_let(cl_object args);
+static void c_leta(cl_object args);
+static void c_macrolet(cl_object args);
+static void c_multiple_value_bind(cl_object args);
+static void c_multiple_value_call(cl_object args);
+static void c_multiple_value_prog1(cl_object args);
+static void c_multiple_value_setq(cl_object args);
+static void c_nth_value(cl_object args);
+static void c_or(cl_object args);
+static void c_progv(cl_object args);
+static void c_psetq(cl_object args);
+static void c_values(cl_object args);
+static void c_setq(cl_object args);
+static void c_return(cl_object args);
+static void c_return_from(cl_object args);
+static void c_symbol_macrolet(cl_object args);
+static void c_tagbody(cl_object args);
+static void c_throw(cl_object args);
+static void c_unless(cl_object args);
+static void c_unwind_protect(cl_object args);
+static void c_when(cl_object args);
+static void compile_body(cl_object args);
+static void compile_form(cl_object args, bool push);
+
+/* -------------------- SAFE LIST HANDLING -------------------- */
+
+static cl_object
+pop(cl_object *l) {
+	cl_object head, list = *l;
+	if (ATOM(list))
+		FEerror("Error parsing special form",0);
+	head = CAR(list);
+	*l = CDR(list);
+	return head;
+}
+
+static cl_object
+pop_maybe_nil(cl_object *l) {
+	cl_object head, list = *l;
+	if (list == Cnil)
+		return Cnil;
+	if (ATOM(list))
+		FEerror("Error parsing special form",0);
+	head = CAR(list);
+	*l = CDR(list);
+	return head;
+}
+
+/* ------------------------------ ASSEMBLER ------------------------------ */
+
+static cl_index
+asm_begin(void) {
+	/* Save beginning of bytecodes for this session */
+	return current_pc();
+}
+
+static void
+asm_clear(cl_index beginning) {
+	cl_index i;
+	/* Remove data from this session */
+	bytecodes->vector.fillp = beginning;
+}
+
+static cl_object
+asm_end(cl_index beginning) {
+	cl_object new_bytecodes;
+	cl_index length, bytes, i;
+
+	/* Save bytecodes from this session in a new vector */
+	length = current_pc() - beginning;
+	bytes = length * sizeof(cl_object);
+	new_bytecodes = alloc_object(t_bytecodes);
+	new_bytecodes->bytecodes.lex = Cnil;
+	new_bytecodes->bytecodes.data = alloc(bytes);
+	new_bytecodes->bytecodes.size = length;
+	memcpy(new_bytecodes->bytecodes.data,
+	       &bytecodes->vector.self.t[beginning],
+	       bytes);
+
+	asm_clear(beginning);
+	return new_bytecodes;
+}
+
+static void
+asm_grow(void) {
+	cl_object *old_data = bytecodes->vector.self.t;
+	cl_index old_size = bytecodes->vector.fillp;
+	bytecodes->vector.dim += 128;
+	array_allocself(bytecodes);
+	memcpy(bytecodes->vector.self.t, old_data, old_size*sizeof(cl_object));
+}
+
+static void
+asm1(register cl_object op) {
+	int where = bytecodes->vector.fillp;
+	if (where >= bytecodes->vector.dim)
+		asm_grow();
+	bytecodes->vector.self.t[where] = op;
+	bytecodes->vector.fillp++;
+}
+
+static void
+asm_op(register int n) {
+	asm1(MAKE_FIXNUM(n));
+}
+
+static void
+asm_op2(register int code, register cl_fixnum n) {
+	cl_object op = MAKE_FIXNUM(code);
+	cl_object new_op = SET_OPARG(op, n);
+	if (n < -MAX_OPARG || MAX_OPARG < n)
+		FEerror("Argument to bytecode is too large", 0);
+	else
+		asm1(new_op);
+}
+
+static inline cl_object
+make_op(int code) {
+	return MAKE_FIXNUM(code);
+}
+
+static cl_object
+make_op2(int code, cl_fixnum n) {
+	cl_object volatile op = MAKE_FIXNUM(code);
+	cl_object new_op = SET_OPARG(op, n);
+	if (n < -MAX_OPARG || MAX_OPARG < n)
+		FEerror("Argument to bytecode is too large", 0);
+	return new_op;
+}
+
+static void
+asm_insert(cl_fixnum where, cl_object op) {
+	cl_fixnum end = bytecodes->vector.fillp;
+	if (where > end)
+		FEerror("asm1_insert: position out of range", 0);
+	if (end >= bytecodes->vector.dim)
+		asm_grow();
+	memmove(&bytecodes->vector.self.t[where+1],
+		&bytecodes->vector.self.t[where],
+		(end - where) * sizeof(cl_object));
+	bytecodes->vector.fillp++;
+	bytecodes->vector.self.t[where] = op;
+}
+
+static void
+asm_list(register cl_object l) {
+	if (ATOM(l))
+		asm1(l);
+	while(!endp(l)) {
+		asm1(CAR(l));
+		l = CDR(l);
+	}
+}
+
+static void
+asmn(int narg, ...) {
+	va_list args;
+
+	va_start(args, narg);
+	while (narg-- > 0)
+		asm1(va_arg(args, cl_object));
+}
+
+static void
+asm_at(register cl_index where, register cl_object what) {
+	if (where > bytecodes->vector.fillp)
+		FEerror("Internal error at asm_at()",0);
+	bytecodes->vector.self.t[where] = what;
+}
+
+static cl_index
+asm_block(void) {
+	cl_index output;
+	output = current_pc();
+	asm1(MAKE_FIXNUM(0));
+	return output;
+}	
+
+static cl_index
+asm_jmp(register int op) {
+	cl_index output = current_pc();
+	asm_op(op);
+	return output;
+}
+
+static void
+asm_complete(register int op, register cl_index original) {
+	cl_fixnum delta = current_pc() - original;
+	cl_object code = asm_ref(original);
+	cl_object new_code = SET_OPARG(code, delta);
+	if (code != MAKE_FIXNUM(op))
+		FEerror("Non matching codes in ASM-COMPLETE2", 0);
+	else if (delta < -MAX_OPARG || delta > MAX_OPARG)
+		FEerror("Too large jump", 0);
+	else
+		asm_at(original, new_code);
+}
+
+static cl_index
+current_pc(void) {
+	return bytecodes->vector.fillp;
+}
+
+static void
+set_pc(cl_index pc) {
+	bytecodes->vector.fillp = pc;
+}
+
+static cl_object
+asm_ref(register cl_index n) {
+	return bytecodes->vector.self.t[n];
+}
+
+/* ------------------------------ COMPILER ------------------------------ */
+
+typedef struct {
+  cl_object symbol;
+  const char *const name;
+  void (*compiler)(cl_object);
+} compiler_record;
+
+static compiler_record database[] = {
+  {OBJNULL, "AND", c_and},
+  {OBJNULL, "BLOCK", c_block},
+  {OBJNULL, "CASE", c_case},
+  {OBJNULL, "CATCH", c_catch},
+  {OBJNULL, "COND", c_cond},
+  {OBJNULL, "DO", c_do},
+  {OBJNULL, "DO*", c_doa},
+  {OBJNULL, "DOLIST", c_dolist},
+  {OBJNULL, "DOTIMES", c_dotimes},
+  {OBJNULL, "EVAL-WHEN", c_eval_when},
+  {OBJNULL, "FLET", c_flet},
+  {OBJNULL, "FUNCTION", c_function},
+  {OBJNULL, "GO", c_go},
+  {OBJNULL, "IF", c_if},
+  {OBJNULL, "LABELS", c_labels},
+  {OBJNULL, "LET", c_let},
+  {OBJNULL, "LET*", c_leta},
+  {OBJNULL, "MACROLET", c_macrolet},
+  {OBJNULL, "MULTIPLE-VALUE-BIND", c_multiple_value_bind},
+  {OBJNULL, "MULTIPLE-VALUE-CALL", c_multiple_value_call},
+  {OBJNULL, "MULTIPLE-VALUE-PROG1", c_multiple_value_prog1},
+  {OBJNULL, "MULTIPLE-VALUE-SETQ", c_multiple_value_setq},
+  {OBJNULL, "NTH-VALUE", c_nth_value},
+  {OBJNULL, "OR", c_or},
+  {OBJNULL, "PROGN", compile_body},
+  {OBJNULL, "PROGV", c_progv},
+  {OBJNULL, "PSETQ", c_psetq},
+  {OBJNULL, "RETURN", c_return},
+  {OBJNULL, "RETURN-FROM", c_return_from},
+  {OBJNULL, "SETQ", c_setq},
+  {OBJNULL, "TAGBODY", c_tagbody},
+  {OBJNULL, "THROW", c_throw},
+  {OBJNULL, "UNWIND-PROTECT", c_unwind_protect},
+  {OBJNULL, "UNLESS", c_unless},
+  {OBJNULL, "VALUES", c_values},
+  {OBJNULL, "WHEN", c_when},
+  {OBJNULL, "", c_when}
+};
+
+/* ----------------- LEXICAL ENVIRONMENT HANDLING -------------------- */
+
+static void
+c_register_var(register cl_object var, bool special)
+{
+	CAR(lex_env) = CONS(CONS(var, special? Sspecial : Cnil), CAR(lex_env));
+}
+
+static bool
+special_variablep(register cl_object var, register cl_object specials)
+{
+	return ((var->symbol.stype == stp_special) || member_eq(var, specials));
+}
+
+static void
+c_pbind(cl_object var, cl_object specials)
+{
+	if (!SYMBOLP(var))
+		FEerror("The object ~A is not a valid variable name", 1, var);
+	else if (special_variablep(var, specials)) {
+		c_register_var(var, TRUE);
+		asm_op(OP_PBINDS);
+	} else {
+		c_register_var(var, FALSE);
+		asm_op(OP_PBIND);
+	}
+	asm1(var);
+}
+
+static void
+c_bind(cl_object var, cl_object specials)
+{
+	if (!SYMBOLP(var))
+		FEerror("The object ~A is not a valid variable name", 1, var);
+	else if (special_variablep(var, specials)) {
+		c_register_var(var, TRUE);
+		asm_op(OP_BINDS);
+	} else {
+		c_register_var(var, FALSE);
+		asm_op(OP_BIND);
+	}
+	asm1(var);
+}
+
+static void
+compile_setq(int op, cl_object var)
+{
+	cl_object ndx;
+
+	if (!SYMBOLP(var))
+		FEerror("SETQ: ~A is not a symbol", 1, var);
+	ndx = lex_var_sch(var);
+	if (!Null(ndx) && CDR(ndx) != Sspecial)
+		asm_op(op); /* Lexical variable */
+	else if (var->symbol.stype == stp_constant)
+		FEerror("SETQ: Cannot change the value of the constant ~A", 1,var);
+	else if (op == OP_SETQ)
+		asm_op(OP_SETQS); /* Special variable */
+	else
+		asm_op(OP_PSETQS); /* Special variable */
+	asm1(var);
+}
+
+static void
+bind_tag(cl_object tag)
+{
+	CDR(lex_env) = CONS(list(3, tag, Stag, Cnil), CDR(lex_env));
+}
+
+static bool
+reference_tag(cl_object tag)
+{
+	cl_object l;
+	bool non_local = FALSE;
+
+	for (l = CDR(lex_env); !endp(l); l = CDR(l)) {
+		cl_object record = CAR(l);
+		if (ATOM(record))
+			non_local = TRUE;
+		else if (CAR(record) == Ct && CDR(record) == Cnil)
+			non_local = TRUE;
+		else if (eql(CAR(record), tag) && CADR(record) == Stag) {
+			cl_object mark;
+			if (non_local)
+				mark = Ct;
+			else
+				mark = MAKE_FIXNUM(current_pc());
+			CADDR(record) = nconc(CADDR(record), CONS(mark, Cnil));
+			return non_local;
+		}
+	}
+	FEerror("Reference to unknown tag ~S", 1, tag);
+}
+
+/* -------------------- THE COMPILER -------------------- */
+
+static void
+c_and(cl_object args) {
+	if (Null(args)) {
+		asm1(Ct);
+		return;
+	} else if (ATOM(args)) {
+		FEerror("Wrong type of argument to AND ~S", 1, args);
+	} else {
+		compile_form(pop(&args),FALSE);
+		if (!endp(args)) {
+			cl_index label = asm_jmp(OP_JNIL);
+			c_and(args);
+			asm_complete(OP_JNIL, label);
+		}
+	}
+}
+
+/*
+	The OP_BLOCK operator encloses several forms within a block
+	named BLOCK_NAME, thus catching any OP_RETFROM whose argument
+	matches BLOCK_NAME. The end of this block is marked both by
+	the OP_EXIT operator and the LABELZ which is packed within
+	the OP_BLOCK operator.
+	
+		[OP_BLOCK + labelz]
+		block_name
+		....
+		OP_EXIT
+	labelz:	...
+*/
+
+static void
+c_block(cl_object body) {
+	cl_object name = pop(&body);
+	cl_index labelz = asm_jmp(OP_BLOCK);
+	if (!SYMBOLP(name))
+		FEerror("Not a valid BLOCK name: ~S", 1, name);
+	asm1(name);
+	compile_body(body);
+	asm_op(OP_EXIT);
+	asm_complete(OP_BLOCK, labelz);
+}
+
+/*
+	There are several ways to invoke functions and to handle the
+	output arguments. These are
+
+		[OP_CALL + nargs]
+		function_name
+
+		[OP_PCALL + nargs]
+		function_name
+
+		[OP_FCALL + nargs]
+
+		[OP_PFCALL + nargs]
+
+	 OP_CALL and OP_FCALL leave all arguments in the VALUES() array,
+	 while OP_PCALL and OP_PFCALL leave the first argument in the
+	 stack.
+
+	 OP_CALL and OP_PCALL use the following symbol to retrieve the
+	 function, while OP_FCALL and OP_PFCALL use the value in VALUES(0).
+ */
+static void
+c_call(cl_object args, bool push) {
+	cl_object name;
+	cl_index nargs;
+
+	name = pop(&args);
+	for (nargs = 0; !endp(args); nargs++) {
+		compile_form(pop(&args),TRUE);
+	}
+	if (ATOM(name)) {
+		asm_op2(push? OP_PCALL : OP_CALL, nargs);
+		asm1(name);
+	} else if (CAR(name) == Slambda) {
+		asm_op(OP_CLOSE);
+		asm1(make_lambda(Cnil, CDR(name)));
+		asm_op2(push? OP_PFCALL : OP_FCALL, nargs);
+	} else {
+		cl_object aux = setf_namep(name);
+		if (aux == OBJNULL)
+			FEerror("Invalid function name ~S", 1, name);
+		asm_op2(push? OP_PCALL : OP_CALL, nargs);
+		asm1(aux);
+	}
+}
+
+static void
+perform_c_case(cl_object args) {
+	cl_object test, clause, conseq;
+	cl_fixnum label1, label2;
+
+	if (Null(args)) {
+		asm_op(OP_NOP);
+		return;
+	}
+
+	clause = pop(&args);
+	if (ATOM(clause))
+		FEerror("~S is an illegal CASE clause.",1,clause);
+	test = pop(&clause);
+	if (Sotherwise == test || test == Ct) {
+		compile_body(clause);
+	} else {
+		cl_index labeln, labelz;
+		if (CONSP(test)) {
+			cl_index n = length(test);
+			while (n > 1) {
+				cl_object v = pop(&test);
+				cl_fixnum jump = (n--) * 2;
+				asm_op2(OP_JEQ, jump);
+				asm1(v);
+			}
+			test = CAR(test);
+		}
+		labeln = asm_jmp(OP_JNEQ);
+		asm1(test);
+		compile_body(clause);
+		labelz = asm_jmp(OP_JMP);
+		asm_complete(OP_JNEQ, labeln);
+		perform_c_case(args);
+		asm_complete(OP_JMP, labelz);
+	}
+}
+
+static void
+c_case(cl_object clause) {
+	compile_form(pop(&clause), FALSE);
+	perform_c_case(clause);
+}
+
+/*
+	The OP_CATCH takes the object in VALUES(0) and uses it to catch
+	any OP_THROW operation which uses that value as argument. If a
+	catch occurs, or when all forms have been properly executed, it
+	jumps to LABELZ. LABELZ is packed within the OP_CATCH operator.
+		[OP_CATCH + labelz]
+		...
+		"forms to be caught"
+		...
+	       	OP_EXIT
+	labelz:	...
+*/
+
+static void
+c_catch(cl_object args) {
+	cl_index labelz;
+
+	/* Compile evaluation of tag */
+	compile_form(pop(&args), FALSE);
+
+	/* Compile jump point */
+	labelz = asm_jmp(OP_CATCH);
+
+	/* Compile body of CATCH */
+	compile_body(args);
+	asm_op(OP_EXIT);
+	asm_complete(OP_CATCH, labelz);
+}
+
+/*
+	There are three operators which perform explicit jumps, but
+	almost all other operators use labels in one way or
+	another.
+
+	1) Jumps are always relative to the place where the jump label
+	is retrieved so that if the label is in vector[0], then the
+	destination is roughly vector + vector[0].
+
+	2) There are two types of labels, "packed labels" and "simple
+	labels". The first ones are packed in the upper bits of an
+	operator so that
+		destination = vector + vector[0]>>16
+	Simple labels take the whole word and thus
+		destination = vector + fix(vector[0])
+
+	3) The three jump forms are
+
+		[OP_JMP + label]	; Unconditional jump
+		[OP_JNIL + label]	; Jump if VALUES(0) == Cnil
+		[OP_JT + label]		; Jump if VALUES(0) != Cnil
+
+	It is important to remark that both OP_JNIL and OP_JT truncate
+	the values stack, so that always NValues = 1 after performing
+	any of these operations.
+*/
+static void
+c_cond(cl_object args) {
+	cl_object test, clause, conseq;
+	cl_fixnum label_nil, label_exit;
+
+	clause = pop(&args);
+	if (ATOM(clause))
+		FEerror("~S is an illegal COND clause.",1,clause);
+	test = pop(&clause);
+	if (Ct == test) {
+		/* Default sentence. If no forms, just output T. */
+		if (Null(clause))
+			compile_form(Ct, FALSE);
+		else
+			compile_body(clause);
+	} else {
+		/* Compile the test. If no more forms, just output
+		   the first value (this is guaranteed by OP_JNIL */
+		compile_form(test, FALSE);
+		label_nil = asm_jmp(OP_JNIL);
+		if (!Null(clause))
+			compile_body(clause);
+		if (Null(args))
+			asm_complete(OP_JNIL, label_nil);
+		else {
+			label_exit = asm_jmp(OP_JMP);
+			asm_complete(OP_JNIL, label_nil);
+			c_cond(args);
+			asm_complete(OP_JMP, label_exit);
+		}
+	}
+}
+
+/*	The OP_DO operator saves the lexical environment and establishes
+	a NIL block to execute the enclosed forms, which are typically
+	like the ones shown below. At the exit of the block, either by
+	means of a OP_RETFROM jump or because of normal termination,
+	the lexical environment is restored, and all bindings undone.
+
+		[OP_DO + labelz]
+		labelz
+		...	; bindings
+	labelb:	...	; body
+		...	; stepping forms
+	labelt:	...	; test form
+		[JNIL + label]
+		...	; output form
+		OP_EXIT
+	labelz:
+
+*/
+static void
+c_do_doa(int op, cl_object args) {
+	cl_object bindings, test, specials, body, l;
+	cl_object stepping = Cnil, vars = Cnil;
+	cl_index labelb, labelt, labelz;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	bindings = pop(&args);
+	test = pop(&args);
+
+	siLprocess_declarations(1, args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	labelz = asm_jmp(OP_DO);
+
+	/* Compile initial bindings */
+	if (length(bindings) == 1)
+		op = OP_BIND;
+	for (l=bindings; !endp(l); ) {
+		cl_object aux = pop(&l);
+		cl_object var, value;
+		if (ATOM(aux)) {
+			var = aux;
+			value = Cnil;
+		} else {
+			var = pop(&aux);
+			value = pop_maybe_nil(&aux);
+			if (!endp(aux))
+				stepping = CONS(CONS(var,pop(&aux)),stepping);
+			if (!Null(aux))
+				FEerror("Not a valid argument to LET ~S.", 1,
+					args);
+		}
+		if (!SYMBOLP(var))
+			FEerror("Cannot bind ~S.", 1, var);
+		if (op == OP_PBIND) {
+			compile_form(value, TRUE);
+			vars = CONS(var, vars);
+		} else {
+			compile_form(value, FALSE);
+			c_bind(var, specials);
+		}
+	}
+	while (!endp(vars))
+		c_pbind(pop(&vars), specials);
+
+	/* Jump to test */
+	labelt = asm_jmp(OP_JMP);
+
+	/* Compile body */
+	labelb = current_pc();
+	c_tagbody(body);
+
+	/* Compile stepping clauses */
+	if (length(stepping) == 1)
+		op = OP_BIND;
+	for (vars = Cnil, stepping=nreverse(stepping); !endp(stepping); ) {
+		cl_object pair = pop(&stepping);
+		cl_object var = CAR(pair);
+		cl_object value = CDR(pair);
+		if (op == OP_PBIND) {
+			compile_form(value, TRUE);
+			vars = CONS(var, vars);
+		} else {
+			compile_form(value, FALSE);
+			compile_setq(OP_SETQ, var);
+		}
+	}
+	while (!endp(vars))
+		compile_setq(OP_PSETQ, pop(&vars));
+
+	/* Compile test */
+	asm_complete(OP_JMP, labelt);
+	compile_form(pop(&test), FALSE);
+	asm_op2(OP_JNIL, labelb - current_pc());
+
+	/* Compile output clauses */
+	compile_body(test);
+	asm_op(OP_EXIT);
+
+	/* Compile return point of block */
+	asm_complete(OP_DO, labelz);
+
+	lex_env = lex_old;
+}
+
+
+static void
+c_doa(cl_object args) {
+	c_do_doa(OP_BIND, args);
+}
+
+static void
+c_do(cl_object args) {
+	c_do_doa(OP_PBIND, args);
+}
+
+/*
+	The OP_DOLIST & OP_DOTIMES operators save the lexical
+	environment and establishes a NIL block to execute the
+	enclosed forms, which iterate over the elements in a list or
+	over a range of integer numbers. At the exit of the block,
+	either by means of a OP_RETFROM jump or because of normal
+	termination, the lexical environment is restored, and all
+	bindings undone.
+
+		[OP_DOTIMES/OP_DOLIST + labelz]
+		...	; bindings
+		[OP_EXIT + labelo]
+		...	; body
+		...	; stepping forms
+		OP_EXIT
+	labelo:	...	; output form
+		OP_EXIT
+	labelz:
+
+ */
+
+static void
+c_dolist_dotimes(int op, cl_object args) {
+	cl_object head = pop(&args);
+	cl_object var = pop(&head);
+	cl_object list = pop(&head);
+	cl_object specials, body;
+	cl_index labelz, labelo;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	siLprocess_declarations(1, args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	if (!SYMBOLP(var))
+		FEerror("Cannot bind to ~S", 1, var);
+
+	/* Compute list and enter loop */
+	compile_form(list, FALSE);
+	labelz = asm_jmp(op);
+
+	/* Initialize the variable */
+	compile_form((op == OP_DOLIST)? Cnil : MAKE_FIXNUM(0), FALSE);
+	c_bind(var, specials);
+	labelo = asm_jmp(OP_EXIT);
+
+	/* Variable assignment and iterated body */
+	compile_setq(OP_SETQ, var);
+	c_tagbody(body);
+	asm_op(OP_EXIT);
+
+	/* Output */
+	asm_complete(OP_EXIT, labelo);
+	if (CDR(head) != Cnil)
+		FEerror("Too many arguments to output form of DOLIST", 0);
+	if (Null(head))
+		compile_body(Cnil);
+	else {
+		compile_setq(OP_SETQ, var);
+		compile_form(pop(&head), FALSE);
+	}
+	asm_op(OP_EXIT);
+
+	/* Exit point for block */
+	asm_complete(op, labelz);
+
+	lex_env = lex_old;
+}
+
+
+static void
+c_dolist(cl_object args) {
+	c_dolist_dotimes(OP_DOLIST, args);
+}
+
+static void
+c_dotimes(cl_object args) {
+	c_dolist_dotimes(OP_DOTIMES, args);
+}
+
+static void
+c_eval_when(cl_object args) {
+	cl_object situation = pop(&args);
+
+	if (member_eq(Seval, situation) || member_eq(Kexecute, situation))
+		compile_body(args);
+	else
+		compile_body(Cnil);
+}
+
+
+/*
+	The OP_FLET/OP_FLABELS operators change the lexical environment
+	to add a few local functions.
+
+		[OP_FLET/OP_FLABELS + nfun]
+		fun1
+		...
+		funn
+		...
+		OP_EXIT
+	labelz:
+*/
+static void
+c_labels_flet(int op, cl_object args) {
+	cl_object def_list = pop(&args);
+	int nfun = length(def_list);
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	if (nfun == 0) {
+		compile_body(args);
+		return;
+	}
+	asm_op2(op, nfun);
+	do {
+		cl_object definition = pop(&def_list);
+		cl_object name = pop(&definition);
+		asm1(make_lambda(name, definition));
+	} while (!endp(def_list));
+	compile_body(args);
+	asm_op(OP_EXIT);
+
+	lex_env = lex_old;
+}
+
+
+static void
+c_flet(cl_object args) {
+	c_labels_flet(OP_FLET, args);
+}
+
+
+/*
+	There are two operators that produce functions. The first one
+	is
+		OP_FUNCTION
+		symbol
+	which takes the function binding of SYMBOL. The second one is
+		OP_CLOSE
+		interpreted
+	which encloses the INTERPRETED function in the current lexical
+	environment.
+*/
+static void
+c_function(cl_object args) {
+	cl_object function = pop(&args);
+	if (!endp(args))
+		FEerror("Too many arguments to FUNCTION", 0);
+	if (SYMBOLP(function)) {
+		asm_op(OP_FUNCTION);
+		asm1(function);
+	} else if (CONSP(function) && CAR(function) == Slambda) {
+		asm_op(OP_CLOSE);
+		asm1(make_lambda(Cnil, CDR(function)));
+	} else if (CONSP(function) && CAR(function) == siSlambda_block) {
+		cl_object name = CADR(function);
+		cl_object body = CDDR(function);
+		asm_op(OP_CLOSE);
+		asm1(make_lambda(name, body));
+	} else
+		FEerror("No a valid argument to FUNCTION ~S", 1, function);
+}
+
+
+static void
+c_go(cl_object args) {
+	cl_object tag = pop(&args);
+	if (!Null(args))
+		FEerror("Too many arguments to GO",0);
+	if (!reference_tag(tag))
+		asm_op(OP_JMP);		/* Local tag */
+	else {
+		asm_op(OP_GO);		/* Tagbody out of closure */
+		asm1(tag);
+	}
+}
+
+
+/*
+	To get an idea of what goes on
+
+		...		; test form
+		JNIL	labeln
+		...		; form for true case
+		JMP	labelz
+		...		; form fro nil case
+	labelz:
+*/
+static void
+c_if(cl_object form) {
+	cl_fixnum label_nil, label_true;
+
+	/* Compile test */
+	compile_form(pop(&form), FALSE);
+	label_nil = asm_jmp(OP_JNIL);
+
+	/* Compile THEN clause */
+	compile_form(pop(&form), FALSE);
+	label_true = asm_jmp(OP_JMP);
+
+	/* Compile ELSE clause */
+	asm_complete(OP_JNIL, label_nil);
+	if (!endp(form))
+		compile_form(pop(&form), FALSE);
+	asm_complete(OP_JMP, label_true);
+
+	if (!Null(form))
+		FEerror("Too many arguments to IF form", 0);
+}
+
+
+static void
+c_labels(cl_object args) {
+	c_labels_flet(OP_LABELS, args);
+}
+
+
+/*
+	The OP_PUSHENV saves the current lexical environment to allow
+	several bindings.
+		OP_PUSHENV
+		...		; binding forms
+		...		; body
+		OP_EXIT
+
+	There are four forms which perform bindings
+		OP_PBIND	; Bind NAME in the lexical env. using
+		name		; a value from the stack
+		OP_PBINDS	; Bind NAME as special variable using
+		name		; a value from the stack
+		OP_BIND		; Bind NAME in the lexical env. using
+		name		; VALUES(0)
+		OP_BINDS	; Bind NAME as special variable using
+		name		; VALUES(0)
+
+	After a variable has been bound, there are several ways to
+	refer to it.
+
+	1) Refer to the n-th variable in the lexical environment
+		[SYMVAL + n]
+
+	2) Refer to the value of a special variable or constant
+		SYMVALS
+		name
+
+        3) Push the value of the n-th variable of the lexical environment
+		[PUSHV + n]
+
+	4) Push the value of a special variable or constant
+		PUSHVS
+		name
+*/
+
+static void
+c_let_leta(int op, cl_object args) {
+	cl_object bindings, specials, body, l, vars;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	bindings = car(args);
+	siLprocess_declarations(1, CDR(args));
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	/* Optimize some common cases */
+	switch(length(bindings)) {
+	case 0:		compile_body(body); return;
+	case 1:		op = OP_BIND; break;
+	default:
+	}
+
+	asm_op(OP_PUSHENV);
+	for (vars=Cnil, l=bindings; !endp(l); ) {
+		cl_object aux = pop(&l);
+		cl_object var, value;
+		if (ATOM(aux)) {
+			var = aux;
+			value = Cnil;
+		} else {
+			var = pop(&aux);
+			value = pop_maybe_nil(&aux);
+			if (!Null(aux))
+				FEerror("Not a valid argument to LET ~S.", 1,
+					args);
+		}
+		if (!SYMBOLP(var))
+			FEerror("Cannot bind ~S.", 1, var);
+		if (op == OP_PBIND) {
+			compile_form(value, TRUE);
+			vars = CONS(var, vars);
+		} else {
+			compile_form(value, FALSE);
+			c_bind(var, specials);
+		}
+	}
+	while (!endp(vars))
+		c_pbind(pop(&vars), specials);
+	compile_body(body);
+	asm_op(OP_EXIT);
+
+	lex_env = lex_old;
+}
+
+static void
+c_let(cl_object args) {
+	c_let_leta(OP_PBIND, args);
+}
+
+static void
+c_leta(cl_object args) {
+	c_let_leta(OP_BIND, args);
+}
+
+/*
+	MACROLET
+
+	The current lexical environment is saved. A new one is prepared with
+	the definitions of these macros, and this environment is used to
+	compile the body.
+ */
+static void
+c_macrolet(cl_object args)
+{
+	cl_object def_list, def, name;
+	int nfun = 0;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	/* Pop the list of definitions */
+	for (def_list = pop(&args); !endp(def_list); ) {
+		cl_object definition = pop(&def_list);
+		cl_object name = pop(&definition);
+		cl_object arglist = pop(&definition);
+		cl_object macro, function;
+		macro = funcall(4, siSexpand_defmacro, name, arglist,
+				definition);
+		function = make_lambda(name, CDR(macro));
+		lex_macro_bind(name, function);
+	}
+	compile_body(args);
+	lex_env = lex_old;
+}	
+
+
+static void
+c_multiple_value_bind(cl_object args)
+{
+	cl_object vars, value, body, specials;
+	cl_index save_pc, n;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	vars = pop(&args);
+	value = pop(&args);
+	siLprocess_declarations(1,args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	compile_form(value, FALSE);
+	n = length(vars);
+	if (n == 0) {
+		compile_body(body);
+	} else {
+		asm_op(OP_PUSHENV);
+		asm_op2(OP_MBIND, n);
+		for (vars=reverse(vars); n; n--){
+			cl_object var = pop(&vars);
+			if (!SYMBOLP(var))
+				FEerror("Cannot bind ~S.", 1, var);
+			if (special_variablep(var, specials)) {
+				asm1(MAKE_FIXNUM(1));
+				c_register_var(var, TRUE);
+			} else
+				c_register_var(var, FALSE);
+			asm1(var);
+		}
+		compile_body(body);
+		asm_op(OP_EXIT);
+	}
+	lex_env = lex_old;
+}
+
+
+static void
+c_multiple_value_call(cl_object args) {
+	cl_object name;
+
+	name = pop(&args);
+	if (endp(args)) {
+		/* If no arguments, just use ordinary call */
+		c_call(list(1, name), FALSE);
+		return;
+	}
+	asm_op(OP_MCALL);
+	do {
+		compile_form(pop(&args), FALSE);
+		asm_op(OP_PUSHVALUES);
+	} while (!endp(args));
+	compile_form(name, FALSE);
+	asm_op(OP_EXIT);
+}
+
+
+static void
+c_multiple_value_prog1(cl_object args) {
+	compile_form(pop(&args), FALSE);
+	if (!endp(args)) {
+		asm_op(OP_MPROG1);
+		compile_body(args);
+		asm_op(OP_EXIT);
+	}
+}
+
+
+static void
+c_multiple_value_setq(cl_object args) {
+	cl_object orig_vars;
+	cl_object vars = Cnil;
+	cl_object temp_vars = Cnil;
+	cl_object late_assignment = Cnil;
+	cl_index nvars = 0;
+
+	/* Look for symbol macros, building the list of variables
+	   and the list of late assignments. */
+	for (orig_vars = reverse(pop(&args)); !endp(orig_vars); ) {
+		cl_object aux, v = pop(&orig_vars);
+		if (!SYMBOLP(v))
+			FEerror("Cannot bind ~S", 1, v);
+		v = macro_expand1(v, CDR(lex_env));
+		if (!SYMBOLP(v)) {
+			aux = v;
+			v = Lgensym(0);
+			temp_vars = CONS(v, temp_vars);
+			late_assignment = CONS(list(3, Ssetf, aux, v),
+					       late_assignment);
+		}
+		vars = CONS(v, vars);
+		nvars++;
+	}
+
+	if (!Null(temp_vars)) {
+		asm_op(OP_PUSHENV);
+		do {
+			compile_form(Cnil, FALSE);
+			c_bind(CAR(temp_vars), Cnil);
+			temp_vars = CDR(temp_vars);
+		} while (!Null(temp_vars));
+	}
+
+	/* Compile values */
+	compile_form(pop(&args), FALSE);
+	if (args != Cnil)
+		FEerror("Too many arguments to MULTIPLE-VALUE-SETQ",0);
+	if (nvars == 0)
+		/* No variables */
+		return;
+
+	/* Compile variables */
+	asm_op2(OP_MSETQ, nvars);
+	vars = reverse(vars);
+	while (nvars--) {
+		cl_object ndx, var = pop(&vars);
+		if (!SYMBOLP(var))
+			FEerror("MULTIPLE-VALUE-SETQ: ~A is not a symbol", 1, var);
+		ndx = lex_var_sch(var);
+		if (!Null(ndx) && CDR(ndx) != Sspecial)
+			asm1(var); /* Lexical variable */
+		else if (var->symbol.stype == stp_constant)
+			FEerror("MULTIPLE-VALUE-SETQ: Cannot change the value of the constant ~A", 1,var);
+		else {
+			asm1(MAKE_FIXNUM(1));
+			asm1(var);
+		}
+	}
+
+	/* Assign to symbol-macros */
+	if (!Null(late_assignment)) {
+		compile_body(late_assignment);
+		asm_op(OP_EXIT);
+	}
+}
+
+
+/*
+	The OP_NTHVAL operator moves a value from VALUES(ndx) to
+	VALUES(0). The index NDX is taken from the stack.
+
+		OP_NTHVAL
+*/
+static void
+c_nth_value(cl_object args) {
+	compile_form(pop(&args), TRUE);		/* INDEX */
+	compile_form(pop(&args), FALSE);	/* VALUES */
+	if (args != Cnil)
+		FEerror("Too many arguments to NTH-VALUE",0);
+	asm_op(OP_NTHVAL);
+}
+
+
+static void
+c_or(cl_object args) {
+	if (Null(args)) {
+		asm1(Cnil);
+		return;
+	} else if (ATOM(args)) {
+		FEerror("Wrong type of argument to AND ~S", 1, args);
+	} else {
+		compile_form(pop(&args), FALSE);
+		if (!endp(args)) {
+			cl_index label = asm_jmp(OP_JT);
+			c_or(args);
+			asm_complete(OP_JT, label);
+		}
+	}
+}
+
+
+/*
+	The OP_PROGV operator exectures a set of statements in a lexical
+	environment that has been extended with special variables. The
+	list of special variables is taken from the top of the stack,
+	while the list of values is in VALUES(0).
+
+		...		; list of variables
+		OP_PUSH
+		...		; list of values
+		OP_PROGV
+		...		; body of progv
+		OP_EXIT
+*/
+static void
+c_progv(cl_object args) {
+	cl_object vars = pop(&args);
+	cl_object values = pop(&args);
+
+	/* The list of variables is in the stack */
+	compile_form(vars, TRUE);
+
+	/* The list of values is in VALUES(0) */
+	compile_form(values, FALSE);
+
+	/* The body is interpreted within an extended lexical
+	   environment. However, as all the new variables are
+	   special, the compiler need not take care of them
+	*/
+	asm_op(OP_PROGV);
+	compile_body(args);
+	asm_op(OP_EXIT);
+}
+
+
+/*
+	There are four assignment operators. They are
+
+	1) Assign VALUES(0) to the lexical variable which occupies the
+	   N-th position
+		[OP_SETQ + n]
+
+	2) Assign VALUES(0) to the special variable NAME
+		OP_SETQS
+		name
+
+	3) Pop a value from the stack and assign it to the lexical
+	   variable in the N-th position.
+		[OP_PSETQ + n]
+
+	4) Pop a value from the stack and assign it to the special
+	   variable denoted by NAME
+		OP_PSETQS
+		name
+*/
+static void
+c_psetq(cl_object old_args) {
+	cl_object args = Cnil, vars = Cnil;
+	bool use_psetf = FALSE;
+	cl_index nvars = 0;
+
+	/* We have to make sure that non of the variables which
+	   are to be assigned is actually a symbol macro. If that
+	   is the case, we invoke (PSETF ...) to handle the
+	   macro expansions.
+	*/
+	while (!endp(old_args)) {
+		cl_object var = pop(&old_args);
+		cl_object value = pop(&old_args);
+		if (!SYMBOLP(var))
+			FEerror("Cannot assign to ~a", 1, var);
+		var = macro_expand1(var, CDR(lex_env));
+		if (!SYMBOLP(var))
+			use_psetf = TRUE;
+		args = CONS(var, CONS(value, args));
+		nvars++;
+	}
+	if (use_psetf) {
+		compile_form(CONS(Spsetf, args), FALSE);
+		return;
+	}
+	while (!endp(args)) {
+		cl_object var = pop(&args);
+		cl_object value = pop(&args);
+		vars = CONS(var, vars);
+		compile_form(value, TRUE);
+	}
+	while (!endp(vars))
+		compile_setq(OP_PSETQ, pop(&vars));
+}
+
+
+/*
+	The OP_RETFROM operator returns from a block using the objects
+	in VALUES() as output values.
+
+		...		; output form
+		OP_RETFROM
+		tag		; object which names the block
+*/
+static void
+c_return(cl_object stmt) {
+	cl_object output = pop_maybe_nil(&stmt);
+
+	compile_form(output, FALSE);
+	asm_op(OP_RETURN);
+	asm1(Cnil);
+	if (stmt != Cnil)
+		FEerror("Too many arguments to RETURN", 0);
+}
+
+
+static void
+c_return_from(cl_object stmt) {
+	cl_object name = pop(&stmt);
+	cl_object output = pop_maybe_nil(&stmt);
+
+	compile_form(output, FALSE);
+	asm_op(OP_RETURN);
+	if (!SYMBOLP(name))
+		FEerror("Not a valid return tag ~S", 1, name);
+	asm1(name);
+	if (stmt != Cnil)
+		FEerror("Too many arguments to RETURN-FROM", 0);
+}
+
+
+static void
+c_setq(cl_object args) {
+	while (!endp(args)) {
+		cl_object var = pop(&args);
+		cl_object value = pop(&args);
+		if (!SYMBOLP(var))
+			FEerror("Cannot bind ~S", 1, var);
+		var = macro_expand1(var, CDR(lex_env));
+		if (SYMBOLP(var)) {
+			compile_form(value, FALSE);
+			compile_setq(OP_SETQ, var);
+		} else {
+			compile_form(list(3, Ssetf, var, value), FALSE);
+		}
+	}
+}
+
+
+static void
+c_symbol_macrolet(cl_object args)
+{
+	cl_object def_list, def, name, specials, body;
+	cl_object lex_old = lex_env;
+	int nfun = 0;
+
+	/* Set a new lexical environment where we will bind
+	   our macrology */
+	lex_copy();
+
+	def_list = pop(&args);
+	siLprocess_declarations(1,args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	/* Scan the list of definitions */
+	for (; !endp(def_list); ) {
+		cl_object definition = pop(&def_list);
+		cl_object name = pop(&definition);
+		cl_object expansion = pop(&definition);
+		cl_object arglist = list(2, Lgensym(0), Lgensym(0));
+		cl_object function;
+		if (special_variablep(name, specials))
+			FEerror("Symbol ~A cannot be declared special and appear in a SYMBOL-MACROLET", 1, name);
+		definition = list(2, arglist, list(2, Squote, expansion));
+		function = make_lambda(name, definition);
+		lex_symbol_macro_bind(name, function);
+	}
+	compile_body(body);
+	lex_env = lex_old;
+}
+
+static void
+c_tagbody(cl_object args)
+{
+	int i, nt;
+	cl_fixnum label0, labelz;
+	cl_object body, tag_list;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	/* count and register the tags */
+	for (nt = 0, tag_list = Cnil, body = args; !endp(body); body = CDR(body)) {
+		cl_object form = CAR(body);
+		int type = type_of(form);
+		if (type == t_symbol || type == t_fixnum || type == t_bignum) {
+			tag_list = CONS(list(3, form, Stag, Cnil), tag_list);
+			nt += 1;
+		}
+	}
+	if (nt == 0) {
+		compile_body(args);
+		return;
+	}
+	label0 = current_pc();
+	CDR(lex_env) = nconc(nreverse(tag_list), CDR(lex_env));
+
+	/*
+	 * We compile the body, storing the address of each label.
+	 */
+	for (tag_list = CDR(lex_env), body = args; !endp(body); body = CDR(body)) {
+		cl_object form = CAR(body);
+		int type = type_of(form);
+		if (type == t_symbol || type == t_fixnum || type == t_bignum) {
+			/* Each label points to a place in the bytecodes
+			   stack. This point is registered at the beginning of
+			   the tag list. */
+			cl_object pc = MAKE_FIXNUM(current_pc());
+			cl_object tag = CAR(tag_list);
+			cl_object relocation = CADDR(tag);
+			CADDR(tag) = CONS(pc, relocation);
+			tag_list = CDR(tag_list);
+		} else if (CONSP(form)) {
+			/* Since the output of all forms is ignored, we
+			   need only compile forms which are not atoms */
+			compile_form(form, FALSE);
+		}
+	}
+	/*
+	 * Each (GO ...) form leads to either a local jump, or a jump
+	 * out of a closure. In this loop we fix the destination of those
+	 * local jumps...
+	 */
+	for (i = 0, tag_list = Cnil; nt; nt--, CDR(lex_env) = CDDR(lex_env)) {
+		cl_object tag = CADR(lex_env);
+		cl_object tag_name = CAR(tag);
+		cl_object relocation = CADDR(tag);
+		cl_fixnum pc = fix(pop(&relocation));
+		while (!endp(relocation)) {
+			cl_object jump = pop(&relocation);
+			if (FIXNUMP(jump)) {
+				cl_fixnum pc_orig = fix(jump);
+				asm_at(pc_orig, make_op2(OP_JMP, pc - pc_orig));
+				continue;
+			}
+			tag_list = nconc(tag_list,
+					 list(2, tag_name, MAKE_FIXNUM(pc)));
+			i++;
+		}
+	}
+	/*
+	 * ...and in this loop we keep a record of the tags that were
+	 * referenced by nonlocal jumps. This implies inserting an OP_TAGBODY
+	 * operand with its relocation table at LABEL0.
+	 */
+	if (!i)
+		compile_body(Cnil);
+	else {
+		cl_fixnum delta = 1 + 2*i;
+		cl_fixnum label;
+		asm_op(OP_EXIT);
+		asm_insert(label0, make_op2(OP_TAGBODY, i));
+		while (!endp(tag_list)) {
+			cl_object name = pop(&tag_list);
+			cl_fixnum pc = fix(pop(&tag_list)) + delta;
+			asm_insert(label0, name); label0++;
+			asm_insert(label0, MAKE_FIXNUM(pc - label0)); label0++;
+		}
+	}
+}
+
+
+/*
+	The OP_THROW jumps to an enclosing OP_CATCH whose tag
+	matches the one of the throw. The tag is taken from the
+	stack, while the output values are left in VALUES().
+*/
+static void
+c_throw(cl_object stmt) {
+	/* FIXME! Do we apply the right protocol here? */
+	cl_object tag = pop(&stmt);
+	cl_object form = pop(&stmt);
+	if (stmt != Cnil)
+		FEerror("Too many argumnents to THROW",0);
+	compile_form(tag, TRUE);
+	compile_form(form, FALSE);
+	asm_op(OP_THROW);
+}
+
+
+static void
+c_unless(cl_object form) {
+	cl_fixnum label_true, label_false;
+
+	/* Compile test */
+	compile_form(pop(&form), FALSE);
+	label_true = asm_jmp(OP_JT);
+
+	/* Compile body */
+	compile_body(form);
+	label_false = asm_jmp(OP_JMP);
+	asm_complete(OP_JT, label_true);
+
+	/* When test failed, output NIL */
+	asm1(Cnil);
+	asm_complete(OP_JMP, label_false);
+}
+
+
+static void
+c_unwind_protect(cl_object args) {
+	cl_index label = asm_jmp(OP_UNWIND);
+
+	/* Compile form to be protected */
+	compile_form(pop(&args), FALSE);
+	asm_op(OP_EXIT);
+
+	/* Compile exit clause */
+	asm_complete(OP_UNWIND, label);
+	compile_body(args);
+	asm_op(OP_EXIT);
+}
+
+
+/*
+	The OP_VALUES moves N values from the stack to VALUES().
+
+		[OP_VALUES + n]
+*/
+static void
+c_values(cl_object args) {
+	int n = 0;
+
+	while (!endp(args)) {
+		compile_form(pop_maybe_nil(&args), TRUE);
+		n++;
+	}
+	asm_op2(OP_VALUES, n);
+}
+
+
+static void
+c_when(cl_object form) {
+	cl_fixnum label;
+
+	/* Compile test */
+	compile_form(pop(&form), FALSE);
+	label = asm_jmp(OP_JNIL);
+
+	/* Compile body */
+	compile_body(form);
+	asm_complete(OP_JNIL, label);
+}
+
+
+static void
+compile_form(cl_object stmt, bool push) {
+	compiler_record *l;
+	cl_object function;
+	cl_object macro;
+
+	/* FIXME! We should protect this region with error handling */
+ BEGIN:
+	/*
+	 * First try with variable references and quoted constants
+	 */
+	if (ATOM(stmt)) {
+		if (SYMBOLP(stmt)) {
+			if (push) asm_op(OP_PUSHV);
+			asm1(stmt);
+			goto OUTPUT;
+		}
+	QUOTED:
+		if (push)
+			asm_op(OP_PUSHQ);
+		else if (FIXNUMP(stmt) || SYMBOLP(stmt))
+			asm_op(OP_QUOTE);
+		asm1(stmt);
+		goto OUTPUT;
+	}
+ LIST:
+	/*
+	 * Next try with special forms.
+	 */
+	function = CAR(stmt);
+	if (!SYMBOLP(function))
+		goto ORDINARY_CALL;
+	if (function == Squote) {
+		stmt = CDR(stmt);
+		if (CDR(stmt) != Cnil)
+			FEerror("Too many arguments to QUOTE",0);
+		stmt = CAR(stmt);
+		goto QUOTED;
+	}
+	for (l = database; l->symbol != OBJNULL; l++)
+		if (l->symbol == function) {
+			(*(l->compiler))(CDR(stmt));
+			if (push) asm_op(OP_PUSH);
+			goto OUTPUT;
+		}
+	/*
+	 * Next try to macroexpand
+	 */
+	{
+		cl_object new_stmt = macro_expand1(stmt, CDR(lex_env));
+		if (new_stmt != stmt){
+			stmt = new_stmt;
+			goto BEGIN;
+		}
+	}
+	if (function->symbol.isform)
+		FEerror("Found no macroexpander for special form ~S", 1, function);
+ ORDINARY_CALL:
+	/*
+	 * Finally resort to ordinary function calls.
+	 */
+	c_call(stmt, push);
+ OUTPUT:
+}
+
+
+static void
+compile_body(cl_object body) {
+	if (endp(body))
+		asm_op(OP_NOP);
+	else do {
+		compile_form(CAR(body), FALSE);
+		body = CDR(body);
+	} while (!endp(body));
+}
+
+/* ----------------------------- PUBLIC INTERFACE ---------------------------- */
+
+/* ------------------------------------------------------------
+   LAMBDA OBJECTS: An interpreted function is a vector made of
+	the following components
+
+      #(LAMBDA
+	{block-name | NIL}
+	{variable-env | NIL}
+	{function-env | NIL}
+	{block-env | NIL}
+	(list of variables declared special)
+	Nreq {var}*			; required arguments
+	Nopt {var value flag}*		; optional arguments
+	{rest-var NIL}			; rest variable
+	{T | NIL}			; allow other keys?
+	Nkey {key var value flag}*	; keyword arguments
+	Naux {var init}			; auxiliary variables
+	documentation-string
+	list-of-declarations
+	{form}*				; body)
+
+   ------------------------------------------------------------ */
+
+#define push(v,l) l = CONS(v, l)
+#define push_var(v, list) \
+	check_symbol(v); \
+	if (v->symbol.stype == stp_constant) \
+		FEerror("~S is not a variable.", 1, v); \
+	push(v, list);
+
+/*
+  Handles special declarations, removes declarations from body
+ */
+@(defun si::process_declarations (body &optional doc)
+	cl_object documentation = Cnil, declarations = Cnil, form, specials = Cnil;
+	cl_object decls, vars, v;
+@
+	/* BEGIN: SEARCH DECLARE */
+	for (; !endp(body); body = CDR(body)) {
+	  form = CAR(body);
+
+	  if (!Null(doc) && type_of(form) == t_string) {
+	    if (documentation == Cnil)
+	      documentation = form;
+	    else
+	      break;
+	    continue;
+	  }
+
+	  if (ATOM(form) || (CAR(form) != Sdeclare))
+	    break;
+
+	  for (decls = CDR(form); !endp(decls); decls = CDR(decls)) {
+	    cl_object sentence = CAR(decls);
+	    if (ATOM(sentence))
+	      FEerror("Illegal declaration form", 1, form);
+	    push(sentence, declarations);
+	    if (CAR(sentence) == Sspecial)
+	      for (vars = CDR(sentence); !endp(vars); vars = CDR(vars)) {
+		v = CAR(vars);
+		check_symbol(v);
+		push(v,specials);
+	      }
+	  }
+	}
+	/* END: SEARCH DECLARE */
+
+	@(return declarations body documentation specials)
+@)
+
+@(defun si::process_lambda_list (lambda)
+	cl_object documentation, declarations, specials;
+	cl_object lambda_list, body, form;
+	cl_object x, v, key, init, spp;
+	cl_object reqs = Cnil, opts = Cnil, keys = Cnil, rest = Cnil, auxs = Cnil;
+	int nreq = 0, nopt = 0, nkey = 0, naux = 0;
+	cl_object allow_other_keys = Cnil;
+@
+	bds_check;
+	if (ATOM(lambda))
+		FEerror("No lambda list.", 0);
+	lambda_list = CAR(lambda);
+
+	declarations = siLprocess_declarations(2, CDR(lambda), Ct);
+	body = VALUES(1);
+	documentation = VALUES(2);
+	specials = VALUES(3);
+
+REQUIRED:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		v = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		if (v == SAallow_other_keys)
+			goto ILLEGAL_LAMBDA;
+		if (v == SAoptional)
+			goto OPTIONAL;
+		if (v == SArest)
+			goto REST;
+		if (v == SAkey)
+			goto KEYWORD;
+		if (v == SAaux)
+			goto AUX;
+		nreq++;
+		push_var(v, reqs);
+	}
+OPTIONAL:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		x = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		spp = Cnil;
+		init = Cnil;
+		if (ATOM(x)) {
+			if (x == SAoptional || x == SAallow_other_keys)
+				goto ILLEGAL_LAMBDA;
+			if (x == SArest)
+				goto REST;
+			if (x == SAkey)
+				goto KEYWORD;
+			if (x == SAaux)
+				goto AUX;
+			v = x;
+		} else {
+			v = CAR(x);
+			if (!endp(x = CDR(x))) {
+				init = CAR(x);
+				if (!endp(x = CDR(x))) {
+					spp = CAR(x);
+					if (!endp(CDR(x)))
+						goto ILLEGAL_LAMBDA;
+				}
+			}
+		}
+		nopt++;
+		push_var(v, opts);
+		push(init, opts);
+		if (spp != Cnil) {
+			push_var(spp, opts);
+		} else {
+			push(Cnil, opts);
+		}
+	}
+
+REST:
+	if (endp(lambda_list))
+		goto ILLEGAL_LAMBDA;
+	v = CAR(lambda_list);
+	push_var(v, rest);
+
+	lambda_list = CDR(lambda_list);
+	if (endp(lambda_list))
+		goto OUTPUT;
+	v = CAR(lambda_list);
+	lambda_list = CDR(lambda_list);
+	if (v == SAoptional || v == SArest || v == SAallow_other_keys)
+		goto ILLEGAL_LAMBDA;
+	if (v == SAkey)
+		goto KEYWORD;
+	if (v == SAaux)
+		goto AUX;
+	goto ILLEGAL_LAMBDA;
+
+KEYWORD:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		init = Cnil;
+		spp = Cnil;
+		x = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		if (ATOM(x)) {
+			if (x == SAallow_other_keys) {
+				if (!Null(allow_other_keys))
+					goto ILLEGAL_LAMBDA;
+				allow_other_keys = Ct;
+				if (endp(lambda_list))
+					goto OUTPUT;
+				x = CAR(lambda_list);
+				lambda_list = CDR(lambda_list);
+				if (key != SAaux)
+					goto ILLEGAL_LAMBDA;
+				goto AUX;
+			} else if (x == SAoptional || x == SArest || x == SAkey)
+				goto ILLEGAL_LAMBDA;
+			else if (x == SAaux)
+				goto AUX;
+			v = x;
+		} else {
+			v = CAR(x);
+			if (!endp(x = CDR(x))) {
+				init = CAR(x);
+				if (!endp(x = CDR(x))) {
+					spp = CAR(x);
+					if (!endp(CDR(x)))
+						goto ILLEGAL_LAMBDA;
+				}
+			}
+		}
+		if (CONSP(v)) {
+			x = v;
+			key = CAR(x);
+			if (key->symbol.hpack != keyword_package)
+				FEerror("~S is not a keyword", 1, key);
+			if (endp(CDR(x)) || !endp(CDDR(x)))
+				goto ILLEGAL_LAMBDA;
+			v = CADR(x);
+		} else {
+			check_symbol(v);
+			key = intern(v->symbol.name, keyword_package);
+		}
+		nkey++;
+		push(key, keys);
+		push_var(v, keys);
+		push(init, keys);
+		if (Null(spp)) {
+			push(Cnil, keys);
+		} else {
+			push_var(spp, keys);
+		}
+	}
+
+AUX:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		x = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		if (ATOM(x)) {
+			if (x == SAoptional || x == SArest ||
+			    x == SAkey || x == SAallow_other_keys ||
+			    x == SAaux)
+				goto ILLEGAL_LAMBDA;
+			v = x;
+			init = Cnil;
+		} else if (endp(CDDR(x))) {
+			v = CAR(x);
+			init = CADR(x);
+		} else
+			goto ILLEGAL_LAMBDA;
+		naux++;
+		push_var(v, auxs);
+		push(init, auxs);
+	}
+
+OUTPUT:
+	@(return CONS(MAKE_FIXNUM(nreq), nreverse(reqs))
+		 CONS(MAKE_FIXNUM(nopt), nreverse(opts))
+		 nreverse(rest)
+		 allow_other_keys
+		 CONS(MAKE_FIXNUM(nkey), nreverse(keys))
+		 nreverse(auxs)
+		 documentation
+		 specials
+		 declarations
+		 body)
+
+ILLEGAL_LAMBDA:
+	FEerror("Illegal lambda list ~S.", 1, CAR(lambda));
+@)
+
+static void
+c_default(cl_index deflt_pc) {
+	cl_object deflt = asm_ref(deflt_pc);
+	enum cl_type t = type_of(deflt);
+	if ((t == t_symbol) && (deflt->symbol.stype == stp_constant))
+		/* FIXME! Shouldn't this happen only in unsafe mode */
+		asm_at(deflt_pc, SYM_VAL(deflt));
+	else if ((t == t_symbol) || (t == t_cons) || (t == t_fixnum)) {
+		cl_index pc = current_pc();
+		asm_at(deflt_pc, MAKE_FIXNUM(pc-deflt_pc));
+		compile_form(deflt, FALSE);
+		asm_op(OP_EXIT);
+	}
+}
+
+static void
+c_register_var2(register cl_object var, register cl_object *specials)
+{
+	if (Null(var))
+		return;
+	if (member_eq(var, *specials))
+		c_register_var(var, TRUE);
+	else if (var->symbol.stype == stp_special) {
+		*specials = CONS(var, *specials);
+		c_register_var(var, TRUE);
+	} else if (var->symbol.stype == stp_constant)
+		FEerror("Cannot bind the constant ~A", 1, var);
+	else
+		c_register_var(var, FALSE);
+}
+
+cl_object
+make_lambda(cl_object name, cl_object lambda) {
+	cl_object reqs, opts, rest, keys, auxs, allow_other_keys;
+	cl_object specials, doc, decl, body, l;
+	cl_index specials_pc, opts_pc, keys_pc, label;
+	int nopts, nkeys;
+	cl_index handle;
+	cl_object lex_old = lex_env;
+
+	lex_copy();
+
+	/* Mark closure boundary */
+	CDR(lex_env) = CONS(CONS(Ct, Cnil), CDR(lex_env));
+
+	reqs = siLprocess_lambda_list(1,lambda);
+	opts = VALUES(1);
+	rest = VALUES(2);
+	allow_other_keys = VALUES(3);
+	keys = VALUES(4);
+	auxs = VALUES(5);
+	doc  = VALUES(6);
+	specials = VALUES(7);
+	decl = VALUES(8);
+	body = VALUES(9);
+
+	handle = asm_begin();
+
+	asm1(name);			/* Name of the function */
+	specials_pc = current_pc();	/* Which variables are declared special */
+	asm1(specials);
+
+	asm_list(reqs);			/* Special arguments */
+	reqs = CDR(reqs);
+	while (!endp(reqs)) {
+		cl_object v = pop(&reqs);
+		c_register_var2(v, &specials);
+	}
+
+	opts_pc = current_pc()+1;	/* Optional arguments */
+	nopts = fix(CAR(opts));
+	asm_list(opts);
+
+	asm_list(rest);			/* Name of &rest argument */
+
+	asm1(allow_other_keys);		/* Value of &allow-other-keys */
+
+	keys_pc = current_pc()+1;	/* Keyword arguments */
+	nkeys = fix(CAR(keys));
+	asm_list(keys);
+	asmn(2, doc, decl);
+
+	label = asm_jmp(OP_JMP);
+
+	while (nopts--) {
+		c_default(opts_pc+1);
+		c_register_var2(asm_ref(opts_pc), &specials);
+		c_register_var2(asm_ref(opts_pc+2), &specials);
+		opts_pc+=3;
+	}
+	c_register_var2(car(rest), &specials);
+	while (nkeys--) {
+		c_default(keys_pc+2);
+		c_register_var2(asm_ref(keys_pc+1), &specials);
+		c_register_var2(asm_ref(keys_pc+3), &specials);
+		keys_pc+=4;
+	}
+	
+	if ((current_pc() - label) == 1)
+		set_pc(label);
+	else
+		asm_complete(OP_JMP, label);
+	while (!endp(auxs)) {		/* Local bindings */
+		cl_object var = pop(&auxs);
+		cl_object value = pop(&auxs);
+		compile_form(value, FALSE);
+		c_bind(var, specials);
+	}
+	asm_at(specials_pc, specials);
+	compile_body(body);
+	asm_op(OP_HALT);
+
+	lex_env = lex_old;
+
+	return asm_end(handle);
+}
+
+static cl_object
+alloc_bytecodes()
+{
+	cl_object vector = alloc_simple_vector(128, aet_object);
+	array_allocself(vector);
+	vector->vector.hasfillp = TRUE;
+	vector->vector.fillp = 0;
+	return vector;
+}
+
+@(defun si::make_lambda (name rest)
+	cl_object lambda, old_bytecodes = bytecodes;
+	cl_object lex_old = lex_env;
+@
+	lex_new();
+	bytecodes = alloc_bytecodes();
+	lambda = make_lambda(name,rest);
+	bytecodes = old_bytecodes;
+	lex_env = lex_old;
+	@(return lambda)
+@)
+
+cl_object
+eval(cl_object form, cl_object *new_bytecodes)
+{
+	cl_object old_bytecodes = bytecodes;
+	cl_index handle;
+
+	if (new_bytecodes == NULL)
+		bytecodes = alloc_bytecodes();
+	else if (*new_bytecodes != Cnil) {
+		bytecodes = *new_bytecodes;
+	} else {
+		bytecodes = *new_bytecodes = alloc_bytecodes();
+	}
+	handle = asm_begin();
+	compile_form(form, FALSE);
+	asm_op(OP_EXIT);
+	asm_op(OP_HALT);
+/*  	Lprint(1,bytecodes); */
+	VALUES(0) = Cnil;
+	NValues = 0;
+	interpret(&bytecodes->vector.self.t[handle]);
+	asm_clear(handle);
+	bytecodes = old_bytecodes;
+	return VALUES(0);
+}
+
+void
+init_compiler(void)
+{
+	compiler_record *l;
+
+	register_root(&bytecodes);
+
+	for (l = database; l->name[0] != 0; l++)
+	  l->symbol = _intern(l->name, lisp_package);
+}
diff --git a/src/c/new/interpreter.d b/src/c/new/interpreter.d
new file mode 100644
index 000000000..150ae7e50
--- /dev/null
+++ b/src/c/new/interpreter.d
@@ -0,0 +1,874 @@
+/*
+    interpreter.c -- Bytecode interpreter.
+*/
+/*
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include "ecls-inl.h"
+#include "bytecodes.h"
+
+#define next_code(v) *(v++)
+
+static void
+lambda_bind_var(cl_object var, cl_object val, cl_object specials)
+{
+	if (!member_eq(var, specials))
+		CAR(lex_env) = CONS(CONS(var, CONS(val, Cnil)), CAR(lex_env));
+	else {
+		CAR(lex_env) = CONS(CONS(var, Cnil), CAR(lex_env));
+		bds_bind(var, val);
+	}
+}
+
+static void
+bind_var(register cl_object var, register cl_object val)
+{
+	CAR(lex_env) = CONS(CONS(var, CONS(val, Cnil)), CAR(lex_env));
+}
+
+static void
+bind_special(register cl_object var, register cl_object val)
+{
+	CAR(lex_env) = CONS(CONS(var, Cnil), CAR(lex_env));
+	bds_bind(var, val);
+}
+
+static cl_object *
+lambda_bind(int narg, cl_object lambda_list, cl_object *args)
+{
+	cl_object *data = &lambda_list->bytecodes.data[2];
+	cl_object specials = lambda_list->bytecodes.data[1];
+	cl_object aux;
+	int i, n;
+	bool other_keys = FALSE;
+	bool check_remaining = TRUE;
+
+	/* 1) REQUIRED ARGUMENTS:  N var1 ... varN */
+	n = fix(next_code(data));
+	if (narg < n)
+	  check_arg_failed(narg, n);
+	for (; n; n--, narg--)
+	  lambda_bind_var(next_code(data), next_code(args), specials);
+
+	/* 2) OPTIONAL ARGUMENTS:  N var1 value1 flag1 ... varN valueN flagN */
+	for (n = fix(next_code(data)); n; n--, data+=3) {
+	  if (narg) {
+	    lambda_bind_var(data[0], args[0], specials);
+	    args++; narg--;
+	    if (!Null(data[2]))
+	      lambda_bind_var(data[2], Ct, specials);
+	  } else {
+	    cl_object defaults = data[1];
+	    if (FIXNUMP(defaults)) {
+	      interpret(&data[1] + fix(defaults));
+	      defaults = VALUES(0);
+	    }
+	    lambda_bind_var(data[0], defaults, specials);
+	    if (!Null(data[2]))
+	      lambda_bind_var(data[2], Cnil, specials);
+	  }
+	}
+
+	/* 3) REST ARGUMENT: {rest-var | NIL} */
+	if (!Null(data[0])) {
+	  cl_object rest = Cnil;
+	  check_remaining = FALSE;
+	  for (i=narg; i; )
+	    rest = CONS(args[--i], rest);
+	  lambda_bind_var(data[0], rest, specials);
+	}
+	data++;
+
+	/* 4) ALLOW-OTHER-KEYS: { T | NIL } */
+	other_keys = !Null(next_code(data));
+
+	/* 5) KEYWORDS: N key1 var1 value1 flag1 ... keyN varN valueN flagN */
+	n = fix(next_code(data));
+	if (n != 0 || other_keys) {
+	  cl_object *keys;
+	  cl_object spp[n];
+	  bool other_found = FALSE;
+	  for (i=0; i<n; i++)
+	    spp[i] = OBJNULL;
+	  for (; narg; args+=2, narg-=2) {
+	    if (!SYMBOLP(args[0]) || args[0]->symbol.hpack != keyword_package)
+	      FEerror("Not a keyword ~S.", 1, args[0]);
+	    keys = data;
+	    for (i = 0; i < n; i++, keys += 4) {
+	      if (args[0] == keys[0]) {
+		if (spp[i] == OBJNULL)
+		  spp[i] = args[1];
+		goto FOUND;
+	      }
+	    }
+	    if (args[0] != SAallow_other_keys)
+	      other_found = TRUE;
+	    else
+	      other_keys = (args[1] == Cnil);
+	  FOUND:
+	  }
+	  if (other_found && !other_keys)
+	    FEerror("Unknown keys found", 0);
+	  for (i=0; i<n; i++, data+=4) {
+	    if (spp[i] != OBJNULL)
+	      lambda_bind_var(data[1],spp[i],specials);
+	    else {
+	      cl_object defaults = data[2];
+	      if (FIXNUMP(defaults)) {
+		      interpret(&data[2] + fix(defaults));
+		      defaults = VALUES(0);
+	      }
+	      lambda_bind_var(data[1],defaults,specials);
+	    }
+	    if (!Null(data[3]))
+	      lambda_bind_var(data[3],(spp[i] != OBJNULL)? Ct : Cnil,specials);
+	  }
+	}
+	if (narg && !other_keys && check_remaining)
+	  FEerror("Too many arguments to function ~S", 1,
+		  lambda_list->bytecodes.data[0]);
+
+	return &data[2];
+}
+
+cl_object
+lambda_apply(int narg, cl_object fun, cl_object *args)
+{       cl_object lex_old = lex_env;
+	cl_object output, name, *body;
+	bds_ptr old_bds_top;
+	volatile bool block, closure;
+
+	if (type_of(fun) != t_bytecodes)
+		FEinvalid_function(fun);
+
+	/* Set the lexical environment of the function */
+	ihs_check;
+	if (Null(fun->bytecodes.lex))
+		lex_env = CONS(Cnil, Cnil);
+	else
+		lex_env = CONS(CAR(fun->bytecodes.lex),CDR(fun->bytecodes.lex));
+	ihs_push(fun, lex_env);
+	old_bds_top = bds_top;
+
+	/* Establish bindings */
+	body = lambda_bind(narg, fun, args);
+
+	/* If it is a named lambda, set a block for RETURN-FROM */
+	block = FALSE;
+	name = fun->bytecodes.data[0];
+	if (Null(fun->bytecodes.data[0]))
+		block = FALSE;
+	else {
+		block = TRUE;
+		fun = new_frame_id();
+		lex_block_bind(name, fun);
+		if (frs_push(FRS_CATCH, fun)) {
+			output = VALUES(0);
+			goto END;
+		}
+	}
+
+	/* Process statements */
+	VALUES(0) = Cnil;
+	NValues = 0;
+	interpret(body);
+
+END:    if (block) frs_pop();
+	bds_unwind(old_bds_top);
+	lex_env = lex_old;
+	ihs_pop();
+	returnn(VALUES(0));
+}
+
+
+/* ----------------- BYTECODE STACK --------------- */
+
+cl_object stack = OBJNULL;
+
+static void
+stack_grow(void) {
+	cl_object *old_data = stack->vector.self.t;
+	cl_index old_size = stack->vector.fillp;
+	stack->vector.dim += 128;
+	array_allocself(stack);
+	memcpy(stack->vector.self.t, old_data, old_size*sizeof(cl_object));
+}
+
+static void
+push1(register cl_object op) {
+	cl_index where;
+	where = stack->vector.fillp;
+	if (where >= stack->vector.dim)
+		stack_grow();
+	stack->vector.self.t[where] = op;
+	stack->vector.fillp++;
+}
+
+static cl_object
+pop1() {
+	return stack->vector.self.t[--stack->vector.fillp];
+}
+
+static cl_index
+get_sp_index() {
+	return stack->vector.fillp;
+}
+
+static void
+dec_sp_index(register cl_index delta) {
+	stack->vector.fillp -= delta;
+}
+
+static void
+set_sp_index(register cl_index sp) {
+	if (stack->vector.fillp < sp)
+		FEerror("Tried to advance stack", 0);
+	stack->vector.fillp = sp;
+}
+
+static cl_object *
+get_sp() {
+	return stack->vector.self.t + stack->vector.fillp;
+}
+
+static cl_object *
+get_sp_at(cl_index where) {
+	return stack->vector.self.t + where;
+}
+
+/* -------------------- AIDS TO THE INTERPRETER -------------------- */
+
+static inline cl_fixnum
+get_oparg(cl_object o) {
+	return GET_OPARG(o);
+}
+
+static inline cl_object *
+packed_label(cl_object *v) {
+	return v + GET_OPARG(v[0]);
+}
+
+static inline cl_object *
+simple_label(cl_object *v) {
+	return v + fix(v[0]);
+}
+
+static cl_object
+search_symbol_function(register cl_object fun) {
+	cl_object output = lex_fun_sch(fun);
+	if (!Null(output))
+		return output;
+	output = SYM_FUN(fun);
+	if (output == OBJNULL || fun->symbol.mflag)
+		FEundefined_function(fun);
+	return output;
+}
+
+static cl_object
+search_symbol_value(register cl_object s) {
+	cl_object x;
+	/*  x = lex_var_sch(form);  */
+	for (x = CAR(lex_env);  CONSP(x);  x = CDR(x))
+		if (CAAR(x) == s) {
+			x = CDAR(x);
+			if (ENDP(x)) break;
+			return CAR(x);
+		}
+	x = SYM_VAL(s);
+	if (x == OBJNULL)
+		FEunbound_variable(s);
+	return x;
+}
+		
+static cl_object
+interpret_apply(int narg, cl_object fun, cl_object *args) {
+	cl_object x;
+
+ AGAIN:
+	switch (type_of(fun)) {
+	case t_cfun:
+		ihs_push_funcall(fun->cfun.name);
+		x = APPLY(narg, fun->cfun.entry, args);
+		ihs_pop();
+		return x;
+	case t_cclosure:
+		/* FIXME! Shouldn't we register this call somehow? */
+		return APPLY_closure(narg, fun->cclosure.entry, fun->cclosure.env, args);
+#ifdef CLOS
+	case t_gfun:
+		ihs_push_funcall(fun->gfun.name);
+		x = gcall(narg, fun, args);
+		ihs_pop();
+		return x;
+#endif
+	case t_bytecodes:
+		return lambda_apply(narg, fun, args);
+	case t_symbol:
+		fun = search_symbol_function(fun);
+		goto AGAIN;
+	default:
+	}
+	FEinvalid_function(fun);
+}
+
+/* -------------------- THE INTERPRETER -------------------- */
+
+static cl_object *
+interpret_block(cl_object *vector) {
+	cl_object * volatile exit, name;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	exit = packed_label(vector - 1);
+	lex_block_bind(next_code(vector), id);
+	if (frs_push(FRS_CATCH,id) == 0)
+		vector = interpret(vector);
+	frs_pop();
+	lex_env = lex_old;
+	return exit;
+}
+
+static cl_object *
+interpret_catch(cl_object *vector) {
+	cl_object * volatile exit;
+	exit = packed_label(vector - 1);
+	if (frs_push(FRS_CATCH,VALUES(0)) == 0)
+		interpret(vector);
+	frs_pop();
+	return exit;
+}
+
+static cl_object *
+interpret_tagbody(cl_object *vector) {
+	cl_index i, ntags = fix(get_oparg(vector[-1]));
+	cl_object lex_old = lex_env;
+	cl_object id = new_frame_id();
+	cl_object *aux, *tag_list = vector;
+
+	lex_copy();
+	aux = vector;
+	for (i=0; i<ntags; i++, aux+=2)
+		lex_tag_bind(*aux, id);
+
+	if (frs_push(FRS_CATCH, id) != 0) {
+		for (aux = vector, i=0; i<ntags; i++, aux+=2)
+			if (eql(aux[0], nlj_tag)) {
+				aux++;
+				break;
+			}
+		if (i >= ntags)
+			FEerror("Someone tried to RETURN-FROM a TAGBODY",0);
+		else
+			aux = simple_label(aux);
+	}
+	vector = interpret(aux);
+	frs_pop();
+	lex_env = lex_old;
+	VALUES(0) = Cnil;
+	NValues = 0;
+	return vector;
+}
+
+static cl_object *
+interpret_unwind_protect(cl_object *vector) {
+	bool unwinding;
+	int nr;
+	cl_object * volatile exit;
+
+	exit = packed_label(vector-1);
+	if (frs_push(FRS_PROTECT, Cnil))
+		unwinding = TRUE;
+	else {
+		interpret(vector);
+		unwinding = FALSE;
+	}
+	nr = NValues;
+	MV_SAVE(nr);
+	exit = interpret(exit);
+	MV_RESTORE(nr);
+	frs_pop();
+	if (unwinding)
+		unwind(nlj_fr, nlj_tag);
+	return exit;
+}
+
+static cl_object *
+interpret_do(cl_object *vector) {
+	cl_object *volatile exit;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+	lex_copy();
+	lex_block_bind(Cnil, id);
+
+	exit = packed_label(vector-1);
+	if (frs_push(FRS_CATCH,id) == 0)
+		interpret(vector);
+	frs_pop();
+
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return exit;
+}
+
+static cl_object *
+interpret_dolist(cl_object *vector) {
+	cl_object *output, *volatile exit;
+	cl_object list, var;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+	lex_copy();
+	lex_block_bind(Cnil, id);
+
+	list = VALUES(0);
+	exit = packed_label(vector - 1);
+	if (frs_push(FRS_CATCH,id) == 0) {
+		/* Build list & bind variable*/
+		vector = interpret(vector);
+		output = packed_label(vector-1);
+		while (!endp(list)) {
+			NValues = 1;
+			VALUES(0) = CAR(list);
+			interpret(vector);
+			list = CDR(list);
+		}
+		VALUES(0) = Cnil;
+		NValues = 1;
+		interpret(output);
+	}
+	frs_pop();
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return exit;
+}
+
+static cl_object *
+interpret_dotimes(cl_object *vector) {
+	cl_object *output, *volatile exit;
+	cl_fixnum length, i;
+	cl_object var;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+	lex_copy();
+	lex_block_bind(Cnil, id);
+
+	length = fix(VALUES(0));
+	exit = packed_label(vector - 1);
+	if (frs_push(FRS_CATCH,id) == 0) {
+		/* Bind variable */
+		vector = interpret(vector);
+		output = packed_label(vector-1);
+		for (i = 0; i < length;) {
+			interpret(vector);
+			NValues = 1;
+			VALUES(0) = MAKE_FIXNUM(++i);
+		}
+		interpret(output);
+	}
+	frs_pop();
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return exit;
+}
+
+static cl_object
+close_around(cl_object fun, cl_object lex) {
+	cl_object v = alloc_object(t_bytecodes);
+	v->bytecodes.size = fun->bytecodes.size;
+	v->bytecodes.data = fun->bytecodes.data;
+	if (!Null(CAR(lex)) || !Null(CDR(lex)))
+		v->bytecodes.lex = CONS(CAR(lex),CDR(lex));
+	else
+		v->bytecodes.lex = Cnil;
+	return v;
+}
+
+static cl_object *
+interpret_flet(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	cl_index nfun = get_oparg(vector[-1]);
+
+	lex_copy();
+	while (nfun--) {
+		cl_object fun = next_code(vector);
+		cl_object f = close_around(fun,lex_old);
+		lex_fun_bind(f->bytecodes.data[0], f);
+	}
+	vector = interpret(vector);
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+interpret_labels(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	cl_index i, nfun = get_oparg(vector[-1]);
+	cl_object l;
+
+	lex_copy();
+	for (i=0; i<nfun; i++) {
+		cl_object f = next_code(vector);
+		lex_fun_bind(f->bytecodes.data[0], f);
+	}
+	/* Update the closures so that all functions can call each other */
+	for (i=0, l=CDR(lex_env); i<nfun; i++) {
+		cl_object f = CADDAR(l);
+		CADDAR(l) = close_around(f, lex_env);
+		l = CDR(l);
+	}
+	vector = interpret(vector);
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+interpret_mbind(cl_object *vector)
+{
+	int i = get_oparg(vector[-1]);
+	while (i--) {
+		cl_object var = next_code(vector);
+		cl_object value = (i < NValues) ? VALUES(i) : Cnil;
+		if (var == MAKE_FIXNUM(1))
+			bind_special(next_code(vector), value);
+		else
+			bind_var(var, value);
+	}
+	return vector;
+}
+
+static cl_object *
+interpret_mcall(cl_object *vector) {
+	cl_index sp = get_sp_index();
+	vector = interpret(vector);
+	VALUES(0) = interpret_apply(get_sp_index()-sp, VALUES(0), get_sp_at(sp));
+	set_sp_index(sp);
+	return vector;
+}
+
+static cl_object *
+interpret_mprog1(cl_object *vector) {
+	cl_index i,n = NValues;
+	for (i=0; i<n; i++) {
+		push1(VALUES(i));
+	}
+	vector = interpret(vector);
+	for (i=n; i;) {
+		VALUES(--i) = pop1();
+	}
+	NValues = n;
+	return vector;
+}
+
+static cl_object *
+interpret_msetq(cl_object *vector)
+{
+	cl_object var, value;
+	int i = get_oparg(vector[-1]);
+	while (i--) {
+		var = next_code(vector);
+		value = (i < NValues) ? VALUES(i) : Cnil;
+		if (var != MAKE_FIXNUM(1))
+			CADR(lex_var_sch(var)) = value;
+		else {
+			var = next_code(vector);
+			if (var->symbol.stype == stp_constant)
+				FEerror("Cannot set the constant ~A", 1, var);
+			else
+				SYM_VAL(var) = value;
+		}
+	}
+	if (NValues > 1) NValues = 1;
+	return vector;
+}
+
+static cl_object *
+interpret_progv(cl_object *vector) {
+	cl_object values = VALUES(0);
+	cl_object vars = pop1();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+
+	lex_copy();
+	while (!endp(vars)) {
+		if (values == Cnil)
+			bds_bind(CAR(vars), OBJNULL);
+		else {
+			bds_bind(CAR(vars), car(values));
+			values = CDR(values);
+		}
+		vars = CDR(vars);
+	}
+	vector = interpret(vector);
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return vector;
+}
+
+static cl_object *
+interpret_pushenv(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+
+	lex_copy();
+	vector = interpret(vector);
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return vector;
+}
+
+cl_object *
+interpret(cl_object *vector) {
+	enum cl_type t;
+	cl_object s;
+	cl_fixnum n;
+
+ BEGIN:
+	s = next_code(vector);
+	t = type_of(s);
+	if (t == t_symbol) {
+		VALUES(0) = search_symbol_value(s);
+		NValues = 1;
+		goto BEGIN;
+	}
+	if (t != t_fixnum) {
+		VALUES(0) = s;
+		NValues = 1;
+		goto BEGIN;
+	}
+	switch (GET_OP(s)) {
+	case OP_PUSHQ:
+		push1(next_code(vector));
+		break;
+	case OP_PUSH:
+		push1(VALUES(0));
+		break;
+	case OP_PUSHV:
+		push1(search_symbol_value(next_code(vector)));
+		break;
+	case OP_QUOTE:
+		VALUES(0) = next_code(vector);
+		NValues = 1;
+		break;
+	case OP_NOP:
+		VALUES(0) = Cnil;
+		NValues = 0;
+		break;
+	case OP_BLOCK:
+		vector = interpret_block(vector);
+		break;
+	case OP_PUSHVALUES: {
+		int i;
+		for (i=0; i<NValues; i++)
+			push1(VALUES(i));
+		break;
+	}
+	case OP_MCALL:
+		vector = interpret_mcall(vector);
+		break;
+	case OP_CALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object name = next_code(vector);
+		VALUES(0) = interpret_apply(n, name, get_sp()-n);
+		dec_sp_index(n);
+		break;
+	}
+	case OP_PCALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object name = next_code(vector);
+		VALUES(0) = interpret_apply(n, name, get_sp()-n);
+		dec_sp_index(n);
+		push1(VALUES(0));
+		break;
+	}
+	case OP_FCALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object fun = VALUES(0);
+		VALUES(0) = interpret_apply(n, fun, get_sp()-n);
+		dec_sp_index(n);
+		break;
+	}
+	case OP_PFCALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object fun = VALUES(0);
+		VALUES(0) = interpret_apply(n, fun, get_sp()-n);
+		dec_sp_index(n);
+		push1(VALUES(0));
+		break;
+	}
+	case OP_CATCH:
+		vector = interpret_catch(vector);
+		break;
+	case OP_EXIT:
+		return vector;
+	case OP_HALT:
+		return vector-1;
+	case OP_FLET:
+		vector = interpret_flet(vector);
+		break;
+	case OP_LABELS:
+		vector = interpret_labels(vector);
+		break;
+	case OP_FUNCTION:
+		VALUES(0) = search_symbol_function(next_code(vector));
+		NValues = 1;
+		break;
+	case OP_CLOSE:
+		VALUES(0) = close_around(next_code(vector), lex_env);
+		NValues = 1;
+		break;
+	case OP_GO: {
+		cl_object tag = next_code(vector);
+		cl_object id = lex_tag_sch(tag);
+		if (Null(id))
+			FEerror("~S is an undefined tag.", 1, tag);
+		VALUES(0) = Cnil;
+		NValues = 0;
+		go(id, tag);
+		break;
+	}
+	case OP_RETURN: {
+		cl_object tag = next_code(vector);
+		cl_object id = lex_block_sch(tag);
+		if (Null(id))
+			FEerror("The block name ~S is undefined.", 1, tag);
+		return_from(id, tag);
+		break;
+	}
+	case OP_THROW:
+		throw(pop1());
+		break;
+	case OP_JMP:
+		vector = vector - 1 + get_oparg(s);
+		break;
+	case OP_JNIL:
+		NValues = 1;
+		if (Null(VALUES(0))) vector = vector - 1 + get_oparg(s);
+		break;
+	case OP_JT:
+		NValues = 1;
+		if (!Null(VALUES(0))) vector = vector - 1 + get_oparg(s);
+		break;
+	case OP_JEQ:
+		if (VALUES(0) == next_code(vector))
+			vector = vector + get_oparg(s) - 2;
+		break;
+	case OP_JNEQ:
+		if (VALUES(0) != next_code(vector))
+			vector = vector + get_oparg(s) - 2;
+		break;
+	case OP_BIND:
+		bind_var(next_code(vector), VALUES(0));
+		break;
+	case OP_BINDS:
+		bind_special(next_code(vector), VALUES(0));
+		break;
+	case OP_SETQ:
+		CADR(lex_var_sch(next_code(vector))) = VALUES(0);
+		break;
+	case OP_SETQS: {
+		cl_object var = next_code(vector);
+		if (var->symbol.stype == stp_constant)
+			FEerror("Cannot bind the constant ~A", 1, var);
+		else
+			SYM_VAL(var) = VALUES(0);
+		break;
+	}
+	case OP_PBIND:
+		bind_var(next_code(vector), pop1());
+		break;
+	case OP_PBINDS:
+		bind_special(next_code(vector), pop1());
+		break;
+	case OP_PSETQ:
+		CADR(lex_var_sch(next_code(vector))) = pop1();
+		Values[0] = Cnil;
+		NValues = 1;
+		break;
+	case OP_PSETQS: {
+		cl_object var = next_code(vector);
+		if (var->symbol.stype == stp_constant)
+			FEerror("Cannot bind the constant ~A", 1, var);
+		else
+			SYM_VAL(var) = pop1();
+		Values[0] = Cnil;
+		NValues = 1;
+		break;
+	}
+	case OP_MSETQ:
+		vector = interpret_msetq(vector);
+		break;
+	case OP_MBIND:
+		vector = interpret_mbind(vector);
+		break;
+	case OP_MPROG1:
+		vector = interpret_mprog1(vector);
+		break;
+	case OP_PROGV:
+		vector = interpret_progv(vector);
+		break;
+	case OP_PUSHENV:
+		vector = interpret_pushenv(vector);
+		break;
+	case OP_VALUES: {
+		cl_fixnum n = get_oparg(s);
+		NValues = n;
+		while (n)
+			VALUES(--n) = pop1();
+		break;
+	}
+	case OP_NTHVAL: {
+		cl_index n = fix(pop1());
+		if (n < 0 || n >= NValues)
+			VALUES(0) = Cnil;
+		else
+			VALUES(0) = VALUES(n);
+		NValues = 1;
+		break;
+	}
+	case OP_DOLIST:
+		vector = interpret_dolist(vector);
+		break;
+	case OP_DOTIMES:
+		vector = interpret_dotimes(vector);
+		break;
+	case OP_DO:
+		vector = interpret_do(vector);
+		break;
+	case OP_TAGBODY:
+		vector = interpret_tagbody(vector);
+		break;
+	case OP_UNWIND:
+		vector = interpret_unwind_protect(vector);
+		break;
+	default:
+		FEerror("Unknown code ~S", 1, MAKE_FIXNUM(*(vector-1)));
+	}
+	goto BEGIN;
+}
+
+@(defun si::interpreter_stack ()
+@
+	@(return stack)
+@)
+
+void
+init_interpreter(void)
+{
+	register_root(&stack);
+	stack = alloc_simple_vector(128, aet_object);
+	array_allocself(stack);
+	stack->vector.hasfillp = TRUE;
+	stack->vector.fillp = 0;
+}
diff --git a/src/c/num_arith.d b/src/c/num_arith.d
new file mode 100644
index 000000000..e12f93f23
--- /dev/null
+++ b/src/c/num_arith.d
@@ -0,0 +1,908 @@
+/*
+    num_arith.c  -- Arithmetic operations
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+
+/*  (*		)  */
+
+@(defun times (&rest nums)
+	int i;
+	cl_object numi, prod = MAKE_FIXNUM(1);
+@
+	/* INV: type check in number_times() */
+	for (i = 0;  i < narg;  i++) {
+	  numi = va_arg(nums, cl_object);
+	  prod = number_times(prod, numi);
+	}
+	@(return prod)
+@)
+
+cl_object
+fixnum_times(int i, int j)
+{
+
+	int high, sign;
+	mp_limb_t i0, j0, res[2];
+	cl_object z;
+
+	if (i == 0 || j == 0)
+		return(MAKE_FIXNUM(0));
+	i0 = abs(i);
+	j0 = abs(j);
+	sign = ((i >= 0 && j >= 0) || (i < 0 && j < 0)) ? 1 : -1;
+	high = mpn_mul(res, &i0, 1, &j0, 1);
+	if (high == 0) {
+	  if (sign > 0) {
+	    if (res[0] <= MOST_POSITIVE_FIX)
+	      return(MAKE_FIXNUM(res[0]));
+	  } else {
+	    if (res[0] <= (MOST_POSITIVE_FIX + 1))
+	      return(MAKE_FIXNUM(-res[0]));
+	  }
+	  z = alloc_object(t_bignum);
+	  mpz_init_set_si(z->big.big_num, sign * res[0]);
+	} else {
+	  z = bignum2(res[1], res[0]);
+	  z->big.big_size = sign * 2;
+	}
+	return(z);
+}
+
+static cl_object
+big_times_fix(cl_object b, int i)
+{
+	cl_object z;
+
+	if (i == 1)
+		return(b);
+	if (i == -1)
+		return(big_minus(b));
+	z = big_register0_get();
+	mpz_mul_ui(z->big.big_num, b->big.big_num, abs(i));
+	if (i < 0)
+	  big_complement(z);
+	z = big_register_normalize(z);
+	return(z);
+}
+
+static cl_object
+big_times_big(cl_object x, cl_object y)
+{
+	cl_object z;
+	z = big_register0_get();
+	mpz_mul(z->big.big_num, x->big.big_num, y->big.big_num);
+	z = big_register_normalize(z);
+	return(z);
+}
+
+cl_object
+number_times(cl_object x, cl_object y)
+{
+	cl_object z, z1;
+
+	switch (type_of(x)) {
+	case t_fixnum:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return fixnum_times(fix(x),fix(y));
+		case t_bignum:
+			return big_times_fix(y, fix(x));
+		case t_ratio:
+			z = number_times(x, y->ratio.num);
+			z = make_ratio(z, y->ratio.den);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(fix(x) * sf(y));
+		case t_longfloat:
+			return make_longfloat(fix(x) * lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_bignum:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return big_times_fix(x, fix(y));
+		case t_bignum:
+			return big_times_big(x, y);
+		case t_ratio:
+			z = number_times(x, y->ratio.num);
+			z = make_ratio(z, y->ratio.den);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(number_to_double(x) * sf(y));
+		case t_longfloat:
+			return make_longfloat(number_to_double(x) * lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_ratio:
+		switch (type_of(y)) {
+		case t_fixnum:
+		case t_bignum:
+			z = number_times(x->ratio.num, y);
+			z = make_ratio(z, x->ratio.den);
+			return(z);
+		case t_ratio:
+			z = number_times(x->ratio.num,y->ratio.num);
+			z1 = number_times(x->ratio.den,y->ratio.den);
+			z = make_ratio(z, z1);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(number_to_double(x) * sf(y));
+		case t_longfloat:
+			return make_longfloat(number_to_double(x) * lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_shortfloat:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return make_shortfloat(fix(y) * sf(x));
+		case t_bignum:
+		case t_ratio:
+			return make_shortfloat(number_to_double(y) * sf(x));
+		case t_shortfloat:
+			return make_shortfloat(sf(y) * sf(x));
+		case t_longfloat:
+			return make_longfloat(lf(y) * sf(x));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_longfloat:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return make_longfloat(fix(y) * lf(x));
+		case t_bignum:
+		case t_ratio:
+			return make_longfloat(number_to_double(y) * lf(x));
+		case t_shortfloat:
+			return make_longfloat(sf(y) * lf(x));
+		case t_longfloat:
+			return make_longfloat(lf(y) * lf(x));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_complex:
+	{
+		cl_object z11, z12, z21, z22;
+
+		if (type_of(y) != t_complex) {
+			cl_object aux = x;
+			x = y; y = aux;
+		COMPLEX: /* INV: x is real, y is complex */
+			return make_complex(number_times(x, y->complex.real),
+					    number_times(x, y->complex.imag));
+		}
+		z11 = number_times(x->complex.real, y->complex.real);
+		z12 = number_times(x->complex.imag, y->complex.imag);
+		z21 = number_times(x->complex.imag, y->complex.real);
+		z22 = number_times(x->complex.real, y->complex.imag);
+		return(make_complex(number_minus(z11, z12), number_plus(z21, z22)));
+	}
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+/* (+          )   */
+@(defun plus (&rest nums)
+        int i;
+	cl_object numi, sum = MAKE_FIXNUM(0);
+@
+	/* INV: type check is in number_plus() */
+	for (i = 0;  i < narg;  i++) {
+	  numi = va_arg(nums, cl_object);
+	  sum = number_plus(sum, numi);
+	}
+	@(return sum)
+@)
+
+cl_object
+number_plus(cl_object x, cl_object y)
+{
+	int i, j;
+	cl_object z, z1;
+	
+	switch (type_of(x)) {
+	case t_fixnum:
+	        switch (type_of(y)) {
+		case t_fixnum: {
+			int k = fix(x) + fix(y);
+			if (k >= MOST_NEGATIVE_FIX && k <= MOST_POSITIVE_FIX)
+			  return(MAKE_FIXNUM(k));
+			else
+			  return(bignum1(k));
+		      }
+		case t_bignum:
+			if ((i = fix(x)) == 0)
+				return(y);
+			z = big_register0_get();
+			if (i > 0)
+			  mpz_add_ui(z->big.big_num, y->big.big_num, i);
+			else
+			  mpz_sub_ui(z->big.big_num, y->big.big_num, -i);
+		  	z = big_register_normalize(z);
+			return(z);
+		case t_ratio:
+			z = number_times(x, y->ratio.den);
+			z = number_plus(z, y->ratio.num);
+			z = make_ratio(z, y->ratio.den);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(fix(x) + sf(y));
+		case t_longfloat:
+			return make_longfloat(fix(x) + lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_bignum:
+		switch (type_of(y)) {
+		case t_fixnum:
+			if ((j = fix(y)) == 0)
+				return(x);
+			z = big_register0_get();
+			if (j > 0)
+			  mpz_add_ui(z->big.big_num, x->big.big_num, j);
+			else
+			  mpz_sub_ui(z->big.big_num, x->big.big_num, -j);
+			z = big_register_normalize(z);
+			return(z);
+		case t_bignum:
+			z = big_plus(x, y);
+			z = big_normalize(z);
+			return(z);
+		case t_ratio:
+			z = number_times(x, y->ratio.den);
+			z = number_plus(z, y->ratio.num);
+			z = make_ratio(z, y->ratio.den);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(number_to_double(x) + sf(y));
+		case t_longfloat:
+			return make_longfloat(number_to_double(x) + lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_ratio:
+		switch (type_of(y)) {
+		case t_fixnum:
+		case t_bignum:
+			z = number_times(x->ratio.den, y);
+			z = number_plus(x->ratio.num, z);
+			z = make_ratio(z, x->ratio.den);
+			return(z);
+		case t_ratio:
+			z1 = number_times(x->ratio.num,y->ratio.den);
+			z = number_times(x->ratio.den,y->ratio.num);
+			z = number_plus(z1, z);
+			z1 = number_times(x->ratio.den,y->ratio.den);
+			z = make_ratio(z, z1);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(number_to_double(x) + sf(y));
+		case t_longfloat:
+			return make_shortfloat(number_to_double(x) + lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_shortfloat:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return make_shortfloat(fix(y) + sf(x));
+		case t_bignum:
+		case t_ratio:
+			return make_shortfloat(number_to_double(y) + sf(x));
+		case t_shortfloat:
+			return make_shortfloat(sf(y) + sf(x));
+		case t_longfloat:
+			return make_longfloat(lf(y) + sf(x));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_longfloat:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return make_longfloat(fix(y) + lf(x));
+		case t_bignum:
+		case t_ratio:
+			return make_longfloat(number_to_double(y) + lf(x));
+		case t_shortfloat:
+			return make_longfloat(sf(y) + lf(x));
+		case t_longfloat:
+			return make_longfloat(lf(y) + lf(x));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_complex:
+		if (type_of(y) != t_complex) {
+			cl_object aux = x;
+			x = y; y = aux;
+		COMPLEX: /* INV: x is real, y is complex */
+			return make_complex(number_plus(x, y->complex.real), y->complex.imag);
+		}
+		z = number_plus(x->complex.real, y->complex.real);
+		z1 = number_plus(x->complex.imag, y->complex.imag);
+		z = make_complex(z, z1);
+		return(z);
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+/*  (-		)  */
+@(defun minus (num &rest nums)
+	int i;
+	cl_object diff;
+@
+	/* INV: argument type check in number_{negate,minus}() */
+	if (narg == 1)
+		@(return number_negate(num))
+	for (i = 1, diff = num;  i < narg;  i++) {
+	  num = va_arg(nums, cl_object);
+	  diff = number_minus(diff, num);
+	}
+	@(return diff)
+@)
+
+cl_object
+number_minus(cl_object x, cl_object y)
+{
+	int i, j, k;
+	cl_object z, z1;
+	
+	switch (type_of(x)) {
+	case t_fixnum:
+		switch(type_of(y)) {
+		case t_fixnum:
+			if ((k = fix(x) - fix(y)) >= MOST_NEGATIVE_FIX &&
+			    k <= MOST_POSITIVE_FIX)
+			  return(MAKE_FIXNUM(k));
+			else
+			  return(bignum1(k));
+		case t_bignum:
+			z = big_register0_get();
+			i = fix(x);
+			if (i > 0)
+			  mpz_sub_ui(z->big.big_num, y->big.big_num, i);
+			else
+			  mpz_add_ui(z->big.big_num, y->big.big_num, -i);
+			big_complement(z);
+			z = big_register_normalize(z);
+			return(z);
+		case t_ratio:
+			z = number_times(x, y->ratio.den);
+			z = number_minus(z, y->ratio.num);
+			z = make_ratio(z, y->ratio.den);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(fix(x) - sf(y));
+		case t_longfloat:
+			return make_shortfloat(fix(x) - lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_bignum:
+		switch (type_of(y)) {
+		case t_fixnum:
+			if ((j = fix(y)) == 0)
+				return(x);
+			z = big_register0_get();
+			if (j > 0)
+				mpz_sub_ui(z->big.big_num, x->big.big_num, j);
+			else
+				mpz_add_ui(z->big.big_num, x->big.big_num, -j);
+			z = big_register_normalize(z);
+			return(z);
+		case t_bignum:
+			y = big_minus(y);
+			z = big_plus(x, y);
+			z = big_normalize(z);
+			return(z);
+		case t_ratio:
+			z = number_times(x, y->ratio.den);
+			z = number_minus(z, y->ratio.num);
+			z = make_ratio(z, y->ratio.den);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(number_to_double(x) - sf(y));
+		case t_longfloat:
+			return make_longfloat(number_to_double(x) - lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_ratio:
+		switch (type_of(y)) {
+		case t_fixnum:
+		case t_bignum:
+			z = number_times(x->ratio.den, y);
+			z = number_minus(x->ratio.num, z);
+			z = make_ratio(z, x->ratio.den);
+			return(z);
+		case t_ratio:
+			z = number_times(x->ratio.num,y->ratio.den);
+			z1 = number_times(x->ratio.den,y->ratio.num);
+			z = number_minus(z, z1);
+			z1 = number_times(x->ratio.den,y->ratio.den);
+			z = make_ratio(z, z1);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(number_to_double(x) - sf(y));
+		case t_longfloat:
+			return make_longfloat(number_to_double(x) - lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_shortfloat:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return make_shortfloat(sf(x) - fix(y));
+		case t_bignum:
+		case t_ratio:
+			return make_shortfloat(sf(x) - number_to_double(y));
+		case t_shortfloat:
+			return make_shortfloat(sf(x) - sf(y));
+		case t_longfloat:
+			return make_longfloat(sf(x) - lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_longfloat:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return make_longfloat(lf(x) - fix(y));
+		case t_bignum:
+		case t_ratio:
+			return make_longfloat(lf(x) - number_to_double(y));
+		case t_shortfloat:
+			return make_longfloat(lf(x) - sf(y));
+		case t_longfloat:
+			return make_longfloat(lf(x) - lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	COMPLEX:
+		return make_complex(number_minus(x, y->complex.real),
+				    number_negate(y->complex.imag));
+	case t_complex:
+		if (type_of(y) != t_complex) {
+			z = number_minus(x->complex.real, y);
+			z1 = x->complex.imag;
+		} else {
+			z = number_minus(x->complex.real, y->complex.real);
+			z1 = number_minus(x->complex.imag, y->complex.imag);
+		}
+		return make_complex(z, z1);
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+@(defun conjugate (c)
+@
+	switch (type_of(c)) {
+	case t_complex:
+		c = make_complex(c->complex.real,
+				 number_negate(c->complex.imag));
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+	case t_shortfloat:
+	case t_longfloat:
+		break;
+	default:
+		FEtype_error_number(c);
+	}
+	@(return c)
+@)
+
+cl_object
+number_negate(cl_object x)
+{
+	cl_object	z, z1;
+
+	switch (type_of(x)) {
+	case t_fixnum: {
+		int k = fix(x);
+		/* -MOST_NEGATIVE_FIX > MOST_POSITIVE_FIX */
+		if (k == MOST_NEGATIVE_FIX)
+			return(bignum1(- MOST_NEGATIVE_FIX));
+		else
+			return(MAKE_FIXNUM(-k));
+	}
+	case t_bignum:
+		z = big_register0_get();
+		mpz_neg(z->big.big_num, x->big.big_num);
+		return(big_register_copy(z));
+
+	case t_ratio:
+		z1 = number_negate(x->ratio.num);
+		z = alloc_object(t_ratio);
+		z->ratio.num = z1;
+		z->ratio.den = x->ratio.den;
+		return(z);
+
+	case t_shortfloat:
+		z = alloc_object(t_shortfloat);
+		sf(z) = -sf(x);
+		return(z);
+
+	case t_longfloat:
+		z = alloc_object(t_longfloat);
+		lf(z) = -lf(x);
+		return(z);
+
+	case t_complex:
+		z = number_negate(x->complex.real);
+		z1 = number_negate(x->complex.imag);
+		z = make_complex(z, z1);
+		return(z);
+
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+/*  (/		)  */
+@(defun divide (num &rest nums)
+	int i;
+@
+	/* INV: type check is in number_divide() */
+	if (narg == 0)
+		FEtoo_few_arguments(&narg);
+	if (narg == 1)
+		@(return number_divide(MAKE_FIXNUM(1), num))
+	for (i = 1;  i < narg;  i++)
+		num = number_divide(num, va_arg(nums, cl_object));
+	@(return num)
+@)
+
+cl_object
+number_divide(cl_object x, cl_object y)
+{
+	cl_object z, z1, z2, z3;
+
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+		switch (type_of(y)) {
+		case t_fixnum:
+		case t_bignum:
+			if (number_minusp(y) == TRUE) {
+				x = number_negate(x);
+				y = number_negate(y);
+			}
+			z = make_ratio(x, y);
+			return(z);
+		case t_ratio:
+			z = number_times(x, y->ratio.den);
+			z = make_ratio(z, y->ratio.num);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(number_to_double(x) / sf(y));
+		case t_longfloat:
+			return make_longfloat(number_to_double(x) / lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_ratio:
+		switch (type_of(y)) {
+		case t_fixnum:
+		case t_bignum:
+			z = number_times(x->ratio.den, y);
+			z = make_ratio(x->ratio.num, z);
+			return(z);
+		case t_ratio:
+			z = number_times(x->ratio.num,y->ratio.den);
+			z1 = number_times(x->ratio.den,y->ratio.num);
+			z = make_ratio(z, z1);
+			return(z);
+		case t_shortfloat:
+			return make_shortfloat(number_to_double(x) / sf(y));
+		case t_longfloat:
+			return make_longfloat(number_to_double(x) / lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_shortfloat:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return make_shortfloat(sf(x) / fix(y));
+		case t_bignum:
+		case t_ratio:
+			return make_shortfloat(sf(x) / number_to_double(y));
+		case t_shortfloat:
+			return make_shortfloat(sf(x) / sf(y));
+		case t_longfloat:
+			return make_longfloat(sf(x) / lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_longfloat:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return make_longfloat(lf(x) / fix(y));
+		case t_bignum:
+		case t_ratio:
+			return make_longfloat(lf(x) / number_to_double(y));
+		case t_shortfloat:
+			return make_longfloat(lf(x) / sf(y));
+		case t_longfloat:
+			return make_longfloat(lf(x) / lf(y));
+		case t_complex:
+			goto COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_complex:
+		if (type_of(y) != t_complex) {
+			z1 = number_divide(x->complex.real, y);
+			z2 = number_divide(x->complex.imag, y);
+			return make_complex(z1, z2);
+		} else if (1) {
+			/* #C(z1 z2) = #C(xr xi) * #C(yr -yi) */
+			z1 = number_plus(number_times(x->complex.real, y->complex.real),
+					 number_times(x->complex.imag, y->complex.imag));
+			z2 = number_minus(number_times(x->complex.imag, y->complex.real),
+					  number_times(x->complex.real, y->complex.imag));
+		} else {
+		COMPLEX: /* INV: x is real, y is complex */
+			/* #C(z1 z2) = x * #C(yr -yi) */
+			z1 = number_times(x, y->complex.real);
+			z2 = number_negate(number_times(x, y->complex.imag));
+		}
+		z  = number_plus(number_times(y->complex.real, y->complex.real),
+				 number_times(y->complex.imag, y->complex.imag));
+		z  = make_complex(number_divide(z1, z), number_divide(z2, z));
+		return(z);
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+cl_object
+integer_divide(cl_object x, cl_object y)
+{
+	enum type tx, ty;
+
+	tx = type_of(x);
+	ty = type_of(y);
+	if (tx == t_fixnum) {
+ 		if (ty == t_fixnum)
+			return MAKE_FIXNUM(fix(x) / fix(y));
+		if (ty == t_bignum)
+			return MAKE_FIXNUM(0);
+		FEtype_error_integer(y);
+	}
+	if (tx == t_bignum) {
+		cl_object q = big_register0_get();
+		if (ty == t_bignum) {
+			mpz_tdiv_q(q->big.big_num, x->big.big_num, y->big.big_num);
+		} else if (ty == t_fixnum) {
+			cl_fixnum j = fix(y);
+			mpz_tdiv_q_ui(q->big.big_num, x->big.big_num, abs(j));
+			if (j < 0)
+			  mpz_neg(q->big.big_num, q->big.big_num);
+		} else {
+			FEtype_error_integer(y);
+		}
+		return big_register_normalize(q);
+	}
+	FEtype_error_integer(x);
+}
+
+@(defun gcd (&rest nums)
+	int i;
+	cl_object gcd;
+@
+	if (narg == 0)
+		@(return MAKE_FIXNUM(0))
+	/* INV: get_gcd() checks types */
+	gcd = va_arg(nums, cl_object);
+	if (narg == 1)
+		@(return (number_minusp(gcd) ? number_negate(gcd) : gcd))
+	for (i = 1;  i < narg;  i++)
+		gcd = get_gcd(gcd, va_arg(nums, cl_object));
+	@(return gcd)
+@)
+
+cl_object
+get_gcd(cl_object x, cl_object y)
+{
+	enum cl_type tx = type_of(x);
+	enum cl_type ty = type_of(y);
+	cl_object gcd;
+
+	switch (tx) {
+	case t_fixnum:
+		if (ty == t_fixnum) {
+			cl_fixnum i = fix(x);
+			cl_fixnum j = fix(y);
+			for (i = abs(i), j = abs(j); TRUE; ) {
+				cl_fixnum k;
+				if (i < j) {
+					k = i;
+					i = j;
+					j = k;
+				}
+				if (j == 0)
+					return(MAKE_FIXNUM(i));
+				k = i % j;
+				i = j;
+				j = k;
+			}
+		} else {
+			x = bignum1(fix(x));
+		}
+		break;
+	case t_bignum:
+		break;
+	default:
+		FEtype_error_integer(x);
+	}
+	switch (ty) {
+	case t_fixnum:
+		y = bignum1(fix(y));
+	case t_bignum:
+		gcd = big_register0_get();
+		mpz_gcd(gcd->big.big_num, x->big.big_num, y->big.big_num);
+		gcd = big_register_normalize(gcd);
+		return(gcd);
+	default:
+		FEtype_error_integer(y);
+	}
+}
+
+/*  (1+ x)  */
+@(defun one_plus (x)
+@	/* INV: type check is in one_plus() */
+	@(return one_plus(x))
+@)
+
+
+cl_object
+one_plus(cl_object x)
+{
+	cl_object z;
+	
+	switch (type_of(x)) {
+
+	case t_fixnum:
+ 		if (x == MAKE_FIXNUM(MOST_POSITIVE_FIX))
+		  return(bignum1(MOST_POSITIVE_FIX+1));
+		return (cl_object)((int)x + ((int)MAKE_FIXNUM(1) - FIXNUM_TAG));
+	case t_bignum:
+		return(number_plus(x, MAKE_FIXNUM(1)));
+
+	case t_ratio:
+		z = number_plus(x->ratio.num, x->ratio.den);
+		z = make_ratio(z, x->ratio.den);
+		return(z);
+
+	case t_shortfloat:
+		z = alloc_object(t_shortfloat);
+		sf(z) = sf(x) + 1.0;
+		return(z);
+
+	case t_longfloat:
+		z = alloc_object(t_longfloat);
+		lf(z) = lf(x) + 1.0;
+		return(z);
+
+	case t_complex:
+		z = one_plus(x->complex.real);
+		z = make_complex(z, x->complex.imag);
+		return(z);
+
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+/*  (1-	x)  */
+@(defun one_minus (x)
+@	/* INV: type check is in one_minus() */
+	@(return one_minus(x))
+@)
+
+
+cl_object
+one_minus(cl_object x)
+{
+	cl_object z;
+	
+	switch (type_of(x)) {
+
+	case t_fixnum:
+ 		if (x == MAKE_FIXNUM(MOST_NEGATIVE_FIX))
+		  return(bignum1(MOST_NEGATIVE_FIX-1));
+		return (cl_object)((int)x - ((int)MAKE_FIXNUM(1) - FIXNUM_TAG));
+
+	case t_bignum:
+		return(number_minus(x, MAKE_FIXNUM(1)));
+
+	case t_ratio:
+		z = number_minus(x->ratio.num, x->ratio.den);
+		z = make_ratio(z, x->ratio.den);
+		return(z);
+
+	case t_shortfloat:
+		z = alloc_object(t_shortfloat);
+		sf(z) = sf(x) - 1.0;
+		return(z);
+
+	case t_longfloat:
+		z = alloc_object(t_longfloat);
+		lf(z) = lf(x) - 1.0;
+		return(z);
+
+	case t_complex:
+		z = one_minus(x->complex.real);
+		z = make_complex(z, x->complex.imag);
+		return(z);
+
+	default:
+		FEtype_error_real(x);
+	}
+}
+
+@(defun lcm (lcm &rest nums)
+@
+	/* INV: get_gcd() checks types. By placing `numi' before `lcm' in
+	   this call, we make sure that errors point to `numi' */
+	while (narg-- > 1) {
+		cl_object numi = va_arg(nums, cl_object);
+		cl_object t = number_times(lcm, numi);
+		cl_object g = get_gcd(numi, lcm);
+		lcm = number_divide(t, g);
+	}
+	@(return (number_minusp(lcm) ? number_negate(lcm) : lcm))
+@)
diff --git a/src/c/num_co.d b/src/c/num_co.d
new file mode 100644
index 000000000..996a9c469
--- /dev/null
+++ b/src/c/num_co.d
@@ -0,0 +1,1171 @@
+/*
+    num_co.c -- Operations on floating-point numbers.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+	IMPLEMENTATION-DEPENDENT
+
+	This file contains those functions
+	that know the representation of floating-point numbers.
+*/
+
+#include "ecls.h"
+#include <math.h>
+#ifndef HAVE_ISOC99
+# define floorf floor
+# define ceilf ceil
+# define fabsf fabs
+#endif
+
+static cl_object plus_half, minus_half;
+
+
+#ifdef VAX
+/*
+	radix = 2
+
+	SEEEEEEEEHHHHHHH	The redundant most significant fraction bit
+	HHHHHHHHHHHHHHHH	is not expressed.
+	LLLLLLLLLLLLLLLL
+	LLLLLLLLLLLLLLLL
+*/
+#endif
+#ifdef IEEEFLOAT
+# ifndef WORDS_BIGENDIAN
+/*
+	radix = 2
+
+	LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL	The redundant most
+	SEEEEEEEEEEEHHHHHHHHHHHHHHHHHHHH	significant fraction bit
+						is not expressed.
+*/
+# else
+/*
+	radix = 2
+
+	SEEEEEEEEEEEHHHHHHHHHHHHHHHHHHHH	The redundant most
+	LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL	significant fraction bit
+						is not expressed.
+*/
+# endif
+#endif
+#ifdef TAHOE
+/*
+        radix = 2
+
+        SEEEEEEEEHHHHHHHHHHHHHHHHHHHHHHH       The redundant most significant
+        LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL       fraction bit is not expressed.
+
+*/
+#endif
+
+static void
+integer_decode_double(double d, unsigned *hp, unsigned *lp, int *ep, int *sp)
+{
+	unsigned h, l;
+
+	if (d == 0.0) {
+		*hp = *lp = 0;
+		*ep = 0;
+		*sp = 1;
+		return;
+	}
+	h = *((unsigned *)&d + HIND);
+	l = *((unsigned *)&d + LIND);
+#ifdef VAX
+	*ep = ((h >> 7) & 0xff) - 128 - 56;
+	h = ((h >> 15) & 0x1fffe) | (((h & 0x7f) | 0x80) << 17);
+	l = ((l >> 16) & 0xffff) | (l << 16);
+#endif VAX
+#ifdef IEEEFLOAT
+	*ep = ((h & 0x7ff00000) >> 20) - 1022 - 53;
+	h = (h & 0x000fffff) | 0x00100000;
+#endif IEEEFLOAT
+#ifdef TAHOE
+        *ep = ((h & 0x7f800000) >> 23) - 128 - 56;
+        h = (h & 0x007fffff) | 0x00800000;
+#endif
+	*hp = h;
+	*lp = l;
+	*sp = (d > 0.0 ? 1 : -1);
+}
+
+#ifdef VAX
+/*
+	radix = 2
+
+	SEEEEEEEEMMMMMMM	The redundant most significant fraction bit
+	MMMMMMMMMMMMMMMM	is not expressed.
+*/
+#endif VAX
+#ifdef IEEEFLOAT
+/*
+	radix = 2
+
+	SEEEEEEEEMMMMMMMMMMMMMMMMMMMMMMM	The redundant most
+						significant fraction bit
+						is not expressed.
+*/
+#endif IEEEFLOAT
+#ifdef TAHOE
+/*
+        radix = 2
+        
+        SEEEEEEEEMMMMMMMMMMMMMMMMMMMMMMM        The redundant most significant
+                                                fraction bit is not expressed.
+*/
+#endif
+static void
+integer_decode_float(double d, int *mp, int *ep, int *sp)
+{
+	float f;
+	int m;
+
+	f = d;
+	if (f == 0.0) {
+		*mp = 0;
+		*ep = 0;
+		*sp = 1;
+		return;
+	}
+	m = *(int *)(&f);
+#ifdef VAX
+	*ep = ((m >> 7) & 0xff) - 128 - 24;
+	*mp = ((m >> 16) & 0xffff) | (((m & 0x7f) | 0x80) << 16);
+#endif VAX
+#ifdef IEEEFLOAT
+	*ep = ((m & 0x7f800000) >> 23) - 126 - 24;
+	*mp = (m & 0x007fffff) | 0x00800000;
+#endif IEEEFLOAT
+#ifdef TAHOE
+        *ep = ((m & 0x7f800000) >> 23) - 128 -24;
+        *mp = (m & 0x007fffff) | 0x00800000;
+#endif
+	*sp = (f > 0.0 ? 1 : -1);
+}
+
+static int
+double_exponent(double value)
+{
+	int *d = (int*)&value;
+	if (value == 0.0)
+		return(0);
+#ifdef VAX
+	return(((d[0] >> 7) & 0xff) - 128);
+#endif VAX
+#ifdef IEEEFLOAT
+	return(((d[HIND] & 0x7ff00000) >> 20) - 1022);
+#endif IEEEFLOAT
+#ifdef TAHOE
+        return(((d[0] & 0x7f800000) >> 23) - 128);
+#endif
+}
+
+static void
+set_exponent(double *value, int e)
+{
+	unsigned int *d = (int*)value;
+	if (*value == 0.0)
+		return;
+#ifdef VAX
+	d[0] = (d[0] & 0xffff807f) | (((e + 128) << 7) & 0x7f80);
+#endif VAX
+#ifdef IEEEFLOAT
+	d[HIND] = (d[HIND] & 0x800fffff) | (((e + 1022) << 20) & 0x7ff00000);
+#endif IEEEFLOAT
+#ifdef TAHOE
+        d[0] = (d[0] & 0x807fffff) | (((e + 128) << 23) & 0x7f800000);
+#endif
+}
+
+
+cl_object
+double_to_integer(double d)
+{
+	int h, l, e, s;
+	cl_object x;
+
+	if (d == 0.0)
+		return(MAKE_FIXNUM(0));
+	integer_decode_double(d, &h, &l, &e, &s);
+
+#if defined(VAX) || defined(TAHOE)
+	if (e <= -32) {
+		h >>= (-e) - 32;
+		return(MAKE_FIXNUM(s*h));
+	}
+#endif
+#ifdef IEEEFLOAT
+	if (e <= -32) {
+		e = (-e) - 32;
+		if (e >= 32)
+			return(MAKE_FIXNUM(0));
+		h >>= e;
+		return(MAKE_FIXNUM(s*h));
+	}
+#endif IEEEFLOAT
+	if (h != 0)
+		x = bignum2(h, l);
+	else
+		x = MAKE_FIXNUM(l);
+
+	x = integer_shift(x, e);
+	if (s < 0)
+		x = number_negate(x);
+	return(x);
+}
+
+static cl_object
+number_remainder(cl_object x, cl_object y, cl_object q)
+{
+	cl_object z;
+
+	z = number_times(q, y);
+	z = number_minus(x, z);
+	return(z);
+}
+
+/* Coerce X to single-float if one arg,
+   otherwise coerce to same float type as second arg */
+
+@(defun float (x &optional (y OBJNULL))
+	enum type t = t_shortfloat;
+@
+	if (y != OBJNULL) {
+		t = type_of(y);
+		if (t != t_shortfloat && t != t_longfloat)
+			FEtype_error_float(y);
+	}
+	switch (type_of(x)) {
+	case t_fixnum:
+		if (t == t_shortfloat)
+			x = make_shortfloat(fix(x));
+		else
+			x = make_longfloat(fix(x));
+		break;
+	case t_bignum:
+	case t_ratio: {
+		double d = number_to_double(x);
+		if (t == t_shortfloat)
+			x = make_shortfloat(d);
+		else
+			x = make_longfloat(d);		
+		break;
+	}
+	case t_shortfloat:
+		if (t == t_longfloat)
+			x = make_longfloat(sf(x));
+		break;
+	case t_longfloat:
+		if (t == t_shortfloat)
+			x = make_shortfloat(lf(x));
+		break;
+	default:
+		FEtype_error_real(x);
+	}
+	@(return x)
+@)
+
+@(defun numerator (x)
+	cl_object out;
+@
+	switch (type_of(x)) {
+	case t_ratio:
+		out = x->ratio.num;
+		break;
+	case t_fixnum:
+	case t_bignum:
+		out = x;
+		break;
+	default:
+		FEwrong_type_argument(Srational, x);
+	}
+	@(return out)
+@)
+
+@(defun denominator (x)
+	cl_object out;
+@
+	switch (type_of(x)) {
+	case t_ratio:
+		out = x->ratio.den;
+		break;
+	case t_fixnum:
+	case t_bignum:
+		out = MAKE_FIXNUM(1);
+		break;
+	default:
+		FEwrong_type_argument(Srational, x);
+	}
+	@(return out)
+@)
+
+cl_object
+floor1(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+		VALUES(0) = x;
+		VALUES(1) = MAKE_FIXNUM(0);
+		break;
+	case t_ratio:
+		VALUES(0) = floor2(x->ratio.num, x->ratio.den);
+		VALUES(1) = make_ratio(VALUES(1), x->ratio.den);
+		break;
+	case t_shortfloat: {
+		float d = sf(x);
+		float y = floorf(d);
+		VALUES(0) = double_to_integer(y);
+		VALUES(1) = make_shortfloat(d - y);
+		break;
+	}
+	case t_longfloat: {
+		double d = lf(x);
+		double y = floor(d);
+		VALUES(0) = double_to_integer(y);
+		VALUES(1) = make_longfloat(d - y);
+		break;
+	}
+	default:
+		FEtype_error_real(x);
+	}
+	NValues = 2;
+	return VALUES(0);
+}
+
+cl_object
+floor2(cl_object x, cl_object y)
+{
+	switch(type_of(x)) {
+	case t_fixnum:
+		switch(type_of(y)) {
+		case t_fixnum: {	/* FIX / FIX */
+		  cl_fixnum a = fix(x), b = fix(y);
+		  cl_fixnum q = a / b,  r = a % b;
+		  if ((r^b) < 0 && r) {	/* opposite sign and some remainder*/
+		    VALUES(0) = MAKE_FIXNUM(q-1);
+		    VALUES(1) = MAKE_FIXNUM(r+b);
+		  } else {
+		    VALUES(0) = MAKE_FIXNUM(q);
+		    VALUES(1) = MAKE_FIXNUM(r);
+		  }
+		  break;
+		}
+		case t_bignum: {	/* FIX / BIG */
+		  if (number_plusp(x) != number_plusp(y)) {
+		    VALUES(0) = MAKE_FIXNUM(-1);
+		    VALUES(1) = number_plus(y, x);
+		  } else {
+		    VALUES(0) = MAKE_FIXNUM(0);
+		    VALUES(1) = x;
+		  }
+		  break;
+		}
+		case t_ratio:		/* FIX / RAT */
+		  floor2(number_times(x, y->ratio.den), y->ratio.num);
+		  VALUES(1) = make_ratio(VALUES(1), y->ratio.den);
+		  break;
+		case t_shortfloat: {	/* FIX / SF */
+		  float n = sf(y);
+		  float p = fix(x) / n;
+		  float q = floorf(p);
+		  VALUES(0) = double_to_integer(q);
+		  VALUES(1) = make_shortfloat((p - q)*n);
+		  break;
+		}
+		case t_longfloat: {	/* FIX / LF */
+		  double n = lf(y);
+		  double p = fix(x) / n;
+		  double q = floor(p);
+		  VALUES(0) = double_to_integer(q);
+		  VALUES(1) = make_longfloat((p - q)*n);
+		  break;
+		}
+		default:
+		  FEtype_error_real(y);
+		}
+		break;
+	case t_bignum:
+		switch(type_of(y)) {
+		case t_fixnum: {	/* BIG / FIX */
+		  cl_object q = big_register0_get();
+		  cl_object r = big_register1_get();
+		  cl_object j = big_register2_get();
+		  mpz_set_si(j->big.big_num, fix(y));
+		  mpz_fdiv_qr(q->big.big_num, r->big.big_num, x->big.big_num, j->big.big_num);
+		  VALUES(0) = big_register_normalize(q);
+		  VALUES(1) = big_register_normalize(r);
+		  break;
+		}
+		case t_bignum: {	/* BIG / BIG */
+		  cl_object q = big_register0_get();
+		  cl_object r = big_register1_get();
+		  mpz_fdiv_qr(q->big.big_num, r->big.big_num, x->big.big_num, y->big.big_num);
+		  VALUES(0) = big_register_normalize(q);
+		  VALUES(1) = big_register_normalize(r);
+		  break;
+		}
+		case t_ratio:		/* BIG / RAT */
+		  floor2(number_times(x, y->ratio.den), y->ratio.num);
+		  VALUES(1) = make_ratio(VALUES(1), y->ratio.den);
+		  break;
+		case t_shortfloat: {	/* BIG / SF */
+		  float n = sf(y);
+		  float p = big_to_double(x) / n;
+		  float q = floorf(p);
+		  VALUES(0) = double_to_integer(q);
+		  VALUES(1) = make_shortfloat((p - q)*n);
+		  break;
+		}
+		case t_longfloat: {	/* BIG / LF */
+		  double n = lf(y);
+		  double p = big_to_double(x) / n;
+		  double q = floor(p);
+		  VALUES(0) = double_to_integer(q);
+		  VALUES(1) = make_longfloat((p - q)*n);
+		  break;
+		}
+		default:
+		  FEtype_error_real(y);
+		}
+		break;
+	case t_ratio:
+		switch(type_of(y)) {
+		case t_ratio:		/* RAT / RAT */
+		  floor2(number_times(x->ratio.num, y->ratio.den),
+			 number_times(x->ratio.den, y->ratio.num));
+		  VALUES(1) = make_ratio(VALUES(1), number_times(x->ratio.den, y->ratio.den));
+		  break;
+		default:		/* RAT / ANY */
+		  floor2(x->ratio.num, number_times(x->ratio.den, y));
+		  VALUES(1) = make_ratio(VALUES(1), x->ratio.den);
+		}
+		break;
+	case t_shortfloat: {		/* SF / ANY */
+		float n = number_to_double(y);
+		float p = sf(x)/n;
+		float q = floorf(p);
+		VALUES(0) = double_to_integer(q);
+		VALUES(1) = make_shortfloat((p - q)*n);
+		break;
+	}
+	case t_longfloat: {		/* LF / ANY */
+		double n = number_to_double(y);
+		double p = lf(x)/n;
+		double q = floor(p);
+		VALUES(0) = double_to_integer(q);
+		VALUES(1) = make_longfloat((p - q)*n);
+		break;
+	}
+	default:
+		FEtype_error_real(x);
+	}
+	NValues = 2;
+	return VALUES(0);
+}
+  
+@(defun floor (x &optional (y OBJNULL))
+@
+	if (narg == 1)
+		floor1(x);
+	else
+		floor2(x, y);
+	returnn(VALUES(0));
+@)
+
+cl_object
+ceiling1(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+		VALUES(0) = x;
+		VALUES(1) = MAKE_FIXNUM(0);
+		break;
+	case t_ratio:
+		VALUES(0) = ceiling2(x->ratio.num, x->ratio.den);
+		VALUES(1) = make_ratio(VALUES(1), x->ratio.den);
+		break;
+	case t_shortfloat: {
+		double d = (double)(sf(x));
+		double y = ceil(d);
+		VALUES(0) = double_to_integer(y);
+		VALUES(1) = make_shortfloat(d - y);
+		break;
+	}
+	case t_longfloat: {
+		double d = (double)(sf(x));
+		double y = ceil(d);
+		VALUES(0) = double_to_integer(y);
+		VALUES(1) = make_longfloat(d - y);
+		break;
+	}
+	default:
+		FEtype_error_real(x);
+	}
+	NValues = 2;
+	return VALUES(0);
+}
+
+cl_object
+ceiling2(cl_object x, cl_object y)
+{
+	switch(type_of(x)) {
+	case t_fixnum:
+		switch(type_of(y)) {
+		case t_fixnum: {	/* FIX / FIX */
+		  cl_fixnum a = fix(x); cl_fixnum b = fix(y);
+		  cl_fixnum q = a / b;  cl_fixnum r = a % b;
+		  if ((r^b) > 0 && r) {	/* same signs and some remainder */
+		    VALUES(0) = MAKE_FIXNUM(q+1);
+		    VALUES(1) = MAKE_FIXNUM(r-b);
+		  } else {
+		    VALUES(0) = MAKE_FIXNUM(q);
+		    VALUES(1) = MAKE_FIXNUM(r);
+		  }
+		  break;
+		}
+		case t_bignum: {	/* FIX / BIG */
+		  if (number_plusp(x) != number_plusp(y)) {
+		    VALUES(0) = MAKE_FIXNUM(0);
+		    VALUES(1) = x;
+		  } else {
+		    VALUES(0) = MAKE_FIXNUM(1);
+		    VALUES(1) = number_minus(x, y);
+		  }
+		  break;
+		}
+		case t_ratio:		/* FIX / RAT */
+		  ceiling2(number_times(x, y->ratio.den), y->ratio.num);
+		  VALUES(1) = make_ratio(VALUES(1), y->ratio.den);
+		  break;
+		case t_shortfloat: {	/* FIX / SF */
+		  float n = sf(y);
+		  float p = fix(x)/n;
+		  float q = ceilf(p);
+		  VALUES(0) = double_to_integer(q);
+		  VALUES(1) = make_shortfloat((p - q)*n);
+		  break;
+		}
+		case t_longfloat: {	/* FIX / LF */
+		  double n = lf(y);
+		  double p = fix(x)/n;
+		  double q = ceil(p);
+		  VALUES(0) = double_to_integer(q);
+		  VALUES(1) = make_longfloat((p - q)*n);
+		  break;
+		}
+		default:
+		  FEtype_error_real(y);
+		}
+		break;
+	case t_bignum:
+		switch(type_of(y)) {
+		case t_fixnum: {	/* BIG / FIX */
+		  cl_object q = big_register0_get();
+		  cl_object r = big_register1_get();
+		  cl_object j = big_register2_get();
+		  mpz_set_si(j->big.big_num, fix(y));
+		  mpz_cdiv_qr(q->big.big_num, r->big.big_num, x->big.big_num, j->big.big_num);
+		  VALUES(0) = big_register_normalize(q);
+		  VALUES(1) = big_register_normalize(r);
+		  break;
+		}
+		case t_bignum: {	/* BIG / BIG */
+		  cl_object q = big_register0_get();
+		  cl_object r = big_register1_get();
+		  mpz_cdiv_qr(q->big.big_num, r->big.big_num, x->big.big_num, y->big.big_num);
+		  VALUES(0) = big_register_normalize(q);
+		  VALUES(1) = big_register_normalize(r);
+		  break;
+		}
+		case t_ratio:		/* BIG / RAT */
+		  ceiling2(number_times(x, y->ratio.den), y->ratio.num);
+		  VALUES(1) = make_ratio(VALUES(1), y->ratio.den);
+		  break;
+		case t_shortfloat: {	/* BIG / SF */
+		  float n = sf(y);
+		  float p = big_to_double(x)/n;
+		  float q = ceilf(p);
+		  VALUES(0) = double_to_integer(q);
+		  VALUES(1) = make_shortfloat((p - q)*n);
+		  break;
+		}
+		case t_longfloat: {	/* BIG / LF */
+		  double n = lf(y);
+		  double p = big_to_double(x)/n;
+		  double q = ceil(p);
+		  VALUES(0) = double_to_integer(q);
+		  VALUES(1) = make_longfloat((p - q)*n);
+		  break;
+		}
+		default:
+		  FEtype_error_real(y);
+		}
+		break;
+	case t_ratio:
+		switch(type_of(y)) {
+		case t_ratio:		/* RAT / RAT */
+		  ceiling2(number_times(x->ratio.num, y->ratio.den),
+			   number_times(x->ratio.den, y->ratio.num));
+		  VALUES(1) = make_ratio(VALUES(1), number_times(x->ratio.den, y->ratio.den));
+		  break;
+		default:		/* RAT / ANY */
+		  ceiling2(x->ratio.num, number_times(x->ratio.den, y));
+		  VALUES(1) = number_divide(VALUES(1), x->ratio.den);
+		}
+		break;
+	case t_shortfloat: {		/* SF / ANY */
+		float n = number_to_double(y);
+		float p = sf(x)/n;
+		float q = ceilf(p);
+		VALUES(0) = double_to_integer(q);
+		VALUES(1) = make_shortfloat((p - q)*n);
+		break;
+	}
+	case t_longfloat: {		/* LF / ANY */
+		double n = number_to_double(y);
+		double p = lf(x)/n;
+		double q = ceil(p);
+		VALUES(0) = double_to_integer(q);
+		VALUES(1) = make_longfloat((p - q)*n);
+		break;
+	}
+	default:
+		FEtype_error_real(x);
+	}
+	NValues = 2;
+	return VALUES(0);
+}
+  
+@(defun ceiling (x &optional (y OBJNULL))
+@
+	if (narg == 1)
+		ceiling1(x);
+	else
+		ceiling2(x, y);
+	returnn(VALUES(0));
+@)
+
+cl_object
+truncate1(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+		VALUES(0) = x;
+		VALUES(1) = MAKE_FIXNUM(0);
+		break;
+	case t_ratio:
+		VALUES(0) = truncate2(x->ratio.num, x->ratio.den);
+		VALUES(1) = make_ratio(VALUES(1), x->ratio.den);
+		break;
+	case t_shortfloat: {
+		float d = sf(x);
+		float y = d > 0? floorf(d) : ceilf(d);
+		VALUES(0) = double_to_integer(y);
+		VALUES(1) = make_shortfloat(d - y);
+		break;
+	}
+	case t_longfloat: {
+		double d = lf(x);
+		double y = d > 0? floor(d) : ceil(d);
+		VALUES(0) = double_to_integer(y);
+		VALUES(1) = make_longfloat(d - y);
+		break;
+	}
+	default:
+		FEtype_error_real(x);
+	}
+	NValues = 2;
+	return VALUES(0);
+}
+
+cl_object
+truncate2(cl_object x, cl_object y)
+{
+	if (number_plusp(x) != number_plusp(y))
+		return ceiling2(x, y);
+	else
+		return floor2(x, y);
+}
+
+@(defun truncate (x &optional (y OBJNULL))
+@
+	if (narg == 1)
+		truncate1(x);
+	else
+		truncate2(x, y);
+	returnn(VALUES(0));
+@)
+
+cl_object
+round1(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+		VALUES(0) = x;
+		VALUES(1) = MAKE_FIXNUM(0);
+		break;
+	case t_ratio:
+		return round2(x->ratio.num, x->ratio.den);
+	case t_shortfloat: {
+		double d = (double)(sf(x));
+		cl_object q = double_to_integer(d + (d>=0? 0.5 : -0.5));
+		d -= number_to_double(q);
+		if (d == 0.5) {
+		  if (number_oddp(q)) {
+			q = one_plus(q);
+			d = -0.5;
+		  }
+		} else if (d == -0.5) {
+		  if (number_oddp(q)) {
+			q = one_minus(q);
+			d = 0.5;
+		  }
+		}
+		VALUES(0) = q;
+		VALUES(1) = make_shortfloat(d);
+		break;
+	}
+	case t_longfloat: {
+		double d = lf(x);
+		cl_object q = double_to_integer(d + (d>=0? 0.5 : -0.5));
+		d -= number_to_double(q);
+		if (d == 0.5) {
+		  if (number_oddp(q)) {
+			q = one_plus(q);
+			d = -0.5;
+		  }
+		} else if (d == -0.5) {
+		  if (number_oddp(q)) {
+			q = one_minus(q);
+			d = 0.5;
+		  }
+		}
+		VALUES(0) = q;
+		VALUES(1) = make_longfloat(d);
+		break;
+	}
+	default:
+		FEtype_error_real(x);
+	}
+	NValues = 2;
+	return VALUES(0);
+}
+
+cl_object
+round2(cl_object x, cl_object y)
+{
+	cl_object q;
+
+	q = number_divide(x, y);
+	switch (type_of(q)) {
+	case t_fixnum:
+	case t_bignum:
+		VALUES(0) = q;
+		VALUES(1) = MAKE_FIXNUM(0);
+		break;
+	case t_ratio: {
+		cl_object q1 = integer_divide(q->ratio.num, q->ratio.den);
+		cl_object r = number_minus(q, q1);
+		int c = number_compare(r, plus_half);
+		if (c > 0 || (c == 0 && number_oddp(q1))) {
+			q1 = one_plus(q1);
+		} else if (c < 0 || (c == 0 && number_oddp(q1))) {
+			q1 = one_minus(q1);
+		}
+		VALUES(0) = q1;
+		VALUES(1) = number_remainder(x, y, q1);
+		break;
+	}
+	case t_shortfloat:
+	case t_longfloat: {
+		double d = number_to_double(q);
+		cl_object q1 = double_to_integer(d + (d >= 0.0 ? 0.5 : -0.5));
+		d -= number_to_double(q1);
+		if (d == 0.5 && number_oddp(q1))
+			q1 = one_plus(q1);
+		if (d == -0.5 && number_oddp(q1))
+			q1 = one_minus(q1);
+		VALUES(0) = q1;
+		VALUES(1) = number_remainder(x, y, q1);
+		break;
+	}
+	default:
+		FEerror("Complex arguments to round2 (~S, ~S)", 2, x, y);
+	}
+	NValues = 2;
+	return VALUES(0);
+}
+
+@(defun round (x &optional (y OBJNULL))
+@
+	if (narg == 1)
+		round1(x);
+	else
+		round2(x, y);
+	returnn(VALUES(0));
+@)
+
+
+@(defun mod (x y)
+@
+	/* INV: #'floor always outputs two values */
+	Lfloor(2, x, y);
+	@(return VALUES(1))
+@)
+
+
+@(defun rem (x y)
+@
+	Ltruncate(2, x, y);
+	@(return VALUES(1))
+@)
+
+
+@(defun decode_float (x)
+	double d;
+	int e, s;
+	enum cl_type tx = type_of(x);
+@
+	switch (tx) {
+	case t_shortfloat:
+		d = sf(x); break;
+	case t_longfloat:
+		d = lf(x); break;
+	default:
+		FEtype_error_float(x);
+	}
+	if (d >= 0.0)
+		s = 1;
+	else {
+		d = -d;
+		s = -1;
+	}
+	e = double_exponent(d);
+	set_exponent(&d, 0);
+	if (tx == t_shortfloat) {
+		@(return make_shortfloat(d)
+			 MAKE_FIXNUM(e)
+			 make_shortfloat(s))
+	} else {
+		@(return make_longfloat(d)
+			 MAKE_FIXNUM(e)
+			 make_longfloat(s))
+	}
+@)
+
+
+@(defun scale_float (x y)
+	double d;
+	int e, k;
+	enum cl_type tx = type_of(x);
+@
+	if (FIXNUMP(y))
+		k = fix(y);
+	else
+		FEerror("~S is an illegal exponent.", 1, y);
+	switch (tx) {
+	case t_shortfloat:
+		d = sf(x); break;
+	case t_longfloat:
+		d = lf(x); break;
+	default:
+		FEtype_error_float(x);
+	}
+	e = double_exponent(d) + k;
+#if defined(VAX) || defined(TAHOE)
+	if (e <= -128 || e >= 128)
+#endif
+#ifdef IEEEFLOAT
+	if (tx == t_shortfloat && (e <= -126 || e >= 130) ||
+	    tx == t_longfloat && (e <= -1022 || e >= 1026))
+#endif IEEEFLOAT
+		FEerror("~S is an illegal exponent.", 1, y);
+	set_exponent(&d, e);
+	@(return ((tx == t_shortfloat) ? make_shortfloat(d)
+				       : make_longfloat(d)))
+@)
+
+
+@(defun float_radix (x)
+	enum cl_type t = type_of(x);
+@
+	if (t != t_shortfloat && t != t_longfloat)
+		FEtype_error_float(x);
+	@(return MAKE_FIXNUM(2))
+@)
+
+
+@(defun float_sign (x &optional (y x))
+	int negativep;
+@
+	switch (type_of(x)) {
+	case t_shortfloat:
+		negativep = sf(x) < 0; break;
+	case t_longfloat:
+		negativep = lf(x) < 0; break;
+	default:
+		FEtype_error_float(x);
+	}
+	switch (type_of(y)) {
+	case t_shortfloat: {
+		float f = sf(y);
+		@(return make_shortfloat(negativep? -fabsf(f) : fabsf(f)))
+	}
+	case t_longfloat: {
+		double f = lf(y);
+		@(return make_longfloat(negativep? -fabs(f) : fabs(f)))
+	}
+	default:
+		FEtype_error_float(x);
+	}
+@)
+
+@(defun float_digits (x)
+@
+	switch (type_of(x)) {
+	case t_shortfloat:
+		x = MAKE_FIXNUM(6);
+		break;
+	case t_longfloat:
+		x = MAKE_FIXNUM(14);
+		break;
+	default:
+		FEtype_error_float(x);
+	}
+	@(return x)
+@)
+
+
+@(defun float_precision (x)
+@
+	switch (type_of(x)) {
+	case t_shortfloat:
+		@(return ((sf(x) == 0.0) ? MAKE_FIXNUM(0) : MAKE_FIXNUM(24)))
+	case t_longfloat:
+		@(return ((lf(x) == 0.0) ? MAKE_FIXNUM(0) : MAKE_FIXNUM(53)))
+	default:
+		FEtype_error_float(x);
+	}
+@)
+
+
+@(defun integer_decode_float (x)
+	int h, l, e, s;
+@
+	switch (type_of(x)) {
+	case t_longfloat:
+		integer_decode_double(lf(x), &h, &l, &e, &s);
+		x = (h != 0) ? bignum2(h, l) : MAKE_FIXNUM(l);
+		break;
+	case t_shortfloat:
+		integer_decode_float((double)(sf(x)), &h, &e, &s);
+		x = MAKE_FIXNUM(h);
+		break;
+	default:
+		FEtype_error_float(x);
+	}
+	@(return x MAKE_FIXNUM(e) MAKE_FIXNUM(s))
+@)
+
+
+@(defun complex (r &optional (i MAKE_FIXNUM(0)))
+@	/* INV: make_complex() checks types */
+	@(return make_complex(r, i))
+@)
+
+
+@(defun realpart (x)
+@
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+	case t_shortfloat:
+	case t_longfloat:
+		break;
+	case t_complex:
+		x = x->complex.real;
+		break;
+	default:
+		FEtype_error_number(x);
+	}
+	@(return x)
+@)
+
+
+@(defun imagpart (x)
+@
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		x = MAKE_FIXNUM(0);
+		break;
+	case t_shortfloat:
+		x = shortfloat_zero;
+		break;
+	case t_longfloat:
+		x = longfloat_zero;
+		break;
+	case t_complex:
+		x = x->complex.imag;
+		break;
+	default:
+		FEtype_error_number(x);
+	}
+	@(return x)
+@)
+
+void
+init_num_co(void)
+{
+	float smallest_float, biggest_float;
+	double smallest_double, biggest_double;
+	float float_epsilon, float_negative_epsilon;
+	double double_epsilon, double_negative_epsilon;
+	double lf1, lf2;
+	float sf1, sf2;
+	cl_object num;
+
+#define LF_EQL(a,b) (lf1 = a, lf2 = b, lf1 == lf2)
+#define SF_EQL(a,b) (sf1 = a, sf2 = b, sf1 == sf2)
+
+#ifdef VAX
+	l[0] = 0x80;
+	l[1] = 0;
+	smallest_float = *(float *)l;
+	smallest_double = *(double *)l;
+#endif VAX
+
+#ifdef IEEEFLOAT
+	((int *) &smallest_float)[0]= 1;
+	((int *) &smallest_double)[HIND] = 0;
+	((int *) &smallest_double)[LIND] = 1;
+#endif IEEEFLOAT
+
+#ifdef VAX
+	l[0] = 0xffff7fff;
+	l[1] = 0xffffffff;
+	biggest_float = *(float *)l;
+	biggest_double = *(double *)l;
+#endif VAX
+
+#ifdef IEEEFLOAT
+	((unsigned int *) &biggest_float)[0]= (unsigned int)0x7f7fffff;
+	((unsigned int *) &biggest_double)[HIND] = (unsigned int)0x7fefffff;
+	((unsigned int *) &biggest_double)[LIND] = (unsigned int)0xffffffff;
+#endif IEEEFLOAT
+
+#ifdef TAHOE
+        l[0] = 0x00800000;
+        l[1] = 0;
+        smallest_float = *(float *)l;
+        smallest_double = *(double *)l;
+#endif
+
+/* We want the smallest number not satisfying something,
+   and so we go quickly down, and then back up.  We have
+   to use a function call for test, since in line code may keep
+   too much precision, while the usual lisp eql,is not
+   in line.
+   We use SMALL as a multiple to come back up by.
+*/
+
+#define SMALL 1.05	
+
+	for (float_epsilon = 1.0;
+	     !SF_EQL((float)(1.0 + float_epsilon),(float)1.0);
+	     float_epsilon /= 2.0)
+		;
+	while(SF_EQL((float)(1.0 + float_epsilon),(float)1.0))
+	  float_epsilon=float_epsilon*SMALL;
+	for (float_negative_epsilon = 1.0;
+	     !SF_EQL((float)(1.0 - float_negative_epsilon) ,(float)1.0);
+	     float_negative_epsilon /= 2.0)
+		;
+	while(SF_EQL((float)(1.0 - float_negative_epsilon) ,(float)1.0))
+	  float_negative_epsilon=float_negative_epsilon*SMALL;
+	for (double_epsilon = 1.0;
+	     !(LF_EQL(1.0 + double_epsilon, 1.0));
+	     double_epsilon /= 2.0)
+		;
+	while((LF_EQL(1.0 + double_epsilon, 1.0)))
+	  double_epsilon=double_epsilon*SMALL;
+	  ;
+	for (double_negative_epsilon = 1.0;
+	     !LF_EQL(1.0 - double_negative_epsilon , 1.0);
+	     double_negative_epsilon /= 2.0)
+		;
+	while(LF_EQL(1.0 - double_negative_epsilon , 1.0))
+	  double_negative_epsilon=double_negative_epsilon*SMALL;
+	  ;
+
+	num = make_shortfloat(biggest_float);
+	make_constant("MOST-POSITIVE-SHORT-FLOAT", num);
+	make_constant("MOST-POSITIVE-SINGLE-FLOAT", num);
+
+	num = make_shortfloat(smallest_float);
+	make_constant("LEAST-POSITIVE-SHORT-FLOAT", num);
+	make_constant("LEAST-POSITIVE-SINGLE-FLOAT", num);
+
+	num = make_shortfloat(-smallest_float);
+	make_constant("LEAST-NEGATIVE-SHORT-FLOAT", num);
+	make_constant("LEAST-NEGATIVE-SINGLE-FLOAT", num);
+
+	num = make_shortfloat(-biggest_float);
+	make_constant("MOST-NEGATIVE-SHORT-FLOAT", num);
+	make_constant("MOST-NEGATIVE-SINGLE-FLOAT", num);
+
+	num = make_longfloat(biggest_double);
+	make_constant("MOST-POSITIVE-DOUBLE-FLOAT", num);
+	make_constant("MOST-POSITIVE-LONG-FLOAT", num);
+
+	num = make_longfloat(smallest_double);
+	make_constant("LEAST-POSITIVE-DOUBLE-FLOAT", num);
+	make_constant("LEAST-POSITIVE-LONG-FLOAT", num);
+
+	num = make_longfloat(-smallest_double);
+	make_constant("LEAST-NEGATIVE-DOUBLE-FLOAT", num);
+	make_constant("LEAST-NEGATIVE-LONG-FLOAT", num);
+
+	num = make_longfloat(-biggest_double);
+	make_constant("MOST-NEGATIVE-DOUBLE-FLOAT", num);
+	make_constant("MOST-NEGATIVE-LONG-FLOAT", num);
+
+	num = make_shortfloat(float_epsilon);
+	make_constant("SHORT-FLOAT-EPSILON", num);
+	make_constant("SINGLE-FLOAT-EPSILON", num);
+	num = make_longfloat(double_epsilon);
+	make_constant("DOUBLE-FLOAT-EPSILON", num);
+	make_constant("LONG-FLOAT-EPSILON", num);
+
+	num = make_shortfloat(float_negative_epsilon);
+	make_constant("SHORT-FLOAT-NEGATIVE-EPSILON", num);
+	make_constant("SINGLE-FLOAT-NEGATIVE-EPSILON", num);
+	num = make_longfloat(double_negative_epsilon);
+	make_constant("DOUBLE-FLOAT-NEGATIVE-EPSILON", num);
+	make_constant("LONG-FLOAT-NEGATIVE-EPSILON", num);
+
+	plus_half = make_ratio(MAKE_FIXNUM(1), MAKE_FIXNUM(2));
+	register_root(&plus_half);
+
+	minus_half = make_ratio(MAKE_FIXNUM(-1), MAKE_FIXNUM(2));
+	register_root(&minus_half);
+}
diff --git a/src/c/num_comp.d b/src/c/num_comp.d
new file mode 100644
index 000000000..3cab2bd5a
--- /dev/null
+++ b/src/c/num_comp.d
@@ -0,0 +1,332 @@
+/*
+    num_comp.c  -- Comparisons on numbers.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+/*
+   For sake of profiler, put Lall_the_same before number_compare,
+   so that all calls to number_compare are attributed to function =.
+   Similarly for Lmonotonically_decreasing.
+*/
+
+
+@(defun all_the_same (num &rest nums)
+	int i;
+	cl_object numi;
+@
+	/* ANSI: Need not signal error for 1 argument */
+	/* INV: For >= 2 arguments, number_equalp() performs checks */
+	for (i = 1; i < narg; i++) {
+		numi = va_arg(nums, cl_object);
+		if (!number_equalp(num, numi))
+			@(return Cnil)
+	}
+	@(return Ct)
+@)
+
+/* Returns 1 if both numbers compare to equal */
+int
+number_equalp(cl_object x, cl_object y)
+{
+	double dx;
+
+	/* INV: (= fixnum bignum) => 0 */
+	/* INV: (= fixnum ratio) => 0 */
+	/* INV: (= bignum ratio) => 0 */
+	switch (type_of(x)) {
+	case t_fixnum:
+		switch (type_of(y)) {
+		case t_fixnum:
+		  	return x == y;
+		case t_bignum:
+		case t_ratio:
+			return 0;
+		case t_shortfloat:
+			return fix(x) == sf(y);
+		case t_longfloat:
+			return fix(x) == lf(y);
+		case t_complex:
+			goto Y_COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_bignum:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return 0;
+		case t_bignum:
+			return big_compare(x, y)==0;
+		case t_ratio:
+			return 0;
+		case t_shortfloat:
+			return sf(y) == number_to_double(x);
+		case t_longfloat:
+			return lf(y) == number_to_double(x);
+		case t_complex:
+			goto Y_COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_ratio:
+		switch (type_of(y)) {
+		case t_fixnum:
+		case t_bignum:
+			return 0;
+		case t_ratio:
+			return (number_equalp(x->ratio.num, y->ratio.num) &&
+				number_equalp(x->ratio.den, x->ratio.den));
+		case t_shortfloat:
+			return sf(y) == number_to_double(x);
+		case t_longfloat:
+			return lf(y) == number_to_double(x);
+		case t_complex:
+			goto Y_COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	case t_shortfloat:
+		dx = sf(x);
+		goto FLOAT;
+	case t_longfloat:
+		dx = lf(x);
+	FLOAT:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return dx == fix(y);
+		case t_bignum:
+		case t_ratio:
+			return dx == number_to_double(y);
+		case t_shortfloat:
+			return dx == sf(y);
+		case t_longfloat:
+			return dx == lf(y);
+		case t_complex:
+			goto Y_COMPLEX;
+		default:
+			FEtype_error_number(y);
+		}
+	Y_COMPLEX:
+		if (!number_zerop(y->complex.imag))
+			return 0;
+		return number_equalp(x, y->complex.real);
+	case t_complex:
+		if (type_of(y) == t_complex)
+			return (number_equalp(x->complex.real, y->complex.real) &&
+				number_equalp(x->complex.imag, y->complex.imag));
+		if (REAL_TYPE(type_of(y))) {
+			if (number_zerop(x->complex.imag))
+				return number_equalp(x->complex.real, y) != 0;
+			else
+				return 0;
+		}
+		FEtype_error_number(y);
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+/*
+	The value of number_compare(x, y) is
+
+		-1	if	x < y
+		0	if	x = y
+		1	if	x > y.
+
+	If x or y is not real, it fails.
+*/
+int
+number_compare(cl_object x, cl_object y)
+{
+	int ix, iy;
+	double dx, dy;
+
+	switch (type_of(x)) {
+	case t_fixnum:
+	  	ix = fix(x);
+		switch (type_of(y)) {
+		case t_fixnum:
+		  	iy = fix(y);
+			if (ix < iy)
+				return(-1);
+			else return(ix != iy);
+		case t_bignum:
+			/* INV: (= x y) can't be zero since fixnum != bignum */
+			return big_sign(y) < 0? 1 : -1;
+		case t_ratio:
+			x = number_times(x, y->ratio.den);
+			y = y->ratio.num;
+			return(number_compare(x, y));
+		case t_shortfloat:
+			dx = (double)(ix);
+			dy = (double)(sf(y));
+			goto LONGFLOAT;
+		case t_longfloat:
+			dx = (double)(ix);
+			dy = lf(y);
+			goto LONGFLOAT;
+		default:
+			FEtype_error_real(y);
+		}
+	case t_bignum:
+		switch (type_of(y)) {
+		case t_fixnum:
+			return big_sign(x) < 0 ? -1 : 1;
+		case t_bignum:
+			return(big_compare(x, y));
+		case t_ratio:
+			x = number_times(x, y->ratio.den);
+			y = y->ratio.num;
+			return(number_compare(x, y));
+		case t_shortfloat:
+			dx = number_to_double(x);
+			dy = (double)(sf(y));
+			goto LONGFLOAT;
+		case t_longfloat:
+			dx = number_to_double(x);
+			dy = lf(y);
+			goto LONGFLOAT;
+		default:
+			FEtype_error_real(y);
+		}
+	case t_ratio:
+		switch (type_of(y)) {
+		case t_fixnum:
+		case t_bignum:
+			y = number_times(y, x->ratio.den);
+			x = x->ratio.num;
+			return(number_compare(x, y));
+		case t_ratio:
+			return(number_compare(number_times(x->ratio.num,
+							   y->ratio.den),
+					      number_times(y->ratio.num,
+							   x->ratio.den)));
+		case t_shortfloat:
+			dx = number_to_double(x);
+			dy = (double)(sf(y));
+			goto LONGFLOAT;
+		case t_longfloat:
+			dx = number_to_double(x);
+			dy = lf(y);
+			goto LONGFLOAT;
+		default:
+			FEtype_error_real(y);
+		}
+	case t_shortfloat:
+		dx = (double)(sf(x));
+		goto LONGFLOAT0;
+	case t_longfloat:
+		dx = lf(x);
+	LONGFLOAT0:
+		switch (type_of(y)) {
+		case t_fixnum:
+			dy = (double)(fix(y));
+			break;
+		case t_bignum:
+		case t_ratio:
+			dy = number_to_double(y);
+			break;
+		case t_shortfloat:
+			dy = (double)(sf(y));
+			break;
+		case t_longfloat:
+			dy = lf(y);
+			break;
+		default:
+			FEtype_error_real(y);
+		}
+	LONGFLOAT:
+		if (dx == dy)
+			return(0);
+		else if (dx < dy)
+			return(-1);
+		else
+			return(1);
+	default:
+		FEtype_error_real(x);
+	}
+}
+
+@(defun all_different (&rest nums)
+	int i, j;
+	va_list numb;
+@
+	if (narg == 0)
+		FEtoo_few_arguments(&narg);
+	if (narg == 1)
+		@(return Ct)
+	for (i = 0; i < narg; i++) {
+	  cl_object numi = va_arg(nums, cl_object);
+	  va_start(numb, narg);
+	  for (j = 0; j < i; j++)
+	    if (number_equalp(numi, va_arg(numb, cl_object)))
+	      @(return Cnil)
+	}
+	@(return Ct)
+@)
+
+#define MONOTONIC(i, j) (int narg, ...) \
+{ va_list nums; va_start(nums, narg); \
+  return monotonic(i, j, narg, (cl_object *)nums); }
+
+cl_object
+Lmonotonically_nondecreasing	MONOTONIC( 1, 0)
+cl_object
+Lmonotonically_nonincreasing	MONOTONIC(-1, 0)
+cl_object
+Lmonotonically_increasing	MONOTONIC( 1, 1)
+cl_object
+Lmonotonically_decreasing	MONOTONIC(-1, 1)
+
+cl_object
+monotonic(int s, int t, int narg, cl_object *nums)
+{
+	int i;
+
+	if (narg == 0)
+		FEtoo_few_arguments(&narg);
+	/* INV: type check occurs in number_compare() */
+	for (i = 1; i < narg; i++)
+		if (s*number_compare(nums[i], nums[i-1]) < t)
+			return1(Cnil);
+	return1(Ct);
+}
+
+@(defun max (max &rest nums)
+	cl_object numi;
+	int i;
+@
+	/* INV: type check occurs in number_compare() */
+	for (i = 1;  i < narg;  i++) {
+	  numi = va_arg(nums, cl_object);
+	  if (number_compare(max, numi) < 0)
+	    max = numi;
+	}
+	@(return max)
+@)
+
+@(defun min (min &rest nums)
+	cl_object numi;
+	int i;
+@	
+	/* INV: type check occurs in number_compare() */
+	va_start(nums, min);
+	for (i = 1;  i < narg;  i++) {
+	  numi = va_arg(nums, cl_object);
+	  if (number_compare(min, numi) > 0)
+			min = numi;
+	}
+	@(return min)
+@)
diff --git a/src/c/num_log.d b/src/c/num_log.d
new file mode 100644
index 000000000..6f81ce7ce
--- /dev/null
+++ b/src/c/num_log.d
@@ -0,0 +1,693 @@
+/*
+    num_log.c  -- Logical operations on numbers.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+#define BOOLCLR		0
+#define BOOLSET		017
+#define BOOL1		03
+#define BOOL2		05
+#define BOOLC1		014
+#define BOOLC2		012
+#define BOOLAND		01
+#define BOOLIOR		07
+#define BOOLXOR		06
+#define BOOLEQV		011
+#define BOOLNAND	016
+#define BOOLNOR		010
+#define BOOLANDC1	04
+#define BOOLANDC2	02
+#define BOOLORC1	015
+#define BOOLORC2	013
+
+/*
+	x : fixnum or bignum (may be not normalized)
+	y : integer
+   returns
+	fixnum or bignum ( not normalized )
+*/
+
+static cl_object big_log_op(struct bignum *x, cl_object y, int (*op)());
+
+static cl_object
+log_op(int narg, int (*op)(), cl_object *nums)
+{
+	enum cl_type t;
+	cl_object x, numi;
+	int i = 1, j;
+
+	if (narg < 2) FEtoo_few_arguments(&narg);
+	x = *nums++;
+	t = type_of(x);
+	if (t == t_bignum) {
+		x = big_copy(x);	/* since big_log_op clobbers it */
+		goto BIG_OP;
+	} if (t != t_fixnum) {
+		FEtype_error_integer(x);
+	}
+	j = fix(x);
+	for (; i < narg; i++) {
+	  numi = *nums++;
+	  t = type_of(numi);
+	  if (t == t_bignum) {
+	    x = big_log_op(&bignum1(j)->big, numi, op);
+	    i++;
+	    goto BIG_OP;
+	  } else if (t != t_fixnum) {
+	    FEtype_error_integer(numi);
+	  }
+	  j = (*op)(j, fix(numi));
+	}
+	return(MAKE_FIXNUM(j));
+
+BIG_OP:
+	for (; i < narg; i++)	  
+	  x = big_log_op(&x->big, *nums++, op);
+	return(big_normalize(x));
+}
+/*
+	big_log_op(x, y, op) performs the logical operation op on
+	bignum x and integer y, and returns the result in x destructively.
+*/
+static cl_object
+big_log_op(struct bignum *x, cl_object y, int (*op)())
+{
+	int	i, j;
+	int 	y_size, x_size = x->big_size;
+	mp_limb_t *y_limbs, *x_limbs = x->big_limbs;
+	int	y_sign, x_sign = (big_sign((cl_object)x) < 0);
+
+	if (FIXNUMP(y)) {
+	  i = fix(y);
+	  x_limbs[x_size-1] = (*op)(x_limbs[x_size-1], i);
+	  y_sign = (i < 0);
+	} else if (type_of(y) != t_bignum) {
+	  FEtype_error_integer(y);
+	} else {
+	  y_sign = big_sign((cl_object)y) < 0;
+	  x_size = abs(x->big_size);
+	  y_size = abs(y->big.big_size);
+	  y_limbs = y->big.big_limbs;
+
+	  if (y_size > x_size) {
+	    /* First loop finds the size of the result.  */
+	    for (i = y_size - 1; i >= 0; i--) {
+	      j = (i >= x_size) ? 0 : x_limbs[i];
+	      if ((*op)(j, y_limbs[i]) != 0)
+		break;
+	    }
+	    x_size = i + 1;
+
+	    /* Handle allocation, now that we know exactly how much space is
+	       needed for the result.  */
+	    if (x->big_dim < x_size) {
+	      _mpz_realloc(x->big_num, x_size);
+	      x_limbs = x->big_limbs;
+	    }
+	  }
+	  /* Second loop computes the real result.  */
+	  for (i = 0 ; i < x_size; i++)
+	    x_limbs[i] = (*op)(x_limbs[i], y_limbs[i]);
+	}
+	/*
+	  Set the sign according to operation.
+	  */
+	x->big_size = (*op)(x_sign, y_sign)? -x_size : x_size;
+	return((cl_object)x);
+}
+
+static int
+ior_op(int i, int j)
+{
+	return(i | j);
+}
+
+static int
+xor_op(int i, int j)
+{
+	return(i ^ j);
+}
+
+static int
+and_op(int i, int j)
+{
+	return(i & j);
+}
+
+static int
+eqv_op(int i, int j)
+{
+	return(~(i ^ j));
+}
+
+static int
+nand_op(int i, int j)
+{
+	return(~(i & j));
+}
+
+static int
+nor_op(int i, int j)
+{
+	return(~(i | j));
+}
+
+static int
+andc1_op(int i, int j)
+{
+	return((~i) & j);
+}
+
+static int
+andc2_op(int i, int j)
+{
+	return(i & (~j));
+}
+
+static int
+orc1_op(int i, int j)
+{
+	return((~i) | j);
+}
+
+static int
+orc2_op(int i, int j)
+{
+	return(i | (~j));
+}
+
+static int
+b_clr_op(int i, int j)
+{
+	return(0);
+}
+
+static int
+b_set_op(int i, int j)
+{
+	return(-1);
+}
+
+static int
+b_1_op(int i, int j)
+{
+	return(i);
+}
+
+static int
+b_2_op(int i, int j)
+{
+	return(j);
+}
+
+static int
+b_c1_op(int i, int j)
+{
+	return(~i);
+}
+
+static int
+b_c2_op(int i, int j)
+{
+	return(~j);
+}
+
+static int
+big_bitp(cl_object	x, int p)
+{
+	if (p < 0)
+		return 0;
+	else {
+#define BITS_PER_LIMB (sizeof(mp_limb_t)*8)
+ 	  	int size = x->big.big_size;
+ 		mp_limb_t *limbs = x->big.big_limbs;
+ 		int cell = p / BITS_PER_LIMB;
+ 		int bit = p % BITS_PER_LIMB;
+ 		if (size > 0)
+		  if (cell > size)
+		    return(size < 0);
+		  else
+		    return (limbs[cell] >> bit) & 1;
+		else {
+		  mp_size_t zero_bound;
+		  size = -size;
+		  /* Locate the least significant non-zero limb.  */
+		  for (zero_bound = 0; limbs[zero_bound] == 0; zero_bound++)
+		    ;
+		  if (cell > size)
+		    return 1;
+		  else if (cell < zero_bound)
+		    return 0;
+		  else if (cell == zero_bound)
+		    return (-limbs[cell] >> bit) & 1;
+		  else /* cell > zero_bound */
+		    return (~limbs[cell] >> bit) & 1;
+		}
+ 	}
+}
+
+@(defun lognot (x)
+@
+	return Llogxor(1,x,MAKE_FIXNUM(-1));
+@)
+
+static int
+count_bits(cl_object x)
+{
+	cl_fixnum count;
+
+	switch (type_of(x)) {
+	case t_fixnum: {
+		cl_fixnum i = fix(x);
+		cl_fixnum j = (i < 0) ? ~i : i;
+		for (count=0 ; j ; j >>= 1)
+		  if (j & 1) count++;
+		break;
+	}
+	case t_bignum:
+		if (big_sign(x) < 0) {
+			Llognot(1,x);
+			VALUES(0) = x;
+		}
+		count = mpz_popcount(x->big.big_num);
+		break;
+	default:
+		FEtype_error_integer(x);
+	}
+	return count;
+}
+
+/*
+   Left shift if w > 0, right shift if w < 0.
+ */
+cl_object
+integer_shift(cl_object x, int w)
+{
+	cl_object y;
+	int cell, bits, i;
+	
+	if (w == 0) return(x);
+	cell = w / 32;
+	bits = w % 32;
+	if (FIXNUMP(x)) {
+		i = fix(x);
+		if (i == 0) return(x);
+		if (cell == 0) {
+			if (w < 0) {
+				if (i >= 0)
+					return(MAKE_FIXNUM(i >> -w));
+				else
+					return(MAKE_FIXNUM(~((~i) >> -w)));
+			}
+			if (i > 0) {
+				if (((~MOST_POSITIVE_FIX >> w) & i) == 0)
+					return(MAKE_FIXNUM(i << w));
+			} else {
+				if (((MOST_NEGATIVE_FIX >> w) & ~i) == 0)
+					return(MAKE_FIXNUM(i << w));
+			}
+		}
+		x = bignum1(i);
+	}
+	y = big_register0_get();
+	if (w < 0) {
+	  mpz_div_2exp(y->big.big_num, x->big.big_num, -w);
+	} else {
+	  mpz_mul_2exp(y->big.big_num, x->big.big_num, w);
+	}
+	return(big_register_normalize(y));
+}
+
+int
+int_bit_length(int i)
+{
+	register int	count, j;
+
+	count = 0;
+	for (j = 0; j < 31 ; j++)
+		if (((i >> j) & 1) == 1) count = j + 1;
+	return(count);
+}
+
+@(defun logior (&rest nums)
+@
+	if (narg == 0)
+		@(return MAKE_FIXNUM(0))
+	/* INV: log_op() checks types */
+	if (narg == 1)
+		@(return va_arg(nums, cl_object))
+	@(return log_op(narg, ior_op, (cl_object *)nums))
+@)
+
+@(defun logxor (&rest nums)
+@
+	if (narg == 0)
+		@(return MAKE_FIXNUM(0))
+	/* INV: log_op() checks types */
+	if (narg == 1)
+		@(return va_arg(nums, cl_object))
+	@(return log_op(narg, xor_op, (cl_object *)nums))
+@)
+
+@(defun logand (&rest nums)
+@
+	if (narg == 0)
+		@(return MAKE_FIXNUM(-1))
+	/* INV: log_op() checks types */
+	if (narg == 1)
+		@(return va_arg(nums, cl_object))
+	@(return log_op(narg, and_op, (cl_object *)nums))
+@)
+
+@(defun logeqv (&rest nums)
+@
+	if (narg == 0)
+		@(return MAKE_FIXNUM(-1))
+	/* INV: log_op() checks types */
+	if (narg == 1)
+		@(return va_arg(nums, cl_object))
+	@(return log_op(narg, eqv_op, (cl_object *)nums))
+@)
+
+@(defun boole (o &rest nums)
+	int	(*op)();
+@
+	/* FIXME! Is this check ok? */
+	check_arg(3);
+	/* INV: log_op() checks types */
+	switch(fixint(o)) {
+		case BOOLCLR:	op = b_clr_op;	break;
+		case BOOLSET:	op = b_set_op;	break;
+		case BOOL1:	op = b_1_op;	break;
+		case BOOL2:	op = b_2_op;	break;
+		case BOOLC1:	op = b_c1_op;	break;
+		case BOOLC2:	op = b_c2_op;	break;
+		case BOOLAND:	op = and_op;	break;
+		case BOOLIOR:	op = ior_op;	break;
+		case BOOLXOR:	op = xor_op;	break;
+		case BOOLEQV:	op = eqv_op;	break;
+		case BOOLNAND:	op = nand_op;	break;
+		case BOOLNOR:	op = nor_op;	break;
+		case BOOLANDC1:	op = andc1_op;	break;
+		case BOOLANDC2:	op = andc2_op;	break;
+		case BOOLORC1:	op = orc1_op;	break;
+		case BOOLORC2:	op = orc2_op;	break;
+		default:
+			FEerror("~S is an invalid logical operator.",
+				1, o);
+	}
+	@(return log_op(2, op, (cl_object *)nums))
+@)
+
+@(defun logbitp (p x)
+	bool	i;
+@
+	assert_type_non_negative_integer(p);
+	assert_type_integer(x);
+	if (FIXNUMP(p))
+		if (FIXNUMP(x))
+			i = ((fix(x) >> fix(p)) & 1);
+		else
+			i = big_bitp(x, fix(p));
+	else if (FIXNUMP(x))
+		i = (fix(x) < 0);
+	else
+		i = (big_sign(x) < 0);
+	@(return (i ? Ct : Cnil))
+@)
+
+@(defun ash (x y)
+	cl_object r;
+	int sign_x;
+@
+        assert_type_integer(x);
+	assert_type_integer(y);
+	if (FIXNUMP(y))
+	  r = integer_shift(x, fix(y));
+	else {
+	  /*
+	    bit position represented by bignum is probably
+	    out of our address space. So, result is returned
+	    according to sign of integer.
+	    */
+	  if (FIXNUMP(x))
+	    if (fix(x) > 0)
+	      sign_x = 1;
+	    else if (fix(x) == 0)
+	      sign_x = 0;
+	    else
+	      sign_x = -1;
+	  else
+	    sign_x = big_sign(x);
+	  if (big_sign(y) < 0)
+	    if (sign_x < 0)
+	      r = MAKE_FIXNUM(-1);
+	    else
+	      r = MAKE_FIXNUM(0);
+	  else if (sign_x == 0)
+	    r = x;
+	  else
+	    FEerror("Insufficient memory.", 0);
+	}
+	@(return r)
+@)
+
+@(defun logcount (x)
+@
+	@(return MAKE_FIXNUM(count_bits(x)))
+@)
+
+@(defun integer_length (x)
+	int	count, i;
+@
+	switch (type_of(x)) {
+	case t_fixnum:
+		i = fix(x);
+		count = int_bit_length((i < 0) ? ~i : i);
+		break;
+	case t_bignum: {
+	  	int last = abs(x->big.big_size) - 1;
+		i = x->big.big_limbs[last];
+		count = last * (sizeof(mp_limb_t) * 8) + int_bit_length(i);
+		break;
+	}
+	default:
+		FEtype_error_integer(x);
+	}
+	@(return MAKE_FIXNUM(count))
+@)
+
+void
+init_num_log(void)
+{
+	make_constant("BOOLE-CLR", MAKE_FIXNUM(BOOLCLR));
+	make_constant("BOOLE-SET", MAKE_FIXNUM(BOOLSET));
+	make_constant("BOOLE-1", MAKE_FIXNUM(BOOL1));
+	make_constant("BOOLE-2", MAKE_FIXNUM(BOOL2));
+	make_constant("BOOLE-C1", MAKE_FIXNUM(BOOLC1));
+	make_constant("BOOLE-C2", MAKE_FIXNUM(BOOLC2));
+	make_constant("BOOLE-AND", MAKE_FIXNUM(BOOLAND));
+	make_constant("BOOLE-IOR", MAKE_FIXNUM(BOOLIOR));
+	make_constant("BOOLE-XOR", MAKE_FIXNUM(BOOLXOR));
+	make_constant("BOOLE-EQV", MAKE_FIXNUM(BOOLEQV));
+	make_constant("BOOLE-NAND", MAKE_FIXNUM(BOOLNAND));
+	make_constant("BOOLE-NOR", MAKE_FIXNUM(BOOLNOR));
+	make_constant("BOOLE-ANDC1", MAKE_FIXNUM(BOOLANDC1));
+	make_constant("BOOLE-ANDC2", MAKE_FIXNUM(BOOLANDC2));
+	make_constant("BOOLE-ORC1", MAKE_FIXNUM(BOOLORC1));
+	make_constant("BOOLE-ORC2", MAKE_FIXNUM(BOOLORC2));
+}
+
+@(defun si::bit_array_op (o x y r)
+	cl_fixnum i, j, n, d;
+	cl_object r0;
+	int (*op)();
+	bool replace = FALSE;
+	int xi, yi, ri;
+	byte *xp, *yp, *rp;
+	int xo, yo, ro;
+@
+	if (type_of(x) == t_bitvector) {
+		d = x->vector.dim;
+		xp = x->vector.self.bit;
+		xo = x->vector.offset;
+		if (type_of(y) != t_bitvector)
+			goto ERROR;
+		if (d != y->vector.dim)
+			goto ERROR;
+		yp = y->vector.self.bit;
+		yo = y->vector.offset;
+		if (r == Ct)
+			r = x;
+		if (r != Cnil) {
+			if (type_of(r) != t_bitvector)
+				goto ERROR;
+			if (r->vector.dim != d)
+				goto ERROR;
+			i = (r->vector.self.bit - xp)*8 + (r->vector.offset - xo);
+			if ((i > 0 && i < d) || (i < 0 && -i < d)) {
+				r0 = r;
+				r = Cnil;
+				replace = TRUE;
+				goto L1;
+			}
+			i = (r->vector.self.bit - yp)*8 + (r->vector.offset - yo);
+			if ((i > 0 && i < d) || (i < 0 && -i < d)) {
+				r0 = r;
+				r = Cnil;
+				replace = TRUE;
+			}
+		}
+	L1:
+		if (Null(r)) {
+			r = siLmake_vector(6, Sbit, MAKE_FIXNUM(d), Cnil, Cnil, Cnil, Cnil);
+		}
+	} else {
+		if (type_of(x) != t_array)
+			goto ERROR;
+		if ((enum aelttype)x->array.elttype != aet_bit)
+			goto ERROR;
+		d = x->array.dim;
+		xp = x->vector.self.bit;
+		xo = x->vector.offset;
+		if (type_of(y) != t_array)
+			goto ERROR;
+		if ((enum aelttype)y->array.elttype != aet_bit)
+			goto ERROR;
+		if (x->array.rank != y->array.rank)
+			goto ERROR;
+		yp = y->vector.self.bit;
+		yo = y->vector.offset;
+		for (i = 0;  i < x->array.rank;  i++)
+			if (x->array.dims[i] != y->array.dims[i])
+				goto ERROR;
+		if (r == Ct)
+			r = x;
+		if (r != Cnil) {
+			if (type_of(r) != t_array)
+				goto ERROR;
+			if ((enum aelttype)r->array.elttype != aet_bit)
+				goto ERROR;
+			if (r->array.rank != x->array.rank)
+				goto ERROR;
+			for (i = 0;  i < x->array.rank;  i++)
+				if (r->array.dims[i] != x->array.dims[i])
+					goto ERROR;
+			i = (r->vector.self.bit - xp)*8 + (r->vector.offset - xo);
+			if ((i > 0 && i < d) || (i < 0 && -i < d)) {
+				r0 = r;
+				r = Cnil;
+				replace = TRUE;
+				goto L2;
+			} 
+			i = (r->vector.self.bit - yp)*8 + (r->vector.offset - yo);
+			if ((i > 0 && i < d) || (i < 0 && -i < d)) {
+				r0 = r;
+				r = Cnil;
+				replace = TRUE;
+			}
+		}
+	L2:
+		if (Null(r)) {
+		  r = alloc_object(t_array);
+		  r->array.self.t = NULL;
+		  r->array.displaced = Cnil;
+		  r->array.rank = 1;
+		  r->array.dims = NULL;
+		  r->array.elttype = get_aelttype(Sbit);
+		  r->array.dims = alloc_atomic_align(sizeof(int), sizeof(int));
+		  r->array.dim = x->array.dim;
+		  r->array.adjustable = FALSE;
+		  array_allocself(r);
+		}
+	}
+	rp = r->vector.self.bit;
+	ro = r->vector.offset;
+	switch(fixint(o)) {
+		case BOOLCLR:	op = b_clr_op;	break;
+		case BOOLSET:	op = b_set_op;	break;
+		case BOOL1:	op = b_1_op;	break;
+		case BOOL2:	op = b_2_op;	break;
+		case BOOLC1:	op = b_c1_op;	break;
+		case BOOLC2:	op = b_c2_op;	break;
+		case BOOLAND:	op = and_op;	break;
+		case BOOLIOR:	op = ior_op;	break;
+		case BOOLXOR:	op = xor_op;	break;
+		case BOOLEQV:	op = eqv_op;	break;
+		case BOOLNAND:	op = nand_op;	break;
+		case BOOLNOR:	op = nor_op;	break;
+		case BOOLANDC1:	op = andc1_op;	break;
+		case BOOLANDC2:	op = andc2_op;	break;
+		case BOOLORC1:	op = orc1_op;	break;
+		case BOOLORC2:	op = orc2_op;	break;
+		default:
+			FEerror("~S is an invalid logical operator.", 1, o);
+	}
+
+#define	set_high(place, nbits, value) \
+	(place)=((place)&~(-0400>>(nbits)))|((value)&(-0400>>(nbits)))
+
+#define	set_low(place, nbits, value) \
+	(place)=((place)&(-0400>>(8-(nbits))))|((value)&~(-0400>>(8-(nbits))))
+
+#define	extract_byte(integer, pointer, index, offset) \
+	(integer) = (pointer)[(index)+1] & 0377; \
+	(integer) = ((pointer)[index]<<(offset))|((integer)>>(8-(offset)))
+
+#define	store_byte(pointer, index, offset, value) \
+	set_low((pointer)[index], 8-(offset), (value)>>(offset)); \
+	set_high((pointer)[(index)+1], offset, (value)<<(8-(offset)))
+
+	if (xo == 0 && yo == 0 && ro == 0) {
+		for (n = d/8, i = 0;  i < n;  i++)
+			rp[i] = (*op)(xp[i], yp[i]);
+		if ((j = d%8) > 0)
+			set_high(rp[n], j, (*op)(xp[n], yp[n]));
+		if (!replace)
+			@(return r)
+	} else {
+		for (n = d/8, i = 0;  i <= n;  i++) {
+			extract_byte(xi, xp, i, xo);
+			extract_byte(yi, yp, i, yo);
+			if (i == n) {
+				if ((j = d%8) == 0)
+					break;
+				extract_byte(ri, rp, n, ro);
+				set_high(ri, j, (*op)(xi, yi));
+			} else
+				ri = (*op)(xi, yi);
+			store_byte(rp, i, ro, ri);
+		}
+		if (!replace)
+			@(return r)
+	}
+	rp = r0->vector.self.bit;
+	ro = r0->vector.offset;
+	for (n = d/8, i = 0;  i <= n;  i++) {
+		if (i == n) {
+			if ((j = d%8) == 0)
+				break;
+			extract_byte(ri, rp, n, ro);
+			set_high(ri, j, r->vector.self.bit[n]);
+		} else
+			ri = r->vector.self.bit[i];
+		store_byte(rp, i, ro, ri);
+	}
+	@(return r0)
+ERROR:
+	FEerror("Illegal arguments for bit-array operation.", 0);
+@)
+
diff --git a/src/c/num_pred.d b/src/c/num_pred.d
new file mode 100644
index 000000000..bfef4b954
--- /dev/null
+++ b/src/c/num_pred.d
@@ -0,0 +1,148 @@
+/*
+    num_pred.c  -- Predicates on numbers.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+int
+number_zerop(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+		return(x == MAKE_FIXNUM(0));
+
+	case t_bignum:
+	case t_ratio:
+		return(0);
+
+	case t_shortfloat:
+		return(sf(x) == 0.0);
+
+	case t_longfloat:
+		return(lf(x) == 0.0);
+
+	case t_complex:
+		return(number_zerop(x->complex.real) &&
+		       number_zerop(x->complex.imag));
+
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+int
+number_plusp(cl_object x)
+{
+ RESTART:
+	switch (type_of(x)) {
+	case t_fixnum:
+		return(fix(x) > 0);
+
+	case t_bignum:
+		return(big_sign(x) > 0);
+
+	case t_ratio:
+		/* INV: rat_den is always positive */
+		x = x->ratio.num;
+		goto RESTART;
+
+	case t_shortfloat:
+		return(sf(x) > 0.0);
+
+	case t_longfloat:
+		return(lf(x) > 0.0);
+
+	default:
+		FEtype_error_real(x);
+	}
+}
+
+int
+number_minusp(cl_object x)
+{
+ RESTART:
+	switch (type_of(x)) {
+	case t_fixnum:
+		return(fix(x) < 0);
+
+	case t_bignum:
+		return(big_sign(x) < 0);
+
+	case t_ratio:
+		/* INV: rat_den is always positive */
+		x = x->ratio.num;
+		goto RESTART;
+
+	case t_shortfloat:
+		return(sf(x) < 0.0);
+
+	case t_longfloat:
+		return(lf(x) < 0.0);
+
+	default:
+		FEtype_error_real(x);
+	}
+}
+
+int
+number_oddp(cl_object x)
+{
+	if (FIXNUMP(x))
+		return fix(x) & 1;
+	if (type_of(x) == t_bignum)
+		return big_odd_p(x);
+	FEtype_error_integer(x);
+}
+
+int
+number_evenp(cl_object x)
+{
+	if (FIXNUMP(x))
+		return ~fix(x) & 1;
+	if (type_of(x) == t_bignum)
+		return big_even_p(x);
+	FEtype_error_integer(x);
+}
+
+@(defun zerop (x)
+@	/* INV: number_zerop() checks type */
+	@(return (number_zerop(x) ? Ct : Cnil))
+@)
+
+@(defun plusp (x)
+@	/* INV: number_plusp()  checks type */
+	@(return (number_plusp(x) ? Ct : Cnil))
+@)
+
+@(defun minusp (x)
+@	/* INV: number_minusp() checks type */
+	@(return (number_minusp(x) ? Ct : Cnil))
+@)
+
+@(defun oddp (x)
+@	/* INV: number_oddp() checks type */
+	@(return (number_oddp(x) ? Ct : Cnil))
+@)
+
+@(defun evenp (x)
+@	/* INV: number_evenp() checks_type */
+	@(return (number_evenp(x) ? Ct : Cnil))
+@)
+
+/* FIXME: What the hen is this for? */
+@(defun si::nani (x)
+@
+	@(return (cl_object)fixint(x))
+@)
diff --git a/src/c/num_rand.d b/src/c/num_rand.d
new file mode 100644
index 000000000..a3d9e7b02
--- /dev/null
+++ b/src/c/num_rand.d
@@ -0,0 +1,109 @@
+/*
+    num_rand.c  -- Random numbers.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include <time.h>
+
+cl_object Vrandom_state;
+
+static cl_object
+rando(cl_object x, cl_object rs)
+{
+	enum type tx;
+	cl_object z;
+	double d;
+	
+	tx = type_of(x);
+	if (number_compare(x, MAKE_FIXNUM(0)) != 1)
+		FEwrong_type_argument(TSpositive_number, x);
+	d = (double)(rs->random.value>>1) / (4294967296.0/2.0);
+	d = number_to_double(x) * d;
+	if (tx == t_fixnum) {
+		z = MAKE_FIXNUM((int)d);
+		return(z);
+	} else if (tx == t_bignum) {
+		z = double_to_integer(d);
+		return(z);
+	} else if (tx == t_shortfloat) {
+		z = alloc_object(t_shortfloat);
+		sf(z) = (float)d;
+		return(z);
+	} else if (tx == t_longfloat) {
+		z = alloc_object(t_longfloat);
+		lf(z) = d;
+		return(z);
+	} else
+		FEerror("~S is not an integer nor a floating-point number.",
+			1, x);
+}
+
+cl_object
+make_random_state(cl_object rs)
+{
+        cl_object z;
+
+	if (Null(rs)) {
+		z = alloc_object(t_random);
+		z->random.value = symbol_value(Vrandom_state)->random.value;
+		return(z);
+	} else if (rs == Ct) {
+		z = alloc_object(t_random);
+		z->random.value = time(0);
+		return(z);
+	} else if (type_of(rs) != t_random)
+   		FEwrong_type_argument(Srandom_state, rs);
+	else {
+		z =alloc_object(t_random);
+		z->random.value = rs->random.value;
+		return(z);
+	}
+}
+
+static void
+advance_random_state(cl_object rs)
+{
+	rs->random.value
+	= rs->random.value
+	+ (rs->random.value<<2)
+	+ (rs->random.value<<17)
+	+ (rs->random.value<<27);
+}
+
+
+@(defun random (x &optional (rs symbol_value(Vrandom_state)))
+@	
+	if (type_of(rs) != t_random)
+		FEwrong_type_argument(Srandom_state, rs);
+	advance_random_state(rs);
+	@(return rando(x, rs));
+@)
+
+@(defun make_random_state (&optional (rs Cnil))
+@
+	@(return make_random_state(rs))
+@)
+
+@(defun random_state_p (x)
+@
+	@(return ((type_of(x) == t_random) ? Ct : Cnil))
+@)
+
+void
+init_num_rand(void)
+{
+        SYM_VAL(Vrandom_state) = make_random_state(Ct);
+}
diff --git a/src/c/num_sfun.d b/src/c/num_sfun.d
new file mode 100644
index 000000000..9e1b9fa41
--- /dev/null
+++ b/src/c/num_sfun.d
@@ -0,0 +1,531 @@
+/*
+    num_sfun.c  -- Trascendental functions.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include <math.h>
+#ifndef HAVE_ISOC99
+# define expf exp
+# define logf log
+# define sqrtf sqrt
+# define cosf cos
+# define sinf sin
+# define tanf tan
+# define sinhf sinh
+# define coshf cosh
+#endif
+
+#ifndef M_PI
+# ifdef PI
+#  define M_PI PI
+# else
+#   define M_PI 3.14159265358979323846
+# endif
+#endif
+
+cl_object imag_unit, minus_imag_unit, imag_two;
+
+cl_fixnum
+fixnum_expt(cl_fixnum x, cl_fixnum y)
+{
+	int z;
+
+	z = 1;
+	while (y > 0)
+		if (y%2 == 0) {
+			x *= x;
+			y /= 2;
+		} else {
+			z *= x;
+			--y;
+		}
+	return(z);
+}
+
+cl_object
+number_exp(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		return(make_shortfloat(expf(number_to_double(x))));
+
+	case t_shortfloat:
+		return(make_shortfloat(expf(sf(x))));
+
+	case t_longfloat:
+		return(make_longfloat(exp(lf(x))));
+
+	case t_complex: {
+		cl_object y, y1;
+	
+		y = x->complex.imag;
+		x = x->complex.real;
+		x = number_exp(x);
+		y1 = number_cos(y);
+		y = number_sin(y);
+		y = make_complex(y1, y);
+		x = number_times(x, y);
+		return(x);
+	}
+
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+cl_object
+number_expt(cl_object x, cl_object y)
+{
+	enum type tx, ty;
+	cl_object z;
+
+	tx = type_of(x);
+	ty = type_of(y);
+	if (ty == t_fixnum && fix(y) == 0)
+		switch (tx) {
+		case t_fixnum:  case t_bignum:  case t_ratio:
+			return(MAKE_FIXNUM(1));
+
+		case t_shortfloat:
+			return(make_shortfloat(1.0));
+
+		case t_longfloat:
+			return(make_longfloat(1.0));
+
+		case t_complex:
+			z = number_expt(x->complex.real, y);
+			z = make_complex(z, MAKE_FIXNUM(0));
+			return(z);
+
+		default:
+			FEtype_error_number(x);
+		}
+	if (number_zerop(x)) {
+		if (!number_plusp(ty==t_complex?y->complex.real:y))
+			FEerror("Cannot raise zero to the power ~S.", 1, y);
+		return(number_times(x, y));
+	}
+	if (ty == t_fixnum || ty == t_bignum) {
+		if (number_minusp(y)) {
+			z = number_negate(y);
+			z = number_expt(x, z);
+			z = number_divide(MAKE_FIXNUM(1), z);
+			return(z);
+		}
+		z = MAKE_FIXNUM(1);
+		while (number_plusp(y))
+			if (number_evenp(y)) {
+				x = number_times(x, x);
+				y = integer_divide(y, MAKE_FIXNUM(2));
+			} else {
+				z = number_times(z, x);
+				y = number_minus(y, MAKE_FIXNUM(1));
+			}
+		return(z);
+	}
+	z = number_nlog(x);
+	z = number_times(z, y);
+	z = number_exp(z);
+	return(z);
+}
+
+cl_object
+number_nlog(cl_object x)
+{
+	cl_object r, i, a, p;
+
+	if (type_of(x) == t_complex) {
+		r = x->complex.real;
+		i = x->complex.imag;
+		goto COMPLEX;
+	}
+	if (number_zerop(x))
+		FEerror("Zero is the logarithmic singularity.", 0);
+	if (number_minusp(x)) {
+		r = x;
+		i = MAKE_FIXNUM(0);
+		goto COMPLEX;
+	}
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		return(make_shortfloat(logf(number_to_double(x))));
+
+	case t_shortfloat:
+		return(make_shortfloat(logf(sf(x))));
+
+	case t_longfloat:
+		return(make_longfloat(log(lf(x))));
+
+	default:
+		FEtype_error_number(x);
+	}
+COMPLEX:
+	a = number_times(r, r);
+	p = number_times(i, i);
+	a = number_plus(a, p);
+	a = number_nlog(a);
+	a = number_divide(a, MAKE_FIXNUM(2));
+	p = number_atan2(i, r);
+	x = make_complex(a, p);
+	return(x);
+}
+
+cl_object
+number_log(cl_object x, cl_object y)
+{
+	if (number_zerop(y))
+		FEerror("Zero is the logarithmic singularity.", 0);
+	return(number_divide(number_nlog(y), number_nlog(x)));
+}
+
+cl_object
+number_sqrt(cl_object x)
+{
+	cl_object z;
+
+	if (type_of(x) == t_complex)
+		goto COMPLEX;
+	if (number_minusp(x))
+		goto COMPLEX;
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		return(make_shortfloat(sqrtf(number_to_double(x))));
+
+	case t_shortfloat:
+		return(make_shortfloat(sqrtf(sf(x))));
+
+	case t_longfloat:
+		return(make_longfloat(sqrt(lf(x))));
+
+	default:
+		FEtype_error_number(x);
+	}
+
+COMPLEX:
+	z = make_ratio(MAKE_FIXNUM(1), MAKE_FIXNUM(2));
+	z = number_expt(x, z);
+	return(z);
+}
+
+cl_object
+number_atan2(cl_object y, cl_object x)
+{
+	cl_object z;
+	double dy, dx, dz;
+
+	dy = number_to_double(y);
+	dx = number_to_double(x);
+	if (dx > 0.0)
+		if (dy > 0.0)
+			dz = atan(dy / dx);
+		else if (dy == 0.0)
+			dz = 0.0;
+		else
+			dz = -atan(-dy / dx);
+	else if (dx == 0.0)
+		if (dy > 0.0)
+			dz = M_PI / 2.0;
+		else if (dy == 0.0)
+			FEerror("Logarithmic singularity.", 0);
+		else
+			dz = -M_PI / 2.0;
+	else
+		if (dy > 0.0)
+			dz = M_PI - atan(dy / -dx);
+		else if (dy == 0.0)
+			dz = M_PI;
+		else
+			dz = -M_PI + atan(-dy / -dx);
+	if (type_of(x) == t_longfloat || type_of(y) == t_longfloat)
+		z = make_longfloat(dz);
+	else
+		z = make_shortfloat(dz);
+	return(z);
+}
+
+cl_object
+number_atan(cl_object y)
+{
+	cl_object z, z1;
+
+	if (type_of(y) == t_complex) {
+#if 0 /* FIXME! ANSI states it should be this first part */
+		z = number_times(imag_unit, y);
+		z = number_nlog(one_plus(z)) +
+		  number_nlog(number_minus(MAKE_FIXNUM(1), z));
+		z = number_divide(z, number_times(MAKE_FIXNUM(2), imag_unit));
+#else
+		z = number_times(imag_unit, y);
+		z = one_plus(z);
+		z1 = number_times(y, y);
+		z1 = one_plus(z1);
+		z1 = number_sqrt(z1);
+		z = number_divide(z, z1);
+		z = number_nlog(z);
+		z = number_times(minus_imag_unit, z);
+#endif /* ANSI */
+		return(z);
+	}
+	return(number_atan2(y, MAKE_FIXNUM(1)));
+}
+
+cl_object
+number_sin(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		return(make_shortfloat(sinf(number_to_double(x))));
+	case t_shortfloat:
+		return(make_shortfloat(sinf(sf(x))));
+	case t_longfloat:
+		return(make_longfloat(sin(lf(x))));
+	case t_complex: {
+		/*
+		  z = x + I y
+		  z = x + I y
+		  sin(z) = sinh(I z) = sinh(-y + I x)
+		*/
+		double dx = number_to_double(x->complex.real);
+		double dy = number_to_double(x->complex.imag);
+		double a = sin(dx) * cosh(dy);
+		double b = cos(dx) * sinh(dy);
+		if (type_of(x->complex.real) != t_longfloat)
+			return make_complex(make_shortfloat(a), make_shortfloat(b));
+		return make_complex(make_longfloat(a), make_longfloat(b));
+	}
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+cl_object
+number_cos(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		return(make_shortfloat(cosf(number_to_double(x))));
+	case t_shortfloat:
+		return(make_shortfloat(cosf(sf(x))));
+	case t_longfloat:
+		return(make_longfloat(cos(lf(x))));
+	case t_complex: {
+		/*
+		  z = x + I y
+		  cos(z) = cosh(I z) = cosh(-y + I x)
+		*/
+		double dx = number_to_double(x->complex.real);
+		double dy = number_to_double(x->complex.imag);
+		double a =  cos(dx) * cosh(dy);
+		double b = -sin(dx) * sinh(dy);
+		if (type_of(x->complex.real) != t_longfloat)
+			return make_complex(make_shortfloat(a), make_shortfloat(b));
+		return make_complex(make_longfloat(a), make_longfloat(b));
+	}
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+cl_object
+number_tan(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		return(make_shortfloat(tanf(number_to_double(x))));
+	case t_shortfloat:
+		return(make_shortfloat(tanf(sf(x))));
+	case t_longfloat:
+		return(make_longfloat(tan(lf(x))));
+	case t_complex: {
+		cl_object a = number_sin(x);
+		cl_object b = number_cos(x);
+		return number_divide(a, b);
+	}
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+cl_object
+number_sinh(cl_object x)
+{
+
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		return make_shortfloat(sinhf(number_to_double(x)));
+	case t_shortfloat:
+		return make_shortfloat(sinhf(sf(x)));
+	case t_longfloat:
+		return make_longfloat(sinh(lf(x)));
+	case t_complex: {
+		/*
+		  z = x + I y
+		  sinh(z) = (exp(z)-exp(-z))/2
+		          = (exp(x)*(cos(y)+Isin(y))-exp(-x)*(cos(y)-Isin(y)))/2
+			  = sinh(x)*cos(y) + Icosh(x)*sin(y);
+		*/
+		double dx = number_to_double(x->complex.real);
+		double dy = number_to_double(x->complex.imag);
+		double a = sinh(dx) * cos(dy);
+		double b = cosh(dx) * sin(dy);
+		if (type_of(x->complex.real) != t_longfloat)
+			return make_complex(make_shortfloat(a), make_shortfloat(b));
+		return make_complex(make_longfloat(a), make_longfloat(b));
+	}
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+cl_object
+number_cosh(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		return make_shortfloat(coshf(number_to_double(x)));
+	case t_shortfloat:
+		return make_shortfloat(coshf(sf(x)));
+	case t_longfloat:
+		return make_longfloat(cosh(lf(x)));
+	case t_complex: {
+		/*
+		  z = x + I y
+		  cosh(z) = (exp(z)+exp(-z))/2
+		          = (exp(x)*(cos(y)+Isin(y))+exp(-x)*(cos(y)-Isin(y)))/2
+			  = cosh(x)*cos(y) + Isinh(x)*sin(y);
+		*/
+		double dx = number_to_double(x->complex.real);
+		double dy = number_to_double(x->complex.imag);
+		double a = cosh(dx) * cos(dy);
+		double b = sinh(dx) * sin(dy);
+		if (type_of(x->complex.real) != t_longfloat)
+			return make_complex(make_shortfloat(a), make_shortfloat(b));
+		return make_complex(make_longfloat(a), make_longfloat(b));
+	}
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+cl_object
+number_tanh(cl_object x)
+{
+	switch (type_of(x)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		return(make_shortfloat(tanhf(number_to_double(x))));
+	case t_shortfloat:
+		return(make_shortfloat(tanhf(sf(x))));
+	case t_longfloat:
+		return(make_longfloat(tanh(lf(x))));
+	case t_complex: {
+		cl_object a = number_sinh(x);
+		cl_object b = number_cosh(x);
+		return number_divide(a, b);
+	}
+	default:
+		FEtype_error_number(x);
+	}
+}
+
+@(defun exp (x)
+@	/* INV: type check in number_exp() */
+	@(return number_exp(x))
+@)
+
+@(defun expt (x y)
+@	/* INV: type check in number_expt() */
+	@(return number_expt(x, y))
+@)
+
+@(defun log (x &optional (y OBJNULL))
+@	/* INV: type check in number_nlog() and number_log() */
+	if (y == OBJNULL)
+		@(return number_nlog(x))
+	@(return number_log(y, x))
+@)
+
+@(defun sqrt (x)
+@	/* INV: type check in number_sqrt() */
+	@(return number_sqrt(x))
+@)
+
+@(defun sin (x)
+@	/* INV: type check in number_sin() */
+	@(return number_sin(x))
+@)
+
+@(defun cos (x)
+@	/* INV: type check in number_cos() */
+	@(return number_cos(x))
+@)
+
+@(defun tan (x)
+@	/* INV: type check in number_tan() */
+	@(return number_tan(x))
+@)
+
+@(defun atan (x &optional (y OBJNULL))
+@	/* INV: type check in number_atan() & number_atan2() */
+	if (y == OBJNULL)
+		@(return number_atan(x))
+	@(return number_atan2(x, y))
+@)
+
+@(defun sinh (x)
+@	/* INV: type check in number_sin() */
+	@(return number_sinh(x))
+@)
+
+@(defun cosh (x)
+@	/* INV: type check in number_cos() */
+	@(return number_cosh(x))
+@)
+
+@(defun tanh (x)
+@	/* INV: type check in number_tan() */
+	@(return number_tanh(x))
+@)
+
+void
+init_num_sfun(void)
+{
+	imag_unit = make_complex(make_shortfloat(0.0), make_shortfloat(1.0));
+	register_root(&imag_unit);
+	minus_imag_unit = make_complex(make_shortfloat(0.0),
+				       make_shortfloat(-1.0));
+	register_root(&minus_imag_unit);
+	imag_two = make_complex(make_shortfloat(0.0), make_shortfloat(2.0));
+	register_root(&imag_two);
+
+	make_constant("PI", make_longfloat(M_PI));
+}
diff --git a/src/c/number.d b/src/c/number.d
new file mode 100644
index 000000000..2be7bd7e7
--- /dev/null
+++ b/src/c/number.d
@@ -0,0 +1,207 @@
+/*
+    number.c -- Numeric constants.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+cl_object shortfloat_zero;
+cl_object longfloat_zero;
+
+int
+fixint(cl_object x)
+{
+	if (!FIXNUMP(x))
+		FEwrong_type_argument(Sfixnum, x);
+	return fix(x);
+}
+
+int
+fixnnint(cl_object x)
+{
+	if (FIXNUMP(x)) {
+		cl_fixnum i = fix(x);
+		if (i >= 0)
+			return i;
+	}
+	FEcondition(9, Ssimple_type_error, Kformat_control,
+		    make_simple_string("Not a non-negative fixnum ~S"),
+		    Kformat_arguments, list(1,x),
+		    Kexpected_type, Sfixnum, Kdatum, x);
+}
+
+cl_object
+make_ratio(cl_object num, cl_object den)
+{
+	cl_object g, r;
+
+	if (number_zerop(num))
+		return(MAKE_FIXNUM(0));
+	if (number_zerop(den))
+		FEerror("Zero denominator.", 0);
+	if (den == MAKE_FIXNUM(1))
+		return(num);
+	if (number_minusp(den)) {
+		num = number_negate(num);
+		den = number_negate(den);
+	}
+	g = get_gcd(num, den);
+	num = integer_divide(num, g);
+	den = integer_divide(den, g);
+	if (den == MAKE_FIXNUM(1))
+		return num;
+	if (den == MAKE_FIXNUM(-1))
+		return number_negate(num);
+	r = alloc_object(t_ratio);
+	r->ratio.num = num;
+	r->ratio.den = den;
+	return(r);
+}
+
+cl_object
+make_shortfloat(float f)
+{
+	cl_object x;
+
+	
+	if (f == (float)0.0)
+		return(shortfloat_zero);
+	if (isnanf(f) || isinf(f))
+		FEerror("Not a number.",0);
+	x = alloc_object(t_shortfloat);
+	sf(x) = f;
+	return(x);
+}
+
+cl_object
+make_longfloat(double f)
+{
+	cl_object x;
+
+	if (f == (double)0.0)
+		return(longfloat_zero);
+	if (isnan(f) || isinf(f))
+		FEerror("Not a number.",0);
+	x = alloc_object(t_longfloat);
+	lf(x) = f;
+	return(x);
+}
+
+cl_object
+make_complex(cl_object r, cl_object i)
+{
+	cl_object c;
+
+	switch (type_of(r)) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+		switch (type_of(i)) {
+		case t_fixnum:
+			if (i == MAKE_FIXNUM(0))
+				return(r);
+		case t_bignum:
+		case t_ratio:
+			break;
+		case t_shortfloat:
+			r = make_shortfloat((float)number_to_double(r));
+			break;
+		case t_longfloat:
+			r = make_longfloat(number_to_double(r));
+			break;
+		default:
+			FEtype_error_real(i);
+		}
+		break;
+	case t_shortfloat:
+		switch (type_of(i)) {
+		case t_fixnum:
+		case t_bignum:
+		case t_ratio:
+			i = make_shortfloat((float)number_to_double(i));
+		case t_shortfloat:
+			break;
+		case t_longfloat:
+			r = make_longfloat((double)(sf(r)));
+			break;
+		default:
+			FEtype_error_real(i);
+		}
+		break;
+	case t_longfloat:
+		switch (type_of(i)) {
+		case t_fixnum:
+		case t_bignum:
+		case t_ratio:
+		case t_shortfloat:
+			i = make_longfloat(number_to_double(i));
+		case t_longfloat:
+			break;
+		default:
+			FEtype_error_real(i);
+		}
+		break;
+	default:
+		FEtype_error_real(r);
+	}			
+	c = alloc_object(t_complex);
+	c->complex.real = r;
+	c->complex.imag = i;
+	return(c);
+}
+
+double
+number_to_double(cl_object x)
+{
+	switch(type_of(x)) {
+	case t_fixnum:
+		return((double)(fix(x)));
+
+	case t_bignum:
+		return(big_to_double(x));
+
+	case t_ratio:
+		return(number_to_double(x->ratio.num) /
+		       number_to_double(x->ratio.den));
+
+	case t_shortfloat:
+		return((double)(sf(x)));
+
+	case t_longfloat:
+		return(lf(x));
+
+	default:
+		FEtype_error_real(x);
+	}
+}
+
+void
+init_number(void)
+{
+	shortfloat_zero = alloc_object(t_shortfloat);
+	sf(shortfloat_zero) = (float)0.0;
+	longfloat_zero = alloc_object(t_longfloat);
+	lf(longfloat_zero) = (double)0.0;
+	register_root(&shortfloat_zero);
+	register_root(&longfloat_zero);
+
+  	make_constant("MOST-POSITIVE-FIXNUM", MAKE_FIXNUM(MOST_POSITIVE_FIX));
+	make_constant("MOST-NEGATIVE-FIXNUM", MAKE_FIXNUM(MOST_NEGATIVE_FIX));
+
+	init_big();
+	init_num_co();
+	init_num_log();
+	init_num_sfun();
+	init_num_rand();
+}
diff --git a/src/c/old/all_symbols.d b/src/c/old/all_symbols.d
new file mode 100644
index 000000000..0f45fe444
--- /dev/null
+++ b/src/c/old/all_symbols.d
@@ -0,0 +1,308 @@
+#include "ecls.h"
+#include "page.h"
+
+const struct symbol_info all_symbols[] = {
+/* assignment.c */
+{&Ssetf, "SETF", CL_ORDINARY},
+{&Spsetf, "PSETF", CL_ORDINARY},
+{&siSsetf_symbol, "SETF-SYMBOL", SI_ORDINARY},
+{&siSclear_compiler_properties, "CLEAR-COMPILER-PROPERTIES", SI_ORDINARY},
+#ifdef PDE
+{&siVrecord_source_pathname_p, "*RECORD-SOURCE-PATHNAME-P*", SI_SPECIAL},
+{&siSrecord_source_pathname, "RECORD-SOURCE-PATHNAME", SI_ORDINARY},
+#endif
+
+/* backq.c */
+{&siScomma, ",", SI_ORDINARY},
+{&siScomma_at, ",@@", SI_ORDINARY},
+{&siScomma_dot, ",.", SI_ORDINARY},
+{&SlistX, "LIST*", CL_ORDINARY},
+{&Sappend, "APPEND", CL_ORDINARY},
+{&Snconc, "NCONC", CL_ORDINARY},
+
+/* bind.c */
+{&SAoptional, "&OPTIONAL", CL_ORDINARY},
+{&SArest, "&REST", CL_ORDINARY},
+{&SAkey, "&KEY", CL_ORDINARY},
+{&SAallow_other_keys, "&ALLOW-OTHER-KEYS", CL_ORDINARY},
+{&SAaux, "&AUX", CL_ORDINARY},
+
+/* block.c */
+{&Sblock, "BLOCK", CL_ORDINARY},
+
+/* clos.c */
+#ifdef CLOS
+{&siSXclass_name_hash_tableX, "*CLASS-NAME-HASH-TABLE*", SI_SPECIAL},
+{&Sclass, "CLASS", CL_ORDINARY},
+{&Sbuilt_in, "BUILT-IN", CL_ORDINARY},
+#endif
+
+/* compiler.c */
+{&siSlambda_block, "LAMBDA-BLOCK", CL_ORDINARY},
+
+/* conditional.c */
+{&Sotherwise, "OTHERWISE", CL_ORDINARY},
+
+/* error.c */
+{&siSuniversal_error_handler, "UNIVERSAL-ERROR-HANDLER", SI_ORDINARY},
+{&siSterminal_interrupt, "TERMINAL-INTERRUPT", SI_ORDINARY},
+
+/* eval.c */
+{&Sapply, "APPLY", CL_ORDINARY},
+{&Sfuncall, "FUNCALL", CL_ORDINARY},
+{&Vevalhook, "*EVALHOOK*", CL_SPECIAL},
+{&Vapplyhook, "*APPLYHOOK*", CL_SPECIAL},
+
+/* file.c */
+{&Vstandard_input, "*STANDARD-INPUT*", CL_SPECIAL},
+{&Vstandard_output, "*STANDARD-OUTPUT*", CL_SPECIAL},
+{&Verror_output, "*ERROR-OUTPUT*", CL_SPECIAL},
+{&Vquery_io, "*QUERY-IO*", CL_SPECIAL},
+{&Vdebug_io, "*DEBUG-IO*", CL_SPECIAL},
+{&Vterminal_io, "*TERMINAL-IO*", CL_SPECIAL},
+{&Vtrace_output, "*TRACE-OUTPUT*", CL_SPECIAL},
+{&siVignore_eof_on_terminal_io, "*IGNORE-EOF-ON-TERMINAL-IO*", SI_SPECIAL},
+
+/* format.c */
+{&siVindent_formatted_output, "*INDENT-FORMATTED-OUTPUT*", SI_SPECIAL},
+
+/* gbc.c */
+#if 0 && !defined(GBC_BOEHM)
+{&siVgc_verbose, "*GC-VERBOSE*", SI_SPECIAL},
+{&siVgc_message, "*GC-MESSAGE*", SI_SPECIAL},
+#endif /* !GBC_BOEHM */
+
+/* gfun.c */
+{&siScompute_applicable_methods, "COMPUTE-APPLICABLE-METHODS", SI_ORDINARY},
+{&siScompute_effective_method, "COMPUTE-EFFECTIVE-METHOD", SI_ORDINARY},
+{&siSgeneric_function_method_combination, "GENERIC-FUNCTION-METHOD-COMBINATION", SI_ORDINARY},
+{&siSgeneric_function_method_combination_args, "GENERIC-FUNCTION-METHOD-COMBINATION-ARGS", SI_ORDINARY},
+
+/* hash.c */
+{&Seq, "EQ", CL_ORDINARY},
+{&Seql, "EQL", CL_ORDINARY},
+{&Sequal, "EQUAL", CL_ORDINARY},
+
+/* instance.c */
+{&Sprint_object, "PRINT-OBJECT", CL_ORDINARY},
+
+/* lex.c */
+{&Smacro, "MACRO", CL_ORDINARY},
+{&siSsymbol_macro, "SYMBOL-MACRO", SI_ORDINARY},
+{&Stag, "TAG", CL_ORDINARY},
+
+/* load.c */
+{&Vload_verbose, "*LOAD-VERBOSE*", CL_SPECIAL},
+#ifdef PDE
+{&siVsource_pathname, "*SOURCE-PATHNAME*", CL_SPECIAL},
+#endif
+#ifdef RSYM
+{&siVsymbol_table, "*SYMBOL-TABLE*", CL_SPECIAL},
+#endif
+
+/* lwp.c */
+#ifdef THREADS
+{&Srunning, "RUNNING", CL_ORDINARY},
+{&Ssuspended, "SUSPENDED", CL_ORDINARY},
+{&Swaiting, "WAITING", CL_ORDINARY},
+{&Sstopped, "STOPPED", CL_ORDINARY},
+{&Sdead, "DEAD", CL_ORDINARY},
+{&siSthread_top_level, "THREAD-TOP-LEVEL", SI_ORDINARY},
+#endif
+
+/* macros.c */
+{&Vmacroexpand_hook, "*MACROEXPAND-HOOK*", CL_SPECIAL},
+{&siSexpand_defmacro, "EXPAND-DEFMACRO", SI_ORDINARY},
+{&siVinhibit_macro_special, "*INHIBIT-MACRO-SPECIAL*", SI_SPECIAL},
+
+/* main.c */
+{&siVsystem_directory, "*SYSTEM-DIRECTORY*", SI_SPECIAL},
+{&Vfeatures, "*FEATURES*", CL_SPECIAL},
+
+/* num_rand.c */
+{&Vrandom_state, "*RANDOM-STATE*", CL_SPECIAL},
+
+/* package.c */
+{&Vpackage, "*PACKAGE*", CL_SPECIAL},
+
+/* pathname.c */
+{&Vdefault_pathname_defaults, "*DEFAULT-PATHNAME-DEFAULTS*", CL_SPECIAL},
+
+/* print.c */
+{&Vprint_escape, "*PRINT-ESCAPE*", CL_SPECIAL},
+{&Vprint_pretty, "*PRINT-PRETTY*", CL_SPECIAL},
+{&Vprint_circle, "*PRINT-CIRCLE*", CL_SPECIAL},
+{&Vprint_base, "*PRINT-BASE*", CL_SPECIAL},
+{&Vprint_radix, "*PRINT-RADIX*", CL_SPECIAL},
+{&Vprint_case, "*PRINT-CASE*", CL_SPECIAL},
+{&Vprint_gensym, "*PRINT-GENSYM*", CL_SPECIAL},
+{&Vprint_level, "*PRINT-LEVEL*", CL_SPECIAL},
+{&Vprint_length, "*PRINT-LENGTH*", CL_SPECIAL},
+{&Vprint_array, "*PRINT-ARRAY*", CL_SPECIAL},
+{&siSpretty_print_format, "PRETTY-PRINT-FORMAT", SI_ORDINARY},
+{&siSsharp_exclamation, "#!", SI_ORDINARY},
+{&siVprint_package, "*PRINT-PACKAGE*", SI_SPECIAL},
+{&siVprint_structure, "*PRINT-STRUCTURE*", SI_SPECIAL},
+#ifdef CLOS
+{&Sstream_write_char, "STREAM-WRITE-CHAR", CL_ORDINARY},
+{&Sstream_write_string, "STREAM-WRITE-STRING", CL_ORDINARY},
+{&Sstream_fresh_line, "STREAM-FRESH-LINE", CL_ORDINARY},
+{&Sstream_clear_output, "STREAM-CLEAR-OUTPUT", CL_ORDINARY},
+{&Sstream_force_output, "STREAM-FORCE-OUTPUT", CL_ORDINARY},
+#endif
+
+/* profile.c */
+#ifdef PROFILE
+{&sSAprofile_arrayA, "*PROFILE-ARRAY*", SI_SPECIAL},
+#endif PROFILE
+
+/* read.c */
+{&Vreadtable, "*READTABLE*", CL_SPECIAL},
+{&Vread_default_float_format, "*READ-DEFAULT-FLOAT-FORMAT*", CL_SPECIAL},
+{&Vread_base, "*READ-BASE*", CL_SPECIAL},
+{&Vread_suppress, "*READ-SUPPRESS*", CL_SPECIAL},
+{&siSsharp_comma, "#,", SI_ORDINARY},
+#ifdef CLOS
+{&Sstream_read_line, "STREAM-READ-LINE", CL_ORDINARY},
+{&Sstream_read_char, "STREAM-READ-CHAR", CL_ORDINARY},
+{&Sstream_unread_char, "STREAM-UNREAD-CHAR", CL_ORDINARY},
+{&Sstream_peek_char, "STREAM-PEEK-CHAR", CL_ORDINARY},
+{&Sstream_listen, "STREAM-LISTEN", CL_ORDINARY},
+{&Sstream_clear_input, "STREAM-CLEAR-INPUT", CL_ORDINARY},
+#endif
+
+/* structure.c */
+{&siSstructure_print_function, "STRUCTURE-PRINT-FUNCTION", SI_ORDINARY},
+{&siSstructure_slot_descriptions, "STRUCTURE-SLOT-DESCRIPTIONS", SI_ORDINARY},
+#ifndef CLOS
+{&siSstructure_include, "STRUCTURE-INCLUDE", SI_ORDINARY},
+#else
+{&Sstructure_object, "STRUCTURE-OBJECT", CL_ORDINARY},
+#endif
+
+/* symbol.c */
+{&siSpname, "PNAME", SI_ORDINARY},
+{&Vgensym_counter, "*GENSYM-COUNTER*", CL_SPECIAL},
+
+/* toplevel.c */
+{&Sdeclare, "DECLARE", CL_ORDINARY},
+{&Scompile, "COMPILE", CL_ORDINARY},
+{&Sload, "LOAD", CL_ORDINARY},
+{&Seval, "EVAL", CL_ORDINARY},
+{&Sprogn, "PROGN", CL_ORDINARY},
+{&Swarn, "WARN", CL_ORDINARY},
+{&Stypep, "TYPEP", CL_ORDINARY},
+
+/* typespec.c */
+{&Squote, "QUOTE", CL_ORDINARY},
+{&Slambda, "LAMBDA", CL_ORDINARY},
+{&Sspecial, "SPECIAL", CL_ORDINARY},
+{&St, "T", CL_ORDINARY},
+{&Snil, "NIL", CL_ORDINARY},
+{&Scommon, "COMMON", CL_ORDINARY},
+{&Ssequence, "SEQUENCE", CL_ORDINARY},
+{&Snull, "NULL", CL_ORDINARY},
+{&Scons, "CONS", CL_ORDINARY},
+{&Slist, "LIST", CL_ORDINARY},
+{&Ssymbol, "SYMBOL", CL_ORDINARY},
+{&Sarray, "ARRAY", CL_ORDINARY},
+{&Svector, "VECTOR", CL_ORDINARY},
+{&Sbit_vector, "BIT-VECTOR", CL_ORDINARY},
+{&Sstring, "STRING", CL_ORDINARY},
+{&Ssimple_array, "SIMPLE-ARRAY", CL_ORDINARY},
+{&Ssimple_vector, "SIMPLE-VECTOR", CL_ORDINARY},
+{&Ssimple_string, "SIMPLE-STRING", CL_ORDINARY},
+{&Ssimple_bit_vector, "SIMPLE-BIT-VECTOR", CL_ORDINARY},
+{&Sfunction, "FUNCTION", CL_ORDINARY},
+{&Spathname, "PATHNAME", CL_ORDINARY},
+{&Slogical_pathname, "LOGICAL-PATHNAME", CL_ORDINARY},
+{&Scharacter, "CHARACTER", CL_ORDINARY},
+{&Sbase_char, "BASE-CHAR", CL_ORDINARY},
+{&Sextended_char, "EXTENDED-CHAR", CL_ORDINARY},
+{&Scompiled_function, "COMPILED-FUNCTION", CL_ORDINARY},
+{&Snumber, "NUMBER", CL_ORDINARY},
+{&Sreal, "REAL", CL_ORDINARY},
+{&Srational, "RATIONAL", CL_ORDINARY},
+{&Sfloat, "FLOAT", CL_ORDINARY},
+{&Sinteger, "INTEGER", CL_ORDINARY},
+{&Sratio, "RATIO", CL_ORDINARY},
+{&Sshort_float, "SHORT-FLOAT", CL_ORDINARY},
+{&Sstandard_char, "STANDARD-CHAR", CL_ORDINARY},
+{&Sfixnum, "FIXNUM", CL_ORDINARY},
+{&Scomplex, "COMPLEX", CL_ORDINARY},
+{&Ssingle_float, "SINGLE-FLOAT", CL_ORDINARY},
+{&Spackage, "PACKAGE", CL_ORDINARY},
+{&Sbignum, "BIGNUM", CL_ORDINARY},
+{&Srandom_state, "RANDOM-STATE", CL_ORDINARY},
+{&Sdouble_float, "DOUBLE-FLOAT", CL_ORDINARY},
+{&Sstream, "STREAM", CL_ORDINARY},
+{&Sbit, "BIT", CL_ORDINARY},
+{&Sreadtable, "READTABLE", CL_ORDINARY},
+{&Slong_float, "LONG-FLOAT", CL_ORDINARY},
+{&Shash_table, "HASH-TABLE", CL_ORDINARY},
+{&Ssigned_char, "SIGNED-CHAR", CL_ORDINARY},
+{&Sunsigned_char, "UNSIGNED-CHAR", CL_ORDINARY},
+{&Ssigned_short, "SIGNED-SHORT", CL_ORDINARY},
+{&Sunsigned_short, "UNSIGNED-SHORT", CL_ORDINARY},
+#ifdef CLOS
+{&Sinstance, "INSTANCE", CL_ORDINARY},
+{&Sdispatch_function, "DISPATCH-FUNCTION", CL_ORDINARY},
+{&Sstructure, "STRUCTURE", CL_ORDINARY},
+#endif
+{&Ssatisfies, "SATISFIES", CL_ORDINARY},
+{&Smember, "MEMBER", CL_ORDINARY},
+{&Snot, "NOT", CL_ORDINARY},
+{&Sor, "OR", CL_ORDINARY},
+{&Sand, "AND", CL_ORDINARY},
+{&Svalues, "VALUES", CL_ORDINARY},
+{&Smod, "MOD", CL_ORDINARY},
+{&Ssigned_byte, "SIGNED-BYTE", CL_ORDINARY},
+{&Sunsigned_byte, "UNSIGNED-BYTE", CL_ORDINARY},
+{&SX, "*", CL_ORDINARY},
+{&Splusp, "PLUSP", CL_ORDINARY},
+{&Skeyword, "KEYWORD", CL_ORDINARY},
+#ifdef THREADS
+{&Scont, "CONT", CL_ORDINARY},
+{&Sthread, "THREAD", CL_ORDINARY},
+#endif
+#ifdef LOCATIVE
+{&Slocative, "LOCATIVE", CL_ORDINARY},
+#endif
+{&Ssubtypep, "SUBTYPEP", CL_ORDINARY},
+
+/* unify.c */
+#ifdef LOCATIVE
+{&Ssetq, "SETQ", CL_ORDINARY},
+{&Sunify_slot, "UNIFY-SLOT", CL_ORDINARY},
+#endif
+
+{NULL, (const char*)NULL, CL_ORDINARY}};
+
+void
+init_all_symbols(void) {
+  const struct symbol_info *s = all_symbols;
+  cl_object *loc;
+
+  /* This must keep the garbage collector happy */
+  for (s = all_symbols; s->name != NULL; s++)
+    *(s->loc) = OBJNULL;
+
+  for (s = all_symbols; s->name != NULL; s++) {
+    loc = s->loc;
+    switch (s->type) {
+    case CL_ORDINARY:
+      *loc = make_ordinary(s->name);
+      break;
+    case CL_SPECIAL:
+      *loc = make_special(s->name, Cnil);
+      break;
+    case SI_ORDINARY:
+      *loc = make_si_ordinary(s->name);
+      break;
+    case SI_SPECIAL:
+      *loc = make_si_special(s->name, Cnil);
+      break;
+    }
+    /*    register_root(loc);*/
+  }
+}
diff --git a/src/c/old/compiler.d b/src/c/old/compiler.d
new file mode 100644
index 000000000..9cbae7526
--- /dev/null
+++ b/src/c/old/compiler.d
@@ -0,0 +1,2148 @@
+/*
+    compiler.c -- Bytecode compiler
+*/
+/*
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include "ecls-inl.h"
+#include "bytecodes.h"
+
+/********************* EXPORTS *********************/
+
+cl_object siSlambda_block;
+cl_object Sdeclare;
+cl_object Sdefun;
+cl_object Scompile, Sload, Seval, Sprogn, Swarn, Stypep, Sotherwise;
+cl_object Kexecute, Kcompile_toplevel, Kload_toplevel;
+cl_object siVinhibit_macro_special;
+
+cl_object SAoptional;
+cl_object SArest;
+cl_object SAkey;
+cl_object SAallow_other_keys;
+cl_object SAaux;
+
+cl_object Kallow_other_keys;
+
+cl_object bytecodes;
+
+/********************* PRIVATE ********************/
+
+static cl_index asm_begin(void);
+static cl_object asm_end(cl_index);
+static void asm_clear(cl_index);
+static void asm_grow(void);
+static void asm1(register cl_object op);
+static void asm_op(register int n);
+static void asm_list(register cl_object l);
+static void asmn(int narg, ...);
+static void asm_at(register cl_index where, register cl_object what);
+static cl_index asm_jmp(register int op);
+static void asm_complete(register int op, register cl_index original);
+static cl_index current_pc();
+static void set_pc(cl_index pc);
+static cl_object asm_ref(register cl_index where);
+
+static void c_and(cl_object args);
+static void c_block(cl_object args);
+static void c_case(cl_object args);
+static void c_catch(cl_object args);
+static void c_cond(cl_object args);
+static void c_do(cl_object args);
+static void c_doa(cl_object args);
+static void c_dolist(cl_object args);
+static void c_dotimes(cl_object args);
+static void c_eval_when(cl_object args);
+static void c_flet(cl_object args);
+static void c_function(cl_object args);
+static void c_go(cl_object args);
+static void c_if(cl_object args);
+static void c_labels(cl_object args);
+static void c_let(cl_object args);
+static void c_leta(cl_object args);
+static void c_macrolet(cl_object args);
+static void c_multiple_value_bind(cl_object args);
+static void c_multiple_value_call(cl_object args);
+static void c_multiple_value_prog1(cl_object args);
+static void c_multiple_value_setq(cl_object args);
+static void c_nth_value(cl_object args);
+static void c_or(cl_object args);
+static void c_progv(cl_object args);
+static void c_psetq(cl_object args);
+static void c_values(cl_object args);
+static void c_setq(cl_object args);
+static void c_return(cl_object args);
+static void c_return_from(cl_object args);
+static void c_symbol_macrolet(cl_object args);
+static void c_tagbody(cl_object args);
+static void c_throw(cl_object args);
+static void c_unless(cl_object args);
+static void c_unwind_protect(cl_object args);
+static void c_when(cl_object args);
+static void compile_body(cl_object args);
+static void compile_form(cl_object args, bool push);
+
+/* -------------------- SAFE LIST HANDLING -------------------- */
+
+static cl_object
+pop(cl_object *l) {
+	cl_object head, list = *l;
+	if (ATOM(list))
+		FEerror("Error parsing special form",0);
+	head = CAR(list);
+	*l = CDR(list);
+	return head;
+}
+
+static cl_object
+pop_maybe_nil(cl_object *l) {
+	cl_object head, list = *l;
+	if (list == Cnil)
+		return Cnil;
+	if (ATOM(list))
+		FEerror("Error parsing special form",0);
+	head = CAR(list);
+	*l = CDR(list);
+	return head;
+}
+
+/* ------------------------------ ASSEMBLER ------------------------------ */
+
+static cl_index
+asm_begin(void) {
+	/* Save beginning of bytecodes for this session */
+	return current_pc();
+}
+
+static void
+asm_clear(cl_index beginning) {
+	cl_index i;
+	/* Remove data from this session */
+	bytecodes->vector.fillp = beginning;
+}
+
+static cl_object
+asm_end(cl_index beginning) {
+	cl_object new_bytecodes;
+	cl_index length, bytes, i;
+
+	/* Save bytecodes from this session in a new vector */
+	length = current_pc() - beginning;
+	bytes = length * sizeof(cl_object);
+	new_bytecodes = alloc_object(t_bytecodes);
+	new_bytecodes->bytecodes.lex = Cnil;
+	new_bytecodes->bytecodes.data = alloc(bytes);
+	new_bytecodes->bytecodes.size = length;
+	memcpy(new_bytecodes->bytecodes.data,
+	       &bytecodes->vector.self.t[beginning],
+	       bytes);
+
+	asm_clear(beginning);
+	return new_bytecodes;
+}
+
+static void
+asm_grow(void) {
+	cl_object *old_data = bytecodes->vector.self.t;
+	cl_index old_size = bytecodes->vector.fillp;
+	bytecodes->vector.dim += 128;
+	array_allocself(bytecodes);
+	memcpy(bytecodes->vector.self.t, old_data, old_size*sizeof(cl_object));
+}
+
+static void
+asm1(register cl_object op) {
+	int where = bytecodes->vector.fillp;
+	if (where >= bytecodes->vector.dim)
+		asm_grow();
+	bytecodes->vector.self.t[where] = op;
+	bytecodes->vector.fillp++;
+}
+
+static void
+asm_op(register int n) {
+	asm1(MAKE_FIXNUM(n));
+}
+
+static void
+asm_op2(register int code, register cl_fixnum n) {
+	cl_object op = MAKE_FIXNUM(code);
+	cl_object new_op = SET_OPARG(op, n);
+	if (n < -MAX_OPARG || MAX_OPARG < n)
+		FEerror("Argument to bytecode is too large", 0);
+	else
+		asm1(new_op);
+}
+
+static inline cl_object
+make_op(int code) {
+	return MAKE_FIXNUM(code);
+}
+
+static cl_object
+make_op2(int code, cl_fixnum n) {
+	cl_object volatile op = MAKE_FIXNUM(code);
+	cl_object new_op = SET_OPARG(op, n);
+	if (n < -MAX_OPARG || MAX_OPARG < n)
+		FEerror("Argument to bytecode is too large", 0);
+	return new_op;
+}
+
+static void
+asm_insert(cl_fixnum where, cl_object op) {
+	cl_fixnum end = bytecodes->vector.fillp;
+	if (where > end)
+		FEerror("asm1_insert: position out of range", 0);
+	if (end >= bytecodes->vector.dim)
+		asm_grow();
+	memmove(&bytecodes->vector.self.t[where+1],
+		&bytecodes->vector.self.t[where],
+		(end - where) * sizeof(cl_object));
+	bytecodes->vector.fillp++;
+	bytecodes->vector.self.t[where] = op;
+}
+
+static void
+asm_list(register cl_object l) {
+	if (ATOM(l))
+		asm1(l);
+	while(!endp(l)) {
+		asm1(CAR(l));
+		l = CDR(l);
+	}
+}
+
+static void
+asmn(int narg, ...) {
+	va_list args;
+
+	va_start(args, narg);
+	while (narg-- > 0)
+		asm1(va_arg(args, cl_object));
+}
+
+static void
+asm_at(register cl_index where, register cl_object what) {
+	if (where > bytecodes->vector.fillp)
+		FEerror("Internal error at asm_at()",0);
+	bytecodes->vector.self.t[where] = what;
+}
+
+static cl_index
+asm_block(void) {
+	cl_index output;
+	output = current_pc();
+	asm1(MAKE_FIXNUM(0));
+	return output;
+}	
+
+static cl_index
+asm_jmp(register int op) {
+	cl_index output = current_pc();
+	asm_op(op);
+	return output;
+}
+
+static void
+asm_complete(register int op, register cl_index original) {
+	cl_fixnum delta = current_pc() - original;
+	cl_object code = asm_ref(original);
+	cl_object new_code = SET_OPARG(code, delta);
+	if (code != MAKE_FIXNUM(op))
+		FEerror("Non matching codes in ASM-COMPLETE2", 0);
+	else if (delta < -MAX_OPARG || delta > MAX_OPARG)
+		FEerror("Too large jump", 0);
+	else
+		asm_at(original, new_code);
+}
+
+static cl_index
+current_pc(void) {
+	return bytecodes->vector.fillp;
+}
+
+static void
+set_pc(cl_index pc) {
+	bytecodes->vector.fillp = pc;
+}
+
+static cl_object
+asm_ref(register cl_index n) {
+	return bytecodes->vector.self.t[n];
+}
+
+/* ------------------------------ COMPILER ------------------------------ */
+
+typedef struct {
+  cl_object symbol;
+  const char *const name;
+  void (*compiler)(cl_object);
+} compiler_record;
+
+static compiler_record database[] = {
+  {OBJNULL, "AND", c_and},
+  {OBJNULL, "BLOCK", c_block},
+  {OBJNULL, "CASE", c_case},
+  {OBJNULL, "CATCH", c_catch},
+  {OBJNULL, "COND", c_cond},
+  {OBJNULL, "DO", c_do},
+  {OBJNULL, "DO*", c_doa},
+  {OBJNULL, "DOLIST", c_dolist},
+  {OBJNULL, "DOTIMES", c_dotimes},
+  {OBJNULL, "EVAL-WHEN", c_eval_when},
+  {OBJNULL, "FLET", c_flet},
+  {OBJNULL, "FUNCTION", c_function},
+  {OBJNULL, "GO", c_go},
+  {OBJNULL, "IF", c_if},
+  {OBJNULL, "LABELS", c_labels},
+  {OBJNULL, "LET", c_let},
+  {OBJNULL, "LET*", c_leta},
+  {OBJNULL, "MACROLET", c_macrolet},
+  {OBJNULL, "MULTIPLE-VALUE-BIND", c_multiple_value_bind},
+  {OBJNULL, "MULTIPLE-VALUE-CALL", c_multiple_value_call},
+  {OBJNULL, "MULTIPLE-VALUE-PROG1", c_multiple_value_prog1},
+  {OBJNULL, "MULTIPLE-VALUE-SETQ", c_multiple_value_setq},
+  {OBJNULL, "NTH-VALUE", c_nth_value},
+  {OBJNULL, "OR", c_or},
+  {OBJNULL, "PROGN", compile_body},
+  {OBJNULL, "PROGV", c_progv},
+  {OBJNULL, "PSETQ", c_psetq},
+  {OBJNULL, "RETURN", c_return},
+  {OBJNULL, "RETURN-FROM", c_return_from},
+  {OBJNULL, "SETQ", c_setq},
+  {OBJNULL, "TAGBODY", c_tagbody},
+  {OBJNULL, "THROW", c_throw},
+  {OBJNULL, "UNWIND-PROTECT", c_unwind_protect},
+  {OBJNULL, "UNLESS", c_unless},
+  {OBJNULL, "VALUES", c_values},
+  {OBJNULL, "WHEN", c_when},
+  {OBJNULL, "", c_when}
+};
+
+/* ----------------- LEXICAL ENVIRONMENT HANDLING -------------------- */
+
+static void
+c_register_var(register cl_object var, bool special)
+{
+	CAR(lex_env) = CONS(CONS(var, special? Sspecial : Cnil), CAR(lex_env));
+}
+
+static bool
+special_variablep(register cl_object var, register cl_object specials)
+{
+	return ((var->symbol.stype == stp_special) || member_eq(var, specials));
+}
+
+static void
+c_pbind(cl_object var, cl_object specials)
+{
+	if (!SYMBOLP(var))
+		FEerror("The object ~A is not a valid variable name", 1, var);
+	else if (special_variablep(var, specials)) {
+		c_register_var(var, TRUE);
+		asm_op(OP_PBINDS);
+	} else {
+		c_register_var(var, FALSE);
+		asm_op(OP_PBIND);
+	}
+	asm1(var);
+}
+
+static void
+c_bind(cl_object var, cl_object specials)
+{
+	if (!SYMBOLP(var))
+		FEerror("The object ~A is not a valid variable name", 1, var);
+	else if (special_variablep(var, specials)) {
+		c_register_var(var, TRUE);
+		asm_op(OP_BINDS);
+	} else {
+		c_register_var(var, FALSE);
+		asm_op(OP_BIND);
+	}
+	asm1(var);
+}
+
+static void
+compile_setq(int op, cl_object var)
+{
+	cl_object ndx;
+
+	if (!SYMBOLP(var))
+		FEerror("SETQ: ~A is not a symbol", 1, var);
+	ndx = lex_var_sch(var);
+	if (!Null(ndx) && CDR(ndx) != Sspecial)
+		asm_op(op); /* Lexical variable */
+	else if (var->symbol.stype == stp_constant)
+		FEerror("SETQ: Cannot change the value of the constant ~A", 1,var);
+	else if (op == OP_SETQ)
+		asm_op(OP_SETQS); /* Special variable */
+	else
+		asm_op(OP_PSETQS); /* Special variable */
+	asm1(var);
+}
+
+static void
+bind_tag(cl_object tag)
+{
+	CDR(lex_env) = CONS(list(3, tag, Stag, Cnil), CDR(lex_env));
+}
+
+static bool
+reference_tag(cl_object tag)
+{
+	cl_object l;
+	bool non_local = FALSE;
+
+	for (l = CDR(lex_env); !endp(l); l = CDR(l)) {
+		cl_object record = CAR(l);
+		if (ATOM(record))
+			non_local = TRUE;
+		else if (CAR(record) == Ct && CDR(record) == Cnil)
+			non_local = TRUE;
+		else if (eql(CAR(record), tag) && CADR(record) == Stag) {
+			cl_object mark;
+			if (non_local)
+				mark = Ct;
+			else
+				mark = MAKE_FIXNUM(current_pc());
+			CADDR(record) = nconc(CADDR(record), CONS(mark, Cnil));
+			return non_local;
+		}
+	}
+	FEerror("Reference to unknown tag ~S", 1, tag);
+}
+
+/* -------------------- THE COMPILER -------------------- */
+
+static void
+c_and(cl_object args) {
+	if (Null(args)) {
+		asm1(Ct);
+		return;
+	} else if (ATOM(args)) {
+		FEerror("Wrong type of argument to AND ~S", 1, args);
+	} else {
+		compile_form(pop(&args),FALSE);
+		if (!endp(args)) {
+			cl_index label = asm_jmp(OP_JNIL);
+			c_and(args);
+			asm_complete(OP_JNIL, label);
+		}
+	}
+}
+
+/*
+	The OP_BLOCK operator encloses several forms within a block
+	named BLOCK_NAME, thus catching any OP_RETFROM whose argument
+	matches BLOCK_NAME. The end of this block is marked both by
+	the OP_EXIT operator and the LABELZ which is packed within
+	the OP_BLOCK operator.
+	
+		[OP_BLOCK + labelz]
+		block_name
+		....
+		OP_EXIT
+	labelz:	...
+*/
+
+static void
+c_block(cl_object body) {
+	cl_object name = pop(&body);
+	cl_index labelz = asm_jmp(OP_BLOCK);
+	if (!SYMBOLP(name))
+		FEerror("Not a valid BLOCK name: ~S", 1, name);
+	asm1(name);
+	compile_body(body);
+	asm_op(OP_EXIT);
+	asm_complete(OP_BLOCK, labelz);
+}
+
+/*
+	There are several ways to invoke functions and to handle the
+	output arguments. These are
+
+		[OP_CALL + nargs]
+		function_name
+
+		[OP_PCALL + nargs]
+		function_name
+
+		[OP_FCALL + nargs]
+
+		[OP_PFCALL + nargs]
+
+	 OP_CALL and OP_FCALL leave all arguments in the VALUES() array,
+	 while OP_PCALL and OP_PFCALL leave the first argument in the
+	 stack.
+
+	 OP_CALL and OP_PCALL use the following symbol to retrieve the
+	 function, while OP_FCALL and OP_PFCALL use the value in VALUES(0).
+ */
+static void
+c_call(cl_object args, bool push) {
+	cl_object name;
+	cl_index nargs;
+
+	name = pop(&args);
+	for (nargs = 0; !endp(args); nargs++) {
+		compile_form(pop(&args),TRUE);
+	}
+	if (ATOM(name)) {
+		asm_op2(push? OP_PCALL : OP_CALL, nargs);
+		asm1(name);
+	} else if (CAR(name) == Slambda) {
+		asm_op(OP_CLOSE);
+		asm1(make_lambda(Cnil, CDR(name)));
+		asm_op2(push? OP_PFCALL : OP_FCALL, nargs);
+	} else {
+		cl_object aux = setf_namep(name);
+		if (aux == OBJNULL)
+			FEerror("Invalid function name ~S", 1, name);
+		asm_op2(push? OP_PCALL : OP_CALL, nargs);
+		asm1(aux);
+	}
+}
+
+static void
+perform_c_case(cl_object args) {
+	cl_object test, clause, conseq;
+	cl_fixnum label1, label2;
+
+	if (Null(args)) {
+		asm_op(OP_NOP);
+		return;
+	}
+
+	clause = pop(&args);
+	if (ATOM(clause))
+		FEerror("~S is an illegal CASE clause.",1,clause);
+	test = pop(&clause);
+	if (Sotherwise == test || test == Ct) {
+		compile_body(clause);
+	} else {
+		cl_index labeln, labelz;
+		if (CONSP(test)) {
+			cl_index n = length(test);
+			while (n > 1) {
+				cl_object v = pop(&test);
+				cl_fixnum jump = (n--) * 2;
+				asm_op2(OP_JEQ, jump);
+				asm1(v);
+			}
+			test = CAR(test);
+		}
+		labeln = asm_jmp(OP_JNEQ);
+		asm1(test);
+		compile_body(clause);
+		labelz = asm_jmp(OP_JMP);
+		asm_complete(OP_JNEQ, labeln);
+		perform_c_case(args);
+		asm_complete(OP_JMP, labelz);
+	}
+}
+
+static void
+c_case(cl_object clause) {
+	compile_form(pop(&clause), FALSE);
+	perform_c_case(clause);
+}
+
+/*
+	The OP_CATCH takes the object in VALUES(0) and uses it to catch
+	any OP_THROW operation which uses that value as argument. If a
+	catch occurs, or when all forms have been properly executed, it
+	jumps to LABELZ. LABELZ is packed within the OP_CATCH operator.
+		[OP_CATCH + labelz]
+		...
+		"forms to be caught"
+		...
+	       	OP_EXIT
+	labelz:	...
+*/
+
+static void
+c_catch(cl_object args) {
+	cl_index labelz;
+
+	/* Compile evaluation of tag */
+	compile_form(pop(&args), FALSE);
+
+	/* Compile jump point */
+	labelz = asm_jmp(OP_CATCH);
+
+	/* Compile body of CATCH */
+	compile_body(args);
+	asm_op(OP_EXIT);
+	asm_complete(OP_CATCH, labelz);
+}
+
+/*
+	There are three operators which perform explicit jumps, but
+	almost all other operators use labels in one way or
+	another.
+
+	1) Jumps are always relative to the place where the jump label
+	is retrieved so that if the label is in vector[0], then the
+	destination is roughly vector + vector[0].
+
+	2) There are two types of labels, "packed labels" and "simple
+	labels". The first ones are packed in the upper bits of an
+	operator so that
+		destination = vector + vector[0]>>16
+	Simple labels take the whole word and thus
+		destination = vector + fix(vector[0])
+
+	3) The three jump forms are
+
+		[OP_JMP + label]	; Unconditional jump
+		[OP_JNIL + label]	; Jump if VALUES(0) == Cnil
+		[OP_JT + label]		; Jump if VALUES(0) != Cnil
+
+	It is important to remark that both OP_JNIL and OP_JT truncate
+	the values stack, so that always NValues = 1 after performing
+	any of these operations.
+*/
+static void
+c_cond(cl_object args) {
+	cl_object test, clause, conseq;
+	cl_fixnum label_nil, label_exit;
+
+	clause = pop(&args);
+	if (ATOM(clause))
+		FEerror("~S is an illegal COND clause.",1,clause);
+	test = pop(&clause);
+	if (Ct == test) {
+		/* Default sentence. If no forms, just output T. */
+		if (Null(clause))
+			compile_form(Ct, FALSE);
+		else
+			compile_body(clause);
+	} else {
+		/* Compile the test. If no more forms, just output
+		   the first value (this is guaranteed by OP_JNIL */
+		compile_form(test, FALSE);
+		label_nil = asm_jmp(OP_JNIL);
+		if (!Null(clause))
+			compile_body(clause);
+		if (Null(args))
+			asm_complete(OP_JNIL, label_nil);
+		else {
+			label_exit = asm_jmp(OP_JMP);
+			asm_complete(OP_JNIL, label_nil);
+			c_cond(args);
+			asm_complete(OP_JMP, label_exit);
+		}
+	}
+}
+
+/*	The OP_DO operator saves the lexical environment and establishes
+	a NIL block to execute the enclosed forms, which are typically
+	like the ones shown below. At the exit of the block, either by
+	means of a OP_RETFROM jump or because of normal termination,
+	the lexical environment is restored, and all bindings undone.
+
+		[OP_DO + labelz]
+		labelz
+		...	; bindings
+	labelb:	...	; body
+		...	; stepping forms
+	labelt:	...	; test form
+		[JNIL + label]
+		...	; output form
+		OP_EXIT
+	labelz:
+
+*/
+static void
+c_do_doa(int op, cl_object args) {
+	cl_object bindings, test, specials, body, l;
+	cl_object stepping = Cnil, vars = Cnil;
+	cl_index labelb, labelt, labelz;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	bindings = pop(&args);
+	test = pop(&args);
+
+	siLprocess_declarations(1, args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	labelz = asm_jmp(OP_DO);
+
+	/* Compile initial bindings */
+	if (length(bindings) == 1)
+		op = OP_BIND;
+	for (l=bindings; !endp(l); ) {
+		cl_object aux = pop(&l);
+		cl_object var, value;
+		if (ATOM(aux)) {
+			var = aux;
+			value = Cnil;
+		} else {
+			var = pop(&aux);
+			value = pop_maybe_nil(&aux);
+			if (!endp(aux))
+				stepping = CONS(CONS(var,pop(&aux)),stepping);
+			if (!Null(aux))
+				FEerror("Not a valid argument to LET ~S.", 1,
+					args);
+		}
+		if (!SYMBOLP(var))
+			FEerror("Cannot bind ~S.", 1, var);
+		if (op == OP_PBIND) {
+			compile_form(value, TRUE);
+			vars = CONS(var, vars);
+		} else {
+			compile_form(value, FALSE);
+			c_bind(var, specials);
+		}
+	}
+	while (!endp(vars))
+		c_pbind(pop(&vars), specials);
+
+	/* Jump to test */
+	labelt = asm_jmp(OP_JMP);
+
+	/* Compile body */
+	labelb = current_pc();
+	c_tagbody(body);
+
+	/* Compile stepping clauses */
+	if (length(stepping) == 1)
+		op = OP_BIND;
+	for (vars = Cnil, stepping=nreverse(stepping); !endp(stepping); ) {
+		cl_object pair = pop(&stepping);
+		cl_object var = CAR(pair);
+		cl_object value = CDR(pair);
+		if (op == OP_PBIND) {
+			compile_form(value, TRUE);
+			vars = CONS(var, vars);
+		} else {
+			compile_form(value, FALSE);
+			compile_setq(OP_SETQ, var);
+		}
+	}
+	while (!endp(vars))
+		compile_setq(OP_PSETQ, pop(&vars));
+
+	/* Compile test */
+	asm_complete(OP_JMP, labelt);
+	compile_form(pop(&test), FALSE);
+	asm_op2(OP_JNIL, labelb - current_pc());
+
+	/* Compile output clauses */
+	compile_body(test);
+	asm_op(OP_EXIT);
+
+	/* Compile return point of block */
+	asm_complete(OP_DO, labelz);
+
+	lex_env = lex_old;
+}
+
+
+static void
+c_doa(cl_object args) {
+	c_do_doa(OP_BIND, args);
+}
+
+static void
+c_do(cl_object args) {
+	c_do_doa(OP_PBIND, args);
+}
+
+/*
+	The OP_DOLIST & OP_DOTIMES operators save the lexical
+	environment and establishes a NIL block to execute the
+	enclosed forms, which iterate over the elements in a list or
+	over a range of integer numbers. At the exit of the block,
+	either by means of a OP_RETFROM jump or because of normal
+	termination, the lexical environment is restored, and all
+	bindings undone.
+
+		[OP_DOTIMES/OP_DOLIST + labelz]
+		...	; bindings
+		[OP_EXIT + labelo]
+		...	; body
+		...	; stepping forms
+		OP_EXIT
+	labelo:	...	; output form
+		OP_EXIT
+	labelz:
+
+ */
+
+static void
+c_dolist_dotimes(int op, cl_object args) {
+	cl_object head = pop(&args);
+	cl_object var = pop(&head);
+	cl_object list = pop(&head);
+	cl_object specials, body;
+	cl_index labelz, labelo;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	siLprocess_declarations(1, args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	if (!SYMBOLP(var))
+		FEerror("Cannot bind to ~S", 1, var);
+
+	/* Compute list and enter loop */
+	compile_form(list, FALSE);
+	labelz = asm_jmp(op);
+
+	/* Initialize the variable */
+	compile_form((op == OP_DOLIST)? Cnil : MAKE_FIXNUM(0), FALSE);
+	c_bind(var, specials);
+	labelo = asm_jmp(OP_EXIT);
+
+	/* Variable assignment and iterated body */
+	compile_setq(OP_SETQ, var);
+	c_tagbody(body);
+	asm_op(OP_EXIT);
+
+	/* Output */
+	asm_complete(OP_EXIT, labelo);
+	if (CDR(head) != Cnil)
+		FEerror("Too many arguments to output form of DOLIST", 0);
+	if (Null(head))
+		compile_body(Cnil);
+	else {
+		compile_setq(OP_SETQ, var);
+		compile_form(pop(&head), FALSE);
+	}
+	asm_op(OP_EXIT);
+
+	/* Exit point for block */
+	asm_complete(op, labelz);
+
+	lex_env = lex_old;
+}
+
+
+static void
+c_dolist(cl_object args) {
+	c_dolist_dotimes(OP_DOLIST, args);
+}
+
+static void
+c_dotimes(cl_object args) {
+	c_dolist_dotimes(OP_DOTIMES, args);
+}
+
+static void
+c_eval_when(cl_object args) {
+	cl_object situation = pop(&args);
+
+	if (member_eq(Seval, situation) || member_eq(Kexecute, situation))
+		compile_body(args);
+	else
+		compile_body(Cnil);
+}
+
+
+/*
+	The OP_FLET/OP_FLABELS operators change the lexical environment
+	to add a few local functions.
+
+		[OP_FLET/OP_FLABELS + nfun]
+		fun1
+		...
+		funn
+		...
+		OP_EXIT
+	labelz:
+*/
+static void
+c_labels_flet(int op, cl_object args) {
+	cl_object def_list = pop(&args);
+	int nfun = length(def_list);
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	if (nfun == 0) {
+		compile_body(args);
+		return;
+	}
+	asm_op2(op, nfun);
+	do {
+		cl_object definition = pop(&def_list);
+		cl_object name = pop(&definition);
+		asm1(make_lambda(name, definition));
+	} while (!endp(def_list));
+	compile_body(args);
+	asm_op(OP_EXIT);
+
+	lex_env = lex_old;
+}
+
+
+static void
+c_flet(cl_object args) {
+	c_labels_flet(OP_FLET, args);
+}
+
+
+/*
+	There are two operators that produce functions. The first one
+	is
+		OP_FUNCTION
+		symbol
+	which takes the function binding of SYMBOL. The second one is
+		OP_CLOSE
+		interpreted
+	which encloses the INTERPRETED function in the current lexical
+	environment.
+*/
+static void
+c_function(cl_object args) {
+	cl_object function = pop(&args);
+	if (!endp(args))
+		FEerror("Too many arguments to FUNCTION", 0);
+	if (SYMBOLP(function)) {
+		asm_op(OP_FUNCTION);
+		asm1(function);
+	} else if (CONSP(function) && CAR(function) == Slambda) {
+		asm_op(OP_CLOSE);
+		asm1(make_lambda(Cnil, CDR(function)));
+	} else if (CONSP(function) && CAR(function) == siSlambda_block) {
+		cl_object name = CADR(function);
+		cl_object body = CDDR(function);
+		asm_op(OP_CLOSE);
+		asm1(make_lambda(name, body));
+	} else
+		FEerror("No a valid argument to FUNCTION ~S", 1, function);
+}
+
+
+static void
+c_go(cl_object args) {
+	cl_object tag = pop(&args);
+	if (!Null(args))
+		FEerror("Too many arguments to GO",0);
+	if (!reference_tag(tag))
+		asm_op(OP_JMP);		/* Local tag */
+	else {
+		asm_op(OP_GO);		/* Tagbody out of closure */
+		asm1(tag);
+	}
+}
+
+
+/*
+	To get an idea of what goes on
+
+		...		; test form
+		JNIL	labeln
+		...		; form for true case
+		JMP	labelz
+		...		; form fro nil case
+	labelz:
+*/
+static void
+c_if(cl_object form) {
+	cl_fixnum label_nil, label_true;
+
+	/* Compile test */
+	compile_form(pop(&form), FALSE);
+	label_nil = asm_jmp(OP_JNIL);
+
+	/* Compile THEN clause */
+	compile_form(pop(&form), FALSE);
+	label_true = asm_jmp(OP_JMP);
+
+	/* Compile ELSE clause */
+	asm_complete(OP_JNIL, label_nil);
+	if (!endp(form))
+		compile_form(pop(&form), FALSE);
+	asm_complete(OP_JMP, label_true);
+
+	if (!Null(form))
+		FEerror("Too many arguments to IF form", 0);
+}
+
+
+static void
+c_labels(cl_object args) {
+	c_labels_flet(OP_LABELS, args);
+}
+
+
+/*
+	The OP_PUSHENV saves the current lexical environment to allow
+	several bindings.
+		OP_PUSHENV
+		...		; binding forms
+		...		; body
+		OP_EXIT
+
+	There are four forms which perform bindings
+		OP_PBIND	; Bind NAME in the lexical env. using
+		name		; a value from the stack
+		OP_PBINDS	; Bind NAME as special variable using
+		name		; a value from the stack
+		OP_BIND		; Bind NAME in the lexical env. using
+		name		; VALUES(0)
+		OP_BINDS	; Bind NAME as special variable using
+		name		; VALUES(0)
+
+	After a variable has been bound, there are several ways to
+	refer to it.
+
+	1) Refer to the n-th variable in the lexical environment
+		[SYMVAL + n]
+
+	2) Refer to the value of a special variable or constant
+		SYMVALS
+		name
+
+        3) Push the value of the n-th variable of the lexical environment
+		[PUSHV + n]
+
+	4) Push the value of a special variable or constant
+		PUSHVS
+		name
+*/
+
+static void
+c_let_leta(int op, cl_object args) {
+	cl_object bindings, specials, body, l, vars;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	bindings = car(args);
+	siLprocess_declarations(1, CDR(args));
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	/* Optimize some common cases */
+	switch(length(bindings)) {
+	case 0:		compile_body(body); return;
+	case 1:		op = OP_BIND; break;
+	default:
+	}
+
+	asm_op(OP_PUSHENV);
+	for (vars=Cnil, l=bindings; !endp(l); ) {
+		cl_object aux = pop(&l);
+		cl_object var, value;
+		if (ATOM(aux)) {
+			var = aux;
+			value = Cnil;
+		} else {
+			var = pop(&aux);
+			value = pop_maybe_nil(&aux);
+			if (!Null(aux))
+				FEerror("Not a valid argument to LET ~S.", 1,
+					args);
+		}
+		if (!SYMBOLP(var))
+			FEerror("Cannot bind ~S.", 1, var);
+		if (op == OP_PBIND) {
+			compile_form(value, TRUE);
+			vars = CONS(var, vars);
+		} else {
+			compile_form(value, FALSE);
+			c_bind(var, specials);
+		}
+	}
+	while (!endp(vars))
+		c_pbind(pop(&vars), specials);
+	compile_body(body);
+	asm_op(OP_EXIT);
+
+	lex_env = lex_old;
+}
+
+static void
+c_let(cl_object args) {
+	c_let_leta(OP_PBIND, args);
+}
+
+static void
+c_leta(cl_object args) {
+	c_let_leta(OP_BIND, args);
+}
+
+/*
+	MACROLET
+
+	The current lexical environment is saved. A new one is prepared with
+	the definitions of these macros, and this environment is used to
+	compile the body.
+ */
+static void
+c_macrolet(cl_object args)
+{
+	cl_object def_list, def, name;
+	int nfun = 0;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	/* Pop the list of definitions */
+	for (def_list = pop(&args); !endp(def_list); ) {
+		cl_object definition = pop(&def_list);
+		cl_object name = pop(&definition);
+		cl_object arglist = pop(&definition);
+		cl_object macro, function;
+		macro = funcall(4, siSexpand_defmacro, name, arglist,
+				definition);
+		function = make_lambda(name, CDR(macro));
+		lex_macro_bind(name, function);
+	}
+	compile_body(args);
+	lex_env = lex_old;
+}	
+
+
+static void
+c_multiple_value_bind(cl_object args)
+{
+	cl_object vars, value, body, specials;
+	cl_index save_pc, n;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	vars = pop(&args);
+	value = pop(&args);
+	siLprocess_declarations(1,args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	compile_form(value, FALSE);
+	n = length(vars);
+	if (n == 0) {
+		compile_body(body);
+	} else {
+		asm_op(OP_PUSHENV);
+		asm_op2(OP_MBIND, n);
+		for (vars=reverse(vars); n; n--){
+			cl_object var = pop(&vars);
+			if (!SYMBOLP(var))
+				FEerror("Cannot bind ~S.", 1, var);
+			if (special_variablep(var, specials)) {
+				asm1(MAKE_FIXNUM(1));
+				c_register_var(var, TRUE);
+			} else
+				c_register_var(var, FALSE);
+			asm1(var);
+		}
+		compile_body(body);
+		asm_op(OP_EXIT);
+	}
+	lex_env = lex_old;
+}
+
+
+static void
+c_multiple_value_call(cl_object args) {
+	cl_object name;
+
+	name = pop(&args);
+	if (endp(args)) {
+		/* If no arguments, just use ordinary call */
+		c_call(list(1, name), FALSE);
+		return;
+	}
+	asm_op(OP_MCALL);
+	do {
+		compile_form(pop(&args), FALSE);
+		asm_op(OP_PUSHVALUES);
+	} while (!endp(args));
+	compile_form(name, FALSE);
+	asm_op(OP_EXIT);
+}
+
+
+static void
+c_multiple_value_prog1(cl_object args) {
+	compile_form(pop(&args), FALSE);
+	if (!endp(args)) {
+		asm_op(OP_MPROG1);
+		compile_body(args);
+		asm_op(OP_EXIT);
+	}
+}
+
+
+static void
+c_multiple_value_setq(cl_object args) {
+	cl_object orig_vars;
+	cl_object vars = Cnil;
+	cl_object temp_vars = Cnil;
+	cl_object late_assignment = Cnil;
+	cl_index nvars = 0;
+
+	/* Look for symbol macros, building the list of variables
+	   and the list of late assignments. */
+	for (orig_vars = reverse(pop(&args)); !endp(orig_vars); ) {
+		cl_object aux, v = pop(&orig_vars);
+		if (!SYMBOLP(v))
+			FEerror("Cannot bind ~S", 1, v);
+		v = macro_expand1(v, CDR(lex_env));
+		if (!SYMBOLP(v)) {
+			aux = v;
+			v = Lgensym(0);
+			temp_vars = CONS(v, temp_vars);
+			late_assignment = CONS(list(3, Ssetf, aux, v),
+					       late_assignment);
+		}
+		vars = CONS(v, vars);
+		nvars++;
+	}
+
+	if (!Null(temp_vars)) {
+		asm_op(OP_PUSHENV);
+		do {
+			compile_form(Cnil, FALSE);
+			c_bind(CAR(temp_vars), Cnil);
+			temp_vars = CDR(temp_vars);
+		} while (!Null(temp_vars));
+	}
+
+	/* Compile values */
+	compile_form(pop(&args), FALSE);
+	if (args != Cnil)
+		FEerror("Too many arguments to MULTIPLE-VALUE-SETQ",0);
+	if (nvars == 0)
+		/* No variables */
+		return;
+
+	/* Compile variables */
+	asm_op2(OP_MSETQ, nvars);
+	vars = reverse(vars);
+	while (nvars--) {
+		cl_object ndx, var = pop(&vars);
+		if (!SYMBOLP(var))
+			FEerror("MULTIPLE-VALUE-SETQ: ~A is not a symbol", 1, var);
+		ndx = lex_var_sch(var);
+		if (!Null(ndx) && CDR(ndx) != Sspecial)
+			asm1(var); /* Lexical variable */
+		else if (var->symbol.stype == stp_constant)
+			FEerror("MULTIPLE-VALUE-SETQ: Cannot change the value of the constant ~A", 1,var);
+		else {
+			asm1(MAKE_FIXNUM(1));
+			asm1(var);
+		}
+	}
+
+	/* Assign to symbol-macros */
+	if (!Null(late_assignment)) {
+		compile_body(late_assignment);
+		asm_op(OP_EXIT);
+	}
+}
+
+
+/*
+	The OP_NTHVAL operator moves a value from VALUES(ndx) to
+	VALUES(0). The index NDX is taken from the stack.
+
+		OP_NTHVAL
+*/
+static void
+c_nth_value(cl_object args) {
+	compile_form(pop(&args), TRUE);		/* INDEX */
+	compile_form(pop(&args), FALSE);	/* VALUES */
+	if (args != Cnil)
+		FEerror("Too many arguments to NTH-VALUE",0);
+	asm_op(OP_NTHVAL);
+}
+
+
+static void
+c_or(cl_object args) {
+	if (Null(args)) {
+		asm1(Cnil);
+		return;
+	} else if (ATOM(args)) {
+		FEerror("Wrong type of argument to AND ~S", 1, args);
+	} else {
+		compile_form(pop(&args), FALSE);
+		if (!endp(args)) {
+			cl_index label = asm_jmp(OP_JT);
+			c_or(args);
+			asm_complete(OP_JT, label);
+		}
+	}
+}
+
+
+/*
+	The OP_PROGV operator exectures a set of statements in a lexical
+	environment that has been extended with special variables. The
+	list of special variables is taken from the top of the stack,
+	while the list of values is in VALUES(0).
+
+		...		; list of variables
+		OP_PUSH
+		...		; list of values
+		OP_PROGV
+		...		; body of progv
+		OP_EXIT
+*/
+static void
+c_progv(cl_object args) {
+	cl_object vars = pop(&args);
+	cl_object values = pop(&args);
+
+	/* The list of variables is in the stack */
+	compile_form(vars, TRUE);
+
+	/* The list of values is in VALUES(0) */
+	compile_form(values, FALSE);
+
+	/* The body is interpreted within an extended lexical
+	   environment. However, as all the new variables are
+	   special, the compiler need not take care of them
+	*/
+	asm_op(OP_PROGV);
+	compile_body(args);
+	asm_op(OP_EXIT);
+}
+
+
+/*
+	There are four assignment operators. They are
+
+	1) Assign VALUES(0) to the lexical variable which occupies the
+	   N-th position
+		[OP_SETQ + n]
+
+	2) Assign VALUES(0) to the special variable NAME
+		OP_SETQS
+		name
+
+	3) Pop a value from the stack and assign it to the lexical
+	   variable in the N-th position.
+		[OP_PSETQ + n]
+
+	4) Pop a value from the stack and assign it to the special
+	   variable denoted by NAME
+		OP_PSETQS
+		name
+*/
+static void
+c_psetq(cl_object old_args) {
+	cl_object args = Cnil, vars = Cnil;
+	bool use_psetf = FALSE;
+	cl_index nvars = 0;
+
+	/* We have to make sure that non of the variables which
+	   are to be assigned is actually a symbol macro. If that
+	   is the case, we invoke (PSETF ...) to handle the
+	   macro expansions.
+	*/
+	while (!endp(old_args)) {
+		cl_object var = pop(&old_args);
+		cl_object value = pop(&old_args);
+		if (!SYMBOLP(var))
+			FEerror("Cannot assign to ~a", 1, var);
+		var = macro_expand1(var, CDR(lex_env));
+		if (!SYMBOLP(var))
+			use_psetf = TRUE;
+		args = CONS(var, CONS(value, args));
+		nvars++;
+	}
+	if (use_psetf) {
+		compile_form(CONS(Spsetf, args), FALSE);
+		return;
+	}
+	while (!endp(args)) {
+		cl_object var = pop(&args);
+		cl_object value = pop(&args);
+		vars = CONS(var, vars);
+		compile_form(value, TRUE);
+	}
+	while (!endp(vars))
+		compile_setq(OP_PSETQ, pop(&vars));
+}
+
+
+/*
+	The OP_RETFROM operator returns from a block using the objects
+	in VALUES() as output values.
+
+		...		; output form
+		OP_RETFROM
+		tag		; object which names the block
+*/
+static void
+c_return(cl_object stmt) {
+	cl_object output = pop_maybe_nil(&stmt);
+
+	compile_form(output, FALSE);
+	asm_op(OP_RETURN);
+	asm1(Cnil);
+	if (stmt != Cnil)
+		FEerror("Too many arguments to RETURN", 0);
+}
+
+
+static void
+c_return_from(cl_object stmt) {
+	cl_object name = pop(&stmt);
+	cl_object output = pop_maybe_nil(&stmt);
+
+	compile_form(output, FALSE);
+	asm_op(OP_RETURN);
+	if (!SYMBOLP(name))
+		FEerror("Not a valid return tag ~S", 1, name);
+	asm1(name);
+	if (stmt != Cnil)
+		FEerror("Too many arguments to RETURN-FROM", 0);
+}
+
+
+static void
+c_setq(cl_object args) {
+	while (!endp(args)) {
+		cl_object var = pop(&args);
+		cl_object value = pop(&args);
+		if (!SYMBOLP(var))
+			FEerror("Cannot bind ~S", 1, var);
+		var = macro_expand1(var, CDR(lex_env));
+		if (SYMBOLP(var)) {
+			compile_form(value, FALSE);
+			compile_setq(OP_SETQ, var);
+		} else {
+			compile_form(list(3, Ssetf, var, value), FALSE);
+		}
+	}
+}
+
+
+static void
+c_symbol_macrolet(cl_object args)
+{
+	cl_object def_list, def, name, specials, body;
+	cl_object lex_old = lex_env;
+	int nfun = 0;
+
+	/* Set a new lexical environment where we will bind
+	   our macrology */
+	lex_copy();
+
+	def_list = pop(&args);
+	siLprocess_declarations(1,args);
+	body = VALUES(1);
+	specials = VALUES(3);
+
+	/* Scan the list of definitions */
+	for (; !endp(def_list); ) {
+		cl_object definition = pop(&def_list);
+		cl_object name = pop(&definition);
+		cl_object expansion = pop(&definition);
+		cl_object arglist = list(2, Lgensym(0), Lgensym(0));
+		cl_object function;
+		if (special_variablep(name, specials))
+			FEerror("Symbol ~A cannot be declared special and appear in a SYMBOL-MACROLET", 1, name);
+		definition = list(2, arglist, list(2, Squote, expansion));
+		function = make_lambda(name, definition);
+		lex_symbol_macro_bind(name, function);
+	}
+	compile_body(body);
+	lex_env = lex_old;
+}
+
+static void
+c_tagbody(cl_object args)
+{
+	int i, nt;
+	cl_fixnum label0, labelz;
+	cl_object body, tag_list;
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	/* count and register the tags */
+	for (nt = 0, tag_list = Cnil, body = args; !endp(body); body = CDR(body)) {
+		cl_object form = CAR(body);
+		int type = type_of(form);
+		if (type == t_symbol || type == t_fixnum || type == t_bignum) {
+			tag_list = CONS(list(3, form, Stag, Cnil), tag_list);
+			nt += 1;
+		}
+	}
+	if (nt == 0) {
+		compile_body(args);
+		return;
+	}
+	label0 = current_pc();
+	CDR(lex_env) = nconc(nreverse(tag_list), CDR(lex_env));
+
+	/*
+	 * We compile the body, storing the address of each label.
+	 */
+	for (tag_list = CDR(lex_env), body = args; !endp(body); body = CDR(body)) {
+		cl_object form = CAR(body);
+		int type = type_of(form);
+		if (type == t_symbol || type == t_fixnum || type == t_bignum) {
+			/* Each label points to a place in the bytecodes
+			   stack. This point is registered at the beginning of
+			   the tag list. */
+			cl_object pc = MAKE_FIXNUM(current_pc());
+			cl_object tag = CAR(tag_list);
+			cl_object relocation = CADDR(tag);
+			CADDR(tag) = CONS(pc, relocation);
+			tag_list = CDR(tag_list);
+		} else if (CONSP(form)) {
+			/* Since the output of all forms is ignored, we
+			   need only compile forms which are not atoms */
+			compile_form(form, FALSE);
+		}
+	}
+	/*
+	 * Each (GO ...) form leads to either a local jump, or a jump
+	 * out of a closure. In this loop we fix the destination of those
+	 * local jumps...
+	 */
+	for (i = 0, tag_list = Cnil; nt; nt--, CDR(lex_env) = CDDR(lex_env)) {
+		cl_object tag = CADR(lex_env);
+		cl_object tag_name = CAR(tag);
+		cl_object relocation = CADDR(tag);
+		cl_fixnum pc = fix(pop(&relocation));
+		while (!endp(relocation)) {
+			cl_object jump = pop(&relocation);
+			if (FIXNUMP(jump)) {
+				cl_fixnum pc_orig = fix(jump);
+				asm_at(pc_orig, make_op2(OP_JMP, pc - pc_orig));
+				continue;
+			}
+			tag_list = nconc(tag_list,
+					 list(2, tag_name, MAKE_FIXNUM(pc)));
+			i++;
+		}
+	}
+	/*
+	 * ...and in this loop we keep a record of the tags that were
+	 * referenced by nonlocal jumps. This implies inserting an OP_TAGBODY
+	 * operand with its relocation table at LABEL0.
+	 */
+	if (!i)
+		compile_body(Cnil);
+	else {
+		cl_fixnum delta = 1 + 2*i;
+		cl_fixnum label;
+		asm_op(OP_EXIT);
+		asm_insert(label0, make_op2(OP_TAGBODY, i));
+		while (!endp(tag_list)) {
+			cl_object name = pop(&tag_list);
+			cl_fixnum pc = fix(pop(&tag_list)) + delta;
+			asm_insert(label0, name); label0++;
+			asm_insert(label0, MAKE_FIXNUM(pc - label0)); label0++;
+		}
+	}
+}
+
+
+/*
+	The OP_THROW jumps to an enclosing OP_CATCH whose tag
+	matches the one of the throw. The tag is taken from the
+	stack, while the output values are left in VALUES().
+*/
+static void
+c_throw(cl_object stmt) {
+	/* FIXME! Do we apply the right protocol here? */
+	cl_object tag = pop(&stmt);
+	cl_object form = pop(&stmt);
+	if (stmt != Cnil)
+		FEerror("Too many argumnents to THROW",0);
+	compile_form(tag, TRUE);
+	compile_form(form, FALSE);
+	asm_op(OP_THROW);
+}
+
+
+static void
+c_unless(cl_object form) {
+	cl_fixnum label_true, label_false;
+
+	/* Compile test */
+	compile_form(pop(&form), FALSE);
+	label_true = asm_jmp(OP_JT);
+
+	/* Compile body */
+	compile_body(form);
+	label_false = asm_jmp(OP_JMP);
+	asm_complete(OP_JT, label_true);
+
+	/* When test failed, output NIL */
+	asm1(Cnil);
+	asm_complete(OP_JMP, label_false);
+}
+
+
+static void
+c_unwind_protect(cl_object args) {
+	cl_index label = asm_jmp(OP_UNWIND);
+
+	/* Compile form to be protected */
+	compile_form(pop(&args), FALSE);
+	asm_op(OP_EXIT);
+
+	/* Compile exit clause */
+	asm_complete(OP_UNWIND, label);
+	compile_body(args);
+	asm_op(OP_EXIT);
+}
+
+
+/*
+	The OP_VALUES moves N values from the stack to VALUES().
+
+		[OP_VALUES + n]
+*/
+static void
+c_values(cl_object args) {
+	int n = 0;
+
+	while (!endp(args)) {
+		compile_form(pop_maybe_nil(&args), TRUE);
+		n++;
+	}
+	asm_op2(OP_VALUES, n);
+}
+
+
+static void
+c_when(cl_object form) {
+	cl_fixnum label;
+
+	/* Compile test */
+	compile_form(pop(&form), FALSE);
+	label = asm_jmp(OP_JNIL);
+
+	/* Compile body */
+	compile_body(form);
+	asm_complete(OP_JNIL, label);
+}
+
+
+static void
+compile_form(cl_object stmt, bool push) {
+	compiler_record *l;
+	cl_object function;
+	cl_object macro;
+
+	/* FIXME! We should protect this region with error handling */
+ BEGIN:
+	/*
+	 * First try with variable references and quoted constants
+	 */
+	if (ATOM(stmt)) {
+		if (SYMBOLP(stmt)) {
+			if (push) asm_op(OP_PUSHV);
+			asm1(stmt);
+			goto OUTPUT;
+		}
+	QUOTED:
+		if (push)
+			asm_op(OP_PUSHQ);
+		else if (FIXNUMP(stmt) || SYMBOLP(stmt))
+			asm_op(OP_QUOTE);
+		asm1(stmt);
+		goto OUTPUT;
+	}
+ LIST:
+	/*
+	 * Next try with special forms.
+	 */
+	function = CAR(stmt);
+	if (!SYMBOLP(function))
+		goto ORDINARY_CALL;
+	if (function == Squote) {
+		stmt = CDR(stmt);
+		if (CDR(stmt) != Cnil)
+			FEerror("Too many arguments to QUOTE",0);
+		stmt = CAR(stmt);
+		goto QUOTED;
+	}
+	for (l = database; l->symbol != OBJNULL; l++)
+		if (l->symbol == function) {
+			(*(l->compiler))(CDR(stmt));
+			if (push) asm_op(OP_PUSH);
+			goto OUTPUT;
+		}
+	/*
+	 * Next try to macroexpand
+	 */
+	{
+		cl_object new_stmt = macro_expand1(stmt, CDR(lex_env));
+		if (new_stmt != stmt){
+			stmt = new_stmt;
+			goto BEGIN;
+		}
+	}
+	if (function->symbol.isform)
+		FEerror("Found no macroexpander for special form ~S", 1, function);
+ ORDINARY_CALL:
+	/*
+	 * Finally resort to ordinary function calls.
+	 */
+	c_call(stmt, push);
+ OUTPUT:
+}
+
+
+static void
+compile_body(cl_object body) {
+	if (endp(body))
+		asm_op(OP_NOP);
+	else do {
+		compile_form(CAR(body), FALSE);
+		body = CDR(body);
+	} while (!endp(body));
+}
+
+/* ----------------------------- PUBLIC INTERFACE ---------------------------- */
+
+/* ------------------------------------------------------------
+   LAMBDA OBJECTS: An interpreted function is a vector made of
+	the following components
+
+      #(LAMBDA
+	{block-name | NIL}
+	{variable-env | NIL}
+	{function-env | NIL}
+	{block-env | NIL}
+	(list of variables declared special)
+	Nreq {var}*			; required arguments
+	Nopt {var value flag}*		; optional arguments
+	{rest-var NIL}			; rest variable
+	{T | NIL}			; allow other keys?
+	Nkey {key var value flag}*	; keyword arguments
+	Naux {var init}			; auxiliary variables
+	documentation-string
+	list-of-declarations
+	{form}*				; body)
+
+   ------------------------------------------------------------ */
+
+#define push(v,l) l = CONS(v, l)
+#define push_var(v, list) \
+	check_symbol(v); \
+	if (v->symbol.stype == stp_constant) \
+		FEerror("~S is not a variable.", 1, v); \
+	push(v, list);
+
+/*
+  Handles special declarations, removes declarations from body
+ */
+@(defun si::process_declarations (body &optional doc)
+	cl_object documentation = Cnil, declarations = Cnil, form, specials = Cnil;
+	cl_object decls, vars, v;
+@
+	/* BEGIN: SEARCH DECLARE */
+	for (; !endp(body); body = CDR(body)) {
+	  form = CAR(body);
+
+	  if (!Null(doc) && type_of(form) == t_string) {
+	    if (documentation == Cnil)
+	      documentation = form;
+	    else
+	      break;
+	    continue;
+	  }
+
+	  if (ATOM(form) || (CAR(form) != Sdeclare))
+	    break;
+
+	  for (decls = CDR(form); !endp(decls); decls = CDR(decls)) {
+	    cl_object sentence = CAR(decls);
+	    if (ATOM(sentence))
+	      FEerror("Illegal declaration form", 1, form);
+	    push(sentence, declarations);
+	    if (CAR(sentence) == Sspecial)
+	      for (vars = CDR(sentence); !endp(vars); vars = CDR(vars)) {
+		v = CAR(vars);
+		check_symbol(v);
+		push(v,specials);
+	      }
+	  }
+	}
+	/* END: SEARCH DECLARE */
+
+	@(return declarations body documentation specials)
+@)
+
+@(defun si::process_lambda_list (lambda)
+	cl_object documentation, declarations, specials;
+	cl_object lambda_list, body, form;
+	cl_object x, v, key, init, spp;
+	cl_object reqs = Cnil, opts = Cnil, keys = Cnil, rest = Cnil, auxs = Cnil;
+	int nreq = 0, nopt = 0, nkey = 0, naux = 0;
+	cl_object allow_other_keys = Cnil;
+@
+	bds_check;
+	if (ATOM(lambda))
+		FEerror("No lambda list.", 0);
+	lambda_list = CAR(lambda);
+
+	declarations = siLprocess_declarations(2, CDR(lambda), Ct);
+	body = VALUES(1);
+	documentation = VALUES(2);
+	specials = VALUES(3);
+
+REQUIRED:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		v = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		if (v == SAallow_other_keys)
+			goto ILLEGAL_LAMBDA;
+		if (v == SAoptional)
+			goto OPTIONAL;
+		if (v == SArest)
+			goto REST;
+		if (v == SAkey)
+			goto KEYWORD;
+		if (v == SAaux)
+			goto AUX;
+		nreq++;
+		push_var(v, reqs);
+	}
+OPTIONAL:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		x = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		spp = Cnil;
+		init = Cnil;
+		if (ATOM(x)) {
+			if (x == SAoptional || x == SAallow_other_keys)
+				goto ILLEGAL_LAMBDA;
+			if (x == SArest)
+				goto REST;
+			if (x == SAkey)
+				goto KEYWORD;
+			if (x == SAaux)
+				goto AUX;
+			v = x;
+		} else {
+			v = CAR(x);
+			if (!endp(x = CDR(x))) {
+				init = CAR(x);
+				if (!endp(x = CDR(x))) {
+					spp = CAR(x);
+					if (!endp(CDR(x)))
+						goto ILLEGAL_LAMBDA;
+				}
+			}
+		}
+		nopt++;
+		push_var(v, opts);
+		push(init, opts);
+		if (spp != Cnil) {
+			push_var(spp, opts);
+		} else {
+			push(Cnil, opts);
+		}
+	}
+
+REST:
+	if (endp(lambda_list))
+		goto ILLEGAL_LAMBDA;
+	v = CAR(lambda_list);
+	push_var(v, rest);
+
+	lambda_list = CDR(lambda_list);
+	if (endp(lambda_list))
+		goto OUTPUT;
+	v = CAR(lambda_list);
+	lambda_list = CDR(lambda_list);
+	if (v == SAoptional || v == SArest || v == SAallow_other_keys)
+		goto ILLEGAL_LAMBDA;
+	if (v == SAkey)
+		goto KEYWORD;
+	if (v == SAaux)
+		goto AUX;
+	goto ILLEGAL_LAMBDA;
+
+KEYWORD:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		init = Cnil;
+		spp = Cnil;
+		x = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		if (ATOM(x)) {
+			if (x == SAallow_other_keys) {
+				if (!Null(allow_other_keys))
+					goto ILLEGAL_LAMBDA;
+				allow_other_keys = Ct;
+				if (endp(lambda_list))
+					goto OUTPUT;
+				x = CAR(lambda_list);
+				lambda_list = CDR(lambda_list);
+				if (key != SAaux)
+					goto ILLEGAL_LAMBDA;
+				goto AUX;
+			} else if (x == SAoptional || x == SArest || x == SAkey)
+				goto ILLEGAL_LAMBDA;
+			else if (x == SAaux)
+				goto AUX;
+			v = x;
+		} else {
+			v = CAR(x);
+			if (!endp(x = CDR(x))) {
+				init = CAR(x);
+				if (!endp(x = CDR(x))) {
+					spp = CAR(x);
+					if (!endp(CDR(x)))
+						goto ILLEGAL_LAMBDA;
+				}
+			}
+		}
+		if (CONSP(v)) {
+			x = v;
+			key = CAR(x);
+			if (key->symbol.hpack != keyword_package)
+				FEerror("~S is not a keyword", 1, key);
+			if (endp(CDR(x)) || !endp(CDDR(x)))
+				goto ILLEGAL_LAMBDA;
+			v = CADR(x);
+		} else {
+			check_symbol(v);
+			key = intern(v->symbol.name, keyword_package);
+		}
+		nkey++;
+		push(key, keys);
+		push_var(v, keys);
+		push(init, keys);
+		if (Null(spp)) {
+			push(Cnil, keys);
+		} else {
+			push_var(spp, keys);
+		}
+	}
+
+AUX:
+	while (1) {
+		if (endp(lambda_list))
+			goto OUTPUT;
+		x = CAR(lambda_list);
+		lambda_list = CDR(lambda_list);
+		if (ATOM(x)) {
+			if (x == SAoptional || x == SArest ||
+			    x == SAkey || x == SAallow_other_keys ||
+			    x == SAaux)
+				goto ILLEGAL_LAMBDA;
+			v = x;
+			init = Cnil;
+		} else if (endp(CDDR(x))) {
+			v = CAR(x);
+			init = CADR(x);
+		} else
+			goto ILLEGAL_LAMBDA;
+		naux++;
+		push_var(v, auxs);
+		push(init, auxs);
+	}
+
+OUTPUT:
+	@(return CONS(MAKE_FIXNUM(nreq), nreverse(reqs))
+		 CONS(MAKE_FIXNUM(nopt), nreverse(opts))
+		 nreverse(rest)
+		 allow_other_keys
+		 CONS(MAKE_FIXNUM(nkey), nreverse(keys))
+		 nreverse(auxs)
+		 documentation
+		 specials
+		 declarations
+		 body)
+
+ILLEGAL_LAMBDA:
+	FEerror("Illegal lambda list ~S.", 1, CAR(lambda));
+@)
+
+static void
+c_default(cl_index deflt_pc) {
+	cl_object deflt = asm_ref(deflt_pc);
+	enum cl_type t = type_of(deflt);
+	if ((t == t_symbol) && (deflt->symbol.stype == stp_constant))
+		/* FIXME! Shouldn't this happen only in unsafe mode */
+		asm_at(deflt_pc, SYM_VAL(deflt));
+	else if ((t == t_symbol) || (t == t_cons) || (t == t_fixnum)) {
+		cl_index pc = current_pc();
+		asm_at(deflt_pc, MAKE_FIXNUM(pc-deflt_pc));
+		compile_form(deflt, FALSE);
+		asm_op(OP_EXIT);
+	}
+}
+
+static void
+c_register_var2(register cl_object var, register cl_object *specials)
+{
+	if (Null(var))
+		return;
+	if (member_eq(var, *specials))
+		c_register_var(var, TRUE);
+	else if (var->symbol.stype == stp_special) {
+		*specials = CONS(var, *specials);
+		c_register_var(var, TRUE);
+	} else if (var->symbol.stype == stp_constant)
+		FEerror("Cannot bind the constant ~A", 1, var);
+	else
+		c_register_var(var, FALSE);
+}
+
+cl_object
+make_lambda(cl_object name, cl_object lambda) {
+	cl_object reqs, opts, rest, keys, auxs, allow_other_keys;
+	cl_object specials, doc, decl, body, l;
+	cl_index specials_pc, opts_pc, keys_pc, label;
+	int nopts, nkeys;
+	cl_index handle;
+	cl_object lex_old = lex_env;
+
+	lex_copy();
+
+	/* Mark closure boundary */
+	CDR(lex_env) = CONS(CONS(Ct, Cnil), CDR(lex_env));
+
+	reqs = siLprocess_lambda_list(1,lambda);
+	opts = VALUES(1);
+	rest = VALUES(2);
+	allow_other_keys = VALUES(3);
+	keys = VALUES(4);
+	auxs = VALUES(5);
+	doc  = VALUES(6);
+	specials = VALUES(7);
+	decl = VALUES(8);
+	body = VALUES(9);
+
+	handle = asm_begin();
+
+	asm1(name);			/* Name of the function */
+	specials_pc = current_pc();	/* Which variables are declared special */
+	asm1(specials);
+
+	asm_list(reqs);			/* Special arguments */
+	reqs = CDR(reqs);
+	while (!endp(reqs)) {
+		cl_object v = pop(&reqs);
+		c_register_var2(v, &specials);
+	}
+
+	opts_pc = current_pc()+1;	/* Optional arguments */
+	nopts = fix(CAR(opts));
+	asm_list(opts);
+
+	asm_list(rest);			/* Name of &rest argument */
+
+	asm1(allow_other_keys);		/* Value of &allow-other-keys */
+
+	keys_pc = current_pc()+1;	/* Keyword arguments */
+	nkeys = fix(CAR(keys));
+	asm_list(keys);
+	asmn(2, doc, decl);
+
+	label = asm_jmp(OP_JMP);
+
+	while (nopts--) {
+		c_default(opts_pc+1);
+		c_register_var2(asm_ref(opts_pc), &specials);
+		c_register_var2(asm_ref(opts_pc+2), &specials);
+		opts_pc+=3;
+	}
+	c_register_var2(car(rest), &specials);
+	while (nkeys--) {
+		c_default(keys_pc+2);
+		c_register_var2(asm_ref(keys_pc+1), &specials);
+		c_register_var2(asm_ref(keys_pc+3), &specials);
+		keys_pc+=4;
+	}
+	
+	if ((current_pc() - label) == 1)
+		set_pc(label);
+	else
+		asm_complete(OP_JMP, label);
+	while (!endp(auxs)) {		/* Local bindings */
+		cl_object var = pop(&auxs);
+		cl_object value = pop(&auxs);
+		compile_form(value, FALSE);
+		c_bind(var, specials);
+	}
+	asm_at(specials_pc, specials);
+	compile_body(body);
+	asm_op(OP_HALT);
+
+	lex_env = lex_old;
+
+	return asm_end(handle);
+}
+
+static cl_object
+alloc_bytecodes()
+{
+	cl_object vector = alloc_simple_vector(128, aet_object);
+	array_allocself(vector);
+	vector->vector.hasfillp = TRUE;
+	vector->vector.fillp = 0;
+	return vector;
+}
+
+@(defun si::make_lambda (name rest)
+	cl_object lambda, old_bytecodes = bytecodes;
+	cl_object lex_old = lex_env;
+@
+	lex_new();
+	bytecodes = alloc_bytecodes();
+	lambda = make_lambda(name,rest);
+	bytecodes = old_bytecodes;
+	lex_env = lex_old;
+	@(return lambda)
+@)
+
+cl_object
+eval(cl_object form, cl_object *new_bytecodes)
+{
+	cl_object old_bytecodes = bytecodes;
+	cl_index handle;
+
+	if (new_bytecodes == NULL)
+		bytecodes = alloc_bytecodes();
+	else if (*new_bytecodes != Cnil) {
+		bytecodes = *new_bytecodes;
+	} else {
+		bytecodes = *new_bytecodes = alloc_bytecodes();
+	}
+	handle = asm_begin();
+	compile_form(form, FALSE);
+	asm_op(OP_EXIT);
+	asm_op(OP_HALT);
+/*  	Lprint(1,bytecodes); */
+	VALUES(0) = Cnil;
+	NValues = 0;
+	interpret(&bytecodes->vector.self.t[handle]);
+	asm_clear(handle);
+	bytecodes = old_bytecodes;
+	return VALUES(0);
+}
+
+void
+init_compiler(void)
+{
+	compiler_record *l;
+
+	register_root(&bytecodes);
+
+	for (l = database; l->name[0] != 0; l++)
+	  l->symbol = _intern(l->name, lisp_package);
+}
diff --git a/src/c/old/interpreter.d b/src/c/old/interpreter.d
new file mode 100644
index 000000000..150ae7e50
--- /dev/null
+++ b/src/c/old/interpreter.d
@@ -0,0 +1,874 @@
+/*
+    interpreter.c -- Bytecode interpreter.
+*/
+/*
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include "ecls-inl.h"
+#include "bytecodes.h"
+
+#define next_code(v) *(v++)
+
+static void
+lambda_bind_var(cl_object var, cl_object val, cl_object specials)
+{
+	if (!member_eq(var, specials))
+		CAR(lex_env) = CONS(CONS(var, CONS(val, Cnil)), CAR(lex_env));
+	else {
+		CAR(lex_env) = CONS(CONS(var, Cnil), CAR(lex_env));
+		bds_bind(var, val);
+	}
+}
+
+static void
+bind_var(register cl_object var, register cl_object val)
+{
+	CAR(lex_env) = CONS(CONS(var, CONS(val, Cnil)), CAR(lex_env));
+}
+
+static void
+bind_special(register cl_object var, register cl_object val)
+{
+	CAR(lex_env) = CONS(CONS(var, Cnil), CAR(lex_env));
+	bds_bind(var, val);
+}
+
+static cl_object *
+lambda_bind(int narg, cl_object lambda_list, cl_object *args)
+{
+	cl_object *data = &lambda_list->bytecodes.data[2];
+	cl_object specials = lambda_list->bytecodes.data[1];
+	cl_object aux;
+	int i, n;
+	bool other_keys = FALSE;
+	bool check_remaining = TRUE;
+
+	/* 1) REQUIRED ARGUMENTS:  N var1 ... varN */
+	n = fix(next_code(data));
+	if (narg < n)
+	  check_arg_failed(narg, n);
+	for (; n; n--, narg--)
+	  lambda_bind_var(next_code(data), next_code(args), specials);
+
+	/* 2) OPTIONAL ARGUMENTS:  N var1 value1 flag1 ... varN valueN flagN */
+	for (n = fix(next_code(data)); n; n--, data+=3) {
+	  if (narg) {
+	    lambda_bind_var(data[0], args[0], specials);
+	    args++; narg--;
+	    if (!Null(data[2]))
+	      lambda_bind_var(data[2], Ct, specials);
+	  } else {
+	    cl_object defaults = data[1];
+	    if (FIXNUMP(defaults)) {
+	      interpret(&data[1] + fix(defaults));
+	      defaults = VALUES(0);
+	    }
+	    lambda_bind_var(data[0], defaults, specials);
+	    if (!Null(data[2]))
+	      lambda_bind_var(data[2], Cnil, specials);
+	  }
+	}
+
+	/* 3) REST ARGUMENT: {rest-var | NIL} */
+	if (!Null(data[0])) {
+	  cl_object rest = Cnil;
+	  check_remaining = FALSE;
+	  for (i=narg; i; )
+	    rest = CONS(args[--i], rest);
+	  lambda_bind_var(data[0], rest, specials);
+	}
+	data++;
+
+	/* 4) ALLOW-OTHER-KEYS: { T | NIL } */
+	other_keys = !Null(next_code(data));
+
+	/* 5) KEYWORDS: N key1 var1 value1 flag1 ... keyN varN valueN flagN */
+	n = fix(next_code(data));
+	if (n != 0 || other_keys) {
+	  cl_object *keys;
+	  cl_object spp[n];
+	  bool other_found = FALSE;
+	  for (i=0; i<n; i++)
+	    spp[i] = OBJNULL;
+	  for (; narg; args+=2, narg-=2) {
+	    if (!SYMBOLP(args[0]) || args[0]->symbol.hpack != keyword_package)
+	      FEerror("Not a keyword ~S.", 1, args[0]);
+	    keys = data;
+	    for (i = 0; i < n; i++, keys += 4) {
+	      if (args[0] == keys[0]) {
+		if (spp[i] == OBJNULL)
+		  spp[i] = args[1];
+		goto FOUND;
+	      }
+	    }
+	    if (args[0] != SAallow_other_keys)
+	      other_found = TRUE;
+	    else
+	      other_keys = (args[1] == Cnil);
+	  FOUND:
+	  }
+	  if (other_found && !other_keys)
+	    FEerror("Unknown keys found", 0);
+	  for (i=0; i<n; i++, data+=4) {
+	    if (spp[i] != OBJNULL)
+	      lambda_bind_var(data[1],spp[i],specials);
+	    else {
+	      cl_object defaults = data[2];
+	      if (FIXNUMP(defaults)) {
+		      interpret(&data[2] + fix(defaults));
+		      defaults = VALUES(0);
+	      }
+	      lambda_bind_var(data[1],defaults,specials);
+	    }
+	    if (!Null(data[3]))
+	      lambda_bind_var(data[3],(spp[i] != OBJNULL)? Ct : Cnil,specials);
+	  }
+	}
+	if (narg && !other_keys && check_remaining)
+	  FEerror("Too many arguments to function ~S", 1,
+		  lambda_list->bytecodes.data[0]);
+
+	return &data[2];
+}
+
+cl_object
+lambda_apply(int narg, cl_object fun, cl_object *args)
+{       cl_object lex_old = lex_env;
+	cl_object output, name, *body;
+	bds_ptr old_bds_top;
+	volatile bool block, closure;
+
+	if (type_of(fun) != t_bytecodes)
+		FEinvalid_function(fun);
+
+	/* Set the lexical environment of the function */
+	ihs_check;
+	if (Null(fun->bytecodes.lex))
+		lex_env = CONS(Cnil, Cnil);
+	else
+		lex_env = CONS(CAR(fun->bytecodes.lex),CDR(fun->bytecodes.lex));
+	ihs_push(fun, lex_env);
+	old_bds_top = bds_top;
+
+	/* Establish bindings */
+	body = lambda_bind(narg, fun, args);
+
+	/* If it is a named lambda, set a block for RETURN-FROM */
+	block = FALSE;
+	name = fun->bytecodes.data[0];
+	if (Null(fun->bytecodes.data[0]))
+		block = FALSE;
+	else {
+		block = TRUE;
+		fun = new_frame_id();
+		lex_block_bind(name, fun);
+		if (frs_push(FRS_CATCH, fun)) {
+			output = VALUES(0);
+			goto END;
+		}
+	}
+
+	/* Process statements */
+	VALUES(0) = Cnil;
+	NValues = 0;
+	interpret(body);
+
+END:    if (block) frs_pop();
+	bds_unwind(old_bds_top);
+	lex_env = lex_old;
+	ihs_pop();
+	returnn(VALUES(0));
+}
+
+
+/* ----------------- BYTECODE STACK --------------- */
+
+cl_object stack = OBJNULL;
+
+static void
+stack_grow(void) {
+	cl_object *old_data = stack->vector.self.t;
+	cl_index old_size = stack->vector.fillp;
+	stack->vector.dim += 128;
+	array_allocself(stack);
+	memcpy(stack->vector.self.t, old_data, old_size*sizeof(cl_object));
+}
+
+static void
+push1(register cl_object op) {
+	cl_index where;
+	where = stack->vector.fillp;
+	if (where >= stack->vector.dim)
+		stack_grow();
+	stack->vector.self.t[where] = op;
+	stack->vector.fillp++;
+}
+
+static cl_object
+pop1() {
+	return stack->vector.self.t[--stack->vector.fillp];
+}
+
+static cl_index
+get_sp_index() {
+	return stack->vector.fillp;
+}
+
+static void
+dec_sp_index(register cl_index delta) {
+	stack->vector.fillp -= delta;
+}
+
+static void
+set_sp_index(register cl_index sp) {
+	if (stack->vector.fillp < sp)
+		FEerror("Tried to advance stack", 0);
+	stack->vector.fillp = sp;
+}
+
+static cl_object *
+get_sp() {
+	return stack->vector.self.t + stack->vector.fillp;
+}
+
+static cl_object *
+get_sp_at(cl_index where) {
+	return stack->vector.self.t + where;
+}
+
+/* -------------------- AIDS TO THE INTERPRETER -------------------- */
+
+static inline cl_fixnum
+get_oparg(cl_object o) {
+	return GET_OPARG(o);
+}
+
+static inline cl_object *
+packed_label(cl_object *v) {
+	return v + GET_OPARG(v[0]);
+}
+
+static inline cl_object *
+simple_label(cl_object *v) {
+	return v + fix(v[0]);
+}
+
+static cl_object
+search_symbol_function(register cl_object fun) {
+	cl_object output = lex_fun_sch(fun);
+	if (!Null(output))
+		return output;
+	output = SYM_FUN(fun);
+	if (output == OBJNULL || fun->symbol.mflag)
+		FEundefined_function(fun);
+	return output;
+}
+
+static cl_object
+search_symbol_value(register cl_object s) {
+	cl_object x;
+	/*  x = lex_var_sch(form);  */
+	for (x = CAR(lex_env);  CONSP(x);  x = CDR(x))
+		if (CAAR(x) == s) {
+			x = CDAR(x);
+			if (ENDP(x)) break;
+			return CAR(x);
+		}
+	x = SYM_VAL(s);
+	if (x == OBJNULL)
+		FEunbound_variable(s);
+	return x;
+}
+		
+static cl_object
+interpret_apply(int narg, cl_object fun, cl_object *args) {
+	cl_object x;
+
+ AGAIN:
+	switch (type_of(fun)) {
+	case t_cfun:
+		ihs_push_funcall(fun->cfun.name);
+		x = APPLY(narg, fun->cfun.entry, args);
+		ihs_pop();
+		return x;
+	case t_cclosure:
+		/* FIXME! Shouldn't we register this call somehow? */
+		return APPLY_closure(narg, fun->cclosure.entry, fun->cclosure.env, args);
+#ifdef CLOS
+	case t_gfun:
+		ihs_push_funcall(fun->gfun.name);
+		x = gcall(narg, fun, args);
+		ihs_pop();
+		return x;
+#endif
+	case t_bytecodes:
+		return lambda_apply(narg, fun, args);
+	case t_symbol:
+		fun = search_symbol_function(fun);
+		goto AGAIN;
+	default:
+	}
+	FEinvalid_function(fun);
+}
+
+/* -------------------- THE INTERPRETER -------------------- */
+
+static cl_object *
+interpret_block(cl_object *vector) {
+	cl_object * volatile exit, name;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	lex_copy();
+
+	exit = packed_label(vector - 1);
+	lex_block_bind(next_code(vector), id);
+	if (frs_push(FRS_CATCH,id) == 0)
+		vector = interpret(vector);
+	frs_pop();
+	lex_env = lex_old;
+	return exit;
+}
+
+static cl_object *
+interpret_catch(cl_object *vector) {
+	cl_object * volatile exit;
+	exit = packed_label(vector - 1);
+	if (frs_push(FRS_CATCH,VALUES(0)) == 0)
+		interpret(vector);
+	frs_pop();
+	return exit;
+}
+
+static cl_object *
+interpret_tagbody(cl_object *vector) {
+	cl_index i, ntags = fix(get_oparg(vector[-1]));
+	cl_object lex_old = lex_env;
+	cl_object id = new_frame_id();
+	cl_object *aux, *tag_list = vector;
+
+	lex_copy();
+	aux = vector;
+	for (i=0; i<ntags; i++, aux+=2)
+		lex_tag_bind(*aux, id);
+
+	if (frs_push(FRS_CATCH, id) != 0) {
+		for (aux = vector, i=0; i<ntags; i++, aux+=2)
+			if (eql(aux[0], nlj_tag)) {
+				aux++;
+				break;
+			}
+		if (i >= ntags)
+			FEerror("Someone tried to RETURN-FROM a TAGBODY",0);
+		else
+			aux = simple_label(aux);
+	}
+	vector = interpret(aux);
+	frs_pop();
+	lex_env = lex_old;
+	VALUES(0) = Cnil;
+	NValues = 0;
+	return vector;
+}
+
+static cl_object *
+interpret_unwind_protect(cl_object *vector) {
+	bool unwinding;
+	int nr;
+	cl_object * volatile exit;
+
+	exit = packed_label(vector-1);
+	if (frs_push(FRS_PROTECT, Cnil))
+		unwinding = TRUE;
+	else {
+		interpret(vector);
+		unwinding = FALSE;
+	}
+	nr = NValues;
+	MV_SAVE(nr);
+	exit = interpret(exit);
+	MV_RESTORE(nr);
+	frs_pop();
+	if (unwinding)
+		unwind(nlj_fr, nlj_tag);
+	return exit;
+}
+
+static cl_object *
+interpret_do(cl_object *vector) {
+	cl_object *volatile exit;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+	lex_copy();
+	lex_block_bind(Cnil, id);
+
+	exit = packed_label(vector-1);
+	if (frs_push(FRS_CATCH,id) == 0)
+		interpret(vector);
+	frs_pop();
+
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return exit;
+}
+
+static cl_object *
+interpret_dolist(cl_object *vector) {
+	cl_object *output, *volatile exit;
+	cl_object list, var;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+	lex_copy();
+	lex_block_bind(Cnil, id);
+
+	list = VALUES(0);
+	exit = packed_label(vector - 1);
+	if (frs_push(FRS_CATCH,id) == 0) {
+		/* Build list & bind variable*/
+		vector = interpret(vector);
+		output = packed_label(vector-1);
+		while (!endp(list)) {
+			NValues = 1;
+			VALUES(0) = CAR(list);
+			interpret(vector);
+			list = CDR(list);
+		}
+		VALUES(0) = Cnil;
+		NValues = 1;
+		interpret(output);
+	}
+	frs_pop();
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return exit;
+}
+
+static cl_object *
+interpret_dotimes(cl_object *vector) {
+	cl_object *output, *volatile exit;
+	cl_fixnum length, i;
+	cl_object var;
+	cl_object id = new_frame_id();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+	lex_copy();
+	lex_block_bind(Cnil, id);
+
+	length = fix(VALUES(0));
+	exit = packed_label(vector - 1);
+	if (frs_push(FRS_CATCH,id) == 0) {
+		/* Bind variable */
+		vector = interpret(vector);
+		output = packed_label(vector-1);
+		for (i = 0; i < length;) {
+			interpret(vector);
+			NValues = 1;
+			VALUES(0) = MAKE_FIXNUM(++i);
+		}
+		interpret(output);
+	}
+	frs_pop();
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return exit;
+}
+
+static cl_object
+close_around(cl_object fun, cl_object lex) {
+	cl_object v = alloc_object(t_bytecodes);
+	v->bytecodes.size = fun->bytecodes.size;
+	v->bytecodes.data = fun->bytecodes.data;
+	if (!Null(CAR(lex)) || !Null(CDR(lex)))
+		v->bytecodes.lex = CONS(CAR(lex),CDR(lex));
+	else
+		v->bytecodes.lex = Cnil;
+	return v;
+}
+
+static cl_object *
+interpret_flet(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	cl_index nfun = get_oparg(vector[-1]);
+
+	lex_copy();
+	while (nfun--) {
+		cl_object fun = next_code(vector);
+		cl_object f = close_around(fun,lex_old);
+		lex_fun_bind(f->bytecodes.data[0], f);
+	}
+	vector = interpret(vector);
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+interpret_labels(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	cl_index i, nfun = get_oparg(vector[-1]);
+	cl_object l;
+
+	lex_copy();
+	for (i=0; i<nfun; i++) {
+		cl_object f = next_code(vector);
+		lex_fun_bind(f->bytecodes.data[0], f);
+	}
+	/* Update the closures so that all functions can call each other */
+	for (i=0, l=CDR(lex_env); i<nfun; i++) {
+		cl_object f = CADDAR(l);
+		CADDAR(l) = close_around(f, lex_env);
+		l = CDR(l);
+	}
+	vector = interpret(vector);
+	lex_env = lex_old;
+	return vector;
+}
+
+static cl_object *
+interpret_mbind(cl_object *vector)
+{
+	int i = get_oparg(vector[-1]);
+	while (i--) {
+		cl_object var = next_code(vector);
+		cl_object value = (i < NValues) ? VALUES(i) : Cnil;
+		if (var == MAKE_FIXNUM(1))
+			bind_special(next_code(vector), value);
+		else
+			bind_var(var, value);
+	}
+	return vector;
+}
+
+static cl_object *
+interpret_mcall(cl_object *vector) {
+	cl_index sp = get_sp_index();
+	vector = interpret(vector);
+	VALUES(0) = interpret_apply(get_sp_index()-sp, VALUES(0), get_sp_at(sp));
+	set_sp_index(sp);
+	return vector;
+}
+
+static cl_object *
+interpret_mprog1(cl_object *vector) {
+	cl_index i,n = NValues;
+	for (i=0; i<n; i++) {
+		push1(VALUES(i));
+	}
+	vector = interpret(vector);
+	for (i=n; i;) {
+		VALUES(--i) = pop1();
+	}
+	NValues = n;
+	return vector;
+}
+
+static cl_object *
+interpret_msetq(cl_object *vector)
+{
+	cl_object var, value;
+	int i = get_oparg(vector[-1]);
+	while (i--) {
+		var = next_code(vector);
+		value = (i < NValues) ? VALUES(i) : Cnil;
+		if (var != MAKE_FIXNUM(1))
+			CADR(lex_var_sch(var)) = value;
+		else {
+			var = next_code(vector);
+			if (var->symbol.stype == stp_constant)
+				FEerror("Cannot set the constant ~A", 1, var);
+			else
+				SYM_VAL(var) = value;
+		}
+	}
+	if (NValues > 1) NValues = 1;
+	return vector;
+}
+
+static cl_object *
+interpret_progv(cl_object *vector) {
+	cl_object values = VALUES(0);
+	cl_object vars = pop1();
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+
+	lex_copy();
+	while (!endp(vars)) {
+		if (values == Cnil)
+			bds_bind(CAR(vars), OBJNULL);
+		else {
+			bds_bind(CAR(vars), car(values));
+			values = CDR(values);
+		}
+		vars = CDR(vars);
+	}
+	vector = interpret(vector);
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return vector;
+}
+
+static cl_object *
+interpret_pushenv(cl_object *vector) {
+	cl_object lex_old = lex_env;
+	bds_ptr old_bds_top = bds_top;
+
+	lex_copy();
+	vector = interpret(vector);
+	lex_env = lex_old;
+	bds_unwind(old_bds_top);
+	return vector;
+}
+
+cl_object *
+interpret(cl_object *vector) {
+	enum cl_type t;
+	cl_object s;
+	cl_fixnum n;
+
+ BEGIN:
+	s = next_code(vector);
+	t = type_of(s);
+	if (t == t_symbol) {
+		VALUES(0) = search_symbol_value(s);
+		NValues = 1;
+		goto BEGIN;
+	}
+	if (t != t_fixnum) {
+		VALUES(0) = s;
+		NValues = 1;
+		goto BEGIN;
+	}
+	switch (GET_OP(s)) {
+	case OP_PUSHQ:
+		push1(next_code(vector));
+		break;
+	case OP_PUSH:
+		push1(VALUES(0));
+		break;
+	case OP_PUSHV:
+		push1(search_symbol_value(next_code(vector)));
+		break;
+	case OP_QUOTE:
+		VALUES(0) = next_code(vector);
+		NValues = 1;
+		break;
+	case OP_NOP:
+		VALUES(0) = Cnil;
+		NValues = 0;
+		break;
+	case OP_BLOCK:
+		vector = interpret_block(vector);
+		break;
+	case OP_PUSHVALUES: {
+		int i;
+		for (i=0; i<NValues; i++)
+			push1(VALUES(i));
+		break;
+	}
+	case OP_MCALL:
+		vector = interpret_mcall(vector);
+		break;
+	case OP_CALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object name = next_code(vector);
+		VALUES(0) = interpret_apply(n, name, get_sp()-n);
+		dec_sp_index(n);
+		break;
+	}
+	case OP_PCALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object name = next_code(vector);
+		VALUES(0) = interpret_apply(n, name, get_sp()-n);
+		dec_sp_index(n);
+		push1(VALUES(0));
+		break;
+	}
+	case OP_FCALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object fun = VALUES(0);
+		VALUES(0) = interpret_apply(n, fun, get_sp()-n);
+		dec_sp_index(n);
+		break;
+	}
+	case OP_PFCALL: {
+		cl_fixnum n = get_oparg(s);
+		cl_object fun = VALUES(0);
+		VALUES(0) = interpret_apply(n, fun, get_sp()-n);
+		dec_sp_index(n);
+		push1(VALUES(0));
+		break;
+	}
+	case OP_CATCH:
+		vector = interpret_catch(vector);
+		break;
+	case OP_EXIT:
+		return vector;
+	case OP_HALT:
+		return vector-1;
+	case OP_FLET:
+		vector = interpret_flet(vector);
+		break;
+	case OP_LABELS:
+		vector = interpret_labels(vector);
+		break;
+	case OP_FUNCTION:
+		VALUES(0) = search_symbol_function(next_code(vector));
+		NValues = 1;
+		break;
+	case OP_CLOSE:
+		VALUES(0) = close_around(next_code(vector), lex_env);
+		NValues = 1;
+		break;
+	case OP_GO: {
+		cl_object tag = next_code(vector);
+		cl_object id = lex_tag_sch(tag);
+		if (Null(id))
+			FEerror("~S is an undefined tag.", 1, tag);
+		VALUES(0) = Cnil;
+		NValues = 0;
+		go(id, tag);
+		break;
+	}
+	case OP_RETURN: {
+		cl_object tag = next_code(vector);
+		cl_object id = lex_block_sch(tag);
+		if (Null(id))
+			FEerror("The block name ~S is undefined.", 1, tag);
+		return_from(id, tag);
+		break;
+	}
+	case OP_THROW:
+		throw(pop1());
+		break;
+	case OP_JMP:
+		vector = vector - 1 + get_oparg(s);
+		break;
+	case OP_JNIL:
+		NValues = 1;
+		if (Null(VALUES(0))) vector = vector - 1 + get_oparg(s);
+		break;
+	case OP_JT:
+		NValues = 1;
+		if (!Null(VALUES(0))) vector = vector - 1 + get_oparg(s);
+		break;
+	case OP_JEQ:
+		if (VALUES(0) == next_code(vector))
+			vector = vector + get_oparg(s) - 2;
+		break;
+	case OP_JNEQ:
+		if (VALUES(0) != next_code(vector))
+			vector = vector + get_oparg(s) - 2;
+		break;
+	case OP_BIND:
+		bind_var(next_code(vector), VALUES(0));
+		break;
+	case OP_BINDS:
+		bind_special(next_code(vector), VALUES(0));
+		break;
+	case OP_SETQ:
+		CADR(lex_var_sch(next_code(vector))) = VALUES(0);
+		break;
+	case OP_SETQS: {
+		cl_object var = next_code(vector);
+		if (var->symbol.stype == stp_constant)
+			FEerror("Cannot bind the constant ~A", 1, var);
+		else
+			SYM_VAL(var) = VALUES(0);
+		break;
+	}
+	case OP_PBIND:
+		bind_var(next_code(vector), pop1());
+		break;
+	case OP_PBINDS:
+		bind_special(next_code(vector), pop1());
+		break;
+	case OP_PSETQ:
+		CADR(lex_var_sch(next_code(vector))) = pop1();
+		Values[0] = Cnil;
+		NValues = 1;
+		break;
+	case OP_PSETQS: {
+		cl_object var = next_code(vector);
+		if (var->symbol.stype == stp_constant)
+			FEerror("Cannot bind the constant ~A", 1, var);
+		else
+			SYM_VAL(var) = pop1();
+		Values[0] = Cnil;
+		NValues = 1;
+		break;
+	}
+	case OP_MSETQ:
+		vector = interpret_msetq(vector);
+		break;
+	case OP_MBIND:
+		vector = interpret_mbind(vector);
+		break;
+	case OP_MPROG1:
+		vector = interpret_mprog1(vector);
+		break;
+	case OP_PROGV:
+		vector = interpret_progv(vector);
+		break;
+	case OP_PUSHENV:
+		vector = interpret_pushenv(vector);
+		break;
+	case OP_VALUES: {
+		cl_fixnum n = get_oparg(s);
+		NValues = n;
+		while (n)
+			VALUES(--n) = pop1();
+		break;
+	}
+	case OP_NTHVAL: {
+		cl_index n = fix(pop1());
+		if (n < 0 || n >= NValues)
+			VALUES(0) = Cnil;
+		else
+			VALUES(0) = VALUES(n);
+		NValues = 1;
+		break;
+	}
+	case OP_DOLIST:
+		vector = interpret_dolist(vector);
+		break;
+	case OP_DOTIMES:
+		vector = interpret_dotimes(vector);
+		break;
+	case OP_DO:
+		vector = interpret_do(vector);
+		break;
+	case OP_TAGBODY:
+		vector = interpret_tagbody(vector);
+		break;
+	case OP_UNWIND:
+		vector = interpret_unwind_protect(vector);
+		break;
+	default:
+		FEerror("Unknown code ~S", 1, MAKE_FIXNUM(*(vector-1)));
+	}
+	goto BEGIN;
+}
+
+@(defun si::interpreter_stack ()
+@
+	@(return stack)
+@)
+
+void
+init_interpreter(void)
+{
+	register_root(&stack);
+	stack = alloc_simple_vector(128, aet_object);
+	array_allocself(stack);
+	stack->vector.hasfillp = TRUE;
+	stack->vector.fillp = 0;
+}
diff --git a/src/c/package.d b/src/c/package.d
new file mode 100644
index 000000000..9b5a56d73
--- /dev/null
+++ b/src/c/package.d
@@ -0,0 +1,930 @@
+/*
+    package.d -- Packages.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+/******************************* EXPORTS ******************************/
+
+bool lisp_package_locked = FALSE;
+cl_object lisp_package;
+cl_object user_package;
+cl_object keyword_package;
+cl_object system_package;
+#ifdef CLOS
+cl_object clos_package;
+#endif
+#ifdef TK
+cl_object tk_package;
+#endif
+cl_object Vpackage;		/*  *package*  */
+
+#ifndef THREADS
+int intern_flag;
+#endif
+
+cl_object Kinternal;
+cl_object Kexternal;
+cl_object Kinherited;
+cl_object Knicknames;
+cl_object Kuse;
+
+/******************************* ------- ******************************/
+
+#define	INTERNAL	1
+#define	EXTERNAL	2
+#define	INHERITED	3
+
+static cl_object package_list = Cnil;
+static cl_object uninterned_list = Cnil;
+
+static void no_package(cl_object n) __attribute__((noreturn));
+static void package_already(cl_object n) __attribute__((noreturn));
+
+static void
+no_package(cl_object n)
+{
+	FEerror("There is no package with the name ~A.", 1, n);
+}
+
+static void
+package_already(cl_object n)
+{
+	FEerror("A package with the name ~A already exists.", 1, n);
+}
+
+static bool
+member_string_eq(cl_object x, cl_object l)
+{
+	/* INV: l is a proper list */
+	for (;  CONSP(l);  l = CDR(l))
+		if (string_eq(x, CAR(l)))
+			return(TRUE);
+	return(FALSE);
+}
+
+/*
+	Make_package(n, ns, ul) makes a package with name n,
+	which must be a string or a symbol,
+	and nicknames ns, which must be a list of strings or symbols,
+	and uses packages in list ul, which must be a list of packages
+	or package names i.e. strings or symbols.
+*/
+static cl_object
+make_package_hashtable()
+{
+	cl_object h;
+	cl_index hsize = 128, i;
+
+	h = alloc_object(t_hashtable);
+	h->hash.test = htt_pack;
+	h->hash.size = hsize;
+	h->hash.rehash_size = make_shortfloat(1.5);
+	h->hash.threshold = make_shortfloat(0.7);
+	h->hash.entries = 0;
+	h->hash.data = alloc(hsize * sizeof(struct hashtable_entry));
+	for(i = 0;  i < hsize;  i++) {
+		h->hash.data[i].key = OBJNULL;
+		h->hash.data[i].value = OBJNULL;
+	}
+	return h;
+}
+
+cl_object
+make_package(cl_object name, cl_object nicknames, cl_object use_list)
+{
+	cl_object x, y;
+	cl_index i;
+
+	name = coerce_to_string(name);
+	assert_type_proper_list(nicknames);
+	assert_type_proper_list(use_list);
+
+	if (find_package(name) != Cnil)
+		package_already(name);
+	x = alloc_object(t_package);
+	x->pack.name = name;
+	x->pack.nicknames = Cnil;
+	x->pack.shadowings = Cnil;
+	x->pack.uses = Cnil;
+	x->pack.usedby = Cnil;
+	x->pack.locked = FALSE;
+	for (;  !endp(nicknames);  nicknames = CDR(nicknames)) {
+		cl_object nick = coerce_to_string(CAR(nicknames));
+		if (find_package(nick) != Cnil)
+			package_already(nick);
+		x->pack.nicknames = CONS(nick, x->pack.nicknames);
+	}
+	for (;  !endp(use_list);  use_list = CDR(use_list)) {
+		if (type_of(CAR(use_list)) == t_package)
+			y = CAR(use_list);
+		else {
+			y = find_package(CAR(use_list));
+			if (Null(y))
+				no_package(CAR(use_list));
+		}
+		x->pack.uses = CONS(y, x->pack.uses);
+		y->pack.usedby = CONS(x, y->pack.usedby);
+	}
+	x->pack.internal = make_package_hashtable();
+	x->pack.external = make_package_hashtable();
+	package_list = CONS(x, package_list);
+	return(x);
+}
+
+cl_object
+rename_package(cl_object x, cl_object name, cl_object nicknames)
+{
+	cl_object y;
+
+	/*
+	   If we are trying to rename the package with either its name
+	   or a nickname, then we are really trying to redefine the
+	   package.  Therefore, do not signal the error.
+
+	   Marco Antoniotti 19951028
+	 */
+	x = coerce_to_package(x);
+	name = coerce_to_string(name);
+	y = find_package(name);
+	if ((y != Cnil) && (y != x))
+		package_already(name);
+
+	x->pack.name = name;
+	x->pack.nicknames = Cnil;
+	assert_type_proper_list(nicknames);
+	for (;  !endp(nicknames);  nicknames = CDR(nicknames)) {
+		cl_object nick = CAR(nicknames);
+		y = find_package(nick);
+		if (x == y)
+			continue;
+		if (y != Cnil)
+			package_already(nick);
+		x->pack.nicknames = CONS(coerce_to_string(nick), x->pack.nicknames);
+	}
+	return(x);
+}
+
+/*
+	Find_package(n) seaches for a package with name n, where n is
+	a valid string designator, or simply outputs n if it is a
+	package.
+*/
+cl_object
+find_package(cl_object name)
+{
+	cl_object l, p;
+
+	if (type_of(name) == t_package)
+		return name;
+	name = coerce_to_string_designator(name);
+	/* INV: package_list is a proper list */
+	for (l = package_list; CONSP(l); l = CDR(l)) {
+		p = CAR(l);
+		if (string_eq(name, p->pack.name))
+			return p;
+		if (member_string_eq(name, p->pack.nicknames))
+			return p;
+	}
+	return Cnil;
+}
+
+cl_object
+coerce_to_package(cl_object p)
+{
+	cl_object pp;
+	if (type_of(p) == t_package)
+		return(p);
+	pp = find_package(p);
+	if (!Null(pp))
+		return (pp);
+	FEwrong_type_argument(Spackage, p);
+}
+
+cl_object
+current_package(void)
+{
+	cl_object x;
+
+	x = symbol_value(Vpackage);
+	if (type_of(x) != t_package) {
+		SYM_VAL(Vpackage) = user_package;
+		FEerror("The value of *PACKAGE*, ~S, was not a package.",
+			1, x);
+	}
+	return(x);
+}
+
+/*
+	Intern(st, p) interns string st in package p.
+*/
+cl_object
+_intern(const char *s, cl_object p)
+{
+	cl_object str = make_simple_string(s);
+	return intern(str, p);
+}
+
+cl_object
+intern(cl_object name, cl_object p)
+{
+	cl_object s, ul;
+
+	assert_type_string(name);
+	p = coerce_to_package(p);
+	s = gethash_safe(name, p->pack.external, OBJNULL);
+	if (s != OBJNULL) {
+		intern_flag = EXTERNAL;
+		return s;
+	}
+	/* Keyword package has no intern section nor can it be used */
+	if (p == keyword_package) goto INTERN;
+	s = gethash_safe(name, p->pack.internal, OBJNULL);
+	if (s != OBJNULL) {
+		intern_flag = INTERNAL;
+		return s;
+	}
+	for (ul=p->pack.uses; CONSP(ul); ul = CDR(ul)) {
+		s = gethash_safe(name, CAR(ul)->pack.external, OBJNULL);
+		if (s != OBJNULL) {
+			intern_flag = INHERITED;
+			return s;
+		}
+	}
+ INTERN:
+	s = make_symbol(name);
+	s->symbol.hpack = p;
+	intern_flag = 0;
+	if (p == keyword_package) {
+		s->symbol.stype = stp_constant;
+		SYM_VAL(s) = s;
+		sethash(name, p->pack.external, s);
+	} else {
+		sethash(name, p->pack.internal, s);
+	}
+	return s;
+}
+
+/*
+	Find_symbol(st, len, p) searches for string st of length len in package p.
+*/
+cl_object
+find_symbol(cl_object name, cl_object p)
+{
+	cl_object s, ul;
+	
+	name = coerce_to_string_designator(name);
+	p = coerce_to_package(p);
+	s = gethash_safe(name, p->pack.external, OBJNULL);
+	if (s != OBJNULL) {
+		intern_flag = EXTERNAL;
+		return s;
+	}
+	if (p == keyword_package) goto RETURN;
+	s = gethash_safe(name, p->pack.internal, OBJNULL);
+	if (s != OBJNULL) {
+		intern_flag = INTERNAL;
+		return s;
+	}
+	for (ul=p->pack.uses; CONSP(ul); ul = CDR(ul)) {
+		s = gethash_safe(name, CAR(ul)->pack.external, OBJNULL);
+		if (s != OBJNULL) {
+			intern_flag = INHERITED;
+			return s;
+		}
+	}
+RETURN:
+	intern_flag = 0;
+	return(Cnil);
+}
+
+static void
+delete_eq(cl_object x, cl_object *lp)
+{
+	for (;  CONSP(*lp);  lp = &CDR((*lp)))
+		if (CAR((*lp)) == x) {
+			*lp = CDR((*lp));
+			return;
+		}
+}
+
+bool
+unintern(cl_object s, cl_object p)
+{
+	cl_object x, y, l, hash;
+
+	assert_type_symbol(s);
+	p = coerce_to_package(p);
+	hash = p->pack.internal;
+	x = gethash_safe(s->symbol.name, hash, OBJNULL);
+	if (x == s) {
+		if (member_eq(s, p->pack.shadowings))
+			goto L;
+		goto UNINTERN;
+	}
+	hash = p->pack.external;
+	x = gethash_safe(s->symbol.name, hash, OBJNULL);
+	if (x == s) {
+		if (member_eq(s, p->pack.shadowings))
+			goto L;
+		goto UNINTERN;
+	}
+	return(FALSE);
+
+L:
+	x = OBJNULL;
+	for (l = p->pack.uses; CONSP(l); l = CDR(l)) {
+		y = gethash_safe(s->symbol.name, CAR(l)->pack.external, OBJNULL);
+		if (y != OBJNULL) {
+			if (x == OBJNULL)
+				x = y;
+			else if (x != y)
+FEerror("Cannot unintern the shadowing symbol ~S~%\
+from ~S,~%\
+because ~S and ~S will cause~%\
+a name conflict.", 4, s, p, x, y);
+		}
+	}
+	delete_eq(s, &p->pack.shadowings);
+
+UNINTERN:
+	remhash(s->symbol.name, hash);
+	if (s->symbol.hpack == p)
+		s->symbol.hpack = Cnil;
+	if (s->symbol.stype != stp_ordinary)
+		uninterned_list = CONS(s, uninterned_list);
+	return(TRUE);
+}
+
+void
+export(cl_object s, cl_object p)
+{
+	cl_object x, l, hash = OBJNULL;
+BEGIN:
+	assert_type_symbol(s);
+	p = coerce_to_package(p);
+	x = find_symbol(s, p);
+	if (!intern_flag)
+		FEerror("The symbol ~S is not accessible from ~S.", 2,
+			s, p);
+	if (x != s) {
+		import(s, p);	/*  signals an error  */
+		goto BEGIN;
+	}
+	if (intern_flag == EXTERNAL)
+		return;
+	if (intern_flag == INTERNAL)
+		hash = p->pack.internal;
+	for (l = p->pack.usedby; CONSP(l); l = CDR(l)) {
+		x = find_symbol(s, CAR(l));
+		if (intern_flag && s != x &&
+		    !member_eq(x, CAR(l)->pack.shadowings))
+FEerror("Cannot export the symbol ~S~%\
+from ~S,~%\
+because it will cause a name conflict~%\
+in ~S.", 3, s, p, CAR(l));
+	}
+	if (hash != OBJNULL)
+		remhash(s->symbol.name, hash);
+	sethash(s->symbol.name, p->pack.external, s);
+}
+
+void
+delete_package(cl_object p)
+{
+	cl_object hash, list;
+	cl_index i;
+
+	p = coerce_to_package(p);
+	if (p == lisp_package || p == keyword_package)
+		FEerror("Cannot remove package ~S", 1, p->pack.name);
+	for (list = p->pack.uses; !endp(list); list = CDR(list))
+		unuse_package(CAR(list), p);
+	for (list = p->pack.usedby; !endp(list); list = CDR(list))
+		unuse_package(p, CAR(list));
+	for (hash = p->pack.internal, i = 0; i < hash->hash.size; i++)
+		if (hash->hash.data[i].key != OBJNULL)
+			unintern(hash->hash.data[i].value, p);
+	for (hash = p->pack.external, i = 0; i < hash->hash.size; i++)
+		if (hash->hash.data[i].key != OBJNULL)
+			unintern(hash->hash.data[i].value, p);
+	delete_eq(p, &package_list);
+	p->pack.shadowings = Cnil;
+	p->pack.internal = OBJNULL;
+	p->pack.external = OBJNULL;
+}
+
+void
+unexport(cl_object s, cl_object p)
+{
+	cl_object x;
+
+	if (p == keyword_package)
+		FEerror("Cannot unexport a symbol from the keyword.", 0);
+	assert_type_symbol(s);
+	p = coerce_to_package(p);
+	x = find_symbol(s, p);
+	if (intern_flag != EXTERNAL || x != s)
+		/* According to ANSI & Cltl, internal symbols are
+		   ignored in unexport */
+		return;
+	remhash(s->symbol.name, p->pack.external);
+	sethash(s->symbol.name, p->pack.internal, s);
+}
+
+void
+import(cl_object s, cl_object p)
+{
+	cl_object x;
+
+	assert_type_symbol(s);
+	p = coerce_to_package(p);
+	x = find_symbol(s, p);
+	if (intern_flag) {
+		if (x != s)
+			FEerror("Cannot import the symbol ~S~%\
+from ~S,~%\
+because there is already a symbol with the same name~%\
+in the package.", 2, s, p);
+		if (intern_flag == INTERNAL || intern_flag == EXTERNAL)
+			return;
+	}
+	sethash(s->symbol.name, p->pack.internal, s);
+	if (Null(s->symbol.hpack))
+		s->symbol.hpack = p;
+}
+
+void
+shadowing_import(cl_object s, cl_object p)
+{
+	cl_object x;
+
+	assert_type_symbol(s);
+	p = coerce_to_package(p);
+	x = find_symbol(s, p);
+	if (intern_flag && intern_flag != INHERITED) {
+		if (x == s) {
+			if (!member_eq(x, p->pack.shadowings))
+				p->pack.shadowings
+				= CONS(x, p->pack.shadowings);
+			return;
+		}
+		if(member_eq(x, p->pack.shadowings))
+			delete_eq(x, &p->pack.shadowings);
+		if (intern_flag == INTERNAL)
+			remhash(x->symbol.name, p->pack.internal);
+		else
+			remhash(x->symbol.name, p->pack.external);
+		if (x->symbol.hpack == p)
+			x->symbol.hpack = Cnil;
+		if (x->symbol.stype != stp_ordinary)
+			uninterned_list = CONS(x, uninterned_list);
+	}
+	p->pack.shadowings = CONS(s, p->pack.shadowings);
+	sethash(s->symbol.name, p->pack.internal, s);
+}
+
+void
+shadow(cl_object s, cl_object p)
+{
+	cl_object x;
+
+	assert_type_symbol(s);
+	p = coerce_to_package(p);
+	x = find_symbol(s, p);
+	if (intern_flag != INTERNAL && intern_flag != EXTERNAL) {
+		x = make_symbol(s);
+		sethash(x->symbol.name, p->pack.internal, x);
+		x->symbol.hpack = p;
+	}
+	p->pack.shadowings = CONS(x, p->pack.shadowings);
+}
+
+void
+use_package(cl_object x, cl_object p)
+{
+	struct hashtable_entry *hash_entries;
+	cl_index i, hash_length;
+
+	x = coerce_to_package(x);
+	if (x == keyword_package)
+		FEerror("Cannot use keyword package.", 0);
+	p = coerce_to_package(p);
+	if (p == keyword_package)
+		FEerror("Cannot use in keyword package.", 0);
+	if (p == x)
+		return;
+	if (member_eq(x, p->pack.uses))
+		return;
+	hash_entries = x->pack.external->hash.data;
+	hash_length = x->pack.external->hash.size;
+	for (i = 0;  i < hash_length;  i++)
+		if (hash_entries[i].key != OBJNULL) {
+			cl_object here = hash_entries[i].value;
+			cl_object there = find_symbol(here, p);
+			if (intern_flag && here != there
+			    && ! member_eq(there, p->pack.shadowings))
+FEerror("Cannot use ~S~%\
+from ~S,~%\
+because ~S and ~S will cause~%\
+a name conflict.", 4, x, p, here, there);
+		}
+	p->pack.uses = CONS(x, p->pack.uses);
+	x->pack.usedby = CONS(p, x->pack.usedby);
+}
+
+void
+unuse_package(cl_object x, cl_object p)
+{
+	x = coerce_to_package(x);
+	p = coerce_to_package(p);
+	delete_eq(x, &p->pack.uses);
+	delete_eq(p, &x->pack.usedby);
+}
+
+@(defun make_package (pack_name
+		      &key nicknames
+			   (use `CONS(lisp_package, Cnil)`))
+@
+	/* INV: make_package() performs type checking */
+	@(return make_package(pack_name, nicknames, use))
+@)
+
+@(defun si::select_package (pack_name)
+	cl_object p;
+@
+	/* INV: find_package()/in_package() perform type checks */
+	p = find_package(pack_name);
+	if (Null(p))
+		FEerror("Package ~s not found", 1, pack_name);
+	@(return (SYM_VAL(Vpackage) = p))
+@)
+
+@(defun find_package (p)
+@
+	@(return find_package(p))
+@)
+
+@(defun package_name (p)
+@
+	/* INV: coerce_to_package() performs type checks */
+	/* FIXME: name should be a fresh one */
+	p = coerce_to_package(p);
+	@(return p->pack.name)
+@)
+
+@(defun package_nicknames (p)
+@
+	/* INV: coerce_to_package() type checks */
+	/* FIXME: list should be a fresh one */
+	p = coerce_to_package(p);
+	@(return p->pack.nicknames)
+@)
+
+@(defun rename_package (pack new_name &o new_nicknames)
+@
+	/* INV: rename_package() type checks and coerces pack to package */
+	@(return rename_package(pack, new_name, new_nicknames))
+@)
+
+@(defun package_use_list (p)
+@
+	/* INV: coerce_to_package() type checks */
+	/* FIXME: list should be a fresh one */
+	p = coerce_to_package(p);
+	@(return p->pack.uses)
+@)
+
+@(defun package_used_by_list (p)
+@
+	/* INV: coerce_to_package() type checks */
+	/* FIXME: list should be a fresh one */
+	p = coerce_to_package(p);
+	@(return p->pack.usedby)
+@)
+
+@(defun package_shadowing_symbols (p)
+@
+	/* INV: coerce_to_package() type checks */
+	/* FIXME: list should be a fresh one */
+	p = coerce_to_package(p);
+	@(return p->pack.shadowings)
+@)
+
+@(defun si::package_lock (p t)
+@
+	/* INV: coerce_to_package() type checks */
+	p = coerce_to_package(p);
+	p->pack.locked = (t != Cnil);
+	@(return p)
+@)
+
+@(defun list_all_packages ()
+@
+	@(return copy_list(package_list))
+@)
+
+@(defun intern (strng &optional (p `current_package()`) &aux sym)
+@
+	sym = intern(strng, p);
+	if (intern_flag == INTERNAL)
+		@(return sym Kinternal)
+	if (intern_flag == EXTERNAL)
+		@(return sym Kexternal)
+	if (intern_flag == INHERITED)
+		@(return sym Kinherited)
+	@(return sym Cnil)
+@)
+
+@(defun find_symbol (strng &optional (p `current_package()`))
+	cl_object x;
+@
+	x = find_symbol(strng, p);
+	if (intern_flag == INTERNAL)
+		@(return x Kinternal)
+	if (intern_flag == EXTERNAL)
+		@(return x Kexternal)
+	if (intern_flag == INHERITED)
+		@(return x Kinherited)
+	@(return Cnil Cnil)
+@)
+
+@(defun unintern (symbl &optional (p `current_package()`))
+@
+	@(return `unintern(symbl, p) ? Ct : Cnil`)
+@)
+
+@(defun export (symbols &o (pack `current_package()`))
+	cl_object l;
+@
+BEGIN:
+	switch (type_of(symbols)) {
+	case t_symbol:
+		if (Null(symbols))
+			break;
+		export(symbols, pack);
+		break;
+
+	case t_cons:
+		pack = coerce_to_package(pack); /* Saves time */
+		for (l = symbols;  !endp(l);  l = CDR(l))
+			export(CAR(l), pack);
+		break;
+
+	default:
+		assert_type_symbol(symbols);
+		goto BEGIN;
+	}
+	@(return Ct)
+@)
+
+@(defun unexport (symbols &o (pack `current_package()`))
+	cl_object l;
+@
+BEGIN:
+	switch (type_of(symbols)) {
+	case t_symbol:
+		if (Null(symbols))
+			break;
+		unexport(symbols, pack);
+		break;
+
+	case t_cons:
+		pack = coerce_to_package(pack); /* Saves time */
+		for (l = symbols;  !endp(l);  l = CDR(l))
+			unexport(CAR(l), pack);
+		break;
+
+	default:
+		assert_type_symbol(symbols);
+		goto BEGIN;
+	}
+	@(return Ct)
+@)
+
+@(defun import (symbols &o (pack `current_package()`))
+	cl_object l;
+@
+BEGIN:
+	switch (type_of(symbols)) {
+	case t_symbol:
+		if (Null(symbols))
+			break;
+		import(symbols, pack);
+		break;
+
+	case t_cons:
+		pack = coerce_to_package(pack); /* Saves time */
+		for (l = symbols;  !endp(l);  l = CDR(l))
+			import(CAR(l), pack);
+		break;
+
+	default:
+		assert_type_symbol(symbols);
+		goto BEGIN;
+	}
+	@(return Ct)
+@)
+
+@(defun shadowing_import (symbols &o (pack `current_package()`))
+	cl_object l;
+@
+BEGIN:
+	switch (type_of(symbols)) {
+	case t_symbol:
+		if (Null(symbols))
+			break;
+		shadowing_import(symbols, pack);
+		break;
+
+	case t_cons:
+		pack = coerce_to_package(pack); /* Saves time */
+		for (l = symbols;  !endp(l);  l = CDR(l))
+			shadowing_import(CAR(l), pack);
+		break;
+
+	default:
+		assert_type_symbol(symbols);
+		goto BEGIN;
+	}
+	@(return Ct)
+@)
+
+@(defun shadow (symbols &o (pack `current_package()`))
+	cl_object l;
+@
+BEGIN:
+	switch (type_of(symbols)) {
+	case t_symbol:
+		if (Null(symbols))
+			break;
+		shadow(symbols, pack);
+		break;
+
+	case t_cons:
+		pack = coerce_to_package(pack); /* Saves time */
+		for (l = symbols;  !endp(l);  l = CDR(l))
+			shadow(CAR(l), pack);
+		break;
+
+	default:
+		assert_type_symbol(symbols);
+		goto BEGIN;
+	}
+	@(return Ct)
+@)
+
+@(defun use_package (pack &o (pa `current_package()`))
+	cl_object l;
+@
+BEGIN:
+	switch (type_of(pack)) {
+	case t_symbol:
+		if (Null(pack))
+			break;
+	case t_string:
+	case t_package:
+		use_package(pack, pa);
+		break;
+
+	case t_cons:
+		pa = coerce_to_package(pa); /* Saves time */
+		for (l = pack;  !endp(l);  l = CDR(l))
+			use_package(CAR(l), pa);
+		break;
+
+	default:
+		assert_type_package(pack);
+		goto BEGIN;
+	}
+	@(return Ct)
+@)
+
+@(defun unuse_package (pack &o (pa `current_package()`))
+	cl_object l;
+@
+BEGIN:
+	switch (type_of(pack)) {
+	case t_symbol:
+		if (Null(pack))
+			break;
+
+	case t_string:
+	case t_package:
+		unuse_package(pack, pa);
+		break;
+
+	case t_cons:
+		pa = coerce_to_package(pa);
+		for (l = pack;  !endp(l);  l = CDR(l))
+			unuse_package(CAR(l), pa);
+		break;
+
+	default:
+		assert_type_package(pack);
+		goto BEGIN;
+	}
+	@(return Ct)
+@)
+
+@(defun si::package_internal (p index)
+	cl_fixnum j;
+	cl_object hash;
+@
+	p = coerce_to_package(p);
+	hash = p->pack.internal;
+	if (!FIXNUMP(index) || (j = fix(index)) < 0 || j >= hash->hash.size)
+		FEerror("~S is an illegal index to a package hashtable.",
+			1, index);
+	@(return ((hash->hash.data[j].key != OBJNULL)?
+		   hash->hash.data[j].value : MAKE_FIXNUM(1)))
+@)
+
+@(defun si::package_external (p index)
+	cl_fixnum j;
+	cl_object hash;
+@
+	p = coerce_to_package(p);
+	hash = p->pack.external;
+	if (!FIXNUMP(index) || (j = fix(index)) < 0 || j >= hash->hash.size)
+		FEerror("~S is an illegal index to a package hashtable.",
+			1, index);
+	@(return ((hash->hash.data[j].key != OBJNULL)?
+		  hash->hash.data[j].value : MAKE_FIXNUM(1)))
+@)
+
+@(defun si::package_size (p)
+@
+	assert_type_package(p);
+	@(return MAKE_FIXNUM(p->pack.external->hash.size)
+		 MAKE_FIXNUM(p->pack.internal->hash.size))
+@)
+
+@(defun delete_package (p)
+@
+	delete_package(p);
+@)
+
+void
+init_package(void)
+{
+	register_root(&package_list);
+	register_root(&uninterned_list);
+
+	lisp_package    = make_package(make_simple_string("COMMON-LISP"),
+				       CONS(make_simple_string("CL"),
+					    CONS(make_simple_string("LISP"),Cnil)),
+				       Cnil);
+	register_root(&lisp_package);
+	user_package    = make_package(make_simple_string("COMMON-LISP-USER"),
+				       CONS(make_simple_string("CL-USER"),
+					    CONS(make_simple_string("USER"),Cnil)),
+				       CONS(lisp_package, Cnil));
+	register_root(&user_package);
+	keyword_package = make_package(make_simple_string("KEYWORD"),
+				       Cnil, Cnil);
+	register_root(&keyword_package);
+	system_package  = make_package(make_simple_string("SI"),
+				       CONS(make_simple_string("SYSTEM"),
+					    CONS(make_simple_string("SYS"),
+						 Cnil)),
+				       CONS(lisp_package, Cnil));
+	register_root(&system_package);
+#ifdef CLOS
+	clos_package    = make_package(make_simple_string("CLOS"),
+				       Cnil,
+				       CONS(lisp_package, Cnil));
+	register_root(&clos_package);
+#endif
+#ifdef TK
+	tk_package      = make_package(make_simple_string("TK"),
+				       Cnil,
+				       CONS(lisp_package, Cnil));
+	register_root(&tk_package);
+#endif
+
+	Cnil->symbol.hpack = lisp_package;
+	import(Cnil, lisp_package);
+	export(Cnil, lisp_package);
+
+	Ct->symbol.hpack = lisp_package;
+	import(Ct, lisp_package);
+	export(Ct, lisp_package);
+
+	/*  There is no need to enter a package as a mark origin.  */
+
+	Vpackage = make_special("*PACKAGE*", lisp_package);
+}
diff --git a/src/c/pathname.d b/src/c/pathname.d
new file mode 100644
index 000000000..b9ac03db6
--- /dev/null
+++ b/src/c/pathname.d
@@ -0,0 +1,1186 @@
+/*
+    pathname.d -- Pathnames.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+	O.S. DEPENDENT
+
+	This file contains those functions that interpret namestrings.
+*/
+
+#include "ecls.h"
+#include <ctype.h>
+
+/******************************* EXPORTS ******************************/
+
+cl_object Vdefault_pathname_defaults;
+cl_object Kwild;
+cl_object Kwild_inferiors;
+cl_object Knewest;
+
+/******************************* ------- ******************************/
+
+cl_object Khost;
+cl_object Kdevice;
+cl_object Kdirectory;
+cl_object Kname;
+cl_object Ktype;
+cl_object Kversion;
+cl_object Kdefaults;
+
+cl_object Kabsolute;
+cl_object Krelative;
+cl_object Kup;
+
+static cl_object pathname_translations = Cnil;
+
+static void
+error_directory(cl_object d) {
+	FEerror("make-pathname: ~A is not a valid directory", 1, d);
+}
+
+cl_object
+make_pathname(cl_object host, cl_object device, cl_object directory,
+	      cl_object name, cl_object type, cl_object version)
+{
+	cl_object x;
+
+	if (!endp(directory) &&
+	    CAR(directory) != Kabsolute &&
+	    CAR(directory) != Krelative)
+		error_directory(directory);
+	x = alloc_object(t_pathname);
+	x->pathname.logical = FALSE;
+	x->pathname.host = host;
+	x->pathname.device = device;
+	x->pathname.directory = directory;
+	x->pathname.name = name;
+	x->pathname.type = type;
+	x->pathname.version = version;
+	return(x);
+}
+
+
+static cl_object
+tilde_expand(cl_object directory)
+{
+	cl_object head, prefix;
+	
+	if (endp(directory))
+		goto RET;
+	/* If path is absolute or null, we have nothing
+	   to expand */
+	head = CAR(directory);
+	if (head == Kabsolute)
+		goto RET;
+	/* If path is relative and not empty, we search
+	   for heading tilde */
+	if (head != Krelative)
+		error_directory(directory);
+	head = CADR(directory);
+	if (type_of(head) != t_string)
+		goto RET;
+	if (head->string.fillp == 0 || head->string.self[0] != '~')
+		goto RET;
+	prefix = homedir_pathname(head)->pathname.directory;
+	directory = append(prefix, CDDR(directory));
+ RET:
+	return directory;
+}
+
+#define WORD_INCLUDE_DELIM 1
+#define WORD_ALLOW_ASTERISK  2
+#define WORD_EMPTY_IS_NIL 4
+#define WORD_LOGICAL 8
+
+static cl_object
+make_one(const char *s, cl_index end)
+{
+	cl_object x = alloc_simple_string(end);
+	x->string.self = alloc(end+1);
+	memcpy(x->string.self, s, end);
+	x->string.self[end] = '\0';
+	return(x);
+}
+
+/*
+ * Parses a word from string `S' until either:
+ *	1) character `DELIM' is found
+ *	2) end of string is reached
+ *	3) a non valid character is found
+ * Output is either
+ *	1) :error in case (3) above
+ *	2) :wild, :wild-inferiors, :up
+ *	3) "" or Cnil when word has no elements
+ *	5) A non empty string
+ */
+static cl_object
+parse_word(const char *s, char delim, int flags, cl_index start, cl_index end,
+	   cl_index *end_of_word)
+{
+	volatile cl_index i, j;
+	for (i = j = start; i < end && s[i] != delim; i++) {
+		char c = s[i];
+		bool valid_char;
+		if (c == '*') {
+			if (!(flags & WORD_ALLOW_ASTERISK))
+				valid_char = FALSE; /* Asterisks not allowed in this word */
+			else if (i > start && s[i-1] == '*' && end > start + 2)
+				valid_char = FALSE; /* "**" surrounded by other characters! */
+			else
+				valid_char = TRUE; /* single "*" */
+		}			
+#if 0
+		else if (flags & WORD_LOGICAL)
+			valid_char = is_upper(c) || is_digit(c) || c == '-';
+#endif
+		else
+			valid_char = c != 0;
+		if (!valid_char) {
+			*end_of_word = start;
+			return Kerror;
+		}
+	}
+	if (i < end)
+		*end_of_word = i+1;
+	else {
+		*end_of_word = end;
+		if (flags & WORD_INCLUDE_DELIM) {
+			*end_of_word = start;
+			return Cnil;
+		}
+	}
+	s += j;
+	switch(i-j) {
+	case 0:
+		if (flags & WORD_EMPTY_IS_NIL)
+			return Cnil;
+		return null_string;
+	case 1:
+		if (s[0] == '*')
+			return Kwild;
+		break;
+	case 2:
+		if (s[0] == '*' && s[1] == '*')
+			/* :wild-inferiors not supported in pathnames */
+			return Kerror;
+		if (!(flags & WORD_LOGICAL) && s[0] == '.' && s[1] == '.')
+			return Kup;
+		break;
+	}
+	return make_one(s, i-j);
+}
+
+/*
+ * Parses a logical or physical directory tree. Output is always a
+ * list of valid directory components, which may be just NIL.
+ *
+ * INV: When parsing of directory components has failed, a valid list
+ * is also returned, and it will be later in the parsing of
+ * pathname-name or pathname-type when the same error is detected.
+ */
+
+static cl_object
+parse_directories(const char *s, int flags, cl_index start, cl_index end,
+		  cl_index *end_of_dir)
+{
+	cl_index i, j;
+	cl_object path = Cnil;
+	cl_object *plast = &path;
+	char delim = (flags & WORD_LOGICAL) ? ';' : '/';
+
+	flags |= WORD_INCLUDE_DELIM | WORD_ALLOW_ASTERISK;
+	*end_of_dir = start;
+	for (i = j = start; i < end; j = i) {
+		cl_object word = parse_word(s, delim, flags, j, end, &i);
+		if (word == Kerror || word == Cnil)
+			break;
+		if (word == null_string) {	/* just "/" or ";" */
+			if (j != start) {
+				if (flags & WORD_LOGICAL)
+					return Kerror;
+				continue;
+			}
+			word = (flags & WORD_LOGICAL) ? Krelative : Kabsolute;
+		}
+		*end_of_dir = i;
+		plast = &CDR(*plast = CONS(word, Cnil));
+	}
+	return path;
+}
+
+bool
+logical_hostname_p(cl_object host)
+{
+	if (type_of(host) != t_string)
+		return FALSE;
+	return assoc(host, pathname_translations) != Cnil;
+}
+
+/*
+ * Parses a lisp namestring until the whole substring is parsed or an
+ * error is found. It returns a valid pathname or NIL, plus the place
+ * where parsing ended in *END_OF_PARSING.
+ *
+ * The rules are as follows:
+ *
+ * 1) If a hostname is supplied it determines whether the namestring
+ *    will be parsed as logical or as physical.
+ *
+ * 2) If no hostname is supplied, first it tries parsing using logical
+ *    pathname rules and, if no logical hostname is found, then it
+ *    tries the physical pathname format.
+ *
+ * 3) Logical pathname syntax:
+ *	[logical-hostname:][;][logical-directory-component;][pathname-name][.pathname-type]
+ *
+ * 4) Physical pathname syntax:
+ *	[device:][[//hostname]/][directory-component/]*[pathname-name][.pathname-type]
+ *
+ *	logical-hostname, device, hostname = word
+ *	logical-directory-component = word | wildcard-word
+ *	directory-component = word | wildcard-word | '..' | '.'
+ *	pathname-name, pathname-type = word | wildcard-word | ""
+ *
+ */
+cl_object
+parse_namestring(const char *s, cl_index start, cl_index end, cl_index *ep,
+		 cl_object default_host)
+{
+	cl_object host, device, path, name, type;
+	bool logical;
+
+	/* We first try parsing as logical-pathname. In case of
+	 * failure, physical-pathname parsing is performed only when
+	 * there is no supplied *logical* host name. All other failures
+	 * result in Cnil as output.
+	 */
+	host = parse_word(s, ':', WORD_LOGICAL | WORD_INCLUDE_DELIM, start, end, ep);
+	if (default_host != Cnil) {
+		if (host == Cnil || host == Kerror)
+			host = default_host;
+		else if (!equal(default_host, host))
+			return Cnil;
+	}
+	if (!logical_hostname_p(host))
+		goto physical;
+	/*
+	 * Logical pathname format:
+	 *	[logical-hostname:][;][logical-directory-component;][pathname-name][.pathname-type]
+	 */
+	logical = TRUE;
+	device = Cnil;
+	path = parse_directories(s, WORD_LOGICAL, *ep, end, ep);
+	if (path == Kerror)
+		return Cnil;
+	if (!endp(path) && CAR(path) != Krelative)
+		path = CONS(Kabsolute, path);
+	name = parse_word(s, '.', WORD_LOGICAL | WORD_ALLOW_ASTERISK | WORD_EMPTY_IS_NIL, *ep, end, ep);
+	type = parse_word(s, '\0', WORD_LOGICAL | WORD_ALLOW_ASTERISK | WORD_EMPTY_IS_NIL, *ep, end, ep);
+	if (type == Kerror)
+		return Cnil;
+	goto make_it;
+ physical:
+	/*
+	 * Physical pathname format:
+	 *	[device:][[//hostname]/][directory-component/]*[pathname-name][.pathname-type]
+	 */
+	logical = FALSE;
+	device = parse_word(s, ':', WORD_INCLUDE_DELIM | WORD_EMPTY_IS_NIL,
+			    start, end, ep);
+	if (device == Kerror)
+		device = Cnil;
+	else if (device != Cnil) {
+		if (type_of(device) != t_string)
+			return Cnil;
+		if (strcmp(device->string.self, "file") == 0)
+			device = Cnil;
+	}
+	start = *ep;
+	if (start <= end - 2 && s[start] == '/' && s[start+1] == '/')
+		host = parse_word(s, '/', WORD_EMPTY_IS_NIL, start, end, ep);
+	else
+		host = Cnil;
+	if (host == Kerror)
+		host = Cnil;
+	else if (host != Cnil) {
+		if (type_of(host) != t_string || !equal(host, default_host))
+			return Cnil;
+	}
+	path = parse_directories(s, 0, *ep, end, ep);
+	if (path == Kerror)
+		return Cnil;
+	if (!endp(path)) {
+		if (CAR(path) == Kabsolute) {
+			/* According to ANSI CL, "/.." is erroneous */
+			if (cadr(path) == Kup)
+				return Cnil;
+		} else  {
+			/* If path is relative and we got here, then it
+			   has no :RELATIVE/:ABSOLUTE in front of it and we add one.
+			   Pathnames with hostnames are always absolute.
+			*/
+			path = CONS(host == Cnil? Krelative : Kabsolute, path);
+			path = tilde_expand(path);
+		}
+	}
+	name = parse_word(s, '.', WORD_ALLOW_ASTERISK | WORD_EMPTY_IS_NIL, *ep,
+			  end, ep);
+	type = parse_word(s, '\0', WORD_ALLOW_ASTERISK | WORD_EMPTY_IS_NIL, *ep,
+			  end, ep);
+	if (type == Kerror)
+		return Cnil;
+ make_it:
+	if (*ep >= end) *ep = end;
+	path = make_pathname(host, device, path, name, type, Cnil);
+	path->pathname.logical = logical;
+	return path;
+}
+
+cl_object
+coerce_to_pathname(cl_object x)
+{
+	cl_object y;
+	cl_index e;
+
+L:
+	switch (type_of(x)) {
+	case t_string:
+                /* !!!!! Bug Fix. NLG */
+		y = parse_namestring(x->string.self, 0, x->string.fillp, &e,Cnil);
+		if (y == Cnil || e != x->string.fillp)
+		  FEerror("~S is not a valid pathname string", 1, x);
+		return(y);
+
+	case t_pathname:
+		return(x);
+
+	case t_stream:
+		switch ((enum smmode)x->stream.mode) {
+		case smm_closed:
+		case smm_input:
+		case smm_output:
+		case smm_probe:
+		case smm_io:
+			x = x->stream.object1;
+			/*
+				The file was stored in stream.object1.
+				See open.
+			*/
+			goto L;
+
+		case smm_synonym:
+			x = symbol_value(x->stream.object0);
+			goto L;
+		default:
+		}
+	default:
+		FEerror("~S cannot be coerced to a pathname.", 1, x);
+	}
+}
+
+cl_object
+coerce_to_file_pathname(cl_object pathname)
+{
+	pathname = coerce_to_physical_pathname(pathname);
+	if (pathname->pathname.device != Cnil)
+		FEerror("Device ~S not yet supported.", 1,
+			pathname->pathname.device);
+	if (pathname->pathname.host != Cnil)
+		FEerror("Access to remote files not yet supported.", 0);
+	return pathname;
+}
+
+static cl_object translate_logical_pathname(cl_object x);
+
+cl_object
+coerce_to_physical_pathname(cl_object x)
+{
+	x = coerce_to_pathname(x);
+	if (x->pathname.logical)
+	  return translate_logical_pathname(x);
+	return x;
+}
+
+cl_object
+coerce_to_filename(cl_object pathname)
+{
+	cl_object namestring;
+
+	pathname = coerce_to_file_pathname(pathname);
+	namestring = coerce_to_namestring(pathname);
+	if (namestring->string.fillp >= MAXPATHLEN - 16)
+		FEerror("Too long filename: ~S.", 1, namestring);
+	return namestring;
+}
+
+cl_object
+default_device(cl_object host)
+{
+	return Cnil;
+}
+
+cl_object
+merge_pathnames(cl_object path, cl_object defaults, cl_object default_version)
+{
+	cl_object host, device, directory, name, type, version;
+
+	defaults = coerce_to_pathname(defaults);
+	if (type_of(path) == t_string) {
+		cl_index foo;
+		cl_object aux = parse_namestring(path->string.self, 0,
+						 path->string.fillp, &foo,
+						 default_version->pathname.host);
+		if (aux != Cnil) path = aux;
+	}
+	if (type_of(path) != t_pathname)
+		path = coerce_to_pathname(path);
+	if (Null(path->pathname.host))
+		host = defaults->pathname.host;
+	else
+		host = path->pathname.host;
+	if (Null(path->pathname.device))
+		if (Null(path->pathname.host))
+			device = defaults->pathname.device;
+		else if (path->pathname.host == defaults->pathname.host)
+			device = defaults->pathname.device;
+		else
+			device = default_device(path->pathname.host);
+	else
+		device = path->pathname.device;
+	if (Null(path->pathname.directory))
+		directory = defaults->pathname.directory;
+	else if (CAR(path->pathname.directory) == Kabsolute)
+		directory = path->pathname.directory;
+	else if (!Null(defaults->pathname.directory))
+		directory = append(defaults->pathname.directory,
+				   CDR(path->pathname.directory));
+	else
+		directory = path->pathname.directory;
+	if (Null(path->pathname.name))
+		name = defaults->pathname.name;
+	else
+		name = path->pathname.name;
+	if (Null(path->pathname.type))
+		type = defaults->pathname.type;
+	else
+		type = path->pathname.type;
+	version = Cnil;
+	/*
+		In this implementation, version is not considered
+	*/
+	defaults = make_pathname(host, device, directory, name, type, version);
+	defaults->pathname.logical = path->pathname.logical;
+	return defaults;
+}
+
+static void
+push_c_string(cl_object buffer, const char *s, cl_index length)
+{
+	cl_index fillp = buffer->string.fillp;
+	cl_index dim = buffer->string.dim;
+	char *dest = buffer->string.self;
+
+	if (type_of(buffer) != t_string)
+		internal_error("push_c_string");
+	for (; length; length--, s++) {
+		dest[fillp++] = *s;
+		if (fillp >= dim) {
+			char *new_dest = alloc_atomic(dim += 32);
+			memcpy(new_dest, dest, fillp);
+			buffer->string.dim = dim;
+			buffer->string.self = new_dest;
+			dest = new_dest;
+		}
+	}
+	buffer->string.fillp = fillp;
+}
+
+static void
+push_string(cl_object buffer, cl_object string)
+{
+	string = coerce_to_string_designator(string);
+	push_c_string(buffer, string->string.self, string->string.fillp);
+}
+
+/*
+	namestring(x) converts a pathname to a namestring.
+*/
+cl_object
+namestring(cl_object x)
+{
+	cl_object l, y;
+	bool logical;
+	cl_object buffer, host;
+
+	buffer = cl_token;
+	buffer->string.fillp = 0;
+	logical = x->pathname.logical;
+	host = x->pathname.host;
+	if (logical) {
+		if (host != Cnil) {
+			push_string(buffer, host);
+			push_c_string(buffer, ":", 1);
+		}
+	} else {
+		if ((y = x->pathname.device) != Cnil) {
+			push_string(buffer, y);
+			push_c_string(buffer, ":", 1);
+		}
+		if (host != Cnil) {
+			if (y == Cnil)
+				push_c_string(buffer, "file:", 5);
+			push_c_string(buffer, "//", 2);
+			push_string(buffer, host);
+		}
+	}
+	l = x->pathname.directory;
+	if (endp(l))
+		goto L;
+	y = CAR(l);
+	if (y == Krelative) {
+		if (logical)
+			push_c_string(buffer, ":", 1);
+	} else if (y == Kabsolute) {
+		if (!logical)
+			push_c_string(buffer, "/", 1);
+	} else
+		FEerror("namestring: ~A is not a valid directory list",1, l);
+	l = CDR(l);
+	for (;  !endp(l);  l = CDR(l)) {
+		y = CAR(l);
+		if (y == Kup) {
+			push_c_string(buffer, "..", 2);
+		} else if (y == Kwild) {
+			push_c_string(buffer, "*", 1);
+		} else if (y == Kwild_inferiors) {
+			push_c_string(buffer, "**", 2);
+		} else {
+			push_string(buffer, y);
+		}
+		push_c_string(buffer, logical? ";" : "/", 1);
+	}
+L:
+	if (Null(y = x->pathname.name))
+		goto M;
+	if (y == Kwild) {
+		push_c_string(buffer, "*", 1);
+		goto M;
+	}
+	if (type_of(y) != t_string)
+		FEerror("~S is an illegal pathname name.", 1, y);
+	push_string(buffer, y);
+M:
+	if (Null(y = x->pathname.type))
+		goto N;
+	if (y == Kwild) {
+		push_c_string(buffer, ".*", 2);
+		goto N;
+	}
+	if (type_of(y) != t_string)
+		FEerror("~S is an illegal pathname type.", 1, y);
+	push_c_string(buffer, ".", 1);
+	push_string(buffer, y);
+N:
+	return(copy_simple_string(cl_token));
+}
+
+cl_object
+coerce_to_namestring(cl_object x)
+{
+	cl_object y;
+L:
+	switch (type_of(x)) {
+	case t_string:
+		if (x->string.self[0] != '~')
+		  return(x);
+		/* added by E. Wang */
+		return(namestring(coerce_to_pathname(x)));
+
+	case t_pathname:
+		return(namestring(x));
+
+	case t_stream:
+		switch ((enum smmode)x->stream.mode) {
+		case smm_input:
+		case smm_output:
+		case smm_probe:
+		case smm_io:
+			x = x->stream.object1;
+			/*
+				The file was stored in stream.object1.
+				See open.
+			*/
+			goto L;
+
+		case smm_synonym:
+			x = symbol_value(x->stream.object0);
+			goto L;
+
+		default:
+			goto CANNOT_COERCE;
+		}
+
+	default:
+	CANNOT_COERCE:
+		FEerror("~S cannot be coerced to a namestring.", 1, x);
+	}
+}
+
+@(defun pathname (name)
+@	/* INV: coerce_to_pathname() checks types */
+	@(return coerce_to_pathname(name))
+@)
+
+@(defun parse_namestring (thing
+	&o host
+	   (defaults symbol_value(Vdefault_pathname_defaults))
+	&k (start MAKE_FIXNUM(0)) end junk_allowed
+	&a x y)
+	cl_index s, e, ee;
+@
+	/* INV: coerce_to_pathname() checks types */
+	/* defaults is ignored */
+	x = thing;
+L:
+	switch (type_of(x)) {
+	case t_string:
+		get_string_start_end(x, start, end, &s, &e);
+		y = parse_namestring(x->string.self, s, e - s, &ee, host);
+		if (Null(junk_allowed)) {
+			if (y == Cnil || ee != e - s)
+				FEerror("Cannot parse the namestring ~S~%\nfrom ~S to ~S.",
+					3, x, start, end);
+		} else {
+			if (y == Cnil)
+				@(return Cnil `MAKE_FIXNUM(s + ee)`)
+		}
+		if (logical_hostname_p(host) && y != Cnil && !y->pathname.logical) {
+			if (Null(junk_allowed))
+				FEerror("A logical pathname was expected instead of ~S", 1, thing);
+			else
+				@(return Cnil `MAKE_FIXNUM(s + ee)`);
+		}
+		start = MAKE_FIXNUM(s + ee);
+		break;
+		
+	case t_pathname:
+		y = x;
+		break;
+		
+	case t_stream:
+		switch ((enum smmode)x->stream.mode) {
+		case smm_input:
+		case smm_output:
+		case smm_probe:
+		case smm_io:
+			x = x->stream.object1;
+			/*
+				The file was stored in stream.object1.
+				See open.
+			*/
+			goto L;
+
+		case smm_synonym:
+			x = symbol_value(x->stream.object0);
+			goto L;
+
+		default:
+			goto CANNOT_PARSE;
+		}
+
+	default:
+	CANNOT_PARSE:
+		FEerror("Object ~S does not contain a valid namestring.", 1, x);
+	}
+	@(return y start)
+@)
+
+@(defun merge_pathnames (path
+	&o (defaults symbol_value(Vdefault_pathname_defaults))
+ 	   (default_version Knewest))
+@
+	/* INV: coerce_to_pathname() checks types */
+	path = coerce_to_pathname(path);
+	defaults = coerce_to_pathname(defaults);
+	@(return merge_pathnames(path, defaults, default_version))
+@)
+
+@(defun make_pathname (&key host device directory name
+			    type version defaults
+		       &aux x)
+@
+	if (Null(defaults)) {
+		defaults
+		= symbol_value(Vdefault_pathname_defaults);
+		defaults = coerce_to_pathname(defaults);
+		defaults
+		= make_pathname(defaults->pathname.host,
+			        Cnil, Cnil, Cnil, Cnil, Cnil);
+	} else
+		defaults = coerce_to_pathname(defaults);
+	x = make_pathname(host, device, directory, name, type, version);
+	x = merge_pathnames(x, defaults, Cnil);
+	@(return x)
+@)
+
+@(defun pathnamep (pname)
+@
+	@(return ((type_of(pname) == t_pathname)? Ct : Cnil))
+@)
+
+@(defun si::logical_pathname_p (pname)
+@
+	@(return ((type_of(pname) == t_pathname && pname->pathname.logical)?
+		  Ct : Cnil))
+@)
+
+@(defun pathname_host (pname)
+@
+	/* INV: coerce_to_pathname() checks types */
+	pname = coerce_to_pathname(pname);
+	@(return pname->pathname.host)
+@)
+
+@(defun pathname_device (pname)
+@
+	/* INV: coerce_to_pathname() checks types */
+	pname = coerce_to_pathname(pname);
+	@(return pname->pathname.device)
+@)
+
+@(defun pathname_directory (pname)
+@
+	/* INV: coerce_to_pathname() checks types */
+	pname = coerce_to_pathname(pname);
+	@(return pname->pathname.directory)
+@)
+
+@(defun pathname_name (pname)
+@
+	/* INV: coerce_to_pathname() checks types */
+	pname = coerce_to_pathname(pname);
+	@(return pname->pathname.name)
+@)
+
+@(defun pathname_type (pname)
+@
+	/* INV: coerce_to_pathname() checks types */
+	pname = coerce_to_pathname(pname);
+	@(return pname->pathname.type)
+@)
+
+@(defun pathname_version (pname)
+@
+	/* INV: coerce_to_pathname() checks types */
+	pname = coerce_to_pathname(pname);
+	@(return  pname->pathname.version)
+@)
+
+@(defun namestring (pname)
+@
+	/* INV: coerce_to_pathname() checks types */
+	@(return coerce_to_namestring(pname))
+@)
+
+@(defun file_namestring (pname)
+@
+	/* INV: coerce_to_filename() checks types */
+	pname = coerce_to_filename(pname);
+	@(return namestring(make_pathname(Cnil, Cnil, Cnil,
+					     pname->pathname.name,
+					     pname->pathname.type,
+					     pname->pathname.version)))
+@)
+
+@(defun directory_namestring (pname)
+@
+	/* INV: coerce_to_pathname() checks types */
+	pname = coerce_to_pathname(pname);
+	@(return namestring(make_pathname(Cnil, Cnil,
+					     pname->pathname.directory,
+					     Cnil, Cnil, Cnil)))
+@)
+
+@(defun host_namestring (pname)
+@
+	/* INV: coerce_to_pathname() checks types */
+	pname = coerce_to_pathname(pname);
+	pname = pname->pathname.host;
+	if (Null(pname) || pname == Kwild)
+		pname = null_string;
+	@(return pname)
+@)
+
+@(defun enough_namestring (path
+	&o (defaults symbol_value(Vdefault_pathname_defaults)))
+	cl_object newpath;
+@
+	/* INV: coerce_to_pathname() checks types */
+	defaults = coerce_to_pathname(defaults);
+	path = coerce_to_pathname(path);
+	newpath
+	= make_pathname(equalp(path->pathname.host, defaults->pathname.host) ?
+			Cnil : path->pathname.host,
+	                equalp(path->pathname.device,
+			       defaults->pathname.device) ?
+			Cnil : path->pathname.device,
+	                equalp(path->pathname.directory,
+			       defaults->pathname.directory) ?
+			Cnil : path->pathname.directory,
+	                equalp(path->pathname.name, defaults->pathname.name) ?
+			Cnil : path->pathname.name,
+	                equalp(path->pathname.type, defaults->pathname.type) ?
+			Cnil : path->pathname.type,
+	                equalp(path->pathname.version,
+			       defaults->pathname.version) ?
+			Cnil : path->pathname.version);
+	newpath->pathname.logical = path->pathname.logical;
+	@(return namestring(newpath))
+@)
+
+/* --------------- PATHNAME MATCHING ------------------ */
+
+static bool path_item_match(cl_object a, cl_object mask);
+
+static bool
+do_path_item_match(const char *s, const char *p) {
+	const char *next;
+	while (*s) {
+	  if (*p == '*') {
+	    /* Match any group of characters */
+	    next = p+1;
+	    while (*s && *s != *next) s++;
+	    if (do_path_item_match(s,next))
+	      return TRUE;
+	    /* starts back from the '*' */
+	    if (!*s)
+	      return FALSE;
+	    s++;
+	  } else if (*s != *p)
+	    return FALSE;
+	  else
+	    s++, p++;
+	}
+	return (*p == 0);
+}
+
+static bool
+path_item_match(cl_object a, cl_object mask) {
+	if (mask == Kwild || mask == Cnil)
+		return TRUE;
+	if (type_of(a) != t_string)
+		return (a == mask);
+	if (type_of(mask) != t_string)
+		FEerror("~S is not supported as mask for pathname-match-p", 1, mask);
+	return do_path_item_match(a->string.self, mask->string.self);
+}
+
+bool
+pathname_match_p(cl_object path, cl_object mask)
+{
+	cl_object a, b;
+	path = coerce_to_pathname(path);
+	mask = coerce_to_pathname(mask);
+	if (path->pathname.logical != mask->pathname.logical)
+		return FALSE;
+#if 0
+	if (!path_item_match(path->pathname.host, mask->pathname.host))
+		return FALSE;
+#endif 
+	a = path->pathname.directory;
+	b = mask->pathname.directory;
+	while (!endp(a)) {
+		if (endp(b))
+			/* Directory tree lengths do not match */
+			return FALSE;
+		if (!path_item_match(CAR(a), CAR(b)))
+			return FALSE;
+		a = CDR(a);
+		b = CDR(b);
+	}
+	if (a != b)
+		/* Directory tree lengths do not match */
+		return FALSE;
+	if (!path_item_match(path->pathname.name, mask->pathname.name))
+		return FALSE;
+	if (!path_item_match(path->pathname.type, mask->pathname.type))
+		return FALSE;
+	if (!path_item_match(path->pathname.version, mask->pathname.version))
+		return FALSE;
+	return TRUE;
+}
+
+@(defun pathname_match_p (path mask)
+@
+	@(return (pathname_match_p(path, mask)? Ct : Cnil))
+@)
+
+/* --------------- PATHNAME TRANSLATIONS ------------------ */
+
+static cl_object
+coerce_to_from_pathname(cl_object x, cl_object host)
+{
+	cl_object y;
+	cl_index e;
+
+	switch (type_of(x)) {
+	case t_string:
+                /* !!!!! Bug Fix. NLG */
+		y = parse_namestring(x->string.self, 0, x->string.fillp, &e, host);
+		if (y == Cnil || e != x->string.fillp)
+			FEerror("~S is not a valid pathname string", 1, x);
+		x = y;
+	case t_pathname:
+		if (x->pathname.logical)
+			return x;
+	default:
+		return Cnil;
+	}
+}
+
+@(defun si::pathname_translations (host &optional (set OBJNULL))
+	cl_index aux;
+	cl_object pair, l;
+@
+	/* Check that host is a valid host name */
+	assert_type_string(host);
+	aux = host->string.fillp;
+	parse_word(host->string.self, '\0', WORD_LOGICAL, 0, aux, &aux);
+	if (aux != host->string.fillp)
+		FEerror("Wrong host syntax ~S", 1, host);
+
+	/* Find its translation list */
+	pair = assoc(host, pathname_translations);
+	if (set == OBJNULL)
+		@(return ((pair == Cnil)? Cnil : CADR(pair)))
+
+	/* Set the new translation list */
+	assert_type_list(set);
+	if (pair == Cnil) {
+		pair = CONS(host, CONS(Cnil, Cnil));
+		pathname_translations = CONS(pair, pathname_translations);
+	}
+	for (l = set, set = Cnil; !endp(l); l = CDR(l)) {
+		cl_object item = CAR(l);
+		cl_object from = coerce_to_from_pathname(car(item), host);
+		cl_object to = coerce_to_pathname(cadr(item));
+		if (type_of(from) != t_pathname || !from->pathname.logical)
+		  FEerror("~S is not a valid from-pathname translation", 1, from);
+		if (type_of(to) != t_pathname)
+		  FEerror("~S is not a valid to-pathname translation", 1, from);
+		set = CONS(CONS(from, CONS(to, Cnil)), set);
+	}
+	CADR(pair) = Lreconc(2, set, Cnil);
+	@(return set)
+@)
+
+static cl_object
+find_wilds(cl_object l, cl_object source_item, cl_object match)
+{
+	const char *a, *b;
+	cl_index i, j, k, ia, ib;
+
+	if (match == Kwild || match == Cnil)
+		return CONS(source_item, Cnil);
+	if (match == Kwild_inferiors)
+		FEerror(":wild-inferiors not yet supported", 0);
+	if (type_of(match) != t_string || type_of(source_item) != t_string) {
+		if (match != source_item)
+			return Kerror;
+		return l;
+	}
+	a  = source_item->string.self;
+	ia = source_item->string.fillp;
+	b  = match->string.self;
+	ib = match->string.fillp;
+	for(i = j = 0; i < ia && j < ib; ) {
+		if (b[j] == '*') {
+			for (j++, k = i; k < ia && a[k] != b[j]; k++)
+				;
+			l = CONS(make_one(&a[i], k-i), l);
+			i = k;
+			continue;
+		}
+		if (a[i] != b[j])
+			return Kerror;
+		i++, j++;
+	}
+	if (i < ia || j < ib)
+		return Kerror;
+	return l;
+}
+
+static cl_object
+copy_wildcards(cl_object *wilds_list, cl_object template)
+{
+	char *s;
+	cl_index i, l, j;
+	bool new_string;
+	cl_object wilds = *wilds_list;
+
+	if (template == Kwild || template == Cnil) {
+		if (endp(wilds))
+			return Kerror;
+		template = CAR(wilds);
+		*wilds_list = CDR(wilds);
+		return template;
+	}
+	if (type_of(template) != t_string)
+		return template;
+
+	new_string = FALSE;
+	s = template->string.self;
+	l = template->string.fillp;
+	cl_token->string.fillp = 0;
+
+	for (j = i = 0; i < l; ) {
+		if (s[i] != '*') {
+			i++;
+			continue;
+		}
+		if (i != j)
+			push_c_string(cl_token, &s[j], i-j);
+		new_string = TRUE;
+		if (endp(wilds))
+			return Kerror;
+		push_string(cl_token, CAR(wilds));
+		wilds = CDR(wilds);
+		j = i++;
+	}
+	/* Only create a new string when needed */
+	if (new_string)
+		template = copy_simple_string(cl_token);
+	*wilds_list = wilds;
+	return template;
+}
+
+cl_object
+translate_pathname(cl_object source, cl_object from, cl_object to)
+{
+	cl_object wilds, out, a, b, c, d, *pc;
+
+	source = coerce_to_pathname(source);
+	from = coerce_to_pathname(from);
+	to = coerce_to_pathname(to);
+
+	if (source->pathname.logical != from->pathname.logical)
+		goto error;
+	out = alloc_object(t_pathname);
+	out->pathname.logical = to->pathname.logical;
+
+	/* Match host names */
+	if (!equal(source->pathname.host, from->pathname.host))
+		goto error;
+	out->pathname.host = to->pathname.host;
+
+	/* Match devices */
+	if (!equal(source->pathname.device, from->pathname.device))
+		goto error;
+	out->pathname.device = to->pathname.device;
+
+	/* Match directories */
+	wilds = Cnil;
+	a = source->pathname.directory;
+	b = from->pathname.directory;
+	while (!endp(a) && !endp(b)) {
+		wilds = find_wilds(wilds, CAR(a), CAR(b));
+		if (wilds == Kerror) goto error;
+		a = CDR(a);
+		b = CDR(b);
+	}
+	Lreconc(2, wilds, Cnil);
+	if (a != Cnil || b != Cnil)
+		goto error;
+	for (c = Cnil, pc = &c, b = to->pathname.directory; !endp(b); b = CDR(b)) {
+		d = copy_wildcards(&wilds, CAR(b));
+		if (d == Kerror) goto error2;
+		*pc = CONS(d, Cnil);
+		pc = &CDR(*pc);
+	}
+	if (wilds != Cnil)
+		goto error2;
+	out->pathname.directory = c;
+
+	/* Match name */
+	wilds = find_wilds(Cnil, source->pathname.name, from->pathname.name);
+	if (wilds == Kerror) goto error2;
+	d = copy_wildcards(&wilds, to->pathname.name);
+	if (d == Kerror || wilds != Cnil) goto error2;
+	out->pathname.name = d;
+
+	/* Match type */
+	wilds = find_wilds(Cnil, source->pathname.type, from->pathname.type);
+	if (wilds == Kerror) goto error2;
+	d = copy_wildcards(&wilds, to->pathname.type);
+	if (d == Kerror || wilds != Cnil) goto error2;
+	out->pathname.type = d;
+
+	/* Match version */
+#if 0
+	wilds = find_wilds(Cnil, source->pathname.version, from->pathname.version);
+	if (wilds == Kerror) goto error2;
+	d = copy_wildcards(&wilds, to->pathname.version);
+	if (d == Kerror || wilds != Cnil) goto error2;
+	out->pathname.version = d;
+#else
+	out->pathname.version = Cnil;
+#endif
+	return out;
+
+ error:
+	FEerror("~S is not a specialization of path ~S", 2, source, from);
+ error2:
+	FEerror("Number of wildcards in ~S do not match  ~S", 2, from, to);
+}
+
+@(defun translate_pathname (source from to)
+@
+	@(return translate_pathname(source, from, to))
+@)
+
+static cl_object
+translate_logical_pathname(cl_object source)
+{
+	cl_object l, pair;
+	source = coerce_to_pathname(source);
+	if (!source->pathname.logical)
+		goto error;
+ begin:
+	l = siLpathname_translations(1, source->pathname.host, Cnil);
+	for(; !endp(l); l = CDR(l)) {
+		pair = CAR(l);
+		if (pathname_match_p(source, CAR(pair))) {
+			source = translate_pathname(source, CAR(pair), CADR(pair));
+			if (source->pathname.logical)
+				goto begin;
+			return source;
+		}
+	}
+ error:
+	FEerror("~S admits no logical pathname translations", 1, source);
+}
+
+@(defun translate_logical_pathname (source)
+@
+	@(return translate_logical_pathname(source))
+@)
+
+void
+init_pathname(void)
+{
+	SYM_VAL(Vdefault_pathname_defaults) =
+	  make_pathname(Cnil, Cnil, Cnil, Cnil, Cnil, Cnil);
+}
diff --git a/src/c/predicate.d b/src/c/predicate.d
new file mode 100644
index 000000000..7c764d74e
--- /dev/null
+++ b/src/c/predicate.d
@@ -0,0 +1,515 @@
+/*
+    predicate.c -- Predicates.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+@(defun identity (x)
+@
+	@(return x)
+@)
+
+@(defun null (x)
+@
+	@(return (Null(x) ? Ct : Cnil))
+@)
+
+@(defun symbolp (x)
+@
+	@(return (SYMBOLP(x) ? Ct : Cnil))
+@)
+
+@(defun atom (x)
+@
+	@(return (ATOM(x) ? Ct : Cnil))
+@)
+
+@(defun consp (x)
+@
+	@(return (CONSP(x) ? Ct : Cnil))
+@)
+
+@(defun listp (x)
+@
+	@(return ((Null(x) || CONSP(x)) ? Ct : Cnil))
+@)
+
+@(defun numberp (x)
+	enum type t;
+@
+	t = type_of(x);
+	@(return (NUMBER_TYPE(t) ? Ct : Cnil))
+@)
+
+/*	Used in compiled code		*/
+bool numberp(cl_object x)
+{
+  enum type t = type_of(x);
+  return(NUMBER_TYPE(t));
+}
+
+@(defun integerp (x)
+	enum type t;
+@
+	t = type_of(x);
+	@(return ((t == t_fixnum || t == t_bignum) ? Ct : Cnil))
+@)
+
+@(defun rationalp (x)
+	enum type t;
+@
+	t = type_of(x);
+	@(return ((t == t_fixnum || t == t_bignum || t == t_ratio) ? Ct : Cnil))
+@)
+
+@(defun floatp (x)
+	enum type t;
+@
+	t = type_of(x);
+	@(return ((t == t_longfloat || t == t_shortfloat) ? Ct : Cnil))
+@)
+
+@(defun realp (x)
+	enum type t;
+@
+	t = type_of(x);
+	@(return (REAL_TYPE(t) ? Ct : Cnil))
+@)
+
+@(defun complexp (x)
+@
+	@(return ((type_of(x) == t_complex) ? Ct : Cnil))
+@)
+
+@(defun characterp (x)
+@
+	@(return (CHARACTERP(x) ? Ct : Cnil))
+@)
+
+@(defun stringp (x)
+@
+	@(return ((type_of(x) == t_string) ? Ct : Cnil))
+@)
+
+@(defun bit_vector_p (x)
+@
+	@(return ((type_of(x) == t_bitvector) ? Ct : Cnil))
+@)
+
+@(defun vectorp (x)
+	enum type t;
+@
+	t = type_of(x);
+	@(return ((t == t_vector || t == t_string || t == t_bitvector) ? Ct : Cnil))
+@)
+
+@(defun simple_string_p (x)
+@
+	@(return ((type_of(x) == t_string &&
+		     !x->string.adjustable &&
+		     !x->string.hasfillp &&
+		     Null(CAR(x->string.displaced))) ? Ct : Cnil))
+@)
+
+@(defun simple_bit_vector_p (x)
+@
+	@(return ((type_of(x) == t_bitvector &&
+		     !x->vector.adjustable &&
+		     !x->vector.hasfillp &&
+		     Null(CAR(x->vector.displaced))) ? Ct : Cnil))
+@)
+
+@(defun simple_vector_p (x)
+	enum type t;
+@
+	t = type_of(x);
+	@(return ((t == t_vector &&
+		     !x->vector.adjustable &&
+		     !x->vector.hasfillp &&
+		     Null(CAR(x->vector.displaced)) &&
+		     (enum aelttype)x->vector.elttype == aet_object) ? Ct : Cnil))
+@)
+
+@(defun arrayp (x)
+	enum type t;
+@
+	t = type_of(x);
+	@(return (ARRAY_TYPE(t) ? Ct : Cnil))
+@)
+
+@(defun packagep (x)
+@
+	@(return ((type_of(x) == t_package) ? Ct : Cnil))
+@)
+
+@(defun functionp (x)
+	enum type t;
+	cl_object output;
+@
+	t = type_of(x);
+	if (t == t_bytecodes || t == t_cfun || t == t_cclosure)
+		output = Ct;
+	else
+		output = Cnil;
+	@(return output)
+@)
+
+@(defun compiled_function_p (x)
+	enum type t;
+@
+	t = type_of(x);
+	@(return ((t == t_bytecodes || t == t_cfun || t == t_cclosure) ? Ct : Cnil))
+@)
+
+@(defun commonp (x)
+	cl_object output;
+@
+	output = (FALSE /* type_of(x) == t_spice */
+#ifdef THREADS
+		     || type_of(x) == t_thread
+		     || type_of(x) == t_cont
+#endif THREADS
+#ifdef CLOS
+		     || type_of(x) == t_instance
+		     || type_of(x) == t_gfun
+#endif CLOS
+		     ) ? Cnil : Ct;
+	@(return output)
+@)
+
+@(defun eq (x y)
+@
+	@(return ((x == y) ? Ct : Cnil))
+@)
+
+bool
+eql(cl_object x, cl_object y)
+{
+	enum type t;
+
+	if (x == y)
+		return(TRUE);
+	if ((t = type_of(x)) != type_of(y))
+		return(FALSE);
+	switch (t) {
+
+	case t_fixnum:
+		return(fix(x) == fix(y));
+
+	case t_bignum:
+		return(big_compare(x, y) == 0);
+
+	case t_ratio:
+		return(eql(x->ratio.num, y->ratio.num) &&
+		       eql(x->ratio.den, y->ratio.den));
+
+	case t_shortfloat:
+		return(sf(x) == sf(y));
+
+	case t_longfloat:
+		return(lf(x) == lf(y));
+
+	case t_complex:
+		if (eql(x->complex.real, y->complex.real) &&
+		    eql(x->complex.imag, y->complex.imag))
+			return(TRUE);
+		else
+			return(FALSE);
+
+	case t_character:
+		return(CHAR_CODE(x) == CHAR_CODE(y));
+
+	default:
+		return(FALSE);
+	}
+}
+
+@(defun eql (x y)
+@
+	@(return (eql(x, y) ? Ct : Cnil))
+@)
+
+bool
+equal(register cl_object x, cl_object y)
+{
+	register enum type t;
+
+	cs_check(y);
+BEGIN:
+	if ((t = type_of(x)) != type_of(y))
+		return(FALSE);
+	if (x==y)
+		return(TRUE);
+	switch (t) {
+
+	case t_cons:
+		if (!equal(CAR(x), CAR(y)))
+			return(FALSE);
+		x = CDR(x);
+		y = CDR(y);
+		goto BEGIN;
+
+	case t_symbol:
+	case t_vector:
+	case t_array:
+		return FALSE;
+
+	case t_fixnum:
+		return(fix(x)==fix(y));
+
+	case t_shortfloat:
+		return(x->SF.SFVAL==y->SF.SFVAL);
+
+	case t_longfloat:
+		return(x->LF.LFVAL==y->LF.LFVAL);
+
+	case t_string:
+		return(string_eq(x, y));
+
+	case t_bitvector: {
+		cl_index i, ox, oy;
+
+		if (x->vector.fillp != y->vector.fillp)
+			return(FALSE);
+		ox = x->vector.offset;
+		oy = y->vector.offset;
+		for (i = 0;  i < x->vector.fillp;  i++)
+			if((x->vector.self.bit[(i+ox)/8] & (0200>>(i+ox)%8))
+			 !=(y->vector.self.bit[(i+oy)/8] & (0200>>(i+oy)%8)))
+				return(FALSE);
+		return(TRUE);
+	}
+
+#ifdef CLOS
+	case t_instance: {
+		cl_index i;
+
+		if (x->instance.class != y->instance.class)
+			return(FALSE);
+		for (i = 0;  i < x->instance.length;  i++)
+			if (!equal(x->instance.slots[i], y->instance.slots[i]))
+				return(FALSE);
+		return(TRUE);
+	}
+#else
+	case t_structure:
+	{
+		int i;
+
+		if (x->str.name != y->str.name)
+			return(FALSE);
+		for (i = 0;  i < x->str.length;  i++)
+			if (!equal(x->str.self[i], y->str.self[i]))
+				return(FALSE);
+		return(TRUE);
+	}
+#endif CLOS
+
+	case t_pathname:
+		return(equal(x->pathname.host, y->pathname.host) &&
+		       equal(x->pathname.device, y->pathname.device) &&
+		       equal(x->pathname.directory, y->pathname.directory) &&
+		       equal(x->pathname.name, y->pathname.name) &&
+		       equal(x->pathname.type, y->pathname.type) &&
+		       equal(x->pathname.version, y->pathname.version));
+
+	default:
+		return(eql(x,y));
+	}
+}
+
+@(defun equal (x y)
+@
+	@(return (equal(x, y) ? Ct : Cnil))
+@)
+
+bool
+equalp(cl_object x, cl_object y)
+{
+	enum type tx, ty;
+	cl_index j;
+
+	cs_check(x);
+
+BEGIN:
+	if (eql(x, y))
+		return(TRUE);
+	tx = type_of(x);
+	ty = type_of(y);
+
+	switch (tx) {
+	case t_fixnum:
+	case t_bignum:
+	case t_ratio:
+	case t_shortfloat:
+	case t_longfloat:
+	case t_complex:
+		if (ty == t_fixnum || ty == t_bignum || ty == t_ratio ||
+		    ty == t_shortfloat || ty == t_longfloat ||
+		    ty == t_complex)
+			return number_equalp(x, y);
+		else
+			return FALSE;
+
+	case t_vector:
+	case t_string:
+	case t_bitvector:
+		if (ty == t_vector || ty == t_string || ty == t_bitvector) {
+		  j = x->vector.fillp;
+		  if (j != y->vector.fillp)
+		    return FALSE;
+		  goto ARRAY;
+		}
+		else
+			return(FALSE);
+
+	case t_array:
+		if (ty == t_array && x->array.rank == y->array.rank) {
+		  if (x->array.rank > 1) {
+		    cl_index i = 0;
+		    for (i = 0; i < x->array.rank; i++)
+		      if (x->array.dims[i] != y->array.dims[i]) return(FALSE);
+		  }
+		  if (x->array.dim != y->array.dim)
+		    return(FALSE);
+		  j=x->array.dim;
+		  goto ARRAY;
+		}
+		else
+			return(FALSE);
+
+	default:
+	}
+	if (tx != ty)
+		return(FALSE);
+	switch (tx) {
+	case t_character:
+		return(char_equal(x, y));
+
+	case t_cons:
+		if (!equalp(CAR(x), CAR(y)))
+			return(FALSE);
+		x = CDR(x);
+		y = CDR(y);
+		goto BEGIN;
+
+#ifdef CLOS
+	case t_instance: {
+		cl_index i;
+
+		if (x->instance.class != y->instance.class)
+			return(FALSE);
+		for (i = 0;  i < x->instance.length;  i++)
+			if (!equal(x->instance.slots[i], y->instance.slots[i]))
+				return(FALSE);
+		return(TRUE);
+	}
+#else
+	case t_structure: {
+		cl_index i;
+
+		if (x->str.name != y->str.name)
+			return(FALSE);
+		for (i = 0;  i < x->str.length;  i++)
+			if (!equalp(x->str.self[i], y->str.self[i]))
+				return(FALSE);
+		return(TRUE);
+	}
+#endif CLOS
+
+	case t_pathname:
+		return(equal(x, y));
+
+	default:
+		return(FALSE);
+	}
+
+ARRAY:
+	{
+		cl_index i;
+
+		for (i = 0;  i < j;  i++)
+			if (!equalp(aref(x, i), aref(y, i)))
+				return(FALSE);
+		return(TRUE);
+	}
+}
+
+@(defun equalp (x y)
+@
+	@(return (equalp(x, y) ? Ct : Cnil))
+@)
+
+/*
+	Contains_sharp_comma returns TRUE, iff the argument contains
+	a cons whose car is si:|#,| or a STRUCTURE.
+	Refer to the compiler about this magic.
+*/
+bool
+contains_sharp_comma(cl_object x)
+{
+	enum type tx;
+
+	cs_check(x);
+
+BEGIN:
+	tx = type_of(x);
+	if (tx == t_complex)
+		return(contains_sharp_comma(x->complex.real) ||
+		       contains_sharp_comma(x->complex.imag));
+	if (tx == t_vector) {
+		cl_index i;
+		for (i = 0;  i < x->vector.fillp;  i++)
+			if (contains_sharp_comma(x->vector.self.t[i]))
+				return(TRUE);
+		return(FALSE);
+	}
+	if (tx == t_cons) {
+		if (CAR(x) == siSsharp_comma)
+			return(TRUE);
+		if (contains_sharp_comma(CAR(x)))
+			return(TRUE);
+		x = CDR(x);
+		goto BEGIN;
+	}
+	if (tx == t_array) {
+		cl_index i, j;
+		for (i = 0, j = 1;  i < x->array.rank;  i++)
+			j *= x->array.dims[i];
+		for (i = 0;  i < j;  i++)
+			if (contains_sharp_comma(x->array.self.t[i]))
+				return(TRUE);
+		return(FALSE);
+	}
+#ifdef CLOS
+	if (tx == t_instance)
+		return(TRUE);		/*  Oh, my god!  */
+#else
+	if (tx == t_structure)
+		return(TRUE);		/*  Oh, my god!  */
+#endif CLOS
+	return(FALSE);
+}
+
+@(defun si::contains_sharp_comma (x)
+@
+	@(return (contains_sharp_comma(x) ? Ct : Cnil))
+@)
+
+@(defun si::fixnump (x)
+@
+	@(return (FIXNUMP(x) ? Ct : Cnil))
+@)
diff --git a/src/c/print.d b/src/c/print.d
new file mode 100644
index 000000000..73c2ab792
--- /dev/null
+++ b/src/c/print.d
@@ -0,0 +1,2337 @@
+/*
+    print.d -- Print.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include <ctype.h>
+#include <unistd.h>
+
+extern void *alloca(size_t size);
+
+/******************************* EXPORTS ******************************/
+
+cl_object Kupcase;
+cl_object Kdowncase;
+cl_object Kcapitalize;
+
+cl_object Kstream;
+cl_object Kescape;
+cl_object Kpretty;
+cl_object Kcircle;
+cl_object Kbase;
+cl_object Kradix;
+cl_object Kcase;
+cl_object Kgensym;
+cl_object Klevel;
+cl_object Klength;
+cl_object Karray;
+
+cl_object Vprint_escape;
+cl_object Vprint_pretty;
+cl_object Vprint_circle;
+cl_object Vprint_base;
+cl_object Vprint_radix;
+cl_object Vprint_case;
+cl_object Vprint_gensym;
+cl_object Vprint_level;
+cl_object Vprint_length;
+cl_object Vprint_array;
+
+cl_object siVprint_package;
+cl_object siVprint_structure;
+
+#ifndef THREADS
+bool PRINTescape;
+bool PRINTpretty;
+bool PRINTcircle;
+int PRINTbase;
+bool PRINTradix;
+cl_object PRINTcase;
+bool PRINTgensym;
+int PRINTlevel;
+int PRINTlength;
+bool PRINTarray;
+void (*write_ch_fun)();		/* virtual output (for pretty-print) */
+void (*output_ch_fun)();	/* physical output */
+#endif THREADS
+
+/******************************* ------- ******************************/
+
+#define	LINE_LENGTH	72
+
+#define	to_be_escaped(c) \
+	(standard_readtable->readtable.table[(c)&0377].syntax_type \
+	 != cat_constituent || \
+	 islower((c)&0377) || (c) == ':')
+
+
+cl_object PRINTpackage;
+bool PRINTstructure;
+
+#ifdef CLOS
+cl_object Sstream_write_char,
+  Sstream_write_string,
+  Sstream_fresh_line,
+  Sstream_clear_output,
+  Sstream_force_output;
+#endif CLOS
+
+#define	write_ch	(*write_ch_fun)
+#define	output_ch	(*output_ch_fun)
+
+cl_object siSpretty_print_format;
+cl_object siSsharp_exclamation;
+
+#define	MARK		0400
+#define	UNMARK		0401
+#define	SET_INDENT	0402
+#define	INDENT		0403
+#define	INDENT1		0404
+#define	INDENT2		0405
+
+#define	mod(x)		((x)%Q_SIZE)
+
+#ifdef THREADS
+
+#define queue             clwp->lwp_queue
+#define indent_stack      clwp->lwp_indent_stack
+#define qh         clwp->lwp_qh
+#define qt         clwp->lwp_qt
+#define qc         clwp->lwp_qc
+#define isp        clwp->lwp_isp
+#define iisp       clwp->lwp_iisp
+
+#define CIRCLEjmp clwp->lwp_CIRCLEjmp
+#define CIRCLEbase clwp->lwp_CIRCLEbase
+#define CIRCLEtop clwp->lwp_CIRCLEtop
+#define CIRCLElimit clwp->lwp_CIRCLElimit
+
+#else
+static short queue[Q_SIZE];
+static short indent_stack[IS_SIZE];
+
+static int qh;
+static int qt;
+static int qc;
+static int isp;
+static int iisp;
+
+jmp_buf CIRCLEjmp;
+cl_object *CIRCLEbase;
+cl_object *CIRCLEtop;
+cl_object *CIRCLElimit;
+cl_object PRINTstream;
+
+#endif THREADS
+
+#ifdef CLOS
+
+static void flush_queue (bool force);
+static void write_decimal1 (int i);
+static void travel_push_object (cl_object x);
+
+void
+interactive_writec_stream(int c, cl_object stream)
+{
+	funcall(3, Sstream_write_char, stream, code_char(c));
+}
+
+void
+flush_interactive_stream(cl_object stream)
+{
+	funcall(2, Sstream_force_output, stream);
+}
+
+#define FLUSH_STREAM(strm) \
+  if (type_of(strm) == t_stream) flush_stream(strm); \
+  else flush_interactive_stream(strm)
+#define FILE_COLUMN(strm) \
+  ((type_of(strm) == t_instance) ? -1 : file_column(strm))
+#else
+#define FLUSH_STREAM(strm)	flush_stream(strm)
+#define FILE_COLUMN(strm) 	file_column(strm)
+#endif CLOS
+
+static void
+writec_queue(int c)
+{
+	if (qc >= Q_SIZE)
+		flush_queue(FALSE);
+	if (qc >= Q_SIZE)
+		FEerror("Can't pretty-print.", 0);
+	queue[qt] = c;
+	qt = mod(qt+1);
+	qc++;
+}
+
+static void
+flush_queue(bool force)
+{
+	int c, i, j, k, l, i0;
+
+BEGIN:
+	while (qc > 0) {
+		c = queue[qh];
+		if (c == MARK)
+			goto DO_MARK;
+		else if (c == UNMARK)
+			isp -= 2;
+		else if (c == SET_INDENT)
+			indent_stack[isp] = FILE_COLUMN(PRINTstream);
+		else if (c == INDENT) {
+			goto DO_INDENT;
+		} else if (c == INDENT1) {
+			i = FILE_COLUMN(PRINTstream)-indent_stack[isp];
+			if (i < 8 && indent_stack[isp] < LINE_LENGTH/2) {
+				output_ch(' ');
+				indent_stack[isp]
+				= FILE_COLUMN(PRINTstream);
+			} else {
+				if (indent_stack[isp] < LINE_LENGTH/2) {
+					indent_stack[isp]
+					= indent_stack[isp-1] + 4;
+				}
+				goto DO_INDENT;
+			}
+		} else if (c == INDENT2) {
+			indent_stack[isp] = indent_stack[isp-1] + 2;
+			goto PUT_INDENT;
+		} else if (c < 0400)
+			output_ch(c);
+		qh = mod(qh+1);
+		--qc;
+	}
+	return;
+
+DO_MARK:
+	k = LINE_LENGTH - 1 - FILE_COLUMN(PRINTstream);
+	for (i = 1, j = 0, l = 1;  l > 0 && i < qc && j < k;  i++) {
+		c = queue[mod(qh + i)];
+		if (c == MARK)
+			l++;
+		else if (c == UNMARK)
+			--l;
+		else if (c == INDENT || c == INDENT1 || c == INDENT2)
+			j++;
+		else if (c < 0400)
+			j++;
+	}
+	if (l == 0)
+		goto FLUSH;
+	if (i == qc && !force)
+		return;
+	qh = mod(qh+1);
+	--qc;
+	if (++isp >= IS_SIZE-1)
+		FEerror("Can't pretty-print.", 0);
+	indent_stack[isp++] = FILE_COLUMN(PRINTstream);
+	indent_stack[isp] = indent_stack[isp-1];
+	goto BEGIN;
+
+DO_INDENT:
+	if (iisp > isp)
+		goto PUT_INDENT;
+	k = LINE_LENGTH - 1 - FILE_COLUMN(PRINTstream);
+	for (i0 = 0, i = 1, j = 0, l = 1;  i < qc && j < k;  i++) {
+		c = queue[mod(qh + i)];
+		if (c == MARK)
+			l++;
+		else if (c == UNMARK) {
+			if (--l == 0)
+				goto FLUSH;
+		} else if (c == SET_INDENT) {
+			if (l == 1)
+				break;
+		} else if (c == INDENT) {
+			if (l == 1)
+				i0 = i;
+			j++;
+		} else if (c == INDENT1) {
+			if (l == 1)
+				break;
+			j++;
+		} else if (c == INDENT2) {
+			if (l == 1) {
+				i0 = i;
+				break;
+			}
+			j++;
+		} else if (c < 0400)
+			j++;
+	}
+	if (i == qc && !force)
+		return;
+	if (i0 == 0)
+		goto PUT_INDENT;
+	i = i0;
+	goto FLUSH;
+
+PUT_INDENT:
+	qh = mod(qh+1);
+	--qc;
+	output_ch('\n');
+	for (i = indent_stack[isp];  i > 0;  --i)
+		output_ch(' ');
+	iisp = isp;
+	goto BEGIN;
+
+FLUSH:
+	for (j = 0;  j < i;  j++) {
+		c = queue[qh];
+		if (c == INDENT || c == INDENT1 || c == INDENT2)
+			output_ch(' ');
+		else if (c < 0400)
+			output_ch(c);
+		qh = mod(qh+1);
+		--qc;
+	}
+	goto BEGIN;
+}
+
+void
+writec_PRINTstream(int c)
+{
+	if (c == INDENT || c == INDENT1)
+		writec_stream(' ', PRINTstream);
+	else if (c < 0400)
+		writec_stream(c, PRINTstream);
+}
+
+#ifdef CLOS
+static void
+interactive_writec_PRINTstream(int c)
+{
+	if (c == INDENT || c == INDENT1)
+		interactive_writec_stream(' ', PRINTstream);
+	else if (c < 0400)
+		interactive_writec_stream(c, PRINTstream);
+}
+#endif CLOS
+
+void
+write_str(char *s)
+{
+	while (*s != '\0')
+		write_ch(*s++);
+}
+
+void
+write_decimal(int i)
+{
+	if (i == 0) {
+		write_ch('0');
+		return;
+	}
+	write_decimal1(i);
+}
+
+static void
+write_decimal1(int i)
+{
+	if (i == 0)
+		return;
+	write_decimal1(i/10);
+	write_ch(i%10 + '0');
+}
+
+void
+write_addr(cl_object x)
+{
+	cl_fixnum i, j;
+
+	i = (cl_index)x;
+	for (j = sizeof(i)-4;  j >= 0;  j -= 4) {
+		int k = (i>>j) & 0xf;
+		if (k < 10)
+			write_ch('0' + k);
+		else
+			write_ch('a' + k - 10);
+	}
+}
+
+static void
+write_base(void)
+{
+	if (PRINTbase == 2)
+		write_str("#b");
+	else if (PRINTbase == 8)
+		write_str("#o");
+	else if (PRINTbase == 16)
+		write_str("#x");
+	else if (PRINTbase >= 10) {
+		write_ch('#');
+		write_ch(PRINTbase/10+'0');
+		write_ch(PRINTbase%10+'0');
+		write_ch('r');
+	} else {
+		write_ch('#');
+		write_ch(PRINTbase+'0');
+		write_ch('r');
+	}
+}
+
+/* The floating point precision is required to make the
+   most-positive-long-float printed expression readable.
+   If this is too small, then the rounded off fraction, may be too big
+   to read */
+
+#ifndef FPRC 
+#define FPRC 16
+#endif
+
+void
+edit_double(int n, double d, int *sp, char *s, int *ep)
+{
+	char *p, buff[FPRC + 9];
+	int i;
+
+#ifdef IEEEFLOAT
+	if ((*((int *)&d +HIND) & 0x7ff00000) == 0x7ff00000)
+		FEerror("Can't print a non-number.", 0);
+	else
+		sprintf(buff, "%*.*e",FPRC+8,FPRC, d);
+	if (buff[FPRC+3] != 'e') {
+		sprintf(buff, "%*.*e",FPRC+7,FPRC,d);
+		*ep = (buff[FPRC+5]-'0')*10 + (buff[FPRC+6]-'0');
+	} else
+		*ep = (buff[FPRC+5]-'0')*100 +
+		  (buff[FPRC+6]-'0')*10 + (buff[FPRC+7]-'0');
+	*sp = 1;
+	if (buff[0] == '-')
+		*sp *= -1;
+#else
+	sprintf(buff, "%*.*e",FPRC+7,FPRC, d);
+	/*  "-D.MMMMMMMMMMMMMMMe+EE"  */
+	/*   0123456789012345678901   */
+	*sp = 1;
+	if (buff[0] == '-')
+		*sp *= -1;
+	*ep = (buff[FPRC+5]-'0')*10 + (buff[FPRC+6]-'0');
+#endif IEEEFLOAT
+
+	if (buff[FPRC+4] == '-')
+		*ep *= -1;
+	buff[2] = buff[1];
+	p = buff + 2;
+	if (n < FPRC+1) {
+		if (p[n] >= '5') {
+			for (i = n - 1;  i >= 0;  --i)
+				if (p[i] == '9')
+					p[i] = '0';
+				else {
+					p[i]++;
+					break;
+				}
+			if (i < 0) {
+				*--p = '1';
+				(*ep)++;
+			}
+		}
+		for (i = 0;  i < n;  i++)
+			s[i] = p[i];
+	} else {
+		for (i = 0;  i < FPRC+1;  i++)
+			s[i] = p[i];
+		for (;  i < n;  i++)
+			s[i] = '0';
+	}
+	s[n] = '\0';
+}
+
+
+void
+write_double(double d, int e, bool shortp)
+{
+	int sign;
+	char buff[FPRC+5];
+	int exp;
+	int i;
+	int n = FPRC;		/* was FPRC+1 */
+
+	if (shortp)
+		n = 7;
+	edit_double(n, d, &sign, buff, &exp);
+	if (sign==2) {
+		write_str("#<");
+		write_str(buff);
+		write_ch('>');
+		return;
+	      }
+	if (sign < 0)
+		write_ch('-');
+	if (-3 <= exp && exp < 7) {
+		if (exp < 0) {
+			write_ch('0');
+			write_ch('.');
+			exp = (-exp) - 1;
+			for (i = 0;  i < exp;  i++)
+				write_ch('0');
+			for (;  n > 0;  --n)
+				if (buff[n-1] != '0')
+					break;
+			if (exp == 0 && n == 0)
+				n = 1;
+			for (i = 0;  i < n;  i++)
+				write_ch(buff[i]);
+		} else {
+			exp++;
+			for (i = 0;  i < exp;  i++)
+				if (i < n)
+					write_ch(buff[i]);
+				else
+					write_ch('0');
+			write_ch('.');
+			if (i < n)
+				write_ch(buff[i]);
+			else
+				write_ch('0');
+			i++;
+			for (;  n > i;  --n)
+				if (buff[n-1] != '0')
+					break;
+			for (;  i < n;  i++)
+				write_ch(buff[i]);
+		}
+		exp = 0;
+	} else {
+		write_ch(buff[0]);
+		write_ch('.');
+		write_ch(buff[1]);
+		for (;  n > 2;  --n)
+			if (buff[n-1] != '0')
+				break;
+		for (i = 2;  i < n;  i++)
+			write_ch(buff[i]);
+	}
+	if (exp == 0 && e == 0)
+		return;
+	if (e == 0)
+		e = 'E';
+	write_ch(e);
+	if (exp < 0) {
+		write_ch('-');
+		exp *= -1;
+	}
+	write_decimal(exp);
+}
+
+
+#ifndef CLOS
+static void
+call_structure_print_function(cl_object x, int level)
+{
+	int i;
+	bool eflag;
+	bds_ptr old_bds_top;
+
+	void (*wf)() = write_ch_fun;
+
+	bool e = PRINTescape;
+	bool r = PRINTradix;
+	int b = PRINTbase;
+	bool c = PRINTcircle;
+	bool p = PRINTpretty;
+	int lv = PRINTlevel;
+	int ln = PRINTlength;
+	bool g = PRINTgensym;
+	bool a = PRINTarray;
+	cl_object ps = PRINTstream;
+	cl_object pc = PRINTcase;
+
+	short ois[IS_SIZE];
+
+	int oqh;
+	int oqt;
+	int oqc;
+	int oisp;
+	int oiisp;
+
+	while (interrupt_flag) {
+		interrupt_flag = FALSE;
+#ifdef unix
+		alarm(0);
+#endif unix
+		terminal_interrupt(TRUE);
+	}
+
+	if (PRINTpretty)
+		flush_queue(TRUE);
+
+	oqh = qh;
+	oqt = qt;
+	oqc = qc;
+	oisp = isp;
+	oiisp = iisp;
+
+	for (i = 0;  i <= isp;  i++)
+		ois[i] = indent_stack[i];
+
+	old_bds_top = bds_top;
+	bds_bind(Vprint_escape, PRINTescape?Ct:Cnil);
+	bds_bind(Vprint_radix, PRINTradix?Ct:Cnil);
+	bds_bind(Vprint_base, MAKE_FIXNUM(PRINTbase));
+	bds_bind(Vprint_circle, PRINTcircle?Ct:Cnil);
+	bds_bind(Vprint_pretty, PRINTpretty?Ct:Cnil);
+	bds_bind(Vprint_level, PRINTlevel<0?Cnil:MAKE_FIXNUM(PRINTlevel));
+	bds_bind(Vprint_length, PRINTlength<0?Cnil:MAKE_FIXNUM(PRINTlength));
+	bds_bind(Vprint_gensym, PRINTgensym?Ct:Cnil);
+	bds_bind(Vprint_array, PRINTarray?Ct:Cnil);
+	bds_bind(Vprint_case, PRINTcase);
+	
+	if (frs_push(FRS_PROTECT, Cnil))
+		eflag = TRUE;
+	else {
+		funcall(4, getf(x->str.name->symbol.plist,
+		       siSstructure_print_function, Cnil),
+			  x, PRINTstream, MAKE_FIXNUM(level));
+		eflag = FALSE;
+	}
+
+	frs_pop();
+	bds_unwind(old_bds_top);
+
+	for (i = 0;  i <= oisp;  i++)
+		indent_stack[i] = ois[i];
+
+	iisp = oiisp;
+	isp = oisp;
+	qc = oqc;
+	qt = oqt;
+	qh = oqh;
+
+	PRINTcase = pc;
+	PRINTstream = ps;
+	PRINTarray = a;
+	PRINTgensym = g;
+	PRINTlength = ln;
+	PRINTlevel = lv;
+	PRINTpretty = p;
+	PRINTcircle = c;
+	PRINTbase = b;
+	PRINTradix = r;
+	PRINTescape = e;
+
+	write_ch_fun = wf;
+
+	if (eflag) unwind(nlj_fr, nlj_tag);
+}
+
+#else
+static void
+call_print_object(cl_object x, int level)
+{
+	int i;
+	bool eflag;
+	bds_ptr old_bds_top;
+
+	void (*wf)() = write_ch_fun;
+
+	bool e = PRINTescape;
+	bool r = PRINTradix;
+	int b = PRINTbase;
+	bool c = PRINTcircle;
+	bool p = PRINTpretty;
+	int lv = PRINTlevel;
+	int ln = PRINTlength;
+	bool g = PRINTgensym;
+	bool a = PRINTarray;
+	cl_object ps = PRINTstream;
+	cl_object pc = PRINTcase;
+
+	short ois[IS_SIZE];
+
+	int oqh;
+	int oqt;
+	int oqc;
+	int oisp;
+	int oiisp;
+
+	while (interrupt_flag) {
+		interrupt_flag = FALSE;
+#ifdef unix
+		alarm(0);
+#endif
+		terminal_interrupt(TRUE);
+	}
+
+	if (PRINTpretty)
+		flush_queue(TRUE);
+
+	oqh = qh;
+	oqt = qt;
+	oqc = qc;
+	oisp = isp;
+	oiisp = iisp;
+
+	for (i = 0;  i <= isp;  i++)
+		ois[i] = indent_stack[i];
+
+	old_bds_top = bds_top;
+	bds_bind(Vprint_escape, PRINTescape?Ct:Cnil);
+	bds_bind(Vprint_radix, PRINTradix?Ct:Cnil);
+	bds_bind(Vprint_base, MAKE_FIXNUM(PRINTbase));
+	bds_bind(Vprint_circle, PRINTcircle?Ct:Cnil);
+	bds_bind(Vprint_pretty, PRINTpretty?Ct:Cnil);
+	bds_bind(Vprint_level, PRINTlevel<0?Cnil:MAKE_FIXNUM(PRINTlevel));
+	bds_bind(Vprint_length, PRINTlength<0?Cnil:MAKE_FIXNUM(PRINTlength));
+	bds_bind(Vprint_gensym, PRINTgensym?Ct:Cnil);
+	bds_bind(Vprint_array, PRINTarray?Ct:Cnil);
+	bds_bind(Vprint_case, PRINTcase);
+
+	
+	if (frs_push(FRS_PROTECT, Cnil))
+		eflag = TRUE;
+	else {
+		funcall(3, Sprint_object, x, PRINTstream);
+		eflag = FALSE;
+	}
+
+	frs_pop();
+	bds_unwind(old_bds_top);
+
+	for (i = 0;  i <= oisp;  i++)
+		indent_stack[i] = ois[i];
+
+	iisp = oiisp;
+	isp = oisp;
+	qc = oqc;
+	qt = oqt;
+	qh = oqh;
+
+	PRINTcase = pc;
+	PRINTstream = ps;
+	PRINTarray = a;
+	PRINTgensym = g;
+	PRINTlength = ln;
+	PRINTlevel = lv;
+	PRINTpretty = p;
+	PRINTcircle = c;
+	PRINTbase = b;
+	PRINTradix = r;
+	PRINTescape = e;
+
+	write_ch_fun = wf;
+
+	if (eflag) unwind(nlj_fr, nlj_tag);
+}
+#endif CLOS
+
+void
+write_fixnum(cl_fixnum i)
+{
+	short digits[16];
+	int j;
+	for (j = 0;  j < 16 && i != 0;  i /= PRINTbase)
+	  digits[j++] = digit_weight(i%PRINTbase, PRINTbase);
+	if (j == 16) write_fixnum(i);
+	while (j-- > 0)
+	  write_ch(digits[j]);
+}
+
+void
+write_bignum(cl_object x)
+{
+	cl_fixnum str_size = mpz_sizeinbase(x->big.big_num, PRINTbase);
+	char str[str_size];		/* __GNUC__ */
+	char *s = str;
+	mpz_get_str(str, PRINTbase, x->big.big_num);
+	while (*s)
+	  write_ch(*s++);
+}
+
+static void
+write_symbol(register cl_object x)
+{
+	bool escaped;
+	cl_index i;
+	cl_object s = x->symbol.name;
+
+	if (!PRINTescape) {
+		for (i = 0;  i < s->string.fillp;  i++) {
+			int c = s->string.self[i];
+			if (isupper(c) &&
+			    (PRINTcase == Kdowncase ||
+			     (PRINTcase == Kcapitalize && i != 0)))
+				c = tolower(c);
+			write_ch(c);
+		}
+		return;
+	}
+	if (Null(x->symbol.hpack)) {
+		if (PRINTcircle) {
+			cl_object *vp;
+			for (vp = CIRCLEbase;  vp < CIRCLEtop;  vp += 2)
+				if (x == *vp) {
+					write_ch('#');
+					write_decimal((vp-CIRCLEbase)/2);
+					if (vp[1] != Cnil) {
+						write_ch('#');
+						return;
+					} else {
+						write_ch('=');
+						vp[1] = Ct;
+					}
+				}
+		}
+		if (PRINTgensym)
+			write_str("#:");
+	} else if (x->symbol.hpack == keyword_package)
+		write_ch(':');
+	else if ((PRINTpackage != OBJNULL && x->symbol.hpack != PRINTpackage)
+		 || find_symbol(x, current_package())!=x
+		 || intern_flag == 0) {
+		escaped = 0;
+		for (i = 0;
+		     i < x->symbol.hpack->pack.name->string.fillp;
+		     i++) {
+			int c = x->symbol.hpack->pack.name->string.self[i];
+			if (to_be_escaped(c))
+				escaped = 1;
+		}
+		if (escaped)
+			write_ch('|');
+		for (i = 0;
+		     i < x->symbol.hpack->pack.name->string.fillp;
+		     i++) {
+			int c = x->symbol.hpack->pack.name->string.self[i];
+			if (c == '|' || c == '\\')
+				write_ch('\\');
+			if (escaped == 0 && isupper(c) &&
+			    (PRINTcase == Kdowncase ||
+			     (PRINTcase == Kcapitalize && i!=0)))
+				c = tolower(c);
+			write_ch(c);
+		}
+		if (escaped)
+			write_ch('|');
+		if (find_symbol(x, x->symbol.hpack) != x)
+			error("can't print symbol");
+		if ((PRINTpackage != OBJNULL &&
+		     x->symbol.hpack != PRINTpackage)
+		    || intern_flag == INTERNAL)
+			write_str("::");
+		else if (intern_flag == EXTERNAL)
+			write_ch(':');
+		else
+			FEerror("Pathological symbol --- cannot print.", 0);
+	}
+	escaped = 0;
+	if (potential_number_p(s, PRINTbase))
+		escaped = 1;
+	for (i = 0;  i < s->string.fillp;  i++) {
+		int c = s->string.self[i];
+		if (to_be_escaped(c))
+			escaped = 1;
+	}
+	for (i = 0;  i < s->string.fillp;  i++)
+		if (s->string.self[i] != '.')
+			goto NOT_DOT;
+	escaped = 1;
+
+ NOT_DOT:			
+	if (escaped)
+		write_ch('|');
+	for (i = 0;  i < s->string.fillp;  i++) {
+		int c = s->string.self[i];
+		if (c == '|' || c == '\\')
+			write_ch('\\');
+		if (escaped == 0 && isupper(c) &&
+		    (PRINTcase == Kdowncase ||
+		     (PRINTcase == Kcapitalize && i != 0)))
+			c = tolower(c);
+		write_ch(c);
+	}
+	if (escaped)
+		write_ch('|');
+}
+
+static void
+write_character(register int i)
+{
+	if (!PRINTescape) {
+		write_ch(i);
+		return;
+	}
+	write_str("#\\");
+	switch (i) {
+	case '\r':	write_str("Return"); break;
+	case ' ':	write_str("Space"); break;
+	case '\177':	write_str("Rubout"); break;
+	case '\f':	write_str("Page"); break;
+	case '\t':	write_str("Tab"); break;
+	case '\b':	write_str("Backspace");	break;
+	case '\n':	write_str("Newline"); break;
+	case '\0':	write_str("Null"); break;
+	default:
+		if (i & 0200) {
+			write_ch('\\');
+			write_ch(((i>>6)&7) + '0');
+			write_ch(((i>>3)&7) + '0');
+			write_ch(((i>>0)&7) + '0');
+		} else if (i < 040) {
+			write_ch('^');
+			i += 0100;
+			if (i == '\\')
+				write_ch('\\');
+			write_ch(i);
+		} else
+			write_ch(i);
+		break;
+	}
+}
+
+
+void
+write_object(cl_object x, int level)
+{
+	cl_object r, y;
+	cl_fixnum i, j;
+	cl_index ndx, k;
+	cl_object *vp;
+
+	cs_check(x);
+
+ BEGIN:
+	if (x == OBJNULL) {
+		write_str("#<OBJNULL>");
+		return;
+	}
+
+	switch (type_of(x)) {
+
+	case FREE:
+		write_str("#<FREE OBJECT ");
+		write_addr(x);
+		write_ch('>');
+		return;
+
+	case t_fixnum:
+		if (PRINTradix && PRINTbase != 10)
+			write_base();
+		if (x == MAKE_FIXNUM(0)) {
+			write_ch('0');
+		} else if (FIXNUM_MINUSP(x)) {
+			write_ch('-');
+			write_fixnum(-fix(x));
+		} else
+			write_fixnum(fix(x));
+		if (PRINTradix && PRINTbase == 10)
+			write_ch('.');
+		return;
+
+	case t_bignum:
+		if (PRINTradix && PRINTbase != 10)
+			write_base();
+		write_bignum(x);
+		if (PRINTradix && PRINTbase == 10)
+			write_ch('.');
+		return;
+
+	case t_ratio:
+		if (PRINTradix) {
+			write_base();
+			PRINTradix = FALSE;
+			write_object(x->ratio.num, level);
+			write_ch('/');
+			write_object(x->ratio.den, level);
+			PRINTradix = TRUE;
+		} else {
+			write_object(x->ratio.num, level);
+			write_ch('/');
+			write_object(x->ratio.den, level);
+		}
+		return;
+
+	case t_shortfloat:
+		r = symbol_value(Vread_default_float_format);
+		if (r == Ssingle_float || r == Sshort_float)
+			write_double((double)sf(x), 0, TRUE);
+		else
+			write_double((double)sf(x), 'f', TRUE);
+		return;
+
+	case t_longfloat:
+		r = symbol_value(Vread_default_float_format);
+		if (r == Slong_float || r == Sdouble_float)
+			write_double(lf(x), 0, FALSE);
+		else
+			write_double(lf(x), 'd', FALSE);
+		return;
+
+	case t_complex:
+		write_str("#C(");
+		write_object(x->complex.real, level);
+		write_ch(' ');
+		write_object(x->complex.imag, level);
+		write_ch(')');
+		return;
+
+	case t_character:
+		write_character(CHAR_CODE(x));
+		return;
+
+	case t_symbol:
+		write_symbol(x);
+		return;
+
+	case t_array: {
+		int subscripts[ARANKLIM];
+		cl_index n, m, k, i;
+
+		if (!PRINTarray) {
+			write_str("#<array ");
+			write_addr(x);
+			write_ch('>');
+			return;
+		}
+		if (PRINTcircle) {
+			for (vp = CIRCLEbase;  vp < CIRCLEtop;  vp += 2)
+			    if (x == *vp) {
+				write_ch('#');
+				write_decimal((vp-CIRCLEbase)/2);
+				if (vp[1] != Cnil) {
+				    write_ch('#');
+				    return;
+				} else {
+				    write_ch('=');
+				    vp[1] = Ct;
+				    break;
+				}
+			    }
+		}
+		if (PRINTlevel >= 0 && level >= PRINTlevel) {
+			write_ch('#');
+			return;
+		}
+		n = x->array.rank;
+		write_ch('#');
+		write_decimal(n);
+		write_ch('A');
+		if (PRINTlevel >= 0 && level+n >= PRINTlevel)
+			n = PRINTlevel - level;
+		for (j = 0;  j < n;  j++)
+			subscripts[j] = 0;
+		for (m = 0, j = 0;;) {
+			for (i = j;  i < n;  i++) {
+				if (subscripts[i] == 0) {
+					write_ch(MARK);
+					write_ch('(');
+					write_ch(SET_INDENT);
+					if (x->array.dims[i] == 0) {
+						write_ch(')');
+						write_ch(UNMARK);
+						j = i-1;
+						k = 0;
+						goto INC;
+					}
+				}
+				if (subscripts[i] > 0)
+					write_ch(INDENT);
+				if (PRINTlength >= 0 &&
+				    subscripts[i] >= PRINTlength) {
+					write_str("...)");
+					write_ch(UNMARK);
+					k=x->array.dims[i]-subscripts[i];
+					subscripts[i] = 0;
+					for (j = i+1;  j < n;  j++)
+						k *= x->array.dims[j];
+					j = i-1;
+					goto INC;
+				}
+			}
+			/* FIXME: This conses! */
+			if (n == x->array.rank)
+				write_object(aref(x, m), level+n);
+			else
+				write_ch('#');
+			j = n-1;
+			k = 1;
+
+		INC:
+			while (j >= 0) {
+				if (++subscripts[j] < x->array.dims[j])
+					break;
+				subscripts[j] = 0;
+				write_ch(')');
+				write_ch(UNMARK);
+				--j;
+			}
+			if (j < 0)
+				break;
+			m += k;
+		}
+		return;
+	}
+
+	case t_vector:
+		if (!PRINTarray) {
+			write_str("#<vector ");
+			write_decimal(x->vector.dim);
+			write_ch(' ');
+			write_addr(x);
+			write_ch('>');
+			return;
+		}
+		if (PRINTcircle) {
+			for (vp = CIRCLEbase;  vp < CIRCLEtop;  vp += 2)
+			    if (x == *vp) {
+				write_ch('#');
+				write_decimal((vp-CIRCLEbase)/2);
+				if (vp[1] != Cnil) {
+				    write_ch('#');
+				    return;
+				} else {
+				    write_ch('=');
+				    vp[1] = Ct;
+				    break;
+				}
+			    }
+		}
+		if (PRINTlevel >= 0 && level >= PRINTlevel) {
+			write_ch('#');
+			return;
+		}
+		write_ch('#');
+		write_ch(MARK);
+		write_ch('(');
+		write_ch(SET_INDENT);
+		if (x->vector.fillp > 0) {
+			if (PRINTlength == 0) {
+				write_str("...)");
+				write_ch(UNMARK);
+				return;
+			}
+			write_object(aref(x, 0), level+1);
+			for (ndx = 1;  ndx < x->vector.fillp;  ndx++) {
+				write_ch(INDENT);
+				if (PRINTlength>=0 && ndx>=PRINTlength){
+					write_str("...");
+					break;
+				}
+				write_object(aref(x, ndx), level+1);
+			}
+		}
+		write_ch(')');
+		write_ch(UNMARK);
+		return;
+
+	case t_string:
+		if (!PRINTescape) {
+			for (ndx = 0;  ndx < x->string.fillp;  ndx++)
+				write_ch(x->string.self[ndx]);
+			return;
+		}
+		write_ch('"');
+		for (ndx = 0;  ndx < x->string.fillp;  ndx++) {
+			int c = x->string.self[ndx];
+			if (c == '"' || c == '\\')
+				write_ch('\\');
+			write_ch(c);
+		}
+		write_ch('"');
+		break;
+
+	case t_bitvector:
+		if (!PRINTarray) {
+			write_str("#<bit-vector ");
+			write_addr(x);
+			write_ch('>');
+			break;
+		}
+		write_str("#*");
+		for (ndx = 0;  ndx < x->vector.fillp;  ndx++)
+			if (x->vector.self.bit[ndx/8] & (0200 >> ndx%8))
+				write_ch('1');
+			else
+				write_ch('0');
+		break;
+
+	case t_cons:
+		if (CAR(x) == siSsharp_comma) {
+			write_str("#.");
+			x = CDR(x);
+			goto BEGIN;
+		}
+		if (CAR(x) == siSsharp_exclamation) {
+			write_str("#!");
+			x = CDR(x);
+			goto BEGIN;
+		}
+		if (PRINTcircle) {
+			for (vp = CIRCLEbase;  vp < CIRCLEtop;  vp += 2)
+			    if (x == *vp) {
+			        write_ch('#');
+				write_decimal((vp-CIRCLEbase)/2);
+				if (vp[1] != Cnil) {
+				    write_ch('#');
+				    return;
+				} else {
+				    write_ch('=');
+				    vp[1] = Ct;
+				    break;
+				}
+			    }
+		}
+		if (CAR(x) == Squote && CONSP(CDR(x)) && Null(CDDR(x))) {
+			write_ch('\'');
+			x = CADR(x);
+			goto BEGIN;
+		}
+		if (CAR(x) == Sfunction && CONSP(CDR(x)) && Null(CDDR(x))) {
+			write_ch('#');
+			write_ch('\'');
+			x = CADR(x);
+			goto BEGIN;
+		}
+		if (PRINTlevel >= 0 && level >= PRINTlevel) {
+			write_ch('#');
+			return;
+		}
+		write_ch(MARK);
+		write_ch('(');
+		write_ch(SET_INDENT);
+		if (PRINTpretty && CAR(x) != OBJNULL &&
+		    type_of(CAR(x)) == t_symbol &&
+		    (r = getf(CAR(x)->symbol.plist,
+		              siSpretty_print_format, Cnil)) != Cnil)
+			goto PRETTY_PRINT_FORMAT;
+		for (i = 0;  ;  i++) {
+			if (PRINTlength >= 0 && i >= PRINTlength) {
+				write_str("...");
+				break;
+			}
+			y = CAR(x);
+			x = CDR(x);
+			write_object(y, level+1);
+			/* FIXME! */
+			if (x == OBJNULL || ATOM(x)) {
+				if (x != Cnil) {
+					write_ch(INDENT);
+					write_str(". ");
+					write_object(x, level);
+				}
+				break;
+			}
+			if (PRINTcircle) {
+			  for (vp = CIRCLEbase; vp < CIRCLEtop; vp += 2)
+			    if (x == *vp) {
+				if (vp[1] != Cnil) {
+				    write_str(" . #");
+				    write_decimal((vp-CIRCLEbase)/2);
+				    write_ch('#');
+				    goto RIGHT_PAREN;
+				} else {
+				    write_ch(INDENT);
+				    write_str(". ");
+				    write_object(x, level);
+				    goto RIGHT_PAREN;
+				}
+			    }
+			}
+			if (i == 0 && y != OBJNULL && type_of(y) == t_symbol)
+				write_ch(INDENT1);
+			else
+				write_ch(INDENT);
+		}
+
+	RIGHT_PAREN:
+		write_ch(')');
+		write_ch(UNMARK);
+		return;
+
+	PRETTY_PRINT_FORMAT:
+		j = fixint(r);
+		for (i = 0;  ;  i++) {
+			if (PRINTlength >= 0 && i >= PRINTlength) {
+				write_str("...");
+				break;
+			}
+			y = CAR(x);
+			x = CDR(x);
+			if (i <= j && Null(y))
+				write_str("()");
+			else
+				write_object(y, level+1);
+			/* FIXME! */
+			if (x == OBJNULL || ATOM(x)) {
+				if (x != Cnil) {
+					write_ch(INDENT);
+					write_str(". ");
+					write_object(x, level);
+				}
+				break;
+			}
+			if (i >= j)
+				write_ch(INDENT2);
+			else if (i == 0)
+				write_ch(INDENT1);
+			else
+				write_ch(INDENT);
+		}
+		goto RIGHT_PAREN;
+
+	case t_package:
+		write_str("#<");
+		write_object(x->pack.name, level);
+ 		write_str(" package>");
+		break;
+
+	case t_hashtable:
+		write_str("#<hash-table ");
+		write_addr(x);
+		write_ch('>');
+		break;
+
+	case t_stream:
+		switch ((enum smmode)x->stream.mode) {
+		case smm_closed:
+			write_str("#<closed stream ");
+			write_object(x->stream.object1, level);
+			break;
+
+		case smm_input:
+			write_str("#<input stream ");
+			write_object(x->stream.object1, level);
+			break;
+
+		case smm_output:
+			write_str("#<output stream ");
+			write_object(x->stream.object1, level);
+			break;
+
+		case smm_io:
+			write_str("#<io stream ");
+			write_object(x->stream.object1, level);
+			break;
+
+		case smm_probe:
+			write_str("#<probe stream ");
+			write_object(x->stream.object1, level);
+			break;
+
+		case smm_synonym:
+			write_str("#<synonym stream to ");
+			write_object(x->stream.object0, level);
+			break;
+
+		case smm_broadcast:
+			write_str("#<broadcast stream ");
+			write_addr(x);
+			break;
+
+		case smm_concatenated:
+			write_str("#<concatenated stream ");
+			write_addr(x);
+			break;
+
+		case smm_two_way:
+			write_str("#<two-way stream ");
+			write_addr(x);
+			break;
+
+		case smm_echo:
+			write_str("#<echo stream ");
+			write_addr(x);
+			break;
+
+		case smm_string_input:
+			write_str("#<string-input stream from \"");
+			y = x->stream.object0;
+			k = y->string.fillp;
+			for (ndx = 0;  ndx < k && ndx < 16;  ndx++)
+				write_ch(y->string.self[ndx]);
+			if (k > 16)
+				write_str("...");
+			write_ch('"');
+			break;
+
+		case smm_string_output:
+			write_str("#<string-output stream ");
+			write_addr(x);
+			break;
+
+		default:
+			error("illegal stream mode");
+		}
+		write_ch('>');
+		break;
+
+	case t_random:
+		write_str("#$");
+		write_object(MAKE_FIXNUM(x->random.value), level);
+		break;
+
+#ifndef CLOS
+	case t_structure:
+		if (PRINTcircle) {
+			for (vp = CIRCLEbase;  vp < CIRCLEtop;  vp += 2)
+			    if (x == *vp) {
+				write_ch('#');
+				write_decimal((vp-CIRCLEbase)/2);
+				if (vp[1] != Cnil) {
+				    write_ch('#');
+				    return;
+				} else {
+				    write_ch('=');
+				    vp[1] = Ct;
+				    break;
+				}
+			    }
+		}
+		if (PRINTlevel >= 0 && level >= PRINTlevel) {
+			write_ch('#');
+			break;
+		}
+		if (type_of(x->str.name) != t_symbol)
+			FEwrong_type_argument(Ssymbol, x->str.name);
+		if (PRINTstructure ||
+		    Null(getf(x->str.name->symbol.plist,
+			      siSstructure_print_function, Cnil))) {
+			write_str("#S");
+/* structure_to_list conses slot names and values into a list to be printed.
+ * print shouldn't allocate memory - Beppe
+ */
+			x = structure_to_list(x);
+			write_object(x, level);
+		} else
+			call_structure_print_function(x, level);
+		break;
+#endif CLOS
+
+	case t_readtable:
+		write_str("#<readtable ");
+		write_addr(x);
+		write_ch('>');
+		break;
+
+	case t_pathname:
+		if (PRINTescape)
+			write_str("#P");
+		write_object(namestring(x), level);
+		break;
+
+	case t_bytecodes: {
+		cl_object name = x->bytecodes.data[0];
+		write_str("#<interpreted-function ");
+		if (name != Cnil)
+			write_object(name, level);
+		else
+			write_addr(x);
+		write_ch('>');
+		break;
+	}
+	case t_cfun:
+		write_str("#<compiled-function ");
+		if (x->cfun.name != Cnil)
+			write_object(x->cfun.name, level);
+		else
+			write_addr(x);
+		write_ch('>');
+		break;
+	case t_codeblock:
+		write_str("#<codeblock ");
+		if (x->cblock.name != Cnil)
+			write_object(x->cblock.name, level);
+		else
+			write_addr(x);
+		write_ch('>');
+		break;
+	case t_cclosure:
+		write_str("#<compiled-closure ");
+		write_addr(x);
+		write_ch('>');
+		break;
+#ifdef LOCATIVE
+	case t_spice:
+		write_str("#<\100"); /* at-sign is the escape for dpp */
+		for (i = 28;  i >= 0;  i -= 4) {
+			j = ((int)x >> i) & 0xf;
+			if (j < 10)
+				write_ch('0' + j);
+			else
+				write_ch('A' + (j - 10));
+		}
+		write_ch('>');
+		break;
+#endif
+#ifdef THREADS
+      	case t_cont:
+		write_str("#<cont ");
+		write_object(x->cn.cn_thread, level);
+		write_ch('>');
+		break;
+
+	case t_thread:
+		write_str("#<thread ");
+		write_object(x->thread.entry, level);
+		write_ch(' ');
+		write_addr(x);
+		write_ch('>');
+		break;
+#endif THREADS
+#ifdef CLOS
+	case t_instance:
+		if (type_of(x->instance.class) != t_instance)
+			FEwrong_type_argument(Sinstance, x->instance.class);
+		call_print_object(x, level);
+		break;
+
+	case t_gfun:
+		write_str("#<dispatch-function ");
+		if (x->gfun.name != Cnil)
+			write_object(x->gfun.name, level);
+		else
+			write_addr(x);
+		write_ch('>');
+		break;
+#endif CLOS
+
+#ifdef LOCATIVE
+	case t_locative:
+		if (UNBOUNDP(x)) {
+		  /* The next location should contain the
+		     logical variable name */
+		  if (type_of(*(cl_object *)(((unsigned int)(x) >> 2)
+					  + sizeof(cl_object))) == t_symbol)
+		    write_object(*(cl_object *)(((unsigned int)(x) >> 2)
+					     + sizeof(cl_object)), level);
+		  else {
+		    write_str("#<locative ");
+		    write_addr(x);
+		    write_ch('>');
+		  }
+		}
+		else
+		  write_object(DEREF(x), level);
+		break;
+#endif LOCATIVE
+	
+	default:
+		error("illegal type --- cannot print");
+	}
+}
+
+#define PRINTcircleSIZE	4000
+
+/* To print circular structures, we traverse the structure by adding
+   a pair <element, flag> to the array CIRCLEbase for each element visited.
+   flag is initially NIL and becomes T if the element is visited again.
+   After the visit we squeeze out all the non circular elements.
+   The flags is used during printing to distinguish between the first visit
+   to the element.
+ */
+
+/* Allocates space for travel_push: if not enough, get back with
+  longjmp and increase it */
+
+#ifdef DOWN_STACK
+
+/*
+fixed with new alloca() since gcc 2.7 ?
+#ifdef i386
+#define SIZEincrement PRINTcircleSIZE
+#endif i386
+*/
+#define SIZEincrement size
+
+#define setupPRINTcircle(x) \
+	if (PRINTcircle) { volatile int size = PRINTcircleSIZE; \
+	  if (ecls_setjmp(CIRCLEjmp) != 0) \
+	    size += PRINTcircleSIZE; \
+	  CIRCLEbase = alloca(SIZEincrement * sizeof(cl_object)); \
+	  CIRCLElimit = &CIRCLEbase[size]; \
+	  setupPRINTcircle1(x); }
+#else
+#define setupPRINTcircle(x) \
+	if (PRINTcircle) { volatile int size = PRINTcircleSIZE; \
+	  if (ecls_setjmp(CIRCLEjmp) != 0) { \
+	    size += PRINTcircleSIZE; \
+	    alloca(PRINTcircleSIZE * sizeof(cl_object)); \
+	  } else \
+	     CIRCLEbase = alloca(PRINTcircleSIZE * sizeof(cl_object)); \
+	  CIRCLElimit = &CIRCLEbase[size]; \
+	  setupPRINTcircle1(x); }
+#endif DOWN_STACK
+
+
+
+static void
+setupPRINTcircle1(cl_object x)
+{   cl_object *vp, *vq;
+
+    CIRCLEtop = CIRCLEbase;
+    travel_push_object(x);
+    /* compact shared elements towards CIRCLEbase */
+    for (vp = vq = CIRCLEbase;  vp < CIRCLEtop;  vp += 2)
+      if (vp[1] != Cnil) {
+	vq[0] = vp[0]; vq[1] = Cnil; vq += 2;
+      }
+    CIRCLEtop = vq;
+}
+
+static void
+travel_push_object(cl_object x)
+{
+	enum type t;
+	cl_index i;
+	cl_object *vp;
+
+	cs_check(x);
+
+BEGIN:
+	if (x == OBJNULL) return;
+	t = type_of(x);
+	if (t != t_array && t != t_vector && t != t_cons &&
+#ifdef CLOS
+	    t != t_instance &&
+#else
+	    t != t_structure &&
+#endif CLOS
+	    !(t == t_symbol && Null(x->symbol.hpack)))
+		return;
+	for (vp = CIRCLEbase;  vp < CIRCLEtop;  vp += 2)
+		if (x == *vp) {
+		  /* if (vp[1] == Cnil) */ vp[1] = Ct;
+			return;
+		}
+	if (CIRCLEtop >= CIRCLElimit)
+	  ecls_longjmp(CIRCLEjmp, 1); /* go back to allocate more space */
+	CIRCLEtop[0] = x;
+	CIRCLEtop[1] = Cnil;
+	CIRCLEtop += 2;
+
+	switch (t) {
+	case t_array:
+	  if ((enum aelttype)x->array.elttype == aet_object)
+	    for (i = 0;  i < x->array.dim;  i++)
+	      travel_push_object(x->array.self.t[i]);
+	  break;
+
+	case t_vector:
+	  if ((enum aelttype)x->vector.elttype == aet_object)
+	    for (i = 0;  i < x->vector.fillp;  i++)
+	      travel_push_object(x->vector.self.t[i]);
+	  break;
+
+	case t_cons:
+	  travel_push_object(CAR(x));
+	  x = CDR(x);
+	  goto BEGIN;
+
+#ifdef CLOS
+	case t_instance:
+	  for (i = 0;  i < x->instance.length;  i++)
+	    travel_push_object(x->instance.slots[i]);
+	  break;
+#else
+	case t_structure:
+	  for (i = 0;  i < x->str.length;  i++)
+	    travel_push_object(x->str.self[i]);
+#endif CLOS
+	default:
+	  /* INV: all types of 'x' have been handled */
+	}
+}
+
+void setupPRINT(cl_object x, cl_object strm)
+{
+	cl_object y;
+
+	PRINTstream = strm;
+RETRY:	if (type_of(PRINTstream) == t_stream) {
+	  if (PRINTstream->stream.mode == (short)smm_synonym) {
+ 		PRINTstream = symbol_value(PRINTstream->stream.object0);
+		goto RETRY;
+	      }
+	  else
+	  output_ch_fun = writec_PRINTstream;
+	} else
+#ifdef CLOS
+	  if (type_of(PRINTstream) == t_instance)
+	    output_ch_fun = interactive_writec_PRINTstream;
+	  else
+#endif CLOS
+	    { SYM_VAL(Vstandard_output) = symbol_value(Vterminal_io);
+	      FEwrong_type_argument(Sstream, PRINTstream);
+	    }
+	PRINTescape = symbol_value(Vprint_escape) != Cnil;
+	PRINTpretty = symbol_value(Vprint_pretty) != Cnil;
+	PRINTcircle = symbol_value(Vprint_circle) != Cnil;
+	y = symbol_value(Vprint_base);
+	if (!FIXNUMP(y) || fix(y) < 2 || fix(y) > 36) {
+		SYM_VAL(Vprint_base) = MAKE_FIXNUM(10);
+		FEerror("~S is an illegal PRINT-BASE.", 1, y);
+	} else
+		PRINTbase = fix(y);
+	PRINTradix = symbol_value(Vprint_radix) != Cnil;
+	PRINTcase = symbol_value(Vprint_case);
+	if (PRINTcase != Kupcase && PRINTcase != Kdowncase &&
+	    PRINTcase != Kcapitalize) {
+		SYM_VAL(Vprint_case) = Kdowncase;
+		FEerror("~S is an illegal PRINT-CASE.", 1, PRINTcase);
+	}
+	PRINTgensym = symbol_value(Vprint_gensym) != Cnil;
+	y = symbol_value(Vprint_level);
+	if (Null(y))
+		PRINTlevel = -1;
+	else if (!FIXNUMP(y) || fix(y) < 0) {
+		SYM_VAL(Vprint_level) = Cnil;
+		FEerror("~S is an illegal PRINT-LEVEL.", 1, y);
+	} else
+		PRINTlevel = fix(y);
+	y = symbol_value(Vprint_length);
+	if (Null(y))
+		PRINTlength = -1;
+	else if (!FIXNUMP(y) || fix(y) < 0) {
+		SYM_VAL(Vprint_length) = Cnil;
+		FEerror("~S is an illegal PRINT-LENGTH.", 1, y);
+	} else
+		PRINTlength = fix(y);
+	PRINTarray = symbol_value(Vprint_array) != Cnil;
+/*	setupPRINTcircle(x); */
+	if (PRINTpretty) {
+		qh = qt = qc = 0;
+		isp = iisp = 0;
+		indent_stack[0] = 0;
+		write_ch_fun = writec_queue;
+	} else
+		write_ch_fun = output_ch_fun;
+	PRINTpackage = symbol_value(siVprint_package);
+	if (PRINTpackage == Cnil) PRINTpackage = OBJNULL;
+	PRINTstructure = symbol_value(siVprint_structure) != Cnil;
+}
+
+void cleanupPRINT(void)
+{
+	if (PRINTpretty)
+		flush_queue(TRUE);
+}
+
+bool
+potential_number_p(cl_object strng, int base)
+{
+	int i, l, c; bool dc;
+	char *s;
+
+	l = strng->string.fillp;
+	if (l == 0)
+		return(FALSE);
+	s = strng->string.self;
+	dc = FALSE;
+	c = s[0];
+	if (digitp(c, base) >= 0)
+		dc = TRUE;
+	else if (c != '+' && c != '-' && c != '^' && c != '_')
+		return(FALSE);
+	if (s[l-1] == '+' || s[l-1] == '-')
+		return(FALSE);
+	for (i = 1;  i < l;  i++) {
+		c = s[i];
+		if (digitp(c, base) >= 0) {
+			dc = TRUE;
+			continue;
+		}
+		if (c != '+' && c != '-' && c != '/' && c != '.' &&
+		    c != '^' && c != '_' &&
+		    c != 'e' && c != 'E' &&
+		    c != 's' && c != 'S' && c != 'l' && c != 'L')
+			return(FALSE);
+	}
+	return(dc);
+}
+
+@(defun write (x
+	       &key ((:stream strm) Cnil)
+		    (escape symbol_value(Vprint_escape))
+		    (radix symbol_value(Vprint_radix))
+		    (base symbol_value(Vprint_base))
+		    (circle symbol_value(Vprint_circle))
+		    (pretty symbol_value(Vprint_pretty))
+		    (level symbol_value(Vprint_level))
+		    (length symbol_value(Vprint_length))
+		    ((:case cas) symbol_value(Vprint_case))
+		    (gensym symbol_value(Vprint_gensym))
+		    (array symbol_value(Vprint_array)))
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+ 		strm = symbol_value(strm->stream.object0);
+		goto RETRY;
+	      }
+	  else
+	    output_ch_fun = writec_PRINTstream;
+	} else
+#ifdef CLOS
+          if (type_of(strm) == t_instance)
+	    output_ch_fun = interactive_writec_PRINTstream;
+          else
+#endif CLOS
+            FEtype_error_stream(strm);
+	PRINTstream = strm;
+	PRINTescape = escape != Cnil;
+	PRINTpretty = pretty != Cnil;
+	PRINTcircle = circle != Cnil;
+	if (!FIXNUMP(base) || fix((base))<2 || fix((base))>36)
+		FEerror("~S is an illegal PRINT-BASE.", 1, base);
+	else
+		PRINTbase = fix((base));
+	PRINTradix = radix != Cnil;
+	PRINTcase = cas;
+	if (PRINTcase != Kupcase && PRINTcase != Kdowncase &&
+	    PRINTcase != Kcapitalize)
+		FEerror("~S is an illegal PRINT-CASE.", 1, cas);
+	PRINTgensym = gensym != Cnil;
+	if (Null(level))
+		PRINTlevel = -1;
+	else if (!FIXNUMP(level) || fix((level)) < 0)
+		FEerror("~S is an illegal PRINT-LEVEL.", 1, level);
+	else
+		PRINTlevel = fix((level));
+	if (Null(length))
+		PRINTlength = -1;
+	else if (!FIXNUMP(length) || fix((length)) < 0)
+		FEerror("~S is an illegal PRINT-LENGTH.", 1, length);
+	else
+		PRINTlength = fix((length));
+	PRINTarray = array != Cnil;
+	if (PRINTpretty) {
+		qh = qt = qc = 0;
+		isp = iisp = 0;
+		indent_stack[0] = 0;
+		write_ch_fun = writec_queue;
+	} else
+		write_ch_fun = output_ch_fun;
+	PRINTpackage = symbol_value(siVprint_package);
+	if (PRINTpackage == Cnil) PRINTpackage = OBJNULL;
+	PRINTstructure = symbol_value(siVprint_structure) != Cnil;
+  	setupPRINTcircle(x);
+	write_object(x, 0);
+	cleanupPRINT();
+	FLUSH_STREAM(PRINTstream);
+	@(return x)
+@)
+
+@(defun prin1 (obj &optional strm)
+@
+	prin1(obj, strm);
+	@(return obj)
+@)
+
+@(defun print (obj &optional strm)
+@
+	print(obj, strm);
+	@(return obj)
+@)
+
+@(defun pprint (obj &optional strm)
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+ 		strm = symbol_value(strm->stream.object0);
+		goto RETRY;
+	      }
+	  else
+	    output_ch_fun = writec_PRINTstream;
+	} else
+#ifdef CLOS
+          if (type_of(strm) == t_instance)
+	    output_ch_fun = interactive_writec_PRINTstream;
+          else
+#endif CLOS
+            FEtype_error_stream(strm);
+	setupPRINT(obj, strm);
+	PRINTescape = TRUE;
+	PRINTpretty = TRUE;
+	qh = qt = qc = 0;
+	isp = iisp = 0;
+	indent_stack[0] = 0;
+	write_ch_fun = writec_queue;
+	output_ch('\n');
+  	setupPRINTcircle(obj);
+	write_object(obj, 0);
+	cleanupPRINT();
+	FLUSH_STREAM(PRINTstream);
+	@(return)
+@)
+
+@(defun princ (obj &optional strm)
+@
+	princ(obj, strm);
+	@(return obj)
+@)
+
+@(defun write_char (c &optional strm)
+@
+	/* INV: char_code() checks the type of `c' */
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+ 		strm = symbol_value(strm->stream.object0);
+		goto RETRY;
+	      }
+	  else {
+	    writec_stream(char_code(c), strm);
+/*
+	    FLUSH_STREAM(strm);
+*/
+	    @(return c)
+	  }
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance) {
+	  interactive_writec_stream(char_code(c), strm);
+	  @(return c)
+	  }
+        else
+#endif
+          FEtype_error_stream(strm);
+@)
+
+@(defun write_string (strng &o strm &k (start MAKE_FIXNUM(0)) end)
+	cl_index s, e, i;
+@
+	get_string_start_end(strng, start, end, &s, &e);
+	assert_type_string(strng);
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+ 		strm = symbol_value(strm->stream.object0);
+		goto RETRY;
+	      }
+	  else {
+	    for (i = s;  i < e;  i++)
+	      writec_stream(strng->string.self[i], strm);
+	    flush_stream(strm);
+	  }
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	  funcall(4, Sstream_write_string, strm, strng,
+		  MAKE_FIXNUM(s), MAKE_FIXNUM(e));
+	else
+#endif
+          FEtype_error_stream(strm);
+	@(return strng)
+@)
+
+@(defun write_line (strng &o strm &k (start MAKE_FIXNUM(0)) end)
+	cl_index s, e, i;
+@
+	get_string_start_end(strng, start, end, &s, &e);
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+	assert_type_string(strng);
+
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+ 		strm = symbol_value(strm->stream.object0);
+		goto RETRY;
+	      }
+	  else {
+	    for (i = s;  i < e;  i++)
+	      writec_stream(strng->string.self[i], strm);
+	    writec_stream('\n', strm);
+	    flush_stream(strm);
+	  }
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance) {
+	  for (i = s;  i < e;  i++)
+	     interactive_writec_stream(strng->string.self[i], strm);
+	  interactive_writec_stream('\n', strm);
+	  flush_interactive_stream(strm);
+	} else
+#endif CLOS
+	    FEtype_error_stream(strm);
+	@(return strng)
+@)
+
+@(defun terpri (&optional strm)
+@
+	terpri(strm);
+	@(return Cnil)
+@)
+
+@(defun fresh_line (&optional strm)
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+ 		strm = symbol_value(strm->stream.object0);
+		goto RETRY;
+	      }
+	  else {
+	    if (FILE_COLUMN(strm) == 0)
+	      @(return Cnil)
+		writec_stream('\n', strm);
+	    flush_stream(strm);
+	    @(return Ct)
+	    }
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+  	    return funcall(2, Sstream_fresh_line,strm);
+	else
+#endif
+	 FEtype_error_stream(strm);
+@)
+
+@(defun force_output (&o strm)
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+ 		strm = symbol_value(strm->stream.object0);
+		goto RETRY;
+	      }
+	  else
+	    flush_stream(strm);
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	  flush_interactive_stream(strm);
+	else
+#endif CLOS
+	   FEtype_error_stream(strm);
+	@(return Cnil)
+@)
+
+@(defun clear_output (&o strm)
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+ 		strm = symbol_value(strm->stream.object0);
+		goto RETRY;
+	      }
+	  else
+	   clear_output_stream(strm);
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	  funcall(2, Sstream_clear_output, strm);
+	else
+#endif
+	  FEtype_error_stream(strm);
+	@(return Cnil)
+@)
+
+@(defun write_byte (integer binary_output_stream)
+@
+	if (!FIXNUMP(integer))
+		FEerror("~S is not a byte.", 1, integer);
+	assert_type_stream(binary_output_stream);
+	writec_stream(fix(integer), binary_output_stream);
+	@(return integer)
+@)
+
+@(defun write_bytes (stream string start end)
+        cl_index is, ie; FILE *fp;
+	int written, sofarwritten, towrite;
+@
+	assert_type_stream(stream);
+	if (stream->stream.mode == smm_closed)
+	  closed_stream(stream);
+
+        is = fix(start);	/* FIXME: Unsafe! */
+	ie = fix(end);
+        sofarwritten = is;
+	towrite = ie-is;
+        fp = stream->stream.file;
+	if (fp == NULL) fp = stream->stream.object1->stream.file;
+	while (towrite > 0) {
+	  written = write(fileno(fp),
+			  string->string.self+sofarwritten, towrite);
+	  if (written != -1) {
+	    towrite -= written;
+	    sofarwritten += written;
+	  }
+	  else @(return MAKE_FIXNUM(-1))
+	}
+	@(return MAKE_FIXNUM(sofarwritten - is))
+@)
+
+void
+init_print(void)
+{
+	SYM_VAL(Vprint_escape) = Ct;
+	SYM_VAL(Vprint_pretty) = Ct;
+	SYM_VAL(Vprint_circle) = Cnil;
+	SYM_VAL(Vprint_base) = MAKE_FIXNUM(10);
+	SYM_VAL(Vprint_radix) = Cnil;
+	SYM_VAL(Vprint_case) = Kupcase;
+	SYM_VAL(Vprint_gensym) = Ct;
+	SYM_VAL(Vprint_level) = Cnil;
+	SYM_VAL(Vprint_length) = Cnil;
+	SYM_VAL(Vprint_array) = Ct;
+
+	SYM_VAL(siVprint_package) = Cnil;
+	SYM_VAL(siVprint_structure) = Cnil;
+
+	PRINTstream = Cnil;
+	register_root(&PRINTstream);
+	PRINTescape = TRUE;
+	PRINTpretty = FALSE;
+	PRINTcircle = FALSE;
+	PRINTbase = 10;
+	PRINTradix = FALSE;
+	PRINTcase = Kupcase;
+	register_root(&PRINTcase);
+	PRINTgensym = TRUE;
+	PRINTlevel = -1;
+	PRINTlength = -1;
+	PRINTarray = FALSE;
+
+	write_ch_fun = writec_PRINTstream;
+	output_ch_fun = writec_PRINTstream;
+}
+
+cl_object
+princ(cl_object obj, cl_object strm)
+{
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+	if (obj == OBJNULL)
+		goto SIMPLE_CASE;
+	switch (type_of(obj)) {
+	case t_symbol:
+		PRINTcase = symbol_value(Vprint_case);
+		PRINTpackage = symbol_value(siVprint_package);
+		if (PRINTpackage == Cnil) PRINTpackage = OBJNULL;
+
+	SIMPLE_CASE:
+	case t_string:
+	case t_character:
+		PRINTstream = strm;
+		PRINTescape = FALSE;
+RETRY:		if (type_of(PRINTstream) == t_stream) {
+		  if (PRINTstream->stream.mode == (short)smm_synonym) {
+			PRINTstream = symbol_value(PRINTstream->stream.object0);
+			goto RETRY;
+		      }
+		  else
+		    write_ch_fun = writec_PRINTstream;
+		} else
+#ifdef CLOS
+		  if (type_of(PRINTstream) == t_instance)
+		    write_ch_fun = interactive_writec_PRINTstream;
+		  else
+#endif CLOS
+		    FEtype_error_stream(strm);
+		write_object(obj, 0);
+		break;
+
+	default:
+		setupPRINT(obj, strm);
+		PRINTescape = FALSE;
+		write_object(obj, 0);
+		cleanupPRINT();
+	}
+	return(obj);
+}
+
+cl_object
+prin1(cl_object obj, cl_object strm)
+{
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+	if (obj == OBJNULL)
+		goto SIMPLE_CASE;
+	switch (type_of(obj)) {
+	SIMPLE_CASE:
+	case t_string:
+	case t_character:
+		PRINTstream = strm;
+		PRINTescape = TRUE;
+RETRY:		if (type_of(PRINTstream) == t_stream) {
+		  if (PRINTstream->stream.mode == (short)smm_synonym) {
+			PRINTstream = symbol_value(PRINTstream->stream.object0);
+			goto RETRY;
+		      }
+		  else
+		    write_ch_fun = writec_PRINTstream;
+		} else
+#ifdef CLOS
+		  if (type_of(PRINTstream) == t_instance)
+		    write_ch_fun = interactive_writec_PRINTstream;
+		  else
+#endif CLOS
+		    FEtype_error_stream(strm);
+		write_object(obj, 0);
+		break;
+
+	default:
+		setupPRINT(obj, strm);
+		PRINTescape = TRUE;
+		setupPRINTcircle(obj);
+		write_object(obj, 0);
+		cleanupPRINT();
+	}
+	FLUSH_STREAM(PRINTstream);
+	return(obj);
+}
+
+cl_object
+print(cl_object obj, cl_object strm)
+{
+	terpri(strm);
+	prin1(obj, strm);
+	princ_char(' ', strm);
+	return obj;
+}
+
+cl_object
+terpri(cl_object strm)
+{
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else
+	    write_ch_fun = writec_stream;
+	} else
+#ifdef CLOS
+	  if (type_of(strm) == t_instance)
+	    write_ch_fun = interactive_writec_stream;
+	  else
+#endif CLOS
+	    FEtype_error_stream(strm);
+	write_ch('\n', strm);
+	FLUSH_STREAM(strm);
+	return(Cnil);
+}
+
+void
+write_string(cl_object strng, cl_object strm)
+{
+	cl_index i;
+
+	if (Null(strm))
+		strm = symbol_value(Vstandard_output);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+	assert_type_string(strng);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else {
+	    for (i = 0;  i < strng->string.fillp;  i++)
+	      writec_stream(strng->string.self[i], strm);
+	    flush_stream(strm);
+	  }
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance) {
+	  for (i = 0;  i < strng->string.fillp;  i++)
+		interactive_writec_stream(strng->string.self[i], strm);
+	  flush_interactive_stream(strm);
+	} else
+#endif CLOS
+	  FEtype_error_stream(strm);
+}
+
+/*
+	THE ULTRA-SPECIAL-DINNER-SERVICE OPTIMIZATION
+*/
+void
+princ_str(const char *s, cl_object sym)
+{
+/*	sym = symbol_value(sym);		Beppe */
+	if (Null(sym))
+		sym = symbol_value(Vstandard_output);
+	else if (sym == Ct)
+		sym = symbol_value(Vterminal_io);
+RETRY:	if (type_of(sym) == t_stream) {
+          if (sym->stream.mode == (short)smm_synonym) {
+	    sym = symbol_value(sym->stream.object0);
+	    goto RETRY;
+	  }
+	  else
+	    writestr_stream(s, sym);
+	} else
+#ifdef CLOS
+	if (type_of(sym) == t_instance)
+	  while (*s != '\0')
+		interactive_writec_stream(*s++, sym);
+	else
+#endif CLOS
+	  FEerror("~S is not a stream.", 1, sym);
+}
+
+void
+princ_char(int c, cl_object sym)
+{
+/*	sym = symbol_value(sym); 		Beppe */
+	if (Null(sym))
+		sym = symbol_value(Vstandard_output);
+	else if (sym == Ct)
+		sym = symbol_value(Vterminal_io);
+RETRY:	if (type_of(sym) == t_stream) {
+          if (sym->stream.mode == (short)smm_synonym) {
+	    sym = symbol_value(sym->stream.object0);
+	    goto RETRY;
+	  }
+	  else {
+	    writec_stream(c, sym);
+	    if (c == '\n')
+	      flush_stream(sym);
+	  }
+	} else
+#ifdef CLOS
+	if (type_of(sym) == t_instance) {
+	  interactive_writec_stream(c, sym);
+	  if (c == '\n')
+		flush_interactive_stream(sym);
+	} else
+#endif CLOS
+	  FEerror("~S is not a stream.", 1, sym);
+}
diff --git a/src/c/profile.d b/src/c/profile.d
new file mode 100644
index 000000000..511a04145
--- /dev/null
+++ b/src/c/profile.d
@@ -0,0 +1,137 @@
+/*  profile.c -- profiling tool						*/
+/*
+    Copyright (c) 1996, Giuseppe Attardi.
+
+    This program is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+/*
+ *----------------------------------------------------------------------
+ * Profiling tool
+ * ----------------------------------------------------------------------
+ */
+
+extern caddr_t	*function_entry_table;
+extern int	function_entries;
+
+static object sSAprofile_arrayA;
+static caddr_t profile_start;
+static unsigned int profile_scale;
+
+/*
+ *----------------------------------------------------------------------
+ * profile resolution start-address
+ *   scale is a value between 0 and 16384:
+ *	0 means stop profiling, other values represent the size of
+ *	consecutive groups of instructions to which each tick is attributed
+ *   Only (length *profile-array*) / (2 * scale) intructions from
+ *   start-address are profiled.
+ *----------------------------------------------------------------------
+ */
+
+extern int siLmake_vector (int narg, object etype, object dim, object adj, object fillp, object displ, object disploff, object staticp);
+extern void profil (short unsigned int *, size_t, int, unsigned int);
+
+siLprofile(int narg, object scale, object start_address)
+{
+  int size;
+  object ar = sSAprofile_arrayA->symbol.dbind;
+  if ((narg > 2) || (narg == 0))
+    check_arg_failed(narg, 2);
+  if (narg == 1)
+    profile_start = (caddr_t)function_entry_table[0];
+  else
+    profile_start = (caddr_t)fixnnint(start_address);
+  profile_scale = fixnnint(scale);
+  if (type_of(ar) != t_vector) {
+    size = (int)function_entry_table[(function_entries-1)*2]
+      - (int)profile_start;
+    size = size / (sizeof(int) * 2 * profile_scale);
+    ar = siLmake_vector(7, Sfixnum, MAKE_FIXNUM(size),
+		   Cnil, Cnil, Cnil, Cnil,
+		   Ct);		/* static: must not be moved by GC */
+    sSAprofile_arrayA->symbol.dbind = ar;
+  }
+  else
+#   define	inheap(pp)	((unsigned long)(pp) < (unsigned long)heap_end)
+    if (!inheap(ar->array.self.fix))
+      FEerror("SI:*PROFILE-ARRAY* must be a static array", 0);
+  if (profile_scale > 0)
+    profile_scale = 65536 / ( 2 * profile_scale);
+  profil((unsigned short *)ar->array.self.fix, ar->array.dim * sizeof(int),
+	 profile_start, profile_scale);
+#error "Not fixed"
+  VALUES(0) = MAKE_FIXNUM(profile_start);
+  RETURN(1);
+}
+
+siLclear_profile(int narg)
+{
+  int i;
+  object ar = sSAprofile_arrayA->symbol.dbind;
+  check_arg(0);
+  if (type_of(ar) != t_vector)
+    FEerror("SI:*PROFILE-ARRAY* must be an array of FIXNUM", 0);
+  for (i = 0;  i < ar->array.dim;  i++)
+      ar->array.self.fix[i] = 0;
+}
+
+total_ticks(unsigned short *aar, unsigned int dim)
+{
+  register unsigned short *endar = aar+dim;
+  register int count = 0;
+  for ( ; aar < endar; aar++)
+    count += *aar;
+  return count;
+}
+
+siLdisplay_profile(int narg)
+{
+  caddr_t prev, next;
+  unsigned upto, dim;
+  int i, j, scale, count, total;
+  unsigned short *ar;
+  object obj_ar = sSAprofile_arrayA->symbol.dbind;
+  int groupSize = 0x20000 / profile_scale;
+
+  check_arg(0);
+  if (type_of(obj_ar) != t_vector)
+    FEerror("si:*profile-array* not a vector", 0);
+  ar = (unsigned short *)obj_ar->array.self.fix;
+  dim = obj_ar->array.dim * (sizeof(int) / sizeof(short));
+
+  total = total_ticks(ar, dim);
+
+  for (i = 0; i < 2*function_entries; i += 2, prev = next) {
+    prev = function_entry_table[i];
+    if (prev < profile_start) continue;
+
+    if (i+2 == 2*function_entries)
+      upto = dim;
+    else {
+    next = function_entry_table[i+2];
+      upto = (next > profile_start)
+	? (next - profile_start) / groupSize : 0;
+      if (upto >= dim) upto = dim;
+    }
+    count = 0;
+    for (j = (prev - profile_start) / groupSize; j < upto; j++)
+      count += ar[j];
+    if (count > 0) {
+      object name = (object)function_entry_table[i+1];
+      printf("\n%6.2f%% (%5d): ", 100.0 * count/total, count);
+      prin1(name, Cnil);
+      fflush(stdout);
+    }
+    if (upto == dim) break;
+  }
+  printf("\nTotal ticks: %d\n", total); fflush(stdout);
+  RETURN(0);
+}
diff --git a/src/c/read.d b/src/c/read.d
new file mode 100644
index 000000000..52c77703d
--- /dev/null
+++ b/src/c/read.d
@@ -0,0 +1,2405 @@
+/*
+    read.d -- Read.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "ecls-inl.h"
+#include <ctype.h>
+
+/******************************* EXPORTS ******************************/
+
+cl_object standard_readtable;
+
+cl_object Vreadtable;
+cl_object Vread_default_float_format;
+cl_object Vread_base;
+cl_object Vread_suppress;
+
+cl_object Kjunk_allowed;
+
+cl_object siSsharp_comma;
+
+#ifndef THREADS
+cl_object READtable;
+int READdefault_float_format;
+int READbase;
+bool READsuppress;
+bool preserving_whitespace_flag;
+bool escape_flag;
+cl_object delimiting_char;
+bool detect_eos_flag;
+bool in_list_flag;
+bool dot_flag;
+cl_object default_dispatch_macro;
+cl_object sharp_eq_context;
+cl_object (*read_ch_fun)() = readc;
+#endif THREADS
+
+#ifdef CLOS
+cl_object Sstream_read_line,
+  Sstream_read_char,
+  Sstream_unread_char,
+  Sstream_peek_char,
+  Sstream_listen,
+  Sstream_clear_input;
+#endif
+
+/******************************* ------- ******************************/
+
+static cl_object dispatch_reader;
+
+#define	token_buffer	cl_token->string.self
+
+#define	cat(c)	(READtable->readtable.table[char_code((c))].syntax_type)
+
+static void too_long_token (void);
+static void too_long_string (void);
+static void extra_argument (int c, cl_object d);
+
+static void
+setup_READtable(void)
+{
+	READtable = current_readtable();
+}
+
+static void
+setup_READ(void)
+{
+	cl_object x;
+
+	READtable = current_readtable();
+	x = symbol_value(Vread_default_float_format);
+	if (x == Ssingle_float || x == Sshort_float)
+		READdefault_float_format = 'S';
+	else if (x == Sdouble_float || x == Slong_float)
+		READdefault_float_format = 'F';
+	else {
+		SYM_VAL(Vread_default_float_format) = Ssingle_float;
+	FEerror("The value of *READ-DEFAULT-FLOAT-FORMAT*, ~S, was illegal.",
+			1, x);
+	}
+	x = symbol_value(Vread_base);
+	if (!FIXNUMP(x) || fix(x) < 2 || fix(x) > 36) {
+		SYM_VAL(Vread_base) = MAKE_FIXNUM(10);
+		FEerror("The value of *READ-BASE*, ~S, was illegal.", 1, x);
+	}
+	READbase = fix(x);
+	READsuppress = symbol_value(Vread_suppress) != Cnil;
+}
+
+static void
+setup_standard_READ(void)
+{
+	READtable = standard_readtable;
+	READdefault_float_format = 'S';
+	READbase = 10;
+	READsuppress = FALSE;
+	sharp_eq_context = Cnil;
+	backq_level = 0;
+}
+
+#ifdef CLOS
+cl_object
+interactive_readc(cl_object stream)
+{
+	return _funcall(2, Sstream_read_char, stream);
+}
+#endif CLOS
+
+cl_object
+readc(cl_object in)
+{
+	return(code_char(readc_stream(in)));
+}
+
+#define	read_char(in)	(*read_ch_fun)(in)
+
+void unread_char(cl_object c, cl_object in)
+{
+	/* INV: char_code() checks the type of `c' */
+#ifdef CLOS
+	if (type_of(in) == t_instance)
+	  funcall(3, Sstream_unread_char, in, c);
+	else
+#endif
+	  unreadc_stream(char_code(c), in);
+}
+
+/*
+	peek_char corresponds to COMMON Lisp function PEEK-CHAR.
+	When pt is TRUE, preceeding whitespaces are ignored.
+*/
+cl_object
+peek_char(bool pt, cl_object in)
+{
+	cl_object c;
+
+	c = read_char(in);
+	if (pt)
+	  while (cat(c) == cat_whitespace)
+	    c = read_char(in);
+	unread_char(c, in);
+	return(c);
+}
+
+static cl_object
+read_object_recursive(cl_object in)
+{
+	volatile cl_object x;
+	bool e;
+
+	cl_object old_READtable = READtable;
+	int old_READdefault_float_format = READdefault_float_format;
+	int old_READbase = READbase;
+	bool old_READsuppress = READsuppress;
+
+	if (frs_push(FRS_PROTECT, Cnil))
+		e = TRUE;
+	else {
+		setup_READ();
+		x = read_object(in);
+		e = FALSE;
+	}
+	frs_pop();
+
+	READtable = old_READtable;
+	READdefault_float_format = old_READdefault_float_format;
+	READbase = old_READbase;
+	READsuppress = old_READsuppress;
+
+	if (e) unwind(nlj_fr, nlj_tag);
+	return(x);
+}
+
+cl_object
+read_object_non_recursive(cl_object in)
+{
+	volatile cl_object x;
+	bool e;
+	cl_object old_READtable;
+	int old_READdefault_float_format;
+	int old_READbase;
+	int old_READsuppress;
+	int old_backq_level;
+	cl_object old_sharp_eq_context;
+
+	old_READtable = READtable;
+	old_READdefault_float_format = READdefault_float_format;
+	old_READbase = READbase;
+	old_READsuppress = READsuppress;
+	old_sharp_eq_context = sharp_eq_context;
+	old_backq_level = backq_level;
+	setup_READ();
+	sharp_eq_context = Cnil;
+	backq_level = 0;
+
+	if (frs_push(FRS_PROTECT, Cnil))
+		e = TRUE;
+	else {
+	  	static cl_object patch_sharp(cl_object x);
+		e = FALSE;
+		x = read_object(in);
+		if (!Null(sharp_eq_context))
+			x = patch_sharp(x);
+	}
+	frs_pop();
+
+	READtable = old_READtable;
+	READdefault_float_format = old_READdefault_float_format;
+	READbase = old_READbase;
+	READsuppress = old_READsuppress;
+	sharp_eq_context = old_sharp_eq_context;
+	backq_level = old_backq_level;
+	if (e) unwind(nlj_fr, nlj_tag);
+	return(x);
+}
+
+#if TK
+extern bool no_input;
+#define GETC(c, fp)	{ if (fp == stdin) \
+			   while (no_input) Tk_DoOneEvent(0); \
+			  c = getc(fp); \
+			  no_input = !FILE_CNT(fp); }
+#else
+#define GETC(c, fp)	c = getc(fp)
+#endif /* TK */
+
+/* Beppe: faster code for inner loop from file stream */
+#if !defined(CLOS)
+#define READ_CHAR_TO(res, in, eof_code) \
+  {FILE *fp = in->stream.file; \
+     if (fp) { int ch; \
+	       GETC(ch, fp); \
+	       if (ch == EOF) \
+		 {eof_code;} \
+	       else res = code_char(ch);} \
+      else \
+	if (stream_at_end(in)) \
+	   {eof_code;} \
+	else res = read_char(in);}
+#else
+#define READ_CHAR_TO(res, in, eof_code) \
+  {if (stream_at_end(in)) {eof_code;} else res = read_char(in);}
+#endif unix
+
+/*
+	Read_object(in) reads an object from stream in.
+	This routine corresponds to COMMON Lisp function READ.
+*/
+cl_object
+read_object(cl_object in)
+{
+	cl_object x, c;
+	enum chattrib a;
+	cl_object old_delimiter, p;
+	cl_index length, i, colon;
+	int colon_type;
+	bool df, ilf;
+
+	cs_check(in);
+
+	old_delimiter = delimiting_char;
+	delimiting_char = OBJNULL;
+	df = detect_eos_flag;
+	detect_eos_flag = FALSE;
+	ilf = in_list_flag;
+	in_list_flag = FALSE;
+	dot_flag = FALSE;
+
+BEGIN:
+	/* Beppe: */
+	do {
+		READ_CHAR_TO(c, in, if (df) return(OBJNULL);
+					else
+					    FEend_of_file(in));
+		a = cat(c);
+	} while (a == cat_whitespace);
+	delimiting_char = OBJNULL;
+	if (old_delimiter != OBJNULL && old_delimiter == c)
+		return(OBJNULL);
+	if (a == cat_terminating || a == cat_non_terminating) {
+		cl_object x = READtable->readtable.table[char_code(c)].macro;
+		cl_object o = _funcall(3, x, in, c);
+		if (NValues == 0) goto BEGIN;
+		if (NValues > 1) FEerror("The readmacro ~S returned ~D values.",
+					 2, x, MAKE_FIXNUM(i));
+		return o;
+	}
+	escape_flag = FALSE;
+	length = 0;
+	colon_type = 0;
+	for (;;) {
+		if (a == cat_single_escape) {
+			c = read_char(in);
+			a = cat_constituent;
+			escape_flag = TRUE;
+		} else if (a == cat_multiple_escape) {
+			escape_flag = TRUE;
+			for (;;) {
+				if (stream_at_end(in))
+					FEend_of_file(in);
+				c = read_char(in);
+				a = cat(c);
+				if (a == cat_single_escape) {
+					c = read_char(in);
+					a = cat_constituent;
+				} else if (a == cat_multiple_escape)
+					break;
+				if (length >= cl_token->string.dim)
+					too_long_token();
+				token_buffer[length++] = char_code(c);
+			}
+			goto NEXT;
+		} else if ('a' <= char_code(c) && char_code(c) <= 'z')
+			c = code_char(toupper(char_code(c)));
+		else if (char_code(c) == ':') {
+			if (colon_type == 0) {
+				colon_type = 1;
+				colon = length;
+			} else if (colon_type == 1 && colon == length-1)
+				colon_type = 2;
+			else
+				colon_type = -1;
+				/*  Colon has appeared twice.  */
+		}
+		if (a == cat_whitespace || a == cat_terminating) {
+			if (preserving_whitespace_flag ||
+			    cat(c) != cat_whitespace)
+				unread_char(c, in);
+			break;
+		}
+		if (length >= cl_token->string.dim)
+			too_long_token();
+		token_buffer[length++] = char_code(c);
+	NEXT:
+		READ_CHAR_TO(c, in, break);
+		a = cat(c);
+	}
+
+	if (READsuppress) {
+		cl_token->string.fillp = length;
+		return(Cnil);
+	}
+	if (ilf && !escape_flag &&
+	    length == 1 && cl_token->string.self[0] == '.') {
+		dot_flag = TRUE;
+		return(Cnil);
+	} else if (!escape_flag && length > 0) {
+		for (i = 0;  i < length;  i++)
+			if (cl_token->string.self[i] != '.')
+				goto N;
+		FEerror("Dots appeared illegally.", 0);
+	}
+
+N:
+	cl_token->string.fillp = length;
+	if (escape_flag || (READbase <= 10 && token_buffer[0] > '9'))
+		goto SYMBOL;
+	x = parse_number(token_buffer, length, &i, READbase);
+	if (x != OBJNULL && length == i)
+		return(x);
+
+SYMBOL:
+	if (colon_type == 1 /* && length > colon + 1 */) {
+		if (colon == 0)
+			p = keyword_package;
+		else {
+			cl_token->string.fillp = colon;
+			p = find_package(cl_token);
+			if (Null(p))
+			    FEerror("There is no package with the name ~A.",
+				    1, copy_simple_string(cl_token));
+		}
+		for (i = colon + 1;  i < length;  i++)
+			token_buffer[i - (colon + 1)]
+			= token_buffer[i];
+		cl_token->string.fillp = length - (colon + 1);
+		if (colon > 0) {
+			cl_token->string.self[cl_token->string.fillp] = '\0';
+			x = find_symbol(cl_token, p);
+			if (intern_flag != EXTERNAL)
+			FEerror("Cannot find the external symbol ~A in ~S.",
+						2, copy_simple_string(cl_token), p);
+			return(x);
+		}
+	} else if (colon_type == 2 /* && colon > 0 && length > colon + 2 */) {
+		cl_token->string.fillp = colon;
+		p = find_package(cl_token);
+		if (Null(p))
+			FEerror("There is no package with the name ~A.",
+				1, copy_simple_string(cl_token));
+		for (i = colon + 2;  i < length;  i++)
+			token_buffer[i - (colon + 2)] = token_buffer[i];
+		cl_token->string.fillp = length - (colon + 2);
+	} else
+		p = current_package();
+	token_buffer[cl_token->string.fillp] = '\0';
+	x = intern(cl_token, p);
+	if (x->symbol.name == cl_token)
+		x->symbol.name = copy_simple_string(cl_token);
+	return(x);
+}
+
+#define	is_exponent_marker(i)	\
+	((i) == 'e' || (i) == 'E' ||	\
+	 (i) == 's' || (i) == 'S' || (i) == 'f' || (i) == 'F' || \
+	 (i) == 'd' || (i) == 'D' || (i) == 'l' || (i) == 'L' || \
+	 (i) == 'b' || (i) == 'B')
+
+#define basep(d)	(d <= 36)
+
+/*
+	parse_number(s, end, ep, radix) parses C string s
+	up to (but not including) s[end]
+	using radix as the radix for the rational number.
+	(For floating numbers, radix should be 10.)
+	When parsing succeeds,
+	the index of the next character is assigned to *ep,
+	and the number is returned as a lisp data object.
+	If not, OBJNULL is returned.
+*/
+cl_object
+parse_number(char *s, cl_index end, cl_index *ep, int radix)
+{
+	cl_object x, y;
+	int sign;
+	cl_object integer_part;
+	double fraction, fraction_unit, f;
+	char exponent_marker;
+	int exponent, d;
+	cl_index i, j, k;
+
+	if (s[end-1] == '.')
+		radix = 10;
+		/*
+			DIRTY CODE!!
+		*/
+BEGIN:
+	exponent_marker = 'E';
+	i = 0;
+	sign = 1;
+	if (s[i] == '+')
+		i++;
+	else if (s[i] == '-') {
+		sign = -1;
+		i++;
+	}
+	integer_part = big_register0_get();
+	if (i >= end)
+		goto NO_NUMBER;
+	if (s[i] == '.') {
+		if (radix != 10) {
+			radix = 10;
+			goto BEGIN;
+		}
+		i++;
+		goto FRACTION;
+	}
+	if (!basep(radix) || (d = digitp(s[i], radix)) < 0)
+		goto NO_NUMBER;
+	do {
+		big_mul_ui(integer_part, radix);
+		big_add_ui(integer_part, d);
+		i++;
+	} while (i < end && (d = digitp(s[i], radix)) >= 0);
+	if (i >= end)
+		goto MAKE_INTEGER;
+	if (s[i] == '.') {
+		if (radix != 10) {
+			radix = 10;
+			goto BEGIN;
+		}
+		if (++i >= end)
+			goto MAKE_INTEGER;
+		else if (digitp(s[i], radix) >= 0)
+			goto FRACTION;
+		else if (is_exponent_marker(s[i])) {
+			fraction = (double)sign * big_to_double(integer_part);
+			goto EXPONENT;
+		} else
+			goto MAKE_INTEGER;
+	}
+	if (s[i] == '/') {
+	  i++;
+	  if (sign < 0)
+	    big_complement(integer_part);
+	  x = big_register_normalize(integer_part);
+
+	  /* 		DENOMINATOR			 */
+
+	  if ((d = digitp(s[i], radix)) < 0)
+	    goto NO_NUMBER;
+	  integer_part = big_register0_get();
+	  do {
+	    big_mul_ui(integer_part, radix);
+	    big_add_ui(integer_part, d);
+	    i++;
+	  } while (i < end && (d = digitp(s[i], radix)) >= 0);
+	  y = big_register_normalize(integer_part);
+	  x = make_ratio(x, y);
+	  goto END;
+	}
+
+	if (is_exponent_marker(s[i])) {
+		fraction = (double)sign * big_to_double(integer_part);
+		goto EXPONENT;
+	}
+
+	goto NO_NUMBER;
+
+MAKE_INTEGER:
+	if (sign < 0)
+		big_complement(integer_part);
+	x = big_register_normalize(integer_part);
+	goto END;
+
+FRACTION:
+
+	if (radix != 10)
+		goto NO_NUMBER;
+
+	radix = 10;
+	if ((d = digitp(s[i], radix)) < 0)
+		goto NO_NUMBER;
+	fraction = 0.0;
+	fraction_unit = 1000000000.0;
+	for (;;) {
+		k = j = 0;
+		do {
+			j = 10*j + d;
+			i++;
+			k++;
+			if (i < end)
+				d = digitp(s[i], radix);
+			else
+				break;
+		} while (k < 9 && d >= 0);
+		while (k++ < 9)
+			j *= 10;
+		fraction += ((double)j /fraction_unit);
+		if (i >= end || d < 0)
+			break;
+		fraction_unit *= 1000000000.0;
+	}
+	fraction += big_to_double(integer_part);
+	fraction *= (double)sign;
+	if (i >= end)
+		goto MAKE_FLOAT;
+	if (is_exponent_marker(s[i]))
+		goto EXPONENT;
+	goto MAKE_FLOAT;
+
+EXPONENT:
+
+	if (radix != 10)
+		goto NO_NUMBER;
+
+	radix = 10;
+	exponent_marker = s[i];
+	i++;
+	if (i >= end)
+		goto NO_NUMBER;
+	sign = 1;
+	if (s[i] == '+')
+		i++;
+	else if (s[i] == '-') {
+		sign = -1;
+		i++;
+	}
+	if (i >= end)
+		goto NO_NUMBER;
+	if ((d = digitp(s[i], radix)) < 0)
+		goto NO_NUMBER;
+	exponent = 0;
+	do {
+		exponent = 10 * exponent + d;
+		i++;
+	} while (i < end && (d = digitp(s[i], radix)) >= 0);
+	d = exponent;
+	f = 10.0;
+	/* Use pow because it is more accurate */
+	{
+	  double pow(double, double);
+	  double po = pow(10.0, (double)(sign * d));
+          if (po == 0.0) {
+	    fraction *= pow(10.0, (double)(sign * (d-1)));
+	    fraction /= 10.0;
+	  } else     
+	    fraction *= po;
+	}
+
+MAKE_FLOAT:
+	switch (exponent_marker) {
+
+	case 'e':  case 'E':
+		exponent_marker = READdefault_float_format;
+		goto MAKE_FLOAT;
+
+	case 's':  case 'S':
+#ifdef IEEEFLOAT
+		{
+		  float biggest_float;
+		  *((int *)&biggest_float) = 0x7f7fffff;
+		  if (fraction > biggest_float || fraction < -biggest_float)
+		    FEerror("Floating-point overflow.", 0);
+		}
+#endif
+		x = make_shortfloat((float)fraction);
+		break;
+
+	case 'f':  case 'F':  case 'd':  case 'D':  case 'l':  case 'L':
+#ifdef IEEEFLOAT
+		if ((*((int *)&fraction + HIND) & 0x7ff00000) == 0x7ff00000)
+		  FEerror("Floating-point overflow.", 0);
+#endif
+		x = make_longfloat((double)fraction);
+		break;
+
+	case 'b':  case 'B':
+		goto NO_NUMBER;
+	}
+
+END:
+	*ep = i;
+	return(x);
+
+NO_NUMBER:
+	*ep = i;
+	return(OBJNULL);
+}
+
+cl_object
+parse_integer(char *s, cl_index end, cl_index *ep, int radix)
+{
+	cl_object x;
+	int sign, d;
+	cl_object integer_part;
+	cl_index i;
+
+	i = 0;
+	sign = 1;
+	if (s[i] == '+')
+		i++;
+	else if (s[i] == '-') {
+		sign = -1;
+		i++;
+	}
+	if (i >= end || !basep(radix) || (d = digitp(s[i], radix)) < 0) {
+	  *ep = i;
+	  return(OBJNULL);
+	}
+	integer_part = big_register0_get();
+	do {
+		big_mul_ui(integer_part, radix);
+		big_add_ui(integer_part, d);
+		i++;
+	} while (i < end && (d = digitp(s[i], radix)) >= 0);
+	if (sign < 0)
+		big_complement(integer_part);
+	x = big_register_normalize(integer_part);
+	*ep = i;
+	return(x);
+}
+
+static
+@(defun left_parenthesis_reader (in c)
+  cl_object x, y;
+  cl_object *p;
+@
+  y = Cnil;
+  for (p = &y ; ; p = &(CDR(*p))) {
+    delimiting_char = code_char(')');
+    in_list_flag = TRUE;
+    x = read_object(in);
+    if (x == OBJNULL)
+      break;
+    if (dot_flag) {
+      if (p == &y)
+	FEerror("A dot appeared after a left parenthesis.", 0);
+      in_list_flag = TRUE;
+      *p = read_object(in);
+      if (dot_flag)
+	FEerror("Two dots appeared consecutively.", 0);
+      c = read_char(in);
+      while (cat(c) == cat_whitespace)
+	c = read_char(in);
+      if (char_code(c) != ')')
+	FEerror("A dot appeared before a right parenthesis.", 0);
+      break;
+    }
+    *p = CONS(x, Cnil);
+  }
+  @(return y)
+@)
+/*
+	read_string(delim, in) reads
+	a simple string	terminated by character code delim
+	and places it in token.
+	Delim is not included in the string but discarded.
+*/
+static void
+read_string(int delim, cl_object in)
+{
+	cl_index i;
+	cl_object c;
+
+	i = 0;
+	for (;;) {
+		c = read_char(in);
+		if (char_code(c) == delim)
+			break;
+		else if (cat(c) == cat_single_escape)
+			c = read_char(in);
+		if (i >= cl_token->string.dim)
+			too_long_string();
+		token_buffer[i++] = char_code(c);
+	}
+	cl_token->string.fillp = i;
+	cl_token->string.self[i] = '\0';
+}
+
+/*
+	Read_constituent(in) reads
+	a sequence of constituent characters from stream in
+	and places it in token_buffer.
+*/
+static void
+read_constituent(cl_object in)
+{
+	size_t i;
+	cl_object c;
+
+	i = 0;
+	for (;;) {
+		c = read_char(in);
+		if (cat(c) != cat_constituent) {
+			unread_char(c, in);
+			break;
+		}
+		token_buffer[i++] = char_code(c);
+	}
+	cl_token->string.fillp = i;
+}
+
+static
+@(defun double_quote_reader (in c)
+@
+	read_string('"', in);
+	@(return copy_simple_string(cl_token))
+@)
+
+static
+@(defun dispatch_reader (in dc)
+	cl_object c, x, y;
+	int i, d;
+@
+	if (READtable->readtable.table[char_code(dc)].dispatch_table == NULL)
+		FEerror("~C is not a dispatching macro character", 1, dc);
+
+	c = read_char(in);
+	d = digitp((int)char_code(c), 10);
+	if (d >= 0) {
+		i = 0;
+		do {
+			i = 10*i + d;
+			c = read_char(in);
+			d = digitp(char_code(c), 10);
+		} while (d >= 0);
+		y = MAKE_FIXNUM(i);
+	} else
+		y = Cnil;
+
+	x = READtable->readtable.table[char_code(dc)].dispatch_table[char_code(c)];
+	return funcall(4, x, in, c, y);
+@)
+
+static
+@(defun single_quote_reader (in c)
+@
+	@(return CONS(Squote, CONS(read_object(in), Cnil)))
+@)
+
+static
+@(defun void_reader (in c)
+@
+	/*  no result  */
+	@(return)
+@)
+
+#define Lright_parenthesis_reader Lvoid_reader
+
+/*
+int
+Lcomma_reader(){} in backq.c
+*/
+
+static
+@(defun semicolon_reader (in c)
+@
+	do
+		c = read_char(in);
+	while (char_code(c) != '\n');
+	/*  no result  */
+	@(return)
+@)
+
+/*
+int
+Lbackquote_reader(){}
+*/
+
+/*
+	sharpmacro routines
+*/
+
+static
+@(defun sharp_C_reader (in c d)
+	cl_object x, real, imag;
+@
+	if (d != Cnil && !READsuppress)
+		extra_argument('C', d);
+	c = read_char(in);
+	if (char_code(c) != '(')
+		FEerror("A left parenthesis is expected.", 0);
+	delimiting_char = code_char(')');
+	real = read_object(in);
+	if (real == OBJNULL)
+		FEerror("No real part.", 0);
+	delimiting_char = code_char(')');
+	imag = read_object(in);
+	if (imag == OBJNULL)
+		FEerror("No imaginary part.", 0);
+	delimiting_char = code_char(')');
+	x = read_object(in);
+	if (x != OBJNULL)
+		FEerror("A right parenthesis is expected.", 0);
+	if (READsuppress)
+		@(return Cnil)
+	if (contains_sharp_comma(real) ||
+	    contains_sharp_comma(imag)) {
+		x = alloc_object(t_complex);
+		x->complex.real = real;
+		x->complex.imag = imag;
+	} else {
+		/* INV: make_complex() checks its types */
+		x = make_complex(real, imag);
+	}
+	@(return x)
+@)
+
+static
+@(defun sharp_backslash_reader (in c d)
+@
+	if (d != Cnil && !READsuppress)
+		if (!FIXNUMP(d) ||
+		    fix(d) != 0)
+			FEerror("~S is an illegal CHAR-FONT.", 1, d);
+			/*  assuming that CHAR-FONT-LIMIT is 1  */
+	unread_char(code_char('\\'), in);
+	if (READsuppress) {
+		(void)read_object(in);
+		@(return Cnil)
+	}
+	READsuppress = TRUE;
+	(void)read_object(in);
+	READsuppress = FALSE;
+	c = cl_token;
+	if (c->string.fillp == 1)
+		c = code_char(c->string.self[0]);
+	else if (string_equal(c, STreturn))
+		c = code_char('\r');
+	else if (string_equal(c, STspace))
+		c = code_char(' ');
+	else if (string_equal(c, STrubout))
+		c = code_char('\177');
+	else if (string_equal(c, STpage))
+		c = code_char('\f');
+	else if (string_equal(c, STtab))
+		c = code_char('\t');
+	else if (string_equal(c, STbackspace))
+		c = code_char('\b');
+	else if (string_equal(c, STlinefeed) || string_equal(c, STnewline))
+		c = code_char('\n');
+	else if (string_equal(c, STnull))
+		c = code_char('\000');
+	/*	#\^x	*/
+	else if (c->string.fillp == 2 && c->string.self[0] == '^')
+		c = code_char(c->string.self[1] & 037);
+	else if (c->string.self[0] =='\\' && c->string.fillp > 1) {
+		cl_index i, n;
+		for (n = 0, i = 1;  i < c->string.fillp;  i++)
+			if (c->string.self[i] < '0' ||
+			    '7' < c->string.self[i])
+				FEerror("Octal digit expected.", 0);
+			else
+				n = 8*n + c->string.self[i] - '0';
+		c = code_char(n & 0377);
+	} else
+		FEerror("~S is an illegal character name.", 1, c);
+	@(return c)
+@)
+
+static
+@(defun sharp_single_quote_reader (in c d)
+@
+	if(d != Cnil && !READsuppress)
+		extra_argument('#', d);
+	@(return CONS(Sfunction, CONS(read_object(in), Cnil)))
+@)
+
+#define	QUOTE	1
+#define	EVAL	2
+#define	LIST	3
+#define	LISTA	4
+#define	APPEND	5
+#define	NCONC	6
+
+
+/*
+ *----------------------------------------------------------------------
+ *	Stack of unknown size
+ *----------------------------------------------------------------------
+ */
+
+#define INCREMENT 64
+#define ESTACK(st)	volatile int _esize = 0; cl_object *(st), *(st ## 0);
+#define ETOP(st)	(st ## 0)
+
+#define EPUSH(st, val, count) \
+    { int i; if (count == _esize) { \
+      st = (cl_object *)alloca(INCREMENT*sizeof(cl_object)); \
+      for ( i = 0; i < _esize; i++) \
+	st[i] = st ## 0[i]; \
+      (st ## 0) = st; st += _esize;\
+      _esize += INCREMENT; \
+    }; *(st)++ = (val);}
+
+
+static
+@(defun sharp_left_parenthesis_reader (in c d)
+	int dim, dimcount, i, a;
+	cl_object x, last;
+	ESTACK(vsp);
+@
+	if (Null(d) || READsuppress)
+		dim = -1;
+	else if (FIXNUMP(d))
+		dim = fix(d);
+	if (backq_level > 0) {
+		unreadc_stream('(', in);
+		x = read_object(in);
+		a = backq_car(&x);
+		if (a == APPEND || a == NCONC)
+		  FEerror(",at or ,. has appeared in an illegal position.", 0);
+		if (a == QUOTE) {
+		  for (dimcount = 0;  !endp(x);  x = CDR(x), dimcount++)
+		    EPUSH(vsp, CAR(x), dimcount);
+		  goto L;
+		}
+		@(return list(4, siScomma, Sapply,
+			      CONS(Squote, CONS(Svector, Cnil)), x))
+	}
+	for (dimcount = 0 ;; dimcount++) {
+	  delimiting_char = code_char(')');
+	  x = read_object(in);
+	  if (x == OBJNULL)
+	    break;
+	  EPUSH(vsp, x, dimcount);
+	}
+L:
+	if (dim >= 0) {
+		if (dimcount > dim)
+			FEerror("Too many elements in #(...).", 0);
+		if (dimcount == 0)
+			FEerror("Cannot fill the vector #().", 0);
+		else last = vsp[-1];
+	} else
+	  dim = dimcount;
+	x = alloc_simple_vector(dim, aet_object);
+	x->vector.self.t = alloc_align(dim * sizeof(cl_object), sizeof(cl_object));
+	for (i = 0; i < dim; i++)
+		x->vector.self.t[i] = (i < dimcount) ? ETOP(vsp)[i] : last;
+	@(return x)
+@)
+
+static
+@(defun sharp_asterisk_reader (in c d)
+	int dim, dimcount, i;
+	cl_object x, last, elt;
+	ESTACK(vsp);
+@
+	if (READsuppress) {
+		read_constituent(in);
+		@(return Cnil)
+	}
+	if (Null(d))
+		dim = -1;
+	else if (FIXNUMP(d))
+		dim = fix(d);
+	for (dimcount = 0 ;; dimcount++) {
+		if (stream_at_end(in))
+			break;
+		x = read_char(in);
+		if (char_code(x) != '0' && char_code(x) != '1') {
+			unread_char(x, in);
+			break;
+		}
+		EPUSH(vsp, x, dimcount);
+	}	
+	if (dim >= 0) {
+		if (dimcount > dim)
+			FEerror("Too many elements in #*....", 0);
+		if (dimcount == 0)
+			FEerror("Cannot fill the bit-vector #*.", 0);
+		else last = vsp[-1];
+	} else {
+	  dim = dimcount;	/* Beppe ? */
+	  last = MAKE_FIXNUM(0);
+	}
+	x = alloc_simple_bitvector(dim);
+	x->vector.self.bit = alloc_atomic((dim + CHAR_BIT - 1)/CHAR_BIT);
+	for (i = 0; i < dim; i++) {
+		elt = (i < dimcount) ? ETOP(vsp)[i] : last;
+		if (char_code(elt) == '0')
+			x->vector.self.bit[i/CHAR_BIT] &= ~(0200 >> i%CHAR_BIT);
+		else
+			x->vector.self.bit[i/CHAR_BIT] |= 0200 >> i%CHAR_BIT;
+		}
+	@(return x)
+@)
+
+static
+@(defun sharp_colon_reader (in c d)
+	cl_index length;
+	enum chattrib a;
+@
+	if (d != Cnil && !READsuppress)
+		extra_argument(':', d);
+	c = read_char(in);
+	a = cat(c);
+	escape_flag = FALSE;
+	length = 0;
+	goto L;
+	for (;;) {
+		if (length >= cl_token->string.dim)
+			too_long_token();
+		token_buffer[length++] = char_code(c);
+	K:
+		if (stream_at_end(in))
+			goto M;
+		c = read_char(in);
+		a = cat(c);
+	L:
+		if (a == cat_single_escape) {
+			c = read_char(in);
+			a = cat_constituent;
+			escape_flag = TRUE;
+		} else if (a == cat_multiple_escape) {
+			escape_flag = TRUE;
+			for (;;) {
+				if (stream_at_end(in))
+					FEend_of_file(in);
+				c = read_char(in);
+				a = cat(c);
+				if (a == cat_single_escape) {
+					c = read_char(in);
+					a = cat_constituent;
+				} else if (a == cat_multiple_escape)
+					break;
+				if (length >= cl_token->string.dim)
+					too_long_token();
+				token_buffer[length++] = char_code(c);
+			}
+			goto K;
+		} else if ('a' <= char_code(c) && char_code(c) <= 'z')
+			c = code_char(toupper(char_code(c)));
+		if (a == cat_whitespace || a == cat_terminating)
+			break;
+	}
+	if (preserving_whitespace_flag || cat(c) != cat_whitespace)
+		unread_char(c, in);
+
+M:
+	if (READsuppress)
+		@(return Cnil)
+	cl_token->string.fillp = length;
+	@(return make_symbol(copy_simple_string(cl_token)))
+@)
+
+static
+@(defun sharp_dot_reader (in c d)
+	cl_object lex_old = lex_env;
+@
+	if(d != Cnil && !READsuppress)
+		extra_argument('.', d);
+	if (READsuppress)
+		@(return Cnil)
+	in = read_object(in);
+	lex_new();
+	in = eval(in, NULL);
+	lex_env = lex_old;
+	@(return in)
+@)
+
+static
+@(defun sharp_comma_reader (in c d)
+	cl_object lex_old = lex_env;
+@
+	if(d != Cnil && !READsuppress)
+		extra_argument(',', d);
+	if (READsuppress)
+		@(return Cnil)
+	in = read_object(in);
+	lex_new();
+	in = eval(in, NULL);
+	lex_env = lex_old;
+	@(return in)
+@)
+
+@(defun si::sharp_comma_reader_for_compiler (in c d)
+@
+	if(d != Cnil && !READsuppress)
+		extra_argument(',', d);
+	if (READsuppress)
+		@(return Cnil)
+	@(return CONS(siSsharp_comma, read_object(in)))
+@)
+
+/*
+	For fasload.
+*/
+static cl_object read_VV_block = OBJNULL;
+
+static
+@(defun sharp_exclamation_reader (in c d)
+	cl_fixnum code;
+@
+	if(d != Cnil && !READsuppress)
+		extra_argument('!', d);
+	if (READsuppress)
+		@(return Cnil)
+	code = fixint(read_object(in));
+	switch (code) {
+	case 0: {
+		cl_object name = read_object(in);
+		siLselect_package(1,name);
+		break;
+	}
+	case 1: {
+		cl_object name = read_object(in);
+		cl_object p = find_package(name);
+		if (Null(p)) make_package(name,Cnil,Cnil);
+		break;
+	}
+	default:
+		code = -code - 1;
+		if (code < 0 || code >= read_VV_block->cblock.data_size)
+			FEerror("Bogus binary file. #!~S unknown.",1,
+				MAKE_FIXNUM(code));
+		@(return read_VV_block->cblock.data[code])
+	}
+	@(return)
+@)
+
+static
+@(defun sharp_B_reader (in c d)
+	cl_index i;
+	cl_object x;
+@
+	if(d != Cnil && !READsuppress)
+		extra_argument('B', d);
+	read_constituent(in);
+	if (READsuppress)
+		@(return Cnil)
+	x = parse_number(token_buffer, cl_token->string.fillp, &i, 2);
+	if (x == OBJNULL || i != cl_token->string.fillp)
+		FEerror("Cannot parse the #B readmacro.", 0);
+	if (type_of(x) == t_shortfloat ||
+	    type_of(x) == t_longfloat)
+		FEerror("The float ~S appeared after the #B readmacro.",
+			1, x);
+	@(return x)
+@)
+
+static
+@(defun sharp_O_reader (in c d)
+	cl_index i;
+	cl_object x;
+@
+	if(d != Cnil && !READsuppress)
+		extra_argument('O', d);
+	read_constituent(in);
+	if (READsuppress)
+		@(return Cnil)
+	x = parse_number(token_buffer, cl_token->string.fillp, &i, 8);
+	if (x == OBJNULL || i != cl_token->string.fillp)
+		FEerror("Cannot parse the #O readmacro.", 0);
+	if (type_of(x) == t_shortfloat ||
+	    type_of(x) == t_longfloat)
+		FEerror("The float ~S appeared after the #O readmacro.",
+			1, x);
+	@(return x)
+@)
+
+static
+@(defun sharp_X_reader (in c d)
+	cl_index i;
+	cl_object x;
+@
+	if(d != Cnil && !READsuppress)
+		extra_argument('X', d);
+	read_constituent(in);
+	if (READsuppress)
+		@(return Cnil)
+	x = parse_number(token_buffer, cl_token->string.fillp, &i, 16);
+	if (x == OBJNULL || i != cl_token->string.fillp)
+		FEerror("Cannot parse the #X readmacro.", 0);
+	if (type_of(x) == t_shortfloat ||
+	    type_of(x) == t_longfloat)
+		FEerror("The float ~S appeared after the #X readmacro.",
+			1, x);
+	@(return x)
+@)
+
+static
+@(defun sharp_R_reader (in c d)
+	int radix;
+	cl_index i;
+	cl_object x;
+@
+	if (READsuppress)
+		radix = 10;
+	else if (FIXNUMP(d)) {
+		radix = fix(d);
+		if (radix > 36 || radix < 2)
+			FEerror("~S is an illegal radix.", 1, d);
+	} else
+		FEerror("No radix was supplied in the #R readmacro.", 0);
+	read_constituent(in);
+	if (READsuppress)
+		@(return Cnil)
+	x = parse_number(token_buffer, cl_token->string.fillp, &i, radix);
+	if (x == OBJNULL || i != cl_token->string.fillp)
+		FEerror("Cannot parse the #R readmacro.", 0);
+	if (type_of(x) == t_shortfloat ||
+	    type_of(x) == t_longfloat)
+		FEerror("The float ~S appeared after the #R readmacro.",
+			1, x);
+	@(return x)
+@)
+
+#define sharp_A_reader Lvoid_reader
+#define sharp_S_reader Lvoid_reader
+
+static
+@(defun sharp_eq_reader (in c d)
+	cl_object pair, value;
+@
+	if (READsuppress) @(return)
+	if (Null(d))
+		FEerror("The #= readmacro requires an argument.", 0);
+	if (assql(d, sharp_eq_context) != Cnil)
+		FEerror("Duplicate definitions for #~D=.", 1, d);
+	pair = CONS(d, Cnil);
+	sharp_eq_context = CONS(pair, sharp_eq_context);
+	value = read_object(in);
+	if (value == pair)
+		FEerror("#~D# is defined by itself.", 1, d);
+	@(return (CDR(pair) = value))
+@)
+
+static
+@(defun sharp_sharp_reader (in c d)
+	cl_object pair;
+@
+	if (READsuppress) @(return)
+	if (Null(d))
+		FEerror("The ## readmacro requires an argument.", 0);
+	pair = assq(d, sharp_eq_context);
+	if (pair != Cnil)
+		@(return pair)
+	FEerror("#~D# is undefined.", 1, d);
+@)
+
+static cl_object
+do_patch_sharp(cl_object x)
+{
+	cs_check(x);
+
+	switch (type_of(x)) {
+	case t_cons: {
+	  	cl_object y = x;
+		cl_object *place = &x;
+		do {
+			/* This was the result of a #d# */
+			if (CAR(y) == OBJNULL) {
+				*place = CDR(y);
+				return x;
+			} else
+				CAR(y) = do_patch_sharp(CAR(y));
+			place = &CDR(y);
+			y = CDR(y);
+		} while (CONSP(y));
+		break;
+	}
+	case t_vector: {
+		cl_index i;
+
+		for (i = 0;  i < x->vector.fillp;  i++)
+			x->vector.self.t[i] = do_patch_sharp(x->vector.self.t[i]);
+		break;
+	}
+	case t_array: {
+		cl_index i, j;
+
+		for (i = 0, j = 1;  i < x->array.rank;  i++)
+			j *= x->array.dims[i];
+		for (i = 0;  i < j;  i++)
+			x->array.self.t[i] = do_patch_sharp(x->array.self.t[i]);
+		break;
+	}
+	default:
+	}
+	return(x);
+}
+
+static cl_object
+patch_sharp(cl_object x)
+{
+	cl_object pair = sharp_eq_context;
+	loop_for_in(pair) { 
+		CAAR(pair) = OBJNULL;
+	} end_loop_for_in;
+
+	x = do_patch_sharp(x);
+
+	pair = sharp_eq_context;
+	loop_for_in(pair) { 
+		CAAR(pair) = Cnil;
+	} end_loop_for_in;
+	return x;
+}
+
+#define Lsharp_plus_reader Lvoid_reader
+#define Lsharp_minus_reader Lvoid_reader
+#define Lsharp_less_than_reader Lvoid_reader
+#define Lsharp_whitespace_reader Lvoid_reader
+#define Lsharp_right_parenthesis_reader Lvoid_reader
+
+static
+@(defun sharp_vertical_bar_reader (in ch d)
+	int c;
+	int level = 0;
+@
+	if (d != Cnil && !READsuppress)
+		extra_argument('|', d);
+	for (;;) {
+		c = char_code(read_char(in));
+	L:
+		if (c == '#') {
+			c = char_code(read_char(in));
+			if (c == '|')
+				level++;
+		} else if (c == '|') {
+			c = char_code(read_char(in));
+			if (c == '#') {
+				if (level == 0)
+					break;
+				else
+					--level;
+			} else
+				goto L;
+		}
+	}
+	@(return)
+	/*  no result  */
+@)
+
+static
+@(defun default_dispatch_macro (in c d)
+@
+	FEerror("Undefined dispatch macro character.", 1, c);
+@)
+
+/*
+	#P" ... " returns the pathname with namestring ... .
+*/
+static
+@(defun sharp_P_reader (in c d)
+@
+	@(return coerce_to_pathname(read_object(in)))
+@)
+
+/*
+	#" ... " returns the pathname with namestring ... .
+*/
+static
+@(defun sharp_double_quote_reader (in c d)
+@
+	if (d != Cnil && !READsuppress)
+		extra_argument('"', d);
+	unread_char(c, in);
+	@(return coerce_to_pathname(read_object(in)))
+@)
+
+/*
+	#$ fixnum returns a random-state with the fixnum
+	as its content.
+*/
+static
+@(defun sharp_dollar_reader (in c d)
+	cl_object output;
+@
+	if (d != Cnil && !READsuppress)
+		extra_argument('$', d);
+	c = read_object(in);
+	if (!FIXNUMP(c))
+		FEerror("Cannot make a random-state with the value ~S.",
+			1, c);
+	output = alloc_object(t_random);
+	output->random.value = fix(c);
+	@(return output)
+@)
+
+/*
+	readtable routines
+*/
+
+cl_object
+copy_readtable(cl_object from, cl_object to)
+{
+	struct readtable_entry *rtab;
+	cl_index i;
+
+	if (Null(to)) {
+		to = alloc_object(t_readtable);
+		to->readtable.table = NULL;
+			/*  Saving for GC.  */
+		to->readtable.table
+		= rtab
+ 		= alloc_align(RTABSIZE * sizeof(struct readtable_entry), sizeof(struct readtable_entry));
+		memcpy(rtab, from->readtable.table,
+			 RTABSIZE * sizeof(struct readtable_entry));
+/*
+		for (i = 0;  i < RTABSIZE;  i++)
+			rtab[i] = from->readtable.table[i];
+*/
+				/*  structure assignment  */
+	} else
+	  rtab=to->readtable.table;
+	for (i = 0;  i < RTABSIZE;  i++)
+		if (from->readtable.table[i].dispatch_table != NULL) {
+			rtab[i].dispatch_table
+ 			= alloc_align(RTABSIZE * sizeof(cl_object), sizeof(cl_object));
+			memcpy(rtab[i].dispatch_table, from->readtable.table[i].dispatch_table,
+			      RTABSIZE * sizeof(cl_object *));
+/*
+			for (j = 0;  j < RTABSIZE;  j++)
+				rtab[i].dispatch_table[j]
+				= from->readtable.table[i].dispatch_table[j];
+*/
+		}
+	return(to);
+}
+
+cl_object
+current_readtable(void)
+{
+	cl_object r;
+
+	r = symbol_value(Vreadtable);
+	if (type_of(r) != t_readtable) {
+	  SYM_VAL(Vreadtable) = copy_readtable(standard_readtable, Cnil);
+	  FEerror("The value of *READTABLE*, ~S, was not a readtable.",
+		  1, r);
+	}
+	return(r);
+}
+
+
+@(defun read (&optional (strm symbol_value(Vstandard_input))
+			(eof_errorp Ct)
+			eof_value
+			recursivep
+	      &aux x)
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else
+	    read_ch_fun = readc;
+	} else
+#ifdef CLOS
+	  if (type_of(strm) == t_instance)
+	    read_ch_fun = interactive_readc;
+	  else
+#endif CLOS
+	    FEwrong_type_argument(Sstream, strm);
+	if (Null(recursivep))
+		preserving_whitespace_flag = FALSE;
+	detect_eos_flag = TRUE;
+	if (Null(recursivep))
+		x = read_object_non_recursive(strm);
+	else
+		x = read_object_recursive(strm);
+	if (x == OBJNULL) {
+		if (Null(eof_errorp) && Null(recursivep))
+			@(return eof_value)
+		FEend_of_file(strm);
+	}
+	@(return x)
+@)
+
+@(defun read_preserving_whitespace
+	(&optional (strm symbol_value(Vstandard_input))
+		   (eof_errorp Ct)
+		   eof_value
+		   recursivep
+	 &aux x)
+	cl_object c;
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else
+	    read_ch_fun = readc;
+	} else
+#ifdef CLOS
+	  if (type_of(strm) == t_instance)
+	    read_ch_fun = interactive_readc;
+	  else
+#endif CLOS
+	    FEwrong_type_argument(Sstream, strm);
+	while (!stream_at_end(strm)) {
+		c = read_char(strm);
+		if (cat(c) != cat_whitespace) {
+			unread_char(c, strm);
+			goto READ;
+		}
+	}
+	if (Null(eof_errorp) && Null(recursivep))
+		@(return eof_value)
+	FEend_of_file(strm);
+
+READ:
+	if (Null(recursivep))
+		preserving_whitespace_flag = TRUE;
+	if (Null(recursivep))
+		x = read_object_non_recursive(strm);
+	else
+		x = read_object_recursive(strm);
+	@(return x)
+@)
+
+@(defun read_delimited_list
+	(d
+	 &optional (strm symbol_value(Vstandard_input))
+		   recursivep
+	 &aux l x)
+
+	cl_object *p;
+	bool e;
+	volatile cl_object old_sharp_eq_context;
+	volatile int old_backq_level;
+
+@
+	if (!CHARACTERP(d))
+		FEtype_error_character(d);
+	if (Null(strm))
+		strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+	assert_type_stream(strm);
+	if (Null(recursivep)) {
+		old_sharp_eq_context = sharp_eq_context;
+		old_backq_level = backq_level;
+		setup_READ();
+		sharp_eq_context = Cnil;
+		backq_level = 0;
+		if (frs_push(FRS_PROTECT, Cnil)) {
+			e = TRUE;
+			goto L;
+		}
+	}
+	l = Cnil;
+	p = &l;
+	preserving_whitespace_flag = FALSE;	/*  necessary?  */
+	for (;;) {
+		delimiting_char = d;
+		x = read_object_recursive(strm);
+		if (x == OBJNULL)
+			break;
+		*p = CONS(x, Cnil);
+		p = &(CDR((*p)));
+	}
+	if (Null(recursivep)) {
+		if (!Null(sharp_eq_context))
+			l = patch_sharp(l);
+		e = FALSE;
+	L:
+		frs_pop();
+		sharp_eq_context = old_sharp_eq_context;
+		backq_level = old_backq_level;
+		if (e) unwind(nlj_fr, nlj_tag);
+	}
+	@(return l)
+@)
+
+@(defun read_line (&optional (strm symbol_value(Vstandard_input))
+			     (eof_errorp Ct)
+			     eof_value
+			     recursivep
+		   &aux c)
+	cl_index i;
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else {
+	    if (stream_at_end(strm)) {
+	      if (Null(eof_errorp) && Null(recursivep))
+		@(return eof_value Ct)
+	      else
+		FEend_of_file(strm);
+	    }
+	    i = 0;
+	    for (;;) {
+	      c = read_char(strm);
+	      if (char_code(c) == '\n') {
+		c = Cnil;
+		break;
+	      }
+	      if (i >= cl_token->string.dim)
+		too_long_string();
+	      cl_token->string.self[i++] = char_code(c);
+	      if (stream_at_end(strm)) {
+		c = Ct;
+		break;
+	      }
+	    }
+#ifdef CRLF
+	    if (i > 0 && cl_token->string.self[i-1] == '\r') i--;
+#endif CRLF
+	    cl_token->string.fillp = i;
+	    @(return copy_simple_string(cl_token) c)
+	    }
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	     return funcall(2, Sstream_read_line, strm);
+        else
+#endif
+	  FEerror("~S is not a stream.", 1, strm);
+@)
+
+@(defun read_char (&optional (strm symbol_value(Vstandard_input))
+			     (eof_errorp Ct)
+			     eof_value
+			     recursivep)
+@
+        if (Null(strm))
+	    strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+	    strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else {
+	    if (stream_at_end(strm)) {
+	      if (Null(eof_errorp) && Null(recursivep))
+		@(return eof_value)
+		  else
+		    FEend_of_file(strm);
+	    }
+	    @(return read_char(strm))
+	    }
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	     return funcall(2, Sstream_read_char, strm);
+	else
+#endif
+	  FEerror("~S is not a stream.", 1, strm);
+@)
+
+@(defun unread_char (c &optional (strm symbol_value(Vstandard_input)))
+@
+	/* INV: unread_char() checks the type `c' */
+	if (Null(strm))
+		strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else {
+	    unread_char(c, strm);
+	    @(return Cnil)
+	    }
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	     return funcall(3, Sstream_unread_char, strm, c);
+	else
+#endif
+	  FEerror("~S is not a stream.", 1, strm);
+@)
+
+@(defun peek_char (&optional peek_type
+			     (strm symbol_value(Vstandard_input))
+			     (eof_errorp Ct)
+			     eof_value
+			     recursivep)
+	cl_object c;
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else {
+	    setup_READtable();
+	    if (Null(peek_type)) {
+	      if (stream_at_end(strm)) {
+		if (Null(eof_errorp) && Null(recursivep))
+		  @(return eof_value)
+		    else
+		      FEend_of_file(strm);
+	      }
+	      c = read_char(strm);
+	      unread_char(c, strm);
+	      @(return c)
+	      }
+	    if (peek_type == Ct) {
+	      while (!stream_at_end(strm)) {
+		c = read_char(strm);
+		if (cat(c) != cat_whitespace) {
+		  unread_char(c, strm);
+		  @(return c)
+		  }
+	      }
+	      if (Null(eof_errorp))
+		@(return eof_value)
+		  else
+		    FEend_of_file(strm);
+	    }
+	    /* INV: char_eq() checks the type of `peek_type' */
+	    while (!stream_at_end(strm)) {
+	      c = read_char(strm);
+	      if (char_eq(c, peek_type)) {
+		unread_char(c, strm);
+		@(return c)
+		}
+	    }
+	    if (Null(eof_errorp))
+	      @(return eof_value)
+		else
+		  FEend_of_file(strm);
+	  }
+	} else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	     return funcall(3, Sstream_peek_char, strm, peek_type);
+	else
+#endif
+	  FEerror("~S is not a stream.", 1, strm);
+@)
+
+@(defun listen (&optional (strm symbol_value(Vstandard_input)))
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else {
+	    if (listen_stream(strm))
+	      @(return Ct)
+	    else
+	      @(return Cnil)
+	      }
+	}
+	else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	     return funcall(2, Sstream_listen, strm);
+	else
+#endif
+	  FEerror("~S is not a stream.", 1, strm);
+@)
+
+@(defun read_char_no_hang (&optional (strm symbol_value(Vstandard_input))
+			             (eof_errorp Ct)
+			             eof_value
+			             recursivep)
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+	assert_type_stream(strm);
+#if 0
+	if (!listen_stream(strm))
+		/* Incomplete! */
+		@(return Cnil)
+	@(return read_char(strm))
+#else
+	/*
+	  This implementation fails for EOF and handles
+	  CLOS streams.
+	*/
+RETRY:	if (type_of(strm) == t_stream) {
+	  if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  } else {
+	    if (listen_stream(strm))
+	      @(return read_char(strm))
+	    else if (!stream_at_end(strm))
+	      @(return Cnil)
+	    else if (Null(eof_errorp) && Null(recursivep))
+	      @(return eof_value)
+	    else
+	      FEend_of_file(strm);
+	  }
+	}
+	else
+#ifdef CLOS
+	/* FIXME! Is this all right? */
+	if (type_of(strm) == t_instance) {
+	  if (_funcall(2, Sstream_listen, strm) == Cnil)
+	    @(return Cnil)
+	  else
+	    return funcall(2, Sstream_read_char, strm);
+	} else
+#endif
+	  FEerror("~S is not a stream.", 1, strm);
+#endif
+@)
+
+@(defun clear_input (&optional (strm symbol_value(Vstandard_input)))
+@
+	if (Null(strm))
+		strm = symbol_value(Vstandard_input);
+	else if (strm == Ct)
+		strm = symbol_value(Vterminal_io);
+RETRY:	if (type_of(strm) == t_stream) {
+          if (strm->stream.mode == (short)smm_synonym) {
+	    strm = symbol_value(strm->stream.object0);
+	    goto RETRY;
+	  }
+	  else {
+	    clear_input_stream(strm);
+	    @(return Cnil)
+	     }
+	    } else
+#ifdef CLOS
+	if (type_of(strm) == t_instance)
+	     return funcall(2, Sstream_clear_input, strm);
+  	else
+#endif
+	  FEerror("~S is not a stream.", 1, strm);
+@)
+
+@(defun parse_integer (strng
+		       &key (start MAKE_FIXNUM(0))
+			    end
+			    (radix MAKE_FIXNUM(10))
+			    junk_allowed
+		       &aux x)
+	cl_index s, e, ep;
+@
+	assert_type_string(strng);
+	get_string_start_end(strng, start, end, &s, &e);
+	if (!FIXNUMP(radix) ||
+	    fix(radix) < 2 || fix(radix) > 36)
+		FEerror("~S is an illegal radix.", 1, radix);
+	setup_READtable();
+	while (READtable->readtable.table[strng->string.self[s]].syntax_type
+	       == cat_whitespace && s < e)
+		s++;
+	if (s >= e) {
+		if (junk_allowed != Cnil)
+			@(return Cnil MAKE_FIXNUM(s))
+		else
+			goto CANNOT_PARSE;
+	}
+	x = parse_integer(strng->string.self+s, e-s, &ep, fix(radix));
+	if (x == OBJNULL) {
+		if (junk_allowed != Cnil)
+			@(return Cnil MAKE_FIXNUM(ep+s))
+		else
+			goto CANNOT_PARSE;
+	}
+	if (junk_allowed != Cnil)
+		@(return x MAKE_FIXNUM(ep+s))
+	for (s += ep ;  s < e;  s++)
+		if (READtable->readtable.table[strng->string.self[s]].syntax_type
+		    != cat_whitespace)
+			goto CANNOT_PARSE;
+	@(return x MAKE_FIXNUM(e))
+
+CANNOT_PARSE:
+	FEerror("Cannot parse an integer in the string ~S.", 1, strng);
+@)
+
+@(defun read_byte (binary_input_stream
+		   &optional eof_errorp eof_value)
+	int c;
+@
+	assert_type_stream(binary_input_stream);
+	if (stream_at_end(binary_input_stream)) {
+		if (Null(eof_errorp))
+			@(return eof_value)
+		else
+			FEend_of_file(binary_input_stream);
+	}
+	c = readc_stream(binary_input_stream);
+	@(return MAKE_FIXNUM(c))
+@)
+
+@(defun read_bytes (stream string start end)
+	int is, ie, c; FILE *fp;
+@
+	assert_type_stream(stream);
+	if (stream->stream.mode == smm_closed)
+	  closed_stream(stream);
+
+	/* FIXME! this may fail! */
+        is = fix(start);
+	ie = fix(end);
+	fp = stream->stream.file;
+	if (fp == NULL) fp = stream->stream.object0->stream.file;
+	c = fread (string->string.self + is, sizeof(unsigned char),
+		   ie - is,
+		   fp);
+	@(return MAKE_FIXNUM(c))
+@)
+
+
+
+@(defun copy_readtable (&o (from current_readtable()) to)
+@
+	if (Null(from)) {
+		from = standard_readtable;
+		if (to != Cnil)
+			assert_type_readtable(to);
+		to = copy_readtable(from, to);
+		to->readtable.table['#'].dispatch_table['!']
+		= default_dispatch_macro;
+		/*  We must forget #! macro.  */
+		@(return to)
+	}
+	assert_type_readtable(from);
+	if (to != Cnil)
+		assert_type_readtable(to);
+	@(return copy_readtable(from, to))
+@)
+
+@(defun readtablep (readtable)
+@
+	@(return ((type_of(readtable) == t_readtable)? Ct : Cnil))
+@)
+
+static struct readtable_entry*
+read_table_entry(cl_object rdtbl, cl_object c)
+{
+	/* INV: char_code() checks the type of `c' */
+	assert_type_readtable(rdtbl);
+	return &(rdtbl->readtable.table[char_code(c)]);
+}
+
+@(defun set_syntax_from_char (tochr fromchr
+			      &o (tordtbl current_readtable())
+				 fromrdtbl)
+	struct readtable_entry*torte, *fromrte;
+@
+	/* INV: read_table_entry() checks all values */
+	if (Null(fromrdtbl))
+		fromrdtbl = standard_readtable;
+	/* INV: char_code() checks the types of `tochar',`fromchar' */
+	torte = read_table_entry(tordtbl, tochr);
+	fromrte = read_table_entry(fromrdtbl, fromchr);
+	torte->syntax_type = fromrte->syntax_type;
+	torte->macro = fromrte->macro;
+	if ((torte->dispatch_table = fromrte->dispatch_table) != NULL) {
+		size_t rtab_size = RTABSIZE * sizeof(cl_object);
+		torte->dispatch_table = alloc(rtab_size);
+		memcpy(torte->dispatch_table, fromrte->dispatch_table, rtab_size);
+	}
+	@(return Ct)
+@)
+
+@(defun set_macro_character (chr fnc
+			     &optional ntp
+				       (rdtbl current_readtable()))
+	struct readtable_entry*entry;
+@
+	/* INV: read_table_entry() checks our arguments */
+	entry = read_table_entry(rdtbl, chr);
+	if (ntp != Cnil)
+		entry->syntax_type = cat_non_terminating;
+	else
+		entry->syntax_type = cat_terminating;
+	entry->macro = fnc;
+	@(return Ct)
+@)
+
+@(defun get_macro_character (chr &o (rdtbl current_readtable()))
+	struct readtable_entry*entry;
+	cl_object m;
+@
+
+	/* fix to allow NIL as readtable argument. Beppe */
+	if (Null(rdtbl))
+		rdtbl = standard_readtable;
+	/* INV: read_table_entry() checks our arguments */
+	entry = read_table_entry(rdtbl, chr);
+	m = entry->macro;
+	if (m == OBJNULL)
+		@(return Cnil)
+	if (entry->syntax_type = cat_non_terminating)
+		@(return m Ct)
+	else
+		@(return m Cnil)
+@)
+
+@(defun make_dispatch_macro_character (chr
+	&optional ntp (rdtbl current_readtable()))
+	struct readtable_entry*entry;
+	cl_object *table;
+	int i;
+@
+	/* INV: read_table_entry() checks our arguments */
+	entry = read_table_entry(rdtbl, chr);
+	if (ntp != Cnil)
+		entry->syntax_type = cat_non_terminating;
+	else
+		entry->syntax_type = cat_terminating;
+	table = alloc(RTABSIZE * sizeof(cl_object));
+	entry->dispatch_table = table;
+	for (i = 0;  i < RTABSIZE;  i++)
+		table[i] = default_dispatch_macro;
+	entry->macro = dispatch_reader;
+	@(return Ct)
+@)
+
+@(defun set_dispatch_macro_character (dspchr subchr fnc
+	&optional (rdtbl current_readtable()))
+	struct readtable_entry*entry;
+	cl_fixnum subcode;
+@
+	entry = read_table_entry(rdtbl, dspchr);
+	if (entry->macro != dispatch_reader || entry->dispatch_table == NULL)
+		FEerror("~S is not a dispatch character.", 1, dspchr);
+	subcode = char_code(subchr);
+	if ('a' <= subcode && subcode <= 'z')
+		subcode = toupper(subcode);
+	entry->dispatch_table[subcode] = fnc;
+	@(return Ct)
+@)
+
+@(defun get_dispatch_macro_character (dspchr subchr
+	&optional (rdtbl current_readtable()))
+	struct readtable_entry*entry;
+	cl_fixnum subcode;
+@
+	if (Null(rdtbl))
+		rdtbl = standard_readtable;
+	entry = read_table_entry(rdtbl, dspchr);
+	if (entry->macro != dispatch_reader || entry->dispatch_table == NULL)
+		FEerror("~S is not a dispatch character.", 1, dspchr);
+	subcode = char_code(subchr);
+	if (digitp(subcode, 10) >= 0)
+		@(return Cnil)
+	@(return entry->dispatch_table[subcode])
+@)
+
+cl_object
+string_to_object(cl_object x)
+{
+	cl_object in;
+
+	in = make_string_input_stream(x, 0, x->string.fillp);
+	preserving_whitespace_flag = FALSE;
+	detect_eos_flag = FALSE;
+	x = read_object(in);
+	return(x);
+}
+
+@(defun si::string_to_object (str)
+@
+	assert_type_string(str);
+	@(return string_to_object(str))
+@)
+
+@(defun si::standard_readtable ()
+@
+	@(return standard_readtable)
+@)
+
+static void
+too_long_token(void)
+{
+	char *q;
+
+	q = alloc_atomic(cl_token->string.dim*2);
+	memcpy(q, cl_token->string.self, cl_token->string.dim);
+	cl_token->string.self = q;
+	cl_token->string.dim *= 2;
+}
+
+static void
+too_long_string(void)
+{
+	char *q;
+
+	q = alloc_atomic(cl_token->string.dim*2);
+	memcpy(q, cl_token->string.self, cl_token->string.dim);
+	cl_token->string.self = q;
+	cl_token->string.dim *= 2;
+}
+
+static void
+extra_argument(int c, cl_object d)
+{
+	FEerror("~S is an extra argument for the #~C readmacro.",
+		2, d, code_char(c));
+}
+
+
+#define	make_cf(f)	make_cfun((f), Cnil, NULL)
+
+void
+init_read(void)
+{
+	struct readtable_entry *rtab;
+	cl_object *dtab;
+	int i;
+
+	standard_readtable = alloc_object(t_readtable);
+	register_root(&standard_readtable);
+
+	standard_readtable->readtable.table
+	= rtab
+	= alloc(RTABSIZE * sizeof(struct readtable_entry));
+	for (i = 0;  i < RTABSIZE;  i++) {
+		rtab[i].syntax_type = cat_constituent;
+		rtab[i].macro = OBJNULL;
+		rtab[i].dispatch_table = NULL;
+	}
+
+	dispatch_reader = make_cf(Ldispatch_reader);
+	register_root(&dispatch_reader);
+
+	rtab['\t'].syntax_type = cat_whitespace;
+	rtab['\n'].syntax_type = cat_whitespace;
+	rtab['\f'].syntax_type = cat_whitespace;
+	rtab['\r'].syntax_type = cat_whitespace;
+	rtab[' '].syntax_type = cat_whitespace;
+	rtab['"'].syntax_type = cat_terminating;
+	rtab['"'].macro = make_cf(Ldouble_quote_reader);
+	rtab['#'].syntax_type = cat_non_terminating;
+	rtab['#'].macro = dispatch_reader;
+	rtab['\''].syntax_type = cat_terminating;
+	rtab['\''].macro = make_cf(Lsingle_quote_reader);
+	rtab['('].syntax_type = cat_terminating;
+	rtab['('].macro = make_cf(Lleft_parenthesis_reader);
+	rtab[')'].syntax_type = cat_terminating;
+	rtab[')'].macro = make_cf(Lright_parenthesis_reader);
+/*
+	rtab[','].syntax_type = cat_terminating;
+	rtab[','].macro = make_cf(Lcomma_reader);
+*/
+	rtab[';'].syntax_type = cat_terminating;
+	rtab[';'].macro = make_cf(Lsemicolon_reader);
+	rtab['\\'].syntax_type = cat_single_escape;
+/*
+	rtab['`'].syntax_type = cat_terminating;
+	rtab['`'].macro = make_cf(Lbackquote_reader);
+*/
+	rtab['|'].syntax_type = cat_multiple_escape;
+/*
+	rtab['|'].macro = make_cf(Lvertical_bar_reader);
+*/
+
+	default_dispatch_macro = make_cf(Ldefault_dispatch_macro);
+#ifndef THREADS
+	register_root(&default_dispatch_macro);
+#endif
+
+	rtab['#'].dispatch_table
+	= dtab
+	= alloc(RTABSIZE * sizeof(cl_object));
+	for (i = 0;  i < RTABSIZE;  i++)
+		dtab[i] = default_dispatch_macro;
+	dtab['C'] = dtab['c'] = make_cf(Lsharp_C_reader);
+	dtab['\\'] = make_cf(Lsharp_backslash_reader);
+	dtab['\''] = make_cf(Lsharp_single_quote_reader);
+	dtab['('] = make_cf(Lsharp_left_parenthesis_reader);
+	dtab['*'] = make_cf(Lsharp_asterisk_reader);
+	dtab[':'] = make_cf(Lsharp_colon_reader);
+	dtab['.'] = make_cf(Lsharp_dot_reader);
+	dtab['!'] = make_cf(Lsharp_exclamation_reader);
+	/*  Used for fasload only. */
+	dtab[','] = make_cf(Lsharp_comma_reader);
+	dtab['B'] = dtab['b'] = make_cf(Lsharp_B_reader);
+	dtab['O'] = dtab['o'] = make_cf(Lsharp_O_reader);
+	dtab['X'] = dtab['x'] = make_cf(Lsharp_X_reader);
+	dtab['R'] = dtab['r'] = make_cf(Lsharp_R_reader);
+/*
+	dtab['A'] = dtab['a'] = make_cf(Lsharp_A_reader);
+	dtab['S'] = dtab['s'] = make_cf(Lsharp_S_reader);
+*/
+	dtab['A'] = dtab['a'] = make_si_ordinary("SHARP-A-READER");
+	dtab['S'] = dtab['s'] = make_si_ordinary("SHARP-S-READER");
+	dtab['P'] = dtab['p'] = make_cf(Lsharp_P_reader);
+
+	dtab['='] = make_cf(Lsharp_eq_reader);
+	dtab['#'] = make_cf(Lsharp_sharp_reader);
+	dtab['+'] = make_cf(Lsharp_plus_reader);
+	dtab['-'] = make_cf(Lsharp_minus_reader);
+/*
+	dtab['<'] = make_cf(Lsharp_less_than_reader);
+*/
+	dtab['|'] = make_cf(Lsharp_vertical_bar_reader);
+	dtab['"'] = make_cf(Lsharp_double_quote_reader);
+	/*  This is specific to this implementation  */
+	dtab['$'] = make_cf(Lsharp_dollar_reader);
+	/*  This is specific to this implimentation  */
+/*
+	dtab[' '] = dtab['\t'] = dtab['\n'] = dtab['\f']
+	= make_cf(Lsharp_whitespace_reader);
+	dtab[')'] = make_cf(Lsharp_right_parenthesis_reader);
+*/
+
+	init_backq();
+
+	SYM_VAL(Vreadtable) =
+	  copy_readtable(standard_readtable, Cnil);
+	SYM_VAL(Vreadtable)->readtable.table['#'].dispatch_table['!']
+	  = default_dispatch_macro; /*  We must forget #! macro.  */
+	SYM_VAL(Vread_default_float_format)
+	  = Ssingle_float;
+	SYM_VAL(Vread_base) = MAKE_FIXNUM(10);
+	SYM_VAL(Vread_suppress) = Cnil;
+
+	READtable = symbol_value(Vreadtable);
+	register_root(&READtable);
+	READdefault_float_format = 'S';
+	READbase = 10;
+	READsuppress = FALSE;
+
+	sharp_eq_context = Cnil;
+
+	delimiting_char = OBJNULL;
+	register_root(&delimiting_char);
+
+	detect_eos_flag = FALSE;
+	in_list_flag = FALSE;
+	dot_flag = FALSE;
+
+	read_ch_fun = readc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * read_VV --
+ *     reads the data vector from stream into vector VV
+ *
+ * Results:
+ *	a vector.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+read_VV(cl_object block, void *entry)
+{
+	typedef void (*entry_point_ptr)(cl_object);
+	volatile cl_object x, v;
+	int i;
+	bool e;
+	cl_object in;
+	cl_object old_READtable;
+	int old_READdefault_float_format;
+	int old_READbase;
+	int old_READsuppress;
+	int old_backq_level;
+	cl_object old_sharp_eq_context;
+	cl_object old_package;
+
+	entry_point_ptr entry_point = entry;
+	cl_object *VV;
+	int len;
+#ifdef PDE
+	bds_ptr old_bds_top = bds_top;
+#endif
+
+	if (block == NULL)
+		block = alloc_object(t_codeblock);
+
+	(*entry_point)(block);
+	VV = block->cblock.data;
+	len = block->cblock.data_size;
+
+	old_READtable = READtable;
+	old_READdefault_float_format = READdefault_float_format;
+	old_READbase = READbase;
+	old_READsuppress = READsuppress;
+	old_sharp_eq_context = sharp_eq_context;
+	old_backq_level = backq_level;
+
+	old_package = SYM_VAL(Vpackage);
+	SYM_VAL(Vpackage) = lisp_package;
+
+	setup_standard_READ();
+
+	in = make_string_input_stream(make_simple_string(block->cblock.data_text),
+				      0, block->cblock.data_text_size);
+	if (frs_push(FRS_PROTECT, Cnil))
+		e = TRUE;
+	else {
+	  read_VV_block = block;
+	  for (i = 0 ; i < len; i++) {
+	    sharp_eq_context = Cnil;
+	    backq_level = 0;
+	    preserving_whitespace_flag = FALSE;
+	    detect_eos_flag = FALSE;
+	    x = read_object(in);
+	    if (x == OBJNULL)
+	      break;
+	    if (!Null(sharp_eq_context))
+	      x = patch_sharp(x);
+	    VV[i] = x;
+	  }
+	  if (i < len)
+	    FEerror("Not enough data while loading binary file",0);
+	  SYM_VAL(Vpackage) = old_package;
+#ifdef PDE
+	  bds_bind(siVsource_pathname, VV[block->cblock.source_pathname]);
+#endif
+	  (*entry_point)(MAKE_FIXNUM(0));
+	  e = FALSE;
+	}
+
+	frs_pop();
+	close_stream(in, 0);
+
+	read_VV_block = OBJNULL;
+#ifdef PDE
+	bds_unwind(old_bds_top);
+#endif
+
+	READtable = old_READtable;
+	READdefault_float_format = old_READdefault_float_format;
+	READbase = old_READbase;
+	READsuppress = old_READsuppress;
+	sharp_eq_context = old_sharp_eq_context;
+	backq_level = old_backq_level;
+	if (e) unwind(nlj_fr, nlj_tag);
+}
+
diff --git a/src/c/reference.d b/src/c/reference.d
new file mode 100644
index 000000000..b2265c951
--- /dev/null
+++ b/src/c/reference.d
@@ -0,0 +1,148 @@
+/*
+    reference.c -- Reference in Constants and Variables.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "ecls-inl.h"
+
+#define SBOUNDP(sym) (SYM_VAL(sym) == OBJNULL)
+#define FBOUNDP(sym) (SYM_FUN(sym) == OBJNULL)
+
+@(defun fboundp (sym)
+	cl_object output;
+@
+	if (!SYMBOLP(sym)) {
+		cl_object sym1 = setf_namep(sym);
+		if (sym1 != OBJNULL)
+			sym = sym1;
+		else
+			FEtype_error_symbol(sym);
+	}
+	if (sym->symbol.isform)
+		output = Ct;
+	else if (FBOUNDP(sym))
+		output = Cnil;
+	else
+		output = Ct;
+	@(return output)
+@)
+
+cl_object
+symbol_function(cl_object sym)
+{
+	if (!SYMBOLP(sym)) {
+		cl_object sym1 = setf_namep(sym);
+		if (sym1 != OBJNULL)
+			sym = sym1;
+		else
+			FEtype_error_symbol(sym);
+	}
+	if (sym->symbol.isform || sym->symbol.mflag)
+		FEinvalid_function(sym);
+	if (FBOUNDP(sym))
+		FEundefined_function(sym);
+	return(SYM_FUN(sym));
+}
+
+/*
+	Symbol-function returns
+                function-closure		for function
+		(macro . function-closure)	for macros
+		(special . address)		for special forms.
+	(if defined CLOS it returns also
+		generic-function                for generic functions)
+*/
+@(defun symbol_function (sym)
+	cl_object output;
+@
+	if (!SYMBOLP(sym)) {
+		cl_object sym1 = setf_namep(sym);
+		if (sym1 != OBJNULL)
+			sym = sym1;
+		else
+			FEtype_error_symbol(sym);
+	}
+	if (sym->symbol.isform)
+		output = Sspecial;
+	else if (FBOUNDP(sym))
+		FEundefined_function(sym);
+	else if (sym->symbol.mflag)
+		output = CONS(Smacro, SYM_FUN(sym));
+	else
+		output = SYM_FUN(sym);
+	@(return output)
+@)
+
+@(defun si::coerce_to_function (fun)
+	enum cl_type t = type_of(fun);
+@
+	if (t == t_symbol) {
+		cl_object fd = lex_fun_sch(fun);
+		if (!Null(fd))
+			return CADDR(fd);
+		else if (FBOUNDP(fun) || fun->symbol.mflag)
+			FEundefined_function(fun);
+		else
+			@(return SYM_FUN(fun))
+	} else if (t == t_cons && CAR(fun) == Slambda) {
+		return siLmake_lambda(2, Cnil, CDR(fun));
+	} else {
+	  	cl_object setf_sym = setf_namep(fun);
+		if ((setf_sym != OBJNULL) && !FBOUNDP(setf_sym))
+			@(return SYM_FUN(setf_sym))
+		else
+			FEinvalid_function(fun);
+	}
+@)
+
+@(defun symbol_value (sym)
+@
+	if (!SYMBOLP(sym))
+		FEtype_error_symbol(sym);
+	if (SBOUNDP(sym))
+		FEunbound_variable(sym);
+	@(return SYM_VAL(sym))
+@)
+
+@(defun boundp (sym)
+@
+	if (!SYMBOLP(sym))
+		FEtype_error_symbol(sym);
+	@(return (SBOUNDP(sym)? Cnil : Ct))
+@)
+
+@(defun macro_function (sym &optional env)
+	cl_object fd;
+@
+	if (!SYMBOLP(sym))
+		FEtype_error_symbol(sym);
+	if (Null(env))
+		fd = Cnil;
+	else {
+		fd = search_macro(sym, env);
+		if (!Null(fd)) @(return fd)
+	}
+	if (sym->symbol.mflag)
+		fd = SYM_FUN(sym);
+	@(return fd)
+@)
+
+@(defun special_form_p (form)
+@
+	if (!SYMBOLP(form))
+		FEtype_error_symbol(form);
+	@(return (form->symbol.isform? Ct : Cnil))
+@)
diff --git a/src/c/sequence.d b/src/c/sequence.d
new file mode 100644
index 000000000..23625a825
--- /dev/null
+++ b/src/c/sequence.d
@@ -0,0 +1,466 @@
+/*
+    sequence.d -- Sequence routines.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "ecls-inl.h"
+
+#undef endp
+
+#define	endp(obje)	(endp_temp = (obje), CONSP(endp_temp) ? \
+			 FALSE : endp_temp == Cnil ? TRUE : \
+			 (FEwrong_type_argument(Slist, endp_temp), FALSE))
+
+/*
+	I know the following name is not good.
+*/
+cl_object
+alloc_simple_vector(int l, enum aelttype aet)
+{
+	cl_object x;
+
+	x = alloc_object(t_vector);
+	x->vector.hasfillp = FALSE;
+	x->vector.adjustable = FALSE;
+	x->vector.displaced = Cnil;
+	x->vector.dim = x->vector.fillp = l;
+	x->vector.self.t = NULL;
+	x->vector.elttype = (short)aet;
+	return(x);
+}
+
+cl_object
+alloc_simple_bitvector(int l)
+{
+	cl_object x;
+
+	x = alloc_object(t_bitvector);
+	x->vector.hasfillp = FALSE;
+	x->vector.adjustable = FALSE;
+	x->vector.displaced = Cnil;
+	x->vector.dim = x->vector.fillp = l;
+	x->vector.offset = 0;
+	x->vector.self.bit = NULL;
+	return(x);
+}
+
+@(defun elt (x i)
+@
+	@(return elt(x, fixint(i)))
+@)
+
+cl_object
+elt(cl_object seq, cl_fixnum index)
+{
+	cl_fixnum i;
+	cl_object l;
+	cl_object endp_temp;
+
+	if (index < 0)
+		goto E;
+	switch (type_of(seq)) {
+	case t_cons:
+		for (i = index, l = seq;  i > 0;  --i)
+			if (endp(l))
+				goto E;
+			else
+				l = CDR(l);
+		if (endp(l))
+			goto E;
+		return(CAR(l));
+
+	case t_vector:
+	case t_bitvector:
+		if (index >= seq->vector.fillp)
+			goto E;
+		return(aref(seq, index));
+
+	case t_string:
+		if (index >= seq->string.fillp)
+			goto E;
+		return(code_char(seq->string.self[index]));
+
+	default:
+		FEerror("~S is not a sequence.", 1, seq);
+	}
+E:
+	FEtype_error_index(MAKE_FIXNUM(index));
+}
+
+@(defun si::elt_set (seq index val)
+@
+	@(return elt_set(seq, fixint(index), val))
+@)
+
+cl_object
+elt_set(cl_object seq, cl_fixnum index, cl_object val)
+{
+	int i;
+	cl_object l;
+	cl_object endp_temp;
+
+	if (index < 0)
+		goto E;
+	switch (type_of(seq)) {
+	case t_cons:
+		for (i = index, l = seq;  i > 0;  --i)
+			if (endp(l))
+				goto E;
+			else
+				l = CDR(l);
+		if (endp(l))
+			goto E;
+		return(CAR(l) = val);
+
+	case t_vector:
+	case t_bitvector:
+		if (index >= seq->vector.fillp)
+			goto E;
+		return(aset(seq, index, val));
+
+	case t_string:
+		if (index >= seq->string.fillp)
+			goto E;
+		/* INV: char_code() checks the type of `val' */
+		seq->string.self[index] = char_code(val);
+		return(val);
+
+	default:
+		FEerror("~S is not a sequence.", 1, seq);
+	}
+E:
+	FEtype_error_index(MAKE_FIXNUM(index));
+}
+
+@(defun subseq (sequence start &optional end &aux x)
+	cl_fixnum s, e;
+	cl_fixnum i, j;
+@
+	s = fixnnint(start);
+	if (Null(end))
+		e = -1;
+	else
+		e = fixnnint(end);
+	switch (type_of(sequence)) {
+	case t_symbol:
+		if (Null(sequence)) {
+			if (s > 0)
+				goto ILLEGAL_START_END;
+			if (e > 0)
+				goto ILLEGAL_START_END;
+			@(return Cnil)
+		}
+		FEwrong_type_argument(Ssequence, sequence);
+
+	case t_cons:
+		if (e >= 0)
+			if ((e -= s) < 0)
+				goto ILLEGAL_START_END;
+		while (s-- > 0) {
+			if (ATOM(sequence))
+				goto ILLEGAL_START_END;
+			sequence = CDR(sequence);
+		}
+		if (e < 0)
+			@(return `copy_list(sequence)`)
+		{ cl_object *z = &x;
+		  for (i = 0;  i < e;  i++) {
+		    if (ATOM(sequence))
+		      goto ILLEGAL_START_END;
+		    z = &CDR(*z = CONS(CAR(sequence), Cnil));
+		    sequence = CDR(sequence);
+		  }
+		}
+		@(return x)
+
+	case t_vector:
+		if (s > sequence->vector.fillp)
+			goto ILLEGAL_START_END;
+		if (e < 0)
+			e = sequence->vector.fillp;
+		else if (e < s || e > sequence->vector.fillp)
+			goto ILLEGAL_START_END;
+		x = alloc_simple_vector(e - s, sequence->vector.elttype);
+		array_allocself(x);
+		switch ((enum aelttype)sequence->vector.elttype) {
+		case aet_object:
+		case aet_fix:
+		case aet_sf:
+			for (i = s, j = 0;  i < e;  i++, j++)
+				x->vector.self.t[j] = sequence->vector.self.t[i];
+			break;
+
+		case aet_lf:
+			for (i = s, j = 0;  i < e;  i++, j++)
+				x->array.self.lf[j] =
+				sequence->array.self.lf[i];
+			break;
+		default:
+			internal_error("subseq");
+		}
+		@(return x)
+
+	case t_string:
+		if (s > sequence->string.fillp)
+			goto ILLEGAL_START_END;
+		if (e < 0)
+			e = sequence->string.fillp;
+		else if (e < s || e > sequence->string.fillp)
+			goto ILLEGAL_START_END;
+		x = alloc_simple_string(e - s);
+		x->string.self = alloc_atomic(e - s + 1);
+		x->string.self[e-s] = '\0';
+		for (i = s, j = 0;  i < e;  i++, j++)
+			x->string.self[j] = sequence->string.self[i];
+		@(return x)
+
+	case t_bitvector:
+		if (s > sequence->vector.fillp)
+			goto ILLEGAL_START_END;
+		if (e < 0)
+			e = sequence->vector.fillp;
+		else if (e < s || e > sequence->vector.fillp)
+			goto ILLEGAL_START_END;
+		x = alloc_simple_bitvector(e - s);
+		x->vector.self.bit = alloc_atomic((e-s+CHAR_BIT-1)/CHAR_BIT);
+		s += sequence->vector.offset;
+		e += sequence->vector.offset;
+		for (i = s, j = 0;  i < e;  i++, j++)
+			if (sequence->vector.self.bit[i/CHAR_BIT]&(0200>>i%CHAR_BIT))
+				x->vector.self.bit[j/CHAR_BIT]
+				|= 0200>>j%CHAR_BIT;
+			else
+				x->vector.self.bit[j/CHAR_BIT]
+				&= ~(0200>>j%CHAR_BIT);
+		@(return x)
+
+	default:
+		FEwrong_type_argument(Ssequence, x);
+	}
+
+ILLEGAL_START_END:
+	FEerror("~S and ~S are illegal as :START and :END~%\
+for the sequence ~S.", 3, start, end, sequence);
+@)
+
+@(defun copy_seq (x)
+@
+	/* INV: #'subseq outputs only one value */
+	return Lsubseq(2, x, MAKE_FIXNUM(0));
+@)
+
+@(defun length (x)
+@
+	@(return MAKE_FIXNUM(length(x)))
+@)
+
+cl_fixnum
+length(cl_object x)
+{
+	cl_fixnum i;
+
+	switch (type_of(x)) {
+	case t_symbol:
+		if (Null(x))
+			return(0);
+		FEwrong_type_argument(Ssequence, x);
+
+	case t_cons:
+		/* INV: A list's length always fits in a fixnum */
+		i = 0;
+		loop_for_in(x) {
+			i++;
+		} end_loop_for_in;
+		return(i);
+
+	case t_vector:
+	case t_string:
+	case t_bitvector:
+		return(x->vector.fillp);
+
+	default:
+		FEwrong_type_argument(Ssequence, x);
+	}
+}
+
+@(defun reverse (x)
+@
+	@(return reverse(x))
+@)
+
+cl_object
+reverse(cl_object seq)
+{
+	cl_object x, y, v;
+	int i, j, k;
+	cl_object endp_temp;
+
+	switch (type_of(seq)) {
+	case t_symbol:
+		if (Null(seq))
+			return(Cnil);
+		FEwrong_type_argument(Ssequence, seq);
+
+	case t_cons:
+		v = Cnil;
+		for (x = seq;  !endp(x);  x = CDR(x))
+			v = CONS(CAR(x), v);
+		return(v);
+
+	case t_vector:
+		x = seq;
+		k = x->vector.fillp;
+		y = alloc_simple_vector(k, x->vector.elttype);
+		array_allocself(y);
+		switch ((enum aelttype)x->vector.elttype) {
+		case aet_object:
+		case aet_fix:
+		case aet_sf:
+			for (j = k - 1, i = 0;  j >=0;  --j, i++)
+				y->vector.self.t[j] = x->vector.self.t[i];
+			break;
+
+		case aet_lf:
+			for (j = k - 1, i = 0;  j >=0;  --j, i++)
+				y->array.self.lf[j] = x->array.self.lf[i];
+			break;
+		default:
+			internal_error("reverse");
+		}
+		return(y);
+
+	case t_string:
+		x = seq;
+		y = alloc_simple_string(x->string.fillp);
+		y->string.self = alloc_atomic(x->string.fillp+1);
+		for (j = x->string.fillp - 1, i = 0;  j >=0;  --j, i++)
+			y->string.self[j] = x->string.self[i];
+		y->string.self[x->string.fillp] = '\0';
+		return(y);
+
+	case t_bitvector:
+		x = seq;
+		y = alloc_simple_bitvector(x->vector.fillp);
+		y->vector.self.bit = alloc_atomic((x->vector.fillp+CHAR_BIT-1)/CHAR_BIT);
+		for (j = x->vector.fillp - 1, i = x->vector.offset;
+		     j >=0;
+		     --j, i++)
+			if (x->vector.self.bit[i/CHAR_BIT]&(0200>>i%CHAR_BIT))
+				y->vector.self.bit[j/CHAR_BIT] |= 0200>>j%CHAR_BIT;
+			else
+				y->vector.self.bit[j/CHAR_BIT] &= ~(0200>>j%CHAR_BIT);
+		return(v);
+
+	default:
+		FEwrong_type_argument(Ssequence, seq);
+	}
+}
+
+@(defun nreverse (x)
+@
+	@(return nreverse(x))
+@)
+
+cl_object
+nreverse(cl_object seq)
+{
+	cl_object x, y, z;
+	int i, j, k;
+	cl_object endp_temp;
+
+	switch (type_of(seq)) {
+	case t_symbol:
+		if (Null(seq))
+			return(Cnil);
+		FEwrong_type_argument(Ssequence, seq);
+
+	case t_cons:
+		for (x = Cnil, y = seq;  !endp(CDR(y));) {
+			z = y;
+			y = CDR(y);
+			CDR(z) = x;
+			x = z;
+		}
+		CDR(y) = x;
+		return(y);
+
+	case t_vector:
+		x = seq;
+		k = x->vector.fillp;
+		switch ((enum aelttype)x->vector.elttype) {
+		case aet_object:
+		case aet_fix:
+			for (i = 0, j = k - 1;  i < j;  i++, --j) {
+				y = x->vector.self.t[i];
+				x->vector.self.t[i] = x->vector.self.t[j];
+				x->vector.self.t[j] = y;
+			}
+			return(seq);
+
+		case aet_sf:
+			for (i = 0, j = k - 1;  i < j;  i++, --j) {
+				float y = x->array.self.sf[i];
+				x->array.self.sf[i] = x->array.self.sf[j];
+				x->array.self.sf[j] = y;
+			}
+			return(seq);
+
+		case aet_lf:
+			for (i = 0, j = k - 1;  i < j;  i++, --j) {
+				double y = x->array.self.lf[i];
+				x->array.self.lf[i] = x->array.self.lf[j];
+				x->array.self.lf[j] = y;
+			}
+			return(seq);
+		default:
+			internal_error("subseq");
+		}
+
+	case t_string:
+		x = seq;
+		for (i = 0, j = x->string.fillp - 1;  i < j;  i++, --j) {
+			k = x->string.self[i];
+			x->string.self[i] = x->string.self[j];
+			x->string.self[j] = k;
+		}
+		return(seq);
+
+	case t_bitvector:
+		x = seq;
+		for (i = x->vector.offset,
+		     j = x->vector.fillp + x->vector.offset - 1;
+		     i < j;
+		     i++, --j) {
+			k = x->vector.self.bit[i/CHAR_BIT]&(0200>>i%CHAR_BIT);
+			if (x->vector.self.bit[j/CHAR_BIT]&(0200>>j%CHAR_BIT))
+				x->vector.self.bit[i/CHAR_BIT]
+				|= 0200>>i%CHAR_BIT;
+			else
+				x->vector.self.bit[i/CHAR_BIT]
+				&= ~(0200>>i%CHAR_BIT);
+			if (k)
+				x->vector.self.bit[j/CHAR_BIT]
+				|= 0200>>j%CHAR_BIT;
+			else
+				x->vector.self.bit[j/CHAR_BIT]
+				&= ~(0200>>j%CHAR_BIT);
+		}
+		return(seq);
+
+	default:
+		FEwrong_type_argument(Ssequence, seq);
+	}
+}
diff --git a/src/c/stacks.d b/src/c/stacks.d
new file mode 100644
index 000000000..0e52363ce
--- /dev/null
+++ b/src/c/stacks.d
@@ -0,0 +1,375 @@
+/*
+    stacks.c -- Binding/History/Frame stacks.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#ifdef HAVE_SYS_RESOURCE_H
+# include <sys/time.h>
+# include <sys/resource.h>
+#endif
+
+#ifndef THREADS
+size_t bds_size;
+bds_ptr bds_org;
+bds_ptr bds_limit;
+bds_ptr bds_top;
+
+size_t ihs_size;
+ihs_ptr ihs_org;
+ihs_ptr ihs_limit;
+ihs_ptr ihs_top;
+
+size_t frs_size;
+frame_ptr frs_org;
+frame_ptr frs_limit;
+frame_ptr frs_top;
+frame_ptr nlj_fr;
+cl_object nlj_tag;
+
+int *cs_org;
+int *cs_limit;
+size_t cssize;
+
+int NValues;
+cl_object Values[VSSIZE];
+#endif
+
+cl_object Kcatch, Kcatchall, Kprotect;
+
+/********************* BINDING STACK ************************/
+
+void
+bds_overflow(void)
+{
+	--bds_top;
+	if (bds_limit > bds_org + bds_size)
+		error("bind stack overflow.");
+	bds_limit += BDSGETA;
+	FEerror("Bind stack overflow.", 0);
+}
+
+void
+bds_unwind(bds_ptr new_bds_top)
+{       register bds_ptr bds = bds_top;
+	for (;  bds > new_bds_top;  bds--)
+		SYM_VAL(bds->bds_sym) = bds->bds_val;
+	bds_top = new_bds_top;
+}
+
+static bds_ptr
+get_bds_ptr(cl_object x)
+{
+	bds_ptr p;
+
+	if (FIXNUMP(x)) {
+	  p = bds_org + fix(x);
+	  if (bds_org <= p && p <= bds_top)
+	    return(p);
+	}
+	FEerror("~S is an illegal bds index.", 1, x);
+}
+
+@(defun si::bds_top ()
+@
+	@(return MAKE_FIXNUM(bds_top - bds_org))
+@)
+
+@(defun si::bds_var (arg)
+@
+	@(return get_bds_ptr(arg)->bds_sym)
+@)
+
+@(defun si::bds_val (arg)
+@
+	@(return get_bds_ptr(arg)->bds_val)
+@)
+
+/******************** INVOCATION STACK **********************/
+
+void
+ihs_overflow(void)
+{
+	--ihs_top;
+	if (ihs_limit > ihs_org + ihs_size)
+		error("invocation history stack overflow.");
+	ihs_limit += IHSGETA;
+	FEerror("Invocation history stack overflow.", 0);
+}
+
+cl_object
+ihs_function_name(cl_object x)
+{
+	cl_object y;
+
+	switch (type_of(x)) {
+	case t_symbol:
+		return(x);
+
+	case t_bytecodes:
+		y = x->bytecodes.data[0];
+		if (Null(y))
+			return(Slambda);
+		else
+			return y;
+
+	case t_cfun:
+		return(x->cfun.name);
+
+	default:
+		return(Cnil);
+	}
+}
+
+cl_object
+ihs_top_function_name(void)
+{
+	cl_object x;
+	ihs_ptr h = ihs_top;
+
+	while (h >= ihs_org) {
+		x = ihs_function_name(h->ihs_function);
+		if (x != Cnil)
+			return(x);
+		h--;
+	}
+	return(Cnil);
+}
+
+/*
+	Lisp interface to IHS
+*/
+
+static ihs_ptr
+get_ihs_ptr(cl_object x)
+{
+	ihs_ptr p;
+
+	if (FIXNUMP(x)) {
+	  p = ihs_org + fix(x);
+	  if (ihs_org <= p && p <= ihs_top)
+	    return(p);
+	}
+	FEerror("~S is an illegal ihs index.", 1, x);
+}
+
+@(defun si::ihs_top ()
+@
+	@(return MAKE_FIXNUM(ihs_top - ihs_org))
+@)
+
+@(defun si::ihs_fun (arg)
+@
+	@(return get_ihs_ptr(arg)->ihs_function)
+@)
+
+@(defun si::ihs_env (arg)
+	cl_object lex;
+@
+	lex = get_ihs_ptr(arg)->ihs_base;
+	@(return CONS(car(lex),cdr(lex)))
+@)
+
+/********************** FRAME STACK *************************/
+
+static int frame_id = 0;
+
+cl_object
+new_frame_id(void)
+{
+  return(MAKE_FIXNUM(frame_id++));
+}
+
+int
+frs_overflow(void)		/* used as condition in list.d */
+{
+	--frs_top;
+	if (frs_limit > frs_org + frs_size)
+		error("frame stack overflow.");
+	frs_limit += FRSGETA;
+	FEerror("Frame stack overflow.", 0);
+}
+
+frame_ptr
+_frs_push(register enum fr_class class, register cl_object val)
+{
+	if (++frs_top >= frs_limit) frs_overflow();
+	frs_top->frs_lex = lex_env;
+	frs_top->frs_bds_top = bds_top;
+	frs_top->frs_class = class;
+	frs_top->frs_val = val;
+	frs_top->frs_ihs = ihs_top;
+	frs_top->frs_sp = stack->vector.fillp;
+	return frs_top;
+}
+
+void
+unwind(frame_ptr fr, cl_object tag)
+{
+	nlj_fr = fr;
+	nlj_tag = tag;
+	while (frs_top != fr
+		&& frs_top->frs_class == FRS_CATCH)
+	  --frs_top;
+	lex_env = frs_top->frs_lex;
+	ihs_top = frs_top->frs_ihs;
+	bds_unwind(frs_top->frs_bds_top);
+	stack->vector.fillp = frs_top->frs_sp;
+	ecls_longjmp(frs_top->frs_jmpbuf, 1);
+	/* never reached */
+}
+
+frame_ptr
+frs_sch (cl_object frame_id)
+{
+	frame_ptr top;
+
+	for (top = frs_top;  top >= frs_org;  top--)
+		if (top->frs_val == frame_id && top->frs_class == FRS_CATCH)
+			return(top);
+	return(NULL);
+}
+
+frame_ptr
+frs_sch_catch(cl_object frame_id)
+{
+	frame_ptr top;
+
+	for(top = frs_top;  top >= frs_org  ;top--)
+	  if ((top->frs_val == frame_id && top->frs_class == FRS_CATCH)
+	      || top->frs_class == FRS_CATCHALL)
+	    return(top);
+	return(NULL);
+}
+
+static frame_ptr
+get_frame_ptr(cl_object x)
+{
+	frame_ptr p;
+
+	if (FIXNUMP(x)) {
+	  p = frs_org + fix(x);
+	  if (frs_org <= p && p <= frs_top)
+	    return(p);
+	}
+	FEerror("~S is an illegal frs index.", 1, x);
+}
+
+@(defun si::frs_top ()
+@
+	@(return MAKE_FIXNUM(frs_top - frs_org))
+@)
+
+@(defun si::frs_bds (arg)
+@
+	@(return MAKE_FIXNUM(get_frame_ptr(arg)->frs_bds_top - bds_org))
+@)
+
+@(defun si::frs_class (arg)
+	enum fr_class c;
+	cl_object output;
+@
+	c = get_frame_ptr(arg)->frs_class;
+	if (c == FRS_CATCH) output = Kcatch;
+	else if (c == FRS_PROTECT) output = Kprotect;
+	else if (c == FRS_CATCHALL) output = Kcatchall;
+	else FEerror("Unknown frs class was detected.", 0);
+	@(return output)
+@)
+
+@(defun si::frs_tag (arg)
+@
+	@(return get_frame_ptr(arg)->frs_val)
+@)
+
+@(defun si::frs_ihs (arg)
+@
+	@(return MAKE_FIXNUM(get_frame_ptr(arg)->frs_ihs - ihs_org))
+@)
+
+@(defun si::sch_frs_base (fr ihs)
+	frame_ptr x;
+	ihs_ptr y;
+@
+	y = get_ihs_ptr(ihs);
+	for (x = get_frame_ptr(fr); x <= frs_top && x->frs_ihs < y; x++);
+	@(return ((x > frs_top) ? Cnil : MAKE_FIXNUM(x - frs_org)))
+@)
+
+/********************* INITIALIZATION ***********************/
+
+@(defun si::reset_stack_limits ()
+@
+	if (bds_top < bds_org + (bds_size - 2*BDSGETA))
+		bds_limit = bds_org + (bds_size - 2*BDSGETA);
+	else
+		error("can't reset bds_limit.");
+	if (frs_top < frs_org + (bds_size - 2*FRSGETA))
+		frs_limit = frs_org + (frs_size - 2*FRSGETA);
+	else
+		error("can't reset frs_limit.");
+	if (ihs_top < ihs_org + (ihs_size - 2*IHSGETA))
+		ihs_limit = ihs_org + (ihs_size - 2*IHSGETA);
+	else
+		error("can't reset ihs_limit.");
+#ifdef DOWN_STACK
+	if (&narg > cs_org - cssize + 16)
+		cs_limit = cs_org - cssize;
+#else
+	if (&narg < cs_org + cssize - 16)
+		cs_limit = cs_org + cssize;
+#endif
+	else
+		error("can't reset cs_limit.");
+
+	@(return Cnil)
+@)
+
+void
+alloc_stacks(int *new_cs_org)
+{
+#ifdef THREADS
+	Values = main_lpd.lwp_Values;
+#endif
+
+	frs_size = FRSSIZE + 2*FRSGETA;
+	frs_org = alloc(frs_size * sizeof(*frs_org));
+	frs_top = frs_org-1;
+	frs_limit = &frs_org[frs_size - 2*FRSGETA];
+	bds_size = BDSSIZE + 2*BDSGETA;
+	bds_org = alloc(bds_size * sizeof(*bds_org));
+	bds_top = bds_org-1;
+	bds_limit = &bds_org[bds_size - 2*BDSGETA];
+	ihs_size = IHSSIZE + 2*IHSGETA;
+	ihs_org = alloc(ihs_size * sizeof(*ihs_org));
+  	ihs_top = ihs_org-1;
+	ihs_limit = &ihs_org[ihs_size - 2*IHSGETA];
+
+	cs_org = new_cs_org;
+#if defined(HAVE_SYS_RESOURCE_H) && defined(RLIMIT_STACK)
+	{
+	  struct rlimit rl;
+	  getrlimit(RLIMIT_STACK, &rl);
+	  cssize = rl.rlim_cur/4 - 4*CSGETA;
+	}
+#else
+	cssize = CSSIZE;
+#endif
+#ifdef DOWN_STACK
+	cs_limit = cs_org - cssize; /* in THREADS I'm assigning to the main thread clwp */
+#else
+	cs_limit = cs_org + cssize;
+#endif
+}
diff --git a/src/c/string.d b/src/c/string.d
new file mode 100644
index 000000000..ad9c84375
--- /dev/null
+++ b/src/c/string.d
@@ -0,0 +1,683 @@
+/*
+    string.d -- String routines.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under thep terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include <ctype.h>
+#include <string.h>
+#include "ecls-inl.h"
+
+cl_object Kstart1;
+cl_object Kend1;
+cl_object Kstart2;
+cl_object Kend2;
+cl_object Kstart;
+cl_object Kend;
+
+@(defun make_string (size &key (initial_element code_char(' '))
+		     (element_type Scharacter)
+		     &aux x)
+	cl_index i, s, code;
+@
+	if (element_type != Scharacter
+	    && element_type != Sbase_char
+	    && element_type != Sstandard_char) {
+	  if (_funcall(2, Ssubtypep, element_type, Scharacter) == Cnil)
+	    FEerror("The type ~S is not a valid string char type.",
+		    1, element_type);
+	}
+	/* INV: char_code() checks the type of initial_element() */
+	code = char_code(initial_element);
+	s = object_to_index(size);
+	x = alloc_simple_string(s);
+	x->string.self = alloc_atomic(s+1);
+	x->string.self[s] = '\0';
+	for (i = 0;  i < s;  i++)
+		x->string.self[i] = code;
+	@(return x)
+@)
+
+cl_object
+alloc_simple_string(cl_index l)
+{
+	cl_object x;
+
+	x = alloc_object(t_string);
+	x->string.hasfillp = FALSE;
+	x->string.adjustable = FALSE;
+	x->string.displaced = Cnil;
+	x->string.dim = (x->string.fillp = l) + 1;
+	x->string.self = NULL;
+	return(x);
+}
+
+/*
+	Make a string of a certain size, with some eading zeros to
+	keep C happy. The string must be adjustable, to allow further
+	growth. (See unixfsys.c for its use).
+*/
+cl_object
+alloc_adjustable_string(cl_index l)
+{
+	cl_object output = alloc_simple_string(l);
+	output->string.self = alloc_atomic(l+1);
+	output->string.self[l] = output->string.self[0] = 0;
+	output->string.fillp = 0;
+	output->string.hasfillp = TRUE;
+ 	output->string.adjustable = TRUE;
+	return output;
+}
+
+/*
+	Make_simple_string(s) makes a simple string from C string s.
+*/
+cl_object
+make_simple_string(char *s)
+{
+	cl_object x;
+
+	x = alloc_simple_string(strlen(s));
+	x->string.self = s;
+	
+	return(x);
+}
+
+cl_object
+make_string_copy(char *s)
+{
+	cl_object x;
+	cl_index l = strlen(s);
+
+	x = alloc_simple_string(l);
+	x->string.self = alloc_atomic(l+1);
+	memcpy(x->string.self, s, l+1);
+	return(x);
+}
+
+
+/*
+	Copy_simple_string(x) copies string x to a simple string.
+*/
+cl_object
+copy_simple_string(cl_object x)
+{
+	cl_object y;
+	cl_index l = x->string.fillp;
+
+	y = alloc_simple_string(l);
+	y->string.self = alloc_atomic(l+1);
+	memcpy(y->string.self, x->string.self, l);
+	y->string.self[l] = '\0';
+	return(y);
+}
+
+cl_object
+coerce_to_string(cl_object x)
+{
+	cl_object y;
+
+	switch (type_of(x)) {
+	case t_symbol:
+		return x->symbol.name;
+
+	case t_character:
+		y = alloc_simple_string(1);
+		y->string.self = alloc_atomic(2);
+		y->string.self[1] = '\0';
+		y->string.self[0] = CHAR_CODE(x);
+		return(y);
+
+	case t_string:
+		return(x);
+
+	default:
+		FEtype_error_string(x);
+	}
+}
+
+/*
+	Outputs a valid string designator which is either a string or
+	a symbol, avoiding copying as far as possible. Characters are
+	coerced to strings.
+*/
+cl_object
+coerce_to_string_designator(cl_object x)
+{
+	cl_object y;
+
+	switch (type_of(x)) {
+	case t_symbol:
+		return x->symbol.name;
+
+	case t_string:
+		return x;
+
+	case t_character:
+		y = alloc_simple_string(1);
+		y->string.self = alloc_atomic(2);
+		y->string.self[1] = '\0';
+		y->string.self[0] = CHAR_CODE(x);
+		return(y);
+
+	default:
+		FEtype_error_string(x);
+	}
+}
+
+@(defun char (s i)
+	cl_index j;
+@
+	assert_type_string(s);
+	j = object_to_index(i);
+	/* CHAR bypasses fill pointers when accessing strings */
+	if (j >= s->string.dim-1)
+		illegal_index(s, i);
+	@(return `code_char(s->string.self[j])`)
+@)
+
+@(defun si::char_set (str index c)
+	cl_index j;
+@
+	assert_type_string(str);
+	j = object_to_index(index);
+	if (j >= str->string.fillp)
+		illegal_index(str, index);
+	/* INV: char_code() checks type of `c' */
+	str->string.self[j] = char_code(c);
+	@(return c)
+@)
+
+void
+get_string_start_end(cl_object string, cl_object start, cl_object end,
+		     cl_index *ps, cl_index *pe)
+{
+	/* INV: Works with either string or symbol */
+	if (!FIXNUMP(start) || FIXNUM_MINUSP(start))
+		goto E;
+	else
+		*ps = fix(start);
+	if (Null(end)) {
+		*pe = string->string.fillp;
+		if (*pe < *ps)
+			goto E;
+	} else if (!FIXNUMP(end) || FIXNUM_MINUSP(end))
+		goto E;
+	else {
+		*pe = fix(end);
+		if (*pe < *ps || *pe > string->string.fillp)
+			goto E;
+	}
+	return;
+
+E:
+	FEerror("~S and ~S are illegal as :START and :END~%\
+for the string designator ~S.", 3, start, end, string);
+}
+
+@(defun string_eq (string1 string2 &key (start1 MAKE_FIXNUM(0)) end1
+		   (start2 MAKE_FIXNUM(0)) end2)
+	cl_index s1, e1, s2, e2;
+@
+	string1 = coerce_to_string_designator(string1);
+	string2 = coerce_to_string_designator(string2);
+	get_string_start_end(string1, start1, end1, &s1, &e1);
+	get_string_start_end(string2, start2, end2, &s2, &e2);
+	if (e1 - s1 != e2 - s2)
+		@(return Cnil)
+	while (s1 < e1)
+		if (string1->string.self[s1++] !=
+		    string2->string.self[s2++])
+			@(return Cnil)
+	@(return Ct)
+@)
+
+/*
+	This correponds to string= (just the string equality).
+*/
+bool
+string_eq(cl_object x, cl_object y)
+{
+	/* INV: Works with either a symbol or a string */
+	cl_index i, j;
+	i = x->string.fillp;
+	j = y->string.fillp;
+	return (i == j && strncmp(x->string.self, y->string.self, i) == 0);
+}
+
+
+@(defun string_equal (string1 string2 &key (start1 MAKE_FIXNUM(0)) end1
+		      (start2 MAKE_FIXNUM(0)) end2)
+	cl_index s1, e1, s2, e2;
+	cl_index i1, i2;
+@
+	string1 = coerce_to_string_designator(string1);
+	string2 = coerce_to_string_designator(string2);
+	get_string_start_end(string1, start1, end1, &s1, &e1);
+	get_string_start_end(string2, start2, end2, &s2, &e2);
+	if (e1 - s1 != e2 - s2)
+		@(return Cnil)
+	while (s1 < e1) {
+		i1 = string1->string.self[s1++];
+		i2 = string2->string.self[s2++];
+		if (toupper(i1) != toupper(i2))
+			@(return Cnil)
+	}
+	@(return Ct)
+@)
+
+/*
+	This corresponds to string-equal
+	(string equality ignoring the case).
+*/
+bool
+string_equal(cl_object x, cl_object y)
+{
+	cl_index i, j;
+	register char *p, *q;
+
+	/* INV: Works with symbols ands strings */
+	i = x->string.fillp;
+	j = y->string.fillp;
+	if (i != j)
+		return(FALSE);
+	p = x->string.self;
+	q = y->string.self;
+	for (i = 0;  i < j;  i++)
+		if (toupper(p[i]) != toupper(q[i]))
+			return(FALSE);
+	return(TRUE);
+}
+
+cl_return
+Lstring_cmp(int narg, int sign, int boundary, cl_object *ARGS)
+{
+	cl_object string1 = ARGS[0], string2 = ARGS[1];
+	cl_index s1, e1, s2, e2;
+	int s, i1, i2;
+	cl_object KEYS[4];
+#define start1 KEY_VARS[0]
+#define end1 KEY_VARS[1]
+#define start2 KEY_VARS[2]
+#define end2 KEY_VARS[3]
+#define start1p KEY_VARS[4]
+#define start2p KEY_VARS[6]
+	cl_object KEY_VARS[8];
+
+	if (narg < 2) FEtoo_few_arguments(&narg);
+	KEYS[0]=Kstart1;
+	KEYS[1]=Kend1;
+	KEYS[2]=Kstart2;
+	KEYS[3]=Kend2;
+	parse_key(narg-2, ARGS+2, 4, KEYS, KEY_VARS, OBJNULL, 0);
+
+	string1 = coerce_to_string_designator(string1);
+	string2 = coerce_to_string_designator(string2);
+	if (start1p == Cnil) start1 = MAKE_FIXNUM(0);
+	if (start2p == Cnil) start2 = MAKE_FIXNUM(0);
+	get_string_start_end(string1, start1, end1, &s1, &e1);
+	get_string_start_end(string2, start2, end2, &s2, &e2);
+	while (s1 < e1) {
+		if (s2 == e2)
+		  return1(sign>0 ? Cnil : MAKE_FIXNUM(s1));
+		i1 = string1->string.self[s1];
+		i2 = string2->string.self[s2];
+		if (sign == 0) {
+			if (i1 != i2)
+			  return1(MAKE_FIXNUM(s1));
+		} else {
+			s = sign*(i2-i1);
+			if (s > 0)
+			  return1(MAKE_FIXNUM(s1));
+			if (s < 0)
+			  return1(Cnil);
+		}
+		s1++;
+		s2++;
+	}
+	if (s2 == e2)
+	  return1(boundary==0 ? MAKE_FIXNUM(s1) : Cnil);
+	else
+	  return1(sign>=0 ? MAKE_FIXNUM(s1) : Cnil);
+#undef start1p
+#undef start2p
+#undef start1
+#undef end1
+#undef start2
+#undef end2
+}
+
+cl_return
+Lstring_l(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_cmp(narg, 1, 1, (cl_object *)args); }
+cl_return
+Lstring_g(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_cmp(narg,-1, 1, (cl_object *)args); }
+cl_return
+Lstring_le(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_cmp(narg, 1, 0, (cl_object *)args); }
+cl_return
+Lstring_ge(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_cmp(narg,-1, 0, (cl_object *)args); }
+cl_return
+Lstring_neq(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_cmp(narg, 0, 1, (cl_object *)args); }
+
+
+cl_return
+Lstring_compare(int narg, int sign, int boundary, cl_object *ARGS)
+{
+	cl_object string1 = ARGS[0], string2 = ARGS[1];
+	cl_index s1, e1, s2, e2;
+	int i1, i2, s;
+
+	cl_object KEYS[4];
+#define start1 KEY_VARS[0]
+#define end1 KEY_VARS[1]
+#define start2 KEY_VARS[2]
+#define end2 KEY_VARS[3]
+#define start1p KEY_VARS[4]
+#define start2p KEY_VARS[6]
+	cl_object KEY_VARS[8];
+
+	if (narg < 2) FEtoo_few_arguments(&narg);
+	KEYS[0]=Kstart1;
+	KEYS[1]=Kend1;
+	KEYS[2]=Kstart2;
+	KEYS[3]=Kend2;
+	parse_key(narg-2, ARGS+2, 4, KEYS, KEY_VARS, OBJNULL, 0);
+
+	string1 = coerce_to_string_designator(string1);
+	string2 = coerce_to_string_designator(string2);
+	if (start1p == Cnil) start1 = MAKE_FIXNUM(0);
+	if (start2p == Cnil) start2 = MAKE_FIXNUM(0);
+	get_string_start_end(string1, start1, end1, &s1, &e1);
+	get_string_start_end(string2, start2, end2, &s2, &e2);
+	while (s1 < e1) {
+		if (s2 == e2)
+		  return1(sign>0 ? Cnil : MAKE_FIXNUM(s1));
+		i1 = string1->string.self[s1];
+		i1 = toupper(i1);
+		i2 = string2->string.self[s2];
+		i2 = toupper(i2);
+		if (sign == 0) {
+			if (i1 != i2)
+			  return1(MAKE_FIXNUM(s1));
+		} else {
+			s = sign*(i2-i1);
+			if (s > 0)
+			  return1(MAKE_FIXNUM(s1));
+			if (s < 0)
+			  return1(Cnil);
+		}
+		s1++;
+		s2++;
+	}
+	if (s2 == e2)
+		return1(boundary==0 ? MAKE_FIXNUM(s1) : Cnil);
+	else
+		return1(sign>=0 ? MAKE_FIXNUM(s1) : Cnil);
+#undef start1p
+#undef start2p
+#undef start1
+#undef end1
+#undef start2
+#undef end2
+}
+
+cl_return
+Lstring_lessp(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_compare(narg, 1, 1, (cl_object *)args); }
+cl_return
+Lstring_greaterp(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_compare(narg,-1, 1, (cl_object *)args); }
+cl_return
+Lstring_not_greaterp(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_compare(narg, 1, 0, (cl_object *)args); }
+cl_return
+Lstring_not_lessp(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_compare(narg,-1, 0, (cl_object *)args); }
+cl_return
+Lstring_not_equal(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_compare(narg, 0, 1, (cl_object *)args); }
+
+bool
+member_char(int c, cl_object char_bag)
+{
+	cl_index i, f;
+
+	switch (type_of(char_bag)) {
+	case t_cons:
+		loop_for_in(char_bag) {
+			cl_object other = CAR(char_bag);
+			if (CHARACTERP(other) && c == CHAR_CODE(other))
+				return(TRUE);
+			char_bag = CDR(char_bag);
+		} end_loop_for_in;
+		return(FALSE);
+
+	case t_vector:
+		for (i = 0, f = char_bag->vector.fillp;  i < f;  i++) {
+			cl_object other = char_bag->vector.self.t[i];
+			if (CHARACTERP(other) && c == CHAR_CODE(other))
+				return(TRUE);
+		}
+		return(FALSE);
+
+	case t_string:
+		for (i = 0, f = char_bag->string.fillp;  i < f;  i++) {
+			if (c == char_bag->string.self[i])
+				return(TRUE);
+		}
+		return(FALSE);
+
+	case t_bitvector:
+		return(FALSE);
+
+	default:
+		FEerror("~S is not a sequence.", 1, char_bag);
+	}
+}
+
+cl_return
+Lstring_trim(int narg, cl_object char_bag, cl_object strng)
+	{ return Lstring_trim0(narg, TRUE, TRUE, char_bag, strng); }
+cl_return
+Lstring_left_trim(int narg, cl_object char_bag, cl_object strng)
+	{ return Lstring_trim0(narg, TRUE, FALSE, char_bag, strng); }
+cl_return
+Lstring_right_trim(int narg, cl_object char_bag, cl_object strng)
+	{ return Lstring_trim0(narg, FALSE, TRUE, char_bag, strng);}
+
+@(defun string_trim0(bool left_trim, bool right_trim)
+		    (char_bag strng &aux res)
+	cl_index i, j, k;
+@
+	strng = coerce_to_string_designator(strng);
+	i = 0;
+	j = strng->string.fillp - 1;
+	if (left_trim)
+		for (;  i <= j;  i++)
+			if (!member_char(strng->string.self[i], char_bag))
+				break;
+	if (right_trim)
+		for (;  j >= i;  --j)
+			if (!member_char(strng->string.self[j], char_bag))
+				break;
+	k = j - i + 1;
+	res = alloc_simple_string(k);
+	res->string.self = alloc_atomic(k+1);
+	res->string.self[k] = '\0';
+	memcpy(res->string.self, strng->string.self+i, k);
+	@(return res)
+@)
+
+cl_return
+Lstring_case(int narg, int (*casefun)(), cl_object *ARGS)
+{
+	cl_object strng = ARGS[0];
+	cl_index s, e, i;
+	bool b;
+	cl_object KEYS[2];
+#define start KEY_VARS[0]
+#define end KEY_VARS[1]
+#define startp KEY_VARS[2]
+	cl_object conv;
+	cl_object KEY_VARS[4];
+
+	if (narg < 1) FEtoo_few_arguments(&narg);
+	KEYS[0]=Kstart;
+	KEYS[1]=Kend;
+	parse_key(narg-1, ARGS+1, 2, KEYS, KEY_VARS, OBJNULL, 0);
+
+	strng = coerce_to_string_designator(strng);
+	conv = copy_simple_string(strng);
+	if (startp == Cnil) start = MAKE_FIXNUM(0);
+	get_string_start_end(conv, start, end, &s, &e);
+	b = TRUE;
+	for (i = s;  i < e;  i++)
+		conv->string.self[i] = (*casefun)(conv->string.self[i], &b);
+	return1(conv);
+#undef startp
+#undef start
+#undef end
+}
+
+static int char_upcase(int c, int *bp);
+static int char_downcase(int c, int *bp);
+static int char_capitalize(int c, int *bp);
+
+cl_return
+Lstring_upcase(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_case(narg, char_upcase, (cl_object *)args); }
+
+static int
+char_upcase(int c, int *bp)
+{
+	return(toupper(c));
+}
+
+cl_return
+Lstring_downcase(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_case(narg, char_downcase, (cl_object *)args); }
+
+static int
+char_downcase(int c, int *bp)
+{
+	return(tolower(c));
+}
+
+cl_return
+Lstring_capitalize(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lstring_case(narg, char_capitalize, (cl_object *)args); }
+
+static int
+char_capitalize(int c, int *bp)
+{
+	if (islower(c)) {
+		if (*bp)
+			c = toupper(c);
+		*bp = FALSE;
+	} else if (isupper(c)) {
+		if (!*bp)
+			c = tolower(c);
+		*bp = FALSE;
+	} else if (!isdigit(c))
+		*bp = TRUE;
+	return(c);
+}
+
+
+cl_return
+Lnstring_case(int narg, int (*casefun)(), cl_object *ARGS)
+{
+	cl_object strng = ARGS[0];
+	cl_index s, e, i;
+	bool b;
+	cl_object KEYS[2];
+#define start KEY_VARS[0]
+#define end KEY_VARS[1]
+#define startp KEY_VARS[2]
+	cl_object KEY_VARS[4];
+
+	if (narg < 1) FEtoo_few_arguments(&narg);
+	KEYS[0]=Kstart;
+	KEYS[1]=Kend;
+	parse_key(narg-1, ARGS+1, 2, KEYS, KEY_VARS, OBJNULL, 0);
+
+	assert_type_string(strng);
+	if (startp == Cnil) start = MAKE_FIXNUM(0);
+	get_string_start_end(strng, start, end, &s, &e);
+	b = TRUE;
+	for (i = s;  i < e;  i++)
+		strng->string.self[i] = (*casefun)(strng->string.self[i], &b);
+	return1(strng);
+#undef startp
+#undef start
+#undef end
+}
+
+cl_return
+Lnstring_upcase(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lnstring_case(narg, char_upcase, (cl_object *)args); }
+cl_return
+Lnstring_downcase(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lnstring_case(narg, char_downcase, (cl_object *)args); }
+cl_return
+Lnstring_capitalize(int narg, ...)
+{ va_list args; va_start(args, narg);
+  return Lnstring_case(narg, char_capitalize, (cl_object *)args); }
+
+
+@(defun string (x)
+@
+	@(return `coerce_to_string(x)`)
+@)
+
+@(defun si::string_concatenate (&rest args)
+	cl_index l;
+	int i;
+	cl_object v, *strings;
+	char *vself;
+@
+	strings = (cl_object *)args;
+	for (i = 0, l = 0;  i < narg;  i++) {
+		strings[i] = coerce_to_string_designator(va_arg(args, cl_object));
+		l += strings[i]->string.fillp;
+	}
+	v = alloc_simple_string(l);
+	v->string.self = alloc_atomic(l+1);
+	v->string.self[l] = '\0';
+	for (i = 0, vself = v->string.self;  i < narg;  i++, vself += l) {
+		l = strings[i]->string.fillp;
+		memcpy(vself, strings[i]->string.self, l);
+	}
+	@(return v)
+@)
diff --git a/src/c/structure.d b/src/c/structure.d
new file mode 100644
index 000000000..e3025b653
--- /dev/null
+++ b/src/c/structure.d
@@ -0,0 +1,203 @@
+/*
+    structure.c -- Structure interface.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+/******************************* EXPORTS ******************************/
+
+cl_object siSstructure_print_function;
+cl_object siSstructure_slot_descriptions;
+
+/******************************* ------- ******************************/
+
+#ifdef CLOS
+cl_object Sstructure_object;
+
+bool
+structure_subtypep(cl_object x, cl_object y)
+{ cl_object superiors;
+  if (CLASS_NAME(x) == y)
+    return(TRUE);
+  for (superiors=CLASS_SUPERIORS(x); superiors!=Cnil;
+       superiors=CDR(superiors)) {
+    if (structure_subtypep(CAR(superiors), y))
+      return(TRUE);
+  }
+  return(FALSE);
+}
+#else
+cl_object siSstructure_include;
+
+bool
+structure_subtypep(cl_object x, cl_object y)
+{
+	do {
+		if (!SYMBOLP(x))
+			return(FALSE);
+		if (x == y)
+			return(TRUE);
+		x = get(x, siSstructure_include, Cnil);
+	} while (x != Cnil);
+	return(FALSE);
+}
+#endif CLOS
+
+@(defun si::structure_subtype_p (x y)
+@
+	@(return ((type_of(x) == T_STRUCTURE
+		     && structure_subtypep(STYPE(x), y)) ? Ct : Cnil))
+@)
+
+#ifndef CLOS
+/* This is only used for printing. Should not cons!! */ 
+cl_object
+structure_to_list(cl_object x)
+{
+	cl_object *p, r, s;
+	int i, n;
+
+	s = getf(SNAME(x)->symbol.plist,
+	         siSstructure_slot_descriptions, Cnil);
+	p = &CDR(r = CONS(SNAME(x), Cnil));
+	for (i=0, n=SLENGTH(x);  !endp(s) && i<n;  s=CDR(s), i++) {
+		p = &(CDR(*p = CONS(car(CAR(s)), Cnil)));
+		p = &(CDR(*p = CONS(SLOT(x, i), Cnil)));
+	}
+	return(r);
+}
+#else
+cl_object
+structure_to_list(cl_object x)
+{ FEerror("Should never be called!",0);
+}
+#endif CLOS
+
+@(defun si::make_structure (type &rest args)
+	cl_object x;
+	int i;
+@
+	x = alloc_object(T_STRUCTURE);
+	STYPE(x) = type;
+	SLOTS(x) = NULL;	/* for GC sake */
+	SLENGTH(x) = --narg;
+	SLOTS(x) = alloc_align(sizeof(cl_object)*narg, sizeof(cl_object));
+	for (i = 0;  i < narg;  i++)
+		SLOT(x, i) = va_arg(args, cl_object);
+	@(return x)
+@)
+
+@(defun si::copy_structure (x)
+	cl_index j, size;
+	cl_object y;
+@
+	if (!STRUCTUREP(x))
+		FEwrong_type_argument(Sstructure, x);
+	y = alloc_object(T_STRUCTURE);
+	STYPE(y) = STYPE(x);
+	SLENGTH(y) = j = SLENGTH(x);
+	size = sizeof(cl_object)*j;
+	SLOTS(y) = NULL;	/* for GC sake */
+	SLOTS(y) = alloc_align(size, sizeof(cl_object));
+	memcpy(SLOTS(y), SLOTS(x), size);
+	@(return y)
+@)
+
+/* Kept only for compatibility. One should use class-of or type-of. */
+@(defun si::structure_name (s)
+@
+	if (!STRUCTUREP(s))
+		FEwrong_type_argument(Sstructure, s);
+	@(return SNAME(s))
+@)
+
+@(defun si::structure_ref (x type index)
+@
+	if (type_of(x) != T_STRUCTURE ||
+	    !structure_subtypep(STYPE(x), type))
+		FEwrong_type_argument(type, x);
+	@(return SLOT(x, fix(index)))
+@)
+
+cl_object
+structure_ref(cl_object x, cl_object name, int n)
+{
+
+	if (type_of(x) != T_STRUCTURE ||
+	    !structure_subtypep(STYPE(x), name))
+		FEwrong_type_argument(name, x);
+	return(SLOT(x, n));
+}
+
+@(defun si::structure_set (x type index val)
+@
+	if (type_of(x) != T_STRUCTURE ||
+	    !structure_subtypep(STYPE(x), type))
+		FEwrong_type_argument(type, x);
+	SLOT(x, fix(index)) = val;
+	@(return val)
+@)
+
+cl_object
+structure_set(cl_object x, cl_object name, int n, cl_object v)
+{
+
+	if (type_of(x) != T_STRUCTURE ||
+	    !structure_subtypep(STYPE(x), name))
+		FEwrong_type_argument(name, x);
+	SLOT(x, n) = v;
+	return(v);
+}
+
+@(defun si::structurep (s)
+@
+	@(return (STRUCTUREP(s) ? Ct : Cnil))
+@)
+
+@(defun si::rplaca_nthcdr (x idx v)
+/*
+	Used in DEFSETF forms generated by DEFSTRUCT.
+	(si:rplaca-nthcdr x i v) is equivalent to 
+	(progn (rplaca (nthcdr i x) v) v).
+*/
+	cl_fixnum i;
+	cl_object l;
+@
+	assert_type_cons(x);
+	for (i = fixnnint(idx), l = x;  i > 0; --i) {
+		l = CDR(l);
+		if (endp(l)) FEtype_error_index(idx);
+	}
+	CAR(l) = v;
+	@(return v)
+@)
+
+@(defun si::list_nth (idx x)
+/*
+	Used in structure access functions generated by DEFSTRUCT.
+	si:list-nth is similar to nth except that
+	(si:list-nth i x) is error if the length of the list x is less than i.
+*/
+	cl_fixnum i;
+	cl_object l;
+@
+	assert_type_cons(x);
+	for (i = fixnnint(idx), l = x;  i > 0; --i) {
+		l = CDR(l);
+		if (endp(l)) FEtype_error_index(idx);
+	}
+	@(return CAR(l))
+@)
diff --git a/src/c/symbol.d b/src/c/symbol.d
new file mode 100644
index 000000000..b0a0667e0
--- /dev/null
+++ b/src/c/symbol.d
@@ -0,0 +1,533 @@
+/*
+    symbol.d -- Symbols.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+/******************************* EXPORTS ******************************/
+
+#ifndef THREADS
+cl_object gensym_prefix;
+cl_object gentemp_prefix;
+cl_object cl_token;
+#endif THREADS
+
+struct symbol Cnil_body, Ct_body;
+cl_object Vgensym_counter;
+
+/******************************* ------- ******************************/
+
+cl_object siSpname;
+
+static cl_index gentemp_counter;
+
+@(defun make_symbol (str)
+@
+	assert_type_string(str);
+	@(return make_symbol(str))
+@)
+
+cl_object
+make_symbol(cl_object st)
+{
+	cl_object x;
+
+	x = alloc_object(t_symbol);
+	SYM_VAL(x) = OBJNULL;
+	/* FIXME! Should we copy? */
+	x->symbol.name = st;
+	SYM_FUN(x) = OBJNULL;
+	x->symbol.plist = Cnil;
+	x->symbol.hpack = Cnil;
+	x->symbol.stype = stp_ordinary;
+	x->symbol.mflag = FALSE;
+	x->symbol.isform = FALSE;
+	return(x);
+}
+
+/*
+	Make_ordinary(s) makes an ordinary symbol from C string s
+	and interns it in lisp package as an external symbol.
+*/
+cl_object
+make_ordinary(const char *s)
+{
+	cl_object x = _intern(s, lisp_package);
+	export(x, lisp_package);
+	return(x);
+}
+
+/*
+	Make_special(s, v) makes a special variable from C string s
+	with initial value v in lisp package.
+*/
+cl_object
+make_special(const char *s, cl_object v)
+{
+	cl_object x = make_ordinary(s);
+	x->symbol.stype = (short)stp_special;
+	SYM_VAL(x) = v;
+	return(x);
+}
+
+/*
+	Make_constant(s, v) makes a constant from C string s
+	with constant value v in lisp package.
+*/
+cl_object
+make_constant(const char *s, cl_object v)
+{
+	cl_object x = make_ordinary(s);
+	x->symbol.stype = (short)stp_constant;
+	SYM_VAL(x) = v;
+	return(x);
+}
+
+/*
+	Make_si_ordinary(s) makes an ordinary symbol from C string s
+	and interns it in system package as an external symbol.
+*/
+cl_object
+make_si_ordinary(const char *s)
+{
+	cl_object x = _intern(s, system_package);
+	export(x, system_package);
+	return(x);
+}
+
+/*
+	Make_si_special(s, v) makes a special variable from C string s
+	with initial value v in system package.
+*/
+cl_object
+make_si_special(const char *s, cl_object v)
+{
+	cl_object x = make_si_ordinary(s);
+	x->symbol.stype = (short)stp_special;
+	SYM_VAL(x) = v;
+	return(x);
+}
+
+/*
+	Make_si_constant(s, v) makes a constant from C string s
+	with constant value v in system package.
+*/
+cl_object
+make_si_constant(const char *s, cl_object v)
+{
+	cl_object x = make_si_ordinary(s);
+	x->symbol.stype = (short)stp_constant;
+	SYM_VAL(x) = v;
+	return(x);
+}
+
+/*
+	Make_keyword(s) makes a keyword from C string s.
+*/
+cl_object
+make_keyword(const char *s)
+{
+	cl_object x = _intern(s, keyword_package);
+	/* export(x, keyword_package); this is implicit in intern() */
+	return x;
+}
+
+cl_object
+symbol_value(cl_object s)
+{
+	/* FIXME: Should we check symbol type? */
+	if (SYM_VAL(s) == OBJNULL)
+		FEunbound_variable(s);
+	return(SYM_VAL(s));
+}
+
+cl_object
+getf(cl_object place, cl_object indicator, cl_object deflt)
+{
+	cl_object slow, l;
+
+	/* This loop guarantees finishing for circular lists */
+	slow = l = place;
+	while (CONSP(l)) {
+		cl_object cdr_l = CDR(l);
+		if (!CONSP(cdr_l))
+			FEtype_error_plist(place);
+		if (CAR(l) == indicator)
+			return CAR(cdr_l);
+		l = CDR(cdr_l);
+		slow = CDR(slow);
+		if (l == slow)
+			FEcircular_list(place);
+	}
+	if (l != Cnil)
+		FEtype_error_plist(place);
+	return(deflt);
+}
+
+cl_object
+get(cl_object s, cl_object p, cl_object d)
+{
+	if (!SYMBOLP(s))
+		FEtype_error_symbol(s);
+	return(getf(s->symbol.plist, p, d));
+}
+
+/*
+	Putf(p, v, i) puts value v for property i to property list p
+	and returns the resulting property list.
+*/
+cl_object
+putf(cl_object place, cl_object value, cl_object indicator)
+{
+	cl_object slow, l;
+
+	/* This loop guarantees finishing for circular lists */
+	slow = l = place;
+	while (CONSP(l)) {
+		cl_object cdr_l = CDR(l);
+		if (!CONSP(cdr_l))
+			FEtype_error_plist(place);
+		if (CAR(l) == indicator) {
+			CAR(cdr_l) = value;
+			return place;
+		}
+		l = CDR(cdr_l);
+		slow = CDR(slow);
+		if (l == slow)
+			FEcircular_list(place);
+	}
+	if (l != Cnil)
+		FEtype_error_plist(place);
+	place = CONS(value, place);
+	return CONS(indicator, place);
+}
+
+cl_object
+putprop(cl_object s, cl_object v, cl_object p)
+{
+	if (!SYMBOLP(s))
+		FEtype_error_symbol(s);
+	s->symbol.plist = putf(s->symbol.plist, v, p);
+	return(v);
+}
+
+/*
+	Remf(p, i) removes property i
+	from the property list pointed by p,
+	which is a pointer to an cl_object.
+	The returned value of remf(p, i) is:
+
+		TRUE    if the property existed
+		FALSE   otherwise.
+*/
+bool
+remf(cl_object *place, cl_object indicator)
+{
+	cl_object *slow, *l;
+
+	/* This loop guarantees finishing for circular lists */
+	slow = l = place;
+	while (CONSP(*l)) {
+		cl_object cdr_l = CDR(*l);
+		if (!CONSP(cdr_l))
+			FEtype_error_plist(*place);
+		if (CAR(*l) == indicator) {
+			*l = CDR(cdr_l);
+			return TRUE;
+		}
+		l = &CDR(cdr_l);
+		slow = &CDR(*slow);
+		if (l == slow)
+			FEcircular_list(*place);
+	}
+	if (*l != Cnil)
+		FEtype_error_plist(*place);
+	return(FALSE);
+}
+
+cl_object
+remprop(cl_object s, cl_object p)
+{
+	if (!SYMBOLP(s))
+		FEtype_error_symbol(s);
+	if (remf(&s->symbol.plist, p))
+		return(Ct);
+	else
+		return(Cnil);
+}
+
+bool
+keywordp(cl_object s)
+{
+	return (SYMBOLP(s) && s->symbol.hpack == keyword_package);
+}
+
+@(defun get (sym indicator &optional deflt)
+@
+	assert_type_symbol(sym);
+	@(return getf(sym->symbol.plist, indicator, deflt))
+@)
+
+@(defun remprop (sym prop)
+@
+	assert_type_symbol(sym);
+	@(return (remf(&sym->symbol.plist, prop)? Ct: Cnil))
+@)
+
+@(defun symbol_plist (sym)
+@
+	assert_type_symbol(sym);
+	@(return sym->symbol.plist)
+@)
+
+@(defun getf (place indicator &optional deflt)
+@
+	@(return getf(place, indicator, deflt))
+@)
+
+@(defun get_properties (place indicator_list)
+	cl_object slow, cdr_l, l;
+@
+	/* This loop guarantees finishing for circular lists */
+	for (slow = l = place;  CONSP(l); ) {
+		cdr_l = CDR(l);
+		if (!CONSP(cdr_l))
+			FEtype_error_plist(place);
+		if (member_eq(CAR(l), indicator_list))
+			@(return CAR(l) CADR(l) l)
+		l = CDR(cdr_l);
+		slow = CDR(slow);
+		if (l == slow)
+			FEcircular_list(place);
+	}
+	if (l != Cnil)
+		FEtype_error_plist(place);
+	@(return Cnil Cnil Cnil)
+@)
+
+cl_object
+symbol_name(cl_object x)
+{
+	assert_type_symbol(x);
+	return x->symbol.name;
+}
+
+@(defun symbol_name (sym)
+@
+	@(return symbol_name(sym))
+@)
+
+@(defun copy_symbol (sym &optional cp &aux x)
+@
+	assert_type_symbol(sym);
+	x = make_symbol(sym);
+	if (Null(cp))
+		@(return x)
+	x->symbol.stype = sym->symbol.stype;
+	SYM_VAL(x) = SYM_VAL(sym);
+	x->symbol.mflag = sym->symbol.mflag;
+	SYM_FUN(x) = SYM_FUN(sym);
+	x->symbol.plist = copy_list(sym->symbol.plist);
+	@(return x)
+@)
+
+@(defun gensym (&optional (x gensym_prefix) &aux str)
+	cl_index name_length, j, counter_value;
+	volatile cl_object counter;
+@
+	if (type_of(x) == t_string) {
+		gensym_prefix = x;
+		counter = SYM_VAL(Vgensym_counter);
+	} else
+		counter = x;
+	if (!FIXNUMP(counter) || FIXNUM_MINUSP(counter)) {
+		FEerror("*gensym-counter*, ~A, not a positive fixnum",
+			1, counter);
+	}
+	counter_value = fix(counter);
+	name_length = gensym_prefix->string.fillp;
+	for (j = counter_value;  j > 0;  j /= 10)
+		name_length++;
+	if (name_length == 0)
+		name_length++;
+	str = alloc_simple_string(name_length);
+	str->string.self = alloc_atomic(name_length+1);
+	str->string.self[name_length] = '\0';
+	for (j = 0;  j < gensym_prefix->string.fillp;  j++)
+		str->string.self[j] = gensym_prefix->string.self[j];
+	if (counter_value == 0)
+		str->string.self[--name_length] = '0';
+	else
+		for (j=counter_value;  j > 0;  j /= 10)
+			str->string.self[--name_length] = j%10 + '0';
+	SYM_VAL(Vgensym_counter) = MAKE_FIXNUM(counter_value+1);
+	@(return make_symbol(str))
+@)
+
+@(defun gentemp (&optional (prefix gentemp_prefix)
+			   (pack `current_package()`)
+		 &aux str smbl)
+	size_t name_length, j;
+@
+	assert_type_string(prefix);
+	assert_type_package(pack);
+ONCE_MORE:
+	name_length = prefix->string.fillp;
+	for (j = gentemp_counter;  j > 0;  j /= 10)
+		name_length++;
+	if (name_length == 0)
+		name_length++;
+	str = alloc_simple_string(name_length);
+        str->string.self = alloc_atomic(name_length+1);
+	str->string.self[name_length] = '\0';
+        for (j = 0;  j < prefix->string.fillp;  j++)
+                str->string.self[j] = prefix->string.self[j];
+	if ((j = gentemp_counter) == 0)
+		str->string.self[--name_length] = '0';
+	else
+		for (;  j > 0;  j /= 10)
+			str->string.self[--name_length] = j%10 + '0';
+	gentemp_counter++;
+	smbl = intern(str, pack);
+	if (intern_flag != 0)
+		goto ONCE_MORE;
+	@(return smbl)
+@)
+
+@(defun symbol_package (sym)
+@
+	assert_type_symbol(sym);
+	@(return sym->symbol.hpack)
+@)
+
+@(defun keywordp (sym)
+@
+	@(return ((SYMBOLP(sym) && keywordp(sym))? Ct: Cnil))
+@)
+
+/*
+	(SI:PUT-F plist value indicator)
+	returns the new property list with value for property indicator.
+	It will be used in SETF for GETF.
+*/
+@(defun si::put_f (plist value indicator)
+@
+	@(return putf(plist, value, indicator))
+@)
+
+/*
+	(SI:REM-F plist indicator) returns two values:
+
+		* the new property list
+		  in which property indcator is removed
+
+		* T     if really removed
+		  NIL   otherwise.
+
+	It will be used for macro REMF.
+*/
+@(defun si::rem_f (plist indicator)
+	bool found;
+@
+	found = remf(&plist, indicator);
+	@(return plist (found? Ct : Cnil))
+@)
+
+@(defun si::set_symbol_plist (sym plist)
+@
+	assert_type_symbol(sym);
+	sym->symbol.plist = plist;
+	@(return plist)
+@)
+
+@(defun si::putprop (sym value indicator)
+@
+	assert_type_symbol(sym);
+	sym->symbol.plist = putf(sym->symbol.plist, value, indicator);
+	@(return value)
+@)
+
+/* Added for defstruct. Beppe */
+@(defun si::put_properties (sym &rest ind_values)
+	cl_object prop;
+@
+	while (--narg >= 2) {
+	  prop = va_arg(ind_values, cl_object);
+	  putprop(sym, va_arg(ind_values, cl_object), prop);
+	  narg--;
+	}
+	@(return sym)
+@)
+
+@(defun si::Amake_special (sym)
+@
+	assert_type_symbol(sym);
+	if ((enum stype)sym->symbol.stype == stp_constant)
+		FEerror("~S is a constant.", 1, sym);
+	sym->symbol.stype = (short)stp_special;
+	remf(&sym->symbol.plist, siSsymbol_macro);
+	@(return sym)
+@)
+
+@(defun si::Amake_constant (sym val)
+@
+	assert_type_symbol(sym);
+	if ((enum stype)sym->symbol.stype == stp_special)
+		FEerror(
+		 "The argument ~S to DEFCONSTANT is a special variable.",
+		 1, sym);
+	sym->symbol.stype = (short)stp_constant;
+	SYM_VAL(sym) = val;
+	@(return sym)
+@)
+
+void
+init_symbol(void)
+{
+	Cnil_body.t = (short)t_symbol;
+	Cnil_body.dbind = Cnil;
+	Cnil_body.name = make_simple_string("NIL");
+	Cnil_body.gfdef = OBJNULL;
+	Cnil_body.plist = Cnil;
+	Cnil_body.hpack = Cnil;
+	Cnil_body.stype = (short)stp_constant;
+	Cnil_body.mflag = FALSE;
+	Cnil_body.isform = FALSE;
+
+	Ct_body.t = (short)t_symbol;
+	Ct_body.dbind = Ct;
+	Ct_body.name = make_simple_string("T");
+	Ct_body.gfdef = OBJNULL;
+	Ct_body.plist = Cnil;
+	Ct_body.hpack = Cnil;
+	Ct_body.stype = (short)stp_constant;
+	Ct_body.mflag = FALSE;
+	Ct_body.isform = FALSE;
+
+	gensym_prefix = make_simple_string("G");
+	gentemp_prefix = make_simple_string("T");
+	gentemp_counter = 0;
+	cl_token = alloc_simple_string(LISP_PAGESIZE);
+	cl_token->string.fillp = 0;
+	cl_token->string.self = alloc_atomic(LISP_PAGESIZE);
+	cl_token->string.hasfillp = TRUE;
+	cl_token->string.adjustable = TRUE;
+
+	register_root(&gensym_prefix);
+	register_root(&gentemp_prefix);
+	register_root(&cl_token);
+}
+
diff --git a/src/c/tclBasic.d b/src/c/tclBasic.d
new file mode 100644
index 000000000..8eb0cbb0f
--- /dev/null
+++ b/src/c/tclBasic.d
@@ -0,0 +1,786 @@
+/*
+ *
+ * tclBasic. c  		- A library replacement for simulating 
+ *				  a Tcl interpreter in ECoLisp
+ *
+ * Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+ * 
+ *
+ * Permission to use, copy, and/or distribute this software and its
+ * documentation for any purpose and without fee is hereby granted, provided
+ * that both the above copyright notice and this permission notice appear in
+ * all copies and derived works.  Fees for distribution or use of this
+ * software or derived works may only be charged with express written
+ * permission of the copyright holder.  
+ * This software is provided ``as is'' without express or implied warranty.
+ *
+ * This software is a derivative work of other copyrighted softwares; the
+ * copyright notices of these softwares are placed in the file COPYRIGHTS
+ *
+ *
+ *            Author: Erick Gallesio [eg@unice.fr]
+ *    Creation date: 19-Feb-1993 22:15
+ * Last file update: 11-Feb-1995 15:07
+ *
+ * Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+ *
+ */
+
+#include "ecls.h"
+#include "tk.h"
+#include "tclInt.h"
+
+cl_object TkWidgetType;
+Tcl_Interp *ECL_interp;
+
+extern cl_object tk_package;
+
+static Tcl_HashTable VarTable;	/* Global hash table retaining traced variables */
+
+#define STRING_INPUT_STREAM(s, strm) \
+  struct stream strm; \
+  struct string string; \
+  string.t = (short)t_string; \
+  string.m = FALSE; \
+  string.st_hasfillp = FALSE; \
+  string.st_adjustable = FALSE; \
+  string.st_displaced = Cnil; \
+  string.st_dim = (string.st_fillp = strlen(s)) + 1; \
+  string.st_self = s; \
+  strm.t = (short)t_stream; \
+  strm.m = FALSE; \
+  strm.sm_mode = (short)smm_string_input; \
+  strm.sm_fp = NULL; \
+  strm.sm_object0 = (cl_object)&string; \
+  strm.sm_object1 = OBJNULL; \
+  strm.sm_int0 = 0; \
+  strm.sm_int1 = string.st_fillp
+
+static cl_object
+eval_from_string(char *s)
+{
+  cl_object x;
+  STRING_INPUT_STREAM(s, strm);
+  x = Lread(3, (cl_object)&strm, Cnil, OBJNULL);
+  return (x != OBJNULL) ? eval(x, NULL) : Cnil;
+}
+
+static cl_object string_stream;
+static char char_string[2] = { 0, 0};
+static char *empty = "()";
+
+static char *
+object2string(cl_object x)
+{
+  extern VOID *malloc();
+  switch (type_of(x)) {
+  case t_string:
+  case t_symbol:
+    if (x == Cnil)
+      return(empty);
+    else
+      return(x->string.self);
+  case t_fixnum: {
+    char *num = malloc(12);
+    sprintf(num, "%d", fix(x));
+    return(num);
+  }
+  case t_character: {
+    char_string[0] = char_code(x);
+    return char_string;
+  }
+  case t_cons: {
+    extern cl_object siVprint_package;
+    string_stream->stream.object0->string.fillp = 0;
+    string_stream->stream.int0 = string_stream->stream.int1 = 0;
+    bds_bind(siVprint_package, Ct);
+    prin1(x, string_stream);
+    bds_unwind1;
+    return(string_stream->stream.object0->string.self);
+  }
+  case t_pathname:
+    return namestring(x)->string.self;
+  case t_shortfloat: {
+    char *num = malloc(12);
+    sprintf(num, "%f", sf(x));
+    return(num);
+  }
+  case t_longfloat: {
+    char *num = malloc(12);
+    sprintf(num, "%f", lf(x));
+    return(num);
+  }
+  case t_ratio: {
+    char *num = malloc(12);
+    if (FIXNUMP(x->ratio.num) && FIXNUMP(x->ratio.den)) {
+      sprintf(num, "%d", fix(x->ratio.num) / fix(x->ratio.den));
+      return(num);
+    }
+    break;
+  }
+  }
+  FEerror("~S cannot be coerced to a C string.", 1, x);
+}
+
+/*****************************************************************************
+ *
+ *				Eval functions
+ *
+ *****************************************************************************/
+
+int
+Tcl_GlobalEval(Tcl_Interp *interp, char *s)
+{
+  cl_object result;
+
+  if (*s == '\0') return TCL_OK;
+
+  /* In some situations Tk appends some data (numbers) to the callback. This
+   * arise for scrollbars and scales. These parameters are normally used to
+   * reflect slider position. When such a situation arises, we have to 
+   * specify the callback as a string and add a pair of parenthesis around
+   * this string to form a valid sexpr. To recognize such cases, we look
+   * at first character: if it is not an open parenthesis, we add a pair of ()
+   * around the callback string 
+   * 
+   */
+
+  if (*s != '(') {
+    /* Build the command to evaluate by adding a pair of parenthesis */
+    char buffer[strlen(s)+3];	/* __GNUC__ */
+    sprintf(buffer, "(%s)", s);
+    result = eval_from_string(buffer);
+  }
+  else result = eval_from_string(s);
+  /* we might use TCL_DYNAMIC if object_to_string used malloc */
+  Tcl_SetResult(interp, object2string(result), TCL_STATIC);
+  return TCL_OK;
+}
+
+/* very simplistic. But do we need something more clever? */
+int
+Tcl_Eval(Tcl_Interp *interp, char *s)
+{
+  return Tcl_GlobalEval(interp, s);
+}
+
+int
+Tcl_VarEval(Tcl_Interp *interp, /* Interpreter in which to execute command */
+	    ...)		/* One or more strings to concatenate,
+				   terminated with a NULL string. */
+{
+    va_list argList;
+#define FIXED_SIZE 200
+    char fixedSpace[FIXED_SIZE+1];
+    int spaceAvl, spaceUsed, length;
+    char *string, *cmd;
+    int result;
+
+    /*
+     * Copy the strings one after the other into a single larger
+     * string.  Use stack-allocated space for small commands, but if
+     * the commands gets too large than call ckalloc to create the
+     * space.
+     */
+
+    va_start(argList, interp);
+    spaceAvl = FIXED_SIZE;
+    spaceUsed = 0;
+    cmd = fixedSpace;
+    while (TRUE) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	length = strlen(string);
+	if ((spaceUsed + length) > spaceAvl) {
+	    char *new;
+
+	    spaceAvl = spaceUsed + length;
+	    spaceAvl += spaceAvl/2;
+	    new = ckalloc((unsigned) spaceAvl);
+	    memcpy((VOID *) new, (VOID *) cmd, spaceUsed);
+	    if (cmd != fixedSpace) {
+		ckfree(cmd);
+	    }
+	    cmd = new;
+	}
+	strcpy(cmd + spaceUsed, string);
+	spaceUsed += length;
+    }
+    va_end(argList);
+    cmd[spaceUsed] = '\0';
+
+    result = Tcl_GlobalEval(interp, cmd);
+    if (cmd != fixedSpace) {
+	ckfree(cmd);
+    }
+    return result;
+}
+
+
+static void
+upcase(char *s, char *d)
+{ 
+  for ( ; *s != '\0'; s++)
+    *d++ = toupper(*s);
+  *d = '\0';
+}
+
+/*****************************************************************************
+ *
+ *	      Variable accesses (GetVar, GetVar2, SetVar, SetVar2)
+ *
+ *****************************************************************************/
+
+char *
+Tcl_GetVar(Tcl_Interp *interp, char *var, int flags)
+{
+  cl_object V;
+  char VAR[strlen(var)+1];	/* __GNUC__ */
+  upcase(var, VAR);
+  V = SYM_VAL(_intern(VAR, tk_package));
+  return (V == OBJNULL) ? NULL : object2string(V);
+}
+
+char *
+Tcl_GetVar2(Tcl_Interp *interp, char *name1, char *name2, int flags)
+{
+  if (name2 && *name2) {
+    char *res;
+    char s[strlen(name1) + strlen(name2) + 8]; /* __GNUC__ */
+
+    sprintf(s, "(AREF %s %s)", name1, name2);
+    Tcl_GlobalEval(interp, s);
+    return interp->result;
+  }
+  return Tcl_GetVar(interp, name1, flags);
+}
+
+char *
+Tcl_SetVar(Tcl_Interp *interp, char *var, char *val, int flags)
+{
+  char VAR[strlen(var)+1];	/* __GNUC__ */
+  upcase(var, VAR);
+  /* Eval the following expression: (setq var val) */
+  SYM_VAL(_intern(VAR, tk_package)) = make_simple_string(val);
+/*  Tcl_ChangeValue(var);  in tcl-trace.c */
+  return val;
+}
+
+char *
+Tcl_SetVar2(Tcl_Interp *interp, char *name1, char *name2, char *val,
+		  int flags)
+{ 
+  if (name2 && *name2) {
+    char *res;
+    char s[strlen(name1) + strlen(name2) + 16]; /* __GNUC__ */
+
+    sprintf(s, "(SETF (AREF %s %s) %s)", name1, name2);
+    Tcl_GlobalEval(interp, s);
+    return interp->result;
+  }
+  return Tcl_SetVar(interp, name1, val, flags);
+}
+
+/*****************************************************************************
+ *
+ *			    Tcl command management
+ *
+ *****************************************************************************/
+
+int
+Tcl_DeleteCommand(Tcl_Interp *interp, char *cmdName)
+{
+  cl_object V   = _intern(cmdName, tk_package);
+
+  if (SYM_FUN(V) == OBJNULL) return -1;
+  SYM_FUN(V) = OBJNULL;		/* Undefine "cmdName" */
+  SYM_VAL(V) = OBJNULL;		/* Undefine "cmdName" */
+  return 0;
+}
+
+/* ECL should use lowercase symbols as default!!!
+   In such case we could read with:
+
+    STRING_INPUT_STREAM(s, strm);
+    Lread(3, (cl_object)&strm, Cnil, OBJNULL);
+    result = VALUES(0);
+    Lread(3, (cl_object)&strm, Cnil, OBJNULL);
+    if (VALUES(0) != OBJNULL) {
+      result = CONS(result, Cnil);
+      for (p = &CDR(result) ; ; p = &(CDR(*p))) {
+	*p = CONS(VALUES(0), Cnil);
+	Lread(3, (cl_object)&strm, Cnil, OBJNULL);
+	if (VALUES(0) == OBJNULL) break;
+      }
+    }
+ */
+static cl_object
+parse_from_string(struct string *s, char **ep)
+{
+  if (isdigit(s->st_self[0])) {
+    int n;
+    cl_object num = parse_number(s->st_self, s->st_fillp, &n, 10);
+    *ep = s->st_self + n;
+    return num;
+  }
+  else {
+    *ep = s->st_self + s->st_fillp;
+    (cl_object)s = copy_simple_string(s);
+    s->st_self[s->st_fillp] = '\0';
+    return (cl_object)s;
+  }
+}
+
+/* We must return strings since commands like 'text index 1.0+1c' return
+   indexes (e.g. 1.1) which should not be converted to numbers*/
+static cl_object
+TkResult2Lisp(Tcl_Interp *interp)
+{
+  register char *s = interp->result;
+  register cl_object result = Cnil, *p;
+  extern cl_object Tk_root_window;
+ 
+  if (strcmp(s, ".") == 0) return Tk_root_window;
+  if (*s) {
+    int i;
+    char *e;
+    struct stream strm;
+    struct string string;
+    string.t = (short)t_string;
+    string.m = FALSE;
+    string.st_hasfillp = FALSE;
+    string.st_adjustable = FALSE;
+    string.st_displaced = Cnil;
+    string.st_self = s;
+ 
+    e = strchr(s, ' ');
+    if (e == NULL) {
+      string.st_dim = (string.st_fillp = strlen(s))+1;
+      result = copy_simple_string(&string);
+    } else {
+      /*  Result was a list of values, build a proper list */
+      string.st_dim = (string.st_fillp = e-s)+1;
+      *e = '\0';
+      result = CONS(copy_simple_string(&string), Cnil);
+      for (p = &CDR(result) ; ; p = &(CDR(*p))) {
+        s = e+1;
+        string.st_self = s;
+        e = strchr(s, ' ');
+        if (e == NULL) {
+          string.st_dim = (string.st_fillp = strlen(s))+1;
+          *p = CONS(copy_simple_string(&string), Cnil);
+          break;
+        }
+        string.st_dim = (string.st_fillp = e-s)+1;
+        *e = '\0';
+        *p = CONS(copy_simple_string(&string), Cnil);
+      }
+    }
+  }
+  Tcl_ResetResult(interp); 
+  return result;
+}
+
+#ifdef NEW
+static cl_object
+TkResult2Lisp(Tcl_Interp *interp)
+{
+  register char *s = interp->result;
+  register cl_object result = Cnil, *p;
+  extern cl_object Tk_root_window;
+
+  if (strcmp(s, ".") == 0) return Tk_root_window;
+  if (*s) {
+    int i;
+    char *e;
+    struct stream strm;
+    struct string string;
+    string.t = (short)t_string;
+    string.m = FALSE;
+    string.st_hasfillp = FALSE;
+    string.st_adjustable = FALSE;
+    string.st_displaced = Cnil;
+    string.st_self = s;
+
+    e = strchr(s, ' ');
+    if (e == NULL) {
+      string.st_dim = (string.st_fillp = strlen(s))+1;
+      result = parse_from_string(&string, &e);
+    } else {
+      /*  Result was a list of values, build a proper list */
+      string.st_dim = (string.st_fillp = e-s)+1;
+      result = CONS(parse_from_string(&string, &e), Cnil);
+      for (p = &CDR(result) ; ; p = &(CDR(*p))) {
+	s = e+1;
+	string.st_self = s;
+	e = strchr(s, ' ');
+	if (e == NULL) {
+	  string.st_dim = (string.st_fillp = strlen(s))+1;
+	  *p = CONS(parse_from_string(&string, &e), Cnil);
+	  break;
+	}
+	string.st_dim = (string.st_fillp = e-s)+1;
+	*p = CONS(parse_from_string(&string, &e), Cnil);
+      }
+    }
+  }
+  Tcl_ResetResult(interp); 
+  return result;
+}
+#endif
+
+tclMethodDispatch(int narg, cl_object env, ...)
+{
+  va_list args;
+  cl_object W = CAR(env);
+  char *argv[narg];
+  int i;
+  Tcl_CmdProc *proc = (Tcl_CmdProc *)fix(SLOT(W, 0));
+  ClientData clientData = (ClientData)fix(SLOT(W, 1));
+  argv[0] = SLOT(W, 2)->symbol.name->string.self; /* command name */
+  va_start(args, env);
+  for (i = 1; i < narg; i++)
+    argv[i] = object2string(va_arg(args, cl_object));
+  /* if previous result was a symbol, proc could not write to interp->result
+   * so we must clear it
+   */
+  Tcl_ResetResult(ECL_interp);
+  if ((*proc)(clientData, ECL_interp, narg, argv) == TCL_ERROR)
+    VALUES(0) = (cl_object)FEerror(ECL_interp->result, 0);
+  else
+    VALUES(0) = TkResult2Lisp(ECL_interp);
+  return(1);
+}
+
+void
+Tcl_CreateCommand(Tcl_Interp *interp, char *cmdName, Tcl_CmdProc *proc,
+		  ClientData clientData,
+		  Tcl_CmdDeleteProc *deleteProc)
+{
+  cl_object SYM, sym, W;
+  char CMDNAME[strlen(cmdName)+1]; /* __GNUC__ */
+
+  sym = _intern(cmdName, tk_package);
+  /* Define a variable whose name is the command name */
+  upcase(cmdName, CMDNAME);
+  SYM = _intern(CMDNAME, tk_package);
+  SYM_VAL(SYM) = sym;		/* evaluating to lower case symbol */
+  siLmake_structure(4, TkWidgetType, MAKE_FIXNUM(proc),
+		    MAKE_FIXNUM(clientData), sym);
+  W = VALUES(0);
+
+  /* Define a function whose name is the command name */
+  SYM_FUN(sym) = (cl_object)make_cclosure(tclMethodDispatch, CONS(W, Cnil), NULL);
+  SYM_FUN(SYM) = SYM_FUN(sym);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandInfo --
+ *
+ *	Returns various information about a Tcl command.
+ *
+ * Results:
+ *	If cmdName exists in interp, then *infoPtr is modified to
+ *	hold information about cmdName and 1 is returned.  If the
+ *	command doesn't exist then 0 is returned and *infoPtr isn't
+ *	modified.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetCommandInfo(Tcl_Interp *interp, /* Interpreter in which to look
+					* for command. */
+		   char *cmdName, /* Name of desired command. */
+		   Tcl_CmdInfo *infoPtr) /* Where to store information about
+					  * command. */
+{
+    cl_object v = _intern(cmdName, tk_package);
+    
+    if (!structure_subtypep(TYPE_OF(SYM_VAL(v)), TkWidgetType)) return 0;
+
+    infoPtr->proc       = (Tcl_CmdProc *)fix(SLOT(SYM_VAL(v), 0));
+    infoPtr->clientData = (ClientData)fix(SLOT(SYM_VAL(v), 1));
+    infoPtr->deleteProc = NULL;
+    infoPtr->deleteData = NULL;
+    return 1;
+}
+
+
+/*****************************************************************************
+ *
+ *			  Tcl interpreter management
+ *
+ *****************************************************************************/
+
+Tcl_Interp *
+Tcl_CreateInterp()
+{
+  register Interp *iPtr = (Interp *) ckalloc(sizeof(Interp));
+  
+  iPtr->result		 = iPtr->resultSpace;
+  iPtr->freeProc	 = 0;
+  iPtr->errorLine	 = 0;
+  iPtr->resultSpace[0]   = 0;
+  
+  iPtr->appendResult	 = NULL;
+  iPtr->appendAvl	 = 0;
+  iPtr->appendUsed	 = 0;
+
+  strcpy(iPtr->pdFormat, "%g");
+
+  return (Tcl_Interp *) iPtr;
+}
+
+void
+Tcl_DeleteInterp(Tcl_Interp *interp)
+{
+  Interp *iPtr = (Interp *) interp;
+  
+  if (iPtr->appendResult != NULL) {
+    ckfree(iPtr->appendResult);
+  }
+  ckfree((char *) iPtr);
+}
+
+init_tk()
+{
+#ifdef CLOS
+  TkWidgetType = define a class with name: _intern("WIDGET", tk_package);
+#else
+  TkWidgetType = _intern("WIDGET", tk_package);
+#endif
+  string_stream = make_string_output_stream(64);
+  register_root(&string_stream);
+  Tcl_InitHashTable(&VarTable, TCL_STRING_KEYS);
+}
+
+/*
+ * Dummies
+ */
+int
+Tcl_Init(Tcl_Interp *interp)
+{}
+
+void
+Tcl_CallWhenDeleted(
+    Tcl_Interp *interp,		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc,	/* Procedure to call when interpreter
+				 * is about to be deleted. */
+    ClientData clientData)	/* One-word value to pass to proc. */
+{}
+
+void
+Tcl_DontCallWhenDeleted(interp, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc;	/* Procedure to call when interpreter
+				 * is about to be deleted. */
+    ClientData clientData;	/* One-word value to pass to proc. */
+{}
+
+int
+Tcl_SetCommandInfo(interp, cmdName, infoPtr)
+    Tcl_Interp *interp;			/* Interpreter in which to look
+					 * for command. */
+    char *cmdName;			/* Name of desired command. */
+    Tcl_CmdInfo *infoPtr;		/* Where to store information about
+					 * command. */
+{}
+
+Tcl_Trace
+Tcl_CreateTrace(interp, level, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which to create the trace. */
+    int level;			/* Only call proc for commands at nesting level
+				 * <= level (1 => top level). */
+    Tcl_CmdTraceProc *proc;	/* Procedure to call before executing each
+				 * command. */
+    ClientData clientData;	/* Arbitrary one-word value to pass to proc. */
+{}
+
+void
+Tcl_DeleteTrace(interp, trace)
+    Tcl_Interp *interp;		/* Interpreter that contains trace. */
+    Tcl_Trace trace;		/* Token for trace (returned previously by
+				 * Tcl_CreateTrace). */
+{}
+
+void
+Tcl_AddErrorInfo(interp, message)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    char *message;		/* Message to record. */
+{}
+
+int
+Tcl_SetRecursionLimit(interp, depth)
+    Tcl_Interp *interp;			/* Interpreter whose nesting limit
+					 * is to be set. */
+    int depth;				/* New value for maximimum depth. */
+{}
+
+/*----------------------------------------------------------------------
+ * from tclVar.c
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceVar(interp, varName, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which variable is
+				 * to be traced. */
+    char *varName;		/* Name of variable;  may end with "(index)"
+				 * to signify an array reference. */
+    int flags;			/* OR-ed collection of bits, including any
+				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
+    Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are
+				 * invoked upon varName. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+  Tcl_HashEntry *entry;
+  int new;
+  struct VarTrace *data;
+  
+  entry = Tcl_CreateHashEntry(&VarTable, varName, &new);
+  
+  /* Create the value associated to the "var" key */
+  data= (struct VarTrace *) ckalloc((unsigned) sizeof (struct VarTrace));
+  data->flags	   = flags & ~TCL_TRACE_UNSETS; /* Unset has no meaning in ECL */
+  data->traceProc  = proc;
+  data->clientData = clientData;
+  data->nextPtr	   = (VarTrace *) (new ? NULL : Tcl_GetHashValue(entry));
+
+  /* Put it in table */
+  Tcl_SetHashValue(entry, (ClientData) data);
+  
+  return TCL_OK;
+}
+
+
+int
+Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which variable is
+				 * to be traced. */
+    char *part1;		/* Name of scalar variable or array. */
+    char *part2;		/* Name of element within array;  NULL means
+				 * trace applies to scalar variable or array
+				 * as-a-whole. */
+    int flags;			/* OR-ed collection of bits, including any
+				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
+    Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are
+				 * invoked upon varName. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+  if (*part2) {
+    
+  }
+  return Tcl_TraceVar(interp, part1, flags, proc, clientData);
+}
+
+void
+Tcl_UntraceVar(interp, varName, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter containing traced variable. */
+    char *varName;		/* Name of variable;  may end with "(index)"
+				 * to signify an array reference. */
+    int flags;			/* OR-ed collection of bits describing
+				 * current trace, including any of
+				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
+    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+  Tcl_HashEntry *entry;
+  register VarTrace *p, *prev;
+  
+  if (entry = Tcl_FindHashEntry(&VarTable, varName)) {
+    /* Variable is traced. Try to find correponding trace function */
+    flags &= ~TCL_TRACE_UNSETS; /* Unset has no meaning for us */
+
+    p = (struct VarTrace *) Tcl_GetHashValue(entry);    
+    for (prev=NULL; p ; prev=p, p=p->nextPtr) {
+      if (p->traceProc == proc && p->flags == flags && p->clientData == clientData)
+	break;
+    }
+    if (p) {
+      if (prev == NULL) {
+	if (p->nextPtr)
+	  Tcl_SetHashValue(entry, (ClientData *) p->nextPtr);
+	else 
+	  Tcl_DeleteHashEntry(entry);
+      }
+      else
+	prev->nextPtr = p->nextPtr;
+      ckfree(p);
+    }
+  }
+}
+
+void
+Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter containing traced variable. */
+    char *part1;		/* Name of variable or array. */
+    char *part2;		/* Name of element within array;  NULL means
+				 * trace applies to scalar variable or array
+				 * as-a-whole. */
+    int flags;			/* OR-ed collection of bits describing
+				 * current trace, including any of
+				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
+    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+  if (part2 && *part2) {
+    char *s = malloc(strlen(part1) + strlen(part2) + 3);
+
+    sprintf(s, "%s{%s}", part1, part2);
+    Tcl_UntraceVar(interp, s, flags, proc, clientData);
+    free(s);
+  }
+  else
+    Tcl_UntraceVar(interp, part1, flags, proc, clientData);
+}
+
+/****
+ * 
+ * Tcl_ChangeValue
+ *
+ * This function is called by Lisp when a there's a global variable change
+ * (using a tk-setq). "var" is a C string indicating the name of this
+ * variable. If this variable is traced, call the C functions associated to it.
+ *
+ ****/
+
+#define TRACING (1<<20)
+
+void Tcl_ChangeValue(char *var)
+{ 
+  Tcl_HashEntry *entry;
+  register VarTrace *data, *p;
+  extern int Tk_initialized;
+
+  if (!Tk_initialized) return;
+
+  if (entry = Tcl_FindHashEntry(&VarTable, var)) {
+    /* Variable is traced. Call all the associated traces */
+    data = (struct VarTrace *) Tcl_GetHashValue(entry);
+    
+    for (p = data; p ; p = p->nextPtr) {
+      /* Invoke trace procedure if not already active */
+      if (p->flags & TRACING) 
+	continue;
+
+      p->flags |= TRACING;
+      (*p->traceProc)(p->clientData, ECL_interp, var, "", p->flags);
+    
+      /* Unset our flag */
+      p->flags &= ~TRACING;
+    }
+  }
+}
diff --git a/src/c/tcp.d b/src/c/tcp.d
new file mode 100644
index 000000000..bba5bdb00
--- /dev/null
+++ b/src/c/tcp.d
@@ -0,0 +1,114 @@
+/* tcp.c  -- stream interface to TCP					*/
+
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or modify it
+    under the terms of the GNU General Library Public License as published
+    by the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+cl_object
+make_stream(cl_object host, int fd, enum smmode smm)
+{
+   cl_object stream;
+   char *mode;			/* file open mode */
+   FILE *fp;			/* file pointer */
+
+   switch(smm) {
+    case smm_input:
+      mode = "r";
+      break;
+    case smm_output:
+      mode = "w";
+      break;
+    default:
+      FEerror("make_stream: wrong mode", 0);
+   }
+   fp = fdopen(fd, mode);
+
+   stream = alloc_object(t_stream);
+   stream->stream.mode = (short)smm;
+   stream->stream.file = fp;
+   stream->stream.object0 = Sbase_char;
+   stream->stream.object1 = host; /* not really used */
+   stream->stream.int0 = stream->stream.int1 = 0;
+#if !defined(GBC_BOEHM)
+   fp->_IO_buf_base = NULL; /* BASEFF */; 
+   setbuf(fp, stream->stream.buffer = alloc_atomic(BUFSIZ)); 
+#endif
+   return(stream);
+}
+
+/* 
+   Lopen_client_stream --
+
+   To test this function, try:
+   (setq s (si:open-client-stream "host" 13))
+   (read-line s)
+   "Wed Jun 22 19:44:36 METDST 1994"
+*/
+@(defun open_client_stream (host port)
+   int fd;			/* file descriptor */
+   cl_object streamIn, streamOut;
+@
+   if (type_of(host) != t_string)
+     FEwrong_type_argument(Sstring, host);
+
+   if (!FIXNUMP(port))
+     FEwrong_type_argument(TSpositive_number, port);
+
+   /* FIXME! Why? */
+   if (host->string.fillp > BUFSIZ - 1)
+     FEerror("~S is a too long file name.", 1, host);
+
+#ifdef THREADS
+   start_critical_section();
+#endif THREADS
+   fd = connect_to_server(host->string.self, fix(port)); 
+#ifdef THREADS
+   end_critical_section();
+#endif THREADS
+
+   if (fd == 0)
+     @(return Cnil)
+
+   streamIn = make_stream(host, fd, smm_input);
+   streamOut = make_stream(host, fd, smm_output);
+
+   @(return make_two_way_stream(streamIn, streamOut))
+@)
+
+@(defun open_server_stream (port)
+   int fd;			/* file descriptor */
+   cl_object streamIn, streamOut;
+   cl_object output;
+@
+   if (!FIXNUMP(port))
+     FEwrong_type_argument(TSpositive_number, port);
+
+#ifdef THREADS
+   start_critical_section();
+#endif THREADS
+   fd = create_server_port(fix(port));
+#ifdef THREADS
+   end_critical_section();
+#endif THREADS
+
+   if (fd == 0)
+     output = Cnil;
+   else {
+     streamIn = make_stream(Cnil, fd, smm_input);
+     streamOut = make_stream(Cnil, fd, smm_output);
+     output = make_two_way_stream(streamIn, streamOut);
+   }
+   @(return output)
+@)
+
+
diff --git a/src/c/time.d b/src/c/time.d
new file mode 100644
index 000000000..478f59c9b
--- /dev/null
+++ b/src/c/time.d
@@ -0,0 +1,161 @@
+/*
+    time.c -- Time routines.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include <math.h>
+#include <time.h>
+#include <sys/times.h>
+#include <unistd.h>
+
+#ifndef HZ			/* usually from <sys/param.h> */
+#define HZ 60
+#endif
+
+static time_t beginning;
+
+int
+runtime(void)
+/*
+   tms_utime is the CPU time used while executing instructions in the
+   user space of the calling process, measured in 1/HZ seconds.
+*/
+{
+	struct tms buf;
+
+	times(&buf);
+	return(buf.tms_utime);
+}
+
+static cl_object Jan1st1970UT;
+
+cl_object
+UTC_time_to_universal_time(int i)
+{
+	return number_plus(bignum1(i), Jan1st1970UT);
+}
+
+@(defun get_universal_time ()
+@
+	@(return UTC_time_to_universal_time(time(0)))
+@)
+
+@(defun sleep (z)
+	double r;
+	struct timespec tm;
+@
+	/* INV: number_minusp() makes sure `z' is real */
+	if (number_minusp(z))
+		FEcondition(9, Ssimple_type_error, Kformat_control,
+			    make_simple_string("Not a non-negative number ~S"),
+			    Kformat_arguments, list(1, z),
+			    Kexpected_type, Sreal, Kdatum, z);
+#ifdef HAVE_NANOSLEEP
+	r = object_to_double(z);
+	tm.tv_sec = (time_t)floor(r);
+	tm.tv_nsec = (long)((r - floor(r)) * 1e9);
+	nanosleep(&tm, NULL);
+#else
+	z = round1(z);
+	if (FIXNUMP(z))
+		sleep(fix(z));
+	else
+		for(;;)
+			sleep(1000);
+#endif
+	@(return Cnil)
+@)
+
+@(defun get_internal_run_time ()
+	struct tms buf;
+@
+	times(&buf);
+	@(return MAKE_FIXNUM(buf.tms_utime))
+@)
+
+@(defun get_internal_real_time ()
+@
+	@(return MAKE_FIXNUM((time(0) - beginning)*HZ))
+@)
+
+/*
+ * Return the hours west of Greenwich for the current timezone.
+ *
+ * Based on Lott's get_timezone() function from CMU Common Lisp.
+ */
+@(defun get_local_time_zone ()
+  struct tm ltm, gtm;
+  int mw;
+  time_t when = 0L;
+@
+  ltm = *localtime(&when);
+  gtm = *gmtime(&when);
+
+  mw = (gtm.tm_min + 60 * gtm.tm_hour) - (ltm.tm_min + 60 * ltm.tm_hour);
+
+  if ((gtm.tm_wday + 1) % 7 == ltm.tm_wday)
+    mw -= 24*60;
+  else if (gtm.tm_wday == (ltm.tm_wday + 1) % 7)
+    mw += 24*60;
+
+  @(return make_ratio(MAKE_FIXNUM(mw), MAKE_FIXNUM(60)))
+@)
+
+/*
+ * Return T if daylight saving is in effect at Universal Time UT, which
+ * defaults to current time.
+ *
+ */
+@(defun daylight_saving_timep (&rest args)
+  struct tm *ltm;
+  time_t when;
+@
+  if (narg == 0)
+    when = time(0);
+  else if (narg == 1) {
+    cl_object UT, UTC;
+    va_start(args, narg);
+    UT = va_arg(args, cl_object);
+    UTC = number_minus(UT, Jan1st1970UT);
+    switch (type_of(UTC)) {
+    case t_fixnum:
+      when = fix(UTC);
+      break;
+    case t_bignum:
+      when = big_to_long(UTC);
+      break;
+    default:
+      FEerror("Universal Time out of range: ~A.", 1, UT);
+    }
+  }
+  else
+    FEtoo_many_arguments(&narg);
+  ltm = localtime(&when);
+  @(return (ltm->tm_isdst ? Ct : Cnil))
+@)
+
+void
+init_unixtime(void)
+{
+	beginning = time(0);
+
+	make_si_special("*DEFAULT-TIME-ZONE*", MAKE_FIXNUM(TIME_ZONE));
+	make_constant("INTERNAL-TIME-UNITS-PER-SECOND", MAKE_FIXNUM(HZ));
+
+	Jan1st1970UT =
+	  number_times(MAKE_FIXNUM(24 * 60 * 60),
+		       MAKE_FIXNUM(17 + 365 * 70));
+	register_root(&Jan1st1970UT);
+}
diff --git a/src/c/tkMain.d b/src/c/tkMain.d
new file mode 100644
index 000000000..38f77843c
--- /dev/null
+++ b/src/c/tkMain.d
@@ -0,0 +1,210 @@
+/* 
+ * tkMain.c 			-- Initialization of Tk
+ *
+ * This code initializes the Tk library. It corresponds to a part of the 
+ * file main.c of the wish interpreter. 
+ *
+ *           Author: Erick Gallesio [eg@unice.fr]
+ *    Creation date: 13-May-1993 10:59
+ * Last file update: 10-Feb-1995 22:23
+ *
+ *
+ * Code used here was originally copyrigthed as shown below:
+ *      Copyright 1990-1992 Regents of the University of California.
+ *
+ *
+ * Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+ * 
+ *
+ * Permission to use, copy, and/or distribute this software and its
+ * documentation for any purpose and without fee is hereby granted, provided
+ * that both the above copyright notice and this permission notice appear in
+ * all copies and derived works.  Fees for distribution or use of this
+ * software or derived works may only be charged with express written
+ * permission of the copyright holder.  
+ * This software is provided ``as is'' without express or implied warranty.
+ *
+ * This software is a derivative work of other copyrighted softwares; the
+ * copyright notices of these softwares are placed in the file COPYRIGHTS
+ *
+ * Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+ *
+ */
+
+#include "ecls.h"
+#include "tk.h"
+
+
+/*
+ * Command used to initialize ECL/tk:
+ */
+
+static char initCmd[] =
+"(tk::tk-init)";
+
+/*
+ * Global variables used by the main program:
+ */
+
+static Tk_Window w;		/* The main window for the application.  If
+				 * NULL then the application no longer
+				 * exists. */
+Tcl_Interp *ECL_interp = NULL;	/* Interpreter for this application. */
+int Tk_initialized = FALSE;	/* TRUE when Tk is fully initialized */
+cl_object Tk_root_window;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void DelayedMap _ANSI_ARGS_((ClientData clientData));
+static void StructureProc _ANSI_ARGS_((ClientData clientData,
+				       XEvent *eventPtr));
+
+extern StdinResume();
+extern cl_object tk_package;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_main
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_main(int synchronize, char *name, char *fileName, char *Xdisplay,
+	     char *geometry)
+{
+  Tk_3DBorder border;
+
+  ECL_interp = Tcl_CreateInterp();
+  
+  /*
+   * Parse command-line arguments.
+   */
+
+  Tcl_SetVar(ECL_interp, "*geometry*", geometry ? geometry : "",
+	     TCL_GLOBAL_ONLY);
+
+  /*
+   * Initialize the Tk application and arrange to map the main window
+   * after the startup script has been executed, if any.  This way
+   * the script can withdraw the window so it isn't ever mapped
+   * at all.
+   */
+
+  w = Tk_CreateMainWindow(ECL_interp, Xdisplay, name, "ECL/Tk");
+  if (w == NULL) {
+    fprintf(stderr, "%s\n", ECL_interp->result);
+    exit(1);
+  }
+
+  Tcl_SetVar(ECL_interp, "*root*", ".", TCL_GLOBAL_ONLY);
+  Tk_root_window = _intern("*ROOT*", tk_package);
+
+  Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
+			(ClientData) NULL);
+  Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);
+  if (synchronize) {
+    XSynchronize(Tk_Display(w), True);
+  }
+  Tk_GeometryRequest(w, 200, 200);
+  border = Tk_Get3DBorder(ECL_interp, w, None, "#cccccc");
+  if (border == NULL) {
+    Tcl_SetResult(ECL_interp, (char *) NULL, TCL_STATIC);
+    Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));
+  } 
+  else {
+    Tk_SetBackgroundFromBorder(w, border);
+  }
+  XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),
+		 BlackPixelOfScreen(Tk_Screen(w)));
+  
+  Tk_initialized = 1;		/* Ok, it's fully initialized		     */
+
+  /*
+   * Set up a handler for stdin, for resuming read when input
+   * becomes available
+   */
+  Tk_CreateFileHandler(0, TK_READABLE, (Tk_FileProc *)StdinResume,
+		       (ClientData) 0);
+  StdinEnableEvents();		/* check for events when idle */
+
+  /*
+   * Set the geometry of the main window, if requested.
+   */
+  if (geometry != NULL) {
+    if (TCL_OK != Tcl_VarEval(ECL_interp, "(wm 'geometry *root* '", 
+			      geometry, ")", NULL))
+      fprintf(stderr, "**** Warning: %s\n", ECL_interp->result);
+  }
+
+  /*
+   * Execute ECL/Tk's initialization script, followed by the script specified
+   * on the command line, if any.
+   */
+  
+  Tcl_GlobalEval(ECL_interp, initCmd);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StructureProc --
+ *
+ *	This procedure is invoked whenever a structure-related event
+ *	occurs on the main window.  If the window is deleted, the
+ *	procedure modifies "w" to record that fact.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Variable "w" may get set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StructureProc(ClientData clientData, /* Information about window. */
+	      XEvent *eventPtr)	/* Information about event. */
+{
+  if (eventPtr->type == DestroyNotify)
+    w = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DelayedMap --
+ *
+ *	This procedure is invoked by the event dispatcher once the
+ *	startup script has been processed.  It waits for all other
+ *	pending idle handlers to be processed (so that all the
+ *	geometry information will be correct), then maps the
+ *	application's main window.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The main window gets mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DelayedMap(ClientData clientData)
+{
+
+    while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
+	/* Empty loop body. */
+    }
+    if (w == NULL) {
+	return;
+    }
+    Tk_MapWindow(w);
+}
diff --git a/src/c/typespec.d b/src/c/typespec.d
new file mode 100644
index 000000000..b43170718
--- /dev/null
+++ b/src/c/typespec.d
@@ -0,0 +1,427 @@
+/*
+    typespec.c -- Type specifier routines.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+
+/******************************* EXPORTS ******************************/
+
+cl_object Squote;
+cl_object Slambda;
+cl_object Sspecial;
+
+cl_object Ssubtypep;
+
+cl_object
+St,		Snil,		Scommon,	Ssequence,
+Snull,		Scons,		Slist,		Ssymbol,
+Sarray,		Svector,	Sbit_vector,	Sstring,
+Ssimple_array,	Ssimple_vector,	Ssimple_string,	Ssimple_bit_vector,
+Sfunction,	Spathname,	Scharacter,	Scompiled_function,
+Snumber,	Srational,	Sfloat,		Sreal,
+Sinteger,	Sratio,		Sshort_float,	Sstandard_char,
+Sfixnum,	Scomplex,	Ssingle_float,	Spackage,
+Sbignum,	Srandom_state,	Sdouble_float,	Sstream,
+Sbit,		Sreadtable,	Slong_float,	Shash_table,
+Ssigned_char,	Sunsigned_char,	Ssigned_short,	Sunsigned_short,
+Sbase_char,	Sextended_char,	Slogical_pathname;
+
+#ifdef THREADS
+cl_object Scont, Sthread;
+#endif THREADS
+
+#ifdef CLOS
+cl_object Sinstance, Sdispatch_function;
+#endif
+
+#ifdef LOCATIVE
+cl_object Slocative;
+#endif
+
+cl_object Sstructure,	Ssatisfies,	Smember,	Snot,	Sor,	Sand;
+cl_object Svalues,	Smod,		Ssigned_byte,	Sunsigned_byte;
+
+cl_object SX;		/*  symbol *  */
+cl_object Splusp;
+
+cl_object TSnon_negative_integer;
+cl_object TSpositive_number;
+
+/******************************* ------- ******************************/
+
+cl_object Skeyword;
+
+/**********************************************************************/
+
+void
+FEtype_error_character(cl_object x) {
+	FEwrong_type_argument(Scharacter, x);
+}
+
+void
+FEtype_error_cons(cl_object x) {
+	FEwrong_type_argument(Scons, x);
+}
+
+void
+FEtype_error_number(cl_object x) {
+	FEwrong_type_argument(Snumber, x);
+}
+
+void
+FEtype_error_real(cl_object x) {
+	FEwrong_type_argument(Sreal, x);
+}
+
+void
+FEtype_error_float(cl_object x) {
+	FEwrong_type_argument(Sfloat, x);
+}
+
+void
+FEtype_error_integer(cl_object x) {
+	FEwrong_type_argument(Sinteger, x);
+}
+
+void
+FEtype_error_list(cl_object x) {
+	FEwrong_type_argument(Slist, x);
+}
+
+void
+FEtype_error_proper_list(cl_object x) {
+	FEcondition(9, Ssimple_type_error, Kformat_control,
+		    make_simple_string("Not a proper list ~D"),
+		    Kformat_arguments, list(1, x),
+		    Kexpected_type, Slist,
+		    Kdatum, x);
+}
+
+void
+FEtype_error_alist(cl_object x)
+{
+	FEcondition(9, Ssimple_type_error, Kformat_control,
+		    make_simple_string("Not a valid association list ~D"),
+		    Kformat_arguments, list(1, x),
+		    Kexpected_type, Slist,
+		    Kdatum, x);
+}
+
+void
+FEtype_error_plist(cl_object x)
+{
+	FEcondition(9, Ssimple_type_error, Kformat_control,
+		    make_simple_string("Not a valid property list ~D"),
+		    Kformat_arguments, list(1, x),
+		    Kexpected_type, Slist,
+		    Kdatum, x);
+}
+
+void
+FEcircular_list(cl_object x)
+{
+	/* FIXME: Is this the right way to rebind it? */
+	bds_bind(Vprint_circle, Ct);
+	FEcondition(9, Ssimple_type_error, Kformat_control,
+		    make_simple_string("Circular list ~D"),
+		    Kformat_arguments, list(1, x),
+		    Kexpected_type, Slist,
+		    Kdatum, x);
+}
+
+void
+FEtype_error_index(cl_object x)
+{
+	FEcondition(9, Ssimple_type_error, Kformat_control,
+		    make_simple_string("Index out of bounds ~D"),
+		    Kformat_arguments, list(1, x),
+		    Kexpected_type, Sfixnum,
+		    Kdatum, x);
+}
+
+void
+FEtype_error_string(cl_object s)
+{
+	FEwrong_type_argument(Sstring, s);
+}
+
+void
+FEtype_error_stream(cl_object strm)
+{
+	FEwrong_type_argument(Sstream, strm);
+}
+
+/**********************************************************************/
+
+void
+assert_type_integer(cl_object p)
+{
+	enum type t = type_of(p);
+	if (t != t_fixnum && t != t_bignum)
+		FEtype_error_integer(p);
+}
+
+void
+assert_type_non_negative_integer(cl_object p)
+{
+	enum type t = type_of(p);
+
+	if (t == t_fixnum) {
+		if (FIXNUM_PLUSP(p))
+			return;
+	} else if (t == t_bignum) {
+		if (big_sign(p) >= 0)
+			return;
+	}
+	FEwrong_type_argument(TSnon_negative_integer, p);
+}
+
+void
+assert_type_character(cl_object p)
+{
+	if (!CHARACTERP(p))
+		FEtype_error_character(p);
+}
+
+void
+assert_type_symbol(cl_object p)
+{
+	if (!SYMBOLP(p))
+		FEwrong_type_argument(Ssymbol, p);
+}
+
+void
+assert_type_package(cl_object p)
+{
+	if (type_of(p) != t_package)
+		FEwrong_type_argument(Spackage, p);
+}
+
+void
+assert_type_string(cl_object p)
+{
+	if (type_of(p) != t_string)
+		FEtype_error_string(p);
+}
+
+void
+assert_type_cons(cl_object p)
+{
+	if (ATOM(p))
+		FEwrong_type_argument(Scons, p);
+}
+
+void
+assert_type_list(cl_object p)
+{
+	if (ATOM(p) && p != Cnil)
+		FEtype_error_list(p);
+}
+
+void
+assert_type_proper_list(cl_object p)
+{
+	if (ATOM(p) && p != Cnil)
+		FEtype_error_list(p);
+	if (list_length(p) == Cnil)
+		FEcircular_list(p);
+}
+
+void
+assert_type_stream(cl_object p)
+{
+	if (type_of(p) != t_stream)
+		FEwrong_type_argument(Sstream, p);
+}
+
+void
+assert_type_readtable(cl_object p)
+{
+	if (type_of(p) != t_readtable)
+		FEwrong_type_argument(Sreadtable, p);
+}
+
+void
+assert_type_hash_table(cl_object p)
+{
+	if (type_of(p) != t_hashtable)
+		FEwrong_type_argument(Shash_table, p);
+}
+
+void
+assert_type_array(cl_object p)
+{
+	if (!ARRAYP(p))
+		FEwrong_type_argument(Sarray, p);
+}
+
+void
+assert_type_vector(cl_object p)
+{
+	if (!VECTORP(p))
+		FEwrong_type_argument(Svector, p);
+}
+
+cl_object
+TYPE_OF(cl_object x)
+{
+	switch (type_of(x)) {
+#ifdef CLOS
+        case t_instance:
+		{ cl_object cl = CLASS_OF(x);
+		  if (CLASS_NAME(cl) != Cnil)
+		    return(CLASS_NAME(cl));
+		  else
+		    return(cl);
+		}
+#endif
+
+	case t_fixnum:
+		return(Sfixnum);
+
+	case t_bignum:
+		return(Sbignum);
+
+	case t_ratio:
+		return(Sratio);
+
+	case t_shortfloat:
+		return(Sshort_float);
+
+	case t_longfloat:
+		return(Slong_float);
+
+	case t_complex:
+		return(Scomplex);
+
+	case t_character: {
+		int i = CHAR_CODE(x);
+		if ((' ' <= i && i < '\177') || i == '\n')
+			return(Sstandard_char);
+		else
+			return(Sbase_char);
+	}
+
+	case t_symbol:
+		if (x == Cnil)
+			return(Snull);
+		if (x->symbol.hpack == keyword_package)
+			return(Skeyword);
+		else
+			return(Ssymbol);
+
+	case t_package:
+		return(Spackage);
+
+	case t_cons:
+		return(Scons);
+
+	case t_hashtable:
+		return(Shash_table);
+
+	case t_array:
+		if (x->array.adjustable ||
+		    Null(CAR(x->array.displaced)))
+			return(Sarray);
+		else
+			return(Ssimple_array);
+
+	case t_vector:
+		if (x->vector.adjustable ||
+		    x->vector.hasfillp ||
+		    Null(CAR(x->vector.displaced)) ||
+		    (enum aelttype)x->vector.elttype != aet_object)
+			return(Svector);
+		else
+			return(Ssimple_vector);
+
+	case t_string:
+		if (x->string.adjustable ||
+		    x->string.hasfillp ||
+		    Null(CAR(x->string.displaced)))
+			return(Sstring);
+		else
+			return(Ssimple_string);
+
+	case t_bitvector:
+		if (x->vector.adjustable ||
+		    x->vector.hasfillp ||
+		    Null(CAR(x->vector.displaced)))
+			return(Sbit_vector);
+		else
+			return(Ssimple_bit_vector);
+
+#ifndef CLOS
+	case t_structure:
+		return(x->str.name);
+#endif CLOS
+
+	case t_stream:
+		return(Sstream);
+
+	case t_readtable:
+		return(Sreadtable);
+
+	case t_pathname:
+		if (x->pathname.logical)
+			return Slogical_pathname;
+		return(Spathname);
+
+	case t_random:
+		return(Srandom_state);
+
+	case t_bytecodes:
+	case t_cfun:
+	case t_cclosure:
+		return(Scompiled_function);
+
+#ifdef THREADS
+	case t_cont:
+		return(Scont);
+
+	case t_thread:
+		return(Sthread);
+#endif THREADS
+#ifdef CLOS
+	case t_gfun:
+		return(Sdispatch_function);
+#endif
+#ifdef LOCATIVE
+	      case t_locative:
+		return(Slocative);
+#endif
+
+	default:
+		error("not a lisp data object");
+	}
+}
+
+@(defun type_of (x)
+@
+	@(return TYPE_OF(x))
+@)
+
+void
+init_typespec(void)
+{
+
+	TSnon_negative_integer
+	= CONS(Sinteger,
+		    CONS(MAKE_FIXNUM(0), CONS(SX, Cnil)));
+	register_root(&TSnon_negative_integer);
+	TSpositive_number = CONS(Ssatisfies, CONS(Splusp, Cnil));
+	register_root(&TSpositive_number);
+}				
diff --git a/src/c/unify.d b/src/c/unify.d
new file mode 100644
index 000000000..402e6c418
--- /dev/null
+++ b/src/c/unify.d
@@ -0,0 +1,298 @@
+/*
+    unify.d -- Support for unification.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include "unify.h"
+
+object *slot;			/* scanning pointer within object */
+int (*slotf)();			/* read/write mode accessor */
+
+/* -------------------- Trail Instructions -------------------- */
+
+object *trail[VSSIZE];
+object **trail_top = trail;
+
+#define BIND(loc, val)		{loc = val; trail_push(&loc);}
+
+@(defun trail_mark ()
+@
+  trail_mark;
+@)
+
+@(defun trail_restore ()
+@
+  trail_restore;
+  @(return Cnil)
+@)
+
+@(defun trail_unmark ()
+@
+  trail_unmark;
+  @(return Cnil)
+@)
+
+/* -------------------- Mode Operators -------------------- */
+
+bool get_slot(object x)		/* read mode */
+{
+  if (x == *slot || unify(x, *slot))
+    if (*slot == OBJNULL)
+      return((bool)MAKE_LOCATIVE(slot++));
+    else
+      return((bool)*slot++);	/* dereference */
+  else
+    return(FALSE);
+}
+
+bool set_slot(object x)		/* write mode */
+{
+  /* NOTE: slot contains OBJNULL */
+  *slot = x;
+  return((bool)MAKE_LOCATIVE(slot++));
+}
+
+
+/* -------------------- Get Instructions -------------------- */
+
+/* get_variable is just setq */
+
+@(defun get_value (v x)
+@
+	@(return `get_value(v, x)?Ct:Cnil`)
+@)
+
+@(defun get_constant (c x)
+@
+	@(return `get_constant(c, x)?Ct:Cnil`)
+@)
+
+@(defun get_nil (arg)
+@
+	@(return `get_nil(arg)?Ct:Cnil`)
+@)
+
+bool
+get_cons(object x)
+{
+
+RETRY:	switch (type_of(x)) {
+	case t_cons:
+	  slot = &CDR(x);	/* cdr slot is first in struct cons */
+	  slotf = get_slot;
+	  return(TRUE);
+
+	case t_locative:
+	  if (UNBOUNDP(x)) {
+	    object new = CONS(OBJNULL, OBJNULL);
+	    BIND(DEREF(x), new);
+	    slot = &CDR(new);
+	    slotf = set_slot;
+	    return(TRUE);
+	  }
+	  else {
+	    x = DEREF(x);
+	    goto RETRY;
+	  }
+
+	default: return(FALSE);
+	}
+	    
+}
+
+@(defun get_cons (arg)
+@
+	@(return `get_cons(arg)?Ct:Cnil`)
+@)
+
+bool
+get_instance(object x, object class, int arity)
+{
+RETRY:	switch (type_of(x)) {
+	case t_instance: 
+	if (CLASS_OF(x) == class) {
+	  slot = x->instance.slots;
+	  slotf = get_slot;
+	  return(TRUE);
+	} else
+	  return(FALSE);
+
+	case t_locative:
+	  if (UNBOUNDP(x)) {
+	    object new = allocate_instance(class, arity);
+	    BIND(DEREF(x), new);
+	    slot = new->instance.slots;
+	    slotf = set_slot;
+	    return(TRUE);
+	  }
+	  else {
+	    x = DEREF(x);
+	    goto RETRY;
+	  }
+	default: return(FALSE);
+	}
+}
+
+@(defun get_instance (x class arity)
+@
+	@(return `get_instance(x, class, fix(arity))?Ct:Cnil`)
+@)
+
+
+/* -------------------- Unify Instructions --------------------  */
+
+#define UNIFY_LOCATIVE(x, y, L)	{object *p = &DEREF(x); \
+				   if (*p == OBJNULL) { \
+				     BIND(*p, y); return(TRUE); } \
+				       else { x = *p; goto L;}}
+/*
+#define UNIFY_LOCATIVE(x, y, L) {if (UNBOUNDP(x)) { \
+				     BIND(DEREF(x), y); return(TRUE); } \
+				       else { x = DEREF(x); goto L;}}
+*/
+
+bool
+unify(object x, object y)
+{
+  /* NOTE: x <- y */
+
+  L: switch (type_of(x)) {
+
+  case t_locative: UNIFY_LOCATIVE(x, y, L);
+
+  case t_cons:
+       L1: switch (type_of(y)) {
+
+       case t_cons: return(unify(CAR(x), CAR(y)) &&
+			   unify(CDR(x), CDR(y)));
+
+       case t_locative: UNIFY_LOCATIVE(y, x, L1);
+
+       default: return(FALSE);
+       }
+
+  case t_instance:
+       L2: switch (type_of(y)) {
+
+       case t_instance:
+	 if (CLASS_OF(x) == CLASS_OF(y)) {
+	   int l = x->instance.length; int i;
+	   object *slotx = x->instance.slots;
+	   object *sloty = y->instance.slots;
+	   for (i = 0; i < l; i++) {
+	     if (!unify(*slotx++, *sloty++))
+	       return(FALSE);
+	   }
+	   return(TRUE);
+	 } else
+	   return(FALSE);
+
+       case t_locative: UNIFY_LOCATIVE(y, x, L2);
+
+       default: return(FALSE);
+       }
+
+  default:
+    L3: if (LOCATIVEP(y))
+           UNIFY_LOCATIVE(y, x, L3)
+        else if (equal(x,y))
+	  return(TRUE);
+	else
+	  return(FALSE);
+  }
+}
+
+/* Internal function. One should use unify_variable, which always returns T */
+
+@(defun unify_slot ()
+@
+	@(return `(object)unify_slot`)
+@)
+
+
+@(defun unify_value (loc)
+  object x;
+@
+	x = (object)unify_value(loc);
+	@(return `(x == Cnil || x)?Ct:Cnil`)
+@)
+
+@(defun unify_constant (c)
+  object x;
+@
+	x = (object)unify_constant(c);
+	@(return `(x == Cnil || x)?Ct:Cnil`)
+@)
+
+@(defun unify_nil ()
+  object x;
+@
+	x = (object)unify_nil;
+	@(return `(x == Cnil || x)?Ct:Cnil`)
+@)
+
+/* -------------------- Test Functions -------------------- */
+
+@(defun make_locative (&optional (n 0))
+@
+	@(return `MAKE_LOCATIVE(fix(n))`)
+@)
+
+@(defun locativep (obje)
+@
+        @(return `LOCATIVEP(obje)?Ct:Cnil`)
+@)
+
+@(defun unboundp (loc)
+@
+        @(return `UNBOUNDP(loc)?Ct:Cnil`)
+@)
+
+@(defun dereference (x)
+  extern object Slocative;
+@
+	while (type_of(x) != t_locative)
+	  x = wrong_type_argument(Slocative, x);
+	@(return `DEREF(x)`)
+@)
+
+@(defun make_variable (name)
+@
+	@(return `CONS(name, OBJNULL)`)
+@)
+
+/* (defmacro unify-variable (v) `(progn (setq ,v (si:unify-slot)) t) */
+
+object Ssetq, Sunify_slot;
+
+@(defun unify_variable (object var)
+@
+	@(return list(3, Sprogn,
+			 list(3, Ssetq, CADR(var),
+				 CONS(Sunify_slot, Cnil)),
+			 Ct))
+@)
+
+#define make_si_macro(name, cfun)	\
+	{object x = make_si_ordinary(name); \
+	   SYM_FUN(x) = make_cfun(cfun, Cnil, NULL); \
+	   x->symbol.mflag = TRUE; \
+	 }
+
+void
+init_unify(void)
+{
+	make_si_macro("UNIFY-VARIABLE", Lunify_variable);
+}
diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d
new file mode 100644
index 000000000..c4fdde793
--- /dev/null
+++ b/src/c/unixfsys.d
@@ -0,0 +1,573 @@
+/*
+    unixfsys.c  -- Unix file system interface.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+#include <string.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <pwd.h>
+#include <sys/stat.h>
+#ifdef BSD
+#include <dirent.h>
+#else
+#include "<sys/dir.h>"
+#endif
+
+cl_object Klist_all;
+
+/*
+ * string_to_pathanme, to be used when s is a real pathname
+ */
+cl_object
+string_to_pathname(char *s)
+{
+  cl_index e;
+  return parse_namestring(s, 0, strlen(s), &e, Cnil);
+}
+
+/*
+ * Finds current directory by using getcwd() with an adjustable
+ * string which grows until it can host the whole path.
+ */
+static cl_object
+current_dir(void) {
+	cl_object output;
+	const char *ok;
+	extern char *getcwd(char *, size_t);
+	cl_index size = 128;
+
+	do {
+	  output = alloc_adjustable_string(size);
+	  ok = getcwd(output->string.self, size);
+	  size += 256;
+	} while(ok == NULL);
+	size = strlen(output->string.self);
+	if ((size + 1 /* / */ + 1 /* 0 */) >= output->string.dim) {
+	  /* Too large to host the trailing '/' */
+	  cl_object other = alloc_adjustable_string(size+2);
+	  strcpy(other->string.self, output->string.self);
+	  output = other;
+	}
+	output->string.self[size++] = '/';
+	output->string.self[size] = 0;
+	output->string.fillp = size;
+	return output;
+}
+
+/*
+ * Using a certain path, guess the type of the object it points to.
+ */
+
+enum file_system_type {
+  FILE_DOES_NOT_EXIST = 0,
+  FILE_REGULAR = 1,
+  FILE_DIRECTORY = 2,
+  FILE_OTHER = 3
+};
+
+static int
+get_file_system_type(const char *namestring) {
+  struct stat buf;
+
+  if (stat(namestring, &buf) < 0)
+    return FILE_DOES_NOT_EXIST;
+  if (S_ISREG(buf.st_mode))
+    return FILE_REGULAR;
+  if (S_ISDIR(buf.st_mode))
+    return FILE_DIRECTORY;
+  return FILE_OTHER;
+}
+
+
+/*
+ * Search the actual name of the directory of a pathname,
+ * going through links if they exist. Default is
+ * current directory
+ */
+static cl_object
+error_no_dir(cl_object pathname) {
+	FEerror("truedirectory: does not exist or cannot be accessed",1,pathname);
+	return OBJNULL;
+}
+
+cl_object
+truedirectory(cl_object pathname)
+{
+	cl_object directory;
+
+	directory = current_dir();
+	if (pathname->pathname.directory != Cnil) {
+	  cl_object dir = pathname->pathname.directory;
+	  if (CAR(dir) == Kabsolute)
+	    chdir("/");
+	  for (dir=CDR(dir); !Null(dir); dir=CDR(dir)) {
+	    cl_object name = CAR(dir);
+	    if (name == Kup) {
+	      if (chdir("..") < 0)
+		return error_no_dir(pathname);
+	    } else if (type_of(name) == t_string) {
+	      if (chdir(name->string.self) < 0)
+		return error_no_dir(pathname);
+	    } else
+	      FEerror("truename: ~A not allowed in filename",1,name);
+	  }
+	  dir = current_dir();
+	  chdir(directory->string.self);
+	  directory = dir;
+	}
+	return directory;
+}
+
+cl_object
+truename(cl_object pathname)
+{
+	cl_object directory;
+	cl_object truefilename;
+
+	pathname = coerce_to_file_pathname(pathname);
+
+	/* We are looking for a file! */
+	if (pathname->pathname.name == Cnil)
+	  FEerror("truename: no file name supplied",0);
+
+	/* Wildcards are not allowed */
+	if (pathname->pathname.name == Kwild ||
+	    pathname->pathname.type == Kwild)
+	  FEerror("truename: :wild not allowed in filename",0);
+
+	directory = truedirectory(pathname);
+
+	/* Compose a whole pathname by adding the
+	   file name and the file type */
+	if (Null(pathname->pathname.type)) 
+	  truefilename = siLstring_concatenate(2, directory, pathname->pathname.name);
+	else {
+	  truefilename = siLstring_concatenate(4, directory,
+				pathname->pathname.name,
+				make_simple_string("."),
+				pathname->pathname.type);
+	}
+
+	/* Finally check that the object exists and it is
+	   either a file or a device. (FIXME! Should we
+	   reject devices, pipes, etc?) */
+	switch (get_file_system_type(truefilename->string.self)) {
+	case FILE_DOES_NOT_EXIST:
+	  FEerror("truename: file does not exist or cannot be accessed",1,pathname);
+	  return OBJNULL;
+	case FILE_DIRECTORY:
+	  FEerror("truename: ~A is a directory", 1, truefilename);
+	  return OBJNULL;
+	default:
+	  return coerce_to_pathname(truefilename);
+	}
+}
+
+bool
+file_exists(cl_object file)
+{
+	struct stat filestatus;
+
+	/* INV: If input is a string, it assumes it is a valid file name */
+	if (type_of(file) != t_string)
+		file = coerce_to_filename(file);
+	if (stat(file->string.self, &filestatus) >= 0)
+		return(TRUE);
+	else
+		return(FALSE);
+}
+
+FILE *
+backup_fopen(char *filename, char *option)
+{
+	char backupfilename[MAXPATHLEN];
+	char command[MAXPATHLEN * 2];
+
+	strcat(strcpy(backupfilename, filename), ".BAK");
+	sprintf(command, "mv %s %s", filename, backupfilename);
+	system(command);
+	return(fopen(filename, option));
+}
+
+int
+file_len(FILE *fp)
+{
+	struct stat filestatus;
+
+	fstat(fileno(fp), &filestatus);
+	return(filestatus.st_size);
+}
+
+@(defun truename (file)
+@
+	/* INV: truename() checks type of file */
+	@(return truename(file))
+@)
+
+@(defun rename_file (old new)
+	cl_object filename, newfilename, old_truename, new_truename;
+@
+	/* INV: coerce_to_file_pathname() checks types */
+	old = coerce_to_file_pathname(old);
+	new = coerce_to_file_pathname(new);
+	new = merge_pathnames(new, old, Cnil);
+	old_truename = truename(old);
+	filename = coerce_to_filename(old);
+	newfilename = coerce_to_filename(new);
+	if (rename(filename->string.self, newfilename->string.self) < 0)
+		FEerror("Cannot rename the file ~S to ~S.", 2, old, new);
+	new_truename = truename(new);
+	@(return new old_truename new_truename)
+@)
+
+@(defun delete_file (file)
+	cl_object filename;
+@
+	/* INV: coerce_to_filename() checks types */
+	filename = coerce_to_filename(file);
+	if (unlink(filename->string.self) < 0)
+		FEerror("Cannot delete the file ~S.", 1, file);
+	@(return Ct)
+@)
+
+@(defun probe_file (file)
+@
+	/* INV: file_exists() and truename() check types */
+	@(return (file_exists(file)? truename(file) : Cnil))
+@)
+
+@(defun file_write_date (file)
+	cl_object filename, time;
+	struct stat filestatus;
+@
+	/* INV: coerce_to_filename() checks types */
+	filename = coerce_to_filename(file);
+	if (stat(filename->string.self, &filestatus) < 0)
+	  time = Cnil;
+	else
+	  time = UTC_time_to_universal_time(filestatus.st_mtime);
+	@(return time)
+@)
+
+@(defun file_author (file)
+	cl_object filename;
+	struct stat filestatus;
+	struct passwd *pwent;
+#ifndef __STDC__
+	extern struct passwd *getpwuid(uid_t);
+#endif
+@
+	/* INV: coerce_to_filename() checks types */
+	filename = coerce_to_filename(file);
+	if (stat(filename->string.self, &filestatus) < 0)
+		FEerror("Cannot get the file status of ~S.", 1, file);
+	pwent = getpwuid(filestatus.st_uid);
+	@(return make_string_copy(pwent->pw_name))
+@)
+
+const char *
+expand_pathname(const char *name)
+{
+  const char *path, *p;
+  static char pathname[255], *pn;
+
+  if (IS_DIR_SEPARATOR(name[0])) return(name);
+  if ((path = getenv("PATH")) == NULL) error("No PATH in environment");
+  p = path;
+  pn = pathname;
+  do {
+    if ((*p == '\0') || (*p == PATH_SEPARATOR)) {
+      if (pn != pathname) *pn++ = DIR_SEPARATOR; /* on SYSV . is empty */
+LAST: strcpy(pn, name);
+      if (access(pathname, X_OK) == 0)
+	return (pathname);
+      pn = pathname;
+      if (p[0] == PATH_SEPARATOR && p[1] == '\0') { /* last entry is empty */
+	p++;
+	goto LAST;
+      }
+    }
+    else
+      *pn++ = *p;
+  } while (*p++ != '\0');
+  return(name);			/* should never occur */
+}
+
+cl_object
+homedir_pathname(cl_object user)
+{
+	cl_index i;
+	char *p, filename[MAXPATHLEN];
+	struct passwd *pwent = NULL;
+#ifndef __STDC__
+	extern struct passwd *getpwuid(uid_t), *getpwnam();
+#endif
+	
+	if (Null(user))
+		pwent = getpwuid(getuid());
+	else {
+		user = coerce_to_string(user);
+		p = user->string.self;
+		i = user->string.fillp;
+		if (i > 0 && *p == '~') {
+			p++;
+			i--;
+		}
+		if (i == 0)
+			pwent = getpwuid(getuid());
+		else {
+			strncpy(filename, p, i);
+			filename[i] = '\0';
+			pwent = getpwnam(filename);
+		}
+	}
+	if (pwent == NULL)
+		FEerror("Unknown user ~S.", 1, user);
+	strcpy(filename, pwent->pw_dir);
+	i = strlen(filename);
+	if (i == 0 || filename[i-1] != '/') {
+		filename[i++] = '/';
+		filename[i] = '\0';
+	}
+	return string_to_pathname(filename);
+}
+
+@(defun user_homedir_pathname (&optional host)
+	cl_object pathname;
+@
+	/* Ignore optional host argument. */
+#ifdef MSDOS
+	{ extern char *getenv();
+	  char *h = getenv("HOME");
+	  pathname = (h == NULL)? make_simple_string("/")
+				: make_string_copy(h);
+	}
+#else
+	pathname = homedir_pathname(Cnil);
+#endif MSDOS
+	@(return pathname)
+@)
+
+/*
+ * Take two C strings and check if the first one matches
+ * against the pattern given by the second one. The pattern
+ * is that of a Unix shell except for brackets and curly
+ * braces
+ */
+static bool
+string_match(const char *s, const char *p) {
+	const char *next;
+	while (*s) {
+	  switch (*p) {
+	  case '*':
+	    /* Match any group of characters */
+	    next = p+1;
+	    if (*next != '?') {
+	      if (*next == '\\')
+		next++;
+	      while (*s && *s != *next) s++;
+	    }
+	    if (string_match(s,next))
+	      return TRUE;
+	    /* starts back from the '*' */
+	    if (!*s)
+	      return FALSE;
+	    s++;
+	    break;
+	  case '?':
+	    /* Match any character */
+	    s++, p++;
+	    break;
+	  case '\\':
+      /* Interpret a pattern character literally.
+         Trailing slash is interpreted as a slash. */
+	    if (p[1]) p++;
+	    if (*s != *p)
+	      return FALSE;
+	    s++, p++;
+	    break;
+	  default:
+	    if (*s != *p)
+	      return FALSE;
+	    s++, p++;
+	    break;
+	  }
+	}
+	while (*p == '*')
+	  p++;
+	return (*p == 0);
+}
+
+@(defun si::string_match (s1 s2)
+@
+	assert_type_string(s1);
+	assert_type_string(s2);
+	@(return (string_match(s1->string.self, s2->string.self) ? Ct : Cnil))
+@)
+
+static cl_object
+actual_directory(cl_object namestring, cl_object mask, bool all)
+{
+	cl_object ret = Cnil;
+	cl_object saved_dir = current_dir();
+	cl_object *directory = &ret;
+	cl_object dir_path = coerce_to_file_pathname(namestring);
+	enum file_system_type t;
+#if defined(BSD)
+/*
+ * version by Brian Spilsbury <brian@@bizo.biz.usyd.edu.au>, using opendir()
+ * arranged by Juan Jose Garcia Ripoll to understand masks
+ */
+	DIR *dir;
+	struct dirent *entry;
+
+	if (chdir(namestring->string.self) < 0) {
+	  chdir(saved_dir->string.self);
+	  FEerror("directory: cannot access ~A",1,namestring);
+	}
+	dir = opendir(".");
+	if (dir == NULL) {
+	  chdir(saved_dir->string.self);
+	  FEerror("Can't open the directory ~S.", 1, dir);
+	}
+
+	while ((entry = readdir(dir))) {
+	  t = get_file_system_type(entry->d_name);
+	  if ((all || t == FILE_REGULAR) &&
+	      string_match(entry->d_name, mask->string.self))
+	    {
+	      cl_index e = strlen(entry->d_name);
+	      cl_object file = parse_namestring(entry->d_name, 0, e, &e, Cnil);
+	      file = merge_pathnames(dir_path, file,Cnil);
+	      *directory = CONS(file, Cnil);
+	      directory = &CDR(*directory);
+	    }
+	}
+	closedir(dir);
+#endif
+#if defined(SYSV)
+	FILE *fp;
+	char iobuffer[BUFSIZ];
+	DIRECTORY dir;
+
+	if (chdir(namestring->string.self) < 0) {
+	  chdir(saved_dir->string.self);
+	  FEerror("directory: cannot access ~A",1,namestring);
+	}
+	fp = fopen(".", OPEN_R);
+	if (fp == NULL) {
+	  chdir(saved_dir->string.self);
+	  FEerror("Can't open the directory ~S.", 1, dir);
+	}
+
+	setbuf(fp, iobuffer);
+	/* FIXME! What are these three lines for? */
+	fread(&dir, sizeof(DIRECTORY), 1, fp);
+	fread(&dir, sizeof(DIRECTORY), 1, fp);
+	for (;;) {
+	  if (fread(&dir, sizeof(DIRECTORY), 1, fp) <= 0)
+	    break;
+	  if (dir.d_ino == 0)
+	    continue;
+	  t = get_file_system_type(dir.d_name);
+	  if ((all || t == FILE_REGULAR) &&
+	      string_match(dir.d_name, mask->string.self))
+	    {
+	      int e = strlen(dir.d_name);
+	      cl_object file = parse_namestring(dir.d_name, 0, e, &e);
+	      file = merge_pathnames(dir_path, file,Cnil);
+	      *directory = CONS(file, Cnil);
+	      directory = &CDR(*directory);
+	    }
+	}
+	fclose(fp);
+#endif
+	chdir(saved_dir->string.self);
+	return ret;
+}
+
+@(defun directory (&optional (filemask OBJNULL)
+			     (kall OBJNULL))
+	cl_object directory;
+	cl_object name, type, mask;
+	bool all = FALSE;
+@
+	/* Without arguments, it justs lists all files in
+	   current directory */
+	if (filemask == OBJNULL) {
+	  directory = current_dir();
+	  mask = make_simple_string("*");
+	  goto DO_MATCH;
+	}
+
+	if (kall == Klist_all)
+	  all = TRUE;
+	else if (kall != OBJNULL)
+	  FEwrong_type_argument(Skeyword, kall);
+
+	/* INV: coerce_to_file_pathname() checks types */
+	filemask = coerce_to_file_pathname(filemask);
+	name = filemask->pathname.name;
+	type = filemask->pathname.type;
+
+	directory = truedirectory(filemask);
+
+	if (name == Kwild)
+	  name = make_simple_string("*");
+	else if (name == Cnil) {
+	  if (type == Cnil)
+	    name = make_simple_string("*");
+	  else
+	    name = null_string;
+	}
+
+	if (type == Cnil)
+	  mask = name;
+	else {
+	  cl_object dot = make_simple_string(".");
+	  if (type == Kwild)
+	    type = make_simple_string("*");
+	  mask = siLstring_concatenate(3, name, dot, type);
+	}
+ DO_MATCH:
+	@(return actual_directory(directory, mask, all))
+@)
+
+@(defun si::chdir (directory)
+	cl_object filename, previous;
+@
+	/* INV: coerce_to_filename() checks types */
+	filename = coerce_to_filename(directory);
+	previous = current_dir();
+	if (chdir(filename->string.self) < 0)
+		FEerror("Can't change the current directory to ~S.",
+			1, directory);
+	@(return previous)
+@)
+
+#ifdef sun4sol2
+/* These functions can't be used with static linking on Solaris */
+struct passwd *
+getpwnam(const char *name)
+{
+  FEerror("~~ expansion not supported on Solaris.", 0);
+}
+struct passwd *
+getpwuid(uid_t uid)
+{
+  FEerror("ECL can't use getpwuid on Solaris.", 0);
+}
+#endif
diff --git a/src/c/unixint.d b/src/c/unixint.d
new file mode 100644
index 000000000..d01fd0bf0
--- /dev/null
+++ b/src/c/unixint.d
@@ -0,0 +1,175 @@
+/*
+    unixint.c -- Unix interrupt interface.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include <signal.h>
+
+/******************************* EXPORTS ******************************/
+
+int interrupt_enable;		/* console interupt enable */
+int interrupt_flag;		/* console interupt flag */
+
+/******************************* ------- ******************************/
+
+static cl_object SVinterrupt_enable;
+
+#ifndef THREADS
+
+void
+sigalrm(void)
+{
+	if (interrupt_flag) {
+		interrupt_flag = FALSE;
+		terminal_interrupt(TRUE);
+	}
+}
+
+void
+sigint(void)
+{
+  if (!interrupt_enable || interrupt_flag) {
+    if (!interrupt_enable) {
+      fprintf(stdout, "\n;;;Interrupt delayed.\n"); fflush(stdout);
+      interrupt_flag = TRUE;
+    }
+    signal(SIGINT, sigint);
+    return;
+  }
+  if (symbol_value(SVinterrupt_enable) == Cnil) {
+    SYM_VAL(SVinterrupt_enable) = Ct;
+    signal(SIGINT, sigint);
+    return;
+  }
+#ifdef __GO32__
+  if (interrupt_flag)
+    sigalrm();
+#endif
+  interrupt_flag = TRUE;
+  signal(SIGALRM, sigalrm);
+  alarm(1);
+  signal(SIGINT, sigint);
+}
+
+#else /* THREADS */
+
+extern int critical_level;
+bool scheduler_interrupted = FALSE;
+int scheduler_interruption = 0;
+
+void
+sigint()
+{
+#ifdef SYSV
+  signal(SIGINT, sigint);
+#endif
+  if (critical_level > 0) {
+    scheduler_interrupted = TRUE;
+    scheduler_interruption = ERROR_INT;
+    return;
+  }
+
+  if (symbol_value(SVinterrupt_enable) == Cnil) {
+    SVinterrupt_enable->symbol.dbind = Ct;
+    return;
+  }
+
+  terminal_interrupt(TRUE);
+}
+
+#endif /*THREADS */
+
+void
+sigfpe(void)
+{
+	signal(SIGFPE, sigfpe);
+	FEerror("Floating-point exception.", 0);
+}
+
+#ifdef unix
+void
+signal_catcher(int sig, int code, int scp)
+{
+	char str[64];
+
+	if (!interrupt_enable) {
+		sprintf(str, "signal %d caught (during GC)", sig);
+		error(str);
+	}
+	else if (sig == SIGSEGV)
+	  FEerror("Segmentation violation.~%\
+Wrong type argument to a compiled function.", 0);
+	else {
+	  printf("System error. Trying to recover ...\n");
+	  fflush(stdout);
+	  FEerror("Signal ~D caught.~%\
+The internal memory may be broken.~%\
+You should check the signal and exit from Lisp.", 1,
+		  MAKE_FIXNUM(sig));
+	}
+}
+
+@(defun si::catch_bad_signals ()
+@
+	signal(SIGILL, signal_catcher);
+	signal(SIGBUS, signal_catcher);
+	signal(SIGSEGV, signal_catcher);
+#ifdef SIGIOT
+	signal(SIGIOT, signal_catcher);
+#endif
+#ifdef SIGEMT
+	signal(SIGEMT, signal_catcher);
+#endif
+#ifdef SIGSYS
+	signal(SIGSYS, signal_catcher);
+#endif
+	@(return Ct)
+@)
+
+@(defun si::uncatch_bad_signals ()
+@
+	signal(SIGILL, SIG_DFL);
+	signal(SIGBUS, SIG_DFL);
+	signal(SIGSEGV, SIG_DFL);
+#ifdef SIGIOT
+	signal(SIGIOT, SIG_DFL);
+#endif
+#ifdef SIGEMT
+	signal(SIGEMT, SIG_DFL);
+#endif
+#ifdef SIGSYS
+	signal(SIGSYS, SIG_DFL);
+#endif
+	@(return Ct)
+@)
+#endif unix
+
+void
+enable_interrupt(void)
+{
+	interrupt_enable = TRUE;
+	signal(SIGFPE, sigfpe);
+	signal(SIGINT, sigint);
+#ifdef __EMX__
+	signal(SIGBREAK, sigint);
+#endif
+}
+
+void
+init_interrupt(void)
+{
+	SVinterrupt_enable = make_si_special("*INTERRUPT-ENABLE*", Ct);
+}
diff --git a/src/c/unixsys.d b/src/c/unixsys.d
new file mode 100644
index 000000000..9c300ef66
--- /dev/null
+++ b/src/c/unixsys.d
@@ -0,0 +1,115 @@
+/*
+    unixsys.s  -- Unix shell interface.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "ecls.h"
+
+#if !defined(__stdlib_h) && !defined(_STDLIB_H_) && !defined(__STDLIB_H__) &&  !defined(_STDLIB_H)
+#include <signal.h>
+int
+system(const char *command)
+{
+	char buf[4];
+	extern sigint();
+
+	signal(SIGINT, SIG_IGN);
+	write(4, command, strlen(command)+1);
+	read(5, buf, 1);
+	signal(SIGINT, sigint);
+	return(buf[0]<<8);
+}
+#endif __STDLIB_H__
+
+#if defined(__FreeBSD__) || defined(__NetBSD__)
+
+/* due to the calls to realloc in system.c/exec.c (memory which hasn't been
+malloc'ed can't be realloced in ecl) we have to patch this a bit.
+We use execv and supply the arg list, so execl doesn't have to realloc. CvdL */
+
+#include <sys/types.h>
+#include <sys/signal.h>
+#include <sys/wait.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <unistd.h>
+#include <paths.h>
+
+int
+system(command)
+	const char *command;
+{
+	union wait pstat;
+	pid_t pid;
+	int omask;
+	sig_t intsave, quitsave;
+
+	if (!command)		/* just checking... */
+		return(1);
+
+	omask = sigblock(sigmask(SIGCHLD));
+	switch(pid = vfork()) {
+	case -1:			/* error */
+		(void)sigsetmask(omask);
+		pstat.w_status = 0;
+		pstat.w_retcode = 127;
+		return(pstat.w_status);
+	case 0:	{			/* child */
+		const char *args[] = { "sh", "-c", command, (char *)NULL };
+		(void)sigsetmask(omask);
+	        execv(_PATH_BSHELL, args);
+		_exit(127);
+	}
+	}
+	intsave = signal(SIGINT, SIG_IGN);
+	quitsave = signal(SIGQUIT, SIG_IGN);
+	pid = waitpid(pid, (int *)&pstat, 0);
+	(void)sigsetmask(omask);
+	(void)signal(SIGINT, intsave);
+	(void)signal(SIGQUIT, quitsave);
+	return(pid == -1 ? -1 : pstat.w_status);
+}
+#endif
+
+@(defun si::system (cmd)
+@
+	assert_type_string(cmd);
+	/* FIXME! Are there any limits for system()? */
+	/* if (cmd->string.fillp >= 1024)
+		FEerror("Too long command line: ~S.", 1, cmd);*/
+	/* FIXME! This is a non portable way of getting the exit code */
+	@(return MAKE_FIXNUM(system(cmd->string.self) >> 8))
+@)
+
+@(defun si::open_pipe (cmd)
+  FILE *ptr;
+  cl_object stream;
+@
+  assert_type_string(cmd);
+ 
+  if ((ptr = popen(cmd->string.self, OPEN_R)) == NULL)
+    @(return Cnil)
+  stream = alloc_object(t_stream);
+  stream->stream.mode = smm_input;
+  stream->stream.file = ptr;
+  stream->stream.object0 = Sbase_char;
+  stream->stream.object1 = cmd;
+  stream->stream.int0 = stream->stream.int1 = 0;
+#if !defined(GBC_BOEHM)
+  /* FIXME! This is not portable */
+  ptr->_IO_buf_base = NULL;
+  setbuf(ptr, stream->stream.buffer = alloc_atomic(BUFSIZ));
+#endif
+  @(return stream)
+@)
diff --git a/src/clos/boot.lsp b/src/clos/boot.lsp
new file mode 100644
index 000000000..8280d0956
--- /dev/null
+++ b/src/clos/boot.lsp
@@ -0,0 +1,142 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; ----------------------------------------------------------------------
+;;; BOOT
+
+(defun boot ()
+  (let ((class (find-class 'class))
+	(built-in (find-class 'built-in)))
+
+    ;; class CLASS	--------
+    (setf (class-slots class)
+	  (parse-slots '((NAME :INITARG :NAME :INITFORM NIL)
+			       (SUPERIORS :INITARG :DIRECT-SUPERCLASSES)
+			       (INFERIORS :INITFORM NIL)
+			       (SLOTS :INITARG :SLOTS))))
+
+    (defmethod OPTIMIZE-SLOT-VALUE ((class class) form) form)
+
+    (defmethod OPTIMIZE-SET-SLOT-VALUE ((class class) form) form)
+
+    (defmethod make-instance ((class class) &rest initargs)
+      (let ((instance (allocate-instance class)))
+	(apply #'initialize-instance instance initargs)
+	instance))
+
+    (defmethod initialize-instance ((class class) 
+				    &rest initargs 
+				    &key direct-superclasses
+				    &allow-other-keys)
+
+	(call-next-method)			; from class T
+
+	;; default inheritance
+	(unless direct-superclasses 
+	  (setf (class-superiors class)
+		(class-default-direct-superclasses class direct-superclasses)))
+	  
+	;; if the class has a name register it in hash table
+	(when (si:sl-boundp (class-name class))
+	  (setf (find-class (class-name class)) class))
+	(dolist (s (class-superiors class)) ; inheritance lattice
+	  (push class (class-inferiors s)))
+	class)
+
+    (defmethod class-default-direct-superclasses ((class class)
+						  supplied-superclasses)
+      (or supplied-superclasses
+	  (list (find-class 't))))
+
+    ;; class BUILT-IN	--------
+    (setf (class-slots built-in)
+	  (parse-slots '((NAME :INITARG :NAME :INITFORM NIL)
+			       (SUPERIORS :INITARG :DIRECT-SUPERCLASSES)
+			       (INFERIORS :INITFORM NIL)
+			       (SLOTS :INITARG :SLOTS))))
+
+    (defmethod slot-value ((self built-in) slot)
+      (let ((position (position slot (class-slots (si:instance-class self))
+				:key #'slotd-name)))
+	(if position
+	    (si:instance-ref self position)
+	    (slot-missing (si:instance-class self) self slot 'slot-value))))
+
+    (defmethod make-instance ((class built-in) &rest initargs)
+      (declare (ignore initargs))
+      (error "The built-in class (~A) cannot be instantiated" class))
+
+    (defmethod initialize-instance ((class built-in)
+				    &rest initargs &key &allow-other-keys)
+
+	(call-next-method)		; from class T
+	
+	;; if the class has a name register it in hash table
+	(when (si:sl-boundp (class-name class))
+	  (setf (find-class (class-name class)) class)) 
+
+	(dolist (s (class-superiors class)) ; inheritance lattice
+	  (push class (class-inferiors s)))
+	class)
+
+    (defmethod print-object ((class built-in) stream)
+      (print-unreadable-object
+       (class stream)
+       (format stream "The ~A ~A" (class-name (si:instance-class class))
+	       (class-name class)))
+      class)
+
+    ;; class T	--------
+    (defmethod initialize-instance ((instance T)
+				    &rest initargs &key &allow-other-keys)
+	(let ((class-slots (class-slots (si:instance-class instance))))
+	  ;; initialize from initforms
+	  (do ((scan class-slots (cdr scan))
+	       (i 0 (1+ i)))
+	      ((null scan))
+	    (when (and (not (si:sl-boundp 
+			     (si:instance-ref instance i)))
+		       (not (eq (slotd-initform (first scan)) 
+				'INITFORM-UNSUPPLIED)))
+	      (si:instance-set instance i
+			       (eval (slotd-initform (first scan))))))
+
+	  ;; initialize from initargs
+	  (do* ((name-loc initargs (cddr name-loc))
+		(name (first name-loc) (first name-loc)))
+	       ((null name-loc))
+	    ;; scan the class-slots to fill them with the initargs
+	    (do ((scan-slot  class-slots (cdr scan-slot))
+		 (index 0 (1+ index)))
+		((null scan-slot) ())
+	      (declare (fixnum index))
+	      ;; if the initarg is associated with a slot
+	      (when (member name (slotd-initargs (first scan-slot)))
+		;; fill the slot
+		(setf (si:instance-ref instance index)
+		      (second name-loc)))
+	      ;; go on scanning the slots because a single initarg
+	      ;; can initialize more than one slot
+	      )))
+      instance)
+
+    (defmethod slot-missing ((class t) object slot-name operation 
+			     &optional new-value)
+      (declare (ignore operation new-value))
+      (error "~A is not a slot of ~A" slot-name object))
+
+    (defmethod slot-unbound ((class t) object slot-name)
+      (error "the slot ~A of ~A is unbound" slot-name object))
+    ))
+
+(boot)
+
+;;; ----------------------------------------------------------------------
diff --git a/src/clos/builtin.lsp b/src/clos/builtin.lsp
new file mode 100644
index 000000000..914795fee
--- /dev/null
+++ b/src/clos/builtin.lsp
@@ -0,0 +1,184 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; ----------------------------------------------------------------------
+;;; Built-in classes
+;;; ----------------------------------------------------------------------
+
+;;; ----------------------------------------------------------------------
+;;; Predefined Common Lisp Classes
+
+;(defclass t (object) () (:metaclass built-in))
+
+(defclass array (t) () (:metaclass built-in))
+(defclass sequence (t) () (:metaclass built-in))
+   (defclass list (sequence) () (:metaclass built-in))
+      (defclass cons (list) () (:metaclass built-in))
+   (defclass string (array sequence) () (:metaclass built-in))
+   (defclass vector (array sequence) () (:metaclass built-in))
+      (defclass bit-vector (vector) () (:metaclass built-in))
+
+(defclass character (t) () (:metaclass built-in))
+
+(defclass number (t) () (:metaclass built-in))
+   (defclass complex (number) () (:metaclass built-in))
+   (defclass float (number) () (:metaclass built-in))
+   (defclass rational (number) () (:metaclass built-in))
+      (defclass integer (rational) () (:metaclass built-in))
+      (defclass ratio (rational) () (:metaclass built-in))
+
+(defclass symbol (t) () (:metaclass built-in))
+   (defclass null (symbol list) () (:metaclass built-in))
+   (defclass keyword (symbol) () (:metaclass built-in))
+
+(defclass pathname (t) () (:metaclass built-in))
+   (defclass logical-pathname (pathname) () (:metaclass built-in))
+
+;;; Now we protect classes from redefinition:
+(defun setf-find-class (name new-value)
+  (cond
+   ((member name '(T NIL NULL SYMBOL KEYWORD ATOM CONS LIST SEQUENCE
+		     NUMBER INTEGER BIGNUM RATIONAL RATIO FLOAT
+		     SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT COMPLEX
+		     CHARACTER STANDARD-CHAR BASE-CHAR EXTENDED-CHAR
+		     PACKAGE STREAM PATHNAME READTABLE HASH-TABLE RANDOM-STATE
+		     STRUCTURE ARRAY SIMPLE-ARRAY FUNCTION COMPILED-FUNCTION
+		     LOGICAL-PATHNAME))
+    (error "The class associated to the CL specifier ~S cannot be changed."
+	   name))
+   ((member name '(CLASS BUILT-IN) :test #'eq)
+    (error "The kernel CLOS class ~S cannot be changed." name))
+   ((classp new-value)
+    (setf (gethash name si:*class-name-hash-table*) new-value))
+   ((null new-value) (remhash name si:*class-name-hash-table*))
+   (t (error "~A is not a class." new-value))))
+
+;;; ----------------------------------------------------------------------
+;;; Methods
+
+(defmethod make-instance ((class-name symbol) &rest initargs)
+  (apply #'make-instance (find-class class-name) initargs))
+
+(defmethod change-class ((instance t) (new-class symbol))
+  (funcall #'change-class instance (find-class new-class)))
+
+;;; ----------------------------------------------------------------------
+;;; Structures
+;;; ----------------------------------------------------------------------
+
+(defun create-structure-class (name
+			       superclasses-names
+			       direct-slots all-slots
+			       default-initargs documentation)
+  (declare (ignore class-slots default-initargs documentation))
+  (dolist (slot all-slots)
+    (unless (eq :INSTANCE (slotd-allocation slot))
+      (error "The structure class ~S can't have shared slots" name)))
+  (let* ((metaclass (find-class 'STRUCTURE-CLASS))
+	 (existing (find-class name nil))
+	 (superclasses (mapcar #'find-class superclasses-names))
+	 (cpl (compute-class-precedence-list name superclasses)))
+
+    (flet ((unchanged-class ()
+	     (and existing
+		  (eq metaclass (si:instance-class existing))
+		  (equal (or superclasses-names '(STRUCTURE-OBJECT))
+			 ;; i.e. class-default-direct-superclasses
+			 (mapcar #'(lambda (x) (class-name x))
+				 (class-superiors existing)))
+		  (equal all-slots (slot-value existing 'SLOTS))
+		  (prog2 (setf (slot-value existing 'DOCUMENTATION)
+			       documentation)
+		      t))))
+
+      (if (unchanged-class)
+	  existing
+	  (make-instance metaclass
+			 :name name
+			 :direct-superclasses superclasses
+			 :slots all-slots
+			 :class-precedence-list cpl)))))
+
+;;; the method to make instances of structure-class
+#+nil
+(defmethod make-instance ((class structure-metaclass) &rest initargs)
+  (let ((instance (allocate-instance class)))
+    (apply #'initialize-instance instance initargs)
+    instance))
+
+;;; -----------------------------------------------------------------------
+;;; Structure-class
+
+(defclass structure-class (class)
+  ;; class-precedence-list must be in the same position as in standard-class
+  ((precedence-list :initarg :class-precedence-list)
+   slot-descriptions initial-offset defstruct-form constructors documentation
+		     copier predicate print-function)
+  (:metaclass class))
+
+;;; structure-classes cannot be instantiated
+(defmethod make-instance ((class structure-class) &rest initargs)
+  (declare (ignore initargs))
+  (error "The structure-class (~A) cannot be instantiated" class))
+
+;;; the method to initialize the instances of structure-class
+(defmethod initialize-instance ((class structure-class)
+				&rest initargs &key &allow-other-keys)
+    (call-next-method)				; from class T
+    
+    ;; if the class has a name register it in hash table
+    (when (system:sl-boundp (class-name class))
+      (setf (find-class (class-name class)) class))
+
+  (dolist (s (class-superiors class))	; inheritance lattice
+	  (push class (class-inferiors s)))
+  (push class (slot-value class 'PRECEDENCE-LIST)) ;; add itself in cpl
+  class)
+
+;;; ----------------------------------------------------------------------
+;;; Structure-object
+;;; ----------------------------------------------------------------------
+
+;;; Structure-object has no slots and inherits only from t:
+;;; (defclass structure-object (t) ())
+
+(eval-when
+ (compile load eval)
+ (make-instance (find-class 'STANDARD-CLASS)
+		:name 'STRUCTURE-OBJECT
+		:direct-superclasses (list (find-class 't))
+		:slots ()
+		:class-precedence-list ()
+		:slot-index-table ()
+		:direct-slots ()
+		:default-initargs ()
+		:documentation "The root of inheritance for structures"))
+
+(defmethod print-object ((obj structure-object) stream)
+  (let* ((class (si:instance-class obj))
+	 (slotds (class-slots class)))
+    (princ "#S(" stream)
+    (prin1 (class-name class) stream)
+    (do ((scan slotds (cdr scan))
+	 (i 0 (1+ i))
+	 (sv))
+	((null scan))
+	(declare (fixnum i))
+	(setq sv (si:instance-ref obj i))
+	(princ " " stream)
+	(prin1 (slotd-name (car scan)) stream)
+	(princ " " stream)
+	(prin1 sv stream)
+	)
+    (princ ")" stream)
+    obj))
+
+;;; ----------------------------------------------------------------------
diff --git a/src/clos/change.lsp b/src/clos/change.lsp
new file mode 100644
index 000000000..731ce6c20
--- /dev/null
+++ b/src/clos/change.lsp
@@ -0,0 +1,176 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; The mechanism for updating classes.
+
+;;; ----------------------------------------------------------------------
+;;; Invalid Class
+;;; ----------------------------------------------------------------------
+
+(defclass invalid () ())
+
+(defmethod OPTIMIZE-SLOT-VALUE ((class class) form) form)
+    
+(defmethod OPTIMIZE-SET-SLOT-VALUE ((class class) form) form)
+
+(defmethod slot-value ((object invalid) slot-name)
+  ;; first update the instance
+  (update-instance object)
+  ;; now access the slot
+  (slot-value object slot-name))
+
+(defmethod (setf slot-value) (val (object invalid) slot-name)
+  ;; first update the instance
+  (update-instance object)
+  ;; now modify the slot
+  (setf (slot-value object slot-name) val))
+
+;;; ----------------------------------------------------------------------
+
+(defmethod class-instance-slot-count ((class class))
+    (let ((count 0))
+      (declare (fixnum count))
+      (dolist (slot (class-slots class))
+	(when (eq :INSTANCE (slotd-allocation slot))
+	  (incf count)))
+      count))
+
+(defun update-instance (instance)
+  (let* ((old-class (class-of instance))
+	 (new-class (slot-value old-class 'FORWARD))
+					; was saved here by redefine-class
+	 (old-slots (class-slots old-class))
+	 (new-slots (class-slots new-class))
+	 discarded-slots
+	 added-slots
+	 retained-correspondance
+	 property-list
+	 position)
+    ;; dont (declare (fixnum position)) otherwise if position will fail.
+    (unless (equal old-slots new-slots)
+      (setq discarded-slots
+	    (set-difference (mapcar #'slotd-name old-slots)
+			    (mapcar #'slotd-name new-slots)))
+      ;; compute the property list
+      (dolist (slot-name discarded-slots)
+	;; can't use slot-value or we loop
+	(push (cons slot-name (standard-instance-get instance slot-name))
+	      property-list)))
+
+    ;; compute retained local slots and update instance:
+    (let ((new-i 0)
+	  (old-i 0)
+	  (index-table (slot-index-table old-class))
+	  name
+	  old-slot)
+      (declare (fixnum new-i old-i))
+      (dolist (new-slot new-slots)
+	(setq name (slotd-name new-slot)
+	      old-slot (find name old-slots :key #'slotd-name :test #'eq))
+	(if old-slot
+	    (when (and (eq :INSTANCE (slotd-allocation new-slot))
+		       (eq :INSTANCE (slotd-allocation old-slot)))
+	      (push (cons new-i (gethash name index-table))
+		    retained-correspondance))
+	    (push new-slot added-slots))
+	(incf new-i))
+
+      (si:change-instance instance new-class
+			  (class-instance-slot-count new-class)
+			  (nreverse retained-correspondance)))
+
+    ;; initialize newly added slots
+    (update-instance-for-redefined-class instance added-slots
+					 discarded-slots property-list)
+    ))
+
+(defun remove-optional-slot-accessors (class)
+  (let ((class-name (class-name class)))
+    (dolist (slotd (class-slots class))
+      
+      (dolist (accessor (slotd-accessors slotd))
+	(let* ((gfun (symbol-function accessor))
+	       (gf-object (si:gfun-instance gfun))
+	       (setf-accessor (list 'setf accessor))
+	       (setf-gfun (symbol-function setf-accessor))
+	       (setf-gf-object (si:gfun-instance setf-gfun))
+	       found)
+	  ;; primary reader method
+	  (when (setq found
+		      (find-method gf-object nil (list class-name) nil))
+	    (remove-method gf-object found))
+	  ;; before reader method
+	  (when (setq found
+		      (find-method gf-object ':before (list class-name) nil))
+	    (remove-method gf-object found))
+	  ;; after reader method
+	  (when (setq found
+		      (find-method gf-object ':after (list class-name) nil))
+	    (remove-method gf-object found))
+	  (when (null (methods gf-object))
+	    (fmakunbound accessor))
+	  ;; primary writer method
+	  (when (setq found
+		      (find-method setf-gf-object nil (list nil class-name) nil))
+	    (remove-method setf-gf-object found))
+	  ;; before writer method
+	  (when (setq found
+		      (find-method setf-gf-object ':before (list nil class-name) nil))
+	    (remove-method setf-gf-object found))
+	  ;; after writer method
+	  (when (setq found
+		      (find-method setf-gf-object ':after (list nil class-name) nil))
+	    (remove-method setf-gf-object found))
+	  (when (null (methods gf-object))
+	    (fmakunbound setf-accessor))))
+      
+      ;; remove previous defined reader methods
+      (dolist (reader (slotd-readers slotd))
+	(let* ((gfun (symbol-function reader))
+	       (gf-object (si:gfun-instance gfun))
+	       found)
+	  ;; primary method
+	  (when (setq found
+		      (find-method gf-object nil (list class-name) nil))
+	    (remove-method gf-object found))
+	  ;; before method
+	  (when (setq found
+		      (find-method gf-object ':before (list class-name) nil))
+	    (remove-method gf-object found))
+	  ;; after method
+	  (when (setq found
+		      (find-method gf-object ':after (list class-name) nil))
+	    (remove-method gf-object found))
+	(when (null (methods gf-object))
+	  (fmakunbound reader))))
+      
+      ;; remove previous defined writer methods
+      (dolist (writer (slotd-writers slotd))
+	(let* ((gfun (symbol-function writer))
+	       (gf-object (si:gfun-instance gfun))
+	       found)
+	  ;; primary method
+	  (when (setq found
+		      (find-method gf-object nil (list class-name) nil))
+	    (remove-method gf-object found))
+	  ;; before method
+	  (when (setq found
+		      (find-method gf-object ':before (list class-name) nil))
+	    (remove-method gf-object found))
+	  ;; after method
+	  (when (setq found
+		      (find-method gf-object ':after (list class-name) nil))
+	    (remove-method gf-object found))
+	(when (null (methods gf-object))
+	  (fmakunbound writer)))))))
+
+
+;;; ----------------------------------------------------------------------
diff --git a/src/clos/cmpinit.lsp b/src/clos/cmpinit.lsp
new file mode 100644
index 000000000..4dbdb29a8
--- /dev/null
+++ b/src/clos/cmpinit.lsp
@@ -0,0 +1,8 @@
+(defvar std-compile (symbol-function 'compile-file))
+(defun compile-file (file &key (output-file (merge-pathnames file ".o")))
+  (funcall std-compile
+	   file
+	   :c-file t :h-file t :data-file t :system-p t
+	   :output-file nil))
+
+;(setq compiler:*cc* (concatenate 'STRING compiler:*cc* " -I../h"))
diff --git a/src/clos/combin.lsp b/src/clos/combin.lsp
new file mode 100644
index 000000000..a88a787d6
--- /dev/null
+++ b/src/clos/combin.lsp
@@ -0,0 +1,295 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    ECoLisp is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+(defun get-method-qualifiers (method) (nth 1 method))
+
+(defun get-method-function (method) (nth 4 method))
+
+;;; They will be redefined later:
+(proclaim '(notinline get-method-qualifiers get-method-function))
+
+
+;;;
+;;; Convert an effective method form to a compiled effective method function.
+;;; The strategy is to have compiled functions around which are are templates
+;;; for effective method functions.  Then the effective method functions we
+;;; generate are closures over the particular methods in the effective method
+;;; form.  This strategy has the advantage that we don't have to call the
+;;; compiler when we combine new methods.  It also has the advantage that
+;;; same shape effective methods share the same code vector.  It is of course
+;;; predicated on the assumption that funcalling compiled closures is fast.
+;;;
+;;; *effective-method-templates* is a list of effective-method template
+;;; entries.  Each entry is itself a list of the form:
+;;; 
+;;;   (<template> <match-function> <make-code-function> <when> <count>)
+;;;
+;;; The match function is simple-effective-method-match-p.
+;;;
+;;;
+
+(defvar *effective-method-templates* ())
+
+(defun make-effective-method-function (form)
+  (if (and (listp form)
+	   (eq (first form) 'CALL-METHOD)
+	   (method-p (second form))
+	   (every #'method-p (third form)))
+      ;; The effective method is just a call to call-method.  This opens
+      ;; up a possibility of just using the method function of the method
+      ;; being called as the effective method function.
+      ;;
+      ;; But we have to be careful.  We must be sure to communicate the
+      ;; next methods to the method if it needs them.  If there are no
+      ;; next methods we must communicate that fact to prevent the leaky
+      ;; next methods bug.
+      (let ((method-function (get-method-function (second form))))
+	(if (method-needs-next-methods-p (second form))
+	      (let ((next-method-functions
+		     (mapcar #'get-method-function (third form))))
+		#'(lambda (&rest .combined-method-args.)
+		    (let ((*next-methods* next-method-functions))
+		      (apply method-function .combined-method-args.))))
+	  method-function))
+      ;; lookup or add an entry to *effective-method-templates*
+      (let (entry)
+	(dolist (e *effective-method-templates*)
+	  (let ((matchp (funcall (symbol-function (second e)) (first e) form)))
+	    (when matchp (return (setq entry e)))))
+	(unless entry
+	  ;; None of the recorded entries match.  Have to generate a new entry.
+	  (setq entry
+		(multiple-value-bind (template predicate constructor)
+		    (compile-effective-method-template-entry form)
+		  (list template predicate (compile () constructor)
+			'ON-THE-FLY 0)))
+	  (add-effective-method-template-entry entry))
+	(incf (fifth entry))
+	(funcall (third entry) form))))
+
+(defun add-effective-method-template-entry (entry)
+  ;; We keep the list of entries sorted so that the entries with complex
+  ;; match functions stay at the end.  This prevents a newly defined
+  ;; complex match function from slowing down all the more common cases.
+  ;;
+  (setq *effective-method-templates*
+	(merge 'list
+	       *effective-method-templates*
+	       (list entry)
+	       #'(lambda (a b)
+		   (and (eq a 'SIMPLE-EFFECTIVE-METHOD-MATCH-P)
+			(not (eq a b))))
+	       :key #'second)))
+
+(defmacro precompile-effective-method-template
+    (effective-method &optional (when 'PRE-MADE))
+  (multiple-value-bind (template predicate constructor)
+      (compile-effective-method-template-entry effective-method)
+    `(EVAL-WHEN (LOAD)
+      (ADD-EFFECTIVE-METHOD-TEMPLATE-ENTRY
+       (LIST ',template ',predicate (FUNCTION ,constructor) ',when 0)))))
+
+
+(defun compile-effective-method-template-entry (form)
+  (values (walk-form form
+		     nil
+		     #'(lambda (f c e)
+			 (declare (ignore c e))
+			 (if (not (consp f))
+			     f
+			     (if (eq (first f) 'CALL-METHOD)
+				 (if (= (length f) 3)
+				     '(_CALL-METHOD_)
+				     (error "Wrong number of arguments to ~
+                                                call-method."))
+				 f))))
+	  'SIMPLE-EFFECTIVE-METHOD-MATCH-P
+	  (make-simple-effective-method-code-constructor form)))
+
+(defun simple-effective-method-match-p (template form)
+  (labels ((every* (fn l1 l2)
+	     ;; This version of every is slightly different. It
+	     ;; returns NIL if it reaches the end of one of the
+	     ;; lists before reaching the end of the other.
+	     (do ((t1 l1 (rest t1))
+		  (t2 l2 (rest t2)))
+		 (())
+	       (cond ((null t1) (return (null t2)))
+		     ((null t2) (return (null t1)))
+		     ((funcall fn (first t1) (first t2)))
+		     (t (return nil)))))
+	   (walk (tm fm)
+	     (cond ((eq tm fm) t)
+		   ((and (listp tm)
+			 (listp fm))
+		    (if (eq (first fm) 'CALL-METHOD)
+			(eq (first tm) '_CALL-METHOD_)
+			(every* #'walk tm fm)))
+		   ((and (stringp tm)
+			 (stringp fm))
+		    (string-equal tm fm))
+		   (t nil))))
+    (walk template form)))
+
+(defun simple-code-walker (form env walk-function)
+  (if (consp form)
+      (catch form
+	(let ((new (funcall walk-function form :eval nil)))
+	  (walker::recons
+	   new
+	   (simple-code-walker (first new) env walk-function)
+	   (simple-code-walker (rest new) env walk-function))))
+      form))
+
+;;;
+;;; These two functions must to pass the symbols which name the functions
+;;; not the actual functions.  This is done this way because we are going
+;;; to have to compile forms which include them as constants.  Before the
+;;; symbols are actually applied, symbol function is used to get the actual
+;;; function.
+;;; 
+(defun make-simple-effective-method-code-constructor (form)
+  (make-code-constructor form))
+
+(defvar *combined-method-next-methods-gensyms* ())
+(defvar *combined-method-method-function-gensyms* ())
+
+(eval-when (eval load)
+  (dotimes (i 10)
+    (push (make-symbol (format nil ".METHOD-~A-NEXT-METHODS." (- 9 i)))
+	  *combined-method-next-methods-gensyms*)
+    (push (make-symbol (format nil ".METHOD-~A-FUNCTION." (- 9 i)))
+	  *combined-method-method-function-gensyms*)))
+    
+
+(defun make-code-constructor (form)
+  (let* ((method-vars ())
+	 (code-body nil)
+	 (next-method-gensyms *combined-method-next-methods-gensyms*)
+	 (method-function-gensyms *combined-method-method-function-gensyms*))
+    (flet ((convert-function (f c e)
+	     (declare (ignore e))
+	     (cond ((and (listp f)
+			 (eq c ':eval))
+		    (if (or (eq (first f) '_CALL-METHOD_)
+			    (eq (first f) 'CALL-METHOD))
+			(let ((gensym1 (or (pop method-function-gensyms)
+					   (gensym)))
+			      (gensym2 (or (pop next-method-gensyms)
+					   (gensym))))
+			  (push gensym1 method-vars)
+			  (push gensym2 method-vars)
+			  `(LET ((*NEXT-METHODS* ,gensym2))
+			     (DECLARE (SPECIAL *NEXT-METHODS*))
+			     (APPLY ,gensym1 .COMBINED-METHOD-ARGS.)))
+			f))
+		   ((method-p f)
+		    (error "Effective method body must be malformed."))
+		   (t f))))
+      (setq code-body (simple-code-walker form nil #'convert-function))
+      ;;
+      ;; This is written in a slightly screwey way because of a bug in the
+      ;; 3600 compiler.  Basically, if both of the funargs in the compiled
+      ;; up function close over method-vars the 3600 compiler loses.
+      ;; 
+      `(LAMBDA (.FORM.)
+	 (LET ((METHODS NIL) ,@method-vars)
+	   (SIMPLE-CODE-WALKER
+	    .FORM.
+	    NIL
+	    #'(lambda (f c e)
+		(declare (ignore e))
+		(if (and (eq c ':eval)
+			 (listp f)
+			 (eq (first f) 'CALL-METHOD))
+		    (progn 
+		      (push (get-method-function (second f)) methods)
+		      (PUSH (THIRD F) methods)
+		      (throw f f))
+		    f)
+		f))
+	   ,@(do ((mvs method-vars (cddr mvs))
+		  (setqs))
+		 ((null mvs) (nreverse setqs))
+		 (push `(SETQ ,(first mvs)
+			      (mapcar #'convert-effective-method
+				      (pop methods)))
+		       setqs)
+		 (push `(SETQ ,(second mvs) (pop methods)) setqs))
+	   #'(LAMBDA (&REST .COMBINED-METHOD-ARGS.)
+	       ,code-body))))))
+
+
+
+(defun convert-effective-method (effective-method)
+  (cond ((method-p effective-method)
+	 (get-method-function effective-method))
+	((and (listp effective-method)
+	      (eq (first effective-method) 'MAKE-METHOD))
+	 (make-effective-method-function
+	   (make-progn (second effective-method))))
+	(t
+	 (error "Effective-method form is malformed."))))
+
+(defun make-method-call (method &optional next-methods)
+  `(CALL-METHOD ,method ,next-methods))
+
+(defun make-progn (&rest forms)
+  (let ((progn-form nil))
+    (labels ((collect-forms (forms)
+	       (when forms
+		 (collect-forms (rest forms))
+		 (if (and (listp (first forms))
+			  (eq (caar forms) 'PROGN))
+		     (collect-forms (cdar forms))
+		     (push (first forms) progn-form)))))
+      (collect-forms forms)
+      (cons 'PROGN progn-form))))
+
+
+(defun compute-combined-method (gf methods)
+  (declare (ignore gf))
+  (let ((before ())
+	(primary ())
+	(after ())
+	(around ()))
+    (dolist (m methods)
+      (let ((qualifiers (get-method-qualifiers m)))
+	(cond ((member :BEFORE qualifiers) (push m before))
+	      ((member :AFTER  qualifiers) (push m after))
+	      ((member :AROUND  qualifiers) (push m around))
+	      (t
+	       (push m primary)))))
+    (setq before (nreverse before)
+	  after (nreverse after)
+	  primary (nreverse primary)
+	  around (nreverse around))
+
+    (make-effective-method-function
+     (if (and (null before)
+	      (null after))
+	 (if (null around)
+	     ;; By returning a single call-method `form' here we enable
+	     ;; an important implementation-specific optimization.
+	     `(CALL-METHOD ,(first primary) ,(rest primary))
+	     `(CALL-METHOD ,(first around) ,(append (rest around) primary)))
+	 (let ((main-effective-method
+		`(PROGN ,@(mapcar #'make-method-call before)
+		  (MULTIPLE-VALUE-PROG1
+		      ,(if primary
+			   `(CALL-METHOD ,(first primary) ,(rest primary))
+			   '(error "No applicable primary method."))
+		    ,@(mapcar #'make-method-call after)))))
+	   (if around
+	       `(CALL-METHOD ,(first around)
+		 (,@(rest around)
+		  (MAKE-METHOD ,main-effective-method)))
+	       main-effective-method))))))
diff --git a/src/clos/conditions.lsp b/src/clos/conditions.lsp
new file mode 100644
index 000000000..da2492220
--- /dev/null
+++ b/src/clos/conditions.lsp
@@ -0,0 +1,816 @@
+;;;;  Copyright (c) 2001, Juan Jose Garcia-Ripoll
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;
+;;; conditions.lsp
+;;;
+;;; Originally written by Kent M. Pitman of Symbolics, Inc. and
+;;; distributed without any copyright.
+;;; This is Version 18.
+;;;
+;;; KMP's disclaimer:
+;;;
+;;; This is a sample implementation. It is not in any way intended as the
+;;; definition of any aspect of the condition system. It is simply an existence
+;;; proof that the condition system can be implemented.
+;;;
+
+(in-package "SYSTEM")
+
+;;; ----------------------------------------------------------------------
+;;; ECLS's interface to the toplevel and debugger
+
+(defun invoke-debugger (&optional (datum "Debug") &rest arguments)
+  (let ((condition
+	 (coerce-to-condition datum arguments 'simple-condition 'debug)))
+    (when *ignore-errors*
+      (setq *ignore-errors* nil)
+      (setq *last-error* condition)
+      (throw *ignore-errors-tag* 'ERROR))
+    (break-level t (format t "~&~A~%" condition))))
+
+(defun break-level (continuable *break-message*)
+  (unless *break-enable*
+    (throw *quit-tag* nil))
+  (let ((*break-level* (1+ *break-level*))
+	(*break-env* nil)
+	(*standard-input* *debug-io*)
+	(*standard-output* *debug-io*)
+	(*readtable* (or *break-readtable* *readtable*)))
+    (catch *continue-tag*
+      (when (listen *debug-io*)
+	(clear-input *debug-io*))
+      (tpl :continuable continuable
+	   :commands (adjoin break-commands *tpl-commands*)))))
+
+(defun sys::universal-error-handler (continue-string datum args)
+  (declare (inline apply) ;; So as not to get bogus frames in debugger
+	   (ignore error-name))
+  (let ((condition (coerce-to-condition datum args 'simple-error 'error)))
+    (when *ignore-errors*
+      (setq *ignore-errors* nil)
+      (setq *last-error* condition)
+      (throw *ignore-errors-tag* 'ERROR))
+    (if continue-string
+      (with-simple-restart
+	  (continue "~A" (format nil "~?" continue-string args))
+	(signal condition)
+	(invoke-debugger condition))
+      (progn
+	(signal condition)
+	(invoke-debugger condition)))))
+
+(defun sys::tpl-continue-command (&rest any)
+  (apply #'invoke-restart 'continue any))
+
+;;; ----------------------------------------------------------------------
+;;; Unique Ids
+
+(defmacro unique-id (obj)
+  "Generates a unique integer ID for its argument."
+  `(sys:pointer ,obj))
+
+
+;;; Restarts
+
+(defvar *restart-clusters* '())
+
+;;; do we need copy-list if *restart-clusters* has only one element? Beppe
+(defun compute-restarts () (apply #'append *restart-clusters*))
+
+(defun restart-print (restart stream depth)
+  (declare (ignore depth))
+  (if *print-escape*
+      (format stream "#<~s.~d>" (type-of restart) (unique-id restart))
+      (restart-report restart stream)))
+
+(defstruct (restart (:PRINT-FUNCTION restart-print))
+  name
+  function
+  report-function
+  interactive-function)
+
+(defun restart-report (restart stream)
+  (let ((fn (restart-report-function restart)))
+    (if fn
+	(funcall fn stream)
+	(format stream "~s" (or (restart-name restart) restart)))))
+
+(defmacro restart-bind (bindings &body forms)
+  `(let ((*restart-clusters*
+	  (cons (list ,@(mapcar #'(lambda (binding)
+				    `(make-restart
+				      :NAME     ',(car binding)
+				      :FUNCTION ,(cadr binding)
+				      ,@(cddr binding)))
+				bindings))
+		*restart-clusters*)))
+     ,@forms))
+
+(defun find-restart (name)
+  (dolist (restart-cluster *restart-clusters*)
+    (dolist (restart restart-cluster)
+      (when (or (eq restart name) (eq (restart-name restart) name))
+	(return-from find-restart restart)))))
+  
+(defun invoke-restart (restart &rest values)
+  (let ((real-restart (or (find-restart restart)
+			  (error "Restart ~S is not active." restart))))
+    (apply (restart-function real-restart) values)))
+
+(defun invoke-restart-interactively (restart)
+  (let ((real-restart (or (find-restart restart)
+			  (error "Restart ~S is not active." restart))))
+    (apply (restart-function real-restart)
+	   (let ((interactive-function
+		   (restart-interactive-function real-restart)))
+	     (if interactive-function
+		 (funcall interactive-function)
+		 '())))))
+
+
+(defmacro restart-case (expression &body clauses)
+  (flet ((transform-keywords (&key report interactive)
+	   (let ((keywords '()))
+	     (when interactive
+	       (setq keywords (list :INTERACTIVE-FUNCTION
+				    `#',interactive)))
+	     (when report
+	       (setq keywords (list* :REPORT-FUNCTION
+				     (if (stringp report)
+					 `#'(lambda (stream)
+					      (write-string ,report stream))
+					 `#',report)
+				     keywords)))
+	     keywords)))
+    (let ((block-tag (gensym))
+	  (temp-var  (gensym))
+	  (data (mapcar #'(lambda (clause)
+			    (let (keywords (forms (cddr clause)))
+			      (do ()
+				  ((null forms))
+				(if (keywordp (car forms))
+				    (setq keywords (list* (car forms)
+							  (cadr forms)
+							  keywords)
+					  forms (cddr forms))
+				    (return)))
+			      (list (car clause) 		;Name=0
+				    (gensym) 			;Tag=1
+				    (apply #'transform-keywords ;Keywords=2
+					   keywords)
+				    (cadr clause)		;BVL=3
+				    forms))) 			;Body=4
+			clauses)))
+      `(block ,block-tag
+	 (let ((,temp-var nil))
+	   (tagbody
+	     (restart-bind
+	       ,(mapcar #'(lambda (datum)
+			    (let ((name (nth 0 datum))
+				  (tag  (nth 1 datum))
+				  (keys (nth 2 datum)))
+			      `(,name #'(lambda (&rest temp)
+					  (setq ,temp-var temp)
+					  (go ,tag))
+				,@keys)))
+			data)
+	       (return-from ,block-tag ,expression))
+	     ,@(mapcan #'(lambda (datum)
+			   (let ((tag  (nth 1 datum))
+				 (bvl  (nth 3 datum))
+				 (body (nth 4 datum)))
+			     (list tag
+				   `(return-from ,block-tag
+				      (apply #'(lambda ,bvl ,@body)
+					     ,temp-var)))))
+		       data)))))))
+
+(defmacro with-simple-restart ((restart-name format-control
+					     &rest format-arguments)
+			       &body forms)
+  `(restart-case (progn ,@forms)
+     (,restart-name ()
+        :REPORT (lambda (stream)
+		  (format stream ,format-control ,@format-arguments))
+      (values nil t))))
+
+
+;;; ----------------------------------------------------------------------
+;;; Condition Data Type
+
+(defun condition-print (condition stream depth)
+  (declare (ignore depth))
+  (if *print-escape*
+      (format stream "#<~S.~D>" (type-of condition) (unique-id condition))
+      (funcall (slot-value condition 'REPORT) condition stream)))
+
+(defclass condition () ())
+
+(defmacro define-condition (name parent-list slot-specs &rest options)
+  (let* ((report-function nil)
+	 (documentation nil))
+    (dolist (option options)
+      (case (car option)
+	(:REPORT (setq report-function (cadr option)))
+	(:DOCUMENTATION (setq documentation (cadr option)))
+	(otherwise (cerror "Ignore this DEFINE-CONDITION option."
+			   "Invalid DEFINE-CONDITION option: ~S" option))))
+    `(PROGN
+      (DEFCLASS ,name ,parent-list ,slot-specs)
+      ,@(when report-function
+	      `((defmethod print-object ((X ,name) stream)
+		    (if *print-escape*
+		      (call-next-method)
+		      ,(if (stringp report-function)
+			   `(write-string ,report-function stream)
+			   `(,report-function x stream))))))
+      ,@(when documentation
+	      `(EVAL-WHEN (COMPILE LOAD EVAL)
+		(SETF (GET ',name 'DOCUMENTATION) ',documentation)))
+      ',NAME)))
+
+(defun make-condition (type &rest slot-initializations)
+  (unless (subtypep type 'CONDITION)
+    (error 'SIMPLE-TYPE-ERROR
+	   :DATUM type
+	   :EXPECTED-TYPE 'CONDITION
+	   :FORMAT-CONTROL "Not a condition type: ~S"
+	   :FORMAT-ARGUMENTS (list type)))
+  (apply #'make-instance type slot-initializations))
+
+#| For the moment, do not redefine these. Beppe.
+(eval-when (eval compile load)
+
+(defun accumulate-cases (macro-name cases list-is-atom-p)
+  (do ((c cases (cdr c))
+       (l '()))
+      ((null c) (nreverse l))
+    (let ((keys (caar c)))
+      (cond ((atom keys)
+	     (cond ((null keys))
+		   ((member keys '(OTHERWISE T))
+		    (error "OTHERWISE is not allowed in ~S expressions."
+			   macro-name))
+		   (t (push keys l))))
+	    (list-is-atom-p
+	     (push keys l))
+	    (t (setq l (append keys l)))))))
+
+);nehw-lave
+
+(defmacro ecase (keyform &rest cases)
+  (let ((keys (accumulate-cases 'ECASE cases nil)))
+    `(case ,keyform
+      ,@cases
+      (otherwise
+       (error 'CASE-FAILURE :name 'ECASE
+	:datum ,keyform
+	:expected-type '(MEMBER ,@keys)
+	:possibilities ',keys))))))
+
+(defmacro ccase (keyplace &rest cases)
+  (let ((keys (accumulate-cases 'CCASE cases nil))
+	(tag1 (gensym))
+	(tag2 (gensym)))
+    `(block ,tag1
+       (tagbody ,tag2
+	 (return-from ,tag1
+	   (case ,keyplace
+	     ,@cases
+	     (otherwise
+	       (restart-case (error 'CASE-FAILURE
+				    :name 'CCASE
+				    :datum ,keyplace
+				    :expected-type '(MEMBER ,@keys)
+				    :possibilities ',keys)
+		 (store-value (value)
+		     :report (lambda (stream)
+			       (format stream "Supply a new value of ~S."
+				       ',keyplace))
+		     :interactive read-evaluated-form
+		   (setf ,keyplace value)
+		   (go ,tag2))))))))))
+
+
+
+(defmacro etypecase (keyform &rest cases)
+  (let ((types (accumulate-cases 'ETYPECASE cases t)))
+    `(typecase ,keyform
+      ,@cases
+      (otherwise
+       (error 'CASE-FAILURE :name 'ETYPECASE
+	:datum ,keyform
+	:expected-type '(OR ,@types)
+	:possibilities ',types)))))
+
+(defmacro ctypecase (keyplace &rest cases)
+  (let ((types (accumulate-cases 'CTYPECASE cases t))
+	(tag1 (gensym))
+	(tag2 (gensym)))
+    `(block ,tag1
+       (tagbody ,tag2
+	 (return-from ,tag1
+	   (typecase ,keyplace
+	     ,@cases
+	     (otherwise
+	       (restart-case (error 'CASE-FAILURE
+				    :name 'CTYPECASE
+				    :datum ,keyplace
+				    :expected-type '(OR ,@types)
+				    :possibilities ',types)
+		 (store-value (value)
+		     :REPORT (lambda (stream)
+			       (format stream "Supply a new value of ~S."
+				       ',keyplace))
+		     :INTERACTIVE read-evaluated-form
+		   (setf ,keyplace value)
+		   (go ,tag2))))))))))
+
+|#
+
+
+(defun assert-report (names stream)
+  (format stream "Retry assertion")
+  (if names
+      (format stream " with new value~P for ~{~S~^, ~}."
+	      (length names) names)
+      (format stream ".")))
+
+(defun assert-prompt (name value)
+  (cond ((y-or-n-p "The old value of ~S is ~S.~
+		  ~%Do you want to supply a new value? "
+		   name value)
+	 (format *query-io* "~&type a form to be evaluated:~%")
+	 (flet ((read-it () (eval (read *query-io*))))
+	   (if (symbolp name) ;Help user debug lexical variables
+	       (progv (list name) (list value) (read-it))
+	       (read-it))))
+	(t value)))
+
+(defun simple-assertion-failure (assertion)
+  (error 'SIMPLE-TYPE-ERROR
+	 :DATUM assertion
+	 :EXPECTED-TYPE nil		; This needs some work in next revision. -kmp
+	 :FORMAT-CONTROL "The assertion ~S failed."
+	 :FORMAT-ARGUMENTS (list assertion)))
+
+(defmacro assert (test-form &optional places datum &rest arguments)
+  (let ((tag (gensym)))
+    `(tagbody ,tag
+       (unless ,test-form
+	 (restart-case ,(if datum
+			    `(error ,datum ,@arguments)
+			    `(simple-assertion-failure ',test-form))
+	   (continue ()
+	       :REPORT (lambda (stream) (assert-report ',places stream))
+	     ,@(mapcar #'(lambda (place)
+			   `(setf ,place (assert-prompt ',place ,place)))
+		       places)
+             (go ,tag)))))))
+
+
+
+(defun read-evaluated-form ()
+  (format *query-io* "~&Type a form to be evaluated:~%")
+  (list (eval (read *query-io*))))
+
+(defmacro check-type (place type &optional type-string)
+  (let ((tag1 (gensym))
+	(tag2 (gensym)))
+    `(block ,tag1
+       (tagbody ,tag2
+	 (if (typep ,place ',type) (return-from ,tag1 nil))
+	 (restart-case ,(if type-string
+			    `(error "The value of ~S is ~S, ~
+				     which is not ~A."
+				    ',place ,place ,type-string)
+			    `(error "The value of ~S is ~S, ~
+				     which is not of type ~S."
+				    ',place ,place ',type))
+	   (store-value (value)
+	       :REPORT (lambda (stream)
+			 (format stream "Supply a new value of ~S."
+				 ',place))
+	       :INTERACTIVE read-evaluated-form
+	     (setf ,place value)
+	     (go ,tag2)))))))
+
+(defvar *handler-clusters* nil)
+
+(defmacro handler-bind (bindings &body forms)
+  (unless (every #'(lambda (x) (and (listp x) (= (length x) 2))) bindings)
+    (error "Ill-formed handler bindings."))
+  `(let ((*handler-clusters*
+	  (cons (list ,@(mapcar #'(lambda (x) `(cons ',(car x) ,(cadr x)))
+				bindings))
+		*handler-clusters*)))
+     ,@forms))
+
+(defvar *break-on-signals* nil)
+
+(defun signal (datum &rest arguments)
+  (let ((condition
+	 (coerce-to-condition datum arguments 'SIMPLE-CONDITION 'SIGNAL))
+        (*handler-clusters* *handler-clusters*))
+    (if (typep condition *break-on-signals*)
+	(break "~A~%Break entered because of *BREAK-ON-SIGNALS*."
+	       condition))
+    (loop (unless *handler-clusters* (return))
+          (let ((cluster (pop *handler-clusters*)))
+	    (dolist (handler cluster)
+	      (when (typep condition (car handler))
+		(funcall (cdr handler) condition)
+		(return nil) ;?
+		))))
+    nil))
+
+
+
+;;; COERCE-TO-CONDITION
+;;;  Internal routine used in ERROR, CERROR, BREAK, and WARN for parsing the
+;;;  hairy argument conventions into a single argument that's directly usable 
+;;;  by all the other routines.
+
+(defun coerce-to-condition (datum arguments default-type function-name)
+  (cond ((typep datum 'CONDITION)
+	 (when arguments
+	   (cerror "Ignore the additional arguments."
+		   'SIMPLE-TYPE-ERROR
+		   :DATUM arguments
+		   :EXPECTED-TYPE 'NULL
+		   :FORMAT-CONTROL "You may not supply additional arguments ~
+				     when giving ~S to ~S."
+		   :FORMAT-ARGUMENTS (list datum function-name)))
+	 datum)
+        ((symbolp datum)                  ;roughly, (subtypep datum 'CONDITION)
+         (apply #'make-condition datum arguments))
+        ((stringp datum)
+	 (make-condition default-type
+                         :FORMAT-CONTROL datum
+                         :FORMAT-ARGUMENTS arguments))
+        (t
+         (error 'SIMPLE-TYPE-ERROR
+		:DATUM datum
+		:EXPECTED-TYPE '(OR SYMBOL STRING)
+		:FORMAT-CONTROL "Bad argument to ~S: ~S"
+		:FORMAT-ARGUMENTS (list function-name datum)))))
+
+(defun break (&optional (format-control "Break") &rest format-arguments)
+  (with-simple-restart (continue "Return from BREAK.")
+    (invoke-debugger
+      (make-condition 'SIMPLE-CONDITION
+		      :FORMAT-CONTROL    format-control
+		      :FORMAT-ARGUMENTS format-arguments)))
+  nil)
+
+(define-condition warning (condition) ())
+
+(defun warn (datum &rest arguments)
+  (let ((condition
+	  (coerce-to-condition datum arguments 'SIMPLE-WARNING 'WARN)))
+    (check-type condition warning "a warning condition")
+    (if *break-on-warnings*
+	(break "~A~%Break entered because of *BREAK-ON-WARNINGS*."
+	       condition))
+    (restart-case (signal condition)
+      (muffle-warning ()
+	  :REPORT "Skip warning."
+	(return-from warn nil)))
+    (format *error-output* "~&Warning:~%~A~%" condition)
+    nil))
+
+
+
+(define-condition serious-condition (condition) ())
+
+(define-condition error (serious-condition) ())
+
+(defun simple-condition-printer (condition stream)
+  (format stream "~?" (format-control condition) (format-arguments condition)))
+
+(define-condition simple-condition (condition)
+  ((format-control :INITARG :FORMAT-CONTROL :INITFORM "" :ACCESSOR format-control)
+   (format-arguments :INITARG :FORMAT-ARGUMENTS :ACCESSOR format-arguments))
+  (:REPORT simple-condition-printer))
+
+(define-condition simple-warning (simple-condition warning)
+  () (:REPORT simple-condition-printer))
+
+(define-condition simple-error (simple-condition error) ())
+
+(define-condition storage-condition (serious-condition) ())
+
+(define-condition stack-overflow    (storage-condition) ())
+
+(define-condition storage-exhausted (storage-condition) ())
+
+(define-condition type-error (error)
+  ((datum :INITARG :DATUM :READER type-error-datum)
+   (expected-type :INITARG :EXPECTED-TYPE :READER type-error-expected-type))
+  (:REPORT
+   (lambda (condition stream)
+     (format stream "~S is not of type ~S."
+	     (type-error-datum condition)
+	     (type-error-expected-type condition)))))
+
+(define-condition simple-type-error (simple-condition type-error) ())
+
+(define-condition case-failure (type-error)
+  ((name :INITARG :NAME :READER case-failure-name)
+   (possibilities :INITARG :POSSIBILITIES :READER case-failure-possibilities))
+  (:REPORT
+   (lambda (condition stream)
+     (format stream "~S fell through ~S expression.~%Wanted one of ~:S."
+	     (type-error-datum condition)
+	     (case-failure-name condition)
+	     (case-failure-possibilities condition)))))
+
+(define-condition program-error (error) ())
+
+(define-condition control-error (error) ())
+
+(define-condition stream-error (error)
+  ((stream :INITARG :STREAM :READER stream-error-stream)))
+
+(define-condition end-of-file (stream-error)
+  ()
+  (:REPORT (lambda (condition stream)
+	     (format stream "Unexpected end of file on ~S."
+		     (stream-error-stream condition)))))
+
+(define-condition file-error (error)
+  ((pathname :INITARG :PATHNAME :READER file-error-pathname)))
+
+(define-condition package-error (error)
+  ((package :INITARG :PACKAGE :READER package-error-package)))
+
+(define-condition cell-error (error)
+  ((name :INITARG :NAME :READER cell-error-name)))
+
+(define-condition unbound-variable (cell-error)
+  ()
+  (:REPORT (lambda (condition stream)
+	     (format stream "The variable ~S is unbound."
+		     (cell-error-name condition)))))
+  
+(define-condition undefined-function (cell-error)
+  ()
+  (:REPORT (lambda (condition stream)
+	     (format stream "The function ~S is undefined."
+		     (cell-error-name condition)))))
+
+(define-condition arithmetic-error (error)
+  ((operation :INITARG :OPERATION :READER arithmetic-error-operation)))
+
+(define-condition division-by-zero         (arithmetic-error) ())
+
+(define-condition floating-point-overflow  (arithmetic-error) ())
+
+(define-condition floating-point-underflow (arithmetic-error) ())
+
+(define-condition abort-failure (control-error) ()
+  (:REPORT (lambda (c s) (declare (ignore c))
+		   (write-string "Abort failed." s))))
+
+(defun simple-condition-class-p (type)
+  (typep type 'SIMPLE-CONDITION-CLASS))
+
+;;;
+;;; Additions by ECLS
+;;;
+(define-condition simple-program-error (simple-condition program-error) ())
+
+(define-condition simple-control-error (simple-condition control-error) ())
+
+
+
+(defmacro handler-case (form &rest cases)
+  (let ((no-error-clause (assoc ':NO-ERROR cases)))
+    (if no-error-clause
+	(let ((normal-return (make-symbol "NORMAL-RETURN"))
+	      (error-return  (make-symbol "ERROR-RETURN")))
+	  `(block ,error-return
+	    (multiple-value-call #'(lambda ,@(cdr no-error-clause))
+	      (block ,normal-return
+		(return-from ,error-return
+		  (handler-case (return-from ,normal-return ,form)
+		     ,@(remove no-error-clause cases)))))))
+	(let ((tag (gensym))
+	      (var (gensym))
+	      (annotated-cases (mapcar #'(lambda (case) (cons (gensym) case))
+				       cases)))
+	  `(block ,tag
+	     (let ((,var nil))
+	       (declare (ignore ,var))
+	       (tagbody
+		 (handler-bind ,(mapcar #'(lambda (annotated-case)
+					    (list (cadr annotated-case)
+						  `#'(lambda (temp)
+						       ,@(if (caddr annotated-case)
+							     `((setq ,var temp)))
+						       (go ,(car annotated-case)))))
+					annotated-cases)
+			       (return-from ,tag ,form))
+		 ,@(mapcan #'(lambda (annotated-case)
+			       (list (car annotated-case)
+				     (let ((body (cdddr annotated-case)))
+				       `(return-from ,tag
+					  ,(cond ((caddr annotated-case)
+						  `(let ((,(caaddr annotated-case)
+							  ,var))
+						     ,@body))
+						 ((not (cdr body))
+						  (car body))
+						 (t
+						  `(progn ,@body)))))))
+			   annotated-cases))))))))
+
+(defmacro ignore-errors (&rest forms)
+  `(handler-case (progn ,@forms)
+     (error (condition) (values nil condition))))
+
+(defun abort          ()      (invoke-restart 'ABORT)
+       			      (error 'ABORT-FAILURE))
+(defun continue       ()      (invoke-restart 'CONTINUE))
+(defun muffle-warning ()      (invoke-restart 'MUFFLE-WARNING))
+(defun store-value    (value) (invoke-restart 'STORE-VALUE value))
+(defun use-value      (value) (invoke-restart 'USE-VALUE   value))
+
+#|
+;;; ----------------------------------------------------------------------
+;;; Interface
+;;;
+
+(defun sys::universal-error-handler
+  (error-name correctable function-name
+	      continue-format-string error-format-string
+	      args)
+  (declare (inline apply)) ;; So as not to get bogus frames in debugger
+  (if correctable
+      (apply #'cerror continue-format-string args)
+      (apply #'error error-format-string args)))
+
+(defun invoke-debugger (condition)
+  (let ((si::*tpl-prompt-hook*
+	 '(lambda 
+  (sys::break-level *restart-clusters*
+		    (format nil "~?"
+			    (format-string condition)
+			    (format-arguments condition))))
+
+(setq *restart-clusters*
+      (list (list
+	     (make-restart
+	      :NAME 'ABORT
+	      :FUNCTION #'(lambda () (throw si::*quit-tag* NIL))
+	      :REPORT-FUNCTION 
+	      #'(lambda (stream) 
+		  (format stream "Return to top level."))
+	      :INTERACTIVE-FUNCTION nil))))
+
+;;; ----------------------------------------------------------------------
+;;; Sample Debugger
+
+(defvar *debug-level* 0)
+(defvar *debug-abort* nil)
+(defvar *debug-continue* nil)
+(defvar *debug-condition* nil)
+(defvar *debug-restarts* nil)
+(defvar *number-of-debug-restarts* 0)
+(defvar *debug-eval* 'eval)
+(defvar *debug-print* #'(lambda (values) (format t "~&~{~s~^,~%~}" values)))
+
+(defmacro debug-command                (x) `(get ,x 'debug-command))
+(defmacro debug-command-argument-count (x) `(get ,x 'debug-command-argument-count))
+
+(defmacro define-debug-command (name bvl &rest body)
+  `(progn (setf (debug-command ',name) #'(lambda ,bvl ,@body))
+          (setf (debug-command-argument-count ',name) ,(length bvl))
+          ',name))
+
+(defun read-debug-command ()
+  (format t "~&debug ~d> " *debug-level*)
+  (cond ((char= (peek-char t) #\:)
+	 (read-char) ;Eat the ":" so that ":1" reliably reads a number.
+	 (with-input-from-string (stream (read-line))
+	   (let ((eof (list nil)))
+	     (do ((form (let ((*package* (find-package "keyword")))
+			  (read stream nil eof))
+			(read stream nil eof))
+		  (l '() (cons form l)))
+		 ((eq form eof) (nreverse l))))))
+	(t
+	 (list :eval (read)))))
+                   
+(define-debug-command :EVAL (form)
+  (funcall *debug-print* (multiple-value-list (funcall *debug-eval* form))))
+
+(define-debug-command :ABORT ()
+  (if *debug-abort*
+      (invoke-restart-interactively *debug-abort*)
+      (format T "~&There is no way to abort.~%")))
+
+(define-debug-command :CONTINUE ()
+  (if *debug-continue*
+      (invoke-restart-interactively *debug-continue*)
+      (format T "~&There is no way to continue.~%")))
+
+(define-debug-command :ERROR ()
+  (format T "~&~A~%" *debug-condition*))
+
+(define-debug-command :HELP ()
+  (format T "~&You are in a portable debugger.~
+             ~%Type a debugger command or a form to evaluate.~
+             ~%Commands are:~%")
+  (show-restarts *debug-restarts* *number-of-debug-restarts* 16)
+  (format T "~& :EVAL form     Evaluate a form.~
+             ~% :HELP          Show this text.~%")
+  (when *debug-abort*    (format T "~& :ABORT         Exit by ABORT.~%"))
+  (when *debug-continue* (format T "~& :CONTINUE      Exit by CONTINUE.~%"))
+  (format T "~& :ERROR         Reprint error message.~%"))
+
+
+
+(defvar *debug-command-prefix* ":")
+
+(defun show-restarts (&optional (restarts *debug-restarts*)
+		      		(max *number-of-debug-restarts*)
+				target-column)
+  (unless max (setq max (length restarts)))
+  (when restarts
+    (do ((w (if target-column
+		(- target-column 3)
+		(ceiling (log max 10))))
+         (p restarts (cdr p))
+         (i 0 (1+ i)))
+        ((or (not p) (= i max)))
+      (format T "~& ~A~A "
+	      *debug-command-prefix*
+	      (let ((s (format nil "~d" (+ i 1))))
+		(with-output-to-string (str)
+		  (format str "~A" s)
+		  (dotimes (i (- w (length s)))
+		    (write-char #\Space str)))))
+      (when (eq (car p) *debug-abort*) (format t "(Abort) "))
+      (when (eq (car p) *debug-continue*) (format T "(Continue) "))
+      (format T "~A" (car p))
+      (format T "~%"))))
+
+(defvar *debugger-hook* NIL)
+
+(defun invoke-debugger (&optional (datum "Debug") &rest arguments)
+  (let ((condition
+	 (coerce-to-condition datum arguments 'simple-condition 'debug)))
+    (when *debugger-hook*
+      (let ((hook *debugger-hook*)
+	    (*debugger-hook* nil))
+	(funcall hook condition hook)))
+    (standard-debugger condition)))
+
+(defun standard-debugger (condition)
+  (let* ((*debug-level* (1+ *debug-level*))
+	 (*debug-restarts* (compute-restarts))
+	 (*number-of-debug-restarts* (length *debug-restarts*))
+	 (*debug-abort*    (find-restart 'abort))
+	 (*debug-continue* (or (let ((c (find-restart 'continue)))
+				 (if (or (not *debug-continue*)
+					 (not (eq *debug-continue* c)))
+				     c nil))
+			       (let ((c (if *debug-restarts*
+					    (first *debug-restarts*) nil)))
+				 (if (not (eq c *debug-abort*)) c NIL))))
+	 (*debug-condition* condition))
+    (format T "~&~A~%" condition)
+    (show-restarts)
+    (do ((command (read-debug-command) (read-debug-command)))
+	(nil)
+      (execute-debugger-command (car command) (cdr command) *debug-level*))))
+
+(defun execute-debugger-command (cmd args level)
+  (with-simple-restart (abort "Return to debug level ~D." level)
+    (when cmd
+      (if (integerp cmd)
+	  (if (and (plusp cmd)
+		   (< cmd (+ *number-of-debug-restarts* 1)))
+	      (let ((restart (nth (- cmd 1) *debug-restarts*)))
+		(if args
+		    (apply #'invoke-restart restart (mapcar *debug-eval* args))
+		    (invoke-restart-interactively restart)))
+	      (format T "~&No such restart."))
+	  (let ((fn (debug-command cmd)))
+	    (if fn
+		(if (= (length args) (debug-command-argument-count cmd))
+		    (apply fn args)
+		    (format T "~&Too ~:[few~;many~] arguments to ~A."
+			    (> (length args) (debug-command-argument-count cmd))
+			    cmd))
+		(format T "~&~S is not a debugger command.~%" cmd)))))))
+
+|#
diff --git a/src/clos/defclass.lsp b/src/clos/defclass.lsp
new file mode 100644
index 000000000..d7be51450
--- /dev/null
+++ b/src/clos/defclass.lsp
@@ -0,0 +1,531 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; ----------------------------------------------------------------------
+;;; DEFCLASS
+
+(defmacro DEFCLASS (&rest args)
+  (multiple-value-bind (name superclasses slots 
+			     metaclass-name default-initargs documentation)
+      (parse-defclass args)
+    (unless metaclass-name
+      (setq metaclass-name 'STANDARD-CLASS)) ; the default for CLOS
+
+    ;; process superclasses
+    (dolist (superclass superclasses)
+      (unless (legal-class-name-p superclass)
+	(error "~A is not a legal superclass name" superclass)))
+
+    ;; process slots
+    (let* ((direct-slots (parse-slots slots))
+	   (all-slots (collect-all-slots direct-slots name superclasses)))
+      ;; update slots with inherited information
+      (do ((scan direct-slots (cdr scan))
+	   (slot))
+	  ((null scan))
+	(setq slot
+	      (find (slotd-name (first scan)) all-slots :key #'slotd-name))
+	(setf (first scan) slot))
+      `(eval-when (compile load eval)
+	;; at compile time just create the definition
+	(ensure-class
+	 ',metaclass-name
+	 ',name
+	 ',superclasses
+	 ',direct-slots
+	 ',all-slots
+	 ',default-initargs
+	 ',documentation)
+	#+PDE
+	(si:record-source-pathname ',name 'DEFCLASS)
+	,@ (generate-methods
+	    name
+	    :metaclass-name metaclass-name
+	    :superiors (mapcar #'find-class superclasses)
+	    :slots all-slots)
+	(find-class ',name)))))
+
+(defun collect-all-slots (slots name superclasses-names)
+  (let* ((superclasses (mapcar #'find-class superclasses-names))
+	 (cpl (compute-class-precedence-list name superclasses)))
+    (collect-slotds cpl slots)))
+
+(defun ensure-class (metaclass name superclasses direct-slots all-slots
+			       default-initargs documentation)
+  (case metaclass
+    (STANDARD-CLASS
+     (create-standard-class name superclasses direct-slots all-slots
+			    default-initargs documentation))
+    (STRUCTURE-CLASS
+     (create-structure-class name superclasses direct-slots all-slots
+			    default-initargs documentation))
+    (T
+     (make-instance (find-class metaclass)
+		    :NAME name
+		    :DIRECT-SUPERCLASSES (mapcar #'find-class superclasses)
+		    :DIRECT-SLOTS direct-slots
+		    :SLOTS all-slots
+		    :DEFAULT-INITARGS default-initargs
+		    :DOCUMENTATION documentation))))
+
+;;; ----------------------------------------------------------------------
+;;;                                                                parsing
+
+(defun parse-defclass (args)
+  (let (name superclasses slots options
+	     metaclass-name default-initargs documentation)
+    (unless args
+      (error "Illegal defclass form: the class name, the superclasses and the slots should always be provided"))
+    (setq name (pop args))
+    (unless args
+      (error "Illegal defclass form: the class name, the superclasses list and the slot specifier list should always be provided"))
+    (unless (listp (first args))
+      (error "Illegal defclass form: the superclasses should be a list"))
+    (setq superclasses (pop args))
+    (unless args
+      (error "Illegal defclass form: the class name, the superclasses list and the slot specifier list should always be provided"))
+    (unless (listp (first args))
+      (error "Illegal defclass form: the slots should be a list"))
+    (setq slots (pop args))
+    (setq options args)
+    (unless (legal-class-name-p name)
+      (error "Illegal defclass form: the class name should be a symbol"))
+    ;; process options
+    (dolist (option options)
+      (case (first option)
+	(:metaclass
+	 (if metaclass-name
+	     (error "Option :metaclass specified more than once for class ~A" 
+		    name)
+	   ;; else
+	   (setq metaclass-name (second option))))
+	(:default-initargs
+	  (if default-initargs
+	      (error "Option :default-initargs specified more than once for class ~A" name)
+	      (setq default-initargs (cdr option))))
+	(:documentation
+	  (if documentation
+	      (error "Option :documentation specified more than once for class ~A"
+		     name)
+	      (setq documentation (second option))))  
+	(otherwise (error "~S is not a legal class-option." (first option)))))
+    (values name superclasses slots 
+	    metaclass-name default-initargs documentation)))
+
+
+;;; ----------------------------------------------------------------------
+;;;                                                               methods
+
+;;; Initialization is split into two parts, so that methods are
+;;; generated in a way that the compiler can see them.
+;;; This cant be a method because of bootstrap problem.
+
+(defun generate-methods (class-name &rest init-options)
+  (keyword-bind (metaclass-name superiors inferiors slots methods)
+		init-options 
+    (declare (ignore superiors inferiors methods))
+    (let (instance-slots shared-slots)
+      (dolist (slot slots)
+	(case (slotd-allocation slot)
+	  (:INSTANCE (push slot instance-slots))
+	  (T (push slot shared-slots))))
+      (setq instance-slots (nreverse instance-slots)
+	    shared-slots (nreverse shared-slots))
+      (cond
+	;; since slot-value is inherited from 'STANDARD-OBJECT
+	((subtypep metaclass-name 'STANDARD-CLASS)
+	 (generate-optional-slot-accessors
+	  class-name instance-slots shared-slots t))
+	;; don't generate accessor for structures:
+	((subtypep metaclass-name 'STRUCTURE-CLASS) nil)
+	(t
+	 `(,@ (generate-slot-accessors
+	       class-name
+	       instance-slots
+	       shared-slots)))))))
+
+(defun generate-slot-accessors (name slotds shared-slotds)
+  (when (plusp (length slotds))
+    (append
+    (if  (< (+ (length slotds)
+	       (length shared-slotds)) 16) ; linear search is faster
+	`((install-method
+	    'SLOT-VALUE nil '(,name NIL) '(SELF SLOT) nil nil
+	    #'(lambda (self slot)
+		(declare (type ,name self))
+		(case slot
+		      ,@(do ((scan slotds (cdr scan))
+			     (index 0 (1+ index))
+			     (clauses))
+			    ((null scan)
+			     (nreverse
+			       (cons
+				 `(T (SLOT-MISSING (SI:INSTANCE-CLASS SELF)
+						   SELF SLOT 'SLOT-VALUE))
+				 clauses)))
+			    (push `(,(slotd-name (first scan))
+				    (let ((val (si:instance-ref self ,index)))
+				      ,@(let ((type (slotd-type (first scan))))
+					  (unless (eq 'T type)
+					    `((DECLARE (TYPE ,type val)))))
+				      (if (si:sl-boundp val)
+					  val
+					  'UNBOUND)))
+				  clauses)))))
+
+	  (install-method
+	    '(SETF SLOT-VALUE) nil '(NIL ,name NIL) '(VALUE SELF SLOT) nil nil
+	    #'(lambda (value self slot)
+		(declare (type ,name self))
+		(case slot
+		      ,@(do ((scan slotds (cdr scan))
+			     (index 0 (1+ index))
+			     (clauses))
+			    ((null scan)
+			     (nreverse
+			       (cons `(t (slot-missing (si:instance-class self)
+					  self slot value 'SETF))
+					     clauses)))
+			    (push `(,(slotd-name (first scan))
+				    (setf (si:instance-ref self ,index) value))
+				  clauses))))))
+
+      `((let* ((size (floor (length ',slotds) 1.5))
+	       (table (make-hash-table :size (if (zerop size) 1 size))))
+	  (do ((scan ',slotds (cdr scan))
+	       (index 0 (1+ index)))
+	      ((null scan))
+	    (setf (gethash (slotd-name (first scan)) table) index))
+
+	  (install-method 'SLOT-VALUE nil '(,name NIL) '(SELF SLOT) nil nil
+			  #'(lambda (self slot) 
+			      (declare (type ,name self))
+			      (let ((index
+				     (the fixnum
+					  (gethash slot table 
+						   most-positive-fixnum))))
+				(declare (fixnum index)) 
+				(if (not (= index most-positive-fixnum))
+				    (let ((val (si:instance-ref self index)))
+				      (if (si:sl-boundp val)
+					  val
+					  'UNBOUND))
+				    (slot-missing
+				     (si:instance-class self) self slot
+				     'SLOT-VALUE)))))
+
+	  (install-method '(SETF SLOT-VALUE) nil '(NIL ,name NIL)
+			  '(VALUE SELF SLOT) nil nil
+			  #'(lambda (value self slot)
+			      (declare (type ,name self))
+			      (let ((index
+				     (the fixnum
+					  (gethash slot table 
+						   most-positive-fixnum))))
+				(declare (fixnum index))
+				(if (not (= index most-positive-fixnum))
+				    (si:instance-set self index value)
+				    (slot-missing 
+				     (si:instance-class self) self slot value 'SETF)))))
+	  )))
+
+    (generate-optional-slot-accessors name slotds shared-slotds))))
+
+(defun generate-optional-slot-accessors (name slotds shared-slotds
+					      &optional optimized)
+  (nconc
+   ;; instance slots accessor methods
+   (do ((scan slotds (cdr scan))
+	(i 0 (1+ i))
+	(slotd)
+	(methods))
+       ((null scan) methods)
+       (declare (fixnum i))
+       (setq slotd (first scan))
+       (dolist (accessor (slotd-accessors slotd))
+	 ;; accessors are implemented using slot-value
+	 (push
+	  `(install-method '(SETF ,accessor) nil '(NIL ,name) '(V SELF) nil nil
+	    ,(if optimized
+		 `#'(lambda (v self)
+		      (declare (type ,name self))
+		      (si:instance-set self ,i v))
+	       `#'(lambda (v self)
+		    (setf (slot-value self ',(slotd-name slotd)) v))))
+	  methods)
+	 (push
+	  `(install-method ',accessor nil '(,name) '(SELF) nil nil
+	    ,(if optimized
+		 `#'(lambda (self)
+		      (declare (type ,name self))
+		      (let ((val (si:instance-ref self ,i)))
+			,@(let ((type (slotd-type slotd)))
+			    (unless (eq 't type)
+			      `((DECLARE (TYPE ,type VAL)))))
+			    (if (si:sl-boundp val) val
+				;; else
+				(slot-unbound (si:instance-class self) self
+					      ',(slotd-name slotd)))))
+		 `#'(lambda (self)
+		      (declare (type ,name self))
+		      (slot-value self ',(slotd-name slotd)))))
+	  methods))
+       (dolist (reader (slotd-readers slotd))
+	 (push
+	  `(install-method ',reader nil '(,name) '(SELF) nil nil
+	    ,(if optimized
+		 `#'(lambda (self)
+		      (declare (type ,name self))
+		      (let ((val (si:instance-ref self ,i)))
+			,@(let ((type (slotd-type slotd)))
+			    (unless (eq 't type)
+			      `((DECLARE (TYPE ,type VAL)))))
+			(if (si:sl-boundp val) val
+			    ;; else
+			    (slot-unbound (si:instance-class self) self
+					  ',(slotd-name slotd)))))
+		 `#'(lambda (self)
+		      (declare (type ,name self))
+		      (slot-value self ',(slotd-name slotd)))))
+	  methods))
+       (dolist (writer (slotd-writers slotd))
+	 (push
+	  `(install-method ',writer nil '(NIL ,name) '(V SELF) nil nil
+	    ,(if optimized
+		 `#'(lambda (v self)
+		      (declare (type ,name self))
+		      (si:instance-set self ,i v))
+	       `#'(lambda (v self)
+		    (declare (type ,name self))
+		    (setf (slot-value self ',(slotd-name slotd)) v))))
+	  methods))
+       )
+
+   ;; class slots accessor methods
+   (do ((scan shared-slotds (cdr scan))
+	(slotd)
+	(methods))
+       ((null scan) methods)
+       (setq slotd (first scan))
+       (dolist (accessor (slotd-accessors slotd))
+	 ;; accessors are implemented using slot-value
+	 (push
+	  `(install-method '(SETF ,accessor) nil '(NIL ,name) 
+	    '(V SELF) nil nil
+	    #'(lambda (v self) 
+		(declare (type ,name self))
+		(setf (slot-value self ',(slotd-name slotd)) v)))
+	  methods)
+	 (push
+	  `(install-method ',accessor nil '(,name) '(SELF) nil nil
+	    #'(lambda (self)
+		(declare (type ,name self))
+		(slot-value self ',(slotd-name slotd))))
+	  methods))
+       (dolist (reader (slotd-readers slotd))
+	 ;; readers are implemented using slot-value
+	 (push
+	  `(install-method ',reader nil '(,name) '(SELF) nil nil
+	    #'(lambda (self)
+		(declare (type ,name self))
+		(slot-value self ',(slotd-name slotd))))
+	  methods))
+       (dolist (writer (slotd-writers slotd))
+	 (push
+	  `(install-method ',writer nil '(NIL ,name) '(V SELF) nil nil
+	    #'(lambda (v self)
+		(declare (type ,name self))
+		(setf (slot-value self ',(slotd-name slotd)) v)))
+	  methods)))))
+
+;;; ----------------------------------------------------------------------
+;;; SLOTS
+
+(defun collect-slotds (classes slots)
+  (flet ((combine-slotds (new-slotd old-slotd)
+	   (let ((new-type (slotd-type new-slotd))
+		 (old-type (slotd-type old-slotd)))
+	     (setf (slotd-initargs new-slotd)
+		   (union (slotd-initargs new-slotd)
+			  (slotd-initargs old-slotd)))
+	     (when (eq (slotd-initform new-slotd) 'INITFORM-UNSUPPLIED)
+	       (setf (slotd-initform new-slotd) (slotd-initform old-slotd)))
+	     (setf (slotd-type new-slotd)
+		   ;; since (subtypep '(and t1 t2) `(and t2 t1)) returns nil
+		   ;; we should be more smart then this:
+		   (cond ((subtypep new-type old-type) new-type)
+			 ((subtypep old-type new-type) old-type)
+			 ((listp old-type)
+			  (if (listp new-type)
+			      `(and ,@(cdr new-type)
+				,@(cdr old-type)) ; take out the ands
+			      `(and ,new-type ,@(cdr old-type))))
+			 ((listp new-type)
+			     `(and ,@(cdr new-type) ,old-type))
+			 (T `(and ,new-type ,old-type)))))
+	   new-slotd))
+
+    (let ((collected-slots)
+	  (new-slot))
+      (dolist (sc classes)
+	(dolist (slot (class-slots sc))
+	  (if (setq new-slot
+		    (find (slotd-name slot) collected-slots
+			  :key #'slotd-name))
+	      (combine-slotds new-slot slot) ; updates the slot
+	      (if (setq new-slot
+			(find (slotd-name slot) slots
+			      :key #'slotd-name))
+		  (progn
+		    (setq slots (delete new-slot slots))
+		    (combine-slotds new-slot slot) ; updates the slot
+		    (push new-slot collected-slots))
+		  (push (copy-slotd slot) collected-slots)))))
+      (nconc (nreverse collected-slots) slots))))
+
+
+;;; ----------------------------------------------------------------------
+;;; support for standard-class
+
+(defun collect-default-initargs (classes initargs)
+  (dolist (sc classes)
+    (setq initargs (default-initargs sc initargs)))
+  initargs)
+
+(defun compute-class-precedence-list (class-name superclasses)
+  ;; We start by computing two values.
+  ;;   CPL
+  ;;     The depth-first left-to-right up to joins walk of the supers tree.
+  ;;     This is equivalent to depth-first right-to-left walk of the
+  ;;     tree with all but the last occurence of a class removed from
+  ;;     the resulting list.  This is in fact how the walk is implemented.
+  ;;
+  ;;   PRECEDENCE-ALIST
+  ;;     An alist of the precedence relations. The car of each element
+  ;;     of the precedence-alist is a class C, the cdr is all the classes C'
+  ;;     which should precede C because either:
+  ;;       C is a local super of C'
+  ;;      or
+  ;;       C' appears before C in some class's local-supers.
+  ;;
+  ;;     Thus, the precedence-alist reflects the two constraints that:
+  ;;       1. A class must appear in the CPL before its local supers.
+  ;;       2. Order of local supers is preserved in the CPL.
+  ;;
+  (labels
+   ((must-move-p (element list precedence-alist &aux move)
+		 (dolist (must-precede (cdr (assoc element
+						   precedence-alist
+						   :test #'eq)))
+			 (when (setq move (member must-precede (cdr list)
+						  :test #'eq))
+			       (return move))))
+    (find-farthest-move
+     (element move precedence-alist)
+     (dolist (must-precede (transitive-closure element precedence-alist))
+	     (setq move (or (member must-precede move :test #'eq) move)))
+     move)
+    (transitive-closure
+     (class precedence-alist)
+     (let ((closure ()))
+       (labels ((walk (element path)
+		      (when (member element path :test #'eq)
+			    (class-ordering-error
+			     class-name element path precedence-alist))
+		      (dolist (precede
+			       (cdr (assoc element
+					   precedence-alist :test #'eq)))
+			      (unless (member precede closure :test #'eq)
+				      (pushnew precede closure)
+				      (walk precede (cons element path))))))
+	       (walk class nil)
+	       closure))))
+
+   (multiple-value-bind
+    (cpl precedence-alist)
+    (walk-supers superclasses nil nil)
+    (let ((tail cpl)
+	  (element nil)
+	  (move nil))
+      ;; For each class in the cpl, make sure that there are no classes after
+      ;; it which should be before it.  We do this by cdring down the list,
+      ;; making sure that for each element of the list, none of its
+      ;; must-precedes come after it in the list. If we find one, we use the
+      ;; transitive closure of the must-precedes (call find-farthest-move) to
+      ;; see where the class must really be moved. We use a hand-coded loop
+      ;; so that we can splice things in and out of the CPL as we go.
+      (loop (when (null tail) (return))
+	    (setq element (car tail)
+		  move (must-move-p element tail precedence-alist))
+	    (cond (move
+		   (setq move (find-farthest-move element move precedence-alist))
+		   (setf (cdr move) (cons element (cdr move)))
+		   (setf (car tail) (cadr tail))
+		   (setf (cdr tail) (cddr tail))
+		   )
+		  (t
+		   (setq tail (cdr tail)))))
+      cpl))))
+
+(defun walk-supers (supers cpl precedence-alist)
+  (do* ((pre (reverse supers))
+	(sup)
+	(precedence))
+       ((null pre) (values cpl precedence-alist))
+    (setq sup (pop pre))
+    (when pre
+      (if (setq precedence (assoc sup precedence-alist :test #'eq))
+	  ;; don't use rplacd here:
+	  (setq precedence (cons (car precedence) (union pre precedence)))
+	  (push (cons sup pre) precedence-alist)))
+    (multiple-value-setq (cpl precedence-alist)
+      (walk-supers (class-superiors sup) cpl precedence-alist))
+    (setq cpl (adjoin sup cpl))))
+
+(defun class-ordering-error (root element path precedence-alist)
+  (setq path (cons element (reverse (member element (reverse path) :test #'eq))))
+  (flet ((pretty (class) (or (class-name class) class)))
+    (let ((explanations ()))
+      (do ((tail path (cdr tail)))
+	  ((null (cdr tail)))
+	(let ((after (cadr tail))
+	      (before (car tail)))
+	  (if (member after (class-superiors before) :test #'eq)
+	      (push (format nil
+			    "~% ~A must precede ~A -- ~
+                              ~A is in the local supers of ~A."
+			    (pretty before) (pretty after)
+			    (pretty after) (pretty before))
+		    explanations)
+	      (dolist (common-precede
+			(intersection
+			  (cdr (assoc after precedence-alist :test #'eq))
+			  (cdr (assoc before precedence-alist :test #'eq))))
+		(when (member after (member before
+					    (class-superiors common-precede)
+					    :test #'eq)
+			      :test #'eq)
+		  (push (format nil
+				"~% ~A must precede ~A -- ~
+                                  ~A has local supers ~S."
+				(pretty before) (pretty after)
+				(pretty common-precede)
+				(mapcar #'pretty
+					(class-superiors common-precede)))
+			explanations))))))
+      (error "While computing the class-precedence-list for the class ~A:~%~
+              There is a circular constraint through the classes:~{ ~A~}.~%~
+              This arises because:~{~A~}"
+	     root
+	     (mapcar #'pretty path)
+	     (reverse explanations)))))
+
+;;; ----------------------------------------------------------------------
diff --git a/src/clos/defsys.lsp.in b/src/clos/defsys.lsp.in
new file mode 100644
index 000000000..cc07285a2
--- /dev/null
+++ b/src/clos/defsys.lsp.in
@@ -0,0 +1,49 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;
+;;;
+
+;;; ----------------------------------------------------------------------
+;;;	CLOS
+;;; ----------------------------------------------------------------------
+
+(defparameter
+  *clos-modules*
+  ;; file       load              compile               files which force
+  ;;            environment       environment           recompilations of
+  ;;                                                    this file
+  '(
+    (walk      ()           	 ()               	())
+    (macros    (walk)     	 (walk)                 ())
+    (method    (macros)          (macros)               ())
+    (kernel    (method)          (method)       	(method))
+    (slot      ()	         ()			())
+    (combin    (method)          (method)		(method))
+    (precomp   t		 t			())
+    (boot      (kernel slot combin)
+	       			 (kernel slot)   	(kernel slot))
+    (print     (boot)		 (boot) 		(boot))
+    (defclass  (kernel slot)     (kernel slot)          (boot))
+    (standard  (boot defclass precomp)
+	      			 (boot defclass)	(method defclass))
+    (inspect   (standard)        (standard)             (standard))
+    (change    (standard)	 (standard)		(standard))
+    (builtin   (standard)        (standard)	   	(standard))
+    (stdmethod (builtin)	 (builtin)	        (builtin))
+    (generic   (stdmethod)       (stdmethod)            ())
+    (fixup     (stdmethod)       (stdmethod)            (standard))
+    (conditions ()		 ()			())
+    ))
+
+(sbt:defsystem 
+ clos
+ :modules *clos-modules*
+ :source-directory "@srcdir@/"
+ :fasl-directory "@builddir@/clos/"
+ :library-directory "@builddir@/")
diff --git a/src/clos/fixup.lsp b/src/clos/fixup.lsp
new file mode 100644
index 000000000..ef1d76f3e
--- /dev/null
+++ b/src/clos/fixup.lsp
@@ -0,0 +1,262 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; ----------------------------------------------------------------------
+;;; Fixup
+
+(defun fix-early-methods ()
+  (dolist (method-info *early-methods*)
+    (let* ((method-name (car method-info))
+	   (gfun (symbol-function method-name))
+	   (gf-object (si:gfun-instance gfun)))
+
+      (when (eq 'T (class-name (si:instance-class gf-object)))
+	;; complete the generic function object
+	(si:instance-class-set gf-object
+			       (find-class 'STANDARD-GENERIC-FUNCTION))
+	(si:instance-set gf-object 4
+			 (find-class 'STANDARD-METHOD))	; method-class
+	)
+
+      (dolist (method (cdr method-info))
+	;; we must use CxR here since method accessors have been redefined
+	(let* (;;(class-name (car method))
+	       (qualifiers (cadr method))
+	       (specializers (caddr method))
+	       (lambda-list (cadddr method))
+	       (function (nth 4 method))
+	       (plist (nth 5 method))
+	       (options (nth 6 method)))
+
+	  ;; create the method instance according
+	  ;; to the information previously saved
+	  (add-method gf-object
+		      (make-method qualifiers specializers lambda-list
+				   function plist options gf-object
+				   'STANDARD-METHOD))))))
+
+      (fmakunbound 'FIX-EARLY-METHODS)
+      (makunbound '*EARLY-METHODS*))
+
+
+;;; ----------------------------------------------------------------------
+;;;                                                              redefined
+
+(defun make-method (qualifiers specializers arglist
+			       function plist options gfun method-class)
+  (declare (ignore options))
+  (make-instance method-class
+		 :generic-function gfun
+		 :qualifiers qualifiers
+		 :lambda-list arglist
+		 :specializers specializers
+		 :method-function function
+		 :plist plist
+		 :allow-other-keys t))
+
+(defun get-method-qualifiers (method)
+  (if (typep method 'STANDARD-METHOD)
+      (si:instance-ref method 3)
+    (error "~A is not a standard method" method)))
+
+(defun add-method (gf method)
+  (declare (notinline method-qualifiers)) ; during boot it's a structure accessor
+  (let ((method-qualifiers (method-qualifiers method)) 
+	(specializers (specializers method))
+	found)
+    (when (setq found (find-method gf method-qualifiers specializers nil))
+	  (remove-method gf found))
+  (push method (methods gf))
+  (clrhash (si:gfun-method-ht (generic-function-dispatcher gf)))
+  method))
+
+(defun remove-method (gf method)
+  (setf (methods gf) (delete method (methods gf))))
+
+;;; ----------------------------------------------------------------------
+;;;                                                           do the fixup
+
+(fix-early-methods)
+
+;;; ----------------------------------------------------------------------
+;;;                                                  continue redefinition
+
+(defun method-needs-next-methods-p (method)
+  (getf (si:instance-ref method 7) :needs-next-methods-p))
+
+(defun method-p (method) (typep method 'METHOD))
+
+(defun get-method-function (method)
+  (if (typep method 'STANDARD-METHOD)
+      (si:instance-ref method 4)
+    (error "~A is not a standard method" method)))
+
+(defun si:compute-applicable-methods (gf args)
+  (let ((methods (methods gf))
+	applicable-list
+	args-specializers)
+    ;; first compute the applicable method list
+    (dolist (method methods)
+      ;; for each method in the list
+      (do* ((scan-args args (cdr scan-args))
+	    (scan-specializers (specializers method)
+			       (cdr scan-specializers))
+	    (arg)
+	    (spec))
+	  ;; check if the method is applicable verifying 
+	  ;; if each argument satisfies the corresponding
+	  ;; parameter specializers
+	  ((null scan-args) (push method applicable-list))
+	(setq arg (first scan-args)
+	      spec (first scan-specializers))
+	(unless (or (null spec)
+		    (and (consp spec) (eql arg (cadr spec)))
+		    (typep arg spec)
+		    (and (eq 'INVALID spec)
+			 (si:instancep arg)
+			 (eq 'INVALID (class-name (class-of arg)))))
+	  (return))))
+    (dolist (arg args) 
+      (push (type-of arg) args-specializers))
+    (setq args-specializers (nreverse args-specializers))
+    ;; then order the list
+    (do* ((scan applicable-list)
+	  (most-specific (first scan) (first scan))
+	  (ordered-list))
+	 ((null (cdr scan)) (when most-specific
+			      ;; at least one method
+			      (nreverse
+			       (push most-specific ordered-list))))
+      (dolist (meth (cdr scan))
+	(when (eq (compare-methods most-specific
+				   meth args-specializers) 2)
+	  (setq most-specific meth)))
+      (setq scan (delete most-specific scan))
+      (push most-specific ordered-list))))
+
+;;; ----------------------------------------------------------------------
+;;;                                                      method comparison
+
+(defun compare-methods (method-1 method-2 args-specializers)
+  (let ((specializers-list-1 (specializers method-1))
+	(specializers-list-2 (specializers method-2)))
+    (compare-specializers-lists specializers-list-1 
+				specializers-list-2 args-specializers)))
+
+(defun compare-specializers-lists (spec-list-1 spec-list-2 args-specializers)
+  (when (or spec-list-1 spec-list-2)
+    (ecase (compare-specializers (first spec-list-1)
+				 (first spec-list-2)
+				 (first args-specializers))
+      (1 '1)
+      (2 '2)
+      (= 
+       (compare-specializers-lists (cdr spec-list-1)
+				   (cdr spec-list-2)
+				   (cdr args-specializers)))
+      ((nil)
+       (error "The type specifiers ~S and ~S can not be disambiguated~
+                  with respect to the argument specializer: ~S"
+	      (or (car spec-list-1) t)
+	      (or (car spec-list-2) t)
+	      (car args-specializers)))))
+  )
+
+(defun compare-specializers (spec-1 spec-2 arg-spec)
+  (let* ((arg-class (closest-class arg-spec))
+	 (cpl (cons arg-class
+		    (if (typep arg-class 'STANDARD-CLASS)
+			(slot-value arg-class 'PRECEDENCE-LIST)
+			(compute-class-precedence-list
+			 arg-spec
+			 (class-superiors arg-class)))))
+	 (cpl-names))
+    (setq cpl-names (dolist (e cpl (nreverse cpl-names))
+		      (push (class-name e) cpl-names)))
+    (cond ((equal spec-1 spec-2) '=)
+	  ((null spec-1) '2)
+	  ((null spec-2) '1)
+	  ((subtypep spec-1 spec-2) '1)
+	  ((subtypep spec-2 spec-1) '2)
+	  ((and (listp spec-1) (eq (car spec-1) 'eql)) '1) ; is this engough?
+	  ((and (listp spec-2) (eq (car spec-2) 'eql)) '2) ; Beppe
+	  ((member spec-1 (member spec-2 cpl-names)) '2)
+	  ((member spec-2 (member spec-1 cpl-names)) '1)
+	  (t (compare-complex-specializers spec-1 spec-2 arg-spec)))))
+
+(defun compare-complex-specializers (spec-1 spec-2 arg-spec)
+  (declare (ignore spec-1 spec-2 arg-spec))
+  (error "Complex type specifiers are not yet supported."))
+
+(defun si:compute-effective-method (gf applicable-methods
+				    method-combination-type
+				    method-combination-args)
+  (declare (ignore method-combination-type method-combination-args))
+  (if applicable-methods
+      (compute-combined-method gf applicable-methods)
+    (no-applicable-method gf)))
+
+(defmethod no-applicable-method (gf &rest args)
+    (declare (ignore args))
+  (error "No applicable method for ~S" 
+	 (si:gfun-name (generic-function-dispatcher gf))))
+
+(defmethod no-next-method (gf method &rest args)
+  (declare (ignore gf args))
+  (error "No next method for method ~A" method))
+
+
+;;; ----------------------------------------------------------------------
+;;; Redefinition Protocol
+
+(defun redefine-class (class new-class superclasses-names inferiors)
+  (unless (typep class 'STANDARD-CLASS)
+    (error "Class ~A cannot be redefined: it is not a standard class" class))
+
+  ;; remove previous defined accessor methods
+  (remove-optional-slot-accessors class)
+  (let ((superclasses (mapcar #'find-class 
+			      (or superclasses-names
+				  (list 'STANDARD-OBJECT)))))
+    ;; update subclasses
+    (dolist (subclass (nreverse inferiors))
+      (let ((subclass-superclasses
+	     (mapcar #'(lambda (x) (class-name x)) (class-superiors subclass)))
+	    (subclass-name (class-name subclass)))
+	(print subclass)
+	(pushnew
+	 (ensure-class (class-name (si:instance-class subclass))
+		       subclass-name
+		       subclass-superclasses
+		       (slot-value subclass 'DIRECT-SLOTS)
+		       (collect-slotds
+			(compute-class-precedence-list
+			 subclass-name
+			 (mapcar #'find-class superclasses-names))
+			(slot-value subclass 'DIRECT-SLOTS))
+		       (default-initargs-of subclass)
+		       (documentation-of subclass))
+	 (class-inferiors new-class))
+	(eval
+	 (cons 'PROGN
+	       (generate-methods
+		subclass-name
+		:metaclass-name (class-name (class-of subclass))
+		:superiors superclasses
+		:slots slots)))))
+
+    ;; invalidate the class
+    (setf (class-name class) 'INVALID)
+    (setf (slot-value class 'FORWARD) new-class))
+
+  new-class)
+
+;;;----------------------------------------------------------------------
diff --git a/src/clos/generic.lsp b/src/clos/generic.lsp
new file mode 100644
index 000000000..663719b0d
--- /dev/null
+++ b/src/clos/generic.lsp
@@ -0,0 +1,341 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+(defun legal-generic-function-p (name)
+  (cond ((not (fboundp name)))
+	; a generic function already exists
+	((si:gfunp (symbol-function name)))
+	((special-form-p name)
+	 (error "~A is a special form" name))
+	((macro-function name)
+	 (error "~A is a macro" name))
+	(t 
+	 (error "~A is a lisp function" name))))
+
+(defmacro defgeneric (&rest args)
+  (multiple-value-bind (function-specifier lambda-list options)
+    (parse-defgeneric args)
+    (when (legal-generic-function-p function-specifier)
+      (parse-lambda-list lambda-list)
+      
+      ;; process options
+      (multiple-value-bind (argument-precedence-order 
+			    declaration documentation method-combination
+			    generic-function-class method-class method-list) 
+	(parse-generic-options options lambda-list)
+	(unless generic-function-class
+	  (setq generic-function-class 'STANDARD-GENERIC-FUNCTION))
+	(unless method-class (setq method-class 'STANDARD-METHOD))
+	(unless argument-precedence-order
+	  (setq argument-precedence-order ':DEFAULT))
+	#|
+	       (if (fboundp function-specifier)
+		   ;; remove methods defined by previous defgeneric
+		   (setf (methods 
+			  (si:gfun-instance 
+			   (symbol-function function-specifier)) nil)))
+|#
+	`(progn
+	   (ensure-generic-function ',function-specifier
+				    :lambda-list ',lambda-list
+				    :argument-precedence-order 
+				    ',argument-precedence-order
+				    :declare ',declaration
+				    :documentation ',documentation
+				    :generic-function-class 
+				    ',generic-function-class
+				    :method-combination
+				    ',method-combination
+				    :method-class ',method-class)
+	   ;,(dolist (method method-list)
+	   ;; add methods specified by defgeneric
+	   ;)
+	   )))))
+
+(defmacro generic-function (&rest args)
+  (multiple-value-bind (lambda-list options)
+    (parse--generic-function args)
+    
+    (parse-lambda-list lambda-list)
+    ;; process options
+    (multiple-value-bind (argument-precedence-order 
+			  declaration documentation method-combination
+			  generic-function-class method-class method-list) 
+      (parse-generic-options options lambda-list)
+      (unless generic-function-class
+	(setq generic-function-class 'STANDARD-GENERIC-FUNCTION))
+    (unless method-class
+      (setq method-class 'STANDARD-METHOD))
+    (unless argument-precedence-order
+      (setq argument-precedence-order ':DEFAULT))
+    `(progn
+       (let* ((dispatcher (make-gfun nil ',lambda-list))
+	      (gf-object (make-instance 
+			  ',generic-function-class
+			  :lambda-list ',lambda-list
+			  :argument-precedence-order ',argument-precedence-order
+			  :method-combination ',method-combination
+			  :method-class ',method-class
+			  :documentation ',documentation
+			  :gfun dispatcher)))
+	 (setf (si:gfun-instance dispatcher) gf-object)
+	 ;,(dolist (method method-list)
+	 ;; add methods specified by defgeneric
+	 ;)
+	 gf-object)))))
+		
+;;; ----------------------------------------------------------------------
+;;;                                                                parsing
+
+(defun parse-defgeneric (args)
+  ;; (values function-specifier lambda-list options)
+  (let (function-specifier)
+    (unless args
+      (error "Illegal defgeneric form: missing generic function name"))
+    (setq function-specifier (pop args))
+    (unless (legal-generic-function-name-p function-specifier)
+      (error "~A cannot be a generic function specifier.~%~
+             It must be either a non-nil symbol or ~%~
+             a list whose car is SETF and whose cadr is a non-nil symbol."
+	     function-specifier))
+    (unless args
+      (error "Illegal defgeneric  form: missing lambda-list"))
+    (values function-specifier (first args) (rest args))))
+
+(defun parse-generic-function (args)
+  ;; (values lambda-list options)
+  (unless args
+    (error "Illegal generic-function form: missing lambda-list"))
+  (values (first args) (rest args)))
+	
+(defun parse-generic-options (options lambda-list)
+  (let (argument-precedence-order
+	declaration
+	documentation
+	method-combination
+	generic-function-class 
+	method-class
+	method-list)
+    (dolist (option options)
+	    (case (first option)
+		  (:argument-precedence-order
+		   (if argument-precedence-order
+		       (error "Option :argument-precedence-order specified more than once")
+		     (setq argument-precedence-order
+			   (parse-parameter-names
+			    (second option) lambda-list))))
+		  (declare
+		   (if declaration
+		       (error "Option declare specified more than once")
+		     (setq declaration
+			   (parse-legal-declaration
+			    (second option)))))
+		  (:documentation
+		   (if documentation
+		       (error "Option :documentation specified more than once")
+		     (setq documentation
+			   (parse-legal-documentation
+			    (second option)))))
+		  (:method-combination
+		   (if method-combination
+		       (error "Option :method-combination specified more than \
+once")
+		     (setq method-combination
+			   ;(parse-legal-method-combination
+			    ;(second option))
+			   ; until method-combination is implemented
+			   (second option))))
+		  (:generic-function-class
+		   (if generic-function-class
+		       (error "Option :generic-function-class specified more \
+than once")
+		     (setq generic-function-class
+			   (legal-generic-function-classp (second option)))))
+		  (:method-class
+		   (if method-class
+		       (error "Option :method-class specified more than once")
+		     (setq method-class
+			   (parse-legal-method-class (second option)))))
+		  (:method
+		   (push (parse-legal-method-list (second option))
+			  method-list))
+		  (otherwise 
+		   (error "~S is not a legal defgeneric option" 
+			  (first option)))))
+    (values argument-precedence-order declaration documentation 
+	    method-combination generic-function-class  method-class 
+	    method-list)))
+
+(defun ensure-generic-function (function-specifier 
+				&key lambda-list
+				argument-precedence-order
+				declare
+				documentation
+				(generic-function-class
+				 'STANDARD-GENERIC-FUNCTION)
+				(method-combination 'STANDARD)
+				(method-class 'STANDARD-METHOD)
+				environment)
+  (unless (LEGAL-GENERIC-FUNCTION-NAME-P function-specifier)
+    (error "Generic function ~A has incorrect function specifier
+                  (a non-nil symbol, a list whose car is SETF)"
+	   function-specifier))
+  (when (LEGAL-GENERIC-FUNCTION-P function-specifier)
+    (unless (classp method-class)
+      (setq method-class 
+	    (find-class method-class)))
+
+    (let (dispatcher gf-object)
+      (if (and (fboundp function-specifier)
+	       (si:gfunp 
+		(setq dispatcher (symbol-function function-specifier))))
+
+	  ;; modify the existing object
+	  (progn
+	    (setf gf-object
+		  (si:gfun-instance dispatcher)
+		  (slot-value gf-object 'ARGUMENT-PRECEDENCE-ORDER)
+		  argument-precedence-order
+		  (slot-value gf-object 'DOCUMENTATION)
+		  documentation
+		  (generic-function-method-combination gf-object)
+		  method-combination
+		  (slot-value gf-object 'METHOD-CLASS)
+		  method-class)
+	    ;;(if (or
+	    ;;     (not (method-exist-p function-specifier))
+	    ;;     (congruent-lambda-list-p lambda-list 
+	    ;;		    (lambda-list gf-object)))
+	    ;;   (setf (lambda-list generic-function) lambda-list))
+	    ;;(when (and generic-function-class
+	    ;;           (compatible-p generic-function-class
+	    ;;                         (generic-function-class gf-object)))
+	    ;;     (change-class gf-object generic-function-class))
+	    )
+	  ;; else create a new generic function object
+	  (setf dispatcher (make-gfun function-specifier lambda-list)
+		gf-object (make-instance 
+			   generic-function-class
+			   :lambda-list lambda-list
+			   :argument-precedence-order argument-precedence-order
+			   :method-combination method-combination
+			   :method-class method-class
+			   :documentation documentation
+			   :gfun dispatcher)
+		(si:gfun-instance dispatcher) gf-object
+		(symbol-function function-specifier) dispatcher))
+      gf-object)))
+
+;;; ----------------------------------------------------------------------
+;;;                                                             congruence
+
+(defun congruent-lambda-list-p (l1 l2)
+  (let (post-keyword)
+    (do ((scan1 l1 (cdr scan1))
+	 (scan2 l2 (cdr scan2)))
+	((and (null scan1) (null scan2)))
+	(cond ((and (not post-keyword)
+		    (or
+		     (and 
+		      (member (first scan1) 
+			      '(&REST &KEY &ALLOW-OTHER-KEYS &AUX))
+		      (not (member (first scan2) 
+			      '(&REST &KEY &ALLOW-OTHER-KEYS &AUX))))
+		     (and 
+		      (member (first scan2) 
+			      '(&REST &KEY &ALLOW-OTHER-KEYS &AUX))
+		      (not (member (first scan1) 
+			      '(&REST &KEY &ALLOW-OTHER-KEYS &AUX))))))
+	       (error "the two lambda lists ~S ~S have not the same number
+                       of required parameters" l1 l2))
+	      ((eq (first scan1) '&OPTIONAL)
+	       (unless (eq (first scan2) '&OPTIONAL)
+		       (error "the two lambda lists ~S ~S have not the same 
+                        number of optional parameters" l1 l2))
+	       (do ((scan-op1 (cdr scan1) (cdr scan-op1))
+		    (scan-op2 (cdr scan2) (cdr scan-op2)))
+		    ((and (null scan-op1) (null scan-op2)))
+		    (cond ((or (null scan-op2)
+			      (member (car scan-op2) 
+				      '(&REST &KEY &ALLOW-OTHER-KEYS &AUX)))
+			  (error "the two lambda lists ~S ~S have not the same 
+                        number of optional parameters" l1 l2)))))))))
+
+;;; ----------------------------------------------------------------------
+;;;                                                                parsing
+
+(defun parse-lambda-list (lambda-list &optional post-keyword)
+  (let ((arg (car lambda-list)))
+    (cond ((null lambda-list))
+	  ((eq arg '&AUX)
+	   (error "&aux is not allowed in a generic function lambda-list"))
+	  ((member arg lambda-list-keywords)
+	   (parse-lambda-list (cdr lambda-list) t))
+	  (post-keyword
+	   ;; After a lambda-list-keyword there can be no specializers.
+	   (parse-lambda-list (cdr lambda-list) t))
+	  (t
+	   (if (listp arg)
+	       (error "the parameters cannot be specialized in generic function lambda-list")
+	       (parse-lambda-list (cdr lambda-list)))))))
+
+(defun parse-parameter-names (parameter-list lambda-list)
+  (let (required-list count)
+    (setf required-list
+	  (do ((l lambda-list (cdr l)))
+	      ((or (null l)
+		   (member (car l) '(&REST &KEY &ALLOW-OTHER-KEYS)))
+	       (nreverse required-list))
+	      (push l required-list)))
+    (dolist (l required-list parameter-list)
+	    (setf count (count l parameter-list))
+	    (when (not (= count 1))
+		  (error "the required parameter ~S must be included
+                                exactly once in the argument-precedence-order 
+                                option" l)))))
+
+(defun parse-legal-declaration (decl)
+  (unless (eq (car decl) 'OPTIMIZE)
+	  (error "The only declaration allowed is optimize"))
+  (do* ((d (cdr decl) (cdr d))
+	(first (car d) (car d)))
+       ((null d) decl)
+       (unless (member (car first) '(SPEED SPACE))
+	       (error "The only qualities allowed are speed and space"))))
+
+(defun parse-legal-documentation (doc)
+  (unless (stringp doc)
+	  (error "The documentation must be a string"))
+  doc)
+
+(defun parse-legal-method-combination (name args)
+  (unless (method-combination-p name)
+	  (error "~A is not the name of a method-combination type" name))
+  (unless (legal-method-combination-args name args)
+	  (error "~S are not legal args for the method combination type ~A"
+		 args name))
+  (values name args))
+
+(defun legal-generic-function-classp (class-name)
+  ; until we don't know when a class can be the class of a generic function
+  (unless (subtypep (find-class class-name) 
+		    (find-class 'GENERIC-FUNCTION))
+	  (error "The class ~S cannnot be the class of a generic function" 
+		 class-name))
+  class-name)
+
+(defun parse-legal-method-class (class-name)
+  ; until we don't know when a class can be the class of a method
+  (error "At the moment the class of a method can be only standard-method"))
+
+(defun parse-legal-method-list (methods-list)
+  methods-list)
+
diff --git a/src/clos/init.lsp b/src/clos/init.lsp
new file mode 100644
index 000000000..af0042908
--- /dev/null
+++ b/src/clos/init.lsp
@@ -0,0 +1,10 @@
+(load "../util/system")
+(load "defsys")
+(load "cmpinit")
+(setq compiler:*cc* (concatenate 'STRING compiler:*cc* " -I../h -I../../linux/h"))
+(rename-package 'clos 'old-clos)
+(setq si:*gc-verbose* nil)
+(sbt:build-system clos :compile :force)
+;(setq *print-circle* t)
+;(allocate 'cons 800 t)
+(quit)
\ No newline at end of file
diff --git a/src/clos/inspect.lsp b/src/clos/inspect.lsp
new file mode 100644
index 000000000..520c74041
--- /dev/null
+++ b/src/clos/inspect.lsp
@@ -0,0 +1,457 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; new methods for slot-boundp and slot-value
+
+(defmethod slot-value ((class t) slot-name)
+  (multiple-value-bind (val condition)
+    (general-instance-get class slot-name)
+    (ecase condition
+      (:VALUE val)
+      (:UNBOUND (slot-unbound (si:instance-class class) class slot-name))
+      (:MISSING (slot-missing (si:instance-class class) class slot-name
+			      'SLOT-VALUE))
+      )))
+
+(defmethod slot-value ((class standard-class) slot-name)
+  (multiple-value-bind (val condition)
+    (general-instance-get class slot-name)
+    (ecase condition
+      (:VALUE val)
+      (:UNBOUND (slot-unbound (si:instance-class class) class slot-name))
+      (:MISSING (slot-missing (si:instance-class class) class slot-name
+			      'SLOT-VALUE))
+      )))
+
+(defmethod slot-boundp ((class standard-class) slot-name)
+  (multiple-value-bind (val condition)
+    (general-instance-get class slot-name)
+    (ecase condition
+      (:VALUE t)
+      (:UNBOUND nil)
+      (:MISSING (slot-missing (si:instance-class class) class slot-name
+			      'SLOT-BOUNDP))
+      )))
+
+(defmethod slot-boundp ((class t) slot-name)
+  (multiple-value-bind (val condition)
+    (general-instance-get class slot-name)
+    (ecase condition
+      (:VALUE t)
+      (:UNBOUND nil)
+      (:MISSING (slot-missing (si:instance-class class) class slot-name
+			      'SLOT-BOUNDP))
+      )))
+
+(defmethod select-clos-N ((instance standard-object))
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS))
+	 (class-slotds (slot-value class 'CLOS::CLASS-CLASS-SLOTS)))
+        (if local-slotds
+	    (progn
+	      (si::inspect-indent)
+	      (format t "The local slots are:~%")
+	      (incf si::*inspect-level*)
+	      (dolist (slotd local-slotds)
+		(si::inspect-indent-1)
+		(format t "name : ~S" (clos::slotd-name slotd))
+		(if (slot-boundp instance (clos::slotd-name slotd))
+		    (si::inspect-recursively "value:"
+		       (slot-value instance (clos::slotd-name slotd))
+		       (slot-value instance (clos::slotd-name slotd)))
+		    (si::inspect-print "value: Unbound"
+		       nil
+		       (slot-value instance (clos::slotd-name slotd)))))
+	      (decf si::*inspect-level*))
+	    (progn
+	      (si::inspect-indent)
+	      (format t "It has no local slots.~%")))
+	(if class-slotds
+	    (progn
+	      (si::inspect-indent)
+	      (format t "The class slots are:~%")
+	      (incf si::*inspect-level*)
+	      (dolist (slotd class-slotds)
+		(si::inspect-indent-1)
+		(format t "name : ~S" (clos::slotd-name slotd))
+		(if (slot-boundp instance (clos::slotd-name slotd))
+		    (si::inspect-recursively "value:"
+		       (slot-value instance (clos::slotd-name slotd))
+		       (slot-value instance (clos::slotd-name slotd)))
+		    (si::inspect-print "value: Unbound"
+		       nil
+		       (slot-value instance (clos::slotd-name slotd)))))
+	      (decf si::*inspect-level*))
+	    (progn
+	      (si::inspect-indent)
+	      (format t "It has no class slots.~%")))))
+
+(defmethod select-clos-N ((instance standard-class))
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS)))
+        (if local-slotds
+	    (progn
+	      (si::inspect-indent)
+	      (format t "The (local) slots are:~%")
+	      (incf si::*inspect-level*)
+	      (dolist (slotd local-slotds)
+		(si::inspect-indent-1)
+		(format t "name : ~S" (clos::slotd-name slotd))
+		(if (slot-boundp instance (clos::slotd-name slotd))
+		    (si::inspect-recursively "value:"
+		       (slot-value instance (clos::slotd-name slotd))
+;		       (slot-value instance (clos::slotd-name slotd))
+		       )
+		    (si::inspect-print "value: Unbound"
+		       nil
+;		       (slot-value instance (clos::slotd-name slotd))
+		       )))
+	      (decf si::*inspect-level*))
+	    (progn
+	      (si::inspect-indent)
+	      (format t "It has no (local) slots.~%")))))
+
+(defmethod select-clos-N ((instance t))
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS)))
+        (if local-slotds
+	    (progn
+	      (si::inspect-indent)
+	      (format t "The (local) slots are:~%")
+	      (incf si::*inspect-level*)
+	      (dolist (slotd local-slotds)
+		(si::inspect-indent-1)
+		(format t "name : ~S" (clos::slotd-name slotd))
+		(if (slot-boundp instance (clos::slotd-name slotd))
+		    (si::inspect-recursively "value:"
+		       (slot-value instance (clos::slotd-name slotd))
+;		       (slot-value instance (clos::slotd-name slotd))
+		       )
+		    (si::inspect-print "value: Unbound"
+		       nil
+;		       (slot-value instance (clos::slotd-name slotd))
+		       )))
+	      (decf si::*inspect-level*))
+	    (progn
+	      (si::inspect-indent)
+	      (format t "It has no (local) slots.~%")))))
+
+(defmethod select-clos-L ((instance standard-object))
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS))
+	 (class-slotds (slot-value class 'CLOS::CLASS-CLASS-SLOTS)))
+        (terpri)
+	(if local-slotds
+	    (progn
+	      (format t "The names of the local slots are:~%")
+	      (dolist (slotd local-slotds)
+		(format t "  ~S~%" (clos::slotd-name slotd))))
+	    (progn
+	      (format t "It has no local slots.~%")))
+	(terpri)
+	(if class-slotds
+	    (progn
+	      (format t "The names of the class slots are:~%")
+	      (dolist (slotd class-slotds)
+		(format t "  ~S~%" (clos::slotd-name slotd))))
+	    (progn
+	      (format t "It has no class slots.~%")))
+	(terpri)))
+
+(defmethod select-clos-L ((instance standard-class))
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS)))
+        (terpri)
+	(if local-slotds
+	    (progn
+	      (format t "The names of the (local) slots are:~%")
+	      (dolist (slotd local-slotds)
+		      (format t "  ~S~%" (clos::slotd-name slotd))))
+	    (progn
+	      (format t "It has no (local) slots.~%")))
+	(terpri)))
+
+(defmethod select-clos-L ((instance t))
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS)))
+        (terpri)
+	(if local-slotds
+	    (progn
+	      (format t "The names of the (local) slots are:~%")
+	      (dolist (slotd local-slotds)
+		      (format t "  ~S~%" (clos::slotd-name slotd))))
+	    (progn
+	      (format t "It has no (local) slots.~%")))
+	(terpri)))
+
+(defmethod select-clos-J ((instance standard-object))
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS))
+	 (class-slotds (slot-value class 'CLOS::CLASS-CLASS-SLOTS))
+	 (slotd (car (member (prog1
+			       (read-preserving-whitespace *query-io*)
+			       (si::inspect-read-line))
+			     (append local-slotds class-slotds)
+			     :key #'clos::slotd-name
+			     :test #'eq))))
+        (if slotd
+	    (progn
+	      (incf si::*inspect-level*)
+	      (si::inspect-indent-1)
+	      (format t "name : ~S" (clos::slotd-name slotd))
+	      (if (slot-boundp instance (clos::slotd-name slotd))
+		  (si::inspect-recursively "value:"
+		     (slot-value instance (clos::slotd-name slotd))
+		     (slot-value instance (clos::slotd-name slotd)))
+		  (si::inspect-print "value: Unbound"
+		     nil
+		     (slot-value instance (clos::slotd-name slotd))))
+	      (decf si::*inspect-level*))
+	    (progn
+	      (terpri)
+	      (format t "~S is not a slot of the instance." (slotd-name slotd))
+	      (terpri)
+	      (terpri)))))
+
+(defmethod select-clos-J ((instance standard-class))
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS))
+	 (slotd (car (member (prog1
+			       (read-preserving-whitespace *query-io*)
+			       (si::inspect-read-line))
+			     local-slotds
+			     :key #'clos::slotd-name
+			     :test #'eq))))
+        (if slotd
+	    (progn
+	      (incf si::*inspect-level*)
+	      (si::inspect-indent-1)
+	      (format t "name : ~S" (clos::slotd-name slotd))
+	      (if (slot-boundp instance (clos::slotd-name slotd))
+		  (si::inspect-recursively "value:"
+		     (slot-value instance (clos::slotd-name slotd))
+;		     (slot-value instance (clos::slotd-name slotd))
+		     )
+		  (si::inspect-print "value: Unbound"
+		     nil
+;		     (slot-value instance (clos::slotd-name slotd))
+		     ))
+	      (decf si::*inspect-level*))
+	    (progn
+	      (terpri)
+	      (format t "~S is not a slot of the instance." (slotd-name slotd))
+	      (terpri)
+	      (terpri)))))
+
+(defmethod select-clos-J ((instance t))
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS))
+	 (slotd (car (member (prog1
+			       (read-preserving-whitespace *query-io*)
+			       (si::inspect-read-line))
+			     local-slotds
+			     :key #'clos::slotd-name
+			     :test #'eq))))
+        (if slotd
+	    (progn
+	      (incf si::*inspect-level*)
+	      (si::inspect-indent-1)
+	      (format t "name : ~S" (clos::slotd-name slotd))
+	      (if (slot-boundp instance (clos::slotd-name slotd))
+		  (si::inspect-recursively "value:"
+		     (slot-value instance (clos::slotd-name slotd))
+;		     (slot-value instance (clos::slotd-name slotd))
+		     )
+		  (si::inspect-print "value: Unbound"
+		     nil
+;		     (slot-value instance (clos::slotd-name slotd))
+		     ))
+	      (decf si::*inspect-level*))
+	    (progn
+	      (terpri)
+	      (format t "~S is not a slot of the instance." (slotd-name slotd))
+	      (terpri)
+	      (terpri)))))
+
+(defun select-clos-? ()
+  (terpri)
+  (format t
+	  "Inspect commands for clos instances:~%~
+n (or N or Newline):  inspects all slots of the class (recursively).~%~
+s (or S):             skips the field.~%~
+p (or P):             pretty-prints the field.~%~
+a (or A):             aborts the inspection of the rest of the fields.~%~
+e (or E) form:        evaluates and prints the form.~%~
+l (or L):             show the names of all slots.~%~
+j (or J) slot-name:   inspect the slot with the name requested.~%~
+q (or Q):             quits the inspection.~%~
+?:                    prints this.~%~%"
+	  ))
+
+(defmethod inspect-obj ((instance standard-object))
+  (unless (eq (si:instance-class (si:instance-class instance))
+              (find-class 'STANDARD-CLASS))
+          (terpri)
+          (format t "No applicable method CLOS::INSPECT-OBJ for an instance~%")
+          (format t "of class ~S" (si:instance-class instance))
+          (throw 'SI::ABORT-INSPECT nil))
+  (decf si::*inspect-level*)
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS))
+	 (class-slotds (slot-value class 'CLOS::CLASS-CLASS-SLOTS)))
+    (loop
+      (format t "~S - clos object:" instance)
+      (incf si::*inspect-level*)
+      (si::inspect-indent)
+      (format t "- it is an instance of class named ~S,"
+	      (class-name class))
+      (si::inspect-indent)
+      (format t "- it has ~A local slots and ~A class slots: "
+	      (length local-slotds) (length class-slotds))
+      (force-output)
+      (case (do ((char (read-char *query-io*) (read-char *query-io*)))
+		((and (char/= char #\Space) (char/= #\Tab)) char))
+	    ((#\Newline #\Return)
+	     (select-clos-N instance)
+	     (return nil))
+	    ((#\n #\N)
+	     (si::inspect-read-line)
+	     (select-clos-N instance)
+	     (return nil))
+	    ((#\s #\S)
+	     (si::inspect-read-line)
+	     (return nil))
+	    ((#\p #\P)
+	     (si::inspect-read-line)
+	     (si::select-P instance))
+	    ((#\a #\A)
+	     (si::inspect-read-line)
+	     (throw 'SI::ABORT-INSPECT nil))
+	    ((#\e #\E)
+	     (si::select-E))
+	    ((#\q #\Q)
+	     (si::inspect-read-line)
+	     (throw 'SI::QUIT-INSPECT nil))
+	    ((#\l #\L)
+	     (si::inspect-read-line)
+	     (select-clos-L instance))
+	    ((#\j #\J)
+	     (select-clos-J instance))
+	    ((#\?)
+	     (si::inspect-read-line)
+	     (select-clos-?))
+	    (t
+	     (si::inspect-read-line)))
+      (decf si::*inspect-level*)
+      (si::inspect-indent)))
+  (incf si::*inspect-level*))
+
+(defmethod inspect-obj ((instance standard-class))
+  (decf si::*inspect-level*)
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS)))
+    (loop
+      (format t "~S - clos object:" instance)
+      (incf si::*inspect-level*)
+      (si::inspect-indent)
+      (format t "- it is an instance of class named ~S,"
+	      (class-name class))
+      (si::inspect-indent)
+      (format t "- it has ~A local slots: " (length local-slotds))
+      (force-output)
+      (case (do ((char (read-char *query-io*) (read-char *query-io*)))
+		((and (char/= char #\Space) (char/= #\Tab)) char))
+	    ((#\Newline #\Return)
+	     (select-clos-N instance)
+	     (return nil))
+	    ((#\n #\N)
+	     (si::inspect-read-line)
+	     (select-clos-N instance)
+	     (return nil))
+	    ((#\s #\S)
+	     (si::inspect-read-line)
+	     (return nil))
+	    ((#\p #\P)
+	     (si::inspect-read-line)
+	     (si::select-P instance))
+	    ((#\a #\A)
+	     (si::inspect-read-line)
+	     (throw 'SI::ABORT-INSPECT nil))
+	    ((#\e #\E)
+	     (si::select-E))
+	    ((#\q #\Q)
+	     (si::inspect-read-line)
+	     (throw 'SI::QUIT-INSPECT nil))
+	    ((#\l #\L)
+	     (si::inspect-read-line)
+	     (select-clos-L instance))
+	    ((#\j #\J)
+	     (select-clos-J instance))
+	    ((#\?)
+	     (si::inspect-read-line)
+	     (select-clos-?))
+	    (t
+	     (si::inspect-read-line)))
+      (decf si::*inspect-level*)
+      (si::inspect-indent)))
+  (incf si::*inspect-level*))
+
+(defmethod inspect-obj ((instance t))
+  (decf si::*inspect-level*)
+  (let* ((class (si:instance-class instance))
+	 (local-slotds (slot-value class 'CLOS::SLOTS)))
+    (loop
+      (format t "~S - clos object:" instance)
+      (incf si::*inspect-level*)
+      (si::inspect-indent)
+      (format t "- it is an instance of class named ~S,"
+	      (class-name class))
+      (si::inspect-indent)
+      (format t "- it has ~A local slots: " (length local-slotds))
+      (force-output)
+      (case (do ((char (read-char *query-io*) (read-char *query-io*)))
+		((and (char/= char #\Space) (char/= #\Tab)) char))
+	    ((#\Newline #\Return)
+	     (select-clos-N instance)
+	     (return nil))
+	    ((#\n #\N)
+	     (si::inspect-read-line)
+	     (select-clos-N instance)
+	     (return nil))
+	    ((#\s #\S)
+	     (si::inspect-read-line)
+	     (return nil))
+	    ((#\p #\P)
+	     (si::inspect-read-line)
+	     (si::select-P instance))
+	    ((#\a #\A)
+	     (si::inspect-read-line)
+	     (throw 'SI::ABORT-INSPECT nil))
+	    ((#\e #\E)
+	     (si::select-E))
+	    ((#\q #\Q)
+	     (si::inspect-read-line)
+	     (throw 'SI::QUIT-INSPECT nil))
+	    ((#\l #\L)
+	     (si::inspect-read-line)
+	     (select-clos-L instance))
+	    ((#\j #\J)
+	     (select-clos-J instance))
+	    ((#\?)
+	     (si::inspect-read-line)
+	     (select-clos-?))
+	    (t
+	     (si::inspect-read-line)))
+      (decf si::*inspect-level*)
+      (si::inspect-indent)))
+  (incf si::*inspect-level*))
+
+;;; -------------------------------------------------------------------------
diff --git a/src/clos/kernel.lsp b/src/clos/kernel.lsp
new file mode 100644
index 000000000..26eb5bec2
--- /dev/null
+++ b/src/clos/kernel.lsp
@@ -0,0 +1,182 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+(defconstant *default-method-cache-size* 64 "Size of hash tables for methods")
+
+;;; ----------------------------------------------------------------------
+
+(defun class-of (object)
+  (if (si:instancep object)
+      (si:instance-class object)
+      (typecase object
+	(NULL (find-class 'null))
+	(KEYWORD (find-class 'keyword))
+	(SYMBOL (find-class 'symbol))
+	(CONS (find-class 'cons))
+	(LIST (find-class 'list))
+	(STRING (find-class 'string))
+	(BIT-VECTOR (find-class 'bit-vector))
+	(VECTOR (find-class 'vector))
+	(SEQUENCE (find-class 'sequence))
+	(ARRAY (find-class 'array))
+	(CHARACTER (find-class 'character))
+	(INTEGER (find-class 'integer))
+	(RATIO (find-class 'ratio))
+	(RATIONAL (find-class 'rational))
+	(FLOAT (find-class 'float))
+	(COMPLEX (find-class 'complex))
+	(NUMBER (find-class 'number))
+	(PATHNAME (find-class 'pathname))
+	(LOGICAL-PATHNAME (find-class 'logical-pathname))
+	(t (find-class 't)))))
+
+(defun closest-class (type &aux fd)
+  (or (find-class type nil)
+      (case type
+	((FIXNUM BIGNUM) (find-class 'integer))
+	((SHORT-FLOAT LONG-FLOAT) (find-class 'float))
+	((BASE-CHAR STANDARD-CHAR EXTENDED-CHAR) (find-class 'character))
+	(SIMPLE-ARRAY (find-class 'array))
+	(SIMPLE-VECTOR (find-class 'vector))
+	(SIMPLE-BIT-VECTOR (find-class 'bit-vector))
+	(SIMPLE-STRING (find-class 'string))
+	((PACKAGE HASHTABLE STREAM READTABLE COMPILED-FUNCTION
+		  CONT THREAD DISPATCH-FUNCTION LOCATIVE)
+	 (find-class 't)))))
+	  
+	  
+
+;;; ----------------------------------------------------------------------
+;;; Each instance has a pointer to the class of which it is an instance.
+;;; Its is used to search for methods and class variables.
+
+;;; Bootstrapping for class Class.
+
+
+(defun search-make-instance (obj)
+  (let* ((gfun (symbol-function (if (si::tracing-body 'make-instance)
+				    (get 'make-instance 'si::traced)
+				    'make-instance)))
+	 (table (si:gfun-method-ht gfun))
+	 (key (list (class-name (si:instance-class obj))))
+	 (method (si:method-ht-get key table)))
+    (unless method
+      (setq method (si:compute-applicable-methods
+		    (si:gfun-instance gfun)
+		    (list obj))))
+    method))
+
+(defun classp (obj)
+  (and (si:instancep obj)
+       (search-make-instance obj)
+       t))
+
+(defun metaclassp (obj)
+  (and (si:instancep obj)
+       (search-make-instance (si:instance-class obj))
+       (search-make-instance obj)
+       t))
+
+;;; ----------------------------------------------------------------------
+;;; Object initializations
+
+(defun allocate-instance (class)
+  (si:allocate-instance class (length (class-slots class))))
+
+;;; ----------------------------------------------------------------------
+;;; Methods
+
+(defun install-method (name qualifiers specializers lambda-list doc plist
+			    fun &rest options)
+  (declare (ignore doc)
+	   (notinline ensure-generic-function method-class))
+;  (record-definition 'method `(method ,name ,@qualifiers ,specializers))
+  (let* ((gf (ensure-generic-function name :lambda-list lambda-list))
+	 (method (make-method qualifiers specializers lambda-list
+			      fun plist options gf (method-class gf)))
+	 (dispatcher (generic-function-dispatcher gf)))
+
+    ;; update the spec-how of the gfun 
+    ;; computing the or of the previous value and the new one
+    (do ((i 0 (1+ i))
+	 (l specializers (cdr l))
+	 (spec-how)
+	 (spec-how-old))
+	((null l))
+	(declare (fixnum i))
+	(setq spec-how (first l)
+	      spec-how-old (si:gfun-spec-how-ref dispatcher i))
+	(if (consp spec-how)		; an eql list
+	    (if (consp spec-how-old)
+		(push (second spec-how) (si:gfun-spec-how-ref dispatcher i))
+	      (setf (si:gfun-spec-how-ref dispatcher i) (cdr spec-how)))
+	  (unless (consp spec-how-old)	; either T or NIL
+	    (setf (si:gfun-spec-how-ref dispatcher i)
+		  (or spec-how spec-how-old)))))
+    (add-method gf method)))
+
+;;; ----------------------------------------------------------------------
+;;;                                                         early versions
+
+(defun method-class (gfun) 'standard-method)
+
+(defun methods (gf) (si:instance-ref gf 7))
+
+;(defun generic-function-dispatcher (gf) (si:instance-ref gf 6)) anticipata
+
+(defun make-gfun (name lambda-list)
+  (let* ((nargs
+	  (or (position-if
+	       #'(lambda (x)
+		   (member x '(&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX)
+			   :test #'eq))
+	       lambda-list)
+	      (length lambda-list)))
+	 (gfun
+	  (si:allocate-gfun
+	   name
+	   nargs
+	   (make-hash-table
+	    :test #'equal
+	    ;; use fixnums as limits for efficiency:
+	    :size *default-method-cache-size*
+	    :rehash-size #.(/ *default-method-cache-size* 2)
+	    :rehash-threshold #.(/ *default-method-cache-size* 2)))))
+    (declare (fixnum nargs))
+    (dotimes (i nargs)
+      (declare (fixnum i))
+      (setf (si:gfun-spec-how-ref gfun i) nil))
+    gfun))
+
+;;; early version used during bootstrap
+(defun ensure-generic-function (name &key lambda-list)
+  (let (gfun)
+    (unless (and (fboundp name)
+		 (si:gfunp (setq gfun (symbol-function name))))
+
+      ;; create a fake standard-generic-function object:
+      (let ((gf-object (si:allocate-instance (find-class 't) 8)))
+	(declare (type standard-object gf-object))
+	;; create a new gfun
+	(setq gfun (make-gfun name lambda-list))
+
+	(si:instance-set gf-object 0 lambda-list) ; lambda-list
+	(si:instance-set gf-object 1 'default) ; argument-precedence-order
+	(si:instance-set gf-object 2 'standard)	; method-combination
+	(si:instance-set gf-object 3 nil) ; method-combination-arguments
+	(si:instance-set gf-object 5 nil) ; documentation
+	(si:instance-set gf-object 6 gfun) ; gfun
+	(si:instance-set gf-object 7 nil) ; methods
+	(si:gfun-instance-set gfun gf-object)
+	(setf (symbol-function name) gfun)))
+
+    (si:gfun-instance gfun)))
+
diff --git a/src/clos/load.lsp.in b/src/clos/load.lsp.in
new file mode 100644
index 000000000..3a4c1a46f
--- /dev/null
+++ b/src/clos/load.lsp.in
@@ -0,0 +1,19 @@
+
+(load "@srcdir@/walk")
+(load "@srcdir@/macros")
+(load "@srcdir@/method")
+(load "@srcdir@/kernel")
+(load "@srcdir@/slot")
+(load "@srcdir@/combin")
+(load "@srcdir@/precomp")
+(load "@srcdir@/boot")
+(load "@srcdir@/print")
+(load "@srcdir@/defclass")
+(load "@srcdir@/standard")
+(load "@srcdir@/inspect")
+(load "@srcdir@/change")
+(load "@srcdir@/builtin")
+(load "@srcdir@/stdmethod")
+(load "@srcdir@/generic")
+(load "@srcdir@/fixup")
+(load "@srcdir@/conditions")
\ No newline at end of file
diff --git a/src/clos/macros.lsp b/src/clos/macros.lsp
new file mode 100644
index 000000000..8aed5ab74
--- /dev/null
+++ b/src/clos/macros.lsp
@@ -0,0 +1,119 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(defpackage "CLOS"
+  (:use "WALKER" "CL"))
+
+(in-package "CLOS")
+
+(eval-when (:compile-toplevel)
+  (print (si::compiled-function-block #'walker::walk-form)))
+
+;;; ----------------------------------------------------------------------
+
+;(proclaim '(DECLARATION VARIABLE-REBINDING))
+;;; Make this stable:
+(declaim '(DECLARATION VARIABLE-REBINDING))
+
+(defvar *keyword-package* (find-package 'KEYWORD))
+
+(defun make-keyword (symbol)
+  (intern (symbol-name symbol) *keyword-package*))
+
+(defmacro doplist ((key val) plist &body body)
+  `(let ((.plist-tail. ,plist) ,key ,val)
+     (loop (when (null .plist-tail.) (return nil))
+	   (setq ,key (pop .plist-tail.))
+	   (when (null .plist-tail.)
+	     (error "Malformed plist in doplist, odd number of elements."))
+	   (setq ,val (pop .plist-tail.))
+	   (progn ,@body))))
+  ;;
+;;;;;; FIND-CLASS  naming classes.
+  ;;
+;;;
+;;; (FIND-CLASS <name>) returns the class named <name>.  setf can be used
+;;; with find-class to set the class named <name>.  These are "extrinsic"
+;;; names.  Neither find-class nor setf of find-class do anything with the
+;;; name slot of the class, they only lookup and change the association from
+;;; name to class.
+;;; 
+
+;(defvar *class-name-hash-table* (make-hash-table :test #'eq)
+; "The hash table containing all classes")
+
+(defun find-class (name &optional (errorp t) environment)
+  (declare (ignore environment))
+  (let ((class (gethash name si:*class-name-hash-table*)))
+    (cond (class class)
+	  (errorp (error "No class named ~S." name))
+	  (t nil))))
+
+;;; This is only used during boot. The real one is in built-in.
+(defun setf-find-class (name new-value)
+  (if (classp new-value)
+      (setf (gethash name si:*class-name-hash-table*) new-value)
+    (error "~A is not a class." new-value)))
+
+(defsetf find-class setf-find-class)
+
+(defun legal-class-name-p (x)
+  (and (symbolp x)
+       (not (keywordp x))))
+
+;;; ----------------------------------------------------------------------
+
+(defmacro keyword-bind (keywords form &body body)
+  `(apply (function (lambda (&key . ,keywords) . ,body)) ,form))
+
+;;;----------------------------------------------------------------------
+;;; Implementation of Instance
+
+;;; ECL implementation:
+
+(proclaim '(function si:instance-ref (t fixnum) t))
+(proclaim '(function si:instance-set (t fixnum t) t))
+
+(defmacro unbound () '(sys:nani 0))
+
+;;; ----------------------------------------------------------------------
+;;; Class CLASS
+;;;
+;;; The slots in Class Class are:
+;;; name superiors inferiors slots methods
+
+(defmacro class-name		(class) `(si:instance-ref ,class 0))
+(defmacro class-superiors	(class) `(si:instance-ref ,class 1))
+(defmacro class-inferiors	(class) `(si:instance-ref ,class 2))
+(defmacro class-slots		(class) `(si:instance-ref ,class 3))
+
+;;; ----------------------------------------------------------------------
+;;; STANDARD-CLASS
+
+;;; for compiler optimization to work, a-standard-class should be
+;;; a variable declared of type standard-class.
+(defmacro slot-index-table (a-standard-class)
+  `(the hash-table (si:instance-ref ,a-standard-class 5)))
+
+;;; ----------------------------------------------------------------------
+;;; Low level printing
+;;;
+
+(defun set-function-name (fn new-name)
+  (cond ((typep fn 'COMPILED-FUNCTION)
+	 (si::set-compiled-function-name fn new-name))
+	((and (listp fn)
+	      (eq (car fn) 'LAMBDA-BLOCK))
+	 (setf (cadr fn) new-name))
+	((and (listp fn)
+	      (eq (car fn) 'LAMBDA))
+	 (setf (car fn) 'LAMBDA-BLOCK
+	       (cdr fn) (cons new-name (cdr fn)))))
+  fn)
+
diff --git a/src/clos/method.lsp b/src/clos/method.lsp
new file mode 100644
index 000000000..41d8b8897
--- /dev/null
+++ b/src/clos/method.lsp
@@ -0,0 +1,815 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; ----------------------------------------------------------------------
+
+(defvar *method-size* 32)		; Size of methods hash tables
+
+;;; This holds fake methods created during bootstrap.
+;;; It is  an alist of:
+;;;	(method-name {method}+)
+(defvar *early-methods* nil)
+
+;;;
+;;; This is used by combined methods to communicate the next methods to
+;;; the methods they call.  This variable is captured by a lexical variable
+;;; of the methods to give it the proper lexical scope.
+;;; 
+(defvar *next-methods* nil)
+
+
+;;; ----------------------------------------------------------------------
+;;; defmethod
+
+;;; For setf methods the syntax is:
+;;;    (defmethod (setf foo) ((nv type) (x1 type1) ... (xn typen))
+;;;       ...)
+;;; where nv is the new value to be assigned.
+
+(defmacro defmethod (&rest args &environment env)
+
+  ;; args = name {method-qualifier}* specialized-lambda-list &body body
+
+  (multiple-value-bind (name qualifiers lambda-list body)
+    (parse-defmethod args)
+    (multiple-value-bind (fn-form specializers doc plist)
+      (expand-defmethod name qualifiers lambda-list body env)
+      (multiple-value-bind
+	  (parameters specialized-lambda-list specializers)
+	(parse-specialized-lambda-list lambda-list nil)
+	(declare (ignore parameters))
+	(walker::env-lexical-variables env)
+	`(PROGN
+	  #+PDE
+	  (EVAL-WHEN
+	      (LOAD)
+	    (SI:RECORD-SOURCE-PATHNAME
+	     ',name '(DEFMETHOD ',qualifiers ',specializers)))
+	  (EVAL-WHEN (COMPILE LOAD EVAL)
+	    (INSTALL-METHOD
+	     ',name
+	     ',qualifiers
+	     ',specializers
+	     ',specialized-lambda-list
+	     ',doc
+	     ',plist
+	     ,fn-form)
+	    ))))))
+
+
+;;; ----------------------------------------------------------------------
+;;;                                                  method body expansion
+
+(defun expand-defmethod
+    (generic-function-name qualifiers specialized-lambda-list body env)
+  ;; (values fn-form specializers doc)
+  (declare (ignore qualifiers))
+  (multiple-value-bind (declarations real-body documentation)
+      (sys::find-declarations body)
+    (multiple-value-bind (parameters lambda-list specializers)
+	(parse-specialized-lambda-list specialized-lambda-list 't)
+
+      (let* ((required-parameters
+	      (mapcar #'(lambda (r s) (declare (ignore s)) r)
+		      parameters
+		      specializers))
+	     (class-declarations 
+	      `(declare
+		,@(mapcan #'(lambda (p s) (and (symbolp s) s
+					       (not (eq s 't))
+					       `((type ,s ,p))))
+			  parameters
+			  specializers)))
+	     (method-lambda 
+	      ;; Remove the documentation string and insert the
+	      ;; appropriate class declarations.  The documentation
+	      ;; string is removed to make it easy for us to insert
+	      ;; new declarations later, they will just go after the
+	      ;; second of the method lambda.  The class declarations
+	      ;; are inserted to communicate the class of the method's
+	      ;; arguments to the code walk.
+	      `(lambda-block ,(if (listp generic-function-name)
+				  (second generic-function-name)
+				  generic-function-name)
+		,lambda-list
+		,class-declarations
+		,@declarations
+		;; (progn ,@parameters-to-reference)
+		,@real-body))
+
+	     (call-next-method-p nil)	;flag indicating that call-next-method
+					;should be in the method definition
+	     (next-method-p-p nil)	;flag indicating that next-method-p
+					;should be in the method definition
+	     (save-original-args nil)	;flag indicating whether or not the
+					;original arguments to the method
+					;must be preserved.  This happens
+					;for two reasons:
+					; - the method takes &mumble args,
+					;   so one of the lexical functions
+					;   might be used in a default value
+					;   form
+					; - call-next-method is used without
+					;   arguments at least once in the
+					;   body of the method
+	     (original-args ())
+	     (applyp nil)		; flag indicating whether or not the
+					; method takes &mumble arguments. If
+					; it does, it means call-next-method
+					; without arguments must be APPLY'd
+					; to original-args.  If this gets set
+					; true, save-original-args is set so
+					; as well
+	     (aux-bindings ())		; Suffice to say that &aux is one of
+					; damndest things to have put in a
+					; language.
+	     (slots (mapcar #'list required-parameters))
+					; records for each class:
+					; - slot-index-table
+					; - slot-indexes for each slot
+					; See optimize-standard-instance-access.
+	     (plist ())
+	     (walked-lambda nil))
+	(flet ((walk-function (form context env)
+		 (cond ((not (eq context ':EVAL)) form)
+		       ((not (listp form)) form)
+		       ((eq (car form) 'CALL-NEXT-METHOD)
+			(setq call-next-method-p 't)
+			(setq save-original-args (not (cdr form)))
+			form)
+		       ((eq (car form) 'NEXT-METHOD-P)
+			(setq next-method-p-p 't)
+			form)
+		       ((and (eq (car form) 'FUNCTION)
+			     (case (second form)
+			       (CALL-NEXT-METHOD
+				(setq call-next-method-p 'T)
+				(setq save-original-args 'T)
+				form)
+			       (NEXT-METHOD-P
+				(setq next-method-p-p 'T)
+				form)
+			       (t nil))))
+		       ((and (eq (car form) 'SLOT-VALUE)
+			     (symbolp (second form))
+			     (constantp (third form)))
+			(multiple-value-bind (ignore class)
+			    (can-optimize-access (second form) env)
+			  (if class
+			      (optimize-slot-value class form)
+			      form)))
+		       ;; does not work for (push x (slot-value y 's))
+		       ;; and similia, since push is turned into
+		       ;; (|(setf slot-value)| (cons (slot-value y 's) x) x 's)
+		       ((eq (car form) 'SETF)
+			(if (cdddr form)
+			    (do* ((setf-list (cdr form) (cddr setf-list))
+				  (instance-access)
+				  (value)
+				  (result))
+				 ((null setf-list)
+				  (cons 'PROGN (nreverse result)))
+			      (setq instance-access (car setf-list)
+				    value (second setf-list))
+			      (push
+			       (if (and instance-access
+					(listp instance-access)
+					(eq (car instance-access)
+					    'SLOT-VALUE)
+					(symbolp (second instance-access))
+					(constantp (third instance-access)))
+				   (multiple-value-bind (ignore class)
+				       (can-optimize-access
+					(second instance-access) env)
+				     (let ((new-form
+					    (list 'SETF instance-access
+						  value)))
+				       (if class
+					   (optimize-set-slot-value class
+								    new-form)
+					   new-form)))
+				   (list 'SETF instance-access value))
+			       result))
+			    (if (and (cdr form)
+				     (second form)
+				     (listp (second form))
+				     (eq (caadr form) 'SLOT-VALUE)
+				     (symbolp (cadadr form))
+				     (constantp (third (second form))))
+				(multiple-value-bind (ignore class)
+				    (can-optimize-access (cadadr form) env)
+				  (if class
+				      (optimize-set-slot-value class form)
+				      form))
+				form)))
+
+		       ((eq (car form) 'STANDARD-INSTANCE-ACCESS)
+			(multiple-value-bind (parameter class)
+			    (can-optimize-access (second form) env)
+			  (if class
+			      (optimize-standard-instance-access
+			       class parameter form slots)
+			      form)))
+		       (t form))))
+
+	  (setq walked-lambda (walk-form method-lambda env #'walk-function))
+
+	  ;; Scan the lambda list to determine whether this method
+	  ;; takes &mumble arguments.  If it does, we set applyp and
+	  ;; save-original-args true.
+	  ;; 
+	  ;; This is also the place where we construct the original
+	  ;; arguments lambda list if there has to be one.
+	  (dolist (p lambda-list)
+	    (if (member p '(&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX)
+			:test #'eq)	; cant use lambda-list-keywords
+		(if (eq p '&aux)
+		    (progn
+		      (setq aux-bindings (cdr (member '&AUX lambda-list
+						      :test #'eq)))
+		      (return nil))
+		    (progn
+		      (setq applyp t
+			    save-original-args t)
+		      (push '&REST original-args)
+		      (push (make-symbol "AMPERSAND-ARGS") original-args)
+		      (return nil)))
+		(push (make-symbol (symbol-name p)) original-args)))
+	  (setq original-args (when save-original-args
+				(nreverse original-args)))
+	  
+	  (multiple-value-bind (walked-declarations walked-lambda-body)
+	      (sys::find-declarations (cdddr walked-lambda) t)
+	    (declare (ignore ignore))
+	    
+	    (when (some #'cdr slots)	; there are optimized slot accesses
+	      (setq walked-lambda-body
+		    (add-index-binding walked-lambda-body slots)))
+	    (when (or next-method-p-p call-next-method-p)
+	      (setq plist (list* :needs-next-methods-p 'T plist)))
+
+	    (values
+	     `(function ,(if (or call-next-method-p next-method-p-p)
+			     (add-lexical-functions-to-method-lambda
+			      walked-declarations
+			      walked-lambda-body
+			      `(lambda-block ,(second walked-lambda)
+				,lambda-list
+				,@walked-declarations
+				,.walked-lambda-body)
+			      original-args
+			      lambda-list
+			      save-original-args
+			      applyp
+			      aux-bindings
+			      call-next-method-p
+			      next-method-p-p)
+			     `(lambda-block ,(second walked-lambda)
+			       ,lambda-list
+			       ,@walked-declarations
+			       ,.walked-lambda-body)))
+	     specializers
+	     documentation
+	     plist)))))))
+
+(defun add-lexical-functions-to-method-lambda (walked-declarations
+					       walked-lambda-body
+					       walked-lambda
+					       original-args
+					       lambda-list
+					       save-original-args
+					       applyp
+					       aux-bindings
+					       call-next-method-p
+					       next-method-p-p)
+  (cond ((and (null save-original-args)
+	      (null applyp))
+	 ;;
+	 ;; We don't have to save the original arguments.  In addition,
+	 ;; this method doesn't take any &mumble arguments (this means
+	 ;; that there is no way the lexical functions can be used inside
+	 ;; of the default value form for an &mumble argument).
+	 ;;
+	 ;; We can expand this into a simple lambda expression with an
+	 ;; FLET to define the lexical functions.
+	 ;; 
+	 `(lambda ,lambda-list
+	    ,@walked-declarations
+	    (let ((.next-method. (car *next-methods*))
+		  (*next-methods* (cdr *next-methods*)))
+	      (flet (,@(and call-next-method-p
+;;;
+;;; WARNING: these &rest/apply combinations produce useless garbage. Beppe
+;;;
+			    '((CALL-NEXT-METHOD (&REST CNM-ARGS)
+				;; (declare (static-extent cnm-args))
+				(IF .NEXT-METHOD.
+				    (APPLY .NEXT-METHOD. CNM-ARGS)
+				    (ERROR "No next method.")))))
+		     ,@(and next-method-p-p
+			    '((NEXT-METHOD-P ()
+				(NOT (NULL .NEXT-METHOD.))))))
+		,@walked-lambda-body)))
+
+;;; Assuming that we can determine statically which is the next method,
+;;; we could use this solution. Compute-effective-method can set
+;;; the value of .next-method. within each closure at the appropriate
+;;; value. Same thing for next case. 	Beppe
+;	 `(let (.next-method.)
+;	    (lambda ,lambda-list
+;	      ,@walked-declarations
+;	      (flet (,@(and call-next-method-p
+;			    '((CALL-NEXT-METHOD (&REST CNM-ARGS)
+;				;; (declare (static-extent cnm-args))
+;				(IF .NEXT-METHOD.
+;				    (APPLY .NEXT-METHOD. CNM-ARGS)
+;				    (ERROR "No next method.")))))
+;		     ,@(and next-method-p-p
+;			    '((NEXT-METHOD-P ()
+;				(NOT (NULL .NEXT-METHOD.))))))
+;		,@walked-lambda-body)))
+	 )
+	((null applyp)
+	 ;;
+	 ;; This method doesn't accept any &mumble arguments.  But we
+	 ;; do have to save the original arguments (this is because
+	 ;; call-next-method is being called with no arguments).
+	 ;; Have to be careful though, there may be multiple calls to
+	 ;; call-next-method, all we know is that at least one of them
+	 ;; is with no arguments.
+	 ;; 
+	 `(lambda ,original-args
+	    (let ((.next-method. (car *next-methods*))
+		  (*next-methods* (cdr *next-methods*)))
+	      (flet (,@(and call-next-method-p
+                            `((call-next-method (&rest cnm-args)
+				;; (declare (static-extent cnm-args))
+				(if .next-method.
+				    (if cnm-args
+					(apply .next-method. cnm-args)
+					(funcall .next-method. ,@original-args))
+				    (error "No next method.")))))
+		     ,@(and next-method-p-p
+			    '((NEXT-METHOD-P ()
+				(NOT (NULL .NEXT-METHOD.))))))
+		(let* (,@(mapcar #'list
+				 (subseq lambda-list 0
+					 (position '&AUX lambda-list))
+				 original-args)
+		       ,@aux-bindings)
+		  ,@walked-declarations
+		  ,@walked-lambda-body)))))
+	(t
+	 ;;
+	 ;; This is the fully general case.
+	 ;; We must allow for the lexical functions being used inside
+	 ;; the default value forms of &mumble arguments, and if must
+	 ;; allow for call-next-method being called with no arguments.
+	 ;; 
+	 `(lambda ,original-args
+	    (let ((.next-method. (car *next-methods*))
+		  (*next-methods* (cdr *next-methods*)))
+	      (flet (,@(and call-next-method-p
+			    `((call-next-method (&rest cnm-args)
+				;; (declare (static-extent cnm-args))
+				(if .next-method.
+				    (if cnm-args
+					(apply .next-method. cnm-args)
+					(apply .next-method. 
+					       ,@(remove '&REST original-args)))
+				    (error "No next method.")))))
+		     ,@(and next-method-p-p
+			    '((NEXT-METHOD-P ()
+				(NOT (NULL .NEXT-METHOD.))))))
+		(apply (function ,walked-lambda)
+		       ,@(remove '&REST original-args))))))))
+
+#|
+(defun make-parameter-references (specialized-lambda-list
+				  required-parameters
+				  declarations
+				  generic-function-name
+				  specializers)
+  (flet ((ignoredp (symbol)
+	   (dolist (decl (cdar declarations))
+	     (when (and (eq (car decl) 'IGNORE)
+			(member symbol (cdr decl) :test #'eq))
+	       (return t)))))	   
+    (do ((sscan specialized-lambda-list (cdr sscan))
+	 (pscan required-parameters (cdr pscan))
+	 (references nil))
+	((null sscan) (nreverse references))
+	(cond ((not (listp (car sscan))))
+	      ((ignoredp (caar sscan))
+	       (warn "In defmethod ~S ~S, there is a~%~
+                      redundant ignore declaration for the parameter ~S."
+		     generic-function-name
+		     specializers
+		     (caar sscan)))
+	      (t (push (caar sscan) references))))))
+|#
+
+;;; ----------------------------------------------------------------------
+;;;                                                                parsing
+
+(defun legal-generic-function-name-p (name)
+  (or (symbolp name) (si:setf-namep name)))
+
+(defun parse-defmethod (args)
+  ;; (values name qualifiers arglist body)
+  (let (name qualifiers)
+    (unless args
+      (error "Illegal defmethod form: missing method name"))
+    (setq name (pop args))
+    (unless (legal-generic-function-name-p name)
+      (error "~A cannot be a generic function specifier.~%~
+             It must be either a non-nil symbol or ~%~
+             a list whose car is setf and whose second is a non-nil symbol."
+	     name))
+    (unless args
+      (error "Illegal defmethod form: missing lambda-list"))
+    (loop (cond ((null (first args))
+		 (error "Illegal defmethod form: null lambda-list"))
+		((consp (first args))
+		 (return (setq qualifiers (nreverse qualifiers))))
+		(t (push (pop args) qualifiers))))
+    (values name qualifiers (first args) (rest args))))
+
+(defun parse-specialized-lambda-list (arglist warningp)
+  ;; This function has been modified to get an easy control on the
+  ;; correctness of the specialized-lambda-list. Furthermore it has became
+  ;; an iterative function.
+  ;; -- Daniele --
+  (let (parameters lambda-list specializers)
+    (do ((arg (first arglist) (first arglist)))
+	((or (null arglist)
+	     (member arg '(&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX))))
+      (pop arglist)
+      (when (and warningp (member arg lambda-list-keywords))
+	(warn "Unrecognized lambda-list keyword ~S in arglist.~%~
+                        Assume this keyword as a required parameter."
+	      arg))
+      (push (if (listp arg) (first arg) arg) parameters)
+      (push (if (listp arg) (first arg) arg) lambda-list)
+      (push (if (listp arg) (if (consp (second arg))
+				`(eql ,(eval (cadadr arg)))
+				(second arg))
+		())
+	    specializers))
+    (when (eq (first arglist) '&OPTIONAL)
+      (push (pop arglist) lambda-list)
+      (do ((arg (first arglist) (first arglist)))
+	  ((or (null arglist)
+	       (member arg '(&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS
+			     &AUX))))
+	(pop arglist)
+	(when (and warningp (member arg lambda-list-keywords))
+	  (warn "Unrecognized lambda-list keyword ~S in arglist.~%~
+                           Assume this keyword as an optional parameter."
+		arg))
+	(push (if (listp arg) (first arg) arg) parameters)
+	(push arg lambda-list)))
+    (when (eq (first arglist) '&REST)
+      (push (pop arglist) lambda-list)
+      (when (not (symbolp (first arglist)))
+	(error "~S in the lambda-list is not a symbol."
+	       (first arglist)))
+      (push (pop arglist) lambda-list))
+    (when (eq (first arglist) '&KEY)
+      (push (pop arglist) lambda-list)
+      (do ((arg (first arglist) (first arglist)))
+	  ((or (null arglist)
+	       (member arg '(&OPTIONAL &REST &KEY &AUX))))
+	(pop arglist)
+	(when (eq arg '&ALLOW-OTHER-KEYS)
+	  (push arg lambda-list)
+	  (return))
+	(when (and warningp (member arg lambda-list-keywords))
+	  (warn "Unrecognized lambda-list keyword ~S in arglist.~%~
+                           Assume this keyword as a keyword parameter."
+		arg))
+	(push (if (listp arg) (first arg) arg) parameters)
+	(push arg lambda-list)))
+    (when (eq (first arglist) '&AUX)
+      (push (pop arglist) lambda-list)
+      (do ((arg (first arglist) (first arglist)))
+	  ((or (null arglist)
+	       (member arg '(&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS
+			     &AUX))))
+	(pop arglist)
+	(when (and warningp (member arg lambda-list-keywords))
+	  (warn "Unrecognized lambda-list keyword ~S in arglist.~%~
+                           Assume this keyword as an aux parameter."
+		arg))
+	(push (if (listp arg) (first arg) arg) parameters)
+	(push arg lambda-list)))
+    (when arglist (error "The position of the lambda-list keyword ~S~%~
+                             is not correct."
+			 (first arglist)))
+    (values (nreverse parameters)
+	    (nreverse lambda-list)
+	    (nreverse specializers))))
+
+(defun declaration-specializers (arglist declarations)
+  (do ((argscan arglist (cdr argscan))
+       (declist (when declarations (cdr declarations))))
+      ((or
+	(null argscan)
+	(member (first argscan) '(&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX)))
+       `(DECLARE ,@declist))
+      (when (listp (first argscan))
+	    (push `(TYPE ,(cadar argscan) ,(caar argscan)) declist))))
+
+
+;;; ----------------------------------------------------------------------
+;;;                                                             operations
+
+;;; early version used during bootstrap
+(defstruct (method (:type list)
+		   (:constructor make-method
+				 (qualifiers specializers lambda-list
+					     function plist options
+					     &rest ignore)))
+  (class-name 'STANDARD-METHOD)
+  qualifiers specializers lambda-list function plist options)
+
+;;; early version used during bootstrap
+(defun method-p (x) (and (listp x) (eq 'STANDARD-METHOD (first x))))
+
+;;; early version used during bootstrap
+(defun method-needs-next-methods-p (method)
+  (getf (nth 5 method) :needs-next-methods-p))
+
+(defun generic-function-dispatcher (gf) (si:instance-ref gf 6))
+
+;;; early version used during bootstrap
+(defun add-method (gf method)
+  (let* ((name (si:gfun-name (generic-function-dispatcher gf)))
+	 (method-entry (assoc name *early-methods*)))
+    (unless method-entry
+      (setq method-entry (list name))
+      (push method-entry *early-methods*))
+    (push method (cdr method-entry))
+    method))
+
+(defun find-method (gf qualifiers specializers &optional (errorp t))
+  (declare (notinline method-qualifiers))
+  (let ((method-list (methods gf))
+	(required-args (subseq (lambda-list gf) 0 (length specializers)))
+	found)
+    (dolist (method method-list)
+      (when (and (equal qualifiers (method-qualifiers method))
+		 (equal specializers (specializers method)))
+	(setq found method)
+	(return)))
+    (if (and (not found) errorp)
+	(error "There is no method on the generic function ~S that agrees on 
+               qualifiers ~S and specializers ~S"
+	       (si:gfun-name (generic-function-dispatcher gf))
+	       qualifiers specializers)
+	found)))
+
+
+;;; ----------------------------------------------------------------------
+;;;                                                              bootstrap
+
+(defvar *method-key-hash-table* (make-hash-table :test #'eq :size 32)
+  ; the hash table containing the keywords accepted by
+  ; allocate-instance and initialize-instance methods
+  )
+
+(defun update-method-key-hash-table (class lambda-list)
+  (let (post-key-list keywords-list)
+    ;; search &key in lambda-list
+    (setq post-key-list
+	  (do ((scan lambda-list (cdr scan)))
+	      ((null scan))
+	      (when (eq (first scan) '&KEY)
+		(return (cdr scan)))))
+    ;; extract keywords from post-key-list
+    (when post-key-list
+      (do* ((key-scan post-key-list (cdr key-scan))
+	    (first-key-scan (first key-scan) (first key-scan)))
+	   ((or (null key-scan)
+		(member first-key-scan '(&ALLOW-OTHER-KEYS &AUX)))
+	    (setq keywords-list (nreverse keywords-list)))
+	(push (if (listp first-key-scan) 
+		  (let ((key-par (first first-key-scan)))
+		    (if (listp key-par) (first key-par)
+			(make-keyword key-par)))
+		  (make-keyword first-key-scan))
+	      keywords-list))
+      ;; insert in the hash table a new entry whose keyword is the class name
+      ;; and whose value is the keyword list accepted by the method
+      (setf (gethash class *method-key-hash-table*) keywords-list))))
+
+
+;;; ----------------------------------------------------------------------
+;;;                                                             with-slots
+
+(defmacro with-slots (slot-entries instance-form &body body)
+  (let* ((temp (gensym))
+	 (accessors
+	  (do ((scan slot-entries (cdr scan))
+	       (res))
+	      ((null scan) (nreverse res))
+	      (if (symbolp (first scan))
+		  (push `(,(first scan) (slot-value ,temp ',(first scan))) res)
+		(push `(,(caar scan)
+			(slot-value ,temp ',(cadar scan))) res)))))
+    `(let ((,temp ,instance-form))
+       ,@(and (symbolp instance-form)
+	      `((declare (variable-rebinding ,temp ,instance-form))))
+       (symbol-macrolet ,accessors ,@body))))
+
+;(with-slots (x (y2 y)) inst (setq x y2))
+
+;;; ----------------------------------------------------------------------
+;;;                                                         with-accessors
+
+(defmacro with-accessors (slot-accessor-pairs instance-form &body body)
+  (let* ((temp (gensym))
+	 (accessors (do ((scan slot-accessor-pairs (cdr scan))
+			(res))
+		       ((null scan) (nreverse res))
+		       (push `(,(caar scan) (,(cadar scan) ,temp)) res))))
+    `(let ((,temp ,instance-form))
+       ,@(and (symbolp instance-form)
+	      `((declare (variable-rebinding ,temp ,instance-form))))
+       (symbol-macrolet ,accessors ,@body))))
+
+
+;;; ----------------------------------------------------------------------
+;;;                                                              bootstrap
+
+(defun si:compute-applicable-methods (gf args)
+  (let* ((gfun (generic-function-dispatcher gf))
+	 (name (si:gfun-name gfun))
+	 (setfp (and (listp name) (eq 'SETF (first name))))
+	 (early-methods (cdr (assoc name *early-methods*)))
+	 methods)
+    (labels ((search-early-methods (class)
+	       (let* ((class-name (class-name class))
+		      (method (find (if setfp
+					(list 'T class-name)
+					(list class-name))
+				    early-methods
+				    :key #'method-specializers
+				    :test #'(lambda (x y)
+					      (if setfp
+						  (eq (second x) (second y))
+						  (eq (first x) (first y)))))))
+		 (when method (push method methods))
+		 ;; search in the superclasses
+		 (dolist (c (class-superiors class))
+		   (search-early-methods c)))))
+      (search-early-methods
+	   (find-class (type-of (if setfp (second args) (first args)))))
+      (nreverse methods))))
+
+
+(defun si:generic-function-method-combination (gf))
+
+(defun si:generic-function-method-combination-args (gf))
+
+(defun si:compute-effective-method (gf applicable-methods 
+				    method-combination-type
+				    method-combination-args)
+  (declare (ignore method-combination-type method-combination-args))
+  ; the simplest case
+  (if applicable-methods
+      (make-effective-method-function
+       `(call-method ,(first applicable-methods)
+		     ,(cdr applicable-methods)))
+    (no-applicable-method gf)))
+
+
+
+;;; ----------------------------------------------------------------------
+;;;                                                             optimizers
+
+(defun can-optimize-access (var env)
+  ;; (values required-parameter class)
+  (let ((required-parameter?
+	  (or (third (variable-declaration 'VARIABLE-REBINDING var env))
+	      var)))
+    (if required-parameter?
+	(values required-parameter?
+		(find-class (variable-class required-parameter? env) 'NIL))
+	(values nil nil))))
+
+
+(defun optimize-standard-instance-access (class parameter form slots)
+  ;; Returns an optimized form corresponding to FORM.
+  ;; SLOTS is a list of:
+  ;;	(parameter [(class . class-index-table) {(slot-name . slot-index)}+])
+  ;; parameters of the same class share the cdr of such list.
+  ;;
+  (let ((instance (second form))
+	 (slot-name (reduce-constant (third form)))
+	 (new (fourth form))
+	 (entry (assoc parameter slots :test #'eq))
+	slot)
+    (unless entry
+      (error "Can't optimize instance access.  Report this as a bug."))
+    (setq slot (find slot-name (slot-value class 'SLOTS)
+		     :key #'slotd-name))
+    (unless slot
+      (error "Slot ~A not present in class ~A." slot-name class))
+    (if (eq :INSTANCE (slotd-allocation slot))
+	(let (slot-entry slot-index)
+	  (unless (cdr entry)
+	    ;; there is just one index-table for each different class
+	    (let ((class-slot-info (find class slots :key #'caadr :test #'eq)))
+	      (setf (cdr entry)
+		    (if class-slot-info
+			(cdr class-slot-info)
+			;; create variable for index-table
+			(list (cons class (gensym)))))))
+	  (setq slot-entry (assoc slot-name (cddr entry) :test #'eq))
+	  (if slot-entry
+	      (setq slot-index (cdr slot-entry))
+	      (push (cons slot-name (setq slot-index (gensym)))
+		    (cddr entry)))
+	  (if new
+	      `(si:instance-set ,instance ,slot-index ,new)
+	      `(the ,(slotd-type slot)
+		(si:instance-ref-safe ,instance ,slot-index))))
+	;; dont'optimize shared slots
+	(if new
+	    `(standard-instance-set ,new ,instance ',slot-name)
+	    `(standard-instance-get ,instance ',slot-name)))))
+
+;(defun get-slotd-type (class slot)
+;  (slotd-type (find slot (slot-value class 'SLOTS) :key #'slotd-name)))
+
+(defun signal-slot-unbound (instance slot-name)
+  (slot-unbound (si:instance-class instance) instance slot-name))
+
+(defun add-index-binding (method-body isl)
+  (let (class-index-bindings
+	slot-index-bindings
+	slot-index-declarations)
+
+    ;; don't forget setf! Chicca
+    (setf class-index-bindings
+	  (dolist (entry isl (nreverse class-index-bindings))
+	    ;; check if the entry provides the information needed! Chicca
+	    (when (cdr entry)
+	      (unless (assoc (cdadr entry) class-index-bindings :test #'eq)
+		(push `(,(cdadr entry)
+			(let ((class (si:instance-class ,(first entry))))
+			  (declare (type standard-class class))
+			  (slot-index-table class)))
+		      class-index-bindings)))))
+
+    ;; don't forget setf! Chicca
+    (setf slot-index-bindings 
+	  (dolist (entry isl (nreverse slot-index-bindings))
+	    (dolist (slot-entry (cddr entry))
+	      (push `(,(cdr slot-entry)
+		      (slot-index ',(first slot-entry) ,(cdadr entry)))
+		    slot-index-bindings)
+	      (push `(fixnum ,(cdr slot-entry))
+		    slot-index-declarations))))
+
+    `((let ,class-index-bindings
+	(let ,slot-index-bindings
+	  (declare . ,slot-index-declarations)
+	  . ,method-body)))))
+
+
+;;; Force the compiler into optimizing use of gethash inside methods:
+(setf (symbol-function 'SLOT-INDEX) (symbol-function 'GETHASH))
+(setf (get 'SLOT-INDEX ':INLINE-ALWAYS)
+       '(((T T) FIXNUM NIL NIL "fix(gethash(#0,#1))")
+	 ((T T) T NIL NIL "(gethash(#0,#1))")))
+
+(defun reduce-constant (old)
+  (let ((new (eval old)))
+    (if (eq new old)
+	new
+	(if (constantp new)
+	    (reduce-constant new)
+	    new))))
+
+;;; ----------------------------------------------------------------------
+;;;                                                                 walker
+
+;;; Inform the walker of the kind of declarations to consider:
+
+(pushnew 'TYPE *variable-declarations*)
+(pushnew 'VARIABLE-REBINDING *variable-declarations*)
+
+(defun variable-class (var env)
+  (second (variable-declaration 'TYPE var env)))
+
+;;; ----------------------------------------------------------------------
diff --git a/src/clos/precomp.lsp b/src/clos/precomp.lsp
new file mode 100644
index 000000000..25229bdcf
--- /dev/null
+++ b/src/clos/precomp.lsp
@@ -0,0 +1,139 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    ECoLisp is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+(defmacro pre-make-caching-discriminating-functions (specs)
+  `(progn ,.(mapcar #'(lambda (s)
+			`(pre-make-templated-function-constructor
+			   caching-discriminating-function
+			   ,.s))
+		    specs)))
+
+(defmacro pre-make-templated-function-constructor (name
+						   &rest template-parameters)
+  (let* ((params (get name 'TEMPLATED-FN-PARAMS))
+	 (template-params (first params))
+	 (instance-params (second params))
+	 (body (cddr params))
+	 (form 
+	  (progv template-params
+		 template-parameters
+	    `(LET ((ENTRY
+		    (OR (ASSOC ',template-parameters 
+			       (GET ',name 'TEMPLATED-FN-CONSTRUCTORS)
+			       :test #'equal)
+			(LET ((NEW-ENTRY
+			       (LIST ',template-parameters () () ())))
+			  (PUSH NEW-ENTRY
+				(GET ',name 'TEMPLATED-FN-CONSTRUCTORS))
+			  NEW-ENTRY))))
+	      (SETF (THIRD ENTRY) 'COMPILED)
+	      (SETF (SECOND ENTRY)
+	       (FUNCTION (LAMBDA ,(eval instance-params)
+		 ,(eval (cons 'PROGN body)))))))))
+    form))
+
+(eval-when (load)
+  (pre-make-caching-discriminating-functions
+    ((1 NIL (0) 32)
+     (2 NIL (0) 32)
+     (2 NIL (1) 32)		;setf of accessor gfuns
+     (2 NIL (0 1) 32)
+     (3 NIL (0) 32)
+     (3 NIL (1) 32)
+     (3 NIL (0 1) 32)
+     (4 NIL (0) 32)
+     (4 NIL (1) 32)
+     (5 NIL (0) 32)
+     (5 NIL (0 1) 32)
+     (6 NIL (0) 32)
+     (6 NIL (0 1) 32)
+     (7 NIL (0) 32)
+     
+     (1 T (0) 32)
+     (2 T (0) 32)
+     (2 T (0 1) 32)
+     (3 T (0) 32)
+     (4 T (0) 32))))
+
+(eval-when (compile eval)
+  (defmacro precompile-effective-method-templates (templates)
+    `(progn ,@(mapcar #'(lambda (x)
+			  `(precompile-effective-method-template ,x))
+		      templates))))
+
+(precompile-effective-method-templates 
+  (
+   (_call-method_)				      ;1 or more :around
+						      ;methods with 0 or
+						      ;more next methods
+						      ;This case happens
+						      ;whenever there are
+						      ;:around methods
+
+
+   (PROGN (_call-method_)			      ;1 :before 1 :after
+	  (MULTIPLE-VALUE-PROG1			      ;*** NO PRIMARY, COMMON
+	    (error "No applicable primary method.")   ;*** INTERMEDIATE STATE
+	    (_call-method_)))
+
+   (PROGN (_call-method_)			      ;1 :before 0 :after
+	  (MULTIPLE-VALUE-PROG1			      ;*** NO PRIMARY, COMMON
+	    (error "No applicable primary method."))) ;*** INTERMEDIATE STATE
+
+
+   (PROGN ()					      ;0 :before 1 :after
+	  (MULTIPLE-VALUE-PROG1			      ;*** NO PRIMARY, COMMON
+	    (error "No applicable primary method.")   ;*** INTERMEDIATE STATE
+	    (_call-method_)))
+
+
+   (PROGN (_call-method_)			      ;1 :before 1 :after
+	  (MULTIPLE-VALUE-PROG1 (_call-method_)
+				(_call-method_)))
+
+   (PROGN ()					      ;0 :before 1 :after
+	  (MULTIPLE-VALUE-PROG1 (_call-method_)
+				(_call-method_)))
+
+   (PROGN (_call-method_)			      ;1 :before 0 :after
+	  (MULTIPLE-VALUE-PROG1 (_call-method_)
+				()))
+
+
+   (PROGN (_call-method_)			      ;2 :befores 2 :after
+	  (_call-method_)
+	  (MULTIPLE-VALUE-PROG1 (_call-method_)
+				(_call-method_)
+				(_call-method_)))
+
+
+   (PROGN (_call-method_)			      ;2 :befores 1 :after
+	  (_call-method_)
+	  (MULTIPLE-VALUE-PROG1 (_call-method_)
+				(_call-method_)))
+
+   (PROGN (_call-method_)			      ;1 :before 2 :after
+	  (MULTIPLE-VALUE-PROG1 (_call-method_)
+				(_call-method_)
+				(_call-method_)))
+
+
+   (PROGN (_call-method_)			      ;2 :befores no :after
+	  (_call-method_)
+	  (MULTIPLE-VALUE-PROG1 (_call-method_)
+				()))
+
+   (PROGN (_call-method_)			      ;0 :before 2 :after
+	  (MULTIPLE-VALUE-PROG1 (_call-method_)
+				(_call-method_)
+				(_call-method_)))
+  
+   ))
diff --git a/src/clos/print.lsp b/src/clos/print.lsp
new file mode 100644
index 000000000..35954c1a1
--- /dev/null
+++ b/src/clos/print.lsp
@@ -0,0 +1,77 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; ----------------------------------------------------------------------
+;;; Printing
+;;; ----------------------------------------------------------------------
+
+(defmethod print-object ((instance t) stream)
+  (print-unreadable-object (instance stream)
+	(format stream "a ~A"
+		(si:instance-ref (si:instance-class instance) 0)))
+  instance)
+
+(defmethod print-object ((class class) stream)
+  (print-unreadable-object (class stream)
+	(format stream "The ~A ~A"
+		(class-name (si:instance-class class)) (class-name class)))
+  class)
+
+
+;;; ----------------------------------------------------------------------
+;;; Describe
+;;; ----------------------------------------------------------------------
+
+(defmethod describe-object ((obj t) &optional (stream t))
+  (let* ((class (class-of obj))
+	 (slotds (class-slots class)))
+    (format stream "~%~A is an instance of class ~A"
+	    obj (class-name class))
+    (do ((scan slotds (cdr scan))
+	 (i 0 (1+ i))
+	 (sv))
+	((null scan))
+	(declare (fixnum i))
+	(setq sv (si:instance-ref obj i))
+	(print (slotd-name (car scan)) stream) (princ ":	" stream)
+	(if (si:sl-boundp sv)
+	    (prin1 sv stream)
+	  (prin1 "Unbound" stream))))
+  obj)
+
+(defmethod describe-object ((obj class) &optional (stream t))
+  (let* ((class  (si:instance-class obj))
+	 (slotds (class-slots class)))
+    (format stream "~%~A is an instance of class ~A"
+	    obj (class-name class))
+    (do ((scan slotds (cdr scan))
+	 (i 0 (1+ i))
+	 (sv))
+	((null scan))
+	(declare (fixnum i))
+	(print (slotd-name (car scan)) stream) (princ ":	" stream)
+	(case (slotd-name (car scan))
+	      ((superiors inferiors)
+	       (princ "(" stream)
+	       (do* ((scan (si:instance-ref obj i) (cdr scan))
+		     (e (car scan) (car scan)))
+		    ((null scan))
+		    (prin1 (class-name e) stream)
+		    (when (cdr scan) (princ " " stream)))
+	       (princ ")" stream))
+	      (otherwise 
+	       (setq sv (si:instance-ref obj i))
+	       (if (si:sl-boundp sv)
+		   (prin1 sv stream)
+		 (prin1 "Unbound" stream))))))
+  obj)
+
+;;; ----------------------------------------------------------------------
diff --git a/src/clos/slot.lsp b/src/clos/slot.lsp
new file mode 100644
index 000000000..c8149e24e
--- /dev/null
+++ b/src/clos/slot.lsp
@@ -0,0 +1,82 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; ----------------------------------------------------------------------
+;;; SLOT descriptors
+;;;
+
+(defstruct (slotd (:type list))
+  name initargs initform accessors readers writers allocation type
+  documentation)
+
+(defun PARSE-SLOT (slot)
+  (let ((name nil)
+        (initargs nil)
+        (initform 'INITFORM-UNSUPPLIED)	; default
+        (accessors ())
+        (readers ())
+        (writers ())
+        (allocation ':INSTANCE)
+        (type 'T)				; default
+	(documentation nil)
+	(slotd (make-slotd)))
+
+    (cond ((symbolp slot)     (setq name slot))
+          ((null (cdr slot))  (setq name (car slot)))
+          (t
+           (setq name (car slot))
+           (let ((options (cdr slot))
+		 (option nil)
+		 (value nil))
+             (loop (when (null options) (return t))
+		   (setq option (pop options)
+			 value (pop options))
+		   (unless (legal-slot-option-p option)
+		     (error "In the slot description ~S,~%~
+                             the option ~S is not legal."
+			    slot option))
+                   (case option
+                     (:initarg    (push value initargs))
+                     (:initform   (setq initform value))
+                     (:accessor   (push value accessors))
+                     (:reader     (push value readers))
+                     (:writer     (push value writers))
+                     (:allocation (setq allocation value))
+                     (:type       (setq type (if (null value) (error "In the slot description ~S, ~%~
+                                                                      the type option is not complete")
+					       value)))
+                     (:documentation     (push value documentation)))))))
+
+    (setf (slotd-name slotd)       name
+;	  (slotd-keyword slotd)    (make-keyword name)
+	  (slotd-initargs slotd)   initargs
+	  (slotd-initform slotd)   initform
+	  (slotd-accessors slotd)  accessors
+	  (slotd-readers slotd)    readers
+	  (slotd-writers slotd)    writers
+	  (slotd-allocation slotd) allocation
+	  (slotd-type slotd)       type)
+	  (slotd-documentation slotd)    documentation
+
+    slotd))
+
+(defun PARSE-SLOTS (slots)
+  (do ((scan slots (cdr scan))
+       (collect))
+      ((null scan) (nreverse collect))
+    (push (parse-slot (first scan)) collect)))
+
+(defun LEGAL-SLOT-OPTION-P (option)
+  (member option
+	  '(:accessor :reader :writer :allocation :initarg :initform :type
+		      :documentation)))
+
+;;; ----------------------------------------------------------------------
diff --git a/src/clos/standard.lsp b/src/clos/standard.lsp
new file mode 100644
index 000000000..e53aa80f4
--- /dev/null
+++ b/src/clos/standard.lsp
@@ -0,0 +1,586 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;; ----------------------------------------------------------------------
+
+;;; bootstrap order:
+(defmethod (setf slot-value) (val (instance standard-object) slot-name)
+  (standard-instance-set val instance slot-name))
+
+;;; ----------------------------------------------------------------------
+
+(eval-when (compile load eval)
+  (defun create-standard-class
+      (name superclasses-names
+	    direct-slots		; both instance + shared in this class
+	    all-slots
+	    default-initargs
+	    documentation)
+    (let* ((metaclass (find-class 'STANDARD-CLASS))
+	   (existing (find-class name nil))
+	   (superclasses (mapcar #'find-class superclasses-names))
+	   (cpl (compute-class-precedence-list name superclasses)))
+
+      (flet ((unchanged-class ()
+	       (declare (inline si:instance-class))
+	       (and existing
+		    (eq metaclass (si:instance-class existing))
+		    (equal (or superclasses-names '(STANDARD-OBJECT))
+					; i.e. class-default-direct-superclasses
+			   (mapcar #'(lambda (x) (class-name x))
+				   (class-superiors existing)))
+		    (equal direct-slots (slot-value existing 'DIRECT-SLOTS))
+		    (equal all-slots (slot-value existing 'SLOTS))
+		    (equal default-initargs (default-initargs-of existing))
+		    (prog2 (setf (slot-value existing 'DOCUMENTATION)
+				 documentation)
+			t))))
+
+	(if (unchanged-class)
+	    existing
+	    (let ((new-class
+		   (make-instance
+		    metaclass
+		    :name name
+		    :direct-superclasses superclasses
+		    :slots all-slots
+
+		    ;; The following slots are defined in standard-class.
+		    ;; initialize-instance takes care of them
+		    :direct-slots direct-slots
+		    :class-precedence-list cpl
+		    :default-initargs
+		    (collect-default-initargs cpl default-initargs)
+		    :documentation documentation)))
+	      (when existing
+		(redefine-class existing new-class superclasses-names
+				(class-inferiors existing))) ; Beppe
+	      new-class)))))
+  ;;; Bootstrap versions.
+  (defun redefine-class (class new-class superclasses-names inferiors)
+    (declare (ignore superclasses-names inferiors))
+    (format t "~%Redefinition of class ~A." (class-name class))
+    new-class))
+
+;;; ----------------------------------------------------------------------
+;;; STANDARD-CLASS
+;;; ----------------------------------------------------------------------
+
+(defclass standard-class (class)
+  ;; class-precedence-list must be in the same position as in structure-class
+  ((precedence-list :initarg :class-precedence-list)
+   slot-index-table
+   ;; associates names to slot index.
+   ;; For shared slots it contains (class . index) pairs for indexing into
+   ;; the shared-slots of class
+   ;; Be careful when changing the position of this slot!
+   (direct-slots :initarg :direct-slots) ; instance + shared in this class
+   (shared-slots :initarg :shared-slots	; vector of shared slots
+		 :initform nil
+		 :accessor class-shared-slots)
+   (instance-slot-count :accessor class-instance-slot-count)
+   (default-initargs :initarg :default-initargs :reader default-initargs-of)
+   (documentation :initarg :documentation :accessor documentation-of)
+   (forward)				; forwarding pointer to redefined class
+   )
+  (:metaclass class))
+
+;;; ----------------------------------------------------------------------
+;;; Standard-object
+;;; ----------------------------------------------------------------------
+
+;;; Standard-object has no slots and inherits only from t:
+;;; (defclass standard-object (t) ())
+
+(eval-when
+ (compile load eval)
+ (make-instance (find-class 'STANDARD-CLASS)
+		:NAME 'STANDARD-OBJECT
+		:DIRECT-SUPERCLASSES (list (find-class 'T))
+		:SLOTS ()
+		:CLASS-PRECEDENCE-LIST (list (find-class 'T))
+		:DIRECT-SLOTS ()
+		:DEFAULT-INITARGS ()
+		:DOCUMENTATION "The root of inheritance for objects"))
+
+#+PDE
+(si:record-source-pathname 'STANDARD-OBJECT 'DEFCLASS)
+
+(defmethod slot-value ((object standard-object) slot-name)
+  (multiple-value-bind (val condition)
+    (standard-instance-get object slot-name)
+    (ecase condition
+      (:VALUE val)
+      (:UNBOUND	(slot-unbound (si:instance-class object) object slot-name))
+      (:MISSING (slot-missing (si:instance-class object) object slot-name
+			      'SLOT-VALUE))
+      )))
+
+(defmethod slot-boundp ((instance standard-object) slot-name)
+  (multiple-value-bind (val condition)
+      (standard-instance-get instance slot-name)
+    (declare (ignore val))
+    (ecase condition
+      (:VALUE t)
+      (:UNBOUND nil)
+      (:MISSING (slot-missing (si:instance-class instance) instance slot-name
+			      'SLOT-BOUNDP))
+      )))
+      
+(defmethod slot-exists-p ((instance standard-object) slot-name)
+  (let ((class (si:instance-class instance)))
+    (declare (type standard-class class))
+    (slot-index slot-name (slot-index-table class))))
+
+(defmethod slot-makunbound ((instance standard-object) slot-name)
+  (let* ((class (si:instance-class instance))
+	 (index (slot-index slot-name (slot-index-table class))))
+    (if index
+	(if (atom index)
+	    (si:sl-makunbound instance (the fixnum index))
+	    ;; else it is a shared slot
+	    (setf (svref (class-shared-slots (car index)) (cdr index))
+		  (unbound)))
+	(slot-missing (si:instance-class instance) instance slot-name
+		      'SLOT-MAKUNBOUND))))
+
+(defmethod shared-initialize ((instance standard-object) 
+			      slot-names &rest initargs)
+  ;;
+  ;; initialize the instance's slots is a two step process
+  ;;   1 A slot for which one of the initargs in initargs can set
+  ;;      the slot, should be set by that initarg.  If more than
+  ;;      one initarg in initargs can set the slot, the leftmost
+  ;;      one should set it.
+  ;;
+  ;;   2 Any slot not set by step 1, may be set from its initform
+  ;;      by step 2.  Only those slots specified by the slot-names
+  ;;      argument are set.  If slot-names is:
+  ;;       T
+  ;;            any slot not set in step 1 is set from its
+  ;;            initform
+  ;;       <list of slot names>
+  ;;            any slot in the list, and not set in step 1
+  ;;            is set from its initform
+  ;;
+  ;;       ()
+  ;;            no slots are set from initforms
+  ;;
+  (let* ((class (si:instance-class instance)))
+    ;; initialize-instance slots
+    (dolist (slotd (class-slots class))
+      (let* ((slot-initargs (slotd-initargs slotd))
+	     (slot-name (slotd-name slotd)))
+
+	(or
+	 ;; Try to initialize the slot from one of the initargs.
+	 (doplist (initarg val)
+		  initargs
+		  (when (member initarg slot-initargs :test #'eq)
+		    (setf (slot-value instance slot-name) val)
+		    (return 'T)))
+	 ;; Try to initialize the slot from its initform.
+	 (when (and slot-names
+		    (or (eq slot-names 'T)
+			(member slot-name slot-names :test #'eq))
+		    (not (slot-boundp instance slot-name)))
+	   (let ((initform (slotd-initform slotd)))
+	     (unless (eq initform 'INITFORM-UNSUPPLIED)
+	       (setf (slot-value instance slot-name) (eval initform)))))))))
+  instance)
+
+(defmethod initialize-instance ((instance standard-object) &rest initargs)
+  (apply #'shared-initialize instance t initargs))
+
+(defmethod reinitialize-instance ((instance standard-object) &rest initargs)
+    (let* ((class (si:instance-class instance)))
+      (flet ((search-allow-other-keys (initargs-list)
+	       (do ((arg-list initargs-list (cddr arg-list)))
+		   ((null arg-list) nil)
+		 (when (eq (first arg-list) ':ALLOW-OTHER-KEYS)
+		   (return (second arg-list))))))
+	(unless (search-allow-other-keys initargs)
+	  (check-initargs class initargs)))
+      (apply #'shared-initialize instance nil initargs)
+      instance))
+
+(defmethod change-class ((instance standard-object) (new-class standard-class))
+    (let* ((old-class (si:instance-class instance))
+	   (old-slotds (class-slots old-class))
+	   (new-slotds (class-slots new-class)))
+
+      ;; "The values of local slots specified by both the class Cto and
+      ;; Cfrom are retained.  If such a local slot was unbound, it remains
+      ;; unbound."
+      ;; "The values of slots specified as shared in the class Cfrom and
+      ;; as local in the class Cto are retained."
+      (let ((new-i 0)
+	    (old-i 0)
+	    retained-correspondance)
+	(declare (fixnum new-i))
+	(dolist (new-slot new-slotds)
+	  (setq old-i (position (slotd-name new-slot) old-slotds
+				:key #'slotd-name :test #'eq))
+	  (when old-i
+	    (push (cons new-i old-i) retained-correspondance))
+	  (incf new-i))
+	(si:change-instance instance new-class
+			    (class-instance-slot-count new-class)
+			    (nreverse retained-correspondance)))
+
+      ;; Compute the newly added slots.  The spec defines
+      ;; newly added slots as "those local slots for which no slot of
+      ;; the same name exists in the previous class."
+      (let (added-slots)
+	(dolist (slotd new-slotds)
+	  (if (and (not (member slotd old-slotds :key #'slotd-name :test #'eq))
+		   (eq (slotd-allocation slotd) ':INSTANCE))
+	      (push (slotd-name slotd) added-slots)))
+	(apply #'shared-initialize instance added-slots)))
+
+  instance)
+
+
+(defmethod update-instance-for-redefined-class ((instance standard-object)
+						added-slots
+						discarded-slots
+						property-list
+						&rest initargs)
+  (declare (ignore discarded-slots property-list))
+  ;; ***
+  ;; *** Later we need to do initarg checking here.
+  ;; ***
+  (apply #'shared-initialize instance added-slots initargs))
+
+(defmethod describe-object ((obj standard-object))
+  (let* ((class (si:instance-class obj))
+	 (slotds (class-slots class))
+	 slotname has-shared-slots)
+    (format t "~%~A is an instance of class ~A"
+	    obj (class-name class))
+    (when slotds
+      ;; print instance slots
+      (format t "~%it has the following instance slots")
+      (dolist (slot slotds)
+	(setq slotname (slotd-name slot))
+	(case (slotd-allocation slot)
+	  (:INSTANCE
+	   (format t "~%~A:~24,8T~A"
+		   slotname
+		   (if (slot-boundp obj slotname)
+		       (slot-value obj slotname) "Unbound")))
+	  ;; :CLASS
+	  (T (setq has-shared-slots t))))
+      (when has-shared-slots
+	;; print class slots
+	(format t "~%it has the following class slots")
+	(dolist (slot slotds)
+	  (setq slotname (slotd-name slot))
+	  (unless (eq (slotd-allocation slot) :INSTANCE)
+	    (format t "~%~A:~24,8T~A"
+		    slotname
+		    (if (slot-boundp obj slotname)
+			(slot-value obj slotname) "Unbound")))))))
+  obj)
+
+;;; ----------------------------------------------------------------------
+;;; Now we can fix inheritance for standard-class:
+
+(eval-when (compile load eval)
+	   (setf (class-superiors (find-class 'STANDARD-CLASS))
+		 (list (find-class 'CLASS)
+		       (find-class 'STANDARD-OBJECT))))
+
+;;; ----------------------------------------------------------------------
+;;; default-initargs
+
+(defmethod default-initargs ((class t) initargs)
+  initargs)
+
+(defmethod default-initargs ((class standard-class) initargs)
+  (do ((scan (reverse (default-initargs-of class)) (cddr scan))
+       (defaults))
+      ((null scan) (nconc initargs (nreverse defaults)))
+    (unless (do ((iscan initargs (cddr iscan)))
+		((null iscan) nil)
+	      (when (eq (first iscan) (second scan)) (return t)))
+      (setq defaults (nconc defaults (list (first scan) (second scan)))))))
+
+;;; ----------------------------------------------------------------------
+;;; check-initargs
+
+(defun check-initargs (class initargs)
+  ;; scan initarg list 
+  (do* ((name-loc initargs (cddr name-loc))
+	(name (first name-loc) (first name-loc)))
+       ((null name-loc) class)
+    (if (null (cdr name-loc))
+	(error "No value supplied for the init-name ~S." name)
+	(unless
+	    (or 
+	     ;; check if the arguments is associated with a slot
+	     (do ((scan-slot (class-slots class) (cdr scan-slot)))
+		 ((null scan-slot) ())
+	       (when (member name (slotd-initargs (first scan-slot)))
+		 (return t)))
+	     #| modify this
+		;; check if the argument is associated with a 
+		;; initialize-instance or allocate-instance method
+		;; inspecting all the keywords of the applicable methods
+		(let ((cpl (cons class (slot-value class
+                                        'PRECEDENCE-LIST)))
+		      cpl-names)
+		  ; convert cpl in the list of the names of the classes
+		  (do ((scan-cpl cpl (cdr scan-cpl)))
+		      ((null scan-cpl) (setq cpl-names (nreverse cpl-names)))
+		      (push (class-name (first scan-cpl)) cpl-names))
+		  (dolist (scan cpl-names)
+			  (when (member name
+					(gethash scan *method-key-hash-table*))
+				(return t))))
+|#
+	     )
+	  ;; signal error
+	  (error "Unknown initialization option ~A for class ~A"
+		 name class)))))
+
+;;; ----------------------------------------------------------------------
+;;; Basic access to instances
+
+(defun standard-instance-get (instance slot-name)
+  (let* ((class (si:instance-class instance))
+	 (index (gethash slot-name (slot-index-table class))))
+    (declare (type standard-class class))
+    (if (null index)
+	(values nil :MISSING)
+	(let ((val (if (atom index)
+		       ;; local slot
+		       (si:instance-ref instance (the fixnum index))
+		       ;; shared slot
+		       (svref (class-shared-slots (car index)) (cdr index)))))
+	  (if (si:sl-boundp val)
+	      (values val :VALUE)
+	      (values nil :UNBOUND))))))
+
+(defun standard-instance-set (val instance slot-name)
+  (let* ((class (si:instance-class instance))
+	 (index (gethash slot-name (slot-index-table class))))
+    (declare (type standard-class class))
+    (if index
+	(if (atom index)
+	    (si:instance-set instance (the fixnum index) val)
+	    ;; else it is a shared slot
+	    (setf (svref (class-shared-slots (car index)) (cdr index)) val))
+	(slot-missing (si:instance-class instance) instance slot-name
+		      'SLOT-VALUE))))
+
+(defun general-instance-get (instance slot-name)
+  (let* ((class (si:instance-class instance))
+         (index (position slot-name (class-slots class)
+                          :key #'slotd-name :test #'eq)))
+    (if index
+	(let ((val (si:instance-ref instance (the fixnum index))))
+	  (if (si:sl-boundp val)
+	      (values val :VALUE)
+	      (values nil :UNBOUND)))
+	(values nil :MISSING))))
+
+;;; ----------------------------------------------------------------------
+;;;                                                             optimizers
+
+(defmethod OPTIMIZE-SLOT-VALUE ((class standard-class) form)
+  (let ((instance (second form))
+	(slot-name (third form)))
+    `(standard-instance-access ,instance
+			       ',(reduce-constant slot-name) . ,(cdddr form))))
+
+(defmethod OPTIMIZE-SET-SLOT-VALUE ((class standard-class) form)
+  (let ((instance (cadadr form))
+	(slot-name (caddr (second form)))
+	(new-value (third form)))
+    `(standard-instance-access ,instance
+			       ',(reduce-constant slot-name) ,new-value)))
+
+;;; ----------------------------------------------------------------------
+;;; Methods
+
+(defmethod initialize-instance ((class standard-class)
+;;;				&rest initargs 
+				&key name direct-superclasses 
+				&allow-other-keys)
+
+  (call-next-method)			; from class T
+
+  (let* ((superclasses 
+	  (class-default-direct-superclasses class direct-superclasses))
+	 (cpl (if (and (cdr superclasses)
+		       (eq (class-name (car superclasses)) 'STANDARD-OBJECT))
+		  ;; it is a class inheriting from a structure
+		  ;; so standard-object must be the first in cpl
+		  (cons (car superclasses)
+			(remove (find-class 'STANDARD-OBJECT)
+				(compute-class-precedence-list 
+				 name
+				 (cdr superclasses))))
+		  ;; else
+		  (compute-class-precedence-list name superclasses)))
+	 (slots (class-slots class))
+	 (class-direct-slots (slot-value class 'DIRECT-SLOTS))
+	 (table (make-hash-table :size (max 32 (* 2 (length slots)))
+				 :test #'eq))
+	 (local-index -1)
+	 (shared-index -1))
+    (declare (fixnum local-index shared-index))
+
+    (setf (slot-value class 'SUPERIORS) superclasses)
+    (setf (slot-value class 'PRECEDENCE-LIST) cpl)
+    (setf (slot-index-table class) table)
+    (dolist (slot slots)
+      (let* ((name (slotd-name slot))
+	     (allocation (slotd-allocation slot))
+	     location)
+	(cond ((eq allocation :INSTANCE) ; local slot
+	       (setq location (incf local-index)))
+	      ((member slot class-direct-slots) ; new shared slot
+	       (setq location (cons class (incf shared-index))))
+	      (t			; inherited shared slot
+	       (dolist (c cpl)
+		 (when (and
+			(typep c 'STANDARD-CLASS)
+			(setq location
+			      (gethash name (slot-value c 'SLOT-INDEX-TABLE))))
+		   (return)))))
+	(setf (gethash name table) location)))
+    (setf (class-instance-slot-count class) (1+ local-index))
+    (when (plusp (incf shared-index))
+      (setf (class-shared-slots class)
+	    (make-array shared-index :initial-element (unbound)))))
+
+  class)
+
+;;; Bootstrap problem: early version of add-method does not do this,
+;;; but here initialize-instance has already been called, so we do it
+;;; explicitely
+(clrhash (si:gfun-method-ht (symbol-function 'initialize-instance)))
+
+(defmethod class-default-direct-superclasses ((class standard-class)
+					      supplied-superclasses)
+  (let ((default-superclasses supplied-superclasses))
+    (if supplied-superclasses
+	(progn
+	  ;; check if the class inherits from a structure. 
+	  ;; A structure can be the first one in the list of superclasses.
+	  (dolist (super (cdr supplied-superclasses))
+	    (when (typep super 'STRUCTURE)
+	      (error
+	       "The standard class ~A can have the structure class ~A only~
+		as first superclass in the list" class super)))
+	  
+	  ;; default inheritance for CLOS classes that are instances
+	  ;; of standard-class is standard-object.
+	  (if (eq (class-name (class-of (first supplied-superclasses)))
+		  'STRUCTURE-CLASS)
+	      (push (find-class 'STANDARD-OBJECT) default-superclasses)
+	  
+	      ;; else
+	      (unless (or (eq (class-name class) 'STANDARD-OBJECT)
+			  (eq (class-name class) 'STRUCTURE-OBJECT)
+			  (some #'(lambda (x) (subtypep (class-name x)
+							'STANDARD-OBJECT))
+				supplied-superclasses))
+		(setf default-superclasses
+		      (nreverse (cons (find-class 'STANDARD-OBJECT)
+				      (nreverse supplied-superclasses)))))))
+    ;; else
+      (setf default-superclasses (list (find-class 'STANDARD-OBJECT))))
+    default-superclasses))
+
+(defmethod make-instance ((class standard-class) &rest initargs)
+  (setq initargs (default-initargs class initargs))
+  (flet ((search-allow-other-keys (initargs-list)
+	    (do ((arg-list initargs-list (cddr arg-list)))
+		((null arg-list))
+		(when (eq (first arg-list) ':ALLOW-OTHER-KEYS)
+		      (return (second arg-list))))))
+	(if (not (search-allow-other-keys initargs))
+	    (check-initargs class initargs)))
+  (let ((instance
+	 (si:allocate-instance class (class-instance-slot-count class))))
+    (apply #'initialize-instance instance initargs)
+    instance))
+
+(defmethod describe-object ((obj standard-class))
+  (let ((slotds (class-slots (si:instance-class obj))))
+    (format t "~%~A is an instance of class ~A"
+	    obj (class-name (si:instance-class obj)))
+    (do ((scan slotds (cdr scan))
+	 (i 0 (1+ i)))
+	((null scan))
+      (declare (fixnum i))
+      (print (slotd-name (car scan))) (princ ":	")
+      (case (slotd-name (car scan))
+	    ((SUPERIORS INFERIORS PRECEDENCE-LIST)
+	     (princ "(")
+	     (do* ((scan (si:instance-ref obj i) (cdr scan))
+		   (e (car scan) (car scan)))
+		  ((null scan))
+		  (prin1 (class-name e))
+		  (when (cdr scan) (princ " ")))
+	     (princ ")"))
+	    (otherwise (prin1 (si:instance-ref obj i))))))
+  obj)
+
+
+;;; ----------------------------------------------------------------------
+;;;                                                          documentation
+
+#|
+(defmethod documentation ((obj standard-class) &optional doc-type)
+  (declare (ignore doc-type))
+  (documentation-of obj))
+
+(defmethod (setf documentation)
+  ((s string) (obj standard-class) &optional doc-type)
+  (declare (ignore doc-type))
+  (setf (documentation-of obj) s))
+|#
+;;; ----------------------------------------------------------------------
+;;; Generic Function
+;;; ----------------------------------------------------------------------
+
+(defclass generic-function () ())
+
+
+;;; ----------------------------------------------------------------------
+;;; Standard Generic Function
+;;; ----------------------------------------------------------------------
+
+(defclass standard-generic-function (generic-function)
+  ((lambda-list :initarg :lambda-list :accessor lambda-list)
+   (argument-precedence-order 
+    :initarg :argument-precedence-order
+    :accessor generic-function-argument-precedence-order)
+   (method-combination 
+    :initarg :method-combination 
+    :accessor generic-function-method-combination
+    )
+   (method-combination-arguments
+    :initarg :method-combination-arguments
+    :accessor generic-function-method-combination-arguments
+    )
+   (method-class :initarg :method-class)
+   (documentation :initarg :documentation 
+;                 :accessor documentation
+		  )
+   (gfun :initarg :gfun :accessor gfun :initform nil)
+   (methods :initform nil :accessor methods))) ; 7th slot as in kernel.lsp
+
+;;;----------------------------------------------------------------------
diff --git a/src/clos/stdmethod.lsp b/src/clos/stdmethod.lsp
new file mode 100644
index 000000000..10012ddd4
--- /dev/null
+++ b/src/clos/stdmethod.lsp
@@ -0,0 +1,58 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CLOS")
+
+;;;----------------------------------------------------------------------
+;;; Method
+;;; ----------------------------------------------------------------------
+
+(defclass method () ())
+
+;;; ----------------------------------------------------------------------
+;;; Standard Method
+;;; ----------------------------------------------------------------------
+
+
+(defclass standard-method (method)
+  ((generic-function :initarg :generic-function)
+   (lambda-list :initarg :lambda-list)
+   (specializers :initarg :specializers :accessor specializers)
+   (qualifiers :initform nil :initarg :qualifiers :reader method-qualifiers)
+   (method-function :initarg :method-function)
+   (documentation :initform nil :initarg documentation)
+   (declarations :initform nil)
+   (plist :initform nil :initarg :plist :accessor method-plist)))
+
+
+(defmethod function-keywords ((method standard-method))
+  (let ((lambda-list (slot-value method 'lambda-list))
+	arg
+	key-list
+	keyp
+	allowed)
+    (dolist (arg lambda-list (setq key-list (nreverse key-list)))
+      (cond 
+       ((eq arg '&key)
+	(setf keyp t))
+       ((and keyp 
+	     (not (member arg '(&allow-other-keys &aux))))
+	(push (if (listp arg)
+		  (let ((key-par (first arg)))
+		    (if (listp key-par) (first key-par)
+		      (make-keyword key-par)))
+		(make-keyword arg))
+	      key-list))
+       ((eq arg '&allow-other-keys)
+	(setf allowed t)
+	(return))
+       ((eq arg '&aux) 
+	(return))
+       (t ())))
+    (values key-list allowed)))
diff --git a/src/clos/walk.lsp b/src/clos/walk.lsp
new file mode 100644
index 000000000..17112f904
--- /dev/null
+++ b/src/clos/walk.lsp
@@ -0,0 +1,1421 @@
+;;;-*- Mode:LISP; Package:(WALKER LISP 1000); Base:10; Syntax:Common-lisp -*-
+;;;
+;;; *************************************************************************
+;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
+;;; All rights reserved.
+;;;
+;;; Use and copying of this software and preparation of derivative works
+;;; based upon this software are permitted.  Any distribution of this
+;;; software or derivative works must comply with all applicable United
+;;; States export control laws.
+;;; 
+;;; This software is made available AS IS, and Xerox Corporation makes no
+;;; warranty about the software, its performance or its conformity to any
+;;; specification.
+;;; 
+;;; Any person obtaining a copy of this software is requested to send their
+;;; name and post office or electronic mail address to:
+;;;   CommonLoops Coordinator
+;;;   Xerox PARC
+;;;   3333 Coyote Hill Rd.
+;;;   Palo Alto, CA 94304
+;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
+;;;
+;;; Suggestions, comments and requests for improvements are also welcome.
+;;; *************************************************************************
+;;; 
+;;; A simple code walker, based IN PART on: (roll the credits)
+;;;   Larry Masinter's Masterscope
+;;;   Moon's Common Lisp code walker
+;;;   Gary Drescher's code walker
+;;;   Larry Masinter's simple code walker
+;;;   .
+;;;   .
+;;;   boy, thats fair (I hope).
+;;;
+;;; For now at least, this code walker really only does what PCL needs it to
+;;; do.  Maybe it will grow up someday.
+;;;
+
+;;;
+;;; This code walker used to be completely portable.  Now it is just "Real
+;;; easy to port".  This change had to happen because the hack that made it
+;;; completely portable kept breaking in different releases of different
+;;; Common Lisps, and in addition it never worked entirely anyways.  So,
+;;; its now easy to port.  To port this walker, all you have to write is one
+;;; simple macro and two simple functions.  These macros and functions are
+;;; used by the walker to manipluate the macroexpansion environments of
+;;; the Common Lisp it is running in.
+;;;
+;;; The code which implements the macroexpansion environment manipulation
+;;; mechanisms is in the first part of the file, the real walker follows it.
+;;; 
+
+;;;
+;;; The user entry points are walk-form and nested-walked-form.  In addition,
+;;; it is legal for user code to call the variable information functions:
+;;; variable-lexical-p, variable-special-p and variable-class.  Some users
+;;; will need to call define-walker-template, they will have to figure that
+;;; out for themselves.
+;;; 
+(defpackage "WALKER"
+  (:export define-walker-template
+	   walk-form
+	   #+NEW
+	   walk-form-expand-macros-p
+	   #-ecls nested-walk-form
+	   variable-lexical-p
+	   variable-special-p
+	   *variable-declarations*
+	   variable-declaration
+	   #+NEW
+	   macroexpand-all
+	   ))
+
+(in-package "WALKER")
+(declaim (notinline note-lexical-binding walk-bindings-1 walk-let/let*
+		    walk-form-internal))
+
+;;;
+;;; On the following pages are implementations of the implementation specific
+;;; environment hacking functions.
+;;;
+;;; This code just hacks 'macroexpansion environments'.  That is, it is only
+;;; concerned with the function binding of symbols in the environment.  The
+;;; walker needs to be able to tell if the symbol names a lexical macro or
+;;; function, and it needs to be able to build environments which contain
+;;; lexical macro or function bindings.  It must be able, when walking a
+;;; macrolet, flet or labels form to construct an environment which reflects
+;;; the bindings created by that form.  Note that the environment created
+;;; does NOT have to be sufficient to evaluate the body, merely to walk its
+;;; body.  This means that definitions do not have to be supplied for lexical
+;;; functions, only the fact that that function is bound is important.  For
+;;; macros, the macroexpansion function must be supplied.
+;;;
+;;; This code is organized in a way that lets it work in implementations that
+;;; stack cons their environments.  That is reflected in the fact that the
+;;; only operation that lets a user build a new environment is a with-body
+;;; macro which executes its body with the specified symbol bound to the new
+;;; environment.  No code in this walker or in PCL will hold a pointer to
+;;; these environments after the body returns.  Other user code is free to do
+;;; so in implementations where it works, but that code is not considered
+;;; portable.
+;;;
+;;; There are 3 environment hacking tools.  One macro which is used for
+;;; creating new environments, and two functions which are used to access the
+;;; bindings of existing environments.
+;;;
+;;; WITH-AUGMENTED-ENVIRONMENT
+;;;
+;;; ENVIRONMENT-FUNCTION
+;;;
+;;; ENVIRONMENT-MACRO
+;;; 
+
+(defun unbound-lexical-function (&rest args)
+  (declare (ignore args))
+  (error "The evaluator was called to evaluate a form in a macroexpansion~%~
+          environment constructed by the PCL portable code walker.  These~%~
+          environments are only useful for macroexpansion, they cannot be~%~
+          used for evaluation.~%~
+          This error should never occur when using PCL.~%~
+          This most likely source of this error is a program which tries to~%~
+          to use the PCL portable code walker to build its own evaluator."))
+
+
+;;;
+;;; In Kyoto Common Lisp, the macroexpansion environment is a three element
+;;; list.  The second element describes lexical functions and macros.  The 
+;;; function entries in this list have the form 
+;;;     (<name> FUNCTION <function-value>)
+;;; The macro entries have the form
+;;;     (<name> MACRO <macro-value>).
+;;;
+;;;
+
+(defmacro with-augmented-environment
+	  ((new-env old-env &key functions macros) &body body)
+	  `(let ((,new-env (with-augmented-environment-internal ,old-env
+								,functions
+								,macros)))
+	     ,@body))
+
+(defun with-augmented-environment-internal (env functions macros)
+  (let ((vars (car env))
+	(funs (cdr env)))
+    (dolist (f functions)
+      (push `(,(car f) function ,#'unbound-lexical-function) funs))
+    (dolist (m macros)
+      (push `(,(car m) macro ,(second m)) funs))
+    (cons vars funs)))
+
+(defun environment-function (env fn)
+  (when env
+	(let ((entry (assoc fn (cdr env))))
+	  (and entry
+	       (eq (second entry) 'FUNCTION)
+	       (third entry)))))
+
+(defun environment-macro (env macro)
+  (when env
+	(let ((entry (assoc macro (cdr env))))
+	  (and entry
+	       (eq (second entry) 'MACRO)
+	       (third entry)))))
+
+
+
+(defmacro with-new-definition-in-environment
+	  ((new-env old-env macrolet/flet/labels-form) &body body)
+  (let ((functions (make-symbol "Functions"))
+	(macros (make-symbol "Macros")))
+    `(let ((,functions ())
+	   (,macros ()))
+       (ecase (car ,macrolet/flet/labels-form)
+	 ((FLET LABELS)
+	  (dolist (fn (second ,macrolet/flet/labels-form))
+	    (push fn ,functions)))
+	 ((MACROLET)
+	  (dolist (mac (second ,macrolet/flet/labels-form))
+	    (push (list (car mac)
+			(convert-macro-to-lambda (second mac)
+						 (cddr mac)
+						 (string (car mac))))
+		  ,macros))))
+       (with-augmented-environment
+	      (,new-env ,old-env :functions ,functions :macros ,macros)
+	 ,@body))))
+
+(defun convert-macro-to-lambda (llist body &optional (name "Dummy Macro"))
+  (let ((gensym (make-symbol name)))
+    (eval `(defmacro ,gensym ,llist ,@body))
+    (macro-function gensym)))
+
+;;;
+;;; Now comes the real walker.
+;;;
+;;; As the walker walks over the code, it communicates information to itself
+;;; about the walk.  This information includes the walk function, variable
+;;; bindings, declarations in effect etc.  This information is inherently
+;;; lexical, so the walker passes it around in the actual environment the
+;;; walker passes to macroexpansion functions.  This is what makes the
+;;; nested-walk-form facility work properly.
+;;;
+(defmacro walker-environment-bind ((var env &rest key-args)
+				      &body body)
+  `(with-augmented-environment
+     (,var ,env :macros (walker-environment-bind-1 ,env ,.key-args))
+     .,body))
+
+(defvar *key-to-walker-environment* (gensym))
+
+(defun env-lock (env)
+  (environment-macro env *key-to-walker-environment*))
+
+(defun walker-environment-bind-1 (env &key (walk-function nil wfnp)
+					   (walk-form nil wfop)
+					   (declarations nil decp)
+					   (lexical-variables nil lexp))
+  (let ((lock (env-lock env)))
+    (list
+      (list *key-to-walker-environment*
+	    (list (if wfnp walk-function     (car lock))
+		  (if wfop walk-form         (second lock))
+		  (if decp declarations      (third lock))
+		  (if lexp lexical-variables (fourth lock)))))))
+		  
+(defun env-walk-function (env)
+  (first (env-lock env)))
+
+(defun env-walk-form (env)
+  (second (env-lock env)))
+
+(defun env-declarations (env)
+  (third (env-lock env)))
+
+(defun env-lexical-variables (env)
+  (fourth (env-lock env)))
+
+
+(defun note-declaration (declaration env)
+  (push declaration (third (env-lock env))))
+
+(defun note-lexical-binding (thing env)
+  (push #+NEW (list thing :LEXICAL-VAR) #-NEW thing (fourth (env-lock env))))
+
+
+(defun VARIABLE-LEXICAL-P (var env)
+  #+NEW
+  (let ((entry (member var (env-lexical-variables env) :key #'car)))
+    (when (eq (cadar entry) :LEXICAL-VAR)
+      entry))
+  #-NEW
+  (member var (env-lexical-variables env)))
+
+#+NEW
+(defun variable-symbol-macro-p (var env)
+  (let ((entry (member var (env-lexical-variables env) :key #'car)))
+    (when (eq (cadar entry) :macro)
+      entry)))
+
+(defvar *VARIABLE-DECLARATIONS* '(SPECIAL TYPE)) ; Beppe
+
+(defun VARIABLE-DECLARATION (declaration var env)
+  (if (not (member declaration *variable-declarations*))
+      (error "~S is not a recognized variable declaration." declaration)
+      (let ((id (or (variable-lexical-p var env) var)))
+	(dolist (decl (env-declarations env))
+	  (when (and (eq (car decl) declaration)
+		     (or (eq (second decl) id)
+			 (and (eq 'TYPE (car decl))
+			      (member var (cddr decl) :test #'eq)))) ; Beppe
+	    (return decl))))))
+
+(defun VARIABLE-SPECIAL-P (var env)
+  (or (not (null (variable-declaration 'SPECIAL var env)))
+      (variable-globally-special-p var)))
+
+;;;
+;;; VARIABLE-GLOBALLY-SPECIAL-P is used to ask if a variable has been
+;;; declared globally special.  Any particular CommonLisp implementation
+;;; should customize this function accordingly and send their customization
+;;; back.
+;;;
+;;; The default version of variable-globally-special-p is probably pretty
+;;; slow, so it uses *globally-special-variables* as a cache to remember
+;;; variables that it has already figured out are globally special.
+;;;
+;;; This would need to be reworked if an unspecial declaration got added to
+;;; Common Lisp.
+;;;
+;;; Common Lisp nit:
+;;;   variable-globally-special-p should be defined in Common Lisp.
+;;;
+
+(defun variable-globally-special-p (symbol) (si:specialp symbol))
+
+
+  ;;   
+;;;;;; Handling of special forms (the infamous 24).
+  ;;
+;;;
+;;; and I quote...
+;;; 
+;;;     The set of special forms is purposely kept very small because
+;;;     any program analyzing program (read code walker) must have
+;;;     special knowledge about every type of special form. Such a
+;;;     program needs no special knowledge about macros...
+;;;
+;;; So all we have to do here is a define a way to store and retrieve
+;;; templates which describe how to walk the 24 special forms and we are all
+;;; set...
+;;;
+;;; Well, its a nice concept, and I have to admit to being naive enough that
+;;; I believed it for a while, but not everyone takes having only 24 special
+;;; forms as seriously as might be nice.  There are (at least) 3 ways to
+;;; lose:
+;;
+;;;   1 - Implementation x implements a Common Lisp special form as a macro
+;;;       which expands into a special form which:
+;;;         - Is a common lisp special form (not likely)
+;;;         - Is not a common lisp special form (on the 3600 IF --> COND).
+;;;
+;;;     * We can safe ourselves from this case (second subcase really) by
+;;;       checking to see if there is a template defined for something
+;;;       before we check to see if we we can macroexpand it.
+;;;
+;;;   2 - Implementation x implements a Common Lisp macro as a special form.
+;;;
+;;;     * This is a screw, but not so bad, we save ourselves from it by
+;;;       defining extra templates for the macros which are *likely* to
+;;;       be implemented as special forms.  (DO, DO* ...)
+;;;
+;;;   3 - Implementation x has a special form which is not on the list of
+;;;       Common Lisp special forms.
+;;;
+;;;     * This is a bad sort of a screw and happens more than I would like
+;;;       to think, especially in the implementations which provide more
+;;;       than just Common Lisp (3600, Xerox etc.).
+;;;       The fix is not terribly staisfactory, but will have to do for
+;;;       now.  There is a hook in get walker-template which can get a
+;;;       template from the implementation's own walker.  That template
+;;;       has to be converted, and so it may be that the right way to do
+;;;       this would actually be for that implementation to provide an
+;;;       interface to its walker which looks like the interface to this
+;;;       walker.
+;;;
+
+(eval-when (compile load eval)
+
+(defmacro get-walker-template-internal (x) ;Has to be inside eval-when because
+  `(get ,x 'WALKER-TEMPLATE))		   ;Golden Common Lisp doesn't hack
+					   ;compile time definition of macros
+					   ;right for setf.
+
+(defmacro define-walker-template
+	  (name &optional (template '(NIL REPEAT (EVAL))))
+  `(eval-when (load eval)
+     (setf (get-walker-template-internal ',name) ',template)))
+)
+
+(defun get-walker-template (x)
+  (cond ((symbolp x)
+	 (or (get-walker-template-internal x)
+	     (get-implementation-dependent-walker-template x)))
+	((and (listp x) (eq (car x) 'LAMBDA))
+	 '(LAMBDA REPEAT (EVAL)))
+	(t
+	 (error "Can't get template for ~S" x))))
+
+(defun get-implementation-dependent-walker-template (x)
+  (declare (ignore x))
+  ())
+
+
+  ;;   
+;;;;;; The actual templates
+  ;;   
+
+(define-walker-template BLOCK                (NIL NIL REPEAT (EVAL)))
+(define-walker-template CATCH                (NIL EVAL REPEAT (EVAL)))
+(define-walker-template COMPILER-LET         walk-compiler-let)
+(define-walker-template DECLARE              walk-unexpected-declare)
+(define-walker-template EVAL-WHEN            (NIL QUOTE REPEAT (EVAL)))
+(define-walker-template FLET                 walk-flet)
+(define-walker-template FUNCTION             (NIL CALL))
+(define-walker-template GO                   (NIL QUOTE))
+(define-walker-template IF                   walk-if)
+(define-walker-template LABELS               walk-labels)
+(define-walker-template LAMBDA               walk-lambda)
+(define-walker-template LET                  walk-let)
+(define-walker-template LET*                 walk-let*)
+#+NEW
+(define-walker-template LOCALLY              walk-locally)
+(define-walker-template MACROLET             walk-macrolet)
+(define-walker-template MULTIPLE-VALUE-CALL  (NIL EVAL REPEAT (EVAL)))
+(define-walker-template MULTIPLE-VALUE-PROG1 (NIL RETURN REPEAT (EVAL)))
+#+NEW
+(define-walker-template MULTIPLE-VALUE-SETQ  walk-multiple-value-setq)
+#-NEW
+(define-walker-template MULTIPLE-VALUE-SETQ  (NIL (REPEAT (SET)) EVAL))
+(define-walker-template MULTIPLE-VALUE-BIND  walk-multiple-value-bind)
+(define-walker-template PROGN                (NIL REPEAT (EVAL)))
+(define-walker-template PROGV                (NIL EVAL EVAL REPEAT (EVAL)))
+(define-walker-template QUOTE                (NIL QUOTE))
+(define-walker-template RETURN-FROM          (NIL QUOTE REPEAT (RETURN)))
+#+NEW
+(define-walker-template SETQ                 walk-setq)
+#-NEW
+(define-walker-template SETQ                 (NIL REPEAT (SET EVAL)))
+#+NEW
+(define-walker-template SYMBOL-MACROLET      walk-symbol-macrolet)
+#-NEW
+(define-walker-template TAGBODY              walk-tagbody)
+(define-walker-template THE                  (NIL QUOTE EVAL))
+(define-walker-template THROW                (NIL EVAL EVAL))
+(define-walker-template UNWIND-PROTECT       (NIL RETURN REPEAT (EVAL)))
+
+;;; The new special form.
+;(define-walker-template pcl::LOAD-TIME-EVAL       (NIL EVAL))
+
+;;;
+;;; And the extra templates...
+;;;
+#+ecls
+(define-walker-template DOTIMES	walk-dotimes/dolist)
+#+ecls
+(define-walker-template DOLIST	walk-dotimes/dolist)
+#+ecls
+(define-walker-template WHEN	walk-when/unless)
+#+ecls
+(define-walker-template UNLESS	walk-when/unless)
+(define-walker-template DO      walk-do)
+(define-walker-template DO*     walk-do*)
+(define-walker-template PROG    walk-prog)
+(define-walker-template PROG*   walk-prog*)
+(define-walker-template COND    (NIL REPEAT ((TEST REPEAT (EVAL)))))
+(define-walker-template lambda-block walk-named-lambda)	;Not really right, but
+						        ;we don't hack block
+						        ;names anyways.
+
+
+;;; Controls whether macros are expanded by walk-form
+#+NEW
+(defvar WALK-FORM-EXPAND-MACROS-P nil)
+#+NEW
+(defun macroexpand-all (form &optional environment)
+  (let ((walk-form-expand-macros-p t))
+    (walk-form form environment)))
+
+(defun WALK-FORM (form
+		  &optional environment
+			    (walk-function
+			      #'(lambda (subform context env)
+				  (declare (ignore context env))
+				  subform)))
+  (walker-environment-bind (new-env environment :walk-function walk-function)
+    (walk-form-internal form :eval new-env)))
+
+;;;
+;;; nested-walk-form provides an interface that allows nested macros, each
+;;; of which must walk their body to just do one walk of the body of the
+;;; inner macro.  That inner walk is done with a walk function which is the
+;;; composition of the two walk functions.
+;;;
+;;; This facility works by having the walker annotate the environment that
+;;; it passes to macroexpand-1 to know which form is being macroexpanded.
+;;; If then the &whole argument to the macroexpansion function is eq to
+;;; the env-walk-form of the environment, nested-walk-form can be certain
+;;; that there are no intervening layers and that a nested walk is alright.
+;;;
+;;; There are some semantic problems with this facility.  In particular, if
+;;; the outer walk function returns T as its walk-no-more-p value, this will
+;;; prevent the inner walk function from getting a chance to walk the subforms
+;;; of the form.  This is almost never what you want, since it destroys the
+;;; equivalence between this nested-walk-form function and two seperate
+;;; walk-forms.
+;;;
+#-ecls
+(defun NESTED-WALK-FORM (whole
+			 form
+			 &optional environment
+				   (walk-function
+				     #'(lambda (subform context env)
+					 (declare (ignore context env))
+					 subform)))
+  (if (eq whole (env-walk-form environment))
+      (let ((outer-walk-function (env-walk-function environment)))
+	(throw whole
+	  (walk-form
+	    form
+	    environment
+	    #'(lambda (f c e)
+		;; First loop to make sure the inner walk function
+		;; has done all it wants to do with this form.
+		;; Basically, what we are doing here is providing
+		;; the same contract walk-form-internal normally
+		;; provides to the inner walk function.
+		(let ((inner-result nil)
+		      (inner-no-more-p nil)
+		      (outer-result nil)
+		      (outer-no-more-p nil))
+		  (loop
+		    (multiple-value-setq (inner-result inner-no-more-p)
+					 (funcall walk-function f c e))
+		    (cond (inner-no-more-p (return))
+			  ((not (eq inner-result f)))
+			  ((not (consp inner-result)) (return))
+			  ((get-walker-template (car inner-result)) (return))
+			  (t
+			   (multiple-value-bind (expansion macrop)
+			       (walker-environment-bind
+				     (new-env e :walk-form inner-result)
+				 (macroexpand-1 inner-result new-env))
+			     (if macrop
+				 (setq inner-result expansion)
+				 (return)))))
+		    (setq f inner-result))
+		  (multiple-value-setq (outer-result outer-no-more-p)
+				       (funcall outer-walk-function
+						inner-result
+						c
+						e))
+		  (values outer-result
+			  (and inner-no-more-p outer-no-more-p)))))))
+      (walk-form form environment walk-function)))
+
+;;;
+;;; WALK-FORM-INTERNAL is the main driving function for the code walker. It
+;;; takes a form and the current context and walks the form calling itself or
+;;; the appropriate template recursively.
+;;;
+;;;   "It is recommended that a program-analyzing-program process a form
+;;;    that is a list whose car is a symbol as follows:
+;;;
+;;;     1. If the program has particular knowledge about the symbol,
+;;;        process the form using special-purpose code.  All of the
+;;;        standard special forms should fall into this category.
+;;;     2. Otherwise, if macro-function is true of the symbol apply
+;;;        either macroexpand or macroexpand-1 and start over.
+;;;     3. Otherwise, assume it is a function call. "
+;;;     
+
+(defun walk-form-internal (form context env
+			   &aux fn template)
+  ;; First apply the walk-function to perform whatever translation
+  ;; the user wants to this form.  If the second value returned
+  ;; by walk-function is T then we don't recurse...
+  (catch form
+    (multiple-value-bind (newform walk-no-more-p)
+      (funcall (env-walk-function env) form context env)
+      (catch newform
+	(cond (walk-no-more-p newform)
+	      ((not (eq form newform))
+	       (walk-form-internal newform context env))
+	      ((not (consp newform))
+	       #+NEW
+	       (let ((symmac (car (variable-symbol-macro-p newform env))))
+		 (if symmac
+		     (let ((newnewform (walk-form-internal (cddr symmac)
+							   context env)))
+		       (if (eq newnewform (cddr symmac))
+			   (if walk-form-expand-macros-p newnewform newform)
+			   newnewform))
+		     newform))
+	       #-NEW
+	       newform)
+	      ((setq template (get-walker-template (setq fn (car newform))))
+	       (if (symbolp template)
+		   (funcall template newform context env)
+		   (walk-template newform template context env)))
+	      (t
+	       (multiple-value-bind (newnewform macrop)
+		 (walker-environment-bind (new-env env :walk-form newform)
+					  (macroexpand-1 newform new-env))
+		 (cond
+		   (macrop
+		    #+NEW
+		    (let ((newnewnewform
+			   (walk-form-internal newnewform context env)))
+		      (if (eq newnewnewform newnewform)
+			  (if walk-form-expand-macros-p newnewform newform)
+			  newnewnewform))
+		    #-NEW
+		    (walk-form-internal newnewform context env))
+		   ((and (symbolp fn)
+			 (not (fboundp fn))
+			 (special-form-p fn))
+		    (error
+		     "~S is a special form, not defined in the CommonLisp.~%~
+                       manual This code walker doesn't know how to walk it.~%~
+                       Define a template for this special form and try again."
+		     fn))
+		   (t
+		    ;; Otherwise, walk the form as if its just a standard 
+		    ;; functioncall using a template for standard function
+		    ;; call.
+		    (walk-template
+		     newnewform '(CALL REPEAT (EVAL)) context env))))))))))
+
+(defun walk-template (form template context env)
+  (if (atom template)
+      (ecase template
+        ((EVAL FUNCTION TEST EFFECT RETURN)
+         (walk-form-internal form :EVAL env))
+        ((QUOTE NIL) form)
+        (SET
+          (walk-form-internal form :SET env))
+        ((LAMBDA CALL)
+	 (cond ((or (symbolp form)
+		    (and (listp form)
+			 (= (length form) 2)
+			 (eq (car form) 'SETF))) form)
+	       (t (walk-form-internal form context env)))))
+      (case (car template)
+        (REPEAT
+          (walk-template-handle-repeat form
+                                       (cdr template)
+				       ;; For the case where nothing happens
+				       ;; after the repeat optimize out the
+				       ;; call to length.
+				       (if (null (cddr template))
+					   ()
+					   (nthcdr (- (length form)
+						      (length
+							(cddr template)))
+						   form))
+                                       context
+				       env))
+        (IF
+	  (walk-template form
+			 (if (if (listp (second template))
+				 (eval (second template))
+				 (funcall (second template) form))
+			     (third template)
+			     (fourth template))
+			 context
+			 env))
+        (REMOTE
+          (walk-template form (second template) context env))
+        (otherwise
+          (cond ((atom form) form)
+                (t (recons form
+                           (walk-template
+			     (car form) (car template) context env)
+                           (walk-template
+			     (cdr form) (cdr template) context env))))))))
+
+(defun walk-template-handle-repeat (form template stop-form context env)
+  (if (eq form stop-form)
+      (walk-template form (cdr template) context env)
+      (walk-template-handle-repeat-1 form
+				     template
+				     (car template)
+				     stop-form
+				     context
+				     env)))
+
+(defun walk-template-handle-repeat-1 (form template repeat-template
+					   stop-form context env)
+  (cond ((null form) ())
+        ((eq form stop-form)
+         (if (null repeat-template)
+             (walk-template stop-form (cdr template) context env)       
+             (error "While handling repeat:~%~
+                     Ran into stop while still in repeat template.")))
+        ((null repeat-template)
+         (walk-template-handle-repeat-1
+	   form template (car template) stop-form context env))
+        (t
+         (recons form
+                 (walk-template (car form) (car repeat-template) context env)
+                 (walk-template-handle-repeat-1 (cdr form)
+						template
+						(cdr repeat-template)
+						stop-form
+						context
+						env)))))
+
+(defun walk-repeat-eval (form env)
+  (and form
+       (recons form
+	       (walk-form-internal (car form) :eval env)
+	       (walk-repeat-eval (cdr form) env))))
+
+(defun recons (x car cdr)
+  (if (or (not (eq (car x) car))
+          (not (eq (cdr x) cdr)))
+      (cons car cdr)
+      x))
+
+(defun relist (x &rest args)
+  (if (null args)
+      nil
+      (relist-internal x args nil)))
+
+(defun relist* (x &rest args)
+  (relist-internal x args 'T))
+
+(defun relist-internal (x args *p)
+  (if (null (cdr args))
+      (if *p (car args) (recons x (car args) nil))
+      (recons x
+	      (car args)
+	      (relist-internal (cdr x) (cdr args) *p))))
+
+
+  ;;   
+;;;;;; Special walkers
+  ;;
+
+(defun walk-declarations (body fn env
+			       &optional doc-string-p declarations old-body
+			       &aux (form (car body)) macrop new-form)
+  (cond ((and (stringp form)			;might be a doc string
+              (cdr body)			;isn't the returned value
+              (null doc-string-p)		;no doc string yet
+              (null declarations))		;no declarations yet
+         (recons body
+                 form
+                 (walk-declarations (cdr body) fn env t)))
+        ((and (listp form) (eq (car form) 'DECLARE))
+         ;; Got ourselves a real live declaration.  Record it, look for more.
+         (dolist (declaration (cdr form))
+	   (let ((type (car declaration))
+		 (name (second declaration))
+		 (args (cddr declaration)))
+	     (if (member type *variable-declarations*)
+		 (note-declaration `(,type
+				     ,(or (variable-lexical-p name env) name)
+				     ,.args)
+				   env)
+		 (note-declaration declaration env))
+	     (push declaration declarations)))
+         (recons body
+                 form
+                 (walk-declarations
+		   (cdr body) fn env doc-string-p declarations)))
+        ((and form
+	      (listp form)
+	      (null (get-walker-template (car form)))
+	      (progn
+		(multiple-value-setq (new-form macrop)
+				     (macroexpand-1 form env))
+		macrop))
+	 ;; This form was a call to a macro.  Maybe it expanded
+	 ;; into a declare?  Recurse to find out.
+	 (walk-declarations (recons body new-form (cdr body))
+			    fn env doc-string-p declarations
+			    (or old-body body)))
+	(t
+	 ;; Now that we have walked and recorded the declarations,
+	 ;; call the function our caller provided to expand the body.
+	 ;; We call that function rather than passing the real-body
+	 ;; back, because we are RECONSING up the new body.
+	 (funcall fn (or old-body body) env))))
+
+
+(defun walk-unexpected-declare (form context env)
+  (declare (ignore context env))
+  (warn "Encountered declare ~S in a place where a declare was not expected."
+	form)
+  form)
+
+(defun walk-arglist (arglist context env &optional (destructuringp nil)
+					 &aux arg)
+  (cond ((null arglist) ())
+        ((symbolp (setq arg (car arglist)))
+         (or (member arg lambda-list-keywords)
+             (note-lexical-binding arg env))
+         (recons arglist
+                 arg
+                 (walk-arglist (cdr arglist)
+                               context
+			       env
+                               (and destructuringp
+				    (not (member arg
+						 lambda-list-keywords))))))
+        ((consp arg)
+         (prog1 (recons arglist
+			(if destructuringp
+			    (walk-arglist arg context env destructuringp)
+			    (relist* arg
+				     (car arg)
+				     (walk-form-internal (second arg) :eval env)
+				     (cddr arg)))
+				    (walk-arglist (cdr arglist) context env nil))
+                (if (symbolp (car arg))
+                    (note-lexical-binding (car arg) env)
+                    (note-lexical-binding (cadar arg) env))
+                (or (null (cddr arg))
+                    (not (symbolp (third arg)))
+                    (note-lexical-binding (third arg) env))))
+          (t
+	   (error "Can't understand something in the arglist ~S" arglist))))
+
+(defun walk-let (form context env)
+  (walk-let/let* form context env nil))
+
+(defun walk-let* (form context env)
+  (walk-let/let* form context env t))
+
+(defun walk-prog (form context env)
+  (walk-prog/prog* form context env nil))
+
+(defun walk-prog* (form context env)
+  (walk-prog/prog* form context env t))
+
+(defun walk-do (form context env)
+  (walk-do/do* form context env nil))
+
+(defun walk-do* (form context env)
+  (walk-do/do* form context env t))
+
+(defun walk-let/let* (form context old-env sequentialp)
+  (walker-environment-bind (new-env old-env)
+    (let* ((let/let* (car form))
+	   (bindings (second form))
+	   (body (cddr form))
+	   (walked-bindings 
+	     (walk-bindings-1 bindings
+			      old-env
+			      new-env
+			      context
+			      sequentialp))
+	   (walked-body
+	     (walk-declarations body #'walk-repeat-eval new-env)))
+      (relist*
+	form let/let* walked-bindings walked-body))))
+
+#+NEW
+(defun walk-locally (form context env)
+  (declare (ignore context))
+  (let* ((locally (car form))
+	 (body (cdr form))
+	 (walked-body
+	  (walk-declarations body #'walk-repeat-eval env)))
+    (relist*
+     form locally walked-body)))
+
+(defun walk-prog/prog* (form context old-env sequentialp)
+  (walker-environment-bind (new-env old-env)
+    (let* ((possible-block-name (second form))
+	   (blocked-prog (and (symbolp possible-block-name)
+			      (not (eq possible-block-name 'nil)))))
+      (multiple-value-bind (let/let* block-name bindings body)
+	  (if blocked-prog
+	      (values (car form) (cadr form) (caddr form) (cdddr form))
+	      (values (car form) nil	     (cadr  form) (cddr  form)))
+	(let* ((walked-bindings 
+		 (walk-bindings-1 bindings
+				  old-env
+				  new-env
+				  context
+				  sequentialp))
+	       (walked-body
+		 (walk-declarations 
+		   body
+		   #'(lambda (real-body real-env)
+		       (walk-tagbody-1 real-body context real-env))
+		   new-env)))
+	  (if block-name
+	      (relist*
+		form let/let* block-name walked-bindings walked-body)
+	      (relist*
+		form let/let* walked-bindings walked-body)))))))
+
+(defun walk-do/do* (form context old-env sequentialp)
+  (walker-environment-bind (new-env old-env)
+    (let* ((do/do* (car form))
+	   (bindings (second form))
+	   (end-test (third form))
+	   (body (cdddr form))
+	   (walked-bindings (walk-bindings-1 bindings
+					     old-env
+					     new-env
+					     context
+					     sequentialp))
+	   (walked-body
+	     (walk-declarations body #'walk-repeat-eval new-env)))
+      (relist* form
+	       do/do*
+	       (walk-bindings-2 bindings walked-bindings context new-env)
+	       (walk-template end-test '(TEST REPEAT (EVAL)) context new-env)
+	       walked-body))))
+
+#+ecls
+(defun walk-dotimes/dolist (form context old-env)
+  (walker-environment-bind (new-env old-env)
+    (let* ((dotimes/dolist (car form))
+	   (bindings (second form))
+	   (body (cddr form))
+	   ; This is a hack. We tread BINDINGS as we
+	   ; would in a DO/DO* loop.
+	   (walked-bindings (walk-bindings-1 bindings
+					     old-env
+					     new-env
+					     context
+					     t))
+	   (walked-body
+	     (walk-declarations body #'walk-repeat-eval new-env)))
+      (relist* form
+	       dotimes/dolist
+	       (walk-bindings-2 bindings walked-bindings context new-env)
+	       walked-body))))
+
+#+NEW
+(defun walk-multiple-value-setq (form context env)
+  (let ((vars (cadr form)))
+    (if (some #'(lambda (var)
+		  (variable-symbol-macro-p var env))
+	      vars)
+	(let* ((temps (mapcar #'(lambda (var) (declare (ignore var)) (gensym)) vars))
+	       (sets (mapcar #'(lambda (var temp) `(setq ,var ,temp)) vars temps))
+	       (expanded `(multiple-value-bind ,temps 
+			       ,(caddr form)
+			     ,@sets))
+	       (walked (walk-form-internal expanded context env)))
+	  (if (eq walked expanded)
+	      form
+	      walked))
+	(walk-template form '(nil (repeat (set)) eval) context env))))
+
+(defun walk-multiple-value-bind (form context old-env)
+  (walker-environment-bind (new-env old-env)
+    (let* ((mvb (car form))
+	   (bindings (second form))
+	   (mv-form (walk-template (third form) 'EVAL context old-env))
+	   (body (cdddr form))
+	   walked-bindings
+	   (walked-body
+	     (walk-declarations 
+	       body
+	       #'(lambda (real-body real-env)
+		   (setq walked-bindings
+			 (walk-bindings-1 bindings
+					  old-env
+					  new-env
+					  context
+					  nil))
+		   (walk-repeat-eval real-body real-env))
+	       new-env)))
+      (relist* form mvb walked-bindings mv-form walked-body))))
+
+(defun walk-bindings-1 (bindings old-env new-env context sequentialp)
+  (and bindings
+       (let ((binding (car bindings)))
+         (recons bindings
+                 (if (symbolp binding)
+                     (prog1 binding
+                            (note-lexical-binding binding new-env))
+                     (prog1 (relist* binding
+				     (car binding)
+				     (walk-form-internal (second binding)
+							 context
+							 (if sequentialp
+							     new-env
+							     old-env))
+				     (cddr binding))	;save cddr for DO/DO*
+						        ;it is the next value
+						        ;form. Don't walk it
+						        ;now though.
+                            (note-lexical-binding (car binding) new-env)))
+                 (walk-bindings-1 (cdr bindings)
+				  old-env
+				  new-env
+				  context
+				  sequentialp)))))
+
+(defun walk-bindings-2 (bindings walked-bindings context env)
+  (and bindings
+       (let ((binding (car bindings))
+             (walked-binding (car walked-bindings)))
+         (recons bindings
+		 (if (symbolp binding)
+		     binding
+		     (relist* binding
+			      (car walked-binding)
+			      (second walked-binding)
+			      (walk-template (cddr binding)
+					     '(EVAL)
+					     context
+					     env)))		 
+                 (walk-bindings-2 (cdr bindings)
+				  (cdr walked-bindings)
+				  context
+				  env)))))
+
+(defun walk-lambda (form context old-env)
+  (walker-environment-bind (new-env old-env)
+    (let* ((arglist (second form))
+           (body (cddr form))
+           (walked-arglist (walk-arglist arglist context new-env))
+           (walked-body
+             (walk-declarations body #'walk-repeat-eval new-env)))
+      (relist* form
+               (car form)
+	       walked-arglist
+               walked-body))))
+
+(defun walk-named-lambda (form context old-env)
+  (walker-environment-bind (new-env old-env)
+    (let* ((name (second form))
+	   (arglist (third form))
+           (body (cdddr form))
+           (walked-arglist (walk-arglist arglist context new-env))
+           (walked-body
+             (walk-declarations body #'walk-repeat-eval new-env)))
+      (relist* form
+               (car form)
+	       name
+	       walked-arglist
+               walked-body))))  
+
+#+NEW
+(defun walk-setq (form context env)
+  (if (cdddr form)
+      (let* ((expanded (let ((rforms nil)
+			     (tail (cdr form)))
+			 (loop (when (null tail) (return (nreverse rforms)))
+			       (let ((var (pop tail)) (val (pop tail)))
+				 (push `(setq ,var ,val) rforms)))))
+	     (walked (walk-repeat-eval expanded env)))
+	(if (eq expanded walked)
+	    form
+	    `(progn ,@walked)))
+      (let* ((var (cadr form))
+	     (val (caddr form))
+	     (symmac (car (variable-symbol-macro-p var env))))
+	(if symmac
+	    (let* ((expanded `(setf ,(cddr symmac) ,val))
+		   (walked (walk-form-internal expanded context env)))
+	      (if (eq expanded walked)
+		  form
+		  walked))
+	    (relist form 'setq
+		    (walk-form-internal var :set env)
+		    (walk-form-internal val :eval env))))))
+
+#+NEW
+(defun walk-symbol-macrolet (form context old-env)
+  (declare (ignore context))
+  (let* ((bindings (second form)))
+    (walker-environment-bind
+	(new-env old-env
+		 :lexical-variables
+		 (append (mapcar #'(lambda (binding)
+				     `(,(first binding)
+				       :macro . ,(second binding)))
+				 bindings)
+			 (env-lexical-variables old-env)))
+      (relist* form 'SYMBOL-MACROLET bindings
+	       (walk-repeat-eval (cddr form) new-env)))))
+
+(defun walk-tagbody (form context env)
+  (recons form (car form) (walk-tagbody-1 (cdr form) context env)))
+
+(defun walk-tagbody-1 (form context env)
+  (and form
+       (recons form
+               (walk-form-internal (car form)
+				   (if (symbolp (car form)) 'QUOTE context)
+				   env)
+               (walk-tagbody-1 (cdr form) context env))))
+
+(defun walk-compiler-let (form context old-env)
+  (declare (ignore context))
+  (let ((vars ())
+	(vals ()))
+    (dolist (binding (second form))
+      (cond ((symbolp binding) (push binding vars) (push nil vals))
+	    (t
+	     (push (car binding) vars)
+	     (push (eval (second binding)) vals))))
+    (relist* form
+	     (car form)
+	     (second form)
+	     (progv vars vals (walk-repeat-eval (cddr form) old-env)))))
+
+(defun walk-macrolet (form context old-env)
+  (walker-environment-bind (macro-env
+			    nil
+			    :walk-function (env-walk-function old-env))
+    (labels ((walk-definitions (definitions)
+	       (and definitions
+		    (let ((definition (car definitions)))
+		      (recons definitions
+                              (relist* definition
+                                       (car definition)
+                                       (walk-arglist (second definition)
+						     context
+						     macro-env
+						     t)
+                                       (walk-declarations (cddr definition)
+							  #'walk-repeat-eval
+							  macro-env))
+			      (walk-definitions (cdr definitions)))))))
+      (with-new-definition-in-environment (new-env old-env form)
+	(relist* form
+		 (car form)
+		 (walk-definitions (second form))
+		 (walk-declarations (cddr form)
+				    #'walk-repeat-eval
+				    new-env))))))
+
+(defun walk-flet (form context old-env)
+  (labels ((walk-definitions (definitions)
+	     (if (null definitions)
+		 ()
+		 (recons definitions
+			 (walk-lambda (car definitions) context old-env)
+			 (walk-definitions (cdr definitions))))))
+    (recons form
+	    (car form)
+	    (recons (cdr form)
+		    (walk-definitions (second form))
+		    (with-new-definition-in-environment (new-env old-env form)
+		      (walk-declarations (cddr form)
+					 #'walk-repeat-eval
+					 new-env))))))
+
+(defun walk-labels (form context old-env)
+  (with-new-definition-in-environment (new-env old-env form)
+    (labels ((walk-definitions (definitions)
+	       (if (null definitions)
+		   ()
+		   (recons definitions
+			   (walk-lambda (car definitions) context new-env)
+			   (walk-definitions (cdr definitions))))))
+      (recons form
+	      (car form)
+	      (recons (cdr form)
+		      (walk-definitions (second form))
+		      (walk-declarations (cddr form)
+					 #'walk-repeat-eval
+					 new-env))))))
+
+(defun walk-if (form context env)
+  (let ((predicate (second form))
+	(arm1 (third form))
+	(arm2 
+	  (if (cddddr form)
+	      (progn
+		(warn "In the form:~%~S~%~
+                       IF only accepts three arguments, you are using ~D.~%~
+                       It is true that some Common Lisps support this, but ~
+                       it is not~%~
+                       truly legal Common Lisp.  For now, this code ~
+                       walker is interpreting ~%~
+                       the extra arguments as extra else clauses. ~
+                       Even if this is what~%~
+                       you intended, you should fix your source code."
+		      form
+		      (length (cdr form)))
+		(cons 'PROGN (cdddr form)))
+	      (fourth form))))
+    (relist form
+	    'IF
+	    (walk-form-internal predicate context env)
+	    (walk-form-internal arm1 context env)
+	    (walk-form-internal arm2 context env))))
+
+#+ecls
+(defun walk-when/unless (form context env)
+  (relist* form
+	   (first form)
+	   (walk-form-internal (second form) context env) ; predicate
+	   (walk-repeat-eval (cddr form) env)))
+
+
+;;;
+;;; Tests tests tests
+;;;
+
+#|
+;;; 
+;;; Here are some examples of the kinds of things you should be able to do
+;;; with your implementation of the macroexpansion environment hacking
+;;; mechanism.
+;;; 
+;;; with-lexical-macros is kind of like macrolet, but it only takes names
+;;; of the macros and actual macroexpansion functions to use to macroexpand
+;;; them.  The win about that is that for macros which want to wrap several
+;;; macrolets around their body, they can do this but have the macroexpansion
+;;; functions be compiled.  See the WITH-RPUSH example.
+;;;
+;;; If the implementation had a special way of communicating the augmented
+;;; environment back to the evaluator that would be totally great.  It would
+;;; mean that we could just augment the environment then pass control back
+;;; to the implementations own compiler or interpreter.  We wouldn't have
+;;; to call the actual walker.  That would make this much faster.  Since the
+;;; principal client of this is defmethod it would make compiling defmethods
+;;; faster and that would certainly be a win.
+;;;
+(defmacro with-lexical-macros (macros &body body &environment old-env)
+  (with-augmented-environment (new-env old-env :macros macros)
+    (walk-form (cons 'PROGN body) new-env)))
+
+(defun expand-rpush (form env)
+  `(push ,(third form) ,(second form)))
+
+(defmacro with-rpush (&body body)
+  `(with-lexical-macros ,(list (list 'RPUSH #'expand-rpush)) ,@body))
+
+
+;;;
+;;; Unfortunately, I don't have an automatic tester for the walker.  
+;;; Instead there is this set of test cases with a description of
+;;; how each one should go.
+;;; 
+(defmacro take-it-out-for-a-test-walk (form)
+  `(progn 
+     (terpri)
+     (terpri)
+     (let ((copy-of-form (copy-tree ',form))
+           (result (walk-form ',form nil
+                              '(lambda (x y env)
+                                 (format t "~&Form: ~S ~3T Context: ~A" x y)
+                                 (when (symbolp x)
+				   (let ((lexical (variable-lexical-p x env))
+					 (special (variable-special-p x env)))
+                                     (when lexical
+                                       (format t ";~3T")
+                                       (format t "lexically bound"))
+                                     (when special
+                                       (format t ";~3T")
+                                       (format t "declared special"))
+                                     (when (boundp x)
+                                       (format t ";~3T")
+                                       (format t "bound: ~S " (eval x)))))
+                                 x))))
+       (cond ((not (equal result copy-of-form))
+              (format t "~%Warning: Result not EQUAL to copy of start."))
+             ((not (eq result ',form))
+              (format t "~%Warning: Result not EQ to copy of start.")))
+       (pprint result)
+       result)))
+
+(defmacro foo (&rest ignore) ''GLOBAL-FOO)
+
+(defmacro bar (&rest ignore) ''GLOBAL-BAR)
+
+(take-it-out-for-a-test-walk (list arg1 arg2 arg3))
+(take-it-out-for-a-test-walk (list (cons 1 2) (list 3 4 5)))
+
+(take-it-out-for-a-test-walk (progn (foo) (bar 1)))
+
+(take-it-out-for-a-test-walk (block block-name a b c))
+(take-it-out-for-a-test-walk (block block-name (list a) b c))
+
+(take-it-out-for-a-test-walk (catch catch-tag (list a) b c))
+;;;
+;;; This is a fairly simple macrolet case.  While walking the body of the
+;;; macro, x should be lexically bound. In the body of the macrolet form
+;;; itself, x should not be bound.
+;;; 
+(take-it-out-for-a-test-walk
+  (macrolet ((foo (x) (list x) ''INNER))
+    x
+    (foo 1)))
+
+;;;
+;;; A slightly more complex macrolet case.  In the body of the macro x
+;;; should not be lexically bound.  In the body of the macrolet form itself
+;;; x should be bound.  Note that THIS CASE WILL CAUSE AN ERROR when it
+;;; tries to macroexpand the call to foo.
+;;; 
+(take-it-out-for-a-test-walk
+     (let ((x 1))
+       (macrolet ((foo () (list x) ''INNER))
+	 x
+	 (foo))))
+
+;;;
+;;; A truly hairy use of compiler-let and macrolet.  In the body of the
+;;; macro x should not be lexically bound.  In the body of the macrolet
+;;; itself x should not be lexically bound.  But the macro should expand
+;;; into 1.
+;;; 
+(take-it-out-for-a-test-walk
+  (compiler-let ((x 1))
+    (let ((x 2))
+      (macrolet ((foo () x))
+	x
+	(foo)))))
+
+
+(take-it-out-for-a-test-walk
+  (flet ((foo (x) (list x y))
+	 (bar (x) (list x y)))
+    (foo 1)))
+
+(take-it-out-for-a-test-walk
+  (let ((y 2))
+    (flet ((foo (x) (list x y))
+	   (bar (x) (list x y)))
+      (foo 1))))
+
+(take-it-out-for-a-test-walk
+  (labels ((foo (x) (bar x))
+	   (bar (x) (foo x)))
+    (foo 1)))
+
+(take-it-out-for-a-test-walk
+  (flet ((foo (x) (foo x)))
+    (foo 1)))
+
+(take-it-out-for-a-test-walk
+  (flet ((foo (x) (foo x)))
+    (flet ((bar (x) (foo x)))
+      (bar 1))))
+
+(take-it-out-for-a-test-walk (compiler-let ((a 1) (b 2)) (foo a) b))
+(take-it-out-for-a-test-walk (prog () (declare (special a b))))
+(take-it-out-for-a-test-walk (let (a b c)
+                               (declare (special a b))
+                               (foo a) b c))
+(take-it-out-for-a-test-walk (let (a b c)
+                               (declare (special a) (special b))
+                               (foo a) b c))
+(take-it-out-for-a-test-walk (let (a b c)
+                               (declare (special a))
+                               (declare (special b))
+                               (foo a) b c))
+(take-it-out-for-a-test-walk (let (a b c)
+                               (declare (special a))
+                               (declare (special b))
+                               (let ((a 1))
+                                 (foo a) b c)))
+(take-it-out-for-a-test-walk (eval-when ()
+                               a
+                               (foo a)))
+(take-it-out-for-a-test-walk (eval-when (eval when load)
+                               a
+                               (foo a)))
+
+(take-it-out-for-a-test-walk (multiple-value-bind (a b) (foo a b) (list a b)))
+(take-it-out-for-a-test-walk (multiple-value-bind (a b)
+				 (foo a b)
+			       (declare (special a))
+			       (list a b)))
+(take-it-out-for-a-test-walk (progn (function foo)))
+(take-it-out-for-a-test-walk (progn a b (go a)))
+(take-it-out-for-a-test-walk (if a b c))
+(take-it-out-for-a-test-walk (if a b))
+(take-it-out-for-a-test-walk ((lambda (a b) (list a b)) 1 2))
+(take-it-out-for-a-test-walk ((lambda (a b) (declare (special a)) (list a b))
+			      1 2))
+(take-it-out-for-a-test-walk (let ((a a) (b a) (c b)) (list a b c)))
+(take-it-out-for-a-test-walk (let* ((a a) (b a) (c b)) (list a b c)))
+(take-it-out-for-a-test-walk (let ((a a) (b a) (c b))
+                               (declare (special a b))
+                               (list a b c)))
+(take-it-out-for-a-test-walk (let* ((a a) (b a) (c b))
+                               (declare (special a b))
+                               (list a b c)))
+(take-it-out-for-a-test-walk (let ((a 1) (b 2))
+                               (foo bar)
+                               (declare (special a))
+                               (foo a b)))
+(take-it-out-for-a-test-walk (multiple-value-call #'foo a b c))
+(take-it-out-for-a-test-walk (multiple-value-prog1 a b c))
+(take-it-out-for-a-test-walk (progn a b c))
+(take-it-out-for-a-test-walk (progv vars vals a b c))
+(take-it-out-for-a-test-walk (quote a))
+(take-it-out-for-a-test-walk (return-from block-name a b c))
+(take-it-out-for-a-test-walk (setq a 1))
+(take-it-out-for-a-test-walk (setq a (foo 1) b (bar 2) c 3))
+(take-it-out-for-a-test-walk (tagbody a b c (go a)))
+(take-it-out-for-a-test-walk (the foo (foo-form a b c)))
+(take-it-out-for-a-test-walk (throw tag-form a))
+(take-it-out-for-a-test-walk (unwind-protect (foo a b) d e f))
+
+(defmacro flet-1 (a b) ''OUTER)
+(defmacro labels-1 (a b) ''OUTER)
+
+(take-it-out-for-a-test-walk
+  (flet ((flet-1 (a b) () (flet-1 a b) (list a b)))
+    (flet-1 1 2)
+    (foo 1 2)))
+(take-it-out-for-a-test-walk
+  (labels ((label-1 (a b) () (label-1 a b)(list a b)))
+    (label-1 1 2)
+    (foo 1 2)))
+(take-it-out-for-a-test-walk (macrolet ((macrolet-1 (a b) (list a b)))
+                               (macrolet-1 a b)
+                               (foo 1 2)))
+
+(take-it-out-for-a-test-walk (macrolet ((foo (a) `(inner-foo-expanded ,a)))
+                               (foo 1)))
+
+(take-it-out-for-a-test-walk (progn (bar 1)
+                                    (macrolet ((bar (a)
+						 `(inner-bar-expanded ,a)))
+                                      (bar 2))))
+
+(take-it-out-for-a-test-walk (progn (bar 1)
+                                    (macrolet ((bar (s)
+						 (bar s)
+						 `(inner-bar-expanded ,s)))
+                                      (bar 2))))
+
+(take-it-out-for-a-test-walk (cond (a b)
+                                   ((foo bar) a (foo a))))
+
+
+(let ((the-lexical-variables ()))
+  (walk-form '(let ((a 1) (b 2))
+		#'(lambda (x) (list a b x y)))
+	     ()
+	     #'(lambda (form context env)
+		 (when (and (symbolp form)
+			    (variable-lexical-p form env))
+		   (push form the-lexical-variables))
+		 form))
+  (or (and (= (length the-lexical-variables) 3)
+	   (member 'a the-lexical-variables)
+	   (member 'b the-lexical-variables)
+	   (member 'x the-lexical-variables))
+      (error "Walker didn't do lexical variables of a closure properly.")))
+    
+|#
diff --git a/src/clx/CHANGES b/src/clx/CHANGES
new file mode 100644
index 000000000..ba9c63ab3
--- /dev/null
+++ b/src/clx/CHANGES
@@ -0,0 +1,331 @@
+R5 changes: (see below for details)
+
+o Numerous bug fixes
+
+o Continued gradual conversion towards ANSI Common Lisp
+
+o Performance improvements to image code
+
+o Multiprocess locking and error reporting made more robust
+
+o Event queue consing reduced
+
+o ICCCM support
+
+Details of changes since R4:
+
+R4.1 changes:
+
+o Fix reported bugs and to include the vendor-specific
+  bug-fixing and performance-improving patches that I recently received.
+
+o Code compiled with the R4 CLX will work with the R4.1X CLX, but code
+  compiled with the R4.1X CLX will NOT work with the R4 CLX.  I made an effort
+  to ensure backward binary compatibility with R4 CLX so that old code doesn't
+  have to be recompiled to still work.  It does have to be recompiled to fix
+  an event-queue bug, since the fix involved a change to the event-loop macro.
+
+R4.2 changes:
+
+o Atoms and visuals are now correctly maintained in a separate namespace from 
+  windows, pixmaps, cursors, fonts, gcontexts, and colormaps.
+
+o I have made an attempt to make socket code work for kcl and ibcl.  I have
+  akcl here, but not kcl and ibcl, so it's only guesswork that kcl and ibcl 
+  works.
+
+o compile-clx and load-clx do more pathname merging to work around problems
+  in some lisp implementations. *default-pathname-defaults* is never bound 
+  anymore.
+
+o Some ansi common lisp stuff.  If you have :ansi-common-lisp on *features*,
+  CLX will:
+
+  - Use the common-lisp package instead of the lisp package.
+
+  - Use the common lisp condition system, being careful not to stomp on 
+    define-condition and type-error.
+
+  - Use declaim instead of proclaim.
+
+  - Use the dynamic-extent declaration for rest args and closures.
+
+  - Use print-unreadable-object.
+
+o Code compiled with the R4 and R4.1 CLX will work with the R4.2 CLX, provided
+  you don't have :ansi-common-lisp on your features list.  Code compiled with 
+  the R4.2 CLX will NOT work with the R4 CLX.
+
+R4.3 changes:
+
+o Changed the ansi-common-lisp feature to clx-ansi-common-lisp.
+
+o A new package.l file has been introduced.  All the package operations that
+  were in the other files have been moved to package.l.  Because of this, 
+  the compile-clx and load-clx functions which are defined in the defsystem.l
+  file have been moved to the user package from the xlib package, since the xlib 
+  package isn't defined when the defsystem.l file is loaded.
+
+o excldefsys.l has been merged into defsystem.l.  You don't have to rename
+  excldefsys.l to defsystem.l anymore.
+
+o User-specified-size/position-p hints are now set correctly.
+  These hints were being ignored if the size-hints structure did not
+  define the corresponding geometry slots. But ICCCM declares these
+  slots to be obsolete.
+
+o (setf wm-command) has been changed to use PRIN1 inside the ANSI Common Lisp
+  form WITH-STANDARD-IO-SYNTAX (or the equivalent defined in dependent.l), with
+  elements of command separated by NULL characters.  This enables 
+    (with-standard-io-syntax (mapcar #'read-from-string (wm-command window)))
+  to recover a lisp command.
+
+o A typo in X-TYPE-ERROR has been fixed.
+
+o The WITH-GCONTEXT macro has been changed so that if you supply nil for a
+  property value, WITH-GCONTEXT is will leave the property unchanged.  It used
+  to always change the property without regard for whether the supplied value
+  was nil.  This change to how the macro expands, so user code has to be 
+  recompiled for the change to take effect.
+
+o Since ANSI Common Lisp doesn't have CHAR-BIT, the implementation of
+  DEFAULT-KEYSYM-TRANSLATE is now implementation dependent in ANSI Common Lisp
+  implementations, with the default doing nothing to character objects.  In
+  non-ANSI Common Lisps and lispms, it still uses CHAR-BIT. The definition of
+  DEFAULT-KEYSYM-TRANSLATE has been moved to dependent.l.
+
+o The image putting, getting, and copying code has been sped up a bit for lispm, 
+  lcl3.0, and excl.
+
+o The lcl3.0 io code has been sped up a bit by using read-array instead of
+  fast-read-byte.
+
+o READ-RESOURCES now handles any lines that start with # and don't start with
+  #include as comments.
+
+R4.4 changes:
+
+o Fixed typo in DEFAULT-KEYSYM-TRANSLATE.
+
+o In events, CurrentTime (encoded as 0 in the protocol) decodes to NIL instead 
+  of 0.
+
+o NIL now translates to and from the atom-id of 0.
+
+o A new variable *OUTPUT-BUFFER-SIZE* has been introduced, with value 8192.
+  Now, instead of the buffer creating code always creating output buffers of 
+  length 8192 bytes, they create output buffers of length *OUTPUT-BUFFER-SIZE* 
+  bytes.
+
+o GCONTEXT-CACHE-P, COLORMAP-PLIST and CURSOR-PLIST have been exported.
+
+o If CREATE-GCONTEXT is given a rect-seq as a clip-mask, then a
+  SetClipRectangles request must be sent to initialize the clip-mask.  The logic
+  to do this is located in FORCE-GCONTEXT-CHANGES-INTERNAL, but this wasn't
+  being called because create-gcontext always forces local/server-state
+  timestamps equal.  Same problem for dash lists.  CREATE-GCONTEXT has been
+  fixed so that in these cases it makes the timestamps unequal so that
+  FORCE-GCONTEXT-CHANGES-INTERNAL is called.
+
+o ANGLEP type check sped up for excl.  Arc drawing should be lots faster.
+
+o RATIONAL type definition for kcl now takes the correct optional args.
+
+o (SETF FONT-PATH) changed to return the value
+
+o Fixed typo in the hex parsing in READ-BITMAP-FILE
+
+o Made READ-RESOURCES more robust about weird resource files.
+
+o New variable *DEF-CLX-CLASS-USE-DEFCLASS*, which controls whether DEF-CLX-CLASS
+  uses DEFCLASS.  If it is a list, it is interpreted by DEF-CLX-CLASS to be a list
+  of type names for which DEFCLASS should be used.  If it is not a list, DEFCLASS
+  is always used.  IF it is NIL, DEFCLASS is never used, since NIL is the empty
+  list.  By default, it's T in Genera, NIL otherwise.
+
+o Fixed typo in DEFINE-CONDITION for #-(or lispm clx-ansi-common-lisp excl lcl3.0).
+
+o Fixed typo in MERGE-RESOURCES 
+
+o In Lucid lisp, the functions aref-card8, aref-int8, aset-card8, aset-int8,
+  aref-card16, aref-int16, aref-card32, aref-int32, aref-card29, aset-card16,
+  aset-int16, aset-card32, aset-int32, and aset-card29 Have been fixed so that
+  they can be used inline with the development compiler.
+
+o The default value of the BYTE-LSB-FIRST-P argument to CREATE-IMAGE has been
+  changed from always T to T on LSBFirst machines and NIL on MSBFirst machines.
+
+o The order of the color values returned by ALLOC-COLOR when a color name is supplied
+  as an argument is fixed so that the screen color correctly is returned as the second 
+  value and the exact color is correctly returned as the third value.  The order was 
+  backwards.
+
+o The internal WITH-BUFFER-INPUT and WITH-BUFFER-OUTPUT macros have been
+  changed to wrap macrolet around body only when necessary.  This simplifies the
+  compiler's job for non lisp machines.
+
+o All uses of DEFINE-CONDITION have been changed to include a slots argument,
+  even if that argument is NIL -- the argument is not optional.
+
+o DEFINE-CONDITION is no longer exported from the XLIB package.
+
+o New functionality has been added to make-pixmap and make-window.  They may
+  now take a :PIXMAP or :WINDOW argument (respectively).  If non-NIL (default is
+  nil), they will use that argument as the pixmap or window object to be set.
+  Otherwise they will create a new pixmap/window object.  This whole schmeel is
+  necessary because creation of window and pixmap objects in CLX doesn't go
+  through the CLOS initialize-instance mechanism.
+
+o The DESCRIBE-WINDOW debug utility has been fixed to not use strange
+  lisp machine format codes.
+
+o Numerous Allegro specific changes in support of Allegro CL version 4.0.
+
+R4.5 changes:
+
+o Fixed READ-VECTOR-CARD8 and WRITE-VECTOR-CARD8 to work with arbitrary vectors.
+
+o Changed COMPILE-CLX and LOAD-CLX to use the verbose mode of COMPILE-FILE and LOAD.
+
+o Added a conditional for HPUX to COMPILE-CLX.
+
+o Changed DISPLAY-CONNECT to save the default colormap ID in the ID database.
+
+o Added new keyword arguments :PROGRAM-SPECIFIED-POSITION-P and :PROGRAM-SPECIFIED-SIZE-P
+  to SET-WM-PROPERTIES and corresponsing slots in the WM-SIZE-HINTS structure.
+  These control the appropriate flags in the size hints.  The old way of controlling these
+  flags, with the :X, :Y, :WIDTH, and :HEIGHT arguments, is now obsolete due to changes
+  in the ICCCM.
+
+o Removed bogus declarations from the SETF expander for WM-NAME.
+
+o Defined a proper SETF function for CUT-BUFFER when in ANSI Lisp.
+
+o Fix the encoding of the revert-to argument to SET-INPUT-FOCUS.
+
+o Fix a fencepost error in STORE-COLORS.
+
+o Fix TEXT-EXTENTS and TEXT-WIDTH to handle font changes properly.
+
+o Fix TEXT-EXTENTS-LOCAL to handle negative ascents and descents properly.
+
+o Fix DRAW-IMAGE-GLYPHS to not try to write more than 255 glyphs.
+
+o Added conditionalizations for Minima, a new operating system under development at Symbolics.
+
+o Some gratuitous changes in the Symbolics-specific code.
+
+o Removed *EVENT-LOOP-VERSION* and support for pre-R4.1 compiled code.
+
+o In Lucid, fixed HOLDING-LOCK to clean up on timeout.
+
+o Gcontexts and fonts without associated displays now print correctly.
+
+Requests that send "strings" of two byte font indices can *not* assume that
+the two byte objects are being written on two byte boundaries.  The simplest
+fix was just to modify the write-*-card16 functions to use a new macro that
+writes one half of the object at a time.  The only undesirable affect of
+this is that CLIENT-MESSAGE and CHANGE-PROPERTY are slightly slower for
+card16 data than they were before.
+    NEW macro
+	-- write-card16-by-bytes			bufmac.l
+    CHANGED functions:
+	-- write-list-card16				buffer.l
+	-- write-list-card16-with-transform		""
+	-- write-simple-array-card16			""
+	-- write-simple-array-card16-with-transform	""
+	-- write-vector-card16				""
+	-- write-vector-card16-with-transform		""
+
+Print functions changed to use write-string instead of princ where
+possible.  This allows for much cleaner printing when *print-circle* is
+true -- princ is required to use *print-circle*, even for strings!
+Write-string is, of course, not so burdened.
+	-- print-color					clx.l
+	-- print-display				""
+	-- print-drawable				""
+	-- print-visual-info				""
+	-- print-colormap				""
+	-- print-cursor					""
+	-- print-gcontext				""
+	-- print-screen					""
+	-- print-font					""
+	-- print-resource-database			resource.l
+	-- print-image					image.l
+
+Changes to display tracing: In a multiprocessing system is it very helpful
+to know what process wrote or read certain requests.  Thus I have modified
+the format of the trace-history list.  It is now an alist of: ((id .
+more-info) .  byte-vector).  (more-info is a list returned by the
+trace-more-info function).  Also added the ability to suspend and resume
+tracing without destroying the trace history.  Renamed 'display-trace' to
+'show-trace' to avoid confusion.  (Having both 'trace-display and
+'display-trace wasn't such a hot idea).
+	-- lots-o-stuff					debug/trace.l
+
+Image-glyph functions had a different argument order than non-image glyph
+functions.  Image-glyph functions changed to be compatible with others.
+Declarations in draw-glyphs* functions were wrong.
+	-- draw-image-glyphs				text.l
+	-- draw-image-glyphs8				text.l
+	-- draw-image-glyphs16				text.l
+	-- draw-glyphs8					text.l
+	-- draw-glyphs16				text.l
+
+Quote #.'ed arrays to accomodate CLTL1 lisps
+	-- empty-data constants				image.l
+
+Set-input-focus fix wasn't finished
+	-- set-input-focus				requests.l
+
+Standardized strange integer type specifier in keysym macro
+	-- keysym					translate.l
+
+===============================================================================
+Franz specific changes, applicable to Allegro and Extended Common Lisps:
+(note that all these changes are #+excl or #+allegro, so if you're not
+ using our product these changes are "commented" out)
+-----------------------------------------------------------------------
+Atom-cache hash table type changed to #'equal.  Resource-id-map has table
+type changed to #'equal.
+    NEW macro
+	-- atom-cache-map-test				depdefs.l
+    CHANGED def-clx-class
+	-- display					clx.l
+    CHANGED macro
+	-- resource-id-map-test				depdefs.l
+
+Don't bother to import require, provide, since we're using the CLTL1
+package.  Also put the requires and provides inside eval-when to make the
+compiler happy.  Don't redefine typep, instead push our customizations onto
+the typep handling list.
+	-- toplevel forms				excldep.l
+
+Old code removed from file
+	-- removed some cmacros				exclcmac.l
+
+Allegro >=4.0 now does support with-standard-io-syntax and
+print-unreadable-object.
+	-- with-standard-io-syntax{,-function}		dependent.l
+	-- print-unreadable-object{,-function}		depdefs.l
+
+Conditionalizations in Makefile cleaned up.
+	-- 						exclMakefile
+
+Descriptive comment added to holding-lock
+	-- holding-lock					dependent.l
+
+Added typep transformers for all CLX types.
+	--						excldep.cl
+
+R5.0 changes:
+
+o Changed occurrances STRING-CHAR to BASE-CHAR.
+
+o Fixed some type declarations to use type NULL instead of NIL.
+
+o Various fixes to vendor-specific code.
+
+o Detect attempts to use images an incorrect depth.
+
+o Stop doing case conversion on resource names be default.
diff --git a/src/clx/README b/src/clx/README
new file mode 100644
index 000000000..7f4aa19a8
--- /dev/null
+++ b/src/clx/README
@@ -0,0 +1,48 @@
+These files contain beta code, but they have been tested to some extent under
+Symbolics, TI, Lucid and Franz.  The files have been given .l suffixes to keep
+them within 12 characters, to keep SysV sites happy.  Please rename them with
+more appropriate suffixes for your system.
+
+
+For Franz systems, see exclREADME.
+
+
+For Symbolics systems, first rename all the .l files to .lisp.  Then edit your
+sys.translations file so that sys:x11;clx; points to this directory and put a
+clx.system file in your sys:site;directory that has the form
+
+    (si:set-system-source-file "clx" "sys:x11;clx;defsystem.lisp")
+
+in it.   After that CLX can be compiled with the "Compile System CLX" command
+and loaded with the "Load System CLX" command.
+
+
+
+For TI systems, rename all the .l files to .lisp, and make a clx.translations
+file in your sys:site; directory pointing to this directory and a
+sys:site;clx.system file like the one described for symbolics systems above,
+but with the defsystem file being in the clx:clx; directory.  Then CLX can be
+compiled with (make-system "CLX" :compile :noconfirm) and loaded with
+(make-system "CLX" :noconfirm).
+
+
+
+For Lucid systems, you should rename all the .l files to .lisp too (This might
+not be possible on SysV systems).  After loading the defsystem.l file, CLX can
+be compiled with the (compile-clx) function and loaded with the
+(load-clx) form.  
+
+The ms-patch.uu file is a patch to Lucid version 2 systems.  You probably
+don't need it, as you are probably running Lucid version 3 or later, but if
+you are still using Lucid version 2, you need this patch.  You'll need to
+uudecode it to produce the binary.
+
+
+
+For kcl systems, after loading the defsystem.l file, CLX can be compiled with
+the (compile-clx) function and loaded with the (load-clx) form.
+
+
+
+For more information, see defsystem.l and provide.l.
+
diff --git a/src/clx/attributes.lsp b/src/clx/attributes.lsp
new file mode 100644
index 000000000..133ab6b2a
--- /dev/null
+++ b/src/clx/attributes.lsp
@@ -0,0 +1,643 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;; Window Attributes
+
+;;;(c) Copyright Enhancements by Giuseppe Attardi, 1994.
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+;;;	The special variable *window-attributes* is an alist containg:
+;;;	(drawable attributes attribute-changes geometry geometry-changes)
+;;;	Where DRAWABLE is the associated window or pixmap
+;;;	      ATTRIBUTES is NIL or a reply-buffer containing the drawable's
+;;;		         attributes for use by the accessors.
+;;;	      ATTRIBUTE-CHANGES is NIL or an array.  The first element
+;;;			 of the array is a "value-mask", indicating which
+;;;			 attributes have changed.  The other elements are
+;;;			 integers associated with the changed values, ready
+;;;			 for insertion into a server request.
+;;;	      GEOMETRY is like ATTRIBUTES, but for window geometry
+;;;	      GEOMETRY-CHANGES is like ATTRIBUTE-CHANGES, but for window geometry
+;;;
+;;;	Attribute and Geometry accessors and SETF's look on the special variable
+;;;	*window-attributes* for the drawable.  If its not there, the accessor is
+;;;     NOT within a WITH-STATE, and a server request is made to get or put a value.
+;;;     If an entry is found in *window-attributes*, the cache buffers are used
+;;;	for the access.
+;;;
+;;;	All WITH-STATE has to do (re)bind *Window-attributes* to a list including
+;;;	the new drawable.  The caches are initialized to NIL and allocated as needed.
+
+(in-package :xlib)
+
+(eval-when (compile load eval)			;needed by Franz Lisp
+(defconstant *attribute-size* 44)
+(defconstant *geometry-size* 24)
+(defconstant *context-size* (max *attribute-size* *geometry-size* (* 16 4))))
+
+(defvar *window-attributes* nil) ;; Bound to an alist of (drawable . state) within WITH-STATE
+
+;; Window Attribute reply buffer resource
+(defvar *context-free-list* nil) ;; resource of free reply buffers
+
+(defun allocate-context ()
+  (or (threaded-atomic-pop *context-free-list* reply-next reply-buffer)
+      (make-reply-buffer *context-size*)))
+
+(defun deallocate-context (context)
+  (declare (type reply-buffer context))
+  (threaded-atomic-push context *context-free-list* reply-next reply-buffer))
+
+(defmacro state-attributes (state) `(second ,state))
+(defmacro state-attribute-changes (state) `(third ,state))
+(defmacro state-geometry (state) `(fourth ,state))
+(defmacro state-geometry-changes (state) `(fifth ,state))
+ 
+(defmacro drawable-equal-function ()
+  (if (member 'drawable *clx-cached-types*)
+      ''eq ;; Allows the compiler to use the microcoded ASSQ primitive on LISPM's
+    ''drawable-equal))
+
+(defmacro window-equal-function ()
+  (if (member 'window *clx-cached-types*)
+      ''eq
+    ''drawable-equal))
+
+(defmacro with-state ((drawable) &body body)
+  ;; Allows a consistent view to be obtained of data returned by GetWindowAttributes
+  ;; and GetGeometry, and allows a coherent update using ChangeWindowAttributes and
+  ;; ConfigureWindow.  The body is not surrounded by a with-display.  Within the
+  ;; indefinite scope of the body, on a per-process basis in a multi-process
+  ;; environment, the first call within an Accessor Group on the specified drawable
+  ;; (the object, not just the variable) causes the complete results of the protocol
+  ;; request to be retained, and returned in any subsequent accessor calls.  Calls
+  ;; within a Setf Group are delayed, and executed in a single request on exit from
+  ;; the body.  In addition, if a call on a function within an Accessor Group follows
+  ;; a call on a function in the corresponding Setf Group, then all delayed setfs for
+  ;; that group are executed, any retained accessor information for that group is
+  ;; discarded, the corresponding protocol request is (re)issued, and the results are
+  ;; (again) retained, and returned in any subsequent accessor calls.
+
+  ;; Accessor Group A (for GetWindowAttributes):
+  ;; window-visual, window-visual-info, window-class, window-gravity, window-bit-gravity,
+  ;; window-backing-store, window-backing-planes, window-backing-pixel,
+  ;; window-save-under, window-colormap, window-colormap-installed-p,
+  ;; window-map-state, window-all-event-masks, window-event-mask,
+  ;; window-do-not-propagate-mask, window-override-redirect
+
+  ;; Setf Group A (for ChangeWindowAttributes):
+  ;; window-gravity, window-bit-gravity, window-backing-store, window-backing-planes,
+  ;; window-backing-pixel, window-save-under, window-event-mask,
+  ;; window-do-not-propagate-mask, window-override-redirect, window-colormap,
+  ;; window-cursor
+
+  ;; Accessor Group G (for GetGeometry):
+  ;; drawable-root, drawable-depth, drawable-x, drawable-y, drawable-width,
+  ;; drawable-height, drawable-border-width
+
+  ;; Setf Group G (for ConfigureWindow):
+  ;; drawable-x, drawable-y, drawable-width, drawable-height, drawable-border-width,
+  ;; window-priority
+  (let ((state-entry (gensym)))
+     ;; alist of (drawable attributes attribute-changes geometry geometry-changes)
+    `(with-stack-list (,state-entry ,drawable nil nil nil nil)
+       (with-stack-list* (*window-attributes* ,state-entry *window-attributes*)
+	 (multiple-value-prog1
+	   (progn ,@body)
+	   (cleanup-state-entry ,state-entry))))))
+
+(defun cleanup-state-entry (state)
+  ;; Return buffers to the free-list
+  (let ((entry (state-attributes state)))
+    (when entry (deallocate-context entry)))
+  (let ((entry (state-attribute-changes state)))
+    (when entry
+      (put-window-attribute-changes (car state) entry)
+      (deallocate-gcontext-state entry)))
+  (let ((entry (state-geometry state)))
+    (when entry (deallocate-context entry)))
+  (let ((entry (state-geometry-changes state)))
+    (when entry
+      (put-drawable-geometry-changes (car state) entry)
+      (deallocate-gcontext-state entry))))
+
+
+
+(defun change-window-attribute (window number value)
+  ;; Called from window attribute SETF's to alter an attribute value
+  ;; number is the change-attributes request mask bit number
+  (declare (type window window)
+	   (type card8 number)
+	   (type card32 value))
+  (let ((state-entry nil)
+	(changes nil))
+    #+ecl (declare (gcontext-state changes))
+    (if (and *window-attributes*
+	     (setq state-entry (assoc window (the list *window-attributes*)
+				      :test (window-equal-function))))
+	(progn					; Within a WITH-STATE - cache changes
+	  (setq changes (state-attribute-changes state-entry))
+	  (unless changes
+	    (setq changes (allocate-gcontext-state))
+	    (setf (state-attribute-changes state-entry) changes)
+	    (setf (aref changes 0) 0)) ;; Initialize mask to zero
+	  (setf (aref changes 0) (logior (aref changes 0) (ash 1 number))) ;; set mask bit
+	  (setf (aref changes (1+ number)) value))	;; save value
+						; Send change to the server
+      (with-buffer-request ((window-display window) *x-changewindowattributes*)
+	(window window)
+	(card32 (ash 1 number) value)))))
+;;
+;; These two are twins (change-window-attribute change-drawable-geometry)
+;; If you change one, you probably need to change the other...
+;;
+(defun change-drawable-geometry (drawable number value)
+  ;; Called from drawable geometry SETF's to alter an attribute value
+  ;; number is the change-attributes request mask bit number
+  (declare (type drawable drawable)
+	   (type card8 number)
+	   (type card29 value))
+  (let ((state-entry nil)
+	(changes nil))
+    #+ecl (declare (gcontext-state changes))
+    (if (and *window-attributes*
+	     (setq state-entry (assoc drawable (the list *window-attributes*)
+				      :test (drawable-equal-function))))
+	(progn					; Within a WITH-STATE - cache changes
+	  (setq changes (state-geometry-changes state-entry))
+	  (unless changes
+	    (setq changes (allocate-gcontext-state))
+	    (setf (state-geometry-changes state-entry) changes)
+	    (setf (aref changes 0) 0)) ;; Initialize mask to zero
+	  (setf (aref changes 0) (logior (aref changes 0) (ash 1 number))) ;; set mask bit
+	  (setf (aref changes (1+ number)) value))	;; save value
+						; Send change to the server
+      (with-buffer-request ((drawable-display drawable) *x-configurewindow*)
+	(drawable drawable)
+	(card16 (ash 1 number))
+	(card29 value)))))
+
+(defun get-window-attributes-buffer (window)
+  (declare (type window window))
+  (let ((state-entry nil)
+	(changes nil))
+    (or (and *window-attributes*
+	     (setq state-entry (assoc window (the list *window-attributes*)
+				      :test (window-equal-function)))
+	     (null (setq changes (state-attribute-changes state-entry)))
+	     (state-attributes state-entry))
+	(let ((display (window-display window)))
+	  (with-display (display)
+	    ;; When SETF's have been done, flush changes to the server
+	    (when changes
+	      (put-window-attribute-changes window changes)
+	      (deallocate-gcontext-state (state-attribute-changes state-entry))
+	      (setf (state-attribute-changes state-entry) nil))
+	    ;; Get window attributes
+	    (with-buffer-request-and-reply (display *x-getwindowattributes* size :sizes (8))
+		 ((window window))
+	      (let ((repbuf (or (state-attributes state-entry) (allocate-context))))
+		(declare (type reply-buffer repbuf))
+		;; Copy into repbuf from reply buffer
+		(buffer-replace (reply-ibuf8 repbuf) buffer-bbuf 0 size)
+		(when state-entry (setf (state-attributes state-entry) repbuf))
+		repbuf)))))))
+
+;;
+;; These two are twins (get-window-attributes-buffer get-drawable-geometry-buffer)
+;; If you change one, you probably need to change the other...
+;;
+(defun get-drawable-geometry-buffer (drawable)
+  (declare (type drawable drawable))
+  (let ((state-entry nil)
+	(changes nil))
+    (or (and *window-attributes*
+	     (setq state-entry (assoc drawable (the list *window-attributes*)
+				      :test (drawable-equal-function)))
+	     (null (setq changes (state-geometry-changes state-entry)))
+	     (state-geometry state-entry))
+	(let ((display (drawable-display drawable)))
+	  (with-display (display)
+	    ;; When SETF's have been done, flush changes to the server
+	    (when changes
+	      (put-drawable-geometry-changes drawable changes)
+	      (deallocate-gcontext-state (state-geometry-changes state-entry))
+	      (setf (state-geometry-changes state-entry) nil))
+	    ;; Get drawable attributes
+	    (with-buffer-request-and-reply (display *x-getgeometry* size :sizes (8))
+		 ((drawable drawable))
+	      (let ((repbuf (or (state-geometry state-entry) (allocate-context))))
+		(declare (type reply-buffer repbuf))
+		;; Copy into repbuf from reply buffer
+		(buffer-replace (reply-ibuf8 repbuf) buffer-bbuf 0 size)
+		(when state-entry (setf (state-geometry state-entry) repbuf))
+		repbuf)))))))
+
+(defun put-window-attribute-changes (window changes)
+  ;; change window attributes
+  ;; Always from Called within a WITH-DISPLAY
+  (declare (type window window)
+	   (type gcontext-state changes))
+  (let* ((display (window-display window))
+	 (mask (aref changes 0)))
+    (declare (type display display)
+	     (type mask32 mask))
+    (with-buffer-request (display *x-changewindowattributes*)
+      (window window)
+      (card32 mask)
+      (progn ;; Insert a word in the request for each one bit in the mask
+	(do ((bits mask (ash bits -1))
+	     (request-size 2)			;Word count
+	     (i 1 (index+ i 1)))		;Entry count
+	    ((zerop bits)
+	     (card16-put 2 (index-incf request-size))
+	     (index-incf (buffer-boffset display) (index* request-size 4)))
+	  (declare (type mask32 bits)
+		   (type array-index i request-size))
+	  (when (oddp bits)
+	    (card32-put (index* (index-incf request-size) 4) (aref changes i))))))))
+;;
+;; These two are twins (put-window-attribute-changes put-drawable-geometry-changes)
+;; If you change one, you probably need to change the other...
+;;
+(defun put-drawable-geometry-changes (window changes)
+  ;; change window attributes or geometry (depending on request-number...)
+  ;; Always from Called within a WITH-DISPLAY
+  (declare (type window window)
+	   (type gcontext-state changes))
+  (let* ((display (window-display window))
+	 (mask (aref changes 0)))
+    (declare (type display display)
+	     (type mask16 mask))
+    (with-buffer-request (display *x-configurewindow*)
+      (window window)
+      (card16 mask)
+      (progn ;; Insert a word in the request for each one bit in the mask
+	(do ((bits mask (ash bits -1))
+	     (request-size 2)			;Word count
+	     (i 1 (index+ i 1)))		;Entry count
+	    ((zerop bits)
+	     (card16-put 2 (index-incf request-size)) ; ECL
+	     (index-incf (buffer-boffset display)
+			 (index* request-size 4))) ; ECL
+	  (declare (type mask16 bits)
+		   (type array-index request-size) ; ECL
+		   (type array-index i))
+	  (when (oddp bits)
+	    (card29-put (index* (incf request-size) 4) ; ECL
+			(aref changes i))))))))
+
+(defmacro with-attributes ((window &rest options) &body body)
+  `(let ((.with-attributes-reply-buffer. (get-window-attributes-buffer ,window)))
+     (declare (type reply-buffer .with-attributes-reply-buffer.))
+     (prog1 
+       (with-buffer-input (.with-attributes-reply-buffer. ,@options) ,@body)
+       (unless *window-attributes*
+	 (deallocate-context .with-attributes-reply-buffer.)))))
+;;
+;; These two are twins (with-attributes with-geometry)
+;; If you change one, you probably need to change the other...
+;;
+(defmacro with-geometry ((window &rest options) &body body)
+  `(let ((.with-geometry-reply-buffer. (get-drawable-geometry-buffer ,window)))
+     (declare (type reply-buffer .with-geometry-reply-buffer.))
+     (prog1 
+       (with-buffer-input (.with-geometry-reply-buffer. ,@options) ,@body)
+       (unless *window-attributes*
+	 (deallocate-context .with-geometry-reply-buffer.)))))
+
+;;;-----------------------------------------------------------------------------
+;;; Group A: (for GetWindowAttributes)
+;;;-----------------------------------------------------------------------------
+
+(defun window-visual (window)
+  (declare (type window window))
+  (declare (values resource-id))
+  (with-attributes (window :sizes 32)
+    (resource-id-get 8)))
+
+(defun window-visual-info (window)
+  (declare (type window window))
+  (declare (values visual-info))
+  (with-attributes (window :sizes 32)
+    (visual-info (window-display window) (resource-id-get 8))))
+
+(defun window-class (window)
+  (declare (type window window))
+  (declare (values (member :input-output :input-only)))
+  (with-attributes (window :sizes 16)
+    (member16-get 12 :copy :input-output :input-only)))
+
+(defun set-window-background (window background)
+  (declare (type window window)
+	   (type (or (member :none :parent-relative) pixel pixmap) background))
+  (cond ((eq background :none) (change-window-attribute window 0 0))
+	((eq background :parent-relative) (change-window-attribute window 0 1))
+	((integerp background) ;; Background pixel
+	 (change-window-attribute window 0 0) ;; pixmap :NONE
+	 (change-window-attribute window 1 background))
+	((type? background 'pixmap) ;; Background pixmap
+	 (change-window-attribute window 0 (pixmap-id background)))
+	(t (x-type-error background '(or (member :none :parent-relative) integer pixmap))))
+  background)
+
+#+Genera (eval-when (compile) (compiler:function-defined 'window-background))
+
+(defsetf window-background set-window-background)
+
+(defun set-window-border (window border)
+  (declare (type window window)
+	   (type (or (member :copy) pixel pixmap) border))
+  (cond ((eq border :copy) (change-window-attribute window 2 0))
+	((type? border 'pixmap) ;; Border pixmap
+	 (change-window-attribute window 2 (pixmap-id border)))
+	((integerp border) ;; Border pixel
+	 (change-window-attribute window 3 border))
+	(t (x-type-error border '(or (member :copy) integer pixmap))))
+  border)
+
+#+Genera (eval-when (compile) (compiler:function-defined 'window-border))
+
+(defsetf window-border set-window-border)
+
+(defun window-bit-gravity (window)
+  ;; setf'able
+  (declare (type window window))
+  (declare (values bit-gravity))
+  (with-attributes (window :sizes 8)
+    (member8-vector-get 14 *bit-gravity-vector*)))
+
+(defun set-window-bit-gravity (window gravity)
+  (change-window-attribute
+    window 4 (encode-type (member-vector *bit-gravity-vector*) gravity))
+  gravity)
+
+(defsetf window-bit-gravity set-window-bit-gravity)
+
+(defun window-gravity (window)
+  ;; setf'able
+  (declare (type window window))
+  (declare (values win-gravity))
+  (with-attributes (window :sizes 8)
+    (member8-vector-get 15 *win-gravity-vector*)))
+
+(defun set-window-gravity (window gravity)
+  (change-window-attribute
+    window 5 (encode-type (member-vector *win-gravity-vector*) gravity))
+  gravity)
+
+(defsetf window-gravity set-window-gravity)
+
+(defun window-backing-store (window)
+  ;; setf'able
+  (declare (type window window))
+  (declare (values (member :not-useful :when-mapped :always)))
+  (with-attributes (window :sizes 8)
+    (member8-get 1 :not-useful :when-mapped :always)))
+
+(defun set-window-backing-store (window when)
+  (change-window-attribute
+    window 6 (encode-type (member :not-useful :when-mapped :always) when))
+  when)
+
+(defsetf window-backing-store set-window-backing-store)
+
+(defun window-backing-planes (window)
+  ;; setf'able
+  (declare (type window window))
+  (declare (values pixel))
+  (with-attributes (window :sizes 32)
+    (card32-get 16)))
+
+(defun set-window-backing-planes (window planes)
+  (change-window-attribute window 7 (encode-type card32 planes))
+  planes)
+
+(defsetf window-backing-planes set-window-backing-planes)
+
+(defun window-backing-pixel (window)
+  ;; setf'able
+  (declare (type window window))
+  (declare (values pixel))
+  (with-attributes (window :sizes 32)
+    (card32-get 20)))
+
+(defun set-window-backing-pixel (window pixel)
+  (change-window-attribute window 8 (encode-type card32 pixel))
+  pixel)
+
+(defsetf window-backing-pixel set-window-backing-pixel)
+
+(defun window-save-under (window)
+  ;; setf'able
+  (declare (type window window))
+  (declare (values (member :off :on)))
+  (with-attributes (window :sizes 8)
+    (member8-get 24 :off :on)))
+
+(defun set-window-save-under (window when)
+  (change-window-attribute window 10 (encode-type (member :off :on) when))
+  when)
+
+(defsetf window-save-under set-window-save-under)
+
+(defun window-override-redirect (window)
+  ;; setf'able
+  (declare (type window window))
+  (declare (values (member :off :on)))
+  (with-attributes (window :sizes 8)
+    (member8-get 27 :off :on)))
+
+(defun set-window-override-redirect (window when)
+  (change-window-attribute window 9 (encode-type (member :off :on) when))
+  when)
+
+(defsetf window-override-redirect set-window-override-redirect)
+
+(defun window-event-mask (window)
+  ;; setf'able
+  (declare (type window window))
+  (declare (values mask32))
+  (with-attributes (window :sizes 32)
+    (card32-get 36)))
+
+(defsetf window-event-mask (window) (event-mask)
+  (let ((em (gensym)))
+    `(let ((,em ,event-mask))
+       (declare (type event-mask ,em))
+       (change-window-attribute ,window 11 (encode-event-mask ,em))
+       ,em)))
+
+(defun window-do-not-propagate-mask (window)
+  ;; setf'able
+  (declare (type window window))
+  (declare (values mask32))
+  (with-attributes (window :sizes 32)
+    (card32-get 40)))
+
+(defsetf window-do-not-propagate-mask (window) (device-event-mask)
+  (let ((em (gensym)))
+    `(let ((,em ,device-event-mask))
+       (declare (type device-event-mask ,em))
+       (change-window-attribute ,window 12 (encode-device-event-mask ,em))
+       ,em)))
+
+(defun window-colormap (window)
+  (declare (type window window))
+  (declare (values (or null colormap)))
+  (with-attributes (window :sizes 32)
+    (let ((id (resource-id-get 28)))
+      (if (zerop id) nil
+	(lookup-colormap (window-display window) id)))))
+
+(defun set-window-colormap (window colormap)
+  (change-window-attribute
+    window 13 (encode-type (or (member :copy) colormap) colormap))
+  colormap)
+
+(defsetf window-colormap set-window-colormap)
+
+(defun window-cursor (window)
+  (declare (type window window))
+  (declare (values cursor))
+  window
+  (error "~S can only be set" 'window-cursor))
+
+(defun set-window-cursor (window cursor)
+  (change-window-attribute
+    window 14 (encode-type (or (member :none) cursor) cursor))
+  cursor)
+
+(defsetf window-cursor set-window-cursor)
+
+(defun window-colormap-installed-p (window)
+  (declare (type window window))
+  (declare (values boolean))
+  (with-attributes (window :sizes 8)
+    (boolean-get 25)))
+
+(defun window-all-event-masks (window)
+  (declare (type window window))
+  (declare (values mask32))
+  (with-attributes (window :sizes 32)
+    (card32-get 32)))
+
+(defun window-map-state (window)
+  (declare (type window window))
+  (declare (values (member :unmapped :unviewable :viewable)))
+  (with-attributes (window :sizes 8)
+    (member8-get 26 :unmapped :unviewable :viewable)))
+
+
+;;;-----------------------------------------------------------------------------
+;;; Group G: (for GetGeometry)
+;;;-----------------------------------------------------------------------------
+
+(defun drawable-root (drawable)
+  (declare (type drawable drawable))
+  (declare (values window))
+  (with-geometry (drawable :sizes 32)
+    (window-get 8 (drawable-display drawable))))
+
+(defun drawable-x (drawable)
+  ;; setf'able
+  (declare (type drawable drawable))
+  (declare (values int16))
+  (with-geometry (drawable :sizes 16)
+    (int16-get 12)))
+
+(defun set-drawable-x (drawable x)
+  (change-drawable-geometry drawable 0 (encode-type int16 x))
+  x)
+
+(defsetf drawable-x set-drawable-x)
+
+(defun drawable-y (drawable)
+  ;; setf'able
+  (declare (type drawable drawable))
+  (declare (values int16))
+  (with-geometry (drawable :sizes 16)
+    (int16-get 14)))
+
+(defun set-drawable-y (drawable y)
+  (change-drawable-geometry drawable 1 (encode-type int16 y))
+  y)
+
+(defsetf drawable-y set-drawable-y)
+
+(defun drawable-width (drawable)
+  ;; setf'able
+  ;; Inside width, excluding border.
+  (declare (type drawable drawable))
+  (declare (values card16))
+  (with-geometry (drawable :sizes 16)
+    (card16-get 16)))
+
+(defun set-drawable-width (drawable width)
+  (change-drawable-geometry drawable 2 (encode-type card16 width))
+  width)
+
+(defsetf drawable-width set-drawable-width)
+
+(defun drawable-height (drawable)
+  ;; setf'able
+  ;; Inside height, excluding border.
+  (declare (type drawable drawable))
+  (declare (values card16))
+  (with-geometry (drawable :sizes 16)
+    (card16-get 18)))
+
+(defun set-drawable-height (drawable height)
+  (change-drawable-geometry drawable 3 (encode-type card16 height))
+  height)
+
+(defsetf drawable-height set-drawable-height)
+
+(defun drawable-depth (drawable)
+  (declare (type drawable drawable))
+  (declare (values card8))
+  (with-geometry (drawable :sizes 8)
+    (card8-get 1)))
+
+(defun drawable-border-width (drawable)
+  ;; setf'able
+  (declare (type drawable drawable))
+  (declare (values integer))
+  (with-geometry (drawable :sizes 16)
+    (card16-get 20)))
+
+(defun set-drawable-border-width (drawable width)
+  (change-drawable-geometry drawable 4 (encode-type card16 width))
+  width)
+
+(defsetf drawable-border-width set-drawable-border-width)
+
+(defun set-window-priority (mode window sibling)
+  (declare (type (member :above :below :top-if :bottom-if :opposite) mode)
+	   (type window window)
+	   (type (or null window) sibling))
+  (with-state (window)
+    (change-drawable-geometry
+      window 6 (encode-type (member :above :below :top-if :bottom-if :opposite) mode))
+    (when sibling
+      (change-drawable-geometry window 5 (encode-type window sibling))))
+  mode)
+
+#+Genera (eval-when (compile) (compiler:function-defined 'window-priority))
+
+(defsetf window-priority (window &optional sibling) (mode)
+  ;; A bit strange, but retains setf form.
+  `(set-window-priority ,mode ,window ,sibling))
diff --git a/src/clx/buffer.lsp b/src/clx/buffer.lsp
new file mode 100644
index 000000000..70fb357e0
--- /dev/null
+++ b/src/clx/buffer.lsp
@@ -0,0 +1,1804 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;; This file contains definitions for the BUFFER object for Common-Lisp X
+;;; windows version 11
+
+;;;(c) Copyright Enhancements by Giuseppe Attardi, 1994.
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+;; A few notes:
+;;
+;;  1. The BUFFER implements a two-way buffered byte / half-word
+;;     / word stream.  Hooks are left for implementing this with a
+;;     shared memory buffer, or with effenciency hooks to the network
+;;     code.
+;;
+;;  2. The BUFFER object uses overlapping displaced arrays for
+;;     inserting and removing bytes half-words and words.
+;;
+;;  3. The BYTE component of these arrays is written to a STREAM
+;;     associated with the BUFFER.  The stream has its own buffer.
+;;     This may be made more efficient by using the Zetalisp
+;;     :Send-Output-Buffer operation.
+;;
+;;  4. The BUFFER object is INCLUDED in the DISPLAY object.
+;;     This was done to reduce access time when sending requests,
+;;     while maintaing some code modularity.
+;;     Several buffer functions are duplicated (with-buffer,
+;;     buffer-force-output, close-buffer) to keep the naming
+;;     conventions consistent.
+;;
+;;  5. A nother layer of software is built on top of this for generating
+;;     both client and server interface routines, given a specification
+;;     of the protocol. (see the INTERFACE file)
+;;
+;;  6. Care is taken to leave the buffer pointer (buffer-bbuf) set to
+;;     a point after a complete request.  This is to ensure that a partial
+;;     request won't be left after aborts (e.g. control-abort on a lispm).
+
+(in-package :xlib)
+
+(defconstant *requestsize* 160) ;; Max request size (excluding variable length requests)
+
+;;; This is here instead of in bufmac so that with-display can be
+;;; compiled without macros and bufmac being loaded.
+
+(defmacro with-buffer ((buffer &key timeout inline)
+		       &body body &environment env)
+  ;; This macro is for use in a multi-process environment.  It provides
+  ;; exclusive access to the local buffer object for request generation and
+  ;; reply processing.
+  `(macrolet ((with-buffer ((buffer &key timeout) &body body)
+		;; Speedup hack for lexically nested with-buffers
+		`(progn
+		   (progn ,buffer ,@(and timeout `(,timeout)) nil)
+		   ,@body)))
+     ,(if (and (null inline) (macroexpand '(use-closures) env))
+	  `(flet ((.with-buffer-body. () ,@body))
+	     #+clx-ansi-common-lisp
+	     (declare (dynamic-extent #'.with-buffer-body.))
+	     (with-buffer-function ,buffer ,timeout #'.with-buffer-body.))
+	(let ((buf (if (or (symbolp buffer) (constantp buffer))
+		       buffer
+		     '.buffer.)))
+	  `(let (,@(unless (eq buf buffer) `((,buf ,buffer))))
+	     ,@(unless (eq buf buffer) `((declare (type buffer ,buf))))
+	     ,(declare-bufmac)
+	     (when (buffer-dead ,buf)
+	       (x-error 'closed-display :display ,buf))
+	     (holding-lock ((buffer-lock ,buf) ,buf "CLX Display Lock"
+			    ,@(and timeout `(:timeout ,timeout)))
+	       ,@body))))))
+
+(defun with-buffer-function (buffer timeout function)
+  (declare (type display buffer)
+	   (type (or null number) timeout)
+	   (type function function)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent function)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg function))
+  (with-buffer (buffer :timeout timeout :inline t)
+    (funcall function)))
+
+;;; The following are here instead of in bufmac so that event-case can
+;;; be compiled without macros and bufmac being loaded.
+
+(defmacro read-card8 (byte-index)
+  `(aref-card8 buffer-bbuf (index+ buffer-boffset ,byte-index)))
+
+(defmacro read-int8 (byte-index)
+  `(aref-int8 buffer-bbuf (index+ buffer-boffset ,byte-index)))
+
+(defmacro read-card16 (byte-index)
+  #+clx-overlapping-arrays
+  `(aref-card16 buffer-wbuf (index+ buffer-woffset (index-ash ,byte-index -1)))
+  #-clx-overlapping-arrays
+  `(aref-card16 buffer-bbuf (index+ buffer-boffset ,byte-index)))
+
+(defmacro read-int16 (byte-index)
+  #+clx-overlapping-arrays
+  `(aref-int16 buffer-wbuf (index+ buffer-woffset (index-ash ,byte-index -1)))
+  #-clx-overlapping-arrays
+  `(aref-int16 buffer-bbuf (index+ buffer-boffset ,byte-index)))
+
+(defmacro read-card32 (byte-index)
+  #+clx-overlapping-arrays
+  `(aref-card32 buffer-lbuf (index+ buffer-loffset (index-ash ,byte-index -2)))
+  #-clx-overlapping-arrays
+  `(aref-card32 buffer-bbuf (index+ buffer-boffset ,byte-index)))
+
+(defmacro read-int32 (byte-index)
+  #+clx-overlapping-arrays
+  `(aref-int32 buffer-lbuf (index+ buffer-loffset (index-ash ,byte-index -2)))
+  #-clx-overlapping-arrays
+  `(aref-int32 buffer-bbuf (index+ buffer-boffset ,byte-index)))
+
+(defmacro read-card29 (byte-index)
+  #+clx-overlapping-arrays
+  `(aref-card29 buffer-lbuf (index+ buffer-loffset (index-ash ,byte-index -2)))
+  #-clx-overlapping-arrays
+  `(aref-card29 buffer-bbuf (index+ buffer-boffset ,byte-index)))
+
+(defmacro event-code (reply-buffer)
+  ;; The reply-buffer structure is used for events.
+  ;; The size slot is used for the event code.
+  `(reply-size ,reply-buffer))
+
+(defmacro reading-event ((event &rest options) &body body)
+  (declare (arglist (buffer &key sizes) &body body))
+  ;; BODY may contain calls to (READ32 &optional index) etc.
+  ;; These calls will read from the input buffer at byte
+  ;; offset INDEX.  If INDEX is not supplied, then the next
+  ;; word, half-word or byte is returned.
+  `(with-buffer-input (,event ,@options) ,@body))
+
+(defmacro with-buffer-input ((reply-buffer &key display (sizes '(8 16 32)) index)
+			     &body body)
+  (unless (listp sizes) (setq sizes (list sizes)))
+  ;; 160 is a special hack for client-message-events
+  (when (set-difference sizes '(0 8 16 32 160 256))
+    (error "Illegal sizes in ~a" sizes))
+  `(let ((%reply-buffer ,reply-buffer)
+	 ,@(and display `((%buffer ,display))))
+     (declare (type reply-buffer %reply-buffer)
+	      ,@(and display '((type display %buffer))))
+     ,(declare-bufmac)
+     ,@(and display '(%buffer))
+     (let* ((buffer-boffset (the array-index ,(or index 0)))
+	    #-clx-overlapping-arrays
+	    (buffer-bbuf (reply-ibuf8 %reply-buffer))
+	    #+clx-overlapping-arrays
+	    ,@(append
+		(when (member 8 sizes)
+		  `((buffer-bbuf (reply-ibuf8 %reply-buffer))))
+		(when (or (member 16 sizes) (member 160 sizes))
+		  `((buffer-woffset (index-ash buffer-boffset -1))
+		    (buffer-wbuf (reply-ibuf16 %reply-buffer))))
+		(when (member 32 sizes)
+		  `((buffer-loffset (index-ash buffer-boffset -2))
+		    (buffer-lbuf (reply-ibuf32 %reply-buffer))))))
+       (declare (type array-index buffer-boffset))
+       #-clx-overlapping-arrays
+       (declare (type buffer-bytes buffer-bbuf)
+		(array-register buffer-bbuf))
+       #+clx-overlapping-arrays
+       ,@(append
+	   (when (member 8 sizes)
+	     '((declare (type buffer-bytes buffer-bbuf)
+			(array-register buffer-bbuf))))
+	   (when (member 16 sizes)
+	     '((declare (type array-index buffer-woffset))
+	       (declare (type buffer-words buffer-wbuf)
+			(array-register buffer-wbuf))))
+	   (when (member 32 sizes)
+	     '((declare (type array-index buffer-loffset))
+	       (declare (type buffer-longs buffer-lbuf)
+			(array-register buffer-lbuf)))))
+       buffer-boffset
+       #-clx-overlapping-arrays
+       buffer-bbuf
+       #+clx-overlapping-arrays
+       ,@(append
+	   (when (member 8  sizes) '(buffer-bbuf))
+	   (when (member 16 sizes) '(buffer-woffset buffer-wbuf))
+	   (when (member 32 sizes) '(buffer-loffset buffer-lbuf)))
+       #+clx-overlapping-arrays
+       (macrolet ((%buffer-sizes () ',sizes))
+	 ,@body)
+       #-clx-overlapping-arrays
+       ,@body)))
+
+(defun make-buffer (output-size constructor &rest options)
+  (declare (dynamic-extent options))
+  ;; Output-Size is the output-buffer size in bytes.
+  (let ((byte-output (make-array output-size :element-type
+				 #-ecl 'card8 #+ecl 'base-char
+				 :initial-element
+				 #-ecl 0 #+ecl #.(int-char 0))))
+    (apply constructor
+	   :size output-size
+	   :obuf8 byte-output
+	   #+clx-overlapping-arrays
+	   :obuf16
+	   #+clx-overlapping-arrays
+	   (make-array (index-ash output-size -1)
+		       :element-type 'overlap16
+		       :displaced-to byte-output)
+	   #+clx-overlapping-arrays
+	   :obuf32
+	   #+clx-overlapping-arrays
+	   (make-array (index-ash output-size -2)
+		       :element-type 'overlap32
+		       :displaced-to byte-output)
+	   options))) 
+
+(defun make-reply-buffer (size)
+  ;; Size is the buffer size in bytes
+  (let ((byte-input (make-array size :element-type
+				#-ecl 'card8 #+ecl 'base-char
+				:initial-element
+				#-ecl 0 #+ecl #.(int-char 0))))
+    (make-reply-buffer-internal
+      :size size
+      :ibuf8 byte-input
+      #+clx-overlapping-arrays
+      :ibuf16
+      #+clx-overlapping-arrays
+      (make-array (index-ash size -1)
+		  :element-type 'overlap16
+		  :displaced-to byte-input)
+      #+clx-overlapping-arrays
+      :ibuf32
+      #+clx-overlapping-arrays
+      (make-array (index-ash size -2)
+		  :element-type 'overlap32
+		  :displaced-to byte-input))))
+
+(defun buffer-ensure-size (buffer size)
+  (declare (type buffer buffer)
+	   (type array-index size))
+  (when (index> size (buffer-size buffer))
+    (with-buffer (buffer)
+      (buffer-flush buffer)
+      (let* ((new-buffer-size (index-ash 1 (integer-length (index1- size))))
+	     (new-buffer (make-array new-buffer-size :element-type 'card8
+				     :initial-element 0)))
+	(setf (buffer-obuf8 buffer) new-buffer)
+	#+clx-overlapping-arrays
+	(setf (buffer-obuf16 buffer)
+	      (make-array (index-ash new-buffer-size -1)
+			  :element-type 'overlap16
+			  :displaced-to new-buffer)
+	      (buffer-obuf32 buffer)
+	      (make-array (index-ash new-buffer-size -2)
+			  :element-type 'overlap32
+			  :displaced-to new-buffer))))))
+
+(defun buffer-pad-request (buffer pad)
+  (declare (type buffer buffer)
+	   (type array-index pad))
+  (unless (index-zerop pad)
+    (when (index> (index+ (buffer-boffset buffer) pad)
+		  (buffer-size buffer))
+      (buffer-flush buffer))
+    (incf (buffer-boffset buffer) pad)
+    (unless (index-zerop (index-mod (buffer-boffset buffer) 4))
+      (buffer-flush buffer))))
+
+(declaim (inline buffer-new-request-number))
+
+(defun buffer-new-request-number (buffer)
+  (declare (type buffer buffer))
+  (setf (buffer-request-number buffer)
+	(ldb (byte 16 0) (1+ (buffer-request-number buffer)))))
+
+(defun with-buffer-request-function (display gc-force request-function)
+  (declare (type display display)
+	   (type (or null gcontext) gc-force))
+  (declare (type function request-function)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent request-function)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg request-function))
+  (with-buffer (display :inline t)
+    (multiple-value-prog1
+      (progn
+	(when gc-force (force-gcontext-changes-internal gc-force))
+	(without-aborts (funcall request-function display)))
+      (display-invoke-after-function display))))
+
+(defun with-buffer-request-function-nolock (display gc-force request-function)
+  (declare (type display display)
+	   (type (or null gcontext) gc-force))
+  (declare (type function request-function)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent request-function)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg request-function))
+  (multiple-value-prog1
+    (progn
+      (when gc-force (force-gcontext-changes-internal gc-force))
+      (without-aborts (funcall request-function display)))
+    (display-invoke-after-function display)))
+
+(defstruct (pending-command (:copier nil) (:predicate nil))
+  (sequence 0 :type card16)
+  (reply-buffer nil :type (or null reply-buffer))
+  (process nil)
+  (next nil #-explorer :type #-explorer (or null pending-command)))
+
+(defun with-buffer-request-and-reply-function
+       (display multiple-reply request-function reply-function)
+  (declare (type display display)
+	   (type boolean multiple-reply))
+  (declare (type function request-function reply-function)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent request-function reply-function)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg request-function reply-function))
+  (let ((pending-command nil)
+	(reply-buffer nil))
+    (declare (type (or null pending-command) pending-command)
+	     (type (or null reply-buffer) reply-buffer))
+    (unwind-protect
+	(progn 
+	  (with-buffer (display :inline t)
+	    (setq pending-command (start-pending-command display))
+	    (without-aborts (funcall request-function display))
+	    (buffer-force-output display)
+	    (display-invoke-after-function display))
+	  (cond (multiple-reply
+		 (loop
+		   (setq reply-buffer (read-reply display pending-command))
+		   (when (funcall reply-function display reply-buffer) (return nil))
+		   (deallocate-reply-buffer (shiftf reply-buffer nil))))
+		(t
+		 (setq reply-buffer (read-reply display pending-command))
+		 (funcall reply-function display reply-buffer))))
+      (when reply-buffer (deallocate-reply-buffer reply-buffer))
+      (when pending-command (stop-pending-command display pending-command)))))
+
+;;
+;; Buffer stream operations
+;;
+
+(defun buffer-write (vector buffer start end)
+  ;; Write out VECTOR from START to END into BUFFER
+  ;; Internal function, MUST BE CALLED FROM WITHIN WITH-BUFFER
+  (declare (type buffer buffer)
+	   (type array-index start end))
+  (when (buffer-dead buffer)
+    (x-error 'closed-display :display buffer))
+  (wrap-buf-output (buffer)
+    (funcall (buffer-write-function buffer) vector buffer start end))
+  nil)
+
+(defun buffer-flush (buffer)
+  ;; Write the buffer contents to the server stream - doesn't force-output the stream
+  ;; Internal function, MUST BE CALLED FROM WITHIN WITH-BUFFER
+  (declare (type buffer buffer))
+  (unless (buffer-flush-inhibit buffer)
+    (let ((boffset (buffer-boffset buffer)))
+      (declare (type array-index boffset))
+      (when (index-plusp boffset)
+	(buffer-write (buffer-obuf8 buffer) buffer 0 boffset)
+	(setf (buffer-boffset buffer) 0)
+	(setf (buffer-last-request buffer) nil))))
+  nil)
+
+(defmacro with-buffer-flush-inhibited ((buffer) &body body)
+  (let ((buf (if (or (symbolp buffer) (constantp buffer)) buffer '.buffer.)))
+    `(let* (,@(and (not (eq buf buffer)) `((,buf ,buffer)))
+	    (.saved-buffer-flush-inhibit. (buffer-flush-inhibit ,buf)))
+       (unwind-protect
+	   (progn
+	     (setf (buffer-flush-inhibit ,buf) t)
+	     ,@body)
+	 (setf (buffer-flush-inhibit ,buf) .saved-buffer-flush-inhibit.)))))
+
+(defun buffer-force-output (buffer)
+  ;; Output is normally buffered, this forces any buffered output to the server.
+  (declare (type buffer buffer))
+  (when (buffer-dead buffer)
+    (x-error 'closed-display :display buffer))
+  (buffer-flush buffer)
+  (wrap-buf-output (buffer)
+    (without-aborts
+      (funcall (buffer-force-output-function buffer) buffer)))
+  nil)
+
+(defun close-buffer (buffer &key abort)
+  ;; Close the host connection in BUFFER
+  (declare (type buffer buffer))
+  (unless (null (buffer-output-stream buffer))
+    (wrap-buf-output (buffer)
+      (funcall (buffer-close-function buffer) buffer :abort abort))
+    (setf (buffer-dead buffer) t)
+    ;; Zap pointers to the streams, to ensure they're GC'd
+    (setf (buffer-output-stream buffer) nil)
+    (setf (buffer-input-stream buffer) nil)
+    )
+  nil)
+
+(defun buffer-input  (buffer vector start end &optional timeout)
+  ;; Read into VECTOR from the buffer stream
+  ;; Timeout, when non-nil, is in seconds
+  ;; Returns non-nil if EOF encountered
+  ;; Returns :TIMEOUT when timeout exceeded
+  (declare (type buffer buffer)
+	   (type vector vector)
+	   (type array-index start end)
+	   (type (or null number) timeout))
+  (declare (values eof-p))
+  (when (buffer-dead buffer)
+    (x-error 'closed-display :display buffer))
+  (unless (= start end)
+    (let ((result
+	    (wrap-buf-input (buffer)
+	      (funcall (buffer-input-function buffer)
+		       buffer vector start end timeout))))
+      (unless (or (null result) (eq result :timeout))
+	(close-buffer buffer))
+      result)))
+
+(defun buffer-input-wait  (buffer timeout)
+  ;; Timeout, when non-nil, is in seconds
+  ;; Returns non-nil if EOF encountered
+  ;; Returns :TIMEOUT when timeout exceeded
+  (declare (type buffer buffer)
+	   (type (or null number) timeout))
+  (declare (values timeout))
+  (when (buffer-dead buffer)
+    (x-error 'closed-display :display buffer))
+  (let ((result
+	  (wrap-buf-input (buffer)
+	    (funcall (buffer-input-wait-function buffer)
+		     buffer timeout))))
+    (unless (or (null result) (eq result :timeout))
+      (close-buffer buffer))
+    result))
+
+(defun buffer-listen (buffer)
+  ;; Returns T if there is input available for the buffer. This should never
+  ;; block, so it can be called from the scheduler.
+  (declare (type buffer buffer))
+  (declare (values input-available))
+  (or (not (null (buffer-dead buffer)))
+      (wrap-buf-input (buffer)
+	(funcall (buffer-listen-function buffer) buffer))))
+
+;;; Reading sequences of strings
+
+;;; a list of pascal-strings with card8 lengths, no padding in between
+;;; can't use read-sequence-char
+(defun read-sequence-string (buffer-bbuf length nitems result-type
+			     &optional (buffer-boffset 0))
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type array-index length nitems buffer-boffset))
+  length
+  (with-vector (buffer-bbuf buffer-bytes)
+    (let ((result (make-sequence result-type nitems)))
+      (do* ((index 0 (index+ index 1 string-length))
+	    (count 0 (index1+ count))
+	    (string-length 0)
+	    (string ""))
+	   ((index>= count nitems)
+	    result)
+	(declare (type array-index index count string-length)
+		 (type string string))
+	(setq string-length (read-card8 index)
+	      string (make-sequence 'string string-length))
+	(do ((i (index1+ index) (index1+ i))
+	     (j 0 (index1+ j)))
+	    ((index>= j string-length)
+	     (setf (elt result count) string))
+	  (declare (type array-index i j))
+	  (setf (aref string j) (card8->char (read-card8 i))))))))
+
+;;; Reading sequences of chars
+
+(defun read-sequence-char (reply-buffer result-type nitems &optional transform data
+			   (start 0) (index 0))
+  (declare (type reply-buffer reply-buffer)
+	   (type t result-type) ;; CL type
+	   (type array-index nitems start index)
+	   (type (or null sequence) data))
+  (declare (type (or null (function (character) t)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (if transform 
+      (flet ((card8->char->transform (v)
+	       (declare (type card8 v))
+	       (funcall transform (card8->char v))))
+	#+clx-ansi-common-lisp
+	(declare (dynamic-extent #'card8->char->transform))
+	(read-sequence-card8
+	  reply-buffer result-type nitems #'card8->char->transform
+	  data start index))
+    (read-sequence-card8
+      reply-buffer result-type nitems #'card8->char
+      data start index)))
+
+;;; Reading sequences of card8's
+
+(defun read-list-card8 (reply-buffer nitems data start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type list data))
+  (with-buffer-input (reply-buffer :sizes (8) :index index)
+    (do* ((j nitems (index- j 1))
+	  (lst (nthcdr start data)  (cdr lst))
+	  (index 0 (index+ index 1)))
+	 ((index-zerop j))
+      (declare (type array-index j index)
+	       (type cons lst))
+      (setf (car lst) (read-card8 index)))))
+
+(defun read-list-card8-with-transform (reply-buffer nitems data transform start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type list data))
+  (declare (type (function (card8) t) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-buffer-input (reply-buffer :sizes (8) :index index)
+    (do* ((j nitems (index- j 1))
+	  (lst (nthcdr start data) (cdr lst))
+	  (index 0 (index+ index 1)))
+	 ((index-zerop j))
+      (declare (type array-index j index)
+	       (type cons lst))
+      (setf (car lst) (funcall transform (read-card8 index))))))
+
+#-lispm
+(defun read-simple-array-card8 (reply-buffer nitems data start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type #+ecl buffer-bytes #-ecl (simple-array card8 (*)) data))
+  (with-vector (data #+ecl buffer-bytes #-ecl (simple-array card8 (*)))
+    (with-buffer-input (reply-buffer :sizes (8))
+      (buffer-replace data buffer-bbuf start (index+ start nitems) index))))
+
+#-lispm
+(defun read-simple-array-card8-with-transform (reply-buffer nitems data transform start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type #+ecl buffer-bytes #-ecl (simple-array card8 (*)) data))
+  (declare (type (function (card8) card8) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data #+ecl buffer-bytes #-ecl (simple-array card8 (*)))
+    (with-buffer-input (reply-buffer :sizes (8) :index index)
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 1)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j)
+	      #-ecl (the card8 (funcall transform (read-card8 index)))
+	      #+ecl (int-char
+		     (the card8 (funcall transform (read-card8 index)))))))))
+
+(defun read-vector-card8 (reply-buffer nitems data start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type vector data))
+  (with-vector (data #+ecl buffer-bytes #-ecl vector)
+    (with-buffer-input (reply-buffer :sizes (8) :index index)
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 1)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j) #-ecl (read-card8 index)
+	      #+ecl (int-char (read-card8 index)))))))
+
+(defun read-vector-card8-with-transform (reply-buffer nitems data transform start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type vector data))
+  (declare (type (function (card8) t) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data #+ecl buffer-bytes #-ecl vector)
+    (with-buffer-input (reply-buffer :sizes (8) :index index)
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 1)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j)
+	      #-ecl (funcall transform (read-card8 index))
+	      #+ecl (int-char
+		     (the card8 (funcall transform (read-card8 index)))))))))
+
+(defun read-sequence-card8 (reply-buffer result-type nitems &optional transform data
+			    (start 0) (index 0))
+  (declare (type reply-buffer reply-buffer)
+	   (type t result-type) ;; CL type
+	   (type array-index nitems start index)
+	   (type (or null sequence) data))
+  (declare (type (or null (function (card8) t)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (let ((result (or data (make-sequence result-type nitems))))
+    (typecase result
+      (list
+	(if transform 
+	    (read-list-card8-with-transform
+	      reply-buffer nitems result transform start index)
+	  (read-list-card8 reply-buffer nitems result start index)))
+      #-lispm
+      (#+ecl buffer-bytes #-ecl (simple-array card8 (*))
+       (if transform 
+	   (read-simple-array-card8-with-transform
+	     reply-buffer nitems result transform start index)
+	 (read-simple-array-card8 reply-buffer nitems result start index)))
+      (t
+	(if transform 
+	    (read-vector-card8-with-transform
+	      reply-buffer nitems result transform start index)
+	  (read-vector-card8 reply-buffer nitems result start index))))
+    result))
+
+;;; For now, perhaps performance it isn't worth doing better?
+
+(defun read-sequence-int8 (reply-buffer result-type nitems &optional transform data
+			   (start 0) (index 0))
+  (declare (type reply-buffer reply-buffer)
+	   (type t result-type) ;; CL type
+	   (type array-index nitems start index)
+	   (type (or null sequence) data))
+  (declare (type (or null (function (int8) t)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (if transform 
+      (flet ((card8->int8->transform (v)
+	       (declare (type card8 v))
+	       (funcall transform (card8->int8 v))))
+	#+clx-ansi-common-lisp
+	(declare (dynamic-extent #'card8->int8->transform))
+	(read-sequence-card8
+	  reply-buffer result-type nitems #'card8->int8->transform
+	  data start index))
+    (read-sequence-card8
+      reply-buffer result-type nitems #'card8->int8
+      data start index)))
+
+;;; Reading sequences of card16's
+
+(defun read-list-card16 (reply-buffer nitems data start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type list data))
+  (with-buffer-input (reply-buffer :sizes (16) :index index)
+    (do* ((j nitems (index- j 1))
+	  (lst (nthcdr start data) (cdr lst))
+	  (index 0 (index+ index 2)))
+	 ((index-zerop j))
+      (declare (type array-index j index)
+	       (type cons lst))
+      (setf (car lst) (read-card16 index)))))
+
+(defun read-list-card16-with-transform (reply-buffer nitems data transform start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type list data))
+  (declare (type (function (card16) t) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-buffer-input (reply-buffer :sizes (16) :index index)
+    (do* ((j nitems (index- j 1))
+	  (lst (nthcdr start data) (cdr lst))
+	  (index 0 (index+ index 2)))
+	 ((index-zerop j))
+      (declare (type array-index j index)
+	       (type cons lst))
+      (setf (car lst) (funcall transform (read-card16 index))))))
+
+#-lispm
+(defun read-simple-array-card16 (reply-buffer nitems data start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type (simple-array card16 (*)) data))
+  (with-vector (data (simple-array card16 (*)))
+    (with-buffer-input (reply-buffer :sizes (16) :index index)
+      #-clx-overlapping-arrays
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 2)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j) (the card16 (read-card16 index))))
+      #+clx-overlapping-arrays
+      (buffer-replace data buffer-wbuf start (index+ start nitems) (index-floor index 2)))))
+
+#-lispm
+(defun read-simple-array-card16-with-transform (reply-buffer nitems data transform start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type (simple-array card16 (*)) data))
+  (declare (type (function (card16) card16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data (simple-array card16 (*)))
+    (with-buffer-input (reply-buffer :sizes (16) :index index)
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 2)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j) (the card16 (funcall transform (read-card16 index))))))))
+
+(defun read-vector-card16 (reply-buffer nitems data start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type vector data))
+  (with-vector (data vector)
+    (with-buffer-input (reply-buffer :sizes (16) :index index)
+      #-clx-overlapping-arrays
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 2)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j) (read-card16 index)))
+      #+clx-overlapping-arrays
+      (buffer-replace data buffer-wbuf start (index+ start nitems) (index-floor index 2)))))
+
+(defun read-vector-card16-with-transform (reply-buffer nitems data transform start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type vector data))
+  (declare (type (function (card16) t) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data vector)
+    (with-buffer-input (reply-buffer :sizes (16) :index index)
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 2)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j) (funcall transform (read-card16 index)))))))
+
+(defun read-sequence-card16 (reply-buffer result-type nitems &optional transform data
+			     (start 0) (index 0))
+  (declare (type reply-buffer reply-buffer)
+	   (type t result-type) ;; CL type
+	   (type array-index nitems start index)
+	   (type (or null sequence) data))
+  (declare (type (or null (function (card16) t)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (let ((result (or data (make-sequence result-type nitems))))
+    (typecase result
+      (list
+	(if transform 
+	    (read-list-card16-with-transform reply-buffer nitems result transform start index)
+	  (read-list-card16 reply-buffer nitems result start index)))
+      #-lispm
+      ((simple-array card16 (*))
+       (if transform 
+	   (read-simple-array-card16-with-transform
+	     reply-buffer nitems result transform start index)
+	 (read-simple-array-card16 reply-buffer nitems result start index)))
+      (t
+	(if transform 
+	    (read-vector-card16-with-transform
+	      reply-buffer nitems result transform start index)
+	  (read-vector-card16 reply-buffer nitems result start index))))
+    result))
+  
+;;; For now, perhaps performance it isn't worth doing better?
+
+(defun read-sequence-int16 (reply-buffer result-type nitems &optional transform data
+			    (start 0) (index 0))
+  (declare (type reply-buffer reply-buffer)
+	   (type t result-type) ;; CL type
+	   (type array-index nitems start index)
+	   (type (or null sequence) data))
+  (declare (type (or null (function (int16) t)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (if transform 
+      (flet ((card16->int16->transform (v)
+	       (declare (type card16 v))
+	       (funcall transform (card16->int16 v))))
+	#+clx-ansi-common-lisp
+	(declare (dynamic-extent #'card16->int16->transform))
+	(read-sequence-card16
+	  reply-buffer result-type nitems #'card16->int16->transform
+	  data start index))
+    (read-sequence-card16
+      reply-buffer result-type nitems #'card16->int16
+      data start index)))
+
+;;; Reading sequences of card32's
+
+(defun read-list-card32 (reply-buffer nitems data start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type list data))
+  (with-buffer-input (reply-buffer :sizes (32) :index index)
+    (do* ((j nitems (index- j 1))
+	  (lst (nthcdr start data) (cdr lst))
+	  (index 0 (index+ index 4)))
+	 ((index-zerop j))
+      (declare (type array-index j index)
+	       (type cons lst))
+      (setf (car lst) (read-card32 index)))))
+
+(defun read-list-card32-with-transform (reply-buffer nitems data transform start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type list data))
+  (declare (type (function (card32) t) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-buffer-input (reply-buffer :sizes (32) :index index)
+    (do* ((j nitems (index- j 1))
+	  (lst (nthcdr start data) (cdr lst))
+	  (index 0 (index+ index 4)))
+	 ((index-zerop j))
+      (declare (type array-index j index)
+	       (type cons lst))
+      (setf (car lst) (funcall transform (read-card32 index))))))
+
+#-lispm
+(defun read-simple-array-card32 (reply-buffer nitems data start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type (simple-array card32 (*)) data))
+  (with-vector (data (simple-array card32 (*)))
+    (with-buffer-input (reply-buffer :sizes (32) :index index)
+      #-clx-overlapping-arrays
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 4)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j) (the card32 (read-card32 index))))
+      #+clx-overlapping-arrays
+      (buffer-replace data buffer-lbuf start (index+ start nitems) (index-floor index 4)))))
+
+#-lispm
+(defun read-simple-array-card32-with-transform (reply-buffer nitems data transform start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type (simple-array card32 (*)) data))
+  (declare (type (function (card32) card32) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data (simple-array card32 (*)))
+    (with-buffer-input (reply-buffer :sizes (32) :index index)
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 4)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j) (the card32 (funcall transform (read-card32 index))))))))
+
+(defun read-vector-card32 (reply-buffer nitems data start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type vector data))
+  (with-vector (data vector)
+    (with-buffer-input (reply-buffer :sizes (32) :index index)
+      #-clx-overlapping-arrays
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 4)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j) (read-card32 index)))
+      #+clx-overlapping-arrays
+      (buffer-replace data buffer-lbuf start (index+ start nitems) (index-floor index 4)))))
+
+(defun read-vector-card32-with-transform (reply-buffer nitems data transform start index)
+  (declare (type reply-buffer reply-buffer)
+	   (type array-index nitems start index)
+	   (type vector data))
+  (declare (type (function (card32) t) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data vector)
+    (with-buffer-input (reply-buffer :sizes (32) :index index)
+      (do* ((j start (index+ j 1))
+	    (end (index+ start nitems))
+	    (index 0 (index+ index 4)))
+	   ((index>= j end))
+	(declare (type array-index j end index))
+	(setf (aref data j) (funcall transform (read-card32 index)))))))
+
+(defun read-sequence-card32 (reply-buffer result-type nitems &optional transform data
+			     (start 0) (index 0))
+  (declare (type reply-buffer reply-buffer)
+	   (type t result-type) ;; CL type
+	   (type array-index nitems start index)
+	   (type (or null sequence) data))
+  (declare (type (or null (function (card32) t)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (let ((result (or data (make-sequence result-type nitems))))
+    (typecase result
+      (list
+	(if transform 
+	    (read-list-card32-with-transform reply-buffer nitems result transform start index)
+	  (read-list-card32 reply-buffer nitems result start index)))
+      #-lispm
+      ((simple-array card32 (*))
+       (if transform 
+	   (read-simple-array-card32-with-transform
+	     reply-buffer nitems result transform start index)
+	 (read-simple-array-card32 reply-buffer nitems result start index)))
+      (t
+	(if transform 
+	    (read-vector-card32-with-transform
+	      reply-buffer nitems result transform start index)
+	  (read-vector-card32 reply-buffer nitems result start index))))
+    result))
+
+;;; For now, perhaps performance it isn't worth doing better?
+
+(defun read-sequence-int32 (reply-buffer result-type nitems &optional transform data
+			    (start 0) (index 0))
+  (declare (type reply-buffer reply-buffer)
+	   (type t result-type) ;; CL type
+	   (type array-index nitems start index)
+	   (type (or null sequence) data))
+  (declare (type (or null (function (int32) t)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (if transform 
+      (flet ((card32->int32->transform (v)
+	       (declare (type card32 v))
+	       (funcall transform (card32->int32 v))))
+	#+clx-ansi-common-lisp
+	(declare (dynamic-extent #'card32->int32->transform))
+	(read-sequence-card32
+	  reply-buffer result-type nitems #'card32->int32->transform
+	  data start index))
+    (read-sequence-card32
+      reply-buffer result-type nitems #'card32->int32
+      data start index)))
+
+;;; Writing sequences of chars
+
+(defun write-sequence-char
+       (buffer boffset data &optional (start 0) (end (length data)) transform)
+  (declare (type buffer buffer)
+	   (type sequence data)
+	   (type array-index boffset start end))
+  (declare (type (or null (function (t) character)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (if transform 
+      (flet ((transform->char->card8 (x)
+	       (char->card8 (the character (funcall transform x)))))
+	#+clx-ansi-common-lisp
+	(declare (dynamic-extent #'transform->char->card8))
+	(write-sequence-card8
+	  buffer boffset data start end #'transform->char->card8))
+    (write-sequence-card8 buffer boffset data start end #'char->card8)))
+
+;;; Writing sequences of card8's
+
+(defun write-list-card8 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (writing-buffer-chunks card8
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    (dotimes (j chunk)
+      (declare (type array-index j))
+      #-ti (write-card8 j (pop lst))		;TI Compiler bug
+      #+ti (setf (aref buffer-bbuf (index+ buffer-boffset j)) (pop lst))
+      ))
+  nil)
+
+(defun write-list-card8-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) card8) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (writing-buffer-chunks card8
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    (dotimes (j chunk)
+      (declare (type array-index j))
+      (write-card8 j (funcall transform (pop lst)))))
+  nil)
+
+;;; Should really write directly from data, instead of into the buffer first
+#-lispm
+(defun write-simple-array-card8 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type #+ecl buffer-bytes #-ecl (simple-array card8 (*)) data)
+	   (type array-index boffset start end))
+  (with-vector (data #+ecl buffer-bytes #-ecl (simple-array card8 (*)))
+    (writing-buffer-chunks card8
+			   ((index start (index+ index chunk)))
+			   ((type array-index index))
+      (buffer-replace buffer-bbuf data
+		      buffer-boffset
+		      (index+ buffer-boffset chunk)
+		      index)))
+  nil)
+
+#-lispm
+(defun write-simple-array-card8-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type #+ecl buffer-bytes #-ecl (simple-array card8 (*)) data)
+	   (type array-index boffset start end))
+  (declare (type (function (card8) card8) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data #+ecl buffer-bytes #-ecl (simple-array card8 (*)))
+    (writing-buffer-chunks card8
+			   ((index start))
+			   ((type array-index index))
+      (dotimes (j chunk)
+	(declare (type array-index j))
+	(write-card8 j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-vector-card8 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (with-vector (data #+ecl buffer-bytes #-ecl vector)
+    (writing-buffer-chunks card8
+			   ((index start))
+			   ((type array-index index))
+      (dotimes (j chunk)
+	(declare (type array-index j))
+	(write-card8 j (aref data index))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-vector-card8-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) card8) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data #+ecl buffer-bytes #-ecl vector)
+    (writing-buffer-chunks card8
+			   ((index start))
+			   ((type array-index index))
+      (dotimes (j chunk)
+	(declare (type array-index j))
+	(write-card8 j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-sequence-card8
+       (buffer boffset data &optional (start 0) (end (length data)) transform)
+  (declare (type buffer buffer)
+	   (type sequence data)
+	   (type array-index boffset start end))
+  (declare (type (or null (function (t) card8)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (typecase data
+    (list
+      (if transform
+	  (write-list-card8-with-transform buffer boffset data start end transform)
+	  (write-list-card8 buffer boffset data start end)))
+    #-lispm
+    (#+ecl buffer-bytes #-ecl (simple-array card8 (*))
+     (if transform
+	 (write-simple-array-card8-with-transform buffer boffset data start end transform)
+	 (write-simple-array-card8 buffer boffset data start end)))
+    (t
+      (if transform
+	  (write-vector-card8-with-transform buffer boffset data start end transform)
+	  (write-vector-card8 buffer boffset data start end)))))
+
+;;; For now, perhaps performance it isn't worth doing better?
+
+(defun write-sequence-int8
+       (buffer boffset data &optional (start 0) (end (length data)) transform)
+  (declare (type buffer buffer)
+	   (type sequence data)
+	   (type array-index boffset start end))
+  (declare (type (or null (function (t) int8)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (if transform 
+      (flet ((transform->int8->card8 (x)
+	       (int8->card8 (the int8 (funcall transform x)))))
+	#+clx-ansi-common-lisp
+	(declare (dynamic-extent #'transform->int8->card8))
+	(write-sequence-card8
+	  buffer boffset data start end #'transform->int8->card8))
+      (write-sequence-card8 buffer boffset data start end #'int8->card8)))
+
+;;; Writing sequences of card16's
+
+(defun write-list-card16 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (writing-buffer-chunks card16
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    ;; Depends upon the chunks being an even multiple of card16's big
+    (do ((j 0 (index+ j 2)))
+	((index>= j chunk))
+      (declare (type array-index j))
+      (write-card16 j (pop lst))))
+  nil)
+
+(defun write-list-card16-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) card16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (writing-buffer-chunks card16
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    ;; Depends upon the chunks being an even multiple of card16's big
+    (do ((j 0 (index+ j 2)))
+	((index>= j chunk))
+      (declare (type array-index j))
+      (write-card16 j (funcall transform (pop lst)))))
+  nil)
+
+#-lispm
+(defun write-simple-array-card16 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type (simple-array card16 (*)) data)
+	   (type array-index boffset start end))
+  (with-vector (data (simple-array card16 (*)))
+    (writing-buffer-chunks card16
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of card16's big
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-card16 j (aref data index))
+	(setq index (index+ index 1)))
+      ;; overlapping case
+      (let ((length (floor chunk 2)))
+	(buffer-replace buffer-wbuf data
+			buffer-woffset
+			(index+ buffer-woffset length)
+			index)
+	(setq index (index+ index length)))))
+  nil)
+
+#-lispm
+(defun write-simple-array-card16-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type (simple-array card16 (*)) data)
+	   (type array-index boffset start end))
+  (declare (type (function (card16) card16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data (simple-array card16 (*)))
+    (writing-buffer-chunks card16
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of card16's big
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-card16 j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-vector-card16 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (with-vector (data vector)
+    (writing-buffer-chunks card16
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of card16's big
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-card16 j (aref data index))
+	(setq index (index+ index 1)))
+      ;; overlapping case
+      (let ((length (floor chunk 2)))
+	(buffer-replace buffer-wbuf data
+			buffer-woffset
+			(index+ buffer-woffset length)
+			index)
+	(setq index (index+ index length)))))
+  nil)
+
+(defun write-vector-card16-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) card16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data vector)
+    (writing-buffer-chunks card16
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of card16's big
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-card16 j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-sequence-card16
+       (buffer boffset data &optional (start 0) (end (length data)) transform)
+  (declare (type buffer buffer)
+	   (type sequence data)
+	   (type array-index boffset start end))
+  (declare (type (or null (function (t) card16)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (typecase data
+    (list
+      (if transform
+	  (write-list-card16-with-transform buffer boffset data start end transform)
+	  (write-list-card16 buffer boffset data start end)))
+    #-lispm
+    ((simple-array card16 (*))
+     (if transform
+	 (write-simple-array-card16-with-transform buffer boffset data start end transform)
+	 (write-simple-array-card16 buffer boffset data start end)))
+    (t
+      (if transform
+	  (write-vector-card16-with-transform buffer boffset data start end transform)
+	  (write-vector-card16 buffer boffset data start end)))))
+
+;;; Writing sequences of int16's
+
+(defun write-list-int16 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (writing-buffer-chunks int16
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    ;; Depends upon the chunks being an even multiple of int16's big
+    (do ((j 0 (index+ j 2)))
+	((index>= j chunk))
+      (declare (type array-index j))
+      (write-int16 j (pop lst))))
+  nil)
+
+(defun write-list-int16-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) int16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (writing-buffer-chunks int16
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    ;; Depends upon the chunks being an even multiple of int16's big
+    (do ((j 0 (index+ j 2)))
+	((index>= j chunk))
+      (declare (type array-index j))
+      (write-int16 j (funcall transform (pop lst)))))
+  nil)
+
+#-lispm
+(defun write-simple-array-int16 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type (simple-array int16 (*)) data)
+	   (type array-index boffset start end))
+  (with-vector (data (simple-array int16 (*)))
+    (writing-buffer-chunks int16
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of int16's big
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-int16 j (aref data index))
+	(setq index (index+ index 1)))
+      ;; overlapping case
+      (let ((length (floor chunk 2)))
+	(buffer-replace buffer-wbuf data
+			buffer-woffset
+			(index+ buffer-woffset length)
+			index)
+	(setq index (index+ index length)))))
+  nil)
+
+#-lispm
+(defun write-simple-array-int16-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type (simple-array int16 (*)) data)
+	   (type array-index boffset start end))
+  (declare (type (function (int16) int16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data (simple-array int16 (*)))
+    (writing-buffer-chunks int16
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of int16's big
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-int16 j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-vector-int16 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (with-vector (data vector)
+    (writing-buffer-chunks int16
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of int16's big
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-int16 j (aref data index))
+	(setq index (index+ index 1)))
+      ;; overlapping case
+      (let ((length (floor chunk 2)))
+	(buffer-replace buffer-wbuf data
+			buffer-woffset
+			(index+ buffer-woffset length)
+			index)
+	(setq index (index+ index length)))))
+  nil)
+
+(defun write-vector-int16-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) int16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data vector)
+    (writing-buffer-chunks int16
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of int16's big
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-int16 j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-sequence-int16
+       (buffer boffset data &optional (start 0) (end (length data)) transform)
+  (declare (type buffer buffer)
+	   (type sequence data)
+	   (type array-index boffset start end))
+  (declare (type (or null (function (t) int16)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (typecase data
+    (list
+      (if transform
+	  (write-list-int16-with-transform buffer boffset data start end transform)
+	  (write-list-int16 buffer boffset data start end)))
+    #-lispm
+    ((simple-array int16 (*))
+     (if transform
+	 (write-simple-array-int16-with-transform buffer boffset data start end transform)
+	 (write-simple-array-int16 buffer boffset data start end)))
+    (t
+      (if transform
+	  (write-vector-int16-with-transform buffer boffset data start end transform)
+	  (write-vector-int16 buffer boffset data start end)))))
+
+;;; Writing sequences of card32's
+
+(defun write-list-card32 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (writing-buffer-chunks card32
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    ;; Depends upon the chunks being an even multiple of card32's big
+    (do ((j 0 (index+ j 4)))
+	((index>= j chunk))
+      (declare (type array-index j))
+      (write-card32 j (pop lst))))
+  nil)
+
+(defun write-list-card32-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) card32) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (writing-buffer-chunks card32
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    ;; Depends upon the chunks being an even multiple of card32's big
+    (do ((j 0 (index+ j 4)))
+	((index>= j chunk))
+      (declare (type array-index j))
+      (write-card32 j (funcall transform (pop lst)))))
+  nil)
+
+#-lispm
+(defun write-simple-array-card32 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type (simple-array card32 (*)) data)
+	   (type array-index boffset start end))
+  (with-vector (data (simple-array card32 (*)))
+    (writing-buffer-chunks card32
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of card32's big
+      (do ((j 0 (index+ j 4)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-card32 j (aref data index))
+	(setq index (index+ index 1)))
+      ;; overlapping case
+      (let ((length (floor chunk 4)))
+	(buffer-replace buffer-lbuf data
+			buffer-loffset
+			(index+ buffer-loffset length)
+			index)
+	(setq index (index+ index length)))))
+  nil)
+
+#-lispm
+(defun write-simple-array-card32-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type (simple-array card32 (*)) data)
+	   (type array-index boffset start end))
+  (declare (type (function (card32) card32) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data (simple-array card32 (*)))
+    (writing-buffer-chunks card32
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of card32's big
+      (do ((j 0 (index+ j 4)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-card32 j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-vector-card32 (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (with-vector (data vector)
+    (writing-buffer-chunks card32
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of card32's big
+      (do ((j 0 (index+ j 4)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-card32 j (aref data index))
+	(setq index (index+ index 1)))
+      ;; overlapping case
+      (let ((length (floor chunk 4)))
+	(buffer-replace buffer-lbuf data
+			buffer-loffset
+			(index+ buffer-loffset length)
+			index)
+	(setq index (index+ index length)))))
+  nil)
+
+(defun write-vector-card32-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) card32) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data vector)
+    (writing-buffer-chunks card32
+			   ((index start))
+			   ((type array-index index))
+      ;; Depends upon the chunks being an even multiple of card32's big
+      (do ((j 0 (index+ j 4)))
+	  ((index>= j chunk))
+	(declare (type array-index j))
+	(write-card32 j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-sequence-card32
+       (buffer boffset data &optional (start 0) (end (length data)) transform)
+  (declare (type buffer buffer)
+	   (type sequence data)
+	   (type array-index boffset start end))
+  (declare (type (or null (function (t) card32)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (typecase data
+    (list
+      (if transform
+	  (write-list-card32-with-transform buffer boffset data start end transform)
+	  (write-list-card32 buffer boffset data start end)))
+    #-lispm
+    ((simple-array card32 (*))
+     (if transform
+	 (write-simple-array-card32-with-transform buffer boffset data start end transform)
+	 (write-simple-array-card32 buffer boffset data start end)))
+    (t
+      (if transform
+	  (write-vector-card32-with-transform buffer boffset data start end transform)
+	  (write-vector-card32 buffer boffset data start end)))))
+
+;;; For now, perhaps performance it isn't worth doing better?
+
+(defun write-sequence-int32
+       (buffer boffset data &optional (start 0) (end (length data)) transform)
+  (declare (type buffer buffer)
+	   (type sequence data)
+	   (type array-index boffset start end))
+  (declare (type (or null (function (t) int32)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (if transform 
+      (flet ((transform->int32->card32 (x)
+	       (int32->card32 (the int32 (funcall transform x)))))
+	#+clx-ansi-common-lisp
+	(declare (dynamic-extent #'transform->int32->card32))
+	(write-sequence-card32
+	  buffer boffset data start end #'transform->int32->card32))
+    (write-sequence-card32 buffer boffset data start end #'int32->card32)))
+
+(defun read-bitvector256 (buffer-bbuf boffset data)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type array-index boffset)
+	   (type (or null (simple-bit-vector 256)) data))
+  (let ((result (or data (make-array 256 :element-type 'bit :initial-element 0))))
+    (declare (type (simple-bit-vector 256) result)
+	     (array-register result))
+    (do ((i (index+ boffset 1) (index+ i 1)) ;; Skip first byte
+	 (j 8 (index+ j 8)))
+	((index>= j 256))
+      (declare (type array-index i j))
+      (do ((byte (aref-card8 buffer-bbuf i) (index-ash byte -1))
+	   (k j (index+ k 1)))
+	  ((zerop byte)
+	   (when data ;; Clear uninitialized bits in data
+	     (do ((end (index+ j 8)))
+		 ((index= k end))
+	       (declare (type array-index end))
+	       (setf (aref result k) 0)
+	       (index-incf k))))
+	(declare (type array-index k)
+		 (type card8 byte))
+	(setf (aref result k) (the bit (logand byte 1)))))
+    result))
+
+(defun write-bitvector256 (buffer boffset map)
+  (declare (type buffer buffer)
+	   (type array-index boffset)
+	   (type (simple-array bit (*)) map))
+  (with-buffer-output (buffer :index boffset :sizes 8)
+    (do* ((i (index+ buffer-boffset 1) (index+ i 1))	; Skip first byte
+	  (j 8 (index+ j 8)))		
+	 ((index>= j 256))
+      (declare (type array-index i j))
+      (do ((byte 0)
+	   (bit (index+ j 7) (index- bit 1)))
+	  ((index< bit j)
+	   (aset-card8 byte buffer-bbuf i))
+	(declare (type array-index bit)
+		 (type card8 byte))
+	(setq byte (the card8 (logior (the card8 (ash byte 1)) (aref map bit))))))))
+
+;;; Writing sequences of char2b's
+
+(defun write-list-char2b (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (writing-buffer-chunks card16
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    (do ((j 0 (index+ j 2)))
+	((index>= j (1- chunk)) (setf chunk j))
+      (declare (type array-index j))
+      (write-char2b j (pop lst))))
+  nil)
+
+(defun write-list-char2b-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type list data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) card16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (writing-buffer-chunks card16
+			 ((lst (nthcdr start data)))
+			 ((type list lst))
+    (do ((j 0 (index+ j 2)))
+	((index>= j (1- chunk)) (setf chunk j))
+      (declare (type array-index j))
+      (write-char2b j (funcall transform (pop lst)))))
+  nil)
+
+#-lispm
+(defun write-simple-array-char2b (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type (simple-array card16 (*)) data)
+	   (type array-index boffset start end))
+  (with-vector (data (simple-array card16 (*)))
+    (writing-buffer-chunks card16
+			   ((index start))
+			   ((type array-index index))
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j (1- chunk)) (setf chunk j))
+	(declare (type array-index j))
+	(write-char2b j (aref data index))
+	(setq index (index+ index 1)))))
+  nil)
+
+#-lispm
+(defun write-simple-array-char2b-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type (simple-array card16 (*)) data)
+	   (type array-index boffset start end))
+  (declare (type (function (card16) card16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data (simple-array card16 (*)))
+    (writing-buffer-chunks card16
+			   ((index start))
+			   ((type array-index index))
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j (1- chunk)) (setf chunk j))
+	(declare (type array-index j))
+	(write-char2b j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-vector-char2b (buffer boffset data start end)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (with-vector (data vector)
+    (writing-buffer-chunks card16
+			   ((index start))
+			   ((type array-index index))
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j (1- chunk)) (setf chunk j))
+	(declare (type array-index j))
+	(write-char2b j (aref data index))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-vector-char2b-with-transform (buffer boffset data start end transform)
+  (declare (type buffer buffer)
+	   (type vector data)
+	   (type array-index boffset start end))
+  (declare (type (function (t) card16) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (with-vector (data vector)
+    (writing-buffer-chunks card16
+			   ((index start))
+			   ((type array-index index))
+      (do ((j 0 (index+ j 2)))
+	  ((index>= j (1- chunk)) (setf chunk j))
+	(declare (type array-index j))
+	(write-char2b j (funcall transform (aref data index)))
+	(setq index (index+ index 1)))))
+  nil)
+
+(defun write-sequence-char2b
+       (buffer boffset data &optional (start 0) (end (length data)) transform)
+  (declare (type buffer buffer)
+	   (type sequence data)
+	   (type array-index boffset start end))
+  (declare (type (or null (function (t) card16)) transform)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent transform)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg transform))
+  (typecase data
+    (list
+      (if transform
+	  (write-list-char2b-with-transform buffer boffset data start end transform)
+	  (write-list-char2b buffer boffset data start end)))
+    #-lispm
+    ((simple-array card16 (*))
+     (if transform
+	 (write-simple-array-char2b-with-transform buffer boffset data start end transform)
+	 (write-simple-array-char2b buffer boffset data start end)))
+    (t
+      (if transform
+	  (write-vector-char2b-with-transform buffer boffset data start end transform)
+	  (write-vector-char2b buffer boffset data start end)))))
+
diff --git a/src/clx/bufmac.lsp b/src/clx/bufmac.lsp
new file mode 100644
index 000000000..00df94462
--- /dev/null
+++ b/src/clx/bufmac.lsp
@@ -0,0 +1,188 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;; This file contains macro definitions for the BUFFER object for Common-Lisp
+;;; X windows version 11
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+;;; The read- macros are in buffer.lisp, because event-case depends on (most of) them.
+
+(defmacro write-card8 (byte-index item)
+  `(aset-card8 (the card8 ,item) buffer-bbuf (index+ buffer-boffset ,byte-index)))
+
+(defmacro write-int8 (byte-index item)
+  `(aset-int8 (the int8 ,item) buffer-bbuf (index+ buffer-boffset ,byte-index)))
+
+(defmacro write-card16 (byte-index item)
+  #+clx-overlapping-arrays
+  `(aset-card16 (the card16 ,item) buffer-wbuf
+		(index+ buffer-woffset (index-ash ,byte-index -1)))
+  #-clx-overlapping-arrays
+  `(aset-card16 (the card16 ,item) buffer-bbuf
+		(index+ buffer-boffset ,byte-index)))
+
+(defmacro write-int16 (byte-index item)
+  #+clx-overlapping-arrays
+  `(aset-int16 (the int16 ,item) buffer-wbuf
+	       (index+ buffer-woffset (index-ash ,byte-index -1)))
+  #-clx-overlapping-arrays
+  `(aset-int16 (the int16 ,item) buffer-bbuf
+	       (index+ buffer-boffset ,byte-index)))
+
+(defmacro write-card32 (byte-index item)
+  #+clx-overlapping-arrays
+  `(aset-card32 (the card32 ,item) buffer-lbuf
+		(index+ buffer-loffset (index-ash ,byte-index -2)))
+  #-clx-overlapping-arrays
+  `(aset-card32 (the card32 ,item) buffer-bbuf
+		(index+ buffer-boffset ,byte-index)))
+
+(defmacro write-int32 (byte-index item)
+  #+clx-overlapping-arrays
+  `(aset-int32 (the int32 ,item) buffer-lbuf
+	       (index+ buffer-loffset (index-ash ,byte-index -2)))
+  #-clx-overlapping-arrays
+  `(aset-int32 (the int32 ,item) buffer-bbuf
+	       (index+ buffer-boffset ,byte-index)))
+
+(defmacro write-card29 (byte-index item)
+  #+clx-overlapping-arrays
+  `(aset-card29 (the card29 ,item) buffer-lbuf
+		(index+ buffer-loffset (index-ash ,byte-index -2)))
+  #-clx-overlapping-arrays
+  `(aset-card29 (the card29 ,item) buffer-bbuf
+		(index+ buffer-boffset ,byte-index)))
+
+;; This is used for 2-byte characters, which may not be aligned on 2-byte boundaries
+;; and always are written high-order byte first.
+(defmacro write-char2b (byte-index item)
+  ;; It is impossible to do an overlapping write, so only nonoverlapping here.
+  `(let ((%item ,item)
+	 (%byte-index (index+ buffer-boffset ,byte-index)))
+     (declare (type card16 %item)
+	      (type array-index %byte-index))
+     (aset-card8 (the card8 (ldb (byte 8 8) %item)) buffer-bbuf %byte-index)
+     (aset-card8 (the card8 (ldb (byte 8 0) %item)) buffer-bbuf (index+ %byte-index 1))))
+
+(defmacro set-buffer-offset (value &environment env)
+  env
+  `(let ((.boffset. ,value))
+     (declare (type array-index .boffset.))
+     (setq buffer-boffset .boffset.)
+     #+clx-overlapping-arrays
+     ,@(when (member 16 (macroexpand '(%buffer-sizes) env))
+	 `((setq buffer-woffset (index-ash .boffset. -1))))
+     #+clx-overlapping-arrays
+     ,@(when (member 32 (macroexpand '(%buffer-sizes) env))
+	 `((setq buffer-loffset (index-ash .boffset. -2))))
+     #+clx-overlapping-arrays
+     .boffset.))
+
+(defmacro advance-buffer-offset (value)
+  `(set-buffer-offset (index+ buffer-boffset ,value)))
+
+(defmacro with-buffer-output ((buffer &key (sizes '(8 16 32)) length index) &body body)
+  (unless (listp sizes) (setq sizes (list sizes)))
+  `(let ((%buffer ,buffer))
+     (declare (type display %buffer))
+     ,(declare-bufmac)
+     ,(when length
+	`(when (index>= (index+ (buffer-boffset %buffer) ,length) (buffer-size %buffer))
+	   (buffer-flush %buffer)))
+     (let* ((buffer-boffset (the array-index ,(or index `(buffer-boffset %buffer))))
+	    #-clx-overlapping-arrays
+	    (buffer-bbuf (buffer-obuf8 %buffer))
+	    #+clx-overlapping-arrays
+	    ,@(append
+		(when (member 8 sizes)
+		  `((buffer-bbuf (buffer-obuf8 %buffer))))
+		(when (or (member 16 sizes) (member 160 sizes))
+		  `((buffer-woffset (index-ash buffer-boffset -1))
+		    (buffer-wbuf (buffer-obuf16 %buffer))))
+		(when (member 32 sizes)
+		  `((buffer-loffset (index-ash buffer-boffset -2))
+		    (buffer-lbuf (buffer-obuf32 %buffer))))))
+       (declare (type array-index buffer-boffset))
+       #-clx-overlapping-arrays
+       (declare (type buffer-bytes buffer-bbuf)
+		(array-register buffer-bbuf))
+       #+clx-overlapping-arrays
+       ,@(append
+	   (when (member 8  sizes)
+	     '((declare (type buffer-bytes buffer-bbuf)
+			(array-register buffer-bbuf))))
+	   (when (member 16 sizes)
+	     '((declare (type array-index buffer-woffset))
+	       (declare (type buffer-words buffer-wbuf)
+			(array-register buffer-wbuf))))
+	   (when (member 32 sizes)
+	     '((declare (type array-index buffer-loffset))
+	       (declare (type buffer-longs buffer-lbuf)
+			(array-register buffer-lbuf)))))
+       buffer-boffset
+       #-clx-overlapping-arrays
+       buffer-bbuf
+       #+clx-overlapping-arrays
+       ,@(append
+	   (when (member 8  sizes) '(buffer-bbuf))
+	   (when (member 16 sizes) '(buffer-woffset buffer-wbuf))
+	   (when (member 32 sizes) '(buffer-loffset buffer-lbuf)))
+       #+clx-overlapping-arrays
+       (macrolet ((%buffer-sizes () ',sizes))
+	 ,@body)
+       #-clx-overlapping-arrays
+       ,@body)))
+
+;;; This macro is just used internally in buffer
+
+(defmacro writing-buffer-chunks (type args decls &body body)
+  (when (> (length body) 2)
+    (error "writing-buffer-chunks called with too many forms"))
+  (let* ((size (* 8 (index-increment type)))
+	 (form #-clx-overlapping-arrays
+	       (first body)
+	       #+clx-overlapping-arrays		; XXX type dependencies
+	       (or (second body)
+		   (first body))))
+    `(with-buffer-output (buffer :index boffset :sizes ,(reverse (adjoin size '(8))))
+       ;; Loop filling the buffer
+       (do* (,@args
+	     ;; Number of bytes needed to output
+	     (len ,(if (= size 8)
+		       `(index- end start)
+		       `(index-ash (index- end start) ,(truncate size 16)))
+		  (index- len chunk))
+	     ;; Number of bytes available in buffer
+	     (chunk (index-min len (index- (buffer-size buffer) buffer-boffset))
+		    (index-min len (index- (buffer-size buffer) buffer-boffset))))
+	    ((not (index-plusp len)))
+	 (declare ,@decls
+		  (type array-index len chunk))
+	 ,form
+	 (index-incf buffer-boffset chunk)
+	 ;; Flush the buffer
+	 (when (and (index-plusp len) (index>= buffer-boffset (buffer-size buffer)))
+	   (setf (buffer-boffset buffer) buffer-boffset)
+	   (buffer-flush buffer)
+	   (setq buffer-boffset (buffer-boffset buffer))
+	   #+clx-overlapping-arrays
+	   ,(case size
+	      (16 '(setq buffer-woffset (index-ash buffer-boffset -1)))
+	      (32 '(setq buffer-loffset (index-ash buffer-boffset -2))))))
+       (setf (buffer-boffset buffer) (lround buffer-boffset))))) 
diff --git a/src/clx/clx.lsp b/src/clx/clx.lsp
new file mode 100644
index 000000000..eab2b1ba8
--- /dev/null
+++ b/src/clx/clx.lsp
@@ -0,0 +1,938 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;;(c) Copyright Enhancements by Giuseppe Attardi, 1994.
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+;; Primary Interface Author:
+;;	Robert W. Scheifler
+;;	MIT Laboratory for Computer Science
+;;	545 Technology Square, Room 418
+;;	Cambridge, MA 02139
+;;	rws@zermatt.lcs.mit.edu
+
+;; Design Contributors:
+;;	Dan Cerys, Texas Instruments
+;;	Scott Fahlman, CMU
+;;      Charles Hornig, Symbolics
+;;      John Irwin, Franz
+;;	Kerry Kimbrough, Texas Instruments
+;;	Chris Lindblad, MIT
+;;	Rob MacLachlan, CMU
+;;	Mike McMahon, Symbolics
+;;	David Moon, Symbolics
+;;	LaMott Oren, Texas Instruments
+;;	Daniel Weinreb, Symbolics
+;;	John Wroclawski, MIT
+;;	Richard Zippel, Symbolics
+
+;; Primary Implementation Author:
+;;	LaMott Oren, Texas Instruments
+
+;; Implementation Contributors:
+;;      Charles Hornig, Symbolics
+;;      John Irwin, Franz
+;;	Chris Lindblad, MIT
+;;	Robert Scheifler, MIT
+
+;;;
+;;; Change history:
+;;;
+;;;  Date	Author		Description
+;;; -------------------------------------------------------------------------------------
+;;; 04/07/87	R.Scheifler	Created code stubs
+;;; 04/08/87	L.Oren		Started Implementation
+;;; 05/11/87	L.Oren		Included draft 3 revisions
+;;; 07/07/87	L.Oren		Untested alpha release to MIT
+;;; 07/17/87	L.Oren		Alpha release
+;;; 08/**/87	C.Lindblad	Rewrite of buffer code
+;;; 08/**/87	et al		Various random bug fixes
+;;; 08/**/87	R.Scheifler	General syntactic and portability cleanups
+;;; 08/**/87	R.Scheifler	Rewrite of gcontext caching and shadowing
+;;; 09/02/87	L.Oren		Change events from resource-ids to objects
+;;; 12/24/87	R.Budzianowski	KCL support
+;;; 12/**/87	J.Irwin		ExCL 2.0 support
+;;; 01/20/88	L.Oren		Add server extension mechanisms
+;;; 01/20/88	L.Oren		Only force output when blocking on input
+;;; 01/20/88	L.Oren		Uniform support for :event-window on events
+;;; 01/28/88	L.Oren		Add window manager property functions
+;;; 01/28/88	L.Oren		Add character translation facility
+;;; 02/**/87	J.Irwin		Allegro 2.2 support
+
+;;; This is considered a somewhat changeable interface.  Discussion of better
+;;; integration with CLOS, support for user-specified subclassess of basic
+;;; objects, and the additional functionality to match the C Xlib is still in
+;;; progress.  Bug reports should be addressed to bug-clx@expo.lcs.mit.edu.
+
+;; Note: all of the following is in the package XLIB.
+
+(in-package :xlib)
+
+(pushnew :clx *features*)
+(pushnew :xlib *features*)
+
+(defparameter *version* "MIT R5.0")
+(pushnew :clx-mit-r4 *features*)
+(pushnew :clx-mit-r5 *features*)
+
+(defparameter *protocol-major-version* 11.)
+(defparameter *protocol-minor-version* 0)
+
+(defparameter *x-tcp-port* 6000) ;; add display number
+
+; Note: various perversions of the CL type system are used below.
+; Examples: (list elt-type) (sequence elt-type)
+
+;; Note: if you have read the Version 11 protocol document or C Xlib manual, most of
+;; the relationships should be fairly obvious.  We have no intention of writing yet
+;; another moby document for this interface.
+
+;; Types employed: display, window, pixmap, cursor, font, gcontext, colormap, color.
+;; These types are defined solely by a functional interface; we do not specify
+;; whether they are implemented as structures or flavors or ...  Although functions
+;; below are written using DEFUN, this is not an implementation requirement (although
+;; it is a requirement that they be functions as opposed to macros or special forms).
+;; It is unclear whether with-slots in the Common Lisp Object System must work on
+;; them.
+
+;; Windows, pixmaps, cursors, fonts, gcontexts, and colormaps are all represented as
+;; compound objects, rather than as integer resource-ids.  This allows applications
+;; to deal with multiple displays without having an explicit display argument in the
+;; most common functions.  Every function uses the display object indicated by the
+;; first argument that is or contains a display; it is an error if arguments contain
+;; different displays, and predictable results are not guaranteed.
+
+;; Each of window, pixmap, cursor, font, gcontext, and colormap have the following
+;; five functions:
+
+;(defun make-<mumble> (display resource-id)
+;  ;; This function should almost never be called by applications, except in handling
+;  ;; events.  To minimize consing in some implementations, this may use a cache in
+;  ;; the display.  Make-gcontext creates with :cache-p nil.  Make-font creates with
+;  ;; cache-p true.
+;  (declare (type display display)
+;	   (type integer resource-id)
+;	   (values <mumble>)))
+
+;(defun <mumble>-display (<mumble>)
+;  (declare (type <mumble> <mumble>)
+;	   (values display)))
+
+;(defun <mumble>-id (<mumble>)
+;  (declare (type <mumble> <mumble>)
+;	   (values integer)))
+
+;(defun <mumble>-equal (<mumble>-1 <mumble>-2)
+;  (declare (type <mumble> <mumble>-1 <mumble>-2)))
+
+;(defun <mumble>-p (<mumble>-1 <mumble>-2)
+;  (declare (type <mumble> <mumble>-1 <mumble>-2)
+;	   (values boolean)))
+
+(deftype boolean () '(or null (not null)))
+
+#|
+#+ecl
+
+(deftype card32 () '(integer 0 4294967295)) ; 2^32 - 1
+
+(defun card29p (x)
+  (declare (fixnum x))
+  (and (>= x 0) (<= x 536870911)))
+(deftype card29 () '(and fixnum (satisfies card29p)))
+
+(deftype int32 () 'fixnum)
+
+(defun card16p (x)
+  (declare (fixnum x))
+  (and (>= x 0) (<= x 65535)))
+(deftype card16 () '(and fixnum (satisfies card16p)))
+
+(defun int16p (x)
+  (declare (fixnum x))
+  (and (>= x -32768) (<= x 32767)))
+(deftype int16 () '(and fixnum (satisfies int16p)))
+
+(defun card8p (x)
+  (declare (fixnum x))
+  (and (>= x 0) (<= x 255)))
+(deftype card8 () '(and fixnum (satisfies card8p)))
+
+(defun int8p (x)
+  (declare (fixnum x))
+  (and (>= x -128) (<= x 127)))
+(deftype card8 () '(and fixnum (satisfies card8p)))
+)
+|#
+(deftype card32 () '(unsigned-byte 32))
+
+(deftype card29 () '(unsigned-byte 29))
+
+(deftype card24 () '(unsigned-byte 24))
+
+(deftype int32 () '(signed-byte 32))
+
+(deftype card16 () '(unsigned-byte 16))
+
+(deftype int16 () '(signed-byte 16))
+
+(deftype card8 () '(unsigned-byte 8))
+
+(deftype int8 () '(signed-byte 8))
+
+(deftype card4 () '(unsigned-byte 4))
+
+#-clx-ansi-common-lisp
+(deftype real (&optional (min '*) (max '*))
+  (labels ((convert (limit floatp)
+	     (typecase limit
+	       (number (if floatp (float limit 0s0) (rational limit)))
+	       (list (map 'list #'convert limit))
+	       (otherwise limit))))
+    `(or (float ,(convert min t) ,(convert max t))
+	 (rational ,(convert min nil) ,(convert max nil)))))
+
+#-clx-ansi-common-lisp
+(deftype base-char ()
+  'string-char)
+
+; Note that we are explicitly using a different rgb representation than what
+; is actually transmitted in the protocol.
+
+(deftype rgb-val () '(real 0 1))
+
+; Note that we are explicitly using a different angle representation than what
+; is actually transmitted in the protocol.
+
+(deftype angle () '(real #.(* -2 pi) #.(* 2 pi)))
+
+(deftype mask32 () 'card32)
+
+(deftype mask16 () 'card16)
+
+(deftype pixel () '(unsigned-byte 32))
+(deftype image-depth () '(integer 0 32))
+
+(deftype resource-id () 'card29)
+
+(deftype keysym () 'card32)
+
+; The following functions are provided by color objects:
+
+; The intention is that IHS and YIQ and CYM interfaces will also exist.
+; Note that we are explicitly using a different spectrum representation
+; than what is actually transmitted in the protocol.
+
+(def-clx-class (color (:constructor make-color-internal (red green blue))
+		      (:copier nil) (:print-function print-color))
+  (red 0.0 :type rgb-val)
+  (green 0.0 :type rgb-val)
+  (blue 0.0 :type rgb-val))
+
+(defun print-color (color stream depth)
+  (declare (type color color)
+	   (ignore depth))
+  (print-unreadable-object (color stream :type t)
+    (prin1 (color-red color) stream)
+    (write-string " " stream)
+    (prin1 (color-green color) stream)
+    (write-string " " stream)
+    (prin1 (color-blue color) stream)))
+
+(defun make-color (&key (red 1.0) (green 1.0) (blue 1.0) &allow-other-keys)
+  (declare (type rgb-val red green blue))
+  (declare (values color))
+  (make-color-internal red green blue))
+
+(defun color-rgb (color)
+  (declare (type color color))
+  (declare (values red green blue))
+  (values (color-red color) (color-green color) (color-blue color)))
+
+(def-clx-class (bitmap-format (:copier nil))
+  (unit 8 :type (member 8 16 32))
+  (pad 8 :type (member 8 16 32))
+  (lsb-first-p nil :type boolean))
+
+(def-clx-class (pixmap-format (:copier nil))
+  (depth 0 :type image-depth)
+  (bits-per-pixel 8 :type (member 1 4 8 16 24 32))
+  (scanline-pad 8 :type (member 8 16 32)))
+
+(defparameter *atom-cache-size* 200)
+(defparameter *resource-id-map-size* 500)
+
+(def-clx-class (display (:include buffer)
+			(:constructor make-display-internal)
+			(:print-function print-display)
+			(:copier nil))
+  (host)					; Server Host
+  (display 0 :type integer)			; Display number on host
+  (after-function nil)				; Function to call after every request
+  (event-lock
+    (make-process-lock "CLX Event Lock"))	; with-event-queue lock
+  (event-queue-lock
+    (make-process-lock "CLX Event Queue Lock"))	; new-events/event-queue lock
+  (event-queue-tail				; last event in the event queue
+    nil :type (or null reply-buffer))
+  (event-queue-head				; Threaded queue of events
+    nil :type (or null reply-buffer))
+  (atom-cache (make-hash-table :test (atom-cache-map-test) :size *atom-cache-size*)
+	      :type hash-table)			; Hash table relating atoms keywords
+						; to atom id's
+  (font-cache nil)				; list of font
+  (protocol-major-version 0 :type card16)	; Major version of server's X protocol
+  (protocol-minor-version 0 :type card16)	; minor version of servers X protocol
+  (vendor-name "" :type string)			; vendor of the server hardware
+  (resource-id-base 0 :type resource-id)	; resouce ID base
+  (resource-id-mask 0 :type resource-id)	; resource ID mask bits
+  (resource-id-byte nil)			; resource ID mask field (used with DPB & LDB)
+  (resource-id-count 0 :type resource-id)	; resource ID mask count
+						; (used for allocating ID's)
+  (resource-id-map (make-hash-table :test (resource-id-map-test)
+				    :size *resource-id-map-size*)
+		   :type hash-table)		; hash table maps resource-id's to
+						; objects (used in lookup functions)
+  (xid 'resourcealloc)				; allocator function
+  (byte-order #+clx-little-endian :lsbfirst     ; connection byte order
+	      #-clx-little-endian :msbfirst)
+  (release-number 0 :type card32)		; release of the server
+  (max-request-length 0 :type card16)		; maximum number 32 bit words in request
+  (default-screen)				; default screen for operations
+  (roots nil :type list)			; List of screens
+  (motion-buffer-size 0 :type card32)		; size of motion buffer
+  (xdefaults)					; contents of defaults from server
+  (image-lsb-first-p nil :type boolean)
+  (bitmap-format (make-bitmap-format)		; Screen image info
+		 :type bitmap-format)
+  (pixmap-formats nil :type sequence)		; list of pixmap formats
+  (min-keycode 0 :type card8)			; minimum key-code
+  (max-keycode 0 :type card8)			; maximum key-code
+  (error-handler 'default-error-handler)	; Error handler function
+  (close-down-mode :destroy)  			; Close down mode saved by Set-Close-Down-Mode
+  (authorization-name "" :type string)
+  (authorization-data "" :type string)
+  (last-width nil :type (or null card29))	; Accumulated width of last string
+  (keysym-mapping nil				; Keysym mapping cached from server
+		  :type (or null (array * (* *))))
+  (modifier-mapping nil :type list)		; ALIST of (keysym . state-mask) for all modifier keysyms
+  (keysym-translation nil :type list)		; An alist of (keysym object function)
+						; for display-local keysyms
+  (extension-alist nil :type list)		; extension alist, which has elements:
+						; (name major-opcode first-event first-error)
+  (event-extensions '#() :type vector)		; Vector mapping X event-codes to event keys
+  (performance-info)				; Hook for gathering performance info
+  (trace-history)				; Hook for debug trace
+  (plist)					; hook for extension to hang data
+  ;; These slots are used to manage multi-process input.
+  (input-in-progress nil)			; Some process reading from the stream.
+						; Updated with CONDITIONAL-STORE.
+  (pending-commands nil)			; Threaded list of PENDING-COMMAND objects 
+						; for all commands awaiting replies.
+						; Protected by WITH-EVENT-QUEUE-INTERNAL.
+  (asynchronous-errors nil)			; Threaded list of REPLY-BUFFER objects
+						; containing error messages for commands
+						; which did not expect replies.
+						; Protected by WITH-EVENT-QUEUE-INTERNAL.
+  (report-asynchronous-errors			; When to report asynchronous errors
+    '(:immediately) :type list)			; The keywords that can be on this list 
+						; are :IMMEDIATELY, :BEFORE-EVENT-HANDLING,
+						; and :AFTER-FINISH-OUTPUT
+  (event-process nil)				; Process ID of process awaiting events.
+						; Protected by WITH-EVENT-QUEUE.
+  (new-events nil :type (or null reply-buffer))	; Pointer to the first new event in the
+						; event queue.
+						; Protected by WITH-EVENT-QUEUE.
+  (current-event-symbol				; Bound with PROGV by event handling macros 
+    (list (gensym) (gensym)) :type cons)
+  (atom-id-map (make-hash-table :test (resource-id-map-test)
+				:size *atom-cache-size*)
+	       :type hash-table)
+  )
+
+(defun print-display-name (display stream)
+  (declare (type (or null display) display))
+  (cond (display
+	 #-allegro (princ (display-host display) stream)
+	 #+allegro (write-string (string (display-host display)) stream)
+	 (write-string ":" stream)
+	 (princ (display-display display) stream))
+	(t
+	 (write-string "(no display)" stream)))
+  display)
+
+(defun print-display (display stream depth)
+  (declare (type display display)
+	   (ignore depth))
+  (print-unreadable-object (display stream :type t)
+    (print-display-name display stream)
+    (write-string " (" stream)
+    (write-string (display-vendor-name display) stream)
+    (write-string " R" stream)
+    (prin1 (display-release-number display) stream)
+    (write-string ")" stream)))
+
+;;(deftype drawable () '(or window pixmap))
+
+(def-clx-class (drawable (:copier nil) (:print-function print-drawable))
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  (plist nil :type list)			; Extension hook
+  )
+
+(defun print-drawable (drawable stream depth)
+  (declare (type drawable drawable)
+	   (ignore depth))
+  (print-unreadable-object (drawable stream :type t)
+    (print-display-name (drawable-display drawable) stream)
+    (write-string " " stream)
+    (prin1 (drawable-id drawable) stream)))
+
+(def-clx-class (window (:include drawable) (:copier nil)
+		       (:print-function print-drawable))
+  )
+
+(def-clx-class (pixmap (:include drawable) (:copier nil)
+		       (:print-function print-drawable))
+  )
+
+(def-clx-class (visual-info (:copier nil) (:print-function print-visual-info))
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  (class :static-gray :type (member :static-gray :static-color :true-color
+				    :gray-scale :pseudo-color :direct-color))
+  (red-mask 0 :type pixel)
+  (green-mask 0 :type pixel)
+  (blue-mask 0 :type pixel)
+  (bits-per-rgb 1 :type card8)
+  (colormap-entries 0 :type card16)
+  (plist nil :type list)			; Extension hook
+  )
+
+(defun print-visual-info (visual-info stream depth)
+  (declare (type visual-info visual-info)
+	   (ignore depth))
+  (print-unreadable-object (visual-info stream :type t)
+    (prin1 (visual-info-bits-per-rgb visual-info) stream)
+    (write-string "-bit " stream)
+    (princ (visual-info-class visual-info) stream)
+    (write-string " " stream)
+    (print-display-name (visual-info-display visual-info) stream)
+    (write-string " " stream)
+    (prin1 (visual-info-id visual-info) stream)))
+
+(def-clx-class (colormap (:copier nil) (:print-function print-colormap))
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  (visual-info nil :type (or null visual-info))
+  )
+
+(defun print-colormap (colormap stream depth)
+  (declare (type colormap colormap)
+	   (ignore depth))
+  (print-unreadable-object (colormap stream :type t)
+    (when (colormap-visual-info colormap)
+      (princ (visual-info-class (colormap-visual-info colormap)) stream)
+      (write-string " " stream))
+    (print-display-name (colormap-display colormap) stream)
+    (write-string " " stream)
+    (prin1 (colormap-id colormap) stream)))
+
+(def-clx-class (cursor (:copier nil) (:print-function print-cursor))
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  )
+
+(defun print-cursor (cursor stream depth)
+  (declare (type cursor cursor)
+	   (ignore depth))
+  (print-unreadable-object (cursor stream :type t)
+    (print-display-name (cursor-display cursor) stream)
+    (write-string " " stream)
+    (prin1 (cursor-id cursor) stream)))
+
+; Atoms are accepted as strings or symbols, and are always returned as keywords.
+; Protocol-level integer atom ids are hidden, using a cache in the display object.
+
+(deftype xatom () '(or string symbol))
+
+(defconstant *predefined-atoms*
+	     '#(nil :PRIMARY :SECONDARY :ARC :ATOM :BITMAP
+		    :CARDINAL :COLORMAP :CURSOR
+		    :CUT_BUFFER0 :CUT_BUFFER1 :CUT_BUFFER2 :CUT_BUFFER3
+		    :CUT_BUFFER4 :CUT_BUFFER5 :CUT_BUFFER6 :CUT_BUFFER7
+		    :DRAWABLE :FONT :INTEGER :PIXMAP :POINT :RECTANGLE
+		    :RESOURCE_MANAGER :RGB_COLOR_MAP :RGB_BEST_MAP
+		    :RGB_BLUE_MAP :RGB_DEFAULT_MAP
+		    :RGB_GRAY_MAP :RGB_GREEN_MAP :RGB_RED_MAP :STRING
+		    :VISUALID :WINDOW :WM_COMMAND :WM_HINTS
+		    :WM_CLIENT_MACHINE :WM_ICON_NAME :WM_ICON_SIZE
+		    :WM_NAME :WM_NORMAL_HINTS :WM_SIZE_HINTS
+		    :WM_ZOOM_HINTS :MIN_SPACE :NORM_SPACE :MAX_SPACE
+		    :END_SPACE :SUPERSCRIPT_X :SUPERSCRIPT_Y
+		    :SUBSCRIPT_X :SUBSCRIPT_Y
+		    :UNDERLINE_POSITION :UNDERLINE_THICKNESS
+		    :STRIKEOUT_ASCENT :STRIKEOUT_DESCENT
+		    :ITALIC_ANGLE :X_HEIGHT :QUAD_WIDTH :WEIGHT
+		    :POINT_SIZE :RESOLUTION :COPYRIGHT :NOTICE
+		    :FONT_NAME :FAMILY_NAME :FULL_NAME :CAP_HEIGHT
+		    :WM_CLASS :WM_TRANSIENT_FOR))
+
+(deftype stringable () '(or string symbol))
+
+(deftype fontable () '(or stringable font))
+
+; Nil stands for CurrentTime.
+
+(deftype timestamp () '(or null card32))
+
+(defconstant *bit-gravity-vector*
+	     '#(:forget :north-west :north :north-east :west
+		:center :east :south-west :south
+		:south-east :static))
+
+(deftype bit-gravity ()
+  '(member :forget :north-west :north :north-east :west
+	   :center :east :south-west :south :south-east :static))
+
+(defconstant *win-gravity-vector*
+	     '#(:unmap :north-west :north :north-east :west
+		:center :east :south-west :south :south-east
+		:static))
+
+(deftype win-gravity ()
+  '(member :unmap :north-west :north :north-east :west
+	   :center :east :south-west :south :south-east :static))
+
+(deftype grab-status ()
+  '(member :success :already-grabbed :invalid-time :not-viewable))
+
+; An association list.
+
+(deftype alist (key-type-and-name datum-type-and-name)
+  (declare (ignore key-type-and-name datum-type-and-name))
+  'list)
+
+; A sequence, containing zero or more repetitions of the given elements,
+; with the elements expressed as (type name).
+
+(deftype repeat-seq (&rest elts) elts 'sequence)
+
+(deftype point-seq () '(repeat-seq (int16 x) (int16 y)))
+
+(deftype seg-seq () '(repeat-seq (int16 x1) (int16 y1) (int16 x2) (int16 y2)))
+
+(deftype rect-seq () '(repeat-seq (int16 x) (int16 y) (card16 width) (card16 height)))
+
+(deftype arc-seq ()
+  '(repeat-seq (int16 x) (int16 y) (card16 width) (card16 height)
+	       (angle angle1) (angle angle2)))
+
+(deftype gcontext-state () 'simple-vector)
+
+(def-clx-class (gcontext (:copier nil) (:print-function print-gcontext))
+  ;; The accessors convert to CLX data types.
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  (drawable nil :type (or null drawable))
+  (cache-p t :type boolean)
+  (server-state (allocate-gcontext-state) :type gcontext-state)
+  (local-state (allocate-gcontext-state) :type gcontext-state)
+  (plist nil :type list)			; Extension hook
+  (next nil #-explorer :type #-explorer (or null gcontext))
+  )
+
+(defun print-gcontext (gcontext stream depth)
+  (declare (type gcontext gcontext)
+	   (ignore depth))
+  (print-unreadable-object (gcontext stream :type t)
+    (print-display-name (gcontext-display gcontext) stream)
+    (write-string " " stream)
+    (prin1 (gcontext-id gcontext) stream)))
+
+(defconstant *event-mask-vector*
+	     '#(:key-press :key-release :button-press :button-release
+		:enter-window :leave-window :pointer-motion :pointer-motion-hint
+		:button-1-motion :button-2-motion :button-3-motion :button-4-motion
+		:button-5-motion :button-motion :keymap-state :exposure :visibility-change
+		:structure-notify :resize-redirect :substructure-notify :substructure-redirect
+		:focus-change :property-change :colormap-change :owner-grab-button))
+
+(deftype event-mask-class ()
+  '(member :key-press :key-release :owner-grab-button :button-press :button-release
+	   :enter-window :leave-window :pointer-motion :pointer-motion-hint
+	   :button-1-motion :button-2-motion :button-3-motion :button-4-motion
+	   :button-5-motion :button-motion :exposure :visibility-change
+	   :structure-notify :resize-redirect :substructure-notify :substructure-redirect
+	   :focus-change :property-change :colormap-change :keymap-state))
+
+(deftype event-mask ()
+  '(or mask32 list)) ;; (OR integer (LIST event-mask-class))
+
+(defconstant *pointer-event-mask-vector*
+	     '#(%error %error :button-press :button-release
+		:enter-window :leave-window :pointer-motion :pointer-motion-hint
+		:button-1-motion :button-2-motion :button-3-motion :button-4-motion
+		:button-5-motion :button-motion :keymap-state))
+
+(deftype pointer-event-mask-class ()
+  '(member :button-press :button-release
+	   :enter-window :leave-window :pointer-motion :pointer-motion-hint
+	   :button-1-motion :button-2-motion :button-3-motion :button-4-motion
+	   :button-5-motion :button-motion :keymap-state))
+
+(deftype pointer-event-mask ()
+  '(or mask32 list)) ;;  '(or integer (list pointer-event-mask-class)))
+
+(defconstant *device-event-mask-vector*
+	     '#(:key-press :key-release :button-press :button-release :pointer-motion
+		:button-1-motion :button-2-motion :button-3-motion :button-4-motion
+		:button-5-motion :button-motion))
+
+(deftype device-event-mask-class ()
+  '(member :key-press :key-release :button-press :button-release :pointer-motion
+	   :button-1-motion :button-2-motion :button-3-motion :button-4-motion
+	   :button-5-motion :button-motion))
+
+(deftype device-event-mask ()
+  '(or mask32 list)) ;;  '(or integer (list device-event-mask-class)))
+
+(defconstant *state-mask-vector*
+	     '#(:shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5
+		:button-1 :button-2 :button-3 :button-4 :button-5))
+
+(deftype modifier-key ()
+  '(member :shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5))
+
+(deftype modifier-mask ()
+  '(or (member :any) mask16 list)) ;;  '(or (member :any) integer (list modifier-key)))
+
+(deftype state-mask-key ()
+  '(or modifier-key (member :button-1 :button-2 :button-3 :button-4 :button-5)))
+
+(defconstant *gcontext-components*
+	     '(:function :plane-mask :foreground :background
+	       :line-width :line-style :cap-style :join-style :fill-style
+	       :fill-rule :tile :stipple :ts-x :ts-y :font :subwindow-mode
+	       :exposures :clip-x :clip-y :clip-mask :dash-offset :dashes
+	       :arc-mode))
+
+(deftype gcontext-key ()
+  '(member :function :plane-mask :foreground :background
+	   :line-width :line-style :cap-style :join-style :fill-style
+	   :fill-rule :tile :stipple :ts-x :ts-y :font :subwindow-mode
+	   :exposures :clip-x :clip-y :clip-mask :dash-offset :dashes
+	   :arc-mode))
+
+(deftype event-key ()
+  '(member :key-press :key-release :button-press :button-release :motion-notify
+	   :enter-notify :leave-notify :focus-in :focus-out :keymap-notify
+	   :exposure :graphics-exposure :no-exposure :visibility-notify
+	   :create-notify :destroy-notify :unmap-notify :map-notify :map-request
+	   :reparent-notify :configure-notify :gravity-notify :resize-request
+	   :configure-request :circulate-notify :circulate-request :property-notify
+	   :selection-clear :selection-request :selection-notify
+	   :colormap-notify :client-message :mapping-notify))
+
+(deftype error-key ()
+  '(member :access :alloc :atom :colormap :cursor :drawable :font :gcontext :id-choice
+	   :illegal-request :implementation :length :match :name :pixmap :value :window))
+
+(deftype draw-direction ()
+  '(member :left-to-right :right-to-left))
+
+(defconstant *boole-vector*
+	     '#(#.boole-clr #.boole-and #.boole-andc2 #.boole-1
+		#.boole-andc1 #.boole-2 #.boole-xor #.boole-ior
+		#.boole-nor #.boole-eqv #.boole-c2 #.boole-orc2
+		#.boole-c1 #.boole-orc1 #.boole-nand #.boole-set))
+
+(deftype boole-constant ()
+  `(member ,boole-clr ,boole-and ,boole-andc2 ,boole-1
+	   ,boole-andc1 ,boole-2 ,boole-xor ,boole-ior
+	   ,boole-nor ,boole-eqv ,boole-c2 ,boole-orc2
+	   ,boole-c1 ,boole-orc1 ,boole-nand ,boole-set))
+
+(def-clx-class (screen (:copier nil) (:print-function print-screen))
+  (root nil :type (or null window))
+  (width 0 :type card16)
+  (height 0 :type card16)
+  (width-in-millimeters 0 :type card16)
+  (height-in-millimeters 0 :type card16)
+  (depths nil :type (alist (image-depth depth) ((list visual-info) visuals)))
+  (root-depth 1 :type image-depth)
+  (root-visual-info nil :type (or null visual-info))
+  (default-colormap nil :type (or null colormap))
+  (white-pixel 0 :type pixel)
+  (black-pixel 1 :type pixel)
+  (min-installed-maps 1 :type card16)
+  (max-installed-maps 1 :type card16)
+  (backing-stores :never :type (member :never :when-mapped :always))
+  (save-unders-p nil :type boolean)
+  (event-mask-at-open 0 :type mask32)
+  (plist nil :type list)			; Extension hook
+  )
+
+(defun print-screen (screen stream depth)
+  (declare (type screen screen)
+	   (ignore depth))
+  (print-unreadable-object (screen stream :type t)
+    (let ((display (drawable-display (screen-root screen))))
+      (print-display-name display stream)
+      (write-string "." stream)
+      (princ (position screen (display-roots display)) stream))
+    (write-string " " stream)
+    (prin1 (screen-width screen) stream)
+    (write-string "x" stream)
+    (prin1 (screen-height screen) stream)
+    (write-string "x" stream)
+    (prin1 (screen-root-depth screen) stream)
+    (when (screen-root-visual-info screen)
+      (write-string " " stream)
+      (princ (visual-info-class (screen-root-visual-info screen)) stream))))
+
+(defun screen-root-visual (screen)
+  (declare (type screen screen)
+	   (values resource-id))
+  (visual-info-id (screen-root-visual-info screen)))
+
+;; The list contains alternating keywords and integers.
+(deftype font-props () 'list)
+
+(def-clx-class (font-info (:copier nil) (:predicate nil))
+  (direction :left-to-right :type draw-direction)
+  (min-char 0 :type card16)   ;; First character in font
+  (max-char 0 :type card16)   ;; Last character in font
+  (min-byte1 0 :type card8)   ;; The following are for 16 bit fonts
+  (max-byte1 0 :type card8)   ;; and specify min&max values for
+  (min-byte2 0 :type card8)   ;; the two character bytes
+  (max-byte2 0 :type card8)
+  (all-chars-exist-p nil :type boolean)
+  (default-char 0 :type card16)
+  (min-bounds nil :type (or null vector))
+  (max-bounds nil :type (or null vector))
+  (ascent 0 :type int16)
+  (descent 0 :type int16)
+  (properties nil :type font-props))
+
+(def-clx-class (font (:constructor make-font-internal) (:copier nil)
+		     (:print-function print-font))
+  (id-internal nil :type (or null resource-id)) ;; NIL when not opened
+  (display nil :type (or null display))
+  (reference-count 0 :type fixnum)
+  (name "" :type (or null string)) ;; NIL when ID is for a GContext
+  (font-info-internal nil :type (or null font-info))
+  (char-infos-internal nil :type (or null (simple-array int16 (*))))
+  (local-only-p t :type boolean) ;; When T, always calculate text extents locally
+  (plist nil :type list)			; Extension hook
+  )
+
+(defun print-font (font stream depth)
+  (declare (type font font)
+	   (ignore depth))
+  (print-unreadable-object (font stream :type t)
+    (if (font-name font)
+	(princ (font-name font) stream)
+      (write-string "(gcontext)" stream))
+    (write-string " " stream)
+    (print-display-name (font-display font) stream)
+    (when (font-id-internal font)
+      (write-string " " stream)
+      (prin1 (font-id font) stream))))
+
+(defun font-id (font)
+  ;; Get font-id, opening font if needed
+  (or (font-id-internal font)
+      (open-font-internal font)))
+
+(defun font-font-info (font)
+  (or (font-font-info-internal font)
+      (query-font font)))
+
+(defun font-char-infos (font)
+  (or (font-char-infos-internal font)
+      (progn (query-font font)
+	     (font-char-infos-internal font))))
+
+(defun make-font (&key id
+		  display
+		  (reference-count 0)
+		  (name "")
+		  (local-only-p t)
+		  font-info-internal)
+  (make-font-internal :id-internal id
+		      :display display
+		      :reference-count reference-count
+		      :name name
+		      :local-only-p local-only-p
+		      :font-info-internal font-info-internal))
+
+; For each component (<name> <unspec> :type <type>) of font-info,
+; there is a corresponding function:
+
+;(defun font-<name> (font)
+;  (declare (type font font)
+;	   (values <type>)))
+
+(macrolet ((make-font-info-accessors (useless-name &body fields)
+	     `(within-definition (,useless-name make-font-info-accessors)
+		,@(mapcar
+		    #'(lambda (field)
+			(let* ((type (second field))
+			       (n (string (first field)))
+			       (name (xintern 'font- n))
+			       (accessor (xintern 'font-info- n)))
+			  `(defun ,name (font)
+			     (declare (type font font))
+			     (declare (values ,type))
+			     (,accessor (font-font-info font)))))
+		    fields))))
+  (make-font-info-accessors ignore
+    (direction draw-direction)
+    (min-char card16)
+    (max-char card16)
+    (min-byte1 card8)
+    (max-byte1 card8)
+    (min-byte2 card8)
+    (max-byte2 card8)
+    (all-chars-exist-p boolean)
+    (default-char card16)
+    (min-bounds vector)
+    (max-bounds vector)
+    (ascent int16)
+    (descent int16)
+    (properties font-props)))
+
+(defun font-property (font name)
+  (declare (type font font)
+	   (type keyword name))
+  (declare (values (or null int32)))
+  (getf (font-properties font) name))
+
+(macrolet ((make-mumble-equal (type)
+	     ;; When cached, EQ works fine, otherwise test resource id's and displays
+	     (let ((predicate (xintern type '-equal))
+		   (id (xintern type '-id))
+		   (dpy (xintern type '-display)))
+	       (if (member type *clx-cached-types*)
+		   `(within-definition (,type make-mumble-equal)
+		      (declaim (inline ,predicate))
+		      (defun ,predicate (a b) (eq a b)))
+		   `(within-definition (,type make-mumble-equal)
+		      (defun ,predicate (a b)
+			(declare (type ,type a b))
+			(and (= (,id a) (,id b))
+			     (eq (,dpy a) (,dpy b)))))))))
+  (make-mumble-equal window)
+  (make-mumble-equal pixmap)
+  (make-mumble-equal cursor)
+  (make-mumble-equal font)
+  (make-mumble-equal gcontext)
+  (make-mumble-equal colormap)
+  (make-mumble-equal drawable))
+
+;;;
+;;; Event-mask encode/decode functions
+;;;    Converts from keyword-lists to integer and back
+;;;
+(defun encode-mask (key-vector key-list key-type)
+  ;; KEY-VECTOR is a vector containg bit-position keywords.  The position of the
+  ;; keyword in the vector indicates its bit position in the resulting mask
+  ;; KEY-LIST is either a mask or a list of KEY-TYPE
+  ;; Returns NIL when KEY-LIST is not a list or mask.
+  (declare (type (simple-array keyword (*)) key-vector)
+	   (type (or mask32 list) key-list))
+  (declare (values (or mask32 null)))
+  (typecase key-list
+    (mask32 key-list)
+    (list (let ((mask 0))
+	    (dolist (key key-list mask)
+	      (let ((bit (position key (the vector key-vector) :test #'eq)))
+		(unless bit
+		  (x-type-error key key-type))
+		(setq mask (logior mask (ash 1 bit)))))))))
+
+(defun decode-mask (key-vector mask)
+  (declare (type (simple-array keyword (*)) key-vector)
+	   (type mask32 mask))
+  (declare (values list))
+  (do ((m mask (ash m -1))
+       (bit 0 (1+ bit))
+       (len (length key-vector))
+       (result nil))       
+      ((or (zerop m) (>= bit len)) result)
+    (declare (type mask32 m)
+	     (fixnum bit len)
+	     (list result))
+    (when (oddp m)
+      (push (aref key-vector bit) result))))
+
+(defun encode-event-mask (event-mask)
+  (declare (type event-mask event-mask))
+  (declare (values mask32))
+  (or (encode-mask *event-mask-vector* event-mask 'event-mask-class)
+      (x-type-error event-mask 'event-mask)))
+
+(defun make-event-mask (&rest keys)
+  ;; This is only defined for core events.
+  ;; Useful for constructing event-mask, pointer-event-mask, device-event-mask.
+  (declare (type list keys)) ;; (list event-mask-class)
+  (declare (values mask32))
+  (encode-mask *event-mask-vector* keys 'event-mask-class))
+
+(defun make-event-keys (event-mask)
+  ;; This is only defined for core events.
+  (declare (type mask32 event-mask))
+  (declare (values (list event-mask-class)))
+  (decode-mask *event-mask-vector* event-mask))
+
+(defun encode-device-event-mask (device-event-mask)
+  (declare (type device-event-mask device-event-mask))
+  (declare (values mask32))
+  (or (encode-mask *device-event-mask-vector* device-event-mask
+		   'device-event-mask-class)
+      (x-type-error device-event-mask 'device-event-mask)))
+
+(defun encode-modifier-mask (modifier-mask)
+  (declare (type modifier-mask modifier-mask)) ;; (list state-mask-key)
+  (declare (values mask16))
+  (or (encode-mask *state-mask-vector* modifier-mask 'modifier-key)
+      (and (eq modifier-mask :any) #x8000)
+      (x-type-error modifier-mask 'modifier-mask)))
+
+(defun encode-state-mask (state-mask)
+  (declare (type (or mask16 list) state-mask)) ;; (list state-mask-key)
+  (declare (values mask16))
+  (or (encode-mask *state-mask-vector* state-mask 'state-mask-key)
+      (x-type-error state-mask '(or mask16 (list state-mask-key)))))
+
+(defun make-state-mask (&rest keys)
+  ;; Useful for constructing modifier-mask, state-mask.
+  (declare (type list keys)) ;; (list state-mask-key)
+  (declare (values mask16))
+  (encode-mask *state-mask-vector* keys 'state-mask-key))
+
+(defun make-state-keys (state-mask)
+  (declare (type mask16 state-mask))
+  (declare (values (list state-mask-key)))
+  (decode-mask *state-mask-vector* state-mask))
+
+(defun encode-pointer-event-mask (pointer-event-mask)
+  (declare (type pointer-event-mask pointer-event-mask))
+  (declare (values mask32))
+  (or (encode-mask *pointer-event-mask-vector* pointer-event-mask
+		   'pointer-event-mask-class)
+      (x-type-error pointer-event-mask 'pointer-event-mask)))
diff --git a/src/clx/clxmain.lsp b/src/clx/clxmain.lsp
new file mode 100644
index 000000000..767728815
--- /dev/null
+++ b/src/clx/clxmain.lsp
@@ -0,0 +1,936 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;;(c) Copyright Enhancements by Giuseppe Attardi, 1994.
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+;; Primary Interface Author:
+;;	Robert W. Scheifler
+;;	MIT Laboratory for Computer Science
+;;	545 Technology Square, Room 418
+;;	Cambridge, MA 02139
+;;	rws@zermatt.lcs.mit.edu
+
+;; Design Contributors:
+;;	Dan Cerys, Texas Instruments
+;;	Scott Fahlman, CMU
+;;      Charles Hornig, Symbolics
+;;      John Irwin, Franz
+;;	Kerry Kimbrough, Texas Instruments
+;;	Chris Lindblad, MIT
+;;	Rob MacLachlan, CMU
+;;	Mike McMahon, Symbolics
+;;	David Moon, Symbolics
+;;	LaMott Oren, Texas Instruments
+;;	Daniel Weinreb, Symbolics
+;;	John Wroclawski, MIT
+;;	Richard Zippel, Symbolics
+
+;; Primary Implementation Author:
+;;	LaMott Oren, Texas Instruments
+
+;; Implementation Contributors:
+;;      Charles Hornig, Symbolics
+;;      John Irwin, Franz
+;;	Chris Lindblad, MIT
+;;	Robert Scheifler, MIT
+
+;;;
+;;; Change history:
+;;;
+;;;  Date	Author		Description
+;;; -------------------------------------------------------------------------------------
+;;; 04/07/87	R.Scheifler	Created code stubs
+;;; 04/08/87	L.Oren		Started Implementation
+;;; 05/11/87	L.Oren		Included draft 3 revisions
+;;; 07/07/87	L.Oren		Untested alpha release to MIT
+;;; 07/17/87	L.Oren		Alpha release
+;;; 08/**/87	C.Lindblad	Rewrite of buffer code
+;;; 08/**/87	et al		Various random bug fixes
+;;; 08/**/87	R.Scheifler	General syntactic and portability cleanups
+;;; 08/**/87	R.Scheifler	Rewrite of gcontext caching and shadowing
+;;; 09/02/87	L.Oren		Change events from resource-ids to objects
+;;; 12/24/87	R.Budzianowski	KCL support
+;;; 12/**/87	J.Irwin		ExCL 2.0 support
+;;; 01/20/88	L.Oren		Add server extension mechanisms
+;;; 01/20/88	L.Oren		Only force output when blocking on input
+;;; 01/20/88	L.Oren		Uniform support for :event-window on events
+;;; 01/28/88	L.Oren		Add window manager property functions
+;;; 01/28/88	L.Oren		Add character translation facility
+;;; 02/**/87	J.Irwin		Allegro 2.2 support
+
+;;; This is considered a somewhat changeable interface.  Discussion of better
+;;; integration with CLOS, support for user-specified subclassess of basic
+;;; objects, and the additional functionality to match the C Xlib is still in
+;;; progress.  Bug reports should be addressed to bug-clx@expo.lcs.mit.edu.
+
+;; Note: all of the following is in the package XLIB.
+
+(in-package :xlib)
+
+(pushnew :clx *features*)
+(pushnew :xlib *features*)
+
+(defparameter *version* "MIT R5.0")
+(pushnew :clx-mit-r4 *features*)
+(pushnew :clx-mit-r5 *features*)
+
+(defparameter *protocol-major-version* 11.)
+(defparameter *protocol-minor-version* 0)
+
+(defparameter *x-tcp-port* 6000) ;; add display number
+
+; Note: various perversions of the CL type system are used below.
+; Examples: (list elt-type) (sequence elt-type)
+
+;; Note: if you have read the Version 11 protocol document or C Xlib manual, most of
+;; the relationships should be fairly obvious.  We have no intention of writing yet
+;; another moby document for this interface.
+
+;; Types employed: display, window, pixmap, cursor, font, gcontext, colormap, color.
+;; These types are defined solely by a functional interface; we do not specify
+;; whether they are implemented as structures or flavors or ...  Although functions
+;; below are written using DEFUN, this is not an implementation requirement (although
+;; it is a requirement that they be functions as opposed to macros or special forms).
+;; It is unclear whether with-slots in the Common Lisp Object System must work on
+;; them.
+
+;; Windows, pixmaps, cursors, fonts, gcontexts, and colormaps are all represented as
+;; compound objects, rather than as integer resource-ids.  This allows applications
+;; to deal with multiple displays without having an explicit display argument in the
+;; most common functions.  Every function uses the display object indicated by the
+;; first argument that is or contains a display; it is an error if arguments contain
+;; different displays, and predictable results are not guaranteed.
+
+;; Each of window, pixmap, cursor, font, gcontext, and colormap have the following
+;; five functions:
+
+;(defun make-<mumble> (display resource-id)
+;  ;; This function should almost never be called by applications, except in handling
+;  ;; events.  To minimize consing in some implementations, this may use a cache in
+;  ;; the display.  Make-gcontext creates with :cache-p nil.  Make-font creates with
+;  ;; cache-p true.
+;  (declare (type display display)
+;	   (type integer resource-id)
+;	   (values <mumble>)))
+
+;(defun <mumble>-display (<mumble>)
+;  (declare (type <mumble> <mumble>)
+;	   (values display)))
+
+;(defun <mumble>-id (<mumble>)
+;  (declare (type <mumble> <mumble>)
+;	   (values integer)))
+
+;(defun <mumble>-equal (<mumble>-1 <mumble>-2)
+;  (declare (type <mumble> <mumble>-1 <mumble>-2)))
+
+;(defun <mumble>-p (<mumble>-1 <mumble>-2)
+;  (declare (type <mumble> <mumble>-1 <mumble>-2)
+;	   (values boolean)))
+
+(deftype boolean () '(or null (not null)))
+
+#|
+#+ecl
+
+(deftype card32 () '(integer 0 4294967295)) ; 2^32 - 1
+
+(defun card29p (x)
+  (declare (fixnum x))
+  (and (>= x 0) (<= x 536870911)))
+(deftype card29 () '(and fixnum (satisfies card29p)))
+
+(deftype int32 () 'fixnum)
+
+(defun card16p (x)
+  (declare (fixnum x))
+  (and (>= x 0) (<= x 65535)))
+(deftype card16 () '(and fixnum (satisfies card16p)))
+
+(defun int16p (x)
+  (declare (fixnum x))
+  (and (>= x -32768) (<= x 32767)))
+(deftype int16 () '(and fixnum (satisfies int16p)))
+
+(defun card8p (x)
+  (declare (fixnum x))
+  (and (>= x 0) (<= x 255)))
+(deftype card8 () '(and fixnum (satisfies card8p)))
+
+(defun int8p (x)
+  (declare (fixnum x))
+  (and (>= x -128) (<= x 127)))
+(deftype card8 () '(and fixnum (satisfies card8p)))
+)
+|#
+(deftype card32 () '(unsigned-byte 32))
+
+(deftype card29 () '(unsigned-byte 29))
+
+(deftype card24 () '(unsigned-byte 24))
+
+(deftype int32 () '(signed-byte 32))
+
+(deftype card16 () '(unsigned-byte 16))
+
+(deftype int16 () '(signed-byte 16))
+
+(deftype card8 () '(unsigned-byte 8))
+
+(deftype int8 () '(signed-byte 8))
+
+(deftype card4 () '(unsigned-byte 4))
+
+#-clx-ansi-common-lisp
+(deftype real (&optional (min '*) (max '*))
+  (labels ((convert (limit floatp)
+	     (typecase limit
+	       (number (if floatp (float limit 0s0) (rational limit)))
+	       (list (map 'list #'convert limit))
+	       (otherwise limit))))
+    `(or (float ,(convert min t) ,(convert max t))
+	 (rational ,(convert min nil) ,(convert max nil)))))
+
+#-(or ecl clx-ansi-common-lisp)
+
+; Note that we are explicitly using a different rgb representation than what
+; is actually transmitted in the protocol.
+
+(deftype rgb-val () '(real 0 1))
+
+; Note that we are explicitly using a different angle representation than what
+; is actually transmitted in the protocol.
+
+(deftype angle () '(real #.(* -2 pi) #.(* 2 pi)))
+
+(deftype mask32 () 'card32)
+
+(deftype mask16 () 'card16)
+
+(deftype pixel () '(unsigned-byte 32))
+(deftype image-depth () '(integer 0 32))
+
+(deftype resource-id () 'card29)
+
+(deftype keysym () 'card32)
+
+; The following functions are provided by color objects:
+
+; The intention is that IHS and YIQ and CYM interfaces will also exist.
+; Note that we are explicitly using a different spectrum representation
+; than what is actually transmitted in the protocol.
+
+(def-clx-class (color (:constructor make-color-internal (red green blue))
+		      (:copier nil) (:print-function print-color))
+  (red 0.0 :type rgb-val)
+  (green 0.0 :type rgb-val)
+  (blue 0.0 :type rgb-val))
+
+(defun print-color (color stream depth)
+  (declare (type color color)
+	   (ignore depth))
+  (print-unreadable-object (color stream :type t)
+    (prin1 (color-red color) stream)
+    (write-string " " stream)
+    (prin1 (color-green color) stream)
+    (write-string " " stream)
+    (prin1 (color-blue color) stream)))
+
+(defun make-color (&key (red 1.0) (green 1.0) (blue 1.0) &allow-other-keys)
+  (declare (type rgb-val red green blue))
+  (declare (values color))
+  (make-color-internal red green blue))
+
+(defun color-rgb (color)
+  (declare (type color color))
+  (declare (values red green blue))
+  (values (color-red color) (color-green color) (color-blue color)))
+
+(def-clx-class (bitmap-format (:copier nil))
+  (unit 8 :type (member 8 16 32))
+  (pad 8 :type (member 8 16 32))
+  (lsb-first-p nil :type boolean))
+
+(def-clx-class (pixmap-format (:copier nil))
+  (depth 0 :type image-depth)
+  (bits-per-pixel 8 :type (member 1 4 8 16 24 32))
+  (scanline-pad 8 :type (member 8 16 32)))
+
+(defparameter *atom-cache-size* 200)
+(defparameter *resource-id-map-size* 500)
+
+(def-clx-class (display (:include buffer)
+			(:constructor make-display-internal)
+			(:print-function print-display)
+			(:copier nil))
+  (host)					; Server Host
+  (display 0 :type integer)			; Display number on host
+  (after-function nil)				; Function to call after every request
+  (event-lock
+    (make-process-lock "CLX Event Lock"))	; with-event-queue lock
+  (event-queue-lock
+    (make-process-lock "CLX Event Queue Lock"))	; new-events/event-queue lock
+  (event-queue-tail				; last event in the event queue
+    nil :type (or null reply-buffer))
+  (event-queue-head				; Threaded queue of events
+    nil :type (or null reply-buffer))
+  (atom-cache (make-hash-table :test (atom-cache-map-test) :size *atom-cache-size*)
+	      :type hash-table)			; Hash table relating atoms keywords
+						; to atom id's
+  (font-cache nil)				; list of font
+  (protocol-major-version 0 :type card16)	; Major version of server's X protocol
+  (protocol-minor-version 0 :type card16)	; minor version of servers X protocol
+  (vendor-name "" :type string)			; vendor of the server hardware
+  (resource-id-base 0 :type resource-id)	; resouce ID base
+  (resource-id-mask 0 :type resource-id)	; resource ID mask bits
+  (resource-id-byte nil)			; resource ID mask field (used with DPB & LDB)
+  (resource-id-count 0 :type resource-id)	; resource ID mask count
+						; (used for allocating ID's)
+  (resource-id-map (make-hash-table :test (resource-id-map-test)
+				    :size *resource-id-map-size*)
+		   :type hash-table)		; hash table maps resource-id's to
+						; objects (used in lookup functions)
+  (xid 'resourcealloc)				; allocator function
+  (byte-order #+clx-little-endian :lsbfirst     ; connection byte order
+	      #-clx-little-endian :msbfirst)
+  (release-number 0 :type card32)		; release of the server
+  (max-request-length 0 :type card16)		; maximum number 32 bit words in request
+  (default-screen)				; default screen for operations
+  (roots nil :type list)			; List of screens
+  (motion-buffer-size 0 :type card32)		; size of motion buffer
+  (xdefaults)					; contents of defaults from server
+  (image-lsb-first-p nil :type boolean)
+  (bitmap-format (make-bitmap-format)		; Screen image info
+		 :type bitmap-format)
+  (pixmap-formats nil :type sequence)		; list of pixmap formats
+  (min-keycode 0 :type card8)			; minimum key-code
+  (max-keycode 0 :type card8)			; maximum key-code
+  (error-handler 'default-error-handler)	; Error handler function
+  (close-down-mode :destroy)  			; Close down mode saved by Set-Close-Down-Mode
+  (authorization-name "" :type string)
+  (authorization-data "" :type string)
+  (last-width nil :type (or null card29))	; Accumulated width of last string
+  (keysym-mapping nil				; Keysym mapping cached from server
+		  :type (or null (array * (* *))))
+  (modifier-mapping nil :type list)		; ALIST of (keysym . state-mask) for all modifier keysyms
+  (keysym-translation nil :type list)		; An alist of (keysym object function)
+						; for display-local keysyms
+  (extension-alist nil :type list)		; extension alist, which has elements:
+						; (name major-opcode first-event first-error)
+  (event-extensions '#() :type vector)		; Vector mapping X event-codes to event keys
+  (performance-info)				; Hook for gathering performance info
+  (trace-history)				; Hook for debug trace
+  (plist)					; hook for extension to hang data
+  ;; These slots are used to manage multi-process input.
+  (input-in-progress nil)			; Some process reading from the stream.
+						; Updated with CONDITIONAL-STORE.
+  (pending-commands nil)			; Threaded list of PENDING-COMMAND objects 
+						; for all commands awaiting replies.
+						; Protected by WITH-EVENT-QUEUE-INTERNAL.
+  (asynchronous-errors nil)			; Threaded list of REPLY-BUFFER objects
+						; containing error messages for commands
+						; which did not expect replies.
+						; Protected by WITH-EVENT-QUEUE-INTERNAL.
+  (report-asynchronous-errors			; When to report asynchronous errors
+    '(:immediately) :type list)			; The keywords that can be on this list 
+						; are :IMMEDIATELY, :BEFORE-EVENT-HANDLING,
+						; and :AFTER-FINISH-OUTPUT
+  (event-process nil)				; Process ID of process awaiting events.
+						; Protected by WITH-EVENT-QUEUE.
+  (new-events nil :type (or null reply-buffer))	; Pointer to the first new event in the
+						; event queue.
+						; Protected by WITH-EVENT-QUEUE.
+  (current-event-symbol				; Bound with PROGV by event handling macros 
+    (list (gensym) (gensym)) :type cons)
+  (atom-id-map (make-hash-table :test (resource-id-map-test)
+				:size *atom-cache-size*)
+	       :type hash-table)
+  )
+
+(defun print-display-name (display stream)
+  (declare (type (or null display) display))
+  (cond (display
+	 #-allegro (princ (display-host display) stream)
+	 #+allegro (write-string (string (display-host display)) stream)
+	 (write-string ":" stream)
+	 (princ (display-display display) stream))
+	(t
+	 (write-string "(no display)" stream)))
+  display)
+
+(defun print-display (display stream depth)
+  (declare (type display display)
+	   (ignore depth))
+  (print-unreadable-object (display stream :type t)
+    (print-display-name display stream)
+    (write-string " (" stream)
+    (write-string (display-vendor-name display) stream)
+    (write-string " R" stream)
+    (prin1 (display-release-number display) stream)
+    (write-string ")" stream)))
+
+;;(deftype drawable () '(or window pixmap))
+
+(def-clx-class (drawable (:copier nil) (:print-function print-drawable))
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  (plist nil :type list)			; Extension hook
+  )
+
+(defun print-drawable (drawable stream depth)
+  (declare (type drawable drawable)
+	   (ignore depth))
+  (print-unreadable-object (drawable stream :type t)
+    (print-display-name (drawable-display drawable) stream)
+    (write-string " " stream)
+    (prin1 (drawable-id drawable) stream)))
+
+(def-clx-class (window (:include drawable) (:copier nil)
+		       (:print-function print-drawable))
+  )
+
+(def-clx-class (pixmap (:include drawable) (:copier nil)
+		       (:print-function print-drawable))
+  )
+
+(def-clx-class (visual-info (:copier nil) (:print-function print-visual-info))
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  (class :static-gray :type (member :static-gray :static-color :true-color
+				    :gray-scale :pseudo-color :direct-color))
+  (red-mask 0 :type pixel)
+  (green-mask 0 :type pixel)
+  (blue-mask 0 :type pixel)
+  (bits-per-rgb 1 :type card8)
+  (colormap-entries 0 :type card16)
+  (plist nil :type list)			; Extension hook
+  )
+
+(defun print-visual-info (visual-info stream depth)
+  (declare (type visual-info visual-info)
+	   (ignore depth))
+  (print-unreadable-object (visual-info stream :type t)
+    (prin1 (visual-info-bits-per-rgb visual-info) stream)
+    (write-string "-bit " stream)
+    (princ (visual-info-class visual-info) stream)
+    (write-string " " stream)
+    (print-display-name (visual-info-display visual-info) stream)
+    (write-string " " stream)
+    (prin1 (visual-info-id visual-info) stream)))
+
+(def-clx-class (colormap (:copier nil) (:print-function print-colormap))
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  (visual-info nil :type (or null visual-info))
+  )
+
+(defun print-colormap (colormap stream depth)
+  (declare (type colormap colormap)
+	   (ignore depth))
+  (print-unreadable-object (colormap stream :type t)
+    (when (colormap-visual-info colormap)
+      (princ (visual-info-class (colormap-visual-info colormap)) stream)
+      (write-string " " stream))
+    (print-display-name (colormap-display colormap) stream)
+    (write-string " " stream)
+    (prin1 (colormap-id colormap) stream)))
+
+(def-clx-class (cursor (:copier nil) (:print-function print-cursor))
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  )
+
+(defun print-cursor (cursor stream depth)
+  (declare (type cursor cursor)
+	   (ignore depth))
+  (print-unreadable-object (cursor stream :type t)
+    (print-display-name (cursor-display cursor) stream)
+    (write-string " " stream)
+    (prin1 (cursor-id cursor) stream)))
+
+; Atoms are accepted as strings or symbols, and are always returned as keywords.
+; Protocol-level integer atom ids are hidden, using a cache in the display object.
+
+(deftype xatom () '(or string symbol))
+
+(defconstant *predefined-atoms*
+	     '#(nil :PRIMARY :SECONDARY :ARC :ATOM :BITMAP
+		    :CARDINAL :COLORMAP :CURSOR
+		    :CUT_BUFFER0 :CUT_BUFFER1 :CUT_BUFFER2 :CUT_BUFFER3
+		    :CUT_BUFFER4 :CUT_BUFFER5 :CUT_BUFFER6 :CUT_BUFFER7
+		    :DRAWABLE :FONT :INTEGER :PIXMAP :POINT :RECTANGLE
+		    :RESOURCE_MANAGER :RGB_COLOR_MAP :RGB_BEST_MAP
+		    :RGB_BLUE_MAP :RGB_DEFAULT_MAP
+		    :RGB_GRAY_MAP :RGB_GREEN_MAP :RGB_RED_MAP :STRING
+		    :VISUALID :WINDOW :WM_COMMAND :WM_HINTS
+		    :WM_CLIENT_MACHINE :WM_ICON_NAME :WM_ICON_SIZE
+		    :WM_NAME :WM_NORMAL_HINTS :WM_SIZE_HINTS
+		    :WM_ZOOM_HINTS :MIN_SPACE :NORM_SPACE :MAX_SPACE
+		    :END_SPACE :SUPERSCRIPT_X :SUPERSCRIPT_Y
+		    :SUBSCRIPT_X :SUBSCRIPT_Y
+		    :UNDERLINE_POSITION :UNDERLINE_THICKNESS
+		    :STRIKEOUT_ASCENT :STRIKEOUT_DESCENT
+		    :ITALIC_ANGLE :X_HEIGHT :QUAD_WIDTH :WEIGHT
+		    :POINT_SIZE :RESOLUTION :COPYRIGHT :NOTICE
+		    :FONT_NAME :FAMILY_NAME :FULL_NAME :CAP_HEIGHT
+		    :WM_CLASS :WM_TRANSIENT_FOR))
+
+(deftype stringable () '(or string symbol))
+
+(deftype fontable () '(or stringable font))
+
+; Nil stands for CurrentTime.
+
+(deftype timestamp () '(or null card32))
+
+(defconstant *bit-gravity-vector*
+	     '#(:forget :north-west :north :north-east :west
+		:center :east :south-west :south
+		:south-east :static))
+
+(deftype bit-gravity ()
+  '(member :forget :north-west :north :north-east :west
+	   :center :east :south-west :south :south-east :static))
+
+(defconstant *win-gravity-vector*
+	     '#(:unmap :north-west :north :north-east :west
+		:center :east :south-west :south :south-east
+		:static))
+
+(deftype win-gravity ()
+  '(member :unmap :north-west :north :north-east :west
+	   :center :east :south-west :south :south-east :static))
+
+(deftype grab-status ()
+  '(member :success :already-grabbed :invalid-time :not-viewable))
+
+; An association list.
+
+(deftype alist (key-type-and-name datum-type-and-name)
+  (declare (ignore key-type-and-name datum-type-and-name))
+  'list)
+
+; A sequence, containing zero or more repetitions of the given elements,
+; with the elements expressed as (type name).
+
+(deftype repeat-seq (&rest elts) elts 'sequence)
+
+(deftype point-seq () '(repeat-seq (int16 x) (int16 y)))
+
+(deftype seg-seq () '(repeat-seq (int16 x1) (int16 y1) (int16 x2) (int16 y2)))
+
+(deftype rect-seq () '(repeat-seq (int16 x) (int16 y) (card16 width) (card16 height)))
+
+(deftype arc-seq ()
+  '(repeat-seq (int16 x) (int16 y) (card16 width) (card16 height)
+	       (angle angle1) (angle angle2)))
+
+(deftype gcontext-state () 'simple-vector)
+
+(def-clx-class (gcontext (:copier nil) (:print-function print-gcontext))
+  ;; The accessors convert to CLX data types.
+  (id 0 :type resource-id)
+  (display nil :type (or null display))
+  (drawable nil :type (or null drawable))
+  (cache-p t :type boolean)
+  (server-state (allocate-gcontext-state) :type gcontext-state)
+  (local-state (allocate-gcontext-state) :type gcontext-state)
+  (plist nil :type list)			; Extension hook
+  (next nil #-explorer :type #-explorer (or null gcontext))
+  )
+
+(defun print-gcontext (gcontext stream depth)
+  (declare (type gcontext gcontext)
+	   (ignore depth))
+  (print-unreadable-object (gcontext stream :type t)
+    (print-display-name (gcontext-display gcontext) stream)
+    (write-string " " stream)
+    (prin1 (gcontext-id gcontext) stream)))
+
+(defconstant *event-mask-vector*
+	     '#(:key-press :key-release :button-press :button-release
+		:enter-window :leave-window :pointer-motion :pointer-motion-hint
+		:button-1-motion :button-2-motion :button-3-motion :button-4-motion
+		:button-5-motion :button-motion :keymap-state :exposure :visibility-change
+		:structure-notify :resize-redirect :substructure-notify :substructure-redirect
+		:focus-change :property-change :colormap-change :owner-grab-button))
+
+(deftype event-mask-class ()
+  '(member :key-press :key-release :owner-grab-button :button-press :button-release
+	   :enter-window :leave-window :pointer-motion :pointer-motion-hint
+	   :button-1-motion :button-2-motion :button-3-motion :button-4-motion
+	   :button-5-motion :button-motion :exposure :visibility-change
+	   :structure-notify :resize-redirect :substructure-notify :substructure-redirect
+	   :focus-change :property-change :colormap-change :keymap-state))
+
+(deftype event-mask ()
+  '(or mask32 list)) ;; (OR integer (LIST event-mask-class))
+
+(defconstant *pointer-event-mask-vector*
+	     '#(%error %error :button-press :button-release
+		:enter-window :leave-window :pointer-motion :pointer-motion-hint
+		:button-1-motion :button-2-motion :button-3-motion :button-4-motion
+		:button-5-motion :button-motion :keymap-state))
+
+(deftype pointer-event-mask-class ()
+  '(member :button-press :button-release
+	   :enter-window :leave-window :pointer-motion :pointer-motion-hint
+	   :button-1-motion :button-2-motion :button-3-motion :button-4-motion
+	   :button-5-motion :button-motion :keymap-state))
+
+(deftype pointer-event-mask ()
+  '(or mask32 list)) ;;  '(or integer (list pointer-event-mask-class)))
+
+(defconstant *device-event-mask-vector*
+	     '#(:key-press :key-release :button-press :button-release :pointer-motion
+		:button-1-motion :button-2-motion :button-3-motion :button-4-motion
+		:button-5-motion :button-motion))
+
+(deftype device-event-mask-class ()
+  '(member :key-press :key-release :button-press :button-release :pointer-motion
+	   :button-1-motion :button-2-motion :button-3-motion :button-4-motion
+	   :button-5-motion :button-motion))
+
+(deftype device-event-mask ()
+  '(or mask32 list)) ;;  '(or integer (list device-event-mask-class)))
+
+(defconstant *state-mask-vector*
+	     '#(:shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5
+		:button-1 :button-2 :button-3 :button-4 :button-5))
+
+(deftype modifier-key ()
+  '(member :shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5))
+
+(deftype modifier-mask ()
+  '(or (member :any) mask16 list)) ;;  '(or (member :any) integer (list modifier-key)))
+
+(deftype state-mask-key ()
+  '(or modifier-key (member :button-1 :button-2 :button-3 :button-4 :button-5)))
+
+(defconstant *gcontext-components*
+	     '(:function :plane-mask :foreground :background
+	       :line-width :line-style :cap-style :join-style :fill-style
+	       :fill-rule :tile :stipple :ts-x :ts-y :font :subwindow-mode
+	       :exposures :clip-x :clip-y :clip-mask :dash-offset :dashes
+	       :arc-mode))
+
+(deftype gcontext-key ()
+  '(member :function :plane-mask :foreground :background
+	   :line-width :line-style :cap-style :join-style :fill-style
+	   :fill-rule :tile :stipple :ts-x :ts-y :font :subwindow-mode
+	   :exposures :clip-x :clip-y :clip-mask :dash-offset :dashes
+	   :arc-mode))
+
+(deftype event-key ()
+  '(member :key-press :key-release :button-press :button-release :motion-notify
+	   :enter-notify :leave-notify :focus-in :focus-out :keymap-notify
+	   :exposure :graphics-exposure :no-exposure :visibility-notify
+	   :create-notify :destroy-notify :unmap-notify :map-notify :map-request
+	   :reparent-notify :configure-notify :gravity-notify :resize-request
+	   :configure-request :circulate-notify :circulate-request :property-notify
+	   :selection-clear :selection-request :selection-notify
+	   :colormap-notify :client-message :mapping-notify))
+
+(deftype error-key ()
+  '(member :access :alloc :atom :colormap :cursor :drawable :font :gcontext :id-choice
+	   :illegal-request :implementation :length :match :name :pixmap :value :window))
+
+(deftype draw-direction ()
+  '(member :left-to-right :right-to-left))
+
+(defconstant *boole-vector*
+	     '#(#.boole-clr #.boole-and #.boole-andc2 #.boole-1
+		#.boole-andc1 #.boole-2 #.boole-xor #.boole-ior
+		#.boole-nor #.boole-eqv #.boole-c2 #.boole-orc2
+		#.boole-c1 #.boole-orc1 #.boole-nand #.boole-set))
+
+(deftype boole-constant ()
+  `(member ,boole-clr ,boole-and ,boole-andc2 ,boole-1
+	   ,boole-andc1 ,boole-2 ,boole-xor ,boole-ior
+	   ,boole-nor ,boole-eqv ,boole-c2 ,boole-orc2
+	   ,boole-c1 ,boole-orc1 ,boole-nand ,boole-set))
+
+(def-clx-class (screen (:copier nil) (:print-function print-screen))
+  (root nil :type (or null window))
+  (width 0 :type card16)
+  (height 0 :type card16)
+  (width-in-millimeters 0 :type card16)
+  (height-in-millimeters 0 :type card16)
+  (depths nil :type (alist (image-depth depth) ((list visual-info) visuals)))
+  (root-depth 1 :type image-depth)
+  (root-visual-info nil :type (or null visual-info))
+  (default-colormap nil :type (or null colormap))
+  (white-pixel 0 :type pixel)
+  (black-pixel 1 :type pixel)
+  (min-installed-maps 1 :type card16)
+  (max-installed-maps 1 :type card16)
+  (backing-stores :never :type (member :never :when-mapped :always))
+  (save-unders-p nil :type boolean)
+  (event-mask-at-open 0 :type mask32)
+  (plist nil :type list)			; Extension hook
+  )
+
+(defun print-screen (screen stream depth)
+  (declare (type screen screen)
+	   (ignore depth))
+  (print-unreadable-object (screen stream :type t)
+    (let ((display (drawable-display (screen-root screen))))
+      (print-display-name display stream)
+      (write-string "." stream)
+      (princ (position screen (display-roots display)) stream))
+    (write-string " " stream)
+    (prin1 (screen-width screen) stream)
+    (write-string "x" stream)
+    (prin1 (screen-height screen) stream)
+    (write-string "x" stream)
+    (prin1 (screen-root-depth screen) stream)
+    (when (screen-root-visual-info screen)
+      (write-string " " stream)
+      (princ (visual-info-class (screen-root-visual-info screen)) stream))))
+
+(defun screen-root-visual (screen)
+  (declare (type screen screen)
+	   (values resource-id))
+  (visual-info-id (screen-root-visual-info screen)))
+
+;; The list contains alternating keywords and integers.
+(deftype font-props () 'list)
+
+(def-clx-class (font-info (:copier nil) (:predicate nil))
+  (direction :left-to-right :type draw-direction)
+  (min-char 0 :type card16)   ;; First character in font
+  (max-char 0 :type card16)   ;; Last character in font
+  (min-byte1 0 :type card8)   ;; The following are for 16 bit fonts
+  (max-byte1 0 :type card8)   ;; and specify min&max values for
+  (min-byte2 0 :type card8)   ;; the two character bytes
+  (max-byte2 0 :type card8)
+  (all-chars-exist-p nil :type boolean)
+  (default-char 0 :type card16)
+  (min-bounds nil :type (or null vector))
+  (max-bounds nil :type (or null vector))
+  (ascent 0 :type int16)
+  (descent 0 :type int16)
+  (properties nil :type font-props))
+
+(def-clx-class (font (:constructor make-font-internal) (:copier nil)
+		     (:print-function print-font))
+  (id-internal nil :type (or null resource-id)) ;; NIL when not opened
+  (display nil :type (or null display))
+  (reference-count 0 :type fixnum)
+  (name "" :type (or null string)) ;; NIL when ID is for a GContext
+  (font-info-internal nil :type (or null font-info))
+  (char-infos-internal nil :type (or null (simple-array int16 (*))))
+  (local-only-p t :type boolean) ;; When T, always calculate text extents locally
+  (plist nil :type list)			; Extension hook
+  )
+
+(defun print-font (font stream depth)
+  (declare (type font font)
+	   (ignore depth))
+  (print-unreadable-object (font stream :type t)
+    (if (font-name font)
+	(princ (font-name font) stream)
+      (write-string "(gcontext)" stream))
+    (write-string " " stream)
+    (print-display-name (font-display font) stream)
+    (when (font-id-internal font)
+      (write-string " " stream)
+      (prin1 (font-id font) stream))))
+
+(defun font-id (font)
+  ;; Get font-id, opening font if needed
+  (or (font-id-internal font)
+      (open-font-internal font)))
+
+(defun font-font-info (font)
+  (or (font-font-info-internal font)
+      (query-font font)))
+
+(defun font-char-infos (font)
+  (or (font-char-infos-internal font)
+      (progn (query-font font)
+	     (font-char-infos-internal font))))
+
+(defun make-font (&key id
+		  display
+		  (reference-count 0)
+		  (name "")
+		  (local-only-p t)
+		  font-info-internal)
+  (make-font-internal :id-internal id
+		      :display display
+		      :reference-count reference-count
+		      :name name
+		      :local-only-p local-only-p
+		      :font-info-internal font-info-internal))
+
+; For each component (<name> <unspec> :type <type>) of font-info,
+; there is a corresponding function:
+
+;(defun font-<name> (font)
+;  (declare (type font font)
+;	   (values <type>)))
+
+(macrolet ((make-font-info-accessors (useless-name &body fields)
+	     `(within-definition (,useless-name make-font-info-accessors)
+		,@(mapcar
+		    #'(lambda (field)
+			(let* ((type (second field))
+			       (n (string (first field)))
+			       (name (xintern 'font- n))
+			       (accessor (xintern 'font-info- n)))
+			  `(defun ,name (font)
+			     (declare (type font font))
+			     (declare (values ,type))
+			     (,accessor (font-font-info font)))))
+		    fields))))
+  (make-font-info-accessors ignore
+    (direction draw-direction)
+    (min-char card16)
+    (max-char card16)
+    (min-byte1 card8)
+    (max-byte1 card8)
+    (min-byte2 card8)
+    (max-byte2 card8)
+    (all-chars-exist-p boolean)
+    (default-char card16)
+    (min-bounds vector)
+    (max-bounds vector)
+    (ascent int16)
+    (descent int16)
+    (properties font-props)))
+
+(defun font-property (font name)
+  (declare (type font font)
+	   (type keyword name))
+  (declare (values (or null int32)))
+  (getf (font-properties font) name))
+
+(macrolet ((make-mumble-equal (type)
+	     ;; When cached, EQ works fine, otherwise test resource id's and displays
+	     (let ((predicate (xintern type '-equal))
+		   (id (xintern type '-id))
+		   (dpy (xintern type '-display)))
+	       (if (member type *clx-cached-types*)
+		   `(within-definition (,type make-mumble-equal)
+		      (declaim (inline ,predicate))
+		      (defun ,predicate (a b) (eq a b)))
+		   `(within-definition (,type make-mumble-equal)
+		      (defun ,predicate (a b)
+			(declare (type ,type a b))
+			(and (= (,id a) (,id b))
+			     (eq (,dpy a) (,dpy b)))))))))
+  (make-mumble-equal window)
+  (make-mumble-equal pixmap)
+  (make-mumble-equal cursor)
+  (make-mumble-equal font)
+  (make-mumble-equal gcontext)
+  (make-mumble-equal colormap)
+  (make-mumble-equal drawable))
+
+;;;
+;;; Event-mask encode/decode functions
+;;;    Converts from keyword-lists to integer and back
+;;;
+(defun encode-mask (key-vector key-list key-type)
+  ;; KEY-VECTOR is a vector containg bit-position keywords.  The position of the
+  ;; keyword in the vector indicates its bit position in the resulting mask
+  ;; KEY-LIST is either a mask or a list of KEY-TYPE
+  ;; Returns NIL when KEY-LIST is not a list or mask.
+  (declare (type (simple-array keyword (*)) key-vector)
+	   (type (or mask32 list) key-list))
+  (declare (values (or mask32 null)))
+  (typecase key-list
+    (mask32 key-list)
+    (list (let ((mask 0))
+	    (dolist (key key-list mask)
+	      (let ((bit (position key (the vector key-vector) :test #'eq)))
+		(unless bit
+		  (x-type-error key key-type))
+		(setq mask (logior mask (ash 1 bit)))))))))
+
+(defun decode-mask (key-vector mask)
+  (declare (type (simple-array keyword (*)) key-vector)
+	   (type mask32 mask))
+  (declare (values list))
+  (do ((m mask (ash m -1))
+       (bit 0 (1+ bit))
+       (len (length key-vector))
+       (result nil))       
+      ((or (zerop m) (>= bit len)) result)
+    (declare (type mask32 m)
+	     (fixnum bit len)
+	     (list result))
+    (when (oddp m)
+      (push (aref key-vector bit) result))))
+
+(defun encode-event-mask (event-mask)
+  (declare (type event-mask event-mask))
+  (declare (values mask32))
+  (or (encode-mask *event-mask-vector* event-mask 'event-mask-class)
+      (x-type-error event-mask 'event-mask)))
+
+(defun make-event-mask (&rest keys)
+  ;; This is only defined for core events.
+  ;; Useful for constructing event-mask, pointer-event-mask, device-event-mask.
+  (declare (type list keys)) ;; (list event-mask-class)
+  (declare (values mask32))
+  (encode-mask *event-mask-vector* keys 'event-mask-class))
+
+(defun make-event-keys (event-mask)
+  ;; This is only defined for core events.
+  (declare (type mask32 event-mask))
+  (declare (values (list event-mask-class)))
+  (decode-mask *event-mask-vector* event-mask))
+
+(defun encode-device-event-mask (device-event-mask)
+  (declare (type device-event-mask device-event-mask))
+  (declare (values mask32))
+  (or (encode-mask *device-event-mask-vector* device-event-mask
+		   'device-event-mask-class)
+      (x-type-error device-event-mask 'device-event-mask)))
+
+(defun encode-modifier-mask (modifier-mask)
+  (declare (type modifier-mask modifier-mask)) ;; (list state-mask-key)
+  (declare (values mask16))
+  (or (encode-mask *state-mask-vector* modifier-mask 'modifier-key)
+      (and (eq modifier-mask :any) #x8000)
+      (x-type-error modifier-mask 'modifier-mask)))
+
+(defun encode-state-mask (state-mask)
+  (declare (type (or mask16 list) state-mask)) ;; (list state-mask-key)
+  (declare (values mask16))
+  (or (encode-mask *state-mask-vector* state-mask 'state-mask-key)
+      (x-type-error state-mask '(or mask16 (list state-mask-key)))))
+
+(defun make-state-mask (&rest keys)
+  ;; Useful for constructing modifier-mask, state-mask.
+  (declare (type list keys)) ;; (list state-mask-key)
+  (declare (values mask16))
+  (encode-mask *state-mask-vector* keys 'state-mask-key))
+
+(defun make-state-keys (state-mask)
+  (declare (type mask16 state-mask))
+  (declare (values (list state-mask-key)))
+  (decode-mask *state-mask-vector* state-mask))
+
+(defun encode-pointer-event-mask (pointer-event-mask)
+  (declare (type pointer-event-mask pointer-event-mask))
+  (declare (values mask32))
+  (or (encode-mask *pointer-event-mask-vector* pointer-event-mask
+		   'pointer-event-mask-class)
+      (x-type-error pointer-event-mask 'pointer-event-mask)))
diff --git a/src/clx/cmpinit.lsp b/src/clx/cmpinit.lsp
new file mode 100644
index 000000000..9b1086285
--- /dev/null
+++ b/src/clx/cmpinit.lsp
@@ -0,0 +1,7 @@
+(defvar std-compile (symbol-function 'compile-file))
+(defun compile-file (file &rest args &key (output-file 'T))
+  (funcall std-compile
+	   file
+	   :c-file t :h-file t :data-file t
+	   :output-file output-file))
+
diff --git a/src/clx/defsys.lsp.in b/src/clx/defsys.lsp.in
new file mode 100644
index 000000000..ab9bf375a
--- /dev/null
+++ b/src/clx/defsys.lsp.in
@@ -0,0 +1,64 @@
+;;;;  Copyright (c) 1992, Giuseppe Attardi.
+;;;;
+;;;;    ECoLisp is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file "../Copyright" for full details.
+;;
+;;
+;; #+PDE (setq si:*record-source-pathname-p* t)
+;;
+;;; ----------------------------------------------------------------------
+;;;	CLX
+;;; ----------------------------------------------------------------------
+;;
+(sbt:defsystem
+ clx
+;;
+ :modules
+;;
+;;; file           load             compile           files which force
+;;;                environment      environment       recompilations of
+;;;                                                   this file
+ (quote ((package         t	            t                        ())
+   (ecldep         (package)        t	             	     ())
+   (depdefs        (package ecldep) (package ecldep)         (ecldep))
+   (clxmain	   (depdefs)        (depdefs)	             (depdefs))
+   (dependent	   (clxmain)	    (clxmain)	             (clxmain))
+   (macros    	   (dependent)      (dependent)	             (dependent))
+   (bufmac   	   (macros)	    (macros)		     (macros))
+   (buffer         t                (macros bufmac)          ())
+   (display        t                (macros bufmac buffer)   (macros))
+   (gcontext       (display)        (macros bufmac buffer
+					    display)         (display))
+   (input          (display depdefs)(macros bufmac buffer
+					    display depdefs) (display
+							      depdefs))
+   (requests       (display)        (macros bufmac buffer
+					    display gcontext)(display))
+   (fonts          (display)        (macros bufmac buffer
+					    display)         (display))
+   (graphics       (fonts)          (macros bufmac buffer
+					    fonts)           (display fonts))
+   (text           (fonts gcontext) (macros bufmac buffer
+					    fonts gcontext)  (gcontext fonts
+							       display))
+   (attributes     (display)        (macros bufmac buffer
+					    display)         (display))
+   (translate      (display)        (macros bufmac buffer
+					    display text)    (display))
+   (keysyms        (translate)      (buffer translate)       (translate
+							      display))
+   (manager        (clxmain)        (clxmain macros bufmac)  (display))
+   (image          (display)        (macros bufmac buffer
+					    display)         (display))
+   (resource       (display)        (macros bufmac buffer
+					    display)         (display))))
+;;
+ :source-directory "@srcdir@/"
+ :fasl-directory "./"
+ :library-directory "../")
+;;
+;;; ----------------------------------------------------------------------
diff --git a/src/clx/defsystem.lsp b/src/clx/defsystem.lsp
new file mode 100644
index 000000000..f9c6448be
--- /dev/null
+++ b/src/clx/defsystem.lsp
@@ -0,0 +1,512 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Base: 10; Lowercase: T;  -*-
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Portions Copyright (C) 1987 Texas Instruments Incorporated.
+;;; Portions Copyright (C) 1988, 1989 Franz Inc, Berkeley, Ca.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+;;; Franz Incorporated provides this software "as is" without express or
+;;; implied warranty.
+
+;;; #+ features used in this file
+;;;   clx-ansi-common-lisp
+;;;   lispm
+;;;   genera
+;;;   minima
+;;;   lucid
+;;;   lcl3.0
+;;;   apollo
+;;;   kcl
+;;;   ibcl
+;;;   excl
+
+#+(or Genera Minima)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (common-lisp:pushnew :clx-ansi-common-lisp common-lisp:*features*))
+
+#+(and Genera clx-ansi-common-lisp)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* si:*ansi-common-lisp-readtable*))
+
+#-clx-ansi-common-lisp 
+(lisp:in-package :user)
+
+#+clx-ansi-common-lisp
+(common-lisp:in-package :common-lisp-user)
+
+
+;;;; Lisp Machines
+
+#+(and lispm (not genera))
+(global:defsystem CLX
+  (:pathname-default "clx:clx;")
+  (:patchable "clx:patch;" clx-ti)
+  (:initial-status :experimental)
+
+  (:module package "package")
+  (:module depdefs "depdefs")
+  (:module clx "clx")
+  (:module dependent "dependent")
+  (:module macros "macros")
+  (:module bufmac "bufmac")
+  (:module buffer "buffer")
+  (:module display "display")
+  (:module gcontext "gcontext")
+  (:module requests "requests")
+  (:module input "input")
+  (:module fonts "fonts")
+  (:module graphics "graphics")
+  (:module text "text")
+  (:module attributes "attributes")
+  (:module translate "translate")
+  (:module keysyms "keysyms")
+  (:module manager "manager")
+  (:module image "image")
+  (:module resource "resource")
+  (:module doc "doc")
+
+  (:compile-load package)
+  (:compile-load depdefs
+   (:fasload package))
+  (:compile-load clx
+   (:fasload package depdefs))
+  (:compile-load dependent
+   (:fasload package depdefs clx))
+  ;; Macros only needed for compilation
+  (:skip :compile-load macros
+   (:fasload package depdefs clx dependent))
+  ;; Bufmac only needed for compilation
+  (:skip :compile-load bufmac
+   (:fasload package depdefs clx dependent macros))
+  (:compile-load buffer
+   (:fasload package depdefs clx dependent macros bufmac))
+  (:compile-load display
+   (:fasload package depdefs clx dependent macros bufmac buffer))
+  (:compile-load gcontext
+   (:fasload package depdefs clx dependent macros bufmac buffer display))
+  (:compile-load input
+   (:fasload package depdefs clx dependent macros bufmac buffer display))
+  (:compile-load requests
+   (:fasload package depdefs clx dependent macros bufmac buffer display input))
+  (:compile-load fonts
+   (:fasload package depdefs clx dependent macros bufmac buffer display))
+  (:compile-load graphics
+   (:fasload package depdefs clx dependent macros fonts bufmac buffer display
+	     fonts))
+  (:compile-load text
+   (:fasload package depdefs clx dependent macros fonts bufmac buffer display
+	     gcontext fonts))
+  (:compile-load-init attributes
+   (dependent)
+   (:fasload package depdefs clx dependent macros bufmac buffer display))
+  (:compile-load translate
+   (:fasload package depdefs clx dependent macros bufmac buffer display))
+  (:compile-load keysyms
+   (:fasload package depdefs clx dependent macros bufmac buffer display
+	     translate))
+  (:compile-load manager
+   (:fasload package depdefs clx dependent macros bufmac buffer display))
+  (:compile-load image
+   (:fasload package depdefs clx dependent macros bufmac buffer display))
+  (:compile-load resource
+   (:fasload package depdefs clx dependent macros bufmac buffer display))
+  (:auxiliary doc)
+  )
+
+
+;;; Symbolics Lisp Machines
+#+Genera
+(scl:defsystem CLX
+    (:default-pathname "SYS:X11;CLX;"
+     :pretty-name "CLX"
+     :maintaining-sites (:scrc)
+     :distribute-sources t
+     :distribute-binaries t
+     :source-category :basic)
+  (:module doc ("doc")
+	   (:type :lisp-example))
+  (:serial
+    "package" "depdefs" "generalock" "clx" "dependent" "macros" "bufmac"
+    "buffer" "display" "gcontext" "input" "requests" "fonts" "graphics"
+    "text" "attributes" "translate" "keysyms" "manager" "image" "resource"))
+
+
+;;; Franz
+
+;;
+;; The following is a suggestion.  If you comment out this form be
+;; prepared for possible deadlock, since no interrupts will be recognized
+;; while reading from the X socket if the scheduler is not running.
+;;
+#+excl
+(setq compiler::generate-interrupt-checks-switch
+      (compile nil
+	       '(lambda (safety size speed &optional debug)
+		  (declare (ignore size debug))
+		  (or (< speed 3) (> safety 0)))))
+
+
+;;; Allegro
+
+#+allegro
+(excl:defsystem :clx 
+  ()
+  |package|
+  (|excldep|
+    :load-before-compile (|package|)
+    :recompile-on (|package|))
+  (|depdefs|
+    :load-before-compile (|package| |excldep|)
+    :recompile-on (|excldep|))
+  (|clx|
+    :load-before-compile (|package| |excldep| |depdefs|)
+    :recompile-on (|package| |excldep| |depdefs|))
+  (|dependent|
+    :load-before-compile (|package| |excldep| |depdefs| |clx|)
+    :recompile-on (|clx|))
+  (|exclcmac|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|)
+    :recompile-on (|dependent|))
+  (|macros|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac|)
+    :recompile-on (|exclcmac|))
+  (|bufmac|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros|)
+    :recompile-on (|macros|))
+  (|buffer|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac|)
+    :recompile-on (|bufmac|))
+  (|display|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer|)
+    :recompile-on (|buffer|))
+  (|gcontext|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|)
+    :recompile-on (|display|))
+  (|input|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|)
+    :recompile-on (|display|))
+  (|requests|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|
+			  |input|)
+    :recompile-on (|display|))
+  (|fonts|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|)
+    :recompile-on (|display|))
+  (|graphics|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|
+			  |fonts|)
+    :recompile-on (|fonts|))
+  (|text|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|
+			  |gcontext| |fonts|)
+    :recompile-on (|gcontext| |fonts|)
+    :load-after (|translate|))
+  ;; The above line gets around a compiler macro expansion bug.
+  
+  (|attributes|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|)
+    :recompile-on (|display|))
+  (|translate|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|
+			  |text|)
+    :recompile-on (|display|))
+  (|keysyms|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|
+			  |translate|)
+    :recompile-on (|translate|))
+  (|manager|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|)
+    :recompile-on (|display|))
+  (|image|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|)
+    :recompile-on (|display|))
+  
+  ;; Don't know if l-b-c list is correct.  XX
+  (|resource|
+    :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
+			  |exclcmac| |macros| |bufmac| |buffer| |display|)
+    :recompile-on (|display|))
+  )
+
+#+allegro
+(excl:defsystem :clx-debug
+    (:default-pathname "debug/"
+     :needed-systems (:clx)
+     :load-before-compile (:clx))
+  |describe| |keytrans| |trace| |util|)
+
+
+;;;; Compile CLX
+
+;;; COMPILE-CLX compiles the lisp source files and loads the binaries.
+;;; It goes to some trouble to let the source files be in one directory
+;;; and the binary files in another.  Thus the same set of sources can
+;;; be used for different machines and/or lisp systems.  It also allows
+;;; you to supply explicit extensions, so source files do not have to
+;;; be renamed to fit into the naming conventions of an implementation.
+
+;;; For example,
+;;;     (compile-clx "*.lisp" "machine/")
+;;; compiles source files from the connected directory and puts them
+;;; into the "machine" subdirectory.  You can then load CLX out of the
+;;; machine directory.
+
+;;; The code has no knowledge of the source file types (eg, ".l" or
+;;; ".lisp") or of the binary file types (eg, ".b" or ".sbin").  Calling
+;;; compile-file and load with a file type of NIL usually sorts things
+;;; out correctly, but you may have to explicitly give the source and
+;;; binary file types.
+
+;;; An attempt at compiling the C language sources is also made,
+;;; but you may have to set different compiler switches
+;;; should be.  If it doesn't do the right thing, then do
+;;;     (compile-clx "" "" :compile-c NIL)
+;;; to prevent the compilation.
+
+;;; compilation notes
+;;;   lucid2.0/hp9000s300
+;;;     must uudecode the file make-sequence-patch.uu
+
+#+(or lucid kcl ibcl)
+(defun clx-foreign-files (binary-path)
+
+  #+(and lucid (not lcl3.0) (or mc68000 mc68020))
+  (load (merge-pathnames "make-sequence-patch" binary-path))
+
+  #+(and lucid apollo)
+  (lucid::load-foreign-file
+    (namestring (merge-pathnames "socket" binary-path))
+    :preserve-pathname t)
+
+  #+(and lucid (not apollo))
+  (lucid::load-foreign-files
+    (list (namestring (merge-pathnames "socket.o" binary-path)))
+    '("-lc"))
+
+  #+(or kcl ibcl)
+  (progn
+    (let ((pathname (merge-pathnames "sockcl.o" binary-path))
+	  (options
+	    (concatenate
+	      'string
+	      (namestring (merge-pathnames "socket.o" binary-path))
+	      " -lc")))
+      (format t "~&Faslinking ~A with ~A.~%" pathname options)
+      (si:faslink (namestring pathname) options)
+      (format t "~&Finished faslinking ~A.~%" pathname)))
+  )
+
+#-(or lispm allegro)
+(defun compile-clx (&optional
+		    (source-pathname-defaults "")
+		    (binary-pathname-defaults "")
+		    &key
+		    (compile-c t))
+
+  ;; The pathname-defaults above might only be strings, so coerce them
+  ;; to pathnames.  Build a default binary path with every component
+  ;; of the source except the file type.  This should prevent
+  ;; (compile-clx "*.lisp") from destroying source files.
+  (let* ((source-path (pathname source-pathname-defaults))
+	 (path        (make-pathname
+			:host      (pathname-host      source-path)
+			:device    (pathname-device    source-path)
+			:directory (pathname-directory source-path)
+			:name      (pathname-name      source-path)
+			:type      nil
+			:version   (pathname-version   source-path)))
+	 (binary-path (merge-pathnames binary-pathname-defaults
+				       path))
+	 #+clx-ansi-common-lisp (*compile-verbose* t)
+	 (*load-verbose* t))
+				       
+    ;; Make sure source-path and binary-path file types are distinct so
+    ;; we don't accidently overwrite the source files.  NIL should be an
+    ;; ok type, but anything else spells trouble.
+    (if (and (equal (pathname-type source-path)
+		    (pathname-type binary-path))
+	     (not (null (pathname-type binary-path))))
+	(error "Source and binary pathname defaults have same type ~s ~s"
+	       source-path binary-path))
+
+    (format t "~&;;; Default paths: ~s ~s~%" source-path binary-path)
+
+    ;; In lucid make sure we're using the compiler in production mode.
+    #+lcl3.0
+    (progn
+      (unless (member :pqc *features*)
+	(cerror
+	  "Go ahead anyway."
+	  "Lucid's production mode compiler must be loaded to compile CLX."))
+      (proclaim '(optimize (speed 3)
+			   (safety 1)
+			   (space 0)
+			   (compilation-speed 0))))
+
+    (labels ((compile-lisp (filename)
+	       (let ((source (merge-pathnames filename source-path))
+		     (binary (merge-pathnames filename binary-path)))
+		 ;; If the source and binary pathnames are the same,
+		 ;; then don't supply an output file just to be sure
+		 ;; compile-file defaults correctly.
+		 #+(or kcl ibcl) (load source)
+		 (if (equal source binary)
+		     (compile-file source)
+		   (compile-file source :output-file binary))
+		 binary))
+	     (compile-and-load (filename)
+	       (load (compile-lisp filename)))
+	     #+(or lucid kcl ibcl)
+	     (compile-c (filename)
+	       (let* ((c-filename (concatenate 'string filename ".c"))
+		      (o-filename (concatenate 'string filename ".o"))
+		      (src (merge-pathnames c-filename source-path))
+		      (obj  (merge-pathnames o-filename binary-path))
+		      (args (list "-c" (namestring src)
+				  "-o" (namestring obj)
+				  #+mips "-G 0"
+				  #+(or hp sysv) "-DSYSV"
+				  #+(and mips (not dec)) "-I/usr/include/bsd"
+				  #-(and mips (not dec)) "-DUNIXCONN"
+				  #+(and lucid pa) "-DHPUX -DHPUX7.0"
+				  )))
+		 (format t ";;; cc~{ ~A~}~%" args)
+		 (unless
+		   (zerop 
+		     #+lucid
+		     (multiple-value-bind (iostream estream exitstatus pid)
+			 ;; in 2.0, run-program is exported from system:
+			 ;; in 3.0, run-program is exported from lcl:
+			 ;; system inheirits lcl
+			 (system::run-program "cc" :arguments args)
+		       (declare (ignore iostream estream pid))
+		       exitstatus)
+		     #+(or kcl ibcl)
+		     (system (format nil "cc~{ ~A~}" args)))
+		   (error "Compile of ~A failed." src)))))
+
+      ;; Now compile and load all the files.
+      ;; Defer compiler warnings until everything's compiled, if possible.
+      (#+clx-ansi-common-lisp with-compilation-unit
+       #+lcl3.0 lucid::with-deferred-warnings
+       #-(or lcl3.0 clx-ansi-common-lisp) progn
+       ()
+       
+       (compile-and-load "package")
+       #+(or lucid kcl ibcl) (when compile-c (compile-c "socket"))
+       #+(or kcl ibcl) (compile-lisp "sockcl")
+       #+(or lucid kcl ibcl) (clx-foreign-files binary-path)
+       #+excl (compile-and-load "excldep")
+       (compile-and-load "depdefs")
+       (compile-and-load "clx")
+       (compile-and-load "dependent")
+       #+excl (compile-and-load "exclcmac")	; these are just macros
+       (compile-and-load "macros")		; these are just macros
+       (compile-and-load "bufmac")		; these are just macros
+       (compile-and-load "buffer")
+       (compile-and-load "display")
+       (compile-and-load "gcontext")
+       (compile-and-load "input")
+       (compile-and-load "requests")
+       (compile-and-load "fonts")
+       (compile-and-load "graphics")
+       (compile-and-load "text")
+       (compile-and-load "attributes")
+       (compile-and-load "translate")
+       (compile-and-load "keysyms")
+       (compile-and-load "manager")
+       (compile-and-load "image")
+       (compile-and-load "resource")
+       ))))
+
+
+;;;; Load CLX
+
+;;; This procedure loads the binaries for CLX.  All of the binaries
+;;; should be in the same directory, so setting the default pathname
+;;; should point load to the right place.
+
+;;; You should have a module definition somewhere so the require/provide
+;;; mechanism can avoid reloading CLX.  In an ideal world, somebody would
+;;; just put
+;;;		(REQUIRE 'CLX)
+;;; in their file (some implementations don't have a central registry for
+;;; modules, so a pathname needs to be supplied).
+
+;;; The REQUIRE should find a file that does
+;;;		(IN-PACKAGE 'XLIB :USE '(LISP))
+;;;		(PROVIDE 'CLX)
+;;;		(LOAD <clx-defsystem-file>)
+;;;		(LOAD-CLX <binary-specific-clx-directory>)
+
+#-(or lispm allegro)
+(defun load-clx (&optional (binary-pathname-defaults "")
+		 &key (macrosp nil))
+
+  (let* ((source-path (pathname ""))
+	 (path        (make-pathname
+			:host      (pathname-host      source-path)
+			:device    (pathname-device    source-path)
+			:directory (pathname-directory source-path)
+			:name      (pathname-name      source-path)
+			:type      nil
+			:version   (pathname-version   source-path)))
+	 (binary-path (merge-pathnames binary-pathname-defaults
+				       path))
+	 (*load-verbose* t))
+
+    (flet ((load-binary (filename)
+	     (let ((binary (merge-pathnames filename binary-path)))
+	       (load binary))))
+
+      (load-binary "package")
+      #+(or lucid kcl ibcl) (clx-foreign-files binary-path)
+      #+excl (load-binary "excldep")
+      (load-binary "depdefs")
+      (load-binary "clx")
+      (load-binary "dependent")
+      (when macrosp
+	#+excl (load-binary "exclcmac")
+	(load-binary "macros")
+	(load-binary "bufmac"))
+      (load-binary "buffer")
+      (load-binary "display")
+      (load-binary "gcontext")
+      (load-binary "input")
+      (load-binary "requests")
+      (load-binary "fonts")
+      (load-binary "graphics")
+      (load-binary "text")
+      (load-binary "attributes")
+      (load-binary "translate")
+      (load-binary "keysyms")
+      (load-binary "manager")
+      (load-binary "image")
+      (load-binary "resource")
+      )))
diff --git a/src/clx/demo/cmu.lsp b/src/clx/demo/cmu.lsp
new file mode 100644
index 000000000..af1a24bd6
--- /dev/null
+++ b/src/clx/demo/cmu.lsp
@@ -0,0 +1,1117 @@
+;;; Received from: Bill.Chiles@WB1.CS.CMU.EDU
+;;; -*- Mode: Lisp; Package: Demos -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie-Mellon University, and has been placed in the public domain.
+;;; CMU Common Lisp is currently incomplete and under active development.
+;;; If you want to use this code or any part of CMU Common Lisp, please
+;;; contact Scott Fahlman (FAHLMAN@CMUC). 
+;;; **********************************************************************
+;;;
+;;; This file contains various graphics hacks written and ported over the
+;;; years by various and numerous persons.
+;;;
+;;; This file should be portable to any valid Common Lisp with CLX -- DEC 88.
+;;;
+
+(in-package "DEMOS" :use '("LISP" "XLIB"))
+
+(export '(do-all-demos demo))
+
+
+;;;; Graphic demos wrapper macro.
+
+;;; This wrapper macro should be reconsidered with respect to its property
+;;; list usage.  Possibly a demo structure should be used with *demos*
+;;; pointing to these instead of function names.  Also, something should
+;;; be done about a title window that displays the name of the demo while
+;;; it is running.
+
+(defparameter *demos* nil)
+
+(defvar *host* (machine-instance))	; set this properly
+
+(defvar *display* nil)
+(defvar *screen* nil)
+(defvar *root* nil)
+(defvar *white-pixel* nil)
+(defvar *black-pixel* nil)
+(defvar *window* nil)
+
+;;; ----------------------------------------------------------------------
+;;; Color support. Beppe
+
+;;; Use this for color displays:
+(eval-when (load compile eval) (pushnew 'color *features*))
+
+(defvar *colormap*)
+(defvar *colors* (make-array 10 :element-type 'stringable
+                             :initial-contents '("white" "black" "red" "green"
+                                                 "blue" "yellow" "orange" 
+						 "brown" "gray" "violet")))
+
+(defvar *color-pixels* (make-array 10 :element-type 'pixel))
+
+(defun create-colors ()
+  (let* ((colormap (xlib:screen-default-colormap *screen*)))
+    (dotimes (i (length *color-pixels*))
+      (setf (aref *color-pixels* i)
+	    (xlib:alloc-color colormap (aref *colors* i))))
+    (values colormap)))
+
+;;; ----------------------------------------------------------------------
+
+(defmacro defdemo (fun-name demo-name args x y width height background doc &rest forms)
+  `(progn
+     (defun ,fun-name ,args
+       ,doc
+       (cond (*display*
+	      (xlib:with-state (*window*)
+		(setf (xlib:drawable-x *window*) ,x)
+		(setf (xlib:drawable-y *window*) ,y)
+		(setf (xlib:drawable-width *window*) ,width)
+		(setf (xlib:drawable-height *window*) ,height)))
+	     (t
+	      #+:cmu
+	      (multiple-value-setq (*display* *screen*) (ext:open-clx-display))
+	      #-:cmu
+	      (progn
+		;; Portable method
+		(setf *display* (xlib:open-display *host*))
+		(setf *screen* (xlib:display-default-screen *display*)))
+	      (setf *root* (xlib:screen-root *screen*))
+	      (setf *black-pixel* (xlib:screen-black-pixel *screen*))
+	      (setf *white-pixel* (xlib:screen-white-pixel *screen*))
+	      #+COLOR
+	      (setq *colormap* (create-colors))
+	      (setf *window* (xlib:create-window :parent *root*
+						 :x ,x :y ,y
+						 :event-mask nil
+						 :width ,width :height ,height
+						 :background ,background
+						 :border *black-pixel*
+						 #+COLOR
+						 :colormap #+COLOR *colormap*
+						 :border-width 2
+						 ))))
+       (xlib:map-window *window*)
+       ;; 
+       ;; I hate to do this since this is not something any normal
+       ;; program should do ...
+       (setf (xlib:window-priority *window*) :above)
+       (xlib:display-finish-output *display*)
+       (unwind-protect
+	   (progn ,@forms)
+	 (xlib:unmap-window *window*)
+	 (xlib:display-finish-output *display*))
+       nil)				; unwind-protect bug in DCL.
+     (setf (get ',fun-name 'demo-name) ',demo-name)
+     (setf (get ',fun-name 'demo-doc) ',doc)
+     (export ',fun-name)
+     (pushnew ',fun-name *demos*)
+     ',fun-name))
+
+
+;;;; Main entry points.
+
+(defun do-all-demos ()
+  (dolist (demo *demos*)
+    (funcall demo)
+    (sleep 3)))
+
+;;; DEMO is a hack to get by.  It should be based on creating a menu.  At
+;;; that time, *name-to-function* should be deleted, since this mapping will
+;;; be manifested in the menu slot name cross its action.  Also the
+;;; "Shove-bounce" demo should be renamed to "Shove bounce"; likewise for
+;;; "Fast-towers-of-Hanoi" and "Slow-towers-of-hanoi".
+;;;
+
+(defvar *name-to-function* (make-hash-table :test #'eq))
+(defvar *keyword-package* (find-package "KEYWORD"))
+
+(defun demo ()
+  (macrolet ((read-demo ()
+	       `(let ((*package* *keyword-package*))
+		 (read))))
+    (dolist (d *demos*)
+      (setf (gethash (intern (string-upcase (get d 'demo-name))
+			     *keyword-package*)
+		     *name-to-function*)
+	    d))
+    (loop
+     (fresh-line)
+     (dolist (d *demos*)
+       (write-string "   ")
+       (write-line (get d 'demo-name)))
+     (write-string "   ")
+     (write-line "Help <demo name>")
+     (write-string "   ")
+     (write-line "Quit")
+     (write-string "Enter demo name: ")
+     (let ((demo (read-demo)))
+       (case demo
+	 (:help
+	  (let* ((demo (read-demo))
+		 (fun (gethash demo *name-to-function*)))
+	    (fresh-line)
+	    (if fun
+		(format t "~&~%~A~&~%" (get fun 'demo-doc))
+		(format t "Unknown demo name -- ~A." demo))))
+	 (:quit (return t))
+	 (t
+	  (let ((fun (gethash demo *name-to-function*)))
+	    (if fun
+		(funcall fun)
+		(format t "~&~%Unknown demo name -- ~A.~&~%" demo)))))))))
+
+
+;;;; Shared demo utilities.
+
+(defun full-window-state (w)
+  (xlib:with-state (w)
+    (values (xlib:drawable-width w) (xlib:drawable-height w)
+	    (xlib:drawable-x w) (xlib:drawable-y w)
+	    (xlib:window-map-state w))))
+
+
+;;;; Greynetic.
+
+;;; GREYNETIC displays random sized and shaded boxes in a window.  This is
+;;; real slow.  It needs work.
+;;; 
+
+(defun greynetic (window duration background foreground)
+  (let* ((pixmap (xlib:create-pixmap :width 32 :height 32
+				     :depth (xlib:drawable-depth window)
+				     :drawable window))
+	 (gcontext (xlib:create-gcontext :drawable window
+					 :background background
+					 :foreground foreground
+					 :tile pixmap
+					 :fill-style :tiled)))
+    (multiple-value-bind (width height) (full-window-state window)
+      (dotimes (i duration)
+	(let* ((pixmap-data (greynetic-pixmapper))
+	       (image (xlib:create-image :width 32 :height 32
+					 :depth 1 :data pixmap-data)))
+	  (xlib:put-image pixmap gcontext image :x 0 :y 0 :width 32 :height 32
+ 			  #+COLOR :bitmap-p #+COLOR t)
+	  (xlib:draw-rectangle window gcontext
+			       (- (random width) 5)
+			       (- (random height) 5)
+			       (+ 4 (random (truncate width 3)))
+			       (+ 4 (random (truncate height 3)))
+			       t))
+	(xlib:display-force-output *display*)))
+    (xlib:free-gcontext gcontext)
+    (xlib:free-pixmap pixmap)))
+
+(defvar *greynetic-pixmap-array*
+  (make-array '(32 32) :initial-element 0 :element-type 'xlib:pixel))
+
+(defun greynetic-pixmapper ()
+  (let ((pixmap-data *greynetic-pixmap-array*))
+    (dotimes (i 4)
+      (declare (fixnum i))
+      (let ((nibble (random 16)))
+	(setf nibble (logior nibble (ash nibble 4))
+	      nibble (logior nibble (ash nibble 8))
+	      nibble (logior nibble (ash nibble 12))
+	      nibble (logior nibble (ash nibble 16)))
+	(dotimes (j 32)
+	  (let ((bit (if (logbitp j nibble) 1 0)))
+	    (setf (aref pixmap-data i j) bit
+		  (aref pixmap-data (+ 4 i) j) bit
+		  (aref pixmap-data (+ 8 i) j) bit
+		  (aref pixmap-data (+ 12 i) j) bit
+		  (aref pixmap-data (+ 16 i) j) bit
+		  (aref pixmap-data (+ 20 i) j) bit
+		  (aref pixmap-data (+ 24 i) j) bit
+		  (aref pixmap-data (+ 28 i) j) bit)))))
+    pixmap-data))
+
+(defdemo greynetic-demo "Greynetic" (&optional (duration 300))
+  100 100 600 600 (aref *color-pixels* 2)
+  "Displays random grey rectangles."
+  (greynetic *window* duration
+	     (aref *color-pixels* 8) (aref *color-pixels* 3)))
+
+
+;;;; Qix.
+
+(defstruct qix
+  buffer
+  (dx1 5 :type fixnum)			; Beppe
+  (dy1 10 :type fixnum)			; Beppe
+  (dx2 10 :type fixnum)			; Beppe
+  (dy2 5 :type fixnum))			; Beppe
+
+(defun construct-qix (length)
+  (let ((qix (make-qix)))
+    (setf (qix-buffer qix) (make-circular-list length))
+    qix))
+
+(defun make-circular-list (length)
+  (let ((l (make-list length)))
+    (rplacd (last l) l)))
+
+(defun qix (window lengths duration background foreground)
+  "Each length is the number of lines to put in a qix, and that many qix
+  (of the correct size) are put up on the screen.  Lets the qix wander around
+  the screen for Duration steps."
+  (declare (fixnum duration))		; Beppe
+  (let ((histories (mapcar #'construct-qix lengths)))
+    (multiple-value-bind (width height) (full-window-state window)
+      (declare (fixnum width height))
+      (xlib:clear-area window)
+      (xlib:display-force-output *display*)
+      (do ((h histories (cdr h))
+	   (l lengths (cdr l)))
+	  ((null h))
+	(do ((x (qix-buffer (car h)) (cdr x))
+	     (i 0 (1+ i)))
+	    ((= i (car l)))
+	  (rplaca x (make-array 4))))
+      ;; Start each qix at a random spot on the screen.
+      (dolist (h histories)
+	(let ((x (random width))
+	      (y (random height)))
+	  (rplaca (qix-buffer h)
+		  (make-array 4 :initial-contents (list x y x y)))))
+      (rplacd (last histories) histories)
+      (let ((x1 0) (y1 0) (x2 0) (y2 0) (dx1 0) (dy1 0) (dx2 0) (dy2 0)
+	    (tem 0) line next-line qix
+	    (gc (xlib:create-gcontext :drawable window
+				      :foreground foreground
+				      :background background
+				      :line-width 0 :line-style :solid
+				      :function boole-c2)))
+	(declare (fixnum x1 y1 x2 y2 dx1 dy1 dx2 dy2 tem)) ; Beppe
+	(declare (type (vector fixnum) line next-line)) ; Beppe
+	(dotimes (i duration)
+	  ;; Line is the next line in the next qix. Rotate this qix and
+	  ;; the qix ring.
+	  (setq qix (car histories))
+	  (setq line (car (qix-buffer qix)))
+	  (setq next-line (cadr (qix-buffer qix)))
+	  (setf (qix-buffer qix) (cdr (qix-buffer qix)))
+	  (setq histories (cdr histories))
+	  (setf x1 (svref line 0))
+	  (setf y1 (svref line 1))
+	  (setf x2 (svref line 2))
+	  (setf y2 (svref line 3))
+	  (xlib:draw-line window gc x1 y1 x2 y2)
+	  (setq dx1 (- (the fixnum (+ (qix-dx1 qix) (random 3))) 1)) ; Beppe
+	  (setq dy1 (- (the fixnum (+ (qix-dy1 qix) (random 3))) 1)) ; Beppe
+	  (setq dx2 (- (the fixnum (+ (qix-dx2 qix) (random 3))) 1)) ; Beppe
+	  (setq dy2 (- (the fixnum (+ (qix-dy2 qix) (random 3))) 1)) ; Beppe
+	  (cond ((> dx1 10) (setq dx1 10))
+		((< dx1 -10) (setq dx1 -10)))
+	  (cond ((> dy1 10) (setq dy1 10))
+		((< dy1 -10) (setq dy1 -10)))
+	  (cond ((> dx2 10) (setq dx2 10))
+		((< dx2 -10) (setq dx2 -10)))
+	  (cond ((> dy2 10) (setq dy2 10))
+		((< dy2 -10) (setq dy2 -10)))
+	  (cond ((or (>= (setq tem (+ x1 dx1)) width) (minusp tem))
+		 (setq dx1 (- dx1))))
+	  (cond ((or (>= (setq tem (+ x2 dx2)) width) (minusp tem))
+		 (setq dx2 (- dx2))))
+	  (cond ((or (>= (setq tem (+ y1 dy1)) height) (minusp tem))
+		 (setq dy1 (- dy1))))
+	  (cond ((or (>= (setq tem (+ y2 dy2)) height) (minusp tem))
+		 (setq dy2 (- dy2))))
+	  (setf (qix-dy2 qix) dy2)
+	  (setf (qix-dx2 qix) dx2)
+	  (setf (qix-dy1 qix) dy1)
+	  (setf (qix-dx1 qix) dx1)
+	  (when (svref next-line 0)
+	    (xlib:draw-line window gc
+			    (svref next-line 0) (svref next-line 1)
+			    (svref next-line 2) (svref next-line 3)))
+	  (setf (svref next-line 0) (the fixnum (+ x1 dx1))) ; Beppe
+	  (setf (svref next-line 1) (the fixnum (+ y1 dy1))) ; Beppe
+	  (setf (svref next-line 2) (the fixnum (+ x2 dx2))) ; Beppe
+	  (setf (svref next-line 3) (the fixnum (+ y2 dy2))) ; Beppe
+	  (xlib:display-force-output *display*))))))
+
+
+(defdemo qix-demo "Qix" (&optional (lengths '(30 30)) (duration 2000))
+  500 0 300 300 (aref *color-pixels* 4)
+  "Hypnotic wandering lines."
+  (qix *window* lengths duration
+       (aref *color-pixels* 5) (aref *color-pixels* 4)))
+
+
+;;;; Petal.
+
+
+;;; Fast sine constants:
+
+(defconstant d360 #o5500)
+(defconstant d270 #o4160)
+(defconstant d180 #o2640)
+(defconstant d90 #o1320)
+(defconstant vecmax 2880)
+
+(defconstant sin-array
+  '#(#o0 #o435 #o1073 #o1531 #o2166 #o2623 #o3260 
+     #o3714 #o4350 #o5003 #o5435 #o6066 #o6516 #o7145
+     #o7573 #o10220 #o10644 #o11266 #o11706 #o12326 
+     #o12743 #o13357 #o13771 #o14401 #o15007 #o15414
+     #o16016 #o16416 #o17013 #o17407 #o20000 #o20366
+     #o20752 #o21333 #o21711 #o22265 #o22636 #o23204
+     #o23546 #o24106 #o24443 #o24774 #o25323 #o25645
+     #o26165 #o26501 #o27011 #o27316 #o27617 #o30115
+     #o30406 #o30674 #o31156 #o31434 #o31706 #o32154
+     #o32416 #o32654 #o33106 #o33333 #o33554 #o33771
+     #o34202 #o34406 #o34605 #o35000 #o35167 #o35351
+     #o35526 #o35677 #o36043 #o36203 #o36336 #o36464
+     #o36605 #o36721 #o37031 #o37134 #o37231 #o37322
+     #o37407 #o37466 #o37540 #o37605 #o37646 #o37701
+     #o37730 #o37751 #o37766 #o37775 #o40000))
+(proclaim '(type (vector fixnum) sin-array)) ; Beppe
+
+(defmacro psin (val)
+  `(let* ((val ,val)
+	  neg
+	  (frac 0)
+	  (sinlo 0))
+    (declare (fixnum val frac sinlo))	; Beppe
+     (if (>= val d180)
+	 (setq neg t
+	       val (- val d180)))
+     (if (>= val d90)
+	 (setq val (- d180 val)))
+     (setq frac (the fixnum (logand val 7))) ; Beppe
+     (setq val (ash val -3))
+     ;; 
+     (setq sinlo (if (>= val 90)
+		     (svref sin-array 90)
+		     (svref sin-array val)))
+     ;; 
+     (if (< val 90)
+	 (setq sinlo
+	       (+ sinlo (ash (* frac (- (svref sin-array (1+ val)) sinlo))
+			     -3))))
+     ;; 
+     (if neg
+	 (- sinlo)
+	 sinlo)))
+
+(defmacro pcos (x)
+  `(let ((tmp (- ,x d270)))
+    (declare (fixnum tmp))		; Beppe
+    (psin (if (minusp tmp) (+ tmp d360) tmp))))
+
+
+;;;; Miscellaneous petal hackery.
+
+(defmacro high-16bits-* (a b)
+  `(let ((a-h (ash ,a -8))
+	 (b-h (ash ,b -8)))
+    (declare (fixnum a-h b-h))		; Beppe
+    (+ (* a-h b-h)
+     (ash (* a-h (the fixnum (logand ,b 255))) -8) ; Beppe
+     (ash (* b-h (the fixnum (logand ,a 255))) -8)))) ; Beppe
+
+(defun complete (style petal)
+  (declare (fixnum style petal))
+  (let ((repnum 1)
+	(factor 0) (cntval 0) (needed 0))
+    (declare (fixnum repnum factor cntval needed)) ; Beppe
+    (dotimes (i 3)
+      (case i
+	(0 (setq factor 2 cntval 6)) 
+	(1 (setq factor 3 cntval 2))
+	(2 (setq factor 5 cntval 1)))
+      (do ()
+	  ((or (minusp cntval) (not (zerop (rem style factor)))))
+	(setq repnum (* repnum factor))
+	(setq cntval (1- cntval))
+	(setq style (floor style factor))))
+    (setq needed (floor vecmax repnum))
+    (if (and (not (oddp needed)) (oddp petal)) (floor needed 2) needed)))
+
+
+;;;; Petal Parameters and Petal itself
+
+(defparameter continuous t)
+(defparameter styinc 2)
+(defparameter petinc 1)
+(defparameter scalfac-fac 8192)
+
+(defun petal (petal-window background foreground
+			   &optional (how-many 10) (style 0) (petal 0))
+  (let ((width 512)
+	(height 512))
+    (declare (fixnum width height))	; Beppe
+    (xlib:clear-area petal-window)
+    (xlib:display-force-output *display*)
+    (let ((veccnt 0)
+	  (nustyle 722)
+	  (nupetal 3)
+	  (scalfac (1+ (floor scalfac-fac (min width height))))
+	  (ctrx (floor width 2))
+	  (ctry (floor height 2))
+	  (tt 0)
+	  (s 0)
+	  (lststyle 0)
+	  (lstpetal 0)
+	  (petstyle 0)
+	  (vectors 0)
+	  (r 0)
+	  (x1 0)
+	  (y1 0)
+	  (x2 0)
+	  (y2 0)
+	  (i 0)
+	  (gc (xlib:create-gcontext :drawable petal-window
+				    :foreground foreground
+				    :background background
+				    :line-width 0 :line-style :solid)))
+      (declare (fixnum veccnt nustyle nupetal scalfac ctrx ctry tt s
+		       lststyle lstpetal petstyle vectors r x1 y1 x2
+		       y2 i)) ; Beppe
+      (loop
+	(when (zerop veccnt)
+	  (setq tt 0 s 0 lststyle style lstpetal petal petal nupetal
+		style nustyle petstyle (rem (* petal style) d360)
+		vectors (complete style petal))
+	  (when continuous
+	    (setq nupetal (+ nupetal petinc)
+		  nustyle (+ nustyle styinc)))
+	  (when (or (/= lststyle style) (/= lstpetal petal))
+	    (xlib:clear-area petal-window)
+	    (xlib:display-force-output *display*)))
+	(when (or (/= lststyle style) (/= lstpetal petal))
+	  (setq veccnt (1+ veccnt) i veccnt x1 x2 y1 y2
+		tt (rem (+ tt style) d360)
+		s (rem (+ s petstyle) d360)
+		r (pcos s))
+	  (setq x2 (+ ctrx (floor (high-16bits-* (pcos tt) r) scalfac))
+		y2 (+ ctry (floor (high-16bits-* (psin tt) r) scalfac)))
+	  (when (/= i 1)
+	    (xlib:draw-line petal-window gc x1 y1 x2 y2)
+	    (xlib:display-force-output *display*)))
+	(when (> veccnt vectors)
+	  (setq veccnt 0)
+	  (setq how-many (1- how-many))
+	  (sleep 2)
+	  (when (zerop how-many) (return)))))))
+
+(defdemo petal-demo "Petal" (&optional (how-many 10) (style 0) (petal 0))
+  100 100 512 512 (aref *color-pixels* 3)
+  "Flower-like display."
+  (petal *window* (aref *color-pixels* 3) (aref *color-pixels* 4)
+	 how-many style petal))
+
+
+;;;; Hanoi.
+
+;;; Random parameters:
+
+(defparameter disk-thickness 15 "The thickness of a disk in pixels.")
+(defparameter disk-spacing (+ disk-thickness 3)
+  "The amount of vertical space used by a disk on a needle.")
+(defvar *horizontal-velocity* 20 "The speed at which disks slide sideways.")
+(defvar *vertical-velocity* 12 "The speed at which disks move up and down.")
+
+;;; These variables are bound by the main function.
+
+(defvar *hanoi-window* () "The window that Hanoi is happening on.")
+(defvar *hanoi-window-height* () "The height of the viewport Hanoi is happening on.")
+(defvar *transfer-height* () "The height at which disks are transferred.")
+(defvar *hanoi-gcontext* () "The graphics context for Hanoi under X11.")
+
+
+;;; Needle Functions
+
+(defstruct disk
+  size)
+
+(defstruct needle
+  position
+  disk-stack)
+
+;;; Needle-Top-Height returns the height of the top disk on NEEDLE.
+
+(defun needle-top-height (needle)
+  (- *hanoi-window-height*
+     (* disk-spacing (length (the list (needle-disk-stack needle))))))
+
+(defvar available-disks
+  (do ((i 10 (+ i 10))
+       (dlist () (cons (make-disk :size i) dlist)))
+      ((> i 80) dlist)))
+
+(defvar needle-1 (make-needle :position 184))
+(defvar needle-2 (make-needle :position 382))
+(defvar needle-3 (make-needle :position 584))
+
+;;; Graphic interface abstraction:
+
+;;; Invert-Rectangle calls the CLX function draw-rectangle with "fill-p"
+;;; set to T.  Update-Screen forces the display output.
+;;; 
+(defmacro invert-rectangle (x y height width)
+  `(xlib:draw-rectangle *hanoi-window* *hanoi-gcontext*
+			,x ,y ,width ,height t))
+
+(defmacro update-screen ()
+  `(xlib:display-force-output *display*))
+
+
+;;;; Moving disks up and down
+
+;;; Slide-Up slides the image of a disk up from the coordinates X,
+;;; START-Y to the point X, END-Y.  DISK-SIZE is the size of the disk to
+;;; move.  START-Y must be greater than END-Y
+
+(defun slide-up (start-y end-y x disk-size)
+  (multiple-value-bind (number-moves pixels-left)
+		       (truncate (- start-y end-y) *vertical-velocity*)
+    (do ((x (- x disk-size))
+	 (width (* disk-size 2))
+	 (old-y start-y (- old-y *vertical-velocity*))
+	 (new-y (- start-y *vertical-velocity*) (- new-y *vertical-velocity*))
+	 (number-moves number-moves (1- number-moves)))
+	((zerop number-moves)
+	 (when (plusp pixels-left)
+	   (invert-rectangle x (- old-y pixels-left) disk-thickness width)
+	   (invert-rectangle x old-y disk-thickness width)
+	   (update-screen)))
+      ;; Loop body writes disk at new height & erases at old height.
+      (invert-rectangle x old-y disk-thickness width)
+      (invert-rectangle x new-y disk-thickness width)
+      (update-screen))))
+
+;;; Slide-Down slides the image of a disk down from the coordinates X,
+;;; START-Y to the point X, END-Y.  DISK-SIZE is the size of the disk to
+;;; move.  START-Y must be less than END-Y.
+
+(defun slide-down (start-y end-y x disk-size)
+  (multiple-value-bind (number-moves pixels-left)
+		       (truncate (- end-y start-y) *vertical-velocity*)
+    (do ((x (- x disk-size))
+	 (width (* disk-size 2))
+	 (old-y start-y (+ old-y *vertical-velocity*))
+	 (new-y (+ start-y *vertical-velocity*) (+ new-y *vertical-velocity*))
+	 (number-moves number-moves (1- number-moves)))
+	((zerop number-moves)
+	 (when (plusp pixels-left)
+	   (invert-rectangle x (+ old-y pixels-left) disk-thickness width)
+	   (invert-rectangle x old-y disk-thickness width)
+	   (update-screen)))
+      ;; Loop body writes disk at new height & erases at old height.
+      (invert-rectangle X old-y disk-thickness width)
+      (invert-rectangle X new-y disk-thickness width)
+      (update-screen))))
+
+
+;;;; Lifting and Droping Disks
+
+;;; Lift-disk pops the top disk off of needle and raises it up to the
+;;; transfer height.  The disk is returned.
+
+(defun lift-disk (needle)
+  "Pops the top disk off of NEEDLE, Lifts it above the needle, & returns it."
+  (let* ((height (needle-top-height needle))
+	 (disk (pop (needle-disk-stack needle))))
+    (slide-up height
+	      *transfer-height*
+	      (needle-position needle)
+	      (disk-size disk))
+    disk))
+
+;;; Drop-disk drops a disk positioned over needle at the transfer height
+;;; onto needle.  The disk is pushed onto needle.
+
+(defun drop-disk (disk needle)
+  "DISK must be positioned above NEEDLE.  It is dropped onto NEEDLE."
+  (push disk (needle-disk-stack needle))
+  (slide-down *transfer-height*
+	      (needle-top-height needle)
+	      (needle-position needle)
+	      (disk-size disk))
+  t)
+
+
+;;; Drop-initial-disk is the same as drop-disk except that the disk is
+;;; drawn once before dropping.
+
+(defun drop-initial-disk (disk needle)
+  "DISK must be positioned above NEEDLE.  It is dropped onto NEEDLE."
+  (let* ((size (disk-size disk))
+	 (lx (- (needle-position needle) size)))
+    (invert-rectangle lx *transfer-height* disk-thickness (* size 2))
+    (push disk (needle-disk-stack needle))
+    (slide-down *transfer-height*
+		(needle-top-height needle)
+		(needle-position needle)
+		(disk-size disk))
+    t))
+
+
+;;;; Sliding Disks Right and Left
+
+;;; Slide-Right slides the image of a disk located at START-X, Y to the
+;;; position END-X, Y.  DISK-SIZE is the size of the disk.  START-X is
+;;; less than END-X.
+
+(defun slide-right (start-x end-x Y disk-size)
+  (multiple-value-bind (number-moves pixels-left)
+		       (truncate (- end-x start-x) *horizontal-velocity*)
+    (do ((right-x (+ start-x disk-size) (+ right-x *horizontal-velocity*))
+	 (left-x  (- start-x disk-size) (+ left-x  *horizontal-velocity*))
+	 (number-moves number-moves (1- number-moves)))
+	((zerop number-moves)
+	 (when (plusp pixels-left)
+	   (invert-rectangle right-x Y disk-thickness pixels-left)
+	   (invert-rectangle left-x  Y disk-thickness pixels-left)
+	   (update-screen)))
+      ;; Loop body adds chunk *horizontal-velocity* pixels wide to right
+      ;; side of disk, then chops off left side.
+      (invert-rectangle right-x Y disk-thickness *horizontal-velocity*)
+      (invert-rectangle left-x Y disk-thickness *horizontal-velocity*)
+      (update-screen))))
+
+;;; Slide-Left is the same as Slide-Right except that START-X is greater
+;;; than END-X.
+
+(defun slide-left (start-x end-x Y disk-size)
+  (multiple-value-bind (number-moves pixels-left)
+		       (truncate (- start-x end-x) *horizontal-velocity*)
+    (do ((right-x (- (+ start-x disk-size) *horizontal-velocity*)
+		  (- right-x *horizontal-velocity*))
+	 (left-x  (- (- start-x disk-size) *horizontal-velocity*)
+		  (- left-x  *horizontal-velocity*))
+	 (number-moves number-moves (1- number-moves)))
+	((zerop number-moves)
+	 (when (plusp pixels-left)
+	   (setq left-x  (- (+ left-x  *horizontal-velocity*) pixels-left))
+	   (setq right-x (- (+ right-x *horizontal-velocity*) pixels-left))
+	   (invert-rectangle left-x  Y disk-thickness pixels-left)
+	   (invert-rectangle right-x Y disk-thickness pixels-left)
+	   (update-screen)))
+      ;; Loop body adds chunk *horizontal-velocity* pixels wide to left
+      ;; side of disk, then chops off right side.
+      (invert-rectangle left-x  Y disk-thickness *horizontal-velocity*)
+      (invert-rectangle right-x Y disk-thickness *horizontal-velocity*)
+      (update-screen))))
+
+
+;;;; Transferring Disks
+
+;;; Transfer disk slides a disk at the transfer height from a position
+;;; over START-NEEDLE to a position over END-NEEDLE.  Modified disk is
+;;; returned.
+
+(defun transfer-disk (disk start-needle end-needle)
+  "Moves DISK from a position over START-NEEDLE to a position over END-NEEDLE."
+  (let ((start (needle-position start-needle))
+	(end (needle-position end-needle)))
+    (if (< start end)
+	(slide-right start end *transfer-height* (disk-size disk))
+	(slide-left start end *transfer-height* (disk-size disk)))
+    disk))
+
+
+;;; Move-One-Disk moves the top disk from START-NEEDLE to END-NEEDLE.
+
+(defun move-one-disk (start-needle end-needle)
+  "Moves the disk on top of START-NEEDLE to the top of END-NEEDLE."
+  (drop-disk (transfer-disk (lift-disk start-needle)
+			    start-needle
+			    end-needle)
+	     end-needle)
+  t)
+
+;;; Move-N-Disks moves the top N disks from START-NEEDLE to END-NEEDLE
+;;; obeying the rules of the towers of hannoi problem.  To move the
+;;; disks, a third needle, TEMP-NEEDLE, is needed for temporary storage.
+
+(defun move-n-disks (n start-needle end-needle temp-needle)
+  "Moves the top N disks from START-NEEDLE to END-NEEDLE.  
+   Uses TEMP-NEEDLE for temporary storage."
+  (cond ((= n 1)
+	 (move-one-disk start-needle end-needle))
+	(t
+	 (move-n-disks (1- n) start-needle temp-needle end-needle)
+	 (move-one-disk start-needle end-needle)
+	 (move-n-disks (1- n) temp-needle end-needle start-needle)))
+  t)
+
+
+;;;; Hanoi itself.
+
+(defun hanoi (window n background foreground)
+  (multiple-value-bind (width height) (full-window-state window)
+    (declare (ignore width))
+    (let* ((*hanoi-window* window)
+	   (*hanoi-window-height* height)
+	   (*transfer-height* (- height (* disk-spacing n)))
+	   (*hanoi-gcontext* (xlib:create-gcontext :drawable *hanoi-window*
+						   :foreground foreground
+						   :background background
+						   :fill-style :solid
+						   :function boole-c2)))
+      (xlib:clear-area *hanoi-window*)
+      (xlib:display-force-output *display*)
+      (setf (needle-disk-stack needle-1) ())
+      (setf (needle-disk-stack needle-2) ())
+      (setf (needle-disk-stack needle-3) ())
+      (do ((n n (1- n))
+	   (available-disks available-disks (cdr available-disks)))
+	  ((zerop n))
+	(drop-initial-disk (car available-disks) needle-1))
+      (move-n-disks n needle-1 needle-3 needle-2)
+      t)))
+
+;;; Change the names of these when the DEMO loop isn't so stupid.
+;;; 
+(defdemo slow-hanoi-demo "Slow-towers-of-Hanoi" (&optional (how-many 4))
+  0 100 768 300 (aref *color-pixels* 9)
+  "Solves the Towers of Hanoi problem before your very eyes."
+  (let ((*horizontal-velocity* 3)
+	(*vertical-velocity* 1))
+    (hanoi *window* how-many (aref *color-pixels* 2) (aref *color-pixels* 9))))
+;;;
+(defdemo fast-hanoi-demo "Fast-towers-of-Hanoi" (&optional (how-many 7))
+  0 100 768 300 (aref *color-pixels* 9)
+  "Solves the Towers of Hanoi problem before your very eyes."
+  (hanoi *window* how-many (aref *color-pixels* 2) (aref *color-pixels* 9)))
+
+
+
+;;;; Bounce window.
+
+;;; BOUNCE-WINDOW takes a window and seemingly drops it to the bottom of
+;;; the screen.  Optionally, the window can have an initial x velocity,
+;;; screen border elasticity, and gravity value.  The outer loop is
+;;; entered the first time with the window at its initial height, but
+;;; each iteration after this, the loop starts with the window at the
+;;; bottom of the screen heading upward.  The inner loop, except for the
+;;; first execution, carries the window up until the negative velocity
+;;; becomes positive, carrying the window down to bottom when the
+;;; velocity is positive.  Due to number lossage, ROUND'ing and
+;;; TRUNC'ing when the velocity gets so small will cause the window to
+;;; head upward with the same velocity over two iterations which will
+;;; cause the window to bounce forever, so we have prev-neg-velocity and
+;;; number-problems to check for this.  This is not crucial with the x
+;;; velocity since the loop terminates as a function of the y velocity.
+;;; 
+(defun bounce-window (window &optional
+			     (x-velocity 0) (elasticity 0.85) (gravity 2))
+  (unless (< 0 elasticity 1)
+    (error "Elasticity must be between 0 and 1."))
+  (unless (plusp gravity)
+    (error "Gravity must be positive."))
+  (multiple-value-bind (width height x y mapped) (full-window-state window)
+    (when (eq mapped :viewable)
+      (let ((top-of-window-at-bottom (- (xlib:drawable-height *root*) height))
+	    (left-of-window-at-right (- (xlib:drawable-width *root*) width))
+	    (y-velocity 0)
+	    (prev-neg-velocity most-negative-fixnum)
+	    (number-problems nil))
+	(declare (fixnum top-of-window-at-bottom left-of-window-at-right
+			 y-velocity))
+	(loop
+	  (when (= prev-neg-velocity 0) (return t))
+	  (let ((negative-velocity (minusp y-velocity)))
+	    (loop
+	      (let ((next-y (+ y y-velocity))
+		    (next-y-velocity (+ y-velocity gravity)))
+		(declare (fixnum next-y next-y-velocity))
+		(when (> next-y top-of-window-at-bottom)
+		  (cond
+		   (number-problems
+		    (setf y-velocity (incf prev-neg-velocity)))
+		   (t
+		    (setq y-velocity
+			  (- (truncate (* elasticity y-velocity))))
+		    (when (= y-velocity prev-neg-velocity)
+		      (incf y-velocity)
+		      (setf number-problems t))
+		    (setf prev-neg-velocity y-velocity)))
+		  (setf y top-of-window-at-bottom)
+		  (setf (xlib:drawable-x window) x
+			(xlib:drawable-y window) y)
+		  (xlib:display-force-output *display*)
+		  (return))
+		(setq y-velocity next-y-velocity)
+		(setq y next-y))
+
+	      (when (and negative-velocity (>= y-velocity 0))
+		(setf negative-velocity nil))
+	      (let ((next-x (+ x x-velocity)))
+		(declare (fixnum next-x))
+		(when (or (> next-x left-of-window-at-right)
+			  (< next-x 0))
+		  (setq x-velocity (- (truncate (* elasticity x-velocity)))))
+		(setq x next-x))
+	      (setf (xlib:drawable-x window) x
+		    (xlib:drawable-y window) y)
+	      (xlib:display-force-output *display*))))))))
+
+;;; Change the name of this when DEMO is not so stupid.
+;;; 
+(defdemo shove-bounce-demo "Shove-bounce" ()
+  100 100 300 300 *white-pixel*
+  "Drops the demo window with an inital X velocity which bounces off
+  screen borders."
+  (bounce-window *window* 30))
+
+(defdemo bounce-demo "Bounce" ()
+  100 100 300 300 *black-pixel*
+  "Drops the demo window which bounces off screen borders."
+  (bounce-window *window*))
+
+
+;;;; Recurrence Demo
+
+;;; Copyright (C) 1988 Michael O. Newton (newton@csvax.caltech.edu)
+
+;;; Permission is granted to any individual or institution to use, copy,
+;;; modify, and distribute this software, provided that this complete
+;;; copyright and permission notice is maintained, intact, in all copies and
+;;; supporting documentation.  
+
+;;; The author provides this software "as is" without express or
+;;; implied warranty.
+
+;;; This routine plots the recurrence 
+;;;      x <- y(1+sin(0.7x)) - 1.2(|x|)^.5
+;;;      y <- .21 - x
+;;; As described in a ?? 1983 issue of the Mathematical Intelligencer
+
+(defun recurrence (display window background foreground
+			   &optional (point-count 10000))
+  (let ((gc (xlib:create-gcontext :drawable window
+				  :background background
+				  :foreground foreground)))
+    (multiple-value-bind (width height) (full-window-state window)
+      (xlib:clear-area window)
+      (draw-ppict window gc point-count 0.0 0.0 (* width 0.5) (* height 0.5))
+      (xlib:display-force-output display)
+      (sleep 4))
+    (xlib:free-gcontext gc)))
+
+;;; Draw points.  X assumes points are in the range of width x height,
+;;; with 0,0 being upper left and 0,H being lower left.
+;;; hw and hh are half-width and half-height of screen
+
+(defun draw-ppict (win gc count x y hw hh)
+  "Recursively draw pretty picture"
+  (unless (zerop count)
+    (let ((xf (floor (* (+ 1.0 x) hw ))) ;These lines center the picture
+          (yf (floor (* (+ 0.7 y) hh ))))
+      (xlib:draw-point win gc xf yf)
+      (draw-ppict win gc (1- count) 
+                  (- (* y (1+ (sin (* 0.7 x)))) (* 1.2 (sqrt (abs x))))
+                  (- 0.21 x)
+                  hw
+                  hh))))
+
+(defdemo recurrence-demo "Recurrence" ()
+  10 10 700 700 (aref *color-pixels* 2)
+  "Plots a cool recurrence relation."
+  (recurrence *display* *window*
+	      (aref *color-pixels* 4) (aref *color-pixels* 2)))
+
+
+;;;; Plaid
+
+;;; 
+;;; Translated from the X11 Plaid Demo written in C by Christopher Hoover.
+;;; 
+
+(defmacro rect-x (rects n)
+  `(svref ,rects (ash ,n 2)))
+(defmacro rect-y (rects n)
+  `(svref ,rects (+ (ash ,n 2) 1)))
+(defmacro rect-width (rects n)
+  `(svref ,rects (+ (ash ,n 2) 2)))
+(defmacro rect-height (rects n)
+  `(svref ,rects (+ (ash ,n 2) 3)))
+
+
+(defun plaid (display window background foreground
+		      &optional (num-iterations 10000) (num-rectangles 10))
+  (let ((gcontext (xlib:create-gcontext :drawable window
+					:function boole-c2
+					#-COLOR :plane-mask
+					#-COLOR (logxor *white-pixel*
+							*black-pixel*)
+					:background background
+					:foreground foreground
+					:fill-style :solid))
+	(rectangles (make-array (* 4 num-rectangles)
+				:element-type 'number
+				:initial-element 0)))
+    (multiple-value-bind (width height) (full-window-state window)
+      (let ((center-x (ash width -1))
+	    (center-y (ash height -1))
+	    (x-dir -2)
+	    (y-dir -2)
+	    (x-off 2)
+	    (y-off 2))
+	(dotimes (iter (truncate num-iterations num-rectangles))
+	  (dotimes (i num-rectangles)
+	    (setf (rect-x rectangles i) (- center-x x-off))
+	    (setf (rect-y rectangles i) (- center-y y-off))
+	    (setf (rect-width rectangles i) (ash x-off 1))
+	    (setf (rect-height rectangles i) (ash y-off 1))
+	    (incf x-off x-dir)
+	    (incf y-off y-dir)
+	    (when (or (<= x-off 0) (>= x-off center-x))
+	      (decf x-off (ash x-dir 1))
+	      (setf x-dir (- x-dir)))
+	    (when (or (<= y-off 0) (>= y-off center-y))
+	      (decf y-off (ash y-dir 1))
+	      (setf y-dir (- y-dir))))
+	  (xlib:draw-rectangles window gcontext rectangles t)
+	  (xlib:display-force-output display))))
+    (xlib:free-gcontext gcontext)))
+
+(defdemo plaid-demo "Plaid" (&optional (iterations 10000) (num-rectangles 10))
+  10 10 101 201 (aref *color-pixels* 3)
+  "Plaid, man."
+  (plaid *display* *window*
+	 (aref *color-pixels* 3) (aref *color-pixels* 8)
+	 iterations num-rectangles))
+
+
+;;;; Bball demo
+
+;;; 
+;;; Ported to CLX by Blaine Burks
+;;; 
+
+(defvar *ball-size-x* #-COLOR 38 #+COLOR 36)
+(defvar *ball-size-y* 34)
+
+(defmacro xor-ball (pixmap window gcontext x y)
+  `(xlib:copy-area ,pixmap ,gcontext 0 0 *ball-size-x* *ball-size-y*
+		   ,window ,x ,y))
+
+(defconstant bball-gravity 1)
+(defconstant maximum-x-drift 7)
+
+(defvar *max-bball-x*)
+(defvar *max-bball-y*)
+
+(defstruct (ball (:copier nil) (:predicate nil))
+  (x (random (- *max-bball-x* *ball-size-x*)) :type fixnum) ; Beppe
+  (y (random (- *max-bball-y* *ball-size-y*)) :type fixnum) ; Beppe
+  (dx (if (zerop (random 2)) (random maximum-x-drift)
+	  (- (random maximum-x-drift))) :type fixnum) ; Beppe
+  (dy 0 :type fixnum))			; Beppe
+
+(defun get-bounce-image ()
+  "Returns the pixmap to be bounced around the screen."
+  (xlib::bitmap-image   #*000000000000000000000000000000000000
+			#*000000000000000000000000000000000000
+			#*000000000000000000001000000010000000
+			#*000000000000000000000000000100000000
+			#*000000000000000000000100001000000000
+			#*000000000000000010000000010000000000
+			#*000000000000000000100010000000000000
+			#*000000000000000000001000000000000000
+			#*000000000001111100000000000101010000
+			#*000000000010000011000111000000000000
+			#*000000000100000000111000000000000000
+			#*000000000100000000000000000100000000
+			#*000000000100000000001000100010000000
+			#*000000111111100000010000000001000000
+			#*000000111111100000100000100000100000
+			#*000011111111111000000000000000000000
+			#*001111111111111110000000100000000000
+			#*001111111111111110000000000000000000
+			#*011111111111111111000000000000000000
+			#*011111111111111111000000000000000000
+			#*111111111111110111100000000000000000
+			#*111111111111111111100000000000000000
+			#*111111111111111101100000000000000000
+			#*111111111111111101100000000000000000
+			#*111111111111111101100000000000000000
+			#*111111111111111111100000000000000000
+			#*111111111111110111100000000000000000
+			#*011111111111111111000000000000000000
+			#*011111111111011111000000000000000000
+			#*001111111111111110000000000000000000
+			#*001111111111111110000000000000000000
+			#*000011111111111000000000000000000000
+			#*000000111111100000000000000000000000
+			#*000000000000000000000000000000000000))
+
+
+(defun bounce-1-ball (pixmap window gcontext ball)
+  (let ((x (ball-x ball))
+	(y (ball-y ball))
+	(dx (ball-dx ball))
+	(dy (ball-dy ball)))
+    #-COLOR
+    (xor-ball pixmap window gcontext x y)
+    #+COLOR
+    (xlib:clear-area window :x x :y y :width 36 :height 34) 
+    (setq x (+ x dx))
+    (setq y (+ y dy))
+    (if (or (< x 0) (> x (- *max-bball-x* *ball-size-x*)))
+	(setq x (- x dx)
+	      dx (- dx)))
+    (if (> y (- *max-bball-y* *ball-size-y*))
+	(setq y (- y dy)
+	      dy (- dy)))
+    (setq dy (+ dy bball-gravity))
+    (setf (ball-x ball) x)
+    (setf (ball-y ball) y)
+    (setf (ball-dx ball) dx)
+    (setf (ball-dy ball) dy)
+    (xor-ball pixmap window gcontext x y)))
+
+(defun bounce-balls (display window background foreground how-many duration)
+  (declare (fixnum how-many))		; Beppe
+  (xlib:clear-area window)
+  (xlib:display-force-output display)
+  (multiple-value-bind (*max-bball-x* *max-bball-y*) (full-window-state window)
+    (let* ((balls (do ((i 0 (1+ i))
+		       (list () (cons (make-ball) list)))
+		      ((= i how-many) list)
+		      (declare (fixnum i)))) ; Beppe
+	   (gcontext (xlib:create-gcontext :drawable window
+					   :foreground foreground
+					   :background background
+					   :function
+					   #-COLOR boole-xor
+					   #+COLOR boole-1
+					   :exposures :off))
+	   (bounce-pixmap (xlib:create-pixmap :width 38 :height 34
+					      :depth (xlib:drawable-depth window)
+					      :drawable window))
+	   (pixmap-gc (xlib:create-gcontext :drawable bounce-pixmap
+					    :foreground foreground
+					    :background background)))
+      (xlib:put-image bounce-pixmap pixmap-gc (get-bounce-image)
+		      :x 0 :y 0 :width 38 :height 34
+		      #+COLOR :bitmap-p t)
+      (xlib:free-gcontext pixmap-gc)
+      (dolist (ball balls)
+	(xor-ball bounce-pixmap window gcontext (ball-x ball) (ball-y ball)))
+      (xlib:display-force-output display)
+      (dotimes (i duration)
+	(dolist (ball balls)
+	  (bounce-1-ball bounce-pixmap window gcontext ball))
+	(xlib:display-force-output display))
+      (xlib:free-pixmap bounce-pixmap)
+      (xlib:free-gcontext gcontext))))
+
+(defdemo bouncing-ball-demo "Bouncing-Ball" (&optional (how-many 5) (duration 500))
+  34 34 700 500 (aref *color-pixels* 3)
+  "Bouncing balls in space."
+  (bounce-balls *display*  *window*
+		(aref *color-pixels* 3) (aref *color-pixels* 2)
+		how-many duration))
+
+
diff --git a/src/clx/demo/hello.lsp b/src/clx/demo/hello.lsp
new file mode 100644
index 000000000..7dca5f57f
--- /dev/null
+++ b/src/clx/demo/hello.lsp
@@ -0,0 +1,75 @@
+
+(in-package 'xlib)
+
+(defun hello-world (&optional (host (machine-instance))
+			      &rest args &key (string "Hello World")
+			      (font "6x10"))
+  ;; CLX demo, says STRING using FONT in its own window on HOST
+  (let* ((display (open-display host))
+	 (screen (display-default-screen display))
+	 (black (screen-black-pixel screen))
+	 (white (screen-white-pixel screen))
+	 (red 31)
+	 (font (open-font display font))
+	 (border 1)			; Minimum margin around the text
+	 (width (+ (text-width font string) (* 2 border)))
+	 (height (+ (max-char-ascent font) (max-char-descent font)
+		    (* 2 border)))
+	 (x (truncate (- (screen-width screen) width) 2))
+	 (y (truncate (- (screen-height screen) height) 2))
+	 (window (create-window :parent (screen-root screen)
+				:x x :y y :width width :height height
+				:background black
+				:border white
+				:border-width 1
+				:colormap (screen-default-colormap screen)
+				:bit-gravity :center
+				:event-mask (make-event-mask
+					     :exposure :key-press)))
+	 (keymap (keyboard-mapping display))
+	 (gcontext (create-gcontext :drawable window
+				    :background black
+				    :foreground white
+				    :font font)))
+    (setf (wm-name window) string
+	  (wm-icon-name window) string
+	  (wm-command window) (list* 'hello-world host args)
+	  (wm-normal-hints window) (make-wm-size-hints :x x :y y :width :width)
+	  (wm-hints window) (make-wm-hints :input :off :initial-state :normal))
+
+    (map-window window)
+    ;; Handle events
+    (unwind-protect
+	 (loop
+	  (event-case
+	   (display :force-output-p t)
+	   (exposure;; Come here on exposure events,
+	    (window count);; binding WINDOW and COUNT from the event.
+	    (when (zerop count);; Ignore all but the last exposure event.
+	      (with-state (window)
+		(let ((x (truncate (- (drawable-width window) width) 2))
+		      (y (truncate (- (+ (drawable-height window)
+					 (max-char-ascent font))
+				      (max-char-descent font))
+				   2)))
+		  ;; Draw text centered in widnow
+		  (clear-area window)
+		  (draw-glyphs window gcontext x y string)))
+	      ;; Returning non-nil causes event-case to exit
+	      t))
+	   (key-press
+	    (window state code)
+	    (let ((char (int-char (aref keymap code 0))))
+	      (when char
+		(return-from hello-world))
+	      t))))
+      ;; Ensure display is closed when done
+      (close-display display))))
+
+#|
+To run this program do:
+   
+     (hello-world "hostname")
+
+To exit press the q key
+|#
diff --git a/src/clx/depdefs.lsp b/src/clx/depdefs.lsp
new file mode 100644
index 000000000..308d7dd2d
--- /dev/null
+++ b/src/clx/depdefs.lsp
@@ -0,0 +1,657 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;; This file contains some of the system dependent code for CLX
+
+;;;(c) Copyright Enhancements by Giuseppe Attardi, 1994.
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+;;;-------------------------------------------------------------------------
+;;; Declarations
+;;;-------------------------------------------------------------------------
+
+;;; fix a bug in kcl's RATIONAL...
+;;;   redefine both the function and the type.
+
+#+(or kcl ibcl)
+(progn
+  (defun rational (x)
+    (if (rationalp x)
+	x
+	(lisp:rational x)))
+  (deftype rational (&optional l u) `(lisp:rational ,l ,u)))
+
+;;; DECLAIM
+
+#-clx-ansi-common-lisp
+(defmacro declaim (&rest decl-specs)
+  (if (cdr decl-specs)
+      `(progn
+	 ,@(mapcar #'(lambda (decl-spec) `(proclaim ',decl-spec))
+		   decl-specs))
+    `(proclaim ',(car decl-specs))))
+
+;;; VALUES value1 value2 ... -- Documents the values returned by the function.
+
+#-lispm
+(declaim (declaration values))
+
+;;; ARGLIST arg1 arg2 ... -- Documents the arglist of the function.  Overrides
+;;; the documentation that might get generated by the real arglist of the
+;;; function.
+
+#-(or lispm lcl3.0)
+(declaim (declaration arglist))
+
+;;; DYNAMIC-EXTENT var -- Tells the compiler that the rest arg var has
+;;; dynamic extent and therefore can be kept on the stack and not copied to
+;;; the heap, even though the value is passed out of the function.
+
+#-(or clx-ansi-common-lisp lcl3.0)
+(declaim (declaration dynamic-extent))
+
+;;; IGNORABLE var -- Tells the compiler that the variable might or might not be used.
+
+#-clx-ansi-common-lisp
+(declaim (declaration ignorable))
+
+;;; ARRAY-REGISTER var1 var2 ... -- The variables mentioned are locals (not
+;;; args) that hold vectors.  
+
+#-Genera 
+(declaim (declaration array-register))
+
+;;; INDENTATION argpos1 arginden1 argpos2 arginden2 --- Tells the lisp editor how to
+;;; indent calls to the function or macro containing the declaration.  
+
+#-genera
+(declaim (declaration indentation))
+
+;;;-------------------------------------------------------------------------
+;;; Declaration macros
+;;;-------------------------------------------------------------------------
+
+;;; WITH-VECTOR (variable type) &body body --- ensures the variable is a local
+;;; and then does a type declaration and array register declaration
+(defmacro with-vector ((var type) &body body)
+  `(let ((,var ,var))
+     (declare (type ,type ,var)
+	      (array-register ,var))
+     ,@body))
+
+;;; WITHIN-DEFINITION (name type) &body body --- Includes definitions for
+;;; Meta-.
+
+#+lispm
+(defmacro within-definition ((name type) &body body)
+  `(zl:local-declare
+     ((sys:function-parent ,name ,type))
+     (sys:record-source-file-name ',name ',type)
+     ,@body))
+
+#-lispm
+(defmacro within-definition ((name type) &body body)
+  (declare (ignore name type))
+  `(progn ,@body))
+
+
+;;;-------------------------------------------------------------------------
+;;; CLX can maintain a mapping from X server ID's to local data types.  If
+;;; one takes the view that CLX objects will be instance variables of
+;;; objects at the next higher level, then PROCESS-EVENT will typically map
+;;; from resource-id to higher-level object.  In that case, the lower-level
+;;; CLX mapping will almost never be used (except in rare cases like
+;;; query-tree), and only serve to consume space (which is difficult to
+;;; GC), in which case always-consing versions of the make-<mumble>s will
+;;; be better.  Even when maps are maintained, it isn't clear they are
+;;; useful for much beyond xatoms and windows (since almost nothing else
+;;; ever comes back in events).
+;;;--------------------------------------------------------------------------
+(defconstant *clx-cached-types*
+	     '( drawable
+		window
+		pixmap
+;		gcontext
+		cursor
+		colormap
+		font))
+
+(defmacro resource-id-map-test ()
+  #+excl '#'equal
+  #-excl '#'eql)
+					; (eq fixnum fixnum) is not guaranteed.
+(defmacro atom-cache-map-test ()
+  #+excl '#'equal
+  #-excl '#'eq)
+
+(defmacro keysym->character-map-test ()
+  #+excl '#'equal
+  #-excl '#'eql)
+
+;;; You must define this to match the real byte order.  It is used by
+;;; overlapping array and image code.
+
+#+(or lispm vax little-endian Minima)
+(eval-when (eval compile load)
+  (pushnew :clx-little-endian *features*))
+
+#+lcl3.0
+(eval-when (compile eval load)
+  (ecase lucid::machine-endian
+    (:big nil)
+    (:little (pushnew :clx-little-endian *features*))))
+
+#+ecl
+(eval-when (compile eval load)
+  (when (little-endian-p)
+    (pushnew :clx-little-endian *features*)))
+
+;;; Steele's Common-Lisp states:  "It is an error if the array specified
+;;; as the :displaced-to argument  does not have the same :element-type
+;;; as the array being created" If this is the case on your lisp, then
+;;; leave the overlapping-arrays feature turned off.  Lisp machines
+;;; (Symbolics TI and LMI) don't have this restriction, and allow arrays
+;;; with different element types to overlap.  CLX will take advantage of
+;;; this to do fast array packing/unpacking when the overlapping-arrays
+;;; feature is enabled.
+
+#+(and clx-little-endian lispm)
+(eval-when (eval compile load)
+  (pushnew :clx-overlapping-arrays *features*))
+
+#+(and clx-overlapping-arrays genera)
+(progn
+(deftype overlap16 () '(unsigned-byte 16))
+(deftype overlap32 () '(signed-byte 32))
+)
+
+#+(and clx-overlapping-arrays (or explorer lambda cadr))
+(progn
+(deftype overlap16 () '(unsigned-byte 16))
+(deftype overlap32 () '(unsigned-byte 32))
+)
+
+#-ecl
+(deftype buffer-bytes () `(simple-array (unsigned-byte 8) (*)))
+
+#+clx-overlapping-arrays
+(progn
+(deftype buffer-words () `(vector overlap16))
+(deftype buffer-longs () `(vector overlap32))
+)
+
+;;; This defines a type which is a subtype of the integers.
+;;; This type is used to describe all variables that can be array indices.
+;;; It is here because it is used below.
+;;; This is inclusive because start/end can be 1 past the end.
+(deftype array-index () `(integer 0 ,array-dimension-limit))
+
+
+;; this is the best place to define these?
+
+#-Genera
+(progn
+
+(defun make-index-typed (form)
+  (if (constantp form) form `(the array-index ,form)))
+
+(defun make-index-op (operator args)
+  `(the array-index
+	(values 
+	  ,(case (length args)
+	     (0 `(,operator))
+	     (1 `(,operator
+		  ,(make-index-typed (first args))))
+	     (2 `(,operator
+		  ,(make-index-typed (first args))
+		  ,(make-index-typed (second args))))
+	     (otherwise
+	       `(,operator
+		 ,(make-index-op operator (subseq args 0 (1- (length args))))
+		 ,(make-index-typed (first (last args)))))))))
+
+(defmacro index+ (&rest numbers) (make-index-op '+ numbers))
+(defmacro index-logand (&rest numbers) (make-index-op 'logand numbers))
+(defmacro index-logior (&rest numbers) (make-index-op 'logior numbers))
+(defmacro index- (&rest numbers) (make-index-op '- numbers))
+(defmacro index* (&rest numbers) (make-index-op '* numbers))
+
+(defmacro index1+ (number) (make-index-op '1+ (list number)))
+(defmacro index1- (number) (make-index-op '1- (list number)))
+
+(defmacro index-incf (place &optional (delta 1))
+  (make-index-op 'incf (list place delta)))
+(defmacro index-decf (place &optional (delta 1))
+  (make-index-op 'decf (list place delta)))
+
+(defmacro index-min (&rest numbers) (make-index-op 'min numbers))
+(defmacro index-max (&rest numbers) (make-index-op 'max numbers))
+
+(defmacro index-floor (number divisor)
+  (make-index-op 'floor (list number divisor)))
+(defmacro index-ceiling (number divisor)
+  (make-index-op 'ceiling (list number divisor)))
+(defmacro index-truncate (number divisor)
+  (make-index-op 'truncate (list number divisor)))
+
+(defmacro index-mod (number divisor)
+  (make-index-op 'mod (list number divisor)))
+
+(defmacro index-ash (number count)
+  (make-index-op 'ash (list number count)))
+
+(defmacro index-plusp (number) `(plusp (the array-index ,number)))
+(defmacro index-zerop (number) `(zerop (the array-index ,number)))
+(defmacro index-evenp (number) `(evenp (the array-index ,number)))
+(defmacro index-oddp  (number) `(oddp  (the array-index ,number)))
+
+(defmacro index> (&rest numbers)
+  `(> ,@(mapcar #'make-index-typed numbers)))
+(defmacro index= (&rest numbers)
+  `(= ,@(mapcar #'make-index-typed numbers)))
+(defmacro index< (&rest numbers)
+  `(< ,@(mapcar #'make-index-typed numbers)))
+(defmacro index>= (&rest numbers)
+  `(>= ,@(mapcar #'make-index-typed numbers)))
+(defmacro index<= (&rest numbers)
+  `(<= ,@(mapcar #'make-index-typed numbers)))
+
+)
+
+#+Genera
+(progn
+
+(defmacro index+ (&rest numbers) `(+ ,@numbers))
+(defmacro index-logand (&rest numbers) `(logand ,@numbers))
+(defmacro index-logior (&rest numbers) `(logior ,@numbers))
+(defmacro index- (&rest numbers) `(- ,@numbers))
+(defmacro index* (&rest numbers) `(* ,@numbers))
+
+(defmacro index1+ (number) `(1+ ,number))
+(defmacro index1- (number) `(1- ,number))
+
+(defmacro index-incf (place &optional (delta 1)) `(setf ,place (index+ ,place ,delta)))
+(defmacro index-decf (place &optional (delta 1)) `(setf ,place (index- ,place ,delta)))
+
+(defmacro index-min (&rest numbers) `(min ,@numbers))
+(defmacro index-max (&rest numbers) `(max ,@numbers))
+
+(defun positive-power-of-two-p (x)
+  (when (symbolp x)
+    (multiple-value-bind (constantp value) (lt:named-constant-p x)
+      (when constantp (setq x value))))
+  (and (typep x 'fixnum) (plusp x) (zerop (logand x (1- x)))))
+
+(defmacro index-floor (number divisor)
+  (cond ((eql divisor 1) number)
+	((and (positive-power-of-two-p divisor) (fboundp 'si:%fixnum-floor))
+	 `(si:%fixnum-floor ,number ,divisor))
+	(t `(floor ,number ,divisor))))
+
+(defmacro index-ceiling (number divisor)
+  (cond ((eql divisor 1) number)
+	((and (positive-power-of-two-p divisor) (fboundp 'si:%fixnum-ceiling))
+	 `(si:%fixnum-ceiling ,number ,divisor))
+	(t `(ceiling ,number ,divisor))))
+
+(defmacro index-truncate (number divisor)
+  (cond ((eql divisor 1) number)
+	((and (positive-power-of-two-p divisor) (fboundp 'si:%fixnum-floor))
+	 `(si:%fixnum-floor ,number ,divisor))
+	(t `(truncate ,number ,divisor))))
+
+(defmacro index-mod (number divisor)
+  (cond ((and (positive-power-of-two-p divisor) (fboundp 'si:%fixnum-mod))
+	 `(si:%fixnum-mod ,number ,divisor))
+	(t `(mod ,number ,divisor))))
+
+(defmacro index-ash (number count)
+  (cond ((eql count 0) number)
+	((and (typep count 'fixnum) (minusp count) (fboundp 'si:%fixnum-floor))
+	 `(si:%fixnum-floor ,number ,(expt 2 (- count))))
+	((and (typep count 'fixnum) (plusp count) (fboundp 'si:%fixnum-multiply))
+	 `(si:%fixnum-multiply ,number ,(expt 2 count)))
+	(t `(ash ,number ,count))))
+
+(defmacro index-plusp (number) `(plusp ,number))
+(defmacro index-zerop (number) `(zerop ,number))
+(defmacro index-evenp (number) `(evenp ,number))
+(defmacro index-oddp  (number) `(oddp  ,number))
+
+(defmacro index> (&rest numbers) `(> ,@numbers))
+(defmacro index= (&rest numbers) `(= ,@numbers))
+(defmacro index< (&rest numbers) `(< ,@numbers))
+(defmacro index>= (&rest numbers) `(>= ,@numbers))
+(defmacro index<= (&rest numbers) `(<= ,@numbers))
+
+)
+
+;;;; Stuff for BUFFER definition
+
+(defconstant *replysize* 32.)
+
+;; used in defstruct initializations to avoid compiler warnings
+(defvar *empty-bytes* (make-sequence 'buffer-bytes 0))
+(declaim (type buffer-bytes *empty-bytes*))
+#+clx-overlapping-arrays
+(progn
+(defvar *empty-words* (make-sequence 'buffer-words 0))
+(declaim (type buffer-words *empty-words*))
+)
+#+clx-overlapping-arrays
+(progn
+(defvar *empty-longs* (make-sequence 'buffer-longs 0))
+(declaim (type buffer-longs *empty-longs*))
+)
+
+(defstruct (reply-buffer (:conc-name reply-) (:constructor make-reply-buffer-internal)
+			 (:copier nil) (:predicate nil))
+  (size 0 :type array-index)			;Buffer size
+  ;; Byte (8 bit) input buffer
+  (ibuf8 *empty-bytes* :type buffer-bytes)
+  ;; Word (16bit) input buffer
+  #+clx-overlapping-arrays
+  (ibuf16 *empty-words* :type buffer-words)
+  ;; Long (32bit) input buffer
+  #+clx-overlapping-arrays
+  (ibuf32 *empty-longs* :type buffer-longs)
+  (next nil #-explorer :type #-explorer (or null reply-buffer))
+  (data-size 0 :type array-index)
+  )
+
+(defconstant *buffer-text16-size* 256)
+(deftype buffer-text16 () `(simple-array (unsigned-byte 16) (,*buffer-text16-size*)))
+
+;; These are here because.
+
+(defparameter *xlib-package* (find-package :xlib))
+
+(defun xintern (&rest parts)
+  (intern (apply #'concatenate 'string (mapcar #'string parts)) *xlib-package*))
+
+(defparameter *keyword-package* (find-package :keyword))
+
+(defun kintern (name)
+  (intern (string name) *keyword-package*))
+
+;;; Pseudo-class mechanism.
+
+(eval-when (eval compile load)
+(defvar *def-clx-class-use-defclass* #+Genera t #-Genera nil
+  "Controls whether DEF-CLX-CLASS uses DEFCLASS.  
+   If it is a list, it is interpreted by DEF-CLX-CLASS to be a list of type names
+   for which DEFCLASS should be used. 
+   If it is not a list, then DEFCLASS is always used.
+   If it is NIL, then DEFCLASS is never used, since NIL is the empty list.")
+)
+
+(defmacro def-clx-class ((name &rest options) &body slots)
+  (if (or (not (listp *def-clx-class-use-defclass*))
+	  (member name *def-clx-class-use-defclass*))
+      (let ((clos-package #+clx-ansi-common-lisp
+			  (find-package :common-lisp)
+			  #-clx-ansi-common-lisp
+			  (or (find-package :clos)
+			      (find-package :pcl)
+			      (let ((lisp-pkg (find-package :lisp)))
+				(and (find-symbol (string 'defclass) lisp-pkg)
+				     lisp-pkg))))
+	    (constructor t)
+	    (constructor-args t)
+	    (include nil)
+	    (print-function nil)
+	    (copier t)
+	    (predicate t))
+	(dolist (option options)
+	  (ecase (pop option)
+	    (:constructor
+	      (setf constructor (pop option))
+	      (setf constructor-args (if (null option) t (pop option))))
+	    (:include
+	      (setf include (pop option)))
+	    (:print-function
+	      (setf print-function (pop option)))
+	    (:copier
+	      (setf copier (pop option)))
+	    (:predicate
+	      (setf predicate (pop option)))))
+	(flet ((cintern (&rest symbols)
+		 (intern (apply #'concatenate 'simple-string
+				(mapcar #'symbol-name symbols))
+			 *package*))
+	       (kintern (symbol)
+			(intern (symbol-name symbol) (find-package :keyword)))
+	       (closintern (symbol)
+		 (intern (symbol-name symbol) clos-package)))
+	  (when (eq constructor t)
+	    (setf constructor (cintern 'make- name)))
+	  (when (eq copier t)
+	    (setf copier (cintern 'copy- name)))
+	  (when (eq predicate t)
+	    (setf predicate (cintern name '-p)))
+	  (when include
+	    (setf slots (append (get include 'def-clx-class) slots)))
+	  (let* ((n-slots (length slots))
+		 (slot-names (make-list n-slots))
+		 (slot-initforms (make-list n-slots))
+		 (slot-types (make-list n-slots)))
+	    (dotimes (i n-slots)
+	      (let ((slot (elt slots i)))
+		(setf (elt slot-names i) (pop slot))
+		(setf (elt slot-initforms i) (pop slot))
+		(setf (elt slot-types i) (getf slot :type t))))
+	    `(progn
+
+	       (eval-when (compile load eval)
+		 (setf (get ',name 'def-clx-class) ',slots))
+
+	       ;; From here down are the system-specific expansions:
+
+	       (within-definition (,name def-clx-class)
+		 (,(closintern 'defclass)
+		  ,name ,(and include `(,include))
+		  (,@(map 'list
+			  #'(lambda (slot-name slot-initform slot-type)
+			      `(,slot-name
+				:initform ,slot-initform :type ,slot-type
+				:accessor ,(cintern name '- slot-name)
+				,@(when (and constructor
+					     (or (eq constructor-args t)
+						 (member slot-name
+							 constructor-args)))
+				    `(:initarg ,(kintern slot-name)))
+				))
+			  slot-names slot-initforms slot-types)))
+		 ,(when constructor
+		    (if (eq constructor-args t)
+			`(defun ,constructor (&rest args)
+			   (apply #',(closintern 'make-instance)
+				  ',name args))
+			`(defun ,constructor ,constructor-args
+			   (,(closintern 'make-instance) ',name
+			    ,@(mapcan #'(lambda (slot-name)
+					  (and (member slot-name slot-names)
+					       `(,(kintern slot-name) ,slot-name)))
+				      constructor-args)))))
+		 ,(when predicate
+		    #+allegro
+		    `(progn
+		       (,(closintern 'defmethod) ,predicate (object)
+			 (declare (ignore object))
+			 nil)
+		       (,(closintern 'defmethod) ,predicate ((object ,name))
+			 t))
+		    #-allegro
+		    `(defun ,predicate (object)
+		       (typep object ',name)))
+		 ,(when copier
+		    `(,(closintern 'defmethod) ,copier ((.object. ,name))
+		      (,(closintern 'with-slots) ,slot-names .object.
+		       (,(closintern 'make-instance) ',name
+			,@(mapcan #'(lambda (slot-name)
+				      `(,(kintern slot-name) ,slot-name))
+				  slot-names)))))
+		 ,(when print-function
+		    `(,(closintern 'defmethod)
+		      ,(closintern 'print-object)
+		      ((object ,name) stream)
+		      (,print-function object stream 0))))))))
+      `(within-definition (,name def-clx-class)
+	 (defstruct (,name ,@options)
+	   ,@slots))))
+
+#+Genera
+(progn
+  (scl:defprop def-clx-class "CLX Class" si:definition-type-name)
+  (scl:defprop def-clx-class zwei:defselect-function-spec-finder
+	       zwei:definition-function-spec-finder))
+
+
+;; We need this here so we can define DISPLAY for CLX.
+;;
+;; This structure is :INCLUDEd in the DISPLAY structure.
+;; Overlapping (displaced) arrays are provided for byte
+;; half-word and word access on both input and output.
+;;
+(def-clx-class (buffer (:constructor nil) (:copier nil) (:predicate nil))
+  ;; Lock for multi-processing systems
+  (lock (make-process-lock "CLX Buffer Lock"))
+  #-excl (output-stream nil :type (or null stream))
+  #+excl (output-stream -1 :type fixnum)
+  ;; Buffer size
+  (size 0 :type array-index)
+  (request-number 0 :type (unsigned-byte 16))
+  ;; Byte position of start of last request
+  ;; used for appending requests and error recovery
+  (last-request nil :type (or null array-index))
+  ;; Byte position of start of last flushed request
+  (last-flushed-request nil :type (or null array-index))
+  ;; Current byte offset
+  (boffset 0 :type array-index)
+  ;; Byte (8 bit) output buffer
+  (obuf8 *empty-bytes* :type buffer-bytes)
+  ;; Word (16bit) output buffer
+  #+clx-overlapping-arrays
+  (obuf16 *empty-words* :type buffer-words)
+  ;; Long (32bit) output buffer
+  #+clx-overlapping-arrays
+  (obuf32 *empty-longs* :type buffer-longs)
+  ;; Holding buffer for 16-bit text
+  (tbuf16 (make-sequence 'buffer-text16 *buffer-text16-size* :initial-element 0))
+  ;; Probably EQ to Output-Stream
+  #-excl (input-stream nil :type (or null stream))
+  #+excl (input-stream -1 :type fixnum)
+  ;; T when the host connection has gotten errors
+  (dead nil :type (or null (not null)))
+  ;; T makes buffer-flush a noop.  Manipulated with with-buffer-flush-inhibited.
+  (flush-inhibit nil :type (or null (not null)))
+  
+  ;; Change these functions when using shared memory buffers to the server
+  ;; Function to call when writing the buffer
+  (write-function 'buffer-write-default)
+  ;; Function to call when flushing the buffer
+  (force-output-function 'buffer-force-output-default)
+  ;; Function to call when closing a connection
+  (close-function 'buffer-close-default)
+  ;; Function to call when reading the buffer
+  (input-function 'buffer-read-default)
+  ;; Function to call to wait for data to be input
+  (input-wait-function 'buffer-input-wait-default)
+  ;; Function to call to listen for input data
+  (listen-function 'buffer-listen-default)
+
+  #+Genera (debug-io nil :type (or null stream))
+  ) 
+
+;;-----------------------------------------------------------------------------
+;; Printing routines.
+;;-----------------------------------------------------------------------------
+
+#-(or clx-ansi-common-lisp Genera)
+(defun print-unreadable-object-function (object stream type identity function)
+  (declare #+lispm
+	   (sys:downward-funarg function))
+  (princ "#<" stream)
+  (when type
+    (let ((type (type-of object))
+	  (pcl-package (find-package :pcl)))
+      ;; Handle pcl type-of lossage
+      (when (and pcl-package
+		 (symbolp type)
+		 (eq (symbol-package type) pcl-package)
+		 (string-equal (symbol-name type) "STD-INSTANCE"))
+	(setq type
+	      (funcall (intern (symbol-name 'class-name) pcl-package)
+		       (funcall (intern (symbol-name 'class-of) pcl-package)
+				object))))
+      (prin1 type stream)))
+  (when (and type function) (princ " " stream))
+  (when function (funcall function))
+  (when (and (or type function) identity) (princ " " stream))
+  (when identity (princ "???" stream))
+  (princ ">" stream)
+  nil)
+  
+#-(or clx-ansi-common-lisp Genera)
+(defmacro print-unreadable-object
+	  ((object stream &key type identity) &body body)
+  (if body
+      `(flet ((.print-unreadable-object-body. () ,@body))
+	 (print-unreadable-object-function
+	   ,object ,stream ,type ,identity #'.print-unreadable-object-body.))
+    `(print-unreadable-object-function ,object ,stream ,type ,identity nil)))
+
+
+;;-----------------------------------------------------------------------------
+;; Image stuff
+;;-----------------------------------------------------------------------------
+
+(defconstant *image-bit-lsb-first-p*
+	     #+clx-little-endian t
+	     #-clx-little-endian nil)
+
+(defconstant *image-byte-lsb-first-p*
+	     #+clx-little-endian t
+	     #-clx-little-endian nil)
+
+(defconstant *image-unit* 32)
+
+(defconstant *image-pad* 32)
+
+
+;;-----------------------------------------------------------------------------
+;; Foreign Functions
+;;-----------------------------------------------------------------------------
+
+#+(and lucid apollo (not lcl3.0))
+(lucid::define-foreign-function '(connect-to-server "connect_to_server")
+  '((:val host    :string)
+    (:val display :integer32))
+  :integer32)
+
+#+(and lucid (not apollo) (not lcl3.0))
+(lucid::define-c-function connect-to-server (host display)
+  :result-type :integer)
+
+#+lcl3.0
+(lucid::def-foreign-function
+    (connect-to-server 
+      (:language :c)
+      (:return-type :signed-32bit))
+  (host :simple-string)
+  (display :signed-32bit))
diff --git a/src/clx/dependent.lsp b/src/clx/dependent.lsp
new file mode 100644
index 000000000..b6d4ee2f0
--- /dev/null
+++ b/src/clx/dependent.lsp
@@ -0,0 +1,3393 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;; This file contains some of the system dependent code for CLX
+
+;;;(c) Copyright Enhancements by Giuseppe Attardi, 1994.
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+;;; The size of the output buffer.  Must be a multiple of 4.
+(defparameter *output-buffer-size* 8192)
+
+#+explorer
+(zwei:define-indentation event-case (1 1))
+
+;;; Number of seconds to wait for a reply to a server request
+(defparameter *reply-timeout* nil) 
+
+#-(or clx-overlapping-arrays (not clx-little-endian))
+(progn
+  (defconstant *word-0* 0)
+  (defconstant *word-1* 1)
+
+  (defconstant *long-0* 0)
+  (defconstant *long-1* 1)
+  (defconstant *long-2* 2)
+  (defconstant *long-3* 3))
+
+#-(or clx-overlapping-arrays clx-little-endian)
+(progn
+  (defconstant *word-0* 1)
+  (defconstant *word-1* 0)
+
+  (defconstant *long-0* 3)
+  (defconstant *long-1* 2)
+  (defconstant *long-2* 1)
+  (defconstant *long-3* 0))
+
+;;; Set some compiler-options for often used code
+
+(eval-when (eval compile load)
+
+(defconstant *buffer-speed* 3
+  "Speed compiler option for buffer code.")
+(defconstant *buffer-safety* #+clx-debugging 3 #-clx-debugging 0
+  "Safety compiler option for buffer code.")
+
+(defun declare-bufmac ()
+  `(declare (optimize (speed ,*buffer-speed*) (safety ,*buffer-safety*))))
+
+;;; It's my impression that in lucid there's some way to make a declaration
+;;; called fast-entry or something that causes a function to not do some
+;;; checking on args. Sadly, we have no lucid manuals here.  If such a
+;;; declaration is available, it would be a good idea to make it here when
+;;; *buffer-speed* is 3 and *buffer-safety* is 0.
+(defun declare-buffun ()
+  `(declare (optimize (speed ,*buffer-speed*) (safety ,*buffer-safety*))))
+
+)
+
+(declaim (inline card8->int8 int8->card8
+		 card16->int16 int16->card16
+		 card32->int32 int32->card32))
+
+#-(or Genera ecl)
+(progn
+
+(defun card8->int8 (x)
+  (declare (type card8 x))
+  (declare (values int8))
+  #.(declare-buffun)
+  (the int8 (if (logbitp 7 x)
+		(the int8 (- x #x100))
+	      x)))
+
+(defun int8->card8 (x)
+  (declare (type int8 x))
+  (declare (values card8))
+  #.(declare-buffun)
+  (the card8 (ldb (byte 8 0) x)))
+
+(defun card16->int16 (x)
+  (declare (type card16 x))
+  (declare (values int16))
+  #.(declare-buffun)
+  (the int16 (if (logbitp 15 x)
+		 (the int16 (- x #x10000))
+		 x)))
+
+(defun int16->card16 (x)
+  (declare (type int16 x))
+  (declare (values card16))
+  #.(declare-buffun)
+  (the card16 (ldb (byte 16 0) x)))
+
+(defun card32->int32 (x)
+  (declare (type card32 x))
+  (declare (values int32))
+  #.(declare-buffun)
+  (the int32 (if (logbitp 31 x)
+		 (the int32 (- x #x100000000))
+		 x)))
+
+(defun int32->card32 (x)
+  (declare (type int32 x))
+  (declare (values card32))
+  #.(declare-buffun)
+  (the card32 (ldb (byte 32 0) x)))
+
+)
+
+#+Genera
+(progn
+
+(defun card8->int8 (x)
+  (declare lt:(side-effects simple reducible))
+  (if (logbitp 7 x) (- x #x100) x))
+
+(defun int8->card8 (x)
+  (declare lt:(side-effects simple reducible))
+  (ldb (byte 8 0) x))
+
+(defun card16->int16 (x)
+  (declare lt:(side-effects simple reducible))
+  (if (logbitp 15 x) (- x #x10000) x))
+
+(defun int16->card16 (x)
+  (declare lt:(side-effects simple reducible))
+  (ldb (byte 16 0) x))
+
+(defun card32->int32 (x)
+  (declare lt:(side-effects simple reducible))
+  (sys:%logldb (byte 32 0) x))
+
+(defun int32->card32 (x)
+  (declare lt:(side-effects simple reducible))
+  (ldb (byte 32 0) x))
+
+)
+
+(declaim (inline aref-card8 aset-card8 aref-int8 aset-int8))
+
+#-(or Genera lcl3.0 excl ecl)
+(progn
+
+(defun aref-card8 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values card8))
+  #.(declare-buffun)
+  (the card8 (aref a i)))
+
+(defun aset-card8 (v a i)
+  (declare (type card8 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a i) v))
+
+(defun aref-int8 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values int8))
+  #.(declare-buffun)
+  (card8->int8 (aref a i)))
+
+(defun aset-int8 (v a i)
+  (declare (type int8 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a i) (int8->card8 v)))
+
+)
+
+#+Genera
+(progn
+
+(defun aref-card8 (a i)
+  (aref a i))
+
+(defun aset-card8 (v a i)
+  (zl:aset v a i))
+
+(defun aref-int8 (a i)
+  (card8->int8 (aref a i)))
+
+(defun aset-int8 (v a i)
+  (zl:aset (int8->card8 v) a i))
+
+)
+
+#+(or excl lcl3.0 clx-overlapping-arrays)
+(declaim (inline aref-card16 aref-int16 aref-card32 aref-int32 aref-card29
+		 aset-card16 aset-int16 aset-card32 aset-int32 aset-card29))
+
+#+(and clx-overlapping-arrays Genera)
+(progn
+
+(defun aref-card16 (a i)
+  (aref a i))
+
+(defun aset-card16 (v a i)
+  (zl:aset v a i))
+
+(defun aref-int16 (a i)
+  (card16->int16 (aref a i)))
+
+(defun aset-int16 (v a i)
+  (zl:aset (int16->card16 v) a i)
+  v)
+
+(defun aref-card32 (a i)
+  (int32->card32 (aref a i)))
+
+(defun aset-card32 (v a i)
+  (zl:aset (card32->int32 v) a i))
+
+(defun aref-int32 (a i) (aref a i))
+
+(defun aset-int32 (v a i)
+  (zl:aset v a i))
+
+(defun aref-card29 (a i)
+  (aref a i))
+
+(defun aset-card29 (v a i)
+  (zl:aset v a i))
+
+)
+
+#+(and clx-overlapping-arrays (not Genera))
+(progn
+
+(defun aref-card16 (a i)
+  (aref a i))
+
+(defun aset-card16 (v a i)
+  (setf (aref a i) v))
+
+(defun aref-int16 (a i)
+  (card16->int16 (aref a i)))
+
+(defun aset-int16 (v a i)
+  (setf (aref a i) (int16->card16 v))
+  v)
+
+(defun aref-card32 (a i)
+  (aref a i))
+
+(defun aset-card32 (v a i)
+  (setf (aref a i) v))
+
+(defun aref-int32 (a i)
+  (card32->int32 (aref a i)))
+
+(defun aset-int32 (v a i)
+  (setf (aref a i) (int32->card32 v))
+  v)
+
+(defun aref-card29 (a i)
+  (aref a i))
+
+(defun aset-card29 (v a i)
+  (setf (aref a i) v))
+
+)
+
+#+excl
+(progn
+  
+(defun aref-card8 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values card8))
+  #.(declare-buffun)
+  (the card8 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+			 :unsigned-byte)))
+
+(defun aset-card8 (v a i)
+  (declare (type card8 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+		    :unsigned-byte) v))
+
+(defun aref-int8 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values int8))
+  #.(declare-buffun)
+  (the int8 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+			:signed-byte)))
+
+(defun aset-int8 (v a i)
+  (declare (type int8 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+		    :signed-byte) v))
+
+(defun aref-card16 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values card16))
+  #.(declare-buffun)
+  (the card16 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+			  :unsigned-word)))
+  
+(defun aset-card16 (v a i)
+  (declare (type card16 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+		    :unsigned-word) v))
+  
+(defun aref-int16 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values int16))
+  #.(declare-buffun)
+  (the int16 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+			 :signed-word)))
+  
+(defun aset-int16 (v a i)
+  (declare (type int16 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+		    :signed-word) v))
+  
+(defun aref-card32 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values card32))
+  #.(declare-buffun)
+  (the card32 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+			  :unsigned-long)))
+    
+(defun aset-card32 (v a i)
+  (declare (type card32 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+		    :unsigned-long) v))
+
+(defun aref-int32 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values int32))
+  #.(declare-buffun)
+  (the int32 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+			 :signed-long)))
+    
+(defun aset-int32 (v a i)
+  (declare (type int32 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+		    :signed-long) v))
+
+(defun aref-card29 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values card29))
+  #.(declare-buffun)
+  (the card29 (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+			  :unsigned-long)))
+
+(defun aset-card29 (v a i)
+  (declare (type card29 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (sys:memref a #.(comp::mdparam 'comp::md-svector-data0-adj) i
+		    :unsigned-long) v))
+  
+)
+
+#+lcl3.0
+(progn
+
+(defun aref-card8 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i)
+	   (values card8))
+  #.(declare-buffun)
+  (the card8 (lucid::%svref-8bit a i)))
+
+(defun aset-card8 (v a i)
+  (declare (type card8 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (lucid::%svref-8bit a i) v))
+
+(defun aref-int8 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i)
+	   (values int8))
+  #.(declare-buffun)
+  (the int8 (lucid::%svref-signed-8bit a i)))
+
+(defun aset-int8 (v a i)
+  (declare (type int8 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (lucid::%svref-signed-8bit a i) v))
+
+(defun aref-card16 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i)
+	   (values card16))
+  #.(declare-buffun)
+  (the card16 (lucid::%svref-16bit a (index-ash i -1))))
+  
+(defun aset-card16 (v a i)
+  (declare (type card16 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (lucid::%svref-16bit a (index-ash i -1)) v))
+  
+(defun aref-int16 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i)
+	   (values int16))
+  #.(declare-buffun)
+  (the int16 (lucid::%svref-signed-16bit a (index-ash i -1))))
+  
+(defun aset-int16 (v a i)
+  (declare (type int16 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (lucid::%svref-signed-16bit a (index-ash i -1)) v))
+
+(defun aref-card32 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i)
+	   (values card32))
+  #.(declare-buffun)
+  (the card32 (lucid::%svref-32bit a (index-ash i -2))))
+    
+(defun aset-card32 (v a i)
+  (declare (type card32 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (lucid::%svref-32bit a (index-ash i -2)) v))
+
+(defun aref-int32 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i)
+	   (values int32))
+  #.(declare-buffun)
+  (the int32 (lucid::%svref-signed-32bit a (index-ash i -2))))
+    
+(defun aset-int32 (v a i)
+  (declare (type int32 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (lucid::%svref-signed-32bit a (index-ash i -2)) v))
+
+(defun aref-card29 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i)
+	   (values card29))
+  #.(declare-buffun)
+  (the card29 (lucid::%svref-32bit a (index-ash i -2))))
+
+(defun aset-card29 (v a i)
+  (declare (type card29 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (lucid::%svref-32bit a (index-ash i -2)) v))
+
+)
+
+
+
+#-(or ecl excl lcl3.0 clx-overlapping-arrays)
+(progn
+
+(defun aref-card16 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values card16))
+  #.(declare-buffun)
+  (the card16
+       (logior (the card16
+		    (ash (the card8 (aref a (index+ i *word-1*))) 8))
+	       (the card8
+		    (aref a (index+ i *word-0*))))))
+
+(defun aset-card16 (v a i)
+  (declare (type card16 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i *word-1*)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i *word-0*)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+(defun aref-int16 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values int16))
+  #.(declare-buffun)
+  (the int16
+       (logior (the int16
+		    (ash (the int8 (aref-int8 a (index+ i *word-1*))) 8))
+	       (the card8
+		    (aref a (index+ i *word-0*))))))
+
+(defun aset-int16 (v a i)
+  (declare (type int16 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i *word-1*)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i *word-0*)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+(defun aref-card32 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values card32))
+  #.(declare-buffun)
+  (the card32
+       (logior (the card32
+		    (ash (the card8 (aref a (index+ i *long-3*))) 24))
+	       (the card29
+		    (ash (the card8 (aref a (index+ i *long-2*))) 16))
+	       (the card16
+		    (ash (the card8 (aref a (index+ i *long-1*))) 8))
+	       (the card8
+		    (aref a (index+ i *long-0*))))))
+
+(defun aset-card32 (v a i)
+  (declare (type card32 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i *long-3*)) (the card8 (ldb (byte 8 24) v))
+	(aref a (index+ i *long-2*)) (the card8 (ldb (byte 8 16) v))
+	(aref a (index+ i *long-1*)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i *long-0*)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+(defun aref-int32 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values int32))
+  #.(declare-buffun)
+  (the int32
+       (logior (the int32
+		    (ash (the int8 (aref-int8 a (index+ i *long-3*))) 24))
+	       (the card29
+		    (ash (the card8 (aref a (index+ i *long-2*))) 16))
+	       (the card16
+		    (ash (the card8 (aref a (index+ i *long-1*))) 8))
+	       (the card8
+		    (aref a (index+ i *long-0*))))))
+
+(defun aset-int32 (v a i)
+  (declare (type int32 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i *long-3*)) (the card8 (ldb (byte 8 24) v))
+	(aref a (index+ i *long-2*)) (the card8 (ldb (byte 8 16) v))
+	(aref a (index+ i *long-1*)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i *long-0*)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+(defun aref-card29 (a i)
+  (declare (type buffer-bytes a)
+	   (type array-index i))
+  (declare (values card29))
+  #.(declare-buffun)
+  (the card29
+       (logior (the card29
+		    (ash (the card8 (aref a (index+ i *long-3*))) 24))
+	       (the card29
+		    (ash (the card8 (aref a (index+ i *long-2*))) 16))
+	       (the card16
+		    (ash (the card8 (aref a (index+ i *long-1*))) 8))
+	       (the card8
+		    (aref a (index+ i *long-0*))))))
+
+(defun aset-card29 (v a i)
+  (declare (type card29 v)
+	   (type buffer-bytes a)
+	   (type array-index i))
+  #.(declare-buffun)
+  (setf (aref a (index+ i *long-3*)) (the card8 (ldb (byte 8 24) v))
+	(aref a (index+ i *long-2*)) (the card8 (ldb (byte 8 16) v))
+	(aref a (index+ i *long-1*)) (the card8 (ldb (byte 8 8) v))
+	(aref a (index+ i *long-0*)) (the card8 (ldb (byte 8 0) v)))
+  v)
+
+)
+
+(defsetf aref-card8 (a i) (v)
+  `(aset-card8 ,v ,a ,i))
+
+(defsetf aref-int8 (a i) (v)
+  `(aset-int8 ,v ,a ,i))
+
+(defsetf aref-card16 (a i) (v)
+  `(aset-card16 ,v ,a ,i))
+
+(defsetf aref-int16 (a i) (v)
+  `(aset-int16 ,v ,a ,i))
+
+(defsetf aref-card32 (a i) (v)
+  `(aset-card32 ,v ,a ,i))
+
+(defsetf aref-int32 (a i) (v)
+  `(aset-int32 ,v ,a ,i))
+
+(defsetf aref-card29 (a i) (v)
+  `(aset-card29 ,v ,a ,i))
+
+;;; Other random conversions
+
+(defun rgb-val->card16 (value)
+  ;; Short floats are good enough
+  (declare (type rgb-val value))
+  (declare (values card16))
+  #.(declare-buffun)
+  ;; Convert VALUE from float to card16
+  (the card16 (values (round (the rgb-val value) #.(/ 1.0s0 #xffff)))))
+
+(defun card16->rgb-val (value) 
+  ;; Short floats are good enough
+  (declare (type card16 value))
+  (declare (values short-float))
+  #.(declare-buffun)
+  ;; Convert VALUE from card16 to float
+  (the short-float (* (the card16 value) #.(/ 1.0s0 #xffff))))
+
+(defun radians->int16 (value)
+  ;; Short floats are good enough
+  (declare (type angle value))
+  (declare (values int16))
+  #.(declare-buffun)
+  (the int16 (values (round (the angle value) #.(float (/ pi 180.0s0 64.0s0) 0.0s0)))))
+
+(defun int16->radians (value)
+  ;; Short floats are good enough
+  (declare (type int16 value))
+  (declare (values short-float))
+  #.(declare-buffun)
+  (the short-float (* (the int16 value) #.(coerce (/ pi 180.0 64.0) 'short-float))))
+
+
+;;-----------------------------------------------------------------------------
+;; Character transformation
+;;-----------------------------------------------------------------------------
+
+
+;;; This stuff transforms chars to ascii codes in card8's and back.
+;;; You might have to hack it a little to get it to work for your machine.
+
+(declaim (inline char->card8 card8->char))
+#+ecl
+(declaim (ftype (function (character) card8) char->card8)
+	 (ftype (function (card8) character) card8->char))
+
+(macrolet ((char-translators ()
+	     (let ((alist
+		     `(#-lispm
+		       ;; The normal ascii codes for the control characters.
+		       ,@`((#\Return . 13)
+			   (#\Linefeed . 10)
+			   (#\Rubout . 127)
+			   (#\Page . 12)
+			   (#\Tab . 9)
+			   (#\Backspace . 8)
+			   (#\Newline . 10)
+			   (#\Space . 32))
+		       ;; One the lispm, #\Newline is #\Return, but we'd really like
+		       ;; #\Newline to translate to ascii code 10, so we swap the
+		       ;; Ascii codes for #\Return and #\Linefeed. We also provide
+		       ;; mappings from the counterparts of these control characters
+		       ;; so that the character mapping from the lisp machine
+		       ;; character set to ascii is invertible.
+		       #+lispm
+		       ,@`((#\Return . 10)   (,(code-char  10) . ,(char-code #\Return))
+			   (#\Linefeed . 13) (,(code-char  13) . ,(char-code #\Linefeed))
+			   (#\Rubout . 127)  (,(code-char 127) . ,(char-code #\Rubout))
+			   (#\Page . 12)     (,(code-char  12) . ,(char-code #\Page))
+			   (#\Tab . 9)       (,(code-char   9) . ,(char-code #\Tab))
+			   (#\Backspace . 8) (,(code-char   8) . ,(char-code #\Backspace))
+			   (#\Newline . 10)  (,(code-char  10) . ,(char-code #\Newline))
+			   (#\Space . 32)    (,(code-char  32) . ,(char-code #\Space)))
+		       ;; The rest of the common lisp charater set with the normal
+		       ;; ascii codes for them.
+		       (#\! . 33) (#\" . 34) (#\# . 35) (#\$ . 36)
+		       (#\% . 37) (#\& . 38) (#\' . 39) (#\( . 40)
+		       (#\) . 41) (#\* . 42) (#\+ . 43) (#\, . 44)
+		       (#\- . 45) (#\. . 46) (#\/ . 47) (#\0 . 48)
+		       (#\1 . 49) (#\2 . 50) (#\3 . 51) (#\4 . 52)
+		       (#\5 . 53) (#\6 . 54) (#\7 . 55) (#\8 . 56)
+		       (#\9 . 57) (#\: . 58) (#\; . 59) (#\< . 60)
+		       (#\= . 61) (#\> . 62) (#\? . 63) (#\@ . 64)
+		       (#\A . 65) (#\B . 66) (#\C . 67) (#\D . 68)
+		       (#\E . 69) (#\F . 70) (#\G . 71) (#\H . 72)
+		       (#\I . 73) (#\J . 74) (#\K . 75) (#\L . 76)
+		       (#\M . 77) (#\N . 78) (#\O . 79) (#\P . 80)
+		       (#\Q . 81) (#\R . 82) (#\S . 83) (#\T . 84)
+		       (#\U . 85) (#\V . 86) (#\W . 87) (#\X . 88)
+		       (#\Y . 89) (#\Z . 90) (#\[ . 91) (#\\ . 92)
+		       (#\] . 93) (#\^ . 94) (#\_ . 95) (#\` . 96)
+		       (#\a . 97) (#\b . 98) (#\c . 99) (#\d . 100)
+		       (#\e . 101) (#\f . 102) (#\g . 103) (#\h . 104)
+		       (#\i . 105) (#\j . 106) (#\k . 107) (#\l . 108)
+		       (#\m . 109) (#\n . 110) (#\o . 111) (#\p . 112)
+		       (#\q . 113) (#\r . 114) (#\s . 115) (#\t . 116)
+		       (#\u . 117) (#\v . 118) (#\w . 119) (#\x . 120)
+		       (#\y . 121) (#\z . 122) (#\{ . 123) (#\| . 124)
+		       (#\} . 125) (#\~ . 126))))
+	       (cond ((dolist (pair alist nil)
+			(when (not (= (char-code (car pair)) (cdr pair)))
+			  (return t)))
+		      `(progn
+			 (defconstant *char-to-card8-translation-table*
+				      ',(let ((array (make-array
+						       (let ((max-char-code 255))
+							 (dolist (pair alist)
+							   (setq max-char-code
+								 (max max-char-code
+								      (char-code (car pair)))))
+							 (1+ max-char-code))
+						       :element-type 'card8)))
+					  (dotimes (i (length array))
+					    (setf (aref array i) (mod i 256)))
+					  (dolist (pair alist)
+					    (setf (aref array (char-code (car pair)))
+						  (cdr pair)))
+					  array))
+			 (defconstant *card8-to-char-translation-table*
+				      ',(let ((array (make-string 256)))
+					  (dotimes (i (length array))
+					    (setf (aref array i) (code-char i)))
+					  (dolist (pair alist)
+					    (setf (aref array (cdr pair)) (car pair)))
+					  array))
+			 #-Genera
+			 (progn
+  			   (defun char->card8 (char)
+			     (declare (type base-char char))
+			     #.(declare-buffun)
+			     (the card8 (aref (the #+ecl buffer-bytes
+						   #-ecl (simple-array card8 (*))
+						   *char-to-card8-translation-table*)
+					      (the array-index (char-code char)))))
+			   (defun card8->char (card8)
+			     (declare (type card8 card8))
+			     #.(declare-buffun)
+			     (the base-char
+				  (aref (the simple-string *card8-to-char-translation-table*)
+					card8)))
+			   )
+			 #+Genera
+			 (progn
+			   (defun char->card8 (char)
+			     (declare lt:(side-effects reader reducible))
+			     (aref *char-to-card8-translation-table* (char-code char)))
+			   (defun card8->char (card8)
+			     (declare lt:(side-effects reader reducible))
+			     (aref *card8-to-char-translation-table* card8))
+			   )
+			 (dotimes (i 256)
+			   (unless (= i (char->card8 (card8->char i)))
+			     (warn "The card8->char mapping is not invertible through char->card8.  Info:~%~S"
+				   (list i
+					 (card8->char i)
+					 (char->card8 (card8->char i))))
+			     (return nil)))
+			 (dotimes (i (length *char-to-card8-translation-table*))
+			   (let ((char (code-char i)))
+			     (unless (eql char (card8->char (char->card8 char)))
+			       (warn "The char->card8 mapping is not invertible through card8->char.  Info:~%~S"
+				     (list char
+					   (char->card8 char)
+					   (card8->char (char->card8 char))))
+			       (return nil))))))
+		     (t
+		      `(progn
+			 (defun char->card8 (char)
+			   (declare (type base-char char))
+			   #.(declare-buffun)
+			   (the card8 (char-code char)))
+			 (defun card8->char (card8)
+			   (declare (type card8 card8))
+			   #.(declare-buffun)
+			   (the base-char (code-char card8)))
+			 ))))))
+  (char-translators))
+
+;;-----------------------------------------------------------------------------
+;; Process Locking
+;;
+;;	Common-Lisp doesn't provide process locking primitives, so we define
+;;	our own here, based on Zetalisp primitives.  Holding-Lock is very
+;;	similar to with-lock on The TI Explorer, and a little more efficient
+;;	than with-process-lock on a Symbolics.
+;;-----------------------------------------------------------------------------
+
+;;; MAKE-PROCESS-LOCK: Creating a process lock.
+
+#-(or LispM excl Minima)
+(defun make-process-lock (name)
+  (declare (ignore name))
+  nil)
+
+#+excl
+(defun make-process-lock (name)
+  (mp:make-process-lock :name name))
+
+#+(and LispM (not Genera))
+(defun make-process-lock (name)
+  (vector nil name))
+
+#+Genera
+(defun make-process-lock (name)
+  (process:make-lock name :flavor 'clx-lock))
+
+#+Minima
+(defun make-process-lock (name)
+  (minima:make-lock name))
+
+;;; HOLDING-LOCK: Execute a body of code with a lock held.
+
+;;; The holding-lock macro takes a timeout keyword argument.  EVENT-LISTEN
+;;; passes its timeout to the holding-lock macro, so any timeout you want to
+;;; work for event-listen you should do for holding-lock.
+
+;; If you're not sharing DISPLAY objects within a multi-processing
+;; shared-memory environment, this is sufficient
+#-(or lispm excl lcl3.0 Minima)
+(defmacro holding-lock ((locator display &optional whostate &key timeout) &body body)
+  (declare (ignore locator display whostate timeout))
+  `(progn ,@body))
+
+#+Genera
+(defmacro holding-lock ((locator display &optional whostate &key timeout)
+			&body body)
+  (declare (ignore whostate))
+  `(process:with-lock (,locator :timeout ,timeout)
+     (let ((.debug-io. (buffer-debug-io ,display)))
+       (scl:let-if .debug-io. ((*debug-io* .debug-io.))
+	 ,@body))))
+
+#+(and lispm (not Genera))
+(defmacro holding-lock ((locator display &optional whostate &key timeout)
+			&body body)
+  (declare (ignore display))
+  ;; This macro is for use in a multi-process environment.
+  (let ((lock (gensym))
+	(have-lock (gensym))
+	(timeo (gensym)))
+    `(let* ((,lock (zl:locf (svref ,locator 0)))
+	    (,have-lock (eq (car ,lock) sys:current-process))
+	    (,timeo ,timeout))
+       (unwind-protect 
+	   (when (cond (,have-lock)
+		       ((#+explorer si:%store-conditional
+			 #-explorer sys:store-conditional
+			 ,lock nil sys:current-process))
+		       ((null ,timeo)
+			(sys:process-lock ,lock nil ,(or whostate "CLX Lock")))
+		       ((sys:process-wait-with-timeout
+			    ,(or whostate "CLX Lock") (round (* ,timeo 60.))
+			  #'(lambda (lock process)
+			      (#+explorer si:%store-conditional
+			       #-explorer sys:store-conditional
+			       lock nil process))
+			  ,lock sys:current-process)))
+	     ,@body)
+	 (unless ,have-lock
+	   (#+explorer si:%store-conditional
+	    #-explorer sys:store-conditional
+	    ,lock sys:current-process nil))))))
+
+;; Lucid has a process locking mechanism as well under release 3.0
+#+lcl3.0
+(defmacro holding-lock ((locator display &optional whostate &key timeout)
+			&body body)
+  (declare (ignore display))
+  (if timeout
+      ;; Hair to support timeout.
+      `(let ((.have-lock. (eq ,locator lcl:*current-process*))
+	     (.timeout. ,timeout))
+	 (unwind-protect
+	     (when (cond (.have-lock.)
+			 ((conditional-store ,locator nil lcl:*current-process*))
+			 ((null .timeout.)
+			  (lcl:process-lock ,locator)
+			  t)
+			 ((lcl:process-wait-with-timeout ,whostate .timeout.
+			    #'(lambda ()
+				(conditional-store ,locator nil lcl:*current-process*))))
+			 ;; abort the PROCESS-UNLOCK if actually timing out
+			 (t
+			  (setf .have-lock. :abort)
+			  nil))
+	       ,@body)
+	   (unless .have-lock. 
+	     (lcl:process-unlock ,locator))))
+    `(lcl:with-process-lock (,locator)
+       ,@body)))
+
+
+#+excl
+(defmacro holding-lock ((locator display &optional whostate &key timeout)
+			&body body)
+  (declare (ignore display))
+  `(let (.hl-lock. .hl-obtained-lock. .hl-curproc.)
+     (unwind-protect
+	 (block .hl-doit.
+	   (when mp::*scheduler-stack-group* ; fast test for scheduler running
+	     (setq .hl-lock. ,locator
+		   .hl-curproc. mp::*current-process*)
+	     (when (and .hl-curproc.	; nil if in process-wait fun
+			(not (eq (mp::process-lock-locker .hl-lock.)
+				 .hl-curproc.)))
+	       ;; Then we need to grab the lock.
+	       ,(if timeout
+		    `(if (not (mp::process-lock .hl-lock. .hl-curproc.
+						,whostate ,timeout))
+			 (return-from .hl-doit. nil))
+		  `(mp::process-lock .hl-lock. .hl-curproc.
+				     ,@(when whostate `(,whostate))))
+	       ;; There is an apparent race condition here.  However, there is
+	       ;; no actual race condition -- our implementation of mp:process-
+	       ;; lock guarantees that the lock will still be held when it
+	       ;; returns, and no interrupt can happen between that and the
+	       ;; execution of the next form.  -- jdi 2/27/91
+	       (setq .hl-obtained-lock. t)))
+	   ,@body)
+       (if (and .hl-obtained-lock.
+		;; Note -- next form added to allow error handler inside
+		;; body to unlock the lock prematurely if it knows that
+		;; the current process cannot possibly continue but will
+		;; throw out (or is it throw up?).
+		(eq (mp::process-lock-locker .hl-lock.) .hl-curproc.))
+	   (mp::process-unlock .hl-lock. .hl-curproc.)))))
+
+#+Minima
+(defmacro holding-lock ((locator display &optional whostate &key timeout) &body body)
+  `(holding-lock-1 #'(lambda () ,@body) ,locator ,display
+		   ,@(and whostate `(:whostate ,whostate))
+		   ,@(and timeout `(:timeout ,timeout))))
+
+#+Minima
+(defun holding-lock-1 (continuation lock display &key (whostate "Lock") timeout)
+  (declare (dynamic-extent continuation))
+  (declare (ignore display whostate timeout))
+  (minima:with-lock (lock)
+    (funcall continuation)))
+
+;;; WITHOUT-ABORTS
+
+;;; If you can inhibit asynchronous keyboard aborts inside the body of this
+;;; macro, then it is a good idea to do this.  This macro is wrapped around
+;;; request writing and reply reading to ensure that requests are atomically
+;;; written and replies are atomically read from the stream.
+
+#-(or Genera excl lcl3.0)
+(defmacro without-aborts (&body body)
+  `(progn ,@body))
+
+#+Genera
+(defmacro without-aborts (&body body)
+  `(sys:without-aborts (clx "CLX is in the middle of an operation that should be atomic.")
+     ,@body))
+
+#+excl
+(defmacro without-aborts (&body body)
+  `(without-interrupts ,@body))
+    
+#+lcl3.0
+(defmacro without-aborts (&body body)
+  `(lcl:with-interruptions-inhibited ,@body))
+
+;;; PROCESS-BLOCK: Wait until a given predicate returns a non-NIL value.
+;;; Caller guarantees that PROCESS-WAKEUP will be called after the predicate's
+;;; value changes.
+
+#-(or lispm excl lcl3.0 Minima)
+(defun process-block (whostate predicate &rest predicate-args)
+  (declare (ignore whostate))
+  (or (apply predicate predicate-args)
+      (error "Program tried to wait with no scheduler.")))
+
+#+Genera
+(defun process-block (whostate predicate &rest predicate-args)
+  (declare (type function predicate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent predicate)
+	   #-clx-ansi-common-lisp
+	   (sys:downward-funarg predicate))
+  (apply #'process:block-process whostate predicate predicate-args))
+
+#+(and lispm (not Genera))
+(defun process-block (whostate predicate &rest predicate-args)
+  (declare (type function predicate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent predicate)
+	   #-clx-ansi-common-lisp 
+	   (sys:downward-funarg predicate))
+  (apply #'global:process-wait whostate predicate predicate-args))
+
+#+excl
+(defun process-block (whostate predicate &rest predicate-args)
+  (if mp::*scheduler-stack-group*
+      (apply #'mp::process-wait whostate predicate predicate-args)
+      (or (apply predicate predicate-args)
+	  (error "Program tried to wait with no scheduler."))))
+
+#+lcl3.0
+(defun process-block (whostate predicate &rest predicate-args)
+  (declare (dynamic-extent predicate-args))
+  (apply #'lcl:process-wait whostate predicate predicate-args))
+
+#+Minima
+(defun process-block (whostate predicate &rest predicate-args)
+  (declare (type function predicate)
+	   (dynamic-extent predicate))
+  (apply #'minima:process-wait whostate predicate predicate-args))
+
+;;; PROCESS-WAKEUP: Check some other process' wait function.
+
+(declaim (inline process-wakeup))
+
+#-(or excl Genera Minima)
+(defun process-wakeup (process)
+  (declare (ignore process))
+  nil)
+
+#+excl
+(defun process-wakeup (process)
+  (let ((curproc mp::*current-process*))
+    (when (and curproc process)
+      (unless (mp::process-p curproc)
+	(error "~s is not a process" curproc))
+      (unless (mp::process-p process)
+	(error "~s is not a process" process))
+      (if (> (mp::process-priority process) (mp::process-priority curproc))
+	  (mp::process-allow-schedule process)))))
+
+#+Genera
+(defun process-wakeup (process)
+  (process:wakeup process))
+
+#+Minima
+(defun process-wakeup (process)
+  (minima:process-wakeup process))
+
+;;; CURRENT-PROCESS: Return the current process object for input locking and
+;;; for calling PROCESS-WAKEUP.
+
+(declaim (inline current-process))
+
+;;; Default return NIL, which is acceptable even if there is a scheduler.
+
+#-(or lispm excl lcl3.0 Minima)
+(defun current-process ()
+  nil)
+
+#+lispm
+(defun current-process ()
+  sys:current-process)
+
+#+excl
+(defun current-process ()
+  (and mp::*scheduler-stack-group*
+       mp::*current-process*))
+
+#+lcl3.0
+(defun current-process ()
+  lcl:*current-process*)
+
+#+Minima
+(defun current-process ()
+  (minima:current-process))
+
+;;; WITHOUT-INTERRUPTS -- provide for atomic operations.
+
+#-(or lispm excl lcl3.0 Minima)
+(defmacro without-interrupts (&body body)
+  `(progn ,@body))
+
+#+(and lispm (not Genera))
+(defmacro without-interrupts (&body body)
+  `(sys:without-interrupts ,@body))
+
+#+Genera
+(defmacro without-interrupts (&body body)
+  `(process:with-no-other-processes ,@body))
+
+#+LCL3.0
+(defmacro without-interrupts (&body body)
+  `(lcl:with-scheduling-inhibited ,@body))
+
+#+Minima
+(defmacro without-interrupts (&body body)
+  `(minima:with-no-other-processes ,@body))
+
+;;; CONDITIONAL-STORE:
+
+;; This should use GET-SETF-METHOD to avoid evaluating subforms multiple times.
+;; It doesn't because CLtL doesn't pass the environment to GET-SETF-METHOD.
+(defmacro conditional-store (place old-value new-value)
+  `(without-interrupts
+     (cond ((eq ,place ,old-value)
+	    (setf ,place ,new-value)
+	    t))))
+
+;;;----------------------------------------------------------------------------
+;;; IO Error Recovery
+;;;	All I/O operations are done within a WRAP-BUF-OUTPUT macro.
+;;;	It prevents multiple mindless errors when the network craters.
+;;;
+;;;----------------------------------------------------------------------------
+
+#-Genera
+(defmacro wrap-buf-output ((buffer) &body body)
+  ;; Error recovery wrapper
+  `(unless (buffer-dead ,buffer)
+     ,@body))
+
+#+Genera
+(defmacro wrap-buf-output ((buffer) &body body)
+  ;; Error recovery wrapper
+  `(let ((.buffer. ,buffer))
+     (unless (buffer-dead .buffer.)
+       (scl:condition-bind
+	 (((sys:network-error)
+	   #'(lambda (error)
+	       (scl:condition-case () 
+		    (funcall (buffer-close-function .buffer.) .buffer. :abort t)
+		  (sys:network-error))
+	       (setf (buffer-dead .buffer.) error)
+	       (setf (buffer-output-stream .buffer.) nil)
+	       (setf (buffer-input-stream .buffer.) nil)
+	       nil)))
+	 ,@body))))
+
+#-Genera
+(defmacro wrap-buf-input ((buffer) &body body)
+  (declare (ignore buffer))
+  ;; Error recovery wrapper
+  `(progn ,@body))
+
+#+Genera
+(defmacro wrap-buf-input ((buffer) &body body)
+  ;; Error recovery wrapper
+  `(let ((.buffer. ,buffer))
+     (scl:condition-bind
+       (((sys:network-error)
+	 #'(lambda (error)
+	     (scl:condition-case () 
+		  (funcall (buffer-close-function .buffer.) .buffer. :abort t)
+		(sys:network-error))
+	     (setf (buffer-dead .buffer.) error)
+	     (setf (buffer-output-stream .buffer.) nil)
+	     (setf (buffer-input-stream .buffer.) nil)
+	     nil)))
+       ,@body)))
+
+
+;;;----------------------------------------------------------------------------
+;;; System dependent IO primitives
+;;;	Functions for opening, reading writing forcing-output and closing 
+;;;	the stream to the server.
+;;;----------------------------------------------------------------------------
+
+;;; OPEN-X-STREAM - create a stream for communicating to the appropriate X
+;;; server
+
+#-(or explorer Genera lucid kcl ibcl excl Minima ecl)
+(defun open-x-stream (host display protocol)
+  host display protocol ;; unused
+  (error "OPEN-X-STREAM not implemented yet."))
+
+;;; Genera:
+
+;;; TCP and DNA are both layered products, so try to work with either one.
+
+#+Genera
+(when (fboundp 'tcp:add-tcp-port-for-protocol)
+  (tcp:add-tcp-port-for-protocol :x-window-system 6000))
+
+#+Genera
+(when (fboundp 'dna:add-dna-contact-id-for-protocol)
+  (dna:add-dna-contact-id-for-protocol :x-window-system "X$X0"))
+
+#+Genera
+(net:define-protocol :x-window-system (:x-window-system :byte-stream)
+  (:invoke-with-stream ((stream :characters nil :ascii-translation nil))
+    stream))
+
+#+Genera
+(eval-when (compile)
+  (compiler:function-defined 'tcp:open-tcp-stream)
+  (compiler:function-defined 'dna:open-dna-bidirectional-stream))
+
+#+Genera
+(defun open-x-stream (host display protocol)
+  (let ((host (net:parse-host host)))
+    (if (or protocol (plusp display))
+	;; The protocol was specified or the display isn't 0, so we
+	;; can't use the Generic Network System.  If the protocol was
+	;; specified, then use that protocol, otherwise, blindly use
+	;; TCP.
+	(ccase protocol
+	  ((:tcp nil)
+	   (tcp:open-tcp-stream
+	     host (+ *x-tcp-port* display) nil
+	     :direction :io
+	     :characters nil
+	     :ascii-translation nil))
+	  ((:dna)
+	   (dna:open-dna-bidirectional-stream
+	     host (format nil "X$X~D" display)
+	     :characters nil
+	     :ascii-translation nil)))
+      (let ((neti:*invoke-service-automatic-retry* t))
+	(net:invoke-service-on-host :x-window-system host)))))
+
+#+explorer
+(defun open-x-stream (host display protocol)
+  (declare (ignore protocol))
+  (net:open-connection-on-medium
+    (net:parse-host host)			;Host
+    :byte-stream				;Medium
+    "X11"					;Logical contact name
+    :stream-type :character-stream
+    :direction :bidirectional
+    :timeout-after-open nil
+    :remote-port (+ *x-tcp-port* display)))
+
+#+explorer
+(net:define-logical-contact-name
+  "X11"
+  `((:local "X11")
+    (:chaos "X11")
+    (:nsp-stream "X11")
+    (:tcp ,*x-tcp-port*)))
+
+#+lucid
+(defun open-x-stream (host display protocol)
+  protocol ;; unused
+  (let ((fd (connect-to-server host display)))
+    (when (minusp fd)
+      (error "Failed to connect to server: ~A ~D" host display))
+    (user::make-lisp-stream :input-handle fd
+			    :output-handle fd
+			    :element-type 'unsigned-byte
+			    #-lcl3.0 :stream-type #-lcl3.0 :ephemeral)))
+
+#+(or kcl ibcl)
+(defun open-x-stream (host display protocol)
+  protocol ;; unused
+  (let ((stream (open-socket-stream host display)))
+    (if (streamp stream)
+	stream
+      (error "Cannot connect to server: ~A:~D" host display))))
+
+#+ecl
+(defun open-x-stream (host display protocol)
+  (declare (ignore protocol))
+  (let ((stream (si:open-client-stream host (+ *x-tcp-port* display))))
+    (if (streamp stream)
+	stream
+      (error "Failed to connect to server: ~A:~D" host display))))
+
+#+excl
+;;
+;; Note that since we don't use the CL i/o facilities to do i/o, the display
+;; input and output "stream" is really a file descriptor (fixnum).
+;;
+(defun open-x-stream (host display protocol)
+  (declare (ignore protocol));; unused
+  (let ((fd (connect-to-server (string host) display)))
+    (when (minusp fd)
+      (error "Failed to connect to server: ~A ~D" host display))
+    fd))
+
+#+Minima
+(defun open-x-stream (host display protocol)
+  (declare (ignore protocol));; unused
+  (minima:open-tcp-stream (minima:gensym-tcp-port)
+			  (apply #'minima:make-ip-address (cdr (host-address host)))
+			  (+ *x-tcp-port* display) :element-type '(unsigned-byte 8)))
+
+;;; BUFFER-READ-DEFAULT - read data from the X stream
+
+#+(or Genera explorer)
+(defun buffer-read-default (display vector start end timeout)
+  ;; returns non-NIL if EOF encountered
+  ;; Returns :TIMEOUT when timeout exceeded
+  (declare (type display display)
+	   (type buffer-bytes vector)
+	   (type array-index start end)
+	   (type (or null number) timeout))
+  #.(declare-buffun)
+  (let ((stream (display-input-stream display)))
+    (or (cond ((null stream))
+	      ((funcall stream :listen) nil)
+	      ((eql timeout 0) :timeout)
+	      ((buffer-input-wait-default display timeout)))
+	(multiple-value-bind (ignore eofp)
+	    (funcall stream :string-in nil vector start end)
+	  eofp))))
+
+
+#+excl
+;;
+;; Rewritten 10/89 to not use foreign function interface to do I/O.
+;;
+(defun buffer-read-default (display vector start end timeout)
+  (declare (type display display)
+	   (type buffer-bytes vector)
+	   (type array-index start end)
+	   (type (or null number) timeout))
+  #.(declare-buffun)
+    
+  (let* ((howmany (- end start))
+	 (fd (display-input-stream display)))
+    (declare (type array-index howmany)
+	     (fixnum fd))
+	  
+    (or (cond ((fd-char-avail-p fd) nil)
+	      ((eql timeout 0) :timeout)
+	      ((buffer-input-wait-default display timeout)))
+	(fd-read-bytes fd vector start howmany))))
+
+
+#+lcl3.0
+(defmacro with-underlying-stream ((variable stream display direction) &body body)
+  `(let ((,variable
+	  (or (getf (display-plist ,display) ',direction)
+	      (setf (getf (display-plist ,display) ',direction)
+		    (lucid::underlying-stream
+		      ,stream ,(if (eq direction 'input) :input :output))))))
+     ,@body))
+
+#+lcl3.0
+(defun buffer-read-default (display vector start end timeout)
+  ;;Note that LISTEN must still be done on "slow stream" or the I/O system
+  ;;gets confused.  But reading should be done from "fast stream" for speed.
+  ;;We used to inhibit scheduling because there were races in Lucid's
+  ;;multitasking system.  Empirical evidence suggests they may be gone now.
+  ;;Should you decide you need to inhibit scheduling, do it around the
+  ;;lcl:read-array.
+  (declare (type display display)
+	   (type buffer-bytes vector)
+	   (type array-index start end)
+	   (type (or null number) timeout))
+  #.(declare-buffun)
+  (let ((stream (display-input-stream display)))
+    (declare (type (or null stream) stream))
+    (or (cond ((null stream))
+	      ((listen stream) nil)
+	      ((eql timeout 0) :timeout)
+	      ((buffer-input-wait-default display timeout)))
+	(with-underlying-stream (stream stream display input)
+	  (eq (lcl:read-array stream vector start end nil :eof) :eof)))))
+
+#+Minima
+(defun buffer-read-default (display vector start end timeout)
+  ;; returns non-NIL if EOF encountered
+  ;; Returns :TIMEOUT when timeout exceeded
+  (declare (type display display)
+	   (type buffer-bytes vector)
+	   (type array-index start end)
+	   (type (or null number) timeout))
+  #.(declare-buffun)
+  (let ((stream (display-input-stream display)))
+    (or (cond ((null stream))
+	      ((listen stream) nil)
+	      ((eql timeout 0) :timeout)
+	      ((buffer-input-wait-default display timeout)))
+	(loop while (< start end) do
+	  (multiple-value-bind (buffer bstart bend)
+	      (minima:get-input-buffer stream nil)
+	    (when (null buffer) (return t))
+	    (let ((n (min (- end start) (- bend bstart))))
+	      (replace vector buffer
+		       :start1 start :end1 (incf start n)
+		       :start2 bstart :end2 (incf bstart n)))
+	    (minima:advance-input-buffer stream bstart)))
+	nil)))
+
+#+ecl
+(defun buffer-read-default (display vector start end timeout)
+  ;; returns non-NIL if EOF encountered
+  ;; Returns :TIMEOUT when timeout exceeded
+  (declare (type display display)
+	   (type buffer-bytes vector)
+	   (type array-index start end)
+	   (type (or null (rational 0 *) (float 0.0 *)) timeout))
+  (declare-buffun)
+  (let ((stream (display-input-stream display)))
+    (declare (type stream stream))
+
+    (or (cond ((null stream))
+	      ((listen stream) nil)
+	      ((eql timeout 0) :timeout)
+	      ((buffer-input-wait-default display timeout)))
+	(minusp (si:read-bytes stream vector start end)))))
+
+;;; WARNING:
+;;;	CLX performance will suffer if your lisp uses read-byte for
+;;;	receiving all data from the X Window System server.
+;;;	You are encouraged to write a specialized version of
+;;;	buffer-read-default that does block transfers.
+#-(or Genera explorer excl lcl3.0 Minima ecl)
+(defun buffer-read-default (display vector start end timeout)
+  (declare (type display display)
+	   (type buffer-bytes vector)
+	   (type array-index start end)
+	   (type (or null (rational 0 *) (float 0.0 *)) timeout))
+  #.(declare-buffun)
+  (let ((stream (display-input-stream display)))
+    (declare (type (or null stream) stream))
+    (or (cond ((null stream))
+	      ((listen stream) nil)
+	      ((eql timeout 0) :timeout)
+	      ((buffer-input-wait-default display timeout)))
+	(do* ((index start (index1+ index)))
+	     ((index>= index end) nil)
+	  (declare (type array-index index))
+	  (let ((c (read-byte stream nil nil)))
+	    (declare (type (or null card8) c))
+	    (if (null c)
+		(return t)
+	      (setf (aref vector index) (the card8 c))))))))
+
+;;; BUFFER-WRITE-DEFAULT - write data to the X stream
+
+#+(or Genera explorer)
+(defun buffer-write-default (vector display start end)
+  ;; The default buffer write function for use with common-lisp streams
+  (declare (type buffer-bytes vector)
+	   (type display display)
+	   (type array-index start end))
+  #.(declare-buffun)
+  (let ((stream (display-output-stream display)))
+    (declare (type (or null stream) stream))
+    (unless (null stream) 
+      (write-string vector stream :start start :end end))))
+
+#+excl
+(defun buffer-write-default (vector display start end)
+  (declare (type buffer-bytes vector)
+	   (type display display)
+	   (type array-index start end))
+  #.(declare-buffun)
+  (excl::filesys-write-bytes (display-output-stream display) vector start
+			     (- end start)))
+  
+#+lcl3.0
+(defun buffer-write-default (vector display start end)
+  ;;We used to inhibit scheduling because there were races in Lucid's
+  ;;multitasking system.  Empirical evidence suggests they may be gone now.
+  ;;Should you decide you need to inhibit scheduling, do it around the
+  ;;lcl:write-array.
+  (declare (type display display)
+	   (type buffer-bytes vector)
+	   (type array-index start end))
+  #.(declare-buffun)
+  (let ((stream (display-output-stream display)))
+    (declare (type (or null stream) stream))
+    (unless (null stream) 
+      (with-underlying-stream (stream stream display output)
+	(lcl:write-array stream vector start end)))))
+
+#+Minima
+(defun buffer-write-default (vector display start end)
+  ;; The default buffer write function for use with common-lisp streams
+  (declare (type buffer-bytes vector)
+	   (type display display)
+	   (type array-index start end))
+  #.(declare-buffun)
+  (let ((stream (display-output-stream display)))
+    (declare (type (or null stream) stream))
+    (unless (null stream) 
+      (loop while (< start end) do
+	(multiple-value-bind (buffer bstart bend)
+	    (minima:get-output-buffer stream)
+	  (let ((n (min (- end start) (- bend bstart))))
+	    (replace buffer vector
+		     :start1 bstart :end1 (incf bstart n) :start2 start :end2 (incf start n) ))
+	    (minima:advance-output-buffer stream bstart))))))
+
+#+ecl
+(defun buffer-write-default (vector display start end)
+  (declare (type buffer-bytes vector)
+	   (type display display)
+	   (type array-index start end))
+  (declare-buffun)
+  (si:write-bytes (display-output-stream display) vector start end))
+
+;;; WARNING:
+;;;	CLX performance will be severely degraded if your lisp uses
+;;;	write-byte to send all data to the X Window System server.
+;;;	You are STRONGLY encouraged to write a specialized version
+;;;	of buffer-write-default that does block transfers.
+
+#-(or Genera explorer excl lcl3.0 Minima ecl)
+(defun buffer-write-default (vector display start end)
+  ;; The default buffer write function for use with common-lisp streams
+  (declare (type buffer-bytes vector)
+	   (type display display)
+	   (type array-index start end))
+  #.(declare-buffun)
+  (let ((stream (display-output-stream display)))
+    (declare (type (or null stream) stream))
+    (unless (null stream)
+      (with-vector (vector buffer-bytes)
+	(do ((index start (index1+ index)))
+	    ((index>= index end))
+	  (declare (type array-index index))
+	  (write-byte (aref vector index) stream))))))
+
+;;; buffer-force-output-default - force output to the X stream
+
+#+(or excl ecl)
+(defun buffer-force-output-default (display)
+  ;; buffer-write-default does the actual writing.
+  (declare (ignore display)))
+
+#-(or excl ecl)
+(defun buffer-force-output-default (display)
+  ;; The default buffer force-output function for use with common-lisp streams
+  (declare (type display display))
+  (let ((stream (display-output-stream display)))
+    (declare (type (or null stream) stream))
+    (unless (null stream)
+      (force-output stream))))
+
+;;; BUFFER-CLOSE-DEFAULT - close the X stream
+
+#+excl
+(defun buffer-close-default (display &key abort)
+  ;; The default buffer close function for use with common-lisp streams
+  (declare (type display display)
+	   (ignore abort))
+  #.(declare-buffun)
+  (excl::filesys-checking-close (display-output-stream display)))
+
+#-excl
+(defun buffer-close-default (display &key abort)
+  ;; The default buffer close function for use with common-lisp streams
+  (declare (type display display))
+  #.(declare-buffun)
+  (let ((stream (display-output-stream display)))
+    (declare (type (or null stream) stream))
+    (unless (null stream)
+      (close stream :abort abort))))
+
+;;; BUFFER-INPUT-WAIT-DEFAULT - wait for for input to be available for the
+;;; buffer.  This is called in read-input between requests, so that a process
+;;; waiting for input is abortable when between requests.  Should return
+;;; :TIMEOUT if it times out, NIL otherwise.
+
+;;; The default implementation
+
+;; Poll for input every *buffer-read-polling-time* SECONDS.
+#-(or Genera explorer excl lcl3.0)
+(defparameter *buffer-read-polling-time* 0.5)
+
+#-(or Genera explorer excl lcl3.0)
+(defun buffer-input-wait-default (display timeout)
+  (declare (type display display)
+	   (type (or null number) timeout))
+  (declare (values timeout))
+  
+  (let ((stream (display-input-stream display)))
+    (declare (type (or null stream) stream))
+    (cond ((null stream))
+	  ((listen stream) nil)
+	  ((eql timeout 0) :timeout)
+	  ((not (null timeout))
+	   (multiple-value-bind (npoll fraction)
+	       (truncate timeout *buffer-read-polling-time*)
+	     #+ecl (declare (fixnum npoll fraction))
+	     (dotimes (i npoll)			; Sleep for a time, then listen again
+	       (sleep *buffer-read-polling-time*)
+	       (when (listen stream)
+		 (return-from buffer-input-wait-default nil)))
+	     (when (plusp fraction)
+	       (sleep fraction)			; Sleep a fraction of a second
+	       (when (listen stream)		; and listen one last time
+		 (return-from buffer-input-wait-default nil)))
+	     :timeout)))))
+
+#+Genera
+(defun buffer-input-wait-default (display timeout)
+  (declare (type display display)
+	   (type (or null number) timeout))
+  (declare (values timeout))
+  (let ((stream (display-input-stream display)))
+    (declare (type (or null stream) stream))
+    (cond ((null stream))
+	  ((scl:send stream :listen) nil)
+	  ((eql timeout 0) :timeout)
+	  ((null timeout) (si:stream-input-block stream "CLX Input"))
+	  (t
+	   (scl:condition-bind ((neti:protocol-timeout
+				  #'(lambda (error)
+				      (when (eq stream (scl:send error :stream))
+					(return-from buffer-input-wait-default :timeout)))))
+	     (neti:with-stream-timeout (stream :input timeout)
+	       (si:stream-input-block stream "CLX Input")))))
+    nil))
+
+#+explorer
+(defun buffer-input-wait-default (display timeout)
+  (declare (type display display)
+	   (type (or null number) timeout))
+  (declare (values timeout))
+  (let ((stream (display-input-stream display)))
+    (declare (type (or null stream) stream))
+    (cond ((null stream))
+	  ((zl:send stream :listen) nil)
+	  ((eql timeout 0) :timeout)
+	  ((null timeout)
+	   (si:process-wait "CLX Input" stream :listen))
+	  (t
+	   (unless (si:process-wait-with-timeout
+		       "CLX Input" (round (* timeout 60.)) stream :listen)
+	     (return-from buffer-input-wait-default :timeout))))
+    nil))
+
+#+excl
+;;
+;; This is used so an 'eq' test may be used to find out whether or not we can
+;; safely throw this process out of the CLX read loop.
+;;
+(defparameter *read-whostate* "waiting for input from X server")
+
+;;
+;; Note that this function returns nil on error if the scheduler is running,
+;; t on error if not.  This is ok since buffer-read will detect the error.
+;;
+#+excl
+(defun buffer-input-wait-default (display timeout)
+  (declare (type display display)
+	   (type (or null number) timeout))
+  (declare (values timeout))
+  (let ((fd (display-input-stream display)))
+    (declare (fixnum fd))
+    (when (>= fd 0)
+      (cond ((fd-char-avail-p fd)
+	     nil)
+	    
+	    ;; Otherwise no bytes were available on the socket
+	    ((and timeout (zerop timeout))
+	     ;; If there aren't enough and timeout == 0, timeout.
+	     :timeout)
+	  
+	    ;; If the scheduler is running let it do timeouts.
+	    (mp::*scheduler-stack-group*
+	     #+allegro
+	     (if (not
+		  (mp:wait-for-input-available fd :whostate *read-whostate*
+					       :wait-function #'fd-char-avail-p
+					       :timeout timeout))
+		 (return-from buffer-input-wait-default :timeout))
+	     #-allegro
+	     (mp::wait-for-input-available fd :whostate *read-whostate*
+					   :wait-function #'fd-char-avail-p))
+	    
+	    ;; Otherwise we have to handle timeouts by hand, and call select()
+	    ;; to block until input is available.  Note we don't really handle
+	    ;; the interaction of interrupts and (numberp timeout) here.  XX
+	    (t
+	     (let ((res 0))
+	       (declare (fixnum res))
+	       (with-interrupt-checking-on
+		(loop
+		  (setq res (fd-wait-for-input fd (if (null timeout) 0
+						    (truncate timeout))))
+		  (cond ((plusp res)	; success
+			 (return nil))
+			((eq res 0)	; timeout
+			 (return :timeout))
+			((eq res -1)	; error
+			 (return t))
+			;; Otherwise we got an interrupt -- go around again.
+			)))))))))
+
+	   
+#+lcl3.0
+(defun buffer-input-wait-default (display timeout)
+  (declare (type display display)
+	   (type (or null number) timeout)
+	   (values timeout))
+  #.(declare-buffun)
+  (let ((stream (display-input-stream display)))
+    (declare (type (or null stream) stream))
+    (cond ((null stream))
+	  ((listen stream) nil)
+	  ((eql timeout 0) :timeout)
+	  ((with-underlying-stream (stream stream display input)
+	     (lucid::waiting-for-input-from-stream stream
+               (lucid::with-io-unlocked
+		 (if (null timeout)
+		     (lcl:process-wait "CLX Input" #'listen stream)
+		   (lcl:process-wait-with-timeout
+		     "CLX Input" timeout #'listen stream)))))
+	   nil)
+	  (:timeout))))
+
+
+;;; BUFFER-LISTEN-DEFAULT - returns T if there is input available for the
+;;; buffer. This should never block, so it can be called from the scheduler.
+
+;;; The default implementation is to just use listen.
+#-excl
+(defun buffer-listen-default (display)
+  (declare (type display display))
+  (let ((stream (display-input-stream display)))
+    (declare (type (or null stream) stream))
+    (if (null stream)
+	t
+      (listen stream))))
+
+#+excl 
+(defun buffer-listen-default (display)
+  (declare (type display display))
+  (let ((fd (display-input-stream display)))
+    (declare (type fixnum fd))
+    (if (= fd -1)
+	t
+      (fd-char-avail-p fd))))
+
+
+;;;----------------------------------------------------------------------------
+;;; System dependent speed hacks
+;;;----------------------------------------------------------------------------
+
+;;
+;; WITH-STACK-LIST is used by WITH-STATE as a memory saving feature.
+;; If your lisp doesn't have stack-lists, and you're worried about
+;; consing garbage, you may want to re-write this to allocate and
+;; initialize lists from a resource.
+;;
+#-lispm
+(defmacro with-stack-list ((var &rest elements) &body body)
+  ;; SYNTAX: (WITH-STACK-LIST (var exp1 ... expN) body)
+  ;; Equivalent to (LET ((var (MAPCAR #'EVAL '(exp1 ... expN)))) body)
+  ;; except that the list produced by MAPCAR resides on the stack and
+  ;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
+  `(let ((,var (list ,@elements)))
+     (declare (type cons ,var)
+	      #+clx-ansi-common-lisp (dynamic-extent ,var))
+     ,@body))
+
+#-lispm
+(defmacro with-stack-list* ((var &rest elements) &body body)
+  ;; SYNTAX: (WITH-STACK-LIST* (var exp1 ... expN) body)
+  ;; Equivalent to (LET ((var (APPLY #'LIST* (MAPCAR #'EVAL '(exp1 ... expN))))) body)
+  ;; except that the list produced by MAPCAR resides on the stack and
+  ;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
+  `(let ((,var (list* ,@elements)))
+     (declare (type cons ,var)
+	      #+clx-ansi-common-lisp (dynamic-extent ,var))
+     ,@body))
+
+(declaim (inline buffer-replace))
+
+#+lispm
+(defun buffer-replace (buf1 buf2 start1 end1 &optional (start2 0))
+  (declare (type vector buf1 buf2)
+	   (type array-index start1 end1 start2))
+  (sys:copy-array-portion buf2 start2 (length buf2) buf1 start1 end1))
+
+#+excl
+(defun buffer-replace (target-sequence source-sequence target-start
+				       target-end &optional (source-start 0))
+  (declare (type buffer-bytes target-sequence source-sequence)
+	   (type array-index target-start target-end source-start)
+	   (optimize (speed 3) (safety 0)))
+  
+  (let ((source-end (length source-sequence)))
+    (declare (type array-index source-end))
+    
+    (excl:if* (and (eq target-sequence source-sequence)
+		   (> target-start source-start))
+       then (let ((nelts (min (- target-end target-start)
+			      (- source-end source-start))))
+	      (do ((target-index (+ target-start nelts -1) (1- target-index))
+		   (source-index (+ source-start nelts -1) (1- source-index)))
+		  ((= target-index (1- target-start)) target-sequence)
+		(declare (type array-index target-index source-index))
+		
+		(setf (aref target-sequence target-index)
+		  (aref source-sequence source-index))))
+       else (do ((target-index target-start (1+ target-index))
+		 (source-index source-start (1+ source-index)))
+		((or (= target-index target-end) (= source-index source-end))
+		 target-sequence)
+	      (declare (type array-index target-index source-index))
+
+	      (setf (aref target-sequence target-index)
+		(aref source-sequence source-index))))))
+
+#+lucid
+;;;The compiler is *supposed* to optimize calls to replace, but in actual
+;;;fact it does not.
+(defun buffer-replace (buf1 buf2 start1 end1 &optional (start2 0))
+  (declare (type buffer-bytes buf1 buf2)
+	   (type array-index start1 end1 start2))
+  #.(declare-buffun)
+  (let ((end2 (lucid::%simple-8bit-vector-length buf2)))
+    (declare (type array-index end2))
+    (lucid::simple-8bit-vector-replace-internal
+      buf1 buf2 start1 end1 start2 end2)))
+
+#+(and clx-overlapping-arrays (not (or lispm excl)))
+(defun buffer-replace (buf1 buf2 start1 end1 &optional (start2 0))
+  (declare (type vector buf1 buf2)
+	   (type array-index start1 end1 start2))
+  (replace buf1 buf2 :start1 start1 :end1 end1 :start2 start2))
+
+#-(or lispm lucid excl clx-overlapping-arrays)
+(defun buffer-replace (buf1 buf2 start1 end1 &optional (start2 0))
+  (declare (type buffer-bytes buf1 buf2)
+	   (type array-index start1 end1 start2))
+  (replace buf1 buf2 :start1 start1 :end1 end1 :start2 start2))
+
+#+ti
+(defun with-location-bindings (sys:&quote bindings &rest body)
+  (do ((bindings bindings (cdr bindings)))
+      ((null bindings)
+       (sys:eval-body-as-progn body))
+    (sys:bind (sys:*eval `(sys:locf ,(caar bindings)))
+	      (sys:*eval (cadar bindings)))))
+
+#+ti
+(compiler:defoptimizer with-location-bindings with-l-b-compiler nil (form)
+  (let ((bindings (cadr form))
+	(body (cddr form)))
+    `(let ()
+       ,@(loop for (accessor value) in bindings
+	       collect `(si:bind (si:locf ,accessor) ,value))
+       ,@body)))
+
+#+ti
+(defun (:property with-location-bindings compiler::cw-handler) (exp)
+  (let* ((bindlist (mapcar #'compiler::cw-clause (second exp)))
+	 (body (compiler::cw-clause (cddr exp))))
+    (and compiler::cw-return-expansion-flag
+	 (list* (first exp) bindlist body))))
+
+#+(and lispm (not ti))
+(defmacro with-location-bindings (bindings &body body)
+  `(sys:letf* ,bindings ,@body))
+
+#+lispm
+(defmacro with-gcontext-bindings ((gc saved-state indexes ts-index temp-mask temp-gc)
+				  &body body)
+  ;; don't use svref on LHS because Symbolics didn't define locf for it
+  (let* ((local-state (gensym))
+	 (bindings `(((aref ,local-state ,ts-index) 0))))	; will become zero anyway
+    (dolist (index indexes)
+      (push `((aref ,local-state ,index) (svref ,saved-state ,index))
+	    bindings))
+    `(let ((,local-state (gcontext-local-state ,gc)))
+       (declare (type gcontext-state ,local-state))
+       (unwind-protect
+	   (with-location-bindings ,bindings
+	     ,@body)
+	 (setf (svref ,local-state ,ts-index) 0)
+	 (when ,temp-gc
+	   (restore-gcontext-temp-state ,gc ,temp-mask ,temp-gc))
+	 (deallocate-gcontext-state ,saved-state)))))
+
+#-lispm
+(defmacro with-gcontext-bindings ((gc saved-state indexes ts-index temp-mask temp-gc)
+				  &body body)
+  (let ((local-state (gensym))
+	(resets nil))
+    (dolist (index indexes)
+      (push `(setf (svref ,local-state ,index) (svref ,saved-state ,index))
+	    resets))
+    `(unwind-protect
+	 (progn
+	   ,@body)
+       (let ((,local-state (gcontext-local-state ,gc)))
+	 (declare (type gcontext-state ,local-state))
+	 ,@resets
+	 (setf (svref ,local-state ,ts-index) 0))
+       (when ,temp-gc
+	 (restore-gcontext-temp-state ,gc ,temp-mask ,temp-gc))
+       (deallocate-gcontext-state ,saved-state))))
+
+;;;----------------------------------------------------------------------------
+;;; How error detection should CLX do?
+;;; Several levels are possible:
+;;;
+;;; 1. Do the equivalent of check-type on every argument.
+;;; 
+;;; 2. Simply report TYPE-ERROR.  This eliminates overhead of all the format
+;;;    strings generated by check-type.
+;;; 
+;;; 3. Do error checking only on arguments that are likely to have errors
+;;;    (like keyword names)
+;;; 
+;;; 4. Do error checking only where not doing so may dammage the envirnment
+;;;    on a non-tagged machine (i.e. when storing into a structure that has
+;;;    been passed in)
+;;; 
+;;; 5. No extra error detection code.  On lispm's, ASET may barf trying to
+;;;    store a non-integer into a number array. 
+;;; 
+;;; How extensive should the error checking be?  For example, if the server
+;;; expects a CARD16, is is sufficient for CLX to check for integer, or
+;;; should it also check for non-negative and less than 65536?
+;;;----------------------------------------------------------------------------
+ 
+;; The *TYPE-CHECK?* constant controls how much error checking is done.
+;; Possible values are:
+;;    NIL      - Don't do any error checking
+;;    t        - Do the equivalent of checktype on every argument
+;;    :minimal - Do error checking only where errors are likely
+
+;;; This controls macro expansion, and isn't changable at run-time You will
+;;; probably want to set this to nil if you want good performance at
+;;; production time.
+(defconstant *type-check?* #+(or Genera Minima) nil #-(or Genera Minima) t)
+
+;; TYPE? is used to allow the code to do error checking at a different level from
+;; the declarations.  It also does some optimizations for systems that don't have
+;; good compiler support for TYPEP.  The definitions for CARD32, CARD16, INT16, etc.
+;; include range checks.  You can modify TYPE? to do less extensive checking
+;; for these types if you desire.
+
+(defmacro type? (object type)
+  (if (not (constantp type))
+      `(typep ,object ,type)
+    (progn
+      (setq type (eval type))
+      #+(or Genera explorer Minima)
+      (if *type-check?*
+	  `(locally (declare (optimize safety)) (typep ,object ',type))
+	`(typep ,object ',type))
+      #-(or Genera explorer Minima)
+      (let ((predicate (assoc type
+			      '((drawable drawable-p) (window window-p)
+				(pixmap pixmap-p) (cursor cursor-p)
+				(font font-p) (gcontext gcontext-p)
+				(colormap colormap-p) (null null)
+				(integer integerp)))))
+	(cond (predicate
+	       `(,(second predicate) ,object))
+	      ((eq type 'boolean)
+	       't)			; Everything is a boolean.
+	      (*type-check?*
+	       `(locally (declare (optimize safety)) (typep ,object ',type)))
+	      (t
+	       `(typep ,object ',type)))))))
+
+;; X-TYPE-ERROR is the function called for type errors.
+;; If you want lots of checking, but are concerned about code size,
+;; this can be made into a macro that ignores some parameters.
+
+(defun x-type-error (object type &optional error-string)
+  (x-error 'x-type-error
+	   :datum object
+	   :expected-type type
+	   :type-string error-string))
+
+
+;;-----------------------------------------------------------------------------
+;; Error handlers
+;;    Hack up KMP error signaling using zetalisp until the real thing comes 
+;;    along
+;;-----------------------------------------------------------------------------
+
+(defun default-error-handler (display error-key &rest key-vals
+			      &key asynchronous &allow-other-keys)
+  (declare (type boolean asynchronous)
+	   (dynamic-extent key-vals))
+  ;; The default display-error-handler.
+  ;; It signals the conditions listed in the DISPLAY file.
+  (if asynchronous
+      (apply #'x-cerror "Ignore" error-key :display display :error-key error-key key-vals)
+      (apply #'x-error error-key :display display :error-key error-key key-vals)))
+
+#+(and lispm (not Genera) (not clx-ansi-common-lisp))
+(defun x-error (condition &rest keyargs)
+  (apply #'sys:signal condition keyargs))
+
+#+(and lispm (not Genera) (not clx-ansi-common-lisp))
+(defun x-cerror (proceed-format-string condition &rest keyargs)
+  (sys:signal (apply #'zl:make-condition condition keyargs)
+	      :proceed-types proceed-format-string))
+
+#+(and Genera (not clx-ansi-common-lisp))
+(defun x-error (condition &rest keyargs)
+  (declare (dbg:error-reporter))
+  (apply #'sys:signal condition keyargs))
+
+#+(and Genera (not clx-ansi-common-lisp))
+(defun x-cerror (proceed-format-string condition &rest keyargs)
+  (declare (dbg:error-reporter))
+  (apply #'sys:signal condition :continue-format-string proceed-format-string keyargs))
+
+#+(or clx-ansi-common-lisp excl lcl3.0)
+(defun x-error (condition &rest keyargs)
+  (declare (dynamic-extent keyargs))
+  (apply #'error condition keyargs))
+
+#+(or clx-ansi-common-lisp excl lcl3.0)
+(defun x-cerror (proceed-format-string condition &rest keyargs)
+  (declare (dynamic-extent keyargs))
+  (apply #'cerror proceed-format-string condition keyargs))
+
+#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+(defun x-error (condition &rest keyargs)
+  (error "X-Error: ~a"
+	 (princ-to-string (apply #'make-condition condition keyargs))))
+
+#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+(defun x-cerror (proceed-format-string condition &rest keyargs)
+  (cerror proceed-format-string "X-Error: ~a"
+	 (princ-to-string (apply #'make-condition condition keyargs))))
+
+;; version 15 of Pitman error handling defines the syntax for define-condition to be:
+;; DEFINE-CONDITION name (parent-type) [({slot}*) {option}*]
+;; Where option is one of: (:documentation doc-string) (:conc-name symbol-or-string)
+;; or (:report exp)
+
+#+lcl3.0 
+(defmacro define-condition (name parent-types &optional slots &rest args)
+  `(lcl:define-condition
+     ,name (,(first parent-types))
+     ,(mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
+	      slots)
+     ,@args))
+
+#+(and excl (not clx-ansi-common-lisp))
+(defmacro define-condition (name parent-types &optional slots &rest args)
+  `(excl::define-condition
+     ,name (,(first parent-types))
+     ,(mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
+	      slots)
+     ,@args))
+
+#+(and lispm (not clx-ansi-common-lisp))
+(defmacro define-condition (name parent-types &body options)
+  (let ((slot-names
+	  (mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
+		  (pop options)))
+	(documentation nil)
+	(conc-name (concatenate 'string (string name) "-"))	       
+	(reporter nil))
+    (dolist (item options)
+      (ecase (first item)
+	(:documentation (setq documentation (second item)))
+	(:conc-name (setq conc-name (string (second item))))
+	(:report (setq reporter (second item)))))
+    `(within-definition (,name define-condition)
+       (zl:defflavor ,name ,slot-names ,parent-types
+	 :initable-instance-variables
+	 #-Genera
+	 (:accessor-prefix ,conc-name)
+	 #+Genera
+	 (:conc-name ,conc-name)
+	 #-Genera
+	 (:outside-accessible-instance-variables ,@slot-names)
+	 #+Genera
+	 (:readable-instance-variables ,@slot-names))
+       ,(when reporter ;; when no reporter, parent's is inherited
+	  `(zl:defmethod #-Genera (,name :report)
+	                 #+Genera (dbg:report ,name) (stream)
+	      ,(if (stringp reporter)
+		   `(write-string ,reporter stream)
+		 `(,reporter global:self stream))
+	      global:self))
+       (zl:compile-flavor-methods ,name)
+       ,(when documentation
+	  `(setf (documentation name 'type) ,documentation))
+       ',name)))
+
+#+(and lispm (not Genera) (not clx-ansi-common-lisp))
+(zl:defflavor x-error () (global:error))
+
+#+(and Genera (not clx-ansi-common-lisp))
+(scl:defflavor x-error
+	((dbg:proceed-types '(:continue))	;
+	 continue-format-string)
+	(sys:error)
+  (:initable-instance-variables continue-format-string))
+
+#+(and Genera (not clx-ansi-common-lisp))
+(scl:defmethod (scl:make-instance x-error) (&rest ignore)
+  (when (not (sys:variable-boundp continue-format-string))
+    (setf dbg:proceed-types (remove :continue dbg:proceed-types))))
+
+#+(and Genera (not clx-ansi-common-lisp))
+(scl:defmethod (dbg:proceed x-error :continue) ()
+  :continue)
+
+#+(and Genera (not clx-ansi-common-lisp))
+(sys:defmethod (dbg:document-proceed-type x-error :continue) (stream)
+  (format stream continue-format-string))
+
+#+(or clx-ansi-common-lisp excl lcl3.0)
+(define-condition x-error (error) ())
+
+#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+(defstruct x-error
+  report-function)
+
+#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+(defmacro define-condition (name parent-types &body options)
+  ;; Define a structure that when printed displays an error message
+  (flet ((reporter-for-condition (name)
+	   (xintern "." name '-reporter.)))
+    (let ((slot-names
+	    (mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
+		    (pop options)))
+	  (documentation nil)
+	  (conc-name (concatenate 'string (string name) "-"))	       
+	  (reporter nil)
+	  (condition (gensym))
+	  (stream (gensym))
+	  (report-function (reporter-for-condition name)))
+      (dolist (item options)
+	(ecase (first item)
+	  (:documentation (setq documentation (second item)))
+	  (:conc-name (setq conc-name (string (second item))))
+	  (:report (setq reporter (second item)))))
+      (unless reporter
+	(setq report-function (reporter-for-condition (first parent-types))))
+      `(within-definition (,name define-condition)
+	 (defstruct (,name (:conc-name ,(intern conc-name))
+			   #-clos	; ECL
+		     (:print-function condition-print)
+		     (:include ,(first parent-types)
+		      (report-function ',report-function))
+		     (:copier nil)	; save space. ECL.
+		     (:predicate nil))	; idem. ECL
+	   ,@slot-names)
+	 ,(when documentation
+	    `(setf (documentation name 'type) ,documentation))
+	 ,(when reporter
+	    `(defun ,report-function (,condition ,stream)
+	       ,(if (stringp reporter)
+		    `(write-string ,reporter ,stream)
+		  `(,reporter ,condition ,stream))
+	       ,condition))
+	 ',name))))
+
+#-(or lispm clx-ansi-common-lisp excl lcl3.0 clos)
+(defun condition-print (condition stream depth)
+  (declare (type x-error condition)
+	   (type stream stream)
+	   (ignore depth))
+  (if *print-escape*
+      (print-unreadable-object (condition stream :type t))
+    (funcall (x-error-report-function condition) condition stream))
+  condition)
+  
+#+clos
+(defmethod print-object ((condition x-error) stream)
+  (declare (type stream stream))
+  (if *print-escape*
+      (format stream "#<CONDITION ~a>" (type-of condition))
+    (funcall (x-error-report-function condition) condition stream))
+  condition)
+
+#-(or lispm clx-ansi-common-lisp excl lcl3.0)
+(defun make-condition (type &rest slot-initializations)
+  (declare (dynamic-extent slot-initializations))
+  (let ((make-function (intern (concatenate 'string (string 'make-) (string type))
+			       (symbol-package type))))
+    (apply make-function slot-initializations)))
+
+#-(or clx-ansi-common-lisp excl lcl3.0)
+(define-condition type-error (x-error)
+  ((datum :reader type-error-datum :initarg :datum)
+   (expected-type :reader type-error-expected-type :initarg :expected-type))
+  (:report
+    (lambda (condition stream)
+      (format stream "~s isn't a ~a"
+	      (type-error-datum condition)
+	      (type-error-expected-type condition)))))
+
+
+;;-----------------------------------------------------------------------------
+;;  HOST hacking
+;;-----------------------------------------------------------------------------
+
+#-(or explorer Genera Minima)
+(defun host-address (host &optional (family :internet))
+  ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
+  ;; and cdr is a list of network address bytes.
+  (declare (type (or stringable list) host)
+	   (type (or null (member :internet :decnet :chaos) card8) family))
+  (declare (values list))
+  host family
+  (error "HOST-ADDRESS not implemented yet."))
+
+#+explorer
+(defun host-address (host &optional (family :internet))
+  ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
+  ;; and cdr is a list of network address bytes.
+  (declare (type (or stringable list) host)
+	   (type (or null (member :internet :decnet :chaos) card8) family))
+  (declare (values list))
+  (ecase family
+    (:internet
+     (let ((addr (ip:get-ip-address host)))
+       (unless addr (error "~s isn't an internet host name" host))
+       (list :internet
+	     (ldb (byte 8 24) addr)
+	     (ldb (byte 8 16) addr)
+	     (ldb (byte 8 8) addr)
+	     (ldb (byte 8 0) addr))))
+    (:chaos
+     (let ((addr (first (chaos:chaos-addresses host))))
+       (unless addr (error "~s isn't a chaos host name" host))
+       (list :chaos
+	     (ldb (byte 8 0) addr)
+	     (ldb (byte 8 8) addr))))))
+
+#+Genera
+(defun host-address (host &optional (family :internet))
+  ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
+  ;; and cdr is a list of network address bytes.
+  (declare (type (or stringable list) host)
+	   (type (or null (member :internet :decnet :chaos) card8) family))
+  (declare (values list))
+  (let ((net-type (if (eq family :DECnet)
+		      :DNA
+		      family)))
+    (dolist (addr
+	      (sys:send (net:parse-host host) :network-addresses)
+	      (error "~s isn't a valid ~(~A~) host name" host family))
+      (let ((network (car addr))
+	    (address (cadr addr)))
+	(when (sys:send network :network-typep net-type)
+	  (return (ecase family
+		    (:internet
+		      (multiple-value-bind (a b c d) (tcp:explode-internet-address address)
+			(list :internet a b c d)))
+		    ((:chaos :DECnet)
+		     (list family (ldb (byte 8 0) address) (ldb (byte 8 8) address))))))))))
+
+#+Minima
+(defun host-address (host &optional (family :internet))
+  ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
+  ;; and cdr is a list of network address bytes.
+  (declare (type (or stringable list) host)
+	   (type (or null (member :internet :decnet :chaos) card8) family))
+  (declare (values list))
+  (check-type family (member :internet))
+  (or (loop with (num delim)
+	    repeat 4
+	    for idx = 0 then (1+ delim)
+	    when (and delim (or (= delim (length host))
+				(char-not-equal (char host delim) #\.)))
+	      return nil
+	    do (multiple-value-setq (num delim)
+	         (parse-integer host :start idx :junk-allowed t))
+	    when (or (null num) (< num 0) (> num 255))
+	      return nil
+	    else collect num into nums
+	    finally (return (when (= delim (length host))
+			      (cons :internet nums))))
+      (error "Invalid internet address [~A]." host)))
+
+#+explorer ;; This isn't required, but it helps make sense of the results from access-hosts
+(defun get-host (host-object)
+  ;; host-object is a list whose car is the family keyword (:internet :DECnet :Chaos)
+  ;; and cdr is a list of network address bytes.
+  (declare (type list host-object))
+  (declare (values string family))
+  (let* ((family (first host-object))
+	 (address (ecase family
+		    (:internet
+		     (dpb (second host-object)
+			  (byte 8 24)
+			  (dpb (third host-object)
+			       (byte 8 16)
+			       (dpb (fourth host-object)
+				    (byte 8 8)
+				    (fifth host-object)))))
+		    (:chaos
+		     (dpb (third host-object) (byte 8 8) (second host-object))))))
+    (when (eq family :internet) (setq family :ip))
+    (let ((host (si:get-host-from-address address family)))
+      (values (and host (funcall host :name)) family))))
+
+;;; This isn't required, but it helps make sense of the results from access-hosts
+#+Genera
+(defun get-host (host-object)
+  ;; host-object is a list whose car is the family keyword (:internet :DECnet :Chaos)
+  ;; and cdr is a list of network address bytes.
+  (declare (type list host-object))
+  (declare (values string family))
+  (let ((family (first host-object)))
+    (values (sys:send (net:get-host-from-address 
+			(ecase family
+			  (:internet
+			    (apply #'tcp:build-internet-address (rest host-object)))
+			  ((:chaos :DECnet)
+			   (dpb (third host-object) (byte 8 8) (second host-object))))
+			(net:local-network-of-type (if (eq family :DECnet)
+						       :DNA
+						       family)))
+		      :name)
+	    family)))
+
+
+;;-----------------------------------------------------------------------------
+;; Whether to use closures for requests or not.
+;;-----------------------------------------------------------------------------
+
+;;; If this macro expands to non-NIL, then request and locking code is
+;;; compiled in a much more compact format, as the common code is shared, and
+;;; the specific code is built into a closure that is funcalled by the shared
+;;; code.  If your compiler makes efficient use of closures then you probably
+;;; want to make this expand to T, as it makes the code more compact.
+
+(defmacro use-closures ()
+  #+(or lispm Minima) t
+  #-(or lispm Minima) nil)
+
+
+;;-----------------------------------------------------------------------------
+;; Resource stuff
+;;-----------------------------------------------------------------------------
+
+
+;;; DEFAULT-RESOURCES-PATHNAME - The pathname of the resources file to load if
+;;; a resource manager isn't running.
+
+(defun default-resources-pathname ()
+  (when #+unix t #-unix (search "Unix" (software-type) :test #'char-equal)
+    (merge-pathnames (user-homedir-pathname) (pathname ".Xdefaults"))))
+
+
+
+;;; RESOURCES-PATHNAME - The pathname of the resources file to load after the
+;;; defaults have been loaded.
+
+(defun resources-pathname ()
+  (when #+unix t #-unix (search "Unix" (software-type) :test #'char-equal)
+    (or #+(or excl (and lcl3.0 (not vax-vms)))
+	(let ((string (#+excl sys:getenv
+		       #+lcl3.0 lcl:environment-variable
+		       "XENVIRONMENT")))
+	  (when string
+	    (pathname string)))
+	(merge-pathnames
+	  (user-homedir-pathname)
+	  (pathname 
+	    (concatenate 'simple-string ".Xdefaults-"
+			 #+excl (short-site-name)
+			 #-excl (machine-instance)))))))
+
+
+;;-----------------------------------------------------------------------------
+;; GC stuff
+;;-----------------------------------------------------------------------------
+
+(defun gc-cleanup ()
+  (declare (special *event-free-list*
+		    *pending-command-free-list*
+		    *reply-buffer-free-lists*
+		    *gcontext-local-state-cache*
+		    *temp-gcontext-cache*))
+  (setq *event-free-list* nil)
+  (setq *pending-command-free-list* nil)
+  (when (boundp '*reply-buffer-free-lists*)
+    (fill *reply-buffer-free-lists* nil))
+  (setq *gcontext-local-state-cache* nil)
+  (setq *temp-gcontext-cache* nil)
+  nil)
+
+#+Genera
+(si:define-gc-cleanup clx-cleanup ("CLX Cleanup")
+  (gc-cleanup))
+
+
+;;-----------------------------------------------------------------------------
+;; WITH-STANDARD-IO-SYNTAX equivalent, used in (SETF WM-COMMAND)
+;;-----------------------------------------------------------------------------
+
+#-(or clx-ansi-common-lisp Genera)
+(defun with-standard-io-syntax-function (function)
+  (declare #+lispm
+	   (sys:downward-funarg function))
+  (let ((*package* (find-package :user))
+	(*print-array* t)
+	(*print-base* 10)
+	(*print-case* :upcase)
+	(*print-circle* nil)
+	(*print-escape* t)
+	(*print-gensym* t)
+	(*print-length* nil)
+	(*print-level* nil)
+	(*print-pretty* nil)
+	(*print-radix* nil)
+	(*read-base* 10)
+	(*read-default-float-format* 'single-float)
+	(*read-suppress* nil)
+	#+ticl (ticl:*print-structure* t)
+	#+lucid (lucid::*print-structure* t))
+    (funcall function)))
+
+#-(or clx-ansi-common-lisp Genera)
+(defmacro with-standard-io-syntax (&body body)
+  `(flet ((.with-standard-io-syntax-body. () ,@body))
+     (with-standard-io-syntax-function #'.with-standard-io-syntax-body.)))
+
+
+;;-----------------------------------------------------------------------------
+;; DEFAULT-KEYSYM-TRANSLATE
+;;-----------------------------------------------------------------------------
+
+;;; If object is a character, char-bits are set from state.
+;;;
+;;; [the following isn't implemented (should it be?)]
+;;; If object is a list, it is an alist with entries:
+;;; (base-char [modifiers] [mask-modifiers])
+;;; When MODIFIERS are specified, this character translation
+;;; will only take effect when the specified modifiers are pressed.
+;;; MASK-MODIFIERS can be used to specify a set of modifiers to ignore.
+;;; When MASK-MODIFIERS is missing, all other modifiers are ignored.
+;;; In ambiguous cases, the most specific translation is used.
+
+#+(or (not ecl clx-ansi-common-lisp) lispm allegro)
+(defun default-keysym-translate (display state object)
+  (declare (type display display)
+	   (type card16 state)
+	   (type t object)
+	   (values t)
+	   (special left-meta-keysym right-meta-keysym
+		    left-super-keysym right-super-keysym
+		    left-hyper-keysym right-hyper-keysym))
+  (when (characterp object)
+    (when (logbitp (position :control *state-mask-vector*) state)
+      (setf (char-bit object :control) 1))
+    (when (or (state-keysymp display state left-meta-keysym)
+	      (state-keysymp display state right-meta-keysym))
+      (setf (char-bit object :meta) 1))
+    (when (or (state-keysymp display state left-super-keysym)
+	      (state-keysymp display state right-super-keysym))
+      (setf (char-bit object :super) 1))
+    (when (or (state-keysymp display state left-hyper-keysym)
+	      (state-keysymp display state right-hyper-keysym))
+      (setf (char-bit object :hyper) 1)))
+  object)
+
+#+(or ecl (and clx-ansi-common-lisp (not lispm) (not allegro)))
+(defun default-keysym-translate (display state object)
+  (declare (type display display)
+	   (type card16 state)
+	   (type t object)
+	   (ignore display state)
+	   (values t))
+  object)
+
+
+;;-----------------------------------------------------------------------------
+;; Image stuff
+;;-----------------------------------------------------------------------------
+
+;;; Types
+
+(deftype pixarray-1-element-type ()
+  'bit)
+
+(deftype pixarray-4-element-type ()
+  '(unsigned-byte 4))
+
+(deftype pixarray-8-element-type ()
+  '(unsigned-byte 8))
+
+(deftype pixarray-16-element-type ()
+  '(unsigned-byte 16))
+
+(deftype pixarray-24-element-type ()
+  '(unsigned-byte 24))
+
+(deftype pixarray-32-element-type ()
+  #-(or Genera Minima) '(unsigned-byte 32)
+  #+(or Genera Minima) 'fixnum)
+
+(deftype pixarray-1  ()
+  '(array pixarray-1-element-type (* *)))
+
+(deftype pixarray-4  ()
+  '(array pixarray-4-element-type (* *)))
+
+(deftype pixarray-8  ()
+  '(array pixarray-8-element-type (* *)))
+
+(deftype pixarray-16 ()
+  '(array pixarray-16-element-type (* *)))
+
+(deftype pixarray-24 ()
+  '(array pixarray-24-element-type (* *)))
+
+(deftype pixarray-32 ()
+  '(array pixarray-32-element-type (* *)))
+
+(deftype pixarray ()
+  '(or pixarray-1 pixarray-4 pixarray-8 pixarray-16 pixarray-24 pixarray-32))
+
+(deftype bitmap ()
+  'pixarray-1)
+
+;;; WITH-UNDERLYING-SIMPLE-VECTOR 
+
+#+Genera
+(defmacro with-underlying-simple-vector
+	  ((variable element-type pixarray) &body body)
+  (let ((bits-per-element
+	  (sys:array-bits-per-element
+	    (symbol-value (sys:type-array-element-type element-type)))))
+    `(scl:stack-let ((,variable
+		      (make-array
+			(index-ceiling
+			  (index* (array-total-size ,pixarray)
+				  (sys:array-element-size ,pixarray))
+			  ,bits-per-element)
+			:element-type ',element-type
+			:displaced-to ,pixarray)))
+       (declare (array-register ,variable))
+       ,@body)))
+
+#+lcl3.0
+(defmacro with-underlying-simple-vector
+	  ((variable element-type pixarray) &body body)
+  `(let ((,variable (sys:underlying-simple-vector ,pixarray)))
+     (declare (type (simple-array ,element-type (*)) ,variable))
+     ,@body))
+
+#+excl
+(defmacro with-underlying-simple-vector
+	  ((variable element-type pixarray) &body body)
+  `(let ((,variable (cdr (excl::ah_data ,pixarray))))
+     (declare (type (simple-array ,element-type (*)) ,variable))
+     ,@body))
+
+;;; These are used to read and write pixels from and to CARD8s.
+
+;;; READ-IMAGE-LOAD-BYTE is used to extract 1 and 4 bit pixels from CARD8s.
+
+(defmacro read-image-load-byte (size position integer)
+  (unless *image-bit-lsb-first-p* (setq position (- 7 position)))
+  `(the (unsigned-byte ,size)
+	(#-Genera ldb #+Genera sys:%logldb
+	 (byte ,size ,position)
+	 (the card8 ,integer))))
+
+;;; READ-IMAGE-ASSEMBLE-BYTES is used to build 16, 24 and 32 bit pixels from
+;;; the appropriate number of CARD8s.
+
+(defmacro read-image-assemble-bytes (&rest bytes)
+  (unless *image-byte-lsb-first-p* (setq bytes (reverse bytes)))
+  (let ((it (first bytes))
+	(count 0))
+    #+ecl (declare (fixnum count))
+    (dolist (byte (rest bytes))
+      (setq it
+	    `(#-Genera dpb #+Genera sys:%logdpb 
+	      (the card8 ,byte)
+	      (byte 8 ,(incf count 8))
+	      (the (unsigned-byte ,count) ,it))))
+    #-Genera `(the (unsigned-byte ,(* (length bytes) 8)) ,it)
+    #+Genera it))
+
+;;; WRITE-IMAGE-LOAD-BYTE is used to extract a CARD8 from a 16, 24 or 32 bit
+;;; pixel.
+
+(defmacro write-image-load-byte (position integer integer-size)
+  integer-size
+  (unless *image-byte-lsb-first-p* (setq position (- integer-size 8 position)))
+  #+ecl
+  `(int-char
+      (the card8
+	 (ldb
+	  (byte 8 ,position)
+	  (the fixnum ,integer)
+	 )))
+  #-ecl
+  `(the card8
+	(#-Genera ldb #+Genera sys:%logldb
+	 (byte 8 ,position)
+	 #-Genera (the (unsigned-byte ,integer-size) ,integer)
+	 #+Genera ,integer
+	 )))
+
+;;; WRITE-IMAGE-ASSEMBLE-BYTES is used to build a CARD8 from 1 or 4 bit
+;;; pixels.
+
+(defmacro write-image-assemble-bytes (&rest bytes)
+  (unless *image-bit-lsb-first-p* (setq bytes (reverse bytes)))
+  (let ((size (floor 8 (length bytes)))
+	(it (first bytes))
+	(count 0))
+    #+ecl (declare (fixnum size count))
+    (dolist (byte (rest bytes))
+      (setq it `(#-Genera dpb #+Genera sys:%logdpb
+		 (the (unsigned-byte ,size) ,byte)
+		 (byte ,size ,(incf count size))
+		 (the (unsigned-byte ,count) ,it))))
+    #+ecl
+    `(int-char (the card8 ,it))
+    #-ecl
+    `(the card8 ,it)))
+
+#+(or Genera lcl3.0 excl)
+(defvar *computed-image-byte-lsb-first-p* *image-byte-lsb-first-p*)
+
+#+(or Genera lcl3.0 excl)
+(defvar *computed-image-bit-lsb-first-p* *image-bit-lsb-first-p*)
+
+;;; The following table gives the bit ordering within bytes (when accessed
+;;; sequentially) for a scanline containing 32 bits, with bits numbered 0 to
+;;; 31, where bit 0 should be leftmost on the display.  For a given byte
+;;; labelled A-B, A is for the most significant bit of the byte, and B is
+;;; for the least significant bit.
+;;; 
+;;; legend:
+;;; 	1   scanline-unit = 8
+;;; 	2   scanline-unit = 16
+;;; 	4   scanline-unit = 32
+;;; 	M   byte-order = MostSignificant
+;;; 	L   byte-order = LeastSignificant
+;;; 	m   bit-order = MostSignificant
+;;; 	l   bit-order = LeastSignificant
+;;; 
+;;; 
+;;; format	ordering
+;;; 
+;;; 1Mm	00-07 08-15 16-23 24-31
+;;; 2Mm	00-07 08-15 16-23 24-31
+;;; 4Mm	00-07 08-15 16-23 24-31
+;;; 1Ml	07-00 15-08 23-16 31-24
+;;; 2Ml	15-08 07-00 31-24 23-16
+;;; 4Ml	31-24 23-16 15-08 07-00
+;;; 1Lm	00-07 08-15 16-23 24-31
+;;; 2Lm	08-15 00-07 24-31 16-23
+;;; 4Lm	24-31 16-23 08-15 00-07
+;;; 1Ll	07-00 15-08 23-16 31-24
+;;; 2Ll	07-00 15-08 23-16 31-24
+;;; 4Ll	07-00 15-08 23-16 31-24
+
+#+(or Genera lcl3.0 excl) 
+(defconstant
+  *image-bit-ordering-table*
+  '(((1 (00 07) (08 15) (16 23) (24 31)) (nil nil))
+    ((2 (00 07) (08 15) (16 23) (24 31)) (nil nil))
+    ((4 (00 07) (08 15) (16 23) (24 31)) (nil nil))
+    ((1 (07 00) (15 08) (23 16) (31 24)) (nil t))
+    ((2 (15 08) (07 00) (31 24) (23 16)) (nil t))
+    ((4 (31 24) (23 16) (15 08) (07 00)) (nil t))
+    ((1 (00 07) (08 15) (16 23) (24 31)) (t   nil))
+    ((2 (08 15) (00 07) (24 31) (16 23)) (t   nil))
+    ((4 (24 31) (16 23) (08 15) (00 07)) (t   nil))
+    ((1 (07 00) (15 08) (23 16) (31 24)) (t   t))
+    ((2 (07 00) (15 08) (23 16) (31 24)) (t   t))
+    ((4 (07 00) (15 08) (23 16) (31 24)) (t   t))))
+  
+#+(or Genera lcl3.0 excl) 
+(defun compute-image-byte-and-bit-ordering ()
+  (declare (values image-byte-lsb-first-p image-bit-lsb-first-p))
+  ;; First compute the ordering 
+  (let ((ordering nil)
+	(a (make-array '(1 32) :element-type 'bit :initial-element 0)))
+    (dotimes (i 4)
+      (push (flet ((bitpos (a i n)
+		     (declare (optimize (speed 3) (safety 0) (space 0)))
+		     (declare (type (simple-array bit (* *)) a)
+			      (type fixnum i n))
+		     (with-underlying-simple-vector (v (unsigned-byte 8) a)
+		       (prog2
+			 (setf (aref v i) n)
+			 (dotimes (i 32)
+			   (unless (zerop (aref a 0 i))
+			     (return i)))
+			 (setf (aref v i) 0)))))
+	      (list (bitpos a i #b10000000)
+		    (bitpos a i #b00000001)))
+	    ordering))
+    (setq ordering (cons (floor *image-unit* 8) (nreverse ordering)))
+    ;; Now from the ordering, compute byte-lsb-first-p and bit-lsb-first-p
+    (let ((byte-and-bit-ordering
+	    (second (assoc ordering *image-bit-ordering-table*
+			   :test #'equal))))
+      (unless byte-and-bit-ordering
+	(error "Couldn't determine image byte and bit ordering~@
+                measured image ordering = ~A"
+	       ordering))
+      (values-list byte-and-bit-ordering))))
+
+#+(or Genera lcl3.0 excl) 
+(multiple-value-setq
+  (*computed-image-byte-lsb-first-p* *computed-image-bit-lsb-first-p*)
+  (compute-image-byte-and-bit-ordering))
+
+;;; If you can write fast routines that can read and write pixarrays out of a
+;;; buffer-bytes, do it!  It makes the image code a lot faster.  The
+;;; FAST-READ-PIXARRAY, FAST-WRITE-PIXARRAY and FAST-COPY-PIXARRAY routines
+;;; return T if they can do it, NIL if they can't.
+
+;;; FAST-READ-PIXARRAY - fill part of a pixarray from a buffer of card8s
+
+#+(or lcl3.0 excl)
+(defun fast-read-pixarray-1 (buffer-bbuf index array x y width height  
+			     padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-1 array)
+	   (type card16 x y width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (with-underlying-simple-vector (vector pixarray-1-element-type array)
+      (do* ((start (index+ index
+			   (index* y padded-bytes-per-line)
+			   (index-ceiling x 8))
+		   (index+ start padded-bytes-per-line))
+	    (y 0 (index1+ y))
+	    (left-bits (index-mod (index- x) 8))
+	    (right-bits (index-mod (index- width left-bits) 8))
+	    (middle-bits (index- width left-bits right-bits))
+	    (middle-bytes (index-floor middle-bits 8)))
+	   ((index>= y height))
+	(declare (type array-index start y
+		       left-bits right-bits middle-bits middle-bytes))
+	(cond ((index< middle-bits 0)
+	       (let ((byte (aref buffer-bbuf (index1- start)))
+		     (x (array-row-major-index array y left-bits)))
+		 (declare (type card8 byte)
+			  (type array-index x))
+		 (when (index> right-bits 6)
+		   (setf (aref vector (index- x 1))
+			 (read-image-load-byte 1 7 byte)))
+		 (when (and (index> left-bits 1)
+			    (index> right-bits 5))
+		   (setf (aref vector (index- x 2))
+			 (read-image-load-byte 1 6 byte)))
+		 (when (and (index> left-bits 2)
+			    (index> right-bits 4))
+		   (setf (aref vector (index- x 3))
+			 (read-image-load-byte 1 5 byte)))
+		 (when (and (index> left-bits 3)
+			    (index> right-bits 3))
+		   (setf (aref vector (index- x 4))
+			 (read-image-load-byte 1 4 byte)))
+		 (when (and (index> left-bits 4)
+			    (index> right-bits 2))
+		   (setf (aref vector (index- x 5))
+			 (read-image-load-byte 1 3 byte)))
+		 (when (and (index> left-bits 5)
+			    (index> right-bits 1))
+		   (setf (aref vector (index- x 6))
+			 (read-image-load-byte 1 2 byte)))
+		 (when (index> left-bits 6)
+		   (setf (aref vector (index- x 7))
+			 (read-image-load-byte 1 1 byte)))))
+	      (t
+	       (unless (index-zerop left-bits)
+		 (let ((byte (aref buffer-bbuf (index1- start)))
+		       (x (array-row-major-index array y left-bits)))
+		   (declare (type card8 byte)
+			    (type array-index x))
+		   (setf (aref vector (index- x 1))
+			 (read-image-load-byte 1 7 byte))
+		   (when (index> left-bits 1)
+		     (setf (aref vector (index- x 2))
+			   (read-image-load-byte 1 6 byte))
+		     (when (index> left-bits 2)
+		       (setf (aref vector (index- x 3))
+			     (read-image-load-byte 1 5 byte))
+		       (when (index> left-bits 3)
+			 (setf (aref vector (index- x 4))
+			       (read-image-load-byte 1 4 byte))
+			 (when (index> left-bits 4)
+			   (setf (aref vector (index- x 5))
+				 (read-image-load-byte 1 3 byte))
+			   (when (index> left-bits 5)
+			     (setf (aref vector (index- x 6))
+				   (read-image-load-byte 1 2 byte))
+			     (when (index> left-bits 6)
+			       (setf (aref vector (index- x 7))
+				     (read-image-load-byte 1 1 byte))
+			       ))))))))
+	       (do* ((end (index+ start middle-bytes))
+		     (i start (index1+ i))
+		     (x (array-row-major-index array y left-bits) (index+ x 8)))
+		    ((index>= i end)
+		     (unless (index-zerop right-bits)
+		       (let ((byte (aref buffer-bbuf end))
+			     (x (array-row-major-index
+				  array y (index+ left-bits middle-bits))))
+			 (declare (type card8 byte)
+				  (type array-index x))
+			 (setf (aref vector (index+ x 0))
+			       (read-image-load-byte 1 0 byte))
+			 (when (index> right-bits 1)
+			   (setf (aref vector (index+ x 1))
+				 (read-image-load-byte 1 1 byte))
+			   (when (index> right-bits 2)
+			     (setf (aref vector (index+ x 2))
+				   (read-image-load-byte 1 2 byte))
+			     (when (index> right-bits 3)
+			       (setf (aref vector (index+ x 3))
+				     (read-image-load-byte 1 3 byte))
+			       (when (index> right-bits 4)
+				 (setf (aref vector (index+ x 4))
+				       (read-image-load-byte 1 4 byte))
+				 (when (index> right-bits 5)
+				   (setf (aref vector (index+ x 5))
+					 (read-image-load-byte 1 5 byte))
+				   (when (index> right-bits 6)
+				     (setf (aref vector (index+ x 6))
+					   (read-image-load-byte 1 6 byte))
+				     )))))))))
+		 (declare (type array-index end i x))
+		 (let ((byte (aref buffer-bbuf i)))
+		   (declare (type card8 byte))
+		   (setf (aref vector (index+ x 0))
+			 (read-image-load-byte 1 0 byte))
+		   (setf (aref vector (index+ x 1))
+			 (read-image-load-byte 1 1 byte))
+		   (setf (aref vector (index+ x 2))
+			 (read-image-load-byte 1 2 byte))
+		   (setf (aref vector (index+ x 3))
+			 (read-image-load-byte 1 3 byte))
+		   (setf (aref vector (index+ x 4))
+			 (read-image-load-byte 1 4 byte))
+		   (setf (aref vector (index+ x 5))
+			 (read-image-load-byte 1 5 byte))
+		   (setf (aref vector (index+ x 6))
+			 (read-image-load-byte 1 6 byte))
+		   (setf (aref vector (index+ x 7))
+			 (read-image-load-byte 1 7 byte))))
+	       )))))
+  t)
+
+#+(or lcl3.0 excl)
+(defun fast-read-pixarray-4 (buffer-bbuf index array x y width height 
+			     padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-4 array)
+	   (type card16 x y width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (with-underlying-simple-vector (vector pixarray-4-element-type array)
+      (do* ((start (index+ index
+			   (index* y padded-bytes-per-line)
+			   (index-ceiling x 2))
+		   (index+ start padded-bytes-per-line))
+	    (y 0 (index1+ y))
+	    (left-nibbles (index-mod (index- x) 2))
+	    (right-nibbles (index-mod (index- width left-nibbles) 2))
+	    (middle-nibbles (index- width left-nibbles right-nibbles))
+	    (middle-bytes (index-floor middle-nibbles 2)))
+	   ((index>= y height))
+	(declare (type array-index start y
+		       left-nibbles right-nibbles middle-nibbles middle-bytes))
+	(unless (index-zerop left-nibbles)
+	  (setf (aref array y 0)
+		(read-image-load-byte
+		  4 4 (aref buffer-bbuf (index1- start)))))
+	(do* ((end (index+ start middle-bytes))
+	      (i start (index1+ i))
+	      (x (array-row-major-index array y left-nibbles) (index+ x 2)))
+	     ((index>= i end)
+	      (unless (index-zerop right-nibbles)
+		(setf (aref array y (index+ left-nibbles middle-nibbles))
+		      (read-image-load-byte 4 0 (aref buffer-bbuf end)))))
+	  (declare (type array-index end i x))
+	  (let ((byte (aref buffer-bbuf i)))
+	    (declare (type card8 byte))
+	    (setf (aref vector (index+ x 0))
+		  (read-image-load-byte 4 0 byte))
+	    (setf (aref vector (index+ x 1))
+		  (read-image-load-byte 4 4 byte))))
+	)))
+  t)
+
+#+(or Genera lcl3.0 excl)
+(defun fast-read-pixarray-24 (buffer-bbuf index array x y width height 
+			      padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-24 array)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (with-underlying-simple-vector (vector pixarray-24-element-type array)
+      (do* ((start (index+ index
+			   (index* y padded-bytes-per-line)
+			   (index* x 3))
+		   (index+ start padded-bytes-per-line))
+	    (y 0 (index1+ y)))
+	   ((index>= y height))
+	(declare (type array-index start y))
+	(do* ((end (index+ start (index* width 3)))
+	      (i start (index+ i 3))
+	      (x (array-row-major-index array y 0) (index1+ x)))
+	     ((index>= i end))
+	  (declare (type array-index end i x))
+	  (setf (aref vector x)
+		(read-image-assemble-bytes
+		  (aref buffer-bbuf (index+ i 0))
+		  (aref buffer-bbuf (index+ i 1))
+		  (aref buffer-bbuf (index+ i 2))))))))
+  t)
+
+#+lispm
+(defun fast-read-pixarray-using-bitblt
+       (bbuf boffset pixarray x y width height padded-bytes-per-line
+	bits-per-pixel)
+  (#+Genera sys:stack-let* #-Genera let*
+   ((dimensions (list (+ y height)
+		      (floor (* padded-bytes-per-line 8) bits-per-pixel)))
+    (a (make-array
+	 dimensions
+	 :element-type (array-element-type pixarray)
+	 :displaced-to bbuf
+	 :displaced-index-offset (floor (* boffset 8) bits-per-pixel))))
+   (sys:bitblt boole-1 width height a x y pixarray 0 0))
+  t)
+
+#+(or Genera lcl3.0 excl)
+(defun fast-read-pixarray-with-swap
+       (bbuf boffset pixarray x y width height padded-bytes-per-line
+	bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type array-index boffset
+		 padded-bytes-per-line)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (unless (index= bits-per-pixel 24)
+    (let ((pixarray-padded-bits-per-line
+	    (if (index= height 1) 0
+	      (index* (index- (array-row-major-index pixarray 1 0)
+			      (array-row-major-index pixarray 0 0))
+		      bits-per-pixel)))
+	  (x-bits (index* x bits-per-pixel)))
+      (declare (type array-index pixarray-padded-bits-per-line x-bits))
+      (when (if (eq *computed-image-byte-lsb-first-p* *computed-image-bit-lsb-first-p*)
+		(and (index-zerop (index-mod pixarray-padded-bits-per-line 8))
+		     (index-zerop (index-mod x-bits 8)))
+	      (and (index-zerop (index-mod pixarray-padded-bits-per-line *image-unit*))
+		   (index-zerop (index-mod x-bits *image-unit*))))
+	(multiple-value-bind (image-swap-function image-swap-lsb-first-p)
+	    (image-swap-function
+	      bits-per-pixel 
+	      unit byte-lsb-first-p bit-lsb-first-p
+	      *image-unit* *computed-image-byte-lsb-first-p*
+	      *computed-image-bit-lsb-first-p*)
+	  (declare (type symbol image-swap-function)
+		   (type boolean image-swap-lsb-first-p))
+	  (with-underlying-simple-vector (dst card8 pixarray)
+	    (funcall
+	      (symbol-function image-swap-function) bbuf dst
+	      (index+ boffset
+		      (index* y padded-bytes-per-line)
+		      (index-floor x-bits 8))
+	      0 (index-ceiling (index* width bits-per-pixel) 8)
+	      padded-bytes-per-line
+	      (index-floor pixarray-padded-bits-per-line 8)
+	      height image-swap-lsb-first-p)))
+	t))))
+
+(defun fast-read-pixarray (bbuf boffset pixarray
+			   x y width height padded-bytes-per-line
+			   bits-per-pixel
+			   unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type array-index boffset
+		 padded-bytes-per-line)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (progn bbuf boffset pixarray x y width height padded-bytes-per-line
+	 bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+  (or
+    #+(or Genera lcl3.0 excl)
+    (fast-read-pixarray-with-swap
+      bbuf boffset pixarray x y width height padded-bytes-per-line
+      bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+    (let ((function
+	    (or #+lispm
+		(and (= (sys:array-element-size pixarray) bits-per-pixel)
+		     (zerop (index-mod padded-bytes-per-line 4))
+		     (zerop (index-mod
+			      (* #+Genera (sys:array-row-span pixarray)
+				 #-Genera (array-dimension pixarray 1)
+				 bits-per-pixel)
+			      32))
+		     #'fast-read-pixarray-using-bitblt)
+		#+(or lcl3.0 excl)
+		(and (index= bits-per-pixel 1)
+		     #'fast-read-pixarray-1)
+		#+(or lcl3.0 excl)
+		(and (index= bits-per-pixel 4)
+		     #'fast-read-pixarray-4)
+		#+(or Genera lcl3.0 excl)
+		(and (index= bits-per-pixel 24)
+		     #'fast-read-pixarray-24))))
+      (when function
+	(read-pixarray-internal
+	  bbuf boffset pixarray x y width height padded-bytes-per-line
+	  bits-per-pixel function
+	  unit byte-lsb-first-p bit-lsb-first-p
+	  *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*)))))
+
+;;; FAST-WRITE-PIXARRAY - copy part of a pixarray into an array of CARD8s
+
+#+(or lcl3.0 excl)
+(defun fast-write-pixarray-1 (buffer-bbuf index array x y width height
+			      padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-1 array)
+	   (type card16 x y width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (with-underlying-simple-vector (vector pixarray-1-element-type array)
+      (do* ((h 0 (index1+ h))
+	    (y y (index1+ y))
+	    (right-bits (index-mod width 8))
+	    (middle-bits (index- width right-bits))
+	    (middle-bytes (index-ceiling middle-bits 8))
+	    (start index (index+ start padded-bytes-per-line)))
+	   ((index>= h height))
+	(declare (type array-index h y right-bits middle-bits
+		       middle-bytes start))
+	(do* ((end (index+ start middle-bytes))
+	      (i start (index1+ i))
+	      (start-x x)
+	      (x (array-row-major-index array y start-x) (index+ x 8)))
+	     ((index>= i end)
+	      (unless (index-zerop right-bits)
+		(let ((x (array-row-major-index
+			   array y (index+ start-x middle-bits))))
+		  (declare (type array-index x))
+		  (setf (aref buffer-bbuf end)
+			(write-image-assemble-bytes
+			  (aref vector (index+ x 0))
+			  (if (index> right-bits 1)
+			      (aref vector (index+ x 1))
+			    0)
+			  (if (index> right-bits 2)
+			      (aref vector (index+ x 2))
+			    0)
+			  (if (index> right-bits 3)
+			      (aref vector (index+ x 3))
+			    0)
+			  (if (index> right-bits 4)
+			      (aref vector (index+ x 4))
+			    0)
+			  (if (index> right-bits 5)
+			      (aref vector (index+ x 5))
+			    0)
+			  (if (index> right-bits 6)
+			      (aref vector (index+ x 6))
+			    0)
+			  0)))))
+	  (declare (type array-index end i start-x x))
+	  (setf (aref buffer-bbuf i)
+		(write-image-assemble-bytes
+		  (aref vector (index+ x 0))
+		  (aref vector (index+ x 1))
+		  (aref vector (index+ x 2))
+		  (aref vector (index+ x 3))
+		  (aref vector (index+ x 4))
+		  (aref vector (index+ x 5))
+		  (aref vector (index+ x 6))
+		  (aref vector (index+ x 7))))))))
+  t)
+
+#+(or lcl3.0 excl)
+(defun fast-write-pixarray-4 (buffer-bbuf index array x y width height
+			      padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-4 array)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (with-underlying-simple-vector (vector pixarray-4-element-type array)
+      (do* ((h 0 (index1+ h))
+	    (y y (index1+ y))
+	    (right-nibbles (index-mod width 2))
+	    (middle-nibbles (index- width right-nibbles))
+	    (middle-bytes (index-ceiling middle-nibbles 2))
+	    (start index (index+ start padded-bytes-per-line)))
+	   ((index>= h height))
+	(declare (type array-index h y right-nibbles middle-nibbles
+		       middle-bytes start))
+	(do* ((end (index+ start middle-bytes))
+	      (i start (index1+ i))
+	      (start-x x)
+	      (x (array-row-major-index array y start-x) (index+ x 2)))
+	     ((index>= i end)
+	      (unless (index-zerop right-nibbles)
+		(setf (aref buffer-bbuf end)
+		      (write-image-assemble-bytes
+			(aref array y (index+ start-x middle-nibbles))
+			0))))
+	  (declare (type array-index end i start-x x))
+	  (setf (aref buffer-bbuf i)
+		(write-image-assemble-bytes
+		  (aref vector (index+ x 0))
+		  (aref vector (index+ x 1))))))))
+  t)
+
+#+(or Genera lcl3.0 excl)
+(defun fast-write-pixarray-24 (buffer-bbuf index array x y width height
+			       padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-24 array)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (with-underlying-simple-vector (vector pixarray-24-element-type array)
+      (do* ((h 0 (index1+ h))
+	    (y y (index1+ y))
+	    (start index (index+ start padded-bytes-per-line)))
+	   ((index>= h height))
+	(declare (type array-index y start))
+	(do* ((end (index+ start (index* width 3)))
+	      (i start (index+ i 3))
+	      (x (array-row-major-index array y x) (index1+ x)))
+	     ((index>= i end))
+	  (declare (type array-index end i x))
+	  (let ((pixel (aref vector x)))
+	    (declare (type pixarray-24-element-type pixel))
+	    (setf (aref buffer-bbuf (index+ i 0))
+		  (write-image-load-byte 0 pixel 24))
+	    (setf (aref buffer-bbuf (index+ i 1))
+		  (write-image-load-byte 8 pixel 24))
+	    (setf (aref buffer-bbuf (index+ i 2))
+		  (write-image-load-byte 16 pixel 24)))))))
+  t)
+
+#+lispm
+(defun fast-write-pixarray-using-bitblt
+       (bbuf boffset pixarray x y width height padded-bytes-per-line
+	bits-per-pixel)
+  (#+Genera sys:stack-let* #-Genera let*
+   ((dimensions (list (+ y height)
+		      (floor (* padded-bytes-per-line 8) bits-per-pixel)))
+    (a (make-array
+	 dimensions
+	 :element-type (array-element-type pixarray)
+	 :displaced-to bbuf
+	 :displaced-index-offset (floor (* boffset 8) bits-per-pixel))))
+   (sys:bitblt boole-1 width height pixarray x y a 0 0))
+  t)
+
+#+(or Genera lcl3.0 excl)
+(defun fast-write-pixarray-with-swap
+       (bbuf boffset pixarray x y width height padded-bytes-per-line
+	bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type array-index boffset padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (unless (index= bits-per-pixel 24)
+    (let ((pixarray-padded-bits-per-line
+	    (if (index= height 1) 0
+	      (index* (index- (array-row-major-index pixarray 1 0)
+			      (array-row-major-index pixarray 0 0))
+		      bits-per-pixel)))
+	  (pixarray-start-bit-offset
+	    (index* (array-row-major-index pixarray y x)
+		    bits-per-pixel)))
+      (declare (type array-index pixarray-padded-bits-per-line
+		     pixarray-start-bit-offset))
+      (when (if (eq *computed-image-byte-lsb-first-p* *computed-image-bit-lsb-first-p*)
+		(and (index-zerop (index-mod pixarray-padded-bits-per-line 8))
+		     (index-zerop (index-mod pixarray-start-bit-offset 8)))
+	      (and (index-zerop (index-mod pixarray-padded-bits-per-line *image-unit*))
+		   (index-zerop (index-mod pixarray-start-bit-offset *image-unit*))))
+	(multiple-value-bind (image-swap-function image-swap-lsb-first-p)
+	    (image-swap-function
+	      bits-per-pixel
+	      *image-unit* *computed-image-byte-lsb-first-p*
+	      *computed-image-bit-lsb-first-p*
+	      unit byte-lsb-first-p bit-lsb-first-p)
+	  (declare (type symbol image-swap-function)
+		   (type boolean image-swap-lsb-first-p))
+	  (with-underlying-simple-vector (src card8 pixarray)
+	    (funcall
+	      (symbol-function image-swap-function)
+	      src bbuf (index-floor pixarray-start-bit-offset 8) boffset
+	      (index-ceiling (index* width bits-per-pixel) 8)
+	      (index-floor pixarray-padded-bits-per-line 8)
+	      padded-bytes-per-line height image-swap-lsb-first-p))
+	  t)))))
+
+(defun fast-write-pixarray (bbuf boffset pixarray x y width height
+			    padded-bytes-per-line bits-per-pixel
+			    unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type array-index boffset padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (progn bbuf boffset pixarray x y width height padded-bytes-per-line
+	 bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+  (or
+    #+(or Genera lcl3.0 excl)
+    (fast-write-pixarray-with-swap
+      bbuf boffset pixarray x y width height padded-bytes-per-line
+      bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+    (let ((function
+	    (or #+lispm
+		(and (= (sys:array-element-size pixarray) bits-per-pixel)
+		     (zerop (index-mod padded-bytes-per-line 4))
+		     (zerop (index-mod
+			      (* #+Genera (sys:array-row-span pixarray)
+				 #-Genera (array-dimension pixarray 1)
+				 bits-per-pixel)
+			      32))
+		     #'fast-write-pixarray-using-bitblt)
+		#+(or lcl3.0 excl)
+		(and (index= bits-per-pixel 1)
+		     #'fast-write-pixarray-1)
+		#+(or lcl3.0 excl)
+		(and (index= bits-per-pixel 4)
+		     #'fast-write-pixarray-4)
+		#+(or Genera lcl3.0 excl)
+		(and (index= bits-per-pixel 24)
+		     #'fast-write-pixarray-24))))
+      (when function
+	(write-pixarray-internal
+	  bbuf boffset pixarray x y width height padded-bytes-per-line
+	  bits-per-pixel function
+	  *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*
+	  unit byte-lsb-first-p bit-lsb-first-p)))))
+
+;;; FAST-COPY-PIXARRAY - copy part of a pixarray into another
+
+(defun fast-copy-pixarray (pixarray copy x y width height bits-per-pixel)
+  (declare (type pixarray pixarray copy)
+	   (type card16 x y width height)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel))
+  (progn pixarray copy x y width height bits-per-pixel nil)
+  (or
+    #+lispm
+    (let* ((pixarray-padded-pixels-per-line
+	     #+Genera (sys:array-row-span pixarray)
+	     #-Genera (array-dimension pixarray 1))
+	   (pixarray-padded-bits-per-line
+	     (* pixarray-padded-pixels-per-line bits-per-pixel))
+	   (copy-padded-pixels-per-line
+	     #+Genera (sys:array-row-span copy)
+	     #-Genera (array-dimension copy 1))
+	   (copy-padded-bits-per-line
+	     (* copy-padded-pixels-per-line bits-per-pixel)))
+      (when (and (= (sys:array-element-size pixarray) bits-per-pixel)
+		 (zerop (index-mod pixarray-padded-bits-per-line 32))
+		 (zerop (index-mod copy-padded-bits-per-line 32)))
+	(sys:bitblt boole-1 width height pixarray x y copy 0 0)
+	t))
+    #+(or lcl3.0 excl)
+    (unless (index= bits-per-pixel 24)
+      (let ((pixarray-padded-bits-per-line
+	      (if (index= height 1) 0
+		(index* (index- (array-row-major-index pixarray 1 0)
+				(array-row-major-index pixarray 0 0))
+			bits-per-pixel)))
+	    (copy-padded-bits-per-line
+	      (if (index= height 1) 0
+		(index* (index- (array-row-major-index copy 1 0)
+				(array-row-major-index copy 0 0))
+			bits-per-pixel)))
+	    (pixarray-start-bit-offset
+	      (index* (array-row-major-index pixarray y x)
+		      bits-per-pixel)))
+	(declare (type array-index pixarray-padded-bits-per-line
+		       copy-padded-bits-per-line pixarray-start-bit-offset))
+	(when (if (eq *computed-image-byte-lsb-first-p* *computed-image-bit-lsb-first-p*)
+		  (and (index-zerop (index-mod pixarray-padded-bits-per-line 8))
+		       (index-zerop (index-mod copy-padded-bits-per-line 8))
+		       (index-zerop (index-mod pixarray-start-bit-offset 8)))
+		(and (index-zerop (index-mod pixarray-padded-bits-per-line *image-unit*))
+		     (index-zerop (index-mod copy-padded-bits-per-line *image-unit*))
+		     (index-zerop (index-mod pixarray-start-bit-offset *image-unit*))))
+	  (with-underlying-simple-vector (src card8 pixarray)
+	    (with-underlying-simple-vector (dst card8 copy)
+	      (image-noswap
+		src dst
+		(index-floor pixarray-start-bit-offset 8) 0
+		(index-ceiling (index* width bits-per-pixel) 8)
+		(index-floor pixarray-padded-bits-per-line 8)
+		(index-floor copy-padded-bits-per-line 8)
+		height nil)))
+	  t)))
+    #+(or lcl3.0 excl)
+    (macrolet
+      ((copy (type element-type)
+	 `(let ((pixarray pixarray)
+		(copy copy))
+	    (declare (type ,type pixarray copy))
+	    #.(declare-buffun)
+	    (with-underlying-simple-vector (src ,element-type pixarray)
+	      (with-underlying-simple-vector (dst ,element-type copy)
+		(do* ((dst-y 0 (index1+ dst-y))
+		      (src-y y (index1+ src-y)))
+		     ((index>= dst-y height))
+		  (declare (type card16 dst-y src-y))
+		  (do* ((dst-idx (array-row-major-index copy dst-y 0)
+				 (index1+ dst-idx))
+			(dst-end (index+ dst-idx width))
+			(src-idx (array-row-major-index pixarray src-y x)
+				 (index1+ src-idx)))
+		       ((index>= dst-idx dst-end))
+		    (declare (type array-index dst-idx src-idx dst-end))
+		    (setf (aref dst dst-idx)
+			  (the ,element-type (aref src src-idx))))))))))
+      (ecase bits-per-pixel
+	(1  (copy pixarray-1  pixarray-1-element-type))
+	(4  (copy pixarray-4  pixarray-4-element-type))
+	(8  (copy pixarray-8  pixarray-8-element-type))
+	(16 (copy pixarray-16 pixarray-16-element-type))
+	(24 (copy pixarray-24 pixarray-24-element-type))
+	(32 (copy pixarray-32 pixarray-32-element-type)))
+      t)))
diff --git a/src/clx/display.lsp b/src/clx/display.lsp
new file mode 100644
index 000000000..8dfbb7f5e
--- /dev/null
+++ b/src/clx/display.lsp
@@ -0,0 +1,523 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;; This file contains definitions for the DISPLAY object for Common-Lisp X windows version 11
+
+;;;(c) Copyright Enhancements by Giuseppe Attardi, 1994.
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+;;
+;; Resource id management
+;;
+(defun initialize-resource-allocator (display)
+  ;; Find the resource-id-byte (appropriate for LDB & DPB) from the resource-id-mask
+  (let ((id-mask (display-resource-id-mask display)))
+    (unless (zerop id-mask) ;; zero mask is an error
+      (do ((first 0 (index1+ first))
+	   (mask id-mask (the mask32 (ash mask -1))))
+	  ((oddp mask)
+	   (setf (display-resource-id-byte display)
+		 (byte (integer-length mask) first)))
+	(declare (type array-index first)
+		 (type mask32 mask))))))
+
+(defun resourcealloc (display)
+  ;; Allocate a resource-id for in DISPLAY
+  (declare (type display display))
+  (declare (values resource-id))
+  (dpb (incf (display-resource-id-count display))
+       (display-resource-id-byte display)
+       (display-resource-id-base display)))
+
+(defmacro allocate-resource-id (display object type)
+  ;; Allocate a resource-id for OBJECT in DISPLAY
+  (if (member (eval type) *clx-cached-types*)
+      `(let ((id (funcall (display-xid ,display) ,display)))
+	 (save-id ,display id ,object)
+	 id)
+    `(funcall (display-xid ,display) ,display)))
+
+(defmacro deallocate-resource-id (display id type)
+  ;; Deallocate a resource-id for OBJECT in DISPLAY
+  (when (member (eval type) *clx-cached-types*)
+    `(deallocate-resource-id-internal ,display ,id)))
+
+(defun deallocate-resource-id-internal (display id)
+  (remhash id (display-resource-id-map display)))
+
+(defun lookup-resource-id (display id)
+  ;; Find the object associated with resource ID
+  (gethash id (display-resource-id-map display)))
+
+(defun save-id (display id object)
+  ;; Register a resource-id from another display.
+  (declare (type display display)
+	   (type integer id)
+	   (type t object))
+  (declare (values object))
+  (setf (gethash id (display-resource-id-map display)) object))
+
+;; Define functions to find the CLX data types given a display and resource-id
+;; If the data type is being cached, look there first.
+(macrolet ((generate-lookup-functions (useless-name &body types)
+	    `(within-definition (,useless-name generate-lookup-functions)
+	       ,@(mapcar
+		   #'(lambda (type)
+		       `(defun ,(xintern 'lookup- type)
+			       (display id)
+			  (declare (type display display)
+				   (type resource-id id))
+			  (declare (values ,type))
+			  ,(if (member type *clx-cached-types*)
+			       `(let ((,type (lookup-resource-id display id)))
+				  (cond ((null ,type) ;; Not found, create and save it.
+					 (setq ,type (,(xintern 'make- type)
+						      :display display :id id))
+					 (save-id display id ,type))
+					;; Found.  Check the type
+					,(cond ((null *type-check?*)
+						`(t ,type))
+					       ((member type '(window pixmap))
+						`((type? ,type 'drawable) ,type))
+					       (t `((type? ,type ',type) ,type)))
+					,@(when *type-check?*
+					    `((t (x-error 'lookup-error
+							  :id id
+							  :display display
+							  :type ',type
+							  :object ,type))))))
+			       ;; Not being cached.  Create a new one each time.
+			       `(,(xintern 'make- type)
+				 :display display :id id))))
+		   types))))
+  (generate-lookup-functions ignore
+    drawable
+    window
+    pixmap
+    gcontext
+    cursor
+    colormap
+    font))
+
+(defun id-atom (id display)
+  ;; Return the cached atom for an atom ID
+  (declare (type resource-id id)
+	   (type display display))
+  (declare (values (or null keyword)))
+  (gethash id (display-atom-id-map display)))
+
+(defun atom-id (atom display)
+  ;; Return the ID for an atom in DISPLAY
+  (declare (type xatom atom)
+	   (type display display))
+  (declare (values (or null resource-id)))
+  (gethash (if (or (null atom) (keywordp atom)) atom (kintern atom))
+	   (display-atom-cache display)))
+
+(defun set-atom-id (atom display id)
+  ;; Set the ID for an atom in DISPLAY
+  (declare (type xatom atom)
+	   (type display display)
+	   (type resource-id id))
+  (declare (values resource-id))
+  (let ((atom (if (or (null atom) (keywordp atom)) atom (kintern atom))))
+    (setf (gethash id (display-atom-id-map display)) atom)
+    (setf (gethash atom (display-atom-cache display)) id)
+    id))
+
+(defsetf atom-id set-atom-id)
+
+(defun initialize-predefined-atoms (display)
+  (dotimes (i (length *predefined-atoms*))
+    (declare (type resource-id i))
+    (setf (atom-id (svref *predefined-atoms* i) display) i)))
+
+(defun visual-info (display visual-id)
+  (declare (type display display)
+	   (type resource-id visual-id)
+	   (values visual-info))
+  (when (zerop visual-id)
+    (return-from visual-info nil))
+  (dolist (screen (display-roots display))
+    (declare (type screen screen))
+    (dolist (depth (screen-depths screen))
+      (declare (type cons depth))
+      (dolist (visual-info (rest depth))
+	(declare (type visual-info visual-info))
+	(when (funcall (resource-id-map-test) visual-id (visual-info-id visual-info))
+	  (return-from visual-info visual-info)))))
+  (error "Visual info not found for id #x~x in display ~s." visual-id display))
+
+
+;;
+;; Display functions
+;;
+(defmacro with-display ((display &key timeout inline)
+			&body body)
+  ;; This macro is for use in a multi-process environment.  It provides exclusive
+  ;; access to the local display object for multiple request generation.  It need not
+  ;; provide immediate exclusive access for replies; that is, if another process is
+  ;; waiting for a reply (while not in a with-display), then synchronization need not
+  ;; (but can) occur immediately.  Except where noted, all routines effectively
+  ;; contain an implicit with-display where needed, so that correct synchronization
+  ;; is always provided at the interface level on a per-call basis.  Nested uses of
+  ;; this macro will work correctly.  This macro does not prevent concurrent event
+  ;; processing; see with-event-queue.
+  `(with-buffer (,display
+		 ,@(and timeout `(:timeout ,timeout))
+		 ,@(and inline `(:inline ,inline)))
+     ,@body))
+
+(defmacro with-event-queue ((display &key timeout inline)
+			    &body body &environment env)
+  ;; exclusive access to event queue
+  `(macrolet ((with-event-queue ((display &key timeout) &body body)
+		;; Speedup hack for lexically nested with-event-queues
+		`(progn
+		   (progn ,display ,@(and timeout `(,timeout)) nil)
+		   ,@body)))
+     ,(if (and (null inline) (macroexpand '(use-closures) env))
+	  `(flet ((.with-event-queue-body. () ,@body))
+	     #+clx-ansi-common-lisp
+	     (declare (dynamic-extent #'.with-event-queue-body.))
+	     (with-event-queue-function
+	       ,display ,timeout #'.with-event-queue-body.))
+	(let ((disp (if (or (symbolp display) (constantp display))
+			display
+		      '.display.)))
+	  `(let (,@(unless (eq disp display) `((,disp ,display))))
+	     (holding-lock ((display-event-lock ,disp) ,disp "CLX Event Lock"
+			    ,@(and timeout `(:timeout ,timeout)))
+	       ,@body))))))
+
+(defun with-event-queue-function (display timeout function)
+  (declare (type display display)
+	   (type (or null number) timeout)
+	   (type function function)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent function)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg function))
+  (with-event-queue (display :timeout timeout :inline t)
+    (funcall function)))
+
+(defmacro with-event-queue-internal ((display &key timeout) &body body)
+  ;; exclusive access to the internal event queues
+  (let ((disp (if (or (symbolp display) (constantp display)) display '.display.)))
+    `(let (,@(unless (eq disp display) `((,disp ,display))))
+       (holding-lock ((display-event-queue-lock ,disp) ,disp "CLX Event Queue Lock"
+		      ,@(and timeout `(:timeout ,timeout)))
+	 ,@body))))
+
+(defun open-display (host  &rest options &key (display 0) protocol
+		     authorization-name authorization-data &allow-other-keys)
+  ;; Implementation specific routine to setup the buffer for a specific host and display.
+  ;; This must interface with the local network facilities, and will probably do special
+  ;; things to circumvent the nework when displaying on the local host.
+  ;;
+  ;; A string must be acceptable as a host, but otherwise the possible types
+  ;; for host and protocol are not constrained, and will likely be very
+  ;; system dependent.  The default protocol is system specific.  Authorization,
+  ;; if any, is assumed to come from the environment somehow.
+  (declare (type integer display)
+	   (dynamic-extent options))
+  (declare (values display))
+  ;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM.
+  (let* ((stream (open-x-stream host display protocol))
+	 (disp (apply #'make-buffer
+		      *output-buffer-size*
+		      'make-display-internal
+		      :host host
+		      :display display
+		      :output-stream stream
+		      :input-stream stream
+		      :allow-other-keys t
+		      options))
+	 (ok-p nil))
+    (unwind-protect
+	(progn
+	  (display-connect disp
+			   :authorization-name authorization-name
+			   :authorization-data authorization-data)
+	  (initialize-resource-allocator disp)
+	  (initialize-predefined-atoms disp)
+	  (initialize-extensions disp)
+	  (setq ok-p t))
+      (unless ok-p (close-display disp :abort t)))
+    disp))
+
+(defun display-force-output (display)
+  ; Output is normally buffered, this forces any buffered output to the server.
+  (declare (type display display))
+  (with-display (display)
+    (buffer-force-output display)))
+
+(defun close-display (display &key abort)
+  ;; Close the host connection in DISPLAY
+  (declare (type display display))
+  (close-buffer display :abort abort))
+
+(defun display-connect (display &key authorization-name authorization-data)
+  (unless authorization-name (setq authorization-name ""))
+  (unless authorization-data (setq authorization-data ""))
+  (with-buffer-output (display :sizes (8 16))
+    (card8-put
+      0
+      (ecase (display-byte-order display)
+	(:lsbfirst #x6c)   ;; Ascii lowercase l - Least Significant Byte First
+	(:msbfirst #x42))) ;; Ascii uppercase B -  Most Significant Byte First
+    (card16-put 2 *protocol-major-version*)
+    (card16-put 4 *protocol-minor-version*)
+    (card16-put 6 (length authorization-name))
+    (card16-put 8 (length authorization-data))
+    (write-sequence-char display 12 authorization-name)
+    (write-sequence-char display
+			 (lround (+ 12 (length authorization-name))) authorization-data))
+  (buffer-force-output display)
+  (let ((reply-buffer nil))
+    (declare (type (or null reply-buffer) reply-buffer))
+    (unwind-protect
+	(progn
+	  (setq reply-buffer (allocate-reply-buffer #x1000))
+	  (with-buffer-input (reply-buffer :sizes (8 16 32))
+	    (buffer-input display buffer-bbuf 0 8)
+	    (let ((success (boolean-get 0))
+		  (reason-length (card8-get 1))
+		  (major-version (card16-get 2))
+		  (minor-version (card16-get 4))
+		  (total-length (card16-get 6))
+		  vendor-length
+		  num-roots
+		  num-formats)
+	      (declare (ignore total-length))
+	      #+ecl (declare (fixnum num-roots num-formats))
+	      (unless success
+		(x-error 'connection-failure
+			 :major-version major-version
+			 :minor-version minor-version
+			 :host (display-host display)
+			 :display (display-display display)
+			 :reason
+			 (progn (buffer-input display buffer-bbuf 0 reason-length)
+				(string-get reason-length 0 :reply-buffer reply-buffer))))
+	      (buffer-input display buffer-bbuf 0 32)
+	      (setf (display-protocol-major-version display) major-version)
+	      (setf (display-protocol-minor-version display) minor-version)
+	      (setf (display-release-number display) (card32-get 0))
+	      (setf (display-resource-id-base display) (card32-get 4))
+	      (setf (display-resource-id-mask display) (card32-get 8))
+	      (setf (display-motion-buffer-size display) (card32-get 12))
+	      (setq vendor-length (card16-get 16))
+	      (setf (display-max-request-length display) (card16-get 18))
+	      (setq num-roots (card8-get 20))
+	      (setq num-formats (card8-get 21))
+	      ;; Get the image-info
+	      (setf (display-image-lsb-first-p display) (zerop (card8-get 22)))
+	      (let ((format (display-bitmap-format display)))
+		(declare (type bitmap-format format))
+		(setf (bitmap-format-lsb-first-p format) (zerop (card8-get 23)))
+		(setf (bitmap-format-unit format) (card8-get 24))
+		(setf (bitmap-format-pad format) (card8-get 25)))
+	      (setf (display-min-keycode display) (card8-get 26))
+	      (setf (display-max-keycode display) (card8-get 27))
+	      ;; 4 bytes unused
+	      ;; Get the vendor string
+	      (buffer-input display buffer-bbuf 0 (lround vendor-length))
+	      (setf (display-vendor-name display)
+		    (string-get vendor-length 0 :reply-buffer reply-buffer))
+	      ;; Initialize the pixmap formats
+	      (dotimes (i num-formats) ;; loop gathering pixmap formats
+		(declare (ignorable i))
+		(buffer-input display buffer-bbuf 0 8)
+		(push (make-pixmap-format :depth (card8-get 0)
+					  :bits-per-pixel (card8-get 1)
+					  :scanline-pad (card8-get 2))
+						; 5 unused bytes
+		      (display-pixmap-formats display)))
+	      (setf (display-pixmap-formats display)
+		    (nreverse (display-pixmap-formats display)))
+	      ;; Initialize the screens
+	      (dotimes (i num-roots)
+		(declare (ignorable i))
+		(buffer-input display buffer-bbuf 0 40)
+		(let* ((root-id (card32-get 0))
+		       (root (make-window :id root-id :display display))
+		       (root-visual (card32-get 32))
+		       (default-colormap-id (card32-get 4))
+		       (default-colormap
+			 (make-colormap :id default-colormap-id :display display))
+		       (screen
+			 (make-screen
+			   :root root
+			   :default-colormap default-colormap
+			   :white-pixel (card32-get 8)
+			   :black-pixel (card32-get 12)
+			   :event-mask-at-open (card32-get 16)
+			   :width  (card16-get 20)
+			   :height (card16-get 22)
+			   :width-in-millimeters  (card16-get 24)
+			   :height-in-millimeters (card16-get 26)
+			   :min-installed-maps (card16-get 28)
+			   :max-installed-maps (card16-get 30)
+			   :backing-stores (member8-get 36 :never :when-mapped :always)
+			   :save-unders-p (boolean-get 37)
+			   :root-depth (card8-get 38)))
+		       (num-depths (card8-get 39))
+		       (depths nil))
+		  #+ecl (declare (fixnum num-depths))
+		  ;; Save root window for event reporting
+		  (save-id display root-id root)
+		  (save-id display default-colormap-id default-colormap)
+		  ;; Create the depth AList for a screen, (depth . visual-infos)
+		  (dotimes (j num-depths)
+		    (declare (ignorable j))
+		    (buffer-input display buffer-bbuf 0 8)
+		    (let ((depth (card8-get 0))
+			  (num-visuals (card16-get 2))
+			  (visuals nil)) ;; 4 bytes unused
+		      #+ecl (declare (fixnum num-visuals))
+		      (dotimes (k num-visuals)
+			(declare (ignorable k))
+			(buffer-input display buffer-bbuf 0 24)
+			(let* ((visual (card32-get 0))
+			       (visual-info (make-visual-info
+					      :id visual
+					      :display display
+					      :class (member8-get 4 :static-gray :gray-scale
+								  :static-color :pseudo-color
+								  :true-color :direct-color)
+					      :bits-per-rgb (card8-get 5)
+					      :colormap-entries (card16-get 6)
+					      :red-mask (card32-get 8)
+					      :green-mask (card32-get 12)
+					      :blue-mask (card32-get 16)
+					      ;; 4 bytes unused
+					      )))
+			  (push visual-info visuals)
+			  (when (funcall (resource-id-map-test) root-visual visual)
+			    (setf (screen-root-visual-info screen)
+				  (setf (colormap-visual-info default-colormap)
+					visual-info)))))
+		      (push (cons depth (nreverse visuals)) depths)))
+		  (setf (screen-depths screen) (nreverse depths))
+		  (push screen (display-roots display))))
+	      (setf (display-roots display) (nreverse (display-roots display)))
+	      (setf (display-default-screen display) (first (display-roots display))))))
+      (when reply-buffer
+	(deallocate-reply-buffer reply-buffer))))
+  display)
+
+(defun display-protocol-version (display)
+  (declare (type display display))
+  (declare (values major minor))
+  (values (display-protocol-major-version display)
+	  (display-protocol-minor-version display)))
+
+(defun display-vendor (display)
+  (declare (type display display))
+  (declare (values name release))
+  (values (display-vendor-name display)
+	  (display-release-number display)))
+
+(defun display-nscreens (display)
+  (declare (type display display))
+  (length (display-roots display)))
+
+#+comment ;; defined by the DISPLAY defstruct
+(defsetf display-error-handler (display) (handler)
+  ;; All errors (synchronous and asynchronous) are processed by calling an error
+  ;; handler in the display.  If handler is a sequence it is expected to contain
+  ;; handler functions specific to each error; the error code is used to index the
+  ;; sequence, fetching the appropriate handler.  Any results returned by the handler
+  ;; are ignored; it is assumed the handler either takes care of the error
+  ;; completely, or else signals. For all core errors, the keyword/value argument
+  ;; pairs are:
+  ;;    :display display
+  ;;    :error-key error-key
+  ;;    :major integer
+  ;;    :minor integer
+  ;;    :sequence integer
+  ;;    :current-sequence integer
+  ;; For :colormap, :cursor, :drawable, :font, :gcontext, :id-choice, :pixmap, and
+  ;; :window errors another pair is:
+  ;;    :resource-id integer
+  ;; For :atom errors, another pair is:
+  ;;    :atom-id integer
+  ;; For :value errors, another pair is:
+  ;;    :value integer
+  )
+
+  ;; setf'able
+  ;; If defined, called after every protocol request is generated, even those inside
+  ;; explicit with-display's, but never called from inside the after-function itself.
+  ;; The function is called inside the effective with-display for the associated
+  ;; request.  Default value is nil.  Can be set, for example, to
+  ;; #'display-force-output or #'display-finish-output.
+
+(defvar *inside-display-after-function* nil)
+
+(defun display-invoke-after-function (display)
+  ; Called after every protocal request is generated
+  (declare (type display display))
+  (when (and (display-after-function display)
+	     (not *inside-display-after-function*))
+    (let ((*inside-display-after-function* t)) ;; Ensure no recursive calls
+      (funcall (display-after-function display) display))))
+
+(defun display-finish-output (display)
+  ;; Forces output, then causes a round-trip to ensure that all possible
+  ;; errors and events have been received.
+  (declare (type display display))
+  (with-buffer-request-and-reply (display *x-getinputfocus* 16 :sizes (8 32))
+       ()
+    )
+  ;; Report asynchronous errors here if the user wants us to.
+  (report-asynchronous-errors display :after-finish-output))
+
+(defparameter
+  *request-names*
+  '#("error" "CreateWindow" "ChangeWindowAttributes" "GetWindowAttributes"
+     "DestroyWindow" "DestroySubwindows" "ChangeSaveSet" "ReparentWindow"
+     "MapWindow" "MapSubwindows" "UnmapWindow" "UnmapSubwindows"
+     "ConfigureWindow" "CirculateWindow" "GetGeometry" "QueryTree"
+     "InternAtom" "GetAtomName" "ChangeProperty" "DeleteProperty"
+     "GetProperty" "ListProperties" "SetSelectionOwner" "GetSelectionOwner"
+     "ConvertSelection" "SendEvent" "GrabPointer" "UngrabPointer"
+     "GrabButton" "UngrabButton" "ChangeActivePointerGrab" "GrabKeyboard"
+     "UngrabKeyboard" "GrabKey" "UngrabKey" "AllowEvents"
+     "GrabServer" "UngrabServer" "QueryPointer" "GetMotionEvents"
+     "TranslateCoords" "WarpPointer" "SetInputFocus" "GetInputFocus"
+     "QueryKeymap" "OpenFont" "CloseFont" "QueryFont"
+     "QueryTextExtents" "ListFonts" "ListFontsWithInfo" "SetFontPath"
+     "GetFontPath" "CreatePixmap" "FreePixmap" "CreateGC"
+     "ChangeGC" "CopyGC" "SetDashes" "SetClipRectangles"
+     "FreeGC" "ClearToBackground" "CopyArea" "CopyPlane"
+     "PolyPoint" "PolyLine" "PolySegment" "PolyRectangle"
+     "PolyArc" "FillPoly" "PolyFillRectangle" "PolyFillArc"
+     "PutImage" "GetImage" "PolyText8" "PolyText16"
+     "ImageText8" "ImageText16" "CreateColormap" "FreeColormap"
+     "CopyColormapAndFree" "InstallColormap" "UninstallColormap" "ListInstalledColormaps"
+     "AllocColor" "AllocNamedColor" "AllocColorCells" "AllocColorPlanes"
+     "FreeColors" "StoreColors" "StoreNamedColor" "QueryColors"
+     "LookupColor" "CreateCursor" "CreateGlyphCursor" "FreeCursor"
+     "RecolorCursor" "QueryBestSize" "QueryExtension" "ListExtensions"
+     "SetKeyboardMapping" "GetKeyboardMapping" "ChangeKeyboardControl" "GetKeyboardControl"
+     "Bell" "ChangePointerControl" "GetPointerControl" "SetScreenSaver"
+     "GetScreenSaver" "ChangeHosts" "ListHosts" "ChangeAccessControl"
+     "ChangeCloseDownMode" "KillClient" "RotateProperties" "ForceScreenSaver"
+     "SetPointerMapping" "GetPointerMapping" "SetModifierMapping" "GetModifierMapping"))
diff --git a/src/clx/doc.lsp b/src/clx/doc.lsp
new file mode 100644
index 000000000..b9ca59a25
--- /dev/null
+++ b/src/clx/doc.lsp
@@ -0,0 +1,3818 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+;;; Copyright (c) 1987, 1988  X Consortium
+;;; Copyright (c) 1987, 1988  Texas Instruments Incorportated
+;;; 
+;;; Permission is hereby granted, free of charge, to any person obtaining
+;;; a copy of this software and associated documentation files (the
+;;; "Software"), to deal in the Software without restriction, including
+;;; without limitation the rights to use, copy, modify, merge, publish,
+;;; distribute, sublicense, and/or sell copies of the Software, and to
+;;; permit persons to whom the Software is furnished to do so, subject to
+;;; the following conditions:
+;;; 
+;;; The above copyright notice and this permission notice shall be included
+;;; in all copies or substantial portions of the Software.
+;;; 
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;;; IN NO EVENT SHALL THE X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR
+;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+;;; OTHER DEALINGS IN THE SOFTWARE.
+;;; 
+;;; Except as contained in this notice, the name of the X Consortium shall
+;;; not be used in advertising or otherwise to promote the sale, use or
+;;; other dealings in this Software without prior written authorization
+;;; from the X Consortium.
+;;;
+;;; Texas Instruments Incorporated provides this document "as is" without
+;;; express or implied warranty.
+
+;; Version 4
+
+;; This is considered a somewhat changeable interface.  Discussion of better
+;; integration with CLOS, support for user-specified subclassess of basic
+;; objects, and the additional functionality to match the C Xlib is still in
+;; progress.
+
+;; Primary Interface Author:
+;;	Robert W. Scheifler
+;;	MIT Laboratory for Computer Science
+;;	545 Technology Square, Room 418
+;;	Cambridge, MA 02139
+;;	rws@zermatt.lcs.mit.edu
+
+;; Design Contributors:
+;;	Dan Cerys, Texas Instruments
+;;	Scott Fahlman, CMU
+;;      Charles Hornig, Symbolics
+;;      John Irwin, Franz
+;;	Kerry Kimbrough, Texas Instruments
+;;	Chris Lindblad, MIT
+;;	Rob MacLachlan, CMU
+;;	Mike McMahon, Symbolics
+;;	David Moon, Symbolics
+;;	LaMott Oren, Texas Instruments
+;;	Daniel Weinreb, Symbolics
+;;	John Wroclawski, MIT
+;;	Richard Zippel, Symbolics
+
+;; CLX Extensions
+;; Adds some of the functionality provided by the C XLIB library.
+;;
+;; Primary Author
+;;	LaMott G. Oren
+;;	Texas Instruments
+;; 
+;; Design Contributors:
+;;	Robert W. Scheifler, MIT
+
+
+;; Note: all of the following is in the package XLIB.
+
+;; Note: various perversions of the CL type system are used below.
+;; Examples: (list elt-type) (sequence elt-type)
+
+(proclaim '(declaration arglist values))
+
+;; Note: if you have read the Version 11 protocol document or C Xlib manual, most of
+;; the relationships should be fairly obvious.  We have no intention of writing yet
+;; another moby document for this interface.
+
+(deftype card32 () '(unsigned-byte 32))
+
+(deftype card29 () '(unsigned-byte 29))
+
+(deftype int32 () '(signed-byte 32))
+
+(deftype card16 () '(unsigned-byte 16))
+
+(deftype int16 () '(signed-byte 16))
+
+(deftype card8 () '(unsigned-byte 8))
+
+(deftype int8 () '(signed-byte 8))
+
+(deftype mask32 () 'card32)
+
+(deftype mask16 () 'card16)
+
+(deftype resource-id () 'card29)
+
+;; Types employed: display, window, pixmap, cursor, font, gcontext, colormap, color.
+;; These types are defined solely by a functional interface; we do not specify
+;; whether they are implemented as structures or flavors or ...  Although functions
+;; below are written using DEFUN, this is not an implementation requirement (although
+;; it is a requirement that they be functions as opposed to macros or special forms).
+;; It is unclear whether with-slots in the Common Lisp Object System must work on
+;; them.
+
+;; Windows, pixmaps, cursors, fonts, gcontexts, and colormaps are all represented as
+;; compound objects, rather than as integer resource-ids.  This allows applications
+;; to deal with multiple displays without having an explicit display argument in the
+;; most common functions.  Every function uses the display object indicated by the
+;; first argument that is or contains a display; it is an error if arguments contain
+;; different displays, and predictable results are not guaranteed.
+
+;; Each of window, pixmap, drawable, cursor, font, gcontext, and colormap have the
+;; following five functions:
+
+(defun <mumble>-display (<mumble>)
+  (declare (type <mumble> <mumble>)
+	   (values display)))
+
+(defun <mumble>-id (<mumble>)
+  (declare (type <mumble> <mumble>)
+	   (values resource-id)))
+
+(defun <mumble>-equal (<mumble>-1 <mumble>-2)
+  (declare (type <mumble> <mumble>-1 <mumble>-2)))
+
+(defun <mumble>-p (<mumble>)
+  (declare (type <mumble> <mumble>)
+	   (values boolean)))
+
+;; The following functions are provided by color objects:
+
+;; The intention is that IHS and YIQ and CYM interfaces will also exist.  Note that
+;; we are explicitly using a different spectrum representation than what is actually
+;; transmitted in the protocol.
+
+(deftype rgb-val () '(real 0 1))
+
+(defun make-color (&key red green blue &allow-other-keys)	; for expansion
+  (declare (type rgb-val red green blue)
+	   (values color)))
+
+(defun color-rgb (color)
+  (declare (type color color)
+	   (values red green blue)))
+
+(defun color-red (color)
+  ;; setf'able
+  (declare (type color color)
+	   (values rgb-val)))
+
+(defun color-green (color)
+  ;; setf'able
+  (declare (type color color)
+	   (values rgb-val)))
+
+(defun color-blue (color)
+  ;; setf'able
+  (declare (type color color)
+	   (values rgb-val)))
+
+(deftype drawable () '(or window pixmap))
+
+;; Atoms are accepted as strings or symbols, and are always returned as keywords.
+;; Protocol-level integer atom ids are hidden, using a cache in the display object.
+
+(deftype xatom () '(or string symbol))
+
+(deftype stringable () '(or string symbol))
+
+(deftype fontable () '(or stringable font))
+
+;; Nil stands for CurrentTime.
+
+(deftype timestamp () '(or null card32))
+
+(deftype bit-gravity () '(member :forget :static :north-west :north :north-east
+				 :west :center :east :south-west :south :south-east))
+
+(deftype win-gravity () '(member :unmap :static :north-west :north :north-east
+				 :west :center :east :south-west :south :south-east))
+
+(deftype grab-status ()
+  '(member :success :already-grabbed :frozen :invalid-time :not-viewable))
+
+(deftype boolean () '(or null (not null)))
+
+(deftype pixel () '(unsigned-byte 32))
+(deftype image-depth () '(integer 0 32))
+
+(deftype keysym () 'card32)
+
+(deftype array-index () `(integer 0 ,array-dimension-limit))
+
+;; An association list.
+
+(deftype alist (key-type-and-name datum-type-and-name) 'list)
+
+;; A sequence, containing zero or more repetitions of the given elements,
+;; with the elements expressed as (type name).
+
+(deftype repeat-seq (&rest elts) 'sequence)
+
+(deftype point-seq () '(repeat-seq (int16 x) (int16 y)))
+
+(deftype seg-seq () '(repeat-seq (int16 x1) (int16 y1) (int16 x2) (int16 y2)))
+
+(deftype rect-seq () '(repeat-seq (int16 x) (int16 y) (card16 width) (card16 height)))
+
+;; Note that we are explicitly using a different angle representation than what
+;; is actually transmitted in the protocol.
+
+(deftype angle () '(real #.(* -2 pi) #.(* 2 pi)))
+
+(deftype arc-seq () '(repeat-seq (int16 x) (int16 y) (card16 width) (card16 height)
+				 (angle angle1) (angle angle2)))
+
+(deftype event-mask-class ()
+  '(member :key-press :key-release :owner-grab-button :button-press :button-release
+	   :enter-window :leave-window :pointer-motion :pointer-motion-hint
+	   :button-1-motion :button-2-motion :button-3-motion :button-4-motion
+	   :button-5-motion :button-motion :exposure :visibility-change
+	   :structure-notify :resize-redirect :substructure-notify :substructure-redirect
+	   :focus-change :property-change :colormap-change :keymap-state))
+
+(deftype event-mask ()
+  '(or mask32 (list event-mask-class)))
+
+(deftype pointer-event-mask-class ()
+  '(member :button-press :button-release
+	   :enter-window :leave-window :pointer-motion :pointer-motion-hint
+	   :button-1-motion :button-2-motion :button-3-motion :button-4-motion
+	   :button-5-motion :button-motion :keymap-state))
+
+(deftype pointer-event-mask ()
+  '(or mask32 (list pointer-event-mask-class)))
+
+(deftype device-event-mask-class ()
+  '(member :key-press :key-release :button-press :button-release :pointer-motion
+	   :button-1-motion :button-2-motion :button-3-motion :button-4-motion
+	   :button-5-motion :button-motion))
+
+(deftype device-event-mask ()
+  '(or mask32 (list device-event-mask-class)))
+
+(deftype modifier-key ()
+  '(member :shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5))
+
+(deftype modifier-mask ()
+  '(or (member :any) mask16 (list modifier-key)))
+
+(deftype state-mask-key ()
+  '(or modifier-key (member :button-1 :button-2 :button-3 :button-4 :button-5)))
+
+(deftype gcontext-key ()
+  '(member :function :plane-mask :foreground :background
+	   :line-width :line-style :cap-style :join-style :fill-style :fill-rule
+	   :arc-mode :tile :stipple :ts-x :ts-y :font :subwindow-mode
+	   :exposures :clip-x :clip-y :clip-mask :dash-offset :dashes))
+
+(deftype event-key ()
+  '(member :key-press :key-release :button-press :button-release :motion-notify
+	   :enter-notify :leave-notify :focus-in :focus-out :keymap-notify
+	   :exposure :graphics-exposure :no-exposure :visibility-notify
+	   :create-notify :destroy-notify :unmap-notify :map-notify :map-request
+	   :reparent-notify :configure-notify :gravity-notify :resize-request
+	   :configure-request :circulate-notify :circulate-request :property-notify
+	   :selection-clear :selection-request :selection-notify
+	   :colormap-notify :client-message))
+
+(deftype error-key ()
+  '(member :access :alloc :atom :colormap :cursor :drawable :font :gcontext :id-choice
+	   :illegal-request :implementation :length :match :name :pixmap :value :window))
+
+(deftype draw-direction ()
+  '(member :left-to-right :right-to-left))
+
+(defstruct bitmap-format
+  (unit <unspec> :type (member 8 16 32))
+  (pad <unspec> :type (member 8 16 32))
+  (lsb-first-p <unspec> :type boolean))
+
+(defstruct pixmap-format
+  (depth <unspec> :type image-depth)
+  (bits-per-pixel <unspec> :type (member 1 4 8 16 24 32))
+  (pad <unspec> :type (member 8 16 32)))
+
+(defstruct visual-info
+  (id <unspec> :type resource-id)
+  (display <unspec> :type display)
+  (class <unspec> :type (member :static-gray :static-color :true-color
+				:gray-scale :pseudo-color :direct-color))
+  (red-mask <unspec> :type pixel)
+  (green-mask <unspec> :type pixel)
+  (blue-mask <unspec> :type pixel)
+  (bits-per-rgb <unspec> :type card8)
+  (colormap-entries <unspec> :type card16))
+
+(defstruct screen
+  (root <unspec> :type window)
+  (width <unspec> :type card16)
+  (height <unspec> :type card16)
+  (width-in-millimeters <unspec> :type card16)
+  (height-in-millimeters <unspec> :type card16)
+  (depths <unspec> :type (alist (image-depth depth) ((list visual-info) visuals)))
+  (root-depth <unspec> :type image-depth)
+  (root-visual-info <unspec> :type visual-info)
+  (default-colormap <unspec> :type colormap)
+  (white-pixel <unspec> :type pixel)
+  (black-pixel <unspec> :type pixel)
+  (min-installed-maps <unspec> :type card16)
+  (max-installed-maps <unspec> :type card16)
+  (backing-stores <unspec> :type (member :never :when-mapped :always))
+  (save-unders-p <unspec> :type boolean)
+  (event-mask-at-open <unspec> :type mask32))
+
+(defun screen-root-visual (screen)
+  (declare (type screen screen)
+	   (values resource-id)))
+
+;; The list contains alternating keywords and integers.
+
+(deftype font-props () 'list)
+
+(defun open-display (host &key (display 0) protocol)
+  ;; A string must be acceptable as a host, but otherwise the possible types for host
+  ;; and protocol are not constrained, and will likely be very system dependent.  The
+  ;; default protocol is system specific.  Authorization, if any, is assumed to come
+  ;; from the environment somehow.
+  (declare (type integer display)
+	   (values display)))
+
+(defun display-protocol-major-version (display)
+  (declare (type display display)
+	   (values card16)))
+
+(defun display-protocol-minor-version (display)
+  (declare (type display display)
+	   (values card16)))
+
+(defun display-vendor-name (display)
+  (declare (type display display)
+	   (values string)))
+
+(defun display-release-number (display)
+  (declare (type display display)
+	   (values card32)))
+
+(defun display-image-lsb-first-p (display)
+  (declare (type display display)
+	   (values boolean)))
+
+(defun display-bitmap-formap (display)
+  (declare (type display display)
+	   (values bitmap-format)))
+
+(defun display-pixmap-formats (display)
+  (declare (type display display)
+	   (values (list pixmap-formats))))
+
+(defun display-roots (display)
+  (declare (type display display)
+	   (values (list screen))))
+
+(defun display-motion-buffer-size (display)
+  (declare (type display display)
+	   (values card32)))
+
+(defun display-max-request-length (display)
+  (declare (type display display)
+	   (values card16)))
+
+(defun display-min-keycode (display)
+  (declare (type display display)
+	   (values card8)))
+
+(defun display-max-keycode (display)
+  (declare (type display display)
+	   (values card8)))
+
+(defun close-display (display)
+  (declare (type display display)))
+
+(defun display-error-handler (display)
+  (declare (type display display)
+	   (values handler)))
+
+(defsetf display-error-handler (display) (handler)
+  ;; All errors (synchronous and asynchronous) are processed by calling an error
+  ;; handler in the display.  If handler is a sequence it is expected to contain
+  ;; handler functions specific to each error; the error code is used to index the
+  ;; sequence, fetching the appropriate handler.  Any results returned by the handler
+  ;; are ignored; it is assumed the handler either takes care of the error
+  ;; completely, or else signals. For all core errors, the keyword/value argument
+  ;; pairs are:
+  ;;    :major card8
+  ;;    :minor card16
+  ;;    :sequence card16
+  ;;    :current-sequence card16
+  ;;	:asynchronous (member t nil)
+  ;; For :colormap, :cursor, :drawable, :font, :gcontext, :id-choice, :pixmap, and
+  ;; :window errors another pair is:
+  ;;    :resource-id card32
+  ;; For :atom errors, another pair is:
+  ;;    :atom-id card32
+  ;; For :value errors, another pair is:
+  ;;    :value card32
+  (declare (type display display)
+	   (type (or (sequence (function (display symbol &rest key-vals)))
+		     (function (display symbol &rest key-vals)))
+		 handler)))
+
+(defsetf display-report-asynchronous-errors (display) (when)
+  ;; Most useful in multi-process lisps.
+  ;;
+  ;; Synchronous errors are always signalled in the process that made the
+  ;; synchronous request.  An error is considered synchronous if a process is
+  ;; waiting for a reply with the same request-id as the error.
+  ;; 
+  ;; Asynchronous errors can be signalled at any one of these three times:
+  ;; 
+  ;; 1.  As soon as they are read.  They get signalled in whichever process 
+  ;; was doing the reading.  This is enabled by
+  ;;       (setf (xlib:display-report-asynchronous-errors display)
+  ;;             '(:immediately))
+  ;; This is the default.
+  ;; 
+  ;; 2.  Before any events are to be handled.  You get these by doing an
+  ;; event-listen with any timeout value other than 0, or in of the event
+  ;; processing forms.  This is useful if you using a background process to
+  ;; handle input.  This is enabled by
+  ;;       (setf (xlib:display-report-asynchronous-errors display)
+  ;;             '(:before-event-handling)) 
+  ;; 
+  ;; 3.  After a display-finish-output.  You get these by doing a
+  ;; display-finish-output.  A cliche using this might have a with-display
+  ;; wrapped around the display operations that possibly cause an asynchronous
+  ;; error, with a display-finish-output right the end of the with-display to
+  ;; catch any asynchronous errors.  This is enabled by
+  ;;       (setf (xlib:display-report-asynchronous-errors display)
+  ;;             '(:after-finish-output))
+  ;; 
+  ;; You can select any combination of the three keywords.  For example, to
+  ;; get errors reported before event handling and after finish-output,
+  ;;       (setf (xlib:display-report-asynchronous-errors display)
+  ;;             '(:before-event-handling :after-finish-output))
+  (declare (type list when))
+  )
+
+(defmacro define-condition (name base &body items)
+  ;; just a place-holder here for the real thing
+  )
+
+(define-condition request-error error
+  display
+  major
+  minor
+  sequence
+  current-sequence
+  asynchronous)
+
+(defun default-error-handler (display error-key &rest key-vals)
+  ;; The default display-error-handler.
+  ;; It signals the conditions listed below.
+  (declare (type display display)
+	   (type symbol error-key))
+  )
+
+(define-condition resource-error request-error
+  resource-id)
+
+(define-condition access-error request-error)
+
+(define-condition alloc-error request-error)
+
+(define-condition atom-error request-error
+  atom-id)
+
+(define-condition colormap-error resource-error)
+
+(define-condition cursor-error resource-error)
+
+(define-condition drawable-error resource-error)
+
+(define-condition font-error resource-error)
+
+(define-condition gcontext-error resource-error)
+
+(define-condition id-choice-error resource-error)
+
+(define-condition illegal-request-error request-error)
+
+(define-condition implementation-error request-error)
+
+(define-condition length-error request-error)
+
+(define-condition match-error request-error)
+
+(define-condition name-error request-error)
+
+(define-condition pixmap-error resource-error)
+
+(define-condition value-error request-error
+  value)
+
+(define-condition window-error resource-error)
+
+(defmacro with-display ((display) &body body)
+  ;; This macro is for use in a multi-process environment.  It provides exclusive
+  ;; access to the local display object for multiple request generation.  It need not
+  ;; provide immediate exclusive access for replies; that is, if another process is
+  ;; waiting for a reply (while not in a with-display), then synchronization need not
+  ;; (but can) occur immediately.  Except where noted, all routines effectively
+  ;; contain an implicit with-display where needed, so that correct synchronization
+  ;; is always provided at the interface level on a per-call basis.  Nested uses of
+  ;; this macro will work correctly.  This macro does not prevent concurrent event
+  ;; processing; see with-event-queue.
+  )
+
+(defun display-force-output (display)
+  ;; Output is normally buffered; this forces any buffered output.
+  (declare (type display display)))
+
+(defun display-finish-output (display)
+  ;; Forces output, then causes a round-trip to ensure that all possible errors and
+  ;; events have been received.
+  (declare (type display display)))
+
+(defun display-after-function (display)
+  ;; setf'able
+  ;; If defined, called after every protocol request is generated, even those inside
+  ;; explicit with-display's, but never called from inside the after-function itself.
+  ;; The function is called inside the effective with-display for the associated
+  ;; request.  Default value is nil.  Can be set, for example, to
+  ;; #'display-force-output or #'display-finish-output.
+  (declare (type display display)
+	   (values (or null (function (display))))))
+
+(defun create-window (&key parent x y width height (depth 0) (border-width 0)
+		      (class :copy) (visual :copy)
+		      background border gravity bit-gravity
+		      backing-store backing-planes backing-pixel save-under
+		      event-mask do-not-propagate-mask override-redirect
+		      colormap cursor)
+  ;; Display is obtained from parent.  Only non-nil attributes are passed on in the
+  ;; request: the function makes no assumptions about what the actual protocol
+  ;; defaults are.  Width and height are the inside size, excluding border.
+  (declare (type window parent)
+	   (type int16 x y)
+	   (type card16 width height depth border-width)
+	   (type (member :copy :input-output :input-only) class)
+	   (type (or (member :copy) visual-info) visual)
+	   (type (or null (member :none :parent-relative) pixel pixmap) background)
+	   (type (or null (member :copy) pixel pixmap) border)
+	   (type (or null win-gravity) gravity)
+	   (type (or null bit-gravity) bit-gravity)
+	   (type (or null (member :not-useful :when-mapped :always) backing-store))
+	   (type (or null pixel) backing-planes backing-pixel)
+	   (type (or null event-mask) event-mask)
+	   (type (or null device-event-mask) do-not-propagate-mask)
+	   (type (or null (member :on :off)) save-under override-redirect)
+	   (type (or null (member :copy) colormap) colormap)
+	   (type (or null (member :none) cursor) cursor)
+	   (values window)))
+
+(defun window-class (window)
+  (declare (type window window)
+	   (values (member :input-output :input-only))))
+
+(defun window-visual-info (window)
+  (declare (type window window)
+	   (values visual-info)))
+
+(defun window-visual (window)
+  (declare (type window window)
+	   (values resource-id)))
+
+(defsetf window-background (window) (background)
+  (declare (type window window)
+	   (type (or (member :none :parent-relative) pixel pixmap) background)))
+
+(defsetf window-border (window) (border)
+  (declare (type window window)
+	   (type (or (member :copy) pixel pixmap) border)))
+
+(defun window-gravity (window)
+  ;; setf'able
+  (declare (type window window)
+	   (values win-gravity)))
+
+(defun window-bit-gravity (window)
+  ;; setf'able
+  (declare (type window window)
+	   (values bit-gravity)))
+
+(defun window-backing-store (window)
+  ;; setf'able
+  (declare (type window window)
+	   (values (member :not-useful :when-mapped :always))))
+
+(defun window-backing-planes (window)
+  ;; setf'able
+  (declare (type window window)
+	   (values pixel)))
+
+(defun window-backing-pixel (window)
+  ;; setf'able
+  (declare (type window window)
+	   (values pixel)))
+
+(defun window-save-under (window)
+  ;; setf'able
+  (declare (type window window)
+	   (values (member :on :off))))
+
+(defun window-event-mask (window)
+  ;; setf'able
+  (declare (type window window)
+	   (values mask32)))
+
+(defun window-do-not-propagate-mask (window)
+  ;; setf'able
+  (declare (type window window)
+	   (values mask32)))
+
+(defun window-override-redirect (window)
+  ;; setf'able
+  (declare (type window window)
+	   (values (member :on :off))))
+
+(defun window-colormap (window)
+  (declare (type window window)
+	   (values (or null colormap))))
+
+(defsetf window-colormap (window) (colormap)
+  (declare (type window window)
+	   (type (or (member :copy) colormap) colormap)))
+
+(defsetf window-cursor (window) (cursor)
+  (declare (type window window)
+	   (type (or (member :none) cursor) cursor)))
+
+(defun window-colormap-installed-p (window)
+  (declare (type window window)
+	   (values boolean)))
+
+(defun window-all-event-masks (window)
+  (declare (type window window)
+	   (values mask32)))
+
+(defun window-map-state (window)
+  (declare (type window window)
+	   (values (member :unmapped :unviewable :viewable))))
+
+(defsetf drawable-x (window) (x)
+  (declare (type window window)
+	   (type int16 x)))
+
+(defsetf drawable-y (window) (y)
+  (declare (type window window)
+	   (type int16 y)))
+
+(defsetf drawable-width (window) (width)
+  ;; Inside width, excluding border.
+  (declare (type window window)
+	   (type card16 width)))
+
+(defsetf drawable-height (window) (height)
+  ;; Inside height, excluding border.
+  (declare (type window window)
+	   (type card16 height)))
+
+(defsetf drawable-border-width (window) (border-width)
+  (declare (type window window)
+	   (type card16 border-width)))
+
+(defsetf window-priority (window &optional sibling) (mode)
+  ;; A bit strange, but retains setf form.
+  (declare (type window window)
+	   (type (or null window) sibling)
+	   (type (member :above :below :top-if :bottom-if :opposite) mode)))
+
+(defmacro with-state ((drawable) &body body)
+  ;; Allows a consistent view to be obtained of data returned by GetWindowAttributes
+  ;; and GetGeometry, and allows a coherent update using ChangeWindowAttributes and
+  ;; ConfigureWindow.  The body is not surrounded by a with-display.  Within the
+  ;; indefinite scope of the body, on a per-process basis in a multi-process
+  ;; environment, the first call within an Accessor Group on the specified drawable
+  ;; (the object, not just the variable) causes the complete results of the protocol
+  ;; request to be retained, and returned in any subsequent accessor calls.  Calls
+  ;; within a Setf Group are delayed, and executed in a single request on exit from
+  ;; the body.  In addition, if a call on a function within an Accessor Group follows
+  ;; a call on a function in the corresponding Setf Group, then all delayed setfs for
+  ;; that group are executed, any retained accessor information for that group is
+  ;; discarded, the corresponding protocol request is (re)issued, and the results are
+  ;; (again) retained, and returned in any subsequent accessor calls.
+
+  ;; Accessor Group A (for GetWindowAttributes):
+  ;; window-visual-info, window-visual, window-class, window-gravity, window-bit-gravity,
+  ;; window-backing-store, window-backing-planes, window-backing-pixel,
+  ;; window-save-under, window-colormap, window-colormap-installed-p,
+  ;; window-map-state, window-all-event-masks, window-event-mask,
+  ;; window-do-not-propagate-mask, window-override-redirect
+
+  ;; Setf Group A (for ChangeWindowAttributes):
+  ;; window-gravity, window-bit-gravity, window-backing-store, window-backing-planes,
+  ;; window-backing-pixel, window-save-under, window-event-mask,
+  ;; window-do-not-propagate-mask, window-override-redirect, window-colormap,
+  ;; window-cursor
+
+  ;; Accessor Group G (for GetGeometry):
+  ;; drawable-root, drawable-depth, drawable-x, drawable-y, drawable-width,
+  ;; drawable-height, drawable-border-width
+
+  ;; Setf Group G (for ConfigureWindow):
+  ;; drawable-x, drawable-y, drawable-width, drawable-height, drawable-border-width,
+  ;; window-priority
+  )
+
+(defun destroy-window (window)
+  (declare (type window window)))
+
+(defun destroy-subwindows (window)
+  (declare (type window window)))
+
+(defun add-to-save-set (window)
+  (declare (type window window)))
+
+(defun remove-from-save-set (window)
+  (declare (type window window)))
+
+(defun reparent-window (window parent x y)
+  (declare (type window window parent)
+	   (type int16 x y)))
+
+(defun map-window (window)
+  (declare (type window window)))
+
+(defun map-subwindows (window)
+  (declare (type window window)))
+
+(defun unmap-window (window)
+  (declare (type window window)))
+
+(defun unmap-subwindows (window)
+  (declare (type window window)))
+
+(defun circulate-window-up (window)
+  (declare (type window window)))
+
+(defun circulate-window-down (window)
+  (declare (type window window)))
+
+(defun drawable-root (drawable)
+  (declare (type drawable drawable)
+	   (values window)))
+
+(defun drawable-depth (drawable)
+  (declare (type drawable drawable)
+	   (values card8)))
+
+(defun drawable-x (drawable)
+  (declare (type drawable drawable)
+	   (values int16)))
+
+(defun drawable-y (drawable)
+  (declare (type drawable drawable)
+	   (values int16)))
+
+(defun drawable-width (drawable)
+  ;; For windows, inside width, excluding border.
+  (declare (type drawable drawable)
+	   (values card16)))
+
+(defun drawable-height (drawable)
+  ;; For windows, inside height, excluding border.
+  (declare (type drawable drawable)
+	   (values card16)))
+
+(defun drawable-border-width (drawable)
+  (declare (type drawable drawable)
+	   (values card16)))
+
+(defun query-tree (window &key (result-type 'list))
+  (declare (type window window)
+	   (type type result-type)
+	   (values (sequence window) parent root)))
+
+(defun change-property (window property data type format
+			&key (mode :replace) (start 0) end transform)
+  ;; Start and end affect sub-sequence extracted from data.
+  ;; Transform is applied to each extracted element.
+  (declare (type window window)
+	   (type xatom property type)
+	   (type (member 8 16 32) format)
+	   (type sequence data)
+	   (type (member :replace :prepend :append) mode)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type (or null (function (t) integer)) transform)))
+
+(defun delete-property (window property)
+  (declare (type window window)
+	   (type xatom property)))
+
+(defun get-property (window property
+		     &key type (start 0) end delete-p (result-type 'list) transform)
+  ;; Transform is applied to each integer retrieved.
+  ;; Nil is returned for type when the protocol returns None.
+  (declare (type window window)
+	   (type xatom property)
+	   (type (or null xatom) type)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type boolean delete-p)
+	   (type type result-type)
+	   (type (or null (function (integer) t)) transform)
+	   (values data type format bytes-after)))
+
+(defun rotate-properties (window properties &optional (delta 1))
+  ;; Postive rotates left, negative rotates right (opposite of actual protocol request).
+  (declare (type window window)
+	   (type (sequence xatom) properties)
+	   (type int16 delta)))
+
+(defun list-properties (window &key (result-type 'list))
+  (declare (type window window)
+	   (type type result-type)
+	   (values (sequence keyword))))
+
+;; Although atom-ids are not visible in the normal user interface, atom-ids might
+;; appear in window properties and other user data, so conversion hooks are needed.
+
+(defun intern-atom (display name)
+  (declare (type display display)
+	   (type xatom name)
+	   (values resource-id)))
+
+(defun find-atom (display name)
+  (declare (type display display)
+	   (type xatom name)
+	   (values (or null resource-id))))
+
+(defun atom-name (display atom-id)
+  (declare (type display display)
+	   (type resource-id atom-id)
+	   (values keyword)))
+
+(defun selection-owner (display selection)
+  (declare (type display display)
+	   (type xatom selection)
+	   (values (or null window))))
+
+(defsetf selection-owner (display selection &optional time) (owner)
+  ;; A bit strange, but retains setf form.
+  (declare (type display display)
+	   (type xatom selection)
+	   (type (or null window) owner)
+	   (type timestamp time)))
+
+(defun convert-selection (selection type requestor &optional property time)
+  (declare (type xatom selection type)
+	   (type window requestor)
+	   (type (or null xatom) property)
+	   (type timestamp time)))
+
+(defun send-event (window event-key event-mask &rest args
+		   &key propagate-p display &allow-other-keys)
+  ;; Additional arguments depend on event-key, and are as specified further below
+  ;; with declare-event, except that both resource-ids and resource objects are
+  ;; accepted in the event components.  The display argument is only required if the
+  ;; window is :pointer-window or :input-focus.  If an argument has synonyms, it is
+  ;; only necessary to supply a value for one of them; it is an error to specify
+  ;; different values for synonyms.
+  (declare (type (or window (member :pointer-window :input-focus)) window)
+	   (type (or null event-key) event-key)
+	   (type event-mask event-mask)
+	   (type boolean propagate-p)
+	   (type (or null display) display)))
+
+(defun grab-pointer (window event-mask
+		     &key owner-p sync-pointer-p sync-keyboard-p confine-to cursor time)
+  (declare (type window window)
+	   (type pointer-event-mask event-mask)
+	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
+	   (type (or null window) confine-to)
+	   (type (or null cursor) cursor)
+	   (type timestamp time)
+	   (values grab-status)))
+
+(defun ungrab-pointer (display &key time)
+  (declare (type display display)
+	   (type timestamp time)))
+
+(defun grab-button (window button event-mask
+		    &key (modifiers 0)
+			 owner-p sync-pointer-p sync-keyboard-p confine-to cursor)
+  (declare (type window window)
+	   (type (or (member :any) card8) button)
+	   (type modifier-mask modifiers)
+	   (type pointer-event-mask event-mask)
+	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
+	   (type (or null window) confine-to)
+	   (type (or null cursor) cursor)))
+
+(defun ungrab-button (window button &key (modifiers 0))
+  (declare (type window window)
+	   (type (or (member :any) card8) button)
+	   (type modifier-mask modifiers)))
+
+(defun change-active-pointer-grab (display event-mask &optional cursor time)
+  (declare (type display display)
+	   (type pointer-event-mask event-mask)
+	   (type (or null cursor) cursor)
+	   (type timestamp time)))
+
+(defun grab-keyboard (window &key owner-p sync-pointer-p sync-keyboard-p time)
+  (declare (type window window)
+	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
+	   (type timestamp time)
+	   (values grab-status)))
+
+(defun ungrab-keyboard (display &key time)
+  (declare (type display display)
+	   (type timestamp time)))
+
+(defun grab-key (window key &key (modifiers 0) owner-p sync-pointer-p sync-keyboard-p)
+  (declare (type window window)
+	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
+	   (type (or (member :any) card8) key)
+	   (type modifier-mask modifiers)))
+
+(defun ungrab-key (window key &key (modifiers 0))
+  (declare (type window window)
+	   (type (or (member :any) card8) key)
+	   (type modifier-mask modifiers)))
+
+(defun allow-events (display mode &optional time)
+  (declare (type display display)
+	   (type (member :async-pointer :sync-pointer :reply-pointer
+			 :async-keyboard :sync-keyboard :replay-keyboard
+			 :async-both :sync-both)
+		 mode)
+	   (type timestamp time)))
+
+(defun grab-server (display)
+  (declare (type display display)))
+
+(defun ungrab-server (display)
+  (declare (type display display)))
+
+(defmacro with-server-grabbed ((display) &body body)
+  ;; The body is not surrounded by a with-display.
+  )
+
+(defun query-pointer (window)
+  (declare (type window window)
+	   (values x y same-screen-p child mask root-x root-y root)))
+
+(defun pointer-position (window)
+  (declare (type window window)
+	   (values x y same-screen-p)))
+
+(defun global-pointer-position (display)
+  (declare (type display display)
+	   (values root-x root-y root)))
+
+(defun motion-events (window &key start stop (result-type 'list))
+  (declare (type window window)
+	   (type timestamp start stop)
+	   (type type result-type)
+	   (values (repeat-seq (int16 x) (int16 y) (timestamp time)))))
+
+(defun translate-coordinates (src src-x src-y dst)
+  ;; If src and dst are not on the same screen, nil is returned.
+  (declare (type window src)
+	   (type int16 src-x src-y)
+	   (type window dst)
+	   (values dst-x dst-y child)))
+
+(defun warp-pointer (dst dst-x dst-y)
+  (declare (type window dst)
+	   (type int16 dst-x dst-y)))
+
+(defun warp-pointer-relative (display x-off y-off)
+  (declare (type display display)
+	   (type int16 x-off y-off)))
+
+(defun warp-pointer-if-inside (dst dst-x dst-y src src-x src-y
+			       &optional src-width src-height)
+  ;; Passing in a zero src-width or src-height is a no-op.  A null src-width or
+  ;; src-height translates into a zero value in the protocol request.
+  (declare (type window dst src)
+	   (type int16 dst-x dst-y src-x src-y)
+	   (type (or null card16) src-width src-height)))
+
+(defun warp-pointer-relative-if-inside (x-off y-off src src-x src-y
+					&optional src-width src-height)
+  ;; Passing in a zero src-width or src-height is a no-op.  A null src-width or
+  ;; src-height translates into a zero value in the protocol request.
+  (declare (type window src)
+	   (type int16 x-off y-off src-x src-y)
+	   (type (or null card16) src-width src-height)))
+
+(defun set-input-focus (display focus revert-to &optional time)
+  ;; Setf ought to allow multiple values.
+  (declare (type display display)
+	   (type (or (member :none :pointer-root) window) focus)
+	   (type (member :none :parent :pointer-root) revert-to)
+	   (type timestamp time)))
+
+(defun input-focus (display)
+  (declare (type display display)
+	   (values focus revert-to)))
+
+(defun query-keymap (display)
+  (declare (type display display)
+	   (values (bit-vector 256))))
+
+(defun open-font (display name)
+  ;; Font objects may be cached and reference counted locally within the display
+  ;; object.  This function might not execute a with-display if the font is cached.
+  ;; The protocol QueryFont request happens on-demand under the covers.
+  (declare (type display display)
+	   (type stringable name)
+	   (values font)))
+
+;; We probably want a per-font bit to indicate whether caching on
+;; text-extents/width calls is desirable.  But what to name it?
+
+(defun discard-font-info (font)
+  ;; Discards any state that can be re-obtained with QueryFont.  This is simply
+  ;; a performance hint for memory-limited systems.
+  (declare (type font font)))
+
+;; This can be signalled anywhere a pseudo font access fails.
+
+(define-condition invalid-font error
+  font)
+
+;; Note: font-font-info removed.
+
+(defun font-name (font)
+  ;; Returns nil for a pseudo font returned by gcontext-font.
+  (declare (type font font)
+	   (values (or null string))))
+
+(defun font-direction (font)
+  (declare (type font font)
+	   (values draw-direction)))
+
+(defun font-min-char (font)
+  (declare (type font font)
+	   (values card16)))
+
+(defun font-max-char (font)
+  (declare (type font font)
+	   (values card16)))
+
+(defun font-min-byte1 (font)
+  (declare (type font font)
+	   (values card8)))
+
+(defun font-max-byte1 (font)
+  (declare (type font font)
+	   (values card8)))
+
+(defun font-min-byte2 (font)
+  (declare (type font font)
+	   (values card8)))
+
+(defun font-max-byte2 (font)
+  (declare (type font font)
+	   (values card8)))
+
+(defun font-all-chars-exist-p (font)
+  (declare (type font font)
+	   (values boolean)))
+
+(defun font-default-char (font)
+  (declare (type font font)
+	   (values card16)))
+
+(defun font-ascent (font)
+  (declare (type font font)
+	   (values int16)))
+
+(defun font-descent (font)
+  (declare (type font font)
+	   (values int16)))
+
+;; The list contains alternating keywords and int32s.
+
+(deftype font-props () 'list)
+
+(defun font-properties (font)
+  (declare (type font font)
+	   (values font-props)))
+
+(defun font-property (font name)
+  (declare (type font font)
+	   (type keyword name)
+	   (values (or null int32))))
+
+;; For each of left-bearing, right-bearing, width, ascent, descent, attributes:
+
+(defun char-<metric> (font index)
+  ;; Note: I have tentatively chosen to return nil for an out-of-bounds index
+  ;; (or an in-bounds index on a pseudo font), although returning zero or
+  ;; signalling might be better.
+  (declare (type font font)
+	   (type card16 index)
+	   (values (or null int16))))
+
+(defun max-char-<metric> (font)
+  ;; Note: I have tentatively chosen separate accessors over allowing :min and
+  ;; :max as an index above.
+  (declare (type font font)
+	   (values int16)))
+
+(defun min-char-<metric> (font)
+  (declare (type font font)
+	   (values int16)))
+
+;; Note: char16-<metric> accessors could be defined to accept two-byte indexes.
+
+(defun close-font (font)
+  ;; This might not generate a protocol request if the font is reference
+  ;; counted locally or if it is a pseudo font.
+  (declare (type font font)))
+
+(defun list-font-names (display pattern &key (max-fonts 65535) (result-type 'list))
+  (declare (type display display)
+	   (type string pattern)
+	   (type card16 max-fonts)
+	   (type type result-type)
+	   (values (sequence string))))
+
+(defun list-fonts (display pattern &key (max-fonts 65535) (result-type 'list))
+  ;; Returns "pseudo" fonts that contain basic font metrics and properties, but
+  ;; no per-character metrics and no resource-ids.  These pseudo fonts will be
+  ;; converted (internally) to real fonts dynamically as needed, by issuing an
+  ;; OpenFont request.  However, the OpenFont might fail, in which case the
+  ;; invalid-font error can arise.
+  (declare (type display display)
+	   (type string pattern)
+	   (type card16 max-fonts)
+	   (type type result-type)
+	   (values (sequence font))))
+
+(defun font-path (display &key (result-type 'list))
+  (declare (type display display)
+	   (type type result-type)
+	   (values (sequence (or string pathname)))))
+
+(defsetf font-path (display) (paths)
+  (declare (type display display)
+	   (type (sequence (or string pathname)) paths)))
+
+(defun create-pixmap (&key width height depth drawable)
+  (declare (type card16 width height)
+	   (type card8 depth)
+	   (type drawable drawable)
+	   (values pixmap)))
+
+(defun free-pixmap (pixmap)
+  (declare (type pixmap pixmap)))
+
+(defun create-gcontext (&key drawable function plane-mask foreground background
+			     line-width line-style cap-style join-style fill-style fill-rule
+			     arc-mode tile stipple ts-x ts-y font subwindow-mode
+			     exposures clip-x clip-y clip-mask clip-ordering
+			     dash-offset dashes
+			     (cache-p t))
+  ;; Only non-nil components are passed on in the request, but for effective caching
+  ;; assumptions have to be made about what the actual protocol defaults are.  For
+  ;; all gcontext components, a value of nil causes the default gcontext value to be
+  ;; used.  For clip-mask, this implies that an empty rect-seq cannot be represented
+  ;; as a list.  Note:  use of stringable as font will cause an implicit open-font.
+  ;; Note:  papers over protocol SetClipRectangles and SetDashes special cases.  If
+  ;; cache-p is true, then gcontext state is cached locally, and changing a gcontext
+  ;; component will have no effect unless the new value differs from the cached
+  ;; value.  Component changes (setfs and with-gcontext) are always deferred
+  ;; regardless of the cache mode, and sent over the protocol only when required by a
+  ;; local operation or by an explicit call to force-gcontext-changes.
+  (declare (type drawable drawable)
+	   (type (or null boole-constant) function)
+	   (type (or null pixel) plane-mask foreground background)
+	   (type (or null card16) line-width dash-offset)
+	   (type (or null int16) ts-x ts-y clip-x clip-y)
+	   (type (or null (member :solid :dash :double-dash)) line-style)
+	   (type (or null (member :not-last :butt :round :projecting)) cap-style)
+	   (type (or null (member :miter :round :bevel)) join-style)
+	   (type (or null (member :solid :tiled :opaque-stippled :stippled)) fill-style)
+	   (type (or null (member :even-odd :winding)) fill-rule)
+	   (type (or null (member :chord :pie-slice)) arc-mode)
+	   (type (or null pixmap) tile stipple)
+	   (type (or null fontable) font)
+	   (type (or null (member :clip-by-children :include-inferiors)) subwindow-mode)
+	   (type (or null (member :on :off)) exposures)
+	   (type (or null (member :none) pixmap rect-seq) clip-mask)
+	   (type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering)
+	   (type (or null (or card8 (sequence card8))) dashes)
+	   (type boolean cache)
+	   (values gcontext)))
+
+;; For each argument to create-gcontext (except font, clip-mask and
+;; clip-ordering) declared as (type <type> <name>), there is an accessor:
+
+(defun gcontext-<name> (gcontext)
+  ;; The value will be nil if the last value stored is unknown (e.g., the cache was
+  ;; off, or the component was copied from a gcontext with unknown state).
+  (declare (type gcontext gcontext)
+	   (values <type>)))
+
+;; For each argument to create-gcontext (except clip-mask and clip-ordering) declared
+;; as (type (or null <type>) <name>), there is a setf for the corresponding accessor:
+
+(defsetf gcontext-<name> (gcontext) (value)
+  (declare (type gcontext gcontext)
+	   (type <type> value)))
+
+(defun gcontext-font (gcontext &optional metrics-p)
+  ;; If the stored font is known, it is returned.  If it is not known and
+  ;; metrics-p is false, then nil is returned.  If it is not known and
+  ;; metrics-p is true, then a pseudo font is returned.  Full metric and
+  ;; property information can be obtained, but the font does not have a name or
+  ;; a resource-id, and attempts to use it where a resource-id is required will
+  ;; result in an invalid-font error.
+  (declare (type gcontext gcontext)
+	   (type boolean metrics-p)
+	   (values (or null font))))
+
+(defun gcontext-clip-mask (gcontext)
+  (declare (type gcontext gcontext)
+	   (values (or null (member :none) pixmap rect-seq)
+		   (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)))))
+
+(defsetf gcontext-clip-mask (gcontext &optional ordering) (clip-mask)
+  ;; Is nil illegal here, or is it transformed to a vector?
+  ;; A bit strange, but retains setf form.
+  (declare (type gcontext gcontext)
+	   (type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering)
+	   (type (or (member :none) pixmap rect-seq) clip-mask)))
+
+(defun force-gcontext-changes (gcontext)
+  ;; Force any delayed changes.
+  (declare (type gcontext gcontext)))
+
+(defmacro with-gcontext ((gcontext &key
+			  function plane-mask foreground background
+			  line-width line-style cap-style join-style fill-style fill-rule
+			  arc-mode tile stipple ts-x ts-y font subwindow-mode
+			  exposures clip-x clip-y clip-mask clip-ordering
+			  dashes dash-offset)
+			 &body body)
+  ;; Changes gcontext components within the dynamic scope of the body (i.e.,
+  ;; indefinite scope and dynamic extent), on a per-process basis in a multi-process
+  ;; environment.  The values are all evaluated before bindings are performed.  The
+  ;; body is not surrounded by a with-display.  If cache-p is nil or the some
+  ;; component states are unknown, this will implement save/restore by creating a
+  ;; temporary gcontext and doing gcontext-components to and from it.
+  )
+
+(defun copy-gcontext-components (src dst &rest keys)
+  (declare (type gcontext src dst)
+	   (type (list gcontext-key) keys)))
+
+(defun copy-gcontext (src dst)
+  (declare (type gcontext src dst))
+  ;; Copies all components.
+  )
+	   
+(defun free-gcontext (gcontext)
+  (declare (type gcontext gcontext)))
+
+(defun clear-area (window &key (x 0) (y 0) width height exposures-p)
+  ;; Passing in a zero width or height is a no-op.  A null width or height translates
+  ;; into a zero value in the protocol request.
+  (declare (type window window)
+	   (type int16 x y)
+	   (type (or null card16) width height)
+	   (type boolean exposures-p)))
+
+(defun copy-area (src gcontext src-x src-y width height dst dst-x dst-y)
+  (declare (type drawable src dst)
+	   (type gcontext gcontext)
+	   (type int16 src-x src-y dst-x dst-y)
+	   (type card16 width height)))
+
+(defun copy-plane (src gcontext plane src-x src-y width height dst dst-x dst-y)
+  (declare (type drawable src dst)
+	   (type gcontext gcontext)
+	   (type pixel plane)
+	   (type int16 src-x src-y dst-x dst-y)
+	   (type card16 width height)))
+
+(defun draw-point (drawable gcontext x y)
+  ;; Should be clever about appending to existing buffered protocol request, provided
+  ;; gcontext has not been modified.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)))
+
+(defun draw-points (drawable gcontext points &optional relative-p)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type point-seq points)
+	   (type boolean relative-p)))
+
+(defun draw-line (drawable gcontext x1 y1 x2 y2 &optional relative-p)
+  ;; Should be clever about appending to existing buffered protocol request, provided
+  ;; gcontext has not been modified.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x1 y1 x2 y2)
+	   (type boolean relative-p)))
+
+(defun draw-lines (drawable gcontext points &key relative-p fill-p (shape :complex))
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type point-seq points)
+	   (type boolean relative-p fill-p)
+	   (type (member :complex :non-convex :convex) shape)))
+
+(defun draw-segments (drawable gcontext segments)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type seg-seq segments)))
+
+(defun draw-rectangle (drawable gcontext x y width height &optional fill-p)
+  ;; Should be clever about appending to existing buffered protocol request, provided
+  ;; gcontext has not been modified.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type boolean fill-p)))
+
+(defun draw-rectangles (drawable gcontext rectangles &optional fill-p)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type rect-seq rectangles)
+	   (type boolean fill-p)))
+
+(defun draw-arc (drawable gcontext x y width height angle1 angle2 &optional fill-p)
+  ;; Should be clever about appending to existing buffered protocol request, provided
+  ;; gcontext has not been modified.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type angle angle1 angle2)
+	   (type boolean fill-p)))
+
+(defun draw-arcs (drawable gcontext arcs &optional fill-p)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type arc-seq arcs)
+	   (type boolean fill-p)))
+
+;; The following image routines are bare minimum.  It may be useful to define some
+;; form of "image" object to hide representation details and format conversions.  It
+;; also may be useful to provide stream-oriented interfaces for reading and writing
+;; the data.
+
+(defun put-raw-image (drawable gcontext data
+		      &key (start 0) depth x y width height (left-pad 0) format)
+  ;; Data must be a sequence of 8-bit quantities, already in the appropriate format
+  ;; for transmission; the caller is responsible for all byte and bit swapping and
+  ;; compaction.  Start is the starting index in data; the end is computed from the
+  ;; other arguments.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type (sequence card8) data)
+	   (type array-index start)
+	   (type card8 depth left-pad)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type (member :bitmap :xy-pixmap :z-pixmap) format)))
+
+(defun get-raw-image (drawable &key data (start 0) x y width height
+				    (plane-mask 0xffffffff) format
+				    (result-type '(vector (unsigned-byte 8))))
+  ;; If data is given, it is modified in place (and returned), otherwise a new
+  ;; sequence is created and returned, with a size computed from the other arguments
+  ;; and the returned depth.  The sequence is filled with 8-bit quantities, in
+  ;; transmission format; the caller is responsible for any byte and bit swapping and
+  ;; compaction required for further local use.
+  (declare (type drawable drawable)
+	   (type (or null (sequence card8)) data)
+	   (type array-index start)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type pixel plane-mask)
+	   (type (member :xy-pixmap :z-pixmap) format)
+	   (values (sequence card8) depth visual-info)))
+
+(defun translate-default (src src-start src-end font dst dst-start)
+  ;; dst is guaranteed to have room for (- src-end src-start) integer elements,
+  ;; starting at dst-start; whether dst holds 8-bit or 16-bit elements depends
+  ;; on context.  font is the current font, if known.  The function should
+  ;; translate as many elements of src as possible into indexes in the current
+  ;; font, and store them into dst.  The first return value should be the src
+  ;; index of the first untranslated element.  If no further elements need to
+  ;; be translated, the second return value should be nil.  If a horizontal
+  ;; motion is required before further translation, the second return value
+  ;; should be the delta in x coordinate.  If a font change is required for
+  ;; further translation, the second return value should be the new font.  If
+  ;; known, the pixel width of the translated text can be returned as the third
+  ;; value; this can allow for appending of subsequent output to the same
+  ;; protocol request, if no overall width has been specified at the higher
+  ;; level.
+  (declare (type sequence src)
+	   (type array-index src-start src-end dst-start)
+	   (type (or null font) font)
+	   (type vector dst)
+	   (values array-index (or null int16 font) (or null int32))))
+
+;; There is a question below of whether translate should always be required, or
+;; if not, what the default should be or where it should come from.  For
+;; example, the default could be something that expected a string as src and
+;; translated the CL standard character set to ASCII indexes, and ignored fonts
+;; and bits.  Or the default could expect a string but otherwise be "system
+;; dependent".  Or the default could be something that expected a vector of
+;; integers and did no translation.  Or the default could come from the
+;; gcontext (but what about text-extents and text-width?).
+
+(defun text-extents (font sequence &key (start 0) end translate)
+  ;; If multiple fonts are involved, font-ascent and font-descent will be the
+  ;; maximums.  If multiple directions are involved, the direction will be nil.
+  ;; Translate will always be called with a 16-bit dst buffer.
+  (declare (type sequence sequence)
+	   (type (or font gcontext) font)
+	   (type translate translate)
+	   (values width ascent descent left right font-ascent font-descent direction
+		   (or null array-index))))
+
+(defun text-width (font sequence &key (start 0) end translate)
+  ;; Translate will always be called with a 16-bit dst buffer.
+  (declare (type sequence sequence)
+	   (type (or font gcontext) font)
+	   (type translate translate)
+	   (values int32 (or null array-index))))
+
+;; This controls the element size of the dst buffer given to translate.  If
+;; :default is specified, the size will be based on the current font, if known,
+;; and otherwise 16 will be used.  [An alternative would be to pass the buffer
+;; size to translate, and allow it to return the desired size if it doesn't
+;; like the current size.  The problem is that the protocol doesn't allow
+;; switching within a single request, so to allow switching would require
+;; knowing the width of text, which isn't necessarily known.  We could call
+;; text-width to compute it, but perhaps that is doing too many favors?]  [An
+;; additional possibility is to allow an index-size of :two-byte, in which case
+;; translate would be given a double-length 8-bit array, and translate would be
+;; expected to store first-byte/second-byte instead of 16-bit integers.]
+
+(deftype index-size () '(member :default 8 16))
+
+;; In the glyph functions below, if width is specified, it is assumed to be the
+;; total pixel width of whatever string of glyphs is actually drawn.
+;; Specifying width will allow for appending the output of subsequent calls to
+;; the same protocol request, provided gcontext has not been modified in the
+;; interim.  If width is not specified, appending of subsequent output might
+;; not occur (unless translate returns the width).  Specifying width is simply
+;; a hint, for performance.
+
+(defun draw-glyph (drawable gcontext x y elt
+		   &key translate width (size :default))
+  ;; Returns true if elt is output, nil if translate refuses to output it.
+  ;; Second result is width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type translate translate)
+	   (type (or null int32) width)
+	   (type index-size size)
+	   (values boolean (or null int32))))
+
+(defun draw-glyphs (drawable gcontext x y sequence
+		    &key (start 0) end translate width (size :default))
+  ;; First result is new start, if end was not reached.  Second result is
+  ;; overall width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type sequence sequence)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type (or null int32) width)
+	   (type translate translate)
+	   (type index-size size)
+	   (values (or null array-index) (or null int32))))
+
+(defun draw-image-glyph (drawable gcontext x y elt
+			 &key translate width (size :default))
+  ;; Returns true if elt is output, nil if translate refuses to output it.
+  ;; Second result is overall width, if known.  An initial font change is
+  ;; allowed from translate.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type translate translate)
+	   (type (or null int32) width)
+	   (type index-size size)
+	   (values boolean (or null int32))))
+
+(defun draw-image-glyphs (drawable gcontext x y sequence
+			  &key (start 0) end width translate (size :default))
+  ;; An initial font change is allowed from translate, but any subsequent font
+  ;; change or horizontal motion will cause termination (because the protocol
+  ;; doesn't support chaining).  [Alternatively, font changes could be accepted
+  ;; as long as they are accompanied with a width return value, or always
+  ;; accept font changes and call text-width as required.  However, horizontal
+  ;; motion can't really be accepted, due to semantics.]  First result is new
+  ;; start, if end was not reached.  Second result is overall width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type sequence sequence)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type (or null int32) width)
+	   (type translate translate)
+	   (type index-size size)
+	   (values (or null array-index) (or null int32))))
+
+(defun create-colormap (visual window &optional alloc-p)
+  (declare (type visual-info visual)
+	   (type window window)
+	   (type boolean alloc-p)
+	   (values colormap)))
+
+(defun free-colormap (colormap)
+  (declare (type colormap colormap)))
+
+(defun copy-colormap-and-free (colormap)
+  (declare (type colormap colormap)
+	   (values colormap)))
+
+(defun install-colormap (colormap)
+  (declare (type colormap colormap)))
+
+(defun uninstall-colormap (colormap)
+  (declare (type colormap colormap)))
+
+(defun installed-colormaps (window &key (result-type 'list))
+  (declare (type window window)
+	   (type type result-type)
+	   (values (sequence colormap))))
+
+(defun alloc-color (colormap color)
+  (declare (type colormap colormap)
+	   (type (or stringable color) color)
+	   (values pixel screen-color exact-color)))
+
+(defun alloc-color-cells (colormap colors &key (planes 0) contiguous-p (result-type 'list))
+  (declare (type colormap colormap)
+	   (type card16 colors planes)
+	   (type boolean contiguous-p)
+	   (type type result-type)
+	   (values (sequence pixel) (sequence mask))))
+
+(defun alloc-color-planes (colormap colors
+			   &key (reds 0) (greens 0) (blues 0)
+				contiguous-p (result-type 'list))
+  (declare (type colormap colormap)
+	   (type card16 colors reds greens blues)
+	   (type boolean contiguous-p)
+	   (type type result-type)
+	   (values (sequence pixel) red-mask green-mask blue-mask)))
+
+(defun free-colors (colormap pixels &optional (plane-mask 0))
+  (declare (type colormap colormap)
+	   (type (sequence pixel) pixels)
+	   (type pixel plane-mask)))
+
+(defun store-color (colormap pixel spec &key (red-p t) (green-p t) (blue-p t))
+  (declare (type colormap colormap)
+	   (type pixel pixel)
+	   (type (or stringable color) spec)
+	   (type boolean red-p green-p blue-p)))
+
+(defun store-colors (colormap specs &key (red-p t) (green-p t) (blue-p t))
+  ;; If stringables are specified for colors, it is unspecified whether all
+  ;; stringables are first resolved and then a single StoreColors protocol request is
+  ;; issued, or whether multiple StoreColors protocol requests are issued.
+  (declare (type colormap colormap)
+	   (type (repeat-seq (pixel pixel) ((or stringable color) color)) specs)
+	   (type boolean red-p green-p blue-p)))
+
+(defun query-colors (colormap pixels &key (result-type 'list))
+  (declare (type colormap colormap)
+	   (type (sequence pixel) pixels)
+	   (type type result-type)
+	   (values (sequence color))))
+
+(defun lookup-color (colormap name)
+  (declare (type colormap colormap)
+	   (type stringable name)
+	   (values screen-color true-color)))
+
+(defun create-cursor (&key source mask x y foreground background)
+  (declare (type pixmap source)
+	   (type (or null pixmap) mask)
+	   (type card16 x y)
+	   (type color foreground background)
+	   (values cursor)))
+
+(defun create-glyph-cursor (&key source-font source-char mask-font mask-char
+				 foreground background)
+  (declare (type font source-font)
+	   (type card16 source-char)
+	   (type (or null font) mask-font)
+	   (type (or null card16) mask-char)
+	   (type color foreground background)
+	   (values cursor)))
+
+(defun free-cursor (cursor)
+  (declare (type cursor cursor)))
+
+(defun recolor-cursor (cursor foreground background)
+  (declare (type cursor cursor)
+	   (type color foreground background)))
+
+(defun query-best-cursor (width height drawable)
+  (declare (type card16 width height)
+	   (type drawable display)
+	   (values width height)))
+
+(defun query-best-tile (width height drawable)
+  (declare (type card16 width height)
+	   (type drawable drawable)
+	   (values width height)))
+
+(defun query-best-stipple (width height drawable)
+  (declare (type card16 width height)
+	   (type drawable drawable)
+	   (values width height)))
+
+(defun query-extension (display name)
+  (declare (type display display)
+	   (type stringable name)
+	   (values major-opcode first-event first-error)))
+
+(defun list-extensions (display &key (result-type 'list))
+  (declare (type display display)
+	   (type type result-type)
+	   (values (sequence string))))
+
+;; Should pointer-mapping setf be changed to set-pointer-mapping?
+
+(defun set-modifier-mapping (display &key shift lock control mod1 mod2 mod3 mod4 mod5)
+  ;; Can signal device-busy.
+  ;; Setf ought to allow multiple values.
+  ;; Returns true for success, nil for failure
+  (declare (type display display)
+	   (type (sequence card8) shift lock control mod1 mod2 mod3 mod4 mod5)
+	   (values (member :success :busy :failed))))
+
+(defun modifier-mapping (display)
+  ;; each value is a list of card8s
+  (declare (type display display)
+	   (values shift lock control mod1 mod2 mod3 mod4 mod5)))
+
+;; Either we will want lots of defconstants for well-known values, or perhaps
+;; an integer-to-keyword translation function for well-known values.
+
+(defun change-keyboard-mapping (display keysyms
+				&key (start 0) end (first-keycode start))
+  ;; start/end give subrange of keysyms
+  ;; first-keycode is the first-keycode to store at
+  (declare (type display display)
+	   (type (array * (* *)) keysyms)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type card8 first-keycode)))
+
+(defun keyboard-mapping (display &key first-keycode start end data)
+  ;; First-keycode specifies which keycode to start at (defaults to
+  ;; min-keycode).  Start specifies where (in result) to put first-keycode
+  ;; (defaults to first-keycode).  (- end start) is the number of keycodes to
+  ;; get (end defaults to (1+ max-keycode)).  If data is specified, the results
+  ;; are put there.
+  (declare (type display display)
+	   (type (or null card8) first-keycode)
+	   (type (or null array-index) start end)
+	   (type (or null (array * (* *))) data)
+	   (values (array * (* *)))))
+
+(defun change-keyboard-control (display &key key-click-percent
+				bell-percent bell-pitch bell-duration
+				led led-mode key auto-repeat-mode)
+  (declare (type display display)
+	   (type (or null (member :default) int16) key-click-percent
+						   bell-percent bell-pitch bell-duration)
+	   (type (or null card8) led key)
+	   (type (or null (member :on :off)) led-mode)
+	   (type (or null (member :on :off :default)) auto-repeat-mode)))
+
+(defun keyboard-control (display)
+  (declare (type display display)
+	   (values key-click-percent bell-percent bell-pitch bell-duration
+		   led-mask global-auto-repeat auto-repeats)))
+
+(defun bell (display &optional (percent-from-normal 0))
+  ;; It is assumed that an eventual audio extension to X will provide more complete
+  ;; control.
+  (declare (type display display)
+	   (type int8 percent-from-normal)))
+
+(defun pointer-mapping (display &key (result-type 'list))
+  (declare (type display display)
+	   (type type result-type)
+	   (values (sequence card8))))
+
+(defsetf pointer-mapping (display) (map)
+  ;; Can signal device-busy.
+  (declare (type display display)
+	   (type (sequence card8) map)))
+
+(defun change-pointer-control (display &key acceleration threshold)
+  ;; Acceleration is rationalized if necessary.
+  (declare (type display display)
+	   (type (or null (member :default) number) acceleration)
+	   (type (or null (member :default) integer) threshold)))
+
+(defun pointer-control (display)
+  (declare (type display display)
+	   (values acceleration threshold)))
+
+(defun set-screen-saver (display timeout interval blanking exposures)
+  ;; Setf ought to allow multiple values.
+  ;; Timeout and interval are in seconds, will be rounded to minutes.
+  (declare (type display display)
+	   (type (or (member :default) int16) timeout interval)
+	   (type (member :on :off :default) blanking exposures)))
+
+(defun screen-saver (display)
+  ;; Returns timeout and interval in seconds.
+  (declare (type display display)
+	   (values timeout interval blanking exposures)))
+
+(defun activate-screen-saver (display)
+  (declare (type display display)))
+
+(defun reset-screen-saver (display)
+  (declare (type display display)))
+
+(defun add-access-host (display host)
+  ;; A string must be acceptable as a host, but otherwise the possible types for host
+  ;; are not constrained, and will likely be very system dependent.
+  (declare (type display display)))
+
+(defun remove-access-host (display host)
+  ;; A string must be acceptable as a host, but otherwise the possible types for host
+  ;; are not constrained, and will likely be very system dependent.
+  (declare (type display display)))
+
+(defun access-hosts (display &key (result-type 'list))
+  ;; The type of host objects returned is not constrained, except that the hosts must
+  ;; be acceptable to add-access-host and remove-access-host.
+  (declare (type display display)
+	   (type type result-type)
+	   (values (sequence host) enabled-p)))
+
+(defun access-control (display)
+  ;; setf'able
+  (declare (type display display)
+	   (values boolean)))
+
+(defun close-down-mode (display)
+  ;; setf'able
+  ;; Cached locally in display object.
+  (declare (type display display)
+	   (values (member :destroy :retain-permanent :retain-temporary))))
+
+(defun kill-client (display resource-id)
+  (declare (type display display)
+	   (type resource-id resource-id)))
+
+(defun kill-temporary-clients (display)
+  (declare (type display display)))
+
+(defun make-event-mask (&rest keys)
+  ;; This is only defined for core events.
+  ;; Useful for constructing event-mask, pointer-event-mask, device-event-mask.
+  (declare (type (list event-mask-class) keys)
+	   (values mask32)))
+
+(defun make-event-keys (event-mask)
+  ;; This is only defined for core events.
+  (declare (type mask32 event-mask)
+	   (values (list event-mask-class))))
+
+(defun make-state-mask (&rest keys)
+  ;; Useful for constructing modifier-mask, state-mask.
+  (declare (type (list state-mask-key) keys)
+	   (values mask16)))
+
+(defun make-state-keys (state-mask)
+  (declare (type mask16 mask)
+	   (values (list state-mask-key))))
+
+(defmacro with-event-queue ((display) &body body)
+  ;; Grants exclusive access to event queue.
+  )
+
+(defun event-listen (display &optional (timeout 0))
+  (declare (type display display)
+	   (type (or null number) timeout)
+	   (values (or null number) (or null (member :timeout) (not null))))
+  ;; Returns the number of events queued locally, if any, else nil.  Hangs
+  ;; waiting for events, forever if timeout is nil, else for the specified
+  ;; number of seconds.  The second value returned is :timeout if the
+  ;; operation timed out, and some other non-nil value if an EOF has been
+  ;; detected.
+  )
+
+(defun process-event (display &key handler timeout peek-p discard-p (force-output-p t))
+  ;; If force-output-p is true, first invokes display-force-output.  Invokes
+  ;; handler on each queued event until handler returns non-nil, and that
+  ;; returned object is then returned by process-event.  If peek-p is true,
+  ;; then the event is not removed from the queue.  If discard-p is true, then
+  ;; events for which handler returns nil are removed from the queue,
+  ;; otherwise they are left in place.  Hangs until non-nil is generated for
+  ;; some event, or for the specified timeout (in seconds, if given); however,
+  ;; it is acceptable for an implementation to wait only once on network data,
+  ;; and therefore timeout prematurely.  Returns nil on timeout or EOF, with a
+  ;; second return value being :timeout for a timeout and some other non-nil
+  ;; value for EOF.  If handler is a sequence, it is expected to contain
+  ;; handler functions specific to each event class; the event code is used to
+  ;; index the sequence, fetching the appropriate handler.  The arguments to
+  ;; the handler are described further below using declare-event.  If
+  ;; process-event is invoked recursively, the nested invocation begins with
+  ;; the event after the one currently being processed.
+  (declare (type display display)
+	   (type (or (sequence (function (&rest key-vals) t))
+		     (function (&rest key-vals) t))
+		 handler)
+	   (type (or null number) timeout)
+	   (type boolean peek-p)))
+
+(defun make-event-handlers (&key (type 'array) default)
+  (declare (type t type)			;Sequence type specifier
+	   (type function default)
+	   (values sequence))			;Default handler for initial content
+  ;; Makes a handler sequence suitable for process-event
+  )
+   
+(defun event-handler (handlers event-key)
+  (declare (type sequence handlers)
+	   (type event-key event-key)
+	   (values function))
+  ;; Accessor for a handler sequence
+  )
+
+(defsetf event-handler (handlers event-key) (handler)
+  (declare (type sequence handlers)
+	   (type event-key event-key)
+	   (type function handler)
+	   (values function))
+  ;; Setf accessor for a handler sequence
+  )
+
+(defmacro event-case ((display &key timeout peek-p discard-p (force-output-p t))
+		      &body clauses)
+  (declare (arglist (display &key timeout peek-p discard-p force-output-p)
+		    (event-or-events ((&rest args) |...|) &body body) |...|))
+  ;; If force-output-p is true, first invokes display-force-output.  Executes
+  ;; the matching clause for each queued event until a clause returns non-nil,
+  ;; and that returned object is then returned by event-case.  If peek-p is
+  ;; true, then the event is not removed from the queue.  If discard-p is
+  ;; true, then events for which the clause returns nil are removed from the
+  ;; queue, otherwise they are left in place.  Hangs until non-nil is
+  ;; generated for some event, or for the specified timeout (in seconds, if
+  ;; given); however, it is acceptable for an implementation to wait only once
+  ;; on network data, and therefore timeout prematurely.  Returns nil on
+  ;; timeout or EOF with a second return value being :timeout for a timeout
+  ;; and some other non-nil value for EOF.  In each clause, event-or-events is
+  ;; an event-key or a list of event-keys (but they need not be typed as
+  ;; keywords) or the symbol t or otherwise (but only in the last clause).
+  ;; The keys are not evaluated, and it is an error for the same key to appear
+  ;; in more than one clause.  Args is the list of event components of
+  ;; interest; corresponding values (if any) are bound to variables with these
+  ;; names (i.e., the args are variable names, not keywords, the keywords are
+  ;; derived from the variable names).  An arg can also be a (keyword var)
+  ;; form, as for keyword args in a lambda lists.  If no t/otherwise clause
+  ;; appears, it is equivalent to having one that returns nil.  If
+  ;; process-event is invoked recursively, the nested invocation begins with
+  ;; the event after the one currently being processed.
+  )
+
+(defmacro event-cond ((display &key timeout peek-p discard-p (force-output-p t))
+		      &body clauses)
+  ;; The clauses of event-cond are of the form:
+  ;; (event-or-events binding-list test-form . body-forms)
+  ;;
+  ;; EVENT-OR-EVENTS	event-key or a list of event-keys (but they
+  ;;			need not be typed as keywords) or the symbol t
+  ;;			or otherwise (but only in the last clause).  If
+  ;;			no t/otherwise clause appears, it is equivalent
+  ;;			to having one that returns nil.  The keys are
+  ;;			not evaluated, and it is an error for the same
+  ;;			key to appear in more than one clause.
+  ;;
+  ;; BINDING-LIST	The list of event components of interest.
+  ;;			corresponding values (if any) are bound to
+  ;;			variables with these names (i.e., the binding-list
+  ;;			has variable names, not keywords, the keywords are
+  ;;			derived from the variable names).  An arg can also
+  ;;			be a (keyword var) form, as for keyword args in a
+  ;;			lambda list.
+  ;;
+  ;; The matching TEST-FORM for each queued event is executed until a
+  ;; clause's test-form returns non-nil.  Then the BODY-FORMS are
+  ;; evaluated, returning the (possibly multiple) values of the last
+  ;; form from event-cond.  If there are no body-forms then, if the
+  ;; test-form is non-nil, the value of the test-form is returned as a
+  ;; single value.
+  ;;
+  ;; Options:
+  ;; FORCE-OUTPUT-P	When true, first invoke display-force-output if no
+  ;;		  	input is pending.
+  ;;
+  ;; PEEK-P		When true, then the event is not removed from the queue.
+  ;;
+  ;; DISCARD-P		When true, then events for which the clause returns nil
+  ;; 			are removed from the queue, otherwise they are left in place.
+  ;;
+  ;; TIMEOUT		If NIL, hang until non-nil is generated for some event's
+  ;;			test-form. Otherwise return NIL after TIMEOUT seconds have
+  ;;			elapsed.  NIL is also returned whenever EOF is read.
+  ;;			Whenever NIL is returned a second value is returned which
+  ;;			is either :TIMEOUT if a timeout occurred or some other
+  ;;			non-NIL value if an EOF is detected.
+  ;;
+  (declare (arglist (display &key timeout peek-p discard-p force-output-p)
+		   (event-or-events (&rest args) test-form &body body) |...|))
+  )
+
+(defun discard-current-event (display)
+  (declare (type display display)
+	   (values boolean))
+  ;; Discard the current event for DISPLAY.
+  ;; Returns NIL when the event queue is empty, else T.
+  ;; To ensure events aren't ignored, application code should only call
+  ;; this when throwing out of event-case or process-next-event, or from
+  ;; inside even-case, event-cond or process-event when :peek-p is T and
+  ;; :discard-p is NIL.
+ )
+
+(defmacro declare-event (event-codes &rest declares)
+  ;; Used to indicate the keyword arguments for handler functions in process-event
+  ;; and event-case.  In the declares, an argument listed as (name1 name2) indicates
+  ;; synonyms for the same argument.  All process-event handlers can have
+  ;; (display display), (event-key event-key), and (boolean send-event-p) as keyword
+  ;; arguments, and an event-case clause can also have event-key and send-event-p as
+  ;; arguments.
+  (declare (arglist event-key-or-keys &rest (type &rest keywords))))
+
+(declare-event (:key-press :key-release :button-press :button-release)
+  (card16 sequence)
+  (window (window event-window) root)
+  ((or null window) child)
+  (boolean same-screen-p)
+  (int16 x y root-x root-y)
+  (card16 state)
+  ((or null card32) time)
+  ;; for key-press and key-release, code is the keycode
+  ;; for button-press and button-release, code is the button number
+  (card8 code))
+
+(declare-event :motion-notify
+  (card16 sequence)
+  (window (window event-window) root)
+  ((or null window) child)
+  (boolean same-screen-p)
+  (int16 x y root-x root-y)
+  (card16 state)
+  ((or null card32) time)
+  (boolean hint-p))
+
+(declare-event (:enter-notify :leave-notify)
+  (card16 sequence)
+  (window (window event-window) root)
+  ((or null window) child)
+  (boolean same-screen-p)
+  (int16 x y root-x root-y)
+  (card16 state)
+  ((or null card32) time)
+  ((member :normal :grab :ungrab) mode)
+  ((member :ancestor :virtual :inferior :nonlinear :nonlinear-virtual) kind)
+  (boolean focus-p))
+
+(declare-event (:focus-in :focus-out)
+  (card16 sequence)
+  (window (window event-window))
+  ((member :normal :while-grabbed :grab :ungrab) mode)
+  ((member :ancestor :virtual :inferior :nonlinear :nonlinear-virtual
+	   :pointer :pointer-root :none)
+   kind))
+
+(declare-event :keymap-notify
+  ((bit-vector 256) keymap))
+
+(declare-event :exposure
+  (card16 sequence)
+  (window (window event-window))
+  (card16 x y width height count))
+
+(declare-event :graphics-exposure
+  (card16 sequence)
+  (drawable (drawable event-window))
+  (card16 x y width height count)
+  (card8 major)
+  (card16 minor))
+
+(declare-event :no-exposure
+  (card16 sequence)
+  (drawable (drawable event-window))
+  (card8 major)
+  (card16 minor))
+
+(declare-event :visibility-notify
+  (card16 sequence)
+  (window (window event-window))
+  ((member :unobscured :partially-obscured :fully-obscured) state))
+
+(declare-event :create-notify
+  (card16 sequence)
+  (window window (parent event-window))
+  (int16 x y)
+  (card16 width height border-width)
+  (boolean override-redirect-p))
+
+(declare-event :destroy-notify
+  (card16 sequence)
+  (window event-window window))
+
+(declare-event :unmap-notify
+  (card16 sequence)
+  (window event-window window)
+  (boolean configure-p))
+
+(declare-event :map-notify
+  (card16 sequence)
+  (window event-window window)
+  (boolean override-redirect-p))
+
+(declare-event :map-request
+  (card16 sequence)
+  (window (parent event-window) window))
+
+(declare-event :reparent-notify
+  (card16 sequence)
+  (window event-window window parent)
+  (int16 x y)
+  (boolean override-redirect-p))
+
+(declare-event :configure-notify
+  (card16 sequence)
+  (window event-window window)
+  (int16 x y)
+  (card16 width height border-width)
+  ((or null window) above-sibling)
+  (boolean override-redirect-p))
+
+(declare-event :gravity-notify
+  (card16 sequence)
+  (window event-window window)
+  (int16 x y))
+
+(declare-event :resize-request
+  (card16 sequence)
+  (window (window event-window))
+  (card16 width height))
+
+(declare-event :configure-request
+  (card16 sequence)
+  (window (parent event-window) window)
+  (int16 x y)
+  (card16 width height border-width)
+  ((member :above :below :top-if :bottom-if :opposite) stack-mode)
+  ((or null window) above-sibling)
+  (mask16 value-mask))
+
+(declare-event :circulate-notify
+  (card16 sequence)
+  (window event-window window)
+  ((member :top :bottom) place))
+
+(declare-event :circulate-request
+  (card16 sequence)
+  (window (parent event-window) window)
+  ((member :top :bottom) place))
+
+(declare-event :property-notify
+  (card16 sequence)
+  (window (window event-window))
+  (keyword atom)
+  ((member :new-value :deleted) state)
+  ((or null card32) time))
+
+(declare-event :selection-clear
+  (card16 sequence)
+  (window (window event-window))
+  (keyword selection)
+  ((or null card32) time))
+
+(declare-event :selection-request
+  (card16 sequence)
+  (window (window event-window) requestor)
+  (keyword selection target)
+  ((or null keyword) property)
+  ((or null card32) time))
+
+(declare-event :selection-notify
+  (card16 sequence)
+  (window (window event-window))
+  (keyword selection target)
+  ((or null keyword) property)
+  ((or null card32) time))
+
+(declare-event :colormap-notify
+  (card16 sequence)
+  (window (window event-window))
+  ((or null colormap) colormap)
+  (boolean new-p installed-p))
+
+(declare-event :mapping-notify
+  (card16 sequence)
+  ((member :modifier :keyboard :pointer) request)
+  (card8 start count))
+
+(declare-event :client-message
+  (card16 sequence)
+  (window (window event-window))
+  ((member 8 16 32) format)
+  ((sequence integer) data))
+
+(defun queue-event (display event-key &rest args &key append-p &allow-other-keys)
+  ;; The event is put at the head of the queue if append-p is nil, else the tail.
+  ;; Additional arguments depend on event-key, and are as specified above with
+  ;; declare-event, except that both resource-ids and resource objects are accepted
+  ;; in the event components.
+  (declare (type display display)
+	   (type event-key event-key)
+	   (type boolean append-p)))
+
+
+
+;;; From here on, there has been less coherent review of the interface:
+
+;;;-----------------------------------------------------------------------------
+;;; Window Manager Property functions
+
+(defun wm-name (window)
+  (declare (type window window)
+	   (values string)))
+
+(defsetf wm-name (window) (name))
+
+(defun wm-icon-name (window)
+  (declare (type window window)
+	   (values string)))
+
+(defsetf wm-icon-name (window) (name))
+
+(defun get-wm-class (window)
+  (declare (type window window)
+	   (values (or null name-string) (or null class-string))))
+
+(defun set-wm-class (window resource-name resource-class)
+  (declare (type window window)
+	   (type (or null stringable) resource-name resource-class)))
+
+(defun wm-command (window)
+  ;; Returns a list whose car is a command string and 
+  ;; whose cdr is the list of argument strings.
+  (declare (type window window)
+	   (values (list string))))
+
+(defsetf wm-command (window) (command)
+  ;; Uses PRIN1 inside the ANSI common lisp form WITH-STANDARD-IO-SYNTAX (or
+  ;; equivalent), with elements of command separated by NULL characters.  This
+  ;; enables 
+  ;;   (with-standard-io-syntax (mapcar #'read-from-string (wm-command window)))
+  ;; to recover a lisp command.
+  (declare (type window window)
+	   (type (list stringable) command)))
+
+(defun wm-client-machine (window)
+  ;; Returns a list whose car is a command string and 
+  ;; whose cdr is the list of argument strings.
+  (declare (type window window)
+	   (values string)))
+
+(defsetf wm-client-machine (window) (string)
+  (declare (type window window)
+	   (type stringable string)))
+
+(defstruct wm-hints
+  (input nil :type (or null (member :off :on)))
+  (initial-state nil :type (or null (member :normal :iconic)))
+  (icon-pixmap nil :type (or null pixmap))
+  (icon-window nil :type (or null window))
+  (icon-x nil :type (or null card16))
+  (icon-y nil :type (or null card16))
+  (icon-mask nil :type (or null pixmap))
+  (window-group nil :type (or null resource-id))
+  (flags 0 :type card32)    ;; Extension-hook.  Exclusive-Or'ed with the FLAGS field
+  ;; may be extended in the future
+  )
+
+(defun wm-hints (window)
+  (declare (type window window)
+	   (values wm-hints)))
+
+(defsetf wm-hints (window) (wm-hints))
+
+
+(defstruct wm-size-hints
+  ;; Defaulted T to put the burden of remembering these on widget programmers.
+  (user-specified-position-p t :type boolean) ;; True when user specified x y
+  (user-specified-size-p t :type boolean)     ;; True when user specified width height
+  (x nil :type (or null int16))		      ;; Obsolete
+  (y nil :type (or null int16))		      ;; Obsolete
+  (width nil :type (or null card16))	      ;; Obsolete
+  (height nil :type (or null card16))	      ;; Obsolete
+  (min-width nil :type (or null card16))
+  (min-height nil :type (or null card16))
+  (max-width nil :type (or null card16))
+  (max-height nil :type (or null card16))
+  (width-inc nil :type (or null card16))
+  (height-inc nil :type (or null card16))
+  (min-aspect nil :type (or null number))
+  (max-aspect nil :type (or null number))
+  (base-width nil :type (or null card16))
+  (base-height nil :type (or null card16))
+  (win-gravity nil :type (or null win-gravity)))
+
+(defun wm-normal-hints (window)
+  (declare (type window window)
+	   (values wm-size-hints)))
+
+(defsetf wm-normal-hints (window) (wm-size-hints))
+
+;; ICON-SIZES uses the SIZE-HINTS structure
+
+(defun icon-sizes (window)
+  (declare (type window window)
+	   (values wm-size-hints)))
+  
+(defsetf icon-sizes (window) (wm-size-hints))
+
+(defun wm-protocols (window)
+  (declare (type window window)
+	   (values protocols)))
+  
+(defsetf wm-protocols (window) (protocols)
+  (declare (type window window)
+	   (type (list keyword) protocols)))
+
+(defun wm-colormap-windows (window)
+  (declare (type window window)
+	   (values windows)))
+  
+(defsetf wm-colormap-windows (window) (windows)
+  (declare (type window window)
+	   (type (list window) windows)))
+
+(defun transient-for (window)
+  (declare (type window window)
+	   (values window)))
+
+(defsetf transient-for (window) (transient)
+  (declare (type window window transient)))
+
+(defun set-wm-properties (window &rest options &key 
+			  name icon-name resource-name resource-class command
+			  hints normal-hints
+			  ;; the following are used for wm-normal-hints
+			  user-specified-position-p user-specified-size-p
+			  program-specified-position-p program-specified-size-p
+			  min-width min-height max-width max-height
+			  width-inc height-inc min-aspect max-aspect
+			  base-width base-height win-gravity
+			  ;; the following are used for wm-hints
+			  input initial-state icon-pixmap icon-window
+			  icon-x icon-y icon-mask window-group)
+  ;; Set properties for WINDOW.
+  (declare (type window window)
+	   (type (or null stringable) name icoin-name resource-name resource-class)
+	   (type (or null list) command)
+	   (type (or null wm-hints) hints)
+	   (type (or null wm-size-hints) normal-hints)
+	   (type boolean user-specified-position-p user-specified-size-p)
+	   (type boolean program-specified-position-p program-specified-size-p)
+	   (type (or null card16) min-width min-height max-width max-height width-inc height-inc base-width base-height win-gravity)
+	   (type (or null number) min-aspect max-aspect)
+	   (type (or null (member :off :on)) input)
+	   (type (or null (member :normal :iconic)) initial-state)
+	   (type (or null pixmap) icon-pixmap icon-mask)
+	   (type (or null window) icon-window)
+	   (type (or null card16) icon-x icon-y)
+	   (type (or null resource-id) window-group)))
+
+(defun iconify-window (window)
+  (declare (type window window)))
+
+(defun withdraw-window (window)
+  (declare (type window window)))
+ 
+(defstruct standard-colormap
+  (colormap nil :type (or null colormap))
+  (base-pixel 0 :type pixel)
+  (max-color nil :type (or null color))
+  (mult-color nil :type (or null color))
+  (visual nil :type (or null visual-info))
+  (kill nil :type (or (member nil :release-by-freeing-colormap)
+		      drawable gcontext cursor colormap font)))
+
+(defun rgb-colormaps (window property)
+  (declare (type window window)
+	   (type (member :rgb_default_map :rgb_best_map :rgb_red_map
+			 :rgb_green_map :rgb_blue_map) property)
+	   (values (list standard-colormap))))
+
+(defsetf rgb-colormaps (window property) (standard-colormaps)
+  (declare (type window window)
+	   (type (member :rgb_default_map :rgb_best_map :rgb_red_map
+			 :rgb_green_map :rgb_blue_map) property)
+	   (type (list standard-colormap) standard-colormaps)))
+
+(defun cut-buffer (display &key (buffer 0) (type :string) (result-type 'string)
+		                (transform #'card8->char) (start 0) end)
+  ;; Return the contents of cut-buffer BUFFER
+  (declare (type display display)
+	   (type (integer 0 7) buffer)
+	   (type xatom type)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type t result-type)			;a sequence type
+	   (type (or null (function (integer) t)) transform)
+	   (values sequence type format bytes-after)))
+
+(defsetf cut-buffer (display buffer &key (type :string) (format 8)
+			     (transform #'char->card8) (start 0) end) (data))
+
+(defun rotate-cut-buffers (display &optional (delta 1) (careful-p t))
+  ;; Positive rotates left, negative rotates right (opposite of actual
+  ;; protocol request).  When careful-p, ensure all cut-buffer
+  ;; properties are defined, to prevent errors.
+  (declare (type display display)
+	   (type int16 delta)
+	   (type boolean careful-p)))
+
+;;;-----------------------------------------------------------------------------
+;;; Keycode mapping
+
+(defun define-keysym-set (set first-keysym last-keysym)
+  ;; Define all keysyms from first-keysym up to and including
+  ;; last-keysym to be in SET (returned from the keysym-set function).
+  ;; Signals an error if the keysym range overlaps an existing set.
+ (declare (type keyword set)
+	  (type keysym first-keysym last-keysym)))
+
+(defun keysym-set (keysym)
+  ;; Return the character code set name of keysym
+  ;; Note that the keyboard set (255) has been broken up into its parts.
+  (declare (type keysym keysym)
+	   (values keyword)))
+
+(defun define-keysym (object keysym &key lowercase translate modifiers mask display)	              
+  ;; Define the translation from keysym/modifiers to a (usually
+  ;; character) object.  ANy previous keysym definition with
+  ;; KEYSYM and MODIFIERS is deleted before adding the new definition.
+  ;;
+  ;; MODIFIERS is either a modifier-mask or list containing intermixed
+  ;; keysyms and state-mask-keys specifying when to use this
+  ;; keysym-translation.  The default is NIL.
+  ;;
+  ;; MASK is either a modifier-mask or list containing intermixed
+  ;; keysyms and state-mask-keys specifying which modifiers to look at
+  ;; (i.e.  modifiers not specified are don't-cares).
+  ;; If mask is :MODIFIERS then the mask is the same as the modifiers
+  ;; (i.e.  modifiers not specified by modifiers are don't cares)
+  ;; The default mask is *default-keysym-translate-mask*
+  ;;
+  ;; If DISPLAY is specified, the translation will be local to DISPLAY,
+  ;; otherwise it will be the default translation for all displays.
+  ;;
+  ;; LOWERCASE is used for uppercase alphabetic keysyms.  The value
+  ;; is the associated lowercase keysym.  This information is used
+  ;; by the keysym-both-case-p predicate (for caps-lock computations)
+  ;; and by the keysym-downcase function.
+  ;;
+  ;; TRANSLATE will be called with parameters (display state OBJECT)
+  ;; when translating KEYSYM and modifiers and mask are satisfied.
+  ;; [e.g (zerop (logxor (logand state (or mask *default-keysym-translate-mask*))
+  ;;                     (or modifiers 0)))
+  ;;      when mask and modifiers aren't lists of keysyms]
+  ;; The default is #'default-keysym-translate
+  ;;
+  (declare (type (or base-char t) object)
+	   (type keysym keysym)
+	   (type (or null mask16 list) ;; (list (or keysym state-mask-key))
+	         modifiers)
+	   (type (or null (member :modifiers) mask16 list) ;; (list (or keysym state-mask-key))
+	         mask)
+	   (type (or null display) display)
+           (type (or null keysym) lowercase)
+	   (type (function (display card16 t) t) translate)))
+
+(defvar *default-keysym-translate-mask*
+	(the (or (member :modifiers) mask16 list)	; (list (or keysym state-mask-key))
+	     (logand #xff (lognot (make-state-mask :lock))))
+  "Default keysym state mask to use during keysym-translation.")
+
+(defun undefine-keysym (object keysym &key display modifiers &allow-other-keys)	              
+  ;; Undefine the keysym-translation translating KEYSYM to OBJECT with MODIFIERS.
+  ;; If DISPLAY is non-nil, undefine the translation for DISPLAY if it exists.
+  (declare (type (or base-char t) object)
+	   (type keysym keysym)
+	   (type (or null mask16 list) ;; (list (or keysym state-mask-key))
+	         modifiers)
+	   (type (or null display) display)))
+
+(defun default-keysym-translate (display state object)
+  ;; If object is a character, char-bits are set from state.
+  ;; If object is a list, it is an alist with entries:
+  ;; (base-char [modifiers] [mask-modifiers)
+  ;; When MODIFIERS are specified, this character translation
+  ;; will only take effect when the specified modifiers are pressed.
+  ;; MASK-MODIFIERS can be used to specify a set of modifiers to ignore.
+  ;; When MASK-MODIFIERS is missing, all other modifiers are ignored.
+  ;; In ambiguous cases, the most specific translation is used.
+  (declare (type display display)
+	   (type card16 state)
+	   (type t object)
+	   (values t))) ;; Object returned by keycode->character
+   
+(defmacro keysym (keysym &rest bytes)
+  ;; Build a keysym.
+  ;; If KEYSYM is an integer, it is used as the most significant bits of
+  ;; the keysym, and BYTES are used to specify low order bytes. The last
+  ;; parameter is always byte4 of the keysym.  If KEYSYM is not an
+  ;; integer, the keysym associated with KEYSYM is returned.
+  ;;
+  ;; This is a macro and not a function macro to promote compile-time
+  ;; lookup. All arguments are evaluated.
+  (declare (type t keysym)
+	   (type (list card8) bytes)
+	   (values keysym)))
+
+(defun character->keysyms (character &optional display)
+  ;; Given a character, return a list of all matching keysyms.
+  ;; If DISPLAY is given, translations specific to DISPLAY are used,
+  ;; otherwise only global translations are used.
+  ;; Implementation dependent function.
+  ;; May be slow [i.e. do a linear search over all known keysyms]
+  (declare (type t character)
+	   (type (or null display) display)
+	   (values (list keysym))))
+
+(defun keycode->keysym (display keycode keysym-index)
+  (declare (type display display)
+	   (type card8 code)
+	   (type card16 state)
+	   (type card8 keysym-index)
+	   (values keysym)))
+
+(defun keysym->keycodes (display keysym)
+  ;; Return keycodes for keysym, as multiple values
+  (declare (type display display)
+	   (type keysym keysym)
+	   (values (or null keycode) (or null keycode) (or null keycode)))
+  )
+
+(defun keysym->character (display keysym &optional state)
+  ;; Find the character associated with a keysym.
+  ;; STATE is used for adding char-bits to character as follows:
+  ;;    control -> char-control-bit
+  ;;    mod-1 -> char-meta-bit
+  ;;    mod-2 -> char-super-bit
+  ;;    mod-3 -> char-hyper-bit
+  ;; Implementation dependent function.
+  (declare (type display display)
+	   (type keysym keysym)
+	   (type (or null card16) state)
+	   (values (or null character))))
+
+(defun keycode->character (display keycode state &key keysym-index
+	                   (keysym-index-function #'default-keysym-index))
+  ;; keysym-index defaults to the result of keysym-index-function which
+  ;; is called with the following parameters:
+  ;; (char0 state caps-lock-p keysyms-per-keycode)
+  ;; where char0 is the "character" object associated with keysym-index 0 and
+  ;; caps-lock-p is non-nil when the keysym associated with the lock
+  ;; modifier is for caps-lock.
+  ;; STATE is also used for setting char-bits:
+  ;;    control -> char-control-bit
+  ;;    mod-1 -> char-meta-bit
+  ;;    mod-2 -> char-super-bit
+  ;;    mod-3 -> char-hyper-bit
+  ;; Implementation dependent function.
+  (declare (type display display)
+	   (type card8 keycode)
+	   (type card16 state)
+	   (type (or null card8) keysym-index)
+	   (type (or null (function (char0 state caps-lock-p keysyms-per-keycode) card8))
+		 keysym-index-function)
+	   (values (or null character))))
+
+(defun default-keysym-index (display keycode state)
+  ;; Returns a keysym-index for use with keycode->character
+  (declare (values card8))
+)
+
+;;; default-keysym-index implements the following tables:
+;;;
+;;; control shift caps-lock character               character
+;;;   0       0       0       #\a                      #\8
+;;;   0       0       1       #\A                      #\8
+;;;   0       1       0       #\A                      #\*
+;;;   0       1       1       #\A                      #\*
+;;;   1       0       0       #\control-A              #\control-8
+;;;   1       0       1       #\control-A              #\control-8
+;;;   1       1       0       #\control-shift-a        #\control-*
+;;;   1       1       1       #\control-shift-a        #\control-*
+;;;
+;;; control shift shift-lock character               character
+;;;   0       0       0       #\a                      #\8
+;;;   0       0       1       #\A                      #\*
+;;;   0       1       0       #\A                      #\*
+;;;   0       1       1       #\A                      #\8
+;;;   1       0       0       #\control-A              #\control-8
+;;;   1       0       1       #\control-A              #\control-*
+;;;   1       1       0       #\control-shift-a        #\control-*
+;;;   1       1       1       #\control-shift-a        #\control-8
+
+(defun state-keysymp (display state keysym)
+  ;; Returns T when a modifier key associated with KEYSYM is on in STATE
+  (declare (type display display)
+	   (type card16 state)
+	   (type keysym keysym)
+	   (values boolean)))
+
+(defun mapping-notify (display request start count)
+  ;; Called on a mapping-notify event to update
+  ;; the keyboard-mapping cache in DISPLAY
+  (declare (type display display)
+	   (type (member :modifier :keyboard :pointer) request)
+	   (type card8 start count)))
+
+(defun keysym-in-map-p (display keysym keymap)
+  ;; Returns T if keysym is found in keymap
+  (declare (type display display)
+	   (type keysym keysym)
+	   (type (bit-vector 256) keymap)
+	   (value boolean)))
+
+(defun character-in-map-p (display character keymap)
+  ;; Implementation dependent function.
+  ;; Returns T if character is found in keymap
+  (declare (type display display)
+	   (type t character)
+	   (type (bit-vector 256) keymap)
+	   (value boolean)))
+
+;;;-----------------------------------------------------------------------------
+;;; Extensions
+
+(defmacro define-extension (name &key events errors)
+  ;; Define extension NAME with EVENTS and ERRORS.
+  ;; Note: The case of NAME is important.
+  ;; To define the request, Use:
+  ;;     (with-buffer-request (display (extension-opcode ,name)) ,@body)
+  ;;     See the REQUESTS file for lots of examples.
+  ;; To define event handlers, use declare-event.
+  ;; To define error handlers, use declare-error and define-condition.
+  (declare (type stringable name)
+	   (type (list symbol) events errors)))
+
+(defmacro extension-opcode (display name)
+  ;; Returns the major opcode for extension NAME.
+  ;; This is a macro to enable NAME to be interned for fast run-time
+  ;; retrieval. 
+  ;; Note: The case of NAME is important.
+  (declare (type display display)
+	   (type stringable name)
+	   (values card8)))
+
+(defmacro define-error (error-key function)
+  ;; Associate a function with ERROR-KEY which will be called with
+  ;; parameters DISPLAY and REPLY-BUFFER and returns a plist of
+  ;; keyword/value pairs which will be passed on to the error handler.
+  ;; A compiler warning is printed when ERROR-KEY is not defined in a
+  ;; preceding DEFINE-EXTENSION.
+  ;; Note: REPLY-BUFFER may used with the READING-EVENT and READ-type
+  ;;       macros for getting error fields. See DECODE-CORE-ERROR for
+  ;        an example.
+  (declare (type symbol error-key)
+	   (type function function)))
+
+;; All core errors use this, so we make it available to extensions.
+(defun decode-core-error (display event &optional arg)
+  ;; All core errors have the following keyword/argument pairs:
+  ;;    :major integer
+  ;;    :minor integer
+  ;;    :sequence integer
+  ;;    :current-sequence integer
+  ;; In addition, many have an additional argument that comes from the
+  ;; same place in the event, but is named differently.  When the ARG
+  ;; argument is specified, the keyword ARG with card32 value starting
+  ;; at byte 4 of the event is returned with the other keyword/argument
+  ;; pairs.
+  (declare (type display display)
+	   (type reply-buffer event)
+	   (type (or null keyword) arg)
+	   (values keyword/arg-plist)))
+
+;; This isn't new, just extended.
+(defmacro declare-event (event-codes &body declares)
+  ;; Used to indicate the keyword arguments for handler functions in
+  ;; process-event and event-case.
+  ;; Generates functions used in SEND-EVENT.
+  ;; A compiler warning is printed when all of EVENT-CODES are not
+  ;; defined by a preceding DEFINE-EXTENSION.
+  ;; See the INPUT file for lots of examples.
+  (declare (type (or keyword (list keywords)) event-codes)
+	   (type (alist (field-type symbol) (field-names (list symbol)))
+                 declares)))
+
+(defmacro define-gcontext-accessor (name &key default set-function copy-function)
+  ;; This will define a new gcontext accessor called NAME.
+  ;; Defines the gcontext-NAME accessor function and its defsetf.
+  ;; Gcontext's will cache DEFAULT-VALUE and the last value SETF'ed when
+  ;; gcontext-cache-p is true.  The NAME keyword will be allowed in
+  ;; CREATE-GCONTEXT, WITH-GCONTEXT, and COPY-GCONTEXT-COMPONENTS.
+  ;; SET-FUNCTION will be called with parameters (GCONTEXT NEW-VALUE)
+  ;; from create-gcontext, and force-gcontext-changes.
+  ;; COPY-FUNCTION will be called with parameters (src-gc dst-gc src-value)
+  ;; from copy-gcontext and copy-gcontext-components.
+  ;; The copy-function defaults to:
+  ;; (lambda (ignore dst-gc value)
+  ;;    (if value
+  ;;	    (,set-function dst-gc value)
+  ;;	  (error "Can't copy unknown GContext component ~a" ',name)))
+  (declare (type symbol name)
+	   (type t default)
+	   (type (function (gcontext t) t) set-function) ;; required
+	   (type (or null (function (gcontext gcontext t) t))
+		 copy-function)))
+
+
+;; To aid extension implementors in attaching additional information to
+;; clx data structures, the following accessors (with SETF's) are
+;; defined.  GETF can be used on these to extend the structures.
+
+display-plist
+screen-plist
+visual-info-plist
+gcontext-plist
+font-plist
+drawable-plist
+
+
+
+;;; These have had perhaps even less review.
+
+;;; Add some of the functionality provided by the C XLIB library.
+;;;
+;;; LaMott G. Oren, Texas Instruments  10/87
+;;; 
+;;; Design Contributors:
+;;;	Robert W. Scheifler, MIT
+
+;;;-----------------------------------------------------------------------------
+;;; Regions (not yet implemented)
+
+;;; Regions are arbitrary collections of pixels.  This is represented
+;;; in the region structure as either a list of rectangles or a bitmap.
+
+(defun make-region (&optional x y width height)
+  ;; With no parameters, returns an empty region
+  ;; If some parameters are given, all must be given.
+  (declare (type (or null int16) x y width height)
+	   (values region)))
+
+(defun region-p (thing))
+
+(defun copy-region (region))
+
+(defun region-empty-p (region)
+  (declare (type region region)
+	   (values boolean)))
+
+(defun region-clip-box (region)
+  ;; Returns a region which is the smallest enclosing rectangle
+  ;; enclosing REGION
+  (declare (type region region)
+	   (values region)))
+
+;; Accessors that return the boundaries of a region
+(defun region-x (region))
+(defun region-y (region))
+(defun region-width (region))
+(defun region-height (region))
+
+(defsetf region-x (region) (x))
+(defsetf region-y (region) (y))
+;; Setting a region's X/Y translates the region
+
+(defun region-intersection (&rest regions)
+  "Returns a region which is the intersection of one or more REGIONS.
+Returns an empty region if the intersection is empty.
+If there are no regions given, return a very large region."
+  (declare (type (list region) regions)
+	   (values region)))
+
+(defun region-union (&rest regions)
+  "Returns a region which is the union of a number of REGIONS
+ (i.e. the smallest region that can contain all the other regions)
+ Returns the empty region if no regions are given."
+  (declare (type (list region) regions)
+	   (values region)))
+
+(defun region-subtract (region subtract)
+  "Returns a region containing the points that are in REGION but not in SUBTRACT"
+  (declare (type region region subtract)
+	   (values region)))
+
+(defun point-in-region-p (region x y)
+  ;; Returns T when X/Y are a point within REGION.
+  (declare (type region region)
+	   (type int16 x y)
+	   (values boolean)))
+
+(defun region-equal (a b)
+  ;; Returns T when regions a and b contain the same points.
+  ;; That is, return t when for every X/Y (point-in-region-p a x y)
+  ;; equals (point-in-region-p b x y)
+  (declare (type region a b)
+	   (values boolean)))
+
+(defun subregion-p (large small)
+  "Returns T if SMALL is within LARGE.
+ That is, return T when for every X/Y (point-in-region-p small X Y)
+ implies (point-in-region-p large X Y)."
+  (declare (type region large small)
+	   (values boolean)))
+
+(defun region-intersect-p (a b)
+  "Returns T if A intersects B.
+ That is, return T when there is some point common to regions A and B."
+  (declare (type region a b)
+	   (values boolean)))
+
+(defun map-region (region function &rest args)
+  ;; Calls function with arguments (x y . args) for every point in REGION.
+  (declare (type region region)
+	   (type (function x y &rest args) function)))
+
+;;   Why isn't it better to augment
+;;   gcontext-clip-mask to deal with
+;;   	(or null (member :none) pixmap rect-seq region)
+;;   and force conversions on the caller?
+;; Good idea.
+
+;;(defun gcontext-clip-region (gcontext)
+;;  ;; If the clip-mask of GCONTEXT is known, return it as a region.
+;;  (declare (type gcontext gcontext)
+;;	   (values (or null region))))
+
+;;(defsetf gcontext-clip-region (gcontext) (region)
+;;  ;; Set the clip-rectangles or clip-mask for for GCONTEXT to include
+;;  ;; only the pixels within REGION.
+;;  (declare (type gcontext gcontext)
+;;	   (type region region)))
+
+(defun image->region (image)
+  ;; Returns a region containing the 1 bits of a depth-1 image
+  ;; Signals an error if image isn't of depth 1.
+  (declare (type image image)
+	   (values region)))
+
+(defun region->image (region)
+  ;; Returns a depth-1 image containg 1 bits for every pixel in REGION.
+  (declare (type region region)
+	   (values image)))
+
+(defun polygon-region (points &optional (fill-rule :even-odd))
+  (declare (type sequence points) ;(repeat-seq (integer x) (integer y))
+	   (type (member :even-odd :winding) fill-rule)
+	   (values region)))
+
+;;;-----------------------------------------------------------------------------
+;;; IMAGE functions
+
+
+(deftype bitmap () '(array bit (* *)))
+(deftype pixarray () '(array pixel (* *)))
+
+(defconstant *lisp-byte-lsb-first-p* #+lispm t #-lispm nil
+	     "Byte order in pixel arrays")
+
+(defstruct image
+  ;; Public structure
+  (width 0 :type card16 :read-only t)
+  (height 0 :type card16 :read-only t)
+  (depth 1 :type card8 :read-only t)
+  (plist nil :type list))
+
+;; Image-Plist accessors:
+(defun image-name (image))
+(defun image-x-hot (image))
+(defun image-y-hot (image))
+(defun image-red-mask (image))
+(defun image-blue-mask (image))
+(defun image-green-mask (image))
+
+(defsetf image-name (image) (name))
+(defsetf image-x-hot (image) (x))
+(defsetf image-y-hot (image) (y))
+(defsetf image-red-mask (image) (mask))
+(defsetf image-blue-mask (image) (mask))
+(defsetf image-green-mask (image) (mask))
+
+(defstruct (image-x (:include image))
+  ;; Use this format for shoveling image data
+  ;; Private structure. Accessors for these NOT exported.
+  (format :z-pixmap :type (member :bitmap :xy-pixmap :z-pixmap))
+  (bytes-per-line 0 :type card16)
+  (scanline-pad 32 :type (member 8 16 32))
+  (bits-per-pixel 0 :type (member 1 4 8 16 24 32))
+  (bit-lsb-first-p nil :type boolean)		; Bit order
+  (byte-lsb-first-p nil :type boolean)		; Byte order
+  (data #() :type (array card8 (*))))		; row-major
+
+(defstruct (image-xy (:include image))
+  ;; Public structure
+  ;; Use this format for image processing
+  (bitmap-list nil :type (list bitmap)))
+
+(defstruct (image-z (:include image))
+  ;; Public structure
+  ;; Use this format for image processing
+  (bits-per-pixel 0 :type (member 1 4 8 16 24 32))
+  (pixarray #() :type pixarray))
+
+(defun create-image (&key (width (required-arg width))
+		          (height (required-arg height))
+		     depth data plist name x-hot y-hot
+		     red-mask blue-mask green-mask
+		     bits-per-pixel format scanline-pad bytes-per-line
+		     byte-lsb-first-p bit-lsb-first-p )
+  ;; Returns an image-x image-xy or image-z structure, depending on the
+  ;; type of the :DATA parameter.
+  (declare
+    (type card16 width height)			; Required
+    (type (or null card8) depth)		; Defualts to 1
+    (type (or (array card8 (*))			;Returns image-x
+	      (list bitmap)			;Returns image-xy
+	      pixarray) data)			;Returns image-z
+    (type list plist)
+    (type (or null stringable) name)
+    (type (or null card16) x-hot y-hot)
+    (type (or null pixel) red-mask blue-mask green-mask)
+    (type (or null (member 1 4 8 16 24 32)) bits-per-pixel)
+
+    ;; The following parameters are ignored for image-xy and image-z:
+    (type (or null (member :bitmap :xy-pixmap :z-pixmap))
+	  format)				; defaults to :z-pixmap
+    (type (or null (member 8 16 32)) scanline-pad)
+    (type (or null card16) bytes-per-line) ;default from width and scanline-pad
+    (type boolean byte-lsb-first-p bit-lsb-first-p)
+    (values image)))
+
+(defun get-image (drawable &key 
+		  (x (required-arg x))
+		  (y (required-arg y))
+		  (width (required-arg width))
+		  (height (required-arg height))
+		  plane-mask format result-type)
+  ;; Get an image from the server.
+  ;; Format defaults to :z-pixmap.  Result-Type defaults from Format,
+  ;; image-z for :z-pixmap, and image-xy for :xy-pixmap.
+  ;; Plane-mask defaults to #xFFFFFFFF.
+  ;; Returns an image-x image-xy or image-z structure, depending on the
+  ;; result-type parameter.
+  (declare (type drawable drawable)
+	   (type int16 x y) ;; required
+	   (type card16 width height) ;; required
+	   (type (or null pixel) plane-mask)
+	   (type (or null (member :xy-pixmap :z-pixmap)) format)
+	   (type (or null (member image-x image-xy image-z)) result-type)
+	   (values image)))
+
+(defun put-image (drawable gcontext image &key
+		  (src-x 0) (src-y 0)
+		  (x (required-arg x))
+		  (y (required-arg y))
+		  width height
+		  bitmap-p)
+  ;; When BITMAP-P, force format to be :bitmap when depth=1
+  ;; This causes gcontext to supply foreground & background pixels.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type image image)
+	   (type int16 x y) ;; required
+	   (type (or null card16) width height)
+	   (type boolean bitmap-p)))
+
+(defun copy-image (image &key (x 0) (y 0) width height result-type)
+  ;; Copy with optional sub-imaging and format conversion.
+  ;; result-type defaults to (type-of image)
+  (declare (type image image)
+	   (type card16 x y)
+	   (type (or null card16) width height) ;; Default from image
+	   (type (or null (member image-x image-xy image-z)) result-type)
+	   (values image)))
+
+(defun read-bitmap-file (pathname)
+  ;; Creates an image from a C include file in standard X11 format
+  (declare (type (or pathname string stream) pathname)
+	   (values image)))
+
+(defun write-bitmap-file (pathname image &optional name)
+  ;; Writes an image to a C include file in standard X11 format
+  ;; NAME argument used for variable prefixes.  Defaults to "image"
+  (declare (type (or pathname string stream) pathname)
+	   (type image image)
+	   (type (or null stringable) name)))
+
+;;;-----------------------------------------------------------------------------
+;;; Resource data-base
+
+
+(defun make-resource-database ()
+  ;; Returns an empty resource data-base
+  (declare (values resource-database)))
+
+(defun get-resource (database value-name value-class full-name full-class)
+  ;; Return the value of the resource in DATABASE whose partial name
+  ;; most closely matches (append full-name (list value-name)) and
+  ;;                      (append full-class (list value-class)).
+  (declare (type resource-database database)
+	   (type stringable value-name value-class)
+	   (type (list stringable) full-name full-class)
+	   (values value)))
+
+(defun add-resource (database name-list value)
+  ;; name-list is a list of either strings or symbols. If a symbol, 
+  ;; case-insensitive comparisons will be used, if a string,
+  ;; case-sensitive comparisons will be used.  The symbol '* or
+  ;; string "*" are used as wildcards, matching anything or nothing.
+  (declare (type resource-database database)
+	   (type (list stringable) name-list)
+	   (type t value)))
+
+(defun delete-resource (database name-list)
+  (declare (type resource-database database)
+	   (type (list stringable) name-list)))
+
+(defun map-resource (database function &rest args)
+  ;; Call FUNCTION on each resource in DATABASE.
+  ;; FUNCTION is called with arguments (name-list value . args)
+  (declare (type resource-database database)
+	   (type (function ((list stringable) t &rest t) t) function)
+	   (values nil)))
+
+(defun merge-resources (database with-database)
+  (declare (type resource-database database with-database)
+	   (values resource-database))
+  (map-resource #'add-resource database with-database)
+  with-database)
+
+;; Note: with-input-from-string can be used with read-resources to define
+;;       default resources in a program file.
+
+(defun read-resources (database pathname &key key test test-not)
+  ;; Merges resources from a file in standard X11 format with DATABASE.
+  ;; KEY is a function used for converting value-strings, the default is
+  ;; identity.  TEST and TEST-NOT are predicates used for filtering
+  ;; which resources to include in the database.  They are called with
+  ;; the name and results of the KEY function.
+  (declare (type resource-database database)
+	   (type (or pathname string stream) pathname)
+	   (type (or null (function (string) t)) key)
+	   (type (or null (function ((list string) t) boolean))
+                 test test-not)
+	   (values resource-database)))
+
+(defun write-resources (database pathname &key write test test-not)
+  ;; Write resources to PATHNAME in the standard X11 format.
+  ;; WRITE is a function used for writing values, the default is #'princ
+  ;; TEST and TEST-NOT are predicates used for filtering which resources
+  ;; to include in the database.  They are called with the name and value.
+  (declare (type resource-database database)
+	   (type (or pathname string stream) pathname)
+	   (type (or null (function (string stream) t)) write)
+	   (type (or null (function ((list string) t) boolean))
+                 test test-not)))
+
+(defun root-resources (screen &key database key test test-not)
+  "Returns a resource database containing the contents of the root window
+   RESOURCE_MANAGER property for the given SCREEN. If SCREEN is a display,
+   then its default screen is used. If an existing DATABASE is given, then
+   resource values are merged with the DATABASE and the modified DATABASE is
+   returned.
+
+   TEST and TEST-NOT are predicates for selecting which resources are
+   read.  Arguments are a resource name list and a resource value. The KEY
+   function, if given, is called to convert a resource value string to the
+   value given to TEST or TEST-NOT."
+
+  (declare (type (or screen display) screen)
+	   (type (or null resource-database) database)
+	   (type (or null (function (string) t)) key)
+	   (type (or null (function (list t) boolean)) test test-not)
+	   (values resource-database)))
+
+(defsetf root-resources (screen &key test test-not (write 'princ)) (database)
+  "Changes the contents of the root window RESOURCE_MANAGER property for the
+   given SCREEN. If SCREEN is a display, then its default screen is used. 
+
+   TEST and TEST-NOT are predicates for selecting which resources from the
+   DATABASE are written.  Arguments are a resource name list and a resource
+   value.  The WRITE function is used to convert a resource value into a
+   string stored in the property."
+
+  (declare (type (or screen display) screen)
+	(type (or null resource-database) database)
+	(type (or null (function (list t) boolean)) test test-not)
+	(type (or null (function (string stream) t)) write)
+	(values resource-database)))
+
+;;;-----------------------------------------------------------------------------
+;;; Shared GContext's
+
+(defmacro using-gcontext ((var &rest options &key drawable
+			       function plane-mask foreground background
+			       line-width line-style cap-style
+			       join-style fill-style fill-rule arc-mode
+			       tile stipple ts-x ts-y font
+			       subwindow-mode exposures clip-x clip-y
+			       clip-mask clip-ordering dash-offset
+			       dashes)
+			  &body body)
+  ;; Equivalent to (let ((var (apply #'make-gcontext options))) ,@body)
+  ;; but more efficient because it uses a gcontext cache associated with
+  ;; drawable's display.
+  )
+
+
+
+ X11 Request Name       CLX Function Name
+-----------------       -----------------
+AllocColor              ALLOC-COLOR
+AllocColorCells         ALLOC-COLOR-CELLS
+AllocColorPlanes        ALLOC-COLOR-PLANES
+AllocNamedColor         ALLOC-COLOR
+AllowEvents             ALLOW-EVENTS
+Bell                    BELL
+ChangeAccessControl     (setf (ACCESS-CONTROL display) boolean)
+ChangeActivePointerGrab CHANGE-ACTIVE-POINTER-GRAB
+ChangeCloseDownMode     (setf (CLOSE-DOWN-MODE display) mode)
+ChangeGC                FORCE-GCONTEXT-CHANGES
+     ;; See WITH-GCONTEXT
+     (setf (gcontext-function gc) boole-constant)
+     (setf (gcontext-plane-mask gc) card32)
+     (setf (gcontext-foreground gc) card32)
+     (setf (gcontext-background gc) card32)
+     (setf (gcontext-line-width gc) card16)
+     (setf (gcontext-line-style gc) keyword)
+     (setf (gcontext-cap-style gc) keyword)
+     (setf (gcontext-join-style gc) keyword)
+     (setf (gcontext-fill-style gc) keyword)
+     (setf (gcontext-fill-rule gc) keyword)
+     (setf (gcontext-tile gc) pixmap)
+     (setf (gcontext-stipple gc) pixmap)
+     (setf (gcontext-ts-x gc) int16) ;; Tile-Stipple-X-origin
+     (setf (gcontext-ts-y gc) int16) ;; Tile-Stipple-Y-origin
+     (setf (gcontext-font gc &optional metrics-p) font)
+     (setf (gcontext-subwindow-mode gc) keyword)
+     (setf (gcontext-exposures gc) (member :on :off))
+     (setf (gcontext-clip-x gc) int16)
+     (setf (gcontext-clip-y gc) int16)
+     (setf (gcontext-clip-mask gc &optional ordering)
+	   (or (member :none) pixmap rect-seq))
+     (setf (gcontext-dash-offset gc) card16)
+     (setf (gcontext-dashes gc) (or card8 sequence))
+     (setf (gcontext-arc-mode gc) (member :chord :pie-slice))
+     (setf (gcontext-clip-ordering gc) keyword)
+
+ChangeHosts             ADD-ACCESS-HOST
+ChangeHosts             REMOVE-ACCESS-HOST
+ChangeKeyboardControl   CHANGE-KEYBOARD-CONTROL
+ChangePointerControl    CHANGE-POINTER-CONTROL
+ChangeProperty          CHANGE-PROPERTY
+ChangeSaveSet           REMOVE-FROM-SAVE-SET
+ChangeSaveSet           ADD-TO-SAVE-SET
+ChangeWindowAttributes
+     ;; See WITH-STATE
+     (setf (window-background window) value)
+     (setf (window-border window) value)
+     (setf (window-bit-gravity window) value)
+     (setf (window-gravity window) value)
+     (setf (window-backing-store window) value)
+     (setf (window-backing-planes window) value)
+     (setf (window-backing-pixel window) value)
+     (setf (window-override-redirect window) value)
+     (setf (window-save-under window) value)
+     (setf (window-colormap window) value)
+     (setf (window-cursor window) value)
+     (setf (window-event-mask window) value)
+     (setf (window-do-not-propagate-mask window) value)
+
+CirculateWindow         CIRCULATE-WINDOW-DOWN
+CirculateWindow         CIRCULATE-WINDOW-UP
+ClearToBackground       CLEAR-AREA
+CloseFont               CLOSE-FONT
+ConfigureWindow
+     ;; See WITH-STATE
+     (setf (drawable-x drawable) integer)
+     (setf (drawable-y drawable) integer)
+     (setf (drawable-width drawable) integer)
+     (setf (drawable-height drawable) integer)
+     (setf (drawable-depth drawable) integer)
+     (setf (drawable-border-width drawable) integer)
+     (setf (window-priority window &optional sibling) integer)
+
+ConvertSelection        CONVERT-SELECTION
+CopyArea                COPY-AREA
+CopyColormapAndFree     COPY-COLORMAP-AND-FREE
+CopyGC                  COPY-GCONTEXT
+CopyGC                  COPY-GCONTEXT-COMPONENTS
+CopyPlane               COPY-PLANE
+CreateColormap          CREATE-COLORMAP
+CreateCursor            CREATE-CURSOR
+CreateGC                CREATE-GCONTEXT
+CreateGlyphCursor       CREATE-GLYPH-CURSOR
+CreatePixmap            CREATE-PIXMAP
+CreateWindow            CREATE-WINDOW
+DeleteProperty          DELETE-PROPERTY
+DestroySubwindows       DESTROY-SUBWINDOWS
+DestroyWindow           DESTROY-WINDOW
+FillPoly                DRAW-LINES
+ForceScreenSaver        RESET-SCREEN-SAVER
+ForceScreenSaver        ACTIVATE-SCREEN-SAVER
+FreeColormap            FREE-COLORMAP
+FreeColors              FREE-COLORS
+FreeCursor              FREE-CURSOR
+FreeGC                  FREE-GCONTEXT
+FreePixmap              FREE-PIXMAP
+GetAtomName             ATOM-NAME
+GetFontPath             FONT-PATH
+GetGeometry             ;; See WITH-STATE
+                        DRAWABLE-ROOT
+                        DRAWABLE-X
+                        DRAWABLE-Y
+                        DRAWABLE-WIDTH
+                        DRAWABLE-HEIGHT
+                        DRAWABLE-DEPTH
+                        DRAWABLE-BORDER-WIDTH
+
+GetImage                GET-RAW-IMAGE
+GetInputFocus           INPUT-FOCUS
+GetKeyboardControl      KEYBOARD-CONTROL
+GetKeyboardMapping      KEYBOARD-MAPPING
+GetModifierMapping      MODIFIER-MAPPING
+GetMotionEvents         MOTION-EVENTS
+GetPointerControl       POINTER-CONTROL
+GetPointerMapping       POINTER-MAPPING
+GetProperty             GET-PROPERTY
+GetScreenSaver          SCREEN-SAVER
+GetSelectionOwner       SELECTION-OWNER
+GetWindowAttributes     ;; See WITH-STATE
+                        WINDOW-VISUAL-INFO
+                        WINDOW-CLASS
+                        WINDOW-BIT-GRAVITY
+                        WINDOW-GRAVITY
+                        WINDOW-BACKING-STORE
+                        WINDOW-BACKING-PLANES
+                        WINDOW-BACKING-PIXEL
+                        WINDOW-SAVE-UNDER
+                        WINDOW-OVERRIDE-REDIRECT
+                        WINDOW-EVENT-MASK
+                        WINDOW-DO-NOT-PROPAGATE-MASK
+                        WINDOW-COLORMAP
+                        WINDOW-COLORMAP-INSTALLED-P
+                        WINDOW-ALL-EVENT-MASKS
+                        WINDOW-MAP-STATE
+
+GrabButton              GRAB-BUTTON
+GrabKey                 GRAB-KEY
+GrabKeyboard            GRAB-KEYBOARD
+GrabPointer             GRAB-POINTER
+GrabServer              GRAB-SERVER
+ImageText16             DRAW-IMAGE-GLYPHS
+ImageText16             DRAW-IMAGE-GLYPH
+ImageText8              DRAW-IMAGE-GLYPHS
+InstallColormap         INSTALL-COLORMAP
+InternAtom              FIND-ATOM
+InternAtom              INTERN-ATOM
+KillClient              KILL-TEMPORARY-CLIENTS
+KillClient              KILL-CLIENT
+ListExtensions          LIST-EXTENSIONS
+ListFonts               LIST-FONT-NAMES
+ListFontsWithInfo       LIST-FONTS
+ListHosts               ACCESS-CONTROL
+ListHosts               ACCESS-HOSTS
+ListInstalledColormaps  INSTALLED-COLORMAPS
+ListProperties          LIST-PROPERTIES
+LookupColor             LOOKUP-COLOR
+MapSubwindows           MAP-SUBWINDOWS
+MapWindow               MAP-WINDOW
+OpenFont                OPEN-FONT
+PolyArc                 DRAW-ARC
+PolyArc                 DRAW-ARCS
+PolyFillArc             DRAW-ARC
+PolyFillArc             DRAW-ARCS
+PolyFillRectangle       DRAW-RECTANGLE
+PolyFillRectangle       DRAW-RECTANGLES
+PolyLine                DRAW-LINE
+PolyLine                DRAW-LINES
+PolyPoint               DRAW-POINT
+PolyPoint               DRAW-POINTS
+PolyRectangle           DRAW-RECTANGLE
+PolyRectangle           DRAW-RECTANGLES
+PolySegment             DRAW-SEGMENTS
+PolyText16              DRAW-GLYPH
+PolyText16              DRAW-GLYPHS
+PolyText8               DRAW-GLYPHS
+PutImage                PUT-RAW-IMAGE
+QueryBestSize           QUERY-BEST-CURSOR
+QueryBestSize           QUERY-BEST-STIPPLE
+QueryBestSize           QUERY-BEST-TILE
+QueryColors             QUERY-COLORS
+QueryExtension          QUERY-EXTENSION
+QueryFont               FONT-NAME
+                        FONT-NAME
+                        FONT-DIRECTION
+                        FONT-MIN-CHAR
+                        FONT-MAX-CHAR
+                        FONT-MIN-BYTE1
+                        FONT-MAX-BYTE1
+                        FONT-MIN-BYTE2
+                        FONT-MAX-BYTE2
+                        FONT-ALL-CHARS-EXIST-P
+                        FONT-DEFAULT-CHAR
+                        FONT-ASCENT
+                        FONT-DESCENT
+                        FONT-PROPERTIES
+                        FONT-PROPERTY
+     
+                        CHAR-LEFT-BEARING
+                        CHAR-RIGHT-BEARING
+                        CHAR-WIDTH
+                        CHAR-ASCENT
+                        CHAR-DESCENT
+                        CHAR-ATTRIBUTES
+     
+                        MIN-CHAR-LEFT-BEARING
+                        MIN-CHAR-RIGHT-BEARING
+                        MIN-CHAR-WIDTH
+                        MIN-CHAR-ASCENT
+                        MIN-CHAR-DESCENT
+                        MIN-CHAR-ATTRIBUTES
+     
+                        MAX-CHAR-LEFT-BEARING
+                        MAX-CHAR-RIGHT-BEARING
+                        MAX-CHAR-WIDTH
+                        MAX-CHAR-ASCENT
+                        MAX-CHAR-DESCENT
+                        MAX-CHAR-ATTRIBUTES
+
+QueryKeymap             QUERY-KEYMAP
+QueryPointer            GLOBAL-POINTER-POSITION
+QueryPointer            POINTER-POSITION
+QueryPointer            QUERY-POINTER
+QueryTextExtents        TEXT-EXTENTS
+QueryTextExtents        TEXT-WIDTH
+QueryTree               QUERY-TREE
+RecolorCursor           RECOLOR-CURSOR
+ReparentWindow          REPARENT-WINDOW
+RotateProperties        ROTATE-PROPERTIES
+SendEvent               SEND-EVENT
+SetClipRectangles       FORCE-GCONTEXT-CHANGES
+     ;; See WITH-GCONTEXT
+     (setf (gcontext-clip-x gc) int16)
+     (setf (gcontext-clip-y gc) int16)
+     (setf (gcontext-clip-mask gc &optional ordering)
+	   (or (member :none) pixmap rect-seq))
+     (setf (gcontext-clip-ordering gc) keyword)
+
+SetDashes               FORCE-GCONTEXT-CHANGES
+     ;; See WITH-GCONTEXT
+     (setf (gcontext-dash-offset gc) card16)
+     (setf (gcontext-dashes gc) (or card8 sequence))
+
+SetFontPath
+     (setf (font-path font) paths)
+	Where paths is (type (sequence (or string pathname)))
+
+SetInputFocus           SET-INPUT-FOCUS
+SetKeyboardMapping      CHANGE-KEYBOARD-MAPPING
+SetModifierMapping      SET-MODIFIER-MAPPING
+SetPointerMapping       SET-POINTER-MAPPING
+SetScreenSaver          SET-SCREEN-SAVER
+SetSelectionOwner       SET-SELECTION-OWNER
+StoreColors             STORE-COLOR
+StoreColors             STORE-COLORS
+StoreNamedColor         STORE-COLOR
+StoreNamedColor         STORE-COLORS
+TranslateCoords         TRANSLATE-COORDINATES
+UngrabButton            UNGRAB-BUTTON
+UngrabKey               UNGRAB-KEY
+UngrabKeyboard          UNGRAB-KEYBOARD
+UngrabPointer           UNGRAB-POINTER
+UngrabServer            UNGRAB-SERVER
+UninstallColormap       UNINSTALL-COLORMAP
+UnmapSubwindows         UNMAP-SUBWINDOWS
+UnmapWindow             UNMAP-WINDOW
+WarpPointer             WARP-POINTER
+WarpPointer             WARP-POINTER-IF-INSIDE
+WarpPointer             WARP-POINTER-RELATIVE
+WarpPointer             WARP-POINTER-RELATIVE-IF-INSIDE
+NoOperation             NO-OPERATION
+
+
+
+ X11 Request Name       CLX Function Name
+-----------------       -----------------
+ListHosts               ACCESS-CONTROL
+ListHosts               ACCESS-HOSTS
+ForceScreenSaver        ACTIVATE-SCREEN-SAVER
+ChangeHosts             ADD-ACCESS-HOST
+ChangeSaveSet           ADD-TO-SAVE-SET
+AllocColor              ALLOC-COLOR
+AllocNamedColor         ALLOC-COLOR
+AllocColorCells         ALLOC-COLOR-CELLS
+AllocColorPlanes        ALLOC-COLOR-PLANES
+AllowEvents             ALLOW-EVENTS
+GetAtomName             ATOM-NAME
+Bell                    BELL
+ChangeActivePointerGrab CHANGE-ACTIVE-POINTER-GRAB
+ChangeKeyboardControl   CHANGE-KEYBOARD-CONTROL
+SetKeyboardMapping      CHANGE-KEYBOARD-MAPPING
+ChangePointerControl    CHANGE-POINTER-CONTROL
+ChangeProperty          CHANGE-PROPERTY
+QueryFont               CHAR-ASCENT
+QueryFont               CHAR-ATTRIBUTES
+QueryFont               CHAR-DESCENT
+QueryFont               CHAR-LEFT-BEARING
+QueryFont               CHAR-RIGHT-BEARING
+QueryFont               CHAR-WIDTH
+CirculateWindow         CIRCULATE-WINDOW-DOWN
+CirculateWindow         CIRCULATE-WINDOW-UP
+ClearToBackground       CLEAR-AREA
+CloseFont               CLOSE-FONT
+ConvertSelection        CONVERT-SELECTION
+CopyArea                COPY-AREA
+CopyColormapAndFree     COPY-COLORMAP-AND-FREE
+CopyGC                  COPY-GCONTEXT
+CopyGC                  COPY-GCONTEXT-COMPONENTS
+CopyPlane               COPY-PLANE
+CreateColormap          CREATE-COLORMAP
+CreateCursor            CREATE-CURSOR
+CreateGC                CREATE-GCONTEXT
+CreateGlyphCursor       CREATE-GLYPH-CURSOR
+CreatePixmap            CREATE-PIXMAP
+CreateWindow            CREATE-WINDOW
+DeleteProperty          DELETE-PROPERTY
+DestroySubwindows       DESTROY-SUBWINDOWS
+DestroyWindow           DESTROY-WINDOW
+PolyArc                 DRAW-ARC
+PolyArc                 DRAW-ARCS
+PolyText16              DRAW-GLYPH
+PolyText16              DRAW-GLYPHS
+PolyText8               DRAW-GLYPHS
+ImageText16             DRAW-IMAGE-GLYPH
+ImageText16             DRAW-IMAGE-GLYPHS
+ImageText8              DRAW-IMAGE-GLYPHS
+PolyLine                DRAW-LINE
+PolyLine                DRAW-LINES
+PolyPoint               DRAW-POINT
+PolyPoint               DRAW-POINTS
+PolyFillRectangle       DRAW-RECTANGLE
+PolyRectangle           DRAW-RECTANGLE
+PolyFillRectangle       DRAW-RECTANGLES
+PolyRectangle           DRAW-RECTANGLES
+PolySegment             DRAW-SEGMENTS
+GetGeometry             DRAWABLE-BORDER-WIDTH
+GetGeometry             DRAWABLE-DEPTH
+GetGeometry             DRAWABLE-HEIGHT
+GetGeometry             DRAWABLE-ROOT
+GetGeometry             DRAWABLE-WIDTH
+GetGeometry             DRAWABLE-X
+GetGeometry             DRAWABLE-Y
+FillPoly                FILL-POLYGON
+InternAtom              FIND-ATOM
+QueryFont               FONT-ALL-CHARS-EXIST-P
+QueryFont               FONT-ASCENT
+QueryFont               FONT-DEFAULT-CHAR
+QueryFont               FONT-DESCENT
+QueryFont               FONT-DIRECTION
+QueryFont               FONT-MAX-BYTE1
+QueryFont               FONT-MAX-BYTE2
+QueryFont               FONT-MAX-CHAR
+QueryFont               FONT-MIN-BYTE1
+QueryFont               FONT-MIN-BYTE2
+QueryFont               FONT-MIN-CHAR
+QueryFont               FONT-NAME
+QueryFont               FONT-NAME
+GetFontPath             FONT-PATH
+QueryFont               FONT-PROPERTIES
+QueryFont               FONT-PROPERTY
+ChangeGC                FORCE-GCONTEXT-CHANGES
+SetClipRectangles       FORCE-GCONTEXT-CHANGES
+SetDashes               FORCE-GCONTEXT-CHANGES
+FreeColormap            FREE-COLORMAP
+FreeColors              FREE-COLORS
+FreeCursor              FREE-CURSOR
+FreeGC                  FREE-GCONTEXT
+FreePixmap              FREE-PIXMAP
+GetProperty             GET-PROPERTY
+GetImage                GET-RAW-IMAGE
+QueryPointer            GLOBAL-POINTER-POSITION
+GrabButton              GRAB-BUTTON
+GrabKey                 GRAB-KEY
+GrabKeyboard            GRAB-KEYBOARD
+GrabPointer             GRAB-POINTER
+GrabServer              GRAB-SERVER
+GrabServer              WITH-SERVER-GRABBED
+GetInputFocus           INPUT-FOCUS
+InstallColormap         INSTALL-COLORMAP
+ListInstalledColormaps  INSTALLED-COLORMAPS
+InternAtom              INTERN-ATOM
+GetKeyboardControl      KEYBOARD-CONTROL
+GetKeyboardMapping      KEYBOARD-MAPPING
+KillClient              KILL-CLIENT
+KillClient              KILL-TEMPORARY-CLIENTS
+ListExtensions          LIST-EXTENSIONS
+ListFonts               LIST-FONT-NAMES
+ListFontsWithInfo       LIST-FONTS
+ListProperties          LIST-PROPERTIES
+LookupColor             LOOKUP-COLOR
+MapSubwindows           MAP-SUBWINDOWS
+MapWindow               MAP-WINDOW
+QueryFont               MAX-CHAR-ASCENT
+QueryFont               MAX-CHAR-ATTRIBUTES
+QueryFont               MAX-CHAR-DESCENT
+QueryFont               MAX-CHAR-LEFT-BEARING
+QueryFont               MAX-CHAR-RIGHT-BEARING
+QueryFont               MAX-CHAR-WIDTH
+QueryFont               MIN-CHAR-ASCENT
+QueryFont               MIN-CHAR-ATTRIBUTES
+QueryFont               MIN-CHAR-DESCENT
+QueryFont               MIN-CHAR-LEFT-BEARING
+QueryFont               MIN-CHAR-RIGHT-BEARING
+QueryFont               MIN-CHAR-WIDTH
+GetModifierMapping      MODIFIER-MAPPING
+GetMotionEvents         MOTION-EVENTS
+NoOperation             NO-OPERATION
+OpenFont                OPEN-FONT
+GetPointerControl       POINTER-CONTROL
+GetPointerMapping       POINTER-MAPPING
+QueryPointer            POINTER-POSITION
+PutImage                PUT-RAW-IMAGE
+QueryBestSize           QUERY-BEST-CURSOR
+QueryBestSize           QUERY-BEST-STIPPLE
+QueryBestSize           QUERY-BEST-TILE
+QueryColors             QUERY-COLORS
+QueryExtension          QUERY-EXTENSION
+QueryKeymap             QUERY-KEYMAP
+QueryPointer            QUERY-POINTER
+QueryTree               QUERY-TREE
+RecolorCursor           RECOLOR-CURSOR
+ChangeHosts             REMOVE-ACCESS-HOST
+ChangeSaveSet           REMOVE-FROM-SAVE-SET
+ReparentWindow          REPARENT-WINDOW
+ForceScreenSaver        RESET-SCREEN-SAVER
+RotateProperties        ROTATE-PROPERTIES
+GetScreenSaver          SCREEN-SAVER
+GetSelectionOwner       SELECTION-OWNER
+SendEvent               SEND-EVENT
+ChangeAccessControl     SET-ACCESS-CONTROL
+ChangeCloseDownMode     SET-CLOSE-DOWN-MODE
+SetInputFocus           SET-INPUT-FOCUS
+SetModifierMapping      SET-MODIFIER-MAPPING
+SetPointerMapping       SET-POINTER-MAPPING
+SetScreenSaver          SET-SCREEN-SAVER
+SetSelectionOwner       SET-SELECTION-OWNER
+StoreColors             STORE-COLOR
+StoreColors             STORE-COLORS
+StoreNamedColor         STORE-COLOR
+StoreNamedColor         STORE-COLORS
+QueryTextExtents        TEXT-EXTENTS
+QueryTextExtents        TEXT-WIDTH
+TranslateCoords         TRANSLATE-COORDINATES
+UngrabButton            UNGRAB-BUTTON
+UngrabKey               UNGRAB-KEY
+UngrabKeyboard          UNGRAB-KEYBOARD
+UngrabPointer           UNGRAB-POINTER
+UngrabServer            UNGRAB-SERVER
+UngrabServer            WITH-SERVER-GRABBED
+UninstallColormap       UNINSTALL-COLORMAP
+UnmapSubwindows         UNMAP-SUBWINDOWS
+UnmapWindow             UNMAP-WINDOW
+WarpPointer             WARP-POINTER
+WarpPointer             WARP-POINTER-IF-INSIDE
+WarpPointer             WARP-POINTER-RELATIVE
+WarpPointer             WARP-POINTER-RELATIVE-IF-INSIDE
+GetWindowAttributes     WINDOW-ALL-EVENT-MASKS
+GetWindowAttributes     WINDOW-BACKING-PIXEL
+GetWindowAttributes     WINDOW-BACKING-PLANES
+GetWindowAttributes     WINDOW-BACKING-STORE
+GetWindowAttributes     WINDOW-BIT-GRAVITY
+GetWindowAttributes     WINDOW-CLASS
+GetWindowAttributes     WINDOW-COLORMAP
+GetWindowAttributes     WINDOW-COLORMAP-INSTALLED-P
+GetWindowAttributes     WINDOW-DO-NOT-PROPAGATE-MASK
+GetWindowAttributes     WINDOW-EVENT-MASK
+GetWindowAttributes     WINDOW-GRAVITY
+GetWindowAttributes     WINDOW-MAP-STATE
+GetWindowAttributes     WINDOW-OVERRIDE-REDIRECT
+GetWindowAttributes     WINDOW-SAVE-UNDER
+GetWindowAttributes     WINDOW-VISUAL-INFO
+
+ConfigureWindow         (SETF (DRAWABLE-BORDER-WIDTH DRAWABLE) INTEGER)
+ConfigureWindow         (SETF (DRAWABLE-DEPTH DRAWABLE) INTEGER)
+ConfigureWindow         (SETF (DRAWABLE-HEIGHT DRAWABLE) INTEGER)
+ConfigureWindow         (SETF (DRAWABLE-WIDTH DRAWABLE) INTEGER)
+ConfigureWindow         (SETF (DRAWABLE-X DRAWABLE) INTEGER)
+ConfigureWindow         (SETF (DRAWABLE-Y DRAWABLE) INTEGER)
+SetFontPath             (SETF (FONT-PATH FONT) PATHS)
+ChangeGC                (SETF (GCONTEXT-ARC-MODE GC) (MEMBER CHORD PIE-SLICE))
+ChangeGC                (SETF (GCONTEXT-BACKGROUND GC) CARD32)
+ChangeGC                (SETF (GCONTEXT-CAP-STYLE GC) KEYWORD)
+SetClipRectangles       (SETF (GCONTEXT-CLIP-MASK GC &OPTIONAL ORDERING)
+	                      (OR (MEMBER NONE) PIXMAP RECT-SEQ))
+SetClipRectangles       (SETF (GCONTEXT-CLIP-ORDERING GC) KEYWORD)
+SetClipRectangles       (SETF (GCONTEXT-CLIP-X GC) INT16)
+SetClipRectangles       (SETF (GCONTEXT-CLIP-Y GC) INT16)
+SetDashes               (SETF (GCONTEXT-DASH-OFFSET GC) CARD16)
+SetDashes               (SETF (GCONTEXT-DASHES GC) (OR CARD8 SEQUENCE))
+ChangeGC                (SETF (GCONTEXT-EXPOSURES GC) (MEMBER ON OFF))
+ChangeGC                (SETF (GCONTEXT-FILL-RULE GC) KEYWORD)
+ChangeGC                (SETF (GCONTEXT-FILL-STYLE GC) KEYWORD)
+ChangeGC                (SETF (GCONTEXT-FONT GC &OPTIONAL METRICS-P) FONT)
+ChangeGC                (SETF (GCONTEXT-FOREGROUND GC) CARD32)
+ChangeGC                (SETF (GCONTEXT-FUNCTION GC) BOOLE-CONSTANT)
+ChangeGC                (SETF (GCONTEXT-JOIN-STYLE GC) KEYWORD)
+ChangeGC                (SETF (GCONTEXT-LINE-STYLE GC) KEYWORD)
+ChangeGC                (SETF (GCONTEXT-LINE-WIDTH GC) CARD16)
+ChangeGC                (SETF (GCONTEXT-PLANE-MASK GC) CARD32)
+ChangeGC                (SETF (GCONTEXT-STIPPLE GC) PIXMAP)
+ChangeGC                (SETF (GCONTEXT-SUBWINDOW-MODE GC) KEYWORD)
+ChangeGC                (SETF (GCONTEXT-TILE GC) PIXMAP)
+ChangeGC                (SETF (GCONTEXT-TS-X GC) INT16)
+ChangeGC                (SETF (GCONTEXT-TS-Y GC) INT16)
+ChangeWindowAttributes  (SETF (WINDOW-BACKGROUND WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-BACKING-PIXEL WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-BACKING-PLANES WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-BACKING-STORE WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-BIT-GRAVITY WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-BORDER WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-COLORMAP WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-CURSOR WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-DO-NOT-PROPAGATE-MASK WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-EVENT-MASK WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-GRAVITY WINDOW) VALUE)
+ChangeWindowAttributes  (SETF (WINDOW-OVERRIDE-REDIRECT WINDOW) VALUE)
+ConfigureWindow         (SETF (WINDOW-PRIORITY WINDOW &OPTIONAL SIBLING) INTEGER)
+ChangeWindowAttributes  (SETF (WINDOW-SAVE-UNDER WINDOW) VALUE)
+
+
+
+;; Here's a list of the CLX functions that don't directly correspond to 
+;; X Window System requests.  The've been categorized by function:
+
+					   ;Display Management
+CLOSE-DISPLAY
+CLOSE-DOWN-MODE
+DISPLAY-AFTER-FUNCTION ;; SETF'able
+DISPLAY-FINISH-OUTPUT
+DISPLAY-FORCE-OUTPUT
+DISPLAY-INVOKE-AFTER-FUNCTION
+OPEN-DISPLAY
+WITH-DISPLAY
+WITH-EVENT-QUEUE
+					   ;Extensions
+DECLARE-EVENT
+DECODE-CORE-ERROR
+DEFAULT-ERROR-HANDLER
+DEFINE-CONDITION
+DEFINE-ERROR
+DEFINE-EXTENSION
+DEFINE-GCONTEXT-ACCESSOR
+EXTENSION-OPCODE
+					   ;Events
+EVENT-CASE
+EVENT-LISTEN
+MAPPING-NOTIFY
+PROCESS-EVENT
+EVENT-HANDLER
+MAKE-EVENT-HANDLERS
+QUEUE-EVENT
+					   ;Image
+COPY-IMAGE
+CREATE-IMAGE
+GET-IMAGE
+IMAGE-BLUE-MASK
+IMAGE-DEPTH
+IMAGE-GREEN-MASK
+IMAGE-HEIGHT
+IMAGE-NAME
+IMAGE-PIXMAP
+IMAGE-PLIST
+IMAGE-RED-MASK
+IMAGE-WIDTH
+IMAGE-X-HOT
+IMAGE-Y-HOT
+PUT-IMAGE
+READ-BITMAP-FILE
+WRITE-BITMAP-FILE
+					   ;Keysyms
+CHARACTER->KEYSYMS
+CHARACTER-IN-MAP-P
+DEFAULT-KEYSYM-INDEX
+DEFAULT-KEYSYM-TRANSLATE
+DEFINE-KEYSYM
+DEFINE-KEYSYM-SET
+KEYCODE->CHARACTER
+KEYCODE->KEYSYM
+KEYSYM
+KEYSYM->CHARACTER
+KEYSYM-IN-MAP-P
+KEYSYM-SET
+UNDEFINE-KEYSYM
+					   ;Properties
+CUT-BUFFER
+GET-STANDARD-COLORMAP
+GET-WM-CLASS
+ICON-SIZES
+MAKE-WM-HINTS
+MAKE-WM-SIZE-HINTS
+ROTATE-CUT-BUFFERS
+SET-STANDARD-COLORMAP
+SET-WM-CLASS
+TRANSIENT-FOR
+WM-CLIENT-MACHINE
+WM-COMMAND
+WM-HINTS
+WM-HINTS-FLAGS
+WM-HINTS-ICON-MASK
+WM-HINTS-ICON-PIXMAP
+WM-HINTS-ICON-WINDOW
+WM-HINTS-ICON-X
+WM-HINTS-ICON-Y
+WM-HINTS-INITIAL-STATE
+WM-HINTS-INPUT
+WM-HINTS-P
+WM-HINTS-WINDOW-GROUP
+WM-ICON-NAME
+WM-NAME
+WM-NORMAL-HINTS
+WM-SIZE-HINTS-HEIGHT
+WM-SIZE-HINTS-HEIGHT-INC
+WM-SIZE-HINTS-MAX-ASPECT
+WM-SIZE-HINTS-MAX-HEIGHT
+WM-SIZE-HINTS-MAX-WIDTH
+WM-SIZE-HINTS-MIN-ASPECT
+WM-SIZE-HINTS-MIN-HEIGHT
+WM-SIZE-HINTS-MIN-WIDTH
+WM-SIZE-HINTS-P
+WM-SIZE-HINTS-USER-SPECIFIED-POSITION-P
+WM-SIZE-HINTS-USER-SPECIFIED-SIZE-P
+WM-SIZE-HINTS-WIDTH
+WM-SIZE-HINTS-WIDTH-INC
+WM-SIZE-HINTS-X
+WM-SIZE-HINTS-Y
+WM-ZOOM-HINTS
+					   ;Misc.
+MAKE-COLOR
+MAKE-EVENT-KEYS
+MAKE-EVENT-MASK
+MAKE-RESOURCE-DATABASE
+MAKE-STATE-KEYS
+MAKE-STATE-MASK
+DISCARD-FONT-INFO
+TRANSLATE-DEFAULT
+					   ;Structures
+BITMAP-FORMAT-LSB-FIRST-P
+BITMAP-FORMAT-P
+BITMAP-FORMAT-PAD
+BITMAP-FORMAT-UNIT
+BITMAP-IMAGE
+
+COLOR-BLUE
+COLOR-GREEN
+COLOR-P
+COLOR-RED
+COLOR-RGB
+COLORMAP-DISPLAY
+COLORMAP-EQUAL
+COLORMAP-ID
+COLORMAP-P
+COLORMAP-VISUAL-INFO
+
+CURSOR-DISPLAY
+CURSOR-EQUAL
+CURSOR-ID
+CURSOR-P
+
+DRAWABLE-DISPLAY
+DRAWABLE-EQUAL
+DRAWABLE-ID
+DRAWABLE-P
+
+FONT-DISPLAY
+FONT-EQUAL
+FONT-ID
+FONT-MAX-BOUNDS
+FONT-MIN-BOUNDS
+FONT-P
+FONT-PLIST
+
+GCONTEXT-DISPLAY
+GCONTEXT-EQUAL
+GCONTEXT-ID
+GCONTEXT-P
+GCONTEXT-PLIST
+
+DISPLAY-AUTHORIZATION-DATA
+DISPLAY-AUTHORIZATION-NAME
+DISPLAY-BITMAP-FORMAT
+DISPLAY-BYTE-ORDER
+DISPLAY-DEFAULT-SCREEN
+DISPLAY-DISPLAY
+DISPLAY-ERROR-HANDLER
+DISPLAY-IMAGE-LSB-FIRST-P
+DISPLAY-KEYCODE-RANGE
+DISPLAY-MAX-KEYCODE
+DISPLAY-MAX-REQUEST-LENGTH
+DISPLAY-MIN-KEYCODE
+DISPLAY-MOTION-BUFFER-SIZE
+DISPLAY-NSCREENS
+DISPLAY-P
+DISPLAY-PIXMAP-FORMATS
+DISPLAY-PLIST
+DISPLAY-PROTOCOL-MAJOR-VERSION
+DISPLAY-PROTOCOL-MINOR-VERSION
+DISPLAY-PROTOCOL-VERSION
+DISPLAY-RELEASE-NUMBER
+DISPLAY-RESOURCE-ID-BASE
+DISPLAY-RESOURCE-ID-MASK
+DISPLAY-ROOTS
+DISPLAY-SQUISH
+DISPLAY-VENDOR
+DISPLAY-VENDOR-NAME
+DISPLAY-VERSION-NUMBER
+DISPLAY-XDEFAULTS
+DISPLAY-XID
+
+PIXMAP-DISPLAY
+PIXMAP-EQUAL
+PIXMAP-FORMAT-BITS-PER-PIXEL
+PIXMAP-FORMAT-DEPTH
+PIXMAP-FORMAT-P
+PIXMAP-FORMAT-SCANLINE-PAD
+PIXMAP-ID
+PIXMAP-P
+PIXMAP-PLIST
+
+SCREEN-BACKING-STORES
+SCREEN-BLACK-PIXEL
+SCREEN-DEFAULT-COLORMAP
+SCREEN-DEPTHS
+SCREEN-EVENT-MASK-AT-OPEN
+SCREEN-HEIGHT
+SCREEN-HEIGHT-IN-MILLIMETERS
+SCREEN-MAX-INSTALLED-MAPS
+SCREEN-MIN-INSTALLED-MAPS
+SCREEN-P
+SCREEN-PLIST
+SCREEN-ROOT
+SCREEN-ROOT-DEPTH
+SCREEN-ROOT-VISUAL-INFO
+SCREEN-SAVE-UNDERS-P
+SCREEN-WHITE-PIXEL
+SCREEN-WIDTH
+SCREEN-WIDTH-IN-MILLIMETERS
+
+VISUAL-INFO
+VISUAL-INFO-BITS-PER-RGB
+VISUAL-INFO-BLUE-MASK
+VISUAL-INFO-CLASS
+VISUAL-INFO-COLORMAP-ENTRIES
+VISUAL-INFO-GREEN-MASK
+VISUAL-INFO-ID
+VISUAL-INFO-P
+VISUAL-INFO-PLIST
+VISUAL-INFO-RED-MASK
+
+WINDOW-DISPLAY
+WINDOW-EQUAL
+WINDOW-ID
+WINDOW-P
+WINDOW-PLIST
diff --git a/src/clx/ecldep.lsp b/src/clx/ecldep.lsp
new file mode 100644
index 000000000..a9456f0eb
--- /dev/null
+++ b/src/clx/ecldep.lsp
@@ -0,0 +1,134 @@
+;;;
+;;;     CLX -- ecldep.cl
+;;;
+
+;;;;  Copyright (c) 1994, Giuseppe Attardi.
+;;;;
+;;;;    ECL is free software; you can redistribute it and/or modify it
+;;;;    under the terms of the GNU Library General Public License as
+;;;;    published by the Free Software Foundation; either version 2
+;;;;    of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package :xlib)
+
+;;; from file depdefs.l
+
+(deftype buffer-bytes () 'string)
+
+(defCbody little-endian-p () boolean
+	  "Cnil;
+    { int whichbyte = 1;
+      if (*(char *) &whichbyte) x=Ct;}")
+
+#|
+(definline index+ (fixnum fixnum) fixnum	"(#0) + (#1)")
+(definline index-logand (fixnum fixnum) fixnum	"(#0) & (#1)")
+(definline index-logior (fixnum fixnum) fixnum	"(#0) | (#1)")
+(definline index- (fixnum fixnum) fixnum	"(#0) - (#1)")
+(definline index* (fixnum fixnum) fixnum	"(#0) * (#1)")
+(definline index1+ (fixnum) fixnum		"(#0)+1")
+(definline index1- (fixnum) fixnum		"(#0)-1")
+
+(defmacro index-incf (place &optional (delta 1))
+   `(setf ,place (the array-index (+ ,place ,delta))))
+
+(defmacro index-decf (place &optional (delta 1))
+   `(setf ,place (the array-index (- ,place ,delta))))
+
+(definline index-min (fixnum fixnum) fixnum	"(#0) < (#1) ? (#0) : (#1)")
+(definline index-max (fixnum fixnum) fixnum	"(#0) > (#1) ? (#0) : (#1)")
+
+(defmacro index-floor (number &optional divisor) ; never used
+   `(the array-index
+	 (values (floor (the array-index ,number)
+			,@(when divisor `((the array-index ,divisor)))))))
+(defmacro index-ceiling (number &optional divisor) ; rarely used
+   `(the array-index
+	 (values (ceiling (the array-index ,number)
+			  ,@(when divisor `((the array-index ,divisor)))))))
+(defmacro index-truncate (number &optional divisor) ; never used
+   `(the array-index
+	 (values (truncate (the array-index ,number)
+			   ,@(when divisor `((the array-index ,divisor)))))))
+
+(definline index-mod (fixnum fixnum) fixnum	"(#0) % (#1)")
+
+(definline index-ash (fixnum fixnum) fixnum
+	    "(#1) > 0 ? ((#0) << (#1)) : ((#0) >> -(#1))")
+(definline index-plusp (fixnum) compiler::boolean	"(#0) > 0")
+(definline index-zerop (fixnum) compiler::boolean	"(#0) == 0")
+(definline index-evenp (fixnum) compiler::boolean	"!((#0) & 1)")
+(definline index-oddp (fixnum) compiler::boolean	"((#0) & 1)")
+(definline index> (fixnum fixnum) compiler::boolean	"(#0) > (#1)")
+(definline index= (fixnum fixnum) compiler::boolean	"(#0) == (#1)")
+(definline index< (fixnum fixnum) compiler::boolean	"(#0) < (#1)")
+(definline index>= (fixnum fixnum) compiler::boolean	"(#0) >= (#1)")
+(definline index<= (fixnum fixnum) compiler::boolean	"(#0) <= (#1)")
+|#
+
+;;; from file dependent.l
+
+(definline card8->int8 (fixnum) fixnum
+  "(#0) & 0x80 ? ((#0)-0x100) : (#0)")
+
+(definline int8->card8 (fixnum) fixnum
+  "(#0)")
+
+(definline card16->int16 (fixnum) fixnum
+  "((short)(#0))")
+
+(definline int16->card16 (fixnum) fixnum
+  "((unsigned short)(#0))")
+
+(definline card32->int32 (fixnum) fixnum
+  "(#0)")
+
+(definline int32->card32 (fixnum) fixnum
+  "(#0)")
+
+(definline aref-card8 (string fixnum) fixnum
+  "(#0)->ust.ust_self[#1]")
+
+(definline aset-card8 (fixnum string fixnum) fixnum
+        "((#1)->ust.ust_self[#2]=(#0))")
+;; alternatively:
+;(defmacro aref-card8 (s i) `(schar ,s ,i))
+;(defmacro aset-card8 (v s i) `(setf (schar ,s ,i) (int-char ,v)))
+
+(definline aref-int8 (string fixnum) fixnum
+  "(#0)->st.st_self[#1]")
+
+(definline aset-int8 (fixnum string fixnum) fixnum
+        "((#1)->st.st_self[#2]=(#0))")
+
+(definline aref-card16 (string fixnum) fixnum
+  "(*(unsigned short *)((#0)->ust.ust_self+(#1)))")
+
+(definline aset-card16 (fixnum string fixnum) fixnum
+  "((*(unsigned short *)((#1)->ust.ust_self+(#2)))=#0)")
+
+(definline aref-int16 (string fixnum) fixnum
+  "(*(short *)((#0)->st.st_self+(#1)))")
+
+(definline aset-int16 (fixnum string fixnum) fixnum
+  "((*(short *)((#1)->st.st_self+(#2)))=#0)")
+
+(definline aref-card32 (string fixnum) fixnum
+  "(*(unsigned long *)((#0)->ust.ust_self+(#1)))")
+
+(definline aset-card32 (fixnum string fixnum) fixnum
+  "((*(unsigned long *)((#1)->ust.ust_self+(#2)))=#0)")
+
+(definline aref-int32 (string fixnum) fixnum
+  "(*(long *)((#0)->ust.ust_self+(#1)))")
+
+(definline aset-int32 (fixnum string fixnum) fixnum
+  "((*(long *)((#1)->ust.ust_self+(#2)))=#0)")
+
+(definline aref-card29 (string fixnum) fixnum
+  "((*(unsigned long *)((#0)->ust.ust_self+(#1))) & 0x1fffffff)")
+
+(definline aset-card29 (fixnum string fixnum) fixnum
+  "((*(unsigned long *)((#1)->ust.ust_self+(#2)))=#0)")
diff --git a/src/clx/ecllock.lsp b/src/clx/ecllock.lsp
new file mode 100644
index 000000000..369841b73
--- /dev/null
+++ b/src/clx/ecllock.lsp
@@ -0,0 +1,42 @@
+(in-package 'mp :use '(lisp) )
+
+(export '(lock-owner
+	  make-process-lock
+	  P
+	  V))
+	 
+(defstruct (lock (:constructor make-process-lock)
+		 (:conc-name nil))
+  (owner nil)
+  (requests nil))
+
+(defun P (lock)
+  (si:without-scheduling
+    (if (owner lock)
+	(wait-in lock)
+      ;else
+      (setf (owner lock) (current-thread)))))
+
+(defun wait-in (lock)
+  (setf (requests lock)
+	(nconc (requests lock) (list (current-thread))))
+  (deactivate (current-thread)))
+
+
+(defun V (lock)
+  (si:without-scheduling
+    (if (requests lock)
+      (progn
+        (setf (owner lock) (car (requests lock)))
+	(reactivate (owner lock))
+        (setf (requests lock)
+            (delete (car (requests lock)) (requests lock))))
+      ;else
+      (setf (owner lock) nil))))
+
+
+(in-package 'xlib)
+
+(import '(owner
+	  make-process-lock))
+
diff --git a/src/clx/fonts.lsp b/src/clx/fonts.lsp
new file mode 100644
index 000000000..8cc20693d
--- /dev/null
+++ b/src/clx/fonts.lsp
@@ -0,0 +1,366 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+;; The char-info stuff is here instead of CLX because of uses of int16->card16.
+
+; To allow efficient storage representations, the type char-info is not
+; required to be a structure.
+
+;; For each of left-bearing, right-bearing, width, ascent, descent, attributes:
+
+;(defun char-<metric> (font index)
+;  ;; Note: I have tentatively chosen to return nil for an out-of-bounds index
+;  ;; (or an in-bounds index on a pseudo font), although returning zero or
+;  ;; signalling might be better.
+;  (declare (type font font)
+;	   (type integer index)
+;	   (values (or null integer))))
+
+;(defun max-char-<metric> (font)
+;  ;; Note: I have tentatively chosen separate accessors over allowing :min and
+;  ;; :max as an index above.
+;  (declare (type font font)
+;	   (values integer)))
+
+;(defun min-char-<metric> (font)
+;  (declare (type font font)
+;	   (values integer)))
+
+;; Note: char16-<metric> accessors could be defined to accept two-byte indexes.
+
+(deftype char-info-vec () '(simple-array int16 (6)))
+
+(macrolet ((def-char-info-accessors (useless-name &body fields)
+	    `(within-definition (,useless-name def-char-info-accessors)
+	       ,@(do ((field fields (cdr field))
+		      (n 0 (1+ n))
+		      (name) (type)
+		      (result nil))
+		     ((endp field) result)
+		   (setq name (xintern 'char- (caar field)))
+		   (setq type (cadar field))
+		   (flet ((from (form)
+			    (if (eq type 'int16)
+				form
+				`(,(xintern 'int16-> type) ,form))))
+		     (push
+		       `(defun ,name (font index)
+			  (declare (type font font)
+				   (type array-index index))
+			  (declare (values (or null ,type)))
+			  (when (and (font-name font)
+				     (index>= (font-max-char font) index (font-min-char font)))
+			    (the ,type
+				 ,(from
+				    `(the int16
+					  (let ((char-info-vector (font-char-infos font)))
+					    (declare (type char-info-vec char-info-vector))
+					    (if (index-zerop (length char-info-vector))
+						;; Fixed width font
+						(aref (the char-info-vec
+							   (font-max-bounds font))
+						      ,n)
+						;; Variable width font
+						(aref char-info-vector
+						      (index+
+							(index*
+							  6
+							  (index-
+							    index
+							    (font-min-char font)))
+							,n)))))))))
+		       result)
+		     (setq name (xintern 'min-char- (caar field)))
+		     (push
+		       `(defun ,name (font)
+			  (declare (type font font))
+			  (declare (values (or null ,type)))
+			  (when (font-name font)
+			    (the ,type
+				 ,(from
+				    `(the int16
+					  (aref (the char-info-vec (font-min-bounds font))
+						,n))))))
+		       result)
+		     (setq name (xintern 'max-char- (caar field)))
+		     (push
+		       `(defun ,name (font)
+			  (declare (type font font))
+			  (declare (values (or null ,type)))
+			  (when (font-name font)
+			    (the ,type
+				 ,(from
+				    `(the int16
+					  (aref (the char-info-vec (font-max-bounds font))
+						,n))))))
+		       result)))
+	  
+	       (defun make-char-info
+		      (&key ,@(mapcar
+				#'(lambda (field)
+				    `(,(car field) (required-arg ,(car field))))
+				fields))
+		 (declare ,@(mapcar #'(lambda (field) `(type ,@(reverse field))) fields))
+		 (let ((result (make-array ,(length fields) :element-type 'int16)))
+		   (declare (type char-info-vec result)
+			    (array-register result))
+		   ,@(do* ((field fields (cdr field))
+			   (var (caar field) (caar field))
+			   (type (cadar field) (cadar field))
+			   (n 0 (1+ n))
+			   (result nil))
+			  ((endp field) (nreverse result))
+		       (push `(setf (aref result ,n)
+				    ,(if (eq type 'int16)
+					 var
+					 `(,(xintern type '->int16) ,var)))
+			     result))
+		   result)))))
+  (def-char-info-accessors ignore
+    (left-bearing int16)
+    (right-bearing int16)
+    (width int16)
+    (ascent int16)
+    (descent int16)
+    (attributes card16)))
+    
+(defun open-font (display name)
+  ;; Font objects may be cached and reference counted locally within the display
+  ;; object.  This function might not execute a with-display if the font is cached.
+  ;; The protocol QueryFont request happens on-demand under the covers.
+  (declare (type display display)
+	   (type stringable name))
+  (declare (values font))
+  (let* ((name-string (string-downcase (string name)))
+	 (font (car (member name-string (display-font-cache display)
+			    :key 'font-name
+			    :test 'equal)))
+	 font-id)
+    (unless font
+      (setq font (make-font :display display :name name-string))
+      (setq font-id (allocate-resource-id display font 'font))
+      (setf (font-id-internal font) font-id)
+      (with-buffer-request (display *x-openfont*)
+	(resource-id font-id)
+	(card16 (length name-string))
+	(pad16 nil)
+	(string name-string))
+      (push font (display-font-cache display)))
+    (incf (font-reference-count font))
+    font))
+
+(defun open-font-internal (font)
+  ;; Called "under the covers" to open a font object
+  (declare (type font font))
+  (declare (values resource-id))
+  (let* ((name-string (font-name font))
+	 (display (font-display font))
+	 (id (allocate-resource-id display font 'font)))
+    (setf (font-id-internal font) id)
+    (with-buffer-request (display *x-openfont*)
+      (resource-id id)
+      (card16 (length name-string))
+      (pad16 nil)
+      (string name-string))
+    (push font (display-font-cache display))
+    (incf (font-reference-count font))
+    id))
+
+(defun discard-font-info (font)
+  ;; Discards any state that can be re-obtained with QueryFont.  This is
+  ;; simply a performance hint for memory-limited systems.
+  (declare (type font font))
+  (setf (font-font-info-internal font) nil
+	(font-char-infos-internal font) nil))
+
+(defun query-font (font)
+  ;; Internal function called by font and char info accessors
+  (declare (type font font))
+  (declare (values font-info))
+  (let ((display (font-display font))
+	font-id
+	font-info
+	props)
+    (setq font-id (font-id font)) ;; May issue an open-font request
+    (with-buffer-request-and-reply (display *x-queryfont* 60)
+	 ((resource-id font-id))
+      (let* ((min-byte2 (card16-get 40))
+	     (max-byte2 (card16-get 42))
+	     (min-byte1 (card8-get 49))
+	     (max-byte1 (card8-get 50))
+	     (min-char  min-byte2)
+	     (max-char  (index+ (index-ash max-byte1 8) max-byte2))
+	     (nfont-props (card16-get 46))
+	     (nchar-infos (index* (card32-get 56) 6))
+	     (char-info (make-array nchar-infos :element-type 'int16)))
+	(setq font-info
+	      (make-font-info
+		:direction (member8-get 48 :left-to-right :right-to-left)
+		:min-char min-char
+		:max-char max-char
+		:min-byte1 min-byte1
+		:max-byte1 max-byte1
+		:min-byte2 min-byte2
+		:max-byte2 max-byte2
+		:all-chars-exist-p (boolean-get 51)
+		:default-char (card16-get 44)
+		:ascent (int16-get 52)
+		:descent (int16-get 54)
+		:min-bounds (char-info-get 8)
+		:max-bounds (char-info-get 24)))
+	(setq props (sequence-get :length (index* 2 nfont-props) :format int32
+				  :result-type 'list :index 60))
+	(sequence-get :length nchar-infos :format int16 :data char-info
+		      :index (index+ 60 (index* 2 nfont-props 4)))
+	(setf (font-char-infos-internal font) char-info)
+	(setf (font-font-info-internal font) font-info)))
+    ;; Replace atom id's with keywords in the plist
+    (do ((p props (cddr p)))
+	((endp p))
+      (setf (car p) (atom-name display (car p))))
+    (setf (font-info-properties font-info) props)
+    font-info))
+
+(defun close-font (font)
+  ;; This might not generate a protocol request if the font is reference
+  ;; counted locally.
+  (declare (type font font))
+  (when (and (not (plusp (decf (font-reference-count font))))
+	     (font-id-internal font))
+    (let ((display (font-display font))
+	  (id (font-id-internal font)))
+      (declare (type display display))
+      ;; Remove font from cache
+      (setf (display-font-cache display) (delete font (display-font-cache display)))
+      ;; Close the font
+      (with-buffer-request (display *x-closefont*)
+	(resource-id id)))))
+
+(defun list-font-names (display pattern &key (max-fonts 65535) (result-type 'list))
+  (declare (type display display)
+	   (type string pattern)
+	   (type card16 max-fonts)
+	   (type t result-type)) ;; CL type
+  (declare (values (sequence string)))
+  (let ((string (string pattern)))
+    (with-buffer-request-and-reply (display *x-listfonts* size :sizes (8 16))
+	 ((card16 max-fonts (length string))
+	  (string string))
+      (values
+	(read-sequence-string
+	  buffer-bbuf (index- size *replysize*) (card16-get 8) result-type *replysize*)))))
+
+(defun list-fonts (display pattern &key (max-fonts 65535) (result-type 'list))
+  ;; Note: Was called list-fonts-with-info.
+  ;; Returns "pseudo" fonts that contain basic font metrics and properties, but
+  ;; no per-character metrics and no resource-ids.  These pseudo fonts will be
+  ;; converted (internally) to real fonts dynamically as needed, by issuing an
+  ;; OpenFont request.  However, the OpenFont might fail, in which case the
+  ;; invalid-font error can arise.
+  (declare (type display display)
+	   (type string pattern)
+	   (type card16 max-fonts)
+	   (type t result-type)) ;; CL type
+  (declare (values (sequence font)))
+  (let ((string (string pattern))
+	(result nil))
+    (with-buffer-request-and-reply (display *x-listfontswithinfo* 60
+					    :sizes (8 16) :multiple-reply t)
+	 ((card16 max-fonts (length string))
+	  (string string))
+      (cond ((zerop (card8-get 1)) t)
+	    (t
+	(let* ((name-len (card8-get 1))
+	       (min-byte2 (card16-get 40))
+	       (max-byte2 (card16-get 42))
+	       (min-byte1 (card8-get 49))
+	       (max-byte1 (card8-get 50))
+	       (min-char  min-byte2)
+	       (max-char  (index+ (index-ash max-byte1 8) max-byte2))
+	       (nfont-props (card16-get 46))
+	       (font
+		 (make-font
+		   :display display
+		   :name nil
+		   :font-info-internal
+		   (make-font-info
+		     :direction (member8-get 48 :left-to-right :right-to-left)
+		     :min-char min-char
+		     :max-char max-char
+		     :min-byte1 min-byte1
+		     :max-byte1 max-byte1
+		     :min-byte2 min-byte2
+		     :max-byte2 max-byte2
+		     :all-chars-exist-p (boolean-get 51)
+		     :default-char (card16-get 44)
+		     :ascent (int16-get 52)
+		     :descent (int16-get 54)
+		     :min-bounds (char-info-get 8)
+		     :max-bounds (char-info-get 24)
+		     :properties (sequence-get :length (index* 2 nfont-props)
+					       :format int32
+					       :result-type 'list
+					       :index 60)))))
+	  (setf (font-name font) (string-get name-len (index+ 60 (index* 2 nfont-props 4))))
+	  (push font result))
+	nil)))
+    ;; Replace atom id's with keywords in the plist
+    (dolist (font result)
+      (do ((p (font-properties font) (cddr p)))
+	  ((endp p))
+	(setf (car p) (atom-name display (car p)))))
+    (coerce (nreverse result) result-type)))
+
+(defun font-path (display &key (result-type 'list))
+  (declare (type display display)
+	   (type t result-type)) ;; CL type
+  (declare (values (sequence (or string pathname))))
+  (with-buffer-request-and-reply (display *x-getfontpath* size :sizes (8 16))
+       ()
+    (values
+      (read-sequence-string
+	buffer-bbuf (index- size *replysize*) (card16-get 8) result-type *replysize*))))
+
+(defun set-font-path (display paths)
+  (declare (type display display)
+	   (type sequence paths)) ;; (sequence (or string pathname))
+  (let ((path-length (length paths))
+	(request-length 8))
+    ;; Find the request length
+    (dotimes (i path-length)
+      (let* ((string (string (elt paths i)))
+	     (len (length string)))
+	(incf request-length (1+ len))))
+    (with-buffer-request (display *x-setfontpath* :length request-length)
+      (length (ceiling request-length 4))
+      (card16 path-length)
+      (pad16 nil)
+      (progn
+	(incf buffer-boffset 8)
+	(dotimes (i path-length)
+	  (let* ((string (string (elt paths i)))
+		 (len (length string)))
+	    (card8-put 0 len)
+	    (string-put 1 string :appending t :header-length 1)
+	    (incf buffer-boffset (1+ len))))
+	(setf (buffer-boffset display) (lround buffer-boffset)))))
+  paths)
+
+(defsetf font-path set-font-path)
diff --git a/src/clx/gcontext.lsp b/src/clx/gcontext.lsp
new file mode 100644
index 000000000..e2700d770
--- /dev/null
+++ b/src/clx/gcontext.lsp
@@ -0,0 +1,973 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;; GContext
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+;;;	GContext values are usually cached locally in the GContext object.
+;;;	This is required because the X.11 server doesn't have any requests
+;;;	for getting GContext values back.
+;;;
+;;;	GContext changes are cached until force-GContext-changes is called.
+;;;	All the requests that use GContext (including the GContext accessors,
+;;;	but not the SETF's) call force-GContext-changes.
+;;;	In addition, the macro WITH-GCONTEXT may be used to provide a 
+;;;	local view if a GContext.
+;;;
+;;;	Each GContext keeps a copy of the values the server has seen, and
+;;;	a copy altered by SETF, called the LOCAL-STATE (bad name...).
+;;;	The SETF accessors increment a timestamp in the GContext.
+;;;	When the timestamp in a GContext isn't equal to the timestamp in
+;;;	the local-state, changes have been made, and force-GContext-changes
+;;;	loops through the GContext and local-state, sending differences to
+;;;	the server, and updating GContext.
+;;;
+;;;	WITH-GCONTEXT works by BINDING the local-state slot in a GContext to
+;;;	a private copy.  This is easy (and fast) for lisp machines, but other
+;;;	lisps will have problems.  Fortunately, most other lisps don't care,
+;;;	because they don't run in a multi-processing shared-address space
+;;;	environment.
+
+(in-package :xlib)
+
+;; GContext state accessors
+;;	The state vector contains all card32s to speed server updating
+
+(eval-when (eval compile load)
+
+(defconstant *gcontext-fast-change-length* #.(length *gcontext-components*))
+
+(macrolet ((def-gc-internals (name &rest extras)
+	    (let ((macros nil)
+		  (indexes nil)
+		  (masks nil)
+		  (index 0))
+	      #+ecl (declare (type array-index index))
+	      (dolist (name *gcontext-components*)
+		(push `(defmacro ,(xintern 'gcontext-internal- name) (state)
+			 `(svref ,state ,,index))
+		      macros)
+		(setf (getf indexes name) index)
+		(push (ash 1 index) masks)
+		(incf index))
+	      (dolist (extra extras)
+		(push `(defmacro ,(xintern 'gcontext-internal- (first extra)) (state)
+			 `(svref ,state ,,index))
+		      macros)
+		;; don't override already correct index entries
+		(unless (or (getf indexes (second extra)) (getf indexes (first extra)))
+		  (setf (getf indexes (or (second extra) (first extra))) index))
+		(push (logior (ash 1 index)
+			      (if (second extra)
+				  (ash 1 (position (second extra) *gcontext-components*))
+				  0))
+		      masks)
+		(incf index))
+	      `(within-definition (def-gc-internals ,name)
+		 ,@(nreverse macros)
+		 (eval-when (eval compile load)
+		   (defconstant *gcontext-data-length* ,index)
+		   (defconstant *gcontext-indexes* ',indexes)
+		   (defconstant *gcontext-masks*
+				',(coerce (nreverse masks) 'simple-vector)))))))
+  (def-gc-internals ignore
+    (:clip :clip-mask) (:dash :dashes) (:font-obj :font) (:timestamp)))
+
+) ;; end EVAL-WHEN
+
+(deftype gcmask () '(unsigned-byte #.*gcontext-fast-change-length*))
+
+(deftype xgcmask () '(unsigned-byte #.*gcontext-data-length*))
+
+(defstruct (gcontext-extension (:type vector) (:copier nil)) ;; un-named
+  (name nil :type symbol :read-only t)
+  (default nil :type t :read-only t)
+  (set-function #'identity :type (function (gcontext t) t) :read-only t)
+  (copy-function #'identity :type (function (gcontext gcontext t) t) :read-only t))
+
+(defvar *gcontext-extensions* nil) ;; list of gcontext-extension
+
+;; Gcontext state Resource
+(defvar *gcontext-local-state-cache* nil) ;; List of unused gcontext local states
+
+(defmacro gcontext-state-next (state)
+  `(svref ,state 0))
+
+(defun allocate-gcontext-state ()
+  ;; Allocate a gcontext-state
+  ;; Loop until a local state is found that's large enough to hold
+  ;; any extensions that may exist.
+  (let ((length (index+ *gcontext-data-length* (length *gcontext-extensions*))))
+    (declare (type array-index length))
+    (loop
+      (let ((state (or (threaded-atomic-pop *gcontext-local-state-cache*
+					    gcontext-state-next gcontext-state)
+		       (make-array length :initial-element nil))))
+	(declare (type gcontext-state state))
+	(when (index>= (length state) length)
+	  (return state))))))
+
+(defun deallocate-gcontext-state (state)
+  (declare (type gcontext-state state))
+  (fill state nil)
+  (threaded-atomic-push state *gcontext-local-state-cache*
+			gcontext-state-next gcontext-state))
+
+;; Temp-Gcontext Resource
+(defvar *temp-gcontext-cache* nil) ;; List of unused gcontexts
+
+(defun allocate-temp-gcontext ()
+  (or (threaded-atomic-pop *temp-gcontext-cache* gcontext-next gcontext)
+      (make-gcontext :local-state '#() :server-state '#())))
+
+(defun deallocate-temp-gcontext (gc)
+  (declare (type gcontext gc))
+  (threaded-atomic-push gc *temp-gcontext-cache* gcontext-next gcontext))
+
+;; For each argument to create-gcontext (except clip-mask and clip-ordering) declared
+;; as (type <type> <name>), there is an accessor:
+
+;(defun gcontext-<name> (gcontext)
+;  ;; The value will be nil if the last value stored is unknown (e.g., the cache was
+;  ;; off, or the component was copied from a gcontext with unknown state).
+;  (declare (type gcontext gcontext)
+;	   (values <type>)))
+
+;; For each argument to create-gcontext (except clip-mask and clip-ordering) declared
+;; as (type (or null <type>) <name>), there is a setf for the corresponding accessor:
+
+;(defsetf gcontext-<name> (gcontext) (value)
+;  )
+
+;; Generate all the accessors and defsetf's for GContext
+
+(defmacro xgcmask->gcmask (mask)
+  `(the gcmask (logand ,mask #.(1- (ash 1 *gcontext-fast-change-length*)))))
+
+(defmacro access-gcontext ((gcontext local-state) &body body)
+  `(let ((,local-state (gcontext-local-state ,gcontext)))
+     (declare (type gcontext-state ,local-state))
+     ,@body))
+
+(defmacro modify-gcontext ((gcontext local-state) &body body)
+  ;; The timestamp must be altered after the modification
+  `(let ((,local-state (gcontext-local-state ,gcontext)))
+     (declare (type gcontext-state ,local-state))
+     (prog1
+	 (progn ,@body)
+       (setf (gcontext-internal-timestamp ,local-state) 0))))
+
+(defmacro def-gc-accessor (name type)
+  (let* ((gcontext-name (xintern 'gcontext- name))
+	 (internal-accessor (xintern 'gcontext-internal- name))
+	 (internal-setfer (xintern 'set- gcontext-name)))
+    `(within-definition (,name def-gc-accessor)
+
+       (defun ,gcontext-name (gcontext)
+	 (declare (type gcontext gcontext))
+	 (declare (values (or null ,type)))
+	 (let ((value (,internal-accessor (gcontext-local-state gcontext))))
+	   (declare (type (or null card32) value))
+	   (when value ;; Don't do anything when value isn't known
+	     (let ((%buffer (gcontext-display gcontext)))
+	       (declare (type display %buffer))
+	       %buffer
+	       (decode-type ,type value)))))
+       
+       (defun ,internal-setfer (gcontext value)
+	 (declare (type gcontext gcontext)
+		  (type ,type value))
+	 (modify-gcontext (gcontext local-state)
+	   (setf (,internal-accessor local-state) (encode-type ,type value))
+	   ,@(when (eq type 'pixmap)
+	       ;; write-through pixmaps, because the protocol allows
+	       ;; the server to copy the pixmap contents at the time
+	       ;; of the store, rather than continuing to share with
+	       ;; the pixmap.
+	       `((let ((server-state (gcontext-server-state gcontext)))
+		   (setf (,internal-accessor server-state) nil))))
+	   value))
+       
+       (defsetf ,gcontext-name ,internal-setfer))))
+
+(defmacro incf-internal-timestamp (state)
+  (let ((ts (gensym)))
+    `(let ((,ts (the fixnum (gcontext-internal-timestamp ,state))))
+       (declare (type fixnum ,ts))
+       ;; the probability seems low enough
+       (setq ,ts (if (= ,ts most-positive-fixnum)
+		     1
+		     (the fixnum (1+ ,ts))))
+       (setf (gcontext-internal-timestamp ,state) ,ts))))
+
+(def-gc-accessor function boole-constant)
+(def-gc-accessor plane-mask card32)
+(def-gc-accessor foreground card32)
+(def-gc-accessor background card32)
+(def-gc-accessor line-width card16)
+(def-gc-accessor line-style (member :solid :dash :double-dash))
+(def-gc-accessor cap-style (member :not-last :butt :round :projecting))
+(def-gc-accessor join-style (member :miter :round :bevel))
+(def-gc-accessor fill-style (member :solid :tiled :stippled :opaque-stippled))
+(def-gc-accessor fill-rule (member :even-odd :winding))
+(def-gc-accessor tile pixmap)
+(def-gc-accessor stipple pixmap)
+(def-gc-accessor ts-x int16) ;; Tile-Stipple-X-origin
+(def-gc-accessor ts-y int16) ;; Tile-Stipple-Y-origin
+;; (def-GC-accessor font font) ;; See below
+(def-gc-accessor subwindow-mode (member :clip-by-children :include-inferiors))
+(def-gc-accessor exposures (member :off :on))
+(def-gc-accessor clip-x int16)
+(def-gc-accessor clip-y int16)
+;; (def-GC-accessor clip-mask) ;; see below
+(def-gc-accessor dash-offset card16)
+;; (def-GC-accessor dashes)  ;; see below
+(def-gc-accessor arc-mode (member :chord :pie-slice))
+
+
+(defun gcontext-clip-mask (gcontext)
+  (declare (type gcontext gcontext))
+  (declare (values (or null (member :none) pixmap rect-seq)
+		   (or null (member :unsorted :y-sorted :yx-sorted :yx-banded))))
+  (access-gcontext (gcontext local-state)
+    (multiple-value-bind (clip clip-mask)
+	(without-interrupts
+	  (values (gcontext-internal-clip local-state)
+		  (gcontext-internal-clip-mask local-state)))
+      (if (null clip)
+	  (values (let ((%buffer (gcontext-display gcontext)))
+		    (declare (type display %buffer))
+		    (decode-type (or (member :none) pixmap) clip-mask))
+		  nil)
+	(values (second clip)
+		(decode-type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded))
+			     (first clip)))))))
+
+(defsetf gcontext-clip-mask (gcontext &optional ordering) (clip-mask)
+  ;; A bit strange, but retains setf form.
+  ;; a nil clip-mask is transformed to an empty vector
+  `(set-gcontext-clip-mask ,gcontext ,ordering ,clip-mask))
+
+(defun set-gcontext-clip-mask (gcontext ordering clip-mask)
+  ;; a nil clip-mask is transformed to an empty vector
+  (declare (type gcontext gcontext)
+	   (type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) ordering)
+	   (type (or (member :none) pixmap rect-seq) clip-mask))
+  (unless clip-mask (x-type-error clip-mask '(or (member :none) pixmap rect-seq)))
+  (multiple-value-bind (clip-mask clip)
+      (typecase clip-mask
+	(pixmap (values (pixmap-id clip-mask) nil))
+	((member :none) (values 0 nil))
+	(sequence
+	  (values nil
+		  (list (encode-type
+			  (or null (member :unsorted :y-sorted :yx-sorted :yx-banded))
+			  ordering)
+			(copy-seq clip-mask))))
+	(otherwise (x-type-error clip-mask '(or (member :none) pixmap rect-seq))))
+    (modify-gcontext (gcontext local-state)
+      (let ((server-state (gcontext-server-state gcontext)))
+	(declare (type gcontext-state server-state))
+	(without-interrupts
+	  (setf (gcontext-internal-clip local-state) clip
+		(gcontext-internal-clip-mask local-state) clip-mask)
+	  (if (null clip)
+	      (setf (gcontext-internal-clip server-state) nil)
+	    (setf (gcontext-internal-clip-mask server-state) nil))
+	  (when (and clip-mask (not (zerop clip-mask)))
+	    ;; write-through clip-mask pixmap, because the protocol allows the
+	    ;; server to copy the pixmap contents at the time of the store,
+	    ;; rather than continuing to share with the pixmap.
+	    (setf (gcontext-internal-clip-mask server-state) nil))))))
+  clip-mask)
+
+(defun gcontext-dashes (gcontext)
+  (declare (type gcontext gcontext))
+  (declare (values (or null card8 sequence)))
+  (access-gcontext (gcontext local-state)
+    (multiple-value-bind (dash dashes)
+	(without-interrupts 
+	  (values (gcontext-internal-dash local-state)
+		  (gcontext-internal-dashes local-state)))
+      (if (null dash)
+	  dashes
+	dash))))
+
+(defsetf gcontext-dashes set-gcontext-dashes)
+
+(defun set-gcontext-dashes (gcontext dashes)
+  (declare (type gcontext gcontext)
+	   (type (or card8 sequence) dashes))
+  (multiple-value-bind (dashes dash)
+      (if (type? dashes 'sequence)
+	  (if (zerop (length dashes))
+	      (x-type-error dashes '(or card8 sequence) "non-empty sequence")
+	    (values nil (or (copy-seq dashes) (vector))))
+	(values (encode-type card8 dashes) nil))
+    (modify-gcontext (gcontext local-state)
+      (let ((server-state (gcontext-server-state gcontext)))
+	(declare (type gcontext-state server-state))
+	(without-interrupts
+	  (setf (gcontext-internal-dash local-state) dash
+		(gcontext-internal-dashes local-state) dashes)
+	  (if (null dash)
+	      (setf (gcontext-internal-dash server-state) nil)
+	    (setf (gcontext-internal-dashes server-state) nil))))))
+  dashes)
+
+(defun gcontext-font (gcontext &optional metrics-p)
+  ;; If the stored font is known, it is returned.  If it is not known and
+  ;; metrics-p is false, then nil is returned.  If it is not known and
+  ;; metrics-p is true, then a pseudo font is returned.  Full metric and
+  ;; property information can be obtained, but the font does not have a name or
+  ;; a resource-id, and attempts to use it where a resource-id is required will
+  ;; result in an invalid-font error.
+  (declare (type gcontext gcontext)
+	   (type boolean metrics-p))
+  (declare (values (or null font)))
+  (access-gcontext (gcontext local-state)
+    (let ((font (gcontext-internal-font-obj local-state)))
+      (or font
+	  (when metrics-p
+	    ;; XXX this isn't correct
+	    (make-font :display (gcontext-display gcontext)
+		       :id (gcontext-id gcontext)
+		       :name nil))))))
+
+(defsetf gcontext-font set-gcontext-font)
+
+(defun set-gcontext-font (gcontext font)
+  (declare (type gcontext gcontext)
+	   (type fontable font))
+  (let* ((font-object (if (font-p font) font (open-font (gcontext-display gcontext) font)))
+	 (font (and font-object (font-id font-object))))
+    ;; XXX need to check font has id (and name?)
+    (modify-gcontext (gcontext local-state)
+      (let ((server-state (gcontext-server-state gcontext)))
+	(declare (type gcontext-state server-state))
+	(without-interrupts
+	  (setf (gcontext-internal-font-obj local-state) font-object
+		(gcontext-internal-font local-state) font)
+	  ;; check against font, not against font-obj
+	  (if (null font)
+	      (setf (gcontext-internal-font server-state) nil)
+	    (setf (gcontext-internal-font-obj server-state) font-object))))))
+  font)
+
+(defun force-gcontext-changes-internal (gcontext)
+  ;; Force any delayed changes.
+  (declare (type gcontext gcontext))
+  #.(declare-buffun)
+
+  (let ((display (gcontext-display gcontext))
+	(server-state (gcontext-server-state gcontext))
+	(local-state (gcontext-local-state gcontext)))
+    (declare (type display display)
+	     (type gcontext-state server-state local-state))
+
+    ;; Update server when timestamps don't match
+    (unless (= (the fixnum (gcontext-internal-timestamp local-state))
+	       (the fixnum (gcontext-internal-timestamp server-state)))
+
+      ;; The display is already locked.
+      (macrolet ((with-buffer ((buffer &key timeout) &body body)
+		   `(progn (progn ,buffer ,@(and timeout `(,timeout)) nil)
+			   ,@body)))
+
+	;; Because there is no locking on the local state we have to
+	;; assume that state will change and set timestamps up front,
+	;; otherwise by the time we figured out there were no changes
+	;; and tried to store the server stamp as the local stamp, the
+	;; local stamp might have since been modified.
+	(setf (gcontext-internal-timestamp local-state)
+	      (incf-internal-timestamp server-state))
+
+	(block no-changes
+	  (let ((last-request (buffer-last-request display)))
+	    (with-buffer-request (display *x-changegc*)
+	      (gcontext gcontext)
+	      (progn
+		(do ((i 0 (index+ i 1))
+		     (bit 1 (the xgcmask (ash bit 1)))
+		     (nbyte 12)
+		     (mask 0)
+		     (local 0))
+		    ((index>= i *gcontext-fast-change-length*)
+		     (when (zerop mask)
+		       ;; If nothing changed, restore last-request and quit
+		       (setf (buffer-last-request display)
+			     (if (zerop (buffer-last-request display))
+				 nil
+			       last-request))
+		       (return-from no-changes nil))
+		     (card29-put 8 mask)
+		     (card16-put 2 (index-ash nbyte -2))
+		     (index-incf (buffer-boffset display) nbyte))
+		  (declare (type array-index i nbyte)
+			   (type xgcmask bit)
+			   (type gcmask mask)
+			   (type (or null card32) local))
+		  (unless (eql (the (or null card32) (svref server-state i))
+			       (setq local (the (or null card32) (svref local-state i))))
+		    (setf (svref server-state i) local)
+		    (card32-put nbyte local)
+		    (setq mask (the gcmask (logior mask bit)))
+		    (index-incf nbyte 4)))))))
+
+	;; Update GContext extensions
+	(do ((extension *gcontext-extensions* (cdr extension))
+	     (i *gcontext-data-length* (index+ i 1))
+	     (local))
+	    ((endp extension))
+	  #+ecl (declare (type array-index i))
+	  (unless (eql (svref server-state i)
+		       (setq local (svref local-state i)))
+	    (setf (svref server-state i) local)
+	    (funcall (gcontext-extension-set-function (car extension)) gcontext local)))
+
+	;; Update clipping rectangles
+	(multiple-value-bind (local-clip server-clip)
+	    (without-interrupts 
+	      (values (gcontext-internal-clip local-state)
+		      (gcontext-internal-clip server-state)))
+	  (unless (equalp local-clip server-clip)
+	    (setf (gcontext-internal-clip server-state) nil)
+	    (unless (null local-clip)
+	      (with-buffer-request (display *x-setcliprectangles*)
+		(data (first local-clip))
+		(gcontext gcontext)
+		;; XXX treat nil correctly
+		(card16 (or (gcontext-internal-clip-x local-state) 0)
+			(or (gcontext-internal-clip-y local-state) 0))
+		;; XXX this has both int16 and card16 values
+		((sequence :format int16) (second local-clip)))
+	      (setf (gcontext-internal-clip server-state) local-clip))))
+
+	;; Update dashes
+	(multiple-value-bind (local-dash server-dash)
+	    (without-interrupts 
+	      (values (gcontext-internal-dash local-state)
+		      (gcontext-internal-dash server-state)))
+	  (unless (equalp local-dash server-dash)
+	    (setf (gcontext-internal-dash server-state) nil)
+	    (unless (null local-dash)
+	      (with-buffer-request (display *x-setdashes*)
+		(gcontext gcontext)
+		;; XXX treat nil correctly
+		(card16 (or (gcontext-internal-dash-offset local-state) 0)
+			(length local-dash))
+		((sequence :format card8) local-dash))
+	      (setf (gcontext-internal-dash server-state) local-dash))))))))
+
+(defun force-gcontext-changes (gcontext)
+  ;; Force any delayed changes.
+  (declare (type gcontext gcontext))
+  (let ((display (gcontext-display gcontext))
+	(server-state (gcontext-server-state gcontext))
+	(local-state (gcontext-local-state gcontext)))
+    (declare (type gcontext-state server-state local-state)
+	     (array-register server-state local-state))
+    ;; Update server when timestamps don't match
+    (unless (= (the fixnum (gcontext-internal-timestamp local-state))
+	       (the fixnum (gcontext-internal-timestamp server-state)))
+      (with-display (display)
+	(force-gcontext-changes-internal gcontext)))))
+
+;;; WARNING: WITH-GCONTEXT WORKS MUCH MORE EFFICIENTLY WHEN THE OPTIONS BEING "BOUND" ARE
+;;;	     SET IN THE GCONTEXT ON ENTRY.  BECAUSE THERE'S NO WAY TO GET THE VALUE OF AN
+;;;	     UNKNOWN GC COMPONENT, WITH-GCONTEXT MUST CREATE A TEMPORARY GC, COPY THE UNKNOWN
+;;;	     COMPONENTS TO THE TEMPORARY GC, ALTER THE GC BEING USED, THEN COPY COMPOMENTS
+;;;          BACK.
+
+(defmacro with-gcontext ((gcontext &rest options &key clip-ordering
+				   &allow-other-keys)
+			 &body body)
+  ;; "Binds" the gcontext components specified by options within the
+  ;; dynamic scope of the body (i.e., indefinite scope and dynamic
+  ;; extent), on a per-process basis in a multi-process environment.
+  ;; The body is not surrounded by a with-display.  If cache-p is nil or
+  ;; the some component states are unknown, this will implement
+  ;; save/restore by creating a temporary gcontext and doing
+  ;; copy-gcontext-components to and from it.
+
+  (declare (arglist (gcontext &rest options &key
+			     function plane-mask foreground background
+			     line-width line-style cap-style join-style
+			     fill-style fill-rule arc-mode tile stipple ts-x
+			     ts-y font subwindow-mode exposures clip-x clip-y
+			     clip-mask clip-ordering dash-offset dashes
+			     &allow-other-keys)
+		   &body body))
+  (remf options :clip-ordering)
+
+  (let ((gc (gensym))
+	(saved-state (gensym))
+	(temp-gc (gensym))
+	(temp-mask (gensym))
+	(temp-vars nil)
+	(setfs nil)
+	(indexes nil) ; List of gcontext field indices
+	(extension-indexes nil) ; List of gcontext extension field indices
+	(ts-index (getf *gcontext-indexes* :timestamp)))
+
+    (do* ((option options (cddr option))
+	  (name (car option) (car option))
+	  (value (cadr option) (cadr option)))
+	 ((endp option) (setq setfs (nreverse setfs)))
+      (let ((index (getf *gcontext-indexes* name)))
+	(if index
+	    (push index indexes)
+	  (let ((extension (find name *gcontext-extensions*
+				 :key #'gcontext-extension-name)))
+	    (if extension
+		(progn
+		  (push (xintern "Internal-" 'gcontext- name "-State-Index")
+			extension-indexes))
+	      (x-type-error name 'gcontext-key)))))
+      (let ((accessor `(,(xintern 'gcontext- name) ,gc
+			,@(when (eq name :clip-mask) `(,clip-ordering))))
+	    (temp-var (gensym)))
+	(when value
+	  (push `(,temp-var ,value) temp-vars)
+	  (push `(when ,temp-var (setf ,accessor ,temp-var)) setfs))))
+    (if setfs
+	`(multiple-value-bind (,gc ,saved-state ,temp-mask ,temp-gc)
+	     (copy-gcontext-local-state ,gcontext ',indexes ,@extension-indexes)
+	   (declare (type gcontext ,gc)
+		    (type gcontext-state ,saved-state)
+		    (type xgcmask ,temp-mask)
+		    (type (or null resource-id) ,temp-gc))
+	   (with-gcontext-bindings (,gc ,saved-state
+					,(append indexes extension-indexes)
+				    ,ts-index ,temp-mask ,temp-gc)
+	     (let ,temp-vars
+	       ,@setfs)
+	     ,@body))
+      `(progn ,@body))))
+
+(defun copy-gcontext-local-state (gcontext indexes &rest extension-indices)
+  ;; Called from WITH-GCONTEXT to save the fields in GCONTEXT indicated by MASK
+  (declare (type gcontext gcontext)
+	   (type list indexes)
+	   (dynamic-extent extension-indices))
+  (let ((local-state (gcontext-local-state gcontext))
+	(saved-state (allocate-gcontext-state))
+	(cache-p (gcontext-cache-p gcontext)))
+    (declare (type gcontext-state local-state saved-state))
+    (setf (gcontext-internal-timestamp saved-state) 1)
+    (let ((temp-gc nil)
+	  (temp-mask 0)
+	  (extension-mask 0))
+      (declare (type xgcmask temp-mask)
+	       (type integer extension-mask))
+      (dolist (i indexes)
+	(when (or (not (setf (svref saved-state i) (svref local-state i)))
+		  (not cache-p))
+	  (setq temp-mask
+		(the xgcmask (logior temp-mask
+				     (the xgcmask (svref *gcontext-masks* i)))))))
+      (dolist (i extension-indices)
+	#+ecl (declare (type array-index i))
+	(when (or (not (setf (svref saved-state i) (svref local-state i)))
+		  (not cache-p))
+	  (setq extension-mask
+		(the xgcmask (logior extension-mask (ash 1 i))))))
+      (when (or (plusp temp-mask)
+		(plusp extension-mask))
+	;; Copy to temporary GC when field unknown or cache-p false
+	(let ((display (gcontext-display gcontext)))
+	  (declare (type display display))
+	  (with-display (display)
+	    (setq temp-gc (allocate-temp-gcontext))
+	    (setf (gcontext-id temp-gc) (allocate-resource-id display gcontext 'gcontext)
+		  (gcontext-display temp-gc) display
+		  (gcontext-drawable temp-gc) (gcontext-drawable gcontext)
+		  (gcontext-server-state temp-gc) saved-state
+		  (gcontext-local-state temp-gc) saved-state)
+	    ;; Create a new (temporary) gcontext
+	    (with-buffer-request (display *x-creategc*)
+	      (gcontext temp-gc)
+	      (drawable (gcontext-drawable gcontext))
+	      (card29 0))
+	    ;; Copy changed components to the temporary gcontext
+	    (when (plusp temp-mask)
+	      (with-buffer-request (display *x-copygc*)
+		(gcontext gcontext)
+		(gcontext temp-gc)
+		(card29 (xgcmask->gcmask temp-mask))))
+	    ;; Copy extension fields to the new gcontext
+	    (when (plusp extension-mask)
+	      ;; Copy extension fields from temp back to gcontext
+	      (do ((bit (ash extension-mask (- *gcontext-data-length*)) (ash bit -1))
+		   (i 0 (index+ i 1)))
+		  ((zerop bit))
+		#+ecl (declare (type array-index i))
+		(let ((copy-function (gcontext-extension-copy-function
+				       (elt *gcontext-extensions* i))))
+		  (funcall copy-function gcontext temp-gc
+			   (svref local-state (index+ i *gcontext-data-length*))))))
+	    )))
+      (values gcontext saved-state (logior temp-mask extension-mask) temp-gc)))) 
+
+(defun restore-gcontext-temp-state (gcontext temp-mask temp-gc)
+  (declare (type gcontext gcontext temp-gc)
+	   (type xgcmask temp-mask))
+  (let ((display (gcontext-display gcontext)))
+    (declare (type display display))
+    (with-display (display)
+      (with-buffer-request (display *x-copygc*)
+	(gcontext temp-gc)
+	(gcontext gcontext)
+	(card29 (xgcmask->gcmask temp-mask)))
+      ;; Copy extension fields from temp back to gcontext
+      (do ((bit (ash temp-mask (- *gcontext-data-length*)) (ash bit -1))
+	   (extensions *gcontext-extensions* (cdr extensions))
+	   (i *gcontext-data-length* (index+ i 1))
+	   (local-state (gcontext-local-state temp-gc)))
+	  ((zerop bit))
+	#+ecl (declare (type array-index i))
+	(let ((copy-function (gcontext-extension-copy-function (car extensions))))
+	  (funcall copy-function temp-gc gcontext (svref local-state i))))
+      ;; free gcontext
+      (with-buffer-request (display *x-freegc*)
+	(gcontext temp-gc))
+      (deallocate-resource-id display (gcontext-id temp-gc) 'gcontext)
+      (deallocate-temp-gcontext temp-gc)
+      ;; Copy saved state back to server state
+      (do ((server-state (gcontext-server-state gcontext))
+	   (bit (xgcmask->gcmask temp-mask) (the gcmask (ash bit -1)))
+	   (i 0 (index+ i 1)))
+	  ((zerop bit)
+	   (incf-internal-timestamp server-state))
+	(declare (type gcontext-state server-state)
+		 (type gcmask bit)
+		 (type array-index i))
+	(when (oddp bit)
+	  (setf (svref server-state i) nil))))))
+
+(defun create-gcontext (&rest options &key (drawable (required-arg drawable))
+			function plane-mask foreground background
+			line-width line-style cap-style join-style fill-style fill-rule
+			arc-mode tile stipple ts-x ts-y font subwindow-mode
+			exposures clip-x clip-y clip-mask clip-ordering
+			dash-offset dashes
+			(cache-p t)
+			&allow-other-keys)
+  ;; Only non-nil components are passed on in the request, but for effective caching
+  ;; assumptions have to be made about what the actual protocol defaults are.  For
+  ;; all gcontext components, a value of nil causes the default gcontext value to be
+  ;; used.  For clip-mask, this implies that an empty rect-seq cannot be represented
+  ;; as a list.  Note:  use of stringable as font will cause an implicit open-font.
+  ;; Note:  papers over protocol SetClipRectangles and SetDashes special cases.  If
+  ;; cache-p is true, then gcontext state is cached locally, and changing a gcontext
+  ;; component will have no effect unless the new value differs from the cached
+  ;; value.  Component changes (setfs and with-gcontext) are always deferred
+  ;; regardless of the cache mode, and sent over the protocol only when required by a
+  ;; local operation or by an explicit call to force-gcontext-changes.
+  (declare (type drawable drawable) ; Required to be non-null
+	   (type (or null boole-constant) function)
+	   (type (or null pixel) plane-mask foreground background)
+	   (type (or null card16) line-width dash-offset)
+	   (type (or null int16) ts-x ts-y clip-x clip-y)
+	   (type (or null (member :solid :dash :double-dash)) line-style)
+	   (type (or null (member :not-last :butt :round :projecting)) cap-style)
+	   (type (or null (member :miter :round :bevel)) join-style)
+	   (type (or null (member :solid :tiled :opaque-stippled :stippled)) fill-style)
+	   (type (or null (member :even-odd :winding)) fill-rule)
+	   (type (or null (member :chord :pie-slice)) arc-mode)
+	   (type (or null pixmap) tile stipple)
+	   (type (or null fontable) font)
+	   (type (or null (member :clip-by-children :include-inferiors)) subwindow-mode)
+	   (type (or null (member :on :off)) exposures)
+	   (type (or null (member :none) pixmap rect-seq) clip-mask)
+	   (type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering)
+	   (type (or null card8 sequence) dashes)
+	   (dynamic-extent options)
+	   (type boolean cache-p))
+  (declare (values gcontext))
+  (let* ((display (drawable-display drawable))
+	 (gcontext (make-gcontext :display display :drawable drawable :cache-p cache-p))
+	 (local-state (gcontext-local-state gcontext))
+	 (server-state (gcontext-server-state gcontext))
+	 (gcontextid (allocate-resource-id display gcontext 'gcontext)))
+    (declare (type display display)
+	     (type gcontext gcontext)
+	     (type resource-id gcontextid)
+	     (type gcontext-state local-state server-state))
+    (setf (gcontext-id gcontext) gcontextid)
+
+    (unless function (setf (gcontext-function gcontext) boole-1))
+    ;; using the depth of the drawable would be better, but ...
+    (unless plane-mask (setf (gcontext-plane-mask gcontext) #xffffffff))
+    (unless foreground (setf (gcontext-foreground gcontext) 0))
+    (unless background (setf (gcontext-background gcontext) 1))
+    (unless line-width (setf (gcontext-line-width gcontext) 0))
+    (unless line-style (setf (gcontext-line-style gcontext) :solid))
+    (unless cap-style (setf (gcontext-cap-style gcontext) :butt))
+    (unless join-style (setf (gcontext-join-style gcontext) :miter))
+    (unless fill-style (setf (gcontext-fill-style gcontext) :solid))
+    (unless fill-rule (setf (gcontext-fill-rule gcontext) :even-odd))
+    (unless arc-mode (setf (gcontext-arc-mode gcontext) :pie-slice))
+    (unless ts-x (setf (gcontext-ts-x gcontext) 0))
+    (unless ts-y (setf (gcontext-ts-y gcontext) 0))
+    (unless subwindow-mode (setf (gcontext-subwindow-mode gcontext)
+				 :clip-by-children))
+    (unless exposures (setf (gcontext-exposures gcontext) :on))
+    (unless clip-mask (setf (gcontext-clip-mask gcontext) :none))
+    (unless clip-x (setf (gcontext-clip-x gcontext) 0))
+    (unless clip-y (setf (gcontext-clip-y gcontext) 0))
+    (unless dashes (setf (gcontext-dashes gcontext) 4))
+    (unless dash-offset (setf (gcontext-dash-offset gcontext) 0))
+    ;; a bit kludgy, but ...
+    (replace server-state local-state)
+
+    (when function (setf (gcontext-function gcontext) function))
+    (when plane-mask (setf (gcontext-plane-mask gcontext) plane-mask))
+    (when foreground (setf (gcontext-foreground gcontext) foreground))
+    (when background (setf (gcontext-background gcontext) background))
+    (when line-width (setf (gcontext-line-width gcontext) line-width))
+    (when line-style (setf (gcontext-line-style gcontext) line-style))
+    (when cap-style (setf (gcontext-cap-style gcontext) cap-style))
+    (when join-style (setf (gcontext-join-style gcontext) join-style))
+    (when fill-style (setf (gcontext-fill-style gcontext) fill-style))
+    (when fill-rule (setf (gcontext-fill-rule gcontext) fill-rule))
+    (when arc-mode (setf (gcontext-arc-mode gcontext) arc-mode))
+    (when tile (setf (gcontext-tile gcontext) tile))
+    (when stipple (setf (gcontext-stipple gcontext) stipple))
+    (when ts-x (setf (gcontext-ts-x gcontext) ts-x))
+    (when ts-y (setf (gcontext-ts-y gcontext) ts-y))
+    (when font (setf (gcontext-font gcontext) font))
+    (when subwindow-mode (setf (gcontext-subwindow-mode gcontext) subwindow-mode))
+    (when exposures (setf (gcontext-exposures gcontext) exposures))
+    (when clip-x (setf (gcontext-clip-x gcontext) clip-x))
+    (when clip-y (setf (gcontext-clip-y gcontext) clip-y))
+    (when clip-mask (setf (gcontext-clip-mask gcontext clip-ordering) clip-mask))
+    (when dash-offset (setf (gcontext-dash-offset gcontext) dash-offset))
+    (when dashes (setf (gcontext-dashes gcontext) dashes))
+    
+    (setf (gcontext-internal-timestamp server-state) 1)
+    (setf (gcontext-internal-timestamp local-state)
+	  ;; SetClipRectangles or SetDashes request need to be sent?
+	  (if (or (gcontext-internal-clip local-state)
+		  (gcontext-internal-dash local-state))
+	      ;; Yes, mark local state "modified" to ensure
+	      ;; force-gcontext-changes will occur.
+	      0
+	    ;; No, mark local state "unmodified"
+	    1))
+    
+    (with-buffer-request (display *x-creategc*)
+      (resource-id gcontextid)
+      (drawable drawable)
+      (progn (do* ((i 0 (index+ i 1))
+		   (bit 1 (the xgcmask (ash bit 1)))
+		   (nbyte 16)
+		   (mask 0)
+		   (local (svref local-state i) (svref local-state i)))
+		 ((index>= i *gcontext-fast-change-length*)
+		  (card29-put 12 mask)
+		  (card16-put 2 (index-ash nbyte -2))
+		  (index-incf (buffer-boffset display) nbyte))
+	       (declare (type array-index i nbyte)
+			(type xgcmask bit)
+			(type gcmask mask)
+			(type (or null card32) local))
+	       (unless (eql local (the (or null card32) (svref server-state i)))
+		 (setf (svref server-state i) local)
+		 (card32-put nbyte local)
+		 (setq mask (the gcmask (logior mask bit)))
+		 (index-incf nbyte 4)))))
+
+    ;; Initialize extensions
+    (do ((extensions *gcontext-extensions* (cdr extensions))
+	 (i *gcontext-data-length* (index+ i 1)))
+	((endp extensions))
+      (declare (type list extensions)
+	       (type array-index i))
+      (setf (svref server-state i)
+	    (setf (svref local-state i)
+		  (gcontext-extension-default (car extensions)))))
+
+    ;; Set extension values
+    (do* ((option-list options (cddr option-list))
+	  (option (car option-list) (car option-list))
+	  (extension))
+	 ((endp option-list))
+      (declare (type list option-list))
+      (cond ((getf *gcontext-indexes* option))	; Gcontext field
+	    ((member option '(:drawable :clip-ordering :cache-p)))	; Optional parameter
+	    ((setq extension (find option *gcontext-extensions*
+				   :key #'gcontext-extension-name))
+	     (funcall (gcontext-extension-set-function extension)
+		      gcontext (second option-list)))
+	    (t (x-type-error option 'gcontext-key))))
+    gcontext)) 
+
+(defun copy-gcontext-components (src dst &rest keys)
+  (declare (type gcontext src dst)
+	   (dynamic-extent keys))
+  ;; you might ask why this isn't just a bunch of
+  ;;   (setf (gcontext-<mumble> dst) (gcontext-<mumble> src))
+  ;; the answer is that you can do that yourself if you want, what we are
+  ;; providing here is access to the protocol request, which will generally
+  ;; be more efficient (particularly for things like clip and dash lists).
+  (when keys
+    (let ((display (gcontext-display src))
+	  (mask 0))
+      (declare (type xgcmask mask))
+      (with-display (display)
+	(force-gcontext-changes-internal src)
+	(force-gcontext-changes-internal dst)
+	
+	;; collect entire mask and handle extensions
+	(dolist (key keys)
+	  (let ((i (getf *gcontext-indexes* key)))
+	    (declare (type (or null array-index) i))
+	    (if i
+		(setq mask (the xgcmask (logior mask
+						(the xgcmask (svref *gcontext-masks* i)))))
+	      (multiple-value-bind (extension index)
+		  (find key *gcontext-extensions* :key #'gcontext-extension-name)
+		(if extension
+		    (funcall (gcontext-extension-copy-function extension)
+			     src dst (svref (gcontext-local-state src)
+					    (index+ index *gcontext-data-length*)))
+		  (x-type-error key 'gcontext-key))))))
+	
+	(when (plusp mask)
+	  (do ((src-server-state (gcontext-server-state src))
+	       (dst-server-state (gcontext-server-state dst))
+	       (dst-local-state (gcontext-local-state dst))
+	       (bit mask (the xgcmask (ash bit -1)))
+	       (i 0 (index+ i 1)))
+	      ((zerop bit)
+	       (incf-internal-timestamp dst-server-state)
+	       (setf (gcontext-internal-timestamp dst-local-state) 0))
+	    (declare (type gcontext-state src-server-state dst-server-state dst-local-state)
+		     (type xgcmask bit)
+		     (type array-index i))
+	    (when (oddp bit)
+	      (setf (svref dst-local-state i)
+		    (setf (svref dst-server-state i) (svref src-server-state i)))))
+	  (with-buffer-request (display *x-copygc*)
+	    (gcontext src dst)
+	    (card29 (xgcmask->gcmask mask))))))))
+
+(defun copy-gcontext (src dst)
+  (declare (type gcontext src dst))
+  ;; Copies all components.
+  (apply #'copy-gcontext-components src dst *gcontext-components*)
+  (do ((extensions *gcontext-extensions* (cdr extensions))
+       (i *gcontext-data-length* (index+ i 1)))
+      ((endp extensions))
+      #+ecl (declare (type array-index i))
+    (funcall (gcontext-extension-copy-function (car extensions))
+	     src dst (svref (gcontext-local-state src) i))))
+	   
+(defun free-gcontext (gcontext)
+  (declare (type gcontext gcontext))
+  (let ((display (gcontext-display gcontext)))
+    (with-buffer-request (display *x-freegc*)
+      (gcontext gcontext))
+    (deallocate-resource-id display (gcontext-id gcontext) 'gcontext)
+    (deallocate-gcontext-state (gcontext-server-state gcontext))
+    (deallocate-gcontext-state (gcontext-local-state gcontext))
+    nil))
+
+(defmacro define-gcontext-accessor (name &key default set-function copy-function)
+  ;; This will define a new gcontext accessor called NAME.
+  ;; Defines the gcontext-NAME accessor function and its defsetf.
+  ;; Gcontext's will cache DEFAULT-VALUE and the last value SETF'ed when
+  ;; gcontext-cache-p is true.  The NAME keyword will be allowed in
+  ;; CREATE-GCONTEXT, WITH-GCONTEXT, and COPY-GCONTEXT-COMPONENTS.
+  ;; SET-FUNCTION will be called with parameters (GCONTEXT NEW-VALUE)
+  ;; from create-gcontext, and force-gcontext-changes.
+  ;; COPY-FUNCTION will be called with parameters (src-gc dst-gc src-value)
+  ;; from copy-gcontext and copy-gcontext-components.
+  ;; The copy-function defaults to:
+  ;; (lambda (ignore dst-gc value)
+  ;;    (if value
+  ;;	    (,set-function dst-gc value)
+  ;;	  (error "Can't copy unknown GContext component ~a" ',name)))
+  (declare (type symbol name)
+	   (type t default)
+	   (type (function (gcontext t) t) set-function) ;; required
+	   (type (or null (function (gcontext gcontext t) t))
+		 copy-function))
+  (let* ((gc-name (intern (concatenate 'string
+				       (string 'gcontext-)
+				       (string name)))) ;; in current package
+	 (key-name (kintern name))
+	 (setfer (xintern "Set-" gc-name))
+	 (internal-set-function (xintern "Internal-Set-" gc-name))
+	 (internal-copy-function (xintern "Internal-Copy-" gc-name))
+	 (internal-state-index (xintern "Internal-" gc-name "-State-Index")))
+    (unless copy-function
+      (setq copy-function
+	    `(lambda (src-gc dst-gc value)
+	       (declare (ignore src-gc))
+	       (if value
+		   (,set-function dst-gc value)
+		 (error "Can't copy unknown GContext component ~a" ',name)))))
+    `(progn
+       (eval-when (compile load eval)
+	 (defparameter ,internal-state-index
+		       (add-gcontext-extension ',key-name ,default ',internal-set-function
+					       ',internal-copy-function))
+	 ) ;; end eval-when
+       (defun ,gc-name (gcontext)
+	 (svref (gcontext-local-state gcontext) ,internal-state-index))
+       (defun ,setfer (gcontext new-value)
+	 (let ((local-state (gcontext-local-state gcontext)))
+	   (setf (gcontext-internal-timestamp local-state) 0)
+	   (setf (svref local-state ,internal-state-index) new-value)))
+       (defsetf ,gc-name ,setfer)
+       (defun ,internal-set-function (gcontext new-value)
+	 (,set-function gcontext new-value)
+	 (setf (svref (gcontext-server-state gcontext) ,internal-state-index)
+	       (setf (svref (gcontext-local-state gcontext) ,internal-state-index)
+		     new-value)))
+       (defun ,internal-copy-function (src-gc dst-gc new-value)
+	 (,copy-function src-gc dst-gc new-value)
+	 (setf (svref (gcontext-local-state dst-gc) ,internal-state-index)
+	       (setf (svref (gcontext-server-state dst-gc) ,internal-state-index)
+		     new-value)))
+       ',name)))
+
+;; GContext extension fields are treated in much the same way as normal GContext
+;; components.  The current value is stored in a slot of the gcontext-local-state,
+;; and the value known to the server is in a slot of the gcontext-server-state.
+;; The slot-number is defined by its position in the *gcontext-extensions* list.
+;; The value of the special variable |Internal-GCONTEXT-name| (where "name" is 
+;; the extension component name) reflects this position.  The position within
+;; *gcontext-extensions* and the value of the special value are determined at
+;; LOAD time to facilitate merging of seperately compiled extension files.
+
+(defun add-gcontext-extension (name default-value set-function copy-function)
+  (declare (type symbol name)
+	   (type t default-value)
+	   (type (function (gcontext t) t) set-function)
+	   (type (function (gcontext gcontext t) t) copy-function))
+  (let ((number (or (position name *gcontext-extensions* :key #'gcontext-extension-name)
+		    (prog1 (length *gcontext-extensions*)
+			   (push nil *gcontext-extensions*)))))
+    (setf (nth number *gcontext-extensions*)
+	  (make-gcontext-extension :name name
+				   :default default-value
+				   :set-function set-function
+				   :copy-function copy-function))
+    (+ number *gcontext-data-length*)))
diff --git a/src/clx/graphics.lsp b/src/clx/graphics.lsp
new file mode 100644
index 000000000..1d354f44e
--- /dev/null
+++ b/src/clx/graphics.lsp
@@ -0,0 +1,447 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;; CLX drawing requests
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+(defvar *inhibit-appending* nil)
+
+(defun draw-point (drawable gcontext x y)
+  ;; Should be clever about appending to existing buffered protocol request.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y))
+  (let ((display (drawable-display drawable)))
+    (declare (type display display))
+    (with-display (display)
+      (force-gcontext-changes-internal gcontext)
+      (with-buffer-output (display :length *requestsize*)
+	(let* ((last-request-byte (display-last-request display))
+	       (current-boffset buffer-boffset))
+	  ;; To append or not append, that is the question
+	  (if (and (not *inhibit-appending*)
+		   last-request-byte
+		   ;; Same request?
+		   (= (aref-card8 buffer-bbuf last-request-byte) *x-polypoint*)
+		   (progn ;; Set buffer pointers to last request
+		     (set-buffer-offset last-request-byte)
+		     ;; same drawable and gcontext?
+		     (or (compare-request (4)
+			   (data 0)
+			   (drawable drawable)
+			   (gcontext gcontext))
+			 (progn ;; If failed, reset buffer pointers
+			   (set-buffer-offset current-boffset)
+			   nil))))
+	      ;; Append request
+	      (progn
+		;; Set new request length		
+		(card16-put 2 (index+ 1 (index-ash (index- current-boffset last-request-byte)
+						   -2)))
+		(set-buffer-offset current-boffset)
+		(put-items (0)			; Insert new point
+		  (int16 x y))
+		(setf (display-boffset display) (index+ buffer-boffset 4)))
+	    ;; New Request
+	    (progn
+	      (put-items (4)
+		(code *x-polypoint*)
+		(data 0) ;; Relative-p false
+		(length 4)
+		(drawable drawable)
+		(gcontext gcontext)
+		(int16 x y))
+	      (buffer-new-request-number display)
+	      (setf (buffer-last-request display) buffer-boffset)
+	      (setf (display-boffset display) (index+ buffer-boffset 16)))))))
+    (display-invoke-after-function display))) 
+
+
+(defun draw-points (drawable gcontext points &optional relative-p)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type sequence points)		;(repeat-seq (integer x) (integer y))
+	   (type boolean relative-p))
+  (with-buffer-request ((drawable-display drawable) *x-polypoint* :gc-force gcontext)
+    ((data boolean) relative-p)
+    (drawable drawable)
+    (gcontext gcontext)
+    ((sequence :format int16) points)))
+
+(defun draw-line (drawable gcontext x1 y1 x2 y2 &optional relative-p)
+  ;; Should be clever about appending to existing buffered protocol request.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x1 y1 x2 y2)
+	   (type boolean relative-p))
+  (let ((display (drawable-display drawable)))
+    (declare (type display display))
+    (when relative-p
+      (incf x2 x1)
+      (incf y2 y1))
+    (with-display (display)
+      (force-gcontext-changes-internal gcontext)
+      (with-buffer-output (display :length *requestsize*)
+	(let* ((last-request-byte (display-last-request display))
+	       (current-boffset buffer-boffset))
+	  ;; To append or not append, that is the question
+	  (if (and (not *inhibit-appending*)
+		   last-request-byte
+		   ;; Same request?
+		   (= (aref-card8 buffer-bbuf last-request-byte) *x-polysegment*)
+		   (progn ;; Set buffer pointers to last request
+		     (set-buffer-offset last-request-byte)
+		     ;; same drawable and gcontext?
+		     (or (compare-request (4)
+			   (drawable drawable)
+			   (gcontext gcontext))
+			 (progn ;; If failed, reset buffer pointers
+			   (set-buffer-offset current-boffset)
+			   nil))))
+	      ;; Append request
+	      (progn
+		;; Set new request length
+		(card16-put 2 (index+ 2 (index-ash (index- current-boffset last-request-byte)
+						   -2)))
+		(set-buffer-offset current-boffset)
+		(put-items (0)			; Insert new point
+		  (int16 x1 y1 x2 y2))
+		(setf (display-boffset display) (index+ buffer-boffset 8)))
+	    ;; New Request
+	    (progn
+	      (put-items (4)
+		(code *x-polysegment*)
+		(length 5)
+		(drawable drawable)
+		(gcontext gcontext)
+		(int16 x1 y1 x2 y2))
+	      (buffer-new-request-number display)
+	      (setf (buffer-last-request display) buffer-boffset)
+	      (setf (display-boffset display) (index+ buffer-boffset 20)))))))
+    (display-invoke-after-function display))) 
+
+(defun draw-lines (drawable gcontext points &key relative-p fill-p (shape :complex))
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type sequence points) ;(repeat-seq (integer x) (integer y))
+	   (type boolean relative-p fill-p)
+	   (type (member :complex :non-convex :convex) shape))
+  (if fill-p
+      (fill-polygon drawable gcontext points relative-p shape)
+    (with-buffer-request ((drawable-display drawable)  *x-polyline* :gc-force gcontext)
+      ((data boolean) relative-p)
+      (drawable drawable)
+      (gcontext gcontext)
+      ((sequence :format int16) points))))
+
+;; Internal function called from DRAW-LINES
+(defun fill-polygon (drawable gcontext points relative-p shape)
+  ;; This is clever about appending to previous requests.  Should it be?
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type sequence points)		;(repeat-seq (integer x) (integer y))
+	   (type boolean relative-p)
+	   (type (member :complex :non-convex :convex) shape))
+  (with-buffer-request ((drawable-display drawable)  *x-fillpoly* :gc-force gcontext)
+    (drawable drawable)
+    (gcontext gcontext)
+    ((member8 :complex :non-convex :convex) shape)
+    (boolean relative-p)
+    ((sequence :format int16) points)))
+
+(defun draw-segments (drawable gcontext segments)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   ;; (repeat-seq (integer x1) (integer y1) (integer x2) (integer y2)))
+	   (type sequence segments)) 
+  (with-buffer-request ((drawable-display drawable) *x-polysegment* :gc-force gcontext)
+    (drawable drawable)
+    (gcontext gcontext)
+    ((sequence :format int16) segments)))
+
+(defun draw-rectangle (drawable gcontext x y width height &optional fill-p)
+  ;; Should be clever about appending to existing buffered protocol request.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type boolean fill-p))
+  (let ((display (drawable-display drawable))
+	(request (if fill-p *x-polyfillrectangle* *x-polyrectangle*)))
+    (declare (type display display)
+	     (type card16 request))
+    (with-display (display)
+      (force-gcontext-changes-internal gcontext)
+      (with-buffer-output (display :length *requestsize*)
+	(let* ((last-request-byte (display-last-request display))
+	       (current-boffset buffer-boffset))
+	  ;; To append or not append, that is the question
+	  (if (and (not *inhibit-appending*)
+		   last-request-byte
+		   ;; Same request?
+		   (= (aref-card8 buffer-bbuf last-request-byte) request)
+		   (progn ;; Set buffer pointers to last request
+		     (set-buffer-offset last-request-byte)
+		     ;; same drawable and gcontext?
+		     (or (compare-request (4)
+			   (drawable drawable)
+			   (gcontext gcontext))
+			 (progn ;; If failed, reset buffer pointers
+			   (set-buffer-offset current-boffset)
+			   nil))))
+	      ;; Append request
+	      (progn
+		;; Set new request length
+		(card16-put 2 (index+ 2 (index-ash (index- current-boffset last-request-byte)
+						   -2)))
+		(set-buffer-offset current-boffset)
+		(put-items (0)			; Insert new point
+		  (int16 x y)
+		  (card16 width height))
+		(setf (display-boffset display) (index+ buffer-boffset 8)))
+	    ;; New Request
+	    (progn
+	      (put-items (4)
+		(code request)
+		(length 5)
+		(drawable drawable)
+		(gcontext gcontext)
+		(int16 x y)
+		(card16 width height))
+	      (buffer-new-request-number display)
+	      (setf (buffer-last-request display) buffer-boffset)
+	      (setf (display-boffset display) (index+ buffer-boffset 20)))))))
+    (display-invoke-after-function display))) 
+
+(defun draw-rectangles (drawable gcontext rectangles &optional fill-p)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   ;; (repeat-seq (integer x) (integer y) (integer width) (integer height)))
+	   (type sequence rectangles)
+	   (type boolean fill-p))
+  (with-buffer-request ((drawable-display drawable)
+			(if fill-p *x-polyfillrectangle* *x-polyrectangle*)
+			:gc-force gcontext)
+    (drawable drawable)
+    (gcontext gcontext)
+    ((sequence :format int16) rectangles)))
+
+(defun draw-arc (drawable gcontext x y width height angle1 angle2 &optional fill-p)
+  ;; Should be clever about appending to existing buffered protocol request.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type angle angle1 angle2)
+	   (type boolean fill-p))
+  (let ((display (drawable-display drawable))
+	(request (if fill-p *x-polyfillarc* *x-polyarc*)))
+    (declare (type display display)
+	     (type card16 request))
+    (with-display (display)
+      (force-gcontext-changes-internal gcontext)
+      (with-buffer-output (display :length *requestsize*)
+	(let* ((last-request-byte (display-last-request display))
+	       (current-boffset buffer-boffset))
+	  ;; To append or not append, that is the question
+	  (if (and (not *inhibit-appending*)
+		   last-request-byte
+		   ;; Same request?
+		   (= (aref-card8 buffer-bbuf last-request-byte) request)
+		   (progn ;; Set buffer pointers to last request
+		     (set-buffer-offset last-request-byte)
+		     ;; same drawable and gcontext?
+		     (or (compare-request (4)
+			   (drawable drawable)
+			   (gcontext gcontext))
+			 (progn ;; If failed, reset buffer pointers
+			   (set-buffer-offset current-boffset)
+			   nil))))
+	      ;; Append request
+	      (progn
+		;; Set new request length		
+		(card16-put 2 (index+ 3 (index-ash (index- current-boffset last-request-byte)
+						   -2)))
+		(set-buffer-offset current-boffset)
+		(put-items (0)			; Insert new point
+		  (int16 x y)
+		  (card16 width height)
+		  (angle angle1 angle2))
+		(setf (display-boffset display) (index+ buffer-boffset 12)))
+	    ;; New Request
+	    (progn
+	      (put-items (4)
+		(code request)
+		(length 6)
+		(drawable drawable)
+		(gcontext gcontext)
+		(int16 x y)
+		(card16 width height)
+		(angle angle1 angle2))
+	      (buffer-new-request-number display)
+	      (setf (buffer-last-request display) buffer-boffset)
+	      (setf (display-boffset display) (index+ buffer-boffset 24)))))))
+    (display-invoke-after-function display))) 
+
+(defun draw-arcs-list (drawable gcontext arcs &optional fill-p)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type list arcs) 
+	   (type boolean fill-p))
+  (let* ((display (drawable-display drawable))
+	 (limit (index- (buffer-size display) 12))
+	 (length (length arcs))
+	 (request (if fill-p *x-polyfillarc* *x-polyarc*)))
+    (with-buffer-request ((drawable-display drawable) request :gc-force gcontext)
+      (drawable drawable)
+      (gcontext gcontext)
+      (progn
+	(card16-put 2 (index+ (index-ash length -1) 3))	; Set request length (in words)
+	(set-buffer-offset (index+ buffer-boffset 12))  ; Position to start of data
+	(do ((arc arcs))
+	    ((endp arc)
+	     (setf (buffer-boffset display) buffer-boffset))
+	  ;; Make sure there's room
+	  (when (index>= buffer-boffset limit)
+	    (setf (buffer-boffset display) buffer-boffset)
+	    (buffer-flush display)
+	    (set-buffer-offset (buffer-boffset display)))
+	  (int16-put  0 (pop arc))
+	  (int16-put  2 (pop arc))
+	  (card16-put 4 (pop arc))
+	  (card16-put 6 (pop arc))
+	  (angle-put  8 (pop arc))
+	  (angle-put 10 (pop arc))
+	  (set-buffer-offset (index+ buffer-boffset 12)))))))
+
+(defun draw-arcs-vector (drawable gcontext arcs &optional fill-p)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type vector arcs) 
+	   (type boolean fill-p))
+  (let* ((display (drawable-display drawable))
+	 (limit (index- (buffer-size display) 12))
+	 (length (length arcs))
+	 (request (if fill-p *x-polyfillarc* *x-polyarc*)))
+    (with-buffer-request ((drawable-display drawable) request :gc-force gcontext)
+      (drawable drawable)
+      (gcontext gcontext)
+      (progn
+	(card16-put 2 (index+ (index-ash length -1) 3))	; Set request length (in words)
+	(set-buffer-offset (index+ buffer-boffset 12))  ; Position to start of data
+	(do ((n 0 (index+ n 6))
+	     (length (length arcs)))
+	    ((index>= n length)
+	     (setf (buffer-boffset display) buffer-boffset))
+	  ;; Make sure there's room
+	  (when (index>= buffer-boffset limit)
+	    (setf (buffer-boffset display) buffer-boffset)
+	    (buffer-flush display)
+	    (set-buffer-offset (buffer-boffset display)))
+	  (int16-put  0 (aref arcs (index+ n 0)))
+	  (int16-put  2 (aref arcs (index+ n 1)))
+	  (card16-put 4 (aref arcs (index+ n 2)))
+	  (card16-put 6 (aref arcs (index+ n 3)))
+	  (angle-put  8 (aref arcs (index+ n 4)))
+	  (angle-put 10 (aref arcs (index+ n 5)))
+	  (set-buffer-offset (index+ buffer-boffset 12)))))))
+
+(defun draw-arcs (drawable gcontext arcs &optional fill-p)
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type sequence arcs) 
+	   (type boolean fill-p))
+  (etypecase arcs
+    (list (draw-arcs-list drawable gcontext arcs fill-p))
+    (vector (draw-arcs-vector drawable gcontext arcs fill-p))))
+
+;; The following image routines are bare minimum.  It may be useful to define
+;; some form of "image" object to hide representation details and format
+;; conversions.  It also may be useful to provide stream-oriented interfaces
+;; for reading and writing the data.
+
+(defun put-raw-image (drawable gcontext data &key
+		      (start 0)
+		      (depth (required-arg depth))
+		      (x (required-arg x))
+		      (y (required-arg y))
+		      (width (required-arg width))
+		      (height (required-arg height))
+		      (left-pad 0)
+		      (format (required-arg format)))
+  ;; Data must be a sequence of 8-bit quantities, already in the appropriate format
+  ;; for transmission; the caller is responsible for all byte and bit swapping and
+  ;; compaction.  Start is the starting index in data; the end is computed from the
+  ;; other arguments.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type sequence data) ; Sequence of integers
+	   (type array-index start)
+	   (type card8 depth left-pad) ;; required
+	   (type int16 x y) ;; required
+	   (type card16 width height) ;; required
+	   (type (member :bitmap :xy-pixmap :z-pixmap) format))
+  (with-buffer-request ((drawable-display drawable) *x-putimage* :gc-force gcontext)
+    ((data (member :bitmap :xy-pixmap :z-pixmap)) format)
+    (drawable drawable)
+    (gcontext gcontext)
+    (card16 width height)
+    (int16 x y)
+    (card8 left-pad depth)
+    (pad16 nil)
+    ((sequence :format card8 :start start) data)))
+
+(defun get-raw-image (drawable &key
+		      data
+		      (start 0)
+		      (x (required-arg x))
+		      (y (required-arg y))
+		      (width (required-arg width))
+		      (height (required-arg height))
+		      (plane-mask #xffffffff)
+		      (format (required-arg format))
+		      (result-type '(vector card8)))
+  ;; If data is given, it is modified in place (and returned), otherwise a new sequence
+  ;; is created and returned, with a size computed from the other arguments and the
+  ;; returned depth.  The sequence is filled with 8-bit quantities, in transmission
+  ;; format; the caller is responsible for any byte and bit swapping and compaction
+  ;; required for further local use.
+  (declare (type drawable drawable)
+	   (type (or null sequence) data) ;; sequence of integers
+	   (type int16 x y) ;; required
+	   (type card16 width height) ;; required
+	   (type array-index start)
+	   (type pixel plane-mask)
+	   (type (member :xy-pixmap :z-pixmap) format))
+  (declare (values (sequence integer) depth visual-info))
+  (let ((display (drawable-display drawable)))
+    (with-buffer-request-and-reply (display *x-getimage* nil :sizes (8 32))
+	 (((data (member error :xy-pixmap :z-pixmap)) format)
+	  (drawable drawable)
+	  (int16 x y)
+	  (card16 width height)
+	  (card32 plane-mask))
+      (let ((depth (card8-get 1))
+	    (length (* 4 (card32-get 4)))
+	    (visual (resource-id-get 8)))
+	(values (sequence-get :result-type result-type :format card8
+			      :length length :start start :data data
+			      :index *replysize*)
+		depth
+		(visual-info display visual))))))
diff --git a/src/clx/image.lsp b/src/clx/image.lsp
new file mode 100644
index 000000000..c9d7a30f1
--- /dev/null
+++ b/src/clx/image.lsp
@@ -0,0 +1,2776 @@
+;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-
+
+;;; CLX Image functions
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+(defmacro with-image-data-buffer ((buffer size) &body body)
+  (declare (indentation 0 4 1 1))
+  `(let ((.reply-buffer. (allocate-reply-buffer ,size)))
+     (declare (type reply-buffer .reply-buffer.))
+     (unwind-protect
+	 (let ((,buffer (reply-ibuf8 .reply-buffer.)))
+	   (declare (type buffer-bytes ,buffer))
+	   (with-vector (,buffer buffer-bytes)
+	     ,@body))
+       (deallocate-reply-buffer .reply-buffer.))))
+
+(def-clx-class (image (:constructor nil) (:copier nil) (:predicate nil))
+  ;; Public structure
+  (width 0 :type card16 :read-only t)
+  (height 0 :type card16 :read-only t)
+  (depth 1 :type card8 :read-only t)
+  (plist nil :type list))
+
+;; Image-Plist accessors:
+(defmacro image-name (image) `(getf (image-plist ,image) :name))
+(defmacro image-x-hot (image) `(getf (image-plist ,image) :x-hot))
+(defmacro image-y-hot (image) `(getf (image-plist ,image) :y-hot))
+(defmacro image-red-mask (image) `(getf (image-plist ,image) :red-mask))
+(defmacro image-blue-mask (image) `(getf (image-plist ,image) :blue-mask))
+(defmacro image-green-mask (image) `(getf (image-plist ,image) :green-mask))
+
+(defun print-image (image stream depth)
+  (declare (type image image)
+	   (ignore depth))
+  (print-unreadable-object (image stream :type t)
+    (when (image-name image)
+      (write-string (string (image-name image)) stream)
+      (write-string " " stream))
+    (prin1 (image-width image) stream)
+    (write-string "x" stream)
+    (prin1 (image-height image) stream)
+    (write-string "x" stream)
+    (prin1 (image-depth image) stream)))
+
+(defconstant *empty-data-x* '#.(make-sequence '(array card8 (*)) 0))
+
+(defconstant *empty-data-z*
+	     '#.(make-array '(0 0) :element-type 'pixarray-1-element-type))
+
+(def-clx-class (image-x (:include image) (:copier nil)
+			(:print-function print-image))
+  ;; Use this format for shoveling image data
+  ;; Private structure. Accessors for these NOT exported.
+  (format :z-pixmap :type (member :bitmap :xy-pixmap :z-pixmap))
+  (bytes-per-line 0 :type card16)
+  (bits-per-pixel 1 :type (member 1 4 8 16 24 32))
+  (bit-lsb-first-p *image-bit-lsb-first-p* :type boolean)	; Bit order
+  (byte-lsb-first-p *image-byte-lsb-first-p* :type boolean)	; Byte order
+  (data *empty-data-x* :type (array card8 (*)))			; row-major
+  (unit *image-unit* :type (member 8 16 32))			; Bitmap unit
+  (pad *image-pad* :type (member 8 16 32))			; Scanline pad
+  (left-pad 0 :type card8))					; Left pad
+
+(def-clx-class (image-xy (:include image) (:copier nil)
+			 (:print-function print-image))
+  ;; Public structure
+  ;; Use this format for image processing
+  (bitmap-list nil :type list)) ;; list of bitmaps
+
+(def-clx-class (image-z (:include image) (:copier nil)
+			(:print-function print-image))
+  ;; Public structure
+  ;; Use this format for image processing
+  (bits-per-pixel 1 :type (member 1 4 8 16 24 32))
+  (pixarray *empty-data-z* :type pixarray))
+
+(defun create-image (&key width height depth
+		     (data (required-arg data))
+		     plist name x-hot y-hot
+		     red-mask blue-mask green-mask
+		     bits-per-pixel format bytes-per-line
+		     (byte-lsb-first-p 
+		       #+clx-little-endian t
+		       #-clx-little-endian nil)
+		     (bit-lsb-first-p
+		       #+clx-little-endian t
+		       #-clx-little-endian nil)
+		     unit pad left-pad)
+  ;; Returns an image-x image-xy or image-z structure, depending on the
+  ;; type of the :DATA parameter.
+  (declare
+    (type (or null card16) width height)	; Required
+    (type (or null card8) depth)		; Defualts to 1
+    (type (or buffer-bytes			; Returns image-x
+	      list				; Returns image-xy
+	      pixarray) data)			; Returns image-z
+    (type list plist)
+    (type (or null stringable) name)
+    (type (or null card16) x-hot y-hot)
+    (type (or null pixel) red-mask blue-mask green-mask)
+    (type (or null (member 1 4 8 16 24 32)) bits-per-pixel)
+    
+    ;; The following parameters are ignored for image-xy and image-z:
+    (type (or null (member :bitmap :xy-pixmap :z-pixmap))
+	  format)				; defaults to :z-pixmap
+    (type (or null card16) bytes-per-line)
+    (type boolean byte-lsb-first-p bit-lsb-first-p)
+    (type (or null (member 8 16 32)) unit pad)
+    (type (or null card8) left-pad))
+  (declare (values image))
+  (let ((image
+	  (etypecase data
+	    (buffer-bytes			; image-x
+	      (let ((data data))
+		(declare (type buffer-bytes data))
+		(unless depth (setq depth (or bits-per-pixel 1)))
+		(unless format
+		  (setq format (if (= depth 1) :xy-pixmap :z-pixmap)))
+		(unless bits-per-pixel
+		  (setq bits-per-pixel
+			(cond ((eq format :xy-pixmap) 1)
+			      ((index> depth 24) 32)
+			      ((index> depth 16) 24)
+			      ((index> depth 8)  16)
+			      ((index> depth 4)   8)
+			      ((index> depth 1)   4)
+			      (t                  1))))
+		(unless width (required-arg width))
+		(unless height (required-arg height))
+		(unless bytes-per-line
+		  (let* ((pad (or pad 8))
+			 (bits-per-line (index* width bits-per-pixel))
+			 (padded-bits-per-line
+			   (index* (index-ceiling bits-per-line pad) pad)))
+		    (declare (type array-index pad bits-per-line
+				   padded-bits-per-line))
+		    (setq bytes-per-line (index-ceiling padded-bits-per-line 8))))
+		(unless unit (setq unit *image-unit*))
+		(unless pad
+		  (setq pad
+			(dolist (pad '(32 16 8))
+			  (when (and (index<= pad *image-pad*)
+				     (zerop
+				       (index-mod
+					 (index* bytes-per-line 8) pad)))
+			    (return pad)))))
+		(unless left-pad (setq left-pad 0))
+		(make-image-x
+		  :width width :height height :depth depth :plist plist
+		  :format format :data data
+		  :bits-per-pixel bits-per-pixel 
+		  :bytes-per-line bytes-per-line
+		  :byte-lsb-first-p byte-lsb-first-p
+		  :bit-lsb-first-p bit-lsb-first-p
+		  :unit unit :pad pad :left-pad left-pad)))
+	    (list				; image-xy
+	      (let ((data data))
+		(declare (type list data))
+		(unless depth (setq depth (length data)))
+		(when data
+		  (unless width (setq width (array-dimension (car data) 1)))
+		  (unless height (setq height (array-dimension (car data) 0))))
+		(make-image-xy
+		  :width width :height height :plist plist :depth depth
+		  :bitmap-list data)))
+	    (pixarray				; image-z
+	      (let ((data data))
+		(declare (type pixarray data))
+		(unless width (setq width (array-dimension data 1)))
+		(unless height (setq height (array-dimension data 0)))
+		(unless bits-per-pixel
+		  (setq bits-per-pixel
+			(etypecase data
+			  (pixarray-32 32)
+			  (pixarray-24 24)
+			  (pixarray-16 16)
+			  (pixarray-8   8)
+			  (pixarray-4   4)
+			  (pixarray-1   1)))))
+	      (unless depth (setq depth bits-per-pixel))
+	      (make-image-z
+		:width width :height height :depth depth :plist plist
+		:bits-per-pixel bits-per-pixel :pixarray data)))))
+    (declare (type image image))
+    (when name (setf (image-name image) name))
+    (when x-hot (setf (image-x-hot image) x-hot))
+    (when y-hot (setf (image-y-hot image) y-hot))
+    (when red-mask (setf (image-red-mask image) red-mask))
+    (when blue-mask (setf (image-blue-mask image) blue-mask))
+    (when green-mask (setf (image-green-mask image) green-mask))
+    image))
+
+;;;-----------------------------------------------------------------------------
+;;; Swapping stuff
+
+(defun image-noswap
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p)
+	   (ignore lsb-first-p))
+  #.(declare-buffun)
+  (if (index= srcinc destinc)
+      (buffer-replace
+	dest src destoff
+	(index+ destoff (index* srcinc (index1- height)) srclen)
+	srcoff)
+    (do* ((h height (index1- h))
+	  (srcstart srcoff (index+ srcstart srcinc))
+	  (deststart destoff (index+ deststart destinc))
+	  (destend (index+ deststart srclen) (index+ deststart srclen)))
+	 ((index-zerop h))
+      (declare (type array-index srcstart deststart destend)
+	       (type card16 h))
+      (buffer-replace dest src deststart destend srcstart))))
+
+(defun image-swap-two-bytes
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (do ((length (index* (index-ceiling srclen 2) 2))
+	   (h height (index1- h))
+	   (srcstart srcoff (index+ srcstart srcinc))
+	   (deststart destoff (index+ deststart destinc)))
+	  ((index-zerop h))
+	(declare (type array-index length srcstart deststart)
+		 (type card16 h))
+	(when (and (index= h 1) (not (index= srclen length)))
+	  (index-decf length 2)
+	  (if lsb-first-p
+	      (setf (aref dest (index1+ (index+ deststart length)))
+		    #-ecl (the card8 (aref src (index+ srcstart length)))
+		    #+ecl (int-char
+			   (the card8 (aref src (index+ srcstart length)))))
+	    (setf (aref dest (index+ deststart length))
+		  #-ecl
+		  (the card8 (aref src (index1+ (index+ srcstart length))))
+		  #+ecl
+		  (int-char
+		   (the card8 (aref src (index1+ (index+ srcstart length))))))))
+	(do ((i length (index- i 2))
+	     (srcidx srcstart (index+ srcidx 2))
+	     (destidx deststart (index+ destidx 2)))
+	    ((index-zerop i))
+	  (declare (type array-index i srcidx destidx))
+	  (setf (aref dest destidx)
+		#-ecl (the card8 (aref src (index1+ srcidx)))
+		#+ecl (int-char (the card8 (aref src (index1+ srcidx)))))
+	  (setf (aref dest (index1+ destidx))
+		#-ecl (the card8 (aref src srcidx))
+		#+ecl (int-char (the card8 (aref src srcidx)))))))))
+
+(defun image-swap-three-bytes
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (do ((length (index* (index-ceiling srclen 3) 3))
+	   (h height (index1- h))
+	   (srcstart srcoff (index+ srcstart srcinc))
+	   (deststart destoff (index+ deststart destinc)))
+	  ((index-zerop h))
+	(declare (type array-index length srcstart deststart)
+		 (type card16 h))
+	(when (and (index= h 1) (not (index= srclen length)))
+	  (index-decf length 3)
+	  (when (index= (index- srclen length) 2)
+	    (setf (aref dest (index+ deststart length 1))
+		  #-ecl (the card8 (aref src (index+ srcstart length 1)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length 1))))))
+	  (if lsb-first-p
+	      (setf (aref dest (index+ deststart length 2))
+		    #-ecl (the card8 (aref src (index+ srcstart length)))
+		    #+ecl (int-char
+			   (the card8 (aref src (index+ srcstart length)))))
+	    (setf (aref dest (index+ deststart length))
+		  #-ecl (the card8 (aref src (index+ srcstart length 2)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length 2)))))))
+	(do ((i length (index- i 3))
+	     (srcidx srcstart (index+ srcidx 3))
+	     (destidx deststart (index+ destidx 3)))
+	    ((index-zerop i))
+	  (declare (type array-index i srcidx destidx))
+	  (setf (aref dest destidx)
+		#-ecl (the card8 (aref src (index+ srcidx 2)))
+		#+ecl (int-char
+		       (the card8 (aref src (index+ srcidx 2)))))
+	  (setf (aref dest (index1+ destidx))
+		#-ecl (the card8 (aref src (index1+ srcidx)))
+		#+ecl (int-char
+		       (the card8 (aref src (index1+ srcidx)))))
+	  (setf (aref dest (index+ destidx 2))
+		#-ecl (the card8 (aref src srcidx))
+		#+ecl (int-char
+		       (the card8 (aref src srcidx)))))))))
+
+(defun image-swap-four-bytes
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (do ((length (index* (index-ceiling srclen 4) 4))
+	   (h height (index1- h))
+	   (srcstart srcoff (index+ srcstart srcinc))
+	   (deststart destoff (index+ deststart destinc)))
+	  ((index-zerop h))
+	(declare (type array-index length srcstart deststart)
+		 (type card16 h))
+	(when (and (index= h 1) (not (index= srclen length)))
+	  (index-decf length 4)
+	  (unless lsb-first-p
+	    (setf (aref dest (index+ deststart length))
+		  #-ecl (the card8 (aref src (index+ srcstart length 3)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length 3))))))
+	  (when (if lsb-first-p
+		    (index= (index- srclen length) 3)
+		  (not (index-zerop (index-logand srclen 2))))
+	    (setf (aref dest (index+ deststart length 1))
+		  #-ecl (the card8 (aref src (index+ srcstart length 2)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length 2))))))
+	  (when (if (null lsb-first-p)
+		    (index= (index- srclen length) 3)
+		  (not (index-zerop (index-logand srclen 2))))
+	    (setf (aref dest (index+ deststart length 2))
+		  #-ecl (the card8 (aref src (index+ srcstart length 1)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length 1))))))
+	  (when lsb-first-p
+	    (setf (aref dest (index+ deststart length 3))
+		  #-ecl (the card8 (aref src (index+ srcstart length)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length)))))))
+	(do ((i length (index- i 4))
+	     (srcidx srcstart (index+ srcidx 4))
+	     (destidx deststart (index+ destidx 4)))
+	    ((index-zerop i))
+	  (declare (type array-index i srcidx destidx))
+	  (setf (aref dest destidx)
+		#-ecl (the card8 (aref src (index+ srcidx 3)))
+		#+ecl (int-char
+		       (the card8 (aref src (index+ srcidx 3)))))
+	  (setf (aref dest (index1+ destidx))
+		#-ecl (the card8 (aref src (index+ srcidx 2)))
+		#+ecl (int-char
+		       (the card8 (aref src (index+ srcidx 2)))))
+	  (setf (aref dest (index+ destidx 2))
+		#-ecl (the card8 (aref src (index1+ srcidx)))
+		#+ecl (int-char
+		       (the card8 (aref src (index1+ srcidx)))))
+	  (setf (aref dest (index+ destidx 3))
+		#-ecl (the card8 (aref src srcidx))
+		#+ecl (int-char
+		       (the card8 (aref src srcidx)))))))))
+
+(defun image-swap-words
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (do ((length (index* (index-ceiling srclen 4) 4))
+	   (h height (index1- h))
+	   (srcstart srcoff (index+ srcstart srcinc))
+	   (deststart destoff (index+ deststart destinc)))
+	  ((index-zerop h))
+	(declare (type array-index length srcstart deststart)
+		 (type card16 h))
+	(when (and (index= h 1) (not (index= srclen length)))
+	  (index-decf length 4)
+	  (unless lsb-first-p
+	    (setf (aref dest (index+ deststart length 1))
+		  #-ecl (the card8 (aref src (index+ srcstart length 3)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length 3))))))
+	  (when (if lsb-first-p
+		    (index= (index- srclen length) 3)
+		  (not (index-zerop (index-logand srclen 2))))
+	    (setf (aref dest (index+ deststart length))
+		  #-ecl (the card8 (aref src (index+ srcstart length 2)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length 2))))))
+	  (when (if (null lsb-first-p)
+		    (index= (index- srclen length) 3)
+		  (not (index-zerop (index-logand srclen 2))))
+	    (setf (aref dest (index+ deststart length 3))
+		  #-ecl (the card8 (aref src (index+ srcstart length 1)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length 1))))))
+	  (when lsb-first-p
+	    (setf (aref dest (index+ deststart length 2))
+		  #-ecl (the card8 (aref src (index+ srcstart length)))
+		  #+ecl (int-char
+			 (the card8 (aref src (index+ srcstart length)))))))
+	(do ((i length (index- i 4))
+	     (srcidx srcstart (index+ srcidx 4))
+	     (destidx deststart (index+ destidx 4)))
+	    ((index-zerop i))
+	  (declare (type array-index i srcidx destidx))
+	  (setf (aref dest destidx)
+		#-ecl (the card8 (aref src (index+ srcidx 2)))
+		#+ecl (int-char
+		       (the card8 (aref src (index+ srcidx 2)))))
+	  (setf (aref dest (index1+ destidx))
+		#-ecl (the card8 (aref src (index+ srcidx 3)))
+		#+ecl (int-char
+		       (the card8 (aref src (index+ srcidx 3)))))
+	  (setf (aref dest (index+ destidx 2))
+		#-ecl (the card8 (aref src srcidx))
+		#+ecl (int-char
+		       (the card8 (aref src srcidx))))
+	  (setf (aref dest (index+ destidx 3))
+		#-ecl (the card8 (aref src (index1+ srcidx)))
+		#+ecl (int-char
+		       (the card8 (aref src (index1+ srcidx))))))))))
+
+(defun image-swap-nibbles
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p)
+	   (ignore lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (do ((h height (index1- h))
+	   (srcstart srcoff (index+ srcstart srcinc))
+	   (deststart destoff (index+ deststart destinc)))
+	  ((index-zerop h))
+	(declare (type array-index srcstart deststart)
+		 (type card16 h))
+	(do ((i srclen (index1- i))
+	     (srcidx srcstart (index1+ srcidx))
+	     (destidx deststart (index1+ destidx)))
+	    ((index-zerop i))
+	  (declare (type array-index i srcidx destidx))
+	  (setf (aref dest destidx)
+		#-ecl (the card8
+		     (let ((byte (aref src srcidx)))
+		       (declare (type card8 byte))
+		       (dpb (the card4 (ldb (byte 4 0) byte))
+			    (byte 4 4)
+			    (the card4 (ldb (byte 4 4) byte)))))
+		#+ecl (int-char
+		       (the card8
+			    (let ((byte (aref src srcidx)))
+			      (declare (type card8 byte))
+			      (dpb (the card4 (ldb (byte 4 0) byte))
+				   (byte 4 4)
+				   (the card4 (ldb (byte 4 4) byte))))))))))))
+
+(defun image-swap-nibbles-left
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p)
+	   (ignore lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (do ((h height (index1- h))
+	   (srcstart srcoff (index+ srcstart srcinc))
+	   (deststart destoff (index+ deststart destinc)))
+	  ((index-zerop h))
+	(declare (type array-index srcstart deststart)
+		 (type card16 h))
+	(do ((i srclen (index1- i))
+	     (srcidx srcstart (index1+ srcidx))
+	     (destidx deststart (index1+ destidx)))
+	    ((index= i 1)
+	     (setf (aref dest destidx)
+		   #-ecl (the card8
+			(let ((byte1 (aref src srcidx)))
+			  (declare (type card8 byte1))
+			  (dpb (the card4 (ldb (byte 4 0) byte1))
+			       (byte 4 4)
+			       0)))
+		   #+ecl (int-char
+			  (the card8
+			(let ((byte1 (aref src srcidx)))
+			  (declare (type card8 byte1))
+			  (dpb (the card4 (ldb (byte 4 0) byte1))
+			       (byte 4 4)
+			       0))))))
+	  (declare (type array-index i srcidx destidx))
+	  (setf (aref dest destidx)
+		#-ecl (the card8
+		     (let ((byte1 (aref src srcidx))
+			   (byte2 (aref src (index1+ srcidx))))
+		       (declare (type card8 byte1 byte2))
+		       (dpb (the card4 (ldb (byte 4 0) byte1))
+			    (byte 4 4)
+			    (the card4 (ldb (byte 4 4) byte2)))))
+		#+ecl (int-char
+		       (the card8
+		     (let ((byte1 (aref src srcidx))
+			   (byte2 (aref src (index1+ srcidx))))
+		       (declare (type card8 byte1 byte2))
+		       (dpb (the card4 (ldb (byte 4 0) byte1))
+			    (byte 4 4)
+			    (the card4 (ldb (byte 4 4) byte2))))))))))))
+
+(defconstant
+  *image-byte-reverse*
+  '#.(coerce
+       '#(
+	  0 128 64 192 32 160 96 224 16 144 80 208 48 176 112 240
+	  8 136 72 200 40 168 104 232 24 152 88 216 56 184 120 248
+	  4 132 68 196 36 164 100 228 20 148 84 212 52 180 116 244
+	  12 140 76 204 44 172 108 236 28 156 92 220 60 188 124 252
+	  2 130 66 194 34 162 98 226 18 146 82 210 50 178 114 242
+	  10 138 74 202 42 170 106 234 26 154 90 218 58 186 122 250
+	  6 134 70 198 38 166 102 230 22 150 86 214 54 182 118 246
+	  14 142 78 206 46 174 110 238 30 158 94 222 62 190 126 254
+	  1 129 65 193 33 161 97 225 17 145 81 209 49 177 113 241
+	  9 137 73 201 41 169 105 233 25 153 89 217 57 185 121 249
+	  5 133 69 197 37 165 101 229 21 149 85 213 53 181 117 245
+	  13 141 77 205 45 173 109 237 29 157 93 221 61 189 125 253
+	  3 131 67 195 35 163 99 227 19 147 83 211 51 179 115 243
+	  11 139 75 203 43 171 107 235 27 155 91 219 59 187 123 251
+	  7 135 71 199 39 167 103 231 23 151 87 215 55 183 119 247
+	  15 143 79 207 47 175 111 239 31 159 95 223 63 191 127 255)
+       '(vector #-ecl card8 #+ecl base-char)))
+
+(defun image-swap-bits
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p)
+	   (ignore lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (let ((byte-reverse *image-byte-reverse*))
+	(with-vector (byte-reverse #-ecl (simple-array card8 (256))
+				   #+ecl buffer-bytes)
+	  (macrolet ((br (byte)
+		       #-ecl `(the card8 (aref byte-reverse (the card8 ,byte)))
+		       #+ecl `(int-char
+			       (the card8
+				(aref byte-reverse (the card8 ,byte))))))
+	    (do ((h height (index1- h))
+		 (srcstart srcoff (index+ srcstart srcinc))
+		 (deststart destoff (index+ deststart destinc)))
+		((index-zerop h))
+	      (declare (type array-index srcstart deststart)
+		       (type card16 h))
+	      (do ((i srclen (index1- i))
+		   (srcidx srcstart (index1+ srcidx))
+		   (destidx deststart (index1+ destidx)))
+		  ((index-zerop i))
+		(declare (type array-index i srcidx destidx))
+		(setf (aref dest destidx) (br (aref src srcidx)))))))))))
+
+(defun image-swap-bits-and-two-bytes
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (let ((byte-reverse *image-byte-reverse*))
+	(with-vector (byte-reverse #-ecl (simple-array card8 (256))
+				   #+ecl buffer-bytes)
+	  (macrolet ((br (byte)
+		       #-ecl `(the card8 (aref byte-reverse (the card8 ,byte)))
+		       #+ecl `(int-char
+			       (the card8
+				(aref byte-reverse (the card8 ,byte))))))
+	    (do ((length (index* (index-ceiling srclen 2) 2))
+		 (h height (index1- h))
+		 (srcstart srcoff (index+ srcstart srcinc))
+		 (deststart destoff (index+ deststart destinc)))
+		((index-zerop h))
+	      (declare (type array-index length srcstart deststart)
+		       (type card16 h))
+	      (when (and (index= h 1) (not (index= srclen length)))
+		(index-decf length 2)
+		(if lsb-first-p
+		    (setf (aref dest (index1+ (index+ deststart length)))
+			  (br (aref src (index+ srcstart length))))
+		  (setf (aref dest (index+ deststart length))
+			(br (aref src (index1+ (index+ srcstart length)))))))
+	      (do ((i length (index- i 2))
+		   (srcidx srcstart (index+ srcidx 2))
+		   (destidx deststart (index+ destidx 2)))
+		  ((index-zerop i))
+		(declare (type array-index i srcidx destidx))
+		(setf (aref dest destidx)
+		      (br (aref src (index1+ srcidx))))
+		(setf (aref dest (index1+ destidx))
+		      (br (aref src srcidx)))))))))))
+
+(defun image-swap-bits-and-four-bytes
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (let ((byte-reverse *image-byte-reverse*))
+	(with-vector (byte-reverse #-ecl (simple-array card8 (256))
+				   #+ecl buffer-bytes)
+	  (macrolet ((br (byte)
+		       #-ecl `(the card8 (aref byte-reverse (the card8 ,byte)))
+		       #+ecl `(int-char
+			       (the card8
+				(aref byte-reverse (the card8 ,byte))))))
+	    (do ((length (index* (index-ceiling srclen 4) 4))
+		 (h height (index1- h))
+		 (srcstart srcoff (index+ srcstart srcinc))
+		 (deststart destoff (index+ deststart destinc)))
+		((index-zerop h))
+	      (declare (type array-index length srcstart deststart)
+		       (type card16 h))
+	      (when (and (index= h 1) (not (index= srclen length)))
+		(index-decf length 4)
+		(unless lsb-first-p
+		  (setf (aref dest (index+ deststart length))
+			(br (aref src (index+ srcstart length 3)))))
+		(when (if lsb-first-p
+			  (index= (index- srclen length) 3)
+			(not (index-zerop (index-logand srclen 2))))
+		  (setf (aref dest (index+ deststart length 1))
+			(br (aref src (index+ srcstart length 2)))))
+		(when (if (null lsb-first-p)
+			  (index= (index- srclen length) 3)
+			(not (index-zerop (index-logand srclen 2))))
+		  (setf (aref dest (index+ deststart length 2))
+			(br (aref src (index+ srcstart length 1)))))
+		(when lsb-first-p
+		  (setf (aref dest (index+ deststart length 3))
+			(br (aref src (index+ srcstart length))))))
+	      (do ((i length (index- i 4))
+		   (srcidx srcstart (index+ srcidx 4))
+		   (destidx deststart (index+ destidx 4)))
+		  ((index-zerop i))
+		(declare (type array-index i srcidx destidx))
+		(setf (aref dest destidx)
+		      (br (aref src (index+ srcidx 3))))
+		(setf (aref dest (index1+ destidx))
+		      (br (aref src (index+ srcidx 2))))
+		(setf (aref dest (index+ destidx 2))
+		      (br (aref src (index1+ srcidx))))
+		(setf (aref dest (index+ destidx 3))
+		      (br (aref src srcidx)))))))))))
+
+(defun image-swap-bits-and-words
+       (src dest srcoff destoff srclen srcinc destinc height lsb-first-p)
+  (declare (type buffer-bytes src dest)
+	   (type array-index srcoff destoff srclen srcinc destinc)
+	   (type card16 height)
+	   (type boolean lsb-first-p))
+  #.(declare-buffun)
+  (with-vector (src buffer-bytes)
+    (with-vector (dest buffer-bytes)
+      (let ((byte-reverse *image-byte-reverse*))
+	(with-vector (byte-reverse #-ecl (simple-array card8 (256))
+				   #+ecl buffer-bytes)
+	  (macrolet ((br (byte)
+		       #-ecl `(the card8 (aref byte-reverse (the card8 ,byte)))
+		       #+ecl `(int-char
+			       (the card8
+				(aref byte-reverse (the card8 ,byte))))))
+	    (do ((length (index* (index-ceiling srclen 4) 4))
+		 (h height (index1- h))
+		 (srcstart srcoff (index+ srcstart srcinc))
+		 (deststart destoff (index+ deststart destinc)))
+		((index-zerop h))
+	      (declare (type array-index length srcstart deststart)
+		       (type card16 h))
+	      (when (and (index= h 1) (not (index= srclen length)))
+		(index-decf length 4)
+		(unless lsb-first-p
+		  (setf (aref dest (index+ deststart length 1))
+			(br (aref src (index+ srcstart length 3)))))
+		(when (if lsb-first-p
+			  (index= (index- srclen length) 3)
+			(not (index-zerop (index-logand srclen 2))))
+		  (setf (aref dest (index+ deststart length))
+			(br (aref src (index+ srcstart length 2)))))
+		(when (if (null lsb-first-p)
+			  (index= (index- srclen length) 3)
+			(not (index-zerop (index-logand srclen 2))))
+		  (setf (aref dest (index+ deststart length 3))
+			(br (aref src (index+ srcstart length 1)))))
+		(when lsb-first-p
+		  (setf (aref dest (index+ deststart length 2))
+			(br (aref src (index+ srcstart length))))))
+	      (do ((i length (index- i 4))
+		   (srcidx srcstart (index+ srcidx 4))
+		   (destidx deststart (index+ destidx 4)))
+		  ((index-zerop i))
+		(declare (type array-index i srcidx destidx))
+		(setf (aref dest destidx)
+		      (br (aref src (index+ srcidx 2))))
+		(setf (aref dest (index1+ destidx))
+		      (br (aref src (index+ srcidx 3))))
+		(setf (aref dest (index+ destidx 2))
+		      (br (aref src srcidx)))
+		(setf (aref dest (index+ destidx 3))
+		      (br (aref src (index1+ srcidx))))))))))))
+
+;;; The following table gives the bit ordering within bytes (when accessed
+;;; sequentially) for a scanline containing 32 bits, with bits numbered 0 to
+;;; 31, where bit 0 should be leftmost on the display.  For a given byte
+;;; labelled A-B, A is for the most significant bit of the byte, and B is
+;;; for the least significant bit.
+;;; 
+;;; legend:
+;;; 	1   scanline-unit = 8
+;;; 	2   scanline-unit = 16
+;;; 	4   scanline-unit = 32
+;;; 	M   byte-order = MostSignificant
+;;; 	L   byte-order = LeastSignificant
+;;; 	m   bit-order = MostSignificant
+;;; 	l   bit-order = LeastSignificant
+;;; 
+;;; 
+;;; format	ordering
+;;; 
+;;; 1Mm	00-07 08-15 16-23 24-31
+;;; 2Mm	00-07 08-15 16-23 24-31
+;;; 4Mm	00-07 08-15 16-23 24-31
+;;; 1Ml	07-00 15-08 23-16 31-24
+;;; 2Ml	15-08 07-00 31-24 23-16
+;;; 4Ml	31-24 23-16 15-08 07-00
+;;; 1Lm	00-07 08-15 16-23 24-31
+;;; 2Lm	08-15 00-07 24-31 16-23
+;;; 4Lm	24-31 16-23 08-15 00-07
+;;; 1Ll	07-00 15-08 23-16 31-24
+;;; 2Ll	07-00 15-08 23-16 31-24
+;;; 4Ll	07-00 15-08 23-16 31-24
+;;; 
+;;; 
+;;; The following table gives the required conversion between any two
+;;; formats.  It is based strictly on the table above.  If you believe one,
+;;; you should believe the other.
+;;; 
+;;; legend:
+;;; 	n   no changes
+;;; 	s   reverse 8-bit units within 16-bit units
+;;; 	l   reverse 8-bit units within 32-bit units
+;;; 	w   reverse 16-bit units within 32-bit units
+;;; 	r   reverse bits within 8-bit units
+;;; 	sr  s+R
+;;; 	lr  l+R
+;;; 	wr  w+R
+
+(defconstant 
+  *image-swap-function*
+  '#.(make-array
+       '(12 12) :initial-contents
+       (let ((n  'image-noswap)
+	     (s  'image-swap-two-bytes)
+	     (l  'image-swap-four-bytes)
+	     (w  'image-swap-words)
+	     (r  'image-swap-bits)
+	     (sr 'image-swap-bits-and-two-bytes)
+	     (lr 'image-swap-bits-and-four-bytes)
+	     (wr 'image-swap-bits-and-words))
+	 (list #|             1Mm 2Mm 4Mm 1Ml 2Ml 4Ml 1Lm 2Lm 4Lm 1Ll 2Ll 4Ll  |#
+	       (list #| 1Mm |# n   n   n   r   sr  lr  n   s   l   r   r   r )
+	       (list #| 2Mm |# n   n   n   r   sr  lr  n   s   l   r   r   r )
+	       (list #| 4Mm |# n   n   n   r   sr  lr  n   s   l   r   r   r )
+	       (list #| 1Ml |# r   r   r   n   s   l   r   sr  lr  n   n   n )
+	       (list #| 2Ml |# sr  sr  sr  s   n   w   sr  r   wr  s   s   s )
+	       (list #| 4Ml |# lr  lr  lr  l   w   n   lr  wr  r   l   l   l )
+	       (list #| 1Lm |# n   n   n   r   sr  lr  n   s   l   r   r   r )
+	       (list #| 2Lm |# s   s   s   sr  r   wr  s   n   w   sr  sr  sr)
+	       (list #| 4Lm |# l   l   l   lr  wr  r   l   w   n   lr  lr  lr)
+	       (list #| 1Ll |# r   r   r   n   s   l   r   sr  lr  n   n   n )
+	       (list #| 2Ll |# r   r   r   n   s   l   r   sr  lr  n   n   n )
+	       (list #| 4Ll |# r   r   r   n   s   l   r   sr  lr  n   n   n )))))
+
+;;; Of course, the table above is a lie.  We also need to factor in the
+;;; order of the source data to cope with swapping half of a unit at the
+;;; end of a scanline, since we are trying to avoid de-ref'ing off the
+;;; end of the source.
+;;;
+;;; Defines whether the first half of a unit has the first half of the data
+
+(defconstant
+  *image-swap-lsb-first-p*
+  '#.(make-array
+       12 :initial-contents
+       (list t   #| 1mm |#
+	     t   #| 2mm |#
+	     t   #| 4mm |#
+	     t   #| 1ml |#
+	     nil #| 2ml |#
+	     nil #| 4ml |#
+	     t   #| 1lm |#
+	     nil #| 2lm |#
+	     nil #| 4lm |#
+	     t   #| 1ll |#
+	     t   #| 2ll |#
+	     t   #| 4ll |#
+	     )))
+
+(defun image-swap-function
+       (bits-per-pixel
+	from-bitmap-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+  (declare (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) from-bitmap-unit to-bitmap-unit)
+	   (type boolean from-byte-lsb-first-p from-bit-lsb-first-p
+		 to-byte-lsb-first-p to-bit-lsb-first-p)
+	   (values function lsb-first-p))
+  (cond ((index= bits-per-pixel 1)
+	 (let ((from-index
+		 (index+
+		   (ecase from-bitmap-unit (32 2) (16 1) (8 0))
+		   (if from-bit-lsb-first-p 3 0)
+		   (if from-byte-lsb-first-p 6 0))))
+	   (values
+	     (aref *image-swap-function* from-index
+		   (index+
+		     (ecase to-bitmap-unit (32 2) (16 1) (8 0))
+		     (if to-bit-lsb-first-p 3 0)
+		     (if to-byte-lsb-first-p 6 0)))
+	     (aref *image-swap-lsb-first-p* from-index))))
+	(t
+	 (values 
+	   (if (if (index= bits-per-pixel 4)
+		   (eq from-bit-lsb-first-p to-bit-lsb-first-p)
+		 (eq from-byte-lsb-first-p to-byte-lsb-first-p))
+	       'image-noswap
+	     (ecase bits-per-pixel
+	       (4  'image-swap-nibbles)
+	       (8  'image-noswap)
+	       (16 'image-swap-two-bytes)
+	       (24 'image-swap-three-bytes)
+	       (32 'image-swap-four-bytes)))
+	   from-byte-lsb-first-p))))
+
+
+;;;-----------------------------------------------------------------------------
+;;; GET-IMAGE
+
+(defun read-pixarray-1 (buffer-bbuf index array x y width height  
+			padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-1 array)
+	   (type card16 x y width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((start (index+ index
+			 (index* y padded-bytes-per-line)
+			 (index-ceiling x 8))
+		 (index+ start padded-bytes-per-line))
+	  (y 0 (index1+ y))
+	  (left-bits (index-mod (index- x) 8))
+	  (right-bits (index-mod (index- width left-bits) 8))
+	  (middle-bits (index- width left-bits right-bits))
+	  (middle-bytes (index-floor middle-bits 8)))
+	 ((index>= y height))
+      (declare (type array-index start y
+		     left-bits right-bits middle-bits middle-bytes))
+      (cond ((index< middle-bits 0)
+	     (let ((byte (aref buffer-bbuf (index1- start)))
+		   (x left-bits))
+	       (declare (type card8 byte)
+			(type array-index x))
+	       (when (index> right-bits 6)
+		 (setf (aref array y (index- x 1))
+		       (read-image-load-byte 1 7 byte)))
+	       (when (and (index> left-bits 1)
+			  (index> right-bits 5))
+		 (setf (aref array y (index- x 2))
+		       (read-image-load-byte 1 6 byte)))
+	       (when (and (index> left-bits 2)
+			  (index> right-bits 4))
+		 (setf (aref array y (index- x 3))
+		       (read-image-load-byte 1 5 byte)))
+	       (when (and (index> left-bits 3)
+			  (index> right-bits 3))
+		 (setf (aref array y (index- x 4))
+		       (read-image-load-byte 1 4 byte)))
+	       (when (and (index> left-bits 4)
+			  (index> right-bits 2))
+		 (setf (aref array y (index- x 5))
+		       (read-image-load-byte 1 3 byte)))
+	       (when (and (index> left-bits 5)
+			  (index> right-bits 1))
+		 (setf (aref array y (index- x 6))
+		       (read-image-load-byte 1 2 byte)))
+	       (when (index> left-bits 6)
+		 (setf (aref array y (index- x 7))
+		       (read-image-load-byte 1 1 byte)))))
+	    (t
+	     (unless (index-zerop left-bits)
+	       (let ((byte (aref buffer-bbuf (index1- start)))
+		     (x left-bits))
+		 (declare (type card8 byte)
+			  (type array-index x))
+		 (setf (aref array y (index- x 1))
+		       (read-image-load-byte 1 7 byte))
+		 (when (index> left-bits 1)
+		   (setf (aref array y (index- x 2))
+			 (read-image-load-byte 1 6 byte))
+		   (when (index> left-bits 2)
+		     (setf (aref array y (index- x 3))
+			   (read-image-load-byte 1 5 byte))
+		     (when (index> left-bits 3)
+		       (setf (aref array y (index- x 4))
+			     (read-image-load-byte 1 4 byte))
+		       (when (index> left-bits 4)
+			 (setf (aref array y (index- x 5))
+			       (read-image-load-byte 1 3 byte))
+			 (when (index> left-bits 5)
+			   (setf (aref array y (index- x 6))
+				 (read-image-load-byte 1 2 byte))
+			   (when (index> left-bits 6)
+			     (setf (aref array y (index- x 7))
+				   (read-image-load-byte 1 1 byte))
+			     ))))))))
+	     (do* ((end (index+ start middle-bytes))
+		   (i start (index1+ i))
+		   (x left-bits (index+ x 8)))
+		  ((index>= i end)
+		   (unless (index-zerop right-bits)
+		     (let ((byte (aref buffer-bbuf end))
+			   (x (index+ left-bits middle-bits)))
+		       (declare (type card8 byte)
+				(type array-index x))
+		       (setf (aref array y (index+ x 0))
+			     (read-image-load-byte 1 0 byte))
+		       (when (index> right-bits 1)
+			 (setf (aref array y (index+ x 1))
+			       (read-image-load-byte 1 1 byte))
+			 (when (index> right-bits 2)
+			   (setf (aref array y (index+ x 2))
+				 (read-image-load-byte 1 2 byte))
+			   (when (index> right-bits 3)
+			     (setf (aref array y (index+ x 3))
+				   (read-image-load-byte 1 3 byte))
+			     (when (index> right-bits 4)
+			       (setf (aref array y (index+ x 4))
+				     (read-image-load-byte 1 4 byte))
+			       (when (index> right-bits 5)
+				 (setf (aref array y (index+ x 5))
+				       (read-image-load-byte 1 5 byte))
+				 (when (index> right-bits 6)
+				   (setf (aref array y (index+ x 6))
+					 (read-image-load-byte 1 6 byte))
+				   )))))))))
+	       (declare (type array-index end i x))
+	       (let ((byte (aref buffer-bbuf i)))
+		 (declare (type card8 byte))
+		 (setf (aref array y (index+ x 0))
+		       (read-image-load-byte 1 0 byte))
+		 (setf (aref array y (index+ x 1))
+		       (read-image-load-byte 1 1 byte))
+		 (setf (aref array y (index+ x 2))
+		       (read-image-load-byte 1 2 byte))
+		 (setf (aref array y (index+ x 3))
+		       (read-image-load-byte 1 3 byte))
+		 (setf (aref array y (index+ x 4))
+		       (read-image-load-byte 1 4 byte))
+		 (setf (aref array y (index+ x 5))
+		       (read-image-load-byte 1 5 byte))
+		 (setf (aref array y (index+ x 6))
+		       (read-image-load-byte 1 6 byte))
+		 (setf (aref array y (index+ x 7))
+		       (read-image-load-byte 1 7 byte))))
+	     )))))
+
+(defun read-pixarray-4 (buffer-bbuf index array x y width height 
+			padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-4 array)
+	   (type card16 x y width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((start (index+ index
+			 (index* y padded-bytes-per-line)
+			 (index-ceiling x 2))
+		 (index+ start padded-bytes-per-line))
+	  (y 0 (index1+ y))
+	  (left-nibbles (index-mod (index- x) 2))
+	  (right-nibbles (index-mod (index- width left-nibbles) 2))
+	  (middle-nibbles (index- width left-nibbles right-nibbles))
+	  (middle-bytes (index-floor middle-nibbles 2)))
+	 ((index>= y height))
+      (declare (type array-index start y
+		     left-nibbles right-nibbles middle-nibbles middle-bytes))
+      (unless (index-zerop left-nibbles)
+	(setf (aref array y 0)
+	      (read-image-load-byte
+		4 4 (aref buffer-bbuf (index1- start)))))
+      (do* ((end (index+ start middle-bytes))
+	    (i start (index1+ i))
+	    (x left-nibbles (index+ x 2)))
+	   ((index>= i end)
+	    (unless (index-zerop right-nibbles)
+	      (setf (aref array y (index+ left-nibbles middle-nibbles))
+		    (read-image-load-byte 4 0 (aref buffer-bbuf end)))))
+	(declare (type array-index end i x))
+	(let ((byte (aref buffer-bbuf i)))
+	  (declare (type card8 byte))
+	  (setf (aref array y (index+ x 0))
+		(read-image-load-byte 4 0 byte))
+	  (setf (aref array y (index+ x 1))
+		(read-image-load-byte 4 4 byte))))
+      )))
+
+(defun read-pixarray-8 (buffer-bbuf index array x y width height 
+			padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-8 array)
+	   (type card16 x y width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((start (index+ index
+			 (index* y padded-bytes-per-line)
+			 x)
+		 (index+ start padded-bytes-per-line))
+	  (y 0 (index1+ y)))
+	 ((index>= y height))
+      (declare (type array-index start y))
+      (do* ((end (index+ start width))
+	    (i start (index1+ i))
+	    (x 0 (index1+ x)))
+	   ((index>= i end))
+	(declare (type array-index end i x))
+	(setf (aref array y x)
+	      #-ecl (the card8 (aref buffer-bbuf i))
+	      #+ecl (int-char
+		     (the card8 (aref buffer-bbuf i))))))))
+
+(defun read-pixarray-16 (buffer-bbuf index array x y width height 
+			 padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-16 array)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((start (index+ index
+			 (index* y padded-bytes-per-line)
+			 (index* x 2))
+		 (index+ start padded-bytes-per-line))
+	  (y 0 (index1+ y)))
+	 ((index>= y height))
+      (declare (type array-index start y))
+      (do* ((end (index+ start (index* width 2)))
+	    (i start (index+ i 2))
+	    (x 0 (index1+ x)))
+	   ((index>= i end))
+	(declare (type array-index end i x))
+	(setf (aref array y x)
+	      (read-image-assemble-bytes
+		(aref buffer-bbuf (index+ i 0))
+		(aref buffer-bbuf (index+ i 1))))))))
+
+(defun read-pixarray-24 (buffer-bbuf index array x y width height 
+			 padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-24 array)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((start (index+ index
+			 (index* y padded-bytes-per-line)
+			 (index* x 3))
+		 (index+ start padded-bytes-per-line))
+	  (y 0 (index1+ y)))
+	 ((index>= y height))
+      (declare (type array-index start y))
+      (do* ((end (index+ start (index* width 3)))
+	    (i start (index+ i 3))
+	    (x 0 (index1+ x)))
+	   ((index>= i end))
+	(declare (type array-index end i x))
+	(setf (aref array y x)
+	      (read-image-assemble-bytes
+		(aref buffer-bbuf (index+ i 0))
+		(aref buffer-bbuf (index+ i 1))
+		(aref buffer-bbuf (index+ i 2))))))))
+
+(defun read-pixarray-32 (buffer-bbuf index array x y width height 
+			 padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-32 array)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((start (index+ index
+			 (index* y padded-bytes-per-line)
+			 (index* x 4))
+		 (index+ start padded-bytes-per-line))
+	  (y 0 (index1+ y)))
+	 ((index>= y height))
+      (declare (type array-index start y))
+      (do* ((end (index+ start (index* width 4)))
+	    (i start (index+ i 4))
+	    (x 0 (index1+ x)))
+	   ((index>= i end))
+	(declare (type array-index end i x))
+	(setf (aref array y x)
+	      (read-image-assemble-bytes
+		(aref buffer-bbuf (index+ i 0))
+		(aref buffer-bbuf (index+ i 1))
+		(aref buffer-bbuf (index+ i 2))
+		(aref buffer-bbuf (index+ i 3))))))))
+
+(defun read-pixarray-internal
+       (bbuf boffset pixarray x y width height padded-bytes-per-line
+	bits-per-pixel read-pixarray-function
+	from-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	to-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type array-index boffset padded-bytes-per-line)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type function read-pixarray-function)
+	   (type (member 8 16 32) from-unit to-unit)
+	   (type boolean from-byte-lsb-first-p from-bit-lsb-first-p
+		 to-byte-lsb-first-p to-bit-lsb-first-p))
+  (multiple-value-bind (image-swap-function image-swap-lsb-first-p)
+      (image-swap-function
+	bits-per-pixel
+	from-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	to-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+    (if (eq image-swap-function 'image-noswap)
+	(funcall
+	  read-pixarray-function
+	  bbuf boffset pixarray x y width height padded-bytes-per-line
+	  bits-per-pixel)
+      (with-image-data-buffer (buf (index* height padded-bytes-per-line))
+	(funcall
+	  (symbol-function image-swap-function) bbuf buf
+	  (index+ boffset (index* y padded-bytes-per-line)) 0
+	  (index-ceiling (index* (index+ x width) bits-per-pixel) 8)
+	  padded-bytes-per-line padded-bytes-per-line height
+	  image-swap-lsb-first-p)
+	(funcall
+	  read-pixarray-function 
+	  buf 0 pixarray x 0 width height padded-bytes-per-line
+	  bits-per-pixel)))))
+
+(defun read-pixarray
+       (bbuf boffset pixarray x y width height padded-bytes-per-line
+	bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type array-index boffset padded-bytes-per-line)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (unless (fast-read-pixarray
+	    bbuf boffset pixarray x y width height padded-bytes-per-line
+	    bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+    (read-pixarray-internal
+      bbuf boffset pixarray x y width height padded-bytes-per-line
+      bits-per-pixel 
+      (ecase bits-per-pixel
+	( 1 #'read-pixarray-1 )
+	( 4 #'read-pixarray-4 )
+	( 8 #'read-pixarray-8 )
+	(16 #'read-pixarray-16)
+	(24 #'read-pixarray-24)
+	(32 #'read-pixarray-32))
+      unit byte-lsb-first-p bit-lsb-first-p
+      *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*)))
+
+(defun read-xy-format-image-x
+       (buffer-bbuf index length data width height depth
+	padded-bytes-per-line padded-bytes-per-plane
+	unit byte-lsb-first-p bit-lsb-first-p pad)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type card16 width height)
+	   (type array-index index length padded-bytes-per-line
+		 padded-bytes-per-plane)
+	   (type image-depth depth)
+	   (type (member 8 16 32) unit pad)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p)
+	   (values image-x))
+  (assert (index<= (index* depth padded-bytes-per-plane) length))
+  (let* ((bytes-per-line (index-ceiling width 8))
+	 (data-length (index* padded-bytes-per-plane depth)))
+    (declare (type array-index bytes-per-line data-length))
+    (cond (data
+	   (check-type data buffer-bytes)
+	   (assert (index>= (length data) data-length)))
+	  (t
+	   (setq data (make-array data-length :element-type #-ecl 'card8
+				  #+ecl 'base-char))))
+    (do ((plane 0 (index1+ plane)))
+	((index>= plane depth))
+      (declare (type image-depth plane))
+      (image-noswap
+	buffer-bbuf data
+	(index+ index (index* plane padded-bytes-per-plane))
+	(index* plane padded-bytes-per-plane)
+	bytes-per-line padded-bytes-per-line padded-bytes-per-line
+	height byte-lsb-first-p))
+    (create-image 
+      :width width :height height :depth depth :data data
+      :bits-per-pixel 1 :format :xy-pixmap
+      :bytes-per-line padded-bytes-per-line
+      :unit unit :pad pad
+      :byte-lsb-first-p byte-lsb-first-p :bit-lsb-first-p bit-lsb-first-p)))
+
+(defun read-z-format-image-x
+       (buffer-bbuf index length data width height depth
+	padded-bytes-per-line 
+	unit byte-lsb-first-p bit-lsb-first-p pad bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type card16 width height)
+	   (type array-index index length padded-bytes-per-line)
+	   (type image-depth depth)
+	   (type (member 8 16 32) unit pad)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (values image-x))
+  (assert (index<= (index* height padded-bytes-per-line) length))
+  (let ((bytes-per-line (index-ceiling (index* width bits-per-pixel) 8))
+	(data-length (index* padded-bytes-per-line height)))
+    (declare (type array-index bytes-per-line data-length))
+    (cond (data
+	   (check-type data buffer-bytes)
+	   (assert (index>= (length data) data-length)))
+	  (t
+	   (setq data (make-array data-length :element-type #-ecl 'card8
+				  #+ecl 'base-char))))
+    (image-noswap
+      buffer-bbuf data index 0 bytes-per-line padded-bytes-per-line
+      padded-bytes-per-line height byte-lsb-first-p)
+    (create-image 
+      :width width :height height :depth depth :data data
+      :bits-per-pixel bits-per-pixel :format :z-pixmap
+      :bytes-per-line padded-bytes-per-line
+      :unit unit :pad pad
+      :byte-lsb-first-p byte-lsb-first-p :bit-lsb-first-p bit-lsb-first-p)))
+
+(defun read-image-xy (bbuf index length data x y width height depth
+		      padded-bytes-per-line padded-bytes-per-plane
+		      unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type card16 x y width height)
+	   (type array-index index length padded-bytes-per-line
+		 padded-bytes-per-plane)
+	   (type image-depth depth)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p)
+	   (values image-xy))
+  (check-type data list)
+  (multiple-value-bind (dimensions element-type)
+      (if data
+	  (values (array-dimensions (first data))
+		  (array-element-type (first data)))
+	(values (list height
+		      (index* (index-ceiling width *image-pad*) *image-pad*))
+		'pixarray-1-element-type))
+    (do* ((arrays data)
+	  (result nil)
+	  (limit (index+ length index))
+	  (plane 0 (1+ plane))
+	  (index index (index+ index padded-bytes-per-plane)))
+	 ((or (>= plane depth)
+	      (index> (index+ index padded-bytes-per-plane) limit))
+	  (setq data (nreverse result) depth (length data)))
+      (declare (type array-index limit index)
+	       (type image-depth plane)
+	       (type list arrays result))
+      (let ((array (or (pop arrays)
+		       (make-array dimensions :element-type element-type))))
+	(declare (type pixarray-1 array))
+	(push array result)
+	(read-pixarray
+	  bbuf index array x y width height padded-bytes-per-line 1
+	  unit byte-lsb-first-p bit-lsb-first-p)))
+    (create-image 
+      :width width :height height :depth depth :data data)))
+
+(defun read-image-z (bbuf index length data x y width height depth
+		     padded-bytes-per-line bits-per-pixel
+		     unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type card16 x y width height)
+	   (type array-index index length padded-bytes-per-line)
+	   (type image-depth depth)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p)
+	   (values image-z))
+  (assert (index<= (index* (index+ y height) padded-bytes-per-line) length))
+  (let* ((image-bits-per-line (index* width bits-per-pixel))
+	 (image-pixels-per-line
+	   (index-ceiling
+	     (index* (index-ceiling image-bits-per-line *image-pad*)
+		     *image-pad*)
+	     bits-per-pixel)))
+    (declare (type array-index image-bits-per-line image-pixels-per-line))
+    (unless data
+      (setq data
+	    (make-array
+	      (list height image-pixels-per-line)
+	      :element-type (ecase bits-per-pixel
+			      (1  'pixarray-1-element-type)
+			      (4  'pixarray-4-element-type)
+			      (8  'pixarray-8-element-type)
+			      (16 'pixarray-16-element-type)
+			      (24 'pixarray-24-element-type)
+			      (32 'pixarray-32-element-type)))))
+    (read-pixarray
+      bbuf index data x y width height padded-bytes-per-line bits-per-pixel
+      unit byte-lsb-first-p bit-lsb-first-p)
+    (create-image 
+      :width width :height height :depth depth :data data
+      :bits-per-pixel bits-per-pixel)))
+
+(defun get-image (drawable &key
+		  data
+		  (x (required-arg x))
+		  (y (required-arg y))
+		  (width (required-arg width))
+		  (height (required-arg height))
+		  plane-mask format result-type)
+  (declare (type drawable drawable)
+	   (type (or buffer-bytes list pixarray) data)
+	   (type int16 x y) ;; required
+	   (type card16 width height) ;; required
+	   (type (or null pixel) plane-mask)
+	   (type (or null (member :xy-pixmap :z-pixmap)) format)
+	   (type (or null (member image-xy image-x image-z)) result-type)
+	   (values image visual-info))
+  (unless result-type
+    (setq result-type (ecase format
+			(:xy-pixmap 'image-xy)
+			(:z-pixmap 'image-z)
+			((nil) 'image-x))))
+  (unless format
+    (setq format (case result-type
+		   (image-xy :xy-pixmap)
+		   ((image-z image-x) :z-pixmap))))
+  (unless (ecase result-type
+	    (image-xy (eq format :xy-pixmap))
+	    (image-z (eq format :z-pixmap))
+	    (image-x t))
+    (error "Result-type ~s is incompatable with format ~s"
+	   result-type format))
+  (unless plane-mask (setq plane-mask #xffffffff))
+  (let ((display (drawable-display drawable)))
+    (with-buffer-request-and-reply (display *x-getimage* nil :sizes (8 32))
+	 (((data (member error :xy-pixmap :z-pixmap)) format)
+	  (drawable drawable)
+	  (int16 x y)
+	  (card16 width height)
+	  (card32 plane-mask))
+      (let* ((depth (card8-get 1))
+	     (length (index* 4 (card32-get 4)))
+	     (visual-info (visual-info display (resource-id-get 8)))
+	     (bitmap-format (display-bitmap-format display))
+	     (unit (bitmap-format-unit bitmap-format))
+	     (byte-lsb-first-p (display-image-lsb-first-p display))
+	     (bit-lsb-first-p  (bitmap-format-lsb-first-p bitmap-format)))
+	(declare (type image-depth depth)
+		 (type array-index length)
+		 (type (or null visual-info) visual-info)
+		 (type bitmap-format bitmap-format)
+		 (type (member 8 16 32) unit)
+		 (type boolean byte-lsb-first-p bit-lsb-first-p))
+	(multiple-value-bind (pad bits-per-pixel)
+	    (ecase format
+	      (:xy-pixmap
+		(values (bitmap-format-pad bitmap-format) 1))
+	      (:z-pixmap
+		(if (= depth 1)
+		    (values (bitmap-format-pad bitmap-format) 1)
+		  (let ((pixmap-format
+			  (find depth (display-pixmap-formats display)
+				:key #'pixmap-format-depth)))
+		    (declare (type pixmap-format pixmap-format))
+		    (values (pixmap-format-scanline-pad pixmap-format)
+			    (pixmap-format-bits-per-pixel pixmap-format))))))
+	  (declare (type (member 8 16 32) pad)
+		   (type (member 1 4 8 16 24 32) bits-per-pixel))
+	  (let* ((bits-per-line (index* bits-per-pixel width))
+		 (padded-bits-per-line
+		   (index* (index-ceiling bits-per-line pad) pad))
+		 (padded-bytes-per-line
+		   (index-ceiling padded-bits-per-line 8))
+		 (padded-bytes-per-plane
+		   (index* padded-bytes-per-line height))
+		 (image
+		   (ecase result-type
+		     (image-x
+		       (ecase format
+			 (:xy-pixmap
+			   (read-xy-format-image-x
+			     buffer-bbuf *replysize* length data
+			     width height depth
+			     padded-bytes-per-line padded-bytes-per-plane
+			     unit byte-lsb-first-p bit-lsb-first-p
+			     pad))
+			 (:z-pixmap
+			   (read-z-format-image-x
+			     buffer-bbuf *replysize* length data
+			     width height depth
+			     padded-bytes-per-line
+			     unit byte-lsb-first-p bit-lsb-first-p
+			     pad bits-per-pixel))))
+		     (image-xy
+		       (read-image-xy
+			 buffer-bbuf *replysize* length data
+			 0 0 width height depth
+			 padded-bytes-per-line padded-bytes-per-plane
+			 unit byte-lsb-first-p bit-lsb-first-p))
+		     (image-z
+		       (read-image-z
+			 buffer-bbuf *replysize* length data
+			 0 0 width height depth padded-bytes-per-line
+			 bits-per-pixel 
+			 unit byte-lsb-first-p bit-lsb-first-p)))))
+	    (declare (type image image)
+		     (type array-index bits-per-line 
+			   padded-bits-per-line padded-bytes-per-line))
+	    (when visual-info
+	      (unless (zerop (visual-info-red-mask visual-info))
+		(setf (image-red-mask image)
+		      (visual-info-red-mask visual-info)))
+	      (unless (zerop (visual-info-green-mask visual-info))
+		(setf (image-green-mask image)
+		      (visual-info-green-mask visual-info)))
+	      (unless (zerop (visual-info-blue-mask visual-info))
+		(setf (image-blue-mask image)
+		      (visual-info-blue-mask visual-info))))
+	    (values image visual-info)))))))
+
+
+;;;-----------------------------------------------------------------------------
+;;; PUT-IMAGE
+
+(defun write-pixarray-1 (buffer-bbuf index array x y width height
+			 padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-1 array)
+	   (type card16 x y width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((h 0 (index1+ h))
+	  (y y (index1+ y))
+	  (right-bits (index-mod width 8))
+	  (middle-bits (index- width right-bits))
+	  (middle-bytes (index-ceiling middle-bits 8))
+	  (start index (index+ start padded-bytes-per-line)))
+	 ((index>= h height))
+      (declare (type array-index h y right-bits middle-bits
+		     middle-bytes start))
+      (do* ((end (index+ start middle-bytes))
+	    (i start (index1+ i))
+	    (start-x x)
+	    (x start-x (index+ x 8)))
+	   ((index>= i end)
+	    (unless (index-zerop right-bits)
+	      (let ((x (index+ start-x middle-bits)))
+		(declare (type array-index x))
+		(setf (aref buffer-bbuf end)
+		      (write-image-assemble-bytes
+			(aref array y (index+ x 0))
+			(if (index> right-bits 1)
+			    (aref array y (index+ x 1))
+			  0)
+			(if (index> right-bits 2)
+			    (aref array y (index+ x 2))
+			  0)
+			(if (index> right-bits 3)
+			    (aref array y (index+ x 3))
+			  0)
+			(if (index> right-bits 4)
+			    (aref array y (index+ x 4))
+			  0)
+			(if (index> right-bits 5)
+			    (aref array y (index+ x 5))
+			  0)
+			(if (index> right-bits 6)
+			    (aref array y (index+ x 6))
+			  0)
+			0)))))
+	(declare (type array-index end i start-x x))
+	(setf (aref buffer-bbuf i)
+	      (write-image-assemble-bytes
+		(aref array y (index+ x 0))
+		(aref array y (index+ x 1))
+		(aref array y (index+ x 2))
+		(aref array y (index+ x 3))
+		(aref array y (index+ x 4))
+		(aref array y (index+ x 5))
+		(aref array y (index+ x 6))
+		(aref array y (index+ x 7))))))))
+
+(defun write-pixarray-4 (buffer-bbuf index array x y width height
+			 padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-4 array)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((h 0 (index1+ h))
+	  (y y (index1+ y))
+	  (right-nibbles (index-mod width 2))
+	  (middle-nibbles (index- width right-nibbles))
+	  (middle-bytes (index-ceiling middle-nibbles 2))
+	  (start index (index+ start padded-bytes-per-line)))
+	 ((index>= h height))
+      (declare (type array-index h y right-nibbles middle-nibbles
+		     middle-bytes start))
+      (do* ((end (index+ start middle-bytes))
+	    (i start (index1+ i))
+	    (start-x x)
+	    (x start-x (index+ x 2)))
+	   ((index>= i end)
+	    (unless (index-zerop right-nibbles)
+	      (setf (aref buffer-bbuf end)
+		    (write-image-assemble-bytes
+		      (aref array y (index+ start-x middle-nibbles))
+		      0))))
+	(declare (type array-index end i start-x x))
+	(setf (aref buffer-bbuf i)
+	      (write-image-assemble-bytes
+		(aref array y (index+ x 0))
+		(aref array y (index+ x 1))))))))
+
+(defun write-pixarray-8 (buffer-bbuf index array x y width height
+			 padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-8 array)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((h 0 (index1+ h))
+	  (y y (index1+ y))
+	  (start index (index+ start padded-bytes-per-line)))
+	 ((index>= h height))
+      (declare (type array-index h y start))
+      (do* ((end (index+ start width))
+	    (i start (index1+ i))
+	    (x x (index1+ x)))
+	   ((index>= i end))
+	(declare (type array-index end i x))
+	(setf (aref buffer-bbuf i)
+	      #-ecl (the card8 (aref array y x))
+	      #+ecl (int-char (the card8 (aref array y x))))))))
+
+(defun write-pixarray-16 (buffer-bbuf index array x y width height
+			  padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-16 array)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((h 0 (index1+ h))
+	  (y y (index1+ y))
+	  (start index (index+ start padded-bytes-per-line)))
+	 ((index>= h height))
+      (declare (type array-index h y start))
+      (do* ((end (index+ start (index* width 2)))
+	    (i start (index+ i 2))
+	    (x x (index1+ x)))
+	   ((index>= i end))
+	(declare (type array-index end i x))
+	(let ((pixel (aref array y x)))
+	  (declare (type pixarray-16-element-type pixel))
+	  (setf (aref buffer-bbuf (index+ i 0))
+		(write-image-load-byte 0 pixel 16))
+	  (setf (aref buffer-bbuf (index+ i 1))
+		(write-image-load-byte 8 pixel 16)))))))
+
+(defun write-pixarray-24 (buffer-bbuf index array x y width height
+			  padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-24 array)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((h 0 (index1+ h))
+	  (y y (index1+ y))
+	  (start index (index+ start padded-bytes-per-line)))
+	 ((index>= h height))
+      (declare (type array-index y start))
+      (do* ((end (index+ start (index* width 3)))
+	    (i start (index+ i 3))
+	    (x x (index1+ x)))
+	   ((index>= i end))
+	(declare (type array-index end i x))
+	(let ((pixel (aref array y x)))
+	  (declare (type pixarray-24-element-type pixel))
+	  (setf (aref buffer-bbuf (index+ i 0))
+		(write-image-load-byte 0 pixel 24))
+	  (setf (aref buffer-bbuf (index+ i 1))
+		(write-image-load-byte 8 pixel 24))
+	  (setf (aref buffer-bbuf (index+ i 2))
+		(write-image-load-byte 16 pixel 24)))))))
+
+(defun write-pixarray-32 (buffer-bbuf index array x y width height
+			  padded-bytes-per-line bits-per-pixel)
+  (declare (type buffer-bytes buffer-bbuf)
+	   (type pixarray-32 array)
+	   (type int16 x y)
+	   (type card16 width height)
+	   (type array-index index padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (ignore bits-per-pixel))
+  #.(declare-buffun)
+  (with-vector (buffer-bbuf buffer-bytes)
+    (do* ((h 0 (index1+ h))
+	  (y y (index1+ y))
+	  (start index (index+ start padded-bytes-per-line)))
+	 ((index>= h height))
+      (declare (type array-index h y start))
+      (do* ((end (index+ start (index* width 4)))
+	    (i start (index+ i 4))
+	    (x x (index1+ x)))
+	   ((index>= i end))
+	(declare (type array-index end i x))
+	(let ((pixel (aref array y x)))
+	  (declare (type pixarray-32-element-type pixel))
+	  (setf (aref buffer-bbuf (index+ i 0))
+		(write-image-load-byte 0 pixel 32))
+	  (setf (aref buffer-bbuf (index+ i 1))
+		(write-image-load-byte 8 pixel 32))
+	  (setf (aref buffer-bbuf (index+ i 2))
+		(write-image-load-byte 16 pixel 32))
+	  (setf (aref buffer-bbuf (index+ i 2))
+		(write-image-load-byte 24 pixel 32)))))))
+
+(defun write-pixarray-internal
+       (bbuf boffset pixarray x y width height padded-bytes-per-line
+	bits-per-pixel write-pixarray-function
+	from-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	to-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type array-index boffset padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type function write-pixarray-function)
+	   (type (member 8 16 32) from-unit to-unit)
+	   (type boolean from-byte-lsb-first-p from-bit-lsb-first-p
+		 to-byte-lsb-first-p to-bit-lsb-first-p))
+  (multiple-value-bind (image-swap-function image-swap-lsb-first-p)
+      (image-swap-function
+	bits-per-pixel
+	from-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	to-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+    (declare (type symbol image-swap-function)
+	     (type boolean image-swap-lsb-first-p))
+    (if (eq image-swap-function 'image-noswap)
+	(funcall
+	  write-pixarray-function
+	  bbuf boffset pixarray x y width height padded-bytes-per-line
+	  bits-per-pixel)
+      (with-image-data-buffer (buf (index* height padded-bytes-per-line))
+	(funcall
+	  write-pixarray-function 
+	  buf 0 pixarray x y width height padded-bytes-per-line
+	  bits-per-pixel)
+	(funcall
+	  (symbol-function image-swap-function) buf bbuf 0 boffset
+	  (index-ceiling (index* width bits-per-pixel) 8)
+	  padded-bytes-per-line padded-bytes-per-line height
+	  image-swap-lsb-first-p)))))
+
+(defun write-pixarray
+       (bbuf boffset pixarray x y width height padded-bytes-per-line
+	bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type buffer-bytes bbuf)
+	   (type pixarray pixarray)
+	   (type card16 x y width height)
+	   (type array-index boffset padded-bytes-per-line)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (unless (fast-write-pixarray
+	    bbuf boffset pixarray x y width height padded-bytes-per-line
+	    bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
+    (write-pixarray-internal
+      bbuf boffset pixarray x y width height padded-bytes-per-line
+      bits-per-pixel
+      (ecase bits-per-pixel
+	( 1 #'write-pixarray-1 )
+	( 4 #'write-pixarray-4 )
+	( 8 #'write-pixarray-8 )
+	(16 #'write-pixarray-16)
+	(24 #'write-pixarray-24)
+	(32 #'write-pixarray-32))
+      *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*
+      unit byte-lsb-first-p bit-lsb-first-p)))
+
+(defun write-xy-format-image-x-data
+       (data obuf data-start obuf-start x y width height
+	from-padded-bytes-per-line to-padded-bytes-per-line
+	from-bitmap-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+  (declare (type buffer-bytes data obuf)
+	   (type array-index data-start obuf-start
+		 from-padded-bytes-per-line to-padded-bytes-per-line)
+	   (type card16 x y width height)
+	   (type (member 8 16 32) from-bitmap-unit to-bitmap-unit)
+	   (type boolean from-byte-lsb-first-p from-bit-lsb-first-p
+		 to-byte-lsb-first-p to-bit-lsb-first-p))
+  (assert (index-zerop (index-mod x 8)))
+  (multiple-value-bind (image-swap-function image-swap-lsb-first-p)
+      (image-swap-function
+	1
+	from-bitmap-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+    (declare (type symbol image-swap-function)
+	     (type boolean image-swap-lsb-first-p))
+    (let ((x-mod-unit (index-mod x from-bitmap-unit)))
+      (declare (type card16 x-mod-unit))
+      (if (and (index-plusp x-mod-unit)
+	       (not (eq from-byte-lsb-first-p from-bit-lsb-first-p)))
+	  (let* ((temp-width (index+ width x-mod-unit))
+		 (temp-bytes-per-line (index-ceiling temp-width 8))
+		 (temp-padded-bits-per-line
+		   (index* (index-ceiling temp-width from-bitmap-unit)
+			   from-bitmap-unit))
+		 (temp-padded-bytes-per-line
+		   (index-ceiling temp-padded-bits-per-line 8)))
+	    (declare (type card16 temp-width temp-bytes-per-line
+			   temp-padded-bits-per-line temp-padded-bytes-per-line))
+	    (with-image-data-buffer
+		 (buf (index* height temp-padded-bytes-per-line))
+	      (funcall
+		(symbol-function image-swap-function) data buf
+		(index+ data-start
+			(index* y from-padded-bytes-per-line)
+			(index-floor (index- x x-mod-unit) 8))
+		0 temp-bytes-per-line from-padded-bytes-per-line
+		temp-padded-bytes-per-line height image-swap-lsb-first-p)
+	      (write-xy-format-image-x-data
+		buf obuf 0 obuf-start x-mod-unit 0 width height
+		temp-padded-bytes-per-line to-padded-bytes-per-line
+		from-bitmap-unit to-byte-lsb-first-p to-byte-lsb-first-p
+		to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p)))
+	(funcall
+	  (symbol-function image-swap-function) data obuf 
+	  (index+ data-start
+		  (index* y from-padded-bytes-per-line)
+		  (index-floor x 8))
+	  obuf-start (index-ceiling width 8) from-padded-bytes-per-line
+	  to-padded-bytes-per-line height image-swap-lsb-first-p)))))
+
+(defun write-xy-format-image-x
+       (display image src-x src-y width height
+	padded-bytes-per-line
+	unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type display display)
+	   (type image-x image)
+	   (type int16 src-x src-y)
+	   (type card16 width height)
+	   (type array-index padded-bytes-per-line)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (dotimes (plane (image-depth image))
+    (let ((data-start
+	    (index* (index* plane (image-height image))
+		    (image-x-bytes-per-line image)))
+	  (src-y src-y)
+	  (height height))
+      (declare (type int16 src-y)
+	       (type card16 height))
+      (loop 
+	(when (index-zerop height) (return))
+	(let ((nlines
+		(index-min (index-floor (index- (buffer-size display)
+						(buffer-boffset display))
+					padded-bytes-per-line)
+			   height)))
+	  (declare (type array-index nlines))
+	  (when (index-plusp nlines)
+	    (write-xy-format-image-x-data
+	      (image-x-data image) (buffer-obuf8 display)
+	      data-start (buffer-boffset display)
+	      src-x src-y width nlines 
+	      (image-x-bytes-per-line image) padded-bytes-per-line
+	      (image-x-unit image) (image-x-byte-lsb-first-p image)
+	      (image-x-bit-lsb-first-p image)
+	      unit byte-lsb-first-p bit-lsb-first-p)
+	    (index-incf (buffer-boffset display)
+			(index* nlines padded-bytes-per-line))
+	    (index-incf src-y nlines)
+	    (when (index-zerop (index-decf height nlines)) (return))))
+	(buffer-flush display)))))
+
+(defun write-z-format-image-x-data
+       (data obuf data-start obuf-start x y width height
+	from-padded-bytes-per-line to-padded-bytes-per-line
+	bits-per-pixel
+	from-bitmap-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+  (declare (type buffer-bytes data obuf)
+	   (type array-index data-start obuf-start
+		 from-padded-bytes-per-line to-padded-bytes-per-line)
+	   (type card16 x y width height)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel)
+	   (type (member 8 16 32) from-bitmap-unit to-bitmap-unit)
+	   (type boolean from-byte-lsb-first-p from-bit-lsb-first-p
+		 to-byte-lsb-first-p to-bit-lsb-first-p))
+  (if (index= bits-per-pixel 1)
+      (write-xy-format-image-x-data
+	data obuf data-start obuf-start x y width height
+	from-padded-bytes-per-line to-padded-bytes-per-line
+	from-bitmap-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+    (let ((srcoff
+	    (index+ data-start
+		    (index* y from-padded-bytes-per-line)
+		    (index-floor (index* x bits-per-pixel) 8)))
+	  (srclen (index-ceiling (index* width bits-per-pixel) 8)))
+      (declare (type array-index srcoff srclen))
+      (if (and (index= bits-per-pixel 4) (index-oddp x))
+	  (with-image-data-buffer (buf (index* height to-padded-bytes-per-line))
+	    (image-swap-nibbles-left
+	      data buf srcoff 0 srclen
+	      from-padded-bytes-per-line to-padded-bytes-per-line height nil)
+	    (write-z-format-image-x-data
+	      buf obuf 0 obuf-start 0 0 width height
+	      to-padded-bytes-per-line to-padded-bytes-per-line
+	      bits-per-pixel
+	      from-bitmap-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	      to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p))
+	(multiple-value-bind (image-swap-function image-swap-lsb-first-p)
+	    (image-swap-function
+	      bits-per-pixel
+	      from-bitmap-unit from-byte-lsb-first-p from-bit-lsb-first-p
+	      to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p)
+	  (declare (type symbol image-swap-function)
+		   (type boolean image-swap-lsb-first-p))
+	  (funcall
+	    (symbol-function image-swap-function) data obuf srcoff obuf-start
+	    srclen from-padded-bytes-per-line to-padded-bytes-per-line height
+	    image-swap-lsb-first-p))))))
+
+(defun write-z-format-image-x (display image src-x src-y width height
+			       padded-bytes-per-line
+			       unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type display display)
+	   (type image-x image)
+	   (type int16 src-x src-y)
+	   (type card16 width height)
+	   (type array-index padded-bytes-per-line)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (loop 
+    (when (index-zerop height) (return))
+    (let ((nlines
+	    (index-min (index-floor (index- (buffer-size display)
+					    (buffer-boffset display))
+				    padded-bytes-per-line)
+		       height)))
+      (declare (type array-index nlines))
+      (when (index-plusp nlines)
+	(write-z-format-image-x-data 
+	  (image-x-data image) (buffer-obuf8 display) 0 (buffer-boffset display)
+	  src-x src-y width nlines
+	  (image-x-bytes-per-line image) padded-bytes-per-line
+	  (image-x-bits-per-pixel image)
+	  (image-x-unit image) (image-x-byte-lsb-first-p image)
+	  (image-x-bit-lsb-first-p image)
+	  unit byte-lsb-first-p bit-lsb-first-p)
+	(index-incf (buffer-boffset display)
+		    (index* nlines padded-bytes-per-line))
+	(index-incf src-y nlines)
+	(when (index-zerop (index-decf height nlines)) (return))))
+    (buffer-flush display)))
+
+(defun write-image-xy (display image src-x src-y width height
+		       padded-bytes-per-line
+		       unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type display display)
+	   (type image-xy image)
+	   (type array-index padded-bytes-per-line)
+	   (type int16 src-x src-y)
+	   (type card16 width height)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (dolist (bitmap (image-xy-bitmap-list image))
+    (declare (type pixarray-1 bitmap))
+    (let ((src-y src-y)
+	  (height height))
+      (declare (type int16 src-y)
+	       (type card16 height))
+      (loop 
+	(let ((nlines
+		(index-min (index-floor (index- (buffer-size display)
+						(buffer-boffset display))
+					padded-bytes-per-line)
+			   height)))
+	  (declare (type array-index nlines))
+	  (when (index-plusp nlines)
+	    (write-pixarray 
+	      (buffer-obuf8 display) (buffer-boffset display)
+	      bitmap src-x src-y width nlines
+	      padded-bytes-per-line 1
+	      unit byte-lsb-first-p bit-lsb-first-p)
+	    (index-incf (buffer-boffset display)
+			(index* nlines padded-bytes-per-line))
+	    (index-incf src-y nlines)
+	    (when (index-zerop (index-decf height nlines)) (return))))
+	(buffer-flush display)))))
+
+(defun write-image-z (display image src-x src-y width height
+		      padded-bytes-per-line
+		      unit byte-lsb-first-p bit-lsb-first-p)
+  (declare (type display display)
+	   (type image-z image)
+	   (type array-index padded-bytes-per-line)
+	   (type int16 src-x src-y)
+	   (type card16 width height)
+	   (type (member 8 16 32) unit)
+	   (type boolean byte-lsb-first-p bit-lsb-first-p))
+  (loop 
+    (let ((bits-per-pixel (image-z-bits-per-pixel image))
+	  (nlines
+	    (index-min (index-floor (index- (buffer-size display)
+					    (buffer-boffset display))
+				    padded-bytes-per-line)
+		       height)))
+      (declare (type (member 1 4 8 16 24 32) bits-per-pixel)
+	       (type array-index nlines))
+      (when (index-plusp nlines)
+	(write-pixarray
+	  (buffer-obuf8 display) (buffer-boffset display)
+	  (image-z-pixarray image) src-x src-y width nlines
+	  padded-bytes-per-line bits-per-pixel
+	  unit byte-lsb-first-p bit-lsb-first-p)
+	(index-incf (buffer-boffset display)
+		    (index* nlines padded-bytes-per-line))
+	(index-incf src-y nlines)
+	(when (index-zerop (index-decf height nlines)) (return))))
+    (buffer-flush display)))
+
+;;; Note:	The only difference between a format of :bitmap and :xy-pixmap
+;;;		of depth 1 is that when sending a :bitmap format the foreground 
+;;;		and background in the gcontext are used.
+
+(defun put-image (drawable gcontext image &key
+		  (src-x 0) (src-y 0)		;Position within image
+		  (x (required-arg x))		;Position within drawable
+		  (y (required-arg y))
+		  width height
+		  bitmap-p)
+  ;; Copy an image into a drawable.
+  ;; WIDTH and HEIGHT default from IMAGE.
+  ;; When BITMAP-P, force format to be :bitmap when depth=1.
+  ;; This causes gcontext to supply foreground & background pixels.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type image image)
+	   (type int16 x y) ;; required
+	   (type int16 src-x src-y)
+	   (type (or null card16) width height)
+	   (type boolean bitmap-p))
+  (let* ((format
+	   (etypecase image
+	     (image-x (image-x-format (the image-x image)))
+	     (image-xy :xy-pixmap)
+	     (image-z :z-pixmap)))
+	 (src-x
+	   (if (image-x-p image)
+	       (index+ src-x (image-x-left-pad (the image-x image)))
+	     src-x))
+	 (image-width (image-width image))
+	 (image-height (image-height image))
+	 (width (min (or width image-width) (index- image-width src-x)))
+	 (height (min (or height image-height) (index- image-height src-y)))
+	 (depth (image-depth image))
+	 (display (drawable-display drawable))
+	 (bitmap-format (display-bitmap-format display))
+	 (unit (bitmap-format-unit bitmap-format))
+	 (byte-lsb-first-p (display-image-lsb-first-p display))
+	 (bit-lsb-first-p  (bitmap-format-lsb-first-p bitmap-format)))
+    (declare (type (member :bitmap :xy-pixmap :z-pixmap) format)
+	     (type card16 src-x image-width image-height width height)
+	     (type image-depth depth)
+	     (type display display)
+	     (type bitmap-format bitmap-format)
+	     (type (member 8 16 32) unit)
+	     (type boolean byte-lsb-first-p bit-lsb-first-p))
+    (when (and bitmap-p (not (index= depth 1)))
+      (error "Bitmaps must have depth 1"))
+    (unless (index<= 0 src-x (index1- (image-width image)))
+      (error "src-x not inside image"))
+    (unless (index<= 0 src-y (index1- (image-height image)))
+      (error "src-y not inside image"))
+    (when (and (index> width 0) (index> height 0))
+      (multiple-value-bind (pad bits-per-pixel)
+	  (ecase format
+	    ((:bitmap :xy-pixmap)
+	      (values (bitmap-format-pad bitmap-format) 1))
+	    (:z-pixmap
+	      (if (= depth 1) 
+		  (values (bitmap-format-pad bitmap-format) 1)
+		(let ((pixmap-format
+			(find depth (display-pixmap-formats display)
+			      :key #'pixmap-format-depth)))
+		  (declare (type (or null pixmap-format) pixmap-format))
+		  (if (null pixmap-format)
+		      (error "The depth of the image ~s does not match any server pixmap format." image))
+		  (if (not (= (typecase image
+				(image-z (image-z-bits-per-pixel image))
+				(image-x (image-x-bits-per-pixel image)))
+			      (pixmap-format-bits-per-pixel pixmap-format)))
+		      ;; We could try to use the "/* XXX slow, but works */"
+		      ;; code in XPutImage from X11R4 here.  However, that
+		      ;; would require considerable support code
+		      ;; (see XImUtil.c, etc).
+		      (error "The bits-per-pixel of the image ~s does not match any server pixmap format." image))
+		  (values (pixmap-format-scanline-pad pixmap-format)
+			  (pixmap-format-bits-per-pixel pixmap-format))))))
+	(declare (type (member 8 16 32) pad)
+		 (type (member 1 4 8 16 24 32) bits-per-pixel))
+	(let* ((left-pad
+		 (if (or (eq format :xy-pixmap) (= depth 1))
+		     (index-mod src-x (index-min pad *image-pad*))
+		   0))
+	       (left-padded-src-x (index- src-x left-pad))
+	       (left-padded-width (index+ width left-pad))
+	       (bits-per-line (index* left-padded-width bits-per-pixel))
+	       (padded-bits-per-line
+		 (index* (index-ceiling bits-per-line pad) pad))
+	       (padded-bytes-per-line (index-ceiling padded-bits-per-line 8))
+	       (request-bytes-per-line
+		 (ecase format
+		   ((:bitmap :xy-pixmap) (index* padded-bytes-per-line depth))
+		   (:z-pixmap padded-bytes-per-line)))
+	       (max-bytes-per-request
+		 (index* (index- (display-max-request-length display) 6) 4))
+	       (max-request-height
+		 (floor max-bytes-per-request request-bytes-per-line)))
+	  (declare (type card8 left-pad)
+		   (type int16 left-padded-src-x)
+		   (type card16 left-padded-width)
+		   (type array-index bits-per-line padded-bits-per-line
+			 padded-bytes-per-line request-bytes-per-line
+			 max-bytes-per-request max-request-height))
+	  ;; Be sure that a scanline can fit in a request
+	  (when (index-zerop max-request-height)
+	    (error "Can't even fit one image scanline in a request"))
+	  ;; Be sure a scanline can fit in a buffer
+	  (buffer-ensure-size display padded-bytes-per-line)
+	  ;; Send the image in multiple requests to avoid exceeding the
+	  ;; request limit
+	  (do* ((request-src-y src-y (index+ request-src-y request-height))
+		(request-y y (index+ request-y request-height))
+		(height-remaining
+		  height (index- height-remaining request-height))
+		(request-height
+		  (index-min height-remaining max-request-height)
+		  (index-min height-remaining max-request-height)))
+	       ((index<= height-remaining 0))
+	    (declare (type array-index request-src-y height-remaining
+			   request-height))
+	    (let* ((request-bytes (index* request-bytes-per-line request-height))
+		   (request-words (index-ceiling request-bytes 4))
+		   (request-length (index+ request-words 6)))
+	      (declare (type array-index request-bytes)
+		       (type card16 request-words request-length))
+	      (with-buffer-request (display *x-putimage* :gc-force gcontext)
+		((data (member :bitmap :xy-pixmap :z-pixmap))
+		 (cond ((or (eq format :bitmap) bitmap-p) :bitmap)
+		       ((plusp left-pad) :xy-pixmap)
+		       (t format)))
+		(drawable drawable)
+		(gcontext gcontext)
+		(card16 width request-height)
+		(int16 x request-y)
+		(card8 left-pad depth)
+		(pad16 nil)
+		(progn 
+		  (length-put 2 request-length)
+		  (setf (buffer-boffset display) (advance-buffer-offset 24))
+		  (etypecase image
+		    (image-x
+		      (ecase (image-x-format (the image-x image))
+			((:bitmap :xy-pixmap)
+			  (write-xy-format-image-x
+			    display image left-padded-src-x request-src-y
+			    left-padded-width request-height
+			    padded-bytes-per-line
+			    unit byte-lsb-first-p bit-lsb-first-p))
+			(:z-pixmap
+			  (write-z-format-image-x
+			    display image left-padded-src-x request-src-y
+			    left-padded-width request-height
+			    padded-bytes-per-line
+			    unit byte-lsb-first-p bit-lsb-first-p))))
+		    (image-xy
+		      (write-image-xy
+			display image left-padded-src-x request-src-y
+			left-padded-width request-height
+			padded-bytes-per-line
+			unit byte-lsb-first-p bit-lsb-first-p))
+		    (image-z
+		      (write-image-z
+			display image left-padded-src-x request-src-y
+			left-padded-width request-height
+			padded-bytes-per-line
+			unit byte-lsb-first-p bit-lsb-first-p)))
+		  ;; Be sure the request is padded to a multiple of 4 bytes
+		  (buffer-pad-request display (index- (index* request-words 4) request-bytes))
+		  )))))))))
+
+;;;-----------------------------------------------------------------------------
+;;; COPY-IMAGE
+
+(defun xy-format-image-x->image-x (image x y width height)
+  (declare (type image-x image)
+	   (type card16 x y width height)
+	   (values image-x))
+  (let* ((padded-x (index+ x (image-x-left-pad image)))
+	 (left-pad (index-mod padded-x 8))
+	 (x (index- padded-x left-pad))
+	 (unit (image-x-unit image))
+	 (byte-lsb-first-p (image-x-byte-lsb-first-p image))
+	 (bit-lsb-first-p (image-x-bit-lsb-first-p image))
+	 (pad (image-x-pad image))
+	 (padded-width
+	   (index* (index-ceiling (index+ width left-pad) pad) pad))
+	 (padded-bytes-per-line (index-ceiling padded-width 8))
+	 (padded-bytes-per-plane (index* padded-bytes-per-line height))
+	 (length (index* padded-bytes-per-plane (image-depth image)))
+	 (obuf (make-array length :element-type #-ecl 'card8
+			   #+ecl 'base-char)))
+    (declare (type card16 x)
+	     (type card8 left-pad)
+	     (type (member 8 16 32) unit pad)
+	     (type array-index padded-width padded-bytes-per-line
+		   padded-bytes-per-plane length)
+	     (type buffer-bytes obuf))
+    (dotimes (plane (image-depth image))
+      (let ((data-start
+	      (index* (image-x-bytes-per-line image)
+		      (image-height image)
+		      plane))
+	    (obuf-start
+	      (index* padded-bytes-per-plane
+		      plane)))
+	(declare (type array-index data-start obuf-start))
+	(write-xy-format-image-x-data
+	  (image-x-data image) obuf data-start obuf-start
+	  x y width height 
+	  (image-x-bytes-per-line image) padded-bytes-per-line
+	  unit byte-lsb-first-p bit-lsb-first-p
+	  unit byte-lsb-first-p bit-lsb-first-p)))
+    (create-image
+      :width width :height height :depth (image-depth image)
+      :data obuf :format (image-x-format image) :bits-per-pixel 1
+      :bytes-per-line padded-bytes-per-line
+      :unit unit :pad pad :left-pad left-pad
+      :byte-lsb-first-p byte-lsb-first-p :bit-lsb-first-p bit-lsb-first-p)))
+
+(defun z-format-image-x->image-x (image x y width height)
+  (declare (type image-x image)
+	   (type card16 x y width height)
+	   (values image-x))
+  (let* ((padded-x (index+ x (image-x-left-pad image)))
+	 (left-pad
+	   (if (index= (image-depth image) 1)
+	       (index-mod padded-x 8)
+	     0))
+	 (x (index- padded-x left-pad))
+	 (bits-per-pixel (image-x-bits-per-pixel image))
+	 (unit (image-x-unit image))
+	 (byte-lsb-first-p (image-x-byte-lsb-first-p image))
+	 (bit-lsb-first-p (image-x-bit-lsb-first-p image))
+	 (pad (image-x-pad image))
+	 (bits-per-line (index* (index+ width left-pad) bits-per-pixel))
+	 (padded-bits-per-line (index* (index-ceiling bits-per-line pad) pad))
+	 (padded-bytes-per-line (index-ceiling padded-bits-per-line 8))
+	 (padded-bytes-per-plane (index* padded-bytes-per-line height))
+	 (length (index* padded-bytes-per-plane (image-depth image)))
+	 (obuf (make-array length :element-type #-ecl 'card8
+			   #+ecl 'base-char)))
+    (declare (type card16 x)
+	     (type card8 left-pad)
+	     (type (member 8 16 32) unit pad)
+	     (type array-index bits-per-pixel padded-bytes-per-line
+		   padded-bytes-per-plane length)
+	     (type buffer-bytes obuf))
+    (write-z-format-image-x-data
+      (image-x-data image) obuf 0 0
+      x y width height 
+      (image-x-bytes-per-line image) padded-bytes-per-line
+      bits-per-pixel
+      unit byte-lsb-first-p bit-lsb-first-p
+      unit byte-lsb-first-p bit-lsb-first-p)
+    (create-image
+      :width width :height height :depth (image-depth image)
+      :data obuf :format :z-pixmap :bits-per-pixel bits-per-pixel
+      :bytes-per-line padded-bytes-per-line
+      :unit unit :pad pad :left-pad left-pad
+      :byte-lsb-first-p byte-lsb-first-p :bit-lsb-first-p bit-lsb-first-p)))
+
+(defun image-x->image-x  (image x y width height)
+  (declare (type image-x image)
+	   (type card16 x y width height)
+	   (values image-x))
+  (ecase (image-x-format image)
+    ((:bitmap :xy-pixmap)
+      (xy-format-image-x->image-x image x y width height))
+    (:z-pixmap
+      (z-format-image-x->image-x image x y width height))))
+
+(defun image-x->image-xy (image x y width height)
+  (declare (type image-x image)
+	   (type card16 x y width height)
+	   (values image-xy))
+  (unless (or (eq (image-x-format image) :bitmap)
+	      (eq (image-x-format image) :xy-pixmap)
+	      (and (eq (image-x-format image) :z-pixmap)
+		   (index= (image-depth image) 1)))
+    (error "Format conversion from ~S to ~S not supported"
+	   (image-x-format image) :xy-pixmap))
+  (read-image-xy
+    (image-x-data image) 0 (length (image-x-data image)) nil
+    (index+ x (image-x-left-pad image)) y width height
+    (image-depth image) (image-x-bytes-per-line image)
+    (index* (image-x-bytes-per-line image) (image-height image))
+    (image-x-unit image) (image-x-byte-lsb-first-p image)
+    (image-x-bit-lsb-first-p image)))
+
+(defun image-x->image-z  (image x y width height)
+  (declare (type image-x image)
+	   (type card16 x y width height)
+	   (values image-z))
+  (unless (or (eq (image-x-format image) :z-pixmap)
+	      (eq (image-x-format image) :bitmap)
+	      (and (eq (image-x-format image) :xy-pixmap)
+		   (index= (image-depth image) 1)))
+    (error "Format conversion from ~S to ~S not supported"
+	   (image-x-format image) :z-pixmap))
+  (read-image-z
+    (image-x-data image) 0 (length (image-x-data image)) nil
+    (index+ x (image-x-left-pad image)) y width height
+    (image-depth image) (image-x-bytes-per-line image)
+    (image-x-bits-per-pixel image)
+    (image-x-unit image) (image-x-byte-lsb-first-p image)
+    (image-x-bit-lsb-first-p image)))
+
+(defun copy-pixarray (array x y width height bits-per-pixel)
+  (declare (type pixarray array)
+	   (type card16 x y width height)
+	   (type (member 1 4 8 16 24 32) bits-per-pixel))
+  (let* ((bits-per-line (index* bits-per-pixel width))
+	 (padded-bits-per-line
+	   (index* (index-ceiling bits-per-line *image-pad*) *image-pad*))
+	 (padded-width (index-ceiling padded-bits-per-line bits-per-pixel))
+	 (copy (make-array (list height padded-width)
+			   :element-type (array-element-type array))))
+    (declare (type array-index bits-per-line padded-bits-per-line padded-width)
+	     (type pixarray copy))
+    #.(declare-buffun)
+    (unless (fast-copy-pixarray array copy x y width height bits-per-pixel)
+      (macrolet
+	((copy (array-type element-type)
+	   `(let ((array array)
+		  (copy copy))
+	      (declare (type ,array-type array copy))
+	      (do* ((dst-y 0 (index1+ dst-y))
+		    (src-y y (index1+ src-y)))
+		   ((index>= dst-y height))
+		(declare (type card16 dst-y src-y))
+		(do* ((dst-x 0 (index1+ dst-x))
+		      (src-x x (index1+ src-x)))
+		     ((index>= dst-x width))
+		  (declare (type card16 dst-x src-x))
+		  (setf (aref copy dst-y dst-x)
+			(the ,element-type
+			     (aref array src-y src-x))))))))
+	(ecase bits-per-pixel
+	  (1  (copy pixarray-1  pixarray-1-element-type))
+	  (4  (copy pixarray-4  pixarray-4-element-type))
+	  (8  (copy pixarray-8  pixarray-8-element-type))
+	  (16 (copy pixarray-16 pixarray-16-element-type))
+	  (24 (copy pixarray-24 pixarray-24-element-type))
+	  (32 (copy pixarray-32 pixarray-32-element-type)))))
+    copy))
+
+(defun image-xy->image-x (image x y width height)
+  (declare (type image-xy image)
+	   (type card16 x y width height)
+	   (values image-x))
+  (let* ((padded-bits-per-line
+	   (index* (index-ceiling width *image-pad*) *image-pad*))
+	 (padded-bytes-per-line (index-ceiling padded-bits-per-line 8))
+	 (padded-bytes-per-plane (index* padded-bytes-per-line height))
+	 (bytes-total (index* padded-bytes-per-plane (image-depth image)))
+	 (data (make-array bytes-total :element-type #-ecl 'card8
+			   #+ecl 'base-char)))
+    (declare (type array-index padded-bits-per-line padded-bytes-per-line
+		   padded-bytes-per-plane bytes-total)
+	     (type buffer-bytes data))
+    (let ((index 0))
+      (declare (type array-index index))
+      (dolist (bitmap (image-xy-bitmap-list image))
+	(declare (type pixarray-1 bitmap))
+	(write-pixarray
+	  data index bitmap x y width height padded-bytes-per-line 1
+	  *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*)
+	(index-incf index padded-bytes-per-plane)))
+    (create-image
+      :width width :height height :depth (image-depth image)
+      :data data :format :xy-pixmap :bits-per-pixel 1
+      :bytes-per-line padded-bytes-per-line
+      :unit *image-unit* :pad *image-pad*
+      :byte-lsb-first-p *image-byte-lsb-first-p*
+      :bit-lsb-first-p *image-bit-lsb-first-p*)))
+
+(defun image-xy->image-xy (image x y width height)
+  (declare (type image-xy image)
+	   (type card16 x y width height)
+	   (values image-xy))
+  (create-image
+    :width width :height height :depth (image-depth image)
+    :data (mapcar
+	    #'(lambda (array)
+		(declare (type pixarray-1 array))
+		(copy-pixarray array x y width height 1))
+	    (image-xy-bitmap-list image))))
+
+(defun image-xy->image-z (image x y width height)
+  (declare (type image-z image)
+	   (type card16 x y width height)
+	   (ignore image x y width height))
+  (error "Format conversion from ~S to ~S not supported"
+	 :xy-pixmap :z-pixmap))
+
+(defun image-z->image-x (image x y width height)
+  (declare (type image-z image)
+	   (type card16 x y width height)
+	   (values image-x))
+  (let* ((bits-per-line (index* width (image-z-bits-per-pixel image)))
+	 (padded-bits-per-line
+	   (index* (index-ceiling bits-per-line *image-pad*) *image-pad*))
+	 (padded-bytes-per-line (index-ceiling padded-bits-per-line 8))
+	 (bytes-total
+	   (index* padded-bytes-per-line height (image-depth image)))
+	 (data (make-array bytes-total :element-type #-ecl 'card8
+			   #+ecl 'base-char))
+	 (bits-per-pixel (image-z-bits-per-pixel image)))
+    (declare (type array-index bits-per-line padded-bits-per-line
+		   padded-bytes-per-line bytes-total)
+	     (type buffer-bytes data)
+	     (type (member 1 4 8 16 24 32) bits-per-pixel))
+    (write-pixarray
+      data 0 (image-z-pixarray image) x y width height padded-bytes-per-line 
+      (image-z-bits-per-pixel image)
+      *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*)
+    (create-image
+      :width width :height height :depth (image-depth image)
+      :data data :format :z-pixmap
+      :bits-per-pixel bits-per-pixel
+      :bytes-per-line padded-bytes-per-line
+      :unit *image-unit* :pad *image-pad*
+      :byte-lsb-first-p *image-byte-lsb-first-p*
+      :bit-lsb-first-p *image-bit-lsb-first-p*)))
+
+(defun image-z->image-xy (image x y width height)
+  (declare (type image-z image)
+	   (type card16 x y width height)
+	   (ignore image x y width height))
+  (error "Format conversion from ~S to ~S not supported"
+	 :z-pixmap :xy-pixmap))
+
+(defun image-z->image-z (image x y width height)
+  (declare (type image-z image)
+	   (type card16 x y width height)
+	   (values image-z))
+  (create-image
+    :width width :height height :depth (image-depth image)
+    :data (copy-pixarray
+	    (image-z-pixarray image) x y width height
+	    (image-z-bits-per-pixel image))))
+
+(defun copy-image (image &key (x 0) (y 0) width height result-type)
+  ;; Copy with optional sub-imaging and format conversion.
+  ;; result-type defaults to (type-of image)
+  (declare (type image image)
+	   (type card16 x y)
+	   (type (or null card16) width height) ;; Default from image
+	   (type (or null (member image-x image-xy image-z)) result-type))
+  (declare (values image))
+  (let* ((image-width (image-width image))
+	 (image-height (image-height image))
+	 (width (or width image-width))
+	 (height (or height image-height)))
+    (declare (type card16 image-width image-height width height))
+    (unless (index<= 0 x (index1- image-width)) (error "x not inside image"))
+    (unless (index<= 0 y (index1- image-height)) (error "y not inside image"))
+    (setq width (index-min width (index-max (index- image-width x) 0)))
+    (setq height (index-min height (index-max (index- image-height y) 0)))
+    (let ((copy
+	    (etypecase image
+	      (image-x
+		(ecase result-type
+		  ((nil image-x) (image-x->image-x image x y width height))
+		  (image-xy (image-x->image-xy image x y width height))
+		  (image-z  (image-x->image-z  image x y width height))))
+	      (image-xy
+		(ecase result-type
+		  (image-x (image-xy->image-x image x y width height))
+		  ((nil image-xy) (image-xy->image-xy image x y width height))
+		  (image-z  (image-xy->image-z image x y width height))))
+	      (image-z 
+		(ecase result-type
+		  (image-x (image-z->image-x image x y width height))
+		  (image-xy  (image-z->image-xy image x y width height))
+		  ((nil image-z) (image-z->image-z image x y width height)))))))
+      (declare (type image copy))
+      (setf (image-plist copy) (copy-list (image-plist image)))
+      (when (and (image-x-hot image) (not (index-zerop x)))
+	(setf (image-x-hot copy) (index- (image-x-hot image) x)))
+      (when (and (image-y-hot image) (not (index-zerop y)))
+	(setf (image-y-hot copy) (index- (image-y-hot image) y)))
+      copy)))
+
+
+;;;-----------------------------------------------------------------------------
+;;; Image I/O functions
+
+
+(defun read-bitmap-file (pathname)
+  ;; Creates an image from a C include file in standard X11 format
+  (declare (type (or pathname string stream) pathname))
+  (declare (values image))
+  (with-open-file (fstream pathname :direction :input)
+    (let ((line "")
+	  (properties nil)
+	  (name nil)
+	  (name-end nil))
+      (declare (type string line)
+	       (type stringable name)
+	       (type list properties))
+      ;; Get properties
+      (loop
+	(setq line (read-line fstream))
+	(unless (char= (aref line 0) #\#) (return))
+	(flet ((read-keyword (line start end)
+		 (kintern
+		   (substitute
+		     #\- #\_
+		     (#-excl string-upcase
+		      #+excl correct-case
+		      (subseq line start end))
+		     :test #'char=))))
+	  (when (null name)
+	    (setq name-end (position #\_ line :test #'char= :from-end t)
+		  name (read-keyword line 8 name-end))
+	    (unless (eq name :image)
+	      (setf (getf properties :name) name)))
+	  (let* ((ind-start (index1+ name-end))
+		 (ind-end (position #\Space line :test #'char=
+				    :start ind-start))
+		 (ind (read-keyword line ind-start ind-end))
+		 (val-start (index1+ ind-end))
+		 (val (parse-integer line :start val-start)))
+	    (setf (getf properties ind) val))))
+      ;; Calculate sizes
+      (multiple-value-bind (width height depth left-pad)
+	  (flet ((extract-property (ind &rest default)
+		   (prog1 (apply #'getf properties ind default)
+			  (remf properties ind))))
+	    (values (extract-property :width)
+		    (extract-property :height)
+		    (extract-property :depth 1)
+		    (extract-property :left-pad 0)))
+	(declare (type (or null card16) width height)
+		 (type image-depth depth)
+		 (type card8 left-pad))
+	(unless (and width height) (error "Not a BITMAP file"))
+	(let* ((bits-per-pixel
+		 (cond ((index> depth 24) 32)
+		       ((index> depth 16) 24)
+		       ((index> depth 8)  16)
+		       ((index> depth 4)   8)
+		       ((index> depth 1)   4)
+		       (t                  1)))
+	       (bits-per-line (index* width bits-per-pixel))
+	       (bytes-per-line (index-ceiling bits-per-line 8))
+	       (padded-bits-per-line
+		 (index* (index-ceiling bits-per-line 32) 32))
+	       (padded-bytes-per-line
+		 (index-ceiling padded-bits-per-line 8))
+	       (data (make-array (* padded-bytes-per-line height)
+				 :element-type #-ecl 'card8
+				 #+ecl 'base-char))
+	       (line-base 0)
+	       (byte 0))
+	  (declare (type array-index bits-per-line bytes-per-line
+			 padded-bits-per-line padded-bytes-per-line
+			 line-base byte)
+		   (type buffer-bytes data))
+	  (with-vector (data buffer-bytes)
+	    (flet ((parse-hex (char)
+		     (second
+		       (assoc char
+			      '((#\0  0) (#\1  1) (#\2  2) (#\3  3)
+				(#\4  4) (#\5  5) (#\6  6) (#\7  7)
+				(#\8  8) (#\9  9) (#\a 10) (#\b 11)
+				(#\c 12) (#\d 13) (#\e 14) (#\f 15))
+			      :test #'char-equal))))
+	      (declare (inline parse-hex))
+	      ;; Read data
+	      ;; Note: using read-line instead of read-char would be 20% faster,
+	      ;;       but would cons a lot of garbage...
+	      (dotimes (i height)
+		(dotimes (j bytes-per-line)
+		  (loop (when (eql (read-char fstream) #\x) (return)))
+		  (setf (aref data (index+ line-base byte))
+			#+ecl
+			(int-char
+			 (index+ (index-ash
+				  (the fixnum
+				       (parse-hex (read-char fstream))) 4)
+				 (the fixnum
+				      (parse-hex (read-char fstream)))))
+			#-ecl
+			(index+ (index-ash (parse-hex (read-char fstream)) 4)
+				(parse-hex (read-char fstream))))
+		  (incf byte))
+		(setq byte 0
+		      line-base (index+ line-base padded-bytes-per-line)))))
+	  ;; Compensate for left-pad in width and x-hot
+	  (index-decf width left-pad)
+	  (when (getf properties :x-hot)
+	    (index-decf (getf properties :x-hot) left-pad))
+	  (create-image
+	    :width width :height height
+	    :depth depth :bits-per-pixel bits-per-pixel
+	    :data data :plist properties :format :z-pixmap
+	    :bytes-per-line padded-bytes-per-line
+	    :unit 32 :pad 32 :left-pad left-pad
+	    :byte-lsb-first-p t :bit-lsb-first-p t))))))
+
+(defun write-bitmap-file (pathname image &optional name)
+  ;; Writes an image to a C include file in standard X11 format
+  ;; NAME argument used for variable prefixes.  Defaults to "image"
+  (declare (type (or pathname string stream) pathname)
+	   (type image image)
+	   (type (or null stringable) name))
+  (unless (typep image 'image-x)
+    (setq image (copy-image image :result-type 'image-x)))
+  (let* ((plist (image-plist image))
+	 (name (or name (image-name image) 'image))
+	 (left-pad (image-x-left-pad image))
+	 (width (index+ (image-width image) left-pad))
+	 (height (image-height image))
+	 (depth
+	   (if (eq (image-x-format image) :z-pixmap)
+	       (image-depth image)
+	     1))
+	 (bits-per-pixel (image-x-bits-per-pixel image))
+	 (bits-per-line (index* width bits-per-pixel))
+	 (bytes-per-line (index-ceiling bits-per-line 8))
+	 (last (index* bytes-per-line height))
+	 (count 0))
+    (declare (type list plist)
+	     (type stringable name)
+	     (type card8 left-pad)
+	     (type card16 width height)
+	     (type (member 1 4 8 16 24 32) bits-per-pixel)
+	     (type image-depth depth)
+	     (type array-index bits-per-line bytes-per-line count last))
+    ;; Move x-hot by left-pad, if there is an x-hot, so image readers that
+    ;; don't know about left pad get the hot spot in the right place.  We have
+    ;; already increased width by left-pad.
+    (when (getf plist :x-hot)
+      (setq plist (copy-list plist))
+      (index-incf (getf plist :x-hot) left-pad))
+    (with-image-data-buffer (data last)
+      (multiple-value-bind (image-swap-function image-swap-lsb-first-p)
+	  (image-swap-function
+	    bits-per-pixel
+	    (image-x-unit image) (image-x-byte-lsb-first-p image)
+	    (image-x-bit-lsb-first-p image) 32 t t)
+	(declare (type symbol image-swap-function)
+		 (type boolean image-swap-lsb-first-p))
+	(funcall
+	  (symbol-function image-swap-function) (image-x-data image)
+	  data 0 0 bytes-per-line (image-x-bytes-per-line image)
+	  bytes-per-line height image-swap-lsb-first-p))
+      (with-vector (data buffer-bytes)
+	(setq name (string-downcase (string name)))
+	(with-open-file (fstream pathname :direction :output)
+	  (format fstream "#define ~a_width ~d~%" name width)
+	  (format fstream "#define ~a_height ~d~%" name height)
+	  (unless (= depth 1)
+	    (format fstream "#define ~a_depth ~d~%" name depth))
+	  (unless (zerop left-pad)
+	    (format fstream "#define ~a_left_pad ~d~%" name left-pad))
+	  (do ((prop plist (cddr prop)))
+	      ((endp prop))
+	    (when (and (not (member (car prop) '(:width :height)))
+		       (numberp (cadr prop)))
+	      (format fstream "#define ~a_~a ~d~%"
+		      name
+		      (substitute
+			#\_ #\- (string-downcase (string (car prop)))
+			:test #'char=)
+		      (cadr prop))))
+	  (format fstream "static char ~a_bits[] = {" name)
+	  (dotimes (i height)
+	    (dotimes (j bytes-per-line)
+	      (when (zerop (index-mod count 15))
+		(terpri fstream)
+		(write-char #\space fstream))
+	      (write-string "0x" fstream)
+	      ;; Faster than (format fstream "0x~2,'0x," byte)
+	      (let ((byte (aref data count))
+		    (translate "0123456789abcdef"))
+		(declare (type card8 byte))
+		(write-char (char translate (ldb (byte 4 4) byte)) fstream)
+		(write-char (char translate (ldb (byte 4 0) byte)) fstream))
+	      (index-incf count)
+	      (unless (index= count last)
+		(write-char #\, fstream))))
+	  (format fstream "};~%" fstream))))))
+
+(defun bitmap-image (&optional plist &rest patterns)
+  ;; Create an image containg pattern
+  ;; PATTERNS are bit-vector constants (e.g. #*10101)
+  ;; If the first parameter is a list, its used as the image property-list.
+  (declare (type (or list bit-vector) plist)
+	   (type list patterns)) ;; list of bitvector
+  (declare (values image))
+  (unless (listp plist)
+    (push plist patterns)
+    (setq plist nil))
+  (let* ((width (length (first patterns)))
+	 (height (length patterns))
+	 (bitarray (make-array (list height width) :element-type 'bit))
+	 (row 0))
+    (declare (type card16 width height row)
+	     (type pixarray-1 bitarray))
+    #+ecl (declare (fixnum width height))
+    (dolist (pattern patterns)
+      (declare (type simple-bit-vector pattern))
+      (dotimes (col width)
+	(declare (type card16 col))
+	(setf (aref bitarray row col) (the bit (aref pattern col))))
+      (incf row))
+    (create-image :width width :height height :plist plist :data bitarray)))
+
+(defun image-pixmap (drawable image &key gcontext width height depth)
+  ;; Create a pixmap containing IMAGE. Size defaults from the image.
+  ;; DEPTH is the pixmap depth.
+  ;; GCONTEXT is used for putting the image into the pixmap.
+  ;; If none is supplied, then one is created, used then freed.
+  (declare (type drawable drawable)
+	   (type image image)
+	   (type (or null gcontext) gcontext)
+	   (type (or null card16) width height)
+	   (type (or null card8) depth))
+  (declare (values pixmap))
+  (let* ((image-width (image-width image))
+	 (image-height (image-height image))
+	 (image-depth (image-depth image))
+	 (width (or width image-width))
+	 (height (or height image-height))
+	 (depth (or depth image-depth))
+	 (pixmap (create-pixmap :drawable drawable
+			       :width width
+			       :height height
+			       :depth depth))
+	 (gc (or gcontext (create-gcontext
+			    :drawable pixmap
+			    :foreground 1
+			    :background 0))))
+    (unless (= depth image-depth)
+      (if (= image-depth 1)
+	  (unless gcontext (xlib::required-arg gcontext))
+	(error "Pixmap depth ~d incompatable with image depth ~d"
+	       depth image-depth)))	       
+    (put-image pixmap gc image :x 0 :y 0 :bitmap-p (and (= image-depth 1) gcontext))
+    ;; Tile when image-width is less than the pixmap width, or
+    ;; the image-height is less than the pixmap height.
+    ;; ??? Would it be better to create a temporary pixmap and 
+    ;; ??? let the server do the tileing?
+    (do ((x image-width (+ x image-width)))
+	((>= x width))
+      (copy-area pixmap gc 0 0 image-width image-height pixmap x 0)
+      (incf image-width image-width))
+    (do ((y image-height (+ y image-height)))
+	((>= y height))
+      (copy-area pixmap gc 0 0 image-width image-height pixmap 0 y)
+      (incf image-height image-height))
+    (unless gcontext (free-gcontext gc))
+    pixmap))
+
diff --git a/src/clx/init.lsp b/src/clx/init.lsp
new file mode 100644
index 000000000..4d6f2a677
--- /dev/null
+++ b/src/clx/init.lsp
@@ -0,0 +1,9 @@
+(load "../util/system")
+(load "defsys")
+(load "cmpinit")
+
+;(sbt:build-system clx)
+;(setq *print-circle* t)
+(allocate 'cons 800 t)
+(si:ALLOCATE-RELOCATABLE-PAGES 200)
+;(setq si:*gc-verbose* nil)
diff --git a/src/clx/input.lsp b/src/clx/input.lsp
new file mode 100644
index 000000000..3c5559819
--- /dev/null
+++ b/src/clx/input.lsp
@@ -0,0 +1,1894 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;; This file contains definitions for the DISPLAY object for Common-Lisp X windows version 11
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+;;;
+;;; Change history:
+;;;
+;;;  Date	Author	Description
+;;; -------------------------------------------------------------------------------------
+;;; 12/10/87	LGO	Created
+
+(in-package :xlib)
+
+;; Event Resource
+(defvar *event-free-list* nil) ;; List of unused (processed) events
+
+(eval-when (eval compile load)
+(defconstant *max-events* 64) ;; Maximum number of events supported (the X11 alpha release only has 34)
+(defvar *event-key-vector* (make-array *max-events* :initial-element nil)
+  "Vector of event keys - See define-event")
+)
+(defvar *event-macro-vector* (make-array *max-events* :initial-element nil)
+  "Vector of event handler functions - See declare-event")
+(defvar *event-handler-vector* (make-array *max-events* :initial-element nil)
+  "Vector of event handler functions - See declare-event")
+(defvar *event-send-vector* (make-array *max-events* :initial-element nil)
+  "Vector of event sending functions - See declare-event")
+
+;;; Added by ECL:
+(proclaim '(type simple-vector
+	    *event-key-vector*
+	    *event-macro-vector*
+	    *event-handler-vector*
+	    *event-send-vector*))
+
+(defun allocate-event ()
+  (or (threaded-atomic-pop *event-free-list* reply-next reply-buffer)
+      (make-reply-buffer *replysize*)))
+
+(defun deallocate-event (reply-buffer)
+  (declare (type reply-buffer reply-buffer))
+  (setf (reply-size reply-buffer) *replysize*)
+  (threaded-atomic-push reply-buffer *event-free-list* reply-next reply-buffer))
+
+;; Extensions are handled as follows:
+;; DEFINITION:	Use DEFINE-EXTENSION
+;;
+;; CODE:	Use EXTENSION-CODE to get the X11 opcode for an extension.
+;;		This looks up the code on the display-extension-alist.
+;;
+;; EVENTS:	Use DECLARE-EVENT to define events. This calls ALLOCATE-EXTENSION-EVENT-CODE
+;;		at LOAD time to define an internal event-code number
+;;		(stored in the 'event-code property of the event-name)
+;;		used to index the following vectors:
+;;		*event-key-vector* 	Used for getting the event-key
+;;		*event-macro-vector*	Used for getting the event-parameter getting macros
+;;
+;;		The GET-INTERNAL-EVENT-CODE function can be called at runtime to convert
+;;		a server event-code into an internal event-code used to index the following
+;;		vectors:
+;;		*event-handler-vector*	Used for getting the event-handler function
+;;		*event-send-vector*	Used for getting the event-sending function
+;;
+;;		The GET-EXTERNAL-EVENT-CODE function can be called at runtime to convert
+;;		internal event-codes to external (server) codes.
+;;
+;; ERRORS:	Use DEFINE-ERROR to define new error decodings.
+;;
+
+
+;; Any event-code greater than 34 is for an extension
+(defparameter *first-extension-event-code* 35)
+
+(defvar *extensions* nil) ;; alist of (extension-name-symbol events errors)
+
+(defmacro define-extension (name &key events errors)
+  ;; Define extension NAME with EVENTS and ERRORS.
+  ;; Note: The case of NAME is important.
+  ;; To define the request, Use:
+  ;;     (with-buffer-request (display (extension-opcode ,name)) ,@body)
+  ;;     See the REQUESTS file for lots of examples.
+  ;; To define event handlers, use declare-event.
+  ;; To define error handlers, use declare-error and define-condition.
+  (declare (type stringable name)
+	   (type list events errors))
+  (let ((name-symbol (kintern name)) ;; Intern name in the keyword package
+	(event-list (mapcar #'canonicalize-event-name events)))
+    `(eval-when (compile load eval)
+       (setq *extensions* (cons (list ',name-symbol ',event-list ',errors)
+				(delete ',name-symbol *extensions* :key #'car))))))
+
+(eval-when (compile eval load)
+(defun canonicalize-event-name (event)
+  ;; Returns the event name keyword given an event name stringable
+  (declare (type stringable event))
+  (declare (values event-key))
+  (kintern event))
+) ;; end eval-when
+
+(eval-when (compile eval load)
+(defun allocate-extension-event-code (name)
+  ;; Allocate an event-code for an extension
+  ;; This is executed at COMPILE and LOAD time from DECLARE-EVENT.
+  ;; The event-code is used at compile-time by macros to index the following vectors:
+  ;; *event-key-vector* *event-macro-vector* *event-handler-vector* *event-send-vector*
+  (let ((event-code (get name 'event-code)))
+    (declare (type (or null card8) event-code))
+    (unless event-code
+      ;; First ensure the name is for a declared extension
+      (unless (dolist (extension *extensions*)
+		(when (member name (second extension))
+		  (return t)))
+	(x-type-error name 'event-key))
+      (setq event-code (position nil *event-key-vector*
+				 :start *first-extension-event-code*))
+      (setf (svref *event-key-vector* event-code) name)
+      (setf (get name 'event-code) event-code))
+    event-code))
+) ;; end eval-when
+
+(defun get-internal-event-code (display code)
+  ;; Given an X11 event-code, return the internal event-code.
+  ;; The internal event-code is used for indexing into the following vectors:
+  ;; *event-key-vector* *event-handler-vector* *event-send-vector*
+  ;; Returns NIL when the event-code is for an extension that isn't handled.
+  (declare (type display display)
+	   (type card8 code))
+  (declare (values (or null card8)))
+  (setq code (logand #x7f code))
+  (if (< code *first-extension-event-code*)
+      code
+    (let* ((code-offset (- code *first-extension-event-code*))
+	   (event-extensions (display-event-extensions display))
+	   (code (if (< code-offset (length event-extensions))
+		     (aref event-extensions code-offset)
+		   0)))
+      (declare (type card8 code-offset code))
+      (when (zerop code)
+	(x-cerror "Ignore the event"
+		  'unimplemented-event :event-code code :display display))
+      code)))
+
+(defun get-external-event-code (display event)
+  ;; Given an X11 event name, return the event-code
+  (declare (type display display)
+	   (type event-key event))
+  (declare (values card8))
+  (let ((code (get-event-code event)))
+    (declare (type (or null card8) code))
+    (when (>= code *first-extension-event-code*)
+      (setq code (+ *first-extension-event-code*
+		    (or (position code (display-event-extensions display))
+			(x-error 'undefined-event :display display :event-name event)))))
+    code))
+
+(defmacro extension-opcode (display name)
+  ;; Returns the major opcode for extension NAME.
+  ;; This is a macro to enable NAME to be interned for fast run-time
+  ;; retrieval. 
+  ;; Note: The case of NAME is important.
+  (let ((name-symbol (kintern name))) ;; Intern name in the keyword package
+    `(or (second (assoc ',name-symbol (display-extension-alist ,display)))
+	 (x-error 'absent-extension :name ',name-symbol :display ,display))))
+
+(defun initialize-extensions (display)
+  ;; Initialize extensions for DISPLAY
+  (let ((event-extensions (make-array 16 :element-type 'card8 :initial-element 0))
+	(extension-alist nil))
+    (declare (type vector event-extensions)
+	     (type list extension-alist))
+    (dolist (extension *extensions*)
+      (let ((name (first extension))
+	    (events (second extension)))
+	(declare (type keyword name)
+		 (type list events))
+	(multiple-value-bind (major-opcode first-event first-error)
+	    (query-extension display name)
+	  (declare (type (or null card8) major-opcode first-event first-error))
+	  (when (and major-opcode (plusp major-opcode))
+	    (push (list name major-opcode first-event first-error)
+		  extension-alist)
+	    (when (plusp first-event) ;; When there are extension events
+	      ;; Grow extension vector when needed
+	      (let ((max-event (- (+ first-event (length events))
+				  *first-extension-event-code*)))
+		(declare (type card8 max-event))
+		(when (>= max-event (length event-extensions))
+		  (let ((new-extensions (make-array (+ max-event 16) :element-type 'card8
+						    :initial-element 0)))
+		    (declare (type vector new-extensions))
+		    (replace new-extensions event-extensions)
+		    (setq event-extensions new-extensions))))
+	      (dolist (event events)
+		(declare (type symbol event))
+		(setf (aref event-extensions (- first-event *first-extension-event-code*))
+		      (get-event-code event))
+		(incf first-event)))))))
+    (setf (display-event-extensions display) event-extensions)
+    (setf (display-extension-alist display) extension-alist)))
+
+;;
+;; Reply handlers
+;;
+
+(defvar *pending-command-free-list* nil)
+
+(defun start-pending-command (display)
+  (declare (type display display))
+  (let ((pending-command (or (threaded-atomic-pop *pending-command-free-list*
+						  pending-command-next pending-command)
+			     (make-pending-command))))
+    (declare (type pending-command pending-command))
+    (setf (pending-command-reply-buffer pending-command) nil)
+    (setf (pending-command-process pending-command) (current-process))
+    (setf (pending-command-sequence pending-command)
+	  (ldb (byte 16 0) (1+ (buffer-request-number display))))
+    ;; Add the pending command to the end of the threaded list of pending
+    ;; commands for the display.
+    (with-event-queue-internal (display)
+      (threaded-nconc pending-command (display-pending-commands display)
+		      pending-command-next pending-command))
+    pending-command))
+
+(defun stop-pending-command (display pending-command)
+  (declare (type display display)
+	   (type pending-command pending-command))
+  (with-event-queue-internal (display)
+    ;; Remove the pending command from the threaded list of pending commands
+    ;; for the display.
+    (threaded-delete pending-command (display-pending-commands display)
+		     pending-command-next pending-command)
+    ;; Deallocate any reply buffers in this pending command
+    (loop
+      (let ((reply-buffer
+	      (threaded-pop (pending-command-reply-buffer pending-command)
+			    reply-next reply-buffer)))
+	(declare (type (or null reply-buffer) reply-buffer))
+	(if reply-buffer
+	    (deallocate-reply-buffer reply-buffer)
+	  (return nil)))))
+  ;; Clear pointers to help the Garbage Collector
+  (setf (pending-command-process pending-command) nil)
+  ;; Deallocate this pending-command
+  (threaded-atomic-push pending-command *pending-command-free-list*
+			pending-command-next pending-command)
+  nil)
+
+;;;
+
+(defvar *reply-buffer-free-lists* (make-array 32 :initial-element nil))
+
+(defun allocate-reply-buffer (size)
+  (declare (type array-index size))
+  (if (index<= size *replysize*)
+      (allocate-event)
+    (let ((index (integer-length (index1- size))))
+      (declare (type array-index index))
+      (or (threaded-atomic-pop (svref *reply-buffer-free-lists* index)
+			       reply-next reply-buffer)
+	  (make-reply-buffer (index-ash 1 index))))))
+
+(defun deallocate-reply-buffer (reply-buffer)
+  (declare (type reply-buffer reply-buffer))
+  (let ((size (reply-size reply-buffer)))
+    (declare (type array-index size))
+    (if (index<= size *replysize*)
+	(deallocate-event reply-buffer)
+      (let ((index (integer-length (index1- size))))
+	(declare (type array-index index))
+	(threaded-atomic-push reply-buffer (svref *reply-buffer-free-lists* index)
+			      reply-next reply-buffer)))))
+
+;;;
+
+(defun read-error-input (display sequence reply-buffer token)
+  (declare (type display display)
+	   (type reply-buffer reply-buffer)
+	   (type card16 sequence))
+  (tagbody
+    start
+       (with-event-queue-internal (display)
+	 (let ((command 
+		 ;; Find any pending command with this sequence number.
+		 (threaded-dolist (pending-command (display-pending-commands display)
+						   pending-command-next pending-command)
+		   (when (= (pending-command-sequence pending-command) sequence)
+		     (return pending-command)))))
+	   (declare (type (or null pending-command) command))
+	   (cond ((not (null command))
+		  ;; Give this reply to the pending command
+		  (threaded-nconc reply-buffer (pending-command-reply-buffer command)
+				  reply-next reply-buffer)
+		  (process-wakeup (pending-command-process command)))
+		 ((member :immediately (display-report-asynchronous-errors display))
+		  ;; No pending command and we should report the error immediately
+		  (go report-error))
+		 (t
+		  ;; No pending command found, count this as an asynchronous error
+		  (threaded-nconc reply-buffer (display-asynchronous-errors display)
+				  reply-next reply-buffer)))))
+       (return-from read-error-input nil)
+    report-error
+       (note-input-complete display token)
+       (apply #'report-error display
+	      (prog1 (make-error display reply-buffer t)
+		     (deallocate-event reply-buffer)))))
+
+(defun read-reply-input (display sequence length reply-buffer)
+  (declare (type display display)
+	   (type (or null reply-buffer) reply-buffer)
+	   (type card16 sequence)
+	   (type array-index length))
+  (unwind-protect 
+      (progn
+	(when (index< *replysize* length)
+	  (let ((repbuf nil))
+	    (declare (type (or null reply-buffer) repbuf))
+	    (unwind-protect
+		(progn
+		  (setq repbuf (allocate-reply-buffer length))
+		  (buffer-replace (reply-ibuf8 repbuf) (reply-ibuf8 reply-buffer)
+				  0 *replysize*)
+		  (deallocate-event (shiftf reply-buffer repbuf nil)))
+	      (when repbuf
+		(deallocate-reply-buffer repbuf))))
+	  (when (buffer-input display (reply-ibuf8 reply-buffer) *replysize* length)
+	    (return-from read-reply-input t))
+	  (setf (reply-data-size reply-buffer) length))
+	(with-event-queue-internal (display)
+	  ;; Find any pending command with this sequence number.
+	  (let ((command 
+		  (threaded-dolist (pending-command (display-pending-commands display)
+						    pending-command-next pending-command)
+		    (when (= (pending-command-sequence pending-command) sequence)
+		      (return pending-command)))))
+	    (declare (type (or null pending-command) command))
+	    (when command 
+	      ;; Give this reply to the pending command
+	      (threaded-nconc (shiftf reply-buffer nil)
+			      (pending-command-reply-buffer command)
+			      reply-next reply-buffer)
+	      (process-wakeup (pending-command-process command)))))
+	nil)
+    (when reply-buffer
+      (deallocate-reply-buffer reply-buffer))))
+
+(defun read-event-input (display code reply-buffer)
+  (declare (type display display)
+	   (type card8 code)
+	   (type reply-buffer reply-buffer))
+  ;; Push the event in the input buffer on the display's event queue
+  (setf (event-code reply-buffer)
+	(get-internal-event-code display code))
+  (enqueue-event reply-buffer display)
+  nil)
+
+(defun note-input-complete (display token)
+  (declare (type display display))
+  (when (eq (display-input-in-progress display) token)
+    ;; Indicate that input is no longer in progress
+    (setf (display-input-in-progress display) nil)
+    ;; Let the event process get the first chance to do input
+    (let ((process (display-event-process display)))
+      (when (not (null process))
+	(process-wakeup process)))
+    ;; Then give processes waiting for command responses a chance
+    (unless (display-input-in-progress display)
+      (with-event-queue-internal (display)
+	(threaded-dolist (command (display-pending-commands display)
+				  pending-command-next pending-command)
+	  (process-wakeup (pending-command-process command)))))))
+
+(defun read-input (display timeout force-output-p predicate &rest predicate-args)
+  (declare (type display display)
+	   (type (or null number) timeout)
+	   (type boolean force-output-p)
+	   (dynamic-extent predicate-args))
+  (declare (type function predicate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent predicate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg predicate))
+  (let ((reply-buffer nil)
+	(token (or (current-process) (cons nil nil))))
+    (declare (type (or null reply-buffer) reply-buffer))
+    (unwind-protect 
+	(tagbody
+	  loop
+	     (when (display-dead display)
+	       (x-error 'closed-display :display display))
+	     (when (apply predicate predicate-args)
+	       (return-from read-input nil))
+	     ;; Check and see if we have to force output
+	     (when (and force-output-p
+			(or (and (not (eq (display-input-in-progress display) token))
+				 (not (conditional-store
+					(display-input-in-progress display) nil token)))
+			    (null (buffer-listen display))))
+	       (go force-output))
+	     ;; Ensure that ony one process is reading input.
+	     (unless (or (eq (display-input-in-progress display) token)
+			 (conditional-store (display-input-in-progress display) nil token))
+	       (if (eql timeout 0)
+		   (return-from read-input :timeout)
+		 (apply #'process-block "CLX Input Lock"
+			#'(lambda (display predicate &rest predicate-args)
+			    (declare (type display display)
+				     (dynamic-extent predicate-args)
+				     (type function predicate)
+				     #+clx-ansi-common-lisp
+				     (dynamic-extent predicate)
+				     #+(and lispm (not clx-ansi-common-lisp))
+				     (sys:downward-funarg predicate))
+			    (or (apply predicate predicate-args)
+				(null (display-input-in-progress display))
+				(not (null (display-dead display)))))
+			display predicate predicate-args))
+	       (go loop))
+	     ;; Now start gobbling.
+	     (setq reply-buffer (allocate-event))
+	     (with-buffer-input (reply-buffer :sizes (8 16 32))
+	       (let ((type 0))
+		 (declare (type card8 type))
+		 ;; Wait for input before we disallow aborts.
+		 (unless (eql timeout 0)
+		   (let ((eof-p (buffer-input-wait display timeout)))
+		     (when eof-p (return-from read-input eof-p))))
+		 (without-aborts
+		   (let ((eof-p (buffer-input display buffer-bbuf 0 *replysize*
+					      (if force-output-p 0 timeout))))
+		     (when eof-p
+		       (when (eq eof-p :timeout)
+			 (if force-output-p
+			     (go force-output)
+			   (return-from read-input :timeout)))
+		       (setf (display-dead display) t)
+		       (return-from read-input eof-p)))
+		   (setf (reply-data-size reply-buffer) *replysize*)
+		   (when (= (the card8 (setq type (read-card8 0))) 1)
+		     ;; Normal replies can be longer than *replysize*, so we
+		     ;; have to handle them while aborts are still disallowed.
+		     (let ((value
+			     (read-reply-input
+			       display (read-card16 2)
+			       (index+ *replysize* (index* (read-card32 4) 4))
+			       (shiftf reply-buffer nil))))
+		       (when value
+			 (return-from read-input value))
+		       (go loop))))
+		 (if (zerop type)
+		     (read-error-input
+		       display (read-card16 2) (shiftf reply-buffer nil) token)
+		   (read-event-input
+		     display (read-card8 0) (shiftf reply-buffer nil)))))
+	     (go loop)
+	  force-output 
+	     (note-input-complete display token)
+	     (display-force-output display)
+	     (setq force-output-p nil)
+	     (go loop))
+      (when (not (null reply-buffer))
+	(deallocate-reply-buffer reply-buffer))
+      (note-input-complete display token))))
+
+(defun report-asynchronous-errors (display mode)
+  (when (and (display-asynchronous-errors display)
+	     (member mode (display-report-asynchronous-errors display)))
+    (let ((aborted t))
+      (unwind-protect 
+	  (loop
+	    (let ((error
+		    (with-event-queue-internal (display)
+		      (threaded-pop (display-asynchronous-errors display)
+				    reply-next reply-buffer))))
+	      (declare (type (or null reply-buffer) error))
+	      (if error
+		  (apply #'report-error display
+			 (prog1 (make-error display error t)
+				(deallocate-event error)))
+		(return (setq aborted nil)))))
+	;; If we get aborted out of this, deallocate all outstanding asynchronous
+	;; errors.
+	(when aborted 
+	  (with-event-queue-internal (display)
+	    (loop
+	      (let ((reply-buffer
+		      (threaded-pop (display-asynchronous-errors display)
+				    reply-next reply-buffer)))
+		(declare (type (or null reply-buffer) reply-buffer))
+		(if reply-buffer
+		    (deallocate-event reply-buffer)
+		  (return nil))))))))))
+
+(defun wait-for-event (display timeout force-output-p)
+  (declare (type display display)
+	   (type (or null number) timeout)
+	   (type boolean force-output-p))
+  (let ((event-process-p (not (eql timeout 0))))
+    (declare (type boolean event-process-p))
+    (unwind-protect
+	(loop
+	  (when event-process-p
+	    (conditional-store (display-event-process display) nil (current-process)))
+	  (let ((eof (read-input
+		       display timeout force-output-p 
+		       #'(lambda (display)
+			   (declare (type display display))
+			   (or (not (null (display-new-events display)))
+			       (and (display-asynchronous-errors display)
+				    (member :before-event-handling
+					    (display-report-asynchronous-errors display))
+				    t)))
+		       display)))
+	    (when eof (return eof)))
+	  ;; Report asynchronous errors here if the user wants us to.
+	  (when event-process-p
+	    (report-asynchronous-errors display :before-event-handling))
+	  (when (not (null (display-new-events display)))
+	    (return nil)))
+      (when (and event-process-p
+		 (eq (display-event-process display) (current-process)))
+	(setf (display-event-process display) nil)))))
+
+(defun read-reply (display pending-command)
+  (declare (type display display)
+	   (type pending-command pending-command))
+  (loop
+    (when (read-input display nil nil
+		      #'(lambda (pending-command)
+			  (declare (type pending-command pending-command))
+			  (not (null (pending-command-reply-buffer pending-command))))
+		      pending-command)
+      (x-error 'closed-display :display display))
+    (let ((reply-buffer
+	    (with-event-queue-internal (display)
+	      (threaded-pop (pending-command-reply-buffer pending-command)
+			    reply-next reply-buffer))))
+      (declare (type reply-buffer reply-buffer))
+      ;; Check for error.
+      (with-buffer-input (reply-buffer)
+	(ecase (read-card8 0)
+	  (0 (apply #'report-error display
+		    (prog1 (make-error display reply-buffer nil)
+			   (deallocate-reply-buffer reply-buffer))))
+	  (1 (return reply-buffer)))))))
+
+;;;
+
+(defun event-listen (display &optional (timeout 0))
+  (declare (type display display)
+	   (type (or null number) timeout)
+	   (values number-of-events-queued eof-or-timeout))
+  ;; Returns the number of events queued locally, if any, else nil.  Hangs
+  ;; waiting for events, forever if timeout is nil, else for the specified
+  ;; number of seconds.
+  (let* ((current-event-symbol (car (display-current-event-symbol display)))
+	 (current-event (and (boundp current-event-symbol)
+			     (symbol-value current-event-symbol)))
+	 (queue (if current-event
+		    (reply-next (the reply-buffer current-event))
+		  (display-event-queue-head display))))
+    (declare (type symbol current-event-symbol)
+	     (type (or null reply-buffer) current-event queue))
+    (if queue
+	(values
+	  (with-event-queue-internal (display :timeout timeout)
+	    (threaded-length queue reply-next reply-buffer))
+	  nil)
+      (with-event-queue (display :timeout timeout :inline t)
+	(let ((eof-or-timeout (wait-for-event display timeout nil)))
+	  (if eof-or-timeout
+	      (values nil eof-or-timeout)
+	    (values 
+	      (with-event-queue-internal (display :timeout timeout)
+		(threaded-length (display-new-events display)
+				 reply-next reply-buffer))
+	      nil)))))))
+
+(defun queue-event (display event-key &rest args &key append-p send-event-p &allow-other-keys)
+  ;; The event is put at the head of the queue if append-p is nil, else the tail.
+  ;; Additional arguments depend on event-key, and are as specified above with
+  ;; declare-event, except that both resource-ids and resource objects are accepted
+  ;; in the event components.
+  (declare (type display display)
+	   (type event-key event-key)
+	   (type boolean append-p send-event-p)
+	   (dynamic-extent args))
+  (unless (get event-key 'event-code)
+    (x-type-error event-key 'event-key))
+  (let* ((event (allocate-event))
+	 (buffer (reply-ibuf8 event))
+	 (event-code (get event-key 'event-code)))
+    (declare (type reply-buffer event)
+	     (type buffer-bytes buffer)
+	     (type (or null card8) event-code))
+    (unless event-code (x-type-error event-key 'event-key))
+    (setf (event-code event) event-code)
+    (with-display (display)
+      (apply (svref *event-send-vector* event-code) display args)
+      (buffer-replace buffer
+		      (display-obuf8 display)
+		      0
+		      *replysize*
+		      (index+ 12 (buffer-boffset display)))
+      (setf (aref buffer 0) (if send-event-p (logior event-code #x80) event-code)
+	    (aref buffer 2) 0
+	    (aref buffer 3) 0))
+    (with-event-queue (display)
+      (if append-p
+	  (enqueue-event event display)
+	(with-event-queue-internal (display)
+	  (threaded-requeue event
+			    (display-event-queue-head display)
+			    (display-event-queue-tail display)
+			    reply-next reply-buffer))))))
+
+(defun enqueue-event (new-event display)
+  (declare (type reply-buffer new-event)
+	   (type display display))
+  ;; Place EVENT at the end of the event queue for DISPLAY
+  (let* ((event-code (event-code new-event))
+	 (event-key (and (index< event-code (length *event-key-vector*))
+			 (svref *event-key-vector* event-code))))
+    (declare (type array-index event-code)
+	     (type (or null keyword) event-key))
+    (if (null event-key)
+	(unwind-protect
+	    (cerror "Ignore this event" "No handler for ~s event" event-key)
+	  (deallocate-event new-event))
+      (with-event-queue-internal (display)
+	(threaded-enqueue new-event
+			  (display-event-queue-head display)
+			  (display-event-queue-tail display)
+			  reply-next reply-buffer)
+	(unless (display-new-events display)
+	  (setf (display-new-events display) new-event))))))
+
+
+(defmacro define-event (name code)
+  `(eval-when (eval compile load)
+     (setf (svref *event-key-vector* (the card8 ,code)) ',name)	; ECL
+     (setf (get ',name 'event-code) ,code)))
+
+;; Event names.  Used in "type" field in XEvent structures.  Not to be
+;; confused with event masks above.  They start from 2 because 0 and 1
+;; are reserved in the protocol for errors and replies. */
+
+(define-event :key-press 2)
+(define-event :key-release 3)
+(define-event :button-press 4)
+(define-event :button-release 5)
+(define-event :motion-notify 6)
+(define-event :enter-notify 7)
+(define-event :leave-notify 8)
+(define-event :focus-in 9)
+(define-event :focus-out 10)
+(define-event :keymap-notify 11)
+(define-event :exposure 12)
+(define-event :graphics-exposure 13)
+(define-event :no-exposure 14)
+(define-event :visibility-notify 15)
+(define-event :create-notify 16)
+(define-event :destroy-notify 17)
+(define-event :unmap-notify 18)
+(define-event :map-notify 19)
+(define-event :map-request 20)
+(define-event :reparent-notify 21)
+(define-event :configure-notify 22)
+(define-event :configure-request 23)
+(define-event :gravity-notify 24)
+(define-event :resize-request 25)
+(define-event :circulate-notify 26)
+(define-event :circulate-request 27)
+(define-event :property-notify 28)
+(define-event :selection-clear 29)
+(define-event :selection-request 30)
+(define-event :selection-notify 31)
+(define-event :colormap-notify 32)
+(define-event :client-message 33)
+(define-event :mapping-notify 34)
+
+
+(defmacro declare-event (event-codes &body declares)
+  ;; Used to indicate the keyword arguments for handler functions in
+  ;; process-event and event-case.
+  ;; Generates the functions used in SEND-EVENT.
+  ;; A compiler warning is printed when all of EVENT-CODES are not
+  ;; defined by a preceding DEFINE-EXTENSION.
+  ;; The body is a list of declarations, each of which has the form:
+  ;; (type . items)  Where type is a data-type, and items is a list of
+  ;; symbol names.  The item order corresponds to the order of fields
+  ;; in the event sent by the server.  An item may be a list of items.
+  ;; In this case, each item is aliased to the same event field.
+  ;; This is used to give all events an EVENT-WINDOW item.
+  ;; See the INPUT file for lots of examples.
+  (declare (type (or keyword list) event-codes)
+	   (type (alist (field-type symbol) (field-names list))
+                 declares))
+  (when (atom event-codes) (setq event-codes (list event-codes)))
+  (setq event-codes (mapcar #'canonicalize-event-name event-codes))
+  (let* ((keywords nil)
+	 (name (first event-codes))
+	 (get-macro (xintern name '-event-get-macro))
+	 (get-function (xintern name '-event-get))
+	 (put-function (xintern name '-event-put)))
+    (multiple-value-bind (get-code get-index get-sizes)
+	(get-put-items
+	  2 declares nil
+	  #'(lambda (type index item args)
+	      (flet ((event-get (type index item args)
+		       (unless (member type '(pad8 pad16))
+			 `(,(kintern item)
+			   (,(getify type) ,index ,@args)))))
+		(if (atom item)
+		    (event-get type index item args)
+		  (mapcan #'(lambda (item)
+			      (event-get type index item args))
+			  item)))))
+      (declare (ignore get-index))
+      (multiple-value-bind (put-code put-index put-sizes)
+	  (get-put-items
+	    2 declares t
+	    #'(lambda (type index item args)
+		(unless (member type '(pad8 pad16))
+		  (if (atom item)
+		      (progn
+			(push item keywords)
+			`((,(putify type) ,index ,item ,@args)))
+		    (let ((names (mapcar #'(lambda (name) (kintern name))
+					 item)))
+		      (setq keywords (append item keywords))
+		      `((,(putify type) ,index
+			 (check-consistency ',names ,@item) ,@args)))))))
+	(declare (ignore put-index))
+	`(within-definition (,name declare-event)
+	   (defun ,get-macro (display event-key variable)
+	     ;; Note: we take pains to macroexpand the get-code here to enable application
+	     ;; code to be compiled without having the CLX macros file loaded.
+	     (subst display '%buffer
+		    (getf `(:display (the display ,display)
+			    :event-key (the keyword ,event-key)
+			    :event-code (the card8 (logand #x7f (read-card8 0)))
+			    :send-event-p (the boolean (logbitp 7 (read-card8 0)))
+			    ,@',(mapcar #'macroexpand get-code))
+			  variable)))
+
+	   (defun ,get-function (display event handler)
+	     (declare (type display display)
+		      (type reply-buffer event))
+	     (declare (type function handler)
+		      #+clx-ansi-common-lisp
+		      (dynamic-extent handler)
+		      #+(and lispm (not clx-ansi-common-lisp))
+		      (sys:downward-funarg handler))
+	     (reading-event (event :display display :sizes (8 16 ,@get-sizes))
+	       (funcall handler
+			:display display
+			:event-key (svref *event-key-vector* (event-code event))
+			:event-code (the card8 (logand #x7f (card8-get 0))) ; ECL
+			:send-event-p (logbitp 7 (card8-get 0))
+			,@get-code)))
+
+	   (defun ,put-function (display &key ,@(setq keywords (nreverse keywords))
+				 &allow-other-keys)
+	     (declare (type display display))
+	     ,(when (member 'sequence keywords)
+		`(unless sequence (setq sequence (display-request-number display))))
+	     (with-buffer-output (display :sizes ,put-sizes
+					  :index (index+ (buffer-boffset display) 12))
+	       ,@put-code))
+       
+	   ,@(mapcar #'(lambda (name)
+			 (allocate-extension-event-code name)
+			 `(let ((event-code (or (get ',name 'event-code)
+						(allocate-extension-event-code ',name))))
+			   #+ecl (declare (type card8 event-code))
+			    (setf (svref *event-macro-vector* event-code)
+				  (function ,get-macro))
+			    (setf (svref *event-handler-vector* event-code)
+				  (function ,get-function))
+			    (setf (svref *event-send-vector* event-code)
+				  (function ,put-function))))
+		     event-codes)
+	   ',name)))))
+
+(defun check-consistency (names &rest args)
+  ;; Ensure all args are nil or have the same value.
+  ;; Returns the consistent non-nil value.
+  (let ((value (car args)))
+    (dolist (arg (cdr args))
+      (if value
+	  (when (and arg (not (eq arg value)))
+	    (x-error 'inconsistent-parameters
+		     :parameters (mapcan #'list names args)))
+	(setq value arg)))
+    value))
+
+(declare-event (:key-press :key-release :button-press :button-release)
+  ;; for key-press and key-release, code is the keycode
+  ;; for button-press and button-release, code is the button number
+  (data code)
+  (card16 sequence)
+  ((or null card32) time)
+  (window root (window event-window))
+  ((or null window) child)
+  (int16 root-x root-y x y)
+  (card16 state)
+  (boolean same-screen-p)
+  )
+
+(declare-event :motion-notify
+  ((data boolean) hint-p)
+  (card16 sequence)
+  ((or null card32) time)
+  (window root (window event-window))
+  ((or null window) child)
+  (int16 root-x root-y x y)
+  (card16 state)
+  (boolean same-screen-p))
+
+(declare-event (:enter-notify :leave-notify)
+  ((data (member8 :ancestor :virtual :inferior :nonlinear :nonlinear-virtual)) kind)
+  (card16 sequence)
+  ((or null card32) time)
+  (window root (window event-window))
+  ((or null window) child)
+  (int16 root-x root-y x y)
+  (card16 state)
+  ((member8 :normal :grab :ungrab) mode)
+  ((bit 0) focus-p)
+  ((bit 1) same-screen-p))
+
+(declare-event (:focus-in :focus-out)
+  ((data (member8 :ancestor :virtual :inferior :nonlinear :nonlinear-virtual
+		  :pointer :pointer-root :none))
+   kind)
+  (card16 sequence)
+  (window (window event-window))
+  ((member8 :normal :while-grabbed :grab :ungrab) mode))
+
+(declare-event :keymap-notify
+  ((bit-vector256 0) keymap))
+
+(declare-event :exposure
+  (card16 sequence)
+  (window (window event-window))
+  (card16 x y width height count))
+
+(declare-event :graphics-exposure
+  (card16 sequence)
+  (drawable (drawable event-window))
+  (card16 x y width height)
+  (card16 minor)  ;; Minor opcode
+  (card16 count)
+  (card8 major))
+
+(declare-event :no-exposure
+  (card16 sequence)
+  (drawable (drawable event-window))
+  (card16 minor)
+  (card8  major))
+
+(declare-event :visibility-notify
+  (card16 sequence)
+  (window (window event-window))
+  ((member8 :unobscured :partially-obscured :fully-obscured) state))
+
+(declare-event :create-notify
+  (card16 sequence)
+  (window (parent event-window) window)
+  (int16 x y)
+  (card16 width height border-width)
+  (boolean override-redirect-p))
+
+(declare-event :destroy-notify
+  (card16 sequence)
+  (window event-window window))
+
+(declare-event :unmap-notify
+  (card16 sequence)
+  (window event-window window)
+  (boolean configure-p))
+
+(declare-event :map-notify
+  (card16 sequence)
+  (window event-window window)
+  (boolean override-redirect-p))
+
+(declare-event :map-request
+  (card16 sequence)
+  (window (parent event-window) window))
+
+(declare-event :reparent-notify
+  (card16 sequence)
+  (window event-window window parent)
+  (int16 x y)
+  (boolean override-redirect-p))
+
+(declare-event :configure-notify
+  (card16 sequence)
+  (window event-window window)
+  ((or null window) above-sibling)
+  (int16 x y)
+  (card16 width height border-width)
+  (boolean override-redirect-p))
+
+(declare-event :configure-request
+  ((data (member :above :below :top-if :bottom-if :opposite)) stack-mode)
+  (card16 sequence)
+  (window (parent event-window) window)
+  ((or null window) above-sibling)
+  (int16 x y)
+  (card16 width height border-width value-mask))
+
+(declare-event :gravity-notify
+  (card16 sequence)
+  (window event-window window)
+  (int16 x y))
+
+(declare-event :resize-request
+  (card16 sequence)
+  (window (window event-window))
+  (card16 width height))
+
+(declare-event :circulate-notify
+  (card16 sequence)
+  (window event-window window parent)
+  ((member16 :top :bottom) place))
+
+(declare-event :circulate-request
+  (card16 sequence)
+  (window (parent event-window) window)
+  (pad16 1 2)
+  ((member16 :top :bottom) place))
+
+(declare-event :property-notify
+  (card16 sequence)
+  (window (window event-window))
+  (keyword atom) ;; keyword
+  ((or null card32) time)
+  ((member16 :new-value :deleted) state))
+
+(declare-event :selection-clear
+  (card16 sequence)
+  ((or null card32) time)
+  (window (window event-window)) 
+  (keyword selection) ;; keyword
+  )
+
+(declare-event :selection-request
+  (card16 sequence)
+  ((or null card32) time)
+  (window (window event-window) requestor)
+  (keyword selection target)
+  ((or null keyword) property)
+  )
+
+(declare-event :selection-notify
+  (card16 sequence)
+  ((or null card32) time)
+  (window (window event-window))
+  (keyword selection target)
+  ((or null keyword) property)
+  )
+
+(declare-event :colormap-notify
+  (card16 sequence)
+  (window (window event-window))
+  ((or null colormap) colormap)
+  (boolean new-p installed-p))
+
+(declare-event :client-message
+  (data format)
+  (card16 sequence)
+  (window (window event-window))
+  (keyword type)
+  ((client-message-sequence format) data))
+
+(declare-event :mapping-notify
+  (card16 sequence)
+  ((member8 :modifier :keyboard :pointer) request)
+  (card8 start) ;; first key-code
+  (card8 count))
+
+
+;;
+;; EVENT-LOOP
+;;
+
+(defun event-loop-setup (display)
+  (declare (type display display)
+	   (values progv-vars progv-vals
+		   current-event-symbol current-event-discarded-p-symbol))
+  (let* ((progv-vars (display-current-event-symbol display))
+	 (current-event-symbol (first progv-vars))
+	 (current-event-discarded-p-symbol (second progv-vars)))
+    (declare (type list progv-vars)
+	     (type symbol current-event-symbol current-event-discarded-p-symbol))
+    (values
+      progv-vars 
+      (list (if (boundp current-event-symbol)
+		;; The current event is already bound, so bind it to the next
+		;; event.
+		(let ((event (symbol-value current-event-symbol)))
+		  (declare (type (or null reply-buffer) event))
+		  (and event (reply-next (the reply-buffer event))))
+	      ;; The current event isn't bound, so bind it to the head of the
+	      ;; event queue.
+	      (display-event-queue-head display))
+	    nil)
+      current-event-symbol
+      current-event-discarded-p-symbol)))
+
+(defun event-loop-step-before (display timeout force-output-p current-event-symbol)
+  (declare (type display display)
+	   (type (or null number) timeout)
+	   (type boolean force-output-p)
+	   (type symbol current-event-symbol)
+	   (values event eof-or-timeout))
+  (unless (symbol-value current-event-symbol)
+    (let ((eof-or-timeout (wait-for-event display timeout force-output-p)))
+      (when eof-or-timeout
+	(return-from event-loop-step-before (values nil eof-or-timeout))))
+    (setf (symbol-value current-event-symbol) (display-new-events display)))
+  (let ((event (symbol-value current-event-symbol)))
+    (declare (type reply-buffer event))
+    (with-event-queue-internal (display)
+      (when (eq event (display-new-events display))
+	(setf (display-new-events display) (reply-next event))))
+    (values event nil)))
+
+(defun dequeue-event (display event)
+  (declare (type display display)
+	   (type reply-buffer event)
+	   (values next))
+  ;; Remove the current event from the event queue
+  (with-event-queue-internal (display)
+    (let ((next (reply-next event))
+	  (head (display-event-queue-head display)))
+      (declare (type (or null reply-buffer) next head))
+      (when (eq event (display-new-events display))
+	(setf (display-new-events display) next))
+      (cond ((eq event head)
+	     (threaded-dequeue (display-event-queue-head display)
+			       (display-event-queue-tail display)
+			       reply-next reply-buffer))
+	    ((null head)
+	     (setq next nil))
+	    (t
+	     (do* ((previous head current)
+		   (current (reply-next previous) (reply-next previous)))
+		  ((or (null current) (eq event current))
+		   (when (eq event current)
+		     (when (eq current (display-event-queue-tail display))
+		       (setf (display-event-queue-tail display) previous))
+		     (setf (reply-next previous) next)))
+	       (declare (type reply-buffer previous)
+			(type (or null reply-buffer) current)))))
+      next)))
+
+(defun event-loop-step-after
+       (display event discard-p current-event-symbol current-event-discarded-p-symbol
+	&optional aborted)
+  (declare (type display display)
+	   (type reply-buffer event)
+	   (type boolean discard-p aborted)
+	   (type symbol current-event-symbol current-event-discarded-p-symbol))
+  (when (and discard-p
+	     (not aborted)
+	     (not (symbol-value current-event-discarded-p-symbol)))
+    (discard-current-event display))
+  (let ((next (reply-next event)))
+    (declare (type (or null reply-buffer) next))
+    (when (symbol-value current-event-discarded-p-symbol)
+      (setf (symbol-value current-event-discarded-p-symbol) nil)
+      (setq next (dequeue-event display event))
+      (deallocate-event event))
+    (setf (symbol-value current-event-symbol) next)))
+
+(defmacro event-loop ((display event timeout force-output-p discard-p) &body body)
+  ;; Bind EVENT to the events for DISPLAY.
+  ;; This is the "GUTS" of process-event and event-case.
+  `(let ((.display. ,display)
+	 (.timeout. ,timeout)
+	 (.force-output-p. ,force-output-p)
+	 (.discard-p. ,discard-p))
+     (declare (type display .display.)
+	      (type (or null number) .timeout.)
+	      (type boolean .force-output-p. .discard-p.))
+     (with-event-queue (.display. ,@(and timeout `(:timeout .timeout.)))
+       (multiple-value-bind (.progv-vars. .progv-vals.
+			     .current-event-symbol. .current-event-discarded-p-symbol.)
+	   (event-loop-setup .display.)
+	 (declare (type list .progv-vars. .progv-vals.)
+		  (type symbol .current-event-symbol. .current-event-discarded-p-symbol.))
+	 (progv .progv-vars. .progv-vals.
+	   (loop
+	     (multiple-value-bind (.event. .eof-or-timeout.)
+		 (event-loop-step-before
+		   .display. .timeout. .force-output-p.
+		   .current-event-symbol.)
+	       (declare (type (or null reply-buffer) .event.))
+	       (when (null .event.) (return (values nil .eof-or-timeout.)))
+	       (let ((.aborted. t))
+		 (unwind-protect 
+		     (progn
+		       (let ((,event .event.))
+			 (declare (type reply-buffer ,event))
+			 ,@body)
+		       (setq .aborted. nil))
+		   (event-loop-step-after
+		     .display. .event. .discard-p.
+		     .current-event-symbol. .current-event-discarded-p-symbol.
+		     .aborted.))))))))))
+
+(defun discard-current-event (display)
+  ;; Discard the current event for DISPLAY.
+  ;; Returns NIL when the event queue is empty, else T.
+  ;; To ensure events aren't ignored, application code should only call
+  ;; this when throwing out of event-case or process-next-event, or from
+  ;; inside even-case, event-cond or process-event when :peek-p is T and
+  ;; :discard-p is NIL.
+  (declare (type display display)
+	   (values boolean))
+  (let* ((symbols (display-current-event-symbol display))
+	 (event
+	   (let ((current-event-symbol (first symbols)))
+	     (declare (type symbol current-event-symbol))
+	     (when (boundp current-event-symbol)
+	       (symbol-value current-event-symbol)))))
+    (declare (type list symbols)
+	     (type (or null reply-buffer) event))
+    (unless (null event)
+      ;; Set the discarded-p flag
+      (let ((current-event-discarded-p-symbol (second symbols)))
+	(declare (type symbol current-event-discarded-p-symbol))
+	(when (boundp current-event-discarded-p-symbol)
+	  (setf (symbol-value current-event-discarded-p-symbol) t)))
+      ;; Return whether the event queue is empty
+      (not (null (reply-next (the reply-buffer event)))))))
+
+;;
+;; PROCESS-EVENT
+;;
+(defun process-event (display &key handler timeout peek-p discard-p (force-output-p t))
+  ;; If force-output-p is true, first invokes display-force-output.  Invokes handler
+  ;; on each queued event until handler returns non-nil, and that returned object is
+  ;; then returned by process-event.  If peek-p is true, then the event is not
+  ;; removed from the queue.  If discard-p is true, then events for which handler
+  ;; returns nil are removed from the queue, otherwise they are left in place.  Hangs
+  ;; until non-nil is generated for some event, or for the specified timeout (in
+  ;; seconds, if given); however, it is acceptable for an implementation to wait only
+  ;; once on network data, and therefore timeout prematurely.  Returns nil on
+  ;; timeout.  If handler is a sequence, it is expected to contain handler functions
+  ;; specific to each event class; the event code is used to index the sequence,
+  ;; fetching the appropriate handler.  Handler is called with raw resource-ids, not
+  ;; with resource objects.  The arguments to the handler are described using declare-event.
+  ;;
+  ;; T for peek-p means the event (for which the handler returns non-nil) is not removed
+  ;; from the queue (it is left in place), NIL means the event is removed.
+  
+  (declare (type display display)
+	   (type (or null number) timeout)
+	   (type boolean peek-p discard-p force-output-p))
+  (declare (type t handler)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent handler)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg #+Genera * #-Genera handler))
+  (event-loop (display event timeout force-output-p discard-p)
+    (let* ((event-code (event-code event)) ;; Event decoder defined by DECLARE-EVENT
+	   (event-decoder (and (index< event-code (length *event-handler-vector*))
+			       (svref *event-handler-vector* event-code))))
+      (declare (type array-index event-code)
+	       (type (or null function) event-decoder))
+      (if event-decoder
+	  (let ((event-handler (if (functionp handler)
+				   handler
+				   (and (type? handler 'sequence)
+					(< event-code (length handler))
+					(elt handler event-code)))))
+	    (if event-handler
+		(let ((result (funcall event-decoder display event event-handler)))
+		  (when result
+		    (unless peek-p
+		      (discard-current-event display))
+		    (return result)))
+	      (cerror "Ignore this event"
+		      "No handler for ~s event"
+		      (svref *event-key-vector* event-code))))
+	(cerror "Ignore this event"
+		"Server Error: event with unknown event code ~d received."
+		event-code)))))
+
+(defun make-event-handlers (&key (type 'array) default)
+  (declare (type t type)			;Sequence type specifier
+	   (type function default)
+	   (values sequence))			;Default handler for initial content
+  ;; Makes a handler sequence suitable for process-event
+  (make-sequence type *max-events* :initial-element default))
+   
+(defun event-handler (handlers event-key)
+  (declare (type sequence handlers)
+	   (type event-key event-key)
+	   (values function))
+  ;; Accessor for a handler sequence
+  (elt handlers (position event-key *event-key-vector* :test #'eq)))
+
+(defun set-event-handler (handlers event-key handler)
+  (declare (type sequence handlers)
+	   (type event-key event-key)
+	   (type function handler)
+	   (values handler))
+  (setf (elt handlers (position event-key *event-key-vector* :test #'eq)) handler))
+
+(defsetf event-handler set-event-handler)
+
+;;
+;; EVENT-CASE
+;; 
+
+(defmacro event-case ((&rest args) &body clauses)
+  ;; If force-output-p is true, first invokes display-force-output.  Executes the
+  ;; matching clause for each queued event until a clause returns non-nil, and that
+  ;; returned object is then returned by event-case.  If peek-p is true, then the
+  ;; event is not removed from the queue.  If discard-p is true, then events for
+  ;; which the clause returns nil are removed from the queue, otherwise they are left
+  ;; in place.  Hangs until non-nil is generated for some event, or for the specified
+  ;; timeout (in seconds, if given); however, it is acceptable for an implementation
+  ;; to wait only once on network data, and therefore timeout prematurely.  Returns
+  ;; nil on timeout.  In each clause, event-or-events is an event-key or a list of
+  ;; event-keys (but they need not be typed as keywords) or the symbol t or otherwise
+  ;; (but only in the last clause).  The keys are not evaluated, and it is an error
+  ;; for the same key to appear in more than one clause.  Args is the list of event
+  ;; components of interest; corresponding values (if any) are bound to variables
+  ;; with these names (i.e., the args are variable names, not keywords, the keywords
+  ;; are derived from the variable names).  An arg can also be a (keyword var) form,
+  ;; as for keyword args in a lambda lists.  If no t/otherwise clause appears, it is
+  ;; equivalent to having one that returns nil.
+  (declare (arglist (display &key timeout peek-p discard-p (force-output-p t))
+		   (event-or-events ((&rest args) |...|) &body body) |...|))
+  ;; Event-case is just event-cond with the whole body in the test-form
+  `(event-cond ,args
+	       ,@(mapcar
+		   #'(lambda (clause)
+		       `(,(car clause) ,(cadr clause) (progn ,@(cddr clause))))
+		   clauses)))
+
+;;
+;; EVENT-COND
+;; 
+
+(defmacro event-cond ((display &key timeout peek-p discard-p (force-output-p t))
+		      &body clauses)
+  ;; The clauses of event-cond are of the form:
+  ;; (event-or-events binding-list test-form . body-forms)
+  ;;
+  ;; EVENT-OR-EVENTS	event-key or a list of event-keys (but they
+  ;;			need not be typed as keywords) or the symbol t
+  ;;			or otherwise (but only in the last clause).  If
+  ;;			no t/otherwise clause appears, it is equivalent
+  ;;			to having one that returns nil.  The keys are
+  ;;			not evaluated, and it is an error for the same
+  ;;			key to appear in more than one clause.
+  ;;
+  ;; BINDING-LIST	The list of event components of interest.
+  ;;			corresponding values (if any) are bound to
+  ;;			variables with these names (i.e., the binding-list
+  ;;			has variable names, not keywords, the keywords are
+  ;;			derived from the variable names).  An arg can also
+  ;;			be a (keyword var) form, as for keyword args in a
+  ;;			lambda list.
+  ;;
+  ;; The matching TEST-FORM for each queued event is executed until a
+  ;; clause's test-form returns non-nil.  Then the BODY-FORMS are
+  ;; evaluated, returning the (possibly multiple) values of the last
+  ;; form from event-cond.  If there are no body-forms then, if the
+  ;; test-form is non-nil, the value of the test-form is returned as a
+  ;; single value.
+  ;;
+  ;; Options:
+  ;; FORCE-OUTPUT-P	When true, first invoke display-force-output if no
+  ;;		  	input is pending.
+  ;;
+  ;; PEEK-P		When true, then the event is not removed from the queue.
+  ;;
+  ;; DISCARD-P		When true, then events for which the clause returns nil
+  ;; 			are removed from the queue, otherwise they are left in place.
+  ;;
+  ;; TIMEOUT		If NIL, hang until non-nil is generated for some event's
+  ;;			test-form. Otherwise return NIL after TIMEOUT seconds have
+  ;;			elapsed.
+  ;;
+  (declare (arglist (display &key timeout peek-p discard-p force-output-p)
+		   (event-or-events (&rest args) test-form &body body) |...|))
+  (let ((event (gensym))
+	(disp (gensym))
+	(peek (gensym)))
+    `(let ((,disp ,display)
+	   (,peek ,peek-p))
+       (declare (type display ,disp))
+       (event-loop (,disp ,event ,timeout ,force-output-p ,discard-p)
+	 (event-dispatch (,disp ,event ,peek) ,@clauses)))))
+
+(defun get-event-code (event)
+  ;; Returns the event code given an event-key
+  (declare (type event-key event))
+  (declare (values card8))
+  (or (get event 'event-code)
+      (x-type-error event 'event-key)))
+
+(defun universal-event-get-macro (display event-key variable)
+  (getf
+    `(:display (the display ,display) :event-key (the keyword ,event-key) :event-code
+	       (the card8 (logand 127 (read-card8 0))) :send-event-p
+	       (the boolean (logbitp 7 (read-card8 0))))
+    variable))
+
+(defmacro event-dispatch ((display event peek-p) &body clauses)
+  ;; Helper macro for event-case
+  ;; CLAUSES are of the form:
+  ;; (event-or-events binding-list test-form . body-forms)
+  (let ((event-key (gensym))
+	(all-events (make-array *max-events* :element-type 'bit :initial-element 0)))
+    #+ecl (declare (bit-vector all-events))
+    `(reading-event (,event)
+       (let ((,event-key (svref *event-key-vector* (event-code ,event))))
+	 (case ,event-key
+	   ,@(mapcar
+	       #'(lambda (clause)		; Translate event-cond clause to case clause
+		   (let* ((events (first clause))
+			  (arglist (second clause))
+			  (test-form (third clause))
+			  (body-forms (cdddr clause)))
+		     (flet ((event-clause (display peek-p first-form rest-of-forms)
+			      (if rest-of-forms
+				  `(when ,first-form
+				     (unless ,peek-p (discard-current-event ,display))
+				     (return (progn ,@rest-of-forms)))
+				;; No body forms, return the result of the test form
+				(let ((result (gensym)))
+				  `(let ((,result ,first-form))
+				     (when ,result
+				       (unless ,peek-p (discard-current-event ,display))
+				       (return ,result)))))))
+
+		       (if (member events '(otherwise t))
+			   ;; code for OTHERWISE clause.
+			   ;; Find all events NOT used by other clauses
+			   (let ((keys (do ((i 0 (1+ i))
+					    (key nil)
+					    (result nil))
+					   ((>= i *max-events*) result)
+					 #+ecl (declare (fixnum i))
+					 (setq key (svref *event-key-vector* i))
+					 (when (and key (zerop (aref all-events i)))
+					   (push key result)))))
+			     `(otherwise
+				(binding-event-values
+				  (,display ,event-key ,(or keys :universal) ,@arglist)
+				  ,(event-clause display peek-p test-form body-forms))))
+
+			 ;; Code for normal clauses
+			 (let (true-events) ;; canonicalize event-names
+			   (if (consp events)
+			       (progn
+				 (setq true-events (mapcar #'canonicalize-event-name events))
+				 (dolist (event true-events)
+				   (setf (aref all-events (get-event-code event)) 1)))
+			     (setf true-events (canonicalize-event-name events)
+				   (aref all-events (get-event-code true-events)) 1))
+			   `(,true-events
+			     (binding-event-values
+			       (,display ,event-key ,true-events ,@arglist)
+			       ,(event-clause display peek-p test-form body-forms))))))))
+	       clauses))))))
+
+(defmacro binding-event-values ((display event-key event-keys &rest value-list) &body body)
+  ;; Execute BODY with the variables in VALUE-LIST bound to components of the
+  ;; EVENT-KEYS events.
+  (unless (consp event-keys) (setq event-keys (list event-keys)))
+  (flet ((var-key (var) (kintern (if (consp var) (first var) var)))
+	 (var-symbol (var) (if (consp var) (second var) var)))
+    ;; VARS is an alist of:
+    ;;  (component-key ((event-key event-key ...) . extraction-code)
+    ;;		       ((event-key event-key ...) . extraction-code) ...)
+    ;; There should probably be accessor macros for this, instead of things like cdadr.
+    (let ((vars (mapcar #'(lambda (var) (list var)) value-list))
+	  (multiple-p nil))
+      ;; Fill in the VARS alist with event-keys and extraction-code
+      (do ((keys event-keys (cdr keys))
+	   (temp nil))
+	  ((endp keys))
+	(let* ((key (car keys))
+	       (binder (case key
+			 (:universal #'universal-event-get-macro)
+			 (otherwise (svref *event-macro-vector* (get-event-code key))))))
+	  (dolist (var vars)
+	    (let ((code (funcall binder display event-key (var-key (car var)))))
+	      (unless code (warn "~a isn't a component of the ~s event"
+				 (var-key (car var)) key))
+	      (if (setq temp (member code (cdr var) :key #'cdr :test #'equal))
+		  (push key (caar temp))
+		(push `((,key) . ,code) (cdr var)))))))
+      ;; Bind all the values
+      `(let ,(mapcar #'(lambda (var)
+			 (if (cddr var) ;; if more than one binding form
+			     (progn (setq multiple-p t)
+				    (var-symbol (car var)))
+			   (list (var-symbol (car var)) (cdadr var))))
+		     vars)
+	 ;; When some values come from different places, generate code to set them
+	 ,(when multiple-p
+	    `(case ,event-key
+	       ,@(do ((keys event-keys (cdr keys))
+		      (clauses nil) ;; alist of (event-keys bindings)
+		      (clause nil nil)
+		      (temp))
+		     ((endp keys)
+		      (dolist (clause clauses)
+			(unless (cdar clause) ;; Atomize single element lists
+			  (setf (car clause) (caar clause))))
+		      clauses)
+		   ;; Gather up all the bindings associated with (car keys)
+		   (dolist (var vars)
+		     (when (cddr var) ;; when more than one binding form
+		       (dolist (events (cdr var))
+			 (when (member (car keys) (car events))
+			   ;; Optimize for event-window being the same as some other binding
+			   (if (setq temp (member (cdr events) clause
+						  :key #'caddr
+						  :test #'equal))
+			       (setq clause
+				     (nconc clause `((setq ,(car var) ,(second (car temp))))))
+			     (push `(setq ,(car var) ,(cdr events)) clause))))))
+		   ;; Merge bindings for (car keys) with other bindings
+		   (when clause
+		     (if (setq temp (member clause clauses :key #'cdr :test #'equal))
+			 (push (car keys) (caar temp))
+		       (push `((,(car keys)) . ,clause) clauses))))))
+	 ,@body))))
+
+
+;;;-----------------------------------------------------------------------------
+;;; Error Handling
+;;;-----------------------------------------------------------------------------
+
+(eval-when (eval compile load)
+(defparameter
+  *xerror-vector*
+  '#(unknown-error
+     request-error				; 1  bad request code
+     value-error				; 2  integer parameter out of range
+     window-error				; 3  parameter not a Window
+     pixmap-error				; 4  parameter not a Pixmap
+     atom-error					; 5  parameter not an Atom
+     cursor-error				; 6  parameter not a Cursor
+     font-error					; 7  parameter not a Font
+     match-error				; 8  parameter mismatch
+     drawable-error				; 9  parameter not a Pixmap or Window
+     access-error				; 10 attempt to access private resource"
+     alloc-error				; 11 insufficient resources
+     colormap-error				; 12 no such colormap
+     gcontext-error				; 13 parameter not a GContext
+     id-choice-error				; 14 invalid resource ID for this connection
+     name-error					; 15 font or color name does not exist
+     length-error				; 16 request length incorrect;
+						;    internal Xlib error
+     implementation-error			; 17 server is defective
+     ))
+)
+
+(defun make-error (display event asynchronous)
+  (declare (type display display)
+	   (type reply-buffer event)
+	   (type boolean asynchronous))
+  (reading-event (event)
+    (let* ((error-code (read-card8 1))
+	   (error-key (get-error-key display error-code))
+	   (error-decode-function (get error-key 'error-decode-function))
+	   (params (funcall error-decode-function display event)))
+      (list* error-code error-key
+	     :asynchronous asynchronous :current-sequence (display-request-number display)
+	     params))))
+
+(defun report-error (display error-code error-key &rest params)
+  (declare (type display display)
+	   (dynamic-extent params))
+  ;; All errors (synchronous and asynchronous) are processed by calling
+  ;; an error handler in the display.  The handler is called with the display
+  ;; as the first argument and the error-key as its second argument. If handler is
+  ;; an array it is expected to contain handler functions specific to
+  ;; each error; the error code is used to index the array, fetching the
+  ;; appropriate handler. Any results returned by the handler are ignored;;
+  ;; it is assumed the handler either takes care of the error completely,
+  ;; or else signals. For all core errors, additional keyword/value argument
+  ;; pairs are:
+  ;;    :major integer
+  ;;    :minor integer
+  ;;    :sequence integer
+  ;;    :current-sequence integer
+  ;;    :asynchronous (member t nil)
+  ;; For :colormap, :cursor, :drawable, :font, :GContext, :id-choice, :pixmap, and :window
+  ;; errors another pair is:
+  ;;    :resource-id integer
+  ;; For :atom errors, another pair is:
+  ;;    :atom-id integer
+  ;; For :value errors, another pair is:
+  ;;    :value integer
+  (let* ((handler (display-error-handler display))
+	 (handler-function
+	   (if (type? handler 'sequence)
+	       (elt handler error-code)
+	     handler)))
+    (apply handler-function display error-key params)))
+
+(defun request-name (code &optional display)
+  (if (< code (length *request-names*))
+      (svref *request-names* code)
+    (dolist (extension (and display (display-extension-alist display)) "unknown")
+      (when (= code (second extension))
+	(return (first extension))))))
+
+#-(or clx-ansi-common-lisp excl lcl3.0)
+(define-condition request-error (x-error)
+  ((display :reader request-error-display)
+   (error-key :reader request-error-error-key)
+   (major :reader request-error-major)
+   (minor :reader request-error-minor)
+   (sequence :reader request-error-sequence)
+   (current-sequence :reader request-error-current-sequence)
+   (asynchronous :reader request-error-asynchronous))
+  (:report report-request-error))
+
+(defun report-request-error (condition stream)
+  (let ((error-key (request-error-error-key condition))
+	(asynchronous (request-error-asynchronous condition))
+	(major (request-error-major condition))
+	(minor (request-error-minor condition))
+	(sequence (request-error-sequence condition))
+	(current-sequence (request-error-current-sequence condition)))		   
+    (format stream "~:[~;Asynchronous ~]~a in ~:[request ~d (last request was ~d) ~;current request~2* ~] Code ~d.~d [~a]"
+	    asynchronous error-key (= sequence current-sequence)
+	    sequence current-sequence major minor
+	    (request-name major (request-error-display condition)))))
+
+;; Since the :report arg is evaluated as (function report-request-error) the
+;; define-condition must come after the function definition.
+#+(or clx-ansi-common-lisp excl lcl3.0)
+(define-condition request-error (x-error)
+  ((display :reader request-error-display :initarg :display)
+   (error-key :reader request-error-error-key :initarg :error-key)
+   (major :reader request-error-major :initarg :major)
+   (minor :reader request-error-minor :initarg :minor)
+   (sequence :reader request-error-sequence :initarg :sequence)
+   (current-sequence :reader request-error-current-sequence :initarg :current-sequence)
+   (asynchronous :reader request-error-asynchronous :initarg :asynchronous))
+  (:report report-request-error))
+
+(define-condition resource-error (request-error)
+  ((resource-id :reader resource-error-resource-id :initarg :resource-id))
+  (:report
+    (lambda (condition stream)
+      (report-request-error condition stream)
+      (format stream " ID #x~x" (resource-error-resource-id condition)))))  
+
+(define-condition unknown-error (request-error)
+  ((error-code :reader unknown-error-error-code :initarg :error-code))
+  (:report
+    (lambda (condition stream)
+      (report-request-error condition stream)
+      (format stream " Error Code ~d." (unknown-error-error-code condition)))))
+
+(define-condition access-error (request-error) ())
+
+(define-condition alloc-error (request-error) ())
+
+(define-condition atom-error (request-error)
+  ((atom-id :reader atom-error-atom-id :initarg :atom-id))
+  (:report
+    (lambda (condition stream)
+      (report-request-error condition stream)
+      (format stream " Atom-ID #x~x" (atom-error-atom-id condition)))))
+
+(define-condition colormap-error (resource-error) ())
+
+(define-condition cursor-error (resource-error) ())
+
+(define-condition drawable-error (resource-error) ())
+
+(define-condition font-error (resource-error) ())
+
+(define-condition gcontext-error (resource-error) ())
+
+(define-condition id-choice-error (resource-error) ())
+
+(define-condition illegal-request-error (request-error) ())
+
+(define-condition length-error (request-error) ())
+
+(define-condition match-error (request-error) ())
+
+(define-condition name-error (request-error) ())
+
+(define-condition pixmap-error (resource-error) ())
+
+(define-condition value-error (request-error)
+  ((value :reader value-error-value :initarg :value))
+  (:report
+    (lambda (condition stream)
+      (report-request-error condition stream)
+      (format stream " Value ~d." (value-error-value condition)))))
+
+(define-condition window-error (resource-error)())
+
+(define-condition implementation-error (request-error) ())
+
+;;-----------------------------------------------------------------------------
+;; Internal error conditions signaled by CLX
+
+(define-condition x-type-error (type-error x-error)
+  ((type-string :reader x-type-error-type-string :initarg :type-string))
+  (:report
+    (lambda (condition stream)
+      (format stream "~s isn't a ~a"
+	      (type-error-datum condition)
+	      (or (x-type-error-type-string condition)
+		  (type-error-expected-type condition))))))
+
+(define-condition closed-display (x-error)
+  ((display :reader closed-display-display :initarg :display))
+  (:report
+    (lambda (condition stream)
+      (format stream "Attempt to use closed display ~s"
+	      (closed-display-display condition)))))
+
+(define-condition lookup-error (x-error)
+  ((id :reader lookup-error-id :initarg :id)
+   (display :reader lookup-error-display :initarg :display)
+   (type :reader lookup-error-type :initarg :type)
+   (object :reader lookup-error-object :initarg :object))
+  (:report
+    (lambda (condition stream)
+      (format stream "ID ~d from display ~s should have been a ~s, but was ~s"
+	      (lookup-error-id condition)
+	      (lookup-error-display condition)
+	      (lookup-error-type condition)
+	      (lookup-error-object condition)))))  
+
+(define-condition connection-failure (x-error)
+  ((major-version :reader connection-failure-major-version :initarg :major-version)
+   (minor-version :reader connection-failure-minor-version :initarg :minor-version)
+   (host :reader connection-failure-host :initarg :host)
+   (display :reader connection-failure-display :initarg :display)
+   (reason :reader connection-failure-reason :initarg :reason))
+  (:report
+    (lambda (condition stream)
+      (format stream "Connection failure to X~d.~d server ~a display ~d: ~a"
+	      (connection-failure-major-version condition)
+	      (connection-failure-minor-version condition)
+	      (connection-failure-host condition)
+	      (connection-failure-display condition)
+	      (connection-failure-reason condition)))))
+  
+(define-condition reply-length-error (x-error)
+  ((reply-length :reader reply-length-error-reply-length :initarg :reply-length)
+   (expected-length :reader reply-length-error-expected-length :initarg :expected-length)
+   (display :reader reply-length-error-display :initarg :display))
+  (:report
+    (lambda (condition stream)
+      (format stream "Reply length was ~d when ~d words were expected for display ~s"
+	      (reply-length-error-reply-length condition)
+	      (reply-length-error-expected-length condition)
+	      (reply-length-error-display condition)))))  
+
+(define-condition reply-timeout (x-error)
+  ((timeout :reader reply-timeout-timeout :initarg :timeout)
+   (display :reader reply-timeout-display :initarg :display))
+  (:report
+    (lambda (condition stream)
+      (format stream "Timeout after waiting ~d seconds for a reply for display ~s"
+	      (reply-timeout-timeout condition)
+	      (reply-timeout-display condition)))))  
+
+(define-condition sequence-error (x-error)
+  ((display :reader sequence-error-display :initarg :display)
+   (req-sequence :reader sequence-error-req-sequence :initarg :req-sequence)
+   (msg-sequence :reader sequence-error-msg-sequence :initarg :msg-sequence))
+  (:report
+    (lambda (condition stream)
+      (format stream "Reply out of sequence for display ~s.~%  Expected ~d, Got ~d"
+	      (sequence-error-display condition)
+	      (sequence-error-req-sequence condition)
+	      (sequence-error-msg-sequence condition)))))  
+
+(define-condition unexpected-reply (x-error)
+  ((display :reader unexpected-reply-display :initarg :display)
+   (msg-sequence :reader unexpected-reply-msg-sequence :initarg :msg-sequence)
+   (req-sequence :reader unexpected-reply-req-sequence :initarg :req-sequence)
+   (length :reader unexpected-reply-length :initarg :length))
+  (:report
+    (lambda (condition stream)
+      (format stream "Display ~s received a server reply when none was expected.~@
+		      Last request sequence ~d Reply Sequence ~d Reply Length ~d bytes."
+	      (unexpected-reply-display condition)
+	      (unexpected-reply-req-sequence condition)
+	      (unexpected-reply-msg-sequence condition)
+	      (unexpected-reply-length condition)))))
+
+(define-condition missing-parameter (x-error)
+  ((parameter :reader missing-parameter-parameter :initarg :parameter))
+  (:report
+    (lambda (condition stream)
+      (let ((parm (missing-parameter-parameter condition)))
+	(if (consp parm)
+	    (format stream "One or more of the required parameters ~a is missing."
+		    parm)
+	  (format stream "Required parameter ~a is missing or null." parm))))))
+
+;; This can be signalled anywhere a pseudo font access fails.
+(define-condition invalid-font (x-error)
+  ((font :reader invalid-font-font :initarg :font))
+  (:report
+    (lambda (condition stream)
+      (format stream "Can't access font ~s" (invalid-font-font condition)))))
+
+(define-condition device-busy (x-error)
+  ((display :reader device-busy-display :initarg :display))
+  (:report
+    (lambda (condition stream)
+      (format stream "Device busy for display ~s"
+	      (device-busy-display condition)))))
+
+(define-condition unimplemented-event (x-error)
+  ((display :reader unimplemented-event-display :initarg :display)
+   (event-code :reader unimplemented-event-event-code :initarg :event-code))
+  (:report
+    (lambda (condition stream)
+      (format stream "Event code ~d not implemented for display ~s"
+	      (unimplemented-event-event-code condition)
+	      (unimplemented-event-display condition)))))
+
+(define-condition undefined-event (x-error)
+  ((display :reader undefined-event-display :initarg :display)
+   (event-name :reader undefined-event-event-name :initarg :event-name))
+  (:report
+    (lambda (condition stream)
+      (format stream "Event code ~d undefined for display ~s"
+	      (undefined-event-event-name condition)
+	      (undefined-event-display condition)))))
+
+(define-condition absent-extension (x-error)
+  ((name :reader absent-extension-name :initarg :name)
+   (display :reader absent-extension-display :initarg :display))
+  (:report
+    (lambda (condition stream)
+      (format stream "Extension ~a isn't defined for display ~s"
+	      (absent-extension-name condition)
+	      (absent-extension-display condition)))))
+
+(define-condition inconsistent-parameters (x-error)
+  ((parameters :reader inconsistent-parameters-parameters :initarg :parameters))
+  (:report
+    (lambda (condition stream)
+      (format stream "inconsistent-parameters:~{ ~s~}"
+	      (inconsistent-parameters-parameters condition)))))
+
+(defun get-error-key (display error-code)
+  (declare (type display display)
+	   (type array-index error-code))
+  ;; Return the error-key associated with error-code
+  (if (< error-code (length *xerror-vector*))
+      (svref *xerror-vector* error-code)
+    ;; Search the extensions for the error
+    (dolist (entry (display-extension-alist display) 'unknown-error)
+      (let* ((event-name (first entry))
+	     (first-error (fourth entry))
+	     (errors (third (assoc event-name *extensions*))))
+	(declare (type keyword event-name)
+		 (type array-index first-error)
+		 (type list errors))
+	(when (and errors
+		   (index<= first-error error-code
+			    (index+ first-error (index- (length errors) 1))))
+	  (return (nth (index- error-code first-error) errors)))))))
+
+(defmacro define-error (error-key function)
+  ;; Associate a function with ERROR-KEY which will be called with
+  ;; parameters DISPLAY and REPLY-BUFFER and
+  ;; returns a plist of keyword/value pairs which will be passed on
+  ;; to the error handler.  A compiler warning is printed when
+  ;; ERROR-KEY is not defined in a preceding DEFINE-EXTENSION.
+  ;; Note: REPLY-BUFFER may used with the READING-EVENT and READ-type
+  ;;       macros for getting error fields. See DECODE-CORE-ERROR for
+  ;;       an example.
+  (declare (type symbol error-key)
+	   (type function function))
+  ;; First ensure the name is for a declared extension
+  (unless (or (find error-key *xerror-vector*)
+	      (dolist (extension *extensions*)
+		(when (member error-key (third extension))
+		  (return t))))
+    (x-type-error error-key 'error-key))
+  `(setf (get ',error-key 'error-decode-function) (function ,function)))
+
+;; All core errors use this, so we make it available to extensions.
+(defun decode-core-error (display event &optional arg)
+  ;; All core errors have the following keyword/argument pairs:
+  ;;    :major integer
+  ;;    :minor integer
+  ;;    :sequence integer
+  ;; In addition, many have an additional argument that comes from the
+  ;; same place in the event, but is named differently.  When the ARG
+  ;; argument is specified, the keyword ARG with card32 value starting
+  ;; at byte 4 of the event is returned with the other keyword/argument
+  ;; pairs.
+  (declare (type display display)
+	   (type reply-buffer event)
+	   (type (or null keyword) arg))
+  (declare (values keyword/arg-plist))
+  display
+  (reading-event (event)
+    (let* ((sequence (read-card16 2))
+	   (minor-code (read-card16 8))
+	   (major-code (read-card8 10))
+	   (result (list :major major-code
+			 :minor minor-code
+			 :sequence sequence)))
+      (when arg
+	(setq result (list* arg (read-card32 4) result)))
+      result)))
+
+(defun decode-resource-error (display event)
+  (decode-core-error display event :resource-id))
+
+(define-error unknown-error
+  (lambda (display event)
+    (list* :error-code (aref (reply-ibuf8 event) 1)
+	   (decode-core-error display event))))
+
+(define-error request-error decode-core-error)		; 1  bad request code
+
+(define-error value-error				; 2  integer parameter out of range
+  (lambda (display event)
+    (decode-core-error display event :value)))
+
+(define-error window-error decode-resource-error)	; 3  parameter not a Window
+
+(define-error pixmap-error decode-resource-error)	; 4  parameter not a Pixmap
+
+(define-error atom-error				; 5  parameter not an Atom
+  (lambda (display event)
+    (decode-core-error display event :atom-id)))
+
+(define-error cursor-error decode-resource-error)	; 6  parameter not a Cursor
+
+(define-error font-error decode-resource-error)		; 7  parameter not a Font
+
+(define-error match-error decode-core-error)		; 8  parameter mismatch
+
+(define-error drawable-error decode-resource-error)	; 9  parameter not a Pixmap or Window
+
+(define-error access-error decode-core-error)		; 10 attempt to access private resource"
+
+(define-error alloc-error decode-core-error)		; 11 insufficient resources
+
+(define-error colormap-error decode-resource-error)	; 12 no such colormap
+
+(define-error gcontext-error decode-resource-error)	; 13 parameter not a GContext
+
+(define-error id-choice-error decode-resource-error)	; 14 invalid resource ID for this connection
+
+(define-error name-error decode-core-error)		; 15 font or color name does not exist
+
+(define-error length-error decode-core-error)		; 16 request length incorrect;
+							;    internal Xlib error
+
+(define-error implementation-error decode-core-error)	; 17 server is defective
diff --git a/src/clx/keysyms.lsp b/src/clx/keysyms.lsp
new file mode 100644
index 000000000..96d160b83
--- /dev/null
+++ b/src/clx/keysyms.lsp
@@ -0,0 +1,408 @@
+;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:YES -*-
+
+;;; Define lisp character to keysym mappings
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+(define-keysym-set :latin-1	(keysym 0 0) (keysym 0 255))
+(define-keysym-set :latin-2	(keysym 1 0) (keysym 1 255))
+(define-keysym-set :latin-3	(keysym 2 0) (keysym 2 255))
+(define-keysym-set :latin-4	(keysym 3 0) (keysym 3 255))
+(define-keysym-set :kana	(keysym 4 0) (keysym 4 255))
+(define-keysym-set :arabic	(keysym 5 0) (keysym 5 255))
+(define-keysym-set :cryllic	(keysym 6 0) (keysym 6 255))
+(define-keysym-set :greek	(keysym 7 0) (keysym 7 255))
+(define-keysym-set :tech	(keysym 8 0) (keysym 8 255))
+(define-keysym-set :special	(keysym 9 0) (keysym 9 255))
+(define-keysym-set :publish	(keysym 10 0) (keysym 10 255))
+(define-keysym-set :apl		(keysym 11 0) (keysym 11 255))
+(define-keysym-set :hebrew	(keysym 12 0) (keysym 12 255))
+(define-keysym-set :keyboard	(keysym 255 0) (keysym 255 255))
+
+(define-keysym :character-set-switch character-set-switch-keysym)
+(define-keysym :left-shift left-shift-keysym)
+(define-keysym :right-shift right-shift-keysym)
+(define-keysym :left-control left-control-keysym)
+(define-keysym :right-control right-control-keysym)
+(define-keysym :caps-lock caps-lock-keysym)
+(define-keysym :shift-lock shift-lock-keysym)
+(define-keysym :left-meta left-meta-keysym)
+(define-keysym :right-meta right-meta-keysym)
+(define-keysym :left-alt left-alt-keysym)
+(define-keysym :right-alt right-alt-keysym)
+(define-keysym :left-super left-super-keysym)
+(define-keysym :right-super right-super-keysym)
+(define-keysym :left-hyper left-hyper-keysym)
+(define-keysym :right-hyper right-hyper-keysym)
+
+(define-keysym #\space 032)
+(define-keysym #\! 033)
+(define-keysym #\" 034)
+(define-keysym #\# 035)
+(define-keysym #\$ 036)
+(define-keysym #\% 037)
+(define-keysym #\& 038)
+(define-keysym #\' 039)
+(define-keysym #\( 040)
+(define-keysym #\) 041)
+(define-keysym #\* 042)
+(define-keysym #\+ 043)
+(define-keysym #\, 044)
+(define-keysym #\- 045)
+(define-keysym #\. 046)
+(define-keysym #\/ 047)
+(define-keysym #\0 048)
+(define-keysym #\1 049)
+(define-keysym #\2 050)
+(define-keysym #\3 051)
+(define-keysym #\4 052)
+(define-keysym #\5 053)
+(define-keysym #\6 054)
+(define-keysym #\7 055)
+(define-keysym #\8 056)
+(define-keysym #\9 057)
+(define-keysym #\: 058)
+(define-keysym #\; 059)
+(define-keysym #\< 060)
+(define-keysym #\= 061)
+(define-keysym #\> 062)
+(define-keysym #\? 063)
+(define-keysym #\@ 064)
+(define-keysym #\A 065 :lowercase 097)
+(define-keysym #\B 066 :lowercase 098)
+(define-keysym #\C 067 :lowercase 099)
+(define-keysym #\D 068 :lowercase 100)
+(define-keysym #\E 069 :lowercase 101)
+(define-keysym #\F 070 :lowercase 102)
+(define-keysym #\G 071 :lowercase 103)
+(define-keysym #\H 072 :lowercase 104)
+(define-keysym #\I 073 :lowercase 105)
+(define-keysym #\J 074 :lowercase 106)
+(define-keysym #\K 075 :lowercase 107)
+(define-keysym #\L 076 :lowercase 108)
+(define-keysym #\M 077 :lowercase 109)
+(define-keysym #\N 078 :lowercase 110)
+(define-keysym #\O 079 :lowercase 111)
+(define-keysym #\P 080 :lowercase 112)
+(define-keysym #\Q 081 :lowercase 113)
+(define-keysym #\R 082 :lowercase 114)
+(define-keysym #\S 083 :lowercase 115)
+(define-keysym #\T 084 :lowercase 116)
+(define-keysym #\U 085 :lowercase 117)
+(define-keysym #\V 086 :lowercase 118)
+(define-keysym #\W 087 :lowercase 119)
+(define-keysym #\X 088 :lowercase 120)
+(define-keysym #\Y 089 :lowercase 121)
+(define-keysym #\Z 090 :lowercase 122)
+(define-keysym #\[ 091)
+(define-keysym #\\ 092)
+(define-keysym #\] 093)
+(define-keysym #\^ 094)
+(define-keysym #\_ 095)
+(define-keysym #\` 096)
+(define-keysym #\a 097)
+(define-keysym #\b 098)
+(define-keysym #\c 099)
+(define-keysym #\d 100)
+(define-keysym #\e 101)
+(define-keysym #\f 102)
+(define-keysym #\g 103)
+(define-keysym #\h 104)
+(define-keysym #\i 105)
+(define-keysym #\j 106)
+(define-keysym #\k 107)
+(define-keysym #\l 108)
+(define-keysym #\m 109)
+(define-keysym #\n 110)
+(define-keysym #\o 111)
+(define-keysym #\p 112)
+(define-keysym #\q 113)
+(define-keysym #\r 114)
+(define-keysym #\s 115)
+(define-keysym #\t 116)
+(define-keysym #\u 117)
+(define-keysym #\v 118)
+(define-keysym #\w 119)
+(define-keysym #\x 120)
+(define-keysym #\y 121)
+(define-keysym #\z 122)
+(define-keysym #\{ 123)
+(define-keysym #\| 124)
+(define-keysym #\} 125)
+(define-keysym #\~ 126)
+
+(progn   ;; Semi-standard characters
+  (define-keysym #\rubout (keysym 255 255))	; :tty
+  (define-keysym #\tab (keysym 255 009))	; :tty
+  (define-keysym #\linefeed (keysym 255 010))	; :tty
+  (define-keysym #\page (keysym 009 227))	; :special
+  (define-keysym #\return (keysym 255 013))	; :tty
+  (define-keysym #\backspace (keysym 255 008))	; :tty
+  )
+
+#+(or lispm excl)
+(progn   ;; Nonstandard characters 
+  (define-keysym #\escape (keysym 255 027))	; :tty
+  )
+
+#+ti
+(progn
+  (define-keysym #\Inverted-exclamation-mark 161)
+  (define-keysym #\american-cent-sign 162)
+  (define-keysym #\british-pound-sign 163)
+  (define-keysym #\Currency-sign 164)
+  (define-keysym #\Japanese-yen-sign 165)
+  (define-keysym #\Yen 165)
+  (define-keysym #\Broken-bar 166)
+  (define-keysym #\Section-symbol 167)
+  (define-keysym #\Section 167)
+  (define-keysym #\Diaresis 168)
+  (define-keysym #\Umlaut 168)
+  (define-keysym #\Copyright-sign 169)
+  (define-keysym #\Copyright 169)
+  (define-keysym #\Feminine-ordinal-indicator 170)
+  (define-keysym #\Angle-quotation-left 171)
+  (define-keysym #\Soft-hyphen 173)
+  (define-keysym #\Shy 173)
+  (define-keysym #\Registered-trademark 174)
+  (define-keysym #\Macron 175)
+  (define-keysym #\Degree-sign 176)
+  (define-keysym #\Ring 176)
+  (define-keysym #\Plus-minus-sign 177)
+  (define-keysym #\Superscript-2 178)
+  (define-keysym #\Superscript-3 179)
+  (define-keysym #\Acute-accent 180)
+  (define-keysym #\Greek-mu 181)
+  (define-keysym #\Paragraph-symbol 182)
+  (define-keysym #\Paragraph 182)
+  (define-keysym #\Pilcrow-sign 182)
+  (define-keysym #\Middle-dot 183)
+  (define-keysym #\Cedilla 184)
+  (define-keysym #\Superscript-1 185)
+  (define-keysym #\Masculine-ordinal-indicator 186)
+  (define-keysym #\Angle-quotation-right 187)
+  (define-keysym #\Fraction-1/4 188)
+  (define-keysym #\One-quarter 188)
+  (define-keysym #\Fraction-1/2 189)
+  (define-keysym #\One-half 189)
+  (define-keysym #\Fraction-3/4 190)
+  (define-keysym #\Three-quarters 190)
+  (define-keysym #\Inverted-question-mark 191)
+  (define-keysym #\Multiplication-sign 215)
+  (define-keysym #\Eszet 223)
+  (define-keysym #\Division-sign 247)
+)
+
+#+ti
+(progn	;; There are no 7-bit ascii representations for the following
+        ;; European characters, so use int-char to create them to ensure
+        ;; nothing is lost while sending files through the mail.
+  (define-keysym (int-char 192) 192 :lowercase 224)
+  (define-keysym (int-char 193) 193 :lowercase 225)
+  (define-keysym (int-char 194) 194 :lowercase 226)
+  (define-keysym (int-char 195) 195 :lowercase 227)
+  (define-keysym (int-char 196) 196 :lowercase 228)
+  (define-keysym (int-char 197) 197 :lowercase 229)
+  (define-keysym (int-char 198) 198 :lowercase 230)
+  (define-keysym (int-char 199) 199 :lowercase 231)
+  (define-keysym (int-char 200) 200 :lowercase 232)
+  (define-keysym (int-char 201) 201 :lowercase 233)
+  (define-keysym (int-char 202) 202 :lowercase 234)
+  (define-keysym (int-char 203) 203 :lowercase 235)
+  (define-keysym (int-char 204) 204 :lowercase 236)
+  (define-keysym (int-char 205) 205 :lowercase 237)
+  (define-keysym (int-char 206) 206 :lowercase 238)
+  (define-keysym (int-char 207) 207 :lowercase 239)
+  (define-keysym (int-char 208) 208 :lowercase 240)
+  (define-keysym (int-char 209) 209 :lowercase 241)
+  (define-keysym (int-char 210) 210 :lowercase 242)
+  (define-keysym (int-char 211) 211 :lowercase 243)
+  (define-keysym (int-char 212) 212 :lowercase 244)
+  (define-keysym (int-char 213) 213 :lowercase 245)
+  (define-keysym (int-char 214) 214 :lowercase 246)
+  (define-keysym (int-char 215) 215)
+  (define-keysym (int-char 216) 216 :lowercase 248)
+  (define-keysym (int-char 217) 217 :lowercase 249)
+  (define-keysym (int-char 218) 218 :lowercase 250)
+  (define-keysym (int-char 219) 219 :lowercase 251)
+  (define-keysym (int-char 220) 220 :lowercase 252)
+  (define-keysym (int-char 221) 221 :lowercase 253)
+  (define-keysym (int-char 222) 222 :lowercase 254)
+  (define-keysym (int-char 223) 223)
+  (define-keysym (int-char 224) 224)
+  (define-keysym (int-char 225) 225)
+  (define-keysym (int-char 226) 226)
+  (define-keysym (int-char 227) 227)
+  (define-keysym (int-char 228) 228)
+  (define-keysym (int-char 229) 229)
+  (define-keysym (int-char 230) 230)
+  (define-keysym (int-char 231) 231)
+  (define-keysym (int-char 232) 232)
+  (define-keysym (int-char 233) 233)
+  (define-keysym (int-char 234) 234)
+  (define-keysym (int-char 235) 235)
+  (define-keysym (int-char 236) 236)
+  (define-keysym (int-char 237) 237)
+  (define-keysym (int-char 238) 238)
+  (define-keysym (int-char 239) 239)
+  (define-keysym (int-char 240) 240)
+  (define-keysym (int-char 241) 241)
+  (define-keysym (int-char 242) 242)
+  (define-keysym (int-char 243) 243)
+  (define-keysym (int-char 244) 244)
+  (define-keysym (int-char 245) 245)
+  (define-keysym (int-char 246) 246)
+  (define-keysym (int-char 247) 247)
+  (define-keysym (int-char 248) 248)
+  (define-keysym (int-char 249) 249)
+  (define-keysym (int-char 250) 250)
+  (define-keysym (int-char 251) 251)
+  (define-keysym (int-char 252) 252)
+  (define-keysym (int-char 253) 253)
+  (define-keysym (int-char 254) 254)
+  (define-keysym (int-char 255) 255)
+  )
+
+#+lispm  ;; Nonstandard characters
+(progn 
+  (define-keysym #\center-dot (keysym 183))	; :latin-1
+  (define-keysym #\down-arrow (keysym 008 254))	; :technical
+  (define-keysym #\alpha (keysym 007 225))	; :greek
+  (define-keysym #\beta (keysym 007 226))	; :greek
+  (define-keysym #\and-sign (keysym 008 222))	; :technical
+  (define-keysym #\not-sign (keysym 172))	; :latin-1
+  (define-keysym #\epsilon (keysym 007 229))	; :greek
+  (define-keysym #\pi (keysym 007 240))		; :greek
+  (define-keysym #\lambda (keysym 007 235))	; :greek
+  (define-keysym #\gamma (keysym 007 227))	; :greek
+  (define-keysym #\delta (keysym 007 228))	; :greek
+  (define-keysym #\up-arrow (keysym 008 252))	; :technical
+  (define-keysym #\plus-minus (keysym 177))	; :latin-1
+  (define-keysym #\infinity (keysym 008 194))	; :technical
+  (define-keysym #\partial-delta (keysym 008 239))	; :technical
+  (define-keysym #\left-horseshoe (keysym 011 218))	; :apl
+  (define-keysym #\right-horseshoe (keysym 011 216))	; :apl
+  (define-keysym #\up-horseshoe (keysym 011 195))	; :apl
+  (define-keysym #\down-horseshoe (keysym 011 214))	; :apl
+  (define-keysym #\double-arrow (keysym 008 205))	; :technical
+  (define-keysym #\left-arrow (keysym 008 251))	; :technical
+  (define-keysym #\right-arrow (keysym 008 253))	; :technical
+  (define-keysym #\not-equals (keysym 008 189))	; :technical
+  (define-keysym #\less-or-equal (keysym 008 188))	; :technical
+  (define-keysym #\greater-or-equal (keysym 008 190))	; :technical
+  (define-keysym #\equivalence (keysym 008 207))	; :technical
+  (define-keysym #\or-sign (keysym 008 223))	; :technical
+  (define-keysym #\integral (keysym 008 191))	; :technical
+;;  break isn't null
+;;  (define-keysym #\null (keysym 255 107))	; :function
+  (define-keysym #\clear-input (keysym 255 011))	; :tty
+  (define-keysym #\help (keysym 255 106))	; :function
+  (define-keysym #\refresh (keysym 255 097))	; :function
+  (define-keysym #\abort (keysym 255 105))	; :function
+  (define-keysym #\resume (keysym 255 098))	; :function
+  (define-keysym #\end (keysym 255 087))	; :cursor
+;;#\universal-quantifier
+;;#\existential-quantifier
+;;#\circle-plus
+;;#\circle-cross same as #\circle-x
+  )
+
+#+genera
+(progn
+;;#\network
+;;#\symbol-help
+  (define-keysym #\lozenge (keysym 009 224))	; :special
+  (define-keysym #\suspend (keysym 255 019))	; :tty
+  (define-keysym #\function (keysym 255 032))	; :function
+  (define-keysym #\square (keysym 010 231))	; :publishing
+  (define-keysym #\circle (keysym 010 230))	; :publishing
+  (define-keysym #\triangle (keysym 010 232))	; :publishing
+  (define-keysym #\scroll (keysym 255 086))	; :cursor
+  (define-keysym #\select (keysym 255 096))	; :function
+  (define-keysym #\complete (keysym 255 104))	; :function
+  )
+
+#+ti
+(progn
+  (define-keysym #\terminal (keysym 255 032))	; :function
+  (define-keysym #\system (keysym 255 096))	; :function
+  (define-keysym #\center-arrow (keysym 255 80))
+  (define-keysym #\left-arrow (keysym 255 081))	; :cursor
+  (define-keysym #\up-arrow (keysym 255 082))	; :cursor
+  (define-keysym #\right-arrow (keysym 255 083))	; :cursor
+  (define-keysym #\down-arrow (keysym 255 084))	; :cursor
+  (define-keysym #\end (keysym 255 087))	; :cursor
+  (define-keysym #\undo (keysym 255 101))	; :function
+  (define-keysym #\break (keysym 255 107))
+  (define-keysym #\keypad-space (keysym 255 128))	; :keypad
+  (define-keysym #\keypad-tab (keysym 255 137))	; :keypad
+  (define-keysym #\keypad-enter (keysym 255 141))	; :keypad
+  (define-keysym #\f1 (keysym 255 145))		; :keypad
+  (define-keysym #\f2 (keysym 255 146))		; :keypad
+  (define-keysym #\f3 (keysym 255 147))		; :keypad
+  (define-keysym #\f4 (keysym 255 148))		; :keypad
+  (define-keysym #\f1 (keysym 255 190))		; :keypad
+  (define-keysym #\f2 (keysym 255 191))		; :keypad
+  (define-keysym #\f3 (keysym 255 192))		; :keypad
+  (define-keysym #\f4 (keysym 255 193))		; :keypad
+  (define-keysym #\keypad-plus (keysym 255 171))	; :keypad
+  (define-keysym #\keypad-comma (keysym 255 172))	; :keypad
+  (define-keysym #\keypad-minus (keysym 255 173))	; :keypad
+  (define-keysym #\keypad-period (keysym 255 174))	; :keypad
+  (define-keysym #\keypad-0 (keysym 255 176))	; :keypad
+  (define-keysym #\keypad-1 (keysym 255 177))	; :keypad
+  (define-keysym #\keypad-2 (keysym 255 178))	; :keypad
+  (define-keysym #\keypad-3 (keysym 255 179))	; :keypad
+  (define-keysym #\keypad-4 (keysym 255 180))	; :keypad
+  (define-keysym #\keypad-5 (keysym 255 181))	; :keypad
+  (define-keysym #\keypad-6 (keysym 255 182))	; :keypad
+  (define-keysym #\keypad-7 (keysym 255 183))	; :keypad
+  (define-keysym #\keypad-8 (keysym 255 184))	; :keypad
+  (define-keysym #\keypad-9 (keysym 255 185))	; :keypad
+  (define-keysym #\keypad-equal (keysym 255 189))	; :keypad
+  (define-keysym #\f1 (keysym 255 192))		; :function
+  (define-keysym #\f2 (keysym 255 193))		; :function
+  (define-keysym #\f3 (keysym 255 194))		; :function
+  (define-keysym #\f4 (keysym 255 195))		; :function
+  (define-keysym #\network (keysym 255 214))
+  (define-keysym #\status (keysym 255 215))
+  (define-keysym #\clear-screen (keysym 255 217))
+  (define-keysym #\left (keysym 255 218))
+  (define-keysym #\middle (keysym 255 219))
+  (define-keysym #\right (keysym 255 220))
+  (define-keysym #\resume (keysym 255 221))
+  (define-keysym #\vt (keysym 009 233))		; :special ;; same as #\delete
+  )
+
+#+ti
+(progn  ;; Explorer specific characters
+  (define-keysym #\Call (keysym 131))		; :latin-1
+  (define-keysym #\Macro (keysym 133))		; :latin-1
+  (define-keysym #\Quote (keysym 142))		; :latin-1
+  (define-keysym #\Hold-output (keysym 143))	; :latin-1
+  (define-keysym #\Stop-output (keysym 144))	; :latin-1
+  (define-keysym #\Center (keysym 156))		; :latin-1
+  (define-keysym #\no-break-space (keysym 160))	; :latin-1
+
+  (define-keysym #\circle-plus (keysym 13))	; :latin-1
+  (define-keysym #\universal-quantifier (keysym 20))	; :latin-1
+  (define-keysym #\existential-quantifier (keysym 21))	; :latin-1
+  (define-keysym #\circle-cross (keysym 22))	; :latin-1
+  )
+
diff --git a/src/clx/macros.lsp b/src/clx/macros.lsp
new file mode 100644
index 000000000..24cb57221
--- /dev/null
+++ b/src/clx/macros.lsp
@@ -0,0 +1,1097 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+;;; CLX basicly implements a very low overhead remote procedure call
+;;; to the server.  This file contains macros which generate the code
+;;; for both the client AND the server, given a specification of the
+;;; interface. This was done to eliminate errors that may occur because
+;;; the client and server code get/put bytes in different places, and
+;;; it makes it easier to extend the protocol.
+
+;;; This is built on top of BUFFER
+
+(in-package :xlib)
+
+;;; This variable is used by the required-arg macro just to satisfy compilers.
+(defvar *required-arg-dummy*)
+
+;;; An error signalling macro use to specify that keyword arguments are required.
+(defmacro required-arg (name)
+  `(progn (x-error 'missing-parameter :parameter ',name)
+	  *required-arg-dummy*))
+
+(defmacro lround (index)
+  ;; Round up to the next 32 bit boundary
+  `(the array-index (logand (index+ ,index 3) -4)))
+
+(defmacro wround (index)
+  ;; Round up to the next 16 bit boundary
+  `(the array-index (logand (index+ ,index 1) -2)))
+
+;;
+;; Data-type accessor functions
+;;
+;;   These functions translate between lisp data-types and the byte,
+;;   half-word or word that gets transmitted across the client/server
+;;   connection
+
+(defun index-increment (type)
+  ;; Given a type, return its field width in bytes
+  (let* ((name (if (consp type) (car type) type))
+	 (increment (get name 'byte-width :not-found)))
+    (when (eq increment :not-found)
+      ;; Check for TYPE in a different package
+      (when (not (eq (symbol-package name) *xlib-package*))
+	(setq name (xintern name))
+	(setq increment (get name 'byte-width :not-found)))
+      (when (eq increment :not-found)
+	(error "~s isn't a known field accessor" name)))
+    increment))
+
+(eval-when (eval compile load)
+(defun getify (name)
+  (xintern name '-get))
+
+(defun putify (name &optional predicate-p)
+  (xintern name '-put (if predicate-p '-predicating "")))
+
+					;; Use &body so zmacs indents properly
+(defmacro define-accessor (name (width) &body get-put-macros)
+  ;; The first body form defines the get macro
+  ;; The second body form defines the put macro
+  ;; The third body form is optional, and defines a put macro that does
+  ;; type checking and does a put when ok, else NIL when the type is incorrect.
+  ;; If no third body form is present, then these macros assume that
+  ;; (AND (TYPEP ,thing 'type) (PUT-type ,thing)) can be generated.
+  ;; these predicating puts are used by the OR accessor.
+  (declare (arglist name (width) get-macro put-macro &optional predicating-put-macro))
+  (when (cdddr get-put-macros)
+    (error "Too many parameters to define-accessor: ~s" (cdddr get-put-macros)))
+  (let ((get-macro (or (first get-put-macros) (error "No GET macro form for ~s" name)))
+	(put-macro (or (second get-put-macros) (error "No PUT macro form for ~s" name))))
+    `(within-definition (,name define-accessor)
+       (setf (get ',name 'byte-width) ,(and width (floor width 8)))
+       (defmacro ,(getify name) ,(car get-macro)
+	 ,@(cdr get-macro))
+       (defmacro ,(putify name) ,(car put-macro)
+	 ,@(cdr put-macro))
+       ,@(when *type-check?*
+	   (let ((predicating-put (third get-put-macros)))
+	     (when predicating-put
+	       `((setf (get ',name 'predicating-put) t)
+		 (defmacro ,(putify name t) ,(car predicating-put)
+		   ,@(cdr predicating-put)))))))))
+) ;; End eval-when
+
+(define-accessor card32 (32)
+  ((index) `(read-card32 ,index))
+  ((index thing) `(write-card32 ,index ,thing)))
+
+(define-accessor card29 (32)
+  ((index) `(read-card29 ,index))
+  ((index thing) `(write-card29 ,index ,thing)))
+
+(define-accessor card16 (16)
+  ((index) `(read-card16 ,index))
+  ((index thing) `(write-card16 ,index ,thing)))
+
+(define-accessor card8 (8)
+  ((index) `(read-card8 ,index))
+  ((index thing) `(write-card8 ,index ,thing)))
+
+(define-accessor integer (32)
+  ((index) `(read-int32 ,index))
+  ((index thing) `(write-int32 ,index ,thing)))
+
+(define-accessor int16 (16)
+  ((index) `(read-int16 ,index))
+  ((index thing) `(write-int16 ,index ,thing)))
+
+(define-accessor rgb-val (16)
+  ;; Used for color's
+  ((index) `(card16->rgb-val (read-card16 ,index)))
+  ((index thing) `(write-card16 ,index (rgb-val->card16 ,thing))))
+
+(define-accessor angle (16)
+  ;; Used for drawing arcs
+  ((index) `(int16->radians (read-int16 ,index)))
+  ((index thing) `(write-int16 ,index (radians->int16 ,thing))))
+
+(define-accessor bit (0)
+  ;; Like BOOLEAN, but tests bits
+  ;; only used by declare-event (:enter-notify :leave-notify)
+  ((index bit)
+   `(logbitp ,bit (read-card8 ,index)))
+  ((index thing bit)
+   (if (zerop bit)
+       `(write-card8 ,index (if ,thing 1 0))
+     `(write-card8 ,index (dpb (if ,thing 1 0) (byte 1 ,bit) (read-card8 ,index))))))
+
+(define-accessor boolean (8)
+  ((index)
+   `(plusp (read-card8 ,index)))
+  ((index thing) `(write-card8 ,index (if ,thing 1 0))))
+
+(define-accessor drawable (32)
+  ((index &optional (buffer '%buffer))
+   `(lookup-drawable ,buffer (read-card29 ,index)))
+  ((index thing) `(write-card29 ,index (drawable-id ,thing))))
+
+(define-accessor window (32)
+  ((index &optional (buffer '%buffer))
+   `(lookup-window ,buffer (read-card29 ,index)))
+  ((index thing) `(write-card29 ,index (window-id ,thing))))
+
+(define-accessor pixmap (32)
+  ((index &optional (buffer '%buffer))
+   `(lookup-pixmap ,buffer (read-card29 ,index)))
+  ((index thing) `(write-card29 ,index (pixmap-id ,thing))))
+
+(define-accessor gcontext (32)
+  ((index &optional (buffer '%buffer))
+   `(lookup-gcontext ,buffer (read-card29 ,index)))
+  ((index thing) `(write-card29 ,index (gcontext-id ,thing))))
+
+(define-accessor cursor (32)
+  ((index &optional (buffer '%buffer))
+   `(lookup-cursor ,buffer (read-card29 ,index)))
+  ((index thing) `(write-card29 ,index (cursor-id ,thing))))
+
+(define-accessor colormap (32)
+  ((index &optional (buffer '%buffer))
+   `(lookup-colormap ,buffer (read-card29 ,index)))
+  ((index thing) `(write-card29 ,index (colormap-id ,thing))))
+
+(define-accessor font (32)
+  ((index &optional (buffer '%buffer))
+   `(lookup-font ,buffer (read-card29 ,index)))
+  ;; The FONT-ID accessor may make a OpenFont request.  Since we don't support recursive
+  ;; with-buffer-request, issue a compile time error, rather than barf at run-time.
+  ((index thing)
+   (declare (ignore index thing))
+   (error "FONT-ID must be called OUTSIDE with-buffer-request.  Use RESOURCE-ID instead.")))
+
+;; Needed to get and put xatom's in events
+(define-accessor keyword (32)
+  ((index &optional (buffer '%buffer))
+   `(atom-name ,buffer (read-card29 ,index)))
+  ((index thing &key (buffer '%buffer))
+   `(write-card29 ,index (or (atom-id ,thing ,buffer)
+			     (error "CLX implementation error in KEYWORD-PUT")))))
+
+(define-accessor resource-id (32)
+  ((index) `(read-card29 ,index))
+  ((index thing) `(write-card29 ,index ,thing)))
+
+(define-accessor resource-id-or-nil (32)
+  ((index) (let ((id (gensym)))
+	     `(let ((,id (read-card29 ,index)))
+                #+ecl (declare (type card29 ,id))
+		(and (plusp ,id) ,id))))
+  ((index thing) `(write-card29 ,index (or ,thing 0))))
+
+(defmacro char-info-get (index)
+  `(make-char-info
+     :left-bearing (int16-get ,index)
+     :right-bearing (int16-get ,(+ index 2))
+     :width	   (int16-get ,(+ index 4))
+     :ascent	   (int16-get ,(+ index 6))
+     :descent	   (int16-get ,(+ index 8))
+     :attributes   (card16-get ,(+ index 10))))
+
+(define-accessor member8 (8)
+  ((index &rest keywords)
+   (let ((value (gensym)))
+     `(let ((,value (read-card8 ,index)))
+        #+ecl (declare (type card8 ,value))
+	(and (< ,value ,(length keywords))
+	     (svref ',(apply #'vector keywords) ,value)))))
+  ((index thing &rest keywords)
+   `(write-card8 ,index (position ,thing
+				  #+lispm ',keywords ;; Lispm's prefer lists
+				  #-lispm (the simple-vector ',(apply #'vector keywords))
+				  :test #'eq)))
+  ((index thing &rest keywords)
+   (let ((value (gensym)))
+     `(let ((,value (position ,thing
+			      #+lispm ',keywords
+			      #-lispm (the simple-vector ',(apply #'vector keywords))
+			      :test #'eq)))
+        #+ecl (declare (type card8 ,value))
+	(and ,value (write-card8 ,index ,value))))))
+
+(define-accessor member16 (16)
+  ((index &rest keywords)
+   (let ((value (gensym)))
+     `(let ((,value (read-card16 ,index)))
+        #+ecl (declare (type card16 ,value))
+	(and (< ,value ,(length keywords))
+	     (svref ',(apply #'vector keywords) ,value)))))
+  ((index thing &rest keywords)
+   `(write-card16 ,index (position ,thing
+				   #+lispm ',keywords ;; Lispm's prefer lists
+				   #-lispm (the simple-vector ',(apply #'vector keywords))
+				   :test #'eq)))
+  ((index thing &rest keywords)
+   (let ((value (gensym)))
+     `(let ((,value (position ,thing
+			      #+lispm ',keywords
+			      #-lispm (the simple-vector ',(apply #'vector keywords))
+			      :test #'eq)))
+        #+ecl (declare (type card16 ,value))
+	(and ,value (write-card16 ,index ,value))))))
+
+(define-accessor member (32)
+  ((index &rest keywords)
+   (let ((value (gensym)))
+     `(let ((,value (read-card29 ,index)))
+        #+ecl (declare (type card29 ,value))
+	(and (< ,value ,(length keywords))
+	     (svref ',(apply #'vector keywords) ,value)))))
+  ((index thing &rest keywords)
+   `(write-card29 ,index (position ,thing
+				   #+lispm ',keywords ;; Lispm's prefer lists
+				   #-lispm (the simple-vector ',(apply #'vector keywords))
+				   :test #'eq)))
+  ((index thing &rest keywords)
+   (if (cdr keywords) ;; IF more than one
+       (let ((value (gensym)))
+	 `(let ((,value (position ,thing
+				   #+lispm ',keywords
+				   #-lispm (the simple-vector ',(apply #'vector keywords))
+				  :test #'eq)))
+            #+ecl (declare (type card29 ,value))
+	    (and ,value (write-card29 ,index ,value))))
+     `(and (eq ,thing ,(car keywords)) (write-card29 ,index 0)))))
+
+(deftype member-vector (vector) `(member ,@(coerce (symbol-value vector) 'list)))
+
+(define-accessor member-vector (32)
+  ((index membership-vector)
+   `(member-get ,index ,@(coerce (eval membership-vector) 'list)))
+  ((index thing membership-vector)
+   `(member-put ,index ,thing ,@(coerce (eval membership-vector) 'list)))
+  ((index thing membership-vector)
+   `(member-put ,index ,thing ,@(coerce (eval membership-vector) 'list))))
+
+(define-accessor member16-vector (16)
+  ((index membership-vector)
+   `(member16-get ,index ,@(coerce (eval membership-vector) 'list)))
+  ((index thing membership-vector)
+   `(member16-put ,index ,thing ,@(coerce (eval membership-vector) 'list)))
+  ((index thing membership-vector)
+   `(member16-put ,index ,thing ,@(coerce (eval membership-vector) 'list))))
+
+(define-accessor member8-vector (8)
+  ((index membership-vector)
+   `(member8-get ,index ,@(coerce (eval membership-vector) 'list)))
+  ((index thing membership-vector)
+   `(member8-put ,index ,thing ,@(coerce (eval membership-vector) 'list)))
+  ((index thing membership-vector)
+   `(member8-put ,index ,thing ,@(coerce (eval membership-vector) 'list))))
+
+(define-accessor boole-constant (32)
+  ;; this isn't member-vector because we need eql instead of eq
+  ((index)
+   (let ((value (gensym)))
+     `(let ((,value (read-card29 ,index)))
+        #+ecl (declare (type card29 ,value))
+	(and (< ,value ,(length *boole-vector*))
+	     (svref *boole-vector* ,value)))))
+  ((index thing)
+   `(write-card29 ,index (position ,thing (the simple-vector *boole-vector*))))
+  ((index thing)
+   (let ((value (gensym)))
+     `(let ((,value (position ,thing (the simple-vector *boole-vector*))))
+        #+ecl (declare (type card29 ,value))
+	(and ,value (write-card29 ,index ,value))))))
+
+(define-accessor null (32)
+  ((index) `(if (zerop (read-card32 ,index)) nil (read-card32 ,index)))
+  ((index value) (declare (ignore value)) `(write-card32 ,index 0)))
+
+(define-accessor pad8 (8)
+  ((index) (declare (ignore index)) nil)
+  ((index value) (declare (ignore index value))  nil))
+
+(define-accessor pad16 (16)
+  ((index) (declare (ignore index)) nil)
+  ((index value) (declare (ignore index value)) nil))
+
+(define-accessor bit-vector256 (256)
+  ;; used for key-maps
+  ;; REAL-INDEX parameter provided so the default index can be over-ridden.
+  ;; This is needed for the :keymap-notify event where the keymap overlaps
+  ;; the window id.
+  ((index &optional (real-index index) data)
+   `(read-bitvector256 buffer-bbuf ,real-index ,data))
+  ((index map &optional (real-index index) (buffer '%buffer))
+   `(write-bitvector256 ,buffer (index+ buffer-boffset ,real-index) ,map)))
+   
+(define-accessor string (nil)
+  ((length index &key reply-buffer)
+   `(read-sequence-char
+      ,(or reply-buffer '%reply-buffer) 'string ,length nil nil 0 ,index))
+  ((index string &key buffer (start 0) end header-length appending)
+   (unless buffer (setq buffer '%buffer))
+   (unless header-length (setq header-length (lround index)))
+   (let* ((real-end (if appending (or end `(length ,string)) (gensym)))
+	  (form `(write-sequence-char ,buffer (index+ buffer-boffset ,header-length)
+				      ,string ,start ,real-end)))
+     (if appending
+	 form
+       `(let ((,real-end ,(or end `(length ,string))))
+	  #+ecl (declare (type array-index ,real-end))
+	  (write-card16 2 (index-ceiling (index+ (index- ,real-end ,start) ,header-length) 4))
+	  ,form)))))
+
+(define-accessor sequence (nil)
+  ((&key length (format 'card32) result-type transform reply-buffer data index start)
+   `(,(ecase format
+	(card8 'read-sequence-card8)
+	(int8 'read-sequence-int8)
+	(card16 'read-sequence-card16)
+	(int16 'read-sequence-int16)
+	(card32 'read-sequence-card32)
+	(int32 'read-sequence-int32))
+     ,(or reply-buffer '%reply-buffer)
+     ,result-type ,length ,transform ,data
+     ,@(when (or start index) `(,(or start 0)))
+     ,@(when index `(,index))))
+  ((index data &key (format 'card32) (start 0) end transform buffer appending)
+   (unless buffer (setq buffer '%buffer))
+   (let* ((real-end (if appending (or end `(length ,data)) (gensym)))
+	  (writer (xintern 'write-sequence- format))
+	  (form `(,writer ,buffer (index+ buffer-boffset ,(lround index))
+		  ,data ,start ,real-end ,transform)))
+     (flet ((maker (size)
+	      (if appending
+		  form
+		  (let ((idx `(index- ,real-end ,start)))
+		    (unless (= size 1)
+		      (setq idx `(index-ceiling ,idx ,size)))
+		    `(let ((,real-end ,(or end `(length ,data))))
+                       #+ecl (declare (type array-index ,real-end))
+		       (write-card16 2 (index+ ,idx ,(index-ceiling index 4)))
+		       ,form)))))
+       (ecase format
+	 ((card8 int8)
+	  (maker 4))
+	 ((card16 int16 char2b)
+	  (maker 2))
+	 ((card32 int32)
+	  (maker 1)))))))
+
+(defmacro client-message-event-get-sequence ()
+  '(let* ((format (read-card8 1))
+ 	  (sequence (make-array (ceiling 160 format)
+				:element-type `(unsigned-byte ,format))))
+     (do ((i 12)
+	  (j 0 (1+ j)))
+	 ((>= i 32))
+       (case format
+	 (8 (setf (aref sequence j) (read-card8 i))
+	    (incf i))
+	 (16 (setf (aref sequence j) (read-card16 i))
+	     (incf i 2))
+	 (32 (setf (aref sequence j) (read-card32 i))
+	     (incf i 4))))
+     sequence))
+
+(defmacro client-message-event-put-sequence (format sequence)
+  `(ecase ,format
+     (8  (sequence-put 12 ,sequence
+		       :format card8
+		       :end (min (length ,sequence) 20)
+		       :appending t))
+     (16 (sequence-put 12 ,sequence
+		       :format card16
+		       :end (min (length ,sequence) 10)
+		       :appending t))
+     (32 (sequence-put 12 ,sequence
+		       :format card32
+		       :end (min (length ,sequence) 5)
+		       :appending t))))
+
+;; Used only in declare-event
+(define-accessor client-message-sequence (160)
+  ((index format) (declare (ignore index format)) `(client-message-event-get-sequence))
+  ((index value format) (declare (ignore index))
+   `(client-message-event-put-sequence ,format ,value)))
+
+
+;;;
+;;; Compound accessors
+;;;    Accessors that take other accessors as parameters
+;;;
+(define-accessor code (0)
+  ((index) (declare (ignore index)) '(read-card8 0))
+  ((index value) (declare (ignore index)) `(write-card8 0 ,value))
+  ((index value) (declare (ignore index)) `(write-card8 0 ,value)))
+
+(define-accessor length (0)
+  ((index) (declare (ignore index)) '(read-card16 2))
+  ((index value) (declare (ignore index)) `(write-card16 2 ,value))
+  ((index value) (declare (ignore index)) `(write-card16 2 ,value)))
+
+(deftype data () 'card8)
+
+(define-accessor data (0)
+  ;; Put data in byte 1 of the reqeust
+  ((index &optional stuff) (declare (ignore index))
+   (if stuff
+       (if (consp stuff)
+	   `(,(getify (car stuff)) 1 ,@(cdr stuff))
+	 `(,(getify stuff) 1))
+     `(read-card8 1)))
+  ((index thing &optional stuff)
+   (if stuff
+       (if (consp stuff)
+	   `(macrolet ((write-card32 (index value) index value))
+	      (write-card8 1 (,(putify (car stuff)) ,index ,thing ,@(cdr stuff))))
+	 `(,(putify stuff) 1 ,thing))
+     `(write-card8 1 ,thing)))
+  ((index thing &optional stuff)
+   (if stuff
+       `(and (type? ,thing ',stuff)
+	     ,(if (consp stuff)
+		  `(macrolet ((write-card32 (index value) index value))
+		     (write-card8 1 (,(putify (car stuff)) ,index ,thing ,@(cdr stuff))))
+		`(,(putify stuff) 1 ,thing)))
+     `(and (type? ,thing 'card8) (write-card8 1 ,thing)))))
+
+;; Macroexpand the result of OR-GET to allow the macros file to not be loaded
+;; when using event-case.  This is pretty gross.
+
+(defmacro or-expand (&rest forms &environment environment)
+  `(cond ,@(mapcar #'(lambda (forms)
+		       (mapcar #'(lambda (form)
+				   (macroexpand form environment))
+			       forms))
+		   forms)))
+
+;;
+;; the OR type
+;;
+(define-accessor or (32)
+  ;; Select from among several types (usually NULL and something else)
+  ((index &rest type-list &environment environment)
+   (do ((types type-list (cdr types))
+	(value (gensym))
+	(result))
+       ((endp types)
+	`(let ((,value (read-card32 ,index)))
+           #+ecl (declare (type card32 ,value))
+	   (macrolet ((read-card32 (index) index ',value)
+		      (read-card29 (index) index ',value))
+	     ,(macroexpand `(or-expand ,@(nreverse result)) environment))))
+     (let ((item (car types))
+	   (args nil))
+       (when (consp item)
+	 (setq args (cdr item)
+	       item (car item)))
+       (if (eq item 'null)  ;; Special case for NULL
+	   (push `((zerop ,value) nil) result)
+	 (push
+	   `((,(getify item) ,index ,@args))
+	   result)))))
+
+  ((index value &rest type-list)
+   (do ((types type-list (cdr types))
+	(result))
+       ((endp types)
+	`(cond ,@(nreverse result)
+	       ,@(when *type-check?*
+		   `((t (x-type-error ,value '(or ,@type-list)))))))
+     (let* ((type (car types))
+	    (type-name type)
+	    (args nil))
+       (when (consp type)
+	 (setq args (cdr type)
+	       type-name (car type)))
+       (push
+	 `(,@(cond ((get type-name 'predicating-put) nil)
+		   ((or *type-check?* (cdr types)) `((type? ,value ',type)))
+		   (t '(t)))
+	   (,(putify type-name (get type-name 'predicating-put)) ,index ,value ,@args))
+	 result)))))
+
+;;
+;; the MASK type...
+;;     is used to specify a subset of a collection of "optional" arguments.
+;;     A mask type consists of a 32 bit mask word followed by a word for each one-bit
+;;     in the mask.  The MASK type is ALWAYS the LAST item in a request.
+;;
+(setf (get 'mask 'byte-width) nil)
+
+(defun mask-get (index type-values body-function)
+  (declare (type function body-function)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent body-function)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg body-function))
+  ;; This is a function, because it must return more than one form (called by get-put-items)
+  ;; Functions that use this must have a binding for %MASK
+  (let* ((bit 0)
+	 (result
+	   (mapcar
+	     #'(lambda (form)
+		 (if (atom form)
+		     form ;; Hack to allow BODY-FUNCTION to return keyword/value pairs
+		   (prog1
+		     `(when (logbitp ,bit %mask)
+			;; Execute form when bit is set
+			,form)
+		     (incf bit))))
+	     (get-put-items
+	       (#-ecl + #+ecl index+ index 4) type-values nil
+	       #'(lambda (type index item args)
+		   (declare (ignore index))
+		   (funcall body-function type '(* (incf %index) 4) item args))))))
+    ;; First form must load %MASK
+    `(,@(when (atom (car result))
+	  (list (pop result)))
+      (progn (setq %mask (read-card32 ,index))
+	     (setq %index ,(ceiling index 4))
+	     ,(car result))
+      ,@(cdr result))))
+
+;; MASK-PUT 
+
+(defun mask-put (index type-values body-function)
+  (declare (type function body-function)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent body-function)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg body-function))
+  ;; The MASK type writes a 32 bit mask with 1 bits for each non-nil value in TYPE-VALUES
+  ;; A 32 bit value follows for each non-nil value.
+  `((let ((%mask 0)
+	  (%index ,index))
+      ,@(let ((bit 1))
+	  (get-put-items
+	    index type-values t 
+	    #'(lambda (type index item args)
+		(declare (ignore index))
+		(if (or (symbolp item) (constantp item))
+		    `((unless (null ,item)
+			(setq %mask (logior %mask ,(shiftf bit (ash bit 1))))
+			,@(funcall body-function type
+				   `(index-incf %index 4) item args)))
+		  `((let ((.item. ,item))
+		      (unless (null .item.)
+			(setq %mask (logior %mask ,(shiftf bit (ash bit 1))))
+			,@(funcall body-function type
+				   `(index-incf %index 4) '.item. args))))))))
+      (write-card32 ,index %mask)
+      (write-card16 2 (index-ceiling (index-incf %index 4) 4))
+      (incf (buffer-boffset %buffer) %index))))
+
+(define-accessor progn (nil)
+  ;; Catch-all for inserting random code
+  ;; Note that code using this is then responsible for setting the request length
+  ((index statement) (declare (ignore index)) statement)
+  ((index statement) (declare (ignore index)) statement))
+
+
+;
+; Wrapper macros, for use around the above
+;
+(defmacro type-check (value type)
+  value type
+  (when *type-check?*
+    `(unless (type? ,value ,type)
+       (x-type-error ,value ,type))))
+
+(defmacro check-put (index value type &rest args &environment env)
+  (let* ((var (if (or (symbolp value) (constantp value)) value '.value.))
+	 (body
+	   (if (or (null (macroexpand `(type-check ,var ',type) env))
+		   (member type '(or progn pad8 pad16))
+		   (constantp value))
+	       `(,(putify type) ,index ,var ,@args)
+	     ;; Do type checking
+	     (if (get type 'predicating-put)
+		 `(or (,(putify type t) ,index ,var ,@args)
+		      (x-type-error ,var ',(if args `(,type ,@args) type)))
+	       `(if (type? ,var ',type)
+		    (,(putify type) ,index ,var ,@args)
+		  (x-type-error ,var ',(if args `(,type ,@args) type)))))))
+    (if (eq var value)
+	body
+      `(let ((,var ,value))
+	 ,body))))
+
+(defun get-put-items (index type-args putp &optional body-function)
+  (declare (type (or null function) body-function)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent body-function)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg body-function))
+  ;; Given a lists of the form (type item item ... item)
+  ;; Calls body-function with four arguments, a function name,
+  ;; index, item name, and optional arguments.
+  ;; The results are appended together and retured.
+  (unless body-function
+    (setq body-function
+	  #'(lambda (type index item args)
+	      `((check-put ,index ,item ,type ,@args)))))
+  (do* ((items type-args (cdr items))
+	(type (caar items) (caar items))
+	(args nil nil)
+	(result nil)
+	(sizes nil))
+       ((endp items) (values result index sizes))
+    (when (consp type)
+      (setq args (cdr type)
+	    type (car type)))
+    (cond ((member type '(return buffer)))
+	  ((eq type 'mask) ;; Hack to enable mask-get/put to return multiple values
+	   (setq result
+		 (append result (if putp
+				    (mask-put index (cdar items) body-function)
+				  (mask-get index (cdar items) body-function)))
+		 index nil))
+	  (t (do* ((item (cdar items) (cdr item))
+		   (increment (index-increment type)))
+		  ((endp item))
+	       (when (constantp index)
+		 (case increment		;Round up index when needed
+		   (2 (setq index (wround index)))
+		   (4 (setq index (lround index)))))
+	       (setq result
+		     (append result (funcall body-function type index (car item) args)))
+	       (when (constantp index)
+		 ;; Variable length requests have null length increment.
+		 ;; Variable length requests set the request size 
+		 ;; & maintain buffer pointers
+		 (if (null increment) 
+		     (setq index nil)
+		   (progn
+		     (incf index increment)
+		     (when (and increment (zerop increment)) (setq increment 1))
+		     (pushnew (* increment 8) sizes)))))))))
+
+(defmacro with-buffer-request-internal
+	  ((buffer opcode &key length sizes &allow-other-keys)
+	   &body type-args)
+  (multiple-value-bind (code index item-sizes)
+      (get-put-items 4 type-args t)
+    (let ((length (if length `(index+ ,length *requestsize*) '*requestsize*))
+	  (sizes (remove-duplicates (append '(8 16) item-sizes sizes))))
+      `(with-buffer-output (,buffer :length ,length :sizes ,sizes)
+	 (setf (buffer-last-request ,buffer) buffer-boffset)
+	 (write-card8 0 ,opcode)	   ;; Stick in the opcode
+	 ,@code
+	 ,@(when index
+	     (setq index (lround index))
+	     `((write-card16 2 ,(ceiling index 4))
+	       (setf (buffer-boffset ,buffer) (index+ buffer-boffset ,index))))
+	 (buffer-new-request-number ,buffer)))))
+
+(defmacro with-buffer-request
+	  ((buffer opcode &rest options &key inline gc-force &allow-other-keys)
+	   &body type-args &environment env)
+  (if (and (null inline) (macroexpand '(use-closures) env))
+      `(flet ((.request-body. (.display.)
+		(declare (type display .display.))
+		(with-buffer-request-internal (.display. ,opcode ,@options)
+		  ,@type-args)))
+	 #+clx-ansi-common-lisp
+	 (declare (dynamic-extent #'.request-body.))
+	 (,(if (eq (car (macroexpand '(with-buffer (buffer)) env)) 'progn)
+	       'with-buffer-request-function-nolock
+	     'with-buffer-request-function)
+	  ,buffer ,gc-force #'.request-body.))
+    `(let ((.display. ,buffer))
+       (declare (type display .display.))
+       (with-buffer (.display.)
+	 ,@(when gc-force `((force-gcontext-changes-internal ,gc-force)))
+	 (multiple-value-prog1
+	   (without-aborts 
+	     (with-buffer-request-internal (.display. ,opcode ,@options)
+	       ,@type-args))
+	   (display-invoke-after-function .display.))))))
+
+(defmacro with-buffer-request-and-reply
+	  ((buffer opcode reply-size &key sizes multiple-reply inline)
+	   type-args &body reply-forms &environment env)
+  (declare (indentation 0 4 1 4 2 1))
+  (let* ((inner-reply-body
+	   `(with-buffer-input (.reply-buffer. :display .display.
+					       ,@(and sizes (list :sizes sizes)))
+	      nil ,@reply-forms))
+	 (reply-body
+	   (if (or (not (symbolp reply-size)) (constantp reply-size))
+	       inner-reply-body
+	     `(let ((,reply-size (reply-data-size (the reply-buffer .reply-buffer.))))
+		(declare (type array-index ,reply-size))
+		,inner-reply-body))))
+    (if (and (null inline) (macroexpand '(use-closures) env))
+	`(flet ((.request-body. (.display.)
+		  (declare (type display .display.))
+		  (with-buffer-request-internal (.display. ,opcode)
+		    ,@type-args))
+		(.reply-body. (.display. .reply-buffer.)
+		  (declare (type display .display.)
+			   (type reply-buffer .reply-buffer.))
+		  (progn .display. .reply-buffer. nil)
+		  ,reply-body))
+	   #+clx-ansi-common-lisp
+	   (declare (dynamic-extent #'.request-body. #'.reply-body.))
+	   (with-buffer-request-and-reply-function
+	     ,buffer ,multiple-reply #'.request-body. #'.reply-body.))
+      `(let ((.display. ,buffer)
+	     (.pending-command. nil)
+	     (.reply-buffer. nil))
+	 (declare (type display .display.)
+		  (type (or null pending-command) .pending-command.)
+		  (type (or null reply-buffer) .reply-buffer.))
+	 (unwind-protect
+	     (progn 
+	       (with-buffer (.display.)
+		 (setq .pending-command. (start-pending-command .display.))
+		 (without-aborts
+		   (with-buffer-request-internal (.display. ,opcode)
+		     ,@type-args))
+		 (buffer-force-output .display.)
+		 (display-invoke-after-function .display.))
+	       ,@(if multiple-reply
+		     `((loop
+			 (setq .reply-buffer. (read-reply .display. .pending-command.))
+			 (when ,reply-body (return nil))
+			 (deallocate-reply-buffer (shiftf .reply-buffer. nil))))
+		   `((setq .reply-buffer. (read-reply .display. .pending-command.))
+		     ,reply-body)))
+	   (when .reply-buffer.
+	     (deallocate-reply-buffer .reply-buffer.))
+	   (when .pending-command.
+	     (stop-pending-command .display. .pending-command.)))))))
+
+(defmacro compare-request ((index) &body body)
+  `(macrolet ((write-card32 (index item) `(= ,item (read-card32 ,index)))
+	      (write-int32 (index item) `(= ,item (read-int32 ,index)))
+	      (write-card29 (index item) `(= ,item (read-card29 ,index)))
+	      (write-int29 (index item) `(= ,item (read-int29 ,index)))
+	      (write-card16 (index item) `(= ,item (read-card16 ,index)))
+	      (write-int16 (index item) `(= ,item (read-int16 ,index)))
+	      (write-card8 (index item) `(= ,item (read-card8 ,index)))
+	      (write-int8 (index item) `(= ,item (read-int8 ,index))))
+     (macrolet ((type-check (value type) value type nil))
+       (and ,@(get-put-items index body t)))))
+
+(defmacro put-items ((index) &body body)
+  `(progn ,@(get-put-items index body t)))
+
+(defmacro decode-type (type value)
+  ;; Given an integer and type, return the value
+  (let ((args nil))
+    (when (consp type)
+      (setq args (cdr type)
+	    type (car type)))
+    `(macrolet ((read-card29 (value) value)
+		(read-card32 (value) value)
+		(read-int32 (value) `(card32->int32 ,value))
+		(read-card16 (value) value)
+		(read-int16 (value) `(card16->int16 ,value))
+		(read-card8 (value) value)
+		(read-int8 (value) `(int8->card8 ,value)))
+       (,(getify type) ,value ,@args))))
+
+(defmacro encode-type (type value)
+  ;; Given a value and type, return an integer
+  ;; When check-p, do type checking on value
+  (let ((args nil))
+    (when (consp type)
+      (setq args (cdr type)
+	    type (car type)))
+    `(macrolet ((write-card29 (index value) index value)
+		(write-card32 (index value) index value)
+		(write-int32 (index value) index `(int32->card32 ,value))
+		(write-card16 (index value) index value)
+		(write-int16 (index value) index `(int16->card16 ,value))
+		(write-card8 (index value) index value)
+		(write-int8 (index value) index `(int8->card8 ,value)))
+       (check-put 0 ,value ,type ,@args))))
+
+(defmacro set-decode-type (type accessor value)
+  `(setf ,accessor (encode-type ,type ,value)))
+(defsetf decode-type set-decode-type)
+
+
+;;;
+;;; Request codes
+;;; 
+
+(defconstant *x-createwindow*                  1)
+(defconstant *x-changewindowattributes*        2)
+(defconstant *x-getwindowattributes*           3)
+(defconstant *x-destroywindow*                 4)
+(defconstant *x-destroysubwindows*             5)  
+(defconstant *x-changesaveset*                 6)
+(defconstant *x-reparentwindow*                7)
+(defconstant *x-mapwindow*                     8)
+(defconstant *x-mapsubwindows*                 9)
+(defconstant *x-unmapwindow*                  10)
+(defconstant *x-unmapsubwindows*              11) 
+(defconstant *x-configurewindow*              12)
+(defconstant *x-circulatewindow*              13)
+(defconstant *x-getgeometry*                  14)
+(defconstant *x-querytree*                    15)
+(defconstant *x-internatom*                   16)
+(defconstant *x-getatomname*                  17)
+(defconstant *x-changeproperty*               18)
+(defconstant *x-deleteproperty*               19)
+(defconstant *x-getproperty*                  20)
+(defconstant *x-listproperties*               21)
+(defconstant *x-setselectionowner*            22)  
+(defconstant *x-getselectionowner*            23) 
+(defconstant *x-convertselection*             24)
+(defconstant *x-sendevent*                    25)
+(defconstant *x-grabpointer*                  26)
+(defconstant *x-ungrabpointer*                27)
+(defconstant *x-grabbutton*                   28)
+(defconstant *x-ungrabbutton*                 29)
+(defconstant *x-changeactivepointergrab*      30)         
+(defconstant *x-grabkeyboard*                 31)
+(defconstant *x-ungrabkeyboard*               32)
+(defconstant *x-grabkey*                      33)
+(defconstant *x-ungrabkey*                    34)
+(defconstant *x-allowevents*                  35)
+(defconstant *x-grabserver*                   36)     
+(defconstant *x-ungrabserver*                 37)       
+(defconstant *x-querypointer*                 38)       
+(defconstant *x-getmotionevents*              39)          
+(defconstant *x-translatecoords*              40)               
+(defconstant *x-warppointer*                  41)      
+(defconstant *x-setinputfocus*                42)        
+(defconstant *x-getinputfocus*                43)        
+(defconstant *x-querykeymap*                  44)      
+(defconstant *x-openfont*                     45)   
+(defconstant *x-closefont*                    46)    
+(defconstant *x-queryfont*                    47)
+(defconstant *x-querytextextents*             48)    
+(defconstant *x-listfonts*                    49) 
+(defconstant *x-listfontswithinfo*    	      50)
+(defconstant *x-setfontpath*                  51)
+(defconstant *x-getfontpath*                  52)
+(defconstant *x-createpixmap*                 53)      
+(defconstant *x-freepixmap*                   54)   
+(defconstant *x-creategc*                     55)
+(defconstant *x-changegc*                     56)
+(defconstant *x-copygc*                       57)
+(defconstant *x-setdashes*                    58)  
+(defconstant *x-setcliprectangles*            59)         
+(defconstant *x-freegc*                       60)
+(defconstant *x-cleartobackground*            61)          
+(defconstant *x-copyarea*                     62)
+(defconstant *x-copyplane*                    63)
+(defconstant *x-polypoint*                    64)
+(defconstant *x-polyline*                     65)
+(defconstant *x-polysegment*                  66)  
+(defconstant *x-polyrectangle*                67)   
+(defconstant *x-polyarc*                      68)
+(defconstant *x-fillpoly*                     69)
+(defconstant *x-polyfillrectangle*            70)        
+(defconstant *x-polyfillarc*                  71) 
+(defconstant *x-putimage*                     72)
+(defconstant *x-getimage*                     73)
+(defconstant *x-polytext8*                    74)   
+(defconstant *x-polytext16*                   75)   
+(defconstant *x-imagetext8*                   76)  
+(defconstant *x-imagetext16*                  77)  
+(defconstant *x-createcolormap*               78)    
+(defconstant *x-freecolormap*                 79) 
+(defconstant *x-copycolormapandfree*          80)       
+(defconstant *x-installcolormap*              81)  
+(defconstant *x-uninstallcolormap*            82)   
+(defconstant *x-listinstalledcolormaps*       83)       
+(defconstant *x-alloccolor*                   84)
+(defconstant *x-allocnamedcolor*              85)    
+(defconstant *x-alloccolorcells*              86)   
+(defconstant *x-alloccolorplanes*             87)   
+(defconstant *x-freecolors*                   88)
+(defconstant *x-storecolors*                  89)
+(defconstant *x-storenamedcolor*              90)   
+(defconstant *x-querycolors*                  91)
+(defconstant *x-lookupcolor*                  92)
+(defconstant *x-createcursor*                 93)
+(defconstant *x-createglyphcursor*            94)    
+(defconstant *x-freecursor*                   95)
+(defconstant *x-recolorcursor*                96)  
+(defconstant *x-querybestsize*                97) 
+(defconstant *x-queryextension*               98) 
+(defconstant *x-listextensions*               99)
+(defconstant *x-setkeyboardmapping*           100)
+(defconstant *x-getkeyboardmapping*           101)
+(defconstant *x-changekeyboardcontrol*        102)               
+(defconstant *x-getkeyboardcontrol*           103)           
+(defconstant *x-bell*                         104)
+(defconstant *x-changepointercontrol*         105)
+(defconstant *x-getpointercontrol*            106)
+(defconstant *x-setscreensaver*               107)         
+(defconstant *x-getscreensaver*               108)        
+(defconstant *x-changehosts*                  109)    
+(defconstant *x-listhosts*                    110) 
+(defconstant *x-changeaccesscontrol*          111)          
+(defconstant *x-changeclosedownmode*          112)
+(defconstant *x-killclient*                   113)
+(defconstant *x-rotateproperties*	      114)
+(defconstant *x-forcescreensaver*	      115)
+(defconstant *x-setpointermapping*            116)
+(defconstant *x-getpointermapping*            117)
+(defconstant *x-setmodifiermapping*	      118)
+(defconstant *x-getmodifiermapping*	      119)
+(defconstant *x-nooperation*                  127)
+
+;;; Some macros for threaded lists
+
+(defmacro threaded-atomic-push (item list next type)
+  (let ((x (gensym))
+	(y (gensym)))
+    `(let ((,x ,item))
+       (declare (type ,type ,x))
+       (loop
+	 (let ((,y ,list))
+	   (declare (type (or null ,type) ,y)
+		    (optimize (speed 3) (safety 0)))
+	   (setf (,next ,x) ,y)
+	   (when (conditional-store ,list ,y ,x)
+	     (return ,x)))))))
+
+(defmacro threaded-atomic-pop (list next type)
+  (let ((y (gensym)))
+    `(loop
+       (let ((,y ,list))
+	 (declare (type (or null ,type) ,y)
+		  (optimize (speed 3) (safety 0)))
+	 (if (null ,y)
+	     (return nil)
+	   (when (conditional-store ,list ,y (,next (the ,type ,y)))
+	     (setf (,next (the ,type ,y)) nil)
+	     (return ,y)))))))
+
+(defmacro threaded-nconc (item list next type)
+  (let ((first (gensym))
+	(x (gensym))
+	(y (gensym))
+	(z (gensym)))
+    `(let ((,z ,item)
+	   (,first ,list))
+       (declare (type ,type ,z)
+		(type (or null ,type) ,first)
+		(optimize (speed 3) (safety 0)))
+       (if (null ,first)
+	   (setf ,list ,z)
+	 (do* ((,x ,first ,y)
+	       (,y (,next ,x) (,next ,x)))
+	      ((null ,y)
+	       (setf (,next ,x) ,z)
+	       ,first)
+	   (declare (type ,type ,x)
+		    (type (or null ,type) ,y)))))))
+
+(defmacro threaded-push (item list next type)
+  (let ((x (gensym)))
+    `(let ((,x ,item))
+       (declare (type ,type ,x)
+		(optimize (speed 3) (safety 0)))
+       (shiftf (,next ,x) ,list ,x)
+       ,x)))
+
+(defmacro threaded-pop (list next type)
+  (let ((x (gensym)))
+    `(let ((,x ,list))
+       (declare (type (or null ,type) ,x)
+		(optimize (speed 3) (safety 0)))
+       (when ,x
+	 (shiftf ,list (,next (the ,type ,x)) nil))
+       ,x)))
+
+(defmacro threaded-enqueue (item head tail next type)
+  (let ((x (gensym)))
+    `(let ((,x ,item))
+       (declare (type ,type ,x)
+		(optimize (speed 3) (safety 0)))
+       (if (null ,tail)
+	   (threaded-nconc ,x ,head ,next ,type)
+	 (threaded-nconc ,x (,next (the ,type ,tail)) ,next ,type))
+       (setf ,tail ,x))))
+
+(defmacro threaded-dequeue (head tail next type)
+  (let ((x (gensym)))
+    `(let ((,x ,head))
+       (declare (type (or null ,type) ,x)
+		(optimize (speed 3) (safety 0)))
+       (when ,x
+	 (when (eq ,x ,tail)
+	   (setf ,tail (,next (the ,type ,x))))
+	 (setf ,head (,next (the ,type ,x))))
+       ,x)))
+
+(defmacro threaded-requeue (item head tail next type)
+  (let ((x (gensym)))
+    `(let ((,x ,item))
+       (declare (type ,type ,x)
+		(optimize (speed 3) (safety 0)))
+       (if (null ,tail)
+	   (setf ,tail (setf ,head ,x))
+	 (shiftf (,next ,x) ,head ,x))
+       ,x)))
+
+(defmacro threaded-dolist ((variable list next type) &body body)
+  `(block nil
+     (do* ((,variable ,list (,next (the ,type ,variable))))
+	  ((null ,variable))
+       (declare (type (or null ,type) ,variable))
+       ,@body)))
+
+(defmacro threaded-delete (item list next type)
+  (let ((x (gensym))
+	(y (gensym))
+	(z (gensym))
+	(first (gensym)))
+    `(let ((,x ,item)
+	   (,first ,list))
+       (declare (type ,type ,x)
+		(type (or null ,type) ,first)
+		(optimize (speed 3) (safety 0)))
+       (when ,first
+	 (if (eq ,first ,x)
+	     (setf ,first (setf ,list (,next ,x)))
+	   (do* ((,y ,first ,z)
+		 (,z (,next ,y) (,next ,y)))
+		((or (null ,z) (eq ,z ,x))
+		 (when (eq ,z ,x)
+		   (setf (,next ,y) (,next ,x))))
+	     (declare (type ,type ,y))
+	     (declare (type (or null ,type) ,z)))))
+       (setf (,next ,x) nil)
+       ,first)))
+
+(defmacro threaded-length (list next type)
+  (let ((x (gensym))
+	(count (gensym)))
+    `(do ((,x ,list (,next (the ,type ,x)))
+	  (,count 0 (index1+ ,count)))
+	 ((null ,x)
+	  ,count)
+       (declare (type (or null ,type) ,x)
+		(type array-index ,count)
+		(optimize (speed 3) (safety 0))))))
+
diff --git a/src/clx/manager.lsp b/src/clx/manager.lsp
new file mode 100644
index 000000000..a8e99e748
--- /dev/null
+++ b/src/clx/manager.lsp
@@ -0,0 +1,783 @@
+;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-
+
+;;; Window Manager Property functions
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+(defun wm-name (window)
+  (declare (type window window))
+  (declare (values string))
+  (get-property window :WM_NAME :type :STRING :result-type 'string :transform #'card8->char))
+
+(defsetf wm-name (window) (name)
+  `(set-string-property ,window :WM_NAME ,name))
+
+(defun set-string-property (window property string)
+  (declare (type window window)
+	   (type keyword property)
+	   (type stringable string))
+  (change-property window property (string string) :STRING 8 :transform #'char->card8)
+  string)
+
+(defun wm-icon-name (window)
+  (declare (type window window))
+  (declare (values string))
+  (get-property window :WM_ICON_NAME :type :STRING
+		:result-type 'string :transform #'card8->char))
+
+(defsetf wm-icon-name (window) (name)
+  `(set-string-property ,window :WM_ICON_NAME ,name))
+
+(defun wm-client-machine (window)
+  (declare (type window window))
+  (declare (values string))
+  (get-property window :WM_CLIENT_MACHINE :type :STRING
+		:result-type 'string :transform #'card8->char))
+
+(defsetf wm-client-machine (window) (name)
+  `(set-string-property ,window :WM_CLIENT_MACHINE ,name))
+
+(defun get-wm-class (window)
+  (declare (type window window))
+  (declare (values (or null name-string) (or null class-string)))
+  (let ((value (get-property window :WM_CLASS :type :STRING
+			     :result-type 'string :transform #'card8->char)))
+    (declare (type (or null string) value))
+    (when value
+      (let* ((name-len (position #.(card8->char 0) (the string value)))
+	     (name (subseq (the string value) 0 name-len))
+	     (class (subseq (the string value) (1+ name-len) (1- (length value)))))
+	(values (and (plusp (length name)) name)
+		(and (plusp (length class)) class))))))
+
+(defun set-wm-class (window resource-name resource-class)
+  (declare (type window window)
+	   (type (or null stringable) resource-name resource-class))
+  (set-string-property window :WM_CLASS
+		       (concatenate 'string
+				    (string (or resource-name ""))
+				    #.(make-string 1 :initial-element (card8->char 0))
+				    (string (or resource-class ""))
+				    #.(make-string 1 :initial-element (card8->char 0))))
+  (values))
+
+(defun wm-command (window)
+  ;; Returns a list whose car is the command and 
+  ;; whose cdr is the list of arguments
+  (declare (type window window))
+  (declare (values list))
+  (do* ((command-string (get-property window :WM_COMMAND :type :STRING
+				      :result-type 'string :transform #'card8->char))
+	(command nil)
+	(start 0 (1+ end))
+	(end 0)
+	(len (length command-string)))
+       ((>= start len) (nreverse command))
+    (setq end (position #.(card8->char 0) command-string :start start))
+    (push (subseq command-string start end) command)))
+
+(defsetf wm-command set-wm-command)
+(defun set-wm-command (window command)
+  ;; Uses PRIN1 inside the ANSI common lisp form WITH-STANDARD-IO-SYNTAX (or
+  ;; equivalent), with elements of command separated by NULL characters.  This
+  ;; enables 
+  ;;   (with-standard-io-syntax (mapcar #'read-from-string (wm-command window)))
+  ;; to recover a lisp command.
+  (declare (type window window)
+	   (type list command))
+  (set-string-property
+    window :WM_COMMAND
+    (with-output-to-string (stream)
+      (with-standard-io-syntax 
+	(dolist (c command)
+	  (prin1 c stream)
+	  (write-char #.(card8->char 0) stream)))))
+  command)
+
+;;-----------------------------------------------------------------------------
+;; WM_HINTS
+
+(def-clx-class (wm-hints)
+  (input nil :type (or null (member :off :on)))
+  (initial-state nil :type (or null (member :dont-care :normal :zoom :iconic :inactive)))
+  (icon-pixmap nil :type (or null pixmap))
+  (icon-window nil :type (or null window))
+  (icon-x nil :type (or null card16))
+  (icon-y nil :type (or null card16))
+  (icon-mask nil :type (or null pixmap))
+  (window-group nil :type (or null resource-id))
+  (flags 0 :type card32)    ;; Extension-hook.  Exclusive-Or'ed with the FLAGS field
+  ;; may be extended in the future
+  )
+
+(defun wm-hints (window)
+  (declare (type window window))
+  (declare (values wm-hints))
+  (let ((prop (get-property window :WM_HINTS :type :WM_HINTS :result-type 'vector)))
+    (when prop
+      (decode-wm-hints prop (window-display window)))))
+
+(defsetf wm-hints set-wm-hints)
+(defun set-wm-hints (window wm-hints)
+  (declare (type window window)
+	   (type wm-hints wm-hints))
+  (declare (values wm-hints))
+  (change-property window :WM_HINTS (encode-wm-hints wm-hints) :WM_HINTS 32)
+  wm-hints)
+
+(defun decode-wm-hints (vector display)
+  (declare (type (simple-vector 9) vector)
+	   (type display display))
+  (declare (values wm-hints))
+  (let ((input-hint 0)
+	(state-hint 1)
+	(icon-pixmap-hint 2)
+	(icon-window-hint 3)
+	(icon-position-hint 4)
+	(icon-mask-hint 5)
+	(window-group-hint 6))
+    (let ((flags (aref vector 0))
+	  (hints (make-wm-hints))
+	  (%buffer display))
+      (declare (type card32 flags)
+	       (type wm-hints hints)
+	       (type display %buffer))
+      (setf (wm-hints-flags hints) flags)
+      (when (logbitp input-hint flags)
+	(setf (wm-hints-input hints) (decode-type (member :off :on) (aref vector 1))))
+      (when (logbitp state-hint flags)
+	(setf (wm-hints-initial-state hints)
+	      (decode-type (member :dont-care :normal :zoom :iconic :inactive)
+			   (aref vector 2))))
+      (when (logbitp icon-pixmap-hint flags)
+	(setf (wm-hints-icon-pixmap hints) (decode-type pixmap (aref vector 3))))
+      (when (logbitp icon-window-hint flags)
+	(setf (wm-hints-icon-window hints) (decode-type window (aref vector 4))))
+      (when (logbitp icon-position-hint flags)
+	(setf (wm-hints-icon-x hints) (aref vector 5)
+	      (wm-hints-icon-y hints) (aref vector 6)))
+      (when (logbitp icon-mask-hint flags)
+	(setf (wm-hints-icon-mask hints) (decode-type pixmap (aref vector 7))))
+      (when (and (logbitp window-group-hint flags) (> (length vector) 7))
+	(setf (wm-hints-window-group hints) (aref vector 8)))
+      hints)))
+
+
+(defun encode-wm-hints (wm-hints)
+  (declare (type wm-hints wm-hints))
+  (declare (values simple-vector))
+  (let ((input-hint         #b1)
+	(state-hint         #b10)
+	(icon-pixmap-hint   #b100)
+	(icon-window-hint   #b1000)
+	(icon-position-hint #b10000)
+	(icon-mask-hint     #b100000)
+	(window-group-hint  #b1000000)
+	(mask               #b1111111)
+	)
+    (let ((vector (make-array 9 :initial-element 0))
+	  (flags 0))
+      (declare (type (simple-vector 9) vector)
+	       (type card16 flags))
+      (when (wm-hints-input wm-hints)
+	(setf flags input-hint
+	      (aref vector 1) (encode-type (member :off :on) (wm-hints-input wm-hints))))
+      (when (wm-hints-initial-state wm-hints)
+	(setf flags (logior flags state-hint)
+	      (aref vector 2) (encode-type (member :dont-care :normal :zoom :iconic :inactive)
+					   (wm-hints-initial-state wm-hints))))
+      (when (wm-hints-icon-pixmap wm-hints)
+	(setf flags (logior flags icon-pixmap-hint)
+	      (aref vector 3) (encode-type pixmap (wm-hints-icon-pixmap wm-hints))))
+      (when (wm-hints-icon-window wm-hints)
+	(setf flags (logior flags icon-window-hint)
+	      (aref vector 4) (encode-type window (wm-hints-icon-window wm-hints))))
+      (when (and (wm-hints-icon-x wm-hints) (wm-hints-icon-y wm-hints))
+	(setf flags (logior flags icon-position-hint)
+	      (aref vector 5) (encode-type card16 (wm-hints-icon-x wm-hints))
+	      (aref vector 6) (encode-type card16 (wm-hints-icon-y wm-hints))))
+      (when (wm-hints-icon-mask wm-hints)
+	(setf flags (logior flags icon-mask-hint)
+	      (aref vector 7) (encode-type pixmap (wm-hints-icon-mask wm-hints))))
+      (when (wm-hints-window-group wm-hints)
+	(setf flags (logior flags window-group-hint)
+	      (aref vector 8) (wm-hints-window-group wm-hints)))
+      (setf (aref vector 0) (logior flags (logandc2 (wm-hints-flags wm-hints) mask)))
+      vector)))
+
+;;-----------------------------------------------------------------------------
+;; WM_SIZE_HINTS
+
+(def-clx-class (wm-size-hints)
+  (user-specified-position-p nil :type boolean) ;; True when user specified x y
+  (user-specified-size-p nil :type boolean)     ;; True when user specified width height
+  (x nil :type (or null int16))			;; Obsolete
+  (y nil :type (or null int16))			;; Obsolete
+  (width nil :type (or null card16))		;; Obsolete
+  (height nil :type (or null card16))		;; Obsolete
+  (min-width nil :type (or null card16))
+  (min-height nil :type (or null card16))
+  (max-width nil :type (or null card16))
+  (max-height nil :type (or null card16))
+  (width-inc nil :type (or null card16))
+  (height-inc nil :type (or null card16))
+  (min-aspect nil :type (or null number))
+  (max-aspect nil :type (or null number))
+  (base-width nil :type (or null card16))
+  (base-height nil :type (or null card16))
+  (win-gravity nil :type (or null win-gravity))
+  (program-specified-position-p nil :type boolean) ;; True when program specified x y
+  (program-specified-size-p nil :type boolean)     ;; True when program specified width height
+  )
+
+
+(defun wm-normal-hints (window)
+  (declare (type window window))
+  (declare (values wm-size-hints))
+  (decode-wm-size-hints (get-property window :WM_NORMAL_HINTS :type :WM_SIZE_HINTS :result-type 'vector)))
+
+(defsetf wm-normal-hints set-wm-normal-hints)
+(defun set-wm-normal-hints (window hints)
+  (declare (type window window)
+	   (type wm-size-hints hints))
+  (declare (values wm-size-hints))
+  (change-property window :WM_NORMAL_HINTS (encode-wm-size-hints hints) :WM_SIZE_HINTS 32)
+  hints)
+
+;;; OBSOLETE
+(defun wm-zoom-hints (window)
+  (declare (type window window))
+  (declare (values wm-size-hints))
+  (decode-wm-size-hints (get-property window :WM_ZOOM_HINTS :type :WM_SIZE_HINTS :result-type 'vector)))
+
+;;; OBSOLETE
+(defsetf wm-zoom-hints set-wm-zoom-hints)
+;;; OBSOLETE
+(defun set-wm-zoom-hints (window hints)
+  (declare (type window window)
+	   (type wm-size-hints hints))
+  (declare (values wm-size-hints))
+  (change-property window :WM_ZOOM_HINTS (encode-wm-size-hints hints) :WM_SIZE_HINTS 32)
+  hints)
+
+(defun decode-wm-size-hints (vector)
+  (declare (type (or null (simple-vector *)) vector))
+  (declare (values (or null wm-size-hints)))
+  (when vector
+    (let ((flags (aref vector 0))
+	  (hints (make-wm-size-hints)))
+      (declare (type card16 flags)
+	       (type wm-size-hints hints))
+      (setf (wm-size-hints-user-specified-position-p hints) (logbitp 0 flags))
+      (setf (wm-size-hints-user-specified-size-p hints) (logbitp 1 flags))
+      (setf (wm-size-hints-program-specified-position-p hints) (logbitp 2 flags))
+      (setf (wm-size-hints-program-specified-size-p hints) (logbitp 3 flags))
+      (when (logbitp 4 flags)
+	(setf (wm-size-hints-min-width hints) (aref vector 5)
+	      (wm-size-hints-min-height hints) (aref vector 6)))
+      (when (logbitp 5 flags)
+	(setf (wm-size-hints-max-width hints) (aref vector 7)
+	      (wm-size-hints-max-height hints) (aref vector 8)))
+      (when (logbitp 6 flags)
+	(setf (wm-size-hints-width-inc hints) (aref vector 9)
+	      (wm-size-hints-height-inc hints) (aref vector 10)))
+      (when (logbitp 7 flags)
+	(setf (wm-size-hints-min-aspect hints) (/ (aref vector 11) (aref vector 12))
+	      (wm-size-hints-max-aspect hints) (/ (aref vector 13) (aref vector 14))))
+      (when (> (length vector) 15)
+	;; This test is for backwards compatibility since old Xlib programs
+	;; can set a size-hints structure that is too small.  See ICCCM.
+	(when (logbitp 8 flags)
+	  (setf (wm-size-hints-base-width hints) (aref vector 15)
+		(wm-size-hints-base-height hints) (aref vector 16)))
+	(when (logbitp 9 flags)
+	  (setf (wm-size-hints-win-gravity hints)
+		(decode-type (member-vector *win-gravity-vector*) (aref vector 17)))))
+      ;; Obsolete fields
+      (when (or (logbitp 0 flags) (logbitp 2 flags))
+	(setf (wm-size-hints-x hints) (aref vector 1)
+	      (wm-size-hints-y hints) (aref vector 2)))
+      (when (or (logbitp 1 flags) (logbitp 3 flags))
+	(setf (wm-size-hints-width hints) (aref vector 3)
+	      (wm-size-hints-height hints) (aref vector 4)))
+      hints)))
+
+(defun encode-wm-size-hints (hints)
+  (declare (type wm-size-hints hints))
+  (declare (values simple-vector))
+  (let ((vector (make-array 18 :initial-element 0))
+	(flags 0))
+    (declare (type (simple-vector 18) vector)
+	     (type card16 flags)) 
+    (when (wm-size-hints-user-specified-position-p hints)
+      (setf (ldb (byte 1 0) flags) 1))
+    (when (wm-size-hints-user-specified-size-p hints)
+      (setf (ldb (byte 1 1) flags) 1))
+    (when (wm-size-hints-program-specified-position-p hints)
+      (setf (ldb (byte 1 2) flags) 1))
+    (when (wm-size-hints-program-specified-size-p hints)
+      (setf (ldb (byte 1 3) flags) 1))
+    (when (and (wm-size-hints-min-width hints) (wm-size-hints-min-height hints))
+      (setf (ldb (byte 1 4) flags) 1
+	    (aref vector 5) (wm-size-hints-min-width hints)
+	    (aref vector 6) (wm-size-hints-min-height hints)))
+    (when (and (wm-size-hints-max-width hints) (wm-size-hints-max-height hints))
+      (setf (ldb (byte 1 5) flags) 1
+	    (aref vector 7) (wm-size-hints-max-width hints)
+	    (aref vector 8) (wm-size-hints-max-height hints)))
+    (when (and (wm-size-hints-width-inc hints) (wm-size-hints-height-inc hints))
+      (setf (ldb (byte 1 6) flags) 1
+	    (aref vector 9) (wm-size-hints-width-inc hints)
+	    (aref vector 10) (wm-size-hints-height-inc hints)))
+    (let ((min-aspect (wm-size-hints-min-aspect hints))
+	  (max-aspect (wm-size-hints-max-aspect hints)))
+      (when (and min-aspect max-aspect)
+	(setf (ldb (byte 1 7) flags) 1
+	      min-aspect (rationalize min-aspect)
+	      max-aspect (rationalize max-aspect)
+	      (aref vector 11) (numerator min-aspect)
+	      (aref vector 12) (denominator min-aspect)
+	      (aref vector 13) (numerator max-aspect)
+	      (aref vector 14) (denominator max-aspect))))
+    (when (and (wm-size-hints-base-width hints)
+	       (wm-size-hints-base-height hints))
+      (setf (ldb (byte 1 8) flags) 1
+	    (aref vector 15) (wm-size-hints-base-width hints)
+	    (aref vector 16) (wm-size-hints-base-height hints)))
+    (when (wm-size-hints-win-gravity hints)
+      (setf (ldb (byte 1 9) flags) 1
+	    (aref vector 17) (encode-type
+			       (member-vector *win-gravity-vector*)
+			       (wm-size-hints-win-gravity hints))))
+    ;; Obsolete fields
+    (when (and (wm-size-hints-x hints) (wm-size-hints-y hints)) 
+      (unless (wm-size-hints-user-specified-position-p hints)
+	(setf (ldb (byte 1 2) flags) 1))
+      (setf (aref vector 1) (wm-size-hints-x hints)
+	    (aref vector 2) (wm-size-hints-y hints)))
+    (when (and (wm-size-hints-width hints) (wm-size-hints-height hints))
+      (unless (wm-size-hints-user-specified-size-p hints)
+	(setf (ldb (byte 1 3) flags) 1))
+      (setf (aref vector 3) (wm-size-hints-width hints)
+	    (aref vector 4) (wm-size-hints-height hints)))
+    (setf (aref vector 0) flags)
+    vector))
+
+;;-----------------------------------------------------------------------------
+;; Icon_Size
+
+;; Use the same intermediate structure as WM_SIZE_HINTS
+
+(defun icon-sizes (window)
+  (declare (type window window))
+  (declare (values wm-size-hints))
+  (let ((vector (get-property window :WM_ICON_SIZE :type :WM_ICON_SIZE :result-type 'vector)))
+    (declare (type (or null (simple-vector 6)) vector))
+    (when vector
+      (make-wm-size-hints
+	:min-width (aref vector 0)
+	:min-height (aref vector 1)
+	:max-width (aref vector 2)
+	:max-height (aref vector 3)
+	:width-inc (aref vector 4)
+	:height-inc (aref vector 5)))))
+  
+(defsetf icon-sizes set-icon-sizes)
+(defun set-icon-sizes (window wm-size-hints)
+  (declare (type window window)
+	   (type wm-size-hints wm-size-hints))
+  (let ((vector (vector (wm-size-hints-min-width wm-size-hints)
+			(wm-size-hints-min-height wm-size-hints)
+			(wm-size-hints-max-width wm-size-hints)
+			(wm-size-hints-max-height wm-size-hints)
+			(wm-size-hints-width-inc wm-size-hints)
+			(wm-size-hints-height-inc wm-size-hints))))
+    (change-property window :WM_ICON_SIZE vector :WM_ICON_SIZE 32)
+    wm-size-hints))
+
+;;-----------------------------------------------------------------------------
+;; WM-Protocols
+
+(defun wm-protocols (window)
+  (map 'list #'(lambda (id) (atom-name (window-display window) id))
+       (get-property window :WM_PROTOCOLS :type :ATOM)))
+
+(defsetf wm-protocols set-wm-protocols)
+(defun set-wm-protocols (window protocols)
+  (change-property window :WM_PROTOCOLS
+		   (map 'list #'(lambda (atom) (intern-atom (window-display window) atom))
+			protocols)
+		   :ATOM 32)
+  protocols)
+
+;;-----------------------------------------------------------------------------
+;; WM-Colormap-windows
+
+(defun wm-colormap-windows (window)
+  (values (get-property window :WM_COLORMAP_WINDOWS :type :WINDOW
+			:transform #'(lambda (id)
+				       (lookup-window (window-display window) id)))))
+
+(defsetf wm-colormap-windows set-wm-colormap-windows)
+(defun set-wm-colormap-windows (window colormap-windows)
+  (change-property window :WM_COLORMAP_WINDOWS colormap-windows :WINDOW 32
+		   :transform #'window-id)
+  colormap-windows)
+
+;;-----------------------------------------------------------------------------
+;; Transient-For
+
+(defun transient-for (window)
+  (let ((prop (get-property window :WM_TRANSIENT_FOR :type :WINDOW :result-type 'list)))
+    (and prop (lookup-window (window-display window) (car prop)))))
+
+(defsetf transient-for set-transient-for)
+(defun set-transient-for (window transient)
+  (declare (type window window transient))
+  (change-property window :WM_TRANSIENT_FOR (list (window-id transient)) :WINDOW 32)
+  transient)
+
+;;-----------------------------------------------------------------------------
+;; Set-WM-Properties
+
+(defun set-wm-properties (window &rest options &key 
+			  name icon-name resource-name resource-class command
+			  client-machine hints normal-hints zoom-hints
+			  ;; the following are used for wm-normal-hints
+			  (user-specified-position-p nil usppp)
+			  (user-specified-size-p nil usspp)
+			  (program-specified-position-p nil psppp)
+			  (program-specified-size-p nil psspp)
+			  x y width height min-width min-height max-width max-height
+			  width-inc height-inc min-aspect max-aspect
+			  base-width base-height win-gravity
+			  ;; the following are used for wm-hints
+			  input initial-state icon-pixmap icon-window
+			  icon-x icon-y icon-mask window-group)
+  ;; Set properties for WINDOW.
+  (declare (arglist window &rest options &key 
+		   name icon-name resource-name resource-class command
+		   client-machine hints normal-hints
+		   ;; the following are used for wm-normal-hints
+		   user-specified-position-p user-specified-size-p
+		   program-specified-position-p program-specified-size-p
+		   min-width min-height max-width max-height
+		   width-inc height-inc min-aspect max-aspect
+		   base-width base-height win-gravity
+		   ;; the following are used for wm-hints
+		   input initial-state icon-pixmap icon-window
+		   icon-x icon-y icon-mask window-group))
+  (declare (type window window)
+	   (type (or null stringable) name icon-name resource-name resource-class client-machine)
+	   (type (or null list) command)
+	   (type (or null wm-hints) hints)
+	   (type (or null wm-size-hints) normal-hints zoom-hints)
+	   (type boolean user-specified-position-p user-specified-size-p)
+	   (type boolean program-specified-position-p program-specified-size-p)
+	   (type (or null int16) x y)
+	   (type (or null card16) width height min-width min-height max-width max-height width-inc height-inc base-width base-height)
+	   (type (or null win-gravity) win-gravity)
+	   (type (or null number) min-aspect max-aspect)
+	   (type (or null (member :off :on)) input)
+	   (type (or null (member :dont-care :normal :zoom :iconic :inactive)) initial-state)
+	   (type (or null pixmap) icon-pixmap icon-mask)
+	   (type (or null window) icon-window)
+	   (type (or null card16) icon-x icon-y)
+	   (type (or null resource-id) window-group)
+	   (dynamic-extent options))
+  (when name (setf (wm-name window) name))
+  (when icon-name (setf (wm-icon-name window) icon-name))
+  (when client-machine (setf (wm-client-machine window) client-machine))
+  (when (or resource-name resource-class)
+    (set-wm-class window resource-name resource-class))
+  (when command (setf (wm-command window) command))
+  ;; WM-HINTS
+  (if (dolist (arg '(:input :initial-state :icon-pixmap :icon-window
+			    :icon-x :icon-y :icon-mask :window-group))
+	(when (getf options arg) (return t)))
+      (let ((wm-hints (if hints (copy-wm-hints hints) (make-wm-hints))))
+	(when input (setf (wm-hints-input wm-hints) input))
+	(when initial-state (setf (wm-hints-initial-state wm-hints) initial-state))
+	(when icon-pixmap (setf (wm-hints-icon-pixmap wm-hints) icon-pixmap))
+	(when icon-window (setf (wm-hints-icon-window wm-hints) icon-window))
+	(when icon-x (setf (wm-hints-icon-x wm-hints) icon-x))
+	(when icon-y (setf (wm-hints-icon-y wm-hints) icon-y))
+	(when icon-mask (setf (wm-hints-icon-mask wm-hints) icon-mask))
+	(when window-group (setf (wm-hints-input wm-hints) window-group))
+	(setf (wm-hints window) wm-hints))
+      (when hints (setf (wm-hints window) hints)))
+  ;; WM-NORMAL-HINTS
+  (if (dolist (arg '(:x :y :width :height :min-width :min-height :max-width :max-height
+			:width-inc :height-inc :min-aspect :max-aspect
+			:user-specified-position-p :user-specified-size-p
+			:program-specified-position-p :program-specified-size-p
+			:base-width :base-height :win-gravity))
+	(when (getf options arg) (return t)))
+      (let ((size (if normal-hints (copy-wm-size-hints normal-hints) (make-wm-size-hints))))
+	(when x (setf (wm-size-hints-x size) x))
+	(when y (setf (wm-size-hints-y size) y))
+	(when width (setf (wm-size-hints-width size) width))
+	(when height (setf (wm-size-hints-height size) height))
+	(when min-width (setf (wm-size-hints-min-width size) min-width))
+	(when min-height (setf (wm-size-hints-min-height size) min-height))
+	(when max-width (setf (wm-size-hints-max-width size) max-width))
+	(when max-height (setf (wm-size-hints-max-height size) max-height))
+	(when width-inc (setf (wm-size-hints-width-inc size) width-inc))
+	(when height-inc (setf (wm-size-hints-height-inc size) height-inc))
+	(when min-aspect (setf (wm-size-hints-min-aspect size) min-aspect))
+	(when max-aspect (setf (wm-size-hints-max-aspect size) max-aspect))
+	(when base-width (setf (wm-size-hints-base-width size) base-width))
+	(when base-height (setf (wm-size-hints-base-height size) base-height))
+	(when win-gravity (setf (wm-size-hints-win-gravity size) win-gravity))
+	(when usppp
+	  (setf (wm-size-hints-user-specified-position-p size) user-specified-position-p))
+	(when usspp
+	  (setf (wm-size-hints-user-specified-size-p size) user-specified-size-p))
+	(when psppp
+	  (setf (wm-size-hints-program-specified-position-p size) program-specified-position-p))
+	(when psspp
+	  (setf (wm-size-hints-program-specified-size-p size) program-specified-size-p))
+	(setf (wm-normal-hints window) size))
+      (when normal-hints (setf (wm-normal-hints window) normal-hints)))
+  (when zoom-hints (setf (wm-zoom-hints window) zoom-hints))
+  )
+
+;;; OBSOLETE
+(defun set-standard-properties (window &rest options)
+  (declare (dynamic-extent options))
+  (apply #'set-wm-properties window options))
+
+;;-----------------------------------------------------------------------------
+;; WM Control
+
+(defun iconify-window (window screen)
+  (declare (type window window)
+	   (type screen screen))
+  (let ((root (screen-root screen)))
+    (declare (type window root))
+    (send-event root :client-message '(:substructure-redirect :substructure-notify)
+		:window window :format 32 :type :WM_CHANGE_STATE :data (list 3))))
+
+(defun withdraw-window (window screen)
+  (declare (type window window)
+	   (type screen screen))
+  (unmap-window window)
+  (let ((root (screen-root screen)))
+    (declare (type window root))
+    (send-event root :unmap-notify '(:substructure-redirect :substructure-notify)
+		:window window :event-window root :configure-p nil)))
+
+
+;;-----------------------------------------------------------------------------
+;; Colormaps
+
+(def-clx-class (standard-colormap (:copier nil) (:predicate nil))
+  (colormap nil :type (or null colormap))
+  (base-pixel 0 :type pixel)
+  (max-color nil :type (or null color))
+  (mult-color nil :type (or null color))
+  (visual nil :type (or null visual-info))
+  (kill nil :type (or (member nil :release-by-freeing-colormap)
+		      drawable gcontext cursor colormap font)))
+
+(defun rgb-colormaps (window property)
+  (declare (type window window)
+	   (type (member :RGB_DEFAULT_MAP :RGB_BEST_MAP :RGB_RED_MAP
+			 :RGB_GREEN_MAP :RGB_BLUE_MAP) property))
+  (let ((prop (get-property window property :type :RGB_COLOR_MAP :result-type 'vector)))
+    (declare (type (or null simple-vector) prop))
+    (when prop
+      (list (make-standard-colormap
+	      :colormap (lookup-colormap (window-display window) (aref prop 0))
+	      :base-pixel (aref prop 7)
+	      :max-color (make-color :red   (card16->rgb-val (aref prop 1))
+				     :green (card16->rgb-val (aref prop 3))
+				     :blue  (card16->rgb-val (aref prop 5)))
+	      :mult-color (make-color :red   (card16->rgb-val (aref prop 2))
+				      :green (card16->rgb-val (aref prop 4))
+				      :blue  (card16->rgb-val (aref prop 6)))
+	      :visual (and (<= 9 (length prop))
+			   (visual-info (window-display window) (aref prop 8)))
+	      :kill (and (<= 10 (length prop))
+			 (let ((killid (aref prop 9)))
+			   (if (= killid 1)
+			       :release-by-freeing-colormap
+			       (lookup-resource-id (window-display window) killid)))))))))
+
+(defsetf rgb-colormaps set-rgb-colormaps)
+(defun set-rgb-colormaps (window property maps)
+  (declare (type window window)
+	   (type (member :RGB_DEFAULT_MAP :RGB_BEST_MAP :RGB_RED_MAP
+			 :RGB_GREEN_MAP :RGB_BLUE_MAP) property)
+	   (type list maps))
+  (let ((prop (make-array (* 10 (length maps)) :element-type 'card32))
+	(index -1))
+    (dolist (map maps)
+      (setf (aref prop (incf index))
+	    (encode-type colormap (standard-colormap-colormap map)))
+      (setf (aref prop (incf index))
+	    (encode-type rgb-val (color-red (standard-colormap-max-color map))))
+      (setf (aref prop (incf index))
+	    (encode-type rgb-val (color-red (standard-colormap-mult-color map))))
+      (setf (aref prop (incf index))
+	    (encode-type rgb-val (color-green (standard-colormap-max-color map))))
+      (setf (aref prop (incf index))
+	    (encode-type rgb-val (color-green (standard-colormap-mult-color map))))
+      (setf (aref prop (incf index))
+	    (encode-type rgb-val (color-blue (standard-colormap-max-color map))))
+      (setf (aref prop (incf index))
+	    (encode-type rgb-val (color-blue (standard-colormap-mult-color map))))
+      (setf (aref prop (incf index))
+	    (standard-colormap-base-pixel map))
+      (setf (aref prop (incf index))
+	    (visual-info-id (standard-colormap-visual map)))
+      (setf (aref prop (incf index))
+	    (let ((kill (standard-colormap-kill map)))
+	      (etypecase kill
+		(symbol
+		  (ecase kill
+		    ((nil) 0)
+		    ((:release-by-freeing-colormap) 1)))
+		(drawable (drawable-id kill))
+		(gcontext (gcontext-id kill))
+		(cursor (cursor-id kill))
+		(colormap (colormap-id kill))
+		(font (font-id kill))))))
+    (change-property window property prop :RGB_COLOR_MAP 32)))
+
+;;; OBSOLETE
+(defun get-standard-colormap (window property)
+  (declare (type window window)
+	   (type (member :RGB_DEFAULT_MAP :RGB_BEST_MAP :RGB_RED_MAP
+			 :RGB_GREEN_MAP :RGB_BLUE_MAP) property))
+  (declare (values colormap base-pixel max-color mult-color))
+  (let ((prop (get-property window property :type :RGB_COLOR_MAP :result-type 'vector)))
+    (declare (type (or null simple-vector) prop))
+    (when prop
+      (values (lookup-colormap (window-display window) (aref prop 0))
+	      (aref prop 7)			;Base Pixel
+	      (make-color :red   (card16->rgb-val (aref prop 1))	;Max Color
+			  :green (card16->rgb-val (aref prop 3))
+			  :blue  (card16->rgb-val (aref prop 5)))
+	      (make-color :red   (card16->rgb-val (aref prop 2))	;Mult color
+			  :green (card16->rgb-val (aref prop 4))
+			  :blue  (card16->rgb-val (aref prop 6)))))))
+
+;;; OBSOLETE
+(defun set-standard-colormap (window property colormap base-pixel max-color mult-color)
+  (declare (type window window)
+	   (type (member :RGB_DEFAULT_MAP :RGB_BEST_MAP :RGB_RED_MAP
+			 :RGB_GREEN_MAP :RGB_BLUE_MAP) property)
+	   (type colormap colormap)
+	   (type pixel base-pixel)
+	   (type color max-color mult-color))
+  (let ((prop (apply #'vector (encode-type colormap colormap)
+		     (encode-type rgb-val (color-red max-color))
+		     (encode-type rgb-val (color-red mult-color))
+		     (encode-type rgb-val (color-green max-color))
+		     (encode-type rgb-val (color-green mult-color))
+		     (encode-type rgb-val (color-blue max-color))
+		     (encode-type rgb-val (color-blue mult-color))
+		     base-pixel)))
+    (change-property window property prop :RGB_COLOR_MAP 32)))
+
+;;-----------------------------------------------------------------------------
+;; Cut-Buffers
+
+(defun cut-buffer (display &key (buffer 0) (type :STRING) (result-type 'string)
+		   (transform #'card8->char) (start 0) end)
+  ;; Return the contents of cut-buffer BUFFER
+  (declare (type display display)
+	   (type (integer 0 7) buffer)
+	   (type xatom type)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type t result-type)			;a sequence type
+	   (type (or null (function (integer) t)) transform))
+  (declare (values sequence type format bytes-after))
+  (let* ((root (screen-root (first (display-roots display))))
+	 (property (aref '#(:CUT_BUFFER0 :CUT_BUFFER1 :CUT_BUFFER2 :CUT_BUFFER3
+			    :CUT_BUFFER4 :CUT_BUFFER5 :CUT_BUFFER6 :CUT_BUFFER7)
+			 buffer)))
+    (get-property root property :type type :result-type result-type
+		  :start start :end end :transform transform)))
+
+;; Implement the following:
+;; (defsetf cut-buffer (display &key (buffer 0) (type :string) (format 8)
+;;			        (transform #'char->card8) (start 0) end) (data)
+;; In order to avoid having to pass positional parameters to set-cut-buffer,
+;; We've got to do the following.  WHAT A PAIN...
+#-clx-ansi-common-lisp
+(define-setf-method cut-buffer (display &rest option-list)
+  (declare (dynamic-extent option-list))
+  (do* ((options (copy-list option-list))
+	(option options (cddr option))
+	(store (gensym))
+	(dtemp (gensym))
+	(temps (list dtemp))
+	(values (list display)))
+       ((endp option)
+	(values (nreverse temps)
+		(nreverse values)
+		(list store)
+		`(set-cut-buffer ,store ,dtemp ,@options)
+		`(cut-buffer ,@options)))
+    (unless (member (car option) '(:buffer :type :format :start :end :transform))
+      (error "Keyword arg ~s isn't recognized" (car option)))
+    (let ((x (gensym)))
+      (push x temps)
+      (push (cadr option) values)
+      (setf (cadr option) x))))
+
+(defun
+  #+clx-ansi-common-lisp (setf cut-buffer)
+  #-clx-ansi-common-lisp set-cut-buffer
+  (data display &key (buffer 0) (type :STRING) (format 8)
+	(start 0) end (transform #'char->card8))
+  (declare (type sequence data)
+	   (type display display)
+	   (type (integer 0 7) buffer)
+	   (type xatom type)
+	   (type (member 8 16 32) format)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type (or null (function (integer) t)) transform))
+  (let* ((root (screen-root (first (display-roots display))))
+	 (property (aref '#(:CUT_BUFFER0 :CUT_BUFFER1 :CUT_BUFFER2 :CUT_BUFFER3
+					 :CUT_BUFFER4 :CUT_BUFFER5 :CUT_BUFFER6 :CUT_BUFFER7)
+			 buffer)))
+    (change-property root property data type format :transform transform :start start :end end)
+    data))
+
+(defun rotate-cut-buffers (display &optional (delta 1) (careful-p t))
+  ;; Positive rotates left, negative rotates right (opposite of actual protocol request).
+  ;; When careful-p, ensure all cut-buffer properties are defined, to prevent errors.
+  (declare (type display display)
+	   (type int16 delta)
+	   (type boolean careful-p))
+  (let* ((root (screen-root (first (display-roots display))))
+	 (buffers '#(:cut_buffer0 :cut_buffer1 :cut_buffer2 :cut_buffer3
+		     :cut_buffer4 :cut_buffer5 :cut_buffer6 :cut_buffer7)))
+    (when careful-p
+      (let ((props (list-properties root)))
+	(dotimes (i 8)
+	  (unless (member (aref buffers i) props)
+	    (setf (cut-buffer display :buffer i) "")))))
+    (rotate-properties root buffers delta)))
+
diff --git a/src/clx/package.lsp b/src/clx/package.lsp
new file mode 100644
index 000000000..65fb02c2e
--- /dev/null
+++ b/src/clx/package.lsp
@@ -0,0 +1,398 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Base: 10; Lowercase: Yes;  -*-
+;;; Copyright (c) 1990  X Consortium
+;;; 
+;;; Permission is hereby granted, free of charge, to any person obtaining
+;;; a copy of this software and associated documentation files (the
+;;; "Software"), to deal in the Software without restriction, including
+;;; without limitation the rights to use, copy, modify, merge, publish,
+;;; distribute, sublicense, and/or sell copies of the Software, and to
+;;; permit persons to whom the Software is furnished to do so, subject to
+;;; the following conditions:
+;;; 
+;;; The above copyright notice and this permission notice shall be included
+;;; in all copies or substantial portions of the Software.
+;;; 
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;;; IN NO EVENT SHALL THE X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR
+;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+;;; OTHER DEALINGS IN THE SOFTWARE.
+;;; 
+;;; Except as contained in this notice, the name of the X Consortium shall
+;;; not be used in advertising or otherwise to promote the sale, use or
+;;; other dealings in this Software without prior written authorization
+;;; from the X Consortium.
+
+;;; The CLtL way
+
+#-clx-ansi-common-lisp 
+(lisp:in-package :xlib :use '(:lisp))
+
+#+(and (or kcl ibcl) (not clx-ansi-common-lisp))
+(shadow 
+  '(
+    rational
+    ))
+
+#+(and lispm (not clx-ansi-common-lisp))
+(import
+  '(
+    sys:arglist
+    sys:with-stack-list
+    sys:with-stack-list*
+    ))
+
+#+(and Genera (not clx-ansi-common-lisp))
+(import
+  '(
+    future-common-lisp:print-unreadable-object
+    future-common-lisp:with-standard-io-syntax
+    sys:array-register
+    zwei:indentation
+    ))
+
+#+(and lcl3.0 (not clx-ansi-common-lisp))
+(import
+  '(
+    lcl:arglist
+    lcl:dynamic-extent
+    lcl:type-error
+    lucid::type-error-datum
+    lucid::type-error-expected-type
+    ))
+
+#+(and excl (not clx-ansi-common-lisp)) 
+(import
+  '(
+    excl::arglist
+    excl::dynamic-extent
+    excl::type-error
+    excl::type-error-datum
+    excl::type-error-expected-type
+    ))
+
+#+(and allegro (not clx-ansi-common-lisp))
+(import
+  '(
+    excl::without-interrupts
+    ))
+
+#-clx-ansi-common-lisp
+(export
+  '(
+    *version* access-control access-error access-hosts
+    activate-screen-saver add-access-host add-resource add-to-save-set
+    alist alloc-color alloc-color-cells alloc-color-planes alloc-error
+    allow-events angle arc-seq array-index atom-error atom-name
+    bell bit-gravity bitmap bitmap-format bitmap-format-lsb-first-p
+    bitmap-format-p bitmap-format-pad bitmap-format-unit bitmap-image
+    boole-constant boolean card16 card29 card32 card8
+    card8->char change-active-pointer-grab change-keyboard-control
+    change-keyboard-mapping change-pointer-control change-property
+    char->card8 char-ascent char-attributes char-descent
+    char-left-bearing char-right-bearing char-width character->keysyms
+    character-in-map-p circulate-window-down circulate-window-up clear-area
+    close-display close-down-mode close-font closed-display color
+    color-blue color-green color-p color-red color-rgb colormap
+    colormap-display colormap-equal colormap-error colormap-id colormap-p
+    colormap-plist colormap-visual-info connection-failure convert-selection
+    copy-area copy-colormap-and-free copy-gcontext copy-gcontext-components
+    copy-image copy-plane create-colormap create-cursor
+    create-gcontext create-glyph-cursor create-image create-pixmap
+    create-window cursor cursor-display cursor-equal cursor-error
+    cursor-id cursor-p cursor-plist cut-buffer declare-event decode-core-error
+    default-error-handler default-keysym-index default-keysym-translate
+    define-error define-extension define-gcontext-accessor
+    define-keysym define-keysym-set delete-property delete-resource
+    destroy-subwindows destroy-window device-busy device-event-mask
+    device-event-mask-class discard-current-event discard-font-info display
+    display-after-function display-authorization-data display-authorization-name
+    display-bitmap-format display-byte-order display-default-screen
+    display-display display-error-handler display-finish-output
+    display-force-output display-host display-image-lsb-first-p
+    display-invoke-after-function display-keycode-range display-max-keycode
+    display-max-request-length display-min-keycode display-motion-buffer-size
+    display-nscreens display-p display-pixmap-formats display-plist
+    display-protocol-major-version display-protocol-minor-version
+    display-protocol-version display-release-number
+    display-report-asynchronous-errors display-resource-id-base
+    display-resource-id-mask display-roots display-vendor
+    display-vendor-name display-xdefaults display-xid draw-arc
+    draw-arcs draw-direction draw-glyph draw-glyphs draw-image-glyph
+    draw-image-glyphs draw-line draw-lines draw-point draw-points
+    draw-rectangle draw-rectangles draw-segments drawable
+    drawable-border-width drawable-depth drawable-display drawable-equal
+    drawable-error drawable-height drawable-id drawable-p
+    drawable-plist drawable-root drawable-width drawable-x drawable-y
+    error-key event-case event-cond event-handler event-key
+    event-listen event-mask event-mask-class extension-opcode
+    find-atom font font-all-chars-exist-p font-ascent
+    font-default-char font-descent font-direction font-display
+    font-equal font-error font-id font-max-byte1 font-max-byte2
+    font-max-char font-min-byte1 font-min-byte2 font-min-char
+    font-name font-p font-path font-plist font-properties
+    font-property fontable force-gcontext-changes free-colormap
+    free-colors free-cursor free-gcontext free-pixmap gcontext
+    gcontext-arc-mode gcontext-background 
+    gcontext-cache-p gcontext-cap-style
+    gcontext-clip-mask gcontext-clip-ordering gcontext-clip-x
+    gcontext-clip-y gcontext-dash-offset gcontext-dashes gcontext-display
+    gcontext-equal gcontext-error gcontext-exposures gcontext-fill-rule
+    gcontext-fill-style gcontext-font gcontext-foreground gcontext-function
+    gcontext-id gcontext-join-style gcontext-key gcontext-line-style
+    gcontext-line-width gcontext-p gcontext-plane-mask gcontext-plist
+    gcontext-stipple gcontext-subwindow-mode gcontext-tile gcontext-ts-x
+    gcontext-ts-y get-external-event-code get-image get-property
+    get-raw-image get-resource get-search-resource get-search-table
+    get-standard-colormap get-wm-class global-pointer-position grab-button
+    grab-key grab-keyboard grab-pointer grab-server grab-status
+    icon-sizes iconify-window id-choice-error illegal-request-error
+    image image-blue-mask image-depth image-green-mask image-height
+    image-name image-pixmap image-plist image-red-mask image-width
+    image-x image-x-hot image-x-p image-xy image-xy-bitmap-list
+    image-xy-p image-y-hot image-z image-z-bits-per-pixel image-z-p
+    image-z-pixarray implementation-error input-focus install-colormap
+    installed-colormaps int16 int32 int8 intern-atom invalid-font
+    keyboard-control keyboard-mapping keycode->character keycode->keysym
+    keysym keysym->character keysym->keycodes keysym-in-map-p
+    keysym-set kill-client kill-temporary-clients length-error
+    list-extensions list-font-names list-fonts list-properties
+    lookup-color lookup-error make-color make-event-handlers
+    make-event-keys make-event-mask make-resource-database make-state-keys
+    make-state-mask make-wm-hints make-wm-size-hints map-resource
+    map-subwindows map-window mapping-notify mask16 mask32
+    match-error max-char-ascent max-char-attributes max-char-descent
+    max-char-left-bearing max-char-right-bearing max-char-width
+    merge-resources min-char-ascent min-char-attributes min-char-descent
+    min-char-left-bearing min-char-right-bearing min-char-width
+    missing-parameter modifier-key modifier-mapping modifier-mask
+    motion-events name-error no-operation open-display open-font
+    pixarray pixel pixmap pixmap-display pixmap-equal
+    pixmap-error pixmap-format pixmap-format-bits-per-pixel
+    pixmap-format-depth pixmap-format-p pixmap-format-scanline-pad
+    pixmap-id pixmap-p pixmap-plist point-seq pointer-control
+    pointer-event-mask pointer-event-mask-class pointer-mapping
+    pointer-position process-event put-image put-raw-image
+    query-best-cursor query-best-stipple query-best-tile query-colors
+    query-extension query-keymap query-pointer query-tree queue-event
+    read-bitmap-file read-resources recolor-cursor rect-seq
+    remove-access-host remove-from-save-set reparent-window repeat-seq
+    reply-length-error reply-timeout request-error reset-screen-saver
+    resource-database resource-database-timestamp resource-error
+    resource-id resource-key rgb-colormaps rgb-val root-resources
+    rotate-cut-buffers rotate-properties screen screen-backing-stores
+    screen-black-pixel screen-default-colormap screen-depths
+    screen-event-mask-at-open screen-height screen-height-in-millimeters
+    screen-max-installed-maps screen-min-installed-maps screen-p
+    screen-plist screen-root screen-root-depth screen-root-visual
+    screen-root-visual-info screen-save-unders-p screen-saver
+    screen-white-pixel screen-width screen-width-in-millimeters seg-seq
+    selection-owner send-event sequence-error set-access-control
+    set-close-down-mode set-input-focus set-modifier-mapping
+    set-pointer-mapping set-screen-saver set-selection-owner
+    set-standard-colormap set-standard-properties set-wm-class
+    set-wm-properties set-wm-resources state-keysym-p state-mask-key
+    store-color store-colors stringable text-extents text-width
+    timestamp transient-for translate-coordinates translate-default
+    translation-function type-error undefine-keysym unexpected-reply
+    ungrab-button ungrab-key ungrab-keyboard ungrab-pointer
+    ungrab-server uninstall-colormap unknown-error unmap-subwindows
+    unmap-window value-error visual-info visual-info-bits-per-rgb
+    visual-info-blue-mask visual-info-class visual-info-colormap-entries
+    visual-info-display visual-info-green-mask visual-info-id visual-info-p
+    visual-info-plist visual-info-red-mask warp-pointer
+    warp-pointer-if-inside warp-pointer-relative warp-pointer-relative-if-inside
+    win-gravity window window-all-event-masks window-background
+    window-backing-pixel window-backing-planes window-backing-store
+    window-bit-gravity window-border window-class window-colormap
+    window-colormap-installed-p window-cursor window-display
+    window-do-not-propagate-mask window-equal window-error
+    window-event-mask window-gravity window-id window-map-state
+    window-override-redirect window-p window-plist window-priority
+    window-save-under window-visual window-visual-info with-display
+    with-event-queue with-gcontext with-server-grabbed with-state
+    withdraw-window wm-client-machine wm-colormap-windows wm-command
+    wm-hints wm-hints-flags wm-hints-icon-mask wm-hints-icon-pixmap
+    wm-hints-icon-window wm-hints-icon-x wm-hints-icon-y
+    wm-hints-initial-state wm-hints-input wm-hints-p wm-hints-window-group
+    wm-icon-name wm-name wm-normal-hints wm-protocols wm-resources
+    wm-size-hints wm-size-hints-base-height wm-size-hints-base-width
+    wm-size-hints-height wm-size-hints-height-inc wm-size-hints-max-aspect
+    wm-size-hints-max-height wm-size-hints-max-width wm-size-hints-min-aspect
+    wm-size-hints-min-height wm-size-hints-min-width wm-size-hints-p
+    wm-size-hints-user-specified-position-p wm-size-hints-user-specified-size-p
+    wm-size-hints-width wm-size-hints-width-inc wm-size-hints-win-gravity
+    wm-size-hints-x wm-size-hints-y wm-zoom-hints write-bitmap-file
+    write-resources xatom
+    ))
+
+
+;;; The ANSI Common Lisp way
+
+#+(and Genera clx-ansi-common-lisp)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* si:*ansi-common-lisp-readtable*))
+
+#+clx-ansi-common-lisp
+(common-lisp:in-package :common-lisp-user)
+
+#+clx-ansi-common-lisp
+(defpackage xlib
+  (:use common-lisp)
+  (:size 3000)
+  #+(or kcl ibcl) (:shadow rational)
+  #+allegro (:use cltl1)
+  #+allegro (:import-from excl without-interrupts)
+  #+excl (:import-from excl arglist)
+  #+Genera (:import-from sys array-register)
+  #+Genera (:import-from zwei indentation)
+  #+lcl3.0 (:import-from lcl arglist)
+  #+lispm (:import-from lisp char-bit)
+  #+lispm (:import-from sys arglist with-stack-list with-stack-list*)
+  (:export
+    *version* access-control access-error access-hosts
+    activate-screen-saver add-access-host add-resource add-to-save-set
+    alist alloc-color alloc-color-cells alloc-color-planes alloc-error
+    allow-events angle arc-seq array-index atom-error atom-name
+    bell bit-gravity bitmap bitmap-format bitmap-format-lsb-first-p
+    bitmap-format-p bitmap-format-pad bitmap-format-unit bitmap-image
+    boole-constant boolean card16 card29 card32 card8
+    card8->char change-active-pointer-grab change-keyboard-control
+    change-keyboard-mapping change-pointer-control change-property
+    char->card8 char-ascent char-attributes char-descent
+    char-left-bearing char-right-bearing char-width character->keysyms
+    character-in-map-p circulate-window-down circulate-window-up clear-area
+    close-display close-down-mode close-font closed-display color
+    color-blue color-green color-p color-red color-rgb colormap
+    colormap-display colormap-equal colormap-error colormap-id colormap-p
+    colormap-plist colormap-visual-info connection-failure convert-selection
+    copy-area copy-colormap-and-free copy-gcontext copy-gcontext-components
+    copy-image copy-plane create-colormap create-cursor
+    create-gcontext create-glyph-cursor create-image create-pixmap
+    create-window cursor cursor-display cursor-equal cursor-error
+    cursor-id cursor-p cursor-plist cut-buffer declare-event decode-core-error
+    default-error-handler default-keysym-index default-keysym-translate
+    define-error define-extension define-gcontext-accessor
+    define-keysym define-keysym-set delete-property delete-resource
+    destroy-subwindows destroy-window device-busy device-event-mask
+    device-event-mask-class discard-current-event discard-font-info display
+    display-after-function display-authorization-data display-authorization-name
+    display-bitmap-format display-byte-order display-default-screen
+    display-display display-error-handler display-finish-output
+    display-force-output display-host display-image-lsb-first-p
+    display-invoke-after-function display-keycode-range display-max-keycode
+    display-max-request-length display-min-keycode display-motion-buffer-size
+    display-nscreens display-p display-pixmap-formats display-plist
+    display-protocol-major-version display-protocol-minor-version
+    display-protocol-version display-release-number
+    display-report-asynchronous-errors display-resource-id-base
+    display-resource-id-mask display-roots display-vendor
+    display-vendor-name display-xdefaults display-xid draw-arc
+    draw-arcs draw-direction draw-glyph draw-glyphs draw-image-glyph
+    draw-image-glyphs draw-line draw-lines draw-point draw-points
+    draw-rectangle draw-rectangles draw-segments drawable
+    drawable-border-width drawable-depth drawable-display drawable-equal
+    drawable-error drawable-height drawable-id drawable-p
+    drawable-plist drawable-root drawable-width drawable-x drawable-y
+    error-key event-case event-cond event-handler event-key
+    event-listen event-mask event-mask-class extension-opcode
+    find-atom font font-all-chars-exist-p font-ascent
+    font-default-char font-descent font-direction font-display
+    font-equal font-error font-id font-max-byte1 font-max-byte2
+    font-max-char font-min-byte1 font-min-byte2 font-min-char
+    font-name font-p font-path font-plist font-properties
+    font-property fontable force-gcontext-changes free-colormap
+    free-colors free-cursor free-gcontext free-pixmap gcontext
+    gcontext-arc-mode gcontext-background
+    gcontext-cache-p gcontext-cap-style
+    gcontext-clip-mask gcontext-clip-ordering gcontext-clip-x
+    gcontext-clip-y gcontext-dash-offset gcontext-dashes gcontext-display
+    gcontext-equal gcontext-error gcontext-exposures gcontext-fill-rule
+    gcontext-fill-style gcontext-font gcontext-foreground gcontext-function
+    gcontext-id gcontext-join-style gcontext-key gcontext-line-style
+    gcontext-line-width gcontext-p gcontext-plane-mask gcontext-plist
+    gcontext-stipple gcontext-subwindow-mode gcontext-tile gcontext-ts-x
+    gcontext-ts-y get-external-event-code get-image get-property
+    get-raw-image get-resource get-search-resource get-search-table
+    get-standard-colormap get-wm-class global-pointer-position grab-button
+    grab-key grab-keyboard grab-pointer grab-server grab-status
+    icon-sizes iconify-window id-choice-error illegal-request-error
+    image image-blue-mask image-depth image-green-mask image-height
+    image-name image-pixmap image-plist image-red-mask image-width
+    image-x image-x-hot image-x-p image-xy image-xy-bitmap-list
+    image-xy-p image-y-hot image-z image-z-bits-per-pixel image-z-p
+    image-z-pixarray implementation-error input-focus install-colormap
+    installed-colormaps int16 int32 int8 intern-atom invalid-font
+    keyboard-control keyboard-mapping keycode->character keycode->keysym
+    keysym keysym->character keysym->keycodes keysym-in-map-p
+    keysym-set kill-client kill-temporary-clients length-error
+    list-extensions list-font-names list-fonts list-properties
+    lookup-color lookup-error make-color make-event-handlers
+    make-event-keys make-event-mask make-resource-database make-state-keys
+    make-state-mask make-wm-hints make-wm-size-hints map-resource
+    map-subwindows map-window mapping-notify mask16 mask32
+    match-error max-char-ascent max-char-attributes max-char-descent
+    max-char-left-bearing max-char-right-bearing max-char-width
+    merge-resources min-char-ascent min-char-attributes min-char-descent
+    min-char-left-bearing min-char-right-bearing min-char-width
+    missing-parameter modifier-key modifier-mapping modifier-mask
+    motion-events name-error no-operation open-display open-font
+    pixarray pixel pixmap pixmap-display pixmap-equal
+    pixmap-error pixmap-format pixmap-format-bits-per-pixel
+    pixmap-format-depth pixmap-format-p pixmap-format-scanline-pad
+    pixmap-id pixmap-p pixmap-plist point-seq pointer-control
+    pointer-event-mask pointer-event-mask-class pointer-mapping
+    pointer-position process-event put-image put-raw-image
+    query-best-cursor query-best-stipple query-best-tile query-colors
+    query-extension query-keymap query-pointer query-tree queue-event
+    read-bitmap-file read-resources recolor-cursor rect-seq
+    remove-access-host remove-from-save-set reparent-window repeat-seq
+    reply-length-error reply-timeout request-error reset-screen-saver
+    resource-database resource-database-timestamp resource-error
+    resource-id resource-key rgb-colormaps rgb-val root-resources
+    rotate-cut-buffers rotate-properties screen screen-backing-stores
+    screen-black-pixel screen-default-colormap screen-depths
+    screen-event-mask-at-open screen-height screen-height-in-millimeters
+    screen-max-installed-maps screen-min-installed-maps screen-p
+    screen-plist screen-root screen-root-depth screen-root-visual
+    screen-root-visual-info screen-save-unders-p screen-saver
+    screen-white-pixel screen-width screen-width-in-millimeters seg-seq
+    selection-owner send-event sequence-error set-access-control
+    set-close-down-mode set-input-focus set-modifier-mapping
+    set-pointer-mapping set-screen-saver set-selection-owner
+    set-standard-colormap set-standard-properties set-wm-class
+    set-wm-properties set-wm-resources state-keysym-p state-mask-key
+    store-color store-colors stringable text-extents text-width
+    timestamp transient-for translate-coordinates translate-default
+    translation-function undefine-keysym unexpected-reply
+    ungrab-button ungrab-key ungrab-keyboard ungrab-pointer
+    ungrab-server uninstall-colormap unknown-error unmap-subwindows
+    unmap-window value-error visual-info visual-info-bits-per-rgb
+    visual-info-blue-mask visual-info-class visual-info-colormap-entries
+    visual-info-display visual-info-green-mask visual-info-id visual-info-p
+    visual-info-plist visual-info-red-mask warp-pointer
+    warp-pointer-if-inside warp-pointer-relative warp-pointer-relative-if-inside
+    win-gravity window window-all-event-masks window-background
+    window-backing-pixel window-backing-planes window-backing-store
+    window-bit-gravity window-border window-class window-colormap
+    window-colormap-installed-p window-cursor window-display
+    window-do-not-propagate-mask window-equal window-error
+    window-event-mask window-gravity window-id window-map-state
+    window-override-redirect window-p window-plist window-priority
+    window-save-under window-visual window-visual-info with-display
+    with-event-queue with-gcontext with-server-grabbed with-state
+    withdraw-window wm-client-machine wm-colormap-windows wm-command
+    wm-hints wm-hints-flags wm-hints-icon-mask wm-hints-icon-pixmap
+    wm-hints-icon-window wm-hints-icon-x wm-hints-icon-y
+    wm-hints-initial-state wm-hints-input wm-hints-p wm-hints-window-group
+    wm-icon-name wm-name wm-normal-hints wm-protocols wm-resources
+    wm-size-hints wm-size-hints-base-height wm-size-hints-base-width
+    wm-size-hints-height wm-size-hints-height-inc wm-size-hints-max-aspect
+    wm-size-hints-max-height wm-size-hints-max-width wm-size-hints-min-aspect
+    wm-size-hints-min-height wm-size-hints-min-width wm-size-hints-p
+    wm-size-hints-user-specified-position-p wm-size-hints-user-specified-size-p
+    wm-size-hints-width wm-size-hints-width-inc wm-size-hints-win-gravity
+    wm-size-hints-x wm-size-hints-y wm-zoom-hints write-bitmap-file
+    write-resources xatom))
diff --git a/src/clx/provide.lsp b/src/clx/provide.lsp
new file mode 100644
index 000000000..bf6f3c7a4
--- /dev/null
+++ b/src/clx/provide.lsp
@@ -0,0 +1,56 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Base: 10; Lowercase: Yes; Package: USER;  -*-
+
+;;;; Module definition for CLX
+
+;;; This file is a Common Lisp Module description, but you will have to edit
+;;; it to meet the needs of your site.
+
+;;; Ideally, this file (or a file that loads this file) should be
+;;; located in the system directory that REQUIRE searches.  Thus a user
+;;; would say
+;;;			(require :clx)
+;;; to load CLX.  If there is no such registry, then the user must
+;;; put in a site specific
+;;;			(require :clx <pathname-of-this-file>)
+;;;
+
+#-clx-ansi-common-lisp 
+(in-package :user)
+
+#+clx-ansi-common-lisp
+(in-package :common-lisp-user)
+
+#-clx-ansi-common-lisp
+(provide :clx)
+
+(defvar *clx-source-pathname*
+	(pathname "/src/local/clx/*.l"))
+
+(defvar *clx-binary-pathname*
+	(let ((lisp
+		(or #+lucid "lucid"
+		    #+akcl  "akcl"
+		    #+kcl   "kcl"
+		    #+ibcl  "ibcl"
+		    (error "Can't provide CLX for this lisp.")))
+	      (architecture
+		(or #+(or sun3 (and sun (or mc68000 mc68020))) "sun3"
+		    #+(or sun4 sparc) "sparc"
+		    #+(and hp (or mc68000 mc68020)) "hp9000s300"
+		    #+vax "vax"
+		    #+prime "prime"
+		    #+sunrise "sunrise"
+		    #+ibm-rt-pc "ibm-rt-pc"
+		    #+mips "mips"
+		    #+prism "prism"
+		    (error "Can't provide CLX for this architecture."))))
+	  (pathname (format nil "/src/local/clx/~A.~A/" lisp architecture))))
+
+(defvar *compile-clx*
+	nil)
+
+(load (merge-pathnames "defsystem" *clx-source-pathname*))
+
+(if *compile-clx*
+    (compile-clx *clx-source-pathname* *clx-binary-pathname*)
+  (load-clx *clx-binary-pathname*))
diff --git a/src/clx/requests.lsp b/src/clx/requests.lsp
new file mode 100644
index 000000000..5b9557998
--- /dev/null
+++ b/src/clx/requests.lsp
@@ -0,0 +1,1493 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+(defun create-window (&key
+		      window
+		      (parent (required-arg parent))
+		      (x (required-arg x))
+		      (y (required-arg y))
+		      (width (required-arg width))
+		      (height (required-arg height))
+		      (depth 0) (border-width 0)
+		      (class :copy) (visual :copy)
+		      background border
+		      bit-gravity gravity
+		      backing-store backing-planes backing-pixel save-under
+		      event-mask do-not-propagate-mask override-redirect
+		      colormap cursor)
+  ;; Display is obtained from parent.  Only non-nil attributes are passed on in
+  ;; the request: the function makes no assumptions about what the actual protocol
+  ;; defaults are.  Width and height are the inside size, excluding border.
+  (declare (type (or null window) window)
+	   (type window parent)		; required
+	   (type int16 x y) ;required
+	   (type card16 width height) ;required
+	   (type card16 depth border-width)
+	   (type (member :copy :input-output :input-only) class)
+	   (type (or (member :copy) visual-info resource-id) visual)
+	   (type (or null (member :none :parent-relative) pixel pixmap) background)
+	   (type (or null (member :copy) pixel pixmap) border)
+	   (type (or null bit-gravity) bit-gravity)
+	   (type (or null win-gravity) gravity)
+	   (type (or null (member :not-useful :when-mapped :always)) backing-store)
+	   (type (or null pixel) backing-planes backing-pixel)
+	   (type (or null event-mask) event-mask)
+	   (type (or null device-event-mask) do-not-propagate-mask)
+	   (type (or null (member :on :off)) save-under override-redirect)
+	   (type (or null (member :copy) colormap) colormap)
+	   (type (or null (member :none) cursor) cursor))
+  (declare (values window))
+  (let* ((display (window-display parent))
+	 (window (or window (make-window :display display)))
+	 (wid (allocate-resource-id display window 'window))
+	 back-pixmap back-pixel
+	 border-pixmap border-pixel)
+    (declare (type display display)
+	     (type window window)
+	     (type resource-id wid)
+	     (type (or null resource-id) back-pixmap border-pixmap)
+	     (type (or null pixel) back-pixel border-pixel))
+    (setf (window-id window) wid)
+    (case background
+      ((nil) nil)
+      (:none (setq back-pixmap 0))
+      (:parent-relative (setq back-pixmap 1))
+      (otherwise
+       (if (type? background 'pixmap)
+	   (setq back-pixmap (pixmap-id background))
+	 (if (integerp background)
+	     (setq back-pixel background)
+	   (x-type-error background
+			 '(or null (member :none :parent-relative) integer pixmap))))))
+    (case border
+      ((nil) nil)
+      (:copy (setq border-pixmap 0))
+      (otherwise
+       (if (type? border 'pixmap)
+	   (setq border-pixmap (pixmap-id border))
+	 (if (integerp border)
+	     (setq border-pixel border)
+	   (x-type-error border '(or null (member :copy) integer pixmap))))))
+    (when event-mask
+      (setq event-mask (encode-event-mask event-mask)))
+    (when do-not-propagate-mask
+      (setq do-not-propagate-mask (encode-device-event-mask do-not-propagate-mask)))
+
+						;Make the request
+    (with-buffer-request (display *x-createwindow*)
+      (data depth)
+      (resource-id wid)
+      (window parent)
+      (int16 x y)
+      (card16 width height border-width)
+      ((member16 :copy :input-output :input-only) class)
+      (resource-id (cond ((eq visual :copy)
+			  0)
+			 ((typep visual 'resource-id)
+			  visual)
+			 (t
+			  (visual-info-id visual))))
+      (mask (card32 back-pixmap back-pixel border-pixmap border-pixel)
+	    ((member-vector *bit-gravity-vector*) bit-gravity)
+	    ((member-vector *win-gravity-vector*) gravity)
+	    ((member :not-useful :when-mapped :always) backing-store)
+	    (card32  backing-planes backing-pixel)
+	    ((member :off :on) override-redirect save-under)
+	    (card32 event-mask do-not-propagate-mask)
+	    ((or (member :copy) colormap) colormap)
+	    ((or (member :none) cursor) cursor)))
+    window))
+
+(defun destroy-window (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-destroywindow*)
+    (window window)))
+
+(defun destroy-subwindows (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-destroysubwindows*)
+    (window window)))
+
+(defun add-to-save-set (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-changesaveset*)
+    (data 0)
+    (window window)))
+
+(defun remove-from-save-set (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-changesaveset*)
+    (data 1)
+    (window window)))
+
+(defun reparent-window (window parent x y)
+  (declare (type window window parent)
+	   (type int16 x y))
+  (with-buffer-request ((window-display window) *x-reparentwindow*)
+    (window window parent)
+    (int16 x y)))
+
+(defun map-window (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-mapwindow*)
+    (window window)))
+
+(defun map-subwindows (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-mapsubwindows*)
+    (window window)))
+
+(defun unmap-window (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-unmapwindow*)
+    (window window)))
+
+(defun unmap-subwindows (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-unmapsubwindows*)
+    (window window)))
+
+(defun circulate-window-up (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-circulatewindow*)
+    (data 0)
+    (window window)))
+
+(defun circulate-window-down (window)
+  (declare (type window window))
+  (with-buffer-request ((window-display window) *x-circulatewindow*)
+    (data 1)
+    (window window)))
+
+(defun query-tree (window &key (result-type 'list))
+  (declare (type window window)
+	   (type t result-type)) ;;type specifier
+  (declare (values (sequence window) parent root))
+  (let ((display (window-display window)))
+    (multiple-value-bind (root parent sequence)
+	(with-buffer-request-and-reply (display *x-querytree* nil :sizes (8 16 32))
+	     ((window window))
+	  (values
+	    (window-get 8)
+	    (resource-id-get 12)
+	    (sequence-get :length (card16-get 16) :result-type result-type
+			  :index *replysize*)))
+      ;; Parent is NIL for root window
+      (setq parent (and (plusp parent) (lookup-window display parent)))
+      (dotimes (i (length sequence))		; Convert ID's to window's
+	(setf (elt sequence i) (lookup-window display (elt sequence i))))
+      (values sequence parent root))))
+
+;; Although atom-ids are not visible in the normal user interface, atom-ids might
+;; appear in window properties and other user data, so conversion hooks are needed.
+
+(defun intern-atom (display name)
+  (declare (type display display)
+	   (type xatom name))
+  (declare (values resource-id))
+  (let ((name (if (or (null name) (keywordp name))
+		  name
+		(kintern (string name)))))
+    (declare (type symbol name))
+    (or (atom-id name display)
+	(let ((string (symbol-name name)))
+	  (declare (type string string))
+	  (multiple-value-bind (id)
+	      (with-buffer-request-and-reply (display *x-internatom* 12 :sizes 32)
+		   ((data 0)
+		    (card16 (length string))
+		    (pad16 nil)
+		    (string string))
+		(values
+		  (resource-id-get 8)))
+	    (declare (type resource-id id))
+	    (setf (atom-id name display) id)
+	    id)))))
+
+(defun find-atom (display name)
+  ;; Same as INTERN-ATOM, but with the ONLY-IF-EXISTS flag True
+  (declare (type display display)
+	   (type xatom name))
+  (declare (values (or null resource-id)))
+  (let ((name (if (or (null name) (keywordp name))
+		  name
+		(kintern (string name)))))
+    (declare (type symbol name))
+    (or (atom-id name display)
+	(let ((string (symbol-name name)))
+	  (declare (type string string))
+	  (multiple-value-bind (id)
+	      (with-buffer-request-and-reply (display *x-internatom* 12 :sizes 32)
+		   ((data 1)
+		    (card16 (length string))
+		    (pad16 nil)
+		    (string string))
+		(values
+		  (or-get 8 null resource-id)))
+	    (declare (type (or null resource-id) id))
+	    (when id 
+	      (setf (atom-id name display) id))
+	    id)))))
+
+(defun atom-name (display atom-id)
+  (declare (type display display)
+	   (type resource-id atom-id))
+  (declare (values keyword))
+  (if (zerop atom-id)
+      nil
+  (or (id-atom atom-id display)
+      (let ((keyword
+	      (kintern
+		  (with-buffer-request-and-reply
+		       (display *x-getatomname* nil :sizes (16))
+		     ((resource-id atom-id))
+		  (values
+		    (string-get (card16-get 8) *replysize*))))))
+	(declare (type keyword keyword))
+	(setf (atom-id keyword display) atom-id)
+	  keyword))))
+
+;;; For binary compatibility with older code
+(defun lookup-xatom (display atom-id)
+  (declare (type display display)
+	   (type resource-id atom-id))
+  (atom-name display atom-id))
+
+(defun change-property (window property data type format
+		       &key (mode :replace) (start 0) end transform)
+  ; Start and end affect sub-sequence extracted from data.
+  ; Transform is applied to each extracted element.
+  (declare (type window window)
+	   (type xatom property type)
+	   (type (member 8 16 32) format)
+	   (type sequence data)
+	   (type (member :replace :prepend :append) mode)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type t transform))			;(or null (function (t) integer))
+  (unless end (setq end (length data)))
+  (let* ((display (window-display window))
+	 (length (index- end start))
+	 (property-id (intern-atom display property))
+	 (type-id (intern-atom display type)))
+    (declare (type display display)
+	     (type array-index length)
+	     (type resource-id property-id type-id))
+    (with-buffer-request (display *x-changeproperty*)
+      ((data (member :replace :prepend :append)) mode)
+      (window window)
+      (resource-id property-id type-id)
+      (card8 format)
+      (card32 length)
+      (progn
+	(ecase format
+	  (8  (sequence-put 24 data :format card8
+			    :start start :end end :transform transform))
+	  (16 (sequence-put 24 data :format card16
+			    :start start :end end :transform transform))
+	  (32 (sequence-put 24 data :format card32
+			    :start start :end end :transform transform)))))))
+
+(defun delete-property (window property)
+  (declare (type window window)
+	   (type xatom property))
+  (let* ((display (window-display window))
+	 (property-id (intern-atom display property)))
+    (declare (type display display)
+	     (type resource-id property-id))
+    (with-buffer-request (display *x-deleteproperty*)
+      (window window)
+      (resource-id property-id))))
+
+(defun get-property (window property
+		     &key type (start 0) end delete-p (result-type 'list) transform)
+  ;; Transform is applied to each integer retrieved.
+  (declare (type window window)
+	   (type xatom property)
+	   (type (or null xatom) type)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type boolean delete-p)
+	   (type t result-type)			;a sequence type
+	   (type t transform))			;(or null (function (integer) t))
+  (declare (values data (or null type) format bytes-after))
+  (let* ((display (window-display window))
+	 (property-id (intern-atom display property))
+	 (type-id (and type (intern-atom display type))))
+    (declare (type display display)
+	     (type resource-id property-id)
+	     (type (or null resource-id) type-id))
+    (multiple-value-bind (reply-format reply-type bytes-after data)
+	(with-buffer-request-and-reply (display *x-getproperty* nil :sizes (8 32))
+	     (((data boolean) delete-p)
+	      (window window)
+	      (resource-id property-id)
+	      ((or null resource-id) type-id)
+	      (card32 start)
+	      (card32 (index- (or end 64000) start)))
+	  (let ((reply-format (card8-get 1))
+		(reply-type (card32-get 8))
+		(bytes-after (card32-get 12))
+		(nitems (card32-get 16)))
+	    (values
+	      reply-format
+	      reply-type
+	      bytes-after
+	      (and (plusp nitems)
+		   (ecase reply-format
+		     (0  nil) ;; (make-sequence result-type 0) ;; Property not found.
+		     (8  (sequence-get :result-type result-type :format card8
+				       :length nitems :transform transform
+				       :index *replysize*))
+		     (16 (sequence-get :result-type result-type :format card16
+				       :length nitems :transform transform
+				       :index *replysize*))
+		     (32 (sequence-get :result-type result-type :format card32
+				       :length nitems :transform transform
+				       :index *replysize*)))))))
+      (values data
+	      (and (plusp reply-type) (atom-name display reply-type))
+	      reply-format
+	      bytes-after))))
+
+(defun rotate-properties (window properties &optional (delta 1))
+  ;; Positive rotates left, negative rotates right (opposite of actual protocol request).
+  (declare (type window window)
+	   (type sequence properties) ;; sequence of xatom
+	   (type int16 delta))
+  (let* ((display (window-display window))
+	 (length (length properties))
+	 (sequence (make-array length)))
+    (declare (type display display)
+	     (type array-index length))
+    (with-vector (sequence vector)
+      ;; Atoms must be interned before the RotateProperties request
+      ;; is started to allow InternAtom requests to be made.
+      (dotimes (i length)
+	(setf (aref sequence i) (intern-atom display (elt properties i))))
+      (with-buffer-request (display *x-rotateproperties*)
+	(window window)
+	(card16 length)
+	(int16 (- delta))
+	((sequence :end length) sequence))))
+  nil)
+
+(defun list-properties (window &key (result-type 'list))
+  (declare (type window window)
+	   (type t result-type)) ;; a sequence type
+  (declare (values (sequence keyword)))
+  (let ((display (window-display window)))
+    (multiple-value-bind (seq)
+	(with-buffer-request-and-reply (display *x-listproperties* nil :sizes 16)
+	     ((window window))
+	  (values
+	    (sequence-get :result-type result-type :length (card16-get 8)
+			  :index *replysize*)))
+      ;; lookup the atoms in the sequence
+      (if (listp seq)
+	  (do ((elt seq (cdr elt)))
+	      ((endp elt) seq)
+	    (setf (car elt) (atom-name display (car elt))))
+	(dotimes (i (length seq) seq)
+	  (setf (aref seq i) (atom-name display (aref seq i))))))))
+
+(defun selection-owner (display selection)
+  (declare (type display display)
+	   (type xatom selection))
+  (declare (values (or null window)))
+  (let ((selection-id (intern-atom display selection)))
+    (declare (type resource-id selection-id))
+    (multiple-value-bind (window)
+	(with-buffer-request-and-reply (display *x-getselectionowner* 12 :sizes 32)
+	     ((resource-id selection-id))
+	  (values
+	    (resource-id-or-nil-get 8)))
+      (and window (lookup-window display window)))))
+
+(defun set-selection-owner (display selection owner &optional time)
+  (declare (type display display)
+	   (type xatom selection)
+	   (type (or null window) owner)
+	   (type timestamp time))
+  (let ((selection-id (intern-atom display selection)))
+    (declare (type resource-id selection-id))
+    (with-buffer-request (display *x-setselectionowner*)
+      ((or null window) owner)
+      (resource-id selection-id)
+      ((or null card32) time))
+    owner))
+
+(defsetf selection-owner (display selection &optional time) (owner)
+  ;; A bit strange, but retains setf form.
+  `(set-selection-owner ,display ,selection ,owner ,time))
+
+(defun convert-selection (selection type requestor &optional property time)
+  (declare (type xatom selection type)
+	   (type window requestor)
+	   (type (or null xatom) property)
+	   (type timestamp time))
+  (let* ((display (window-display requestor))
+	 (selection-id (intern-atom display selection))
+	 (type-id (intern-atom display type))
+	 (property-id (and property (intern-atom display property))))
+    (declare (type display display)
+	     (type resource-id selection-id type-id)
+	     (type (or null resource-id) property-id))
+    (with-buffer-request (display *x-convertselection*)
+      (window requestor)
+      (resource-id selection-id type-id)
+      ((or null resource-id) property-id)
+      ((or null card32) time))))
+
+(defun send-event (window event-key event-mask &rest args
+		   &key propagate-p display &allow-other-keys)
+  ;; Additional arguments depend on event-key, and are as specified further below
+  ;; with declare-event, except that both resource-ids and resource objects are
+  ;; accepted in the event components.  The display argument is only required if the
+  ;; window is :pointer-window or :input-focus.
+  (declare (type (or window (member :pointer-window :input-focus)) window)
+	   (type event-key event-key)
+	   (type (or null event-mask) event-mask)
+	   (type boolean propagate-p)
+	   (type (or null display) display)
+	   (dynamic-extent args))
+  (unless event-mask (setq event-mask 0))
+  (unless display (setq display (window-display window)))
+  (let ((internal-event-code (get-event-code event-key))
+	(external-event-code (get-external-event-code display event-key)))
+    (declare (type card8 internal-event-code external-event-code))
+    ;; Ensure keyword atom-id's are cached
+    (dolist (arg (cdr (assoc event-key '((:property-notify :atom)
+					 (:selection-clear :selection)
+					 (:selection-request :selection :target :property)
+					 (:selection-notify :selection :target :property)
+					 (:client-message :type))
+			     :test #'eq)))
+      (let ((keyword (getf args arg)))
+	(intern-atom display keyword)))
+    ;; Make the sendevent request
+    (with-buffer-request (display *x-sendevent*)
+      ((data boolean) propagate-p)
+      (length 11) ;; 3 word request + 8 words for event = 11
+      ((or (member :pointer-window :input-focus) window) window)
+      (card32 (encode-event-mask event-mask))
+      (card8 external-event-code)
+      (progn
+	(apply (svref *event-send-vector* internal-event-code) display args)
+	(setf (buffer-boffset display) (index+ buffer-boffset 44))))))
+
+(defun grab-pointer (window event-mask
+		     &key owner-p sync-pointer-p sync-keyboard-p confine-to cursor time)
+  (declare (type window window)
+	   (type pointer-event-mask event-mask)
+	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
+	   (type (or null window) confine-to)
+	   (type (or null cursor) cursor)
+	   (type timestamp time))
+  (declare (values grab-status))
+  (let ((display (window-display window)))
+    (with-buffer-request-and-reply (display *x-grabpointer* nil :sizes 8)
+	 (((data boolean) owner-p)
+	  (window window)
+	  (card16 (encode-pointer-event-mask event-mask))
+	  (boolean (not sync-pointer-p) (not sync-keyboard-p))
+	  ((or null window) confine-to)
+	  ((or null cursor) cursor)
+	  ((or null card32) time))
+      (values
+	(member8-get 1 :success :already-grabbed :invalid-time :not-viewable :frozen)))))
+
+(defun ungrab-pointer (display &key time)
+  (declare (type timestamp time))
+  (with-buffer-request (display *x-ungrabpointer*)
+    ((or null card32) time)))
+
+(defun grab-button (window button event-mask
+		    &key (modifiers 0)
+			 owner-p sync-pointer-p sync-keyboard-p confine-to cursor)
+  (declare (type window window)
+	   (type (or (member :any) card8) button)
+	   (type modifier-mask modifiers)
+	   (type pointer-event-mask event-mask)
+	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
+	   (type (or null window) confine-to)
+	   (type (or null cursor) cursor))
+  (with-buffer-request ((window-display window) *x-grabbutton*)
+    ((data boolean) owner-p)
+    (window window)
+    (card16 (encode-pointer-event-mask event-mask))
+    (boolean (not sync-pointer-p) (not sync-keyboard-p))
+    ((or null window) confine-to)
+    ((or null cursor) cursor)
+    (card8 (if (eq button :any) 0 button))
+    (pad8 1)
+    (card16 (encode-modifier-mask modifiers))))
+
+(defun ungrab-button (window button &key (modifiers 0))
+  (declare (type window window)
+	   (type (or (member :any) card8) button)
+	   (type modifier-mask modifiers))
+  (with-buffer-request ((window-display window) *x-ungrabbutton*)
+    (data (if (eq button :any) 0 button))
+    (window window)
+    (card16 (encode-modifier-mask modifiers))))
+
+(defun change-active-pointer-grab (display event-mask &optional cursor time)
+  (declare (type display display)
+	   (type pointer-event-mask event-mask)
+	   (type (or null cursor) cursor)
+	   (type timestamp time))
+  (with-buffer-request (display *x-changeactivepointergrab*)
+    ((or null cursor) cursor)
+    ((or null card32) time)
+    (card16 (encode-pointer-event-mask event-mask))))
+
+(defun grab-keyboard (window &key owner-p sync-pointer-p sync-keyboard-p time)
+  (declare (type window window)
+	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
+	   (type timestamp time))
+  (declare (values grab-status))
+  (let ((display (window-display window)))
+    (with-buffer-request-and-reply (display *x-grabkeyboard* nil :sizes 8)
+	 (((data boolean) owner-p)
+	  (window window)
+	  ((or null card32) time)
+	  (boolean (not sync-pointer-p) (not sync-keyboard-p)))
+      (values
+	(member8-get 1 :success :already-grabbed :invalid-time :not-viewable :frozen)))))
+
+(defun ungrab-keyboard (display &key time)
+  (declare (type display display)
+	   (type timestamp time))
+  (with-buffer-request (display *x-ungrabkeyboard*)
+    ((or null card32) time)))
+
+(defun grab-key (window key &key (modifiers 0) owner-p sync-pointer-p sync-keyboard-p)
+  (declare (type window window)
+	   (type boolean owner-p sync-pointer-p sync-keyboard-p)
+	   (type (or (member :any) card8) key)
+	   (type modifier-mask modifiers))
+  (with-buffer-request ((window-display window) *x-grabkey*)
+    ((data boolean) owner-p)
+    (window window)
+    (card16 (encode-modifier-mask modifiers))
+    (card8 (if (eq key :any) 0 key))
+    (boolean (not sync-pointer-p) (not sync-keyboard-p))))
+
+(defun ungrab-key (window key &key (modifiers 0))
+  (declare (type window window)
+	   (type (or (member :any) card8) key)
+	   (type modifier-mask modifiers))
+  (with-buffer-request ((window-display window) *x-ungrabkey*)
+    (data (if (eq key :any) 0 key))
+    (window window)
+    (card16 (encode-modifier-mask modifiers))))
+
+(defun allow-events (display mode &optional time)
+  (declare (type display display)
+	   (type (member :async-pointer :sync-pointer :replay-pointer
+			 :async-keyboard :sync-keyboard :replay-keyboard
+			 :async-both :sync-both)
+		 mode)
+	   (type timestamp time))
+  (with-buffer-request (display *x-allowevents*)
+    ((data (member :async-pointer :sync-pointer :replay-pointer
+		   :async-keyboard :sync-keyboard :replay-keyboard
+		   :async-both :sync-both))
+     mode)
+    ((or null card32) time)))
+
+(defun grab-server (display)
+  (declare (type display display))
+  (with-buffer-request (display *x-grabserver*)))
+
+(defun ungrab-server (display)
+  (with-buffer-request (display *x-ungrabserver*)))
+
+(defmacro with-server-grabbed ((display) &body body)
+  ;; The body is not surrounded by a with-display.
+  (let ((disp (if (symbolp display) display (gensym))))
+    `(let ((,disp ,display))
+       (declare (type display ,disp))
+       (unwind-protect
+	   (progn
+	     (grab-server ,disp)
+	     ,@body)
+	 (ungrab-server ,disp)))))
+
+(defun query-pointer (window)
+  (declare (type window window))
+  (declare (values x y same-screen-p child mask root-x root-y root))
+  (let ((display (window-display window)))
+    (with-buffer-request-and-reply (display *x-querypointer* 26 :sizes (8 16 32))
+	 ((window window))
+      (values
+	(int16-get 20)
+	(int16-get 22)
+	(boolean-get 1)
+	(or-get 12 null window)
+	(card16-get 24)
+	(int16-get 16)
+	(int16-get 18)
+	(window-get 8)))))
+
+(defun pointer-position (window)
+  (declare (type window window))
+  (declare (values x y same-screen-p))
+  (let ((display (window-display window)))
+    (with-buffer-request-and-reply (display *x-querypointer* 24 :sizes (8 16))
+	 ((window window))
+      (values
+	(int16-get 20)
+	(int16-get 22)
+	(boolean-get 1)))))
+
+(defun global-pointer-position (display)
+  (declare (type display display))
+  (declare (values root-x root-y root))
+  (with-buffer-request-and-reply (display *x-querypointer* 20 :sizes (16 32))
+       ((window (screen-root (first (display-roots display)))))
+    (values
+      (int16-get 16)
+      (int16-get 18)
+      (window-get 8))))
+
+(defun motion-events (window &key start stop (result-type 'list))
+  (declare (type window window)
+	   (type timestamp start stop)
+	   (type t result-type)) ;; a type specifier
+  (declare (values (repeat-seq (integer x) (integer y) (timestamp time))))
+  (let ((display (window-display window)))
+    (with-buffer-request-and-reply (display *x-getmotionevents* nil :sizes 32)
+	 ((window window)
+	  ((or null card32) start stop))
+      (values
+	(sequence-get :result-type result-type :length (index* (card32-get 8) 3)
+		      :index *replysize*)))))
+
+(defun translate-coordinates (src src-x src-y dst)
+  ;; Returns NIL when not on the same screen
+  (declare (type window src)
+	   (type int16 src-x src-y)
+	   (type window dst))
+  (declare (values dst-x dst-y child))
+  (let ((display (window-display src)))
+    (with-buffer-request-and-reply (display *x-translatecoords* 16 :sizes (8 16 32))
+	 ((window src dst)
+	  (int16 src-x src-y))
+      (and (boolean-get 1)
+	   (values
+	     (int16-get 12)
+	     (int16-get 14)
+	     (or-get 8 null window))))))
+
+(defun warp-pointer (dst dst-x dst-y)
+  (declare (type window dst)
+	   (type int16 dst-x dst-y))
+  (with-buffer-request ((window-display dst) *x-warppointer*)
+    (resource-id 0) ;; None
+    (window dst)
+    (int16 0 0)
+    (card16 0 0)
+    (int16 dst-x dst-y)))
+
+(defun warp-pointer-relative (display x-off y-off)
+  (declare (type display display)
+	   (type int16 x-off y-off))
+  (with-buffer-request (display *x-warppointer*)
+    (resource-id 0) ;; None
+    (resource-id 0) ;; None
+    (int16 0 0)
+    (card16 0 0)
+    (int16 x-off y-off)))
+
+(defun warp-pointer-if-inside (dst dst-x dst-y src src-x src-y
+			       &optional src-width src-height)
+  ;; Passing in a zero src-width or src-height is a no-op.
+  ;; A null src-width or src-height translates into a zero value in the protocol request.
+  (declare (type window dst src)
+	   (type int16 dst-x dst-y src-x src-y)
+	   (type (or null card16) src-width src-height))
+  (unless (or (eql src-width 0) (eql src-height 0))
+    (with-buffer-request ((window-display dst) *x-warppointer*)
+      (window src dst)
+      (int16 src-x src-y)
+      (card16 (or src-width 0) (or src-height 0))
+      (int16 dst-x dst-y))))
+
+(defun warp-pointer-relative-if-inside (x-off y-off src src-x src-y
+					&optional src-width src-height)
+  ;; Passing in a zero src-width or src-height is a no-op.
+  ;; A null src-width or src-height translates into a zero value in the protocol request.
+  (declare (type window src)
+	   (type int16 x-off y-off src-x src-y)
+	   (type (or null card16) src-width src-height))
+  (unless (or (eql src-width 0) (eql src-height 0))
+    (with-buffer-request ((window-display src) *x-warppointer*)
+      (window src)
+      (resource-id 0) ;; None
+      (int16 src-x src-y)
+      (card16 (or src-width 0) (or src-height 0))
+      (int16 x-off y-off))))
+
+(defun set-input-focus (display focus revert-to &optional time)
+  (declare (type display display)
+	   (type (or (member :none :pointer-root) window) focus)
+	   (type (member :none :pointer-root :parent) revert-to)
+	   (type timestamp time))
+  (with-buffer-request (display *x-setinputfocus*)
+    ((data (member :none :pointer-root :parent)) revert-to)
+    ((or window (member :none :pointer-root)) focus)
+    ((or null card32) time)))
+
+(defun input-focus (display)
+  (declare (type display display))
+  (declare (values focus revert-to))
+  (with-buffer-request-and-reply (display *x-getinputfocus* 16 :sizes (8 32))
+       ()
+    (values
+      (or-get 8 (member :none :pointer-root) window)
+      (member8-get 1 :none :pointer-root :parent))))
+
+(defun query-keymap (display &optional bit-vector)
+  (declare (type display display)
+	   (type (or null (bit-vector 256)) bit-vector))
+  (declare (values (bit-vector 256)))
+  (with-buffer-request-and-reply (display *x-querykeymap* 40 :sizes 8)
+       ()
+    (values
+      (bit-vector256-get 8 8 bit-vector))))
+
+(defun create-pixmap (&key
+		      pixmap
+		      (width (required-arg width))
+		      (height (required-arg height))
+		      (depth (required-arg depth))
+		      (drawable (required-arg drawable)))
+  (declare (type (or null pixmap) pixmap)
+	   (type card8 depth) ;; required
+	   (type card16 width height) ;; required
+	   (type drawable drawable)) ;; required
+  (declare (values pixmap))
+  (let* ((display (drawable-display drawable))
+	 (pixmap (or pixmap (make-pixmap :display display)))
+	 (pid (allocate-resource-id display pixmap 'pixmap)))
+    (setf (pixmap-id pixmap) pid)
+    (with-buffer-request (display *x-createpixmap*)
+      (data depth)
+      (resource-id pid)
+      (drawable drawable)
+      (card16 width height))
+    pixmap))
+
+(defun free-pixmap (pixmap)
+  (declare (type pixmap pixmap))
+  (let ((display (pixmap-display pixmap)))
+    (with-buffer-request (display *x-freepixmap*)
+      (pixmap pixmap))
+    (deallocate-resource-id display (pixmap-id pixmap) 'pixmap)))
+
+(defun clear-area (window &key (x 0) (y 0) width height exposures-p)
+  ;; Passing in a zero width or height is a no-op.
+  ;; A null width or height translates into a zero value in the protocol request.
+  (declare (type window window)
+	   (type int16 x y)
+	   (type (or null card16) width height)
+	   (type boolean exposures-p))
+  (unless (or (eql width 0) (eql height 0))
+    (with-buffer-request ((window-display window) *x-cleartobackground*)
+      ((data boolean) exposures-p)
+      (window window)
+      (int16 x y)
+      (card16 (or width 0) (or height 0)))))
+
+(defun copy-area (src gcontext src-x src-y width height dst dst-x dst-y)
+  (declare (type drawable src dst)
+	   (type gcontext gcontext)
+	   (type int16 src-x src-y dst-x dst-y)
+	   (type card16 width height))
+  (with-buffer-request ((drawable-display src) *x-copyarea* :gc-force gcontext)
+    (drawable src dst)
+    (gcontext gcontext)
+    (int16 src-x src-y dst-x dst-y)
+    (card16 width height)))
+
+(defun copy-plane (src gcontext plane src-x src-y width height dst dst-x dst-y)
+  (declare (type drawable src dst)
+	   (type gcontext gcontext)
+	   (type pixel plane)
+	   (type int16 src-x src-y dst-x dst-y)
+	   (type card16 width height))
+  (with-buffer-request ((drawable-display src) *x-copyplane* :gc-force gcontext)
+    (drawable src dst)
+    (gcontext gcontext)
+    (int16 src-x src-y dst-x dst-y)
+    (card16 width height)
+    (card32 plane)))
+
+(defun create-colormap (visual-info window &optional alloc-p)
+  (declare (type (or visual-info resource-id) visual-info)
+	   (type window window)
+	   (type boolean alloc-p))
+  (declare (values colormap))
+  (let ((display (window-display window)))
+    (when (typep visual-info 'resource-id)
+      (setf visual-info (visual-info display visual-info)))
+    (let* ((colormap (make-colormap :display display :visual-info visual-info))
+	   (id (allocate-resource-id display colormap 'colormap)))
+      (setf (colormap-id colormap) id)
+      (with-buffer-request (display *x-createcolormap*)
+	((data boolean) alloc-p)
+	(card29 id)
+	(window window)
+	(card29 (visual-info-id visual-info)))
+      colormap)))
+
+(defun free-colormap (colormap)
+  (declare (type colormap colormap))
+  (let ((display (colormap-display colormap)))
+    (with-buffer-request (display *x-freecolormap*)
+      (colormap colormap))
+    (deallocate-resource-id display (colormap-id colormap) 'colormap)))
+
+(defun copy-colormap-and-free (colormap)
+  (declare (type colormap colormap))
+  (declare (values colormap))
+  (let* ((display (colormap-display colormap))
+	 (new-colormap (make-colormap :display display
+				      :visual-info (colormap-visual-info colormap)))
+	 (id (allocate-resource-id display new-colormap 'colormap)))
+    (setf (colormap-id new-colormap) id)
+    (with-buffer-request (display *x-copycolormapandfree*)
+      (resource-id id)
+      (colormap colormap))
+    new-colormap))
+
+(defun install-colormap (colormap)
+  (declare (type colormap colormap))
+  (with-buffer-request ((colormap-display colormap) *x-installcolormap*)
+    (colormap colormap)))
+
+(defun uninstall-colormap (colormap)
+  (declare (type colormap colormap))
+  (with-buffer-request ((colormap-display colormap) *x-uninstallcolormap*)
+    (colormap colormap)))
+
+(defun installed-colormaps (window &key (result-type 'list))
+  (declare (type window window)
+	   (type t result-type)) ;; CL type
+  (declare (values (sequence colormap)))
+  (let ((display (window-display window)))
+    (flet ((get-colormap (id)
+	     (lookup-colormap display id)))
+      (with-buffer-request-and-reply (display *x-listinstalledcolormaps* nil :sizes 16)
+	   ((window window))
+	(values
+	  (sequence-get :result-type result-type :length (card16-get 8)
+			:transform #'get-colormap :index *replysize*))))))
+
+(defun alloc-color (colormap color)
+  (declare (type colormap colormap)
+	   (type (or stringable color) color))
+  (declare (values pixel screen-color exact-color))
+  (let ((display (colormap-display colormap)))
+    (etypecase color
+      (color
+	(with-buffer-request-and-reply (display *x-alloccolor* 20 :sizes (16 32))
+	     ((colormap colormap)
+	      (rgb-val (color-red color)
+		       (color-green color)
+		       (color-blue color))
+	      (pad16 nil))
+	  (values
+	    (card32-get 16)
+	    (make-color :red (rgb-val-get 8)
+			:green (rgb-val-get 10)
+			:blue (rgb-val-get 12))
+	    color)))
+      (stringable
+	(let* ((string (string color))
+	       (length (length string)))
+	  (with-buffer-request-and-reply (display *x-allocnamedcolor* 24 :sizes (16 32))
+	       ((colormap colormap)
+		(card16 length)
+		(pad16 nil)
+		(string string))
+	    (values
+	      (card32-get 8)
+	      (make-color :red (rgb-val-get 18)
+			  :green (rgb-val-get 20)
+			  :blue (rgb-val-get 22))
+	      (make-color :red (rgb-val-get 12)
+			  :green (rgb-val-get 14)
+			  :blue (rgb-val-get 16)))))))))
+
+(defun alloc-color-cells (colormap colors &key (planes 0) contiguous-p (result-type 'list))
+  (declare (type colormap colormap)
+	   (type card16 colors planes)
+	   (type boolean contiguous-p)
+	   (type t result-type)) ;; CL type
+  (declare (values (sequence pixel) (sequence mask)))
+  (let ((display (colormap-display colormap)))
+    (with-buffer-request-and-reply (display *x-alloccolorcells* nil :sizes 16)
+	 (((data boolean) contiguous-p)
+	  (colormap colormap)
+	  (card16 colors planes))
+      (let ((pixel-length (card16-get 8))
+	    (mask-length (card16-get 10)))
+	(values
+	  (sequence-get :result-type result-type :length pixel-length :index *replysize*)
+	  (sequence-get :result-type result-type :length mask-length
+			:index (index+ *replysize* (index* pixel-length 4))))))))
+
+(defun alloc-color-planes (colormap colors
+			   &key (reds 0) (greens 0) (blues 0)
+			   contiguous-p (result-type 'list))
+  (declare (type colormap colormap)
+	   (type card16 colors reds greens blues)
+	   (type boolean contiguous-p)
+	   (type t result-type)) ;; CL type
+  (declare (values (sequence pixel) red-mask green-mask blue-mask))
+  (let ((display (colormap-display colormap)))
+    (with-buffer-request-and-reply (display *x-alloccolorplanes* nil :sizes (16 32))
+	 (((data boolean) contiguous-p)
+	  (colormap colormap)
+	  (card16 colors reds greens blues))
+      (let ((red-mask (card32-get 12))
+	    (green-mask (card32-get 16))
+	    (blue-mask (card32-get 20)))
+	(values
+	  (sequence-get :result-type result-type :length (card16-get 8) :index *replysize*)
+	  red-mask green-mask blue-mask)))))
+
+(defun free-colors (colormap pixels &optional (plane-mask 0))
+  (declare (type colormap colormap)
+	   (type sequence pixels) ;; Sequence of integers
+	   (type pixel plane-mask))
+  (with-buffer-request ((colormap-display colormap) *x-freecolors*)
+    (colormap colormap)
+    (card32 plane-mask)
+    (sequence pixels)))
+
+(defun store-color (colormap pixel spec &key (red-p t) (green-p t) (blue-p t))
+  (declare (type colormap colormap)
+	   (type pixel pixel)
+	   (type (or stringable color) spec)
+	   (type boolean red-p green-p blue-p))
+  (let ((display (colormap-display colormap))
+	(flags 0))
+    (declare (type display display)
+	     (type card8 flags))
+    (when red-p (setq flags 1))
+    (when green-p (incf flags 2))
+    (when blue-p (incf flags 4))
+    (etypecase spec
+      (color
+	(with-buffer-request (display *x-storecolors*)
+	  (colormap colormap)
+	  (card32 pixel)
+	  (rgb-val (color-red spec)
+		   (color-green spec)
+		   (color-blue spec))
+	  (card8 flags)
+	  (pad8 nil)))
+      (stringable
+	(let* ((string (string spec))
+	       (length (length string)))
+	  (with-buffer-request (display *x-storenamedcolor*)
+	    ((data card8) flags)
+	    (colormap colormap)
+	    (card32 pixel)
+	    (card16 length)
+	    (pad16 nil)
+	    (string string)))))))
+
+(defun store-colors (colormap specs &key (red-p t) (green-p t) (blue-p t))
+  ;; If stringables are specified for colors, it is unspecified whether all
+  ;; stringables are first resolved and then a single StoreColors protocol request is
+  ;; issued, or whether multiple StoreColors protocol requests are issued.
+  (declare (type colormap colormap)
+	   (type sequence specs)
+	   (type boolean red-p green-p blue-p))
+  (etypecase specs
+    (list
+      (do ((spec specs (cddr spec)))
+	  ((endp spec))
+	(store-color colormap (car spec) (cadr spec) :red-p red-p :green-p green-p :blue-p blue-p)))
+    (vector
+      (do ((i 0 (+ i 2))
+	   (len (length specs)))
+	  ((>= i len))
+	(store-color colormap (aref specs i) (aref specs (1+ i)) :red-p red-p :green-p green-p :blue-p blue-p)))))
+
+(defun query-colors (colormap pixels &key (result-type 'list))
+  (declare (type colormap colormap)
+	   (type sequence pixels) ;; sequence of integer
+	   (type t result-type))   ;; a type specifier
+  (declare (values (sequence color)))
+  (let ((display (colormap-display colormap)))
+    (with-buffer-request-and-reply (display *x-querycolors* nil :sizes (8 16))
+	 ((colormap colormap)
+	  (sequence pixels))
+      (let ((sequence (make-sequence result-type (card16-get 8))))
+	(advance-buffer-offset *replysize*)
+	(dotimes (i (length sequence) sequence)
+	  (setf (elt sequence i)
+		(make-color :red (rgb-val-get 0)
+			    :green (rgb-val-get 2)
+			    :blue (rgb-val-get 4)))
+	  (advance-buffer-offset 8))))))
+
+(defun lookup-color (colormap name)
+  (declare (type colormap colormap)
+	   (type stringable name))
+  (declare (values screen-color true-color))
+  (let* ((display (colormap-display colormap))
+	 (string (string name))
+	 (length (length string)))
+    (with-buffer-request-and-reply (display *x-lookupcolor* 20 :sizes 16)
+	 ((colormap colormap)
+	  (card16 length)
+	  (pad16 nil)
+	  (string string))
+      (values
+	(make-color :red (rgb-val-get 14)
+		    :green (rgb-val-get 16)
+		    :blue (rgb-val-get 18))
+	(make-color :red (rgb-val-get 8)
+		    :green (rgb-val-get 10)
+		    :blue (rgb-val-get 12))))))
+
+(defun create-cursor (&key
+		      (source (required-arg source))
+		      mask
+		      (x (required-arg x))
+		      (y (required-arg y))
+		      (foreground (required-arg foreground))
+		      (background (required-arg background)))
+  (declare (type pixmap source) ;; required
+	   (type (or null pixmap) mask)
+	   (type card16 x y) ;; required
+	   (type (or null color) foreground background)) ;; required
+  (declare (values cursor))
+  (let* ((display (pixmap-display source))
+	 (cursor (make-cursor :display display))
+	 (cid (allocate-resource-id display cursor 'cursor)))
+    (setf (cursor-id cursor) cid)
+    (with-buffer-request (display *x-createcursor*)
+      (resource-id cid)
+      (pixmap source)
+      ((or null pixmap) mask)
+      (rgb-val (color-red foreground)
+	       (color-green foreground)
+	       (color-blue foreground))
+      (rgb-val (color-red background)
+	       (color-green background)
+	       (color-blue background))
+      (card16 x y))
+    cursor))
+
+(defun create-glyph-cursor (&key
+			    (source-font (required-arg source-font))
+			    (source-char (required-arg source-char))
+			    mask-font
+			    mask-char
+			    (foreground (required-arg foreground))
+			    (background (required-arg background)))
+  (declare (type font source-font) ;; Required
+	   (type card16 source-char) ;; Required
+	   (type (or null font) mask-font)
+	   (type (or null card16) mask-char)
+	   (type color foreground background)) ;; required
+  (declare (values cursor))
+  (let* ((display (font-display source-font))
+	 (cursor (make-cursor :display display))
+	 (cid (allocate-resource-id display cursor 'cursor))
+	 (source-font-id (font-id source-font))
+	 (mask-font-id (if mask-font (font-id mask-font) 0)))
+    (setf (cursor-id cursor) cid)
+    (unless mask-char (setq mask-char 0))
+    (with-buffer-request (display *x-createglyphcursor*)
+      (resource-id cid source-font-id mask-font-id)
+      (card16 source-char)
+      (card16 mask-char)
+      (rgb-val (color-red foreground)
+	       (color-green foreground)
+	       (color-blue foreground))
+      (rgb-val (color-red background)
+	       (color-green background)
+	       (color-blue background)))
+    cursor))
+
+(defun free-cursor (cursor)
+  (declare (type cursor cursor))
+  (let ((display (cursor-display cursor)))
+    (with-buffer-request (display *x-freecursor*)
+      (cursor cursor))
+    (deallocate-resource-id display (cursor-id cursor) 'cursor)))
+
+(defun recolor-cursor (cursor foreground background)
+  (declare (type cursor cursor)
+	   (type color foreground background))
+  (with-buffer-request ((cursor-display cursor) *x-recolorcursor*)
+    (cursor cursor)
+    (rgb-val (color-red foreground)
+	     (color-green foreground)
+	     (color-blue foreground))
+    (rgb-val (color-red background)
+	     (color-green background)
+	     (color-blue background))
+    ))
+
+(defun query-best-cursor (width height drawable)
+  (declare (type card16 width height)
+	   (type (or drawable display) drawable))	
+  (declare (values width height))
+  ;; Drawable can be a display for compatibility.
+  (multiple-value-bind (display drawable)
+      (if (type? drawable 'drawable)
+	  (values (drawable-display drawable) drawable)
+	(values drawable (screen-root (display-default-screen drawable))))
+    (with-buffer-request-and-reply (display *x-querybestsize* 12 :sizes 16)
+	 ((data 0)
+	  (window drawable)
+	  (card16 width height))
+      (values
+	(card16-get 8)
+	(card16-get 10)))))
+
+(defun query-best-tile (width height drawable)
+  (declare (type card16 width height)
+	   (type drawable drawable))
+  (declare (values width height))
+  (let ((display (drawable-display drawable)))
+    (with-buffer-request-and-reply (display *x-querybestsize* 12 :sizes 16)
+	 ((data 1)
+	  (drawable drawable)
+	  (card16 width height))
+      (values
+	(card16-get 8)
+	(card16-get 10)))))
+
+(defun query-best-stipple (width height drawable)
+  (declare (type card16 width height)
+	   (type drawable drawable))
+  (declare (values width height))
+  (let ((display (drawable-display drawable)))
+    (with-buffer-request-and-reply (display *x-querybestsize* 12 :sizes 16)
+	 ((data 2)
+	  (drawable drawable)
+	  (card16 width height))
+      (values
+	(card16-get 8)
+	(card16-get 10)))))
+
+(defun query-extension (display name)
+  (declare (type display display)
+	   (type stringable name))
+  (declare (values major-opcode first-event first-error))
+  (let ((string (string name)))
+    (with-buffer-request-and-reply (display *x-queryextension* 12 :sizes 8)
+	 ((card16 (length string))
+	  (pad16 nil)
+	  (string string))
+      (and (boolean-get 8)    ;; If present
+	   (values
+	     (card8-get 9)
+	     (card8-get 10)
+	     (card8-get 11))))))
+
+(defun list-extensions (display &key (result-type 'list))
+  (declare (type display display)
+	   (type t result-type)) ;; CL type
+  (declare (values (sequence string)))
+  (with-buffer-request-and-reply (display *x-listextensions* size :sizes 8)
+       ()
+    (values
+      (read-sequence-string
+	buffer-bbuf (index- size *replysize*) (card8-get 1) result-type *replysize*))))
+
+(defun change-keyboard-control (display &key key-click-percent
+				bell-percent bell-pitch bell-duration
+				led led-mode key auto-repeat-mode)
+  (declare (type display display)
+	   (type (or null (member :default) int16) key-click-percent
+						   bell-percent bell-pitch bell-duration)
+	   (type (or null card8) led key)
+	   (type (or null (member :on :off)) led-mode)
+	   (type (or null (member :on :off :default)) auto-repeat-mode))
+  (when (eq key-click-percent :default) (setq key-click-percent -1))
+  (when (eq bell-percent :default) (setq bell-percent -1))
+  (when (eq bell-pitch :default) (setq bell-pitch -1))
+  (when (eq bell-duration :default) (setq bell-duration -1))
+  (with-buffer-request (display *x-changekeyboardcontrol* :sizes (32))
+    (mask
+      (integer key-click-percent bell-percent bell-pitch bell-duration)
+      (card32 led)
+      ((member :off :on) led-mode)
+      (card32 key)
+      ((member :off :on :default) auto-repeat-mode))))
+
+(defun keyboard-control (display)
+  (declare (type display display))
+  (declare (values key-click-percent bell-percent bell-pitch bell-duration
+		  led-mask global-auto-repeat auto-repeats))
+  (with-buffer-request-and-reply (display *x-getkeyboardcontrol* 32 :sizes (8 16 32))
+       ()
+    (values
+      (card8-get 12)
+      (card8-get 13)
+      (card16-get 14)
+      (card16-get 16)
+      (card32-get 8)
+      (member8-get 1 :off :on)
+      (bit-vector256-get 32))))
+
+;;  The base volume should
+;; be considered to be the "desired" volume in the normal case; that is, a
+;; typical application should call XBell with 0 as the percent.  Rather
+;; than using a simple sum, the percent argument is instead used as the
+;; percentage of the remaining range to alter the base volume by.  That is,
+;; the actual volume is:
+;;	 if percent>=0:    base - [(base * percent) / 100] + percent
+;;	 if percent<0:     base + [(base * percent) / 100]
+
+(defun bell (display &optional (percent-from-normal 0))
+  ;; It is assumed that an eventual audio extension to X will provide more complete control.
+  (declare (type display display)
+	   (type int8 percent-from-normal))
+  (with-buffer-request (display *x-bell*)
+    (data (int8->card8 percent-from-normal))))
+
+(defun pointer-mapping (display &key (result-type 'list))
+  (declare (type display display)
+	   (type t result-type)) ;; CL type
+  (declare (values sequence)) ;; Sequence of card
+  (with-buffer-request-and-reply (display *x-getpointermapping* nil :sizes 8)
+       ()
+    (values
+      (sequence-get :length (card8-get 1) :result-type result-type :format card8
+		    :index *replysize*))))
+
+(defun set-pointer-mapping (display map)
+  ;; Can signal device-busy.
+  (declare (type display display)
+	   (type sequence map)) ;; Sequence of card8
+  (when (with-buffer-request-and-reply (display *x-setpointermapping* 2 :sizes 8)
+	     ((data (length map))
+	      ((sequence :format card8) map))
+	  (values
+	    (boolean-get 1)))
+    (x-error 'device-busy :display display))
+  map)
+
+(defsetf pointer-mapping set-pointer-mapping)
+
+(defun change-pointer-control (display &key acceleration threshold)
+  ;; Acceleration is rationalized if necessary.
+  (declare (type display display)
+	   (type (or null (member :default) number) acceleration)
+	   (type (or null (member :default) integer) threshold)
+	   (inline rationalize16))
+  (flet ((rationalize16 (number)
+	   ;; Rationalize NUMBER into the ratio of two signed 16 bit numbers
+	   (declare (type number number)
+		    (inline rationalize16))
+	   (declare (values numerator denominator))
+	   (do* ((rational (rationalize number))
+		 (numerator (numerator rational) (ash numerator -1))
+		 (denominator (denominator rational) (ash denominator -1)))
+		((or (= numerator 1)
+		     (and (< (abs numerator) #x8000)
+			  (< denominator #x8000)))
+		 (values
+		   numerator (min denominator #x7fff))))))
+
+    (let ((acceleration-p 1)
+	  (threshold-p 1)
+	  (numerator 0)
+	  (denominator 1))
+      (declare (type card8 acceleration-p threshold-p)
+	       (type int16 numerator denominator))
+      (cond ((eq acceleration :default) (setq numerator -1))
+	    (acceleration (multiple-value-setq (numerator denominator)
+			    (rationalize16 acceleration)))
+	    (t (setq acceleration-p 0)))
+      (cond ((eq threshold :default) (setq threshold -1))
+	    ((null threshold) (setq threshold -1
+				    threshold-p 0)))
+      (with-buffer-request (display *x-changepointercontrol*)
+	(int16 numerator denominator threshold)
+	(card8 acceleration-p threshold-p)))))
+
+(defun pointer-control (display)
+  (declare (type display display))
+  (declare (values acceleration threshold))
+  (with-buffer-request-and-reply (display *x-getpointercontrol* 16 :sizes 16)
+       ()
+    (values
+      (/ (card16-get 8) (card16-get 10)		; Should we float this?
+	 (card16-get 12)))))
+
+(defun set-screen-saver (display timeout interval blanking exposures)
+  ;; Timeout and interval are in seconds, will be rounded to minutes.
+  (declare (type display display)
+	   (type (or (member :default) int16) timeout interval)
+	   (type (member :on :off :default :yes :no) blanking exposures))
+  (case blanking (:yes (setq blanking :on)) (:no (setq blanking :off)))
+  (case exposures (:yes (setq exposures :on)) (:no (setq exposures :off)))
+  (when (eq timeout :default) (setq timeout -1))
+  (when (eq interval :default) (setq interval -1))
+  (with-buffer-request (display *x-setscreensaver*)
+    (int16 timeout interval)
+    ((member8 :on :off :default) blanking exposures)))
+
+(defun screen-saver (display)
+  ;; Returns timeout and interval in seconds.
+  (declare (type display display))
+  (declare (values timeout interval blanking exposures))
+  (with-buffer-request-and-reply (display *x-getscreensaver* 14 :sizes (8 16))
+       ()
+    (values
+      (card16-get 8)
+      (card16-get 10)
+      (member8-get 12 :on :off :default)
+      (member8-get 13 :on :off :default))))
+
+(defun activate-screen-saver (display)
+  (declare (type display display))
+  (with-buffer-request (display *x-forcescreensaver*)
+    (data 1)))
+
+(defun reset-screen-saver (display)
+  (declare (type display display))
+  (with-buffer-request (display *x-forcescreensaver*)
+    (data 0)))
+
+(defun add-access-host (display host &optional (family :internet))
+  ;; A string must be acceptable as a host, but otherwise the possible types for
+  ;; host are not constrained, and will likely be very system dependent.
+  ;; This implementation uses a list whose car is the family keyword
+  ;; (:internet :DECnet :Chaos) and cdr is a list of network address bytes.
+  (declare (type display display)
+	   (type (or stringable list) host)
+	   (type (or null (member :internet :decnet :chaos) card8) family))
+  (change-access-host display host family nil))
+
+(defun remove-access-host (display host &optional (family :internet))
+  ;; A string must be acceptable as a host, but otherwise the possible types for
+  ;; host are not constrained, and will likely be very system dependent.
+  ;; This implementation uses a list whose car is the family keyword
+  ;; (:internet :DECnet :Chaos) and cdr is a list of network address bytes.
+  (declare (type display display)
+	   (type (or stringable list) host)
+	   (type (or null (member :internet :decnet :chaos) card8) family))
+  (change-access-host display host family t))
+
+(defun change-access-host (display host family remove-p)
+  (declare (type display display)
+	   (type (or stringable list) host)
+	   (type (or null (member :internet :decnet :chaos) card8) family))
+  (unless (consp host)
+    (setq host (host-address host family)))
+  (let ((family (car host))
+	(address (cdr host)))
+    (with-buffer-request (display *x-changehosts*)
+      ((data boolean) remove-p)
+      (card8 (encode-type (or null (member :internet :decnet :chaos) card32) family))
+      (card16 (length address))
+      ((sequence :format card8) address))))
+
+(defun access-hosts (display &optional (result-type 'list))
+  ;; The type of host objects returned is not constrained, except that the hosts must
+  ;; be acceptable to add-access-host and remove-access-host.
+  ;; This implementation uses a list whose car is the family keyword
+  ;; (:internet :DECnet :Chaos) and cdr is a list of network address bytes.
+  (declare (type display display)
+	   (type t result-type)) ;; CL type
+  (declare (values (sequence host) enabled-p))
+  (with-buffer-request-and-reply (display *x-listhosts* nil :sizes (8 16))
+       ()
+    (let* ((enabled-p (boolean-get 1))
+	   (nhosts (card16-get 8))
+	   (sequence (make-sequence result-type nhosts)))
+      (advance-buffer-offset *replysize*)
+      (dotimes (i nhosts)
+	(let ((family (card8-get 0))
+	      (len (card16-get 2)))
+	  (setf (elt sequence i)
+		(cons (if (< family 3)
+			  (svref '#(:internet :decnet :chaos) family)
+			family)
+		      (sequence-get :length len :format card8 :result-type 'list
+				    :index (+ buffer-boffset 4))))
+	  (advance-buffer-offset (+ 4 (* 4 (ceiling len 4))))))
+      (values
+	sequence
+	enabled-p))))
+
+(defun access-control (display)
+  (declare (type display display))
+  (declare (values boolean)) ;; True when access-control is ENABLED
+  (with-buffer-request-and-reply (display *x-listhosts* 2 :sizes 8)
+       ()
+    (boolean-get 1)))
+  
+(defun set-access-control (display enabled-p)
+  (declare (type display display)
+	   (type boolean enabled-p))
+  (with-buffer-request (display *x-changeaccesscontrol*)
+    ((data boolean) enabled-p))
+  enabled-p)
+
+(defsetf access-control set-access-control)
+
+(defun close-down-mode (display)
+  ;; setf'able
+  ;; Cached locally in display object.
+  (declare (type display display))
+  (declare (values (member :destroy :retain-permanent :retain-temporary nil)))
+  (display-close-down-mode display))
+
+(defun set-close-down-mode (display mode)
+  ;; Cached locally in display object.
+  (declare (type display display)
+	   (type (member :destroy :retain-permanent :retain-temporary) mode))
+  (setf (display-close-down-mode display) mode)
+  (with-buffer-request (display *x-changeclosedownmode* :sizes (32))
+    ((data (member :destroy :retain-permanent :retain-temporary)) mode))
+  mode)
+
+(defsetf close-down-mode set-close-down-mode)
+
+(defun kill-client (display resource-id)
+  (declare (type display display)
+	   (type resource-id resource-id))
+  (with-buffer-request (display *x-killclient*)
+    (resource-id resource-id)))
+
+(defun kill-temporary-clients (display)
+  (declare (type display display))
+  (with-buffer-request (display *x-killclient*)
+    (resource-id 0)))
+
+(defun no-operation (display)
+  (declare (type display display))
+  (with-buffer-request (display *x-nooperation*)))
diff --git a/src/clx/resource.lsp b/src/clx/resource.lsp
new file mode 100644
index 000000000..bd455d803
--- /dev/null
+++ b/src/clx/resource.lsp
@@ -0,0 +1,696 @@
+;;; -*- Mode:Common-Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-
+
+;; RESOURCE - Lisp version of XLIB's Xrm resource manager
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+;; The C version of this uses a 64 entry hash table at each entry.
+;; Small hash tables lose in Lisp, so we do linear searches on lists.
+
+(defstruct (resource-database (:copier nil) (:predicate nil)
+			      (:print-function print-resource-database)
+			      (:constructor make-resource-database-internal)
+			      #+explorer (:callable-constructors nil)
+			      )
+  (name nil :type stringable :read-only t)
+  (value nil)
+  (tight nil :type list) ;; List of resource-database
+  (loose nil :type list) ;; List of resource-database
+  )
+
+(defun print-resource-database (database stream depth)
+  (declare (type resource-database database)
+	   (ignore depth))
+  (print-unreadable-object (database stream :type t)
+    (write-string (string (resource-database-name database)) stream)
+    (when (resource-database-value database)
+      (write-string " " stream)
+      (prin1 (resource-database-value database) stream))))
+
+;; The value slot of the top-level resource-database structure is used for a
+;; time-stamp.
+
+(defun make-resource-database ()
+  ;; Make a resource-database with initial timestamp of 0
+  (make-resource-database-internal :name "Top-Level" :value 0))
+
+(defun resource-database-timestamp (database)
+  (declare (type resource-database database))
+  (resource-database-value database))
+
+(defun incf-resource-database-timestamp (database)
+  ;; Increment the timestamp
+  (declare (type resource-database database))
+  (let ((timestamp (resource-database-value database)))
+    (setf (resource-database-value database)
+	  (if (= timestamp most-positive-fixnum)
+	      most-negative-fixnum
+	    (1+ timestamp)))))
+
+;; DEBUG FUNCTION  (not exported)
+(defun print-db (entry &optional (level 0) type)
+  ;; Debug function to print a resource database
+  (format t "~%~v@t~s~:[~; *~]~@[ Value ~s~]"
+	  level
+	  (resource-database-name entry)
+	  (eq type 'loose)
+	  (resource-database-value entry))
+  (when (resource-database-tight entry)
+    (dolist (tight (resource-database-tight entry))
+      (print-db tight (+ 2 level) 'tight)))
+  (when (resource-database-loose entry)
+    (dolist (loose (resource-database-loose entry))
+      (print-db loose (+ 2 level) 'loose))))
+
+;; DEBUG FUNCTION
+#+comment
+(defun print-search-table (table)
+  (terpri)
+  (dolist (dbase-list table)
+    (format t "~%~s" dbase-list)
+    (dolist (db dbase-list)
+      (print-db db)
+      (dolist (dblist table)
+	(unless (eq dblist dbase-list)
+	  (when (member db dblist)
+	    (format t "  duplicate at ~s" db))))
+      )))
+
+;;
+;; If this is true, resource symbols will be compared in a case-insensitive
+;; manner, and converting a resource string to a keyword will uppercaseify it.
+;;
+(defparameter *uppercase-resource-symbols* nil)
+
+(defun resource-key (stringable)
+  ;; Ensure STRINGABLE is a keyword.
+  (declare (type stringable stringable))
+  (etypecase stringable
+    (symbol
+      (if (keywordp (the symbol stringable))
+	  stringable
+	  (kintern (symbol-name (the symbol stringable)))))
+    (string
+      (if *uppercase-resource-symbols*
+	  (setq stringable (#-allegro string-upcase #+allegro correct-case
+			    (the string stringable))))
+      (kintern (the string stringable)))))
+
+(defun stringable-equal (a b)
+  ;; Compare two stringables.
+  ;; Ignore case when comparing to a symbol.
+  (declare (type stringable a b))
+  (declare (values boolean))
+  (etypecase a
+    (string
+      (etypecase b
+	(string
+	  (string= (the string a) (the string b)))
+	(symbol
+	  (if *uppercase-resource-symbols*
+	      (string-equal (the string a)
+			    (the string (symbol-name (the symbol b))))
+	      (string= (the string a)
+		       (the string (symbol-name (the symbol b))))))))
+    (symbol
+      (etypecase b
+	(string
+	  (if *uppercase-resource-symbols*
+	      (string-equal (the string (symbol-name (the symbol a)))
+			    (the string b))
+	      (string= (the string (symbol-name (the symbol a)))
+		       (the string b))))
+	(symbol
+	  (string= (the string (symbol-name (the symbol a)))
+		   (the string (symbol-name (the symbol b)))))))))
+
+
+;;;-----------------------------------------------------------------------------
+;;; Add/delete resource
+
+(defun add-resource (database name-list value)
+  ;; name-list is a list of either strings or symbols. If a symbol, 
+  ;; case-insensitive comparisons will be used, if a string,
+  ;; case-sensitive comparisons will be used.  The symbol '* or
+  ;; string "*" are used as wildcards, matching anything or nothing.
+  (declare (type resource-database database)
+	   (type list name-list) ;; (list stringable)
+	   (type t value))
+  (unless value (error "Null resource values are ignored"))
+  (incf-resource-database-timestamp database)
+  (do* ((list name-list (cdr list))
+	(name (car list) (car list))
+	(node database)
+	(loose-p nil))
+       ((endp list)
+	(setf (resource-database-value node) value))
+    ;; Key is the first name that isn't *
+    (if (stringable-equal name "*")
+	(setq loose-p t)
+      ;; find the entry associated with name
+      (progn
+	(do ((entry (if loose-p
+			(resource-database-loose node)
+		      (resource-database-tight node))
+		    (cdr entry)))
+	    ((endp entry)
+	     ;; Entry not found - create a new one
+	     (setq entry (make-resource-database-internal :name name))
+	     (if loose-p
+		 (push entry (resource-database-loose node))
+	       (push entry (resource-database-tight node)))
+	     (setq node entry))
+	  (when (stringable-equal name (resource-database-name (car entry)))
+	    ;; Found entry - use it
+	    (return (setq node (car entry)))))
+	(setq loose-p nil)))))
+
+
+(defun delete-resource (database name-list)
+  (declare (type resource-database database)
+	   (type list name-list))
+  (incf-resource-database-timestamp database)
+  (delete-resource-internal database name-list))
+
+(defun delete-resource-internal (database name-list)
+  (declare (type resource-database database)
+	   (type list name-list)) ;; (list stringable)
+  (do* ((list name-list (cdr list))
+	(string (car list) (car list))
+	(node database)
+	(loose-p nil))
+       ((endp list) nil)
+    ;; Key is the first name that isn't *
+    (if (stringable-equal string "*")
+	(setq loose-p t)
+      ;; find the entry associated with name
+      (progn 
+	(do* ((first-entry (if loose-p
+			       (resource-database-loose node)
+			     (resource-database-tight node)))
+	      (entry-list first-entry (cdr entry-list))
+	      (entry (car entry-list) (car entry-list)))
+	     ((endp entry-list)
+	      ;; Entry not found - exit
+	      (return-from delete-resource-internal nil))
+	  (when (stringable-equal string (resource-database-name entry))
+	    (when (cdr list) (delete-resource-internal entry (cdr list)))
+	    (when (and (null (resource-database-loose entry))
+		       (null (resource-database-tight entry)))
+	      (if loose-p
+		  (setf (resource-database-loose node)
+			(delete entry (resource-database-loose node)
+				:test #'eq :count 1))
+		(setf (resource-database-tight node)
+		      (delete entry (resource-database-tight node)
+			      :test #'eq :count 1))))
+	    (return-from delete-resource-internal t)))
+	(setq loose-p nil)))))
+
+;;;-----------------------------------------------------------------------------
+;;; Get Resource
+
+(defun get-resource (database value-name value-class full-name full-class)
+  ;; Return the value of the resource in DATABASE whose partial name
+  ;; most closely matches (append full-name (list value-name)) and
+  ;;                      (append full-class (list value-class)).
+  (declare (type resource-database database)
+	   (type stringable value-name value-class)
+	   (type list full-name full-class)) ;; (list stringable)
+  (declare (values value))
+  (let ((names (append full-name (list value-name)))
+	(classes (append full-class (list value-class))))
+    (let* ((result (get-entry (resource-database-tight database)
+			      (resource-database-loose database)
+			      names classes)))
+      (when result
+	(resource-database-value result)))))
+
+(defun get-entry-lookup (table name names classes)
+  (declare (type list table names classes)
+	   (symbol name))
+  (dolist (entry table)
+    (declare (type resource-database entry))
+    (when (stringable-equal name (resource-database-name entry))
+      (if (null (cdr names))
+	  (return entry)
+	(let ((result (get-entry (resource-database-tight entry)
+				 (resource-database-loose entry)
+				 (cdr names) (cdr classes))))
+	  (declare (type (or null resource-database) result))
+	  (when result
+	    (return result)
+	    ))))))
+
+(defun get-entry (tight loose names classes &aux result)
+  (declare (type list tight loose names classes))
+  (let ((name (car names))
+	(class (car classes)))
+    (declare (type symbol name class))
+    (cond ((and tight
+		(get-entry-lookup tight name names classes)))
+	  ((and loose
+		(get-entry-lookup loose name names classes)))
+	  ((and tight
+		(not (stringable-equal name class))
+		(get-entry-lookup tight class names classes)))
+	  ((and loose
+		(not (stringable-equal name class))
+		(get-entry-lookup loose class names classes)))	
+	  (loose
+	   (loop
+	     (pop names) (pop classes)
+	     (unless (and names classes) (return nil))
+	     (setq name (car names)
+		   class (car classes))
+	     (when (setq result (get-entry-lookup loose name names classes))
+	       (return result))
+	     (when (and (not (stringable-equal name class))
+			(setq result
+			      (get-entry-lookup loose class names classes)))
+	       (return result))
+	     )))))
+
+
+;;;-----------------------------------------------------------------------------
+;;; Get-resource with search-table
+
+(defun get-search-resource (table name class)
+  ;; (get-search-resource (get-search-table database full-name full-class) 
+  ;;                      value-name value-class)
+  ;; is equivalent to 
+  ;; (get-resource database value-name value-class full-name full-class)
+  ;; But since most of the work is done by get-search-table,
+  ;; get-search-resource is MUCH faster when getting several resources with
+  ;; the same full-name/full-class
+  (declare (type list table)
+	   (type stringable name class))
+  (let ((do-class (and class (not (stringable-equal name class)))))
+    (dolist (dbase-list table)
+      (declare (type list dbase-list))
+      (dolist (dbase dbase-list)
+	(declare (type resource-database dbase))
+	(when (stringable-equal name (resource-database-name dbase))
+	  (return-from get-search-resource
+	    (resource-database-value dbase))))
+      (when do-class
+	(dolist (dbase dbase-list)
+	  (declare (type resource-database dbase))
+	  (when (stringable-equal class (resource-database-name dbase))
+	    (return-from get-search-resource
+	      (resource-database-value dbase))))))))
+
+(defvar *get-table-result*)
+
+(defun get-search-table (database full-name full-class)
+  ;; Return a search table for use with get-search-resource.
+  (declare (type resource-database database)
+	   (type list full-name full-class)) ;; (list stringable)
+  (declare (values value))
+  (let* ((tight (resource-database-tight database))
+	 (loose (resource-database-loose database))
+	 (result (cons nil nil))
+	 (*get-table-result* result))
+    (declare (type list tight loose)
+	     (type cons result))
+    (when (or tight loose)
+      (when full-name
+	(get-tables tight loose full-name full-class))
+
+      ;; Pick up bindings of the form (* name). These are the elements of
+      ;; top-level loose without further tight/loose databases.
+      ;;
+      ;; (Hack: these bindings belong in ANY search table, so recomputing them
+      ;; is a drag.  True fix involves redesigning entire lookup
+      ;; data-structure/algorithm.)
+      ;;
+      (let ((universal-bindings
+	      (remove nil loose :test-not #'eq
+		      :key #'(lambda (database)
+			       (or (resource-database-tight database)
+				   (resource-database-loose database))))))
+	(when universal-bindings
+	  (setf (cdr *get-table-result*) (list universal-bindings)))))
+    (cdr result)))
+
+(defun get-tables-lookup (dbase name names classes)
+  (declare (type list dbase names classes)
+	   (type symbol name))
+  (declare (optimize speed))
+  (dolist (entry dbase)
+    (declare (type resource-database entry))
+    (when (stringable-equal name (resource-database-name entry))
+      (let ((tight (resource-database-tight entry))
+	    (loose (resource-database-loose entry)))
+	(declare (type list tight loose))
+	(when (or tight loose)
+	  (if (cdr names)
+	      (get-tables tight loose (cdr names) (cdr classes))
+	    (when tight
+	      (let ((result *get-table-result*))
+		;; Put tight at end of *get-table-result*
+		(setf (cdr result)
+		      (setq *get-table-result* (cons tight nil))))))
+	  (when loose
+	    (let ((result *get-table-result*))
+	      ;; Put loose at end of *get-table-result*
+	      (setf (cdr result)
+		    (setq *get-table-result* (cons loose nil))))))))))
+
+(defun get-tables (tight loose names classes)
+  (declare (type list tight loose names classes))
+  (let ((name (car names))
+	(class (car classes)))
+    (declare (type symbol name class))
+    (when tight
+      (get-tables-lookup tight name names classes))
+    (when loose
+      (get-tables-lookup loose name names classes))
+    (when (and tight (not (stringable-equal name class)))
+      (get-tables-lookup tight class names classes))
+    (when (and loose (not (stringable-equal name class)))
+      (get-tables-lookup loose class names classes))
+    (when loose
+      (loop
+	(pop names) (pop classes)
+	(unless (and names classes) (return nil))
+	(setq name (car names)
+	      class (car classes))
+	(get-tables-lookup loose name names classes)
+	(unless (stringable-equal name class)
+	  (get-tables-lookup loose class names classes))
+	))))
+
+
+;;;-----------------------------------------------------------------------------
+;;; Utility functions
+
+(defun map-resource (database function &rest args)
+  ;; Call FUNCTION on each resource in DATABASE.
+  ;; FUNCTION is called with arguments (name-list value . args)
+  (declare (type resource-database database)
+	   (type (function (list t &rest t) t) function)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent function)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg function)
+	   (dynamic-extent args))
+  (declare (values nil))
+  (labels ((map-resource-internal (database function args name)
+	     (declare (type resource-database database)
+		      (type (function (list t &rest t) t) function)
+		      (type list name)
+		      #+clx-ansi-common-lisp
+		      (dynamic-extent function)
+		      #+(and lispm (not clx-ansi-common-lisp))
+		      (sys:downward-funarg function))		      
+	     (let ((tight (resource-database-tight database))
+		   (loose (resource-database-loose database)))
+	       (declare (type list tight loose))
+	       (dolist (resource tight)
+		 (declare (type resource-database resource))
+		 (let ((value (resource-database-value resource))
+		       (name (append
+			       name
+			       (list (resource-database-name resource)))))
+		   (if value
+		       (apply function name value args)
+		     (map-resource-internal resource function args name))))
+	       (dolist (resource loose)
+		 (declare (type resource-database resource))
+		 (let ((value (resource-database-value resource))
+		       (name (append
+			       name
+			       (list "*" (resource-database-name resource)))))
+		   (if value
+		       (apply function name value args)
+		     (map-resource-internal resource function args name)))))))
+    (map-resource-internal database function args nil)))
+
+(defun merge-resources (database with-database)
+  (declare (type resource-database database with-database))
+  (declare (values resource-database))
+  (map-resource
+    database
+    #'(lambda (name value database)
+	(add-resource database name value))
+    with-database)
+  with-database)
+
+(defun char-memq (key char)
+  ;; Used as a test function for POSITION
+  (declare (type base-char char))
+  (member char key))
+
+(defmacro resource-with-open-file ((stream pathname &rest options) &body body)
+  ;; Private WITH-OPEN-FILE, which, when pathname is a stream, uses it as the
+  ;; stream
+  (let ((abortp (gensym))
+	(streamp (gensym)))
+    `(let* ((,abortp t)
+	    (,streamp (streamp pathname))
+	    (,stream (if ,streamp pathname (open ,pathname ,@options))))
+       (unwind-protect
+	   (multiple-value-prog1
+	     (progn ,@body)
+	     (setq ,abortp nil))
+	 (unless ,streamp
+	   (close stream :abort ,abortp))))))
+
+(defun read-resources (database pathname &key key test test-not)
+  ;; Merges resources from a file in standard X11 format with DATABASE.
+  ;; KEY is a function used for converting value-strings, the default is
+  ;; identity.  TEST and TEST-NOT are predicates used for filtering
+  ;; which resources to include in the database.  They are called with
+  ;; the name and results of the KEY function.
+  (declare (type resource-database database)
+	   (type (or pathname string stream) pathname)
+	   (type (or null (function (string) t)) key)
+	   (type (or null (function (list t) boolean))
+                 test test-not))
+  (declare (values resource-database))
+  (resource-with-open-file (stream pathname)
+    (loop
+      (let ((string (read-line stream nil :eof)))
+	(declare (type (or string keyword) string))
+	(when (eq string :eof) (return database))
+	(let* ((end (length string))
+	       (i (position '(#\tab #\space) string
+			    :test-not #'char-memq :end end))
+	       (term nil))
+	  (declare (type array-index end)
+		   (type (or null array-index) i term))
+	  (when i ;; else blank line
+	    (case (char string i)
+	      (#\! nil)  ;; Comment - skip
+	      (#.(card8->char 0) nil) ;; terminator for C strings - skip
+	      (#\#       ;; Include
+	       (setq term (position '(#\tab #\space) string :test #'char-memq
+				    :start i :end end))
+	       (when (string-equal string "#INCLUDE" :start1 i :end1 term) 
+		 (let ((path (merge-pathnames
+			       (subseq string (1+ term)) (truename stream))))
+		   (read-resources database path
+				   :key key :test test :test-not test-not))))
+	      (otherwise
+	       (multiple-value-bind (name-list value)
+		   (parse-resource string i end)
+		 (when name-list 
+		   (when key (setq value (funcall key value)))
+		   (when
+		     (cond (test (funcall test name-list value))
+			   (test-not (not (funcall test-not name-list value)))
+			   (t t))
+		     (add-resource database name-list value))))))))))))
+
+(defun parse-resource (string &optional (start 0) end)
+  ;; Parse a resource specfication string into a list of names and a value
+  ;; string
+  (declare (type string string)
+	   (type array-index start)
+	   (type (or null array-index) end))
+  (declare (values name-list value))
+  (do ((i start)
+       (end (or end (length string)))
+       (term)
+       (name-list))
+      ((>= i end))
+    (declare (type array-index end)
+	     (type (or null array-index) i term))
+    (setq term (position '(#\. #\* #\:) string
+			 :test #'char-memq :start i :end end))
+    (case (and term (char string term))
+      ;; Name seperator
+      (#\. (when (> term i)
+	     (push (subseq string i term) name-list)))
+      ;; Wildcard seperator
+      (#\* (when (> term i)
+	     (push (subseq string i term) name-list))
+	   (push '* name-list))
+      ;; Value separator
+      (#\:
+       (push (subseq string i term) name-list)
+       (return
+	 (values
+	   (nreverse name-list)
+	   (string-trim '(#\tab #\space) (subseq string (1+ term))))))
+      (otherwise
+	(return
+	  (values
+	    (nreverse name-list)
+	    (subseq string i term)))))
+    (setq i (1+ term))))
+
+(defun write-resources (database pathname &key write test test-not)
+  ;; Write resources to PATHNAME in the standard X11 format.
+  ;; WRITE is a function used for writing values, the default is #'princ
+  ;; TEST and TEST-NOT are predicates used for filtering which resources
+  ;; to include in the database.  They are called with the name and value.
+  (declare (type resource-database database)
+	   (type (or pathname string stream) pathname)
+	   (type (or null (function (string stream) t)) write)
+	   (type (or null (function (list t) boolean))
+                 test test-not))
+  (resource-with-open-file (stream pathname :direction :output)
+    (map-resource
+      database
+      #'(lambda (name-list value stream write test test-not)
+	  (when
+	    (cond (test (funcall test name-list value))
+		  (test-not (not (funcall test-not name-list value)))
+		  (t t))
+	    (let ((previous (car name-list)))
+	      (princ previous stream)
+	      (dolist (name (cdr name-list))
+		(unless (or (stringable-equal name "*")
+			    (stringable-equal previous "*"))
+		  (write-char #\. stream))
+		(setq previous name)
+		(princ name stream)))
+	    (write-string ":	" stream)
+	    (funcall write value stream)
+	    (terpri stream)))
+      stream (or write #'princ) test test-not))
+  database)
+
+(defun wm-resources (database window &key key test test-not)
+  ;; Takes the resources associated with the RESOURCE_MANAGER property
+  ;; of WINDOW (if any) and merges them with DATABASE.
+  ;; KEY is a function used for converting value-strings, the default is
+  ;; identity.  TEST and TEST-NOT are predicates used for filtering
+  ;; which resources to include in the database.  They are called with
+  ;; the name and results of the KEY function.
+  (declare (type resource-database database)
+	   (type window window)
+	   (type (or null (function (string) t)) key)
+	   (type (or null (function (list t) boolean))
+                 test test-not))
+  (declare (values resource-database))
+  (let ((string (get-property window :RESOURCE_MANAGER :type :STRING
+			      :result-type 'string
+			      :transform #'xlib::card8->char)))
+    (when string
+      (with-input-from-string (stream string)
+	(read-resources database stream
+			:key key :test test :test-not test-not)))))
+
+(defun set-wm-resources (database window &key write test test-not)
+  ;; Sets the resources associated with the RESOURCE_MANAGER property
+  ;; of WINDOW.
+  ;; WRITE is a function used for writing values, the default is #'princ
+  ;; TEST and TEST-NOT are predicates used for filtering which resources
+  ;; to include in the database.  They are called with the name and value.
+  (declare (type resource-database database)
+	   (type window window)
+	   (type (or null (function (string stream) t)) write)
+	   (type (or null (function (list t) boolean))
+                 test test-not))
+  (xlib::set-string-property
+    window :RESOURCE_MANAGER
+    (with-output-to-string (stream)
+      (write-resources database stream :write write
+		       :test test :test-not test-not))))
+
+(defun root-resources (screen &key database key test test-not)
+  "Returns a resource database containing the contents of the root window
+   RESOURCE_MANAGER property for the given SCREEN. If SCREEN is a display,
+   then its default screen is used. If an existing DATABASE is given, then
+   resource values are merged with the DATABASE and the modified DATABASE is
+   returned.
+
+   TEST and TEST-NOT are predicates for selecting which resources are
+   read.  Arguments are a resource name list and a resource value. The KEY
+   function, if given, is called to convert a resource value string to the
+   value given to TEST or TEST-NOT."
+
+  (declare (type (or screen display) screen)
+	   (type (or null resource-database) database)
+	   (type (or null (function (string) t)) key)
+	   (type (or null (function (list t) boolean)) test test-not)
+	   (values resource-database))
+  (let* ((screen (if (type? screen 'display)
+		     (display-default-screen screen)
+		   screen))
+	 (window (screen-root screen))
+	 (database (or database (make-resource-database))))
+    (wm-resources database window :key key :test test :test-not test-not)
+    database))
+
+(defun set-root-resources (screen &key test test-not (write 'princ) database)
+  "Changes the contents of the root window RESOURCE_MANAGER property for the
+   given SCREEN. If SCREEN is a display, then its default screen is used. 
+
+   TEST and TEST-NOT are predicates for selecting which resources from the
+   DATABASE are written.  Arguments are a resource name list and a resource
+   value.  The WRITE function is used to convert a resource value into a
+   string stored in the property."
+
+  (declare (type (or screen display) screen)
+	(type (or null resource-database) database)
+	(type (or null (function (list t) boolean)) test test-not)
+	(type (or null (function (string stream) t)) write)
+	(values resource-database))
+  (let* ((screen (if (type? screen 'display)
+		     (display-default-screen screen)
+		   screen))
+	 (window (screen-root screen)))
+    (set-wm-resources database window
+		      :write write :test test :test-not test-not)
+    database))
+
+(defsetf root-resources set-root-resources)
+
+(defun initialize-resource-database (display)
+  ;; This function is (supposed to be) equivalent to the Xlib initialization
+  ;; code.
+  (declare (type display display))
+  (let ((rdb (make-resource-database))
+	(rootwin (screen-root (car (display-roots display)))))
+    ;; First read the server defaults if present, otherwise from the default
+    ;; resource file
+    (if (get-property rootwin :RESOURCE_MANAGER)
+	(wm-resources rdb rootwin)
+      (let ((path (default-resources-pathname)))
+	(when (and path (probe-file path))
+	  (read-resources rdb path))))
+    ;; Next read from the resources file 
+    (let ((path (resources-pathname)))
+      (when (and path (probe-file path))
+	(read-resources rdb path)))
+    (setf (display-xdefaults display) rdb)))
diff --git a/src/clx/sockcl.lsp b/src/clx/sockcl.lsp
new file mode 100644
index 000000000..df0dc7cf4
--- /dev/null
+++ b/src/clx/sockcl.lsp
@@ -0,0 +1,163 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;;; Server Connection for kcl and ibcl
+
+;;; Copyright (C) 1987, 1989 Massachussetts Institute of Technology 
+;;;
+;;; Permission is granted to any individual or institution to use, copy,
+;;; modify, and distribute this software, provided that this complete
+;;; copyright and permission notice is maintained, intact, in all copies and
+;;; supporting documentation.
+;;;
+;;; Massachussetts Institute of Technology provides this software "as is"
+;;; without express or implied warranty.
+;;;
+
+;;; Adapted from code by Roman Budzianowski - Project Athena/MIT
+
+;;; make-two-way-stream is probably not a reasonable thing to do.
+;;; A close on a two way stream probably does not close the substreams.
+;;; I presume an :io will not work (maybe because it uses 1 buffer?).
+;;; There should be some fast io (writes and reads...).
+
+;;; Compile this file with compile-file.
+;;; Load it with (si:faslink "sockcl.o" "socket.o -lc")
+
+(in-package :xlib)
+
+;;; The cmpinclude.h file does not have this type definition from
+;;; <kcldistribution>/h/object.h.  We include it here so the
+;;; compile-file will work without figuring out where the distribution
+;;; directory is located.
+;;;
+(CLINES "
+enum smmode {			/*  stream mode  */
+	smm_input,		/*  input  */
+	smm_output,		/*  output  */
+	smm_io,			/*  input-output  */
+	smm_probe,		/*  probe  */
+	smm_synonym,		/*  synonym  */
+	smm_broadcast,		/*  broadcast  */
+	smm_concatenated,	/*  concatenated  */
+	smm_two_way,		/*  two way  */
+	smm_echo,		/*  echo  */
+	smm_string_input,	/*  string input  */
+	smm_string_output,	/*  string output  */
+	smm_user_defined        /*  for user defined */ 
+};
+")
+
+#-akcl
+(CLINES "
+struct stream {
+	short	t, m;
+	FILE	*sm_fp;		/*  file pointer  */
+	object	sm_object0;	/*  some object  */
+	object	sm_object1;	/*  some object */
+	int	sm_int0;	/*  some int  */
+	int	sm_int1;	/*  some int  */
+	short	sm_mode;	/*  stream mode  */
+				/*  of enum smmode  */
+};
+")
+
+
+;;;; Connect to the server.
+
+;;; A lisp string is not a reasonable type for C, so copy the characters
+;;; out and then call connect_to_server routine defined in socket.o
+
+(CLINES "
+int
+konnect_to_server(host,display)
+     object host;		/* host name */
+     int    display;		/* display number */
+{
+   int fd;			/* file descriptor */
+   int i;
+   char hname[BUFSIZ];
+   FILE *fout, *fin;
+
+   if (host->st.st_fillp > BUFSIZ - 1)
+     too_long_file_name(host);
+   for (i = 0;  i < host->st.st_fillp;  i++)
+     hname[i] = host->st.st_self[i];
+   hname[i] = '\\0';            /* doubled backslash for lisp */
+
+   fd = connect_to_server(hname,display);
+
+   return(fd);
+}
+")
+
+(defentry konnect-to-server (object int) (int "konnect_to_server"))
+
+
+;;;; Make a one-way stream from a file descriptor.
+
+(CLINES "
+object
+konnect_stream(host,fd,flag,elem)
+     object host;		/* not really used */
+     int fd;			/* file descriptor */
+     int flag;			/* 0 input, 1 output */
+     object elem;		/* 'base-char */
+{
+   struct stream *stream;
+   char *mode;			/* file open mode */
+   FILE *fp;			/* file pointer */
+   enum smmode smm;		/* lisp mode (a short) */
+   vs_mark;
+
+   switch(flag){
+    case 0:
+      smm = smm_input;
+      mode = \"r\";
+      break;
+    case 1:
+      smm = smm_output;
+      mode = \"w\";
+      break;
+    default:
+      FEerror(\"konnect_stream : wrong mode\");
+   }
+   
+   fp = fdopen(fd,mode);
+
+   if (fp == NULL) {
+     stream = Cnil;
+     vs_push(stream);
+   } else {
+     stream = alloc_object(t_stream);
+     stream->sm_mode = (short)smm;
+     stream->sm_fp = fp;
+     stream->sm_object0 = elem;
+     stream->sm_object1 = host;
+     stream->sm_int0 = stream->sm_int1 = 0;
+     vs_push(stream);
+     setbuf(fp, stream->sm.sm_buffer = alloc(BUFSIZ));
+   }
+   vs_reset;
+   return(stream);
+}
+")
+
+(defentry konnect-stream (object int int object) (object "konnect_stream"))
+
+
+;;;; Open an X stream
+
+(defun open-socket-stream (host display)
+  (when (not (and (typep host    'string)	; sanity check the arguments
+		  (typep display 'fixnum)))
+    (error "Host ~s or display ~s are bad." host display))
+
+  (let ((fd (konnect-to-server host display)))	; get a file discriptor
+    (if (< fd 0)
+	NIL
+	(let ((stream-in  (konnect-stream host fd 0 'base-char))	; input
+	      (stream-out (konnect-stream host fd 1 'base-char)))	; output
+	  (if (or (null stream-in) (null stream-out))
+	      (error "Could not make i/o streams for fd ~d." fd))
+	  (make-two-way-stream stream-in stream-out))
+	)))
diff --git a/src/clx/socket.c b/src/clx/socket.c
new file mode 100644
index 000000000..76e9b5723
--- /dev/null
+++ b/src/clx/socket.c
@@ -0,0 +1,191 @@
+/* $XConsortium: socket.c,v 1.7 94/04/17 20:40:30 eswu Exp $ */
+/*
+
+Copyright (c) 1988  X Consortium
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR
+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the X Consortium shall
+not be used in advertising or otherwise to promote the sale, use or
+other dealings in this Software without prior written authorization
+from the X Consortium.
+
+*/
+
+/*
+ * THIS IS AN OS DEPENDENT FILE! It should work on 4.2BSD derived
+ * systems.  VMS and System V should plan to have their own version.
+ *
+ * This code was cribbed from lib/X/XConnDis.c.
+ * Compile using   
+ *                    % cc -c socket.c -DUNIXCONN
+ */
+
+#include <stdio.h>
+#include <X11/Xos.h>
+#include <X11/Xproto.h>
+#include <errno.h>
+#include <netinet/in.h>
+#include <sys/ioctl.h>
+#include <netdb.h> 
+#include <sys/socket.h>
+#ifndef hpux
+#include <netinet/tcp.h>
+#endif
+
+extern int errno;		/* Certain (broken) OS's don't have this */
+				/* decl in errno.h */
+
+#ifdef UNIXCONN
+#include <sys/un.h>
+#ifndef X_UNIX_PATH
+#ifdef hpux
+#define X_UNIX_PATH "/usr/spool/sockets/X11/"
+#define OLD_UNIX_PATH "/tmp/.X11-unix/X"
+#else /* hpux */
+#define X_UNIX_PATH "/tmp/.X11-unix/X"
+#endif /* hpux */
+#endif /* X_UNIX_PATH */
+#endif /* UNIXCONN */
+
+#ifndef hpux
+void bcopy();
+#endif /* hpux */
+
+/* 
+ * Attempts to connect to server, given host and display. Returns file 
+ * descriptor (network socket) or 0 if connection fails.
+ */
+
+int connect_to_server (host, display)
+     char *host;
+     int display;
+{
+  struct sockaddr_in inaddr;	/* INET socket address. */
+  struct sockaddr *addr;		/* address to connect to */
+  struct hostent *host_ptr;
+  int addrlen;			/* length of address */
+#ifdef UNIXCONN
+  struct sockaddr_un unaddr;	/* UNIX socket address. */
+#endif
+  extern char *getenv();
+  extern struct hostent *gethostbyname();
+  int fd;				/* Network socket */
+  {
+#ifdef UNIXCONN
+    if ((host[0] == '\0') || (strcmp("unix", host) == 0)) {
+	/* Connect locally using Unix domain. */
+	unaddr.sun_family = AF_UNIX;
+	(void) strcpy(unaddr.sun_path, X_UNIX_PATH);
+	(void) sprintf(&unaddr.sun_path[strlen(unaddr.sun_path)], "%d", display);
+	addr = (struct sockaddr *) &unaddr;
+#ifdef BSD44SOCKETS
+	unaddr.sun_len = strlen(unaddr.sun_path);
+	addrlen = SUN_LEN(&unaddr);
+#else
+	addrlen = strlen(unaddr.sun_path) + 2;
+#endif
+	/*
+	 * Open the network connection.
+	 */
+	if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0) {
+#ifdef hpux /* this is disgusting */  /* cribbed from X11R4 xlib source */
+  	    if (errno == ENOENT) {  /* No such file or directory */
+	      (void) sprintf(unaddr.sun_path, "%s%d", OLD_UNIX_PATH, display);
+              addrlen = strlen(unaddr.sun_path) + 2;
+              if ((fd = socket ((int) addr->sa_family, SOCK_STREAM, 0)) < 0)
+                return(-1);     /* errno set by most recent system call. */
+	    } else 
+#endif /* hpux */
+	    return(-1);	    /* errno set by system call. */
+        }
+    } else 
+#endif /* UNIXCONN */
+    {
+      /* Get the statistics on the specified host. */
+      if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) 
+	{
+	  if ((host_ptr = gethostbyname(host)) == NULL) 
+	    {
+	      /* No such host! */
+	      errno = EINVAL;
+	      return(-1);
+	    }
+	  /* Check the address type for an internet host. */
+	  if (host_ptr->h_addrtype != AF_INET) 
+	    {
+	      /* Not an Internet host! */
+	      errno = EPROTOTYPE;
+	      return(-1);
+	    }
+	  /* Set up the socket data. */
+	  inaddr.sin_family = host_ptr->h_addrtype;
+#ifdef hpux
+	  (void) memcpy((char *)&inaddr.sin_addr, 
+			(char *)host_ptr->h_addr, 
+			sizeof(inaddr.sin_addr));
+#else /* hpux */
+	  (void) bcopy((char *)host_ptr->h_addr, 
+		       (char *)&inaddr.sin_addr, 
+		       sizeof(inaddr.sin_addr));
+#endif /* hpux */
+	} 
+      else 
+	{
+	  inaddr.sin_family = AF_INET;
+	}
+#ifdef BSD44SOCKETS
+      inaddr.sin_len = sizeof(inaddr);
+#endif
+      addr = (struct sockaddr *) &inaddr;
+      addrlen = sizeof (struct sockaddr_in);
+      inaddr.sin_port = display + X_TCP_PORT;
+      inaddr.sin_port = htons(inaddr.sin_port);
+      /*
+       * Open the network connection.
+       */
+      if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0){
+	return(-1);	    /* errno set by system call. */}
+      /* make sure to turn off TCP coalescence */
+#ifdef TCP_NODELAY
+      {
+	int mi = 1;
+	setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
+      }
+#endif
+    }
+
+    /*
+     * Changed 9/89 to retry connection if system call was interrupted.  This
+     * is necessary for multiprocessing implementations that use timers,
+     * since the timer results in a SIGALRM.	-- jdi
+     */
+    while (connect(fd, addr, addrlen) == -1) {
+	if (errno != EINTR) {
+  	    (void) close (fd);
+  	    return(-1); 	    /* errno set by system call. */
+	}
+      }
+  }
+  /*
+   * Return the id if the connection succeeded.
+   */
+  return(fd);
+}
diff --git a/src/clx/text.lsp b/src/clx/text.lsp
new file mode 100644
index 000000000..160799f82
--- /dev/null
+++ b/src/clx/text.lsp
@@ -0,0 +1,1100 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+
+;;; CLX text keyboard and pointer requests
+
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+;; Strings are broken up into chunks of this size
+(defparameter *max-string-size* 254)
+
+;; In the functions below, the transform is used to convert an element of the
+;; sequence into a font index.  The transform is applied to each element of the
+;; (sub)sequence, until either the transform returns nil or the end of the
+;; (sub)sequence is reached.  If transform returns nil for an element, the
+;; index of that element in the sequence is returned, otherwise nil is
+;; returned.
+
+(deftype translation-function ()
+  #+explorer t
+  #-explorer
+  '(function (sequence array-index array-index (or null font) vector array-index)
+	     (values array-index (or null int16 font) (or null int32))))
+
+;; In the functions below, if width is specified, it is assumed to be the pixel
+;; width of whatever string of glyphs is actually drawn.  Specifying width will
+;; allow for appending the output of subsequent calls to the same protocol
+;; request, provided gcontext has not been modified in the interim.  If width
+;; is not specified, appending of subsequent output might not occur.
+;; Specifying width is simply a hint, for performance.  Note that specifying
+;; width may be difficult if transform can return nil.
+
+(defun translate-default (src src-start src-end font dst dst-start)
+  ;; dst is guaranteed to have room for (- src-end src-start) integer elements,
+  ;; starting at dst-start; whether dst holds 8-bit or 16-bit elements depends
+  ;; on context.  font is the current font, if known.  The function should
+  ;; translate as many elements of src as possible into indexes in the current
+  ;; font, and store them into dst.
+  ;;
+  ;; The first return value should be the src index of the first untranslated
+  ;; element.  If no further elements need to be translated, the second return
+  ;; value should be nil.  If a horizontal motion is required before further
+  ;; translation, the second return value should be the delta in x coordinate.
+  ;; If a font change is required for further translation, the second return
+  ;; value should be the new font.  If known, the pixel width of the translated
+  ;; text can be returned as the third value; this can allow for appending of
+  ;; subsequent output to the same protocol request, if no overall width has
+  ;; been specified at the higher level.
+  ;; (returns values: ending-index
+  ;;                  (OR null horizontal-motion font)
+  ;;                  (OR null translated-width))
+  (declare (type sequence src)
+	   (type array-index src-start src-end dst-start)
+	   (type (or null font) font)
+	   (type vector dst)
+	   (inline graphic-char-p))
+  (declare (values integer (or null integer font) (or null integer)))
+  font ;;not used
+  (if (stringp src)
+      (do ((i src-start (index+ i 1))
+	   (j dst-start (index+ j 1))
+	   (char))
+	  ((index>= i src-end)
+	   i)
+	(declare (type array-index i j))
+	(if (graphic-char-p (setq char (char src i)))
+	    #-ecl (setf (aref dst j) (char->card8 char))
+	    #+ecl (if (eq (type-of dst) 'STRING)
+		      (setf (schar dst j) (int-char (char->card8 char)))
+		      (setf (aref dst j) (char->card8 char)))
+	  (return i)))
+      (do ((i src-start (index+ i 1))
+	   (j dst-start (index+ j 1))
+	   (elt))
+	  ((index>= i src-end)
+	   i)
+	(declare (type array-index i j))
+	(setq elt (elt src i))
+	(cond ((and (characterp elt) (graphic-char-p elt))
+	       #-ecl (setf (aref dst j) (char->card8 elt))
+	       #+ecl (if (eq (type-of dst) 'STRING)
+			 (setf (schar dst j) (int-char (char->card8 elt)))
+			 (setf (aref dst j) (char->card8 elt))))
+	      ((integerp elt)
+	       (setf (aref dst j) elt))
+	      (t
+	       (return i))))))
+
+;; There is a question below of whether translate should always be required, or
+;; if not, what the default should be or where it should come from.  For
+;; example, the default could be something that expected a string as src and
+;; translated the CL standard character set to ASCII indexes, and ignored fonts
+;; and bits.  Or the default could expect a string but otherwise be "system
+;; dependent".  Or the default could be something that expected a vector of
+;; integers and did no translation.  Or the default could come from the
+;; gcontext (but what about text-extents and text-width?).
+
+(defun text-extents (font sequence &key (start 0) end translate)
+  ;; If multiple fonts are involved, font-ascent and font-descent will be the
+  ;; maximums.  If multiple directions are involved, the direction will be nil.
+  ;; Translate will always be called with a 16-bit dst buffer.
+  (declare (type sequence sequence)
+	   (type (or font gcontext) font))
+  (declare (type (or null translation-function) translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg #+Genera * #-Genera translate))
+  (declare (values width ascent descent left right
+		  font-ascent font-descent direction
+		  (or null array-index)))
+  (when (type? font 'gcontext)
+    (force-gcontext-changes font)
+    (setq font (gcontext-font font t)))
+  (check-type font font)
+  (let* ((left-bearing 0)
+	 (right-bearing 0)
+	 ;; Sum of widths
+	 (width 0)
+	 (ascent 0)
+	 (descent 0)
+	 (overall-ascent (font-ascent font))
+	 (overall-descent (font-descent font))
+	 (overall-direction (font-direction font))	 
+	 (next-start nil)
+	 (display (font-display font)))
+    (declare (type int16 ascent descent overall-ascent overall-descent)
+	     (type int32 left-bearing right-bearing width)
+	     (type (or null array-index) next-start)
+	     (type display display))
+    (with-display (display)
+      (do* ((wbuf (display-tbuf16 display))
+	    (src-end (or end (length sequence)))
+	    (src-start start (index+ src-start buf-end))
+	    (end (index-min src-end (index+ src-start *buffer-text16-size*))
+		 (index-min src-end (index+ src-start *buffer-text16-size*)))
+	    (buf-end 0)
+	    (new-font)
+	    (font-ascent 0)
+	    (font-descent 0)
+	    (font-direction)
+	    (stop-p nil))
+	   ((or stop-p (index>= src-start src-end))
+	    (when (index< src-start src-end)
+	      (setq next-start src-start)))
+	(declare (type buffer-text16 wbuf)
+		 (type array-index src-start src-end end buf-end)
+		 (type int16 font-ascent font-descent)
+		 (type boolean stop-p))
+	;; Translate the text
+	(multiple-value-setq (buf-end new-font)
+	  (funcall (or translate #'translate-default)
+		   sequence src-start end font wbuf 0))
+	(setq buf-end (- buf-end src-start))
+	(cond ((null new-font) (setq stop-p t))
+	      ((integerp new-font) (incf width (the int32 new-font))))
+	
+	(let (w a d l r)
+	  (if (or (font-char-infos-internal font) (font-local-only-p font))
+	      ;; Calculate text extents locally
+	      (progn
+		(multiple-value-setq (w a d l r)
+		  (text-extents-local font wbuf 0 buf-end nil))
+		(setq font-ascent (the int16 (font-ascent font))
+		      font-descent (the int16 (font-descent font))
+		      font-direction (font-direction font)))
+	    ;; Let the server calculate text extents
+	    (multiple-value-setq
+	      (w a d l r font-ascent font-descent font-direction)
+	      (text-extents-server font wbuf 0 buf-end)))
+	  (incf width (the int32 w))
+	  (cond ((index= src-start start)
+		 (setq left-bearing (the int32 l))
+		 (setq right-bearing (the int32 r))
+		 (setq ascent (the int16 a))
+		 (setq descent (the int16 d)))
+		(t
+		 (setq left-bearing (the int32 (min left-bearing (the int32 l))))
+		 (setq right-bearing (the int32 (max right-bearing (the int32 r))))
+		 (setq ascent (the int16 (max ascent (the int16 a))))
+		 (setq descent (the int16 (max descent (the int16 d)))))))
+
+	(when (type? new-font 'font)
+	  (setq font new-font))
+
+	(setq overall-ascent (the int16 (max overall-ascent font-ascent)))
+	(setq overall-descent (the int16 (max overall-descent font-descent)))
+	(case overall-direction
+	  (:unknown (setq overall-direction font-direction))
+	  (:left-to-right (unless (eq font-direction :left-to-right)
+			    (setq overall-direction nil)))
+	  (:right-to-left (unless (eq font-direction :right-to-left)
+			    (setq overall-direction nil))))))
+    
+    (values width
+	    ascent
+	    descent
+	    left-bearing
+	    right-bearing
+	    overall-ascent
+	    overall-descent
+	    overall-direction
+	    next-start)))
+
+(defun text-width (font sequence &key (start 0) end translate)
+  ;; Translate will always be called with a 16-bit dst buffer.
+  (declare (type sequence sequence)
+	   (type (or font gcontext) font)
+	   (type array-index start)
+	   (type (or null array-index) end))
+  (declare (type (or null translation-function) translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg #+Genera * #-Genera translate))
+  (declare (values integer (or null integer)))
+  (when (type? font 'gcontext)
+    (force-gcontext-changes font)
+    (setq font (gcontext-font font t)))
+  (check-type font font)
+  (let* ((width 0)
+	 (next-start nil)
+	 (display (font-display font)))
+    (declare (type int32 width)
+	     (type (or null array-index) next-start)
+	     (type display display))
+    (with-display (display)
+      (do* ((wbuf (display-tbuf16 display))
+	    (src-end (or end (length sequence)))
+	    (src-start start (index+ src-start buf-end))
+	    (end (index-min src-end (index+ src-start *buffer-text16-size*))
+		 (index-min src-end (index+ src-start *buffer-text16-size*)))
+	    (buf-end 0)
+	    (new-font)
+	    (stop-p nil))
+	   ((or stop-p (index>= src-start src-end))
+	    (when (index< src-start src-end)
+	      (setq next-start src-start)))
+	(declare (type buffer-text16 wbuf)
+		 (type array-index src-start src-end end buf-end)
+		 (type boolean stop-p))
+	;; Translate the text
+	(multiple-value-setq (buf-end new-font)
+	  (funcall (or translate #'translate-default)
+		   sequence src-start end font wbuf 0))
+	(setq buf-end (- buf-end src-start))
+	(cond ((null new-font) (setq stop-p t))
+	      ((integerp new-font) (incf width (the int32 new-font))))
+	
+	(incf width
+	      (if (or (font-char-infos-internal font) (font-local-only-p font))
+		  (text-extents-local font wbuf 0 buf-end :width-only)
+		(text-width-server font wbuf 0 buf-end)))
+	(when (type? new-font 'font)
+	  (setq font new-font))))
+    (values width next-start)))
+
+(defun text-extents-server (font string start end)
+  (declare (type font font)
+	   (type string string)
+	   (type array-index start end))
+  (declare (values width ascent descent left right font-ascent font-descent direction))
+  (let ((display (font-display font))
+	(length (index- end start))
+	(font-id (font-id font)))
+    (declare (type display display)
+	     (type array-index length)
+	     (type resource-id font-id))
+    (with-buffer-request-and-reply (display *x-querytextextents* 28 :sizes (8 16 32))
+	 (((data boolean) (oddp length))
+	  (length (index+ (index-ceiling length 2) 2))
+	  (resource-id font-id)
+	  ((sequence :format char2b :start start :end end :appending t)
+	   string))
+      (values
+	(integer-get 16)
+	(int16-get 12)
+	(int16-get 14)
+	(integer-get 20)
+	(integer-get 24)
+	(int16-get 8)
+	(int16-get 10)
+	(member8-get 1 :left-to-right :right-to-left)))))
+
+(defun text-width-server (font string start end)
+  (declare (type (or font gcontext) font)
+	   (type string string)
+	   (type array-index start end))
+  (declare (values integer))
+  (let ((display (font-display font))
+	(length (index- end start))
+	(font-id (font-id font)))
+    (declare (type display display)
+	     (type array-index length)
+	     (type resource-id font-id))
+    (with-buffer-request-and-reply (display *x-querytextextents* 28 :sizes 32)
+	 (((data boolean) (oddp length))
+	  (length (index+ (index-ceiling length 2) 2))
+	  (resource-id font-id)
+	  ((sequence :format char2b :start start :end end :appending t)
+	   string))
+      (values (integer-get 16)))))
+
+(defun text-extents-local (font sequence start end width-only-p)
+  (declare (type font font)
+	   (type sequence sequence)
+	   (type integer start end)
+	   (type boolean width-only-p))
+  (declare (values width ascent descent overall-left overall-right))
+  (let* ((char-infos (font-char-infos font))
+	 (font-info (font-font-info font)))
+    (declare (type font-info font-info))
+    (declare (type (simple-array int16 (*)) char-infos)
+	     (array-register char-infos))
+    (if (zerop (length char-infos))
+	;; Fixed width font
+	(let* ((font-width (max-char-width font))
+	       (font-ascent (max-char-ascent font))
+	       (font-descent (max-char-descent font))
+	       (width (* (index- end start) font-width)))
+	  (declare (type int16 font-width font-ascent font-descent)
+		   (type int32 width))
+	  (if width-only-p
+	      width
+	    (values width
+		    font-ascent
+		    font-descent
+		    (max-char-left-bearing font)
+		    (+ width (- font-width) (max-char-right-bearing font)))))
+      
+      ;; Variable-width font
+      (let* ((first-col (font-info-min-byte2 font-info))
+	     (num-cols (1+ (- (font-info-max-byte2 font-info) first-col)))
+	     (first-row (font-info-min-byte1 font-info))
+	     (last-row (font-info-max-byte1 font-info))
+	     (num-rows (1+ (- last-row first-row))))
+	(declare (type card8 first-col first-row last-row)
+		 (type card16 num-cols num-rows))
+	(if (or (plusp first-row) (plusp last-row))
+	    
+	    ;; Matrix (16 bit) font
+	    (macrolet ((char-info-elt (sequence elt)
+			 `(let* ((char (the card16 (elt ,sequence ,elt)))
+				 (row (- (ash char -8) first-row))
+				 (col (- (logand char #xff) first-col)))
+			    (declare (type card16 char)
+				     (type int16 row col))
+			    (if (and (< -1 row num-rows) (< -1 col num-cols))
+				(index* 6 (index+ (index* row num-cols) col))
+			      -1))))
+	      (if width-only-p
+		  (do ((i start (index1+ i))
+		       (width 0))
+		      ((index>= i end) width)
+		    (declare (type array-index i)
+			     (type int32 width))
+		    (let ((n (char-info-elt sequence i)))
+		      (declare (type fixnum n))
+		      (unless (minusp n)  ;; Ignore characters not in the font
+			(incf width (the int16 (aref char-infos (index+ 2 n)))))))
+		;; extents
+		(do ((i start (index1+ i))
+		     (width 0)
+		     (ascent #x-7fff)
+		     (descent #x-7fff)
+		     (left #x7fff)
+		     (right #x-7fff))
+		    ((index>= i end)
+		     (values width ascent descent left right))
+		  (declare (type array-index i)
+			   (type int16 ascent descent)
+			   (type int32 width left right))
+		  (let ((n (char-info-elt sequence i)))
+		    (declare (type fixnum n))
+		    (unless (minusp n) ;; Ignore characters not in the font
+		      (setq left (min left (+ width (aref char-infos n))))
+		      (setq right (max right (+ width (aref char-infos (index1+ n)))))
+		      (incf width (aref char-infos (index+ 2 n)))
+		      (setq ascent (max ascent (aref char-infos (index+ 3 n))))
+		      (setq descent (max descent (aref char-infos (index+ 4 n)))))))))
+	  
+	  ;; Non-matrix (8 bit) font
+	  ;; The code here is identical to the above, except for the following macro:
+	  (macrolet ((char-info-elt (sequence elt)
+		       `(let ((col (- (the card16 (elt ,sequence ,elt)) first-col)))
+			  (declare (type int16 col))
+			  (if (< -1 col num-cols)
+			      (index* 6 col)
+			    -1))))
+	    (if width-only-p
+		(do ((i start (index1+ i))
+		     (width 0))
+		    ((index>= i end) width)
+		  (declare (type array-index i)
+			   (type int32 width))
+		  (let ((n (char-info-elt sequence i)))
+		    (declare (type fixnum n))
+		    (unless (minusp n) ;; Ignore characters not in the font
+		      (incf width (the int16 (aref char-infos (index+ 2 n)))))))
+	      ;; extents
+	      (do ((i start (index1+ i))
+		   (width 0)
+		   (ascent #x-7fff)
+		   (descent #x-7fff)
+		   (left #x7fff)
+		   (right #x-7fff))
+		  ((index>= i end)
+		   (values width ascent descent left right))
+		(declare (type array-index i)
+			 (type int16 ascent descent)
+			 (type int32 width left right))
+		(let ((n (char-info-elt sequence i)))
+		  (declare (type fixnum n))
+		  (unless (minusp n) ;; Ignore characters not in the font
+		    (setq left (min left (+ width (aref char-infos n))))
+		    (setq right (max right (+ width (aref char-infos (index1+ n)))))
+		    (incf width (aref char-infos (index+ 2 n)))
+		    (setq ascent (max ascent (aref char-infos (index+ 3 n))))
+		    (setq descent (max descent (aref char-infos (index+ 4 n)))))
+		  ))))
+	  )))))
+
+;;-----------------------------------------------------------------------------
+
+;; This controls the element size of the dst buffer given to translate.  If
+;; :default is specified, the size will be based on the current font, if known,
+;; and otherwise 16 will be used.  [An alternative would be to pass the buffer
+;; size to translate, and allow it to return the desired size if it doesn't
+;; like the current size.  The problem is that the protocol doesn't allow
+;; switching within a single request, so to allow switching would require
+;; knowing the width of text, which isn't necessarily known.  We could call
+;; text-width to compute it, but perhaps that is doing too many favors?]  [An
+;; additional possibility is to allow an index-size of :two-byte, in which case
+;; translate would be given a double-length 8-bit array, and translate would be
+;; expected to store first-byte/second-byte instead of 16-bit integers.]
+
+(deftype index-size () '(member :default 8 16))
+
+;; In the functions below, if width is specified, it is assumed to be the total
+;; pixel width of whatever string of glyphs is actually drawn.  Specifying
+;; width will allow for appending the output of subsequent calls to the same
+;; protocol request, provided gcontext has not been modified in the interim.
+;; If width is not specified, appending of subsequent output might not occur
+;; (unless translate returns the width).  Specifying width is simply a hint,
+;; for performance.
+
+(defun draw-glyph (drawable gcontext x y elt
+		   &key translate width (size :default))
+  ;; Returns true if elt is output, nil if translate refuses to output it.
+  ;; Second result is width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type (or null int32) width)
+	   (type index-size size))
+  (declare (type (or null translation-function) translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg #+Genera * #-Genera translate))
+  (declare (values boolean (or null int32)))
+  (let* ((display (gcontext-display gcontext))
+	 (result t)
+	 (opcode *x-polytext8*))
+    (declare (type display display))
+    (let ((vector (allocate-gcontext-state)))
+      (declare (type gcontext-state vector))
+      (setf (aref vector 0) elt)
+      (multiple-value-bind (new-start new-font translate-width)
+	  (funcall (or translate #'translate-default)
+		   vector 0 1 (gcontext-font gcontext t) vector 1)
+	;; Allow translate to set a new font
+	(when (type? new-font 'font) 
+	  (setf (gcontext-font gcontext) new-font)
+	  (multiple-value-setq (new-start new-font translate-width)
+	    (funcall translate vector 0 1 new-font vector 1)))
+	;; If new-start is zero, translate refuses to output it
+	(setq result (index-plusp new-start)
+	      elt (aref vector 1))
+	(deallocate-gcontext-state vector)
+	(when translate-width (setq width translate-width))))
+    (when result
+      (when (eql size 16)
+	(setq opcode *x-polytext16*)
+	(setq elt (dpb elt (byte 8 8) (ldb (byte 8 8) elt))))
+      (with-buffer-request (display opcode :gc-force gcontext)
+	(drawable drawable)
+	(gcontext gcontext)
+	(int16 x y)
+	(card8 1 0)
+	(card8 (ldb (byte 8 0) elt))
+	(card8 (ldb (byte 8 8) elt)))
+      (values t width))))
+  
+(defun draw-glyphs (drawable gcontext x y sequence
+		    &key (start 0) end translate width (size :default))
+  ;; First result is new start, if end was not reached.  Second result is
+  ;; overall width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type array-index start)
+	   (type sequence sequence)
+	   (type (or null array-index) end)
+	   (type (or null int32) width)
+	   (type index-size size))
+  (declare (type (or null translation-function) translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg #+Genera * #-Genera translate))
+  (declare (values (or null array-index) (or null int32)))
+  (unless end (setq end (length sequence)))
+  (ecase size
+    ((:default 8) (draw-glyphs8 drawable gcontext x y sequence start end
+				(or translate #'translate-default) width))
+    (16 (draw-glyphs16 drawable gcontext x y sequence start end
+		       (or translate #'translate-default) width))))
+
+(defun draw-glyphs8 (drawable gcontext x y sequence start end translate width)
+  ;; First result is new start, if end was not reached.  Second result is
+  ;; overall width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type array-index start)
+	   (type sequence sequence)
+	   (type (or null array-index) end)
+	   (type (or null int32) width))
+  (declare (values (or null array-index) (or null int32)))
+  (declare (type translation-function translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg translate)) 
+  (let* ((src-start start)
+	 (src-end (or end (length sequence)))
+	 (next-start nil)
+	 (length (index- src-end src-start))
+	 (request-length (* length 2))		; Leave lots of room for font shifts.
+	 (display (gcontext-display gcontext))
+	 ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...
+	 (font (gcontext-font gcontext t)))
+    (declare (type array-index src-start src-end length)
+	     #+ecl (fixnum request-length)
+	     (type (or null array-index) next-start)
+	     (type display display))
+    (with-buffer-request (display *x-polytext8* :gc-force gcontext :length request-length)
+      (drawable drawable)
+      (gcontext gcontext)
+      (int16 x y)
+      (progn
+	;; Don't let any flushes happen since we manually set the request
+	;; length when we're done.
+	(with-buffer-flush-inhibited (display)
+	  (do* ((boffset (index+ buffer-boffset 16))
+		(src-chunk 0)
+		(dst-chunk 0)
+		(offset 0)
+		(overall-width 0)
+		(stop-p nil))
+	       ((or stop-p (zerop length))
+		;; Ensure terminated with zero bytes
+		(do ((end (the array-index (lround boffset))))
+		    ((index>= boffset end))
+		  #-ecl (setf (aref buffer-bbuf boffset) 0)
+		  #+ecl (setf (aref-card8 buffer-bbuf boffset) 0)
+		  (index-incf boffset))
+		(length-put 2 (index-ash (index- boffset buffer-boffset) -2))
+		(setf (buffer-boffset display) boffset)
+		(unless (index-zerop length) (setq next-start src-start))
+		(when overall-width (setq width overall-width)))
+
+	    (declare (type array-index src-chunk dst-chunk offset
+			   #+ecl boffset)
+		     (type (or null int32) overall-width)
+		     (type boolean stop-p))
+	    (setq src-chunk (index-min length *max-string-size*))
+	    (multiple-value-bind (new-start new-font translated-width)
+		(funcall translate
+			 sequence src-start (index+ src-start src-chunk)
+			 font buffer-bbuf (index+ boffset 2))
+	      (setq dst-chunk (index- new-start src-start)
+		    length (index- length dst-chunk)
+		    src-start new-start)
+	      (if translated-width
+		  (when overall-width (incf overall-width translated-width))
+		(setq overall-width nil))
+	      (when (index-plusp dst-chunk)
+		#-ecl (setf (aref buffer-bbuf boffset) dst-chunk)
+		#-ecl (setf (aref buffer-bbuf (index+ boffset 1)) offset)
+		#-ecl (incf boffset (index+ dst-chunk 2))
+		#+ecl (setf (aref-card8 buffer-bbuf boffset) dst-chunk)
+		#+ecl (setf (aref-card8 buffer-bbuf (index+ boffset 1)) offset)
+		#+ecl (index-incf boffset (index+ dst-chunk 2)))
+	      (setq offset 0)
+	      (cond ((null new-font)
+		     ;; Don't stop if translate copied whole chunk
+		     (unless (index= src-chunk dst-chunk)
+		       (setq stop-p t)))
+		    ((integerp new-font) (setq offset new-font))
+		    ((type? new-font 'font)
+		     (setq font new-font)
+		     (let ((font-id (font-id font))
+			   (buffer-boffset boffset))
+		       (declare (type resource-id font-id)
+				(type array-index buffer-boffset))
+		       ;; This changes the gcontext font in the server
+		       ;; Update the gcontext cache (both local and server state)
+		       (let ((local-state (gcontext-local-state gcontext))
+			     (server-state (gcontext-server-state gcontext)))
+			 (declare (type gcontext-state local-state server-state))
+			 (setf (gcontext-internal-font-obj server-state) font
+			       (gcontext-internal-font server-state) font-id)
+			 (without-interrupts
+			   (setf (gcontext-internal-font-obj local-state) font
+				 (gcontext-internal-font local-state) font-id)))
+		       (card8-put 0 #xff)
+		       (card8-put 1 (ldb (byte 8 24) font-id))
+		       (card8-put 2 (ldb (byte 8 16) font-id))
+		       (card8-put 3 (ldb (byte 8 8) font-id))
+		       (card8-put 4 (ldb (byte 8 0) font-id)))
+		     (index-incf boffset 5)))
+	      )))))
+    (values next-start width)))
+
+;; NOTE: After the first font change by the TRANSLATE function, characters are no-longer
+;;       on 16bit boundaries and this function garbles the bytes.
+(defun draw-glyphs16 (drawable gcontext x y sequence start end translate width)
+  ;; First result is new start, if end was not reached.  Second result is
+  ;; overall width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type array-index start)
+	   (type sequence sequence)
+	   (type (or null array-index) end)
+	   (type (or null int32) width))
+  (declare (values (or null array-index) (or null int32)))
+  (declare (type translation-function translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg translate))
+  (let* ((src-start start)
+	 (src-end (or end (length sequence)))
+	 (next-start nil)
+	 (length (index- src-end src-start))
+	 (request-length (* length 3))		; Leave lots of room for font shifts.
+	 (display (gcontext-display gcontext))
+	 ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...
+	 (font (gcontext-font gcontext t))
+	 (buffer (display-tbuf16 display)))
+    (declare (type array-index src-start src-end length)
+	     (type (or null array-index) next-start)
+	     (type display display)
+	     (type buffer-text16 buffer))
+    (with-buffer-request (display *x-polytext16* :gc-force gcontext :length request-length)
+      (drawable drawable)
+      (gcontext gcontext)
+      (int16 x y)
+      (progn
+	;; Don't let any flushes happen since we manually set the request
+	;; length when we're done.
+	(with-buffer-flush-inhibited (display)
+	  (do* ((boffset (index+ buffer-boffset 16))
+		(src-chunk 0)
+		(dst-chunk 0)
+		(offset 0)
+		(overall-width 0)
+		(stop-p nil))
+	       ((or stop-p (zerop length))
+		;; Ensure terminated with zero bytes
+		(do ((end (lround boffset)))
+		    ((index>= boffset end))
+		  #-ecl (setf (aref buffer-bbuf boffset) 0)
+		  #+ecl (setf (aref-card8 buffer-bbuf boffset) 0)
+		  (index-incf boffset))
+		(length-put 2 (index-ash (index- boffset buffer-boffset) -2))
+		(setf (buffer-boffset display) boffset)
+		(unless (zerop length) (setq next-start src-start))
+		(when overall-width (setq width overall-width)))
+
+	    (declare (type array-index boffset src-chunk dst-chunk offset)
+		     (type (or null int32) overall-width)
+		     (type boolean stop-p))
+	    (setq src-chunk (index-min length *max-string-size*))
+	    (multiple-value-bind (new-start new-font translated-width)
+		(funcall translate
+			 sequence src-start (index+ src-start src-chunk)
+			 font buffer 0)
+	      (setq dst-chunk (index- new-start src-start)
+		    length (index- length dst-chunk)
+		    src-start new-start)
+	      (write-sequence-char2b display (index+ boffset 2) buffer 0 dst-chunk)
+	      (if translated-width
+		  (when overall-width (incf overall-width translated-width))
+		(setq overall-width nil))
+	      (when (index-plusp dst-chunk)
+		#-ecl (setf (aref buffer-bbuf boffset) dst-chunk)
+		#-ecl (setf (aref buffer-bbuf (index+ boffset 1)) offset)
+		#+ecl (setf (aref-card8 buffer-bbuf boffset) dst-chunk)
+		#+ecl (setf (aref-card8 buffer-bbuf (index+ boffset 1)) offset)
+		(index-incf boffset (index+ dst-chunk dst-chunk 2)))
+	      (setq offset 0)
+	      (cond ((null new-font)
+		     ;; Don't stop if translate copied whole chunk
+		     (unless (index= src-chunk dst-chunk) 
+		       (setq stop-p t)))
+		    ((integerp new-font) (setq offset new-font))
+		    ((type? new-font 'font)
+		     (setq font new-font)
+		     (let ((font-id (font-id font))
+			   (buffer-boffset boffset))
+		       (declare (type resource-id font-id)
+				(type array-index buffer-boffset))
+		       ;; This changes the gcontext font in the SERVER
+		       ;; Update the gcontext cache (both local and server state)
+		       (let ((local-state (gcontext-local-state gcontext))
+			     (server-state (gcontext-server-state gcontext)))
+			 (declare (type gcontext-state local-state server-state))
+			 (setf (gcontext-internal-font-obj server-state) font
+			       (gcontext-internal-font server-state) font-id)
+			 (without-interrupts
+			   (setf (gcontext-internal-font-obj local-state) font
+				 (gcontext-internal-font local-state) font-id)))
+		       (card8-put 0 #xff)
+		       (card8-put 1 (ldb (byte 8 24) font-id))
+		       (card8-put 2 (ldb (byte 8 16) font-id))
+		       (card8-put 3 (ldb (byte 8 8) font-id))
+		       (card8-put 4 (ldb (byte 8 0) font-id)))
+		     (index-incf boffset 5)))
+	      )))))
+    (values next-start width)))
+
+(defun draw-image-glyph (drawable gcontext x y elt
+			 &key translate width (size :default))
+  ;; Returns true if elt is output, nil if translate refuses to output it.
+  ;; Second result is overall width, if known.  An initial font change is
+  ;; allowed from translate.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type (or null int32) width)
+	   (type index-size size))
+  (declare (type (or null translation-function) translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg #+Genera * #-Genera translate))
+  (declare (values boolean (or null int32)))
+  (let* ((display (gcontext-display gcontext))
+	 (result t)
+	 (opcode *x-imagetext8*))
+    (declare (type display display))
+    (let ((vector (allocate-gcontext-state)))
+      (declare (type gcontext-state vector))
+      (setf (aref vector 0) elt)
+      (multiple-value-bind (new-start new-font translate-width)
+	  (funcall (or translate #'translate-default)
+		   vector 0 1 (gcontext-font gcontext t) vector 1)
+	;; Allow translate to set a new font
+	(when (type? new-font 'font) 
+	  (setf (gcontext-font gcontext) new-font)
+	  (multiple-value-setq (new-start new-font translate-width)
+	    (funcall translate vector 0 1 new-font vector 1)))
+	;; If new-start is zero, translate refuses to output it
+	(setq result (index-plusp new-start)
+	      elt (aref vector 1))
+	(deallocate-gcontext-state vector)
+	(when translate-width (setq width translate-width))))
+    (when result
+      (when (eql size 16)
+	(setq opcode *x-imagetext16*)
+	(setq elt (dpb elt (byte 8 8) (ldb (byte 8 8) elt))))
+      (with-buffer-request (display opcode :gc-force gcontext)
+	(drawable drawable)
+	(gcontext gcontext)
+	(data 1) ;; 1 character
+	(int16 x y)
+	(card8 (ldb (byte 8 0) elt))
+	(card8 (ldb (byte 8 8) elt)))
+      (values t width))))
+
+(defun draw-image-glyphs (drawable gcontext x y sequence
+			  &key (start 0) end translate width (size :default))
+  ;; An initial font change is allowed from translate, but any subsequent font
+  ;; change or horizontal motion will cause termination (because the protocol
+  ;; doesn't support chaining).  [Alternatively, font changes could be accepted
+  ;; as long as they are accompanied with a width return value, or always
+  ;; accept font changes and call text-width as required.  However, horizontal
+  ;; motion can't really be accepted, due to semantics.]  First result is new
+  ;; start, if end was not reached.  Second result is overall width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type array-index start)
+	   (type (or null array-index) end)
+	   (type sequence sequence)
+	   (type (or null int32) width)
+	   (type index-size size))
+  (declare (type (or null translation-function) translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg #+Genera * #-Genera translate))
+  (declare (values (or null array-index) (or null int32)))
+  (setf end (index-min (index+ start 255) (or end (length sequence))))
+  (ecase size
+    ((:default 8)
+     (draw-image-glyphs8 drawable gcontext x y sequence start end translate width))
+    (16
+     (draw-image-glyphs16 drawable gcontext x y sequence start end translate width))))
+
+(defun draw-image-glyphs8 (drawable gcontext x y sequence start end translate width)
+  ;; An initial font change is allowed from translate, but any subsequent font
+  ;; change or horizontal motion will cause termination (because the protocol
+  ;; doesn't support chaining).  [Alternatively, font changes could be accepted
+  ;; as long as they are accompanied with a width return value, or always
+  ;; accept font changes and call text-width as required.  However, horizontal
+  ;; motion can't really be accepted, due to semantics.]  First result is new
+  ;; start, if end was not reached.  Second result is overall width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type array-index start)
+	   (type sequence sequence)
+	   (type (or null array-index) end)
+	   (type (or null int32) width)) 
+  (declare (type (or null translation-function) translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg translate))
+  (declare (values (or null array-index) (or null int32)))
+  (do* ((display (gcontext-display gcontext))
+	(length (index- end start))
+	;; Should metrics-p be T?  Don't want to pass a NIL font into translate...
+	(font (gcontext-font gcontext t))
+	(font-change nil)
+	(new-start) (translated-width) (chunk))
+       (nil) ;; forever
+    (declare (type display display)
+	     (type array-index length)
+	     (type (or null array-index) new-start chunk))
+    
+    (when font-change
+      (setf (gcontext-font gcontext) font))
+    (block change-font
+      (with-buffer-request (display *x-imagetext8* :gc-force gcontext :length length)
+	(drawable drawable)
+	(gcontext gcontext)
+	(int16 x y)
+	(progn
+	  ;; Don't let any flushes happen since we manually set the request
+	  ;; length when we're done.
+	  (with-buffer-flush-inhibited (display)
+	    ;; Translate the sequence into the buffer
+	    (multiple-value-setq (new-start font translated-width)
+	      (funcall (or translate #'translate-default) sequence start end
+		       font buffer-bbuf (index+ buffer-boffset 16)))
+	    ;; Number of glyphs translated
+	    (setq chunk (index- new-start start))		
+	    ;; Check for initial font change
+	    (when (and (index-zerop chunk) (type? font 'font))
+	      (setq font-change t) ;; Loop around changing font
+	      (return-from change-font))
+	    ;; Quit when nothing translated
+	    (when (index-zerop chunk)
+	      (return-from draw-image-glyphs8 new-start))
+	    ;; Update buffer pointers
+	    (data-put 1 chunk)
+	    (let ((blen (lround (index+ 16 chunk))))
+	      (length-put 2 (index-ash blen -2))
+	      (setf (buffer-boffset display) (index+ buffer-boffset blen))))))
+      ;; Normal exit
+      (return-from draw-image-glyphs8
+	(values (if (index= chunk length) nil new-start)
+		(or translated-width width))))))
+
+(defun draw-image-glyphs16 (drawable gcontext x y sequence start end translate width)
+  ;; An initial font change is allowed from translate, but any subsequent font
+  ;; change or horizontal motion will cause termination (because the protocol
+  ;; doesn't support chaining).  [Alternatively, font changes could be accepted
+  ;; as long as they are accompanied with a width return value, or always
+  ;; accept font changes and call text-width as required.  However, horizontal
+  ;; motion can't really be accepted, due to semantics.]  First result is new
+  ;; start, if end was not reached.  Second result is overall width, if known.
+  (declare (type drawable drawable)
+	   (type gcontext gcontext)
+	   (type int16 x y)
+	   (type array-index start)
+	   (type sequence sequence)
+	   (type (or null array-index) end)
+	   (type (or null int32) width))
+  (declare (type (or null translation-function) translate)
+	   #+clx-ansi-common-lisp
+	   (dynamic-extent translate)
+	   #+(and lispm (not clx-ansi-common-lisp))
+	   (sys:downward-funarg translate))
+  (declare (values (or null array-index) (or null int32)))
+  (do* ((display (gcontext-display gcontext))
+	(length (index- end start))
+	;; Should metrics-p be T?  Don't want to pass a NIL font into translate...
+	(font (gcontext-font gcontext t)) 
+	(font-change nil)
+	(new-start) (translated-width) (chunk)
+	(buffer (buffer-tbuf16 display)))
+       (nil) ;; forever
+    
+    (declare (type display display)
+	     (type array-index length)
+	     (type (or null array-index) new-start chunk)
+	     (type buffer-text16 buffer))
+    (when font-change
+      (setf (gcontext-font gcontext) font))
+
+    (block change-font
+      (with-buffer-request (display *x-imagetext16* :gc-force gcontext :length length)
+	(drawable drawable)
+	(gcontext gcontext)
+	(int16 x y)
+	(progn
+	  ;; Don't let any flushes happen since we manually set the request
+	  ;; length when we're done.
+	  (with-buffer-flush-inhibited (display)
+	    ;; Translate the sequence into the buffer
+	    (multiple-value-setq (new-start font translated-width)
+	      (funcall (or translate #'translate-default) sequence start end
+		       font buffer 0))
+	    ;; Number of glyphs translated
+	    (setq chunk (index- new-start start))
+	    ;; Check for initial font change
+	    (when (and (index-zerop chunk) (type? font 'font))
+	      (setq font-change t) ;; Loop around changing font
+	      (return-from change-font))
+	    ;; Quit when nothing translated
+	    (when (index-zerop chunk)
+	      (return-from draw-image-glyphs16 new-start))
+	    (write-sequence-char2b display (index+ buffer-boffset 16) buffer 0 chunk)
+	    ;; Update buffer pointers
+	    (data-put 1 chunk)
+	    (let ((blen (lround (index+ 16 (index-ash chunk 1)))))
+	      (length-put 2 (index-ash blen -2))
+	      (setf (buffer-boffset display) (index+ buffer-boffset blen))))))
+      ;; Normal exit
+      (return-from draw-image-glyphs16
+	(values (if (index= chunk length) nil new-start)
+		(or translated-width width))))))
+
+
+;;-----------------------------------------------------------------------------
+
+(defun display-keycode-range (display)
+  (declare (type display display))
+  (declare (values min max))
+  (values (display-min-keycode display)
+	  (display-max-keycode display)))
+
+;; Should this signal device-busy like the pointer-mapping setf, and return a
+;; boolean instead (true for success)?  Alternatively, should the
+;; pointer-mapping setf be changed to set-pointer-mapping with a (member
+;; :success :busy) result?
+
+(defun set-modifier-mapping (display &key shift lock control mod1 mod2 mod3 mod4 mod5)
+  ;; Setf ought to allow multiple values.
+  (declare (type display display)
+	   (type sequence shift lock control mod1 mod2 mod3 mod4 mod5))
+  (declare (values (member :success :busy :failed)))
+  (let* ((keycodes-per-modifier (index-max (length shift)
+					   (length lock)
+					   (length control)
+					   (length mod1)
+					   (length mod2)
+					   (length mod3)
+					   (length mod4)
+					   (length mod5)))
+	 (data (make-array (index* 8 keycodes-per-modifier)
+			   :element-type 'card8
+			   :initial-element 0)))
+    (replace data shift)
+    (replace data lock :start1 keycodes-per-modifier)
+    (replace data control :start1 (index* 2 keycodes-per-modifier))
+    (replace data mod1 :start1 (index* 3 keycodes-per-modifier))
+    (replace data mod2 :start1 (index* 4 keycodes-per-modifier))
+    (replace data mod3 :start1 (index* 5 keycodes-per-modifier))
+    (replace data mod4 :start1 (index* 6 keycodes-per-modifier))
+    (replace data mod5 :start1 (index* 7 keycodes-per-modifier))
+    (with-buffer-request-and-reply (display *x-setmodifiermapping* 4 :sizes 8)
+	 ((data keycodes-per-modifier)
+	  ((sequence :format card8) data))
+      (values (member8-get 1 :success :busy :failed)))))
+
+(defun modifier-mapping (display)
+  ;; each value is a list of integers
+  (declare (type display display))
+  (declare (values shift lock control mod1 mod2 mod3 mod4 mod5))
+  (let ((lists nil))
+    (with-buffer-request-and-reply (display *x-getmodifiermapping* nil :sizes 8)
+	 ()
+      (do* ((keycodes-per-modifier (card8-get 1))
+	    (advance-by *replysize* keycodes-per-modifier)
+	    (keys nil nil)
+	    (i 0 (index+ i 1)))
+	   ((index= i 8))
+	(advance-buffer-offset advance-by)
+	(dotimes (j keycodes-per-modifier)
+	  (let ((key (read-card8 j)))
+	    (unless (zerop key)
+	      (push key keys))))
+	(push (nreverse keys) lists)))
+    (values-list (nreverse lists))))
+
+;; Either we will want lots of defconstants for well-known values, or perhaps
+;; an integer-to-keyword translation function for well-known values.
+
+(defun change-keyboard-mapping
+       (display keysyms &key (start 0) end (first-keycode start))
+  ;; start/end give subrange of keysyms
+  ;; first-keycode is the first-keycode to store at
+  (declare (type display display)
+	   (type array-index start)
+	   (type card8 first-keycode)
+	   (type (or null array-index) end)
+	   (type (array * (* *)) keysyms))
+  (let* ((keycode-end (or end (array-dimension keysyms 0)))
+	 (keysyms-per-keycode (array-dimension keysyms 1))
+	 (length (index- keycode-end start))
+	 (size (index* length keysyms-per-keycode))
+	 (request-length (index+ size 2)))
+    (declare (type array-index keycode-end keysyms-per-keycode length request-length))
+    (with-buffer-request (display *x-setkeyboardmapping*
+				  :length (index-ash request-length 2)
+				  :sizes (32))
+      (data length)
+      (length request-length)
+      (card8 first-keycode keysyms-per-keycode)
+      (progn
+	(do ((limit (index-ash (buffer-size display) -2))
+	     (w (index+ 2 (index-ash buffer-boffset -2)))
+	     (i start (index+ i 1)))
+	    ((index>= i keycode-end)
+	     (setf (buffer-boffset display) (index-ash w 2)))
+	  (declare (type array-index limit w i))
+	  (when (index> w limit)
+	    (buffer-flush display)
+	    (setq w (index-ash (buffer-boffset display) -2)))
+	  (do ((j 0 (index+ j 1)))
+	      ((index>= j keysyms-per-keycode))
+	    (declare (type array-index j))
+	    (card29-put (index* w 4) (aref keysyms i j))
+	    (index-incf w))))))) 
+
+(defun keyboard-mapping (display &key first-keycode start end data)
+  ;; First-keycode specifies which keycode to start at (defaults to min-keycode).
+  ;; Start specifies where (in result) to put first-keycode. (defaults to first-keycode)
+  ;; (- end start) is the number of keycodes to get. (End defaults to (1+ max-keycode)).
+  ;; If DATA is specified, the results are put there.
+  (declare (type display display)
+	   (type (or null card8) first-keycode)
+	   (type (or null array-index) start end)
+	   (type (or null (array * (* *))) data))
+  (declare (values (array * (* *))))
+  (unless first-keycode (setq first-keycode (display-min-keycode display)))
+  (unless start (setq start first-keycode))
+  (unless end (setq end (1+ (display-max-keycode display))))
+  (with-buffer-request-and-reply (display *x-getkeyboardmapping* nil :sizes (8 32))
+       ((card8 first-keycode (index- end start)))
+    (do* ((keysyms-per-keycode (card8-get 1))
+	  (bytes-per-keycode (* keysyms-per-keycode 4))
+	  (advance-by *replysize* bytes-per-keycode)
+	  (keycode-count (floor (card32-get 4) keysyms-per-keycode)
+			 (index- keycode-count 1))
+	  (result (if (and (arrayp data)
+			   (= (array-rank data) 2)
+			   (>= (array-dimension data 0) (index+ start keycode-count))
+			   (>= (array-dimension data 1) keysyms-per-keycode))
+		      data
+		    (make-array `(,(index+ start keycode-count) ,keysyms-per-keycode)
+				:element-type 'keysym :initial-element 0)))
+	  (i start (1+ i)))
+	 ((zerop keycode-count) (setq data result))
+      (advance-buffer-offset advance-by)
+      (dotimes (j keysyms-per-keycode)
+	(setf (aref result i j) (card29-get (* j 4))))))
+  data)
diff --git a/src/clx/translate.lsp b/src/clx/translate.lsp
new file mode 100644
index 000000000..80accba6a
--- /dev/null
+++ b/src/clx/translate.lsp
@@ -0,0 +1,566 @@
+;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:YES -*-
+
+;;;(c) Copyright Enhancements by Giuseppe Attardi, 1994.
+;;;
+;;;			 TEXAS INSTRUMENTS INCORPORATED
+;;;				  P.O. BOX 2909
+;;;			       AUSTIN, TEXAS 78769
+;;;
+;;; Copyright (C) 1987 Texas Instruments Incorporated.
+;;;
+;;; Permission is granted to any individual or institution to use, copy, modify,
+;;; and distribute this software, provided that this complete copyright and
+;;; permission notice is maintained, intact, in all copies and supporting
+;;; documentation.
+;;;
+;;; Texas Instruments Incorporated provides this software "as is" without
+;;; express or implied warranty.
+;;;
+
+(in-package :xlib)
+
+(defvar *keysym-sets* nil) ;; Alist of (name first-keysym last-keysym)
+
+(defun define-keysym-set (set first-keysym last-keysym)
+  ;; Define all keysyms from first-keysym up to and including
+  ;; last-keysym to be in SET (returned from the keysym-set function).
+  ;; Signals an error if the keysym range overlaps an existing set.
+ (declare (type keyword set)
+	  (type keysym first-keysym last-keysym))
+  (when (> first-keysym last-keysym)
+    (rotatef first-keysym last-keysym))
+  (setq *keysym-sets* (delete set *keysym-sets* :key #'car))
+  (dolist (set *keysym-sets*)
+    (let ((first (second set))
+	  (last (third set)))
+      (when (or (<= first first-keysym last)
+		(<= first last-keysym last))
+	(error "Keysym range overlaps existing set ~s" set))))
+  (push (list set first-keysym last-keysym) *keysym-sets*)
+  set)
+
+(defun keysym-set (keysym)
+  ;; Return the character code set name of keysym
+  (declare (type keysym keysym)
+	   (values keyword))
+  (dolist (set *keysym-sets*)
+    (let ((first (second set))
+	  (last (third set)))
+      (when (<= first keysym last)
+	(return (first set))))))
+
+(eval-when (compile eval load) ;; Required for Vaxlisp ...
+(defmacro keysym (keysym &rest bytes)
+  ;; Build a keysym.
+  ;; If KEYSYM is an integer, it is used as the most significant bits of
+  ;; the keysym, and BYTES are used to specify low order bytes. The last
+  ;; parameter is always byte4 of the keysym.  If KEYSYM is not an
+  ;; integer, the keysym associated with KEYSYM is returned.
+  ;;
+  ;; This is a macro and not a function macro to promote compile-time
+  ;; lookup. All arguments are evaluated.
+  (declare (type t keysym)
+	   (type list bytes)
+	   (values keysym))
+  (typecase keysym
+    ((integer 0 *)
+     (dolist (b bytes keysym) (setq keysym (+ (ash keysym 8) b))))
+    (otherwise
+     (or (car (character->keysyms keysym))
+	 (error "~s Isn't the name of a keysym" keysym)))))
+)
+
+(defvar *keysym->character-map*
+	(make-hash-table :test (keysym->character-map-test) :size 400))
+
+;; Keysym-mappings are a list of the form (object translate lowercase modifiers mask)
+;; With the following accessor macros. Everything after OBJECT is optional.
+
+(defmacro keysym-mapping-object (keysym-mapping)
+  ;; Parameter to translate
+  `(first ,keysym-mapping))
+
+(defmacro keysym-mapping-translate (keysym-mapping)
+  ;; Function to be called with parameters (display state OBJECT)
+  ;; when translating KEYSYM and modifiers and mask are satisfied.
+  `(second ,keysym-mapping))
+
+(defmacro keysym-mapping-lowercase (keysym-mapping)
+  ;; LOWERCASE is used for uppercase alphabetic keysyms.  The value
+  ;; is the associated lowercase keysym.
+  `(third ,keysym-mapping))
+
+(defmacro keysym-mapping-modifiers (keysym-mapping)
+  ;; MODIFIERS is either a modifier-mask or list containing intermixed
+  ;; keysyms and state-mask-keys specifying when to use this
+  ;; keysym-translation.
+  `(fourth ,keysym-mapping))
+
+(defmacro keysym-mapping-mask (keysym-mapping)
+  ;; MASK is either a modifier-mask or list containing intermixed
+  ;; keysyms and state-mask-keys specifying which modifiers to look at
+  ;; (i.e.  modifiers not specified are don't-cares)
+  `(fifth ,keysym-mapping))
+
+(defvar *default-keysym-translate-mask*
+	(the (or (member :modifiers) mask16 list)	; (list (or keysym state-mask-key))
+	     (logand #xff (lognot (make-state-mask :lock))))
+  "Default keysym state mask to use during keysym-translation.")
+
+(defun define-keysym (object keysym &key lowercase translate modifiers mask display)	              
+  ;; Define the translation from keysym/modifiers to a (usually
+  ;; character) object.  ANy previous keysym definition with
+  ;; KEYSYM and MODIFIERS is deleted before adding the new definition.
+  ;;
+  ;; MODIFIERS is either a modifier-mask or list containing intermixed
+  ;; keysyms and state-mask-keys specifying when to use this
+  ;; keysym-translation.  The default is NIL.
+  ;;
+  ;; MASK is either a modifier-mask or list containing intermixed
+  ;; keysyms and state-mask-keys specifying which modifiers to look at
+  ;; (i.e.  modifiers not specified are don't-cares).
+  ;; If mask is :MODIFIERS then the mask is the same as the modifiers
+  ;; (i.e.  modifiers not specified by modifiers are don't cares)
+  ;; The default mask is *default-keysym-translate-mask*
+  ;;
+  ;; If DISPLAY is specified, the translation will be local to DISPLAY,
+  ;; otherwise it will be the default translation for all displays.
+  ;;
+  ;; LOWERCASE is used for uppercase alphabetic keysyms.  The value
+  ;; is the associated lowercase keysym.  This information is used
+  ;; by the keysym-both-case-p predicate (for caps-lock computations)
+  ;; and by the keysym-downcase function.
+  ;;
+  ;; TRANSLATE will be called with parameters (display state OBJECT)
+  ;; when translating KEYSYM and modifiers and mask are satisfied.
+  ;; [e.g (zerop (logxor (logand state (or mask *default-keysym-translate-mask*))
+  ;;                     (or modifiers 0)))
+  ;;      when mask and modifiers aren't lists of keysyms]
+  ;; The default is #'default-keysym-translate
+  ;;
+  (declare (type (or base-char t) object)
+	   (type keysym keysym)
+	   (type (or null mask16 list) ;; (list (or keysym state-mask-key))
+	         modifiers)
+	   (type (or null (member :modifiers) mask16 list) ;; (list (or keysym state-mask-key))
+	         mask)
+	   (type (or null display) display)
+           (type (or null keysym) lowercase)
+	   (type (function (display card16 t) t) translate))
+  (flet ((merge-keysym-mappings (new old)
+	   ;; Merge new keysym-mapping with list of old mappings.
+	   ;; Ensure that the mapping with no modifiers or mask comes first.
+	   (let* ((key (keysym-mapping-modifiers new))
+		  (merge (delete key old :key #'cadddr :test #'equal)))
+	     (if key
+		 (nconc merge (list new))
+	       (cons new merge))))
+	 (mask-check (mask)
+	   (unless (or (numberp mask)
+		       (dolist (element mask t)
+			 (unless (or (find element *state-mask-vector*)
+				     (gethash element *keysym->character-map*))
+			   (return nil))))
+	     (x-type-error mask '(or mask16 (list (or modifier-key modifier-keysym)))))))
+    (let ((entry
+	    ;; Create with a single LIST call, to ensure cdr-coding
+	    (cond
+	      (mask
+	       (unless (eq mask :modifiers)
+		 (mask-check mask))
+	       (when (or (null modifiers) (and (numberp modifiers) (zerop modifiers)))
+		 (error "Mask with no modifiers"))
+	       (list object translate lowercase modifiers mask))
+	      (modifiers (mask-check modifiers)
+			 (list object translate lowercase modifiers))
+	      (lowercase	(list object translate lowercase))
+	      (translate	(list object translate))
+	      (t	(list object)))))
+      (if display
+	  (let ((previous (assoc keysym (display-keysym-translation display))))
+	    (if previous
+		(setf (cdr previous) (merge-keysym-mappings entry (cdr previous)))
+	      (push (list keysym entry) (display-keysym-translation display))))
+	(setf (gethash keysym *keysym->character-map*)
+	      (merge-keysym-mappings entry (gethash keysym *keysym->character-map*)))))
+    object))
+
+(defun undefine-keysym (object keysym &key display modifiers &allow-other-keys)	              
+  ;; Undefine the keysym-translation translating KEYSYM to OBJECT with MODIFIERS.
+  ;; If DISPLAY is non-nil, undefine the translation for DISPLAY if it exists.
+  (declare (type (or base-char t) object)
+	   (type keysym keysym)
+	   (type (or null mask16 list) ;; (list (or keysym state-mask-key))
+	         modifiers)
+	   (type (or null display) display))
+  (flet ((match (key entry)
+	   (let ((object (car key))
+		 (modifiers (cdr key)))
+	     (or (eql object (keysym-mapping-object entry))
+		 (equal modifiers (keysym-mapping-modifiers entry))))))
+    (let* (entry
+	   (previous (if display
+			 (cdr (setq entry (assoc keysym (display-keysym-translation display))))
+		       (gethash keysym *keysym->character-map*)))
+	   (key (cons object modifiers)))
+      (when (and previous (find key previous :test #'match))
+	(setq previous (delete key previous :test #'match))
+	(if display
+	    (setf (cdr entry) previous)
+	  (setf (gethash keysym *keysym->character-map*) previous))))))
+
+(defun keysym-downcase (keysym)
+  ;; If keysym has a lower-case equivalent, return it, otherwise return keysym.
+  (declare (type keysym keysym))
+  (declare (values keysym))
+  (let ((translations (gethash keysym *keysym->character-map*)))
+    (or (and translations (keysym-mapping-lowercase (first translations))) keysym)))
+
+(defun keysym-uppercase-alphabetic-p (keysym)
+  ;; Returns T if keysym is uppercase-alphabetic.
+  ;; I.E. If it has a lowercase equivalent.
+  (declare (type keysym keysym))
+  (declare (values (or null keysym)))
+  (let ((translations (gethash keysym *keysym->character-map*)))
+    (and translations
+	 (keysym-mapping-lowercase (first translations)))))
+
+(defun character->keysyms (character &optional display)
+  ;; Given a character, return a list of all matching keysyms.
+  ;; If DISPLAY is given, translations specific to DISPLAY are used,
+  ;; otherwise only global translations are used.
+  ;; Implementation dependent function.
+  ;; May be slow [i.e. do a linear search over all known keysyms]
+  (declare (type t character)
+	   (type (or null display) display)
+	   (values (list keysym)))
+  (let ((result nil))
+    (when display
+      (dolist (mapping (display-keysym-translation display))
+	(when (eql character (second mapping))
+	  (push (first mapping) result))))
+    (maphash #'(lambda (keysym mappings)
+		 (dolist (mapping mappings)
+		   (when (eql (keysym-mapping-object mapping) character)
+		     (pushnew keysym result))))
+	     *keysym->character-map*)
+    result))
+
+(eval-when (compile eval load) ;; Required for Symbolics...
+(defconstant character-set-switch-keysym (keysym 255 126))
+(defconstant left-shift-keysym (keysym 255 225))
+(defconstant right-shift-keysym (keysym 255 226))
+(defconstant left-control-keysym (keysym 255 227))
+(defconstant right-control-keysym (keysym 255 228))
+(defconstant caps-lock-keysym (keysym 255 229))
+(defconstant shift-lock-keysym (keysym 255 230))
+(defconstant left-meta-keysym (keysym 255 231))
+(defconstant right-meta-keysym (keysym 255 232))
+(defconstant left-alt-keysym (keysym 255 233))
+(defconstant right-alt-keysym (keysym 255 234))
+(defconstant left-super-keysym (keysym 255 235))
+(defconstant right-super-keysym (keysym 255 236))
+(defconstant left-hyper-keysym (keysym 255 237))
+(defconstant right-hyper-keysym (keysym 255 238))
+) ;; end eval-when
+
+
+;;-----------------------------------------------------------------------------
+;; Keysym mapping functions
+
+(defun display-keyboard-mapping (display)
+  (declare (type display display))
+  (declare (values (simple-array keysym (display-max-keycode keysyms-per-keycode))))
+  (or (display-keysym-mapping display)
+      (setf (display-keysym-mapping display) (keyboard-mapping display))))
+
+(defun keycode->keysym (display keycode keysym-index)
+  (declare (type display display)
+	   (type card8 keycode)
+	   (type card8 keysym-index)
+	   (values keysym))
+  (let* ((mapping (display-keyboard-mapping display))
+	 (keysym (aref mapping keycode keysym-index)))
+    (declare (type (simple-array keysym (* *)) mapping)
+	     (type keysym keysym))
+    ;; The keysym-mapping is brain dammaged.
+    ;; Mappings for both-case alphabetic characters have the
+    ;; entry for keysym-index zero set to the uppercase keysym
+    ;; (this is normally where the lowercase keysym goes), and the
+    ;; entry for keysym-index one is zero.
+    (cond ((zerop keysym-index)			; Lowercase alphabetic keysyms
+	   (keysym-downcase keysym))
+	  ((and (zerop keysym) (plusp keysym-index)) ; Get the uppercase keysym
+	   (aref mapping keycode 0))
+	  (t keysym))))
+
+(defun keysym->character (display keysym &optional (state 0))
+  ;; Find the character associated with a keysym.
+  ;; STATE can be used to set character attributes.
+  ;; Implementation dependent function.
+  (declare (type display display)
+	   (type keysym keysym)
+	   (type card16 state))
+  (declare (values (or null character)))
+  (let* ((display-mappings (cdr (assoc keysym (display-keysym-translation display))))
+	 (mapping (or ;; Find the matching display mapping
+		      (dolist (mapping display-mappings)
+			(when (mapping-matches-p display state mapping)
+			  (return mapping)))
+		      ;; Find the matching static mapping
+		      (dolist (mapping (gethash keysym *keysym->character-map*))
+			(when (mapping-matches-p display state mapping)
+			  (return mapping))))))
+    (when mapping
+      (funcall (or (keysym-mapping-translate mapping) 'default-keysym-translate)
+	       display state (keysym-mapping-object mapping)))))
+
+(defun mapping-matches-p (display state mapping)
+  ;; Returns T when the modifiers and mask in MAPPING satisfies STATE for DISPLAY
+  (declare (type display display)
+	   (type mask16 state)
+	   (type list mapping))
+  (declare (values boolean))
+  (flet
+    ((modifiers->mask (display-mapping modifiers errorp &aux (mask 0))
+       ;; Convert MODIFIERS, which is a modifier mask, or a list of state-mask-keys into a mask.
+       ;; If ERRORP is non-nil, return NIL when an unknown modifier is specified,
+       ;; otherwise ignore unknown modifiers.
+       (declare (type list display-mapping)	; Alist of (keysym . mask)
+		(type (or mask16 list) modifiers)
+		(type mask16 mask))
+       (declare (values (or null mask16)))
+       (if (numberp modifiers)
+	   modifiers
+	 (dolist (modifier modifiers mask)
+	   (declare (type symbol modifier))
+	   (let ((bit (position modifier (the simple-vector *state-mask-vector*) :test #'eq)))
+	     (setq mask
+		   (logior mask
+			   (if bit
+			       (ash 1 bit)
+			     (or (cdr (assoc modifier display-mapping))
+				 ;; bad modifier
+				 (if errorp
+				     (return-from modifiers->mask nil)
+				   0))))))))))
+
+    (let* ((display-mapping (get-display-modifier-mapping display))
+	   (mapping-modifiers (keysym-mapping-modifiers mapping))
+	   (modifiers (or (modifiers->mask display-mapping (or mapping-modifiers 0) t)
+			  (return-from mapping-matches-p nil)))
+	   (mapping-mask (or (keysym-mapping-mask mapping)	; If no mask, use the default.
+			     (if mapping-modifiers	        ; If no modifiers, match anything.
+				 *default-keysym-translate-mask*
+			       0)))
+	   (mask (if (eq mapping-mask :modifiers)
+		     modifiers
+		   (modifiers->mask display-mapping mapping-mask nil))))
+      (declare (type mask16 modifiers mask))
+      (= #-ecl (logand state mask)
+	 #+ecl (the mask16 (logand state mask)) modifiers))))
+
+(defun default-keysym-index (display keycode state)
+  ;; Returns a keysym-index for use with keycode->character
+  (declare (values card8))
+  (macrolet ((keystate-p (state keyword)
+	       `(the boolean
+		     (logbitp ,(position keyword *state-mask-vector*)
+			      ,state))))
+    (let* ((mapping (display-keyboard-mapping display))
+	   (keysyms-per-keycode (array-dimension mapping 1))
+	   (symbolp (and (> keysyms-per-keycode 2)
+			 (state-keysymp display state character-set-switch-keysym)))
+	   (result (if symbolp 2 0)))
+      (declare (type (simple-array keysym (* *)) mapping)
+	       (type boolean symbolp)
+	       (type card8 keysyms-per-keycode result))
+      (when (and (< result keysyms-per-keycode)
+		 (keysym-shift-p display state (keysym-uppercase-alphabetic-p
+						 (aref mapping keycode 0))))
+	(incf result))
+      result)))
+
+(defun keysym-shift-p (display state uppercase-alphabetic-p &key
+		       shift-lock-xors
+		       (control-modifiers
+			 '#.(list left-meta-keysym left-super-keysym left-hyper-keysym)))
+  (declare (type display display)
+	   (type card16 state)
+	   (type boolean uppercase-alphabetic-p)
+	   (type boolean shift-lock-xors));;; If T, both SHIFT-LOCK and SHIFT is the same
+	                                  ;;; as neither if the character is alphabetic.
+  (declare (values boolean))
+  (macrolet ((keystate-p (state keyword)
+	       `(the boolean
+		     (logbitp ,(position keyword *state-mask-vector*)
+			      ,state))))
+    (let* ((controlp (or (keystate-p state :control)
+			 (dolist (modifier control-modifiers)
+			   (when (state-keysymp display state modifier)
+			     (return t)))))
+	   (shiftp (keystate-p state :shift))
+	   (lockp  (keystate-p state :lock))
+	   (alphap (or uppercase-alphabetic-p
+		       (not (state-keysymp display #.(make-state-mask :lock)
+					   caps-lock-keysym)))))
+      (declare (type boolean controlp shiftp lockp alphap))
+      ;; Control keys aren't affected by lock
+      (unless controlp
+	;; Not a control character - check state of lock modifier
+	(when (and lockp
+		   alphap
+		   (or (not shiftp) shift-lock-xors))	; Lock doesn't unshift unless shift-lock-xors
+	  (setq shiftp (not shiftp))))
+      shiftp)))
+
+;;; default-keysym-index implements the following tables:
+;;;
+;;; control shift caps-lock character               character
+;;;   0       0       0       #\a                      #\8
+;;;   0       0       1       #\A                      #\8
+;;;   0       1       0       #\A                      #\*
+;;;   0       1       1       #\A                      #\*
+;;;   1       0       0       #\control-A              #\control-8
+;;;   1       0       1       #\control-A              #\control-8
+;;;   1       1       0       #\control-shift-a        #\control-*
+;;;   1       1       1       #\control-shift-a        #\control-*
+;;;
+;;; control shift shift-lock character               character
+;;;   0       0       0       #\a                      #\8
+;;;   0       0       1       #\A                      #\*
+;;;   0       1       0       #\A                      #\*
+;;;   0       1       1       #\A                      #\8
+;;;   1       0       0       #\control-A              #\control-8
+;;;   1       0       1       #\control-A              #\control-*
+;;;   1       1       0       #\control-shift-a        #\control-*
+;;;   1       1       1       #\control-shift-a        #\control-8
+
+(defun keycode->character (display keycode state &key keysym-index
+	                   (keysym-index-function #'default-keysym-index))
+  ;; keysym-index defaults to the result of keysym-index-function which
+  ;; is called with the following parameters:
+  ;; (char0 state caps-lock-p keysyms-per-keycode)
+  ;; where char0 is the "character" object associated with keysym-index 0 and
+  ;; caps-lock-p is non-nil when the keysym associated with the lock
+  ;; modifier is for caps-lock.
+  ;; STATE can also used for setting character attributes.
+  ;; Implementation dependent function.
+  (declare (type display display)
+	   (type card8 keycode)
+	   (type card16 state)
+	   (type (or null card8) keysym-index)
+	   (type (or null (function (base-char card16 boolean card8) card8))
+		 keysym-index-function))
+  (declare (values (or null character)))
+  (let* ((index (or keysym-index
+		    (funcall keysym-index-function display keycode state)))
+	 (keysym (if index (keycode->keysym display keycode index) 0)))
+    (declare (type (or null card8) index)
+	     (type keysym keysym))
+    (when (plusp keysym)
+      (keysym->character display keysym state))))
+
+(defun get-display-modifier-mapping (display)
+  (labels ((keysym-replace (display modifiers mask &aux result)
+	     (dolist (modifier modifiers result)
+	       (push (cons (keycode->keysym display modifier 0) mask) result))))
+    (or (display-modifier-mapping display)
+	(multiple-value-bind (shift lock control mod1 mod2 mod3 mod4 mod5)
+	    (modifier-mapping display)
+	  (setf (display-modifier-mapping display)
+		(nconc (keysym-replace display shift #.(make-state-mask :shift))
+		       (keysym-replace display lock #.(make-state-mask :lock))
+		       (keysym-replace display control #.(make-state-mask :control))
+		       (keysym-replace display mod1 #.(make-state-mask :mod-1))
+		       (keysym-replace display mod2 #.(make-state-mask :mod-2))
+		       (keysym-replace display mod3 #.(make-state-mask :mod-3))
+		       (keysym-replace display mod4 #.(make-state-mask :mod-4))
+		       (keysym-replace display mod5 #.(make-state-mask :mod-5))))))))
+
+(defun state-keysymp (display state keysym)
+  ;; Returns T when a modifier key associated with KEYSYM is on in STATE
+  (declare (type display display)
+	   (type card16 state)
+	   (type keysym keysym))
+  (declare (values boolean))
+  (let* ((mapping (get-display-modifier-mapping display))
+	 (mask (assoc keysym mapping)))
+    (and mask (plusp #-ecl (logand state (cdr mask))
+		     #+ecl (the card16 (logand state (cdr mask)))))))
+
+(defun mapping-notify (display request start count)
+  ;; Called on a mapping-notify event to update
+  ;; the keyboard-mapping cache in DISPLAY
+  (declare (type display display)
+	   (type (member :modifier :keyboard :pointer) request)
+	   (type card8 start count)
+	   (ignore count start))
+  ;; Invalidate the keyboard mapping to force the next key translation to get it
+  (case request
+    (:modifier 
+     (setf (display-modifier-mapping display) nil))
+    (:keyboard
+     (setf (display-keysym-mapping display) nil))))
+
+(defun keysym-in-map-p (display keysym keymap)
+  ;; Returns T if keysym is found in keymap
+  (declare (type display display)
+	   (type keysym keysym)
+	   (type (bit-vector 256) keymap))
+  (declare (values boolean))
+  ;; The keysym may appear in the keymap more than once,
+  ;; So we have to search the entire keysym map.
+  (do* ((min (display-min-keycode display))
+	(max (display-max-keycode display))
+	(map (display-keyboard-mapping display))
+	(jmax (min 2 (array-dimension map 1)))
+	(i min (1+ i)))
+      ((> i max))
+    (declare (type card8 min max jmax)
+	     (type (simple-array keysym (* *)) map))
+    (when (and (plusp (aref keymap i))
+	       (dotimes (j jmax)
+		 (when (= keysym (aref map i j)) (return t))))
+      (return t))))
+
+(defun character-in-map-p (display character keymap)
+  ;; Implementation dependent function.
+  ;; Returns T if character is found in keymap
+  (declare (type display display)
+	   (type character character)
+	   (type (bit-vector 256) keymap))
+  (declare (values boolean))
+  ;; Check all one bits in keymap
+  (do* ((min (display-min-keycode display))
+	(max (display-max-keycode display))
+	(jmax (array-dimension (display-keyboard-mapping display) 1))
+	(i min (1+ i)))
+      ((> i max))
+    (declare (type card8 min max jmax))
+    (when (and (plusp (aref keymap i))
+	       ;; Match when character is in mapping for this keycode
+	       (dotimes (j jmax)
+		 (when (eql character (keycode->character display i 0 :keysym-index j))
+		   (return t))))
+      (return t))))
+
+(defun keysym->keycodes (display keysym)
+  ;; Return keycodes for keysym, as multiple values
+  (declare (type display display)
+	   (type keysym keysym))
+  (declare (values (or null keycode) (or null keycode) (or null keycode)))
+  ;; The keysym may appear in the keymap more than once,
+  ;; So we have to search the entire keysym map.
+  (do* ((min (display-min-keycode display))
+	(max (display-max-keycode display))
+	(map (display-keyboard-mapping display))
+	(jmax (min 2 (array-dimension map 1)))
+	(i min (1+ i))
+	(result nil))
+      ((> i max) (values-list result))
+    (declare (type card8 min max jmax)
+	     (type (simple-array keysym (* *)) map))
+    (dotimes (j jmax)
+      (when (= keysym (aref map i j))
+	(push i result)))))
diff --git a/src/cmp/cmpbind.lsp b/src/cmp/cmpbind.lsp
new file mode 100644
index 000000000..60f1d4629
--- /dev/null
+++ b/src/cmp/cmpbind.lsp
@@ -0,0 +1,98 @@
+;;;;  CMPBIND  Variable Binding.
+;;;;
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;  This file is part of ECoLisp, herein referred to as ECL.
+;;;;
+;;;;    ECL is free software; you can redistribute it and/or modify it under
+;;;;    the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
+;;;;    the Free Software Foundation; either version 2 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "COMPILER")
+
+;;; bind must be called for each variable in a lambda or let, once the value
+;;; to be bound has been placed in loc.
+;;; bind takes care of setting var-loc.
+
+(defun bind (loc var)
+  ;; loc can be either (LCL n), (VA-ARGS kind), (KEYVARS n), (CAR n),
+  ;; a constant, or (VAR var) from a let binding. ; ccb
+  (declare (type var var))
+  (case (var-kind var)
+    (LEXICAL
+     (let ((var-loc (var-loc var)))
+       (if (var-ref-ccb var)
+	   (progn
+	     (unless (sys:fixnump var-loc)
+	       ;; first binding: assign location
+	       (setq var-loc (next-env))
+	       (setf (var-loc var) var-loc))
+	     (when (zerop var-loc) (wt-nl "env" *env-lvl* " = Cnil;"))
+	     (wt-nl "CLV" var-loc
+		    "=&CAR(env" *env-lvl* "=CONS(" loc ",env" *env-lvl* "));"))
+	   (progn
+	     (unless (consp var-loc)
+	       ;; first binding: assign location
+	       (setq var-loc (next-lex))
+	       (setf (var-loc var) var-loc))
+	     (wt-nl) (wt-lex var-loc) (wt "=" loc ";")))
+       (wt-comment (var-name var))))
+    (SPECIAL
+     (bds-bind loc var))
+    (OBJECT
+     (if (eq (var-loc var) 'OBJECT)
+	 ;; set location for lambda list requireds
+	 (setf (var-loc var) (second loc))
+	 ;; already has location (e.g. optional in lambda list)
+	 (unless (and (consp loc)	; check they are not the same
+		      (eq 'LCL (car loc))
+		      (= (var-loc var) (second loc)))
+	   (wt-nl) (wt-lcl (var-loc var)) (wt "= " loc ";"))
+	 ))
+    (t
+     (wt-nl) (wt-lcl (var-loc var)) (wt "= ")
+     (case (var-kind var)
+       (FIXNUM (wt-fixnum-loc loc))
+       (CHARACTER (wt-character-loc loc))
+       (LONG-FLOAT (wt-long-float-loc loc))
+       (SHORT-FLOAT (wt-short-float-loc loc))
+       (t (baboon)))
+     (wt ";")))
+  )
+
+;;; Used by let*, defmacro and lambda's &aux, &optional, &rest, &keyword
+(defun bind-init (var form)
+  (let ((*destination* `(BIND ,var)))
+    ;; assigning location must be done before calling c2expr*,
+    ;; otherwise the increment to *env* or *lex* is done during
+    ;; unwind-exit and will be shadowed by functions (like c2let)
+    ;; which rebind *env* or *lex*.
+    (when (eq (var-kind var) 'LEXICAL)
+      (if (var-ref-ccb var)
+	  (unless (si:fixnump (var-loc var))
+	    (setf (var-loc var) (next-env)))
+	  (unless (consp (var-loc var))
+	    (setf (var-loc var) (next-lex)))))
+    (when (eq (var-kind var) 'SPECIAL)
+      ;; prevent BIND from pushing BDS-BIND
+      (setf (var-ref-ccb var) t))
+    (c2expr* form)
+    (when (eq (var-kind var) 'SPECIAL)
+      ;; now the binding is in effect
+      (push 'BDS-BIND *unwind-exit*))))
+
+(defun bds-bind (loc var)
+  (wt-nl "bds_bind(VV[" (var-loc var) "]," loc ");")
+  ;; push BDS-BIND only once:
+  ;; bds-bind may be called several times on the same variable, e.g.
+  ;; an optional has two alternative bindings.
+  ;; We use field var-ref-ccb to record this fact.
+  (unless (var-ref-ccb var)
+    (push 'BDS-BIND *unwind-exit*)
+    (setf (var-ref-ccb var) t))
+  (wt-comment (var-name var)))
+
+(setf (get 'BIND 'SET-LOC) 'bind)
diff --git a/src/cmp/cmpblock.lsp b/src/cmp/cmpblock.lsp
new file mode 100644
index 000000000..2d3c6bc3d
--- /dev/null
+++ b/src/cmp/cmpblock.lsp
@@ -0,0 +1,145 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPBLOCK  Block and Return-from.
+
+(in-package "COMPILER")
+
+#|
+;;; Use a structure of type vector to avoid creating
+;;; normal structures before booting CLOS:
+(defstruct (blk (:type vector) :named)
+   name			;;; Block name.
+   (ref 0 :type fixnum)	;;; Number of references.
+   ref-ccb		;;; Cross closure reference.
+			;;; During Pass1, T or NIL.
+   ref-clb		;;; Cross local function reference.
+       			;;; During Pass1, T or NIL.
+       			;;; block id, or NIL.
+   exit			;;; Where to return.  A label.
+   destination		;;; Where the value of the block to go.
+   var			;;; variable containing the block ID.
+) |#
+
+;;; During Pass 1, *blocks* holds a list of blk objects and the
+;;; symbols 'CB' (Closure Boundary), 'LB' (Level Boundary) or
+;;; 'UNWIND-PROTECT'.  'CB' will be pushed on *blocks* when the
+;;; compiler begins to process a closure.  'LB' will be pushed on
+;;; *blocks* when *level* is incremented.  'UNWIND-PROTECT' is pushed
+;;; when entering an unwind-protect.  A dummy variable is created to
+;;; hold the block identifier.  When a reference to the block (via
+;;; return-from) is found, the var-ref count for that variable is
+;;; incremented only if the reference appears across a boundary (CB,
+;;; LB or UNWIND-PROTECT), while the blk-ref is always incremented.
+;;; Therefore blk-ref represents whether the block is used at all and
+;;; var-ref for the dummy variable represents whether a block
+;;; identifier must be created and stored in such variable.
+
+(defun c1block (args)
+  (when (endp args) (too-few-args 'BLOCK 1 0))
+  (cmpck (not (symbolp (car args)))
+         "The block name ~s is not a symbol." (car args))
+  (let* ((blk (make-blk :name (car args)
+			:var (make-var :name (car args) :kind 'LEXICAL)))
+         (*blocks* (cons blk *blocks*))
+         (body (c1progn (cdr args))))
+    (when (or (blk-ref-ccb blk) (blk-ref-clb blk))
+	  (incf *setjmps*))
+    (if (plusp (blk-ref blk))
+	(list 'BLOCK (reset-info-type (second body)) blk body)
+	body))
+  )
+
+(defun c2block (blk body)
+  (if (plusp (var-ref (blk-var blk)))
+      (let* ((blk-var (blk-var blk))
+	     (*env-lvl* *env-lvl*))
+	(setf (blk-exit blk) *exit*
+	      (blk-destination blk) *destination*)
+	(wt "{")
+	(unless (or (blk-ref-ccb blk) (blk-ref-clb blk))
+	  (setf (var-loc blk-var) (next-lcl)
+		(var-kind blk-var) 'OBJECT)
+	  (wt " cl_object ") (wt-var blk-var) (wt ";"))
+	(when (env-grows (blk-ref-ccb blk))
+	  (let ((env-lvl *env-lvl*))
+	    (wt-nl "volatile cl_object env" (incf *env-lvl*)
+		   " = env" env-lvl ";")))
+	(bind "new_frame_id()" blk-var)
+	(wt-nl "if (frs_push(FRS_CATCH," blk-var ")!=0) {")
+	(let ((*unwind-exit* (cons 'FRAME *unwind-exit*)))
+	  (unwind-exit 'VALUES)
+	  (wt-nl "} else {")
+	  (c2expr body)
+	  (wt "}"))
+	(when (blk-ref-ccb blk) (decf *env*))
+	(wt-nl "}"))
+      (progn
+	(setf (blk-exit blk) *exit*)
+	(setf (blk-destination blk) *destination*)
+	(c2expr body)))
+  )
+
+(defun c1return-from (args)
+  (cond ((endp args) (too-few-args 'RETURN-FROM 1 0))
+        ((and (not (endp (cdr args))) (not (endp (cddr args))))
+         (too-many-args 'RETURN-FROM 2 (length args)))
+        ((not (symbolp (car args)))
+         "The block name ~s is not a symbol." (car args)))
+  (do ((blks *blocks* (cdr blks))
+       (name (car args))
+       (ccb) (clb) (unw) (blk) (type T))
+      ((endp blks)
+       (cmperr "The block ~s is undefined." name))
+    (setq blk (car blks))
+    (case blk
+      (CB (setq ccb t))
+      (LB (setq clb t))
+      (UNWIND-PROTECT (setq unw T))
+      (t (when (eq (blk-name blk) name)
+           (let* ((val (c1expr (second args)))
+		  (info (reset-info-type (second val)))
+		  (var (blk-var blk)))
+             (cond (ccb (setf (blk-ref-ccb blk) t
+			      type 'CCB
+			      (var-ref-ccb var) T)
+			(incf (var-ref var)))
+		   (clb (setf (blk-ref-clb blk) t
+			      type 'CLB)
+			(incf (var-ref var)))
+		   (unw (setf type 'UNWIND-PROTECT)
+			(incf (var-ref var))))
+	     (incf (blk-ref blk))
+	     (push var (info-local-referred info))
+	     (pushnew var (info-referred-vars info))
+;	     (push blk (info-referred-tags info))
+             (return (list 'RETURN-FROM info blk type val)))))))
+  )
+
+(defun c2return-from (blk type val)
+  (case type
+    (CCB
+     (let ((*destination* 'VALUES)) (c2expr* val))
+     (wt-nl "return_from(" (blk-var blk) "," (add-symbol (blk-name blk)) ");"))
+    ((CLB UNWIND-PROTECT)
+     (let ((*destination* 'VALUES)) (c2expr* val))
+     (wt-nl "return_from(") (blk-var blk) (wt ",Cnil);"))
+    (T (let ((*destination* (blk-destination blk))
+	     (*exit* (blk-exit blk)))
+	 (c2expr val))))
+  )
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'BLOCK 'C1SPECIAL) 'c1block)
+(setf (get 'BLOCK 'C2) 'c2block)
+
+(setf (get 'RETURN-FROM 'C1SPECIAL) 'c1return-from)
+(setf (get 'RETURN-FROM 'C2) 'c2return-from)
diff --git a/src/cmp/cmpcall.lsp b/src/cmp/cmpcall.lsp
new file mode 100644
index 000000000..701b785af
--- /dev/null
+++ b/src/cmp/cmpcall.lsp
@@ -0,0 +1,337 @@
+;;;;  CMPCALL  Function call.
+
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+
+(in-package "COMPILER")
+
+(defun fast-link-proclaimed-type-p (fname &optional args)
+  (and *compile-to-linking-call*
+       (symbolp fname)
+       (and (< (the fixnum (length args)) 10)
+            (or (and (get fname 'FIXED-ARGS)
+                     (listp args))
+                (and
+                 (get fname 'PROCLAIMED-FUNCTION)
+                 (eq (get fname 'PROCLAIMED-RETURN-TYPE) t)
+                 (every #'(lambda (v) (eq v t))
+                        (get fname 'PROCLAIMED-ARG-TYPES)))))))
+
+;;; Like macro-function except it searches the lexical environment,
+;;; to determine if the macro is shadowed by a function or a macro.
+(defun cmp-macro-function (name)
+  (or (sch-local-macro name)
+      (macro-function name)))
+
+(defun c1funob (fun &aux fd function)
+  ;; fun is an expression appearing in functional position, in particular
+  ;; (FUNCTION (LAMBDA ..))
+  (when (and (consp fun)
+	     (symbolp (first fun))
+	     (cmp-macro-function (first fun)))
+    (setq fun (cmp-macroexpand fun)))
+  (cond ((not (and (consp fun)
+		   (eq (first fun) 'FUNCTION)
+		   (consp (cdr fun))
+		   (endp (cddr fun))))
+	 (let ((x (c1expr fun)) (info (make-info :sp-change t)))
+	   (add-info info (second x))
+	   (list 'ORDINARY info x)))
+	((symbolp (setq function (second fun)))
+	 (or (c1call-local function)
+	     (list 'GLOBAL
+		   (make-info :sp-change
+			      (not (get function 'NO-SP-CHANGE)))
+		   function)))
+	((and (consp function)
+	      (eq (first function) 'LAMBDA)
+	      (consp (rest function)))
+	 ;; Don't create closure boundary like in c1function
+	 ;; since funob is used in this same environment
+	 (let ((lambda-expr (c1lambda-expr (rest function))))
+	   (list 'LAMBDA (second lambda-expr) lambda-expr (next-cfun))))
+	((and (consp function)
+	      (eq (first function) 'LAMBDA-BLOCK)
+	      (consp (rest function)))
+	 ;; Don't create closure boundary like in c1function
+	 ;; since funob is used in this same environment
+	 (let ((lambda-expr (c1lambda-expr (cddr function) (second function))))
+	   (list 'LAMBDA (second lambda-expr) lambda-expr (next-cfun))))
+	(t (cmperr "Malformed function: ~A" fun))))
+
+(defun c1funcall (args &aux funob (info (make-info)))
+  (when (endp args) (too-few-args 'FUNCALL 1 0))
+  (setq funob (c1funob (car args)))
+  (add-info info (second funob))
+  (list 'FUNCALL info funob (c1args (cdr args) info)))
+
+(defun c2funcall (funob args &optional loc narg
+			&aux (form (third funob)))
+  ;; Usually, ARGS holds a list of forms, which are arguments to the
+  ;; function.  If, however, the arguments are on VALUES,
+  ;; ARGS should be set to the symbol ARGS-PUSHED, and NARG to a location
+  ;; containing the number of arguments.
+  ;; LOC is the location of the function object (created by save-funob).
+  (case (first funob)
+    (GLOBAL (c2call-global form args loc t narg))
+    (LOCAL (c2call-local form args narg))
+    (LAMBDA (c2call-lambda form args (fourth funob) narg))
+    (ORDINARY		;;; An ordinary expression.  In this case, if
+              		;;; arguments are already on VALUES, then
+              		;;; LOC cannot be NIL.  Callers of C2FUNCALL must be
+              		;;; responsible for maintaining this condition.
+     (let ((fun (third form)))
+       (unless loc
+	 (cond ((eq (first form) 'LOCATION) (setq loc fun))
+	       ((and (eq (first form) 'VAR)
+		     (not (var-changed-in-forms (first fun) args)))
+		(setq loc (cons 'VAR fun))) ; i.e. (VAR var)
+	       (t
+		(setq loc (list 'TEMP (next-temp)))
+		(let ((*destination* loc)) (c2expr* form)))))
+
+       (let ((*inline-blocks* 0))
+	 (c2call-unknown-global nil (if (eq args 'ARGS-PUSHED)
+					args
+					(inline-args args)) loc nil narg)
+	 (close-inline-blocks))))
+    (otherwise (baboon))
+    ))
+
+(defun c2call-lambda (lambda-expr args cfun &optional narg)
+  ;; ARGS is either the list of arguments or 'ARGS-PUSHED
+  ;; NARG is a location containing the number of ARGS-PUSHED
+  (let ((lambda-list (third lambda-expr))
+	(args-pushed (eq 'ARGS-PUSHED args)))
+    (if (or (second lambda-list)		;;; Has optional?
+	    (third lambda-list)			;;; Has rest?
+	    (fourth lambda-list)		;;; Has key?
+	    args-pushed				;;; Args already pushed?
+	    )
+	(let* ((requireds (first lambda-list))
+	       (nreq (length requireds)))
+	  (unless args-pushed (setq narg (length args)))
+	  (wt-nl "{ ")
+	  ;; In reverse order, since stack grows downward:
+	  (if args-pushed
+	      (wt-nl "cl_object *args = &VALUES(" nreq ");")
+	      (wt-nl "cl_object args[" (- narg nreq) "];"))
+	  (when requireds
+	    (wt-nl "cl_object ")
+	    (let ((lcl (+ *lcl* nreq)))
+	      (declare (fixnum lcl))
+	      (do ((args requireds (cdr args)))
+		  ((null args))
+		(wt-lcl lcl) (when (cdr args) (wt ", ")) (decf lcl)))
+	    (wt ";"))
+	  (wt-nl "int narg = ")
+	  (wt (if args-pushed			;;; Args already pushed?
+		  narg
+		  (length args)) ";")
+	  (if args-pushed
+	      (dotimes (i nreq)
+		(wt-nl) (wt-lcl (next-lcl)) (wt "=VALUES(" i ");"))
+	      (progn
+		(dotimes (i nreq)
+		  (let ((*destination* `(LCL ,(next-lcl))))
+		    (c2expr* (pop args))))
+		(do* ((*inline-blocks* 0)
+		      (vals (inline-args args) (cdr vals))
+		      (i 0 (1+ i)))
+		     ((null vals) (close-inline-blocks))
+		  (declare (fixnum i))
+		  (wt-nl "args[" i "]=" (second (first vals)) ";"))
+		(wt-nl "narg = " (- narg nreq) ";")))
+	  (c2lambda-expr lambda-list (third (cddr lambda-expr)) cfun
+			 nil nil 'CALL-LAMBDA)
+	  (wt-nl "}"))
+	(c2let (first lambda-list) args (third (cddr lambda-expr))))))
+
+;;;
+;;; c2call-global:
+;;;   ARGS is either the list of arguments or 'ARGS-PUSHED
+;;;   NARG is a location containing the number of ARGS-PUSHED
+;;;   LOC is either NIL or the location of the function object
+;;;
+(defun c2call-global (fname args loc return-type &optional narg)
+  (unless (eq 'ARGS-PUSHED args)
+    (case fname
+      (AREF
+       (let ((etype (info-type (cadar args))))
+	 (when (or (and (eq etype 'STRING)
+			(setq etype 'CHARACTER))
+		   (and (consp etype)
+			(or (eq (car etype) 'ARRAY)
+			    (eq (car etype) 'VECTOR))
+			(setq etype (second etype))))
+	   (setq etype (type-and return-type etype))
+	   (unless etype
+	     (cmpwarn "Type mismatch was found in ~s."
+		      (cons fname args))
+	     (setq etype T))		; assume no information
+	   (setf return-type etype))))
+      (SYS:ASET				; (sys:aset value array i0 ... in)
+       (let ((etype (info-type (cadr (second args)))))
+	 (when (or (and (eq etype 'STRING)
+			(setq etype 'CHARACTER))
+		   (and (consp etype)
+			(or (eq (car etype) 'ARRAY)
+			    (eq (car etype) 'VECTOR))
+			(setq etype (second etype))))
+	   (setq etype
+		 (type-and return-type
+			   (type-and (info-type (cadr (first args)))
+				     etype)))
+	   (unless etype
+	     (cmpwarn "Type mismatch was found in ~s."
+		      (cons fname args))
+	     (setq etype T))
+	   (setf return-type etype)
+	   (setf (info-type (cadr (first args))) etype))))))
+  (if (and (inline-possible fname)
+	   (not (eq 'ARGS-PUSHED args))
+	   *tail-recursion-info*
+	   (eq (first *tail-recursion-info*) fname)
+	   (last-call-p)
+	   (tail-recursion-possible)
+	   (= (length args) (length (cdr *tail-recursion-info*))))
+      ;; Tail-recursive case.
+      (let* ((*destination* 'TRASH)
+	     (*exit* (next-label))
+	     (*unwind-exit* (cons *exit* *unwind-exit*)))
+	(c2psetq
+	 (mapcar #'(lambda (v) (list v)) ; nil (ccb)
+		 (cdr *tail-recursion-info*))
+	 args)
+	(wt-label *exit*)
+	(unwind-no-exit 'TAIL-RECURSION-MARK)
+	(wt-nl "goto TTL;")
+	(cmpnote "Tail-recursive call of ~s was replaced by iteration."
+		 fname))
+      ;; else
+      (let ((*inline-blocks* 0))
+	(call-global fname (if (eq args 'ARGS-PUSHED) args (inline-args args))
+		     loc return-type narg)
+	(close-inline-blocks))))
+
+;;;
+;;; call-global:
+;;;   LOCS is either the list of typed locs with the arguments or 'ARGS-PUSHED
+;;;   NARG is a location containing the number of ARGS-PUSHED
+;;;   LOC is either NIL or the location of the function object
+;;;
+(defun call-global (fname locs loc return-type narg &aux fd)
+  (flet ((emit-linking-call (fname locs narg &aux i)
+	   (cond ((null *linking-calls*)
+		  (push (list fname 0 (add-symbol fname))
+			*linking-calls*)
+		  (setq i 0))
+		 ((setq i (assoc fname *linking-calls*))
+		  (setq i (second i)))
+		 (t (setq i (1+ (cadar *linking-calls*)))
+		    (push (list fname i (add-symbol fname))
+			  *linking-calls*)))
+	   (unwind-exit
+	    (call-loc fname (format nil "(*LK~d)" i) locs narg))))
+    (if (inline-possible fname)
+	(cond 
+	  ;; Open-codable function call.
+	  ((and (not (eq 'ARGS-PUSHED locs))
+		(null loc)
+		(setq loc (inline-function fname locs return-type)))
+	   (unwind-exit (fix-loc loc)))
+
+	  ;; Call to a function whose C language function name is known.
+	  ((setq fd (get fname 'Lfun))
+	   (wt-h "cl_object " fd "();")
+	   (unwind-exit (call-loc fname fd locs narg)))
+
+	  ;; Call to a function defined in the same file.
+	  ((setq fd (assoc fname *global-funs*))
+	   (unwind-exit (call-loc fname (format nil "L~d" (cdr fd))
+				  locs narg)))
+
+	  ;; Linking call
+	  (*compile-to-linking-call*	; disabled within init_code
+	   (emit-linking-call fname locs narg))
+
+	  (t (c2call-unknown-global fname locs loc t narg)))
+
+	;; else not inline-possible
+	(emit-linking-call fname locs narg)))
+  )
+
+;;; Functions that use SAVE-FUNOB should rebind *temp*.
+(defun save-funob (funob)
+  (case (first funob)
+    ((LAMBDA LOCAL))
+    (GLOBAL
+     (unless (and (inline-possible (third funob))
+                  (or (get (third funob) 'Lfun)
+                      (assoc (third funob) *global-funs*)))
+       (let ((temp (list 'TEMP (next-temp))))
+         (if *safe-compile*
+           (wt-nl temp "=symbol_function(VV[" (add-symbol (third funob)) "]);")
+           (wt-nl temp "=VV[" (add-symbol (third funob)) "]->symbol.gfdef;"))
+         temp)))
+    (ORDINARY (let* ((temp (list 'TEMP (next-temp)))
+                     (*destination* temp))
+                (c2expr* (third funob))
+                temp))
+    (otherwise (baboon))
+    ))
+
+;;;
+;;; call-loc:
+;;;   args are typed locations as produced by inline-args
+;;;
+(defun call-loc (fname fun args &optional narg-loc)
+  (if (eq 'ARGS-PUSHED args)
+      (list 'CALL (if (stringp fun)
+		      "APPLY"		; call to a C function
+		      "apply")		; call to a Lisp function
+	    narg-loc (list fun "&VALUES(0)") fname)
+      (list 'CALL fun (length args) (coerce-locs args nil) fname)))
+
+(defun wt-call (fun narg args &optional fname)
+  (wt fun "(" narg)
+  (dolist (arg args)
+    (wt "," arg))
+  (wt ")")
+  (when fname (wt-comment fname)))
+
+;;;
+;;; c2call-unknown-global
+;;;   LOC is NIL or location containing function
+;;;   ARGS is either the list of typed locations for arguments or 'ARGS-PUSHED
+;;;   NARG is a location containing the number of ARGS-PUSHED
+;;;
+(defun c2call-unknown-global (fname args loc inline-p narg)
+  (unless loc
+    (setq loc
+	  (if *compiler-push-events*
+	      `(VV ,(add-symbol fname))
+	      (format nil (if *safe-compile* 
+				  "symbol_function(VV[~d])"
+				  "VV[~d]->symbol.gfdef") (add-symbol fname)))))
+  (unwind-exit
+   (if (eq args 'ARGS-PUSHED)
+       (list 'CALL "apply" narg (list loc "&VALUES(0)") fname)
+       (call-loc fname "funcall" (cons (list T loc) args)))))
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'funcall 'C1) #'c1funcall)
+(setf (get 'funcall 'c2) #'c2funcall)
+(setf (get 'call-lambda 'c2) #'c2call-lambda)
+(setf (get 'call-global 'c2) #'c2call-global)
+
+(setf (get 'CALL 'WT-LOC) #'wt-call)
diff --git a/src/cmp/cmpcatch.lsp b/src/cmp/cmpcatch.lsp
new file mode 100644
index 000000000..67e0a56c6
--- /dev/null
+++ b/src/cmp/cmpcatch.lsp
@@ -0,0 +1,95 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPCATCH  Catch, Unwind-protect, and Throw.
+
+(in-package "COMPILER")
+
+(defun c1catch (args &aux (info (make-info :sp-change t)) tag)
+  (incf *setjmps*)
+  (when (endp args) (too-few-args 'CATCH 1 0))
+  (setq tag (c1expr (car args)))
+  (add-info info (second tag))
+  (setq args (c1progn (cdr args)))
+  (add-info info (second args))
+  (list 'CATCH info tag args))
+
+(defun c2catch (tag body)
+  (let ((*destination* '(PUSH-CATCH-FRAME)))
+    (c2expr* tag))
+  (let ((*unwind-exit* (cons 'FRAME *unwind-exit*)))
+    (unwind-exit 'VALUES)
+    (wt-nl "} else {")
+    (c2expr body)
+    (wt-nl "}")))
+
+(defun set-push-catch-frame (loc)
+  (wt-nl "if (frs_push(FRS_CATCH," loc ")!=0){"))
+
+(defun c1unwind-protect (args &aux (info (make-info :sp-change t)) form)
+  (incf *setjmps*)
+  (when (endp args) (too-few-args 'UNWIND-PROTECT 1 0))
+  (setq form (let ((*blocks* (cons 'UNWIND-PROTECT *blocks*))
+                   (*tags* (cons 'UNWIND-PROTECT *tags*))
+                   ;(*vars* (cons 'LB *vars*))
+		   )
+                  (c1expr (car args))))
+  (add-info info (second form))
+  (setq args (c1progn (cdr args)))
+  (add-info info (second args))
+  (list 'UNWIND-PROTECT info form args)
+  )
+
+(defun c2unwind-protect (form body &aux (nr (list 'LCL (next-lcl))))
+  (wt-nl "{ volatile bool unwinding = FALSE;")
+  (wt-nl "if (frs_push(FRS_PROTECT,Cnil)) {")
+  (wt-nl "unwinding = TRUE;} else {")
+  (let ((*unwind-exit* (cons 'FRAME *unwind-exit*)))
+    (let ((*destination* 'VALUES)) (c2expr* form))
+    (wt-nl "}")
+    (wt-nl "MV_SAVE(" nr ");")
+    (let ((*destination* 'TRASH)) (c2expr* body))
+    (wt-nl "MV_RESTORE(" nr ");")
+    (wt-nl "if (unwinding) unwind(nlj_fr,nlj_tag);")
+    (wt-nl "else {")
+    (unwind-exit 'VALUES)
+    (wt "}}")))
+
+(defun c1throw (args &aux (info (make-info)) tag)
+  (when (or (endp args) (endp (cdr args)))
+        (too-few-args 'THROW 2 (length args)))
+  (unless (endp (cddr args))
+          (too-many-args 'THROW 2 (length args)))
+  (setq tag (c1expr (car args)))
+  (add-info info (second tag))
+  (setq args (c1expr (second args)))
+  (add-info info (second args))
+  (list 'THROW info tag args)
+  )
+
+(defun c2throw (tag val &aux loc)
+  (case (car tag)
+    (LOCATION (setq loc (third tag)))
+    (VAR (setq loc (cons 'VAR (third tag))))
+    (t (setq loc (list 'TEMP (next-temp)))
+       (let ((*destination* loc)) (c2expr* tag))))
+  (let ((*destination* 'VALUES)) (c2expr* val))
+  (wt-nl "throw(" loc ");"))
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'CATCH 'C1SPECIAL) 'c1catch)
+(setf (get 'CATCH 'C2) 'c2catch)
+(setf (get 'UNWIND-PROTECT 'C1SPECIAL) 'c1unwind-protect)
+(setf (get 'UNWIND-PROTECT 'C2) 'c2unwind-protect)
+(setf (get 'THROW 'C1SPECIAL) 'c1throw)
+(setf (get 'THROW 'C2) 'c2throw)
+
+(setf (get 'PUSH-CATCH-FRAME 'SET-LOC) 'set-push-catch-frame)
diff --git a/src/cmp/cmpcfg.lsp.in b/src/cmp/cmpcfg.lsp.in
new file mode 100644
index 000000000..520772fbb
--- /dev/null
+++ b/src/cmp/cmpcfg.lsp.in
@@ -0,0 +1,8 @@
+;;
+;; * Set compiler and compiler flags -- this includes pointing
+;;   to the directory with our header files.
+;;
+(in-package "COMPILER")
+(setq compiler::*cc* "@CC@")
+(setq compiler::*cc-flags* "@CFLAGS@ -D@MACHINE@ @LSPCFLAGS@")
+(setq compiler::*ld-flags* "-lecls -lcrs -lgmp @LDFLAGS@ @CLIBS@")
diff --git a/src/cmp/cmpdefs.lsp b/src/cmp/cmpdefs.lsp
new file mode 100644
index 000000000..fd367768b
--- /dev/null
+++ b/src/cmp/cmpdefs.lsp
@@ -0,0 +1,396 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPDEF	Definitions
+
+(defpackage "FFI"
+  (:export clines
+	   defcfun
+	   defentry
+	   defla
+	   defcbody			; Beppe
+	   definline			; Beppe
+	   defunC			; Beppe
+	   void
+	   object
+	   char*			; Beppe
+	   ;;char
+	   int
+	   ;;float
+	   double
+	   ))
+
+(defpackage "C"
+  (:nicknames "COMPILER")
+  (:use "FFI" "CL")
+  (:export *compiler-break-enable*
+	   *compile-print*
+	   *compile-to-linking-call*
+	   *compile-verbose*
+	   *cc*
+	   *cc-optimize*
+	   build-ecls
+	   make-library
+	   *suppress-compiler-warnings*
+	   *suppress-compiler-notes*))
+
+(in-package "COMPILER")
+
+;;; Use structures of type vector to avoid creating
+;;; normal structures before booting CLOS.
+
+(defstruct (ref (:type vector))
+  name			;;; Identifier of reference.
+  (ref 0 :type fixnum)	;;; Number of references.
+  ref-ccb		;;; Cross closure reference.
+			;;; During Pass1, T or NIL.
+			;;; During Pass2, the index into the closure env
+)
+
+(defstruct (var (:type vector) (:include ref) :named)
+;  name		;;; Variable name.
+;  (ref 0 :type fixnum)
+		;;; Number of references to the variable (-1 means IGNORE).
+		;;; During Pass 2: set below *register-min* for non register.
+;  ref-ccb	;;; Cross closure reference: T or NIL.
+  kind		;;; One of LEXICAL, SPECIAL, GLOBAL, OBJECT, FIXNUM,
+  		;;; CHARACTER, LONG-FLOAT, SHORT-FLOAT, or REPLACED (used for
+		;;; LET variables).
+		;;; A value DUMMY is used for missing supplied-p keyword
+		;;; variables
+  (loc 'OBJECT)	;;; During Pass 1: indicates whether the variable can
+		;;; be allocated on the c-stack: OBJECT means
+		;;; the variable is declared as OBJECT, and CLB means
+		;;; the variable is referenced across Level Boundary and thus
+		;;; cannot be allocated on the C stack.  Note that OBJECT is
+		;;; set during variable binding and CLB is set when the
+		;;; variable is used later, and therefore CLB may supersede
+		;;; OBJECT.
+		;;; During Pass 2:
+  		;;; For REPLACED: the actual location of the variable.
+  		;;; For FIXNUM, CHARACTER, LONG-FLOAT, SHORT-FLOAT, OBJECT:
+  		;;;   the cvar for the C variable that holds the value.
+  		;;; For LEXICAL: the frame-relative address for the variable.
+		;;; For SPECIAL and GLOBAL: the vv-index for variable name.
+  (type t)	;;; Type of the variable.
+  (index -1)    ;;; position in *vars*. Used by similar.
+  )
+(deftype var () '(satisfies var-p))
+
+;;; A function may be compiled into a CFUN, CCLOSURE or CCLOSURE+LISP_CLOSURE
+;;; Here are examples of function FOO for the 3 cases:
+;;; 1.  (flet ((foo () (bar))) (foo))		CFUN
+;;; 2.  (flet ((foo () (bar))) #'foo)		CFUN+LISP_CFUN
+;;; 3.  (flet ((foo () x)) #'(lambda () (foo))) CCLOSURE
+;;; 4.  (flet ((foo () x)) #'foo)		CCLOSURE+LISP_CLOSURE
+
+;;; A function can be referred across a ccb without being a closure, e.g:
+;;;   (flet ((foo () (bar))) #'(lambda () (foo)))
+;;;   [the lambda also need not be a closure]
+;;; and it can be a closure without being referred across ccb, e.g.:
+;;;   (flet ((foo () x)) #'foo)  [ is this a mistake in c1local-closure?]
+;;; Here instead the lambda must be a closure, but no closure is needed for foo
+;;;   (flet ((foo () x)) #'(lambda () (foo)))
+;;; So we use two separate fields: ref-ccb and closure.
+;;; A CCLOSURE must be created for a function when:
+;;; 1. it appears within a FUNCTION construct and
+;;; 2. it uses some ccb references (directly or indirectly).
+;;; ref-ccb corresponds to the first condition, i.e. function is referred
+;;;   across CCB. It is computed during Pass 1. A value of 'RETURNED means
+;;;   that it is immediately within FUNCTION.
+;;; closure corresponds to second condition and is computed in Pass 2 by
+;;;   looking at the info-referred-vars and info-local-referred of its body.
+
+;;; A LISP_CFUN or LISP_CLOSURE must be created when the function is returned.
+;;; The LISP funob may then be referred locally or across LB or CB:
+;;;     (flet ((foo (z) (bar z))) (list #'foo)))
+;;;     (flet ((foo (z) z)) (flet ((bar () #'foo)) (bar)))
+;;;     (flet ((foo (z) (bar z))) #'(lambda () #'foo)))
+;;; therefore we need field funob.
+
+(defstruct (fun (:type vector) (:include ref) :named)
+;  name			;;; Function name.
+;  (ref 0 :type fixnum)	;;; Number of references.
+;  ref-ccb		;;; Cross closure reference.
+ 			;;; During Pass1, T or NIL.
+  cfun			;;; The cfun for the function.
+  (level 0)		;;; Level of lexical nesting for a function.
+  (env 0)     		;;; Size of env of closure.
+  closure		;;; During Pass2, T if env is used inside the function
+  var			;;; the variable holding the funob
+  )
+(deftype fun () '(satisifes fun-p))
+
+(defstruct (blk (:type vector) (:include ref) :named)
+;  name			;;; Block name.
+;  (ref 0 :type fixnum)	;;; Number of references.
+;  ref-ccb		;;; Cross closure reference.
+			;;; During Pass1, T or NIL.
+			;;; During Pass2, the ccb-lex for the
+			;;; block id, or NIL.
+  ref-clb		;;; Cross local function reference.
+			;;; During Pass1, T or NIL.
+			;;; During Pass2, the lex-address for the
+			;;; block id, or NIL.
+  exit			;;; Where to return.  A label.
+  destination		;;; Where the value of the block to go.
+  var			;;; Variable containing the block ID.
+  )
+(deftype blk () '(satisfies blk-p))
+
+(defstruct (tag (:type vector) (:include ref) :named)
+;  name			;;; Tag name.
+;  (ref 0 :type fixnum)	;;; Number of references.
+;  ref-ccb		;;; Cross closure reference.
+			;;; During Pass1, T or NIL.
+  ref-clb		;;; Cross local function reference.
+			;;; During Pass1, T or NIL.
+  label			;;; Where to jump.  A label.
+  unwind-exit		;;; Where to unwind-no-exit.
+  var			;;; Variable containing frame ID.
+  )
+(deftype tag () '(satisfies tag-p))
+
+(defstruct (info (:type vector) :named)
+  (changed-vars nil)	;;; List of var-objects changed by the form.
+  (referred-vars nil)	;;; List of var-objects referred in the form.
+  (type t)		;;; Type of the form.
+  (sp-change nil)	;;; Whether execution of the form may change
+			;;; the value of a special variable.
+  (volatile nil)	;;; whether there is a possible setjmp. Beppe
+;  (referred-tags nil)   ;;; Tags or block names referenced in the body.
+  (local-referred nil)  ;;; directly referenced in the body:
+;;;	each reference operator (c1call-symbol, c1go, c1return-from, c1vref
+;;;	and c1setq1) adds the reference to the info-local-referred of the form
+;;;	they appear in.
+;;;	This information is not propagated to an enclosing function (see
+;;;	add-info) so that we can determine exactly which frame is used
+;;;	in the body of a function.
+  )
+(deftype info () '(satisfies info-p))
+
+;;;
+;;; VARIABLES
+;;;
+
+;;; --cmpinline.lsp--
+;;;
+;;; Empty info struct
+;;;
+(defvar *info* (make-info))
+
+(defvar *inline-functions* nil)
+(defvar *inline-blocks* 0)
+;;; *inline-functions* holds:
+;;;	(...( function-name . inline-info )...)
+;;;
+;;; *inline-blocks* holds the number of C blocks opened for declaring
+;;; temporaries for intermediate results of the evaluation of inlined
+;;; function calls.
+
+;;; --cmputil.lsp--
+;;;
+;;; Variables and constants for error handling
+;;;
+(defvar *current-form* '|compiler preprocess|)
+(defvar *first-error* t)
+(defvar *error-count* 0)
+(defvar *error-p* nil)
+(defconstant *cmperr-tag* (cons nil nil))
+
+(defvar *compile-print* t)
+(defvar *compile-verbose* t)
+(defvar *suppress-compiler-warnings* nil)
+(defvar *suppress-compiler-notes* nil)
+(defvar *compiler-break-enable* nil)
+
+(defvar *compiler-in-use* nil)
+(defvar *compiler-input*)
+(defvar *compiler-output1*)
+(defvar *compiler-output2*)
+(defvar *compiler-output-data*)
+
+;;; --cmpblock.lsp--
+;;;
+;;; List of defined blocks, including marks for boundaries of closures
+;;;
+(defvar *blocks* nil)
+
+;;; --cmpcall.lsp--
+;;;
+;;; Whether to use linking calls.
+;;;
+(defvar *compile-to-linking-call* t)
+
+;;; --cmpenv.lsp--
+;;;
+(defvar *safe-compile* nil)
+(defvar *compiler-check-args* nil)
+(defvar *compiler-push-events* nil)
+(defvar *speed* 3)
+(defvar *space* 0)
+
+;;;
+;;; Compiled code uses the following kinds of variables:
+;;; 1. Vi, declared explicitely, either unboxed or register (*lcl*, next-lcl)
+;;; 2. Ti, declared collectively, of type object, may be reused (*temp*, next-temp)
+;;; 3. Ui, declared collectively, of type unboxed (*unboxed*, next-unboxed)
+;;; 4. lexi[j], for lexical variables in local functions
+;;; 5. CLVi, for lexical variables in closures
+
+(defvar *lcl* 0)		; number of local variables
+
+(defvar *temp* 0)		; number of temporary variables
+(defvar *max-temp* 0)		; maximum *temp* reached
+
+(defvar *unboxed*)		; list of unboxed variables
+(defvar *next-unboxed* 0)	; number of *unboxed* used.
+
+(defvar *level* 0)		; nesting level for local functions
+
+(defvar *lex* 0)		; number of lexical variables in local functions
+(defvar *max-lex* 0)		; maximum *lex* reached
+
+(defvar *env* 0)		; number of variables in current form
+(defvar *max-env* 0)		; maximum *env* in whole function
+(defvar *env-lvl* 0)		; number of levels of environments
+
+(defvar *next-cmacro* 0)	; holds the last cmacro number used.
+(defvar *next-vv* -1)		; holds the last VV index used.
+(defvar *next-cfun* 0)		; holds the last cfun used.
+
+;;;
+;;; *tail-recursion-info* holds NIL, if tail recursion is impossible.
+;;; If possible, *tail-recursion-info* holds
+;;	( fname  required-arg .... required-arg ),
+;;; where each required-arg is a var-object.
+;;;
+(defvar *tail-recursion-info* nil)
+
+;;;
+;;; *function-declarations* holds :
+;;	(... ( { function-name | fun-object } arg-types return-type ) ...)
+;;; Function declarations for global functions are ASSOCed by function names,
+;;; whereas those for local functions are ASSOCed by function objects.
+;;;
+;;; The valid argment type declaration is:
+;;	( {type}* [ &optional {type}* ] [ &rest type ] [ &key {type}* ] )
+;;; though &optional, &rest, and &key return types are simply ignored.
+;;;
+(defvar *function-declarations* nil)
+
+(defvar *alien-declarations* nil)
+(defvar *notinline* nil)
+
+;;; --cmpexit.lsp--
+;;;
+;;; *last-label* holds the label# of the last used label.
+;;; *exit* holds an 'exit', which is
+;;	( label# . ref-flag ) or one of RETURNs (i.e. RETURN, RETURN-FIXNUM,
+;;	RETURN-CHARACTER, RETURN-LONG-FLOAT, RETURN-SHORT-FLOAT, or
+;;	RETURN-OBJECT).
+;;; *unwind-exit* holds a list consisting of:
+;;	( label# . ref-flag ), one of RETURNs, TAIL-RECURSION-MARK, FRAME,
+;;	JUMP, BDS-BIND (each pushed for a single special binding), or a
+;;	LCL (which holds the bind stack pointer used to unbind).
+;;;
+(defvar *last-label* 0)
+(defvar *exit*)
+(defvar *unwind-exit*)
+
+;;; --cmpflet.lsp--
+;;;
+;;; During Pass 1, *funs* holds a list of fun objects, local macro definitions
+;;; and the symbol 'CB' (Closure Boundary) or 'LB' (Level Boundary).
+;;; 'CB' will be pushed on *funs* when the compiler begins to process a closure.
+;;; 'LB' will be pushed on *funs* when the compiler begins to process a local
+;;; function.
+;;; A local macro definition is a list ( macro-name expansion-function).
+
+(defvar *funs* nil)
+
+;;; --cmplog.lsp--
+;;;
+;;; Destination of output of different forms. See cmploc.lsp for types
+;;; of destinations.
+;;;
+(defvar *destination*)
+
+;;; --cmptag.lsp--
+;;;
+;;; List of tags with marks for closure boundaries.
+;;;
+(defvar *tags* nil)
+
+;;; --cmptop.lsp--
+;;;
+(defvar *funarg-vars*)
+;;; Number of address registers available not counting the
+;;; frame pointer and the stack pointer
+;;; To do: If the regs hold data then there are really more available;
+(defvar *free-address-registers* 5)
+(defvar *free-data-registers* 6)
+(defvar *volatile*)
+(defvar *setjmps* 0)
+
+(defvar *compile-time-too* nil)
+(defvar *not-compile-time* nil)
+
+(defvar *non-package-operation* nil)
+
+(defvar *objects* nil)			; holds { ( object vv-index ) }*
+(defvar *constants* nil)		; holds { ( symbol vv-index ) }*
+(defvar *sharp-commas* nil)		; holds { vv-index }*, where
+;;;  each vv-index should be turned into an object from a string before
+;;;  defining the current function during loading process, so that
+;;;  sharp-comma-macros may be evaluated correctly.
+
+(defvar *proclaim-fixed-args* nil)	; proclaim automatically functions
+					; with fixed number of arguments.
+					; watch out for multiple values.
+
+(defvar *global-funs* nil)		; holds	{ ( global-fun-name cfun ) }*
+(defvar *linking-calls* nil)		; holds { ( global-fun-name vv ) }*
+(defvar *local-funs* nil)		; holds { ( closurep fun funob ) }*
+(defvar *top-level-forms* nil)		; holds { top-level-form }*
+;;;
+;;;     top-level-form:
+;;;	  ( 'DEFUN'     fun-name cfun lambda-expr doc-vv sp )
+;;;	| ( 'DEFMACRO'  macro-name cfun lambda-expr doc-vv sp )
+;;;	| ( 'ORDINARY'  expr )
+;;;	| ( 'DECLARE'   var-name-vv )
+;;;	| ( 'DEFVAR'	var-name-vv expr doc-vv )
+;;;	| ( 'CLINES'	string* )
+;;;	| ( 'DEFCFUN'	header vs-size body )
+;;;	| ( 'SHARP-COMMA' vv )
+;;;	| ( 'DEFCBODY'	fun-name cfun arg-types type body ) ;;; Beppe
+;;;	| ( 'FUNCTION-CONSTANT'	vv-index fun )              ;;; Beppe
+;;; Eliminated:
+;;;	| ( 'DEFENTRY'	fun-name cfun cvspecs type cfun-name )
+;;;	| ( 'DEFUNC'	fun-name cfun lambda-list string* ) ;;; Beppe
+
+(defvar *reservations* nil)
+(defvar *reservation-cmacro* nil)
+
+;;; *reservations* holds (... ( cmacro . value ) ...).
+;;; *reservation-cmacro* holds the cmacro current used as vs reservation.
+
+(defvar *global-entries* nil)
+
+;;; *global-entries* holds (... ( fname cfun return-types arg-type ) ...).
+
+;;; --cmpvar.lsp--
+;;;
+(defvar *vars* nil)
+(defvar *undefined-vars* nil)
+(defvar *special-binding* nil)
+
+(defvar *register-min* 3)		; criteria for putting in register.
+(proclaim '(fixnum *register-min*))
diff --git a/src/cmp/cmpenv.lsp b/src/cmp/cmpenv.lsp
new file mode 100644
index 000000000..5dc78fabd
--- /dev/null
+++ b/src/cmp/cmpenv.lsp
@@ -0,0 +1,485 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPENV  Environments of the Compiler.
+
+(in-package "COMPILER")
+
+;;; Only these flags are set by the user.
+;;; If *safe-compile* is ON, some kind of run-time checks are not
+;;; included in the compiled code.  The default value is OFF.
+
+(defun init-env ()
+  (setq *max-temp* 0)
+  (setq *temp* 0)
+  (setq *next-cmacro* 0)
+  (setq *next-vv* -1)
+  (setq *next-cfun* 0)
+  (setq *last-label* 0)
+  (setq *objects* nil)
+  (setq *constants* nil)
+  (setq *local-funs* nil)
+  (setq *global-funs* nil)
+  (setq *linking-calls* nil)
+  (setq *global-entries* nil)
+  (setq *undefined-vars* nil)
+  (setq *reservations* nil)
+  (setq *top-level-forms* nil)
+  (setq *compile-time-too* nil)
+  (setq *non-package-operation* nil)
+  (setq *function-declarations* nil)
+  (setq *inline-functions* nil)
+  (setq *inline-blocks* 0)
+  (setq *notinline* nil)
+  )
+
+(defun next-lcl () (incf *lcl*))
+
+(defun next-temp ()
+  (prog1 *temp*
+         (incf *temp*)
+         (setq *max-temp* (max *temp* *max-temp*))))
+
+(defun next-unboxed (type)
+  (let ((tem (incf *next-unboxed*)))
+    (push (list (rep-type type) tem) *unboxed*)
+    tem))
+
+(defun next-lex ()
+  (prog1 (cons *level* *lex*)
+         (incf *lex*)
+         (setq *max-lex* (max *lex* *max-lex*))))
+
+(defun next-env () (prog1 *env*
+		     (incf *env*)
+		     (setq *max-env* (max *env* *max-env*))))
+
+(defun add-symbol (symbol)
+  (let ((x (assoc symbol *objects*)))
+       (cond (x (second x))
+             (t (incf *next-vv*)
+                (push (list symbol *next-vv*) *objects*)
+                (wt-data symbol)
+                *next-vv*))))
+
+(defun add-keyword (symbol)
+  (let ((x (assoc symbol *objects*)))
+      (cond (x (wt-filtered-data (format nil "#!~d" (- (1+ (second x)))))
+	       (incf *next-vv*))
+	    (t (incf *next-vv*)
+	       (push (list symbol *next-vv*) *objects*)
+	       (wt-data symbol)
+	       *next-vv*))))
+
+(defun add-object (object &aux x)
+  ;;; Used only during Pass 1.
+  (cond ((sys:contains-sharp-comma object)
+         ;;; SYS:CONTAINS-SHARP-COMMA returns T iff OBJECT
+         ;;; contains a sharp comma OR a structure.
+         (incf *next-vv*)
+         (push *next-vv* *sharp-commas*)
+         (wt-data (prin1-to-string object))
+         *next-vv*)
+        ((setq x (assoc object *objects*))
+         (second x))
+        (t (incf *next-vv*)
+           (push (list object *next-vv*) *objects*)
+           (wt-data object)
+           *next-vv*)))
+
+(defun add-constant (symbol &aux x)
+  ;;; Used only during Pass 1.
+  (cond ((setq x (assoc symbol *constants*))
+         (second x))
+        (t (incf *next-vv*)
+           (push *next-vv* *sharp-commas*)
+           (wt-data (prin1-to-string (cons 'sys:|#,| symbol)))
+           (push (list symbol *next-vv*) *constants*)
+           *next-vv*)))
+
+(defun function-arg-types (arg-types &aux (types nil))
+  (do ((al arg-types (cdr al)))
+      ((or (endp al)
+           (member (car al) '(&optional &rest &key)))
+       (nreverse types))
+      (declare (object al))
+      (push (type-filter (car al)) types)))
+
+;;; The valid return type declaration is:
+;;;	(( VALUES {type}* )) or ( {type}* ).
+
+(defun function-return-type (return-types)
+  (cond ((endp return-types) t)
+        ((and (consp (car return-types))
+              (eq (caar return-types) 'VALUES))
+         (cond ((not (endp (cdr return-types)))
+                (warn "The function return types ~s is illegal." return-types)
+                t)
+               ((or (endp (cdar return-types))
+                    (member (cadar return-types) '(&optional &rest &key)))
+                t)
+               (t (type-filter (cadar return-types)))))
+        (t (type-filter (car return-types)))))
+
+(defun add-function-proclamation (fname decl &aux
+         arg-types return-types)
+  (cond ((and (symbolp fname)
+	      (listp decl) (listp (cdr decl)))
+	 (cond ((or (null decl)(eq (car decl) '*)) (setq arg-types '*)
+		(remprop fname 'PROCLAIMED-ARG-TYPES))
+	       (t (setq arg-types (function-arg-types (car decl)))
+		  (setf (get fname 'PROCLAIMED-ARG-TYPES) arg-types)))
+	 (cond ((or (null (cdr decl))(eq (second decl) '*))
+		(setq return-types '*))
+	       (t (setq return-types (function-return-type (cdr decl)))))
+         (setf (get fname 'PROCLAIMED-RETURN-TYPE) return-types)
+	 (cond((eql return-types '*))
+	      (t(setq return-types (cdr decl))))
+	 ;;; A non-local function may have local entry only if it returns
+	 ;;; a single value.
+         (if (and (not (endp return-types))
+                  (endp (cdr return-types))
+                  (not (and (consp (car return-types))
+                            (eq (caar return-types) 'VALUES)
+                            (or (endp (cdar return-types))
+                                (not (endp (cddar return-types)))))))
+             (setf (get fname 'PROCLAIMED-FUNCTION) t)
+	   (remprop fname 'PROCLAIMED-FUNCTION)))
+        (t (warn "The function procl ~s ~s is not valid." fname decl))))
+
+(defun add-function-declaration (fname arg-types return-types)
+  (if (symbolp fname)
+      (push (list (sch-local-fun fname)
+		  (function-arg-types arg-types)
+		  (function-return-type return-types))
+	    *function-declarations*)
+      (warn "The function name ~s is not a symbol." fname)))
+
+(defun get-arg-types (fname &aux x)
+  (if (setq x (assoc fname *function-declarations*))
+      (second x)
+      (get fname 'PROCLAIMED-ARG-TYPES)))
+
+(defun get-return-type (fname)
+  (let* ((x (assoc fname *function-declarations*))
+         (type1 (if x (caddr x) (get fname 'PROCLAIMED-RETURN-TYPE))))
+        (cond (type1
+               (let ((type (get fname 'RETURN-TYPE)))
+                    (cond (type
+                           (cond ((setq type (type-and type type1)) type)
+                                 (t
+                                  (cmpwarn
+                                   "The return type of ~s was badly declared."
+                                   fname))))
+                          (t type1))))
+              (t (get fname 'RETURN-TYPE)))
+        ))
+
+(defun get-local-arg-types (fun &aux x)
+  (if (setq x (assoc fun *function-declarations*))
+      (second x)
+      nil))
+
+(defun get-local-return-type (fun &aux x)
+  (if (setq x (assoc fun *function-declarations*))
+      (caddr x)
+      nil))
+
+;;; Proclamation and declaration handling.
+
+(defun inline-possible (fname)
+       (not (or ; *compiler-push-events*
+                (member fname *notinline*)
+                (get fname 'CMP-NOTINLINE))))
+
+#-:CCL
+(defun proclaim (decl)
+  (unless (listp decl)
+	  (error "The proclamation specification ~s is not a list" decl))
+  (case (car decl)
+    (SPECIAL
+     (dolist (var (cdr decl))
+       (if (symbolp var)
+           (sys:*make-special var)
+           (warn "The variable name ~s is not a symbol." var))))
+    (OPTIMIZE
+     (dolist (x (cdr decl))
+       (when (symbolp x) (setq x (list x 3)))
+       (if (or (not (consp x))
+               (not (consp (cdr x)))
+               (not (numberp (second x)))
+               (not (<= 0 (second x) 3)))
+           (warn "The OPTIMIZE proclamation ~s is illegal." x)
+           (case (car x)
+                 (SAFETY (setq *compiler-check-args* (>= (second x) 1))
+                         (setq *safe-compile* (>= (second x) 2))
+                         (setq *compiler-push-events* (>= (second x) 3)))
+                 (SPACE (setq *space* (second x)))
+                 (SPEED (setq *speed* (second x)))
+                 (COMPILATION-SPEED (setq *speed* (- 3 (second x))))
+                 (t (warn "The OPTIMIZE quality ~s is unknown." (car x)))))))
+    (TYPE
+     (if (consp (cdr decl))
+         (proclaim-var (second decl) (cddr decl))
+         (warn "The type declaration ~s is illegal." decl)))
+    ((FIXNUM CHARACTER SHORT-FLOAT LONG-FLOAT)
+     (proclaim-var (car decl) (cdr decl)))
+    (FTYPE
+     (cond ((and (consp (cdr decl))
+		 (consp (second decl)))
+	    (eq (caadr decl) 'FUNCTION)
+	    (dolist (v (cddr decl))
+		    (add-function-proclamation v (cdr (second decl)))
+		    ))
+	   (t (cmpwarn "Bad function proclamation ~a" decl))))
+    (FUNCTION
+     (cond ((and (consp (cdr decl)))
+	    (add-function-proclamation (second decl) (cddr decl)))
+	   (t (cmpwarn "Bad function proclamation ~a" decl))))
+    (INLINE
+     (dolist (fun (cdr decl))
+               (if (symbolp fun)
+                   (remprop fun 'CMP-NOTINLINE)
+                   (warn "The function name ~s is not a symbol." fun))))
+    (NOTINLINE
+     (dolist (fun (cdr decl))
+               (if (symbolp fun)
+                   (setf (get fun 'CMP-NOTINLINE) t)
+                   (warn "The function name ~s is not a symbol." fun))))
+    ((OBJECT IGNORE)
+     (dolist (var (cdr decl))
+       (unless (symbolp var)
+               (warn "The variable name ~s is not a symbol." var))))
+    (DECLARATION
+     (dolist (x (cdr decl))
+       (if (symbolp x)
+           (pushnew x *alien-declarations*)
+           (warn "The declaration specifier ~s is not a symbol." x))))
+    ((ARRAY ATOM BASE-CHAR BIGNUM BIT BIT-VECTOR CHARACTER COMMON COMPILED-FUNCTION
+      COMPLEX CONS DOUBLE-FLOAT EXTENDED-CHAR FIXNUM FLOAT HASH-TABLE INTEGER KEYWORD LIST
+      LONG-FLOAT NIL NULL NUMBER PACKAGE PATHNAME RANDOM-STATE RATIO RATIONAL
+      READTABLE SEQUENCE SHORT-FLOAT SIMPLE-ARRAY SIMPLE-BIT-VECTOR
+      SIMPLE-STRING SIMPLE-VECTOR SINGLE-FLOAT STANDARD-CHAR STREAM STRING
+      SYMBOL T VECTOR SIGNED-BYTE UNSIGNED-BYTE)
+     (proclaim-var (car decl) (cdr decl)))
+    (otherwise
+     (unless (member (car decl) *alien-declarations*)
+             (warn "The declaration specifier ~s is unknown." (car decl)))
+     (and (functionp (get (car decl) :proclaim))
+	  (dolist (v (cdr decl))
+		    (funcall (get (car decl) :proclaim) v))))
+    )
+  nil
+  )
+
+(defun proclaim-var (type vl)
+  (setq type (type-filter type))
+  (dolist (var vl)
+    (if (symbolp var)
+	(let ((type1 (get var 'CMP-TYPE))
+	      (v (sch-global var)))
+	  (setq type1 (if type1 (type-and type1 type) type))
+	  (when v (setq type1 (type-and type1 (var-type v))))
+	  (unless type1
+	    (warn
+	     "Inconsistent type declaration was found for the variable ~s."
+	     var)
+	    (setq type1 T))
+	  (setf (get var 'CMP-TYPE) type1)
+	  (when v (setf (var-type v) type1)))
+	(warn "The variable name ~s is not a symbol." var))))
+
+(defun c1body (body doc-p &aux
+		    (ss nil)		; special vars
+		    (is nil)		; ignored vars
+		    (ts nil)		; typed vars (var . type)
+		    (others nil)	; all other vars
+                    doc form)
+  (loop
+    (when (endp body) (return))
+    (setq form (cmp-macroexpand (car body)))
+    (cond
+     ((stringp form)
+      (when (or (null doc-p) (endp (cdr body)) doc) (return))
+      (setq doc form))
+     ((and (consp form) (eq (car form) 'DECLARE))
+      (dolist (decl (cdr form))
+        (cmpck (or (not (consp decl)) (not (symbolp (car decl))))
+               "The declaration ~s is illegal." (cons form decl))
+        (case (car decl)
+          (SPECIAL
+           (dolist (var (cdr decl))
+             (cmpck (not (symbolp var))
+                    "The special declaration ~s contains a non-symbol ~s."
+                    decl var)
+             (push var ss)))
+          (IGNORE
+           (dolist (var (cdr decl))
+             (cmpck (not (symbolp var))
+                    "The ignore declaration ~s contains a non-symbol ~s."
+                    decl var)
+             (push var is)))
+          (TYPE
+           (cmpck (endp (cdr decl))
+                  "The type declaration ~s is illegal." decl)
+           (let ((type (type-filter (second decl))))
+                (when type
+                      (dolist (var (cddr decl))
+                        (cmpck (not (symbolp var))
+                          "The type declaration ~s contains a non-symbol ~s."
+                          decl var)
+                        (push (cons var type) ts)))))
+          (OBJECT
+           (dolist (var (cdr decl))
+             (cmpck (not (symbolp var))
+                    "The object declaration ~s contains a non-symbol ~s."
+                    decl var)
+             (push (cons var 'OBJECT) ts)))
+	  (:REGISTER
+           (dolist (var (cdr decl))
+	      (cmpck (not (symbolp var))
+		     "The register declaration ~s contains a non-symbol ~s."
+		     decl var)
+	      (push (cons var 'REGISTER) ts)
+	      ))
+	  ;; read-only variable treatment. Beppe
+	  (:READ-ONLY
+#| obsolete
+           (dolist (var (cdr decl))
+	      (cmpck (not (symbolp var))
+		     "In the :read-only declaration ~s, ~s is not a symbol."
+		     decl var)
+	      (push (cons var 'READ-ONLY) ts))
+|#
+	      )
+          ((FIXNUM BASE-CHAR EXTENDED-CHAR CHARACTER DOUBLE-FLOAT SHORT-FLOAT ARRAY ATOM BIGNUM BIT
+            BIT-VECTOR COMMON COMPILED-FUNCTION COMPLEX CONS FLOAT HASH-TABLE
+            INTEGER KEYWORD LIST LONG-FLOAT NIL NULL NUMBER PACKAGE PATHNAME
+            RANDOM-STATE RATIO RATIONAL READTABLE SEQUENCE SIMPLE-ARRAY
+            SIMPLE-BIT-VECTOR SIMPLE-STRING SIMPLE-VECTOR SINGLE-FLOAT
+            STANDARD-CHAR STREAM STRING SYMBOL T VECTOR
+            SIGNED-BYTE UNSIGNED-BYTE)
+           (let ((type (type-filter (car decl))))
+                (when type
+                      (dolist (var (cdr decl))
+                        (cmpck (not (symbolp var))
+                          "The type declaration ~s contains a non-symbol ~s."
+                          decl var)
+                        (push (cons var type) ts)))))
+          (otherwise (push decl others))
+          )))
+     (t (return)))
+    (pop body)
+    )
+  (values body ss ts is others doc)
+  )
+
+(defun c1decl-body (decls body &aux (dl nil))
+  (if (null decls)
+      (c1progn body)
+      (let ((*function-declarations* *function-declarations*)
+            (*alien-declarations* *alien-declarations*)
+            (*notinline* *notinline*)
+            (*space* *space*))
+           (dolist (decl decls dl)
+             (case (car decl)
+              (OPTIMIZE
+               (dolist (x (cdr decl))
+                 (when (symbolp x) (setq x (list x 3)))
+                 (if (or (not (consp x))
+                         (not (consp (cdr x)))
+                         (not (numberp (second x)))
+                         (not (<= 0 (second x) 3)))
+                     (warn "The OPTIMIZE proclamation ~s is illegal." x)
+                     (case (car x)
+                           (SAFETY (push (list 'SAFETY (second x)) dl))
+                           (SPACE (setq *space* (second x))
+                                  (push (list 'SPACE (second x)) dl))
+                           ((SPEED COMPILATION-SPEED))
+                           (t (warn "The OPTIMIZE quality ~s is unknown."
+                                    (car x)))))))
+              (FTYPE
+               (if (or (endp (cdr decl))
+                       (not (consp (second decl)))
+                       (not (eq (caadr decl) 'FUNCTION))
+                       (endp (cdadr decl)))
+                   (warn "The function declaration ~s is illegal." decl)
+                   (dolist (fname (cddr decl))
+                     (add-function-declaration
+                      fname (cadadr decl) (cddadr decl)))))
+              (FUNCTION
+               (if (or (endp (cdr decl))
+                       (endp (cddr decl))
+                       (not (symbolp (second decl))))
+                   (warn "The function declaration ~s is illegal." decl)
+                   (add-function-declaration
+                    (second decl) (caddr decl) (cdddr decl))))
+              (INLINE
+               (dolist (fun (cdr decl))
+                 (if (symbolp fun)
+                     (progn (push (list 'INLINE fun) dl)
+                            (setq *notinline* (remove fun *notinline*)))
+                     (warn "The function name ~s is not a symbol." fun))))
+              (NOTINLINE
+               (dolist (fun (cdr decl))
+                 (if (symbolp fun)
+                     (progn (push (list 'NOTINLINE fun) dl)
+                            (push fun *notinline*))
+                     (warn "The function name ~s is not a symbol." fun))))
+              (DECLARATION
+               (dolist (x (cdr decl))
+                 (if (symbolp x)
+                     (pushnew x *alien-declarations*)
+                     (warn "The declaration specifier ~s is not a symbol."
+                           x))))
+              (otherwise
+               (unless (member (car decl) *alien-declarations*)
+                 (warn "The declaration specifier ~s is unknown."
+                       (car decl))))
+              ))
+           (setq body (c1progn body))
+           (list 'DECL-BODY (second body) dl body)
+           )
+      )
+  )
+
+(setf (get 'decl-body 'c2) 'c2decl-body)
+
+(defun c2decl-body (decls body)
+  (let ((*compiler-check-args* *compiler-check-args*)
+        (*safe-compile* *safe-compile*)
+        (*compiler-push-events* *compiler-push-events*)
+        (*notinline* *notinline*)
+        (*space* *space*))
+       (dolist (decl decls)
+         (case (car decl)
+               (SAFETY
+                (let ((level (second decl)))
+                     (declare (fixnum level))
+                     (setq *compiler-check-args* (>= level 1)
+                           *safe-compile* (>= level 2)
+                           *compiler-push-events* (>= level 3))))
+               (SPACE (setq *space* (second decl)))
+               (NOTINLINE (push (second decl) *notinline*))
+               (INLINE
+                (setq *notinline* (remove (second decl) *notinline*)))
+               (otherwise (baboon))))
+       (c2expr body))
+  )
+
+(defun check-vdecl (vnames ts is)
+  (dolist (x ts)
+    (unless (member (car x) vnames)
+      (cmpwarn "Type declaration was found for not bound variable ~s."
+               (car x))))
+  (dolist (x is)
+    (unless (member x vnames)
+      (cmpwarn "Ignore declaration was found for not bound variable ~s." x)))
+  )
diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp
new file mode 100644
index 000000000..ae9ab9c99
--- /dev/null
+++ b/src/cmp/cmpeval.lsp
@@ -0,0 +1,437 @@
+;;;; CMPEVAL --  The Expression Dispatcher.
+
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    ECoLisp is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "COMPILER")
+
+(defun c1expr* (form info)
+  (setq form (c1expr form))
+  (add-info info (second form) (eq (car form) 'FUNCTION))
+  form)
+
+(defun c1expr (form)
+  (setq form (catch *cmperr-tag*
+    (cond ((symbolp form)
+	   (setq form (chk-symbol-macrolet form))
+	   (cond ((not (symbolp form))
+		  (c1expr form))
+		 ((eq form nil) (c1nil))
+		 ((eq form t) (c1t))
+		 ((keywordp form)
+		  (list 'LOCATION (make-info :type (object-type form))
+			(list 'VV (add-object form))))
+		 ((constantp form)
+		  (let ((val (symbol-value form)))
+		    (or (c1constant-value val nil)
+			(list 'LOCATION (make-info :type (object-type val))
+			      (list 'VV (add-constant form))))))
+		 (t (c1var form))))
+	  ((consp form)
+	   (let ((fun (car form))
+		 ;; #+cltl2
+		 setf-symbol)
+	     (cond ((symbolp fun)
+		    (c1call-symbol fun (cdr form)))
+		   ;; #+cltl2
+		   ((setq setf-symbol (si::setf-namep fun))
+		    (c1call-symbol setf-symbol (cdr form)))
+		   ((and (consp fun) (eq (car fun) 'LAMBDA))
+		    (c1call-lambda (cdr fun) (cdr form)))
+		   ((and (consp fun) (eq (car fun) 'sys:|#,|))
+		    (cmperr "Sharp-comma-macro was found in a bad place."))
+		   (t (cmperr "The function ~s is illegal." fun)))))
+	  (t (c1constant-value form t)))))
+  (if (eq form '*cmperr-tag*) (c1nil) form))
+
+(defun c1sharp-comma (arg)
+  (c1constant-value (cons 'sys:|#,| arg) t))
+
+(defvar *c1nil* (list 'LOCATION (make-info :type (object-type nil)) nil))
+(defun c1nil () *c1nil*)
+(defvar *c1t* (list 'LOCATION (make-info :type (object-type t)) t))
+(defun c1t () *c1t*)
+
+(defun c1call-symbol (fname args &aux fd)
+  (cond ((setq fd (get fname 'c1special)) (funcall fd args))
+	((setq fd (c1call-local fname))
+	 (let* ((info (make-info :sp-change t
+				 :referred-vars
+				 (info-referred-vars (second fd))
+				 :local-referred
+				 (info-local-referred (second fd))))
+		(forms (c1args args info)))
+	   (let ((return-type (get-local-return-type (third fd))))
+	     (when return-type (setf (info-type info) return-type)))
+	   (let ((arg-types (get-local-arg-types (third fd))))
+	     ;; Add type information to the arguments.
+	     (when arg-types
+	       (let ((fl nil))
+		 (dolist (form forms)
+		   (cond ((endp arg-types) (push form fl))
+			 (t (push (and-form-type
+				   (car arg-types) form
+				   (car args))
+				  fl)
+			    (pop arg-types)
+			    (pop args))))
+		 (setq forms (nreverse fl)))))
+	   (list 'CALL-LOCAL info (third fd) forms)))
+	((setq fd (sch-local-macro fname))
+	 (c1expr (cmp-expand-macro fd fname args)))
+	((and (setq fd (get fname 'C1))
+	      (inline-possible fname))
+	 (funcall fd args))
+	((and (setq fd (get fname 'C1CONDITIONAL))
+	      (inline-possible fname)
+	      (funcall fd args)))
+	((setq fd (macro-function fname))
+	 (c1expr (cmp-expand-macro fd fname args)))
+	((setq fd (get fname 'COMPILER-MACRO))
+	 (error "Compiler macros not yet supported")
+	 (c1expr (cmp-eval `(funcall ',fd ',(cons fname args) nil))))
+	((and (setq fd (get fname 'SYS::STRUCTURE-ACCESS))
+	      (inline-possible fname)
+	      ;;; Structure hack.
+	      (consp fd)
+	      (sys::fixnump (cdr fd))
+	      (not (endp args))
+	      (endp (cdr args)))
+	 (case (car fd)
+	   (VECTOR (c1expr `(svref ,(car args) ,(cdr fd)))) ; Beppe
+	   (LIST (c1expr `(sys:list-nth ,(cdr fd) ,(car args))))
+	   (t (c1structure-ref1 (car args) (car fd) (cdr fd)))
+	   )
+	 )
+	((eq fname 'SYS:|#,|)
+	 (cmperr "Sharp-comma-macro was found in a bad place."))
+	(t (let* ((info (make-info
+			 :sp-change (null (get fname 'NO-SP-CHANGE))))
+		  (forms (c1args args info)))
+	     (let ((return-type (get-return-type fname)))
+	       (when return-type (setf (info-type info) return-type)))
+	     (let ((arg-types (get-arg-types fname)))
+	       ;; Add type information to the arguments.
+	       (when arg-types
+		 (do ((fl forms (cdr fl))
+		      (fl1 nil)
+		      (al args (cdr al)))
+		     ((endp fl)
+		      (setq forms (nreverse fl1)))
+		   (cond ((endp arg-types) (push (car fl) fl1))
+			 (t (push (and-form-type (car arg-types)
+						 (car fl)
+						 (car al))
+				  fl1)
+			    (pop arg-types))))))
+	     (let ((arg-types (get fname 'ARG-TYPES)))
+	       ;; Check argument types.
+	       (when arg-types
+		 (do ((fl forms (cdr fl))
+		      (al args (cdr al)))
+		     ((or (endp arg-types) (endp fl)))
+		   (check-form-type (car arg-types)
+				    (car fl) (car al))
+		   (pop arg-types))))
+#|
+	;; Do this in c2call-global, when we know types of variables rebound
+	;; by let
+	     (case fname
+	       (AREF
+		(let ((etype (info-type (cadar forms))))
+		  (when (or (and (eq etype 'STRING)
+				 (setq etype 'CHARACTER))
+			    (and (consp etype)
+				 (or (eq (car etype) 'ARRAY)
+				     (eq (car etype) 'VECTOR))
+				 (setq etype (second etype))))
+		    (setq etype
+			  (type-and (info-type info) etype))
+		    (unless etype
+		      (cmpwarn "Type mismatch was found in ~s."
+			       (cons fname args))
+		      (setq etype T))	; assume no information
+		    (setf (info-type info) etype))))
+	       (SYS:ASET		; (sys:aset value array i0 ... in)
+		(let ((etype (info-type (cadr (second forms)))))
+		  (when (or (and (eq etype 'STRING)
+				 (setq etype 'CHARACTER))
+			    (and (consp etype)
+				 (or (eq (car etype) 'ARRAY)
+				     (eq (car etype) 'VECTOR))
+				 (setq etype (second etype))))
+		    (setq etype
+			  (type-and (info-type info)
+				    (type-and (info-type (cadr (first forms)))
+					      etype)))
+		    (unless etype
+		      (cmpwarn "Type mismatch was found in ~s."
+			       (cons fname args))
+		      (setq etype T))
+		    (setf (info-type info) etype)
+		    (setf (info-type (cadr (first forms))) etype)
+		    ))))
+|#
+	     (list 'CALL-GLOBAL info fname forms)))))
+
+(defun c1call-lambda (lambda-expr args &aux (info (make-info :sp-change t)))
+  (setq args (c1args args info))
+  (setq lambda-expr (c1lambda-expr lambda-expr))
+  (add-info info (second lambda-expr))
+  (list 'CALL-LAMBDA info lambda-expr args (next-cfun)))
+
+(defun c2expr (form)
+  (if (eq (car form) 'CALL-GLOBAL)
+;;; ----------------------------------------------------------------------
+;;; Added optimization for proclaimed functions: Beppe
+;;; ----------------------------------------------------------------------
+    (let ((fname (car *tail-recursion-info*)))
+      (c2call-global (third form) (fourth form) nil
+		     (if (and
+			  (last-call-p)
+			  (symbolp fname) ; locally defined function are
+					; represented as variables
+			  (get fname 'PROCLAIMED-FUNCTION))
+			 (get fname 'PROCLAIMED-RETURN-TYPE)
+			 (info-type (second form)))))
+    (if (or (eq (car form) 'LET)
+	    (eq (car form) 'LET*))
+      (let ((*volatile* (volatile (second form))))
+	(declare (special *volatile*))
+	(apply (get (car form) 'C2) (cddr form)))
+      (apply (get (car form) 'C2) (cddr form)))))
+
+(defun c2expr* (form)
+  (let* ((*exit* (next-label))
+	 (*unwind-exit* (cons *exit* *unwind-exit*))
+	 ;;(*lex* *lex*)
+	 (*lcl* *lcl*)
+	 (*temp* *temp*))
+    (c2expr form)
+    (wt-label *exit*))
+  )
+
+(defun c1progn (forms &aux (fl nil))
+  (cond ((endp forms) (c1nil))
+	((endp (cdr forms)) (c1expr (car forms)))
+	(t (let ((info (make-info)))
+		(dolist (form forms)
+			(setq form (c1expr form))
+			(push form fl)
+			(add-info info (second form)))
+		(setf (info-type info) (info-type (cadar fl)))
+		(list 'PROGN info (nreverse fl))
+		)))
+  )
+
+(defun c2progn (forms)
+  ;; c1progn ensures that the length of forms is not less than 1.
+  (do ((l forms (cdr l))
+       (lex *lex*))
+      ((endp (cdr l))
+       (c2expr (car l)))
+    (let ((*destination* 'TRASH)) (c2expr* (car l)))
+    (setq *lex* lex)			; recycle lex locations
+  ))
+
+(defun c1args (forms info)
+  (mapcar #'(lambda (form) (c1expr* form info)) forms))
+
+;;; Structures
+
+(defun c1structure-ref (args)
+  (if (and (not *safe-compile*)         ; Beppe
+	   (not (endp args))
+	   (not (endp (cdr args)))
+	   (consp (second args))
+	   (eq (caadr args) 'QUOTE)
+	   (not (endp (cdadr args)))
+	   (symbolp (cadadr args))
+	   (endp (cddadr args))
+	   (not (endp (cddr args)))
+	   (sys::fixnump (third args))
+	   (endp (cdddr args)))
+      (c1structure-ref1 (car args) (cadadr args) (third args))
+      (let ((info (make-info)))
+	(list 'CALL-GLOBAL info 'SYS:STRUCTURE-REF (c1args args info)))))
+
+(defun c1structure-ref1 (form name index
+			      &aux (info (make-info
+					  :type (get-slot-type name index))))
+  ;;; Explicitly called from c1expr and c1structure-ref.
+  (list 'SYS:STRUCTURE-REF info (c1expr* form info) (add-symbol name) index))
+
+(defun get-slot-type (name index)
+  ;; default is t
+  (type-filter
+   (or (third (nth index (get name 'SYS::STRUCTURE-SLOT-DESCRIPTIONS))) 'T)))
+
+(defun c2structure-ref (form name-vv index
+			     &aux (*inline-blocks* 0))
+  (let ((loc (second (car (inline-args (list form))))))
+       (unwind-exit (list 'SYS:STRUCTURE-REF loc name-vv index)))
+  (close-inline-blocks)
+  )
+
+(defun wt-structure-ref (loc name-vv index)
+  (if *safe-compile*
+      (wt "structure_ref(" loc ",VV[" name-vv "]," index ")")
+      #+clos
+      (wt "(" loc ")->instance.slots[" index "]")
+      #-clos
+      (wt "(" loc ")->str.self[" index "]")))
+
+(defun c1structure-set (args &aux (info (make-info)))
+  (if (and (not *safe-compile*)         ; Beppe
+	   (not (endp args))
+	   (not (endp (cdr args)))
+	   (consp (second args))
+	   (eq (caadr args) 'QUOTE)
+	   (not (endp (cdadr args)))
+	   (symbolp (cadadr args))
+	   (endp (cddadr args))
+	   (not (endp (cddr args)))
+	   (sys::fixnump (third args))
+	   (not (endp (cdddr args)))
+	   (endp (cddddr args)))
+      (let ((x (c1expr (car args)))
+	    (y (c1expr (fourth args)))
+	    (name (cadadr args)))       ; remove QUOTE.
+	(add-info info (second x))
+	(add-info info (second y))
+	;; Beppe. Type check added:
+	(let* ((slot-type (get-slot-type name (third args)))
+	       (new-type (type-and slot-type (info-type (second y)))))
+	  (if new-type                  ; compatible
+	      (if (eq 'VAR (car y))     ; it's a variable
+		(setf (var-type (car (third y))) new-type)   ; propagate type
+		(setf (info-type (second y)) new-type))
+	      (cmpwarn "The type of the form ~s is not ~s."
+		       (fourth args) slot-type)))
+	(setf (info-type info) (info-type (second y)))
+	(list 'SYS:STRUCTURE-SET info x
+	      (add-symbol name)
+	      (third args) y))
+      (list 'CALL-GLOBAL info 'SYS:STRUCTURE-SET (c1args args info))))
+
+(defun c2structure-set (x name-vv index y
+			  &aux locs (*inline-blocks* 0))
+  ;; the third argument here *c1t* is just a hack to ensure that
+  ;; a variable is introduced for y if it is an expression with side effects
+  (setq locs (inline-args (list x y *c1t*)))
+  (setq x (second (first locs)))
+  (setq y (second (second locs)))
+  (if *safe-compile*
+      (wt-nl "structure_set(" x ",VV[" name-vv "]," index "," y ");")
+      #+clos
+      (wt-nl "(" x ")->instance.slots[" index "]= " y ";")
+      #-clos
+      (wt-nl "(" x ")->str.self[" index "]= " y ";"))
+  (unwind-exit y)
+  (close-inline-blocks)
+  )
+
+;;; ----------------------------------------------------------------------
+;;; Instances
+
+#+clos
+(defun c1instance-ref (args &aux (info (make-info)))
+  (let ((form (first args))
+	(index (second args)))
+    (if (sys::fixnump index)
+	(list 'SYS:INSTANCE-REF info (c1expr* form info) index)
+      (list 'CALL-GLOBAL info 'SYS:INSTANCE-REF (c1args args info)))))
+
+#+clos
+(defun c2instance-ref (form index
+			    &aux (*inline-blocks* 0))
+  (let ((loc (second (car (inline-args (list form))))))
+    (unwind-exit (list 'SYS:INSTANCE-REF loc index)))
+  (close-inline-blocks)
+  )
+
+#+clos
+(defun wt-instance-ref (loc index)
+  (if *safe-compile*
+      (wt "instance_ref(" loc "," index ")")
+      (wt "(" loc ")->instance.slots[" index "]")))
+
+;;; ----------------------------------------------------------------------
+
+(defun c1constant-value (val always-p)
+  (cond
+   ((eq val nil) (c1nil))
+   ((eq val t) (c1t))
+   ((sys::fixnump val)
+    (list 'LOCATION (make-info :type 'FIXNUM)
+	  (list 'FIXNUM-VALUE val)))
+   ((characterp val)
+    (list 'LOCATION (make-info :type 'CHARACTER)
+	  (list 'CHARACTER-VALUE (char-code val))))
+   ((typep val 'LONG-FLOAT)
+    (list 'LOCATION (make-info :type 'LONG-FLOAT)
+	  (list 'LONG-FLOAT-VALUE val (add-object val))))
+   ((typep val 'SHORT-FLOAT)
+    (list 'LOCATION (make-info :type 'SHORT-FLOAT)
+	  (list 'SHORT-FLOAT-VALUE val (add-object val))))
+   (always-p
+    (list 'LOCATION (make-info :type (object-type val))
+	  (list 'VV (add-object val))))
+   (t nil)))
+
+(defmacro sys::define-compiler-macro (name vl &rest body)
+  `(progn (setf (get ',name 'COMPILER-MACRO)
+		(sys::expand-defmacro ',name ',vl ',body))
+	  ',name))  
+
+(defun sys::undef-compiler-macro (name)
+  (remprop name 'COMPILER-MACRO))
+
+(defvar *compiler-temps*
+	'(tmp0 tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 tmp7 tmp8 tmp9))
+
+(defmacro sys::define-inline-function (name vars &body body)
+  (let ((temps nil)
+	(*compiler-temps* *compiler-temps*))
+    (dolist (var vars)
+      (if (and (symbolp var)
+	       (not (member var '(&OPTIONAL &REST &KEY &AUX) :test #'eq)))
+	(push (or (pop *compiler-temps*)
+		  (gentemp "TMP" (find-package 'COMPILER)))
+	      temps)
+	(error "The parameter ~s for the inline function ~s is illegal."
+	       var name)))
+    (let ((binding (cons 'LIST (mapcar
+				#'(lambda (var temp) `(list ',var ,temp))
+				vars temps))))
+      `(progn
+	 (defun ,name ,vars ,@body)
+	 (sys::define-compiler-macro ,name ,temps
+				    (list* 'LET ,binding ',body))))))
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'PROGN 'C1SPECIAL) 'c1progn)
+(setf (get 'PROGN 'C2) 'c2progn)
+
+(setf (get 'sys:|#,| 'c1 ) 'c1sharp-comma)
+
+(setf (get 'SYS:STRUCTURE-REF 'C1) 'c1structure-ref)
+(setf (get 'SYS:STRUCTURE-REF 'C2) 'c2structure-ref)
+(setf (get 'SYS:STRUCTURE-REF 'WT-LOC) 'wt-structure-ref)
+(setf (get 'SYS:STRUCTURE-SET 'C1) 'c1structure-set)
+(setf (get 'SYS:STRUCTURE-SET 'C2) 'c2structure-set)
+
+#+clos
+(setf (get 'SYS:INSTANCE-REF 'C1) 'c1instance-ref)
+#+clos
+(setf (get 'SYS:INSTANCE-REF 'C2) 'c2instance-ref)
+#+clos
+(setf (get 'SYS:INSTANCE-REF 'WT-LOC) 'wt-instance-ref)
diff --git a/src/cmp/cmpexit.lsp b/src/cmp/cmpexit.lsp
new file mode 100644
index 000000000..13baafceb
--- /dev/null
+++ b/src/cmp/cmpexit.lsp
@@ -0,0 +1,225 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPEXIT  Exit manager.
+
+(in-package "COMPILER")
+
+(defun unwind-bds (bds-lcl bds-bind)
+  (declare (fixnum bds-bind))
+  (when bds-lcl (wt-nl "bds_unwind(") (wt-lcl bds-lcl) (wt ");"))
+  (dotimes (n bds-bind) (declare (fixnum n)) (wt-nl "bds_unwind1;")))
+
+(defun unwind-exit (loc &optional (jump-p nil)
+                        &aux (bds-lcl nil) (bds-bind 0))
+  (declare (fixnum bds-bind))
+  (when (consp *destination*)
+    (case (car *destination*)
+      (JUMP-TRUE
+       (set-jump-true loc (second *destination*))
+       (when (eq loc t) (return-from unwind-exit)))
+      (JUMP-FALSE
+       (set-jump-false loc (second *destination*))
+       (when (eq loc nil) (return-from unwind-exit)))))
+  (flet ((single-valued-call (loc)
+	   (member (car loc)
+		   '(INLINE INLINE-COND INLINE-FIXNUM
+		     INLINE-CHARACTER INLINE-LONG-FLOAT INLINE-SHORT-FLOAT)
+		   :test #'eq)))
+    (dolist (ue *unwind-exit* (baboon))
+      ;; perform all unwind-exit's which precede *exit*
+      (cond
+	((consp ue)			; ( label# . ref-flag )
+	 (cond ((eq ue *exit*)
+		;; all body forms except the last (returning) are dealt here
+		(cond ((and (consp *destination*)
+			    (or (eq (car *destination*) 'JUMP-TRUE)
+				(eq (car *destination*) 'JUMP-FALSE)))
+		       (unwind-bds bds-lcl bds-bind))
+		      ((not (or bds-lcl (plusp bds-bind)))
+		       (set-loc loc))
+		      ;; Save the value if LOC may possibly refer
+		      ;; to special binding.
+		      ((and (consp loc)
+			    (or (and (eq (car loc) 'VAR)
+				     (member (var-kind (second loc))
+					     '(SPECIAL GLOBAL)
+					     :test #'eq))
+				(single-valued-call loc))
+			    ;; no need for temporary if we can use
+			    ;; *destination* directly
+			    (consp *destination*)
+			    (member (car *destination*)
+				    '(VAR BIND PUSH-CATCH-FRAME)
+				    :test #'eq))
+		       (let* ((*temp* *temp*)
+			      (temp (list 'TEMP (next-temp))))
+			 (let ((*destination* temp))
+			   (set-loc loc)) ; temp <- loc
+			 (unwind-bds bds-lcl bds-bind)
+			 (set-loc temp))) ; *destination* <- temp
+		      (t
+		       (set-loc loc)
+		       (unwind-bds bds-lcl bds-bind)))
+		(when jump-p (wt-nl) (wt-go *exit*))
+		(return))
+	       (t (setq jump-p t))))
+	((numberp ue) (setq bds-lcl ue
+			    bds-bind 0))
+	(t (case ue
+	     (BDS-BIND (incf bds-bind))
+	     (RETURN
+	       (unless (eq *exit* 'RETURN) (baboon))
+	       ;; *destination* must be either RETURN or TRASH.
+	       (cond ((eq loc 'VALUES)
+		      ;; from multiple-value-prog1 or values
+		      (when (or bds-lcl (plusp bds-bind))
+			(unwind-bds bds-lcl bds-bind))
+		      (wt-nl "return VALUES(0);"))
+		     ((eq loc 'RETURN)
+		      ;; from multiple-value-prog1 or values
+		      (when (or bds-lcl (plusp bds-bind))
+			(unwind-bds bds-lcl bds-bind))
+		      (wt-nl "return value0;"))		      
+		     ((or bds-lcl (plusp bds-bind))
+		      (let* ((*destination* 'RETURN))
+			(set-loc loc))
+		      (unwind-bds bds-lcl bds-bind)
+		      (wt-nl "return value0;"))
+		     ((and (consp loc)
+			   (member (car loc) '(CALL CALL-LOCAL)
+				   :test #'eq))
+		      (wt-nl "return(" loc ");"))
+		     (t
+		      (set-loc loc)
+		      (wt-nl "return value0;")))
+	       (return))
+	     (RETURN-FIXNUM
+	      (when (eq *exit* ue)
+		;; *destination* must be RETURN-FIXNUM
+		(if (or bds-lcl (plusp bds-bind))
+		    (let ((lcl (next-lcl)))
+		      (wt-nl "{int ") (wt-lcl lcl) (wt "= ")
+		      (wt-fixnum-loc loc) (wt ";")
+		      (unwind-bds bds-lcl bds-bind)
+		      (wt-nl "return(") (wt-lcl lcl) (wt ");}"))
+		    (progn
+		      (wt-nl "return(") (wt-fixnum-loc loc) (wt ");")))
+		(return)))
+	     (RETURN-CHARACTER
+	      (when (eq *exit* ue)
+		;; *destination* must be RETURN-CHARACTER
+		(if (or bds-lcl (plusp bds-bind))
+		    (let ((lcl (next-lcl)))
+		      (wt-nl "{unsigned char ") (wt-lcl lcl) (wt "= ")
+		      (wt-character-loc loc) (wt ";")
+		      (unwind-bds bds-lcl bds-bind)
+		      (wt-nl "return(") (wt-lcl lcl) (wt ");}"))
+		    (progn
+		      (wt-nl "return(") (wt-character-loc loc) (wt ");")))
+		(return)))
+	     (RETURN-LONG-FLOAT
+	      (when (eq *exit* ue)
+		;; *destination* must be RETURN-LONG-FLOAT
+		(if (or bds-lcl (plusp bds-bind))
+		    (let ((lcl (next-lcl)))
+		      (wt-nl "{double ") (wt-lcl lcl) (wt "= ")
+		      (wt-long-float-loc loc) (wt ";")
+		      (unwind-bds bds-lcl bds-bind)
+		      (wt-nl "return(") (wt-lcl lcl) (wt ");}"))
+		    (progn
+		      (wt-nl "return(") (wt-long-float-loc loc) (wt ");")))
+		(return)))
+	     (RETURN-SHORT-FLOAT
+	      (when (eq *exit* ue)
+		;; *destination* must be RETURN-SHORT-FLOAT
+		(if (or bds-lcl (plusp bds-bind))
+		    (let ((lcl (next-lcl)))
+		      (wt-nl "{float ") (wt-lcl lcl) (wt "= ")
+		      (wt-short-float-loc loc) (wt ";")
+		      (unwind-bds bds-lcl bds-bind)
+		      (wt-nl "return(") (wt-lcl lcl) (wt ");}"))
+		    (progn
+		      (wt-nl "return(") (wt-short-float-loc loc) (wt ");")))
+		(return)))
+	     (RETURN-OBJECT
+	      (when (eq *exit* ue)
+		;; *destination* must be RETURN-OBJECT
+		(if (or bds-lcl (plusp bds-bind))
+		    (progn
+		      (wt-nl "{cl_object x =" loc ";")
+		      (unwind-bds bds-lcl bds-bind)
+		      (wt-nl "return(x);}"))
+		    (wt-nl "return(" loc ");"))
+		(return)))
+	     (FRAME
+	      (let ((*destination* 'RETURN))
+		(set-loc loc)
+		(setq loc *destination*))
+	      (wt-nl "frs_pop();"))
+	     (TAIL-RECURSION-MARK)
+	     (JUMP (setq jump-p t))
+	     (t (baboon)))))))
+  ;;; Never reached
+  )
+
+(defun unwind-no-exit (exit &aux (bds-lcl nil) (bds-bind 0))
+  (declare (fixnum bds-bind))
+  (dolist (ue *unwind-exit* (baboon))
+    (cond
+       ((consp ue)
+        (when (eq ue exit)
+              (unwind-bds bds-lcl bds-bind)
+              (return)))
+       ((numberp ue) (setq bds-lcl ue bds-bind 0))
+       ((eq ue 'BDS-BIND) (incf bds-bind))
+       ((member ue '(RETURN RETURN-OBJECT RETURN-FIXNUM RETURN-CHARACTER
+                            RETURN-LONG-FLOAT RETURN-SHORT-FLOAT))
+        (if (eq exit ue)
+          (progn (unwind-bds bds-lcl bds-bind)
+                 (return))
+          (baboon))
+        ;;; Never reached
+        )
+       ((eq ue 'FRAME) (wt-nl "frs_pop();"))
+       ((eq ue 'TAIL-RECURSION-MARK)
+        (if (eq exit 'TAIL-RECURSION-MARK)
+          (progn (unwind-bds bds-lcl bds-bind)
+                 (return))
+          (baboon))
+        ;;; Never reached
+        )
+       ((eq ue 'JUMP))
+       (t (baboon))
+       ))
+  ;;; Never reached
+  )
+
+;;; Tail-recursion optimization for a function F is possible only if
+;;;	1. F receives only required parameters, and
+;;;	2. no required parameter of F is enclosed in a closure.
+;;;
+;;; A recursive call (F e1 ... en) may be replaced by a loop only if
+;;;	1. F is not declared as NOTINLINE,
+;;;	2. n is equal to the number of required parameters of F,
+;;;	3. the form is a normal function call (i.e. args are not ARGS-PUSHED),
+;;;	4. (F e1 ... en) is not surrounded by a form that causes dynamic
+;;;	   binding (such as LET, LET*, PROGV),
+;;;	5. (F e1 ... en) is not surrounded by a form that that pushes a frame
+;;;	   onto the frame-stack (such as BLOCK and TAGBODY whose tags are
+;;;	   enclosed in a closure, and CATCH),
+
+(defun tail-recursion-possible ()
+  (dolist (ue *unwind-exit* (baboon))
+    (cond ((eq ue 'TAIL-RECURSION-MARK) (return t))
+          ((or (numberp ue) (eq ue 'BDS-BIND) (eq ue 'FRAME))
+           (return nil))
+          ((or (consp ue) (eq ue 'JUMP)))
+          (t (baboon)))))
diff --git a/src/cmp/cmpflet.lsp b/src/cmp/cmpflet.lsp
new file mode 100644
index 000000000..c9f72b122
--- /dev/null
+++ b/src/cmp/cmpflet.lsp
@@ -0,0 +1,370 @@
+;;;;  CMPFLET  Flet, Labels, and Macrolet.
+
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "COMPILER")
+
+#|
+;;; Use a structure of type vector to avoid creating
+;;; normal structures before booting CLOS:
+(defstruct (fun (:type vector) :named)
+  name			;;; Function name.
+  ref			;;; Referenced or not.
+  			;;; During Pass1, T or NIL.
+       			;;; During Pass2, the vs-address for the
+       			;;; function closure, or NIL.
+  ref-ccb		;;; Cross closure reference.
+ 			;;; During Pass1, T or NIL.
+	 		;;; During Pass2, the vs-address for the
+       			;;; function closure, or NIL.
+  cfun			;;; The cfun for the function.
+  level			;;; Level of nesting for a function.
+  env     		;;; Size of env of closure.
+  closure		;;; During Pass1, T if the function is returned
+			;;; During Pass2, T if env is used inside the function
+  ) |#
+
+(defun c1flet (args &aux body ss ts is other-decl info
+                         (defs nil) (local-funs nil))
+  (when (endp args) (too-few-args 'flet 1 0))
+  (let ((*funs* *funs*))
+    (dolist (def (car args))
+      (cmpck (or (endp def)
+                 (not (symbolp (car def)))
+                 (endp (cdr def)))
+             "The function definition ~s is illegal." def)
+      (let ((fun (make-fun :name (car def))))
+        (push fun *funs*)
+        (push (list fun (cdr def)) defs)))
+
+    (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t))
+    
+    (let ((*vars* *vars*))
+      (c1add-globals ss)
+      (check-vdecl nil ts is)
+      (setq body (c1decl-body other-decl body)))
+    (setq info (copy-info (second body))))
+
+  (dolist (def (nreverse defs))
+    (let ((fun (car def)) lam CB/LB)
+      (when (plusp (fun-ref fun))
+	(setq CB/LB (if (fun-ref-ccb fun) 'CB 'LB))
+	(setq lam
+	      (let ((*funs* (cons CB/LB *funs*))
+		    (*vars* (cons CB/LB *vars*))
+		    (*blocks* (cons CB/LB *blocks*))
+		    (*tags* (cons CB/LB *tags*)))
+		(c1lambda-expr (second def) (fun-name fun))))
+	(add-info info (second lam) CB/LB)
+	(push (list fun lam) local-funs)
+	(setf (fun-cfun fun) (next-cfun)))))
+
+  ;; cant do in previous loop since closed var may be in later function
+  (dolist (fun-lam local-funs)
+    (setf (fun-closure (first fun-lam)) (closure-p (second fun-lam))))
+
+  (if local-funs
+      (list 'LOCALS info (nreverse local-funs) body nil)
+      body))
+
+(defun closure-p (funob)
+  (let ((info (second funob)))
+    ;; It's a closure if inside its body there is a reference (var)
+    (dolist (var (info-referred-vars info))
+      ;; referred across CB
+      (when (ref-ref-ccb var)
+	;; established outside the body
+	(when (or
+	       (member var *vars* :test #'eq)
+	       (member var *funs* :test #'eq :key
+		       #'(lambda (x) (unless (symbolp x) (fun-var x))))
+	       (member var *blocks* :test #'eq :key
+		       #'(lambda (x) (unless (symbolp x) (blk-var x))))
+	       (member var *tags* :test #'eq :key
+		       #'(lambda (x) (unless (symbolp x) (tag-var x)))))
+	  (return t))))))
+
+(defvar *within-labels* NIL)		;; used to optimize lex env
+
+(defun c2locals (funs body labels ;; labels is T when deriving from labels
+		      &aux block-p
+		      (level *level*)
+		      (*env* *env*)
+		      (*env-lvl* *env-lvl*) env-grows)
+  ;; create location for each function which is returned,
+  ;; either in lexical:
+  (dolist (def funs)
+    (let* ((fun (car def)) (var (fun-var fun)))
+      (when (plusp (var-ref var))	; the function is returned
+        (unless (eq 'LEXICAL (var-kind var))
+          (setf (var-loc var) (next-lcl))
+          (unless block-p
+            (setq block-p t) (wt-nl "{ "))
+          (wt "cl_object ") (wt-lcl (var-loc var)) (wt ";"))
+	(unless env-grows
+	  (setq env-grows (var-ref-ccb var))))))
+  ;; or in closure environment:
+  (when (env-grows env-grows)
+    (unless block-p
+      (wt-nl "{ ") (setq block-p t))
+    (let ((env-lvl *env-lvl*))
+      (wt "volatile cl_object env" (incf *env-lvl*) " = env" env-lvl ";")))
+  ;; bind such locations:
+  ;; - first create binding (because of possible circularities)
+  (dolist (def funs)
+    (let* ((fun (car def)) (var (fun-var fun)))
+      (when (and var (plusp (var-ref var)))
+	(when labels
+	  (incf (fun-env fun)))		; var is included in the closure env
+	(bind nil var))))
+  ;; - then assign to it
+  (dolist (def funs)
+    (let* ((fun (car def)) (var (fun-var fun)))
+      (when (and var (plusp (var-ref var)))
+	(set-var (list 'MAKE-CCLOSURE fun) var))))
+  ;; we need to introduce a new lex when lexical variables
+  ;; are present in body and:
+  ;;   it is a LABELS (each recursive calls needs a new lex)
+  ;;   or it is the outermost FLET (nested FLETS can use a single lex)
+  (when (and (plusp *lex*)
+	     (or labels (not *within-labels*)))
+    (incf level))
+  ;; create the functions:
+  (dolist (def funs)
+    (let* ((fun (car def)) (var (fun-var fun)) previous)
+      (when (setq previous (new-local level fun (second def)))
+	(setf (fun-level fun) (fun-level previous)
+	      (fun-env fun) (fun-env previous)))))
+
+  (let (;(*level* level)
+	(*within-labels* labels))
+    (c2expr body))
+  (when block-p (wt-nl "}")))
+
+(defun c1labels (args &aux body ss ts is other-decl info
+                      defs fun local-funs
+                      fnames (*funs* *funs*))
+  (when (endp args) (too-few-args 'labels 1 0))
+
+  ;;; bind local-functions
+  (dolist (def (car args))
+    (cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def)))
+           "The local function definition ~s is illegal." def)
+    (cmpck (member (car def) fnames)
+           "The function ~s was already defined." (car def))
+    (push (car def) fnames)
+    (let ((fun (make-fun :name (car def))))
+      (push fun *funs*)
+      (push (list fun NIL (cdr def)) defs)))
+
+  (setq defs (nreverse defs))
+
+  ;;; Now DEFS holds ( { ( fun-object processed body ) }* ).
+
+  (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t))
+  (let ((*vars* *vars*))
+    (c1add-globals ss)
+    (check-vdecl nil ts is)
+    (setq body (c1decl-body other-decl body)))
+  (setq info (copy-info (second body)))
+
+  (do ((finished))
+      (finished)
+    (setq finished t)
+    (dolist (def defs)
+      (setq fun (car def))
+      (when (and (plusp (fun-ref fun))	; referred
+		 (not (fun-ref-ccb fun)) ; not within closure
+                 (not (second def)))	; but not processed yet
+        (setq finished nil)
+        (let ((*vars* (cons 'LB *vars*))
+              (*funs* (cons 'LB *funs*))
+              (*blocks* (cons 'LB *blocks*))
+              (*tags* (cons 'LB *tags*)))
+          (let ((lam (c1lambda-expr (third def) (fun-name fun))))
+            (add-info info (second lam) 'LB)
+            (push (list fun lam) local-funs)))
+	(setf (second def) T)))
+    )
+
+  (do ((finished))
+      (finished)
+    (setq finished t)
+    (dolist (def defs)
+      (setq fun (car def))
+      (when (and fun			; not processed yet
+                 (fun-ref-ccb fun))	; referred across closure
+	(setq finished nil)
+	(when (second def)
+	  ;; also processed as local, e.g.:
+	  ;; (defun foo (z) (labels ((g () z) (h (y) #'g)) (list (h z) (g))))
+	  (setq local-funs (delete fun local-funs :key #'car)))
+	(let ((*vars* (cons 'CB *vars*))
+	      (*funs* (cons 'CB *funs*))
+	      (*blocks* (cons 'CB *blocks*))
+	      (*tags* (cons 'CB *tags*)))
+	  (let ((lam (c1lambda-expr (third def) (fun-name fun))))
+	    (add-info info (second lam) 'CB)
+	    (push (list fun lam) local-funs)))
+	(setf (car def) NIL)))		; def processed
+    )
+
+  (dolist (fun-lam local-funs)
+    (setq fun (first fun-lam))
+    (setf (fun-closure fun) (closure-p (second fun-lam)))
+    (setf (fun-cfun fun) (next-cfun)))
+
+  (if local-funs
+      (list 'LOCALS info local-funs body T) ; T means labels
+      body))
+
+(defun c1macrolet (args &aux (*funs* *funs*) (*vars* *vars*))
+  (when (endp args) (too-few-args 'macrolet 1 0))
+  (dolist (def (car args))
+    (cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def)))
+           "The macro definition ~s is illegal." def)
+    (push (list (car def)
+		'MACRO
+		(si::make-lambda (car def)
+				 (cdr (sys::expand-defmacro (car def) (second def) (cddr def)))))
+          *funs*))
+  (multiple-value-bind (body ss ts is other-decl)
+      (c1body (cdr args) t)
+    (c1add-globals ss)
+    (check-vdecl nil ts is)
+    (c1decl-body other-decl body)))
+
+(defun c1symbol-macrolet (args &aux (*funs* *funs*) (*vars* *vars*))
+  (when (endp args) (too-few-args 'symbol-macrolet 1 0))
+  (dolist (def (car args))
+    (cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def)))
+           "The symbol-macro definition ~s is illegal." def)
+    (push def *vars*))
+  (multiple-value-bind (body ss ts is other-decl)
+      (c1body (cdr args) t)
+    (c1add-globals ss)
+    (check-vdecl nil ts is)
+    (c1decl-body other-decl body)))
+
+(defun local-closure (fname &aux (ccb nil) (clb nil))
+  (dolist (fun *funs*)
+    (cond ((eq fun 'CB) (setq ccb t))
+	  ((eq fun 'LB) (setq clb t))
+	  ((consp fun)			; macro
+	   (when (eq fname (car fun))
+	     (return nil)))
+          ((eq (fun-name fun) fname)
+	   (incf (fun-ref fun))
+	   ;; we introduce a variable to hold the funob
+	   (let ((var (or (fun-var fun)
+			  (setf (fun-var fun)
+				(make-var :name fname :kind 'OBJECT)))))
+	     (cond (ccb (setf (var-ref-ccb var) t
+			      (var-kind var) 'LEXICAL)
+			(setf (fun-ref-ccb fun) t))
+		   (clb (setf (var-kind var) 'LEXICAL))))
+	   (return fun)))))
+
+(defun c1call-local (fname)
+  ;; used by c1funob and c1call-symbol
+  (let ((fun (local-closure fname)))
+    (when fun
+      (list 'LOCAL (make-info :local-referred (list (fun-var fun))
+				   :referred-vars  (list (fun-var fun)))
+	    fun))))
+
+(defun sch-local-fun (fname)
+  ;; Returns fun-ob for the local function (not locat macro) named FNAME,
+  ;; if any.  Otherwise, returns FNAME itself.
+  (dolist (fun *funs* fname)
+    (when (and (not (eq fun 'CB))
+               (not (consp fun))
+               (eq (fun-name fun) fname))
+          (return fun))))
+
+(defun sch-local-macro (fname)
+  (dolist (fun *funs*)
+    (when (and (consp fun)
+               (eq (first fun) fname))
+          (return (third fun)))))
+
+(defun c2call-local (fun args &optional narg)
+  (declare (type fun fun))
+  (cond
+   ((and (listp args)
+         *tail-recursion-info*
+         (eq (car *tail-recursion-info*) (fun-name fun))
+         (eq *exit* 'RETURN)
+         (tail-recursion-possible)
+         (= (length args) (length (cdr *tail-recursion-info*))))
+    (let* ((*destination* 'TRASH)
+           (*exit* (next-label))
+           (*unwind-exit* (cons *exit* *unwind-exit*)))
+          (c2psetq
+	   (mapcar #'(lambda (v) (list v)) ; nil (ccb)
+		   (cdr *tail-recursion-info*))
+	   args)
+          (wt-label *exit*))
+    (unwind-no-exit 'TAIL-RECURSION-MARK)
+    (wt-nl "goto TTL;")
+    (cmpnote "Tail-recursive call of ~s was replaced by iteration."
+             (fun-name fun)))
+   (t (let ((*inline-blocks* 0)
+	    (fun (format nil "LC~d" (fun-cfun fun)))
+	    (lex-level (fun-level fun))
+	    (closure-p (fun-closure fun))
+	    (fname (fun-name fun)))
+	(unwind-exit
+	 (if (eq 'ARGS-PUSHED args)
+	     (list 'CALL-LOCAL "APPLY" lex-level closure-p
+		   (list fun "&VALUES(0)") narg fname)
+	     (list 'CALL-LOCAL fun lex-level closure-p
+		   (coerce-locs (inline-args args) nil) narg fname)))
+	(close-inline-blocks)))))
+
+(defun wt-call-local (fun lex-lvl closure-p args narg fname)
+  (declare (fixnum lex-lvl))
+  ;; if NARG is non-NIL it is location containing narg
+  (let ((nenv (if closure-p (1+ lex-lvl) lex-lvl)))
+    (declare (fixnum nenv))
+    (wt fun "(")
+    (if narg
+	(progn
+	  (wt-loc narg)
+	  (when (plusp nenv)
+	    (wt "+" nenv)))
+	(progn
+	  (wt (+ (length args) nenv))
+	  (when (plusp lex-lvl)
+	    (dotimes (n lex-lvl)
+	      (wt ",lex" n)))
+	  (when closure-p
+	    ;; env of local fun is ALWAYS contained in current env (?)
+	    (wt ", env" *env-lvl*))))
+    (dolist (arg args)
+      (wt "," arg))
+    (wt ")")
+    (when fname (wt-comment fname))))
+
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'FLET 'C1SPECIAL) 'c1flet)
+(setf (get 'LABELS 'C1SPECIAL) 'c1labels)
+(setf (get 'MACROLET 'C1SPECIAL) 'c1macrolet)
+(setf (get 'SYMBOL-MACROLET 'C1SPECIAL) 'c1symbol-macrolet)
+
+(setf (get 'LOCALS 'c2) 'c2locals)	; replaces both c2flet and c2lables
+;;; c2macrolet is not defined, because MACROLET is replaced by PROGN
+;;; during Pass 1.
+(setf (get 'CALL-LOCAL 'C2) 'c2call-local)
+
+(setf (get 'CALL-LOCAL 'WT-LOC) #'wt-call-local)
diff --git a/src/cmp/cmpfun.lsp b/src/cmp/cmpfun.lsp
new file mode 100644
index 000000000..4dfe5fd62
--- /dev/null
+++ b/src/cmp/cmpfun.lsp
@@ -0,0 +1,593 @@
+;;;;  CMPFUN  Library functions.
+
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi and William F. Schelter.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+
+(in-package "COMPILER")
+
+(defvar *princ-string-limit* 80)
+
+(defun c1princ (args &aux stream (info (make-info)))
+  (when (endp args) (too-few-args 'PRINC 1 0))
+  (unless (or (endp (cdr args)) (endp (cddr args)))
+	  (too-many-args 'PRINC 2 (length args)))
+  (setq stream (if (endp (cdr args))
+		   (c1nil)
+		   (c1expr* (second args) info)))
+  (if (and (or (and (stringp (car args))
+		    (<= (length (car args)) *princ-string-limit*))
+	       (characterp (car args)))
+	   (or (endp (cdr args))
+	       (and (eq (car stream) 'VAR)
+		    (member (var-kind (car (third stream)))
+			    '(GLOBAL SPECIAL) :test #'eq))))
+      (list 'PRINC info (car args)
+	    (if (endp (cdr args)) nil (var-loc (caaddr stream)))
+	    stream)
+      (list 'CALL-GLOBAL info 'PRINC
+	    (list (c1expr* (car args) info) stream))))
+
+(defun c2princ (string vv-index stream)
+  (cond ((eq *destination* 'TRASH)
+	 (cond ((characterp string)
+		(wt-nl "princ_char(" (char-code string))
+		(if (null vv-index) (wt ",Cnil")
+		    (wt ",symbol_value(VV[" vv-index "])"))
+		(wt ");"))
+	       ((= (length string) 1)
+		(wt-nl "princ_char(" (char-code (aref string 0)))
+		(if (null vv-index) (wt ",Cnil")
+		    (wt ",symbol_value(VV[" vv-index "])"))
+		(wt ");"))
+	       (t
+		(wt-nl "princ_str(\"")
+		(dotimes (n (length string))
+		  (declare (fixnum n))
+		  (let ((char (schar string n)))
+		       (cond ((char= char #\\) (wt "\\\\"))
+			     ((char= char #\") (wt "\\\""))
+			     ((char= char #\Newline) (wt "\\n"))
+			     (t (wt char)))))
+		(wt "\",")
+		(if (null vv-index) (wt "Cnil")
+		    (wt "symbol_value(VV[" vv-index "])"))
+		(wt ");")))
+	 (unwind-exit nil))
+	((eql string #\Newline) (c2call-global 'TERPRI (list stream) nil t))
+	(t (c2call-global
+	    'PRINC
+	    (list (list 'LOCATION
+			*info*
+			(list 'VV (add-object string)))
+		  stream) nil t))))
+
+(defun c1terpri (args &aux stream (info (make-info)))
+  (unless (or (endp args) (endp (cdr args)))
+	  (too-many-args 'TERPRI 1 (length args)))
+  (setq stream (if (endp args)
+		   (c1nil)
+		   (c1expr* (car args) info)))
+  (if (or (endp args)
+	  (and (eq (car stream) 'VAR)
+	       (member (var-kind (car (third stream)))
+		       '(GLOBAL SPECIAL) :test #'eq)))
+      (list 'PRINC info #\Newline
+	    (if (endp args) nil (var-loc (caaddr stream)))
+	    stream)
+      (list 'CALL-GLOBAL info 'TERPRI (list stream))))
+
+(defun c1apply (args &aux info)
+  (when (or (endp args) (endp (cdr args)))
+	(too-few-args 'APPLY 2 (length args)))
+  (let* ((fun (first args))
+	 (funob (c1funob fun))
+	lambda-expr lambda-list)
+    (setq info (second funob)
+	  args (c1args (cdr args) info))
+    (if (and (eq (first funob) 'LAMBDA)
+	     (null (second (setq lambda-list ; No optional
+				 (third (setq lambda-expr (third funob))))))
+	     (null (fourth lambda-list))) ; No keyword
+	(c1apply-optimize info
+			  (first lambda-list)
+			  (third lambda-list)
+			  (fifth lambda-expr)
+			  args)
+	(case (first funob)
+	  (ORDINARY
+	   (list 'CALL-GLOBAL info 'APPLY (cons (third funob) args)))
+	  (GLOBAL
+	   (list 'CALL-GLOBAL info 'APPLY (cons (c1function (cdr fun)) args)))
+	  ((LAMBDA LOCAL)
+	   (list 'APPLY-LAMBDA/LOCAL info funob args))))))
+
+(defun c2apply-lambda/local (funob args)
+  (let* ((loc (save-funob funob))
+	 (temp *temp*)
+	 (*temp* temp)			; allow reuse of TEMP variables
+	 (arg (list 'TEMP 0))
+	 (narg (list 'LCL (next-lcl)))
+	 (is-lambda (eq 'LAMBDA (first funob))))
+    ;; We must prepare in VALUES the following:
+    ;; n, lex0, ..., lexk, env, arg1, ..., argn
+    (wt-nl "{ int " narg ", i=0;")
+    (dolist (expr args)
+      (setf (second arg) (next-temp))
+      (let ((*destination* arg)) (c2expr* expr)))
+    (wt-nl narg "=length(" arg ")+" (1- (length args)) ";")
+    (setf (second arg) temp)		; restart numbering
+    (unless is-lambda
+      (let* ((fun (third funob))
+	     (lex-lvl (fun-level fun))
+	     (closure-lvl (when (fun-closure fun) (- *env* (fun-env fun)))))
+	(when (plusp lex-lvl)
+	  (dotimes (n lex-lvl)
+	    (wt-nl "VALUES(i++)=(cl_object)lex" n ";")))
+	(setq temp lex-lvl)		; count environment arguments
+	(when closure-lvl
+	  ;; env of local fun is ALWAYS contained in current env (?)
+	  (wt-nl "VALUES(i++)=(cl_object)env" *env-lvl* ";")
+	  (incf temp))))
+    (dotimes (i (1- (length args)))
+      (wt-nl "VALUES(i++)=" arg ";")
+      (incf (second arg)))
+    (unless is-lambda
+      (wt narg "+=" temp ";"))
+    (wt-nl "for (; i<" narg ";i++," arg "=CDR(" arg "))")
+    (wt-nl "	VALUES(i)=CAR(" arg ");")
+    (if is-lambda
+	(c2funcall funob 'ARGS-PUSHED loc narg)
+	(c2call-local (third funob) 'ARGS-PUSHED narg))
+    (wt-nl "}")))
+
+(defun c1apply-optimize (info requireds rest body args
+			      &aux (vl nil) (fl nil))
+  (do ()
+      ((or (endp (cdr args)) (endp requireds)))
+    (push (pop requireds) vl)
+    (push (pop args) fl))
+
+  (cond ((cdr args)
+	 (cmpck (null rest)
+		"APPLY passes too many arguments to LAMBDA expression.")
+	 (push rest vl)
+	 (push (list 'CALL-GLOBAL info 'LIST* args) fl)
+	 (list 'LET info (nreverse vl) (nreverse fl) body))
+	(t
+	 (let ((*vars* *vars*)
+	       (temp (or rest (make-var :name (gensym) :kind 'OBJECT
+					:ref (length args)))))
+	   (push-vars temp)
+	   (push temp vl)
+	   (push (car args) fl)
+	   (list 'LET info (nreverse vl) (nreverse fl)
+		 (list 'LET*
+		       (second body)
+		       requireds
+		       (make-list (length requireds)
+				  :initial-element
+				  (c1expr `(pop ,(var-name temp))))
+		       body))))))
+
+(defun c1rplaca (args &aux (info (make-info)))
+  (when (or (endp args) (endp (cdr args)))
+	(too-few-args 'RPLACA 2 (length args)))
+  (unless (endp (cddr args))
+	  (too-many-args 'RPLACA 2 (length args)))
+  (setq args (c1args args info))
+  (list 'RPLACA info args))
+
+(defun c2rplaca (args &aux (*inline-blocks* 0) x y)
+  (setq args (inline-args args)
+	x (second (first args))
+	y (second (second args)))
+  (safe-compile
+   (wt-nl "if(ATOM(" x "))"
+	  "FEtype_error_cons(" x ");"))
+  (wt-nl "CAR(" x ") = " y ";")
+  (unwind-exit x)
+  (close-inline-blocks))
+
+(defun c1rplacd (args &aux (info (make-info)))
+  (when (or (endp args) (endp (cdr args)))
+	(too-few-args 'RPLACD 2 (length args)))
+  (when (not (endp (cddr args)))
+	(too-many-args 'RPLACD 2 (length args)))
+  (setq args (c1args args info))
+  (list 'RPLACD info args))
+
+(defun c2rplacd (args &aux (*inline-blocks* 0) x y)
+  (setq args (inline-args args)
+	x (second (first args))
+	y (second (second args)))
+  (safe-compile
+   (wt-nl "if(ATOM(" x "))"
+	  "FEtype_error_cons(" x ");"))
+  (wt-nl "CDR(" x ") = " y ";")
+  (unwind-exit x)
+  (close-inline-blocks))
+
+(defun c1member (args &aux (info (make-info)))
+  (when (or (endp args) (endp (cdr args)))
+	(too-few-args 'MEMBER 2 (length args)))
+  (cond ((endp (cddr args))
+	 (list 'MEMBER!2 info 'EQL (c1args args info)))
+	((and (eq (third args) :test)
+	      (= (length args) 4)       ; Beppe
+	      (member (fourth args) '('EQ #'EQ 'EQUAL #'EQUAL 'EQL #'EQL)
+		      :test #'EQUAL))	; arg4 = (QUOTE EQ)
+	 (list 'MEMBER!2 info (second (fourth args))
+	       (c1args (list (car args) (second args)) info)))
+	(t
+	 (list 'CALL-GLOBAL info 'MEMBER (c1args args info)))))
+
+(defun c2member!2 (fun args
+		       &aux (*inline-blocks* 0))
+  (setq args (coerce-locs (inline-args args) nil))
+  (unwind-exit
+   (list 'INLINE nil
+	 (case fun
+	   (EQ "memq(#0,#1)")
+	   (EQL "memql(#0,#1)")
+	   (EQUAL "member(#0,#1)")) args))
+  (close-inline-blocks))
+
+(defun c1assoc (args &aux (info (make-info)))
+  (when (or (endp args) (endp (cdr args)))
+	(too-few-args 'ASSOC 2 (length args)))
+  (cond ((endp (cddr args))
+	 (list 'ASSOC!2 info 'EQL (c1args args info)))
+	((and (eq (third args) ':TEST)
+	      (= (length args) 4)       ; Beppe
+	      (member (fourth args) '('EQ #'EQ 'EQUAL #'EQUAL
+				      'EQUALP #'EQUALP 'EQL #'EQL)
+		      :test 'EQUAL))
+	 (list 'ASSOC!2 info (second (fourth args))
+	       (c1args (list (car args) (second args)) info)))
+	(t
+	 (list 'CALL-GLOBAL info 'ASSOC (c1args args info)))))
+
+(defun c2assoc!2 (fun args
+		      &aux (*inline-blocks* 0))
+  (setq args (coerce-locs (inline-args args) nil))
+  (unwind-exit
+   (list 'INLINE nil
+	 (case fun
+	   (eq "assq(#0,#1)")
+	   (eql "assql(#0,#1)")
+	   (equal "assoc(#0,#1)")
+	   (equalp "assqlp(#0,#1)")) args)) ;Beppe
+  (close-inline-blocks))
+
+(defun co1nth (args)
+  (and (not (endp args))
+       (not (endp (cdr args)))
+       (endp (cddr args))
+       (numberp (car args))
+       (<= 0 (car args) 7)
+       (c1expr (case (car args)
+		     (0 (cons 'CAR (cdr args)))
+		     (1 (cons 'CADR (cdr args)))
+		     (2 (cons 'CADDR (cdr args)))
+		     (3 (cons 'CADDDR (cdr args)))
+		     (4 (list 'CAR (cons 'CDDDDR (cdr args))))
+		     (5 (list 'CADR (cons 'CDDDDR (cdr args))))
+		     (6 (list 'CADDR (cons 'CDDDDR (cdr args))))
+		     (7 (list 'CADDDR (cons 'CDDDDR (cdr args))))
+		     ))))
+
+(defun co1nthcdr (args)
+  (and (not (endp args))
+       (not (endp (cdr args)))
+       (endp (cddr args))
+       (numberp (car args))
+       (<= 0 (car args) 7)
+       (c1expr (case (car args)
+		 (0 (second args))
+		 (1 (cons 'CDR (cdr args)))
+		 (2 (cons 'CDDR (cdr args)))
+		 (3 (cons 'CDDDR (cdr args)))
+		 (4 (cons 'CDDDDR (cdr args)))
+		 (5 (list 'CDR (cons 'CDDDDR (cdr args))))
+		 (6 (list 'CDDR (cons 'CDDDDR (cdr args))))
+		 (7 (list 'CDDDR (cons 'CDDDDR (cdr args))))))))
+
+(defun c1rplaca-nthcdr (args &aux (info (make-info)))
+  (when (or (endp args) (endp (cdr args)) (endp (cddr args)))
+	(too-few-args 'SYS:RPLACA-NTHCDR 3 (length args)))
+  (unless (endp (cdddr args))
+	  (too-few-args 'SYS:RPLACA-NTHCDR 3 (length args)))
+  (if (and (numberp (second args)) (<= 0 (second args) 10))
+      (list 'RPLACA-NTHCDR-IMMEDIATE info
+	    (second args)
+	    (c1args (list (car args) (third args)) info))
+      (list 'CALL-GLOBAL info 'SYS:RPLACA-NTHCDR (c1args args info))))
+
+(defun c2rplaca-nthcdr-immediate (index args
+					&aux (*inline-blocks* 0))
+  (declare (fixnum index))
+  (setq args (coerce-locs (inline-args args) nil))
+  (if *safe-compile*
+      (progn
+       (wt-nl "{cl_object l= ")
+       (dotimes (i index) (declare (fixnum i)) (wt "cdr("))
+       (wt (car args))
+       (dotimes (i index)(declare (fixnum i)) (wt ")"))
+       (wt ";")
+       (wt-nl "if(ATOM(l)) FEtype_error_cons(l);")
+       (wt-nl "CAR(l)= " (second args) ";}"))
+      (progn
+	(wt-nl "CAR(")
+       (dotimes (i index) (declare (fixnum i)) (wt "CDR("))
+       (wt (car args))
+       (dotimes (i index) (declare (fixnum i)) (wt ")"))
+       (wt ")= " (second args) ";")))
+  (unwind-exit (second args))
+  (close-inline-blocks))
+
+(defun c1list-nth (args &aux (info (make-info)))
+  (when (or (endp args) (endp (cdr args)))
+	(too-few-args 'SYS:RPLACA-NTHCDR 2 (length args)))
+  (unless (endp (cddr args))
+	  (too-few-args 'SYS:RPLACA-NTHCDR 2 (length args)))
+  (if (and (numberp (car args)) (<= 0 (car args) 10))
+      (list 'LIST-NTH-IMMEDIATE info
+	    (car args)
+	    (c1args (list (second args)) info))
+      (list 'CALL-GLOBAL info 'SYS:LIST-NTH (c1args args info))))
+
+(defun c2list-nth-immediate (index args &aux (l (next-lcl))
+					     (*inline-blocks* 0))
+  (declare (fixnum index))
+  (setq args (coerce-locs (inline-args args) nil))
+  (wt-nl "{cl_object ") (wt-lcl l) (wt "= ")
+  (if *safe-compile*
+      (progn
+       (dotimes (i index) (declare (fixnum i)) (wt "cdr("))
+       (wt (car args))
+       (dotimes (i index) (declare (fixnum i)) (wt ")"))
+       (wt ";")
+       (wt-nl "if(ATOM(") (wt-lcl l) (wt "))")
+       (wt-nl " FEtype_error_cons(") (wt-lcl l) (wt ");")
+       )
+      (progn
+       (dotimes (i index) (declare (fixnum i)) (wt "CDR("))
+       (wt (car args))
+       (dotimes (i index) (declare (fixnum i)) (wt ")"))
+       (wt ";")))
+  (unwind-exit (list 'CAR l))
+  (wt "}")
+  (close-inline-blocks))
+
+;----------------------------------------------------------------------
+
+(defun co1ash (args)
+  (let ((shamt (second args)) type fun)
+    (when (cond ((and (constantp shamt)
+		      (sys::fixnump (setq shamt (eval shamt))))
+		 (setq fun (if (< shamt 0) 'SHIFT>> 'SHIFT<<)))
+		((and (consp shamt)
+		      (eq (car shamt) 'THE)
+		      (or (subtypep (setq type (second shamt))
+				    '(INTEGER 0 100))
+			  (and (boundp 'SYS::*ASH->>*) sys::*ash->>*
+			       (subtypep type '(INTEGER -100 0)))))
+		 (setq fun
+		       ;; it had to be a (the type..)
+		       (cond ((subtypep type '(INTEGER 0 100))
+			      'SHIFT<<)
+			     ((subtypep type '(INTEGER -100 0))
+			      'SHIFT>>)))))
+      (c1expr (cons fun args)))))
+
+(defun shift>> (a b) (ash a b))
+(defun shift<< (a b) (ash a b))
+(setf (get 'SHIFT>> 'Lfun) "Lash")
+(setf (get 'SHIFT<< 'Lfun) "Lash")
+
+;----------------------------------------------------------------------
+
+(defun co1boole (args)
+   (and (not (endp (cddr args)))
+	(endp (cdddr args))
+	(let ((op-code (first args))
+	      (info (make-info))
+	      c1args)
+	  (and (constantp op-code)
+	       (sys:fixnump (setq op-code (eval op-code)))
+	       (setq c1args (c1args (cons op-code (rest args)) info))
+	       (eq 'FIXNUM (info-type (second (second c1args))))
+	       (eq 'FIXNUM (info-type (second (third c1args))))
+	       `(BOOLE ,info ,c1args)))))
+
+(defun c2boole (args)
+  (flet ((coerce-to-fixnums (locs)
+	   (do ((l locs (cdr l)))
+	       ((null l) locs)
+	     (unless (eq 'FIXNUM (caar l))
+	       (setf (caar l) 'fixnum-loc)))))
+    (let* ((boole-op-arg (third (first args)))
+	   (string (ecase (second boole-op-arg)
+		     (#. boole-clr "(0)")
+		     (#. boole-set "(1)")
+		     (#. boole-1 "(#0)")
+		     (#. boole-2 "(#1)")
+		     (#. boole-c1 "(~(#0))")
+		     (#. boole-c2 "(~(#1))")
+		     (#. boole-and "((#0) & (#1))")
+		     (#. boole-ior "((#0) | (#1))")
+		     (#. boole-xor "((#0) ^ (#1))")
+		     (#. boole-eqv   "(~((#0) ^ (#1)))")
+		     (#. boole-nand "(~((#0) & (#1)))")
+		     (#. boole-nor   "(~((#0)|(#1)))")
+		     (#. boole-andc1 "((~(#0))&(#1))")
+		     (#. boole-andc2 "(((#0))&(~(#1)))")
+		     (#. boole-orc1  "(~(#0) | (#1))")
+		     (#. boole-orc2  "((#0) | (~(#1)))"))))
+      (let ((*inline-blocks* 0))
+	(unwind-exit
+	 (list 'INLINE-FIXNUM nil string
+	       (coerce-to-fixnums (inline-args (rest args)))))
+	(close-inline-blocks)))))
+
+;----------------------------------------------------------------------
+
+(defun co1coerce (args &aux expr type (info (make-info)))
+  (and args (cdr args) (endp (cddr args))
+       (let ((expr (first args))
+	     (type (second args)))
+	 (and (listp type)
+	      (eq (car type) 'QUOTE)
+	      (case (second type)
+		((CHARACTER BASE-CHAR) (c1expr `(CHARACTER ,expr)))
+		(FLOAT (c1expr `(FLOAT ,expr)))
+		((SINGLE-FLOAT SHORT-FLOAT) (c1expr `(FLOAT ,expr 0.0S0)))
+		((DOUBLE-FLOAT LONG-FLOAT) (c1expr `(FLOAT ,expr 0.0L0))))))))
+
+;----------------------------------------------------------------------
+;; turn repetitious cons's into a list*
+
+(defun co1cons (args &aux temp)
+  (labels ((cons-to-lista (x)
+	     (let ((tem (last x)))
+	       (if (and (consp tem)
+			(consp (car tem))
+			(eq (caar tem) 'CONS)
+			(eql (length (cdar tem)) 2))
+		   (cons-to-lista (append (butlast x) (cdar tem)))
+		   x))))
+    (and (eql (length args) 2)
+	 (not (eq args (setq temp (cons-to-lista args))))
+	 (c1expr (if (equal '(nil) (last temp))
+		     (cons 'LIST (butlast temp))
+		     (cons 'LIST* temp))))))
+
+;----------------------------------------------------------------------
+
+;; Return the most particular type we can EASILY obtain from x.  
+(defun result-type (x)
+  (cond ((symbolp x)
+	 (info-type (second (c1expr x))))
+	((constantp x)
+	 (type-filter (type-of x)))
+	((and (consp x) (eq (car x) 'the))
+	 (type-filter (second x)))
+	(t t)))
+
+(defun co1eql (args)
+  (when (and (cdr args)
+	     (not *safe-compile*)
+	     (flet ((replace-constant (lis)
+		      (do ((v lis (cdr v))
+			   (found) (tem))
+			  ((null v) found)
+			(when (and (constantp (car v))
+				   (or (numberp (setq tem (eval (car v))))
+				       (characterp tem)))
+			  (setq found t) (setf (car v) tem)))))
+	       (replace-constant args)))
+    (when (characterp (second args))
+      (setq args (reverse args)))
+    (when (characterp (car args))
+      (let ((c (gensym)))
+	(c1expr
+	 `(let ((,c ,(second args)))
+	   (declare (type ,(result-type (second args)) ,c))
+	   (and (characterp ,c)
+	    (= (char-code ,(car args))
+	     (the fixnum (char-code (the character ,c)))))))))))
+
+;----------------------------------------------------------------------
+
+(defun co1ldb (args &aux (arg1 (first args))
+		    (len (* 8 (round (integer-length most-positive-fixnum) 8)))
+		    size pos)
+    (and (consp arg1)
+	 (eq 'BYTE (car arg1))
+	 (integerp (setq size (second arg1)))
+	 (integerp (setq pos (third arg1)))
+	 (<= (+ size pos) len)
+	 (subtypep (result-type (second args)) 'FIXNUM)
+	 (c1expr `(the fixnum (ldb1 ,size ,pos ,(second args))))))
+
+(push '((fixnum fixnum fixnum) fixnum nil nil
+	"((((~(-1 << (#0))) << (#1)) & (#2)) >> (#1))")
+      (get 'ldb1 ':INLINE-ALWAYS))
+
+;----------------------------------------------------------------------
+
+(defun co1vector-push (args) (co1vector-push1 nil args))
+(defun co1vector-push-extend (args) (co1vector-push1 t args))
+(defun co1vector-push1 (extend args)
+  (unless (or *safe-compile*
+	      (> *space* 3)
+	      (null (cdr args)))
+    (let ((*space* 10))
+      (c1expr
+       `(let* ((.val ,(car args))
+	       (.vec ,(second args))
+	       (.i (fill-pointer .vec))
+	       (.dim (array-total-size .vec)))
+	 (declare (fixnum .i .dim)
+	  (type ,(result-type (second args)) .vec)
+	  (type ,(result-type (car args)) .val))
+	 (cond ((< .i .dim)
+		(the fixnum (sys::fill-pointer-set .vec (the fixnum (+ 1 .i))))
+		(sys::aset .val .vec .i)
+		.i)
+	       (t ,(when extend
+		     `(vector-push-extend .val .vec ,@(cddr args))))))))))
+
+;----------------------------------------------------------------------
+
+(defun co1schar (args)
+   (and (listp (car args)) (not *safe-compile*)
+	(cdr args)
+	(eq (caar args) 'SYMBOL-NAME)
+	(c1expr `(aref (the string ,(second (car args)))
+		  ,(second args)))))
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'princ 'C1) 'c1princ)
+(setf (get 'princ 'C2) 'c2princ)
+(setf (get 'terpri 'C1) 'c1terpri)
+
+(setf (get 'apply 'C1) 'c1apply)
+(setf (get 'apply-lambda/local 'C2) 'c2apply-lambda/local)
+
+(setf (get 'rplaca 'C1) 'c1rplaca)
+(setf (get 'rplaca 'C2) 'c2rplaca)
+(setf (get 'rplacd 'C1) 'c1rplacd)
+(setf (get 'rplacd 'C2) 'c2rplacd)
+
+(setf (get 'member 'C1) 'c1member)
+(setf (get 'member!2 'C2) 'c2member!2)
+(setf (get 'assoc 'C1) 'c1assoc)
+(setf (get 'assoc!2 'C2) 'c2assoc!2)
+
+(setf (get 'nth 'C1CONDITIONAL) 'co1nth)
+(setf (get 'nthcdr 'C1CONDITIONAL) 'co1nthcdr)
+(setf (get 'sys:rplaca-nthcdr 'C1) 'c1rplaca-nthcdr)
+(setf (get 'rplaca-nthcdr-immediate 'C2) 'c2rplaca-nthcdr-immediate)
+(setf (get 'sys:list-nth 'C1) 'c1list-nth)
+(setf (get 'list-nth-immediate 'C2) 'c2list-nth-immediate)
+
+(setf (get 'ash 'C1CONDITIONAL) 'co1ash)
+(setf (get 'boole 'C2) 'c2boole)
+(setf (get 'boole 'C1CONDITIONAL) 'co1boole)
+(setf (get 'coerce 'C1CONDITIONAL) 'co1coerce)
+(setf (get 'cons 'C1CONDITIONAL) 'co1cons)
+(setf (get 'eql 'C1CONDITIONAL) 'co1eql)		    
+(setf (get 'ldb 'C1CONDITIONAL) 'co1ldb)
+(setf (get 'schar 'C1CONDITIONAL) 'co1schar)
+(setf (get 'vector-push 'C1CONDITIONAL) 'co1vector-push)
+(setf (get 'vector-push-extend 'C1CONDITIONAL) 'co1vector-push-extend)
diff --git a/src/cmp/cmpif.lsp b/src/cmp/cmpif.lsp
new file mode 100644
index 000000000..4cdf2e5c9
--- /dev/null
+++ b/src/cmp/cmpif.lsp
@@ -0,0 +1,367 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPIF  Conditionals.
+
+(in-package "COMPILER")
+
+(defun c1if (args &aux info f)
+  (when (or (endp args) (endp (cdr args)))
+        (too-few-args 'if 2 (length args)))
+  (unless (or (endp (cddr args)) (endp (cdddr args)))
+          (too-many-args 'if 3 (length args)))
+  (setq f (c1fmla-constant (car args)))
+  (case f
+        ((T) (c1expr (second args)))
+        ((NIL) (if (endp (cddr args)) (c1nil) (c1expr (third args))))
+        (otherwise
+         (setq info (make-info))
+         (list 'IF info
+               (c1fmla f info)
+               (c1expr* (second args) info)
+               (if (endp (cddr args)) (c1nil) (c1expr* (third args) info)))))
+  )
+
+(defun c1fmla-constant (fmla &aux f)
+  (cond
+   ((consp fmla)
+    (case (car fmla)
+          (AND (do ((fl (cdr fmla) (cdr fl)))
+                   ((endp fl) t)
+		 (setq f (c1fmla-constant (car fl)))
+		 (case f
+		   ((T))
+		   ((NIL) (return nil))
+		   (t (if (endp (cdr fl))
+			  (return f)
+			  (return (list* 'AND f (cdr fl))))))))
+          (OR (do ((fl (cdr fmla) (cdr fl)))
+                  ((endp fl) nil)
+		(setq f (c1fmla-constant (car fl)))
+		(case f
+		  ((T) (return t))
+		  ((NIL))
+		  (t (if (endp (cdr fl))
+			 (return f)
+			 (return (list* 'OR f (cdr fl))))))))
+          ((NOT NULL)
+           (when (endp (cdr fmla)) (too-few-args 'not 1 0))
+           (unless (endp (cddr fmla))
+                   (too-many-args 'not 1 (length (cdr fmla))))
+           (setq f (c1fmla-constant (second fmla)))
+           (case f
+                 ((T) nil)
+                 ((NIL) t)
+                 (t (list 'NOT f))))
+          (t fmla)))
+   ((symbolp fmla) (if (constantp fmla)
+                       (if (symbol-value fmla) t nil)
+                       fmla))
+   (t t))
+  )
+
+(defun c1fmla (fmla info)
+  (if (consp fmla)
+      (case (car fmla)
+            (AND (case (length (cdr fmla))
+                   (0 (c1t))
+                   (1 (c1fmla (second fmla) info))
+                   (t (cons 'FMLA-AND
+                            (mapcar #'(lambda (x) (c1fmla x info))
+                                    (cdr fmla))))))
+            (OR (case (length (cdr fmla))
+                   (0 (c1nil))
+                   (1 (c1fmla (second fmla) info))
+                   (t (cons 'FMLA-OR
+                            (mapcar #'(lambda (x) (c1fmla x info))
+                                    (cdr fmla))))))
+            ((NOT NULL)
+                  (when (endp (cdr fmla)) (too-few-args 'not 1 0))
+                  (unless (endp (cddr fmla))
+                          (too-many-args 'not 1 (length (cdr fmla))))
+                  (list 'FMLA-NOT (c1fmla (second fmla) info)))
+            (t (c1expr* fmla info)))
+      (c1expr* fmla info))
+  )
+
+(defun c2if (fmla form1 form2
+                  &aux (Tlabel (next-label)) Flabel)
+  (cond ((and (eq (car form2) 'LOCATION)
+              (null (third form2))
+              (eq *destination* 'TRASH)
+              (not (eq *exit* 'RETURN)))
+         (let ((exit *exit*)
+               (*unwind-exit* (cons Tlabel *unwind-exit*))
+               (*exit* Tlabel))
+              (CJF fmla Tlabel exit))
+         (wt-label Tlabel)
+         (c2expr form1))
+        (t
+         (setq Flabel (next-label))
+         (let ((*unwind-exit* (cons Flabel (cons Tlabel *unwind-exit*)))
+               (*exit* Tlabel))
+              (CJF fmla Tlabel Flabel))
+         (wt-label Tlabel)
+         (let ((*unwind-exit* (cons 'JUMP *unwind-exit*))
+	       (*temp* *temp*))
+	   (c2expr form1))
+         (wt-label Flabel)
+         (c2expr form2)))
+  )
+
+;;; If fmla is true, jump to Tlabel.  If false, do nothing.
+(defun CJT (fmla Tlabel Flabel)
+  (case (car fmla)
+    (FMLA-AND (do ((fs (cdr fmla) (cdr fs)))
+                  ((endp (cdr fs))
+                   (CJT (car fs) Tlabel Flabel))
+                (let* ((label (next-label))
+                       (*unwind-exit* (cons label *unwind-exit*)))
+                  (CJF (car fs) label Flabel)
+                  (wt-label label))))
+    (FMLA-OR (do ((fs (cdr fmla) (cdr fs)))
+                 ((endp (cdr fs))
+                  (CJT (car fs) Tlabel Flabel))
+               (let* ((label (next-label))
+                      (*unwind-exit* (cons label *unwind-exit*)))
+                 (CJT (car fs) Tlabel label)
+                 (wt-label label))))
+    (FMLA-NOT (CJF (second fmla) Flabel Tlabel))
+    (LOCATION
+     (case (third fmla)
+       ((T) (unwind-no-exit Tlabel) (wt-nl) (wt-go Tlabel))
+       ((NIL))
+       (t (let ((*destination* (list 'JUMP-TRUE Tlabel)))
+            (c2expr* fmla)))))
+    (t (let ((*destination* (list 'JUMP-TRUE Tlabel))) (c2expr* fmla))))
+  )
+
+;;; If fmla is false, jump to Flabel.  If true, do nothing.
+(defun CJF (fmla Tlabel Flabel)
+  (case (car fmla)
+    (FMLA-AND (do ((fs (cdr fmla) (cdr fs)))
+                  ((endp (cdr fs)) (CJF (car fs) Tlabel Flabel))
+                (declare (object fs))
+                (let* ((label (next-label))
+                       (*unwind-exit* (cons label *unwind-exit*)))
+                  (CJF (car fs) label Flabel)
+                  (wt-label label))))
+    (FMLA-OR (do ((fs (cdr fmla) (cdr fs)))
+                 ((endp (cdr fs)) (CJF (car fs) Tlabel Flabel))
+               (declare (object fs))
+               (let* ((label (next-label))
+                      (*unwind-exit* (cons label *unwind-exit*)))
+                 (CJT (car fs) Tlabel label)
+                 (wt-label label))))
+    (FMLA-NOT (CJT (second fmla) Flabel Tlabel))
+    (LOCATION
+     (case (third fmla)
+       ((T))
+       ((NIL) (unwind-no-exit Flabel) (wt-nl) (wt-go Flabel))
+       (t (let ((*destination* (list 'JUMP-FALSE Flabel)))
+            (c2expr* fmla)))))
+    (t (let ((*destination* (list 'JUMP-FALSE Flabel))) (c2expr* fmla))))
+  )
+
+(defun c1and (args)
+  (cond ((endp args) (c1t))
+        ((endp (cdr args)) (c1expr (car args)))
+        (t (let ((info (make-info))) (list 'AND info (c1args args info))))))
+
+(defun c2and (forms)
+  (do ((forms forms (cdr forms))
+       (form))
+      ((endp (cdr forms))
+       (c2expr (car forms)))
+    (declare (list forms))
+    (setq form (first forms))
+    (cond ((eq (car form) 'LOCATION)
+           (case (third form)
+             ((T))
+             ((NIL) (unwind-exit nil 'JUMP))
+             (t (wt-nl "if(" (third form) "==Cnil){")
+                (unwind-exit nil 'JUMP) (wt "}")
+                )))
+          ((eq (car form) 'VAR)
+           (wt-nl "if(")
+           (wt-var (car (third form)))	; (second (third form)) ccb
+           (wt "==Cnil){")
+           (unwind-exit nil 'JUMP) (wt "}"))
+          (t
+           (let* ((label (next-label))
+                  (*unwind-exit* (cons label *unwind-exit*)))
+             (let ((*destination* (list 'JUMP-TRUE label)))
+               (c2expr* form))
+             (unwind-exit nil 'JUMP)
+             (wt-label label))))
+      ))
+
+(defun c1or (args)
+  (cond ((endp args) (c1nil))
+        ((endp (cdr args)) (c1expr (car args)))
+        (t (let ((info (make-info)))
+                (list 'OR info (c1args args info))))))
+
+(defun c2or (forms &aux temp)
+  (do ((forms forms (cdr forms))
+       (form))
+      ((endp (cdr forms))
+       (c2expr (car forms)))
+    (declare (list forms))
+    (setq form (first forms))
+    (cond ((eq (car form) 'LOCATION)
+	   (case (third form)
+	     ((T) (unwind-exit t 'JUMP))
+	     ((NIL))
+	     (t (wt-nl "if(" (third form) "!=Cnil){")
+		(unwind-exit (third form) 'JUMP) (wt "}"))))
+	  ((eq (car form) 'VAR)
+	   (wt-nl "if(")
+	   (wt-var (car (third form)))	; (second (third form)) ccb
+	   (wt "!=Cnil){")
+	   (unwind-exit (cons 'VAR (third form)) 'JUMP) (wt "}"))
+	  ((and (eq (car form) 'CALL-GLOBAL)
+		(get (third form) 'PREDICATE))
+	   (let* ((label (next-label))
+		  (*unwind-exit* (cons label *unwind-exit*)))
+	     (let ((*destination* (list 'JUMP-FALSE label)))
+	       (c2expr* form))
+	     (unwind-exit t 'JUMP)
+	     (wt-label label)))
+	  #+locative
+	  ((and (eq (car form) 'CALL-GLOBAL)
+		(eq (get (third form) 'PROCLAIMED-RETURN-TYPE) 'NULL))
+	   (let ((*destination* 'TRASH))
+	     (c2expr* form)))
+	  (t
+	   (let* ((label (next-label))
+		  (*unwind-exit* (cons label *unwind-exit*)))
+	     ;; to hanlde (or (foo) ..), since foo may be inlined,
+	     ;; we force the result into VALUES(0)
+	     (let ((*destination* 'RETURN)) (c2expr* form))
+	     (wt-nl "if(value0==Cnil)") (wt-go label)
+	     (unwind-exit 'RETURN 'JUMP)
+	     (wt-label label))))
+    )
+  )
+
+(defun set-jump-true (loc label)
+  (unless (null loc)
+    (cond ((eq loc t))
+	  ((atom loc)
+	   (wt-nl "if(" loc ")"))
+          ((eq (car loc) 'INLINE-COND)
+           (wt-nl "if(")
+           (wt-inline-loc (third loc) (fourth loc))
+           (wt ")"))
+	  ;; Get calls inside conditional
+          (t (wt-nl "if((" loc ")!=Cnil)")))
+    (unless (eq loc t) (wt "{"))
+    (unwind-no-exit label)
+    (wt-nl) (wt-go label)
+    (unless (eq loc t) (wt "}")))
+  )
+
+(defun set-jump-false (loc label)
+  (unless (eq loc t)
+    (cond ((null loc))
+	  ((atom loc)
+	   (wt-nl "if(" loc ")"))
+          ((eq (car loc) 'INLINE-COND)
+           (wt-nl "if(!(")
+           (wt-inline-loc (third loc) (fourth loc))
+           (wt "))"))
+          (t (wt-nl "if((" loc ")==Cnil)")))
+    (unless (null loc) (wt "{"))
+    (unwind-no-exit label)
+    (wt-nl) (wt-go label)
+    (unless (null loc) (wt "}")))
+  )
+
+(defun c1ecase (args) (c1case args t))  
+
+(defun c1case (args &optional (default nil))
+  (when (endp args) (too-few-args 'case 1 0))
+  (let* ((info (make-info))
+         (key-form (c1expr* (car args) info))
+         (clauses nil))
+    (dolist (clause (cdr args))
+      (cmpck (endp clause) "The CASE clause ~S is illegal." clause)
+      (case (car clause)
+            ((NIL))
+            ((T OTHERWISE)
+             (when default
+                   (cmperr (if (eq default 't)
+                               "ECASE had an OTHERWISE clause."
+                               "CASE had more than one OTHERWISE clauses.")))
+             (setq default (c1progn (cdr clause)))
+             (add-info info (second default)))
+            (t (let* ((rawkeylist (car clause))
+		      (keylist
+                       (if (consp rawkeylist)
+			 (mapcar #'(lambda (key) (c1constant-value key t))
+				 rawkeylist)
+			 (list (c1constant-value rawkeylist t))))
+                      (body (c1progn (cdr clause))))
+                 (add-info info (second body))
+                 (push (cons keylist body) clauses)))))
+    (list 'CASE info key-form (nreverse clauses) (or default (c1nil)))))
+
+(defun c2case (key-form clauses default
+               &aux loc (*inline-blocks* 0))
+  (setq key-form (second (first (inline-args (list key-form)))))
+  (if (and (consp key-form) (eq (car key-form) 'VAR))
+      (setq loc key-form)
+      (progn
+	(setq loc (list 'LCL (next-lcl)))
+	(wt-nl "{cl_object " loc "= " key-form ";")
+	))
+  (dolist (clause clauses)
+    (let* ((label (next-label))
+           (keylist (first clause)))
+      (wt-nl "if(")
+      (dolist (keys keylist)
+	(let ((data-type (info-type (second keys)))
+	      (data-value (third keys)))
+	  (cond ((not (eq (first keys) 'LOCATION))
+		 (cmperr "Found ~s" keys)
+		 (baboon))
+		((subtypep data-type '(or fixnum symbol character null))
+		 (wt "(" loc "!=" data-value ")"))
+		(t
+		 (wt "!eql(" loc "," data-value ")"))))
+	(wt-nl "&&"))
+      (wt "1)")
+      (wt-go label)
+      (let ((*unwind-exit* (cons 'JUMP *unwind-exit*))) (c2expr (cdr clause)))
+      (wt-label label)))
+
+  (if (eq default 't)
+      (wt-nl "FEerror(\"The ECASE key value ~s is illegal.\",1," loc ");")
+      (c2expr default))
+
+  (unless (eq loc key-form) (wt "}"))
+  (close-inline-blocks))
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'if 'c1special) #'c1if)
+(setf (get 'if 'c2) #'c2if)
+(setf (get 'and 'c1) #'c1and)
+(setf (get 'and 'c2) #'c2and)
+(setf (get 'or 'c1) #'c1or)
+(setf (get 'or 'c2) #'c2or)
+
+(setf (get 'jump-true 'set-loc) #'set-jump-true)
+(setf (get 'jump-false 'set-loc) #'set-jump-false)
+
+(setf (get 'case 'c1) #'c1case)
+(setf (get 'ecase 'c1) #'c1ecase)
+(setf (get 'case 'c2) #'c2case)
diff --git a/src/cmp/cmpinit.lsp b/src/cmp/cmpinit.lsp
new file mode 100644
index 000000000..41e9413cb
--- /dev/null
+++ b/src/cmp/cmpinit.lsp
@@ -0,0 +1,23 @@
+
+(in-package 'compiler)
+
+;;; The production version:
+(proclaim '(optimize (safety 0) (space 3) (speed 3)))
+
+(when (member :clos *features*)
+  (push :ansi *features*))
+
+;#-CLOS
+(defmacro setf-namep (setf-list)
+  `(let (setf-symbol)
+     (and (consp ,setf-list)
+	  (= 2 (length ,setf-list))
+	  (eq (car ,setf-list) 'setf)
+	  (setq setf-symbol (get (second ,setf-list) 'sys::setf-symbol))
+	  (symbolp setf-symbol)
+	  setf-symbol)))
+
+;;; Disable PDE facilities within LISP kernel:
+(setq *features* (delete ':pde *features*))
+;;; Disable record-source-pathname within LISP kernel:
+(defmacro record-source-pathname (x y))
diff --git a/src/cmp/cmpinline.lsp b/src/cmp/cmpinline.lsp
new file mode 100644
index 000000000..7b1e66a15
--- /dev/null
+++ b/src/cmp/cmpinline.lsp
@@ -0,0 +1,570 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPINLINE  Open coding optimizer.
+
+(in-package "COMPILER")
+
+;;; Pass 1 generates the internal form
+;;;	( id  info-object . rest )
+;;; for each form encountered.
+
+#|
+;;; Use a structure of type vector to avoid creating
+;;; normal structures before booting CLOS:
+(defstruct (info (:type vector) :named)
+  (changed-vars nil)	;;; List of var-objects changed by the form.
+  (referred-vars nil)	;;; List of var-objects referred in the form.
+  (type t)		;;; Type of the form.
+  (sp-change nil)	;;; Whether execution of the form may change
+			;;; the value of a special variable.
+  (volatile nil)	;;; whether there is a possible setjmp. Beppe
+  (local-referred nil)  ;;; directly referenced in the body.
+  ) |#
+
+(defun add-info (to-info from-info &optional boundary)
+  (setf (info-changed-vars to-info)
+        (union (info-changed-vars from-info)
+                (info-changed-vars to-info)))
+  (setf (info-referred-vars to-info)
+        (union (info-referred-vars from-info)
+                (info-referred-vars to-info)))
+  (when (info-sp-change from-info)
+        (setf (info-sp-change to-info) t))
+;  (setf (info-referred-tags to-info)
+;	(union (info-referred-tags from-info)
+;	       (info-referred-tags to-info)))
+  (unless boundary
+    (setf (info-local-referred to-info)
+	  (union (info-local-referred from-info)
+		 (info-local-referred to-info))))
+  )
+
+(defun var-changed-in-forms (var forms)
+  (declare (type var var))
+  (case (var-kind var)
+    ((LEXICAL FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT)
+     (dolist (form forms)
+       (when (member var (info-changed-vars (second form)))
+         (return t))))
+    (REPLACED (let ((loc (var-loc var)))
+		(when (and (consp loc) (eq 'VAR (first loc)))
+		  (var-changed-in-forms (second loc) forms))))
+    (t (dolist (form forms)
+         (when (or (member var (info-changed-vars (second form)))
+                   (info-sp-change (second form)))
+           (return t)))))
+  )
+
+;;; Valid property names for open coded functions are:
+;;;  :INLINE-ALWAYS
+;;;  :INLINE-SAFE	safe-compile only
+;;;  :INLINE-UNSAFE	non-safe-compile only
+;;;
+;;; Each property is a list of 'inline-info's, where each inline-info is:
+;;; ( types { type | boolean } side-effect new-object { string | function } ).
+;;;
+;;; For each open-codable function, open coding will occur only if there exits
+;;; an appropriate property with the argument types equal to 'types' and with
+;;; the return-type equal to 'type'.  The third element
+;;; is T if and only if side effects may occur by the call of the function.
+;;; Even if *DESTINATION* is TRASH, open code for such a function with side
+;;; effects must be included in the compiled code.
+;;; The forth element is T if and only if the result value is a new Lisp
+;;; object, i.e., it must be explicitly protected against GBC.
+
+;;;
+;;; inline-args:
+;;;   returns a list of pairs (type loc)
+;;;   side effects: emits code for temporary variables
+;;;
+;;; Whoever calls inline-args must bind *inline-blocks* to 0 and afterwards
+;;; call close-inline-blocks
+;;;
+(defun inline-args (forms &optional types)
+  ;; all uses of next-lcl may be eliminated??? Beppe
+  (flet ((all-locations (args &aux (res t))
+	   (dolist (arg args res)
+	     (unless (member (car arg) '(LOCATION VAR SYS:STRUCTURE-REF
+					 #+clos SYS:INSTANCE-REF)
+			     :test #'eq)
+	       (setq res nil))))
+
+	 (form-type (form)
+	   (info-type (second form))))
+
+    (do ((forms forms (cdr forms))
+	 (form) (locs))
+	((endp forms) (nreverse locs))
+      (setq form (car forms))
+      (case (car form)
+	(LOCATION
+	 (push (list (form-type form) (third form)) locs))
+	(VAR
+	 (let ((var (caaddr form)))
+	   (if (var-changed-in-forms var (cdr forms))
+	       (let ((lcl-loc (list 'LCL (next-lcl)))
+		     (var-type (var-kind var)))
+		 (wt-nl "{" (rep-type var-type) lcl-loc "= ")
+		 (wt-var var) (wt ";")
+		 (push (list (form-type form)
+			     (if (unboxed var)
+				 lcl-loc
+				 (list 'T lcl-loc))) ; global proclaimed var.
+		       locs)
+		 (incf *inline-blocks*))
+	       (push (list (form-type form) (cons 'VAR (third form)))
+		     locs))))
+
+	(CALL-GLOBAL
+	 (let* ((fname (third form))
+		(args (fourth form))
+		(return-type (info-type (second form)))
+		(arg-locs (inline-args args))
+		loc)
+	   (if (and (inline-possible fname)
+		    (not (get fname 'C2)) ; no special treatment
+		    (setq loc (inline-function fname arg-locs return-type)))
+	     (let* ((arg-type (first loc))
+		    (and-type (type-and arg-type return-type))
+		    (typed-loc (list and-type (fix-loc loc))))
+	       (cond
+		 ((and (member arg-type '(FIXNUM LONG-FLOAT
+					  SHORT-FLOAT BOOLEAN CHARACTER)
+			       :test #'eq)
+		       ;; fix to: (bar (+ (bar) y) (bar y))
+		       (all-locations (cdr forms)))
+		  (push typed-loc locs))
+		 ((or (need-to-protect (cdr forms))
+		      (and (second loc)	; side-effectp
+			   (cdr forms)))
+		  ;; if there are side-effects, order of execution matters
+		  (let* ((var (make-var :loc (next-lcl)
+					:kind (if (member arg-type
+							  '(T BOOLEAN)
+							  :test #'eq)
+						  'OBJECT arg-type)
+					:type and-type))
+			 (lcl-var (list 'VAR var)))
+		    ;; use a variable of type arg-type to save the value
+		    ;; if (return-type >= arg-type)
+		    ;; then
+		    ;;   coerce the value to arg-type
+		    ;; otherwise
+		    ;;   save the value without coercion and return the
+		    ;;   variable tagged with and-type,
+		    ;;   so that whoever uses it may coerce it to such type
+		    (wt-nl "{" (rep-type arg-type)) (wt-lcl (var-loc var))
+		    (wt "= " (if (type>= return-type arg-type)
+				  typed-loc loc) ";")
+		    (push (list and-type lcl-var) locs)
+		    (incf *inline-blocks*)))
+		 (t (push typed-loc locs))))
+
+	     (let* ((temp (list 'TEMP (next-temp)))
+		    ;; bindings like c1expr*
+		    (*exit* (next-label))
+		    (*unwind-exit* (cons *exit* *unwind-exit*))
+		    (*lcl* *lcl*)
+		    (*temp* *temp*)
+		    (*destination* temp))
+	       (call-global fname arg-locs nil return-type nil)
+	       (wt-label *exit*)
+	       (push (list (if (eq 'T return-type)
+			       (or (get-return-type fname) 'T)
+			       return-type)
+			   temp) locs)))))
+
+	(SYS:STRUCTURE-REF
+	 (let ((type (form-type form)))
+	   (if (args-cause-side-effect (cdr forms))
+	       (let* ((temp (list 'TEMP (next-temp)))
+		      (*destination* temp))
+		 (c2expr* form)
+		 (push (list type temp) locs))
+	       (push (list type
+			   (list 'SYS:STRUCTURE-REF
+				 (second (first
+					  (inline-args (list (third form)))))
+				 (fourth form)
+				 (fifth form)))
+		     locs))))
+	#+clos
+	(SYS:INSTANCE-REF
+	 (let ((type (form-type form)))
+	   (if (args-cause-side-effect (cdr forms))
+	       (let* ((temp (list 'TEMP (next-temp)))
+		      (*destination* temp))
+		 (c2expr* form)
+		 (push (list type temp) locs))
+	       (push (list type
+			   (list 'SYS:INSTANCE-REF
+				 (second (first
+					  (inline-args (list (third form)))))
+				 (fourth form)
+				#+nil (fifth form))) ; JJGR
+		     locs))))
+	(SETQ
+	 (let ((vref (third form))
+	       (form1 (fourth form)))
+	   (let ((*destination* (cons 'VAR vref))) (c2expr* form1))
+	   (if (eq (car form1) 'LOCATION)
+	       (push (list (form-type form1) (third form1)) locs)
+	       (setq forms (list* nil	; discarded at iteration
+				  (list 'VAR (second form) vref) (cdr forms))
+		     ))))
+
+	(t (let ((temp (list 'TEMP (next-temp))))
+	     (let ((*destination* temp)) (c2expr* form))
+	     (push (list (form-type form) temp) locs))))))
+  )
+
+(defun coerce-locs (args types)
+  ;; each arg is pair (type location).
+  ;; if TYPES is NIL, all types are meant to be T.
+  ;; If type matches the corresponding required type, leave arg as is;
+  ;; otherwise, if type is simple, replace type with coercion to object;
+  ;; otherwise, remove type (WT-LOC will take care of producing an object,
+  ;; except for LCLs).
+  ;;
+  (do ((args args (cdr args))
+       (types (or types '(T)) (or (cdr types) '(T)))
+       (arg-type) (loc))
+      ((null args))
+    (setq arg-type (car (member (caar args)
+				'(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT)
+				:test #'eq))
+	  loc (second (car args)))
+    (if arg-type
+	(if (eq arg-type (car types))
+	    (when (and (consp loc) (eq 'LCL (car loc)))
+	      (setf (car args) loc))
+	    (if (consp loc)
+		(case arg-type
+		  (FIXNUM (if (member (car loc)
+				      ;; TEMPs contain object
+				      '(VAR TEMP FIXNUM-VALUE INLINE-FIXNUM
+					INLINE SI:STRUCTURE-REF)) ; T
+			      (setf (car args) loc)
+			      (setf (caar args) 'FIXNUM->OBJECT)))
+		  (CHARACTER (if (member (car loc)
+					 '(VAR TEMP CHARACTER-VALUE INLINE ; T
+					   INLINE-CHARACTER SI:STRUCTURE-REF))
+				 (setf (car args) loc)
+				 (setf (caar args) 'CHARACTER->OBJECT)))
+		  (LONG-FLOAT (if (member (car loc)
+					  '(VAR TEMP LONG-FLOAT-VALUE ; T
+					    INLINE-LONG-FLOAT INLINE
+					    SI:STRUCTURE-REF))
+				  (setf (car args) loc)
+				  (setf (caar args) 'LONG-FLOAT->OBJECT)))
+		  (SHORT-FLOAT (if (member (car loc)
+					   '(VAR TEMP SHORT-FLOAT-VALUE	; T
+					     INLINE-SHORT-FLOAT INLINE
+					     SI:STRUCTURE-REF))
+				   (setf (car args) loc)
+				   (setf (caar args) 'SHORT-FLOAT->OBJECT))))
+		(setf (car args) loc)))
+	(setf (car args) loc)))
+  args)
+
+;;; this function may go away if we replace all uses of inline-? with
+;;; just the type name. Or else we could use a single tag INLINE
+;;; and put the type in second position, replacing side-effect-p which
+;;; is not used from now on.
+(defun fix-loc (loc)
+  (setf (car loc)
+	(case (car loc)
+	  (BOOLEAN 'INLINE-COND)
+	  (FIXNUM 'INLINE-FIXNUM)
+	  (CHARACTER 'INLINE-CHARACTER)
+	  (LONG-FLOAT 'INLINE-LONG-FLOAT)
+	  (SHORT-FLOAT 'INLINE-SHORT-FLOAT)
+	  (otherwise 'INLINE)))
+  loc)
+
+(defun destination-type ()
+  (if (and (consp *destination*)
+	   (member (car *destination*) '(VAR BIND) :test #'eq))
+      (var-type (second *destination*))
+      T))
+
+;;;
+;;; inline-function:
+;;;   locs are typed locs as produced by inline-args
+;;;   returns NIL if inline expansion of the function is not possible
+;;;
+(defun inline-function (fname locs return-type)
+  ;; Those functions that use INLINE-FUNCTION must rebind
+  ;; the variable *INLINE-BLOCKS*.
+
+  (setq return-type (type-and return-type (destination-type)))
+
+  (let* ((ii (get-inline-info fname (mapcar #'car locs) return-type))
+	 (fun))
+    (when ii
+      (setq fun (fifth ii))
+      ;; remove coercion where not necessary:
+      (coerce-locs locs (first ii))
+      (when (and (stringp fun) (char= (char (the string fun) 0) #\@))
+	(let ((saves nil))
+	  (do* ((i 1 (1+ i))
+		(char (char (the string fun) i) (char (the string fun) i)))
+	       ((char= char #\;))
+	    (declare (fixnum i) (character char))
+	    (push (the fixnum (- (char-code char) #.(char-code #\0))) saves))
+	  (do ((l locs (cdr l))
+	       (n 0 (1+ n))
+	       (locs1 nil))
+	      ((endp l) (setq locs (nreverse locs1)))
+	    (declare (fixnum n))
+	    (if (member n saves)
+		(let* ((loc1 (car l)) (loc loc1) (coersion nil))
+		  (when (and (consp loc1)
+			     (member (car loc1)
+				     '(FIXNUM CHARACTER
+				       LONG-FLOAT SHORT-FLOAT)
+				     :test #'eq))
+		    (setq coersion (car loc1))
+		    (setq loc (second loc1))) ; remove coersion
+		  (if
+		   (or (eq loc 'RETURN)
+		       (member (car loc) '(VAR FIXNUM-VALUE SHORT-FLOAT-VALUE
+					   LONG-FLOAT-VALUE CHARACTER-VALUE VV)
+			       :test #'eq))
+		   (push loc1 locs1)
+		   ;; else
+		   (let ((lcl (list 'LCL (next-lcl))))
+		     (push lcl locs1)
+		     (incf *inline-blocks*)
+		     (wt-nl "{" (rep-type coersion) lcl "= " loc1 ";"))))
+		;; else
+		(push (car l) locs1)))))
+      (list (second ii)
+	    (third ii)
+	    fun
+	    locs)))
+  )
+
+(defun get-inline-info (fname types return-type &aux ii iia)
+  (dolist (x *inline-functions*)
+    (when (and (eq (car x) fname)
+	       (setq ii (inline-type-matches (cdr x) types return-type)))
+      (return-from get-inline-info ii)))
+  (dolist (x (get fname (if *safe-compile*
+			    ':INLINE-SAFE
+			    ':INLINE-UNSAFE)))
+    (when (setq ii (inline-type-matches x types return-type))
+      (return)))
+  (dolist (x (get fname ':INLINE-ALWAYS))
+    (when (setq iia (inline-type-matches x types return-type))
+      (return)))
+  (if (and ii iia)
+      (if (and (every #'type>= (first ii) (first iia))
+	       (type>= (second ii) (second iia)) ; no contravariance here
+	       (not (and (every #'equal (first ii) (first iia))
+			 (equal (second iia) (second ii))))) iia ii)
+      (or ii iia))
+  )
+
+(defun inline-type-matches (inline-info arg-types return-type
+                                        &aux (rts nil)
+					(number-max nil)
+					(inline-return-type
+					 (second inline-info)))
+  ;; In sysfun.lsp optimizers must be listed with most specific cases last.
+  (flet ((float-type-max (t1 t2)
+	   (if t1
+	       (if (or (eq t1 'LONG-FLOAT)
+		       (eq t2 'LONG-FLOAT))
+		   'LONG-FLOAT
+		   (if (or (eq t1 'SHORT-FLOAT)
+			   (eq t2 'SHORT-FLOAT))
+		       'SHORT-FLOAT
+		       'FIXNUM))
+	       t2)))
+    (if (and (do ((arg-types arg-types (cdr arg-types))
+		  (types (car inline-info) (cdr types))
+		  (arg-type) (type))
+		 ((or (endp arg-types) (endp types))
+		  (and (endp arg-types) (endp types)))
+	       (setq arg-type (car arg-types)
+		     type (car types))
+	       (cond ((eq type 'FIXNUM-FLOAT)
+		      (cond ((type>= 'FIXNUM arg-type)
+			     (push 'FIXNUM rts))
+			    ((type>= 'LONG-FLOAT arg-type)
+			     (push 'LONG-FLOAT rts))
+			    ((type>= 'SHORT-FLOAT arg-type)
+			     (push 'SHORT-FLOAT rts))
+			    (t (return nil)))
+		      ;; compute max of FIXNUM-FLOAT arguments types
+		      (setq number-max
+			    (float-type-max number-max (first rts))))
+		     ((type>= type arg-type)
+		      (push type rts))
+		     (t (return nil))))
+	     (or (eq inline-return-type 'BOOLEAN)
+		 (if number-max
+		     ;; for arithmetic operators we take the maximal type
+		     ;; as possible result type
+		     (and (type>= return-type number-max)
+			  (type>= number-max inline-return-type))
+		     ;; no contravariance
+		     (type>= inline-return-type return-type))))
+	(cons (nreverse rts) (cdr inline-info))
+	nil))
+  )
+
+(defun need-to-protect (forms &aux ii)
+  (do ((forms forms (cdr forms))
+       (res nil))
+      ((or res (endp forms)) res)
+    (let ((form (car forms)))
+      (declare (object form))
+      (case (car form)
+	(LOCATION)
+	(VAR
+	 (when (var-changed-in-forms (car (third form)) (cdr forms))
+	   (setq res t)))
+	(CALL-GLOBAL
+	 (let ((fname (third form))
+	       (args (fourth form)))
+	   (when (or (not (inline-possible fname))
+		     (null (setq ii (get-inline-info
+				     fname
+				     (mapcar #'(lambda (x)
+						 (info-type (second x)))
+					     args)
+				     (info-type (second form)))))
+		     (third ii)
+		     (fourth ii)
+		     (need-to-protect args))
+	     (setq res t))))
+	(SYS:STRUCTURE-REF
+	 (when (need-to-protect (list (third form)))
+	   (setq res t)))
+	(t (setq res t)))))
+  )
+
+(defun close-inline-blocks ()
+  (dotimes (i *inline-blocks*) (declare (fixnum i)) (wt "}")))
+
+(eval-when (compile eval)		; also in cmptop.lsp
+  (defmacro parse-index (fun i)
+    `(multiple-value-bind (a-read endpos)
+      (parse-integer ,fun :start (1+ ,i) :junk-allowed t)
+      (setq ,i (1- endpos))
+      a-read))
+  )
+
+(defun wt-inline-loc (fun locs &aux (i 0))
+  (declare (fixnum i))
+  (cond ((stringp fun)
+         (when (char= (char (the string fun) 0) #\@)
+           (setq i 1)
+           (do ()
+               ((char= (char (the string fun) i) #\;) (incf i))
+               (incf i)))
+         (do ((size (length (the string fun)))
+              (char))
+             ((>= i size))
+           (declare (fixnum size) (character char))
+           (setq char (char (the string fun) i))
+           (if (char= char #\#)
+             (wt-loc (nth (parse-index fun i) locs))
+             (princ char *compiler-output1*))
+           (incf i))
+         )
+        (t (apply (coerce fun 'function) locs))))
+
+(defun wt-inline (side-effectp fun locs)
+  (declare (ignore side-effectp))
+  (wt-inline-loc fun locs))
+
+(defun wt-inline-cond (side-effectp fun locs)
+  (declare (ignore side-effectp))
+  (wt "(") (wt-inline-loc fun locs) (wt "?Ct:Cnil)"))
+
+(defun wt-inline-fixnum (side-effectp fun locs)
+  (declare (ignore side-effectp))
+  (wt "MAKE_FIXNUM(") (wt-inline-loc fun locs) (wt ")"))
+
+(defun wt-inline-character (side-effectp fun locs)
+  (declare (ignore side-effectp))
+  (wt "code_char(") (wt-inline-loc fun locs) (wt ")"))
+
+(defun wt-inline-long-float (side-effectp fun locs)
+  (declare (ignore side-effectp))
+  (wt "make_longfloat(") (wt-inline-loc fun locs) (wt ")"))
+
+(defun wt-inline-short-float (side-effectp fun locs)
+  (declare (ignore side-effectp))
+  (wt "make_shortfloat(") (wt-inline-loc fun locs) (wt ")"))
+
+(defun args-cause-side-effect (forms &aux ii)
+  (dolist (form forms nil)
+    (case (car form)
+      ((LOCATION VAR SYS:STRUCTURE-REF #+clos SYS:INSTANCE-REF))
+      (CALL-GLOBAL
+       (let ((fname (third form)))
+	 (unless (and (inline-possible fname)
+		      (setq ii (get-inline-info
+				fname (mapcar #'(lambda (x)
+						 (info-type (second x)))
+					      (fourth form))
+				(info-type (second form))))
+		      (not (third ii))	; no side-effectp
+		      )
+	   (return t))))
+      (otherwise (return t)))))
+
+(defun list-inline (&rest x)
+       (wt "list(" (length x)) (dolist (loc x) (wt #\, loc)) (wt #\)))
+
+(defun list*-inline (&rest x)
+  (case (length x)
+        (1 (wt (car x)))
+        (2 (wt "make_cons(" (car x) "," (second x) ")"))
+        (otherwise
+         (wt "listA(" (length x)) (dolist (loc x) (wt #\, loc)) (wt #\)))))
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'INLINE 'WT-LOC) 'wt-inline)
+(setf (get 'INLINE-COND 'WT-LOC) 'wt-inline-cond)
+(setf (get 'INLINE-FIXNUM 'WT-LOC) 'wt-inline-fixnum)
+(setf (get 'INLINE-CHARACTER 'WT-LOC) 'wt-inline-character)
+(setf (get 'INLINE-LONG-FLOAT 'WT-LOC) 'wt-inline-long-float)
+(setf (get 'INLINE-SHORT-FLOAT 'WT-LOC) 'wt-inline-short-float)
+
+(setf (get 'FIXNUM 'WT-LOC) 'wt-fixnum-loc)
+(setf (get 'CHARACTER 'WT-LOC) 'wt-character-loc)
+(setf (get 'LONG-FLOAT 'WT-LOC) 'wt-long-float-loc)
+(setf (get 'SHORT-FLOAT 'WT-LOC) 'wt-short-float-loc)
+(setf (get 'BOOLEAN 'WT-LOC) 'wt-loc)
+(setf (get 'T 'WT-LOC) 'wt-loc)
+;;; Since they are possible locations, we must add:
+(setf (get 'STRING 'WT-LOC) 'wt-loc)
+(setf (get 'BIT-VECTOR 'WT-LOC) 'wt-loc)
+
+(defun wt-fixnum->object (loc)
+  (wt "MAKE_FIXNUM(" loc ")"))
+(defun wt-character->object (loc)
+  (wt "code_char(" loc ")"))
+(defun wt-short-float->object (loc)
+  (wt "make_shortfloat(" loc ")"))
+(defun wt-long-float->object (loc)
+  (wt "make_longfloat(" loc ")"))
+
+(setf (get 'FIXNUM->OBJECT 'WT-LOC) 'wt-fixnum->object)
+(setf (get 'CHARACTER->OBJECT 'WT-LOC) 'wt-character->object)
+(setf (get 'LONG-FLOAT->OBJECT 'WT-LOC) 'wt-long-float->object)
+(setf (get 'SHORT-FLOAT->OBJECT 'WT-LOC) 'wt-short-float->object)
diff --git a/src/cmp/cmplam.lsp b/src/cmp/cmplam.lsp
new file mode 100644
index 000000000..96345284b
--- /dev/null
+++ b/src/cmp/cmplam.lsp
@@ -0,0 +1,960 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPLAM  Lambda expression.
+
+(in-package "COMPILER")
+
+(eval-when (compile eval)
+  (defmacro ck-spec (condition)
+    `(unless ,condition
+      (cmperr "The parameter specification ~s is illegal." spec)))
+
+  (defmacro ck-vl (condition)
+    `(unless ,condition
+      (cmperr "The lambda list ~s is illegal." vl)))
+  )
+
+;;; During Pass1, a lambda-list
+;;;
+;;; (	{ var }*
+;;; 	[ &optional { var | ( var [ initform [ svar ] ] ) }* ]
+;;; 	[ &rest var ]
+;;; 	[ &key { var | ( { var | ( kwd var ) } [initform [ svar ]])}*
+;;; 		[&allow-other-keys]]
+;;; 	[ &aux {var | (var [initform])}*]
+;;; )
+;;;
+;;; is transformed into
+;;;
+;;; (	( { var }* )				; required
+;;; 	( { (var initform svar) }* )		; optional
+;;; 	{ var | nil }				; rest
+;;; 	key-flag
+;;; 	( { ( kwd-vv-index var initform svar ) }* )	; key
+;;; 	allow-other-keys-flag
+;;; )
+;;;
+;;; where
+;;; 	svar:	(make-var :kind 'DUMMY)	; means svar is not supplied
+;;;	        | var
+;;;
+;;; &aux parameters will be embedded into LET*.
+;;;
+;;; c1lambda-expr receives
+;;;	( lambda-list { doc | decl }* . body )
+;;; and returns
+;;;	( lambda info-object lambda-list' doc body' )
+;;;
+;;; Doc is NIL if no doc string is supplied.
+;;; Body' is body possibly surrounded by a LET* (if &aux parameters are
+;;; supplied) and an implicit block.
+
+(defun c1lambda-expr (lambda-expr
+                      &optional (block-name nil block-it)
+                      &aux (requireds nil) (optionals nil) (rest nil)
+                           (keywords nil) (key-flag nil)
+                           (allow-other-keys nil) (aux-vars nil)
+                           (aux-inits nil) doc spec body ss is ts
+                           other-decls vnames
+                           (*vars* *vars*)
+                           (info (make-info))
+                           (aux-info nil)
+                      )
+  (cmpck (endp lambda-expr)
+         "The lambda expression ~s is illegal." (cons 'LAMBDA lambda-expr))
+
+  (multiple-value-setq (body ss ts is other-decls doc)
+                       (c1body (cdr lambda-expr) t))
+
+  (when block-it (setq body (list (cons 'BLOCK (cons block-name body)))))
+
+  (c1add-globals ss)
+
+  (multiple-value-setq (requireds optionals rest
+				  key-flag keywords allow-other-keys
+				  aux-vars)
+    (parse-lambda-list (car lambda-expr)))
+
+  (do ((specs requireds (cdr specs)))
+      ((null specs))
+    (setq spec (car specs))
+    (let ((v (c1make-var spec ss is ts)))
+      (push spec vnames)
+      (push-vars v)
+      (setf (car specs) v)))
+
+  (do ((specs optionals (cdr specs)))
+      ((null specs))
+    (setq spec (car specs))
+    (cond ((symbolp spec)
+	   (let ((v (c1make-var spec ss is ts)))
+	     (push spec vnames)
+	     (setf (car specs) (list v (default-init (var-type v)) nil))
+	     (push-vars v)))
+	  ((symbolp (cdr spec))
+	   (ck-spec (null (cdr spec)))
+	   (let ((v (c1make-var (car spec) ss is ts)))
+	     (push (car spec) vnames)
+	     (setf (car specs) (list v (default-init (var-type v)) nil))
+	     (push-vars v)))
+	  ((symbolp (cddr spec))
+	   (ck-spec (null (cddr spec)))
+	   (let ((init (c1expr* (second spec) info))
+		 (v (c1make-var (car spec) ss is ts)))
+	     (push (car spec) vnames)
+	     (setf (car specs)
+		   (list v (and-form-type (var-type v) init (second spec)) nil))
+	     (push-vars v)))
+	  (t
+	   (ck-spec (null (cdddr spec)))
+	   (let ((init (c1expr* (second spec) info))
+		 (v (c1make-var (car spec) ss is ts))
+		 (sv (c1make-var (third spec) ss is ts))
+		 )
+	     (push (car spec) vnames)
+	     (push (third spec) vnames)
+	     (setf (car specs)
+		   (list v (and-form-type (var-type v) init (second spec)) sv))
+	     (push-vars v)
+	     (push-vars sv)))))
+
+  (when rest
+    (push rest vnames)
+    (setq rest (c1make-var rest ss is ts))
+    (push-vars rest))
+
+  (do ((specs keywords (cdr specs)))
+      ((null specs))
+    (setq spec (car specs))
+    ;; spec is:
+    ;; 	( kwd-vv-index var [ initform [ svar ]])
+    (cond ((null (cddr spec))
+	   (ck-spec (null (cddr spec)))
+	   (let ((v (c1make-var (second spec) ss is ts)))
+	     (push (second spec) vnames)
+	     (setf (car specs)
+	      (list (car spec) v (default-init (var-type v))
+		    (make-var :kind 'DUMMY)))
+	     (push-vars v)))
+	  ((null (cdddr spec))
+	   (ck-spec (null (cdddr spec)))
+	   (let ((init (c1expr* (third spec) info))
+		 (v (c1make-var (second spec) ss is ts)))
+	     (push (second spec) vnames)
+	     (setf (car specs)
+		   (list (car spec) v
+			 (and-form-type (var-type v) init (third spec))
+			 (make-var :kind 'DUMMY)))
+	     (push-vars v)))
+	  (t
+	   (ck-spec (null (cddddr spec)))
+	   (let ((init (c1expr* (third spec) info))
+		 (v (c1make-var (second spec) ss is ts))
+		 (sv (c1make-var (fourth spec) ss is ts)))
+	     (push (second spec) vnames)
+	     (push (fourth spec) vnames)
+	     (setf (car specs)
+		   (list (car spec) v
+			 (and-form-type (var-type v) init (third spec))
+			 sv))
+	     (push-vars v)
+	     (push-vars sv)))))
+
+  (when aux-vars
+    (setq aux-info (make-info))
+    (do ((specs aux-vars (cdr specs)))
+	((null specs))
+      (setq spec (car specs))
+      (if (consp spec)
+	  (cond ((symbolp (cdr spec))
+		 (ck-spec (null (cdr spec)))
+		 (let ((v (c1make-var (car spec) ss is ts)))
+		   (push (car spec) vnames)
+		   (push (default-init (var-type v)) aux-inits)
+		   (setf (car specs) v)
+		   (push-vars v)))
+		(t
+		 (ck-spec (null (cddr spec)))
+		 (let ((init (c1expr* (second spec) aux-info))
+		       (v (c1make-var (car spec) ss is ts)))
+		   (push (car spec) vnames)
+		   (push (and-form-type (var-type v) init (second spec))
+			 aux-inits)
+		   (setf (car specs) v)
+		   (push-vars v))))
+	  (let ((v (c1make-var spec ss is ts)))
+	    (push spec vnames)
+	    (push (default-init (var-type v)) aux-inits)
+	    (setf (car specs) v)
+	    (push-vars v))))
+    (setq aux-inits (nreverse aux-inits))
+    (add-info info aux-info))
+
+  (check-vdecl vnames ts is)
+
+  (setq body (c1decl-body other-decls body))
+
+  (add-info info (second body))
+
+  (dolist (var requireds) (check-vref var))
+  (dolist (opt optionals)
+            (check-vref (car opt))
+            (when (third opt) (check-vref (third opt))))
+  (when rest (check-vref rest))
+  (dolist (kwd keywords)
+            (check-vref (second kwd))
+            (when (fourth kwd) (check-vref (fourth kwd))))
+  (dolist (var aux-vars) (check-vref var))
+
+  (when aux-vars
+        (add-info aux-info (second body))
+        (setq body (list 'LET* aux-info aux-vars aux-inits body)))
+
+  (list 'LAMBDA
+        info
+        (list requireds optionals rest key-flag keywords allow-other-keys)
+        doc
+        body)
+  )
+
+(defun parse-lambda-list (vl &aux spec requireds optionals rest
+			     key-flag keywords allow-other-keys aux-vars)
+  (block parse
+   (tagbody
+    Lreq
+      (when (null vl) (return-from parse))
+      (ck-vl (consp vl))
+      (case (setq spec (pop vl))
+            (&optional (go Lopt))
+            (&rest (go Lrest))
+            (&key (go Lkey))
+            (&aux (go Laux)))
+      (push spec requireds)
+      (go Lreq)
+
+    Lopt
+      (when (null vl) (return-from parse))
+      (ck-vl (consp vl))
+      (case (setq spec (pop vl))
+            (&rest (go Lrest))
+            (&key (go Lkey))
+            (&aux (go Laux)))
+      (push spec optionals)
+      (go Lopt)
+
+    Lrest
+      (ck-vl (consp vl))
+      (setq rest (pop vl))
+      (when (null vl) (return-from parse))
+      (ck-vl (consp vl))
+      (case (setq spec (pop vl))
+            (&key (go Lkey))
+            (&aux (go Laux)))
+      (cmperr "Either &key or &aux is missing before ~s." spec)
+
+    Lkey
+      (setq key-flag t)
+      (when (null vl) (return-from parse))
+      (ck-vl (consp vl))
+      (case (setq spec (pop vl))
+            (&aux (go Laux))
+            (&allow-other-keys (setq allow-other-keys t)
+                               (when (null vl) (return-from parse))
+                               (ck-vl (consp vl))
+                               (case (setq spec (pop vl))
+                                     (&aux (go Laux)))
+                               (cmperr "&aux is missing before ~s." spec)))
+      ;; { var || ( { var || ( kwd var ) } [initform [ svar ]] ) }
+      (unless (consp spec) (setq spec (list spec)))
+      (cond ((consp (car spec))
+             (ck-spec (and (keywordp (caar spec))
+                           (consp (cdar spec))
+                           (null (cddar spec))))
+             (setq spec (cons (caar spec) (cons (cadar spec) (cdr spec)))))
+            (t
+             (ck-spec (symbolp (car spec)))
+             (setq spec (cons (intern (string (car spec)) 'KEYWORD)
+                              (cons (car spec) (cdr spec))))))
+      (push spec keywords)
+      (go Lkey)
+
+    Laux
+      (when (null vl) (return-from parse))
+      (ck-vl (consp vl))
+      (push (pop vl) aux-vars)
+      (go Laux)
+      )
+   )
+  (values (nreverse requireds)
+	  (nreverse optionals)
+	  rest
+	  key-flag
+	  (nreverse keywords)
+	  allow-other-keys
+	  (nreverse aux-vars))
+  )
+
+(defun c2lambda-expr (lambda-list body cfun fname
+				  &optional closure-p call-lambda)
+  (let ((*tail-recursion-info*		;;; Tail recursion possible if
+         (and fname (symbolp fname)	;;; named function (a list is used for
+	      				;;; lambda-block's),
+				        ;;; no required appears in closure,
+              (dolist (var (car lambda-list) t)
+                (declare (type var var))
+                (when (var-ref-ccb var) (return nil)))
+              (null (second lambda-list))	;;; no optionals,
+              (null (third lambda-list))	;;; no rest parameter, and
+              (null (fourth lambda-list))	;;; no keywords.
+              (cons fname (car lambda-list)))))
+    (if (fourth lambda-list)			;;; key-flag
+      (c2lambda-expr-with-key lambda-list body closure-p call-lambda cfun)
+      (c2lambda-expr-without-key lambda-list body closure-p call-lambda)))
+  )
+
+#| Steps:
+ 1. defun creates declarations for requireds + va_alist
+ 2. c2lambda-expr adds declarations for:
+	unboxed requireds
+	lexical optionals (+ supplied-p), rest, keywords (+ supplied-p)
+    Lexical optionals and keywords can be unboxed if:
+	a. there is more then one reference in the body
+	b. they are not referenced in closures
+ 3. binding is performed for:
+	special or unboxed requireds
+	optionals, rest, keywords
+|#
+
+(defun c2lambda-expr-without-key (lambda-list
+                                  body
+				  closure-p
+				  kind
+                                  &aux
+				  (requireds (first lambda-list))
+                                  (optionals (second lambda-list))
+                                  (rest (third lambda-list)) rest-loc
+                                  (nreq (length requireds))
+                                  (labels nil)
+                                  (*unwind-exit* *unwind-exit*)
+                                  (*env* *env*)
+                                  (block-p nil))
+  (declare (fixnum nreq))
+
+  ;; kind is either:
+  ;; 1. CALL-LAMBDA, for a lambda expression
+  ;; 2. LOCAL-ENTRY, for the local entry of a proclaimed function
+  ;; 3. NIL, otherwise
+
+  (if
+   (eq 'LOCAL-ENTRY kind)
+
+   ;; for local entry functions arguments are processed by t3defun
+   (do ((reqs requireds (cdr reqs))
+	(reqi (1+ *lcl*) (1+ reqi))
+	(LCL_i (list 'LCL 0)))		; to allow concurrent compilations
+       ((endp reqs) (setq *lcl* reqi))
+     (declare (fixnum reqi) (type cons reqs))
+     (if (eq (var-kind (first reqs)) 'SPECIAL)
+	 (progn
+	   (setf (second LCL_i) reqi)
+	   (bind LCL_i (first reqs)))
+	 (setf (var-loc (first reqs)) reqi)))
+
+   ;; For each variable, set its var-loc.
+   ;; For optional parameters, and lexical variables which can be unboxed,
+   ;; this will be a new LCL.
+   ;; The bind step later will assign to such variable.
+   (let* ((req0 (if (eq 'CALL-LAMBDA kind) (- *lcl* nreq) *lcl*))
+	  (lcl (+ req0 nreq)))
+     (declare (fixnum lcl))
+     (labels ((wt-decl (var)
+		(wt-nl)
+		(unless block-p
+		  (wt "{") (setq block-p t))
+		(wt *volatile* (register var) (rep-type (var-kind var)))
+		(wt-lcl (incf lcl)) (wt ";")
+		lcl)
+	      (do-decl (var)
+		(when (local var)	; no LCL needed for SPECIAL or LEX
+		  (setf (var-loc var) (wt-decl var)))))
+       (do ((reqs requireds (cdr reqs))
+	    (reqi (1+ req0) (1+ reqi)) (var))
+	   ((endp reqs))
+	 (declare (fixnum reqi) (type cons reqs) (type var var))
+	 (setq var (first reqs))
+	 (when (unboxed var)
+	   (setf (var-loc var) (wt-decl var)))) ; create unboxed variable
+       (when (and rest (< (var-ref rest) 1)) ; dont create rest if not used
+	 (setq rest nil))
+       (when (or optionals rest)	; rest necessary for CALL-LAMBDA
+	 (unless block-p
+	   (wt-nl "{") (setq block-p t))
+	 ;; count optionals
+	 (wt "int i=" (if (eq 'CALL-LAMBDA kind) 0 nreq) ";"))
+       (dolist (opt optionals)
+	 (do-decl (car opt))
+	 (when (third opt) (do-decl (third opt))))
+       (when rest (setq rest-loc `(LCL ,(wt-decl rest)))))
+
+     (unless (eq 'CALL-LAMBDA kind)
+       (when (or optionals rest)	; (not (null requireds))
+	 (unless block-p
+	   (wt-nl "{") (setq block-p t))
+	 (wt-nl "va_list args; va_start(args, ")
+	 (if (plusp nreq)
+	     (wt-lcl (+ req0 nreq))
+	     (if closure-p (wt "env0") (wt "narg")))
+	 (wt ");")))
+
+     ;; check arguments
+     (when (or *safe-compile* *compiler-check-args*)
+       (cond ((or (third lambda-list) ; rest=NIL if not used
+		  optionals)
+	      (when requireds
+		(wt-nl "if(narg<" nreq ") FEtoo_few_arguments(&narg);"))
+	      (unless (third lambda-list)
+		(wt-nl "if(narg>" (+ nreq (length optionals))
+		       ") FEtoo_many_arguments(&narg);")))
+	     (t (wt-nl "check_arg(" nreq ");"))))
+
+     ;; Bind required parameters.
+     (do ((reqs requireds (cdr reqs))
+	  (reqi (1+ req0) (1+ reqi))
+	  (LCL_i (list 'LCL 0)))	; to allow concurrent compilations
+	 ((endp reqs))
+       (declare (fixnum reqi) (type cons reqs))
+       (setf (second LCL_i) reqi)
+       (bind LCL_i (first reqs)))
+
+     (setq *lcl* lcl))
+   )
+  ;; Bind optional parameters as long as there remain arguments.
+  (when optionals
+    (let ((va-arg-loc `(VA-ARG ,(eq kind 'CALL-LAMBDA))))
+      (dolist (opt optionals)
+	(push (next-label) labels)
+	(wt-nl "if (i==narg) ") (wt-go (car labels))
+	(bind va-arg-loc (car opt))
+	(when (third opt) (bind t (third opt)))
+	(wt-nl "i++;")
+	))
+    (let ((label (next-label)))
+      (wt-nl) (wt-go label)
+      (setq labels (nreverse labels))
+      ;;; Bind unspecified optional parameters.
+      (dolist (opt optionals)
+        (wt-label (car labels))
+        (pop labels)
+	(bind-init (first opt) (second opt))
+        (when (third opt) (bind nil (third opt))))
+      (wt-label label))
+    )
+  (when rest
+    (if optionals
+	(wt-nl "narg -= i;")
+	(wt-nl "narg -=" nreq ";"))
+    (wt-nl rest-loc)
+    (if (eq (var-type rest) :DYNAMIC-EXTENT)
+	(wt "=(ALLOCA_CONS(narg),ON_STACK_MAKE_LIST(narg));")
+	(wt "=make_list(narg);"))
+    (wt-nl "{ cl_object p=" rest-loc ";")
+    (wt-nl " for(;narg-->0;p=CDR(p))")
+    (wt-nl "   CAR(p)=") (wt-va_arg (eq 'CALL-LAMBDA kind)) (wt ";i++;}")
+    (bind rest-loc rest))
+
+  (when *tail-recursion-info*
+        (push 'TAIL-RECURSION-MARK *unwind-exit*) (wt-nl1 "TTL:"))
+
+  ;;; Now the parameters are ready!
+  (c2expr body)
+
+  (when block-p (wt-nl "}"))
+  )
+
+(defun c2lambda-expr-with-key
+    (lambda-list body closure-p call-lambda cfun
+		 &aux (requireds (first lambda-list))
+		 (optionals (second lambda-list))
+		 (rest (third lambda-list)) rest-loc
+		 (key-flag (fourth lambda-list))
+		 (keywords (fifth lambda-list))
+		 (allow-other-keys (sixth lambda-list))
+		 (nreq (length requireds))
+		 (nkey (length keywords))
+		 (labels nil)
+		 (*unwind-exit* *unwind-exit*)
+		 (*env* *env*)
+		 (block-p nil)
+		 (last-arg))
+  (declare (fixnum nreq nkey))
+
+  ;; For each variable, set its var-loc.
+  ;; For optional and keyword parameters, and lexical variables which
+  ;; can be unboxed, this will be a new LCL.
+  ;; The bind step later will assign to such variable.
+  (let* ((req0 (if call-lambda (- *lcl* nreq) *lcl*))
+	 (lcl (+ req0 nreq)))
+    (declare (fixnum lcl))
+    (labels ((wt-decl (var)
+               (wt-nl)
+               (unless block-p
+                 (wt "{") (setq block-p t))
+               (wt *volatile* (register var) (rep-type (var-kind var)))
+               (wt-lcl (incf lcl)) (wt ";")
+               lcl)
+             (do-decl (var)
+	       (when (local var) ; no LCL needed for SPECIAL or LEX
+		 (setf (var-loc var) (wt-decl var)))))
+      (do ((reqs requireds (cdr reqs))
+	   (reqi (1+ req0) (1+ reqi)) (var))
+	  ((endp reqs))
+	(declare (fixnum reqi) (type cons reqs) (type var var))
+	(setq var (first reqs))
+	(if (unboxed var)
+	    (setf (var-loc var) (wt-decl var)))) ; create unboxed variable
+      (when (and rest (< (var-ref rest) 1)) ; dont create rest if not used
+	(setq rest nil))
+      (when (or optionals rest)		; rest necessary for CALL-LAMBDA
+        (unless block-p
+          (wt-nl "{") (setq block-p t))
+	;; count optionals
+        (wt "int i=" (if call-lambda 0 nreq) ";"))
+      (dolist (opt optionals)
+        (do-decl (car opt))
+        (when (third opt) (do-decl (third opt))))
+      (when rest (setq rest-loc `(LCL ,(wt-decl rest))))
+      (dolist (key keywords)
+        (do-decl (second key))
+        (when (fourth key) (do-decl (fourth key)))))
+
+    (unless call-lambda
+      (unless block-p
+	(wt-nl "{") (setq block-p t))
+      (wt-nl "va_list args; va_start(args, ")
+      (wt (setq last-arg (if (plusp nreq)
+			     (format nil "V~d" (+ req0 nreq))
+			     (if closure-p "env0" "narg"))))
+      (wt ");"))
+
+    ;; check arguments
+    (when (and (or *safe-compile* *compiler-check-args*) requireds)
+      (wt-nl "if(narg<" nreq ") FEtoo_few_arguments(&narg);"))
+
+    ;; Bind required parameters.
+    (do ((reqs requireds (cdr reqs))
+	 (reqi (1+ req0) (1+ reqi))
+	 (LCL_i (list 'LCL 0)))		; to allow concurrent compilations
+	((endp reqs))
+      (declare (fixnum reqi) (type cons reqs))
+      (setf (second LCL_i) reqi)
+      (bind LCL_i (first reqs)))
+
+    (setq *lcl* lcl)
+    )
+  ;; Bind optional parameters as long as there remain arguments.
+  (when optionals
+    (let ((va-arg-loc `(VA-ARG ,call-lambda)))
+      (dolist (opt optionals)
+	(push (next-label) labels)
+	(wt-nl "if (i==narg) ") (wt-go (car labels))
+	(bind va-arg-loc (car opt))
+	(when (third opt) (bind t (third opt)))
+	(wt-nl "i++;")
+	))
+    (let ((label (next-label)))
+      (wt-nl) (wt-go label)
+      (setq labels (nreverse labels))
+      ;;; Bind unspecified optional parameters.
+      (dolist (opt optionals)
+        (wt-label (car labels))
+        (pop labels)
+	(bind-init (first opt) (second opt))
+        (when (third opt) (bind nil (third opt))))
+      (wt-label label))
+    )
+
+  (if optionals
+      (wt-nl "narg -= i;")
+      (wt-nl "narg -=" nreq ";"))
+  (when rest
+    (wt-nl rest-loc)
+    (if (eq (var-type rest) :DYNAMIC-EXTENT)
+	(wt "=(ALLOCA_CONS(narg), ON_STACK_MAKE_LIST(narg));")
+	(wt "=make_list(narg);"))
+    ;; don't clobber narg, needed by parse_key
+    (wt-nl "{ int n=narg; cl_object p=" rest-loc ";")
+    (wt-nl " for(;n-->0;p=CDR(p))")
+    (wt-nl "   CAR(p)=") (wt-va_arg call-lambda) (wt ";i++;}")
+    (bind rest-loc rest))
+
+  (wt-h "#define L" cfun "keys (&VV[" (add-keyword (caar keywords)) "])")
+  (dolist (kwd (rest keywords))
+    (add-keyword (first kwd)))
+
+  (wt-nl "{ cl_object keyvars[" (* 2 nkey) "];")
+  (when rest
+    (if call-lambda
+	(wt-nl "args -= narg;")
+	(wt-nl "va_start(args," last-arg ");")))
+  (wt-nl "parse_key(narg,args," (length keywords) ",L" cfun "keys,keyvars,")
+  (if rest
+      (wt rest-loc)
+    (wt "OBJNULL"))
+  (wt (if allow-other-keys ",TRUE);" ",FALSE);"))
+
+  ;;; Bind keywords.
+  (let ((KEYVARS[i] `(KEYVARS 0))	; create, since we clobber it
+	(i 0))
+    (declare (fixnum i))
+    (dolist (kwd keywords)
+      (cond ((and (eq (car (third kwd)) 'LOCATION)
+		  (null (third (third kwd))))
+	     ;; no initform
+	     ;; Cnil has been set in keyvars if keyword parameter is not supplied.
+	     (setf (second KEYVARS[i]) i)
+	     (bind KEYVARS[i] (second kwd)))
+	    (t
+	     ;; with initform
+	     (setf (second KEYVARS[i]) (+ nkey i))
+	     (wt-nl "if(") (wt-loc KEYVARS[i]) (wt "==Cnil){")
+	     (bind-init (second kwd) (third kwd))
+	     (wt-nl "}else{")
+	     (setf (second KEYVARS[i]) i)
+	     (bind KEYVARS[i] (second kwd))
+	     (wt "}")))
+      (unless (eq (var-kind (fourth kwd)) 'DUMMY)
+	(setf (second KEYVARS[i]) (+ nkey i))
+	(bind KEYVARS[i] (fourth kwd)))
+      (incf i))
+    )
+  (wt-nl "}")
+
+  ;;; Now the parameters are ready, after all!
+  (c2expr body)
+
+  (when block-p (wt-nl "}"))
+  )
+
+(defun need-to-set-vs-pointers (lambda-list)
+				;;; On entry to in-line lambda expression,
+				;;; vs_base and vs_top must be set iff,
+   (or *safe-compile*
+       *compiler-check-args*
+       (nth 1 lambda-list)	;;; optional,
+       (nth 2 lambda-list)	;;; rest, or
+       (nth 3 lambda-list)	;;; key-flag.
+       ))
+
+
+;;; The DEFMACRO compiler.
+
+;;; valid lambda-list to DEFMACRO is:
+;;;
+;;;	( [ &whole sym ]
+;;;	  [ &environment sym ]
+;;;	  { v }*
+;;;	  [ &optional { sym | ( v [ init [ v ] ] ) }* ]
+;;;	  {  [ { &rest | &body } v ]
+;;;	     [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }*
+;;;		    [ &allow-other-keys ]]
+;;;	     [ &aux { sym | ( v [ init ] ) }* ]
+;;;	  |  . sym }
+;;;	 )
+;;;
+;;; where v is short for { defmacro-lambda-list | sym }.
+;;; Defmacro-lambda-list is defined as:
+;;;
+;;;	( { v }*
+;;;	  [ &optional { sym | ( v [ init [ v ] ] ) }* ]
+;;;	  {  [ { &rest | &body } v ]
+;;;	     [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }*
+;;;		    [ &allow-other-keys ]]
+;;;	     [ &aux { sym | ( v [ init ] ) }* ]
+;;;	  |  . sym }
+;;;	 )
+
+;(defvar *vnames*) -> vnames
+;(defvar *dm-info*)-> dm-info
+;(defvar *dm-vars*)-> dm-vars
+
+(defun c1dm (macro-name vl body
+                        &aux (whole nil) (env nil)
+                        (vnames nil) (dm-info (make-info)) (dm-vars nil)
+			(setjmps *setjmps*) ; Beppe
+                        doc ss is ts other-decls ppn)
+
+  (multiple-value-setq (body ss ts is other-decls doc) (c1body body t))
+  (setq body (list (list* 'BLOCK macro-name body)))
+
+  (c1add-globals ss)
+
+  (when (and (listp vl) (eq (car vl) '&WHOLE))
+        (push (second vl) vnames)
+        (setq whole (c1make-var (second vl) ss is ts))
+        (push whole dm-vars)
+        (push-vars whole)
+        (setq vl (cddr vl))
+        )
+  (do ((x vl (cdr x)))
+      ((atom x))
+    (when (eq (car x) '&ENVIRONMENT)
+      (push (second x) vnames)
+      (setq env (c1make-var (second x) ss is ts))
+      (push env dm-vars)
+      (push-vars env)
+      (setq vl (nconc (ldiff vl x) (cddr x)))))
+
+  (labels ((c1dm-vl (vl ss is ts)
+	     (do ((optionalp nil) (restp nil) (keyp nil)
+		  (allow-other-keys-p nil) (auxp nil)
+		  (requireds nil) (optionals nil) (rest nil) (key-flag nil)
+		  (keywords nil) (auxs nil) (allow-other-keys nil)
+		  (n 0) (ppn nil))
+		 ((not (consp vl))
+		  (when vl
+		    (when restp (dm-bad-key '&REST))
+		    (setq rest (c1dm-v vl ss is ts)))
+		  (values (list (nreverse requireds) (nreverse optionals) rest key-flag
+				(nreverse keywords) allow-other-keys (nreverse auxs))
+			  ppn)
+		  )
+	       (let ((v (car vl)))
+		 (declare (object v))
+		 (cond
+		   ((eq v '&OPTIONAL)
+		    (when optionalp (dm-bad-key '&OPTIONAL))
+		    (setq optionalp t)
+		    (pop vl))
+		   ((or (eq v '&REST) (eq v '&BODY))
+		    (when restp (dm-bad-key v))
+		    (setq rest (c1dm-v (second vl) ss is ts))
+		    (setq restp t optionalp t)
+		    (setq vl (cddr vl))
+		    (when (eq v '&BODY) (setq ppn n)))
+		   ((eq v '&KEY)
+		    (when keyp (dm-bad-key '&KEY))
+		    (setq keyp t restp t optionalp t key-flag t)
+		    (pop vl))
+		   ((eq v '&ALLOW-OTHER-KEYS)
+		    (when (or (not keyp) allow-other-keys-p)
+		      (dm-bad-key '&ALLOW-OTHER-KEYS))
+		    (setq allow-other-keys-p t allow-other-keys t)
+		    (pop vl))
+		   ((eq v '&AUX)
+		    (when auxp (dm-bad-key '&AUX))
+		    (setq auxp t allow-other-keys-p t keyp t restp t optionalp t)
+		    (pop vl))
+		   (auxp
+		    (let (x init)
+		      (cond ((symbolp v) (setq x v init (c1nil)))
+			    (t (setq x (car v))
+			       (if (endp (cdr v))
+				   (setq init (c1nil))
+				   (setq init (c1expr* (second v) dm-info)))))
+		      (push (list (c1dm-v x ss is ts) init) auxs))
+		    (pop vl))
+		   (keyp
+		    (let (x k init (sv nil))
+		      (cond ((symbolp v)
+			     (setq x v
+				   k (intern (string v) 'KEYWORD)
+				   init (c1nil)))
+			    (t (if (symbolp (car v))
+				   (setq x (car v)
+					 k (intern (string (car v)) 'KEYWORD))
+				   (setq x (cadar v) k (caar v)))
+			       (cond ((endp (cdr v)) (setq init (c1nil)))
+				     (t (setq init (c1expr* (second v) dm-info))
+					(unless (endp (cddr v))
+					  (setq sv (third v)))))))
+		      (push (list k (c1dm-v x ss is ts) init
+				  (if sv (c1dm-v sv ss is ts) nil))
+			    keywords)
+		      )
+		    (pop vl))
+		   (optionalp
+		    (let (x init (sv nil))
+		      (cond ((symbolp v) (setq x v init (c1nil)))
+			    (t (setq x (car v))
+			       (cond ((endp (cdr v))
+				      (setq init (c1nil)))
+				     (t (setq init (c1expr* (second v) dm-info))
+					(unless (endp (cddr v))
+					  (setq sv (third v)))))))
+		      (push (list (c1dm-v x ss is ts) init
+				  (if sv (c1dm-v sv ss is ts) nil))
+			    optionals))
+		    (pop vl)
+		    (incf n)
+		    )
+		   (t (push (c1dm-v v ss is ts) requireds)
+		      (pop vl)
+		      (incf n))
+		   )))
+	     )
+
+	   (c1dm-v (v ss is ts)
+	     (cond ((symbolp v)
+		    (push v vnames)
+		    (setq v (c1make-var v ss is ts))
+		    (push-vars v)
+		    (push v dm-vars)
+		    v)
+		   (t (c1dm-vl v ss is ts))))
+	   )
+    (multiple-value-setq (vl ppn) (c1dm-vl vl ss is ts)))
+
+  (check-vdecl vnames ts is)
+  (setq body (c1decl-body other-decls body))
+  (add-info dm-info (second body))
+  (unless (eql setjmps *setjmps*)
+    (setf (info-volatile dm-info) t)
+    (setf (get macro-name 'CONTAINS-SETJMP) t))
+  (dolist (v dm-vars) (check-vref v))
+
+  (list doc ppn whole env vl body)
+  )
+
+(defun c1dm-bad-key (key)
+       (cmperr "Defmacro-lambda-list contains illegal use of ~s." key))
+
+(defun c2dm (name whole env vl body &aux lcl)
+  (when (or *safe-compile* *compiler-check-args*)
+    (wt-nl "check_arg(2);"))
+  (setq lcl (next-lcl))
+  (when whole
+    (check-vref whole)
+;    (setf (var-loc whole) lcl)
+    (bind (list 'LCL lcl) whole))
+  (setq lcl (next-lcl))
+  (when env
+    (check-vref env)
+;    (setf (var-loc env) lcl)
+    (bind (list 'LCL lcl) env))
+  (labels ((reserve-v (v)
+	     (if (consp v)
+		 (reserve-vl v)
+		 (when (local v)
+		   (let ((lcl (next-lcl)))
+		     (setf (var-loc v) lcl)
+		     (setf (var-kind v) 'OBJECT)
+		     (wt ",") (wt-lcl lcl)))))
+
+	   (reserve-vl (vl)
+	     (dolist (var (car vl)) (reserve-v var))
+	     (dolist (opt (second vl))
+	       (reserve-v (car opt))
+	       (when (third opt) (reserve-v (third opt))))
+	     (when (third vl) (reserve-v (third vl)))
+	     (dolist (kwd (fifth vl))
+	       (reserve-v (second kwd))
+	       (when (fourth kwd) (reserve-v (fourth kwd))))
+	     (dolist (aux (seventh vl))
+	       (reserve-v (car aux))))
+
+	   (dm-bind-loc (v loc)
+	     (if (consp v)
+		 (let ((lcl (next-lcl)))
+		   (wt-nl "{cl_object ") (wt-lcl lcl) (wt "= " loc ";")
+		   (dm-bind-vl v lcl)
+		   (wt "}"))
+		 (bind loc v)))
+
+	   (dm-bind-init (para &aux (v (first para)) (init (second para)))
+	     (if (consp v)
+		 (let* ((*inline-blocks* 0) ; used by inline-args
+			(lcl (next-lcl))
+			(loc (second (first (inline-args (list init))))))
+		   (wt-nl) (wt-lcl lcl) (wt "= " loc ";")
+		   (dm-bind-vl v lcl)
+		   (close-inline-blocks))
+		 (bind-init v init)))
+
+	   (dm-bind-vl (vl lcl &aux
+			   (requireds (car vl)) (optionals (second vl))
+			   (rest (third vl)) (key-flag (fourth vl))
+			   (keywords (fifth vl))
+			   (allow-other-keys (sixth vl))
+			   (auxs (seventh vl))
+			   )
+	     (declare (object requireds optionals rest key-flag keywords
+			      allow-other-keys auxs))
+	     (do ((reqs requireds (cdr reqs)))
+		 ((endp reqs))
+	       (declare (object reqs))
+	       (when (or *safe-compile* *compiler-check-args*)
+		 (wt-nl "if(endp(") (wt-lcl lcl)
+		 (wt "))FEinvalid_macro_call(VV[" (add-symbol name) "]);"))
+	       (dm-bind-loc (car reqs) `(CAR ,lcl))
+	       (when (or (cdr reqs) optionals rest key-flag
+			 *safe-compile* *compiler-check-args*)
+		 (wt-nl) (wt-lcl lcl) (wt "=CDR(") (wt-lcl lcl) (wt ");")))
+	     (do ((opts optionals (cdr opts))
+		  (opt))
+		 ((endp opts))
+	       (declare (object opts opt))
+	       (setq opt (car opts))
+	       (wt-nl "if(endp(") (wt-lcl lcl) (wt ")){")
+	       (let ((*env* *env*)
+		     (*unwind-exit* *unwind-exit*))
+		 (dm-bind-init opt)
+		 (when (third opt) (dm-bind-loc (third opt) nil))
+		 )
+	       (wt-nl "} else {")
+	       (dm-bind-loc (car opt) `(CAR ,lcl))
+	       (when (third opt) (dm-bind-loc (third opt) t))
+	       (when (or (cdr opts) rest key-flag
+			 *safe-compile* *compiler-check-args*)
+		 (wt-nl) (wt-lcl lcl) (wt "=CDR(") (wt-lcl lcl) (wt ");"))
+	       (wt "}"))
+	     (when rest (dm-bind-loc rest `(LCL ,lcl)))
+	     (when keywords
+	       (let* ((lcl1 (next-lcl))
+		      (loc1 `(LCL ,lcl1)))
+		 (wt-nl "{cl_object " loc1 ";")
+		 (dolist (kwd keywords)
+		   (wt-nl loc1 "=getf(") (wt-lcl lcl)
+		   (wt ",VV[" (add-symbol (car kwd)) "],OBJNULL);")
+		   (wt-nl "if(" loc1 "==OBJNULL){")
+		   (let ((*env* *env*)
+			 (*unwind-exit* *unwind-exit*))
+		     (dm-bind-init (cdr kwd))
+		     (when (fourth kwd) (dm-bind-loc (fourth kwd) nil))
+		     (wt-nl "} else {"))
+		   (dm-bind-loc (second kwd) loc1)
+		   (when (fourth kwd) (dm-bind-loc (fourth kwd) t))
+		   (wt "}"))
+		 (wt "}")))
+	     (when (and (or *safe-compile* *compiler-check-args*)
+			(null rest)
+			(null key-flag))
+	       (wt-nl "if(!endp(") (wt-lcl lcl)
+	       (wt "))FEinvalid_macro_call(VV[" (add-symbol name) "]);"))
+	     (when (and (or *safe-compile* *compiler-check-args*)
+			key-flag
+			(not allow-other-keys))
+	       (wt-nl "check_other_key(") (wt-lcl lcl) (wt "," (length keywords))
+	       (dolist (kwd keywords)
+		 (wt ",VV[" (add-symbol (car kwd)) "]"))
+	       (wt ");"))
+	     (dolist (aux auxs)
+	       (dm-bind-init aux)))
+	   )
+
+    (setq lcl (next-lcl))
+    (wt-nl "{cl_object ") (wt-lcl lcl) (wt "=CDR(V1)")
+    (reserve-vl vl)			; declare variables for pattern
+    (wt ";")
+    (dm-bind-vl vl lcl)
+    )
+  (c2expr body)
+  (wt "}")
+  )
diff --git a/src/cmp/cmplet.lsp b/src/cmp/cmplet.lsp
new file mode 100644
index 000000000..4b243b79c
--- /dev/null
+++ b/src/cmp/cmplet.lsp
@@ -0,0 +1,427 @@
+;;;;  CMPLET  Let and Let*.
+;;;;
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    ECL is free software; you can redistribute it and/or modify it
+;;;;    under the terms of the GNU Library General Public License as
+;;;;    published by the Free Software Foundation; either version 2 of
+;;;;    the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "COMPILER")
+
+(defun c1let (args &aux (info (make-info))
+                   	(setjmps *setjmps*)
+                        (forms nil) (vars nil) (vnames nil)
+                        ss is ts body other-decls
+                        (*vars* *vars*))
+  (when (endp args) (too-few-args 'let 1 0))
+
+  (multiple-value-setq (body ss ts is other-decls) (c1body (cdr args) nil))
+
+  (c1add-globals ss)
+
+  (dolist (x (car args))
+    (cond ((symbolp x)
+           (let ((v (c1make-var x ss is ts)))
+                (push x vnames)
+                (push v vars)
+                (push (default-init (var-type v)) forms)))
+          (t (cmpck (not (and (consp x) (or (endp (cdr x)) (endp (cddr x)))))
+                    "The variable binding ~s is illegal." x)
+             (let* ((vname (car x))
+		    (v (c1make-var vname ss is ts))
+		    (form (if (endp (cdr x))
+                            (default-init (var-type v))
+                            (and-form-type (var-type v)
+                                           (c1expr* (second x) info)
+                                           (second x)))))
+	       ;; :read-only variable handling. Beppe
+;	       (when (read-only-variable-p vname ts)
+;		     (setf (var-type v) (info-type (second form))))
+	       (push vname vnames)
+	       (push v vars)
+	       (push form forms)))))
+
+  (dolist (v (reverse vars)) (push-vars v))
+
+  (check-vdecl vnames ts is)
+
+  (setq body (c1decl-body other-decls body))
+
+  (add-info info (second body))
+  (setf (info-type info) (info-type (second body)))
+
+  ;; since the body may produce type constraints on variables:
+  ;; (let (x) (foo x)) where (type (function (fixnum) fixnum) foo)
+  ;; do it again
+  (do ((vars vars (cdr vars))
+       (forms forms (cdr forms))
+       (form) (var))
+      ((null vars))
+    (declare (type var var))
+    (setq var (first vars)
+	  form (first forms))
+    (setf (car forms)
+	  (and-form-type (var-type var) form (var-name var)))
+    (when (member (info-type (second (car forms)))
+		  '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT) :test #'eq)
+      (incf (var-ref var)))		; force unboxing
+    ;; Automatic treatement for READ-ONLY variables:
+    (unless (var-changed-in-forms var (list body))
+      (let ((type (info-type (second (car forms)))))
+	(setf (var-type var) type)
+	(update-var-type var type body)))
+    (check-vref var)
+    )
+
+  (unless (eql setjmps *setjmps*) (setf (info-volatile info) t))
+
+  (list 'LET info (reverse vars) (reverse forms) body)
+  )
+
+(defun update-var-type (var type x)
+  (when (listp x)
+    (if (and (eq (car x) 'VAR)
+	     (eq var (first (third x))))
+	(setf (info-type (second x))
+	      ;; some occurrences might be typed with 'the'
+	      (type-and (info-type (second x)) type))
+	(dolist (e x)
+	  (update-var-type var type e)))))
+
+;(defun read-only-variable-p (v l) (eq 'READ-ONLY (cdr (assoc v l))))
+
+(defun c2let (vars forms body
+                   &aux (block-p nil) (bindings nil)
+                   initials
+                   (*unwind-exit* *unwind-exit*)
+		   (*env* *env*)
+                   (*env-lvl* *env-lvl*) env-grows)
+  (declare (type boolean block-p))
+
+  ;; Allocation is needed for:
+  ;; 1. each variable which is LOCAL and which is not REPLACED
+  ;;    or whose value is not DISCARDED
+  ;; 2. each init form for the remaining variables except last
+
+  ;; Determine which variables are really necessary and create list of init's
+  ;; and list of bindings. Bindings for specials must be done after all inits.
+  (labels ((do-decl (var lcl)
+	     (declare (type var var))
+	     (setf (var-loc var) lcl)	; must be set or bind will clobber it
+	     (wt-nl)
+	     (unless block-p
+	       (wt "{") (setq block-p t))
+	     (wt *volatile* (register var) (rep-type (var-kind var)))
+	     (wt-lcl lcl) (wt ";")
+	     (when (local var)
+	       (wt-comment (var-name var))))
+	   (do-init (var form fl)
+	     (if (and (local var)
+		      (not (args-cause-side-effect (cdr fl))))
+		 ;; avoid creating temporary for init
+		 (push (cons (list 'VAR var) form) initials)
+		 (let* ((lcl (next-lcl))
+			(loc (list 'LCL lcl)))
+		   (do-decl (make-var) lcl)
+		   (push (cons loc form) initials)
+		   (push (cons var loc) bindings)))))
+
+    (do ((vl vars (rest vl))
+         (fl forms (rest fl))
+         (form) (var)
+         (prev-ss nil) (used t t))
+        ((endp vl))
+      (declare (type var var))
+      (setq form (first fl)
+            var (first vl))
+      (when (and (local var)
+		 (setq used (not (discarded var form body))))
+	(do-decl var (next-lcl)))
+      (when used
+	(if (unboxed var)
+	    (push (cons (list 'VAR var) form) initials)	; nil (ccb)
+	    ;; LEXICAL, SPECIAL, GLOBAL or OBJECT
+	    (case (car form)
+	      (LOCATION
+	       (if (can-be-replaced var body)
+		   (setf (var-kind var) 'REPLACED
+			 (var-loc var) (third form))
+		   (push (cons var (third form)) bindings)))
+	      (VAR
+	       (let* ((vref1 (third form))
+		      (var1 (car vref1)))
+		 (cond ((or (var-changed-in-forms var1 (cdr fl))
+			    (and (member (var-kind var1) '(SPECIAL GLOBAL)
+					 :test #'eq)
+				 (member (var-name var1) prev-ss :test #'eq)))
+			(do-init var form fl))
+		       ((and (can-be-replaced var body)
+			     (member (var-kind var1) '(LEXICAL REPLACED OBJECT)
+				     :test #'eq)
+			     (not (var-ref-ccb var1))
+			     (not (member var1
+					  (info-changed-vars (second body)))))
+			(setf (var-kind var) 'REPLACED
+			      (var-loc var) (cons 'VAR vref1)))
+		       (t (push (cons var (cons 'VAR vref1)) bindings)))))
+	      (t (do-init var form fl))))
+	(unless env-grows
+	  (setq env-grows (var-ref-ccb var))))
+      (when (eq (var-kind var) 'SPECIAL) (push (var-name var) prev-ss))))
+
+  (when (env-grows env-grows)
+    (unless block-p
+      (wt-nl "{ ") (setq block-p t))
+    (let ((env-lvl *env-lvl*))
+      (wt "volatile cl_object env" (incf *env-lvl*) " = env" env-lvl ";")))
+
+  ;; eval INITFORM's and bind variables
+  (dolist (init (nreverse initials))
+    (let ((*destination* (car init))
+	  (*lcl* *lcl*))
+      (c2expr* (cdr init))))
+  ;; bind LET variables
+  (dolist (binding (nreverse bindings))
+    (bind (cdr binding) (car binding)))
+
+  (c2expr body)
+  (when block-p (wt-nl "}"))
+  )
+
+(defun env-grows (possibily)
+  ;; if additional closure variables are introduced and this is not
+  ;; last form, we must use a new env.
+  (and possibily
+       (plusp *env*)
+       (dolist (exit *unwind-exit*)
+	 (case exit
+	   (RETURN (return NIL))
+	   (BDS-BIND)
+	   (t (return T))))))
+
+(defun c1let* (args &aux (forms nil) (vars nil) (vnames nil)
+                    (setjmps *setjmps*)
+                    ss is ts body other-decls
+                    (info (make-info)) (*vars* *vars*))
+  (when (endp args) (too-few-args 'let* 1 0))
+
+  (multiple-value-setq (body ss ts is other-decls) (c1body (cdr args) nil))
+  (c1add-globals ss)
+
+  (dolist (x (car args))
+    (cond ((symbolp x)
+           (let ((v (c1make-var x ss is ts)))
+	     (push x vnames)
+	     (push (default-init (var-type v)) forms)
+	     (push v vars)
+	     (push-vars v)))
+          ((not (and (consp x) (or (endp (cdr x)) (endp (cddr x)))))
+           (cmperr "The variable binding ~s is illegal." x))
+          (t (let* ((v (c1make-var (car x) ss is ts))
+		    (form (if (endp (cdr x))
+			      (default-init (var-type v))
+			      (and-form-type (var-type v)
+					     (c1expr* (second x) info)
+					     (second x)))))
+	       ;; :read-only variable handling.
+;	       (when (read-only-variable-p (car x) ts)
+;		     (setf (var-type v) (info-type (second form))))
+	       (push (car x) vnames)
+	       (push form forms)
+	       (push v vars)
+	       (push-vars v)))))
+
+  (check-vdecl vnames ts is)
+  (setq body (c1decl-body other-decls body))
+  (add-info info (second body))
+  (setf (info-type info) (info-type (second body)))
+
+  ;; since the body may produce type constraints on variables,
+  ;; do it again:
+  (let (used-vars used-forms)
+    (do ((vs (setq vars (nreverse vars)) (cdr vs))
+	 (fs (nreverse forms) (cdr fs))
+	 (var) (form))
+	((null vs))
+      (setq var (car vs)
+	    form (and-form-type (var-type var) (car fs) (cadar args)))
+      ;; Automatic treatement for READ-ONLY variables:
+      (let ((rest-forms (cons body (cdr fs))))
+	(unless (var-changed-in-forms var rest-forms)
+	  (let ((type (info-type (second form))))
+	    (setf (var-type var) type)
+	    (update-var-type var type rest-forms))))
+      (check-vref var)
+
+      ;;  (let* ((v1 e1) (v2 e2) (v3 e3)) (expr e4 v2 e5))
+      ;;  can become
+      ;;  (let* ((v1 e1) (v3 e3)) (expr e4 e2 e5))
+      ;;  provided
+      ;;  - v2 appears only once
+      ;;  - v2 appears only in body
+      ;;  - e2 does not affect v1 nor e3, e3 does not affect e2
+      ;;  - e4 does not affect e2
+
+      (if (and (= 1 (var-ref var))
+	       (member var (info-referred-vars (second body)))
+	       (or (and (null (cdr fs))	; last variable
+			;; its form does not affect previous variables
+			(let ((tforms (list (car fs))))
+			  (dolist (v vars)
+			    (when (eq v var) (return t))
+			    (when (var-changed-in-forms v tforms)
+			      (return nil)))))
+		   (not (args-cause-side-effect fs)))
+	       (catch var
+		 (replaceable var body)))
+
+	  (locally (declare (notinline nsubst))
+	    (setq body
+		  (nsubst-if form #'(lambda (x)
+				      (and (listp x)
+					   (eq (first x) 'VAR)
+					   (eq var (first (third x)))))
+			     body)))
+	  (progn
+	    (push var used-vars)
+	    (push form used-forms)
+	    (when (member (info-type (second form))
+			  '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT)
+			  :test #'eq)
+	      (incf (var-ref var))))))		; force unboxing
+
+    (unless (eql setjmps *setjmps*) (setf (info-volatile info) t))
+    (list 'LET* info (nreverse used-vars) (nreverse used-forms) body)))
+
+;; should check whether a form before var causes a side-effect
+;; exactly one occurrence of var is present in forms
+(defun replaceable (var form)
+  (case (car form)
+    (VAR
+     (if (eq var (first (third form)))
+	 (throw var T)
+	 T))
+    ((LOCATION SYS:STRUCTURE-REF) T)
+    (CALL-GLOBAL
+     (dolist (arg (fourth form) T)
+       (when (or (not (replaceable var arg))
+		 (args-cause-side-effect (list arg)))
+	 (return nil))))
+    (SETQ (replaceable var (fourth form)))))
+
+(defun c2let* (vars forms body
+                    &aux (block-p nil)
+                    (*unwind-exit* *unwind-exit*)
+		    (*env* *env*)
+		    (*env-lvl* *env-lvl*) env-grows)
+  (declare (type boolean block-p))
+
+  (do ((vl vars (cdr vl))
+       (fl forms (cdr fl))
+       (var) (form) (kind))
+      ((endp vl))
+    (declare (type var var))
+    (setq form (car fl)
+          var (car vl)
+          kind (local var))
+    (unless (unboxed var)
+      ;; LEXICAL, SPECIAL, GLOBAL or OBJECT
+      (case (car form)
+        (LOCATION
+         (when (can-be-replaced* var body (cdr fl))
+           (setf (var-kind var) 'REPLACED
+                 (var-loc var) (third form))))
+        (VAR
+         (let* ((vref1 (third form))
+		(var1 (car vref1)))
+           (declare (type var var1))
+           (when (and (can-be-replaced* var body (cdr fl))
+		      (member (var-kind var1)
+			      '(LEXICAL REPLACED OBJECT) :test #'eq)
+		      (not (var-ref-ccb var1))
+		      (not (var-changed-in-forms var1 (cdr fl)))
+		      (not (member var1 (info-changed-vars (second body)))))
+             (setf (var-kind var) 'REPLACED
+                   (var-loc var) (cons 'VAR vref1))))))
+      (unless env-grows
+	(setq env-grows (var-ref-ccb var))))
+    (when (and kind (not (eq (var-kind var) 'REPLACED)))
+      (setf (var-loc var) (next-lcl))
+      (wt-nl) (unless block-p (wt "{") (setq block-p t))
+      (wt *volatile* (register var) (rep-type kind))
+      (wt-lcl (var-loc var)) (wt ";")
+      (wt-comment (var-name var)))
+    )
+
+  (when (env-grows env-grows)
+    (unless block-p
+      (wt-nl "{ ") (setq block-p t))
+    (let ((env-lvl *env-lvl*))
+      (wt "volatile cl_object env" (incf *env-lvl*) " = env" env-lvl ";")))
+
+  (do ((vl vars (cdr vl))
+       (fl forms (cdr fl))
+       (var nil) (form nil))
+      ((null vl))
+    (declare (type var var))
+    (setq var (car vl)
+	  form (car fl))
+    (case (var-kind var)
+      ((FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT) ; (local var)
+       (let ((*destination* `(VAR ,var))) ; nil (ccb)
+	 (c2expr* form)))
+      (REPLACED)
+      (t (case (car form)
+	   (LOCATION (bind (third form) var))
+	   (VAR (bind (cons 'VAR (third form)) var))
+	   (t (bind-init var form))))))
+
+  (c2expr body)
+
+  (when block-p (wt-nl "}"))
+  )
+
+(defun discarded (var form body &aux last)
+  (labels ((last-form (x)
+	     (case (car x)
+	       (PROGN
+		 (last-form (car (last (third x)))))
+	       ((LET LET* FLET LABELS BLOCK CATCH)
+		(last-form (car (last x))))
+	       (VAR (car (third x)))
+	       (t x))))
+    (and (not (args-cause-side-effect (list form)))
+	 (or (< (var-ref var) 1)
+	     (and (= (var-ref var) 1)
+		  (eq var (last-form body))
+		  (eq 'TRASH *destination*))))))
+
+(defun can-be-replaced (var body)
+  (declare (type var var))
+  (and (eq (var-kind var) 'OBJECT)
+       (< (var-ref var) *register-min*)
+       (not (member var (info-changed-vars (second body))))))
+#|  (and (or (eq (var-kind var) 'LEXICAL)
+	   (and (eq (var-kind var) 'OBJECT)
+		(< (var-ref var) *register-min*)))
+       (not (var-ref-ccb var))
+       (not (member var (info-changed-vars (second body)))))
+|#
+
+(defun can-be-replaced* (var body forms)
+  (declare (type var var))
+  (and (can-be-replaced var body)
+       (dolist (form forms t)
+         (when (member var (info-changed-vars (second form)))
+               (return nil)))))
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'LET 'C1SPECIAL) #'c1let)
+(setf (get 'LET 'C2) 'c2let)
+(setf (get 'LET* 'C1SPECIAL) #'c1let*)
+(setf (get 'LET* 'C2) 'c2let*)
diff --git a/src/cmp/cmploc.lsp b/src/cmp/cmploc.lsp
new file mode 100644
index 000000000..8b3d084f1
--- /dev/null
+++ b/src/cmp/cmploc.lsp
@@ -0,0 +1,235 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPLOC  Set-loc and Wt-loc.
+
+(in-package "COMPILER")
+
+;;; Valid locations are:
+;;;	NIL
+;;;	T
+;;;	'VALUES'
+;;;	( 'VALUE' i )			VALUES(i)
+;;;	( 'VAR' var-object ) ; ccb
+;;;	( 'VV' vv-index )
+;;;	( 'LCL' lcl )			local variable, type unboxed
+;;;	( 'TEMP' temp )			local variable, type object
+;;;	( 'CALL' fun narg locs fname )	locs are locations containing the arguments
+;;;	( 'CALL-LOCAL' fun lex closure args narg fname )
+;;;	( 'INLINE' side-effect-p fun/string locs )	fun is applied to locs
+;;;	( 'INLINE-COND' side-effect-p fun/string locs )
+;;;	( 'INLINE-FIXNUM' side-effect-p fun/string locs )
+;;;	( 'INLINE-CHARACTER' side-effect-p fun/string locs )
+;;;	( 'INLINE-LONG-FLOAT' side-effect-p fun/string locs )
+;;;	( 'INLINE-SHORT-FLOAT' side-effect-p fun/string locs )
+;;;	( 'CAR' lcl )
+;;;	( 'CADR' lcl )
+;;;	( 'SYMBOL-FUNCTION' vv-index )
+;;;	( 'MAKE-CCLOSURE' cfun )
+;;;	( 'FIXNUM-VALUE' fixnum-value )
+;;;	( 'CHARACTER-VALUE' character-code )
+;;;	( 'LONG-FLOAT-VALUE' long-float-value vv )
+;;;	( 'SHORT-FLOAT-VALUE' short-float-value vv )
+;;;;	These are never passed to unwind-exit:
+;;;	( 'FIXNUM->OBJECT' loc )
+;;;	( 'CHARACTER->OBJECT' loc )
+;;;	( 'LONG-FLOAT->OBJECT' loc )
+;;;	( 'SHORT-FLOAT->OBJECT' loc )
+
+
+;;; Valid *DESTINATION* locations are:
+;;;
+;;;	'RETURN'	The value is returned from the current function.
+;;;	'RETURN-FIXNUM'
+;;;	'RETURN-CHARACTER'
+;;;	'RETURN-LONG-FLOAT'
+;;;	'RETURN-SHORT-FLOAT'
+;;;	'RETURN-OBJECT
+;;;	'TRASH'			The value may be thrown away.
+;;;	'VALUES'
+;;;	( 'VAR' var-object ) ; ccb
+;;;	( 'LCL' lcl )
+;;;	( 'LEX' lex-address )
+;;;	( 'BIND' var alternative )	; alternative is optional
+;;;	( 'JUMP-TRUE' label )
+;;;	( 'JUMP-FALSE' label )
+;;;	( 'PUSH-CATCH-FRAME' )
+
+(defun set-loc (loc &aux fd
+		    (is-call (and (consp loc)
+				  (member (car loc) '(CALL CALL-LOCAL)
+					  :test #'eq))))
+  (case *destination*
+    (VALUES
+     (cond (is-call (wt-nl "VALUES(0)=" loc ";"))
+	   ((eq loc 'VALUES))
+	   (t (wt-nl "VALUES(0)=" loc "; NValues=1;"))))
+    (RETURN
+     (cond ((or is-call (eq loc 'VALUES)) (wt-nl "value0=" loc ";"))
+	   ((eq loc 'RETURN))
+	   (t (wt-nl "value0=" loc "; NValues=1;"))))
+    (TRASH
+     (cond (is-call (wt-nl "(void)" loc ";"))
+	   ((and (consp loc)
+		 (member (car loc)
+			 '(INLINE INLINE-COND INLINE-FIXNUM
+				  INLINE-CHARACTER INLINE-LONG-FLOAT
+				  INLINE-SHORT-FLOAT)
+			 :test #'eq)
+		 (second loc))
+;;;	Removed (void) specifier, for the Prolog inline code.
+;;;         (wt-nl "(void)(") (wt-inline t (third loc) (fourth loc))
+            (wt-nl) (wt-inline t (third loc) (fourth loc))
+            (wt ";"))))
+    (t (cond
+        ((or (not (consp *destination*))
+             (not (symbolp (car *destination*))))
+         (baboon))
+        ((setq fd (get (car *destination*) 'SET-LOC))
+         (apply fd loc (cdr *destination*)))
+        ((setq fd (get (car *destination*) 'WT-LOC))
+         (wt-nl) (apply fd (cdr *destination*)) (wt "= " loc ";"))
+        (t (baboon)))))
+  )
+
+(defun wt-loc (loc &aux fd)
+  (cond ((eq loc nil) (wt "Cnil"))
+        ((eq loc t) (wt "Ct"))
+        ((eq loc 'RETURN)
+	 (wt "value0"))	; added for last inline-arg
+	((eq loc 'VALUES)
+	 (wt "VALUES(0)"))
+        ((or (not (consp loc))
+             (not (symbolp (car loc))))
+         (baboon))
+        ((setq fd (get (car loc) 'WT-LOC))
+	 (apply fd (cdr loc)))
+	(t (baboon)))
+  )
+
+(defun last-call-p ()
+  (member *exit*
+          '(RETURN RETURN-FIXNUM RETURN-CHARACTER RETURN-SHORT-FLOAT
+            RETURN-LONG-FLOAT RETURN-OBJECT)))
+
+(defun wt-car (lcl) (wt "CAR(") (wt-lcl lcl) (wt ")"))
+
+(defun wt-cdr (lcl) (wt "CDR(") (wt-lcl lcl) (wt ")"))
+
+(defun wt-cadr (lcl) (wt "CADR(") (wt-lcl lcl) (wt ")"))
+
+(defun wt-lcl (lcl) (wt "V" lcl))
+
+(defun wt-vv (vv) (wt "VV[" vv "]"))
+
+(defun wt-lcl-loc (lcl)
+  (wt-lcl lcl))
+
+(defun wt-temp (temp)
+  (wt "T" temp))
+
+(defun wt-number (value &optional vv)
+  (typecase value
+    (fixnum (wt "MAKE_FIXNUM(" value ")"))
+    (t (wt "VV[" vv "]"))))
+
+(defun wt-character (value &optional vv)
+  (wt (format nil "code_char('\\~O')" value)))
+
+(defun wt-fixnum-loc (loc)
+  (if (consp loc)
+      (case (car loc)
+	(VAR
+	 (if (eq (var-kind (second loc)) 'FIXNUM)
+	     (wt-lcl (var-loc (second loc)))
+	     (wt "fix(" loc ")")))
+	(INLINE-FIXNUM
+	 (wt-inline-loc (third loc) (fourth loc)))
+	(FIXNUM-VALUE
+	 (wt (second loc)))
+	((INLINE-SHORT-FLOAT INLINE-LONG-FLOAT)
+	 (wt "((int)(")
+	 (wt-inline-loc (third loc) (fourth loc))
+	 (wt "))"))
+	(t (wt "fix(" loc ")")))
+      (wt "fix(" loc ")")))
+
+(defun wt-character-loc (loc)
+  (if (consp loc)
+      (case (car loc)
+	(VAR
+	 (if (eq (var-kind (second loc)) 'CHARACTER)
+	     (wt-lcl (var-loc (second loc)))
+	     (wt "char_code(" loc ")")))
+        (INLINE-CHARACTER
+         (wt-inline-loc (third loc) (fourth loc)))
+        (CHARACTER-VALUE
+         (wt (second loc)))
+        (t (wt "char_code(" loc ")")))
+      (wt "char_code(" loc ")")))
+
+(defun wt-long-float-loc (loc)
+  (if (consp loc)
+      (case (car loc)
+	(VAR
+	 (if (eq (var-kind (second loc)) 'LONG-FLOAT)
+	     (wt-lcl (var-loc (second loc)))
+	     (wt "lf(" loc ")")))
+	(INLINE-LONG-FLOAT
+	 (wt-inline-loc (third loc) (fourth loc)))
+	(LONG-FLOAT-VALUE
+	 (wt (second loc)))
+	(t (wt "lf(" loc ")")))
+      (wt "lf(" loc ")")))
+
+(defun wt-short-float-loc (loc)
+  (if (consp loc)
+      (case (car loc)
+	(VAR
+	 (if (eq (var-kind (second loc)) 'SHORT-FLOAT)
+	     (wt-lcl (var-loc (second loc)))
+	     (wt "sf(" loc ")")))
+	(INLINE-SHORT-FLOAT
+	 (wt-inline-loc (third loc) (fourth loc)))
+	(SHORT-FLOAT-VALUE
+	 (wt (second loc)))
+	(t (wt "sf(" loc ")")))
+      (wt "sf(" loc ")")))
+
+(defun wt-va_arg (call-lambda)
+  (if call-lambda
+      (wt "args[i]")
+      (wt "va_arg(args, cl_object)")))
+;(defun set-va_arg (loc) (wt-nl "va_arg(args, cl_object)=" loc ";"))
+
+(defun wt-value (i) (wt "VALUES(" i ")"))
+
+(defun wt-keyvars (i) (wt "keyvars[" i "]"))
+
+;;; -----------------------------------------------------------------
+
+(setf (get 'TEMP 'WT-LOC) #'wt-temp)
+(setf (get 'LCL 'WT-LOC) #'wt-lcl-loc)
+(setf (get 'VV 'WT-LOC) #'wt-vv)
+(setf (get 'CAR 'WT-LOC) #'wt-car)
+(setf (get 'CDR 'WT-LOC) #'wt-cdr)
+(setf (get 'CADR 'WT-LOC) #'wt-cadr)
+(setf (get 'FIXNUM-VALUE 'WT-LOC) #'wt-number)
+(setf (get 'FIXNUM-LOC 'WT-LOC) #'wt-fixnum-loc) ; used in cmpfun.lsp
+(setf (get 'CHARACTER-VALUE 'WT-LOC) #'wt-character)
+;(setf (get 'CHARACTER-LOC 'WT-LOC) #'wt-character-loc)
+(setf (get 'LONG-FLOAT-VALUE 'WT-LOC) #'wt-number)
+;(setf (get 'LONG-FLOAT-LOC 'WT-LOC) #'wt-long-float-loc)
+(setf (get 'SHORT-FLOAT-VALUE 'WT-LOC) #'wt-number)
+;(setf (get 'SHORT-FLOAT-LOC 'WT-LOC) #'wt-short-float-loc)
+(setf (get 'VA-ARG 'WT-LOC) #'wt-va_arg)
+;(setf (get 'VA-ARG 'SET-LOC) #'set-va_arg)
+(setf (get 'VALUE 'WT-LOC) #'wt-value)
+(setf (get 'KEYVARS 'WT-LOC) #'wt-keyvars)
diff --git a/src/cmp/cmpmac.lsp b/src/cmp/cmpmac.lsp
new file mode 100644
index 000000000..d4b92c0a7
--- /dev/null
+++ b/src/cmp/cmpmac.lsp
@@ -0,0 +1,66 @@
+;;; ----------------------------------------------------------------------
+;;; Macros only used in the code of the compiler itself:
+
+(in-package "COMPILER")
+(import 'sys::arglist "COMPILER")
+
+;;; from cmpenv.lsp
+(defmacro next-cmacro () '(incf *next-cmacro*))
+(defmacro next-cfun () '(incf *next-cfun*))
+
+;;; from cmplabel.lsp
+(defmacro next-label () `(cons (incf *last-label*) nil))
+
+(defmacro next-label* () `(cons (incf *last-label*) t))
+
+(defmacro wt-label (label)
+  `(when (cdr ,label) (wt-nl1 "L" (car ,label) ":")))
+
+(defmacro wt-go (label)
+  `(progn (rplacd ,label t) (wt "goto L" (car ,label) ";")))
+
+;;; from cmplam.lsp
+(defmacro ck-spec (condition)
+  `(unless ,condition
+           (cmperr "The parameter specification ~s is illegal." spec)))
+
+(defmacro ck-vl (condition)
+  `(unless ,condition
+           (cmperr "The lambda list ~s is illegal." vl)))
+
+;;; fromcmputil.sp
+(defmacro safe-compile (&rest forms) `(when *safe-compile* ,@forms))
+(defmacro cmpck (condition string &rest args)
+  `(if ,condition (cmperr ,string ,@args)))
+
+;;; from cmpwt.lsp
+(defmacro wt (&rest forms &aux (fl nil))
+  (dolist (form forms (cons 'progn (nreverse (cons nil fl))))
+    (if (stringp form)
+        (push `(princ ,form *compiler-output1*) fl)
+        (push `(wt1 ,form) fl))))
+
+(defmacro wt-h (&rest forms &aux (fl nil))
+  (dolist (form forms)
+    (if (stringp form)
+      (push `(princ ,form *compiler-output2*) fl)
+      (push `(wt-h1 ,form) fl)))
+  `(progn (terpri *compiler-output2*) ,@(nreverse (cons nil fl))))
+
+(defmacro princ-h (form) `(princ ,form *compiler-output2*))
+
+(defmacro wt-nl (&rest forms)
+  `(wt #\Newline #\Tab ,@forms))
+
+(defmacro wt-nl1 (&rest forms)
+  `(wt #\Newline ,@forms))
+
+(defmacro definline (fun arg-types type code)
+  `(eval-when (compile load eval)
+              ;; defCbody must go first, because it clears symbol-plist of fun
+              (defCbody ,fun ,arg-types ,type ,code)
+              (proclaim '(function ,fun ,arg-types ,type))
+              (setf (get ',fun ':inline-always)
+                    '((,arg-types ,type
+                       t                ; side-effect-p
+                       nil ,code)))))
diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp
new file mode 100644
index 000000000..0afa409e9
--- /dev/null
+++ b/src/cmp/cmpmain.lsp
@@ -0,0 +1,508 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPMAIN  Compiler main program.
+
+;;;		**** Caution ****
+;;;	This file is machine/OS dependant.
+;;;		*****************
+
+
+(in-package "COMPILER")
+
+(defvar *cmpinclude* "<ecls-cmp.h>")
+;;; This is copied into each .h file generated, EXCEPT for system-p calls.
+;;; The constant string *include-string* is the content of file "ecl.h".
+;;; Here we use just a placeholder: it will be replaced with sed.
+
+(defvar *cc* "cc"))
+(defvar *cc-flags* "-g -I.")
+(defvar *cc-optimize* "-O")		; C compiler otimization flag
+(defvar *cc-format* "~A ~A ~:[~*~;~A~] -I~A/h -w -c ~A -o ~A"))
+;(defvar *cc-format* "~A ~A ~:[~*~;~A~] -I~A/h -c ~A -o ~A"))
+(defvar *ld-flags* "")
+(defvar *ld-format* "~A -w -o ~A -L~A ~{~A ~} -llsp ~A")
+
+(eval-when (compile eval)
+  (defmacro get-output-pathname (file ext)
+    `(make-pathname
+      :directory (or (and (or (stringp ,file) (pathnamep ,file))
+		          (pathname-directory ,file))
+		     directory)
+      :name (if (or (null ,file) (eq ,file T)) name (pathname-name ,file))
+      :type ,ext)))
+
+(defun safe-system (string)
+  (print string)
+  (let ((result (si:system string)))
+    (unless (zerop result)
+      (cerror "Continues anyway."
+	      "(SYSTEM ~S) returned non-zero value ~D"
+	      string result))
+    result))
+
+(defun library-pathname (name &optional (directory "./"))
+  (make-pathname :name (concatenate 'string "lib" name) :type "a" :defaults directory))
+
+(defun compile-file-pathname (name &key output-file)
+  (merge-pathnames (or output-file name) #P".o"))
+
+(defun make-library (lib objects &key (output-dir "./"))
+  (let* ((lib (string-upcase lib))
+	 (init-name (mapcar #'(lambda (x) (string-upcase (pathname-name x)))
+			    objects))
+	 (liba (library-pathname (string-downcase lib) output-dir))
+	 (libc (make-pathname :name lib :type "c" :defaults output-dir))
+	 (libo (make-pathname :name lib :type "o" :defaults output-dir)))
+    (with-open-file (libc-file libc :direction :output)
+      (format libc-file
+	      "
+void
+init_~A(cl_object)
+{
+~{	extern void init_~A(cl_object);~%~}
+~{	read_VV((void*)0,init_~A);~%~}
+}
+"
+	      lib init-name init-name)
+    (compiler-cc libc libo)
+    (safe-system (format nil "ar cr ~A ~A ~{~A ~}"
+			 (namestring liba) (namestring libo) objects))
+    (delete-file (namestring libc))
+    (delete-file (namestring libo)))
+    liba))
+
+(defun linker-cc (o-pathname options)
+  (safe-system
+   (format nil
+	   *ld-format*
+	   *cc* (namestring o-pathname)
+	   (namestring sys::*system-directory*)
+	   options *ld-flags*)))
+
+(defun rsym (name)
+  (let ((output (make-pathname :name (pathname-name name) :type "sym"))
+	(rsym (make-pathname :name "rsym" :defaults sys::*system-directory*)))
+    (cond ((not (probe-file rsym))
+	   (error "rsym executable not found"))
+	  ((not (probe-file name))
+	   (error "executable to be scanned not found"))
+	  (t
+	   (safe-system (format nil "~A ~A ~A" rsym name output))))))
+
+(defun build-ecls (name &rest components)
+  (let ((c-name (make-pathname :name name :type "c"))
+	(o-name (make-pathname :name name :type "o"))
+	(ld-flags nil))
+    (with-open-file (c-file c-name :direction :output)
+      (format c-file "
+#include \"ecls.h\"
+
+extern cl_object lisp_package;
+#ifdef RSYM
+extern cl_object siVsymbol_table;
+#endif
+void
+init_lisp_libs(void)
+{
+	init_LSP();
+	siLpackage_lock(2, lisp_package, Ct);~%")
+      (dolist (item (append '(#+clos clos) components))
+	(cond ((symbolp item)
+	       (format c-file "	init_~A();~%" (string-upcase item))
+	       (setq ld-flags (nconc ld-flags (list (format nil "-l~A" (string-downcase item))))))
+	      ((stringp item)
+	       (setq ld-flags (nconc ld-flags (list item))))
+	      (t
+	       (error "compiler::build-ecls wrong argument ~A" item))))
+      (format c-file "
+#ifdef RSYM
+	SYM_VAL(siVsymbol_table) = make_simple_string(\"~A.sym\");
+#endif
+	return;~%}~%" name))
+    (compiler-cc c-name o-name)
+    (linker-cc name (cons (namestring o-name) ld-flags))
+    (rsym name)
+    (delete-file c-name)
+    ))
+
+(defun compile-file (input-pathname
+                      &key (output-file 'T)
+		      (verbose *compile-verbose*)
+		      (print *compile-print*)
+		      (c-file nil)
+		      (h-file nil)
+		      (data-file nil)
+		      (system-p nil)
+		      (load nil)
+                      &aux (*standard-output* *standard-output*)
+                           (*error-output* *error-output*)
+                           (*compiler-in-use* *compiler-in-use*)
+                           (*package* *package*)
+			   (*print-pretty* nil)
+                           (*error-count* 0)
+			   #+PDE sys:*source-pathname*)
+  (declare (notinline compiler-cc))
+
+  (setq input-pathname (merge-pathnames input-pathname #".lsp"))
+
+  #+PDE (setq sys:*source-pathname* (truename input-pathname))
+
+  (when *compiler-in-use*
+    (format t "~&;;; The compiler was called recursively.~%~
+Cannot compile ~a."
+	    (namestring input-pathname))
+    (setq *error-p* t)
+    (return-from compile-file (values)))
+
+  (setq *error-p* nil
+	*compiler-in-use* t)
+
+  (unless (probe-file input-pathname)
+    (format t "~&;;; The source file ~a is not found.~%"
+            (namestring input-pathname))
+    (setq *error-p* t)
+    (return-from compile-file (values)))
+
+  (when *compile-verbose*
+    (format t "~&;;; Compiling ~a."
+            (namestring input-pathname)))
+
+  (let* ((eof '(NIL))
+	 (output-default (if (or (eq output-file 'T)
+				 (null output-file))
+			     input-pathname
+			     output-file))
+         (directory (pathname-directory output-default))
+         (name (pathname-name output-default))
+         (o-pathname (get-output-pathname output-file "o"))
+         (c-pathname (get-output-pathname c-file "c"))
+         (h-pathname (get-output-pathname h-file "h"))
+         (data-pathname (get-output-pathname data-file "data")))
+
+    (init-env)
+
+    (when (probe-file "./cmpinit.lsp")
+      (load "./cmpinit.lsp" :verbose *compile-verbose*))
+
+    (with-open-file (*compiler-output-data*
+                     data-pathname :direction :output)
+      (wt-data-begin)
+
+      (with-open-file
+          (*compiler-input* input-pathname)
+        (let* ((rtb *readtable*)
+               (prev (when (eq (get-macro-character #\# rtb)
+			       (get-macro-character
+				#\# (si:standard-readtable)))
+		       (get-dispatch-macro-character #\# #\, rtb))))
+          (if (and prev (eq prev (get-dispatch-macro-character
+                                   #\# #\, (si:standard-readtable))))
+              (set-dispatch-macro-character #\# #\,
+                'SYS:SHARP-COMMA-READER-FOR-COMPILER rtb)
+              (setq prev nil))
+          (unwind-protect
+            (do ((form (read *compiler-input* nil eof)
+                       (read *compiler-input* nil eof)))
+                ((eq form eof))
+              (t1expr form))
+            (when prev (set-dispatch-macro-character #\# #\, prev rtb)))))
+
+      (when (zerop *error-count*)
+        (when *compile-verbose* (format t "~&;;; End of Pass 1.  "))
+        (compiler-pass2 c-pathname h-pathname data-pathname system-p
+                        (if system-p
+                            (pathname-name input-pathname)
+                            "code")))
+
+      (wt-data-end)
+
+      ) ;;; *compiler-output-data* closed.
+
+    (init-env)
+
+    (if (zerop *error-count*)
+        (progn
+          (cond (output-file
+		 (when *compile-verbose*
+		   (format t "~&;;; Calling the C compiler... "))
+                 (compiler-cc c-pathname o-pathname)
+                 (cond ((probe-file o-pathname)
+                        ;(cat-data-file o-pathname data-pathname)
+                        (when load (load o-pathname))
+                        (when *compile-verbose*
+			  (print-compiler-info)
+			  (format t "~&;;; Finished compiling ~a."
+				  (namestring input-pathname))))
+		       #+(or SYSTEM-V APOLLO) ;tito 
+		       ((probe-file (setq ob-name
+					  (format nil "~a.o"
+						  (pathname-name o-pathname))))
+			(si:system (format nil "mv ~A ~A" (namestring ob-name)
+					    (namestring o-pathname)))
+                        ;(cat-data-file o-pathname data-pathname)
+                        (when load (load o-pathname))
+                        (when *compile-verbose*
+			  (print-compiler-info)
+			  (format t "~&;;; Finished compiling ~a."
+				  (namestring input-pathname))))	       
+                       (t (format t "~&;;; The C compiler failed to compile the intermediate file.~%")
+                          (setq *error-p* t))))
+		(*compile-verbose*
+		 (print-compiler-info)
+		 (format t "~&;;; Finished compiling ~a."
+			 (namestring input-pathname))))
+          (unless c-file (delete-file c-pathname))
+          (unless h-file (delete-file h-pathname))
+          (unless data-file (delete-file data-pathname))
+	  o-pathname)
+
+        (progn
+          (when (probe-file c-pathname) (delete-file c-pathname))
+          (when (probe-file h-pathname) (delete-file h-pathname))
+          (when (probe-file data-pathname) (delete-file data-pathname))
+          (format t "~&;;; No FASL generated.~%")
+          (setq *error-p* t)
+	  (values))
+        ))
+  )
+
+(defun compile (name &optional (def nil supplied-p)
+                      &aux form gazonk-name
+                      data-pathname
+                      (*compiler-in-use* *compiler-in-use*)
+                      (*standard-output* *standard-output*)
+                      (*error-output* *error-output*)
+                      (*package* *package*)
+                      (*compile-print* nil)
+		      (*print-pretty* nil)
+                      (*error-count* 0))
+
+  (unless (symbolp name) (error "~s is not a symbol." name))
+
+  (when *compiler-in-use*
+    (format t "~&;;; The compiler was called recursively.~
+		~%Cannot compile ~s." name)
+    (setq *error-p* t)
+    (return-from compile))
+
+  (setq *error-p* nil
+	*compiler-in-use* t)
+
+  (cond ((and supplied-p def)
+         (unless (and (consp def) (eq (car def) 'LAMBDA))
+                 (error "~s is invalid lambda expression." def))
+         (setq form (if name
+                        `(defun ,name ,@(cdr def))
+                        `(set 'GAZONK #',def))))
+        ((and (fboundp name)
+              (consp (setq def (symbol-function name))))
+         (cond ((and (eq (car def) 'LAMBDA-BLOCK)
+                     (consp (cdr def)) (consp (cddr def)))
+                (if (eq (cadr def) name)
+                    (setq form `(defun ,name ,@(cddr def)))
+                    (setq form `(defun ,name ,(caddr def)
+                                  (block ,(cadr def) ,@(cdddr def))))))
+               ((eq (car def) 'LAMBDA)
+                (setq form `(defun ,name ,@(cdr def))))
+               ((and (eq (car def) 'LAMBDA-CLOSURE)
+                     (consp (cdr def)) (null (cadr def))
+                     (consp (cddr def)) (null (caddr def))
+                     (consp (cdddr def)) (null (cadddr def)))
+                (setq form `(defun ,name ,@(cddddr def))))
+               ((and (eq (car def) 'LAMBDA-BLOCK-CLOSURE)
+                     (consp (cdr def)) (null (cadr def))
+                     (consp (cddr def)) (null (caddr def))
+                     (consp (cdddr def)) (null (cadddr def))
+                     (consp (cddddr def)))
+                (setq form `(defun ,name
+                              (block ,(car (cddddr def))
+                                ,@(cdr (cddddr def))))))
+               (t (error "I cannot compile such ~Ss, sorry." (car def)))))
+        (t (error "No lambda expression is assigned to the symbol ~s." name)))
+
+  (dotimes (n 1000
+              (progn
+                (format t "~&;;; The name space for GAZONK files exhausted.~%~
+;;; Delete one of your GAZONK*** files before compiling ~s." name)
+                (setq *error-p* t)
+                (return-from compile (values))))
+    (setq gazonk-name (format nil "gazonk~3,'0d" n))
+    (setq data-pathname (make-pathname :name gazonk-name :type "data"))
+    (unless (probe-file data-pathname)
+      (return)))
+
+  (let ((c-pathname (make-pathname :name gazonk-name :type "c"))
+        (h-pathname (make-pathname :name gazonk-name :type "h"))
+        (o-pathname (make-pathname :name gazonk-name :type "o")))
+
+    (init-env)
+
+    (with-open-file (*compiler-output-data* data-pathname
+					    :direction :output)
+      (wt-data-begin)
+
+      (t1expr form)
+
+      (when (zerop *error-count*)
+        (when *compile-verbose* (format t "~&;;; End of Pass 1.  "))
+        (compiler-pass2 c-pathname h-pathname data-pathname nil "code"))
+
+      (wt-data-end)
+      ) ;;; *compiler-output-data* closed.
+
+    (init-env)
+
+    (if (zerop *error-count*)
+        (progn
+          (when *compile-verbose*
+	    (format t "~&;;; Calling the C compiler... "))
+          (compiler-cc c-pathname o-pathname)
+          (delete-file c-pathname)
+          (delete-file h-pathname)
+          (cond ((probe-file o-pathname)
+                 ;(cat-data-file o-pathname data-pathname)
+                 (load o-pathname :verbose nil)
+                 (when *compile-verbose* (print-compiler-info))
+                 (delete-file o-pathname)
+                 (delete-file data-pathname))
+                (t (delete-file data-pathname)
+                   (format t "~&;;; The C compiler failed to compile~
+			~the intermediate code for ~s.~%" name)
+                   (setq *error-p* t)))
+	  (or name (symbol-value 'GAZONK)))
+
+        (progn
+	  (print c-pathname)
+          (when (probe-file c-pathname) (delete-file c-pathname))
+          (when (probe-file h-pathname) (delete-file h-pathname))
+          (when (probe-file data-pathname) (delete-file data-pathname))
+          (format t "~&;;; Failed to compile ~s.~%" name)
+          (setq *error-p* t)
+          name))))
+
+(defun disassemble (&optional (thing nil)
+			      &key (h-file nil) (data-file nil)
+			      &aux def disassembled-form
+			      (*compiler-in-use* *compiler-in-use*)
+			      (*print-pretty* nil))
+ (when *compiler-in-use*
+   (format t "~&;;; The compiler was called recursively.~
+                   ~%Cannot disassemble ~a." thing)
+   (setq *error-p* t)
+   (return-from disassemble))
+ (setq *error-p* nil
+       *compiler-in-use* t)
+
+ (cond ((null thing))
+       ((symbolp thing)
+	(setq def (symbol-function thing))
+	(when (macro-function thing)
+	  (setq def (cdr def)))
+	(if (and (consp def)
+		 (eq (car def) 'LAMBDA-BLOCK)
+		 (consp (cdr def)))
+	    (setq disassembled-form `(defun ,thing ,@(cddr def)))
+	    (error "The function object ~s cannot be disassembled." def)))
+       ((and (consp thing) (eq (car thing) 'LAMBDA))
+	(setq disassembled-form `(defun gazonk ,@(cdr thing))))
+       (t (setq disassembled-form thing)))
+
+  (let* ((null-stream (make-broadcast-stream))
+         (*compiler-output1* null-stream)
+         (*compiler-output2* (if h-file
+				 (open h-file :direction :output)
+				 null-stream))
+         (*compiler-output-data* (if data-file
+				     (open data-file :direction :output)
+				     null-stream))
+         (*error-count* 0)
+         (t3local-fun (symbol-function 'T3LOCAL-FUN))
+	 (t3fun (get 'DEFUN 'T3)))
+    (unwind-protect
+      (progn
+        (setf (get 'DEFUN 'T3)
+              #'(lambda (&rest args)
+                 (let ((*compiler-output1* *standard-output*))
+                   (apply t3fun args))))
+        (setf (symbol-function 'T3LOCAL-FUN)
+              #'(lambda (&rest args)
+                 (let ((*compiler-output1* *standard-output*))
+                   (apply t3local-fun args))))
+        (init-env)
+        (when data-file (wt-data-begin))
+        (t1expr disassembled-form)
+        (if (zerop *error-count*)
+          (catch *cmperr-tag* (ctop-write "code"
+					  (if h-file (namestring h-file) "")
+					  (if data-file (namestring data-file) "")))
+          (setq *error-p* t))
+	(when data-file (wt-data-end))
+        )
+      (setf (get 'DEFUN 'T3) t3fun)
+      (setf (symbol-function 'T3LOCAL-FUN) t3local-fun)
+      (when h-file (close *compiler-output2*))
+      (when data-file (close *compiler-output-data*))))
+  (values)
+  )
+
+(defun compiler-pass2 (c-pathname h-pathname data-pathname system-p init-name)
+  (with-open-file (*compiler-output1* c-pathname :direction :output)
+    (with-open-file (*compiler-output2* h-pathname :direction :output)
+      (wt-nl1 "#include " *cmpinclude*)
+      (catch *cmperr-tag* (ctop-write (string-upcase init-name)
+				      (namestring h-pathname)
+				      (namestring data-pathname)
+				      system-p))
+      (terpri *compiler-output1*)
+      ;; write ctl-z at end to make sure preprocessor stops!
+;      #+ms-dos (write-char (code-char 26) *compiler-output1*)
+      (terpri *compiler-output2*))))
+
+(defun compiler-cc (c-pathname o-pathname)
+  (safe-system
+   (format nil
+	   *cc-format*
+	   *cc* *cc-flags* (>= *speed* 2) *cc-optimize*
+	   (namestring sys::*system-directory*)
+	   (namestring c-pathname)
+	   (namestring o-pathname))
+; Since the SUN4 assembler loops with big files, you might want to use this:
+;   (format nil
+;	   "~A ~@[~*-O1~] -S -I. -I~A -w ~A ; as -o ~A ~A"
+;	   *cc* (>= *speed* 2)
+;          *include-directory*
+;	   (namestring c-pathname)
+;	   (namestring o-pathname)
+;	   (namestring s-pathname))
+   ))
+
+(defun cat-data-file (o-pathname data-pathname)
+  (with-open-file (o-file (namestring o-pathname)
+			  :direction :output
+			  :if-exists :append)
+    ;; cat data-file >> o-file
+    (with-open-file (data-file (namestring data-pathname))
+      (do ((buffer (make-string 256))
+	   (n 0))
+	  ((zerop (setq n (sys::read-bytes data-file buffer 0 256))))
+	(declare (fixnum n))
+	(sys::write-bytes o-file buffer 0 n)))))
+
+(defun print-compiler-info ()
+  (format t "~&;;; OPTIMIZE levels: Safety=~d~:[ (No runtime error checking)~;~], Space=~d, Speed=~d~%"
+          (cond ((null *compiler-check-args*) 0)
+                ((null *safe-compile*) 1)
+                ((null *compiler-push-events*) 2)
+                (t 3))
+          *safe-compile* *space* *speed*))
+
+;;; ----------------------------------------------------------------------
+(provide "compiler")
diff --git a/src/cmp/cmpmap.lsp b/src/cmp/cmpmap.lsp
new file mode 100644
index 000000000..37cf5c402
--- /dev/null
+++ b/src/cmp/cmpmap.lsp
@@ -0,0 +1,231 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPMAP  Map functions.
+
+(in-package "COMPILER")
+
+(defun c1map-functions (name car-p args &aux funob info)
+  (when (or (endp args) (endp (cdr args)))
+        (too-few-args 'map-function 2 (length args)))
+  (setq funob (c1funob (car args)))
+  (setq info (copy-info (cadr funob)))
+  (list name info funob car-p (c1args (cdr args) info))
+  )
+
+(defun c2mapcar (funob car-p args &aux (*inline-blocks* 0))
+  (let ((label (next-label*))
+        (value-loc (list 'TEMP (next-temp)))
+        (handy (list 'lcl (next-lcl)))
+        (handies (mapcar #'(lambda (x) (declare (ignore x))
+                                   (list 'lcl (next-lcl)))
+                         args))
+        (save (save-funob funob)))
+    (setq args (push-changed-vars (coerce-locs (inline-args args) nil)
+				  funob))
+       (wt-nl "{cl_object " handy ";")
+       (dolist (loc handies)
+         (wt-nl "cl_object " loc "= " (car args) ";")
+         (pop args))
+       (cond (*safe-compile*
+              (wt-nl "if(endp(" (car handies) ")")
+              (dolist (loc (cdr handies)) (wt "||endp(" loc ")"))
+              (wt "){"))
+             (t
+              (wt-nl "if(" (car handies) "==Cnil")
+              (dolist (loc (cdr handies)) (wt "||" loc "==Cnil"))
+              (wt "){")))
+       (unwind-exit nil 'jump)
+       (wt "}")
+       (wt-nl value-loc "=" handy "=CONS(Cnil,Cnil);")
+       (wt-label label)
+       (let* ((*destination* (list 'CAR (cadr handy)))
+              (*exit* (next-label))
+              (*unwind-exit* (cons *exit* *unwind-exit*)))
+	 (c2funcall funob
+		    (if car-p
+			(mapcar
+			 #'(lambda (loc)
+			     (list 'LOCATION *info* (list 'CAR (cadr loc))))
+			 handies)
+			(mapcar #'(lambda (loc) (list 'LOCATION *info* loc))
+				handies))
+		    save)
+	 (wt-label *exit*))
+       (cond (*safe-compile*
+              (wt-nl "if(endp(" (car handies) "=CDR(" (car handies) "))")
+              (dolist (loc (cdr handies))
+                        (wt "||endp(" loc "=CDR(" loc "))"))
+              (wt "){"))
+             (t
+              (wt-nl "if((" (car handies) "=CDR(" (car handies) "))==Cnil")
+              (dolist (loc (cdr handies))
+                        (wt "||(" loc "=CDR(" loc "))==Cnil"))
+              (wt "){")))
+       (unwind-exit value-loc 'jump)
+       (wt "}")
+       (wt-nl handy "=CDR(" handy ")=CONS(Cnil,Cnil);")
+       (wt-nl) (wt-go label)
+       (wt "}")
+       (close-inline-blocks)
+       )
+  )
+
+(defun c2mapc (funob car-p args &aux (*inline-blocks* 0))
+  (let ((label (next-label*))
+        value-loc
+        (handies (mapcar #'(lambda (x) (declare (ignore x))
+                                   (list 'LCL (next-lcl)))
+                         args))
+        (save (save-funob funob)))
+       (setq args (push-changed-vars (coerce-locs (inline-args args) nil)
+				     funob))
+       (wt-nl "{")
+       ;; preserve first argument:
+       (if (eq 'RETURN (car args))
+	   (progn
+	     (setq value-loc (list 'LCL (next-lcl)))
+	     (wt-nl "cl_object " value-loc "= " (car args) ";"))
+	   (setq value-loc (car args)))
+       (dolist (loc handies)
+                 (wt-nl "cl_object " loc "= " (car args) ";")
+                 (pop args))
+       (cond (*safe-compile*
+              (wt-nl "if(endp(" (car handies) ")")
+              (dolist (loc (cdr handies)) (wt "||endp(" loc ")"))
+              (wt "){"))
+             (t
+              (wt-nl "if(" (car handies) "==Cnil")
+              (dolist (loc (cdr handies)) (wt "||" loc "==Cnil"))
+              (wt "){")))
+       (unwind-exit nil 'JUMP)
+       (wt "}")
+       (wt-label label)
+       (let* ((*destination* 'TRASH)
+              (*exit* (next-label))
+              (*unwind-exit* (cons *exit* *unwind-exit*)))
+             (c2funcall funob
+               (if car-p
+                   (mapcar
+                    #'(lambda (loc)
+                              (list 'LOCATION *info* (list 'CAR (cadr loc))))
+                    handies)
+                   (mapcar #'(lambda (loc) (list 'LOCATION *info* loc))
+                           handies))
+               save)
+             (wt-label *exit*))
+       (cond (*safe-compile*
+              (wt-nl "if(endp(" (car handies) "=CDR(" (car handies) "))")
+              (dolist (loc (cdr handies))
+                        (wt "||endp(" loc "=CDR(" loc "))"))
+              (wt "){"))
+             (t
+              (wt-nl "if((" (car handies) "=CDR(" (car handies) "))==Cnil")
+              (dolist (loc (cdr handies))
+                        (wt "||(" loc "=CDR(" loc "))==Cnil"))
+              (wt "){")))
+       (unwind-exit value-loc 'JUMP)
+       (wt "}")
+       (wt-nl) (wt-go label)
+       (wt "}")
+       (close-inline-blocks)
+       )
+  )
+
+(defun c2mapcan (funob car-p args &aux (*inline-blocks* 0))
+  (let ((label (next-label*))
+        (value-loc (list 'TEMP (next-temp)))
+        (handy (list 'LCL (next-lcl)))
+        (handies (mapcar #'(lambda (x) (declare (ignore x))
+                                   (list 'LCL (next-lcl)))
+                         args))
+        (save (save-funob funob)))
+       (setq args (push-changed-vars (coerce-locs (inline-args args) nil)
+				     funob))
+       (wt-nl "{cl_object " handy ";")
+       (dolist (loc handies)
+                 (wt-nl "cl_object " loc "= " (car args) ";")
+                 (pop args))
+       (cond (*safe-compile*
+              (wt-nl "if(endp(" (car handies) ")")
+              (dolist (loc (cdr handies)) (wt "||endp(" loc ")"))
+              (wt "){"))
+             (t
+              (wt-nl "if(" (car handies) "==Cnil")
+              (dolist (loc (cdr handies)) (wt "||" loc "==Cnil"))
+              (wt "){")))
+       (unwind-exit nil 'jump)
+       (wt "}")
+       (wt-nl value-loc "=" handy "=CONS(Cnil,Cnil);")
+       (wt-label label)
+       (let* ((*destination* (list 'CDR (cadr handy)))
+              (*exit* (next-label))
+              (*unwind-exit* (cons *exit* *unwind-exit*))
+              )
+             (c2funcall funob
+               (if car-p
+                   (mapcar
+                    #'(lambda (loc)
+                              (list 'LOCATION *info* (list 'CAR (cadr loc))))
+                    handies)
+                   (mapcar #'(lambda (loc) (list 'LOCATION *info* loc))
+                           handies))
+               save)
+             (wt-label *exit*))
+       (cond
+        (*safe-compile*
+         (wt-nl "while(!endp(CDR(" handy ")))" handy "=CDR(" handy ");")
+         (wt-nl "if(endp(" (car handies) "=CDR(" (car handies) "))")
+         (dolist (loc (cdr handies)) (wt "||endp(" loc "=CDR(" loc "))"))
+         (wt "){"))
+        (t
+         (wt-nl "while(CDR(" handy ")!=Cnil)" handy "=CDR(" handy ");")
+         (wt-nl "if((" (car handies) "=CDR(" (car handies) "))==Cnil")
+         (dolist (loc (cdr handies))
+                   (wt "||(" loc "=CDR(" loc "))==Cnil"))
+         (wt "){")))
+       (wt-nl value-loc "=CDR(" value-loc ");")
+       (unwind-exit value-loc 'jump)
+       (wt "}")
+       (wt-nl) (wt-go label)
+       (wt "}")
+       (close-inline-blocks)
+       )
+  )
+
+
+(defun push-changed-vars (locs funob &aux (locs1 nil) (forms (list funob)))
+  (dolist (loc locs (nreverse locs1))
+    (if (and (consp loc)
+	     (eq (car loc) 'VAR)
+	     (var-changed-in-forms (cadr loc) forms))
+	(let ((temp (list 'TEMP (next-temp))))
+	  (wt-nl temp "= " loc ";")
+	  (push temp locs1))
+	(push loc locs1))))
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'mapcar 'c1) 'c1mapcar)
+(setf (get 'maplist 'c1) 'c1maplist)
+(setf (get 'mapcar 'c2) 'c2mapcar)
+(setf (get 'mapc 'c1) 'c1mapc)
+(setf (get 'mapl 'c1) 'c1mapl)
+(setf (get 'mapc 'c2) 'c2mapc)
+(setf (get 'mapcan 'c1) 'c1mapcan)
+(setf (get 'mapcon 'c1) 'c1mapcon)
+(setf (get 'mapcan 'c2) 'c2mapcan)
+
+(defun c1mapcar (args) (c1map-functions 'mapcar t args))
+(defun c1maplist (args) (c1map-functions 'mapcar nil args))
+(defun c1mapc (args) (c1map-functions 'mapc t args))
+(defun c1mapl (args) (c1map-functions 'mapc nil args))
+(defun c1mapcan (args) (c1map-functions 'mapcan t args))
+(defun c1mapcon (args) (c1map-functions 'mapcan nil args))
diff --git a/src/cmp/cmpmulti.lsp b/src/cmp/cmpmulti.lsp
new file mode 100644
index 000000000..8541f6261
--- /dev/null
+++ b/src/cmp/cmpmulti.lsp
@@ -0,0 +1,258 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPMULT  Multiple-value-call and Multiple-value-prog1.
+
+(in-package "COMPILER")
+
+(defun c1multiple-value-call (args &aux info funob)
+  (when (endp args) (too-few-args 'multiple-value-call 1 0))
+  (cond ((endp (rest args)) (c1funcall args))
+        (t (setq funob (c1funob (first args)))
+           (setq info (copy-info (second funob)))
+           (setq args (c1args (rest args) info))
+           (list 'MULTIPLE-VALUE-CALL info funob args)))
+  )
+
+(defun c2multiple-value-call (funob forms)
+  (let ((tot (list 'LCL (next-lcl)))
+	(nr (list 'LCL (next-lcl)))
+        (loc (save-funob funob)))
+    (wt-nl "{ int " tot ";")
+    (let ((*destination* 'VALUES))
+	(c2expr* (first forms)))
+    (wt-nl tot "=NValues;")
+    (dolist (form (rest forms))
+      (wt-nl "MV_SAVE(" nr ");")
+      (let ((*destination* 'VALUES))
+	(c2expr* form))
+      (wt-nl "MV_SHIFT(NValues," nr ");")
+      (wt-nl tot "+=NValues;")
+      (wt-nl "MV_RESTORE(" nr ");")
+      (wt-nl "NValues=" tot ";"))
+    (c2funcall funob 'ARGS-PUSHED loc tot)
+    (wt "}"))
+  )
+
+(defun c1multiple-value-prog1 (args &aux (info (make-info)) form)
+  (when (endp args) (too-few-args 'multiple-value-prog1 1 0))
+  (setq form (c1expr* (first args) info))
+  (setq args (c1args (rest args) info))
+  (list 'MULTIPLE-VALUE-PROG1 info form args)
+  )
+
+(defun c2multiple-value-prog1 (form forms)
+  (if (eq 'TRASH *destination*)
+      ;; dont bother saving values
+      (c2progn (cons form forms))
+      (progn
+	(let ((*destination* 'VALUES)) (c2expr* form))
+	(wt-nl "MV_SAVE(nr);")
+	(dolist (form forms)
+	  (let ((*destination* 'TRASH)) (c2expr* form)))
+	(wt-nl "MV_RESTORE(nr);")
+	(unwind-exit 'VALUES))))
+
+;;; Beppe:
+;;; this is the WRONG way to handle 1 value problem.
+;;; should be done in c2values, so that (values (truncate a b)) can
+;;; be used to restrict to one value, so we would not have to warn
+;;; if this occurred in a proclaimed fun.
+
+(defun c1values (args &aux (info (make-info)))
+  (if (and args (null (rest args)))
+    ;; unnecessary code is produced for expression (values nil)
+    (c1expr (first args))
+    (progn
+      (setq args (c1args args info))
+      (list 'VALUES info args))))
+
+(defun c2values (forms)
+  (when (and (eq *destination* 'RETURN-OBJECT)
+             (rest forms)
+             (consp *current-form*)
+             (eq 'DEFUN (first *current-form*)))
+    (cmpwarn "Trying to return multiple values. ~
+              ~%;But ~a was proclaimed to have single value.~
+              ~%;Only first one will be assured."
+             (second *current-form*)))
+  (let ((nv (length forms)))
+    (declare (fixnum nv))
+    (case nv
+      (0 (wt-nl "value0=Cnil;NValues=0;")
+	 (unwind-exit 'RETURN))
+      (1 (c2expr (first forms)))
+      (t (let ((*inline-blocks* 0))
+	   ;; 1) By inlining arguments we make sure that VL has no call to funct.
+	   ;; 2) Reverse args to avoid clobbering VALUES(0)
+	   (do ((vl (nreverse (inline-args forms)) (rest vl))
+		(i (1- (length forms)) (1- i)))
+	       ((null vl))
+	     (declare (fixnum i))
+	     (if (zerop i)
+	       (wt-nl "value0=")
+	       (wt-nl "VALUES(" i ")="))
+	     (wt (second (first vl)) ";"))
+	   (wt-nl "NValues=" nv ";")
+	   (unwind-exit 'RETURN)
+	   (close-inline-blocks))))))
+
+(defun c1multiple-value-setq (args &aux (info (make-info)) (vrefs nil)
+			      (vars nil) (temp-vars nil) (late-bindings nil))
+  (when (or (endp args) (endp (rest args)))
+        (too-few-args 'multiple-value-setq 2 0))
+  (unless (endp (cddr args))
+          (too-many-args 'multiple-value-setq 2 (length args)))
+  (dolist (var (reverse (first args)))
+          (cmpck (not (symbolp var)) "The variable ~s is not a symbol." var)
+	  (setq var (chk-symbol-macrolet var))
+	  (cond ((symbolp var)
+		 (cmpck (constantp var)
+			"The constant ~s is being assigned a value." var)
+		 (push var vars))
+		(t (let ((new-var (gensym)))
+		     (push new-var vars)
+		     (push new-var temp-vars)
+		     (push `(setf ,var ,new-var) late-bindings)))))
+  (if temp-vars
+    (c1expr `(let* (,@temp-vars)
+	      (multiple-value-setq ,vars ,@(second args))
+	      ,@late-bindings))
+    (dolist (var vars
+	     (list 'MULTIPLE-VALUE-SETQ info (nreverse vrefs)
+		   (c1expr* (second args) info)))
+      (setq var (c1vref var))
+      (push var vrefs)
+      (push (first var) (info-changed-vars info)))))
+
+(defun multiple-value-check (vrefs form)
+  (and (rest vrefs)
+       (eq (first form) 'CALL-GLOBAL)
+       (let ((fname (third form)))
+         (when (and (symbolp fname)
+                    (get fname 'PROCLAIMED-RETURN-TYPE))
+           (cmpwarn "~A was proclaimed to have only one return value. ~
+                     ~%;;; But you appear to want multiple values." fname)))))
+
+(defun c2multiple-value-setq (vrefs form)
+  (multiple-value-check vrefs form)
+  (let* ((*lcl* *lcl*)
+         (nr (list 'LCL (next-lcl))))
+    (let ((*destination* 'VALUES)) (c2expr* form))
+    (wt-nl "{int " nr "=NValues;")
+    (do ((vs vrefs (rest vs))
+         (i 0 (1+ i))
+         (vref))
+        ((endp vs))
+      (declare (fixnum i))
+      (setq vref (first vs))
+      (wt-nl "if (" nr ">0) {")
+      (set-var (list 'VALUE i) (first vref)) ; (second vref) ccb
+      (unless (endp (rest vs)) (wt-nl nr "--;"))
+      (wt-nl "} else {") (set-var nil (first vref)) ; (second vref) ccb
+      (wt "}"))
+    (unless (eq *exit* 'RETURN) (wt-nl))
+    (wt-nl "if (NValues>1) NValues=1;}")
+    (unwind-exit 'VALUES)))
+
+(defun c1multiple-value-bind (args &aux (info (make-info))
+                                   (vars nil) (vnames nil) init-form
+                                   ss is ts body other-decls
+                                   (*vars* *vars*))
+  (when (or (endp args) (endp (rest args)))
+    (too-few-args 'multiple-value-bind 2 (length args)))
+
+  (multiple-value-setq (body ss ts is other-decls) (c1body (cddr args) nil))
+
+  (c1add-globals ss)
+
+  (dolist (s (first args))
+    (push s vnames)
+    (push (c1make-var s ss is ts) vars))
+  (setq init-form (c1expr* (second args) info))
+  (dolist (v (setq vars (nreverse vars)))
+    (push-vars v))
+  (check-vdecl vnames ts is)
+  (setq body (c1decl-body other-decls body))
+  (add-info info (second body))
+  (setf (info-type info) (info-type (second body)))
+  (dolist (var vars) (check-vref var))
+  (list 'MULTIPLE-VALUE-BIND info vars init-form body)
+  )
+
+(defun c2multiple-value-bind (vars init-form body
+                                   &aux (labels nil)
+                                   (*unwind-exit* *unwind-exit*)
+                                   (*env* *env*) env-grows
+                                   (*lcl* *lcl*)
+                                   (nr (list 'LCL (next-lcl))))
+
+  (multiple-value-check vars init-form)
+  (wt-nl "{ int " nr ";")
+  (dolist (var vars)
+    (declare (type var var))
+    (let ((kind (local var)))
+      (if kind
+        (let ((lcl (next-lcl)))
+          (setf (var-loc var) lcl)
+          (wt-nl *volatile* (register var) (rep-type kind)) (wt-lcl lcl)
+          (wt ";")
+	  (wt-comment (var-name var)))
+	(unless env-grows (setq env-grows (var-ref-ccb var))))))
+
+  (let ((*destination* 'VALUES)) (c2expr* init-form))
+  (wt-nl nr "=NValues;")
+  (let ((*env-lvl* *env-lvl*))
+    (when (setq env-grows (env-grows env-grows))
+      (let ((env-lvl *env-lvl*))
+	(wt-nl "{ volatile cl_object env" (incf *env-lvl*)
+	       " = env" env-lvl ";")))
+    (let ((*unwind-exit* *unwind-exit*))
+      (do ((vs vars (rest vs))
+	   (i 0 (1+ i))
+	   (value '(VALUE 0)))
+	  ((endp vs))
+	(declare (fixnum i))
+	(push (next-label) labels)
+	(wt-nl "if (" nr "--<=0) ") (wt-go (first labels))
+	(setf (second value) i)
+	(bind value (first vs))))
+
+    (let ((label (next-label)))
+      (wt-nl) (wt-go label)
+
+      (setq labels (nreverse labels))
+
+      (let ((*suppress-compiler-warnings* t))
+	;; suppress the warning by default-init
+	(dolist (v vars)
+	  (wt-label (first labels))
+	  (pop labels)
+	  (bind (third (default-init (var-type v))) v)))
+
+      (wt-label label))
+
+    (c2expr body)
+    (when env-grows (wt "}")))
+  (wt "}")
+  )
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'multiple-value-call 'c1special) #'c1multiple-value-call)
+(setf (get 'multiple-value-call 'c2) #'c2multiple-value-call)
+(setf (get 'multiple-value-prog1 'c1special) #'c1multiple-value-prog1)
+(setf (get 'multiple-value-prog1 'c2) #'c2multiple-value-prog1)
+(setf (get 'values 'c1) #'c1values)
+(setf (get 'values 'c2) #'c2values)
+(setf (get 'multiple-value-setq 'c1) #'c1multiple-value-setq)
+(setf (get 'multiple-value-setq 'c2) #'c2multiple-value-setq)
+(setf (get 'multiple-value-bind 'c1) #'c1multiple-value-bind)
+(setf (get 'multiple-value-bind 'c2) #'c2multiple-value-bind)
diff --git a/src/cmp/cmpspecial.lsp b/src/cmp/cmpspecial.lsp
new file mode 100644
index 000000000..47c70e97c
--- /dev/null
+++ b/src/cmp/cmpspecial.lsp
@@ -0,0 +1,190 @@
+;;;;  CMPSPECIAL  Miscellaneous special forms.
+
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+
+(in-package "COMPILER")
+
+(defun c1quote (args)
+  (when (endp args) (too-few-args 'QUOTE 1 0))
+  (unless (endp (cdr args)) (too-many-args 'QUOTE 1 (length args)))
+  (c1constant-value (car args) t))
+
+(defun c1eval-when (args)
+  (when (endp args) (too-few-args 'EVAL-WHEN 1 0))
+  (dolist (situation (car args) (c1nil))
+    (case situation
+      ((EVAL :EXECUTE) (return-from c1eval-when (c1progn (cdr args))))
+      ((LOAD COMPILE :LOAD-TOPLEVEL :COMPILE-TOPLEVEL))
+      (otherwise
+       (cmperr "The situation ~s is illegal." situation)))))
+
+(defun c1declare (args)
+  (cmperr "The declaration ~s was found in a bad place." (cons 'DECLARE args)))
+
+(defun c1the (args &aux info form type)
+  (when (or (endp args) (endp (cdr args)))
+        (too-few-args 'THE 2 (length args)))
+  (unless (endp (cddr args))
+          (too-many-args 'THE 2 (length args)))
+  (setq form (c1expr (second args)))
+  (setq info (copy-info (second form)))
+  (setq type (type-and (type-filter (car args)) (info-type info)))
+  (unless type
+    (cmpwarn "Type mismatch was found in ~s." (cons 'THE args))
+    (setq type T))
+  (setf (info-type info) type)
+  (setf (second form) info)
+  form)
+
+(defun c1compiler-let (args &aux (symbols nil) (values nil))
+  (when (endp args) (too-few-args 'COMPILER-LET 1 0))
+  (dolist (spec (car args))
+    (cond ((consp spec)
+           (cmpck (not (and (symbolp (car spec))
+                            (or (endp (cdr spec))
+                                (endp (cddr spec)))))
+                  "The variable binding ~s is illegal." spec)
+           (push (car spec) symbols)
+           (push (if (endp (cdr spec)) nil (eval (second spec))) values))
+          ((symbolp spec)
+           (push spec symbols)
+           (push nil values))
+          (t (cmperr "The variable binding ~s is illegal." spec))))
+  (setq symbols (nreverse symbols))
+  (setq values (nreverse values))
+  (setq args (progv symbols values (c1progn (cdr args))))
+  (list 'COMPILER-LET (second args) symbols values args))
+
+(defun c2compiler-let (symbols values body)
+  (progv symbols values (c2expr body)))
+
+(defun c1function (args &aux fd)
+  (when (endp args) (too-few-args 'function 1 0))
+  (unless (endp (cdr args)) (too-many-args 'function 1 (length args)))
+  (let ((fun (car args))
+	(*vars* (cons 'CB *vars*))
+	(*funs* (cons 'CB *funs*))
+	(*blocks* (cons 'CB *blocks*))
+	(*tags* (cons 'CB *tags*)))
+    (setq fun (or (si:setf-namep fun) fun))
+    (cond ((symbolp fun)
+	   (let ((funob (local-closure fun)))
+	     (if funob
+		 (let ((vars (list (fun-var funob))))
+		   (incf (var-ref (fun-var funob)))
+		   (list 'VAR (make-info :referred-vars vars
+					 :local-referred vars)
+			 vars))
+		 `(FUNCTION ,(make-info :sp-change
+					(not (get fun 'NO-SP-CHANGE)))
+		   GLOBAL nil ,fun))))
+          ((and (consp fun) (eq (car fun) 'LAMBDA))
+           (cmpck (endp (cdr fun))
+                  "The lambda expression ~s is illegal." fun)
+           (let* ((funob (c1lambda-expr (cdr fun)))
+		  (info (second funob))
+		  (closure (closure-p funob))
+		  (body (cddr fun))
+		  (fun (make-fun :name
+				 (when (and (consp body)
+					    (null (cdr body))
+					    (consp (first body))
+					    (eq 'BLOCK (first (first body))))
+				   (list (second (first body))))
+				 :cfun (next-cfun)
+				 :closure closure)))
+	     (if closure
+		 `(FUNCTION ,info CLOSURE ,funob ,fun)
+		 (progn
+		   (push `(FUNCTION-CONSTANT ,funob ,fun)
+			 *top-level-forms*)
+		   `(FUNCTION ,info CONSTANT ,funob ,fun)))))
+	  ((and (consp fun) (eq (car fun) 'LAMBDA-BLOCK))
+           (cmpck (endp (cdr fun))
+                  "The lambda expression ~s is illegal." fun)
+           (let* ((name (second fun))
+		  (funob (c1lambda-expr (cddr fun)))
+		  (info (second funob))
+		  (closure (closure-p funob))
+		  (body (cdddr fun))
+		  (fun (make-fun :name name
+				 :cfun (next-cfun)
+				 :closure closure)))
+	     (if closure
+		 `(FUNCTION ,info CLOSURE ,funob ,fun)
+		 (progn
+		   (push `(FUNCTION-CONSTANT ,funob ,fun)
+			 *top-level-forms*)
+		   `(FUNCTION ,info CONSTANT ,funob ,fun)))))
+	  (t (cmperr "The function ~s is illegal." fun)))))
+
+(defun c2function (kind funob fun)
+  (case kind
+    (GLOBAL
+     (unwind-exit (list 'SYMBOL-FUNCTION (add-symbol fun))))
+    (CLOSURE
+     (setf (fun-closure fun) (> *env* 0))
+     (new-local 0 fun funob)	; 0 was *level*
+     (unwind-exit `(MAKE-CCLOSURE ,fun)))
+    (CONSTANT
+     (unwind-exit (fun-var fun)))))
+
+;;; Mechanism for sharing code.
+(defun new-local (level fun funob)
+  ;; returns the previous function or NIL.
+  (declare (type fun fun))
+  (let ((previous (dolist (local *local-funs*)
+		    (when (and (= *env* (fun-env (second local)))
+			       ;; closures must be embedded in env of
+			       ;; same size
+			       (similar funob (third local)))
+		      (return (second local)))))
+        (closure (when (fun-closure fun) 'CLOSURE)))
+    (if previous
+	(progn
+          (if closure
+	      (cmpnote "Sharing code for closure")
+	      (cmpnote "Sharing code for local function ~A" (fun-name fun)))
+	  (setf (fun-cfun fun) (fun-cfun previous))
+	  previous)
+        (progn
+          (setf (fun-level fun) (if (fun-ref-ccb fun) 0 level)
+                (fun-env fun) *env*)
+          (push (list closure fun funob) *local-funs*)
+	  NIL))))
+
+(defun wt-symbol-function (vv)
+  (if *safe-compile*
+      (wt "symbol_function(VV[" vv "])")
+      (wt "(VV[" vv "]->symbol.gfdef)")))
+
+(defun wt-make-closure (fun &aux (cfun (fun-cfun fun)))
+  (declare (type fun fun))
+  (if (fun-closure fun)
+      (wt "make_cclosure(LC" cfun ",env" *env-lvl*)
+      (wt "make_cfun(LC" cfun ",Cnil")) ; empty environment
+  (wt ",Cblock)"))
+
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'quote 'c1special) 'c1quote)
+(setf (get 'function 'c1special) 'c1function)
+(setf (get 'function 'c2) 'c2function)
+(setf (get 'the 'c1special) 'c1the)
+(setf (get 'eval-when 'c1special) 'c1eval-when)
+(setf (get 'declare 'c1special) 'c1declare)
+(setf (get 'compiler-let 'c1special) 'c1compiler-let)
+(setf (get 'compiler-let 'c2) 'c2compiler-let)
+
+(setf (get 'symbol-function 'wt-loc) 'wt-symbol-function)
+(setf (get 'make-cclosure 'wt-loc) 'wt-make-closure)
diff --git a/src/cmp/cmptag.lsp b/src/cmp/cmptag.lsp
new file mode 100644
index 000000000..0c1547725
--- /dev/null
+++ b/src/cmp/cmptag.lsp
@@ -0,0 +1,229 @@
+;;;;  CMPTAG  --  Tagbody and Go.
+
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    ECoLisp is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+
+(in-package "COMPILER")
+
+#|
+;;; Use a structure of type vector to avoid creating
+;;; normal structures before booting CLOS:
+(defstruct (tag (:type vector) :named)
+   name			;;; Tag name.
+   (ref 0 :type fixnum)	;;; Number of references.
+   ref-ccb		;;; Cross closure reference.
+			;;; During Pass1, T or NIL.
+   ref-clb		;;; Cross local function reference.
+       			;;; During Pass1, T or NIL.
+   label		;;; Where to jump.  A label.
+   unwind-exit		;;; Where to unwind-no-exit.
+   var			;;; Variable containing frame ID.
+) |#
+
+;;; During Pass 1, *tags* holds a list of tag objects and the symbols 'CB'
+;;; (Closure Boundary), 'LB' (Level Boundary) or 'UNWIND-PROTECT'.
+;;; 'CB' will be pushed on *tags* when the compiler begins to process
+;;;  a closure.
+;;; 'LB' will be pushed on *tags* when *level* is incremented.
+;;; 'UNWIND-PROTECT' is pushed when entering an unwind-protect.
+;;;  A dummy variable is created to hold the tag identifier and one tag
+;;;  structure (containing reference to such variable) is created for each
+;;;  label in the body.
+;;;  When a reference to a tag (go instruction) is found, the
+;;;  var-kind is stepped from NIL to OBJECT (if appearing inside an
+;;;  unwind-protect) to LEXICAL (if appearing across a boundary: with
+;;;  var-ref-ccb set to T in case of closure boundary).
+;;;  The tag-ref is also incremented.
+;;;  Therefore var-ref represents whether some tag is used at all and var-kind
+;;;  variable represents whether a tag identifier must be created and the
+;;;  kind of the dummy variable to store it.
+
+
+(defvar *reg-amount* 60)
+;;; amount to increase var-ref for each variable reference inside a loop
+
+(defun add-loop-registers (tagbody)
+  ;; Find a maximal iteration interval in TAGBODY from first to end
+  ;; then increment the var-ref slot.
+  (labels ((add-reg1 (form)
+	     ;; increase the var-ref in FORM for all vars
+	     (if (consp form)
+		 (dolist (v form)
+		   (add-reg1 v))
+		 (when (var-p form)
+		   (incf (var-ref form) (the fixnum *reg-amount*)))))
+	   (jumps-to-p (clause tag-name)
+	     ;; Does CLAUSE have a go TAG-NAME in it?
+	     (cond ((atom clause) nil)
+		   ((eq (car clause) 'GO)
+		    (eq (tag-name (third clause)) tag-name))
+		   (t (or (jumps-to-p (car clause) tag-name)
+			  (jumps-to-p (cdr clause) tag-name))))))
+    (do ((v tagbody (cdr v))
+	 (end nil)
+	 (first nil))
+	((null v)
+	 (do ((ww first (cdr ww)))
+	     ((eq ww end) (add-reg1 (car ww)))
+	   (add-reg1 (car ww))))
+      (when (tag-p (car v))
+	(unless first (setq first v))
+	(do ((w (cdr v) (cdr w))
+	     (name (tag-name (car v))))
+	    ((null w))
+	  (when (jumps-to-p (car w) name)
+	    (setq end w)))))))
+
+(defun c1tagbody (body &aux (*tags* *tags*) (info (make-info))
+                       (tag-var (make-var :name 'TAGBODY :kind NIL)))
+  ;;; Establish tags.
+  (setq body
+        (mapcar
+         #'(lambda (x)
+             (if (not (consp x))
+               (let ((tag (make-tag :name x :var tag-var)))
+                 (push tag *tags*)
+                 tag)
+               x))
+         body))
+
+  ;;; Process non-tag forms.
+  (setq body (mapcar #'(lambda (x) (if (tag-p x) x (c1expr* x info)))
+                     body))
+
+  ;;; Delete redundant tags.
+  (let ((body1 nil) (ref nil))
+    (dolist (form body)
+      (if (tag-p form)
+	  (when (plusp (tag-ref form))
+	    (push form body1))
+	  (push form body1)))
+    (if (plusp (var-ref tag-var))
+	(progn (setq body1 (nreverse body1))
+	       (when (var-ref-ccb tag-var)
+		 (incf *setjmps*))
+	       (add-loop-registers body1)
+	       (list 'TAGBODY info tag-var body1))
+	(list 'PROGN info (nreverse (cons (c1nil) body1))))))
+
+(defun c2tagbody (tag-loc body)
+  (declare (type variable tag-loc))
+  (if (null (var-kind tag-loc))
+      ;; only local goto's
+      (let ((label (next-label)))
+	;; Allocate labels.
+	(dolist (x body)
+	  (when (and (tag-p x) (plusp (tag-ref x)))
+	    (setf (tag-label x) (next-label*))
+	    (setf (tag-unwind-exit x) label)))
+	(let ((*unwind-exit* (cons label *unwind-exit*)))
+	  (c2tagbody-body body)))
+      ;; some tag used non locally or inside an unwind-protect
+      (let ((*unwind-exit* (cons 'FRAME *unwind-exit*))
+	    (label (next-label))
+	    (*env* *env*) (*env-lvl* *env-lvl*)
+	    (*lex* *lex*) (*lcl* *lcl*)
+	    (env-grows (env-grows (var-ref-ccb tag-loc))))
+	(when env-grows
+	  (let ((env-lvl *env-lvl*))
+	    (wt-nl "{ volatile cl_object env" (incf *env-lvl*)
+		   " = env" env-lvl ";")))
+	(when (eq 'OBJECT (var-kind tag-loc))
+	  (setf (var-loc tag-loc) (next-lcl))
+	  (wt-nl "{ cl_object ") (wt-var tag-loc) (wt ";")
+	  (setq env-grows t))		; just to ensure closing the block
+	(bind "new_frame_id()" tag-loc)
+	(wt-nl "if (frs_push(FRS_CATCH,") (wt-var tag-loc) (wt ")) {")
+	;; Allocate labels.
+	(dolist (tag body)
+	  (when (and (tag-p tag) (plusp (tag-ref tag)))
+	    (setf (tag-label tag) (next-label))
+	    (setf (tag-unwind-exit tag) label)
+	    (wt-nl "if (eql(nlj_tag,VV[" (add-symbol (tag-name tag)) "])) ")
+	    (wt-go (tag-label tag))))
+	(when (var-ref-ccb tag-loc)
+	  (wt-nl "FEerror(\"The GO tag ~s is not established.\",1,nlj_tag);"))
+	(wt-nl "}")
+	(let ((*unwind-exit* (cons label *unwind-exit*)))
+	  (c2tagbody-body body))
+	(when env-grows (wt "}"))))
+  )
+
+(defun c2tagbody-body (body)
+  (do ((l body (cdr l)) (written nil))
+      ((endp (cdr l))
+       (cond (written (unwind-exit nil))
+             ((tag-p (car l))
+              (wt-label (tag-label (car l)))
+              (unwind-exit nil))
+             (t (let* ((*exit* (next-label))
+                       (*unwind-exit* (cons *exit* *unwind-exit*))
+                       (*destination* 'TRASH))
+                  (c2expr (car l))
+                  (wt-label *exit*))
+                (unless (eq (caar l) 'GO) (unwind-exit nil)))))
+    (cond (written (setq written nil))
+          ((tag-p (car l)) (wt-label (tag-label (car l))))
+          (t (let* ((*exit* (if (tag-p (second l))
+                                (progn (setq written t) (tag-label (second l)))
+                                (next-label)))
+                    (*unwind-exit* (cons *exit* *unwind-exit*))
+                    (*destination* 'TRASH))
+               (c2expr (car l))
+               (wt-label *exit*))))))
+
+(defun c1go (args)
+  (cond ((endp args) (too-few-args 'GO 1 0))
+        ((not (endp (cdr args))) (too-many-args 'GO 1 (length args)))
+        ((not (or (symbolp (car args)) (integerp (car args))))
+         "The tag name ~s is not a symbol nor an integer." (car args)))
+  (do ((tags *tags* (cdr tags))
+       (name (car args))
+       (info (make-info))
+       (ccb) (clb) (unw) (tag) (var))
+      ((endp tags) (cmperr "The tag ~s is undefined." name))
+    (declare (type var var))
+    (setq tag (car tags))
+    (case tag
+      (CB (setq ccb t))
+      (LB (setq clb t))
+      (UNWIND-PROTECT (setq unw T))
+      (T (when (eq (tag-name tag) name)
+	   (setq var (tag-var tag))
+	   (cond (ccb (setf (tag-ref-ccb tag) t
+			    (var-ref-ccb var) T
+			    (var-kind var) 'LEXICAL))
+		 (clb (setf (tag-ref-clb tag) t
+			    (var-kind var) 'LEXICAL))
+		 (unw (unless (var-kind var)
+			(setf (var-kind var) 'OBJECT))))
+	   (incf (var-ref var))
+	   (incf (tag-ref tag))
+	   (push var (info-local-referred info)) ; no pushnew
+	   (pushnew var (info-referred-vars info))
+;          (push tag (info-referred-tags info))
+	   (return (list 'GO info tag (or ccb clb unw))))))))
+
+(defun c2go (tag nonlocal &aux (var (tag-var tag)))
+  (if nonlocal
+      (wt-nl "go(" var ",VV[" (add-symbol (tag-name tag)) "]);")
+      ;; local go
+      (progn
+	(unwind-no-exit (tag-unwind-exit tag))
+	(wt-nl) (wt-go (tag-label tag)))))
+
+;;; ------------------------------------------------------------
+
+(setf (get 'tagbody 'c1special) 'c1tagbody)
+(setf (get 'tagbody 'c2) 'c2tagbody)
+
+(setf (get 'go 'c1special) 'c1go)
+(setf (get 'go 'c2) 'c2go)
diff --git a/src/cmp/cmptest.lsp b/src/cmp/cmptest.lsp
new file mode 100644
index 000000000..a063ce8f5
--- /dev/null
+++ b/src/cmp/cmptest.lsp
@@ -0,0 +1,257 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPTEST  Functions for compiler test.
+
+(in-package "COMPILER")
+
+(defun self-compile ()
+ (with-open-file (log "lsplog" :direction :output)
+  (let ((*standard-output* (make-broadcast-stream *standard-output* log)))
+
+;       (self-compile2 "cmpbind")
+;       (self-compile2 "cmpblock")
+;       (self-compile2 "cmpcall")
+;       (self-compile2 "cmpcatch")
+       (self-compile2 "cmpenv")
+;       (self-compile2 "cmpeval")
+;       (self-compile2 "cmpflet")
+;       (self-compile2 "cmpfun")
+;       (self-compile2 "cmpif")
+;       (self-compile2 "cmpinline")
+       (self-compile2 "cmplabel")
+;       (self-compile2 "cmplam")
+;       (self-compile2 "cmplet")
+;       (self-compile2 "cmploc")
+;       (self-compile2 "cmpmap")
+;       (self-compile2 "cmpmulti")
+;       (self-compile2 "cmpspecial")
+;       (self-compile2 "cmptag")
+;       (self-compile2 "cmptop")
+;       (self-compile2 "cmptype")
+       (self-compile2 "cmputil")
+;       (self-compile2 "cmpvar")
+;       (self-compile2 "cmpvs")
+;       (self-compile2 "cmpwt")
+
+       ))
+ t)
+
+(defun setup ()
+
+;  (allocate 'cons 800)
+;  (allocate 'string 256)
+;  (allocate 'structure 32)
+;  (allocate-relocatable-pages 128)
+
+;  (load "cmpinline.lsp")
+  (load "cmputil.lsp")
+;  (load "cmptype.lsp")
+
+;  (load "cmpbind.lsp")
+;  (load "cmpblock.lsp")
+  (load "cmpcall.lsp")
+;  (load "cmpcatch.lsp")
+;  (load "cmpenv.lsp")
+;  (load "cmpeval.lsp")
+  (load "cmpflet.lsp")
+;  (load "cmpfun.lsp")
+;  (load "cmpif.lsp")
+  (load "cmplabel.lsp")
+;  (load "cmplam.lsp")
+;  (load "cmplet.lsp")
+  (load "cmploc.lsp")
+;  (load "cmpmain.lsp")
+;  (load "cmpmap.lsp")
+;  (load "cmpmulti.lsp")
+;  (load "cmpspecial.lsp")
+;  (load "cmptag.lsp")
+  (load "cmptop.lsp")
+;  (load "cmpvar.lsp")
+;  (load "cmpvs.lsp")
+;  (load "cmpwt.lsp")
+
+;  (load "lfun_list")
+;  (load "cmpopt.lsp")
+
+  )
+
+(defun cli () (process ":cli.pr"))
+
+(defun load-fasl ()
+
+  (load "cmpinline")
+  (load "cmputil")
+  (load "cmpbind")
+  (load "cmpblock")
+  (load "cmpcall")
+  (load "cmpcatch")
+  (load "cmpenv")
+  (load "cmpeval")
+  (load "cmpflet")
+  (load "cmpfun")
+  (load "cmpif")
+  (load "cmplabel")
+  (load "cmplam")
+  (load "cmplet")
+  (load "cmploc")
+  (load "cmpmap")
+  (load "cmpmulti")
+  (load "cmpspecial")
+  (load "cmptag")
+  (load "cmptop")
+  (load "cmptype")
+  (load "cmpvar")
+  (load "cmpvs")
+  (load "cmpwt")
+
+  (load "cmpmain.lsp")
+  (load "lfun_list.lsp")
+  (load "cmpopt.lsp")
+
+  )
+
+(setq *macroexpand-hook* 'funcall)
+
+(defun self-compile1 (file)
+  (prin1 file) (terpri)
+  (compile-file1 file
+    :fasl-file t :c-file t :h-file t :data-file t :ob-file t :system-p t))
+
+(defun self-compile2 (file)
+  (prin1 file) (terpri)
+  (compile-file1 file
+    :fasl-file t :c-file t :h-file t :data-file t :ob-file t :system-p t)
+  (prin1 (load file)) (terpri))
+
+(defvar *previous-form* nil)
+
+(defun cmp (form)
+  (setq *previous-form* form)
+  (again))
+
+(defun again ()
+  (init-env)
+  (print *previous-form*)
+  (terpri)
+  (setq *compiler-output1* *standard-output*)
+  (setq *compiler-output2* *standard-output*)
+  (setq *compiler-output-data* *standard-output*)
+  (let ((prev (get-dispatch-macro-character #\# #\,)))
+       (set-dispatch-macro-character #\# #\,
+                                     'sys:sharp-comma-reader-for-compiler)
+       (unwind-protect
+        (t1expr *previous-form*)
+        (set-dispatch-macro-character #\# #\, prev)))
+  (catch *cmperr-tag* (ctop-write "test"))
+  t)
+
+;(defun make-cmpmain-for-unix ()
+;       (print "unixmain")
+;       (format t "~&The old value of *FEATURES* is ~s." *features*)
+;       (let ((*features* '(:unix :common :ecl)))
+;            (format t "~&The new value of *FEATURES* is ~s." *features*)
+;            (init-env)
+;            (compile-file1 "cmpmain.lsp"
+;                           :output-file "unixmain"
+;                           :c-file t
+;                           :h-file t
+;                           :data-file t
+;                           :system-p t
+;                           ))
+;       (format t "~&The resumed value of *FEATURES* is ~s." *features*)
+;       )
+
+(defun compiler-make-ufun ()
+  (make-ufun '(
+  "cmpbind.lsp"
+  "cmpblock.lsp"
+  "cmpcall.lsp"
+  "cmpcatch.lsp"
+  "cmpenv.lsp"
+  "cmpeval.lsp"
+  "cmpflet.lsp"
+  "cmpfun.lsp"
+  "cmpif.lsp"
+  "cmpinline.lsp"
+  "cmplabel.lsp"
+  "cmplam.lsp"
+  "cmplet.lsp"
+  "cmploc.lsp"
+  "cmpmain.lsp"
+  "cmpmap.lsp"
+  "cmpmulti.lsp"
+  "cmpspecial.lsp"
+  "cmptag.lsp"
+  "cmptop.lsp"
+  "cmptype.lsp"
+  "cmputil.lsp"
+  "cmpvar.lsp"
+  "cmpvs.lsp"
+  "cmpwt.lsp"
+
+  ))
+
+  t)
+
+(defun remrem ()
+       (do-symbols (x (find-package 'lisp))
+                   (remprop x ':inline-always)
+                   (remprop x ':inline-safe)
+                   (remprop x ':inline-unsafe))
+       (do-symbols (x (find-package 'system))
+                   (remprop x ':inline-always)
+                   (remprop x ':inline-safe)
+                   (remprop x ':inline-unsafe)))
+(defun ckck ()
+       (do-symbols (x (find-package 'lisp))
+                   (when (or (get x ':inline-always)
+                             (get x ':inline-safe)
+                             (get x ':inline-unsafe))
+                         (print x)))
+       (do-symbols (x (find-package 'si))
+                   (when (or (get x ':inline-always)
+                             (get x ':inline-safe)
+                             (get x ':inline-unsafe))
+                         (print x))))
+
+(defun make-cmpopt (&aux (eof (cons nil nil)))
+  (with-open-file (in "cmpopt.db")
+    (with-open-file (out "cmpopt.lsp" :direction :output)
+      (print '(in-package "COMPILER") out)
+      (terpri out) (terpri out)
+      (do ((x (read in nil eof) (read in nil eof)))
+          ((eq x eof))
+          (apply #'(lambda (property return-type side-effectp new-object-p
+                                     name arg-types body)
+                     (when (stringp body)
+                       (do ((i 0 (1+ i))
+                            (l nil)
+                            (l1 nil))
+                           ((>= i (length body))
+                            (when l1
+                              (setq body
+                                    (concatenate 'string
+                                                 "@"
+                                                 (nreverse l1)
+                                                 ";"
+                                                 body))))
+                         (when (char= (aref body i) #\#)
+                           (incf i)
+                           (cond ((member (aref body i) l)
+                                  (pushnew (aref body i) l1))
+                                 (t (push (aref body i) l))))))
+                     (print
+                      `(push '(,arg-types ,return-type ,side-effectp
+                                          ,new-object-p ,body)
+                             (get ',name ',property))
+                      out))
+                 (cdr x)))
+      (terpri out))))
diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp
new file mode 100644
index 000000000..485ca6714
--- /dev/null
+++ b/src/cmp/cmptop.lsp
@@ -0,0 +1,1255 @@
+;;;;  CMPTOP  --  Compiler top-level.
+
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "COMPILER")
+
+(defun t1expr (form &aux (*current-form* form) (*first-error* t)
+                    *funarg-vars*
+		    (*setjmps* 0))
+  (catch *cmperr-tag*
+    (when (consp form)
+      (let ((fun (car form)) (args (cdr form)) fd setf-symbol) ; #+cltl2
+	(cond
+            ((symbolp fun)
+             (cond ((eq fun 'sys:|#,|)
+                    (cmperr "Sharp-comma-macro is in a bad place."))
+                   ((get fun 'PACKAGE-OPERATION)
+                    (when *non-package-operation*
+                      (cmpwarn "The package operation ~s was in a bad place."
+                               form))
+			  (cmp-eval form)
+                    (wt-data-package-operation form))
+                   ((setq fd (get fun 'T1))
+                    (when *compile-print* (print-current-form))
+                    (funcall fd args))
+                   ((get fun 'TOP-LEVEL-MACRO)
+                    (when *compile-print* (print-current-form))
+		    (let ((*compile-time-too* t))
+		      (t1expr (cmp-macroexpand-1 form))))
+                   ((get fun 'C1) (t1ordinary form))
+                   ((setq fd (macro-function fun))
+                    (t1expr (cmp-expand-macro fd fun (cdr form))))
+                   (t (t1ordinary form))
+                   ))
+	    ;; #+cltl2
+            ((setq setf-symbol (si::setf-namep fun))
+	     (t1ordinary form))
+            ((consp fun) (t1ordinary form))
+            (t (cmperr "~s is illegal function." fun)))
+           )))
+  )
+
+(defun ctop-write (name h-namestring data-namestring
+		        &optional system-p
+			&aux (vv-reservation (next-cmacro)) def
+		   	top-output-string
+			(*volatile* " volatile "))
+
+  (setq *top-level-forms* (nreverse *top-level-forms*))
+
+  (wt-nl1 "#include \"" h-namestring "\"")
+  ;;; Initialization function.
+  (let* ((*lcl* 0) (*lex* 0) (*max-lex* 0) (*max-env* 0) (*max-temp* 0)
+	 (*unboxed* nil)
+	 (*reservation-cmacro* (next-cmacro))
+	 (c-output-file *compiler-output1*)
+	 (*compiler-output1* (make-string-output-stream))
+	 (local-funs)
+	 #+PDE (optimize-space (>= *space* 3)))
+    (wt-nl1 "static const char *compiler_data_text;")
+    (wt-nl1 "void")
+    (wt-nl1 "init_" name "(cl_object flag)")
+    (wt-nl1 "{ VT" *reservation-cmacro* " CLSR" *reservation-cmacro*)
+    (wt-nl "cl_object value0;")
+    (wt-nl "if (!FIXNUMP(flag)){")
+    (wt-nl "Cblock=flag;")
+    (wt-nl "flag->cblock.data = VV;")
+    (wt-nl "flag->cblock.data_size = VM;")
+    (wt-nl "flag->cblock.data_text = compiler_data_text;")
+    (wt-nl "flag->cblock.data_text_size = compiler_data_text_size;")
+    (wt-nl "return;}")
+    (flet ((emit-local-funs ()
+	   ;; Local functions and closure functions
+	   (do ()
+	       ;; repeat until t3local-fun generates no more
+	       ((eq local-funs *local-funs*))
+	     ;; scan *local-funs* backwards
+	     (do ((lfs *local-funs* (cdr lfs)))
+		 ((eq (cdr lfs) local-funs)
+		  (setq local-funs lfs)
+		  (when *compile-print*
+		    (print-emitting (fun-name (cadar lfs))))
+		  (locally (declare (notinline t3local-fun))
+		    ;; so disassemble can redefine it
+		    (apply 't3local-fun (car lfs))))))))
+      ;; useless in initialization.
+      (dolist (form *top-level-forms*)
+	(let ((*compile-to-linking-call* nil)
+	      (*env* 0) (*level* 0) (*temp* 0))
+	  (when (setq def (get (car form) 'T2))
+	    (apply def (cdr form))))
+	(let ((*compiler-output1* c-output-file))
+	  (emit-local-funs)
+	  (setq *funarg-vars* nil)
+	  (when (setq def (get (car form) 'T3))
+	    ;; new local functions get pushed into *local-funs*
+	    (when (and *compile-print*
+		       (member (car form)
+			       '(DEFUN DEFMACRO DEFCBODY) ; DEFENTRY DEFUNC
+			       :test #'eq))
+	      (print-emitting (second form)))
+	    (apply def (cdr form)))
+	  (emit-local-funs)
+	  (setq *funarg-vars* nil))))
+    (wt-function-epilogue)
+    (wt-nl1 "}")
+    (setq top-output-string (get-output-stream-string *compiler-output1*)))
+
+  ;; Declarations in h-file.
+  (wt-h "static cl_object Cblock;")
+  (dolist (x *reservations*)
+    (wt-h "#define VM" (car x) " " (cdr x)))
+  (incf *next-vv*)
+  (wt-h "#define VM" vv-reservation " " *next-vv*)
+  (cond ((zerop *next-vv*)
+	 (wt-h "static cl_object VV[1];")
+	 (wt-h "#define VM 0"))
+	(t
+	 (wt-h "#define VM " *next-vv*)
+	 (wt-h "static cl_object VV[VM];")))
+  (when *linking-calls*
+    (dotimes (i (length *linking-calls*))
+      (declare (fixnum i))
+      (wt-h "static cl_object LKF" i "(int, ...);")
+      (wt-h "static cl_object (*LK" i ")(int, ...)=LKF" i ";"))
+    )
+  ;;; Global entries for directly called functions.
+  (dolist (x *global-entries*)
+    (apply 'wt-global-entry x))
+  
+  ;;; Initial functions for linking calls.
+  (dolist (x *linking-calls*)
+    (let ((i (second x)))
+      (wt-nl1 "static cl_object LKF" i
+	      "(int narg, ...) {TRAMPOLINK(VV[" (third x) "],&LK" i ");}")))
+
+  (wt-h "#define compiler_data_text_size " *wt-string-size*)
+  (wt-nl1 "static const char *compiler_data_text = ")
+  (wt-nl1 "#include \"" data-namestring "\"")
+  (wt-nl1 ";")
+
+  (wt-h1 top-output-string))
+
+(defun t1eval-when (args &aux (load-flag nil) (compile-flag nil))
+  (when (endp args) (too-few-args 'eval-when 1 0))
+  (dolist (situation (car args))
+    (case situation
+      ((LOAD :LOAD-TOPLEVEL) (setq load-flag t))
+      ((COMPILE :COMPILE-TOPLEVEL) (setq compile-flag t))
+      ((EVAL :EXECUTE))
+      (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal."
+			 situation))))
+  (let ((*not-compile-time* (not compile-flag))
+	(*compile-time-too* compile-flag))
+    (cond (load-flag
+	   (t1progn (rest args)))
+	  (compile-flag
+	   (cmp-eval (cons 'PROGN (cdr args))))))
+  )
+
+(defun t1compiler-let (args &aux (symbols nil) (values nil))
+  (when (endp args) (too-few-args 'compiler-let 1 0))
+  (dolist (spec (car args))
+    (cond ((consp spec)
+           (cmpck (not (and (symbolp (car spec))
+                            (or (endp (cdr spec))
+                                (endp (cddr spec)))))
+                  "The variable binding ~s is illegal." spec)
+           (push (car spec) symbols)
+           (push (if (endp (cdr spec)) nil (eval (second spec))) values))
+          ((symbolp spec)
+           (push spec symbols)
+           (push nil values))
+          (t (cmperr "The variable binding ~s is illegal." spec))))
+  (setq symbols (nreverse symbols))
+  (setq values (nreverse values))
+  (setq args (progv symbols values (t1progn (cdr args))))
+  )
+
+(defun t1progn (args) (dolist (form args) (t1expr form)))
+
+(defun t1defun (args &aux (setjmps *setjmps*))
+  (when (or (endp args) (endp (cdr args)))
+        (too-few-args 'defun 2 (length args)))
+  (cmpck (not (symbolp (car args)))
+         "The function name ~s is not a symbol." (car args))
+  (when *compile-time-too* (cmp-eval (cons 'DEFUN args)))
+  (setq *non-package-operation* t)
+  (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) lambda-expr
+        (*sharp-commas* nil) (*special-binding* nil)
+        (cfun (next-cfun))
+        (doc nil) (fname (car args)))
+    
+    (setq lambda-expr (c1lambda-expr (cdr args) fname))
+    (unless (eql setjmps *setjmps*)
+      (setf (info-volatile (second lambda-expr)) t))
+    (when (fourth lambda-expr)
+      (setq doc (add-object (fourth lambda-expr))))
+    (add-load-time-sharp-comma)
+    (new-defun fname cfun lambda-expr doc *special-binding*)
+    (when
+      (and
+       (get fname 'PROCLAIMED-FUNCTION)
+       (let ((lambda-list (third lambda-expr)))
+         (declare (list lambda-list))
+         (and (null (second lambda-list))	; no optional
+              (null (third lambda-list))	; no rest
+              (null (fourth lambda-list))	; no keyword
+              (< (length (car lambda-list)) lambda-parameters-limit))))
+      (flet
+	  ((make-inline-string (cfun args)
+	     (if (null args)
+		 (format nil "LI~d()" cfun)
+		 (let ((o (make-array 100 :element-type 'BASE-CHAR
+				      :fill-pointer 0)))
+		   (format o "LI~d(" cfun)
+		   (do ((l args (cdr l))
+			(n 0 (1+ n)))
+		       ((endp (cdr l))
+			(format o "#~d)" n))
+		     (declare (fixnum n))
+		     (format o "#~d," n))
+		   o))))
+	(let ((pat (get fname 'PROCLAIMED-ARG-TYPES))
+	      (prt (get fname 'PROCLAIMED-RETURN-TYPE)))
+	  (push (list fname pat prt t
+		      (not (member prt
+				   '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT)
+				   :test #'eq))
+		      (make-inline-string cfun pat))
+		*inline-functions*))))
+    )
+  )
+
+;;; Mechanism for sharing code:
+(defun new-defun (fname cfun lambda-expr doc special-binding)
+  (let ((previous (dolist (form *top-level-forms*)
+		    (when (and (eq 'DEFUN (car form))
+			       (equal special-binding (sixth form))
+			       (similar lambda-expr (fourth form)))
+		      (return (third form))))))
+    (if previous
+	(progn
+	  (cmpnote "Sharing code for function ~A" fname)
+	  (push (list 'DEFUN fname previous nil doc special-binding
+                      *funarg-vars*)
+		*top-level-forms*))
+	(progn
+	  (push (list 'DEFUN fname cfun lambda-expr doc special-binding
+                      *funarg-vars*)
+		*top-level-forms*)
+	  (push (cons fname cfun) *global-funs*)))))
+
+(defun similar (x y)
+  (or (equal x y)
+      (and (consp x)
+	   (consp y)
+	   (similar (car x) (car y))
+	   (similar (cdr x) (cdr y)))
+      (and (var-p x)
+	   (var-p y)
+	   (do ((i 2 (1+ i)))
+	       ((= i (length x)) t)
+	     (declare (fixnum i))
+	     (unless (equal (svref x i) (svref y i))
+	       (return nil))))
+      (and (typep x 'VECTOR)
+	   (typep y 'VECTOR)
+	   (every #'similar x y))))
+
+(defun wt-if-proclaimed (fname cfun vv lambda-expr)
+  (when (fast-link-proclaimed-type-p fname)
+    (if (assoc fname *inline-functions*)
+      (wt-nl "(void)putprop(VV[" vv "],make_fixnum((int)LI"
+             cfun "),VV[" (add-object 'SYS::CDEFN)"]);")
+      (let ((arg-c (length (car (third lambda-expr))))
+            (arg-p (length (get fname 'PROCLAIMED-ARG-TYPES))))
+        (if (= arg-c arg-p)
+          (cmpwarn
+           " ~a is proclaimed but not in *inline-functions* ~
+            ~%T1defun could not assure suitability of args for C call" fname
+           )
+          (cmpwarn
+           "Number of proclaimed args for ~a was ~a. ~
+            ~%;;; Its definition had ~a." fname arg-p arg-c))))))
+
+(defun volatile (info)
+   (if (info-volatile info) "volatile " ""))
+
+(defun register (var)
+  (if (and (equal *volatile* "")
+	   (> (var-ref var) (the fixnum *register-min*)))
+      "register "
+      ""))
+
+(defun t2defun (fname cfun lambda-expr doc sp funarg-vars
+                      &aux (vv (add-symbol fname))
+		      (nkey (length (fifth (third lambda-expr)))))
+  (declare (ignore sp funarg-vars))
+  (when (get fname 'NO-GLOBAL-ENTRY) (return-from t2defun nil))
+  (wt-nl "MF(VV[" vv "],L" cfun ",Cblock);")
+  (when (< *space* 3)
+    (when doc
+      (wt-nl "(void)putprop(VV[" vv "],VV[" doc "],VV["
+	     (add-symbol 'si::function-documentation) "]);")
+      (wt-nl))
+    (setf (get fname 'DEBUG-PROP) t)
+    (wt-nl "(void)putprop(VV[" vv "],VV[Vdeb" vv "],VV["
+	   (add-object 'ARGLIST) "]);"))
+  (when (get fname 'PROCLAIMED-FUNCTION)
+	(wt-if-proclaimed fname cfun vv lambda-expr))
+)
+
+(defun t3defun (fname cfun lambda-expr doc sp funarg-vars
+                      &aux inline-info lambda-list requireds
+                      (*current-form* (list 'DEFUN fname))
+                      (*volatile* (when lambda-expr
+                                    (volatile (second lambda-expr))))
+		      (*lcl* 0) (*temp* 0) (*max-temp* 0)
+		      (*next-unboxed* 0) (*unboxed* nil)
+		      (*lex* *lex*) (*max-lex* *max-lex*)
+		      (*env* *env*) (*max-env* 0) (*level* *level*))
+  (declare (ignore doc))
+  
+  (setq *funarg-vars* funarg-vars)
+  (when lambda-expr		; Not sharing code.
+    (setq lambda-list (third lambda-expr)
+          requireds (car lambda-list))
+    (analyze-regs (info-referred-vars (second lambda-expr)))
+
+    (if (dolist (v *inline-functions*)
+	  (and (eq (car v) fname)
+	       (return (setq inline-info v))))
+      
+	;; Local entry
+	(let* ((*exit* (case (third inline-info)
+			 (FIXNUM 'RETURN-FIXNUM)
+			 (CHARACTER 'RETURN-CHARACTER)
+			 (LONG-FLOAT 'RETURN-LONG-FLOAT)
+			 (SHORT-FLOAT 'RETURN-SHORT-FLOAT)
+			 (otherwise 'RETURN-OBJECT)))
+	       (*unwind-exit* (list *exit*))
+	       (*destination* *exit*)
+	       (*reservation-cmacro* (next-cmacro)))
+
+	  ;; Add global entry information.
+	  (push (list fname cfun (second inline-info) (third inline-info))
+		*global-entries*)
+	  (wt-comment "local entry for function " fname)
+	  (wt-h "static " (rep-type (third inline-info)) "LI" cfun "();")
+	  (wt-nl1 "static " (rep-type (third inline-info)) "LI" cfun "(")
+	  (do ((vl requireds (cdr vl))
+	       (types (second inline-info) (cdr types))
+	       (prev-type nil) (var)
+	       (lcl (1+ *lcl*) (1+ lcl)))
+	      ((endp vl))
+	    (declare (fixnum lcl))
+	    (setq var (first vl))
+	    (when (member (car types)
+			  '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT)
+			  :test #'eq)
+	      ;; so that c2lambda-expr will know its proper type.
+	      (setf (var-kind var) (car types)))
+	    (when prev-type (wt ","))
+	    (wt *volatile* (register var)
+		(rep-type (car types)))
+	    (setq prev-type (car types))
+	    (wt-lcl lcl))
+	  (wt ")")
+
+	  ;; Now the body.
+	  (let ((*tail-recursion-info* (cons fname requireds))
+		(*unwind-exit* *unwind-exit*))
+	    (wt-nl1 "{")
+	    (wt-function-prolog nil 'LOCAL-ENTRY)
+	    (c2lambda-expr lambda-list (third (cddr lambda-expr)) cfun fname
+			   nil 'LOCAL-ENTRY)
+	    (wt-nl1 "}")
+	    (wt-function-epilogue)))
+
+	;; normal (non proclaimed) function:
+	(let ((*exit* 'RETURN) (*unwind-exit* '(RETURN))
+	      (*destination* 'RETURN) (*reservation-cmacro* (next-cmacro))
+	      (va_args (or (second lambda-list)
+			   (third lambda-list)
+			   (fourth lambda-list))))
+
+	  (wt-comment "function definition for " fname)
+	  (if (numberp cfun)
+	      (progn
+		(wt-nl1 "static cl_object L" cfun "(int narg")
+		(wt-h "static cl_object L" cfun "(int"))
+	      (progn
+		(wt-nl1 cfun "(int narg")
+		(wt-h cfun "(int")))
+	  (do ((vl requireds (cdr vl))
+	       (lcl (1+ *lcl*) (1+ lcl)))
+	      ((endp vl))
+	    (declare (fixnum lcl))
+	    (wt ", cl_object ") (wt-lcl lcl)
+	    (wt-h1 ", cl_object"))
+	  (when va_args
+	    (wt ", ...")
+	    (wt-h1 ", ..."))
+	  (wt ")")
+	  (wt-h1 ");")
+      
+	  (wt-nl1 "{")
+	  (wt-function-prolog sp)
+	  (c2lambda-expr lambda-list (third (cddr lambda-expr)) cfun fname)
+	  (wt-nl1 "}")
+	  (wt-function-epilogue))))
+  (add-debug-info fname lambda-expr)	; needed also when code is shared
+  )
+
+(defun wt-function-prolog (&optional sp local-entry)
+  (wt " VT" *reservation-cmacro*
+      " VLEX" *reservation-cmacro*
+      " CLSR" *reservation-cmacro*)
+  (wt-nl "cl_object value0;")
+  (when (and (not local-entry) *safe-compile*)
+    (wt-nl "cs_check;"))
+  (when sp (wt-nl "bds_check;"))
+  ; (when *compiler-push-events* (wt-nl "ihs_check;"))
+  )
+
+(defun wt-function-epilogue (&optional closure-p)
+  (push (cons *reservation-cmacro* (+ *max-temp* (length *unboxed*)))
+        *reservations*)
+  (wt-h "#define VT" *reservation-cmacro*)
+  (when (plusp *max-temp*)
+    (wt-h1 " cl_object ")
+    (dotimes (i *max-temp*)
+      (wt-h1 "T") (wt-h1 i)
+      (unless (= (1+ i) *max-temp*) (wt-h1 ",")))
+    (wt-h1 ";"))
+;  (wt-h "#define VU" *reservation-cmacro*)
+;  (when *unboxed*
+;    (format *compiler-output2* " ~{~{~aU~a; ~}~}" *unboxed*))
+  (wt-h "#define VLEX" *reservation-cmacro*)
+  (when (plusp *max-lex*)
+    (wt-h1 " cl_object lex") (wt-h1 *level*)
+    (wt-h1 "[") (wt-h1 *max-lex*) (wt-h1 "];"))
+  (wt-h "#define CLSR" *reservation-cmacro*)
+  (when (plusp *max-env*)
+    (unless closure-p (wt-h1 " volatile cl_object env0;"))
+    (wt-h1 " cl_object ")
+    (dotimes (i *max-env*)
+      (wt-h1 "*CLV") (wt-h1 i)
+      (unless (= (1+ i) *max-env*) (wt-h1 ",")))
+    (wt-h1 ";"))
+  )
+
+;;; Modified for debugging compiled functions. Beppe
+(defun add-debug-info (fname lambda-expr)
+  (cond
+    ((>= *space* 3))
+    ((null (get fname 'DEBUG-PROP))
+     (warn "~a has a duplicate definition in this file" fname))
+    (t
+     (remprop fname 'DEBUG-PROP)
+     (let* ((args (third lambda-expr))
+	    (requireds (mapcar #'var-name (first args)))
+	    (optionals (mapcar #'(lambda (x) (var-name (car x)))
+			       (second args)))
+	    ;; (rest (var-name (third args)))
+	    (keywords (mapcar #'(lambda (x) (var-name (second x))) (fifth args)))
+	    )
+       (wt-h "#define Vdeb" (add-symbol fname) " "
+	     (add-object (nconc requireds optionals keywords)))))))
+
+;;; Checks the register slots of variables, and finds which
+;;; variables should be in registers, reducing the var-ref value
+;;; in the remaining.  Data and address variables are done separately.
+(defun analyze-regs (vars)
+  (flet ((analyze-regs1 (vars want &aux (tem 0) (real-min 3) (this-min 100000)
+			      (have 0))
+           (declare (fixnum want tem real-min this-min have))
+	   (do ((vs vars) (v))
+	       ((null vs))
+	     (setq v (pop vs)
+		   tem (var-ref v))
+	     (when (>= tem real-min)
+	       (incf have)
+	       (setq this-min (min this-min tem))
+	       (when (> have want)
+		 (setq have 0
+		       real-min (1+ this-min)
+		       this-min 1000000
+		       vs vars))))
+	   (when (< have want) (decf real-min))
+	   (dolist (v vars)
+	     (when (< (var-ref v) real-min)
+	       ;; don't put 1, otherwise optimization may discard
+	       ;; variable
+	       (setf (var-ref v) (min (var-ref v) *register-min*))))))
+    (let (addr data)
+      (dolist (v vars)
+	(if (member (var-type v)
+		    '(FIXNUM CHARACTER SHORT-FLOAT LONG-FLOAT)
+		    :test #'eq)
+	    (pushnew v data)
+	    (pushnew v addr)))
+      (analyze-regs1 addr *free-address-registers*)
+      (analyze-regs1 data *free-data-registers*))))
+
+(defun wt-global-entry (fname cfun arg-types return-type)
+    (when (get fname 'NO-GLOBAL-ENTRY) (return-from wt-global-entry nil))
+    (wt-comment "global entry for the function " fname)
+    (wt-nl1 "static cl_object L" cfun "(int narg")
+    (wt-h "static cl_object L" cfun "(int")
+    (do ((vl arg-types (cdr vl))
+	 (lcl (1+ *lcl*) (1+ lcl)))
+	((endp vl) (wt1 ")"))
+      (declare (fixnum lcl))
+      (wt1 ", cl_object ") (wt-lcl lcl)
+      (wt-h1 ", cl_object"))
+    (wt-h1 ");")
+    (wt-nl1 "{")
+    (when (or *safe-compile* *compiler-check-args*)
+          (wt-nl "check_arg(" (length arg-types) ");"))
+    (wt-nl "NValues=1;")
+    (wt-nl "return " (case return-type
+                            (FIXNUM "MAKE_FIXNUM")
+                            (CHARACTER "code_char")
+                            (LONG-FLOAT "make_longfloat")
+                            (SHORT-FLOAT "make_shortfloat")
+                            (otherwise ""))
+           "(LI" cfun "(")
+    (do ((types arg-types (cdr types))
+         (n 1 (1+ n)))
+        ((endp types))
+      (declare (fixnum n))
+      (wt (case (car types)
+            (FIXNUM "fix")
+            (CHARACTER "char_code")
+            (LONG-FLOAT "lf")
+            (SHORT-FLOAT "sf")
+            (otherwise "")) "(")
+        (wt-lcl n) (wt ")")
+        (unless (endp (cdr types)) (wt ",")))
+    (wt "));}")
+    )
+
+(defun rep-type (type)
+  (case type
+    (FIXNUM "int ")
+    (CHARACTER "unsigned char ")
+    (SHORT-FLOAT "float ")
+    (LONG-FLOAT "double ")
+    (otherwise "cl_object ")))
+
+(defun t1defmacro (args)
+  (when (or (endp args) (endp (cdr args)))
+    (too-few-args 'defmacro 2 (length args)))
+  (cmpck (not (symbolp (car args)))
+         "The macro name ~s is not a symbol." (car args))
+  (cmp-eval (cons 'DEFMACRO args))
+  (setq *non-package-operation* t)
+  (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil)
+        (*sharp-commas* nil) (*special-binding* nil)
+        macro-lambda (cfun (next-cfun)) (doc nil) (ppn nil))
+    (setq macro-lambda (c1dm (car args) (second args) (cddr args)))
+    (when (car macro-lambda) (setq doc (add-object (car macro-lambda))))
+    (when (second macro-lambda) (setq ppn (add-object (second macro-lambda))))
+    (add-load-time-sharp-comma)
+    (push (list 'DEFMACRO (car args) cfun (cddr macro-lambda) doc ppn
+		*special-binding*)
+	  *top-level-forms*))
+  )
+
+(defun t2defmacro (fname cfun macro-lambda doc ppn sp
+                         &aux (vv (add-symbol fname)))
+  (declare (ignore macro-lambda sp))
+  (when (< *space* 3)
+    (when doc
+      (wt-nl "(void)putprop(VV[" vv "],VV[" doc "],VV["
+	     (add-symbol 'si::function-documentation) "]);")
+      (wt-nl))
+    (when ppn
+      (wt-nl "(void)putprop(VV[" vv "],VV[" ppn "],siSpretty_print_format);")
+      (wt-nl)))
+  (wt-h "static cl_object L" cfun "();")
+  (wt-nl "MM(VV[" vv "],L" cfun ",Cblock);")
+  )
+
+(defun t3defmacro (fname cfun macro-lambda doc ppn sp
+                         &aux (*lcl* 0) (*temp* 0) (*max-temp* 0)
+                         (*lex* *lex*) (*max-lex* *max-lex*)
+			 (*next-unboxed* 0) *unboxed*
+                         (*env* *env*) (*max-env* 0) (*level* *level*)
+			 (*volatile*
+			  (if (get fname 'CONTAINS-SETJMP) " volatile " ""))
+                         (*exit* 'RETURN) (*unwind-exit* '(RETURN))
+                         (*destination* 'RETURN)
+                         (*reservation-cmacro* (next-cmacro)))
+  (declare (ignore doc ppn))
+  (wt-comment "macro definition for " fname)
+  (wt-nl1 "static cl_object L" cfun "(int narg, cl_object V1, cl_object V2)")
+  (wt-nl1 "{")
+  (wt-function-prolog sp)
+  (c2dm fname (car macro-lambda) (second macro-lambda) (third macro-lambda)
+        (fourth macro-lambda))
+  (wt-nl1 "}")
+  (wt-function-epilogue)
+  )
+
+(defun t1ordinary (form)
+  (when (or *compile-time-too*
+	    (eq (car form) 'SYS:*MAKE-CONSTANT)
+	    (eq (car form) 'SYS:*MAKE-SPECIAL)
+	    (eq (car form) 'LISP:PROCLAIM))
+	(cmp-eval form))
+  (setq *non-package-operation* t)
+  (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil)
+        (*sharp-commas* nil))
+       (setq form (c1expr form))
+       (add-load-time-sharp-comma)
+       (push (list 'ORDINARY form) *top-level-forms*)))
+
+(defun t2ordinary (form)
+  (let* ((*exit* (next-label)) (*unwind-exit* (list *exit*))
+         (*destination* 'TRASH))
+        (c2expr form)
+        (wt-label *exit*)))
+
+(defun add-load-time-sharp-comma ()
+  (dolist (vv (reverse *sharp-commas*))
+    (push (list 'SHARP-COMMA vv) *top-level-forms*)))
+
+(defun t2sharp-comma (vv)
+  (wt-nl "VV[" vv "]=string_to_object(VV[" vv "]);"))
+
+(defun t2declare (vv)
+  (wt-nl "VV[" vv "]->symbol.stype=(short)stp_special;"))
+
+(defun t1defvar (args &aux form (doc nil) (name (car args)))
+  (when *compile-time-too* (cmp-eval `(defvar ,@args)))
+  (setq *non-package-operation* nil)
+  (if (endp (cdr args))
+      (push (list 'DECLARE (add-symbol name)) *top-level-forms*)
+      (progn
+	(unless (endp (cddr args)) (setq doc (add-object (third args))))
+	(let* ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil)
+	       (*sharp-commas* nil))
+	  (setq form (c1expr (second args)))
+	  (add-load-time-sharp-comma))
+	(push (list 'DEFVAR (make-var :name name :kind 'SPECIAL
+				      :loc (add-symbol name)) form doc)
+	      *top-level-forms*)))
+  )
+
+(defun t2defvar (var form doc &aux (vv (var-loc var)))
+  (wt-nl "VV[" vv "]->symbol.stype=(short)stp_special;")
+  (let* ((*exit* (next-label)) (*unwind-exit* (list *exit*))
+         (*destination* (list 'VAR var)))
+        (wt-nl "if(VV[" vv "]->symbol.dbind == OBJNULL){")
+        (c2expr form)
+        (wt "}")
+        (wt-label *exit*))
+  (when (and doc (< *space* 3))
+    (wt-nl "(void)putprop(VV[" vv "],VV[" doc "],VV[" (add-symbol 'si::variable-documentation) "]);")
+    (wt-nl))
+  )
+
+(defun t1clines (args)
+  (dolist (s args)
+    (cmpck (not (stringp s)) "The argument to CLINE, ~s, is not a string." s))
+  (push (list 'CLINES args) *top-level-forms*))
+
+(defun t3clines (ss) (dolist (s ss) (wt-nl1 s)))
+
+(defun parse-cvspecs (x &aux (cvspecs nil))
+  (dolist (cvs x (nreverse cvspecs))
+    (cond ((symbolp cvs)
+           (push (list 'OBJECT (string-downcase (symbol-name cvs))) cvspecs))
+          ((stringp cvs) (push (list 'OBJECT cvs) cvspecs))
+          ((and (consp cvs)
+                (member (car cvs) '(OBJECT CHAR INT FLOAT DOUBLE)))
+           (dolist (name (cdr cvs))
+             (push (list (car cvs)
+                         (cond ((symbolp name)
+                                (string-downcase (symbol-name name)))
+                               ((stringp name) name)
+                               (t (cmperr "The C variable name ~s is illegal."
+                                          name))))
+                   cvspecs)))
+          (t (cmperr "The C variable specification ~s is illegal." cvs))))
+  )
+
+(defun t3local-fun (closure-p fun lambda-expr
+			      ;; if defined by labels can be tail-recursive
+                              &aux (level (fun-level fun))
+			      (nenvs level)
+			      (*volatile* (volatile (second lambda-expr)))
+                              (lambda-list (third lambda-expr))
+                              (requireds (car lambda-list))
+                              (va_args (or (second lambda-list)
+                                           (third lambda-list)
+                                           (fourth lambda-list))))
+  (declare (fixnum level nenvs))
+  (wt-comment (if (fun-closure fun) "closure " "local function ")
+	      (let ((name (fun-name fun)))
+		;; a list is used for lambda-block's
+		(if (symbolp name) (or name 'CLOSURE) (first name))))
+  (wt-h "static cl_object LC" (fun-cfun fun) "(")
+  (wt-nl1 "static cl_object LC" (fun-cfun fun) "(")
+  (wt-h1 "int")
+  (wt "int narg")
+  (dotimes (n level)
+    (wt-h1 ",cl_object *")
+    (wt ",cl_object *lex" n))
+  (when closure-p
+    (wt-h1 ", cl_object")
+    (wt ", cl_object env0")
+    (incf nenvs))
+  (let ((lcl 0))
+    (declare (fixnum lcl))
+    (dolist (var requireds)
+      (wt-h1 ", cl_object ")
+      (wt ", cl_object ") (wt-lcl (incf lcl))))
+  (when va_args
+    (wt-h1 ", ...")
+    (wt ", ..."))
+  (wt-h1 ");")
+  (wt ")")
+
+  (analyze-regs (info-referred-vars (second lambda-expr)))
+  (let* ((*lcl* 0) (*temp* 0) (*max-temp* 0)
+	 (*lex* 0) (*max-lex* 0) (*next-unboxed* 0) *unboxed*
+	 (*env* (fun-env fun))		; continue growing env
+	 (*max-env* *env*) (*env-lvl* 0)
+	 (*level* level)
+	 (*exit* 'RETURN) (*unwind-exit* '(RETURN))
+	 (*destination* 'RETURN) (*reservation-cmacro* (next-cmacro)))
+    (wt-nl1 "{")
+    (wt " VT" *reservation-cmacro*
+	" VLEX" *reservation-cmacro*
+	" CLSR" *reservation-cmacro*)
+    (wt-nl "cl_object value0;")
+    (when (plusp nenvs)
+      (wt-nl "narg-=" nenvs ";"))	; APPLY counts env as arg
+    (when (fun-closure fun)
+      (let ((clv-used (remove-if
+		       #'(lambda (x)
+			   (or
+			    ;; non closure variable
+			    (not (ref-ref-ccb x))
+			    ;; parameter of this closure
+			    ;; (not yet bound, therefore var-loc is OBJECT)
+			    (eq (var-loc x) 'OBJECT)))
+		       (info-local-referred (second lambda-expr)))))
+        (setq clv-used (sort clv-used #'> :key #'var-loc))
+        (when clv-used
+          (wt-nl "{cl_object scan=env0;")
+          (do ((n (1- (fun-env fun)) (1- n))
+               (bs clv-used))
+              ((minusp n))
+            (when (= n (var-loc (car bs)))
+              (wt-nl "CLV" n "= &CAR(scan);")
+	      (wt-comment (var-name (car bs)))
+              (pop bs))
+            (unless bs (return))
+            (when (plusp n) (wt " scan=CDR(scan);")))
+          (wt "}"))))
+    (c2lambda-expr (third lambda-expr) (third (cddr lambda-expr))
+		   (fun-cfun fun) (fun-name fun)
+		   (fun-closure fun))
+    (wt-nl1 "}")
+    (wt-function-epilogue closure-p))	; we should declare in CLSR only those used
+  )
+
+#|
+(defun t1defcfun (args &aux (body nil))
+  (when (or (endp args) (endp (cdr args)))
+        (too-few-args 'defcfun 2 (length args)))
+  (cmpck (not (stringp (car args)))
+         "The first argument to defCfun ~s is not a string." (car args))
+  (cmpck (not (numberp (second args)))
+         "The second argument to defCfun ~s is not a number." (second args))
+  (dolist (s (cddr args))
+    (cond ((stringp s) (push s body))
+          ((consp s)
+           (cond ((symbolp (car s))
+                  (cmpck (special-form-p (car s))
+                         "Special form ~s is not allowed in defCfun." (car s))
+                  (push (list (cons (car s) (parse-cvspecs (cdr s)))) body))
+                 ((and (consp (car s)) (symbolp (caar s))
+                       (not (if (eq (caar s) 'QUOTE)
+                                (or (endp (cdar s))
+                                    (not (endp (cddar s)))
+                                    (endp (cdr s))
+                                    (not (endp (cddr s))))
+                                (special-form-p (caar s)))))
+                  (push (cons (cons (caar s)
+                                    (if (eq (caar s) 'QUOTE)
+                                        (list (add-object (cadar s)))
+                                        (parse-cvspecs (cdar s))))
+                              (parse-cvspecs (cdr s)))
+                        body))
+                 (t (cmperr "The defCfun body ~s is illegal." s))))
+          (t (cmperr "The defCfun body ~s is illegal." s))))
+  (push (list 'DEFCFUN (car args) (second args) (reverse body))
+        *top-level-forms*)
+  )
+
+(defun t3defcfun (header vs-size body &aux fd narg)
+  (wt-comment "C function defined by " 'defcfun)
+  (wt-nl1 header)
+  (wt-nl1 "{")
+  ;;; manca un pezzo, Beppe ???
+  (dolist (s body)
+    (cond ((stringp s) (wt-nl1 s))
+          ((eq (caar s) 'QUOTE)
+           (wt-nl1 (cadadr s))
+           (if (eq (caadr s) 'OBJECT)
+	       (wt "=VV[" (cadar s) "];")
+	       (wt "=object_to_" (string-downcase (symbol-name (caadr s)))
+		   "(VV[" (cadar s) "]);")))
+          (t
+           (setq narg (length cdar s))
+           (cond ((setq fd (assoc (caar s) *global-funs*))
+                  (cond (*compiler-push-events*
+                         (wt-nl1 "ihs_push(VV[" (add-symbol (caar s)) "],&narg);")
+                         (wt-nl1 "L" (cdr fd) "();")
+                         (wt-nl1 "ihs_pop();"))
+                        (t (wt-nl1 "L" (cdr fd) "(" narg))))
+                 (t (wt-nl1 "funcall(" (1+ narg) ",VV[" (add-symbol (caar s))
+                            "]->symbol.gfdef"))
+                 )
+           (dolist (arg (cdar s))
+             (wt ",")
+             (case (car arg)
+               (OBJECT (wt (second arg)))
+               (CHAR (wt "code_char((int)" (second arg) ")"))
+               (INT  (wt "MAKE_FIXNUM((int)" (second arg) ")"))
+               (FLOAT (wt "make_shortfloat((float)" (second arg) ")"))
+               (DOUBLE (wt "make_longfloat((double)" (second arg) ")"))))
+           (wt ");")
+           (unless (endp (cdr s))
+               (wt-nl1 (cadadr s))
+               (case (caadr s)
+                     (object (wt "=vs_base[0];"))
+                     (otherwise (wt "=object_to_"
+                                    (string-downcase (symbol-name (caadr s)))
+                                    "(vs_base[0]);")))
+               (dolist (dest (cddr s))
+                 (wt-nl1 "vs_base++;")
+                 (wt-nl1 (second dest))
+                 (if (eq (car dest) 'OBJECT)
+		     (wt "=(vs_base<vs_top?vs_base[0]:Cnil);")
+		     (wt "=object_to_"
+			 (string-downcase (symbol-name (car dest)))
+			 "((vs_base<vs_top?vs_base[0]:Cnil));")))
+               )
+             (wt-nl1 "}")
+             )))
+  (wt-nl1 "}")
+  )
+
+(defun t1defentry (args &aux type cname (cfun (next-cfun)) cfspec)
+  (when (or (endp args) (endp (cdr args)) (endp (cddr args)))
+        (too-few-args 'defentry 3 (length args)))
+  (cmpck (not (symbolp (car args)))
+         "The function name ~s is not a symbol." (car args))
+  (dolist (x (second args))
+    (cmpck (not (member x '(OBJECT CHAR* CHAR INT FLOAT DOUBLE)))
+           "The C-type ~s is illegal." x))
+  (setq cfspec (third args))
+  (cond ((symbolp cfspec)
+         (setq type 'OBJECT)
+         (setq cname (string-downcase (symbol-name cfspec))))
+        ((stringp cfspec)
+         (setq type 'OBJECT)
+         (setq cname cfspec))
+        ((and (consp cfspec)
+              (member (car cfspec) '(VOID OBJECT CHAR* CHAR INT FLOAT DOUBLE))
+              (consp (cdr cfspec))
+              (or (symbolp (second cfspec)) (stringp (second cfspec)))
+              (endp (cddr cfspec)))
+         (setq cname (if (symbolp (second cfspec))
+                        (string-downcase (symbol-name (second cfspec)))
+                        (second cfspec)))
+         (setq type (car cfspec)))
+        (t (cmperr "The C function specification ~s is illegal." cfspec)))
+  (push (list 'DEFENTRY (car args) cfun (second args) type cname)
+        *top-level-forms*)
+  (push (cons (car args) cfun) *global-funs*)
+  )
+
+(defun t2defentry (fname cfun arg-types type cname
+                         &aux (vv (add-symbol fname)))
+  (declare (ignore arg-types type cname))
+  (wt-h "static L" cfun "();")
+  (wt-nl "MF(VV[" vv "],L" cfun ",Cblock);")
+  )
+
+(defun t3defentry (fname cfun arg-types type cname)
+  (wt-comment "function definition for " fname)
+  (wt-nl1 "static L" cfun "()")
+  (wt-nl1 "{	cl_object *old_base=vs_base;")
+  (unless (eq type 'VOID) (wt-nl (string-downcase (symbol-name type)) " x;"))
+  (when *safe-compile* (wt-nl "check_arg(" (length arg-types) ");"))
+  (unless (eq type 'VOID) (wt-nl "x="))
+  (wt-nl cname "(")
+  (unless (endp arg-types)
+          (do ((types arg-types (cdr types))
+               (i 0 (1+ i)))
+              (nil)
+              (declare (object types) (fixnum i))
+              (case (car types)
+                    (object (wt-nl "vs_base[" i "]"))
+		    (char*
+		     (if *safe-compile*
+			 (wt-nl "object_to_string"
+				"(vs_base[" i "])")
+		       (wt-nl "(vs_base[" i "]->string.self)")))
+		    (int
+		     (if *safe-compile*
+			 (wt-nl "object_to_int"
+				"(vs_base[" i "])")
+		       (wt-nl "fix(vs_base[" i "])")))
+                    (otherwise
+                     (wt-nl "object_to_"
+                            (string-downcase (symbol-name (car types)))
+                            "(vs_base[" i "])")))
+              (when (endp (cdr types)) (return))
+              (wt ",")))
+  (wt ");")
+  (wt-nl "vs_top=(vs_base=old_base)+1;")
+  (wt-nl "vs_base[0]=")
+  (case type
+        (VOID (wt "Cnil"))
+        (OBJECT (wt "x"))
+        (CHAR* (wt "make_simple_string(x)"))
+        (CHAR (wt "code_char(x)"))
+        (INT  (wt "MAKE_FIXNUM(x)"))
+        (FLOAT (wt "make_shortfloat(x)"))
+        (DOUBLE (wt "make_longfloat(x)"))
+        )
+  (wt ";")
+  (wt-nl1 "}")
+  )
+
+(defun t1defla (args) (declare (ignore args)))
+|#
+;;; ----------------------------------------------------------------------
+;;; Function definition with in-line body expansion.
+;;; This is similar to defentry, except that the C body is supplied
+;;; instead of a C function to call.
+;;; Besides, Lisp types are used instead of C types, for proper coersion.
+;;;
+;;; (defCbody logand (fixnum fixnum) fixnum "(#0) & (#1)")
+;;;
+;;; ----------------------------------------------------------------------
+
+(defun t1defCbody (args &aux fun (cfun (next-cfun)))
+  (when (or (endp args) (endp (cdr args))
+	    (endp (cddr args)) (endp (cdddr args)))
+        (too-few-args 'defCbody 4 (length args)))
+  (setq fun (first args))
+  (cmpck (not (symbolp fun))
+         "The function name ~s is not a symbol." fun)
+  (push (list 'DEFCBODY fun cfun (second args) (third args)
+	      (fourth args))
+        *top-level-forms*)
+  (push (cons fun cfun) *global-funs*)
+  )
+
+
+(defun t2defCbody (fname cfun arg-types type body
+                         &aux (vv (add-symbol fname)))
+  (declare (ignore arg-types type body))
+  (wt-h "static cl_object L" cfun "();")
+  (wt-nl "MF(VV[" vv "],L" cfun ",Cblock);")
+  )
+
+#|
+;;; Simpler version. Does not perform type checking of args though.
+
+(defun t3defCbody (fname cfun arg-types type body &aux args)
+  (wt-comment "function definition for " fname)
+  (wt-nl1 "static L" cfun "(int narg")
+  (do ((vl arg-types (cdr vl))
+       (lcl 1 (1+ lcl)))
+      ((endp vl))
+    (declare (fixnum lcl))
+    (push (list 'VAR (make-info :type (car vl))
+		(list (make-var :kind 'OBJECT :loc lcl))) args)
+    (wt ", cl_object ") (wt-lcl lcl)
+    )
+  (wt ")")
+  (wt-nl1 "{")
+  (when *safe-compile* (wt-nl "check_arg(" (length arg-types) ");"))
+  (let ((*inline-functions* (push (list fname arg-types type T NIL body)
+				  *inline-functions*))
+	(*destination* (if type 'RETURN 'TRASH)))
+    (c2expr* `(CALL-GLOBAL ,(make-info :type type)
+	       ,fname ,(nreverse args) ,type)))
+  (wt-nl "RETURN(" (if type 1 0) ");")
+  (wt-nl1 "}")
+  )
+|#
+
+(eval-when (compile eval)		; also in cmpinline.lsp
+  ;; by mds@sepgifbr.sep.de.edf.fr (M.Decugis)
+  (defmacro parse-index (fun i)
+    `(multiple-value-bind (a-read endpos)
+      (parse-integer ,fun :start (1+ ,i) :junk-allowed t)
+      (setq ,i (1- endpos))
+      a-read))
+  )
+
+(defun t3defCbody (fname cfun arg-types type body)
+  (wt-comment "function definition for " fname)
+  (wt-nl1 "static cl_object L" cfun "(int narg")
+  (do ((vl arg-types (cdr vl))
+       (lcl 1 (1+ lcl)))
+      ((endp vl))
+    (declare (fixnum lcl))
+    (wt ", cl_object ") (wt-lcl lcl)
+    )
+  (wt ")")
+  (wt-nl1 "{")
+  (flet ((lisp2c-type (type)
+		      (case type
+			    ((NIL) 'VOID)
+			    (CHARACTER 'CHAR)
+			    (FIXNUM 'INT)
+			    (LONG-FLOAT 'DOUBLE)
+			    (SHORT-FLOAT 'FLOAT)
+			    (otherwise 'OBJECT)))
+	 (wt-inline-arg (fun locs &aux (i 0))
+            (declare (fixnum i))
+	    (cond ((stringp fun)
+		   (when (char= (char (the string fun) 0) #\@)
+			 (setq i 1)
+			 (do ()
+			     ((char= (char (the string fun) i) #\;) (incf i))
+			     (incf i)))
+		   (do ((size (length (the string fun))))
+		       ((>= i size))
+		       (declare (fixnum size))
+		       (let ((char (char (the string fun) i)))
+			 (declare (character char))
+			 (if (char= char #\#)
+			     (wt (nth (parse-index fun i) locs))
+			   (princ char *compiler-output1*))
+			 (incf i)))))))
+	(when type
+	  (let ((ctype (lisp2c-type type)))
+	    (if (eq ctype 'OBJECT)
+	      (wt-nl "cl_object x;")
+	      (wt-nl (string-downcase ctype) " x;"))))
+	(when *safe-compile* (wt-nl "check_arg(" (length arg-types) ");"))
+	(when type (wt-nl "x="))
+	(wt-inline-arg
+	 body
+	 (do ((types arg-types (cdr types))
+	      (i 1 (1+ i))
+	      (lst))
+	     ((null types) (nreverse lst))
+	     (declare (object types) (fixnum i))
+	     (push
+	      (if (eq (lisp2c-type (car types)) 'OBJECT)
+		  (format nil "V~d" i)
+		(format nil "object_to_~(~a~)(V~d)"
+			(lisp2c-type (car types)) i))
+	      lst)))
+	(wt ";")
+	(wt-nl "NValues=1;")
+	(wt-nl "return ")
+	(case type
+	      ((NIL) (wt "Cnil"))
+	      (BOOLEAN (wt "(x?Ct:Cnil)"))
+	      (CHARACTER (wt "code_char(x)"))
+	      (FIXNUM (wt "MAKE_FIXNUM(x)"))
+	      (SHORT-FLOAT (wt "make_shortfloat(x)"))
+	      (LONG-FLOAT (wt "make_longfloat(x)"))
+	      (otherwise (wt "x"))
+	      )
+	(wt ";}")
+	))
+#|
+;;; ----------------------------------------------------------------------
+;;; Lisp function defined in C.
+;;; Arguments and results are passed on stack.
+;;;
+;;; ----------------------------------------------------------------------
+
+(defun t1defunC (args &aux fun lambda-list (cfun (next-cfun)))
+  (when (or (endp args) (endp (cdr args)))
+        (too-few-args 'defunC 2 (length args)))
+  (setq fun (first args))
+  (cmpck (not (symbolp fun))
+         "The function name ~s is not a symbol." fun)
+  (setq lambda-list (second args))
+  (cmpck (not (listp lambda-list))
+         "The lambda list ~s is not a list." lambda-list)
+  (dolist (s (cddr args))
+    (cmpck (not (stringp s)) "The argument to DEFUNC, ~s, is not a string." s))
+  (push (list 'DEFUNC fun cfun lambda-list (cddr args)) *top-level-forms*)
+  (push (cons fun cfun) *global-funs*)
+  )
+
+(defun t2defunC (fname cfun lambda-list body
+		       &aux (vv (add-symbol fname)))
+  (declare (ignore lambda-list body))
+  (wt-h "static L" cfun "();")
+  (wt-nl "MF(VV[" vv "],L" cfun ",Cblock);")
+  )
+
+(defun t3defunC (fname cfun lambda-list body)
+  (wt-comment "function definition for " fname)
+  (wt-nl1 "static L" cfun "()")
+  (multiple-value-bind
+	(requireds optionals rest key-flag keywords allow-other-keys auxs)
+      (parse-lambda-list lambda-list)
+    (let ((nreq (length requireds))
+	  (nopt (length optionals)))
+      (declare (fixnum nreq nopt))
+      ;; Emit declarations:
+      (wt-nl1 "{")
+      (dolist (v requireds)
+	(wt-nl "cl_object " (string-downcase v) ";"))
+      (do ((scan optionals (cdr scan))
+	   (v))
+	  ((null scan))
+	(setq v (car scan))
+	(when (consp v)
+	  (setq v (car v))
+	  (cmpwarn "Discarding default value for optional variable ~s" v))
+        (setq v (string-downcase v))
+	(rplaca scan v)
+	(wt-nl "cl_object " v "=Cnil;"))
+      (when rest
+	(setq rest (string-downcase rest))
+	(wt-nl "cl_object " rest "=Cnil;"))
+      (dolist (v keywords)
+	(wt-nl "cl_object " (string-downcase (second v)) ";"))
+      (when auxs
+	(cmpwarn "&aux variables in defunC discarded"))
+      (if (and (null optionals)
+	       (null rest)
+	       (null key-flag))
+	  (wt-nl "check_arg(" nreq ");")
+	  (wt-nl "if (narg < " nreq  ") FEtoo_few_arguments(&narg);"))
+      ;; Assign requireds:
+      (do ((i 0 (1+ i))
+	   (vars requireds (cdr vars)))
+	  ((null vars))
+	(declare (fixnum i))
+	(wt-nl (string-downcase (car vars)) "=vs_base[" i "];"))
+      ;; Assign optionals:
+      (do ((i nreq (1+ i))
+	   (vars optionals (cdr vars)))
+	  ((null vars))
+	(declare (fixnum i))
+	(wt-nl (car vars) "=(narg>" i ") ? vs_base[" i "] : Cnil;"))
+      (when (and (> nopt 0) (not key-flag) (null rest))
+	(wt-nl "if (narg > " (+ nreq nopt) ") FEtoo_many_arguments(fname,narg);"))
+      (when rest
+         (wt-nl "{cl_object *p=vs_top;")
+         (wt-nl " for(;p>vs_base+" (+ nreq nopt) ";p--)"
+		rest "=CONS(p[-1]," rest ");}"))
+      (when key-flag
+	(wt-nl "parse_key(vs_base+" (+ nreq nopt) ",FALSE,"
+	       (if allow-other-keys "TRUE," "FALSE,") (length keywords))
+	(dolist (k keywords)
+	  (wt-nl ",VV[" (add-object (car k)) "]"))
+	(wt ");")
+	(do ((ks keywords (cdr ks))
+	     (i (+ nreq nopt) (1+ i)))
+	    ((null ks))
+	  (declare (fixnum i))
+	  (wt-nl (string-downcase (second (car ks))) "=vs_base[" i "];")))
+      ))
+  ;; Now the supplied body:
+  (dolist (s body)
+    (wt-nl1 s))
+  (wt-nl1 "}")
+  )
+|#
+
+(defun t2function-constant (funob fun)
+  (let ((previous (new-local *level* fun funob)))
+    (if (and previous (fun-var previous))
+	(setf (fun-var fun) (fun-var previous))
+	(let ((loc (progn (wt-data nil) `(VV ,(incf *next-vv*)))))
+	  (wt-nl loc " = ") (wt-make-closure fun) (wt ";")
+	  (setf (fun-var fun) loc))))
+)
+
+;;; ----------------------------------------------------------------------
+
+;;; Pass 1 top-levels.
+
+(setf (get 'COMPILER-LET 'T1) #'t1compiler-let)
+(setf (get 'EVAL-WHEN 'T1) #'t1eval-when)
+(setf (get 'PROGN 'T1) #'t1progn)
+(setf (get 'DEFUN 'T1) #'t1defun)
+(setf (get 'DEFMACRO 'T1) #'t1defmacro)
+(setf (get 'DEFVAR 'T1) #'t1defvar)
+(setf (get 'CLINES 'T1) 't1clines)
+(setf (get 'DEFCFUN 'T1) 't1defcfun)
+;(setf (get 'DEFENTRY 'T1) 't1defentry)
+(setf (get 'DEFLA 'T1) 't1defla)
+(setf (get 'DEFCBODY 'T1) 't1defCbody)	; Beppe
+;(setf (get 'DEFUNC 'T1) 't1defunC)	; Beppe
+
+;;; Pass 2 initializers.
+
+(setf (get 'DEFUN 'T2) #'t2defun)
+(setf (get 'DEFMACRO 'T2) #'t2defmacro)
+(setf (get 'ORDINARY 'T2) #'t2ordinary)
+(setf (get 'DECLARE 'T2) #'t2declare)
+(setf (get 'SHARP-COMMA 'T2) #'t2sharp-comma)
+(setf (get 'DEFVAR 'T2) #'t2defvar)
+;(setf (get 'DEFENTRY 'T2) 't2defentry)
+(setf (get 'DEFCBODY 'T2) 't2defCbody)	; Beppe
+;(setf (get 'DEFUNC 'T2)	't2defunC); Beppe
+(setf (get 'FUNCTION-CONSTANT 'T2) 't2function-constant); Beppe
+
+;;; Pass 2 C function generators.
+
+(setf (get 'DEFUN 'T3) #'t3defun)
+(setf (get 'DEFMACRO 'T3) #'t3defmacro)
+(setf (get 'CLINES 'T3) 't3clines)
+(setf (get 'DEFCFUN 'T3) 't3defcfun)
+;(setf (get 'DEFENTRY 'T3) 't3defentry)
+(setf (get 'DEFCBODY 'T3) 't3defCbody)	; Beppe
+;(setf (get 'DEFUNC 'T3) 't3defunC)	; Beppe
+
+;;; Package operations.
+
+(setf (get 'si::select-package 'PACKAGE-OPERATION) t)
+(setf (get 'si::%defpackage 'PACKAGE-OPERATION) t)
+
+;;; Top-level macros.
+
+(setf (get 'defstruct 'TOP-LEVEL-MACRO) t)
+(setf (get 'deftype 'TOP-LEVEL-MACRO) t)
+(setf (get 'defsetf 'TOP-LEVEL-MACRO) t)
+; Handled through t1ordinary:
+;(setf (get 'defconstant 'TOP-LEVEL-MACRO) t)
+;(setf (get 'defparameter 'TOP-LEVEL-MACRO) t)
+
diff --git a/src/cmp/cmptype.lsp b/src/cmp/cmptype.lsp
new file mode 100644
index 000000000..da991d704
--- /dev/null
+++ b/src/cmp/cmptype.lsp
@@ -0,0 +1,261 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPTYPE  Type information.
+
+(in-package "COMPILER")
+
+;;; CL-TYPE is any valid type specification of Common Lisp.
+;;;
+;;; TYPE is a representation type used by ECL.  TYPE is one of:
+;;;
+;;;				T(BOOLEAN)
+;;;
+;;;	FIXNUM  CHARACTER  SHORT-FLOAT  LONG-FLOAT
+;;;	(VECTOR T)  STRING  BIT-VECTOR  (VECTOR FIXNUM)
+;;;	(VECTOR SHORT-FLOAT)  (VECTOR LONG-FLOAT)
+;;;	(ARRAY T)  (ARRAY BASE-CHAR)  (ARRAY BIT)
+;;;	(ARRAY FIXNUM)
+;;;	(ARRAY SHORT-FLOAT)  (ARRAY LONG-FLOAT)
+;;;	STANDARD-OBJECT STRUCTURE-OBJECT
+;;;	SYMBOL
+;;;	UNKNOWN
+;;;
+;;;				NIL
+;;;
+;;;
+;;; immediate-type:
+;;;	FIXNUM		int
+;;;	CHARACTER	char
+;;;	SHORT-FLOAT	float
+;;;	LONG-FLOAT	double
+
+
+;;; Check if THING is an object of the type TYPE.
+;;; Depends on the implementation of TYPE-OF.
+(defun object-type (thing)
+  (let ((type (if thing (type-of thing) 'SYMBOL)))
+    (case type
+      ((FIXNUM SHORT-FLOAT LONG-FLOAT SYMBOL NULL) type)
+      ((BASE-CHAR STANDARD-CHAR CHARACTER EXTENDED-CHAR) 'CHARACTER)
+      ((STRING BIT-VECTOR) type)
+      (VECTOR (list 'VECTOR (array-element-type thing)))
+      (ARRAY (list 'ARRAY (array-element-type thing)))
+      #+clos
+      (STANDARD-OBJECT 'STANDARD-OBJECT)
+      #+clos
+      (STRUCTURE-OBJECT 'STRUCTURE-OBJECT)
+      (t t))))
+
+(defun type-filter (type)
+  (multiple-value-bind (type-name type-args) (sys::normalize-type type)
+    (case type-name
+        ((FIXNUM CHARACTER SHORT-FLOAT LONG-FLOAT SYMBOL) type-name)
+        (SINGLE-FLOAT 'SHORT-FLOAT)
+        (DOUBLE-FLOAT 'LONG-FLOAT)
+        ((SIMPLE-STRING STRING) 'STRING)
+        ((SIMPLE-BIT-VECTOR BIT-VECTOR) 'BIT-VECTOR)
+	((NIL T) t)
+	((SIMPLE-ARRAY ARRAY)
+	 (cond ((endp type-args) '(ARRAY T))		; Beppe
+	       ((eq '* (car type-args)) t)
+	       (t (let ((element-type
+			 (sys::type-for-array (car type-args))))
+		    (if (and (cdr type-args)
+			     (not (eq (second type-args) '*))
+			     (= (length (second type-args)) 1))
+		      (case element-type
+			(BASE-CHAR 'STRING)
+			(BIT 'BIT-VECTOR)
+			(t (list 'VECTOR element-type)))
+		      (list 'ARRAY element-type))))))
+	(INTEGER
+	 (if (sys::sub-interval-p type-args
+				  '#.(list most-negative-fixnum
+					   most-positive-fixnum))
+	   'FIXNUM
+	   t))
+	((SHORT-FLOAT SINGLE-FLOAT) 'SHORT-FLOAT)
+	((LONG-FLOAT DOUBLE-FLOAT) 'LONG-FLOAT)
+	((STREAM) 'STREAM)	; Beppe
+	(t (cond #+clos
+		 ((subtypep type 'STANDARD-OBJECT) type)
+		 #+clos
+		 ((subtypep type 'STRUCTURE-OBJECT) type) 
+		 ((dolist (v '(FIXNUM CHARACTER SHORT-FLOAT LONG-FLOAT
+			       (VECTOR T) STRING BIT-VECTOR
+			       (VECTOR FIXNUM) (VECTOR SHORT-FLOAT)
+			       (VECTOR LONG-FLOAT) (ARRAY BASE-CHAR)
+			       (ARRAY BIT) (ARRAY FIXNUM)
+			       (ARRAY SHORT-FLOAT) (ARRAY LONG-FLOAT)
+			       (ARRAY T))) ; Beppe
+		    (when (subtypep type v) (return v))))
+		 ((eq type-name 'VALUES)
+		  (if (null (cdr type-args))
+		    (list 'VALUES (type-filter (car type-args)))
+		    t))
+		 ((and (eq type-name 'SATISFIES) ; Beppe
+		       (symbolp (car type-args))
+		       (get (car type-args) 'TYPE-FILTER)))
+		 (t t))))))
+
+;;; The algebra of types should be more complete. Beppe
+(defun type-and (type1 type2)
+  (cond ((equal type1 type2) type1)
+        ((eq type1 t) type2)
+	((eq type1 '*) type2)		; optional args
+	((eq type1 'OBJECT) type2)	; Beppe
+	((eq type2 'OBJECT) type1)	; Beppe
+        ((eq type2 t) type1)
+	((eq type2 '*) type1)		; optional args
+	((and (consp type2) (eq (car type2) 'VALUES))
+	 (type-and type1 (second type2)))
+        ((consp type1)
+         (case (car type1)
+               (ARRAY
+                (case (cadr type1)
+                      (BASE-CHAR
+		       (if (eq type2 'STRING)
+			   type2
+			 (if (and (consp type2)	; Beppe
+				  (member (car type2) '(ARRAY VECTOR))
+				  (null (cddr type2))
+				  (type>= 'BASE-CHAR (cadr type2)))
+			     type1 nil)))
+                      (BIT (if (eq type2 'BIT-VECTOR) type2 nil))
+		      ;; Beppe:
+                      (t (case type2
+			   (STRING
+			    (when (type-and (cadr type1) 'BASE-CHAR)
+			      '(ARRAY BASE-CHAR)))
+			   (BIT-VECTOR
+			    (when (type-and (cadr type1) 'BIT)
+			      '(ARRAY BIT)))
+			   ((ARRAY VECTOR) type1)
+			   (t (if (and (consp type2)
+				       (member (car type2) '(ARRAY VECTOR)))
+				  (cond ((type>= (cadr type1) (cadr type2))
+					 type2)
+					((type>= (cadr type2) (cadr type1))
+					 type1))))))))
+               (VECTOR
+                (case (cadr type1)	; Beppe
+                      (BASE-CHAR
+		       (if (eq type2 'STRING)
+			   type2
+			 (if (and (consp type2)	; Beppe
+				  (member (car type2) '(ARRAY VECTOR))
+				  (null (cddr type2))
+				  (type>= 'BASE-CHAR (cadr type2)))
+			     type1 nil)))
+                      (BIT (if (eq type2 'BIT-VECTOR) type2 nil))
+		      ;; Beppe
+                      (t (case type2
+			   (STRING
+			    (when (eq (cadr type1) 'BASE-CHAR) type1))
+			   (BIT-VECTOR
+			    (when (eq (cadr type1) 'BIT) type1))
+			   ((ARRAY VECTOR) type1)
+			   (t (if (and (consp type2)
+				       (member (car type2) '(ARRAY VECTOR)))
+				  (cond ((type>= (cadr type1) (cadr type2))
+					 type2)
+					((type>= (cadr type2) (cadr type1))
+					 type1))))))))
+	       (values (type-and (second type1) type2)))
+	 )
+	((and (consp type2) (eq (car type2) 'OR)) ; Beppe
+	 (do ((types (cdr type2) (cdr types))
+	      (res))
+	     ((null types) nil)
+	     (when (setq res (type-and type1 (car types)))
+	       (return res))))
+        (t (case type1
+                 (STRING
+                  (if (and (consp type2) (eq (car type2) 'ARRAY)
+                           (eq (cadr type2) 'BASE-CHAR))
+                      type1 nil))
+                 (BIT-VECTOR
+                  (if (and (consp type2) (eq (car type2) 'ARRAY)
+                           (eq (cadr type2) 'BIT))
+                      type1 nil))
+                 (FIXNUM-FLOAT
+                  (if (member type2 '(FIXNUM FLOAT SHORT-FLOAT LONG-FLOAT))
+                      type2 nil))
+                 (FLOAT
+                  (if (member type2 '(SHORT-FLOAT LONG-FLOAT))
+                      type2 nil))
+                 ((LONG-FLOAT SHORT-FLOAT)
+                  (if (member type2 '(FIXNUM-FLOAT FLOAT))
+                      type1 nil))
+;;;		 ((SIGNED-CHAR UNSIGNED-CHAR SIGNED-SHORT)
+;;;		  (if (eq type2 'FIXNUM) type1 nil))
+;;;		 ((UNSIGNED-SHORT)
+;;;		  (if (subtypep type1 type2) type1 nil))
+                 (FIXNUM
+		  (case type2
+		    ((bit FIXNUM-FLOAT) 'FIXNUM)
+;;;		    ((SIGNED-CHAR UNSIGNED-CHAR SIGNED-SHORT BIT)
+;;;		     type2)
+;;;		    ((UNSIGNED-SHORT)
+;;;		     (if (subtypep type2 type1) type2 nil))
+		    ))
+		 #+clos
+		 (STANDARD-OBJECT
+                  (if (subtypep type2 'STANDARD-OBJECT) type2 nil))
+		 #+clos
+		 (STRUCTURE-OBJECT
+                  (if (subtypep type2 'STRUCTURE-OBJECT) type2 nil))))))
+
+(defun type>= (type1 type2)
+  (equal (type-and type1 type2) type2))
+
+(defun reset-info-type (info)
+  (if (info-type info)
+      (let ((info1 (copy-info info)))
+           (setf (info-type info1) t)
+           info1)
+      info))
+
+;;;
+;;; and-form-type
+;;;   returns a copy of form whose type is the type-and of type and the form's
+;;;   type
+;;;
+(defun and-form-type (type form original-form)
+  (let* ((type2 (info-type (cadr form)))
+	 (type1 (or (type-and type type2)
+		    (when (subtypep type2 type) type2)))) ; class types. Beppe
+    (if type1
+	(if (eq type1 type2)
+	    form
+	    (let ((info (copy-info (cadr form))))
+	      (setf (info-type info) type1)
+	      (list* (car form) info (cddr form))))
+	(progn
+;	  (cmpwarn "The type of the form ~s is not ~s." original-form type)
+	  (cmperr "The type of the form ~s is not ~s." original-form type)
+	  form))))
+
+(defun check-form-type (type form original-form)
+  (when (null (type-and type (info-type (cadr form))))
+        (cmperr "The type of the form ~s is not ~s." original-form type)))
+;        (cmpwarn "The type of the form ~s is not ~s." original-form type)))
+
+(defun default-init (type)
+  (let ((new-value (getf '(fixnum 0 character #\space long-float 0.0L1
+			   short-float 0.0S1)
+			 type)))
+    (cond (new-value
+	   (cmpwarn "The default value of NIL is not ~s. Using ~s instead."
+		    type new-value)
+	   (c1constant-value new-value nil))
+	  (t
+	   (c1nil)))))
diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp
new file mode 100644
index 000000000..84e4c6289
--- /dev/null
+++ b/src/cmp/cmputil.lsp
@@ -0,0 +1,190 @@
+;;;; CMPUTIL  --  Miscellaneous Functions.
+
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    ECoLisp is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "COMPILER")
+
+(defun cmperr (string &rest args &aux (*print-case* :upcase))
+  (print-current-form)
+  (format t "~&;;; ")
+  (apply #'format t string args)
+  (incf *error-count*)
+  (throw *cmperr-tag* '*cmperr-tag*))
+
+(defun too-many-args (name upper-bound n &aux (*print-case* :upcase))
+  (print-current-form)
+  (format t
+          "~&;;; ~S requires at most ~R argument~:p, ~
+          but ~R ~:*~[were~;was~:;were~] supplied.~%"
+          name
+          upper-bound
+          n)
+  (incf *error-count*)
+  (throw *cmperr-tag* '*cmperr-tag*))
+
+(defun too-few-args (name lower-bound n &aux (*print-case* :upcase))
+  (print-current-form)
+  (format t
+          "~&;;; ~S requires at least ~R argument~:p, ~
+          but only ~R ~:*~[were~;was~:;were~] supplied.~%"
+          name
+          lower-bound
+          n)
+  (incf *error-count*)
+  (throw *cmperr-tag* '*cmperr-tag*))
+
+(defun cmpwarn (string &rest args &aux (*print-case* :upcase))
+  (unless *suppress-compiler-warnings*
+    (print-current-form)
+    (format t "~&;;; Warning: ")
+    (apply #'format t string args)
+    (terpri))
+  nil)
+
+(defun cmpnote (string &rest args &aux (*print-case* :upcase))
+  (unless *suppress-compiler-notes* 
+    (format t "~&;;; Note: ")
+    (apply #'format t string args)
+    (terpri))
+  nil)
+
+(defun print-current-form ()
+  (when *first-error*
+        (setq *first-error* nil)
+        (cond
+         #-:CCL
+         ((and (consp *current-form*)
+               (eq (car *current-form*) 'sys:|#,|))
+          (format t "~&;;; Compiling #,~s.~%" (cdr *current-form*)))
+         (t
+          (let ((*print-length* 2)
+                (*print-level* 2))
+               (format t "~&;;; Compiling ~s.~%" *current-form*)))))
+  nil)
+
+(defun print-emitting (name)
+  (format t "~&;;; Emitting code for ~s.~%" (or name "lambda")))
+
+(defun undefined-variable (sym &aux (*print-case* :upcase))
+  (print-current-form)
+  (format t
+          "~&;;; The variable ~s is undefined.~
+           ~%;;; The compiler will assume this variable is a global.~%"
+          sym)
+  nil)
+
+(defun baboon (&aux (*print-case* :upcase))
+  (print-current-form)
+  (format
+   t "~&;;; A bug was found in the compiler.  Contact attardi@di.unipi.it.~%")
+  (incf *error-count*)
+  (break)
+;  (throw *cmperr-tag* '*cmperr-tag*) DEBUG
+)
+
+(defun cmp-eval (form &aux (throw-flag t))
+  (unless *not-compile-time*
+    (unwind-protect
+	 (prog1
+	     (cmp-toplevel-eval form)
+	   (setq throw-flag nil))
+      (when throw-flag
+	(let ((*print-case* :upcase))
+	  (print-current-form)
+	  (format t "~&;;; The form ~s was not evaluated successfully.~
+                     ~%;;; You are recommended to compile again.~%"
+		  form))))))
+
+
+(defun cmp-macroexpand (form &aux env (throw-flag t))
+  ;; Obtain the local macro environment for expansion.
+  (dolist (v *funs*)
+    (when (consp v)
+      (push v env)))
+  (when env (setq env (cons nil (nreverse env))))
+  (unwind-protect
+      (prog1
+	  (cmp-toplevel-eval `(macroexpand ',form ',env))
+	(setq throw-flag nil))
+    (when throw-flag
+      (let ((*print-case* :upcase))
+	(print-current-form)
+	(format t
+		"~&;;; The macro form ~s was not expanded successfully.~
+                   ~%;;; You are recommended to compile again.~%"
+		form)))))
+
+
+(defun cmp-macroexpand-1 (form &aux env (throw-flag t))
+  (dolist (v *funs*)
+    (when (consp v)
+      (push (list (car v) 'MACRO (cadr v)) env))) 
+  (when env (setq env (cons nil (nreverse env))))
+  (unwind-protect
+      (prog1
+	  (cmp-toplevel-eval `(macroexpand-1 ',form ',env))
+	(setq throw-flag nil))
+    (when throw-flag
+      (let ((*print-case* :upcase))
+	(print-current-form)
+	(format t
+		"~&;;; The macro form ~s was not expanded successfully.~
+                   ~%;;; You are recommended to compile again.~%"
+		form)))))
+	  
+
+(defun cmp-expand-macro (fd fname args &aux env (throw-flag t))
+  (dolist (v *funs*)
+	  (if (consp v) (push (list (car v) 'MACRO (cadr v)) env)))
+  (when env (setq env (cons nil (nreverse env))))
+  (unwind-protect
+      (prog1
+	  (cmp-toplevel-eval
+	   `(funcall *macroexpand-hook* ',fd ',(cons fname args) ',env))
+	(setq throw-flag nil))
+    (if throw-flag
+        (let ((*print-case* :upcase))
+          (print-current-form)
+          (format t
+		  "~&;;; The macro form (~s ...) was not expanded successfully.~
+                   ~%;;; You are recommended to compile again.~%"
+		  fname)))))
+
+(defun cmp-toplevel-eval (form)
+   (let*
+     #-:CCL
+     ((sys::*ihs-base* sys::*ihs-top*)
+      (sys::*ihs-top* (1- (sys::ihs-top)))
+      (*break-enable* *compiler-break-enable*)
+      (sys::*break-hidden-packages*
+       (cons (find-package 'compiler)
+	     sys::*break-hidden-packages*)))
+     #+:CCL
+     ((*break-on-errors* *compiler-break-enable*))
+         (eval form)))
+
+(defun compiler-clear-compiler-properties (symbol)
+  (remprop symbol 'sys::cdefn)
+  #-:CCL
+  (sys::unlink-symbol symbol)
+  (remprop symbol 'package-operation)
+  (remprop symbol 't1)
+  (remprop symbol 't2)
+  (remprop symbol 't3)
+  (remprop symbol 'top-level-macro)
+  (remprop symbol 'c1)
+  (remprop symbol 'c2)
+  (remprop symbol 'c1conditional)
+  (remprop symbol ':inline-always)
+  (remprop symbol ':inline-unsafe)
+  (remprop symbol ':inline-safe)
+  (remprop symbol 'lfun))
+  
diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp
new file mode 100644
index 000000000..a1737ea02
--- /dev/null
+++ b/src/cmp/cmpvar.lsp
@@ -0,0 +1,471 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPVAR  Variables.
+
+(in-package "COMPILER")
+
+#|
+;;; Use a structure of type vector to avoid creating
+;;; normal structures before booting CLOS:
+(defstruct (var (:type vector) :named)
+  name		;;; Variable name.
+  (ref 0 :type fixnum)
+		;;; Number of references to the variable (-1 means IGNORE).
+		;;; During Pass 2: set below *register-min* for non register.
+  ref-ccb	;;; Cross closure reference: T or NIL.
+  kind		;;; One of LEXICAL, SPECIAL, GLOBAL, OBJECT, FIXNUM,
+  		;;; CHARACTER, LONG-FLOAT, SHORT-FLOAT, or REPLACED (used for
+		;;; LET variables).
+  (loc 'OBJECT)	;;; During Pass 1: indicates whether the variable can
+		;;; be allocated on the c-stack: OBJECT means
+		;;; the variable is declared as OBJECT, and CLB means
+		;;; the variable is referenced across Level Boundary and thus
+		;;; cannot be allocated on the C stack.  Note that OBJECT is
+		;;; set during variable binding and CLB is set when the
+		;;; variable is used later, and therefore CLB may supersede
+		;;; OBJECT.
+		;;; During Pass 2:
+  		;;; For REPLACED: the actual location of the variable.
+  		;;; For FIXNUM, CHARACTER, LONG-FLOAT, SHORT-FLOAT, OBJECT:
+  		;;;   the cvar for the C variable that holds the value.
+  		;;; For LEXICAL: the frame-relative address for the variable.
+		;;; For SPECIAL and GLOBAL: the vv-index for variable name.
+  (type t)	;;; Type of the variable.
+  (index -1)    ;;; position in *vars*. Used by similar.
+  ) |#
+
+;;; A special binding creates a var object with the kind field SPECIAL,
+;;; whereas a special declaration without binding creates a var object with
+;;; the kind field GLOBAL.  Thus a reference to GLOBAL may need to make sure
+;;; that the variable has a value.
+
+;;;  Bootstrap problem: proclaim needs this function:
+(defun sch-global (name)
+  (dolist (var *undefined-vars* nil)
+    (declare (type var var))
+    (when (eq (var-name var) name)
+      (return-from sch-global var))))
+
+;;;
+;;; Check if a variable has been declared as a special variable with a global
+;;; value.
+
+(defun check-global (name)
+  (let ((x (assoc name *objects*)))
+    (when x
+      (dolist (tlf *top-level-forms*)
+        (when (or (and (eq (car tlf) 'DEFVAR)
+		       (= (var-loc (second tlf)) (second x)))
+		  (and (eq (car tlf) 'DECLARE)
+		       (= (second tlf) (second x))))
+          (return tlf))))))
+
+;;;
+;;; Check if the symbol has a symbol macro
+;;;
+(defun chk-symbol-macrolet (symbol)
+  (do ((form symbol))
+      ((not (symbolp form)) form)
+    (dolist (v *vars*
+	     ;; At the end, loof for a DEFINE-SYMBOL-MACRO definition
+	     (let ((expansion (get form 'si::symbol-macro)))
+	       (if expansion
+		 (setq form expansion)
+		 (return-from chk-symbol-macrolet form))))
+      ;; Search for a SYMBOL-MACROLET definition
+      (cond ((and (consp v) (eq (first v) form))
+	     (setq form (second v))
+	     (return))
+	    ((symbolp v))
+	    ((eq (var-name v) form)
+	     ;; Any macro definition has been shadowed by LET/LET*, etc.
+	     (return-from chk-symbol-macrolet form))))))
+
+;;; During Pass 1, *vars* emulates the environment: it holds a list of var
+;;; objects and the symbols 'CB' (Closure Boundary) and 'LB' (Level Boundary).
+;;; 'CB' is pushed on *vars* when the compiler begins to process a closure.
+;;; 'LB' is pushed on *vars* when *level* is incremented.
+;;; *GLOBALS* holds a list of var objects for those variables that are
+;;; not defined.  This list is used only to suppress duplicated warnings when
+;;; undefined variables are detected.
+
+(defun c1make-var (name specials ignores types &aux x)
+  (let ((var (make-var :name name)))
+    (declare (type var var))		; Beppe
+    (cmpck (not (symbolp name)) "The variable ~s is not a symbol." name)
+    (cmpck (constantp name) "The constant ~s is being bound." name)
+
+    (cond ((or (member name specials) (sys:specialp name)
+               (check-global name))	;; added. Beppe 17 Aug 1987
+           
+           (setf (var-kind var) 'SPECIAL)
+           (setf (var-loc var) (add-symbol name))
+           (cond ((setq x (assoc name types))
+                  (setf (var-type var) (cdr x)))
+                 ((setq x (get name 'CMP-TYPE))
+                  (setf (var-type var) x)))
+           (setq *special-binding* t))
+          (t
+           (dolist (v types)
+             (when (eq (car v) name)
+               (case (cdr v)
+;                 (OBJECT (setf (var-loc var) 'OBJECT))
+                 (REGISTER
+                  (incf (var-ref var) 100))
+                 (t (setf (var-type var) (cdr v))))))
+;           (when (or (null (var-type var))
+;                     (eq t (var-type var)))
+;             (setf (var-loc var) 'OBJECT))
+           ;; :READ-ONLY variable treatment.
+;           (when (eq 'READ-ONLY (var-type var))
+;             (setf (var-type var) 't))
+           (setf (var-kind var) 'LEXICAL))) ; we rely on check-vref to fix it
+    (when (member name ignores) (setf (var-ref var) -1)) ; IGNORE.
+    var)
+  )
+
+(defun check-vref (var)
+  (when (and (eq (var-kind var) 'LEXICAL)
+             (not (var-ref-ccb var)))
+    (when (zerop (var-ref var)) ;;; This field may be -1 (IGNORE). Beppe
+        (cmpwarn "The variable ~s is not used." (var-name var)))
+    (when (not (eq (var-loc var) 'CLB))
+      ;; if the variable can be stored locally, set it var-kind to its type
+      (setf (var-kind var)
+	    (if (> (var-ref var) 1)
+		(let ((type (var-type var)))
+		  (cond ((type>= 'FIXNUM type) 'FIXNUM)
+			((type>= 'CHARACTER type) 'CHARACTER)
+			((type>= 'LONG-FLOAT type) 'LONG-FLOAT)
+			((type>= 'SHORT-FLOAT type) 'SHORT-FLOAT)
+			(t 'OBJECT)))
+		'OBJECT))))
+  )
+
+(defun c1var (name)
+  (let ((info (make-info))
+        (vref (c1vref name)))
+    (push (car vref) (info-referred-vars info))
+    (push (car vref) (info-local-referred info))
+    (setf (info-type info) (var-type (car vref)))
+    (list 'VAR info vref))
+  )
+
+;;; A variable reference (vref for short) is a list: pair
+;;;	( var-object ) Beppe(ccb) ccb-reference )
+
+(defun c1vref (name &aux (ccb nil) (clb nil))
+  (dolist (var *vars*)
+    (declare (type var var))
+    (cond ((eq var 'CB) (setq ccb t))	; closure boundary
+          ((eq var 'LB) (setq clb t))	; level boundary
+	  ((and (consp var) (eq (first var) name)) ; symbol macrolet
+	   (c1expr (second var)))
+          ((eq (var-name var) name)
+           (when (minusp (var-ref var)) ; IGNORE.
+             (cmpwarn "The ignored variable ~s is used." name)
+             (setf (var-ref var) 0))
+	   (when (eq (var-kind var) 'LEXICAL)
+	     (cond (ccb (setf (var-ref-ccb var) t
+			      (var-loc var) 'OBJECT)) ; replace a previous 'CLB
+		   (clb (setf (var-loc var) 'CLB))))
+           (incf (var-ref var))
+           (return-from c1vref (list var))))) ; ccb
+  (let ((var (sch-global name)))
+    (unless var
+      (if *compile-time-too* 
+        (unless (sys:specialp name) (undefined-variable name))
+        (unless (or (sys:specialp name)
+                    (check-global name))
+          (undefined-variable name)))
+      (setq var (make-var :name name
+                          :kind 'GLOBAL
+                          :loc (add-symbol name)
+                          :type (or (get name 'CMP-TYPE) t)))
+      (push var *undefined-vars*))
+    (list var))				; ccb
+  )
+
+;;; At each variable binding, the variable is added to *vars* which
+;;; emulates the environment.
+;;; The index is computed, which is used by similar to compare functions.
+;;;
+(defun push-vars (v)
+  (setf (var-index v) (length *vars*))
+  (push v *vars*))
+
+(defun unboxed (var)
+  (member (var-kind var) '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT)
+          :test #'eq))
+
+(defun local (var)
+  (car (member (var-kind var) '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT)
+	       :test #'eq)))
+
+(defun c2var (vref) (unwind-exit (cons 'VAR vref)))
+
+(defun c2location (loc) (unwind-exit loc))
+
+(defun wt-var (var &aux (var-loc (var-loc var))) ; ccb
+  (declare (type var var))
+  (case (var-kind var)
+    (LEXICAL (cond ;(ccb (wt-env var-loc))
+                   ((var-ref-ccb var) (wt-env var-loc))
+                   (t (wt-lex var-loc))))
+    (SPECIAL (wt "(VV[" var-loc "]->symbol.dbind)"))
+    (REPLACED (wt var-loc))
+    (GLOBAL (if *safe-compile*
+              (wt "symbol_value(VV[" var-loc "])")
+              (wt "(VV[" var-loc "]->symbol.dbind)")))
+    (t (case (var-kind var)
+         (FIXNUM    (wt "MAKE_FIXNUM"))
+         (CHARACTER (wt "code_char"))
+         (LONG-FLOAT (wt "make_longfloat"))
+         (SHORT-FLOAT (wt "make_shortfloat"))
+         (OBJECT)
+         (t (baboon)))
+       (wt "(") (wt-lcl var-loc) (wt ")"))
+    ))
+
+(defun set-var (loc var &aux (var-loc (var-loc var))) ;  ccb
+  (unless (and (consp loc)
+               (eq (car loc) 'VAR)
+               (eq (second loc) var)
+;               (eq (third loc) ccb)
+	       )
+    (case (var-kind var)
+      (LEXICAL (wt-nl)
+               (if (var-ref-ccb var)
+		   (wt-env var-loc)
+		   (wt-lex var-loc))
+               (wt "= " loc ";"))
+      (SPECIAL (wt-nl "(VV[" var-loc "]->symbol.dbind)= " loc ";"))
+      (GLOBAL
+       (if *safe-compile*
+         (wt-nl "set(VV[" var-loc "]," loc ");")
+         (wt-nl "(VV[" var-loc "]->symbol.dbind)= " loc ";")))
+      (t
+       (wt-nl) (wt-lcl var-loc) (wt "= ")
+       (case (var-kind var)
+         (FIXNUM (wt-fixnum-loc loc))
+         (CHARACTER (wt-character-loc loc))
+         (LONG-FLOAT (wt-long-float-loc loc))
+         (SHORT-FLOAT (wt-short-float-loc loc))
+         (OBJECT (wt-loc loc))
+         (t (baboon)))
+       (wt ";"))
+      )))
+
+(defun set-lex (loc lex)
+  (unless (and (consp loc)
+               (eq (car loc) 'LEX)
+               (equal (second loc) lex))
+    (wt-nl) (wt-lex lex) (wt "= " loc ";")))
+          
+(defun wt-lex (lex)
+  (if (consp lex)
+    (wt "lex" (car lex) "[" (cdr lex) "]")
+    (wt-lcl lex)))
+
+;;; reference to variable of inner closure.
+(defun wt-env (clv) (wt "*CLV" clv))
+
+;;; ----------------------------------------------------------------------
+
+(defun c1add-globals (globals)
+  (dolist (name globals)
+    (push (make-var :name name
+                    :kind 'GLOBAL
+                    :loc (add-symbol name)
+                    :type (let ((x (get name 'CMP-TYPE))) (if x x t))
+                    )
+          *vars*))
+  )
+
+(defun c1setq (args)
+  (cond ((endp args) (c1nil))
+        ((endp (cdr args)) (too-few-args 'SETQ 2 1))
+        ((endp (cddr args)) (c1setq1 (car args) (second args)))
+        (t
+         (do ((pairs args (cddr pairs))
+              (forms nil))
+             ((endp pairs) (c1expr (cons 'PROGN (nreverse forms))))
+             (declare (object pairs))
+             (cmpck (endp (cdr pairs))
+                    "No form was given for the value of ~s." (car pairs))
+             (push (list 'SETQ (car pairs) (second pairs)) forms)
+             )))
+  )
+
+(defun c1setq1 (name form &aux (info (make-info)) type form1 name1)
+  (cmpck (not (symbolp name)) "The variable ~s is not a symbol." name)
+  (cmpck (constantp name) "The constant ~s is being assigned a value." name)
+  (setq name (chk-symbol-macrolet name))
+  (unless (symbolp name)
+    (return-from c1setq1 (c1expr `(setf ,name ,form))))
+  (setq name1 (c1vref name))
+  (pushnew (car name1) (info-changed-vars info))
+  (pushnew (car name1) (info-referred-vars info))
+  (pushnew (car name1) (info-local-referred info))
+  (setq form1 (c1expr form))
+  (add-info info (second form1))
+  (setq type (type-and (var-type (car name1)) (info-type (second form1))))
+  (unless type
+    (cmpwarn "Type mismatch between ~s and ~s." name form)
+    (setq type T))
+  (unless (eq type (info-type (second form1)))
+    (let ((info1 (copy-info (second form1))))
+         (setf (info-type info1) type)
+         (setq form1 (list* (car form1) info1 (cddr form1)))))
+  (setf (info-type info) type)
+  (list 'SETQ info name1 form1)
+  )
+
+(defun c2setq (vref form &aux (dest (cons 'VAR vref)))
+  (let ((*destination* dest)) (c2expr* form))
+  (if (eq (car form) 'LOCATION)
+    (c2location (third form))
+    (unwind-exit dest))
+  )
+
+(defun c1progv (args &aux symbols values (info (make-info)) forms)
+  (when (or (endp args) (endp (cdr args)))
+        (too-few-args 'PROGV 2 (length args)))
+  (setq symbols (c1expr* (car args) info))
+  (setq values (c1expr* (second args) info))
+  (setq forms (c1progn (cddr args)))
+  (add-info info (second forms))
+  (list 'PROGV info symbols values forms)
+  )
+
+(defun c2progv (symbols values body
+                &aux (*unwind-exit* *unwind-exit*))
+  (let* ((*lcl* *lcl*)
+         (lcl (next-lcl))
+         (sym-loc (list 'LCL (next-lcl)))
+         (val-loc (list 'LCL (next-lcl))))
+    (wt-nl "{cl_object " sym-loc "," val-loc ";")
+    (wt-nl "bds_ptr ") (wt-lcl lcl) (wt "=bds_top;")
+    (push lcl *unwind-exit*)
+    
+    (let ((*destination* sym-loc)) (c2expr* symbols))
+    
+    (let ((*destination* val-loc)) (c2expr* values))
+    
+    (wt-nl "while(!endp(" sym-loc ")) {")
+    (when *safe-compile*
+      (wt-nl "if(type_of(CAR(" sym-loc "))!=t_symbol)")
+      (wt-nl
+       "FEinvalid_variable(\"~s is not a symbol.\",CAR(" sym-loc "));"))
+    (wt-nl "if(endp(" val-loc "))bds_bind(CAR(" sym-loc "),OBJNULL);")
+    (wt-nl "else{bds_bind(CAR(" sym-loc "),CAR(" val-loc "));")
+    (wt-nl val-loc "=CDR(" val-loc ");}")
+    (wt-nl sym-loc "=CDR(" sym-loc ");}")
+
+    (c2expr body)
+    (wt "}")
+    )
+  )
+
+(defun c1psetq (old-args &aux (args nil) (use-psetf nil) (vrefs nil) (forms nil)
+                          (info (make-info :type '(MEMBER NIL))))
+  (do (var (l old-args (cddr l)))
+      ((endp l))
+      (declare (object l))
+      (setq var (car l))
+      (cmpck (not (symbolp var))
+             "The variable ~s is not a symbol." var)
+      (cmpck (endp (cdr l))
+             "No form was given for the value of ~s." var)
+      (setq var (chk-symbol-macrolet var))
+      (setq args (list* var (second l) args))
+      (if (symbolp var)
+	(cmpck (constantp var)
+	       "The constant ~s is being assigned a value." var)
+	(setq use-psetf t)))
+  (when use-psetf
+    (return-from c1psetq (c1expr `(psetf ,@args))))
+  (do ((l args (cddr l)))
+      ((endp l))
+      (let* ((vref (c1vref (car l)))
+             (form (c1expr (second l)))
+             (type (type-and (var-type (car vref))
+                             (info-type (second form)))))
+            (unless (equal type (info-type (second form)))
+              (let ((info1 (copy-info (second form))))
+		(setf (info-type info1) type)
+		(setq form (list* (car form) info1 (cddr form)))))
+            (push vref vrefs)
+            (push form forms)
+            (push (car vref) (info-changed-vars info))
+            (add-info info (cadar forms)))
+      )
+  (list 'PSETQ info (nreverse vrefs) (nreverse forms))
+  )
+
+(defun var-referred-in-forms (var forms)
+  (case (var-kind var)
+    ((LEXICAL REPLACED FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT)
+     (dolist (form forms nil)
+       (when (member var (info-referred-vars (second form)))
+	 (return-from var-referred-in-forms t))))
+    (t (dolist (form forms nil)
+	 (when (or (member var (info-referred-vars (second form)))
+		   (info-sp-change (second form)))
+	   (return-from var-referred-in-forms t))))
+    ))
+
+(defun c2psetq (vrefs forms &aux (*lcl* *lcl*) (saves nil) (blocks 0))
+  ;; similar to inline-args
+  (do ((vrefs vrefs (cdr vrefs))
+       (forms forms (cdr forms))
+       (var) (form))
+      ((null vrefs))
+    (setq var (caar vrefs)
+	  form (car forms))
+    (if (or (var-changed-in-forms var (cdr forms))
+            (var-referred-in-forms var (cdr forms)))
+        (case (car form)
+          (LOCATION (push (cons var (third form)) saves))
+          (otherwise
+            (if (local var)
+                (let* ((kind (var-kind var))
+                       (lcl (next-lcl))
+		       (temp (list 'VAR (make-var :kind kind :loc lcl))))
+                  (wt-nl "{" *volatile* (rep-type kind)) (wt-lcl lcl) (wt ";")
+                  (incf blocks)
+                  (let ((*destination* temp)) (c2expr* form))
+                  (push (cons var temp) saves))
+                (let ((*destination* (list 'TEMP (next-temp))))
+                  (c2expr* form)
+                  (push (cons var *destination*) saves)))))
+        (let ((*destination* (cons 'VAR (car vrefs)))) (c2expr* form))))
+  (dolist (save saves) (set-var (cdr save) (car save)))
+  (dotimes (i blocks) (wt "}"))
+  (unwind-exit nil)
+  )
+
+;;; ----------------------------------------------------------------------
+
+(setf (get 'VAR 'C2) 'c2var)
+(setf (get 'LOCATION 'C2) 'c2location)
+(setf (get 'SETQ 'c1special) 'c1setq)
+(setf (get 'SETQ 'C2) 'c2setq)
+(setf (get 'PROGV 'c1special) 'c1progv)
+(setf (get 'PROGV 'C2) 'c2progv)
+(setf (get 'PSETQ 'c1) 'c1psetq)
+(setf (get 'PSETQ 'C2) 'c2psetq)
+
+(setf (get 'VAR 'SET-LOC) 'set-var)
+(setf (get 'VAR 'WT-LOC) 'wt-var)
+
+(setf (get 'LEX 'SET-LOC) 'set-lex)
+(setf (get 'LEX 'WT-LOC) 'wt-lex)
diff --git a/src/cmp/cmpwt.lsp b/src/cmp/cmpwt.lsp
new file mode 100644
index 000000000..a8ff29a89
--- /dev/null
+++ b/src/cmp/cmpwt.lsp
@@ -0,0 +1,149 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;; CMPWT  Output routines.
+
+(in-package "COMPILER")
+
+(defvar *wt-string-size* 0)
+
+;;; Each lisp compiled file consists on code and a data section. Whenever an
+;;; #'in-package toplevel form is found, a read-time evaluated expression is
+;;; inserted in the data section which changes the current package for the
+;;; rest of it. This way it is possible to save some space by writing the
+;;; symbol's package only when it does not belong to the current package.
+
+(defun wt-comment (message &optional symbol)
+  (if symbol
+    (progn
+      (terpri *compiler-output1*)
+      (princ "/*	" *compiler-output1*)
+      (princ message *compiler-output1*))
+    (if (symbol-package message)
+	(progn
+	  (format *compiler-output1* "~50T/*  ")
+	  (setq symbol message))
+	;; useless to show gensym's
+	(return-from wt-comment)))
+  (let* ((s (symbol-name symbol))
+         (l (1- (length s)))
+         c)
+    (declare (string s) (fixnum l) (character c))
+    (dotimes (n l)
+      (setq c (schar s n))
+      (princ c *compiler-output1*)
+      (when (and (char= c #\*) (char= (schar s (1+ n)) #\/))
+        (princ #\\ *compiler-output1*)))
+    (princ (schar s l) *compiler-output1*))
+  (format *compiler-output1* "~70T*/")
+  nil
+  )
+
+(defun wt1 (form)
+  (typecase form
+    ((or STRING INTEGER CHARACTER)
+     (princ form *compiler-output1*))
+    ((or LONG-FLOAT SHORT-FLOAT)
+     (format *compiler-output1* "~10,,,,,,'eG" form))
+    (VAR (wt-var form))
+    (t (wt-loc form)))
+  nil)
+
+(defun wt-h1 (form)
+  (if (consp form)
+    (let ((fun (get (car form) 'wt)))
+      (if fun
+        (apply fun (cdr form))
+        (cmperr "The location ~s is undefined." form)))
+    (princ form *compiler-output2*))
+  nil)
+
+;;; This routine converts lisp data into C-strings. We have to take
+;;; care of escaping special characteres with backslashes.
+;;;
+;;; FIXME! With some compilers (GCC, for instance), four backslashes
+;;; at the end of a line are turned into a single backslash!!!!
+;;; Current fix is ugly.
+(defun wt-filtered-data (string)
+  (let ((N (length string)))
+    (incf *wt-string-size* (1+ N)) ; 1+ accounts for newline
+    (terpri *compiler-output-data*)
+    (dotimes (i N)
+      (let ((x (aref string i)))
+	(cond
+	  ((or (< (char-code x) 32)
+	       (> (char-code x) 127))
+	   (case x
+	     ; We avoid a trailing backslash+newline because some preprocessors
+	     ; remove them.
+	     (#\Newline
+	      (if (and (> i 0) (char= (aref string (1- i)) #\\))
+		(princ "\\n" *compiler-output-data*)
+		(princ #\Newline *compiler-output-data*)))
+	     (#\Tab (princ "\\t" *compiler-output-data*))
+	     (t (format *compiler-output-data* "\\~3,'0o" (char-code x)))))
+	  ((char= x #\\)
+	   (princ "\\\\" *compiler-output-data*))
+	  ((char= x #\")
+	   (princ "\\\"" *compiler-output-data*))
+	  (t (princ x *compiler-output-data*)))))
+    string))
+
+;;; This routine outputs some data into the C file data section. The objects
+;;; which are output include all symbols and all constants. To avoid
+;;; superfluous package names when printing symbols, we bind *package* to the
+;;; package of the last in-package form before printing anything.
+(defvar *compiler-package* (find-package "CL"))
+
+(defun wt-data (expr)
+  (let ((*print-radix* nil)
+        (*print-base* 10)
+        (*print-circle* t)
+        (*print-pretty* nil)
+        (*print-level* nil)
+        (*print-length* nil)
+        (*print-case* :downcase)
+        (*print-gensym* t)
+        (*print-array* t)
+	(*read-default-float-format* 'single-float)
+	;(*package* *compiler-package*)
+	;(sys::*print-package* *compiler-package*)
+	(sys::*print-package* (symbol-package 'nil))
+        (sys::*print-structure* t))
+    (wt-filtered-data
+     (typecase expr
+       (COMPILED-FUNCTION
+	(prin1-to-string (sys:compiled-function-name expr)))
+       (PACKAGE
+	(format nil "~%#.(find-package ~S)" (package-name expr)))
+       (t (prin1-to-string expr))))
+    nil))
+
+(defun wt-data-begin ()
+  (setq *wt-string-size* 0)
+  (princ #\" *compiler-output-data*)
+  (wt-filtered-data (format nil "#!0 ~s" "CL"))
+  nil)
+
+(defun wt-data-end ()
+  (princ #\" *compiler-output-data*))
+
+(defun wt-data-package-operation (form)
+  (ecase (car form)
+    (si::select-package
+     (t1ordinary form)
+     (cmp-eval form)
+     (let ((package-name (cadr form)))
+       (setq *compiler-package* (si::select-package package-name))
+       #+nil(wt-filtered-data (format nil "#!0 ~s" (string package-name)))))
+    (si::%defpackage
+     (t1ordinary `(eval ',form))
+     (wt-filtered-data (format nil "#!1 ~s" (second form)))
+     (cmp-eval form))))
\ No newline at end of file
diff --git a/src/cmp/defsys.lsp.in b/src/cmp/defsys.lsp.in
new file mode 100644
index 000000000..dc11f4733
--- /dev/null
+++ b/src/cmp/defsys.lsp.in
@@ -0,0 +1,46 @@
+;;; ----------------------------------------------------------------------
+;;;	CLOS
+;;; ----------------------------------------------------------------------
+
+(defparameter
+  *cmp-modules*
+  ;; file	load		compile			files which force
+  ;;		environment	environment		recompilations of
+  ;;							this file
+  '(
+    (cmpdefs	()		()			())
+    (cmpmac	()		()			())
+    (cmpinline	()		()			())
+    (cmputil	()		()			())
+    (cmptype	()		()			())
+    (cmpbind	()		()			())
+    (cmpblock	()		()			())
+    (cmpcall	()		()			())
+    (cmpcatch	()		()			())
+    (cmpenv	()		()			())
+    (cmpeval	()		()			())
+    (cmpexit	()		()			())
+    (cmpflet	()		()			())
+    (cmpfun	()		()			())
+    (cmpif	()		()			())
+    (cmplam	()		()			())
+    (cmplet	()		()			())
+    (cmploc	()		()			())
+    (cmpmap	()		()			())
+    (cmpmulti	()		()			())
+    (cmpspecial	()		()			())
+    (cmptag	()		()			())
+    (cmptop	()		()			())
+    (cmpvar	()		()			())
+    (cmpwt	()		()			())
+    (cmpmain	()		()			())
+    (cmpcfg	()		()			())
+    (sysfun	()		()			())))
+
+(sbt:defsystem 
+ cmp
+ :modules *cmp-modules*
+ :source-directory '("@srcdir@/" "@builddir@/cmp/")
+ :fasl-directory "@builddir@/cmp/"
+ :library-directory "@builddir@/")
+
diff --git a/src/cmp/load.lsp.in b/src/cmp/load.lsp.in
new file mode 100644
index 000000000..eb32e6800
--- /dev/null
+++ b/src/cmp/load.lsp.in
@@ -0,0 +1,29 @@
+
+(load "@srcdir@/cmpdefs")
+(load "@srcdir@/cmpmac")
+(load "@srcdir@/cmpinline")
+(load "@srcdir@/cmputil")
+(load "@srcdir@/cmptype")
+(load "@srcdir@/cmpbind")
+(load "@srcdir@/cmpblock")
+(load "@srcdir@/cmpcall")
+(load "@srcdir@/cmpcatch")
+(load "@srcdir@/cmpenv")
+(load "@srcdir@/cmpeval")
+(load "@srcdir@/cmpexit")
+(load "@srcdir@/cmpflet")
+(load "@srcdir@/cmpfun")
+(load "@srcdir@/cmpif")
+(load "@srcdir@/cmplam")
+(load "@srcdir@/cmplet")
+(load "@srcdir@/cmploc")
+(load "@srcdir@/cmpmap")
+(load "@srcdir@/cmpmulti")
+(load "@srcdir@/cmpspecial")
+(load "@srcdir@/cmptag")
+(load "@srcdir@/cmptop")
+(load "@srcdir@/cmpvar")
+(load "@srcdir@/cmpwt")
+(load "@srcdir@/cmpmain")
+(load "@srcdir@/sysfun")
+(load "@builddir@/cmp/cmpcfg.lsp")
diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp
new file mode 100644
index 000000000..5267187cb
--- /dev/null
+++ b/src/cmp/sysfun.lsp
@@ -0,0 +1,1141 @@
+;;; CMPSYSFUN   Database for system functions.
+;;;
+;;; Copyright (c) 1991, Giuseppe Attardi. All rights reserved.
+;;;    Copying of this file is authorized to users who have executed the true
+;;;    and proper "License Agreement for ECoLisp".
+
+;;;
+;;; For each system function it provides:
+;;;
+;;; 	name		of corresponding C function
+;;;	argtypes	(list of types of arguments, * means optionals)
+;;;	return-type
+;;;	never-change-special-var-p
+;;;	predicate
+;;;	optimizers
+;;;
+;;; An optimizer is a property list:
+;;;	{ property inline-info }*
+;;;
+;;; Valid property names are:
+;;;  :INLINE-ALWAYS
+;;;  :INLINE-SAFE	safe-compile only
+;;;  :INLINE-UNSAFE	non-safe-compile only
+;;;
+;;; An inline-info is:
+;;; ( types { type | boolean } side-effect new-object { string | function } ).
+;;; string is:
+;;; [@i..;]Cexpr(#0, ..., #n)
+;;; where #0 indicates the first argument. The optional @i indicates an
+;;; argument to be saved into a variable before evaluating Cexpr.
+
+;;; The following flag:
+;;;	side-effect-p
+;;; which is repeated in each optimizer, could be supplied just once
+;;; per function, while
+;;;	allocates-new-storage
+;;; could be just eliminated since we use a conservative GC.
+
+(in-package "COMPILER")
+
+(defun defsysfun (fname cname-string &optional
+		  arg-types return-type
+		  never-change-special-var-p predicate
+		  &rest optimizers)
+  ;; The value NIL for each parameter except for fname means "not known".
+  ;; optimizers is a list of alternating {safety inline-info}* as above.
+  (when cname-string (setf (get fname 'Lfun) cname-string))
+  (when arg-types
+    (setf (get fname 'arg-types)
+	  (mapcar #'(lambda (x) (if (eql x '*) '* (type-filter x)))
+		  arg-types)))
+  (when (and return-type (not (eq 'T return-type)))
+    (setf (get fname 'return-type) (type-filter return-type)))
+  (when never-change-special-var-p (setf (get fname 'no-sp-change) t))
+  (when predicate (setf (get fname 'predicate) t))
+  (remprop fname ':inline-always)
+  (remprop fname ':inline-safe)
+  (remprop fname ':inline-unsafe)
+  (do ((scan optimizers (cddr scan))
+       (safety) (inline-info))
+      ((null scan))
+      (setq safety (first scan)
+	    inline-info (second scan))
+      (push inline-info (get fname safety)))
+  )
+
+; file alloc.c
+#-boehm-gc
+(mapcar #'(lambda (x) (apply #'defsysfun x)) '(
+(si::ALLOC "siLalloc")
+(si::NPAGE "siLnpage")
+(si::MAXPAGE "siLmaxpage")
+(si::ALLOC-CONTPAGE "siLalloc_contpage")
+(si::NCBPAGE "siLncbpage")
+(si::MAXCBPAGE "siLmaxcbpage")
+(si::ALLOC-RELPAGE "siLalloc_relpage")
+(si::NRBPAGE "siLnrbpage")
+(si::GET-HOLE-SIZE "siLget_hole_size")
+(si::SET-HOLE-SIZE "siLset_hole_size")))
+
+(mapcar #'(lambda (x) (apply #'defsysfun x)) '(
+(si::RPLACA-NTHCDR "siLrplaca_nthcdr" nil T)
+(si::LIST-NTH "siLlist_nth" nil T)
+(si::MAKE-PURE-ARRAY "siLmake_pure_array" nil array)
+(si::MAKE-VECTOR "siLmake_vector" nil vector)
+;(si::MAKE-BITVECTOR "siLmake_bitvector" nil bit-vector nil nil)
+(AREF "Laref" (array *) T NIL NIL
+	:inline-unsafe ((t t t) t nil t
+		"@0;aref(#0,fix(#1)*(#0)->array.dims[1]+fix(#2))")
+	:inline-unsafe (((array t) t t) t nil nil
+		"@0;(#0)->array.self.t[fix(#1)*(#0)->array.dims[1]+fix(#2)]")
+	:inline-unsafe (((array bit) t t) fixnum nil nil
+		"@0;aref_bv(#0,fix(#1)*(#0)->array.dims[1]+fix(#2))")
+	:inline-unsafe (((array t) fixnum fixnum) t nil nil
+		"@0;(#0)->array.self.t[#1*(#0)->array.dims[1]+#2]")
+	:inline-unsafe (((array bit) fixnum fixnum) fixnum nil nil
+		"@0;aref_bv(#0,(#1)*(#0)->array.dims[1]+#2)")
+	:inline-unsafe (((array base-char) fixnum fixnum) character nil nil
+		"@0;(#0)->string.self[#1*(#0)->array.dims[1]+#2]")
+	:inline-unsafe (((array long-float) fixnum fixnum) long-float nil nil
+		"@0;(#0)->array.self.lf[#1*(#0)->array.dims[1]+#2]")
+	:inline-unsafe (((array short-float) fixnum fixnum) short-float nil nil
+		"@0;(#0)->array.self.sf[#1*(#0)->array.dims[1]+#2]")
+	:inline-unsafe (((array fixnum) fixnum fixnum) fixnum nil nil
+		"@0;(#0)->array.self.fix[#1*(#0)->array.dims[1]+#2]")
+
+	:inline-always ((t t) t nil t "aref1(#0,fixint(#1))")
+	:inline-always ((t fixnum) t nil t "aref1(#0,#1)")
+	:inline-unsafe ((t t) t nil t "aref1(#0,fix(#1))")
+	:inline-unsafe ((t fixnum) t nil t "aref1(#0,#1)")
+	:inline-unsafe (((array t) t) t nil nil "(#0)->vector.self.t[fix(#1)]")
+	:inline-unsafe (((array bit) t) fixnum nil nil "aref_bv(#0,fix(#1))")
+	:inline-unsafe (((array t) fixnum) t nil nil "(#0)->vector.self.t[#1]")
+	:inline-unsafe (((array bit) fixnum) fixnum nil nil "aref_bv(#0,#1)")
+	:inline-unsafe (((array base-char) fixnum) fixnum nil nil
+		"(#0)->string.self[#1]")
+	:inline-unsafe (((array base-char) fixnum) character nil nil
+		"(#0)->string.self[#1]")
+	:inline-unsafe (((array long-float) fixnum) long-float nil nil
+		"(#0)->array.self.lf[#1]")
+	:inline-unsafe (((array short-float) fixnum) short-float nil nil
+		"(#0)->array.self.sf[#1]")
+	:inline-unsafe (((array fixnum) fixnum) fixnum nil nil
+		"(#0)->array.self.fix[#1]"))
+(SI::ASET "siLaset" (T ARRAY *) NIL NIL NIL
+	:inline-unsafe ((t t t t) t t nil
+		"@0;aset(#1,fix(#2)*(#1)->array.dims[1]+fix(#3),#0)")
+	:inline-unsafe ((t t fixnum fixnum) t t nil
+		"@0;aset(#1,(#2)*(#1)->array.dims[1]+(#3),#0)")
+	:inline-unsafe ((t (array t) fixnum fixnum) t t nil
+		"@1;(#1)->array.self.t[#2*(#1)->array.dims[1]+#3]= #0")
+	:inline-unsafe ((t (array bit) fixnum fixnum) fixnum t nil
+		"@0;aset_bv(#1,(#2)*(#1)->array.dims[1]+(#3),fix(#0))")
+
+	:inline-unsafe
+	((character (array base-char) fixnum fixnum) character t nil
+		"@1;(#1)->string.self[#2*(#1)->array.dims[1]+#3]= #0")
+	:inline-unsafe 
+	((long-float (array long-float) fixnum fixnum) long-float t nil
+		"@1;(#1)->array.self.lf[#2*(#1)->array.dims[1]+#3]= #0")
+	:inline-unsafe
+	((short-float (array short-float) fixnum fixnum) short-float t nil
+		"@1;(#1)->array.self.sf[#2*(#1)->array.dims[1]+#3]= #0")
+	:inline-unsafe
+	((fixnum (array fixnum) fixnum fixnum) fixnum t nil
+		"@1;(#1)->array.self.fix[#2*(#1)->array.dims[1]+#3]= #0")
+	:inline-unsafe ((fixnum (array bit) fixnum fixnum) fixnum t nil
+		"@0;aset_bv(#1,(#2)*(#1)->array.dims[1]+(#3),#0)")
+
+	:inline-always ((t t t) t t nil "aset1(#1,fixint(#2),#0)")
+	:inline-always ((t t fixnum) t t nil "aset1(#1,#2,#0)")
+
+	:inline-unsafe ((t t t) t t nil "aset1(#1,fix(#2),#0)")
+	:inline-unsafe ((t (array t) fixnum) t t nil "(#1)->vector.self.t[#2]= #0")
+	:inline-unsafe ((t (array bit) fixnum) fixnum t nil "aset_bv(#1,#2,fix(#0))")
+	:inline-unsafe ((character (array base-char) fixnum) character t nil
+		"(#1)->string.self[#2]= #0")
+	:inline-unsafe ((long-float (array long-float) fixnum) long-float t nil
+		"(#1)->array.self.lf[#2]= #0")
+	:inline-unsafe ((short-float (array short-float) fixnum) short-float t nil
+		"(#1)->array.self.sf[#2]= #0")
+	:inline-unsafe ((fixnum (array fixnum) fixnum) fixnum t nil
+		"(#1)->array.self.fix[#2]= #0")
+	:inline-unsafe ((fixnum (array bit) fixnum) fixnum t nil
+		"aset_bv(#1,#2,#0)"))
+(ARRAY-ELEMENT-TYPE "Larray_element_type" (array) T)
+(ARRAY-RANK "Larray_rank" (array) fixnum)
+(ARRAY-DIMENSION "Larray_dimension" (array fixnum) fixnum)
+(ARRAY-TOTAL-SIZE "Larray_total_size" (array) T nil nil
+	:inline-unsafe ((t) fixnum nil nil "((#0)->string.dim)"))
+(ADJUSTABLE-ARRAY-P "Ladjustable_array_p" (array) T nil t)
+(si::DISPLACED-ARRAY-P "siLdisplaced_array_p" (array) T nil t)
+(SVREF "Lsvref" (simple-vector fixnum) T nil nil
+	:inline-always ((t t) t nil t "aref1(#0,fixint(#1))")
+	:inline-always ((t fixnum) t nil t "aref1(#0,#1)")
+	:inline-unsafe ((t t) t nil nil "(#0)->vector.self.t[fix(#1)]")
+	:inline-unsafe ((t fixnum) t nil nil "(#0)->vector.self.t[#1]"))
+(si::SVSET "siLsvset" (simple-vector fixnum t) T nil nil
+	:inline-always ((t t t) t t nil "aset1(#0,fixint(#1),#2)")
+	:inline-always ((t fixnum t) t t nil "aset1(#0,#1,#2)")
+	:inline-unsafe ((t t t) t t nil "((#0)->vector.self.t[fix(#1)]=(#2))")
+	:inline-unsafe ((t fixnum t) t t nil "(#0)->vector.self.t[#1]= #2"))
+(ARRAY-HAS-FILL-POINTER-P "Larray_has_fill_pointer_p" nil T nil t)
+(FILL-POINTER "Lfill_pointer" (vector) fixnum nil nil
+	:inline-unsafe ((t) fixnum nil nil "((#0)->string.fillp)"))
+(si::FILL-POINTER-SET "siLfill_pointer_set"
+	(vector fixnum) fixnum nil nil
+	:inline-unsafe ((t fixnum) fixnum t nil "((#0)->string.fillp)=(#1)"))
+(si::REPLACE-ARRAY "siLreplace_array" nil T nil nil)
+;(si::ASET-BY-CURSOR "siLaset_by_cursor" nil T nil nil)
+
+; file assignment.c
+(SET "Lset" (symbol t) T)
+(si::FSET "siLfset" (symbol t) T)
+(MAKUNBOUND "Lmakunbound" (symbol) T)
+(FMAKUNBOUND "Lfmakunbound" (symbol) T)
+(si::CLEAR-COMPILER-PROPERTIES "siLclear_compiler_properties" nil T)
+
+; file catch.c
+;#-clcs (SI::ERROR-SET "siLerror_set" (T) * NIL NIL)
+
+; file cfun.c
+(si::COMPILED-FUNCTION-NAME "siLcompiled_function_name" nil T)
+
+; file character.c
+(STANDARD-CHAR-P "Lstandard_char_p" (character) T nil t)
+(GRAPHIC-CHAR-P "Lgraphic_char_p" (character) T nil t)
+(ALPHA-CHAR-P "Lalpha_char_p" (character) T nil t)
+(UPPER-CASE-P "Lupper_case_p" (character) T nil t)
+(LOWER-CASE-P "Llower_case_p" (character) T nil t)
+(BOTH-CASE-P "Lboth_case_p" (character) T nil t)
+(DIGIT-CHAR-P "Ldigit_char_p" (character *) T nil nil
+	:inline-always
+	((character) boolean nil nil "@0; ((#0) <= '9' && (#0) >= '0')"))
+(ALPHANUMERICP "Lalphanumericp" (character) T nil t)
+(CHARACTER "Lcharacter" (T) CHARACTER)
+(CHAR= "Lchar_eq" (character *) T nil t
+	:inline-always ((character character) boolean nil nil "(#0)==(#1)")
+	:inline-always ((t t) boolean nil nil "char_code(#0)==char_code(#1)"))
+(CHAR/= "Lchar_neq" (character *) T nil t
+	:inline-always ((character character) boolean nil nil "(#0)!=(#1)")
+	:inline-always ((t t) boolean nil nil "char_code(#0)!=char_code(#1)"))
+(CHAR< "Lchar_l" (character *) T nil t
+	:inline-always ((character character) boolean nil nil "(#0)<(#1)"))
+(CHAR> "Lchar_g" (character *) T nil t
+	:inline-always ((character character) boolean nil nil "(#0)>(#1)"))
+(CHAR<= "Lchar_le" (character *) T nil t
+	:inline-always ((character character) boolean nil nil "(#0)<=(#1)"))
+(CHAR>= "Lchar_ge" (character *) T nil t
+	:inline-always ((character character) boolean nil nil "(#0)>=(#1)"))
+(CHAR-EQUAL "Lchar_equal" (character *) T nil t)
+(CHAR-NOT-EQUAL "Lchar_not_equal" (character *) T nil t)
+(CHAR-LESSP "Lchar_lessp" (character *) T nil t)
+(CHAR-GREATERP "Lchar_greaterp" (character *) T nil t)
+(CHAR-NOT-GREATERP "Lchar_not_greaterp" (character *) T nil t)
+(CHAR-NOT-LESSP "Lchar_not_lessp" (character *) T nil t)
+(CHARACTER "Lcharacter" nil character nil nil)
+(CHAR-CODE "Lchar_code" (character) fixnum nil nil
+	:inline-always ((character) fixnum nil nil "#0"))
+(CODE-CHAR "Lcode_char" (fixnum) character nil nil
+	:inline-always ((fixnum) character nil nil "#0"))
+(CHAR-UPCASE "Lchar_upcase" (character) character nil nil)
+(CHAR-DOWNCASE "Lchar_downcase" (character) character nil nil)
+(DIGIT-CHAR "Ldigit_char" (fixnum *) character nil nil)
+(CHAR-INT "Lchar_int" (character) fixnum nil nil
+	:inline-always ((character) fixnum nil nil "#0"))
+(INT-CHAR "Lint_char" (fixnum) character nil nil
+	:inline-always ((fixnum) character nil nil "#0"))
+(CHAR-NAME "Lchar_name" (character) symbol)
+(NAME-CHAR "Lname_char" (symbol) character)
+
+; ; file error.c
+#-clcs
+(ERROR "Lerror" (T *) T nil nil)
+#-clcs
+(CERROR "Lcerror" (T T *) T nil nil)
+
+(si::IHS-TOP "siLihs_top")
+(si::IHS-FUN "siLihs_fun")
+(si::IHS-ENV "siLihs_env")
+(si::FRS-TOP "siLfrs_top")
+(si::FRS-VS "siLfrs_vs")
+(si::FRS-BDS "siLfrs_bds")
+(si::FRS-CLASS "siLfrs_class")
+(si::FRS-TAG "siLfrs_tag")
+(si::FRS-IHS "siLfrs_ihs")
+(si::BDS-TOP "siLbds_top")
+(si::BDS-VAR "siLbds_var")
+(si::BDS-VAL "siLbds_val")
+(si::VS-TOP "siLvs_top")
+(si::VS "siLvs")
+(si::SCH-FRS-BASE "siLsch_frs_base")
+(si::UNIVERSAL-ERROR-HANDLER "siLuniversal_error_handler")
+
+; file eval.c
+(APPLY "Lapply" (T T *) T)
+(FUNCALL "Lfuncall" (T *) T)
+(EVAL "Leval" (T) T)
+(EVALHOOK "Levalhook" (T T T *) T)
+(APPLYHOOK "Lapplyhook" (T T T T *) T)
+(CONSTANTP "Lconstantp" (T) T NIL T)
+(si::UNLINK-SYMBOL "siLunlink_symbol" nil T)
+(si::LINK-ENABLE "siLlink_enable" nil T)
+
+; file file.d
+(MAKE-SYNONYM-STREAM "Lmake_synonym_stream" (T) T)
+(MAKE-BROADCAST-STREAM "Lmake_broadcast_stream" (*) T)
+(MAKE-CONCATENATED-STREAM "Lmake_concatenated_stream" nil T)
+(MAKE-TWO-WAY-STREAM "Lmake_two_way_stream" (T T) T)
+(MAKE-ECHO-STREAM "Lmake_echo_stream" (T T) T)
+(MAKE-STRING-INPUT-STREAM "Lmake_string_input_stream" nil T)
+(MAKE-STRING-OUTPUT-STREAM "Lmake_string_output_stream" nil T)
+(GET-OUTPUT-STREAM-STRING "Lget_output_stream_string" nil T)
+(SI::OUTPUT-STREAM-STRING "siLoutput_stream_string" (T) T)
+(STREAMP "Lstreamp" (T) T NIL T)
+(INPUT-STREAM-P "Linput_stream_p" (T) T NIL T)
+(OUTPUT-STREAM-P "Loutput_stream_p" (T) T NIL T)
+(STREAM-ELEMENT-TYPE "Lstream_element_type" (T) T)
+(CLOSE "Lclose" (T *) T)
+;#-clcs (OPEN "Lopen" (T *) T)
+(FILE-POSITION "Lfile_position" (T *) T)
+(FILE-LENGTH "Lfile_length" (T) T)
+;#-clcs (LOAD "Lload" (T *) T)
+(si::GET-STRING-INPUT-STREAM-INDEX "siLget_string_input_stream_index" nil T)
+(si::MAKE-STRING-OUTPUT-STREAM-FROM-STRING
+	"siLmake_string_output_stream_from_string" nil T)
+
+; file gbc.c
+(si::ROOM-REPORT "siLroom_report" nil T)
+(si::RESET-GBC-COUNT "siLreset_gbc_count" nil T)
+(GBC "Lgbc" nil T)
+
+; file unixfsys.c
+(TRUENAME "Ltruename" (T) T)
+(RENAME-FILE "Lrename_file" (T T) T)
+(SI::SPECIALP "siLspecialp" (T) T NIL T)
+(DELETE-FILE "Ldelete_file" (T) T)
+(PROBE-FILE "Lprobe_file" (T) T)
+(FILE-WRITE-DATE "Lfile_write_date" (T) T)
+(FILE-AUTHOR "Lfile_author" (T) T)
+(PATHNAME "Lpathname" (T) T)
+(USER-HOMEDIR-PATHNAME "Luser_homedir_pathname" (*) T)
+(DIRECTORY "Ldirectory" (T) T)
+(si::CHDIR "siLchdir" nil T)
+
+; file unixint.c
+(si::CATCH-BAD-SIGNALS "siLcatch_bad_signals" nil T)
+(si::UNCATCH-BAD-SIGNALS "siLuncatch_bad_signals" nil T)
+
+; file format.c
+(FORMAT "Lformat" (T string *) T)
+
+; file hash.d
+(MAKE-HASH-TABLE "Lmake_hash_table" (*) T)
+(HASH-TABLE-P "Lhash_table_p" (T) T NIL T)
+(VALUES "Lvalues" (*) *)
+(GETHASH "Lgethash" (T T *) (VALUES T T))
+(REMHASH "Lremhash" (T T) T)
+(MAPHASH "Lmaphash" (T T) T)
+(CLRHASH "Lclrhash" (T) T)
+(HASH-TABLE-COUNT "Lhash_table_count" (T) T)
+(SXHASH "Lsxhash" (T) FIXNUM)
+(SI::HASH-SET "siLhash_set" NIL T)
+
+; file list.d
+(CAR "Lcar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "car(#0)")
+	:inline-unsafe ((t) t nil nil "CAR(#0)"))
+(CDR "Lcdr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdr(#0)")
+	:inline-unsafe ((t) t nil nil "CDR(#0)"))
+(CAAR "Lcaar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "caar(#0)")
+	:inline-unsafe ((t) t nil nil "CAAR(#0)"))
+(CADR "Lcadr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cadr(#0)")
+	:inline-unsafe ((t) t nil nil "CADR(#0)"))
+(CDAR "Lcdar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdar(#0)")
+	:inline-unsafe ((t) t nil nil "CDAR(#0)"))
+(CDDR "Lcddr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cddr(#0)")
+	:inline-unsafe ((t) t nil nil "CDDR(#0)"))
+(CAAAR "Lcaaar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "caaar(#0)")
+	:inline-unsafe ((t) t nil nil "CAAAR(#0)"))
+(CAADR "Lcaadr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "caadr(#0)")
+	:inline-unsafe ((t) t nil nil "CAADR(#0)"))
+(CADAR "Lcadar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cadar(#0)")
+	:inline-unsafe ((t) t nil nil "CADAR(#0)"))
+(CADDR "Lcaddr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "caddr(#0)")
+	:inline-unsafe ((t) t nil nil "CADDR(#0)"))
+(CDAAR "Lcdaar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdaar(#0)")
+	:inline-unsafe ((t) t nil nil "CDAAR(#0)"))
+(CDADR "Lcdadr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdadr(#0)")
+	:inline-unsafe ((t) t nil nil "CDADR(#0)"))
+(CDDAR "Lcddar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cddar(#0)")
+	:inline-unsafe ((t) t nil nil "CDDAR(#0)"))
+(CDDDR "Lcdddr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdddr(#0)")
+	:inline-unsafe ((t) t nil nil "CDDDR(#0)"))
+(CAAAAR "Lcaaaar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "caaaar(#0)")
+	:inline-unsafe ((t) t nil nil "CAAAAR(#0)"))
+(CAAADR "Lcaaadr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "caaadr(#0)")
+	:inline-unsafe ((t) t nil nil "CAAADR(#0)"))
+(CAADAR "Lcaadar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "caadar(#0)")
+	:inline-unsafe ((t) t nil nil "CAADAR(#0)"))
+(CAADDR "Lcaaddr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "caaddr(#0)")
+	:inline-unsafe ((t) t nil nil "CAADDR(#0)"))
+(CADAAR "Lcadaar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cadaar(#0)")
+	:inline-unsafe ((t) t nil nil "CADAAR(#0)"))
+(CADADR "Lcadadr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cadadr(#0)")
+	:inline-unsafe ((t) t nil nil "CADADR(#0)"))
+(CADDAR "Lcaddar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "caddar(#0)")
+	:inline-unsafe ((t) t nil nil "CADDAR(#0)"))
+(CADDDR "Lcadddr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cadddr(#0)")
+	:inline-unsafe ((t) t nil nil "CADDDR(#0)"))
+(CDAAAR "Lcdaaar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdaaar(#0)")
+	:inline-unsafe ((t) t nil nil "CDAAAR(#0)"))
+(CDAADR "Lcdaadr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdaadr(#0)")
+	:inline-unsafe ((t) t nil nil "CDAADR(#0)"))
+(CDADAR "Lcdadar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdadar(#0)")
+	:inline-unsafe ((t) t nil nil "CDADAR(#0)"))
+(CDADDR "Lcdaddr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdaddr(#0)")
+	:inline-unsafe ((t) t nil nil "CDADDR(#0)"))
+(CDDAAR "Lcddaar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cddaar(#0)")
+	:inline-unsafe ((t) t nil nil "CDDAAR(#0)"))
+(CDDADR "Lcddadr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cddadr(#0)")
+	:inline-unsafe ((t) t nil nil "CDDADR(#0)"))
+(CDDDAR "Lcdddar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdddar(#0)")
+	:inline-unsafe ((t) t nil nil "CDDDAR(#0)"))
+(CDDDDR "Lcddddr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cddddr(#0)")
+	:inline-unsafe ((t) t nil nil "CDDDDR(#0)"))
+(CONS "Lcons" (T T) T NIL NIL
+	:inline-always ((t t) t nil t "CONS(#0,#1)"))
+(TREE-EQUAL "Ltree_equal" (T T *) T NIL T)
+(ENDP "Lendp" (T) T NIL T
+	:inline-safe ((t) boolean nil nil "endp(#0)")
+	:inline-unsafe ((t) boolean nil nil "#0==Cnil"))
+(LIST-LENGTH "Llist_length" (T) T NIL NIL)
+(NTH "Lnth" (T T) T NIL NIL
+	:inline-always ((t t) t nil nil "nth(fixint(#0),#1)")
+	:inline-always ((fixnum t) t nil nil "nth(#0,#1)")
+	:inline-unsafe ((t t) t nil nil "nth(fix(#0),#1)")
+	:inline-unsafe ((fixnum t) t nil nil "nth(#0,#1)"))
+(FIRST "Lcar" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "car(#0)")
+	:inline-unsafe ((t) t nil nil "CAR(#0)"))
+(SECOND "Lcadr" (T) T nil nil
+	:inline-safe ((t) t nil nil "cadr(#0)")
+	:inline-unsafe ((t) t nil nil "CADR(#0)"))
+(THIRD "Lcaddr" (T) T nil nil
+	:inline-safe ((t) t nil nil "caddr(#0)")
+	:inline-unsafe ((t) t nil nil "CADDR(#0)"))
+(FOURTH "Lcadddr" (T) T nil nil
+	:inline-safe ((t) t nil nil "cadddr(#0)")
+	:inline-unsafe ((t) t nil nil "CADDDR(#0)"))
+(FIFTH "Lfifth" (T) T)
+(SIXTH "Lsixth" (T) T)
+(SEVENTH "Lseventh" (T) T)
+(EIGHTH "Leighth" (T) T)
+(NINTH "Lninth" (T) T)
+(TENTH "Ltenth" (T) T)
+(REST "Lcdr" (T) T NIL NIL
+	:inline-safe ((t) t nil nil "cdr(#0)")
+	:inline-unsafe ((t) t nil nil "CDR(#0)"))
+(NTHCDR "Lnthcdr" (fixnum t) T nil nil
+	:inline-always ((t t) t nil nil "nthcdr(fixint(#0),#1)")
+	:inline-always ((fixnum t) t nil nil "nthcdr(#0,#1)")
+	:inline-unsafe ((t t) t nil nil "nthcdr(fix(#0),#1)")
+	:inline-unsafe ((fixnum t) t nil nil "nthcdr(#0,#1)"))
+(LAST "Llast" (T) T)
+(LIST "Llist" (*) T NIL NIL
+	:inline-always (nil t nil nil "Cnil")
+	:inline-always ((t) t nil t "CONS(#0,Cnil)")
+	:inline-always ((t t) t nil t list-inline)
+	:inline-always ((t t t) t nil t list-inline)
+	:inline-always ((t t t t) t nil t list-inline)
+	:inline-always ((t t t t t) t nil t list-inline)
+	:inline-always ((t t t t t t) t nil t list-inline)
+	:inline-always ((t t t t t t t) t nil t list-inline)
+	:inline-always ((t t t t t t t t) t nil t list-inline)
+	:inline-always ((t t t t t t t t t) t nil t list-inline)
+	:inline-always ((t t t t t t t t t t) t nil t list-inline))
+(LIST* "LlistA" (T *) T NIL NIL
+	:inline-always ((t) t nil nil "#0")
+	:inline-always ((t t) t nil t "CONS(#0,#1)")
+	:inline-always ((t t t) t nil t list*-inline)
+	:inline-always ((t t t t) t nil t list*-inline)
+	:inline-always ((t t t t t) t nil t list*-inline)
+	:inline-always ((t t t t t t) t nil t list*-inline)
+	:inline-always ((t t t t t t t) t nil t list*-inline)
+	:inline-always ((t t t t t t t t) t nil t list*-inline)
+	:inline-always ((t t t t t t t t t) t nil t list*-inline)
+	:inline-always ((t t t t t t t t t t) t nil t list*-inline))
+(MAKE-LIST "Lmake_list" (fixnum *) T)
+(APPEND "Lappend" (*) T NIL NIL
+	:inline-always ((t t) t nil t "append(#0,#1)"))
+(COPY-LIST "Lcopy_list" (T) T)
+(COPY-ALIST "Lcopy_alist" (T) T)
+(COPY-TREE "Lcopy_tree" (T) T)
+(REVAPPEND "Lrevappend" (T T) T)
+(NCONC "Lnconc" (*) T NIL NIL
+	:inline-always ((t t) t t nil "nconc(#0,#1)"))
+(NRECONC "Lreconc" (T T) T)
+(BUTLAST "Lbutlast" (T *) T)
+(NBUTLAST "Lnbutlast" (T *) T)
+(LDIFF "Lldiff" (T T) T)
+(RPLACA "Lrplaca" (cons T) T)
+(RPLACD "Lrplacd" (cons T) T)
+(SUBST "Lsubst" (T T T *) T)
+(SUBST-IF "Lsubst_if" (T T T *) T)
+(SUBST-IF-NOT "Lsubst_if_not" (T T T *) T)
+(NSUBST "Lnsubst" (T T T *) T)
+(NSUBST-IF "Lnsubst_if" (T T T *) T)
+(NSUBST-IF-NOT "Lnsubst_if_not" (T T T *) T)
+(SUBLIS "Lsublis" (T T *) T)
+(NSUBLIS "Lnsublis" (T T *) T)
+(MEMBER "Lmember" (T T *) T)
+(MEMBER-IF "Lmember_if" (T T *) T)
+(MEMBER-IF-NOT "Lmember_if_not" (T T *) T)
+(MEMBER1 "Lmember1"(T T *) T)
+(TAILP "Ltailp" (T T) T NIL T)
+(ADJOIN "Ladjoin" (T T *) T)
+(ACONS "Lacons" (T T T) T)
+(PAIRLIS "Lpairlis" (T T *) T)
+(ASSOC "Lassoc" (T T *) T)
+(ASSOC-IF "Lassoc_if" (T T) T)
+(ASSOC-IF-NOT "Lassoc_if_not" (T T) T)
+(RASSOC "Lrassoc" (T T *) T)
+(RASSOC-IF "Lrassoc_if" (T T) T)
+(RASSOC-IF-NOT "Lrassoc_if_not" (T T) T)
+(si::MEMQ "siLmemq" (T T T) T)
+
+; file lwp.c
+;to do
+
+; file macros.c
+(si::DEFINE-MACRO "siLdefine_macro" nil T)
+(MACROEXPAND "Lmacroexpand" (T *) (VALUES T T))
+(MACROEXPAND-1 "Lmacroexpand_1" (T *) (VALUES T T))
+
+; file main.c
+(QUIT "Lquit" nil T)
+(IDENTITY "Lidentity" (T) T)
+(si::ARGC "siLargc" nil T)
+(si::ARGV "siLargv" nil T)
+(si::GETENV "siLgetenv" nil T)
+(si::RESET-STACK-LIMITS "siLreset_stack_limits" nil T)
+#-sparc
+(si::INIT-SYSTEM "siLinit_system" nil T)
+(si::POINTER "siLaddress" nil T)
+(si::NANI "siLnani" nil T)
+
+; file mapfun.c
+(MAPCAR "Lmapcar" (T T *) T)
+(MAPLIST "Lmaplist" (T T *) T)
+(MAPC "Lmapc" (T T *) T)
+(MAPL "Lmapl" (T T *) T)
+(MAPCAN "Lmapcan" (T T *) T)
+(MAPCON "Lmapcon" (T T *) T)
+
+; file multival.c
+(VALUES "Lvalues" nil T)
+(VALUES-LIST "Lvalues_list" (T) *)
+
+; file num_arith.c
+(+ "Lplus" (*) T NIL NIL
+	:inline-always ((t t) t nil t "number_plus(#0,#1)")
+	:inline-always ((fixnum-float fixnum-float) long-float nil nil
+		"(double)(#0)+(double)(#1)")
+	:inline-always ((fixnum-float fixnum-float) short-float nil nil
+		"(float)(#0)+(float)(#1)")
+	:inline-always ((fixnum fixnum) fixnum nil nil "(#0)+(#1)"))
+(- "Lminus" (T *) T NIL NIL
+	:inline-always ((t) t nil t "number_negate(#0)")
+	:inline-always ((t t) t nil t "number_minus(#0,#1)")
+	:inline-always ((fixnum-float fixnum-float) long-float nil nil
+		"(double)(#0)-(double)(#1)")
+	:inline-always ((fixnum-float fixnum-float) short-float nil nil
+		"(float)(#0)-(float)(#1)")
+	:inline-always ((fixnum fixnum) fixnum nil nil "(#0)-(#1)")
+
+	:inline-always ((fixnum-float) long-float nil nil "-(double)(#0)")
+	:inline-always ((fixnum-float) short-float nil nil "-(float)(#0)")
+	:inline-always ((fixnum) fixnum nil nil "-(#0)")) 
+(* "Ltimes" (*) T NIL NIL
+	:inline-always ((t t) t nil t "number_times(#0,#1)")
+	:inline-always ((fixnum-float fixnum-float) long-float nil nil
+		"(double)(#0)*(double)(#1)")
+	:inline-always ((fixnum-float fixnum-float) short-float nil nil
+		"(float)(#0)*(float)(#1)")
+	:inline-always ((fixnum fixnum) t nil nil "fixnum_times(#0,#1)")
+	:inline-always ((fixnum fixnum) fixnum nil nil "(#0)*(#1)"))
+(/ "Ldivide" (T *) T NIL NIL
+	:inline-always ((t t) t nil t "number_divide(#0,#1)")
+	:inline-always ((fixnum-float fixnum-float) long-float nil nil
+		"(double)(#0)/(double)(#1)")
+	:inline-always ((fixnum-float fixnum-float) short-float nil nil
+		"(float)(#0)/(float)(#1)")
+	:inline-always ((fixnum fixnum) fixnum nil nil "(#0)/(#1)"))
+(1+ "Lone_plus" (T) T NIL NIL
+	:inline-always ((t) t nil t "one_plus(#0)")
+	:inline-always ((fixnum-float) long-float nil nil "(double)(#0)+1")
+	:inline-always ((fixnum-float) short-float nil nil "(float)(#0)+1")
+	:inline-always ((fixnum) fixnum nil nil "(#0)+1"))
+(1- "Lone_minus" (T) T NIL NIL
+	:inline-always ((t) t nil t "one_minus(#0)")
+	:inline-always ((fixnum-float) long-float nil nil "(double)(#0)-1")
+	:inline-always ((fixnum-float) short-float nil nil "(float)(#0)-1")
+	:inline-always ((fixnum) fixnum nil nil "(#0)-1"))
+(CONJUGATE "Lconjugate" (T) T)
+(GCD "Lgcd" (*) T)
+(LCM "Llcm" (T *) T)
+
+; file num_co.c
+(FLOAT "Lfloat" (T *) T NIL NIL
+	:inline-always ((T) short-float nil nil "(Lfloat(1,#0),sf(VALUES(0)))")
+	:inline-always ((fixnum-float) long-float nil nil "((double)(#0))")
+	:inline-always ((fixnum-float) short-float nil nil "((float)(#0))"))
+(NUMERATOR "Lnumerator" (T) T)
+(DENOMINATOR "Ldenominator" (T) T)
+(FLOOR "Lfloor" (T *) (VALUES T T) NIL NIL
+	:inline-always ((fixnum fixnum) fixnum nil nil
+		"@01;(#0>=0&&#1>0?(#0)/(#1):ifloor(#0,#1))"))
+(CEILING "Lceiling" (T *) (VALUES T T) NIL NIL)
+(TRUNCATE "Ltruncate" (T *) (VALUES T T) NIL NIL
+	:inline-always ((fixnum-float) fixnum nil nil "(fixnum)(#0)"))
+(ROUND "Lround" (T *) (VALUES T T))
+(MOD "Lmod" (T T) T NIL NIL
+	:inline-always ((fixnum fixnum) fixnum nil nil
+		"@01;(#0>=0&&#1>0?(#0)%(#1):imod(#0,#1))"))
+(REM "Lrem" (T T) T NIL NIL
+	:inline-always ((fixnum fixnum) fixnum nil nil "(#0)%(#1)"))
+(DECODE-FLOAT "Ldecode_float" (T) (VALUES T T T))
+(SCALE-FLOAT "Lscale_float" (T T) T)
+(FLOAT-RADIX "Lfloat_radix" (T) FIXNUM)
+(FLOAT-SIGN "Lfloat_sign" (T *) T)
+(FLOAT-DIGITS "Lfloat_digits" (T) FIXNUM)
+(FLOAT-PRECISION "Lfloat_precision" (T) FIXNUM)
+(INTEGER-DECODE-FLOAT "Linteger_decode_float" (T) (VALUES T T T))
+(COMPLEX "Lcomplex" (T *) T)
+(REALPART "Lrealpart" (T) T)
+(IMAGPART "Limagpart" (T) T)
+(= "Lall_the_same" (T *) T NIL T
+	:inline-always ((t t) boolean nil nil "number_compare(#0,#1)==0")
+	:inline-always ((fixnum-float fixnum-float) boolean nil nil "(#0)==(#1)"))
+(/= "Lall_different" (T *) T nil t
+	:inline-always ((t t) boolean nil nil "number_compare(#0,#1)!=0")
+	:inline-always ((fixnum-float fixnum-float) boolean nil nil "(#0)!=(#1)"))
+(< "Lmonotonically_increasing" (T *) T nil t
+	:inline-always ((t t) boolean nil nil "number_compare(#0,#1)<0")
+	:inline-always ((fixnum-float fixnum-float) boolean nil nil "(#0)<(#1)"))
+(> "Lmonotonically_decreasing" (T *) T nil t
+	:inline-always ((t t) boolean nil nil "number_compare(#0,#1)>0")
+	:inline-always ((fixnum-float fixnum-float) boolean nil nil "(#0)>(#1)"))
+(<= "Lmonotonically_nondecreasing" (T *) T nil t
+	:inline-always ((t t) boolean nil nil "number_compare(#0,#1)<=0")
+	:inline-always ((fixnum-float fixnum-float) boolean nil nil "(#0)<=(#1)"))
+(>= "Lmonotonically_nonincreasing" (T *) T nil t
+	:inline-always ((t t) boolean nil nil "number_compare(#0,#1)>=0")
+	:inline-always ((fixnum-float fixnum-float) boolean nil nil "(#0)>=(#1)"))
+(MAX "Lmax" (T *) T NIL NIL
+	:inline-always ((t t) t nil nil "@01;(number_compare(#0,#1)>=0?#0:#1)")
+	:inline-always ((fixnum fixnum) fixnum nil nil "@01;(#0)>=(#1)?#0:#1"))
+(MIN "Lmin" (T *) T NIL NIL
+	:inline-always ((t t) t nil nil "@01;(number_compare(#0,#1)<=0?#0:#1)")
+	:inline-always ((fixnum fixnum) fixnum nil nil "@01;(#0)<=(#1)?#0:#1"))
+(LOGIOR "Llogior" (*) T NIL NIL
+	:inline-always ((fixnum fixnum) fixnum nil nil "((#0) | (#1))"))
+(LOGXOR "Llogxor" (*) T NIL NIL)
+(LOGAND "Llogand" (*) T NIL NIL
+	:inline-always ((fixnum fixnum) fixnum nil nil "((#0) & (#1))"))
+(LOGEQV "Llogeqv" (*) T NIL NIL)
+(BOOLE "Lboole" (T T T) T NIL NIL)
+(LOGBITP "Llogbitp" (T T) T NIL T
+	:inline-always ((fixnum fixnum) boolean nil nil "(#1 >> #0) & 1"))
+(ASH "Lash" (T T) T)
+(LOGCOUNT "Llogcount" (T) T)
+(INTEGER-LENGTH "Linteger_length" (T) FIXNUM)
+(si::BIT-ARRAY-OP "siLbit_array_op" nil T)
+(ZEROP "Lzerop" (T) T NIL T
+	:inline-always ((t) boolean nil nil "number_compare(MAKE_FIXNUM(0),#0)==0")
+	:inline-always ((fixnum-float) boolean nil nil "(#0)==0"))
+(PLUSP "Lplusp" (T) T NIL T
+	:inline-always ((t) boolean nil nil "number_compare(MAKE_FIXNUM(0),#0)<0")
+	:inline-always ((fixnum-float) boolean nil nil "(#0)>0"))
+(MINUSP "Lminusp" (T) T NIL T
+	:inline-always ((t) boolean nil nil "number_compare(MAKE_FIXNUM(0),#0)>0")
+	:inline-always ((fixnum-float) boolean nil nil "(#0)<0"))
+(ODDP "Loddp" (T) T NIL T
+	:inline-always ((fixnum fixnum) boolean nil nil "(#0) & 1"))
+(EVENP "Levenp" (T) T NIL T
+	:inline-always ((fixnum fixnum) boolean nil nil "~(#0) & 1"))
+(RANDOM "Lrandom" (T *) T)
+(MAKE-RANDOM-STATE "Lmake_random_state" (*) T)
+(RANDOM-STATE-P "Lrandom_state_p" (T) T NIL T)
+(EXP "Lexp" (T) T NIL NIL
+	:inline-always ((number) t nil t "number_exp(#0)"))
+(EXPT "Lexpt" (T T) T NIL NIL
+	:inline-always ((t t) t nil t "number_expt(#0,#1)")
+	:inline-always ((fixnum fixnum) fixnum nil nil
+		(lambda (loc1 loc2)
+		  (if (and (consp loc1) (eq (car loc1) 'fixnum)
+			   (consp (cadr loc1)) (eq (caadr loc1) 'fixnum-value)
+			   (eq (cadr (cadr loc1)) 2))
+		      (progn (wt1 "(1<<(") (wt1 loc2) (wt1 "))"))
+		    (progn (wt1 "fixnum_expt(") (wt1 loc1) (wt1 #\,) (wt1 loc2)
+			   (wt1 #\) ))))))
+(LOG "Llog" (T *) T NIL NIL
+	:inline-always ((fixnum-float) long-float nil t "log((double)(#0))")
+	:inline-always ((fixnum-float) short-float nil nil
+		"(float)log((double)(#0))"))
+(SQRT "Lsqrt" (T) T NIL NIL
+	:inline-always ((fixnum-float) long-float nil t "sqrt((double)(#0))")
+	:inline-always ((fixnum-float) short-float nil nil
+		"(float)sqrt((double)(#0))"))
+(SIN "Lsin" (T) T NIL NIL
+	:inline-always ((fixnum-float) long-float nil nil "sin((double)(#0))")
+	:inline-always ((fixnum-float) short-float nil nil
+		"(float)sin((double)(#0))"))
+(COS "Lcos" (T) T NIL NIL
+	:inline-always ((fixnum-float) long-float nil nil "cos((double)(#0))")
+	:inline-always ((fixnum-float) short-float nil nil
+		"(float)cos((double)(#0))"))
+(tan "Ltan" (number) number nil nil
+	:inline-always ((fixnum-float) long-float nil nil "tan((double)(#0))")
+	:inline-always ((fixnum-float) short-float nil nil
+		"(float)tan((double)(#0))"))
+(ATAN "Latan" (T *) T)
+
+; file package.d
+(MAKE-PACKAGE "Lmake_package" (T *) T)
+(si::SELECT-PACKAGE "siLselect_package" (T) T)
+(FIND-PACKAGE "Lfind_package" (T) T)
+(PACKAGE-NAME "Lpackage_name" (T) T)
+(PACKAGE-NICKNAMES "Lpackage_nicknames" (T) T)
+(RENAME-PACKAGE "Lrename_package" (T T *) T)
+(PACKAGE-USE-LIST "Lpackage_use_list" (T) T)
+(PACKAGE-USED-BY-LIST "Lpackage_used_by_list" (T) T)
+(PACKAGE-SHADOWING-SYMBOLS "Lpackage_shadowing_symbols" (T) T)
+(LIST-ALL-PACKAGES "Llist_all_packages" NIL T)
+(INTERN "Lintern" (string *) (VALUES T T))
+(FIND-SYMBOL "Lfind_symbol" (string *) (VALUES T T))
+(UNINTERN "Lunintern" (symbol t) T)
+(EXPORT "Lexport" (T *) T)
+(UNEXPORT "Lunexport" (T *) T)
+(IMPORT "Limport" (T *) T)
+(SHADOWING-IMPORT "Lshadowing_import" (T *) T)
+(SHADOW "Lshadow" (T *) T)
+(USE-PACKAGE "Luse_package" (T *) T)
+(UNUSE-PACKAGE "Lunuse_package" (T *) T)
+(si::PACKAGE-INTERNAL "siLpackage_internal" nil T)
+(si::PACKAGE-EXTERNAL "siLpackage_external" nil T)
+(PATHNAME "Lpathname" (T) T)
+(PARSE-NAMESTRING "Lparse_namestring" (T *) T)
+(MERGE-PATHNAMES "Lmerge_pathnames" (T *) T)
+(MAKE-PATHNAME "Lmake_pathname" (*) T)
+(PATHNAMEP "Lpathnamep" (T) T NIL T)
+(PATHNAME-HOST "Lpathname_host" (T) T)
+(PATHNAME-DEVICE "Lpathname_device" (T) T)
+(PATHNAME-DIRECTORY "Lpathname_directory" (T) T)
+(PATHNAME-NAME "Lpathname_name" (T) T)
+(PATHNAME-TYPE "Lpathname_type" (T) T)
+(PATHNAME-VERSION "Lpathname_version" (T) T)
+(NAMESTRING "Lnamestring" (T) string NIL NIL
+	:inline-always ((t) t nil t "coerce_to_namestring(#0)"))
+(FILE-NAMESTRING "Lfile_namestring" (T) STRING)
+(DIRECTORY-NAMESTRING "Ldirectory_namestring" (T) STRING)
+(HOST-NAMESTRING "Lhost_namestring" (T) STRING)
+(ENOUGH-NAMESTRING "Lenough_namestring" (T *) STRING)
+(NULL "Lnull" (T) T NIL T
+	:inline-always ((t) boolean nil nil "#0==Cnil"))
+(SYMBOLP "Lsymbolp" (T) T NIL T
+	:inline-always ((t) boolean nil nil "SYMBOLP(#0)"))
+(ATOM "Latom" (T) T NIL T
+	:inline-always ((t) boolean nil nil "ATOM(#0)"))
+(CONSP "Lconsp" (T) T NIL T
+	:inline-always ((t) boolean nil nil "CONSP(#0)"))
+(LISTP "Llistp" (T) T NIL T
+	:inline-always ((t) boolean nil nil "@0;LISTP(#0)"))
+(NUMBERP "Lnumberp" (T) T NIL T
+	:inline-always ((t) boolean nil nil "numberp(#0)"))
+(INTEGERP "Lintegerp" (T) T NIL T
+	:inline-always ((t) boolean nil nil
+		"@0;type_of(#0)==t_fixnum||type_of(#0)==t_bignum"))
+(RATIONALP "Lrationalp" (T) T nil t)
+(FLOATP "Lfloatp" (T) T NIL T
+	:inline-always ((t) boolean nil nil
+		"@0;type_of(#0)==t_shortfloat||type_of(#0)==t_longfloat"))
+(COMPLEXP "Lcomplexp" (T) T NIL T)
+(CHARACTERP "Lcharacterp" (T) T NIL T
+	:inline-always ((t) boolean nil nil "CHARACTERP(#0)"))
+(STRINGP "Lstringp" (T) T NIL T
+	:inline-always ((t) boolean nil nil "type_of(#0)==t_string"))
+(BIT-VECTOR-P "Lbit_vector_p" (T) T NIL T
+	:inline-always ((t) boolean nil nil "(type_of(#0)==t_bitvector)"))
+(VECTORP "Lvectorp" (T) T NIL T
+	:inline-always ((t) boolean nil nil
+		"@0;type_of(#0)==t_vector||
+type_of(#0)==t_string||
+type_of(#0)==t_bitvector"))
+(SIMPLE-STRING-P "Lsimple_string_p" (T) T NIL T)
+(SIMPLE-BIT-VECTOR-P "Lsimple_bit_vector_p" (T) T NIL T)
+(SIMPLE-VECTOR-P "Lsimple_vector_p" (T) T NIL T)
+(ARRAYP "Larrayp" (T) T NIL T
+	:inline-always ((t) boolean nil nil "@0;ARRAYP(#0)"))
+(PACKAGEP "Lpackagep" (T) T NIL T)
+(FUNCTIONP "Lfunctionp" (T) T NIL T)
+(COMPILED-FUNCTION-P "Lcompiled_function_p" (T) T NIL T)
+(EQ "Leq" (T T) T NIL T
+	:inline-always ((t t) boolean nil nil "(#0)==(#1)")
+	:inline-always ((fixnum fixnum) boolean nil nil "(#0)==(#1)"))
+(EQL "Leql" (T T) T NIL T
+	:inline-always ((t t) boolean nil nil "eql(#0,#1)")
+	:inline-always ((character t) boolean nil nil	; Beppe
+		"(CHARACTERP(#1) && (#0)==CHAR_CODE(#1))")
+	:inline-always ((t character) boolean nil nil	; Beppe
+		"(CHARACTERP(#0) && CHAR_CODE(#0)==(#1))")
+	:inline-always ((character character) boolean nil nil "(#0)==(#1)")
+	:inline-always ((fixnum fixnum) boolean nil nil "(#0)==(#1)"))
+(EQUAL "Lequal" (T T) T nil t
+	:inline-always ((t t) boolean nil nil "equal(#0,#1)")
+	:inline-always ((fixnum fixnum) boolean nil nil "(#0)==(#1)"))
+(EQUALP "Lequalp" (T T) T NIL T
+	:inline-always ((t t) boolean nil nil "equalp(#0,#1)")
+	:inline-always ((fixnum fixnum) boolean nil nil "(#0)==(#1)"))
+(NOT "Lnull" (T) T NIL T
+	:inline-always ((t) boolean nil nil "(#0)==Cnil"))
+
+; file print.d
+(CLEAR-OUTPUT "Lclear_output" (*) T)
+(FINISH-OUTPUT "Lforce_output" (*) T)
+(FORCE-OUTPUT "Lforce_output" (*) T)
+(FRESH-LINE "Lfresh_line" (*) T)
+(LISTEN "Llisten" (*) T)
+(PEEK-CHAR "Lpeek_char" (*) T)
+(PPRINT "Lpprint" (T *) T)
+(PRIN1 "Lprin1" (T *) T NIL NIL
+	:inline-always ((t t) t t nil "prin1(#0,#1)")
+	:inline-always ((t) t t nil "prin1(#0,Cnil)"))
+(PRINC "Lprinc" (T *) T NIL NIL
+	:inline-always ((t t) t t nil "princ(#0,#1)")
+	:inline-always ((t) t t nil "princ(#0,Cnil)"))
+(PRINT "Lprint" (T *) T NIL NIL
+	:inline-always ((t t) t t nil "print(#0,#1)")
+	:inline-always ((t) t t nil "print(#0,Cnil)"))
+(PROBE-FILE "Lprobe_file" (T) T NIL T
+	:inline-always ((t) boolean nil nil "(file_exists(#0))"))
+(UNREAD-CHAR "Lunread_char" (T *) T)
+(READ "Lread" (*) T)
+(READ-CHAR "Lread_char" (*) T)
+(READ-DELIMITED-LIST "Lread_delimited_list" (T *) T)
+(READ-LINE "Lread_line" (*) (VALUES T T))
+(READ-PRESERVING-WHITESPACE "Lread_preserving_whitespace" nil T)
+(TERPRI "Lterpri" (*) T NIL T
+	:inline-always ((t) t t nil "terpri(#0)")
+	:inline-always (nil t t nil "terpri(Cnil)"))
+(WRITE "Lwrite" (T *) T)
+(WRITE-BYTE "Lwrite_byte" (fixnum stream) T)
+(si::WRITE-BYTES "Lwrite_bytes"	(stream string fixnum fixnum) T)
+(WRITE-CHAR "Lwrite_char" (T *) T NIL NIL
+	:inline-always ((t) t t nil "@0;(princ_char(char_code(#0),Cnil),(#0))"))
+(WRITE-LINE "Lwrite_line" (T *) T)
+(WRITE-STRING "Lwrite_string" (T *) T)
+(READ-CHAR-NO-HANG "Lread_char_no_hang" (*) T)
+(CLEAR-INPUT "Lclear_input" (*) T)
+(PARSE-INTEGER "Lparse_integer" (T *))
+(READ-BYTE "Lread_byte" (T *) T)
+(si::READ-BYTES "Lread_bytes" (stream string fixnum fixnum) T)
+(COPY-READTABLE "Lcopy_readtable" (*) T NIL NIL
+	:inline-always ((null null) t nil nil "standard_readtable"))
+(READTABLEP "Lreadtablep" (T) T NIL T)
+(SET-SYNTAX-FROM-CHAR "Lset_syntax_from_char" (T T *) T)
+(SET-MACRO-CHARACTER "Lset_macro_character" (T T *) T)
+(GET-MACRO-CHARACTER "Lget_macro_character" (T *) T)
+(MAKE-DISPATCH-MACRO-CHARACTER "Lmake_dispatch_macro_character" nil T)
+(SET-DISPATCH-MACRO-CHARACTER "Lset_dispatch_macro_character" nil T)
+(GET-DISPATCH-MACRO-CHARACTER "Lget_dispatch_macro_character" nil T)
+(SI::STRING-TO-OBJECT "siLstring_to_object" (T) T)
+(si::STANDARD-READTABLE "siLstandard_readtable" (T) T)
+(SYMBOL-FUNCTION "Lsymbol_function" (T) T NIL NIL
+	:inline-always ((t) t nil t "symbol_function(#0)"))
+(FBOUNDP "Lfboundp" (symbol) T nil t)
+(SYMBOL-VALUE "Lsymbol_value" (symbol) T)
+(BOUNDP "Lboundp" (symbol) T nil t
+	:inline-unsafe ((t) boolean nil nil "(#0)->symbol.dbind!=OBJNULL"))
+(MACRO-FUNCTION "Lmacro_function" (symbol) T)
+(SPECIAL-FORM-P "Lspecial_form_p" (symbol) T nil t)
+
+; file unixsave.c
+(SAVE "Lsave" (T) T)
+
+; file unixsys.c
+(si::SYSTEM "siLsystem" nil T)
+
+; file sequence.d
+(ELT "Lelt" (sequence fixnum) T nil nil
+	:inline-always ((t t) t nil t "elt(#0,fixint(#1))")
+	:inline-always ((t fixnum) t nil t "elt(#0,#1)")
+	:inline-unsafe ((t t) t nil t "elt(#0,fix(#1))")
+	:inline-unsafe ((t fixnum) t nil t "elt(#0,#1)"))
+(si::ELT-SET "siLelt_set" (sequence fixnum t) T nil nil
+	:inline-always ((t t t) t t nil "elt_set(#0,fixint(#1),#2)")
+	:inline-always ((t fixnum t) t t nil "elt_set(#0,#1,#2)")
+	:inline-unsafe ((t t t) t t nil "elt_set(#0,fix(#1),#2)"))
+(SUBSEQ "Lsubseq" (sequence fixnum *) sequence)
+(COPY-SEQ "Lcopy_seq" (sequence) sequence)
+(LENGTH "Llength" (sequence) fixnum t nil
+	:inline-always ((t) fixnum nil nil "length(#0)")
+	:inline-unsafe (((array t)) fixnum nil nil "(#0)->vector.fillp")
+	:inline-unsafe ((string) fixnum nil nil "(#0)->string.fillp"))
+(REVERSE "Lreverse" (sequence) sequence nil nil
+	:inline-always ((t) t nil t "reverse(#0)"))
+(NREVERSE "Lnreverse" (sequence) sequence nil nil
+	:inline-always ((t) t t t "nreverse(#0)"))
+
+; file character.d
+(CHAR "Lchar" (string fixnum) character nil nil
+	:inline-always ((t t) t nil t "elt(#0,fixint(#1))")
+	:inline-always ((t fixnum) t nil t "elt(#0,#1)")
+	:inline-unsafe ((t t) t nil nil "code_char((#0)->string.self[fix(#1)])")
+	:inline-unsafe ((t fixnum) fixnum nil nil "(#0)->string.self[#1]")
+	:inline-unsafe ((t fixnum) character nil nil "(#0)->string.self[#1]"))
+(si::CHAR-SET "siLchar_set"
+	(string fixnum character) character nil nil
+	:inline-always ((t t t) t t nil "elt_set(#0,fixint(#1),#2)")
+	:inline-always ((t fixnum t) t t nil "elt_set(#0,#1,#2)")
+	:inline-unsafe ((t t t) t t nil
+		"@2;((#0)->string.self[fix(#1)]=char_code(#2),(#2))")
+	:inline-unsafe ((t fixnum character) character t nil
+		"(#0)->string.self[#1]= #2"))
+(SCHAR "Lchar" (string fixnum) character nil nil
+	:inline-always ((t t) t nil t "elt(#0,fixint(#1))")
+	:inline-always ((t fixnum) t nil t "elt(#0,#1)")
+	:inline-unsafe ((t t) t nil nil "code_char((#0)->string.self[fix(#1)])")
+	:inline-unsafe ((t t) fixnum nil nil "(#0)->string.self[fix(#1)]")
+	:inline-unsafe ((t fixnum) fixnum nil nil "(#0)->string.self[#1]")
+	:inline-unsafe ((t fixnum) character nil nil "(#0)->string.self[#1]"))
+(si::SCHAR-SET "siLchar_set"
+	(string fixnum character) character nil nil
+	:inline-always ((t t t) t t nil "elt_set(#0,fixint(#1),#2)")
+	:inline-always ((t fixnum t) t t nil "elt_set(#0,#1,#2)")
+	:inline-unsafe ((t t t) t t nil
+		"@2;((#0)->string.self[fix(#1)]=char_code(#2),(#2))")
+	:inline-unsafe ((t fixnum character) character t nil
+		"(#0)->string.self[#1]= #2"))
+(STRING= "Lstring_eq" (string string *) T nil t
+	:inline-always ((string  string) boolean nil nil "string_eq(#0,#1)"))
+(STRING-EQUAL "Lstring_equal" (string string *) T nil t
+	:inline-always ((string  string) boolean nil nil "string_equal(#0,#1)"))
+(STRING< "Lstring_l" (string string *) T nil t)
+(STRING> "Lstring_g" (string string *) T nil t)
+(STRING<= "Lstring_le" (string string *) T nil t)
+(STRING>= "Lstring_ge" (string string *) T nil t)
+(STRING/= "Lstring_neq" (string string *) T nil t)
+(STRING-LESSP "Lstring_lessp" (string string *) T nil t)
+(STRING-GREATERP "Lstring_greaterp" (string string *) T nil t)
+(STRING-NOT-LESSP "Lstring_not_lessp" (string string *) T nil t)
+(STRING-NOT-GREATERP "Lstring_not_greaterp" (string string *) T nil t)
+(STRING-NOT-EQUAL "Lstring_not_equal" (string string *) T nil t)
+(MAKE-STRING "Lmake_string" (fixnum *) string)
+(STRING-TRIM "Lstring_trim" (t string) string)
+(STRING-LEFT-TRIM "Lstring_left_trim" (t string) string)
+(STRING-RIGHT-TRIM "Lstring_right_trim" (t string) string)
+(STRING-UPCASE "Lstring_upcase" (string *) string)
+(STRING-DOWNCASE "Lstring_downcase" (string *) string)
+(STRING-CAPITALIZE "Lstring_capitalize" (string *) string)
+(NSTRING-UPCASE "Lnstring_upcase" (string *) string)
+(NSTRING-DOWNCASE "Lnstring_downcase" (string *) string)
+(NSTRING-CAPITALIZE "Lnstring_capitalize" (string *) string)
+(STRING "Lstring" (T) string nil t
+	:inline-always ((t) t nil nil "coerce_to_string(#0)"))
+(STRING-CONCATENATE "siLstring_concatenate" (T) string nil nil)
+
+; file structure.d
+(si::MAKE-STRUCTURE "siLmake_structure" (T *) T)
+(si::COPY-STRUCTURE "siLcopy_structure" (T T) T)
+(SI::STRUCTURE-NAME "siLstructure_name" (T) SYMBOL NIL NIL
+	:inline-always ((structure) symbol nil nil "SNAME(#0)"))
+(si::STRUCTURE-REF "siLstructure_ref" (t t fixnum) T nil nil
+	:inline-always ((t t fixnum) t nil nil "structure_ref(#0,#1,#2)"))
+(si::STRUCTURE-SET "siLstructure_set" (t t fixnum t) T nil nil
+	:inline-always ((t t fixnum t) t T nil "structure_set(#0,#1,#2,#3)"))
+(SI::STRUCTUREP "siLstructurep" (T) T NIL T
+	:inline-always ((t) boolean nil nil "type_of(#0)==t_structure"))
+(SI::STRUCTURE-SUBTYPE-P "siLstructure_subtype_p" (T T) T NIL T)
+(si::RPLACA-NTHCDR "siLrplaca_nthcdr" (T T T) nil T nil t)
+(si::LIST-NTH "siLlist_nth" (T T) T nil t)
+
+; file toplevel.c
+(si::*MAKE-SPECIAL "siLAmake_special" nil T)
+(si::*MAKE-CONSTANT "siLAmake_constant" nil T)
+
+; file symbol.d
+(GET "Lget" (symbol t *) T nil nil
+	:inline-always ((t t t) t nil nil "get(#0,#1,#2)")
+	:inline-always ((t t) t nil nil "get(#0,#1,Cnil)")
+	:inline-unsafe ((t t t) t nil nil "getf((#0)->symbol.plist,#1,#2)")
+	:inline-unsafe ((t t) t nil nil "getf((#0)->symbol.plist,#1,Cnil)"))
+(REMPROP "Lremprop" (symbol t) T nil nil
+	:inline-always ((t t) t t nil "remprop(#0,#1)"))
+(SYMBOL-PLIST "Lsymbol_plist" (symbol) T nil T
+	:inline-always ((t) t nil nil "((#0)->symbol.plist)"))
+(GETF "Lgetf" (T T *) T)
+(GET-PROPERTIES "Lget_properties" (T T) *)
+(SYMBOL-NAME "Lsymbol_name" (symbol) string nil nil
+	:inline-always ((symbol) t nil t "((#0)->symbol.name)")
+	:inline-always ((t) t nil t "symbol_name(#0)"))
+(MAKE-SYMBOL "Lmake_symbol" (string) symbol)
+(COPY-SYMBOL "Lcopy_symbol" (symbol *) symbol)
+(GENSYM "Lgensym" (*) symbol)
+(GENTEMP "Lgentemp" (*) symbol)
+(SYMBOL-PACKAGE "Lsymbol_package" (symbol) T)
+(KEYWORDP "Lkeywordp" (T) T NIL T
+;  :inline-always ((t) boolean nil nil
+;        "@0;(type_of(#0)==t_symbol&&(#0)->symbol.hpack==keyword_package)")
+ )
+(SI::PUT-F "siLput_f" NIL (T T))
+(SI::REM-F "siLrem_f" NIL (T T))
+(si::SET-SYMBOL-PLIST "siLset_symbol_plist" (symbol t) T)
+(SI::PUTPROP "siLputprop" (T T T) T NIL NIL
+	:inline-always ((t t t) t t nil "putprop(#0,#1,#2)"))
+
+; file tcp.c
+(si::OPEN-TCP-STREAM "Lopen_tcp_stream" (T T) T)
+
+; file unixfasl.c
+(si::READ-EXTERNALS "siLread_externals" nil T)
+(si::SET-UP-COMBINED "siLset_up_combined" nil T)
+(si::BUILD-SYMBOL-TABLE "siLbuild_symbol_table" nil T)
+#+bsd
+(si::FASLINK "siLfaslink" nil T)
+
+; file unixtime.c
+(si::DAYLIGHT-SAVING-TIME-P "Ldaylight_saving_timep" nil T nil t)
+(GET-UNIVERSAL-TIME "Lget_universal_time" nil T)
+(GET-INTERNAL-RUN-TIME "Lget_internal_run_time" nil T)
+(GET-INTERNAL-REAL-TIME "Lget_internal_real_time" nil T)
+(si::GET-LOCAL-TIME-ZONE "Lget_local_time_zone" nil T)
+(SLEEP "Lsleep" (real) T)
+
+(TYPE-OF "Ltype_of" (T) T NIL NIL
+	:inline-always ((t) t nil t "TYPE_OF(#0)"))
+
+;;; Beppe's additions
+(READ-BYTES "Lread_bytes" (stream string fixnum fixnum) T)
+(WRITE-BYTES "Lwrite_bytes" (stream string fixnum fixnum) T)
+
+;;; AKCL additions:
+(SI::COPY-STREAM "siLcopy_stream" (T T) T)
+
+;; file numlib.lsp:
+(LOGNOT nil nil nil NIL NIL
+	:inline-always ((fixnum) fixnum nil nil "(~(#0))"))
+
+;;; file cmpfun.lsp:
+;;; The following functions are introduced by the compiler in pass 1 
+
+(shift>> nil nil nil NIL NIL
+	:inline-always ((fixnum fixnum) fixnum nil nil "((#0) >> (- (#1)))"))
+(shift<< nil nil nil NIL NIL
+	:inline-always ((fixnum fixnum) fixnum nil nil "((#0) << (#1))"))
+(short-float-p nil nil nil T T
+	:inline-always ((t) boolean nil nil "type_of(#0)==t_shortfloat"))
+(long-float-p nil nil nil T T
+	:inline-always ((t) boolean nil nil "type_of(#0)==t_longfloat"))
+(si:fixnump nil nil nil T T
+	:inline-always ((t) boolean nil nil "FIXNUMP(#0)")
+	:inline-always ((fixnum) boolean nil nil "1"))
+(si::put-properties "siLput_properties" (*) nil T)
+)) ; end of inlines
+
+;;; Prolog:
+#+locative
+(setf (get 'si::trail-restore 'proclaimed-return-type) 'null) ; C2OR optimization
+#+locative
+(mapcar #'(lambda (x) (apply #'defsysfun x)) '(
+(si::trail-mark nil nil nil nil nil
+	:inline-always (() nil t nil "trail_mark"))
+(si::trail-restore nil nil nil nil nil
+	:inline-always (() nil t nil "trail_restore"))
+(si::trail-unmark nil nil nil nil nil
+	:inline-always (() nil t nil "trail_unmark"))
+(si::get-value nil nil nil nil nil
+	:inline-always ((t t) boolean t nil "get_value(#0, #1)"))
+(si::get-constant nil nil nil nil nil
+	:inline-always ((t t) boolean t nil "get_constant(#0, #1)"))
+(si::get-nil nil nil nil nil nil
+	:inline-always ((t) boolean t nil "get_nil(#0)"))
+(si::get-cons nil nil nil nil nil
+	:inline-always ((t) boolean t nil "get_cons(#0)"))
+(si::unify-slot nil nil nil nil nil
+	:inline-always (() t t nil "(*slotf)(*slot)"))
+(si::unify-value nil nil nil nil nil
+	:inline-always ((t) boolean t nil "(*slotf)(#0)"))
+(si::unify-constant nil nil nil nil nil
+	:inline-always ((t) boolean t nil "(*slotf)(#0)"))
+(si::unify-nil nil nil nil nil nil
+	:inline-always (() boolean t nil "(*slotf)(Cnil)"))
+)) ; end of #+locative
+
+#+clos
+(mapcar #'(lambda (x) (apply #'defsysfun x)) '(
+; file setf.c
+(si::SETF-NAMEP "siLsetf_namep" nil T nil t)
+
+; file instance.c
+(si::ALLOCATE-INSTANCE "siLallocate_instance" (t fixnum) T)
+(si::INSTANCE-REF "siLinstance_ref" (t fixnum) T nil nil
+	:inline-always ((standard-object fixnum) t nil nil
+		"(#0)->instance.slots[#1]"))
+(si::INSTANCE-REF-SAFE "siLinstance_ref_safe" (t fixnum) T nil nil
+	:inline-unsafe ((standard-object fixnum) t nil nil
+		"(#0)->instance.slots[#1]"))
+(si::INSTANCE-SET "siLinstance_set" (t fixnum t) T nil nil
+	:inline-always ((standard-object fixnum t) t t nil
+		"(#0)->instance.slots[#1]=(#2)"))
+(si::INSTANCE-CLASS "siLinstance_class" (t) T nil nil
+	:inline-always ((standard-object) t nil nil "(#0)->instance.class"))
+(si::INSTANCE-CLASS-SET "siLinstance_class_set" (t t) T)
+(si::INSTANCEP "siLinstancep" (t) T nil t)
+(si::SL-BOUNDP "siLsl_boundp" (t) T nil t
+	:inline-always ((t) boolean nil nil "(#0)!=OBJNULL"))
+(si::SL-MAKUNBOUND "siLsl_makunbound" (t fixnum) T nil t)
+
+; file gfun.c
+(si::ALLOCATE-GFUN "siLallocate_gfun" nil T)
+(si::GFUN-NAME  "siLgfun_name" nil T)
+(si::GFUN-NAME-SET "siLgfun_name_set" nil T)
+(si::GFUN-METHOD-HT "siLgfun_method_ht" nil T)
+(si::GFUN-METHOD-HT-SET "siLgfun_method_ht_set" nil T)
+(si::GFUN-SPEC-HOW-REF  "siLgfun_spec_how_ref" nil T)
+(si::GFUN-SPEC-HOW-SET "siLgfun_spec_how_set" nil T)
+(si::GFUN-INSTANCE  "siLgfun_instance" nil T)
+(si::GFUN-INSTANCE-SET "siLgfun_instance_set" nil T)
+(si::GFUNP "siLgfunp" nil T)
+)) ; end of of #+clos
+
diff --git a/src/cmp/test.lsp b/src/cmp/test.lsp
new file mode 100644
index 000000000..f46139956
--- /dev/null
+++ b/src/cmp/test.lsp
@@ -0,0 +1,481 @@
+
+(in-package 'system)
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+(eval-when (eval compile) (defun sys:clear-compiler-properties (symbol)))
+(eval-when (eval compile) (setq sys:*inhibit-macro-special* nil))
+
+(in-package 'compiler)
+
+(defun d (x) (disassemble x))
+(defun foo (x) (labels ((g () (funcall x))) (g)))
+(defun foo (x) (labels ((g () (funcall g x))) (g)))
+(defun foo (x) (labels ((g (y) (funcall y x))) (g 0)))
+
+#|
+#+:CCL (rplaca (symbol-function 'foo) 'lambda-block)
+
+(defun d () (disassemble 'foo))
+(defmacro defn (&rest body)
+  #+:CCL `(rplacd (symbol-function 'foo) ',body)
+  #+KCL `(defun ,@body))
+(defun test ()
+  (compile-file "test.lsp" :c-file t :h-file t :data-file t :output-file nil))
+|#
+
+(defun fact (n) (if (= 0 n) 1 (* n (fact (1- n)))))
+(defun t1 (n) (flet ((fl1 (x) (h (fl1 (g x))))) (fl1 (t1 n))))
+(defun t2 (n) (labels ((fl1 (x) (h (fl1 (g x))))) (fl1 (t1 n))))
+(defun t3 (n) (macrolet ((m (x) `(h (g ,x)))) (m (t1 n))))
+
+(defun t4 (n) (multiple-value-call #'(lambda (x y &optional z) (foo x y z))
+		(bar n) (gee n)))
+(defun t5 (n) (multiple-value-call #'foo (bar n) (gee n)))
+(defun t6 (n) ((lambda (x y) (foo x y))
+		(bar n) (gee n)))
+(defun t7 (line)
+  (do ((i 0 line)
+       (space-p #'(lambda (c) (or (eql c #\space) (eql c #\tab)))))
+      ((>= i 0)) (funcall space-p)))
+
+
+(defun t8 (n) (bar (bar n n) (bar n n)))
+(defun t9 (n) (bar (bar n (bar n n))))
+(defun t10 (n &optional acc) (bar n acc))
+(proclaim '(special z))
+(defun t11 (z) (bar z z))
+(defun t12 (n &optional z) (bar n z))
+(defconstant kappa 0)
+;(defun t13 (kappa) (bar kappa))
+
+(defun t14 (n) (let ((i 0)) (declare (fixnum i)) (bar (1+ i) n)))
+(defun t15 (n) (let ((i (gee)) (j (gee)))
+                     (declare (fixnum i)) (setq i j) (bar i j n)))
+(defun t16 (n) (let ((sp 1))
+                     (setq sp 3) (bar sp n)))
+(defun t17 (n) (let ((sp 1))
+                     (declare (special sp))
+                     (setq sp 3) (bar sp n)))
+(defun t18 (n) (let ((sp (gee)) (j sp))
+                     (declare (special sp))
+                     (setq j 3) (bar j n)))
+(defun t19 (n) (let* ((sp n) (j sp))
+                     (declare (special sp))
+                     (setq j 3) (bar j n)))
+(defun t20 (n) (let* ((sp (gee)) (j sp))
+                     (declare (special sp))
+                     (setq j 3) (bar j n)))
+;; test cmpmulti.lsp
+(defun t21 (n) (multiple-value-call 'bar (bar n n) (bar n n)))
+(defun t22 (n) (multiple-value-prog1 (bar n n) (bar n n)))
+(defun t22.1 (n) (multiple-value-prog1 (values 1 n) (bar n))))
+(defun t23 (n) (bar (multiple-value-prog1 (bar n n) (bar n n))))
+(defun t24 (n) (bar (multiple-value-prog1 (list n n) (bar n n))))
+(defun t25 (n) (bar (multiple-value-prog1 (* n n n) (bar n n))))
+(defun t25.1 (n) (bar (multiple-value-prog1
+			 (multiple-value-prog1 (* n n n) (bar n n))
+		       (foo n))))
+(defun t26 (n) (values))
+(defun t27 (n) (values n))
+(defun t28 (n) (values n (bar n n)))
+
+(defun t29 (n m) (multiple-value-setq () (bar n n)))
+(defun t30 (n m) (multiple-value-setq (n m) (bar n n)))
+(defun t31 (n m) (multiple-value-setq (n m) (values n n)))
+(defun t32 (n m) (multiple-value-setq (n m) (progn (bar n) (values n n))))
+
+(defun t33 (n)
+          (multiple-value-bind (x y) (bar n n) (bar x y)))
+(defun t34 (n)
+          (multiple-value-bind (x y) (bar n n)
+            (declare (special x)) (bar x y)))
+
+;;; cmpflet.lsp
+(defun t35 (n)
+          (flet ((bar (x) (list x n)))
+            (bar n)))
+(defun t36 (n) (let ((y (gee)))
+                     (flet ((bar (x) (list x y n)))
+                       (bar n))))
+(defun t37 (n) (let ((y n))
+                     (flet ((bar (x) (list x y n)))
+                       (bar n))))
+(defun t38 (n &optional y)
+          (flet ((bar (x) (list x y n)))
+            (bar n)))
+(defun t39 (n &optional y)
+          (flet ((bar (x) 
+                      (flet ((gee () (list x y n)))
+                        (gee))))
+            (bar n)))
+(defun t40 (n)
+  (flet ((bar (x) 
+	   (flet ((gee () (list n n)))
+	     (gee))))
+    (bar n)))
+(defun t41 (n)
+  (print n)
+  (flet ((bar () n)) #'bar))
+(defun t42 (n)
+  (flet ((bar (x) 
+	   (flet ((gee () (list n n)))
+	     #'gee)))
+    (bar n)))
+(defun t43 (n)
+          (let ((y n))
+            (flet ((bar (x) (list x y n)))
+              (bar n)))
+          (let ((y n))
+            (flet ((bar (x) (list x y n)))
+              (bar n))))
+(defun t44 (x y z)
+          (flet ((gen (v) (h y z #'(lambda () (p x v)))))
+            (list x (gen y) (gen z))))
+(defun t45 ()
+          (flet ((gen (z) (bar z))) #'gen))
+(defun t46 ()
+          (flet ((gen (z) (bar z))) (list #'gen)))
+(defun t47 ()
+          (flet ((gen (z) (bar z))) #'(lambda () #'gen)))
+(defun t48 (x y)
+          (flet ((gen (z) (h x y z))) #'gen))
+(defun t49 (x y)
+          (flet ((gen (z) (h x y z)))
+            #'(lambda () (gen 0))))
+(defun t50 (x)
+  (flet ((gen (z) (h x z)))
+    (flet ((bar (y) (gen y)))
+      (bar x))))
+(defun t51 (x)
+  (flet ((gen (z)
+              (flet ((bar () (h x z)))
+                (bar x z))))
+    #'gen))
+(defun t52 (x)
+  (flet ((gen (z)
+              (flet ((bar (y) y)) (bar x z))))
+    (gen x)))
+
+(defun t53 (x)
+  (labels ((bar (y) (gen y))
+           (gen (z) (h x z)))
+    (bar x)))
+(defun t54 (x)
+  (labels ((bar () #'gen)
+           (gen (z) (h x z)))
+    (bar)))
+(defun t55 (x)
+  (labels ((gen (z) (h x z #'gen))
+           (bar () #'gen))
+    (bar)))
+(defun t56 (x)
+  (labels ((gen () #'bar)
+           (bar () #'gen))
+    (bar)))
+(defun t57 (x)
+  (let ((z (list x)))
+    ;; the closure should have no lex:
+    (labels ((gen () (bar x #'(lambda (y) (list z y)))))
+      (gen))))
+(defun t58 (x)
+  (let ((z (list x)))
+    (labels ((foo () x)
+	     (gen () (bar z #'gen)))
+      (gen))))
+(defun t59 (s)
+  ;; no closures:
+  (labels ((vc (x) (list s x))
+	   (hor (y) (vc y)))
+    (mapcar #'hor s)))
+;; g closure:
+(defun foo (x) (flet ((g () (setq x 0)) (h () x)) (k #'h (g))))
+;;; cmpcall.lsp
+(defun t58 (x)
+  ((lambda (&key y z) (foo y z)) :y x))
+(defun t59 (x &rest r)
+  (apply #'(lambda (&key a b c) (foo c b a)) x r))
+
+;;; cmpvar.lsp
+(defun t60 (n m)
+          (psetq n (setq m 0) m (bar m)))
+;; contravariance
+(defun t61 (n) (let ((k 0))
+                     (declare (fixnum k)) (setq k (* (length n) n))))
+(defun t62 (n) (let ((k 0))
+                     (declare (special k))
+                     (setq k (* (length n) n))))
+(defun t63 (n) (declare (vector n))
+          (aref n (length n)))
+
+(defun t64 (x y) (rplaca (bar x) y))
+(defun t65 (x) ((lambda (y &optional z) (cons y z)) (1+ x) 3))
+
+;;; cmptag.lsp
+(defun t66 () (tagbody (flet ((bar () (go a))) (bar)) a (boh)))
+(defun t67 () (tagbody (flet ((bar ()
+				 (flet ((gee () (go a))) (gee))))
+			  (bar)) a (boh)))
+(defun foo () (tagbody l1 (a) (flet ((b () (go l1))) (b)) (go l1)))
+(defun foo () (tagbody l1 (a) (unwind-protect (go l1) (b))))
+
+;;; cmpblock.lsp
+(defun foo () (flet ((bar () (return-from foo))) (bar)))
+(defun foo () (flet ((bar () (return-from foo))) #'bar))
+(defun foo () (block b (bar #'(lambda (x) (return-from b)))))
+;; non buono il trattamento di catch:
+(defun t71 () (catch 'ME (bar)))
+(defun t71 () (catch 'ME (unwind-protect (throw 'ME (bar)) (gee))))
+
+;;; cmpcatch.lsp
+(defun foo () (unwind-protect (return-from foo 0) 1))
+
+;;; cmpflet.lsp + cmplam.lsp
+;;; bug: CLV0 is estracted in both lambda's
+(defun foo (clv0)
+  (labels ((bar (clv2)
+	     (gee clv0)
+	     #'(lambda () (bar clv2 #'bar))))
+    #'(lambda (x) (bar x #'bar))))
+
+(defun foo (hmm)			; hmm is closure variable
+  (flet ((bar () hmm))
+    #'(lambda (y) (bar y))))
+
+;;; g lex, f cfun:
+(defun foo ()
+  (labels ((f (x) x)
+	   (g () #'f))
+    (g)))
+
+;;; f, g, h closures:
+(defun foo (x)
+  (labels ((f () (list (h) (g)))
+	   (g () #'f)
+	   (h () x))
+    (g)))
+
+;;; f, g, h closures:
+(defun foo (x)
+  (flet ((h () x))
+    (labels ((f () (list (h) (g)))
+	     (g () #'f))
+      (g))))
+
+;;; b closure, c lex:
+(defun foo () (tagbody l1 (a)
+		 (labels ((b () (go l1)) (c () #'b)) (c))
+		 (go l1)))
+
+;;; cmpfun.lsp
+(defun t80 (x) (apply #'(lambda (y &rest z) (list y z)) x))
+
+;;; cmptop.lsp
+(let ((z))
+  (foo #'(lambda () (setq z nil)))
+  (defun gee (hmm r)
+    (flet ((do-state ()
+	     (bar #'(lambda (x) x) hmm)))
+      (do-state))
+    #'(lambda ()
+	(bar #'(lambda (x) x) hmm))))
+
+;;; various test of closures:
+
+(defun foo (x)
+  (when x (block ccb
+	    #'(lambda (x) (return-from ccb y))))
+  (bar #'(lambda () (car x))))
+
+(defun foo (x)
+  (when x (let (ccb)
+	    (bar #'(lambda (x) (list ccb y)))))
+  (bar #'(lambda () (car x))))
+
+(defun foo ()
+  (let (x)
+    (when x (let (ccb)
+	      (bar #'(lambda (x) (list ccb y)))))
+    (bar #'(lambda () (car x)))))
+
+(defun foo (x)
+  (let (ccb)
+    (bar #'(lambda () (list ccb x)))))
+
+(defun foo (x)
+  (let (ccb *print-pretty*)
+    (bar #'(lambda () (list ccb x)))))
+
+(defun foo (x)
+  (if x (let (ccb)
+	  (bar #'(lambda (x) (list ccb y))))
+      (bar #'(lambda () (car x)))))
+
+(defun foo (gram)
+  (let* ((new (let ((x use-nt)) (bar x))))
+    #'(lambda () (merge-in-nt new gram))))
+
+;; lex0 and env0:
+(defun foo (gf em)
+  (labels ((bar (c) (list gf em #'(lambda () gf) (bar c))))
+    (bar gf)))
+
+;; kintern should not use lex0:
+(defun foo (x)
+  (flet ((kintern (s) s)
+	 (bar () x))
+    (list (bar) #'(lambda (z) (kintern z)))))
+
+;; tail recursion for labels:
+(defun foo (gf em)
+  (labels ((bar (c) (bar #'(lambda () gf))))
+    (bar gf)))
+
+;; proper use of temporary in inline-args:
+(defun foo (x v) (declare (fixnum x) (simple-vector v))
+       (the fixnum (+ (the fixnum (aref v 0)) (the fixnum (bar)))))
+(defun foo (x v) (declare (fixnum x) (simple-vector v))
+       (bar (the fixnum (aref v 0)) (bar)))
+(defun foo (x v) (declare (fixnum x) (type (vector fixnum) v))
+       (the fixnum (+ (the fixnum (aref v 0)) (the fixnum (bar)))))
+(defun foo (z)
+  (declare (double-float z))
+  (* (+ z 0.5d0) (log z)))
+(defun foo () (bar (plusp 3) (bar)))
+
+;; keyword initialization
+(defun foo (&rest r &key (arg (PROGN (X-ERROR) *DUMMY*)) b) arg)
+
+;; volatile
+(defun foo (l)
+  (dolist (var l) (when var (return-from foo var))))
+(defun foo (l &aux (y (car l)))
+  (flet ((bar (x) (return-from foo x)))
+    (bar l) y))
+(defun foo (l &aux y)
+ (setq y (car l)) (list #'(lambda (x) (return-from foo x)) y))
+
+;; lex0 only:
+(defun foo (arg)
+  (flet ((bar (x) (cons x arg)))
+    (flet ((gee (x) (bar x)))
+      (gee arg))))
+;; lex0 only:
+(defun foo (arg)
+  (flet ((bar (x) (cons x arg)))
+    (let ((y arg))
+      (flet ((gee (x) (cons y (bar x))))
+	(gee arg)))))
+;; lex0, lex1:
+(defun foo (x)
+  (labels ((gen (z)
+	     (flet ((bar (w) (list x w z)))
+	       (bar (gen (cdr z))))))
+    (gen x)))
+;; lex0, lex1:
+(defun foo (x)
+  (flet ((gen (z)
+	     (flet ((bar (w) (list x w z)))
+	       (bar (cdr z)))))
+    (gen x)))
+;; lex0, lex1:
+(defun foo (x)
+  (flet ((gen (y)
+	   (let ((z y))
+	     (flet ((bar (w) (list x w z)))
+	       (bar (cdr z))))))
+    (gen x)))
+;; link should not be a closure:
+(defun foo ()
+  (labels ((link (y) (list #'(lambda (x) (eq x y)))))
+    (link 3)))
+;; lex required for gee:
+(defun foo (x)
+  (labels ((bar (y) y)
+	   (gee () (list #'bar)))
+    (gee)))
+;; Still to fix. No closure for bar:
+(defun foo ()
+  (labels ((bar () (bar))) #'bar))
+
+;; inlininig:
+(defun foo (a) (declare (type (array bit) a)) (setf (aref a 3) 0))
+(defun foo (map byte bit)
+  (declare (fixnum bit byte) (type (simple-array bit (*)) map))
+  (setq byte (the fixnum (logior (the fixnum (ash byte 1))
+				 (aref map bit)))))
+;; Still to fix. Should use just env0:
+(defun foo (x)
+  (TAGBODY
+     (CONS
+      #'(LAMBDA () (GO tag))
+      #'(LAMBDA () x))
+   tag)
+  NIL)
+;; bar itself should be in its own env:
+(defun foo (x)
+  (labels ((bar () (cons x (gee #'bar))))
+    (bar)))
+;; Segmentation violation
+(defun c2compiler-let (symbols values body)
+  (progv symbols values (c2expr body)))
+
+;; Bug signalled by donc@ISI.EDU (Don Cohen)
+(defun foo ()
+  (labels ((outer ()
+	     (labels ((inner () nil))
+	       (list
+		 #'(lambda () (outer))
+  	         #'(lambda () (inner))))))
+    (outer)))
+;; variant:
+(defun foo ()
+  (labels ((outer ()
+	     (list
+	      #'(lambda () (outer))
+	      (labels ((inner () nil))
+		#'(lambda () (inner))))))
+    (outer)))
+
+;; let*: extra bds_unwind1
+;;        if((V3=CDR(V3))==Cnil){
+;;        bds_bind(VV[0],T0);                       /*  *VAL*           */
+;;        bds_unwind1;
+;;        goto L1;}
+(defun foo (x)
+  (let* ((*val* (mapcar #'list *val*)))
+    (declare (special *val*))
+    x))
+;; compiler error:
+(defun foo (x)
+  (flet ((bar () x))
+    #'(lambda () #'bar)))
+;;
+(defun foo (x)
+  (flet ((bar (z) x))
+    #'(lambda (args) (mapcar #'bar args)))) ; must be closure
+;; Nested closures. Compiler bug:
+(defun foo (x) #'(lambda () (list #'(lambda () x))))
+;;
+(defun foo () (macrolet ((g () nil)) (g)))
+;; extra var V2:
+(defun foo (htp) (flet ((b () htp)) (b)))
+;; declaration of lex0 in .h must be lex0[1]
+;; (use :tr (wt-function-epilogue :print (*lex*)) for disassemble):
+(defun foo (x)
+  (let (x) (flet ((bar () x)) (bar)))
+  nil)
+;; cc: undeclared variable i:
+(defun foo (x)
+  (MULTIPLE-VALUE-CALL #'(LAMBDA (&REST TRYVALUE) TRYVALUE) x))
+;; cc: undeclared variable args:
+(defun foo (x) (flet ((g (&key a))) (g :a x)))
+;; lambda's should NOT be shared:
+(defun foo () (cons #'(lambda (x y) x) #'(lambda (x y) y)))
+(defun foo () (cons #'(lambda (x y) y) #'(lambda (x &rest y) y)))
+(defun foo () (cons #'(lambda () (setq x nil)) #'(lambda () (setq y nil))))
+;; lambda's should be shared:
+(defun foo () (cons #'(lambda (x y) x) #'(lambda (y x) y)))
+(defun foo () (cons #'(lambda (x) (let (z) (cons z x)))
+		    #'(lambda (z) (let (x) (cons x z)))))
+;; result should not be fixnum
+(defun foo () (/ 3 2))
diff --git a/src/compile.lsp.in b/src/compile.lsp.in
new file mode 100644
index 000000000..e2980d5c6
--- /dev/null
+++ b/src/compile.lsp.in
@@ -0,0 +1,38 @@
+;;;
+;;; Configuration file for the bootstrapping version of ECLS
+;;;
+(load "bare.lsp")
+
+;;;
+;;; * Compile, load and link Common-Lisp base library
+;;;
+(in-package "COMMON-LISP-USER")
+(load "lsp/defsys.lsp")
+(sbt::operate-on-system lsp :library)
+;(sbt::operate-on-system lsp :load)
+
+#ifndef RUNTIME
+;;;
+;;; * Compile, load and link Common-Lisp to C compiler
+;;;
+(load "cmp/defsys.lsp")
+(sbt::operate-on-system cmp :library)
+;(sbt::operate-on-system cmp :load)
+#endif RUNTIME
+
+#ifdef CLOS
+;;;
+;;; * Compile, load and link PCL based Common-Lisp Object System
+;;;
+(load "clos/defsys.lsp")
+(sbt::operate-on-system clos :library)
+;(sbt::operate-on-system clos :load)
+#endif CLOS
+
+(compiler::build-ecls "ecls"
+#ifndef RUNTIME
+	   'cmp
+#endif
+)
+
+(quit)
diff --git a/src/compile2.lsp.in b/src/compile2.lsp.in
new file mode 100644
index 000000000..cef572643
--- /dev/null
+++ b/src/compile2.lsp.in
@@ -0,0 +1,55 @@
+;;;
+;;; Configuration file for the bootstrapping version of ECLS
+;;;
+
+;;;
+;;; * Beppe's defsystem utility
+;;;
+(load "@srcdir@/util/system.lsp")
+
+;;;
+;;; * We redefine this to force generation of source files
+;;; in the object directory -- source files help debugging
+;;; with GDB.
+;;;
+(defun sbt::sbt-compile-file (&rest s)
+  (apply #'compiler::compile-file
+	   (car s)
+	   :c-file t :h-file t :data-file t :system-p t
+	   (cdr s)))
+
+(setq compiler::*cc-flags* (concatenate 'string compiler::*cc-flags* " -I@srcdir@/h -I@srcdir@/gmp -I@builddir@/h"))
+
+;;;
+;;; * Compile, load and link Common-Lisp base library
+;;;
+(in-package "USER")
+(load "lsp/defsys.lsp")
+(sbt::operate-on-system lsp :library)
+;(sbt::operate-on-system lsp :load)
+
+#ifndef RUNTIME
+;;;
+;;; * Compile, load and link Common-Lisp to C compiler
+;;;
+(load "cmp/defsys.lsp")
+(sbt::operate-on-system cmp :library)
+;(sbt::operate-on-system cmp :load)
+#endif RUNTIME
+
+#ifdef CLOS
+;;;
+;;; * Compile, load and link PCL based Common-Lisp Object System
+;;;
+(load "clos/defsys.lsp")
+(sbt::operate-on-system clos :library)
+;(sbt::operate-on-system clos :load)
+#endif CLOS
+
+(compiler::build-ecls "ecls"
+#ifndef RUNTIME
+	   'cmp
+#endif
+)
+
+(quit)
diff --git a/src/compile_rest.lsp.in b/src/compile_rest.lsp.in
new file mode 100644
index 000000000..082507454
--- /dev/null
+++ b/src/compile_rest.lsp.in
@@ -0,0 +1,49 @@
+;;;
+;;; Configuration file for the remaining libraires of ECLS
+;;;
+;;;
+;;; * Learn where we come from and where we go to
+;;;
+(in-package "SYSTEM")
+(*make-special '*ecls-srcdir*) ; defparameter is missing
+(*make-special '*ecls-builddir*)
+(setq *ecls-srcdir* #P"@srcdir@/")
+(setq *ecls-builddir* (sys::chdir *ecls-srcdir*))
+(setq *system-directory* *ecls-builddir*)
+(setq compiler::*cc-flags* (concatenate 'string compiler::*cc-flags* " -I@srcdir@/h -I@srcdir@/gmp "))
+
+;;;
+;;; * Load system builder tool
+;;;
+(in-package "CL-USER")
+(load "@srcdir@/util/system.lsp")
+
+;;;
+;;; * We redefine this to force generation of source files
+;;; in the object directory -- source files help debugging
+;;; with GDB.
+;;;
+(defun sbt::sbt-compile-file (&rest s)
+  (apply #'compiler::compile-file
+	   (car s)
+	   :c-file t :h-file t :data-file t :system-p t
+	   (cdr s)))
+
+#ifdef CLX
+;;;
+;;; * Compile and link MIT CLX extensions
+;;;
+(push :clx-ansi-common-lisp *features*)
+(sys::chdir (merge-pathnames "clx/" sys::*ecls-builddir*))
+(load "defsys.lsp")
+(sbt::operate-on-system clx :library)
+
+(sys::chdir sys::*ecls-builddir*)
+(compiler::build-ecls "eclx"
+#ifndef RUNTIME
+	   'cmp
+#endif
+	   'clx
+)
+#endif CLX
+
diff --git a/src/config.guess b/src/config.guess
new file mode 100755
index 000000000..08018f497
--- /dev/null
+++ b/src/config.guess
@@ -0,0 +1,1373 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+#
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000
+# 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>.
+# Please send patches to <config-patches@gnu.org>.
+#
+# 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
+
+dummy=dummy-$$
+trap 'rm -f $dummy.c $dummy.o $dummy ${dummy}1.s ${dummy}2.c ; exit 1' 1 2 15
+
+# Use $HOST_CC if defined. $CC may point to a cross-compiler
+if test x"$CC_FOR_BUILD" = x; then
+  if test x"$HOST_CC" != x; then
+    CC_FOR_BUILD="$HOST_CC"
+  else
+    if test x"$CC" != x; then
+      CC_FOR_BUILD="$CC"
+    else
+      echo 'dummy(){}' >$dummy.c
+      for c in cc c89 gcc; do 
+	  ($c $dummy.c -c) >/dev/null 2>&1
+	  if test $? = 0; then
+	      CC_FOR_BUILD="$c"; break
+	  fi
+      done
+      rm -f $dummy.c $dummy.o
+      if test x"$CC_FOR_BUILD" = x; then
+	CC_FOR_BUILD=no_compiler_found
+      fi
+    fi
+  fi
+fi
+
+
+# First make a best effort at recognizing x86 CPU type and leave it in X86CPU.
+# If we fail, set X86CPU to UNAME_MACHINE
+#
+# DJGPP v2 (or 2.03 at least) always gives "pc" for uname -m, and the
+# OEM for uname -s.  Eg. pc:MS-DOS:6:2 on MS-DOS 6.21.  The list of
+# possible OEMs is in src/libc/dos/dos/getdos_v.c of djlsr203.zip, but
+# just pc:*:*:* seems ok.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+    i?86:*:*:* | i86pc:*:*:* | pc:*:*:*)
+	case "${UNAME_MACHINE}" in
+	i86pc | pc)  UNAME_MACHINE=i386 ;;
+	esac
+	cat <<EOF >${dummy}1.s
+	.globl cpuid
+	.globl _cpuid
+cpuid:
+_cpuid:
+	pushl %esi
+	pushl %ebx
+	movl 16(%esp),%eax
+	.byte 0x0f
+	.byte 0xa2
+	movl 12(%esp),%esi
+	movl %ebx,(%esi)
+	movl %edx,4(%esi)
+	movl %ecx,8(%esi)
+	popl %ebx
+	popl %esi
+	ret
+EOF
+	cat <<EOF >${dummy}2.c
+main ()
+{
+  char vendor_string[13];
+  char dummy_string[12];
+  long fms;
+  int family, model;
+  char *modelstr;
+
+  cpuid (vendor_string, 0);
+  vendor_string[12] = 0;
+
+  fms = cpuid (dummy_string, 1);
+
+  family = (fms >> 8) & 15;
+  model = (fms >> 4) & 15;
+
+  modelstr = "i486";
+  if (strcmp (vendor_string, "GenuineIntel") == 0)
+    {
+      switch (family)
+	{
+	case 5:
+	  if (model <= 2)
+	    modelstr = "pentium";
+	  else if (model >= 4)
+	    modelstr = "pentiummmx";
+	  break;
+	case 6:
+	  if (model == 1)
+	    modelstr = "pentiumpro";
+	  else if (model <= 6)
+	    modelstr = "pentium2";
+	  else
+	    modelstr = "pentium3";
+	  break;
+	}
+    }
+  else if (strcmp (vendor_string, "AuthenticAMD") == 0)
+    {
+      switch (family)
+	{
+	case 5:
+	  if (model <= 3)
+	    modelstr = "k5";
+	  else if (model <= 7)
+	    modelstr = "k6";
+	  else if (model <= 8)
+	    modelstr = "k62";
+	  else if (model <= 9)
+	    modelstr = "k63";
+	  break;
+	case 6:
+	  modelstr = "athlon";
+	  break;
+	}
+    }
+  else if (strcmp (vendor_string, "CyrixInstead") == 0)
+    {
+      /* Should recognize Cyrix' processors too.  */
+    }
+
+  printf ("%s\n", modelstr);
+  return 0;
+}
+EOF
+	$CC_FOR_BUILD ${dummy}1.s ${dummy}2.c -o $dummy >/dev/null 2>&1
+	if test "$?" = 0 ; then
+	  X86CPU=`./$dummy`
+	fi
+
+
+	# Default to believing uname -m if the program fails to compile or
+	# run.  Will fail to run on 386 since cpuid was only added on 486.
+	if test -z "$X86CPU"
+	then
+	    X86CPU="$UNAME_MACHINE"
+	fi
+	rm -f ${dummy}1.s ${dummy}2.c $dummy
+  ;;
+esac
+
+# 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
+	.data
+\$Lformat:
+	.byte 37,100,45,37,120,10,0	# "%d-%x\n"
+
+	.text
+	.globl main
+	.align 4
+	.ent main
+main:
+	.frame \$30,16,\$26,0
+	ldgp \$29,0(\$27)
+	.prologue 1
+	.long 0x47e03d80 # implver \$0
+	lda \$2,-1
+	.long 0x47e20c21 # amask \$2,\$1
+	lda \$16,\$Lformat
+	mov \$0,\$17
+	not \$1,\$18
+	jsr \$26,printf
+	ldgp \$29,0(\$26)
+	mov 0,\$16
+	jsr \$26,exit
+	.end main
+EOF
+	$CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
+	if test "$?" = 0 ; then
+		case `./$dummy` in
+			0-0)
+				UNAME_MACHINE="alpha"
+				;;
+			1-0)
+				UNAME_MACHINE="alphaev5"
+				;;
+			1-1)
+				UNAME_MACHINE="alphaev56"
+				;;
+			1-101)
+				UNAME_MACHINE="alphapca56"
+				;;
+			2-303)
+				UNAME_MACHINE="alphaev6"
+				;;
+			2-307)
+				UNAME_MACHINE="alphaev67"
+				;;
+		esac
+	fi
+	rm -f $dummy.s $dummy
+	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+	exit 0 ;;
+    alpha:NetBSD:*:* | alpha:FreeBSD:*:*)
+	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_FOR_BUILD $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}-unknown-`echo ${UNAME_SYSTEM}${UNAME_RELEASE} | sed -e 's/^[VTX]//' -e 's/[-(].*//' | tr [[A-Z]] [[a-z]]`
+	exit 0 ;;
+    Alpha\ *:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# Should we change UNAME_MACHINE based on the output of uname instead
+	# of the specific Alpha model?
+	echo alpha-pc-interix
+	exit 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 ;;
+    *:[Aa]miga[Oo][Ss]:*:*)
+	echo ${UNAME_MACHINE}-unknown-amigaos
+	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 ;;
+    *:OS/390:*:*)
+	echo i370-ibm-openedition
+	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*:*:* | MIS*:SMP_DC-OSx*:*:*)
+	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+	if test "`(/bin/universe) 2>/dev/null`" = att ; then
+		echo pyramid-pyramid-sysv3
+	else
+		echo pyramid-pyramid-bsd
+	fi
+	exit 0 ;;
+    NILE*:*:*:dcosx)
+	echo pyramid-pyramid-svr4
+	exit 0 ;;
+    sun4H:SunOS:5.*:*)
+	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    sun4[md]:SunOS:5.*:*)
+	echo sparcv8-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    sun4u:SunOS:5.*:*)
+	echo sparcv9-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    i386:SunOS:5.*:*)
+	echo ${X86CPU}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    sun4[md]: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 sparcv8-sun-sunos`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 ;;
+    # The situation for MiNT is a little confusing.  The machine name
+    # can be virtually everything (everything which is not
+    # "atarist" or "atariste" at least should have a processor
+    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"
+    # to the lowercase version "mint" (or "freemint").  Finally
+    # the system name "TOS" denotes a system which is actually not
+    # MiNT.  But MiNT is downward compatible to TOS, so this should
+    # be no problem.
+    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+        echo m68k-atari-mint${UNAME_RELEASE}
+	exit 0 ;;
+    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+	echo m68k-atari-mint${UNAME_RELEASE}
+        exit 0 ;;
+    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+        echo m68k-atari-mint${UNAME_RELEASE}
+	exit 0 ;;
+    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+        echo m68k-milan-mint${UNAME_RELEASE}
+        exit 0 ;;
+    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+        echo m68k-hades-mint${UNAME_RELEASE}
+        exit 0 ;;
+    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+        echo m68k-unknown-mint${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 ;;
+    macppc:NetBSD:*:*)
+	echo powerpc-apple-netbsd${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:*:* | 2430:CLIX:*:*)
+	echo clipper-intergraph-clix${UNAME_RELEASE}
+	exit 0 ;;
+    mips:*:*:UMIPS | mips:*:*:RISCos)
+	sed 's/^	//' << EOF >$dummy.c
+#ifdef __cplusplus
+#include <stdio.h>  /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+	#if defined (host_mips) && defined (MIPSEB)
+	#if defined (SYSTYPE_SYSV)
+	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_SVR4)
+	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+	#endif
+	#endif
+	  exit (-1);
+	}
+EOF
+	$CC_FOR_BUILD $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 ] || [ $UNAME_PROCESSOR = mc88110 ]
+	then
+	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
+	       [ ${TARGET_BINARY_INTERFACE}x = x ]
+	    then
+		echo m88k-dg-dgux${UNAME_RELEASE}
+	    else
+		echo m88k-dg-dguxbcs${UNAME_RELEASE}
+	    fi
+	else
+	    echo i586-dg-dgux${UNAME_RELEASE}
+	fi
+ 	exit 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_FOR_BUILD $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)
+	sed 's/^	//' << EOF >$dummy.c
+	#include <stdio.h>
+	#include <sys/systemcfg.h>
+	main ()
+	{
+	  if (_system_configuration.architecture == POWER_RS
+	      || _system_configuration.implementation == POWER_601)
+	    puts ("power");
+	  else
+	    {
+	      if (_system_configuration.width == 64)
+		puts ("powerpc64");
+	      else
+		puts ("powerpc");
+	    }
+	  exit (0);
+	}
+EOF
+	$CC_FOR_BUILD $dummy.c -o $dummy
+	IBM_ARCH=`./$dummy`
+	rm -f $dummy.c $dummy
+	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 BSD 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/[34678]??:HP-UX:*:*)
+	case "${UNAME_MACHINE}" in
+	    9000/31? )            HP_ARCH=m68000 ;;
+	    9000/[34]?? )         HP_ARCH=m68k ;;
+	    9000/[678][0-9][0-9])
+              sed 's/^              //' << EOF >$dummy.c
+
+              #define _HPUX_SOURCE
+              #include <stdlib.h>
+              #include <unistd.h>
+
+              int main ()
+              {
+              #if defined(_SC_KERNEL_BITS)
+                  long bits = sysconf(_SC_KERNEL_BITS);
+              #endif
+                  long cpu  = sysconf (_SC_CPU_VERSION);
+
+                  switch (cpu)
+              	{
+              	case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+              	case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+              	case CPU_PA_RISC2_0:
+              #if defined(_SC_KERNEL_BITS)
+              	    switch (bits)
+              		{
+              		case 64: puts ("hppa2.0w"); break;
+              		case 32: puts ("hppa2.0n"); break;
+              		default: puts ("hppa2.0"); break;
+              		} break;
+              #else  /* !defined(_SC_KERNEL_BITS) */
+              	    puts ("hppa2.0"); break;
+              #endif
+              	default: puts ("hppa1.0"); break;
+              	}
+                  exit (0);
+              }
+EOF
+	(CCOPTS= $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null ) && HP_ARCH=`./$dummy`
+	rm -f $dummy.c $dummy
+	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_FOR_BUILD $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 ;;
+    *9??*:MPE/iX:*:*)
+	echo hppa1.0-hp-mpeix
+	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 ;;
+    hppa*:OpenBSD:*:*)
+	echo hppa-unknown-openbsd
+	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} | sed -e 's/\.[^.]*$/.X/'
+	exit 0 ;;
+    CRAY*T3D:*:*:*)
+	echo alpha-cray-unicos
+	exit 0 ;;
+    CRAY*T3E:*:*:*)
+	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit 0 ;;
+    CRAY*SV1:*:*:*)
+	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit 0 ;;
+    CRAY-2:*:*:*)
+	echo cray2-cray-unicos
+        exit 0 ;;
+    F300:UNIX_System_V:*:*)
+        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | 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:*:* | i?86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+	echo ${X86CPU}-pc-bsdi${UNAME_RELEASE}
+	exit 0 ;;
+    sparc*:BSD/OS:*:*)
+	echo sparc-unknown-bsdi${UNAME_RELEASE}
+	exit 0 ;;
+    *:BSD/OS:*:*)
+	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+	exit 0 ;;
+    i386:FreeBSD:*:*)
+	echo ${X86CPU}-pc-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+	exit 0 ;;
+    *:FreeBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+	exit 0 ;;
+    i386:NetBSD:*:*)
+	echo ${X86CPU}-pc-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+	exit 0 ;;
+    *:NetBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+	exit 0 ;;
+    i386:OpenBSD:*:*)
+	echo ${X86CPU}-pc-openbsd`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 ${X86CPU}-pc-cygwin
+	exit 0 ;;
+    i*:MINGW*:*)
+	echo ${UNAME_MACHINE}-pc-mingw32
+	exit 0 ;;
+    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
+	# UNAME_MACHINE based on the output of uname instead of i386?
+	echo i386-pc-interix
+	exit 0 ;;
+    i*:UWIN*:*)
+	echo ${UNAME_MACHINE}-pc-uwin
+	exit 0 ;;
+    p*:CYGWIN*:*)
+	echo powerpcle-unknown-cygwin
+	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. cd to the root directory to prevent
+	# problems with other programs or directories called `ld' in the path.
+	ld_help_string=`cd /; 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
+	  *ia64)
+		echo "${UNAME_MACHINE}-unknown-linux"
+		exit 0
+		;;
+	  i?86linux)
+		echo "${X86CPU}-pc-linux-gnuaout"
+		exit 0
+		;;
+	  i?86coff)
+		echo "${X86CPU}-pc-linux-gnucoff"
+		exit 0
+		;;
+	  sparclinux)
+		echo "${UNAME_MACHINE}-unknown-linux-gnuaout"
+		exit 0
+		;;
+	  armlinux)
+		echo "${UNAME_MACHINE}-unknown-linux-gnuaout"
+		exit 0
+		;;
+	  elf32arm*)
+		echo "${UNAME_MACHINE}-unknown-linux-gnuoldld"
+		exit 0
+		;;
+	  armelf_linux*)
+		echo "${UNAME_MACHINE}-unknown-linux-gnu"
+		exit 0
+		;;
+	  m68klinux)
+		echo "${UNAME_MACHINE}-unknown-linux-gnuaout"
+		exit 0
+		;;
+	  elf32ppc | elf32ppclinux)
+		# Determine Lib Version
+		cat >$dummy.c <<EOF
+#include <features.h>
+#if defined(__GLIBC__)
+extern char __libc_version[];
+extern char __libc_release[];
+#endif
+main(argc, argv)
+     int argc;
+     char *argv[];
+{
+#if defined(__GLIBC__)
+  printf("%s %s\n", __libc_version, __libc_release);
+#else
+  printf("unkown\n");
+#endif
+  return 0;
+}
+EOF
+		LIBC=""
+		$CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null
+		if test "$?" = 0 ; then
+			./$dummy | grep 1\.99 > /dev/null
+			if test "$?" = 0 ; then
+				LIBC="libc1"
+			fi
+		fi
+		rm -f $dummy.c $dummy
+		echo powerpc-unknown-linux-gnu${LIBC}
+		exit 0
+		;;
+	esac
+
+	if test "${UNAME_MACHINE}" = "alpha" ; then
+		cat <<EOF >$dummy.s
+			.data
+		\$Lformat:
+			.byte 37,100,45,37,120,10,0	# "%d-%x\n"
+
+			.text
+			.globl main
+			.align 4
+			.ent main
+		main:
+			.frame \$30,16,\$26,0
+			ldgp \$29,0(\$27)
+			.prologue 1
+			.long 0x47e03d80 # implver \$0
+			lda \$2,-1
+			.long 0x47e20c21 # amask \$2,\$1
+			lda \$16,\$Lformat
+			mov \$0,\$17
+			not \$1,\$18
+			jsr \$26,printf
+			ldgp \$29,0(\$26)
+			mov 0,\$16
+			jsr \$26,exit
+			.end main
+EOF
+		LIBC=""
+		$CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
+		if test "$?" = 0 ; then
+			case `./$dummy` in
+			0-0)
+				UNAME_MACHINE="alpha"
+				;;
+			1-0)
+				UNAME_MACHINE="alphaev5"
+				;;
+			1-1)
+				UNAME_MACHINE="alphaev56"
+				;;
+			1-101)
+				UNAME_MACHINE="alphapca56"
+				;;
+			2-303)
+				UNAME_MACHINE="alphaev6"
+				;;
+			2-307)
+				UNAME_MACHINE="alphaev67"
+				;;
+			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
+#ifdef __cplusplus
+#include <stdio.h>  /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+#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_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0
+	  rm -f $dummy.c $dummy
+	elif test "${UNAME_MACHINE}" = "s390"; then
+	  echo s390-ibm-linux && exit 0
+	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 "${X86CPU}-pc-linux-gnuoldld" && exit 0
+
+	  case "${UNAME_MACHINE}" in
+	  i?86)
+	    VENDOR=pc;
+	    UNAME_MACHINE=${X86CPU}
+	    ;;
+	  *)
+	    VENDOR=unknown;
+	    ;;
+	  esac
+	  # Determine whether the default compiler is a.out or elf
+	  cat >$dummy.c <<EOF
+#include <features.h>
+#ifdef __cplusplus
+#include <stdio.h>  /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+#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_FOR_BUILD $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 ${X86CPU}-pc-sysv4.2uw${UNAME_VERSION}
+	exit 0 ;;
+    i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*)
+	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
+	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+		echo ${X86CPU}-univel-sysv${UNAME_REL}
+	else
+		echo ${X86CPU}-pc-sysv${UNAME_REL}
+	fi
+	exit 0 ;;
+    i?86:*:5:7*)
+        # Fixed at (any) Pentium or better
+        UNAME_MACHINE=i586
+        if [ ${UNAME_SYSTEM} = "UnixWare" ] ; then
+	    echo ${X86CPU}-sco-sysv${UNAME_RELEASE}uw${UNAME_VERSION}
+	else
+	    echo ${X86CPU}-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 ${X86CPU}-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
+		(/bin/uname -X|egrep '^Machine.*Pent ?II' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		(/bin/uname -X|egrep '^Machine.*Pentium Pro' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		echo ${X86CPU}-pc-sco$UNAME_REL
+	else
+		echo ${X86CPU}-pc-sysv32
+	fi
+	exit 0 ;;
+    i?86:*DOS:*:*)
+	echo ${X86CPU}-pc-msdosdjgpp
+	exit 0 ;;
+    pc:*:*:*)
+	# Left here for compatibility:
+        # uname -m prints for DJGPP always 'pc', but it prints nothing about
+        # the processor, so we play safe by assuming i386.
+	echo i386-pc-msdosdjgpp
+        exit 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.*:* | i?86:LynxOS:3.[01]*:*)
+	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*:ReliantUNIX-*:*:*)
+	echo mips-sni-sysv4
+	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 ;;
+    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+	if [ -d /usr/nec ]; then
+	        echo mips-nec-sysv${UNAME_RELEASE}
+	else
+	        echo mips-unknown-sysv${UNAME_RELEASE}
+	fi
+        exit 0 ;;
+    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.
+	echo powerpc-be-beos
+	exit 0 ;;
+    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.
+	echo powerpc-apple-beos
+	exit 0 ;;
+    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.
+	echo i586-pc-beos
+	exit 0 ;;
+    SX-4:SUPER-UX:*:*)
+	echo sx4-nec-superux${UNAME_RELEASE}
+	exit 0 ;;
+    SX-5:SUPER-UX:*:*)
+	echo sx5-nec-superux${UNAME_RELEASE}
+	exit 0 ;;
+    Power*:Rhapsody:*:*)
+	echo powerpc-apple-rhapsody${UNAME_RELEASE}
+	exit 0 ;;
+    *:Rhapsody:*:*)
+	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
+	exit 0 ;;
+    Power*:Mac*OS:*:*)
+	echo powerpc-apple-macos${UNAME_RELEASE}
+	exit 0 ;;
+    *:Mac*OS:*:*)
+	echo ${UNAME_MACHINE}-apple-macos${UNAME_RELEASE}
+	exit 0 ;;
+    *:Darwin:*:*)
+	echo `uname -p`-apple-darwin${UNAME_RELEASE}
+	exit 0 ;;
+    *:procnto*:*:* | *:QNX:[0123456789]*:*)
+	if test "${UNAME_MACHINE}" = "x86pc"; then
+		UNAME_MACHINE=pc
+	fi
+	echo `uname -p`-${UNAME_MACHINE}-nto-qnx
+	exit 0 ;;
+    *:QNX:*:4*)
+	echo i386-pc-qnx
+	exit 0 ;;
+    NSR-W:NONSTOP_KERNEL:*:*)
+	echo nsr-tandem-nsk${UNAME_RELEASE}
+	exit 0 ;;
+    BS2000:POSIX*:*:*)
+	echo bs2000-siemens-sysv
+	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`;
+  if (version < 4)
+    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+  else
+    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+  exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+  printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+  printf ("ns32k-encore-mach\n"); exit (0);
+#else
+  printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+  printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+  printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+  printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+    struct utsname un;
+
+    uname(&un);
+
+    if (strncmp(un.version, "V2", 2) == 0) {
+	printf ("i386-sequent-ptx2\n"); exit (0);
+    }
+    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+	printf ("i386-sequent-ptx1\n"); exit (0);
+    }
+    printf ("i386-sequent-ptx\n"); exit (0);
+
+#endif
+
+#if defined (vax)
+#if !defined (ultrix)
+  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_FOR_BUILD $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/src/config.sub b/src/config.sub
new file mode 100755
index 000000000..c4123f28f
--- /dev/null
+++ b/src/config.sub
@@ -0,0 +1,1273 @@
+#! /bin/sh
+# Configuration validation subroutine script, version 1.1.
+#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000
+#   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.
+
+# Written by Per Bothner <bothner@cygnus.com>.
+# Please send patches to <config-patches@gnu.org>.
+#
+# 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
+  nto-qnx* | 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
+		;;
+	-sim | -cisco | -oki | -wec | -winbond)
+		os=
+		basic_machine=$1
+		;;
+	-scout)
+		;;
+	-wrs)
+		os=-vxworks
+		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/'`
+		;;
+	-udk*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-isc)
+		os=-isc2.2
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-clix*)
+		basic_machine=clipper-intergraph
+		;;
+	-isc*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-lynx*)
+		os=-lynxos
+		;;
+	-ptx*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+		;;
+	-windowsnt*)
+		os=`echo $os | sed -e 's/windowsnt/winnt/'`
+		;;
+	-psos*)
+		os=-psos
+		;;
+	-mint | -mint[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+	# Recognize the basic CPU types without company name.
+	# Some are omitted here because they have special meanings below.
+	tahoe | i860 | ia64 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \
+		| arme[lb] | pyramid | mn10200 | mn10300 | tron | a29k \
+		| 580 | i960 | h8300 \
+		| x86 | ppcbe | mipsbe | mipsle | shbe | shle | armbe | armle \
+		| hppa | hppa1.0 | hppa1.1 | hppa2.0 | hppa2.0w | hppa2.0n \
+		| alpha | alphaev[4-8] | alphaev56 | alphapca5[67] \
+		| alphaev6[78] \
+		| we32k | ns16k | clipper | i370 | sh | powerpc | powerpcle \
+		| 1750a | dsp16xx | pdp11 | mips16 | mips64 | mipsel | mips64el \
+		| mips64orion | mips64orionel | mipstx39 | mipstx39el \
+		| mips64vr4300 | mips64vr4300el | mips64vr4100 | mips64vr4100el \
+		| mips64vr5000 | miprs64vr5000el | mcore \
+		| sparc | sparclet | sparclite | sparc64 | sparcv9 | v850 | c4x \
+		| powerpc64 | sparcv8 | supersparc | microsparc | ultrasparc \
+		| thumb | d10v | fr30 | avr)
+		basic_machine=$basic_machine-unknown
+		;;
+	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | z8k | v70 | h8500 | w65 | pj | pjl)
+		;;
+
+	# 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[34567]86 | pentium[23] | k[56] | k6[23] | athlon)
+	  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[34567]86-* | pentium[23]-* | i860-* | ia64-* | m32r-* | m68k-* | m68000-* \
+	      | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \
+	      | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \
+	      | power-* | none-* | 580-* | cray2-* | h8300-* | h8500-* | i960-* \
+	      | xmp-* | ymp-* \
+	      | x86-* | ppcbe-* | mipsbe-* | mipsle-* | shbe-* | shle-* | armbe-* | armle-* \
+	      | hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* | hppa2.0w-* | hppa2.0n-* \
+	      | alpha-* | alphaev[4-8]-* | alphaev56-* | alphapca5[67]-* \
+	      | alphaev6[78]-* \
+	      | we32k-* | cydra-* | ns16k-* | pn-* | np1-* | xps100-* \
+	      | clipper-* | orion-* \
+	      | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \
+	      | sparc64-* | sparcv9-* | sparc86x-* | mips16-* | mips64-* | mipsel-* \
+	      | mips64el-* | mips64orion-* | mips64orionel-* \
+	      | mips64vr4100-* | mips64vr4100el-* | mips64vr4300-* | mips64vr4300el-* \
+	      | mipstx39-* | mipstx39el-* | mcore-* \
+	      | f301-* | armv*-* | s390-* | sv1-* | t3e-* \
+	      | m88110-* | m680[01234]0-* | m683?2-* | m68360-* | z8k-* | d10v-* \
+	      | k[56]-* | k6[23]-* | athlon-* | powerpc64-* \
+	      | sparcv8-* | supersparc-* | microsparc-* | ultrasparc-* \
+	      | thumb-* | v850-* | d30v-* | tic30-* | c30-* | fr30-* )
+		;;
+	# 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
+		;;
+	a29khif)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	adobe68k)
+		basic_machine=m68010-adobe
+		os=-scout
+		;;
+	alliant | fx80)
+		basic_machine=fx80-alliant
+		;;
+	altos | altos3068)
+		basic_machine=m68k-altos
+		;;
+	am29k)
+		basic_machine=a29k-none
+		os=-bsd
+		;;
+	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
+		;;
+	apollo68bsd)
+		basic_machine=m68k-apollo
+		os=-bsd
+		;;
+	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
+		;;
+	es1800 | OSE68k | ose68k | ose | OSE)
+		basic_machine=m68k-ericsson
+		os=-ose
+		;;
+	fx2800)
+		basic_machine=i860-alliant
+		;;
+	genix)
+		basic_machine=ns32k-ns
+		;;
+	gmicro)
+		basic_machine=tron-gmicro
+		os=-sysv
+		;;
+	h3050r* | hiux*)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	h8300hms)
+		basic_machine=h8300-hitachi
+		os=-hms
+		;;
+	h8300xray)
+		basic_machine=h8300-hitachi
+		os=-xray
+		;;
+	h8500hms)
+		basic_machine=h8500-hitachi
+		os=-hms
+		;;
+	harris)
+		basic_machine=m88k-harris
+		os=-sysv3
+		;;
+	hp300-*)
+		basic_machine=m68k-hp
+		;;
+	hp300bsd)
+		basic_machine=m68k-hp
+		os=-bsd
+		;;
+	hp300hpux)
+		basic_machine=m68k-hp
+		os=-hpux
+		;;
+	hp3k9[0-9][0-9] | hp9[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k2[0-9][0-9] | hp9k31[0-9])
+		basic_machine=m68000-hp
+		;;
+	hp9k3[2-9][0-9])
+		basic_machine=m68k-hp
+		;;
+	hp9k6[0-9][0-9] | hp6[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k7[0-79][0-9] | hp7[0-79][0-9])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k78[0-9] | hp78[0-9])
+		basic_machine=hppa2.0-hp
+		;;
+	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+		basic_machine=hppa2.0-hp
+		;;
+	hp9k8[0-9][13679] | hp8[0-9][13679])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][0-9] | hp8[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hppa-next)
+		os=-nextstep3
+		;;
+	hppaosf)
+		basic_machine=hppa1.1-hp
+		os=-osf
+		;;
+	hppro)
+		basic_machine=hppa1.1-hp
+		os=-proelf
+		;;
+	i370-ibm* | ibm*)
+		basic_machine=i370-ibm
+		;;
+# I'm not sure what "Sysv32" means.  Should this be sysv3.2?
+	i[34567]86v32)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv32
+		;;
+	i[34567]86v4*)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv4
+		;;
+	i[34567]86v)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv
+		;;
+	i[34567]86sol2)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-solaris2
+		;;
+	i386mach)
+		basic_machine=i386-mach
+		os=-mach
+		;;
+	i386-vsta | vsta)
+		basic_machine=i386-unknown
+		os=-vsta
+		;;
+	i386-go32 | go32)
+		basic_machine=i386-unknown
+		os=-go32
+		;;
+	i386-mingw32 | mingw32)
+		basic_machine=i386-unknown
+		os=-mingw32
+		;;
+	iris | iris4d)
+		basic_machine=mips-sgi
+		case $os in
+		    -irix*)
+			;;
+		    *)
+			os=-irix4
+			;;
+		esac
+		;;
+	isi68 | isi)
+		basic_machine=m68k-isi
+		os=-sysv
+		;;
+	macppc*)
+		basic_machine=powerpc-apple
+		;;
+	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
+		;;
+	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+	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
+		;;
+	mmix*)
+		basic_machine=mmix-knuth
+		os=-mmixware
+		;;
+	monitor)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	msdos)
+		basic_machine=i386-unknown
+		os=-msdos
+		;;
+	mvs)
+		basic_machine=i370-ibm
+		os=-mvs
+		;;
+	ncr3000)
+		basic_machine=i486-ncr
+		os=-sysv4
+		;;
+	netbsd386)
+		basic_machine=i386-unknown
+		os=-netbsd
+		;;
+	netwinder)
+		basic_machine=armv4l-rebel
+		os=-linux
+		;;
+	news | news700 | news800 | news900)
+		basic_machine=m68k-sony
+		os=-newsos
+		;;
+	news1000)
+		basic_machine=m68030-sony
+		os=-newsos
+		;;
+	news-3600 | risc-news)
+		basic_machine=mips-sony
+		os=-newsos
+		;;
+	necv70)
+		basic_machine=v70-nec
+		os=-sysv
+		;;
+	next | m*-next )
+		basic_machine=m68k-next
+		case $os in
+		    -nextstep* )
+			;;
+		    -ns2*)
+		      os=-nextstep2
+			;;
+		    *)
+		      os=-nextstep3
+			;;
+		esac
+		;;
+	nh3000)
+		basic_machine=m68k-harris
+		os=-cxux
+		;;
+	nh[45]000)
+		basic_machine=m88k-harris
+		os=-cxux
+		;;
+	nindy960)
+		basic_machine=i960-intel
+		os=-nindy
+		;;
+	mon960)
+		basic_machine=i960-intel
+		os=-mon960
+		;;
+	np1)
+		basic_machine=np1-gould
+		;;
+	nsr-tandem)
+		basic_machine=nsr-tandem
+		;;
+	op50n-* | op60c-*)
+		basic_machine=hppa1.1-oki
+		os=-proelf
+		;;
+	OSE68000 | ose68000)
+		basic_machine=m68000-ericsson
+		os=-ose
+		;;
+	os68k)
+		basic_machine=m68k-none
+		os=-os68k
+		;;
+	pa-hitachi)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	paragon)
+		basic_machine=i860-intel
+		os=-osf
+		;;
+	pbd)
+		basic_machine=sparc-tti
+		;;
+	pbb)
+		basic_machine=m68k-tti
+		;;
+        pc532 | pc532-*)
+		basic_machine=ns32k-pc532
+		;;
+	pentiummmx | p55)
+		basic_machine=pentiummmx-pc
+		;;
+	pentium | p5 | i586)
+		basic_machine=pentium-pc
+		;;
+	pentiumpro | p6)
+		basic_machine=pentiumpro-pc
+		;;
+	pentiummmx-* | p55-*)
+		basic_machine=pentiummmx-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentium-* | p5-* | i586-*)
+		basic_machine=pentium-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentiumpro-* | p6-*)
+		basic_machine=pentiumpro-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	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/^[^-]*-//'`
+		;;
+	ppc64)	basic_machine=powerpc64-unknown
+	        ;;
+	ppc64-*)
+		basic_machine=powerpc64-`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
+		;;
+	rom68k)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	rm[46]00)
+		basic_machine=mips-siemens
+		;;
+	rtpc | rtpc-*)
+		basic_machine=romp-ibm
+		;;
+	sa29200)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	sequent)
+		basic_machine=i386-sequent
+		;;
+	sh)
+		basic_machine=sh-hitachi
+		os=-hms
+		;;
+	sparclite-wrs)
+		basic_machine=sparclite-wrs
+		os=-vxworks
+		;;
+	sps7)
+		basic_machine=m68k-bull
+		os=-sysv2
+		;;
+	spur)
+		basic_machine=spur-unknown
+		;;
+	st2000)
+		basic_machine=m68k-tandem
+		;;
+	stratus)
+		basic_machine=i860-stratus
+		os=-sysv4
+		;;
+	sun2)
+		basic_machine=m68000-sun
+		;;
+	sun2os3)
+		basic_machine=m68000-sun
+		os=-sunos3
+		;;
+	sun2os4)
+		basic_machine=m68000-sun
+		os=-sunos4
+		;;
+	sun3os3)
+		basic_machine=m68k-sun
+		os=-sunos3
+		;;
+	sun3os4)
+		basic_machine=m68k-sun
+		os=-sunos4
+		;;
+	sun4os3)
+		basic_machine=sparc-sun
+		os=-sunos3
+		;;
+	sun4os4)
+		basic_machine=sparc-sun
+		os=-sunos4
+		;;
+	sun4sol2)
+		basic_machine=sparc-sun
+		os=-solaris2
+		;;
+	sun3 | sun3-*)
+		basic_machine=m68k-sun
+		;;
+	sun4)
+		basic_machine=sparc-sun
+		;;
+	sun386 | sun386i | roadrunner)
+		basic_machine=i386-sun
+		;;
+	sv1)
+		basic_machine=sv1-cray
+		os=-unicos
+		;;
+	symmetry)
+		basic_machine=i386-sequent
+		os=-dynix
+		;;
+	t3e)
+		basic_machine=t3e-cray
+		os=-unicos
+		;;
+	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
+		;;
+	v810 | necv810)
+		basic_machine=v810-nec
+		os=-none
+		;;
+	vaxv)
+		basic_machine=vax-dec
+		os=-sysv
+		;;
+	vms)
+		basic_machine=vax-dec
+		os=-vms
+		;;
+	vpp*|vx|vx-*)
+               basic_machine=f301-fujitsu
+               ;;
+	vxworks960)
+		basic_machine=i960-wrs
+		os=-vxworks
+		;;
+	vxworks68)
+		basic_machine=m68k-wrs
+		os=-vxworks
+		;;
+	vxworks29k)
+		basic_machine=a29k-wrs
+		os=-vxworks
+		;;
+	w65*)
+		basic_machine=w65-wdc
+		os=-none
+		;;
+	w89k-*)
+		basic_machine=hppa1.1-winbond
+		os=-proelf
+		;;
+	xmp)
+		basic_machine=xmp-cray
+		os=-unicos
+		;;
+        xps | xps100)
+		basic_machine=xps100-honeywell
+		;;
+	z8k-*-coff)
+		basic_machine=z8k-unknown
+		os=-sim
+		;;
+	none)
+		basic_machine=none-none
+		os=-none
+		;;
+
+# Here we handle the default manufacturer of certain CPU types.  It is in
+# some cases the only manufacturer, in others, it is the most popular.
+	w89k)
+		basic_machine=hppa1.1-winbond
+		;;
+	op50n)
+		basic_machine=hppa1.1-oki
+		;;
+	op60c)
+		basic_machine=hppa1.1-oki
+		;;
+	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 | sparcv9)
+		basic_machine=sparc-sun
+		;;
+        cydra)
+		basic_machine=cydra-cydrome
+		;;
+	orion)
+		basic_machine=orion-highlevel
+		;;
+	orion105)
+		basic_machine=clipper-highlevel
+		;;
+	mac | mpw | mac-mpw)
+		basic_machine=m68k-apple
+		;;
+	pmac | pmac-mpw)
+		basic_machine=powerpc-apple
+		;;
+	c4x*)
+		basic_machine=c4x-none
+		os=-coff
+		;;
+	*)
+		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* | -oabi* \
+	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+	      | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+	      | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \
+	      | -interix* | -uwin* | -rhapsody* | -darwin* | -opened* \
+	      | -openstep* | -oskit*)
+	# Remember, each alternative MUST END IN *, to match a version number.
+		;;
+	-qnx*)
+		case $basic_machine in
+		    x86-* | i[34567]86-*)
+			;;
+		    *)
+			os=-nto$os
+			;;
+		esac
+		;;
+	-nto*)
+		os=-nto-qnx
+		;;
+	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
+	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* \
+	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
+		;;
+	-mac*)
+		os=`echo $os | sed -e 's|mac|macos|'`
+		;;
+	-linux*)
+		os=`echo $os | sed -e 's|linux|linux-gnu|'`
+		;;
+	-sunos5*)
+		os=`echo $os | sed -e 's|sunos5|solaris2|'`
+		;;
+	-sunos6*)
+		os=`echo $os | sed -e 's|sunos6|solaris3|'`
+		;;
+	-opened*)
+		os=-openedition
+		;;
+	-wince*)
+		os=-wince
+		;;
+	-osfrose*)
+		os=-osfrose
+		;;
+	-osf*)
+		os=-osf
+		;;
+	-utek*)
+		os=-bsd
+		;;
+	-dynix*)
+		os=-bsd
+		;;
+	-acis*)
+		os=-aos
+		;;
+	-386bsd)
+		os=-bsd
+		;;
+	-ctix* | -uts*)
+		os=-sysv
+		;;
+	-ns2 )
+	        os=-nextstep2
+		;;
+	-nsk)
+		os=-nsk
+		;;
+	# 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*)
+		;;
+	-ose*)
+		os=-ose
+		;;
+	-es1800*)
+		os=-ose
+		;;
+	-xenix)
+		os=-xenix
+		;;
+        -*mint | -*MiNT)
+	        os=-mint
+		;;
+	-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*-rebel)
+		os=-linux
+		;;
+	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
+		;;
+	m68*-cisco)
+		os=-aout
+		;;
+	mips*-cisco)
+		os=-elf
+		;;
+	mips*-*)
+		os=-elf
+		;;
+	*-tti)	# must be before sparc entry or we get the wrong os.
+		os=-sysv3
+		;;
+	sparc-* | *-sun)
+		os=-sunos4.1.1
+		;;
+	*-be)
+		os=-beos
+		;;
+	*-ibm)
+		os=-aix
+		;;
+	*-wec)
+		os=-proelf
+		;;
+	*-winbond)
+		os=-proelf
+		;;
+	*-oki)
+		os=-proelf
+		;;
+	*-hp)
+		os=-hpux
+		;;
+	*-hitachi)
+		os=-hiux
+		;;
+	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+		os=-sysv
+		;;
+	*-cbm)
+		os=-amigaos
+		;;
+	*-dg)
+		os=-dgux
+		;;
+	*-dolphin)
+		os=-sysv3
+		;;
+	m68k-ccur)
+		os=-rtu
+		;;
+	m88k-omron*)
+		os=-luna
+		;;
+	*-next )
+		os=-nextstep
+		;;
+	*-sequent)
+		os=-ptx
+		;;
+	*-crds)
+		os=-unos
+		;;
+	*-ns)
+		os=-genix
+		;;
+	i370-*)
+		os=-mvs
+		;;
+	*-next)
+		os=-nextstep3
+		;;
+        *-gould)
+		os=-sysv
+		;;
+        *-highlevel)
+		os=-bsd
+		;;
+	*-encore)
+		os=-bsd
+		;;
+        *-sgi)
+		os=-irix
+		;;
+        *-siemens)
+		os=-sysv4
+		;;
+	*-masscomp)
+		os=-rtu
+		;;
+	f301-fujitsu)
+		os=-uxpv
+		;;
+	*-rom68k)
+		os=-coff
+		;;
+	*-*bug)
+		os=-coff
+		;;
+	*-apple)
+		os=-macos
+		;;
+	*-atari*)
+		os=-mint
+		;;
+	*)
+		os=-none
+		;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer.  We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+	*-unknown)
+		case $os in
+			-riscix*)
+				vendor=acorn
+				;;
+			-sunos*)
+				vendor=sun
+				;;
+			-aix*)
+				vendor=ibm
+				;;
+			-beos*)
+				vendor=be
+				;;
+			-hpux*)
+				vendor=hp
+				;;
+			-mpeix*)
+				vendor=hp
+				;;
+			-hiux*)
+				vendor=hitachi
+				;;
+			-unos*)
+				vendor=crds
+				;;
+			-dgux*)
+				vendor=dg
+				;;
+			-luna*)
+				vendor=omron
+				;;
+			-genix*)
+				vendor=ns
+				;;
+			-mvs* | -opened*)
+				vendor=ibm
+				;;
+			-ptx*)
+				vendor=sequent
+				;;
+			-vxsim* | -vxworks*)
+				vendor=wrs
+				;;
+			-aux*)
+				vendor=apple
+				;;
+			-hms*)
+				vendor=hitachi
+				;;
+			-mpw* | -macos*)
+				vendor=apple
+				;;
+			-*mint | -*MiNT)
+				vendor=atari
+				;;
+		esac
+		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+		;;
+esac
+
+echo $basic_machine$os
diff --git a/src/configure b/src/configure
new file mode 100755
index 000000000..8691f50e0
--- /dev/null
+++ b/src/configure
@@ -0,0 +1,3013 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13 
+# 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
+	--disable-clos		Don't include CLOS."
+ac_help="$ac_help
+       --enable-local-gmp      Use local GMP library."
+ac_help="$ac_help
+	--enable-boehm	 	Enable Boehm & Weiser's garbage collector."
+ac_help="$ac_help
+	--enable-profile 	Enable profiling tool."
+ac_help="$ac_help
+	--enable-tk		Include Tk."
+ac_help="$ac_help
+	--enable-clx		Include CLX."
+ac_help="$ac_help
+	--enable-tcp		Include socket interface."
+ac_help="$ac_help
+	--enable-locative	Include locative support."
+ac_help="$ac_help
+	--enable-threads	Include the multiple thread facility."
+ac_help="$ac_help
+	--enable-runtime	Build a RunTime Lisp with no compiler."
+ac_help="$ac_help
+  --with-x                use the X Window System"
+
+# 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=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# 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.13"
+    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=configure.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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+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
+
+
+		# You must have autoconf version 2.1 or later.
+
+###
+### Make sure we do not configure within source directory
+###
+if test -f configure; then
+echo "***"
+echo "*** This program cannot be built within the source directory ***"
+echo "***"
+exit 2;
+fi
+
+ECLS_VERSION=0.2
+
+
+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.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $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:588: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+  case $nonopt in
+  NONE)
+    if host_alias=`${CONFIG_SHELL-/bin/sh} $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=`${CONFIG_SHELL-/bin/sh} $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
+
+
+
+
+
+
+
+
+
+
+# Check whether --enable-clos or --disable-clos was given.
+if test "${enable_clos+set}" = set; then
+  enableval="$enable_clos"
+  clos=`test "$enable_clos" != "no"`
+else
+  clos=1
+fi
+
+# Check whether --enable-gmp or --disable-gmp was given.
+if test "${enable_gmp+set}" = set; then
+  enableval="$enable_gmp"
+  gmp="$enable_local_gmp"
+fi
+
+# Check whether --enable-boehm or --disable-boehm was given.
+if test "${enable_boehm+set}" = set; then
+  enableval="$enable_boehm"
+  boehm="$enable_boehm"
+fi
+
+# Check whether --enable-profile or --disable-profile was given.
+if test "${enable_profile+set}" = set; then
+  enableval="$enable_profile"
+  profile="$enable_profile"
+fi
+
+# Check whether --enable-tk or --disable-tk was given.
+if test "${enable_tk+set}" = set; then
+  enableval="$enable_tk"
+  tk="$enable_tk"
+fi
+
+# Check whether --enable-clx or --disable-clx was given.
+if test "${enable_clx+set}" = set; then
+  enableval="$enable_clx"
+  clx="$enable_clx"
+fi
+
+# Check whether --enable-tcp or --disable-tcp was given.
+if test "${enable_tcp+set}" = set; then
+  enableval="$enable_tcp"
+  tcp="$enable_tcp"
+fi
+
+# Check whether --enable-locative or --disable-locative was given.
+if test "${enable_locative+set}" = set; then
+  enableval="$enable_locative"
+  locative="$enable_locative"
+fi
+
+# Check whether --enable-threads or --disable-threads was given.
+if test "${enable_threads+set}" = set; then
+  enableval="$enable_threads"
+  threads="$enable_threads"
+fi
+
+# Check whether --enable-runtime or --disable-runtime was given.
+if test "${enable_runtime+set}" = set; then
+  enableval="$enable_runtime"
+  runtime="$enable_runtime"
+fi
+
+
+#### Make srcdir absolute, if it isn't already.  It's important to
+#### avoid running the path through pwd unnecessarily, since pwd can
+#### give you automounter prefixes, which can go away.
+case "${srcdir}" in
+  /* ) ;;
+  . )
+    ## We may be able to use the $PWD environment variable to make this
+    ## absolute.  But sometimes PWD is inaccurate.
+    if [ "${PWD}" != "" ] && [ "`(cd ${PWD} ; sh -c pwd)`" = "`pwd`" ] ; then
+      srcdir="$PWD"
+    else
+      srcdir="`(cd ${srcdir}; pwd)`"
+    fi
+  ;;
+  *  ) srcdir="`(cd ${srcdir}; pwd)`" ;;
+esac
+
+### Guess the operating system
+case $host_os in
+	linux*)
+		host="linux"
+		;;
+	freebsd*)
+		host="freebsd"
+		;;
+	netbsd*)
+		host="netbsd"
+		;;
+	*)
+		host="$host_os"
+		;;
+esac
+
+### Establish some default values.
+
+if test "x$prefix" = "xNONE"; then prefix=${ac_default_prefix}; fi
+if test "x$exec_prefix" = "xNONE"; then exec_prefix=${prefix}; fi
+bindir="${exec_prefix}/bin"
+libdir="${exec_prefix}/lib/ecls"
+mandir="${prefix}/man/man1"
+infodir="${prefix}/info"
+builddir=`pwd`
+
+if [ $profile ] ; then
+ if [ ${host} = linux ] ; then
+ LIBS="${LIBS} -lgmon"
+ fi
+fi
+if [ $tk ] ; then
+ TKLIBS="-ltk -ltcl -lXpm @XLIBS@"
+fi
+
+
+### ----------------------------------------------------------------------
+###		Set options
+###
+test "${boehm}" && cat >> confdefs.h <<\EOF
+#define GBC_BOEHM 1
+EOF
+
+test "${clos}" && cat >> confdefs.h <<\EOF
+#define CLOS 1
+EOF
+
+test "${tk}" && cat >> confdefs.h <<\EOF
+#define TK 1
+EOF
+
+test "${clx}" && cat >> confdefs.h <<\EOF
+#define CLX 1
+EOF
+
+test "${tcp}" -o "${clx}" && cat >> confdefs.h <<\EOF
+#define TCP 1
+EOF
+
+test "${locative}" && cat >> confdefs.h <<\EOF
+#define LOCATIVE 1
+EOF
+
+test "${threads}" && cat >> confdefs.h <<\EOF
+#define THREADS 1
+EOF
+
+test "${runtime}" && cat >> confdefs.h <<\EOF
+#define RUNTIME 1
+EOF
+
+test "${profile}" && cat >> confdefs.h <<\EOF
+#define PROFILE 1
+EOF
+
+### ----------------------------------------------------------------------
+###           checks for programs
+CC=gcc		      # We need gcc for variable length arrays
+
+# 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:779: 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=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; 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:809: 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=":"
+  ac_prog_rejected=no
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; 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
+
+  if test -z "$CC"; then
+    case "`uname -s`" in
+    *win32* | *WIN32*)
+      # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:860: 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=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_CC="cl"
+      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
+ ;;
+    esac
+  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:892: 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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 903 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:908: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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*
+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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+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:934: 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:939: 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:948: \"$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
+else
+  GCC=
+fi
+
+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:967: 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
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+
+echo $ac_n "checking for POSIXized ISC""... $ac_c" 1>&6
+echo "configure:999: 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
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1020: 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 1035 "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:1041: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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 1052 "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:1058: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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} -nologo -E"
+  cat > conftest.$ac_ext <<EOF
+#line 1069 "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:1075: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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*
+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
+           # sets variable CPP
+# 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:1102: 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=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; 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
+        # sets variable RANLIB
+# 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
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# 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:1141: 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=":"
+  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.
+      # Don't use installbsd from OSF since it installs stuff as root
+      # by default.
+      for ac_prog in ginstall 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.
+	    :
+	  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_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+       # sets variables INSTALL, INSTALL_DATA, INSTALL_PROGRAM
+echo $ac_n "checking whether ln -s works""... $ac_c" 1>&6
+echo "configure:1194: 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
+          # sets variable LN_S
+
+#### Some command variations:
+
+if test ${host} = MSDOS -o ${host} = GO32 ; then
+ RM="deltree /y"
+ CP="copy"
+ MV="move"
+ if test ${host} = MSDOS ; then
+   RUN="emx "
+  else
+   RUN="go32 "
+  fi
+else
+ RM="rm -f"
+ CP="cp"
+ MV="mv"
+ RUN="./"
+fi
+
+#### Extract some information from the machine description file.
+#### WARNING: file confdefs.h may depend on version of Autoconf
+
+echo "Extracting parameters from the machine description file"
+
+tempcname="conftest.c"
+
+echo '
+#include "confdefs.h"
+#include "'${srcdir}'/h/machines.h"
+#ifdef CFLAGS
+configure___CFLAGS=CFLAGS
+#endif
+
+#ifdef LSPCFLAGS
+configure___LSPCFLAGS=LSPCFLAGS
+#endif
+
+#ifdef CLIBS
+configure___CLIBS=CLIBS
+#endif
+
+#ifdef LDFLAGS
+configure___LDFLAGS=LDFLAGS
+#endif
+
+#ifdef ILDFLAGS
+configure___ILDFLAGS=ILDFLAGS
+#endif
+
+#ifdef UNEXEC
+configure___UNEXEC=UNEXEC
+#else
+configure___UNEXEC=unixsave
+#endif
+
+#ifdef DLD
+configure___DLD=DLD
+#else
+configure___DLD=dld
+#endif
+
+#ifdef RSYM
+configure___RSYM=RSYM
+#endif
+
+#ifdef SETJMP
+configure___SETJMP=SETJMP
+#endif
+
+#ifdef _setjmp
+configure____jmp=1
+#endif
+
+configure___architecture=ARCHITECTURE
+configure___software_type=SOFTWARE_TYPE
+configure___software_version=SOFTWARE_VERSION
+' > ${tempcname}
+
+# The value of CPP is a quoted variable reference, so we need to do this
+# to get its actual value...
+CPP=`eval "echo $CPP"`
+eval `${CPP} -D${host} ${tempcname} \
+       | grep 'configure___' \
+       | sed -e 's/^configure___\([^=]*=\)[ ]*\(.*[^ ]\) */\1"\2"/' `
+rm ${tempcname}
+
+test ${SETJMP} && SETJMPO=setjmp.o
+
+CFLAGS="${CFLAGS}"
+CLIBS="${CLIBS} -lm"
+
+test "$boehm" && CLIBS="-lgc ${CLIBS}"
+test "${_jmp}" && cat >> confdefs.h <<\EOF
+#define _setjmp setjmp
+EOF
+
+test "${_jmp}" && cat >> confdefs.h <<\EOF
+#define _longjmp longjmp
+EOF
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+###
+###           checks for UNIX variants that set DEFS
+###
+echo $ac_n "checking for getpwnam in -lsun""... $ac_c" 1>&6
+echo "configure:1335: checking for getpwnam in -lsun" >&5
+ac_lib_var=`echo sun'_'getpwnam | 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="-lsun  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1343 "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 getpwnam();
+
+int main() {
+getpwnam()
+; return 0; }
+EOF
+if { (eval echo configure:1354: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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 sun | sed -e 's/[^a-zA-Z0-9_]/_/g' \
+    -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_lib 1
+EOF
+
+  LIBS="-lsun $LIBS"
+
+else
+  echo "$ac_t""no" 1>&6
+fi
+         # on IRIX adds -lsun
+###
+###           checks for header files
+###
+for ac_hdr in sys/resource.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1388: 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 1393 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1398: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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 sys/utsname.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1428: 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 1433 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1438: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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_func in nanosleep
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1467: 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 1472 "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:1495: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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
+
+###		      # DEFS HAVE_UNISTD_H, HAVE_STDLIB_H, HAVE_STDARG_H
+###		      # and HAVE_STRING_H
+###
+###           checks for typedefs
+###
+###
+###           checks for functions and declarations
+###
+###           checks for compiler characteristics
+###
+echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6
+echo "configure:1530: checking whether byte ordering is bigendian" >&5
+if eval "test \"`echo '$''{'ac_cv_c_bigendian'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_cv_c_bigendian=unknown
+# See if sys/param.h defines the BYTE_ORDER macro.
+cat > conftest.$ac_ext <<EOF
+#line 1537 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
+ bogus endian macros
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:1548: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  # It does; now see whether it defined to BIG_ENDIAN or not.
+cat > conftest.$ac_ext <<EOF
+#line 1552 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if BYTE_ORDER != BIG_ENDIAN
+ not big endian
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:1563: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_c_bigendian=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_c_bigendian=no
+fi
+rm -f conftest*
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+if test $ac_cv_c_bigendian = unknown; then
+if test "$cross_compiling" = yes; then
+    { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1583 "configure"
+#include "confdefs.h"
+main () {
+  /* Are we little or big endian?  From Harbison&Steele.  */
+  union
+  {
+    long l;
+    char c[sizeof (long)];
+  } u;
+  u.l = 1;
+  exit (u.c[sizeof (long) - 1] == 1);
+}
+EOF
+if { (eval echo configure:1596: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  ac_cv_c_bigendian=no
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  ac_cv_c_bigendian=yes
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_c_bigendian" 1>&6
+if test $ac_cv_c_bigendian = yes; then
+  cat >> confdefs.h <<\EOF
+#define WORDS_BIGENDIAN 1
+EOF
+
+fi
+    	   # DEFS WORDS_BIGENDIAN
+###
+###	      X11 stuff
+###
+# If we find X, set shell vars x_includes and x_libraries to the
+# paths, otherwise set no_x=yes.
+# Uses ac_ vars as temps to allow command line to override cache and checks.
+# --without-x overrides everything else, but does not touch the cache.
+echo $ac_n "checking for X""... $ac_c" 1>&6
+echo "configure:1627: checking for X" >&5
+
+# Check whether --with-x or --without-x was given.
+if test "${with_x+set}" = set; then
+  withval="$with_x"
+  :
+fi
+
+# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
+if test "x$with_x" = xno; then
+  # The user explicitly disabled X.
+  have_x=disabled
+else
+  if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then
+    # Both variables are already set.
+    have_x=yes
+  else
+if eval "test \"`echo '$''{'ac_cv_have_x'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  # One or both of the vars are not set, and there is no cached value.
+ac_x_includes=NO ac_x_libraries=NO
+rm -fr conftestdir
+if mkdir conftestdir; then
+  cd conftestdir
+  # Make sure to not put "make" in the Imakefile rules, since we grep it out.
+  cat > Imakefile <<'EOF'
+acfindx:
+	@echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"'
+EOF
+  if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then
+    # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+    eval `${MAKE-make} acfindx 2>/dev/null | grep -v make`
+    # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
+    for ac_extension in a so sl; do
+      if test ! -f $ac_im_usrlibdir/libX11.$ac_extension &&
+        test -f $ac_im_libdir/libX11.$ac_extension; then
+        ac_im_usrlibdir=$ac_im_libdir; break
+      fi
+    done
+    # Screen out bogus values from the imake configuration.  They are
+    # bogus both because they are the default anyway, and because
+    # using them would break gcc on systems where it needs fixed includes.
+    case "$ac_im_incroot" in
+	/usr/include) ;;
+	*) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;;
+    esac
+    case "$ac_im_usrlibdir" in
+	/usr/lib | /lib) ;;
+	*) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;;
+    esac
+  fi
+  cd ..
+  rm -fr conftestdir
+fi
+
+if test "$ac_x_includes" = NO; then
+  # Guess where to find include files, by looking for this one X11 .h file.
+  test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h
+
+  # First, try using that file with no special directory specified.
+cat > conftest.$ac_ext <<EOF
+#line 1689 "configure"
+#include "confdefs.h"
+#include <$x_direct_test_include>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1694: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  # We can compile using X headers with no special include directory.
+ac_x_includes=
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  # Look for the header file in a standard set of common directories.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+  for ac_dir in               \
+    /usr/X11/include          \
+    /usr/X11R6/include        \
+    /usr/X11R5/include        \
+    /usr/X11R4/include        \
+                              \
+    /usr/include/X11          \
+    /usr/include/X11R6        \
+    /usr/include/X11R5        \
+    /usr/include/X11R4        \
+                              \
+    /usr/local/X11/include    \
+    /usr/local/X11R6/include  \
+    /usr/local/X11R5/include  \
+    /usr/local/X11R4/include  \
+                              \
+    /usr/local/include/X11    \
+    /usr/local/include/X11R6  \
+    /usr/local/include/X11R5  \
+    /usr/local/include/X11R4  \
+                              \
+    /usr/X386/include         \
+    /usr/x386/include         \
+    /usr/XFree86/include/X11  \
+                              \
+    /usr/include              \
+    /usr/local/include        \
+    /usr/unsupported/include  \
+    /usr/athena/include       \
+    /usr/local/x11r5/include  \
+    /usr/lpp/Xamples/include  \
+                              \
+    /usr/openwin/include      \
+    /usr/openwin/share/include \
+    ; \
+  do
+    if test -r "$ac_dir/$x_direct_test_include"; then
+      ac_x_includes=$ac_dir
+      break
+    fi
+  done
+fi
+rm -f conftest*
+fi # $ac_x_includes = NO
+
+if test "$ac_x_libraries" = NO; then
+  # Check for the libraries.
+
+  test -z "$x_direct_test_library" && x_direct_test_library=Xt
+  test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc
+
+  # See if we find them without any special options.
+  # Don't add to $LIBS permanently.
+  ac_save_LIBS="$LIBS"
+  LIBS="-l$x_direct_test_library $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1763 "configure"
+#include "confdefs.h"
+
+int main() {
+${x_direct_test_function}()
+; return 0; }
+EOF
+if { (eval echo configure:1770: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  LIBS="$ac_save_LIBS"
+# We can link X programs with no special library path.
+ac_x_libraries=
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  LIBS="$ac_save_LIBS"
+# First see if replacing the include by lib works.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+for ac_dir in `echo "$ac_x_includes" | sed s/include/lib/` \
+    /usr/X11/lib          \
+    /usr/X11R6/lib        \
+    /usr/X11R5/lib        \
+    /usr/X11R4/lib        \
+                          \
+    /usr/lib/X11          \
+    /usr/lib/X11R6        \
+    /usr/lib/X11R5        \
+    /usr/lib/X11R4        \
+                          \
+    /usr/local/X11/lib    \
+    /usr/local/X11R6/lib  \
+    /usr/local/X11R5/lib  \
+    /usr/local/X11R4/lib  \
+                          \
+    /usr/local/lib/X11    \
+    /usr/local/lib/X11R6  \
+    /usr/local/lib/X11R5  \
+    /usr/local/lib/X11R4  \
+                          \
+    /usr/X386/lib         \
+    /usr/x386/lib         \
+    /usr/XFree86/lib/X11  \
+                          \
+    /usr/lib              \
+    /usr/local/lib        \
+    /usr/unsupported/lib  \
+    /usr/athena/lib       \
+    /usr/local/x11r5/lib  \
+    /usr/lpp/Xamples/lib  \
+    /lib/usr/lib/X11	  \
+                          \
+    /usr/openwin/lib      \
+    /usr/openwin/share/lib \
+    ; \
+do
+  for ac_extension in a so sl; do
+    if test -r $ac_dir/lib${x_direct_test_library}.$ac_extension; then
+      ac_x_libraries=$ac_dir
+      break 2
+    fi
+  done
+done
+fi
+rm -f conftest*
+fi # $ac_x_libraries = NO
+
+if test "$ac_x_includes" = NO || test "$ac_x_libraries" = NO; then
+  # Didn't find X anywhere.  Cache the known absence of X.
+  ac_cv_have_x="have_x=no"
+else
+  # Record where we found X for the cache.
+  ac_cv_have_x="have_x=yes \
+	        ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries"
+fi
+fi
+  fi
+  eval "$ac_cv_have_x"
+fi # $with_x != no
+
+if test "$have_x" != yes; then
+  echo "$ac_t""$have_x" 1>&6
+  no_x=yes
+else
+  # If each of the values was on the command line, it overrides each guess.
+  test "x$x_includes" = xNONE && x_includes=$ac_x_includes
+  test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
+  # Update the cache value to reflect the command line values.
+  ac_cv_have_x="have_x=yes \
+		ac_x_includes=$x_includes ac_x_libraries=$x_libraries"
+  echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6
+fi
+
+if test "$no_x" = yes; then
+  # Not all programs may use this symbol, but it does not hurt to define it.
+  cat >> confdefs.h <<\EOF
+#define X_DISPLAY_MISSING 1
+EOF
+
+  X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS=
+else
+  if test -n "$x_includes"; then
+    X_CFLAGS="$X_CFLAGS -I$x_includes"
+  fi
+
+  # It would also be nice to do this for all -L options, not just this one.
+  if test -n "$x_libraries"; then
+    X_LIBS="$X_LIBS -L$x_libraries"
+    # For Solaris; some versions of Sun CC require a space after -R and
+    # others require no space.  Words are not sufficient . . . .
+    case "`(uname -sr) 2>/dev/null`" in
+    "SunOS 5"*)
+      echo $ac_n "checking whether -R must be followed by a space""... $ac_c" 1>&6
+echo "configure:1876: checking whether -R must be followed by a space" >&5
+      ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries"
+      cat > conftest.$ac_ext <<EOF
+#line 1879 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:1886: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  ac_R_nospace=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_R_nospace=no
+fi
+rm -f conftest*
+      if test $ac_R_nospace = yes; then
+	echo "$ac_t""no" 1>&6
+	X_LIBS="$X_LIBS -R$x_libraries"
+      else
+	LIBS="$ac_xsave_LIBS -R $x_libraries"
+	cat > conftest.$ac_ext <<EOF
+#line 1902 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:1909: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  ac_R_space=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_R_space=no
+fi
+rm -f conftest*
+	if test $ac_R_space = yes; then
+	  echo "$ac_t""yes" 1>&6
+	  X_LIBS="$X_LIBS -R $x_libraries"
+	else
+	  echo "$ac_t""neither works" 1>&6
+	fi
+      fi
+      LIBS="$ac_xsave_LIBS"
+    esac
+  fi
+
+  # Check for system-dependent libraries X programs must link with.
+  # Do this before checking for the system-independent R6 libraries
+  # (-lICE), since we may need -lsocket or whatever for X linking.
+
+  if test "$ISC" = yes; then
+    X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet"
+  else
+    # Martyn.Johnson@cl.cam.ac.uk says this is needed for Ultrix, if the X
+    # libraries were built with DECnet support.  And karl@cs.umb.edu says
+    # the Alpha needs dnet_stub (dnet does not exist).
+    echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6
+echo "configure:1941: checking for dnet_ntoa in -ldnet" >&5
+ac_lib_var=`echo dnet'_'dnet_ntoa | 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="-ldnet  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1949 "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 dnet_ntoa();
+
+int main() {
+dnet_ntoa()
+; return 0; }
+EOF
+if { (eval echo configure:1960: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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
+  X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    if test $ac_cv_lib_dnet_dnet_ntoa = no; then
+      echo $ac_n "checking for dnet_ntoa in -ldnet_stub""... $ac_c" 1>&6
+echo "configure:1982: checking for dnet_ntoa in -ldnet_stub" >&5
+ac_lib_var=`echo dnet_stub'_'dnet_ntoa | 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="-ldnet_stub  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1990 "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 dnet_ntoa();
+
+int main() {
+dnet_ntoa()
+; return 0; }
+EOF
+if { (eval echo configure:2001: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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
+  X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    fi
+
+    # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT,
+    # to get the SysV transport functions.
+    # chad@anasazi.com says the Pyramis MIS-ES running DC/OSx (SVR4)
+    # needs -lnsl.
+    # The nsl library prevents programs from opening the X display
+    # on Irix 5.2, according to dickey@clark.net.
+    echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:2030: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2035 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char gethostbyname(); 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 gethostbyname();
+
+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_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2058: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_gethostbyname=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    if test $ac_cv_func_gethostbyname = no; then
+      echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6
+echo "configure:2079: 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 2087 "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:2098: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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
+  X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    fi
+
+    # lieder@skyler.mavd.honeywell.com says without -lsocket,
+    # socket/setsockopt and other routines are undefined under SCO ODT
+    # 2.0.  But -lsocket is broken on IRIX 5.2 (and is not necessary
+    # on later versions), says simon@lia.di.epfl.ch: it contains
+    # gethostby* variants that don't use the nameserver (or something).
+    # -lsocket must be given before -lnsl if both are needed.
+    # We assume that if connect needs -lnsl, so does gethostbyname.
+    echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:2128: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2133 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char connect(); 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 connect();
+
+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_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2156: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_connect=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    if test $ac_cv_func_connect = no; then
+      echo $ac_n "checking for connect in -lsocket""... $ac_c" 1>&6
+echo "configure:2177: 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 $X_EXTRA_LIBS $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2185 "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:2196: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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
+  X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    fi
+
+    # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX.
+    echo $ac_n "checking for remove""... $ac_c" 1>&6
+echo "configure:2220: checking for remove" >&5
+if eval "test \"`echo '$''{'ac_cv_func_remove'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2225 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char remove(); 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 remove();
+
+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_remove) || defined (__stub___remove)
+choke me
+#else
+remove();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2248: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_remove=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_remove=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'remove`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    if test $ac_cv_func_remove = no; then
+      echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6
+echo "configure:2269: checking for remove in -lposix" >&5
+ac_lib_var=`echo posix'_'remove | 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="-lposix  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2277 "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 remove();
+
+int main() {
+remove()
+; return 0; }
+EOF
+if { (eval echo configure:2288: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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
+  X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    fi
+
+    # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay.
+    echo $ac_n "checking for shmat""... $ac_c" 1>&6
+echo "configure:2312: checking for shmat" >&5
+if eval "test \"`echo '$''{'ac_cv_func_shmat'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2317 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char shmat(); 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 shmat();
+
+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_shmat) || defined (__stub___shmat)
+choke me
+#else
+shmat();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2340: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_shmat=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_shmat=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'shmat`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    if test $ac_cv_func_shmat = no; then
+      echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6
+echo "configure:2361: checking for shmat in -lipc" >&5
+ac_lib_var=`echo ipc'_'shmat | 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="-lipc  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2369 "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 shmat();
+
+int main() {
+shmat()
+; return 0; }
+EOF
+if { (eval echo configure:2380: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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
+  X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    fi
+  fi
+
+  # Check for libraries that X11R6 Xt/Xaw programs need.
+  ac_save_LDFLAGS="$LDFLAGS"
+  test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries"
+  # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to
+  # check for ICE first), but we must link in the order -lSM -lICE or
+  # we get undefined symbols.  So assume we have SM if we have ICE.
+  # These have to be linked with before -lX11, unlike the other
+  # libraries we check for below, so use a different variable.
+  #  --interran@uluru.Stanford.EDU, kb@cs.umb.edu.
+  echo $ac_n "checking for IceConnectionNumber in -lICE""... $ac_c" 1>&6
+echo "configure:2413: checking for IceConnectionNumber in -lICE" >&5
+ac_lib_var=`echo ICE'_'IceConnectionNumber | 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="-lICE $X_EXTRA_LIBS $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2421 "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 IceConnectionNumber();
+
+int main() {
+IceConnectionNumber()
+; return 0; }
+EOF
+if { (eval echo configure:2432: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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
+  X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+  LDFLAGS="$ac_save_LDFLAGS"
+
+fi
+
+ 
+XINCLUDES=""
+XLIBS=""
+ 
+if test "$x_includes" != "" 
+then 
+  XINCLUDES=-I$x_includes
+fi
+ 
+if test "$x_libraries" != ""
+then
+   XLIBS="-L$x_libraries"
+fi
+
+
+
+
+XLIBS="$XLIBS $X_PRE_LIBS -lX11 $X_EXTRA_LIBS"
+###
+###		Subsystems
+###
+echo -n "checking for gmp..."
+if test "$enable_local_gmp" = "yes"; then
+cat >> confdefs.h <<\EOF
+#define HAVE_LOCAL_GMP 1
+EOF
+
+echo "use local $enable_local_gmp"
+else
+subdirs="gmp"
+
+echo "use provided"
+fi
+CLIBS="-lgmp ${CLIBS}"
+###
+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 | grep ac_space) 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.13"
+    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 "h/config.h compile.lsp compile2.lsp compile_rest.lsp bare.lsp
+ lsp/config.lsp cmp/cmpcfg.lsp lsp/load.lsp clos/load.lsp cmp/load.lsp
+ ../Makefile Makefile c/Makefile crs/Makefile doc/Makefile
+ tk/Makefile clx/defsys.lsp tests/Makefile ansi-tests/Makefile gabriel/Makefile
+ lsp/defsys.lsp cmp/defsys.lsp clos/defsys.lsp gc/Makefile h/config.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%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%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%@ECLS_VERSION@%$ECLS_VERSION%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%@builddir@%$builddir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@TKLIBS@%$TKLIBS%g
+s%@CC@%$CC%g
+s%@CPP@%$CPP%g
+s%@RANLIB@%$RANLIB%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@LN_S@%$LN_S%g
+s%@CP@%$CP%g
+s%@RM@%$RM%g
+s%@MV@%$MV%g
+s%@RUN@%$RUN%g
+s%@LSPCFLAGS@%$LSPCFLAGS%g
+s%@CLIBS@%$CLIBS%g
+s%@ILDFLAGS@%$ILDFLAGS%g
+s%@UNEXEC@%$UNEXEC%g
+s%@DLD@%$DLD%g
+s%@RSYM@%$RSYM%g
+s%@SETJMP@%$SETJMP%g
+s%@SETJMPO@%$SETJMPO%g
+s%@architecture@%$architecture%g
+s%@software_type@%$software_type%g
+s%@software_version@%$software_version%g
+s%@X_CFLAGS@%$X_CFLAGS%g
+s%@X_PRE_LIBS@%$X_PRE_LIBS%g
+s%@X_LIBS@%$X_LIBS%g
+s%@X_EXTRA_LIBS@%$X_EXTRA_LIBS%g
+s%@XINCLUDES@%$XINCLUDES%g
+s%@XLIBS@%$XLIBS%g
+s%@subdirs@%$subdirs%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-"h/config.h compile.lsp compile2.lsp compile_rest.lsp bare.lsp
+ lsp/config.lsp cmp/cmpcfg.lsp lsp/load.lsp clos/load.lsp cmp/load.lsp
+ ../Makefile Makefile c/Makefile crs/Makefile doc/Makefile
+ tk/Makefile clx/defsys.lsp tests/Makefile ansi-tests/Makefile gabriel/Makefile
+ lsp/defsys.lsp cmp/defsys.lsp clos/defsys.lsp gc/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="h/config.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
+# Fix machine dependencies in Makefiles
+CPP=`grep "^s%@CPP@%" config.status | sed -e "s/^s%@CPP@%//g" -e "s/%g$//g"`
+# Prefer cpp since it does not remove backslash newline
+test -x /lib/cpp && CPP=/lib/cpp
+# Get back the value for host:
+host=`grep "^s%@host@" config.status | sed -e "s/s%@host@%//" -e "s/%g//"`
+
+# Can't use @host@ directly in Makefile's or CPP will replace with 1
+SUBDIR_MAKEFILES=`grep SUBDIR_MAKEFILES= Makefile | sed -e "s/SUBDIR_MAKEFILES=//"`
+for mf in lsp/config.lsp compile.lsp compile2.lsp compile_rest.lsp bare.lsp\
+     lsp/load.lsp cmp/load.lsp clos/load.lsp cmp/cmpcfg.lsp \
+     Makefile ${SUBDIR_MAKEFILES}; do
+     echo updating $mf
+     # pull in configuration #defines, but omit #includes
+     cat h/config.h | \
+	grep -v '^# *include' > junk.c
+     sed -e '/^#  */d' $mf >> junk.c
+     ${CPP} -P -D${host} junk.c | \
+     sed -e "s/@MACHINE@/${host}/" \
+	 -e 's/^#.*//' -e 's/^[ 	][ 	]*$//' -e 's/^ /	/' | \
+     sed -n -e '/^..*$/p' > $mf
+     rm -f junk.c
+done
+echo updating ../Makefile
+# Fix srcdir and VPATH
+sed -e "s/@MACHINE@/${host}/" -e "s%src/\.\.$%src%" ../Makefile > foo
+mv foo ../Makefile
+# Fix for GNU make: does not help
+#touch Makefile
+
+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
+
+if test "$no_recursion" != yes; then
+
+  # Remove --cache-file and --srcdir arguments so they do not pile up.
+  ac_sub_configure_args=
+  ac_prev=
+  for ac_arg in $ac_configure_args; do
+    if test -n "$ac_prev"; then
+      ac_prev=
+      continue
+    fi
+    case "$ac_arg" in
+    -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=*)
+      ;;
+    -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+      ac_prev=srcdir ;;
+    -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+      ;;
+    *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;;
+    esac
+  done
+
+  for ac_config_dir in gmp; do
+
+    # Do not complain, so a configure script can configure whichever
+    # parts of a large source tree are present.
+    if test ! -d $srcdir/$ac_config_dir; then
+      continue
+    fi
+
+    echo configuring in $ac_config_dir
+
+    case "$srcdir" in
+    .) ;;
+    *)
+      if test -d ./$ac_config_dir || mkdir ./$ac_config_dir; then :;
+      else
+        { echo "configure: error: can not create `pwd`/$ac_config_dir" 1>&2; exit 1; }
+      fi
+      ;;
+    esac
+
+    ac_popdir=`pwd`
+    cd $ac_config_dir
+
+      # A "../" for each directory in /$ac_config_dir.
+      ac_dots=`echo $ac_config_dir|sed -e 's%^\./%%' -e 's%[^/]$%&/%' -e 's%[^/]*/%../%g'`
+
+    case "$srcdir" in
+    .) # No --srcdir option.  We are building in place.
+      ac_sub_srcdir=$srcdir ;;
+    /*) # Absolute path.
+      ac_sub_srcdir=$srcdir/$ac_config_dir ;;
+    *) # Relative path.
+      ac_sub_srcdir=$ac_dots$srcdir/$ac_config_dir ;;
+    esac
+
+    # Check for guested configure; otherwise get Cygnus style configure.
+    if test -f $ac_sub_srcdir/configure; then
+      ac_sub_configure=$ac_sub_srcdir/configure
+    elif test -f $ac_sub_srcdir/configure.in; then
+      ac_sub_configure=$ac_configure
+    else
+      echo "configure: warning: no configuration information is in $ac_config_dir" 1>&2
+      ac_sub_configure=
+    fi
+
+    # The recursion is here.
+    if test -n "$ac_sub_configure"; then
+
+      # Make the cache file name correct relative to the subdirectory.
+      case "$cache_file" in
+      /*) ac_sub_cache_file=$cache_file ;;
+      *) # Relative path.
+        ac_sub_cache_file="$ac_dots$cache_file" ;;
+      esac
+  case "$ac_given_INSTALL" in
+        [/$]*) INSTALL="$ac_given_INSTALL" ;;
+        *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+        esac
+
+      echo "running ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir"
+      # The eval makes quoting arguments work.
+      if eval ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir
+      then :
+      else
+        { echo "configure: error: $ac_sub_configure failed for $ac_config_dir" 1>&2; exit 1; }
+      fi
+    fi
+
+    cd $ac_popdir
+  done
+fi
+
diff --git a/src/configure.in b/src/configure.in
new file mode 100644
index 000000000..01d44fc8f
--- /dev/null
+++ b/src/configure.in
@@ -0,0 +1,365 @@
+dnl
+dnl  This is an autoconf script.
+dnl  To rebuild the `configure' script from this, execute the command
+dnl 	autoconf
+dnl  in the directory containing this script.
+dnl
+dnl  AUTOCONF configuration for ECLS
+dnl  Giuseppe Attardi 25.1.1994
+dnl
+dnl  configure.in    ---<autoconf>--->> configure
+dnl
+dnl                      _____
+dnl  configure                \
+dnl  src/h/config.h.in   ----<sh>---->> $(machine)/h/config.h
+dnl  src/*/Makefile.in   _____/         $(machine)/*/Makefile
+dnl
+dnl  $(machine)/Makefile ---<make>--->> ecls
+dnl
+dnl
+AC_INIT(configure.in)
+AC_PREREQ(2.1)		# You must have autoconf version 2.1 or later.
+
+###
+### Make sure we do not configure within source directory
+###
+if test -f configure; then
+echo "***"
+echo "*** This program cannot be built within the source directory ***"
+echo "***"
+exit 2;
+fi
+
+dnl Set the version number. This seems the best place to keep it.
+ECLS_VERSION=0.2
+AC_SUBST(ECLS_VERSION)
+
+dnl Guess operating system of host. We do not allow cross-compiling.
+AC_CANONICAL_HOST
+
+AC_CONFIG_HEADER(h/config.h)
+AC_SUBST(host)
+AC_SUBST(bindir)
+AC_SUBST(mandir)
+AC_SUBST(infodir)
+AC_SUBST(builddir)
+AC_SUBST(top_srcdir)
+AC_SUBST(TKLIBS)
+AC_ARG_ENABLE(clos,
+	[	--disable-clos		Don't include CLOS.],
+	clos=`test "$enable_clos" != "no"`, clos=1)
+AC_ARG_ENABLE(gmp,
+	[       --enable-local-gmp      Use local GMP library.],
+	gmp="$enable_local_gmp")
+AC_ARG_ENABLE(boehm,
+	[	--enable-boehm	 	Enable Boehm & Weiser's garbage collector.],
+	boehm="$enable_boehm")
+AC_ARG_ENABLE(profile,
+	[	--enable-profile 	Enable profiling tool.],
+	profile="$enable_profile")
+AC_ARG_ENABLE(tk,
+	[	--enable-tk		Include Tk.],
+	tk="$enable_tk")
+AC_ARG_ENABLE(clx,
+	[	--enable-clx		Include CLX.],
+	clx="$enable_clx")
+AC_ARG_ENABLE(tcp,
+	[	--enable-tcp		Include socket interface.],
+	tcp="$enable_tcp")
+AC_ARG_ENABLE(locative,
+	[	--enable-locative	Include locative support.],
+	locative="$enable_locative")
+AC_ARG_ENABLE(threads,
+	[	--enable-threads	Include the multiple thread facility.],
+	threads="$enable_threads")
+AC_ARG_ENABLE(runtime,
+	[	--enable-runtime	Build a RunTime Lisp with no compiler.],
+	runtime="$enable_runtime")
+[
+#### Make srcdir absolute, if it isn't already.  It's important to
+#### avoid running the path through pwd unnecessarily, since pwd can
+#### give you automounter prefixes, which can go away.
+case "${srcdir}" in
+  /* ) ;;
+  . )
+    ## We may be able to use the $PWD environment variable to make this
+    ## absolute.  But sometimes PWD is inaccurate.
+    if [ "${PWD}" != "" ] && [ "`(cd ${PWD} ; sh -c pwd)`" = "`pwd`" ] ; then
+      srcdir="$PWD"
+    else
+      srcdir="`(cd ${srcdir}; pwd)`"
+    fi
+  ;;
+  *  ) srcdir="`(cd ${srcdir}; pwd)`" ;;
+esac
+
+### Guess the operating system
+case $host_os in
+	linux*)
+		host="linux"
+		;;
+	freebsd*)
+		host="freebsd"
+		;;
+	netbsd*)
+		host="netbsd"
+		;;
+	*)
+		host="$host_os"
+		;;
+esac
+
+### Establish some default values.
+
+if test "x$prefix" = "xNONE"; then prefix=${ac_default_prefix}; fi
+if test "x$exec_prefix" = "xNONE"; then exec_prefix=${prefix}; fi
+bindir="${exec_prefix}/bin"
+libdir="${exec_prefix}/lib/ecls"
+mandir="${prefix}/man/man1"
+infodir="${prefix}/info"
+builddir=`pwd`
+
+if [ $profile ] ; then
+ if [ ${host} = linux ] ; then
+ LIBS="${LIBS} -lgmon"
+ fi
+fi
+if [ $tk ] ; then
+ TKLIBS="-ltk -ltcl -lXpm @XLIBS@"
+fi
+
+]
+### ----------------------------------------------------------------------
+###		Set options
+###
+test "${boehm}" && AC_DEFINE(GBC_BOEHM)
+test "${clos}" && AC_DEFINE(CLOS)
+test "${tk}" && AC_DEFINE(TK)
+test "${clx}" && AC_DEFINE(CLX)
+test "${tcp}" -o "${clx}" && AC_DEFINE(TCP)
+test "${locative}" && AC_DEFINE(LOCATIVE)
+test "${threads}" && AC_DEFINE(THREADS)
+test "${runtime}" && AC_DEFINE(RUNTIME)
+test "${profile}" && AC_DEFINE(PROFILE)
+### ----------------------------------------------------------------------
+###           checks for programs
+CC=gcc		      # We need gcc for variable length arrays
+AC_SUBST(CC)
+AC_ISC_POSIX
+AC_PROG_CPP           # sets variable CPP
+AC_PROG_RANLIB        # sets variable RANLIB
+AC_PROG_INSTALL       # sets variables INSTALL, INSTALL_DATA, INSTALL_PROGRAM
+AC_PROG_LN_S          # sets variable LN_S
+[
+#### Some command variations:
+
+if test ${host} = MSDOS -o ${host} = GO32 ; then
+ RM="deltree /y"
+ CP="copy"
+ MV="move"
+ if test ${host} = MSDOS ; then
+   RUN="emx "
+  else
+   RUN="go32 "
+  fi
+else
+ RM="rm -f"
+ CP="cp"
+ MV="mv"
+ RUN="./"
+fi
+
+#### Extract some information from the machine description file.
+#### WARNING: file confdefs.h may depend on version of Autoconf
+
+echo "Extracting parameters from the machine description file"
+
+tempcname="conftest.c"
+
+echo '
+#include "confdefs.h"
+#include "'${srcdir}'/h/machines.h"
+#ifdef CFLAGS
+configure___CFLAGS=CFLAGS
+#endif
+
+#ifdef LSPCFLAGS
+configure___LSPCFLAGS=LSPCFLAGS
+#endif
+
+#ifdef CLIBS
+configure___CLIBS=CLIBS
+#endif
+
+#ifdef LDFLAGS
+configure___LDFLAGS=LDFLAGS
+#endif
+
+#ifdef ILDFLAGS
+configure___ILDFLAGS=ILDFLAGS
+#endif
+
+#ifdef UNEXEC
+configure___UNEXEC=UNEXEC
+#else
+configure___UNEXEC=unixsave
+#endif
+
+#ifdef DLD
+configure___DLD=DLD
+#else
+configure___DLD=dld
+#endif
+
+#ifdef RSYM
+configure___RSYM=RSYM
+#endif
+
+#ifdef SETJMP
+configure___SETJMP=SETJMP
+#endif
+
+#ifdef _setjmp
+configure____jmp=1
+#endif
+
+configure___architecture=ARCHITECTURE
+configure___software_type=SOFTWARE_TYPE
+configure___software_version=SOFTWARE_VERSION
+' > ${tempcname}
+
+# The value of CPP is a quoted variable reference, so we need to do this
+# to get its actual value...
+CPP=`eval "echo $CPP"`
+eval `${CPP} -D${host} ${tempcname} \
+       | grep 'configure___' \
+       | sed -e 's/^configure___\([^=]*=\)[ ]*\(.*[^ ]\) */\1"\2"/' `
+rm ${tempcname}
+
+test ${SETJMP} && SETJMPO=setjmp.o
+
+CFLAGS="${CFLAGS}"
+CLIBS="${CLIBS} -lm"
+]
+test "$boehm" && CLIBS="-lgc ${CLIBS}"
+test "${_jmp}" && AC_DEFINE(_setjmp,setjmp)
+test "${_jmp}" && AC_DEFINE(_longjmp,longjmp)
+AC_SUBST(CP)
+AC_SUBST(RM)
+AC_SUBST(MV)
+AC_SUBST(RUN)
+AC_SUBST(CFLAGS)
+AC_SUBST(LSPCFLAGS)
+AC_SUBST(CLIBS)
+AC_SUBST(LDFLAGS)
+AC_SUBST(ILDFLAGS)
+AC_SUBST(UNEXEC)
+AC_SUBST(DLD)
+AC_SUBST(RSYM)
+AC_SUBST(SETJMP)
+AC_SUBST(SETJMPO)
+AC_SUBST(architecture)
+AC_SUBST(software_type)
+AC_SUBST(software_version)
+###
+###           checks for UNIX variants that set DEFS
+###
+AC_CHECK_LIB(sun, getpwnam)         # on IRIX adds -lsun
+###
+###           checks for header files
+###
+dnl AC_CHECK_HEADERS(unistd.h stdlib.h stdarg.h string.h)
+AC_CHECK_HEADERS(sys/resource.h)
+AC_CHECK_HEADERS(sys/utsname.h)
+AC_CHECK_FUNCS(nanosleep)
+###		      # DEFS HAVE_UNISTD_H, HAVE_STDLIB_H, HAVE_STDARG_H
+###		      # and HAVE_STRING_H
+dnl AC_DIR_HEADER         # directory reading functions, DEFS VOID_CLOSEDIR
+###
+###           checks for typedefs
+###
+dnl AC_TYPE_SIZE_T         # DEFS size_t
+dnl AC_TYPE_PID_T          # DEFS pid_t
+dnl AC_TYPE_UID_T          # DEFS uid_t, gid_t
+dnl AC_TYPE_OFF_T	   # DEFS off_t
+###
+###           checks for functions and declarations
+###
+###           checks for compiler characteristics
+###
+dnl Removed in Autoconf-2: AC_ARG_ARRAY               # DEFS NO_ARG_ARRAY
+AC_C_BIGENDIAN    	   # DEFS WORDS_BIGENDIAN
+dnl AC_C_CONST             # DEFS const
+dnl AC_C_CHAR_UNSIGNED     # DEFS __CHAR_UNSIGNED__ if char is unsigned
+###
+###	      X11 stuff
+###
+AC_PATH_X
+AC_PATH_XTRA
+ 
+XINCLUDES=""
+XLIBS=""
+ 
+if test "$x_includes" != "" 
+then 
+  XINCLUDES=-I$x_includes
+fi
+ 
+if test "$x_libraries" != ""
+then
+   XLIBS="-L$x_libraries"
+fi
+
+AC_SUBST(XINCLUDES)
+AC_SUBST(XLIBS)
+
+XLIBS="$XLIBS $X_PRE_LIBS -lX11 $X_EXTRA_LIBS"
+###
+###		Subsystems
+###
+echo -n "checking for gmp..."
+if test "$enable_local_gmp" = "yes"; then
+AC_DEFINE(HAVE_LOCAL_GMP)
+echo "use local $enable_local_gmp"
+else
+AC_CONFIG_SUBDIRS(gmp)
+echo "use provided"
+fi
+CLIBS="-lgmp ${CLIBS}"
+###
+AC_OUTPUT(h/config.h compile.lsp compile2.lsp compile_rest.lsp bare.lsp
+ lsp/config.lsp cmp/cmpcfg.lsp lsp/load.lsp clos/load.lsp cmp/load.lsp
+ ../Makefile Makefile c/Makefile crs/Makefile doc/Makefile
+ tk/Makefile clx/defsys.lsp tests/Makefile ansi-tests/Makefile gabriel/Makefile
+ lsp/defsys.lsp cmp/defsys.lsp clos/defsys.lsp gc/Makefile,
+
+# Fix machine dependencies in Makefiles
+CPP=`grep "^s%@CPP@%" config.status | sed -e "s/^s%@CPP@%//g" -e "s/%g$//g"`
+# Prefer cpp since it does not remove backslash newline
+test -x /lib/cpp && CPP=/lib/cpp
+# Get back the value for host:
+host=`grep "^s%@host@" config.status | sed -e "s/s%@host@%//" -e "s/%g//"`
+
+# Can't use @host@ directly in Makefile's or CPP will replace with 1
+SUBDIR_MAKEFILES=`grep SUBDIR_MAKEFILES= Makefile | sed -e "s/SUBDIR_MAKEFILES=//"`
+for mf in lsp/config.lsp compile.lsp compile2.lsp compile_rest.lsp bare.lsp\
+     lsp/load.lsp cmp/load.lsp clos/load.lsp cmp/cmpcfg.lsp \
+     Makefile ${SUBDIR_MAKEFILES}; do
+     echo updating $mf
+     # pull in configuration #defines, but omit #includes
+     cat h/config.h | \
+	grep -v '^# *include' > junk.c
+     sed -e '/^#  */d' $mf >> junk.c
+     ${CPP} -P -D${host} junk.c | \
+     sed -e "s/@MACHINE@/${host}/" \
+	 -e 's/^#.*//' -e 's/^[ 	][ 	]*$//' -e 's/^ /	/' | \
+     sed -n -e '/^..*$/p' > $mf
+     rm -f junk.c
+done
+echo updating ../Makefile
+# Fix srcdir and VPATH
+sed -e "s/@MACHINE@/${host}/" -e "s%src/\.\.$%src%" ../Makefile > foo
+mv foo ../Makefile
+# Fix for GNU make: does not help
+#touch Makefile
+)
diff --git a/src/crs/Copying.GPL b/src/crs/Copying.GPL
new file mode 100644
index 000000000..aca3fe3ef
--- /dev/null
+++ b/src/crs/Copying.GPL
@@ -0,0 +1,339 @@
+                    GNU GENERAL PUBLIC LICENSE
+                       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+                          675 Mass Ave, Cambridge, MA 02139, 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
+
+        Appendix: 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., 675 Mass Ave, Cambridge, MA 02139, 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/src/crs/Makefile.in b/src/crs/Makefile.in
new file mode 100644
index 000000000..660556381
--- /dev/null
+++ b/src/crs/Makefile.in
@@ -0,0 +1,46 @@
+# file crs/Makefile
+
+top_srcdir= @top_srcdir@
+srcdir	= @srcdir@
+VPATH	= @srcdir@
+
+MACHINE = @MACHINE@
+
+# Programs used by "make":
+#
+CC	= @CC@
+DEFS	= -D$(MACHINE)
+CFLAGS	= -I../h -I$(top_srcdir)/h -I$(top_srcdir)/gmp @CFLAGS@ $(DEFS)
+
+SHELL	= /bin/sh
+RM	= @RM@
+
+# Files
+
+OBJS	= dld.o @SETJMPO@ socket.o
+HFILES	= ../h/config.h $(srcdir)/objff.h
+TARGETS = ../libcrs.a @RSYM@
+
+all:	$(TARGETS)
+
+../libcrs.a: $(OBJS)
+	ar r $@ $(OBJS)
+	@RANLIB@ $@
+
+dld.o:	$(srcdir)/@DLD@.c $(HFILES)
+	$(CC) -c $(CFLAGS) $(srcdir)/@DLD@.c -o $@
+
+socket.o:	$(srcdir)/socket.c
+	$(CC) -c $(CFLAGS) $(srcdir)/socket.c -o $@
+
+unexec.o:	$(srcdir)/@UNEXEC@.c $(HFILES)
+	$(CC) -c $(CFLAGS) $(srcdir)/@UNEXEC@.c -o $@
+
+setjmp.o: $(srcdir)/@SETJMP@
+	as $(srcdir)/@SETJMP@ -o $@
+
+rsym rsym.exe: $(srcdir)/rsym.c $(top_srcdir)/h/machines.h
+	${CC} ${CFLAGS} $(srcdir)/rsym.c -o $@
+
+clean:
+	$(RM) $(TARGETS) $(OBJS) core a.out
diff --git a/src/crs/README b/src/crs/README
new file mode 100644
index 000000000..354f11417
--- /dev/null
+++ b/src/crs/README
@@ -0,0 +1,19 @@
+
+This directory contains the components of the Common Runtime Support:
+
+1. memory management (files gbc.c alloc.c)
+2. dumping an image (files unex*.c and unixsave.c)
+3. dynamic loading (dld.c)
+4. networking support (tcp.c)
+
+These are built into a library (libcrs.a) which is searched when
+building a Lisp application.
+
+Implementations of unexec for various architectures is provided.
+Some of them are those provided with GNU Emacs.
+However we cannot use for instance unexsunos4, which expects a dynamic
+linked executable, since this prevents subsequent loading of files
+(procedures such as memcpy and _setjmp do not appear in the load map).
+
+As a fall back we use unixsave.c, which works for all Suns, HP9000/300,
+Vax, DOS/go32, Apollo, IBM/RT, Sequent.
diff --git a/src/crs/dld.c b/src/crs/dld.c
new file mode 100644
index 000000000..6c87b2a16
--- /dev/null
+++ b/src/crs/dld.c
@@ -0,0 +1,1475 @@
+/*
+    Copyright (c) 1990, Giuseppe Attardi and William F. Schelter.
+
+    This program is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+	dld.c
+*/
+
+/* 
+  There is a companion file rsym.c which is used to build
+  a list of the external symbols in a COFF, ECOFF, ELF or A.OUT object file.
+  These are loaded into ECL, and the linking is done directly inside ECL.
+*/
+
+#include "ecls.h"
+/*#include "page.h"*/
+#include "objff.h"
+#include <sys/wait.h>
+#include <limits.h>
+
+/* bsearch is provided in the Standard C library		*/
+#if !defined(__stdlib_h) && !defined(_STDLIB_H_) && !defined(__STDLIB_H__) && !defined(_STDLIB_H)
+char *
+bsearch(VOID *key, VOID *base, unsigned long nel, unsigned long offset,
+	int (*compar)(const VOID *, const VOID *))
+{
+  int low, high, mid, n;
+  low = 0;
+  high = nel - 1;
+  while (low <= high) {
+    mid = (low + high) / 2;
+    n = compar(key, (char *)((int)base + offset * mid));
+    if (n < 0)
+      high = mid - 1;
+    else if (n > 0)
+      low = mid + 1;
+    else			/* found match */
+      return ((char *)((int)base + offset * mid)); }
+  return (NULL);
+}
+#endif __stdlib_h
+
+struct node {
+  char *string;
+  unsigned int address;
+};
+
+typedef struct node TABL[]; 
+
+struct  string_address_table {
+  TABL *ptable;
+  unsigned int length;
+  unsigned int alloc_length;
+} c_table;
+
+#define PTABLE_EXTRA 20
+
+#define ROUND_UP(a, n)	((a + n - 1) & ~(n-1))
+
+/* ---------------------------------------------------------------------- */
+#define TEMPSPACE 50000
+static char tempSpace[TEMPSPACE];
+static char *tempTop;
+
+char *
+temp_malloc(unsigned int n)
+{  char *val;
+   val = (char *)(((int)tempTop + 7) & ~07); /* was 3 on SUN3 */
+   tempTop = val + n;
+   if (tempTop < tempSpace + TEMPSPACE)
+     return val;
+   else {
+     tempTop = val;
+     return malloc(n);
+   }
+ }
+
+/* free up space which is not allocated in tempSpace */
+
+#define TEMP_FREE(x) \
+if (((char *)x) > tempSpace+TEMPSPACE || ((char *)x) < tempSpace) free(x)
+
+/* ---------------------------------------------------------------------- */
+
+#ifdef apollo
+int section_padding[5];
+int section_vaddr[5];
+
+int section_index(vaddr)
+int vaddr;
+{ int i;
+  for (i = 0; i < 4; i++)
+   if (vaddr < section_vaddr[i+1])
+	return(i);
+  return(4);
+}
+#endif apollo
+
+static RELOC reloc_info;
+static SYMENT *symbol_table;
+
+int
+node_compare(const VOID *node1, const VOID *node2)
+{ return(strcmp(((struct node *)node1)->string,
+		((struct node *)node2)->string));
+}
+
+/* ---------------------------------------------------------------------- */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * dld --
+ *     dynamically load a file into memory.
+ *
+ * Results:
+ *	none.
+ *
+ * Side effects:
+ *	codeblock: containing address where the code has been loaded, and
+ *		   its size
+ *
+ *----------------------------------------------------------------------
+ */
+#ifdef AOUT
+dld(char *faslfile, void **block_start, int *block_size)
+{
+	FILHDR fileheader;
+#ifdef hpux
+	int string_size = 0;
+#endif hpux
+	int textsize, datasize, bsssize, nsyms, extra_bss = 0;
+	char *start_address, *segment_start;
+	cl_object memory, data;
+	FILE *fp;
+	int i, file_end;
+	char *string_table;
+	char buf[BUFSIZ];
+
+	tempTop = tempSpace; /* reset tmp malloc */
+	fp = fopen(faslfile, OPEN_R);
+	if (fp == NULL)
+	  FEerror(";;; Could not open binary file.", 0);
+	setbuf(fp, buf);
+	if (!fread((char *)&fileheader, sizeof(FILHDR), 1, fp))
+	  FEerror(";;; Could not get the header.", 0);
+
+	nsyms = NSYMS(fileheader);
+	textsize = fileheader.a_text;
+	datasize = fileheader.a_data;
+	bsssize = fileheader.a_bss;
+
+	/* 
+	  STEPS:
+	  1) read in the symbol table from the file
+	  2) read in the string table from the file
+	  3) load text + data from the file
+	  4) go through the symbol table, filling external entries
+	  5) go through the relocation information for sections 0..2
+	     relocating the text.
+	*/
+
+	/* STEP 1 -------- Read the symbol table */
+
+	fseek(fp, (int)N_SYMOFF(fileheader), 0);
+	symbol_table = (SYMENT *)temp_malloc(sizeof(SYMENT)*nsyms);
+	/*
+	  Since for alignment reasons on some machines (e.g. i386 and sparc)
+	  the sizeof(SYMENT) != SYMESZ, we must read one SYMENT at a time.
+	  */
+	for (i = 0;  i < nsyms;  i++) {
+	  fread((char *)&symbol_table[i], SYMESZ, 1, fp);
+#         ifdef hpux
+	  symbol_table[i].n_un.n_strx = string_size;
+	  string_size += symbol_table[i].n_length + 1;
+	  fseek(fp, (int)symbol_table[i].n_length, 1);
+#         endif hpux
+	}
+
+	/* STEP 2 -------- Read the string table */
+
+#ifdef hpux
+	{ char *p;
+	  int slen, i, j;
+	  string_table = p = temp_malloc((unsigned int)string_size);
+	  fseek(fp, LESYM_OFFSET(fileheader), 0);
+	  for (i = fileheader.a_lesyms, j = 0; i > 0; i = i - slen - SYMESZ) {
+	    fseek(fp, SYMESZ, 1);
+	    slen = symbol_table[j++].n_length;
+	    fread(p, slen, 1, fp);
+	    *((p)+slen) = '\0';
+	    p += slen + 1;
+	  }
+	}
+	fseek(fp, RDATA_OFFSET(fileheader) + fileheader.a_drsize, 0);
+#else
+	/* The string table is located just after the symbols:
+	   first word contains its size */
+	if (!fread((char *)&i, sizeof(int), 1, fp))
+	  FEerror(";;; The string table of this file is missing.", 0);
+	fseek(fp, -sizeof(int), 1);
+	string_table = temp_malloc(i);
+	if (i != fread(string_table, 1, i, fp))
+	  FEerror(";;; Could not read whole string table.", 0);
+ 	while ((i = getc(fp)) == 0) ; /* skip null characters */
+	ungetc(i, fp);
+#endif hpux
+
+	file_end = ftell(fp);
+
+	if (!(c_table.ptable && *(c_table.ptable))) {
+	  build_symbol_table();
+	  qsort((char*)(c_table.ptable), (int)(c_table.length),
+		sizeof(struct node), node_compare);
+	}
+
+	/* figure out if there is more bss space needed */
+	extra_bss = get_extra_bss(symbol_table, nsyms,
+				  datasize+textsize+bsssize, string_table);
+	*block_size = datasize+textsize+bsssize + extra_bss;
+
+	/*
+	   We must align at 8 to ensure that doubles are properly aligned.
+	   On SGI this helps work around an R4000 bug present in 2.1 and 2.2
+	   silicon which appears when certain classes of branch instructions
+	   are the last instruction on a page of virtual memory.
+	 */
+	*block_start = alloc_align(*block_size, 8);
+	start_address = *block_start;
+
+	/* STEP 3 -------- Load text and data	*/
+
+	if (fseek(fp, N_TXTOFF(fileheader), 0) < 0)
+	  FEerror(";;; File seek error.", 0);
+	fread((char *)start_address, textsize + datasize, 1, fp);
+
+	/* STEP 4 -------- Put value into symbols  */
+
+	link_symbols(nsyms, string_table, start_address);
+	
+	/* STEP 5 -------- Perform relocation	*/
+
+	segment_start = start_address;
+	{ int nrel = fileheader.a_trsize / RELSZ;
+	  fseek(fp, N_TRELOCOFF(fileheader), 0);
+	  for (i = 0; i < nrel; i++) {
+	    fread((char *)&reloc_info, RELSZ, 1, fp);
+	    relocate(segment_start + reloc_info.r_address, start_address);
+	  }
+#         ifdef N_DRELOFF
+	  fseek (fp, N_DRELOFF(fileheader), 0);
+#         endif N_DRELOFF
+	  nrel = (fileheader.a_drsize / RELSZ);
+	  segment_start += fileheader.a_text;
+	  for (i = 0; i < nrel; i++) {
+	    fread((char *)&reloc_info, RELSZ, 1, fp);
+	    relocate(segment_start + reloc_info.r_address, start_address);
+	  }
+	}
+	/* end of relocation */
+	fclose(fp);
+
+	TEMP_FREE(string_table);
+	TEMP_FREE(symbol_table);
+}
+#endif
+
+#ifdef COFF
+dld(char *faslfile, void **block_start, int *block_size)
+{
+	FILHDR fileheader;
+	AOUTHDR aouthdr;
+# ifdef apollo
+#  define NSCNS 5
+        SCNHDR section[NSCNS];
+	int unwindsize, aptvsize;
+	int section_start;
+# else
+#  define NSCNS fileheader.f_nscns
+        SCNHDR section[4];
+# endif apollo
+# ifdef ECOFF
+	HDRR symheader;		/* header for symbol table */
+# endif ECOFF
+	int textsize, datasize, bsssize, nsyms, extra_bss = 0;
+	char *start_address, *segment_start;
+	cl_object memory, data;
+	FILE *fp;
+	int i, file_end;
+	char *string_table;
+	char buf[BUFSIZ];
+
+	tempTop = tempSpace; /* reset tmp malloc */
+	fp = fopen(faslfile, OPEN_R);
+	if (fp == NULL)
+	  FEerror(";;; Could not open binary file.", 0);
+	setbuf(fp, buf);
+	if (!fread((char *)&fileheader, sizeof(FILHDR), 1, fp))
+	  FEerror(";;; Could not get the header.", 0);
+
+	nsyms = NSYMS(fileheader);
+	/* read aouthdr */
+	if (fileheader.f_opthdr)
+	  fread(&aouthdr, fileheader.f_opthdr, 1, fp);
+	fread(&section[0], sizeof(SCNHDR), 1, fp);
+        textsize = section[0].s_size;
+# ifdef apollo
+	section_start = 0;
+	section_vaddr[0] = section[0].s_vaddr;
+	section_padding[0] = section[0].s_vaddr - section_start;
+	/* APOLLO has additional sections */
+	/*	.unwind	*/
+	fread((char *)&section[1], sizeof(SCNHDR), 1, fp);
+	unwindsize = section[1].s_size;
+	section_start += section[0].s_size;
+	section_vaddr[1] = section[1].s_vaddr;
+	section_padding[1] = section[1].s_vaddr - section_start;
+	/*	.data	*/
+	fread((char *)&section[2], sizeof(SCNHDR), 1, fp);
+	datasize = section[2].s_size; 
+	section_start += section[1].s_size;
+	section_vaddr[2] = section[2].s_vaddr;
+	section_padding[2] = section[2].s_vaddr - section_start;
+	/*	.aptv	*/
+	fread((char *)&section[3], sizeof(SCNHDR), 1, fp);
+	if (section[2].s_scnptr) {
+	   aptvsize = section[3].s_size;
+	   section_start += section[2].s_size;
+	} else {
+	   /* APTV is included in .data section */
+	   aptvsize = section[3].s_size - datasize;
+	}
+	section_vaddr[3] = section[3].s_vaddr;
+	section_padding[3] = section[3].s_vaddr - section_start;
+	/*	.bss	*/
+	fread((char *)&section[4], sizeof(SCNHDR), 1, fp);
+	if (strcmp(section[4].s_name, ".bss") == 0)
+	  bsssize = section[4].s_size; 
+	else
+	  bsssize = 0;
+	section_start += section[3].s_size;
+	section_vaddr[4] = section[4].s_vaddr;
+	section_padding[4] = section[4].s_vaddr - section_start;
+# else /* !apollo */
+	nsyms = NSYMS(fileheader);
+	/* Read data sections: .rdata (ECOFF), .data, .bss */
+	datasize = 0; bsssize = 0;
+	for (i = 1; i < NSCNS; i++) {
+	  fread((char *)&section[i], sizeof(SCNHDR), 1, fp);
+	  if (strcmp(section[i].s_name, ".bss") == 0)
+	    bsssize = section[i].s_size; 
+	  else
+	    datasize = section[i].s_size; 
+	}
+#  ifdef ECOFF
+	datasize = aouthdr.dsize;
+	bsssize = aouthdr.bsize;
+#  endif ECOFF
+# endif apollo
+
+	/* 
+	  STEPS:
+	  1) read in the symbol table from the file
+	  2) read in the string table from the file
+	  3) load text + data from the file
+	  4) go through the symbol table, filling external entries
+	  5) go through the relocation information for sections 0..2
+	     relocating the text.
+	*/
+
+	/* STEP 1 -------- Read the symbol table */
+
+# ifdef ECOFF
+	/* ECOFF has a Symbolic Header at the beginning of the symbol table */
+	fseek(fp, fileheader.f_symptr, 0);
+	fread(&symheader, sizeof(HDRR), 1, fp);
+	/* We care only of external symbols */
+	nsyms = symheader.iextMax;
+	fseek(fp, symheader.cbExtOffset, 0);
+# else
+	fseek(fp, (int)N_SYMOFF(fileheader), 0);
+# endif ECOFF
+	symbol_table = (SYMENT *)temp_malloc(sizeof(SYMENT)*nsyms);
+	/*
+	  Since for alignment reasons on some machines (e.g. i386 and sparc)
+	  the sizeof(SYMENT) != SYMESZ, we must read one SYMENT at a time.
+	  */
+	for (i = 0;  i < nsyms;  i++) {
+	  fread((char *)&symbol_table[i], SYMESZ, 1, fp);
+#         ifdef hpux
+	  symbol_table[i].n_un.n_strx = string_size;
+	  string_size += symbol_table[i].n_length + 1;
+	  fseek(fp, (int)symbol_table[i].n_length, 1);
+#         endif hpux
+	}
+
+#       ifdef ECOFF
+	/* In ECOFF external symbols are at the end of file */
+	file_end = ftell(fp);
+#       endif ECOFF
+
+	/* STEP 2 -------- Read the string table */
+
+# ifdef ECOFF
+	/* Read External Strings */
+	fseek(fp, symheader.cbSsExtOffset, 0);
+	i = symheader.cbFdOffset - symheader.cbSsExtOffset;
+	string_table = temp_malloc(i);
+	fread(string_table, i, 1, fp);
+# else /* COFF */
+	/* The string table is located just after the symbols:
+	   first word contains its size */
+	if (!fread((char *)&i, sizeof(int), 1, fp))
+	  FEerror(";;; The string table of this file is missing.", 0);
+	fseek(fp, -sizeof(int), 1);
+	string_table = temp_malloc(i);
+	if (i != fread(string_table, 1, i, fp))
+	  FEerror(";;; Could not read whole string table.", 0);
+ 	while ((i = getc(fp)) == 0) ; /* skip null characters */
+	ungetc(i, fp);
+# endif ECOFF
+
+#ifndef ECOFF
+	file_end = ftell(fp);
+#endif ECOFF
+
+	if (!(c_table.ptable && *(c_table.ptable))) {
+	  build_symbol_table();
+	  qsort((char*)(c_table.ptable), (int)(c_table.length),
+		sizeof(struct node), node_compare);
+	}
+
+	/* figure out if there is more bss space needed */
+	extra_bss = get_extra_bss(symbol_table, nsyms,
+				  datasize+textsize+bsssize, string_table);
+#ifdef apollo
+	*block_size = datasize+textsize+bsssize + extra_bss +
+	  unwindsize + aptvsize;
+#else
+	*block_size = datasize+textsize+bsssize + extra_bss;
+#endif apollo
+	/*
+	   We must align at 8 to ensure that doubles are properly aligned.
+	   On SGI this helps work around an R4000 bug present in 2.1 and 2.2
+	   silicon which appears when certain classes of branch instructions
+	   are the last instruction on a page of virtual memory.
+	 */
+	*block_start = alloc_align(*block_size, 8);
+	start_address = *block_start;
+
+	/* STEP 3 -------- Load text and data	*/
+
+	if (fseek(fp, N_TXTOFF(fileheader), 0) < 0)
+	  FEerror(";;; File seek error.", 0);
+# ifdef apollo
+	fread((char *)start_address, textsize + datasize +
+					   unwindsize + aptvsize, 1, fp);
+# else
+	fread((char *)start_address, textsize + datasize, 1, fp);
+# endif apollo
+
+	/* STEP 4 -------- Put value into symbols  */
+
+	link_symbols(nsyms, string_table, start_address);
+	
+	/* STEP 5 -------- Perform relocation	*/
+
+	segment_start = start_address;
+	{ int j;
+	  /* Apollo optimization.
+	     Do .text last, so that we can bypass APTV indirection */
+	  for (j = NSCNS-1; j >= 0; j--) {
+	    if (section[j].s_nreloc == 0) continue;
+	    fseek(fp, section[j].s_relptr, 0);
+	    for (i = 0; i < section[j].s_nreloc; i++) {
+	      fread(&reloc_info, RELSZ, 1, fp);
+# ifdef apollo
+	      relocate(segment_start + reloc_info.r_vaddr -
+		       section_padding[section_index(reloc_info.r_vaddr)],
+		       start_address);
+# else
+	      relocate(segment_start + reloc_info.r_vaddr, start_address);
+# endif apollo
+	    }
+	  }
+	}
+	/* end of relocation */
+	fclose(fp);
+
+	TEMP_FREE(string_table);
+	TEMP_FREE(symbol_table);
+}
+#endif COFF
+
+#ifdef ELF
+
+static SCNHDR *section_headers;
+static char *section_names;
+static int *section_start;
+static FILHDR *eheader;
+
+get_section_number(char *name)
+{ int k;
+  for (k = 1; k < eheader->e_shnum; k++)
+    if (strcmp(section_names + section_headers[k].sh_name, name) == 0)
+      return k;
+  return -1;
+}
+
+char *
+get_section(FILE *fp, char *name)
+{ int shndx;
+  char *ans;
+  if (strcmp(name, ".shstrtab") == 0)
+    shndx = eheader->e_shstrndx;
+  else
+    shndx = get_section_number(name);
+  fseek(fp, section_headers[shndx].sh_offset, SEEK_SET);
+  ans = (char *)temp_malloc(section_headers[shndx].sh_size);
+  fread(ans, section_headers[shndx].sh_size, 1, fp);
+  return ans;
+}
+
+dld(char *faslfile, void **block_start, int *block_size)
+{
+	FILHDR fileheader;
+	int textsize, datasize, nsyms, extra_bss = 0;
+	char *start_address, *segment_start;
+	FILE *fp;
+	int i, file_end;
+	char *string_table;
+	char buf[BUFSIZ];
+        int symtab_scn, max_align = 0, current = 0;
+	int section_starts[30];
+
+        for ( i = 0; i < sizeof(section_starts)/sizeof(int); i++)
+	  section_starts[i] = -1;
+	section_start = section_starts;
+	eheader = &fileheader;
+
+	tempTop = tempSpace; /* reset tmp malloc */
+	fp = fopen(faslfile, OPEN_R);
+	if (fp == NULL)
+	  FEerror(";;; Could not open binary file.", 0);
+	setbuf(fp, buf);
+	if (!fread((char *)&fileheader, sizeof(FILHDR), 1, fp))
+	  FEerror(";;; Could not get the header.", 0);
+
+	/* 
+	  STEPS:
+	  1) read in the symbol table from the file
+	  2) read in the string table from the file
+	  3) load text + data from the file
+	  4) go through the symbol table, filling external entries
+	  5) go through the relocation information for sections 0..2
+	     relocating the text.
+	*/
+
+	/* STEP 1 -------- Read the symbol table */
+
+	{ int symsize;
+	  /* Read section headers */
+	  section_headers = (void *)temp_malloc(sizeof(SCNHDR)*
+						(1 + fileheader.e_shnum));
+	  fseek(fp, fileheader.e_shoff, SEEK_SET);
+	  for (i = 0 ; i < fileheader.e_shnum ; i++)
+	    fread(&section_headers[i], fileheader.e_shentsize, 1, fp);
+	  /* Read the section names */
+	  section_names = get_section(fp,".shstrtab");
+	  symtab_scn = get_section_number(".symtab");
+	  symsize = section_headers[symtab_scn].sh_entsize;
+	  nsyms = section_headers[symtab_scn].sh_size / symsize;
+	  symbol_table = (void *)temp_malloc(sizeof(SYMENT) * nsyms);
+	  if (fseek(fp, section_headers[symtab_scn].sh_offset, SEEK_SET)) {
+	    fprintf(stderr, "seek error");
+	    exit(1);
+	  }
+	  /* Read the Symbol Table */
+	  for (i = 0;  i < nsyms;  i++)
+	    fread((char *)&symbol_table[i], symsize, 1, fp);
+	  /* calculate how much room is needed to align all the sections
+	     appropriately, and at what offsets they will be read in, presuming
+	     that the begin of the memory is aligned on max_align */
+	  for (i = 1 ; i < fileheader.e_shnum ; i++) {
+	    if ((section_headers[i].sh_flags & SHF_ALLOC)
+		 && (section_headers[i].sh_type == SHT_PROGBITS
+		    || section_headers[i].sh_type == SHT_NOBITS)) {
+	      if (section_headers[i].sh_addralign > max_align)
+		max_align = section_headers[i].sh_addralign;
+	      current = (int)ROUND_UP(current, section_headers[i].sh_addralign);
+	      section_start[i] = current;
+	      current += section_headers[i].sh_size;
+	    }
+	  }
+	}
+
+	/* STEP 2 -------- Read the string table */
+
+	string_table = get_section(fp,".strtab");
+	if (!(c_table.ptable && *(c_table.ptable))) {
+	  build_symbol_table();
+	  qsort((char*)(c_table.ptable), (int)(c_table.length),
+		sizeof(struct node), node_compare);
+	}
+	*block_size = current + (max_align > sizeof(char *) ? max_align : 0);
+	/*
+	   We must align at 8 to ensure that doubles are properly aligned.
+	   On SGI this helps work around an R4000 bug present in 2.1 and 2.2
+	   silicon which appears when certain classes of branch instructions
+	   are the last instruction on a page of virtual memory.
+	 */
+	*block_start = alloc_align(*block_size, 8);
+	start_address = *block_start;
+
+	/* STEP 3 -------- Load text and data	*/
+
+        for ( i = 1 ; i <  fileheader.e_shnum ; i++) {
+	  if ((section_headers[i].sh_flags & SHF_ALLOC)
+	      && (section_headers[i].sh_type == SHT_PROGBITS)) {
+	    fseek(fp, section_headers[i].sh_offset, SEEK_SET);
+	    fread((char *)(start_address + section_start[i]),
+		  section_headers[i].sh_size, 1, fp);
+	  }
+	}
+
+	/* STEP 4 -------- Put value into symbols  */
+
+	link_symbols(nsyms, string_table, start_address);
+	
+	/* STEP 5 -------- Perform relocation	*/
+
+	segment_start = start_address;
+        { int j, k;
+	  char *rel;
+	  SCNHDR *shp;
+	  for (j = 1 ; j < fileheader.e_shnum ; j++) {
+	    shp = &section_headers[j]; 
+	    /* if a section has no memory allocated to it, dont relocate it */
+	    if (!(section_headers[shp->sh_info].sh_flags & SHF_ALLOC))
+	      continue; /* was:
+              if (section_start[k] == -1) continue; Beppe */
+	    k = shp->sh_info;
+	    switch (shp->sh_type) {
+	    case SHT_RELA:
+	      if (symtab_scn != shp->sh_link)
+		FEerror(";;; Unexpected symbol table used", 0);
+	      segment_start = start_address + section_start[k];
+	      break;
+	    case SHT_REL:
+# ifndef __mips
+	      if (symtab_scn != shp->sh_link)
+		FEerror(";;; Unexpected symbol table used", 0);
+	      segment_start = start_address + section_start[k];
+	      break;
+# endif
+	    default: continue;
+	    }
+	    fseek(fp, shp->sh_offset, SEEK_SET);
+	    k = shp->sh_size / shp->sh_entsize;
+	    for (i = 0; i < k; i++) {
+	      fread(&reloc_info, shp->sh_entsize, 1, fp);
+	      relocate(segment_start + reloc_info.r_offset, start_address);
+	    }
+	  }
+	}
+	/* end of relocation */
+	fclose(fp);
+
+	TEMP_FREE(string_table);
+	TEMP_FREE(symbol_table);
+}
+#endif ELF
+
+#ifndef ELF
+get_extra_bss(SYMENT *symbol_table, int length, int start, char *string_table)
+{  int result = start;
+   SYMENT *end, *sym;
+   end = symbol_table + length;
+   for (sym = symbol_table; sym < end; sym++) {
+#ifdef COFF
+#    ifndef ECOFF
+     char tem[SYMNMLEN +1];
+#    endif ECOFF
+     if (0)
+       /* what we really want is
+	  if (sym->n_scnum == 0 && sym->n_sclass == C_EXT
+	  && !(bsearch(..in ptable for this symbol)))
+	  Since this won't allow loading in of a new external array
+	  char foo[10]  not ok
+	  static foo[10] ok.
+	  for the moment we give undefined symbol warning..
+	  Should really go through the symbols, recording the external addr
+	  for ones found in ptable, and for the ones not in ptable
+	  set some flag, and add up the extra_bss required.  Then
+	  when you have the new memory chunk in hand,
+	  you could make the pass setting the relative addresses.
+	  for the ones you flagged last time.
+	  */
+#endif COFF
+#ifdef AOUT
+       if (sym->n_type == (N_EXT | N_UNDF))
+#endif AOUT
+	 /* external bss so not included in size of bss for file */
+	 {  int val = SYM_VALUE(*sym);
+	    struct node nod;
+	    nod.string = SYM_NAME(sym);
+	    if (val && c_table.ptable &&
+		!bsearch((char *)(&nod), (char*)(c_table.ptable),
+			 c_table.length, sizeof(struct node),
+			 node_compare)) {
+	      SYM_VALUE(*sym) = result;
+	      result += val;
+	    }
+	  }
+     sym += NUM_AUX(sym); 
+   }
+   return (result - start);
+ }
+#endif ELF
+
+/* go through the symbol table:
+   1. resolve references to external undefined symbols
+   2. change addresses of other symbols to reflect the current cf_start */
+
+#ifdef ELF
+link_symbols(unsigned int length, char *string_table,
+	     char *start_address)
+{  SYMENT *end, *sym;
+   unsigned int typ;
+   end = symbol_table + length;
+
+   for (sym = symbol_table; sym < end; sym++) {
+     switch (ELF32_ST_BIND(sym->st_info)) {
+     case STB_LOCAL:
+       if (sym->st_shndx == SHN_ABS) break;
+       if (section_headers[sym->st_shndx].sh_flags & SHF_ALLOC)
+	 sym->st_value += (int)(start_address + section_start[sym->st_shndx]);
+       break;
+     case STB_GLOBAL:
+       if (sym->st_shndx == SHN_UNDEF || sym->st_shndx == SHN_COMMON)
+	 set_symbol_address(sym, string_table + sym->st_name);
+       else if (STT_FUNC == ELF32_ST_TYPE(sym->st_info))
+          sym->st_value += (int)(start_address + section_start[sym->st_shndx]);
+       else
+	 printf("[unknown global sym %s]", string_table + sym->st_name);
+       break;
+     default:
+       printf("[unknown bind type %s]", ELF32_ST_BIND(sym->st_info));
+     }
+   }
+ }
+
+#else				/* !ELF */
+
+link_symbols(unsigned int length, char *string_table,
+	     unsigned long *start_address)
+{  SYMENT *end, *sym;
+   unsigned int typ;
+#  ifdef SYMNMLEN
+   char tem[SYMNMLEN +1];
+   tem[SYMNMLEN] = 0;
+#  endif
+   end = symbol_table + length;
+
+   for (sym = symbol_table; sym < end; sym++) {
+
+     char *p;
+
+     p = SYM_NAME(sym);
+     typ = SYM_TYPE(sym);
+
+# ifdef AOUT
+#  ifdef N_STAB
+     if (N_STAB & sym->n_type) continue; /* skip: It is for dbx only */
+#  endif N_STAB
+     typ = N_SECTION(sym);
+# endif AOUT
+
+     switch (typ) {
+
+# ifdef COFF
+     case C_STAT:
+#  ifdef apollo
+       SYM_VALUE(*sym) = (int)start_address - section_padding[sym->n_scnum -1];
+#  else
+       SYM_VALUE(*sym) = (int)start_address;
+#  endif apollo
+       break;
+# endif COFF
+
+# ifdef AOUT
+     case N_ABS: case N_TEXT: case N_DATA: case N_BSS:
+       SYM_VALUE(*sym) = (int)start_address;
+       break;
+# endif AOUT
+
+     case C_EXT:
+       if (EXT_UNDEF(sym))
+	 /* search the symbol_table for the address of symbol and
+	    store it as value of sym */
+	 set_symbol_address(sym, SYM_NAME(sym));
+       else {
+# ifdef ECOFF
+	 if (EXT_EXPORTED(sym))
+	     SYM_VALUE(*sym) += (int)start_address;
+# else
+	 SYM_VALUE(*sym) = (int)start_address;
+# endif ECOFF
+	 /*  we should add the symbol name, so it would be accessible by
+	     future loads (init_code should be an exception though. Beppe)
+	 printf("\nEXT_UNDEF %s", SYM_NAME(sym)); fflush(stdout);
+	 */
+       }
+       break;
+     default:
+       break;
+     }
+#    ifdef NUM_AUX
+     sym += NUM_AUX(sym);	/* skip auxiliary entries */
+#    endif
+   }
+ }
+#endif /* !ELF */
+
+set_symbol_address(SYMENT *sym, char *string)
+{  struct node *answ, nod;
+   nod.string = string;
+   answ = (struct node *)bsearch((VOID *)(&nod), (VOID *)c_table.ptable,
+				 c_table.length, sizeof(struct node),
+				 node_compare);
+   if (answ)
+#ifdef ECOFF
+     SYM_VALUE(*sym) = answ->address;
+#elif  defined(COFF)
+     SYM_VALUE(*sym) = answ->address - SYM_VALUE(*sym);
+#else /* AOUT or ELF */
+     SYM_VALUE(*sym) = answ->address;
+#endif
+   else
+     fprintf(stderr, "\n;;; Undefined symbol %s\n", string); fflush(stderr);
+}
+
+/* ----------------------------------------------------------------------
+ *	Relocation
+ * ----------------------------------------------------------------------
+ */
+
+/*
+  Indications on how to perform relocation is available
+  in the tables reloc_howto_type in gnu/binutils/bfd (eg. coff-mips.c).
+  Here is a sample entry:
+
+  HOWTO (MIPS_R_REFHALF,	-- type
+	 0,			-- rightshift
+	 1,			-- size (0 = byte, 1 = short, 2 = long)
+	 16,			-- bitsize
+	 false,			-- pc_relative
+	 0,			-- bitpos
+	 complain_overflow_bitfield, -- complain_on_overflow
+	 mips_generic_reloc,	-- special_function
+	 "REFHALF",		-- name
+	 true,			-- partial_inplace
+	 0xffff,		-- src_mask
+	 0xffff,		-- dst_mask
+	 false),		-- pcrel_offset
+*/
+
+#ifdef COFF
+relocate(char *where, char *start_address)
+{  unsigned int new_value;
+
+# ifdef __mips
+   static unsigned long *refhi_where;	/* store loc for  */
+
+   if (!reloc_info.r_extern)
+     new_value = (int)start_address;
+   else
+# endif __mips
+     new_value = SYM_VALUE(symbol_table[reloc_info.r_symndx]);
+
+   switch (reloc_info.r_type) {
+
+       case R_ABS: return;
+
+# ifndef __mips
+
+    case R_DIR32:
+      { char tem[SYMNMLEN +1];
+#  ifdef apollo
+	if (strcmp(SYM_NAME(&symbol_table[reloc_info.r_symndx]), ".aptv") == 0)
+	  *(unsigned int *)where =
+	   *(unsigned int *)(*(unsigned int *)where
+				+ new_value
+				+ 2);
+	else
+#  endif apollo
+	  *(unsigned int *)where += new_value;
+      }
+      break;
+#  ifdef R_DIR32S
+    case R_DIR32S: {
+      char *p;
+      unsigned int value;
+ 
+      p = (char *)(&value);
+      p[3] = where[0];
+      p[2] = where[1];
+      p[1] = where[2];
+      p[0] = where[3];
+      value += new_value;
+      where[0] = p[3];
+      where[1] = p[2];
+      where[2] = p[1];
+      where[3] = p[0];
+      break;
+    }
+#  endif R_DIR32S
+    case R_RELBYTE:
+      *(unsigned char *)where += new_value;
+      break;
+
+    case R_RELWORD:
+      *(unsigned short *)where += new_value;
+      break;
+
+    case R_RELLONG:
+      *(unsigned int *)where += new_value;
+      break;
+
+    case R_PCRBYTE:
+      *(unsigned char *)where += new_value - (unsigned int)start_address;
+      break;
+
+    case R_PCRWORD:
+      *(unsigned short *)where += new_value - (unsigned int)start_address;
+      break;
+
+    case R_PCRLONG:
+      *(unsigned int *)where += new_value - (unsigned int)start_address;
+      break;
+
+# else /* __mips */
+
+    case R_REFHALF:
+      *(unsigned short *)where += new_value;
+      break;
+    case R_REFWORD:
+      *(unsigned int *)where += new_value;
+      break;
+    case R_JMPADDR:		/* 26-bit jump reference */
+      *(long *)where = (*(long *)where & ~0x3ffffff) |
+	((int)(new_value >> 2) + (*(long *)where & 0x3ffffff)) & 0x3ffffff;
+      break;
+    case R_REFHI:
+      /* need to add 1 if R_REFLO is negative */
+      refhi_where = (unsigned long *)where;
+      *(long *)where += new_value >> 16;
+      break;
+    case R_REFLO:
+	 { unsigned long val;
+	   unsigned long insn = *(long *)where;
+
+	   /* Lower 16 bits of REFHI and REFLO are the offset to be added.
+	      But the low order 16 bits of REFLO are treated as a signed value.
+	      Therefore, a negative value in the low order bits requires an
+	      adjustment in the high order bits.
+	      */
+	   val = ((*refhi_where & 0xffff) << 16) + (insn & 0xffff);
+	   if (insn & 0x8000)
+	     val -= 0x10000;	/* recover true value */
+	   val += (new_value & 0xffff);
+	   *refhi_where = (*refhi_where & ~0xffff) | (val >> 16);
+	   if (val & 0x8000)
+	     *refhi_where += 1;	/* carry into high order bits */
+	   *(long *)where = (insn & ~0xffff) | (val & 0xffff);
+	 break;
+	 }
+
+/*    case R_GPREL:		/* global pointer relative */
+
+# endif __mips
+
+    default:
+      FEerror(";;; ~d: unsupported relocation type.", 1,
+	      MAKE_FIXNUM(reloc_info.r_type));
+    }
+}
+#endif COFF
+
+#ifdef AOUT
+# ifdef sparc
+
+relocate(char *where, char *start_address)
+{ unsigned int new_value;
+  if (reloc_info.r_extern)
+    new_value = SYM_VALUE(symbol_table[reloc_info.r_index]) + reloc_info.r_addend;
+  else
+    switch (reloc_info.r_index) {
+    case N_DATA: case N_BSS: case N_TEXT:
+      new_value = (int)start_address + reloc_info.r_addend;
+      break;
+    default:
+      FEerror(";;; Relocation fault: index ~x.", 1,
+	      MAKE_FIXNUM(reloc_info.r_index));
+    };
+
+  switch (reloc_info.r_type) {
+  case RELOC_8:
+    *(char *)where = new_value;
+    break;
+  case RELOC_16:
+    *(short *)where = new_value;
+    break;
+  case RELOC_32:
+    *(long *)where = new_value;
+    break;
+  case RELOC_DISP8:
+    *(char *)where = new_value - (int)start_address;
+    break;
+  case RELOC_DISP16:
+    *(short *)where = new_value - (int)start_address;
+    break;
+  case RELOC_DISP32:
+    *(long *)where = new_value - (int)start_address;
+    break;
+  case RELOC_WDISP30:
+    /* Note: where == start_address - reloc_info.addend */
+    *(long *)where |= ((new_value - (int) start_address) >> 2);
+    break;
+  case RELOC_HI22:
+    *(long *)where |= new_value >> 10;
+    break;
+  case RELOC_LO10:
+    *(long *)where |= new_value & 0x3ff;
+    break;
+  default:
+    FEerror(";;; ~d: unsupported relocation type.", 1,
+	    MAKE_FIXNUM(reloc_info.r_type));
+  }
+}
+
+# else /* not sparc */
+
+relocate(char *where, char *start_address)
+{ unsigned int new_value;
+#  ifdef hp9000s300
+  switch(reloc_info.r_segment) {
+  case RNOOP: return;
+  case REXT: 
+    new_value = SYM_VALUE(symbol_table[reloc_info.r_symbolnum]);
+    break;
+  case RDATA: 
+  case RBSS: 
+  case RTEXT: new_value = (int)start_address; break;
+  default:
+    printf(
+    "\nRel_Info {r_segment: %x, r_symbolnum: %x, r_address: %d} -- Ignored", 
+	   reloc_info.r_segment,
+	   reloc_info.r_symbolnum,
+	   reloc_info.r_address); 
+    fflush(stdout);
+    return;
+  };
+#  else
+  if (reloc_info.r_extern) {
+    if (reloc_info.r_pcrel)
+	new_value = SYM_VALUE(symbol_table[reloc_info.r_symbolnum])
+	  - (int)start_address;
+    else
+      new_value = SYM_VALUE(symbol_table[reloc_info.r_symbolnum]);
+  }
+  else {
+    switch (reloc_info.r_symbolnum) {
+    case N_TEXT:
+      /* when it is the result of a previous ld -r */
+      if (reloc_info.r_pcrel) {
+	new_value = 0;
+	break;
+      }
+    case N_DATA: case N_BSS:
+      new_value = (int)start_address;
+      break;
+    default:
+      FEerror(";;; Relocation fault: index ~x.", 1,
+	      MAKE_FIXNUM(reloc_info.r_symbolnum));
+    }
+  };
+#  endif hp9000s300
+
+#  ifdef vax
+  if (!reloc_info.r_pcrel || reloc_info.r_extern)
+#  endif vax
+    switch (reloc_info.r_length) {
+    case 0:
+      *(char *)where = new_value + *(char *) where;
+      break;
+    case 1:
+      *(short *)where = new_value + *(short *) where;
+      break;
+    case 2:
+      *(long *)where = new_value + *(long *) where;
+      break;
+    }
+}
+# endif sparc
+#endif AOUT
+
+#ifdef ELF
+#define MASK(n) (~(~0 << (n)))
+#define STORE_VAL(where, mask, val) \
+    *(unsigned int *)where = \
+     ((val & mask) | ((*(unsigned int *)where) & ~mask))
+
+relocate(char *where, char *start_address)
+{    
+    unsigned int val;
+    val = symbol_table[ELF32_R_SYM(reloc_info.r_info)].st_value
+      + reloc_info.r_addend;
+# ifdef __sparc__
+    switch (ELF32_R_TYPE(reloc_info.r_info)) {
+
+    case R_SPARC_WDISP30:
+      /* v-disp30*/
+      val = (val - (unsigned int)where) >> 2;
+      STORE_VAL(where, MASK(30), val);
+      break;
+	
+    case R_SPARC_HI22:
+      /* t-sim22 */
+      val = val >> 10;
+      STORE_VAL(where, MASK(22), val);
+      break;
+
+    case R_SPARC_32:
+      /*    */
+      STORE_VAL(where, ~0, val);
+      break;
+      
+    case R_SPARC_LO10:
+	/* T-simm13 */
+      val = val & MASK(10);
+      *(short *)(where +2) |= val;
+      break;
+
+    default:
+      printf("(non supported relocation type %d)\n",
+	     ELF32_R_TYPE(reloc_info.r_info));
+    }
+# elif defined(__i386__)
+    switch (ELF32_R_TYPE(reloc_info.r_info)) {
+
+    case R_386_32:
+      *(unsigned int *)where += val;
+      break;
+
+    case R_386_PC32:
+      *(unsigned int *)where += val - (unsigned int)where;
+      break;
+
+    default:
+      printf("(non supported relocation type %d)\n",
+	     ELF32_R_TYPE(reloc_info.r_info));
+    }
+
+# elif defined(__mips)
+    {
+      static unsigned long *refhi_where;	/* store loc for  */
+
+      switch (ELF32_R_TYPE(reloc_info.r_info)) {
+
+      case R_MIPS_16:
+	*(unsigned short *)where = val;
+	break;
+      case R_MIPS_32:
+	*(unsigned int *)where = val;
+	break;
+      case R_MIPS_26:		/* 26-bit jump reference */
+	*(long *)where = (*(long *)where & ~0x3ffffff) |
+	  ((int)(val >> 2) + (*(long *)where & 0x3ffffff)) & 0x3ffffff;
+	break;
+      case R_MIPS_HI16:
+	/* need to add 1 if R_REFLO is negative */
+	refhi_where = (unsigned long *)where;
+	*(long *)where += val >> 16;
+	break;
+      case R_MIPS_LO16:
+	{ unsigned long temp;
+	  unsigned long insn = *(long *)where;
+
+	  /* Lower 16 bits of REFHI and REFLO are the offset to be added.
+	     But the low order 16 bits of REFLO are treated as a signed value.
+	     Therefore, a negative value in the low order bits requires an
+	     adjustment in the high order bits.
+	     */
+	  temp = ((*refhi_where & 0xffff) << 16) + (insn & 0xffff);
+	  if (insn & 0x8000)
+	    temp -= 0x10000;	/* recover true value */
+	  temp += (val & 0xffff);
+	  *refhi_where = (*refhi_where & ~0xffff) | (temp >> 16);
+	  if (temp & 0x8000)
+	    *refhi_where += 1;	/* carry into high order bits */
+	  *(long *)where = (insn & ~0xffff) | (temp & 0xffff);
+	  break;
+	}
+      default:
+	printf("(non supported relocation type %d)\n",
+	       ELF32_R_TYPE(reloc_info.r_info));
+      }
+    }
+/*    case R_GPREL:		/* global pointer relative */
+
+# endif __mips
+
+  }
+#endif ELF
+
+/*
+ * Use the add_symbol to add a c symbol, which you want to refer
+ * to in subsequent loads.  The address used in subsequent loads,
+ * will be the load address of the current symbol.
+ * Such a symbol may only be added once, since subsequent references
+ * will try to link to the old address.
+ */
+
+/* To do: Addition of one symbol to the ptable is very slow, because we 
+   sort each time! */
+
+add_symbol(char *string, int address)
+{   struct node nod;
+    if (!(c_table.ptable))
+      return;
+    if ((c_table.alloc_length) - (c_table.length) > 1) { 
+    BEGIN:
+      nod.string=string;
+      if (bsearch((char *)(&nod), (char *)c_table.ptable, c_table.length,
+		  sizeof(struct node), node_compare))
+	FEerror(";;; The string ~a is already in the ptable", 1,
+		make_simple_string(string));
+      (*c_table.ptable + c_table.length)->string = string;
+      (*c_table.ptable + c_table.length)->address = address;
+      c_table.length = c_table.length + 1;
+      qsort((char*)c_table.ptable, (int)c_table.length, sizeof(struct node),
+	    node_compare);
+    }
+    else {
+      /* grow the ptable */
+      TABL *new, *old_pt;
+      c_table.alloc_length = c_table.length + 1 + PTABLE_EXTRA;
+      new = (TABL *)malloc(sizeof(struct node) * c_table.alloc_length);
+      old_pt = c_table.ptable;
+      /* copy it */
+      {  register int i;
+	 for (i = 0; i < c_table.length; i++) {
+	   (*new)[i].string = (*old_pt)[i].string;
+	   (*new)[i].address = (*old_pt)[i].address;
+	 }
+       }
+      c_table.ptable = new; 
+      free((char *)old_pt);
+      goto BEGIN;
+    }
+  }
+
+#define SYM_ADDRESS(table,i) ((*(table).ptable))[i].address
+#define SYM_STRING(table,i) ((*(table).ptable))[i].string
+
+int
+read_special_symbols(char *symfile)
+{  FILE *symin;
+   char *symbols;
+   int i = 0;
+   struct lsymbol_table tab;
+   char buf[BUFSIZ];
+
+   if (!(symin = fopen(symfile, OPEN_R)))
+     return(-1);
+   setbuf(symin, buf);
+   if (!fread((char *)&tab, sizeof(tab), 1, symin))
+     return(-1);
+   symbols = malloc(tab.tot_leng); /* not temp_malloc */
+   c_table.alloc_length = PTABLE_EXTRA + tab.n_symbols;
+   c_table.ptable = (TABL *)malloc(sizeof(struct node) * c_table.alloc_length);
+   if (!c_table.ptable)
+     return(-1);
+   c_table.length = tab.n_symbols;
+   while (i < tab.n_symbols) {
+     int jj;
+     fread((char *)&jj, sizeof(int), 1, symin);
+     SYM_ADDRESS(c_table, i) = jj;
+     SYM_STRING(c_table, i) = symbols;
+ 
+     while (*(symbols++) = getc(symin)) 
+       ;
+     i++;
+   }
+   return 0;
+ }
+
+#ifdef hpux
+int
+count_symbols(FILHDR *phdr, FILE *fp)
+{  int nsyms,i;
+   fseek(fp, (int)(LESYM_OFFSET(*phdr)), 0);
+   for (i = phdr->a_lesyms, nsyms = 0; i > 0; nsyms++) {
+     SYMENT tmp;
+     fread((char *)&tmp, SYMESZ, 1, fp); i -= SYMESZ;
+     fseek(fp, (int)tmp.n_length, 1); i -= tmp.n_length;
+   }
+   return (nsyms);
+ }
+#endif hpux
+
+#if defined(unix) && 0
+/*
+ *----------------------------------------------------------------------
+ *
+ * faslink --
+ *     dynamically load a file into memory, linking it with additional
+ *     libraries.
+ *
+ * Results:
+ *     none.
+ *----------------------------------------------------------------------
+ */
+
+static
+filecpy(FILE *to, FILE *from, register int n)
+{
+  char buffer[BUFSIZ];
+
+  while (n > BUFSIZ) {
+    fread(buffer, BUFSIZ, 1, from);
+    fwrite(buffer, BUFSIZ, 1, to);
+    n -= BUFSIZ;
+  }
+  if (n > 0) {
+    fread(buffer, 1, n, from);
+    fwrite(buffer, 1, n, to);
+  }
+}
+
+# ifdef ELF
+int
+faslink(cl_object faslfile, cl_object ldargstring) {}
+# else
+
+int
+faslink(cl_object faslfile, cl_object ldargstring)
+{
+#ifdef AOUT
+	FILHDR fileheader, faslheader;
+#define	textsize	fileheader.a_text
+#define	datasize	fileheader.a_data
+#define	bsssize		fileheader.a_bss
+#define	textstart	sizeof(fileheader)
+#endif AOUT
+#ifdef COFF
+	FILHDR fileheader, faslheader;
+	SCNHDR sectionheader;
+	int textsize, datasize, bsssize;
+	int textstart;
+#endif COFF
+
+	cl_object temp_cfun, faslstream;
+	struct codeblock Cblock;
+	FILE *fp, *fp_in;
+	char *faslfilename;
+	char *ldargstr;
+	char ldoutfilename[32], binfilename[32];
+	char command[MAXPATHLEN * 2];
+	char buf[BUFSIZ];
+	int binlength;
+#ifdef IBMRT
+	struct nlist nl[2];
+#endif IBMRT
+	int pid = getpid();
+
+	ldargstr = coerce_to_filename(ldargstring);
+	faslfilename = coerce_to_filename(faslfile);
+
+	sprintf(ldoutfilename, "/tmp/ldtemp%d", pid);
+	sprintf(binfilename, "/tmp/bintemp%d", pid);
+
+	faslstream = (cl_object)open_fasl_data(faslfile);
+	fp_in = faslstream->sm.sm_fp;
+	binlength = ftell(fp_in);
+	rewind(fp_in);
+	fp = fopen(binfilename, OPEN_W);
+	setbuf(fp, buf);
+	filecpy(fp, fp_in, binlength);
+	fclose(fp);
+	/* dont close fp_in: it is used later through faslstream */
+
+	printf(";;; Linking %s\n", faslfilename);
+	/* Do this once to determine text size */
+	sprintf(command,
+		"ld -d -N -x -A %s %s %s -o %s",
+		ecl_self, binfilename, ldargstr, ldoutfilename);
+
+	if (system(command) != 0) {
+	  unlink(ldoutfilename);
+	  FEerror(";;; The linkage editor failed.", 0);
+	}
+
+	fp = fopen(ldoutfilename, OPEN_R);
+	setbuf(fp, buf);
+	fread(&fileheader, sizeof(fileheader), 1, fp);
+#ifdef COFF
+	fread(&sectionheader, sizeof(sectionheader), 1, fp);
+	textsize = sectionheader.s_size;
+	textstart = sectionheader.s_scnptr;
+	fread(&sectionheader, sizeof(sectionheader), 1, fp);
+	datasize = sectionheader.s_size;
+	fread(&sectionheader, sizeof(sectionheader), 1, fp);
+	if (strcmp(sectionheader.s_name, ".bss") == 0)
+		bsssize = sectionheader.s_size;
+	else
+		bsssize = 0;
+#endif COFF
+	temp_cfun = alloc_object(t_cfun);
+	temp_cfun->cf.cf_name = OBJNULL;
+	temp_cfun->cf.cf_block = &Cblock;
+	Cblock.cd_size = textsize + datasize + bsssize;
+	Cblock.cd_start = alloc(Cblock.cd_size);
+	Cblock.cd_data = OBJNULL;
+	fclose(fp);
+
+	/* Link again specifying proper text segment location */
+	sprintf(command,
+		"ld -d -N -x -A %s -T %x %s %s -o %s",
+		ecl_self, Cblock.cd_start, binfilename, ldargstr,
+		ldoutfilename);
+
+	if (system(command) != 0) {
+	        unlink(ldoutfilename);
+		FEerror(";;; The linkage editor failed.", 0);
+	      }
+
+	printf(";;; Loading %s\n", faslfilename);
+
+	fp = fopen(ldoutfilename, OPEN_R);
+	setbuf(fp, buf);
+	if (fseek(fp, textstart, 0) < 0)
+		error("file seek error");
+	fread(Cblock.cd_start, textsize + datasize, 1, fp);
+	fclose(fp);
+
+#ifdef IBMRT
+	nl[0].n_un.n_name = "_init_code";
+	nl[1].n_un.n_name = "";
+	nlist(ldoutfilename, nl);
+#endif IBMRT
+
+	unlink(binfilename);
+	unlink(ldoutfilename);
+
+#ifdef IBMRT
+	(*(int (*)())SYM_VALUE(nl[0]))
+#else
+	(*(int (*)())(Cblock.cd_start))
+#endif IBMRT
+		(Cblock.cd_size, faslstream);
+	close_stream(faslstream, TRUE);
+
+	return(0);
+}
+# endif ELF
+#endif unix
diff --git a/src/crs/dldNeXT.c b/src/crs/dldNeXT.c
new file mode 100644
index 000000000..3fac9b5ff
--- /dev/null
+++ b/src/crs/dldNeXT.c
@@ -0,0 +1,230 @@
+/*  dldNeXT.c -- Dynamic loader for NeXT				*/
+/*
+    Copyright (c) 1994, Giuseppe Attardi
+
+    This file is part of ECoLisp, an Embeddable Common Lisp.
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#include "ecls.h"
+#include <rld.h>
+#include <fcntl.h>
+
+#ifndef THREADS
+static int code_size;
+static char *code_start;
+#endif
+
+static unsigned long
+alloc_code_block(unsigned long size, unsigned long headers_size) {
+  code_size = size;
+  code_start = (char *)alloc_contblock(size);
+  return (unsigned long)code_start;
+}
+
+static void
+load_mach_o(char               *filename)
+{
+    FILE               *fp;
+    struct mach_header  header;
+    char               *hdrbuf;
+    struct load_command *load_command;
+    struct segment_command *segment_command;
+    struct section     *section;
+    int                 len, cmd, seg;
+
+    if ((fp = fopen(filename, "r")) == NULL)
+	FEerror("Can't read Mach-O object file", 0);
+    len = fread((char *)&header, sizeof(struct mach_header), 1, fp);
+    if (len == 1 && header.magic == MH_MAGIC) {
+	hdrbuf = (char *)malloc(header.sizeofcmds);
+	len = fread(hdrbuf, header.sizeofcmds, 1, fp);
+	if (len != 1)
+	    FEerror("failure reading Mach-O load commands", 0);
+	load_command = (struct load_command *) hdrbuf;
+	for (cmd = 0; cmd < header.ncmds; ++cmd) {
+	    if (load_command->cmd == LC_SEGMENT) {
+		segment_command = (struct segment_command *) load_command;
+		section = (struct section *) ((char *)(segment_command + 1));
+		for (seg = 0; seg < segment_command->nsects; ++seg, ++section) {
+		    if (section->size != 0 && section->offset != 0) {
+#ifdef DEBUG
+			fprintf(stderr, "section: %s, addr: 0x%08x, size: %d\n",
+			   section->sectname, section->addr, section->size);
+			fflush(stderr);
+#endif
+			fseek(fp, section->offset, 0);
+			fread((char *)section->addr, section->size, 1, fp);
+		    }
+		}
+	    }
+	    load_command = (struct load_command *)
+	      ((char *)load_command + load_command->cmdsize);
+	}
+	free(hdrbuf);
+    }
+    (void)fclose(fp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * dld --
+ *     dynamically load a file into memory.
+ *
+ * Results:
+ *	none.
+ *
+ * Side effects:
+ *	codeblock: containing address where the code has been loaded, and
+ *		   its size
+ *
+ *----------------------------------------------------------------------
+ */
+dld(char *faslfile, struct codeblock *Cblock)
+{
+  struct mach_header *hdr;
+  char *files[2] = {faslfile, 0};
+  char tempfile[40];
+
+  rld_address_func(alloc_code_block);
+  sprintf(tempfile, "/tmp/fasltemp%d", getpid());
+  if (!rld_load(NULL, &hdr, files, tempfile))
+    FEerror(";;; rld_load() failed", 0);
+  load_mach_o(tempfile);
+  unlink(tempfile);
+  Cblock->cd_size = code_size;
+  Cblock->cd_start = code_start;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * faslink --
+ *     dynamically load a file into memory, linking it with additional
+ *     libraries.
+ *
+ * Results:
+ *     none.
+ *----------------------------------------------------------------------
+ */
+
+static char *library_search_path[] =
+{"/lib", "/usr/lib", "/usr/local/lib", NULL};
+
+#define strdup(string)	strcpy((char *)malloc(strlen(string)+1),(string))
+
+static char*
+expand_library_filename(char *filename)
+{
+    int                 fd;
+    char              **dir;
+    char                libname[256];
+    char                fullname[256];
+
+    if (filename[0] == '-' && filename[1] == 'l') {
+	filename +=2;
+	strcpy(libname, "lib");
+	strcat(libname, filename);
+	strcat(libname, ".a");
+	for (dir = library_search_path; *dir; dir++) {
+	    strcpy(fullname, *dir);
+	    strcat(fullname, "/");
+	    strcat(fullname, libname);
+	    if ((fd = open(fullname, O_RDONLY, 0)) > 0) {
+		close(fd);
+		return (strdup(fullname));
+	    }
+	}
+	return (strdup(libname));
+    }
+    return (strdup(filename));
+}
+
+static char**
+make_ofile_list(char *faslfile, char *argstr)
+{
+  char                filename[256];
+  char               *dst;
+  int                 i;
+  char              **ofile_list;
+
+  ofile_list = (char **)calloc(1, sizeof(char *));
+  ofile_list[0] = strdup(faslfile);
+  i = 1;
+  if (argstr != NULL) {
+    for (;; i++) {
+      while ((*argstr == ' ') && (*argstr != '\0'))
+	argstr++;
+      if (*argstr == '\0')
+	break;
+      dst = filename;
+      while ((*argstr != ' ') && (*argstr != '\0'))
+	*dst++ = *argstr++;
+      *dst = '\0';
+      ofile_list = (char **)realloc((void *)ofile_list,
+				    (i + 1) * sizeof(char *));
+      ofile_list[i] = expand_library_filename(filename);
+    }
+  }
+  ofile_list = (char **)realloc((void *)ofile_list, (i + 1) * sizeof(char *));
+  ofile_list[i] = NULL;
+  return (ofile_list);
+}
+
+static void
+free_ofile_list(char **ofile_list)
+{
+    int i;
+
+    for (i = 1;; i++) {
+	if (ofile_list[i] == NULL)
+	    break;
+	(void)free(ofile_list[i]);
+    }
+    (void)free(ofile_list);
+}
+
+int
+faslink(object faslfile, object ldargstring)
+{
+  object temp_cfun, dataStream;
+  struct codeblock Cblock;
+  char *faslfilename;
+  char *ldargstr;
+  char **ofiles;
+  struct mach_header *hdr;
+
+  ldargstr = coerce_to_filename(ldargstring);
+  faslfilename = coerce_to_filename(faslfile);
+
+  printf(";;; Linking %s\n", faslfilename);
+  rld_address_func(alloc_code_block);
+  ofiles = make_ofile_list(faslfilename, ldargstr);
+  if (!rld_load(NULL, &hdr, ofiles, NULL)) {
+    free_ofile_list(ofiles);
+    FEerror(";;; rld_load() failed", 0);
+  }
+  free_ofile_list(ofiles);
+  /* preserve Cblock from GC */
+  temp_cfun = alloc_object(t_cfun);
+  temp_cfun->cf.cf_name = OBJNULL;
+  temp_cfun->cf.cf_block = &Cblock;
+  Cblock.cd_size = code_size;
+  Cblock.cd_start = code_start;
+  Cblock.cd_data = OBJNULL;
+
+  dataStream = (object)open_fasl_data(faslfile);
+
+  asm("trap #2");		/* clear cache */
+  (*(int (*)())(Cblock.cd_start))(Cblock.cd_size, dataStream);
+  close_stream(dataStream, TRUE);
+
+  return(0);
+}
diff --git a/src/crs/objff.h b/src/crs/objff.h
new file mode 100644
index 000000000..9a2353255
--- /dev/null
+++ b/src/crs/objff.h
@@ -0,0 +1,248 @@
+/*
+    Copyright (c) 1990, Giuseppe Attardi and William F. Schelter.
+
+    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.
+
+    See file '../Copyright' for full details.
+*/
+
+/* format of a rsyms output file:
+
+   struct lsymbol_table	(gives number of symbols, and sum of length of strings)
+   addr, char[], addr, char[], ...
+   This can be read since the addr is sizeof(int) and the char[] is null
+   terminated, immediately followed by and addr...
+   There are tab.n_symbols pairs occurring.
+
+*/
+
+struct lsymbol_table {
+  unsigned int n_symbols;
+  unsigned int tot_leng;
+};
+
+#ifdef COFF
+
+# ifdef MSDOS
+#  include <coff.h>
+# else
+#  include <filehdr.h>
+#  include <aouthdr.h>
+#  include <scnhdr.h>
+#  include <syms.h>
+#  include <reloc.h>
+# endif MSDOS
+
+# ifndef FILHDR
+#  define FILHDR	struct header
+# endif FILHDR
+
+# undef N_BADMAG	/* checks AOUTHDR instead of FILHDR */
+
+# ifdef __i386__
+#  define N_BADMAG(x)	I386BADMAG(x)
+# elif defined(hpux)
+#  define N_BADMAG(x)	!(ISCOFF(x.a_magic))
+# else
+#  define N_BADMAG(x)	!(ISCOFF(x.f_magic))
+# endif
+
+# ifdef ECOFF
+#  undef N_TXTOFF
+# endif
+
+# define N_TXTOFF(p)	section[0].s_scnptr
+# define N_SYMOFF(x)	(x).f_symptr
+# define NSYMS(x)	(x).f_nsyms
+
+# ifdef apollo
+#  define EXT_and_TEXT_BSS_DAT(p) \
+ ((1 <= (p)->n_scnum) && ((p)->n_scnum <= 5) && (p)->n_sclass == C_EXT)
+# elif defined(ECOFF)
+#  define EXT_and_TEXT_BSS_DAT(p) 1
+# else
+#  define EXT_and_TEXT_BSS_DAT(p) \
+ ((1 <= (p)->n_scnum) && ((p)->n_scnum <= 3) && (p)->n_sclass == C_EXT)
+# endif apollo
+
+
+# ifdef ECOFF
+#  define SYMENT EXTR
+#  define SYMESZ sizeof(SYMENT)
+#  define SYM_VALUE(sym)	(sym).asym.value
+#  define SYM_TYPE(psym)	(psym)->asym.st
+#  define SYM_NAME(psym)	&string_table[(psym)->asym.iss]
+
+/* 
+  We must distinguish the following kind of symbols:
+
+  External (ouside function bodies)
+  	Defined (in this file)
+		Static (declared static)
+		Exported (non declared static)
+	Undefined
+
+  Unfortunately AS and GAS produce different symbol tables, so we find
+  a common denominator as follows:
+
+  External:			stNil || stGlobal || stProc || stStaticProc
+	Undefined:		stGblobal || (stProc && scUndefined)
+  	Defined:		!Undefined
+		Static:		stNil || stStatic || stStaticProc
+		Exported:	!Static
+*/
+
+#  define C_STAT	stNil: case stStatic: case stStaticProc
+#  define C_EXT	stGlobal: case stProc
+#  define EXT_UNDEF(p)   (SYM_TYPE(p) == stGlobal || \
+			(SYM_TYPE(p) == stProc && (p)->asym.sc == scUndefined))
+#  define EXT_EXPORTED(p) (SYM_TYPE(p) == stProc)
+#  define NUM_AUX(p)	0
+
+# else				/* !ECOFF */
+
+#  define SYM_VALUE(sym)	(sym).n_value
+#  define SYM_TYPE(psym)	(psym)->n_sclass
+#  define SYM_NAME(psym) \
+  (((psym)->n_zeroes == 0) ? \
+	    &string_table[(psym)->n_offset] : \
+               ((psym)->n_name[SYMNMLEN -1] ? \
+		(strncpy(tem, (psym)->n_name, SYMNMLEN), (char *)tem) : \
+		(psym)->n_name))
+
+#  define EXT_UNDEF(p)	(((p)->n_scnum == 0) && (p)->n_sclass == C_EXT)
+
+#  define NUM_AUX(p)	(p)->n_numaux
+
+# endif ECOFF
+
+# ifdef __GO32__
+#  define n_name	e.e_name
+#  define n_numaux	e_numaux
+#  define n_offset	e.e.e_offset
+#  define n_sclass	e_sclass
+#  define n_scnum	e_scnum
+#  define n_type	e_type
+#  define n_value	e_value
+#  define n_zeroes	e.e.e_zeroes
+#  define SYMNMLEN	E_SYMNMLEN
+
+#  define R_ABS		0
+#  define R_RELBYTE	017
+#  define R_RELWORD	020
+#  define R_RELLONG	021
+#  define R_PCRBYTE	022
+#  define R_PCRWORD	023
+#  define R_PCRLONG	024
+
+#  define R_DIR32	06
+
+# endif __GO32__
+
+#endif COFF
+
+/************************************************************************/
+
+#ifdef ELF
+# define ELF_TARGET_ALL
+# include <elf.h>
+# define FILHDR	Elf32_Ehdr
+# define PRGHDR	Elf32_Phdr
+# define SCNHDR	Elf32_Shdr
+# define SYMENT	Elf32_Sym
+#ifdef __NetBSD__
+# define RELOC	Elf32_RelA
+#else
+# define RELOC  Elf32_Rela
+#endif
+# define N_BADMAG(h)	(ELFMAG0 != h.e_ident[0])
+# ifdef __mips
+# define EXT_and_TEXT_BSS_DAT(p) ((ELF32_ST_BIND(p->st_info) == STB_GLOBAL) \
+				 && (p->st_shndx == text_index \
+				     || p->st_shndx == data_index\
+				     || p->st_shndx == bss_index \
+				     || p->st_shndx == 0xff00 \
+				     || p->st_shndx == STN_UNDEF))
+# else
+# define EXT_and_TEXT_BSS_DAT(p) ((ELF32_ST_BIND(p->st_info) == STB_GLOBAL \
+				   || ELF32_ST_BIND(p->st_info) == STB_WEAK) \
+				  && (p->st_shndx == text_index \
+				      || p->st_shndx == data_index\
+				      || p->st_shndx == bss_index \
+				      || p->st_shndx == SHN_UNDEF))
+# endif
+# define SYM_NAME(p) string_table+(p->st_name)
+# define SYM_VALUE(p) (p).st_value
+#endif ELF
+
+
+/************************************************************************/
+#ifdef AOUT
+
+# include AOUT
+
+# define FILHDR		struct exec
+
+# ifndef AIX
+#  define SYMENT	struct nlist
+# endif AIX
+
+# ifdef hpux
+#  define nlist nlist_
+typedef struct syment {
+	long	n_value;
+	unsigned char	n_type;
+	unsigned char	n_length;
+	short	n_almod;
+	short	n_unused;
+	union { long n_strx;} n_un;
+} SYMENT;
+# endif hpux
+
+# ifndef SYMENT
+#  define SYMENT	struct syment
+# endif SYMENT
+
+# ifndef SYMESZ  
+#  define SYMESZ	(sizeof(SYMENT))
+# endif SYMESZ
+
+# define SYM_VALUE(sym)	(sym).n_value
+
+# ifndef SYMNMLEN
+#  define SYMNMLEN	0	/* no symbols are directly in the table */
+# endif SYMNMLEN
+
+# ifdef hpux
+#  define RELOC	struct r_info
+# elif defined(__sparc__)
+#  define RELOC	struct reloc_info_sparc
+# else
+#  define RELOC	struct relocation_info
+# endif hpux
+
+# ifdef hpux
+#  define NSYMS(hdr)	count_symbols(&hdr, fp)
+#  define N_SYMOFF(x)	LESYM_OFFSET(x)
+#  define N_TRELOCOFF(x) RTEXT_OFFSET(x)
+# else
+#  define NSYMS(f)	((unsigned int)((f).a_syms/(sizeof(struct nlist))))
+#  define N_TRELOCOFF(x) (N_TXTOFF(x) + (x).a_text + (x).a_data)
+# endif hpux
+
+# define EXT_UNDEF(p)	((p)->n_type == N_EXT)
+# define EXT_and_TEXT_BSS_DAT(p) (((p)->n_type & N_EXT) && \
+				 ((p)->n_type & (N_TEXT | N_DATA | N_BSS))) 
+# define NUM_AUX(p)	0
+# define SYM_TYPE(sym)	((sym)->n_type & N_TYPE)
+# define N_SECTION(sym)	(SYM_TYPE(sym) & ~N_EXT)
+# define SYM_NAME(x)	(string_table + (x)->n_un.n_strx)
+# define C_EXT		N_UNDF
+# define RELSZ		sizeof(RELOC)
+# ifndef N_MAGIC
+#  define N_MAGIC(x)	(x).a_magic
+# endif
+#endif AOUT
diff --git a/src/crs/porting/Makefile b/src/crs/porting/Makefile
new file mode 100644
index 000000000..0e6b903b9
--- /dev/null
+++ b/src/crs/porting/Makefile
@@ -0,0 +1,19 @@
+CC = gcc
+
+unexe	: unexe.c
+	$(CC) -static -o unexe -g unexe.c ../../libcrs.a
+
+ecoffdump:	ecoffdump.c
+	$(CC) -o ecoffdump ecoffdump.c
+
+coffdump:	coffdump.c
+	$(CC) -o coffdump coffdump.c -lld
+
+test-dld:	test-dld.c
+	$(CC) -o test-dld test-dld.c
+
+dld:	dld.c
+	$(CC) -o dld dld.c -lld
+
+try:	try.c
+	$(CC) -o try try.c -D${MACHINE}
diff --git a/src/crs/porting/c.c b/src/crs/porting/c.c
new file mode 100644
index 000000000..3f54f410b
--- /dev/null
+++ b/src/crs/porting/c.c
@@ -0,0 +1,58 @@
+
+/* Dump ECOFF-MIPS file */
+
+#include <stdio.h>
+#include <filehdr.h>
+#include <aouthdr.h>
+#include <scnhdr.h>
+#include <syms.h>
+#include <reloc.h>
+#include <storclass.h>
+
+filecpy(FILE *to, FILE *from, register int n)
+{
+  char buffer[BUFSIZ];
+
+  while (n > BUFSIZ) {
+    fread(buffer, BUFSIZ, 1, from);
+    fwrite(buffer, BUFSIZ, 1, to);
+    n -= BUFSIZ;
+  }
+  if (n > 0) {
+    fread(buffer, 1, n, from);
+    fwrite(buffer, 1, n, to);
+  }
+}
+
+main(int argc, char *argv[])
+{
+	int i, n;
+	FILE *fp, *out;
+
+	FILHDR fileheader;
+	AOUTHDR unix_header;
+	char buf[512];
+
+	fp = fopen(argv[1], "r");
+	out = fopen(argv[2], "w");
+
+	fread((char *)&fileheader, sizeof(FILHDR), 1, fp);
+	fwrite((char *)&fileheader, sizeof(FILHDR), 1, out);
+	printf("ptr: %d\n", ftell(fp));
+
+	fread(&unix_header, sizeof(AOUTHDR), 1, fp);
+	fwrite(&unix_header, sizeof(AOUTHDR), 1, out);
+	printf("ptr: %d\n", ftell(fp));
+/*
+	for (i = 0; i < fileheader.f_nscns; i++) {
+	  fread(&section[i], sizeof(SCNHDR), 1, fp);
+	  fwrite(&section[i], sizeof(SCNHDR), 1, out);
+	}
+*/
+	printf("symptr: %d, ptr: %d\n", fileheader.f_symptr, ftell(fp));
+	filecpy(out, fp, fileheader.f_symptr - ftell(fp));
+	while ((n = read(_fileno(fp), buf, sizeof buf)) > 0) {
+	  write(_fileno(out), buf, n);
+	  printf("in: %d, out: %d\n", ftell(fp), ftell(out));
+	}
+}
diff --git a/src/crs/porting/coffdump.c b/src/crs/porting/coffdump.c
new file mode 100644
index 000000000..ac507af5e
--- /dev/null
+++ b/src/crs/porting/coffdump.c
@@ -0,0 +1,272 @@
+
+/* Dump COFF file */
+
+#include <stdio.h>
+#include <filehdr.h>
+#include <aouthdr.h>
+#include <scnhdr.h>
+#include <syms.h>
+#include <reloc.h>
+#include <ldfcn.h>
+
+#ifdef __sgi
+#define ECOFF
+#endif
+
+#ifdef ECOFF
+#define SYMENT SYMR
+#define SYM_VALUE(sym)	(sym).value
+#else
+#define SYM_VALUE(sym)	(sym).n_value
+#endif
+
+main(int argc, char *argv[])
+{
+	int i, j;
+	char *s;
+	char *string_table;
+
+	LDFILE *ldptr;
+	struct aouthdr unix_header;
+	SCNHDR secthead1;
+	SCNHDR secthead2;
+	SCNHDR secthead3;
+	SCNHDR secthead4;
+	SCNHDR sectheadn;
+	SYMENT symbol;
+	struct reloc reloc;
+
+	printf("sizeof(struct reloc) = %d\n\n", sizeof(struct reloc));
+	printf("sizeof(SYMENT) = %d\n\n", sizeof(SYMENT));
+
+	ldptr = ldopen(argv[1], NULL);
+
+	printf("f_magic:        %o\n", HEADER(ldptr).f_magic);
+	printf("f_nscns:	%d\n", HEADER(ldptr).f_nscns);
+	printf("f_timdat:	%d\n", HEADER(ldptr).f_timdat);
+	printf("f_symptr:	%d\n", HEADER(ldptr).f_symptr);
+	printf("f_nsyms:	%d\n", HEADER(ldptr).f_nsyms);
+	printf("f_opthdr:	%d\n", HEADER(ldptr).f_opthdr);
+	printf("f_flags:	%o\n", HEADER(ldptr).f_flags);
+
+	if(HEADER(ldptr).f_opthdr) {
+
+	  FSEEK(ldptr, sizeof(struct filehdr), 0);
+	  FREAD((char *)&unix_header, sizeof(struct aouthdr), 1, ldptr);
+
+#ifdef apollo
+	  printf("\nvformat:		%o\n", unix_header.vformat);
+#else
+	  printf("\nmagic:		%o\n", unix_header.magic);
+#endif /* apollo */
+	  printf("vstamp:		%o\n", unix_header.vstamp);
+	  printf("tsize:		%d\n", unix_header.tsize);
+	  printf("dsize:		%d\n", unix_header.dsize);
+	  printf("bsize:		%d\n", unix_header.bsize);
+	  printf("entry:		%d\n", unix_header.entry);
+	  printf("text_start:	%d\n", unix_header.text_start);
+	  printf("data_start:	%d\n", unix_header.data_start);
+#ifdef apollo
+	  printf("o_sri:		%d\n", unix_header.o_sri);
+	  printf("o_inlib:	%d\n", unix_header.o_inlib);
+	  printf("vid[0]: %d, vid[1]: %d\n", unix_header.vid[0], unix_header.vid[1]);
+#endif /* apollo */
+	}
+
+	ldshread(ldptr, 1, &secthead1);
+
+	printf("\nsecthead1:\n");
+	printf("s_name: %s\n", secthead1.s_name);
+	printf("s_paddr:	%d\n", secthead1.s_paddr);
+	printf("s_vaddr:	%d\n", secthead1.s_vaddr);
+	printf("s_size:		%d\n", secthead1.s_size);
+	printf("s_scnptr:	%d\n", secthead1.s_scnptr);
+	printf("s_relptr:	%d\n", secthead1.s_relptr);
+	printf("s_lnnoptr:	%d\n", secthead1.s_lnnoptr);
+	printf("s_nreloc:	%d\n", secthead1.s_nreloc);
+	printf("s_nlnno:	%d\n", secthead1.s_nlnno);
+	printf("s_flags:	%o\n", secthead1.s_flags);
+
+	ldshread(ldptr, 2, &secthead2);
+
+	printf("\nsecthead2:\n");
+	printf("s_name:	%s\n", secthead2.s_name);
+	printf("s_paddr:	%d\n", secthead2.s_paddr);
+	printf("s_vaddr:	%d\n", secthead2.s_vaddr);
+	printf("s_size:		%d\n", secthead2.s_size);
+	printf("s_scnptr:	%d\n", secthead2.s_scnptr);
+	printf("s_relptr:	%d\n", secthead2.s_relptr);
+	printf("s_lnnoptr:	%d\n", secthead2.s_lnnoptr);
+	printf("s_nreloc:	%d\n", secthead2.s_nreloc);
+	printf("s_nlnno:	%d\n", secthead2.s_nlnno);
+	printf("s_flags:	%o\n", secthead2.s_flags);
+
+	ldshread(ldptr, 3, &secthead3);
+
+	printf("\nsecthead3:\n");
+	printf("s_name:	%s\n", secthead3.s_name);
+	printf("s_paddr:	%d\n", secthead3.s_paddr);
+	printf("s_vaddr:	%d\n", secthead3.s_vaddr);
+	printf("s_size:		%d\n", secthead3.s_size);
+	printf("s_scnptr:	%d\n", secthead3.s_scnptr);
+	printf("s_relptr:	%d\n", secthead3.s_relptr);
+	printf("s_lnnoptr:	%d\n", secthead3.s_lnnoptr);
+	printf("s_nreloc:	%d\n", secthead3.s_nreloc);
+	printf("s_nlnno:	%d\n", secthead3.s_nlnno);
+	printf("s_flags:	%o\n", secthead3.s_flags);
+
+	ldshread(ldptr, 4, &secthead4);
+
+	printf("\nsecthead4:\n");
+	printf("s_name:	%s\n", secthead4.s_name);
+	printf("s_paddr:	%d\n", secthead4.s_paddr);
+	printf("s_vaddr:	%d\n", secthead4.s_vaddr);
+	printf("s_size:		%d\n", secthead4.s_size);
+	printf("s_scnptr:	%d\n", secthead4.s_scnptr);
+	printf("s_relptr:	%d\n", secthead4.s_relptr);
+	printf("s_lnnoptr:	%d\n", secthead4.s_lnnoptr);
+	printf("s_nreloc:	%d\n", secthead4.s_nreloc);
+	printf("s_nlnno:	%d\n", secthead4.s_nlnno);
+	printf("s_flags:	%o\n", secthead4.s_flags);
+
+#ifdef apollo
+	for (i = 5; i <= HEADER(ldptr).f_nscns; i++) {
+	ldshread(ldptr, i, &sectheadn);
+
+	printf("\nsectheadn:\n");
+	printf("s_name:	%s\n", sectheadn.s_name);
+	printf("s_paddr:	%d\n", sectheadn.s_paddr);
+	printf("s_vaddr:	%d\n", sectheadn.s_vaddr);
+	printf("s_size:		%d\n", sectheadn.s_size);
+	printf("s_scnptr:	%d\n", sectheadn.s_scnptr);
+	printf("s_relptr:	%d\n", sectheadn.s_relptr);
+	printf("s_lnnoptr:	%d\n", sectheadn.s_lnnoptr);
+	printf("s_nreloc:	%d\n", sectheadn.s_nreloc);
+	printf("s_nlnno:	%d\n", sectheadn.s_nlnno);
+	printf("s_flags:	%o\n", sectheadn.s_flags);
+		}
+#endif /* apollo */
+
+	printf("\nreloc info for 1:\n");
+	ldrseek(ldptr, 1);
+	for (i = 0; i < secthead1.s_nreloc; i++)	{
+		j = fread(&reloc, 10, 1, IOPTR(ldptr));
+		if (j != 1)
+			fprintf(stderr, "READ ERROR\n");
+		printf("\nr_vaddr		%d\n", reloc.r_vaddr);
+		printf("r_symndx	%d\n", reloc.r_symndx);
+		switch (reloc.r_type)	{
+		case R_ABS:
+			printf("r_type		R_ABS\n");
+			break;
+		case R_DIR32:
+			printf("r_type		R_DIR32\n");
+			break;
+		case R_OFF16:
+			printf("r_type		R_OFF16\n");
+			break;
+		case R_DIR32S:
+			printf("r_type		R_DIR32S\n");
+			break;
+		case R_REL24:
+			printf("r_type		R_REL24\n");
+			break;
+		case R_OPT16:
+			printf("r_type		R_OPT16\n");
+			break;
+		case R_IND24:
+			printf("r_type		R_IND24\n");
+			break;
+		case R_IND32:
+			printf("r_type		R_IND32\n");
+			break;
+		default:
+			fprintf(stderr, "Illegal r_type:	%o\n",
+				reloc.r_type);
+			break;
+		}
+	}
+
+	printf("\nreloc info for 2:\n");
+	ldrseek(ldptr, 2);
+	for (i = 0; i < secthead2.s_nreloc; i++)	{
+		fread(&reloc, sizeof(struct reloc), 1, IOPTR(ldptr));
+		printf("\nr_vaddr		%d\n", reloc.r_vaddr);
+		printf("r_symndx	%d\n", reloc.r_symndx);
+		switch (reloc.r_type)	{
+		case R_RELBYTE:
+			printf("r_type		R_RELTYPE\n");
+			break;
+		case R_RELWORD:
+			printf("r_type		R_RELWORD\n");
+			break;
+		case R_RELLONG:
+			printf("r_type		R_RELLONG\n");
+			break;
+		case R_PCRBYTE:
+			printf("r_type		R_PCRTYPE\n");
+			break;
+		case R_PCRWORD:
+			printf("r_type		R_PCRWORD\n");
+			break;
+		case R_PCRLONG:
+			printf("r_type		R_PCRLONG\n");
+			break;
+		default:
+			fprintf(stderr, "Illegal r_type:	%d",
+				reloc.r_type);
+			break;
+		}
+	}
+
+	/*
+	  If the string table is not empty,
+	  its length is stored after the symbol table,
+	  This is not described in the manual, and may change in the future.
+	  */
+	FSEEK(ldptr, STROFFSET(ldptr), 0);
+	if (FREAD((char *)&i, 4, 1, ldptr) > 0)	{
+	  printf("i: %d\n", i);
+	  string_table = (char *)malloc(i);
+	  FREAD(string_table, 1, i - 4, ldptr);
+	}
+
+	printf("\nsymbols:\n");
+	for (i = 0; i < HEADER(ldptr).f_nsyms; i++)	{
+		ldtbread(ldptr, i, &symbol);
+		printf("\nldgetname(%d):	%s\n",
+			i, ldgetname(ldptr, &symbol));
+#ifdef ECOFF
+		printf("[%d] v %x st %d sc %d index %x %s\n",
+		       i, symbol.value, symbol.st, symbol.sc, symbol.index,
+		       string_table[symbol.iss]);
+#else
+		printf("n_value:	%o\n", SYM_VALUE(symbol));
+		switch (symbol.n_scnum)	{
+		case N_UNDEF:
+			printf("n_scnum:	N_UNDEF\n");
+			break;
+		case N_ABS:
+			printf("n_scnum:	N_ABS\n");
+			break;
+		case N_DEBUG:
+			printf("n_scnum:	N_DEBUG\n");
+			break;
+		case N_TV:
+			printf("n_scnum:	N_TV\n");
+			break;
+		case P_TV:
+			printf("n_scnum:	P_TV\n");
+			break;
+		default:
+			printf("n_scnum:	%d\n", symbol.n_scnum);
+			break;
+		}
+		printf("n_type:		%d\n", symbol.n_type);
+		printf("n_sclass:	%d\n", symbol.n_sclass);
+		printf("n_numaux:	%d\n", symbol.n_numaux);
+		i += symbol.n_numaux;
+#endif /* ECOFF */
+	}
+
+      }
diff --git a/src/crs/porting/ecoffdump.c b/src/crs/porting/ecoffdump.c
new file mode 100644
index 000000000..cd9fc3da1
--- /dev/null
+++ b/src/crs/porting/ecoffdump.c
@@ -0,0 +1,270 @@
+
+/* Dump ECOFF-MIPS file */
+
+#include <stdio.h>
+#include <filehdr.h>
+#include <aouthdr.h>
+#include <scnhdr.h>
+#include <syms.h>
+#include <reloc.h>
+#include <storclass.h>
+
+main(int argc, char *argv[])
+{
+	int i, j;
+	char *s;
+	FILE *fp;
+
+	FILHDR fileheader;
+	AOUTHDR unix_header;
+        SCNHDR section[10];
+	HDRR symheader;
+	char *string_table;
+
+	EXTR symbol;
+	RELOC reloc;
+
+	printf("sizeof(RELOC) = %d\n\n", sizeof(RELOC));
+	printf("sizeof(EXTR) = %d\n\n", sizeof(EXTR));
+
+	/* On MIPS the file headers are present also in the memory
+	   at address 0x400000 (start of text) */
+
+	fp = fopen(argv[1], "r");
+	fread((char *)&fileheader, sizeof(FILHDR), 1, fp);
+
+	printf("f_magic:        0x%x\n", fileheader.f_magic);
+	printf("f_nscns:	%d\n", fileheader.f_nscns);
+	printf("f_timdat:	%d\n", fileheader.f_timdat);
+	printf("f_symptr:	%d\n", fileheader.f_symptr);
+	printf("f_nsyms:	%d\n", fileheader.f_nsyms);
+	printf("f_opthdr:	%d\n", fileheader.f_opthdr);
+	printf("f_flags:	0x%x\n", fileheader.f_flags);
+
+	if (fileheader.f_opthdr) {
+
+	  fread(&unix_header, sizeof(AOUTHDR), 1, fp);
+
+	  printf("\nmagic:		0%o\n", unix_header.magic);
+	  printf("vstamp:		0%o\n", unix_header.vstamp);
+	  printf("tsize:		%d\n", unix_header.tsize);
+	  printf("dsize:		%d\n", unix_header.dsize);
+	  printf("bsize:		%d\n", unix_header.bsize);
+	  printf("entry:		%d\n", unix_header.entry);
+	  printf("text_start:	%d\n", unix_header.text_start);
+	  printf("data_start:	%d\n", unix_header.data_start);
+#if __mips
+	  printf("bss_start:	%d\n", unix_header.bss_start);
+#endif
+	}
+
+	for (i = 0; i < fileheader.f_nscns; i++) {
+	  fread(&section[i], sizeof(SCNHDR), 1, fp);
+	  printf("\nsection[%d]:\n", i);
+	  printf("s_name: %s\n", section[i].s_name);
+	  printf("s_paddr:\t%d\n", section[i].s_paddr);
+	  printf("s_vaddr:\t%d\n", section[i].s_vaddr);
+	  printf("s_size:\t\t%d\n", section[i].s_size);
+	  printf("s_scnptr:\t%d\n", section[i].s_scnptr);
+	  printf("s_relptr:\t%d\n", section[i].s_relptr);
+	  printf("s_lnnoptr:\t%d\n", section[i].s_lnnoptr);
+	  printf("s_nreloc:\t%d\n", section[i].s_nreloc);
+	  printf("s_nlnno:\t%d\n", section[i].s_nlnno);
+	  printf("s_flags:\t0%o\n", section[i].s_flags);
+	}
+
+	/* Print reloc information */
+	for (j = 0; j < fileheader.f_nscns; j++) {
+	  if (section[j].s_nreloc == 0) continue;
+	  fseek(fp, section[j].s_relptr, 0);
+	  printf("\nreloc info for %s:\n", section[j].s_name);
+	  printf("\tr_vaddr  r_symndx  r_type\n\n");
+	  for (i = 0; i < section[j].s_nreloc; i++)	{
+	    if (fread(&reloc, sizeof(reloc), 1, fp) != 1)
+	      fprintf(stderr, "READ ERROR\n");
+	    printf("%15x  %8d  ", reloc.r_vaddr, reloc.r_symndx);
+	    switch (reloc.r_type)	{
+	    case R_ABS:
+	      printf("R_ABS\n");
+	      break;
+#ifdef __mips
+	    case R_REFHALF:
+	      printf("R_REFHALF\n");
+	      break;
+	    case R_REFWORD:
+	      printf("R_REFWORD\n");
+	      break;
+	    case R_JMPADDR:	/* 26-bit jump reference */
+	      printf("R_JMPADDR\n");
+	      break;
+	    case R_REFHI:
+	      printf("R_REFHI\n");
+	      break;
+	    case R_REFLO:
+	      printf("R_REFLO\n");
+	      break;
+	    case R_GPREL:
+	      printf("R_GPREL\n");
+	      break;
+	    case R_LITERAL:
+	      printf("R_LITERAL\n");
+	      break;
+	    case R_REL32:
+	      printf("R_REL32\n");
+	      break;
+	    case R_REFHI_64:
+	      printf("R_REFHI_64\n");
+	      break;
+	    case R_REFLO_64:
+	      printf("R_REFLO_64\n");
+	      break;
+	    case R_REFWORD_64:
+	      printf("R_REFWORD_64\n");
+	      break;
+	    case R_PC16:
+	      printf("R_PC16\n");
+	      break;
+#ifdef __osf__
+	    case R_RELHI:
+	      printf("R_RELHI\n");
+	      break;
+	    case R_RELLO:
+	      printf("R_RELLO\n");
+	      break;
+#endif				/* __osf__ */
+	    case R_REFSHFT:
+	      printf("R_REFSHFT\n");
+	      break;
+	    case R_REFHI_ADDEND:
+	      printf("R_REFHI_ADDEND\n");
+	      break;
+#else
+	    case R_DIR16:
+	      printf("R_DIR16\n");
+	      break;
+	    case R_REL16:
+	      printf("R_REL16\n");
+	      break;
+	    case R_IND16:
+	      printf("R_IND16\n");
+	      break;
+	    case R_DIR24:
+	      printf("R_DIR24\n");
+	      break;
+	    case R_REL24:
+	      printf("R_REL24\n");
+	      break;
+	    case R_DIR32:
+	      printf("R_DIR32\n");
+	      break;
+	    case R_OFF8:
+	      printf("R_OFF8\n");
+	      break;
+	    case R_OFF16:
+	      printf("R_OFF16\n");
+	      break;
+	    case R_SEG12:
+	      printf("R_SEG12\n");
+	      break;
+	    case R_DIR32S:
+	      printf("R_DIR32S\n");
+	      break;
+	    case R_AUX:
+	      printf("R_AUX\n");
+	      break;
+	    case R_OPT16:
+	      printf("R_OPT16\n");
+	      break;
+	    case R_IND24:
+	      printf("R_IND24\n");
+	      break;
+	    case R_IND32:
+	      printf("R_IND32\n");
+	      break;
+	    case R_RELBYTE:
+	      printf("R_RELBYTE\n");
+	      break;
+	    case R_RELWORD:
+	      printf("R_RELWORD\n");
+	      break;
+	    case R_RELLONG:
+	      printf("R_RELLONG\n");
+	      break;
+	    case R_PCRBYTE:
+	      printf("R_PCRBYTE\n");
+	      break;
+	    case R_PCRWORD:
+	      printf("R_PCRWORD\n");
+	      break;
+	    case R_PCRLONG:
+	      printf("R_PCRLONG\n");
+	      break;
+#endif mips
+
+	    default:
+	      printf("%d\n", reloc.r_type);
+
+	    }
+	  }
+	}
+	
+	fseek(fp, fileheader.f_symptr, 0);
+	fread(&symheader, sizeof(HDRR), 1, fp);
+	printf("\nSymbolic header, magic number = 0x%x, vstamp = %d:\n",
+	       symheader.magic, symheader.vstamp);
+	printf("\tInfo\t\t\tOffset\tNumber\tBytes\n\n");
+	printf("\t%s\t\t%d\t%d\t%d\n", "Line numbers",
+	       symheader.cbLineOffset, symheader.ilineMax, symheader.cbLine);
+#define SIZE(x, y)	((y) ? (x)-(y) : 0)
+	printf("\t%s\t\t%d\t%d\t%d\n", "Dense numbers",
+	       symheader.cbDnOffset, symheader.idnMax,
+	       SIZE(symheader.cbPdOffset,symheader.cbDnOffset));
+	printf("\t%s\t%d\t%d\t%d\n", "Procedure Tables",
+	       symheader.cbPdOffset, symheader.ipdMax,
+	       SIZE(symheader.cbSymOffset,symheader.cbPdOffset));
+	printf("\t%s\t\t%d\t%d\t%d\n", "Local Symbols",
+	       symheader.cbSymOffset, symheader.isymMax,
+	       SIZE((symheader.cbOptOffset ?
+		     symheader.cbOptOffset : symheader.cbAuxOffset),
+		    symheader.cbSymOffset));
+	printf("\t%s\t%d\t%d\t%d\n", "Optimization Symbols",
+	       symheader.cbOptOffset, symheader.ioptMax,
+	       SIZE(symheader.cbAuxOffset,symheader.cbOptOffset));
+	printf("\t%s\t%d\t%d\t%d\n", "Auxiliary Symbols",
+	       symheader.cbAuxOffset, symheader.iauxMax,
+	       SIZE(symheader.cbSsOffset,symheader.cbAuxOffset));
+	printf("\t%s\t\t%d\t%d\t%d\n", "Local Strings",
+	       symheader.cbSsOffset, symheader.issMax,
+	       SIZE(symheader.cbExtOffset,symheader.cbSsOffset));
+	printf("\t%s\t%d\t%d\t%d\n", "External Strings",
+	       symheader.cbSsExtOffset, symheader.issExtMax,
+	       SIZE(symheader.cbFdOffset,symheader.cbSsExtOffset));
+	printf("\t%s\t\t%d\t%d\t%d\n", "File Tables",
+	       symheader.cbFdOffset, symheader.ifdMax,
+	       SIZE(symheader.cbRfdOffset,symheader.cbFdOffset));
+	printf("\t%s\t\t%d\t%d\t%d\n", "Relative Files",
+	       symheader.cbRfdOffset, symheader.crfd,
+	       SIZE(symheader.cbExtOffset,symheader.cbRfdOffset));
+	printf("\t%s\t%d\t%d\t%d\n", "External Symbols",
+	       symheader.cbExtOffset, symheader.iextMax,
+	       sizeof(EXTR)*symheader.iextMax);
+
+	/* Read External Strings */
+	fseek(fp, symheader.cbSsExtOffset, 0);
+	i = symheader.cbFdOffset - symheader.cbSsExtOffset;
+	string_table = (char *)malloc(i);
+	fread(string_table, i, 1, fp);
+
+	printf("\nThere are %d external symbols, starting at %d\n\n",
+	       symheader.iextMax, symheader.cbExtOffset);
+
+	fseek(fp, symheader.cbExtOffset, 0);
+	for (i = 0; i < symheader.iextMax; i++)	{
+	  SYMR sym;
+	  fread(&symbol, sizeof(symbol), 1, fp);
+	  sym = symbol.asym;
+	  printf("[%3d]: value %8x st%4d sc%4d index%6x	%s\n",
+		 i, sym.value, sym.st, sym.sc, sym.index,
+		 string_table + sym.iss);
+	}
+}
diff --git a/src/crs/porting/main.c b/src/crs/porting/main.c
new file mode 100644
index 000000000..c9a4cfd70
--- /dev/null
+++ b/src/crs/porting/main.c
@@ -0,0 +1,9 @@
+#include <stdio.h>
+
+int a[100];
+
+main()
+{
+	printf("Hello.\n");
+	printf("a[10] = %d\n", a[10]);
+}
diff --git a/src/crs/porting/o.c b/src/crs/porting/o.c
new file mode 100644
index 000000000..86cf30e9b
--- /dev/null
+++ b/src/crs/porting/o.c
@@ -0,0 +1,9 @@
+#include <stdio.h>
+
+int a[100];
+
+extra_lenght_foo()
+{
+	printf("Hello.\n");
+	printf("a[10] = %d\n", a[10]);
+}
diff --git a/src/crs/porting/o.s b/src/crs/porting/o.s
new file mode 100644
index 000000000..2c55bb5d0
--- /dev/null
+++ b/src/crs/porting/o.s
@@ -0,0 +1,39 @@
+	.file	"o.c"
+	.version	"RR-0.07-Beta"
+.LL0:
+        .data
+        .comm   a,400
+        .text
+	.align	4
+	.globl	extra_lenght_foo
+extra_lenght_foo:
+	jmp	.L28
+.L27:
+/     7		printf("Hello.\n");
+        .text
+	pushl	$.L30
+	call	printf
+	addl	$4,%esp
+/     8		printf("a[10] = %d\n", a[10]);
+        .text
+	pushl	a+40
+	pushl	$.L31
+	call	printf
+	addl	$8,%esp
+/     9	}
+.L26:
+	leave
+	ret
+.L28:
+	pushl	%ebp
+	movl	%esp,%ebp
+	jmp	.L27
+/FUNCEND
+        .data
+.L30:
+
+        .byte    0x48,0x65,0x6c,0x6c,0x6f,0x2e,0x0a,0x00
+.L31:
+
+        .byte    0x61,0x5b,0x31,0x30,0x5d,0x20,0x3d,0x20,0x25,0x64
+        .byte    0x0a,0x00
diff --git a/src/crs/porting/test-dld.c b/src/crs/porting/test-dld.c
new file mode 100644
index 000000000..a304d1b60
--- /dev/null
+++ b/src/crs/porting/test-dld.c
@@ -0,0 +1,57 @@
+#include <stdio.h>
+#include <filehdr.h>
+#include <aouthdr.h>
+#include <scnhdr.h>
+#include <reloc.h>
+#include <syms.h>
+
+int a[100];
+
+main(argc, argv)
+int argc;
+char *argv[];
+{
+	FILE *fp;
+	struct scnhdr section;
+	int tsize, dsize, bsize, text_start;
+	char *text, *malloc();
+	char command[128];
+
+	fp = fopen(argv[1], "r");
+	fseek(fp, sizeof(struct filehdr), 0);
+
+	fread(&section, sizeof(struct scnhdr), 1, fp);
+	tsize = section.s_size;
+	text_start = section.s_scnptr;
+	fread(&section, sizeof(struct scnhdr), 1, fp);
+	dsize = section.s_size;
+	fread(&section, sizeof(struct scnhdr), 1, fp);
+	bsize - section.s_size;
+	fclose(fp);
+
+	printf("size: %d+%d+%d = %d\n", tsize, dsize, bsize,
+		tsize + dsize + bsize);
+	
+	text = malloc(tsize + dsize + bsize);
+
+	sprintf(command, "ild %s %d %s tmp", argv[0], (int)text, argv[1]);
+	printf("%s\n", command);
+	if (system(command) != 0)	{
+		fprintf(stderr, "Can't relocate.\n");
+		exit(1);
+	}
+
+	fp = fopen("tmp", "r");
+	fseek(fp, text_start, 0);
+	fread(text, 1, tsize + dsize, fp);
+	fclose(fp);
+
+	a[10] = 123;
+
+	(*(int (*)())text)();
+}
+
+dummy()
+{
+	printf("What?\n");
+}
diff --git a/src/crs/porting/unexe.c b/src/crs/porting/unexe.c
new file mode 100644
index 000000000..9cb358a64
--- /dev/null
+++ b/src/crs/porting/unexe.c
@@ -0,0 +1,26 @@
+int initflag = 0;
+
+#include <stdio.h>
+
+char *data_end;
+extern char *sbrk();
+extern unexec();
+char stdin_buf[BUFSIZ], stdout_buf[BUFSIZ];
+
+main(argc, argv)
+int argc; char ** argv;
+{ char *data_start;
+  if (!initflag) {
+    initflag = 1;
+    printf("brk(0): %d\n", sbrk(0));
+    printf("data begin: %d\n", &initflag);
+    data_start = sbrk(2000);
+    brk(data_start + 500);
+    data_end = sbrk(0);
+    printf("data_start: %d, data_end: %d, sbrk: %d\n",
+	    data_start, data_end, sbrk(0));
+    unexec("/tmp/foo", argv[0]);
+  } else {
+    printf ("end: %d, sbrk(0): %d, sbrk(0): %d\n", data_end, sbrk(0), sbrk(0));
+  }
+}
diff --git a/src/crs/rsym.c b/src/crs/rsym.c
new file mode 100644
index 000000000..ab81000be
--- /dev/null
+++ b/src/crs/rsym.c
@@ -0,0 +1,269 @@
+/*
+    Copyright (c) 1990, Giuseppe Attardi and William F. Schelter.
+
+    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.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+
+  This program reads the external symbols from an object file and
+  writes them out to a file together with their addresses.
+
+  This information is used for dynamic linking of object files.
+
+*/
+
+
+#include <stdio.h>
+#include <sys/file.h>
+#include "machines.h"
+#include "objff.h"
+
+
+static FILHDR fileheader; 
+static SYMENT *symbol_table;
+static char *string_table;
+static char *start_address;
+static int nsyms;
+
+main(int argc, char *argv[])
+{
+  if (argc != 3) {
+    perror("Usage: rsym file outfile");
+    fflush(stdout);
+    exit(1);
+  }
+  get_myself(argv[1]);
+  output_externals(argv[1], argv[2]);
+  exit(0);
+}
+
+#ifdef ELF
+static int text_index, data_index, bss_index, sbss_index;
+static SCNHDR *section_headers;
+static char *section_names;
+
+get_section_number(char *name)
+{ int k;
+  for (k = 1; k < fileheader.e_shnum; k++)
+    if (strcmp(&section_names[section_headers[k].sh_name], name) == 0)
+      return k;
+  fprintf(stderr, "Missing section\n");
+  exit(1);
+}
+
+char *
+read_section(FILE *fp, int shndx)
+{
+  char *sec;
+
+  sec = (char *)malloc(section_headers[shndx].sh_size);
+  fseek(fp, section_headers[shndx].sh_offset, SEEK_SET);
+  fread(sec, section_headers[shndx].sh_size, 1, fp);
+  return sec;
+}
+#endif ELF
+
+get_myself(char *filename)
+{
+	unsigned int i, string_size;
+	FILE *fp;
+        
+	fp = fopen(filename, OPEN_R);
+	
+	if (fp == NULL) {
+		fprintf(stderr, "Can't open %s\n", filename);
+		exit(1);
+	}
+	fread((char *)&fileheader, sizeof(FILHDR), 1, fp);
+	if (N_BADMAG(fileheader)) {
+#ifdef ELF
+	  fprintf(stderr, "Bad ELF magic %s",filename);
+#else
+	  fprintf(stderr, "Bad magic %s",filename);
+#endif
+	  exit(1);
+	}
+#ifdef ELF
+	{ int symbol_index, symsize;
+	  /* Read section headers */
+	  section_headers = (void *)malloc(sizeof(SCNHDR)*
+					   (1 + fileheader.e_shnum));
+	  fseek(fp, fileheader.e_shoff, SEEK_SET);
+	  for (i = 0 ; i < fileheader.e_shnum ; i++)
+	    fread(&section_headers[i], fileheader.e_shentsize, 1, fp);
+
+	  /* Read the section names */
+	  section_names = read_section(fp, fileheader.e_shstrndx);
+
+	  /* Read the Symbol Table */
+	  symbol_index = get_section_number(".symtab");
+	  symsize = section_headers[symbol_index].sh_entsize;
+	  nsyms = section_headers[symbol_index].sh_size/symsize;
+	  symbol_table = (void *) malloc(sizeof(SYMENT) * nsyms);
+	  if (fseek(fp, section_headers[symbol_index].sh_offset, SEEK_SET)) {
+	    fprintf(stderr, "seek error");
+	    exit(1);
+	  }
+	  for (i = 0;  i < nsyms;  i++)
+	    fread((char *)&symbol_table[i], symsize, 1, fp);
+
+	  /* Read the String Table */
+	  string_table = read_section(fp, get_section_number(".strtab"));
+	  text_index = get_section_number(".text");
+	  bss_index = get_section_number(".bss");
+	  data_index = get_section_number(".data");
+	}
+#else  /* !ELF */
+	if (fseek(fp, (int)(N_SYMOFF(fileheader)), 0)) {
+	  fprintf(stderr, "seek error");
+	  exit(1);
+	}
+# if defined(ECOFF)
+	{ HDRR symheader;
+	  fseek(fp, N_SYMOFF(fileheader), 0);
+	  fread(&symheader, sizeof(HDRR), 1, fp);
+
+	  /* Read External Strings */
+	  fseek(fp, symheader.cbSsExtOffset, 0);
+	  i = symheader.cbFdOffset - symheader.cbSsExtOffset;
+	  string_table = (char *)malloc(i);
+	  fread(string_table, i, 1, fp);
+
+	  /* Read External Symbols */
+	  nsyms = symheader.iextMax;
+	  symbol_table = (SYMENT *)malloc(SYMESZ * nsyms);
+	  fseek(fp, symheader.cbExtOffset, 0);
+	  for (i = 0; i < nsyms; i++)
+	    fread(&symbol_table[i], SYMESZ, 1, fp);
+	}
+# else /* !ECOFF && !ELF */
+
+	nsyms = NSYMS(fileheader);
+	symbol_table = (SYMENT *)malloc(sizeof(SYMENT) * nsyms);
+#  ifndef hpux
+
+	/* Read Symbol Table */
+	for (i = 0;  i < nsyms;  i++)
+	  /* sizeof(SYMENT) and SYMESZ are not always the same */
+	  fread((char *)&symbol_table[i], SYMESZ, 1, fp);
+
+	/* Read the String Table */
+#	ifdef N_STROFF
+	fseek(fp, N_STROFF(fileheader), 0);
+#	endif N_STROFF	
+	/* First word is size of table: */
+	if (fread((char *)&string_size, sizeof(int), 1, fp) > 0) {
+	  string_table = (char *)malloc(string_size);
+	  fseek(fp, -sizeof(int), 1);
+	  if (string_size != fread(string_table, 1, string_size, fp)) {
+	    perror("rsym could not read bad string table");
+	    exit(1);
+	  }
+	} else {
+	  perror("Error: There is no string table \n");
+	  exit(1);
+	}
+#  else /* hpux */
+
+	for (i = 0;  i < nsyms;  i++) {
+	  fread((char *)&symbol_table[i], SYMESZ, 1, fp);
+	  symbol_table[i].n_un.n_strx = string_size;
+	  string_size += symbol_table[i].n_length + 1;
+	  fseek(fp, symbol_table[i].n_length, 1);
+	}
+
+	/* Read the String Table */
+	{  char *p; 
+	   int slen;
+	   p = string_table = malloc((unsigned int)string_size);
+	   dprintf( string table leng = %d, string_size);
+	   fseek(fp, (int)( LESYM_OFFSET(fileheader)), 0);
+	   for (i = 0; i < nsyms; i++) {
+	     fseek(fp, SYMESZ, 1);
+	     slen = symbol_table[i].n_length;
+	     fread(p, slen, 1, fp);
+	     *((p)+slen) = '\0';
+	     p += symbol_table[i].n_length + 1;
+	   }
+	 }
+#  endif hpux
+# endif ECOFF
+#endif ELF
+
+	fclose(fp);
+}
+
+output_externals(char *infile, char *outfile)
+{ FILE *fp, *symout;
+  char *name;
+  struct lsymbol_table tab;
+  SYMENT *p, *end;
+#ifdef SYMNMLEN
+  char tem[SYMNMLEN+1];
+  tem[SYMNMLEN] = 0;
+#endif
+
+  tab.n_symbols = 0; tab.tot_leng = 0;
+  symout = fopen(outfile, OPEN_W);
+  if (!symout) { perror(outfile); exit(1);}
+  fseek(symout, sizeof(struct lsymbol_table), 0);
+  end = symbol_table + nsyms;
+  for (p = symbol_table; p < end; p++) {
+    /*
+      Is the following check enough?
+      */
+    if (EXT_and_TEXT_BSS_DAT(p)) {
+      name = SYM_NAME(p);
+      tab.n_symbols++;
+      fwrite((char *)&SYM_VALUE(*p), sizeof(int), 1, symout);
+      while (tab.tot_leng++, *name)
+	putc(*name++, symout); 
+      putc('\0', symout);
+#     ifdef NUM_AUX
+      p = p + NUM_AUX(p);
+#     endif
+    }
+  }
+#ifdef apollo
+  { struct scnhdr aptvhdr;	
+    struct reloc entry;
+    int i, addr;
+    /* go to the relocation entries for section APTV */
+    fp = fopen(infile, OPEN_R);
+    fseek(fp, FILHSZ + sizeof(struct aouthdr) + 2 * SCNHSZ, 0);
+    fread(&aptvhdr, sizeof(struct scnhdr), 1, fp);
+    fseek(fp, aptvhdr.s_relptr, 0);
+
+    /* Each entry corresponds to an external library symbol.
+       Such relocation entry refers to an element of the APTV vector.
+       Elements in the APTV consist in 6 bytes (2 bytes of JMP instruction,
+       4 bytes of JMP address).
+       The relocation entry contains in r_vaddr the address of these 4 bytes.
+       Therefore the relocation address for the symbol is exactly the
+       address of the APTV element, e.g. the r_vaddr - 2.
+       */
+
+    for (i = 0; i < aptvhdr.s_nreloc; i++) {
+      fread(&entry, sizeof(entry), 1 ,fp);
+      p = &symbol_table[entry.r_symndx];
+      name = SYM_NAME(p);
+      tab.n_symbols++;
+      addr = entry.r_vaddr - 2;
+      fwrite(&addr, sizeof(int), 1, symout);
+      while (tab.tot_leng++, *name)
+	putc(*name++, symout);
+      putc('\0', symout);
+    }
+    fclose(fp);
+  }
+#endif apollo
+  fseek(symout, 0, 0);
+  fwrite(&tab, sizeof(tab), 1, symout);
+  fclose(symout);
+}
diff --git a/src/crs/setjmpsparc.s b/src/crs/setjmpsparc.s
new file mode 100644
index 000000000..fdf887d9f
--- /dev/null
+++ b/src/crs/setjmpsparc.s
@@ -0,0 +1,35 @@
+.text
+        .align 4
+        .global __setjmp
+        .proc   04
+__setjmp:
+	clr  [ %o0 ]
+	st  %sp, [ %o0 + 4 ]
+	add  8, %o7, %o1
+	st  %o1, [ %o0 + 8 ]
+	st  %fp, [ %o0 + 0xc ]
+	st  %i7, [ %o0 + 0x10 ]
+	retl 
+	mov  %g0, %o0
+        .align 4
+        .global __longjmp
+        .proc   04
+__longjmp: ta  3
+	ld  [ %o0 + 4 ], %o2
+	ldd  [ %o2 ], %l0
+	ldd  [ %o2 + 8 ], %l2
+	ldd  [ %o2 + 0x10 ], %l4
+	ldd  [ %o2 + 0x18 ], %l6
+	ldd  [ %o2 + 0x20 ], %i0
+	ldd  [ %o2 + 0x28 ], %i2
+	ldd  [ %o2 + 0x30 ], %i4
+	ld  [ %o0 + 0xc ], %fp
+	mov  %o2, %sp
+	ld  [ %o0 + 0x10 ], %i7
+	ld  [ %o0 + 8 ], %o3
+	tst  %o1
+	bne  L1
+	sub  %o3, 8, %o7
+	mov  1, %o1
+L1:     retl 
+	mov  %o1, %o0
diff --git a/src/crs/socket.c b/src/crs/socket.c
new file mode 100644
index 000000000..168417221
--- /dev/null
+++ b/src/crs/socket.c
@@ -0,0 +1,177 @@
+/*  socket.c  -- socket interface					*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or modify it
+    under the terms of the GNU General Library Public License as published
+    by the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <errno.h>
+
+#include <netinet/in.h>
+#include <netdb.h> 
+#include <sys/socket.h>
+#include <string.h>
+
+#include <sys/ioctl.h>
+
+extern int errno;
+
+/***********************************************************************
+ * Client side
+ **********************************************************************/
+
+/* 
+ * Attempts to connect to server, given host and port. Returns file 
+ * descriptor (network socket) or 0 if connection fails.
+ */
+int connect_to_server(char *host, int port)
+{
+  struct sockaddr_in inaddr;	/* INET socket address. */
+  struct sockaddr *addr;	/* address to connect to */
+  struct hostent *host_ptr;
+  int addrlen;			/* length of address */
+  extern char *getenv();
+  extern struct hostent *gethostbyname();
+  int fd;			/* Network socket */
+
+  /* Get the statistics on the specified host. */
+  if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) {
+    if ((host_ptr = gethostbyname(host)) == NULL) {
+      /* No such host! */
+      errno = EINVAL;
+      return(0);
+    }
+    /* Check the address type for an internet host. */
+    if (host_ptr->h_addrtype != AF_INET) {
+      /* Not an Internet host! */
+      errno = EPROTOTYPE;
+      return(0);
+    }
+    /* Set up the socket data. */
+    inaddr.sin_family = host_ptr->h_addrtype;
+    memcpy((char *)&inaddr.sin_addr, (char *)host_ptr->h_addr,
+	   sizeof(inaddr.sin_addr));
+  } 
+  else
+    inaddr.sin_family = AF_INET;
+
+  addr = (struct sockaddr *) &inaddr;
+  addrlen = sizeof (struct sockaddr_in);
+  inaddr.sin_port = port;
+  inaddr.sin_port = htons(inaddr.sin_port);
+  /*
+   * Open the network connection.
+   */
+  if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0)
+    return(0);			/* errno set by system call. */
+
+#ifdef TCP_NODELAY
+  /* make sure to turn off TCP coalescence */
+  { int mi;
+    setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
+  }
+#endif
+#ifdef THREADS
+  start_critical_section();
+#endif
+  if (connect(fd, addr, addrlen) == -1) {
+    (void) close (fd);
+#ifdef THREADS
+    end_critical_section();
+#endif
+    return(0);		/* errno set by system call. */
+  }
+  /*
+   * Return the id if the connection succeeded.
+   */
+  return(fd);
+}
+
+
+/***********************************************************************
+ * Server side
+ **********************************************************************/
+/*
+ * Creates a server port. Returns file 
+ * descriptor (network socket) or 0 if connection fails.
+ */
+
+int
+create_server_port(int port)
+{
+  struct sockaddr_in inaddr;	/* INET socket address. */
+  struct sockaddr *addr;	/* address to connect to */
+  int addrlen;			/* length of address */
+  int request, conn;		/* Network socket */
+
+  /*
+   * Open the network connection.
+   */
+  if ((request = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
+    return(0);			/* errno set by system call. */
+  }
+
+#ifdef SO_REUSEADDR
+    /* Necesary to restart the server without a reboot */
+    {
+	int one = 1;
+	setsockopt(request, SOL_SOCKET, SO_REUSEADDR, &one, sizeof(int));
+    }
+#endif /* SO_REUSEADDR */
+#ifdef TCP_NODELAY
+  /* make sure to turn off TCP coalescence */
+  { int mi;
+    setsockopt(request, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
+  }
+#endif
+
+  /* Set up the socket data. */
+  memset((char *)&inaddr, 0, sizeof(inaddr));
+  inaddr.sin_family = AF_INET;
+  inaddr.sin_port = htons(port);
+  inaddr.sin_addr.s_addr = htonl(INADDR_ANY);
+
+  if (bind(request, (struct sockaddr *)&inaddr, sizeof (inaddr)))
+    FEerror("Binding TCP socket", 0);
+  if (listen(request, 1))
+    FEerror("TCP listening", 0);
+#ifdef THREADS
+  /* Don't make this file-descriptor non-blocking
+   * just block on it before we attempt to accept from it
+   * Think _hard_ about moving this out of here, into somewhere sane
+   * and creating an 'accepting' stream type, which is bound to a port
+   * on reading returns streams
+   */
+  {
+    FILE *fp;			/* need to use FILE *'s rather than fd... *sigh* */
+    if ((fp = fdopen(request, "r")) == (FILE *)0)
+      printf("fdopen didn't work on accept fd!\n"); fflush(stdout);
+    fcntl(request, F_SETFL, O_NONBLOCK);
+    clearerr(fp);
+
+  loop:	errno = 0;
+    if ((conn = accept(request, (struct sockaddr *)NULL, (int *)NULL)) < 0)
+    if (errno) {
+      lwpblockon(active, fp, PD_INPUT);
+      clearerr(fp);
+      goto loop;
+    } else {
+      fclose(fp);
+      FEerror("Accepting requests", 0);
+    }
+    fclose(fp);
+  }
+#else
+  if ((conn = accept(request, (struct sockaddr *)NULL, (int *)NULL)) < 0)
+    FEerror("Accepting requests", 0);
+#endif	/* THREADS */
+
+  return(conn);
+}
diff --git a/src/crs/unexaix.c b/src/crs/unexaix.c
new file mode 100644
index 000000000..e22e0e18d
--- /dev/null
+++ b/src/crs/unexaix.c
@@ -0,0 +1,871 @@
+/* Modified by Andrew.Vignaux@comp.vuw.ac.nz to get it to work :-) */
+
+/* Copyright (C) 1985, 1986, 1987, 1988 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 1, 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., 675 Mass Ave, Cambridge, MA 02139, 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!  */
+
+
+/*
+ * unexec.c - Convert a running program into an a.out file.
+ *
+ * Author:	Spencer W. Thomas
+ * 		Computer Science Dept.
+ * 		University of Utah
+ * Date:	Tue Mar  2 1982
+ * Modified heavily since then.
+ *
+ * Synopsis:
+ *	unexec (new_name, a_name, data_start, bss_start, entry_address)
+ *	char *new_name, *a_name;
+ *	unsigned data_start, bss_start, entry_address;
+ *
+ * Takes a snapshot of the program and makes an a.out format file in the
+ * file named by the string argument new_name.
+ * If a_name is non-NULL, the symbol table will be taken from the given file.
+ * On some machines, an existing a_name file is required.
+ *
+ * The boundaries within the a.out file may be adjusted with the data_start
+ * and bss_start arguments.  Either or both may be given as 0 for defaults.
+ *
+ * Data_start gives the boundary between the text segment and the data
+ * segment of the program.  The text segment can contain shared, read-only
+ * program code and literal data, while the data segment is always unshared
+ * and unprotected.  Data_start gives the lowest unprotected address.
+ * The value you specify may be rounded down to a suitable boundary
+ * as required by the machine you are using.
+ *
+ * Specifying zero for data_start means the boundary between text and data
+ * should not be the same as when the program was loaded.
+ * If NO_REMAP is defined, the argument data_start is ignored and the
+ * segment boundaries are never changed.
+ *
+ * Bss_start indicates how much of the data segment is to be saved in the
+ * a.out file and restored when the program is executed.  It gives the lowest
+ * unsaved address, and is rounded up to a page boundary.  The default when 0
+ * is given assumes that the entire data segment is to be stored, including
+ * the previous data and bss as well as any additional storage allocated with
+ * break (2).
+ *
+ * The new file is set up to start at entry_address.
+ *
+ * If you make improvements I'd like to get them too.
+ * harpo!utah-cs!thomas, thomas@Utah-20
+ *
+ */
+
+/* There are several compilation parameters affecting unexec:
+
+* COFF
+
+Define this if your system uses COFF for executables.
+Otherwise we assume you use Berkeley format.
+
+* NO_REMAP
+
+Define this if you do not want to try to save Emacs's pure data areas
+as part of the text segment.
+
+Saving them as text is good because it allows users to share more.
+
+However, on machines that locate the text area far from the data area,
+the boundary cannot feasibly be moved.  Such machines require
+NO_REMAP.
+
+Also, remapping can cause trouble with the built-in startup routine
+/lib/crt0.o, which defines `environ' as an initialized variable.
+Dumping `environ' as pure does not work!  So, to use remapping,
+you must write a startup routine for your machine in Emacs's crt0.c.
+If NO_REMAP is defined, Emacs uses the system's crt0.o.
+
+* SECTION_ALIGNMENT
+
+Some machines that use COFF executables require that each section
+start on a certain boundary *in the COFF file*.  Such machines should
+define SECTION_ALIGNMENT to a mask of the low-order bits that must be
+zero on such a boundary.  This mask is used to control padding between
+segments in the COFF file.
+
+If SECTION_ALIGNMENT is not defined, the segments are written
+consecutively with no attempt at alignment.  This is right for
+unmodified system V.
+
+* SEGMENT_MASK
+
+Some machines require that the beginnings and ends of segments
+*in core* be on certain boundaries.  For most machines, a page
+boundary is sufficient.  That is the default.  When a larger
+boundary is needed, define SEGMENT_MASK to a mask of
+the bits that must be zero on such a boundary.
+
+* A_TEXT_OFFSET(HDR)
+
+Some machines count the a.out header as part of the size of the text
+segment (a_text); they may actually load the header into core as the
+first data in the text segment.  Some have additional padding between
+the header and the real text of the program that is counted in a_text.
+
+For these machines, define A_TEXT_OFFSET(HDR) to examine the header
+structure HDR and return the number of bytes to add to `a_text'
+before writing it (above and beyond the number of bytes of actual
+program text).  HDR's standard fields are already correct, except that
+this adjustment to the `a_text' field has not yet been made;
+thus, the amount of offset can depend on the data in the file.
+  
+* A_TEXT_SEEK(HDR)
+
+If defined, this macro specifies the number of bytes to seek into the
+a.out file before starting to write the text segment.a
+
+* EXEC_MAGIC
+
+For machines using COFF, this macro, if defined, is a value stored
+into the magic number field of the output file.
+
+* ADJUST_EXEC_HEADER
+
+This macro can be used to generate statements to adjust or
+initialize nonstandard fields in the file header
+
+* ADDR_CORRECT(ADDR)
+
+Macro to correct an int which is the bit pattern of a pointer to a byte
+into an int which is the number of a byte.
+
+This macro has a default definition which is usually right.
+This default definition is a no-op on most machines (where a
+pointer looks like an int) but not on all machines.
+
+*/
+
+#define XCOFF
+#define COFF
+#define NO_REMAP
+
+#ifndef emacs
+#define PERROR(arg) perror (arg); return -1
+#else
+#include <config.h>
+#define PERROR(file) report_error (file, new)
+#endif
+
+#ifndef CANNOT_DUMP  /* all rest of file!  */
+
+#ifndef CANNOT_UNEXEC /* most of rest of file */
+
+#include <a.out.h>
+/* Define getpagesize () if the system does not.
+   Note that this may depend on symbols defined in a.out.h
+ */
+#include "getpagesize.h"
+
+#ifndef makedev			/* Try to detect types.h already loaded */
+#include <sys/types.h>
+#endif
+#include <stdio.h>
+#include <sys/stat.h>
+#include <errno.h>
+
+extern char *start_of_text ();		/* Start of text */
+extern char *start_of_data ();		/* Start of initialized data */
+
+extern int _data;
+extern int _edata;
+extern int _text;
+extern int _etext;
+extern int _end;
+#ifdef COFF
+#ifndef USG
+#ifndef STRIDE
+#ifndef UMAX
+#ifndef sun386
+/* I have a suspicion that these are turned off on all systems
+   and can be deleted.  Try it in version 19.  */
+#include <filehdr.h>
+#include <aouthdr.h>
+#include <scnhdr.h>
+#include <syms.h>
+#endif /* not sun386 */
+#endif /* not UMAX */
+#endif /* Not STRIDE */
+#endif /* not USG */
+static long block_copy_start;		/* Old executable start point */
+static struct filehdr f_hdr;		/* File header */
+static struct aouthdr f_ohdr;		/* Optional file header (a.out) */
+long bias;			/* Bias to add for growth */
+long lnnoptr;			/* Pointer to line-number info within file */
+#define SYMS_START block_copy_start
+
+static long text_scnptr;
+static long data_scnptr;
+#ifdef XCOFF
+static long load_scnptr;
+static long orig_load_scnptr;
+static long orig_data_scnptr;
+#endif
+static long data_st;
+
+#ifndef MAX_SECTIONS
+#define MAX_SECTIONS	10
+#endif
+
+#endif /* COFF */
+
+static int pagemask;
+
+/* Correct an int which is the bit pattern of a pointer to a byte
+   into an int which is the number of a byte.
+   This is a no-op on ordinary machines, but not on all.  */
+
+#ifndef ADDR_CORRECT   /* Let m-*.h files override this definition */
+#define ADDR_CORRECT(x) ((char *)(x) - (char*)0)
+#endif
+
+#ifdef emacs
+
+static
+report_error (file, fd)
+     char *file;
+     int fd;
+{
+  if (fd)
+    close (fd);
+  error ("Failure operating on %s", file);
+}
+#endif /* emacs */
+
+#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1
+#define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1
+#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1
+
+static
+report_error_1 (fd, msg, a1, a2)
+     int fd;
+     char *msg;
+     int a1, a2;
+{
+  close (fd);
+#ifdef emacs
+  error (msg, a1, a2);
+#else
+  fprintf (stderr, msg, a1, a2);
+  fprintf (stderr, "\n");
+#endif
+}
+
+static int make_hdr ();
+static void mark_x ();
+static int copy_text_and_data ();
+static int copy_sym ();
+
+/* ****************************************************************
+ * unexec
+ *
+ * driving logic.
+ */
+unexec (new_name, a_name, data_start, bss_start, entry_address)
+     char *new_name, *a_name;
+     unsigned data_start, bss_start, entry_address;
+{
+  int new, a_out = -1;
+
+  if (a_name && (a_out = open (a_name, 0)) < 0)
+    {
+      PERROR (a_name);
+    }
+  if ((new = creat (new_name, 0666)) < 0)
+    {
+      PERROR (new_name);
+    }
+  if (make_hdr (new,a_out,data_start,bss_start,entry_address,a_name,new_name) < 0
+      || copy_text_and_data (new) < 0
+      || copy_sym (new, a_out, a_name, new_name) < 0
+#ifdef COFF
+      || adjust_lnnoptrs (new, a_out, new_name) < 0
+#endif
+#ifdef XCOFF
+      || unrelocate_symbols (new, a_out, a_name, new_name) < 0
+#endif
+      )
+    {
+      close (new);
+      /* unlink (new_name);	    	/* Failed, unlink new a.out */
+      return -1;	
+    }
+
+  close (new);
+  if (a_out >= 0)
+    close (a_out);
+  mark_x (new_name);
+  return 0;
+}
+
+/* ****************************************************************
+ * make_hdr
+ *
+ * Make the header in the new a.out from the header in core.
+ * Modify the text and data sizes.
+ */
+static int
+make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name)
+     int new, a_out;
+     unsigned data_start, bss_start, entry_address;
+     char *a_name;
+     char *new_name;
+{
+  register int scns;
+  unsigned int bss_end;
+
+  struct scnhdr section[MAX_SECTIONS];
+  struct scnhdr * f_thdr;		/* Text section header */
+  struct scnhdr * f_dhdr;		/* Data section header */
+  struct scnhdr * f_bhdr;		/* Bss section header */
+  struct scnhdr * f_lhdr;		/* Loader section header */
+  struct scnhdr * f_tchdr;		/* Typechk section header */
+  struct scnhdr * f_dbhdr;		/* Debug section header */
+  struct scnhdr * f_xhdr;		/* Except section header */
+
+  load_scnptr = orig_load_scnptr = lnnoptr = 0;
+  pagemask = getpagesize () - 1;
+
+  /* Adjust text/data boundary. */
+#ifdef NO_REMAP
+  data_start = (long) start_of_data ();
+#endif /*  NO_REMAP */
+  data_start = ADDR_CORRECT (data_start);
+
+#ifdef SEGMENT_MASK
+  data_start = data_start & ~SEGMENT_MASK; /* (Down) to segment boundary. */
+#else
+  data_start = data_start & ~pagemask; /* (Down) to page boundary. */
+#endif
+
+
+  bss_end = ADDR_CORRECT (sbrk (0)) + pagemask;
+  bss_end &= ~ pagemask;
+  /* Adjust data/bss boundary. */
+  if (bss_start != 0)
+    {
+      bss_start = (ADDR_CORRECT (bss_start) + pagemask);
+      /* (Up) to page bdry. */
+      bss_start &= ~ pagemask;
+      if (bss_start > bss_end)
+	{
+	  ERROR1 ("unexec: Specified bss_start (%u) is past end of program",
+		  bss_start);
+	}
+    }
+  else
+    bss_start = bss_end;
+
+  if (data_start > bss_start)	/* Can't have negative data size. */
+    {
+      ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)",
+	      data_start, bss_start);
+    }
+
+#ifdef COFF
+  /* Salvage as much info from the existing file as possible */
+  block_copy_start = 0;
+  f_thdr = NULL; f_dhdr = NULL; f_bhdr = NULL;
+  f_lhdr = NULL; f_tchdr = NULL; f_dbhdr = NULL; f_xhdr = NULL;
+  if (a_out >= 0)
+    {
+      if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr))
+	{
+	  PERROR (a_name);
+	}
+      block_copy_start += sizeof (f_hdr);
+      if (f_hdr.f_opthdr > 0)
+	{
+	  if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr))
+	    {
+	      PERROR (a_name);
+	    }
+	  block_copy_start += sizeof (f_ohdr);
+	}
+      if (f_hdr.f_nscns > MAX_SECTIONS)
+	{
+	  ERROR0 ("unexec: too many section headers -- increase MAX_SECTIONS");
+	}
+      /* Loop through section headers */
+      for (scns = 0; scns < f_hdr.f_nscns; scns++) {
+	struct scnhdr *s = &section[scns];
+	if (read (a_out, s, sizeof (*s)) != sizeof (*s))
+	  {
+	    PERROR (a_name);
+	  }
+	if (s->s_scnptr > 0L)
+	  {
+            if (block_copy_start < s->s_scnptr + s->s_size)
+	      block_copy_start = s->s_scnptr + s->s_size;
+	  }
+
+#define CHECK_SCNHDR(ptr, name, flags) \
+  if (strcmp(s->s_name, name) == 0) { \
+    if (s->s_flags != flags) { \
+      fprintf(stderr, "unexec: %x flags where %x expected in %s section.\n", \
+	      s->s_flags, flags, name); \
+    } \
+    if (ptr) { \
+      fprintf(stderr, "unexec: duplicate section header for section %s.\n", \
+	      name); \
+    } \
+    ptr = s; \
+  }
+	CHECK_SCNHDR(f_thdr, _TEXT, STYP_TEXT);
+	CHECK_SCNHDR(f_dhdr, _DATA, STYP_DATA);
+	CHECK_SCNHDR(f_bhdr, _BSS, STYP_BSS);
+	CHECK_SCNHDR(f_lhdr, _LOADER, STYP_LOADER);
+	CHECK_SCNHDR(f_dbhdr, _DEBUG,  STYP_DEBUG);
+	CHECK_SCNHDR(f_tchdr, _TYPCHK,  STYP_TYPCHK);
+	CHECK_SCNHDR(f_xhdr, _EXCEPT,  STYP_EXCEPT);
+      }
+
+      if (f_thdr == 0)
+	{
+	  ERROR1 ("unexec: couldn't find \"%s\" section", _TEXT);
+	}
+      if (f_dhdr == 0)
+	{
+	  ERROR1 ("unexec: couldn't find \"%s\" section", _DATA);
+	}
+      if (f_bhdr == 0)
+	{
+	  ERROR1 ("unexec: couldn't find \"%s\" section", _BSS);
+	}
+    }
+  else
+    {
+      ERROR0 ("can't build a COFF file from scratch yet");
+    }
+  orig_data_scnptr = f_dhdr->s_scnptr;
+  orig_load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0;
+
+  /* Now we alter the contents of all the f_*hdr variables
+     to correspond to what we want to dump.  */
+  f_hdr.f_flags |= (F_RELFLG | F_EXEC);		/* Why? */
+#ifdef EXEC_MAGIC
+  f_ohdr.magic = EXEC_MAGIC;
+#endif
+#ifndef NO_REMAP
+  f_ohdr.tsize = data_start - f_ohdr.text_start;
+  f_ohdr.text_start = (long) start_of_text ();
+#endif
+  f_ohdr.dsize = bss_start - ((unsigned) &_data);
+  f_ohdr.bsize = bss_end - bss_start;
+
+  f_dhdr->s_size = f_ohdr.dsize;
+  f_bhdr->s_size = f_ohdr.bsize;
+  f_bhdr->s_paddr = f_ohdr.dsize;
+  f_bhdr->s_vaddr = f_ohdr.dsize;
+
+  /* fix scnptr's */
+  {
+    long ptr;
+
+    for (scns = 0; scns < f_hdr.f_nscns; scns++) {
+      struct scnhdr *s = &section[scns];
+      if (scns == 0)
+	ptr = s->s_scnptr;
+
+      if (s->s_scnptr != 0)
+	{
+	  s->s_scnptr = ptr;
+	}
+
+      if ((s->s_flags & 0xffff) == STYP_PAD)
+	{
+	  /*
+	   * the text_start should probably be o_algntext but that doesn't
+	   * seem to change
+	   */
+	  if (f_ohdr.text_start != 0) /* && scns != 0 */
+	    {
+	      s->s_size = 512 - (s->s_scnptr % 512);
+	      if (s->s_size == 512)
+		s->s_size = 0;
+	    }
+	}
+
+      ptr = ptr + s->s_size;
+    }
+
+    bias = ptr - block_copy_start;
+  }
+
+  /* fix other pointers */
+  for (scns = 0; scns < f_hdr.f_nscns; scns++) {
+    struct scnhdr *s = &section[scns];
+
+    if (s->s_relptr != 0)
+      {
+	s->s_relptr += bias;
+      }
+    if (s->s_lnnoptr != 0)
+      {
+	if (lnnoptr == 0) lnnoptr = s->s_lnnoptr;
+	s->s_lnnoptr += bias;
+      }
+  }
+
+  if (f_hdr.f_symptr > 0L)
+    {
+      f_hdr.f_symptr += bias;
+    }
+
+  data_st = data_start;
+  text_scnptr = f_thdr->s_scnptr;
+  data_scnptr = f_dhdr->s_scnptr;
+  load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0;
+  block_copy_start = orig_load_scnptr;
+
+#ifdef ADJUST_EXEC_HEADER
+  ADJUST_EXEC_HEADER
+#endif /* ADJUST_EXEC_HEADER */
+
+  if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr))
+    {
+      PERROR (new_name);
+    }
+
+  if (f_hdr.f_opthdr > 0)
+    {
+      if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr))
+	{
+	  PERROR (new_name);
+	}
+    }
+
+  for (scns = 0; scns < f_hdr.f_nscns; scns++) {
+    struct scnhdr *s = &section[scns];
+    if (write (new, s, sizeof (*s)) != sizeof (*s))
+      {
+	PERROR (new_name);
+      }
+  }
+
+  return (0);
+
+#endif /* COFF */
+}
+
+/* ****************************************************************
+ 
+ *
+ * Copy the text and data segments from memory to the new a.out
+ */
+static int
+copy_text_and_data (new)
+     int new;
+{
+  register char *end;
+  register char *ptr;
+
+  lseek (new, (long) text_scnptr, 0);
+  ptr = start_of_text () + text_scnptr;
+  end = ptr + f_ohdr.tsize;
+  write_segment (new, ptr, end);
+
+  lseek (new, (long) data_scnptr, 0);
+  ptr = (char *) &_data;
+  end = ptr + f_ohdr.dsize;
+  write_segment (new, ptr, end);
+
+  return 0;
+}
+
+write_segment (new, ptr, end)
+     int new;
+     register char *ptr, *end;
+{
+  register int i, nwrite, ret;
+  char buf[80];
+  extern int errno;
+  char zeros[128];
+
+  bzero (zeros, sizeof zeros);
+
+  for (i = 0; ptr < end;)
+    {
+      /* distance to next multiple of 128.  */
+      nwrite = (((int) ptr + 128) & -128) - (int) ptr;
+      /* But not beyond specified end.  */
+      if (nwrite > end - ptr) nwrite = end - ptr;
+      ret = write (new, ptr, nwrite);
+      /* If write gets a page fault, it means we reached
+	 a gap between the old text segment and the old data segment.
+	 This gap has probably been remapped into part of the text segment.
+	 So write zeros for it.  */
+      if (ret == -1 && errno == EFAULT)
+	{
+	write (new, zeros, nwrite);
+	}
+      else if (nwrite != ret)
+	{
+	  sprintf (buf,
+		   "unexec write failure: addr 0x%x, fileno %d, size 0x%x, wrote 0x%x, errno %d",
+		   ptr, new, nwrite, ret, errno);
+	  PERROR (buf);
+	}
+      i += nwrite;
+      ptr += nwrite;
+    }
+}
+
+/* ****************************************************************
+ * copy_sym
+ *
+ * Copy the relocation information and symbol table from the a.out to the new
+ */
+static int
+copy_sym (new, a_out, a_name, new_name)
+     int new, a_out;
+     char *a_name, *new_name;
+{
+  char page[1024];
+  int n;
+
+  if (a_out < 0)
+    return 0;
+
+  if (SYMS_START == 0L)
+    return 0;
+
+  if (lnnoptr && lnnoptr < SYMS_START)	/* if there is line number info */
+    lseek (a_out, lnnoptr, 0);		/* start copying from there */
+  else
+    lseek (a_out, SYMS_START, 0);	/* Position a.out to symtab. */
+
+  while ((n = read (a_out, page, sizeof page)) > 0)
+    {
+      if (write (new, page, n) != n)
+	{
+	  PERROR (new_name);
+	}
+    }
+  if (n < 0)
+    {
+      PERROR (a_name);
+    }
+  return 0;
+}
+
+/* ****************************************************************
+ * mark_x
+ *
+ * After successfully building the new a.out, mark it executable
+ */
+static void
+mark_x (name)
+     char *name;
+{
+  struct stat sbuf;
+  int um;
+  int new = 0;  /* for PERROR */
+
+  um = umask (777);
+  umask (um);
+  if (stat (name, &sbuf) == -1)
+    {
+      PERROR (name);
+    }
+  sbuf.st_mode |= 0111 & ~um;
+  if (chmod (name, sbuf.st_mode) == -1)
+    PERROR (name);
+}
+
+/*
+ *	If the COFF file contains a symbol table and a line number section,
+ *	then any auxiliary entries that have values for x_lnnoptr must
+ *	be adjusted by the amount that the line number section has moved
+ *	in the file (bias computed in make_hdr).  The #@$%&* designers of
+ *	the auxiliary entry structures used the absolute file offsets for
+ *	the line number entry rather than an offset from the start of the
+ *	line number section!
+ *
+ *	When I figure out how to scan through the symbol table and pick out
+ *	the auxiliary entries that need adjustment, this routine will
+ *	be fixed.  As it is now, all such entries are wrong and sdb
+ *	will complain.   Fred Fish, UniSoft Systems Inc.
+ */
+
+#ifdef COFF
+
+/* This function is probably very slow.  Instead of reopening the new
+   file for input and output it should copy from the old to the new
+   using the two descriptors already open (WRITEDESC and READDESC).
+   Instead of reading one small structure at a time it should use
+   a reasonable size buffer.  But I don't have time to work on such
+   things, so I am installing it as submitted to me.  -- RMS.  */
+
+adjust_lnnoptrs (writedesc, readdesc, new_name)
+     int writedesc;
+     int readdesc;
+     char *new_name;
+{
+  register int nsyms;
+  register int new;
+#ifdef amdahl_uts
+  SYMENT symentry;
+  AUXENT auxentry;
+#else
+  struct syment symentry;
+  union auxent auxentry;
+#endif
+
+  if (!lnnoptr || !f_hdr.f_symptr)
+    return 0;
+
+  if ((new = open (new_name, 2)) < 0)
+    {
+      PERROR (new_name);
+      return -1;
+    }
+
+  lseek (new, f_hdr.f_symptr, 0);
+  for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++)
+    {
+      read (new, &symentry, SYMESZ);
+      if (symentry.n_numaux)
+	{
+	  read (new, &auxentry, AUXESZ);
+	  nsyms++;
+	  if (ISFCN (symentry.n_type)) {
+	    auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias;
+	    lseek (new, -AUXESZ, 1);
+	    write (new, &auxentry, AUXESZ);
+	  }
+	}
+    }
+  close (new);
+}
+
+#endif /* COFF */
+
+#ifdef XCOFF
+
+/* It is probably a false economy to optimise this routine (it used to
+   read one LDREL and do do two lseeks per iteration) but the wrath of
+   RMS (see above :-) would be too much to bear */
+
+unrelocate_symbols (new, a_out, a_name, new_name)
+     int new, a_out;
+     char *a_name, *new_name;
+{
+  register int i;
+  register int l;
+  register LDREL *ldrel;
+  LDHDR ldhdr;
+  LDREL ldrel_buf [20];
+  ulong t_start = (ulong) &_text;
+  ulong d_start = (ulong) &_data;
+  int * p;
+  int dirty;
+
+  if (load_scnptr == 0)
+    return 0;
+
+  lseek (a_out, orig_load_scnptr, 0);
+  if (read (a_out, &ldhdr, sizeof (ldhdr)) != sizeof (ldhdr))
+    {
+      PERROR (new_name);
+    }
+
+#define SYMNDX_TEXT	0
+#define SYMNDX_DATA	1
+#define SYMNDX_BSS	2
+  l = 0;
+  for (i = 0; i < ldhdr.l_nreloc; i++, l--, ldrel++)
+    {
+      if (l == 0) {
+	lseek (a_out,
+	       orig_load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i,
+	       0);
+
+	l = ldhdr.l_nreloc - i;
+	if (l > sizeof (ldrel_buf) / LDRELSZ)
+	  l = sizeof (ldrel_buf) / LDRELSZ;
+
+	if (read (a_out, ldrel_buf, l * LDRELSZ) != l * LDRELSZ)
+	  {
+	    PERROR (a_name);
+	  }
+	ldrel = ldrel_buf;
+      }
+      dirty = 0;
+
+      /* this code may not be necessary */
+      /* I originally had == in the "assignment" and it still unrelocated */
+
+      /* move the BSS loader symbols to the DATA segment */
+      if (ldrel->l_rsecnm == f_ohdr.o_snbss)
+	ldrel->l_rsecnm = f_ohdr.o_sndata, dirty++;
+
+      if (ldrel->l_symndx == SYMNDX_BSS)
+	ldrel->l_symndx = SYMNDX_DATA, dirty++;
+
+      if (dirty)
+	{
+	  lseek (new,
+		 load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i,
+		 0);
+
+	  if (write (new, ldrel, LDRELSZ) != LDRELSZ)
+	    {
+	      PERROR (new_name);
+	    }
+	}
+
+      if (ldrel->l_rsecnm == f_ohdr.o_sndata)
+	{
+	  int orig_int;
+
+	  lseek (a_out, orig_data_scnptr + ldrel->l_vaddr, 0);
+
+	  if (read (a_out, (void *) &orig_int, sizeof (orig_int)) != sizeof (orig_int))
+	    {
+	      PERROR (a_name);
+	    }
+
+	  switch (ldrel->l_symndx) {
+	  case SYMNDX_TEXT:
+	    p = (int *) (d_start + ldrel->l_vaddr);
+	    orig_int = * p - (t_start - f_ohdr.text_start);
+	    break;
+
+	  case SYMNDX_DATA:
+	  case SYMNDX_BSS:
+	    p = (int *) (d_start + ldrel->l_vaddr);
+	    orig_int = * p - (d_start - f_ohdr.data_start);
+	    break;
+	  }
+
+	  lseek (new, data_scnptr + ldrel->l_vaddr, 0);
+	  if (write (new, (void *) &orig_int, sizeof (orig_int)) != sizeof (orig_int))
+	    {
+	      PERROR (new_name);
+	    }
+	}
+    }
+}
+#endif /* XCOFF */
+
+#endif /* not CANNOT_UNEXEC */
+
+#endif /* not CANNOT_DUMP */
diff --git a/src/crs/unexec.c b/src/crs/unexec.c
new file mode 100644
index 000000000..e9be7aeac
--- /dev/null
+++ b/src/crs/unexec.c
@@ -0,0 +1,1055 @@
+/* Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs 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.
+
+GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+
+/*
+ * unexec.c - Convert a running program into an a.out file.
+ *
+ * Author:	Spencer W. Thomas
+ * 		Computer Science Dept.
+ * 		University of Utah
+ * Date:	Tue Mar  2 1982
+ * Modified heavily since then.
+ *
+ * Synopsis:
+ *	unexec (new_name, a_name, data_start, bss_start, entry_address)
+ *	char *new_name, *a_name;
+ *	unsigned data_start, bss_start, entry_address;
+ *
+ * Takes a snapshot of the program and makes an a.out format file in the
+ * file named by the string argument new_name.
+ * If a_name is non-NULL, the symbol table will be taken from the given file.
+ * On some machines, an existing a_name file is required.
+ *
+ * The boundaries within the a.out file may be adjusted with the data_start
+ * and bss_start arguments.  Either or both may be given as 0 for defaults.
+ *
+ * Data_start gives the boundary between the text segment and the data
+ * segment of the program.  The text segment can contain shared, read-only
+ * program code and literal data, while the data segment is always unshared
+ * and unprotected.  Data_start gives the lowest unprotected address.
+ * The value you specify may be rounded down to a suitable boundary
+ * as required by the machine you are using.
+ *
+ * Specifying zero for data_start means the boundary between text and data
+ * should not be the same as when the program was loaded.
+ * If NO_REMAP is defined, the argument data_start is ignored and the
+ * segment boundaries are never changed.
+ *
+ * Bss_start indicates how much of the data segment is to be saved in the
+ * a.out file and restored when the program is executed.  It gives the lowest
+ * unsaved address, and is rounded up to a page boundary.  The default when 0
+ * is given assumes that the entire data segment is to be stored, including
+ * the previous data and bss as well as any additional storage allocated with
+ * break (2).
+ *
+ * The new file is set up to start at entry_address.
+ *
+ * If you make improvements I'd like to get them too.
+ * harpo!utah-cs!thomas, thomas@Utah-20
+ *
+ */
+
+/* Modified to support SysVr3 shared libraries by James Van Artsdalen
+ * of Dell Computer Corporation.  james@bigtex.cactus.org.
+ */
+
+/* There are several compilation parameters affecting unexec:
+
+* COFF
+
+Define this if your system uses COFF for executables.
+
+* COFF_ENCAPSULATE
+
+Define this if you are using the GNU coff encapsulated a.out format.
+This is closer to a.out than COFF. You should *not* define COFF if
+you define COFF_ENCAPSULATE
+
+Otherwise we assume you use Berkeley format.
+
+* NO_REMAP
+
+Define this if you do not want to try to save Emacs's pure data areas
+as part of the text segment.
+
+Saving them as text is good because it allows users to share more.
+
+However, on machines that locate the text area far from the data area,
+the boundary cannot feasibly be moved.  Such machines require
+NO_REMAP.
+
+Also, remapping can cause trouble with the built-in startup routine
+/lib/crt0.o, which defines `environ' as an initialized variable.
+Dumping `environ' as pure does not work!  So, to use remapping,
+you must write a startup routine for your machine in Emacs's crt0.c.
+If NO_REMAP is defined, Emacs uses the system's crt0.o.
+
+* SECTION_ALIGNMENT
+
+Some machines that use COFF executables require that each section
+start on a certain boundary *in the COFF file*.  Such machines should
+define SECTION_ALIGNMENT to a mask of the low-order bits that must be
+zero on such a boundary.  This mask is used to control padding between
+segments in the COFF file.
+
+If SECTION_ALIGNMENT is not defined, the segments are written
+consecutively with no attempt at alignment.  This is right for
+unmodified system V.
+
+* SEGMENT_MASK
+
+Some machines require that the beginnings and ends of segments
+*in core* be on certain boundaries.  For most machines, a page
+boundary is sufficient.  That is the default.  When a larger
+boundary is needed, define SEGMENT_MASK to a mask of
+the bits that must be zero on such a boundary.
+
+* A_TEXT_OFFSET(HDR)
+
+Some machines count the a.out header as part of the size of the text
+segment (a_text); they may actually load the header into core as the
+first data in the text segment.  Some have additional padding between
+the header and the real text of the program that is counted in a_text.
+
+For these machines, define A_TEXT_OFFSET(HDR) to examine the header
+structure HDR and return the number of bytes to add to `a_text'
+before writing it (above and beyond the number of bytes of actual
+program text).  HDR's standard fields are already correct, except that
+this adjustment to the `a_text' field has not yet been made;
+thus, the amount of offset can depend on the data in the file.
+  
+* A_TEXT_SEEK(HDR)
+
+If defined, this macro specifies the number of bytes to seek into the
+a.out file before starting to write the text segment.a
+
+* EXEC_MAGIC
+
+For machines using COFF, this macro, if defined, is a value stored
+into the magic number field of the output file.
+
+* ADJUST_EXEC_HEADER
+
+This macro can be used to generate statements to adjust or
+initialize nonstandard fields in the file header
+
+* ADDR_CORRECT(ADDR)
+
+Macro to correct an int which is the bit pattern of a pointer to a byte
+into an int which is the number of a byte.
+
+This macro has a default definition which is usually right.
+This default definition is a no-op on most machines (where a
+pointer looks like an int) but not on all machines.
+
+*/
+
+#ifndef emacs
+#define PERROR(arg) perror (arg); return -1
+#else
+#define IN_UNEXEC
+#include <config.h>
+#define PERROR(file) report_error (file, new)
+#endif
+
+#ifndef CANNOT_DUMP  /* all rest of file!  */
+
+#ifndef CANNOT_UNEXEC /* most of rest of file */
+
+#ifdef COFF_ENCAPSULATE
+int need_coff_header = 1;
+#include <coff-encap/a.out.encap.h> /* The location might be a poor assumption */
+#else
+#include <a.out.h>
+#endif
+
+/* Define getpagesize () if the system does not.
+   Note that this may depend on symbols defined in a.out.h
+ */
+#include "getpagesize.h"
+
+#ifndef makedev			/* Try to detect types.h already loaded */
+#include <sys/types.h>
+#endif /* makedev */
+#include <stdio.h>
+#include <sys/stat.h>
+#include <errno.h>
+
+extern char *start_of_text ();		/* Start of text */
+extern char *start_of_data ();		/* Start of initialized data */
+
+#ifdef COFF
+static long block_copy_start;		/* Old executable start point */
+static struct filehdr f_hdr;		/* File header */
+static struct aouthdr f_ohdr;		/* Optional file header (a.out) */
+long bias;			/* Bias to add for growth */
+long lnnoptr;			/* Pointer to line-number info within file */
+#define SYMS_START block_copy_start
+
+static long text_scnptr;
+static long data_scnptr;
+
+#else /* not COFF */
+
+#ifdef HPUX
+extern void *sbrk ();
+#else
+#if 0
+/* Some systems with __STDC__ compilers still declare this `char *' in some
+   header file, and our declaration conflicts.  The return value is always
+   cast, so it should be harmless to leave it undefined.  Hopefully
+   machines with different size pointers and ints declare sbrk in a header
+   file.  */
+#ifdef __STDC__
+extern void *sbrk ();
+#else
+extern char *sbrk ();
+#endif /* __STDC__ */
+#endif
+#endif /* HPUX */
+
+#define SYMS_START ((long) N_SYMOFF (ohdr))
+
+/* Some machines override the structure name for an a.out header.  */
+#ifndef EXEC_HDR_TYPE
+#define EXEC_HDR_TYPE struct exec
+#endif
+
+#ifdef HPUX
+#ifdef HP9000S200_ID
+#define MY_ID HP9000S200_ID
+#else
+#include <model.h>
+#define MY_ID MYSYS
+#endif /* no HP9000S200_ID */
+static MAGIC OLDMAGIC = {MY_ID, SHARE_MAGIC};
+static MAGIC NEWMAGIC = {MY_ID, DEMAND_MAGIC};
+#define N_TXTOFF(x) TEXT_OFFSET(x)
+#define N_SYMOFF(x) LESYM_OFFSET(x)
+static EXEC_HDR_TYPE hdr, ohdr;
+
+#else /* not HPUX */
+
+#if defined (USG) && !defined (IBMAIX) && !defined (IRIS) && !defined (COFF_ENCAPSULATE) && !defined (LINUX)
+static struct bhdr hdr, ohdr;
+#define a_magic fmagic
+#define a_text tsize
+#define a_data dsize
+#define a_bss bsize
+#define a_syms ssize
+#define a_trsize rtsize
+#define a_drsize rdsize
+#define a_entry entry
+#define	N_BADMAG(x) \
+    (((x).fmagic)!=OMAGIC && ((x).fmagic)!=NMAGIC &&\
+     ((x).fmagic)!=FMAGIC && ((x).fmagic)!=IMAGIC)
+#define NEWMAGIC FMAGIC
+#else /* IRIS or IBMAIX or not USG */
+static EXEC_HDR_TYPE hdr, ohdr;
+#define NEWMAGIC ZMAGIC
+#endif /* IRIS or IBMAIX not USG */
+#endif /* not HPUX */
+
+static int unexec_text_start;
+static int unexec_data_start;
+
+#ifdef COFF_ENCAPSULATE
+/* coffheader is defined in the GNU a.out.encap.h file.  */
+struct coffheader coffheader;
+#endif
+
+#endif /* not COFF */
+
+static int pagemask;
+
+/* Correct an int which is the bit pattern of a pointer to a byte
+   into an int which is the number of a byte.
+   This is a no-op on ordinary machines, but not on all.  */
+
+#ifndef ADDR_CORRECT   /* Let m-*.h files override this definition */
+#define ADDR_CORRECT(x) ((char *)(x) - (char*)0)
+#endif
+
+#ifdef emacs
+
+static
+report_error (file, fd)
+     char *file;
+     int fd;
+{
+  if (fd)
+    close (fd);
+  error ("Failure operating on %s\n", file);
+}
+#endif /* emacs */
+
+#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1
+#define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1
+#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1
+
+static
+report_error_1 (fd, msg, a1, a2)
+     int fd;
+     char *msg;
+     int a1, a2;
+{
+  close (fd);
+#ifdef emacs
+  error (msg, a1, a2);
+#else
+  fprintf (stderr, msg, a1, a2);
+  fprintf (stderr, "\n");
+#endif
+}
+
+static int make_hdr ();
+static int copy_text_and_data ();
+static int copy_sym ();
+static void mark_x ();
+
+/* ****************************************************************
+ * unexec
+ *
+ * driving logic.
+ */
+unexec (new_name, a_name, data_start, bss_start, entry_address)
+     char *new_name, *a_name;
+     unsigned data_start, bss_start, entry_address;
+{
+  int new, a_out = -1;
+
+  if (a_name && (a_out = open (a_name, 0)) < 0)
+    {
+      PERROR (a_name);
+    }
+  if ((new = creat (new_name, 0666)) < 0)
+    {
+      PERROR (new_name);
+    }
+
+  if (make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) < 0
+      || copy_text_and_data (new, a_out) < 0
+      || copy_sym (new, a_out, a_name, new_name) < 0
+#ifdef COFF
+#ifndef COFF_BSD_SYMBOLS
+      || adjust_lnnoptrs (new, a_out, new_name) < 0
+#endif
+#endif
+      )
+    {
+      close (new);
+      /* unlink (new_name);	    	/* Failed, unlink new a.out */
+      return -1;	
+    }
+
+  close (new);
+  if (a_out >= 0)
+    close (a_out);
+  mark_x (new_name);
+  return 0;
+}
+
+/* ****************************************************************
+ * make_hdr
+ *
+ * Make the header in the new a.out from the header in core.
+ * Modify the text and data sizes.
+ */
+static int
+make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name)
+     int new, a_out;
+     unsigned data_start, bss_start, entry_address;
+     char *a_name;
+     char *new_name;
+{
+  int tem;
+#ifdef COFF
+  auto struct scnhdr f_thdr;		/* Text section header */
+  auto struct scnhdr f_dhdr;		/* Data section header */
+  auto struct scnhdr f_bhdr;		/* Bss section header */
+  auto struct scnhdr scntemp;		/* Temporary section header */
+  register int scns;
+#endif /* COFF */
+#ifdef USG_SHARED_LIBRARIES
+  extern unsigned int bss_end;
+#else
+  unsigned int bss_end;
+#endif
+
+  pagemask = getpagesize () - 1;
+
+  /* Adjust text/data boundary. */
+#ifdef NO_REMAP
+  data_start = (int) start_of_data ();
+#else /* not NO_REMAP */
+  if (!data_start)
+    data_start = (int) start_of_data ();
+#endif /* not NO_REMAP */
+  data_start = ADDR_CORRECT (data_start);
+
+#ifdef SEGMENT_MASK
+  data_start = data_start & ~SEGMENT_MASK; /* (Down) to segment boundary. */
+#else
+  data_start = data_start & ~pagemask; /* (Down) to page boundary. */
+#endif
+
+  bss_end = ADDR_CORRECT (sbrk (0)) + pagemask;
+  bss_end &= ~ pagemask;
+
+  /* Adjust data/bss boundary. */
+  if (bss_start != 0)
+    {
+      bss_start = (ADDR_CORRECT (bss_start) + pagemask);
+      /* (Up) to page bdry. */
+      bss_start &= ~ pagemask;
+      if (bss_start > bss_end)
+	{
+	  ERROR1 ("unexec: Specified bss_start (%u) is past end of program",
+		  bss_start);
+	}
+    }
+  else
+    bss_start = bss_end;
+
+  if (data_start > bss_start)	/* Can't have negative data size. */
+    {
+      ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)",
+	      data_start, bss_start);
+    }
+
+#ifdef COFF
+  /* Salvage as much info from the existing file as possible */
+  if (a_out >= 0)
+    {
+      if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr))
+	{
+	  PERROR (a_name);
+	}
+      block_copy_start += sizeof (f_hdr);
+      if (f_hdr.f_opthdr > 0)
+	{
+	  if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr))
+	    {
+	      PERROR (a_name);
+	    }
+	  block_copy_start += sizeof (f_ohdr);
+	}
+      /* Loop through section headers, copying them in */
+      for (scns = f_hdr.f_nscns; scns > 0; scns--) {
+	if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp))
+	  {
+	    PERROR (a_name);
+	  }
+	if (scntemp.s_scnptr > 0L)
+	  {
+            if (block_copy_start < scntemp.s_scnptr + scntemp.s_size)
+	      block_copy_start = scntemp.s_scnptr + scntemp.s_size;
+	  }
+	if (strcmp (scntemp.s_name, ".text") == 0)
+	  {
+	    f_thdr = scntemp;
+	  }
+	else if (strcmp (scntemp.s_name, ".data") == 0)
+	  {
+	    f_dhdr = scntemp;
+	  }
+	else if (strcmp (scntemp.s_name, ".bss") == 0)
+	  {
+	    f_bhdr = scntemp;
+	  }
+      }
+    }
+  else
+    {
+      ERROR0 ("can't build a COFF file from scratch yet");
+    }
+
+  /* Now we alter the contents of all the f_*hdr variables
+     to correspond to what we want to dump.  */
+
+#ifdef USG_SHARED_LIBRARIES
+
+  /* The amount of data we're adding to the file is distance from the
+   * end of the original .data space to the current end of the .data
+   * space.
+   */
+
+  bias = bss_start - (f_ohdr.data_start + f_dhdr.s_size);
+
+#endif
+
+  f_hdr.f_flags |= (F_RELFLG | F_EXEC);
+#ifdef TPIX
+  f_hdr.f_nscns = 3;
+#endif
+#ifdef EXEC_MAGIC
+  f_ohdr.magic = EXEC_MAGIC;
+#endif
+#ifndef NO_REMAP
+  f_ohdr.text_start = (long) start_of_text ();
+  f_ohdr.tsize = data_start - f_ohdr.text_start;
+  f_ohdr.data_start = data_start;
+#endif /* NO_REMAP */
+  f_ohdr.dsize = bss_start - f_ohdr.data_start;
+  f_ohdr.bsize = bss_end - bss_start;
+#ifndef KEEP_OLD_TEXT_SCNPTR
+  /* On some machines, the old values are right.
+     ??? Maybe on all machines with NO_REMAP.  */
+  f_thdr.s_size = f_ohdr.tsize;
+  f_thdr.s_scnptr = sizeof (f_hdr) + sizeof (f_ohdr);
+  f_thdr.s_scnptr += (f_hdr.f_nscns) * (sizeof (f_thdr));
+#endif /* KEEP_OLD_TEXT_SCNPTR */
+#ifdef ADJUST_TEXT_SCNHDR_SIZE
+  /* On some machines, `text size' includes all headers.  */
+  f_thdr.s_size -= f_thdr.s_scnptr;
+#endif /* ADJUST_TEST_SCNHDR_SIZE */
+  lnnoptr = f_thdr.s_lnnoptr;
+#ifdef SECTION_ALIGNMENT
+  /* Some systems require special alignment
+     of the sections in the file itself.  */
+  f_thdr.s_scnptr
+    = (f_thdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT;
+#endif /* SECTION_ALIGNMENT */
+#ifdef TPIX
+  f_thdr.s_scnptr = 0xd0;
+#endif
+  text_scnptr = f_thdr.s_scnptr;
+#ifdef ADJUST_TEXTBASE
+  text_scnptr = sizeof (f_hdr) + sizeof (f_ohdr) + (f_hdr.f_nscns) * (sizeof (f_thdr));
+#endif
+#ifndef KEEP_OLD_PADDR
+  f_dhdr.s_paddr = f_ohdr.data_start;
+#endif /* KEEP_OLD_PADDR */
+  f_dhdr.s_vaddr = f_ohdr.data_start;
+  f_dhdr.s_size = f_ohdr.dsize;
+  f_dhdr.s_scnptr = f_thdr.s_scnptr + f_thdr.s_size;
+#ifdef SECTION_ALIGNMENT
+  /* Some systems require special alignment
+     of the sections in the file itself.  */
+  f_dhdr.s_scnptr
+    = (f_dhdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT;
+#endif /* SECTION_ALIGNMENT */
+#ifdef DATA_SECTION_ALIGNMENT
+  /* Some systems require special alignment
+     of the data section only.  */
+  f_dhdr.s_scnptr
+    = (f_dhdr.s_scnptr + DATA_SECTION_ALIGNMENT) & ~DATA_SECTION_ALIGNMENT;
+#endif /* DATA_SECTION_ALIGNMENT */
+  data_scnptr = f_dhdr.s_scnptr;
+#ifndef KEEP_OLD_PADDR
+  f_bhdr.s_paddr = f_ohdr.data_start + f_ohdr.dsize;
+#endif /* KEEP_OLD_PADDR */
+  f_bhdr.s_vaddr = f_ohdr.data_start + f_ohdr.dsize;
+  f_bhdr.s_size = f_ohdr.bsize;
+  f_bhdr.s_scnptr = 0L;
+#ifndef USG_SHARED_LIBRARIES
+  bias = f_dhdr.s_scnptr + f_dhdr.s_size - block_copy_start;
+#endif
+
+  if (f_hdr.f_symptr > 0L)
+    {
+      f_hdr.f_symptr += bias;
+    }
+
+  if (f_thdr.s_lnnoptr > 0L)
+    {
+      f_thdr.s_lnnoptr += bias;
+    }
+
+#ifdef ADJUST_EXEC_HEADER
+  ADJUST_EXEC_HEADER;
+#endif /* ADJUST_EXEC_HEADER */
+
+  if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr))
+    {
+      PERROR (new_name);
+    }
+
+  if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr))
+    {
+      PERROR (new_name);
+    }
+
+#ifndef USG_SHARED_LIBRARIES
+
+  if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr))
+    {
+      PERROR (new_name);
+    }
+
+  if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr))
+    {
+      PERROR (new_name);
+    }
+
+  if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr))
+    {
+      PERROR (new_name);
+    }
+
+#else /* USG_SHARED_LIBRARIES */
+
+  /* The purpose of this code is to write out the new file's section
+   * header table.
+   *
+   * Scan through the original file's sections.  If the encountered
+   * section is one we know (.text, .data or .bss), write out the
+   * correct header.  If it is a section we do not know (such as
+   * .lib), adjust the address of where the section data is in the
+   * file, and write out the header.
+   *
+   * If any section precedes .text or .data in the file, this code
+   * will not adjust the file pointer for that section correctly.
+   */
+
+  lseek (a_out, sizeof (f_hdr) + sizeof (f_ohdr), 0);
+
+  for (scns = f_hdr.f_nscns; scns > 0; scns--)
+    {
+      if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp))
+	PERROR (a_name);
+
+      if (!strcmp (scntemp.s_name, f_thdr.s_name))	/* .text */
+	{
+	  if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr))
+	    PERROR (new_name);
+	}
+      else if (!strcmp (scntemp.s_name, f_dhdr.s_name))	/* .data */
+	{
+	  if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr))
+	    PERROR (new_name);
+	}
+      else if (!strcmp (scntemp.s_name, f_bhdr.s_name))	/* .bss */
+	{
+	  if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr))
+	    PERROR (new_name);
+	}
+      else
+	{
+	  if (scntemp.s_scnptr)
+	    scntemp.s_scnptr += bias;
+	  if (write (new, &scntemp, sizeof (scntemp)) != sizeof (scntemp))
+	    PERROR (new_name);
+	}
+    }
+#endif /* USG_SHARED_LIBRARIES */
+
+  return (0);
+
+#else /* if not COFF */
+
+  /* Get symbol table info from header of a.out file if given one. */
+  if (a_out >= 0)
+    {
+#ifdef COFF_ENCAPSULATE
+      if (read (a_out, &coffheader, sizeof coffheader) != sizeof coffheader)
+	{
+	  PERROR(a_name);
+	}
+      if (coffheader.f_magic != COFF_MAGIC)
+	{
+	  ERROR1("%s doesn't have legal coff magic number\n", a_name);
+	}
+#endif
+      if (read (a_out, &ohdr, sizeof hdr) != sizeof hdr)
+	{
+	  PERROR (a_name);
+	}
+
+      if (N_BADMAG (ohdr))
+	{
+	  ERROR1 ("invalid magic number in %s", a_name);
+	}
+      hdr = ohdr;
+    }
+  else
+    {
+#ifdef COFF_ENCAPSULATE
+      /* We probably could without too much trouble. The code is in gld
+       * but I don't have that much time or incentive.
+       */
+      ERROR0 ("can't build a COFF file from scratch yet");
+#else
+      bzero (&hdr, sizeof hdr);
+#endif
+    }
+
+  unexec_text_start = (long) start_of_text ();
+  unexec_data_start = data_start;
+
+  /* Machine-dependent fixup for header, or maybe for unexec_text_start */
+#ifdef ADJUST_EXEC_HEADER
+  ADJUST_EXEC_HEADER;
+#endif /* ADJUST_EXEC_HEADER */
+
+  hdr.a_trsize = 0;
+  hdr.a_drsize = 0;
+  if (entry_address != 0)
+    hdr.a_entry = entry_address;
+
+  hdr.a_bss = bss_end - bss_start;
+  hdr.a_data = bss_start - data_start;
+#ifdef NO_REMAP
+  hdr.a_text = ohdr.a_text;
+#else /* not NO_REMAP */
+  hdr.a_text = data_start - unexec_text_start;
+
+#ifdef A_TEXT_OFFSET
+  hdr.a_text += A_TEXT_OFFSET (ohdr);
+#endif
+
+#endif /* not NO_REMAP */
+
+#ifdef COFF_ENCAPSULATE
+  /* We are encapsulating BSD format within COFF format.  */
+  {
+    struct coffscn *tp, *dp, *bp;
+    tp = &coffheader.scns[0];
+    dp = &coffheader.scns[1];
+    bp = &coffheader.scns[2];
+    tp->s_size = hdr.a_text + sizeof(struct exec);
+    dp->s_paddr = data_start;
+    dp->s_vaddr = data_start;
+    dp->s_size = hdr.a_data;
+    bp->s_paddr = dp->s_vaddr + dp->s_size;
+    bp->s_vaddr = bp->s_paddr;
+    bp->s_size = hdr.a_bss;
+    coffheader.tsize = tp->s_size;
+    coffheader.dsize = dp->s_size;
+    coffheader.bsize = bp->s_size;
+    coffheader.text_start = tp->s_vaddr;
+    coffheader.data_start = dp->s_vaddr;
+  }
+  if (write (new, &coffheader, sizeof coffheader) != sizeof coffheader)
+    {
+      PERROR(new_name);
+    }
+#endif /* COFF_ENCAPSULATE */
+
+  if (write (new, &hdr, sizeof hdr) != sizeof hdr)
+    {
+      PERROR (new_name);
+    }
+
+#ifdef A_TEXT_OFFSET
+  hdr.a_text -= A_TEXT_OFFSET (ohdr);
+#endif
+
+  return 0;
+
+#endif /* not COFF */
+}
+
+/* ****************************************************************
+ * copy_text_and_data
+ *
+ * Copy the text and data segments from memory to the new a.out
+ */
+static int
+copy_text_and_data (new, a_out)
+     int new, a_out;
+{
+  register char *end;
+  register char *ptr;
+
+#ifdef COFF
+
+#ifdef USG_SHARED_LIBRARIES
+
+  int scns;
+  struct scnhdr scntemp;		/* Temporary section header */
+
+  /* The purpose of this code is to write out the new file's section
+   * contents.
+   *
+   * Step through the section table.  If we know the section (.text,
+   * .data) do the appropriate thing.  Otherwise, if the section has
+   * no allocated space in the file (.bss), do nothing.  Otherwise,
+   * the section has space allocated in the file, and is not a section
+   * we know.  So just copy it.
+   */
+
+  lseek (a_out, sizeof (struct filehdr) + sizeof (struct aouthdr), 0);
+
+  for (scns = f_hdr.f_nscns; scns > 0; scns--)
+    {
+      if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp))
+	PERROR ("temacs");
+
+      if (!strcmp (scntemp.s_name, ".text"))
+	{
+	  lseek (new, (long) text_scnptr, 0);
+	  ptr = (char *) f_ohdr.text_start;
+	  end = ptr + f_ohdr.tsize;
+	  write_segment (new, ptr, end);
+	}
+      else if (!strcmp (scntemp.s_name, ".data"))
+	{
+	  lseek (new, (long) data_scnptr, 0);
+	  ptr = (char *) f_ohdr.data_start;
+	  end = ptr + f_ohdr.dsize;
+	  write_segment (new, ptr, end);
+	}
+      else if (!scntemp.s_scnptr)
+	; /* do nothing - no data for this section */
+      else
+	{
+	  char page[BUFSIZ];
+	  int size, n;
+	  long old_a_out_ptr = lseek (a_out, 0, 1);
+
+	  lseek (a_out, scntemp.s_scnptr, 0);
+	  for (size = scntemp.s_size; size > 0; size -= sizeof (page))
+	    {
+	      n = size > sizeof (page) ? sizeof (page) : size;
+	      if (read (a_out, page, n) != n || write (new, page, n) != n)
+		PERROR ("emacs");
+	    }
+	  lseek (a_out, old_a_out_ptr, 0);
+	}
+    }
+
+#else /* COFF, but not USG_SHARED_LIBRARIES */
+
+  lseek (new, (long) text_scnptr, 0);
+  ptr = (char *) f_ohdr.text_start;
+#ifdef HEADER_INCL_IN_TEXT
+  /* For Gould UTX/32, text starts after headers */
+  ptr = (char *) (ptr + text_scnptr);
+#endif /* HEADER_INCL_IN_TEXT */
+  end = ptr + f_ohdr.tsize;
+  write_segment (new, ptr, end);
+
+  lseek (new, (long) data_scnptr, 0);
+  ptr = (char *) f_ohdr.data_start;
+  end = ptr + f_ohdr.dsize;
+  write_segment (new, ptr, end);
+
+#endif /* USG_SHARED_LIBRARIES */
+
+#else /* if not COFF */
+
+/* Some machines count the header as part of the text segment.
+   That is to say, the header appears in core
+   just before the address that start_of_text () returns.
+   For them, N_TXTOFF is the place where the header goes.
+   We must adjust the seek to the place after the header.
+   Note that at this point hdr.a_text does *not* count
+   the extra A_TEXT_OFFSET bytes, only the actual bytes of code.  */
+
+#ifdef A_TEXT_SEEK
+  lseek (new, (long) A_TEXT_SEEK (hdr), 0);
+#else
+  lseek (new, (long) N_TXTOFF (hdr), 0);
+#endif /* no A_TEXT_SEEK */
+
+  ptr = (char *) unexec_text_start;
+  end = ptr + hdr.a_text;
+  write_segment (new, ptr, end);
+
+  ptr = (char *) unexec_data_start;
+  end = ptr + hdr.a_data;
+/*  This lseek is certainly incorrect when A_TEXT_OFFSET
+    and I believe it is a no-op otherwise.
+    Let's see if its absence ever fails.  */
+/*  lseek (new, (long) N_TXTOFF (hdr) + hdr.a_text, 0); */
+  write_segment (new, ptr, end);
+
+#endif /* not COFF */
+
+  return 0;
+}
+
+write_segment (new, ptr, end)
+     int new;
+     register char *ptr, *end;
+{
+  register int i, nwrite, ret;
+  char buf[80];
+  extern int errno;
+  char zeros[128];
+
+  bzero (zeros, sizeof zeros);
+
+  for (i = 0; ptr < end;)
+    {
+      /* distance to next multiple of 128.  */
+      nwrite = (((int) ptr + 128) & -128) - (int) ptr;
+      /* But not beyond specified end.  */
+      if (nwrite > end - ptr) nwrite = end - ptr;
+      ret = write (new, ptr, nwrite);
+      /* If write gets a page fault, it means we reached
+	 a gap between the old text segment and the old data segment.
+	 This gap has probably been remapped into part of the text segment.
+	 So write zeros for it.  */
+      if (ret == -1 && errno == EFAULT)
+	write (new, zeros, nwrite);
+      else if (nwrite != ret)
+	{
+	  sprintf (buf,
+		   "unexec write failure: addr 0x%x, fileno %d, size 0x%x, wrote 0x%x, errno %d",
+		   ptr, new, nwrite, ret, errno);
+	  PERROR (buf);
+	}
+      i += nwrite;
+      ptr += nwrite;
+    }
+}
+
+/* ****************************************************************
+ * copy_sym
+ *
+ * Copy the relocation information and symbol table from the a.out to the new
+ */
+static int
+copy_sym (new, a_out, a_name, new_name)
+     int new, a_out;
+     char *a_name, *new_name;
+{
+  char page[1024];
+  int n;
+
+  if (a_out < 0)
+    return 0;
+
+#ifdef COFF
+  if (SYMS_START == 0L)
+    return 0;
+#endif  /* COFF */
+
+#ifdef COFF
+  if (lnnoptr)			/* if there is line number info */
+    lseek (a_out, lnnoptr, 0);	/* start copying from there */
+  else
+#endif /* COFF */
+    lseek (a_out, SYMS_START, 0);	/* Position a.out to symtab. */
+
+  while ((n = read (a_out, page, sizeof page)) > 0)
+    {
+      if (write (new, page, n) != n)
+	{
+	  PERROR (new_name);
+	}
+    }
+  if (n < 0)
+    {
+      PERROR (a_name);
+    }
+  return 0;
+}
+
+/* ****************************************************************
+ * mark_x
+ *
+ * After successfully building the new a.out, mark it executable
+ */
+static void
+mark_x (name)
+     char *name;
+{
+  struct stat sbuf;
+  int um;
+  int new = 0;  /* for PERROR */
+
+  um = umask (777);
+  umask (um);
+  if (stat (name, &sbuf) == -1)
+    {
+      PERROR (name);
+    }
+  sbuf.st_mode |= 0111 & ~um;
+  if (chmod (name, sbuf.st_mode) == -1)
+    PERROR (name);
+}
+
+#ifdef COFF
+#ifndef COFF_BSD_SYMBOLS
+
+/*
+ *	If the COFF file contains a symbol table and a line number section,
+ *	then any auxiliary entries that have values for x_lnnoptr must
+ *	be adjusted by the amount that the line number section has moved
+ *	in the file (bias computed in make_hdr).  The #@$%&* designers of
+ *	the auxiliary entry structures used the absolute file offsets for
+ *	the line number entry rather than an offset from the start of the
+ *	line number section!
+ *
+ *	When I figure out how to scan through the symbol table and pick out
+ *	the auxiliary entries that need adjustment, this routine will
+ *	be fixed.  As it is now, all such entries are wrong and sdb
+ *	will complain.   Fred Fish, UniSoft Systems Inc.
+ */
+
+/* This function is probably very slow.  Instead of reopening the new
+   file for input and output it should copy from the old to the new
+   using the two descriptors already open (WRITEDESC and READDESC).
+   Instead of reading one small structure at a time it should use
+   a reasonable size buffer.  But I don't have time to work on such
+   things, so I am installing it as submitted to me.  -- RMS.  */
+
+adjust_lnnoptrs (writedesc, readdesc, new_name)
+     int writedesc;
+     int readdesc;
+     char *new_name;
+{
+  register int nsyms;
+  register int new;
+#if defined (amdahl_uts) || defined (pfa)
+  SYMENT symentry;
+  AUXENT auxentry;
+#else
+  struct syment symentry;
+  union auxent auxentry;
+#endif
+
+  if (!lnnoptr || !f_hdr.f_symptr)
+    return 0;
+
+  if ((new = open (new_name, 2)) < 0)
+    {
+      PERROR (new_name);
+      return -1;
+    }
+
+  lseek (new, f_hdr.f_symptr, 0);
+  for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++)
+    {
+      read (new, &symentry, SYMESZ);
+      if (symentry.n_numaux)
+	{
+	  read (new, &auxentry, AUXESZ);
+	  nsyms++;
+	  if (ISFCN (symentry.n_type) || symentry.n_type == 0x2400)
+	    {
+	      auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias;
+	      lseek (new, -AUXESZ, 1);
+	      write (new, &auxentry, AUXESZ);
+	    }
+	}
+    }
+  close (new);
+}
+
+#endif /* COFF_BSD_SYMBOLS */
+
+#endif /* COFF */
+
+#endif /* not CANNOT_UNEXEC */
+
+#endif /* not CANNOT_DUMP */
diff --git a/src/crs/unexelf.c b/src/crs/unexelf.c
new file mode 100644
index 000000000..378fcbf01
--- /dev/null
+++ b/src/crs/unexelf.c
@@ -0,0 +1,781 @@
+/* Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992
+   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 program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, 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!  */
+
+
+/*
+ * unexec.c - Convert a running program into an a.out file.
+ *
+ * Author:	Spencer W. Thomas
+ * 		Computer Science Dept.
+ * 		University of Utah
+ * Date:	Tue Mar  2 1982
+ * Modified heavily since then.
+ *
+ * Synopsis:
+ *	unexec (new_name, a_name, data_start, bss_start, entry_address)
+ *	char *new_name, *a_name;
+ *	unsigned data_start, bss_start, entry_address;
+ *
+ * Takes a snapshot of the program and makes an a.out format file in the
+ * file named by the string argument new_name.
+ * If a_name is non-NULL, the symbol table will be taken from the given file.
+ * On some machines, an existing a_name file is required.
+ *
+ * The boundaries within the a.out file may be adjusted with the data_start
+ * and bss_start arguments.  Either or both may be given as 0 for defaults.
+ *
+ * Data_start gives the boundary between the text segment and the data
+ * segment of the program.  The text segment can contain shared, read-only
+ * program code and literal data, while the data segment is always unshared
+ * and unprotected.  Data_start gives the lowest unprotected address.
+ * The value you specify may be rounded down to a suitable boundary
+ * as required by the machine you are using.
+ *
+ * Specifying zero for data_start means the boundary between text and data
+ * should not be the same as when the program was loaded.
+ * If NO_REMAP is defined, the argument data_start is ignored and the
+ * segment boundaries are never changed.
+ *
+ * Bss_start indicates how much of the data segment is to be saved in the
+ * a.out file and restored when the program is executed.  It gives the lowest
+ * unsaved address, and is rounded up to a page boundary.  The default when 0
+ * is given assumes that the entire data segment is to be stored, including
+ * the previous data and bss as well as any additional storage allocated with
+ * break (2).
+ *
+ * The new file is set up to start at entry_address.
+ *
+ * If you make improvements I'd like to get them too.
+ * harpo!utah-cs!thomas, thomas@Utah-20
+ *
+ */
+
+/* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co.
+ * ELF support added.
+ *
+ * Basic theory: the data space of the running process needs to be
+ * dumped to the output file.  Normally we would just enlarge the size
+ * of .data, scooting everything down.  But we can't do that in ELF,
+ * because there is often something between the .data space and the
+ * .bss space.
+ *
+ * In the temacs dump below, notice that the Global Offset Table
+ * (.got) and the Dynamic link data (.dynamic) come between .data1 and
+ * .bss.  It does not work to overlap .data with these fields.
+ *
+ * The solution is to create a new .data segment.  This segment is
+ * filled with data from the current process.  Since the contents of
+ * various sections refer to sections by index, the new .data segment
+ * is made the last in the table to avoid changing any existing index.
+
+ * This is an example of how the section headers are changed.  "Addr"
+ * is a process virtual address.  "Offset" is a file offset.
+
+raid:/nfs/raid/src/dist-18.56/src> dump -h temacs
+
+temacs:
+
+           **** SECTION HEADER TABLE ****
+[No]    Type    Flags   Addr         Offset       Size          Name
+        Link    Info    Adralgn      Entsize
+
+[1]     1       2       0x80480d4    0xd4         0x13          .interp
+        0       0       0x1          0            
+
+[2]     5       2       0x80480e8    0xe8         0x388         .hash
+        3       0       0x4          0x4          
+
+[3]     11      2       0x8048470    0x470        0x7f0         .dynsym
+        4       1       0x4          0x10         
+
+[4]     3       2       0x8048c60    0xc60        0x3ad         .dynstr
+        0       0       0x1          0            
+
+[5]     9       2       0x8049010    0x1010       0x338         .rel.plt
+        3       7       0x4          0x8          
+
+[6]     1       6       0x8049348    0x1348       0x3           .init
+        0       0       0x4          0            
+
+[7]     1       6       0x804934c    0x134c       0x680         .plt
+        0       0       0x4          0x4          
+
+[8]     1       6       0x80499cc    0x19cc       0x3c56f       .text
+        0       0       0x4          0            
+
+[9]     1       6       0x8085f3c    0x3df3c      0x3           .fini
+        0       0       0x4          0            
+
+[10]    1       2       0x8085f40    0x3df40      0x69c         .rodata
+        0       0       0x4          0            
+
+[11]    1       2       0x80865dc    0x3e5dc      0xd51         .rodata1
+        0       0       0x4          0            
+
+[12]    1       3       0x8088330    0x3f330      0x20afc       .data
+        0       0       0x4          0            
+
+[13]    1       3       0x80a8e2c    0x5fe2c      0x89d         .data1
+        0       0       0x4          0            
+
+[14]    1       3       0x80a96cc    0x606cc      0x1a8         .got
+        0       0       0x4          0x4          
+
+[15]    6       3       0x80a9874    0x60874      0x80          .dynamic
+        4       0       0x4          0x8          
+
+[16]    8       3       0x80a98f4    0x608f4      0x449c        .bss
+        0       0       0x4          0            
+
+[17]    2       0       0            0x608f4      0x9b90        .symtab
+        18      371     0x4          0x10         
+
+[18]    3       0       0            0x6a484      0x8526        .strtab
+        0       0       0x1          0            
+
+[19]    3       0       0            0x729aa      0x93          .shstrtab
+        0       0       0x1          0            
+
+[20]    1       0       0            0x72a3d      0x68b7        .comment
+        0       0       0x1          0            
+
+raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs
+
+xemacs:
+
+           **** SECTION HEADER TABLE ****
+[No]    Type    Flags   Addr         Offset       Size          Name
+        Link    Info    Adralgn      Entsize
+
+[1]     1       2       0x80480d4    0xd4         0x13          .interp
+        0       0       0x1          0            
+
+[2]     5       2       0x80480e8    0xe8         0x388         .hash
+        3       0       0x4          0x4          
+
+[3]     11      2       0x8048470    0x470        0x7f0         .dynsym
+        4       1       0x4          0x10         
+
+[4]     3       2       0x8048c60    0xc60        0x3ad         .dynstr
+        0       0       0x1          0            
+
+[5]     9       2       0x8049010    0x1010       0x338         .rel.plt
+        3       7       0x4          0x8          
+
+[6]     1       6       0x8049348    0x1348       0x3           .init
+        0       0       0x4          0            
+
+[7]     1       6       0x804934c    0x134c       0x680         .plt
+        0       0       0x4          0x4          
+
+[8]     1       6       0x80499cc    0x19cc       0x3c56f       .text
+        0       0       0x4          0            
+
+[9]     1       6       0x8085f3c    0x3df3c      0x3           .fini
+        0       0       0x4          0            
+
+[10]    1       2       0x8085f40    0x3df40      0x69c         .rodata
+        0       0       0x4          0            
+
+[11]    1       2       0x80865dc    0x3e5dc      0xd51         .rodata1
+        0       0       0x4          0            
+
+[12]    1       3       0x8088330    0x3f330      0x20afc       .data
+        0       0       0x4          0            
+
+[13]    1       3       0x80a8e2c    0x5fe2c      0x89d         .data1
+        0       0       0x4          0            
+
+[14]    1       3       0x80a96cc    0x606cc      0x1a8         .got
+        0       0       0x4          0x4          
+
+[15]    6       3       0x80a9874    0x60874      0x80          .dynamic
+        4       0       0x4          0x8          
+
+[16]    8       3       0x80c6800    0x7d800      0             .bss
+        0       0       0x4          0            
+
+[17]    2       0       0            0x7d800      0x9b90        .symtab
+        18      371     0x4          0x10         
+
+[18]    3       0       0            0x87390      0x8526        .strtab
+        0       0       0x1          0            
+
+[19]    3       0       0            0x8f8b6      0x93          .shstrtab
+        0       0       0x1          0            
+
+[20]    1       0       0            0x8f949      0x68b7        .comment
+        0       0       0x1          0            
+
+[21]    1       3       0x80a98f4    0x608f4      0x1cf0c       .data
+        0       0       0x4          0            
+
+ * This is an example of how the file header is changed.  "Shoff" is
+ * the section header offset within the file.  Since that table is
+ * after the new .data section, it is moved.  "Shnum" is the number of
+ * sections, which we increment.
+ *
+ * "Phoff" is the file offset to the program header.  "Phentsize" and
+ * "Shentsz" are the program and section header entries sizes respectively.
+ * These can be larger than the apparent struct sizes.
+
+raid:/nfs/raid/src/dist-18.56/src> dump -f temacs
+
+temacs:
+
+                    **** ELF HEADER ****
+Class        Data       Type         Machine     Version
+Entry        Phoff      Shoff        Flags       Ehsize
+Phentsize    Phnum      Shentsz      Shnum       Shstrndx
+
+1            1          2            3           1
+0x80499cc    0x34       0x792f4      0           0x34
+0x20         5          0x28         21          19
+
+raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs
+
+xemacs:
+
+                    **** ELF HEADER ****
+Class        Data       Type         Machine     Version
+Entry        Phoff      Shoff        Flags       Ehsize
+Phentsize    Phnum      Shentsz      Shnum       Shstrndx
+
+1            1          2            3           1
+0x80499cc    0x34       0x96200      0           0x34
+0x20         5          0x28         22          19
+
+ * These are the program headers.  "Offset" is the file offset to the
+ * segment.  "Vaddr" is the memory load address.  "Filesz" is the
+ * segment size as it appears in the file, and "Memsz" is the size in
+ * memory.  Below, the third segment is the code and the fourth is the
+ * data: the difference between Filesz and Memsz is .bss
+
+raid:/nfs/raid/src/dist-18.56/src> dump -o temacs
+
+temacs:
+ ***** PROGRAM EXECUTION HEADER *****
+Type        Offset      Vaddr       Paddr
+Filesz      Memsz       Flags       Align
+
+6           0x34        0x8048034   0           
+0xa0        0xa0        5           0           
+
+3           0xd4        0           0           
+0x13        0           4           0           
+
+1           0x34        0x8048034   0           
+0x3f2f9     0x3f2f9     5           0x1000      
+
+1           0x3f330     0x8088330   0           
+0x215c4     0x25a60     7           0x1000      
+
+2           0x60874     0x80a9874   0           
+0x80        0           7           0           
+
+raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs
+
+xemacs:
+ ***** PROGRAM EXECUTION HEADER *****
+Type        Offset      Vaddr       Paddr
+Filesz      Memsz       Flags       Align
+
+6           0x34        0x8048034   0           
+0xa0        0xa0        5           0           
+
+3           0xd4        0           0           
+0x13        0           4           0           
+
+1           0x34        0x8048034   0           
+0x3f2f9     0x3f2f9     5           0x1000      
+
+1           0x3f330     0x8088330   0           
+0x3e4d0     0x3e4d0     7           0x1000      
+
+2           0x60874     0x80a9874   0           
+0x80        0           7           0           
+
+
+ */
+
+/* Modified by wtien@urbana.mcd.mot.com of Motorola Inc. 
+ * 
+ * The above mechanism does not work if the unexeced ELF file is being
+ * re-layout by other applications (such as `strip'). All the applications 
+ * that re-layout the internal of ELF will layout all sections in ascending
+ * order of their file offsets. After the re-layout, the data2 section will 
+ * still be the LAST section in the section header vector, but its file offset 
+ * is now being pushed far away down, and causes part of it not to be mapped
+ * in (ie. not covered by the load segment entry in PHDR vector), therefore 
+ * causes the new binary to fail.
+ *
+ * The solution is to modify the unexec algorithm to insert the new data2
+ * section header right before the new bss section header, so their file
+ * offsets will be in the ascending order. Since some of the section's (all 
+ * sections AFTER the bss section) indexes are now changed, we also need to 
+ * modify some fields to make them point to the right sections. This is done 
+ * by macro PATCH_INDEX. All the fields that need to be patched are:
+ * 
+ * 1. ELF header e_shstrndx field.
+ * 2. section header sh_link and sh_info field.
+ * 3. symbol table entry st_shndx field.
+ *
+ * The above example now should look like:
+
+           **** SECTION HEADER TABLE ****
+[No]    Type    Flags   Addr         Offset       Size          Name
+        Link    Info    Adralgn      Entsize
+
+[1]     1       2       0x80480d4    0xd4         0x13          .interp
+        0       0       0x1          0            
+
+[2]     5       2       0x80480e8    0xe8         0x388         .hash
+        3       0       0x4          0x4          
+
+[3]     11      2       0x8048470    0x470        0x7f0         .dynsym
+        4       1       0x4          0x10         
+
+[4]     3       2       0x8048c60    0xc60        0x3ad         .dynstr
+        0       0       0x1          0            
+
+[5]     9       2       0x8049010    0x1010       0x338         .rel.plt
+        3       7       0x4          0x8          
+
+[6]     1       6       0x8049348    0x1348       0x3           .init
+        0       0       0x4          0            
+
+[7]     1       6       0x804934c    0x134c       0x680         .plt
+        0       0       0x4          0x4          
+
+[8]     1       6       0x80499cc    0x19cc       0x3c56f       .text
+        0       0       0x4          0            
+
+[9]     1       6       0x8085f3c    0x3df3c      0x3           .fini
+        0       0       0x4          0            
+
+[10]    1       2       0x8085f40    0x3df40      0x69c         .rodata
+        0       0       0x4          0            
+
+[11]    1       2       0x80865dc    0x3e5dc      0xd51         .rodata1
+        0       0       0x4          0            
+
+[12]    1       3       0x8088330    0x3f330      0x20afc       .data
+        0       0       0x4          0            
+
+[13]    1       3       0x80a8e2c    0x5fe2c      0x89d         .data1
+        0       0       0x4          0            
+
+[14]    1       3       0x80a96cc    0x606cc      0x1a8         .got
+        0       0       0x4          0x4          
+
+[15]    6       3       0x80a9874    0x60874      0x80          .dynamic
+        4       0       0x4          0x8          
+
+[16]    1       3       0x80a98f4    0x608f4      0x1cf0c       .data
+        0       0       0x4          0            
+
+[17]    8       3       0x80c6800    0x7d800      0             .bss
+        0       0       0x4          0            
+
+[18]    2       0       0            0x7d800      0x9b90        .symtab
+        19      371     0x4          0x10         
+
+[19]    3       0       0            0x87390      0x8526        .strtab
+        0       0       0x1          0            
+
+[20]    3       0       0            0x8f8b6      0x93          .shstrtab
+        0       0       0x1          0            
+
+[21]    1       0       0            0x8f949      0x68b7        .comment
+        0       0       0x1          0            
+
+ */
+
+#include <sys/types.h>
+#include <stdio.h>
+#include <sys/stat.h>
+#include <memory.h>
+#include <string.h>
+#include <errno.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <elf.h>
+#include <sys/mman.h>
+
+#ifndef emacs
+#define fatal(a, b, c) fprintf (stderr, a, b, c), exit (1)
+#else
+extern void fatal (char *, ...);
+#endif
+
+/* Get the address of a particular section or program header entry,
+ * accounting for the size of the entries.
+ */
+
+#define OLD_SECTION_H(n) \
+     (*(Elf32_Shdr *) ((byte *) old_section_h + old_file_h->e_shentsize * (n)))
+#define NEW_SECTION_H(n) \
+     (*(Elf32_Shdr *) ((byte *) new_section_h + new_file_h->e_shentsize * (n)))
+#define OLD_PROGRAM_H(n) \
+     (*(Elf32_Phdr *) ((byte *) old_program_h + old_file_h->e_phentsize * (n)))
+#define NEW_PROGRAM_H(n) \
+     (*(Elf32_Phdr *) ((byte *) new_program_h + new_file_h->e_phentsize * (n)))
+
+#define PATCH_INDEX(n) \
+  do { \
+	 if ((int) (n) >= old_bss_index) \
+	   (n)++; } while (0)
+typedef unsigned char byte;
+
+/* Round X up to a multiple of Y.  */
+
+int
+round_up (x, y)
+     int x, y;
+{
+  int rem = x % y;
+  if (rem == 0)
+    return x;
+  return x - rem + y;
+}
+
+/* ****************************************************************
+ * unexec
+ *
+ * driving logic.
+ *
+ * In ELF, this works by replacing the old .bss section with a new
+ * .data section, and inserting an empty .bss immediately afterwards.
+ *
+ */
+void
+unexec (new_name, old_name, data_start, bss_start, entry_address)
+     char *new_name, *old_name;
+     unsigned data_start, bss_start, entry_address;
+{
+  extern unsigned int data_end;
+  int new_file, old_file, new_file_size;
+
+  /* Pointers to the base of the image of the two files. */
+  caddr_t old_base, new_base;
+
+  /* Pointers to the file, program and section headers for the old and new
+   * files.
+   */
+  Elf32_Ehdr *old_file_h, *new_file_h;
+  Elf32_Phdr *old_program_h, *new_program_h;
+  Elf32_Shdr *old_section_h, *new_section_h;
+
+  /* Point to the section name table in the old file */
+  char *old_section_names;
+
+  Elf32_Addr old_bss_addr, new_bss_addr;
+  Elf32_Word old_bss_size, new_data2_size;
+  Elf32_Off  new_data2_offset;
+  Elf32_Addr new_data2_addr;
+
+  int n, nn, old_bss_index, old_data_index, new_data2_index;
+  struct stat stat_buf;
+
+  /* Open the old file & map it into the address space. */
+
+  old_file = open (old_name, O_RDONLY);
+
+  if (old_file < 0)
+    fatal ("Can't open %s for reading: errno %d\n", old_name, errno);
+
+  if (fstat (old_file, &stat_buf) == -1)
+    fatal ("Can't fstat (%s): errno %d\n", old_name, errno);
+
+  old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0);
+
+  if (old_base == (caddr_t) -1)
+    fatal ("Can't mmap (%s): errno %d\n", old_name, errno);
+
+#ifdef DEBUG
+  fprintf (stderr, "mmap (%s, %x) -> %x\n", old_name, stat_buf.st_size,
+	   old_base);
+#endif
+
+  /* Get pointers to headers & section names */
+
+  old_file_h = (Elf32_Ehdr *) old_base;
+  old_program_h = (Elf32_Phdr *) ((byte *) old_base + old_file_h->e_phoff);
+  old_section_h = (Elf32_Shdr *) ((byte *) old_base + old_file_h->e_shoff);
+  old_section_names = (char *) old_base
+    + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset;
+
+  /* Find the old .bss section.  Figure out parameters of the new
+   * data2 and bss sections.
+   */
+
+  for (old_bss_index = 1; old_bss_index < (int) old_file_h->e_shnum;
+       old_bss_index++)
+    {
+#ifdef DEBUG
+      fprintf (stderr, "Looking for .bss - found %s\n",
+	       old_section_names + OLD_SECTION_H (old_bss_index).sh_name);
+#endif
+      if (!strcmp (old_section_names + OLD_SECTION_H (old_bss_index).sh_name,
+		   ".bss"))
+	break;
+    }
+  if (old_bss_index == old_file_h->e_shnum)
+    fatal ("Can't find .bss in %s.\n", old_name, 0);
+
+  old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr;
+  old_bss_size = OLD_SECTION_H (old_bss_index).sh_size;
+  new_bss_addr = (Elf32_Addr) data_end;
+  new_data2_addr = old_bss_addr;
+  new_data2_size = new_bss_addr - old_bss_addr;
+  new_data2_offset = OLD_SECTION_H (old_bss_index).sh_offset;
+
+#ifdef DEBUG
+  fprintf (stderr, "old_bss_index %d\n", old_bss_index);
+  fprintf (stderr, "old_bss_addr %x\n", old_bss_addr);
+  fprintf (stderr, "old_bss_size %x\n", old_bss_size);
+  fprintf (stderr, "new_bss_addr %x\n", new_bss_addr);
+  fprintf (stderr, "new_data2_addr %x\n", new_data2_addr);
+  fprintf (stderr, "new_data2_size %x\n", new_data2_size);
+  fprintf (stderr, "new_data2_offset %x\n", new_data2_offset);
+#endif
+
+  if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size)
+    fatal (".bss shrank when undumping???\n", 0, 0);
+
+  /* Set the output file to the right size and mmap it.  Set
+   * pointers to various interesting objects.  stat_buf still has
+   * old_file data.
+   */
+
+  new_file = open (new_name, O_RDWR | O_CREAT, 0666);
+  if (new_file < 0)
+    fatal ("Can't creat (%s): errno %d\n", new_name, errno);
+
+  new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size;
+
+  if (ftruncate (new_file, new_file_size))
+    fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno);
+
+  new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED,
+		   new_file, 0);
+
+  if (new_base == (caddr_t) -1)
+    fatal ("Can't mmap (%s): errno %d\n", new_name, errno);
+
+  new_file_h = (Elf32_Ehdr *) new_base;
+  new_program_h = (Elf32_Phdr *) ((byte *) new_base + old_file_h->e_phoff);
+  new_section_h = (Elf32_Shdr *)
+    ((byte *) new_base + old_file_h->e_shoff + new_data2_size);
+
+  /* Make our new file, program and section headers as copies of the
+   * originals.
+   */
+
+  memcpy (new_file_h, old_file_h, old_file_h->e_ehsize);
+  memcpy (new_program_h, old_program_h,
+	  old_file_h->e_phnum * old_file_h->e_phentsize);
+
+  /* Modify the e_shstrndx if necessary. */
+  PATCH_INDEX (new_file_h->e_shstrndx);
+
+  /* Fix up file header.  We'll add one section.  Section header is
+   * further away now.
+   */
+
+  new_file_h->e_shoff += new_data2_size;
+  new_file_h->e_shnum += 1;
+
+#ifdef DEBUG
+  fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff);
+  fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum);
+  fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff);
+  fprintf (stderr, "New section count %d\n", new_file_h->e_shnum);
+#endif
+
+  /* Fix up a new program header.  Extend the writable data segment so
+   * that the bss area is covered too. Find that segment by looking
+   * for a segment that ends just before the .bss area.  Make sure
+   * that no segments are above the new .data2.  Put a loop at the end
+   * to adjust the offset and address of any segment that is above
+   * data2, just in case we decide to allow this later.
+   */
+
+  for (n = new_file_h->e_phnum - 1; n >= 0; n--)
+    {
+      /* Compute maximum of all requirements for alignment of section.  */
+      int alignment = (NEW_PROGRAM_H (n)).p_align;
+      if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment)
+	alignment = OLD_SECTION_H (old_bss_index).sh_addralign;
+
+      if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr)
+	fatal ("Program segment above .bss in %s\n", old_name, 0);
+
+      if (NEW_PROGRAM_H (n).p_type == PT_LOAD
+	  && (round_up ((NEW_PROGRAM_H (n)).p_vaddr
+			+ (NEW_PROGRAM_H (n)).p_filesz,
+			alignment)
+	      == round_up (old_bss_addr, alignment)))
+	break;
+    }
+  if (n < 0)
+    fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0);
+
+  NEW_PROGRAM_H (n).p_filesz += new_data2_size;
+  NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz;
+
+#if 0 /* Maybe allow section after data2 - does this ever happen? */
+  for (n = new_file_h->e_phnum - 1; n >= 0; n--)
+    {
+      if (NEW_PROGRAM_H (n).p_vaddr
+	  && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr)
+	NEW_PROGRAM_H (n).p_vaddr += new_data2_size - old_bss_size;
+
+      if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset)
+	NEW_PROGRAM_H (n).p_offset += new_data2_size;
+    }
+#endif
+
+  /* Fix up section headers based on new .data2 section.  Any section
+   * whose offset or virtual address is after the new .data2 section
+   * gets its value adjusted.  .bss size becomes zero and new address
+   * is set.  data2 section header gets added by copying the existing
+   * .data header and modifying the offset, address and size.
+   */
+  for (old_data_index = 1; old_data_index < (int) old_file_h->e_shnum;
+       old_data_index++)
+    if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name,
+		 ".data"))
+      break;
+  if (old_data_index == old_file_h->e_shnum)
+    fatal ("Can't find .data in %s.\n", old_name, 0);
+
+  /* Walk through all section headers, insert the new data2 section right 
+     before the new bss section. */
+  for (n = 1, nn = 1; n < (int) old_file_h->e_shnum; n++, nn++)
+    {
+      caddr_t src;
+      /* If it is bss section, insert the new data2 section before it. */
+      if (n == old_bss_index)
+	{
+	  /* Steal the data section header for this data2 section. */
+	  memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index),
+		  new_file_h->e_shentsize);
+	  
+	  NEW_SECTION_H (nn).sh_addr = new_data2_addr;
+	  NEW_SECTION_H (nn).sh_offset = new_data2_offset;
+	  NEW_SECTION_H (nn).sh_size = new_data2_size;
+	  /* Use the bss section's alignment. This will assure that the
+	     new data2 section always be placed in the same spot as the old
+	     bss section by any other application. */
+	  NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign;
+
+	  /* Now copy over what we have in the memory now. */
+	  memcpy (NEW_SECTION_H (nn).sh_offset + new_base, 
+		  (caddr_t) OLD_SECTION_H (n).sh_addr, 
+		  new_data2_size);
+	  nn++;
+	}
+      
+      memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), 
+	      old_file_h->e_shentsize);
+      
+      /* The new bss section's size is zero, and its file offset and virtual
+	 address should be off by NEW_DATA2_SIZE. */
+      if (n == old_bss_index)
+	{
+	  /* NN should be `old_bss_index + 1' at this point. */
+	  NEW_SECTION_H (nn).sh_offset += new_data2_size;
+	  NEW_SECTION_H (nn).sh_addr += new_data2_size;
+	  /* Let the new bss section address alignment be the same as the
+	     section address alignment followed the old bss section, so 
+	     this section will be placed in exactly the same place. */
+	  NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign;
+	  NEW_SECTION_H (nn).sh_size = 0;
+	}
+      /* Any section that was original placed AFTER the bss section should now
+	 be off by NEW_DATA2_SIZE. */
+      else if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset)
+	NEW_SECTION_H (nn).sh_offset += new_data2_size;
+      
+      /* If any section hdr refers to the section after the new .data
+	 section, make it refer to next one because we have inserted 
+	 a new section in between. */
+      
+      PATCH_INDEX (NEW_SECTION_H (nn).sh_link);
+      PATCH_INDEX (NEW_SECTION_H (nn).sh_info);
+      
+      /* Now, start to copy the content of sections. */
+      if (NEW_SECTION_H (nn).sh_type == SHT_NULL
+	  || NEW_SECTION_H (nn).sh_type == SHT_NOBITS)
+	continue;
+      
+      /* Write out the sections. .data and .data1 (and data2, called
+       * ".data" in the strings table) get copied from the current process
+       * instead of the old file.
+       */
+      if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data")
+	  || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
+		      ".data1"))
+	src = (caddr_t) OLD_SECTION_H (n).sh_addr;
+      else
+	src = old_base + OLD_SECTION_H (n).sh_offset;
+      
+      memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src,
+	      NEW_SECTION_H (nn).sh_size);
+
+      /* If it is the symbol table, its st_shndx field needs to be patched. */
+      if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB
+	  || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM)
+	{
+	  Elf32_Shdr *spt = &NEW_SECTION_H (nn);
+	  unsigned int num = spt->sh_size / spt->sh_entsize;
+	  Elf32_Sym * sym = (Elf32_Sym *) (NEW_SECTION_H (nn).sh_offset + 
+					   new_base);
+	  for (; num--; sym++)
+	    {
+	      if ((sym->st_shndx == SHN_UNDEF)
+		  || (sym->st_shndx == SHN_ABS)
+		  || (sym->st_shndx == SHN_COMMON))
+		continue;
+	
+	      PATCH_INDEX (sym->st_shndx);
+	    }
+	}
+    }
+
+  /* Close the files and make the new file executable */
+
+  if (close (old_file))
+    fatal ("Can't close (%s): errno %d\n", old_name, errno);
+
+  if (close (new_file))
+    fatal ("Can't close (%s): errno %d\n", new_name, errno);
+
+  if (stat (new_name, &stat_buf) == -1)
+    fatal ("Can't stat (%s): errno %d\n", new_name, errno);
+
+  n = umask (777);
+  umask (n);
+  stat_buf.st_mode |= 0111 & ~n;
+  if (chmod (new_name, stat_buf.st_mode) == -1)
+    fatal ("Can't chmod (%s): errno %d\n", new_name, errno);
+}
diff --git a/src/crs/unexelfsgi.c b/src/crs/unexelfsgi.c
new file mode 100644
index 000000000..af6a96d80
--- /dev/null
+++ b/src/crs/unexelfsgi.c
@@ -0,0 +1,854 @@
+/* Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992
+   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 program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, 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!  */
+
+
+/*
+ * unexec.c - Convert a running program into an a.out file.
+ *
+ * Author:	Spencer W. Thomas
+ * 		Computer Science Dept.
+ * 		University of Utah
+ * Date:	Tue Mar  2 1982
+ * Modified heavily since then.
+ *
+ * Synopsis:
+ *	unexec (new_name, a_name, data_start, bss_start, entry_address)
+ *	char *new_name, *a_name;
+ *	unsigned data_start, bss_start, entry_address;
+ *
+ * Takes a snapshot of the program and makes an a.out format file in the
+ * file named by the string argument new_name.
+ * If a_name is non-NULL, the symbol table will be taken from the given file.
+ * On some machines, an existing a_name file is required.
+ *
+ * The boundaries within the a.out file may be adjusted with the data_start
+ * and bss_start arguments.  Either or both may be given as 0 for defaults.
+ *
+ * Data_start gives the boundary between the text segment and the data
+ * segment of the program.  The text segment can contain shared, read-only
+ * program code and literal data, while the data segment is always unshared
+ * and unprotected.  Data_start gives the lowest unprotected address.
+ * The value you specify may be rounded down to a suitable boundary
+ * as required by the machine you are using.
+ *
+ * Specifying zero for data_start means the boundary between text and data
+ * should not be the same as when the program was loaded.
+ * If NO_REMAP is defined, the argument data_start is ignored and the
+ * segment boundaries are never changed.
+ *
+ * Bss_start indicates how much of the data segment is to be saved in the
+ * a.out file and restored when the program is executed.  It gives the lowest
+ * unsaved address, and is rounded up to a page boundary.  The default when 0
+ * is given assumes that the entire data segment is to be stored, including
+ * the previous data and bss as well as any additional storage allocated with
+ * break (2).
+ *
+ * The new file is set up to start at entry_address.
+ *
+ * If you make improvements I'd like to get them too.
+ * harpo!utah-cs!thomas, thomas@Utah-20
+ *
+ */
+
+/* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co.
+ * ELF support added.
+ *
+ * Basic theory: the data space of the running process needs to be
+ * dumped to the output file.  Normally we would just enlarge the size
+ * of .data, scooting everything down.  But we can't do that in ELF,
+ * because there is often something between the .data space and the
+ * .bss space.
+ *
+ * In the temacs dump below, notice that the Global Offset Table
+ * (.got) and the Dynamic link data (.dynamic) come between .data1 and
+ * .bss.  It does not work to overlap .data with these fields.
+ *
+ * The solution is to create a new .data segment.  This segment is
+ * filled with data from the current process.  Since the contents of
+ * various sections refer to sections by index, the new .data segment
+ * is made the last in the table to avoid changing any existing index.
+
+ * This is an example of how the section headers are changed.  "Addr"
+ * is a process virtual address.  "Offset" is a file offset.
+
+raid:/nfs/raid/src/dist-18.56/src> dump -h temacs
+
+temacs:
+
+           **** SECTION HEADER TABLE ****
+[No]    Type    Flags   Addr         Offset       Size          Name
+        Link    Info    Adralgn      Entsize
+
+[1]     1       2       0x80480d4    0xd4         0x13          .interp
+        0       0       0x1          0            
+
+[2]     5       2       0x80480e8    0xe8         0x388         .hash
+        3       0       0x4          0x4          
+
+[3]     11      2       0x8048470    0x470        0x7f0         .dynsym
+        4       1       0x4          0x10         
+
+[4]     3       2       0x8048c60    0xc60        0x3ad         .dynstr
+        0       0       0x1          0            
+
+[5]     9       2       0x8049010    0x1010       0x338         .rel.plt
+        3       7       0x4          0x8          
+
+[6]     1       6       0x8049348    0x1348       0x3           .init
+        0       0       0x4          0            
+
+[7]     1       6       0x804934c    0x134c       0x680         .plt
+        0       0       0x4          0x4          
+
+[8]     1       6       0x80499cc    0x19cc       0x3c56f       .text
+        0       0       0x4          0            
+
+[9]     1       6       0x8085f3c    0x3df3c      0x3           .fini
+        0       0       0x4          0            
+
+[10]    1       2       0x8085f40    0x3df40      0x69c         .rodata
+        0       0       0x4          0            
+
+[11]    1       2       0x80865dc    0x3e5dc      0xd51         .rodata1
+        0       0       0x4          0            
+
+[12]    1       3       0x8088330    0x3f330      0x20afc       .data
+        0       0       0x4          0            
+
+[13]    1       3       0x80a8e2c    0x5fe2c      0x89d         .data1
+        0       0       0x4          0            
+
+[14]    1       3       0x80a96cc    0x606cc      0x1a8         .got
+        0       0       0x4          0x4          
+
+[15]    6       3       0x80a9874    0x60874      0x80          .dynamic
+        4       0       0x4          0x8          
+
+[16]    8       3       0x80a98f4    0x608f4      0x449c        .bss
+        0       0       0x4          0            
+
+[17]    2       0       0            0x608f4      0x9b90        .symtab
+        18      371     0x4          0x10         
+
+[18]    3       0       0            0x6a484      0x8526        .strtab
+        0       0       0x1          0            
+
+[19]    3       0       0            0x729aa      0x93          .shstrtab
+        0       0       0x1          0            
+
+[20]    1       0       0            0x72a3d      0x68b7        .comment
+        0       0       0x1          0            
+
+raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs
+
+xemacs:
+
+           **** SECTION HEADER TABLE ****
+[No]    Type    Flags   Addr         Offset       Size          Name
+        Link    Info    Adralgn      Entsize
+
+[1]     1       2       0x80480d4    0xd4         0x13          .interp
+        0       0       0x1          0            
+
+[2]     5       2       0x80480e8    0xe8         0x388         .hash
+        3       0       0x4          0x4          
+
+[3]     11      2       0x8048470    0x470        0x7f0         .dynsym
+        4       1       0x4          0x10         
+
+[4]     3       2       0x8048c60    0xc60        0x3ad         .dynstr
+        0       0       0x1          0            
+
+[5]     9       2       0x8049010    0x1010       0x338         .rel.plt
+        3       7       0x4          0x8          
+
+[6]     1       6       0x8049348    0x1348       0x3           .init
+        0       0       0x4          0            
+
+[7]     1       6       0x804934c    0x134c       0x680         .plt
+        0       0       0x4          0x4          
+
+[8]     1       6       0x80499cc    0x19cc       0x3c56f       .text
+        0       0       0x4          0            
+
+[9]     1       6       0x8085f3c    0x3df3c      0x3           .fini
+        0       0       0x4          0            
+
+[10]    1       2       0x8085f40    0x3df40      0x69c         .rodata
+        0       0       0x4          0            
+
+[11]    1       2       0x80865dc    0x3e5dc      0xd51         .rodata1
+        0       0       0x4          0            
+
+[12]    1       3       0x8088330    0x3f330      0x20afc       .data
+        0       0       0x4          0            
+
+[13]    1       3       0x80a8e2c    0x5fe2c      0x89d         .data1
+        0       0       0x4          0            
+
+[14]    1       3       0x80a96cc    0x606cc      0x1a8         .got
+        0       0       0x4          0x4          
+
+[15]    6       3       0x80a9874    0x60874      0x80          .dynamic
+        4       0       0x4          0x8          
+
+[16]    8       3       0x80c6800    0x7d800      0             .bss
+        0       0       0x4          0            
+
+[17]    2       0       0            0x7d800      0x9b90        .symtab
+        18      371     0x4          0x10         
+
+[18]    3       0       0            0x87390      0x8526        .strtab
+        0       0       0x1          0            
+
+[19]    3       0       0            0x8f8b6      0x93          .shstrtab
+        0       0       0x1          0            
+
+[20]    1       0       0            0x8f949      0x68b7        .comment
+        0       0       0x1          0            
+
+[21]    1       3       0x80a98f4    0x608f4      0x1cf0c       .data
+        0       0       0x4          0            
+
+ * This is an example of how the file header is changed.  "Shoff" is
+ * the section header offset within the file.  Since that table is
+ * after the new .data section, it is moved.  "Shnum" is the number of
+ * sections, which we increment.
+ *
+ * "Phoff" is the file offset to the program header.  "Phentsize" and
+ * "Shentsz" are the program and section header entries sizes respectively.
+ * These can be larger than the apparent struct sizes.
+
+raid:/nfs/raid/src/dist-18.56/src> dump -f temacs
+
+temacs:
+
+                    **** ELF HEADER ****
+Class        Data       Type         Machine     Version
+Entry        Phoff      Shoff        Flags       Ehsize
+Phentsize    Phnum      Shentsz      Shnum       Shstrndx
+
+1            1          2            3           1
+0x80499cc    0x34       0x792f4      0           0x34
+0x20         5          0x28         21          19
+
+raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs
+
+xemacs:
+
+                    **** ELF HEADER ****
+Class        Data       Type         Machine     Version
+Entry        Phoff      Shoff        Flags       Ehsize
+Phentsize    Phnum      Shentsz      Shnum       Shstrndx
+
+1            1          2            3           1
+0x80499cc    0x34       0x96200      0           0x34
+0x20         5          0x28         22          19
+
+ * These are the program headers.  "Offset" is the file offset to the
+ * segment.  "Vaddr" is the memory load address.  "Filesz" is the
+ * segment size as it appears in the file, and "Memsz" is the size in
+ * memory.  Below, the third segment is the code and the fourth is the
+ * data: the difference between Filesz and Memsz is .bss
+
+raid:/nfs/raid/src/dist-18.56/src> dump -o temacs
+
+temacs:
+ ***** PROGRAM EXECUTION HEADER *****
+Type        Offset      Vaddr       Paddr
+Filesz      Memsz       Flags       Align
+
+6           0x34        0x8048034   0           
+0xa0        0xa0        5           0           
+
+3           0xd4        0           0           
+0x13        0           4           0           
+
+1           0x34        0x8048034   0           
+0x3f2f9     0x3f2f9     5           0x1000      
+
+1           0x3f330     0x8088330   0           
+0x215c4     0x25a60     7           0x1000      
+
+2           0x60874     0x80a9874   0           
+0x80        0           7           0           
+
+raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs
+
+xemacs:
+ ***** PROGRAM EXECUTION HEADER *****
+Type        Offset      Vaddr       Paddr
+Filesz      Memsz       Flags       Align
+
+6           0x34        0x8048034   0           
+0xa0        0xa0        5           0           
+
+3           0xd4        0           0           
+0x13        0           4           0           
+
+1           0x34        0x8048034   0           
+0x3f2f9     0x3f2f9     5           0x1000      
+
+1           0x3f330     0x8088330   0           
+0x3e4d0     0x3e4d0     7           0x1000      
+
+2           0x60874     0x80a9874   0           
+0x80        0           7           0           
+
+
+ */
+
+/* Modified by wtien@urbana.mcd.mot.com of Motorola Inc. 
+ * 
+ * The above mechanism does not work if the unexeced ELF file is being
+ * re-layout by other applications (such as `strip'). All the applications 
+ * that re-layout the internal of ELF will layout all sections in ascending
+ * order of their file offsets. After the re-layout, the data2 section will 
+ * still be the LAST section in the section header vector, but its file offset 
+ * is now being pushed far away down, and causes part of it not to be mapped
+ * in (ie. not covered by the load segment entry in PHDR vector), therefore 
+ * causes the new binary to fail.
+ *
+ * The solution is to modify the unexec algorithm to insert the new data2
+ * section header right before the new bss section header, so their file
+ * offsets will be in the ascending order. Since some of the section's (all 
+ * sections AFTER the bss section) indexes are now changed, we also need to 
+ * modify some fields to make them point to the right sections. This is done 
+ * by macro PATCH_INDEX. All the fields that need to be patched are:
+ * 
+ * 1. ELF header e_shstrndx field.
+ * 2. section header sh_link and sh_info field.
+ * 3. symbol table entry st_shndx field.
+ *
+ * The above example now should look like:
+
+           **** SECTION HEADER TABLE ****
+[No]    Type    Flags   Addr         Offset       Size          Name
+        Link    Info    Adralgn      Entsize
+
+[1]     1       2       0x80480d4    0xd4         0x13          .interp
+        0       0       0x1          0            
+
+[2]     5       2       0x80480e8    0xe8         0x388         .hash
+        3       0       0x4          0x4          
+
+[3]     11      2       0x8048470    0x470        0x7f0         .dynsym
+        4       1       0x4          0x10         
+
+[4]     3       2       0x8048c60    0xc60        0x3ad         .dynstr
+        0       0       0x1          0            
+
+[5]     9       2       0x8049010    0x1010       0x338         .rel.plt
+        3       7       0x4          0x8          
+
+[6]     1       6       0x8049348    0x1348       0x3           .init
+        0       0       0x4          0            
+
+[7]     1       6       0x804934c    0x134c       0x680         .plt
+        0       0       0x4          0x4          
+
+[8]     1       6       0x80499cc    0x19cc       0x3c56f       .text
+        0       0       0x4          0            
+
+[9]     1       6       0x8085f3c    0x3df3c      0x3           .fini
+        0       0       0x4          0            
+
+[10]    1       2       0x8085f40    0x3df40      0x69c         .rodata
+        0       0       0x4          0            
+
+[11]    1       2       0x80865dc    0x3e5dc      0xd51         .rodata1
+        0       0       0x4          0            
+
+[12]    1       3       0x8088330    0x3f330      0x20afc       .data
+        0       0       0x4          0            
+
+[13]    1       3       0x80a8e2c    0x5fe2c      0x89d         .data1
+        0       0       0x4          0            
+
+[14]    1       3       0x80a96cc    0x606cc      0x1a8         .got
+        0       0       0x4          0x4          
+
+[15]    6       3       0x80a9874    0x60874      0x80          .dynamic
+        4       0       0x4          0x8          
+
+[16]    1       3       0x80a98f4    0x608f4      0x1cf0c       .data
+        0       0       0x4          0            
+
+[17]    8       3       0x80c6800    0x7d800      0             .bss
+        0       0       0x4          0            
+
+[18]    2       0       0            0x7d800      0x9b90        .symtab
+        19      371     0x4          0x10         
+
+[19]    3       0       0            0x87390      0x8526        .strtab
+        0       0       0x1          0            
+
+[20]    3       0       0            0x8f8b6      0x93          .shstrtab
+        0       0       0x1          0            
+
+[21]    1       0       0            0x8f949      0x68b7        .comment
+        0       0       0x1          0            
+
+ */
+
+#include <sys/types.h>
+#include <stdio.h>
+#include <sys/stat.h>
+#include <memory.h>
+#include <string.h>
+#include <errno.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <elf.h>
+#include <syms.h> /* for HDRR declaration */
+#include <sys/mman.h>
+
+#ifndef emacs
+#define fatal(a, b, c) fprintf(stderr, a, b, c), exit(1)
+#else
+extern void fatal(char *, ...);
+#endif
+
+/* Get the address of a particular section or program header entry,
+ * accounting for the size of the entries.
+ */
+
+#define OLD_SECTION_H(n) \
+     (*(Elf32_Shdr *) ((byte *) old_section_h + old_file_h->e_shentsize * (n)))
+#define NEW_SECTION_H(n) \
+     (*(Elf32_Shdr *) ((byte *) new_section_h + new_file_h->e_shentsize * (n)))
+#define OLD_PROGRAM_H(n) \
+     (*(Elf32_Phdr *) ((byte *) old_program_h + old_file_h->e_phentsize * (n)))
+#define NEW_PROGRAM_H(n) \
+     (*(Elf32_Phdr *) ((byte *) new_program_h + new_file_h->e_phentsize * (n)))
+
+#define PATCH_INDEX(n) \
+  do { \
+	 if ((n) >= old_bss_index) \
+	   (n)++; } while (0)
+typedef unsigned char byte;
+
+/* Round X up to a multiple of Y.  */
+
+int
+round_up (x, y)
+     int x, y;
+{
+  int rem = x % y;
+  if (rem == 0)
+    return x;
+  return x - rem + y;
+}
+
+/* ****************************************************************
+ * unexec
+ *
+ * driving logic.
+ *
+ * In ELF, this works by replacing the old .bss section with a new
+ * .data section, and inserting an empty .bss immediately afterwards.
+ *
+ */
+void
+unexec (new_name, old_name, data_start, bss_start, entry_address)
+     char *new_name, *old_name;
+     unsigned data_start, bss_start, entry_address;
+{
+  unsigned int bss_end; /* (G. Attardi)	*/
+  int new_file, old_file, new_file_size;
+
+  /* Pointers to the base of the image of the two files.  */
+  caddr_t old_base, new_base;
+
+  /* Pointers to the file, program and section headers for the old and new
+     files.  */
+  Elf32_Ehdr *old_file_h, *new_file_h;
+  Elf32_Phdr *old_program_h, *new_program_h;
+  Elf32_Shdr *old_section_h, *new_section_h;
+
+  /* Point to the section name table in the old file.  */
+  char *old_section_names;
+
+  Elf32_Addr old_bss_addr, new_bss_addr;
+  Elf32_Word old_bss_size, new_data2_size;
+  Elf32_Off  new_data2_offset;
+  Elf32_Addr new_data2_addr;
+
+  int n, nn, old_bss_index, old_data_index, new_data2_index;
+  int old_mdebug_index;
+  struct stat stat_buf;
+
+  /* Open the old file & map it into the address space.  */
+
+  old_file = open (old_name, O_RDONLY);
+
+  if (old_file < 0)
+    fatal ("Can't open %s for reading: errno %d\n", old_name, errno);
+
+  if (fstat (old_file, &stat_buf) == -1)
+    fatal ("Can't fstat(%s): errno %d\n", old_name, errno);
+
+  old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0);
+
+  if (old_base == (caddr_t) -1)
+    fatal ("Can't mmap(%s): errno %d\n", old_name, errno);
+
+#ifdef DEBUG
+  fprintf (stderr, "mmap(%s, %x) -> %x\n", old_name, stat_buf.st_size,
+	   old_base);
+#endif
+
+  /* Get pointers to headers & section names.  */
+
+  old_file_h = (Elf32_Ehdr *) old_base;
+  old_program_h = (Elf32_Phdr *) ((byte *) old_base + old_file_h->e_phoff);
+  old_section_h = (Elf32_Shdr *) ((byte *) old_base + old_file_h->e_shoff);
+  old_section_names
+    = (char *) old_base + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset;
+
+  /* Find the mdebug section, if any.  */
+  for (old_mdebug_index = 1; old_mdebug_index < old_file_h->e_shnum; old_mdebug_index++)
+    {
+#ifdef DEBUG
+      fprintf (stderr, "Looking for .mdebug - found %s\n",
+	       old_section_names + OLD_SECTION_H(old_mdebug_index).sh_name);
+#endif
+      if (!strcmp (old_section_names + OLD_SECTION_H(old_mdebug_index).sh_name,
+		   ".mdebug"))
+	break;
+    }
+  if (old_mdebug_index == old_file_h->e_shnum)
+    old_mdebug_index = -1; /* just means no such section was present */
+
+  /* Find the old .bss section.  Figure out parameters of the new
+     data2 and bss sections.  */
+
+  for (old_bss_index = 1; old_bss_index < old_file_h->e_shnum; old_bss_index++)
+    {
+#ifdef DEBUG
+      fprintf (stderr, "Looking for .bss - found %s\n",
+	       old_section_names + OLD_SECTION_H(old_bss_index).sh_name);
+#endif
+      if (!strcmp (old_section_names + OLD_SECTION_H(old_bss_index).sh_name,
+		   ".bss"))
+	break;
+    }
+  if (old_bss_index == old_file_h->e_shnum)
+    fatal ("Can't find .bss in %s.\n", old_name, 0);
+
+  old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr;
+  old_bss_size = OLD_SECTION_H (old_bss_index).sh_size;
+#if defined(emacs) || !defined(DEBUG)
+  bss_end = (unsigned int) sbrk (0);
+  new_bss_addr = (Elf32_Addr) bss_end;
+#else
+  new_bss_addr = old_bss_addr + old_bss_size + 0x1234;
+#endif
+  new_data2_addr = old_bss_addr;
+  new_data2_size = new_bss_addr - old_bss_addr;
+  new_data2_offset = OLD_SECTION_H (old_bss_index).sh_offset;
+
+#ifdef DEBUG
+  fprintf (stderr, "old_bss_index %d\n", old_bss_index);
+  fprintf (stderr, "old_bss_addr %x\n", old_bss_addr);
+  fprintf (stderr, "old_bss_size %x\n", old_bss_size);
+  fprintf (stderr, "new_bss_addr %x\n", new_bss_addr);
+  fprintf (stderr, "new_data2_addr %x\n", new_data2_addr);
+  fprintf (stderr, "new_data2_size %x\n", new_data2_size);
+  fprintf (stderr, "new_data2_offset %x\n", new_data2_offset);
+#endif
+
+  if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size)
+    fatal (".bss shrank when undumping???\n", 0, 0);
+
+  /* Set the output file to the right size and mmap it.  Set
+     pointers to various interesting objects.  stat_buf still has
+     old_file data.  */
+
+  new_file = open (new_name, O_RDWR | O_CREAT, 0666);
+  if (new_file < 0)
+    fatal ("Can't creat (%s): errno %d\n", new_name, errno);
+
+  new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size;
+
+  if (ftruncate (new_file, new_file_size))
+    fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno);
+
+  new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED,
+		   new_file, 0);
+
+  if (new_base == (caddr_t) -1)
+    fatal ("Can't mmap (%s): errno %d\n", new_name, errno);
+
+  new_file_h = (Elf32_Ehdr *) new_base;
+  new_program_h = (Elf32_Phdr *) ((byte *) new_base + old_file_h->e_phoff);
+  new_section_h
+    = (Elf32_Shdr *) ((byte *) new_base + old_file_h->e_shoff
+		      + new_data2_size);
+
+  /* Make our new file, program and section headers as copies of the
+     originals.  */
+
+  memcpy (new_file_h, old_file_h, old_file_h->e_ehsize);
+  memcpy (new_program_h, old_program_h,
+	  old_file_h->e_phnum * old_file_h->e_phentsize);
+
+  /* Modify the e_shstrndx if necessary. */
+  PATCH_INDEX (new_file_h->e_shstrndx);
+
+  /* Fix up file header.  We'll add one section.  Section header is
+     further away now.  */
+
+  new_file_h->e_shoff += new_data2_size;
+  new_file_h->e_shnum += 1;
+
+#ifdef DEBUG
+  fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff);
+  fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum);
+  fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff);
+  fprintf (stderr, "New section count %d\n", new_file_h->e_shnum);
+#endif
+
+  /* Fix up a new program header.  Extend the writable data segment so
+     that the bss area is covered too. Find that segment by looking
+     for a segment that ends just before the .bss area.  Make sure
+     that no segments are above the new .data2.  Put a loop at the end
+     to adjust the offset and address of any segment that is above
+     data2, just in case we decide to allow this later.  */
+
+  for (n = new_file_h->e_phnum - 1; n >= 0; n--)
+    {
+      /* Compute maximum of all requirements for alignment of section.  */
+      int alignment = (NEW_PROGRAM_H (n)).p_align;
+      if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment)
+	alignment = OLD_SECTION_H (old_bss_index).sh_addralign;
+
+      /* Supposedly this condition is okay for the SGI.  */
+#if 0
+      if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr)
+	fatal ("Program segment above .bss in %s\n", old_name, 0);
+#endif
+
+      if (NEW_PROGRAM_H (n).p_type == PT_LOAD
+	  && (round_up ((NEW_PROGRAM_H (n)).p_vaddr
+			+ (NEW_PROGRAM_H (n)).p_filesz,
+			alignment)
+	      == round_up (old_bss_addr, alignment)))
+	break;
+    }
+  if (n < 0)
+    fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0);
+
+  NEW_PROGRAM_H (n).p_filesz += new_data2_size;
+  NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz;
+
+#if 1 /* Maybe allow section after data2 - does this ever happen?  */
+  for (n = new_file_h->e_phnum - 1; n >= 0; n--)
+    {
+      if (NEW_PROGRAM_H (n).p_vaddr
+	  && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr)
+	NEW_PROGRAM_H (n).p_vaddr += new_data2_size - old_bss_size;
+
+      if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset)
+	NEW_PROGRAM_H (n).p_offset += new_data2_size;
+    }
+#endif
+
+  /* Fix up section headers based on new .data2 section.  Any section
+     whose offset or virtual address is after the new .data2 section
+     gets its value adjusted.  .bss size becomes zero and new address
+     is set.  data2 section header gets added by copying the existing
+     .data header and modifying the offset, address and size.  */
+  for (old_data_index = 1; old_data_index < old_file_h->e_shnum;
+       old_data_index++)
+    if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name,
+		 ".data"))
+      break;
+  if (old_data_index == old_file_h->e_shnum)
+    fatal ("Can't find .data in %s.\n", old_name, 0);
+
+  /* Walk through all section headers, insert the new data2 section right 
+     before the new bss section.  */
+  for (n = 1, nn = 1; n < old_file_h->e_shnum; n++, nn++)
+    {
+      caddr_t src;
+      /* If it is bss section, insert the new data2 section before it.  */
+      if (n == old_bss_index)
+	{
+	  /* Steal the data section header for this data2 section.  */
+	  memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index),
+		  new_file_h->e_shentsize);
+	  
+	  NEW_SECTION_H (nn).sh_addr = new_data2_addr;
+	  NEW_SECTION_H (nn).sh_offset = new_data2_offset;
+	  NEW_SECTION_H (nn).sh_size = new_data2_size;
+	  /* Use the bss section's alignment. This will assure that the
+	     new data2 section always be placed in the same spot as the old
+	     bss section by any other application.  */
+	  NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign;
+
+	  /* Now copy over what we have in the memory now.  */
+	  memcpy (NEW_SECTION_H (nn).sh_offset + new_base, 
+		  (caddr_t) OLD_SECTION_H (n).sh_addr, 
+		  new_data2_size);
+	  nn++;
+	}
+      
+      memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), 
+	      old_file_h->e_shentsize);
+      
+      /* The new bss section's size is zero, and its file offset and virtual
+	 address should be off by NEW_DATA2_SIZE.  */
+      if (n == old_bss_index)
+	{
+	  /* NN should be `old_bss_index + 1' at this point. */
+	  NEW_SECTION_H (nn).sh_offset += new_data2_size;
+	  NEW_SECTION_H (nn).sh_addr += new_data2_size;
+	  /* Let the new bss section address alignment be the same as the
+	     section address alignment followed the old bss section, so 
+	     this section will be placed in exactly the same place.  */
+	  NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign;
+	  NEW_SECTION_H (nn).sh_size = 0;
+	}
+      /* Any section that was original placed AFTER the bss section should now
+	 be off by NEW_DATA2_SIZE.  */
+      else if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset)
+	NEW_SECTION_H (nn).sh_offset += new_data2_size;
+      
+      /* If any section hdr refers to the section after the new .data
+	 section, make it refer to next one because we have inserted 
+	 a new section in between.  */
+      
+      PATCH_INDEX (NEW_SECTION_H (nn).sh_link);
+      /* For symbol tables, info is a symbol table index,
+	 so don't change it.  */
+      if (NEW_SECTION_H (nn).sh_type != SHT_SYMTAB
+	  && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM)
+	PATCH_INDEX (NEW_SECTION_H (nn).sh_info);
+      
+      /* Now, start to copy the content of sections. */
+      if (NEW_SECTION_H (nn).sh_type == SHT_NULL
+	  || NEW_SECTION_H (nn).sh_type == SHT_NOBITS)
+	continue;
+      
+      /* Write out the sections. .data and .data1 (and data2, called
+	 ".data" in the strings table) get copied from the current process
+	 instead of the old file.  */
+      if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data")
+	  || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
+		      ".data1"))
+	src = (caddr_t) OLD_SECTION_H (n).sh_addr;
+      else
+	src = old_base + OLD_SECTION_H (n).sh_offset;
+      
+      memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src,
+	      NEW_SECTION_H (nn).sh_size);
+
+      /* Adjust  the HDRR offsets in .mdebug and copy the 
+	 line data if it's in its usual 'hole' in the object.
+	 Makes the new file debuggable with dbx.
+	 patches up two problems: the absolute file offsets
+	 in the HDRR record of .mdebug (see /usr/include/syms.h), and
+	 the ld bug that gets the line table in a hole in the
+	 elf file rather than in the .mdebug section proper.
+	 David Anderson. davea@sgi.com  Jan 16,1994.  */
+      if (n == old_mdebug_index)
+	{
+#define MDEBUGADJUST(__ct,__fileaddr)		\
+  if (n_phdrr->__ct > 0)			\
+    {						\
+      n_phdrr->__fileaddr += movement;		\
+    }
+
+	HDRR * o_phdrr = (HDRR *)((byte *)old_base + OLD_SECTION_H (n).sh_offset);
+	HDRR * n_phdrr = (HDRR *)((byte *)new_base + NEW_SECTION_H (nn).sh_offset);
+	unsigned movement = new_data2_size;
+
+	MDEBUGADJUST (idnMax, cbDnOffset);
+	MDEBUGADJUST (ipdMax, cbPdOffset);
+	MDEBUGADJUST (isymMax, cbSymOffset);
+	MDEBUGADJUST (ioptMax, cbOptOffset);
+	MDEBUGADJUST (iauxMax, cbAuxOffset);
+	MDEBUGADJUST (issMax, cbSsOffset);
+	MDEBUGADJUST (issExtMax, cbSsExtOffset);
+	MDEBUGADJUST (ifdMax, cbFdOffset);
+	MDEBUGADJUST (crfd, cbRfdOffset);
+	MDEBUGADJUST (iextMax, cbExtOffset);
+	/* The Line Section, being possible off in a hole of the object,
+	   requires special handling.  */
+	if (n_phdrr->cbLine > 0)
+	  {
+	    if (o_phdrr->cbLineOffset > (OLD_SECTION_H (n).sh_offset
+					 + OLD_SECTION_H (n).sh_size))
+	      {
+		/* line data is in a hole in elf. do special copy and adjust
+		   for this ld mistake.
+		   */
+		n_phdrr->cbLineOffset += movement;
+
+		memcpy (n_phdrr->cbLineOffset + new_base,
+			o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine);
+	      }
+	    else
+	      {
+		/* somehow line data is in .mdebug as it is supposed to be.  */
+		MDEBUGADJUST (cbLine, cbLineOffset);
+	      }
+	  }
+      }
+
+      /* If it is the symbol table, its st_shndx field needs to be patched. */
+      if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB
+	  || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM)
+	{
+	  Elf32_Shdr *spt = &NEW_SECTION_H (nn);
+	  unsigned int num = spt->sh_size / spt->sh_entsize;
+	  Elf32_Sym * sym = (Elf32_Sym *) (NEW_SECTION_H (nn).sh_offset
+					   + new_base);
+	  for (; num--; sym++)
+	    {
+	      if (sym->st_shndx == SHN_UNDEF
+		  || sym->st_shndx == SHN_ABS
+		  || sym->st_shndx == SHN_COMMON)
+		continue;
+	
+	      PATCH_INDEX (sym->st_shndx);
+	    }
+	}
+    }
+
+  /* Close the files and make the new file executable.  */
+
+  if (close (old_file))
+    fatal ("Can't close (%s): errno %d\n", old_name, errno);
+
+  if (close (new_file))
+    fatal ("Can't close (%s): errno %d\n", new_name, errno);
+
+  if (stat (new_name, &stat_buf) == -1)
+    fatal ("Can't stat (%s): errno %d\n", new_name, errno);
+
+  n = umask (777);
+  umask (n);
+  stat_buf.st_mode |= 0111 & ~n;
+  if (chmod (new_name, stat_buf.st_mode) == -1)
+    fatal ("Can't chmod (%s): errno %d\n", new_name, errno);
+}
diff --git a/src/crs/unexfx2800.c b/src/crs/unexfx2800.c
new file mode 100644
index 000000000..89e14e678
--- /dev/null
+++ b/src/crs/unexfx2800.c
@@ -0,0 +1,16 @@
+/* Unexec for the Alliant FX/2800.  */
+
+#include <stdio.h>
+
+unexec (new_name, a_name, data_start, bss_start, entry_address)
+     char *new_name, *a_name;
+     unsigned data_start, bss_start, entry_address;
+{
+  int stat;
+    
+  stat = elf_write_modified_data (a_name, new_name);
+  if (stat < 0)
+    perror ("emacs: elf_write_modified_data");
+  else if (stat > 0)
+    fprintf (stderr, "Unspecified error from elf_write_modified_data.\n");
+}
diff --git a/src/crs/unexhp9k800.c b/src/crs/unexhp9k800.c
new file mode 100644
index 000000000..c7902f1e9
--- /dev/null
+++ b/src/crs/unexhp9k800.c
@@ -0,0 +1,297 @@
+/* Unexec for HP 9000 Series 800 machines.
+   Bob Desinger <hpsemc!bd@hplabs.hp.com>
+
+   Note that the GNU project considers support for HP operation a
+   peripheral activity which should not be allowed to divert effort
+   from development of the GNU system.  Changes in this code will be
+   installed when users send them in, but aside from that we don't
+   plan to think about it, or about whether other Emacs maintenance
+   might break it.
+
+
+  Unexec creates a copy of the old a.out file, and replaces the old data
+  area with the current data area.  When the new file is executed, the
+  process will see the same data structures and data values that the
+  original process had when unexec was called.
+  
+  Unlike other versions of unexec, this one copies symbol table and
+  debug information to the new a.out file.  Thus, the new a.out file
+  may be debugged with symbolic debuggers.
+  
+  If you fix any bugs in this, I'd like to incorporate your fixes.
+  Send them to uunet!hpda!hpsemc!jmorris or jmorris%hpsemc@hplabs.HP.COM.
+  
+  CAVEATS:
+  This routine saves the current value of all static and external
+  variables.  This means that any data structure that needs to be
+  initialized must be explicitly reset.  Variables will not have their
+  expected default values.
+  
+  Unfortunately, the HP-UX signal handler has internal initialization
+  flags which are not explicitly reset.  Thus, for signals to work in
+  conjunction with this routine, the following code must executed when
+  the new process starts up.
+  
+  void _sigreturn();
+  ...
+  sigsetreturn(_sigreturn);
+*/
+
+#include <stdio.h>
+#include <fcntl.h>
+#include <errno.h>
+
+#include <a.out.h>
+
+#define NBPG 2048
+#define roundup(x,n) ( ( (x)+(n-1) ) & ~(n-1) )  /* n is power of 2 */
+#define min(x,y)  ( ((x)<(y))?(x):(y) )
+
+
+/* Create a new a.out file, same as old but with current data space */
+
+unexec(new_name, old_name, new_end_of_text, dummy1, dummy2)
+     char new_name[];		/* name of the new a.out file to be created */
+     char old_name[];		/* name of the old a.out file */
+     char *new_end_of_text;	/* ptr to new edata/etext; NOT USED YET */
+     int dummy1, dummy2;	/* not used by emacs */
+{
+  int old, new;
+  int old_size, new_size;
+  struct header hdr;
+  struct som_exec_auxhdr auxhdr;
+  long i;
+  
+  /* For the greatest flexibility, should create a temporary file in
+     the same directory as the new file.  When everything is complete,
+     rename the temp file to the new name.
+     This way, a program could update its own a.out file even while
+     it is still executing.  If problems occur, everything is still
+     intact.  NOT implemented.  */
+  
+  /* Open the input and output a.out files */
+  old = open(old_name, O_RDONLY);
+  if (old < 0)
+    { perror(old_name); exit(1); }
+  new = open(new_name, O_CREAT|O_RDWR|O_TRUNC, 0777);
+  if (new < 0)
+    { perror(new_name); exit(1); }
+  
+  /* Read the old headers */
+  read_header(old, &hdr, &auxhdr);
+  
+  /* Decide how large the new and old data areas are */
+  old_size = auxhdr.exec_dsize;
+  /* I suspect these two statements are separate
+     to avoid a compiler bug in hpux version 8.  */
+  i = sbrk (0);
+  new_size = i - auxhdr.exec_dmem;
+  
+  /* Copy the old file to the new, up to the data space */
+  lseek(old, 0, 0);
+  copy_file(old, new, auxhdr.exec_dfile);
+  
+  /* Skip the old data segment and write a new one */
+  lseek(old, old_size, 1);
+  save_data_space(new, &hdr, &auxhdr, new_size);
+  
+  /* Copy the rest of the file */
+  copy_rest(old, new);
+  
+  /* Update file pointers since we probably changed size of data area */
+  update_file_ptrs(new, &hdr, &auxhdr, auxhdr.exec_dfile, new_size-old_size);
+  
+  /* Save the modified header */
+  write_header(new, &hdr, &auxhdr);
+  
+  /* Close the binary file */
+  close(old);
+  close(new);
+  return 0;
+}
+
+/* Save current data space in the file, update header.  */
+
+save_data_space(file, hdr, auxhdr, size)
+     int file;
+     struct header *hdr;
+     struct som_exec_auxhdr *auxhdr;
+     int size;
+{
+  /* Write the entire data space out to the file */
+  if (write(file, auxhdr->exec_dmem, size) != size)
+    { perror("Can't save new data space"); exit(1); }
+  
+  /* Update the header to reflect the new data size */
+  auxhdr->exec_dsize = size;
+  auxhdr->exec_bsize = 0;
+}
+
+/* Update the values of file pointers when something is inserted.  */
+
+update_file_ptrs(file, hdr, auxhdr, location, offset)
+     int file;
+     struct header *hdr;
+     struct som_exec_auxhdr *auxhdr;
+     unsigned int location;
+     int offset;
+{
+  struct subspace_dictionary_record subspace;
+  int i;
+  
+  /* Increase the overall size of the module */
+  hdr->som_length += offset;
+  
+  /* Update the various file pointers in the header */
+#define update(ptr) if (ptr > location) ptr = ptr + offset
+  update(hdr->aux_header_location);
+  update(hdr->space_strings_location);
+  update(hdr->init_array_location);
+  update(hdr->compiler_location);
+  update(hdr->symbol_location);
+  update(hdr->fixup_request_location);
+  update(hdr->symbol_strings_location);
+  update(hdr->unloadable_sp_location);
+  update(auxhdr->exec_tfile);
+  update(auxhdr->exec_dfile);
+  
+  /* Do for each subspace dictionary entry */
+  lseek(file, hdr->subspace_location, 0);
+  for (i = 0; i < hdr->subspace_total; i++)
+    {
+      if (read(file, &subspace, sizeof(subspace)) != sizeof(subspace))
+	{ perror("Can't read subspace record"); exit(1); }
+      
+      /* If subspace has a file location, update it */
+      if (subspace.initialization_length > 0 
+	  && subspace.file_loc_init_value > location)
+	{
+	  subspace.file_loc_init_value += offset;
+	  lseek(file, -sizeof(subspace), 1);
+	  if (write(file, &subspace, sizeof(subspace)) != sizeof(subspace))
+	    { perror("Can't update subspace record"); exit(1); }
+	}
+    } 
+  
+  /* Do for each initialization pointer record */
+  /* (I don't think it applies to executable files, only relocatables) */
+#undef update
+}
+
+/* Read in the header records from an a.out file.  */
+
+read_header(file, hdr, auxhdr)
+     int file;
+     struct header *hdr;
+     struct som_exec_auxhdr *auxhdr;
+{
+  
+  /* Read the header in */
+  lseek(file, 0, 0);
+  if (read(file, hdr, sizeof(*hdr)) != sizeof(*hdr))
+    { perror("Couldn't read header from a.out file"); exit(1); }
+  
+  if (hdr->a_magic != EXEC_MAGIC && hdr->a_magic != SHARE_MAGIC
+      &&  hdr->a_magic != DEMAND_MAGIC)
+    {
+      fprintf(stderr, "a.out file doesn't have legal magic number\n"); 
+      exit(1);  
+    }
+  
+  lseek(file, hdr->aux_header_location, 0);
+  if (read(file, auxhdr, sizeof(*auxhdr)) != sizeof(*auxhdr))
+    {
+      perror("Couldn't read auxiliary header from a.out file");
+      exit(1);
+    }  
+}
+
+/* Write out the header records into an a.out file.  */
+
+write_header(file, hdr, auxhdr)
+     int file;
+     struct header *hdr;
+     struct som_exec_auxhdr *auxhdr;
+{
+  /* Update the checksum */
+  hdr->checksum = calculate_checksum(hdr);
+  
+  /* Write the header back into the a.out file */
+  lseek(file, 0, 0);
+  if (write(file, hdr, sizeof(*hdr)) != sizeof(*hdr))
+    { perror("Couldn't write header to a.out file"); exit(1); }
+  lseek(file, hdr->aux_header_location, 0);
+  if (write(file, auxhdr, sizeof(*auxhdr)) != sizeof(*auxhdr))
+    { perror("Couldn't write auxiliary header to a.out file"); exit(1); }
+}
+
+/* Calculate the checksum of a SOM header record. */
+
+calculate_checksum(hdr)
+     struct header *hdr;
+{
+  int checksum, i, *ptr;
+  
+  checksum = 0;  ptr = (int *) hdr;
+  
+  for (i=0; i<sizeof(*hdr)/sizeof(int)-1; i++)
+    checksum ^= ptr[i];
+  
+  return(checksum);
+}
+
+/* Copy size bytes from the old file to the new one.  */
+
+copy_file(old, new, size)
+     int new, old;
+     int size;
+{
+  int len;
+  int buffer[8196];  /* word aligned will be faster */
+  
+  for (; size > 0; size -= len)
+    {
+      len = min(size, sizeof(buffer));
+      if (read(old, buffer, len) != len)
+	{ perror("Read failure on a.out file"); exit(1); }
+      if (write(new, buffer, len) != len)
+	{ perror("Write failure in a.out file"); exit(1); }
+    }
+}
+
+/* Copy the rest of the file, up to EOF.  */
+
+copy_rest(old, new)
+     int new, old;
+{
+  int buffer[4096];
+  int len;
+  
+  /* Copy bytes until end of file or error */
+  while ( (len = read(old, buffer, sizeof(buffer))) > 0)
+    if (write(new, buffer, len) != len) break;
+  
+  if (len != 0)
+    { perror("Unable to copy the rest of the file"); exit(1); }
+}
+
+#ifdef	DEBUG
+display_header(hdr, auxhdr)
+     struct header *hdr;
+     struct som_exec_auxhdr *auxhdr;
+{
+  /* Display the header information (debug) */
+  printf("\n\nFILE HEADER\n");
+  printf("magic number %d \n", hdr->a_magic); 
+  printf("text loc %.8x   size %d \n", auxhdr->exec_tmem, auxhdr->exec_tsize);
+  printf("data loc %.8x   size %d \n", auxhdr->exec_dmem, auxhdr->exec_dsize);
+  printf("entry     %x \n",   auxhdr->exec_entry);
+  printf("Bss  segment size %u\n", auxhdr->exec_bsize);
+  printf("\n");
+  printf("data file loc %d    size %d\n",
+	 auxhdr->exec_dfile, auxhdr->exec_dsize);
+  printf("som_length %d\n", hdr->som_length);
+  printf("unloadable sploc %d    size %d\n",
+	 hdr->unloadable_sp_location, hdr->unloadable_sp_size);
+}
+#endif /* DEBUG */
diff --git a/src/crs/unexmips.c b/src/crs/unexmips.c
new file mode 100644
index 000000000..ec5fa0563
--- /dev/null
+++ b/src/crs/unexmips.c
@@ -0,0 +1,319 @@
+/* Unexec for MIPS (including IRIS4D).
+   Note that the GNU project considers support for MIPS operation
+   a peripheral activity which should not be allowed to divert effort
+   from development of the GNU system.  Changes in this code will be
+   installed when users send them in, but aside from that
+   we don't plan to think about it, or about whether other Emacs
+   maintenance might break it.
+
+   Copyright (C) 1988 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs 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 1, or (at your option)
+any later version.
+
+GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+/* Modified by G. Attardi (attardi@di.unipi.it), Jan. 1994
+   for using <stdarg.h> instead of <vararg.h>		*/
+
+
+#include <config.h>
+#include <sys/types.h>
+#include <sys/file.h>
+#include <sys/stat.h>
+#include <stdio.h>
+#include <filehdr.h>
+#include <aouthdr.h>
+#include <scnhdr.h>
+#include <sym.h>
+
+#if defined (IRIS_4D) || defined (sony)
+#include "getpagesize.h"
+#include <fcntl.h>
+#endif
+
+#define TEXT_START 0x400000
+
+static void fatal_unexec (char *, ...);
+static void mark_x ();
+
+#define READ(_fd, _buffer, _size, _error_message, _error_arg) \
+	errno = EEOF; \
+	if (read (_fd, _buffer, _size) != _size) \
+	  fatal_unexec (_error_message, _error_arg);
+
+#define WRITE(_fd, _buffer, _size, _error_message, _error_arg) \
+	if (write (_fd, _buffer, _size) != _size) \
+	  fatal_unexec (_error_message, _error_arg);
+
+#define SEEK(_fd, _position, _error_message, _error_arg) \
+	errno = EEOF; \
+	if (lseek (_fd, _position, L_SET) != _position) \
+	  fatal_unexec (_error_message, _error_arg);
+
+extern int errno;
+extern int sys_nerr;
+extern char *sys_errlist[];
+#define EEOF -1
+
+static struct scnhdr *text_section;
+static struct scnhdr *init_section;
+static struct scnhdr *finit_section;
+static struct scnhdr *rdata_section;
+static struct scnhdr *data_section;
+static struct scnhdr *lit8_section;
+static struct scnhdr *lit4_section;
+static struct scnhdr *sdata_section;
+static struct scnhdr *sbss_section;
+static struct scnhdr *bss_section;
+
+struct headers {
+    struct filehdr fhdr;
+    struct aouthdr aout;
+    struct scnhdr section[10];
+};
+
+/* Define name of label for entry point for the dumped executable.  */
+
+#ifndef DEFAULT_ENTRY_ADDRESS
+#define DEFAULT_ENTRY_ADDRESS __start
+#endif
+
+unexec (new_name, a_name, data_start, bss_start, entry_address)
+     char *new_name, *a_name;
+     unsigned data_start, bss_start, entry_address;
+{
+  int new, old;
+  int pagesize, brk;
+  int newsyms, symrel;
+  int nread;
+  struct headers hdr;
+  int i;
+  int vaddr, scnptr;
+#define BUFSIZE 8192
+  char buffer[BUFSIZE];
+
+  old = open (a_name, O_RDONLY, 0);
+  if (old < 0) fatal_unexec ("opening %s", a_name);
+
+  new = creat (new_name, 0666);
+  if (new < 0) fatal_unexec ("creating %s", new_name);
+
+  hdr = *((struct headers *)TEXT_START);
+#ifdef MIPS2
+  if (hdr.fhdr.f_magic != MIPSELMAGIC
+      && hdr.fhdr.f_magic != MIPSEBMAGIC
+      && hdr.fhdr.f_magic != (MIPSELMAGIC | 1)
+      && hdr.fhdr.f_magic != (MIPSEBMAGIC | 1))
+    {
+      fprintf (stderr,
+	       "unexec: input file magic number is %x, not %x, %x, %x or %x.\n",
+	       hdr.fhdr.f_magic,
+	       MIPSELMAGIC, MIPSEBMAGIC,
+	       MIPSELMAGIC | 1, MIPSEBMAGIC | 1);
+      exit(1);
+    }
+#else /* not MIPS2 */
+  if (hdr.fhdr.f_magic != MIPSELMAGIC
+      && hdr.fhdr.f_magic != MIPSEBMAGIC)
+    {
+      fprintf (stderr, "unexec: input file magic number is %x, not %x or %x.\n",
+	       hdr.fhdr.f_magic, MIPSELMAGIC, MIPSEBMAGIC);
+      exit (1);
+    }
+#endif /* not MIPS2 */
+  if (hdr.fhdr.f_opthdr != sizeof (hdr.aout))
+    {
+      fprintf (stderr, "unexec: input a.out header is %d bytes, not %d.\n",
+	       hdr.fhdr.f_opthdr, sizeof (hdr.aout));
+      exit (1);
+    }
+  if (hdr.aout.magic != ZMAGIC)
+    {
+      fprintf (stderr, "unexec: input file a.out magic number is %o, not %o.\n",
+	       hdr.aout.magic, ZMAGIC);
+      exit (1);
+    }
+
+#define CHECK_SCNHDR(ptr, name, flags)					\
+  ptr = NULL;								\
+  for (i = 0; i < hdr.fhdr.f_nscns && !ptr; i++)			\
+    if (strcmp (hdr.section[i].s_name, name) == 0)			\
+      {									\
+	if (hdr.section[i].s_flags != flags)				\
+	  fprintf (stderr, "unexec: %x flags (%x expected) in %s section.\n", \
+		   hdr.section[i].s_flags, flags, name);		\
+	ptr = hdr.section + i;						\
+      }									\
+
+  CHECK_SCNHDR (text_section,  _TEXT,  STYP_TEXT);
+  CHECK_SCNHDR (init_section,  _INIT,  STYP_INIT);
+  CHECK_SCNHDR (rdata_section, _RDATA, STYP_RDATA);
+  CHECK_SCNHDR (data_section,  _DATA,  STYP_DATA);
+#ifdef _LIT8
+  CHECK_SCNHDR (lit8_section,  _LIT8,  STYP_LIT8);
+  CHECK_SCNHDR (lit4_section,  _LIT4,  STYP_LIT4);
+#endif /* _LIT8 */
+  CHECK_SCNHDR (sdata_section, _SDATA, STYP_SDATA);
+  CHECK_SCNHDR (sbss_section,  _SBSS,  STYP_SBSS);
+  CHECK_SCNHDR (bss_section,   _BSS,   STYP_BSS);
+#if 0 /* Apparently this error check goes off on irix 3.3,
+	 but it doesn't indicate a real problem.  */
+  if (i != hdr.fhdr.f_nscns)
+    fprintf (stderr, "unexec: %d sections found instead of %d.\n",
+	     i, hdr.fhdr.f_nscns);
+#endif
+
+  text_section->s_scnptr = 0;
+
+  pagesize = getpagesize ();
+  brk = (sbrk (0) + pagesize - 1) & (-pagesize);
+  hdr.aout.dsize = brk - DATA_START;
+  hdr.aout.bsize = 0;
+  if (entry_address == 0)
+    {
+      extern DEFAULT_ENTRY_ADDRESS ();
+      hdr.aout.entry = (unsigned)DEFAULT_ENTRY_ADDRESS;
+    }
+  else
+    hdr.aout.entry = entry_address;
+
+  hdr.aout.bss_start = hdr.aout.data_start + hdr.aout.dsize;
+  rdata_section->s_size = data_start - DATA_START;
+
+  /* Adjust start and virtual addresses of rdata_section, too.  */
+  rdata_section->s_vaddr = DATA_START;
+  rdata_section->s_paddr = DATA_START;
+  rdata_section->s_scnptr = text_section->s_scnptr + hdr.aout.tsize;
+
+  data_section->s_vaddr = data_start;
+  data_section->s_paddr = data_start;
+  data_section->s_size = brk - data_start;
+  data_section->s_scnptr = rdata_section->s_scnptr + rdata_section->s_size;
+  vaddr = data_section->s_vaddr + data_section->s_size;
+  scnptr = data_section->s_scnptr + data_section->s_size;
+  if (lit8_section != NULL)
+    {
+      lit8_section->s_vaddr = vaddr;
+      lit8_section->s_paddr = vaddr;
+      lit8_section->s_size = 0;
+      lit8_section->s_scnptr = scnptr;
+    }
+  if (lit4_section != NULL)
+    {
+      lit4_section->s_vaddr = vaddr;
+      lit4_section->s_paddr = vaddr;
+      lit4_section->s_size = 0;
+      lit4_section->s_scnptr = scnptr;
+    }
+  if (sdata_section != NULL)
+    {
+      sdata_section->s_vaddr = vaddr;
+      sdata_section->s_paddr = vaddr;
+      sdata_section->s_size = 0;
+      sdata_section->s_scnptr = scnptr;
+    }
+  if (sbss_section != NULL)
+    {
+      sbss_section->s_vaddr = vaddr;
+      sbss_section->s_paddr = vaddr;
+      sbss_section->s_size = 0;
+      sbss_section->s_scnptr = scnptr;
+    }
+  if (bss_section != NULL)
+    {
+      bss_section->s_vaddr = vaddr;
+      bss_section->s_paddr = vaddr;
+      bss_section->s_size = 0;
+      bss_section->s_scnptr = scnptr;
+    }
+
+  WRITE (new, TEXT_START, hdr.aout.tsize,
+	 "writing text section to %s", new_name);
+  WRITE (new, DATA_START, hdr.aout.dsize,
+	 "writing data section to %s", new_name);
+
+  SEEK (old, hdr.fhdr.f_symptr, "seeking to start of symbols in %s", a_name);
+  errno = EEOF;
+  nread = read (old, buffer, BUFSIZE);
+  if (nread < sizeof (HDRR)) fatal_unexec ("reading symbols from %s", a_name);
+#define symhdr ((pHDRR)buffer)
+  newsyms = hdr.aout.tsize + hdr.aout.dsize;
+  symrel = newsyms - hdr.fhdr.f_symptr;
+  hdr.fhdr.f_symptr = newsyms;
+  symhdr->cbLineOffset += symrel;
+  symhdr->cbDnOffset += symrel;
+  symhdr->cbPdOffset += symrel;
+  symhdr->cbSymOffset += symrel;
+  symhdr->cbOptOffset += symrel;
+  symhdr->cbAuxOffset += symrel;
+  symhdr->cbSsOffset += symrel;
+  symhdr->cbSsExtOffset += symrel;
+  symhdr->cbFdOffset += symrel;
+  symhdr->cbRfdOffset += symrel;
+  symhdr->cbExtOffset += symrel;
+#undef symhdr
+  do
+    {
+      if (write (new, buffer, nread) != nread)
+	fatal_unexec ("writing symbols to %s", new_name);
+      nread = read (old, buffer, BUFSIZE);
+      if (nread < 0) fatal_unexec ("reading symbols from %s", a_name);
+#undef BUFSIZE
+    } while (nread != 0);
+
+  SEEK (new, 0, "seeking to start of header in %s", new_name);
+  WRITE (new, &hdr, sizeof (hdr),
+	 "writing header of %s", new_name);
+
+  close (old);
+  close (new);
+  mark_x (new_name);
+}
+
+/*
+ * mark_x
+ *
+ * After successfully building the new a.out, mark it executable
+ */
+
+static void
+mark_x (name)
+     char *name;
+{
+  struct stat sbuf;
+  int um = umask (777);
+  umask (um);
+  if (stat (name, &sbuf) < 0)
+    fatal_unexec ("getting protection on %s", name);
+  sbuf.st_mode |= 0111 & ~um;
+  if (chmod (name, sbuf.st_mode) < 0)
+    fatal_unexec ("setting protection on %s", name);
+}
+
+static void
+fatal_unexec (char *s, ...)
+{
+  va_list ap;
+  if (errno == EEOF)
+    fputs ("unexec: unexpected end of file, ", stderr);
+  else if (errno < sys_nerr)
+    fprintf (stderr, "unexec: %s, ", sys_errlist[errno]);
+  else
+    fprintf (stderr, "unexec: error code %d, ", errno);
+  va_start (ap, s);
+  _doprnt (s, ap, stderr);
+  fputs (".\n", stderr);
+  exit (1);
+}
diff --git a/src/crs/unexnext.c b/src/crs/unexnext.c
new file mode 100644
index 000000000..0955dcd7f
--- /dev/null
+++ b/src/crs/unexnext.c
@@ -0,0 +1,468 @@
+/*
+ * unexec for the NeXT Mach environment.
+ *
+ * Bradley Taylor (btaylor@NeXT.COM) 
+ * February 28, 1990
+ * 
+ * Modified by Noritake Yonezawa (yonezawa@cs.uiuc.edu)
+ * July 28, 1991
+ * 
+ * Modified by Noritake Yonezawa (yone@vcdew25.lsi.tmg.nec.CO.JP)
+ * February 16, 1992
+ */
+#undef __STRICT_BSD__
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <mach.h>
+#include <sys/loader.h>
+#include <sys/file.h>
+#include <sys/stat.h>
+#include <libc.h>
+
+#define CEIL(x,quantum) ((((int)(x))+(quantum)-1)&~((quantum)-1))
+
+int malloc_cookie;
+
+#ifndef BIG_HEAP_SIZE
+#define BIG_HEAP_SIZE	0x1000000
+#endif
+
+int                 big_heap = BIG_HEAP_SIZE;
+
+char               *mach_maplimit = 0;
+char               *mach_brkpt = 0;
+
+typedef struct region_t {
+	vm_address_t address;
+	vm_size_t size;
+	vm_prot_t protection;
+	vm_prot_t max_protection;
+	vm_inherit_t inheritance;
+	boolean_t shared;
+	port_t object_name;
+	vm_offset_t offset;
+} region_t;
+
+char *
+my_sbrk(int incr)
+{
+    char               *temp, *ptr;
+    kern_return_t       rtn;
+
+    if (mach_brkpt == 0) {
+	if ((rtn = vm_allocate(task_self(), (vm_address_t *) & mach_brkpt,
+			       big_heap, 1)) != KERN_SUCCESS) {
+	    mach_error("my_sbrk(): vm_allocate() failed", rtn);
+	    return ((char *)-1);
+	}
+	mach_maplimit = mach_brkpt + big_heap;
+    }
+    if (incr == 0) {
+	return (mach_brkpt);
+    } else {
+	ptr = mach_brkpt + incr;
+	if (ptr <= mach_maplimit) {
+	    temp = mach_brkpt;
+	    mach_brkpt = ptr;
+	    return (temp);
+	} else {
+	    fprintf(stderr, "my_sbrk(): no more memory\n");
+	    fflush(stderr);
+	    return ((char *)-1);
+	}
+    }
+}
+
+static void
+grow(
+     struct load_command ***the_commands,
+     unsigned *the_commands_len
+     )
+{
+	if (*the_commands == NULL) {
+		*the_commands_len = 1;
+		*the_commands = malloc(sizeof(*the_commands));
+	} else {
+		(*the_commands_len)++;
+		*the_commands = realloc(*the_commands, 
+					(*the_commands_len *
+					 sizeof(**the_commands)));
+	}
+}
+
+
+static void
+save_command(
+	     struct load_command *command,
+	     struct load_command ***the_commands,
+	     unsigned *the_commands_len
+	     )
+{
+	struct load_command **tmp;
+
+	grow(the_commands, the_commands_len);
+	tmp = &(*the_commands)[*the_commands_len - 1];
+	*tmp = malloc(command->cmdsize);
+	bcopy(command, *tmp, command->cmdsize);
+}
+
+static void
+fatal_unexec(char *format, ...)
+{
+	va_list ap;
+
+	va_start(ap, format);
+	fprintf(stderr, "unexec: ");
+	vfprintf(stderr, format, ap);
+	fprintf(stderr, "\n");
+	va_end(ap);
+}
+
+static int
+read_macho(
+	   int fd,
+	   struct mach_header *the_header,
+	   struct load_command ***the_commands,
+	   unsigned *the_commands_len
+	   )
+{
+	struct load_command command;
+	struct load_command *buf;
+	int i;
+	int size;
+
+	if (read(fd, the_header, sizeof(*the_header)) != sizeof(*the_header)) {
+		fatal_unexec("cannot read macho header");
+		return (0);
+	}
+	for (i = 0; i < the_header->ncmds; i++) {
+		if (read(fd, &command, sizeof(struct load_command)) != 
+		    sizeof(struct load_command)) {
+		  	fatal_unexec("cannot read macho load command header");
+			return (0);
+		}
+		size = command.cmdsize - sizeof(struct load_command);
+		if (size < 0) {
+		  	fatal_unexec("bogus load command size");
+			return (0);
+		}
+		buf = malloc(command.cmdsize);
+		buf->cmd = command.cmd;
+		buf->cmdsize = command.cmdsize;
+		if (read(fd, ((char *)buf + 
+			      sizeof(struct load_command)), 
+			 size) != size) {
+		  	fatal_unexec("cannot read load command data");
+			return (0);
+		}
+		save_command(buf, the_commands, the_commands_len);
+	}
+	return (1);
+}
+
+static int
+filldatagap(
+	    vm_address_t start_address,
+	    vm_size_t *size,
+	    vm_address_t end_address
+	    )
+{
+	vm_address_t address;
+	vm_size_t gapsize;
+
+	address = (start_address + *size);
+	gapsize = end_address - address;
+	*size += gapsize;
+	if (vm_allocate(task_self(), &address, gapsize,
+			FALSE) != KERN_SUCCESS) {
+		fatal_unexec("cannot vm_allocate");
+	        return (0);
+	}
+	return (1);
+}
+
+static int
+get_data_region(
+		vm_address_t *address,
+		vm_size_t *size
+		)
+{
+	region_t region;
+	kern_return_t ret;
+	struct section *sect;
+
+	sect = (struct section *) getsectbyname(SEG_DATA, SECT_DATA);
+	region.address = 0;
+	*address = 0;
+	for (;;) {
+		ret = vm_region(task_self(), 
+				&region.address, 
+				&region.size, 
+				&region.protection, 
+				&region.max_protection, 
+				&region.inheritance,
+				&region.shared, 
+				&region.object_name, 
+				&region.offset);
+		if (ret != KERN_SUCCESS || region.address >= mach_maplimit) {
+			break;
+		}
+		if (*address != 0) {
+			if (region.address > *address + *size) {
+				if (!filldatagap(*address, size, 
+						 region.address)) {
+					return (0);
+				}
+			} 
+			*size += region.size;
+		} else {
+			if (region.address == sect->addr) {
+				*address = region.address;
+				*size = region.size;
+			} 
+		}
+		region.address += region.size;
+	}
+	return (1);
+}
+
+static char *
+my_malloc(
+	  vm_size_t size
+	  )
+{
+	vm_address_t address;
+
+	if (vm_allocate(task_self(), &address, size, TRUE) != KERN_SUCCESS) {
+		return (NULL);
+	}
+	return ((char *)address);
+}
+
+static void
+my_free(
+	char *buf,
+	vm_size_t size
+	)
+{
+	vm_deallocate(task_self(), (vm_address_t)buf, size);
+}
+
+static int
+unexec_doit(
+	    int infd,
+	    int outfd
+	    )
+{
+	int i;
+	struct load_command **the_commands = NULL;
+	unsigned the_commands_len;
+	struct mach_header the_header;
+	int fgrowth;
+	int fdatastart;
+	int fdatasize;
+	int size;
+	int seg;
+	struct stat st;
+	char *buf;
+	vm_address_t data_address;
+	vm_size_t data_size, bss_size;
+
+	struct segment_command *segment;
+	struct section *section;
+
+	if (!read_macho(infd, &the_header, &the_commands, &the_commands_len)) {
+		return (0);
+	}
+
+	if (!get_data_region(&data_address, &data_size)) {
+		return (0);
+	}
+
+
+	/*
+	 * DO NOT USE MALLOC IN THIS SECTION
+	 */
+	{
+		/*
+		 * Fix offsets
+		 */
+		for (i = 0; i < the_commands_len; i++) {
+			switch (the_commands[i]->cmd) {
+			case LC_SEGMENT:
+				segment = ((struct segment_command *)
+					   the_commands[i]);
+				if (strcmp(segment->segname, SEG_DATA) == 0) {
+					data_size = CEIL(mach_brkpt - data_address, getpagesize());
+					bss_size = mach_maplimit - mach_brkpt;
+					fdatastart = segment->fileoff;
+					fdatasize = segment->filesize;
+					fgrowth = (data_size - 
+						   segment->filesize);
+					segment->vmsize = data_size + bss_size;
+					segment->filesize = data_size;
+					section = (struct section *) ((char *) (segment + 1));
+					for (seg = 0; seg < segment->nsects; ++seg, ++section) {
+						if (strcmp(section->sectname, SECT_DATA) == 0) {
+						        section->size = data_size;
+						}
+						else if (strcmp(section->sectname, SECT_BSS) == 0) {
+						        section->addr = data_address + data_size;
+						        section->size = bss_size;
+							section->flags = S_ZEROFILL;
+					}
+						else if (strcmp(section->sectname, SECT_COMMON) == 0) {
+						        section->addr = data_address + data_size + bss_size;
+					}
+					      }
+				}
+                                if (strcmp(segment->segname, SEG_LINKEDIT) == 0) {
+                                        segment->vmaddr += CEIL(fgrowth + bss_size, getpagesize());
+                                        segment->fileoff += fgrowth;
+				}
+				break;
+			case LC_SYMTAB:
+				((struct symtab_command *)
+				 the_commands[i])->symoff += fgrowth;
+				((struct symtab_command *)
+				 the_commands[i])->stroff += fgrowth;
+				break;
+			case LC_SYMSEG:
+				((struct symseg_command *)
+				 the_commands[i])->offset += fgrowth;
+				break;
+			default:
+				break;
+			}
+		}
+		
+		/*
+		 * Write header
+		 */
+		if (write(outfd, &the_header, 
+			  sizeof(the_header)) != sizeof(the_header)) {
+			fatal_unexec("cannot write header");
+			return (0);
+		}
+		
+		/*
+		 * Write commands
+		 */
+		for (i = 0; i < the_commands_len; i++) {
+			if (write(outfd, the_commands[i], 
+				  the_commands[i]->cmdsize) != 
+			    the_commands[i]->cmdsize) {
+			  	fatal_unexec("cannot write commands");
+				return (0);
+			}
+		}
+		
+		/*
+		 * Write original text
+		 */
+		if (lseek(infd, the_header.sizeofcmds + sizeof(the_header), 
+			  L_SET) < 0) {
+		  	fatal_unexec("cannot seek input file");
+			return (0);
+		}
+		size = fdatastart - (sizeof(the_header) + 
+				     the_header.sizeofcmds);
+		buf = my_malloc(size);
+		if (read(infd, buf, size) != size) {
+			my_free(buf, size);
+		  	fatal_unexec("cannot read input file");
+		}
+		if (write(outfd, buf, size) != size) {
+			my_free(buf, size);
+			fatal_unexec("cannot write original text");
+			return (0);
+		}
+		my_free(buf, size);
+		
+		
+		/*
+		 * Write new data
+		 */
+		if (write(outfd, (char *)data_address, 
+			  data_size) != data_size) {
+			fatal_unexec("cannot write new data");
+			return (0);
+		}
+		
+	}
+
+	/*
+	 * OKAY TO USE MALLOC NOW
+	 */
+
+	/*
+	 * Write rest of file
+	 */
+	fstat(infd, &st);
+	if (lseek(infd, fdatasize, L_INCR) < 0) {
+		fatal_unexec("cannot seek input file");
+		return (0);
+	}
+	size = st.st_size - lseek(infd, 0, L_INCR);
+
+	buf = malloc(size);
+	if (read(infd, buf, size) != size) {
+		free(buf);
+		fatal_unexec("cannot read input file");
+		return (0);
+	}
+	if (write(outfd, buf, size) != size) {
+		free(buf);
+		fatal_unexec("cannot write reset of file");
+		return (0);
+	}
+	free(buf);
+	return (1);
+}
+
+void
+unexec(
+       char *outfile,
+       char *infile
+       )
+{
+	int infd;
+	int outfd;
+	char tmpbuf[L_tmpnam];
+	char *tmpfile;
+
+	infd = open(infile, O_RDONLY, 0);
+	if (infd < 0) {
+	  	fatal_unexec("cannot open input file `%s'", infile);
+		exit(1);
+	}
+	
+	tmpnam(tmpbuf);
+	tmpfile = rindex(tmpbuf, '/');
+	if (tmpfile == NULL) {
+		tmpfile = tmpbuf;
+	} else {
+		tmpfile++;
+	}
+	outfd = open(tmpfile, O_WRONLY|O_TRUNC|O_CREAT, 0755);
+	if (outfd < 0) {
+		close(infd);
+		fatal_unexec("cannot open tmp file `%s'", tmpfile);
+		exit(1);
+	}
+	if (!unexec_doit(infd, outfd)) {
+		close(infd);
+		close(outfd);
+		unlink(tmpfile);
+		exit(1);
+	}
+	close(infd);
+	close(outfd);
+	if (rename(tmpfile, outfile) < 0) {
+		unlink(tmpfile);
+		fatal_unexec("cannot rename `%s' to `%s'", tmpfile, outfile);
+		exit(1);
+	}
+}
diff --git a/src/crs/unexsunos4.c b/src/crs/unexsunos4.c
new file mode 100644
index 000000000..664a7db69
--- /dev/null
+++ b/src/crs/unexsunos4.c
@@ -0,0 +1,279 @@
+/* Contributed by Viktor Dukhovni.  */
+/*
+ * Unexec for Berkeley a.out format + SUNOS shared libraries
+ * The unexeced executable contains the __DYNAMIC area from the
+ * original text file,  and then the rest of data + bss + malloced area of
+ * the current process.  (The __DYNAMIC area is at the top of the process
+ * data segment,  we use "data_start" defined externally to mark the start
+ * of the "real" data segment.)
+ *
+ * For programs that want to remap some of the data segment read only
+ * a run_time_remap is provided.  This attempts to remap largest area starting
+ * and ending on page boundaries between "data_start" and "bndry"
+ * For this it to figure out where the text file is located.  A path search
+ * is attempted after trying argv[0] and if all fails we simply do not remap
+ *
+ * One feature of run_time_remap () is mandatory:  reseting the break.
+ *
+ *  Note that we can no longer map data into the text segment,  as this causes
+ *  the __DYNAMIC struct to become read only,  breaking the runtime loader.
+ *  Thus we no longer need to mess with a private crt0.c,  the standard one
+ *  will do just fine,  since environ can live in the writable area between
+ *  __DYNAMIC and data_start,  just make sure that pre-crt0.o (the name
+ *  is somewhat abused here) is loaded first!
+ *
+ */
+#ifdef emacs
+#include <config.h>
+#endif
+
+#include <sys/param.h>
+#include <sys/mman.h>
+#include <sys/file.h>
+#include <sys/stat.h>
+#include <string.h>
+#include <stdio.h>
+#include <a.out.h>
+
+/*
+ * for programs other than emacs
+ * define data_start + initialized here,  and make sure
+ * this object is loaded first!
+ * emacs will define these elsewhere,  and load the object containing
+ * data_start (pre-crt0.o or firstfile.o?) first!
+ * The custom crt0.o *must not* be loaded!
+ */
+#ifndef emacs
+  static int data_start = 0;
+  static int initialized = 0;
+#else
+  extern int initialized;
+  extern unsigned data_start;
+  extern int pureptr;
+#endif
+
+extern char *getenv ();
+static unsigned Brk;
+static struct exec nhdr;
+static int rd_only_len;
+static long cookie;
+
+
+unexec (new_name, a_name, bndry, bss_start, entry) 
+     char *new_name, *a_name;
+     unsigned bndry, bss_start, entry;
+{
+  char buf[PAGSIZ];
+  int fd, new;
+  char *old;
+  struct exec ohdr;		/* Allocate on the stack,  not needed in the next life */
+  struct stat stat;
+
+#ifdef emacs
+  fprintf (stderr, "Used %d bytes of Pure Storage\n", pureptr);
+#endif
+
+  if ((fd = open (a_name, O_RDONLY)) < 0)
+    {
+      fprintf (stderr, "%s: open: ", a_name);
+      perror (a_name);
+      exit (1);
+    }
+  if ((new = open (new_name, O_WRONLY | O_CREAT, 0666)) == -1)
+    {
+      fprintf (stderr, "%s: open: ", a_name);
+      perror (new_name);
+      exit (1);
+    }
+
+  if ((fstat (fd, &stat) == -1))
+    {
+      fprintf (stderr, "%s: ", a_name);
+      perror ("fstat");
+      exit (1);
+    }
+
+  old = (char *)mmap (0, stat.st_size, PROT_READ, MAP_SHARED, fd, 0);
+  if (old == (char *)-1)
+    {
+      fprintf (stderr, "%s: ", a_name);
+      perror ("mmap");
+      exit (1);
+    }
+  close (fd);
+
+  nhdr = ohdr = (*(struct exec *)old);
+
+
+  /*
+   * Remember a magic cookie so we know we've got the right binary
+   * when remapping.
+   */
+  cookie = time (0);
+
+  Brk = sbrk (0);		/* Save the break, it is reset to &_end (by ld.so?) */
+
+  /*
+   * Round up data start to a page boundary (Lose if not a 2 power!)
+   */
+  data_start = ((((int)&data_start) - 1) & ~(N_PAGSIZ (nhdr) - 1)) + N_PAGSIZ (nhdr);
+
+  /*
+   * Round down read only pages to a multiple of the page size
+   */
+  if (bndry)
+    rd_only_len = ((int)bndry & ~(N_PAGSIZ (nhdr) - 1)) - data_start;
+
+#ifndef emacs
+  /* Have to do this some time before dumping the data */
+  initialized = 1;
+#endif
+  
+  /* 
+   * Handle new data and bss sizes and optional new entry point.
+   * No one actually uses bss_start and entry,  but tradition compels
+   * one to support them.
+   * Could complain if bss_start > Brk,  but the caller is *supposed* to know
+   * what she is doing.
+   */
+  nhdr.a_data = (bss_start ? bss_start : Brk) - N_DATADDR (nhdr);
+  nhdr.a_bss  = bss_start ? Brk - bss_start : 0;
+  if (entry) 
+    nhdr.a_entry = entry;
+
+  /*
+   * Write out the text segment with new header
+   * Dynamic executables are ZMAGIC with N_TXTOFF==0 and the header
+   * part of the text segment, but no need to rely on this.
+   * So write the TEXT first,  then go back replace the header.
+   * Doing it in the other order is less general!
+   */
+  lseek (new, N_TXTOFF (nhdr), L_SET);
+  write (new, old + N_TXTOFF (ohdr), N_TXTOFF (ohdr) + ohdr.a_text);
+  lseek (new, 0L, L_SET);
+  write (new, &nhdr, sizeof (nhdr));
+
+  /*
+   * Write out the head of the old data segment from the file not
+   * from core, this has the unresolved __DYNAMIC relocation data
+   * we need to reload
+   */
+  lseek (new, N_DATOFF (nhdr), L_SET);
+  write (new, old + N_DATOFF (ohdr), (int)&data_start - N_DATADDR (ohdr));
+
+  /*
+   * Copy the rest of the data from core
+   */
+  write (new, &data_start, N_BSSADDR (nhdr) - (int)&data_start);
+
+  /*
+   * Copy the symbol table and line numbers
+   */
+  lseek (new, N_TRELOFF (nhdr), L_SET);
+  write (new, old + N_TRELOFF (ohdr), stat.st_size - N_TRELOFF (ohdr));
+
+  fchmod (new, 0755);
+}
+
+void
+run_time_remap (progname)
+     char *progname;
+{
+  char aout[MAXPATHLEN];
+  register char *path, *p;
+
+  /* Just in case */
+  if (!initialized)
+    return;
+
+  /* Restore the break */
+  brk (Brk);
+
+  /*  If nothing to remap:  we are done! */
+  if (rd_only_len == 0)
+    return;
+
+  /*
+   * Attempt to find the executable
+   * First try argv[0],  will almost always succeed as shells tend to give
+   * the full path from the hash list rather than using execvp ()
+   */
+  if (is_it (progname)) 
+    return;
+
+  /*
+   * If argv[0] is a full path and does not exist,  not much sense in
+   * searching further
+   */
+  if (strchr (progname, '/')) 
+    return;
+
+  /*
+   * Try to search for  argv[0] on the PATH
+   */
+  path = getenv ("PATH");
+  if (path == NULL)
+    return;
+
+  while (*path)
+    {
+      /* copy through ':' or end */
+      for (p = aout; *p = *path; ++p, ++path)
+	if (*p == ':')
+	  {
+	    ++path;		/* move past ':' */
+	    break;
+	  }
+      *p++ = '/';
+      strcpy (p, progname);
+      /*
+       * aout is a candidate full path name
+       */
+      if (is_it (aout))
+	return;
+    }
+}
+
+is_it (path)
+  char *path;
+{
+  int fd;
+  long paths_cookie;
+  struct exec hdr;
+
+  /*
+   * Open an executable  and check for a valid header!
+   * Can't bcmp() the header with what we had,  it may have been stripped!
+   * so we may save looking at non executables with the same name, mostly
+   * directories.
+   */
+  fd = open (path, O_RDONLY);
+  if (fd != -1)
+    {
+      if (read (fd, &hdr, sizeof (hdr)) == sizeof (hdr)
+	  && !N_BADMAG (hdr) && N_DATOFF (hdr) == N_DATOFF (nhdr)
+	  && N_TRELOFF (hdr) == N_TRELOFF (nhdr))
+	{
+	  /* compare cookies */
+	  lseek (fd, N_DATOFF (hdr) + (int)&cookie - N_DATADDR (hdr), L_SET);
+	  read (fd, &paths_cookie, sizeof (paths_cookie));
+	  if (paths_cookie == cookie)
+	    {			/* Eureka */
+
+	      /*
+	       * Do the mapping
+	       * The PROT_EXEC may not be needed,  but it is safer this way.
+	       * should the shared library decide to indirect through
+	       * addresses in the data segment not part of __DYNAMIC
+	       */
+	      mmap (data_start, rd_only_len, PROT_READ | PROT_EXEC,
+		    MAP_SHARED | MAP_FIXED, fd,
+		    N_DATOFF (hdr) + data_start - N_DATADDR (hdr));
+	      close (fd);
+	      return 1;
+	    }
+	}
+      close (fd);
+    }
+  return 0;
+}
diff --git a/src/crs/unixsave.c b/src/crs/unixsave.c
new file mode 100644
index 000000000..cadeeac02
--- /dev/null
+++ b/src/crs/unixsave.c
@@ -0,0 +1,369 @@
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    This program is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+	unixsave.c
+*/
+
+#include "config.h"
+#include "page.h"
+#include "objff.h"
+#include <sys/file.h>
+
+#ifdef COFF
+#  define a_text	tsize
+#  define a_data	dsize
+#  define a_bss		bsize
+#endif
+
+
+#ifdef apollo
+#  define SEGSIZ	65536
+#endif
+
+#ifdef IBMRT
+#  define PAGE_SIZE	2048
+#endif
+
+#ifdef SEQ
+#  define SEGSIZ	2048
+#endif
+
+#ifdef TAHOE
+#  define SEGSIZ	1024
+#endif
+
+#ifdef VAX
+#  define PAGE_SIZE	1024
+#  define SEGSIZ	1024
+#endif
+
+#ifndef TXTRELOC
+#  define TXTRELOC	0
+#endif
+
+filecpy(FILE *to, FILE *from, register int n)
+{
+  char buffer[BUFSIZ];
+
+  while (n > BUFSIZ) {
+    fread(buffer, BUFSIZ, 1, from);
+    fwrite(buffer, BUFSIZ, 1, to);
+    n -= BUFSIZ;
+  }
+  if (n > 0) {
+    fread(buffer, 1, n, from);
+    fwrite(buffer, 1, n, to);
+  }
+}
+
+#define ADJUST(field) if (field) field += diff
+
+unexec(char *save_file, char *original_file,
+       unsigned data_start, unsigned bss_start, unsigned entry_address)
+{
+#ifdef AOUT
+	struct exec header;
+#endif AOUT
+#ifdef COFF
+	FILHDR fileheader;
+	AOUTHDR header;
+	SCNHDR sectionheader;
+	long diff, text_scnptr;
+#endif COFF
+
+	char *data_begin;
+	int text_size, data_size, bss_size, str_size, data_padding;
+	FILE *original, *save, *standard_error;
+	register int n;
+	register char *p;
+
+	extern char stdin_buf[BUFSIZ], stdout_buf[BUFSIZ];
+
+	_cleanup();
+
+	original = freopen(original_file, OPEN_R, stdin);
+	if (stdin != original || fileno(original) != 0) {
+		fprintf(stderr, "Can't open the original file.\n");
+		exit(1);
+	}
+	setbuf(original, stdin_buf);
+
+#ifndef apollo
+	/* not unlinking the previous executable is a trick since I dont know
+	   how to create a file whose type is COFF (rather then unstruct) */
+	unlink(save_file);
+#endif apollo
+
+#ifdef MSDOS
+	save = fopen(save_file, OPEN_W);
+#else
+	save = freopen(save_file, OPEN_W, stdout);
+#endif
+	chmod(save_file, 0775);
+	setbuf(save, stdout_buf); /* avoid malloc call by fwrite */
+
+/* ---------------------------------------------------------------------- */
+#ifdef AOUT
+/* ---------------------------------------------------------------------- */
+
+# if defined(VAX) || defined(NEWS) || defined(SEQ) || defined(TAHOE)
+#  define N_DATADDR(hdr)  ((TXTRELOC + hdr.a_text+(SEGSIZ-1)) & ~(SEGSIZ-1))
+# elif defined(IBMRT)
+#  define N_DATADDR(hdr)  (TXTRELOC + hdr.a_text);
+# elif defined(hp9000s300)
+#  define N_DATADDR(hdr)  ((hdr.a_magic.file_type == SHARE_MAGIC || \
+			    hdr.a_magic.file_type == DEMAND_MAGIC) ? \
+			    EXEC_ALIGN(hdr.a_text) : hdr.a_text);
+# endif
+
+	n = 3;	/* section count */
+	fread(&header, sizeof(header), 1, original);
+
+	data_begin = (char *)N_DATADDR(header);
+	text_size = N_DATOFF(header) - N_TXTOFF(header);
+	data_size = header.a_data;
+	bss_size = header.a_bss;
+
+	/* The file generated will have:
+	   1. updated header;
+	   2. same text section as original;
+	   3. data section dumped from memory;
+	   4. bss section empty;
+	   5. syms, trel and drel sections as original;
+	   6. strings as original.
+	 */
+	/* Update header before writing */
+	header.a_data = data_end - data_begin;
+# if defined(__linux__) || defined(__EMX__)
+	data_padding = SEGMENT_SIZE - header.a_data % SEGMENT_SIZE;
+	header.a_data += data_padding;
+# endif
+	header.a_bss = 0;
+	fwrite(&header, sizeof(header), 1, save);
+
+# if defined(__linux__) || defined(__EMX__)
+	if (N_MAGIC(header) == QMAGIC)
+	  filecpy(save, original, text_size - sizeof(header));
+	else
+	  filecpy(save, original, text_size + _N_HDROFF(header));
+# elif defined(MSDOS)
+	filecpy(save, original, text_size);
+# elif defined(SEQ)
+	filecpy(save, original, header.a_text - 
+				N_ADDRADJ(header) - sizeof(header));
+# elif defined(hp9000s300)
+	if (header.a_magic.file_type == DEMAND_MAGIC) {
+	  filecpy(save, original, EXEC_PAGESIZE - sizeof(header));
+	  filecpy(save, original, EXEC_ALIGN(header.a_text));}
+        else
+	  filecpy(save, original, header.a_text);
+# elif defined(vax) || defined(NEWS) || defined(IBMRT)
+	if (N_MAGIC(header) == ZMAGIC)
+          filecpy(save, original, PAGE_SIZE - sizeof(header));
+	filecpy(save, original, header.a_text);
+# elif defined(BSD)
+	filecpy(save, original, header.a_text - sizeof(header));
+# endif
+#endif AOUT
+
+/* ---------------------------------------------------------------------- */
+#ifdef COFF
+/* ---------------------------------------------------------------------- */
+	n = 0;	/* section count */
+	fread(&fileheader, sizeof(fileheader), 1, original);
+	fread(&header, sizeof(header), 1, original);
+
+	data_begin = (char *)header.data_start;
+#  ifdef apollo
+	data_begin += FILHSZ + sizeof(header)
+		      + fileheader.f_nscns * sizeof(struct scnhdr);
+#  endif apollo
+	data_size = header.a_data;
+	header.a_data = data_end - data_begin;
+	diff = header.a_data - data_size;
+	fileheader.f_symptr += diff;
+	fwrite(&fileheader, sizeof(fileheader), 1, save);
+
+	header.a_bss = 0;
+#  ifdef apollo
+	header.o_sri += diff;
+	header.o_inlib += diff;
+#  endif apollo
+#  ifdef __mips
+	header.bss_start = header.data_start + header.a_data;
+	/* tsize includes headers which are also loaded into memory */
+#  endif __mips
+
+	fwrite(&header, sizeof(header), 1, save);
+
+	/* .text */
+	fread(&sectionheader, sizeof(sectionheader), 1, original);
+	n++;
+	text_scnptr = sectionheader.s_scnptr;
+	ADJUST(sectionheader.s_relptr);
+	ADJUST(sectionheader.s_lnnoptr);
+	fwrite(&sectionheader, sizeof(sectionheader), 1, save);
+
+#  ifdef apollo
+
+	/* .unwind */
+	fread(&sectionheader, sizeof(sectionheader), 1, original);
+	n++;
+	ADJUST(sectionheader.s_relptr);
+	ADJUST(sectionheader.s_lnnoptr);
+	fwrite(&sectionheader, sizeof(sectionheader), 1, save);
+
+	/* .aptv */
+	fread(&sectionheader, sizeof(sectionheader), 1, original);
+	n++;
+	ADJUST(sectionheader.s_relptr);
+	ADJUST(sectionheader.s_lnnoptr);
+	fwrite(&sectionheader, sizeof(sectionheader), 1, save);
+#  endif apollo
+
+#  ifdef ECOFF
+
+	/* .init */
+	fread(&sectionheader, sizeof(sectionheader), 1, original);
+	n++;
+	fwrite(&sectionheader, sizeof(sectionheader), 1, save);
+
+	/* .data */
+	fread(&sectionheader, sizeof(sectionheader), 1, original);
+	n++;
+	fwrite(&sectionheader, sizeof(sectionheader), 1, save);
+
+	/* .rdata */
+#  else
+	/* .data */
+#  endif ECOFF
+	fread(&sectionheader, sizeof(sectionheader), 1, original);
+	n++;
+	sectionheader.s_size += diff;
+#  ifdef apollo
+	/* the APTV at the beginning of data section has already
+	   been relocated at first initialization.
+	   Avoid doing it again.
+	 */
+	sectionheader.s_nreloc = 0;
+#  endif apollo
+	ADJUST(sectionheader.s_relptr);
+	ADJUST(sectionheader.s_lnnoptr);
+	fwrite(&sectionheader, sizeof(sectionheader), 1, save);
+
+	/* copy all remaining section headers */
+	for (;  n < fileheader.f_nscns;  n++) {
+	  fread(&sectionheader, sizeof(sectionheader), 1, original);
+	  if (strcmp(sectionheader.s_name, ".bss") == 0) {
+	    sectionheader.s_size = header.a_bss;
+	    ADJUST(sectionheader.s_paddr);
+	    ADJUST(sectionheader.s_vaddr);
+	  }
+	  ADJUST(sectionheader.s_scnptr);
+	  ADJUST(sectionheader.s_relptr);
+	  ADJUST(sectionheader.s_lnnoptr);
+	  fwrite(&sectionheader, sizeof(sectionheader), 1, save);
+	}
+
+	/* copy the text section */
+	text_size = header.a_text;
+# ifdef MSDOS
+#  define SECTION_ALIGNMENT 1023
+#  define ADJUST_TEXT_SCNHDR_SIZE
+# endif
+# ifdef SECTION_ALIGNMENT
+	/* Some systems require special alignment
+	   of the sections in the file itself.  */
+	text_size = (text_size + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT;
+# endif
+# ifdef ADJUST_TEXT_SCNHDR_SIZE
+	/* On some machines, `text size' includes all headers.  */
+	text_size -= FILHSZ + AOUTSZ + SCNHSZ * fileheader.f_nscns;
+# endif
+	filecpy(save, original, text_size);
+
+#endif COFF
+/* ---------------------------------------------------------------------- */
+
+	/* write the new data section */
+#if defined(__linux__) || defined(__EMX__)
+	/* The heap starts at a SEGMENT_SIZE boundary */
+	for (n = data_size + bss_size, p = data_begin; n > BUFSIZ ;
+	     n -= BUFSIZ, p += BUFSIZ)
+	  fwrite(p, BUFSIZ, 1, save);
+	if (n > 0)
+	  fwrite(p, 1, n, save);
+	n = SEGMENT_SIZE - (data_size + bss_size) % SEGMENT_SIZE;
+	/* write 0's to fill gap */
+	{ int j; char pad[512];
+	  for (j = n; j > 512 ; j -= 512)
+	    fwrite(&pad, 512, 1, save);
+	  if (j > 0)
+	    fwrite(&pad, 1, j, save);
+	}
+	header.a_data -= data_size + bss_size + n + data_padding;
+	data_begin += data_size + bss_size + n;
+#endif
+	for (n = header.a_data, p = data_begin; n > BUFSIZ ;
+	     n -= BUFSIZ, p += BUFSIZ)
+	  fwrite(p, BUFSIZ, 1, save);
+	if (n > 0)
+	  fwrite(p, 1, n, save);
+
+#if defined(__linux__) || defined(__EMX__)
+	/* pad data section up to SEGMENT_SIZE */
+	{ int j; char pad[512];
+	  for (j = data_padding; j > 512 ; j -= 512)
+	    fwrite(&pad, 512, 1, save);
+	  if (j > 0)
+	    fwrite(&pad, 1, j, save);
+	}
+#endif __EMX__
+
+	/*  skip data section of original file  */
+	fseek(original, data_size, 1);
+
+#ifdef hpux
+	fseek(save, MODCAL_OFFSET(header), 0);
+	header.a_data = data_size;
+	fseek(original, MODCAL_OFFSET(header), 0);
+#endif hpux
+
+#ifdef ECOFF
+	{  HDRR symhdr; 
+
+	   /* copy up to Symbol Table */
+	   filecpy(save, original, N_SYMOFF(fileheader) - ftell(original));
+	   /* update Symbol Table Header */
+	   fread(&symhdr, cbHDRR, 1, original);
+	   ADJUST(symhdr.cbLineOffset);
+	   ADJUST(symhdr.cbDnOffset);
+	   ADJUST(symhdr.cbPdOffset);
+	   ADJUST(symhdr.cbSymOffset);
+	   ADJUST(symhdr.cbOptOffset);
+	   ADJUST(symhdr.cbAuxOffset);
+	   ADJUST(symhdr.cbSsOffset);
+	   ADJUST(symhdr.cbSsExtOffset);
+	   ADJUST(symhdr.cbFdOffset);
+	   ADJUST(symhdr.cbRfdOffset);
+	   ADJUST(symhdr.cbExtOffset);
+
+	   fwrite(&symhdr, cbHDRR, 1, save);
+	 }
+#endif ECOFF
+
+	/* Copy the rest */
+	filecpy(save, original, file_len(original) - ftell(original));
+	fclose(original);
+	fclose(save);
+}
diff --git a/src/doc/BUGS b/src/doc/BUGS
new file mode 100644
index 000000000..123154044
--- /dev/null
+++ b/src/doc/BUGS
@@ -0,0 +1,92 @@
+THINGS IN THIS FILE
+===================
+
+This file documents assumptions which are made throughout the ECLS code. Most
+of them are critical and a lot of code relies on them, some others are very
+localized but in critical points (eval, apply, etc). In general great care
+must be taken so that changes in ECLS do not break these "invariants".
+
+
+REAL BUGS
+=========
+
+* Logical operations do not work well with bignums because of the two's
+  complement representation. Furthermore, #'logcount also fails for fixnums.
+
+* Routines in bind.c do not check length of arguments and may cause buffer
+  overflows.
+
+* The following routines may cause indefinite loops when passed circular
+  lists:
+
+GCC SPECIFICS
+=============
+
+* Stack allocatable arrays of variable size, i.e.,
+
+  int function(int size) {
+    object x[size];
+    ...
+
+* Functions with a variable number of arguments are called with the
+  same protocol as ordinary functions, i.e., the following code is
+  valid
+
+  #in "foo.c"
+  extern int fa(int foo, ...);
+  int test(object x) {
+    faa(1, x);
+  }
+
+  #in "faa.c"
+  int faa(int foo, object x) {
+  ...
+  }
+
+* Arguments of any function can be acessed as elements of an array.
+
+  #in "foo.c"
+  int test(object *x) {
+  ...
+  }
+
+  #in "faa.c"
+  int faa(int foo, object x, ...) {
+  test(&x);
+  }
+
+
+OPERATING SYSTEM
+================
+
+* Stack checks are required in compiled code to make sure recursion
+  does not get too deep. This makes sense in multithreaded code, but
+  do unix-like operating systems really provide no stack protection?
+
+
+ECLS CODE INVARIANTS
+====================
+
+* C structs are aligned at least at 4 bytes, so that Cnil is a valid
+  object pointer.
+
+* "struct symbol" and "struct cons" share fields so that
+  Cnil->c.c_car == Cnil->c.c_cdr == Cnil.
+
+* "struct array", "struct vector", "struct string, "struct bitvector"
+  share a number of fields, such as "*_dim", "*_self", etc.
+
+* Boehm's garbage collector returns pointers with two lower bits set
+  to zero, i.e.,
+
+	((int)GC_malloc(n)) & 3 == 0
+
+* Frame/binding/history stacks cannot be resized.
+
+* DATA_START % LISP_PAGESIZE == 0
+
+
+;;; Local Variables: ***
+;;; mode:text ***
+;;; fill-column:79 ***
+;;; End: ***
diff --git a/src/doc/Makefile.in b/src/doc/Makefile.in
new file mode 100644
index 000000000..e4c1f0239
--- /dev/null
+++ b/src/doc/Makefile.in
@@ -0,0 +1,72 @@
+# file crs/Makefile
+
+top_srcdir= @top_srcdir@
+srcdir	= @srcdir@
+#ifdef MSDOS
+VPATH	= .;@srcdir@
+#else
+VPATH	= @srcdir@
+#endif
+
+infodir = @infodir@
+libdir = @libdir@
+
+INSTALL	= @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+VERSION=@ECLS_VERSION@
+
+HTML = index.html license.html lgpl.html news.html ecls.html benchmark.html \
+	install.html
+
+FILTER = sed 's,@VERSION@,$(VERSION),g'
+
+ECL = ../ecls
+
+all: help.doc ecls.info $(HTML)
+
+ecls.dvi: $(srcdir)/user.txi clisp.sty ecl.sty
+	tex $(srcdir)/user.txi
+
+ecls.ps: ecls.dvi
+	dvips -o $@ ecls.dvi
+
+install: all
+	$(INSTALL_DATA) help.doc $(PREFIX)$(libdir)
+	$(INSTALL_DATA) ecls.info $(PREFIX)$(infodir)
+
+uninstall:
+	rm -r $(infodir)/ecls.info
+
+help.doc: help.lsp
+	$(ECL) < $(srcdir)/help.lsp > /dev/null
+
+ecls.info: $(srcdir)/user.txi
+	makeinfo --no-split $(srcdir)/user.txi
+
+index.html: $(srcdir)/index.in.html
+	cat $(srcdir)/head $? $(srcdir)/end | $(FILTER) > $@
+install.html: $(srcdir)/install.in.html
+	cat $(srcdir)/head $? $(srcdir)/end | $(FILTER) > $@
+news.html: $(srcdir)/news.in.html
+	cat $(srcdir)/head $? $(srcdir)/end | $(FILTER) > $@
+benchmark.html: $(srcdir)/benchmark.in.html ../gabriel/BENCHMARK
+	(cat $(srcdir)/head; \
+	 cat $(srcdir)/benchmark.in.html; \
+	 echo '<pre>'; cat ../gabriel/BENCHMARK; echo '</pre>'; \
+	 cat $(srcdir)/end) | $(FILTER) > $@
+../gabriel/BENCHMARK:
+	cd ../gabriel; make
+license.html: $(top_srcdir)/../Copyright
+	(cat $(srcdir)/head; \
+	 echo '<pre>'; cat $?; echo '</pre>'; \
+	 cat $(srcdir)/end) | $(FILTER) > $@
+lgpl.html: $(top_srcdir)/../LGPL
+	(cat $(srcdir)/head; \
+	 echo '<pre>'; cat $?; echo '</pre>'; \
+	 cat $(srcdir)/end) | $(FILTER) > $@
+ecls.html: $(srcdir)/user.txi
+	makeinfo --html $(srcdir)/user.txi
+clean:
+	rm -f ecls.* help.doc *.html
diff --git a/src/doc/README.html b/src/doc/README.html
new file mode 100644
index 000000000..c16153131
--- /dev/null
+++ b/src/doc/README.html
@@ -0,0 +1,327 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
+<html>
+<head>
+<title>ECL-Spain 0.1a</title>
+</head>
+
+<body>
+<h1>ECL-Spain 0.1a</h1>
+
+<a name="toc"><h2>Table of contents</h2></a>
+<ul>
+<li><a href="#intro">Introduction</a>
+<li><a href="#intro">Project goals</a>
+<li><a href="#news">News</a>
+<li><a href="#bugs">Known bugs</a>
+<li><a href="#distrib">Distribution</a>
+<li><a href="#installing">Installation</a>
+<li><a href="ecls-guide.html">User's guide</a>
+<li><a href="#author">The author</a>
+<li><a href="#bench">Benchmark</a>
+</ul>
+
+<a name="intro"><a href="#toc"><h2>Introduction</h2></a></a>
+
+<a href="http://ecls.sourceforge.net">ECLS</a> stands for <em>Embeddable
+Common-Lisp "Spain"</em>, and I usually read it as "e-klos". It is a an
+implementation of the <a href="http://www.lisp.org">Common-Lisp language</a>
+which aims to comply to the <a
+href="http://www.lisp.org/HyperSpec/FrontMatter/index.html">ANSI X3J13</a>
+definition of the language.
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> combines a bytecodes
+compiler/interpreter and a translator to C.  The first one is specially suited
+for prototyping and debugging. The second one produces fast code that can be
+dynamically loaded into the interpreter or statically linked to build
+standalone executables.
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is distributed under the <a
+href="#copyright">GNU Library General Public License (GNU LGPL)</a>.
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is not a brand new
+product. It has evolved from the EcoLisp implementation by Giusseppe Attardi
+which in turn was based on the Kyoto Common-Lisp implementation done by Taiichi
+Yuasa and Masami Hagiya, with contributions from several people. Nevertheless
+the program has been seriously modified and the current code base bears little
+resemblance to the previous implementations and the author of those
+implementations should not be blamed for the faults of thi <a
+href="http://ecls.sourceforge.net">ECLS</a>.
+
+<a name="goals"><a href="#toc"><h2>Project goals</h2></a></a>
+
+<ul>
+<li><b>To produce a free implementation of Common-Lisp.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is released under the LGPL or
+GNU Library General Public Licence (See <a
+href="Copyright">Copyright</a>). This means that <a
+href="http://ecls.sourceforge.net">ECLS</a> can be used in commercial projects
+while keeping the implementation free.
+
+<li><b>Compliance to the latest ANSI spec.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is already rather standards
+compliant. <a href="http://ecls.sourceforge.net">ECLS</a> was born as a fork
+from the ECL (Eco-Common-Lisp by Giussepe Attardi) which conformed to Cltl2
+("Common-Lisp the Language 2"), but which was shipped with some ANSI
+compatibility extensions. Currently the worst parts with respect to ANSI are
+the LOOP package and parts of CLOS.
+
+<li><b>Small code size.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is made of a runtime library
+and an interpreter. The interpreter itself is small, at most three files of C
+code. Once the lisp environment is booted, it takes about 1Mb of code (although
+currently it is a bit more due to debuggin issues in the interpreter). If the
+whole of <a href="http://ecls.sourceforge.net">ECLS</a> is compiled from lisp
+to C, the resulting program is 1.5Mb. Nevertheless, there is room for
+improvement in this area.
+
+<li><b>Embedability.</b>
+
+<p>In a near future <a href="http://ecls.sourceforge.net">ECLS</a> will be
+shipped as a library that can be linked against arbitrary C
+programs. Currently, arbitrary C code can be linked against <a
+href="http://ecls.sourceforge.net">ECLS</a>, either statically or at runtime.
+
+<li><b>Portability to arbitrary environments.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> currently compiles and runs
+on Linux, FreeBSD 4.x and NetBSD 1.5. Most of the code is portable. The parts
+which change from operating system to operating system are about the
+filesystem, sockets, signals and the allocation of big chunks of memory, but in
+all it is well below 1000 lines. The worst part is related to word-size and
+endianness. Work is in progress to port <a
+href="http://ecls.sourceforge.net">ECLS</a> to 64-bit environments.
+
+<li><b>Compilation via an ANSI C compiler.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> can translate lisp code to C
+code that can be dynamically loaded or linked to the runtime to produce a
+standalone executable. Currently this process relies on GCC as a targed
+platform, but work is in progress to remove GCC dependencies.
+
+<li><b>Better garbage collection.</b>
+
+<p>As of this release the memory that <a
+href="http://ecls.sourceforge.net">ECLS</a> can allocate is restricted to
+16Mb. I have tried replacing the garbage collector with a conservative one
+(Boehm's GC v 4.11) and that did fix the problems, but increases the memory
+requirements of <a href="http://ecls.sourceforge.net">ECLS</a>. Since this is
+really undesirable, I have been also thinking about revamping the current
+garbage collector with an interface to mmap(). Time wil tell...
+
+<li><b>Improve the compiler: more agressive inlining, better operations among
+numbers and unboxed arrays of complex numbers.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> currently can inline all
+operations that involve fixnums, characters and floating point
+numbers. However, the type inferencer is not very powerful and therefore some
+operations are not inlined because the compiler cannot actually tell the types
+of the arguments and of the output.
+</ul>
+
+<a name="news"><a href="#toc"><h2>News in this release (ECLS-0.1a)</h2></a></a>
+
+<ul>
+<li>Due to human errors, the bytecompiler shipped with 0.1a was an
+  unfinished version. In 0.1b we shipped a more polished files. Some
+  of the errors which are fixed are
+  <ul>
+  <li>Produce the right code for TAGBODY inside closures</li>
+  <li>Activate compiler for SYMBOL-MACROLET</li>
+  <li>Allow non-keyword symbols as lambda-list-keywords</li>
+  <li>Allow more than one :ALLOW-OTHER-KEYS to be supplied, but discard other than the first one
+  <li> Process declarations in FLET/LABELS forms
+  </ul>
+
+<li> Fixed the C compiler routines for TAGBODY: it would produce wrong
+  code when jumping out of a closure.
+
+<li> Rewrite the error system using KMP's condition system, CLOS and a
+  rudimentary interface to the toplevel.
+
+<li> Enclosing the bytecompiler in an UNWIND-PROTECT ensures that the
+  status of the compiler and of the interpreter is always consistent.
+
+<li> Port and incorporate Peter Van Eynde's test suite for ANSI
+  compliance.
+
+<li> Replace features ECL/ECL-MIN with ECLS and ECLS-MIN. All references
+  to ECL (Eco-Common-Lisp) should have been dropped by now.
+
+<li> Add simple-program-error and simple-control-error to the hierarchy
+  of conditions, and try to ensure that all routines in libecls.a
+  signal the right type of condition.
+
+<li> Define COMPLEMENT and CONTINOUSLY.
+
+<li> Fix #'= between bignums.
+
+<li> NIL is no longer valid as the first of a pair of bounding index
+  designators, i.e. (nstring-upcase "aa" :start nil :end nil) causes
+  an error.
+</ul>
+
+<a name="bugs"><a href="#toc"><h2>Known bugs</h2></a></a>
+
+As I mentioned above, the problem I am finding here is the lack of test suites
+which I can use to detect failures in the behavior of any function. Currently I
+can assure that <a href="http://ecls.sourceforge.net">ECLS</a> passes most of
+the tests from the <a href="http://clocc.sourceforge.net">the CLOCC suite</a>.
+The most important exceptions are
+<ul>
+<li>CLOS
+<li>#'format
+<li>#'unread-char is too lax
+<li>The CL package is too polluted
+<li>LOOP lacks some of the standard keywords, including destructuring
+<li>Support for logical pathnames is incomplete
+</ul>
+
+If you find something that should be fixed or that the behavior of a
+function is particularly misleading with respect to the standards, feel free
+to tell me so.
+
+Some other bugs which need to be fixed are:
+<ul>
+<li>Threads and sockets haven't been tested yet.
+<li>#'format doesn't pass the Cltl-1 tests and fails when the number of
+arguments is large.
+<li>Needs better support for wildcards in pathnames.
+<li>Bugs in logical operations among bignums.
+<li>Support for CLOS needs yet more optimization.
+</ul>
+
+<a name="distrib"><a href="#toc"><h2>Distribution</h2></a></a>
+
+This project is hosted at <a href="http://ecls.sourceforge.net">Source
+forge</a>. You can get current copies of the sources and of the documentation
+in there.
+
+<a name="installing"><a href="#toc"><h2>Installation</h2></a></a>
+
+<ul>
+<li>Unpack the tar file
+<pre>
+	gunzip -c ecls.tgz | tar xf -
+</pre>
+
+<li>Run the configuration file.
+<pre>
+	cd ecls-0.1a
+	./configure
+</pre>
+The previous step creates a directory with the name <b>build</b>, and
+stores a bunch of makefiles in it.
+
+<li>Use GNU make to invoke the compilation
+<pre>
+	make
+</pre>
+
+<li>If you want to test the fresh new executable before installing. You you
+should invoke ECLS from withing the build directory using the "-dir ./"
+argument to advice him about the right place to find header files, libraries,
+etc.  For instance, under linux the build directory is "linux" and we would do
+<pre>
+	$ ./configure --prefix=$HOME
+	[...]
+	$ cd build
+	$ make
+	[...]
+	$ ./ecls -dir ./
+</pre>
+
+<li>Install it in the desired location
+<pre>
+	make install
+</pre>
+</ul>
+
+<p>As a side note, a --disable-clos is still in ./configure, but its use is
+discouraged and unsupported.
+
+
+<a name="author"><a href="#toc"><h2>The author</h2></a></a>
+
+For the people who built the several pieces from ECoLisp, see the README.orig
+file. To contact the author of <a href="http://ecls.sourceforge.net">ECLS</a>,
+use the following address
+<pre>
+	Juan Jose Garcia Ripoll
+
+	Univ. de Castilla-La Mancha
+	E.T.S.I. Industriales
+	Departamento de Matematicas
+	c/Camilo Jose Cela, 3
+	Ciudad Real, E-13071
+	Spain
+
+	<a href="mailto:jjgarcia@ind-cr.uclm.es">jjgarcia@ind-cr.uclm.es</a>
+</pre>
+
+
+<a name="news"><a href="#toc"><h2>Benchmark</h2></a></a>
+
+Benchmarks should be taken with a grain of salt. <a
+href="http://ecls.sourceforge.net">ECLS</a> does not aim to compete with any
+commercial or open source implementation. The purpose of these benchmarks are,
+thus, to show the progress of <a href="http://ecls.sourceforge.net">ECLS</a>
+itself from version to version.
+
+<p>It also serves to show how well other implementations perform: CLISPc, which
+is based on bytecodes, is astonishingly fast, compared to other bytecodes
+implementations (ECLSi, CMUCLi) and to native code implementations (ECLSc,
+CMUCLc).
+
+<p>All benchmarks are executed one after another. The benchmark currently shows
+just mean execution times in seconds, using English decimal point (0.03 = 3/100
+seconds).  This means that performance of garbage collectors has a deep impact
+in these numbers.
+
+<p>It would be nice to collect some other information, such as memory use and
+garbage collector timings, but that is beyond my reach for now. Help is always
+welcome.
+
+<p>Finally, I have decided to distribute Gabriel's benchmarks together with <a
+href="http://ecls.sourceforge.net">ECLS</a>. The reason is that this code seems
+to belong to public domain and I had to perform several changes in order to let
+it run with different implementations. To recreate the benchmark just get in
+<tt>build/gabriel/</tt> and type <tt>make</tt>.
+
+<pre>
+
+                CLISPi     ECLSi    CMUCLi    CLISPc     ECLSc    CMUCLc
+boyer            2.490    28.283    13.520     0.397     0.767     0.110
+browse           3.116     7.167    13.260     0.459     *****     0.280
+ctak             0.406     0.883     1.530     0.032     0.017     0.000
+dderiv           0.455     1.317     1.850     0.110     0.167     0.080
+deriv            0.405     1.133     1.670     0.111     0.167     0.070
+destru-mod       1.418     0.871     2.398     0.053     0.025     0.025
+destru           1.384     0.871     2.412     0.053     0.025     0.020
+div2             0.889     1.867     3.850     0.132     0.150     0.070
+fprint           0.026     0.046     0.015     0.026     0.042     0.015
+fread            0.009     0.017     0.007     0.009     0.017     0.005
+frpoly           3.026    22.750    15.240     0.625     6.267     0.220
+puzzle           6.452     4.633    14.630     0.481     0.033     0.020
+puzzle-mod       6.890     4.667    14.680     0.480     0.017     0.030
+puzzle-mod2      6.467     4.633    14.690     0.480     0.033     0.030
+stak             0.374     0.842     1.768     0.047     0.021     0.007
+tak              3.394     9.183    11.500     0.208     0.033     0.020
+tak-mod          3.385     9.450    11.520     0.208     0.033     0.020
+takl             1.407     6.433     9.130     0.107     0.000     0.010
+takr             0.346     0.971     2.035     0.026     0.004     0.002
+tprint           0.022     0.046     0.023     0.022     0.046     0.020
+traverse        41.230    71.767   108.390     1.880     1.450     0.370
+triang-mod      74.765   169.750   255.840     7.362     1.567     3.110
+triang          71.018   149.417   243.330     5.797     0.667     *****
+
+IMPLi = Implementation IMPL interpreted
+IMPLc = Implementation IMPL compiled
+
+CLISP = CLISP 2000-03-06 (March 2000)
+CMUCL = CMUCL 18c
+ECLS  = ECLS 0.1a
+
+</pre></body></html>
diff --git a/src/doc/benchmark.in.html b/src/doc/benchmark.in.html
new file mode 100644
index 000000000..9d37718ad
--- /dev/null
+++ b/src/doc/benchmark.in.html
@@ -0,0 +1,27 @@
+<h2>Benchmark</h2>
+
+Benchmarks should be taken with a grain of salt. <a
+href="http://ecls.sourceforge.net">ECLS</a> does not aim to compete with any
+commercial or open source implementation. The purpose of these benchmarks are,
+thus, to show the progress of <a href="http://ecls.sourceforge.net">ECLS</a>
+itself from version to version.
+
+<p>It also serves to show how well other implementations perform: CLISPc, which
+is based on bytecodes, is astonishingly fast, compared to other bytecodes
+implementations (ECLSi, CMUCLi) and to native code implementations (ECLSc,
+CMUCLc).
+
+<p>All benchmarks are executed one after another. The benchmark currently shows
+just mean execution times in seconds, using English decimal point (0.03 = 3/100
+seconds).  This means that performance of garbage collectors has a deep impact
+in these numbers.
+
+<p>It would be nice to collect some other information, such as memory use and
+garbage collector timings, but that is beyond my reach for now. Help is always
+welcome.
+
+<p>Finally, I have decided to distribute Gabriel's benchmarks together with <a
+href="http://ecls.sourceforge.net">ECLS</a>. The reason is that this code seems
+to belong to public domain and I had to perform several changes in order to let
+it run with different implementations. To recreate the benchmark just get in
+<tt>build/gabriel/</tt> and type <tt>make</tt>.
diff --git a/src/doc/download.in.html b/src/doc/download.in.html
new file mode 100644
index 000000000..62fec9cc9
--- /dev/null
+++ b/src/doc/download.in.html
@@ -0,0 +1,7 @@
+<h2>Downloading</h2>
+
+<p>You can always get the latest source-code release at</p>
+<pre>
+	<a href="http://ecls.sourceforge.net/ecls.tgz">http://ecls.sourceforge.net/ecls.tgz</a>
+</pre>
+
diff --git a/src/doc/end b/src/doc/end
new file mode 100644
index 000000000..d2f71b362
--- /dev/null
+++ b/src/doc/end
@@ -0,0 +1,12 @@
+<!-- End text -->
+  <p>&nbsp;</p>
+  </td>
+ </tr>
+</table>
+<table width="100%" align="center">
+<tr><td bgcolor="#EEEEEE" align="right">
+<h1><font color="#EEEEEE"><a href="http://sourceforge.net"><img src="http://sourceforge.net/sflogo.php?group_id=30335" width="88" height="31" border="0" alt="SourceForge Logo"</a></font></h1>
+</td></tr>
+</table>
+</body>
+</html>
diff --git a/src/doc/goals.in.html b/src/doc/goals.in.html
new file mode 100644
index 000000000..aed8b5ba0
--- /dev/null
+++ b/src/doc/goals.in.html
@@ -0,0 +1,101 @@
+<h2>Introduction</h2>
+
+<a href="http://ecls.sourceforge.net">ECLS</a> stands for <em>Embeddable
+Common-Lisp "Spain"</em>, and I usually read it as "e-klos". It is a an
+implementation of the <a href="http://www.lisp.org">Common-Lisp language</a>
+which aims to comply to the <a
+href="http://www.lisp.org/HyperSpec/FrontMatter/index.html">ANSI X3J13</a>
+definition of the language.
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> combines a bytecodes
+compiler/interpreter and a translator to C.  The first one is specially suited
+for prototyping and debugging. The second one produces fast code that can be
+dynamically loaded into the interpreter or statically linked to build
+standalone executables.
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is distributed under the <a
+href="#copyright">GNU Library General Public License (GNU LGPL)</a>.
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is not a brand new
+product. It has evolved from the EcoLisp implementation by Giusseppe Attardi
+which in turn was based on the Kyoto Common-Lisp implementation done by Taiichi
+Yuasa and Masami Hagiya, with contributions from several people. Nevertheless
+the program has been seriously modified and the current code base bears little
+resemblance to the previous implementations and the author of those
+implementations should not be blamed for the faults of thi <a
+href="http://ecls.sourceforge.net">ECLS</a>.
+
+<h2>Project goals</h2>
+
+<ul>
+<li><b>To produce a free implementation of Common-Lisp.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is released under the LGPL or
+GNU Library General Public Licence (See <a
+href="license.html">Copyright</a>). This means that <a
+href="http://ecls.sourceforge.net">ECLS</a> can be used in commercial projects
+while keeping the implementation free.
+
+<li><b>Compliance to the latest ANSI spec.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is already rather standards
+compliant. <a href="http://ecls.sourceforge.net">ECLS</a> was born as a fork
+from the ECL (Eco-Common-Lisp by Giussepe Attardi) which conformed to Cltl2
+("Common-Lisp the Language 2"), but which was shipped with some ANSI
+compatibility extensions. Currently the worst parts with respect to ANSI are
+the LOOP package and parts of CLOS.
+
+<li><b>Small code size.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> is made of a runtime library
+and an interpreter. The interpreter itself is small, at most three files of C
+code. Once the lisp environment is booted, it takes about 1Mb of code (although
+currently it is a bit more due to debuggin issues in the interpreter). If the
+whole of <a href="http://ecls.sourceforge.net">ECLS</a> is compiled from lisp
+to C, the resulting program is 1.5Mb. Nevertheless, there is room for
+improvement in this area.
+
+<li><b>Embedability.</b>
+
+<p>In a near future <a href="http://ecls.sourceforge.net">ECLS</a> will be
+shipped as a library that can be linked against arbitrary C
+programs. Currently, arbitrary C code can be linked against <a
+href="http://ecls.sourceforge.net">ECLS</a>, either statically or at runtime.
+
+<li><b>Portability to arbitrary environments.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> currently compiles and runs
+on Linux, FreeBSD 4.x and NetBSD 1.5. Most of the code is portable. The parts
+which change from operating system to operating system are about the
+filesystem, sockets, signals and the allocation of big chunks of memory, but in
+all it is well below 1000 lines. The worst part is related to word-size and
+endianness. Work is in progress to port <a
+href="http://ecls.sourceforge.net">ECLS</a> to 64-bit environments.
+
+<li><b>Compilation via an ANSI C compiler.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> can translate lisp code to C
+code that can be dynamically loaded or linked to the runtime to produce a
+standalone executable. Currently this process relies on GCC as a targed
+platform, but work is in progress to remove GCC dependencies.
+
+<li><b>Better garbage collection.</b>
+
+<p>As of this release the memory that <a
+href="http://ecls.sourceforge.net">ECLS</a> can allocate is restricted to
+16Mb. I have tried replacing the garbage collector with a conservative one
+(Boehm's GC v 4.11) and that did fix the problems, but increases the memory
+requirements of <a href="http://ecls.sourceforge.net">ECLS</a>. Since this is
+really undesirable, I have been also thinking about revamping the current
+garbage collector with an interface to mmap(). Time wil tell...
+
+<li><b>Improve the compiler: more agressive inlining, better operations among
+numbers and unboxed arrays of complex numbers.</b>
+
+<p><a href="http://ecls.sourceforge.net">ECLS</a> currently can inline all
+operations that involve fixnums, characters and floating point
+numbers. However, the type inferencer is not very powerful and therefore some
+operations are not inlined because the compiler cannot actually tell the types
+of the arguments and of the output.
+</ul>
+
diff --git a/src/doc/head b/src/doc/head
new file mode 100644
index 000000000..de9a50d82
--- /dev/null
+++ b/src/doc/head
@@ -0,0 +1,32 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
+<html>
+<head>
+<title>ECLS - a Common-Lisp implementation</title>
+<meta http-equiv="Content-Type" content="text/html"/>
+<meta http-equiv="description" content="CLISP summary"/>
+</head>
+
+<body bgcolor="#000000">
+<table width="100%" align="center">
+<tr><td bgcolor="#EEEEEE" align="center">
+<h1><a href="http://http://sourceforge.net/projects/ecls">ECLS</a></h1>
+</td></tr>
+</table>
+</p>
+<table width="100%" cellpadding="5" align="center">
+ <tr>
+  <td width="20%" bgcolor="#DDDDDD" valign="top">
+   <table align="center" valign="top">
+   <tr><td><a href="index.html"><b>Home page</b></a></td></tr>
+   <tr><td><a href="http://sourceforge.net/projects/ecls"><b>Project</b></a></td></tr>
+   <tr><td><a href="news.html"><b>Latest news</b></a></td></tr>
+   <tr><td><a href="install.html"><b>Installing</b></a></td></tr>
+   <tr><td><a href="license.html"><b>License</b></a></td></tr>
+   <tr><td><a href="ecls.html"><b>User's guide</b></a></td></tr>
+   <tr><td><a href="benchmark.html"><b>Benchmarks</b></a></td></tr>
+   <tr><td><a href="download.html"><b>Distribution</b></a></td></tr>
+   <tr><td><a href="http://cvs.sourceforge.net/cgi-bin/cvsweb.cgi/?cvsroot=ecls"><b>Browse CVS</b></a></td></tr>
+   </table>
+  <td width="7"></td>
+  <td width="100%" bgcolor="#FFFFFF" valign="top">
+<!-- Begin text -->
diff --git a/src/doc/help.lsp b/src/doc/help.lsp
new file mode 100644
index 000000000..63825b424
Binary files /dev/null and b/src/doc/help.lsp differ
diff --git a/src/doc/index.in.html b/src/doc/index.in.html
new file mode 100644
index 000000000..7ee75834d
--- /dev/null
+++ b/src/doc/index.in.html
@@ -0,0 +1,40 @@
+<h2>What is ECLS</h2>
+
+<a href="http://ecls.sourceforge.net">ECLS</a> stands for
+<em>Embeddable Common-Lisp "Spain"</em>, and I usually read it as
+"e-klos". It is a an implementation of the <a
+href="http://www.lisp.org">Common-Lisp language</a> which aims to
+comply to the <a
+href="http://www.lisp.org/HyperSpec/FrontMatter/index.html">ANSI
+X3J13</a> definition of the language.
+
+<p>It features</p>
+<ul>
+<li>A bytecodes compiler and interpreter.</li>
+<li>A translator to C.</li>
+<li>An interface to foreign functions.</li>
+<li>A dynamic loader.</li>
+<li>The possibility to build standalone executables.</li>
+<li>The Common-Lisp Object System (CLOS).</li>
+<li>Conditions and restarts for handling errors.</li>
+<li>Sockets as ordinary streams.</li>
+<li>The Gnu Multiprecision library for fast bignum operations.</li>
+<li>A simple conservative mark & sweep garbage collector.</li>
+<li>The Boehm-Weiser garbage collector.</li>
+</ul>
+
+<h2>The author</h2>
+
+The current maintainer of <a href="http://ecls.sourceforge.net">ECLS</a> is
+<pre>
+	Juan Jose Garcia Ripoll
+
+	Univ. de Castilla-La Mancha
+	E.T.S.I. Industriales
+	Departamento de Matematicas
+	c/Camilo Jose Cela, 3
+	Ciudad Real, E-13071
+	Spain
+
+	<a href="mailto:jjgarcia@ind-cr.uclm.es">jjgarcia@ind-cr.uclm.es</a>
+</pre>
diff --git a/src/doc/install.in.html b/src/doc/install.in.html
new file mode 100644
index 000000000..dddb748ea
--- /dev/null
+++ b/src/doc/install.in.html
@@ -0,0 +1,42 @@
+<h2>Installation</h2>
+<ul>
+<li>Unpack the tar file
+<pre>
+	gunzip -c ecls.tgz | tar xf -
+</pre>
+
+<li>Run the configuration file.
+<pre>
+	cd ecls-@VERSION@
+	./configure
+</pre>
+The previous step creates a directory with the name <b>build</b>, and
+stores a bunch of makefiles in it.
+
+<li>Use GNU make to invoke the compilation
+<pre>
+	make
+</pre>
+
+<li>If you want to test the fresh new executable before installing. You you
+should invoke ECLS from withing the build directory using the "-dir ./"
+argument to advice him about the right place to find header files, libraries,
+etc.  For instance, under linux the build directory is "linux" and we would do
+<pre>
+	$ ./configure --prefix=$HOME
+	[...]
+	$ cd build
+	$ make
+	[...]
+	$ ./ecls -dir ./
+</pre>
+
+<li>Install it in the desired location
+<pre>
+	make install
+</pre>
+</ul>
+
+<p>As a side note, a --disable-clos is still in ./configure, but its use is
+discouraged and unsupported.
+
diff --git a/src/doc/license.in.html b/src/doc/license.in.html
new file mode 100644
index 000000000..e20a54219
--- /dev/null
+++ b/src/doc/license.in.html
@@ -0,0 +1,68 @@
+<pre>
+_______________________________________________________________________________
+
+  Copyright (c) 2000, Juan Jose Garcia Ripoll
+  Copyright (c) 1990, 1991, 1993 Giuseppe Attardi
+  Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
+	      All Rights Reserved
+_______________________________________________________________________________
+
+Summary:
+
+  Permission is granted to use, copy, modify this program,
+  EXCEPT that the copyright notice must be reproduced on copies, and
+  credit should be given to the authors where it is due.
+  WE MAKE NO WARRANTY AND ACCEPT NO LIABILITY FOR THIS PROGRAM.
+
+
+In detail:
+
+  1. Permission to use, copy, modify this software and its documentation
+     for any purpose is hereby granted without fee, provided that
+     - the above copyright notice appears in all copies,
+     - both that copyright notice and this permission notice appears in
+       supporting documentation, and that
+     - you cause modified files to carry prominent notices stating that
+       you changed the files and the date of any change.
+
+  2. Please notify us if you are going to sell this software or its
+     documentation for profit.
+
+  3. WE DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL
+     IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
+     WE BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+     ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+     WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+     ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+     SOFTWARE.
+
+
+Additionally:
+
+  ECLS is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published
+  by the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version; see file 'Copying'.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the <a href="http://www.fsf.org/copyleft/lgpl.html">GNU Library General Public License</a>
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+Address for reporting bugs, comments, suggestions:
+
+  Juan Jose Garcia Ripoll
+  Univ. de Castilla-La Mancha
+  E.T.S.I. Industriales
+  Departamento de Matematicas
+  c/Camilo Jose Cela, 3
+  Ciudad Real, E-13071
+  Spain
+
+
+  jjgarcia@ind-cr.uclm.es
+</pre>
\ No newline at end of file
diff --git a/src/doc/news.in.html b/src/doc/news.in.html
new file mode 100644
index 000000000..13165b2cb
--- /dev/null
+++ b/src/doc/news.in.html
@@ -0,0 +1,72 @@
+<h2>News in this release (ECLS-@VERSION@)</h2>
+
+<ul>
+<li>Due to human errors, the bytecompiler shipped with 0.1a was an
+  unfinished version. In 0.1b we shipped a more polished files. Some
+  of the errors which are fixed are
+  <ul>
+  <li>Produce the right code for TAGBODY inside closures</li>
+  <li>Activate compiler for SYMBOL-MACROLET</li>
+  <li>Allow non-keyword symbols as lambda-list-keywords</li>
+  <li>Allow more than one :ALLOW-OTHER-KEYS to be supplied, but discard other than the first one
+  <li> Process declarations in FLET/LABELS forms
+  </ul>
+
+<li> Fixed the C compiler routines for TAGBODY: it would produce wrong
+  code when jumping out of a closure.
+
+<li> Rewrite the error system using KMP's condition system, CLOS and a
+  rudimentary interface to the toplevel.
+
+<li> Enclosing the bytecompiler in an UNWIND-PROTECT ensures that the
+  status of the compiler and of the interpreter is always consistent.
+
+<li> Port and incorporate Peter Van Eynde's test suite for ANSI
+  compliance.
+
+<li> Replace features ECL/ECL-MIN with ECLS and ECLS-MIN. All references
+  to ECL (Eco-Common-Lisp) should have been dropped by now.
+
+<li> Add simple-program-error and simple-control-error to the hierarchy
+  of conditions, and try to ensure that all routines in libecls.a
+  signal the right type of condition.
+
+<li> Define COMPLEMENT and CONTINOUSLY.
+
+<li> Fix #'= between bignums.
+
+<li> NIL is no longer valid as the first of a pair of bounding index
+  designators, i.e. (nstring-upcase "aa" :start nil :end nil) causes
+  an error.
+</ul>
+
+<h2>Known bugs</h2>
+
+As I mentioned above, the problem I am finding here is the lack of test suites
+which I can use to detect failures in the behavior of any function. Currently I
+can assure that <a href="http://ecls.sourceforge.net">ECLS</a> passes most of
+the tests from the <a href="http://clocc.sourceforge.net">the CLOCC suite</a>.
+The most important exceptions are
+<ul>
+<li>CLOS
+<li>#'format
+<li>#'unread-char is too lax
+<li>The CL package is too polluted
+<li>LOOP lacks some of the standard keywords, including destructuring
+<li>Support for logical pathnames is incomplete
+</ul>
+
+If you find something that should be fixed or that the behavior of a
+function is particularly misleading with respect to the standards, feel free
+to tell me so.
+
+Some other bugs which need to be fixed are:
+<ul>
+<li>Threads and sockets haven't been tested yet.
+<li>#'format doesn't pass the Cltl-1 tests and fails when the number of
+arguments is large.
+<li>Needs better support for wildcards in pathnames.
+<li>Bugs in logical operations among bignums.
+<li>Support for CLOS needs yet more optimization.
+</ul>
+
diff --git a/src/doc/todo.txt b/src/doc/todo.txt
new file mode 100644
index 000000000..3c65963b2
--- /dev/null
+++ b/src/doc/todo.txt
@@ -0,0 +1,189 @@
+
+*	error-set can be eliminated, as well as FRS_CATCHALL fr_class and
+	Kcatchall keyword.
+
+*	Removed call
+	(wt-data nil)
+	before loop (dolist (x *linking-calls*) ..) in ctop-write.
+	Created inconsistency in size of data vector in cfun.
+	What was it for?
+
+*	For local entry functions the binding for args which are special
+	should be done after the label TTL: has been emitted.
+
+*	From triang-mod.cl. The following:
+	 (setf (aref board (aref a i)) 0)
+	compiles to:
+	{object V3;
+	object V4;
+	V3= (VV[10]->s.s_dbind);
+	V4= MAKE_FIXNUM(((VV[15]->s.s_dbind))->fixa.fixa_self[V1]);
+	((V3))->fixa.fixa_self[fix((V4))]= 0;
+	}
+	even though:
+	(proclaim '(type (vector fixnum) board sequence a b c))
+
+*	When compiling do/do* references to variables in test forms should
+	be considered multiple.
+
+*	The mechanism for printing circular structure fails on sun when
+	size exceeds PRINTcircleSIZE.
+
+*	disassemble does not behave as in help.doc.
+
+*	c1apply-optimize could emit code for testing whether there are
+	sufficient elements in the list
+
+*	Update code to use constants in <limits.h>
+
+*	The mechanism of local/global entries in cmptop.lsp is worth while
+	only if all arguments are unboxed.
+
+*	Lavori piu' impegnativi:
+	- Rifare il trattamento di ihs
+	- introdurre dichiarazione :dynamic-extent
+	- aggiungere agli ottimizzatori i flags usati da Sherlis
+
+*	Completare la modifica di print-doc (describe.lsp) per stampare
+	intestazioni ripetute per quei simboli (list, *, etc.) che hanno
+	documentazione multipla.
+
+*	Completare l'aggiunta di nomi di caratteri:
+	#\F1, ... , #\F12, #\C-F1, .. , #\C-F12, #\M-F1, .. , #\M-F12
+	#\Up, #\Down, #\Left, #\Right, #\C-Up, #\C-Down, #\C-Left, #\C-Right
+	#\PgUp, #\PgDn, #\Home, #\End, #\C-PgUp, #\C-PgDn, #\C-Home, #\C-End
+
+*	verificare se usando una VAR come *destination*
+                (let* ((kind (var-kind var))
+                       (lcl (next-lcl))
+		       (temp (list 'VAR (make-var :kind kind :loc lcl))))
+                  (wt-nl "{" *volatile* (rep-type kind)) (wt-lcl lcl) (wt ";")
+                  (let ((*destination* temp)) (c2expr* form))
+	si puo' semplificare inline-args evitando l'uso di coerce-loc.
+
+*	questa clausola di cmpinline.lsp
+			((or (eq (var-kind var) 'LEXICAL)
+			     (eq (var-kind var) 'OBJECT))
+			 (let ((lcl-loc (list 'LCL (next-lcl))))
+			   (wt-nl "{object " lcl-loc "= "
+				  (wt-lcl (var-loc var)) (wt ";")
+				  (push (coerce-loc lcl-loc type) locs)
+				  (incf *inline-blocks*))))
+	e' dubbia: (wt-lcl (var-loc var)) per un LEXICAL?
+
+*	parameter closure-p in t3local-fun could be eliminated: it is present
+	in (fun-closure fun).
+
+*	All loops of the kind:
+		for (i = 0;  i < maxpage;  i++) {
+	in gbc.c, could be changed to i = minpage, where:
+		minpage = page(heap_end);
+	just after
+		heap_end = core_end = sbrk(0);
+	in alloc.c
+
+*	In macro_expand1:
+		     (lex_env[1] == OBJNULL) ? Cnil :
+	dovrebbe forse essere
+		     (lex_env[1] == Cnil) ? Cnil :
+
+*	trattamento or non soddisfacente:
+	(let ((dir (or (and output-file
+                       (pathname-directory output-file))
+                  (pathname-directory input-pathname)))
+
+	if((V2)==Cnil){
+	VALUES(0) = Cnil;
+	goto L42;}
+	Lpathname_directory(1,(V2))               /*  PATHNAME-DIRECTORY*/;
+L42:
+	if(VALUES(0)==Cnil)goto L41;
+	V11= VALUES(0);
+	goto L40;
+L41:
+	Lpathname_directory(1,(V1))               /*  PATHNAME-DIRECTORY*/;
+	V11= VALUES(0);
+L40:
+	if((V2)==Cnil){
+	VALUES(0) = Cnil;
+	goto L45;}
+	Lpathname_name(1,(V2))                    /*  PATHNAME-NAME   */;
+L45:
+	if(VALUES(0)==Cnil)goto L44;
+	V12= VALUES(0);
+	goto L43;
+L44:
+	Lpathname_name(1,(V1))                    /*  PATHNAME-NAME   */;
+	V12= VALUES(0);
+L43:
+
+*	in sysfun, scambiare never-change-special-var-p con
+	change-special-var-p per evitare creazione di troppe plist
+
+*	(setq spec (pop vl)) produces:
+	{object V12;                              /*  G4356           */
+	V12= CAR((V1));
+	V1= CDR((V1));
+	V2= (V12);
+	}
+
+*	 (or (and (foo)
+                  (listp args))
+              ...
+	if(VALUES(0)!=Cnil){
+	goto L21;}
+	VALUES(0) = Cnil;
+	goto L20;
+L21:
+	VALUES(0) = (type_of((V2))==t_cons||(V2)==Cnil?Ct:Cnil);
+L20:
+	if(VALUES(0)==Cnil)goto L19;
+
+        potrebbe essere migliorata. c2or dovrebbe chiamare c2expr con
+	JUMP-TRUE come *destination*, ma dovrebbe sapere in quale
+	locazione unwind-exit mette il risultato facendoselo ritornare.
+
+*	cambiare vref1 perche' ritorni solo var anziche' (var)
+
+*	(min (* *step-level* 2) 20) produce
+	(number_compare(number_times((VV[58]->s.s_dbind),MAKE_FIXNUM(2)),MAKE_FIXNUM(20))<=0?number_times((VV[58]->s.s_dbind),MAKE_FIXNUM(2)):MAKE_FIXNUM(20))
+
+*	Aggiungere ottimizzazione travel_push_type in print.d per
+	la stampa ciclica, come AKCL.
+
+*	Rimettere #. in default-init in cmptype.lsp (finito bootstrap
+	da AKCL)
+
+*	ricorsione diretta in c2call-global (utile per labels)
+	da' problemi a flet.
+
+*	unwind-exit caso FRAME considera SIMPLE-FUNCALL. Deve considerare
+	anche FUN-VAL?
+
+*	(let ((start start) (end end))
+	    (declare (fixnum start end))
+	puo' evitare di creare variabili object e poi relative unboxed
+
+*	scambiare ordine argomenti di si:putprop per facilitare (setf get).
+
+*	aggiungere funzioni di lwp.d in cmp/sysfun.lsp
+
+*	Rewrite setjmp.s so that PC is stored in slot 0 of buf, consistently
+	with _setjmp.
+
+*	Change lex.h and elsewhere so that:
+
+	lex-var:        (symbol value)      	; for local binding
+		  (....	   or          ....)
+			symbol                  ; for special binding
+
+	lex-fd:         (fun-name 'FUNCTION' . function)
+		  (....		or				...)
+			(macro-name 'MACRO' . expansion-function)
+
+	lex-tag:  	(tag    'TAG'  	.   frame-id)
+		  (....		or                    ....)
+			(block-name 'BLOCK' . frame-id)
+
+*	Funzione directory non funziona sotto DOS: la free chiamata
+	da setbuf fallisce.
\ No newline at end of file
diff --git a/src/doc/tutorial.txt b/src/doc/tutorial.txt
new file mode 100644
index 000000000..6f963f8a5
--- /dev/null
+++ b/src/doc/tutorial.txt
@@ -0,0 +1,1131 @@
+                          Common LISP Hints
+                          Geoffrey J. Gordon
+                         <ggordon@cs.cmu.edu>
+                       Friday, February 5, 1993
+
+                            Modified by
+                            Giuseppe Attardi
+                	  <attardi@di.unipi.it>
+
+Note: This tutorial introduction to Common Lisp was written for the
+CMU environment, so some of the details of running lisp toward the end
+may differ from site to site.
+
+
+Further Information
+
+The best LISP textbook I know of is
+
+  Guy L. Steele Jr. _Common LISP: the Language_. Digital Press. 1984.
+
+The first edition is easier to read; the second describes a more recent
+standard. (The differences between the two standards shouldn't affect
+casual programmers.)
+
+A book by Dave Touretsky has also been recommended to me, although I
+haven't read it, so I can't say anything about it.
+
+
+
+Symbols
+
+A symbol is just a string of characters. There are restrictions on what
+you can include in a symbol and what the first character can be, but as
+long as you stick to letters, digits, and hyphens, you'll be safe.
+(Except that if you use only digits and possibly an initial hyphen,
+LISP will think you typed an integer rather than a symbol.) Some
+examples of symbols:
+
+        a
+        b
+        c1
+        foo
+        bar
+        baaz-quux-garply
+
+Some things you can do with symbols follow. (Things after a ">" prompt
+are what you type to the LISP interpreter, while other things are what
+the LISP interpreter prints back to you. The ";" is LISP's comment
+character: everything from a ";" to the end of line is ignored.)
+
+> (setq a 5)            ;store a number as the value of a symbol
+5
+> a                     ;take the value of a symbol
+5
+> (let ((a 6)) a)       ;bind the value of a symbol temporarily to 6
+6
+> a                     ;the value returns to 5 once the let is finished
+5
+> (+ a 6)               ;use the value of a symbol as an argument to a function
+11
+> b                     ;try to take the value of a symbol which has no value
+Error: Attempt to take the value of the unbound symbol B
+
+There are two special symbols, t and nil. The value of t is defined
+always to be t, and the value of nil is defined always to be nil. LISP
+uses t and nil to represent true and false. An example of this use is
+in the if statement, described more fully later:
+
+> (if t 5 6)
+5
+> (if nil 5 6)
+6
+> (if 4 5 6)
+5
+
+The last example is odd but correct: nil means false, and anything else
+means true. (Unless we have a reason to do otherwise, we use t to mean
+true, just for the sake of clarity.)
+
+Symbols like t and nil are called self-evaluating symbols, because
+they evaluate to themselves. There is a whole class of self-evaluating
+symbols called keywords; any symbol whose name starts with a colon is a
+keyword. (See below for some uses for keywords.) Some examples:
+
+> :this-is-a-keyword
+:THIS-IS-A-KEYWORD
+> :so-is-this
+:SO-IS-THIS
+> :me-too
+:ME-TOO
+
+
+
+Numbers
+
+An integer is a string of digits optionally preceded by + or -. A real
+number looks like an integer, except that it has a decimal point and
+optionally can be written in scientific notation. A rational looks like
+two integers with a / between them. LISP supports complex numbers,
+which are written #c(r i) (where r is the real part and i is the
+imaginary part). A number is any of the above. Here are some numbers:
+
+        5
+        17
+        -34
+        +6
+        3.1415
+        1.722e-15
+        #c(1.722e-15 0.75)
+
+The standard arithmetic functions are all available: +, -, *, /, floor,
+ceiling, mod, sin, cos, tan, sqrt, exp, expt, and so forth. All of them
+accept any kind of number as an argument. +, -, *, and / return a
+number according to type contagion: an integer plus a rational is a
+rational, a rational plus a real is a real, and a real plus a complex
+is a complex. Here are some examples:
+
+> (+ 3 3/4)             ;type contagion
+15/4 
+> (exp 1)               ;e
+2.7182817 
+> (exp 3)               ;e*e*e
+20.085537 
+> (expt 3 4.2)          ;exponent with a base other than e
+100.90418
+> (+ 5 6 7 (* 8 9 10))  ;the fns +-*/ all accept multiple arguments
+
+There is no limit to the absolute value of an integer except the memory
+size of your computer. Be warned that computations with bignums (as
+large integers are called) can be slow. (So can computations with
+rationals, especially compared to the corresponding computations with
+small integers or floats.)
+
+
+
+Conses
+
+A cons is just a two-field record. The fields are called "car" and
+"cdr", for historical reasons. (On the first machine where LISP was
+implemented, there were two instructions CAR and CDR which stood for
+"contents of address register" and "contents of decrement register".
+Conses were implemented using these two registers.)
+
+Conses are easy to use:
+
+> (cons 4 5)            ;Allocate a cons. Set the car to 4 and the cdr to 5.
+(4 . 5)
+> (cons (cons 4 5) 6)
+((4 . 5) . 6)
+> (car (cons 4 5))
+4
+> (cdr (cons 4 5))
+5
+
+
+
+Lists
+
+You can build many structures out of conses. Perhaps the simplest is a
+linked list: the car of each cons points to one of the elements of the
+list, and the cdr points either to another cons or to nil. You can
+create such a linked list with the list fuction:
+
+> (list 4 5 6)
+(4 5 6)
+
+Notice that LISP prints linked lists a special way: it omits some of
+the periods and parentheses. The rule is: if the cdr of a cons is nil,
+LISP doesn't bother to print the period or the nil; and if the cdr of
+cons A is cons B, then LISP doesn't bother to print the period for cons
+A or the parentheses for cons B. So:
+
+> (cons 4 nil)
+(4)
+> (cons 4 (cons 5 6))
+(4 5 . 6)
+> (cons 4 (cons 5 (cons 6 nil)))
+(4 5 6)
+
+The last example is exactly equivalent to the call (list 4 5 6). Note
+that nil now means the list with no elements: the cdr of (a b), a list
+with 2 elements, is (b), a list with 1 element; and the cdr of (b), a
+list with 1 element, is nil, which therefore must be a list with no
+elements.
+
+The car and cdr of nil are defined to be nil.
+
+If you store your list in a variable, you can make it act like a stack:
+
+> (setq a nil)
+NIL
+> (push 4 a)
+(4)
+> (push 5 a)
+(5 4)
+> (pop a)
+5
+> a
+(4)
+> (pop a)
+4
+> (pop a)
+NIL
+> a
+NIL
+
+
+
+Functions
+
+You saw one example of a function above. Here are some more:
+
+> (+ 3 4 5 6)                   ;this function takes any number of arguments
+18
+> (+ (+ 3 4) (+ (+ 4 5) 6))     ;isn't prefix notation fun?
+22
+> (defun foo (x y) (+ x y 5))   ;defining a function
+FOO
+> (foo 5 0)                     ;calling a function
+10
+> (defun fact (x)               ;a recursive function
+    (if (> x 0) 
+      (* x (fact (- x 1)))
+      1
+  ) )
+FACT
+> (fact 5)
+120
+> (defun a (x) (if (= x 0) t (b (- x))))        ;mutually recursive functions
+A
+> (defun b (x) (if (> x 0) (a (- x 1)) (a (+ x 1))))
+B
+> (a 5)
+T
+> (defun bar (x)                ;a function with multiple statements in
+    (setq x (* x 3))            ;its body -- it will return the value
+    (setq x (/ x 2))            ;returned by its final statement
+    (+ x 4)
+  )
+BAR
+> (bar 6)
+13
+
+When we defined foo, we gave it two arguments, x and y. Now when we
+call foo, we are required to provide exactly two arguments: the first
+will become the value of x for the duration of the call to foo, and the
+second will become the value of y for the duration of the call. In
+LISP, most variables are lexically scoped; that is, if foo calls bar
+and bar tries to reference x, bar will not get foo's value for x.
+
+The process of assigning a symbol a value for the duration of some
+lexical scope is called binding.
+
+You can specify optional arguments for your functions. Any argument
+after the symbol &optional is optional:
+
+> (defun bar (x &optional y) (if y x 0))
+BAR
+> (defun baaz (&optional (x 3) (z 10)) (+ x z))
+BAAZ
+> (bar 5)
+0
+> (bar 5 t)
+5
+> (baaz 5)
+15
+> (baaz 5 6)
+11
+> (baaz)
+13
+
+It is legal to call the function bar with either one or two arguments.
+If it is called with one argument, x will be bound to the value of that
+argument and y will be bound to nil; if it is called with two
+arguments, x and y will be bound to the values of the first and second
+argument, respectively.
+
+The function baaz has two optional arguments. It specifies a default
+value for each of them: if the caller specifies only one argument, z
+will be bound to 10 instead of to nil, and if the caller specifies no
+arguments, x will be bound to 3 and z to 10.
+
+You can make your function accept any number of arguments by ending its
+argument list with an &rest parameter. LISP will collect all arguments
+not otherwise accounted for into a list and bind the &rest parameter to
+that list. So:
+
+> (defun foo (x &rest y) y)
+FOO
+> (foo 3)
+NIL
+> (foo 4 5 6)
+(5 6)
+
+Finally, you can give your function another kind of optional argument
+called a keyword argument. The caller can give these arguments in any
+order, because they're labelled with keywords.
+
+> (defun foo (&key x y) (cons x y))
+FOO
+> (foo :x 5 :y 3)
+(5 . 3)
+> (foo :y 3 :x 5)
+(5 . 3)
+> (foo :y 3)
+(NIL . 3)
+> (foo)
+(NIL)
+
+An &key parameter can have a default value too:
+
+> (defun foo (&key (x 5)) x)
+FOO
+> (foo :x 7)
+7
+> (foo)
+5
+
+
+
+Printing
+
+Some functions can cause output. The simplest one is print, which
+prints its argument and then returns it.
+
+> (print 3)
+3
+3
+
+The first 3 above was printed, the second was returned.
+
+If you want more complicated output, you will need to use format.
+Here's an example:
+
+> (format t "An atom: ~S~%and a list: ~S~%and an integer: ~D~%"
+          nil (list 5) 6)
+An atom: NIL
+and a list: (5)
+and an integer: 6
+
+The first argument to format is either t, nil, or a stream. T specifies
+output to the terminal. Nil means not to print anything but to return a
+string containing the output instead. Streams are general places for
+output to go: they can specify a file, or the terminal, or another
+program. This handout will not describe streams in any further detail.
+
+The second argument is a formatting template, which is a string
+optionally containing formatting directives.
+
+All remaining arguments may be referred to by the formatting
+directives. LISP will replace the directives with some appropriate
+characters based on the arguments to which they refer and then print
+the resulting string.
+
+Format always returns nil unless its first argument is nil, in which
+case it prints nothing and returns a string.
+
+There are three different directives in the above example: ~S, ~D, and
+~%. The first one accepts any LISP object and is replaced by a printed
+representation of that object (the same representation which is
+produced by print). The second one accepts only integers. The third one
+doesn't refer to an argument; it is always replaced by a carriage
+return.
+
+Another useful directive is ~~, which is replaced by a single ~.
+
+Refer to a LISP manual for (many, many) additional formatting
+directives.
+
+
+
+Forms and the Top-Level Loop
+
+The things which you type to the LISP interpreter are called forms; the
+LISP interpreter repeatedly reads a form, evaluates it, and prints the
+result. This procedure is called the read-eval-print loop.
+
+Some forms will cause errors. After an error, LISP will put you into
+the debugger so you can try to figure out what caused the error. LISP
+debuggers are all different; but most will respond to the command
+"help" or ":help" by giving some form of help.
+
+In general, a form is either an atom (for example, a symbol, an
+integer, or a string) or a list. If the form is an atom, LISP evaluates
+it immediately. Symbols evaluate to their value; integers and strings
+evaluate to themselves. If the form is a list, LISP treats its first
+element as the name of a function; it evaluates the remaining elements
+recursively, and then calls the function with the values of the
+remaining elements as arguments.
+
+For example, if LISP sees the form (+ 3 4), it treats + as the name of
+a function. It then evaluates 3 to get 3 and 4 to get 4; finally it
+calls + with 3 and 4 as the arguments. The + function returns 7, which
+LISP prints.
+
+The top-level loop provides some other conveniences; one particularly
+convenient convenience is the ability to talk about the results of
+previously typed forms. LISP always saves its most recent three
+results; it stores them as the values of the symbols *, **, and ***.
+For example:
+
+> 3
+3
+> 4
+4
+> 5
+5
+> ***
+3
+> ***
+4
+> ***
+5
+> **
+4
+> *
+4
+
+
+
+Special forms
+
+There are a number of special forms which look like function calls but
+aren't. These include control constructs such as if statements and do
+loops; assignments like setq, setf, push, and pop; definitions such as
+defun and defstruct; and binding constructs such as let. (Not all of
+these special forms have been mentioned yet. See below.)
+
+One useful special form is the quote form: quote prevents its argument
+from being evaluated. For example:
+
+> (setq a 3)
+3
+> a
+3
+> (quote a)
+A
+> 'a                    ;'a is an abbreviation for (quote a)
+A
+
+Another similar special form is the function form: function causes its
+argument to be interpreted as a function rather than being evaluated.
+For example:
+
+> (setq + 3)
+3
+> +
+3
+> '+
++
+> (function +)
+#<Function + @ #x-fbef9de>
+> #'+                   ;#'+ is an abbreviation for (function +)
+#<Function + @ #x-fbef9de>
+
+The function special form is useful when you want to pass a function as
+an argument to another function. See below for some examples of
+functions which take functions as arguments.
+
+
+
+Binding
+
+Binding is lexically scoped assignment. It happens to the variables in
+a function's parameter list whenever the function is called: the formal
+parameters are bound to the actual parameters for the duration of the
+function call. You can bind variables anywhere in a program with the
+let special form, which looks like this:
+
+        (let ((var1 val1)
+              (var2 val2)
+              ...
+             )
+          body
+        )
+
+Let binds var1 to val1, var2 to val2, and so forth; then it executes
+the statements in its body. The body of a let follows exactly the same
+rules that a function body does. Some examples:
+
+> (let ((a 3)) (+ a 1))
+4
+> (let ((a 2) 
+        (b 3)
+        (c 0))
+    (setq c (+ a b))
+    c
+  )
+5
+> (setq c 4)
+4
+> (let ((c 5)) c)
+5
+> c
+4
+
+Instead of (let ((a nil) (b nil)) ...), you can write (let (a b) ...).
+
+The val1, val2, etc. inside a let cannot reference the variables var1,
+var2, etc. that the let is binding. For example,
+
+> (let ((x 1)
+        (y (+ x 1)))
+    y
+  )
+Error: Attempt to take the value of the unbound symbol X
+
+If the symbol x already has a global value, stranger happenings will
+result:
+
+> (setq x 7)
+7
+> (let ((x 1)
+        (y (+ x 1)))
+    y
+  )
+8
+
+The let* special form is just like let except that it allows values to
+reference variables defined earlier in the let*. For example,
+
+> (setq x 7)
+7
+> (let* ((x 1)
+         (y (+ x 1)))
+    y
+  )
+2
+
+The form
+
+        (let* ((x a)
+               (y b))
+          ...
+        ) 
+
+is equivalent to
+
+        (let ((x a))
+          (let ((y b))
+            ...
+        ) )
+
+
+
+Dynamic Scoping
+
+The let and let* forms provide lexical scoping, which is what you
+expect if you're used to programming in C or Pascal. Dynamic scoping is
+what you get in BASIC: if you assign a value to a dynamically scoped
+variable, every mention of that variable returns that value until you
+assign another value to the same variable.
+
+In LISP, dynamically scoped variables are called special variables. You
+can declare a special variable with the defvar special form. Here are
+some examples of lexically and dynamically scoped variables.
+
+In this example, the function check-regular references a regular (ie,
+lexically scoped) variable. Since check-regular is lexically outside of
+the let which binds regular, check-regular returns the variable's
+global value.
+
+> (setq regular 5)
+5 
+> (defun check-regular () regular)
+CHECK-REGULAR 
+> (check-regular)
+5 
+> (let ((regular 6)) (check-regular))
+5 
+
+In this example, the function check-special references a special (ie,
+dynamically scoped) variable. Since the call to check-special is
+temporally inside of the let which binds special, check-special returns
+the variable's local value.
+
+> (defvar *special* 5)
+*SPECIAL*
+> (defun check-special () *special*)
+CHECK-SPECIAL
+> (check-special)
+5
+> (let ((*special* 6)) (check-special))
+6
+
+By convention, the name of a special variable begins and ends with a *.
+Special variables are chiefly used as global variables, since
+programmers usually expect lexical scoping for local variables and
+dynamic scoping for global variables.
+
+For more information on the difference between lexical and dynamic
+scoping, see _Common LISP: the Language_.
+
+
+
+Arrays
+
+The function make-array makes an array. The aref function accesses its
+elements. All elements of an array are initially set to nil. For
+example:
+
+> (make-array '(3 3))
+#2a((NIL NIL NIL) (NIL NIL NIL) (NIL NIL NIL))
+> (aref * 1 1)
+NIL
+> (make-array 4)        ;1D arrays don't need the extra parens
+#(NIL NIL NIL NIL)
+
+Array indices always start at 0.
+
+See below for how to set the elements of an array.
+
+
+
+Strings
+
+A string is a sequence of characters between double quotes. LISP
+represents a string as a variable-length array of characters. You can
+write a string which contains a double quote by preceding the quote
+with a backslash; a double backslash stands for a single backslash. For
+example:
+
+        "abcd" has 4 characters
+        "\"" has 1 character
+        "\\" has 1 character
+
+Here are some functions for dealing with strings:
+
+> (concatenate 'string "abcd" "efg")
+"abcdefg"
+> (char "abc" 1)
+#\b                     ;LISP writes characters preceded by #\
+> (aref "abc" 1)
+#\b                     ;remember, strings are really arrays
+
+The concatenate function can actually work with any type of sequence:
+
+> (concatenate 'string '(#\a #\b) '(#\c))
+"abc"
+> (concatenate 'list "abc" "de")
+(#\a #\b #\c #\d #\e)
+> (concatenate 'vector '#(3 3 3) '#(3 3 3))
+#(3 3 3 3 3 3)
+
+
+
+Structures
+
+LISP structures are analogous to C structs or Pascal records. Here is
+an example:
+
+> (defstruct foo
+    bar
+    baaz
+    quux
+  )
+FOO
+
+This example defines a data type called foo which is a structure
+containing 3 fields. It also defines 4 functions which operate on this
+data type: make-foo, foo-bar, foo-baaz, and foo-quux. The first one
+makes a new object of type foo; the others access the fields of an
+object of type foo. Here is how to use these functions:
+
+> (make-foo)
+#s(FOO :BAR NIL :BAAZ NIL :QUUX NIL) 
+> (make-foo :baaz 3)
+#s(FOO :BAR NIL :BAAZ 3 :QUUX NIL) 
+> (foo-bar *)
+NIL
+> (foo-baaz **)
+3
+
+The make-foo function can take a keyword argument for each of the
+fields a structure of type foo can have. The field access functions
+each take one argument, a structure of type foo, and return the
+appropriate field.
+
+See below for how to set the fields of a structure.
+
+
+
+Setf
+
+Certain forms in LISP naturally define a memory location. For example,
+if the value of x is a structure of type foo, then (foo-bar x) defines
+the bar field of the value of x. Or, if the value of y is a one-
+dimensional array, (aref y 2) defines the third element of y.
+
+The setf special form uses its first argument to define a place in
+memory, evaluates its second argument, and stores the resulting value
+in the resulting memory location. For example,
+
+> (setq a (make-array 3))
+#(NIL NIL NIL)
+> (aref a 1)
+NIL
+> (setf (aref a 1) 3)
+3
+> a
+#(NIL 3 NIL)
+> (aref a 1)
+3
+> (defstruct foo bar)
+FOO
+> (setq a (make-foo))
+#s(FOO :BAR NIL)
+> (foo-bar a)
+NIL
+> (setf (foo-bar a) 3)
+3
+> a
+#s(FOO :BAR 3)
+> (foo-bar a)
+3
+
+Setf is the only way to set the fields of a structure or the elements
+of an array.
+
+Here are some more examples of setf and related functions.
+
+> (setf a (make-array 1))       ;setf on a variable is equivalent to setq
+#(NIL)
+> (push 5 (aref a 1))           ;push can act like setf
+(5)
+> (pop (aref a 1))              ;so can pop
+5
+> (setf (aref a 1) 5)
+5
+> (incf (aref a 1))             ;incf reads from a place, increments,
+6                               ;and writes back
+> (aref a 1)
+6
+
+
+
+Booleans and Conditionals
+
+LISP uses the self-evaluating symbol nil to mean false. Anything other
+than nil means true. Unless we have a reason not to, we usually use the
+self-evaluating symbol t to stand for true.
+
+LISP provides a standard set of logical functions, for example and, or,
+and not. The and and or connectives are short-circuiting: and will not
+evaluate any arguments to the right of the first one which evaluates to
+nil, while or will not evaluate any arguments to the right of the first
+one which evaluates to t.
+
+LISP also provides several special forms for conditional execution. The
+simplest of these is if. The first argument of if determines whether
+the second or third argument will be executed:
+
+> (if t 5 6)
+5
+> (if nil 5 6)
+6
+> (if 4 5 6)
+5
+
+If you need to put more than one statement in the then or else clause
+of an if statement, you can use the progn special form. Progn executes
+each statement in its body, then returns the value of the final one.
+
+> (setq a 7)
+7
+> (setq b 0)
+0
+> (setq c 5)
+5
+> (if (> a 5)
+    (progn
+      (setq a (+ b 7))
+      (setq b (+ c 8)))
+    (setq b 4)
+  )
+13
+
+An if statement which lacks either a then or an else clause can be
+written using the when or unless special form:
+
+> (when t 3)
+3
+> (when nil 3)
+NIL
+> (unless t 3)
+NIL
+> (unless nil 3)
+3
+
+When and unless, unlike if, allow any number of statements in their
+bodies. (Eg, (when x a b c) is equivalent to (if x (progn a b c)).)
+
+> (when t
+    (setq a 5)
+    (+ a 6)
+  )
+11
+
+More complicated conditionals can be defined using the cond special
+form, which is equivalent to an if ... else if ... fi construction.
+
+A cond consists of the symbol cond followed by a number of cond
+clauses, each of which is a list. The first element of a cond clause is
+the condition; the remaining elements (if any) are the action. The cond
+form finds the first clause whose condition evaluates to true (ie,
+doesn't evaluate to nil); it then executes the corresponding action and
+returns the resulting value. None of the remaining conditions are
+evaluated; nor are any actions except the one corresponding to the
+selected condition. For example:
+
+> (setq a 3)
+3
+> (cond
+   ((evenp a) a)        ;if a is even return a
+   ((> a 7) (/ a 2))    ;else if a is bigger than 7 return a/2
+   ((< a 5) (- a 1))    ;else if a is smaller than 5 return a-1
+   (t 17)               ;else return 17
+  )
+2
+
+If the action in the selected cond clause is missing, cond returns what
+the condition evaluated to:
+
+> (cond ((+ 3 4)))
+7
+
+Here's a clever little recursive function which uses cond. You might be
+interested in trying to prove that it terminates for all integers x at
+least 1. (If you succeed, please publish the result.)
+
+> (defun hotpo (x steps)        ;hotpo stands for Half Or Triple Plus One
+    (cond
+     ((= x 1) steps)
+     ((oddp x) (hotpo (+ 1 (* x 3)) (+ 1 steps)))
+     (t (hotpo (/ x 2) (+ 1 steps)))
+  ) )
+A
+> (hotpo 7 0)
+16
+
+The LISP case statement is like a C switch statement:
+
+> (setq x 'b)
+B
+> (case x
+   (a 5)
+   ((d e) 7)
+   ((b f) 3)
+   (otherwise 9)
+  )
+3
+
+The otherwise clause at the end means that if x is not a, b, d, e, or
+f, the case statement will return 9.
+
+
+
+Iteration
+
+The simplest iteration construct in LISP is loop: a loop construct
+repeatedly executes its body until it hits a return special form. For
+example,
+
+> (setq a 4)
+4
+> (loop 
+   (setq a (+ a 1))
+   (when (> a 7) (return a))
+  )
+8
+> (loop
+   (setq a (- a 1))
+   (when (< a 3) (return))
+  )
+NIL
+
+The next simplest is dolist: dolist binds a variable to the elements of
+a list in order and stops when it hits the end of the list.
+
+> (dolist (x '(a b c)) (print x))
+A 
+B 
+C 
+NIL 
+
+Dolist always returns nil. Note that the value of x in the above
+example was never nil: the NIL below the C was the value that dolist
+returned, printed by the read-eval-print loop.
+
+The most complicated iteration primitive is called do. A do statement
+looks like this:
+
+> (do ((x 1 (+ x 1))
+       (y 1 (* y 2)))
+      ((> x 5) y)
+    (print y)
+    (print 'working)
+  )
+1 
+WORKING 
+2 
+WORKING 
+4 
+WORKING 
+8 
+WORKING 
+16 
+WORKING 
+32 
+
+The first part of a do specifies what variables to bind, what their
+initial values are, and how to update them. The second part specifies a
+termination condition and a return value. The last part is the body. A
+do form binds its variables to their initial values like a let, then
+checks the termination condition. As long as the condition is false, it
+executes the body repeatedly; when the condition becomes true, it
+returns the value of the return-value form.
+
+The do* form is to do as let* is to let.
+
+
+
+Non-local Exits
+
+The return special form mentioned in the section on iteration is an
+example of a nonlocal return. Another example is the return-from form,
+which returns a value from the surrounding function:
+
+> (defun foo (x)
+    (return-from foo 3)
+    x
+  )
+FOO
+> (foo 17)
+3
+
+Actually, the return-from form can return from any named block -- it's
+just that functions are the only blocks which are named by default. You
+can create a named block with the block special form:
+
+> (block foo
+    (return-from foo 7)
+    3
+  )
+7
+
+The return special form can return from any block named nil. Loops are
+by default labelled nil, but you can make your own nil-labelled blocks:
+
+> (block nil
+    (return 7)
+    3
+  )
+7
+
+Another form which causes a nonlocal exit is the error form:
+
+> (error "This is an error")
+Error: This is an error
+
+The error form applies format to its arguments, then places you in the
+debugger.
+
+
+
+Funcall, Apply, and Mapcar
+
+Earlier I promised to give some functions which take functions as
+arguments. Here they are:
+
+> (funcall #'+ 3 4)
+7
+> (apply #'+ 3 4 '(3 4))
+14
+> (mapcar #'not '(t nil t nil t nil))
+(NIL T NIL T NIL T)
+
+Funcall calls its first argument on its remaining arguments.
+
+Apply is just like funcall, except that its final argument should be a
+list; the elements of that list are treated as if they were additional
+arguments to a funcall.
+
+The first argument to mapcar must be a function of one argument; mapcar
+applies this function to each element of a list and collects the
+results in another list.
+
+Funcall and apply are chiefly useful when their first argument is a
+variable. For instance, a search engine could take a heuristic function
+as a parameter and use funcall or apply to call that function on a
+state description. The sorting functions described later use funcall
+to call their comparison functions.
+
+Mapcar, along with nameless functions (see below), can replace many
+loops.
+
+
+
+Lambda
+
+If you just want to create a temporary function and don't want to
+bother giving it a name, lambda is what you need.
+
+> #'(lambda (x) (+ x 3))
+(LAMBDA (X) (+ X 3))
+> (funcall * 5)
+8
+
+The combination of lambda and mapcar can replace many loops. For
+example, the following two forms are equivalent:
+
+> (do ((x '(1 2 3 4 5) (cdr x))
+       (y nil))
+      ((null x) (reverse y))
+    (push (+ (car x) 2) y)
+  )
+(3 4 5 6 7)
+> (mapcar #'(lambda (x) (+ x 2)) '(1 2 3 4 5))
+(3 4 5 6 7)
+
+
+
+Sorting
+
+LISP provides two primitives for sorting: sort and stable-sort.
+
+> (sort '(2 1 5 4 6) #'<)
+(1 2 4 5 6)
+> (sort '(2 1 5 4 6) #'>)
+(6 5 4 2 1)
+
+The first argument to sort is a list; the second is a comparison
+function. The sort function does not guarantee stability: if there are
+two elements a and b such that (and (not (< a b)) (not (< b a))), sort
+may arrange them in either order. The stable-sort function is exactly
+like sort, except that it guarantees that two equivalent elements
+appear in the sorted list in the same order that they appeared in the
+original list.
+
+Be careful: sort is allowed to destroy its argument, so if the original
+sequence is important to you, make a copy with the copy-list or copy-seq
+function.
+
+
+
+Equality
+
+LISP has many different ideas of equality. Numerical equality is
+denoted by =. Two symbols are eq if and only if they are identical. Two
+copies of the same list are not eq, but they are equal.
+
+> (eq 'a 'a)
+T
+> (eq 'a 'b)
+NIL
+> (= 3 4)
+T
+> (eq '(a b c) '(a b c))
+NIL
+> (equal '(a b c) '(a b c))
+T
+> (eql 'a 'a)
+T
+> (eql 3 3)
+T
+
+The eql predicate is equivalent to eq for symbols and to = for numbers.
+
+The equal predicate is equivalent to eql for symbols and numbers. It is
+true for two conses if and only if their cars are equal and their cdrs
+are equal. It is true for two structures if and only if the structures
+are the same type and their corresponding fields are equal.
+
+
+
+Some Useful List Functions
+
+These functions all manipulate lists.
+
+> (append '(1 2 3) '(4 5 6))    ;concatenate lists
+(1 2 3 4 5 6)
+> (reverse '(1 2 3))            ;reverse the elements of a list
+(3 2 1)
+> (member 'a '(b d a c))        ;set membership -- returns the first tail
+(A C)                           ;whose car is the desired element
+> (find 'a '(b d a c))          ;another way to do set membership
+A
+> (find '(a b) '((a d) (a d e) (a b d e) ()) :test #'subsetp)
+(A B D E)                       ;find is more flexible though
+> (subsetp '(a b) '(a d e))     ;set containment
+NIL
+> (intersection '(a b c) '(b))  ;set intersection
+(B)
+> (union '(a) '(b))             ;set union
+(A B)
+> (set-difference '(a b) '(a))  ;set difference
+(B)
+
+Subsetp, intersection, union, and set-difference all assume that each
+argument contains no duplicate elements -- (subsetp '(a a) '(a b b)) is
+allowed to fail, for example.
+
+Find, subsetp, intersection, union, and set-difference can all take a
+:test keyword argument; by default, they all use eql.
+
+
+
+Getting Started with Emacs
+
+You can use Emacs to edit LISP code: most Emacses are set up to enter
+LISP mode automatically when they find a file which ends in .lisp, but
+if yours isn't, you can type M-x lisp-mode.
+
+You can run LISP under Emacs, too: make sure that there is a command in
+your path called "lisp" which runs your favorite LISP. For example, you
+could type
+
+        ln -s /usr/local/bin/ecl ~/bin/lisp
+
+Then in Emacs type M-x run-lisp. You can send LISP code to the LISP you
+just started, and do all sorts of other cool things; for more
+information, type C-h m from any buffer which is in LISP mode.
+
+Actually, you don't even need to make a link. Emacs has a variable
+called inferior-lisp-program; so if you add the line
+
+        (setq inferior-lisp-program "/usr/local/bin/ecl")
+
+to your .emacs file, Emacs will know where to find ECL when
+you type M-x run-lisp.
+
diff --git a/src/doc/user.txi b/src/doc/user.txi
new file mode 100644
index 000000000..598240cd0
--- /dev/null
+++ b/src/doc/user.txi
@@ -0,0 +1,6893 @@
+\input texinfo   @c -*-texinfo-*-
+@c %**start of header
+@setfilename ecls.info
+@settitle ECLS User's Guide
+@setchapternewpage odd
+@c %**end of header
+
+@rmacro mopt {a}
+[\a\]@c
+@end rmacro
+@macro mchoice {a}
+<\a\>@c
+@end macro
+@rmacro mstar {a}
+@{\a\@}*@c
+@end rmacro
+@rmacro mplus {a}
+@{\a\@}+@c
+@end rmacro
+@rmacro mgroup {a} 
+@{\a\@},@c
+@end rmacro
+
+@macro kwd{a}
+@var{:\a\}@c
+@end macro
+
+@macro pxlref{a}
+\a\@c
+@end macro
+
+@macro defec{a}
+@defun \a\ 
+@end macro
+
+@macro aux
+@code{&aux}@c
+@end macro
+@macro keys
+@code{&key}@c
+@end macro
+@macro rest
+@code{&rest}@c
+@end macro
+@macro optional
+@code{&optional}@c
+@end macro
+@macro allow
+@code{&allow-other-keys}@c
+@end macro
+
+@macro macref{foo}
+\foo\@c
+@end macro
+@macro tindexed{foo}
+\foo\@c
+@end macro
+@macro cindexed{foo}
+\foo\@c
+@end macro
+@macro vindexed{foo}
+\foo\@c
+@end macro
+@ifhtml
+@macro bibcite{foo}
+[@pxref{Bibliography, \foo\}]
+@end macro
+@end ifhtml
+@ifnothtml
+@macro bibcite{foo}
+[\foo\, @pxref{Bibliography}]
+@end macro
+@end ifnothtml
+
+@macro back
+\\@c
+@end macro
+
+@macro nil
+@code{()}@c
+@end macro
+
+@macro true 
+@code{T}@c
+@end macro
+
+@macro ansi
+@r{ANSI Common-Lisp}@c
+@end macro
+@macro ecls
+@b{@r{ECLS}}
+@end macro
+@macro clisp
+@r{Common-Lisp}@c
+@end macro
+@macro llisp
+@b{@r{Lisp}}
+@end macro
+@macro cltl
+@emph{@clisp{}: The Language}@c
+@end macro
+
+@ifinfo
+@ecls{} is an implementation of @clisp{} designed for being @emph{embeddable}
+into C based applications.
+
+@noindent Copyright @copyright{} 2000, Juan Jose Garcia-Ripoll
+@noindent Copyright @copyright{} 1990, Giusseppe Attardi
+
+@end ifinfo
+
+@titlepage
+@title ECLS User's Guide
+@author Giusseppe Attardi
+@author Juan Jose Garcia Ripoll (revised version)
+
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1990, Giusseppe Attardi
+
+Copyright @copyright{} 2000, Juan Jose Garcia Ripoll
+@end titlepage
+
+@c ************************ TOP NODE **************************
+
+@ifnottex
+@node Top, Introduction, (dir), (dir)
+@top Top
+@end ifnottex
+
+@iftex
+@page
+@titlefont{Preface}
+@vskip 1cm
+@end iftex
+
+@ecls{} is an implementation of @clisp{} originally designed for being
+@emph{embeddable} into C based applications.
+
+This document describes the @ecls{} implementation and how it differs from
+@bibcite{ANSI} and @bibcite{Steele:84}. In general, as work in @ecls{} is
+completed section by section, we will drop compatibility with
+@bibcite{Steele:84} and the corresponding chapter will be updated to document
+@emph{only} the differences with @bibcite{ANSI}.
+
+This manual also documents some implementation facilities, such as the
+multithread facility of @ecls{} or the foreign function interface.
+And finally this manual is the main source of information to understand
+the low level details of @ecls{} and the way to customize this
+implementation.
+
+@menu
+* Introduction::                What ECLS is and how to install it.
+* Standards::                   Deviations from standards.
+* Input and output::            Accessing files with ECLS.
+* Memory management::           Bits and bytes of every object.
+* Program development::         Tracing, steppping, error handling, etc.
+* The interpreter::             The guts behind ECLS.
+* The compiler::                When you need speed@dots{}
+* Declarations::                Helping the compiler
+* OS interface::                Operating system interface.
+* Macros::                      Implementation dependent features of macros.
+* C Language::                  Interfacing with foreign languages.
+* CLOS::                        Common-Lisp's Object System.
+* Multithread::                 Lisp lightweight processes or threads.
+* Implementation details::      What you should know to tweak ECLS.
+* Everything::                  All functions/variables/etc enumerated.
+* Bibliography::                Some interesting books.
+@end menu
+
+@node Introduction, Standards, Top, Top
+@chapter Introduction
+
+@ecls{} is an implementation of the @clisp{} language that was born from
+Giusseppe Attardi's ECoLisp environment, which was in turn based on Kyoto
+Common-Lisp. See @ref{Credits} for the history of the code you are up to use.
+
+@ecls{} (ECL for short) uses standard C calling conventions for Lisp compiled
+functions, which allows C programs to easily call Lisp functions and
+viceversa. No foreign function interface is required: data can be exchanged
+between C and Lisp with no need for conversion.
+
+@ecls{} is based on a Common Runtime Support (CRS) which provides basic
+facilities for memory managment, dynamic loading and dumping of binary images,
+support for multiple threads of execution.  The CRS is built into a library
+that can be linked with the code of the application.  @ecls{} is modular: main
+modules are the program development tools (top level, debugger, trace,
+stepper), the compiler, and CLOS.  A native implementation of CLOS is available
+in @ecls{}: one can configure @ecls{} with or without CLOS.  A runtime version
+of @ecls{} can be built with just the modules which are required by the
+application.
+
+The @ecls{} compiler compiles from Lisp to C, and then invokes the GNU C
+compiler to produce binaries.
+
+While ECoLisp adheres to the the reference of the language given in
+@bibcite{Steele:84}, the aim of @ecls{} is to achieve maximum compliance with
+@ansi{}, the most up to date standard for @clisp{}.
+
+Throughout this manual we will describe the @ecls{} implementation and
+how it differs from @bibcite{ANSI} and @bibcite{Steele:84}. In general, as
+work in @ecls{} is completed section by section, we will drop compatibility
+with @bibcite{Steele:84} and the corresponding chapter will be updated to
+document @emph{only} the differences with @bibcite{ANSI}.
+
+@menu
+* Credits::                     
+* Copyright::                   
+* Installation::                Installing a binary distribution.  
+* Rebuilding ECLS::             Building @ecls{} from sources.
+* Invoking ECLS::               Basic skills.
+@end menu
+
+@node Credits, Copyright, Introduction, Introduction
+@section Credits
+
+@ecls{} is derived from Giusseppe Attardi's ECoLisp, a full implementation of
+Common-Lisp as reported in @cite{Steele:84}. ECoLisp derives itself mostly
+from Kyoto @clisp{}, an implementation developed at the Research Institute for
+Mathematical Sciences (RIMS), Kyoto University, with the cooperation of Nippon
+Data General Corporation.  The main developers of Kyoto @clisp{} were Taiichi
+Yuasa and Masami Hagiya, of the Research Institute for Mathematical Sciences,
+at Kyoto University.
+
+I must thank Giusseppe Attardi, Yuasa and Hagiya for their wonderful work with
+preceding implementations and for putting them in the Public Domain under the
+GNU General Public Licence as published by the Free Software Foundation.
+Without them this product would have never been possible.
+
+This document is an update of the original ECoLisp documentation, which was
+based in part on the material in @bibcite{Yuasa:85}
+
+The following people or organizations must be credited for support in the
+devlopement of Kyoto @clisp{}: Prof. Reiji Nakajima at RIMS, Kyoto University;
+Nippon Data General Corporation; Teruo Yabe; Toshiyasu Harada; Takashi Suzuki;
+Kibo Kurokawa; Data General Corporation; Richard Gabriel; Daniel Weinreb; Skef
+Wholey; Carl Hoffman; Naruhiko Kawamura; Takashi Sakuragawa; Akinori Yonezawa;
+Etsuya Shibayama; Hagiwara Laboratory; Shuji Doshita; Takashi Hattori.
+
+William F. Schelter improved KCL in several areas and developed Austin Kyoto
+@clisp{} (AKCL). Many ideas and code from AKCL have been incorporated in
+@ecls{}.
+
+The following is the full list of contributors to ECoLisp:
+
+@table @sc
+@item Authors:
+
+@table @sc
+@item KCL:
+Taiichi Yuasa and Masami Hagiya
+@item Dynamic loader:
+William F. Schelter (@email{wfs@@fireant.ma.utexas.edu})
+@item Conservative GC:
+William F. Schelter
+@item Top-level, trace, stepper:
+Giuseppe Attardi
+@item Compiler:
+Giuseppe Attardi
+@item CLOS:
+Giuseppe Attardi with excepts from PCL by Gregor Kiczales
+@item Multithread:
+Giuseppe Attardi, Stefano Diomedi, Tito Flagella
+@item Unification:
+Giuseppe Attardi, Mauro Gaspari
+@end table
+
+@item MSDOS EMX port:
+Giuseppe Attardi
+@item ndmake45.exe
+Make utility by D. G. Kneller
+
+@item MSDOS GO32 port:
+Giuseppe Attardi
+@item ndmake45.exe
+Make utility by D. G. Kneller
+
+@item Linux port:
+Marcus Daniels (@email{marcus@@ee.pdx.edu})
+@item FreeBSD port:
+Cornelis van der Laan (@email{nils@@ims.uni-stuttgart.de})
+@item NeXT port:
+David Rudloff (@email{rudloff@@steinway.u-strasbg.fr})
+
+@item Other contributors:
+Dan Stanger (@email{dxs@@evolving.com}), Don Cohen
+(@email{donc@@ISI.EDU}), Brian Spilsbury
+(@email{brian@@bizo.biz.usyd.edu.au})
+@end table
+
+There is no list of contributors to @ecls{}, yet, but you are free to contact me
+at the following address:
+
+@example
+  Juan Jose Garcia-Ripoll (@email{worm@@arrakis.es})
+  Universidad de Castilla-La Mancha
+  Departamento de Matematicas,
+  E.T.S.I. Industriales,
+  Av. Camilo Jose Cela, 3
+  E-13071, Ciudad Real, Spain
+@end example
+
+@node Copyright, Installation, Credits, Introduction
+@section Copyright
+
+@noindent Copyright @copyright{} 2000 Juan Jose Garcia Ripoll
+
+@noindent Copyright @copyright{} 1990, 1991, 1993 Giuseppe Attardi
+
+@noindent Copyright @copyright{} 1984 Taiichi Yuasa and Masami Hagiya
+
+@noindent All Rights Reserved
+
+@noindent Summary:
+
+@quotation
+Permission is granted to use, copy, modify this program,
+EXCEPT that the copyright notice must be reproduced on copies, and
+credit should be given to the authors where it is due.
+WE MAKE NO WARRANTY AND ACCEPT NO LIABILITY FOR THIS PROGRAM.
+@end quotation
+
+@noindent In detail:
+
+@enumerate
+@item
+Permission to use, copy, modify this software and its documentation
+for any purpose is hereby granted without fee, provided that
+@itemize
+@item the above copyright notice appears in all copies,
+@item both that copyright notice and this permission notice appears in supporting documentation, and that
+@item you cause modified files to carry prominent notices stating that you changed the files and the date of any change.
+@end itemize
+
+@item
+Please notify us if you are going to sell this software or its documentation
+for profit.
+
+@item
+WE DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL WE BE LIABLE FOR
+ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
+RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE
+USE OR PERFORMANCE OF THIS SOFTWARE.
+@end enumerate
+
+@noindent Additionally:
+
+@quotation
+@ecls{} is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version; see file 'Copying'.
+
+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 Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+@end quotation
+
+@noindent Address for reporting bugs, comments, suggestions:
+@quotation
+@email{worm@@arrakis.es}
+@end quotation
+
+
+@node Installation, Rebuilding ECLS, Copyright, Introduction
+@section Installation
+
+Usually I build current binaries for the platforms I have access to,
+and these are placed in
+@table @asis
+@item Linux
+@uref{http://www.arrakis.es/~worm/ecls-linux.tgz}
+@item FreeBSD (>= 4.0)
+@uref{http://www.arrakis.es/~worm/ecls-freebsd.tgz}
+@end table
+
+To install them you need only unpack them on the root directory,
+and the program will install itself under
+@example
+/usr/local/bin		ecls program
+/usr/local/lib/ecls	libraries and headers
+/usr/local/man/man1     ecls.1 manual page
+/usr/local/info         ecls.info user guide
+@end example
+
+The flags which I used to build the program are summarized in
+@file{/usr/local/lib/ecls/BUILD-STAMP}. You should check that they
+correspond to your needs before using @ecls{} --i.e., it could be a too
+old version, garbage collector might not be the right one or TCP/IP
+support could have been removed.
+
+@node Rebuilding ECLS, Invoking ECLS, Installation, Introduction
+@section Rebuilding ECLS
+
+@enumerate
+@item Obtain the distribution from @uref{http://www.arrakis.es/~worm/ecls.html}.
+The distribution is in a gzip-compressed tar file named like
+@file{ecls.tgz}
+
+@item Prepare a directory (hereafter called @dfn{ECLS directory}) for
+ECLS.  In the following examples, we suppose that the @emph{ECL
+directory} is @file{/usr/local/ecl}.
+
+@item  Extract the content from the compressed tar file.
+@example
+zcat ecls.tgz | tar xf -
+@end example
+
+@item An autoconfiguration mechanism allows you to perform a standard
+installation with the following commands:
+@example
+./configure
+@end example
+This example will prepare to install executable files, manual pages and
+info files in standard directories like @file{/usr/local/bin},
+@file{/usr/local/man/man1}, @file{/usr/local/info}.
+
+@item If you don't have access rights to these directories, you shoud
+give to configure alternate places.  Try @code{./configure -help} for
+instructions on how to supply this information to configure, but
+a good starting point is
+@example
+./configure --prefix=$HOME
+@end example
+
+@item Make sure everything went ok with the configuration.
+The configuration script figures out the machine where it is running and
+creates a directory @code{machine} where to perform the installation.  If the
+program fails to recognize the machine, you will have to check whether it is
+one of the supported machines present in @code{src/h/machine.h}.
+
+@item Next you must build the program and install it
+@example
+make
+make install
+@end example
+@end enumerate
+
+At the end of installation, the destination directories will contain
+several files. If you have not modified these directories when
+invoking @file{configure} the layout should be
+
+@example 
+Executable files:
+    /usr/local/bin/ecls              the @ecls{} interpreter and compiler
+
+Help documents:
+    /usr/local/lib/ecls/help.doc     data for the online help
+    /usr/local/man/man1/ecls.1       manual page for @ecls{}
+    /usr/local/info/ecls.info        this manual you are reading
+
+Library files and headers:
+    /usr/local/lib/ecls/libecls.a    the core library in C
+    /usr/local/lib/ecls/libgmp.a     GNU library for bignums
+    /usr/local/lib/ecls/libgc.a      Boehm-Weiser garbage collector
+    /usr/local/lib/ecls/*.a          Other lisp compiled code
+    /usr/local/lib/ecls/h/           Header files
+
+Support files:
+    /usr/local/lib/ecls/ecls.sym     Symbols defined in executable.
+                                     Required for loading object files.
+@end example
+
+You can remove all intermediate files produced during installation with the
+command @code{make clean}.
+
+
+@node Invoking ECLS,  , Rebuilding ECLS, Introduction
+@section Entering and leaving @ecls{}
+ 
+@ecls{} is invoked by the command @code{ecls}.
+
+@example
+% ecls
+ECLS (ECoLisp-Spain) 0.0e
+Copyright (C) 1984 Taiichi Yuasa and Masami Hagiya
+Copyright (C) 1993 Giuseppe Attardi
+Copyright (C) 2000 Juan J. Garcia-Ripoll
+        ECLS is free software, and you are welcome to redistribute it
+under certain conditions; see file 'Copyright' for details.
+Type :h for Help.  Top level.
+> 
+@end example
+
+When invoked, @ecls{} will print the banner and initialize the system.  The
+date in the @ecls{} banner identifies the revision of @ecls{}.  @code{Version
+(0.8) 05/14/1993} is the value of the function
+@code{lisp-implementation-version}.
+
+If there exists a file named @file{init.lsp} in the current working directory,
+@ecls{} successively evaluates the forms in the file, immediately after the
+system initialization.  The user may set up his or her own @ecls{} environment
+(e.g., the memory configuration) with @file{init.lsp}.
+
+After the initialization, @ecls{} enters the @dfn{top-level loop} and prints
+the prompt `@code{>}'.
+
+@example
+Type :h for Help.  Top level.
+>
+@end example
+
+The prompt indicates that @ecls{} is now ready to receive a form from the
+terminal and to evaluate it.
+
+Usually, the current package (i.e., the value of @var{*package*}) is the user
+package, and the prompt appears as above.  If, however, the current package is
+other than the user package, then the prompt will be prefixed by the package
+name.
+
+@example
+> (in-package 'cl)
+#<"COMMON-LISP" package>
+COMMON-LISP> (in-package 'system)
+#<"SYSTEM" package>
+SYSTEM>
+@end example
+
+To exit from @ecls{}, call the function @code{quit}.
+
+@example
+>(quit)
+Bye.
+%
+@end example
+
+Alternatively, you may type @ctrl{D}, i.e. press the key @key{D} while pressing
+down the control key (@key{Ctrl}).
+
+@example
+>@ctrl{D}Bye.
+%
+@end example
+
+You can disable @ctrl{D} as the exit command by setting to @code{T} the
+following variable:
+@defvr {System} {*ignore-eof-on-terminal-io*}
+This variable controls whether an end of file character (normally @ctrl{D})
+should terminate the session. The default value is @nil{}.
+@end defvr
+
+The top-level loop of @ecls{} is almost the same as that defined in Section
+20.2 of @bibcite{Steele:84}.  Since the input from the terminal is in line
+mode, each top-level form should be followed by a newline.  If more than one
+value is returned by the evaluation of the top-level form, the values will be
+printed successively.  If no value is returned, then nothing will be printed.
+@example
+>(values 1 2)
+1
+2
+>(values)
+
+>
+@end example
+
+When an error is signalled, control will enter the break loop.
+@example
+>(defun foo (x) (bar x))
+foo
+
+>(defun bar (y) (bee y y))
+bar
+
+>(foo 'lish)
+Error: The function BEE is undefined.
+Error signalled by BAR.
+
+Broken at BAR.
+>>
+@end example
+
+@c @vskip 1em
+
+`@code{>>}' in the last line is the prompt of the break loop.  Like in the
+top-level loop, the prompt will be prefixed by the current package name, if the
+current package is other than the @code{user} package.
+
+To go back to the top-level loop, type @code{:q}
+
+@example
+>>:q
+
+Top level.
+>
+@end example
+
+@c @vskip 1em
+
+See Section 5.4 for the details of the break loop.
+
+The terminal interrupt (usually caused by typing @ctrl{C} (Control-@code{C}))
+is a kind of error.  It breaks the running program and calls the break level
+loop.
+
+Example:
+@example
+>(defun foo () (do () (nil)))
+foo
+
+>(foo)
+@ctrl{C}
+Correctable error: Console interrupt.
+Signalled by DO.
+
+Broken at FOO.
+>>
+@end example
+
+@node Standards, Input and output, Introduction, Top
+@chapter Standards
+
+@ecls{} supports all @clisp{} data types exactly as defined in the
+@bibcite{Steele:84}.  This chapter simply complements Chapter 2 of
+@bibcite{Steele:84}, by describing implementation dependent features of
+@clisp{} data types.  Each section in this chapter corresponds to the section
+in Chapter 2 of @bibcite{Steele:84}, with the same section title.
+
+@menu
+* Numbers::                     
+* Characters::                  
+* Symbols::                     
+* List and conses::             
+* Arrays::                      
+* Hash tables::                 
+* Readtables::                  
+* Packages::                    
+* Pathnames::                   
+* Streams::                     
+* Random-states::               
+* Structures::                  
+* Functions::                   
+* Unreadable data objects::     
+* Overlap of types::            
+* ANSI-CL compliance::          
+@end menu
+
+
+@node Numbers, Characters, Standards, Standards
+@section Numbers
+
+@menu
+* Integers::                    
+* Ratios::                      
+* Floating-point numbers::      
+* Complex numbers::             
+@end menu
+
+
+@node Integers, Ratios, Numbers, Numbers
+@subsection Integers
+
+@tindexed{Fixnum}'s in @ecls{} are those integers in the range (-2^29)
+to (2^29-1), inclusive.  They are represented as immediate data, so no
+memory allocation is involved when using @code{fixnum}'s.  Other
+integers are @code{bignums}. Thus 25 factorial (25!)
+
+@example
+15511210043330985984000000
+@end example
+
+@noindent is definetely a bignum in @ecls{}.
+
+@clisp{} constants related to integers have the following values
+in @ecls{}.
+
+@example
+most-positive-fixnum = 536870911 = 2^29-1
+most-negative-fixnum = -536870912 = - 2^29
+boole-1 = 3
+boole-2 = 5
+boole-and = 1
+boole-andc1 = 4
+boole-andc2 = 2
+boole-c1 = 12
+boole-c2 = 10
+boole-clr = 0
+boole-eqv = 9
+boole-ior = 7
+boole-nand = 14
+boole-nor = 8
+boole-orc1 = 13
+boole-orc2 = 11
+boole-set = 15
+boole-xor = 6
+@end example
+
+See Chapter 12 of @bibcite{Steele:84} for their meanings.
+
+
+@node Ratios, Floating-point numbers, Integers, Numbers
+@subsection Ratios
+
+There are no implementation-dependent features for ratios.
+
+@node Floating-point numbers, Complex numbers, Ratios, Numbers
+@subsection Floating-Point Numbers
+
+@ecls{} supports two floating point formats: @tindexed{single-float} and
+@tindexed{double-float}.  These are implemented with IEEE single and double
+float arithmetic, respectively.  @code{short-float} is a synonym for
+@code{single-float}, and @code{long-float} is a synonym for
+@code{double-float}.  The initial value of @vindexed{read-default-float-format}
+is @code{single-float}.
+
+Both @code{single-float} and @code{double-float} are represented with a pointer
+descriptor, so float operations can cause number consing.  Number consing is
+greatly reduced if type declarations are supplied in programs.
+
+An expression such as @code{(eql 1.0s0 1.0d0)} is false, but @code{(eql 1.0f0
+1.0d0)} is true.  Similarly, @code{(typep 1.0l0 'short-float)} is false, but
+@code{(typep 1.0l0 'double-float}) is true.  For output purposes all
+floating-point numbers are assumed to be of @emph{single} or @emph{double}
+format.
+
+The floating-point precisions and exponent sizes are:
+
+@example
+Format    precision exponent    
+---------------------------- 
+Short      24 bits    8 bits
+Single     24 bits    8 bits
+Double     53 bits   11 bits
+Long       53 bits   11 bits
+@end example
+
+There is no ``minus zero.'' @code{(eql 0.0 -0.0)} is true.
+
+
+@clisp{} constants related to floating-point numbers have the following values
+in @ecls{}.
+@example
+most-positive-short-float
+  = most-positive-single-float
+  = - most-negative-short-float
+  = - most-negative-single-float
+  = 3.402823s38
+
+least-positive-short-float
+  = least-positive-single-float
+  = - least-negative-short-float
+  = - least-negative-single-float
+  = 1.401298s-45
+
+most-positive-long-float
+  = most-positive-double-float
+  = - most-negative-long-float
+  = - most-negative-double-float
+  = 1.797693134862315f308
+
+least-positive-long-float
+  = least-positive-double-float
+  = - least-negative-long-float
+  = - least-negative-double-float
+  = 4.940656458412469f-324
+
+short-float-epsilon
+  = 2.980232s-8
+
+short-float-negative-epsilon
+  = 2.980232s-8
+
+long-float-epsilon
+  = double-float-epsilon
+  = single-float-epsilon
+  = 5.5511151231257827f-17
+
+long-float-negative-epsilon
+  = double-float-negative-epsilon
+  = single-float-negative-epsilon
+  = 5.5511151231257827f-17
+
+pi = 3.141592653589793
+@end example
+
+See Chapter 12 of @bibcite{Steele:84} for their meanings.
+
+@node Complex numbers,  , Floating-point numbers, Numbers
+@subsection Complex Numbers
+
+There are no implementation-dependent features for complex numbers.
+
+
+@node Characters, Symbols, Numbers, Standards
+@section Characteres
+
+@ecls{} is fully @ansi{} compliant in all aspects of the character
+data type, with the following peculiarities.
+
+@menu
+* Character types::             
+* Standard characters::         
+* Line divisions::              
+* Non-standard characters::     
+* Character attributes::        
+@end menu
+
+@node Character types, Standard characters, Characters, Characters
+@subsection Character types
+
+In @ecls{} the @code{extended-character} is empty, and all characters
+are implemented using 8-bit codes.
+
+
+@node Standard characters, Line divisions, Character types, Characters
+@subsection Standard Characters
+
+@ecls{} supports all standard and semi-standard characters listed in Section
+2.2.1 of @bibcite{Steele:84}.  Non-printing characters have the following
+character codes.
+@example
+Character        Code  (in octal)
+--------------------------------
+#@back{}Null                  000
+#@back{}Space                 040
+#@back{}Newline               012
+#@back{}Backspace             010
+#@back{}Tab                   011
+#@back{}Linefeed              012
+#@back{}Page                  014
+#@back{}Return                015
+#@back{}Rubout                177
+@end example
+
+Note that @code{#@back{}Linefeed} is synonymous with @code{#@back{}Newline} and
+thus is a member of @code{standard-char}.  Other semi-standard characters are
+not members of @code{standard-char}.
+
+@node Line divisions, Non-standard characters, Standard characters, Characters
+@subsection Line Divisions
+
+Since @ecls{} represents the @code{#@back{}Newline} character by a single code
+12, problems with line divisions discussed in Section 2.2.2 of the
+@bibcite{Steele:84} are absent in @ecls{}.
+
+
+@node Non-standard characters, Character attributes, Line divisions, Characters
+@subsection Non-standard Characters
+
+@ecls{} supports no additional non-standard characters.
+
+
+@node Character attributes,  , Non-standard characters, Characters
+@subsection Character Attributes
+
+Characters in @ecls{} have no attributes, and thus it lacks the functions and
+variables @code{#'char-bits}, @code{#'char-font}, @code{char-bits-limit}, etc,
+defined in Chapter 13 of @bibcite{Steele:84}.
+
+
+@node Symbols, List and conses, Characters, Standards
+@section Symbols
+ 
+The print name of a symbol may consist of up to 16777216 (i.e., the value of
+@code{array-total-size-limit}) characters.  However, when a symbol is read, the
+number of characters (not counting escape characters) in the print name is
+limited to 2048.
+
+It is not recommended to write on the strings which have been passed to
+#'make-symbol or returned from #'symbol-name.
+
+@node List and conses, Arrays, Symbols, Standards
+@section List and Conses
+
+There are no implementation-dependent features for lists and conses.
+
+
+@node Arrays, Hash tables, List and conses, Standards
+@section Arrays
+
+@ecls{} arrays can have up to 64 ranks.
+
+When the value of the @clisp{} variable @code{*print-array*} (see Section
+22.1.6 of @bibcite{Steele:84}) is @nil{}, then bit-vectors are printed as
+@code{#<a bit-vector @var{address}>}, other vectors are printed as @code{#<a
+vector @var{address}>}, and other arrays are printed as @code{#<an array
+@var{address}>}. The default value for @code{*print-array*} is @nil{}.
+
+@clisp{} constants related to arrays have the following values in @ecls{}.
+
+@example
+    array-dimension-limit = 16777216
+    array-rank-limit = 64
+    array-total-size-limit = 16777216
+@end example
+
+See Section 17.1 of @bibcite{Steele:84} for their meanings.
+
+@menu
+* Vectors::                     
+* Strings::                     
+* Bit-Vectors::                 
+@end menu
+
+
+@node Vectors, Strings, Arrays, Arrays
+@subsection Vectors
+
+In @ecls{}, array elements are represented in one of six ways depending on the
+type of the @code{array}.
+
+@example
+
+Array Type                               Element Representation
+---------------------------------------------------------------
+(array t) and (vector t)                      a cell pointer
+(array fixnum) and (vector fixnum)            32 bit signed integer
+(array string-char) and string                8 bit code
+(array short-float) and (vector short-float)  32 bit floating point
+(array long-float) and (vector long-float)    64 bit floating point
+(array bit) and bit-vector                    1 bit bit
+@end example
+
+
+@node Strings, Bit-Vectors, Vectors, Arrays
+@subsection Strings
+
+The @ecls{} implementation of strings is @ansi{} compliant. Four types 'string,
+'base-string, 'simple-string and 'simple-base-string are defined, but due to
+the lack of extended characters 'base-string and 'simple-base-string are
+simple aliases of 'string and 'simple-string.
+
+A string may consists of up to 16777216 (i.e., the value of
+@code{array-total-size-limit}) characters.  However, when a string is read, the
+number of characters in it (not counting escape characters) is limited
+to 2048.
+
+
+@node Bit-Vectors,  , Strings, Arrays
+@subsection Bit-Vectors
+
+There are no implementation-dependent features for bit-vectors.
+
+
+@node Hash tables, Readtables, Arrays, Standards
+@section Hash Tables
+
+All hash tables are printed as @code{#<a hash-table @var{address}>}.
+
+
+@node Readtables, Packages, Hash tables, Standards
+@section Readtables
+
+All readtables are printed as @code{#<a readtable @var{address}>}.
+
+
+@node Packages, Pathnames, Readtables, Standards
+@section Packages
+
+The following packages are built into @ecls{}.
+
+@multitable {common-lisp-user} {cl-user, user}
+@item @b{Name} @tab @b{Nicknames}
+@item common-lisp @tab cl, lisp
+@item common-lisp-user @tab cl-user, user
+@item system @tab si
+@item keyword
+@end multitable
+
+For instance, the @code{system} package has two nicknames @code{sys} and
+@code{si}; @code{system:symbol} may be written as @code{sys:symbol} or
+@code{si:symbol}.
+
+Depending on the configuation option by which @ecls{} has been built,
+additional packages may be available:
+@example
+compiler clos xlib
+@end example
+
+The @code{compiler} package contains symbols used by the @ecls{} compiler.
+Other packages are described in Section 11.6 of @bibcite{Steele:84}.  The
+@code{clos} package is used for the internal symbols of the @clisp{} Object
+System, which is described in Chapter 14.  The @code{xlib} package is used for
+the internal symbols of CLX, the @clisp{} Language X Interface to the X Window
+System, which is described in a separate manual.
+
+Packages are printed as @code{#<@var{package-name} package>}.
+
+
+@node Pathnames, Streams, Packages, Standards
+@section Pathnames
+
+@ecls{} provides a @code{#} macro @code{#P"} that reads a pathname:
+@code{#P"@var{string}"} is equivalent to @code{(pathname "@var{string}"}).  For
+example, @code{#P"foo.lsp"} is equivalent to @code{(pathname "foo.lsp")}.
+The same format is used when a pathname is printed.
+
+The initial value of the @clisp{} variable
+@var{*default-pathname-defaults*} is @code{#P""} (or, equivalently,
+@code{(pathname "")}).
+
+A pathname in the file system of @clisp{} consists of six elements:
+host, device, directory, name, type and version.  Among these elements,
+@ecls{} does not use @code{version}.  That is, when converting a
+namestring into a pathname, @ecls{} turns this element into @nil{}.
+Conversely, when converting a pathname into a namestring, @ecls{}
+ignores the version.
+
+Let me briefly explain how @ecls{} converts a namestring into a
+pathname. First @ecls{} tries parsing the namestring using the logical
+pathnames syntax, which is as follows
+@example
+        [hostname:][;][directory-item;]*[name][.type]
+        hostname = word
+        directory-item, name, type = wildcard-word
+@end example
+@noindent
+Here, @var{word} is a sequence of one or more characters excluding
+the @code{#\Null} character and the asterisk `*'. And
+@var{wildcard-word} is a sequence of any character excluding
+@code{#\Null} and consecutive asterisks (i.e.  @code{"**"} is not
+allowed).
+
+If @var{hostname} is not found or it is not a logical hostname, then
+@ecls{} tries the physical pathname syntax,
+@example
+        [device:][[//hostname]/][directory-item/]*[name][.type]
+        device, hostname = word
+        directory-item, name, type = wildcard-word
+@end example
+@noindent
+If this syntax also fails, then the namestring is not a valid
+pathname string.
+
+The following rules apply to both physical and logical namestrings.
+First, if a namestring contains one or more periods `.', the last period
+separates the namestring into the file name and the filetype.
+
+@example
+     "foo.lsp"
+         name:          "foo" 
+         type:          "lsp"
+
+     "a.b.c" 
+         name:          "a.b" 
+         type:          "c" 
+@end example
+
+If a namestring ends with a period, the filetype becomes the null string.
+@example
+     "foo." 
+          name:          "foo" 
+          type:          ""  (null string)
+@end example
+
+If a namestring begins with a period, the file name becomes @nil{}.
+@example
+     ".lsp" 
+          name:          nil 
+          type:          "lsp" 
+@end example
+
+If a namestring contains no period, the filetype is @nil{}.
+@example
+    "foo" 
+          name:          "foo" 
+          type:          nil 
+@end example
+
+In a pathname, the file directory is represented as a list which
+always begins with either @code{:relative} or @code{:absolute}
+@example
+     "common/demo/foo.lsp" 
+     ";common;demo;foo.lsp" 
+          directory:     (:relative "common"   "demo") 
+          name:          "foo" 
+          type:          "lsp" 
+     "/common/demo/foo.lsp" 
+     "common;demo;foo.lsp" 
+          directory:     (:absolute "common"   "demo") 
+          name:          "foo" 
+          type:          "lsp"
+@end example
+
+If a namestring does not contain a directory, the directory component
+of the pathname is @nil{}.
+@example
+     "foo.lsp" 
+          directory:     nil 
+          name:          "foo" 
+          type:          "lsp" 
+@end example
+
+The abbreviation symbols `@code{.}' and `@code{..}' may be used in a
+namestring, but only the second one is translated to a standard
+keyword
+@example
+     "./demo/queen.lsp" 
+          directory:     (:relative "." "demo") 
+          name:          "queen" 
+          type:          "lsp" 
+
+     "../../demo/queen.lsp" 
+          directory:     (:relative @pxlref{:up} :up "demo") 
+          name:          "queen" 
+          type:          "lsp" 
+@end example
+
+The part of a namestring after the last directory separator (`@code{/}'
+or `@code{;}') is always regarded as representing the file name and the
+filetype.  In order to represent a pathname with both the name and the
+filetype @nil{}, end the pathname with a slash.
+@example
+     "/usr/common/" 
+          directory:     (:absolute "usr" "common") 
+          name:          nil 
+          type:          nil 
+
+     "/usr/common/.lsp" 
+          directory:     (:absolute "usr" "common") 
+          name:          nil 
+          type:          "lsp" 
+@end example
+
+`@code{*}' in the place of file name or filetype becomes  @code{:wild}
+@example
+     "*.lsp" 
+          name:          :wild
+          type:          "lsp" 
+
+     "foo.*" 
+          name:          "foo" 
+          type:          :wild 
+@end example
+
+
+@node Streams, Random-states, Pathnames, Standards
+@section Streams
+
+Streams are printed in the following formats.
+@table @code
+@item #<input stream @var{file-name}>
+An input stream from the file @var{file-name}.
+
+@item #<output stream @var{file-name}>
+An output stream to the file @var{file-name}.
+
+@item #<string-input stream from @var{string}>
+An input stream generated by @code{(make-string-input-stream
+@var{string} )}.
+
+@item #<a string-output stream>
+An output stream generated by the function @code{make-string-output-stream}.
+
+@item #<a two-way stream>
+A stream generated by the function @code{make-two-way-stream}.
+
+@item #<an echo stream>
+A bidirectional stream generated by the function @code{make-echo-stream}.
+
+@item #<synonym stream to @var{symbol}>
+The stream generated by @code{(make-synonym-stream @var{symbol} )}.
+
+@item #<a concatenated stream>
+An input stream generated by the function @code{make-concatenated-stream}.
+
+@item #<a broadcast stream>
+An output stream generated by the function @code{make-broadcast-stream}.
+@end table
+
+
+@node Random-states, Structures, Streams, Standards
+@section Random-States
+
+@ecls{} provides a @code{#} macro `@code{#$}' that reads a random state.
+@code{#$}@var{integer} is equivalent to @code{(make-random-state
+@var{integer})}.  The same format is used when a random state is printed.
+
+
+@node Structures, Functions, Random-states, Standards
+@section Structures
+
+There are no implementation-dependent features for structures.
+
+
+@node Functions, Unreadable data objects, Structures, Standards
+@section Functions
+
+@table @code
+@item (lambda @var{lambda-list} . body)
+A lambda-expression with null lexical environment and with no implicit block
+around it.  This type of function typically appears when @code{`(lambda
+@var{lambda-list} .  body)} is evaluated.
+
+@item (lambda-block @var{block-name   lambda-list}  .  body)
+A lambda-expression with null lexical environment but with an implicit block
+around it.  This type of function typically appears when @code{(defun
+@var{function-name lambda-list} .  body)} is evaluated.  In this case,
+@var{block-name} is identical to @var{function-name} .
+
+@item (lambda-closure @var{env1   env2   env3   lambda-list} .  body)
+
+A lambda-expression with lexical environments but with no implicit block around
+it.  This type of function typically appears when @code{#`(lambda
+@var{lambda-list} .  body)} (or, equivalently, @code{(function (lambda
+@var{lambda-list} .  body))}) is evaluated. @var{env1}, @var{env2}, and
+@var{env3} represent the variable bindings, the local function/macro
+definitions, and the tag/block-name establishments, respectively, at the time
+the closure was created.
+
+@item (lambda-block-closure @var{env1 env2 env3 block-name lambda-list}  .  body)
+
+A lambda-expression with lexical environments and with an implicit block around
+it.  Local functions and local macros are represented in this
+format. @var{env1}, @var{env2}, and @var{env3} represent the variable bindings,
+the local function/macro bindings, and the tag/block-name establishments,
+respectively, at the time the local function/macro was created by @code{flet},
+@code{labels}, or @code{macrolet}.  The @var{block-name} is identical to the
+local function/macro name.
+@end table
+
+Compiled functions (including compiled macro-expansion functions) are printed
+in the following formats.
+
+@example
+#<compiled-function @var{name}>
+@end example
+or
+@example
+#<compiled-closure nil>
+@end example
+
+Incidentally, the value of @code{(symbol-function @var{special-form-name})} is
+a list,
+@example
+(special . @var{address})
+@end example
+@noindent if @var{special-form-name} names a special form.
+
+@clisp{} constants related to functions have the following values in @ecls{}.
+
+@example
+call-arguments-limit = 64
+lambda-list-keywords = (@optional{} @rest{} @keys{} @allow{}
+                        @aux{} &whole &environment &body)
+lambda-parameters-limit = 64
+multiple-values-limit = 32
+@end example
+
+Refer to @bibcite{Steele:84} for their meanings.
+
+
+@node Unreadable data objects, Overlap of types, Functions, Standards
+@section Unreadable Data Objects
+
+There are no implementation-dependent features for unreadable data objects.
+
+
+@node Overlap of types, ANSI-CL compliance, Unreadable data objects, Standards
+@section Overlap types
+
+In @ecls{}, the types @code{number} and @code{array} are certainly subtypes of
+@code{common}, since @ecls{} does not extend the set of objects of these types.
+
+
+@node ANSI-CL compliance,  , Overlap of types, Standards
+@section ANSI-CL compliance
+
+In this section we have documented the how much @ecls{} implements of
+each section in @bibcite{ANSI}, and which are the most important
+implementation-dependent features.
+
+5. Data and control flow
+
+@itemize
+@item nth-value
+@end itemize
+
+10. Symbols:
+
+@itemize
+@item make-symbol: string becomes part of symbol
+@item symbol-name, copy-symbol
+@item gensym, fails for numeric argument >= MOST-POSITIVE-FIXNUM
+@item *gensym-counter*
+@end itemize
+
+11. Packages:
+
+@itemize
+@item package-name
+@item intern accepts any string designator, not only strings.
+@end itemize
+
+12. Numbers:
+
+@itemize
+@item floor, ceiling, truncate, round
+@item float, complex, realpart, imagpart, numerator, denominator
+@item zerop, plusp, minusp, evenp, oddp
+@item =, /=, <=, >=, <, >, +, -, *, /, 1+, 1- but they do not fail for single
+      non numeric argument
+@item max, min, but they do not contagiate floating-point nature.
+@item minusp, plusp, zerop
+@item sin, cos, tan
+@item pi
+@end itemize
+@itemize
+@item existence and behavior of -0.0 is not assured, with all failures
+      of compliance that it implies.
+@item since we do not have conditions, mathematical errors are simple
+      errors.
+@end itemize
+
+13. Characters: complete
+
+@itemize
+@item character = base-char > standard-char
+@item empty-char is an empty type
+@end itemize
+
+14. Conses:
+
+@itemize
+@item last
+@end itemize
+
+16. Strings: complete
+
+@itemize
+@item string-char = base-char
+@item simple-string-char = simple-base-char
+@item When :start1 or :start2 parameters are NIL they are taken as 0.
+@end itemize
+
+
+19. Filenames: complete, but simplistic
+
+@itemize
+@item :wild-inferiors is not supported
+@item of the possible wildcard combinations, only @code{:wild} works as expected.
+@item in @code{#'pathname-match-p} a @code{nil} directory is not regarded as @code{:wild}.
+@item enough-namestring does not return optimal namestring
+@end itemize
+
+20. Files:
+
+@itemize
+@item truename
+@item rename-file
+@item directory
+@end itemize
+
+
+@node Input and output, Memory management, Standards, Top
+@chapter Input and Output
+
+@menu
+* Read macros::                 
+* Input/Output functions::      
+* Block transfer::              
+* Network streams::             
+* CLOS streams::                
+@end menu
+
+
+@node Read macros, Input/Output functions, Input and output, Input and output
+@section Read macros
+
+@table @asis
+@item #P"
+@code{#"@var{string}"} reads a pathname. @code{#"@var{string}"} is equivalent
+to @code{(pathname "@var{string}")}.
+ 
+@item #$
+@code{#$@var{integer}} reads a random state. @code{#$}@var{integer} is
+equivalent to @code{(make-random-state @var{integer})}.
+@end table
+
+The @code{#} macro '@code{#,}' works as described in @bibcite{Steele:84}, only
+if it is included in a constant object.  The forms immediately after
+@code{`#,'} below will be evaluated when the compiled code is loaded.
+
+@example
+'#,x
+'(a b c (d #,e f) g)
+#(1 2 3 #,(+ a b c) 5 6)
+#C(0.0 #,(exp 1))
+@end example
+
+Otherwise, the effect of using '@code{#,}' is unpredictable.  Note that, when
+interpreted code is loaded, '@code{#,}' has the same effect as the @code{#}
+macro '@code{#.}'.
+
+
+@node Input/Output functions, Block transfer, Read macros, Input and output
+@section Input and Output Functions
+
+The input and output functions of @ecls{} almost follow the definitions in
+Chapter 22 of @bibcite{Steele:84}.  Most of the differences come from the fact
+that, in @ecls{}, input from the terminal is always in line mode and binary I/O
+is not supported.
+
+In @ecls{}, @code{*terminal-io*} is a two-way stream from the standard input
+and to the standard output.  The echoing to the terminal is performed by the
+underlying operating system.  In particular, when a disk file is assigned to
+the standard output, nothing will be echoed at the terminal.
+
+Those functions that deviate from the definitions in @bibcite{Steele:84} are
+listed below.
+
+@defun {load} {@var{pathname} @keys{} :print :verbose :if-does-not-exist}
+If @var{pathname} does not specify the filetype of the input file, then load
+first tries to load a file with the filetype @code{.o}, i.e., the fasl file
+(see Chapter 6). If it fails, then @code{load} tries to load a file with the
+filetype @code{.lsp}.  @ecls{} assumes that @code{.lsp} is the standard
+filetype for source files.  If it fails again, then @code{load} will load the
+specified file with no filetype.
+
+@code{load} recognizes a file as a fasl file if and only if the filetype of the
+file is @code{.o}.  Other files are assumed to be source files.
+@end defun
+
+@defun {open} {}
+The argument to the keyword variable @code{:element-type} and
+@code{:element-type} is always bound to the value @code{string-char}.
+@end defun
+
+@defun {close} {}
+The keyword variable @var{:abort} is always ignored.
+@end defun
+
+@defun {listen} {}
+@code{listen} always returns @true{}.
+@end defun
+
+@defun {read-char-no-hang} {}
+@code{read-char-no-hang} is equivalent to @code{read-char}.
+@end defun
+
+@defun {clear-input} {}
+@code{clear-input} and @code{clear-output} simply
+return @nil{} without doing anything.
+@end defun
+
+@defun {read-byte} {}
+@end defun
+@defun {write-byte} {}
+These functions may operate on any stream.  They read or write a byte (8 bits)
+at a time.
+@end defun
+
+The functions @code{princ}, @code{write-char} and @code{write-byte} do not
+always flush the stream.  The stream is flushed when
+@enumerate
+@item a newline character is written, or
+
+@item the input from the terminal is requested in the case that these
+functions operate on @code{*terminal-io*}
+@end enumerate
+
+
+@node Block transfer, Network streams, Input/Output functions, Input and output
+@section Block Transfer
+
+More efficient block transfer can be obtained with the following functions.
+
+@defun {read-bytes} {stream string start end}
+It reads from @var{stream} a series of bytes to be placed into @var{string}
+starting from position @var{start} up to @var{end} (exclusive). It returns the
+number of bytes actually transferred, or @code{-1} if the operation failed. The
+@var{stream} is automatically flushed. This function may operate on any stream.
+@end defun
+
+@defun {write-bytes} {stream string start end}
+It writes onto @var{stream}the series of bytes from @var{string} starting from
+position @var{start} up to @var{end} (exclusive). It returns the number of
+bytes actually transferred, or @code{-1} if the operation failed. The
+@var{stream} is automatically flushed. This function may operate on any stream.
+@end defun
+
+
+@node Network streams, CLOS streams, Block transfer, Input and output
+@section Network Streams
+
+With a configuration option, the following function is available which opens
+streams across network connections.
+
+@defun {open-client-stream} {host port}
+The string @var{host} indicates the name of the host, while @var{port} is an
+integer which identifies the port number to which to connect.  This function
+returns a two-way stream which can be used in any of the stream operations.
+@end defun
+
+@defun {open-server-stream} {host port}
+A stream connected to port number @var{port} is created to which clients can
+connect.  This function returns a two-way stream which can be used in any of
+the stream operations.
+@end defun
+
+
+@node CLOS streams,  , Network streams, Input and output
+@section CLOS Streams
+
+When the optional CLOS subsystem is available, an interface is provided by
+@ecls{} for using CLOS objects as @clisp{} input/output character streams.
+Such support can be used for instance to build interactive character streams,
+which may be used by applications as the stream argument for @clisp{} I/O
+functions such as @code{read}, @code{listen}, @code{prin1}, etc.  The
+fundamental interface to @code{interactive-stream} objects consists of
+(generic) functions which implement the basic @clisp{} character stream
+operations (see @clisp{}, Chapter 22) but whose details are implementation
+dependent.
+
+The following functions are automatically invoked by @ecls{} when a stream
+operation involves a CLOS object as a stream parameter. The programmer should
+define these methods for any class of objects which are to be used for
+character input/output.
+
+@menu
+* CLOS Stream Input::           
+* CLOS Stream Output::          
+@end menu
+
+@node CLOS Stream Input, CLOS Stream Output, CLOS streams, CLOS streams
+@subsection CLOS Stream Input
+
+Character input from an @code{interactive-stream} is implemented by the
+following methods.
+
+@deffn {Method} {stream-read-char} (object interactive-stream)
+Returns the next character object read from the CLOS stream @var{object}.
+@end deffn
+
+@deffn {Method} {stream-read-line} (object interactive-stream) @rest{} make-array-options
+Reads character objects from the CLOS stream @var{object}, up to and including
+the next @code{#\newline} character, and returns them as a string (without the
+@code{#\newline}. If given, the @var{make-array-options} arguments are passed
+to @code{make-array} when the returned string is created.
+@end deffn
+
+@deffn {Method} {stream-unread-char} (object interactive-stream) character
+Unreads the character object @var{character} from the CLOS stream @var{object}.
+@var{character} will be the next character read by @code{stream-read-char}.
+@end deffn
+
+@deffn {Method} {stream-peek-char} (object interactive-stream) peek-type
+Returns the character object which would be returned by @code{stream-read-char}
+but does not remove it from the input buffer.  If @var{peek-type} is @true{},
+@code{steam-peek-char} skips over any whitespace characters, removing them from
+the input buffer, and returns the next character.
+@end deffn
+
+@deffn {Method} {stream-listen} (object interactive-stream)
+Returns @nil{} is no character is immediately available from the CLOS stream
+@var{object}. Otherwise, the next character is returned, as if
+@code{stream-peek-char} had been called.
+@end deffn
+
+@deffn {Method} {stream-clear-input} object
+Clears any buffered characters on the CLOS stream @var{object}. Returns @nil{}.
+@end deffn
+
+@node CLOS Stream Output,  , CLOS Stream Input, CLOS streams
+@subsection CLOS Stream Output
+
+Character output from an @code{interactive-stream} is implemented by the
+following methods.
+
+@deffn {Method} {stream-write-char}  (object interactive-stream) character
+Outputs the character @var{character} to the CLOS stream @var{object} and
+returns it.
+@end deffn
+
+@deffn {Method} {stream-write-line}  (object interactive-stream) string @optional{} start end
+Writes character objects from thestring @var{string} onto the CLOS stream
+@var{object}. If given, the @var{start} and @var{end} arguments indicate a
+substring that is to be output.
+@end deffn
+
+@deffn {Method} {stream-fresh-line}  (object interactive-stream)
+Outputs a @code{#\back}@code{newline} character to the CLOS stream @var{object}
+if and only if the stream is not already at the beginning of a new line.
+Returns non-@nil{} if a @code{#\back}@code{newline} was output and @nil{}
+otherwise.
+@end deffn
+
+@deffn {Method} {stream-clear-output}  (object interactive-stream)
+Aborts any outstanding output operation on the CLOS stream @var{object} and
+returns @nil{}.
+@end deffn
+
+@deffn {Method} {stream-forse-output}  (object interactive-stream)
+Initiates the emptying of the internal buffers on the CLOS stream @var{object}
+and returns @nil{}.
+@end deffn
+
+@node Memory management, Program development, Input and output, Top
+@chapter Memory Management
+
+The following sections only apply to the @ecls{} original garbage collector.
+If @ecls{} is compiled with @code{--enable-boehm}, then an alternative,
+less restrictive garbage collector is installed, with the disadvantage
+that many of the following functions @code{#'room}, @code{si:*gc-verbose*},
+@dots{} do no longer work.
+
+@menu
+* Implementation types::        
+* Heap and relocatable areas::  
+* The garbage collector::       
+* Allocation functions::        
+* Storage information::         
+@end menu
+ 
+@node Implementation types, Heap and relocatable areas, Memory management, Memory management
+@section Implementation Types
+
+Each @ecls{} object belongs to one of the 22 @emph{implementation types}.  The
+implementation types are shown in Table 4-1 with the corresponding @clisp{}
+data types.  In the table, the compiled functions are divided into three
+implementation types; @code{cfun} is the type of compiled functions without
+environment, @code{cclosure} is the type of compiled functions with environment
+(i.e., the type of compiled closures) and @code{gfun} is the type of compiled
+generic functions of CLOS.
+
+@center Table 4-1  Implementation Types
+@c @vspace{1 em}
+@multitable {@emph{Implementation Type}} {@emph{@clisp{} Data Type}}
+@item @code{cons} @tab @code{cons}
+@item @tindexed{fixnum} @tab @tindexed{fixnum}
+@item @code{bignum} @tab @code{bignum}
+@item @code{ratio} @tab @code{ratio}
+@item @code{short-float} @tab @code{short-float}
+@item @code{long-float} @tab @code{long-float (= double-float = single-float)}
+@item @code{complex} @tab @code{complex}
+@item @code{character} @tab @code{character}
+@item @code{symbol} @tab @code{symbol}
+@item @code{package} @tab @code{package}
+@item @code{hash-table} @tab @code{hash-table}
+@item @code{array} @tab @code{(and array (not vector))}
+@item @code{vector} @tab  @code{(and vector (not string) (not bit-vector))}
+@item @code{string} @tab @code{string}
+@item @code{bit-vector} @tab @code{bit-vector}
+@item @code{structure} @tab @code{structure}
+@item @code{stream} @tab @code{stream}
+@item @code{random-state} @tab @code{random-state}
+@item @code{readtable} @tab @code{readtable}
+@item @code{cfun} @tab @code{compiled-function  without environment} 
+@item @code{cclosure} @tab @code{compiled-function  with environment} 
+@item @code{gfun} @tab @code{none (CLOS generic-function)} 
+@item @code{instance} @tab @code{none (CLOS instance)} 
+@item @code{thread} @tab @code{none (thread)} 
+@item @code{cont} @tab @code{none (continuation)} 
+@item
+@end multitable
+
+Each object is represented by a cell allocated in the heap area of the
+interpreter.  The size of the cell is determined by the implementation type of
+the object.
+
+The implementation types are classified according to the size of the cells for
+the objects of the type, as shown in Table 4-2.  The size of the cells in the
+same type class is the same.
+
+
+@center Table 4-2  Classification of Implementation Types
+@c @vspace{1 em}
+@multitable {@emph{Class}} {@emph{Implementation Types}}
+@item 1 @tab @code{CONS BIGNUM RATIO COMPLEX STRUCTURE}
+@item 2 @tab @code{SHORT-FLOAT RANDOM-STATE READTABLE}
+@item 3 @tab @code{LONG-FLOAT CFUN CCLOSURE}
+@item 4 @tab @code{SYMBOL}
+@item 5 @tab @code{PACKAGE}
+@item 6 @tab @code{ARRAY HASH-TABLE VECTOR BIT-VECTOR STREAM}
+@item 7 @tab @code{STRING}
+@item 8 @tab @code{PATHNAME}
+@end multitable
+
+For objects of the (implementation) types @code{readtable}, @code{symbol},
+@code{package}, @code{array}, @code{hash-table}, @code{vector},
+@code{bit-vector}, @code{stream}, @code{cclosure}, @code{string}, @code{cfun},
+and @code{structure} (or @code{instance}), the cell is simply a header of the
+object.  The body of the object is allocated separately from the cell and is
+managed in a different manner.  The memory space occupied by the body of such
+an object is called a @dfn{block}.  A block is either @dfn{contiguous} or
+@dfn{relocatable} depending on the area in which it is allocated.  The
+difference between the two areas will be explained below.  Table 4-3 lists
+these types, along with the contents of the body and the kind of the block.
+
+@center Table 4-3  Types with Bodies
+@c @vspace{1 em}
+@multitable {@emph{Type}} {@emph{Body}} {@emph{Block}}
+@item @code{readtable} @tab @code{read table} @tab @code{contiguous}
+@item @code{symbol} @tab @code{symbol name} @tab @code{relocatable}
+@item @code{package} @tab @code{hash table} @tab @code{contiguous}
+@item @code{array} @tab @code{array body} @tab @code{relocatable or contiguous}
+@item @code{hash-table} @tab @code{hash table} @tab @code{relocatable}
+@item @code{vector} @tab @code{vector body} @tab @code{relocatable or contiguous}
+@item @code{bit-vector} @tab @code{bit-vector body} @tab @code{relocatable or contiguous}
+@item @code{stream} @tab @code{I/O buffer} @tab @code{contiguous}
+@item @code{cclosure} @tab @code{code} @tab @code{contiguous}
+@item @code{string} @tab @code{string body} @tab @code{relocatable or contiguous}
+@item @code{cfun} @tab @code{code} @tab @code{contiguous}
+@item @code{structure} @tab @code{structure body} @tab @code{relocatable}
+@item @code{instance} @tab @code{instance slots} @tab @code{relocatable}
+@item @code{thread} @tab @code{thread data} @tab @code{contiguous}
+@end multitable
+
+Usually, the body of an array, a vector, a bit-vector, or a string is allocated
+as a relocatable block.  In @ecls{}, the function @code{make-array} takes an
+extra keyword argument @kwd{static}.  If the @kwd{static} argument is supplied
+with a non-@nil{} value, then the body of the array is allocated as a
+contiguous block.
+
+
+@node Heap and relocatable areas, The garbage collector, Implementation types, Memory management
+@section Heap and Relocatable Areas
+
+The memory space of @ecls{} is divided into two parts: the heap area and the
+relocatable area.  Both areas occupy a contiguous space in the memory.
+
+Cells of @ecls{} objects are allocated in the heap.  @ecls{} divides the heap
+into pages (1 page = 2048 bytes), and each page consists of cells in the same
+type class (see Table 4-2).  Cells in different type classes are allocated in
+different pages.  Some blocks are also allocated in the heap: They are called
+contiguous blocks.  The pages for contiguous blocks contain only contiguous
+blocks.  Thus each page in the heap is either a page for cells in a particular
+type class, or a page for contiguous blocks.  Blocks not in the heap are called
+relocatable blocks and are allocated in the relocatable area.
+
+The user may specify the maximum number of pages that can be allocated for each
+type class by calling the @ecls{} specific function @code{allocate}.  There is
+also a limit on the number of pages for contiguous blocks; the limit can be
+altered by calling the @ecls{} specific function
+@code{allocate-contiguous-pages} size of the relocatable area is specified by
+the @ecls{} specific function @code{allocate-relocatable-pages}.  See Section
+4.4 for these functions.
+
+In some installations of @ecls{}, the total amount of memory that @ecls{} can
+use is limited.  In such cases, the entire memory may become exhausted before
+the maximum number of pages for each type class, for contiguous blocks, or for
+the relocatable area have been allocated.
+
+The heap lies in a part of memory with lower address than the relocatable area
+and there is a ``hole'' between the two areas (see Figure 4-1).  On request for
+a new page of heap, the page with the lowest address in the hole is used.  When
+the hole is exhausted, the relocatable area is shifted toward the higher
+address space and a new hole of an appropriate size is created between the two
+areas.
+
+@center Figure 4-1  Heap and Relocatable Area
+@c @vspace{1 em}
+@example
+Lower address                         Higher address
++--------------+-------------------+---------------+
++ HEAP         |   HOLE            | RELOCATABLE   |
++--------------+-------------------+---------------+
+@end example
+
+@node The garbage collector, Allocation functions, Heap and relocatable areas, Memory management
+@section The Garbage Collector
+
+@ecls{} uses a @emph{conservative garbage collection} technique for collecting
+the C stack and a type accurate technique for areas containing Lisp objects.
+Scanning conservatively the C stack, looking for potential pointers to Lisp
+objects, ensures that no live Lisp objects get collected, even if they are
+passed to external procedures in C or some other language.  This approach
+greatly simplies integration of Lisp and C code, since it is not necessary to
+protect Lisp object form collection when a foreign function is invoked.
+
+The garbage collector of @ecls{} has three levels according to what it
+collects:
+@enumerate
+@item cells
+@item cells and relocatable blocks
+@item cells, relocatable blocks and contiguous blocks.
+@end enumerate
+
+In levels 2 and 3, the relocatable area is shifted to the higher address space
+to reserve an appropriate number of pages in the hole.
+
+For each type class, @ecls{} keeps a free list of unused cells, and when the
+free list is exhausted, a new page is allocated, or the garbage collector is
+invoked, depending on whether the maximum number of pages for that class have
+been allocated or not.
+
+The garbage collector does not compactify the heap.  That is, cells and
+contiguous blocks are never moved to another place.  Moreover, once a page is
+allocated for a particular type class or for contiguous blocks, that page will
+never be freed for other classes, even if the entire page becomes garbage.
+
+On the other hand, the relocatable area is compactified during level 2 and
+level 3 of garbage collection.  A relocatable block is really relocatable.
+
+The garbage collector is automatically invoked in one of the following
+situations.  The number in the parentheses indicates the level of garbage
+collection that is performed.
+
+@enumerate
+@item  The free list of a certain type class is exhausted
+after the maximum number of pages have been allocated for that type class (1).
+
+@item The hole is exhausted (2).
+
+@item The relocatable area is exhausted after the maximum number of
+pages have been allocated for the relocatable area (2).
+
+@item The contiguous blocks are exhausted after the maximum number of
+pages have been allocated for contiguous blocks (3).
+@end enumerate
+
+The garbage collector is also invoked by the following @ecls{} specific
+function.
+
+@defun {system} {gc} {x}
+The garbage collector is invoked with the level specified by @var{x}.  If
+@var{x} is @nil{}, the garbage collector is invoked for level 1 garbage
+collection.  If @var{x} is @true{}, it is invoked for level 3 garbage
+collection.  Otherwise, it is invoked for level 2 garbage collection.  If
+@code{sys:*gc-verbose*} is non-@nil{}, then it print messages at the start and
+end of each garbage collection.
+@end defun
+
+@defvar{*gc-verbose*}[system] This variable controls whether to print messages
+at the start and end of each garbage collection.  If @code{sys:*gc-verbose*} is
+@nil{}, @code{gc} foregoes printing any messages.  The default value is @code{T}.
+@end defvar
+
+
+@node Allocation functions, Storage information, The garbage collector, Memory management
+@section Allocation Functions
+ 
+The following functions are used to set or inspect the (maximum)
+number of pages for each type class, for contiguous blocks, or for
+relocatable blocks.
+
+@deffn {extensions} {allocate}  type number
+Sets the maximum number of pages for the type class of the implementation type
+@var{type} to @var{number}.  If more than @var{number} pages have already been
+allocated, an error is signalled.
+@end deffn
+
+@deffn {sys} {allocated-pages}  type
+Returns the number of pages currently allocated for the type class of the
+implementation type @var{type}.
+@end deffn
+
+@deffn {sys} {maximum-allocatable-pages}  type
+Returns the current maximum number of pages for type class of the
+implementation type @var{type}.
+@end deffn
+
+@deffn {sys} {allocate-contiguous-pages}  number
+Sets the maximum number of pages for contiguous blocks to @var{number}.
+@end deffn
+
+@deffn {sys} {allocated-contiguous-pages}  
+Returns the number of pages allocated for contiguous blocks.
+@end deffn
+
+@deffn {sys} {maximum-contiguous-pages}  
+Returns the current maximum number of pages for contiguous blocks.
+@end deffn
+
+@deffn {sys} {allocate-relocatable-pages}  number
+Sets the maximum number of pages for relocatable blocks to @var{number}.  The
+relocatable area is expanded to @var{number} pages immediately.
+Therefore,``the current maximum number'' and ``the number of pages allocated''
+have the same meanings for relocatable blocks.
+@end deffn
+
+@deffn {sys} {allocated-relocatable-pages}  
+Returns the number of pages allocated for relocatable blocks.
+@end deffn
+
+If the pages for a particular type class are exhausted after the maximum number
+of pages for that class have been allocated, and if there remain no free cells
+(actually, if there remain very few cells), @ecls{} behaves as directed by the
+argument that was initially passed to the @ecls{} specific function @code{(si::ignore-maximum-pages)}.  If the
+value is @nil{}, then @ecls{} signals a correctable error and enters the break loop.
+The user can reset the maximum number by calling @code{allocate} and then
+continue the execution of the program by typing @kwd{r}.
+
+Example:
+
+@example
+
+>(make-list 100000)
+
+Correctable error: The storage for CONS is exhausted.
+                   Currently, 531 pages are allocated.
+                   Use ALLOCATE to expand the space.
+Signalled by MAKE-LIST.
+
+Broken at FUNCALL.
+>>(ALLOCATE 'CONS 1000)
+t
+
+>>:r
+
+(nil nil nil nil nil nil nil nil nil nil ............
+@end example
+ 
+The user can also reset the maximum number of pages for relocatable blocks and
+for contiguous blocks in a similar manner.  On the other hand, if the value of
+@code{(si::ignore-maximum-pages)} is non-@nil{}, then @ecls{} automatically
+increments the maximum number of pages for the class by 50 percent.  The
+initial value of @code{(si::ignore-maximum-pages)} is @true{}.
+
+
+@node Storage information,  , Allocation functions, Memory management
+@section Storage Information
+ 
+@defun {room} {@optional{} x}
+The function @code{room} prints the storage information.  The argument
+@var{x}  is simply ignored and
+the output of @code{room}  is always in the same
+format.  @code{room}  prints the following information:
+@end defun
+
+@itemize
+
+@item for each type class
+@itemize
+@item the number of pages so-far allocated for the type class 
+@item the maximum number of pages for the type class
+@item the percentage of used cells to cells so-far allocated 
+@item the number of times the garbage collector has been 
+called to collect cells of the type class 
+@item the implementation types that belong to the type class
+@end itemize
+@item the number of pages actually allocated for contiguous blocks
+@item the maximum number of pages for contiguous blocks
+@item the number of times the garbage collector has been called to 
+collect contiguous blocks 
+@item the number of pages in the hole
+@item the maximum number of pages for relocatable blocks
+@item the number of times the garbage collector has been called to
+collect relocatable blocks 
+@item the total number of pages allocated for cells
+@item the total number of pages allocated
+@item the number of available pages
+@item the number of pages @ecls{} can use.
+@end itemize
+
+The number of times the garbage collector has been called is not shown, if the
+number is zero.
+
+In the following example, the maximum of @code{531} pages have already been
+allocated for the type class to which cons belongs, but only 16.9 percent of
+the cells are actually used.  The garbage collector was once invoked to collect
+cells in this type class.
+
+@example
+> (room)
+ 200/200   48.4%    CONS BIGNUM RATIO COMPLEX STRUCTURE
+   1/5      7.4%    SHORT-FLOAT RANDOM-STATE READTABLE
+  10/34    99.3%    LONG-FLOAT CFUN CCLOSURE
+  47/64    71.9%    SYMBOL
+   1/1      8.9%    PACKAGE
+   2/69    81.8%    ARRAY HASH-TABLE VECTOR BIT-VECTOR STREAM
+  16/40    95.9%    STRING
+   1/1      6.8%    PATHNAME
+
+   0/271            contiguous (1 blocks)
+     127            hole
+     40     3.4%    relocatable
+
+  278 pages for cells
+  445 total pages
+14709 pages available
+ 1230 pages in heap but not gc'd + pages needed for gc marking
+16384 maximum pages
+@end example
+
+
+@node Program development, The interpreter, Memory management, Top
+@chapter Program Development Facilities
+
+@menu
+* The tracer::                  
+* The stepper::                 
+* Errors::                      
+* The break loop::              
+* Describe and inspect::        
+* The profiler::                
+* Online help::                 
+@end menu
+
+@node The tracer, The stepper, Program development, Program development
+@section The Tracer
+ 
+The Tracer causes selected @code{functions} to be traced.  When such a traced  
+@code{function} is invoked, it prints
+@example
+  @var{level} > (@var{name   arg1   ...   argn}) 
+@end example
+
+On return from a traced @code{function}, it prints
+@example
+  < @var{level}  (@var{name   value1   ...   valuen}) 
+@end example
+
+@var{name} is the name of the traced @code{function}, @var{args} are the
+arguments, and @var{values} are the return values.  @var{level} is a number
+which is incremented each time a traced @code{function} is invoked and is
+decremented at the completion of the invocation.  Trace print-outs are indented
+according to the @var{level}.
+
+In the current version of @ecls{}, macros and special forms cannot be traced.
+
+@defmac {trace} {@{function-name | (function-name @{@keys{} form@}*)@}*}
+
+Causes one or more functions to be traced.  Each @var{function-name} must be a
+symbol which is not evaluated.  If a function is called from a compiled
+function in the same file, tracing will not be enabled.  If this is the case,
+to enable tracing, recompile the caller with a @code{notinline} declaration for
+the called function. @code{trace} returns a name list of those functions that
+were traced by the call to trace.  If no @var{function-name} is given,
+@code{trace} simply returns a name list of all the currently traced functions.
+
+Trace options can cause the normal printout to be suppressed, or cause extra
+information to be printed.  Each option is a pair of an option keyword and a
+value form. If an already traced function is traced again, any new options
+replace the old options.  @var{form} is an expression to be evaluated in an
+environment where @var{sys::arglist} is bound to the current list of arguments
+to the function.
+
+The following options are defined:
+
+@table @asis
+@item @kwd{cond} @var{form}
+@item @kwd{cond-before} @var{form}
+@item @kwd{cond-after} @var{form}
+If @kwd{cond-before} is specified, then @code{trace} does nothing unless
+@var{form} evaluates to true at the time of the call.  @kwd{cond-after} is
+similar, but suppresses the initial printout, and is tested when the function
+returns.  @kwd{cond} tries both before and after.
+
+@item @kwd{step} @var{form}
+If @var{form} evaluates to true, the stepper is entered.
+
+@item @kwd{break} @var{form}
+@item @kwd{break-after} @var{form}
+If specified, and @var{form} evaluates to true, then the debugger is invoked at
+the start of the function or at the end of the function according to the
+respective option.
+
+@item @kwd{print} @var{form}
+@item @kwd{print-after} @var{form}
+In addition to the usual printout, the result of evaluating @var{form} is
+printed at the start of the function or at the end of the function, according
+to the respective option.  Multiple print options cause multiple values to be
+@end table
+@end defmac
+
+@defmac {untrace} {@{function-name@}*}
+
+Causes the specified functions to be not traced any more.  @var{function-names}
+must be symbols and they are not evaluated. @code{untrace} returns a name list
+of those functions that were untraced by the call to @code{untrace}.  If no
+@var{function-name} is given, @code{untrace} will untrace all the currently
+traced functions and will return a list of their names.
+
+@end defmac
+
+
+@node The stepper, Errors, The tracer, Program development
+@section The Stepper
+
+@defmac {step} {form}
+
+Starts evaluating the @var{form} in the single-step mode.  In this mode, before
+any form is evaluated, the Stepper will print the form and prompt the user for
+a Stepper command.  The Stepper binds the two variables @vindexed{print-level}
+and @vindexed{print-length} both to @code{2}, so that the current form may not
+occupy too much space on the screen.  A Stepper command will be executed when
+the user types the single character for the command followed by the required
+arguments, if any, and presses the newline key.  If the user presses the
+newline key without having typed any character, then the Stepper will assume
+that the Stepper command @code{n} was abbreviated.
+
+@end defmac
+
+The stepper commands are:
+
+@table @asis
+@item @code{Newline}
+Next.  Evaluates the current form in the single-step mode.
+
+@item @kwd{s}, @kwd{skip}
+Skip.  Evaluates the current form in the ordinary mode.  The single-step mode
+will be resumed at completion of the evaluation.
+
+@item @kwd{b}, @kwd{back}
+Backwards.  Steps back to previous step form.
+
+@item @kwd{pr}, @kwd{print}
+Print.  Pretty-prints the current form.
+
+@item @kwd{form}
+Form. Return the current form.  Nothing is done, but the current form is
+returned as the value of this command.  As a consequence, it is printed by the
+top level in the usual way and saved in the variable @code{*}.  The main
+purpose of this command is to allow the current form to be examined further by
+accessing @code{*}.
+
+@item @kwd{ret}, @kwd{return}
+Return. Return without evaluating the current form.
+
+@item @kwd{x}, @kwd{exit}
+Exit.  Evaluates the current form and any other forms in the ordinary mode.
+
+@item @code{?}
+Help. Lists the commands.
+@end table
+
+@node Errors, The break loop, The stepper, Program development
+@section Errors
+
+@defvar{*break-enable*}
+
+This variable is used to determine whether to enter the break loop (see Section
+5.4) when an error occurs.  Even the function @code{break} checks this
+variable.  Initially, this variable is set to @true{}, and thus an error will
+invoke the break loop.  If the value is @nil{}, functions that cause fatal
+errors, such as @code{ error}, will just print an error message and control
+will return to the top-level loop (or to the current break loop, if already in
+the break loop).  Functions that cause correctable errors, such as @code{
+cerror}, will print an error message and a ``continue message'', and control
+will return to the next form.  In @ecls{}, backtrace is not part of an error
+message, but a break loop command will print backtrace.  Therefore, if
+@vindexed{break-enable} is @nil{}, no backtrace appears on the screen.
+
+When the break loop is entered, @vindexed{break-enable} will be bound to
+@nil{}.
+
+@end defvar
+
+@node The break loop, Describe and inspect, Errors, Program development
+@section The Break Loop
+ 
+The break loop is a read-eval-print loop similar to the top-level loop.  In
+addition to ordinary Lisp forms, the break loop accepts various commands with
+which the user can inspect and modify the state of the program execution.  Each
+break loop command is identified with a keyword (i.e., a symbol in the
+@code{keyword} package).  A break loop command is executed when the user inputs
+a list whose first element is the keyword that identifies the command.  The
+rest of the list is the arguments to the command.  They are evaluated before
+being passed to the command.  If the command needs no arguments, then the user
+may input only the keyword.  It is an error if the given keyword does not
+identify any command.  Any other input to the break loop is regarded as an
+ordinary Lisp form; the form will be evaluated and the resulting values will be
+printed on the terminal.
+
+There can be several instances of the break loop at the same time, and each
+such instance is identified by a @emph{level number}.  When the break loop is
+entered during execution in the top-level loop, the break loop instance is
+given the level number 1.  The break loop instance that is entered from the
+level @emph{n} break loop is given the level number @var{n}@code{+1}.  The
+prompt of the level @emph{n} break loop is @var{n}@code{+1} consecutive
+@code{>}'s, occasionally prefixed with the name of the current package.
+
+The break loop keeps track of the invocation sequence of functions (including
+special forms and macro expansion functions), which led up to the break loop
+from the previous break loop (or from the top-level loop, if the current break
+loop is level 1).  The invocation sequence is maintained in a pushdown stack of
+@emph{events}.  An event consists of an @emph{event function} and an
+@emph{event environment}.  An event function is:
+@enumerate
+@item an interpreted (i.e., not compiled) function (global function, local function, lambda-expression, or closure), 
+
+@item a special form within an interpreted function, 
+
+@item a macro expansion function called from an interpreted function, 
+
+@item a compiled function called from an interpreted function, or 
+
+@item a compiled function called from another compiled function which
+was compiled while the @code{safety} optimize level is 3 or with a
+@code{notinline} declaration for the called function (see Chapter 7).
+@end enumerate
+
+An event is pushed on the event stack when execution of its event function
+begins, and is poped away at the completion of the execution.  An event
+environment is the `environment' of the event function at the time the next
+event is pushed.  Actually, an event environment is a pointer to the main stack
+of @ecls{}.  For each interpreted event function (i.e., event function in
+classes 1, 2, and 3), the pointer points to the first entry of the three
+contiguous main stack entries that hold the lexical environment of the event
+function.  For each compiled event function (i.e., event function in classes 4
+and 5), the pointer is set to the first entry of the main stack area that is
+used locally by the compiled code.  In most cases, the first argument to the
+compiled function is saved in the first entry, the second argument in the
+second entry, and so on.  The local variables of the function are allocated in
+the entries following the arguments.  However, this is not always the case.
+Refer to Section 7.3 for variable allocations in compiled functions.
+
+By break level commands, the user can choose one of the events as the
+@emph{current event}.  If the current event function is an interpreted event
+function, then the break loop evaluates Lisp forms in the lexical environment
+retrieved from the event environment.  In particular, local variables may be
+referenced by the variable names, local functions and local macros may be
+invoked as usual, established blocks may be exited from, and tags may be used
+as the destination of @code{go}.  If the current function is a compiled
+function, Lisp forms are evaluated in the null environment.
+
+Within the break loop, each event is represented by the @emph{event symbol}.
+The @kwd{backtrace} command, for example, lists events in terms of their event
+symbols.  If the event function is a named function (global or local) or a
+macro expansion function, then the function or macro name is used as the event
+symbol.  If the event function is a special form, then the name of the special
+form is used.  If the event function is a lambda-expression (or a closure),
+then the symbol lambda (or lambda-closure) is used.
+
+To suppress unnecessary information, the user can hide (or make invisible) some
+of the events.  Invisible events do not appear in the backtrace, for example.
+Initially, only those events are invisible whose event symbols belong to the
+system internal package system.  When the break loop is entered, the last
+visible event becomes the current event.
+
+The break loop commands are described below.  Some of the commands allow
+abbreviation in the keywords that identify them.  For example, the user may
+abbreviate @kwd{current} as @kwd{c}.  The break loop commands return no values
+at all.
+
+@deffn {Break Command} {:current}  
+@deffnx {Break Command} {:c} {}
+Prints the event symbol of the current event.
+@end deffn
+
+@deffn {Break Command} {:previous}  @optional{} n
+@deffnx {Break Command} {:p} {@optional{} n}
+Makes the @var{n}-th previous visible event the
+new current event.  Invisible events are not counted.  If there are
+less than @var{n} previous events, then the first visible event in the
+invocation sequence becomes the new current event. @var{n} must be a
+positive integer and the default is @code{1}.
+@end deffn
+
+@deffn {Break Command} {:next}  @optional{} n
+@deffnx {Break Command} {:n} {@optional{} n}
+Makes the @var{n}-th next visible event the
+new current event.  If there are less than @var{n} next events,
+then the last visible event in the invocation sequence
+becomes the new current event. @var{n}  must be a positive integer and the  
+default is @code{1}.
+@end deffn
+
+@deffn {Break Command} {:backtrace}  
+@deffnx {Break Command} {:b} {}
+Prints the event symbols of all visible events in order.  The symbol of
+the current event is printed
+in upper-case letters and the event symbols of other events are in lower-case.
+@end deffn
+
+@deffn {Break Command} {:help}  
+@deffnx {Break Command} {:h} {}
+Lists the break loop commands.
+@end deffn
+
+@deffn {Break Command} {:quit}  @optional{} n
+@deffnx {Break Command} {:q} {@optional{} n}
+Returns control to the level @var{n} break loop.  If @var{n} is 0 or if @var{n}
+is omitted, then control will return to the top-level loop. @var{n} must be a
+non-negative integer smaller than the current break level.
+@end deffn
+
+@deffn {Break Command} {:continue}  
+@deffnx {Break Command} {:c} {}
+Returns control to the caller of the break loop.  If the break loop has been
+entered from @code{cerror}, @code{cerror} returns @nil{} as its value and
+control will resume at that point.  Otherwise, this command returns control to
+the previous break loop (or to the top-level loop, if the current break level
+is @code{1}).
+@end deffn
+
+@deffn {Break Command} {:variables}  
+@deffnx {Break Command} {:v} {}
+Prints the names of the bound variables in the current
+environment.  To see the value of a bound variable, just type the
+variable name.
+@end deffn
+
+@deffn {Break Command} {:functions}  
+Prints the names of the local functions and local macros in the current
+environment.  To see the definition of a local function or macro, use the
+function special form in the usual way.  That is, @code{(function @var{name})}
+will return the definition of the local function or macro whose name is
+@var{name}.  Local functions and local macros may be invoked as usual.
+@end deffn
+
+@deffn {Break Command} {:blocks}  
+Prints the names of the blocks established in the current environment.  If a
+block @var{block} is established, then the @code{return-from} form
+@code{(return-from @var{block value})} works as usual.  That is, the block form
+that established @var{block} will return @var{value} as its value and control
+will resume at that point.
+@end deffn
+
+@deffn {Break Command} {:tags}  
+Prints the tags established in the current environment.  If a tag @var{tag} is
+established, then the @code{go} form @code{(go @var{tag})} works as usual.
+That is, control will resume at the position of @var{tag} in the surrounding
+@code{tagbody}.
+@end deffn
+
+@deffn {Break Command} {:local}  @optional{} n
+@deffnx {Break Command} {:l} {@optional{} n}
+If @var{n} is @code{0} or if it is omitted, then this command prints the value
+stored in the main stack entry that is pointed to by the current event
+environment. @var{n} is an offset from that entry.  If @var{n} is positive,
+then the value of the @emph{n}-th next (i.e., toward the top of the main stack)
+entry is printed.  If @var{n} is negative, then the value of the @var{n}-th
+previous (i.e., toward the bottom of the main stack) entry is printed. @var{n}
+must be an integer.  It is an error if the specified entry does not lie between
+the bottom and the top of the stack.
+@end deffn
+
+@deffn {Break Command} {:hide}  symbol
+Hides all events whose event symbol is @var{symbol}.  In particular, by
+@code{:hide 'lambda} and @code{hide 'lambda-closure}, all events become
+invisible whose event functions are lambda-expressions and closures,
+respectively.  If the event symbol of the current event happens to be
+@var{symbol}, then the last previous visible event will become the new current
+event.  @var{symbol} must be a symbol.
+
+Events of @code{eval} and @code{evalhook} may never become invisible and
+attempts to hide them are simply ignored.  It is always the case that the first
+event function is either @code{eval} or @code{evalhook}.  Keeping both of them
+visible is the simplest way to avoid the silly attempts of the user to hide all
+events.
+@end deffn
+
+@deffn {Break Command} {:hide-package}  package
+Hides all events whose event symbol belongs to the package
+@var{package}. @var{package} may be any object that represents a package, i.e.,
+a package object, a symbol, or a string.  If the event symbol of the current
+event happens to belong to the package @var{package}, then the last previous
+visible event will become the new current event.  Even if @code{lisp} package
+was specified as @var{package}, events of @code{eval} and @code{evalhook} do
+not become invisible.  See the description of @kwd{hide} above.
+@end deffn
+
+@deffn {Break Command} {:unhide}  symbol
+@kwd{unhide} is the inverse command of @kwd{hide}.  If, however, @var{ symbol}
+belongs to one of the @kwd{hide-package}d packages, events of @var{symbol}
+become visible only after the package is @code{:unhide-package
+'d}. @var{symbol} must be a symbol.
+@end deffn
+
+@deffn {Break Command} {:unhide-package}  package
+@kwd{unhide-package} is the inverse command of @kwd{hide-package}.  However, an
+event whose event symbol belongs to @var{package} becomes visible only after
+the symbol is @code{unhide 'd}, if the symbol was @kwd{code 'd}
+before. @var{package} may be any object that represents a package, i.e., a
+package object, a symbol, or a string.
+@end deffn
+
+Example:
+
+@example
+> (defun fact (x) (if (= x 0) one (* x (fact (1- x)))))
+fact                    ;;;  Wrong definition for  fact, the factorial. 
+        
+> (fact 6)              ;;;  Tries to calculate factorial 6. 
+
+Error: The variable ONE is unbound.
+Error signalled by IF.
+
+Broken at IF:           ;;;  Enters the break-loop. 
+>> :h                   ;;;  Help. 
+
+Break commands:
+:q(uit)         Return to some previous break level.
+:pop            Pop to previous break level.
+:c(ontinue)     Continue execution.
+:b(acktrace)    Print backtrace.
+:f(unction)     Show current function.
+:p(revious)     Go to previous function.
+:n(ext)         Go to next function.
+:g(o)           Go to next function.
+:fs             Search forward for function.
+:bs             Search backward for function.
+:v(ariables)    Show local variables, functions, blocks, and tags.
+:l(ocal)        Return the nth local value on the stack.
+:hide           Hide function.
+:unhide         Unhide function.
+:hp             Hide package.
+:unhp           Unhide package.
+:unhide-all     Unhide all variables and packages.
+:vs             Show value stack.
+:bds            Show binding stack.
+:m(essage)      Show error message.
+:hs             Help stack.
+
+Top level commands:
+:cf             Compile file.
+:exit or ^D     Exit Lisp.
+:ld             Load file.
+:step           Single step form.
+:tr(ace)        Trace function.
+:untr(ace)      Untrace function.
+
+Help commands:
+:apropos        Apropos.
+:doc(ument)     Document.
+:h(elp) or ?    Help.  Type ":help help" for more information.
+
+>> :b                   ;;;  Backtrace. 
+Backtrace: eval > fact > if > fact > if > fact > if > fact >
+if > fact > if > fact > if > fact > IF
+
+>>: p                   ;;;  Moves to the previous event. 
+Broken at FACT.
+
+>> :b                   ;;;  Now inside of  fact  but outside of  if. 
+Backtrace: eval > fact > if > fact > if > fact > if > fact > 
+if > fact > if > fact > if > FACT > if
+
+>> :v                   ;;;  Shows local variables. 
+Local variables:
+  X: 1
+Block names: FACT.
+
+>> x                    ;;;  The value of x is 1. 
+1
+
+>> (return-from fact 1) ;;;  Returns from the  fact  block with value  1. 
+720                     ;;;  Now the correct answer. 
+
+>                      ;;;  Top-level.
+@end example
+
+
+@node Describe and inspect, The profiler, The break loop, Program development
+@section Describe and Inspect
+
+@defun {describe} {object}
+Prints the information about @var{object} to the stream that is the value of
+@code{*standard-output*}.  The description of an object consists of several
+fields, each of which is described in a recursive manner.  For example, a
+symbol may have fields such as home package, variable documentation, value,
+function documentation, function binding, type documentation, @code{deftype}
+definition, properties.
+@end defun
+
+@defun {inspect} {object}
+Prints the information about @var{object} in an interactive manner.  The output
+of inspect is similar to that of @code{describe}, but after printing the label
+and the value of a field (the value itself is not @code{describe 'd}), it
+prompts the user to input a one-character command.  The input to @code{inspect}
+is taken from the stream that is the value of @code{*query-io*}.  Normally, the
+inspection of @var{object} terminates after all of its fields have been
+inspected.  The following commands are supported:
+
+@table @asis
+@item @code{n}
+Next. Goes to the next level; the field is inspected recursively.
+
+@item @code{s}
+Skip. Skips the inspection of the field. @code{inspect} proceeds to the next
+field.
+
+@item @code{p}
+Print. Pretty-prints the field and prompts again.
+
+@item @code{u} @var{form}]
+Update. The @var{form} is evaluated and the field is replaced by the resulting
+value.  If the field cannot be updated, the message @code{Not updated.}  will
+be printed.
+
+@item @code{a}
+Abort. Aborts the inspection of the current object.  The field and  
+the rest of the fields are not inspected.
+
+@item @code{e} @var{form}
+Eval. Evaluates the specified form in the null environment and prints the
+resulting values.  Then prompts again with the same field.
+
+@item @code{q}
+Quit. Aborts the entire inspection.
+
+@item @code{?}
+Help. Lists the @code{inspect} commands.
+@end table
+@end defun
+
+
+@node The profiler, Online help, Describe and inspect, Program development
+@section The Profiler
+
+The profiler tool is enabled by default in the basic @ecls{} configuration.  It
+can be disabled with the @code{configure} option @code{--disable-profiler}.
+
+@deffn {sys} {profile}  @var{grain} @optional{} @var{address}
+This function activates the profiling of subsequent executions.  @var{grain} is
+a value between 1 and 16384 which indicates the granularity of code segments to
+consider. There is a counter for each such segment.  With each clock tick, the
+current segment is identified and its corresponding histogram count is
+incremented.  A value of 0 for @var{grain} means stop profiling.  @var{address}
+indicates the base address for the code being profiled.
+@end deffn
+
+@deffn {sys} {display-profile}  
+Displays the histogram of accumulated tick counts.  The ticks are attributed to
+the compiled Lisp function whose base address is closest to the start of the
+segment.  This may not be totally accurate for system functions which invoke
+some auxiliary function to do the job.  For instance, all allocator functions,
+like @code{cons}, call an internal function @code{allocate_object} and will be
+reported collectively under @code{sys:save-system}.
+@end deffn
+
+@deffn {sys} {clear-profile}  
+Clears the profile histogram.
+@end deffn
+
+@defvar {sys} {*profile-array*}
+Contains the profile histogram: two short integer counters are packed in each
+value of this array of fixnums.
+@end defvar
+
+
+@node Online help,  , The profiler, Program development
+@section Online Help
+
+Online help is provided by the following functions.
+
+@defun {help} {@optional{} @var{symbol}}
+@code{help} with no arguments prints a greeting message to @ecls{} beginners.
+@code{help} with a symbol argument prints the documentation associated
+with the symbol.
+@end defun
+
+@defun {help*} {@var{string} @optional{} @var{package}}
+Prints the documentation associated with those symbols in the specified
+@var{package} whose print names contain @var{string} as substring.
+@var{string} may be a symbol, in which case the print name of that symbol is
+used. @var{package} is optional and defaults to the LISP psackage.
+If @var{package} is @nil{}, then all packages are searched.
+@end defun
+
+@node The interpreter, The compiler, Program development, Top
+@chapter The Interpreter
+
+When you enter code at the lisp prompt, or when you load a source file,
+@ecls{} begins a process known as minimal compilation. Barely this
+process consists on parsing each form, macroexpanding it and translating
+it into an intermediate language made of @emph{bytecodes}.
+
+@menu
+* The bytecodes::               
+@end menu
+
+@node The bytecodes,  , The interpreter, The interpreter
+@section The intermediate language
+
+
+@node The compiler, Declarations, The interpreter, Top
+@chapter The Compiler
+ 
+The @ecls{} compiler translates a Lisp program stored in a source file into a C
+program, invokes the C compiler to compile the C program, and then generates an
+object file, called @emph{fasl file} (or @emph{o-file} because of the actual
+filetype).  The compiled program in a fasl file is loaded by the function
+@code{load}.
+
+Ordinarily, the object program generated by the @ecls{} compiler scarcely does
+runtime error-checking for runtime efficiency.  In addition, Lisp functions in
+the same source file are linked together and some system functions are
+open-coded in-line.  To control runtime error checking, supply appropriate
+@code{optimize} declarations (see Section 7.1).
+
+The @ecls{} compiler processes the @code{eval-when} special form exactly as
+specified in @bibcite{Steele:84} (see Section 5.3.3 of @bibcite{Steele:84}).
+
+Notice that KCL and AKCL instead behave differently from the @clisp{}
+specification, since they normally process all top-level forms in
+@emph{compile-time-too} mode.  If it is desired that each top-level form be
+processed in @emph{compile-time-too} mode, set the value of the @ecls{}
+specific variable @code{*eval-when-compiler*} to @true{}.
+
+The @ecls{} compiler is invoked by the functions @code{compile-file},
+@code{compile}, and @code{disassemble} described below.  In addition, the
+@ecls{} compiler may be invoked directly by the Shell commands @code{ecl}.
+This command requires the file name of the source file as its
+argument. @code{ecl} simply adds @code{.lsp} to the file name argument to
+obtain the full name of the source file.
+
+@example
+        @code{\% ecl} @var{filename}
+@end example
+
+has the same effect as the compiler invocation @code{(compile-file
+@var{filename})} from within @ecls{}, and
+
+@example
+        @code{\% ecl -C} @var{filename}
+@end example
+
+has the same effects as @code{(compile-file @var{filename}
+:c-file t :h-file t :data-file t)}.
+
+@defun {compile-file} {@var{pathname} @keys{} :output-file :verbose :print :c-file :h-file :data-file}
+@code{compile-file} compiles the Lisp program stored in the file specified by
+@var{pathname}, and generates a binary file.  If the @kwd{verbose} is true, a
+message indicating what file is being compiled is printed.  If the @kwd{print}
+is true, information about top-level forms in the file being compiled is
+printed.  @code{compile-file} generates the following temporary files:
+
+@multitable {Temporary File} {The include file referenced in the c-file}
+@item @b{Temporary File}
+@tab @b{Contents}
+@item @var{c-file}
+@tab C version of the Lisp program
+@item @var{h-file}
+@tab The include file referenced in the c-file
+@item @var{data-file}
+@tab The Lisp data to be used at load time
+@end multitable
+
+If files of these names already exist, the old files will be deleted first.
+Usually, these intermediate files are automatically deleted after execution of
+@code{compile-file}.
+
+The input-file is determined in the usual manner (see Section 2.9), except
+that, if the filetype is not specified, then the default filetype @code{.lsp}
+will be used.  The keyword parameter @code{:output-file} defines the default
+directory and the default name to be applied to the output files (i.e., the
+fasl file and the temporary files).  @kwd{output-file} itself defaults to
+@var{input-pathname}.  That is, if @kwd{output-file} is not supplied, then the
+directory and the name of the input file will be used as the default directory
+and the default name for the output files.  The filetypes of the output files
+are fixed as follows.
+
+@multitable {@b{Output File}} {@b{Filetype}}
+@item @b{Output File} @tab @b{Filetype}
+@item fasl file @tab @code{.o}
+@item c-file @tab @code{.c}
+@item h-file @tab @code{.h}
+@item data-file @tab @code{.data}
+@end multitable
+
+Each output file can be specified by the corresponding keyword parameter.
+If the value of the keyword parameter is @nil{}, then the output file will be
+deleted after execution of @code{compile-file}.  If the value of the
+keyword parameter is @true{}, then the output file will be left in the
+default directory under the default name.  Otherwise, the output file will
+be left in the directory under the name specified by the keyword parameter.
+The default value of @kwd{output-file} is @true{}, and the default values
+of @kwd{c-file}, @kwd{:h-file}, and @kwd{data-file} are all @nil{}.
+
+@table @code
+@item (compile-file 'foo) 
+The source file is @code{FOO.lsp} and the fasl file is @code{FOO.o}
+both in the current directory.
+
+@item (compile-file 'foo.lish) 
+The source file is @code{FOO.LISH} and the fasl file is @code{FOO.o}'.
+
+@item (compile-file "/usr/mas/foo" :output-file "/usr/tai/baa") 
+The source file is @code{foo.lsp} in the directory @file{/usr/mas}, and the
+fasl file is @code{baa.o} in the directory @file{/usr/tai}.
+@end table
+@end defun
+
+@defun {compile} {@var{name} @var{code} @optional{} @var{definition}}
+If @var{definition} is not supplied, @var{name} should be the name of a
+not-yet-compiled function.  In this case, compile compiles the function,
+replaces the previous definition of @var{name} with the compiled
+function,@emph{and} returns @var{name}.  If @var{definition} is supplied, it
+should be a lambda-expression to be compiled and @var{name} should be a symbol.
+If @var{name} is a non-@nil{} symbol, then compile installs the compiled
+function as the function definition of @var{name} and returns @var{name}.  If
+@var{name} is @nil{}, then compile simply returns the compiled function.
+
+The @ecls{} compiler is essentially a file compiler, and forms to be
+compiled are supposed to be stored in a file.  Thus compile actually
+creates a source file which contains the form designated by the
+arguments.  Then compile calls @code{compile-file} to get a fasl file,
+which is then loaded into @ecls{}.  The source file and the fasl file
+are given the names @file{gazonk.lsp} and @file{gazonk.fasl},
+respectively.  These files are not deleted automatically after the
+execution of @code{compile}.
+
+@end defun
+
+@defun {disassemble} {@optional{} @var{thing} @keys{} :h-file :data-file}
+
+This function does not actually disassemble.  It always calls the @ecls{}
+compiler and prints the contents of the c-file, i.e., the C-language code,
+generated by the @ecls{} compiler.  If @var{thing} is not supplied, or if it is
+@nil{}, then the previously compiled form by disassemble will be compiled
+again.  If @var{thing} is a symbol other than @nil{}, then it must be the name
+of a not-yet-compiled function, whose definition is to be compiled.  In this
+case, it is an error if the name is associated with a special form or a macro.
+If @var{thing} is a lambda-expression @code{(lambda @var{lambda-list .
+body})}, then @code{disassemble} first creates a function definition
+@code{(defun gazonk @var{lambda-list .  body})} and this definition is
+compiled.  (The function name @code{gazonk} has no special meanings.  Indeed,
+the displayed code is essentially independent of the function name.)
+Otherwise, @var{thing} itself will be compiled as a top-level form.  In any
+case, @code{disassemble} does not install the compiled function.
+@code{disassemble} returns no value.
+
+No intermediate h-file is created if the keyword parameter @code{:h-file} is
+@nil{} or if @kwd{h-file} is not supplied.  Otherwise, an intermediate h-file
+is created under the name specified by @kwd{h-file}.  Similarly, the
+intermediate data-file is specified by the keyword parameter @kwd{data-file}.
+
+@end defun
+
+@defvar {*eval-when-compile*}
+The compiler processes each top-level form in @dfn{not-compile-time} mode if
+the value of this variable is @nil{}, and in @dfn{compile-time-too} mode,
+otherwise.  See Section 5.3.3 of @bibcite{Steele:84} for these two modes.  The
+initial value of this variable is @nil{}.
+@end defvar
+
+
+@node Declarations, OS interface, The compiler, Top
+@chapter Declarations
+ 
+@ecls{} supports all kinds of declarations described in the
+@bibcite{Steele:84}.  Any valid declaration will affect the @ecls{} environment
+in some way or another, although information obtained by declarations, other
+than special declarations, is mainly used by the @ecls{} compiler.
+
+As described in @bibcite{Steele:84}, @clisp{} declarations are divided into two
+classes: @var{proclamations} and others.  A proclamation is a global
+declaration given by the function @code{proclaim}, the top-level @emph{macro}
+@code{defvar}, or the top-level macro @code{defparameter}.  Once given, a
+proclamation remains effective during the @ecls{} session unless it is shadowed
+by a local declaration or is canceled by another proclamation.  Any other
+declaration is a @emph{local declaration} and is given only by the special form
+@code{declare}.  A local declaration remains in effect only within the body of
+the construct that surrounds the declaration.
+
+In the following nonsensical example borrowed from Chapter 9 of
+@bibcite{Steele:84},
+@example
+(defun nonsense (k x z)
+   (foo z x)
+   (let ((j (foo k x))
+         (x (* k k)))
+        (declare (inline foo) (special x z))
+     (foo x j z)))
+@end example
+@noindent the @code{inline} and the special declarations both remain in effect within the
+surrounding @code{let} form.  In this case, we say that the @code{let} form is
+the @emph{surrounding construct} of these declarations.
+
+@defspec {the} {@var{value-type form}}
+
+The @ecls{} interpreter does actually check whether the value of the
+@emph{form} conforms to the data type specified by @emph{value-type} and
+signals an error if the value does not.  The type checking is performed by
+the function @code{typep}.  For example,
+@end defspec
+
+@example
+(the fixnum (foo))
+@end example
+
+@noindent is equivalent to
+
+@example
+(let ((values (multiple-value-list (foo))))
+   (cond ((endp values) (error ``Too few return values."))
+         ((not (endp (cdr values)))
+          (error ``Too many return values."))
+         ((typep (car values) 'fixnum) (car values))
+         (t (error ``~s is not of type fixnum." (car values)))))
+@end example
+
+On the other hand, the @ecls{} compiler uses the special form to
+obtain type information for compiled code optimization. No code for
+runtime type-checking is embedded in the compiled code.
+
+@menu
+* Declaration specifiers::      
+* Type specifiers::             
+* Type declarations::           
+* Variable allocations::        
+* Raw data functions::          
+* Arguments/Values passing::    
+@end menu
+
+
+@node Declaration specifiers, Type specifiers, Declarations, Declarations
+@section Declaration Specifiers
+ 
+@ecls{} recognizes all declaration specifiers defined in @bibcite{Steele:84}.
+The syntax of each such declaration specifier is exactly the same as defined in
+@bibcite{Steele:84}.  In addition, @ecls{} recognizes the @code{object}
+declaration specifier which is specific to @ecls{}.
+
+@deffn {Declaration} {special}  @{@var{variable-name}@}*
+The interpreter and the compiler of @ecls{} both treat special declarations
+exactly as described in @bibcite{Steele:84}.
+@end deffn
+
+@deffn {Declaration} {type}  @var{type} @{@var{variable-name}@}*
+A @code{type} proclamation @code{(type @emph{type var1 var2} ...)}  specifies
+that the dynamic values of the named variables are of the type @emph{type}.  A
+local @code{type} declaration specifies that the variables mentioned are bound
+by the surrounding construct and have values of the type @emph{type} during
+execution of the surrounding construct.  The compiler issues a warning if one
+of the named variables is not bound by the surrounding construct.  The
+information given by @code{type} declarations is used by the compiler to
+optimize the compiled code.  The behavior of the compiled code is unpredictable
+if a wrong @code{type} declaration is supplied.  The compiler detects certain
+wrong @code{type} declarations at compile time.
+@end deffn
+
+For example,
+@example
+>(defun foo (x y)
+   (declare (fixnum x) (character y))
+   (setq x y)
+  ...))
+foo
+
+>(compile 'foo)
+
+; (defun foo ...) is being compiled.
+;; Warning: Type mismatches between x and y.
+@end example
+
+See Section 7.3 for further information on @code{type} declarations.
+
+@deffn {Declaration} {type}  @{@var{variable-name}@}*
+(@var{type var1 var2} ...) is equivalent to @code{(type @var{type var1 var2}
+...)}, provided that @var{type} is one of the symbols in Table 4-1 of
+@bibcite{Steele:84}, other than @code{function}.  Declaration specifications
+that begin with @code{function} are regarded as @code{function} declarations
+(see below).
+@end deffn
+
+@deffn {Declaration} {function}  @var{function-name} @var{argument-types} . @var{return-types}
+A @code{function} declaration is used to obtain type information for function
+call forms.  That is, a @code{function} declaration specifies the argument and
+the return types of each form that calls the named function.
+@end deffn
+
+@example
+(defun foo ()
+  (declare (function bar (character) fixnum))
+  (+ (bar (atcholi1)) (bar (atcholi2))))
+@end example
+
+In this example, the @code{function} declaration specifies that the two
+functions @code{atcholi1} and @code{atcholi2} both return character objects
+when called within the body of @code{foo}, and that the function bar returns
+fixnum objects when called within the body of @code{foo}.  The type information
+given by function declarations is used by the compiler to optimize the compiled
+code.  The behavior of the compiled code is unpredictable if a wrong
+@code{function} declaration is supplied.  The compiler detects certain wrong
+@code{function} declarations at compile time.
+
+For example,
+
+@example 
+>(defun foo (x)
+   (declare (fixnum x)
+            (function bar (character) fixnum))
+   (bar x))
+foo
+
+>(compile 'foo)
+
+; (defun foo ...) is being compiled.
+;; Warning: The type of the form x is not character.
+@end example
+
+However, the compiler does not check the number of arguments, and thus, the
+following function definition will be compiled successfully without any
+warnings.
+
+@example 
+(defun foo ()
+  (declare (function bar (character character) fixnum))
+  (+ (bar (atcholi1)) (bar (atcholi2) (atcholi3) (atcholi4))))
+@end example
+
+For this definition, the compiler assumes that the three functions
+@code{atcholi1}, @code{atcholi2}, and @code{atcholi3} will return fixnum
+objects.  The return type of @code{atcholi4} is unknown at compile time.
+
+The complete syntax of a function declaration is:
+
+@example 
+(function  function-name
+  (@{type@}* [@{@optional{} | @rest{} | @keys{}@} @{thing@}*])
+  @{(values @{type@}* ) | @{type@}*@}
+)
+@end example
+
+Although @optional{}, @rest{}, and @keys{} markers may appear in the list of
+argument types, only those @var{types} are recognized that appear before any
+such markers and the rest of the list is simply ignored.  Note that functions
+with @optional{}, @rest{}, or @keys{} parameters may still be declared by
+@code{function} declarations because of the use of @code{function} declarations
+mentioned above.
+
+The @code{values} construct in the specification of return types is almost
+useless: @code{(function @var{function-name argument-types} (@var{values}
+@var{type1 type2} @dots{}))} is equivalent to @code{(function
+@var{function-name argment-types type1 type2} @dots{})}.
+
+See Section 7.3 for further information on @code{function} declarations.
+
+@deffn {Declaration} {ftype}  @var{function-type} @{@var{function-name}@}*
+@var{function-type} must be a list whose first element is the symbol
+@code{function}.  @code{(ftype (function . @var{rest}) @var{function-name-1}
+...  @var{function-name-n})} is equivalent to @var{n} consecutive
+@code{function} declarations @code{(function @var{function-name-1}
+. @var{rest})} ... @code{(function @var{function-name-n} . @var{rest})}.
+@end deffn
+
+@deffn {Declaration} {notinline}  @{function-name@}*
+@code{(notinline @var{function1 function2} ...)}  specifies that the
+compiler should not compile the named functions in-line.  Calls to the
+named functions can be traced and an event (see Section 5.4) is pushed
+on the event stack when any one of the named functions is invoked.
+@end deffn
+
+@deffn {Declaration} {inline}  @{function-name@}*
+An @code{inline} proclamation cancels currently effective @code{notinline}
+proclamations, and a local @code{inline} declaration locally shadows currently
+effective @code{notinline} declarations.
+@end deffn
+
+@example
+>(defun foo (x)
+   (cons (car x)
+         (locally (declare (inline car)) (car x))))
+foo
+
+>(defun bar (x)
+   (cons (car x)
+         (locally (declare (inline car)) (car x))))
+foo
+
+>(proclaim '(notinline car))
+nil
+
+>(compile 'foo)
+...
+
+>(proclaim '(inline car))
+nil
+
+>(compile 'bar)
+...
+@end example
+
+Usually, primitive functions such as @code{car} are compiled in-line.
+Therefore, in this example, only the first call to @code{car} within @code{foo}
+is compiled not in-line.
+
+In general, the @ecls{} compiler compiles functions in-line whenever possible.
+Thus an @code{inline} declaration @code{(inline @var{function1 function2} ...)}
+is worthless if none of the named functions have previously been declared to be
+@code{notinline}.
+
+@deffn {Declaration} {ignore}  @{variable-name@}*
+Usually, the compiler issues a warning if a lexical variable is never referred
+to.  @code{(ignore @var{var1 ...  varn})} causes the compiler not to issue a
+warning even if the named variables are never referred to.  The compiler issues
+a warning if one of the named variables is not bound by the surrounding
+construct, or if a named variable is actually referred to.  @code{ignore}
+proclamations are simply ignored.
+@end deffn
+
+@deffn {Declaration} {optimize}  @{(quality value) | quality@}*
+@ecls{} supports the four @code{optimize} qualities listed in the
+@bibcite{Steele:84}.
+
+@code{speed} and @code{compilation-speed} are used to set up the optimization
+switch of the C language compiler which is invoked to compile the C-language
+code generated by the @ecls{} compiler (see Chapter 6).  @code{(optimize (speed
+@var{n}))} and @code{(optimize (compilation-speed @var{m}))} are equivalent,
+where @var{n} and @var{m} are integers between 0 and 3, and @var{m} is equal to
+3-@var{n}.  When a @ecls{} session is started, the @code{speed} quality is set
+to 3.  That is, by default, the compiler generates the fastest code in the
+longest compilation time.  The @code{space} quality specifies whether the code
+size is important or not: The compiled code is a little bit larger and faster
+when compiled with the space quality 0, than when compiled with the space
+quality 1, 2, or 3.  When a @ecls{} session is started, the @code{space}
+quality is set to 0.  The @code{safety} quality determines how much runtime
+error checking code should be embedded in the compiled code.  If the
+@code{safety} quality is 0, the compiled code scarcely does runtime error
+checking.  If the @code{safety} quality is 1, then the compiled code for a
+function will check the number of arguments to the function at runtime.  If the
+@code{safety} quality is 2 or 3, then the compiled code does full runtime error
+checking.  In addition, the highest quality value 3 causes the compiler to
+treat all functions as if they were declared to be @code{notinline}.  When a
+@ecls{} session is started, the @code{safety} quality is set to 0.
+@end deffn
+
+@deffn {Declaration} {declaration}  @{name@}*
+A @code{declaration} declaration is used exactly as specified in the
+@bibcite{Steele:84}.
+@end deffn
+
+@deffn {Declaration} {object}  @{variable-name@}*
+This is the only declaration specifier that is specific to @ecls{}.
+@code{(object @var{var1 ...  varn})} affects only variable bindings and
+specifies that the named variables can be allocated in the C stack (see Section
+7.3).  The compiler issues a warning if one of the named variables is not bound
+by the surrounding construct. @code{object} proclamations are simply ignored.
+@end deffn
+
+
+@node Type specifiers, Type declarations, Declaration specifiers, Declarations
+@section Significant Type Specifiers
+
+Whenever a declaration is encountered, each type specifier (if any) in the
+declaration is converted to one of the following type specifiers, which are
+collectively called the @emph{significant type specifiers}.
+
+@example
+          |------------   fixnum 
+          |------------   character 
+          |------------   short-float 
+          |------------   long-float 
+      t --|----   (array t)  --------------  (vector t) 
+          |----   (array fixnum)  ---------  (vector fixnum) 
+          |----   (array string-char)   ---  string 
+          |----   (array short-float)   ---  (vector short-float) 
+          |----   (array long-float)    ---  (vector long-float) 
+          |----   (array bit)   -----------   bit-vector 
+@end example
+
+Here, the lines indicate subtype relations; the right type is a subtype of the
+left type.  For instance, @code{(vector t)} is a subtype of @code{(array t)}
+and @true{}, and @code{(array t)} itself is a subtype of @true{}.  However,
+@code{(array t)} and @code{(array string-char)} are disjoint types.
+
+The function @code{subtypep} is used for the conversion to significant type
+specifiers: If the first value of @code{(subtypep @var{raw-type type})} is
+@true{} for one of the significant type specifiers @var{type}, then the type
+specifier @var{raw-type} in the declaration is converted to @var{type}.  If
+there are more than one such significant type specifiers, then the type
+specifier that is a subtype of other specifiers is selected.  For example, type
+specifiers @tindexed{fixnum}, @code{(mod 3)}, and @code{(member 0 1)} are all
+converted to @tindexed{fixnum}, though they are also subtypes of @true{}.
+
+Because of this type specifier conversion, @ecls{} may sometimes regard two
+seemingly distinct declarations as the same.  For example, the following
+@code{type} declarations are completely equivalent, internally in @ecls{}.
+
+@example
+declare (type fixnum x))
+
+declare (type (mod 3) x))
+
+declare (type (member 0 1) x))
+@end example
+ 
+Type specifiers in declaration specifications passed to the @ecls{} specific
+function @code{proclamation} are also converted to significant type specifiers.
+Thus, for example,
+
+@example
+>(proclaim '(function foo (fixnum) fixnum))
+nil
+
+>(proclamation '(function foo ((mod 3)) (member 0 1)))
+t
+
+>(proclamation '(function foo (number) character))
+nil
+@end example
+
+The first call to @code{proclamation} returns @true{} because both @code{(mod
+3)} and @code{(member 0 1)} are converted to @tindexed{fixnum} before the
+function type of @code{foo} is checked.
+
+
+@node Type declarations, Variable allocations, Type specifiers, Declarations
+@section Treatment of Type Declarations
+ 
+@ecls{} uses several runtime stacks.
+
+Arguments to functions, lexical and temporary variables are allocated on the C
+stack. Temporary values saved on the C stack may sometimes be represented as
+@var{raw data} instead of pointers to heap-allocated cells.  Accessing such raw
+data on the C stack results in faster compiled code, partly because no pointer
+deferencing operation is necessary, and partly because no cell is newly
+allocated on the heap when a new object is created. This is particularly
+helpful for numeric code which computes with floating point numbers.
+
+@ecls{} uses a conservative garbage collector to scan the C stack and find
+references to live object.
+
+@node Variable allocations, Raw data functions, Type declarations, Declarations
+@section Variable Allocations
+
+If a lexical variable is declared to be of @tindexed{fixnum}, @code{character},
+@code{short-float}, @code{long-float}, or their subtypes, then it is allocated
+on the C stack rather than on the value stack.  In addition, the variable
+always has a raw datum as its value: 32 bit signed integer for fixnums, 8 bit
+character code with 24 bit padding for characters (remember that the font and
+bit fields of @ecls{} characters are always 0), 32 bit floating point
+representation for short-floats, and 64 bit floating point representation for
+long-floats.  Similarly, if a lexical variable is named in an @code{object}
+declaration (see Section 7.1), then it is allocated on the C stack but, in this
+case, the variable always has a cell pointer as its value.  The user is
+strongly recommended to make sure that objects stored in such an @code{object}
+variable may never be garbage collected unexpectedly.  For example,
+
+@example
+(do ((x (foo) (cdr x)))
+    ((endp x))
+    (let ((y (car x)))
+         (declare (object y))
+      (bar y)))
+@end example
+
+@noindent this @code{object} declaration is completely safe because the value of the
+variable @var{y} is always a substructure of the value of @var{x}, which in
+turn is protected against garbage collection.  Incidentally, loop variables of
+@code{dolist} may always be declared as object variables, since the
+@code{dolist} form has essentially the same control structure as the @code{do}
+form above.  On the other hand, the result of evaluation of the following form
+is unpredictable, because the cons cell pointed to from the @code{object}
+variable @var{z} may be garbage collected before @code{bar} is called.
+
+@example
+(let ((z (cons x y)))
+     (declare (object z))
+  (foo (cons x y))
+  (bar z))
+@end example
+
+Lexical variables that are not declared to be of @tindexed{fixnum},
+@tindexed{character}, @tindexed{short-float}, @tindexed{long-float}, or their
+subtypes, and that are not named in @code{object} declarations are usually
+allocated on the value stack, but may possibly be allocated on the C stack
+automatically by the compiler.
+
+
+@node Raw data functions, Arguments/Values passing, Variable allocations, Declarations
+@section Built-in Functions that Operate on Raw Data Directly
+ 
+Some built-in @clisp{} functions can directly operate on raw data, if
+appropriate declarations are supplied.  The addition function \(+\) is among
+such functions.
+
+@example
+(let ((x 1))
+     (declare (fixnum x))
+  ...
+  (setq x (+ x 2))
+  ...
+  )
+@end example
+
+In the compiled code for this @code{let} form, the raw fixnum datum (i.e., the
+32 bit signed integer) stored in @var{x} is simply incremented by 2 and the
+resulting 32 bit signed integer is stored back into @var{x}.  The compiler is
+sure that the addition for 32 bit signed integers will be performed on the call
+to @code{+}, because the arguments are both fixnums and the return value must
+be also a fixnum since the value is to be assigned to the @tindexed{fixnum}
+variable.  The knowledge of both the argument types and the return type is
+necessary for this decision: Addition of two fixnums may possibly produce a
+bignum and addition of two bignums may happen to produce a fixnum value.  If
+either the argument type or the return type were not known to the compiler, the
+general addition function would be called to handle the general case.  In the
+following form, for example, the compiler cannot be sure that the return value
+of the multiplication is a fixnum or that the arguments of the addition are
+fixnums.
+
+@example
+(setq x (+ (* x 3) 2))
+@end example
+
+In order to obtain the optimal code, a @code{the} special form should
+surround the multiplication.
+
+@example
+(setq x (+ (the fixnum (* x 3)) 2))
+@end example
+
+Built-in @clisp{} functions that can directly operate on raw data are:
+
+@enumerate
+@item arithmetic functions such as @code{+},  @code{-},
+@code{1+}, @code{1-},  @code{*}, @code{floor},  @code{mod}, @code{/}, and
+@code{expt}.
+
+@item predicates such as @code{eq}, @code{eql}, @code{equal},
+@code{zerop}, @code{plusp}, @code{minusp}, @code{=}, @code{/=}, @code{<},
+@code{<=}, @code{>}, @code{>=}, @code{char=}, @code{char/=}, @code{char<},
+@code{char<=}, @code{char>}, and @code{char>=}.
+
+@item sequence processing functions that receive or return one or more
+fixnum values, such as @code{nth}, @code{nthcdr}, @code{length}, and
+@code{elt}.
+
+@item array access functions such as @code{svref}, @code{char}, @code{schar},
+and @code{aref} (see below).
+
+@item system-internal functions for array update (see below).
+ 
+@item type-specific functions such as @code{char-code}, @code{code-char},
+and @code{float}.
+@end enumerate
+
+As mentioned in Section 2.5.1, array elements are represented in one of six
+ways depending on the type of the array.  By supplying appropriate array type
+declarations, array access and update operations can handle raw data stored in
+arrays.  For example,
+
+@example
+(let ((a (make-array n :element-type 'fixnum))
+      (sum 0))
+     (declare (type (array fixnum) a)
+              (fixnum sum))
+  (dotimes (i n)             ;;; Array initialization.
+           (declare (fixnum i))
+     (setf (aref a i) i))
+  ....
+  (dotimes (i n)             ;;; Summing up the elements.
+           (declare (fixnum i))
+     (setq sum (+ (aref a i) sum)))
+  ....
+  )
+@end example
+
+The @code{setf} form replaces the @code{i-th} element of the array a by the raw
+fixnum value of @code{i}.  The @code{aref} form retrieves the raw fixnum datum
+stored in @code{a}.  This raw datum is then added to the raw fixnum value of
+the fixnum variable @code{sum}, producing the raw fixnum datum to be stored in
+@code{sum}.  Similar raw data handling is possible for arrays of types
+@code{(array fixnum), (vector fixnum),
+ (array string-char),  string,
+ (array short-float),  (vector short-float),
+ (array long-float)}, and @code{(vector long-float)}.
+
+@node Arguments/Values passing,  , Raw data functions, Declarations
+@section Arguments/Values Passing
+
+Function proclamations @code{(function @var{function-name} (@var{arg-type1}
+@var{arg-type2} ...) @var{return-type})} or its equivalents give the compiler
+the chance to generate compiled code so that arguments to the named functions
+and resulting values of the named functions will be passed via the C stack,
+thus increasing the efficiency of calls to these functions.  Such
+arguments/values passing via the C stack is possible only if the called
+function is also defined in the same source file.  This is because the code for
+the called function must have two entries: One entry for C arguments/values
+passing and another for ordinary Lisp arguments/values passing.  (An ordinary
+function has only the latter entry.)  When the latter entry is used, the
+arguments are @emph{unboxed} and passed to the former entry.  On return from
+the function, the resulting value is cast into a Lisp data type.
+
+A good example of this follows.
+
+@example
+(eval-when (compile)
+  (proclaim '(function tak (fixnum fixnum fixnum) fixnum)))
+
+(defun tak (x y z)
+  (declare (fixnum x y z))
+  (if (not (< y x))
+      z
+      (tak (tak (1- x) y z)
+           (tak (1- y) z x)
+           (tak (1- z) x y))))
+
+;;; Call (tak 18 12 6).
+@end example
+
+When @code{tak} is called with the arguments @code{18, 12}, and @code{6}, the
+raw fixnum data of the arguments are set to the parameters @code{x}, @code{y},
+@code{z}.  After that, only raw C data are used to perform the execution: No
+cell pointers are newly allocated nor even referenced.  The built-in functions
+\(<\) and @code{1-} directly operate on the raw data.  Only at the return from
+the top-level call of @code{tak}, the resulting raw data value (which happens
+to be @code{7}) is reallocated on the heap.  Note that both the @code{function}
+proclamation and the local @tindexed{fixnum} declaration are necessary to
+obtain the optimal code.  The @code{function} proclamation is necessary for
+arguments/values passing via the C stack and the @tindexed{fixnum} declaration
+is necessary to unbox the parameters into C variables.
+
+
+@node OS interface, Macros, Declarations, Top
+@chapter Operating System Interface
+
+@ecls{} provides the following facilities that are not defined in
+@bibcite{Steele:84}.
+
+@defun {sys} {save-system} {filename}
+@code{save} saves the current memory image into a program file @var{filename}.
+After saving the memory image, the @ecls{} process terminates immediately.  To
+execute the saved program file, specify the full pathname of the file, as
+indicated in the example below.
+
+@c @vspace{1 em}
+
+Example:
+@example
+>(defun plus (x y) (+ x y))
+plus
+
+>(save "savefile")
+%
+
+% pwd
+/usr/hagiya
+% /usr/hagiya/savefile
+
+>(plus 2 3)
+5
+
+>(quit)
+Bye.
+%
+@end example
+@end defun
+
+@defun {system} {string}
+Executes a Shell command as if @var{string} is an input to the Shell.  On
+return from the Shell command, @code{system} returns the exit code of the
+command as an integer.
+@end defun
+
+@defun {open-pipe} {string}
+Executes a Shell command as if @var{string} is an input to the Shell.  It
+returns a stream corresponding to the output stream of the Shell command, from
+which one can read its output.
+@end defun
+
+
+@defun {quit} {@optional{} exit-code}
+Terminates @ecls{} and returns the @var{exit-code} to the parent process.
+@var{exit-code} must be an integer and its default value is @code{0}.
+@end defun
+
+@node Macros, C Language, OS interface, Top
+@chapter Macros
+
+@menu
+* System macros::               
+* Defmacro lambda-lists::       
+@end menu
+
+@node System macros, Defmacro lambda-lists, Macros, Macros
+@section System Macros
+ 
+The @ecls{} interpreter implements the following system macros as if they were
+special forms.  That is, macro forms of the following macros are directly
+evaluated without being macro-expanded.
+
+@example
+    and       case      cond      decf      defmacro  defun
+    do        do*       dolist    dotimes   incf      locally
+    loop      multiple-value-bind           multiple-value-list
+    multiple-value-setq           or        pop       prog
+    prog*     prog1     prog2     psetq     push      return
+    setf      unless    when
+@end example
+
+For these macro forms, the functions @code{macro-function} and
+@code{special-form-p} both return non-@nil{} values: @code{macro-function}
+returns the macro expansion function and @code{special-form-p} returns @true{}.
+Of course, functions such as @code{macroexpand} and @code{macroexpand-1} will
+successfully expand macro forms for these system macros.
+
+
+@node Defmacro lambda-lists,  , System macros, Macros
+@section Defmacro Lambda-Lists
+ 
+A @dfn{defmacro lambda-list} is a lambda-list-like construct that is used as
+the third element in the @code{defmacro} form,
+@example
+(defmacro @var{name} @var{efmacro-lambda-list} [@var{declaration} | @var{doc-string}] @{@var{form}@}*)
+@end example
+
+The description of defmacro lambda-lists in @bibcite{Steele:84} is quite
+ambiguous.  @ecls{} employs the following syntax.
+
+The complete syntax of a defmacro lambda-list is:
+
+@example
+( [&whole @var{var}]
+  [&environment @var{var}]
+  [@var{pseudo-var}]
+  [@optional{} @{var | ( pseudo-var [initform [pseudo-var]] )@}Ç]
+  @{[@{@rest{} | &body@} pseudo-var]
+   [@keys{} @{var
+          | (@{var | (keyword pseudo-var)@} [initform [pseudo-var]])@}*
+    [@allow{}]]
+   [@aux{} @{var | (pseudo-var [initform])@}*]
+   | . var @}
+)
+@end example
+
+@noindent where @var{pseudo-var} is either a symbol or a list of the following
+form:
+
+@example
+( @{pseudo-var@}*
+  [@optional{} @{var | (pseudo-var [initform [pseudo-var]])@}*]
+  @{[@{@rest{} | &body@} pseudo-var]
+   [@keys{} @{var | (@{var | (keyword pseudo-var)@} 
+                  [initform [pseudo-var]])@}*
+    [@allow{}]]
+   [@aux{} @{var | (pseudo-var [initform])@}]
+  | . var @}
+)
+@end example
+
+The defmacro lambda-list keyword @code{&whole} may appear only at the
+top-level, first in the defmacro lambda-list.  It is not allowed within
+@var{pseudo-var}.  Use of the @code{&whole} keyword does not affect the
+processing of the rest of the defmacro lambda-list:
+
+@example
+(defmacro foo (&whole w x y) ...)
+@end example
+and
+@example 
+(defmacro foo (x y) ...)
+@end example
+
+@noindent both bind the variables @code{x} and @code{y} to the second and the
+third elements, respectively, of macro forms of @code{foo}.
+
+The defmacro lambda-list keyword @code{&environment} may appear only at the
+top-level, first in the defmacro lambda-list if @code{&whole} is not supplied,
+or immediately after the variable that follows @code{&whole}, if @code{&whole}
+is supplied.  @code{&environment} is not allowed within @var{pseudo-var}.  Like
+@code{&whole}, use of @code{&environment} does not affect the processing of the
+rest of the defmacro lambda-list.  If an @code{&environment} parameter is
+supplied andif this parameter is not used at all, then the @ecls{} compiler
+will issue a warning.  To suppress the warning, just remove the parameter from
+the defmacro lambda-list, or add an @code{ignore} declaration.
+ 
+The defmacro lambda-list keyword @code{&body} is completely equivalent to the
+@rest{} keyword.  @ecls{} takes no special action for @code{&body} parameters.
+
+Although useless, @ecls{} allows supplied-p parameters to be destructured.
+This is useless because supplied-p parameters can never be bound to a non-empty
+list.  Our intention is to stick to the specification in the
+@bibcite{Steele:84} as far as possible, even if it is silly to do so.
+
+Like for ordinary lambda-lists, the interpreter detects invalid arguments to
+macro expansion functions.  When a parameter is destructured, the structure of
+the corresponding argument is also checked.  Such runtime argument checking may
+or may not be embedded in compiled code, depending on the environment when the
+code was generated.  If the code was generated while the @code{safety} optimize
+level is zero (that is, while the value of @code{(proclamation '(optimize
+(safety 0)))} is @true{}), then the generated code does not perform argument
+checking at all.  Otherwise, the compiled code does check the validity of
+arguments.
+
+
+@node C Language, CLOS, Macros, Top
+@chapter The C Language Interface
+ 
+This chapter describes the facility of @ecls{} to interface the C language and
+@ecls{}.  With this facility, the user can arrange his or her C-language
+programs so that they can be invoked from @ecls{}. In addition, the user can
+write Lisp function definitions in the C language to increase runtime
+efficiency.
+
+The basic idea of interfacing the C language is this: As mentioned in Chapter
+6, the @ecls{} compiler, given a Lisp source file, creates an intermediate
+C-language program file, called @emph{c-file}, which is then compiled by the
+C-language compiler to obtain the final fasl-file.  Usually, the c-file
+consists of C-language function definitions.  The first C-language function in
+the c-file is the ``initializer'', which is executed when the fasl file is
+loaded, and the other C-language functions are the C versions of the Lisp
+functions (including macro expansion functions) defined in the source file.  By
+using the top-level macros @code{Clines} and @code{defCfun} described below,
+the user can direct the compiler to insert his or her own C-language function
+definitions and/or C-language preprocessor macros such as @code{#define} and
+@code{#include} into the c-file.  In order that such C-language functions be
+invoked from @ecls{}, another top-level macro @code{defentry} is used.  This
+macro defines a Lisp function whose body consists of the calling sequence to
+the specified C-language function.
+
+The C-language function definitions are placed in the c-file in the order of
+the corresponding Lisp functions defined in the source file.  That is, the C
+code for the first Lisp function comes first, the C code for the second Lisp
+function comes second, and so on.  If a @code{Clines} or @code{defCfun} macro
+form appears between two Lisp function definitions in the source file, then the
+C code specified by the macro is placed in between the C code for the Lisp
+functions.
+
+We define some terminology here which is used throughout this Chapter. A
+@emph{C-id} is either a Lisp string consisting of a valid C-language
+identifier, or a Lisp symbol whose print-name, with all its alphabetic
+characters turned into lower case, is a valid C identifier.  Thus the symbol
+@code{foo} is equivalent to the string @code{"foo"} when used as a C-id.
+Similarly, a @emph{C-expr} is a string or a symbol that may be regarded as a
+C-language expression.  A @emph{C-type} is one of the Lisp symbols @code{int,
+char, float, double,} and @code{object}.  Each corresponds to a data type in
+the C language; @code{object} is the type of Lisp object and other C-types are
+primitive data types in C.
+
+@defmac {Clines} {@{string@}*}
+When the @ecls{} compiler encounters a macro form @code{(Clines @var{string1
+...  stringn})}, it simply outputs the @var{strings} into the c-file.  The
+arguments are not evaluated and each argument must be a string.  Each
+@var{string} may consist of any number of lines, and separate lines in the
+@var{string} are placed in separate lines in the c-file.  In addition, each
+@var{string} opens a fresh line in the c-file, i.e., the first character in the
+@var{string} is placed at the first column of a line.  Therefore, C-language
+preprocessor commands such as @code{#define} and @code{#include} will be
+recognized as such by the C compiler, if the ' # ' sign appears as the first
+character of the @var{string} or as the first character of a line within the
+@var{string}.
+
+When interpreted, a @code{Clines} macro form expands to @nil{}.
+
+@end defmac
+
+@defmac {defentry} {function parameter-list C-function}
+
+@code{defentry} defines a Lisp function whose body consists of the calling
+sequence to a C-language function. @var{function} is the name of the Lisp
+function to be defined, and @var{C-function} specifies the C function to be
+invoked. @var{C-function} must be either a list @code{(@var{type C-id})} or
+@var{C-id}, where @var{type} and @var{C-id} are the type and the name of the C
+function. @var{type} must be a C-type or the symbol @code{void} which means
+that the C function returns no value.  @code{(object @var{C-id})} may be
+abbreviated as @var{C-id}.  @var{parameter-list} is a list of C-types for the
+parameters of the C function.  For example, the following @code{defentry} form
+defines a Lisp function @code{tak} from which the C function @code{tak} above
+is called.
+
+@end defmac
+
+@example
+(defentry tak (int int int) (int tak))
+@end example
+
+The Lisp function @code{tak} defined by this @code{defentry} form requires
+three arguments.  The arguments are converted to @code{int} values before they
+are passed to the C function.  On return from the C function, the returned
+@code{int} value is converted to a Lisp integer (actually a fixnum) and this
+fixnum will be returned as the value of the Lisp function.  See below for type
+conversion between Lisp and the C language.
+
+A @code{defentry} form is treated in the above way only when it appears as a
+top-level form of a Lisp source file.  Otherwise, a @code{defentry} form
+expands to @nil{}.
+
+@defmac {defla} {name lambda-list @{declaration | doc-string@}*}
+
+When interpreted, @code{defla} is exactly the same as @code{defun}.  That is,
+@code{(defla @var{name lambda-list .  body})} expands to @code{(defun @var{name
+lambda-list .  body})}.  However, @code{defla} forms are completely ignored by
+the compiler; no C-language code will be generated for @code{defla} forms.  The
+primary use of @code{defla} is to define a Lisp function in two ways within a
+single Lisp source file; one in the C language and the other in Lisp.
+@code{defla} is short for @emph{DEF}ine @emph{L}isp @emph{A}lternative.
+@end defmac
+
+Suppose you have a Lisp source file whose contents are:
+
+@example 
+;;; C version of TAK.
+(Clines "
+
+       int tak(x, y, z)                           
+       int x, y, z;
+       @{      if (y >= x) return(z);
+               else return(tak(tak(x-1, y, z),
+                               tak(y-1, z, x),
+                               tak(z-1, x, y)));
+       @}
+"
+)
+
+;;;  TAK calls the C function tak defined above.
+(defentry tak (int int int) (int tak))
+;;;  The alternative Lisp definition of TAK.
+(defla tak (x y z)
+   (if (>= y x)
+       z
+       (tak (tak (1- x) y z)
+            (tak (1- y) z x)
+            (tak (1- z) x y))))
+@end example
+
+When this file is loaded into @ecls{}, the interpreter uses the Lisp version of
+the @code{tak} definition.  Once this file has been compiled, and when the
+generated fasl file is loaded into @ecls{}, a function call to @code{tak} is
+actually the call to the C version of @code{tak}.
+
+@defun {defCbody} {name args-types result-type C-expr}
+The @ecls{} compiler produces a function named @var{name} with as many
+arguments as @var{arg-types}.  The @var{C-expr} is an arbitrary C expression
+where the arguments to the function are denoted by @code{#@emph{i}}, where
+@code{@emph{i}} is the integer corresponding to the argument position.  The
+@var{args-types} is the list of \clisp types of the arguments to the function,
+while @var{result-type} is the \clisp type of the result.  The actual arguments
+are coerced to the required types before executing the @var{C-expr} and the
+result is converted into a Lisp object.  @code{defCbody} is ignored by the
+interpreter.
+@end defun
+
+For example, the logical AND of two integers could be defined as:
+@example
+(defCbody logand (fixnum fixnum) fixnum "(#0) & (#1)")
+@end example
+
+@defun {definline} {name args-types result-type C-expr}
+@code{definline} behaves exactly as @code{defCbody}.  Moreover, after a
+@code{definline} definition has been supplied, the @ecls{} compiler will expand
+inline any call to function @var{name} into code corresponding to the C
+language expression @var{C-expr}, provided that the actual arguments are of the
+specified type.  If the actual arguments cannot be coerced to those types, the
+inline expansion is not performed.  @code{definline} is ignored by the
+interpreter.
+
+@end defun
+
+For example, a function to access the n-th byte of a string and return it as an
+integer can be defined as follows:
+
+@example
+(definline aref-byte (string fixnum) fixnum
+   "(#0)->ust.ust_self[#1]")
+@end example
+
+The definitions of the C data structures used to represent \clisp objects can
+be found in file @code{ecl.h} in the directory @code{"src/h"} of the source
+distribution.
+
+@ecls{} converts a Lisp object into a C-language data by using the @clisp{}
+function @code{coerce}: For the C-type @code{int} (or @code{char}), the object
+is first coerced to a Lisp integer and the least significant 32-bit (or 8-bit)
+field is used as the C @code{int} (or @code{char}).  For the C-type
+@code{float} (or @code{double}), the object is coerced to a short-float (or a
+long-float) and this value is used as the @code{C float} (or @code{double}).
+Conversion from a C data into a Lisp object is obvious: @code{C char, int,
+float,} and @code{double} become the equivalent Lisp @code{character},
+@code{fixnum}, @code{short-float}, and @code{long-float}, respectively.
+
+Here we list the complete syntax of @code{Clines}, @code{defentry},
+@code{definline} and @code{defCbody} macro forms.
+
+@example
+Clines-form:
+        (Clines @{string@}*)
+
+defentry-form:
+        (defentry symbol (@{C-type@}*)
+                  @{C-function-name | (@{C-type | void@} C-function-name)@})
+
+defCbody-form:
+        (defCbody symbol (@{type@}*) type C-expr)
+
+definline-form:
+        (defCbody symbol (@{type@}*) type C-expr)
+
+C-function-name:
+C-expr:
+        @{ string | symbol @}
+ 
+C-type:
+        @{ object | int | char | float | double @}
+@end example
+
+
+@node CLOS, Multithread, C Language, Top
+@chapter CLOS
+
+@deffn {Generic} {add-method}  generic-function method
+@deffnx {Method} {add-method} {(generic-function standard-generic-function) (method method)}
+@end deffn
+
+@defmac {call-method} {method next-method-list}
+@end defmac
+
+@defmac {call-next-method} {@rest{} args}
+@end defmac
+
+@deffn {Generic} {change-class}  instance new-class
+@deffnx {Method} {change-class} {(instance standard-object) (new-class standard-class)}
+@deffnx {Method} {change-class} {(instance t) (new-class symbol)}
+@end deffn
+
+@deffn {Generic} {class-name}  class
+@deffnx {Method} {class-name} {(class class)}
+@end deffn
+
+@deffn {Generic} {(setf class-name)}  new-value class
+@deffnx {Method} {(setf class-name)} {new-value (class class)}
+@end deffn
+
+@defun {class-of} {object}
+The function @code{class-of} returns the class of which the given
+object is an instance.  The argument to class-of may be any @clisp{} object.
+@end defun
+
+@defun {compute-applicable-methods} {generic-function function-arguments}
+@end defun
+
+@defmac {defclass} {class-name (@{superclass-name@}*)} (@{slot-specifier@}*) [class-option]
+@example
+@var{class-name} ::= @var{symbol}
+@var{superclass-name} ::= @var{symbol}
+@var{slot-specifier} ::= @var{slot-name} | (@var{slot-name} [@var{slot-option}])
+@var{slot-name} ::= @var{symbol}
+@var{slot-option} ::= @{:reader @var{reader-function-name}@}*
+        | @{:writer @var{writer-function-name}@}*
+        | @{:accessor @var{reader-function-name}@}*
+        | @{:allocation @var{allocation-type}@}
+        | @{:initarg @var{initarg-name}@}*
+        | @{:initform @var{form}@}
+        | @{:type @var{type-specifier}@}
+        | @{:documentation @var{string}@}
+@var{reader-function-name} ::= @var{symbol}
+@var{writer-function-name} ::= @var{function-name}
+@var{function-name} ::= @var{symbol} |(setf @var{symbol})
+@var{initarg-name} ::= @var{symbol}
+@var{allocation-type} ::= :instance | :class
+@var{class-option} ::= (:default-initargs @var{initarg-list})
+        | (:documentation @var{string})
+        | (:metaclass @var{class-name})
+@var{initarg-list} ::= @{@var{initarg-name} @var{default-initial-value-form}@}*
+@end example
+@end defmac
+
+@defmac {defgeneric} {function-name lambda-list [option | @{method-description@}*]}
+@example
+@var{function-name} ::= @var{symbol} | (setf @var{symbol})
+@var{lambda-list} ::= (@{@var{var}@}*
+        [@optional{} @{@var{var} | (@var{var})@}*]
+        [@rest{} @var{var}]
+        [@keys{} @{@var{keyword-parameter}@}* [@allow{}]])
+@var{keyword-parameter} ::= @var{var} | ( @{@var{var} | (@var{keywordvar} )@})
+@var{option} ::= (:argument-precedence-order @{@var{parameter-name}@}+)
+        | (declare @{@var{declaration}@}+)
+        | (:documentation @var{string})
+        | (:method-combination symbol @{@var{arg}@}*)
+        | (:generic-function-class @var{class-name})
+        | (:method-class @var{class-name})
+@var{method-description} ::=
+        (:method @{@var{method-qualifier}@}* @var{specialized-lambda-list}
+         [@{@var{declaration}@}* | @var{documentation}]
+         @{@var{form}@}*)
+@var{method-qualifier} ::= @var{non-nil-atom}
+@var{specialized-lambda-list} ::= (@{@var{var} | (@var{var} @var{parameter-specializer-name})@}*
+        [@optional{} @{@var{var} | (@var{var} [@var{initform} [@var{supplied-p-parameter}]])@}*]
+        [@rest{} @var{var}]
+        [@keys{} @{@var{specialized-keyword-parameter}@}* [@allow{}]])
+        [@aux{} @{@var{var} | (@var{var} [@var{initform}])@}*] )
+@var{specialized-keyword-parameter} ::= @var{var}
+        | @{(@{@var{var} | (@var{keywordvar})@} [@var{initform} [@var{supplied-p-parameter}]])@}*
+@var{parameter-specializer-name} ::= @var{symbol} | (eql @var{eql-specializer-form})
+@end example
+@end defmac
+
+@defmac {define-method-combination} {name [short-form-option]}
+@defmacx {define-method-combination} {name lambda-list (@{method-group-specifier@}*) [(:arguments . lambda-list)] [(:generic-function generic-fn-symbol)] [@{declaration@}* | doc-string] @{form@}*}
+@example
+@var{short-form-option} ::= :documentation @var{string} 
+                        | :identity-with-one-argument @var{boolean} 
+                        | :operator @var{operator} 
+@var{method-group-specifier} ::= (@var{variable}  @{@var{qualifier-pattern}@}+ | @var{predicate}
+                        [@var{long-form-option}])
+@var{long-form-option} ::= :description @var{format-string} 
+                        | :order @var{order} 
+                        | :required @var{boolean}
+@end example
+@end defmac
+
+@defmac {defmethod} {function-name @{method-qualifier@}+ specialized-lambda-list [@{declaration@}* | doc-string] @{form@}*}
+@example
+@var{function-name} ::= @var{symbol} | (setf @var{symbol})
+@var{method-qualifier} ::= @var{non-nil-atom} 
+@var{parameter-specializer-name} ::= @var{symbol} | (eql @var{eql-specializer-form} )
+@end example
+@end defmac
+
+@deffn {Generic} {documentation}  x @optional{} doc-type
+@deffnx {Method} {documentation} {(method standard-method) @optional{} doc-type}
+@deffnx {Method} {documentation} {(generic-function standard-generic-function) @keys{@optional{} doc-type}}
+@deffnx {Method} {documentation} {(class standard-class) @optional{} doc-type}
+@deffnx {Method} {doumentation} {(method-combination method-combination) @optional{} doc-type}
+@deffnx {Method} {documentation} {(slot-description standard-slot-description) @keys{@optional{} doc-type}}
+@deffnx {Method} {documentation} {(symbol symbol) @optional{} doc-type}
+@deffnx {Method} {documentation} {(list list) @optional{} doc-type}
+@end deffn
+
+@deffn {Generic} {(setf documentation)}  new-value x @optional{} doc-type
+@deffnx {Method} {(setf documentation)} {new-value (method standard-method) @optional{} doc-type}
+@deffnx {Method} {(setf documentation)} {new-value (class standard-class) @optional{} doc-type}
+@deffnx {Method} {(setf documentation)} {new-value (method-combination method-combination)}
+@deffnx {Method} {(setf documentation)} {new-value (slot-description standard-slot-description) @optional{} doc-type}
+@deffnx {Method} {(setf documentation)} {new-value (symbol symbol) @optional{} doc-type}
+@deffnx {Method} {(setf documentation)} {new-value (list list) @optional{} doc-type}
+@end deffn
+
+@defun {ensure-generic-function} {function-name @keys{} lambda-list @keys :argument-precedence-order :declare :documentation :generic-function-class|ekeys{:method-combination :method-class :environment}}
+@example
+function-name ::= symbol | (setf symbol)
+@end example
+@end defun
+
+@defun {find-class} {symbol @optional{} errorp environment}
+
+The function find-class returns the class object named by the given symbol in the given environment.
+The first argument to find-class is a symbol. 
+@end defun
+
+@deffn {Generic} {find-method}  generic-function method-qualifiers specializers @optional{} errorp
+@deffnx {Method} {find-method} {(generic-function standard-generic-function)}
+                method-qualifiers specializers  @optional{} errorp
+@end deffn
+
+@deffn {Generic} {function-keywords}  method
+@deffnx {Method} {function-keywords} {(method standard-method)}
+@end deffn
+
+The generic function function-keywords is used to return the keyword parameter specifiers for a given method.
+
+@defmac {generic-function} {lambda-list \mchoice{option | @{method-description@}*}}
+
+@example
+option ::= (:argument-precedence-order @{parameter-name@}+)
+        | (declare @{declaration@}+)
+        | (:documentation string)
+        | (:method-combination symbol @{arg@}*)
+        | (:generic-function-class class-name)
+        | (:method-class class-name)
+method-description ::= (:method @{method-qualifier@}*
+                                specialized-lambda-list
+                                @{declaration | @var{documentation}@}*
+                                @{form@}*)
+@end example
+The @code{generic-function} macro creates an anonymous generic function. The
+generic function is created with the set of methods specified by its method
+descriptions.  The @var{option}, @var{method-qualifier}, and
+@var{specialized-lambda-list} arguments are the same as for @code{defgeneric}.
+The generic function object is returned as the result.  If no method
+descriptions are specified, an anonymous generic function with no methods is
+created.  See @macref{defgeneric}, @macref{generic-flet},
+@macref{generic-labels}, @macref{defmethod}.
+@end defmac
+
+@deffn {Generic} {initialize-instance}  instance @rest{} initargs
+@deffnx {Method} {initialize-instance} {(instance standard-object) @rest{} initargs}
+
+The generic function @code{initialize-instance} is called by
+@code{make-instance} to initialize a newly created instance.  The generic
+function @code{initialize-instance} is called with the new instance and the
+defaulted initialization arguments.
+@end deffn
+
+@defun {invalid-method-error} {method format-string @rest{} args}
+
+The function @code{invalid-method-error} is used to signal an error when there
+is an applicable method whose qualifiers are not valid for the method
+combination type.  The error message is constructed by using a format string
+and any arguments to it.  Because an implementation may need to add additional
+contextual information to the error message, invalid-method-error should be
+called only within the dynamic extent of a method combination function.  The
+function invalid-method-error is called automatically when a method fails to
+satisfy every qualifier pattern and predicate in a define-method-combination
+form.  A method combination function that imposes additional restrictions
+should call invalid-method-error explicitly if it encounters a method it cannot
+accept.
+@end defun
+
+@deffn {Generic} {make-instance}  class @rest{}@var{ initargs}
+@deffnx {Method} {make-instance} {(class standard-class) @rest{} initargs}
+@deffnx {Method} {make-instance} {(class symbol) @rest{} initargs}
+
+The generic function make-instance creates and returns a new instance of the
+given class.  The generic function make-instance may be used as described in
+section 1.9.  The class argument is a class object or a symbol that names a
+class.  The remaining arguments form a list of alternating initialization
+argument names and values.  If the second of the above methods is selected,
+that method invokes make-instance on the arguments (find-class class) and
+initargs.  The initialization arguments are checked within make-instance (see
+section 1.9).  The new instance is returned.
+@end deffn
+
+@deffn {Generic} {make-instances-obsolete}  class
+@deffnx {Method} {make-instances-obsolete} {(class standard-class)}
+@deffnx {Method} {make-instances-obsolete} {(class symbol)}
+@end deffn
+
+@defun {method-combination-error} {format-string @rest{} args}
+
+The function method-combination-error is used to signal an error in method
+combination.  The error message is constructed by using a format string and any
+arguments to it.  Because an implementation may need to add additional
+contextual information to the error message, method-combination-error should be
+called only within the dynamic extent of a method combination function.  The
+format-string argument is a control string that can be given to format, and
+args are any arguments required by that string.
+@end defun
+
+@deffn {Generic} {method-qualifiers}  method
+@deffnx {Method} {method-qualifiers} {(method standard-method)}
+
+The generic function method-qualifiers returns a list of the qualifiers
+of the given method.
+@end deffn
+
+@defun {next-method-p} {}
+
+The locally defined function next-method-p can be used within the body of a
+method defined by a method-defining form to determine whether a next method
+exists.
+@end defun
+
+@deffn {Generic} {no-applicable-method}  generic-function @rest{} function-arguments
+@deffnx {Method} {no-applicable-method} {(generic-function t) @rest{} function-arguments}
+
+The generic function no-applicable-method is called when a generic function of
+the class standard-generic-function is invoked and no method on that generic
+function is applicable. The default method signals an error.
+@end deffn
+
+@deffn {Generic} {no-next-method}  generic-function method @rest{} args
+@deffnx {Method} {no-next-method} {(generic-function standard-generic-function) (method standard-method) @rest{} args}
+@end deffn
+
+@deffn {Generic} {print-object}  object stream
+@deffnx {Method} {print-object} {(object standard-object) stream}
+
+The generic function print-object writes the printed representation of an
+object to a stream.  The function print-object is called by the print system;
+it should not be called by the user.
+@end deffn
+
+@deffn {Generic} {reinitialize-instance}  instance @rest{} initargs
+@deffnx {Method} {reinitialize-instance} {(instance standard-object) @rest{} initargs}
+
+The generic function reinitialize-instance can be used to change the
+values of local slots according to initialization arguments.  This
+generic function is called by the Meta-Object Protocol.  It can also be
+called by users.
+@end deffn
+
+@deffn {Generic} {remove-method}  generic-function method
+@deffnx {Method} {remove-method} {(generic-function standard-generic-function) method}
+
+The generic function remove-method removes a method from a generic function.
+It destructively modifies the specified generic function and returns the
+modified generic function as its result.
+@end deffn
+
+@deffn {Generic} {shared-initialize}  @var{instance slot-names @rest{} initargs}
+@deffnx {Method} {shared-initialize} {(instance standard-object) slot-names @rest{} initargs}
+
+The generic function shared-initialize is used to fill the slots of an instance
+using initialization arguments and :initform forms.  It is called when an
+instance is created, when an instance is re-initialized, when an instance is
+updated to conform to a redefined class, and when an instance is updated to
+conform to a different class.  The generic function @code{shared-initialize} is
+called by the system-supplied primary method for @code{initialize-instance},
+@code{reinitialize-instance}, @code{update-instance-for-redefined-class}, and
+@code{update-instance-for-different-class}.
+@end deffn
+
+@defun {slot-boundp} {instance slot-name}
+
+The function slot-boundp tests whether a specific slot in an instance is bound.
+The arguments are the instance and the name of the slot.
+@end defun
+
+@defun {slot-exists-p} {object slot-name}
+
+The function slot-exists-p tests whether the specified object has a slot of the
+given name.  The object argument is any object.  The slot-name argument is a
+symbol.
+@end defun
+
+@defun {slot-makunbound} {instance slot-name}
+
+The function slot-makunbound restores a slot in an instance to the unbound
+state.  The arguments to slot-makunbound are the instance and the name of the
+slot.
+@end defun
+
+@deffn {Generic} {slot-missing}  class object slot-name operation @optional{} new-value
+@deffnx {Method} {slot-missing} {(class t) object slot-name operation @optional{} new-value}
+
+The generic function slot-missing is invoked when an attempt is made to access
+a slot in an object whose metaclass is standard-class and the name of the slot
+provided is not a name of a slot in that class.  The default method signals an
+error.
+@end deffn
+
+@deffn {Generic} {slot-unbound}  class instance slot-name
+@deffnx {Method} {slot-unbound} {(class t) instance slot-name}
+
+The generic function slot-unbound is called when an unbound slot is read in an
+instance whose metaclass is standard-class. The default method signals an
+error.
+@end deffn
+
+@defun {slot-value} {object slot-name}
+
+The function slot-value returns the value contained in the slot slot-name of
+the given object.  If there is no slot with that name, slot-missing is called.
+If the slot is unbound, slot-unbound is called.  The macro setf can be used
+with slot-value to change the value of a slot.
+@end defun
+
+@deffn {Generic} {update-instance-for-different-class}  previous current @rest{} initargs
+@deffnx {Method} {update-instance-for-different-class} {(previous standard-object) (currentstandard-object) @rest{} initargs}
+@end deffn
+
+@deffn {Generic} {update-instance-for-redefined-class}  instance added-slots discarded-slots property-list @rest{} initargs
+@deffnx {Method} {update-instance-for-redefined-class} {(instance standard-object) added-slots discarded-slots property-list @rest{} initargs}
+@end deffn
+
+@defmac {with-accessors} {(@{slot-entry@}*) instance-form @{declaration@}* @{form@}*}
+
+The macro with-accessors creates a lexical environment in which specified slots
+are lexically available through their accessors as if they were variables.  The
+macro with-accessors invokes the appropriate accessors to access the specified
+slots.  Both setf and setq can be used to set the value of the slot.  The
+result returned is that obtained by executing the forms specified by the body
+argument.
+@end defmac
+
+@defmac {with-slots} {(@{slot-entry@}*) instance-form @{declaration@}* @{form@}*}
+@example
+@var{slot-entry} ::= @var{slot-name} | (@var{variable-name} @var{slot-name})
+@end example
+
+The macro @code{with-slots} creates a lexical context for referring to
+specified slots as though they were variables.  Within such a context the value
+of the slot can be specified by using its slot name, as if it were a lexically
+bound variable.  Both @code{setf} and @code{setq} can be used to set the value
+of the slot.
+@end defmac
+
+
+@node Multithread, Implementation details, CLOS, Top
+@chapter Multithread
+
+The goals of the present design are to provide a minimal set of facilities,
+which stand directly on the core of the @llisp{} computational model, and which
+provide the maximum degree of flexibility to build higher level concurrency and
+synchronization constructs.
+
+In particular we wanted a system which:
+@itemize
+@item is semantically based
+@item is flexible enough to allow freedom to experiment new constructs
+@item blends with the functional nature of @llisp{}
+@item blends with object-oriented programming
+@end itemize
+
+We have achieved this by taking the fundamental concepts of denotational
+description of functional languages like @llisp{} and making them accessible
+within the programming language itself according to the technique of reflection
+@bibcite{Smith:84}.
+
+We show several examples of how typical concurrent programming constructs can
+be implemented using these primitives.
+
+@menu
+* Model::                       
+* Manual Section::              
+@end menu
+
+
+@node Model, Manual Section, Multithread, Multithread
+@section Model
+
+The computational model on which our design is based is the functional model
+described with continuation semantics.  Processing happens through steps of
+function application.  Each function invocation is supplied with a
+continuation, representing the continuation of the program.  Normally as the
+last step of each function execution, the continuation is invoked with
+arguments the values to be returned by the function. The continuation will then
+proceed execution with such values.  However the function can instead invoke an
+alternative continuation, discarding the continutation it has received. In this
+way, the function has the ability to alter the flow of control of the program.
+The theory of denotational semantics shows that with this style of description,
+any arbitrary control construct can be programmed.
+
+Our approach has been to take this underlying model and to make it visible to
+the @llisp{} programmer. Control flow proceed normally through function calls,
+unless the program requests to access its continuation. It can then decide
+whether it wants to resume such continuation at the end, thereby proceeding
+normally, or to discard that continuation and proceed in a different
+way. Continuations are first-class objects which can be passed as arguments or
+returned as values from functions.
+
+Given this model of computation, the only addition which is necessary to be
+able to handle concurrency is the ability to create multiple threads of
+execution.  Control of flow among different threads is obtained just by the use
+of continuations.
+
+@menu
+* Threads::                     
+* Continuations::               
+* Concurrency::                 
+* Mixed computations::          
+@end menu
+
+@node Threads, Continuations, Model, Model
+@subsection Threads
+
+A thread identifies one sequential flow of execution. A thread contains all the
+dynamic information needed by the @llisp{} executor.  A list of active threads
+is managed by a scheduler, which switches execution among them at the
+expiration of a time slice or when a thread gets suspended.
+
+The structure of a thread is roughly as follows:
+
+@center @b{Thread}
+
+@center Function
+
+@center Runtime Stack(s)
+
+@center Program Counter
+
+@center CPU Registers
+
+@center @b{Next Thread}
+
+@center @dots{}
+
+
+@node Continuations, Concurrency, Threads, Model
+@subsection Continuations
+
+A @tindexed{continuation} represents a thread suspended at a particular point
+in its execution, when it is expecting some return values from a procedure call
+or some arguments to a procedure.  Since a continuation can be resumed only
+once, each continuation is unique.
+
+@node Concurrency, Mixed computations, Continuations, Model
+@subsection Concurrency
+
+Actors can be activated concurrently by means of the send primitive. When send
+is invoked, a new @emph{thread}, is created for processing the message by the
+actor, unless the @emph{actor} is already running. In the latter case, the
+message will be just enqueued within the actor.
+
+During the execution of the actor, any function called within the body of the
+actor will use the stack of the new thread. Only using one of the message
+passing primitives like @emph{send} and @emph{reply} the execution will switch
+to a different stack.
+
+@node Mixed computations,  , Concurrency, Model
+@subsection Mixed Computations
+
+In our model computation can proceed in two ways. One way corresponds to the
+traditional sequential execution with function invocation and return, always
+running within a single thread; the second way enables parallel execution where
+function activations proceed concurrently, each one in a separate thread.
+Activation and exchange of data is obtained with the primitive @code{resume}.
+
+A relevant feature or our approach is that the message passing primitives are
+just a generalization of the call/return mechanism, and therefore it is
+possible for the two mechanisms to cohexist easily and neatly.
+
+@node Manual Section,  , Model, Multithread
+@section Manual Section
+
+The present design is structured in two levels.  The first level introduces the
+new data types continuation and thread, and provides a set of primitives to
+create and operate on them.  Using these primitives it is already possible to
+generate and control concurrent computations expressed in terms of @clisp{}
+functions.
+
+The second level is built on top of the facilities of the first level. By
+exploiting the capability to get a hold and manipulate continuations, the
+second level provides a set of constructs for concurrent object oriented
+programming.  Concurrent activities can be generated by using the asynchronous
+send construct.  Synchronization is provided through serialization of message
+processing by an actor.
+
+@menu
+* Primitives::                  
+@end menu
+
+@node Primitives,  , Manual Section, Manual Section
+@subsection Primitives
+
+Two new data types are introduced into the language:
+@itemize
+@item thread
+@item continuation
+@end itemize
+
+@menu
+* Thread primitives::           
+* Continuation primitives::     
+* Scheduler primitives::        
+@end menu
+
+
+@node Thread primitives, Continuation primitives, Primitives, Primitives
+@subsubsection Thread Primitives
+
+@defun {make-thread} {function @keys :cont :name :size}
+
+@var{function} may be a compiled-code object, or a lambda-expression, or a
+symbol; in the latter case the global functional value of that symbol is used
+(which cannot be a special form nor a macro). make-thread creates a new thread
+ready to execute @var{function}. The thread is in a @cindexed{SUSPENDED} status
+and does not run. A thread can be put into execution only by making a
+continuation for it and issuing a resume to such continuation with a list of
+arguments.
+
+@var{name} is a symbol or string used to identify the thread.  @var{size} is
+the dimension of the evaluation stack to be used by the thread.
+@end defun
+
+@defun {deactivate} {thread}
+
+It stops a @cindexed{RUNNING} @code{thread}, removing it from the queue of
+active threads, and sets its status to @cindexed{STOPPED}. A stopped thread can
+be resumed with reactivate. Signals an error if the thread is not
+@cindexed{RUNNING}.
+@end defun
+
+@defun {reactivate} {thread}
+
+Puts a @cindexed{STOPPED} @var{thread} back into the queue of active threads
+for further execution, and sets its status to @cindexed{RUNNING}.  Signals an
+error if the thread is not @cindexed{STOPPED}.
+@end defun
+
+@defun {kill-thread} {thread}
+
+Stops the thread execution and sets its status to @cindexed{DEAD} so that it
+will not be run by the scheduler any more. If the status of the @var{thread} is
+already @cindexed{DEAD} the function has no effect.  Returns @nil{}.
+@end defun
+
+@defun {thread-status} {thread}
+
+Returns the status of the @var{thread}, one of the symbols RUNNING,
+@cindexed{SUSPENDED}, @cindexed{STOPPED} or @cindexed{DEAD}.
+@end defun
+
+@defun {current-thread} {}
+
+It returns the thread within which this function was called.
+@end defun
+
+@node Continuation primitives, Scheduler primitives, Thread primitives, Primitives
+@subsubsection Continuation Primitives
+
+@defun {make-continuation} {thread @keys{} cont}
+
+Builds a unique new continuation for resuming the @var{thread}.  @var{cont} is
+an optional continuation to be supplied to the thread.  Further
+make-continuations on the same thread are disallowed until the last
+continuation created has been resumed.
+@end defun
+
+@defun {resume} {continuation @rest{} args}
+
+Resumes execution of @var{continuation} and passes it the @var{args}.  If
+@var{continuation} was created by make-continuation of a function, the behavior
+is similar to the behavior of a funcall to that function. However execution
+goes on in a separate thread, that is concurrently to the thread which is
+issuing the resume.  Resume returns immediately the thread which has been
+activated.  The thread for continuation must be @cindexed{SUSPENDED}, otherwise
+resume will produce an error. This could happen if continuation was created
+with the result of current-thread and that thread has not been suspended. If
+the continuation had already been resumed or timed-out, resume signals an
+error. If continuation is @nil{}, resume has no effect. Resume reenables
+make-continuation for the thread of @var{continuation}.
+@end defun
+
+@defun {pass} {continuation @rest{} args}
+
+same behaviour as @var{resume} except that suspends the current thread.
+@var{pass} does not return.
+@end defun
+
+@defun {spawn} {function @rest{} args}
+
+Creates a new thread where @var{function} is applied to the @var{args}.
+Returns immediately the new thread without waiting for the function to return.
+
+@code{Spawn} behaves like if it were defined as:
+@example
+(defmacro spawn (function @rest{} args)
+        `(resume (make-continuation (make-thread ,function)) ,@ args))
+@end example
+
+@end defun
+
+@defun {timeout} {delay continuation alternative}
+
+If after @var{delay} seconds @var{continuation} has not been resumed, the
+@var{alternative} continuation is resumed and @var{continuation} is marked as
+@cindexed{TIMED-OUT}.  Returns @nil{} immediately.
+@end defun
+
+@node Scheduler primitives,  , Continuation primitives, Primitives
+@subsubsection Scheduler Primitives
+
+@defun {%disable-scheduler} {}
+
+@code{%disable-scheduler} disables the scheduler, so that the execution of the
+current thread will not be interrupted by the scheduler until the function
+@code{%enable-scheduler} is called. Returns @nil{}.
+@end defun
+
+@defun {%enable-scheduler} {}
+
+@code{%enable-scheduler} enables the scheduler, so that it will time-slice
+execution among all the @cindexed{RUNNING} threads. Returns @nil{}.
+@end defun
+
+@defun {%suspend} {}
+
+@code{%suspend} sets the status of the current thread to @cindexed{SUSPENDED}
+and suspends its execution. The scheduler is enabled again in the same way as
+the function @code{%enable-scheduler} does. The thread will proceed execution
+@emph{only} when a continuation referring to the thread will be resumed. In
+that case @code{suspend} will return the values specified by @code{resume}.
+@end defun
+
+@node Implementation details, Everything, Multithread, Top
+@chapter Implementation Details
+
+@menu
+* @ecls{} and @clisp{}::        
+* @ecls{} is written in C and Lisp::  
+* Porting @ecls{}::             
+* The @ecls{} Compiler::        
+* The C language interface::    
+* @ecls{} size::                
+* Gabriel benchmark::           
+@end menu
+
+@node @ecls{} and @clisp{}, @ecls{} is written in C and Lisp, Implementation details, Implementation details
+@section @ecls{} is a full @clisp{} system.
+
+@ecls{} is a full implementation of the @clisp{} language described in the book
+
+@display
+@cltl{}.
+by Guy L. Steele Jr. et al.
+Digital Press, 1984
+@end display
+
+@noindent @ecls{} supports all @clisp{} functions, macros, and special forms defined in
+it, and all @clisp{} variables and constants are defined in @ecls{} exactly as
+described in the @cltl{}.
+
+
+@node @ecls{} is written in C and Lisp, Porting @ecls{}, @ecls{} and @clisp{}, Implementation details
+@section @ecls{} is written in C and Lisp
+
+The kernel of @ecls{} is written in C, including:
+
+@itemize
+@item memory management and garbage collection
+@item the evaluator (or interpreter)
+@item @clisp{} special forms
+@end itemize
+
+The @ecls{} compiler is entirely written in @clisp{}.
+
+Each @clisp{} function or macro is written either in C or in Lisp.
+
+@example
+        in C:
+                418 @clisp{} functions
+                11 @clisp{} macros
+
+        in Lisp:
+                133 @clisp{} functions
+                59 @clisp{} macros
+@end example
+
+The size of the source code is:
+
+@example
+        C code         705 Kbytes
+        @clisp{} functions and macros written in Lisp
+                       173 Kbytes
+        The compiler   264 Kbytes
+        --------------------------- 
+        total         1142 Kbytes
+@end example
+
+Three routines in the kernel are partly written in assembly language:
+
+@itemize
+@item bignum multiplication
+@item bignum division
+@item function call
+@end itemize
+
+@noindent The total size of assembly code is 20 to 30 lines, depending on the
+version of @ecls{}. C version of these routines are however also available.
+
+
+@node Porting @ecls{}, The @ecls{} Compiler, @ecls{} is written in C and Lisp, Implementation details
+@section Porting @ecls{}
+
+To port @ecls{} to a new architecture, the following steps are required:
+
+@enumerate
+@item Compile all source C code with a GCC compiler.
+
+@item Compile the Lisp libraries and the Lisp compiler,
+supplied already translated into C, except for one file in the compiler
+which contains machine dependencies.
+
+@item Link the binaries and create an executable.
+
+@item Use the executable to compile the machine dependent compiler file
+
+@item Build the full image
+@end enumerate
+
+@menu
+* Objects Representation::      
+* The heap::                    
+* @ecls{} stacks::              
+* Procedure Call Conventions::  
+* The interpreter guts::             
+* The Invocation History Stack::  
+@end menu
+
+
+@node Objects Representation, The heap, Porting @ecls{}, Porting @ecls{}
+@subsection Objects Representation
+
+@ecls{} supports immediate data for representing fixnum's and
+@code{character}'s. The two less significant digits in a pointer are used as
+a tag for distinguishing immediate data from pointers.
+
+Fixnum and characters are represented as follows:
+
+@example
+|-------------------|--| 
+|    Fixnum value   |01|
+|-------------------|--| 
+
+|------------|------|--| 
+|  Ctrl bits | char |10|
+|------------|------|--| 
+@end example
+
+A third kind of immediate data is the @code{locative}, which constains
+an indirect pointer to another object. @code{locative} are useful for
+the efficient representation of logical variables when implementing
+unifcation or Prolog.
+
+Other @ecls{} objects are represented as (a pointer to) a cell that is
+allocated on the heap.  Each cell consists of several words (1 word =
+32 bit) whose first half word is in the format common to all data types:
+half of the word is the type indicator and the other half is used as
+the mark by the garbage collector.  For instance, a cons cell consists
+of three words:
+
+@example
+             
+|---------|----------| 
+|CONS|mark|          |
+|---------|----------| 
+|     car-pointer    |
+|--------------------| 
+|     cdr-pointer    |
+|--------------------| 
+@end example
+
+Array headers and compiled-function headers are represented
+in this way, and array elements and compiled code are placed
+elsewhere.
+
+Internally in compiled functions, certain Lisp objects may
+be represented simply by their values.  For example, a fixnum object
+may be represented by its fixnum value, and a character object may be
+represented by its character code.
+
+
+@node The heap, @ecls{} stacks, Objects Representation, Porting @ecls{}
+@subsection The heap
+
+The whole heap of @ecls{} is divided into pages (1 page = 2048
+bytes).  Each page falls in one of the following classes:
+
+@itemize
+@item pages that contain @emph{cells} consisting of the same number of words
+@item pages that contain @emph{blocks} of variable size
+@item pages that contain @emph{relocatable blocks}: i.e. blocks of variable size
+which can be moved in memory, such as array elements.
+@end itemize
+
+Free cells (i.e., those cells that are not used any more) consisting
+of the same number of words are linked together to form a free list.
+When a new cell is requested, the first cell in the free list (if it
+is not empty) is used and is removed from the list.  If the free list
+is empty, then the garbage collector is invoked to collect unused
+cells.  If the new free list is too short after the garbage
+collection, then new pages are allocated dynamically.  Free blocks are
+also linked together in the order of the size so that, when a block is
+being allocated on the heap, the smallest free area that is large
+enough to hold the block datum will be used.  Cell pages are never
+compactified.  Once a page is allocated for cells with @emph{n} words,
+the page is used for cells with @emph{n} words only, even after all the
+cells in the page become garbage.  The same rule holds for block
+pages.  In contrast, relocatable pages are sometimes compactified.
+That is, each relocatable datum may be moved to another place.
+
+The actual configuration of the @ecls{} heap is:
+
+@example
+lower address                                       higher address
+ +-----------------------------+----------+---------------------+
+ | cell pages and block pages  |   hole   |  relocatable pages  |
+ +-----------------------------+----------+---------------------+
+@end example
+
+There is a ``hole'' between the area for cell/block pages
+and the area for relocatable pages.  New pages are allocated in the
+hole for cell/block pages, whereas new relocatable pages are
+allocated by expanding the heap to the higher address, i.e., to the
+right in this figure.  When the hole becomes empty, the area for
+relocatable pages are shifted to the right to reserve a certain number
+of pages as the hole.  During this process, the relocatable data in
+the relocatable pages are compactified.  No free list is maintained
+for relocatable data.
+
+Symbol print names and string bodies are usually allocated
+in relocatable pages.  However, when the @ecls{} system is created, i.e.,
+when the object module of @ecls{} is created, such relocatable data are
+moved towards the area for cell/block pages and then the pages for
+relocatable data are marked ``static''.  The garbage collector never
+tries to sweep static pages.  Thus, within the object module of @ecls{},
+the heap looks like:
+
+@example
+lower address               higher address
+ +--------------------------------------+
+ |  cell/block pages and static pages   |
+ +--------------------------------------+
+@end example
+
+Notice that the hole is not included in the object module;
+it is allocated only when the @ecls{} system is started.  This saves
+secondary storage a little bit.  The maximum size of the hole is about
+100 pages (= 200 Kbytes).
+
+
+@node @ecls{} stacks, Procedure Call Conventions, The heap, Porting @ecls{}
+@subsection @ecls{} stacks
+
+@ecls{} uses the following stacks:
+
+@table @sc
+@item Frame Stack
+consisting of catch, block, tagbody frames
+
+@item Bind Stack
+for shallow binding of dynamic variables
+
+@item Invocation History Stack
+maintaining information for debugging
+
+@item C Control Stack
+used for:
+@itemize
+@item arguments/values passing
+@item typed lexical variables
+@item temporary values
+@item function invocation
+@end itemize
+@end table
+
+
+@node Procedure Call Conventions, The interpreter guts, @ecls{} stacks, Porting @ecls{}
+@subsection Procedure Call Conventions
+ 
+@ecls{} employs standard C calling conventions to achieve efficiency and
+interoperability with other languages.
+Each Lisp function is implemented as a C function whcih takes as many
+argument as the Lisp original plus one additional integer argument
+which holds the number of actual arguments.  The function returns an
+integer which is the number of multiple Lisp values produced. The actual vales
+themselves are placed in a global (per thread) array (@code{VALUES}).
+
+To show the argument/value passing mechanism, here we list the actual
+code for the @clisp{} function @code{cons}.
+
+@example
+Lcons(int narg, object car, object cdr)
+@{       object x;
+        check_arg(2);
+        x = alloc_object(t_cons);
+        CAR(x) = car;
+        CDR(x) = cdr;
+        VALUES(0) = x;
+        RETURN(1);
+@}
+@end example
+
+@ecls{} adopts the convention that the name of a function that
+implements a @clisp{} function begins with @code{L}, followed by the
+name of the @clisp{} function.  (Strictly speaking, `@code{-}' and
+`@code{*}' in the @clisp{} function name are replaced by `@code{_}' and
+`@code{A}', respectively, to obey the syntax of C.)
+
+@code{check_arg(2)} in the code of @code{Lcons} checks that exactly two
+arguments are supplied to @code{cons}.  That is, it checks that @code{narg} is
+2, and otherwise, it causes an error.  @code{allocate_object(t_cons)} allocates
+a cons cell in the heap and returns the pointer to the cell.  After the
+@code{CAR} and the @code{CDR} fields of the cell are set, the cell pointer is
+put in the @code{VALUES} array. The integer returned by the function (1 in this
+case) represents the number of values of the function.
+
+
+@node The interpreter guts, The Invocation History Stack, Procedure Call Conventions, Porting @ecls{}
+@subsection The interpreter
+
+The @ecls{} interpreter uses three A-lists (Association lists) to
+represent lexical environments.
+
+@itemize
+@item One for variable bindings
+@item One for local function/macro definitions
+@item One for tag/block bindings
+@end itemize
+
+When a function closure is created, the current three A-lists are
+saved in the closure along with the lambda expression.  Later, when the
+closure is invoked, the saved A-lists are
+used to recover the lexical environment.
+
+
+@node The Invocation History Stack,  , The interpreter guts, Porting @ecls{}
+@subsection The Invocation History Stack
+ 
+The invocation history stack consists of two kinds of elements.  Each element
+may be either a pair of a Lisp form and a pointer to lexical environment:
+
+@example
++----------+------------------------+
+|   form   |   environment-pointer  |
++----------+------------------------+
+@end example
+
+@noindent or a pair of a function name and a pointer to the value stack:
+
+@example
++-----------------+-----------------+
+|  function-name  |  stack-pointer  |
++-----------------+-----------------+
+@end example
+
+The former is pushed on the invocation history stack when an
+interpreted code is evaluated.  The @emph{form} is the interpreted code
+itself and the @emph{environment-pointer} points to a three elements
+array which holds the three elements that represent the lexical
+environment.  The latter is pushed when a compiled function is
+invoked.  The @emph{function-name} is the name of the called function
+and the @emph{stack-pointer} points to the position of the first
+argument to the function.  For both kinds, the element on the
+invocation history stack is popped at the end of the evaluation.
+
+Let us see how the invocation history stack is used for debugging.
+
+@example
+>(defun fact (x)                ;;;  Wrong definition of the 
+   (if (= x 0)                  ;;;  factorial function. 
+       one                      ;;;  one  should be  1. 
+       (* x (fact (1- x)))))
+FACT
+
+>(fact 3)                       ;;;  Tries  3!
+Error: The variable ONE is unbound.
+Error signalled by IF.
+Broken at IF.
+>>:b                            ;;;  Backtrace. 
+Backtrace: eval > fact > if > fact > if > fact > if > fact > IF
+                                ;;;  Currently at the last  IF.
+>>:h                            ;;;  Help. 
+
+Break commands:
+:q(uit)         Return to some previous break level.
+:pop            Pop to previous break level.
+:c(ontinue)     Continue execution.
+:b(acktrace)    Print backtrace.
+:f(unction)     Show current function.
+:p(revious)     Go to previous function.
+:n(ext)         Go to next function.
+:g(o)           Go to next function.
+:fs             Search forward for function.
+:bs             Search backward for function.
+:v(ariables)    Show local variables, functions, blocks, and tags.
+:l(ocal)        Return the nth local value on the stack.
+:hide           Hide function.
+:unhide         Unhide function.
+:hp             Hide package.
+:unhp           Unhide package.
+:unhide-all     Unhide all variables and packages.
+:bds            Show binding stack.
+:m(essage)      Show error message.
+:hs             Help stack.
+Top level commands:
+:cf             Compile file.
+:exit or ^D     Exit Lisp.
+:ld             Load file.
+:step           Single step form.
+:tr(ace)        Trace function.
+:untr(ace)      Untrace function.
+
+Help commands:
+:apropos        Apropos.
+:doc(ument)     Document.
+:h(elp) or ?    Help.  Type ":help help" for more information.
+
+>>:p                        ;;;  Move to the last call of  FACT.
+Broken at IF.
+
+>>:b
+Backtrace: eval > fact > if > fact > if > fact > if > FACT > if
+                            ;;;  Now at the last  FACT.
+>>:v                        ;;;  The environment at the last call 
+Local variables:            ;;;  to  FACT  is recovered. 
+  X: 0                      ;;;  X  is the only bound variable. 
+Block names: FACT.          ;;;  The block  FACT  is established. 
+                   
+>>x
+0                           ;;;  The value of  x  is  0.
+        
+>>(return-from fact 1)      ;;;  Return from the last call of 
+6                           ;;;  FACT  with the value of  0.
+                            ;;;  The execution is resumed and 
+>                           ;;;  the value  6  is returned. 
+                            ;;;  Again at the top-level loop. 
+@end example
+
+
+@node The @ecls{} Compiler, The C language interface, Porting @ecls{}, Implementation details
+@section The @ecls{} Compiler
+ 
+The @ecls{} compiler is essentially a translator from @clisp{} to C.  Given
+a Lisp source file, the compiler first generates three intermediate
+files:
+
+@itemize
+@item a C-file which consists of the C version of the Lisp program
+@item an H-file which consists of declarations referenced in the C-file
+@item a Data-file which consists of Lisp data to be used at load time
+@end itemize
+
+The @ecls{} compiler then invokes the C compiler to compile the
+C-file into an object file.  Finally, the contents of the Data-file is
+appended to the object file to make a @emph{Fasl-file}.  The generated
+Fasl-file can be loaded into the @ecls{} system by the @clisp{}
+function @code{load}.  By default, the three intermediate files are
+deleted after the compilation, but, if asked, the compiler leaves
+them.
+
+The merits of the use of C as the intermediate language are:
+
+@itemize -
+@item  The @ecls{} compiler is highly portable.  Indeed the four versions
+of @ecls{} share the same compiler.  Only the calling sequence
+of the C compiler and the handling of the intermediate files are different
+in these versions. 
+
+@item Cross compilation is possible, because the contents of the
+intermediate files are common to all versions of @ecls{}.  For example,
+one can compile his or her Lisp program by the @ecls{} compiler on
+a Sun, bring the intermediate files to DOS, compile the C-file with
+the gcc compiler under DOS, and then append the Data-file to the object
+file.  This procedure generates the Fasl-file for the @ecls{} system on
+DOS.  This kind of cross compilation makes it easier to port @ecls{}.
+
+@item Hardware-dependent optimizations such as register allocations
+are done by the C compiler.
+@end itemize
+
+The demerits are:
+
+@itemize -
+@item  At those sites where no C compiler is available,
+the users cannot compile their Lisp programs.
+
+@item The compilation time is long.  70% to 80% of the
+compilation time is used by the C compiler.  The @ecls{} compiler is
+therefore slower than compiler generating machine code directly.
+@end itemize
+
+@menu
+* The compiler mimics human C programmer::  
+* Implementation of Compiled Closures::  
+* Use of Declarations to Improve Efficiency::  
+* Inspecting generated C code::  
+@end menu
+
+
+@node The compiler mimics human C programmer, Implementation of Compiled Closures, The @ecls{} Compiler, The @ecls{} Compiler
+@subsection The compiler mimics human C programmer
+ 
+The format of the intermediate C code generated by the @ecls{} compiler is the
+same as the hand-coded C code of the @ecls{} source programs.  For example,
+supposing that the Lisp source file contains the
+following function definition:
+
+@example
+            (defun add1 (x) (1+ x))
+@end example
+
+The compiler generates the following intermediate C code.
+
+@example
+init_code(char *start,int size,object data)
+@{      VT2
+       Cblock.cd_start=start;Cblock.cd_size=size;Cblock.cd_data=data;
+       set_VV(VV,VM1,data);
+       MF0(VV[0],L1);
+@}
+/*     function definition for ADD1     */
+   
+static L1(int narg, object V1)
+@{      
+       check_arg(1);
+       VALUES(0)=one_plus(V1);
+       RETURN(1);
+@}
+@end example
+
+The C function @code{L1} implements the Lisp function @code{add1}.  This
+relation is established by @code{MF0} in the initialization function
+@code{init_code}, which is invoked at load time.  There, the vector @code{VV}
+consists of Lisp objects; @code{VV[0]} in this example holds the Lisp symbol
+@code{add1}.  @code{VM1} in the definition of @code{L1} is a C macro declared
+in the corresponding H-file.  The actual value of @code{VM1} is the number of
+value stack locations used by @code{L1}, i.e., 2 in this example.  Thus the
+following macro definition is found in the H-file.
+
+@example
+#define VM1 2
+@end example
+
+
+@node Implementation of Compiled Closures, Use of Declarations to Improve Efficiency, The compiler mimics human C programmer, The @ecls{} Compiler
+@subsection Implementation of Compiled Closures
+ 
+The @ecls{} compiler takes two passes before it invokes the C
+compiler.  The major role of the first pass is to detect function
+closures and to detect, for each function closure, those lexical
+objects (i.e., lexical variable, local function definitions, tags, and
+block-names) to be enclosed within the closure.  This check must be
+done before the C code generation in the second pass, because lexical
+objects to be enclosed in function closures are treated in a different
+way from those not enclosed.
+
+Ordinarily, lexical variables in a compiled function @emph{f}
+are allocated on the C stack.  However, if a lexical variable is
+to be enclosed in function closures, it is allocated on a list, called
+the ``environment list'', which is local to @emph{f}.  In addition, a
+local variable is created which points to the lexical
+variable's location (within the environment list), so that
+the variable may be accessed through an indirection rather than by list
+traversal.
+
+@ignore
+\bf{Rewrite this}
+@end ignore
+
+The environment list is a pushdown list: It is empty when @emph{f} is called.
+An element is pushed on the environment list when a variable to be enclosed in
+closures is bound, and is popped when the binding is no more in effect.  That
+is, at any moment during execution of @emph{f}, the environment list contains
+those lexical variables whose binding is still in effect and which should be
+enclosed in closures.  When a compiled closure is created during execution of
+@emph{f}, the compiled code for the closure is coupled with the environment
+list at that moment to form the compiled closure.
+
+Later, when the compiled closure is invoked, a pointer is set up to each
+lexical variable in the environment list, so that each object may be referenced
+through a memory indirection.
+
+Let us see an example.  Suppose the following function has been compiled.
+
+@lisp
+(defun foo (x)
+    (let ((a #'(lambda () (incf x)))
+          (y x))
+      (values a #'(lambda () (incf x y)))))
+@end lisp
+
+@code{foo} returns two compiled closures.  The first closure increments @var{x}
+by one, whereas the second closure increments @var{x} by the initial value of
+@var{x}.  Both closures return the incremented value of @var{x}.
+
+@example
+>(multiple-value-setq (f g) (foo 10))
+#<compiled-closure nil>
+
+>(funcall f)
+11
+
+>(funcall g)
+21
+
+>
+@end example
+
+After this, the two compiled closures look like:
+
+@example
+second closure       y:                     x:
+|-------|------|      |-------|------|       |------|------| 
+|  **   |    --|----->|  10   |    --|------>|  21  | nil  |
+|-------|------|      |-------|------|       |------|------| 
+                                                ^
+                      first closure             |
+                      |-------|------|          |
+                      |   *   |    --|----------| 
+                      |-------|------| 
+
+ * : address of the compiled code for #'(lambda () (incf x))
+** : address of the compiled code for #'(lambda () (incf x y))
+@end example
+
+
+@node Use of Declarations to Improve Efficiency, Inspecting generated C code, Implementation of Compiled Closures, The @ecls{} Compiler
+@subsection Use of Declarations to Improve Efficiency
+
+Declarations, especially  type  and  function  declarations,
+increase the efficiency of the compiled code.  For example, for the
+following Lisp source file, with two @clisp{} declarations added,
+
+@lisp
+(eval-when (compile)
+  (proclaim '(function tak (fixnum fixnum fixnum) fixnum))
+
+(defun tak (x y z)
+  (declare (fixnum x y z))
+  (if (not (< y x))
+      z
+      (tak (tak (1- x) y z)
+           (tak (1- y) z x)
+           (tak (1- z) x y))))
+@end lisp
+
+The compiler generates the following C code:
+
+@example
+/*      local entry for function TAK                                  */
+static int LI1(register int V1,register int V2,register int V3)
+@{ VT3 VLEX3 CLSR3
+TTL:
+        if (V2 < V1) @{
+        goto L2;@}
+        return(V3);
+L2:
+        @{ int V5;
+          V5 = LI1((V1)-1,V2,V3);
+        @{ int V6;
+          V6 = LI1((V2)-1,V3,V1);
+          V3 = LI1((V3)-1,V1,V2);
+          V2 = V6;
+          V1 = V5;@}@}
+        goto TTL;
+;;; Note: Tail-recursive call of TAK was replaced by iteration.
+@}
+@end example
+
+
+@node Inspecting generated C code,  , Use of Declarations to Improve Efficiency, The @ecls{} Compiler
+@subsection Inspecting generated C code
+
+@clisp{} defines a function disassemble, which is
+supposed to disassemble a compiled function and to display the
+assembler code.  According to @cltl{},
+
+     @emph{This is primary useful for debugging the compiler}, ..\\
+ 
+This is, however, @emph{useless} in our case, because we are
+not concerned with assembly language.  Rather, we are interested in
+the C code generated by the @ecls{} compiler.  Thus the disassemble
+function in @ecls{} accepts not-yet-compiled functions only and displays
+the translated C code.
+
+@example
+> (defun add1 (x) (1+ x))
+ADD1
+> (disassemble *)
+;;; Compiling (DEFUN ADD1 ...).
+;;; Emitting code for ADD1.
+
+/*      function definition for ADD1                                  */
+static L1(int narg, object V1)
+@{ VT3 VLEX3 CLSR3
+TTL:
+        VALUES(0) = one_plus((V1));
+        RETURN(1);
+@}
+@end example
+
+
+@node The C language interface, @ecls{} size, The @ecls{} Compiler, Implementation details
+@section The C language interface
+
+There are several mechanism to integrate C code within @ecls{}.
+
+The user can embed his/her own C code into Lisp source code.  The
+idea is quite simple: the specified C code is inserted in the intermediate
+C code that is generated by the @ecls{} compiler.  In the following example,
+@code{Clines}  and @code{defentry}  are top-level macros specific
+to @ecls{}.  The @code{Clines}  macro form specifies the C code to be embedded,
+in terms of strings, and the @code{defentry}  form defines an entry
+of the specified C function from @ecls{}.
+
+@lisp
+(Clines
+"   int tak(x, y, z)                       "
+"   int x, y, z;                           "
+"   @{   if (y >= x) return(z);             "
+"       else return(tak(tak(x-1, y, z),    "
+"                       tak(y-1, z, x),    "
+"                       tak(z-1, x, y)));  "
+"   @}                                      "
+)
+
+(defentry tak (int int int) (int "tak"))
+@end lisp
+
+@node @ecls{} size, Gabriel benchmark, The C language interface, Implementation details
+@section @ecls{} size
+
+The size of the object module of the whole @ecls{} system (including the
+Compiler) is
+@example
+     @ecls{}/SUN      2.04 Mbytes
+@end example
+
+Since all system initialization (such as loading the database of the @ecls{}
+compiler) has been done when the object module is created, the object module
+size roughly corresponds to the initial size of the @ecls{} process when a
+@ecls{} session is started, minus the initial size of the hole in the heap
+(about 200 Kbytes).
+
+
+@node Gabriel benchmark,  , @ecls{} size, Implementation details
+@section Gabriel benchmark
+
+The following table shows the results of Richard Gabriel's Lisp benchmark tests
+in @ecls{}.  The results with five other public domain @clisp{} implementation
+are also listed for comparison.  Each number represents the CPU time (in
+seconds) for the compiled program.  The code for the benchmark is taken from:
+
+@display
+@emph{Performance and Evaluation of Lisp Systems}
+by Richard P. Gabriel
+Computer Systems Ser. Research Reports
+MIT Press, 1985
+@end display
+
+For the details of the benchmark tests, refer to the book above.
+
+@multitable {Benchmark} {Sun ELC}
+@item Benchmark @tab   Sun ELC 
+@item   Test    @tab           
+@item   Boyer  @tab        2.067 
+@item   Browse  @tab       3.750 
+@item   Ctak  @tab         0.967 
+@item   Dderiv  @tab       1.717 
+@item   Deriv  @tab        1.200 
+@item   Destru  @tab       0.350 
+@item   Div2  @tab         2.467 
+@item   Fft  @tab          2.317 
+@item   Fprint  @tab       0.167 
+@item   Fread  @tab        0.133 
+@item   Puzzle  @tab       1.833 
+@item   Stak  @tab         0.000 
+@item   Tak  @tab          0.200 
+@item   Takl  @tab         0.267 
+@item   Takr  @tab         0.233 
+@item   Tprint  @tab       0.117 
+@item   Traverse  @tab     6.783 
+@item   Triang  @tab       10.067 
+@end multitable
+
+
+@node Everything, Bibliography, Implementation details, Top
+@chapter Everything
+
+@defun {*} {@rest{} numbers}
+@end defun
+@defvar {*}
+@end defvar
+@defvar {**}
+@end defvar
+@defvar {***}
+@end defvar
+@defvar {*applyhook*}
+@end defvar
+@defvar {*break-enable*}
+@end defvar
+@defvar {*break-on-warnings*}
+@end defvar
+@defvr {compiler} {*cc*}
+@end defvr
+@defvr {compiler} {*compile-print*}
+@end defvr
+@defvr {compiler} {*compile-verbose*}
+@end defvr
+@defvr {system} {*gc-verbose*}
+@end defvr
+@defvar {*debug-io*}
+@end defvar
+@defvar {*default-pathname-defaults*}
+@end defvar
+@defvar {*error-output*}
+@end defvar
+@defvar {*eval-when-compile*}
+@end defvar
+@defvar {*evalhook*}
+@end defvar
+@defvar {*features*}
+@end defvar
+@defvr {system} {*ignore-eof-on-terminal-io*}
+@end defvr
+@deffn {system} {ignore-maximum-pages}  &optional (boolean t)
+@end deffn
+@defvr {system} {*indent-formatted-output*}
+@end defvr
+@defvr {system} {*interrupt-enable*}
+@end defvr
+@defvr {system} {*lisp-init-file-list*}
+@end defvr
+@defvr {system} {*lisp-maxpages*}
+@end defvr
+@defvar {*load-verbose*}
+@end defvar
+@defvar {*macroexpand-hook*}
+@end defvar
+@deffn {system} {*make-constant}  symbol value
+@end deffn
+@deffn {system} {*make-special}  symbol
+@end deffn
+@defvar {*modules*}
+@end defvar
+@defvr {system} {*gc-verbose*}
+@end defvr
+@defvar {*package*}
+@end defvar
+@defvar {*print-array*}
+@end defvar
+@defvar {*print-base*}
+@end defvar
+@defvar {*print-case*}
+@end defvar
+@defvar {*print-circle*}
+@end defvar
+@defvar {*print-escape*}
+@end defvar
+@defvar {*print-gensym*}
+@end defvar
+@defvar {*print-length*}
+@end defvar
+@defvar {*print-level*}
+@end defvar
+@defvar {*print-pretty*}
+@end defvar
+@defvar {*print-radix*}
+@end defvar
+@defvar {*query-io*}
+@end defvar
+@defvar {*random-state*}
+@end defvar
+@defvar {*read-base*}
+@end defvar
+@defvar {*read-default-float-format*}
+@end defvar
+@defvar {*read-suppress*}
+@end defvar
+@defvar {*readtable*}
+@end defvar
+@defvar {*standard-input*}
+@end defvar
+@defvar {*standard-output*}
+@end defvar
+@defvr {compiler} {*suppress-compiler-notes*}
+@end defvr
+@defvr {compiler} {*suppress-compiler-warnings*}
+@end defvr
+@defvr {system} {*system-directory*}
+@end defvr
+@defvar {*terminal-io*}
+@end defvar
+@defvar {*trace-output*}
+@end defvar
+@defun {+} {@rest{} numbers}
+@end defun
+@defvar {+}
+@end defvar
+@defvar {++}
+@end defvar
+@defvar {+++}
+@end defvar
+@defun {-} {number @rest{} more-numbers}
+@end defun
+@defvar {-}
+@end defvar
+@defun {/} {number @rest{} more-numbers}
+@end defun
+@defvar {/}
+@end defvar
+@defvar {//}
+@end defvar
+@defvar {///}
+@end defvar
+@defun {/=} {number @rest{} more-numbers}
+@end defun
+@defun {1+} {number}
+@end defun
+@defun {1-} {number}
+@end defun
+@defun {<} {number @rest{} more-numbers}
+@end defun
+@defun {<=} {number @rest{} more-numbers}
+@end defun
+@defun {=} {number @rest{} more-numbers}
+@end defun
+@defun {>} {number @rest{} more-numbers}
+@end defun
+@defun {>=} {number @rest{} more-numbers}
+@end defun
+@defun {abs} {number}
+@end defun
+@defun {acons} {key datum alist}
+@end defun
+@defun {acos} {number}
+@end defun
+@defun {acosh} {number}
+@end defun
+@defun {adjoin} {item list @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {adjust-array} {array dimensions @key{} (element-type (array-element-type array)) initial-element (initial-contents nil) (fill-pointer nil) (displaced-to nil) (displaced-index-offset 0)}
+@end defun
+@defun {adjustable-array-p} {array}
+@end defun
+@deffn {system} {allocate}  type number @optional{} (really-allocate nil)
+@end deffn
+@deffn {system} {allocate-contiguous-pages}  number @optional{} (really-allocate nil)
+@end deffn
+@deffn {system} {allocate-gfun}  name arity hash-table
+@end deffn
+@deffn {system} {allocate-instance}  class length
+@end deffn
+@deffn {system} {allocate-relocatable-pages}  number
+@end deffn
+@deffn {system} {allocated-contiguous-pages}  
+@end deffn
+@deffn {system} {allocated-pages} {type}
+@end deffn
+@deffn {system} {allocated-relocatable-pages}  
+@end deffn
+@defun {alpha-char-p} {char}
+@end defun
+@defun {alphanumericp} {char}
+@end defun
+@defspec {and} {(and @{form@}*)}
+@end defspec
+@defun {append} {@rest{} lists}
+@end defun
+@defun {apply} {function arg @rest{} more-args}
+@end defun
+@defun {applyhook} {function list evalhookfn applyhookfn @optional{} (env nil)}
+@end defun
+@defun {apropos} {string @optional{} (package nil)}
+@end defun
+@defun {apropos-list} {string @optional{} (package nil)}
+@end defun
+@defun {aref} {array @rest{} indexes}
+@end defun
+@deffn {system} {argc}  
+@end deffn
+@defun {arglist} {(SYMBOL)}
+@end defun
+@deffn {system} {argv}  n
+@end deffn
+@deftp {} {array} {}
+@end deftp
+@defun {array-dimension} {array n}
+@end defun
+@defvar {array-dimension-limit}
+@end defvar
+@defun {array-dimensions} {array}
+@end defun
+@defun {array-element-type} {array}
+@end defun
+@defun {array-has-fill-pointer-p} {array}
+@end defun
+@defun {array-in-bounds-p} {array @rest{} indexes}
+@end defun
+@defun {array-rank} {array}
+@end defun
+@defvar {array-rank-limit}
+@end defvar
+@defun {array-row-major-index} {array @rest{} indexes}
+@end defun
+@defun {array-total-size} {array}
+@end defun
+@defvar {array-total-size-limit}
+@end defvar
+@defun {arrayp} {x}
+@end defun
+@defun {ash} {integer count}
+@end defun
+@defun {asin} {number}
+@end defun
+@defun {asinh} {number}
+@end defun
+@defmac {assert} {(assert form [(@{place@}*) [string @{arg@}*]])}
+@end defmac
+@defun {assoc} {item alist @key{} (test #'eql) test-not (key #'identity)}
+@end defun
+@defun {assoc-if} {test alist}
+@end defun
+@defun {assoc-if-not} {test alist}
+@end defun
+@defun {atan} {x @optional{} (y 1)}
+@end defun
+@defun {atanh} {number}
+@end defun
+@deftp {} {atom} {}
+@end deftp
+@defun {atom} {x}
+@end defun
+@deffn {system} {bds-val}  n
+@end deffn
+@deffn {system} {bds-var}  n
+@end deffn
+@deftp {} {bignum} {}
+@end deftp
+@deftp {} {bit} {}
+@end deftp
+@defun {bit} {bit-array @rest{} indexes}
+@end defun
+@defun {bit-and} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@defun {bit-andc1} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@defun {bit-andc2} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@defun {bit-eqv} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@defun {bit-ior} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@defun {bit-nand} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@defun {bit-nor} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@defun {bit-not} {bit-array @optional{} (result nil)}
+@end defun
+@defun {bit-orc1} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@defun {bit-orc2} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@deftp {} {bit-vector} {}
+@end deftp
+@defun {bit-vector-p} {x}
+@end defun
+@defun {bit-xor} {bit-array1 bit-array2 @optional{} (result nil)}
+@end defun
+@defspec {block} {(block name @{form@}*)}
+@end defspec
+@defun {boole} {op integer1 integer2}
+@end defun
+@defvar {boole-1}
+@end defvar
+@defvar {boole-2}
+@end defvar
+@defvar {boole-and}
+@end defvar
+@defvar {boole-andc1}
+@end defvar
+@defvar {boole-andc2}
+@end defvar
+@defvar {boole-c1}
+@end defvar
+@defvar {boole-c2}
+@end defvar
+@defvar {boole-clr}
+@end defvar
+@defvar {boole-eqv}
+@end defvar
+@defvar {boole-ior}
+@end defvar
+@defvar {boole-nand}
+@end defvar
+@defvar {boole-nor}
+@end defvar
+@defvar {boole-orc1}
+@end defvar
+@defvar {boole-orc2}
+@end defvar
+@defvar {boole-set}
+@end defvar
+@defvar {boole-xor}
+@end defvar
+@defun {both-case-p} {char}
+@end defun
+@defun {boundp} {symbol}
+@end defun
+@defun {break} {@optional{} (format-string nil) @rest{} args}
+@end defun
+@defun {butlast} {list @optional{} (n 1)}
+@end defun
+@defun {quit} {}
+@end defun
+@defun {byte} {size position}
+@end defun
+@defun {byte-position} {byte}
+@end defun
+@defun {byte-size} {byte}
+@end defun
+@defun {caaaar} {x}
+@end defun
+@defun {caaadr} {x}
+@end defun
+@defun {caaar} {x}
+@end defun
+@defun {caadar} {x}
+@end defun
+@defun {caaddr} {x}
+@end defun
+@defun {caadr} {x}
+@end defun
+@defun {caar} {x}
+@end defun
+@defun {cadaar} {x}
+@end defun
+@defun {cadadr} {x}
+@end defun
+@defun {cadar} {x}
+@end defun
+@defun {caddar} {x}
+@end defun
+@defun {cadddr} {x}
+@end defun
+@defun {caddr} {x}
+@end defun
+@defun {cadr} {x}
+@end defun
+@defvar {call-arguments-limit}
+@end defvar
+@defun {car} {x}
+@end defun
+@defspec {case} {(case keyform @{({key | (@{key@}*)} @{form@}*)@}*)}
+@end defspec
+@defspec {catch} {(catch tag-form @{form@}*)}
+@end defspec
+@deffn {system} {catch-bad-signals}  
+@end deffn
+@defmac {ccase} {(ccase place @{(@{key | (@{key@}*)@} @{form@}*)@}*)}
+@end defmac
+@defun {cdaaar} {x}
+@end defun
+@defun {cdaadr} {x}
+@end defun
+@defun {cdaar} {x}
+@end defun
+@defun {cdadar} {x}
+@end defun
+@defun {cdaddr} {x}
+@end defun
+@defun {cdadr} {x}
+@end defun
+@defun {cdar} {x}
+@end defun
+@defun {cddaar} {x}
+@end defun
+@defun {cddadr} {x}
+@end defun
+@defun {cddar} {x}
+@end defun
+@defun {cdddar} {x}
+@end defun
+@defun {cddddr} {x}
+@end defun
+@defun {cdddr} {x}
+@end defun
+@defun {cddr} {x}
+@end defun
+@defun {cdr} {x}
+@end defun
+@defun {ceiling} {number @optional{} (divisor 1)}
+@end defun
+@defun {cerror} {continue-format-string error-format-string @rest{} args}
+@end defun
+@deffn {system} {change-instance}  instance class length
+@end deffn
+@defun {char} {string index}
+@end defun
+@defun {char-bit} {char name}
+@end defun
+@defun {char-bits} {char}
+@end defun
+@defvar {char-bits-limit}
+@end defvar
+@defun {char-code} {char}
+@end defun
+@defvar {char-code-limit}
+@end defvar
+@defvar {char-control-bit}
+@end defvar
+@defun {char-downcase} {char}
+@end defun
+@defun {char-equal} {char @rest{} more-chars}
+@end defun
+@defun {char-font} {char}
+@end defun
+@defvar {char-font-limit}
+@end defvar
+@defun {char-greaterp} {char @rest{} more-chars}
+@end defun
+@defvar {char-hyper-bit}
+@end defvar
+@defun {char-int} {char}
+@end defun
+@defun {char-lessp} {char @rest{} more-chars}
+@end defun
+@defvar {char-meta-bit}
+@end defvar
+@defun {char-name} {char}
+@end defun
+@defun {char-not-equal} {char @rest{} more-chars}
+@end defun
+@defun {char-not-greaterp} {char @rest{} more-chars}
+@end defun
+@defun {char-not-lessp} {char @rest{} more-chars}
+@end defun
+@defvar {char-super-bit}
+@end defvar
+@defun {char-upcase} {char}
+@end defun
+@defun {char/=} {char @rest{} more-chars}
+@end defun
+@defun {char<} {char @rest{} more-chars}
+@end defun
+@defun {char<=} {char @rest{} more-chars}
+@end defun
+@defun {char=} {char @rest{} more-chars}
+@end defun
+@defun {char>} {char @rest{} more-chars}
+@end defun
+@defun {char>=} {char @rest{} more-chars}
+@end defun
+@deftp {} {character} {}
+@end deftp
+@defun {character} {x}
+@end defun
+@defun {characterp} {x}
+@end defun
+@deffn {system} {chdir}  filespec
+@end deffn
+@defmac {check-type} {(check-type place typespec [string-form])}
+@end defmac
+@defun {cis} {radians}
+@end defun
+@defun {clear-input} {@optional{} (stream *standard-input*)}
+@end defun
+@defun {clear-output} {@optional{} (stream *standard-output*)}
+@end defun
+@defmac {clines} {(clines @{string@}*)}
+@end defmac
+@defun {close} {stream @key{} (abort nil)}
+@end defun
+@defun {clrhash} {hash-table}
+@end defun
+@defun {code-char} {code @optional{} (bits 0) (font 0)}
+@end defun
+@defun {coerce} {x type}
+@end defun
+@deftp {} {common} {}
+@end deftp
+@defun {commonp} {x}
+@end defun
+@defun {compile} {name @optional{} (definition nil)}
+@end defun
+@defun {compile-file} {input-pathname @key{} output-file (load nil) (o-file t) (c-file nil) (h-file nil) (data-file nil)}
+@end defun
+@deftp {} {compiled-function} {}
+@end deftp
+@deffn {system} {compiled-function-name}  compiled-function
+@end deffn
+@defun {compiled-function-p} {x}
+@end defun
+@defspec {compiler-let} {(compiler-let (@{var | (var [value])@}*) @{form@}*)}
+@end defspec
+@deftp {} {complex} {}
+@end deftp
+@defun {complex} {realpart @optional{} (imagpart 0)}
+@end defun
+@defun {complexp} {x}
+@end defun
+@defun {concatenate} {type @rest{} sequences}
+@end defun
+@defspec {cond} {(cond @{(test @{form@}*)@}*)}
+@end defspec
+@defun {conjugate} {number}
+@end defun
+@deftp {} {cons} {}
+@end deftp
+@defun {cons} {x y}
+@end defun
+@defun {consp} {x}
+@end defun
+@defun {constantp} {x}
+@end defun
+@defun {copy-alist} {alist}
+@end defun
+@defun {copy-list} {list}
+@end defun
+@defun {copy-readtable} {@optional{} (readtable *readtable*) (to-readtable nil)}
+@end defun
+@defun {copy-seq} {sequence}
+@end defun
+@defun {copy-symbol} {symbol @optional{} (flag nil)}
+@end defun
+@defun {copy-tree} {tree}
+@end defun
+@defun {cos} {radians}
+@end defun
+@defun {cosh} {number}
+@end defun
+@defun {count} {item sequence @key{} (key #'identity) (test #'eql) test-not (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {count-if} {test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {count-if-not} {test sequence (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defmac {ctypecase} {(ctypecase place {(type {form}*)}*)}
+@end defmac
+@deffn {system} {daylight-saving-time-p}  
+@end deffn
+@defspec {decf} {(decf place [form])}
+@end defspec
+@defspec {declare} {(declare {decl-spec}*)}
+@end defspec
+@defun {decode-float} {float}
+@end defun
+@defun {decode-universal-time} {integer @optional{} (timezone (get-local-time-zone))}
+@end defun
+@defmac {defcbody} {(defcbody symbol ({arg-type}*) value-type body)}
+@end defmac
+@defmac {defcfun} {(defcfun header n {element}*)}
+@end defmac
+@defmac {defconstant} {(defconstant symbol form [doc])}
+@end defmac
+@defmac {defentry} {(defentry symbol ({arg-type}*) (value-type function-name))}
+@end defmac
+@defmac {define-modify-macro} {(define-modify-macro symbol lambda-list function-name [doc])}
+@end defmac
+@defmac {define-setf-method} {(define-setf-method symbol defmacro-lambda-list @{decl | doc@}* @{form@}*)}
+@end defmac
+@defmac {definline} {(definline symbol (@{arg-type@}*) value-type body)}
+@end defmac
+@defmac {defla} {(defla name lambda-list @{decl | doc@}* @{form@}*)}
+@end defmac
+@defmac {defmacro} {(defmacro name defmacro-lambda-list @{decl | doc@}* @{form@}*)}
+@end defmac
+@defmac {defparameter} {(defparameter name form [doc])}
+@end defmac
+@defmac {defsetf} {(defsetf symbol update-fun [doc])}
+@end defmac
+@defmac {defstruct} {(defstruct arguments)}
+@example
+@var{arguments} ::=
+     @{name | (name @{:conc-name | (:conc-name prefix-string) |
+               :constructor | (:constructor symbol [lambda-list]) |
+               :copier | (:copier symbol) |
+               :predicate | (:predicate symbol) |
+               (:include symbol) |
+               (:print-function function) |
+               (:type @{vector | (vector type) | list@}) |
+               :named |
+               (:initial-offset number)@}*)@}
+     [doc]
+     @{slot-name |
+      (slot-name [default-value-form] @{:type type | :read-only flag@}*)@}*
+@end example
+@end defmac
+@defmac {deftp} {(deftp name lambda-list @{decl | doc@}* @{form@}*)}
+@end defmac
+@defspec {defun} {(defun name lambda-list @{decl | doc@}* @{form@}*)}
+@end defspec
+@defmac {defunc} {(defunc symbol lambda-list @{string@}*)}
+@end defmac
+@defmac {defvar} {(defvar name [form [doc]])}
+@end defmac
+@defun {delete} {item sequence @key{} (key #'identity) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {delete-duplicates} {sequence @key{} (key #'identity) (test #'eql) test-not (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {delete-file} {filespec}
+@end defun
+@defun {delete-if} {test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {delete-if-not} {test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {denominator} {rational}
+@end defun
+@defun {deposit-field} {integer1 bytespec integer2}
+@end defun
+@defun {describe} {x}
+@end defun
+@defun {digit-char} {digit @optional{} (n 10) (font 0)}
+@end defun
+@defun {digit-char-p} {char @optional{} (n 10)}
+@end defun
+@defun {directory} {filespec}
+@end defun
+@defun {directory-namestring} {filespec}
+@end defun
+@defun {disassemble} {@optional{} (thing nil) @key{} (h-file nil) (data-file nil)}
+@end defun
+@deffn {system} {displaced-array-p}  array
+@end deffn
+@defspec {do} {(do (@{(var [init [step]])@}*) (test {result}*) @{decl@}* @{tag | statement@}*)}
+@end defspec
+@defspec {do*} {(do* (@{(var [init [step]])@}*) (test @{result@}*) @{decl@}* @{tag | statement@}*)}
+@end defspec
+@defmac {do-all-symbols} {(do-all-symbols (var [result]) @{decl@}* @{tag | statement@}*)}
+@end defmac
+@defmac {do-external-symbols} {(do-external-symbols (var [package [result]]) @{decl@}* @{tag | statement@}*)}
+@end defmac
+@defmac {do-symbols} {(do-symbols (var [package [result]]) @{decl@}* @{tag | statement@}*)}
+@end defmac
+@defun {documentation} {symbol doc-type}
+@end defun
+@defspec {dolist} {(dolist (var form [result]) @{decl@}* @{tag | statement@}*)}
+@end defspec
+@deftp {} {double-float} {}
+@end deftp
+@defspec {dotimes} {(dotimes (var form [result]) @{decl@}* @{tag | statement@}*)}
+@end defspec
+@defvar {double-float-epsilon}
+@end defvar
+@defvar {double-float-negative-epsilon}
+@end defvar
+@defun {dpb} {newbyte bytespec integer}
+@end defun
+@defun {dribble} {@optional{} filespec}
+@end defun
+@defmac {ecase} {(ecase keyform @{(@{key | (@{key@}*)@} @{form@}*)@}*)}
+@end defmac
+@defun {ed} {@optional{} x}
+@end defun
+@defun {eighth} {x}
+@end defun
+@defun {elt} {sequence n}
+@end defun
+@defun {encode-universal-time} {second minute hour date month year @optional{} (timezone (get-local-time-zone))}
+@end defun
+@defun {endp} {x}
+@end defun
+@defun {enough-namestring} {filespec @optional{} (defaults *default-pathname-defaults*)}
+@end defun
+@defun {eq} {x y}
+@end defun
+@defun {eql} {x y}
+@end defun
+@defun {equal} {x y}
+@end defun
+@defun {equalp} {x y}
+@end defun
+@defun {error} {format-string @rest{} args}
+@end defun
+@deffn {system} {error-set}  form
+@end deffn
+@defmac {etypecase} {(etypecase keyform @{(type @{form@}*)@}*)}
+@end defmac
+@defun {eval} {form}
+@end defun
+@defspec {eval-when} {(eval-when (@{situation@}*) @{form@}*)}
+@end defspec
+@defun {evalhook} {form fun1 fun2 @optional{} (env nil)}
+@end defun
+@defun {evenp} {integer}
+@end defun
+@defun {every} {predicate sequence @rest{} more-sequences}
+@end defun
+@defun {exp} {number}
+@end defun
+@defun {export} {symbol @optional{} (package *package*)}
+@end defun
+@defun {expt} {number1 number2}
+@end defun
+@deffn {system} {faslink}  filespec string
+@end deffn
+@defun {fboundp} {symbol}
+@end defun
+@defun {fceiling} {number @optional{} (divisor 1)}
+@end defun
+@defun {ffloor} {number @optional{} (divisor 1)}
+@end defun
+@defun {fifth} {x}
+@end defun
+@defun {file-author} {filespec}
+@end defun
+@defun {file-length} {file-stream}
+@end defun
+@defun {file-namestring} {filespec}
+@end defun
+@defun {file-position} {file-stream @optional{} file-position}
+@end defun
+@defun {file-write-date} {filespec}
+@end defun
+@defun {fill} {sequence item @key{} (start 0) (end (length sequence))}
+@end defun
+@defun {fill-pointer} {vector}
+@end defun
+@defun {find} {item sequence @key{} (key #'identity) (test #'eql) test-not (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {find-all-symbols} {string}
+@end defun
+@defun {find-if} {test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {find-if-not} {test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {find-package} {name}
+@end defun
+@defun {find-symbol} {string @optional{} (package *package*)}
+@end defun
+@defun {finish-output} {@optional{} (stream *standard-output*)}
+@end defun
+@defun {first} {x}
+@end defun
+@deffn {system} {fixnump}  x
+@end deffn
+@deftp {} {fixnum} {}
+@end deftp
+@defspec {flet} {(flet (@{(name lambda-list @{decl | doc@}* @{form@}*)@}*) . body)}
+@end defspec
+@deftp {} {float} {}
+@end deftp
+@defun {float} {number @optional{} float}
+@end defun
+@defun {float-digits} {float}
+@end defun
+@defun {float-precision} {float}
+@end defun
+@defun {float-radix} {float}
+@end defun
+@defun {float-sign} {float1 @optional{} (float2 (float 1 float1))}
+@end defun
+@defun {floatp} {x}
+@end defun
+@defun {floor} {number @optional{} (divisor 1)}
+@end defun
+@defun {fmakunbound} {symbol}
+@end defun
+@defun {force-output} {@optional{} (stream *standard-output*)}
+@end defun
+@defun {format} {destination format-string @rest{} args}
+@end defun
+@defun {fourth} {x}
+@end defun
+@defun {fresh-line} {@optional{} (stream *standard-output*)}
+@end defun
+@defun {fround} {number @optional{} (divisor 1)}
+@end defun
+@deffn {system} {frs-bds}  n
+@end deffn
+@deffn {system} {frs-ihs}  n
+@end deffn
+@defun {ftruncate} {number @optional{} (divisor 1)}
+@end defun
+@defun {funcall} {function @rest{} args}
+@end defun
+@deftp {} {function} {}
+@end deftp
+@defspec {function} {(function x) | #'x}
+@end defspec
+@defun {functionp} {x}
+@end defun
+@defun {gc} {x}
+@end defun
+@deffn {system} {gc-time}  
+@end deffn
+@defun {gcd} {@rest{} integers}
+@end defun
+@defun {gensym} {@optional{} (x nil)}
+@end defun
+@defun {gentemp} {@optional{} (string "t") (package *package*)}
+@end defun
+@defun {get} {symbol property @optional{} (default nil)}
+@end defun
+@defun {get-decoded-time} {}
+@end defun
+@defun {get-dispatch-macro-character} {char subchar @optional{} (readtable *readtable*)}
+@end defun
+@deffn {system} {get-hole-size}  
+@end deffn
+@defun {get-internal-real-time} {}
+@end defun
+@defun {get-internal-run-time} {}
+@end defun
+@deffn {system} {get-local-time-zone}  
+@end deffn
+@defun {get-macro-character} {char @optional{} (readtable *readtable*)}
+@end defun
+@defun {get-output-stream-string} {string-output-stream}
+@end defun
+@defun {get-properties} {plist list}
+@end defun
+@defun {get-setf-method} {place}
+@end defun
+@defun {get-setf-method-multiple-value} {form}
+@end defun
+@deffn {system} {get-string-input-stream-index}  string-input-stream
+@end deffn
+@defun {get-universal-time} {}
+@end defun
+@deffn {system} {getenv}  string
+@end deffn
+@defun {getf} {plist property @optional{} (default nil)}
+@end defun
+@defun {gethash} {key hash-table @optional{} (default nil)}
+@end defun
+@deffn {system} {gfun-instance}  gfun
+@end deffn
+@deffn {system} {gfun-instance-set}  gfun instance
+@end deffn
+@deffn {system} {gfun-name}  gfun
+@end deffn
+@deffn {system} {gfun-name-set}  gfun name
+@end deffn
+@deffn {system} {gfun-method-ht}  gfun
+@end deffn
+@deffn {system} {gfun-method-ht-set}  gfun hash-table
+@end deffn
+@deffn {system} {gfun-spec-how-ref}  gfun index
+@end deffn
+@deffn {system} {gfun-spec-how-set}  gfun index specializer
+@end deffn
+@deffn {system} {gfunp}  object
+@end deffn
+@defspec {go} {(go tag)}
+@end defspec
+@defun {graphic-char-p} {char}
+@end defun
+@deftp {} {hash-table} {}
+@end deftp
+@defun {hash-table-count} {hash-table}
+@end defun
+@defun {hash-table-p} {x}
+@end defun
+@defun {help} {@optional{} symbol}
+@end defun
+@defun {help*} {string @optional{} (package-spec lisp)}
+@end defun
+@defun {host-namestring} {filespec}
+@end defun
+@defun {identity} {x}
+@end defun
+@defspec {if} {(if test form1 [form2])}
+@end defspec
+@deffn {system} {ihs-fun}  n
+@end deffn
+@defun {imagpart} {number}
+@end defun
+@defun {import} {symbol @optional{} (package *package*)}
+@end defun
+@defun {in-package} {package-name @key{} (nicknames nil) (use (lisp))}
+@end defun
+@defspec {incf} {(incf place [form])}
+@end defspec
+@defun {input-stream-p} {stream}
+@end defun
+@defun {inspect} {x}
+@end defun
+@deffn {system} {instancep}  object
+@end deffn
+@deffn {system} {instance-ref}  instance index
+@end deffn
+@deffn {system} {instance-set}  instance index value
+@end deffn
+@deffn {system} {instance-class}  instance
+@end deffn
+@deffn {system} {instance-class-set}  instance class
+@end deffn
+@defun {int-char} {integer}
+@end defun
+@deftp {} {integer} {}
+@end deftp
+@defun {integer-decode-float} {float}
+@end defun
+@defun {integer-length} {integer}
+@end defun
+@defun {integerp} {x}
+@end defun
+@defun {intern} {string @optional{} (package *package*)}
+@end defun
+@defvar {internal-time-units-per-second}
+@end defvar
+@defun {intersection} {list1 list2 @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {isqrt} {integer}
+@end defun
+@deftp {} {keyword} {}
+@end deftp
+@defun {keywordp} {x}
+@end defun
+@defspec {labels} {(labels (@{(name lambda-list @{decl | doc@}* @{form@}*)@}*) . body)}
+@end defspec
+@defvar {lambda-list-keywords}
+@end defvar
+@defvar {lambda-parameters-limit}
+@end defvar
+@defun {last} {list}
+@end defun
+@defun {lcm} {integer @rest{} more-integers}
+@end defun
+@defun {ldb} {bytespec integer}
+@end defun
+@defun {ldb-test} {bytespec integer}
+@end defun
+@defun {ldiff} {list x}
+@end defun
+@defvar {least-negative-double-float}
+@end defvar
+@defvar {least-negative-long-float}
+@end defvar
+@defvar {least-negative-short-float}
+@end defvar
+@defvar {least-negative-single-float}
+@end defvar
+@defvar {least-positive-double-float}
+@end defvar
+@defvar {least-positive-long-float}
+@end defvar
+@defvar {least-positive-short-float}
+@end defvar
+@defvar {least-positive-single-float}
+@end defvar
+@defun {length} {sequence}
+@end defun
+@defspec {let} {(let (@{var | (var [init])@}*) @{decl@}* @{form@}*)}
+@end defspec
+@defspec {let*} {(let* (@{var | (var [init])@}*) @{decl@}* @{form@}*)}
+@end defspec
+@defun {lisp-implementation-type} {}
+@end defun
+@defun {lisp-implementation-version} {}
+@end defun
+@deftp {} {list} {}
+@end deftp
+@defun {list} {@rest{} args}
+@end defun
+@defun {list*} {arg @rest{} more-args}
+@end defun
+@defun {list-all-packages} {}
+@end defun
+@defun {list-length} {list}
+@end defun
+@defun {listen} {@optional{} (stream *standard-input*)}
+@end defun
+@defun {listp} {x}
+@end defun
+@defun {load} {filespec @key{} (verbose *load-verbose*) (print nil) (if-does-not-exist error)}
+@end defun
+@defspec {locally} {(locally @{decl@}* @{form@}*)}
+@end defspec
+@defun {log} {number1 @optional{} number2}
+@end defun
+@defun {logand} {@rest{} integers}
+@end defun
+@defun {logandc1} {integer1 integer2}
+@end defun
+@defun {logandc2} {integer1 integer2}
+@end defun
+@defun {logbitp} {bit-position integer}
+@end defun
+@defun {logcount} {integer}
+@end defun
+@defun {logeqv} {@rest{} integers}
+@end defun
+@defun {logior} {@rest{} integers}
+@end defun
+@defun {lognand} {integer1 integer2}
+@end defun
+@defun {lognor} {integer1 integer2}
+@end defun
+@defun {lognot} {integer}
+@end defun
+@defun {logorc1} {integer1 integer2}
+@end defun
+@defun {logorc2} {integer1 integer2}
+@end defun
+@defun {logtest} {integer1 integer2}
+@end defun
+@defun {logxor} {@rest{} integers}
+@end defun
+@deftp {} {long-float} {}
+@end deftp
+@defvar {long-float-epsilon}
+@end defvar
+@defvar {long-float-negative-epsilon}
+@end defvar
+@defun {long-site-name} {}
+@end defun
+@defmac {loop} {(loop @{form@}*)}
+@end defmac
+@defun {lower-case-p} {char}
+@end defun
+@defun {machine-instance} {}
+@end defun
+@defun {machine-type} {}
+@end defun
+@defun {machine-version} {}
+@end defun
+@defun {macro-function} {symbol}
+@end defun
+@defun {macroexpand} {form @optional{} (env nil)}
+@end defun
+@defun {macroexpand-1} {form @optional{} (env nil)}
+@end defun
+@defspec {macrolet} {(macrolet (@{(name defmacro-lambda-list @{decl | doc@}* @{form@}*)@}*) . body)}
+@end defspec
+@defun {make-array} {dimensions @key{} (element-type t) initial-element (initial-contents nil) (adjustable nil) (fill-pointer nil) (displaced-to nil) (displaced-index-offset 0) (static nil)}
+@end defun
+@defun {make-broadcast-stream} {@rest{} streams}
+@end defun
+@defun {make-char} {char @optional{} (bits 0) (font 0)}
+@end defun
+@defun {make-concatenated-stream} {@rest{} streams}
+@end defun
+@defun {make-dispatch-macro-character} {char @optional{} (non-terminating-p nil) (readtable *readtable*)}
+@end defun
+@defun {make-echo-stream} {stream1 stream2}
+@end defun
+@defun {make-hash-table} {@key{} (test eql) (size 1024) (rehash-size 1.5) (rehash-threshold 0.7)}
+@end defun
+@defun {make-list} {length @key{} (initial-element nil)}
+@end defun
+@defun {make-package} {package-name @key{} (nicknames nil) (use (lisp))}
+@end defun
+@defun {make-pathname} {@key{} (defaults (parse-namestring "" (pathname-host *default-pathname-defaults*))) (host (pathname-host defaults)) (device (pathname-device defaults)) (directory (pathname-directory defaults)) (name (pathname-name defaults)) (type (pathname-type defaults)) (version (pathname-version defaults))}
+@end defun
+@defun {make-random-state} {@optional{} (random-state nil)}
+@end defun
+@defun {make-sequence} {type length @key{} initial-element}
+@end defun
+@defun {make-string} {length @key{} (initial-element  )}
+@end defun
+@defun {make-string-input-stream} {string @optional{} (start 0) (end (length string))}
+@end defun
+@defun {make-string-output-stream} {}
+@end defun
+@deffn {system} {make-string-output-stream-from-string}  string
+@end deffn
+@defun {make-symbol} {string}
+@end defun
+@defun {make-synonym-stream} {symbol}
+@end defun
+@defun {make-two-way-stream} {stream1 stream2}
+@end defun
+@defun {makunbound} {symbol}
+@end defun
+@defun {map} {type function sequence @rest{} more-sequences}
+@end defun
+@defun {mapc} {function list @rest{} more-lists}
+@end defun
+@defun {mapcan} {function list @rest{} more-lists}
+@end defun
+@defun {mapcar} {function list @rest{} more-lists}
+@end defun
+@defun {mapcon} {function list @rest{} more-lists}
+@end defun
+@defun {maphash} {function hash-table}
+@end defun
+@defun {mapl} {function list @rest{} more-lists}
+@end defun
+@defun {maplist} {function list @rest{} more-lists}
+@end defun
+@defun {mask-field} {bytespec integer}
+@end defun
+@defun {max} {number @rest{} more-numbers}
+@end defun
+@deffn {system} {maximum-allocatable-pages}  type
+@end deffn
+@deffn {system} {maximum-contiguous-pages}  
+@end deffn
+@defun {member} {item list @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {member-if} {test list @key{} (key #'identity)}
+@end defun
+@defun {member-if-not} {test list @key{} (key #'identity)}
+@end defun
+@defun {merge} {type sequence1 sequence2 test @key{} (key #'identity)}
+@end defun
+@defun {merge-pathnames} {filespec @optional{} (defaults *default-pathname-defaults*) default-version}
+@end defun
+@defun {min} {number @rest{} more-numbers}
+@end defun
+@defun {minusp} {number}
+@end defun
+@defun {mismatch} {sequence1 sequence2 @key{} (key #'identity) (test #'eql) test-not (start1 0) (end1 (length sequence1)) (start2 0) (end2 (length sequence2)) (from-end nil)}
+@end defun
+@defun {mod} {number divisor}
+@end defun
+@defvar {most-negative-double-float}
+@end defvar
+@defvar {most-negative-fixnum}
+@end defvar
+@defvar {most-negative-long-float}
+@end defvar
+@defvar {most-negative-short-float}
+@end defvar
+@defvar {most-negative-single-float}
+@end defvar
+@defvar {most-positive-double-float}
+@end defvar
+@defvar {most-positive-fixnum}
+@end defvar
+@defvar {most-positive-long-float}
+@end defvar
+@defvar {most-positive-short-float}
+@end defvar
+@defvar {most-positive-single-float}
+@end defvar
+@defspec {multiple-value-bind} {(multiple-value-bind (@{var@}*) init @{decl@}* @{form@}*)}
+@end defspec
+@defspec {multiple-value-call} {(multiple-value-call function-form @{form@}*)}
+@end defspec
+@defspec {multiple-value-list} {(multiple-value-list form)}
+@end defspec
+@defspec {multiple-value-prog1} {(multiple-value-prog1 first-form @{form@}*)}
+@end defspec
+@defspec {multiple-value-setq} {(multiple-value-setq @{var@}* form)}
+@end defspec
+@defvar {multiple-values-limit}
+@end defvar
+@deffn {system} {nani}  fixnum
+@end deffn
+@defun {name-char} {name}
+@end defun
+@defun {namestring} {filespec}
+@end defun
+@defun {nbutlast} {list @optional{} (n 1)}
+@end defun
+@defun {nconc} {@rest{} lists}
+@end defun
+@deftp {} {nil} {}
+@end deftp
+@defvar {nil}
+@end defvar
+@defun {nintersection} {list1 list2 @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {ninth} {x}
+@end defun
+@defun {not} {x}
+@end defun
+@defun {notany} {predicate sequence @rest{} more-sequences}
+@end defun
+@defun {notevery} {predicate sequence @rest{} more-sequences}
+@end defun
+@defun {nreconc} {x y}
+@end defun
+@defun {nreverse} {sequence}
+@end defun
+@defun {nset-difference} {list1 list2 @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {nset-exclusive-or} {list1 list2 @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {nstring-capitalize} {string @key{} (start 0) (end (length string))}
+@end defun
+@defun {nstring-downcase} {string @key{} (start 0) (end (length string))}
+@end defun
+@defun {nstring-upcase} {string @key{} (start 0) (end (length string))}
+@end defun
+@defun {nsublis} {alist tree @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {nsubst} {new old tree @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {nsubst-if} {new test tree @key{} (key #'identity)}
+@end defun
+@defun {nsubst-if-not} {new test tree @key{} (key #'identity)}
+@end defun
+@defun {nsubstitute} {new old sequence @key{} (key #'identity) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {nsubstitute-if} {new test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {nsubstitute-if-not} {new test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {nth} {n list}
+@end defun
+@defun {nthcdr} {n list}
+@end defun
+@deftp {} {null} {}
+@end deftp
+@defun {null} {x}
+@end defun
+@deftp {} {number} {}
+@end deftp
+@defun {numberp} {x}
+@end defun
+@defun {numerator} {rational}
+@end defun
+@defun {nunion} {list1 list2 @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {oddp} {integer}
+@end defun
+@defun {open} {filespec @key{} (direction input) element-type if-exists if-does-not-exist}
+@end defun
+@deffn {system} {open-client-stream}  host port
+@end deffn
+@deffn {system} {open-server-stream}  host port
+@end deffn
+@defspec {or} {(or {form}*)}
+@end defspec
+@defun {output-stream-p} {stream}
+@end defun
+@deffn {system} {output-stream-string}  string-output-stream
+@end deffn
+@deftp {} {package} {}
+@end deftp
+@defun {package-name} {package}
+@end defun
+@defun {package-nicknames} {package}
+@end defun
+@defun {package-shadowing-symbols} {package}
+@end defun
+@defun {package-use-list} {package}
+@end defun
+@defun {package-used-by-list} {package}
+@end defun
+@defun {packagep} {x}
+@end defun
+@defun {pairlis} {keys items @optional{} (alist nil)}
+@end defun
+@defun {parse-integer} {string @key{} (start 0) (end (length string)) (radix 10) (junk-allowed nil)}
+@end defun
+@defun {parse-namestring} {string @optional{} host defaults @key{} (start 0) end (junk-allowed nil)}
+@end defun
+@deftp {} {pathname} {}
+@end deftp
+@defun {pathname} {filespec}
+@end defun
+@defun {pathname-device} {filespec}
+@end defun
+@defun {pathname-directory} {filespec}
+@end defun
+@defun {pathname-host} {filespec}
+@end defun
+@defun {pathname-name} {filespec}
+@end defun
+@defun {pathname-type} {filespec}
+@end defun
+@defun {pathname-version} {filespec}
+@end defun
+@defun {pathnamep} {x}
+@end defun
+@defun {peek-char} {@optional{} (char-spec nil) (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)}
+@end defun
+@defun {phase} {number}
+@end defun
+@defvar {pi}
+@end defvar
+@deffn {system} {pointer}  object
+@end deffn
+@defun {plusp} {number}
+@end defun
+@defspec {pop} {(pop place)}
+@end defspec
+@defun {position} {item sequence @key{} (key #'identity) (test #'eql) test-not (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {position-if} {test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {position-if-not} {test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {pprint} {object @optional{} (stream *standard-output*)}
+@end defun
+@defun {prin1} {object @optional{} (stream *standard-output*)}
+@end defun
+@defun {prin1-to-string} {object}
+@end defun
+@defun {princ} {object @optional{} (stream *standard-output*)}
+@end defun
+@defun {princ-to-string} {object}
+@end defun
+@defun {print} {object @optional{} (stream *standard-output*)}
+@end defun
+@defun {probe-file} {filespec}
+@end defun
+@defun {proclaim} {decl-spec}
+@end defun
+@defun {proclamation} {decl-spec}
+@end defun
+@defspec {prog} {(prog (@{var | (var [init])@}*) @{decl@}* @{tag | statement@}*)}
+@end defspec
+@defspec {prog*} {(prog* (@{var | (var [init])@}*) @{decl@}* @{tag | statement@}*)}
+@end defspec
+@defspec {prog1} {(prog1 first-form @{form@}*)}
+@end defspec
+@defspec {prog2} {(prog2 first-form second-form @{forms@}*)}
+@end defspec
+@defspec {progn} {(progn @{form@}*)}
+@end defspec
+@defspec {progv} {(progv symbols-form values-form @{form@}*)}
+@end defspec
+@defun {provide} {module-name}
+@end defun
+@defmac {psetf} {(psetf @{place form@}*)}
+@end defmac
+@defspec {psetq} {(psetq @{var form@}*)}
+@end defspec
+@defspec {push} {(push form place)}
+@end defspec
+@defmac {pushnew} {(pushnew form place @{keyword-form value-form@}*)}
+@end defmac
+@defspec {quote} {(quote x) | 'x}
+@end defspec
+@defun {random} {number @optional{} (random-state *random-state*)}
+@end defun
+@deftp {} {random-state} {}
+@end deftp
+@defun {random-state-p} {x}
+@end defun
+@defun {rassoc} {item alist @key{} (test #'eql) test-not (key #'identity)}
+@end defun
+@defun {rassoc-if} {test alist}
+@end defun
+@defun {rassoc-if-not} {test alist}
+@end defun
+@deftp {} {ratio} {}
+@end deftp
+@deftp {} {rational} {}
+@end deftp
+@defun {rational} {number}
+@end defun
+@defun {rationalize} {number}
+@end defun
+@defun {rationalp} {x}
+@end defun
+@defun {read} {@optional{} (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursivep nil)}
+@end defun
+@defun {read-byte} {stream @optional{} (eof-error-p t) (eof-value nil)}
+@end defun
+@deffn {system} {read-bytes}  stream string start end
+@end deffn
+@defun {read-char} {@optional{} (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)}
+@end defun
+@defun {read-char-no-hang} {@optional{} (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)}
+@end defun
+@defun {read-delimited-list} {char @optional{} (stream *standard-input*) (recursive-p nil)}
+@end defun
+@defun {read-from-string} {string @optional{} (eof-error-p t) (eof-value nil) @key{} (start 0) (end (length string)) (preserve-whitespace nil)}
+@end defun
+@defun {read-line} {@optional{} (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)}
+@end defun
+@defun {read-preserving-whitespace} {@optional{} (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)}
+@end defun
+@deftp {} {readtable} {}
+@end deftp
+@defun {readtablep} {x}
+@end defun
+@defun {realpart} {number}
+@end defun
+@defun {reduce} {function sequence @key{} (from-end nil) (start 0) (end (length sequence)) initial-value}
+@end defun
+@defun {rem} {number divisor}
+@end defun
+@defmac {remf} {(remf place form)}
+@end defmac
+@defun {remhash} {key hash-table}
+@end defun
+@defun {remove} {item sequence @key{} (key #'identity) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {remove-duplicates} {sequence @key{} (key #'identity) (test #'eql) test-not (start 0) (end (length sequence)) (from-end nil)}
+@end defun
+@defun {remove-if} {test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {remove-if-not} {test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {remprop} {symbol indicator}
+@end defun
+@defun {rename-file} {filespec new-filespec}
+@end defun
+@defun {rename-package} {package new-name @optional{} (new-nicknames nil)}
+@end defun
+@defun {replace} {sequence1 sequence2 @key{} (start1 0) (end1 (length sequence1)) (start2 0) (end2 (length sequence2))}
+@end defun
+@defun {require} {module-name @optional{} pathname}
+@end defun
+@deffn {system} {reset-gc-count}  
+@end deffn
+@deffn {system} {reset-stack-limits}  
+@end deffn
+@defun {rest} {x}
+@end defun
+@defspec {return} {(return [result])}
+@end defspec
+@defspec {return-from} {(return-from symbol [result])}
+@end defspec
+@defun {revappend} {x y}
+@end defun
+@defun {reverse} {sequence}
+@end defun
+@defun {room} {@optional{} (x t)}
+@end defun
+@defmac {rotatef} {(rotatef @{place@}*)}
+@end defmac
+@defun {round} {number @optional{} (divisor 1)}
+@end defun
+@defun {rplaca} {cons x}
+@end defun
+@defun {rplacd} {cons x}
+@end defun
+@deffn {system} {save}  (FILESPEC)
+@end deffn
+@deffn {system} {save-system}  pathname
+@end deffn
+@defun {sbit} {simple-bit-array @rest{} subscripts}
+@end defun
+@defun {scale-float} {float integer}
+@end defun
+@defun {schar} {simple-string n}
+@end defun
+@defun {search} {sequence1 sequence2 @key{} (key #'identity) (test #'eql) test-not (start1 0) (end1 (length sequence1)) (start2 0) (end2 (length sequence2)) (from-end nil)}
+@end defun
+@defun {second} {x}
+@end defun
+@deftp {} {sequence} {}
+@end deftp
+@defun {set} {symbol object}
+@end defun
+@defun {set-char-bit} {char bit-name flag}
+@end defun
+@defun {set-difference} {list1 list2 @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {set-dispatch-macro-character} {char subchar function @optional{} (readtable *readtable*)}
+@end defun
+@defun {set-exclusive-or} {list1 list2 @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@deffn {system} {set-hole-size}  fixnum
+@end deffn
+@defun {set-macro-character} {char function @optional{} (non-terminating-p nil) (readtable *readtable*)}
+@end defun
+@defun {set-syntax-from-char} {to-char from-char @optional{} (to-readtable *readtable*) (from-readtable nil)}
+@end defun
+@defspec {setf} {(setf @{place form@}*)}
+@end defspec
+@defspec {setq} {(setq @{var form@}*)}
+@end defspec
+@defun {seventh} {x}
+@end defun
+@defun {shadow} {symbol @optional{} (package *package*)}
+@end defun
+@defun {shadowing-import} {symbol @optional{} (package *package*)}
+@end defun
+@defmac {shiftf} {(shiftf {place}+ form)}
+@end defmac
+@deftp {} {short-float} {}
+@end deftp
+@defvar {short-float-epsilon}
+@end defvar
+@defvar {short-float-negative-epsilon}
+@end defvar
+@defun {short-site-name} {}
+@end defun
+@deftp {} {signed-byte} {}
+@end deftp
+@defun {signum} {number}
+@end defun
+@deftp {} {simple-array} {}
+@end deftp
+@deftp {} {simple-bit-vector} {}
+@end deftp
+@defun {simple-bit-vector-p} {x}
+@end defun
+@deftp {} {simple-string} {}
+@end deftp
+@defun {simple-string-p} {x}
+@end defun
+@deftp {} {simple-vector} {}
+@end deftp
+@defun {simple-vector-p} {x}
+@end defun
+@defun {sin} {radians}
+@end defun
+@deftp {} {single-float} {}
+@end deftp
+@defvar {single-float-epsilon}
+@end defvar
+@defvar {single-float-negative-epsilon}
+@end defvar
+@defun {sinh} {number}
+@end defun
+@defun {sixth} {x}
+@end defun
+@defun {sleep} {n}
+@end defun
+@deffn {system} {sl-boundp}  object
+@end deffn
+@deffn {system} {sl-makunbound}  instance index
+@end deffn
+@defun {software-type} {}
+@end defun
+@defun {software-version} {}
+@end defun
+@defun {some} {predicate sequence @rest{} more-sequences}
+@end defun
+@defun {sort} {sequence test @key{} (key #'identity)}
+@end defun
+@defun {special-form-p} {symbol}
+@end defun
+@deffn {system} {specialp}  symbol
+@end deffn
+@defun {sqrt} {number}
+@end defun
+@defun {stable-sort} {sequence test @key{} (key #'identity)}
+@end defun
+@deftp {} {standard-char} {}
+@end deftp
+@defun {standard-char-p} {char}
+@end defun
+@defmac {step} {(step form)}
+@end defmac
+@deftp {} {stream} {}
+@end deftp
+@defun {stream-element-type} {stream}
+@end defun
+@defun {streamp} {x}
+@end defun
+@defun {stream-read-char} {((obj stream-class))}
+@end defun
+@defun {stream-read-line} {((obj stream-class) @rest{} make-array-options)}
+@end defun
+@defun {stream-unread-char} {((obj stream-class) character)}
+@end defun
+@defun {stream-peek-char} {((obj stream-class) peek-type)}
+@end defun
+@defun {stream-listen} {((obj stream-class))}
+@end defun
+@defun {stream-clear-input} {((obj stream-class))}
+@end defun
+@defun {stream-write-char} {((obj stream-class) character)}
+@end defun
+@defun {stream-write-string} {((obj stream-class) string @optional{} start end)}
+@end defun
+@defun {stream-fresh-line} {((obj stream-class))}
+@end defun
+@defun {stream-clear-output} {((obj stream-class))}
+@end defun
+@defun {stream-force-output} {((obj stream-class))}
+@end defun
+@deftp {} {string} {}
+@end deftp
+@defun {string} {x}
+@end defun
+@defun {string-capitalize} {string @key{} (start 0) (end (length string))}
+@end defun
+@deftp {} {string-char} {}
+@end deftp
+@defun {string-char-p} {char}
+@end defun
+@deffn {system} {string-concatenate}  @rest{} strings
+@end deffn
+@defun {string-downcase} {string @key{} (start 0) (end (length string))}
+@end defun
+@defun {string-equal} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string-greaterp} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string-left-trim} {char-bag string}
+@end defun
+@defun {string-lessp} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string-not-equal} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string-not-greaterp} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string-not-lessp} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string-right-trim} {char-bag string}
+@end defun
+@deffn {system} {string-to-object}  string
+@end deffn
+@defun {string-trim} {char-spec string}
+@end defun
+@defun {string-upcase} {string @key{} (start 0) (end (length string))}
+@end defun
+@defun {string/=} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string<} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string<=} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string=} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string>} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {string>=} {string1 string2 @key{} (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))}
+@end defun
+@defun {stringp} {x}
+@end defun
+@deffn {system} {structurep}  x
+@end deffn
+@defun {sublis} {alist tree @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {subseq} {sequence start @optional{} (end (length sequence))}
+@end defun
+@defun {subsetp} {list1 list2 @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {subst} {new old tree @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@defun {subst-if} {new test tree @key{} (key #'identity)}
+@end defun
+@defun {subst-if-not} {new test tree @key{} (key #'identity)}
+@end defun
+@defun {substitute} {new old sequence @key{} (key #'identity) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {substitute-if} {new test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {substitute-if-not} {new test sequence @key{} (key #'identity) (start 0) (end (length sequence)) (count most-positive-fixnum) (from-end nil)}
+@end defun
+@defun {subtypep} {type1 type2}
+@end defun
+@defun {svref} {simple-vector n}
+@end defun
+@defun {sxhash} {object}
+@end defun
+@deftp {} {symbol} {}
+@end deftp
+@defun {symbol-function} {symbol}
+@end defun
+@defun {symbol-name} {symbol}
+@end defun
+@defun {symbol-package} {symbol}
+@end defun
+@defun {symbol-plist} {symbol}
+@end defun
+@defun {symbol-value} {symbol}
+@end defun
+@defun {symbolp} {x}
+@end defun
+@defun {system} {string}
+@end defun
+@deftp {} {t} {}
+@end deftp
+@defvar {t}
+@end defvar
+@defspec {tagbody} {(tagbody @{tag | statement@}*)}
+@end defspec
+@defun {tailp} {x list}
+@end defun
+@defun {tan} {radians}
+@end defun
+@defun {tanh} {number}
+@end defun
+@defun {tenth} {x}
+@end defun
+@defun {terpri} {@optional{} (stream *standard-output*)}
+@end defun
+@defspec {the} {(the type form)}
+@end defspec
+@defun {third} {x}
+@end defun
+@defspec {throw} {(throw tag form)}
+@end defspec
+@defmac {time} {(time form)}
+@end defmac
+@deffn {system} {top-level}  
+@end deffn
+@defmac {trace} {(trace (@{function-name | (@{function-name@}+)@} @{keyword [form]@}*))}
+@end defmac
+@defun {tree-equal} {x y @key{} (test #'eql) test-not}
+@end defun
+@defun {truename} {filespec}
+@end defun
+@defun {truncate} {number @optional{} (divisor 1)}
+@end defun
+@defun {type-of} {x}
+@end defun
+@defmac {typecase} {(typecase keyform @{(type @{form@}*)@}*)}
+@end defmac
+@defun {typep} {x type}
+@end defun
+@deffn {system} {uncatch-bad-signals}  
+@end deffn
+@defun {unexport} {symbol @optional{} (package *package*)}
+@end defun
+@defun {unintern} {symbol @optional{} (package *package*)}
+@end defun
+@defun {union} {list1 list2 @key{} (key #'identity) (test #'eql) test-not}
+@end defun
+@deffn {system} {universal-error-handler}  error-name continuable-p function-name continue-format-string error-format-string @rest{} args
+@end deffn
+@defspec {unless} {(unless test @{form@}*)}
+@end defspec
+@defun {unread-char} {char @optional{} (stream *standard-input*)}
+@end defun
+@deftp {} {unsigned-byte} {}
+@end deftp
+@defmac {untrace} {(untrace @{function-name@}*)}
+@end defmac
+@defun {unuse-package} {package-spec @optional{} (package *package*)}
+@end defun
+@defspec {unwind-protect} {(unwind-protect form {cleanup-form}*)}
+@end defspec
+@defun {upper-case-p} {char}
+@end defun
+@defun {use-package} {package-spec @optional{} (package *package*)}
+@end defun
+@defun {user-homedir-pathname} {@optional{} host}
+@end defun
+@defun {values} {@rest{} args}
+@end defun
+@defun {values-list} {list}
+@end defun
+@deftp {} {vector} {}
+@end deftp
+@defun {vector} {@rest{} objects}
+@end defun
+@defun {vector-pop} {vector}
+@end defun
+@defun {vector-push} {item vector}
+@end defun
+@defun {vector-push-extend} {item vector @optional{} (n (length vector))}
+@end defun
+@defun {vectorp} {x}
+@end defun
+@defun {warn} {format-string @rest{} args}
+@end defun
+@defspec {when} {(when test @{form@}*)}
+@end defspec
+@defmac {with-input-from-string} {(with-input-from-string (var string-form @{keyword value@}*) @{decl@}* @{form@}*)}
+@end defmac
+@defmac {with-open-file} {(with-open-file (var filespec-form @{options@}*) @{decl@}* @{form@}*)}
+@end defmac
+@defmac {with-open-stream} {(with-open-stream (var stream-form) @{decl@}* @{form@}*)}
+@end defmac
+@defmac {with-output-to-string} {(with-output-to-string (var [string-form]) @{decl@}* @{form@}*)}
+@end defmac
+@defun {write} {object @key{} (stream *standard-output*) (escape *print-escape*) (radix *print-radix*) (base *print-base*) (circle *print-circle*) (pretty *print-pretty*) (level *print-level*) (length *print-length*) (case *print-case*) (array *print-array*) (gensym *print-gensym*)}
+@end defun
+@defun {write-byte} {integer stream}
+@end defun
+@deffn {system} {write-bytes}  stream string start end
+@end deffn
+@defun {write-char} {char @optional{} (stream *standard-output*)}
+@end defun
+@defun {write-line} {string @optional{} (stream *standard-output*) @key{} (start 0) (end (length string))}
+@end defun
+@defun {write-string} {string @optional{} (stream *standard-output*) @key{} (start 0) (end (length string))}
+@end defun
+@defun {write-to-string} {object @key{} (escape *print-escape*) (radix *print-radix*) (base *print-base*) (circle *print-circle*) (pretty *print-pretty*) (level *print-level*) (length *print-length*) (case *print-case*) (array *print-array*) (gensym *print-gensym*)}
+@end defun
+@defun {y-or-n-p} {@optional{} (format-string nil) @rest{} args}
+@end defun
+@defun {yes-or-no-p} {@optional{} (format-string nil) @rest{} args}
+@end defun
+@defun {zerop} {number}
+@end defun
+
+
+@node Bibliography,  , Everything, Top
+@chapter Bibliography
+
+@table @b
+@item ANSI
+ANSI @clisp{} Specification, 1986.
+
+@item Steele:84
+Guy L. Steele Jr. et al. ``Common Lisp: the Language'',
+Digital Press, 1984.
+
+@item Steele:90
+Guy L. Steele Jr. at al. ``Common Lisp: the Language II'', second edition,
+Digital Press, 1990.
+
+@item Yasa:85
+Taiichi Yuasa and Masami Hagiya ``Kyoto @clisp{} Report'',
+Research Institute for Mathematical Sciences, Kyoto University, 1988.
+
+@item Smith:84
+B.C. Smith and J. des Rivieres  ``The Implementation of
+Procedurally Reflective Languages'', @emph{Proc. of the 1984 ACM
+Symposium on LISP and Functional Programming}, 1984.
+@end table
+
+@bye
diff --git a/src/etc/ecl.1 b/src/etc/ecl.1
new file mode 100644
index 000000000..69689f652
--- /dev/null
+++ b/src/etc/ecl.1
@@ -0,0 +1,84 @@
+.TH ECL 1 21/09/93
+.UC 4
+.SH NAME
+ecl \- Eco Common LISP
+.SH SYNOPSIS
+\fBecl\fP
+[ [\fB\-c\fP] [\fB\-C\fP] [\fB\-s\fP] [\fB-o\fP \fIofile\fP] \fIifile\fP ]
+.if n .ti +5
+.if t .ti +.5i
+[ \fB\-d\fP \fIdir\fP ]
+[ \fB\-l\fP \fIecl\fP ]
+.SH DESCRIPTION
+.sp
+Eco C\s-3OMMON\s0 L\s-3ISP\s0 (ECL for short) is a full
+implementation of the Common LISP language.
+.PP
+ECL provides the following additional facilities:
+.IP 1.
+MTCL: a multithread facility which allows several threads of execution within
+the same LISP world
+.IP 2.
+CLOS (the Common LISP Object System): an object oriented facility based on the
+notions of classes with multiple inheritance and generic functions
+.PP
+\fBecl\fP without any argument gives you the interactive lisp.
+\fBecl\fP
+.I ifile
+compiles
+.I ifile .
+Filenames ending in
+.B .lsp
+are taken to be
+.SM LISP
+source programs; they are compiled and the binary file is left in the file
+whose name is that of the source with
+.B .o
+substitued for
+.BR .lsp .
+Various flags control the output of the compiler.
+.SH OPTIONS
+.TP 1i
+.B \-c
+compiles the
+.I ifile
+producing only the intermediate C files and no binary file.
+.TP 1i
+.B \-C
+compiles the
+.I ifile
+and produce the intermediate C files as well.
+.TP
+.BI \-o " ofile"
+Name the output file
+.I ofile .
+.I ofile
+must have the suffix \fB.o\fP.
+.TP
+.BI \-l " ecl"
+Use
+.I ecl
+as the executable image.
+.TP
+.BI -d " dir"
+Use
+.I dir
+as system directory.
+.TP
+.B \-s
+Compile for system.
+.SH AUTHORS
+ECL was developed by Giuseppe Attardi starting from the Kyoto Common Lisp
+implementation by Taiichi Yuasa and Masami Hagiya.
+.SH FILES
+.ta 2.4i
+init.lsp	default initializations
+.SH SEE ALSO
+Guy L. Steele Jr.
+.br
+.I "Common LISP: The Language"
+.br
+Digital Press, 1984
+.sp
+.SH "BUGS"
+
diff --git a/src/etc/ecl.csh b/src/etc/ecl.csh
new file mode 100755
index 000000000..c78ee7ae6
--- /dev/null
+++ b/src/etc/ecl.csh
@@ -0,0 +1,53 @@
+#!/bin/csh -f
+set dir = DIRECTORY
+set ecl = ecl
+set a = "" a0 = U a1 = 1 a2 = 0 a3 = 0 a4 = 0
+set ifile = "" ofile = ""
+while ($#argv > 0)
+	switch ($1)
+	case -c:
+		set a1 = 0 a2 = 1 a3 = 1 a4 = 1
+		breaksw
+	case -C:
+		set a2 = 1 a3 = 1 a4 = 1
+		breaksw
+	case -o:
+		shift
+		set ofile = $1
+		breaksw
+	case -d:
+		shift
+		set dir = $1
+		breaksw
+	case -l:
+		shift
+		set ecl = $1
+		breaksw
+	case -s:
+		set a0 = S
+		breaksw
+	case -*:
+		echo ${1}: Unknown flag.
+		echo 'Usage: ecl [-d dir] [-l ecl] [ [-c] [-C] [-s]' \
+				'[-o ofile] ifile ]'
+		echo '	-d dir		System directory, defaults to'
+		echo '				'\"$dir\"
+		echo '	-l ecl		Ecl binary, defaults to' \"$ecl\"
+		echo '	-c		Produce C files only'
+		echo '	-C		Produce C files as well'
+		echo '	-s		Compile for system'
+		echo '	-o ofile	Output file name, defaults to ifile'
+		echo '	ifile		File to compile'
+		exit 1
+	case *:
+		set ifile = $1
+		breaksw
+	endsw
+	shift
+end
+if ($ifile != "" && $ofile == "") set ofile = $ifile
+if ($ifile != "") set a = $a0$a1$a2$a3$a4
+if ($ecl !~ */*) set ecl = $dir/$ecl
+exec $ecl -dir $dir/ $ifile $ofile $a
+exit $status
+
diff --git a/src/etc/ecl.sh b/src/etc/ecl.sh
new file mode 100755
index 000000000..4cb055db5
--- /dev/null
+++ b/src/etc/ecl.sh
@@ -0,0 +1,8 @@
+#!/bin/sh
+dir=DIRECTORY
+ecl=$dir/ecl
+if [ ! -x $ecl ] ; then
+  echo Cannot find $ecl
+  exit 1
+fi
+exec $ecl $@
diff --git a/src/etc/ecls.1 b/src/etc/ecls.1
new file mode 100644
index 000000000..69689f652
--- /dev/null
+++ b/src/etc/ecls.1
@@ -0,0 +1,84 @@
+.TH ECL 1 21/09/93
+.UC 4
+.SH NAME
+ecl \- Eco Common LISP
+.SH SYNOPSIS
+\fBecl\fP
+[ [\fB\-c\fP] [\fB\-C\fP] [\fB\-s\fP] [\fB-o\fP \fIofile\fP] \fIifile\fP ]
+.if n .ti +5
+.if t .ti +.5i
+[ \fB\-d\fP \fIdir\fP ]
+[ \fB\-l\fP \fIecl\fP ]
+.SH DESCRIPTION
+.sp
+Eco C\s-3OMMON\s0 L\s-3ISP\s0 (ECL for short) is a full
+implementation of the Common LISP language.
+.PP
+ECL provides the following additional facilities:
+.IP 1.
+MTCL: a multithread facility which allows several threads of execution within
+the same LISP world
+.IP 2.
+CLOS (the Common LISP Object System): an object oriented facility based on the
+notions of classes with multiple inheritance and generic functions
+.PP
+\fBecl\fP without any argument gives you the interactive lisp.
+\fBecl\fP
+.I ifile
+compiles
+.I ifile .
+Filenames ending in
+.B .lsp
+are taken to be
+.SM LISP
+source programs; they are compiled and the binary file is left in the file
+whose name is that of the source with
+.B .o
+substitued for
+.BR .lsp .
+Various flags control the output of the compiler.
+.SH OPTIONS
+.TP 1i
+.B \-c
+compiles the
+.I ifile
+producing only the intermediate C files and no binary file.
+.TP 1i
+.B \-C
+compiles the
+.I ifile
+and produce the intermediate C files as well.
+.TP
+.BI \-o " ofile"
+Name the output file
+.I ofile .
+.I ofile
+must have the suffix \fB.o\fP.
+.TP
+.BI \-l " ecl"
+Use
+.I ecl
+as the executable image.
+.TP
+.BI -d " dir"
+Use
+.I dir
+as system directory.
+.TP
+.B \-s
+Compile for system.
+.SH AUTHORS
+ECL was developed by Giuseppe Attardi starting from the Kyoto Common Lisp
+implementation by Taiichi Yuasa and Masami Hagiya.
+.SH FILES
+.ta 2.4i
+init.lsp	default initializations
+.SH SEE ALSO
+Guy L. Steele Jr.
+.br
+.I "Common LISP: The Language"
+.br
+Digital Press, 1984
+.sp
+.SH "BUGS"
+
diff --git a/src/gabriel/Makefile.in b/src/gabriel/Makefile.in
new file mode 100644
index 000000000..34e273d7f
--- /dev/null
+++ b/src/gabriel/Makefile.in
@@ -0,0 +1,45 @@
+top_srcdir=@top_srcdir@
+srcdir=@srcdir@
+
+FILES =  CMUCLc ECLSc CLISPc CMUCLi ECLSi CLISPi
+LISP ?= ../ecls -eval '(setq si::*system-directory* "../")'
+NAME ?= ECLSc
+COMPILE ?= NIL
+
+BENCHMARK: $(FILES)
+	rm -f BENCHMARK
+	(echo "(load \"$(srcdir)/test-help.lsp\")"; \
+	 echo "(beautify-output \"BENCHMARK\")"; \
+	 cat $(FILES); \
+	 echo "NIL";)\
+	| ../ecls ; cat BENCHMARK
+
+CMUCLi:
+	make test LISP="lisp" NAME=CMUCLi COMPILE="NIL"
+CMUCLc:
+	make test LISP="lisp" NAME=CMUCLc COMPILE="T"
+CLISPi:
+	make test LISP="clisp -a" NAME=CLISPi COMPILE="NIL"
+CLISPc:
+	make test LISP="clisp -a" NAME=CLISPc COMPILE="T"
+ECLSi:
+	make test NAME=ECLSi COMPILE="NIL"
+ECLSc: ../h/ecls.h
+	make test NAME=ECLSc COMPILE="T"
+
+test:
+	(echo "(load \"$(srcdir)/make-declare.lsp\")"; \
+	 echo "(load \"$(srcdir)/test-help.lsp\")"; \
+	 echo "(do-all-tests \"$(NAME)\" \"$(srcdir)/\" \""`pwd`"/\" $(COMPILE))"; \
+	 echo "#+(or cmu ecl) (quit)") | $(LISP)
+
+../h/ecls.h:
+#ifndef HAVE_LOCAL_GMP
+	cp $(top_srcdir)/gmp/gmp.h ../h
+#endif
+	ln -sf $(top_srcdir)/h/*.h ../h
+
+clean:
+	rm -f $(FILES) BENCHMARK
+	rm -f core *.fas *.c *.h a.out *.o *.lbin *.bin *.*fasl *~ *.lib *#
+	rm -f *.x86f
diff --git a/src/gabriel/boyer.cl b/src/gabriel/boyer.cl
new file mode 100644
index 000000000..2c5d44d40
--- /dev/null
+++ b/src/gabriel/boyer.cl
@@ -0,0 +1,542 @@
+;; $Header$
+;; $Locker$
+
+;;; BOYER -- Logic programming benchmark, originally written by Bob Boyer.
+;;; Fairly CONS intensive.
+
+(defvar **unify-subst**)
+(defvar **temp-temp**)
+
+(defun add-lemma (term)
+  (cond ((and (not (atom term))
+	      (eq (car term)
+		  (quote equal))
+	      (not (atom (cadr term))))
+	 (setf (get (car (cadr term)) (quote lemmas))
+	       (cons term (get (car (cadr term)) (quote lemmas)))))
+	(t (error "~%ADD-LEMMA did not like term:  ~a" term))))
+
+(defun add-lemma-lst (lst)
+  (cond ((null lst)
+	 t)
+	(t (add-lemma (car lst))
+	   (add-lemma-lst (cdr lst)))))
+
+(defun apply-subst (alist term)
+  (cond ((atom term)
+	 (cond ((setq **temp-temp** (assoc term alist :test #'eq))
+		(cdr **temp-temp**))
+	       (t term)))
+	(t (cons (car term)
+		 (apply-subst-lst alist (cdr term))))))
+
+(defun apply-subst-lst (alist lst)
+  (cond ((null lst)
+	 nil)
+	(t (cons (apply-subst alist (car lst))
+		 (apply-subst-lst alist (cdr lst))))))
+
+(defun falsep (x lst)
+  (or (equal x (quote (f)))
+      (member x lst)))
+
+(defun one-way-unify (term1 term2)
+  (progn (setq **unify-subst** nil)
+	 (one-way-unify1 term1 term2)))
+
+(defun one-way-unify1 (term1 term2)
+  (cond ((atom term2)
+	 (cond ((setq **temp-temp** (assoc term2 **unify-subst** :test #'eq))
+		(equal term1 (cdr **temp-temp**)))
+	       (t (setq **unify-subst** (cons (cons term2 term1)
+					  **unify-subst**))
+		  t)))
+	((atom term1)
+	 nil)
+	((eq (car term1)
+	     (car term2))
+	 (one-way-unify1-&lst (cdr term1)
+			     (cdr term2)))
+	(t nil)))
+
+(defun one-way-unify1-&lst (lst1 lst2)
+  (cond ((null lst1)
+	 t)
+	((one-way-unify1 (car lst1)
+			 (car lst2))
+	 (one-way-unify1-&lst (cdr lst1)
+			     (cdr lst2)))
+	(t nil)))
+
+(defun rewrite (term)
+  (cond ((atom term)
+	 term)
+	(t (rewrite-with-lemmas (cons (car term)
+				      (rewrite-args (cdr term)))
+				(get (car term)
+				     (quote lemmas))))))
+
+(defun rewrite-args (lst)
+  (cond ((null lst)
+	 nil)
+	(t (cons (rewrite (car lst))
+		 (rewrite-args (cdr lst))))))
+
+(defun rewrite-with-lemmas (term lst)
+  (cond ((null lst)
+	 term)
+	((one-way-unify term (cadr (car lst)))
+	 (rewrite (apply-subst **unify-subst** (caddr (car lst)))))
+	(t (rewrite-with-lemmas term (cdr lst)))))
+
+(defun boyer-setup ()
+  (add-lemma-lst
+    (quote ((equal (compile form)
+		   (reverse (codegen (optimize form)
+				     (nil))))
+	    (equal (eqp x y)
+		   (equal (fix x)
+			  (fix y)))
+	    (equal (greaterp x y)
+		   (lessp y x))
+	    (equal (lesseqp x y)
+		   (not (lessp y x)))
+	    (equal (greatereqp x y)
+		   (not (lessp x y)))
+	    (equal (boolean x)
+		   (or (equal x (t))
+		       (equal x (f))))
+	    (equal (iff x y)
+		   (and (implies x y)
+			(implies y x)))
+	    (equal (even1 x)
+		   (if (zerop x)
+		       (t)
+		       (odd (1- x))))
+	    (equal (countps- l pred)
+		   (countps-loop l pred (zero)))
+	    (equal (fact- i)
+		   (fact-loop i 1))
+	    (equal (reverse- x)
+		   (reverse-loop x (nil)))
+	    (equal (divides x y)
+		   (zerop (remainder y x)))
+	    (equal (assume-true var alist)
+		   (cons (cons var (t))
+			 alist))
+	    (equal (assume-false var alist)
+		   (cons (cons var (f))
+			 alist))
+	    (equal (tautology-checker x)
+		   (tautologyp (normalize x)
+			       (nil)))
+	    (equal (falsify x)
+		   (falsify1 (normalize x)
+			     (nil)))
+	    (equal (prime x)
+		   (and (not (zerop x))
+			(not (equal x (add1 (zero))))
+			(prime1 x (1- x))))
+	    (equal (and p q)
+		   (if p (if q (t)
+			     (f))
+		       (f)))
+	    (equal (or p q)
+		   (if p (t)
+		       (if q (t)
+			   (f))
+		       (f)))
+	    (equal (not p)
+		   (if p (f)
+		       (t)))
+	    (equal (implies p q)
+		   (if p (if q (t)
+			     (f))
+		       (t)))
+	    (equal (fix x)
+		   (if (numberp x)
+		       x
+		       (zero)))
+	    (equal (if (if a b c)
+		       d e)
+		   (if a (if b d e)
+		       (if c d e)))
+	    (equal (zerop x)
+		   (or (equal x (zero))
+		       (not (numberp x))))
+	    (equal (plus (plus x y)
+			 z)
+		   (plus x (plus y z)))
+	    (equal (equal (plus a b)
+			  (zero))
+		   (and (zerop a)
+			(zerop b)))
+	    (equal (difference x x)
+		   (zero))
+	    (equal (equal (plus a b)
+			  (plus a c))
+		   (equal (fix b)
+			  (fix c)))
+	    (equal (equal (zero)
+			  (difference x y))
+		   (not (lessp y x)))
+	    (equal (equal x (difference x y))
+		   (and (numberp x)
+			(or (equal x (zero))
+			    (zerop y))))
+	    (equal (meaning (plus-tree (append x y))
+			    a)
+		   (plus (meaning (plus-tree x)
+				  a)
+			 (meaning (plus-tree y)
+				  a)))
+	    (equal (meaning (plus-tree (plus-fringe x))
+			    a)
+		   (fix (meaning x a)))
+	    (equal (append (append x y)
+			   z)
+		   (append x (append y z)))
+	    (equal (reverse (append a b))
+		   (append (reverse b)
+			   (reverse a)))
+	    (equal (times x (plus y z))
+		   (plus (times x y)
+			 (times x z)))
+	    (equal (times (times x y)
+			  z)
+		   (times x (times y z)))
+	    (equal (equal (times x y)
+			  (zero))
+		   (or (zerop x)
+		       (zerop y)))
+	    (equal (exec (append x y)
+			 pds envrn)
+		   (exec y (exec x pds envrn)
+			 envrn))
+	    (equal (mc-flatten x y)
+		   (append (flatten x)
+			   y))
+	    (equal (member x (append a b))
+		   (or (member x a)
+		       (member x b)))
+	    (equal (member x (reverse y))
+		   (member x y))
+	    (equal (length (reverse x))
+		   (length x))
+	    (equal (member a (intersect b c))
+		   (and (member a b)
+			(member a c)))
+	    (equal (nth (zero)
+			i)
+		   (zero))
+	    (equal (exp i (plus j k))
+		   (times (exp i j)
+			  (exp i k)))
+	    (equal (exp i (times j k))
+		   (exp (exp i j)
+			k))
+	    (equal (reverse-loop x y)
+		   (append (reverse x)
+			   y))
+	    (equal (reverse-loop x (nil))
+		   (reverse x))
+	    (equal (count-list z (sort-lp x y))
+		   (plus (count-list z x)
+			 (count-list z y)))
+	    (equal (equal (append a b)
+			  (append a c))
+		   (equal b c))
+	    (equal (plus (remainder x y)
+			 (times y (quotient x y)))
+		   (fix x))
+	    (equal (power-eval (big-plus1 l i base)
+			       base)
+		   (plus (power-eval l base)
+			 i))
+	    (equal (power-eval (big-plus x y i base)
+			       base)
+		   (plus i (plus (power-eval x base)
+				 (power-eval y base))))
+	    (equal (remainder y 1)
+		   (zero))
+	    (equal (lessp (remainder x y)
+			  y)
+		   (not (zerop y)))
+	    (equal (remainder x x)
+		   (zero))
+	    (equal (lessp (quotient i j)
+			  i)
+		   (and (not (zerop i))
+			(or (zerop j)
+			    (not (equal j 1)))))
+	    (equal (lessp (remainder x y)
+			  x)
+		   (and (not (zerop y))
+			(not (zerop x))
+			(not (lessp x y))))
+	    (equal (power-eval (power-rep i base)
+			       base)
+		   (fix i))
+	    (equal (power-eval (big-plus (power-rep i base)
+					 (power-rep j base)
+					 (zero)
+					 base)
+			       base)
+		   (plus i j))
+	    (equal (gcd x y)
+		   (gcd y x))
+	    (equal (nth (append a b)
+			i)
+		   (append (nth a i)
+			   (nth b (difference i (length a)))))
+	    (equal (difference (plus x y)
+			       x)
+		   (fix y))
+	    (equal (difference (plus y x)
+			       x)
+		   (fix y))
+	    (equal (difference (plus x y)
+			       (plus x z))
+		   (difference y z))
+	    (equal (times x (difference c w))
+		   (difference (times c x)
+			       (times w x)))
+	    (equal (remainder (times x z)
+			      z)
+		   (zero))
+	    (equal (difference (plus b (plus a c))
+			       a)
+		   (plus b c))
+	    (equal (difference (add1 (plus y z))
+			       z)
+		   (add1 y))
+	    (equal (lessp (plus x y)
+			  (plus x z))
+		   (lessp y z))
+	    (equal (lessp (times x z)
+			  (times y z))
+		   (and (not (zerop z))
+			(lessp x y)))
+	    (equal (lessp y (plus x y))
+		   (not (zerop x)))
+	    (equal (gcd (times x z)
+			(times y z))
+		   (times z (gcd x y)))
+	    (equal (value (normalize x)
+			  a)
+		   (value x a))
+	    (equal (equal (flatten x)
+			  (cons y (nil)))
+		   (and (nlistp x)
+			(equal x y)))
+	    (equal (listp (gopher x))
+		   (listp x))
+	    (equal (samefringe x y)
+		   (equal (flatten x)
+			  (flatten y)))
+	    (equal (equal (greatest-factor x y)
+			  (zero))
+		   (and (or (zerop y)
+			    (equal y 1))
+			(equal x (zero))))
+	    (equal (equal (greatest-factor x y)
+			  1)
+		   (equal x 1))
+	    (equal (numberp (greatest-factor x y))
+		   (not (and (or (zerop y)
+				 (equal y 1))
+			     (not (numberp x)))))
+	    (equal (times-list (append x y))
+		   (times (times-list x)
+			  (times-list y)))
+	    (equal (prime-list (append x y))
+		   (and (prime-list x)
+			(prime-list y)))
+	    (equal (equal z (times w z))
+		   (and (numberp z)
+			(or (equal z (zero))
+			    (equal w 1))))
+	    (equal (greatereqpr x y)
+		   (not (lessp x y)))
+	    (equal (equal x (times x y))
+		   (or (equal x (zero))
+		       (and (numberp x)
+			    (equal y 1))))
+	    (equal (remainder (times y x)
+			      y)
+		   (zero))
+	    (equal (equal (times a b)
+			  1)
+		   (and (not (equal a (zero)))
+			(not (equal b (zero)))
+			(numberp a)
+			(numberp b)
+			(equal (1- a)
+			       (zero))
+			(equal (1- b)
+			       (zero))))
+	    (equal (lessp (length (delete x l))
+			  (length l))
+		   (member x l))
+	    (equal (sort2 (delete x l))
+		   (delete x (sort2 l)))
+	    (equal (dsort x)
+		   (sort2 x))
+	    (equal (length (cons x1
+				 (cons x2
+				       (cons x3 (cons x4
+						      (cons x5
+							    (cons x6 x7)))))))
+		   (plus 6 (length x7)))
+	    (equal (difference (add1 (add1 x))
+			       2)
+		   (fix x))
+	    (equal (quotient (plus x (plus x y))
+			     2)
+		   (plus x (quotient y 2)))
+	    (equal (sigma (zero)
+			  i)
+		   (quotient (times i (add1 i))
+			     2))
+	    (equal (plus x (add1 y))
+		   (if (numberp y)
+		       (add1 (plus x y))
+		       (add1 x)))
+	    (equal (equal (difference x y)
+			  (difference z y))
+		   (if (lessp x y)
+		       (not (lessp y z))
+		       (if (lessp z y)
+			   (not (lessp y x))
+			   (equal (fix x)
+				  (fix z)))))
+	    (equal (meaning (plus-tree (delete x y))
+			    a)
+		   (if (member x y)
+		       (difference (meaning (plus-tree y)
+					    a)
+				   (meaning x a))
+		       (meaning (plus-tree y)
+				a)))
+	    (equal (times x (add1 y))
+		   (if (numberp y)
+		       (plus x (times x y))
+		       (fix x)))
+	    (equal (nth (nil)
+			i)
+		   (if (zerop i)
+		       (nil)
+		       (zero)))
+	    (equal (last (append a b))
+		   (if (listp b)
+		       (last b)
+		       (if (listp a)
+			   (cons (car (last a))
+				 b)
+			   b)))
+	    (equal (equal (lessp x y)
+			  z)
+		   (if (lessp x y)
+		       (equal t z)
+		       (equal f z)))
+	    (equal (assignment x (append a b))
+		   (if (assignedp x a)
+		       (assignment x a)
+		       (assignment x b)))
+	    (equal (car (gopher x))
+		   (if (listp x)
+		       (car (flatten x))
+		       (zero)))
+	    (equal (flatten (cdr (gopher x)))
+		   (if (listp x)
+		       (cdr (flatten x))
+		       (cons (zero)
+			     (nil))))
+	    (equal (quotient (times y x)
+			     y)
+		   (if (zerop y)
+		       (zero)
+		       (fix x)))
+	    (equal (get j (set i val mem))
+		   (if (eqp j i)
+		       val
+		       (get j mem)))))))
+
+(defun tautologyp (x true-lst false-lst)
+  (cond ((truep x true-lst)
+	 t)
+	((falsep x false-lst)
+	 nil)
+	((atom x)
+	 nil)
+	((eq (car x)
+	     (quote if))
+	 (cond ((truep (cadr x)
+		       true-lst)
+		(tautologyp (caddr x)
+			    true-lst false-lst))
+	       ((falsep (cadr x)
+			false-lst)
+		(tautologyp (cadddr x)
+			    true-lst false-lst))
+	       (t (and (tautologyp (caddr x)
+				   (cons (cadr x)
+					 true-lst)
+				   false-lst)
+		       (tautologyp (cadddr x)
+				   true-lst
+				   (cons (cadr x)
+					 false-lst))))))
+	(t nil)))
+
+(defun tautp (x)
+  (tautologyp (rewrite x)
+	      nil nil))
+
+(defun boyer-test ()
+  (prog (ans term)
+	(setq term
+	      (apply-subst
+		(quote ((x f (plus (plus a b)
+				   (plus c (zero))))
+			(y f (times (times a b)
+				    (plus c d)))
+			(z f (reverse (append (append a b)
+					      (nil))))
+			(u equal (plus a b)
+			   (difference x y))
+			(w lessp (remainder a b)
+			   (member a (length b)))))
+		(quote (implies (and (implies x y)
+				     (and (implies y z)
+					  (and (implies z u)
+					       (implies u w))))
+				(implies x w)))))
+	(setq ans (tautp term))))
+
+#|
+(defun trans-of-implies (n)
+  (list (quote implies)
+	(trans-of-implies1 n)
+	(list (quote implies)
+	      0 n)))
+
+(defun trans-of-implies1 (n)
+  (cond ((eql n 1)
+	 (list (quote implies)
+	       0 1))
+	(t (list (quote and)
+		 (list (quote implies)
+		       (1- n)
+		       n)
+		 (trans-of-implies1 (1- n))))))
+|#
+
+(defun truep (x lst)
+       (or (equal x (quote (t)))
+	   (member x lst)))
+
+(defvar setup-performed-p (prog1 t (boyer-setup)))
+
+(defun testboyer ()
+  (boyer-test))
diff --git a/src/gabriel/browse.cl b/src/gabriel/browse.cl
new file mode 100644
index 000000000..b715cdc85
--- /dev/null
+++ b/src/gabriel/browse.cl
@@ -0,0 +1,140 @@
+;; $Header$
+;; $Locker$
+
+;;; BROWSE -- Benchmark to create and browse through an AI-like data base
+;;; of units.
+
+;;; n is # of symbols
+;;; m is maximum amount of stuff on the plist
+;;; npats is the number of basic patterns on the unit
+;;; ipats is the instantiated copies of the patterns
+
+(eval-when (eval compile)
+  (defvar *browse-rand* 21)
+  (proclaim '(type fixnum *browse-rand*))
+  (defconstant *browse-star* (code-char 42))
+  (defconstant *browse-questionmark* (code-char 63)))
+
+(eval-when (eval compile)
+  ;; maybe SYMBOL-NAME
+  (defmacro browse-char1 (x) `(schar (symbol-name ,x) 0)))
+
+
+(defun browse-init (n m npats ipats)
+  (declare (type fixnum n m npats))
+  (setq *browse-rand* 21)
+  (let ((ipats (copy-tree ipats)))
+    (do ((p ipats (cdr p)))
+	((null (cdr p)) (rplacd p ipats)))	
+    (do ((n n (the fixnum (1- n)))
+	 (i m (cond ((= i 0) m)
+		    (t (the fixnum (1- i)))))
+	 (name (gentemp) (gentemp))
+	 (a ()))
+	((= n 0) a)
+      (declare (type fixnum n i)) 
+      (push name a)
+      (do ((i i (the fixnum (1- i))))
+	  ((= i 0))
+	(declare (type fixnum i))
+	(setf (get name (gensym)) nil))
+      (setf (get name 'pattern)
+	    (do ((i npats (the fixnum (1- i)))
+		 (ipats ipats (cdr ipats))
+		 (a ()))
+		((= i 0) a)
+	      (declare (type fixnum i))
+	      (push (car ipats) a)))
+      (do ((j (the fixnum (- m i)) (the fixnum (1- j))))
+	  ((= j 0))
+	(declare (type fixnum j))
+	(setf (get name (gensym)) nil)))))  
+
+
+(defun browse-random ()
+  (setq *browse-rand* (rem (the fixnum (* *browse-rand* 17)) 251)))
+
+(defun browse-randomize (l)
+  (do ((a ()))
+      ((null l) a)
+    (let ((n (rem (the fixnum (browse-random)) (the fixnum (length l)))))
+      (declare (type fixnum n))
+      (cond ((= n 0)
+	     (push (car l) a)
+	     (setq l (cdr l)))
+	    (t 
+	     (do ((n n (the fixnum (1- n)))
+		  (x l (cdr x)))
+		 ((= n 1)
+		  (push (cadr x) a)
+		  (rplacd x (cddr x)))
+	       (declare (type fixnum n))))))))
+
+(defun match (pat dat alist)
+  (cond ((null pat)
+	 (null dat))
+	((null dat) ())
+	((or (eq (car pat) '?)
+	     (eq (car pat)
+		 (car dat)))
+	 (match (cdr pat) (cdr dat) alist))
+	((eq (car pat) '*)
+	 (or (match (cdr pat) dat alist)
+	     (match (cdr pat) (cdr dat) alist)
+	     (match pat (cdr dat) alist)))
+	(t (cond ((atom (car pat))
+			;;replace eq by 'eql for char	
+		  (cond ((eql (browse-char1 (car pat))
+			     *browse-questionmark*)
+			 (let ((val (assoc (car pat) alist)))
+			   (cond (val (match (cons (cdr val)
+						   (cdr pat))
+					     dat alist))
+				 (t (match (cdr pat)
+					   (cdr dat)
+					   (cons (cons (car pat)
+						       (car dat))
+						 alist))))))
+			((eql (browse-char1 (car pat)) *browse-star*)
+			 (let ((val (assoc (car pat) alist)))
+			   (cond (val (match (append (cdr val)
+						     (cdr pat))
+					     dat alist))
+				 (t 
+				  (do ((l () (nconc l (cons (car d) nil)))
+				       (e (cons () dat) (cdr e))
+				       (d dat (cdr d)))
+				      ((null e) ())
+				    (cond ((match (cdr pat) d
+						  (cons (cons (car pat) l)
+							alist))
+					   (return t))))))))))
+		 (t (and 
+		      (not (atom (car dat)))
+		      (match (car pat)
+			     (car dat) alist)
+		      (match (cdr pat)
+			     (cdr dat) alist)))))))
+
+(defun browse ()
+  (investigate (browse-randomize 
+		 (browse-init 100 10 4 '((a a a b b b b a a a a a b b a a a)
+					 (a a b b b b a a
+					  (a a)(b b))
+					 (a a a b (b a) b a b a))))
+	       '((*a ?b *b ?b a *a a *b *a)
+		 (*a *b *b *a (*a) (*b))
+		 (? ? * (b a) * ? ?))))
+
+(defun investigate (units pats)
+  (do ((units units (cdr units)))
+      ((null units))
+    (do ((pats pats (cdr pats)))
+	((null pats))
+      (do ((p (get (car units) 'pattern)
+	      (cdr p)))
+	  ((null p))
+	(match (car pats) (car p) ())))))
+
+(defun testbrowse ()
+  (browse))
diff --git a/src/gabriel/cc-chart b/src/gabriel/cc-chart
new file mode 100644
index 000000000..ff7123f5a
--- /dev/null
+++ b/src/gabriel/cc-chart
@@ -0,0 +1,24 @@
+              gcc      cc,5       cc,4
+BOYER       12.533    12.350     12.250  
+BROWSE      24.517    25.083     25.067  
+CTAK        6.517     7.100      7.133   
+DDERIV      6.050     6.550      6.533   
+DERIV       4.950     5.017      5.033   
+DESTRU      2.900     3.300      3.283   
+DIV2        5.533     5.600      5.583   
+FFT-MOD     7.917     21.583     21.533  
+FFT         59.150    65.117     64.700  
+FPRINT      1.800     1.850      1.767   
+FREAD       3.033     2.533      2.483   
+FRPOLY      86.567    86.800     86.483  
+PUZZLE-MOD  7.200     7.633      7.617   
+PUZZLE      8.317     8.800      8.667   
+STAK        3.733     4.217      4.200   
+TAK-MOD     5.367     3.650      4.350   
+TAK         6.483     5.467      5.967   
+TAKL        2.617     3.167      3.117   
+TAKR        1.000     0.883      1.033   
+TPRINT      3.167     3.150      3.183   
+TRAVERSE    38.933    39.533     39.217  
+TRIANG-MOD  118.033   131.700    130.767 
+TRIANG      149.267   152.517    151.400 
diff --git a/src/gabriel/chart b/src/gabriel/chart
new file mode 100644
index 000000000..ded7517c7
--- /dev/null
+++ b/src/gabriel/chart
@@ -0,0 +1,62 @@
+
+AKCL version  1.20
+LUCID version 2.1.1
+KCL is the Jun 87 version unmodified.
+
+Gabriel benchmarks run on a Sun 3-160 by Bill Schelter.
+Colu
+
+   Thu Apr  7 10:47:59 CDT 1988
+
+HARDWARE:    Sun280     Sun280   Sun3-160   Sun3-160   Sun3-160
+SOFTWARE:             AKCL       LUCID     AKCL     LUCID       KCL
+
+BOYER         6.667   6.533      9.200    12.200     15.160     15.950   
+BROWSE        12.900  13.433     18.500   24.183     29.560     41.283 
+CTAK          3.500   3.000      1.140    6.583      2.160      7.050  
+DDERIV        3.317   3.317      5.420    6.033      9.260      8.417  
+DERIV         2.633   2.700      5.240    4.850      8.200      6.450  
+DESTRU-MOD    1.000              1.090
+DESTRU        1.350   1.667      1.080    2.883      1.720      3.717  
+DIV2          3.117   3.100      4.380    5.433      6.660      5.667  
+FFT-MOD       5.350   5.317      38.360   7.700      51.880     29.467 
+FFT           32.150  32.317     34.760   58.450     51.840     (error)   
+FPRINT        0.667   1.033      0.800    1.817      1.460      2.417  
+FREAD         1.212   1.333      1.670    2.500      3.220      2.783
+FRPOLY        46.883  46.033     30.040   85.450     45.200     90.167 
+PUZZLE-MOD    4.383   4.350      4.380    7.117      6.960      10.183 
+PUZZLE        4.833   4.900      3.180    8.200      5.140      11.183 
+STAK          1.813   1.817      1.380    3.717      2.620      4.350  
+TAK-MOD       2.900   2.900      2.800    5.150      4.680      3.600
+TAK           3.833   3.750      2.760    6.467      4.900      5.767
+TAKL          1.350   1.583      1.680    2.600      2.640      3.017  
+TAKR          0.521   0.533      0.460    0.933      0.840      1.483  
+TPRINT        1.046   1.650      2.100    3.117      3.680      4.233  
+TRAVERSE      25.667  25.833     27.940   38.917     40.060     71.133 
+TRIANG-MOD    63.500  62.217     255.460  112.750    453.460    160.783
+TRIANG        78.017  77.450     76.760   147.567    141.62     220.917                      
+
+
+   Additional notes: All files were proclaimed using the proclaim-file
+facility in make-declare.lsp.  The XX-MOD tests, differ from the
+original XX tests only in the matter of additional proclamations and
+perhaps changing an array type.  This sometimes hurt lucid, mainly
+because the original declarations were optimal for lucid.  (Also in
+several places we changed an eq of integers or characters to an eql,
+to conform with correct Common Lisp, and ensure that the test would
+actually run as intended.)  In AKCL three of the four float types map
+to 64 bit floats, with only short-float being a 32 bit float.  On
+lucid all four appear to be 32 bit (judging from the fact that 1.0e38
+is the largest float in each case).  Thus KCL and AKCL are using 64
+bit floats in the fft examples, while lucid appears to be using 32 bit
+floats.  We did not know what switches to use to speed lucid floating
+arithmetic.
+
+
+   To run the tests in a lisp called foo (eg akcl, lucid,..)
+% cd gabriel
+% make -e "LISP=foo"  >> #errs &
+The times will be recorded in a file called times.  All files
+will be proclaimed, and compiled automatically.
+
+
diff --git a/src/gabriel/control.cl b/src/gabriel/control.cl
new file mode 100644
index 000000000..ef4c311aa
--- /dev/null
+++ b/src/gabriel/control.cl
@@ -0,0 +1,146 @@
+;; $Header$
+;;
+;; benchmark control
+
+(setf (comp:target-fpp) :m68881)
+(setq comp::*target-architecture* :mc68020)
+(setf (sys:gsgc-parameter :generation-spread) 4)
+
+(require :foreign)
+(use-package :ff)
+(load "time.o")
+
+(defforeign 'get_time
+    :entry-point (convert-to-lang "get_time" :language :c)
+    :arguments '(t))
+
+(import '(lisp::time-utime-sec lisp::time-utime-usec lisp::time-stime-sec
+	  lisp::time-stime-usec lisp::time-stime-minflt
+	  lisp::time-stime-majflt lisp::time-stime-maxrss
+	  lisp::time-real-sec lisp::time-real-usec))
+
+(defcstruct time
+  (utime-sec :unsigned-long)
+  (utime-usec :unsigned-long)
+  (stime-sec :unsigned-long)
+  (stime-usec :unsigned-long)
+  (stime-minflt :unsigned-long)
+  (stime-majflt :unsigned-long)
+  (stime-maxrss :unsigned-long)
+  (real-sec :unsigned-long)
+  (real-usec :unsigned-long))
+
+(defmacro bm-time-macro (form)
+  `(let ((start (make-time)) (end (make-time)))
+    (get_time start)
+    (multiple-value-prog1 ,form
+      (get_time end)
+      (print-time start end))))
+
+(defun print-time (start end)
+  (let* ((u1 (truncate (+ (* 1000000 (time-utime-sec start))
+			  (time-utime-usec start))
+		       1000))
+	 (s1 (truncate (+ (* 1000000 (time-stime-sec start))
+			  (time-stime-usec start))
+		       1000))
+	 (u2 (truncate (+ (* 1000000 (time-utime-sec end))
+			  (time-utime-usec end))
+		       1000))
+	 (s2 (truncate (+ (* 1000000 (time-stime-sec end))
+			  (time-stime-usec end))
+		       1000))
+	 (r1 (truncate (+ (* 1000000 (time-real-sec start))
+			  (time-real-usec start))
+		       1000))
+	 (r2 (truncate (+ (* 1000000 (time-real-sec end))
+			  (time-real-usec end))
+		       1000))
+	 (page-faults (- (+ (time-stime-majflt end)
+			    (time-stime-minflt end))
+			 (+ (time-stime-minflt start)
+			    (time-stime-majflt start))))
+	 (real (- r2 r1))
+	 (user (- u2 u1))
+	 (system (- s2 s1)))
+    (format *trace-output*
+      "
+ (~10:<~d~> ;; non-gc user
+  ~10:<~d~> ;; non-gc system
+  ~10:<~d~> ;; gc user
+  ~10:<~d~> ;; gc system
+  ~10:<~d~> ;; total user
+  ~10:<~d~> ;; total gc
+  ~10:<~d~> ;; real
+  ~10:<~d~> ;; max rss size (pages)
+  ~10:<~d~> ;; page faults
+  )"
+      user system 0 0 user 0 real
+      (time-stime-maxrss end) page-faults)))
+
+(defparameter *benches*
+  '(boyer
+    browse
+    ctak
+    dderiv
+    deriv
+    destru
+    (div2 div2-iter div2-recur)
+    fft
+    fprint
+    fread
+    (frpoly frpoly-1 frpoly-2 frpoly-3 frpoly-4)
+    puzzle
+    stak
+    tak
+    takl
+    takr
+    tprint
+    (traverse traverse-init traverse-run)
+    triang))
+
+(defun compile-all-bms (&optional (result-file "results.compile"))
+  (let ((old-time (macro-function 'time)))
+    (setf (macro-function 'time) (macro-function 'bm-time-macro))
+    (let ((*trace-output*
+	   (open result-file :direction :output :if-exists :supersede)))
+      (format *trace-output* "(:benchmark-compilation~%")
+      (gc :tenure)
+      (bm-time-macro
+	(dolist (bench *benches*)
+	  (if (consp bench) (setq bench (car bench)))
+	  (setq bench (string-downcase (string bench)))
+	  (compile-file (merge-pathnames (make-pathname :type "cl") bench))))
+      (format *trace-output* ")~%")
+      (close *trace-output*))
+    (setf (macro-function 'time) old-time)
+    nil))
+
+(defun run-all-bms (&optional (result-file "results.run"))
+  (let ((*trace-output*
+	 (open result-file :direction :output :if-exists :append)))
+    (dolist (bench *benches*)
+      (run-bench bench))
+    (close *trace-output*)))
+
+(defun run-bench (bench &aux name function)
+  (cond
+    ((consp bench)
+     ;; the form of bench is
+     ;;  (file name1 name2 ...)
+     (load (string-downcase (symbol-name (car bench))))
+     (dolist (name (cdr bench))
+       (run-bench-1 name (find-symbol (format nil "~a~a" 'test name)))))
+    (t (load (string-downcase (symbol-name bench)))
+       (run-bench-1 bench (find-symbol (format nil "~a~a" 'test bench))))))
+
+(defun run-bench-1 (bench function)
+  (format *trace-output* "~%(:~a~%" bench)
+  (dotimes (n 3)
+    (gc :tenure)
+    (funcall function))
+  (format *trace-output* ")~%")
+  (force-output *trace-output*))
+
+(defun run-benches (&rest bench-list)
+  (mapc #'(lambda (bench) (apply #'run-bench bench)) bench-list))
diff --git a/src/gabriel/ctak.cl b/src/gabriel/ctak.cl
new file mode 100644
index 000000000..ebba2370a
--- /dev/null
+++ b/src/gabriel/ctak.cl
@@ -0,0 +1,28 @@
+;; $Header$
+;; $Locker$
+
+;;; CTAK -- A version of the TAKeuchi function that uses the CATCH/THROW facility. 
+
+(defun ctak (x y z)
+  (catch 'ctak (ctak-aux x y z)))
+
+(defun ctak-aux (x y z)
+  (declare (fixnum x y z))
+  (cond ((not (< y x))
+	 (throw 'ctak z))
+	(t (ctak-aux
+	     (catch 'ctak
+	       (ctak-aux (the fixnum (1- x))
+			 y
+			 z))
+	     (catch 'ctak
+	       (ctak-aux (the fixnum (1- y))
+			 z
+			 x))
+	     (catch 'ctak
+	       (ctak-aux (the fixnum (1- z))
+			 x
+			 y))))))
+
+(defun testctak ()
+  (ctak 18 12 6))
diff --git a/src/gabriel/dderiv.cl b/src/gabriel/dderiv.cl
new file mode 100644
index 000000000..275545cd5
--- /dev/null
+++ b/src/gabriel/dderiv.cl
@@ -0,0 +1,69 @@
+;; $Header$
+;; $Locker$
+
+;;; DDERIV -- Symbolic derivative benchmark written by Vaughn Pratt.  
+
+;;; This benchmark is a variant of the simple symbolic derivative program 
+;;; (DERIV). The main change is that it is `table-driven.'  Instead of using a
+;;; large COND that branches on the CAR of the expression, this program finds
+;;; the code that will take the derivative on the property list of the atom in
+;;; the CAR position. So, when the expression is (+ . <rest>), the code
+;;; stored under the atom '+ with indicator DERIV will take <rest> and
+;;; return the derivative for '+. The way that MacLisp does this is with the
+;;; special form: (DEFUN (FOO BAR) ...). This is exactly like DEFUN with an
+;;; atomic name in that it expects an argument list and the compiler compiles
+;;; code, but the name of the function with that code is stored on the
+;;; property list of FOO under the indicator BAR, in this case. You may have
+;;; to do something like:
+
+;;; :property keyword is not Common Lisp.
+
+(defun dderiv-aux (a) 
+  (list '// (dderiv a) a))
+
+(defun +dderiv (a)
+  (cons '+ (mapcar 'dderiv a)))
+
+(defun -dderiv (a)
+  (cons '- (mapcar 'dderiv a)))
+
+(defun *dderiv (a)
+  (list '* (cons '* a)
+	(cons '+ (mapcar 'dderiv-aux a))))
+
+(defun //dderiv (a)
+  (list '- 
+	(list '// 
+	      (dderiv (car a)) 
+	      (cadr a))
+	(list '// 
+	      (car a) 
+	      (list '*
+		    (cadr a)
+		    (cadr a)
+		    (dderiv (cadr a))))))
+
+(mapc #'(lambda (op fun) (setf (get op 'dderiv) (symbol-function fun)))
+      '(+ - * //)
+      '(+dderiv -dderiv *dderiv //dderiv))
+
+(defun dderiv (a)
+  (cond 
+    ((atom a)
+     (cond ((eq a 'x) 1) (t 0)))
+    (t (let ((dderiv (get (car a) 'dderiv)))
+	 (cond (dderiv (funcall dderiv (cdr a)))
+	       (t 'error))))))
+
+(defun dderiv-run ()
+  (do ((i 0 (the fixnum (1+ i))))
+      ((= (the fixnum i) 1000.))
+    (declare (type fixnum i))
+    (dderiv '(+ (* 3 x x) (* a x x) (* b x) 5))
+    (dderiv '(+ (* 3 x x) (* a x x) (* b x) 5))
+    (dderiv '(+ (* 3 x x) (* a x x) (* b x) 5))
+    (dderiv '(+ (* 3 x x) (* a x x) (* b x) 5))
+    (dderiv '(+ (* 3 x x) (* a x x) (* b x) 5))))
+
+(defun testdderiv ()
+  (dderiv-run))
diff --git a/src/gabriel/deriv.cl b/src/gabriel/deriv.cl
new file mode 100644
index 000000000..e8755644f
--- /dev/null
+++ b/src/gabriel/deriv.cl
@@ -0,0 +1,45 @@
+;; $Header$
+;; $Locker$
+
+;;; DERIV -- Symbolic derivative benchmark written by Vaughn Pratt.  
+;;; It uses a simple subset of Lisp and does a lot of  CONSing. 
+
+(defun deriv-aux (a) (list '/ (deriv a) a))
+
+(defun deriv (a)
+  (cond 
+    ((atom a)
+     (cond ((eq a 'x) 1) (t 0)))
+    ((eq (car a) '+)	
+     (cons '+ (mapcar #'deriv (cdr a))))
+    ((eq (car a) '-) 
+     (cons '- (mapcar #'deriv (cdr a))))
+    ((eq (car a) '*)
+     (list '* 
+	   a 
+	   (cons '+ (mapcar #'deriv-aux (cdr a)))))
+    ((eq (car a) '/)
+     (list '- 
+	   (list '/ 
+		 (deriv (cadr a)) 
+		 (caddr a))
+	   (list '/ 
+		 (cadr a) 
+		 (list '*
+		       (caddr a)
+		       (caddr a)
+		       (deriv (caddr a))))))
+    (t 'error)))
+
+(defun deriv-run ()
+  (do ((i 0 (the fixnum (1+ i))))
+      ((= (the fixnum i) 1000.))	;runs it 5000 times
+    (declare (type fixnum i))		;improves the code a little
+    (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))
+    (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))
+    (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))
+    (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))
+    (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))))
+
+(defun testderiv ()
+  (deriv-run))
diff --git a/src/gabriel/destru-mod.cl b/src/gabriel/destru-mod.cl
new file mode 100644
index 000000000..810c04a58
--- /dev/null
+++ b/src/gabriel/destru-mod.cl
@@ -0,0 +1,53 @@
+;; $Header$
+;; $Locker$
+
+;; DESTRU -- Destructive operation benchmark
+
+;;mod: add fixnum declaration for n in the following let:
+;;    (let ((n (floor (the fixnum (length (car l1))) 2)))
+
+			
+(defun destructive (n m)
+  (declare (type fixnum n m))
+  (let ((l (do ((i 10. (the fixnum (1- i)))
+		(a () (push () a)))
+	       ((= (the fixnum i) 0) a)
+	     (declare (type fixnum i)))))
+    (do ((i n (the fixnum (1- i))))
+	((= (the fixnum i) 0))
+      (declare (type fixnum i))
+      (cond ((null (car l))
+	     (do ((l l (cdr l)))
+		 ((null l))
+	       (or (car l) 
+		   (rplaca l (cons () ())))
+	       (nconc (car l)
+		      (do ((j m (the fixnum (1- j)))
+			   (a () (push () a)))
+			  ((= (the fixnum j) 0) a)
+			(declare (type fixnum j))))))
+	    (t
+	     (do ((l1 l (cdr l1))
+		  (l2 (cdr l) (cdr l2)))
+		 ((null l2))
+	       (rplacd (do ((j (floor (the fixnum (length (car l2))) 2) 
+			       (the fixnum (1- j)))
+			    (a (car l2) (cdr a)))
+			   ((zerop (the fixnum j)) a)
+			 (declare (type fixnum j))
+			 (rplaca a i))
+		       (let ((n (floor (the fixnum (length (car l1))) 2)))
+			 (declare (fixnum n))
+			 (cond ((= (the fixnum n) 0) (rplaca l1 ())
+				(car l1))
+			       (t 
+				(do ((j n (the fixnum (1- j)))
+				     (a (car l1) (cdr a)))
+				    ((= (the fixnum j) 1)
+				     (prog1 (cdr a)
+				       (rplacd a ())))
+				  (declare (type fixnum j))
+				  (rplaca a i))))))))))))
+
+(defun testdestru ()
+  (destructive 600 50))
diff --git a/src/gabriel/destru.cl b/src/gabriel/destru.cl
new file mode 100644
index 000000000..84b6c51ce
--- /dev/null
+++ b/src/gabriel/destru.cl
@@ -0,0 +1,48 @@
+;; $Header$
+;; $Locker$
+
+;; DESTRU -- Destructive operation benchmark
+			
+(defun destructive (n m)
+  (declare (type fixnum n m))
+  (let ((l (do ((i 10. (the fixnum (1- i)))
+		(a () (push () a)))
+	       ((= (the fixnum i) 0) a)
+	     (declare (type fixnum i)))))
+    (do ((i n (the fixnum (1- i))))
+	((= (the fixnum i) 0))
+      (declare (type fixnum i))
+      (cond ((null (car l))
+	     (do ((l l (cdr l)))
+		 ((null l))
+	       (or (car l) 
+		   (rplaca l (cons () ())))
+	       (nconc (car l)
+		      (do ((j m (the fixnum (1- j)))
+			   (a () (push () a)))
+			  ((= (the fixnum j) 0) a)
+			(declare (type fixnum j))))))
+	    (t
+	     (do ((l1 l (cdr l1))
+		  (l2 (cdr l) (cdr l2)))
+		 ((null l2))
+	       (rplacd (do ((j (floor (the fixnum (length (car l2))) 2) 
+			       (the fixnum (1- j)))
+			    (a (car l2) (cdr a)))
+			   ((zerop (the fixnum j)) a)
+			 (declare (type fixnum j))
+			 (rplaca a i))
+		       (let ((n (floor (the fixnum (length (car l1))) 2)))
+			 (cond ((= (the fixnum n) 0) (rplaca l1 ())
+				(car l1))
+			       (t 
+				(do ((j n (the fixnum (1- j)))
+				     (a (car l1) (cdr a)))
+				    ((= (the fixnum j) 1)
+				     (prog1 (cdr a)
+				       (rplacd a ())))
+				  (declare (type fixnum j))
+				  (rplaca a i))))))))))))
+
+(defun testdestru ()
+  (destructive 600 50))
diff --git a/src/gabriel/div2.cl b/src/gabriel/div2.cl
new file mode 100644
index 000000000..4ac84ca71
--- /dev/null
+++ b/src/gabriel/div2.cl
@@ -0,0 +1,52 @@
+;; $Header$
+;; $Locker$
+
+;;; DIV2 -- Benchmark which divides by 2 using lists of n ()'s.
+;;; This file contains a recursive as well as an iterative test.
+
+(defun create-n (n)
+  (declare (type fixnum n))
+  (do ((n n (the fixnum (1- n)))
+       (a () (push () a)))
+      ((= (the fixnum n) 0) a)
+    (declare (type fixnum n))))
+
+(defvar ll (create-n 200.))
+
+
+(defun iterative-div2 (l)
+  (do ((l l (cddr l))
+       (a () (push (car l) a)))
+      ((null l) a)))
+
+(defun recursive-div2 (l)
+  (cond ((null l) ())
+	(t (cons (car l) (recursive-div2 (cddr l))))))
+
+(defun test-1 (l)
+  (do ((i 300 (the fixnum (1- i))))
+      ((= (the fixnum i) 0))
+    (declare (type fixnum i))
+    (iterative-div2 l)
+    (iterative-div2 l)
+    (iterative-div2 l)
+    (iterative-div2 l)))
+
+(defun test-2 (l)
+  (do ((i 300 (the fixnum (1- i))))
+      ((= (the fixnum i) 0))
+    (declare (type fixnum i))
+    (recursive-div2 l)
+    (recursive-div2 l)
+    (recursive-div2 l)
+    (recursive-div2 l)))
+
+(defun testdiv2 ()
+  (testdiv2-iter)
+  (testdiv2-recur))
+
+(defun testdiv2-iter ()
+  (test-1 ll))
+
+(defun testdiv2-recur ()
+  (test-2 ll))
diff --git a/src/gabriel/fft-mod.cl b/src/gabriel/fft-mod.cl
new file mode 100644
index 000000000..c0b0b7327
--- /dev/null
+++ b/src/gabriel/fft-mod.cl
@@ -0,0 +1,144 @@
+;; $Header$
+;; $Locker$
+
+;; FFT -- This is an FFT benchmark written by Harry Barrow.
+;; It tests a variety of floating point operations, including array references.
+
+(defvar **fft-re**
+  (make-array 1025. :element-type
+	      #+excl 'single-float #+lucid 'float #+KCL 'single-float
+	      #+ecl 'single-float #+clisp 'single-float #+cmu 'single-float
+	      :initial-element 0.0))
+
+(defvar **fft-im**
+  (make-array 1025. :element-type
+	      #+excl 'single-float #+lucid 'single-float #+KCL 'single-float
+	      #+ecl 'single-float #+clisp 'single-float #+cmu 'single-float
+	      :initial-element 0.0))
+
+(defmacro ff+ (a b) 
+ `(the single-float (+ (the single-float ,a) (the single-float ,b))))
+
+(defmacro ff*(a b) 
+ `(the single-float (* (the single-float ,a) (the single-float ,b))))
+(defmacro ff-(a b) 
+ `(the single-float (- (the single-float ,a) (the single-float ,b))))
+
+
+(proclaim '(type (#+KCL vector #-KCL simple-array
+		  #+excl single-float #+lucid single-float #+KCL single-float
+		  #+ecl single-float
+		  #-KCL (*)) **fft-re** **fft-im**))
+
+(defvar s-pi (float pi 0.0))
+(proclaim '(#+excl single-float #+KCL single-float #+lucid single-float #+ecl single-float s-pi))
+
+(defun fft (areal aimag)
+  (declare (type (simple-array single-float (*)) areal aimag))
+  (prog* ((ar areal)
+	  (ai aimag)
+	  (i 1)
+	  (j 0)
+	  (k 0)
+	  (m 0) 			;compute m = log(n)
+	  (n (1- (array-dimension ar 0)))
+	  (nv2 (floor n 2))
+	  (le 0) (le1 0) (ip 0)
+	  (ur 0.0) (ui 0.0) (wr 0.0) (wi 0.0) (tr 0.0) (ti 0.0))
+     (declare (type fixnum i j k n nv2 m le le1 ip))
+     (declare (type (simple-array single-float (*)) ar ai))
+     (declare (single-float ur ui wr wi tr ti))
+     l1 (cond ((< i n)
+	       (setq m (the fixnum (1+ m))
+		     i (the fixnum (+ i i)))
+	       (go l1)))
+     (cond ((not (equal n (the fixnum (expt 2 m))))
+	    (princ "error ... array size not a power of two.")
+	    (read)
+	    (return (terpri))))
+     (setq j 1 				;interchange elements
+	   i 1) 			;in bit-reversed order
+     l3 (cond ((< i j)
+	       (setq tr (aref ar j)
+		     ti (aref ai j))
+	       (setf (aref ar j) (aref ar i))
+	       (setf (aref ai j) (aref ai i))
+	       (setf (aref ar i) tr)
+	       (setf (aref ai i) ti)))
+     (setq k nv2)
+     l6 (cond ((< k j)
+	       (setq j (the fixnum (- j k))
+		     k (the fixnum (/ k 2)))
+	       (go l6)))
+     (setq j (the fixnum (+ j k))
+	   i (the fixnum (1+ i)))
+     (cond ((< i n)
+	    (go l3)))
+     (do ((l 1 (the fixnum (1+ (the fixnum l)))))
+	 ((> (the fixnum l) m)) 	;loop thru stages
+       (declare (type fixnum l))
+       (setq le (the fixnum (expt 2 l))
+	     le1 (the (values fixnum fixnum) (floor le 2))
+	     ur 1.0
+	     ui 0.0
+	     wr (cos (/ s-pi (float le1)))
+	     wi (sin (/ s-pi (float le1))))
+       (do ((j 1 (the fixnum (1+ (the fixnum j)))))
+	   ((> (the fixnum j) le1)) 	;loop thru butterflies
+	 (declare (type fixnum j))
+	 (do ((i j (+ (the fixnum i) le)))
+	     ((> (the fixnum i) n)) 	;do a butterfly
+	   (declare (type fixnum i))
+	   (setq ip (the fixnum (+ i le1))
+		 tr (ff- (ff* (aref ar ip) ur)
+		       (ff* (aref ai ip) ui))
+		 ti (ff+ (ff* (aref ar ip) ui)
+		       (ff* (aref ai ip) ur)))
+	   (setf (aref ar ip) (ff- (aref ar i) tr))
+	   (setf (aref ai ip) (ff- (aref ai i) ti))
+	   (setf (aref ar i) (ff+ (aref ar i) tr))
+	   (setf (aref ai i) (ff+ (aref ai i) ti))))
+       (setq tr (ff- (ff* ur wr) (ff* ui wi))
+	     ti (ff+ (ff* ur wi) (ff* ui wr))
+	     ur tr
+	     ui ti))
+     (return t)))
+
+(defun fft-bench ()
+  (dotimes (i 10)
+    (fft **fft-re** **fft-im**)))
+
+(defun testfft ()
+  (fft-bench))
+
+
+;;;
+;;; the following are for verifying that the implementation gives the
+;;; correct result
+;;;
+
+(defun clear-fft ()
+  (dotimes (i 1025)
+    (setf (aref **fft-re** i) 0.0
+	  (aref **fft-im** i) 0.0))
+  (values))
+
+(defun setup-fft-component (theta &optional (phase 0.0))
+  (let ((f (f* 2 pi theta))
+	(c (cos (f* 0.5 pi phase)))
+	(s (sin (f* 0.5 pi phase))))
+    (dotimes (i 1025)
+      (let ((x (sin (* f (/ i 1024.0)))))
+	(incf (aref **fft-re** i) (float (* c x) 0.0))
+	(incf (aref **fft-im** i) (float (* s x) 0.0)))))
+  (values))
+
+(defvar fft-delta 0.0001)
+
+(defun print-fft ()
+  (dotimes (i 1025)
+    (let ((re (aref **fft-re** i))
+	  (im (aref **fft-im** i)))
+      (unless (and (< (abs re) fft-delta) (< (abs im) fft-delta))
+	(format t "~4d  ~10f ~10f~%" i re im))))
+  (values))
diff --git a/src/gabriel/fft.cl b/src/gabriel/fft.cl
new file mode 100644
index 000000000..2351f2b99
--- /dev/null
+++ b/src/gabriel/fft.cl
@@ -0,0 +1,134 @@
+;; $Header$
+;; $Locker$
+
+;; FFT -- This is an FFT benchmark written by Harry Barrow.
+;; It tests a variety of floating point operations, including array references.
+
+(defvar **fft-re**
+  (make-array 1025. :element-type
+	      #+excl 'single-float #+lucid 'float #+KCL 'single-float
+	      #+ecl 'single-float #+clisp 'single-float #+cmu 'single-float
+	      :initial-element 0.0))
+
+(defvar **fft-im**
+  (make-array 1025. :element-type
+	      #+excl 'single-float #+lucid 'single-float #+KCL 'single-float
+	      #+ecl 'single-float #+clisp 'single-float #+cmu 'single-float
+	      :initial-element 0.0))
+
+(proclaim '(type (#+KCL vector #-KCL simple-array
+		  #+excl single-float #+lucid single-float #+KCL single-float #+ecl single-float
+		  #-KCL (*)) **fft-re** **fft-im**))
+
+(defvar s-pi (float pi 0.0))
+(proclaim '(#+excl single-float #+ecl single-float #+KCL single-float #+lucid single-float #+ecl single-float s-pi))
+
+(defun fft (areal aimag)
+  (declare (type (simple-array single-float (*)) areal aimag))
+  (prog* ((ar areal)
+	  (ai aimag)
+	  (i 1)
+	  (j 0)
+	  (k 0)
+	  (m 0) 			;compute m = log(n)
+	  (n (1- (array-dimension ar 0)))
+	  (nv2 (floor n 2))
+	  (le 0) (le1 0) (ip 0)
+	  (ur 0.0) (ui 0.0) (wr 0.0) (wi 0.0) (tr 0.0) (ti 0.0))
+     (declare (type fixnum i j k n nv2 m le le1 ip))
+     (declare (type (simple-array single-float (*)) ar ai))
+     (declare (single-float ur ui wr wi tr ti))
+     l1 (cond ((< i n)
+	       (setq m (the fixnum (1+ m))
+		     i (the fixnum (+ i i)))
+	       (go l1)))
+     (cond ((not (equal n (the fixnum (expt 2 m))))
+	    (princ "error ... array size not a power of two.")
+	    (read)
+	    (return (terpri))))
+     (setq j 1 				;interchange elements
+	   i 1) 			;in bit-reversed order
+     l3 (cond ((< i j)
+	       (setq tr (aref ar j)
+		     ti (aref ai j))
+	       (setf (aref ar j) (aref ar i))
+	       (setf (aref ai j) (aref ai i))
+	       (setf (aref ar i) tr)
+	       (setf (aref ai i) ti)))
+     (setq k nv2)
+     l6 (cond ((< k j)
+	       (setq j (the fixnum (- j k))
+		     k (the fixnum (/ k 2)))
+	       (go l6)))
+     (setq j (the fixnum (+ j k))
+	   i (the fixnum (1+ i)))
+     (cond ((< i n)
+	    (go l3)))
+     (do ((l 1 (the fixnum (1+ (the fixnum l)))))
+	 ((> (the fixnum l) m)) 	;loop thru stages
+       (declare (type fixnum l))
+       (setq le (the fixnum (expt 2 l))
+	     le1 (the (values fixnum fixnum) (floor le 2))
+	     ur 1.0
+	     ui 0.0
+	     wr (cos (/ s-pi (float le1)))
+	     wi (sin (/ s-pi (float le1))))
+       (do ((j 1 (the fixnum (1+ (the fixnum j)))))
+	   ((> (the fixnum j) le1)) 	;loop thru butterflies
+	 (declare (type fixnum j))
+	 (do ((i j (+ (the fixnum i) le)))
+	     ((> (the fixnum i) n)) 	;do a butterfly
+	   (declare (type fixnum i))
+	   (setq ip (the fixnum (+ i le1))
+		 tr (- (* (aref ar ip) ur)
+		       (* (aref ai ip) ui))
+		 ti (+ (* (aref ar ip) ui)
+		       (* (aref ai ip) ur)))
+	   (setf (aref ar ip) (- (aref ar i) tr))
+	   (setf (aref ai ip) (- (aref ai i) ti))
+	   (setf (aref ar i) (+ (aref ar i) tr))
+	   (setf (aref ai i) (+ (aref ai i) ti))))
+       (setq tr (- (* ur wr) (* ui wi))
+	     ti (+ (* ur wi) (* ui wr))
+	     ur tr
+	     ui ti))
+     (return t)))
+
+(defun fft-bench ()
+  (dotimes (i 10)
+    (fft **fft-re** **fft-im**)))
+
+(defun testfft ()
+  (fft-bench))
+
+
+;;;
+;;; the following are for verifying that the implementation gives the
+;;; correct result
+;;;
+
+(defun clear-fft ()
+  (dotimes (i 1025)
+    (setf (aref **fft-re** i) 0.0
+	  (aref **fft-im** i) 0.0))
+  (values))
+
+(defun setup-fft-component (theta &optional (phase 0.0))
+  (let ((f (* 2 pi theta))
+	(c (cos (* 0.5 pi phase)))
+	(s (sin (* 0.5 pi phase))))
+    (dotimes (i 1025)
+      (let ((x (sin (* f (/ i 1024.0)))))
+	(incf (aref **fft-re** i) (float (* c x) 0.0))
+	(incf (aref **fft-im** i) (float (* s x) 0.0)))))
+  (values))
+
+(defvar fft-delta 0.0001)
+
+(defun print-fft ()
+  (dotimes (i 1025)
+    (let ((re (aref **fft-re** i))
+	  (im (aref **fft-im** i)))
+      (unless (and (< (abs re) fft-delta) (< (abs im) fft-delta))
+	(format t "~4d  ~10f ~10f~%" i re im))))
+  (values))
diff --git a/src/gabriel/fprint.cl b/src/gabriel/fprint.cl
new file mode 100644
index 000000000..a097cb276
--- /dev/null
+++ b/src/gabriel/fprint.cl
@@ -0,0 +1,37 @@
+;; $Header$
+;; $Locker$
+
+;;; FPRINT -- Benchmark to print to a file.
+
+(defvar test-atoms '(abcdef12 cdefgh23 efghij34 ghijkl45 ijklmn56 klmnop67 
+			      mnopqr78 opqrst89 qrstuv90 stuvwx01 uvwxyz12 
+			      wxyzab23 xyzabc34 123456ab 234567bc 345678cd 
+			      456789de 567890ef 678901fg 789012gh 890123hi))
+
+(defun init-aux (m n atoms)
+  (declare (fixnum m n))
+  (cond ((= m 0) (pop atoms))
+	(t (do ((i n (the fixnum (- i 2)))
+		(a ()))
+	       ((< i 1) a)
+	     (declare (fixnum i))
+	     (push (pop atoms) a)
+	     (push (init-aux (the fixnum (1- m)) n atoms) a)))))
+
+(defun fprint-init (m n atoms)
+  (let ((atoms (subst () () atoms)))
+    (do ((a atoms (cdr a)))
+	((null (cdr a)) (rplacd a atoms)))
+    (init-aux m n atoms)))
+
+(defvar test-pattern (fprint-init 6. 6. test-atoms))
+
+(defun fprint ()
+  (if (probe-file "/tmp/fprint.tst")
+      (delete-file "/tmp/fprint.tst"))
+  (let ((stream (open "/tmp/fprint.tst" :direction :output)))
+    (print test-pattern stream)
+    (close stream)))
+
+(defun testfprint ()
+  (fprint))
diff --git a/src/gabriel/fread.cl b/src/gabriel/fread.cl
new file mode 100644
index 000000000..b14a21631
--- /dev/null
+++ b/src/gabriel/fread.cl
@@ -0,0 +1,14 @@
+;; $Header$
+;; $Locker$
+
+;;; FREAD -- Benchmark to read from a file.
+;;; Pronounced "FRED".  Requires the existance of FPRINT.TST which is created
+;;; by FPRINT.
+
+(defun fread ()
+  (let ((stream (open "/tmp/fprint.tst" :direction :input)))
+    (read stream)
+    (close stream)))
+	    
+(defun testfread ()
+  (fread))
diff --git a/src/gabriel/frpoly-mod.cl b/src/gabriel/frpoly-mod.cl
new file mode 100644
index 000000000..75b1e65d0
--- /dev/null
+++ b/src/gabriel/frpoly-mod.cl
@@ -0,0 +1,245 @@
+;; $Header$
+;; $Locker$
+
+;; FRPOLY -- Benchmark from Berkeley based on polynomial arithmetic.
+;; Originally writen in Franz Lisp by Richard Fateman.
+
+;; PDIFFER1 appears in the code, but is not defined; is not called for in this
+;; test, however.
+
+;;
+;;	This contain 2 fixes from Gabriel's book.
+;;
+;;         "ptimes3": after label 'b', change the "if" to a "cond".
+;;		The "go" should be activated when the condition
+;;		holds, NOT when it fails.
+;;
+;;	   The variables *x*, u*, and v are used specially, since this is
+;;		used to handle polynomial coefficients in a recursive
+;;		way. Declaring them global is the wrong approach.
+
+(defvar ans)
+(defvar coef)
+(defvar f)
+(defvar inc)
+(defvar i)
+(defvar qq)
+(defvar ss)
+(defvar v)
+(defvar *x*)
+(defvar *alpha*)
+(defvar *a*)
+(defvar *b*)
+(defvar *chk)
+(defvar *l)
+(defvar *p)
+(defvar q*)
+(defvar u*)
+(defvar *var)
+(defvar *y*)
+(defvar r)
+(defvar r2)
+(defvar r3)
+(defvar start)
+(defvar res1)
+(defvar res2)
+(defvar res3)
+
+;(defmacro pointergp (x y) `(> (get ,x 'order)(get ,y 'order)))
+(defmacro valget (x) `(the fixnum (symbol-value ,x)))
+(defmacro pointergp (x y) `(> (valget ,x) (valget ,y)))
+(defmacro f+ (x y) `(the fixnum (+ (the fixnum ,x) (the fixnum ,y))))
+(defmacro f> (x y) `(> (the fixnum ,x) (the fixnum ,y)))
+
+(defmacro pcoefp (e) `(atom ,e))
+
+(defmacro pzerop (x)
+   `(and (not (consp ,x))
+         (if (typep ,x 'fixnum) (eql 0 (the fixnum ,x))
+             (if (typep ,x 'float) (= 0.0 (the float ,x))))))
+
+(defmacro pzero () 0)
+(defmacro cplus (x y) `(+ ,x ,y))
+(defmacro ctimes (x y) `(* ,x ,y))
+
+(defun pcoefadd (e c x) 
+  (if (pzerop c)
+      x
+      (cons e (cons c x))))
+
+(defun pcplus (c p)
+  (if (pcoefp p)
+      (cplus p c)
+      (psimp (car p) (pcplus1 c (cdr p)))))
+
+(defun pcplus1 (c x)
+  (cond ((null x)
+	 (if (pzerop c)
+	     nil
+	     (cons 0 (cons c nil))))
+	((pzerop (car x))
+	 (pcoefadd 0 (pplus c (cadr x)) nil))
+	(t
+	 (cons (car x) (cons (cadr x) (pcplus1 c (cddr x)))))))
+
+(defun pctimes (c p) 
+  (if (pcoefp p)
+      (ctimes c p)
+      (psimp (car p) (pctimes1 c (cdr p)))))
+
+(defun pctimes1 (c x)
+  (if (null x)
+      nil
+      (pcoefadd (car x)
+		(ptimes c (cadr x))
+		(pctimes1 c (cddr x)))))
+
+(defun pplus (x y) 
+  (cond ((pcoefp x)
+	 (pcplus x y))
+	((pcoefp y)
+	 (pcplus y x))
+	((eq (car x) (car y))
+	 (psimp (car x) (pplus1 (cdr y) (cdr x))))
+	((pointergp (car x) (car y))
+	 (psimp (car x) (pcplus1 y (cdr x))))
+	(t
+	 (psimp (car y) (pcplus1 x (cdr y))))))
+
+(defun pplus1 (x y)
+  (cond ((null x) y)
+	((null y) x)
+	((= (car x) (car y))
+	 (pcoefadd (car x)
+		   (pplus (cadr x) (cadr y))
+		   (pplus1 (cddr x) (cddr y))))
+	((> (car x) (car y))
+	 (cons (car x) (cons (cadr x) (pplus1 (cddr x) y))))
+	(t (cons (car y) (cons (cadr y) (pplus1 x (cddr y)))))))
+
+(defun psimp (var x)
+  (cond ((null x) 0)
+	((atom x) x)
+	((zerop (car x))
+	 (cadr x))
+	(t
+	 (cons var x))))
+
+(defun ptimes (x y) 
+  (cond ((or (pzerop x) (pzerop y))
+	 (pzero))
+	((pcoefp x)
+	 (pctimes x y))
+	((pcoefp y)
+	 (pctimes y x))
+	((eq (car x) (car y))
+	 (psimp (car x) (ptimes1 (cdr x) (cdr y))))
+	((pointergp (car x) (car y))
+	 (psimp (car x) (pctimes1 y (cdr x))))
+	(t
+	 (psimp (car y) (pctimes1 x (cdr y))))))
+
+(defun ptimes1 (*x* y) 
+  (prog (u* v)
+	(setq v (setq u* (ptimes2 y)))
+     a  
+	(setq *x* (cddr *x*))
+	(if (null *x*)
+	    (return u*))
+	(ptimes3 y)
+	(go a)))
+
+(defun ptimes2 (y)
+  (if (null y)
+      nil
+      (pcoefadd (+ (car *x*) (car y))
+		(ptimes (cadr *x*) (cadr y))
+		(ptimes2 (cddr y)))))
+
+(defun ptimes3 (y) 
+  (prog (e u c) 
+     a1	(if (null y) 
+	    (return nil))
+	(setq e (f+ (car *x*) (car y))
+	      c (ptimes (cadr y) (cadr *x*) ))
+	(cond ((pzerop c)
+	       (setq y (cddr y)) 
+	       (go a1))
+	      ((or (null v) (f> e (car v)))
+	       (setq u* (setq v (pplus1 u* (list e c))))
+	       (setq y (cddr y))
+	       (go a1))
+	      ((= e (car v))
+	       (setq c (pplus c (cadr v)))
+	       (if (pzerop c) 			; never true, evidently
+		   (setq u* (setq v (pdiffer1 u* (list (car v) (cadr v)))))
+		   (rplaca (cdr v) c))
+	       (setq y (cddr y))
+	       (go a1)))
+     a  (cond ((and (cddr v) (> (caddr v) e))
+	       (setq v (cddr v))
+	       (go a)))
+	(setq u (cdr v))
+     b  (cond ((or (null (cdr u)) (< (cadr u) e))
+	       (rplacd u (cons e (cons c (cdr u)))) (go e)))
+	(cond ((pzerop (setq c (pplus (caddr u) c)))
+	       (rplacd u (cdddr u))
+	       (go d))
+	      (t
+	       (rplaca (cddr u) c)))
+     e  (setq u (cddr u))
+     d  (setq y (cddr y))
+	(if (null y)
+	    (return nil))
+	(setq e (f+ (car *x*) (car y))
+	      c (ptimes (cadr y) (cadr *x*)))
+     c  (cond ((and (cdr u) (> (cadr u) e))
+	       (setq u (cddr u))
+	       (go c)))
+	(go b))) 
+
+(defun pexptsq (p n)
+  (do ((n (floor n 2) (floor n 2))
+       (s (if (oddp n) p 1)))
+      ((zerop n) s)
+    (setq p (ptimes p p))
+    (and (oddp n) (setq s (ptimes s p)))))
+
+(eval-when (load eval)
+  (setf (valget 'x ) 1)
+  (setf (valget 'y) 2)
+  (setf (valget 'z ) 3)
+  (setq r (pplus '(x 1 1 0 1) (pplus '(y 1 1) '(z 1 1)))	; r= x+y+z+1
+	r2 (ptimes r 100000)				 	; r2 = 100000*r
+	r3 (ptimes r 1.0)))					; r3 = r with floating point coefficients	
+
+
+(defun standard-frpoly-test1 ()
+  (progn (pexptsq r 2)  (pexptsq r2 2) (pexptsq r3 2) nil))
+
+(defun standard-frpoly-test2 ()
+  (progn (pexptsq r 5) (pexptsq r2 5) (pexptsq r3 5) nil))
+
+(defun standard-frpoly-test3 ()
+  (progn (pexptsq r 10) (pexptsq r2 10) (pexptsq r3 10) nil))
+
+(defun standard-frpoly-test4 ()
+  (progn (pexptsq r 15) (pexptsq r2 15) (pexptsq r3 15) nil))
+
+(defun testfrpoly ()
+  (testfrpoly-1)
+  (testfrpoly-2)
+  (testfrpoly-3)
+  (testfrpoly-4))
+
+(defun testfrpoly-1 ()
+  (print (time (standard-frpoly-test1))))
+
+(defun testfrpoly-2 ()
+  (print (time (standard-frpoly-test2))))
+
+(defun testfrpoly-3 ()
+  (print (time (standard-frpoly-test3))))
+
+(defun testfrpoly-4 ()
+  (print (time (standard-frpoly-test4))))
diff --git a/src/gabriel/frpoly.cl b/src/gabriel/frpoly.cl
new file mode 100644
index 000000000..52e42e5be
--- /dev/null
+++ b/src/gabriel/frpoly.cl
@@ -0,0 +1,238 @@
+;; $Header$
+;; $Locker$
+
+;; FRPOLY -- Benchmark from Berkeley based on polynomial arithmetic.
+;; Originally writen in Franz Lisp by Richard Fateman.
+
+;; PDIFFER1 appears in the code, but is not defined; is not called for in this
+;; test, however.
+
+;;
+;;	This contain 2 fixes from Gabriel's book.
+;;
+;;         "ptimes3": after label 'b', change the "if" to a "cond".
+;;		The "go" should be activated when the condition
+;;		holds, NOT when it fails.
+;;
+;;	   The variables *x*, u*, and v are used specially, since this is
+;;		used to handle polynomial coefficients in a recursive
+;;		way. Declaring them global is the wrong approach.
+
+(defvar ans)
+(defvar coef)
+(defvar f)
+(defvar inc)
+(defvar i)
+(defvar qq)
+(defvar ss)
+(defvar v)
+(defvar *x*)
+(defvar *alpha*)
+(defvar *a*)
+(defvar *b*)
+(defvar *chk)
+(defvar *l)
+(defvar *p)
+(defvar q*)
+(defvar u*)
+(defvar *var)
+(defvar *y*)
+(defvar r)
+(defvar r2)
+(defvar r3)
+(defvar start)
+(defvar res1)
+(defvar res2)
+(defvar res3)
+
+(defmacro pointergp (x y) `(> (get ,x 'order)(get ,y 'order)))
+(defmacro pcoefp (e) `(atom ,e))
+
+(defmacro pzerop (x) 
+  `(if (numberp ,x) 					; no signp in CL	
+       (zerop ,x)))		      
+(defmacro pzero () 0)
+(defmacro cplus (x y) `(+ ,x ,y))
+(defmacro ctimes (x y) `(* ,x ,y))
+
+(defun pcoefadd (e c x) 
+  (if (pzerop c)
+      x
+      (cons e (cons c x))))
+
+(defun pcplus (c p)
+  (if (pcoefp p)
+      (cplus p c)
+      (psimp (car p) (pcplus1 c (cdr p)))))
+
+(defun pcplus1 (c x)
+  (cond ((null x)
+	 (if (pzerop c)
+	     nil
+	     (cons 0 (cons c nil))))
+	((pzerop (car x))
+	 (pcoefadd 0 (pplus c (cadr x)) nil))
+	(t
+	 (cons (car x) (cons (cadr x) (pcplus1 c (cddr x)))))))
+
+(defun pctimes (c p) 
+  (if (pcoefp p)
+      (ctimes c p)
+      (psimp (car p) (pctimes1 c (cdr p)))))
+
+(defun pctimes1 (c x)
+  (if (null x)
+      nil
+      (pcoefadd (car x)
+		(ptimes c (cadr x))
+		(pctimes1 c (cddr x)))))
+
+(defun pplus (x y) 
+  (cond ((pcoefp x)
+	 (pcplus x y))
+	((pcoefp y)
+	 (pcplus y x))
+	((eq (car x) (car y))
+	 (psimp (car x) (pplus1 (cdr y) (cdr x))))
+	((pointergp (car x) (car y))
+	 (psimp (car x) (pcplus1 y (cdr x))))
+	(t
+	 (psimp (car y) (pcplus1 x (cdr y))))))
+
+(defun pplus1 (x y)
+  (cond ((null x) y)
+	((null y) x)
+	((= (car x) (car y))
+	 (pcoefadd (car x)
+		   (pplus (cadr x) (cadr y))
+		   (pplus1 (cddr x) (cddr y))))
+	((> (car x) (car y))
+	 (cons (car x) (cons (cadr x) (pplus1 (cddr x) y))))
+	(t (cons (car y) (cons (cadr y) (pplus1 x (cddr y)))))))
+
+(defun psimp (var x)
+  (cond ((null x) 0)
+	((atom x) x)
+	((zerop (car x))
+	 (cadr x))
+	(t
+	 (cons var x))))
+
+(defun ptimes (x y) 
+  (cond ((or (pzerop x) (pzerop y))
+	 (pzero))
+	((pcoefp x)
+	 (pctimes x y))
+	((pcoefp y)
+	 (pctimes y x))
+	((eq (car x) (car y))
+	 (psimp (car x) (ptimes1 (cdr x) (cdr y))))
+	((pointergp (car x) (car y))
+	 (psimp (car x) (pctimes1 y (cdr x))))
+	(t
+	 (psimp (car y) (pctimes1 x (cdr y))))))
+
+(defun ptimes1 (*x* y) 
+  (prog (u* v)
+	(setq v (setq u* (ptimes2 y)))
+     a  
+	(setq *x* (cddr *x*))
+	(if (null *x*)
+	    (return u*))
+	(ptimes3 y)
+	(go a)))
+
+(defun ptimes2 (y)
+  (if (null y)
+      nil
+      (pcoefadd (+ (car *x*) (car y))
+		(ptimes (cadr *x*) (cadr y))
+		(ptimes2 (cddr y)))))
+
+(defun ptimes3 (y) 
+  (prog (e u c) 
+     a1	(if (null y) 
+	    (return nil))
+	(setq e (+ (car *x*) (car y))
+	      c (ptimes (cadr y) (cadr *x*) ))
+	(cond ((pzerop c)
+	       (setq y (cddr y)) 
+	       (go a1))
+	      ((or (null v) (> e (car v)))
+	       (setq u* (setq v (pplus1 u* (list e c))))
+	       (setq y (cddr y))
+	       (go a1))
+	      ((= e (car v))
+	       (setq c (pplus c (cadr v)))
+	       (if (pzerop c) 			; never true, evidently
+		   (setq u* (setq v (pdiffer1 u* (list (car v) (cadr v)))))
+		   (rplaca (cdr v) c))
+	       (setq y (cddr y))
+	       (go a1)))
+     a  (cond ((and (cddr v) (> (caddr v) e))
+	       (setq v (cddr v))
+	       (go a)))
+	(setq u (cdr v))
+     b  (cond ((or (null (cdr u)) (< (cadr u) e))
+	       (rplacd u (cons e (cons c (cdr u)))) (go e)))
+	(cond ((pzerop (setq c (pplus (caddr u) c)))
+	       (rplacd u (cdddr u))
+	       (go d))
+	      (t
+	       (rplaca (cddr u) c)))
+     e  (setq u (cddr u))
+     d  (setq y (cddr y))
+	(if (null y)
+	    (return nil))
+	(setq e (+ (car *x*) (car y))
+	      c (ptimes (cadr y) (cadr *x*)))
+     c  (cond ((and (cdr u) (> (cadr u) e))
+	       (setq u (cddr u))
+	       (go c)))
+	(go b))) 
+
+(defun pexptsq (p n)
+  (do ((n (floor n 2) (floor n 2))
+       (s (if (oddp n) p 1)))
+      ((zerop n) s)
+    (setq p (ptimes p p))
+    (and (oddp n) (setq s (ptimes s p)))))
+
+(eval-when (load eval)
+  (setf (get 'x 'order) 1)
+  (setf (get 'y 'order) 2)
+  (setf (get 'z 'order) 3)
+  (setq r (pplus '(x 1 1 0 1) (pplus '(y 1 1) '(z 1 1)))	; r= x+y+z+1
+	r2 (ptimes r 100000)				 	; r2 = 100000*r
+	r3 (ptimes r 1.0)))					; r3 = r with floating point coefficients	
+
+
+(defun standard-frpoly-test1 ()
+  (progn (pexptsq r 2)  (pexptsq r2 2) (pexptsq r3 2) nil))
+
+(defun standard-frpoly-test2 ()
+  (progn (pexptsq r 5) (pexptsq r2 5) (pexptsq r3 5) nil))
+
+(defun standard-frpoly-test3 ()
+  (progn (pexptsq r 10) (pexptsq r2 10) (pexptsq r3 10) nil))
+
+(defun standard-frpoly-test4 ()
+  (progn (pexptsq r 15) (pexptsq r2 15) (pexptsq r3 15) nil))
+
+(defun testfrpoly ()
+  (testfrpoly-1)
+  (testfrpoly-2)
+  (testfrpoly-3)
+  (testfrpoly-4))
+
+(defun testfrpoly-1 ()
+  (standard-frpoly-test1))
+
+(defun testfrpoly-2 ()
+  (standard-frpoly-test2))
+
+(defun testfrpoly-3 ()
+  (standard-frpoly-test3))
+
+(defun testfrpoly-4 ()
+  (standard-frpoly-test4))
diff --git a/src/gabriel/init.lsp b/src/gabriel/init.lsp
new file mode 100644
index 000000000..1a7609080
--- /dev/null
+++ b/src/gabriel/init.lsp
@@ -0,0 +1,16 @@
+#-boehm-gc
+(allocate 'cons 2000 t)
+#-ecl
+(allocate 'fixnum 200 t)
+;;so that the lisps do the same thing.
+(setq *print-pretty* nil)
+#+(and ecl (not boehm-gc))
+(setq si:*gc-verbose* nil)
+;;If running this on a machine without a floating point chip delete this
+#+nil
+(when (and (boundp 'compiler::*cc*)
+         (search "gcc" compiler::*cc*)
+	 (search "msoft-float" compiler::*cc*))
+      (setq compiler::*cc* "gcc -DVOL=volatile ")
+;      (setq compiler::*register-min* 100000) (setq compiler::*cc* "cc -f68881 -DVOL= ")      (print "using cc")
+      )
diff --git a/src/gabriel/integer.cl b/src/gabriel/integer.cl
new file mode 100644
index 000000000..57757dedf
--- /dev/null
+++ b/src/gabriel/integer.cl
@@ -0,0 +1,34 @@
+
+(defun pi-inv (bits &aux (m 0))
+  (declare (integer bits m))
+  (let* ((n (+ bits (integer-length bits) 11))
+         (tt (truncate (ash 1 n) 882))
+         (d (* 4 882 882))
+         (s 0))
+    (declare (integer s d tt n))
+;    (print (list n tt d s))
+    (do ((i 2 (+ i 2))
+         (j 1123 (+ j 21460)))
+        ((zerop tt) (cons s (- (+ n 2))))
+      (declare (integer i j))
+        (setq s (+ s (* j tt))
+              m (- (* (- i 1) (- (* 2 i) 1) (- (* 2 i) 3)))
+              tt (truncate (* m tt) (* d (the integer (expt i 3))))))))
+
+(defun dvide (x y n)
+  (let* ((ew (+ (integer-length (car y)) (- (integer-length (car x))) n 1))
+         (mw (truncate (ash (car x) ew) (car y)))
+         (ew (- (cdr x) (cdr y) ew)))
+    (cons mw ew)))
+
+(defun pi (bits) (dvide (cons 1 0) (pi-inv bits) bits))
+
+(defun test-float (x) (scale-float (coerce (car x) 'long-float) (cdr x)))
+
+(defun factorial (n)
+  (declare (fixnum n))
+  (do ((i 1 (+ i 1))
+       (ans 1 (* i ans)))
+      ((> i n) ans)
+    (declare (fixnum i ) (integer ans))))
+
diff --git a/src/gabriel/make-declare.lsp b/src/gabriel/make-declare.lsp
new file mode 100644
index 000000000..773d65a15
--- /dev/null
+++ b/src/gabriel/make-declare.lsp
@@ -0,0 +1,76 @@
+;; By W. Schelter
+;; Usage: (proclaim-file "foo.lsp") (compile-file "foo.lsp")
+
+;; You may wish to adjust the following to output the proclamations
+;; for inclusion in a file.  All fixed arg functions should be proclaimed
+;; before their references for maximum efficiency.
+
+;; CAVEAT: The following code only checks for fixed args, it does
+;; not check for single valuedness BUT does make a proclamation
+;; to that efect.  Unfortunately it is impossible to tell about
+;; multiple values without doing a full compiler type pass over 
+;; all files in the relevant system.   However the AKCL compiler should
+;; warn if you inadvertantly proclaim foo to be single valued and then try
+;; to use more than one value.  
+
+(DEFVAR *DECLARE-T-ONLY* NIL)
+(DEFUN PROCLAIM-FILE (NAME &OPTIONAL *DECLARE-T-ONLY*)
+  (WITH-OPEN-FILE 
+      (FILE NAME
+            :DIRECTION :INPUT)
+    (LET ((EOF (CONS NIL NIL)))
+      (LOOP
+       (LET ((FORM (READ FILE NIL EOF)))
+         (COND ((EQ EOF FORM) (RETURN NIL))
+               ((MAKE-DECLARE-FORM FORM ))))))))
+
+(DEFUN MAKE-DECLARE-FORM (FORM)
+; !!!
+  (WHEN
+        (LISTP FORM)
+   (COND ((MEMBER (CAR FORM) '(EVAL-WHEN ))
+          (DOLIST (V (CDDR FORM)) (MAKE-DECLARE-FORM V)))
+         ((MEMBER (CAR FORM) '(PROGN ))
+          (DOLIST (V (CDR FORM)) (MAKE-DECLARE-FORM V)))
+         ((MEMBER (CAR FORM) '(IN-PACKAGE DEFCONSTANT))
+          (EVAL FORM))
+         ((MEMBER (CAR FORM) '(DEFUN))
+          (COND
+           ((AND
+             (CONSP (CADDR FORM))
+             (NOT (MEMBER '&REST (CADDR FORM)))
+             (NOT (MEMBER '&BODY (CADDR FORM)))
+             (NOT (MEMBER '&KEY (CADDR FORM)))
+             (NOT (MEMBER '&OPTIONAL (CADDR FORM))))
+             ;;could print  declarations here.
+	    (print (list (cadr form) (ARG-DECLARES (THIRD FORM) (cdddr FORM))))
+            (FUNCALL 'PROCLAIM
+                     (LIST  'FUNCTION
+                            (CADR FORM)
+			    (ARG-DECLARES (THIRD FORM) (cdddr FORM))
+                            T))))))))
+
+(DEFUN ARG-DECLARES (ARGS DECLS &AUX ANS)
+  (COND ((STRINGP (CAR DECLS)) (SETQ DECLS (CADR DECLS)))
+	(T (SETQ DECLS (CAR DECLS))))
+  (COND ((AND (not *declare-t-only*)
+	       (CONSP DECLS) (EQ (CAR DECLS ) 'DECLARE))
+	 (DO ((V ARGS (CDR V)))
+	     ((OR (EQ (CAR V) '&AUX)
+		  (NULL V))
+	      (NREVERSE ANS))
+	     (PUSH (DECL-TYPE (CAR V) DECLS) ANS)))
+	(T (MAKE-LIST (- (LENGTH args)
+			 (LENGTH (MEMBER '&AUX args)))
+		      :INITIAL-ELEMENT T))))
+
+(DEFUN DECL-TYPE (V DECLS)
+  (DOLIST (D (CDR DECLS))
+	  (CASE (CAR D)
+		(TYPE (IF (MEMBER V (CDDR D))
+			(RETURN-FROM DECL-TYPE (SECOND D))))
+		((FIXNUM CHARACTER FLOAT LONG-FLOAT SHORT-FLOAT )
+		 (IF (MEMBER V (CDR D)) (RETURN-FROM DECL-TYPE (CAR D))))))
+  T)
+			    
+	      
\ No newline at end of file
diff --git a/src/gabriel/makefile b/src/gabriel/makefile
new file mode 100644
index 000000000..a55a0c4a0
--- /dev/null
+++ b/src/gabriel/makefile
@@ -0,0 +1,32 @@
+FILES=  boyer browse  ctak dderiv deriv destru-mod destru  div2 fft-mod \
+	fft fprint fread frpoly  puzzle-mod puzzle stak \
+	tak-mod tak takl takr tprint traverse triang-mod triang
+
+REPEAT ?= 1
+LISP ?= ecl
+RESULTS ?= times
+
+all:
+	make compile
+	@ echo >> $(RESULTS)
+	@ echo "--------------   SESSION   ------------------" >> $(RESULTS)
+	@ echo >> $(RESULTS)
+	@ echo "      " For $(LISP) Common Lisp  >> $(RESULTS)
+	@ date >> $(RESULTS)
+	make -i test
+
+compile:
+	for v in $(FILES) ; do \
+	echo "(load \"make-declare.lsp\")(si::proclaim-file \"$$v.cl\")" \
+	"(compile-file \"$$v.cl\")" | $(LISP) ; done
+
+
+test:
+	for v in $(FILES) ; do \
+	echo "(load \"test-help.lsp\")(do-test \"$$v\" \"$(RESULTS)\")" \
+	| $(LISP); \
+	done
+
+clean:
+	rm -f core *.data *.c a.out *.o *.lbin *.bin *.*fasl *~ *.x86f *.fas *.lib *#
+
diff --git a/src/gabriel/puzzle-mod.cl b/src/gabriel/puzzle-mod.cl
new file mode 100644
index 000000000..395baeda9
--- /dev/null
+++ b/src/gabriel/puzzle-mod.cl
@@ -0,0 +1,184 @@
+;; $Header$
+;; $Locker$
+
+(eval-when (compile load eval)
+  (defconstant puzzle-size 511.)	
+  (defconstant puzzle-classmax 3.)
+  (defconstant puzzle-typemax 12.))
+
+(defvar **iii** 0)
+(defvar **kount** 0)
+(defvar puzzle-d 8.)
+(proclaim '(type fixnum **iii** **kount** puzzle-d))
+
+(defvar piececount (make-array (1+ puzzle-classmax) :element-type 'fixnum :initial-element 0))
+(defvar puzzle-class (make-array (1+ puzzle-typemax) :element-type 'fixnum :initial-element 0))
+(defvar piecemax (make-array (1+ puzzle-typemax) :element-type 'fixnum :initial-element 0))
+(defvar puzzle (make-array (1+ puzzle-size)))
+(defvar puzzle-p (make-array (list (1+ puzzle-typemax) (1+ puzzle-size))))
+
+(proclaim '(type (array fixnum) piececount puzzle-class piecemax))
+(defmacro fref (a i) `(the fixnum (aref ,a (the fixnum ,i))))
+
+
+(proclaim '(type simple-vector   puzzle))
+
+(proclaim '(type (simple-array t (#.(1+ puzzle-typemax) #.(1+ puzzle-size)))
+		 puzzle-p))
+
+(defun fit (i j)
+  (declare (type fixnum i j))
+  (let ((end (fref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end) t)
+      (declare (type fixnum k))
+      (cond ((aref puzzle-p i k)
+	     (cond ((aref puzzle (the fixnum (+ j k)))
+		    (return nil))))))))
+
+(proclaim '(function place (fixnum fixnum ) fixnum))
+(defun jil () 3)
+(defun place (i j)
+  (declare (type fixnum i j))
+  (let ((end (fref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end))
+      (declare (type fixnum k))
+      (cond ((aref puzzle-p i k) 
+	     (setf (aref puzzle (the fixnum (+ j k))) t))))
+    (setf (fref piececount (fref puzzle-class i)) 
+	  (the fixnum
+	       (- (the fixnum
+		       (fref piececount (fref puzzle-class i))) 1)))
+    (do ((k j (the fixnum (1+ k))))
+	((> k puzzle-size)
+	 (terpri)
+	 (princ "Puzzle filled")
+	 0)
+      (declare (type fixnum k))
+      (cond ((not (aref puzzle k))
+	     (return k))))))
+
+
+(defun puzzle-remove (i j)
+  (declare (type fixnum i j))
+  (let ((end (fref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end))
+	(declare (type fixnum k))
+	(cond ((aref puzzle-p i k)
+	       (setf (aref puzzle (the fixnum (+ j k)))  nil))))
+    (setf (fref piececount (fref puzzle-class i))
+	  (the fixnum
+	       (+ (the fixnum (fref piececount (fref puzzle-class i))) 1)))))
+
+(defun trial (j)
+  (declare (type fixnum j))
+  (let ((k 0))
+    (declare (type fixnum k))
+    (do ((i 0 (the fixnum (1+ i))))
+	((> i puzzle-typemax) 
+	 (setq **kount** (the fixnum (1+ **kount**))) nil)
+      (declare (type fixnum i))
+      (cond ((not (= (the fixnum (fref piececount (fref puzzle-class i))) 0))
+	     (cond ((fit i j)
+		    (setq k (place i j))
+		    (cond ((or (trial k)
+			       (= k 0))
+			   (setq **kount** (the fixnum (+ **kount** 1)))
+			   (return t))
+			  (t (puzzle-remove i j))))))))))
+
+(defun definepiece (iclass ii jj kk)
+  (declare (type fixnum ii jj kk))
+  (let ((index 0))
+    (declare (type fixnum index))
+    (do ((i 0 (the fixnum (1+ i))))
+	((> i ii))
+      (declare (type fixnum i))
+      (do ((j 0 (the fixnum (1+ j))))
+	  ((> j jj))
+	(declare (type fixnum j))
+	(do ((k 0 (the fixnum (1+ k))))
+	    ((> k kk))
+	  (declare (type fixnum k))
+	  (setq index  
+	    (+ i 
+	       (the fixnum 
+		    (* puzzle-d 
+		       (the fixnum 
+			    (+ j 
+			       (the fixnum 
+				    (* puzzle-d k))))))))
+	  (setf (aref puzzle-p **iii** index)  t))))
+    (setf (fref puzzle-class **iii**) iclass)
+    (setf (fref piecemax **iii**) index) 
+    (cond ((not (= **iii** puzzle-typemax))
+	   (setq **iii** (the fixnum (+ **iii** 1)))))))
+
+(defun puzzle-start ()
+  (do ((m 0 (the fixnum (1+ m))))
+      ((> m puzzle-size))
+    (declare (type fixnum m))
+    (setf (aref puzzle m) t))
+  (do ((i 1 (the fixnum (1+ i))))
+      ((> i 5))
+    (declare (type fixnum i))
+    (do ((j 1 (the fixnum (1+ j))))
+	((> j 5))
+      (declare (type fixnum j))
+      (do ((k 1 (the fixnum (1+ k))))
+	  ((> k 5))
+	(declare (type fixnum k))
+	(setf (aref puzzle 
+		    (+ i 
+		       (the fixnum
+			    (* puzzle-d 
+			       (the fixnum
+				    (+ j 
+				       (the fixnum
+					    (* puzzle-d k))))))))
+	      nil)))) 
+  (do ((i 0 (the fixnum (1+ i))))
+      ((> i puzzle-typemax))
+    (declare (type fixnum i))
+    (do ((m 0 (the fixnum (1+ m))))
+	((> m puzzle-size))
+      (declare (type fixnum m))
+      (setf (aref puzzle-p i m)  nil)))
+  (setq **iii** 0)
+  (definepiece 0 3 1 0)
+  (definepiece 0 1 0 3)
+  (definepiece 0 0 3 1)
+  (definepiece 0 1 3 0)
+  (definepiece 0 3 0 1)
+  (definepiece 0 0 1 3)
+  
+  (definepiece 1 2 0 0)
+  (definepiece 1 0 2 0)
+  (definepiece 1 0 0 2)
+  
+  (definepiece 2 1 1 0)
+  (definepiece 2 1 0 1)
+  (definepiece 2 0 1 1)
+  
+  (definepiece 3 1 1 1)
+  
+  (setf (fref piececount 0) 13.)
+  (setf (fref piececount 1) 3)
+  (setf (fref piececount 2) 1)
+  (setf (fref piececount 3) 1)
+  (let ((m (+ 1 (the fixnum (* puzzle-d (the fixnum (+ 1 puzzle-d))))))
+	(n 0)(**kount** 0))
+    (declare (type fixnum m n **kount**))
+    (cond ((fit 0 m) (setq n (place 0 m)))
+	  (t (format t "~%Error.")))
+    (cond ((trial n) 
+	   (format t "~%Success in ~4D trials." **kount**))
+	  (t (format t "~%Failure.")))))
+
+(defun testpuzzle ()
+  (puzzle-start))
diff --git a/src/gabriel/puzzle-mod1.cl b/src/gabriel/puzzle-mod1.cl
new file mode 100644
index 000000000..9f2dacd13
--- /dev/null
+++ b/src/gabriel/puzzle-mod1.cl
@@ -0,0 +1,188 @@
+;; $Header$
+;; $Locker$
+
+(eval-when (compile load eval)
+  (defconstant puzzle-size 511.)	
+  (defconstant puzzle-classmax 3.)
+  (defconstant puzzle-typemax 12.))
+
+(defvar **iii** 0)
+(defvar **kount** 0)
+(defvar puzzle-d 8.)
+(proclaim '(type fixnum **iii** **kount** puzzle-d))
+
+(defvar piececount (make-array (1+ puzzle-classmax) :element-type 'fixnum :initial-element 0))
+(defvar puzzle-class (make-array (1+ puzzle-typemax) :element-type 'fixnum :initial-element 0))
+(defvar piecemax (make-array (1+ puzzle-typemax) :element-type 'fixnum :initial-element 0))
+(defvar puzzle (make-array (1+ puzzle-size)))
+(defvar puzzle-p (make-array (list (1+ puzzle-typemax) (1+ puzzle-size))))
+
+(proclaim '(type (array fixnum) piececount puzzle-class piecemax))
+(defmacro fref (a i) `(the fixnum (aref ,a (the fixnum ,i))))
+
+
+(proclaim '(type simple-vector   puzzle))
+
+(proclaim '(type (simple-array t (#.(1+ puzzle-typemax) #.(1+ puzzle-size)))
+		 puzzle-p))
+
+(defun fit (i j)
+  (declare (type fixnum i j))
+  (let ((end (fref piecemax i))
+	(puzzle-pl puzzle-p))
+    (declare (type fixnum end)
+	     (type (simple-array t (#.(1+ puzzle-typemax) #.(1+ puzzle-size)))
+		 puzzle-pl)
+	     )
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end) t)
+      (declare (type fixnum k))
+      (cond ((aref puzzle-pl i k)
+	     (cond ((aref puzzle (the fixnum (+ j k)))
+		    (return nil))))))))
+
+(proclaim '(function place (fixnum fixnum ) fixnum))
+
+(defun place (i j)
+  (declare (type fixnum i j))
+  (let ((end (fref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end))
+      (declare (type fixnum k))
+      (cond ((aref puzzle-p i k) 
+	     (setf (aref puzzle (the fixnum (+ j k))) t))))
+    (setf (fref piececount (fref puzzle-class i)) 
+	  (the fixnum
+	       (- (the fixnum
+		       (fref piececount (fref puzzle-class i))) 1)))
+    (do ((k j (the fixnum (1+ k))))
+	((> k puzzle-size)
+	 (terpri)
+	 (princ "Puzzle filled")
+	 0)
+      (declare (type fixnum k))
+      (cond ((not (aref puzzle k))
+	     (return k))))))
+
+
+(defun puzzle-remove (i j)
+  (declare (type fixnum i j))
+  (let ((end (fref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end))
+	(declare (type fixnum k))
+	(cond ((aref puzzle-p i k)
+	       (setf (aref puzzle (the fixnum (+ j k)))  nil))))
+    (setf (fref piececount (fref puzzle-class i))
+	  (the fixnum
+	       (+ (the fixnum (fref piececount (fref puzzle-class i))) 1)))))
+
+(defun trial (j)
+  (declare (type fixnum j))
+  (let ((k 0))
+    (declare (type fixnum k))
+    (do ((i 0 (the fixnum (1+ i))))
+	((> i puzzle-typemax) 
+	 (setq **kount** (the fixnum (1+ **kount**))) nil)
+      (declare (type fixnum i))
+      (cond ((not (= (the fixnum (fref piececount (fref puzzle-class i))) 0))
+	     (cond ((fit i j)
+		    (setq k (place i j))
+		    (cond ((or (trial k)
+			       (= k 0))
+			   (setq **kount** (the fixnum (+ **kount** 1)))
+			   (return t))
+			  (t (puzzle-remove i j))))))))))
+
+(defun definepiece (iclass ii jj kk)
+  (declare (type fixnum ii jj kk))
+  (let ((index 0))
+    (declare (type fixnum index))
+    (do ((i 0 (the fixnum (1+ i))))
+	((> i ii))
+      (declare (type fixnum i))
+      (do ((j 0 (the fixnum (1+ j))))
+	  ((> j jj))
+	(declare (type fixnum j))
+	(do ((k 0 (the fixnum (1+ k))))
+	    ((> k kk))
+	  (declare (type fixnum k))
+	  (setq index  
+	    (+ i 
+	       (the fixnum 
+		    (* puzzle-d 
+		       (the fixnum 
+			    (+ j 
+			       (the fixnum 
+				    (* puzzle-d k))))))))
+	  (setf (aref puzzle-p **iii** index)  t))))
+    (setf (fref puzzle-class **iii**) iclass)
+    (setf (fref piecemax **iii**) index) 
+    (cond ((not (= **iii** puzzle-typemax))
+	   (setq **iii** (the fixnum (+ **iii** 1)))))))
+
+(defun puzzle-start ()
+  (do ((m 0 (the fixnum (1+ m))))
+      ((> m puzzle-size))
+    (declare (type fixnum m))
+    (setf (aref puzzle m) t))
+  (do ((i 1 (the fixnum (1+ i))))
+      ((> i 5))
+    (declare (type fixnum i))
+    (do ((j 1 (the fixnum (1+ j))))
+	((> j 5))
+      (declare (type fixnum j))
+      (do ((k 1 (the fixnum (1+ k))))
+	  ((> k 5))
+	(declare (type fixnum k))
+	(setf (aref puzzle 
+		    (+ i 
+		       (the fixnum
+			    (* puzzle-d 
+			       (the fixnum
+				    (+ j 
+				       (the fixnum
+					    (* puzzle-d k))))))))
+	      nil)))) 
+  (do ((i 0 (the fixnum (1+ i))))
+      ((> i puzzle-typemax))
+    (declare (type fixnum i))
+    (do ((m 0 (the fixnum (1+ m))))
+	((> m puzzle-size))
+      (declare (type fixnum m))
+      (setf (aref puzzle-p i m)  nil)))
+  (setq **iii** 0)
+  (definepiece 0 3 1 0)
+  (definepiece 0 1 0 3)
+  (definepiece 0 0 3 1)
+  (definepiece 0 1 3 0)
+  (definepiece 0 3 0 1)
+  (definepiece 0 0 1 3)
+  
+  (definepiece 1 2 0 0)
+  (definepiece 1 0 2 0)
+  (definepiece 1 0 0 2)
+  
+  (definepiece 2 1 1 0)
+  (definepiece 2 1 0 1)
+  (definepiece 2 0 1 1)
+  
+  (definepiece 3 1 1 1)
+  
+  (setf (fref piececount 0) 13.)
+  (setf (fref piececount 1) 3)
+  (setf (fref piececount 2) 1)
+  (setf (fref piececount 3) 1)
+  (let ((m (+ 1 (the fixnum (* puzzle-d (the fixnum (+ 1 puzzle-d))))))
+	(n 0)(**kount** 0))
+    (declare (type fixnum m n **kount**))
+    (cond ((fit 0 m) (setq n (place 0 m)))
+	  (t (format t "~%Error.")))
+    (cond ((trial n) 
+	   (format t "~%Success in ~4D trials." **kount**))
+	  (t (format t "~%Failure.")))))
+
+(defun testpuzzle ()
+  (time (puzzle-start)))
diff --git a/src/gabriel/puzzle-mod2.cl b/src/gabriel/puzzle-mod2.cl
new file mode 100644
index 000000000..76e4a3d19
--- /dev/null
+++ b/src/gabriel/puzzle-mod2.cl
@@ -0,0 +1,185 @@
+;; $Header$
+;; $Locker$
+
+(eval-when (compile load eval)
+  (defconstant puzzle-size 511.)	
+  (defconstant puzzle-classmax 3.)
+  (defconstant puzzle-typemax 12.))
+
+(defvar **iii** 0)
+(defvar **kount** 0)
+(defvar puzzle-d 8.)
+(proclaim '(type fixnum **iii** **kount** puzzle-d))
+
+(defvar piececount (make-array (1+ puzzle-classmax) :element-type 'fixnum :initial-element 0))
+(defvar puzzle-class (make-array (1+ puzzle-typemax) :element-type 'fixnum :initial-element 0))
+(defvar piecemax (make-array (1+ puzzle-typemax) :element-type 'fixnum :initial-element 0))
+(defvar puzzle (make-array (1+ puzzle-size)))
+(defvar puzzle-p (make-array (list (1+ puzzle-typemax) (1+ puzzle-size))))
+
+(proclaim '(type (array fixnum) piececount puzzle-class piecemax))
+(defmacro fref (a i) `(the fixnum (aref ,a (the fixnum ,i))))
+
+
+(proclaim '(type simple-vector   puzzle))
+
+(proclaim '(type (simple-array t (#.(1+ puzzle-typemax) #.(1+ puzzle-size)))
+		 puzzle-p))
+
+(defun fit (i j)
+  (declare (type fixnum i j))
+  (let ((end (aref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end) t)
+      (declare (type fixnum k))
+      (cond ((aref puzzle-p i k)
+	     (cond ((aref puzzle (the fixnum (+ j k)))
+		    (return nil))))))))
+
+(proclaim '(function place (fixnum fixnum ) fixnum))
+(proclaim '(function puzzle-remove (fixnum fixnum) fixnum))
+(defun jil () 3)
+(defun place (i j)
+  (declare (type fixnum i j))
+  (let ((end (aref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end))
+      (declare (type fixnum k))
+      (cond ((aref puzzle-p i k) 
+	     (setf (aref puzzle (the fixnum (+ j k))) t))))
+    (setf (aref piececount (aref puzzle-class i)) 
+	  (the fixnum
+	       (- (the fixnum
+		       (aref piececount (aref puzzle-class i))) 1)))
+    (do ((k j (the fixnum (1+ k))))
+	((> k puzzle-size)
+	 (terpri)
+	 (princ "Puzzle filled")
+	 0)
+      (declare (type fixnum k))
+      (cond ((not (aref puzzle k))
+	     (return k))))))
+
+
+(defun puzzle-remove (i j)
+  (declare (type fixnum i j))
+  (let ((end (aref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end))
+	(declare (type fixnum k))
+	(cond ((aref puzzle-p i k)
+	       (setf (aref puzzle (the fixnum (+ j k)))  nil))))
+    (setf (aref piececount (aref puzzle-class i))
+	  (the fixnum
+	       (+ (the fixnum (aref piececount (aref puzzle-class i))) 1)))))
+
+(defun trial (j)
+  (declare (type fixnum j))
+  (let ((k 0))
+    (declare (type fixnum k))
+    (do ((i 0 (the fixnum (1+ i))))
+	((> i puzzle-typemax) 
+	 (setq **kount** (the fixnum (1+ **kount**))) nil)
+      (declare (type fixnum i))
+      (cond ((not (= (the fixnum (aref piececount (aref puzzle-class i))) 0))
+	     (cond ((fit i j)
+		    (setq k (place i j))
+		    (cond ((or (trial k)
+			       (= k 0))
+			   (setq **kount** (the fixnum (+ **kount** 1)))
+			   (return t))
+			  (t (puzzle-remove i j))))))))))
+
+(defun definepiece (iclass ii jj kk)
+  (declare (type fixnum ii jj kk))
+  (let ((index 0))
+    (declare (type fixnum index))
+    (do ((i 0 (the fixnum (1+ i))))
+	((> i ii))
+      (declare (type fixnum i))
+      (do ((j 0 (the fixnum (1+ j))))
+	  ((> j jj))
+	(declare (type fixnum j))
+	(do ((k 0 (the fixnum (1+ k))))
+	    ((> k kk))
+	  (declare (type fixnum k))
+	  (setq index  
+	    (+ i 
+	       (the fixnum 
+		    (* puzzle-d 
+		       (the fixnum 
+			    (+ j 
+			       (the fixnum 
+				    (* puzzle-d k))))))))
+	  (setf (aref puzzle-p **iii** index)  t))))
+    (setf (aref puzzle-class **iii**) iclass)
+    (setf (aref piecemax **iii**) index) 
+    (cond ((not (= **iii** puzzle-typemax))
+	   (setq **iii** (the fixnum (+ **iii** 1)))))))
+
+(defun puzzle-start ()
+  (do ((m 0 (the fixnum (1+ m))))
+      ((> m puzzle-size))
+    (declare (type fixnum m))
+    (setf (aref puzzle m) t))
+  (do ((i 1 (the fixnum (1+ i))))
+      ((> i 5))
+    (declare (type fixnum i))
+    (do ((j 1 (the fixnum (1+ j))))
+	((> j 5))
+      (declare (type fixnum j))
+      (do ((k 1 (the fixnum (1+ k))))
+	  ((> k 5))
+	(declare (type fixnum k))
+	(setf (aref puzzle 
+		    (+ i 
+		       (the fixnum
+			    (* puzzle-d 
+			       (the fixnum
+				    (+ j 
+				       (the fixnum
+					    (* puzzle-d k))))))))
+	      nil)))) 
+  (do ((i 0 (the fixnum (1+ i))))
+      ((> i puzzle-typemax))
+    (declare (type fixnum i))
+    (do ((m 0 (the fixnum (1+ m))))
+	((> m puzzle-size))
+      (declare (type fixnum m))
+      (setf (aref puzzle-p i m)  nil)))
+  (setq **iii** 0)
+  (definepiece 0 3 1 0)
+  (definepiece 0 1 0 3)
+  (definepiece 0 0 3 1)
+  (definepiece 0 1 3 0)
+  (definepiece 0 3 0 1)
+  (definepiece 0 0 1 3)
+  
+  (definepiece 1 2 0 0)
+  (definepiece 1 0 2 0)
+  (definepiece 1 0 0 2)
+  
+  (definepiece 2 1 1 0)
+  (definepiece 2 1 0 1)
+  (definepiece 2 0 1 1)
+  
+  (definepiece 3 1 1 1)
+  
+  (setf (aref piececount 0) 13.)
+  (setf (aref piececount 1) 3)
+  (setf (aref piececount 2) 1)
+  (setf (aref  piececount 3) 1)
+  (let ((m (+ 1 (the fixnum (* puzzle-d (the fixnum (+ 1 puzzle-d))))))
+	(n 0)(**kount** 0))
+    (declare (type fixnum m n **kount**))
+    (cond ((fit 0 m) (setq n (place 0 m)))
+	  (t (format t "~%Error.")))
+    (cond ((trial n) 
+	   (format t "~%Success in ~4D trials." **kount**))
+	  (t (format t "~%Failure.")))))
+
+(defun testpuzzle ()
+  (puzzle-start))
diff --git a/src/gabriel/puzzle.cl b/src/gabriel/puzzle.cl
new file mode 100644
index 000000000..f96d8cb05
--- /dev/null
+++ b/src/gabriel/puzzle.cl
@@ -0,0 +1,178 @@
+;; $Header$
+;; $Locker$
+
+(eval-when (compile load eval)
+  (defconstant puzzle-size 511.)	
+  (defconstant puzzle-classmax 3.)
+  (defconstant puzzle-typemax 12.))
+
+(defvar **iii** 0)
+(defvar **kount** 0)
+(defvar puzzle-d 8.)
+(proclaim '(type fixnum **iii** **kount** puzzle-d))
+
+(defvar piececount (make-array (1+ puzzle-classmax) :initial-element 0))
+(defvar puzzle-class (make-array (1+ puzzle-typemax) :initial-element 0))
+(defvar piecemax (make-array (1+ puzzle-typemax) :initial-element 0))
+(defvar puzzle (make-array (1+ puzzle-size)))
+(defvar puzzle-p (make-array (list (1+ puzzle-typemax) (1+ puzzle-size))))
+
+(proclaim '(type simple-vector 
+		 piececount puzzle-class piecemax puzzle))
+
+(proclaim '(type (simple-array t (#.(1+ puzzle-typemax) #.(1+ puzzle-size)))
+		 puzzle-p))
+		 
+(defun fit (i j)
+  (declare (type fixnum i j))
+  (let ((end (aref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end) t)
+      (declare (type fixnum k))
+      (cond ((aref puzzle-p i k)
+	     (cond ((aref puzzle (the fixnum (+ j k)))
+		    (return nil))))))))
+
+(defun place (i j)
+  (declare (type fixnum i j))
+  (let ((end (aref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end))
+      (declare (type fixnum k))
+      (cond ((aref puzzle-p i k) 
+	     (setf (aref puzzle (the fixnum (+ j k))) t))))
+    (setf (aref piececount (aref puzzle-class i)) 
+	  (the fixnum
+	       (- (the fixnum
+		       (aref piececount (aref puzzle-class i))) 1)))
+    (do ((k j (the fixnum (1+ k))))
+	((> k puzzle-size)
+	 (terpri)
+	 (princ "Puzzle filled")
+	 0)
+      (declare (type fixnum k))
+      (cond ((not (aref puzzle k))
+	     (return k))))))
+
+
+(defun puzzle-remove (i j)
+  (declare (type fixnum i j))
+  (let ((end (aref piecemax i)))
+    (declare (type fixnum end))
+    (do ((k 0 (the fixnum (1+ k))))
+	((> k end))
+      (declare (type fixnum k))
+      (cond ((aref puzzle-p i k)
+	     (setf (aref puzzle (the fixnum (+ j k)))  nil))))
+    (setf (aref piececount (aref puzzle-class i))
+	  (+ (the fixnum (aref piececount (aref puzzle-class i))) 1))))
+
+(defun trial (j)
+  (declare (type fixnum j))
+  (let ((k 0))
+    (declare (type fixnum k))
+    (do ((i 0 (the fixnum (1+ i))))
+	((> i puzzle-typemax) 
+	 (setq **kount** (the fixnum (1+ **kount**))) nil)
+      (declare (type fixnum i))
+      (cond ((not (= (the fixnum (aref piececount (aref puzzle-class i))) 0))
+	     (cond ((fit i j)
+		    (setq k (place i j))
+		    (cond ((or (trial k)
+			       (= k 0))
+			   (setq **kount** (the fixnum (+ **kount** 1)))
+			   (return t))
+			  (t (puzzle-remove i j))))))))))
+
+(defun definepiece (iclass ii jj kk)
+  (declare (type fixnum ii jj kk))
+  (let ((index 0))
+    (declare (type fixnum index))
+    (do ((i 0 (the fixnum (1+ i))))
+	((> i ii))
+      (declare (type fixnum i))
+      (do ((j 0 (the fixnum (1+ j))))
+	  ((> j jj))
+	(declare (type fixnum j))
+	(do ((k 0 (the fixnum (1+ k))))
+	    ((> k kk))
+	  (declare (type fixnum k))
+	  (setq index  
+	    (+ i 
+	       (the fixnum 
+		    (* puzzle-d 
+		       (the fixnum 
+			    (+ j 
+			       (the fixnum 
+				    (* puzzle-d k))))))))
+	  (setf (aref puzzle-p **iii** index)  t))))
+    (setf (aref puzzle-class **iii**) iclass)
+    (setf (aref piecemax **iii**) index) 
+    (cond ((not (= **iii** puzzle-typemax))
+	   (setq **iii** (the fixnum (+ **iii** 1)))))))
+
+(defun puzzle-start ()
+  (do ((m 0 (the fixnum (1+ m))))
+      ((> m puzzle-size))
+    (declare (type fixnum m))
+    (setf (aref puzzle m) t))
+  (do ((i 1 (the fixnum (1+ i))))
+      ((> i 5))
+    (declare (type fixnum i))
+    (do ((j 1 (the fixnum (1+ j))))
+	((> j 5))
+      (declare (type fixnum j))
+      (do ((k 1 (the fixnum (1+ k))))
+	  ((> k 5))
+	(declare (type fixnum k))
+	(setf (aref puzzle 
+		    (+ i 
+		       (the fixnum
+			    (* puzzle-d 
+			       (the fixnum
+				    (+ j 
+				       (the fixnum
+					    (* puzzle-d k))))))))
+	      nil)))) 
+  (do ((i 0 (the fixnum (1+ i))))
+      ((> i puzzle-typemax))
+    (declare (type fixnum i))
+    (do ((m 0 (the fixnum (1+ m))))
+	((> m puzzle-size))
+      (declare (type fixnum m))
+      (setf (aref puzzle-p i m)  nil)))
+  (setq **iii** 0)
+  (definepiece 0 3 1 0)
+  (definepiece 0 1 0 3)
+  (definepiece 0 0 3 1)
+  (definepiece 0 1 3 0)
+  (definepiece 0 3 0 1)
+  (definepiece 0 0 1 3)
+  
+  (definepiece 1 2 0 0)
+  (definepiece 1 0 2 0)
+  (definepiece 1 0 0 2)
+  
+  (definepiece 2 1 1 0)
+  (definepiece 2 1 0 1)
+  (definepiece 2 0 1 1)
+  
+  (definepiece 3 1 1 1)
+  
+  (setf (aref piececount 0) 13.)
+  (setf (aref piececount 1) 3)
+  (setf (aref piececount 2) 1)
+  (setf (aref piececount 3) 1)
+  (let ((m (+ 1 (the fixnum (* puzzle-d (the fixnum (+ 1 puzzle-d))))))
+	(n 0)(**kount** 0))
+    (declare (type fixnum m n **kount**))
+    (cond ((fit 0 m) (setq n (place 0 m)))
+	  (t (format t "~%Error.")))
+    (cond ((trial n) 
+	   (format t "~%Success in ~4D trials." **kount**))
+	  (t (format t "~%Failure.")))))
+
+(defun testpuzzle ()
+  (puzzle-start))
diff --git a/src/gabriel/results b/src/gabriel/results
new file mode 100644
index 000000000..3ebde48cd
--- /dev/null
+++ b/src/gabriel/results
@@ -0,0 +1,61 @@
+I added some more optimizers to fix things I noticed--wfs.
+
+
+browse.cl Errors in code: There was an eq char compare test which
+should have been eql for common lisp.  Corrected this.
+
+akcl run time  : 25.500 secs
+with
+(allocate-relocatable-pages 70)
+(allocate 'cons 1300 t)
+(allocate 'symbol 200 t)
+Lucid time 27 seconds (about 4 meg of space allocated).
+
+-----------------
+
+
+traverse init
+run time  : 4.200 secs
+traverse run
+run time  : 34.950 secs
+
+lucid:
+Total cpu time = 4460 milliseconds
+Total cpu time = 34920 milliseconds
+
+
+-------------------------
+
+
+deriv
+
+For lucid:
+(time (dotimes (i 5) (testderiv)))
+Total cpu time = 35480 milliseconds
+
+kcl:
+(allocate 'cons 2000 t)
+(time (dotimes (i 5) (testderiv)))
+run time  : 33.167 secs
+I did  at the start which seemed to be roughly
+what lucid was grabbing.   It gc'd several times in both implementations.
+
+ps:
+run time  : 49.300 secs instead of 33.2 secs. in the old akcl.
+
+
+------------------
+
+I changed the fixnum declarations for the three arrays a b c,
+and the function try.  These actually slowed lucid down,
+so we include the times for lucid using its own declarations.
+
+triang-mod.cl  
+
+kcl:  run time  : 137.850 secs
+on triang.cl
+lucid: Total cpu time = 136940 milliseconds
+On triang-mod.cl
+lucid: Total cpu time = 258900 milliseconds
+
+(kcl using the lucid declarations was around 234. seconds I think)
diff --git a/src/gabriel/stak.cl b/src/gabriel/stak.cl
new file mode 100644
index 000000000..673c04e78
--- /dev/null
+++ b/src/gabriel/stak.cl
@@ -0,0 +1,33 @@
+;; $Header$
+;; $Locker$
+
+;;; STAK -- The TAKeuchi function with special variables instead of
+;;; parameter passing.
+
+(defvar stak-x)
+(defvar stak-y)
+(defvar stak-z)
+(proclaim '(fixnum stak-x stak-y stak-z))
+
+(defun stak (stak-x stak-y stak-z)
+  (stak-aux))
+
+(defun stak-aux ()
+  (if (not (< stak-y stak-x))
+      stak-z
+    (let ((stak-x (let ((stak-x (the fixnum (1- stak-x)))
+			(stak-y stak-y)
+			(stak-z stak-z))
+		    (stak-aux)))
+	  (stak-y (let ((stak-x (the fixnum (1- stak-y)))
+			(stak-y stak-z)
+			(stak-z stak-x))
+		    (stak-aux)))
+	  (stak-z (let ((stak-x (the fixnum (1- stak-z)))
+			(stak-y stak-x)
+			(stak-z stak-y))
+		    (stak-aux))))
+      (stak-aux))))
+
+(defun teststak ()
+  (stak 18 12 6))
diff --git a/src/gabriel/tak-mod.cl b/src/gabriel/tak-mod.cl
new file mode 100644
index 000000000..310487405
--- /dev/null
+++ b/src/gabriel/tak-mod.cl
@@ -0,0 +1,30 @@
+;; $Header$
+;; $Locker$
+
+#+excl
+(eval-when (compile) (setq comp::register-use-threshold 6))
+
+(proclaim '(function tak (fixnum fixnum fixnum) fixnum))
+
+(defun tak (x y z)
+  (declare (fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t
+	 (tak
+	   (tak (the fixnum (1- x)) y z)
+	   (tak (the fixnum (1- y)) z x)
+	   (tak (the fixnum (1- z)) x y)))))
+
+(defun testtak ()
+  (progn (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)))
+
+#+excl (eval-when (compile) (setq comp::register-use-threshold 3))
diff --git a/src/gabriel/tak.cl b/src/gabriel/tak.cl
new file mode 100644
index 000000000..88874e1c8
--- /dev/null
+++ b/src/gabriel/tak.cl
@@ -0,0 +1,28 @@
+;; $Header$
+;; $Locker$
+
+#+excl
+(eval-when (compile) (setq comp::register-use-threshold 6))
+
+(defun tak (x y z)
+  (declare (fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t
+	 (tak
+	   (tak (the fixnum (1- x)) y z)
+	   (tak (the fixnum (1- y)) z x)
+	   (tak (the fixnum (1- z)) x y)))))
+
+(defun testtak ()
+  (progn (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)
+	 (tak 18 12 6)))
+
+#+excl (eval-when (compile) (setq comp::register-use-threshold 3))
diff --git a/src/gabriel/takl.cl b/src/gabriel/takl.cl
new file mode 100644
index 000000000..2d15be7d5
--- /dev/null
+++ b/src/gabriel/takl.cl
@@ -0,0 +1,27 @@
+;; $Header$
+;; $Locker$
+
+;;; TAKL -- The TAKeuchi function using lists as counters.
+
+(defun listn (n)
+  (declare (type fixnum n))
+  (if (not (= 0 n))
+      (cons n (listn (the fixnum (1- n))))))
+
+(defvar 18l (listn 18))
+(defvar 12l (listn 12))
+(defvar  6l (listn 6))
+
+(defun mas (x y z)
+  (if (not (shorterp y x))
+      z
+    (mas (mas (cdr x) y z)
+	 (mas (cdr y) z x)
+	 (mas (cdr z) x y))))
+
+(defun shorterp (x y)
+  (and y (or (null x)
+	     (shorterp (cdr x) (cdr y)))))
+
+(defun testtakl ()
+  (mas 18l 12l 6l))
diff --git a/src/gabriel/takr.cl b/src/gabriel/takr.cl
new file mode 100644
index 000000000..c728621f3
--- /dev/null
+++ b/src/gabriel/takr.cl
@@ -0,0 +1,611 @@
+;; $Header$
+;; $Locker$
+
+;;; TAKR  -- 100 function (count `em) version of TAK that tries to defeat cache
+;;; memory effects.  Results should be the same as for TAK on stack machines.
+;;; Distribution of calls is not completely flat.
+
+(defun tak0 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak1 (tak37 (the fixnum (1- x)) y z)
+		 (tak11 (the fixnum (1- y)) z x)
+		 (tak17 (the fixnum (1- z)) x y)))))
+(defun tak1 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak2 (tak74 (the fixnum (1- x)) y z)
+		 (tak22 (the fixnum (1- y)) z x)
+		 (tak34 (the fixnum (1- z)) x y)))))
+(defun tak2 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak3 (tak11 (the fixnum (1- x)) y z)
+		 (tak33 (the fixnum (1- y)) z x)
+		 (tak51 (the fixnum (1- z)) x y)))))
+(defun tak3 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak4 (tak48 (the fixnum (1- x)) y z)
+		 (tak44 (the fixnum (1- y)) z x)
+		 (tak68 (the fixnum (1- z)) x y)))))
+(defun tak4 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak5 (tak85 (the fixnum (1- x)) y z)
+		 (tak55 (the fixnum (1- y)) z x)
+		 (tak85 (the fixnum (1- z)) x y)))))
+(defun tak5 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak6 (tak22 (the fixnum (1- x)) y z)
+		 (tak66 (the fixnum (1- y)) z x)
+		 (tak2 (the fixnum (1- z)) x y)))))
+(defun tak6 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak7 (tak59 (the fixnum (1- x)) y z)
+		 (tak77 (the fixnum (1- y)) z x)
+		 (tak19 (the fixnum (1- z)) x y)))))
+(defun tak7 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak8 (tak96 (the fixnum (1- x)) y z)
+		 (tak88 (the fixnum (1- y)) z x)
+		 (tak36 (the fixnum (1- z)) x y)))))
+(defun tak8 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak9 (tak33 (the fixnum (1- x)) y z)
+		 (tak99 (the fixnum (1- y)) z x)
+		 (tak53 (the fixnum (1- z)) x y)))))
+(defun tak9 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak10 (tak70 (the fixnum (1- x)) y z)
+		  (tak10 (the fixnum (1- y)) z x)
+		  (tak70 (the fixnum (1- z)) x y)))))
+(defun tak10 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak11 (tak7 (the fixnum (1- x)) y z)
+		  (tak21 (the fixnum (1- y)) z x)
+		  (tak87 (the fixnum (1- z)) x y)))))
+(defun tak11 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak12 (tak44 (the fixnum (1- x)) y z)
+		  (tak32 (the fixnum (1- y)) z x)
+		  (tak4 (the fixnum (1- z)) x y)))))
+(defun tak12 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak13 (tak81 (the fixnum (1- x)) y z)
+		  (tak43 (the fixnum (1- y)) z x)
+		  (tak21 (the fixnum (1- z)) x y)))))
+
+(defun tak13 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak14 (tak18 (the fixnum (1- x)) y z)
+		  (tak54 (the fixnum (1- y)) z x)
+		  (tak38 (the fixnum (1- z)) x y)))))
+(defun tak14 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak15 (tak55 (the fixnum (1- x)) y z)
+		  (tak65 (the fixnum (1- y)) z x)
+		  (tak55 (the fixnum (1- z)) x y)))))
+(defun tak15 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak16 (tak92 (the fixnum (1- x)) y z)
+		  (tak76 (the fixnum (1- y)) z x)
+		  (tak72 (the fixnum (1- z)) x y)))))
+(defun tak16 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak17 (tak29 (the fixnum (1- x)) y z)
+		  (tak87 (the fixnum (1- y)) z x)
+		  (tak89 (the fixnum (1- z)) x y)))))
+(defun tak17 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak18 (tak66 (the fixnum (1- x)) y z)
+		  (tak98 (the fixnum (1- y)) z x)
+		  (tak6 (the fixnum (1- z)) x y)))))
+(defun tak18 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak19 (tak3 (the fixnum (1- x)) y z)
+		  (tak9 (the fixnum (1- y)) z x)
+		  (tak23 (the fixnum (1- z)) x y)))))
+(defun tak19 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak20 (tak40 (the fixnum (1- x)) y z)
+		  (tak20 (the fixnum (1- y)) z x)
+		  (tak40 (the fixnum (1- z)) x y)))))
+(defun tak20 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak21 (tak77 (the fixnum (1- x)) y z)
+		  (tak31 (the fixnum (1- y)) z x)
+		  (tak57 (the fixnum (1- z)) x y)))))
+(defun tak21 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak22 (tak14 (the fixnum (1- x)) y z)
+		  (tak42 (the fixnum (1- y)) z x)
+		  (tak74 (the fixnum (1- z)) x y)))))
+(defun tak22 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak23 (tak51 (the fixnum (1- x)) y z)
+		  (tak53 (the fixnum (1- y)) z x)
+		  (tak91 (the fixnum (1- z)) x y)))))
+(defun tak23 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak24 (tak88 (the fixnum (1- x)) y z)
+		  (tak64 (the fixnum (1- y)) z x)
+		  (tak8 (the fixnum (1- z)) x y)))))
+(defun tak24 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak25 (tak25 (the fixnum (1- x)) y z)
+		  (tak75 (the fixnum (1- y)) z x)
+		  (tak25 (the fixnum (1- z)) x y)))))
+(defun tak25 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak26 (tak62 (the fixnum (1- x)) y z)
+		  (tak86 (the fixnum (1- y)) z x)
+		  (tak42 (the fixnum (1- z)) x y)))))
+(defun tak26 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak27 (tak99 (the fixnum (1- x)) y z)
+		  (tak97 (the fixnum (1- y)) z x)
+		  (tak59 (the fixnum (1- z)) x y)))))
+(defun tak27 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak28 (tak36 (the fixnum (1- x)) y z)
+		  (tak8 (the fixnum (1- y)) z x)
+		  (tak76 (the fixnum (1- z)) x y)))))
+(defun tak28 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak29 (tak73 (the fixnum (1- x)) y z)
+		  (tak19 (the fixnum (1- y)) z x)
+		  (tak93 (the fixnum (1- z)) x y)))))
+(defun tak29 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak30 (tak10 (the fixnum (1- x)) y z)
+		  (tak30 (the fixnum (1- y)) z x)
+		  (tak10 (the fixnum (1- z)) x y)))))
+(defun tak30 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak31 (tak47 (the fixnum (1- x)) y z)
+		  (tak41 (the fixnum (1- y)) z x)
+		  (tak27 (the fixnum (1- z)) x y)))))
+(defun tak31 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak32 (tak84 (the fixnum (1- x)) y z)
+		  (tak52 (the fixnum (1- y)) z x)
+		  (tak44 (the fixnum (1- z)) x y)))))
+(defun tak32 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak33 (tak21 (the fixnum (1- x)) y z)
+		  (tak63 (the fixnum (1- y)) z x)
+		  (tak61 (the fixnum (1- z)) x y)))))
+(defun tak33 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak34 (tak58 (the fixnum (1- x)) y z)
+		  (tak74 (the fixnum (1- y)) z x)
+		  (tak78 (the fixnum (1- z)) x y)))))
+(defun tak34 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak35 (tak95 (the fixnum (1- x)) y z)
+		  (tak85 (the fixnum (1- y)) z x)
+		  (tak95 (the fixnum (1- z)) x y)))))
+(defun tak35 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak36 (tak32 (the fixnum (1- x)) y z)
+		  (tak96 (the fixnum (1- y)) z x)
+		  (tak12 (the fixnum (1- z)) x y)))))
+(defun tak36 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak37 (tak69 (the fixnum (1- x)) y z)
+		  (tak7 (the fixnum (1- y)) z x)
+		  (tak29 (the fixnum (1- z)) x y)))))
+(defun tak37 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak38 (tak6 (the fixnum (1- x)) y z)
+		  (tak18 (the fixnum (1- y)) z x)
+		  (tak46 (the fixnum (1- z)) x y)))))
+(defun tak38 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak39 (tak43 (the fixnum (1- x)) y z)
+		  (tak29 (the fixnum (1- y)) z x)
+		  (tak63 (the fixnum (1- z)) x y)))))
+(defun tak39 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak40 (tak80 (the fixnum (1- x)) y z)
+		  (tak40 (the fixnum (1- y)) z x)
+		  (tak80 (the fixnum (1- z)) x y)))))
+(defun tak40 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak41 (tak17 (the fixnum (1- x)) y z)
+		  (tak51 (the fixnum (1- y)) z x)
+		  (tak97 (the fixnum (1- z)) x y)))))
+(defun tak41 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak42 (tak54 (the fixnum (1- x)) y z)
+		  (tak62 (the fixnum (1- y)) z x)
+		  (tak14 (the fixnum (1- z)) x y)))))
+(defun tak42 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak43 (tak91 (the fixnum (1- x)) y z)
+		  (tak73 (the fixnum (1- y)) z x)
+		  (tak31 (the fixnum (1- z)) x y)))))
+(defun tak43 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak44 (tak28 (the fixnum (1- x)) y z)
+		  (tak84 (the fixnum (1- y)) z x)
+		  (tak48 (the fixnum (1- z)) x y)))))
+(defun tak44 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak45 (tak65 (the fixnum (1- x)) y z)
+		  (tak95 (the fixnum (1- y)) z x)
+		  (tak65 (the fixnum (1- z)) x y)))))
+(defun tak45 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak46 (tak2 (the fixnum (1- x)) y z)
+		  (tak6 (the fixnum (1- y)) z x)
+		  (tak82 (the fixnum (1- z)) x y)))))
+(defun tak46 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak47 (tak39 (the fixnum (1- x)) y z)
+		  (tak17 (the fixnum (1- y)) z x)
+		  (tak99 (the fixnum (1- z)) x y)))))
+(defun tak47 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak48 (tak76 (the fixnum (1- x)) y z)
+		  (tak28 (the fixnum (1- y)) z x)
+		  (tak16 (the fixnum (1- z)) x y)))))
+(defun tak48 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak49 (tak13 (the fixnum (1- x)) y z)
+		  (tak39 (the fixnum (1- y)) z x)
+		  (tak33 (the fixnum (1- z)) x y)))))
+(defun tak49 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak50 (tak50 (the fixnum (1- x)) y z)
+		  (tak50 (the fixnum (1- y)) z x)
+		  (tak50 (the fixnum (1- z)) x y)))))
+(defun tak50 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak51 (tak87 (the fixnum (1- x)) y z)
+		  (tak61 (the fixnum (1- y)) z x)
+		  (tak67 (the fixnum (1- z)) x y)))))
+(defun tak51 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak52 (tak24 (the fixnum (1- x)) y z)
+		  (tak72 (the fixnum (1- y)) z x)
+		  (tak84 (the fixnum (1- z)) x y)))))
+(defun tak52 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak53 (tak61 (the fixnum (1- x)) y z)
+		  (tak83 (the fixnum (1- y)) z x)
+		  (tak1 (the fixnum (1- z)) x y)))))
+(defun tak53 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak54 (tak98 (the fixnum (1- x)) y z)
+		  (tak94 (the fixnum (1- y)) z x)
+		  (tak18 (the fixnum (1- z)) x y)))))
+(defun tak54 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak55 (tak35 (the fixnum (1- x)) y z)
+		  (tak5 (the fixnum (1- y)) z x)
+		  (tak35 (the fixnum (1- z)) x y)))))
+(defun tak55 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak56 (tak72 (the fixnum (1- x)) y z)
+		  (tak16 (the fixnum (1- y)) z x)
+		  (tak52 (the fixnum (1- z)) x y)))))
+(defun tak56 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak57 (tak9 (the fixnum (1- x)) y z)
+		  (tak27 (the fixnum (1- y)) z x)
+		  (tak69 (the fixnum (1- z)) x y)))))
+(defun tak57 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak58 (tak46 (the fixnum (1- x)) y z)
+		  (tak38 (the fixnum (1- y)) z x)
+		  (tak86 (the fixnum (1- z)) x y)))))
+(defun tak58 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak59 (tak83 (the fixnum (1- x)) y z)
+		  (tak49 (the fixnum (1- y)) z x)
+		  (tak3 (the fixnum (1- z)) x y)))))
+(defun tak59 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak60 (tak20 (the fixnum (1- x)) y z)
+		  (tak60 (the fixnum (1- y)) z x)
+		  (tak20 (the fixnum (1- z)) x y)))))
+(defun tak60 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak61 (tak57 (the fixnum (1- x)) y z)
+		  (tak71 (the fixnum (1- y)) z x)
+		  (tak37 (the fixnum (1- z)) x y)))))
+(defun tak61 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak62 (tak94 (the fixnum (1- x)) y z)
+		  (tak82 (the fixnum (1- y)) z x)
+		  (tak54 (the fixnum (1- z)) x y)))))
+(defun tak62 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak63 (tak31 (the fixnum (1- x)) y z)
+		  (tak93 (the fixnum (1- y)) z x)
+		  (tak71 (the fixnum (1- z)) x y)))))
+(defun tak63 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak64 (tak68 (the fixnum (1- x)) y z)
+		  (tak4 (the fixnum (1- y)) z x)
+		  (tak88 (the fixnum (1- z)) x y)))))
+(defun tak64 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak65 (tak5 (the fixnum (1- x)) y z)
+		  (tak15 (the fixnum (1- y)) z x)
+		  (tak5 (the fixnum (1- z)) x y)))))
+(defun tak65 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak66 (tak42 (the fixnum (1- x)) y z)
+		  (tak26 (the fixnum (1- y)) z x)
+		  (tak22 (the fixnum (1- z)) x y)))))
+(defun tak66 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak67 (tak79 (the fixnum (1- x)) y z)
+		  (tak37 (the fixnum (1- y)) z x)
+		  (tak39 (the fixnum (1- z)) x y)))))
+(defun tak67 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak68 (tak16 (the fixnum (1- x)) y z)
+		  (tak48 (the fixnum (1- y)) z x)
+		  (tak56 (the fixnum (1- z)) x y)))))
+(defun tak68 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak69 (tak53 (the fixnum (1- x)) y z)
+		  (tak59 (the fixnum (1- y)) z x)
+		  (tak73 (the fixnum (1- z)) x y)))))
+(defun tak69 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak70 (tak90 (the fixnum (1- x)) y z)
+		  (tak70 (the fixnum (1- y)) z x)
+		  (tak90 (the fixnum (1- z)) x y)))))
+(defun tak70 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak71 (tak27 (the fixnum (1- x)) y z)
+		  (tak81 (the fixnum (1- y)) z x)
+		  (tak7 (the fixnum (1- z)) x y)))))
+(defun tak71 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak72 (tak64 (the fixnum (1- x)) y z)
+		  (tak92 (the fixnum (1- y)) z x)
+		  (tak24 (the fixnum (1- z)) x y)))))
+(defun tak72 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak73 (tak1 (the fixnum (1- x)) y z)
+		  (tak3 (the fixnum (1- y)) z x)
+		  (tak41 (the fixnum (1- z)) x y)))))
+(defun tak73 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak74 (tak38 (the fixnum (1- x)) y z)
+		  (tak14 (the fixnum (1- y)) z x)
+		  (tak58 (the fixnum (1- z)) x y)))))
+(defun tak74 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak75 (tak75 (the fixnum (1- x)) y z)
+		  (tak25 (the fixnum (1- y)) z x)
+		  (tak75 (the fixnum (1- z)) x y)))))
+(defun tak75 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak76 (tak12 (the fixnum (1- x)) y z)
+		  (tak36 (the fixnum (1- y)) z x)
+		  (tak92 (the fixnum (1- z)) x y)))))
+(defun tak76 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak77 (tak49 (the fixnum (1- x)) y z)
+		  (tak47 (the fixnum (1- y)) z x)
+		  (tak9 (the fixnum (1- z)) x y)))))
+(defun tak77 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak78 (tak86 (the fixnum (1- x)) y z)
+		  (tak58 (the fixnum (1- y)) z x)
+		  (tak26 (the fixnum (1- z)) x y)))))
+(defun tak78 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak79 (tak23 (the fixnum (1- x)) y z)
+		  (tak69 (the fixnum (1- y)) z x)
+		  (tak43 (the fixnum (1- z)) x y)))))
+(defun tak79 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak80 (tak60 (the fixnum (1- x)) y z)
+		  (tak80 (the fixnum (1- y)) z x)
+		  (tak60 (the fixnum (1- z)) x y)))))
+(defun tak80 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak81 (tak97 (the fixnum (1- x)) y z)
+		  (tak91 (the fixnum (1- y)) z x)
+		  (tak77 (the fixnum (1- z)) x y)))))
+(defun tak81 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak82 (tak34 (the fixnum (1- x)) y z)
+		  (tak2 (the fixnum (1- y)) z x)
+		  (tak94 (the fixnum (1- z)) x y)))))
+(defun tak82 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak83 (tak71 (the fixnum (1- x)) y z)
+		  (tak13 (the fixnum (1- y)) z x)
+		  (tak11 (the fixnum (1- z)) x y)))))
+(defun tak83 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak84 (tak8 (the fixnum (1- x)) y z)
+		  (tak24 (the fixnum (1- y)) z x)
+		  (tak28 (the fixnum (1- z)) x y)))))
+(defun tak84 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak85 (tak45 (the fixnum (1- x)) y z)
+		  (tak35 (the fixnum (1- y)) z x)
+		  (tak45 (the fixnum (1- z)) x y)))))
+(defun tak85 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak86 (tak82 (the fixnum (1- x)) y z)
+		  (tak46 (the fixnum (1- y)) z x)
+		  (tak62 (the fixnum (1- z)) x y)))))
+(defun tak86 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak87 (tak19 (the fixnum (1- x)) y z)
+		  (tak57 (the fixnum (1- y)) z x)
+		  (tak79 (the fixnum (1- z)) x y)))))
+(defun tak87 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak88 (tak56 (the fixnum (1- x)) y z)
+		  (tak68 (the fixnum (1- y)) z x)
+		  (tak96 (the fixnum (1- z)) x y)))))
+(defun tak88 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak89 (tak93 (the fixnum (1- x)) y z)
+		  (tak79 (the fixnum (1- y)) z x)
+		  (tak13 (the fixnum (1- z)) x y)))))
+(defun tak89 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak90 (tak30 (the fixnum (1- x)) y z)
+		  (tak90 (the fixnum (1- y)) z x)
+		  (tak30 (the fixnum (1- z)) x y)))))
+(defun tak90 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak91 (tak67 (the fixnum (1- x)) y z)
+		  (tak1 (the fixnum (1- y)) z x)
+		  (tak47 (the fixnum (1- z)) x y)))))
+(defun tak91 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak92 (tak4 (the fixnum (1- x)) y z)
+		  (tak12 (the fixnum (1- y)) z x)
+		  (tak64 (the fixnum (1- z)) x y)))))
+(defun tak92 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak93 (tak41 (the fixnum (1- x)) y z)
+		  (tak23 (the fixnum (1- y)) z x)
+		  (tak81 (the fixnum (1- z)) x y)))))
+(defun tak93 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak94 (tak78 (the fixnum (1- x)) y z)
+		  (tak34 (the fixnum (1- y)) z x)
+		  (tak98 (the fixnum (1- z)) x y)))))
+(defun tak94 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak95 (tak15 (the fixnum (1- x)) y z)
+		  (tak45 (the fixnum (1- y)) z x)
+		  (tak15 (the fixnum (1- z)) x y)))))
+(defun tak95 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak96 (tak52 (the fixnum (1- x)) y z)
+		  (tak56 (the fixnum (1- y)) z x)
+		  (tak32 (the fixnum (1- z)) x y)))))
+(defun tak96 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak97 (tak89 (the fixnum (1- x)) y z)
+		  (tak67 (the fixnum (1- y)) z x)
+		  (tak49 (the fixnum (1- z)) x y)))))
+(defun tak97 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak98 (tak26 (the fixnum (1- x)) y z)
+		  (tak78 (the fixnum (1- y)) z x)
+		  (tak66 (the fixnum (1- z)) x y)))))
+(defun tak98 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak99 (tak63 (the fixnum (1- x)) y z)
+		  (tak89 (the fixnum (1- y)) z x)
+		  (tak83 (the fixnum (1- z)) x y)))))
+(defun tak99 (x y z) 
+  (declare (type fixnum x y z))
+  (cond ((not (< y x)) z)
+	(t (tak0 (tak0 (the fixnum (1- x)) y z)
+		 (tak0 (the fixnum (1- y)) z x)
+		 (tak0 (the fixnum (1- z)) x y)))))
+
+(defun testtakr ()
+  (tak0 18 12 6))
diff --git a/src/gabriel/test-help.lsp b/src/gabriel/test-help.lsp
new file mode 100644
index 000000000..7deede123
--- /dev/null
+++ b/src/gabriel/test-help.lsp
@@ -0,0 +1,141 @@
+(in-package "CL-USER")
+
+#+clisp
+(defmacro with-ignored-errors (&rest forms)
+  (let ((b (gensym)))
+    `(block ,b
+       (let ((*error-handler*
+               #'(lambda (&rest args) (return-from ,b 'error))
+            ))
+         ,@forms
+     ) )
+) )
+
+#+akcl
+(defmacro with-ignored-errors (&rest forms)
+  (let ((b (gensym))
+        (h (gensym)))
+    `(block ,b
+       (let ((,h (symbol-function 'system:universal-error-handler)))
+         (unwind-protect
+           (progn (setf (symbol-function 'system:universal-error-handler)
+                        #'(lambda (&rest args) (return-from ,b 'error))
+                  )
+                  ,@forms
+           )
+           (setf (symbol-function 'system:universal-error-handler) ,h)
+     ) ) )
+) )
+
+#+allegro
+(defmacro with-ignored-errors (&rest forms)
+  (let ((r (gensym)))
+    `(let ((,r (multiple-value-list (excl:errorset (progn ,@forms)))))
+       (if (car ,r) (values-list (cdr ,r)) 'error)
+     )
+) )
+
+#-(or clisp akcl allegro)
+(defmacro with-ignored-errors (&rest forms)
+  (let ((b (gensym)))
+    `(block ,b
+       (handler-bind
+         ((error #'(lambda (condition) (return-from ,b 'error))))
+         ,@forms
+     ) )
+) )
+
+(defvar *source-dir* "./")
+(defvar *output-dir* "./")
+
+(defconstant +all-tests+ '("boyer" "browse" "ctak" "dderiv" "deriv"
+			   "destru-mod" "destru" "div2"
+			   "fprint" "fread" "frpoly"
+			   "puzzle" "puzzle-mod" "puzzle-mod2"
+			   "stak" "tak" "tak-mod" "takl" "takr"
+			   "tprint" "traverse" "triang-mod" "triang"
+			   ;; These two are at the end because they cause
+			   ;; SIGSEGVS in ECLS.
+			   #+nil"fft-mod" #+nil"fft"))
+
+(defconstant +repeats+ '(("destru" 4)("destru-mod" 4)("fprint" 4)("fread" 4)
+			 ("stak" 4)("takr" 4)("tprint" 4)))
+
+#+(or (and ecls (not boehm-gc)) cmu)
+(setq system::*gc-verbose* nil)
+
+(defun do-test (file &key (repeat 1 given) compile &aux tem)
+  (when (find-package "TESTING")
+    (delete-package "TESTING"))
+  #+cmu
+  (gc :full t)
+  #+clisp
+  (system::gc)
+  #+ecls
+  (system::gc t)
+  (let ((source-file (merge-pathnames (merge-pathnames file *source-dir*)
+				      "foo.cl"))
+	(fasl-file (compile-file-pathname (merge-pathnames file *output-dir*)))
+	(*package* (make-package "TESTING")))
+    (cond (compile
+	   (proclaim-file source-file)
+	   (compile-file source-file :output-file fasl-file
+			 #+ecls :c-file #+ecls t #+ecls :h-file #+ecls t)
+	   (load fasl-file))
+	  (t
+	   (load source-file)))
+    (if (and (not given)
+	     (setq tem (assoc file +repeats+ :test 'equalp)))
+      (setq repeat (second tem)))
+    (let* ((pos (position #\- file))
+	   (name (if pos (subseq file 0 pos) file))
+	   (command (intern (string-upcase (format nil "TEST~a" name))))
+	   (start (get-internal-run-time)))
+      (dotimes (i repeat) (funcall command))
+      (setq start (- (get-internal-run-time) start))
+      (/ (float start) (* (float internal-time-units-per-second) repeat)))))
+
+
+(defun do-all-tests (name *source-dir* *output-dir* &optional (compile nil))
+  (with-open-file (st name :direction :output
+		      :if-does-not-exist :create
+		      :if-exists :supersede)
+    (print (cons name (mapcar #'(lambda (name)
+				  (with-ignored-errors
+				      (do-test name :compile compile)))
+			      +all-tests+))
+	   st)))
+
+(defun beautify-output (output)
+  (let ((data nil) (envs 0) (tests 0))
+    (do ((item (read) (read)))
+	((null item))
+      (push item data))
+    (setq envs (length data)
+	  tests (length (car data))
+	  data (make-array (list (1+ envs) tests)
+			   :initial-contents (cons (cons "" +all-tests+) data)))
+    (with-open-file (st output :direction :output :if-exists :append
+			:if-does-not-exist :create)
+      (dotimes (row tests)
+	(dotimes (col (1+ envs))
+	  (let ((data (aref data col row)))
+	    (cond ((zerop col)
+		   (format st "~%~12a" data))
+		  ((numberp data)
+		   (format st "   ~7,3f" data))
+		  ((eq data 'ERROR)
+		   (format st "     *****"))
+		  (t
+		   (format st "   ~7<~a~>" data))))))
+      (format st "
+
+IMPLi = Implementation IMPL interpreted
+IMPLc = Implementation IMPL compiled
+
+CLISP = CLISP 2000-03-06 (March 2000)
+CMUCL = CMUCL 18c
+ECLS  = ECLS ~A
+" (lisp-implementation-version))
+      (terpri st))
+    (quit)))
diff --git a/src/gabriel/times b/src/gabriel/times
new file mode 100644
index 000000000..de0e09c69
--- /dev/null
+++ b/src/gabriel/times
@@ -0,0 +1,645 @@
+
+       For skcl Common Lisp
+Thu Apr  7 10:47:59 CDT 1988
+
+BOYER        12.350 sec.
+BROWSE       32.467 sec.
+CTAK         7.200 sec.
+DDERIV       7.883 sec.
+DERIV        6.417 sec.
+DESTRU       2.917 sec.
+DIV2         5.550 sec.
+FFT-MOD      23.167 sec.
+FFT          65.000 sec.
+FPRINT       1.783 sec.
+FREAD        2.600 sec.
+FRPOLY       86.183 sec.
+PUZZLE-MOD   7.200 sec.
+PUZZLE       8.233 sec.
+STAK         3.733 sec.
+TAK          6.467 sec.
+TAKL         2.667 sec.
+TAKR         1.017 sec.
+TPRINT       3.183 sec.
+TRAVERSE     44.100 sec.
+TRIANG-MOD   139.117 sec.
+TRIANG	     149.900 sec.
+
+--------------   SESSION   ------------------
+
+       For lucid Common Lisp
+Thu Apr  7 11:12:44 CDT 1988
+
+BOYER        15.160 sec.
+BROWSE       29.560 sec.
+CTAK         2.160 sec.
+DDERIV       9.260 sec.
+DERIV        8.200 sec.
+DESTRU       1.720 sec.
+DIV2         6.660 sec.
+FFT-MOD      51.880 sec.
+FFT          51.840 sec.
+FPRINT       1.460 sec.
+FREAD        3.180 sec.
+FRPOLY       45.200 sec.
+PUZZLE-MOD   6.960 sec.
+PUZZLE       5.140 sec.
+STAK         2.620 sec.
+TAK          4.900 sec.
+TAKL         2.640 sec.
+TAKR         0.840 sec.
+TPRINT       3.680 sec.
+TRAVERSE     40.060 sec.
+TRIANG-MOD   288.140 sec.
+TRIANG	     141.62 sec.
+
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Thu Apr  7 11:58:43 CDT 1988
+
+BOYER        12.533 sec.
+BROWSE       24.517 sec.
+CTAK         6.517 sec.
+DDERIV       6.050 sec.
+DERIV        4.950 sec.
+DESTRU       2.900 sec.
+DIV2         5.533 sec.
+FFT-MOD      23.283 sec.
+FFT          64.450 sec.
+FPRINT       1.800
+FREAD        3.033
+FRPOLY       86.567
+PUZZLE-MOD   7.200
+PUZZLE       8.317
+STAK         3.733
+TAK          6.483
+TAKL         2.617
+TAKR         1.000
+TPRINT       3.167
+TRAVERSE     38.933
+TRIANG-MOD   138.500
+TRIANG       149.267
+--------------   SESSION   ------------------
+
+       For kcl Common Lisp
+Thu Apr  7 12:32:17 CDT 1988
+
+
+BOYER        15.950
+BROWSE       41.283
+CTAK         7.050
+DDERIV       8.417
+DERIV        6.450
+DESTRU       3.717
+DIV2         5.667
+FFT-MOD      29.467
+FPRINT       2.417
+FREAD        2.867
+FRPOLY       90.167
+PUZZLE-MOD   10.183
+PUZZLE       11.183
+STAK         4.350
+TAK          5.767
+TAKL         3.017
+TAKR         1.483
+TPRINT       4.233
+TRAVERSE     71.133
+TRIANG-MOD   204.100
+TRIANG       220.917
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Thu Apr  7 13:23:19 CDT 1988
+
+FFT-MOD      7.933
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Thu Apr  7 13:25:08 CDT 1988
+
+FFT          59.150
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Thu Apr  7 19:35:41 CDT 1988
+
+TRIANG-MOD   118.033
+--------------   SESSION   ------------------
+
+       For lucid Common Lisp
+Thu Apr  7 19:42:21 CDT 1988
+
+TRIANG-MOD   453.840
+--------------   SESSION   ------------------
+
+       For kcl Common Lisp
+Thu Apr  7 20:56:37 CDT 1988
+
+TRIANG-MOD   160.783
+--------------   SESSION   ------------------
+
+       For kcl Common Lisp
+Thu Apr  7 21:13:11 CDT 1988
+
+TAK-MOD      3.600
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Thu Apr  7 21:13:53 CDT 1988
+
+TAK-MOD      5.367
+--------------   SESSION   ------------------
+
+       For lucid Common Lisp
+Thu Apr  7 21:14:32 CDT 1988
+
+TAK-MOD      4.760
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Thu Apr  7 22:15:52 CDT 1988
+
+BOYER        12.350
+BROWSE       25.083
+CTAK         7.100
+DDERIV       6.550
+DERIV        5.017
+DESTRU       3.300
+DIV2         5.600
+FFT-MOD      21.583
+FFT          65.117
+FPRINT       1.850
+FREAD        2.533
+FRPOLY       86.800
+PUZZLE-MOD   7.633
+PUZZLE       8.800
+STAK         4.217
+TAK-MOD	     3.650
+TAK          5.467
+TAKL         3.167
+TAKR         0.883
+TPRINT       3.150
+TRAVERSE     39.533
+TRIANG-MOD   131.700
+TRIANG       152.517
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp cc,4
+Thu Apr  7 22:51:17 CDT 1988
+
+BOYER        12.250  
+BROWSE       25.067  
+CTAK         7.133   
+DDERIV       6.533   
+DERIV        5.033   
+DESTRU       3.283   
+DIV2         5.583   
+FFT-MOD      21.533  
+FFT          64.700  
+FPRINT       1.767   
+FREAD        2.483   
+FRPOLY       86.483  
+PUZZLE-MOD   7.617   
+PUZZLE       8.667   
+STAK         4.200   
+TAK-MOD      4.350   
+TAK          5.967   
+TAKL         3.117   
+TAKR         1.033   
+TPRINT       3.183   
+TRAVERSE     39.217  
+TRIANG-MOD   130.767 
+TRIANG       151.400 
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Thu Apr  7 23:23:59 CDT 1988
+
+FREAD        2.550
+--------------   SESSION   ------------------
+
+       For kcl Common Lisp
+Thu Apr  7 23:27:10 CDT 1988
+
+FREAD        2.800
+--------------   SESSION   ------------------
+
+       For lucid Common Lisp
+Thu Apr  7 23:27:48 CDT 1988
+
+FREAD        3.280
+
+;next using regmin=1000000
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Fri Apr  8 00:15:43 CDT 1988
+
+BOYER        12.283
+BROWSE       25.450
+CTAK         6.817
+DDERIV       6.550
+DERIV        4.917
+DESTRU       3.333
+DIV2         5.667
+FFT-MOD      22.050
+FFT          65.450
+FPRINT       1.850
+FREAD        2.517
+FRPOLY       86.733
+PUZZLE-MOD   9.900
+PUZZLE       10.600
+STAK         4.217
+TAK-MOD      3.650
+TAK          5.350
+TAKL         3.067
+TAKR         0.883
+TPRINT       3.183
+TRAVERSE     37.133
+TRIANG-MOD   130.850
+TRIANG       153.833
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Fri Apr  8 00:46:22 CDT 1988
+
+BOYER        12.200
+BROWSE       24.183
+CTAK         6.583
+DDERIV       6.033
+DERIV        4.850
+DESTRU       2.883
+DIV2         5.433
+FFT-MOD      7.700
+FFT          58.450
+FPRINT       1.817
+FREAD        2.500
+FRPOLY       85.450
+PUZZLE-MOD   7.117
+PUZZLE       8.200
+STAK         3.717
+TAK-MOD      5.150
+TAK          6.467
+TAKL         2.600
+TAKR         0.933
+TPRINT       3.117
+TRAVERSE     38.917
+TRIANG-MOD   112.750
+TRIANG       147.567
+--------------   SESSION   ------------------
+
+       For lisp Common Lisp
+Thu Apr 14 15:07:28 CDT 1988
+
+BOYER        9.200
+BROWSE       18.500
+CTAK         1.140
+DDERIV       5.420
+DERIV        5.240
+DESTRU       1.080
+DIV2         4.380
+FFT-MOD      38.360
+FFT          34.760
+FPRINT       0.840
+FREAD        1.760
+FRPOLY       30.040
+PUZZLE-MOD   4.380
+PUZZLE       3.180
+STAK         1.380
+TAK-MOD      2.800
+TAK          2.760
+TAKL         1.680
+TAKR         0.460
+TPRINT       2.100
+TRAVERSE     27.940
+TRIANG-MOD   255.460
+TRIANG       76.760
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Thu Apr 14 15:58:30 CDT 1988
+
+BOYER        6.633
+BROWSE       13.300
+CTAK         3.217
+DDERIV       4.717
+DERIV        4.100
+DESTRU       1.733
+DIV2         3.200
+FFT-MOD      5.917
+FPRINT       1.033
+FREAD        1.300
+FRPOLY       46.550
+PUZZLE-MOD   4.333
+PUZZLE       4.833
+STAK         1.817
+TAK-MOD      2.900
+TAK          3.883
+TAKL         1.533
+TAKR         0.533
+TPRINT       1.750
+TRAVERSE     25.783
+TRIANG-MOD   63.350
+TRIANG       77.833
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Fri Apr 15 23:48:59 CDT 1988
+
+TRAVERSE     0.600
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Fri Apr 15 23:50:36 CDT 1988
+
+BROWSE       12.883
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Fri Apr 15 23:58:06 CDT 1988
+
+TRAVERSE     25.433
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Fri Apr 15 23:59:47 CDT 1988
+
+BROWSE       13.150
+--------------   SESSION   ------------------
+
+       For lisp Common Lisp
+Sat Apr 16 12:53:00 CDT 1988
+
+DESTRU-MOD   1.380
+--------------   SESSION   ------------------
+
+       For lisp Common Lisp
+Sat Apr 16 12:54:07 CDT 1988
+
+DESTRU       1.100
+DESTRU       1.683
+DESTRU-MOD   1.117
+DESTRU       1.200
+DESTRU-MOD   1.160
+DESTRU-MOD   1.000
+DESTRU       1.337
+DESTRU       1.095
+DESTRU-MOD   1.185
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Sat Apr 16 13:42:57 CDT 1988
+
+BOYER        7.267
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Sat Apr 16 13:44:00 CDT 1988
+
+BROWSE       14.150
+BOYER        7.050
+CTAK         3.767
+DDERIV       4.633
+BROWSE       13.683
+DERIV        4.083
+CTAK         3.450
+DESTRU-MOD   1.071
+DDERIV       4.683
+DESTRU       1.408
+DIV2         3.100
+DERIV        4.017
+DESTRU-MOD   1.008
+FFT-MOD      6.200
+DESTRU       1.375
+DIV2         3.100
+FFT-MOD      5.967
+FPRINT       1.046
+FREAD        1.271
+FRPOLY       46.967
+FPRINT       1.096
+PUZZLE-MOD   4.367
+FREAD        1.354
+PUZZLE       4.983
+STAK         1.800
+TAK-MOD      2.900
+TAK          3.867
+TAKL         1.350
+TPRINT       1.775
+FRPOLY       47.733
+PUZZLE-MOD   4.483
+PUZZLE       4.883
+TRAVERSE     26.200
+STAK         1.950
+TAK-MOD      3.067
+TAK          4.533
+TAKL         1.467
+TPRINT       1.867
+TRAVERSE     26.033
+TRIANG-MOD   66.833
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Sat Apr 16 13:57:26 CDT 1988
+
+TAKR         0.512
+TRIANG-MOD   64.917
+TRIANG       80.117
+TRIANG       80.500
+BOYER        6.583
+BROWSE       13.033
+CTAK         3.517
+DDERIV       4.567
+DERIV        3.933
+DESTRU-MOD   1.038
+DESTRU       1.367
+DIV2         3.150
+FFT-MOD      5.283
+FFT          32.267
+FPRINT       0.629
+FREAD        1.212
+FRPOLY       48.100
+PUZZLE-MOD   4.633
+PUZZLE       5.017
+STAK         1.813
+TAK-MOD      2.933
+TAK          4.017
+TAKL         1.350
+TAKR         0.550
+TPRINT       1.038
+TRAVERSE     26.317
+TRIANG-MOD   66.583
+BOYER        7.000
+BROWSE       13.600
+DDERIV       3.283
+DERIV        2.733
+DESTRU       1.408
+DESTRU-MOD   1.063
+FREAD        1.288
+FPRINT       0.608
+
+
+BOYER        6.667 
+BROWSE       12.900
+CTAK         3.500 
+DDERIV       3.317 
+DERIV        2.633 
+DESTRU-MOD   1.000 
+DESTRU       1.350 
+DIV2         3.117 
+FFT-MOD      5.350 
+FFT          32.150
+FPRINT       0.667 
+FREAD        1.212 
+FRPOLY       46.883
+PUZZLE-MOD   4.383 
+PUZZLE       4.833 
+STAK         1.813 
+TAK-MOD      2.900 
+TAK          3.833 
+TAKL         1.350 
+TAKR         0.521 
+TPRINT       1.046 
+TRAVERSE     25.667
+TRIANG-MOD   63.500
+TRIANG       78.017
+
+------
+FPRINT       0.800
+FREAD        1.670
+TPRINT       2.275
+--------------   SESSION   ------------------
+
+       For lisp Common Lisp
+Sat Apr 16 21:28:52 CDT 1988
+
+DESTRU-MOD   1.090
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Sat Apr 16 21:42:49 CDT 1988
+
+BOYER        6.583
+BROWSE       12.900
+CTAK         2.883
+DDERIV       3.300
+DERIV        2.633
+DESTRU-MOD   0.988
+DESTRU       1.367
+DIV2         3.117
+FFT-MOD      5.283
+FFT          32.150
+FPRINT       0.637
+FREAD        1.221
+FRPOLY       46.600
+PUZZLE-MOD   4.283
+PUZZLE       4.850
+STAK         1.800
+TAK-MOD      2.883
+TAK          3.833
+TAKL         1.350
+TAKR         0.517
+TPRINT       1.013
+TRAVERSE     25.567
+TRIANG-MOD   63.317
+TRIANG       77.867
+BOYER        6.833
+BOYER        6.600
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Tue Apr 19 17:28:36 CDT 1988
+
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Tue Apr 19 17:29:35 CDT 1988
+
+BOYER        6.583
+BOYER        8.383
+BOYER        7.050
+BOYER        6.567
+--------------   SESSION   ------------------
+
+       For skcl Common Lisp
+Tue Apr 19 23:40:44 CDT 1988
+
+BOYER        6.600
+BROWSE       12.817
+CTAK         3.417
+DDERIV       3.283
+DERIV        2.633
+DESTRU-MOD   0.975
+DESTRU       1.362
+DIV2         3.150
+FFT-MOD      5.283
+FFT          32.133
+FPRINT       0.625
+FREAD        1.242
+FRPOLY       46.500
+PUZZLE-MOD   4.283
+PUZZLE       4.833
+STAK         1.771
+TAK-MOD      2.883
+TAK          3.783
+TAKL         1.317
+TAKR         0.504
+TPRINT       1.025
+TRAVERSE     25.533
+TRIANG-MOD   62.450
+TRIANG       77.800
+
+--------------   SESSION   ------------------
+
+       For ecl Common Lisp
+sáb feb 26 09:58:33 CET 2000
+
+BOYER        0.150
+CTAK         0.030
+DDERIV       0.090
+DERIV        0.080
+DESTRU-MOD   0.023
+DESTRU       0.025
+DIV2         0.070
+FFT-MOD      0.020
+FPRINT       0.023
+FREAD        0.038
+FRPOLY       15.560
+PUZZLE-MOD   0.090
+PUZZLE       0.090
+STAK         0.025
+TAK-MOD      0.050
+TAK          0.050
+TAKL         0.020
+TAKR         0.010
+TPRINT       0.035
+TRAVERSE     0.950
+TRIANG-MOD   0.000
+TRIANG       1.030
+--------------   SESSION   ------------------
+
+       For gcl Common Lisp
+sáb feb 26 09:59:35 CET 2000
+
+BOYER        0.140
+CTAK         0.040
+DDERIV       0.080
+DERIV        0.070
+DESTRU-MOD   0.018
+DESTRU       0.035
+DIV2         0.080
+FFT-MOD      0.020
+FFT          0.020
+FPRINT       0.015
+FREAD        0.018
+FRPOLY       3.160
+PUZZLE-MOD   0.080
+PUZZLE       0.100
+STAK         0.028
+TAK-MOD      0.050
+TAK          0.060
+TAKL         0.020
+TAKR         0.010
+TPRINT       0.025
+TRAVERSE     1.150
+TRIANG       1.150
diff --git a/src/gabriel/tprint.cl b/src/gabriel/tprint.cl
new file mode 100644
index 000000000..18e11956d
--- /dev/null
+++ b/src/gabriel/tprint.cl
@@ -0,0 +1,32 @@
+;; $Header$
+;; $Locker$
+
+;;; TPRINT -- Benchmark to print and read to the terminal.
+
+(defvar test-atoms '(abc1 cde2 efg3 ghi4 ijk5 klm6 mno7 opq8 qrs9
+			  stu0 uvw1 wxy2 xyz3 123a 234b 345c 456d 
+			  567d 678e 789f 890g))
+
+(defun tprint-init (m n atoms)
+  (let ((atoms (subst () () atoms)))
+    (do ((a atoms (cdr a)))
+	((null (cdr a)) (rplacd a atoms)))
+    (tprint-init-aux m n atoms)))
+
+(defun tprint-init-aux (m n atoms)
+  (declare (fixnum m n))
+  (cond ((= m 0) (pop atoms))
+	(t (do ((i n (the fixnum (- i 2)))
+		(a ()))
+	       ((< i 1) a)
+	     (push (pop atoms) a)
+	     (push (tprint-init-aux (the fixnum (1- m)) n atoms) a)))))
+
+(defvar test-pattern (tprint-init 6. 6. test-atoms))
+
+
+(defun standard-tprint-test () 
+      (print test-pattern))
+
+(defun testtprint ()
+  (print test-pattern))
diff --git a/src/gabriel/traverse.cl b/src/gabriel/traverse.cl
new file mode 100644
index 000000000..640638f53
--- /dev/null
+++ b/src/gabriel/traverse.cl
@@ -0,0 +1,150 @@
+;; $Header$
+;; $Locker$
+
+;;; TRAVERSE --  Benchmark which creates and traverses a tree structure.
+
+
+(eval-when (eval compile load)
+  (defstruct node
+    (parents ())
+    (sons ())
+    (sn (snb))
+    (entry1 ())
+    (entry2 ())
+    (entry3 ())
+    (entry4 ())
+    (entry5 ())
+    (entry6 ())
+    (mark ()))
+)
+(defvar traverse-sn 0)
+(defvar traverse-rand 21.)
+(defvar traverse-count 0)
+(proclaim `(type fixnum traverse-sn traverse-rand traverse-count))
+(defvar traverse-marker nil)
+(defvar traverse-root)
+
+(setq traverse-sn 0 traverse-rand 21 traverse-count 0 traverse-marker nil)
+
+(defun snb ()
+  (setq traverse-sn (the fixnum (1+ traverse-sn))))
+
+(defun traverse-seed ()
+  (setq traverse-rand 21.))
+
+(defun traverse-random ()
+  (setq traverse-rand
+	(the fixnum (rem (the fixnum (* traverse-rand 17)) 251))))
+
+(defun traverse-remove (n q)
+  (declare (type fixnum n))
+  (cond ((eq (cdr (car q)) (car q))
+	 (prog2 () (caar q) (rplaca q ())))
+	((= n 0)
+	 (prog2 () (caar q)
+		(do ((p (car q) (cdr p)))
+		    ((eq (cdr p) (car q))
+		     (rplaca q
+			     (rplacd p (cdr (car q))))))))
+	(t (do ((n n (the fixnum (1- n)))
+		(q (car q) (cdr q))
+		(p (cdr (car q)) (cdr p)))
+	       ((= n 0) (prog2 () (car q) (rplacd q p)))
+	     (declare (type fixnum n))))))
+
+(defun traverse-select (n q)
+  (declare (type fixnum n))
+  (do ((n n (the fixnum (1- n)))
+       (q (car q) (cdr q)))
+      ((= n 0) (car q))
+    (declare (type fixnum n))))
+
+(defun traverse-add (a q)
+  (cond ((null q)
+	 `(,(let ((x `(,a)))
+	      (rplacd x x) x)))
+	((null (car q))
+	 (let ((x `(,a)))
+	   (rplacd x x)
+	   (rplaca q x)))
+	(t (rplaca q
+		   (rplacd (car q) `(,a .,(cdr (car q))))))))
+
+(defun traverse-create-structure (n)
+  (declare (type fixnum n))
+  (let ((a `(,(make-node))))
+    (do ((m (the fixnum (1- n)) (the fixnum (1- m)))
+	 (p a))
+	((= m 0) (setq a `(,(rplacd p a)))
+	 (do ((unused a)
+	      (used (traverse-add (traverse-remove 0 a) ()))
+	      (x) (y))
+	     ((null (car unused))
+	      (find-root (traverse-select 0 used) n))
+	   (setq x (traverse-remove
+		    (the fixnum (rem (the fixnum (traverse-random)) n))
+		    unused))
+	   (setq y (traverse-select 
+		    (the fixnum (rem (the fixnum (traverse-random)) n))
+		    used))
+	   (traverse-add x used)
+	   (setf (node-sons y) `(,x .,(node-sons y)))
+	   (setf (node-parents x) `(,y .,(node-parents x))) ))
+      (declare (type fixnum m))
+      (push (make-node) a))))
+
+(defun find-root (node n)
+  (declare (type fixnum n))
+  (do ((n n (the fixnum (1- n))))
+      ((= n 0) node)
+    (declare (type fixnum n))
+    (cond ((null (node-parents node))
+	   (return node))
+	  (t (setq node (car (node-parents node)))))))
+
+(defun travers (node mark)
+  (cond ((eq (node-mark node) mark) ())
+	(t (setf (node-mark node) mark)
+	   (setq traverse-count (the fixnum (1+ traverse-count)))
+	   (setf (node-entry1 node) (not (node-entry1 node)))
+	   (setf (node-entry2 node) (not (node-entry2 node)))
+	   (setf (node-entry3 node) (not (node-entry3 node)))
+	   (setf (node-entry4 node) (not (node-entry4 node)))
+	   (setf (node-entry5 node) (not (node-entry5 node)))
+	   (setf (node-entry6 node) (not (node-entry6 node)))
+	   (do ((sons (node-sons node) (cdr sons)))
+	       ((null sons) ())
+	     (travers (car sons) mark)))))
+
+
+
+(defun traverse (traverse-root)
+  (let ((traverse-count 0))
+    (declare (type fixnum traverse-count))
+    (travers traverse-root
+	     (setq traverse-marker (not traverse-marker)))
+    traverse-count))
+
+(defun init-traverse()
+  (setq traverse-root (traverse-create-structure 100.))
+  nil)
+
+(defun run-traverse ()
+  (do ((i 50 (the fixnum (1- (the fixnum i)))))
+      ((= (the fixnum i) 0))
+    (declare (type fixnum i))
+    (traverse traverse-root)
+    (traverse traverse-root)
+    (traverse traverse-root)
+    (traverse traverse-root)
+    (traverse traverse-root))) 
+
+(defun testtraverse ()
+  (testtraverse-init)
+  (testtraverse-run))
+
+(defun testtraverse-init ()
+  (init-traverse))
+
+(defun testtraverse-run ()
+  (run-traverse))
diff --git a/src/gabriel/triang-mod.cl b/src/gabriel/triang-mod.cl
new file mode 100644
index 000000000..7c2ef4fb4
--- /dev/null
+++ b/src/gabriel/triang-mod.cl
@@ -0,0 +1,93 @@
+;; $Header$
+;; $Locker$
+
+;;; TRIANG -- Board game benchmark.
+
+(proclaim '(special board sequence a b c))
+(proclaim '(special board sequence a b c))
+(proclaim '(type (vector fixnum ) board))
+(proclaim '(type (vector fixnum  ) sequence))
+(proclaim '(type (vector fixnum ) a))
+(proclaim '(type (vector fixnum ) b))
+(proclaim '(type (vector fixnum ) c))
+(defvar answer)
+(defvar final)
+(proclaim '(function triang-setup () t))
+(proclaim '(function last-position () fixnum))
+(proclaim '(function try (fixnum fixnum) t))
+(proclaim '(function simple-vector-to-list (t) t))
+(proclaim '(function gogogo (fixnum) t))
+(proclaim '(function testtriang () t))
+
+(defun triang-setup ()
+  (setq board (make-array 16 :element-type 'fixnum :initial-element 1))
+  (setq sequence (make-array 14 :element-type 'fixnum :initial-element 0))
+  (setq a
+    (make-array
+      37
+      :element-type 'fixnum 
+      :initial-contents
+      '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4 7 11 8 12
+	13 6 10 15 9 14 13 13 14 15 9 10 6 6)))
+  (setq b (make-array
+	    37 
+            :element-type 'fixnum
+            :initial-contents
+	    '(2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5
+	      2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5 5)))
+  (setq c (make-array
+	    37 
+            :element-type 'fixnum
+            :initial-contents
+	    '(4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6
+	      1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4)))
+  (setf (aref board 5) 0))
+
+(defun last-position ()
+  (do ((i 1 (the fixnum (+ i 1))))
+      ((= i 16) 0)
+    (declare (fixnum i))
+    (if (eq 1 (aref board i))
+	(return i))))
+
+(defun try (i depth)
+  (declare (fixnum i depth))
+  (cond ((= depth 14) 
+	 (let ((lp (last-position)))
+	   (unless (member lp final :test #'eq)
+	     (push lp final)))
+    ;;;     (format t "~&~s"  (cdr (simple-vector-to-list sequence)))
+	 (push (cdr (simple-vector-to-list sequence))
+	       answer) t) 		; this is a hack to replace LISTARRAY
+	((and (eql 1 (aref board (aref a i)))
+	      (eql 1 (aref board (aref b i)))
+	      (eql 0 (aref board (aref c i))))
+	 (setf (aref board (aref a i)) 0)
+	 (setf (aref board (aref b i)) 0)
+	 (setf (aref board (aref c i)) 1)
+	 (setf (aref sequence depth) i)
+	 (do ((j 0 (the fixnum (+ j 1)))
+	      (depth (the fixnum (+ depth 1))))
+	     ((or (= j 36)
+		  (try j depth)) ())
+	   (declare (fixnum j depth)))
+	 (setf (aref board (aref a i)) 1) 
+	 (setf (aref board (aref b i)) 1)
+	 (setf (aref board (aref c i)) 0) ())))
+
+(defun simple-vector-to-list (seq)
+  (do ((i (- (length seq) 1) (1- i))
+       (res))
+      ((< i 0)
+       res)
+    (declare (fixnum i))
+    (push (aref  seq i) res)))
+		
+(defun gogogo (i)
+  (let ((answer ())
+	(final ()))
+    (try i 1)))
+
+(defun testtriang ()
+  (triang-setup)
+  (gogogo 22))
diff --git a/src/gabriel/triang-old-mod.cl b/src/gabriel/triang-old-mod.cl
new file mode 100644
index 000000000..c7337418c
--- /dev/null
+++ b/src/gabriel/triang-old-mod.cl
@@ -0,0 +1,80 @@
+;; $Header$
+;; $Locker$
+
+;;; TRIANG -- Board game benchmark.
+
+(proclaim '(special board sequence a b c))
+
+(proclaim '(type (vector fixnum) a b c))
+(defmacro fref (v i) `(the fixnum (aref (the (vector fixnum) ,v) ,i)))
+
+(defvar answer)
+(defvar final)
+
+(defun triang-setup ()
+  (setq board (make-array 16 :initial-element 1))
+  (setq sequence (make-array 14 :initial-element 0))
+  (setq a
+    (make-array
+      37
+      :element-type 'fixnum :initial-contents
+      '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4 7 11 8 12
+	13 6 10 15 9 14 13 13 14 15 9 10 6 6)))
+  (setq b (make-array
+	    37       :element-type 'fixnum :initial-contents
+	    '(2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5
+	      2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5 5)))
+  (setq c (make-array
+	    37       :element-type 'fixnum :initial-contents
+	    '(4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6
+	      1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4)))
+  (setf (svref board 5) 0))
+
+
+(defun last-position ()
+  (do ((i 1 (the fixnum (+ i 1))))
+      ((= i 16) 0)
+    (declare (fixnum i))
+    (if (eq 1 (svref board i))
+	(return i))))
+(proclaim '(function try (fixnum fixnum) t))
+(defun try (i depth)
+  (declare (fixnum i depth))
+  (cond ((= depth 14) 
+	 (let ((lp (last-position)))
+	   (unless (member lp final :test #'eq)
+	     (push lp final)))
+	 (push (cdr (simple-vector-to-list sequence))
+	       answer) t) 		; this is a hack to replace LISTARRAY
+	((and (eq 1 (svref board (fref a i)))
+	      (eq 1 (svref board (fref b i)))
+	      (eq 0 (svref board (fref c i))))
+	 (setf (svref board (fref a i)) 0)
+	 (setf (svref board (fref b i)) 0)
+	 (setf (svref board (fref c i)) 1)
+	 (setf (svref sequence depth) i)
+	 (do ((j 0 (the fixnum (+ j 1)))
+	      (depth (the fixnum (+ depth 1))))
+	     ((or (= j 36)
+		  (try j depth)) ())
+	   (declare (fixnum j depth)))
+	 (setf (svref board (fref a i)) 1) 
+	 (setf (svref board (fref b i)) 1)
+	 (setf (svref board (fref c i)) 0) ())))
+
+(defun simple-vector-to-list (seq)
+  (do ((i (- (length seq) 1) (1- i))
+       (res))
+      ((< i 0)
+       res)
+    (declare (fixnum i))
+    (push (svref seq i) res)))
+		
+(defun gogogo (i)
+  (let ((answer ())
+	(final ()))
+    (try i 1)))
+
+(defun testtriang ()
+  (triang-setup)
+  (print (time (gogogo 22))))
diff --git a/src/gabriel/triang.cl b/src/gabriel/triang.cl
new file mode 100644
index 000000000..30d5c0fa8
--- /dev/null
+++ b/src/gabriel/triang.cl
@@ -0,0 +1,75 @@
+;; $Header$
+;; $Locker$
+
+;;; TRIANG -- Board game benchmark.
+
+(proclaim '(special board sequence a b c))
+(defvar answer)
+(defvar final)
+
+(defun triang-setup ()
+  (setq board (make-array 16 :initial-element 1))
+  (setq sequence (make-array 14 :initial-element 0))
+  (setq a
+    (make-array
+      37
+      :initial-contents
+      '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4 7 11 8 12
+	13 6 10 15 9 14 13 13 14 15 9 10 6 6)))
+  (setq b (make-array
+	    37 :initial-contents
+	    '(2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5
+	      2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5 5)))
+  (setq c (make-array
+	    37 :initial-contents
+	    '(4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6
+	      1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4)))
+  (setf (svref board 5) 0))
+
+(defun last-position ()
+  (do ((i 1 (the fixnum (+ i 1))))
+      ((= i 16) 0)
+    (declare (fixnum i))
+    (if (eq 1 (svref board i))
+	(return i))))
+
+(defun try (i depth)
+  (declare (fixnum i depth))
+  (cond ((= depth 14) 
+	 (let ((lp (last-position)))
+	   (unless (member lp final :test #'eq)
+	     (push lp final)))
+	 (push (cdr (simple-vector-to-list sequence))
+	       answer) t) 		; this is a hack to replace LISTARRAY
+	((and (eq 1 (svref board (svref a i)))
+	      (eq 1 (svref board (svref b i)))
+	      (eq 0 (svref board (svref c i))))
+	 (setf (svref board (svref a i)) 0)
+	 (setf (svref board (svref b i)) 0)
+	 (setf (svref board (svref c i)) 1)
+	 (setf (svref sequence depth) i)
+	 (do ((j 0 (the fixnum (+ j 1)))
+	      (depth (the fixnum (+ depth 1))))
+	     ((or (= j 36)
+		  (try j depth)) ())
+	   (declare (fixnum j depth)))
+	 (setf (svref board (svref a i)) 1) 
+	 (setf (svref board (svref b i)) 1)
+	 (setf (svref board (svref c i)) 0) ())))
+
+(defun simple-vector-to-list (seq)
+  (do ((i (- (length seq) 1) (1- i))
+       (res))
+      ((< i 0)
+       res)
+    (declare (fixnum i))
+    (push (svref seq i) res)))
+		
+(defun gogogo (i)
+  (let ((answer ())
+	(final ()))
+    (try i 1)))
+
+(defun testtriang ()
+  (triang-setup)
+  (gogogo 22))
diff --git a/src/gc/BCC_MAKEFILE b/src/gc/BCC_MAKEFILE
new file mode 100644
index 000000000..225a1ed49
--- /dev/null
+++ b/src/gc/BCC_MAKEFILE
@@ -0,0 +1,82 @@
+# Makefile for Borland C++ 4.5 on NT
+# For Borland 5.0, replace bc45 by bc5.
+# If you have the Borland assembler, remove "-DUSE_GENERIC"
+#
+bc=        c:\bc45
+bcbin=     $(bc)\bin
+bclib=     $(bc)\lib
+bcinclude= $(bc)\include
+
+cc=      $(bcbin)\bcc32
+rc=      $(bcbin)\brc32
+lib=     $(bcbin)\tlib
+link=    $(bcbin)\tlink32
+cflags=  -R -v -vi -H -H=gc.csm -I$(bcinclude);cord -L$(bclib) \
+         -w-pro -w-aus -w-par -w-ccc -w-rch -a4 -D__STDC__=0
+#defines= -DSILENT
+defines= -DSMALL_CONFIG -DSILENT -DALL_INTERIOR_POINTERS -DUSE_GENERIC
+
+.c.obj:
+	$(cc) @&&|
+        $(cdebug) $(cflags) $(cvars) $(defines) -o$* -c $*.c
+|
+
+.cpp.obj:
+	$(cc) @&&|
+        $(cdebug) $(cflags) $(cvars) $(defines) -o$* -c $*.cpp
+|
+
+.rc.res:
+    $(rc) -i$(bcinclude) -r -fo$* $*.rc
+
+XXXOBJS= XXXalloc.obj XXXreclaim.obj XXXallchblk.obj XXXmisc.obj \
+    XXXmach_dep.obj XXXos_dep.obj XXXmark_rts.obj XXXheaders.obj XXXmark.obj \
+    XXXobj_map.obj XXXblacklst.obj XXXfinalize.obj XXXnew_hblk.obj \
+    XXXdbg_mlc.obj XXXmalloc.obj XXXstubborn.obj XXXdyn_load.obj \
+    XXXtypd_mlc.obj XXXptr_chck.obj XXXgc_cpp.obj XXXmallocx.obj
+
+OBJS= $(XXXOBJS:XXX=)
+
+all: gctest.exe cord\de.exe test_cpp.exe
+
+$(OBJS) test.obj: gc_priv.h gc_hdrs.h gc.h gcconfig.h MAKEFILE
+
+gc.lib: $(OBJS)
+    -del gc.lib
+	tlib $* @&&|
+        $(XXXOBJS:XXX=+)
+|
+
+gctest.exe: test.obj gc.lib
+    $(cc) @&&|
+        $(cflags) -W -e$* test.obj gc.lib
+|
+
+cord\de.obj cord\de_win.obj: cord\cord.h cord\private\cord_pos.h cord\de_win.h \
+    cord\de_cmds.h
+
+cord\de.exe: cord\cordbscs.obj cord\cordxtra.obj cord\de.obj cord\de_win.obj \
+        cord\de_win.res gc.lib
+	$(cc) @&&|
+        $(cflags) -W -e$* cord\cordbscs.obj cord\cordxtra.obj \
+        cord\de.obj cord\de_win.obj gc.lib
+|
+    $(rc) cord\de_win.res cord\de.exe
+
+gc_cpp.obj: gc_cpp.h gc.h
+
+gc_cpp.cpp: gc_cpp.cc
+	copy gc_cpp.cc gc_cpp.cpp
+
+test_cpp.cpp: test_cpp.cc
+	copy test_cpp.cc test_cpp.cpp
+
+test_cpp.exe: test_cpp.obj gc_cpp.h gc.h gc.lib
+    $(cc) @&&|
+        $(cflags) -W -e$* test_cpp.obj gc.lib
+|
+
+scratch:
+    -del *.obj *.res *.exe *.csm cord\*.obj cord\*.res cord\*.exe cord\*.csm
+
+
diff --git a/src/gc/EMX_MAKEFILE b/src/gc/EMX_MAKEFILE
new file mode 100644
index 000000000..54a06ce38
--- /dev/null
+++ b/src/gc/EMX_MAKEFILE
@@ -0,0 +1,141 @@
+#
+#  OS/2 specific Makefile for the EMX environment
+#
+#  You need GNU Make 3.71, gcc 2.5.7, emx 0.8h and GNU fileutils 3.9
+#  or similar tools. C++ interface and de.exe weren't tested.
+#
+#  Rename this file "Makefile".
+#
+
+# Primary targets:
+# gc.a - builds basic library
+# c++ - adds C++ interface to library and include directory
+# cords - adds cords (heavyweight strings) to library and include directory
+# test - prints porting information, then builds basic version of gc.a, and runs
+#        some tests of collector and cords.  Does not add cords or c++ interface to gc.a
+# cord/de.exe - builds dumb editor based on cords.
+CC= gcc
+CXX=g++
+# Needed only for "make c++", which adds the c++ interface
+
+CFLAGS= -O -DALL_INTERIOR_POINTERS -DSILENT
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+# -DSILENT disables statistics printing, and improves performance.
+# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+#   altered stubborn objects, at substantial performance cost.
+# -DFIND_LEAK causes the collector to assume that all inaccessible
+#   objects should have been explicitly deallocated, and reports exceptions
+# -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+#   (Clients should also define SOLARIS_THREADS and then include
+#   gc.h before performing thr_ or GC_ operations.)
+# -DALL_INTERIOR_POINTERS allows all pointers to the interior
+#   of objects to be recognized.  (See gc_private.h for consequences.)
+# -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+#   usually causing it to use less space in such situations.
+#   Incremental collection no longer works in this case.
+# -DDONT_ADD_BYTE_AT_END is meaningful only with
+#   -DALL_INTERIOR_POINTERS.  Normally -DALL_INTERIOR_POINTERS
+#   causes all objects to be padded so that pointers just past the end of
+#   an object can be recognized.  This can be expensive.  (The padding
+#   is normally more than one byte due to alignment constraints.)
+#   -DDONT_ADD_BYTE_AT_END disables the padding.
+
+AR= ar
+RANLIB= ar s
+
+# Redefining srcdir allows object code for the nonPCR version of the collector
+# to be generated in different directories
+srcdir = .
+VPATH = $(srcdir)
+
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o dyn_load.o dbg_mlc.o malloc.o stubborn.o checksums.o typd_mlc.o ptr_chck.o mallocx.o
+
+CORD_OBJS=  cord/cordbscs.o cord/cordxtra.o cord/cordprnt.o
+
+CORD_INCLUDE_FILES= $(srcdir)/gc.h $(srcdir)/cord/cord.h $(srcdir)/cord/ec.h \
+           $(srcdir)/cord/cord_pos.h
+
+# Libraries needed for curses applications.  Only needed for de.
+CURSES= -lcurses -ltermlib
+
+# The following is irrelevant on most systems.  But a few
+# versions of make otherwise fork the shell specified in
+# the SHELL environment variable.
+SHELL= bash
+
+SPECIALCFLAGS = 
+# Alternative flags to the C compiler for mach_dep.c.
+# Mach_dep.c often doesn't like optimization, and it's
+# not time-critical anyway.
+
+all: gc.a gctest.exe
+
+$(OBJS) test.o: $(srcdir)/gc_priv.h $(srcdir)/gc_hdrs.h $(srcdir)/gc.h \
+    $(srcdir)/gcconfig.h $(srcdir)/gc_typed.h
+# The dependency on Makefile is needed.  Changing
+# options such as -DSILENT affects the size of GC_arrays,
+# invalidating all .o files that rely on gc_priv.h
+
+mark.o typd_mlc.o finalize.o: $(srcdir)/gc_mark.h
+
+gc.a: $(OBJS)
+	$(AR) ru gc.a $(OBJS)
+	$(RANLIB) gc.a
+
+cords: $(CORD_OBJS) cord/cordtest.exe
+	$(AR) ru gc.a $(CORD_OBJS)
+	$(RANLIB) gc.a
+	cp $(srcdir)/cord/cord.h include/cord.h
+	cp $(srcdir)/cord/ec.h include/ec.h
+	cp $(srcdir)/cord/cord_pos.h include/cord_pos.h
+
+gc_cpp.o: $(srcdir)/gc_cpp.cc $(srcdir)/gc_cpp.h
+	$(CXX) -c -O $(srcdir)/gc_cpp.cc
+	
+c++: gc_cpp.o $(srcdir)/gc_cpp.h
+	$(AR) ru gc.a gc_cpp.o
+	$(RANLIB) gc.a
+	cp $(srcdir)/gc_cpp.h include/gc_cpp.h 
+
+mach_dep.o: $(srcdir)/mach_dep.c
+	$(CC) -o mach_dep.o -c $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+
+mark_rts.o: $(srcdir)/mark_rts.c
+	$(CC) -o mark_rts.o -c $(CFLAGS) $(srcdir)/mark_rts.c
+
+cord/cordbscs.o: $(srcdir)/cord/cordbscs.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c $(srcdir)/cord/cordbscs.c -o  cord/cordbscs.o
+
+cord/cordxtra.o: $(srcdir)/cord/cordxtra.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c $(srcdir)/cord/cordxtra.c -o  cord/cordxtra.o
+
+cord/cordprnt.o: $(srcdir)/cord/cordprnt.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c $(srcdir)/cord/cordprnt.c -o cord/cordprnt.o
+
+cord/cordtest.exe: $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a
+	$(CC) $(CFLAGS) -o cord/cordtest.exe $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a
+
+cord/de.exe: $(srcdir)/cord/de.c $(srcdir)/cord/cordbscs.o $(srcdir)/cord/cordxtra.o gc.a
+	$(CC) $(CFLAGS) -o cord/de.exe $(srcdir)/cord/de.c $(srcdir)/cord/cordbscs.o $(srcdir)/cord/cordxtra.o gc.a $(CURSES)
+
+clean: 
+	rm -f gc.a test.o gctest.exe output-local output-diff $(OBJS) \
+	      setjmp_test  mon.out gmon.out a.out core \
+	      $(CORD_OBJS) cord/cordtest.exe cord/de.exe
+	-rm -f *~
+
+gctest.exe: test.o gc.a
+	$(CC) $(CFLAGS) -o gctest.exe test.o gc.a
+
+# If an optimized setjmp_test generates a segmentation fault,
+# odds are your compiler is broken.  Gctest may still work.
+# Try compiling setjmp_t.c unoptimized.
+setjmp_test.exe: $(srcdir)/setjmp_t.c $(srcdir)/gc.h
+	$(CC) $(CFLAGS) -o setjmp_test.exe $(srcdir)/setjmp_t.c
+
+test: setjmp_test.exe gctest.exe
+	./setjmp_test
+	./gctest
+	make cord/cordtest.exe
+	cord/cordtest
diff --git a/src/gc/MacOS.c b/src/gc/MacOS.c
new file mode 100644
index 000000000..cc12cd15d
--- /dev/null
+++ b/src/gc/MacOS.c
@@ -0,0 +1,154 @@
+/*
+	MacOS.c
+	
+	Some routines for the Macintosh OS port of the Hans-J. Boehm, Alan J. Demers
+	garbage collector.
+	
+	<Revision History>
+	
+	11/22/94  pcb  StripAddress the temporary memory handle for 24-bit mode.
+	11/30/94  pcb  Tracking all memory usage so we can deallocate it all at once.
+	02/10/96  pcb  Added routine to perform a final collection when
+unloading shared library.
+	
+	by Patrick C. Beard.
+ */
+/* Boehm, February 15, 1996 2:55 pm PST */
+
+#include <Resources.h>
+#include <Memory.h>
+#include <LowMem.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "gc.h"
+#include "gc_priv.h"
+
+// use 'CODE' resource 0 to get exact location of the beginning of global space.
+
+typedef struct {
+	unsigned long aboveA5;
+	unsigned long belowA5;
+	unsigned long JTSize;
+	unsigned long JTOffset;
+} *CodeZeroPtr, **CodeZeroHandle;
+
+void* GC_MacGetDataStart()
+{
+	CodeZeroHandle code0 = (CodeZeroHandle)GetResource('CODE', 0);
+	if (code0) {
+		long belowA5Size = (**code0).belowA5;
+		ReleaseResource((Handle)code0);
+		return (LMGetCurrentA5() - belowA5Size);
+	}
+	fprintf(stderr, "Couldn't load the jump table.");
+	exit(-1);
+	return 0;
+}
+
+/* track the use of temporary memory so it can be freed all at once. */
+
+typedef struct TemporaryMemoryBlock TemporaryMemoryBlock, **TemporaryMemoryHandle;
+
+struct TemporaryMemoryBlock {
+	TemporaryMemoryHandle nextBlock;
+	char data[];
+};
+
+static TemporaryMemoryHandle theTemporaryMemory = NULL;
+static Boolean firstTime = true;
+
+void GC_MacFreeTemporaryMemory(void);
+
+Ptr GC_MacTemporaryNewPtr(size_t size, Boolean clearMemory)
+{
+	static Boolean firstTime = true;
+	OSErr result;
+	TemporaryMemoryHandle tempMemBlock;
+	Ptr tempPtr = nil;
+
+	tempMemBlock = (TemporaryMemoryHandle)TempNewHandle(size + sizeof(TemporaryMemoryBlock), &result);
+	if (tempMemBlock && result == noErr) {
+		HLockHi((Handle)tempMemBlock);
+		tempPtr = (**tempMemBlock).data;
+		if (clearMemory) memset(tempPtr, 0, size);
+		tempPtr = StripAddress(tempPtr);
+
+		// keep track of the allocated blocks.
+		(**tempMemBlock).nextBlock = theTemporaryMemory;
+		theTemporaryMemory = tempMemBlock;
+	}
+	
+#     if !defined(SHARED_LIBRARY_BUILD)
+	// install an exit routine to clean up the memory used at the end.
+	if (firstTime) {
+		atexit(&GC_MacFreeTemporaryMemory);
+		firstTime = false;
+	}
+#     endif
+	
+	return tempPtr;
+}
+
+extern word GC_fo_entries; 
+
+static void perform_final_collection()
+{
+  unsigned i;
+  word last_fo_entries = 0;
+  
+  /* adjust the stack bottom, because CFM calls us from another stack
+     location. */
+     GC_stackbottom = (ptr_t)&i;
+
+  /* try to collect and finalize everything in sight */
+    for (i = 0; i < 2 || GC_fo_entries < last_fo_entries; i++) {
+        last_fo_entries = GC_fo_entries;
+        GC_gcollect();
+    }
+}
+
+
+void GC_MacFreeTemporaryMemory()
+{
+# if defined(SHARED_LIBRARY_BUILD)
+    /* if possible, collect all memory, and invoke all finalizers. */
+      perform_final_collection();
+# endif
+
+    if (theTemporaryMemory != NULL) {
+	long totalMemoryUsed = 0;
+	TemporaryMemoryHandle tempMemBlock = theTemporaryMemory;
+	while (tempMemBlock != NULL) {
+		TemporaryMemoryHandle nextBlock = (**tempMemBlock).nextBlock;
+		totalMemoryUsed += GetHandleSize((Handle)tempMemBlock);
+		DisposeHandle((Handle)tempMemBlock);
+		tempMemBlock = nextBlock;
+	}
+	theTemporaryMemory = NULL;
+
+#       if !defined(SILENT) && !defined(SHARED_LIBRARY_BUILD)
+          fprintf(stdout, "[total memory used:  %ld bytes.]\n",
+                  totalMemoryUsed);
+          fprintf(stdout, "[total collections:  %ld.]\n", GC_gc_no);
+#       endif
+    }
+}
+
+#if __option(far_data)
+
+  void* GC_MacGetDataEnd()
+  {
+	CodeZeroHandle code0 = (CodeZeroHandle)GetResource('CODE', 0);
+	if (code0) {
+		long aboveA5Size = (**code0).aboveA5;
+		ReleaseResource((Handle)code0);
+		return (LMGetCurrentA5() + aboveA5Size);
+	}
+	fprintf(stderr, "Couldn't load the jump table.");
+	exit(-1);
+	return 0;
+  }
+
+#endif /* __option(far_data) */
diff --git a/src/gc/MacProjects.sit.hqx b/src/gc/MacProjects.sit.hqx
new file mode 100644
index 000000000..99dff88b4
--- /dev/null
+++ b/src/gc/MacProjects.sit.hqx
@@ -0,0 +1,886 @@
+(This file must be converted with BinHex 4.0)
+
+:$deKBe"bEfTPBh4c,R0TG!"6594%8dP8)3#3"&)e!!!"4UiT8dP8)3!(!!"50A*
+
+-BA8#ZJ#3!aB"#3d0#'GM,MBi5bkjBf038%-ZZ3#3%)Zi!*!8"@`!N!6rN!4069"
+
+568e$3`%!UbqAD+X`19S!!!Ba!!!,*J!!!F%!!!-PfTmj1`#3"PET)d31)LTH6H4
+
+#*AqG5b5HI*)QjY$IIb00%ReTJSi6rG$jG(bZ,"Rc,9Umf[IRj)6FZ-j`GfGR)#!
+
+m-#qLqB#cj'G%46qffB3q8AppLXKc+P&*il4FMJMq3N32r[U,(PlSNdrQm-J(4!p
+
+jK)NHmKJSHY!,&chS$4)pk%8mL3I)B0'$AU6S3'q)k%%[5[5J&ffa#68)0ZM&#T!
+
+!*fHC-2dFZ3i83[Vr[4Xh'+DNQrm'J)rrpqe%ST`,FeVi6b,*qHH")4eQc28NFMN
+
+ZT*m,L"Y%-`pdAk6RLHDaeVV0a,,@P(4UUK66rUM'8bf91llS("lTh81)MBQ+4*q
+
+rfHENEhD)Ke#3!09'M%bL[P1+G88fa$3e)5Gpf0kARpBf*6eIH*0`ZBHR%ii"PbN
+
++D&*)688M)Sm$Bm[cCdDjh2YIjmAc`(TVpi*Vka((A*&Yl@'LTSH1M*AMP#,2[A$
+
+(FHA@S"dL4dER#3b!EfBYem(C9P5iGH"a-bb-AL(F"bb-AL,F6)%a9pJUL,(hf%B
+
+TeQb["X5ib4DQXV!-fa6&mZf&3,(C&UDd-((SpeMBEIB`8Zc,BcZR3A5'X+jYj$'
+
+6)6HVV+R[!`#3!`X!(E@*MFQ%R4d"))`m[3JM[c)bBS54Tj'M(AP+MK&f%VD5SdG
+
+SANFB@3Rqc$Am83(+)`"G(D%A'9!bBQ6!b)b4Sq3SH8D1NDGNX$)bBi54!51--$*
+
+Kj0L!M"KKK"dC--,)-h+-6#KKC-$)-F)NamL!!Z06#X!!b&%bBUHp8RcN'%%6!b,
+
+i!!kV"`"DLHFaK*!!"Ym4K,,2i2X4c[,`c5!GIPf!ZcNi'8'VfJFpSfdpq+CY$8j
+
+-V'f-DZr2[36#1(ael5hmfT@1cSU66D5pqDSA89pdTP-`Z[jj6T&!PmZBFZjal"&
+
+5iG6#blE$+&kLh#QZ118&(0T1J(hZ,9)5MJ9ic*qPI!ac'RJ96QMZjSbkMq()Ui6
+
+B+f,,#'N1icbM4N"aaBr1`3Z9U'8RY'XAiVXFKp#&k2D5Be%VCdh4%,+2QS'b"Q2
+
+%0PNT4rE#%kTUFqYDM56bVjfe!p8MqmL)1VmjVkJY`U[*$&*L3AMSpB@LCQ*U&l%
+
+T+3890rL,V9klFN*4@f0UTf8Z&&afN!"4GC6G8p3fN9$4+4[-@DAeK%lej"@eAAL
+
+eU@&4[Tm28%mqqUkS(F+VDa#lB&'rlRAllRP&l460Qc,)MHR$jMh@$8Y4Xc'e`cd
+
+ZE2AUUiH+fK96feb$epq&'RAQeLG&lCDjmP+"Kr8k9#qp'eI8RPf[6R$dS+$UcqI
+
+ELYSV[*ETFL&j[@lr803qd9I2A#bi4Vei3*d[+@Urk*!!&abe0HTVm%44"i4A6JN
+
+c(2I!kjRl6a9e813DK"A6p(LjRZZGaGH+1L5SiBT[(6ekd2*ILMSXU(l)#m3QMDB
+
+V+QTG!r*NG#RQai#DNh4,l0&!Ie`dYi98Y1%1A$5hKP4,`d9cHdKP'LkD@q4hYC*
+
+%dfdLeCCNN@i9UIBNLh5l5(8N68qhM&4R`d9cfdKP'bkD@dHU+qe&XRfNZSqc10j
+
+#8Me*&ZNfNZT0hSYd+dP&ri-FGM6G6P,p5D,rPNT0`dQLk5+6'NLb5"HDe'$L)Pe
+
+X8N2bj-Z'$r$6-$NZjLGC)1lB-"jQSff@[ak%LJ[rI#%p2ddAGREN(@"V+,S6CI!
+
+I!!!0$3KRBbj38%-ZZ@0M8&"$,VN!N"#$BJ#3%4B!!!d'!*!%rj!%68e38Ne33d-
+
+"!+X[PfqV-$P*!!!'-3!!&UB!!!(&!!!&C80(jji!N!BMM#0%$L)UANhN3L9rV@9
+
+B`f#c2p$XpAVVCc-[`k20Y5bJ+CTHPScj`Z'!lmr*#EPaRH(ZcR!J!!rqMKG"q)#
+
+cj'G%46qffB3q8Aqp4R6FA83PM6`KUjaYD&IlZ@jDrY"pk[b&AZrdH*kFbb9PM*S
+
+`4Kh$c8Lf0bVe+Y`Q$amM6mc%*C1(jF&1bFSdGIlLpc*04b#X&D8[&6R%+-#6HhJ
+
+kX"#A+Bp6%6RGkB&kM%'jh$ZLmam[1Irq,r82rGM"5H4bh1ZB+b"Z%&-pD)5CL9(
+
+AP(4UUK6$!(lkH+UPFXFARF-MIHHMXf!5Nd%SZYRQj'pfL)G3N!$94X#(q25G8U`
+
+VXL'QU3Njk8[phV2@0Q92J#d6rA2N1["[!%c(M4X-8p,0IcYJf2lRBmD2c)*RQEF
+
+68m'9jqq*MjHTji&GqDp$kh501r9fqVPJe4iQDRS)L!)ELqiX08i#@40jpP1+F@p
+
+iC&))L)Qq4Bk-cK-i*h`cDlN1cMBUbZA3+beKhX*-&UD`X%ME%F91fHB3BaCC''Y
+
+KNba-C@(,"-40Yl"l,#c8`YCDf%#"XGD%F4m3'*i'k"iah[Ddam+k"Xd3eV@02'B
+
+bj'D90I9p!!!-q)[jAU2HhQ[NiCQC&f(Ne`JR!hlN1''4Sjc`)hcL5IK+f(@8(q&
+
+(1&Nj2XreTBI[M!0dGB4'MK01#CFF2c,JK"*1MNZ1(q&(11@5ii5EKimF*ja``Np
+
+#bA(#bBL6BpQ6jq5imT-m2mQ!dq2N'H&2RT2M%Nii'6$J,PF!#N#jGS3IS9Uba%G
+
+'A-)*8[#%!j-9'#r3@EpUPQ9+NL6$ldj*kVS6INIK@`*q'q$hGRJCPb,`pUJm(fQ
+
+3!#mGrdQqe$Nm22hkJ2cerNp"i3$m4Z62S5YA40V([V`MbHF@)QPT2IN@3@$ceHm
+
+I&dT3GqF9K,'&&8[6LKMTbQ6@-*%bJE#4RM,b'FA*'VC5`0BBdTa"@aNXM#)mU'"
+
+N@d@XSIKMMiMh#RbbLSjLT49GG9"F84)Q8QfN&![N1hK"A'V5F,,dJIF@+`iNJEb
+
+H-(5Nar84j!"*Q54MH+j&08dYQc,(ipT9I+aFqIQc-XP313&803UUPPD4*+UAIlj
+
+$U+jMAP1QUSfEYV2Qp4HKfZ#TYQTCT)hEaCbp+ZXH0"m5USfHDV1HbL4cCT@41rr
+
+5+d+eL4&+'hR90)iLRp$LYcm)e5McQN@UMR#&$kKqr%eHU-DBejbUCC-k+P4N5r%
+
+Iha+Uc5aj)kVfm*'ej*8Dali5ULfHDLah-l$Zfer1#G9@6l8TTf*r,RKTZ2#Q8'h
+
+MA2&i%MYq(0aCicHKfPlfDYLeJ3*FFEG3l@"HmfJbqFrdHU&IU+jRHE95BmQFkJF
+
+29)qp)93hX!aCGLfYP0!jSEU4HF9)-e8M9rADGfC4U(BbVVC66+8XR2Hj2RAmGk'
+
+kLDNk8`@p0[6F"hrG,e3h`kmm(BhDMQjBm@`ejDH1pG)YbUXYM'Y'5aD`-H(VPZ)
+
+,*i6A,Nqe)D1Y'5@UV@HM3VAE)a3$3MT+9jAGa)HI#%*E@9ie+jmf-PA9dY#66`Z
+
+[fkMA!l&$eZ3)bP996crcal6`ZRdT$9NG0S#+V([`rRZ&eae,A%dMGB2V4H%9YPL
+
+LfZ3B194,NC[ik!QKZSYlaE"deVc1$3[9(XVeFJIG0T,9**@'AVXJZ2Db$%'!,$a
+
+e+d2+8SES`Z&RD1(C`m,VlM*Aj)cP#M@ZlJI#Djp(U28`fl)VL9dKY+IXeFM!HRJ
+
+MVc0#YCpj6@!,M0VrHYh,CMQN!FBjl1ZVEPhjaCK)``"6,6JiU@@ekMjdmEEPI@M
+
+3DpXKj3pi+f`LFFpIUPrF058)N4X)f4ZQ*P5c1[&!pGhC4i@Ue2BCE"bRL&haLRk
+
+Thb#ZUK&ZK-Kc9k4Z-[QKhdaf&1KhN!#*#IdZ-XfJhdPQ)I6l#![SYjD'HXp$hdA
+
+f$1LhNlN-r4DbV8$I8iS[RSEqj#URqY@$9b3dJG1XG))%khUHJMX,Vh896Z%"I%B
+
+PFK1MejpP2[@,$LpbTe[Q%h#[hhai0BBHF+r-MrTeL9G6k!!IKHa1rmf2qMf,9c6
+
+d)%I[5Hq$1hVVq60(`H@-9fb&cfkb$BBDc1-Ck@@#jrVH%0cXH$@cIK[C#F&2Q9X
+
+[qpl(HTpEQ9F`KqVA3&iYS3Pl6#ARpIXMVpCP6[+ma`PkbJPkbJPkbJPkbJPkbJP
+
+kbJPkbJPkbJPk1MHKTlbJTlbJpqGlF2RNe4CD`1XDTfUZEYjDHE@[F0T$,KbK"Vc
+
+mA!9AAPiGS3Qjm[HQi+l-LraVj'p1i3&mcNKce1@eZ4pFX(PY@1(66rD18)Im"eF
+
+YAJ1K#AYcK92peXpVBfM#AZAIKi*r&r$U$"h)dkhp2[JI!kp0S3GjhdZZV))A!43
+
+jH4kk(TLQKF4pTXhHI!ITRb%hcX3KfeN#**1EI54a"'@Z8(9Dm%D@b"Y#qhm!N!-
+
+0!!PRBfaTBLda,VPM8&"$,VN!N"#ah3#3%!9X!!!I``#3"2q3"&"56dT,38K-!3#
+
+TY1))Uc!eD!!!@F-!N!B563#3"2$I!*!)22J1`2KbNQaPEr+hGEX``Jk!Vpa0&eT
+
+RDl*eSGZ&%EEAc@iGG+hAYBDRapHZd6ETQH'lV2AbpMVJ4lN,ck0G4lMb)fcKAQi
+
+*AeLhm1)VRfPGM,"Zi8pBG1%a3VYZi@m,@rM#2'iAfhjHacE,K"[bJGYB,ZcNP&#
+
+"$cqJ[fRG`SmXR'aMC-H6r-)AXTaNHE+Fj"HkN!"0"R[G!H4jITB&`!(!dKX"PZ#
+
+Z+PX+S(dCS&YGZI3,cN3L+P4H)V5R@D3p,54$JD"3'!j')mhRcl%mUJ)9e2PVUaF
+
+j[6lNX)ll!4,jajb6UrZK!hSTX[caD`$ZIHl,pdeVm&EaLeKG-YjQB6AKT)84pF,
+
+kB$+55%ID`b-4QF0T19ckfSl,d['15$X-4cTr0"2!dIR5%1j[S4JQa0,J4lT!pkc
+
+"EjcQ2ZmmNDF36,1DH)X!8($N3ihbR+mcX1GC!E!0fi)+ra)rCUL`#HU&V9)ke`6
+
+IhTB!b&RK%B!&4fA8Ecr8+8IBcr)4Z8L+$bmVaA0$-Lr)$3+SMf0Xkh!%1L(hiM$
+
+H56i!P'Q(V3ZXrmCRE,f[6f'0N!"Z$E6%fl(AqCL20Ka-#kRdjh`qA&CRACe[!5i
+
++PSiKjh)6PJM4H$#5%&U%HF#GqF0F$MM6fH)T68dFSQ!hQ*["e3hGME'TS#e`Fmq
+
+Sl`'0qRTZMfEcM@b8M`(hV,a,kqB4N8iZ[4Sh5b!9ddQpT9YP#5UK!NX`BDbr,"E
+
+!TME)X#08Bm,*$)fP2Ci@G1bTGUbETe@@q%4QL60h[2d5)BQGX-U5,*6)q)99'NX
+
+bP3a1pJZTH#BC&"!P%4'5XP`!Fm82LidDE@#h&eejC#m'cSQd"k1C&S(CD`*"Va"
+
+S%C+TmmkE6aJ*6S3kTd8)4GS&PNjQ"#DY1419T&!JQT+cV-0*5@'9$$5+K-58Y"%
+
+N8Ea'&)q3!*!!UeBZ'qd'!&14D",LQVJ'$qTI1DUU3$%0cAD!e9HMkl`KaGAASBj
+
+TJ#pMhSb5Rq0c+LJ3l3LJkD2dcrJM2Q%3Kh&mZL-JR(&m+L$L-)j29b,%B4br8)j
+
+X!Y$j4ZUh`)[eI!A!R(d!4AHG`LH[d[f@re6*b2mAI`)H5F0aI+2XYq2iC)+N`6M
+
+qC$b5"Z2ij,N%KHI*24K!$k@Plm*Hm'Rd8-bci0h@*rK6m%JDM[-[aZ1Nhq+IKNH
+
+UJA&mE-V&'KM(2a129!2Mq2,5(2qIrSHmNfTSR2rTH+3D'XHRfL81irM8FE,Ep4r
+
+eTUeM[5Ra8bilkJJ6f!)lF0e(0'p*Cke+2Nq9ccEjh#UIZq6c&[RmM(3ZV*!!cL0
+
+k&5l"Jp4$Ilc)-m$9BDMqeV0m$l6LhM(EAX9A,10lG,aR)2GNb6Sm29&b0@CfmMd
+
+&Mr!pHLh'hX&p"qiPVV#h)jIcaN(YAHVY!-im,lH&lp&Fc$pX!KD$+,qKqbMQh",
+
+@BjDAX[M-KFF0&bH!le%r'GC@E`LVXP9mKXdeG)3QcED[U18Vq4jY2c-fD8XFl$a
+
+Jb0pEdXPRCYXVR!e1c(f%qF`GKAUQcPT3T6E-YjCF2GYHhq#[aqa0'*p@XJl4r*8
+
+qM(Fa(e1(MAb2DUZDVTq-SD2mJ+kFAj*ldAQmX-KFQf"C5i,E1fA&P2jHj`!8*c4
+
+Cbq,eU+LUqmriLrQ-H$8"RJ(GXC,YKXYCKk(M!EcN!3MV-HG3b@DB@MEAd"P5,9[
+
+2CjDYplkH1ckr$1D5aNf'jH[,p0ehXaPCKe@(eI0#11SC',UQT)X9K3qD(G8hK#c
+
+C@GQUfADhU*AQPE#2X"A&i-9KaAUdDe$"bpQU)@mfJNfL,U61YQ4RBFiKFac+[hC
+
+Y@49Fi(Ye4UjKII9Fl[b`UM[(Ca+6ZhF[@mq`0Seer)R3*#Y$$IcK`pPc%EI6FKZ
+
+I`IV"'%bLZK'Mdl!5jqQ+3J!feU'k*f(FZf(EGY@@N!!CGAmMqd9@CrDD68d'jf(
+
+3TlQV6AYhAEJlGh4$epjV3bSqBiDXKA!BPjeTVUYp1pI,DPfESAK1"2eSD[B-elh
+
+H#"KCEIFl0K-Um0E-CFr[,$HC6Hhc`fDr-eb-HmN5*`iSE-8)!#TL+mfKpUV"jrc
+
+$X6fMXIlRYZ5'5$I94YXX-&C(`""L$Dkf)VmVe*%)GZr'mh(#3i3EqlYKNKblRf*
+
+'9fi`h"aV43`ejERI0DPfA"MDB``XX)HHa#bYS3h1c!hCcPlQ0+mDh0Yr`mEU8Hk
+
+YrAmUXCIMj8SFBkA%6iNVCjRI%C(IMj&E3@l3G[C&a#hGId-rBQbXrT)c0e6q'2p
+
+eC)89`[fJmPd62,qrh"5fBCA-$%rb1d1R5hbj`ddQ1G,60%Q1l'T#EqB1)110@)h
+
+%i!95M+ekEiM0HfqSHM1k9UQY&%V$jTQPB&VZFVm*4FmG"[Acbff$#qbZ,a3IKUr
+
+B"VZ2A1J-[B%elK$paa&k8Z63JaakNVNdL$c1fP%+A`QGIJ'bm6iH0ZklkX(0S"E
+
+8jP*3Mb,[3pbE@&fLD'2RS@ZY1`pG"kj1X1j#2R9*X*QX*TAMbYcVef*YX2)T6FA
+
+Q@D$Hf'AE5@VBGSP+2*elSqN#9T4Gc"`I)"SMr!P3K8hPL)Se--@E+!*#j8qBAdA
+
+F)f`H'*JMT!TSH@V*`'V2IZI1K@DpeEljYRXA2YJ9eU,IcfjLaVQJjXS%LTUELM'
+
+UNU1Q*M@HTVX(FV[-AA`QqadqFr3i9[JU81PlSB$r%d$A3iqhZfXV+KG!GjBeeU(
+
+[-cfI+9deX0(XqqDqeeCrEqGcqm6iUPf$i$#AQd`B@p0rSjJ6NR2d'hX'fX5-"MQ
+
+MU,pRS%(-F-NCDZeUk[$*BA*h$2XG9RaZHj-D6bq3!1YJC6AD61@QEFZ@lXi09,[
+
+#3r`40LMRE"V0'C!!FecYKJh1Q(D[`hN%90BLbX@@Y!c8C8j3QmY!ApD)[GhVGTJ
+
+**CcApF6MTA!ZjkemqUrh9AKG,PI[cVeVI+q#h6`$QIm$kKcXmZ"@c&ph+[pbaRf
+
++-2[6I1-)JqV1YQR9UpZ-&Cd9Uc'6i5P6JCdV6"8c-TKV%$1eQ*@af2(L22GJCe"
+
+VaTDFcfaEffcXh1Pef-$Pm$Vic)0VQmqbL$(+mRVQJpGcr8kVcZZakIJ-9F5"VJ2
+
+A)XVacTfpDfd&ZhSY"9l2XleH6rpD3Epa6E1D10FlQJjH!G34SPGS&qM3*fC3Pe2
+
+L`2L%lVY,CV!*T39qcpXH[fHHVQRU'%UAhk2&Qk`VKaD[,i2ZHk`cX2[6K&iQRrQ
+
+lbPXmS@QX)1Y!&RH`da"Y"8BfPYDc4GPC#3lV4AhlG+E(2&HTGaMM!VD)&65CaPL
+
+Dr4lQB&J09`k9kE(,mhf[0f[T[[2#[mfpH2-6*6k4bk,U5Z`kcd%Ia$UcfEZ2Z!G
+
+1&'%PEF2B1aKl$'0hBH`R',X1BjX`pP1-h6AD-aHa8TJD0Z"T@[KdIJ$5L*0!R+1
+
+)NmCi#mDEj(J5i`fS4KaV[49[Y[ASjjGJCfSIkdaR)f+)e-#cLpMMH4iTJQFE+B$
+
+RFiN4RXfXNFpBZGXAc[3QM,G2Yh*CMh@3!(q8lFE6#ID-P'YZ"AefKT9M99N2Re%
+
+Z5UJ[cKd0UjR$Y@%N5eQr[bVdDANH1X3[2[#XjcJ0%Se1!jKa'U#f[M%BE`p&`TC
+
+@-mfEF*1J""c`J'Sc4b0!`0Q1cH9X!e(3aCl!)H`k4qIhpfYS1)*',+EMMLJR'JM
+
+*XAVRp4,L3*6EFHJLENI+bThcfZ@BBX$BV8U1Sr-@+@iljX&F'M+D6*J-'5#(%1k
+
+[1&EhlT'("@L3!%(&RA-a6V0,2#9X9%3D8*&8fT'k`V(k5V),NCZX$kh*MY@GDYV
+
+4Y-8%c[bAlh!l-U6&69c*e@N4Mj-C)C2d+XbiMLZjUSJ3--Aq8HQ-$[R0RcMaPa8
+
+e&lLqlpUj[TGS[iMVqri'VZr9AUl[KhZi[J-YA0r"GUl[d&eFhq'YA0rr0h*pEml
+
+RqYlHa2Ap"212)[Ba!pGh2-6e$Gc+p3dqbr80[FMe`hbZAjA&I4IA2aN0'##DQ-I
+
+F0B%8$M1bX*!!6V&dUi!$KD&N2-DNDAZFBic&F2BrKF2r6-!j%"D+4)8c'q,aD,f
+
+3!-3j51B9SJP@RdlLA(j+(8X++A@L25E3BD9ki@,HV9l@i1F0$6KDbP$RC(bL'2*
+
+%ikP8)(QCZL15MXe30%"dDAVbI)DMURqBCV&i5b4dfDrbrk!LN!!@@#SGL#9B+*j
+
+N3JH#Y3HLV#@5r"fhhq@IS5Jp9LM&BLQF6+PSMTk2cbS%9c)KQ@5a90K#Sf4N5PN
+
+S5M[3da4hiQK)k+XiA(ND$YpSYSe-m)LIZ,6N5rL%!p$M"e)Z2G@JJJ8FXU,((EM
+
+pQ)@$C4*&(*ZN6`SqKSGP)q02Q+F@[iqA@RaFJFBHbCM4qfMF%h!%89`D('LN6e`
+
+k'KDkIh4i5)XM8r4*4)JcM9hKZ+)%Kcj2Rl4%aj+pAcSALTmN,qQmF&6[3Z`$k*0
+
+%H%M18RJEF-b22R&0qM&+6,@P[&-a!BIik*1U!BGKe64B611lY)`iBNHI9"S+Ab9
+
+l)JjKd5HT3V25,H+!P%`9Z`rkT%9kNCS1THY!pHQ6Q&%@$8)T99L%Sfhd5H*hI$J
+
+64C28Y,C`Djl#m$6b!XGfTmrR*X8$d@L`Y6QkdK+%4i(E8[b59GP&,"cqQPC3ih4
+
+MlA''N6k&X1iVfl4IfC%6%hNG3kaD8[4Nmd+LGcpXR+[Xb-XNFZZYEkLS`Q4G+Yd
+
+5L413!'S-T`$1NR'U9P55`+R)+U%aM8!K9-"b-+[Xk$GR5FTkh)hN*rJB5@-L'EP
+
+%j(6IK+GdbSlH-e9"XT!!TkM$335*3-%BFqd`miD+#P4)M`VKJ,5STAS-5DFJ,A9
+
+lRF6mdQ"V)#Q+K-c,[YUNl&M9XNEZ@PkXmY(k8'eCj+P3G[5T%69*)e+cY5@CqV"
+
+#$%SP0969B)9`fR3N*L#-jAfF#50kqURL8%pU-)M3+FmipZBILqkTH!E9YJip)aj
+
+%`mKhi"GMeDhkeqSZq1IU*VIi[,SeRcM3"dM$M['C$j!!BhcZ!m11mCN2&2k,$aK
+
+qi32[Hr5%Rh[d,hX-I&T(k6&F2UIBBc4(!m'9d93k(d+2NBr*-djj`D*SpBJAZ,f
+
+9j!86F'3iZ$+9LDAqShqJf[jh,cLPbr2V[SPKZ8BUA*j'UT'@jR"M,2UIAFerUC*
+
+hbU&Hqqk24KaUB492qKV`$C4!&+Z"V#$rQ"GJ24rmKPrCa6X4KAZ0c$d@5+lmTal
+
+hVejS(qNI[*91V#iSP&p#b,2@2paR1A6E52mJe6FBBMJ1dGJL*2+9p3qIhj!![Bp
+
+M('C8fB"h)XK)5,I&%TpfThIZ`BHa&(9Vm2+9kL#QA,kQIZdYiIaLYrARRVV2f2q
+
+YNG[k'UGr%8DeBN-EK0EmEAlarTd(p5,rIHIa&j&hIpETLXk#R@jbC@-b,9jkj$[
+
+SG20dc3jaep#MG,*Rm*9,kClGd#jFfLM2Qq@TmibVrRcNcU2@95h1CX5Efl"&%5r
+
+8mURGV@U5ZdHGS,k4EYRemG4[EPCrFjZ4PqYQYFV$Li`LB4cI%5Ak4CIabTc4cV5
+
+Z`5pfTSPdXM(B'Xb,d*RQlCVl-6rbfNK(iUpddhemB9))4J14@"k%hM42efh'efl
+
+%*i192U1qBE',qSa81Y2F(%qfjbIV-mbRlM2Dk!QiiGN-X@CeBXhQjHJG2R%#l)P
+
+%*m$r!"'46R)DGS+2k[XNTp(qiGGq@r81$FI)IYZ`[)lZM!cTba)YbQKh2VHq(T'
+
+iYATPahXMf583L9i#-b!5'SA3JP$LMk5FV"eL5P&e,)!2AM(fqq[&rAqqJEX3ZJ0
+
+4GUAcq1#I[$MlrpXrj3jb$ZiY+2BkkdRM@qKR3r"mcb,mia%m2lM89dZ[Vqh!-,f
+
+QqNbpVjjZ29qJCq04M`2d!b+N'UT5MqGLqX832%q[Aej$mA2Gr%)2D,J,T!VQVUK
+
+`%6jhAB9V+HAI4,rjJHFl+Pb,m4eQEZZ5@KrPp5aF@N9GqC2+ql1S&YkPdTmG6Gr
+
+!qEV`09U+&4c&223NLQNk-DpALZNdR1mDqVXNM'QAB`crlBKL%mp(M*G"*FCZ`&J
+
+DZ&cZG*Ki-f,J@mmLMhX`*R29E-FB[Qe,XDNr4DlPFZc[1GrDKlkqQYkKeBBaYUl
+
+YEqK(@E3aM+N[HKM14ThU%2X*Hb(-`McNHXhpB"3j2BDaPJB6I!Ne%&qEaD`r`V`
+
+YU-G"k"3ar)MaKKaEKl'$NQC6hd1-Lq4B$Q0G-XB+e-BRajCJ,+'*V3bd4NrqAp,
+
+B[bJT[kddmXG*R(e#AIa5)9RRT[cr!`!!$3!*Cf0XD@)Y-LkjBe"33bkj!*!3qL)
+
+!N"!0"J!!,h3!N!6rN!438Np+5d&)6!%!UE6L#+X`0A!!!#*k!*!'$d%!N!43[J#
+
+3#1j"$F$iCXbcEQ9ffFS2dS@*jbZl63NYVcACZY$0##1XPDZ$V[@ke[$dmVQ6K5h
+
+FYGEmE+(Rmc@246PGf0D9hF)@VNAi`VhS`KGM(GQA+lmmdfiI)f`c`Tq`63P23V[
+
+Y`VEH`KHqX)9f(@(E*!Zrf-)@IZi)AhKXi3[E,M3j*432"&!HrHaD@&$M#f(,qq3
+
+@XL1hN!$"3Rk6AcKCb%+1%di@J&@""TeG+a&(42abSQ*m9@@VL(4[%29TUPEGj%S
+
+NfN09'd1a&"q0T8,*F(-`0#85E)pZZ-eZrEB+Z[80G6A,A6ir2'5jYd$i*mlPdrI
+
+-@8-1XA6I6r6dUG[h&cAjUSAPI(dbhQEPDb0*+mqX6fN-*U1*9$3@'8GN$c0%(%0
+
+GelfTH&Fd4Q0)jLrR%MNc2aM&pcf8d``Y,Ak!B(cHb*GQH1E2Phb'JLQq0Yi5)P*
+
+IZ&DMccNrDX`mDiN1BLbSE&MC!)B+3p!!(FM4Z3"pmf##5,64Fd39&fA9Eck6N4(
+
+q-Kr+TK`qGQ`-&dGPAb51%'Q'J"dB3bK$iZYMHPIm%$'QJ`j8f2l6cq5j@TmTYD&
+
+8Dh0,2)CCjkGqG*&J+Y5CqU@IDmIQUUrh9q!`X*4GG$59b(1#DBYLrXT3Hc`B6B4
+
+D3NZ)Zr'(SNLFq4ETPX+0#01J@-c9Mci&E"ETe"lZK'B2D682F5pVpcl#6cM0`cF
+
+VIh2RdI%LA6N'$6l@jXi1I@kfp+LX3395@i-*Bq1p(FdBDS-m*N)0#&FB@QXXRJV
+
+TqHr&d$F[UDca!YiDjchaf-C3%T1`bTUFNM26%1V@@T1GbH#dKP"R2*d-KU#5L)D
+
+5FVQ)&NXr0"XEY)Prh,6j`NN!Fk+aB(Zk*F3lDTZ$[P"c5bMC1Arq8UD4i#5T15f
+
+KF$3@iP2*G)M2RB8&#LRFh0iTXfaMT'5S@aDD8))aK6DZ*"9[2BV(P+51c4hG,L+
+
+c53S*k44Xa8Acmd49U9R$Xk-p6,4P'e,Rh4bZH3"e6"(G$Pjab5Ikh&MNk*3JKBH
+
+am`[rd,p4KJ)IdrpGAkQ!SYrdArSB+K6p(4q-kaYR%DeiK@MHTTrT+airpFpf(!c
+
+C6D6hMrH[fSGq[SpSi@NLdj2ApC8!q05rrM0pH5A%p,FGr*AqP!RpYPrTjl,kIr)
+
+Mrc0p)kiXJcl9Cb(1%'6hP`BRQ0MP'EU4U`lF@CCrSLp0(%#3!"HAp98B52*lSGq
+
+&ZrfkrM3CD5@kEp'%2R+m!*ldPFM#f(9p0R-`C#rdT5&)cLr`#Kk#rMULrlIXZ[j
+
+d'6P$Y0N+!(Y!54rDdc&h'$"brDYqB3l4$[hhr$0$4PE$2eXNb2ieb2fErJLM)1T
+
+RZCa*(rQIH68r2Xk[*I+#iKreEj!!r52r-kc1XRmYjSpI3ai@B(RaKIqI,BSqG$#
+
+E'MkH69X[ckB'iJEe$Qi`RhhAFB-&cq&lKKZFKRc"-D9m50)#'Z6Fp%2+jFLffS0
+
+N5Tj%4@C5"GI&cC(ZFcD,h$e838lFZmM*m-eX'F$dP%A,,mqff[SF8$&N-KPiM91
+
+9NF2XSa0J@f1fH(J8"hGPCVYkTSRLJ,V55r6R486P'%J,"U5PdFrVi(p*UM20Z#1
+
+AjGIGE[0r"EdLeqdcjp[mNSplX,Y)hCYJ5aj0I@@G*jb-Gm65lHf-'iiR1d+aG!I
+
+M4Q-YACfKpTEfZ,40CpQLY-XkZ5B+lNFp6BS(cVppFXHLm)JE3biI%jRZ4TD29iR
+
+SY!R1P$QEBbjeBD*lqi'1GccMbIje'bEC1H@a56dI1a@*I@9pEqBF-qYcdaaAM`b
+
+5FjP9B(QLVT*e4Aa$'kXN*T*FX[j[jrbLXcJ8Me@X&Eh%AL-JTT!!Gd4B3#S&rjI
+
+6(0UBDSje*M'BT4+G-9BhC9*@-5jcH$[1@!XpJKl'$ZGDCHXmRb03ICB4reapCC!
+
+!(Mqj("6&rGSNfp+B@FQGKfZV'cfXb6ZLR8&V%2h"l5[mJ8hjJPR%eT0&kPUA"r-
+
+MPcHq*D-)FI[,GTp4[[$$5jiqJ&BGP+G#UkjaI6!H#dFM9NbNa28pDebXI1(,,(N
+
+ED'bUV!CChjPULFDCN!"U8NG00mXke@ZV@1Ge4VY$ke-3#PpeT"PAmJT`"+9)V,N
+
+pTl6IHLkVI,'RZ6PAIkpR2HXM[+GCRdK'0dVZpqGr6kpmXC'CT5KCd3'NL33K%LA
+
+eT(2pQ21Q5[3dR+GDX116UUkC9$)S5UXm2KGcINq`Y6NTP421bhiMS(ba5j&Vj+N
+
+6f#aTQ1JNeElPhNVPLj`GVbDV%DYQDdZbmeS[j5Xpee4GLelLG+PS4`JbeUXka[&
+
+k0V$H4$f6H2FMHFHjNP0bI"Sd(Fh4'2DERk5`R-%10TmaEFjrI`$I68b$mrG)kq6
+
+aHBBP*&LlQC0%8Xl9HQQfr9b!L@&XcMHPT*eJ*QI3,1Ibj`$iNqZ&q@YbPJ1Ha&!
+
+Tc3P+,rc(E-IjIaGE%9QEH@4l"'92bccba&FiN!#)&l6[jHikPAbI*GrYmVe9[[I
+
+)phhbr86Z2U8bGeIk!)'b%TGV)mAiNDCMGeGHc9GI%IUT&GqZ"BjUSA+ed+mA[-2
+
+LXC)(FAZaC"ZB'D&IrCc3Ep!"HarI&r!YF8GmAD,SLj2'YmVA4CaPLEK2k0IH*6a
+
+V*Vk$fS9GI4I"H5aL!-[(@%*ka9$HA3N5qMA()VUDA4&9YPT)mi[cZX*6&cM@eJP
+
+93VpZN!!h"R3P6RiqmI$[+mN)k3@15PH6#pcRH,qPD`T@&9NVUY3'[UeNf`)(%Um
+
+4l0h!LdSHK&T$P4pi$qrR04'Md+mkS'(0E3aI&)EejF*+mAAAd"56T5l"Ckd*lZ6
+
+dYG-("ec$9*M3CUehlN4&9Aer+0`PT+AR#H3GeRp3FMK[%pq9er8Y223JLKM!HEY
+
+N,mdU@jbA#DY@la65UhIkhK'(PTE4BPEM30kDR@@'[UIiiUc6TNIh["CTp`k2hPr
+
+5`jXLjbc1QSI$eZbmE28#KdHUPIB[)RkQV95-AKqV@,pZ+bUiLHmHp@@M''(eB8f
+
+f*6X2R,FYF5Vrc4ePeE6)rfDaf,5cCM&h@d69*`VTa,5qikYhmZK0Ble`+6c9aU-
+
+'$C(cf9ZKQl&q68LMIi$490Bh%PU%6PbL0f'aB1Hl9(X5aT1l$Kj@l3YE82GhXer
+
+JkbdqLcQ3!1Fk6iB8YmemmZL+iq,&A6dRGi493YT#@5[6iERXA%YphBr&!El1[CF
+
++&dD44l1b0lLIpNA*b0Ie[@mhS`,[c9hpkT&bXm8F@aUa0,JLKIL@V(3KLJm!)8*
+
+&l+8LDUmD1G8`KVdmJ3fHfLH1XVUTHZhcb&J6TE``hq4Z-c@i`ef*B0pah)HB(K3
+
+H'HbMU6,f$BBChH*)C%0(+c3dM1IjL9Re`SV`bmEQ#NIi'&Lk[$Dk84behl,DCHN
+
+H16RiF'r0K2I@`Gr,ZCIaFJ8(9XVm+EKbPreGN!$mr6@mUF84qbhVQ,I8i-1$d1L
+
+YqD*,(#erAVJEVY!Kh&Y92c(6UfI+c4%lZQ4ZC'U$+c`cjjFl(c$,5(pJUS`F$5#
+
+EZE0`h)YZC!jHBaAMZcmFjCGm1&U$M9+Ne&j+T4(,h&)bVh&lrSC-Tmk6jY8epT%
+
++KrZQ`[0dKhfNlm)+9rKGp,K6bKpRq*MNS4mHqT0LLL3I0lp35RH%Cbk#'pph)mE
+
+6[h0S,fP#'NXTD5D86d2hbhap`Y5EHAZ(lFME$j!!1d1fSr"6Rb5lf@C@BB2jcJl
+
+d"Pmq29"SQ8HDhKll%9B0qe'T%Lq*l`B@mDEXREcc)d9M9,K%USLj(+VSJHQqK)Q
+
+BUR$*mLCd,r",+)phKPA01S'YCFRQb(lRkmXX"TYMlpHHARDS*k*$hLm)m'`$`C@
+
+&''S*&!*9bDJjS-&YYQGB2'VT%G,Cl`MTLd2Sm'j5'3C),I`f)I@3!2%1,)HU+UJ
+
+[bkq[4qlc"L&GfMhFDr(rrZQrf[,p)kG15hMhd4&b@XV0CQ"E"aq41''CBqMY(fk
+
+6'%db`c6B2p`N-G`b3k2E`LC4PM$L%f0jKiiA$`FdZ,h'8JHGYGjZ,MFIA,hUZ$K
+
+Fiik-#KIi%CQcHi)c,(2FXEaGVJlG5DIV!UPX*XE&5&T'QM)AD5aPC#KEMpRZ(3F
+
+@d#@FcrhLGd[T9XjApG)IRkldZGhZJ5-RYrVI*)HP'-lr3A8KTMck#[J2AZG[`VV
+
+Jha3@r)a[((G3NfNVUYR5CUc-9'i"NmFYABR*P@C*M$5iH4*6"eEDLVfl+"l+"(8
+
+@M14#qZ$f$FE-%Cr66QkRcbQN$fhIF,09`KM,jee+2Zp$4fakRpHZ&p+X)mlfR0d
+
+"PD(-NB(YG[A4!D[DjheP`1FGh"ibp'lGS''H'jf"FrF4Q`L4&ES+2A+LQ%dj*8l
+
+JqAe2P46cqDAU"Zq2[3hH*IV!V%Q9RJD[$Y[IcD0hlLbM[MffBNarf[!E,'IqV1S
+
+aElL)9fHGF2%%2`0UDi(dPMEbbl2c%Kck4I2iE0i!RV[80kDaL&r1U`2Q5CH@"Lr
+
+[j0%0QdI,$*Mbr0mIb&Vl[VlL6mAA(hfaa#pj@9j6KDPc$R)3I@Chp&h`$&mbSC-
+
+1!RXIf22!RJ6fYm!H!,BEf0m"Hh*LCMEaT63VNSGE8@5Q-%`Tk#5JFa%k+H!Y`!-
+
+bRJ6HK'V%dHZYf,SBN!$R'c'C1LBRd`93$,0Ui1jQlR&I`LU#Zje9!2GEQ52F,Ia
+
+k)@hM(PmfejF`2MlEaQ@pYK(Kfraah#la*h*F5bXCXX8fMUr1HS@dXLKKFl&i-D,
+
+KRHjGikbVar'Y9la$l2RB6pmR,LdS'+0CVLaC,H`"dT@r%Z!F2cScr3P3LVMhU0$
+
+RDQ6lXmIBIJ6h2FZaT-(pd#Tr(GX$[`!BEfIS4+1rNEepHBe0*1LCXfaR!QFkYKh
+
+"[C!!E89`RpfiTTEKYhU%C9l5FSYb1eVZ[NShdqFHU(5[B[`[Xmd%lNp8ZZr%``V
+
+Z`-Sk2q2e,eY9c6DeamCH2MPq""hf),AJ0Z`'mAk4BHU,`2"fN@(D$$6B3eKJHLe
+
+ijh+BEJhfCmrNX"X@BR0iMP35pJI3b"!RLM2TKUm#`jj4mR%B@%X1Qrhh`&k8X3q
+
+"I82'4(M5h,f&[F[64H#l[1e2f"XKA3FdhPMh,0f#,XX(PR*-SARJ23cXC6*+rTj
+
+($GBeQHQ,U+Ad,JkXA`G[(hJpP*%d'S#PC1a"B'rNDPDX"RC'a[6!hT)eeX&I3XE
+
+f-%rDMYpUEQfrmLafmJQYmYTfr+%XjmL[Mpm65YCl'2rr!!d!#'GMG'9cG#kjZ@0
+
+38%-ZZ3#3%%0D!*!3(m-!!%+&!*!%rj!%8&*25NY"5%`"!+QdiJLV-$9B!!"5l3#
+
+3"K+K!*!%$I3!N!Me"!i!pCQCc1abX2*Ef-,&mj8EA@KjV4fRQfkf--,fZP@[Eld
+
+Z$dq2VmN'A5Bp-hbAY9lHAJFXfQdl+AG,Z2)ME*&GEJRrA-libQIDl@-,fic`*fc
+
+6K5HKhAEKE`YIq-)mEQiRK(pXXmb@iapGq-+kKCfFELT3q1c,IZ&ZXPf1@pl#b%)
+
+ffjdZC,)F@FK#&m,)B+r,!D4[CPq-FBbaqZ@-eH&@A,@%-I9,M(@V+THFE3i'I@,
+
+PFV%p`R[E)f,)lA5*'SmV)SBMaKm`"H(DkkSAQQdeb1%*lP8%I"Kcj(3rX&H6m0M
+
+IZTkaqjrj`UCT$PZ9X*!!V`m&fSamV5GNj#ReR!CAb"Z-H0XpDBqF`ePa(%eGaiT
+
+)S-2EcP+HcTr1B+bXmm9Kh'q$6Mf`X[$"KF4R$RhYV2*CXk3m49H%V`fdL)`T"cl
+
+J+-2j13Fpcq@-E8&E8'&IE%H%!Ne3,pZF#1HDf2Hf""Q,&l1('*Yr8%EphJ1GXSF
+
+r%JrNr)3rGBV*(aq@mf,a)FC8Kq$ER2+`6KCr)B9h0"r'+0,%0Xm[rQdqSqFB2cQ
+
+eBU69f4*S4krcbhc8LClZG$iIR'*cIAh0I"abUXM3iXkAEq$(ilQ,49r!j3f+,H)
+
+maNhp56c112ejNK@"P6JkPXIB&fjK8aKcR!drZX6iG+jqq&li[TdQiqM4U(!CR@&
+
+rGU+(,&FBA8QAdZJ+kKT@q*eSAPdm1Mm9!Sj'C"RE!a%aQhqm(IAaK-)B'-FE!ha
+
+jS(fj'%,(Uc#'FK,*f-@9@FC3113DEaI$J@M)*3)Pk"9$i'!+Qm`pccf[0,(*#J2
+
+h%ZcNS8*JE#k(6ij38,[0q$[cVaRB"FIjhRDA,pSLmUCDTmXQ1P[%8(M@V%X))mK
+
+*81HhL'j[ZmK(3P'46jb,ab@$h%jI@)iU6J@&a*8bd!J5%NZ'TC%NDKY",5%K9lA
+
+%%1kQ%f8Z9IE(4kQ5X*9Mq!UPK%dirih2+53-k[E(m!QELQ!-Rl#ccq$6B)6Z-I`
+
+FQ(52iC0Hd6f'2a&QlKPm`YDG`5GX%V)aI-*'%r+rq)3prJ`qB9260)C2f"21i"-
+
+feI!B2QRI@@I`#A[5'Ic*-1NH`dIV+GeMrFY8Q(52j8mG(mdXar#TGUKe(X1R`pq
+
+T1G'EYSlfTT4IFZ446jL-RfpLA2G!eYX*@kf3!1dTXPdLfkfbh5AE'fAlbB5G8j'
+
+`4rJkCZFXKT(SUhpj-0jKc0+KVIl1dd)2DmAG-GY8*93X&AUb"HYJr,'#0E!H,EJ
+
+1NCe#Mr)KS8HMKZmGh)rJ,V"iE"haZ#h!9,BPYJl''HE&0`Sp@9F+$qSClfFqB9h
+
+h3F6FlY%JbNC43[653pSVJdcS86hQ89H[mbKL98+8Rk[YF1I00PeH*e3+2HTqAYH
+
+N,LMMCc%HqGX+1SASE&1&f@&'l%0mMD%M4m1VBND`e)EiiS,VCTXD(2B'40m'rl5
+
+#08#c9pE!hmAAm#U26ZK4E&E48%VR2LJ-CTF+Lq-[Q!rPj"[UJRc-'14f6EKm3Rq
+
+[HC!!63aQaBb,eS*44IHY`T9#9"TN-1YJpRX&fl4AmahDMZpMp-1B4i1Br38Ef*5
+
+LZGT1Yf,T@L'kG+hYpILK5iVBA1+i5A[CfL*0plhmp&KCF6DUCir(CadF[VkJLmr
+
+hl$189GrN0XCQaUTQQmSPVV*HpY33GT)apN++X4le+M"i0Epbf"EcSZR0GUYL,E'
+
+CL0P[#,$5,pp39-AQe,`b2HjB@cfAZmLMk)i,dH$ilTe,er+S69fpF0LG9mb$!l[
+
+R31a#i(BDla#LU"ri@"l9MH5GKNUFPjh[CUb%le$F&p6Y@VGPQf+Mf`$HhiaG`0F
+
+EE!CpNpCmJ'NLh(AkA6XZh4NrZ+jVe`eZK4!eX*L4F(JZ0X03ArHcH#pICpR!*Pl
+
+XK4j0L8ffh'rc-KeIere1L4i-[$eMkE2E5r8'IIXP(S2Gl*Q)Zf#a'@X,Qq&K$)b
+
+8&-E"[@,S'A[+pp5)VrqCMI&KiNfa[Q3Qde9lQGE01baYqAD,Zb2SkYi*qa$K!H(
+
+QrQk@*rZq5ckG*6lNDIDh!N0&FHA[kK@2A1Tq5ZHFEh)rKLLeYSe0M3qAR,I8E&J
+
+jY+[rT[A9)lQhp[p4)R[CAjVd`eG)q5Ap59[1Ed$+lfq3!*Xb2P4bhK@8@k6rTRj
+
+JV+rq[$NqA2U`m"9NK3VKAUem9mqHIDj8lbP"PFc`j0R0lNQ*I,N$6AVCdp18*hY
+
+f0%'EZEh)H$fUN6,B3ica+pmIjZHp2ebp!DT9@&,)#Mf''B9-IjQPr#f@rm`"TRV
+
+fXT+Kq5E,f4-2X#q@$(82A'Tf[iND,j2dTmcpQ*4$$h,S#F8M6-VMR%F+f4IGNqB
+
+J'pZ22,VGhpLkJDP%PD'3!+P'N!"h!rF@[MkB[ljcr`h&frIIb#bGV(J(mUN2X4*
+
+pX9j4GNhmp4Y3'hcTK+D*KTP-YEkVC$Za8E*$BZ+*q*Y0FrMmf#+ql$LLcLXFCJU
+
+2[K5SU)%*YQ!q)e6KX1%9i!l`mjL@,h-VR'U"@M4@E)Vpm1i&"NfaDF-GpbrBfZ9
+
+43qpR0r'kZ8c&&BRN0640K&FKHr90+PMRPJr'GaLkK'MXKd,di#&8q%UQd23bTI"
+
+9"Y@$aT[+kbSUjl2Z'0pB$phR08+dF1AJHN20YhDrGZhcfjrC,IPAlKKLCBC5[4k
+
+q9Idh5c&Z18Dc[QH`6BT`b"(jr6f$$LR#)NHSe0H#a(a5Q2KG+Ee$aFHh0DPJl5(
+
+93@8ePZK,p9Z@,YNC(kbfH)D&!Aj)MVPY*'C3MV'dDpHCrHTGCHB"TLM1TeLdU%9
+
+-9@4Q+N-4da3eSVGlhF4QX!,1CRRd4iAX3Xj@qF4Il+k`@5b@hZfl9Y@m`Nb'kFM
+
+m(e%[4TI(rJ6aDdl'AmecRb,-rM4HPmkJZV0Y@[@eEEU+cSTV%FR$LPDJFf96T)J
+
+SBV95T"T4851Qcr(ieNkAfS!@ABKZ@GfXkpaZ+bYKPM*EQ4$GZVVj(+2NSbLEp4*
+
+QXhjcHh'fc9U5,85T)[CflEd"+)FkYrHZ,P(Zk$8UEGDRHfh@rY@LC[fUCKAPh&$
+
+@Y1rVM$T#D)9kIMCdBMTe139Pm1GfheX`RFmY90UY2l2DVI1bQkD-SR6CVHVV',Y
+
+QH0(D)YCpAr&dG(pClTG)CrkkmRDVHaU[M*8KLl[iXi"f16cV#a[iKE'C33leSVV
+
+cA&k$1%ZK,B8aKer)+j[dSeNDl&DqM%FeA$0FT%'A9r0mEmcBIIHPIa9riGZ2&Y4
+
+)Z5bXVN6AH6jd%(9@BZSH+"mmR)p+fJ,I1r!p$0mpm2dGI$I#GaYmI`rI25-pFcj
+
+Ib+CiY,#QH5B*Jb`#R#"`$J)R!Rm,r%fb2`5r!f`%81ZYQ*CVS1I,dCQD4M[6f8"
+
+d%aZ`,C3pl(R%#1`5BJ$fKC34E!2I+%5,Z6XAc,!&GAHH@mc&V-9$`JriRE!1mdm
+
+QBJfY6"1EAXca96'V%%d15UJ[MKrdU2JbblTde+I(r2fRV)GU*0F[GKFZ'6FZ&@C
+
+!@&e$S`1V*BfZ3,[Ekc'f'QM#1TGaI6mfFAd[dRd&lTYa2mhe[DcQqPkGarAYVFD
+
+pRq[EGj!!kh[Gb2@pdFVerHebVZqYjlLqJ6bZladIehI`(Ul[(a4Fhf(J[@rMqRk
+
+qJHZ,jh2ph!,FAqIkPGrNqY@YA,rQDG`$A2piD5R$)dE#I+49a0+%1a6`miQp3Qa
+
+bq2hBFJaMcC%A-H[Lh9kI1084#2JDa"!f3ALEk![b$C%30K$$+Rp)$+Z#lAk4M'@
+
+U"BZ%FY95Keh3%Y-m5!m&aNNZUbm3$MY$+e3GhSKrHRQY-ib9%UaRb2XM&r&Bb[Q
+
+$#1m2Y(MG+riPr[FUR"'4$dHFrL$[$S4iX30Jl8iIhq)0r5khhm926M)p@LJ6T9)
+
+i'P,4l,[)jI1kP[&L+-6l`aiMMHaaP!k@(kR(!$5jIF64)2HV9c"fkm2Bb8M[NA,
+
+5*ahe$KKB9T9'TSPBKI4**`H4UR2Kk*+M&9J[`FHC*Q&NUD#pVUA83F[45Jadk'0
+
+F3Yf1$dpTM65,Hfl&AGM3!#1U'a&eQabGKF82I&eA%c-D$%HjjT%"U4TMFAb*[&A
+
+h)@)HETXFRBf&$h`V0NVHj1U3!,`K#cY(qL511H*j`3MI14L%iN0H')LU%pY@kEb
+
+e@+I!ap@!&jDr$K6[395bNR+a,%&ISM6!LST@Uj*V5MUX3Y#A)"$4+kM@NKY`il$
+
+S30pF$R`T#q@S*(BHeKMSieHp#Flf)`,0AQTaDcb@&2)PHQQ)5fb5Xdb1cXF+!Vj
+
+N8DB2,Ic5f4Kjid'T!M!XRlE0,$48%8&NcjVeLhiPLG[pfVbedR#BF'qX0CFl+(-
+
+SP#2N$)DCki1*FLTMEYAMF%qMfLlECUkT+5IZR$kIUlACYmcS)YhC12(&iZ3YB9'
+
+@5Q5*+ZHdkID)X$BCAmp+hXKTKT6AHm#U3r4C*hSQB(BrU*ZE[*&EJ[hH"NF&f1H
+
+b`j%@Ei"`&+-i5TRYhSDUbbZ*lE"hTGJB!9#%@0JA5pj3Yh-5l&V,'fQFRq0a03C
+
+$hZ956TYb(mp1hP#k+8NN)bQBbZ-#L*FT4c0ATc*h9&5!)3dB`XSCTF08SdMC5D3
+
+Pj6BcCAk9Up8CNNK#jN9IDNVH8!QCSr)k39+0G(N`aFD&eSVN$99-XdNF%CZY,D(
+
+`"a@L69D5SkS@&F+T)ekr#"MM-CcF0*pfUMM`5Hd-*A450pjlk`mPT8VU"Y9h0R3
+
+Mi#,4b)#J'D-9V[Mh#PIqZX**-8jAH0BrUp"aT*4UR0)#8Sh6@T!!8Se6@T!!maX
+
+Yd(kN"FGd1[HIG2TA[3DH,8Mf'TBDXp4V02ZFVQ8q2,U3!#'KemM%T"XRp@#KVcU
+
+Y"q@f5Y+$A#aMZCD&Srj`4S3qiL3hckljPY445pa8@+b09#FYcCj'[bpc@BGcr'Q
+
+!%69iq@)m[C*8URU(RG4!'ib%'PfYVS`*8j,-6"h[aReIXbG[D8k5c,e@cYh[$#h
+
+lT)pilFFr65[(JLU"+N',p`QF2Y40KM[Pq2-plHN1e&CT4R@a((P61@0C"rU4'Q`
+
+blVmMh8FNDTaTr9MRD@`4JjR-qSM6-pGM1,T84T8160L3!*%BDI-(2jh'hIh8YR5
+
+r8BZ42Y@"2cR5GhfQ,m$+0,B(FZ(*qFCchdR[JG5Dl3[K98[0EFBhc6Jf!k'Hj$p
+
+R)(rUIIG)ebZT#lVHd,,'8%3DJQ5UfdlEP"@LKiU5A8P9!ff@U2hH-(@biF`FQ[(
+
+KV+6++NJeiI9JS(a#A@K@FPTGe,p@Pj4QR&)AdSc6kT,5M&2U3T15dqU5QT4mULl
+
+T5FPrl#eaeipXJ`L95k4YN!"fmDV'M(FlXp`hrMJpBDZc9%XlCB(Q0M6#dJJhdpT
+
+%2bZdFd30'KTT[d-6#2rA22prCQFCZHEjar[pNj2C69PYp)K@DM)V+8'fT!3C%RU
+
+0$!Sc%%F&0K8NII&jQb@NScQPp1@%DKc0DD4,rDbV-ccd@PV(lCAPY$H4%a*G2UI
+
+ARl'MdM)(c3+5MpDF8)f1Rr4*kNc)faB*9I4DMcVDlZfJPej1UXfAEck8RMde1"C
+
+Ci0@')p(QjN#S(A*Mr%a[J*8"E)T3G!%pL5YhHBl+"RVj4bhpa)5,Y@G#d)*M[FH
+
+rp@3IGap(N9*kF+TlbrUSQrlA5IIaD[aidXeYj&CVNMH83&CM+!&9RaC+%&Q"[`%
+
+!PM5C'9(,)ph(*fUTr9!YMqT9DV2iP&iGfErj4+r'r8D[mMkHFibb02iMPNjf1PA
+
+[d("$VLh(CI8d(p1LX&VN*cJbP(8k[pfF2kE#ZPqTX(51-%LC%ZXU[a22)[*i8[E
+
+rZJ[cIcUGL4G#pHMBk,e2kCF0VX,2PP#E5Iik[#T1$qmHrqXJc[6'Fa2`XLUETTM
+
+$*YV-$D3cYp12%m#qEb(qhJ$feL8eGE5PqJMF0!YqXU&'QZAY39+9b(8[r8`"-MX
+
+Ah$6![T!!ITF!pTb'bfV*EbNA&PMaKL[H#UA+i@kTX"!qGeH&C3R&EkCI&X"$k6d
+
+9PN9@f#m[VUY"R%+aB%N90%@4PhahPUZj([c3IkY-$A%eUr''+[Q8"m(LQS3[kcE
+
+1G+!PiF[1j8b6mBiYqG4I![EZK'rFji"Ab"55leDmdYV+9*,[$[MHa&2kj,XIH(K
+
+90KkIa-Ep'I$!Tj5(&h&2b4cN`,G2pSf$$kqZ5Vi*m(hh+pHLCV(B#pqMEAp*2`L
+
+K$S-ce482X[1!F4&mDd`jE#EL`-(e-DD6q,X(FCd12IXm1+#IdU#-2SFi1q)HB*d
+
+54KI`ANVie'C`8jVJFZTNa%85A%ip'ebqP1"bkZr$jj-acJ0'8-Di!,i@'@-Q-2E
+
+*q68KTiMXZ`ja[9RqCFj@hp%rG"RpQjINMlqNrpQ&-qA@"ki53rAP&2rr!!!0$3p
+
+YGbpRBh4PFh3Z0MK,,VN!N""453#3%#pd!!"+8`#3"2q3"%e08&*0680$!3#V,jH
+
+ZUc!jB!!!"M%!!"R%!!!"V3!!"E(*MaZS!*!'[VXM4!iL+Pj0j%)PIdhl9fbRBC!
+
+!DR1(JAFp3hUJ2KNcZ@(k&LeHlIYc*cMM1X2GRCf"!*`N(81C&iAQNTm4&Ifii1"
+
+EpGII4h6#PiP+'R-jb[e$&IeM12rA3hh-XBk+D2XK9#@U!P9e!@eRU22XRT!!%ar
+
+%6jaP3[FjFKhiIjQ@hidE$&25cAm$`-IrIXai*1U*jZd88q%pXX1%F$M`RNJbAQS
+
+ih%%N0J*@A""6p[pE#%1,cL9X%K8j[Z%i38$F)*'R%8!QpTQQT&06TCMf4amme9+
+
+jii[1iC(HE43E%aa#QlrCjZ4[GSL(8*!!e8D-E"#r6LR@&GN3aF6F'028K*cdTGk
+
+aT$fkUhhK6F,P(Tj11!CFTLJ+QQSXDINp,M$RL-+Cm9q6j"VK+Hr'rhrjXB16b1@
+
+iec&AC&Z,)bAP)A[QZNkT`brFF9bj0@L(b*(4H3)$i*YCbh9`YK90aj%$0a!Gm&!
+
+,de[B3!XlC'%$"-Eme,D0'(Z229-8DlB`9Q$FC!Y6@9L'KA%@PQm[")V0YM#PKBP
+
+$[mI#m!L#i#MfjAH50i4eE512Q3bj@@90I4m!N!--!'XcXfpJlh2Ij$4lRaZHF-P
+
+a`Tr-D)4&@%FjIAiV9hi5rZ3i@3NqRhV5`hI'm8m[3MNjENHi%AjN`!NMR"`rbB$
+
+bTrc)FA,m$%r*F51Fm*03FTa`FTa`-Q#%%hlN'4R`Pa`RA(+FF+mMamRa)mq2m$2
+
+#bB!#GjN8B'@Y6-+0iUpN*rl)-F)*2m)*8[#%!j-9H"9SN!!()1QkKK#+`Hm@K$S
+
+HJ&m,rN[#E`hmIJLEJ,q0bk)PQTCS@&q4J@q@4d"9U,FU)md-(0Yrf-'kLSC3Ech
+
+QTZ6PDfM!,6kXTJh48"8c3%-B$Af2ZR8CG9Ip2$-35k-p#&9[4Zd)$4`EE%%G46!
+
+,R0"9-23T99CN34j4,-#2%@HJ4P(6T'aDQa#N[iMDX5G2a3J5j8hqU`G8AI)J-HU
+
+[2pc+8DXTel3Q5K1DDDe`rC'MeMLS#5QV5"2QC-jFKV@(Y,XiDUf$'TI6Q941+fY
+
+NIrEXmabeMLSdTZC&6Ae8m48krm8h(,@HFXdUSU`BRMk!q[lRHBlD3,RQ4#QENT@
+
+#"cXRI2X+4ie6jif)dMfM+mkEUadrc9%E(G5'h+TKlGFqRHHS#3He,LFDrPe`h($
+
+QCBlDa(3e*P+'jG["RP9riDM0,PI9V"`8d09SikJYP'YH1C5kHVfHlZ'SDkKIpI4
+
+i+LIkaJ28)bpbe,88e9!N694cCG6ZNqFjkMUUN!"T6DE6ZT(h&AViKGmikRVU"NX
+
+TAdR(H9q1FY4@bY@D,XL9SfF2rY6286HiPp,*+'9G,aJIFG50p#Uce14Gj3Y'd81
+
+Ek"h5cFV&)blrQ+1f8B8b8UTJU&0#eN-9cVh+8GXGe*U-j!-kU)P6p4b9*UB'dj*
+
+PCDb-E#IIrF$K4qBkCkfIRK)eFi@ZrFEXr4ae-h@$T1I(e%`C&K,!AUi3T&L#1U`
+
+I'P&bCG3h(rRp#Fje+d8&50fBrKHeFp&j@4Q5M3GV$pea1eGSfk+(0$9pa80R1GF
+
+ZCkfce*a5FDbGI1mKMRSpifUSq482fFRj!BlD6Id+#UPkaDr(MfcMU0YGVSSeRLY
+
+8Z0V[F05H43q4)19lk0aM"lL(GMKViS"LkT1'T(MH+rPeTkZ3!*U"!([&H8FjkLl
+
++0@RS306mKfX[64ZJ+`31D"5@fGUaCaUiVRd8Y@!C+5NVP42Ef6h&a0E[S,D5e*Z
+
+k$e*4k[,4R"1qUq@S0cKV-k$Hk86c@fiEqT2V*rYSlLHcfePEppip1YM9Hl2Del9
+
+2!&`"@TQ,U#F1&[Z''jdelZ4b1(ZHmdimH"0(45eR)(&!*q9f)f6q6PCX0VTUBad
+
+IAd$pf!@`[ik1Br'KUlR)+fakrN"cHF(H36)2h%jb&H(+NrX0&jMF9VMIj$*$&L)
+
+T"p)0cLf`Yq1%"AXR6JQ`Yq'FKMf0GB,GdbRXPYLiZ+lq4#IBL8k`%jeJ*cV"6R5
+
+#RHJ%1p%*GU)6l%3Rf)P1h%qc#+[@Y15RS-eL8qhT&"fJcd&k4dVkK,dC'pb'AVi
+
+MRZjKXmB'HccD3(IrcJ8G(KYmfk)&p1R"5Hkrqa'fKQc`$Bdfm0&Ek'dF5*Cm&25
+
+6E"T+qQc(16M5i"iI4FpKHCCb3p#-XSR6I3[1YF$(e@dVrAm(hAhGA,f#1a4fVQ`
+
+D)a0bM1IcX19PNiJXd-QrQrjp$rTP0Nh4$ljDEE6C0*GdfSPEQNJ$[AaI"9dkQjE
+
+)"&rjZ5PSlpQXL6c)65I42'&jkHi((6HE659pGY(F%GhJrk#CBp-AQC!!QcfG`RF
+
+BE0C'2GbTm18(Qh@4"hI+cbI"'a-fkb-2I05,Qq*VI86`ZS90Dq6"IEUNPpZrZ6d
+
+IkmP@hp@`f9$5UmK,"LjZ2dGjKIdd'pTRSrf,Re6[[[HdcbYXX0R3aK[KcVI)#mr
+
+A-dm"R8jJFcLjAc2T0r!1Xr%Ph(NRKdhm"Y1PM9qd9#9(PFc#![X)[SNKr!e@jAm
+
+!N!-0$3pYGbpRBh4PFh3Z8&"$,VN!N"!4c!#3%%+&!*!)rj!%68e38Ne33d-"!+X
+
+[PkkV-$P&!!!'-3!!'Z!!!!'T!!!&bE5F%03!N!B"fL0%$L)UANhN3L9r6IYAE+G
+
+KN!"UFiH"Gce$HU!q'61jBIV#iB$[cjhJM1X-GhH'!`%ib6Q'-Lm+c58r)bVkFF(
+
+"YqU[[irS4$#9MENFjIkKL[iaR2rVS6lQ@%G&Y2d3UK*9JDUkJ,Bce(Pf6fJm&6R
+
+b2Z8HRJiXa'A+ir""h#2TreqK*11PKX-G4'@dI[MrP@fl(cXiL9b1Haec4BbeKmP
+
+aeJj"iNA$iL1d#Y1J+HR89#QQrG%86l98l[LLFhLNlhad)NaL2JK&0pZFr-d1m4!
+
++XYS)fcSm[diTeKAC%-A8h"M6e)5Fp+AHXD3p1ZNm1FY%rabj$[`E!$0bi`E$P26
+
+rG@!p"$aQr-JXH*CjLX,-Um9UPGj1-5VH)fY@`*(4VHaDSf,&r6CPrlq&--R1K6X
+
+*#r!9a`Q#"HZ@0$hdcLR&Z$Fm-LN%a%6I)NG'j`NF&EkCY9`(CaX9iFL4(fpK!IC
+
+B8#c-*P,XP1dG-@D4KE%@0XR#9"C'PcdhhF,ZXE"3#eYVB3-&a[CDHNU"FB-@YXI
+
+#PPJD!bcX5f0T(aH0)DaV'hR-C-M0+Q[Uq``!Da0l'f3fmMSr"jhCCQZ%N3NRNdf
+
+14LJRP"rPR[a@3Sqr%8D1NjAJmk5Hp2#G-Ic6Le"1MJm)Pachb(2###I(6c*J%8k
+
+j%8k1RiHRj,J46[K*+$P11$P11"P3`JNrmS`-q)!-Z'6!D6eKj2L4C`f-F$+J`(8
+
+Q"D$m9QE4e,T1r"&qK,q%%k6J#3FQ+c!qS%%HJ+LU#N)S",rE%'S`i2Fjq"D$ha,
+
+iI4qf+2P[K53BJQi)Q['&0I#IjBQL)Y4CP"42pjcUHm,'ZSf'8'HBF--Ck@qdLS0
+
+b3K-d'HXH'L*+S#ZS9C93Dp(hThY##E32SH*'Y!@KRP2p0@MV!TJ"6QM*DZUi,'%
+
+T+JeJ!r"$PM03TD!SBLUKM%E&Qd60d0-c)3Z*mVDqK3&9&I13!!6eTfr[iUM&P'Y
+
+#%F4446G@Z(l(88YXe)LB`Z+S2TE@Pf(0!mTp(,A84Uf3!",*H&STD'4qmZcc(,@
+
+-+M3XC`4&IJbl#Phql%Z1'UCF8eL3!,#@e`G3hrdd`e(,+GHd)+EL%XlQBDHLAlh
+
+-85ZSm`B%mB'K&HG0PBjFj+L90QTjHXf`jUXI6h28L)eDPKBdpblBE[Mm*BjDaA6
+
+94Z1DiGV"R*4rj+M9$PGCAcdSS+ZfQD2@8+iCI$4qqhSpdmj4DkPIeF4)2#fiaJ2
+
+8Bbpbe(889F1L)XMT!QVVKFXFYBiUT"YMLB5UC9b&(RhKCikkRVV"`)8VDEQKZf-
+
+V4kfRA)f*V,4kp-cqUedFGB0c+Hf-8Y$eQ[B"4pe)Vc*,6IQVI%eEm0!QHSG8IIA
+
+L@5lrN!#MEUCQhhrr8(p,Ec3@kie#4,V"pIbK)a`9-T!!GBlk-`E@KJ84,f%LG'i
+
+f[T!!!'KLUKNie$XiPM(N0&lQH[KU'dGYS"j+L['X*Sp(8hPGSl0R1'UMM9U5&&e
+
+!'c8b%qDSN!"L,3rTKL6Ki3+b'A[l2CZI0G[Y06`a,LMk#PhcpFQ(1'S6pDZSCSE
+
+PC!&fUR[r&Uj3-eASS(Td!+F,U1H1r2)8jpT#83&5e5EZS1kBGej+JZb9Kc82h(-
+
+h9kKehN1+R,MPS8ZFDjZpPPPABF@aCZbG`abeRA(9j-b+KmcBG!p(lD"q"B9NGG@
+
+[CimeFp5G$PGXM+5cUec0YcMUVRN2@9(2pG$Xii2F3jhf'KR%ZMUQL6M[[CaIGcX
+
++b8Q)f,HFGj+MGP'Z-8d&S[SrA2I32!5k3L5#cQ1CV4NkAXjer4pehS"JT*BMJmh
+
+eq+jHMVUAFXdD@Pa-LB8NHQRI3K)PI3p-0D6jHqhb!-,0lkJIrAq#kpTYIkZh1S$
+
+iJj!!%H0,"hSUqR8TjiTU6d$LH!3qd"l'QVp5(*Z0MQj%N5IR8$IK#2YVk#b4%AU
+
+KAhRjVG*[D*cA0T*HB1mJp`hf9R+*B@mR9a,f0R*MBGp1mJVX655"`0j)XK,X1mL
+
+pKlf"*+irG2*l,$B1E[#"6T2S$,#X@[56ejba+FlV&"bJcm2dMZ6dm6Xk0U4jAES
+
+MHGhp&Sp0DH#"lZkGmrT#0Q@"!rVX)TRXhr[K0j4X`S%(2RS$[3RXDKCpj(@KE-T
+
+cqZ`NL6E3i"kI4160319LE["D@$B9G'mQ#4Ai1,Ued1qGG(GeFr6blT!!hqqbU3a
+
+-b$&jRrZ0-TY)B)&1lYedll[ACE1T#Rl`e9TlcUBkTp0ZdVF%-H4Z[lGR8a1Bi#X
+
+h0hN["GM8"KlNTJYSfQ*jrHjlI6UE66PpZQMZ#'l`[pH@XGNEQ*!!Qr-kq@mqf+`
+
+,HVK6rLX60R@""hI+c5IHHaBfk`-2I,5(G,jrpK(H5aSfpB%(pqQkANlrj[4mV#G
+
+EHm2$CN01V`9H%R"aqMR+bhpj`iDqe%&p8bAIR!qTj%[4$kpFY(MK'lcmYcPXk&Z
+
+H1lcmlTi0lIT[mPVbJIFUL!elGjRM4BM8c8"+#$@"@kr%qK5GrJGH8d5JeDSp%6Z
+
+S`aY94TZmpLQ+$H(Nh"cl%r`RK-KrL#Vr!3#3!aq$!!!"!*!$!43!N!-8!*!$-Tr
+
+lRLe!rr#`!,K[$#eZd!6rm2rdd"lm`FAKdkSV8FY+$deKBe"bEfTPBh4c,R0TG!)
+
+!N!06594%8dP8)3#3"P0*9%46593K!*!BUc!jI3!!8M8!!!&'"1"2l'mDG@6JrHc
+
+K@5U#NI*HN@GK!Z"2kQ`FG&2UN!"S!!,L@5[48(adA`CdC!EJ6qj[8hJS!!EJEHl
+
+LEe5!)D$!FJC1ANl!*IrX51FI-#D`jL63G!*&0K!+1Li!&Ri!)VX-S"lbUKQJ(Z`
+
+3!+SDI!$!#3ZT8,aIE!!!Q$!'8!6"aG!!N!-3!#X!"3%B!J#3"`-!N!-"!*!$!43
+
+!N!-8!*!$-J$j(l!@#J#3!a`!-J!!8f9dC`#3!`S!!2rr!*!&q@G%'@B:
+
diff --git a/src/gc/Mac_files/MacOS_Test_config.h b/src/gc/Mac_files/MacOS_Test_config.h
new file mode 100644
index 000000000..c95f4bb2f
--- /dev/null
+++ b/src/gc/Mac_files/MacOS_Test_config.h
@@ -0,0 +1,91 @@
+/*
+	MacOS_Test_config.h
+	
+	Configuration flags for Macintosh development systems.
+	
+	Test version.
+	
+ 	<Revision History>
+
+ 	11/16/95  pcb  Updated compilation flags to reflect latest 4.6 Makefile.
+	
+	by Patrick C. Beard.
+ */
+/* Boehm, November 17, 1995 12:05 pm PST */
+
+#ifdef __MWERKS__
+
+// for CodeWarrior Pro with Metrowerks Standard Library (MSL).
+// #define MSL_USE_PRECOMPILED_HEADERS 0
+#include <ansi_prefix.mac.h>
+#ifndef __STDC__
+#define __STDC__ 0
+#endif
+
+#endif
+
+// these are defined again in gc_priv.h.
+#undef TRUE
+#undef FALSE
+
+#define ALL_INTERIOR_POINTERS	// follows interior pointers.
+//#define SILENT				// want collection messages.
+//#define DONT_ADD_BYTE_AT_END	// no padding.
+//#define SMALL_CONFIG			// whether to a smaller heap.
+#define NO_SIGNALS				// signals aren't real on the Macintosh.
+#define USE_TEMPORARY_MEMORY	// use Macintosh temporary memory.
+
+// CFLAGS= -O -DNO_SIGNALS -DALL_INTERIOR_POINTERS -DSILENT
+//
+//LIBGC_CFLAGS= -O -DNO_SIGNALS -DSILENT \
+//    -DREDIRECT_MALLOC=GC_malloc_uncollectable \
+//    -DDONT_ADD_BYTE_AT_END -DALL_INTERIOR_POINTERS
+//   Flags for building libgc.a -- the last two are required.
+//
+// Setjmp_test may yield overly optimistic results when compiled
+// without optimization.
+// -DSILENT disables statistics printing, and improves performance.
+// -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+//   altered stubborn objects, at substantial performance cost.
+//   Use only for incremental collector debugging.
+// -DFIND_LEAK causes the collector to assume that all inaccessible
+//   objects should have been explicitly deallocated, and reports exceptions.
+//   Finalization and the test program are not usable in this mode.
+// -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+//   (Clients should also define SOLARIS_THREADS and then include
+//   gc.h before performing thr_ or GC_ operations.)
+//   This is broken on nonSPARC machines.
+// -DALL_INTERIOR_POINTERS allows all pointers to the interior
+//   of objects to be recognized.  (See gc_priv.h for consequences.)
+// -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+//   usually causing it to use less space in such situations.
+//   Incremental collection no longer works in this case.
+// -DLARGE_CONFIG tunes the collector for unusually large heaps.
+//   Necessary for heaps larger than about 500 MB on most machines.
+//   Recommended for heaps larger than about 64 MB.
+// -DDONT_ADD_BYTE_AT_END is meaningful only with
+//   -DALL_INTERIOR_POINTERS.  Normally -DALL_INTERIOR_POINTERS
+//   causes all objects to be padded so that pointers just past the end of
+//   an object can be recognized.  This can be expensive.  (The padding
+//   is normally more than one byte due to alignment constraints.)
+//   -DDONT_ADD_BYTE_AT_END disables the padding.
+// -DNO_SIGNALS does not disable signals during critical parts of
+//   the GC process.  This is no less correct than many malloc 
+//   implementations, and it sometimes has a significant performance
+//   impact.  However, it is dangerous for many not-quite-ANSI C
+//   programs that call things like printf in asynchronous signal handlers.
+// -DOPERATOR_NEW_ARRAY declares that the C++ compiler supports the
+//   new syntax "operator new[]" for allocating and deleting arrays.
+//   See gc_cpp.h for details.  No effect on the C part of the collector.
+//   This is defined implicitly in a few environments.
+// -DREDIRECT_MALLOC=X causes malloc, realloc, and free to be defined
+//   as aliases for X, GC_realloc, and GC_free, respectively.
+//   Calloc is redefined in terms of the new malloc.  X should
+//   be either GC_malloc or GC_malloc_uncollectable.
+//   The former is occasionally useful for working around leaks in code
+//   you don't want to (or can't) look at.  It may not work for
+//   existing code, but it often does.  Neither works on all platforms,
+//   since some ports use malloc or calloc to obtain system memory.
+//   (Probably works for UNIX, and win32.)
+// -DNO_DEBUG removes GC_dump and the debugging routines it calls.
+//   Reduces code size slightly at the expense of debuggability.
diff --git a/src/gc/Mac_files/MacOS_config.h b/src/gc/Mac_files/MacOS_config.h
new file mode 100644
index 000000000..93c3c97a9
--- /dev/null
+++ b/src/gc/Mac_files/MacOS_config.h
@@ -0,0 +1,89 @@
+/*
+	MacOS_config.h
+	
+	Configuration flags for Macintosh development systems.
+	
+ 	<Revision History>
+ 	
+ 	11/16/95  pcb  Updated compilation flags to reflect latest 4.6 Makefile.
+	
+	by Patrick C. Beard.
+ */
+/* Boehm, November 17, 1995 12:10 pm PST */
+
+#ifdef __MWERKS__
+
+// for CodeWarrior Pro with Metrowerks Standard Library (MSL).
+// #define MSL_USE_PRECOMPILED_HEADERS 0
+#include <ansi_prefix.mac.h>
+#ifndef __STDC__
+#define __STDC__ 0
+#endif
+
+#endif /* __MWERKS__ */
+
+// these are defined again in gc_priv.h.
+#undef TRUE
+#undef FALSE
+
+#define ALL_INTERIOR_POINTERS	// follows interior pointers.
+#define SILENT			// no collection messages.
+//#define DONT_ADD_BYTE_AT_END	// no padding.
+//#define SMALL_CONFIG		// whether to use a smaller heap.
+#define NO_SIGNALS		// signals aren't real on the Macintosh.
+#define USE_TEMPORARY_MEMORY	// use Macintosh temporary memory.
+
+// CFLAGS= -O -DNO_SIGNALS -DSILENT -DALL_INTERIOR_POINTERS
+//
+//LIBGC_CFLAGS= -O -DNO_SIGNALS -DSILENT \
+//    -DREDIRECT_MALLOC=GC_malloc_uncollectable \
+//    -DDONT_ADD_BYTE_AT_END -DALL_INTERIOR_POINTERS
+//   Flags for building libgc.a -- the last two are required.
+//
+// Setjmp_test may yield overly optimistic results when compiled
+// without optimization.
+// -DSILENT disables statistics printing, and improves performance.
+// -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+//   altered stubborn objects, at substantial performance cost.
+//   Use only for incremental collector debugging.
+// -DFIND_LEAK causes the collector to assume that all inaccessible
+//   objects should have been explicitly deallocated, and reports exceptions.
+//   Finalization and the test program are not usable in this mode.
+// -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+//   (Clients should also define SOLARIS_THREADS and then include
+//   gc.h before performing thr_ or GC_ operations.)
+//   This is broken on nonSPARC machines.
+// -DALL_INTERIOR_POINTERS allows all pointers to the interior
+//   of objects to be recognized.  (See gc_priv.h for consequences.)
+// -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+//   usually causing it to use less space in such situations.
+//   Incremental collection no longer works in this case.
+// -DLARGE_CONFIG tunes the collector for unusually large heaps.
+//   Necessary for heaps larger than about 500 MB on most machines.
+//   Recommended for heaps larger than about 64 MB.
+// -DDONT_ADD_BYTE_AT_END is meaningful only with
+//   -DALL_INTERIOR_POINTERS.  Normally -DALL_INTERIOR_POINTERS
+//   causes all objects to be padded so that pointers just past the end of
+//   an object can be recognized.  This can be expensive.  (The padding
+//   is normally more than one byte due to alignment constraints.)
+//   -DDONT_ADD_BYTE_AT_END disables the padding.
+// -DNO_SIGNALS does not disable signals during critical parts of
+//   the GC process.  This is no less correct than many malloc 
+//   implementations, and it sometimes has a significant performance
+//   impact.  However, it is dangerous for many not-quite-ANSI C
+//   programs that call things like printf in asynchronous signal handlers.
+// -DOPERATOR_NEW_ARRAY declares that the C++ compiler supports the
+//   new syntax "operator new[]" for allocating and deleting arrays.
+//   See gc_cpp.h for details.  No effect on the C part of the collector.
+//   This is defined implicitly in a few environments.
+// -DREDIRECT_MALLOC=X causes malloc, realloc, and free to be defined
+//   as aliases for X, GC_realloc, and GC_free, respectively.
+//   Calloc is redefined in terms of the new malloc.  X should
+//   be either GC_malloc or GC_malloc_uncollectable.
+//   The former is occasionally useful for working around leaks in code
+//   you don't want to (or can't) look at.  It may not work for
+//   existing code, but it often does.  Neither works on all platforms,
+//   since some ports use malloc or calloc to obtain system memory.
+//   (Probably works for UNIX, and win32.)
+// -DNO_DEBUG removes GC_dump and the debugging routines it calls.
+//   Reduces code size slightly at the expense of debuggability.
\ No newline at end of file
diff --git a/src/gc/Mac_files/dataend.c b/src/gc/Mac_files/dataend.c
new file mode 100644
index 000000000..a3e3fe844
--- /dev/null
+++ b/src/gc/Mac_files/dataend.c
@@ -0,0 +1,9 @@
+/*
+	dataend.c
+	
+	A hack to get the extent of global data for the Macintosh.
+	
+	by Patrick C. Beard.
+ */
+
+long __dataend;
diff --git a/src/gc/Mac_files/datastart.c b/src/gc/Mac_files/datastart.c
new file mode 100644
index 000000000..a9e0dd594
--- /dev/null
+++ b/src/gc/Mac_files/datastart.c
@@ -0,0 +1,9 @@
+/*
+	datastart.c
+	
+	A hack to get the extent of global data for the Macintosh.
+	
+	by Patrick C. Beard.
+ */
+
+long __datastart;
diff --git a/src/gc/Makefile b/src/gc/Makefile
new file mode 100644
index 000000000..d3a3482d2
--- /dev/null
+++ b/src/gc/Makefile
@@ -0,0 +1,469 @@
+# Primary targets:
+# gc.a - builds basic library
+# libgc.a - builds library for use with g++ "-fgc-keyword" extension
+# c++ - adds C++ interface to library
+# cords - adds cords (heavyweight strings) to library
+# test - prints porting information, then builds basic version of gc.a,
+#      	 and runs some tests of collector and cords.  Does not add cords or
+#	 c++ interface to gc.a
+# cord/de - builds dumb editor based on cords.
+ABI_FLAG= 
+CC=cc $(ABI_FLAG)
+HOSTCC=$(CC)
+CXX=g++ $(ABI_FLAG)
+AS=as $(ABI_FLAG)
+#  The above doesn't work with gas, which doesn't run cpp.
+#  Define AS as `gcc -c -x assembler-with-cpp' instead.
+#  Under Irix 6, you will have to specify the ABI (-o32, -n32, or -64)
+#  if you use something other than the default ABI on your machine.
+
+CFLAGS= -O -DATOMIC_UNCOLLECTABLE -DNO_SIGNALS -DNO_EXECUTE_PERMISSION -DALL_INTERIOR_POINTERS -DSILENT
+
+# For dynamic library builds, it may be necessary to add flags to generate
+# PIC code, e.g. -fPIC on Linux.
+
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+# -DSILENT disables statistics printing, and improves performance.
+# -DFIND_LEAK causes GC_find_leak to be initially set.
+#   This causes the collector to assume that all inaccessible
+#   objects should have been explicitly deallocated, and reports exceptions.
+#   Finalization and the test program are not usable in this mode.
+# -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+#   (Clients should also define SOLARIS_THREADS and then include
+#   gc.h before performing thr_ or dl* or GC_ operations.)
+#   Must also define -D_REENTRANT.
+# -D_SOLARIS_PTHREADS enables support for Solaris pthreads.
+#   Define SOLARIS_THREADS as well.
+# -DIRIX_THREADS enables support for Irix pthreads.  See README.irix.
+# -DHPUX_THREADS enables support for HP/UX 11 pthreads.
+#  Also requires -D_REENTRANT. See README.hp.
+# -DLINUX_THREADS enables support for Xavier Leroy's Linux threads.
+#   see README.linux.  -D_REENTRANT may also be required.
+# -DALL_INTERIOR_POINTERS allows all pointers to the interior
+#   of objects to be recognized.  (See gc_priv.h for consequences.)
+# -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+#   usually causing it to use less space in such situations.
+#   Incremental collection no longer works in this case.
+# -DLARGE_CONFIG tunes the collector for unusually large heaps.
+#   Necessary for heaps larger than about 500 MB on most machines.
+#   Recommended for heaps larger than about 64 MB.
+# -DDONT_ADD_BYTE_AT_END is meaningful only with
+#   -DALL_INTERIOR_POINTERS.  Normally -DALL_INTERIOR_POINTERS
+#   causes all objects to be padded so that pointers just past the end of
+#   an object can be recognized.  This can be expensive.  (The padding
+#   is normally more than one byte due to alignment constraints.)
+#   -DDONT_ADD_BYTE_AT_END disables the padding.
+# -DNO_SIGNALS does not disable signals during critical parts of
+#   the GC process.  This is no less correct than many malloc 
+#   implementations, and it sometimes has a significant performance
+#   impact.  However, it is dangerous for many not-quite-ANSI C
+#   programs that call things like printf in asynchronous signal handlers.
+#   This is on by default.  Turning it off has not been extensively tested with
+#   compilers that reorder stores.  It should have been.
+# -DNO_EXECUTE_PERMISSION may cause some or all of the heap to not
+#   have execute permission, i.e. it may be impossible to execute
+#   code from the heap.  Currently this only affects the incremental
+#   collector on UNIX machines.  It may greatly improve its performance,
+#   since this may avoid some expensive cache synchronization.
+# -DOPERATOR_NEW_ARRAY declares that the C++ compiler supports the
+#   new syntax "operator new[]" for allocating and deleting arrays.
+#   See gc_cpp.h for details.  No effect on the C part of the collector.
+#   This is defined implicitly in a few environments.
+# -DREDIRECT_MALLOC=X causes malloc, realloc, and free to be defined
+#   as aliases for X, GC_realloc, and GC_free, respectively.
+#   Calloc is redefined in terms of the new malloc.  X should
+#   be either GC_malloc or GC_malloc_uncollectable.
+#   The former is occasionally useful for working around leaks in code
+#   you don't want to (or can't) look at.  It may not work for
+#   existing code, but it often does.  Neither works on all platforms,
+#   since some ports use malloc or calloc to obtain system memory.
+#   (Probably works for UNIX, and win32.)
+# -DIGNORE_FREE turns calls to free into a noop.  Only useful with
+#   -DREDIRECT_MALLOC.
+# -DNO_DEBUGGING removes GC_dump and the debugging routines it calls.
+#   Reduces code size slightly at the expense of debuggability.
+# -DJAVA_FINALIZATION makes it somewhat safer to finalize objects out of
+#   order by specifying a nonstandard finalization mark procedure  (see
+#   finalize.c).  Objects reachable from finalizable objects will be marked
+#   in a sepearte postpass, and hence their memory won't be reclaimed.
+#   Not recommended unless you are implementing a language that specifies
+#   these semantics.  Since 5.0, determines only only the initial value
+#   of GC_java_finalization variable.
+# -DFINALIZE_ON_DEMAND causes finalizers to be run only in response
+#   to explicit GC_invoke_finalizers() calls.
+#   In 5.0 this became runtime adjustable, and this only determines the
+#   initial value of GC_finalize_on_demand.
+# -DATOMIC_UNCOLLECTABLE includes code for GC_malloc_atomic_uncollectable.
+#   This is useful if either the vendor malloc implementation is poor,
+#   or if REDIRECT_MALLOC is used.
+# -DHBLKSIZE=ddd, where ddd is a power of 2 between 512 and 16384, explicitly
+#   sets the heap block size.  Each heap block is devoted to a single size and
+#   kind of object.  For the incremental collector it makes sense to match
+#   the most likely page size.  Otherwise large values result in more
+#   fragmentation, but generally better performance for large heaps.
+# -DUSE_MMAP use MMAP instead of sbrk to get new memory.
+#   Works for Solaris and Irix.
+# -DUSE_MUNMAP causes memory to be returned to the OS under the right
+#   circumstances.  This currently disables VM-based incremental collection.
+#   This is currently experimental, and works only under some Unix and
+#   Linux versions.
+# -DMMAP_STACKS (for Solaris threads) Use mmap from /dev/zero rather than
+#   GC_scratch_alloc() to get stack memory.
+# -DPRINT_BLACK_LIST Whenever a black list entry is added, i.e. whenever
+#   the garbage collector detects a value that looks almost, but not quite,
+#   like a pointer, print both the address containing the value, and the
+#   value of the near-bogus-pointer.  Can be used to identifiy regions of
+#   memory that are likely to contribute misidentified pointers.
+# -DKEEP_BACK_PTRS Add code to save back pointers in debugging headers
+#   for objects allocated with the debugging allocator.  If all objects
+#   through GC_MALLOC with GC_DEBUG defined, this allows the client
+#   to determine how particular or randomly chosen objects are reachable
+#   for debugging/profiling purposes.  The backptr.h interface is
+#   implemented only if this is defined.
+# -DGC_ASSERTIONS Enable some internal GC assertion checking.  Currently
+#   this facility is only used in a few places.  It is intended primarily
+#   for debugging of the garbage collector itself, but could also
+#   occasionally be useful for debugging of client code.  Slows down the
+#   collector somewhat, but not drastically.
+# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+#   altered stubborn objects, at substantial performance cost.
+#   Use only for debugging of the incremental collector.
+# -DGC_GCJ_SUPPORT includes support for gcj (and possibly other systems
+#   that include a pointer to a type descriptor in each allocated object).
+#   Building this way requires an ANSI C compiler.
+# -DUSE_I686_PREFETCH causes the collector to issue Pentium III style
+#   prefetch instructions.  No effect except on X86 Linux platforms.
+#   Assumes a very recent gcc-compatible compiler and assembler.
+#   (Gas prefetcht0 support was added around May 1999.)
+#   Empirically the code appears to still run correctly on Pentium II
+#   processors, though with no performance benefit.  May not run on other
+#   X86 processors?  In some cases this improves performance by
+#   15% or so.
+# -DUSE_3DNOW_PREFETCH causes the collector to issue AMD 3DNow style
+#   prefetch instructions.  Same restrictions as USE_I686_PREFETCH.
+#   UNTESTED!!
+# -DUSE_LD_WRAP in combination with the gld flags listed in README.linux
+#   causes the collector some system and pthread calls in a more transparent
+#   fashion than the usual macro-based approach.  Requires GNU ld, and
+#   currently probably works only with Linux.
+#
+
+
+LIBGC_CFLAGS= -O -DNO_SIGNALS -DSILENT \
+    -DREDIRECT_MALLOC=GC_malloc_uncollectable \
+    -DDONT_ADD_BYTE_AT_END -DALL_INTERIOR_POINTERS
+#   Flags for building libgc.a -- the last two are required.
+
+CXXFLAGS= $(CFLAGS) 
+AR= ar
+RANLIB= ranlib
+
+
+# Redefining srcdir allows object code for the nonPCR version of the collector
+# to be generated in different directories.  In this case, the destination directory
+# should contain a copy of the original include directory.
+srcdir = .
+VPATH = $(srcdir)
+
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o dbg_mlc.o malloc.o stubborn.o checksums.o solaris_threads.o hpux_irix_threads.o linux_threads.o typd_mlc.o ptr_chck.o mallocx.o solaris_pthreads.o gcj_mlc.o
+
+CSRCS= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dyn_load.c dbg_mlc.c malloc.c stubborn.c checksums.c solaris_threads.c hpux_irix_threads.c linux_threads.c typd_mlc.c ptr_chck.c mallocx.c solaris_pthreads.c gcj_mlc.c
+
+CORD_SRCS=  cord/cordbscs.c cord/cordxtra.c cord/cordprnt.c cord/de.c cord/cordtest.c cord/cord.h cord/ec.h cord/private/cord_pos.h cord/de_win.c cord/de_win.h cord/de_cmds.h cord/de_win.ICO cord/de_win.RC cord/SCOPTIONS.amiga cord/SMakefile.amiga
+
+CORD_OBJS=  cord/cordbscs.o cord/cordxtra.o cord/cordprnt.o
+
+SRCS= $(CSRCS) mips_sgi_mach_dep.s rs6000_mach_dep.s alpha_mach_dep.s \
+    sparc_mach_dep.s gc.h gc_typed.h gc_hdrs.h gc_priv.h gc_private.h \
+    gcconfig.h gc_mark.h include/gc_inl.h include/gc_inline.h gc.man \
+    threadlibs.c if_mach.c if_not_there.c gc_cpp.cc gc_cpp.h weakpointer.h \
+    gcc_support.c mips_ultrix_mach_dep.s include/gc_alloc.h gc_alloc.h \
+    include/new_gc_alloc.h include/javaxfc.h sparc_sunos4_mach_dep.s \
+    solaris_threads.h backptr.h hpux_test_and_clear.s include/gc_gcj.h \
+    dbg_mlc.h $(CORD_SRCS)
+
+OTHER_FILES= Makefile PCR-Makefile OS2_MAKEFILE NT_MAKEFILE BCC_MAKEFILE \
+           README test.c test_cpp.cc setjmp_t.c SMakefile.amiga \
+           SCoptions.amiga README.amiga README.win32 cord/README \
+           cord/gc.h include/gc.h include/gc_typed.h include/cord.h \
+           include/ec.h include/private/cord_pos.h include/private/gcconfig.h \
+           include/private/gc_hdrs.h include/private/gc_priv.h \
+	   include/gc_cpp.h README.rs6000 include/backptr.h \
+           include/weakpointer.h README.QUICK callprocs pc_excludes \
+           barrett_diagram README.OS2 README.Mac MacProjects.sit.hqx \
+           MacOS.c EMX_MAKEFILE makefile.depend README.debugging \
+           include/gc_cpp.h Mac_files/datastart.c Mac_files/dataend.c \
+           Mac_files/MacOS_config.h Mac_files/MacOS_Test_config.h \
+           add_gc_prefix.c README.solaris2 README.sgi README.hp README.uts \
+	   win32_threads.c NT_THREADS_MAKEFILE gc.mak README.dj Makefile.dj \
+	   README.alpha README.linux version.h Makefile.DLLs \
+	   WCC_MAKEFILE nursery.c include/gc_nursery.h include/gc_copy_descr.h \
+	   include/leak_detector.h
+
+CORD_INCLUDE_FILES= $(srcdir)/gc.h $(srcdir)/cord/cord.h $(srcdir)/cord/ec.h \
+           $(srcdir)/cord/private/cord_pos.h
+
+UTILS= if_mach if_not_there threadlibs
+
+# Libraries needed for curses applications.  Only needed for de.
+CURSES= -lcurses -ltermlib
+
+# The following is irrelevant on most systems.  But a few
+# versions of make otherwise fork the shell specified in
+# the SHELL environment variable.
+SHELL= /bin/sh
+
+SPECIALCFLAGS = 
+# Alternative flags to the C compiler for mach_dep.c.
+# Mach_dep.c often doesn't like optimization, and it's
+# not time-critical anyway.
+# Set SPECIALCFLAGS to -q nodirect_code on Encore.
+
+all: gc.a gctest
+
+pcr: PCR-Makefile gc_private.h gc_hdrs.h gc.h gcconfig.h mach_dep.o $(SRCS)
+	make -f PCR-Makefile depend
+	make -f PCR-Makefile
+
+$(OBJS) test.o dyn_load.o dyn_load_sunos53.o: $(srcdir)/gc_priv.h $(srcdir)/gc_hdrs.h $(srcdir)/gc.h \
+    $(srcdir)/gcconfig.h $(srcdir)/gc_typed.h Makefile
+# The dependency on Makefile is needed.  Changing
+# options such as -DSILENT affects the size of GC_arrays,
+# invalidating all .o files that rely on gc_priv.h
+
+mark.o typd_mlc.o finalize.o: $(srcdir)/gc_mark.h
+
+base_lib gc.a: $(OBJS) dyn_load.o $(UTILS)
+	echo > base_lib
+	rm -f dont_ar_1
+	./if_mach SPARC SUNOS5 touch dont_ar_1
+	./if_mach SPARC SUNOS5 $(AR) rus gc.a $(OBJS) dyn_load.o
+	./if_mach M68K AMIGA touch dont_ar_1
+	./if_mach M68K AMIGA $(AR) -vrus gc.a $(OBJS) dyn_load.o
+	./if_not_there dont_ar_1 $(AR) ru gc.a $(OBJS) dyn_load.o
+	./if_not_there dont_ar_1 $(RANLIB) gc.a || cat /dev/null
+#	ignore ranlib failure; that usually means it doesn't exist, and isn't needed
+
+cords: $(CORD_OBJS) cord/cordtest $(UTILS)
+	rm -f dont_ar_3
+	./if_mach SPARC SUNOS5 touch dont_ar_3
+	./if_mach SPARC SUNOS5 $(AR) rus gc.a $(CORD_OBJS)
+	./if_mach M68K AMIGA touch dont_ar_3
+	./if_mach M68K AMIGA $(AR) -vrus gc.a $(CORD_OBJS)
+	./if_not_there dont_ar_3 $(AR) ru gc.a $(CORD_OBJS)
+	./if_not_there dont_ar_3 $(RANLIB) gc.a || cat /dev/null
+
+gc_cpp.o: $(srcdir)/gc_cpp.cc $(srcdir)/gc_cpp.h $(srcdir)/gc.h Makefile
+	$(CXX) -c $(CXXFLAGS) $(srcdir)/gc_cpp.cc
+
+test_cpp: $(srcdir)/test_cpp.cc $(srcdir)/gc_cpp.h gc_cpp.o $(srcdir)/gc.h \
+base_lib $(UTILS)
+	rm -f test_cpp
+	./if_mach HP_PA HPUX $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/test_cpp.cc gc_cpp.o gc.a -ldld `./threadlibs`
+	./if_not_there test_cpp $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/test_cpp.cc gc_cpp.o gc.a `./threadlibs`
+
+c++: gc_cpp.o $(srcdir)/gc_cpp.h test_cpp
+	rm -f dont_ar_4
+	./if_mach SPARC SUNOS5 touch dont_ar_4
+	./if_mach SPARC SUNOS5 $(AR) rus gc.a gc_cpp.o
+	./if_mach M68K AMIGA touch dont_ar_4
+	./if_mach M68K AMIGA $(AR) -vrus gc.a gc_cpp.o
+	./if_not_there dont_ar_4 $(AR) ru gc.a gc_cpp.o
+	./if_not_there dont_ar_4 $(RANLIB) gc.a || cat /dev/null
+	./test_cpp 1
+	echo > c++
+
+dyn_load_sunos53.o: dyn_load.c
+	$(CC) $(CFLAGS) -DSUNOS53_SHARED_LIB -c $(srcdir)/dyn_load.c -o $@
+
+# SunOS5 shared library version of the collector
+sunos5gc.so: $(OBJS) dyn_load_sunos53.o
+	$(CC) -G -o sunos5gc.so $(OBJS) dyn_load_sunos53.o -ldl
+	ln sunos5gc.so libgc.so
+
+# Alpha/OSF shared library version of the collector
+libalphagc.so: $(OBJS)
+	ld -shared -o libalphagc.so $(OBJS) dyn_load.o -lc
+	ln libalphagc.so libgc.so
+
+# IRIX shared library version of the collector
+libirixgc.so: $(OBJS) dyn_load.o
+	ld -shared $(ABI_FLAG) -o libirixgc.so $(OBJS) dyn_load.o -lc
+	ln libirixgc.so libgc.so
+
+# Linux shared library version of the collector
+liblinuxgc.so: $(OBJS) dyn_load.o
+	gcc -shared -o liblinuxgc.so $(OBJS) dyn_load.o -lo
+	ln liblinuxgc.so libgc.so
+
+# Alternative Linux rule.  This is preferable, but is likely to break the
+# Makefile for some non-linux platforms.
+# LIBOBJS= $(patsubst %.o, %.lo, $(OBJS))
+#
+#.SUFFIXES: .lo $(SUFFIXES)
+#
+#.c.lo:
+#	$(CC) $(CFLAGS) $(CPPFLAGS) -fPIC -c $< -o $@
+#
+# liblinuxgc.so: $(LIBOBJS) dyn_load.lo
+# 	gcc -shared -Wl,-soname=libgc.so.0 -o libgc.so.0 $(LIBOBJS) dyn_load.lo
+#	touch liblinuxgc.so
+
+mach_dep.o: $(srcdir)/mach_dep.c $(srcdir)/mips_sgi_mach_dep.s $(srcdir)/mips_ultrix_mach_dep.s $(srcdir)/rs6000_mach_dep.s $(UTILS)
+	rm -f mach_dep.o
+	./if_mach MIPS IRIX5 $(AS) -o mach_dep.o $(srcdir)/mips_sgi_mach_dep.s
+	./if_mach MIPS RISCOS $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+	./if_mach MIPS ULTRIX $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+	./if_mach RS6000 "" $(AS) -o mach_dep.o $(srcdir)/rs6000_mach_dep.s
+#	./if_mach ALPHA "" $(AS) -o mach_dep.o $(srcdir)/alpha_mach_dep.s
+#	alpha_mach_dep.s assumes that pointers are not saved in fp registers.
+#	Gcc on a 21264 can spill pointers to fp registers.  Oops.
+	./if_mach SPARC SUNOS5 $(AS) -o mach_dep.o $(srcdir)/sparc_mach_dep.s
+	./if_mach SPARC SUNOS4 $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+	./if_mach SPARC OPENBSD $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+	./if_mach HP_PA HPUX $(AS) -o hpux_test_and_clear.o $(srcdir)/hpux_test_and_clear.s
+	./if_mach HP_PA HPUX $(CC) -c -o md_tmp.o $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+	./if_mach HP_PA HPUX ld -r -o mach_dep.o md_tmp.o hpux_test_and_clear.o
+	./if_not_there mach_dep.o $(CC) -c $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+
+mark_rts.o: $(srcdir)/mark_rts.c $(UTILS)
+	rm -f mark_rts.o
+	-./if_mach ALPHA OSF1 $(CC) -c $(CFLAGS) -Wo,-notail $(srcdir)/mark_rts.c
+	./if_not_there mark_rts.o $(CC) -c $(CFLAGS) $(srcdir)/mark_rts.c
+#	Work-around for DEC optimizer tail recursion elimination bug.
+#  The ALPHA-specific line should be removed if gcc is used.
+
+alloc.o: version.h
+
+cord/cordbscs.o: $(srcdir)/cord/cordbscs.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordbscs.c
+	mv cordbscs.o cord/cordbscs.o
+#  not all compilers understand -o filename
+
+cord/cordxtra.o: $(srcdir)/cord/cordxtra.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordxtra.c
+	mv cordxtra.o cord/cordxtra.o
+
+cord/cordprnt.o: $(srcdir)/cord/cordprnt.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordprnt.c
+	mv cordprnt.o cord/cordprnt.o
+
+cord/cordtest: $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a $(UTILS)
+	rm -f cord/cordtest
+	./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -lucb
+	./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -ldld `./threadlibs`
+	./if_not_there cord/cordtest $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a `./threadlibs`
+
+cord/de: $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(UTILS)
+	rm -f cord/de
+	./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -lucb `./threadlibs`
+	./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -ldld `./threadlibs`
+	./if_mach RS6000 "" $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+	./if_mach I386 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+	./if_mach ALPHA LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+	./if_mach IA64 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+	./if_mach M68K AMIGA $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+	./if_not_there cord/de $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) `./threadlibs`
+
+if_mach: $(srcdir)/if_mach.c $(srcdir)/gcconfig.h
+	$(HOSTCC) $(CFLAGS) -o if_mach $(srcdir)/if_mach.c
+
+threadlibs: $(srcdir)/threadlibs.c $(srcdir)/gcconfig.h Makefile
+	$(HOSTCC) $(CFLAGS) -o threadlibs $(srcdir)/threadlibs.c
+
+if_not_there: $(srcdir)/if_not_there.c
+	$(HOSTCC) $(CFLAGS) -o if_not_there $(srcdir)/if_not_there.c
+
+clean: 
+	rm -f gc.a *.o gctest gctest_dyn_link test_cpp \
+	      setjmp_test  mon.out gmon.out a.out core if_not_there if_mach \
+	      threadlibs $(CORD_OBJS) cord/cordtest cord/de
+	-rm -f *~
+
+gctest: test.o gc.a $(UTILS)
+	rm -f gctest
+	./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o gctest  test.o gc.a -lucb
+	./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o gctest  test.o gc.a -ldld `./threadlibs`
+	./if_not_there gctest $(CC) $(CFLAGS) -o gctest test.o gc.a `./threadlibs`
+
+# If an optimized setjmp_test generates a segmentation fault,
+# odds are your compiler is broken.  Gctest may still work.
+# Try compiling setjmp_t.c unoptimized.
+setjmp_test: $(srcdir)/setjmp_t.c $(srcdir)/gc.h $(UTILS)
+	$(CC) $(CFLAGS) -o setjmp_test $(srcdir)/setjmp_t.c
+
+test:  KandRtest cord/cordtest
+	cord/cordtest
+
+# Those tests that work even with a K&R C compiler:
+KandRtest: setjmp_test gctest
+	./setjmp_test
+	./gctest
+
+add_gc_prefix: add_gc_prefix.c
+	$(CC) -o add_gc_prefix $(srcdir)/add_gc_prefix.c
+
+gc.tar: $(SRCS) $(OTHER_FILES) add_gc_prefix
+	./add_gc_prefix $(SRCS) $(OTHER_FILES) > /tmp/gc.tar-files
+	tar cvfh gc.tar `cat /tmp/gc.tar-files`
+
+pc_gc.tar: $(SRCS) $(OTHER_FILES)
+	tar cvfX pc_gc.tar pc_excludes $(SRCS) $(OTHER_FILES)
+
+floppy: pc_gc.tar
+	-mmd a:/cord
+	-mmd a:/cord/private
+	-mmd a:/include
+	-mmd a:/include/private
+	mkdir /tmp/pc_gc
+	cat pc_gc.tar | (cd /tmp/pc_gc; tar xvf -)
+	-mcopy -tmn /tmp/pc_gc/* a:
+	-mcopy -tmn /tmp/pc_gc/cord/* a:/cord
+	-mcopy -mn /tmp/pc_gc/cord/de_win.ICO a:/cord
+	-mcopy -tmn /tmp/pc_gc/cord/private/* a:/cord/private
+	-mcopy -tmn /tmp/pc_gc/include/* a:/include
+	-mcopy -tmn /tmp/pc_gc/include/private/* a:/include/private
+	rm -r /tmp/pc_gc
+
+gc.tar.Z: gc.tar
+	compress gc.tar
+
+gc.tar.gz: gc.tar
+	gzip gc.tar
+
+lint: $(CSRCS) test.c
+	lint -DLINT $(CSRCS) test.c | egrep -v "possible pointer alignment problem|abort|exit|sbrk|mprotect|syscall|change in ANSI|improper alignment"
+
+# BTL: added to test shared library version of collector.
+# Currently works only under SunOS5.  Requires GC_INIT call from statically
+# loaded client code.
+ABSDIR = `pwd`
+gctest_dyn_link: test.o libgc.so
+	$(CC) -L$(ABSDIR) -R$(ABSDIR) -o gctest_dyn_link test.o -lgc -ldl -lthread
+
+gctest_irix_dyn_link: test.o libirixgc.so
+	$(CC) -L$(ABSDIR) -o gctest_irix_dyn_link test.o -lirixgc
+
+test_dll.o: test.c libgc_globals.h
+	$(CC) $(CFLAGS) -DGC_USE_DLL -c test.c -o test_dll.o
+
+test_dll: test_dll.o libgc_dll.a libgc.dll
+	$(CC) test_dll.o -L$(ABSDIR) -lgc_dll -o test_dll
+
+SYM_PREFIX-libgc=GC
+
+# Uncomment the following line to build a GNU win32 DLL
+# include Makefile.DLLs
+
+reserved_namespace: $(SRCS)
+	for file in $(SRCS) test.c test_cpp.cc; do \
+		sed s/GC_/_GC_/g < $$file > tmp; \
+		cp tmp $$file; \
+		done
+
+user_namespace: $(SRCS)
+	for file in $(SRCS) test.c test_cpp.cc; do \
+		sed s/_GC_/GC_/g < $$file > tmp; \
+		cp tmp $$file; \
+		done
diff --git a/src/gc/Makefile.DLLs b/src/gc/Makefile.DLLs
new file mode 100644
index 000000000..011f49d3b
--- /dev/null
+++ b/src/gc/Makefile.DLLs
@@ -0,0 +1,107 @@
+#-----------------------------------------------------------------------------#
+
+# Makefile.DLLs, version 0.4.
+
+# Contributed by Fergus Henderson.
+
+# This Makefile contains rules for creating DLLs on Windows using gnu-win32.
+
+#-----------------------------------------------------------------------------#
+
+# This rule creates a `.def' file, which lists the symbols that are exported
+# from the DLL.  We use `nm' to get a list of all the exported text (`T')
+# symbols and data symbols -- including uninitialized data (`B'),
+# initialized data (`D'), read-only data (`R'), and common blocks (`C').
+%.def: %.a
+	echo EXPORTS > $@
+	nm $< | grep '^........ [BCDRT] _' | sed 's/[^_]*_//' >> $@
+
+# We need to use macros to access global data:
+# the user of the DLL must refer to `foo' as `(*__imp_foo)'.
+# This rule creates a `_globals.h' file, which contains macros
+# for doing this.
+
+SYM_PREFIX = $(firstword $(SYM_PREFIX-$*) $*)
+DLL_MACRO = $(SYM_PREFIX)_USE_DLL
+IMP_MACRO = $(SYM_PREFIX)_IMP
+GLOBAL_MACRO = $(SYM_PREFIX)_GLOBAL
+
+%_globals.h: %.a
+	echo "/* automatically generated by Makefile.DLLs */"	> $@
+	echo "#if defined(__GNUC__) && defined(_WIN32) \\"	>> $@
+	echo "	&& defined($(DLL_MACRO))"			>> $@
+	echo "#  define $(IMP_MACRO)(name)	__imp_##name" 	>> $@
+	echo "#  define $(GLOBAL_MACRO)(name)	(*$(IMP_MACRO)(name))" >> $@
+	echo "#else"						>> $@
+	echo "#  define $(GLOBAL_MACRO)(name)	name"		>> $@
+	echo "#endif"						>> $@
+	echo ""							>> $@
+	for sym in `nm $< | grep '^........ [BCDR] _' | sed 's/[^_]*_//'`; do \
+		echo "#define $$sym	$(GLOBAL_MACRO)($$sym)"	>> $@; \
+	done
+
+# This rule creates the export object file (`foo.exp') which contains the
+# jump table array; this export object file becomes part of the DLL. 
+# This rule also creates the import library (`foo_dll.a') which contains small
+# stubs for all the functions exported by the DLL which jump to them via the
+# jump table.  Executables that will use the DLL must be linked against this
+# stub library.
+%.exp %_dll.a : %.def
+	dlltool $(DLLTOOLFLAGS) $(DLLTOOLFLAGS-$*)		\
+		--def $<					\
+		--dllname $*.dll				\
+		--output-exp $*.exp				\
+		--output-lib $*_dll.a
+
+# The `sed' commands below are to convert DOS-style `C:\foo\bar'
+# pathnames into Unix-style `//c/foo/bar' pathnames.
+CYGWIN32_LIBS = $(shell echo					\
+	-L`dirname \`gcc -print-file-name=libgcc.a |		\
+	sed -e 's@^\\\\([A-Za-z]\\\\):@//\\\\1@g' -e 's@\\\\\\\\@/@g' \` ` \
+	-L`dirname \`gcc -print-file-name=libcygwin.a |	\
+	sed -e 's@^\\\\([A-Za-z]\\\\):@//\\\\1@g' -e 's@\\\\\\\\@/@g' \` ` \
+	-L`dirname \`gcc -print-file-name=libkernel32.a | \
+	sed -e 's@^\\\\([A-Za-z]\\\\):@//\\\\1@g' -e 's@\\\\\\\\@/@g' \` ` \
+	-lgcc -lcygwin -lkernel32 -lgcc)
+
+RELOCATABLE=yes
+
+ifeq "$(strip $(RELOCATABLE))" "yes"
+
+# to create relocatable DLLs, we need to do two passes
+%.dll: %.exp %.a dll_fixup.o dll_init.o
+	$(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll -o $*.base			\
+		-e _dll_entry@12 dll_init.o				\
+		dll_fixup.o $*.exp $*.a					\
+		$(LDLIBS) $(LDLIBS-$*)					\
+		$(CYGWIN32_LIBS)
+	$(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll --base-file $*.base -o $@	\
+		-e _dll_entry@12 dll_init.o				\
+		dll_fixup.o $*.exp $*.a					\
+		$(LDLIBS) $(LDLIBS-$*)					\
+		$(CYGWIN32_LIBS)
+	rm -f $*.base
+else
+
+%.dll: %.exp %.a dll_fixup.o dll_init.o
+	$(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll -o $@			\
+		-e _dll_entry@12 dll_init.o				\
+		dll_fixup.o $*.exp $*.a					\
+		$(LDLIBS) $(LDLIBS-$*)					\
+		$(CYGWIN32_LIBS)
+
+endif
+
+# This black magic piece of assembler needs to be linked in in order to
+# properly terminate the list of imported DLLs.
+dll_fixup.s:
+	echo '.section .idata$$3' 	> dll_fixup.s
+	echo '.long 0,0,0,0, 0,0,0,0'	>> dll_fixup.s
+
+# This bit is necessary to provide an initialization function for the DLL.
+dll_init.c:
+	echo '__attribute__((stdcall))' > dll_init.c
+	echo 'int dll_entry(int handle, int reason, void *ptr)' >> dll_init.c
+	echo '{return 1; }' >> dll_init.c
+
+dont_throw_away: dll_fixup.o dll_init.o
diff --git a/src/gc/Makefile.dj b/src/gc/Makefile.dj
new file mode 100644
index 000000000..54f77db9f
--- /dev/null
+++ b/src/gc/Makefile.dj
@@ -0,0 +1,436 @@
+# Primary targets:
+# gc.a - builds basic library
+# libgc.a - builds library for use with g++ "-fgc-keyword" extension
+# c++ - adds C++ interface to library
+# cords - adds cords (heavyweight strings) to library
+# test - prints porting information, then builds basic version of gc.a,
+#      	 and runs some tests of collector and cords.  Does not add cords or
+#	 c++ interface to gc.a
+# cord/de$(EXE_SUFFIX) - builds dumb editor based on cords.
+ABI_FLAG=
+CC=gcc $(ABI_FLAG)
+CXX=gxx $(ABI_FLAG)
+AS=gcc -c -x assembler-with-cpp $(ABI_FLAG)
+#  The above doesn't work with gas, which doesn't run cpp.
+#  Define AS as `gcc -c -x assembler-with-cpp' instead.
+#  Under Irix 6, you will have to specify the ABI (-o32, -n32, or -64)
+#  if you use something other than the default ABI on your machine.
+
+# special defines for DJGPP
+CXXLD=gxx $(ABI_FLAG)
+EXE_SUFFIX=.exe
+
+CFLAGS= -O -DATOMIC_UNCOLLECTABLE -DNO_SIGNALS -DALL_INTERIOR_POINTERS -DNO_EXECUTE_PERMISSION -DSILENT
+
+# For dynamic library builds, it may be necessary to add flags to generate
+# PIC code, e.g. -fPIC on Linux.
+
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+# -DSILENT disables statistics printing, and improves performance.
+# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+#   altered stubborn objects, at substantial performance cost.
+#   Use only for incremental collector debugging.
+# -DFIND_LEAK causes the collector to assume that all inaccessible
+#   objects should have been explicitly deallocated, and reports exceptions.
+#   Finalization and the test program are not usable in this mode.
+# -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+#   (Clients should also define SOLARIS_THREADS and then include
+#   gc.h before performing thr_ or dl* or GC_ operations.)
+#   Must also define -D_REENTRANT.
+# -D_SOLARIS_PTHREADS enables support for Solaris pthreads.
+#   Define SOLARIS_THREADS as well.
+# -DIRIX_THREADS enables support for Irix pthreads.  See README.irix.
+# -DLINUX_THREADS enables support for Xavier Leroy's Linux threads.
+#   see README.linux.  -D_REENTRANT may also be required.
+# -DALL_INTERIOR_POINTERS allows all pointers to the interior
+#   of objects to be recognized.  (See gc_priv.h for consequences.)
+# -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+#   usually causing it to use less space in such situations.
+#   Incremental collection no longer works in this case.
+# -DLARGE_CONFIG tunes the collector for unusually large heaps.
+#   Necessary for heaps larger than about 500 MB on most machines.
+#   Recommended for heaps larger than about 64 MB.
+# -DDONT_ADD_BYTE_AT_END is meaningful only with
+#   -DALL_INTERIOR_POINTERS.  Normally -DALL_INTERIOR_POINTERS
+#   causes all objects to be padded so that pointers just past the end of
+#   an object can be recognized.  This can be expensive.  (The padding
+#   is normally more than one byte due to alignment constraints.)
+#   -DDONT_ADD_BYTE_AT_END disables the padding.
+# -DNO_SIGNALS does not disable signals during critical parts of
+#   the GC process.  This is no less correct than many malloc 
+#   implementations, and it sometimes has a significant performance
+#   impact.  However, it is dangerous for many not-quite-ANSI C
+#   programs that call things like printf in asynchronous signal handlers.
+# -DNO_EXECUTE_PERMISSION may cause some or all of the heap to not
+#   have execute permission, i.e. it may be impossible to execute
+#   code from the heap.  Currently this only affects the incremental
+#   collector on UNIX machines.  It may greatly improve its performance,
+#   since this may avoid some expensive cache synchronization.
+# -DOPERATOR_NEW_ARRAY declares that the C++ compiler supports the
+#   new syntax "operator new[]" for allocating and deleting arrays.
+#   See gc_cpp.h for details.  No effect on the C part of the collector.
+#   This is defined implicitly in a few environments.
+# -DREDIRECT_MALLOC=X causes malloc, realloc, and free to be defined
+#   as aliases for X, GC_realloc, and GC_free, respectively.
+#   Calloc is redefined in terms of the new malloc.  X should
+#   be either GC_malloc or GC_malloc_uncollectable.
+#   The former is occasionally useful for working around leaks in code
+#   you don't want to (or can't) look at.  It may not work for
+#   existing code, but it often does.  Neither works on all platforms,
+#   since some ports use malloc or calloc to obtain system memory.
+#   (Probably works for UNIX, and win32.)
+# -DIGNORE_FREE turns calls to free into a noop.  Only useful with
+#   -DREDIRECT_MALLOC.
+# -DNO_DEBUGGING removes GC_dump and the debugging routines it calls.
+#   Reduces code size slightly at the expense of debuggability.
+# -DJAVA_FINALIZATION makes it somewhat safer to finalize objects out of
+#   order by specifying a nonstandard finalization mark procedure  (see
+#   finalize.c).  Objects reachable from finalizable objects will be marked
+#   in a sepearte postpass, and hence their memory won't be reclaimed.
+#   Not recommended unless you are implementing a language that specifies
+#   these semantics.
+# -DFINALIZE_ON_DEMAND causes finalizers to be run only in response
+#   to explicit GC_invoke_finalizers() calls.
+# -DATOMIC_UNCOLLECTABLE includes code for GC_malloc_atomic_uncollectable.
+#   This is useful if either the vendor malloc implementation is poor,
+#   or if REDIRECT_MALLOC is used.
+# -DHBLKSIZE=ddd, where ddd is a power of 2 between 512 and 16384, explicitly
+#   sets the heap block size.  Each heap block is devoted to a single size and
+#   kind of object.  For the incremental collector it makes sense to match
+#   the most likely page size.  Otherwise large values result in more
+#   fragmentation, but generally better performance for large heaps.
+# -DUSE_MMAP use MMAP instead of sbrk to get new memory.
+#   Works for Solaris and Irix.
+# -DMMAP_STACKS (for Solaris threads) Use mmap from /dev/zero rather than
+#   GC_scratch_alloc() to get stack memory.
+# -DPRINT_BLACK_LIST Whenever a black list entry is added, i.e. whenever
+#   the garbage collector detects a value that looks almost, but not quite,
+#   like a pointer, print both the address containing the value, and the
+#   value of the near-bogus-pointer.  Can be used to identifiy regions of
+#   memory that are likely to contribute misidentified pointers.
+# -DOLD_BLOCK_ALLOC Use the old, possibly faster, large block
+#   allocation strategy.  The new strategy tries harder to minimize
+#   fragmentation, sometimes at the expense of spending more time in the
+#   large block allocator and/or collecting more frequently.
+#   If you expect the allocator to promtly use an explicitly expanded
+#   heap, this is highly recommended.
+#
+
+
+
+LIBGC_CFLAGS= -O -DNO_SIGNALS -DSILENT \
+    -DREDIRECT_MALLOC=GC_malloc_uncollectable \
+    -DDONT_ADD_BYTE_AT_END -DALL_INTERIOR_POINTERS
+#   Flags for building libgc.a -- the last two are required.
+
+CXXFLAGS= $(CFLAGS) -DOPERATOR_NEW_ARRAY
+AR= ar
+RANLIB= ranlib
+
+
+# Redefining srcdir allows object code for the nonPCR version of the collector
+# to be generated in different directories.  In this case, the destination directory
+# should contain a copy of the original include directory.
+srcdir = .
+VPATH = $(srcdir)
+
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o dbg_mlc.o malloc.o stubborn.o checksums.o solaris_threads.o irix_threads.o linux_threads.o typd_mlc.o ptr_chck.o mallocx.o solaris_pthreads.o
+
+CSRCS= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dyn_load.c dbg_mlc.c malloc.c stubborn.c checksums.c solaris_threads.c irix_threads.c linux_threads.c typd_mlc.c ptr_chck.c mallocx.c solaris_pthreads.c
+
+CORD_SRCS=  cord/cordbscs.c cord/cordxtra.c cord/cordprnt.c cord/de.c cord/cordtest.c cord/cord.h cord/ec.h cord/private/cord_pos.h cord/de_win.c cord/de_win.h cord/de_cmds.h cord/de_win.ICO cord/de_win.RC cord/SCOPTIONS.amiga cord/SMakefile.amiga
+
+CORD_OBJS=  cord/cordbscs.o cord/cordxtra.o cord/cordprnt.o
+
+SRCS= $(CSRCS) mips_sgi_mach_dep.s rs6000_mach_dep.s alpha_mach_dep.s \
+    sparc_mach_dep.s gc.h gc_typed.h gc_hdrs.h gc_priv.h gc_private.h \
+    gcconfig.h gc_mark.h include/gc_inl.h include/gc_inline.h gc.man \
+    threadlibs.c if_mach.c if_not_there.c gc_cpp.cc gc_cpp.h weakpointer.h \
+    gcc_support.c mips_ultrix_mach_dep.s include/gc_alloc.h gc_alloc.h \
+    include/new_gc_alloc.h include/javaxfc.h sparc_sunos4_mach_dep.s \
+    solaris_threads.h $(CORD_SRCS)
+
+OTHER_FILES= Makefile PCR-Makefile OS2_MAKEFILE NT_MAKEFILE BCC_MAKEFILE \
+           README test.c test_cpp.cc setjmp_t.c SMakefile.amiga \
+           SCoptions.amiga README.amiga README.win32 cord/README \
+           cord/gc.h include/gc.h include/gc_typed.h include/cord.h \
+           include/ec.h include/private/cord_pos.h include/private/gcconfig.h \
+           include/private/gc_hdrs.h include/private/gc_priv.h \
+	   include/gc_cpp.h README.rs6000 \
+           include/weakpointer.h README.QUICK callprocs pc_excludes \
+           barrett_diagram README.OS2 README.Mac MacProjects.sit.hqx \
+           MacOS.c EMX_MAKEFILE makefile.depend README.debugging \
+           include/gc_cpp.h Mac_files/datastart.c Mac_files/dataend.c \
+           Mac_files/MacOS_config.h Mac_files/MacOS_Test_config.h \
+           add_gc_prefix.c README.solaris2 README.sgi README.hp README.uts \
+	   win32_threads.c NT_THREADS_MAKEFILE gc.mak README.dj Makefile.dj \
+	   README.alpha README.linux version.h Makefile.DLLs \
+	   WCC_MAKEFILE
+
+CORD_INCLUDE_FILES= $(srcdir)/gc.h $(srcdir)/cord/cord.h $(srcdir)/cord/ec.h \
+           $(srcdir)/cord/private/cord_pos.h
+
+UTILS= if_mach$(EXE_SUFFIX) if_not_there$(EXE_SUFFIX)
+
+# Libraries needed for curses applications.  Only needed for de.
+CURSES= -lcurses -ltermlib
+
+# The following is irrelevant on most systems.  But a few
+# versions of make otherwise fork the shell specified in
+# the SHELL environment variable.
+SHELL= /bin/sh
+
+SPECIALCFLAGS = 
+# Alternative flags to the C compiler for mach_dep.c.
+# Mach_dep.c often doesn't like optimization, and it's
+# not time-critical anyway.
+# Set SPECIALCFLAGS to -q nodirect_code on Encore.
+
+all: gc.a gctest$(EXE_SUFFIX)
+
+pcr: PCR-Makefile gc_private.h gc_hdrs.h gc.h gcconfig.h mach_dep.o $(SRCS)
+	make -f PCR-Makefile depend
+	make -f PCR-Makefile
+
+$(OBJS) test.o dyn_load.o dyn_load_sunos53.o: $(srcdir)/gc_priv.h $(srcdir)/gc_hdrs.h $(srcdir)/gc.h \
+    $(srcdir)/gcconfig.h $(srcdir)/gc_typed.h Makefile
+# The dependency on Makefile is needed.  Changing
+# options such as -DSILENT affects the size of GC_arrays,
+# invalidating all .o files that rely on gc_priv.h
+
+mark.o typd_mlc.o finalize.o: $(srcdir)/gc_mark.h
+
+base_lib gc.a: $(OBJS) dyn_load.o $(UTILS)
+	echo > base_lib
+	rm -f on_sparc_sunos5_1
+	./if_mach SPARC SUNOS5 touch on_sparc_sunos5_1
+	./if_mach SPARC SUNOS5 $(AR) rus gc.a $(OBJS) dyn_load.o
+	./if_not_there on_sparc_sunos5_1 $(AR) ru gc.a $(OBJS) dyn_load.o
+	-./if_not_there on_sparc_sunos5_1 $(RANLIB) gc.a
+#	ignore ranlib failure; that usually means it doesn't exist, and isn't needed
+
+cords: $(CORD_OBJS) cord/cordtest$(EXE_SUFFIX) $(UTILS)
+	rm -f on_sparc_sunos5_3
+	./if_mach SPARC SUNOS5 touch on_sparc_sunos5_3
+	./if_mach SPARC SUNOS5 $(AR) rus gc.a $(CORD_OBJS)
+	./if_not_there on_sparc_sunos5_3 $(AR) ru gc.a $(CORD_OBJS)
+	-./if_not_there on_sparc_sunos5_3 $(RANLIB) gc.a
+
+gc_cpp.o: $(srcdir)/gc_cpp.cc $(srcdir)/gc_cpp.h $(srcdir)/gc.h Makefile
+	$(CXX) -c $(CXXFLAGS) $(srcdir)/gc_cpp.cc
+
+test_cpp$(EXE_SUFFIX): $(srcdir)/test_cpp.cc $(srcdir)/gc_cpp.h gc_cpp.o $(srcdir)/gc.h \
+base_lib $(UTILS)
+	rm -f test_cpp test_cpp$(EXE_SUFFIX)
+	./if_mach HP_PA "" $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/test_cpp.cc gc_cpp.o gc.a -ldld
+	./if_not_there test_cpp$(EXE_SUFFIX) $(CXXLD) $(CXXFLAGS) -o test_cpp$(EXE_SUFFIX) $(srcdir)/test_cpp.cc gc_cpp.o gc.a
+	rm -f test_cpp
+
+c++: gc_cpp.o $(srcdir)/gc_cpp.h test_cpp$(EXE_SUFFIX)
+	rm -f on_sparc_sunos5_4
+	./if_mach SPARC SUNOS5 touch on_sparc_sunos5_4
+	./if_mach SPARC SUNOS5 $(AR) rus gc.a gc_cpp.o
+	./if_not_there on_sparc_sunos5_4 $(AR) ru gc.a gc_cpp.o
+	-./if_not_there on_sparc_sunos5_4 $(RANLIB) gc.a
+	./test_cpp$(EXE_SUFFIX) 1
+	echo > c++
+
+dyn_load_sunos53.o: dyn_load.c
+	$(CC) $(CFLAGS) -DSUNOS53_SHARED_LIB -c $(srcdir)/dyn_load.c -o $@
+
+# SunOS5 shared library version of the collector
+sunos5gc.so: $(OBJS) dyn_load_sunos53.o
+	$(CC) -G -o sunos5gc.so $(OBJS) dyn_load_sunos53.o -ldl
+	ln sunos5gc.so libgc.so
+
+# Alpha/OSF shared library version of the collector
+libalphagc.so: $(OBJS)
+	ld -shared -o libalphagc.so $(OBJS) dyn_load.o -lc
+	ln libalphagc.so libgc.so
+
+# IRIX shared library version of the collector
+libirixgc.so: $(OBJS) dyn_load.o
+	ld -shared $(ABI_FLAG) -o libirixgc.so $(OBJS) dyn_load.o -lc
+	ln libirixgc.so libgc.so
+
+# Linux shared library version of the collector
+liblinuxgc.so: $(OBJS) dyn_load.o
+	gcc -shared -o liblinuxgc.so $(OBJS) dyn_load.o -lo
+	ln liblinuxgc.so libgc.so
+
+mach_dep.o: $(srcdir)/mach_dep.c $(srcdir)/mips_sgi_mach_dep.s $(srcdir)/mips_ultrix_mach_dep.s $(srcdir)/rs6000_mach_dep.s $(UTILS)
+	rm -f mach_dep.o
+	./if_mach MIPS IRIX5 $(AS) -o mach_dep.o $(srcdir)/mips_sgi_mach_dep.s
+	./if_mach MIPS RISCOS $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+	./if_mach MIPS ULTRIX $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+	./if_mach RS6000 "" $(AS) -o mach_dep.o $(srcdir)/rs6000_mach_dep.s
+	./if_mach ALPHA "" $(AS) -o mach_dep.o $(srcdir)/alpha_mach_dep.s
+	./if_mach SPARC SUNOS5 $(AS) -o mach_dep.o $(srcdir)/sparc_mach_dep.s
+	./if_mach SPARC SUNOS4 $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+	./if_not_there mach_dep.o $(CC) -c $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+
+mark_rts.o: $(srcdir)/mark_rts.c if_mach if_not_there $(UTILS)
+	rm -f mark_rts.o
+	-./if_mach ALPHA OSF1 $(CC) -c $(CFLAGS) -Wo,-notail $(srcdir)/mark_rts.c
+	./if_not_there mark_rts.o $(CC) -c $(CFLAGS) $(srcdir)/mark_rts.c
+#	Work-around for DEC optimizer tail recursion elimination bug.
+#  The ALPHA-specific line should be removed if gcc is used.
+
+alloc.o: version.h
+
+cord/cordbscs.o: $(srcdir)/cord/cordbscs.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordbscs.c
+	mv cordbscs.o cord/cordbscs.o
+#  not all compilers understand -o filename
+
+cord/cordxtra.o: $(srcdir)/cord/cordxtra.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordxtra.c
+	mv cordxtra.o cord/cordxtra.o
+
+cord/cordprnt.o: $(srcdir)/cord/cordprnt.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordprnt.c
+	mv cordprnt.o cord/cordprnt.o
+
+cord/cordtest$(EXE_SUFFIX): $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a $(UTILS) /tmp
+	rm -f cord/cordtest$(EXE_SUFFIX)
+	./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/cordtest$(EXE_SUFFIX) $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -lucb
+	./if_mach HP_PA "" $(CC) $(CFLAGS) -o cord/cordtest$(EXE_SUFFIX) $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -ldld
+	./if_not_there cord/cordtest$(EXE_SUFFIX) $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a
+	rm -f cord/cordtest cordtest
+	-mv cordtest$(EXE_SUFFIX) cord/
+
+/tmp: $(UTILS)
+	./if_not_there /tmp mkdir /tmp
+
+cord/de$(EXE_SUFFIX): $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(UTILS)
+	rm -f cord/de cord/de$(EXE_SUFFIX)
+	./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -lucb `./threadlibs`
+	./if_mach HP_PA "" $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -ldld
+	./if_mach RS6000 "" $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+	./if_mach I386 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+	./if_mach ALPHA LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+	./if_not_there cord/de$(EXE_SUFFIX) $(CC) $(CFLAGS) -o cord/de$(EXE_SUFFIX) $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES)
+
+if_mach$(EXE_SUFFIX): $(srcdir)/if_mach.c $(srcdir)/gcconfig.h
+	rm -f if_mach if_mach$(EXE_SUFFIX)
+	$(CC) $(CFLAGS) -o if_mach $(srcdir)/if_mach.c
+	rm -f if_mach
+
+threadlibs$(EXE_SUFFIX): $(srcdir)/threadlibs.c $(srcdir)/gcconfig.h Makefile
+	rm -f threadlibs threadlibs$(EXE_SUFFIX)
+	$(CC) $(CFLAGS) -o threadlibs $(srcdir)/threadlibs.c
+	rm -f threadlibs
+
+if_not_there$(EXE_SUFFIX): $(srcdir)/if_not_there.c
+	rm -f if_not_there if_not_there$(EXE_SUFFIX)
+	$(CC) $(CFLAGS) -o if_not_there $(srcdir)/if_not_there.c
+	rm -f if_not_there
+
+# Clean removes *.o several times,
+# because as the first one doesn't seem to get them all!
+clean: 
+	rm -f gc.a *.o
+	rm -f *.o
+	rm -f *.o
+	rm -f cord/*.o
+	rm -f gctest gctest_dyn_link test_cpp
+	rm -f setjmp_test  mon.out gmon.out a.out core if_not_there if_mach
+	rm -f threadlibs $(CORD_OBJS) cordtest cord/cordtest de cord/de
+	rm -f gctest$(EXE_SUFFIX) gctest_dyn_link$(EXE_SUFFIX) test_cpp$(EXE_SUFFIX)
+	rm -f setjmp_test$(EXE_SUFFIX) if_not_there$(EXE_SUFFIX) if_mach$(EXE_SUFFIX)
+	rm -f threadlibs$(EXE_SUFFIX) cord/cordtest$(EXE_SUFFIX)
+	-rm -f *~
+
+gctest$(EXE_SUFFIX): test.o gc.a if_mach$(EXE_SUFFIX) if_not_there$(EXE_SUFFIX)
+	rm -f gctest gctest$(EXE_SUFFIX)
+	./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o gctest  test.o gc.a -lucb
+	./if_mach HP_PA "" $(CC) $(CFLAGS) -o gctest  test.o gc.a -ldld
+	./if_not_there gctest$(EXE_SUFFIX) $(CC) $(CFLAGS) -o gctest$(EXE_SUFFIX) test.o gc.a
+	rm -f gctest
+
+# If an optimized setjmp_test generates a segmentation fault,
+# odds are your compiler is broken.  Gctest may still work.
+# Try compiling setjmp_t.c unoptimized.
+setjmp_test$(EXE_SUFFIX): $(srcdir)/setjmp_t.c $(srcdir)/gc.h \
+		if_mach$(EXE_SUFFIX) if_not_there$(EXE_SUFFIX)
+	rm -f setjmp_test$(EXE_SUFFIX)
+	$(CC) $(CFLAGS) -o setjmp_test $(srcdir)/setjmp_t.c
+	rm -f setjmp_test
+
+test:  KandRtest cord/cordtest$(EXE_SUFFIX)
+	./cord/cordtest$(EXE_SUFFIX)
+
+# Those tests that work even with a K&R C compiler:
+KandRtest: setjmp_test$(EXE_SUFFIX) gctest$(EXE_SUFFIX)
+	./setjmp_test$(EXE_SUFFIX)
+	./gctest$(EXE_SUFFIX)
+
+add_gc_prefix$(EXE_SUFFIX): add_gc_prefix.c
+	$(CC) -o add_gc_prefix$(EXE_SUFFIX) $(srcdir)/add_gc_prefix.c
+	rm -f add_gc_prefix
+
+gc.tar: $(SRCS) $(OTHER_FILES) add_gc_prefix
+	./add_gc_prefix$(EXE_SUFFIX) $(SRCS) $(OTHER_FILES) > /tmp/gc.tar-files
+	(cd $(srcdir)/.. ; tar cvfh - `cat /tmp/gc.tar-files`) > gc.tar
+
+pc_gc.tar: $(SRCS) $(OTHER_FILES)
+	tar cvfX pc_gc.tar pc_excludes $(SRCS) $(OTHER_FILES)
+
+floppy: pc_gc.tar
+	-mmd a:/cord
+	-mmd a:/cord/private
+	-mmd a:/include
+	-mmd a:/include/private
+	mkdir /tmp/pc_gc
+	cat pc_gc.tar | (cd /tmp/pc_gc; tar xvf -)
+	-mcopy -tmn /tmp/pc_gc/* a:
+	-mcopy -tmn /tmp/pc_gc/cord/* a:/cord
+	-mcopy -mn /tmp/pc_gc/cord/de_win.ICO a:/cord
+	-mcopy -tmn /tmp/pc_gc/cord/private/* a:/cord/private
+	-mcopy -tmn /tmp/pc_gc/include/* a:/include
+	-mcopy -tmn /tmp/pc_gc/include/private/* a:/include/private
+	rm -r /tmp/pc_gc
+
+gc.tar.Z: gc.tar
+	compress gc.tar
+
+gc.tar.gz: gc.tar
+	gzip gc.tar
+
+lint: $(CSRCS) test.c
+	lint -DLINT $(CSRCS) test.c | egrep -v "possible pointer alignment problem|abort|exit|sbrk|mprotect|syscall"
+
+# BTL: added to test shared library version of collector.
+# Currently works only under SunOS5.  Requires GC_INIT call from statically
+# loaded client code.
+ABSDIR = `pwd`
+gctest_dyn_link: test.o libgc.so
+	$(CC) -L$(ABSDIR) -R$(ABSDIR) -o gctest_dyn_link test.o -lgc -ldl -lthread
+
+gctest_irix_dyn_link: test.o libirixgc.so
+	$(CC) -L$(ABSDIR) -o gctest_irix_dyn_link test.o -lirixgc
+
+test_dll.o: test.c libgc_globals.h
+	$(CC) $(CFLAGS) -DGC_USE_DLL -c test.c -o test_dll.o
+
+test_dll: test_dll.o libgc_dll.a libgc.dll
+	$(CC) test_dll.o -L$(ABSDIR) -lgc_dll -o test_dll
+
+SYM_PREFIX-libgc=GC
+
+# Uncomment the following line to build a GNU win32 DLL
+# include Makefile.DLLs
+
+reserved_namespace: $(SRCS)
+	for file in $(SRCS) test.c test_cpp.cc; do \
+		sed s/GC_/_GC_/g < $$file > tmp; \
+		cp tmp $$file; \
+		done
+
+user_namespace: $(SRCS)
+	for file in $(SRCS) test.c test_cpp.cc; do \
+		sed s/_GC_/GC_/g < $$file > tmp; \
+		cp tmp $$file; \
+		done
+
diff --git a/src/gc/Makefile.in b/src/gc/Makefile.in
new file mode 100644
index 000000000..9c5e6da03
--- /dev/null
+++ b/src/gc/Makefile.in
@@ -0,0 +1,469 @@
+# Primary targets:
+# gc.a - builds basic library
+# c++ - adds C++ interface to library
+# cords - adds cords (heavyweight strings) to library
+# test - prints porting information, then builds basic version of gc.a,
+#      	 and runs some tests of collector and cords.  Does not add cords or
+#	 c++ interface to gc.a
+# cord/de - builds dumb editor based on cords.
+ABI_FLAG=
+CC=cc $(ABI_FLAG)
+HOSTCC=$(CC)
+CXX=g++ $(ABI_FLAG)
+AS=as $(ABI_FLAG)
+#  The above doesn't work with gas, which doesn't run cpp.
+#  Define AS as `gcc -c -x assembler-with-cpp' instead.
+#  Under Irix 6, you will have to specify the ABI (-o32, -n32, or -64)
+#  if you use something other than the default ABI on your machine.
+
+CFLAGS= @CFLAGS@ -I$(srcdir) -O -DATOMIC_UNCOLLECTABLE -DNO_SIGNALS -DNO_EXECUTE_PERMISSION -DALL_INTERIOR_POINTERS -DSILENT
+
+# For dynamic library builds, it may be necessary to add flags to generate
+# PIC code, e.g. -fPIC on Linux.
+
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+# -DSILENT disables statistics printing, and improves performance.
+# -DFIND_LEAK causes GC_find_leak to be initially set.
+#   This causes the collector to assume that all inaccessible
+#   objects should have been explicitly deallocated, and reports exceptions.
+#   Finalization and the test program are not usable in this mode.
+# -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+#   (Clients should also define SOLARIS_THREADS and then include
+#   gc.h before performing thr_ or dl* or GC_ operations.)
+#   Must also define -D_REENTRANT.
+# -D_SOLARIS_PTHREADS enables support for Solaris pthreads.
+#   Define SOLARIS_THREADS as well.
+# -DIRIX_THREADS enables support for Irix pthreads.  See README.irix.
+# -DHPUX_THREADS enables support for HP/UX 11 pthreads.
+#  Also requires -D_REENTRANT. See README.hp.
+# -DLINUX_THREADS enables support for Xavier Leroy's Linux threads.
+#   see README.linux.  -D_REENTRANT may also be required.
+# -DALL_INTERIOR_POINTERS allows all pointers to the interior
+#   of objects to be recognized.  (See gc_priv.h for consequences.)
+# -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+#   usually causing it to use less space in such situations.
+#   Incremental collection no longer works in this case.
+# -DLARGE_CONFIG tunes the collector for unusually large heaps.
+#   Necessary for heaps larger than about 500 MB on most machines.
+#   Recommended for heaps larger than about 64 MB.
+# -DDONT_ADD_BYTE_AT_END is meaningful only with
+#   -DALL_INTERIOR_POINTERS.  Normally -DALL_INTERIOR_POINTERS
+#   causes all objects to be padded so that pointers just past the end of
+#   an object can be recognized.  This can be expensive.  (The padding
+#   is normally more than one byte due to alignment constraints.)
+#   -DDONT_ADD_BYTE_AT_END disables the padding.
+# -DNO_SIGNALS does not disable signals during critical parts of
+#   the GC process.  This is no less correct than many malloc 
+#   implementations, and it sometimes has a significant performance
+#   impact.  However, it is dangerous for many not-quite-ANSI C
+#   programs that call things like printf in asynchronous signal handlers.
+#   This is on by default.  Turning it off has not been extensively tested with
+#   compilers that reorder stores.  It should have been.
+# -DNO_EXECUTE_PERMISSION may cause some or all of the heap to not
+#   have execute permission, i.e. it may be impossible to execute
+#   code from the heap.  Currently this only affects the incremental
+#   collector on UNIX machines.  It may greatly improve its performance,
+#   since this may avoid some expensive cache synchronization.
+# -DOPERATOR_NEW_ARRAY declares that the C++ compiler supports the
+#   new syntax "operator new[]" for allocating and deleting arrays.
+#   See gc_cpp.h for details.  No effect on the C part of the collector.
+#   This is defined implicitly in a few environments.
+# -DREDIRECT_MALLOC=X causes malloc, realloc, and free to be defined
+#   as aliases for X, GC_realloc, and GC_free, respectively.
+#   Calloc is redefined in terms of the new malloc.  X should
+#   be either GC_malloc or GC_malloc_uncollectable.
+#   The former is occasionally useful for working around leaks in code
+#   you don't want to (or can't) look at.  It may not work for
+#   existing code, but it often does.  Neither works on all platforms,
+#   since some ports use malloc or calloc to obtain system memory.
+#   (Probably works for UNIX, and win32.)
+# -DIGNORE_FREE turns calls to free into a noop.  Only useful with
+#   -DREDIRECT_MALLOC.
+# -DNO_DEBUGGING removes GC_dump and the debugging routines it calls.
+#   Reduces code size slightly at the expense of debuggability.
+# -DJAVA_FINALIZATION makes it somewhat safer to finalize objects out of
+#   order by specifying a nonstandard finalization mark procedure  (see
+#   finalize.c).  Objects reachable from finalizable objects will be marked
+#   in a sepearte postpass, and hence their memory won't be reclaimed.
+#   Not recommended unless you are implementing a language that specifies
+#   these semantics.  Since 5.0, determines only only the initial value
+#   of GC_java_finalization variable.
+# -DFINALIZE_ON_DEMAND causes finalizers to be run only in response
+#   to explicit GC_invoke_finalizers() calls.
+#   In 5.0 this became runtime adjustable, and this only determines the
+#   initial value of GC_finalize_on_demand.
+# -DATOMIC_UNCOLLECTABLE includes code for GC_malloc_atomic_uncollectable.
+#   This is useful if either the vendor malloc implementation is poor,
+#   or if REDIRECT_MALLOC is used.
+# -DHBLKSIZE=ddd, where ddd is a power of 2 between 512 and 16384, explicitly
+#   sets the heap block size.  Each heap block is devoted to a single size and
+#   kind of object.  For the incremental collector it makes sense to match
+#   the most likely page size.  Otherwise large values result in more
+#   fragmentation, but generally better performance for large heaps.
+# -DUSE_MMAP use MMAP instead of sbrk to get new memory.
+#   Works for Solaris and Irix.
+# -DUSE_MUNMAP causes memory to be returned to the OS under the right
+#   circumstances.  This currently disables VM-based incremental collection.
+#   This is currently experimental, and works only under some Unix and
+#   Linux versions.
+# -DMMAP_STACKS (for Solaris threads) Use mmap from /dev/zero rather than
+#   GC_scratch_alloc() to get stack memory.
+# -DPRINT_BLACK_LIST Whenever a black list entry is added, i.e. whenever
+#   the garbage collector detects a value that looks almost, but not quite,
+#   like a pointer, print both the address containing the value, and the
+#   value of the near-bogus-pointer.  Can be used to identifiy regions of
+#   memory that are likely to contribute misidentified pointers.
+# -DKEEP_BACK_PTRS Add code to save back pointers in debugging headers
+#   for objects allocated with the debugging allocator.  If all objects
+#   through GC_MALLOC with GC_DEBUG defined, this allows the client
+#   to determine how particular or randomly chosen objects are reachable
+#   for debugging/profiling purposes.  The backptr.h interface is
+#   implemented only if this is defined.
+# -DGC_ASSERTIONS Enable some internal GC assertion checking.  Currently
+#   this facility is only used in a few places.  It is intended primarily
+#   for debugging of the garbage collector itself, but could also
+#   occasionally be useful for debugging of client code.  Slows down the
+#   collector somewhat, but not drastically.
+# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+#   altered stubborn objects, at substantial performance cost.
+#   Use only for debugging of the incremental collector.
+# -DGC_GCJ_SUPPORT includes support for gcj (and possibly other systems
+#   that include a pointer to a type descriptor in each allocated object).
+#   Building this way requires an ANSI C compiler.
+# -DUSE_I686_PREFETCH causes the collector to issue Pentium III style
+#   prefetch instructions.  No effect except on X86 Linux platforms.
+#   Assumes a very recent gcc-compatible compiler and assembler.
+#   (Gas prefetcht0 support was added around May 1999.)
+#   Empirically the code appears to still run correctly on Pentium II
+#   processors, though with no performance benefit.  May not run on other
+#   X86 processors?  In some cases this improves performance by
+#   15% or so.
+# -DUSE_3DNOW_PREFETCH causes the collector to issue AMD 3DNow style
+#   prefetch instructions.  Same restrictions as USE_I686_PREFETCH.
+#   UNTESTED!!
+# -DUSE_LD_WRAP in combination with the gld flags listed in README.linux
+#   causes the collector some system and pthread calls in a more transparent
+#   fashion than the usual macro-based approach.  Requires GNU ld, and
+#   currently probably works only with Linux.
+#
+
+
+LIBGC_CFLAGS= -O -DNO_SIGNALS -DSILENT \
+    -DREDIRECT_MALLOC=GC_malloc_uncollectable \
+    -DDONT_ADD_BYTE_AT_END -DALL_INTERIOR_POINTERS
+#   Flags for building libgc.a -- the last two are required.
+
+CXXFLAGS= $(CFLAGS) 
+AR= ar
+RANLIB= ranlib
+
+
+# Redefining srcdir allows object code for the nonPCR version of the collector
+# to be generated in different directories.  In this case, the destination directory
+# should contain a copy of the original include directory.
+srcdir = @srcdir@
+VPATH = $(srcdir)
+LIBRARY = ../libgc.a
+
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o dbg_mlc.o malloc.o stubborn.o checksums.o solaris_threads.o hpux_irix_threads.o linux_threads.o typd_mlc.o ptr_chck.o mallocx.o solaris_pthreads.o gcj_mlc.o
+
+CSRCS= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dyn_load.c dbg_mlc.c malloc.c stubborn.c checksums.c solaris_threads.c hpux_irix_threads.c linux_threads.c typd_mlc.c ptr_chck.c mallocx.c solaris_pthreads.c gcj_mlc.c
+
+CORD_SRCS=  cord/cordbscs.c cord/cordxtra.c cord/cordprnt.c cord/de.c cord/cordtest.c cord/cord.h cord/ec.h cord/private/cord_pos.h cord/de_win.c cord/de_win.h cord/de_cmds.h cord/de_win.ICO cord/de_win.RC cord/SCOPTIONS.amiga cord/SMakefile.amiga
+
+CORD_OBJS=  cord/cordbscs.o cord/cordxtra.o cord/cordprnt.o
+
+SRCS= $(CSRCS) mips_sgi_mach_dep.s rs6000_mach_dep.s alpha_mach_dep.s \
+    sparc_mach_dep.s gc.h gc_typed.h gc_hdrs.h gc_priv.h gc_private.h \
+    gcconfig.h gc_mark.h include/gc_inl.h include/gc_inline.h gc.man \
+    threadlibs.c if_mach.c if_not_there.c gc_cpp.cc gc_cpp.h weakpointer.h \
+    gcc_support.c mips_ultrix_mach_dep.s include/gc_alloc.h gc_alloc.h \
+    include/new_gc_alloc.h include/javaxfc.h sparc_sunos4_mach_dep.s \
+    solaris_threads.h backptr.h hpux_test_and_clear.s include/gc_gcj.h \
+    dbg_mlc.h $(CORD_SRCS)
+
+OTHER_FILES= Makefile PCR-Makefile OS2_MAKEFILE NT_MAKEFILE BCC_MAKEFILE \
+           README test.c test_cpp.cc setjmp_t.c SMakefile.amiga \
+           SCoptions.amiga README.amiga README.win32 cord/README \
+           cord/gc.h include/gc.h include/gc_typed.h include/cord.h \
+           include/ec.h include/private/cord_pos.h include/private/gcconfig.h \
+           include/private/gc_hdrs.h include/private/gc_priv.h \
+	   include/gc_cpp.h README.rs6000 include/backptr.h \
+           include/weakpointer.h README.QUICK callprocs pc_excludes \
+           barrett_diagram README.OS2 README.Mac MacProjects.sit.hqx \
+           MacOS.c EMX_MAKEFILE makefile.depend README.debugging \
+           include/gc_cpp.h Mac_files/datastart.c Mac_files/dataend.c \
+           Mac_files/MacOS_config.h Mac_files/MacOS_Test_config.h \
+           add_gc_prefix.c README.solaris2 README.sgi README.hp README.uts \
+	   win32_threads.c NT_THREADS_MAKEFILE gc.mak README.dj Makefile.dj \
+	   README.alpha README.linux version.h Makefile.DLLs \
+	   WCC_MAKEFILE nursery.c include/gc_nursery.h include/gc_copy_descr.h \
+	   include/leak_detector.h
+
+CORD_INCLUDE_FILES= $(srcdir)/gc.h $(srcdir)/cord/cord.h $(srcdir)/cord/ec.h \
+           $(srcdir)/cord/private/cord_pos.h
+
+UTILS= if_mach if_not_there threadlibs
+
+# Libraries needed for curses applications.  Only needed for de.
+CURSES= -lcurses -ltermlib
+
+# The following is irrelevant on most systems.  But a few
+# versions of make otherwise fork the shell specified in
+# the SHELL environment variable.
+SHELL= /bin/sh
+
+SPECIALCFLAGS = 
+# Alternative flags to the C compiler for mach_dep.c.
+# Mach_dep.c often doesn't like optimization, and it's
+# not time-critical anyway.
+# Set SPECIALCFLAGS to -q nodirect_code on Encore.
+
+all: $(LIBRARY) # gctest
+
+pcr: PCR-Makefile gc_private.h gc_hdrs.h gc.h gcconfig.h mach_dep.o $(SRCS)
+	make -f PCR-Makefile depend
+	make -f PCR-Makefile
+
+$(OBJS) test.o dyn_load.o dyn_load_sunos53.o: $(srcdir)/gc_priv.h $(srcdir)/gc_hdrs.h $(srcdir)/gc.h \
+    $(srcdir)/gcconfig.h $(srcdir)/gc_typed.h Makefile
+# The dependency on Makefile is needed.  Changing
+# options such as -DSILENT affects the size of GC_arrays,
+# invalidating all .o files that rely on gc_priv.h
+
+mark.o typd_mlc.o finalize.o: $(srcdir)/gc_mark.h
+
+base_lib $(LIBRARY): $(OBJS) dyn_load.o $(UTILS)
+	echo > base_lib
+	rm -f dont_ar_1
+	./if_mach SPARC SUNOS5 touch dont_ar_1
+	./if_mach SPARC SUNOS5 $(AR) rus $(LIBRARY) $(OBJS) dyn_load.o
+	./if_mach M68K AMIGA touch dont_ar_1
+	./if_mach M68K AMIGA $(AR) -vrus $(LIBRARY) $(OBJS) dyn_load.o
+	./if_not_there dont_ar_1 $(AR) ru $(LIBRARY) $(OBJS) dyn_load.o
+	./if_not_there dont_ar_1 $(RANLIB) $(LIBRARY) || cat /dev/null
+#	ignore ranlib failure; that usually means it doesn't exist, and isn't needed
+
+cords: $(CORD_OBJS) cord/cordtest $(UTILS)
+	rm -f dont_ar_3
+	./if_mach SPARC SUNOS5 touch dont_ar_3
+	./if_mach SPARC SUNOS5 $(AR) rus $(LIBRARY) $(CORD_OBJS)
+	./if_mach M68K AMIGA touch dont_ar_3
+	./if_mach M68K AMIGA $(AR) -vrus $(LIBRARY) $(CORD_OBJS)
+	./if_not_there dont_ar_3 $(AR) ru $(LIBRARY) $(CORD_OBJS)
+	./if_not_there dont_ar_3 $(RANLIB) $(LIBRARY) || cat /dev/null
+
+gc_cpp.o: $(srcdir)/gc_cpp.cc $(srcdir)/gc_cpp.h $(srcdir)/gc.h Makefile
+	$(CXX) -c $(CXXFLAGS) $(srcdir)/gc_cpp.cc
+
+test_cpp: $(srcdir)/test_cpp.cc $(srcdir)/gc_cpp.h gc_cpp.o $(srcdir)/gc.h \
+base_lib $(UTILS)
+	rm -f test_cpp
+	./if_mach HP_PA HPUX $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/test_cpp.cc gc_cpp.o $(LIBRARY) -ldld `./threadlibs`
+	./if_not_there test_cpp $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/test_cpp.cc gc_cpp.o $(LIBRARY) `./threadlibs`
+
+c++: gc_cpp.o $(srcdir)/gc_cpp.h test_cpp
+	rm -f dont_ar_4
+	./if_mach SPARC SUNOS5 touch dont_ar_4
+	./if_mach SPARC SUNOS5 $(AR) rus $(LIBRARY) gc_cpp.o
+	./if_mach M68K AMIGA touch dont_ar_4
+	./if_mach M68K AMIGA $(AR) -vrus $(LIBRARY) gc_cpp.o
+	./if_not_there dont_ar_4 $(AR) ru $(LIBRARY) gc_cpp.o
+	./if_not_there dont_ar_4 $(RANLIB) $(LIBRARY) || cat /dev/null
+	./test_cpp 1
+	echo > c++
+
+dyn_load_sunos53.o: dyn_load.c
+	$(CC) $(CFLAGS) -DSUNOS53_SHARED_LIB -c $(srcdir)/dyn_load.c -o $@
+
+# SunOS5 shared library version of the collector
+sunos5gc.so: $(OBJS) dyn_load_sunos53.o
+	$(CC) -G -o sunos5gc.so $(OBJS) dyn_load_sunos53.o -ldl
+	ln sunos5gc.so libgc.so
+
+# Alpha/OSF shared library version of the collector
+libalphagc.so: $(OBJS)
+	ld -shared -o libalphagc.so $(OBJS) dyn_load.o -lc
+	ln libalphagc.so libgc.so
+
+# IRIX shared library version of the collector
+libirixgc.so: $(OBJS) dyn_load.o
+	ld -shared $(ABI_FLAG) -o libirixgc.so $(OBJS) dyn_load.o -lc
+	ln libirixgc.so libgc.so
+
+# Linux shared library version of the collector
+liblinuxgc.so: $(OBJS) dyn_load.o
+	gcc -shared -o liblinuxgc.so $(OBJS) dyn_load.o -lo
+	ln liblinuxgc.so libgc.so
+
+# Alternative Linux rule.  This is preferable, but is likely to break the
+# Makefile for some non-linux platforms.
+# LIBOBJS= $(patsubst %.o, %.lo, $(OBJS))
+#
+#.SUFFIXES: .lo $(SUFFIXES)
+#
+#.c.lo:
+#	$(CC) $(CFLAGS) $(CPPFLAGS) -fPIC -c $< -o $@
+#
+# liblinuxgc.so: $(LIBOBJS) dyn_load.lo
+# 	gcc -shared -Wl,-soname=libgc.so.0 -o libgc.so.0 $(LIBOBJS) dyn_load.lo
+#	touch liblinuxgc.so
+
+mach_dep.o: $(srcdir)/mach_dep.c $(srcdir)/mips_sgi_mach_dep.s $(srcdir)/mips_ultrix_mach_dep.s $(srcdir)/rs6000_mach_dep.s $(UTILS)
+	rm -f mach_dep.o
+	./if_mach MIPS IRIX5 $(AS) -o mach_dep.o $(srcdir)/mips_sgi_mach_dep.s
+	./if_mach MIPS RISCOS $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+	./if_mach MIPS ULTRIX $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+	./if_mach RS6000 "" $(AS) -o mach_dep.o $(srcdir)/rs6000_mach_dep.s
+#	./if_mach ALPHA "" $(AS) -o mach_dep.o $(srcdir)/alpha_mach_dep.s
+#	alpha_mach_dep.s assumes that pointers are not saved in fp registers.
+#	Gcc on a 21264 can spill pointers to fp registers.  Oops.
+	./if_mach SPARC SUNOS5 $(AS) -o mach_dep.o $(srcdir)/sparc_mach_dep.s
+	./if_mach SPARC SUNOS4 $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+	./if_mach SPARC OPENBSD $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+	./if_mach HP_PA HPUX $(AS) -o hpux_test_and_clear.o $(srcdir)/hpux_test_and_clear.s
+	./if_mach HP_PA HPUX $(CC) -c -o md_tmp.o $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+	./if_mach HP_PA HPUX ld -r -o mach_dep.o md_tmp.o hpux_test_and_clear.o
+	./if_not_there mach_dep.o $(CC) -c $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+
+mark_rts.o: $(srcdir)/mark_rts.c $(UTILS)
+	rm -f mark_rts.o
+	-./if_mach ALPHA OSF1 $(CC) -c $(CFLAGS) -Wo,-notail $(srcdir)/mark_rts.c
+	./if_not_there mark_rts.o $(CC) -c $(CFLAGS) $(srcdir)/mark_rts.c
+#	Work-around for DEC optimizer tail recursion elimination bug.
+#  The ALPHA-specific line should be removed if gcc is used.
+
+alloc.o: version.h
+
+cord/cordbscs.o: $(srcdir)/cord/cordbscs.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordbscs.c
+	mv cordbscs.o cord/cordbscs.o
+#  not all compilers understand -o filename
+
+cord/cordxtra.o: $(srcdir)/cord/cordxtra.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordxtra.c
+	mv cordxtra.o cord/cordxtra.o
+
+cord/cordprnt.o: $(srcdir)/cord/cordprnt.c $(CORD_INCLUDE_FILES)
+	$(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordprnt.c
+	mv cordprnt.o cord/cordprnt.o
+
+cord/cordtest: $(srcdir)/cord/cordtest.c $(CORD_OBJS) $(LIBRARY) $(UTILS)
+	rm -f cord/cordtest
+	./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) $(LIBRARY) -lucb
+	./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) $(LIBRARY) -ldld `./threadlibs`
+	./if_not_there cord/cordtest $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) $(LIBRARY) `./threadlibs`
+
+cord/de: $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o $(LIBRARY) $(UTILS)
+	rm -f cord/de
+	./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o $(LIBRARY) $(CURSES) -lucb `./threadlibs`
+	./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o $(LIBRARY) $(CURSES) -ldld `./threadlibs`
+	./if_mach RS6000 "" $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o $(LIBRARY) -lcurses
+	./if_mach I386 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o $(LIBRARY) -lcurses `./threadlibs`
+	./if_mach ALPHA LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o $(LIBRARY) -lcurses `./threadlibs`
+	./if_mach IA64 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o $(LIBRARY) -lcurses `./threadlibs`
+	./if_mach M68K AMIGA $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o $(LIBRARY) -lcurses
+	./if_not_there cord/de $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o $(LIBRARY) $(CURSES) `./threadlibs`
+
+if_mach: $(srcdir)/if_mach.c $(srcdir)/gcconfig.h
+	$(HOSTCC) $(CFLAGS) -o if_mach $(srcdir)/if_mach.c
+
+threadlibs: $(srcdir)/threadlibs.c $(srcdir)/gcconfig.h Makefile
+	$(HOSTCC) $(CFLAGS) -o threadlibs $(srcdir)/threadlibs.c
+
+if_not_there: $(srcdir)/if_not_there.c
+	$(HOSTCC) $(CFLAGS) -o if_not_there $(srcdir)/if_not_there.c
+
+clean: 
+	rm -f $(LIBRARY) *.o gctest gctest_dyn_link test_cpp \
+	      setjmp_test  mon.out gmon.out a.out core if_not_there if_mach \
+	      threadlibs $(CORD_OBJS) cord/cordtest cord/de
+	-rm -f *~
+
+gctest: test.o $(LIBRARY) $(UTILS)
+	rm -f gctest
+	./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o gctest  test.o $(LIBRARY) -lucb
+	./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o gctest  test.o $(LIBRARY) -ldld `./threadlibs`
+	./if_not_there gctest $(CC) $(CFLAGS) -o gctest test.o $(LIBRARY) `./threadlibs`
+
+# If an optimized setjmp_test generates a segmentation fault,
+# odds are your compiler is broken.  Gctest may still work.
+# Try compiling setjmp_t.c unoptimized.
+setjmp_test: $(srcdir)/setjmp_t.c $(srcdir)/gc.h $(UTILS)
+	$(CC) $(CFLAGS) -o setjmp_test $(srcdir)/setjmp_t.c
+
+test:  KandRtest cord/cordtest
+	cord/cordtest
+
+# Those tests that work even with a K&R C compiler:
+KandRtest: setjmp_test gctest
+	./setjmp_test
+	./gctest
+
+add_gc_prefix: add_gc_prefix.c
+	$(CC) -o add_gc_prefix $(srcdir)/add_gc_prefix.c
+
+gc.tar: $(SRCS) $(OTHER_FILES) add_gc_prefix
+	./add_gc_prefix $(SRCS) $(OTHER_FILES) > /tmp/gc.tar-files
+	tar cvfh gc.tar `cat /tmp/gc.tar-files`
+
+pc_gc.tar: $(SRCS) $(OTHER_FILES)
+	tar cvfX pc_gc.tar pc_excludes $(SRCS) $(OTHER_FILES)
+
+floppy: pc_gc.tar
+	-mmd a:/cord
+	-mmd a:/cord/private
+	-mmd a:/include
+	-mmd a:/include/private
+	mkdir /tmp/pc_gc
+	cat pc_gc.tar | (cd /tmp/pc_gc; tar xvf -)
+	-mcopy -tmn /tmp/pc_gc/* a:
+	-mcopy -tmn /tmp/pc_gc/cord/* a:/cord
+	-mcopy -mn /tmp/pc_gc/cord/de_win.ICO a:/cord
+	-mcopy -tmn /tmp/pc_gc/cord/private/* a:/cord/private
+	-mcopy -tmn /tmp/pc_gc/include/* a:/include
+	-mcopy -tmn /tmp/pc_gc/include/private/* a:/include/private
+	rm -r /tmp/pc_gc
+
+gc.tar.Z: gc.tar
+	compress gc.tar
+
+gc.tar.gz: gc.tar
+	gzip gc.tar
+
+lint: $(CSRCS) test.c
+	lint -DLINT $(CSRCS) test.c | egrep -v "possible pointer alignment problem|abort|exit|sbrk|mprotect|syscall|change in ANSI|improper alignment"
+
+# BTL: added to test shared library version of collector.
+# Currently works only under SunOS5.  Requires GC_INIT call from statically
+# loaded client code.
+ABSDIR = `pwd`
+gctest_dyn_link: test.o libgc.so
+	$(CC) -L$(ABSDIR) -R$(ABSDIR) -o gctest_dyn_link test.o -lgc -ldl -lthread
+
+gctest_irix_dyn_link: test.o libirixgc.so
+	$(CC) -L$(ABSDIR) -o gctest_irix_dyn_link test.o -lirixgc
+
+test_dll.o: test.c libgc_globals.h
+	$(CC) $(CFLAGS) -DGC_USE_DLL -c test.c -o test_dll.o
+
+test_dll: test_dll.o libgc_dll.a libgc.dll
+	$(CC) test_dll.o -L$(ABSDIR) -lgc_dll -o test_dll
+
+SYM_PREFIX-libgc=GC
+
+# Uncomment the following line to build a GNU win32 DLL
+# include Makefile.DLLs
+
+reserved_namespace: $(SRCS)
+	for file in $(SRCS) test.c test_cpp.cc; do \
+		sed s/GC_/_GC_/g < $$file > tmp; \
+		cp tmp $$file; \
+		done
+
+user_namespace: $(SRCS)
+	for file in $(SRCS) test.c test_cpp.cc; do \
+		sed s/_GC_/GC_/g < $$file > tmp; \
+		cp tmp $$file; \
+		done
diff --git a/src/gc/NT_MAKEFILE b/src/gc/NT_MAKEFILE
new file mode 100644
index 000000000..a642262a9
--- /dev/null
+++ b/src/gc/NT_MAKEFILE
@@ -0,0 +1,59 @@
+# Makefile for Windows NT.  Assumes Microsoft compiler, and a single thread.
+# DLLs are included in the root set under NT, but not under win32S.
+# Use "nmake nodebug=1 all" for optimized versions of library, gctest and editor.
+
+CPU= i386
+!include <ntwin32.mak>
+
+OBJS= alloc.obj reclaim.obj allchblk.obj misc.obj mach_dep.obj os_dep.obj mark_rts.obj headers.obj mark.obj obj_map.obj blacklst.obj finalize.obj new_hblk.obj dbg_mlc.obj malloc.obj stubborn.obj dyn_load.obj typd_mlc.obj ptr_chck.obj gc_cpp.obj mallocx.obj
+
+all: gctest.exe cord\de.exe test_cpp.exe
+
+.c.obj:
+	$(cc) $(cdebug) $(cflags) $(cvars) -DSILENT -DALL_INTERIOR_POINTERS -D__STDC__ $*.c /Fo$*.obj
+
+.cpp.obj:
+	$(cc) $(cdebug) $(cflags) $(cvars) -DSILENT -DALL_INTERIOR_POINTERS $*.CPP /Fo$*.obj
+
+$(OBJS) test.obj: gc_priv.h gc_hdrs.h gc.h
+
+gc.lib: $(OBJS)
+	lib /MACHINE:i386 /out:gc.lib $(OBJS)
+# The original NT SDK used lib32 instead of lib
+
+gctest.exe: test.obj gc.lib
+#	The following works for win32 debugging.  For win32s debugging use debugtype:coff
+#	and add mapsympe line.
+#  This produces a "GUI" applications that opens no windows and writes to the log file
+#  "gc.log".  This is done to make the result runnable under win32s.
+	$(link) -debug:full -debugtype:cv $(guiflags) -stack:131072 -out:$*.exe test.obj $(guilibs) gc.lib
+#	mapsympe -n -o gctest.sym gctest.exe
+
+cord\de_win.rbj: cord\de_win.res
+	cvtres -$(CPU) cord\de_win.res -o cord\de_win.rbj
+
+cord\de.obj cord\de_win.obj: cord\cord.h cord\private\cord_pos.h cord\de_win.h cord\de_cmds.h
+
+cord\de_win.res: cord\de_win.rc cord\de_win.h cord\de_cmds.h
+	$(rc) $(rcvars) -r -fo cord\de_win.res $(cvars) cord\de_win.rc
+
+# Cord/de is a real win32 gui application.
+cord\de.exe: cord\cordbscs.obj cord\cordxtra.obj cord\de.obj cord\de_win.obj cord\de_win.rbj gc.lib
+	$(link) -debug:full -debugtype:cv $(guiflags) -stack:16384 -out:cord\de.exe  cord\cordbscs.obj cord\cordxtra.obj cord\de.obj cord\de_win.obj cord\de_win.rbj gc.lib $(guilibs)
+
+gc_cpp.obj: gc_cpp.h gc.h
+
+gc_cpp.cpp: gc_cpp.cc
+	copy gc_cpp.cc gc_cpp.cpp
+
+test_cpp.cpp: test_cpp.cc
+	copy test_cpp.cc test_cpp.cpp
+
+# This generates the C++ test executable.  The executable expects
+# a single numeric argument, which is the number of iterations.
+# The output appears in the file "gc.log".
+test_cpp.exe: test_cpp.obj gc_cpp.h gc.h gc.lib
+	$(link) -debug:full -debugtype:cv $(guiflags) -stack:16384 -out:test_cpp.exe test_cpp.obj gc.lib $(guilibs)
+
+
+
diff --git a/src/gc/NT_THREADS_MAKEFILE b/src/gc/NT_THREADS_MAKEFILE
new file mode 100644
index 000000000..0fd22b70d
--- /dev/null
+++ b/src/gc/NT_THREADS_MAKEFILE
@@ -0,0 +1,2087 @@
+# Microsoft Developer Studio Generated NMAKE File, Format Version 4.10
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Application" 0x0101
+# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
+
+!IF "$(CFG)" == ""
+CFG=gctest - Win32 Release
+!MESSAGE No configuration specified.  Defaulting to cord - Win32 Debug.
+!ENDIF 
+
+!IF "$(CFG)" != "gc - Win32 Release" && "$(CFG)" != "gc - Win32 Debug" &&\
+ "$(CFG)" != "gctest - Win32 Release" && "$(CFG)" != "gctest - Win32 Debug" &&\
+ "$(CFG)" != "cord - Win32 Release" && "$(CFG)" != "cord - Win32 Debug"
+!MESSAGE Invalid configuration "$(CFG)" specified.
+!MESSAGE You can specify a configuration when running NMAKE on this makefile
+!MESSAGE by defining the macro CFG on the command line.  For example:
+!MESSAGE 
+!MESSAGE NMAKE /f "gc.mak" CFG="cord - Win32 Debug"
+!MESSAGE 
+!MESSAGE Possible choices for configuration are:
+!MESSAGE 
+!MESSAGE "gc - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "gc - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "gctest - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "gctest - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE "cord - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "cord - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE 
+!ERROR An invalid configuration is specified.
+!ENDIF 
+
+!IF "$(OS)" == "Windows_NT"
+NULL=
+!ELSE 
+NULL=nul
+!ENDIF 
+################################################################################
+# Begin Project
+# PROP Target_Last_Scanned "gctest - Win32 Debug"
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+OUTDIR=.\Release
+INTDIR=.\Release
+
+ALL : ".\Release\gc.dll" ".\Release\gc.bsc"
+
+CLEAN : 
+	-@erase ".\Release\allchblk.obj"
+	-@erase ".\Release\allchblk.sbr"
+	-@erase ".\Release\alloc.obj"
+	-@erase ".\Release\alloc.sbr"
+	-@erase ".\Release\blacklst.obj"
+	-@erase ".\Release\blacklst.sbr"
+	-@erase ".\Release\checksums.obj"
+	-@erase ".\Release\checksums.sbr"
+	-@erase ".\Release\dbg_mlc.obj"
+	-@erase ".\Release\dbg_mlc.sbr"
+	-@erase ".\Release\dyn_load.obj"
+	-@erase ".\Release\dyn_load.sbr"
+	-@erase ".\Release\finalize.obj"
+	-@erase ".\Release\finalize.sbr"
+	-@erase ".\Release\gc.bsc"
+	-@erase ".\Release\gc.dll"
+	-@erase ".\Release\gc.exp"
+	-@erase ".\Release\gc.lib"
+	-@erase ".\Release\headers.obj"
+	-@erase ".\Release\headers.sbr"
+	-@erase ".\Release\mach_dep.obj"
+	-@erase ".\Release\mach_dep.sbr"
+	-@erase ".\Release\malloc.obj"
+	-@erase ".\Release\malloc.sbr"
+	-@erase ".\Release\mallocx.obj"
+	-@erase ".\Release\mallocx.sbr"
+	-@erase ".\Release\mark.obj"
+	-@erase ".\Release\mark.sbr"
+	-@erase ".\Release\mark_rts.obj"
+	-@erase ".\Release\mark_rts.sbr"
+	-@erase ".\Release\misc.obj"
+	-@erase ".\Release\misc.sbr"
+	-@erase ".\Release\new_hblk.obj"
+	-@erase ".\Release\new_hblk.sbr"
+	-@erase ".\Release\obj_map.obj"
+	-@erase ".\Release\obj_map.sbr"
+	-@erase ".\Release\os_dep.obj"
+	-@erase ".\Release\os_dep.sbr"
+	-@erase ".\Release\ptr_chck.obj"
+	-@erase ".\Release\ptr_chck.sbr"
+	-@erase ".\Release\reclaim.obj"
+	-@erase ".\Release\reclaim.sbr"
+	-@erase ".\Release\stubborn.obj"
+	-@erase ".\Release\stubborn.sbr"
+	-@erase ".\Release\typd_mlc.obj"
+	-@erase ".\Release\typd_mlc.sbr"
+	-@erase ".\Release\win32_threads.obj"
+	-@erase ".\Release\win32_threads.sbr"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /D "NDEBUG" /D "SILENT" /D "GC_BUILD" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /D "NDEBUG" /D "SILENT" /D "GC_BUILD" /D\
+ "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D\
+ "WIN32_THREADS" /FR"$(INTDIR)/" /Fp"$(INTDIR)/gc.pch" /YX /Fo"$(INTDIR)/" /c 
+CPP_OBJS=.\Release/
+CPP_SBRS=.\Release/
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gc.bsc" 
+BSC32_SBRS= \
+	".\Release\allchblk.sbr" \
+	".\Release\alloc.sbr" \
+	".\Release\blacklst.sbr" \
+	".\Release\checksums.sbr" \
+	".\Release\dbg_mlc.sbr" \
+	".\Release\dyn_load.sbr" \
+	".\Release\finalize.sbr" \
+	".\Release\headers.sbr" \
+	".\Release\mach_dep.sbr" \
+	".\Release\malloc.sbr" \
+	".\Release\mallocx.sbr" \
+	".\Release\mark.sbr" \
+	".\Release\mark_rts.sbr" \
+	".\Release\misc.sbr" \
+	".\Release\new_hblk.sbr" \
+	".\Release\obj_map.sbr" \
+	".\Release\os_dep.sbr" \
+	".\Release\ptr_chck.sbr" \
+	".\Release\reclaim.sbr" \
+	".\Release\stubborn.sbr" \
+	".\Release\typd_mlc.sbr" \
+	".\Release\win32_threads.sbr"
+
+".\Release\gc.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+    $(BSC32) @<<
+  $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /dll /incremental:no\
+ /pdb:"$(OUTDIR)/gc.pdb" /machine:I386 /out:"$(OUTDIR)/gc.dll"\
+ /implib:"$(OUTDIR)/gc.lib" 
+LINK32_OBJS= \
+	".\Release\allchblk.obj" \
+	".\Release\alloc.obj" \
+	".\Release\blacklst.obj" \
+	".\Release\checksums.obj" \
+	".\Release\dbg_mlc.obj" \
+	".\Release\dyn_load.obj" \
+	".\Release\finalize.obj" \
+	".\Release\headers.obj" \
+	".\Release\mach_dep.obj" \
+	".\Release\malloc.obj" \
+	".\Release\mallocx.obj" \
+	".\Release\mark.obj" \
+	".\Release\mark_rts.obj" \
+	".\Release\misc.obj" \
+	".\Release\new_hblk.obj" \
+	".\Release\obj_map.obj" \
+	".\Release\os_dep.obj" \
+	".\Release\ptr_chck.obj" \
+	".\Release\reclaim.obj" \
+	".\Release\stubborn.obj" \
+	".\Release\typd_mlc.obj" \
+	".\Release\win32_threads.obj"
+
+".\Release\gc.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+OUTDIR=.\Debug
+INTDIR=.\Debug
+
+ALL : ".\Debug\gc.dll" ".\Debug\gc.bsc"
+
+CLEAN : 
+	-@erase ".\Debug\allchblk.obj"
+	-@erase ".\Debug\allchblk.sbr"
+	-@erase ".\Debug\alloc.obj"
+	-@erase ".\Debug\alloc.sbr"
+	-@erase ".\Debug\blacklst.obj"
+	-@erase ".\Debug\blacklst.sbr"
+	-@erase ".\Debug\checksums.obj"
+	-@erase ".\Debug\checksums.sbr"
+	-@erase ".\Debug\dbg_mlc.obj"
+	-@erase ".\Debug\dbg_mlc.sbr"
+	-@erase ".\Debug\dyn_load.obj"
+	-@erase ".\Debug\dyn_load.sbr"
+	-@erase ".\Debug\finalize.obj"
+	-@erase ".\Debug\finalize.sbr"
+	-@erase ".\Debug\gc.bsc"
+	-@erase ".\Debug\gc.dll"
+	-@erase ".\Debug\gc.exp"
+	-@erase ".\Debug\gc.lib"
+	-@erase ".\Debug\gc.map"
+	-@erase ".\Debug\gc.pdb"
+	-@erase ".\Debug\headers.obj"
+	-@erase ".\Debug\headers.sbr"
+	-@erase ".\Debug\mach_dep.obj"
+	-@erase ".\Debug\mach_dep.sbr"
+	-@erase ".\Debug\malloc.obj"
+	-@erase ".\Debug\malloc.sbr"
+	-@erase ".\Debug\mallocx.obj"
+	-@erase ".\Debug\mallocx.sbr"
+	-@erase ".\Debug\mark.obj"
+	-@erase ".\Debug\mark.sbr"
+	-@erase ".\Debug\mark_rts.obj"
+	-@erase ".\Debug\mark_rts.sbr"
+	-@erase ".\Debug\misc.obj"
+	-@erase ".\Debug\misc.sbr"
+	-@erase ".\Debug\new_hblk.obj"
+	-@erase ".\Debug\new_hblk.sbr"
+	-@erase ".\Debug\obj_map.obj"
+	-@erase ".\Debug\obj_map.sbr"
+	-@erase ".\Debug\os_dep.obj"
+	-@erase ".\Debug\os_dep.sbr"
+	-@erase ".\Debug\ptr_chck.obj"
+	-@erase ".\Debug\ptr_chck.sbr"
+	-@erase ".\Debug\reclaim.obj"
+	-@erase ".\Debug\reclaim.sbr"
+	-@erase ".\Debug\stubborn.obj"
+	-@erase ".\Debug\stubborn.sbr"
+	-@erase ".\Debug\typd_mlc.obj"
+	-@erase ".\Debug\typd_mlc.sbr"
+	-@erase ".\Debug\vc40.idb"
+	-@erase ".\Debug\vc40.pdb"
+	-@erase ".\Debug\win32_threads.obj"
+	-@erase ".\Debug\win32_threads.sbr"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "SILENT" /D "GC_BUILD" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "SILENT" /D "GC_BUILD"\
+ /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D\
+ "WIN32_THREADS" /FR"$(INTDIR)/" /Fp"$(INTDIR)/gc.pch" /YX /Fo"$(INTDIR)/"\
+ /Fd"$(INTDIR)/" /c 
+CPP_OBJS=.\Debug/
+CPP_SBRS=.\Debug/
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gc.bsc" 
+BSC32_SBRS= \
+	".\Debug\allchblk.sbr" \
+	".\Debug\alloc.sbr" \
+	".\Debug\blacklst.sbr" \
+	".\Debug\checksums.sbr" \
+	".\Debug\dbg_mlc.sbr" \
+	".\Debug\dyn_load.sbr" \
+	".\Debug\finalize.sbr" \
+	".\Debug\headers.sbr" \
+	".\Debug\mach_dep.sbr" \
+	".\Debug\malloc.sbr" \
+	".\Debug\mallocx.sbr" \
+	".\Debug\mark.sbr" \
+	".\Debug\mark_rts.sbr" \
+	".\Debug\misc.sbr" \
+	".\Debug\new_hblk.sbr" \
+	".\Debug\obj_map.sbr" \
+	".\Debug\os_dep.sbr" \
+	".\Debug\ptr_chck.sbr" \
+	".\Debug\reclaim.sbr" \
+	".\Debug\stubborn.sbr" \
+	".\Debug\typd_mlc.sbr" \
+	".\Debug\win32_threads.sbr"
+
+".\Debug\gc.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+    $(BSC32) @<<
+  $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /incremental:no /map /debug /machine:I386
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /dll /incremental:no\
+ /pdb:"$(OUTDIR)/gc.pdb" /map:"$(INTDIR)/gc.map" /debug /machine:I386\
+ /out:"$(OUTDIR)/gc.dll" /implib:"$(OUTDIR)/gc.lib" 
+LINK32_OBJS= \
+	".\Debug\allchblk.obj" \
+	".\Debug\alloc.obj" \
+	".\Debug\blacklst.obj" \
+	".\Debug\checksums.obj" \
+	".\Debug\dbg_mlc.obj" \
+	".\Debug\dyn_load.obj" \
+	".\Debug\finalize.obj" \
+	".\Debug\headers.obj" \
+	".\Debug\mach_dep.obj" \
+	".\Debug\malloc.obj" \
+	".\Debug\mallocx.obj" \
+	".\Debug\mark.obj" \
+	".\Debug\mark_rts.obj" \
+	".\Debug\misc.obj" \
+	".\Debug\new_hblk.obj" \
+	".\Debug\obj_map.obj" \
+	".\Debug\os_dep.obj" \
+	".\Debug\ptr_chck.obj" \
+	".\Debug\reclaim.obj" \
+	".\Debug\stubborn.obj" \
+	".\Debug\typd_mlc.obj" \
+	".\Debug\win32_threads.obj"
+
+".\Debug\gc.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "gctest\Release"
+# PROP BASE Intermediate_Dir "gctest\Release"
+# PROP BASE Target_Dir "gctest"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "gctest\Release"
+# PROP Intermediate_Dir "gctest\Release"
+# PROP Target_Dir "gctest"
+OUTDIR=.\gctest\Release
+INTDIR=.\gctest\Release
+
+ALL : "gc - Win32 Release" ".\Release\gctest.exe"
+
+CLEAN : 
+	-@erase ".\gctest\Release\test.obj"
+	-@erase ".\Release\gctest.exe"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D\
+ "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS"\
+ /Fp"$(INTDIR)/gctest.pch" /YX /Fo"$(INTDIR)/" /c 
+CPP_OBJS=.\gctest\Release/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gctest.bsc" 
+BSC32_SBRS= \
+	
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /out:"Release/gctest.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no\
+ /pdb:"$(OUTDIR)/gctest.pdb" /machine:I386 /out:"Release/gctest.exe" 
+LINK32_OBJS= \
+	".\gctest\Release\test.obj" \
+	".\Release\gc.lib"
+
+".\Release\gctest.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "gctest\Debug"
+# PROP BASE Intermediate_Dir "gctest\Debug"
+# PROP BASE Target_Dir "gctest"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "gctest\Debug"
+# PROP Intermediate_Dir "gctest\Debug"
+# PROP Target_Dir "gctest"
+OUTDIR=.\gctest\Debug
+INTDIR=.\gctest\Debug
+
+ALL : "gc - Win32 Debug" ".\Debug\gctest.exe" ".\gctest\Debug\gctest.bsc"
+
+CLEAN : 
+	-@erase ".\Debug\gctest.exe"
+	-@erase ".\gctest\Debug\gctest.bsc"
+	-@erase ".\gctest\Debug\gctest.map"
+	-@erase ".\gctest\Debug\gctest.pdb"
+	-@erase ".\gctest\Debug\test.obj"
+	-@erase ".\gctest\Debug\test.sbr"
+	-@erase ".\gctest\Debug\vc40.idb"
+	-@erase ".\gctest\Debug\vc40.pdb"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "WIN32" /D "_WINDOWS"\
+ /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /FR"$(INTDIR)/"\
+ /Fp"$(INTDIR)/gctest.pch" /YX /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c 
+CPP_OBJS=.\gctest\Debug/
+CPP_SBRS=.\gctest\Debug/
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gctest.bsc" 
+BSC32_SBRS= \
+	".\gctest\Debug\test.sbr"
+
+".\gctest\Debug\gctest.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+    $(BSC32) @<<
+  $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /incremental:no /map /debug /machine:I386 /out:"Debug/gctest.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no\
+ /pdb:"$(OUTDIR)/gctest.pdb" /map:"$(INTDIR)/gctest.map" /debug /machine:I386\
+ /out:"Debug/gctest.exe" 
+LINK32_OBJS= \
+	".\Debug\gc.lib" \
+	".\gctest\Debug\test.obj"
+
+".\Debug\gctest.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "cord\Release"
+# PROP BASE Intermediate_Dir "cord\Release"
+# PROP BASE Target_Dir "cord"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "cord\Release"
+# PROP Intermediate_Dir "cord\Release"
+# PROP Target_Dir "cord"
+OUTDIR=.\cord\Release
+INTDIR=.\cord\Release
+
+ALL : "gc - Win32 Release" ".\Release\de.exe"
+
+CLEAN : 
+	-@erase ".\cord\Release\cordbscs.obj"
+	-@erase ".\cord\Release\cordxtra.obj"
+	-@erase ".\cord\Release\de.obj"
+	-@erase ".\cord\Release\de_win.obj"
+	-@erase ".\cord\Release\de_win.res"
+	-@erase ".\Release\de.exe"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /I "." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /I "." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D\
+ "ALL_INTERIOR_POINTERS" /Fp"$(INTDIR)/cord.pch" /YX /Fo"$(INTDIR)/" /c 
+CPP_OBJS=.\cord\Release/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+RSC_PROJ=/l 0x809 /fo"$(INTDIR)/de_win.res" /d "NDEBUG" 
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/cord.bsc" 
+BSC32_SBRS= \
+	
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /out:"Release/de.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no /pdb:"$(OUTDIR)/de.pdb"\
+ /machine:I386 /out:"Release/de.exe" 
+LINK32_OBJS= \
+	".\cord\Release\cordbscs.obj" \
+	".\cord\Release\cordxtra.obj" \
+	".\cord\Release\de.obj" \
+	".\cord\Release\de_win.obj" \
+	".\cord\Release\de_win.res" \
+	".\Release\gc.lib"
+
+".\Release\de.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "cord\Debug"
+# PROP BASE Intermediate_Dir "cord\Debug"
+# PROP BASE Target_Dir "cord"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "cord\Debug"
+# PROP Intermediate_Dir "cord\Debug"
+# PROP Target_Dir "cord"
+OUTDIR=.\cord\Debug
+INTDIR=.\cord\Debug
+
+ALL : "gc - Win32 Debug" ".\Debug\de.exe"
+
+CLEAN : 
+	-@erase ".\cord\Debug\cordbscs.obj"
+	-@erase ".\cord\Debug\cordxtra.obj"
+	-@erase ".\cord\Debug\de.obj"
+	-@erase ".\cord\Debug\de.pdb"
+	-@erase ".\cord\Debug\de_win.obj"
+	-@erase ".\cord\Debug\de_win.res"
+	-@erase ".\cord\Debug\vc40.idb"
+	-@erase ".\cord\Debug\vc40.pdb"
+	-@erase ".\Debug\de.exe"
+	-@erase ".\Debug\de.ilk"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /I "." /D "_DEBUG" /D "WIN32" /D\
+ "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /Fp"$(INTDIR)/cord.pch" /YX\
+ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c 
+CPP_OBJS=.\cord\Debug/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+RSC_PROJ=/l 0x809 /fo"$(INTDIR)/de_win.res" /d "_DEBUG" 
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/cord.bsc" 
+BSC32_SBRS= \
+	
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /out:"Debug/de.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:yes\
+ /pdb:"$(OUTDIR)/de.pdb" /debug /machine:I386 /out:"Debug/de.exe" 
+LINK32_OBJS= \
+	".\cord\Debug\cordbscs.obj" \
+	".\cord\Debug\cordxtra.obj" \
+	".\cord\Debug\de.obj" \
+	".\cord\Debug\de_win.obj" \
+	".\cord\Debug\de_win.res" \
+	".\Debug\gc.lib"
+
+".\Debug\de.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ENDIF 
+
+################################################################################
+# Begin Target
+
+# Name "gc - Win32 Release"
+# Name "gc - Win32 Debug"
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+!ENDIF 
+
+################################################################################
+# Begin Source File
+
+SOURCE=.\reclaim.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_RECLA=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_RECLA=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\reclaim.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Release\reclaim.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_RECLA=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_RECLA=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\reclaim.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Debug\reclaim.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\os_dep.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_OS_DE=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\STAT.H"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_OS_DE=\
+	".\il\PCR_IL.h"\
+	".\mm\PCR_MM.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	".\vd\PCR_VD.h"\
+	
+
+".\Release\os_dep.obj" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+".\Release\os_dep.sbr" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_OS_DE=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\STAT.H"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_OS_DE=\
+	".\il\PCR_IL.h"\
+	".\mm\PCR_MM.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	".\vd\PCR_VD.h"\
+	
+
+".\Debug\os_dep.obj" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+".\Debug\os_dep.sbr" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\misc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MISC_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MISC_=\
+	".\il\PCR_IL.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\misc.obj" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+".\Release\misc.sbr" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MISC_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MISC_=\
+	".\il\PCR_IL.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\misc.obj" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+".\Debug\misc.sbr" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mark_rts.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MARK_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MARK_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\mark_rts.obj" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+".\Release\mark_rts.sbr" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MARK_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MARK_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\mark_rts.obj" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+".\Debug\mark_rts.sbr" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mach_dep.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MACH_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MACH_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\mach_dep.obj" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+".\Release\mach_dep.sbr" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MACH_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MACH_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\mach_dep.obj" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+".\Debug\mach_dep.sbr" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\headers.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_HEADE=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_HEADE=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\headers.obj" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+".\Release\headers.sbr" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_HEADE=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_HEADE=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\headers.obj" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+".\Debug\headers.sbr" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\alloc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_ALLOC=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_ALLOC=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\alloc.obj" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+".\Release\alloc.sbr" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_ALLOC=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_ALLOC=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\alloc.obj" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+".\Debug\alloc.sbr" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\allchblk.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_ALLCH=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_ALLCH=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\allchblk.obj" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+".\Release\allchblk.sbr" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_ALLCH=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_ALLCH=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\allchblk.obj" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+".\Debug\allchblk.sbr" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\stubborn.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_STUBB=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_STUBB=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\stubborn.obj" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+".\Release\stubborn.sbr" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_STUBB=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_STUBB=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\stubborn.obj" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+".\Debug\stubborn.sbr" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\obj_map.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_OBJ_M=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_OBJ_M=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\obj_map.obj" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+".\Release\obj_map.sbr" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_OBJ_M=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_OBJ_M=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\obj_map.obj" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+".\Debug\obj_map.sbr" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\new_hblk.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_NEW_H=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_NEW_H=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\new_hblk.obj" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+".\Release\new_hblk.sbr" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_NEW_H=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_NEW_H=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\new_hblk.obj" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+".\Debug\new_hblk.sbr" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mark.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MARK_C=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MARK_C=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\mark.obj" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+".\Release\mark.sbr" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MARK_C=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MARK_C=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\mark.obj" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+".\Debug\mark.sbr" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\malloc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MALLO=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MALLO=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\malloc.obj" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+".\Release\malloc.sbr" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MALLO=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MALLO=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\malloc.obj" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+".\Debug\malloc.sbr" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mallocx.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MALLX=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MALLX=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\mallocx.obj" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+".\Release\mallocx.sbr" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MALLX=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MALLX=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\mallocx.obj" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+".\Debug\mallocx.sbr" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\finalize.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_FINAL=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_FINAL=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\finalize.obj" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+".\Release\finalize.sbr" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_FINAL=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_FINAL=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\finalize.obj" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+".\Debug\finalize.sbr" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\dbg_mlc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_DBG_M=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_DBG_M=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\dbg_mlc.obj" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+".\Release\dbg_mlc.sbr" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_DBG_M=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_DBG_M=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\dbg_mlc.obj" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+".\Debug\dbg_mlc.sbr" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\blacklst.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_BLACK=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_BLACK=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\blacklst.obj" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+".\Release\blacklst.sbr" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_BLACK=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_BLACK=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\blacklst.obj" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+".\Debug\blacklst.sbr" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\typd_mlc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_TYPD_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	".\gc_typed.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_TYPD_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\typd_mlc.obj" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+".\Release\typd_mlc.sbr" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_TYPD_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	".\gc_typed.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_TYPD_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\typd_mlc.obj" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+".\Debug\typd_mlc.sbr" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\ptr_chck.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_PTR_C=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_PTR_C=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\ptr_chck.obj" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+".\Release\ptr_chck.sbr" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_PTR_C=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_PTR_C=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\ptr_chck.obj" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+".\Debug\ptr_chck.sbr" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\dyn_load.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_DYN_L=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\STAT.H"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_DYN_L=\
+	".\il\PCR_IL.h"\
+	".\mm\PCR_MM.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\dyn_load.obj" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+".\Release\dyn_load.sbr" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_DYN_L=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\STAT.H"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_DYN_L=\
+	".\il\PCR_IL.h"\
+	".\mm\PCR_MM.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\dyn_load.obj" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+".\Debug\dyn_load.sbr" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\win32_threads.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_WIN32=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_WIN32=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\win32_threads.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+".\Release\win32_threads.sbr" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_WIN32=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_WIN32=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\win32_threads.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+".\Debug\win32_threads.sbr" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\checksums.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_CHECK=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_CHECK=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\checksums.obj" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+".\Release\checksums.sbr" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_CHECK=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_CHECK=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\checksums.obj" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+".\Debug\checksums.sbr" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+# End Target
+################################################################################
+# Begin Target
+
+# Name "gctest - Win32 Release"
+# Name "gctest - Win32 Debug"
+
+!IF  "$(CFG)" == "gctest - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Debug"
+
+!ENDIF 
+
+################################################################################
+# Begin Project Dependency
+
+# Project_Dep_Name "gc"
+
+!IF  "$(CFG)" == "gctest - Win32 Release"
+
+"gc - Win32 Release" : 
+   $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Release" 
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Debug"
+
+"gc - Win32 Debug" : 
+   $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Debug" 
+
+!ENDIF 
+
+# End Project Dependency
+################################################################################
+# Begin Source File
+
+SOURCE=.\test.c
+DEP_CPP_TEST_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	".\gc_typed.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_TEST_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+!IF  "$(CFG)" == "gctest - Win32 Release"
+
+
+".\gctest\Release\test.obj" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Debug"
+
+
+".\gctest\Debug\test.obj" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+".\gctest\Debug\test.sbr" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+# End Target
+################################################################################
+# Begin Target
+
+# Name "cord - Win32 Release"
+# Name "cord - Win32 Debug"
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+!ENDIF 
+
+################################################################################
+# Begin Project Dependency
+
+# Project_Dep_Name "gc"
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+"gc - Win32 Release" : 
+   $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Release" 
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+"gc - Win32 Debug" : 
+   $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Debug" 
+
+!ENDIF 
+
+# End Project Dependency
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de_win.c
+DEP_CPP_DE_WI=\
+	".\cord\cord.h"\
+	".\cord\de_cmds.h"\
+	".\cord\de_win.h"\
+	".\cord\private\cord_pos.h"\
+	
+NODEP_CPP_DE_WI=\
+	".\cord\gc.h"\
+	
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de_win.obj" : $(SOURCE) $(DEP_CPP_DE_WI) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de_win.obj" : $(SOURCE) $(DEP_CPP_DE_WI) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de.c
+DEP_CPP_DE_C2e=\
+	".\cord\cord.h"\
+	".\cord\de_cmds.h"\
+	".\cord\de_win.h"\
+	".\cord\private\cord_pos.h"\
+	
+NODEP_CPP_DE_C2e=\
+	".\cord\gc.h"\
+	
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de.obj" : $(SOURCE) $(DEP_CPP_DE_C2e) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de.obj" : $(SOURCE) $(DEP_CPP_DE_C2e) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\cordxtra.c
+DEP_CPP_CORDX=\
+	".\cord\cord.h"\
+	".\cord\ec.h"\
+	".\cord\private\cord_pos.h"\
+	
+NODEP_CPP_CORDX=\
+	".\cord\gc.h"\
+	
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\cordxtra.obj" : $(SOURCE) $(DEP_CPP_CORDX) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\cordxtra.obj" : $(SOURCE) $(DEP_CPP_CORDX) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\cordbscs.c
+DEP_CPP_CORDB=\
+	".\cord\cord.h"\
+	".\cord\private\cord_pos.h"\
+	
+NODEP_CPP_CORDB=\
+	".\cord\gc.h"\
+	
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\cordbscs.obj" : $(SOURCE) $(DEP_CPP_CORDB) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\cordbscs.obj" : $(SOURCE) $(DEP_CPP_CORDB) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de_win.RC
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de_win.res" : $(SOURCE) "$(INTDIR)"
+   $(RSC) /l 0x809 /fo"$(INTDIR)/de_win.res" /i "cord" /d "NDEBUG" $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de_win.res" : $(SOURCE) "$(INTDIR)"
+   $(RSC) /l 0x809 /fo"$(INTDIR)/de_win.res" /i "cord" /d "_DEBUG" $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+# End Target
+# End Project
+################################################################################
diff --git a/src/gc/OS2_MAKEFILE b/src/gc/OS2_MAKEFILE
new file mode 100644
index 000000000..7b8162182
--- /dev/null
+++ b/src/gc/OS2_MAKEFILE
@@ -0,0 +1,45 @@
+# Makefile for OS/2.  Assumes IBM's compiler, static linking, and a single thread.
+# Adding dynamic linking support seems easy, but takes a little bit of work.
+# Adding thread support may be nontrivial, since we haven't yet figured out how to
+# look at another thread's registers.
+
+# Significantly revised for GC version 4.4 by Mark Boulter (Jan 1994).
+
+OBJS= alloc.obj reclaim.obj allchblk.obj misc.obj mach_dep.obj os_dep.obj mark_rts.obj headers.obj mark.obj obj_map.obj blacklst.obj finalize.obj new_hblk.obj dbg_mlc.obj malloc.obj stubborn.obj typd_mlc.obj ptr_chck.obj mallocx.obj
+
+CORDOBJS= cord\cordbscs.obj cord\cordxtra.obj cord\cordprnt.obj
+
+CC= icc
+CFLAGS= /O /Q /DSILENT /DSMALL_CONFIG /DALL_INTERIOR_POINTERS
+# Use /Ti instead of /O for debugging
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+
+all: $(OBJS) gctest.exe cord\cordtest.exe
+
+$(OBJS) test.obj: gc_priv.h gc_hdrs.h gc.h
+
+## ERASE THE LIB FIRST - if it is already there then this command will fail
+## (make sure its there or erase will fail!)
+gc.lib: $(OBJS)
+        echo . > gc.lib
+        erase gc.lib
+        LIB gc.lib $(OBJS), gc.lst
+
+mach_dep.obj: mach_dep.c
+        $(CC) $(CFLAGS) /C mach_dep.c
+
+gctest.exe: test.obj gc.lib
+        $(CC) $(CFLAGS) /B"/STACK:524288" /Fegctest test.obj gc.lib
+
+cord\cordbscs.obj: cord\cordbscs.c cord\cord.h cord\private\cord_pos.h
+        $(CC) $(CFLAGS) /C /Focord\cordbscs cord\cordbscs.c
+
+cord\cordxtra.obj: cord\cordxtra.c cord\cord.h cord\private\cord_pos.h cord\ec.h
+        $(CC) $(CFLAGS) /C /Focord\cordxtra cord\cordxtra.c
+
+cord\cordprnt.obj: cord\cordprnt.c cord\cord.h cord\private\cord_pos.h cord\ec.h
+        $(CC) $(CFLAGS) /C /Focord\cordprnt cord\cordprnt.c
+
+cord\cordtest.exe: cord\cordtest.c cord\cord.h cord\private\cord_pos.h cord\ec.h $(CORDOBJS) gc.lib
+        $(CC) $(CFLAGS) /B"/STACK:65536" /Fecord\cordtest cord\cordtest.c gc.lib $(CORDOBJS)
diff --git a/src/gc/PCR-Makefile b/src/gc/PCR-Makefile
new file mode 100644
index 000000000..1eae36725
--- /dev/null
+++ b/src/gc/PCR-Makefile
@@ -0,0 +1,68 @@
+#
+# Default target
+#
+
+default: gc.o
+
+include ../config/common.mk
+
+#
+# compilation flags, etc.
+#
+
+
+CPPFLAGS = $(INCLUDE) $(CONFIG_CPPFLAGS) \
+	-DPCR_NO_RENAME -DPCR_NO_HOSTDEP_ERR
+#CFLAGS	= -DPCR -DSILENT $(CONFIG_CFLAGS)
+CFLAGS	= -DPCR $(CONFIG_CFLAGS)
+SPECIALCFLAGS = 	# For code involving asm's
+
+ASPPFLAGS  = $(INCLUDE) $(CONFIG_ASPPFLAGS) \
+	-DPCR_NO_RENAME -DPCR_NO_HOSTDEP_ERR -DASM
+
+ASFLAGS	= $(CONFIG_ASFLAGS)
+
+LDRFLAGS = $(CONFIG_LDRFLAGS)
+
+LDFLAGS = $(CONFIG_LDFLAGS)
+
+#
+#
+#
+#
+# BEGIN PACKAGE-SPECIFIC PART
+#
+#
+#
+#
+
+# Fix to point to local pcr installation directory.
+PCRDIR= ..
+
+COBJ= alloc.o reclaim.o allchblk.o misc.o os_dep.o mark_rts.o headers.o mark.o obj_map.o pcr_interface.o blacklst.o finalize.o new_hblk.o real_malloc.o dyn_load.o dbg_mlc.o malloc.o stubborn.o checksums.o solaris_threads.o typd_mlc.o ptr_chck.o mallocx.o
+
+CSRC= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dyn_load.c dbg_mlc.c malloc.c stubborn.c checksums.c solaris_threads.c typd_mlc.c ptr_chck.c mallocx.c
+
+SHELL= /bin/sh
+
+default: gc.o
+
+gc.o: $(COBJ) mach_dep.o
+	$(LDR) $(CONFIG_LDRFLAGS) -o gc.o $(COBJ) mach_dep.o
+
+
+mach_dep.o: mach_dep.c mips_mach_dep.s rs6000_mach_dep.s if_mach if_not_there
+	rm -f mach_dep.o
+	./if_mach MIPS "" as -o mach_dep.o mips_mach_dep.s
+	./if_mach RS6000 "" as -o mach_dep.o rs6000_mach_dep.s
+	./if_mach ALPHA "" as -o mach_dep.o alpha_mach_dep.s
+	./if_mach SPARC SUNOS5 as -o mach_dep.o sparc_mach_dep.s
+	./if_not_there mach_dep.o $(CC) -c $(SPECIALCFLAGS) mach_dep.c
+
+if_mach: if_mach.c gcconfig.h
+	$(CC) $(CFLAGS) -o if_mach if_mach.c
+
+if_not_there: if_not_there.c
+	$(CC) $(CFLAGS) -o if_not_there if_not_there.c
+
+
diff --git a/src/gc/README b/src/gc/README
new file mode 100644
index 000000000..8f53a2dc8
--- /dev/null
+++ b/src/gc/README
@@ -0,0 +1,1657 @@
+Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+Copyright (c) 1991-1996 by Xerox Corporation.  All rights reserved.
+Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
+Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+
+Permission is hereby granted to use or copy this program
+for any purpose,  provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is granted,
+provided the above notices are retained, and a notice that the code was
+modified is included with the above copyright notice.
+
+This is version 5.2 of a conservative garbage collector for C and C++.
+
+You might find a more recent version of this at
+
+http://www.hpl.hp.com/personal/Hans_Boehm/gc
+
+HISTORY -
+
+  Early versions of this collector were developed as a part of research
+projects supported in part by the National Science Foundation
+and the Defense Advance Research Projects Agency.
+Much of the code was rewritten by Hans-J. Boehm (boehm@acm.org) at Xerox PARC,
+SGI, and HP Labs.
+
+Some other contributors:  
+
+More recent contributors are mentioned in the modification history at the
+end of this file.  My apologies for any omissions.
+
+The SPARC specific code was contributed by Mark Weiser
+(weiser@parc.xerox.com).  The Encore Multimax modifications were supplied by
+Kevin Kenny (kenny@m.cs.uiuc.edu).  The adaptation to the RT is largely due
+to Vernon Lee (scorpion@rice.edu), on machines made available by IBM.
+Much of the HP specific code and a number of good suggestions for improving the
+generic code are due to Walter Underwood (wunder@hp-ses.sde.hp.com).
+Robert Brazile (brazile@diamond.bbn.com) originally supplied the ULTRIX code.
+Al Dosser (dosser@src.dec.com) and Regis Cridlig (Regis.Cridlig@cl.cam.ac.uk)
+subsequently provided updates and information on variation between ULTRIX
+systems.  Parag Patel (parag@netcom.com) supplied the A/UX code.
+Jesper Peterson(jep@mtiame.mtia.oz.au), Michel Schinz, and
+Martin Tauchmann (martintauchmann@bigfoot.com) supplied the Amiga port.
+Thomas Funke (thf@zelator.in-berlin.de(?)) and
+Brian D.Carlstrom (bdc@clark.lcs.mit.edu) supplied the NeXT ports.
+Douglas Steel (doug@wg.icl.co.uk) provided ICL DRS6000 code.
+Bill Janssen (janssen@parc.xerox.com) supplied the SunOS dynamic loader
+specific code. Manuel Serrano (serrano@cornas.inria.fr) supplied linux and
+Sony News specific code.  Al Dosser provided Alpha/OSF/1 code.  He and
+Dave Detlefs(detlefs@src.dec.com) also provided several generic bug fixes.
+Alistair G. Crooks(agc@uts.amdahl.com) supplied the NetBSD and 386BSD ports.
+Jeffrey Hsu (hsu@soda.berkeley.edu) provided the FreeBSD port.
+Brent Benson (brent@jade.ssd.csd.harris.com) ported the collector to
+a Motorola 88K processor running CX/UX (Harris NightHawk).
+Ari Huttunen (Ari.Huttunen@hut.fi) generalized the OS/2 port to
+nonIBM development environments (a nontrivial task).
+Patrick Beard (beard@cs.ucdavis.edu) provided the initial MacOS port.
+David Chase, then at Olivetti Research, suggested several improvements.
+Scott Schwartz (schwartz@groucho.cse.psu.edu) supplied some of the
+code to save and print call stacks for leak detection on a SPARC.
+Jesse Hull and John Ellis supplied the C++ interface code.
+Zhong Shao performed much of the experimentation that led to the
+current typed allocation facility.  (His dynamic type inference code hasn't
+made it into the released version of the collector, yet.)
+(Blame for misinstallation of these modifications goes to the first author,
+however.)
+
+OVERVIEW
+
+    This is intended to be a general purpose, garbage collecting storage
+allocator.  The algorithms used are described in:
+
+Boehm, H., and M. Weiser, "Garbage Collection in an Uncooperative Environment",
+Software Practice & Experience, September 1988, pp. 807-820.
+
+Boehm, H., A. Demers, and S. Shenker, "Mostly Parallel Garbage Collection",
+Proceedings of the ACM SIGPLAN '91 Conference on Programming Language Design
+and Implementation, SIGPLAN Notices 26, 6 (June 1991), pp. 157-164.
+
+Boehm, H., "Space Efficient Conservative Garbage Collection", Proceedings
+of the ACM SIGPLAN '91 Conference on Programming Language Design and
+Implementation, SIGPLAN Notices 28, 6 (June 1993), pp. 197-206.
+
+  Possible interactions between the collector and optimizing compilers are
+discussed in
+
+Boehm, H., and D. Chase, "A Proposal for GC-safe C Compilation",
+The Journal of C Language Translation 4, 2 (December 1992).
+
+and
+
+Boehm H., "Simple GC-safe Compilation", Proceedings
+of the ACM SIGPLAN '96 Conference on Programming Language Design and
+Implementation.
+
+(Both are also available from
+http://reality.sgi.com/boehm/papers/, among other places.)
+
+  Unlike the collector described in the second reference, this collector
+operates either with the mutator stopped during the entire collection
+(default) or incrementally during allocations.  (The latter is supported
+on only a few machines.)  It does not rely on threads, but is intended
+to be thread-safe.
+
+  Some of the ideas underlying the collector have previously been explored
+by others.  (Doug McIlroy wrote a vaguely similar collector that is part of
+version 8 UNIX (tm).)  However none of this work appears to have been widely
+disseminated.
+
+  Rudimentary tools for use of the collector as a leak detector are included, as
+is a fairly sophisticated string package "cord" that makes use of the collector.
+(See cord/README.)
+
+
+GENERAL DESCRIPTION
+
+  This is a garbage collecting storage allocator that is intended to be
+used as a plug-in replacement for C's malloc.
+
+  Since the collector does not require pointers to be tagged, it does not
+attempt to ensure that all inaccessible storage is reclaimed.  However,
+in our experience, it is typically more successful at reclaiming unused
+memory than most C programs using explicit deallocation.  Unlike manually
+introduced leaks, the amount of unreclaimed memory typically stays
+bounded.
+
+  In the following, an "object" is defined to be a region of memory allocated
+by the routines described below.  
+
+  Any objects not intended to be collected must be pointed to either
+from other such accessible objects, or from the registers,
+stack, data, or statically allocated bss segments.  Pointers from
+the stack or registers may point to anywhere inside an object.
+The same is true for heap pointers if the collector is compiled with
+ ALL_INTERIOR_POINTERS defined, as is now the default.
+
+Compiling without ALL_INTERIOR_POINTERS may reduce accidental retention
+of garbage objects, by requiring pointers from the heap to to the beginning
+of an object.  But this no longer appears to be a significant
+issue for most programs.
+
+There are a number of routines which modify the pointer recognition
+algorithm.  GC_register_displacement allows certain interior pointers
+to be recognized even if ALL_INTERIOR_POINTERS is nor defined.
+GC_malloc_ignore_off_page allows some pointers into the middle of large objects
+to be disregarded, greatly reducing the probablility of accidental
+retention of large objects.  For most purposes it seems best to compile
+with ALL_INTERIOR_POINTERS and to use GC_malloc_ignore_off_page if
+you get collector warnings from allocations of very large objects.
+See README.debugging for details.
+
+  Note that pointers inside memory allocated by the standard "malloc" are not
+seen by the garbage collector.  Thus objects pointed to only from such a
+region may be prematurely deallocated.  It is thus suggested that the
+standard "malloc" be used only for memory regions, such as I/O buffers, that
+are guaranteed not to contain pointers to garbage collectable memory.
+Pointers in C language automatic, static, or register variables,
+are correctly recognized.  (Note that GC_malloc_uncollectable has semantics
+similar to standard malloc, but allocates objects that are traced by the
+collector.)
+
+  The collector does not always know how to find pointers in data
+areas that are associated with dynamic libraries.  This is easy to
+remedy IF you know how to find those data areas on your operating
+system (see GC_add_roots).  Code for doing this under SunOS, IRIX 5.X and 6.X,
+HP/UX, Alpha OSF/1, Linux, and win32 is included and used by default.  (See
+README.win32 for win32 details.)  On other systems pointers from dynamic
+library data areas may not be considered by the collector.
+
+  Note that the garbage collector does not need to be informed of shared
+read-only data.  However if the shared library mechanism can introduce
+discontiguous data areas that may contain pointers, then the collector does
+need to be informed.
+
+  Signal processing for most signals may be deferred during collection,
+and during uninterruptible parts of the allocation process.  Unlike
+standard ANSI C mallocs, it can be safe to invoke malloc
+from a signal handler while another malloc is in progress, provided
+the original malloc is not restarted.  (Empirically, many UNIX
+applications already assume this.)  To obtain this level  of signal
+safety, remove the definition of -DNO_SIGNALS in Makefile.  This incurs
+a minor performance penalty, and hence is no longer the default.
+
+  The allocator/collector can also be configured for thread-safe operation.
+(Full signal safety can also be achieved, but only at the cost of two system
+calls per malloc, which is usually unacceptable.)
+
+INSTALLATION AND PORTABILITY
+
+  As distributed, the macro SILENT is defined in Makefile.
+In the event of problems, this can be removed to obtain a moderate
+amount of descriptive output for each collection.
+(The given statistics exhibit a few peculiarities.
+Things don't appear to add up for a variety of reasons, most notably
+fragmentation losses.  These are probably much more significant for the
+contrived program "test.c" than for your application.)
+
+  Note that typing "make test" will automatically build the collector
+and then run setjmp_test and gctest. Setjmp_test will give you information
+about configuring the collector, which is useful primarily if you have
+a machine that's not already supported.  Gctest is a somewhat superficial
+test of collector functionality.  Failure is indicated by a core dump or
+a message to the effect that the collector is broken.  Gctest takes about 
+35 seconds to run on a SPARCstation 2. On a slower machine,
+expect it to take a while.  It may use up to 8 MB of memory.  (The
+multi-threaded version will use more.)  "Make test" will also, as
+its last step, attempt to build and test the "cord" string library.
+This will fail without an ANSI C compiler.
+
+  The Makefile will generate a library gc.a which you should link against.
+Typing "make cords" will add the cord library to gc.a.
+Note that this requires an ANSI C compiler.
+
+  It is suggested that if you need to replace a piece of the collector
+(e.g. GC_mark_rts.c) you simply list your version ahead of gc.a on the
+		work.)
+ld command line, rather than replacing the one in gc.a.  (This will
+generate numerous warnings under some versions of AIX, but it still
+works.)
+
+  All include files that need to be used by clients will be put in the
+include subdirectory.  (Normally this is just gc.h.  "Make cords" adds
+"cord.h" and "ec.h".)
+
+  The collector currently is designed to run essentially unmodified on
+machines that use a flat 32-bit or 64-bit address space.
+That includes the vast majority of Workstations and X86 (X >= 3) PCs.
+(The list here was deleted because it was getting too long and constantly
+out of date.)
+  It does NOT run under plain 16-bit DOS or Windows 3.X.  There are however
+various packages (e.g. win32s, djgpp) that allow flat 32-bit address
+applications to run under those systemsif the have at least an 80386 processor,
+and several of those are compatible with the collector.
+
+  In a few cases (Amiga, OS/2, Win32, MacOS) a separate makefile
+or equivalent is supplied.  Many of these have separate README.system
+files.
+
+  Dynamic libraries are completely supported only under SunOS
+(and even that support is not functional on the last Sun 3 release),
+IRIX 5&6, HP-PA, Win32 (not Win32S) and OSF/1 on DEC AXP machines.
+On other machines we recommend that you do one of the following:
+
+  1) Add dynamic library support (and send us the code).
+  2) Use static versions of the libraries.
+  3) Arrange for dynamic libraries to use the standard malloc.
+     This is still dangerous if the library stores a pointer to a
+     garbage collected object.  But nearly all standard interfaces
+     prohibit this, because they deal correctly with pointers
+     to stack allocated objects.  (Strtok is an exception.  Don't
+     use it.)
+
+  In all cases we assume that pointer alignment is consistent with that
+enforced by the standard C compilers.  If you use a nonstandard compiler
+you may have to adjust the alignment parameters defined in gc_priv.h.
+
+  A port to a machine that is not byte addressed, or does not use 32 bit
+or 64 bit addresses will require a major effort.  A port to plain MSDOS
+or win16 is hard.
+
+  For machines not already mentioned, or for nonstandard compilers, the
+following are likely to require change:
+
+1.  The parameters in gcconfig.h.
+      The parameters that will usually require adjustment are
+   STACKBOTTOM,  ALIGNMENT and DATASTART.  Setjmp_test
+   prints its guesses of the first two.
+      DATASTART should be an expression for computing the
+   address of the beginning of the data segment.  This can often be
+   &etext.  But some memory management units require that there be
+   some unmapped space between the text and the data segment.  Thus
+   it may be more complicated.   On UNIX systems, this is rarely
+   documented.  But the adb "$m" command may be helpful.  (Note
+   that DATASTART will usually be a function of &etext.  Thus a
+   single experiment is usually insufficient.)
+     STACKBOTTOM is used to initialize GC_stackbottom, which
+   should be a sufficient approximation to the coldest stack address.
+   On some machines, it is difficult to obtain such a value that is
+   valid across a variety of MMUs, OS releases, etc.  A number of
+   alternatives exist for using the collector in spite of this.  See the
+   discussion in gcconfig.h immediately preceding the various
+   definitions of STACKBOTTOM.
+   
+2.  mach_dep.c.
+      The most important routine here is one to mark from registers.
+    The distributed file includes a generic hack (based on setjmp) that
+    happens to work on many machines, and may work on yours.  Try
+    compiling and running setjmp_t.c to see whether it has a chance of
+    working.  (This is not correct C, so don't blame your compiler if it
+    doesn't work.  Based on limited experience, register window machines
+    are likely to cause trouble.  If your version of setjmp claims that
+    all accessible variables, including registers, have the value they
+    had at the time of the longjmp, it also will not work.  Vanilla 4.2 BSD
+    on Vaxen makes such a claim.  SunOS does not.)
+      If your compiler does not allow in-line assembly code, or if you prefer
+    not to use such a facility, mach_dep.c may be replaced by a .s file
+    (as we did for the MIPS machine and the PC/RT).
+      At this point enough architectures are supported by mach_dep.c
+    that you will rarely need to do more than adjust for assembler
+    syntax.
+
+3.  os_dep.c (and gc_priv.h).
+  	  Several kinds of operating system dependent routines reside here.
+  	Many are optional.  Several are invoked only through corresponding
+  	macros in gc_priv.h, which may also be redefined as appropriate.
+      The routine GC_register_data_segments is crucial.  It registers static
+    data areas that must be traversed by the collector. (User calls to
+    GC_add_roots may sometimes be used for similar effect.)
+      Routines to obtain memory from the OS also reside here.
+    Alternatively this can be done entirely by the macro GET_MEM
+    defined in gc_priv.h.  Routines to disable and reenable signals
+    also reside here if they are need by the macros DISABLE_SIGNALS
+    and ENABLE_SIGNALS defined in gc_priv.h.
+      In a multithreaded environment, the macros LOCK and UNLOCK
+    in gc_priv.h will need to be suitably redefined.
+      The incremental collector requires page dirty information, which
+    is acquired through routines defined in os_dep.c.  Unless directed
+    otherwise by gcconfig.h, these are implemented as stubs that simply
+    treat all pages as dirty.  (This of course makes the incremental
+    collector much less useful.)
+
+4.  dyn_load.c
+	This provides a routine that allows the collector to scan data
+	segments associated with dynamic libraries.  Often it is not
+	necessary to provide this routine unless user-written dynamic
+	libraries are used.
+
+  For a different version of UN*X or different machines using the
+Motorola 68000, Vax, SPARC, 80386, NS 32000, PC/RT, or MIPS architecture,
+it should frequently suffice to change definitions in gcconfig.h.
+
+
+THE C INTERFACE TO THE ALLOCATOR
+
+  The following routines are intended to be directly called by the user.
+Note that usually only GC_malloc is necessary.  GC_clear_roots and GC_add_roots
+calls may be required if the collector has to trace from nonstandard places
+(e.g. from dynamic library data areas on a machine on which the 
+collector doesn't already understand them.)  On some machines, it may
+be desirable to set GC_stacktop to a good approximation of the stack base. 
+(This enhances code portability on HP PA machines, since there is no
+good way for the collector to compute this value.)  Client code may include
+"gc.h", which defines all of the following, plus many others.
+
+1)  GC_malloc(nbytes)
+    - allocate an object of size nbytes.  Unlike malloc, the object is
+      cleared before being returned to the user.  Gc_malloc will
+      invoke the garbage collector when it determines this to be appropriate.
+      GC_malloc may return 0 if it is unable to acquire sufficient
+      space from the operating system.  This is the most probable
+      consequence of running out of space.  Other possible consequences
+      are that a function call will fail due to lack of stack space,
+      or that the collector will fail in other ways because it cannot
+      maintain its internal data structures, or that a crucial system
+      process will fail and take down the machine.  Most of these
+      possibilities are independent of the malloc implementation.
+
+2)  GC_malloc_atomic(nbytes)
+    - allocate an object of size nbytes that is guaranteed not to contain any
+      pointers.  The returned object is not guaranteed to be cleared.
+      (Can always be replaced by GC_malloc, but results in faster collection
+      times.  The collector will probably run faster if large character
+      arrays, etc. are allocated with GC_malloc_atomic than if they are
+      statically allocated.)
+
+3)  GC_realloc(object, new_size)
+    - change the size of object to be new_size.  Returns a pointer to the
+      new object, which may, or may not, be the same as the pointer to
+      the old object.  The new object is taken to be atomic iff the old one
+      was.  If the new object is composite and larger than the original object,
+      then the newly added bytes are cleared (we hope).  This is very likely
+      to allocate a new object, unless MERGE_SIZES is defined in gc_priv.h.
+      Even then, it is likely to recycle the old object only if the object
+      is grown in small additive increments (which, we claim, is generally bad
+      coding practice.)
+
+4)  GC_free(object)
+    - explicitly deallocate an object returned by GC_malloc or
+      GC_malloc_atomic.  Not necessary, but can be used to minimize
+      collections if performance is critical.  Probably a performance
+      loss for very small objects (<= 8 bytes).
+
+5)  GC_expand_hp(bytes)
+    - Explicitly increase the heap size.  (This is normally done automatically
+      if a garbage collection failed to GC_reclaim enough memory.  Explicit
+      calls to GC_expand_hp may prevent unnecessarily frequent collections at
+      program startup.)
+
+6)  GC_malloc_ignore_off_page(bytes)
+	- identical to GC_malloc, but the client promises to keep a pointer to
+	  the somewhere within the first 256 bytes of the object while it is
+	  live.  (This pointer should nortmally be declared volatile to prevent
+	  interference from compiler optimizations.)  This is the recommended
+	  way to allocate anything that is likely to be larger than 100Kbytes
+	  or so.  (GC_malloc may result in failure to reclaim such objects.)
+
+7)  GC_set_warn_proc(proc)
+	- Can be used to redirect warnings from the collector.  Such warnings
+	  should be rare, and should not be ignored during code development.
+      
+8) GC_enable_incremental()
+    - Enables generational and incremental collection.  Useful for large
+      heaps on machines that provide access to page dirty information.
+      Some dirty bit implementations may interfere with debugging
+      (by catching address faults) and place restrictions on heap arguments
+      to system calls (since write faults inside a system call may not be
+      handled well).
+
+9) Several routines to allow for registration of finalization code.
+   User supplied finalization code may be invoked when an object becomes
+   unreachable.  To call (*f)(obj, x) when obj becomes inaccessible, use
+	GC_register_finalizer(obj, f, x, 0, 0);
+   For more sophisticated uses, and for finalization ordering issues,
+   see gc.h.
+
+  The global variable GC_free_space_divisor may be adjusted up from its
+default value of 4 to use less space and more collection time, or down for
+the opposite effect.  Setting it to 1 or 0 will effectively disable collections
+and cause all allocations to simply grow the heap.
+
+  The variable GC_non_gc_bytes, which is normally 0, may be changed to reflect
+the amount of memory allocated by the above routines that should not be
+considered as a candidate for collection.  Careless use may, of course, result
+in excessive memory consumption.
+
+  Some additional tuning is possible through the parameters defined
+near the top of gc_priv.h.
+  
+  If only GC_malloc is intended to be used, it might be appropriate to define:
+
+#define malloc(n) GC_malloc(n)
+#define calloc(m,n) GC_malloc((m)*(n))
+
+  For small pieces of VERY allocation intensive code, gc_inl.h
+includes some allocation macros that may be used in place of GC_malloc
+and friends.
+
+  All externally visible names in the garbage collector start with "GC_".
+To avoid name conflicts, client code should avoid this prefix, except when
+accessing garbage collector routines or variables.
+
+  There are provisions for allocation with explicit type information.
+This is rarely necessary.  Details can be found in gc_typed.h.
+
+THE C++ INTERFACE TO THE ALLOCATOR:
+
+  The Ellis-Hull C++ interface to the collector is included in
+the collector distribution.  If you intend to use this, type
+"make c++" after the initial build of the collector is complete.
+See gc_cpp.h for the definition of the interface.  This interface
+tries to approximate the Ellis-Detlefs C++ garbage collection
+proposal without compiler changes.
+
+Cautions:
+1. Arrays allocated without new placement syntax are
+allocated as uncollectable objects.  They are traced by the
+collector, but will not be reclaimed.
+
+2. Failure to use "make c++" in combination with (1) will
+result in arrays allocated using the default new operator.
+This is likely to result in disaster without linker warnings.
+
+3. If your compiler supports an overloaded new[] operator,
+then gc_cpp.cc and gc_cpp.h should be suitably modified.
+
+4. Many current C++ compilers have deficiencies that
+break some of the functionality.  See the comments in gc_cpp.h
+for suggested workarounds.
+
+USE AS LEAK DETECTOR:
+
+  The collector may be used to track down leaks in C programs that are
+intended to run with malloc/free (e.g. code with extreme real-time or
+portability constraints).  To do so define FIND_LEAK in Makefile
+This will cause the collector to invoke the report_leak
+routine defined near the top of reclaim.c whenever an inaccessible
+object is found that has not been explicitly freed.  The collector will
+no longer reclaim inaccessible memory; in this form it is purely a
+debugging tool.
+  Productive use of this facility normally involves redefining report_leak
+to do something more intelligent.  This typically requires annotating
+objects with additional information (e.g. creation time stack trace) that
+identifies their origin.  Such code is typically not very portable, and is
+not included here, except on SPARC machines.
+  If all objects are allocated with GC_DEBUG_MALLOC (see next section),
+then the default version of report_leak will report the source file
+and line number at which the leaked object was allocated.  This may
+sometimes be sufficient.  (On SPARC/SUNOS4 machines, it will also report
+a cryptic stack trace.  This can often be turned into a sympolic stack
+trace by invoking program "foo" with "callprocs foo".  Callprocs is
+a short shell script that invokes adb to expand program counter values
+to symbolic addresses.  It was largely supplied by Scott Schwartz.)
+  Note that the debugging facilities described in the next section can
+sometimes be slightly LESS effective in leak finding mode, since in
+leak finding mode, GC_debug_free actually results in reuse of the object.
+(Otherwise the object is simply marked invalid.)  Also note that the test
+program is not designed to run meaningfully in FIND_LEAK mode.
+Use "make gc.a" to build the collector.
+
+DEBUGGING FACILITIES:
+
+  The routines GC_debug_malloc, GC_debug_malloc_atomic, GC_debug_realloc,
+and GC_debug_free provide an alternate interface to the collector, which
+provides some help with memory overwrite errors, and the like.
+Objects allocated in this way are annotated with additional
+information.  Some of this information is checked during garbage
+collections, and detected inconsistencies are reported to stderr.
+
+  Simple cases of writing past the end of an allocated object should
+be caught if the object is explicitly deallocated, or if the
+collector is invoked while the object is live.  The first deallocation
+of an object will clear the debugging info associated with an
+object, so accidentally repeated calls to GC_debug_free will report the
+deallocation of an object without debugging information.  Out of
+memory errors will be reported to stderr, in addition to returning
+NIL.
+
+  GC_debug_malloc checking  during garbage collection is enabled
+with the first call to GC_debug_malloc.  This will result in some
+slowdown during collections.  If frequent heap checks are desired,
+this can be achieved by explicitly invoking GC_gcollect, e.g. from
+the debugger.
+
+  GC_debug_malloc allocated objects should not be passed to GC_realloc
+or GC_free, and conversely.  It is however acceptable to allocate only
+some objects with GC_debug_malloc, and to use GC_malloc for other objects,
+provided the two pools are kept distinct.  In this case, there is a very
+low probablility that GC_malloc allocated objects may be misidentified as
+having been overwritten.  This should happen with probability at most
+one in 2**32.  This probability is zero if GC_debug_malloc is never called.
+
+  GC_debug_malloc, GC_malloc_atomic, and GC_debug_realloc take two
+additional trailing arguments, a string and an integer.  These are not
+interpreted by the allocator.  They are stored in the object (the string is
+not copied).  If an error involving the object is detected, they are printed.
+
+  The macros GC_MALLOC, GC_MALLOC_ATOMIC, GC_REALLOC, GC_FREE, and
+GC_REGISTER_FINALIZER are also provided.  These require the same arguments
+as the corresponding (nondebugging) routines.  If gc.h is included
+with GC_DEBUG defined, they call the debugging versions of these
+functions, passing the current file name and line number as the two
+extra arguments, where appropriate.  If gc.h is included without GC_DEBUG
+defined, then all these macros will instead be defined to their nondebugging
+equivalents.  (GC_REGISTER_FINALIZER is necessary, since pointers to
+objects with debugging information are really pointers to a displacement
+of 16 bytes form the object beginning, and some translation is necessary
+when finalization routines are invoked.  For details, about what's stored
+in the header, see the definition of the type oh in debug_malloc.c)
+
+INCREMENTAL/GENERATIONAL COLLECTION:
+
+The collector normally interrupts client code for the duration of 
+a garbage collection mark phase.  This may be unacceptable if interactive
+response is needed for programs with large heaps.  The collector
+can also run in a "generational" mode, in which it usually attempts to
+collect only objects allocated since the last garbage collection.
+Furthermore, in this mode, garbage collections run mostly incrementally,
+with a small amount of work performed in response to each of a large number of
+GC_malloc requests.
+
+This mode is enabled by a call to GC_enable_incremental().
+
+Incremental and generational collection is effective in reducing
+pause times only if the collector has some way to tell which objects
+or pages have been recently modified.  The collector uses two sources
+of information:
+
+1. Information provided by the VM system.  This may be provided in
+one of several forms.  Under Solaris 2.X (and potentially under other
+similar systems) information on dirty pages can be read from the
+/proc file system.  Under other systems (currently SunOS4.X) it is
+possible to write-protect the heap, and catch the resulting faults.
+On these systems we require that system calls writing to the heap
+(other than read) be handled specially by client code.
+See os_dep.c for details.
+
+2. Information supplied by the programmer.  We define "stubborn"
+objects to be objects that are rarely changed.  Such an object
+can be allocated (and enabled for writing) with GC_malloc_stubborn.
+Once it has been initialized, the collector should be informed with
+a call to GC_end_stubborn_change.  Subsequent writes that store
+pointers into the object must be preceded by a call to
+GC_change_stubborn.
+
+This mechanism performs best for objects that are written only for
+initialization, and such that only one stubborn object is writable
+at once.  It is typically not worth using for short-lived
+objects.  Stubborn objects are treated less efficiently than pointerfree
+(atomic) objects.
+
+A rough rule of thumb is that, in the absence of VM information, garbage
+collection pauses are proportional to the amount of pointerful storage
+plus the amount of modified "stubborn" storage that is reachable during
+the collection.  
+
+Initial allocation of stubborn objects takes longer than allocation
+of other objects, since other data structures need to be maintained.
+
+We recommend against random use of stubborn objects in client
+code, since bugs caused by inappropriate writes to stubborn objects
+are likely to be very infrequently observed and hard to trace.  
+However, their use may be appropriate in a few carefully written
+library routines that do not make the objects themselves available
+for writing by client code.
+
+
+BUGS:
+
+  Any memory that does not have a recognizable pointer to it will be
+reclaimed.  Exclusive-or'ing forward and backward links in a list
+doesn't cut it.
+  Some C optimizers may lose the last undisguised pointer to a memory
+object as a consequence of clever optimizations.  This has almost
+never been observed in practice.  Send mail to boehm@acm.org
+for suggestions on how to fix your compiler.
+  This is not a real-time collector.  In the standard configuration,
+percentage of time required for collection should be constant across
+heap sizes.  But collection pauses will increase for larger heaps.
+(On SPARCstation 2s collection times will be on the order of 300 msecs
+per MB of accessible memory that needs to be scanned.  Your mileage
+may vary.)  The incremental/generational collection facility helps,
+but is portable only if "stubborn" allocation is used.
+  Please address bug reports to boehm@acm.org.  If you are
+contemplating a major addition, you might also send mail to ask whether
+it's already been done (or whether we tried and discarded it).
+
+RECENT VERSIONS:
+
+  Version 1.3 and immediately preceding versions contained spurious
+assembly language assignments to TMP_SP.  Only the assignment in the PC/RT
+code is necessary.  On other machines, with certain compiler options,
+the assignments can lead to an unsaved register being overwritten.
+Known to cause problems under SunOS 3.5 WITHOUT the -O option.  (With
+-O the compiler recognizes it as dead code.  It probably shouldn't,
+but that's another story.)
+
+  Version 1.4 and earlier versions used compile time determined values
+for the stack base.  This no longer works on Sun 3s, since Sun 3/80s use
+a different stack base.  We now use a straightforward heuristic on all
+machines on which it is known to work (incl. Sun 3s) and compile-time
+determined values for the rest.  There should really be library calls
+to determine such values.
+
+  Version 1.5 and earlier did not ensure 8 byte alignment for objects
+allocated on a sparc based machine.
+
+  Version 1.8 added ULTRIX support in gc_private.h.
+  
+  Version 1.9 fixed a major bug in gc_realloc.
+  
+  Version 2.0 introduced a consistent naming convention for collector
+routines and added support for registering dynamic library data segments
+in the standard mark_roots.c.  Most of the data structures were revamped.
+The treatment of interior pointers was completely changed.  Finalization
+was added.  Support for locking was added.  Object kinds were added.
+We added a black listing facility to avoid allocating at addresses known
+to occur as integers somewhere in the address space.  Much of this
+was accomplished by adapting ideas and code from the PCR collector.
+The test program was changed and expanded.
+
+  Version 2.1 was the first stable version since 1.9, and added support
+for PPCR.
+
+  Version 2.2 added debugging allocation, and fixed various bugs.  Among them:
+- GC_realloc could fail to extend the size of the object for certain large object sizes.
+- A blatant subscript range error in GC_printf, which unfortunately
+  wasn't exercised on machines with sufficient stack alignment constraints.
+- GC_register_displacement did the wrong thing if it was called after
+  any allocation had taken place.
+- The leak finding code would eventually break after 2048 byte
+  byte objects leaked.
+- interface.c didn't compile.
+- The heap size remained much too small for large stacks.
+- The stack clearing code behaved badly for large stacks, and perhaps
+  on HP/PA machines.
+
+  Version 2.3 added ALL_INTERIOR_POINTERS and fixed the following bugs:
+- Missing declaration of etext in the A/UX version.
+- Some PCR root-finding problems.
+- Blacklisting was not 100% effective, because the plausible future
+  heap bounds were being miscalculated.
+- GC_realloc didn't handle out-of-memory correctly.
+- GC_base could return a nonzero value for addresses inside free blocks.
+- test.c wasn't really thread safe, and could erroneously report failure
+  in a multithreaded environment.  (The locking primitives need to be
+  replaced for other threads packages.)
+- GC_CONS was thoroughly broken.
+- On a SPARC with dynamic linking, signals stayed diabled while the
+  client code was running.
+  (Thanks to Manuel Serrano at INRIA for reporting the last two.)
+  
+  Version 2.4 added GC_free_space_divisor as a tuning knob, added
+  support for OS/2 and linux, and fixed the following bugs:
+- On machines with unaligned pointers (e.g. Sun 3), every 128th word could
+  fail to be considered for marking.
+- Dynamic_load.c erroneously added 4 bytes to the length of the data and
+  bss sections of the dynamic library.  This could result in a bad memory
+  reference if the actual length was a multiple of a page.  (Observed on
+  Sun 3.  Can probably also happen on a Sun 4.)
+  (Thanks to Robert Brazile for pointing out that the Sun 3 version
+  was broken.  Dynamic library handling is still broken on Sun 3s
+  under 4.1.1U1, but apparently not 4.1.1.  If you have such a machine,
+  use -Bstatic.)
+  
+  Version 2.5 fixed the following bugs:
+- Removed an explicit call to exit(1)
+- Fixed calls to GC_printf and GC_err_printf, so the correct number of
+  arguments are always supplied.  The OS/2 C compiler gets confused if
+  the number of actuals and the number of formals differ.  (ANSI C
+  doesn't require this to work.  The ANSI sanctioned way of doing things
+  causes too many compatibility problems.)
+  
+  Version 3.0  added generational/incremental collection and stubborn
+  objects.
+
+  Version 3.1 added the following features:
+- A workaround for a SunOS 4.X SPARC C compiler
+  misfeature that caused problems when the collector was turned into
+  a dynamic library.  
+- A fix for a bug in GC_base that could result in a memory fault.
+- A fix for a performance bug (and several other misfeatures) pointed
+  out by Dave Detlefs and Al Dosser.
+- Use of dirty bit information for static data under Solaris 2.X.
+- DEC Alpha/OSF1 support (thanks to Al Dosser).
+- Incremental collection on more platforms.
+- A more refined heap expansion policy.  Less space usage by default.
+- Various minor enhancements to reduce space usage, and to reduce
+  the amount of memory scanned by the collector.
+- Uncollectable allocation without per object overhead.
+- More conscientious handling of out-of-memory conditions.
+- Fixed a bug in debugging stubborn allocation.
+- Fixed a bug that resulted in occasional erroneous reporting of smashed
+  objects with debugging allocation.
+- Fixed bogus leak reports of size 4096 blocks with FIND_LEAK.
+
+  Version 3.2 fixed a serious and not entirely repeatable bug in
+  the incremental collector.  It appeared only when dirty bit info
+  on the roots was available, which is normally only under Solaris.
+  It also added GC_general_register_disappearing_link, and some
+  testing code.  Interface.c disappeared.
+
+  Version 3.3 fixes several bugs and adds new ports:
+- PCR-specific bugs.
+- Missing locking in GC_free, redundant FASTUNLOCK
+  in GC_malloc_stubborn, and 2 bugs in
+  GC_unregister_disappearing_link.
+  All of the above were pointed out by Neil Sharman
+  (neil@cs.mu.oz.au).
+- Common symbols allocated by the SunOS4.X dynamic loader
+  were not included in the root set.
+- Bug in GC_finalize (reported by Brian Beuning and Al Dosser)
+- Merged Amiga port from Jesper Peterson (untested)
+- Merged NeXT port from Thomas Funke (significantly
+  modified and untested)
+
+  Version 3.4:
+- Fixed a performance bug in GC_realloc.
+- Updated the amiga port.
+- Added NetBSD and 386BSD ports.
+- Added cord library.
+- Added trivial performance enhancement for
+  ALL_INTERIOR_POINTERS.  (Don't scan last word.)
+  
+  Version 3.5
+- Minor collections now mark from roots only once, if that
+  doesn't cause an excessive pause.
+- The stack clearing heuristic was refined to prevent anomalies
+  with very heavily recursive programs and sparse stacks.
+- Fixed a bug that prevented mark stack growth in some cases.
+  GC_objects_are_marked should be set to TRUE after a call
+  to GC_push_roots and as part of GC_push_marked, since
+  both can now set mark bits.  I think this is only a performance
+  bug, but I wouldn't bet on it.  It's certainly very hard to argue
+  that the old version was correct.
+- Fixed an incremental collection bug that prevented it from
+  working at all when HBLKSIZE != getpagesize()
+- Changed dynamic_loading.c to include gc_priv.h before testing
+  DYNAMIC_LOADING.  SunOS dynamic library scanning
+  must have been broken in 3.4.
+- Object size rounding now adapts to program behavior.
+- Added a workaround (provided by Manuel Serrano and
+  colleagues) to a long-standing SunOS 4.X (and 3.X?) ld bug
+  that I had incorrectly assumed to have been squished.
+  The collector was broken if the text segment size was within
+  32 bytes of a multiple of 8K bytes, and if the beginning of
+  the data segment contained interesting roots.  The workaround
+  assumes a demand-loadable executable.  The original may have
+  have "worked" in some other cases.
+- Added dynamic library support under IRIX5.
+- Added support for EMX under OS/2 (thanks to Ari Huttunen).
+  
+Version 3.6:
+- fixed a bug in the mark stack growth code that was introduced
+  in 3.4.
+- fixed Makefile to work around DEC AXP compiler tail recursion
+  bug.
+
+Version 3.7:
+- Added a workaround for an HP/UX compiler bug.
+- Fixed another stack clearing performance bug.  Reworked
+  that code once more.
+  
+Version 4.0:
+- Added support for Solaris threads (which was possible
+  only by reimplementing some fraction of Solaris threads,
+  since Sun doesn't currently make the thread debugging
+  interface available).
+- Added non-threads win32 and win32S support.
+- (Grudgingly, with suitable muttering of obscenities) renamed
+  files so that the collector distribution could live on a FAT
+  file system.  Files that are guaranteed to be useless on
+  a PC still have long names.  Gc_inline.h and gc_private.h
+  still exist, but now just include  gc_inl.h and gc_priv.h.
+- Fixed a really obscure bug in finalization that could cause
+  undetected mark stack overflows.  (I would be surprised if
+  any real code ever tickled this one.)
+- Changed finalization code to dynamically resize the hash
+  tables it maintains.  (This probably does not matter for well-
+  -written code.  It no doubt does for C++ code that overuses
+  destructors.)
+- Added typed allocation primitives.  Rewrote the marker to
+  accommodate them with more reasonable efficiency.  This
+  change should also speed up marking for GC_malloc allocated
+  objects a little.  See gc_typed.h for new primitives.
+- Improved debugging facilities slightly.  Allocation time
+  stack traces are now kept by default on SPARC/SUNOS4.
+  (Thanks to Scott Schwartz.)
+- Added better support for small heap applications.
+- Significantly extended cord package.  Fixed a bug in the
+  implementation of lazily read files.  Printf and friends now
+  have cord variants.  Cord traversals are a bit faster.
+- Made ALL_INTERIOR_POINTERS recognition the default.
+- Fixed de so that it can run in constant space, independent
+  of file size.  Added simple string searching to cords and de.
+- Added the Hull-Ellis C++ interface.
+- Added dynamic library support for OSF/1.
+  (Thanks to Al Dosser and Tim Bingham at DEC.)
+- Changed argument to GC_expand_hp to be expressed
+  in units of bytes instead of heap blocks.  (Necessary
+  since the heap block size now varies depending on
+  configuration.  The old version was never very clean.)
+- Added GC_get_heap_size().  The previous "equivalent"
+  was broken.
+- Restructured the Makefile a bit.  
+
+Since version 4.0:
+- Changed finalization implementation to guarantee that
+  finalization procedures are called outside of the allocation
+  lock, making direct use of the interface a little less dangerous.
+  MAY BREAK EXISTING CLIENTS that assume finalizers
+  are protected by a lock.  Since there seem to be few multithreaded
+  clients that use finalization, this is hopefully not much of
+  a problem.
+- Fixed a gross bug in CORD_prev.
+- Fixed a bug in blacklst.c that could result in unbounded
+  heap growth during startup on machines that do not clear
+  memory obtained from the OS (e.g. win32S).
+- Ported de editor to win32/win32S.  (This is now the only
+  version with a mouse-sensitive UI.)
+- Added GC_malloc_ignore_off_page to allocate large arrays
+  in the presence of ALL_INTERIOR_POINTERS.
+- Changed GC_call_with_alloc_lock to not disable signals in
+  the single-threaded case.
+- Reduced retry count in GC_collect_or_expand for garbage
+  collecting when out of memory.
+- Made uncollectable allocations bypass black-listing, as they
+  should.
+- Fixed a bug in typed_test in test.c that could cause (legitimate)
+  GC crashes.
+- Fixed some potential synchronization problems in finalize.c
+- Fixed a real locking problem in typd_mlc.c.
+- Worked around an AIX 3.2 compiler feature that results in
+  out of bounds memory references.
+- Partially worked around an IRIX5.2 beta problem (which may
+  or may not persist to the final release).
+- Fixed a bug in the heap integrity checking code that could
+  result in explicitly deallocated objects being identified as
+  smashed.  Fixed a bug in the dbg_mlc stack saving code
+  that caused old argument pointers to be considered live.
+- Fixed a bug in CORD_ncmp (and hence CORD_str).
+- Repaired the OS2 port, which had suffered from bit rot
+  in 4.0.  Worked around what appears to be CSet/2 V1.0
+  optimizer bug.
+- Fixed a Makefile bug for target "c++".
+
+Since version 4.1:
+- Multiple bug fixes/workarounds in the Solaris threads version.
+  (It occasionally failed to locate some register contents for
+  marking.  It also turns out that thr_suspend and friends are
+  unreliable in Solaris 2.3.  Dirty bit reads appear
+  to be unreliable under some weird 
+  circumstances.  My stack marking code
+  contained a serious performance bug.  The new code is
+  extremely defensive, and has not failed in several cpu
+  hours of testing.  But  no guarantees ...)
+- Added MacOS support (thanks to Patrick Beard.)
+- Fixed several syntactic bugs in gc_c++.h and friends.  (These
+  didn't bother g++, but did bother most other compilers.)
+  Fixed gc_c++.h finalization interface.  (It didn't.)
+- 64 bit alignment for allocated objects was not guaranteed in a
+  few cases in which it should have been.
+- Added GC_malloc_atomic_ignore_off_page.
+- Added GC_collect_a_little.
+- Added some prototypes to gc.h.
+- Some other minor bug fixes (notably in Makefile).
+- Fixed OS/2 / EMX port (thanks to Ari Huttunen).
+- Fixed AmigaDOS port. (thanks to Michel Schinz).
+- Fixed the DATASTART definition under Solaris.  There
+  was a 1 in 16K chance of the collector missing the first
+  64K of static data (and thus crashing).
+- Fixed some blatant anachronisms in the README file.
+- Fixed PCR-Makefile for upcoming PPCR release.
+
+Since version 4.2:
+- Fixed SPARC alignment problem with GC_DEBUG.
+- Fixed Solaris threads /proc workaround.  The real
+  problem was an interaction with mprotect.
+- Incorporated fix from Patrick Beard for gc_c++.h (now gc_cpp.h).
+- Slightly improved allocator space utilization by
+  fixing the GC_size_map mechanism.
+- Integrated some Sony News and MIPS RISCos 4.51
+  patches.  (Thanks to Nobuyuki Hikichi of
+  Software Research Associates, Inc. Japan)
+- Fixed HP_PA alignment problem.  (Thanks to
+  xjam@cork.cs.berkeley.edu.)
+- Added GC_same_obj and friends.  Changed GC_base
+  to return 0 for pointers past the end of large objects.
+  Improved GC_base performance with ALL_INTERIOR_POINTERS
+  on machines with a slow integer mod operation.
+  Added GC_PTR_ADD, GC_PTR_STORE, etc. to prepare
+  for preprocessor.
+- changed the default on most UNIX machines to be that
+  signals are not disabled during critical GC operations.
+  This is still ANSI-conforming, though somewhat dangerous
+  in the presence of signal handlers. But the performance
+  cost of the alternative is sometimes problematic.
+  Can be changed back with a minor Makefile edit.
+- renamed IS_STRING in gc.h, to CORD_IS_STRING, thus
+  following my own naming convention.  Added the function
+  CORD_to_const_char_star.
+- Fixed a gross bug in GC_finalize.  Symptom: occasional
+  address faults in that function.  (Thanks to Anselm
+  Baird-Smith (Anselm.BairdSmith@inria.fr)
+- Added port to ICL DRS6000 running DRS/NX.  Restructured
+  things a bit to factor out common code, and remove obsolete
+  code.  Collector should now run under SUNOS5 with either
+  mprotect or /proc dirty bits.  (Thanks to Douglas Steel
+  (doug@wg.icl.co.uk)).
+- More bug fixes and workarounds for Solaris 2.X.  (These were
+  mostly related to putting the collector in a dynamic library,
+  which didn't really work before.  Also SOLARIS_THREADS
+  didn't interact well with dl_open.)  Thanks to btlewis@eng.sun.com.
+- Fixed a serious performance bug on the DEC Alpha.  The text
+  segment was getting registered as part of the root set.
+  (Amazingly, the result was still fast enough that the bug
+  was not conspicuous.) The fix works on OSF/1, version 1.3.
+  Hopefully it also works on other versions of OSF/1 ...
+- Fixed a bug in GC_clear_roots.
+- Fixed a bug in GC_generic_malloc_words_small that broke
+  gc_inl.h.  (Reported by Antoine de Maricourt.  I broke it
+  in trying to tweak the Mac port.) 
+- Fixed some problems with cord/de under Linux.
+- Fixed some cord problems, notably with CORD_riter4.
+- Added DG/UX port.
+  Thanks to Ben A. Mesander (ben@piglet.cr.usgs.gov)
+- Added finalization registration routines with weaker ordering
+  constraints.  (This is necessary for C++ finalization with
+  multiple inheritance, since the compiler often adds self-cycles.)
+- Filled the holes in the SCO port. (Thanks to Michael Arnoldus
+  <chime@proinf.dk>.)
+- John Ellis' additions to the C++ support:  From John:
+
+* I completely rewrote the documentation in the interface gc_c++.h
+(later renamed gc_cpp.h).  I've tried to make it both clearer and more
+precise.
+
+* The definition of accessibility now ignores pointers from an
+finalizable object (an object with a clean-up function) to itself.
+This allows objects with virtual base classes to be finalizable by the
+collector.  Compilers typically implement virtual base classes using
+pointers from an object to itself, which under the old definition of
+accessibility prevented objects with virtual base classes from ever
+being collected or finalized.
+
+* gc_cleanup now includes gc as a virtual base.  This was enabled by
+the change in the definition of accessibility.
+
+* I added support for operator new[].  Since most (all?) compilers
+don't yet support operator new[], it is conditionalized on
+-DOPERATOR_NEW_ARRAY.  The code is untested, but its trivial and looks
+correct.
+
+* The test program test_gc_c++ (later renamed test_cpp.cc)
+tries to test for the C++-specific functionality not tested by the
+other programs.
+- Added <unistd.h> include to misc.c.  (Needed for ppcr.)
+- Added PowerMac port. (Thanks to Patrick Beard again.)
+- Fixed "srcdir"-related Makefile problems.  Changed things so
+  that all externally visible include files always appear in the
+  include subdirectory of the source.  Made gc.h directly
+  includable from C++ code.  (These were at Per
+  Bothner's suggestion.)
+- Changed Intel code to also mark from ebp (Kevin Warne's
+  suggestion).
+- Renamed C++ related files so they could live in a FAT
+  file system. (Charles Fiterman's suggestion.)
+- Changed Windows NT Makefile to include C++ support in
+  gc.lib.  Added C++ test as Makefile target.
+  
+Since version 4.3:
+ - ASM_CLEAR_CODE was erroneously defined for HP
+   PA machines, resulting in a compile error.
+ - Fixed OS/2 Makefile to create a library.  (Thanks to
+   Mark Boulter (mboulter@vnet.ibm.com)).
+ - Gc_cleanup objects didn't work if they were created on
+   the stack.  Fixed.
+ - One copy of Gc_cpp.h in the distribution was out of 
+   synch, and failed to document some known compiler
+   problems with explicit destructor invocation.  Partially
+   fixed.  There are probably other compilers on which
+   gc_cleanup is miscompiled.
+ - Fixed Makefile to pass C compiler flags to C++ compiler.
+ - Added Mac fixes.
+ - Fixed os_dep.c to work around what appears to be
+   a new and different VirtualQuery bug under newer
+   versions of win32S.
+ - GC_non_gc_bytes was not correctly maintained by
+   GC_free.  Fixed.  Thanks to James Clark (jjc@jclark.com).
+ - Added GC_set_max_heap_size.
+ - Changed allocation code to ignore blacklisting if it is preventing
+   use of a very large block of memory.  This has the advantage
+   that naive code allocating very large objects is much more
+   likely to work.  The downside is you might no
+   longer find out that such code should really use
+   GC_malloc_ignore_off_page.
+ - Changed GC_printf under win32 to close and reopen the file
+   between calls.  FAT file systems otherwise make the log file
+   useless for debugging.
+ - Added GC_try_to_collect and GC_get_bytes_since_gc.  These
+   allow starting an abortable collection during idle times. 
+   This facility does not require special OS support.  (Thanks to
+   Michael Spertus of Geodesic Systems for suggesting this.  It was
+   actually an easy addition.  Kumar Srikantan previously added a similar
+   facility to a now ancient version of the collector.  At the time
+   this was much harder, and the result was less convincing.)
+ - Added some support for the Borland development environment.  (Thanks
+   to John Ellis and Michael Spertus.)
+ - Removed a misfeature from checksums.c that caused unexpected 
+   heap growth.  (Thanks to Scott Schwartz.)
+ - Changed finalize.c to call WARN if it encounters a finalization cycle.
+   WARN is defined in gc_priv.h to write a message, usually to stdout.
+   In many environments, this may be inappropriate.
+ - Renamed NO_PARAMS in gc.h to GC_NO_PARAMS, thus adhering to my own
+   naming convention.
+ - Added GC_set_warn_proc to intercept warnings.
+ - Fixed Amiga port. (Thanks to Michel Schinz (schinz@alphanet.ch).)
+ - Fixed a bug in mark.c that could result in an access to unmapped
+   memory from GC_mark_from_mark_stack on machines with unaligned
+   pointers.
+ - Fixed a win32 specific performance bug that could result in scanning of
+   objects allocated with the system malloc.
+ - Added REDIRECT_MALLOC.
+
+Since version 4.4:
+ - Fixed many minor and one major README bugs. (Thanks to Franklin Chen
+   (chen@adi.com) for pointing out many of them.)
+ - Fixed ALPHA/OSF/1 dynamic library support. (Thanks to Jonathan Bachrach
+   (jonathan@harlequin.com)).
+ - Added incremental GC support (MPROTECT_VDB) for Linux (with some
+   help from Bruno Haible).
+ - Altered SPARC recognition tests in gc.h and config.h (mostly as
+   suggested by Fergus Henderson).
+ - Added basic incremental GC support for win32, as implemented by
+   Windows NT and Windows 95.  GC_enable_incremental is a noop
+   under win32s, which doesn't implement enough of the VM interface.
+ - Added -DLARGE_CONFIG.
+ - Fixed GC_..._ignore_off_page to also function without
+   -DALL_INTERIOR_POINTERS.
+ - (Hopefully) fixed RS/6000 port.  (Only the test was broken.)
+ - Fixed a performance bug in the nonincremental collector running
+   on machines supporting incremental collection with MPROTECT_VDB
+   (e.g. SunOS 4, DEC AXP).  This turned into a correctness bug under
+   win32s with win32 incremental collection.  (Not all memory protection
+   was disabled.)
+ - Fixed some ppcr related bit rot.
+ - Caused dynamic libraries to be unregistered before reregistering.
+   The old way turned out to be a performance bug on some machines.
+ - GC_root_size was not properly maintained under MSWIN32.
+ - Added -DNO_DEBUGGING and GC_dump.
+ - Fixed a couple of bugs arising with SOLARIS_THREADS +
+   REDIRECT_MALLOC.
+ - Added NetBSD/M68K port.  (Thanks to Peter Seebach
+   <seebs@taniemarie.solon.com>.)
+ - Fixed a serious realloc bug.  For certain object sizes, the collector
+   wouldn't scan the expanded part of the object.  (Thanks to Clay Spence
+   (cds@peanut.sarnoff.com) for noticing the problem, and helping me to
+   track it down.)
+   
+Since version 4.5:
+ - Added Linux ELF support.  (Thanks to Arrigo Triulzi <arrigo@ic.ac.uk>.)
+ - GC_base crashed if it was called before any other GC_ routines.
+   This could happen if a gc_cleanup object was allocated outside the heap
+   before any heap allocation.
+ - The heap expansion heuristic was not stable if all objects had finalization
+   enabled.  Fixed finalize.c to count memory in finalization queue and
+   avoid explicit deallocation.  Changed alloc.c to also consider this count.
+   (This is still not recommended.  It's expensive if nothing else.)  Thanks
+   to John Ellis for pointing this out.
+ - GC_malloc_uncollectable(0) was broken.  Thanks to Phong Vo for pointing
+   this out.
+ - The collector didn't compile under Linux 1.3.X.  (Thanks to Fred Gilham for
+   pointing this out.)  The current workaround is ugly, but expected to be
+   temporary.
+ - Fixed a formatting problem for SPARC stack traces.
+ - Fixed some '=='s in os_dep.c that should have been assignments.
+   Fortunately these were in code that should never be executed anyway.
+   (Thanks to Fergus Henderson.)
+ - Fixed the heap block allocator to only drop blacklisted blocks in small
+   chunks.  Made BL_LIMIT self adjusting.  (Both of these were in response
+   to heap growth observed by Paul Graham.)
+ - Fixed the Metrowerks/68K Mac code to also mark from a6.  (Thanks
+   to Patrick Beard.)
+ - Significantly updated README.debugging.
+ - Fixed some problems with longjmps out of signal handlers, especially under
+   Solaris.  Added a workaround for the fact that siglongjmp doesn't appear to
+   do the right thing with -lthread under Solaris.
+ - Added MSDOS/djgpp port.  (Thanks to Mitch Harris  (maharri@uiuc.edu).)
+ - Added "make reserved_namespace" and "make user_namespace".  The
+   first renames ALL "GC_xxx" identifiers as "_GC_xxx".  The second is the
+   inverse transformation.  Note that doing this is guaranteed to break all
+   clients written for the other names.
+ - descriptor field for kind NORMAL in GC_obj_kinds with ADD_BYTE_AT_END
+   defined should be -ALIGNMENT not WORDS_TO_BYTES(-1).  This is
+   a serious bug on machines with pointer alignment of less than a word.
+ - GC_ignore_self_finalize_mark_proc didn't handle pointers to very near the
+   end of the object correctly.  Caused failures of the C++ test on a DEC Alpha
+   with g++.
+ - gc_inl.h still had problems.  Partially fixed.  Added warnings at the
+   beginning to hopefully specify the remaining dangers.
+ - Added DATAEND definition to config.h.
+ - Fixed some of the .h file organization.  Fixed "make floppy".
+ 
+Since version 4.6:
+ - Fixed some compilation problems with -DCHECKSUMS (thanks to Ian Searle)
+ - Updated some Mac specific files to synchronize with Patrick Beard.
+ - Fixed a serious bug for machines with non-word-aligned pointers.
+   (Thanks to Patrick Beard for pointing out the problem.  The collector
+   should fail almost any conceivable test immediately on such machines.)
+
+Since version 4.7:
+ - Changed a "comment" in a MacOS specific part of mach-dep.c that caused
+   gcc to fail on other platforms.
+
+Since version 4.8
+ - More README.debugging fixes.
+ - Objects ready for finalization, but not finalized in the same GC
+   cycle, could be prematurely collected.  This occasionally happened
+   in test_cpp.
+ - Too little memory was obtained from the system for very large
+   objects.  That could cause a heap explosion if these objects were
+   not contiguous (e.g. under PCR), and too much of them was blacklisted.
+ - Due to an improper initialization, the collector was too hesitant to
+   allocate blacklisted objects immediately after system startup.
+ - Moved GC_arrays from the data into the bss segment by not explicitly
+   initializing it to zero.  This significantly
+   reduces the size of executables, and probably avoids some disk accesses
+   on program startup.  It's conceivable that it might break a port that I
+   didn't test.
+ - Fixed EMX_MAKEFILE to reflect the gc_c++.h to gc_cpp.h renaming which
+   occurred a while ago.
+
+Since 4.9:
+ - Fixed a typo around a call to GC_collect_or_expand in alloc.c.  It broke
+   handling of out of memory.  (Thanks to Patrick Beard for noticing.)
+
+Since 4.10:
+ - Rationalized (hopefully) GC_try_to_collect in an incremental collection
+   environment.  It appeared to not handle a call while a collection was in
+   progress, and was otherwise too conservative.
+ - Merged GC_reclaim_or_delete_all into GC_reclaim_all to get rid of some
+   code.
+ - Added Patrick Beard's Mac fixes, with substantial completely untested
+   modifications.
+ - Fixed the MPROTECT_VDB code to deal with large pages and imprecise
+   fault addresses (as on an UltraSPARC running Solaris 2.5).  Note that this
+   was not a problem in the default configuration, which uses PROC_VDB.
+ - The DEC Alpha assembly code needed to restore $gp between calls.
+   Thanks to Fergus Henderson for tracking this down and supplying a
+   patch.
+ - The write command for "de" was completely broken for large files.
+   I used the easiest portable fix, which involved changing the semantics
+   so that f.new is written instead of overwriting f.  That's safer anyway.
+ - Added README.solaris2 with a discussion of the possible problems of
+   mixing the collector's sbrk allocation with malloc/realloc.
+ - Changed the data segment starting address for SGI machines.  The
+   old code failed under IRIX6.
+ - Required double word alignment for MIPS.
+ - Various minor fixes to remove warnings.
+ - Attempted to fix some Solaris threads problems reported by Zhiying Chen.
+   In particular, the collector could try to fork a thread with the
+   world stopped as part of GC_thr_init.  It also failed to deal with
+   the case in which the original thread terminated before the whole
+   process did.
+ - Added -DNO_EXECUTE_PERMISSION.  This has a major performance impact
+   on the incremental collector under Irix, and perhaps under other
+   operating systems.
+ - Added some code to support allocating the heap with mmap.  This may
+   be preferable under some circumstances.
+ - Integrated dynamic library support for HP.
+   (Thanks to Knut Tvedten <knuttv@ifi.uio.no>.)
+ - Integrated James Clark's win32 threads support, and made a number
+   of changes to it, many of which were suggested by Pontus Rydin.
+   This is still not 100% solid.
+ - Integrated Alistair Crooks' support for UTS4 running on an Amdahl
+   370-class machine.
+ - Fixed a serious bug in explicitly typed allocation.  Objects requiring
+   large descriptors where handled in a way that usually resulted in
+   a segmentation fault in the marker.  (Thanks to Jeremy Fitzhardinge
+   for helping to track this down.)
+ - Added partial support for GNU win32 development.  (Thanks to Fergus
+   Henderson.)
+ - Added optional support for Java-style finalization semantics.  (Thanks
+   to Patrick Bridges.)  This is recommended only for Java implementations.
+ - GC_malloc_uncollectable faulted instead of returning 0 when out of
+   memory.  (Thanks to dan@math.uiuc.edu for noticing.)
+ - Calls to GC_base before the collector was initialized failed on a
+   DEC Alpha.  (Thanks to Matthew Flatt.)
+ - Added base pointer checking to GC_REGISTER_FINALIZER in debugging
+   mode, at the suggestion of Jeremy Fitzhardinge.
+ - GC_debug_realloc failed for uncollectable objects.  (Thanks to
+   Jeremy Fitzhardinge.)
+ - Explicitly typed allocation could crash if it ran out of memory.
+   (Thanks to Jeremy Fitzhardinge.)
+ - Added minimal support for a DEC Alpha running Linux.
+ - Fixed a problem with allocation of objects whose size overflowed
+   ptrdiff_t.  (This now fails unconditionally, as it should.)
+ - Added the beginning of Irix pthread support.
+ - Integrated Xiaokun Zhu's fixes for djgpp 2.01.
+ - Added SGI-style STL allocator support (gc_alloc.h).
+ - Fixed a serious bug in README.solaris2.  Multithreaded programs must include
+   gc.h with SOLARIS_THREADS defined.
+ - Changed GC_free so it actually deallocates uncollectable objects.
+   (Thanks to Peter Chubb for pointing out the problem.)
+ - Added Linux ELF support for dynamic libararies.  (Thanks again to
+   Patrick Bridges.)
+ - Changed the Borland cc configuration so that the assembler is not
+   required.
+ - Fixed a bug in the C++ test that caused it to fail in 64-bit
+   environments.
+
+Since 4.11:
+ - Fixed ElfW definition in dyn_load.c. (Thanks to Fergus Henderson.)
+   This prevented the dynamic library support from compiling on some
+   older ELF Linux systems.
+ - Fixed UTS4 port (which I apparently mangled during the integration)
+   (Thanks to again to Alistair Crooks.)
+ - "Make C++" failed on Suns with SC4.0, due to a problem with "bool".
+   Fixed in gc_priv.h.
+ - Added more pieces for GNU win32.  (Thanks to Timothy N. Newsham.)
+   The current state of things should suffice for at least some
+   applications.
+ - Changed the out of memory retry count handling as suggested by
+   Kenjiro Taura.  (This matters only if GC_max_retries > 0, which
+   is no longer the default.)
+ - If a /proc read failed repeatedly, GC_written_pages was not updated
+   correctly.  (Thanks to Peter Chubb for diagnosing this.)
+ - Under unlikely circumstances, the allocator could infinite loop in
+   an out of memory situation.  (Thanks again to Kenjiro Taura for
+   identifying the problem and supplying a fix.)
+ - Fixed a syntactic error in the DJGPP code.  (Thanks to Fergus
+   Henderson for finding this by inspection.)  Also fixed a test program
+   problem with DJGPP (Thanks to Peter Monks.)
+ - Atomic uncollectable objects were not treated correctly by the
+   incremental collector.  This resulted in weird log statistics and
+   occasional performance problems.  (Thanks to Peter Chubb for pointing
+   this out.)
+ - Fixed some problems resulting from compilers that dont define
+   __STDC__.  In this case void * and char * were used inconsistently
+   in some cases.  (Void * should not have been used at all.  If
+   you have an ANSI superset compiler that does not define __STDC__,
+   please compile with -D__STDC__=0. Thanks to Manuel Serrano and others
+   for pointing out the problem.)
+ - Fixed a compilation problem on Irix with -n32 and -DIRIX_THREADS.
+   Also fixed some other IRIX_THREADS problems which may or may not have
+   had observable symptoms.
+ - Fixed an HP PA compilation problem in dyn_load.c.  (Thanks to
+   Philippe Queinnec.)
+ - SEGV fault handlers sometimes did not get reset correctly.  (Thanks
+   to David Pickens.)
+ - Added a fix for SOLARIS_THREADS on Intel.  (Thanks again to David
+   Pickens.)  This probably needs more work to become functional.
+ - Fixed struct sigcontext_struct in os_dep.c for compilation under
+   Linux 2.1.X.	(Thanks to Fergus Henderson.)
+ - Changed the DJGPP STACKBOTTOM and DATASTART values to those suggested
+   by Kristian Kristensen.  These may still not be right, but it is
+   it is likely to work more often than what was there before.  They may
+   even be exactly right.
+ - Added a #include <string.h> to test_cpp.cc.  This appears to help
+   with HP/UX and gcc.  (Thanks to assar@sics.se.)
+ - Version 4.11 failed to run in incremental mode on recent 64-bit Irix
+   kernels.  This was a problem related to page unaligned heap segments.
+   Changed the code to page align heap sections on all platforms.
+   (I had mistakenly identified this as a kernel problem earlier.
+   It was not.)
+ - Version 4.11 did not make allocated storage executable, except on
+   one or two platforms, due to a bug in a #if test.  (Thanks to Dave
+   Grove for pointing this out.)
+ - Added sparc_sunos4_mach_dep.s to support Sun's compilers under SunOS4.
+ - Added GC_exclude_static_roots.
+ - Fixed the object size mapping algorithm.  This shouldn't matter,
+   but the old code was ugly.
+ - Heap checking code could die if one of the allocated objects was
+   larger than its base address.  (Unsigned underflow problem.  Thanks
+   to Clay Spence for isolating the problem.)
+ - Added RS6000 (AIX) dynamic library support and fixed STACK_BOTTOM.
+   (Thanks to Fred Stearns.)
+ - Added Fergus Henderson's patches for improved robustness with large
+   heaps and lots of blacklisting.
+ - Added Peter Chubb's changes to support Solaris Pthreads, to support
+   MMAP allocation in Solaris, to allow Solaris to find dynamic libraries
+   through /proc, to add malloc_typed_ignore_off_page, and a few other
+   minor features and bug fixes.
+ - The Solaris 2 port should not use sbrk.  I received confirmation from
+   Sun that the use of sbrk and malloc in the same program is not
+   supported.  The collector now defines USE_MMAP by default on Solaris.
+ - Replaced the djgpp makefile with Gary Leavens' version.
+ - Fixed MSWIN32 detection test.
+ - Added Fergus Henderson's patches to allow putting the collector into
+   a DLL under GNU win32.
+ - Added Ivan V. Demakov's port to Watcom C on X86.
+ - Added Ian Piumarta's Linux/PowerPC port.
+ - On Brian Burton's suggestion added PointerFreeGC to the placement
+   options in gc_cpp.h.  This is of course unsafe, and may be controversial.
+   On the other hand, it seems to be needed often enough that it's worth
+   adding as a standard facility.
+
+Since 4.12:
+ - Fixed a crucial bug in the Watcom port.  There was a redundant decl
+   of GC_push_one in gc_priv.h.
+ - Added FINALIZE_ON_DEMAND.
+ - Fixed some pre-ANSI cc problems in test.c.
+ - Removed getpagesize() use for Solaris.  It seems to be missing in one
+   or two versions.
+ - Fixed bool handling for SPARCCompiler version 4.2.
+ - Fixed some files in include that had gotten unlinked from the main
+   copy.
+ - Some RS/6000 fixes (missing casts).  Thanks to Toralf Foerster.
+ - Fixed several problems in GC_debug_realloc, affecting mostly the
+   FIND_LEAK case.
+ - GC_exclude_static_roots contained a buggy unsigned comparison to
+   terminate a loop.  (Thanks to Wilson Ho.)
+ - CORD_str failed if the substring occurred at the last possible position.
+   (Only affects cord users.)
+ - Fixed Linux code to deal with RedHat 5.0 and integrated Peter Bigot's
+   os_dep.c code for dealing with various Linux versions.
+ - Added workaround for Irix pthreads sigaction bug and possible signal
+   misdirection problems.
+Since alpha1:
+ - Changed RS6000 STACKBOTTOM.
+ - Integrated Patrick Beard's Mac changes.
+ - Alpha1 didn't compile on Irix m.n, m < 6.
+ - Replaced Makefile.dj with a new one from Gary Leavens.
+ - Added Andrew Stitcher's changes to support SCO OpenServer.
+ - Added PRINT_BLACK_LIST, to allow debugging of high densities of false
+   pointers.
+ - Added code to debug allocator to keep track of return address
+   in GC_malloc caller, thus giving a bit more context.
+ - Changed default behavior of large block allocator to more
+   aggressively avoid fragmentation.  This is likely to slow down the
+   collector when it succeeds at reducing space cost.
+ - Integrated Fergus Henderson's CYGWIN32 changes.  They are untested,
+   but needed for newer versions.
+ - USE_MMAP had some serious bugs.  This caused the collector to fail
+   consistently on Solaris with -DSMALL_CONFIG.
+ - Added Linux threads support, thanks largely to Fergus Henderson.
+Since alpha2:
+ - Fixed more Linux threads problems.
+ - Changed default GC_free_space_divisor to 3 with new large block allocation.
+   (Thanks to Matthew Flatt for some measurements that suggest the old
+   value sometimes favors space too much over time.)
+ - More CYGWIN32 fixes.
+ - Integrated Tyson-Dowd's Linux-M68K port.
+ - Minor HP PA and DEC UNIX fixes from Fergus Henderson.
+ - Integrated Christoffe Raffali's Linux-SPARC changes.
+ - Allowed for one more GC fixup iteration after a full GC in incremental
+   mode.  Some quick measurements suggested that this significantly
+   reduces pause times even with smaller GC_RATE values.
+ - Moved some more GC data structures into GC_arrays.  This decreases
+   pause times and GC overhead, but makes debugging slightly less convenient.
+ - Fixed namespace pollution problem ("excl_table").
+ - Made GC_incremental a constant for -DSMALL_CONFIG, hopefully shrinking
+   that slightly.
+ - Added some win32 threads fixes.
+ - Integrated Ivan Demakov and David Stes' Watcom fixes.
+ - Various other minor fixes contributed by many people.
+ - Renamed config.h to gcconfig.h, since config.h tends to be used for
+   many other things.
+ - Integrated Matthew Flatt's support for 68K MacOS "far globals".
+ - Fixed up some of the dynamic library Makefile targets for consistency
+   across platforms.
+ - Fixed a USE_MMAP typo that caused out-of-memory handling to fail
+   on Solaris.
+ - Added code to test.c to test thread creation a bit more.
+ - Integrated GC_win32_free_heap, as suggested by Ivan Demakov.
+ - Fixed Solaris 2.7 stack base finding problem.  (This may actually
+   have been done in an earlier alpha release.)
+Since alpha3:
+ - Fixed MSWIN32 recognition test, which interfered with cygwin.
+ - Removed unnecessary gc_watcom.asm from distribution.  Removed
+   some obsolete README.win32 text.
+ - Added Alpha Linux incremental GC support.  (Thanks to Philipp Tomsich
+   for code for retrieving the fault address in a signal handler.)
+   Changed Linux signal handler context argument to be a pointer.
+ - Took care of some new warnings generated by the 7.3 SGI compiler.
+ - Integrated Phillip Musumeci's FreeBSD/ELF fixes.
+ - -DIRIX_THREADS was broken with the -o32 ABI (typo in gc_priv.h>
+
+Since 4.13:
+ - Fixed GC_print_source_ptr to not use a prototype.
+ - generalized CYGWIN test.
+ - gc::new did the wrong thing with PointerFreeGC placement.
+   (Thanks to Rauli Ruohonen.)
+ - In the ALL_INTERIOR_POINTERS (default) case, some callee-save register
+   values could fail to be scanned if the register was saved and
+   reused in a GC frame.  This showed up in verbose mode with gctest
+   compiled with an unreleased SGI compiler.  I vaguely recall an old
+   bug report that may have been related.  The bug was probably quite old.
+   (The problem was that the stack scanning could be deferred until
+   after the relevant frame was overwritten, and the new save location
+   might be outside the scanned area.  Fixed by more eager stack scanning.)
+ - PRINT_BLACK_LIST had some problems.  A few source addresses were garbage.
+ - Replaced Makefile.dj and added -I flags to cord make targets.
+   (Thanks to Gary Leavens.)
+ - GC_try_to_collect was broken with the nonincremental collector.
+ - gc_cleanup destructors could pass the wrong address to
+   GC_register_finalizer_ignore_self in the presence of multiple
+   inheritance.  (Thanks to Darrell Schiebel.)
+ - Changed PowerPC Linux stack finding code.
+
+Since 4.14alpha1
+ - -DSMALL_CONFIG did not work reliably with large (> 4K) pages.
+   Recycling the mark stack during expansion could result in a size
+   zero heap segment, which confused things.  (This was probably also an
+   issue with the normal config and huge pages.)
+ - Did more work to make sure that callee-save registers were scanned
+   completely, even with the setjmp-based code.  Added USE_GENERIC_PUSH_REGS
+   macro to facilitate testing on machines I have access to.
+ - Added code to explicitly push register contents for win32 threads.
+   This seems to be necessary.  (Thanks to Pierre de Rop.)
+
+Since 4.14alpha2
+ - changed STACKBOTTOM for DJGPP (Thanks to Salvador Eduardo Tropea).
+ 
+Since 4.14
+ - Reworked large block allocator.  Now uses multiple doubly linked free
+   lists to approximate best fit.
+ - Changed heap expansion heuristic.  Entirely free blocks are no longer
+   counted towards the heap size.  This seems to have a major impact on
+   heap size stability; the old version could expand the heap way too
+   much in the presence of large block fragmentation.
+ - added -DGC_ASSERTIONS and some simple assertions inside the collector.
+   This is mainlyt for collector debugging.
+ - added -DUSE_MUNMAP to allow the heap to shrink.  Suupported on only
+   a few UNIX-like platforms for now.
+ - added GC_dump_regions() for debugging of fragmentation issues.
+ - Changed PowerPC pointer alignment under Linux to 4.  (This needs
+   checking by someone who has one.  The suggestions came to me via a
+   rather circuitous path.)
+ - Changed the Linux/Alpha port to walk the data segment backwards until
+   it encounters a SIGSEGV.  The old way to find the start of the data
+   segment broke with a recent release.
+ - cordxtra.c needed to call GC_REGISTER_FINALIZER instead of
+   GC_register_finalizer, so that it would continue to work with GC_DEBUG.
+ - allochblk sometimes cleared the wrong block for debugging purposes
+   when it dropped blacklisted blocks.  This could result in spurious
+   error reports with GC_DEBUG.
+ - added MACOS X Server support.  (Thanks to Andrew Stone.)
+ - Changed the Solaris threads code to ignore stack limits > 8 MB with
+   a warning.  Empirically, it is not safe to access arbitrary pages
+   in such large stacks.  And the dirty bit implementation does not
+   guarantee that none of them will be accessed.
+ - Integrated Martin Tauchmann's Amiga changes.
+ - Integrated James Dominy's OpenBSD/SPARC port.
+
+Since 5.0alpha1
+ - Fixed bugs introduced in alpha1 (OpenBSD & large block initialization).
+ - Added -DKEEP_BACK_PTRS and backptr.h interface.  (The implementation
+   idea came from Al Demers.)
+
+Since 5.0alpha2
+ - Added some highly incomplete code to support a copied young generation.
+   Comments on nursery.h are appreciated.
+ - Changed -DFIND_LEAK, -DJAVA_FINALIZATION, and -DFINALIZE_ON_DEMAND,
+   so the same effect could be obtained with a runtime switch.   This is
+   a step towards standardizing on a single dynamic GC library.
+ - Significantly changed the way leak detection is handled, as a consequence
+   of the above.
+
+Since 5.0 alpha3
+ - Added protection fault handling patch for Linux/M68K from Fergus
+   Henderson and Roman Hodek.
+ - Removed the tests for SGI_SOURCE in new_gc_alloc.h.  This was causing that
+   interface to fail on nonSGI platforms.
+ - Changed the Linux stack finding code to use /proc, after changing it
+   to use HEURISTIC1.  (Thanks to David Mossberger for pointing out the
+   /proc hook.)
+ - Added HP/UX incremental GC support and HP/UX 11 thread support.
+   Thread support is currently still flakey.
+ - Added basic Linux/IA64 support.
+ - Integrated Anthony Green's PicoJava support.
+ - Integrated Scott Ananian's StrongARM/NetBSD support.
+ - Fixed some fairly serious performance bugs in the incremental
+   collector.  These have probably been there essentially forever.
+   (Mark bits were sometimes set before scanning dirty pages.
+   The reclaim phase unnecessarily dirtied full small object pages.)
+ - Changed the reclaim phase to ignore nearly full pages to avoid
+   touching them.
+ - Limited GC_black_list_spacing to roughly the heap growth increment.
+ - Changed full collection triggering heuristic to decrease full GC
+   frequency by default, but to explicitly trigger full GCs during
+   heap growth.  This doesn't always improve things, but on average it's
+   probably a win.
+ - GC_debug_free(0, ...) failed.  Thanks to Fergus Henderson for the
+   bug report and fix.
+
+Since 5.0 alpha4
+ - GC_malloc_explicitly_typed and friends sometimes failed to
+   initialize first word.
+ - Added allocation routines and support in the marker for mark descriptors
+   in a type structure referenced by the first word of an object.  This was
+   introduced to support gcj, but hopefully in a way that makes it
+   generically useful.
+ - Added GC_requested_heapsize, and inhibited collections in nonincremental
+   mode if the actual used heap size is less than what was explicitly
+   requested.
+ - The Solaris pthreads version of GC_pthread_create didn't handle a NULL
+   attribute pointer.  Solaris thread support used the wrong default thread
+   stack size.  (Thanks to Melissa O'Neill for the patch.)
+ - Changed PUSH_CONTENTS macro to no longer modify first parameter.
+   This usually doesn't matter, but it was certainly an accident waiting
+   to happen ...
+ - Added GC_register_finalizer_no_order and friends to gc.h.  They're
+   needed by Java implementations.
+ - Integrated a fix for a win32 deadlock resulting from clock() calling
+   malloc.  (Thanks to Chris Dodd.)
+ - Integrated Hiroshi Kawashima's port to Linux/MIPS.  This was designed
+   for a handheld platform, and may or may not be sufficient for other
+   machines.
+ - Fixed a va_arg problem with the %c specifier in cordprnt.c.  It appears
+   that this was always broken, but recent versions of gcc are the first to
+   report the (statically detectable) bug.
+ - Added an attempt at a more general solution to dlopen races/deadlocks.
+   GC_dlopen now temporarily disables collection.  Still not ideal, but ...
+ - Added -DUSE_I686_PREFETCH, -DUSE_3DNOW_PREFETCH, and support for IA64
+   prefetch instructions.  May improve performance measurably, but I'm not
+   sure the code will run correctly on processors that don't support the
+   instruction.  Won't build except with very recent gcc.
+ - Added caching for header lookups in the marker.  This seems to result
+   in a barely measurable performance gain.  Added support for interleaved
+   lookups of two pointers, but unconfigured that since the performance
+   gain is currently near zero, and it adds to code size.
+ - Changed Linux DATA_START definition to check both data_start and
+   __data_start, since nothing else seems to be portable.
+ - Added -DUSE_LD_WRAP to optionally take advantage of the GNU ld function
+   wrapping mechanism.  Probably currently useful only on Linux.
+ - Moved some variables for the scratch allocator into GC_arrays, on
+   Martin Hirzel's suggestion.
+ - Fixed a win32 threads bug that caused the collector to not look for
+   interior pointers from one of the thread stacks without
+   ALL_INTERIOR_POINTERS.  (Thanks to Jeff Sturm.)
+ - Added Mingw32 support.  (Thanks again to Jeff Sturm for the patch.)
+ - Changed the alpha port to use the generic register scanning code instead
+   of alpha_mach_dep.s.  Alpha_mach_dep.s doesn't look for pointers in fp
+   registers, but gcc sometimes spills pointers there.  (Thanks to Manuel
+   Serrano for helping me debug this by email.)  Changed the IA64 code to
+   do something similar for similar reasons.
+
+Since 5.0alpha6:
+ - -DREDIRECT_MALLOC was broken in alpha6. Fixed.
+ - Cleaned up gc_ccp.h slightly, thus also causing the HP C++ compiler to
+   accept it.
+ - Removed accidental reference to dbg_mlc.c, which caused dbg_mlc.o to be
+   linked into every executable.
+ - Added PREFETCH to bitmap marker.  Changed it to use the header cache.
+ - GC_push_marked sometimes pushed one object too many, resulting in a
+   segmentation fault in GC_mark_from_mark_stack.  This was probably an old
+   bug.  It finally showed up in gctest on win32.
+ - Gc_priv.h erroneously #defined GC_incremental to be TRUE instead of FALSE
+   when SMALL_CONFIG was defined.  This was no doubt a major performance bug for
+   the default win32 configuration.
+ - Removed -DSMALL_CONFIG from NT_MAKEFILE.  It seemed like an anchronism now
+   that the average PC has 64MB or so.
+ - Integrated Bryce McKinley's patches for linux threads and dynamic loading
+   from the libgcj tree.  Turned on dynamic loading support for Linux/PPC.
+ - Changed the stack finding code to use environ on HP/UX.  (Thanks
+   to Gustavo Rodriguez-Rivera for the suggestion.)  This should probably
+   be done on other platforms, too.  Since I can't test those, that'll
+   wait until after 5.0.
+
+Since 5.0alpha7:
+ - Fixed threadlibs.c for linux threads.  -DUSE_LD_WRAP was broken and
+   -ldl was omitted.  Fixed Linux stack finding code to handle
+   -DUSE_LD_WRAP correctly.
+ - Added MSWIN32 exception handler around marker, so that the collector
+   can recover from root segments that are unmapped during the collection.
+   This caused occasional failures under Windows 98, and may also be
+   an issue under Windows NT/2000.
+
+Since 5.0
+ - Fixed a gc.h header bug which showed up under Irix.  (Thanks to
+   Dan Sullivan.)
+ - Fixed a typo in GC_double_descr in typd_mlc.c not getting traced correctly.
+   This probably could result in objects described by array descriptors not
+   getting traced correctly.  (Thanks to Ben Hutchings for pointing this out.)
+ - The block nearly full tests in reclaim.c were not correct for 64 bit
+   environments.  This could result in unnecessary heap growth under unlikely
+   conditions.
+ - Removed use of CLEAR_DOUBLE from generic reclaim code, since odd sizes
+   could occur.
+
+Since 5.1
+ - dyn_load.c declared GC_scratch_last_end_ptr as an extern even if it
+   was defined as a macro.  This prevented the collector from building on
+   Irix.
+ - We quietly assumed that indirect mark descriptors were never 0.
+   Our own typed allocation interface violated that.  This could result
+   in segmentation faults in the marker with typed allocation.
+ - Fixed a _DUSE_MUNMAP bug in the heap block allocation code.
+   (Thanks to Ben Hutchings for the patch.)
+ - Taught the collector about VC++ handling array operator new.
+   (Thanks again to Ben Hutchings for the patch.)
+ - The two copies of gc_hdrs.h had diverged.  Made one a link to the other
+   again.
+
+To do:
+ - Integrate Linux/SPARC fixes.
+ - Very large root set sizes (> 16 MB or so) could cause the collector
+   to abort with an unexpected mark stack overflow.  (Thanks again to
+   Peter Chubb.)  NOT YET FIXED.  Workaround is to increase the initial
+   size.
+ - The SGI version of the collector marks from mmapped pages, even
+   if they are not part of dynamic library static data areas.  This
+   causes performance problems with some SGI libraries that use mmap
+   as a bitmap allocator.  NOT YET FIXED.  It may be possible to turn
+   off DYNAMIC_LOADING in the collector as a workaround.  It may also
+   be possible to conditionally intercept mmap and use GC_exclude_static_roots.
+   The real fix is to walk rld data structures, which looks possible.
+ - Integrate MIT and DEC pthreads ports.
+ - Incremental collector should handle large objects better.  Currently,
+   it looks like the whole object is treated as dirty if any part of it
+   is.
+ - Cord/cordprnt.c doesn't build on a few platforms (notably PowerPC), since
+   we make some unwarranted assumptions about how varargs are handled.  This
+   currently makes the cord-aware versions of printf unusable on some platforms.
+   Fixing this is unfortunately not trivial.
diff --git a/src/gc/README.Mac b/src/gc/README.Mac
new file mode 100644
index 000000000..04f468251
--- /dev/null
+++ b/src/gc/README.Mac
@@ -0,0 +1,385 @@
+Patrick Beard's Notes for building GC v4.12 with CodeWarrior Pro 2:
+----------------------------------------------------------------------------
+The current build environment for the collector is CodeWarrior Pro 2.
+Projects for CodeWarrior Pro 2 (and for quite a few older versions)
+are distributed in the file Mac_projects.sit.hqx. The project file
+:Mac_projects:gc.prj builds static library versions of the collector.
+:Mac_projects:gctest.prj builds the GC test suite.
+
+Configuring the collector is still done by editing the files
+:Mac_files:MacOS_config.h and :Mac_files:MacOS_Test_config.h.
+
+Lars Farm's suggestions on building the collector:
+----------------------------------------------------------------------------
+Garbage Collection on MacOS - a manual 'MakeFile'
+-------------------------------------------------
+
+Project files and IDE's are great on the Macintosh, but they do have
+problems when used as distribution media. This note tries to provide
+porting instructions in pure TEXT form to avoid those problems. A manual
+'makefile' if you like.
+
+    GC version:     4.12a2
+    Codewarrior:    CWPro1
+    date:           18 July 1997
+
+The notes may or may not apply to earlier or later versions of the
+GC/CWPro. Actually, they do apply to earlier versions of both except that
+until recently a project could only build one target so each target was a
+separate project. The notes will most likely apply to future versions too.
+Possibly with minor tweaks.
+
+This is just to record my experiences. These notes do not mean I now
+provide a supported port of the GC to MacOS. It works for me. If it works
+for you, great. If it doesn't, sorry, try again...;-) Still, if you find
+errors, please let me know.
+
+    mailto:         lars.farm@ite.mh.se
+
+    address:        Lars Farm
+                    Krönvägen 33b
+                    856 44 Sundsvall
+                    Sweden
+
+Porting to MacOS is a bit more complex than it first seems. Which MacOS?
+68K/PowerPC? Which compiler? Each supports both 68K and PowerPC and offer a
+large number of (unique to each environment) compiler settings. Each
+combination of compiler/68K/PPC/settings require a unique combination of
+standard libraries. And the IDE's does not select them for you. They don't
+even check that the library is built with compatible setting and this is
+the major source of problems when porting the GC (and otherwise too).
+
+You will have to make choices when you configure the GC. I've made some
+choices here, but there are other combinations of settings and #defines
+that work too.
+
+As for target settings the major obstacles may be:
+- 68K Processor: check "4-byte Ints".
+- PPC Processor: uncheck "Store Static Data in TOC".
+
+What you need to do:
+===================
+
+1) Build the GC as a library
+2) Test that the library works with 'test.c'.
+3) Test that the C++ interface 'gc_cpp.cc/h' works with 'test_cpp.cc'.
+
+1) The Libraries:
+=================
+I made one project with four targets (68K/PPC tempmem or appheap). One target
+will suffice if you're able to decide which one you want. I wasn't...
+
+Codewarrior allows a large number of compiler/linker settings. I used these:
+
+Settings shared by all targets:
+------------------------------
+o Access Paths:
+  - User Paths:   the GC folder
+  - System Paths: {Compiler}:Metrowerks Standard Library:
+                  {Compiler}:MacOS Support:Headers:
+                  {Compiler}:MacOS Support:MacHeaders:
+o C/C++ language:
+  - inlining: normal
+  - direct to SOM: off
+  - enable/check: exceptions, RTTI, bool (and if you like pool strings)
+
+PowerPC target settings
+-----------------------
+o Target Settings:
+  - name of target
+  - MacOS PPC Linker
+o PPC Target
+  - name of library
+o C/C++ language
+  - prefix file as described below
+o PPC Processor
+  - Struct Alignment: PowerPC
+  - uncheck "Store Static Data in TOC" -- important!
+    I don't think the others matter, I use full optimization and its ok
+o PPC Linker
+  - Factory Settings (SYM file with full paths, faster linking, dead-strip
+    static init, Main: __start)
+
+
+68K target settings
+-------------------
+o Target Settings:
+  - name of target
+  - MacOS 68K Linker
+o 68K Target
+  - name of library
+  - A5 relative data
+o C/C++ language
+  - prefix file as described below
+o 68K Processor
+  - Code model: smart
+  - Struct alignment: 68K
+  - FP: SANE
+  - enable 4-Byte Ints -- important!
+    I don't think the others matter. I selected...
+  - enable: 68020
+  - enable: global register allocation
+o IR Optimizer
+  - enable: Optimize Space, Optimize Speed
+    I suppose the others would work too, but haven't tried...
+o 68K Linker
+  - Factory Settings (New Style MacsBug,SYM file with full paths,
+    A6 Frames, fast link, Merge compiler glue into segment 1,
+    dead-strip static init)
+
+Prefix Files to configure the GC sources
+----------------------------------------
+The Codewarrior equivalent of commandline compilers -DNAME=X is to use
+prefix-files. A TEXT file that is automatically #included before the first byte
+of every source file. I used these:
+
+---- ( cut here ) ----  gc_prefix_tempmem.h     -- 68K and PPC -----
+    #include "gc_prefix_common.h"
+    #undef USE_TEMPORARY_MEMORY
+    #define USE_TEMPORARY_MEMORY
+---- ( cut here ) ----  gc_prefix_appmem.h      -- 68K and PPC -----
+    #include "gc_prefix_common.h"
+    #undef USE_TEMPORARY_MEMORY
+//  #define USE_TEMPORARY_MEMORY
+
+---- ( cut here ) ----  gc_prefix_common.h      --------------------
+// gc_prefix_common.h
+// ------------------
+// Codewarrior prefix file to configure the GC libraries
+//
+//   prefix files are the Codewarrior equivalent of the
+//   command line option -Dname=x frequently seen in makefiles
+
+#if !__MWERKS__
+  #error only tried this with Codewarrior
+#endif
+
+#if macintosh
+  #define MSL_USE_PRECOMPILED_HEADERS 0
+  #include <ansi_prefix.mac.h>
+  #ifndef __STDC__
+    #define __STDC__ 0
+  #endif
+
+  //  See list of #defines to configure the library in: 'MakeFile'
+  //  see also README
+
+  #define SILENT                // no collection messages. In case
+                                // of trouble you might want this off
+  #define ALL_INTERIOR_POINTERS // follows interior pointers.
+//#define DONT_ADD_BYTE_AT_END  // disables the padding if defined.
+//#define SMALL_CONFIG          // whether to use a smaller heap.
+  #define NO_SIGNALS            // signals aren't real on the Macintosh.
+  #define ATOMIC_UNCOLLECTABLE  // GC_malloc_atomic_uncollectable()
+
+  // define either or none as per personal preference
+  //   used in malloc.c
+  #define REDIRECT_MALLOC GC_malloc
+//#define REDIRECT_MALLOC GC_malloc_uncollectable
+  // if REDIRECT_MALLOC is #defined make sure that the GC library
+  // is listed before the ANSI/ISO libs in the Codewarrior
+  // 'Link order' panel
+//#define IGNORE_FREE
+
+  // mac specific configs
+//#define USE_TEMPORARY_MEMORY    // use Macintosh temporary memory.
+//#define SHARED_LIBRARY_BUILD    // build for use in a shared library.
+
+#else
+  // could build Win32 here too, or in the future
+  // Rhapsody PPC-mach, Rhapsody PPC-MacOS,
+  // Rhapsody Intel-mach, Rhapsody Intel-Win32,...
+  // ... ugh this will get messy ...
+#endif
+
+// make sure ints are at least 32-bit
+// ( could be set to 16-bit by compiler settings (68K) )
+
+struct gc_private_assert_intsize_{ char x[ sizeof(int)>=4 ? 1 : 0 ]; };
+
+#if __powerc
+  #if __option(toc_data)
+    #error turn off "store static data in TOC" when using GC
+    //     ... or find a way to add TOC to the root set...(?)
+  #endif
+#endif
+---- ( cut here ) ----  end of gc_prefix_common.h  -----------------
+
+Files to  build the GC libraries:
+--------------------------------
+    allchblk.c
+    alloc.c
+    blacklst.c
+    checksums.c
+    dbg_mlc.c
+    finalize.c
+    headers.c
+    mach_dep.c
+    MacOS.c    -- contains MacOS code
+    malloc.c
+    mallocx.c
+    mark.c
+    mark_rts.c
+    misc.c
+    new_hblk.c
+    obj_map.c
+    os_dep.c   -- contains MacOS code
+    ptr_chck.c
+    reclaim.c
+    stubborn.c
+    typd_mlc.c
+    gc++.cc    -- this is 'gc_cpp.cc' with less 'inline' and
+               -- throw std::bad_alloc when out of memory
+               -- gc_cpp.cc works just fine too
+
+2) Test that the library works with 'test.c'.
+=============================================
+
+The test app is just an ordinary ANSI-C console app. Make sure settings
+match the library you're testing.
+
+Files
+-----
+    test.c
+    the GC library to test        -- link order before ANSI libs
+    suitable Mac+ANSI libraries
+
+prefix:
+------
+---- ( cut here ) ----  gc_prefix_testlib.h     -- all libs -----
+#define MSL_USE_PRECOMPILED_HEADERS 0
+#include <ansi_prefix.mac.h>
+#undef NDEBUG
+
+#define ALL_INTERIOR_POINTERS	/* for GC_priv.h */
+---- ( cut here ) ----
+
+3) Test that the C++ interface 'gc_cpp.cc/h' works with 'test_cpp.cc'.
+
+The test app is just an ordinary ANSI-C console app. Make sure settings match
+the library you're testing.
+
+Files
+-----
+    test_cpp.cc
+    the GC library to test        -- link order before ANSI libs
+    suitable Mac+ANSI libraries
+
+prefix:
+------
+same as for test.c
+
+For convenience I used one test-project with several targets so that all
+test apps are build at once. Two for each library to test: test.c and
+gc_app.cc. When I was satisfied that the libraries were ok. I put the
+libraries + gc.h + the c++ interface-file in a folder that I then put into
+the MSL hierarchy so that I don't have to alter access-paths in projects
+that use the GC.
+
+After that, just add the proper GC library to your project and the GC is in
+action! malloc will call GC_malloc and free GC_free, new/delete too. You
+don't have to call free or delete. You may have to be a bit cautious about
+delete if you're freeing other resources than RAM. See gc_cpp.h. You can
+also keep coding as always with delete/free. That works too. If you want,
+"include <gc.h> and tweak it's use a bit.
+
+Symantec SPM
+============
+It has been a while since I tried the GC in SPM, but I think that the above
+instructions should be sufficient to guide you through in SPM too. SPM
+needs to know where the global data is. Use the files 'datastart.c' and
+'dataend.c'. Put 'datastart.c' at the top of your project and 'dataend.c'
+at the bottom  of your project so that all data is surrounded. This is not
+needed in Codewarrior because it provides intrinsic variables
+__datastart__, __data_end__ that wraps all globals.
+
+Source Changes (GC 4.12a2)
+==========================
+Very few. Just one tiny in the GC, not strictly needed.
+- MacOS.c line 131 in routine GC_MacFreeTemporaryMemory()
+  change #       if !defined(SHARED_LIBRARY_BUILD)
+  to     #       if !defined(SILENT) && !defined(SHARED_LIBRARY_BUILD)
+  To turn off a message when the application quits (actually, I faked
+  this change by #defining SHARED_LIBRARY_BUILD in a statically linked
+  library for more than a year without ill effects but perhaps this is
+  better).
+
+- test_cpp.cc
+  made the first lines of main() look like this:
+  ------------
+  int main( int argc, char* argv[] ) {
+  #endif
+  #if macintosh                             // MacOS
+    char* argv_[] = {"test_cpp","10"};      //   doesn't
+    argv=argv_;                             //     have a
+    argc = sizeof(argv_)/sizeof(argv_[0]);  //       commandline
+  #endif                                    //
+
+  int i, iters, n;
+  # ifndef __GNUC__
+   alloc dummy_to_fool_the_compiler_into_doing_things_it_currently_cant_handle;
+  ------------
+
+- config.h [now gcconfig.h]
+  __MWERKS__ does not have to mean MACOS. You can use Codewarrior to
+  build a Win32 or BeOS library and soon a Rhapsody library. You may
+  have to change that #if...
+
+
+
+   It worked for me, hope it works for you.
+
+   Lars Farm
+   18 July 1997
+----------------------------------------------------------------------------
+
+
+Patrick Beard's instructions (may be dated):
+
+v4.3 of the collector now runs under Symantec C++/THINK C v7.0.4, and
+Metrowerks C/C++ v4.5 both 68K and PowerPC. Project files are provided
+to build and test the collector under both development systems.
+
+Configuration
+-------------
+
+To configure the collector, under both development systems, a prefix file
+is used to set preprocessor directives. This file is called "MacOS_config.h".
+Also to test the collector, "MacOS_Test_config.h" is provided.
+
+Testing
+-------
+
+To test the collector (always a good idea), build one of the gctest projects,
+gctest.¹ (Symantec C++/THINK C), mw/gctest.68K.¹, or mw/gctest.PPC.¹. The
+test will ask you how many times to run; 1 should be sufficient.
+
+Building 
+--------
+
+For your convenience project files for the major Macintosh development
+systems are provided.
+
+For Symantec C++/THINK C, you must build the two projects gclib-1.¹ and
+gclib-2.¹. It has to be split up because the collector has more than 32k
+of static data and no library can have more than this in the Symantec
+environment. (Future versions will probably fix this.)
+
+For Metrowerks C/C++ 4.5 you build gc.68K.¹/gc.PPC.¹ and the result will
+be a library called gc.68K.lib/gc.PPC.lib.
+
+Using
+-----
+
+Under Symantec C++/THINK C, you can just add the gclib-1.¹ and gclib-2.¹
+projects to your own project. Under Metrowerks, you add gc.68K.lib or
+gc.PPC.lib and two additional files. You add the files called datastart.c
+and dataend.c to your project, bracketing all files that use the collector.
+See mw/gctest.¹ for an example.
+
+Include the projects/libraries you built above into your own project,
+#include "gc.h", and call GC_malloc. You don't have to call GC_free.
+
+
+Patrick C. Beard
+January 4, 1995
diff --git a/src/gc/README.OS2 b/src/gc/README.OS2
new file mode 100644
index 000000000..5345bbd0f
--- /dev/null
+++ b/src/gc/README.OS2
@@ -0,0 +1,6 @@
+The code assumes static linking, and a single thread.  The editor de has
+not been ported.  The cord test program has.  The supplied OS2_MAKEFILE
+assumes the IBM C Set/2 environment, but the code shouldn't.
+
+Since we haven't figured out hoe to do perform partial links or to build static
+libraries, clients currently need to link against a long list of executables.
diff --git a/src/gc/README.QUICK b/src/gc/README.QUICK
new file mode 100644
index 000000000..ddebf82ca
--- /dev/null
+++ b/src/gc/README.QUICK
@@ -0,0 +1,43 @@
+Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
+Copyright (c) 1999 by Hewlett-Packard. All rights reserved.
+
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+
+Permission is hereby granted to use or copy this program
+for any purpose,  provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is granted,
+provided the above notices are retained, and a notice that the code was
+modified is included with the above copyright notice.
+
+
+For more details and the names of other contributors, see the
+README file and gc.h.  This file describes typical use of
+the collector on a machine that is already supported.
+
+INSTALLATION:
+Under UN*X, type "make test".  Under OS/2 or Windows NT, copy the
+appropriate makefile to MAKEFILE, read it, and type "nmake test".
+Read the machine specific README if one exists.  The only way to
+develop code with the collector for Windows 3.1 is to develop under
+Windows NT, and then to use win32S.
+
+If you wish to use the cord (structured string) library type
+"make cords". (This requires an ANSI C compiler.  You may need
+to redefine CC in the Makefile.)
+
+If you wish to use the collector from C++, type
+"make c++".  These add further files to gc.a and to the include
+subdirectory.  See cord/cord.h and gc_c++.h.
+
+TYPICAL USE:
+Include "gc.h" from this directory.  Link against the appropriate library
+("gc.a" under UN*X).  Replace calls to malloc by calls to GC_MALLOC,
+and calls to realloc by calls to GC_REALLOC.  If the object is known
+to never contain pointers, use GC_MALLOC_ATOMIC instead of
+GC_MALLOC.
+
+Define GC_DEBUG before including gc.h for additional checking.
+
diff --git a/src/gc/README.alpha b/src/gc/README.alpha
new file mode 100644
index 000000000..213a13e3f
--- /dev/null
+++ b/src/gc/README.alpha
@@ -0,0 +1,22 @@
+Should work under OSF/1 and Linux.  Currently no VMS or NT support, though
+the latter shouldn't be hard.
+
+Incremental gc not yet supported under Linux because signal handler
+for SIGSEGV can't get a hold of fault address.  Dynamic library support
+is also missing from Linux/alpha, probably for no good reason.
+
+Currently there is no thread support in the standard distribution.  There
+exists a separate port to DEC Unix pthreads.  It should be possible to
+port the X86 Linux threads support to Alpha without much trouble.
+
+If you get asssembler errors, be sure to read the first few lines of the
+Makefile.
+
+From Philippe Queinnec:
+
+System: DEC/Alpha OSF1 v3.2, vendor cc
+Problem: can't link if libgc has been compiled with "cc -std1".
+         It works if the library has been compiled with either gcc or "cc"
+         alone. The problem is because the variable "end" is not defined if
+         compiling in std1 mode (see man ld).
+Proposed fix: none. Don't use cc -std1 !
diff --git a/src/gc/README.amiga b/src/gc/README.amiga
new file mode 100644
index 000000000..47b158843
--- /dev/null
+++ b/src/gc/README.amiga
@@ -0,0 +1,180 @@
+===========================================================================
+			   Martin Tauchmann's notes		(1-Apr-99)
+===========================================================================
+
+Works now, also with the GNU-C compiler V2.7.2.1. <ftp://ftp.unina.it/pub/amiga/geekgadgets/amiga/m68k/snapshots/971125/amiga-bin/>
+Modify the `Makefile`
+CC=cc $(ABI_FLAG)
+to
+CC=gcc $(ABI_FLAG)
+
+TECHNICAL NOTES
+
+- `GC_get_stack_base()`, `GC_register_data_segments()` works now with every
+   C compiler; also Workbench.
+
+- Removed AMIGA_SKIP_SEG, but the Code-Segment must not be scanned by GC.
+
+
+PROBLEMS
+- When the Linker, does`t merge all Code-Segments to an single one. LD of GCC
+  do it always.
+
+- With ixemul.library V47.3, when an GC program launched from another program
+  (example: `Make` or `if_mach M68K AMIGA gctest`), `GC_register_data_segments()`
+  found the Segment-List of the caller program.
+  Can be fixed, if the run-time initialization code (for C programs, usually *crt0*)
+  support `__data` and `__bss`.
+
+- PowerPC Amiga currently not supported.
+
+- Dynamic libraries (dyn_load.c) not supported.
+
+
+TESTED WITH SOFTWARE
+
+`Optimized Oberon 2 C` (oo2c) <http://cognac.informatik.uni-kl.de/download/index.html>
+
+
+TESTED WITH HARDWARE
+
+MC68030
+
+
+CONTACT
+
+Please, contact me at <martintauchmann@bigfoot.com>, when you change the
+Amiga port. <http://martintauchmann.home.pages.de>
+ 
+===========================================================================
+			   Michel Schinz's notes
+===========================================================================
+WHO DID WHAT
+
+The original Amiga port was made by Jesper Peterson. I (Michel Schinz)
+modified it slightly to reflect the changes made in the new official
+distributions, and to take advantage of the new SAS/C 6.x features. I also
+created a makefile to compile the "cord" package (see the cord
+subdirectory).
+
+TECHNICAL NOTES
+
+In addition to Jesper's notes, I have the following to say:
+
+- Starting with version 4.3, gctest checks to see if the code segment is
+  added to the root set or not, and complains if it is. Previous versions
+  of this Amiga port added the code segment to the root set, so I tried to
+  fix that. The only problem is that, as far as I know, it is impossible to
+  know which segments are code segments and which are data segments (there
+  are indeed solutions to this problem, like scanning the program on disk
+  or patch the LoadSeg functions, but they are rather complicated). The
+  solution I have chosen (see os_dep.c) is to test whether the program
+  counter is in the segment we are about to add to the root set, and if it
+  is, to skip the segment. The problems are that this solution is rather
+  awkward and that it works only for one code segment. This means that if
+  your program has more than one code segment, all of them but one will be
+  added to the root set. This isn't a big problem in fact, since the
+  collector will continue to work correctly, but it may be slower.
+
+  Anyway, the code which decides whether to skip a segment or not can be
+  removed simply by not defining AMIGA_SKIP_SEG. But notice that if you do
+  so, gctest will complain (it will say that "GC_is_visible produced wrong
+  failure indication"). However, it may be useful if you happen to have
+  pointers stored in a code segment (you really shouldn't).
+
+  If anyone has a good solution to the problem of finding, when a program
+  is loaded in memory, whether a segment is a code or a data segment,
+  please let me know.
+
+PROBLEMS
+
+If you have any problem with this version, please contact me at
+schinz@alphanet.ch (but do *not* send long files, since we pay for
+every mail!).
+
+===========================================================================
+			  Jesper Peterson's notes
+===========================================================================
+
+ADDITIONAL NOTES FOR AMIGA PORT
+
+These notes assume some familiarity with Amiga internals.
+
+WHY I PORTED TO THE AMIGA
+
+The sole reason why I made this port was as a first step in getting
+the Sather(*) language on the Amiga. A port of this language will
+be done as soon as the Sather 1.0 sources are made available to me.
+Given this motivation, the garbage collection (GC) port is rather
+minimal.
+
+(*) For information on Sather read the comp.lang.sather newsgroup.
+
+LIMITATIONS
+
+This port assumes that the startup code linked with target programs
+is that supplied with SAS/C versions 6.0 or later. This allows
+assumptions to be made about where to find the stack base pointer
+and data segments when programs are run from WorkBench, as opposed
+to running from the CLI. The compiler dependent code is all in the
+GC_get_stack_base() and GC_register_data_segments() functions, but
+may spread as I add Amiga specific features.
+
+Given that SAS/C was assumed, the port is set up to be built with
+"smake" using the "SMakefile". Compiler options in "SCoptions" can
+be set with "scopts" program. Both "smake" and "scopts" are part of
+the SAS/C commercial development system.
+
+In keeping with the porting philosophy outlined above, this port
+will not behave well with Amiga specific code. Especially not inter-
+process comms via messages, and setting up public structures like
+Intuition objects or anything else in the system lists. For the
+time being the use of this library is limited to single threaded
+ANSI/POSIX  compliant or near-complient code. (ie. Stick to stdio
+for now). Given this limitation there is currently no mechanism for
+allocating "CHIP" or "PUBLIC" memory under the garbage collector.
+I'll add this after giving it considerable thought. The major
+problem is the entire physical address space may have to me scanned,
+since there is no telling who we may have passed memory to.
+
+If you allocate your own stack in client code, you will have to
+assign the pointer plus stack size to GC_stackbottom.
+
+The initial stack size of the target program can be compiled in by
+setting the __stack symbol (see SAS documentaion). It can be over-
+ridden from the CLI by running the AmigaDOS "stack" program, or from
+the WorkBench by setting the stack size in the tool types window.
+
+SAS/C COMPILER OPTIONS (SCoptions)
+
+You may wish to check the "CPU" code option is appropriate for your
+intended target system.
+
+Under no circumstances set the "StackExtend" code option in either
+compiling the library or *ANY* client code.
+
+All benign compiler warnings have been suppressed. These mainly
+involve lack of prototypes in the code, and dead assignments
+detected by the optimizer.
+
+THE GOOD NEWS
+
+The library as it stands is compatible with the GigaMem commercial
+virtual memory software, and probably similar PD software.
+
+The performance of "gctest" on an Amiga 2630 (68030 @ 25Mhz)
+compares favourably with an HP9000 with similar architecture (a 325
+with a 68030 I think).
+
+-----------------------------------------------------------------------
+
+The Amiga port has been brought to you by:
+
+Jesper Peterson.
+
+jep@mtiame.mtia.oz.au		(preferred, but 1 week turnaround)
+jep@orca1.vic.design.telecom.au (that's orca<one>, 1 day turnaround)
+
+At least one of these addresses should be around for a while, even
+though I don't work for either of the companies involved.
+
diff --git a/src/gc/README.debugging b/src/gc/README.debugging
new file mode 100644
index 000000000..f4dd65676
--- /dev/null
+++ b/src/gc/README.debugging
@@ -0,0 +1,68 @@
+Debugging suggestions:
+
+****If you get a segmentation fault or bus error while debugging with a debugger:
+If the fault occurred in GC_find_limit, or with incremental collection enabled, this is probably normal.  The collector installs handlers to take care of these.  You will not see these unless you are using a debugger.  Your debugger should allow you to continue.  It's preferable to tell the debugger to ignore SIGBUS and SIGSEGV ("handle" in gdb, "ignore" in most versions of dbx) and set a breakpoint in abort.  The collector will call abort if the signal had another cause, and there was not other handler previously installed.  I recommend debugging without incremental collection if possible.  (This applies directly to UNIX systems.  Debugging with incremental collection under win32 is worse.  See README.win32.)  
+
+****If you get warning messages informing you that the collector needed to allocate blacklisted blocks:
+
+0) Ignore these warnings while you are using GC_DEBUG.  Some of the routines mentioned below don't have debugging equivalents.  (Alternatively, write the missing routines and send them to me.)
+
+1) Replace allocator calls that request large blocks with calls to GC_malloc_ignore_off_page or GC_malloc_atomic_ignore_off_page.  You may want to set a breakpoint in GC_default_warn_proc to help you identify such calls.  Make sure that a pointer to somewhere near the beginning of the resulting block is maintained in a (preferably volatile) variable as long as the block is needed.
+
+2) If the large blocks are allocated with realloc, I suggest instead allocating them with something like the following.  Note that the realloc size increment should be fairly large (e.g. a factor of 3/2) for this to exhibit reasonable performance.  But we all know we should do that anyway.
+
+void * big_realloc(void *p, size_t new_size)
+{
+    size_t old_size = GC_size(p);
+    void * result;
+ 
+    if (new_size <= 10000) return(GC_realloc(p, new_size));
+    if (new_size <= old_size) return(p);
+    result = GC_malloc_ignore_off_page(new_size);
+    if (result == 0) return(0);
+    memcpy(result,p,old_size);
+    GC_free(p);
+    return(result);
+}
+
+3) In the unlikely case that even relatively small object (<20KB) allocations are triggering these warnings, then your address space contains lots of "bogus pointers", i.e. values that appear to be pointers but aren't.  Usually this can be solved by using GC_malloc_atomic or the routines in gc_typed.h to allocate large pointerfree regions of bitmaps, etc.  Sometimes the problem can be solved with trivial changes of encoding in certain values.  It is possible, though not pleasant, to identify the source of the bogus pointers by setting a breakpoint in GC_add_to_black_list_stack, and looking at the value of current_p in the GC_mark_from_mark_stack frame.  Current_p contains the address of the bogus pointer.
+
+4) If you get only a fixed number of these warnings, you are probably only introducing a bounded leak by ignoring them.  If the data structures being allocated are intended to be permanent, then it is also safe to ignore them.  The warnings can be turned off by calling GC_set_warn_proc with a procedure that ignores these warnings (e.g. by doing absolutely nothing).
+
+
+****If the collector dies in GC_malloc while trying to remove a free list element:
+
+1) With > 99% probability, you wrote past the end of an allocated object.  Try setting GC_DEBUG and using the debugging facilities in gc.h.
+
+
+****If the heap grows too much:
+
+1) Consider using GC_malloc_atomic for objects containing nonpointers.  This is especially important for large arrays containg compressed data, pseudo-random numbers, and the like.  (This isn't all that likely to solve your problem, but it's a useful and easy optimization anyway, and this is a good time to try it.)   If you allocate large objects containg only one or two pointers at the beginning, either try the typed allocation primitives is gc.h, or separate out the pointerfree component.
+2) If you are using the collector in its default mode, with interior pointer recognition enabled, consider using GC_malloc_ignore_off_page to allocate large objects.  (See gc.h and above for details.  Large means > 100K in most environments.)
+3) GC_print_block_list() will print a list of all currently allocated heap blocks and what size objects they contain.  GC_print_hblkfreelist() will print a list of free heap blocks, and whether they are blacklisted.  GC_dump calls both of these, and also prints information about heap sections, and root segments.
+4) Build the collector with -DKEEP_BACK_PTRS, and use the backptr.h
+interface to determine why objects are being retained.
+
+
+****If the collector appears to be losing objects:
+
+1) Replace all calls to GC_malloc_atomic and typed allocation by GC_malloc calls.  If this fixes the problem, gradually reinsert your optimizations.
+2) You may also want to try the safe(r) pointer manipulation primitives in gc.h.  But those are hard to use until the preprocessor becomes available.
+3) Try using the GC_DEBUG facilities.  This is less likely to be successful here than if the collector crashes.
+[The rest of these are primarily for wizards.  You shouldn't need them unless you're doing something really strange, or debugging a collector port.]
+4) Don't turn on incremental collection.  If that fixes the problem, suspect a bug in the dirty bit implementation.  Try compiling with -DCHECKSUMS to check for modified, but supposedly clean, pages.
+5) On a SPARC, in a single-threaded environment, GC_print_callers(GC_arrays._last_stack) prints a cryptic stack trace as of the time of the last collection.  (You will need a debugger to decipher the result.)  The question to ask then is "why should this object have been accessible at the time of the last collection?  Where was a pointer to it stored?".  This facility should be easy to add for some other collector ports (namely if it's easy to traverse stack frames), but will be hard for others.
+6) "print *GC_find_header(p)" in dbx or gdb will print the garbage collector block header information associated with the object p (e.g. object size, etc.)
+7) GC_is_marked(p) determines whether p is the base address of a marked object.  Note that objects allocated since the last collection should not be marked, and that unmarked objects are reclaimed incrementally.  It's usually most interesting to set a breakpoint in GC_finish_collection and then to determine how much of the damaged data structure is marked at that point.
+8) Look at the tracing facility in mark.c.  (Ignore this suggestion unless you are very familiar with collector internals.)
+9) [From Melissa O'Neill:]
+If you're using multiple threads, double check that all thread
+creation goes through the GC_ wrapper functions rather than
+calling the thread-creation functions themselves (e.g.,
+GC_pthread_create rather than pthread_create).  The gc.h header
+file includes suitable preprocessor definitions to accomplish
+this mapping transparently -- the question is: are you including
+it in all the modules that create threads?
+
+
+
diff --git a/src/gc/README.dj b/src/gc/README.dj
new file mode 100644
index 000000000..613bc423c
--- /dev/null
+++ b/src/gc/README.dj
@@ -0,0 +1,12 @@
+[Original version supplied by Xiaokun Zhu <xiaokun@aero.gla.ac.uk>]
+[This version came mostly from Gary Leavens.			  ]
+
+Look first at Makefile.dj, and possibly change the definitions of
+RM and MV if you don't have rm and mv installed.
+Then use Makefile.dj to compile the garbage collector.
+For example, you can do:
+
+	make -f Makefile.dj test
+
+All the tests should work fine.
+
diff --git a/src/gc/README.hp b/src/gc/README.hp
new file mode 100644
index 000000000..072ba5386
--- /dev/null
+++ b/src/gc/README.hp
@@ -0,0 +1,16 @@
+Dynamic loading support requires that executables be linked with -ldld.
+The alternative is to build the collector without defining DYNAMIC_LOADING
+in gcconfig.h and ensuring that all garbage collectable objects are
+accessible without considering statically allocated variables in dynamic
+libraries.
+
+The collector should compile with either plain cc or cc -Ae.  CC -Aa
+fails to define _HPUX_SOURCE and thus will not configure the collector
+correctly.
+
+Incremental collection support was reccently added, and should now work.
+
+Thread support for HP/UX 11 Pthreads was also recently added.  It is still
+flakey in this release.  (It has only been tested on a uniprocessor.  Even
+there some fraction of thread creation calls fail with a not-yet-understood
+error return from sem_wait.)
diff --git a/src/gc/README.linux b/src/gc/README.linux
new file mode 100644
index 000000000..e35e712ef
--- /dev/null
+++ b/src/gc/README.linux
@@ -0,0 +1,68 @@
+See README.alpha for Linux on DEC AXP info.
+
+This file applies mostly to Linux/Intel IA32.  Ports to Linux on an M68K
+and PowerPC are also integrated.  They should behave similarly, except that
+the PowerPC port lacks incremental GC support, and it is unknown to what
+extent the Linux threads code is functional.
+
+Incremental GC is supported on Intel IA32 and M68K.
+
+Dynamic libraries are supported on an ELF system.  A static executable
+should be linked with the gcc option "-Wl,-defsym,_DYNAMIC=0".
+
+The collector appears to work with Linux threads.  We have seen
+intermittent hangs in sem_wait.  So far we have been unable to reproduce
+these unless the process was being debugged or traced.  Thus it's
+possible that the only real issue is that the debugger loses
+signals on rare occasions.
+
+The garbage collector uses SIGPWR and SIGXCPU if it is used with
+Linux threads.  These should not be touched by the client program.
+
+To use threads, you need to abide by the following requirements:
+
+1) You need to use LinuxThreads (which are included in libc6).
+
+   The collector relies on some implementation details of the LinuxThreads
+   package.  It is unlikely that this code will work on other
+   pthread implementations (in particular it will *not* work with
+   MIT pthreads).
+
+2) You must compile the collector with -DLINUX_THREADS and -D_REENTRANT
+   specified in the Makefile.
+
+3a) Every file that makes thread calls should define LINUX_THREADS and 
+   _REENTRANT and then include gc.h.  Gc.h redefines some of the
+   pthread primitives as macros which also provide the collector with
+   information it requires.
+
+3b) A new alternative to (3a) is to build the collector with
+   -DUSE_LD_WRAP, and to link the final program with
+
+   (for ld) --wrap read --wrap dlopen --wrap pthread_create \
+	    --wrap pthread_join --wrap pthread_sigmask
+
+   (for gcc) -Wl,--wrap -Wl,read -Wl,--wrap -Wl,dlopen -Wl,--wrap \
+	     -Wl,pthread_create -Wl,--wrap -Wl,pthread_join -Wl,--wrap \
+	     -Wl,pthread_sigmask
+
+   In any case, _REENTRANT should be defined during compilation.
+
+4) Dlopen() disables collection during its execution.  (It can't run
+   concurrently with the collector, since the collector looks at its
+   data structures.  It can't acquire the allocator lock, since arbitrary
+   user startup code may run as part of dlopen().)  Under unusual
+   conditions, this may cause unexpected heap growth.
+
+5) The combination of LINUX_THREADS, REDIRECT_MALLOC, and incremental
+   collection fails in seemingly random places.  This hasn't been tracked
+   down yet, but is perhaps not completely astonishing.  The thread package
+   uses malloc, and thus can presumably get SIGSEGVs while inside the
+   package.  There is no real guarantee that signals are handled properly
+   at that point.
+
+6) Thread local storage may not be viewed as part of the root set by the
+   collector.  This probably depends on the linuxthreads version.  For the
+   time being, any collectable memory referenced by thread local storage should
+   also be referenced from elsewhere, or be allocated as uncollectable.
+   (This is really a bug that should be fixed somehow.)
diff --git a/src/gc/README.rs6000 b/src/gc/README.rs6000
new file mode 100644
index 000000000..f5630b20a
--- /dev/null
+++ b/src/gc/README.rs6000
@@ -0,0 +1,9 @@
+We have so far failed to find a good way to determine the stack base.
+It is highly recommended that GC_stackbottom be set explicitly on program
+startup.  The supplied value sometimes causes failure under AIX 4.1, though
+it appears to work under 3.X.  HEURISTIC2 seems to work under 4.1, but
+involves a substantial performance penalty, and will fail if there is
+no limit on stack size.
+
+There is no thread support.  (I assume recent versions of AIX provide
+pthreads?  I no longer have access to a machine ...)
diff --git a/src/gc/README.sgi b/src/gc/README.sgi
new file mode 100644
index 000000000..e67124b55
--- /dev/null
+++ b/src/gc/README.sgi
@@ -0,0 +1,41 @@
+Performance of the incremental collector can be greatly enhanced with
+-DNO_EXECUTE_PERMISSION.
+
+The collector should run with all of the -32, -n32 and -64 ABIs.  Remember to
+define the AS macro in the Makefile to be "as -64", or "as -n32".
+
+If you use -DREDIRECT_MALLOC=GC_malloc with C++ code, your code should make
+at least one explicit call to malloc instead of new to ensure that the proper
+version of malloc is linked in.
+
+Sproc threads are not supported in this version, though there may exist other
+ports.
+
+Pthreads support is provided.  This requires that:
+
+1) You compile the collector with -DIRIX_THREADS specified in the Makefile.
+
+2) You have the latest pthreads patches installed.  
+
+(Though the collector makes only documented pthread calls,
+it relies on signal/threads interactions working just right in ways
+that are not required by the standard.  It is unlikely that this code
+will run on other pthreads platforms.  But please tell me if it does.)
+
+3) Every file that makes thread calls should define IRIX_THREADS and then
+include gc.h.  Gc.h redefines some of the pthread primitives as macros which
+also provide the collector with information it requires.
+
+4) pthread_cond_wait and pthread_cond_timed_wait should be prepared for
+premature wakeups.  (I believe the pthreads and realted standards require this
+anyway.  Irix pthreads often terminate a wait if a signal arrives.
+The garbage collector uses signals to stop threads.)
+
+5) It is expensive to stop a thread waiting in IO at the time the request is
+initiated.  Applications with many such threads may not exhibit acceptable
+performance with the collector.  (Increasing the heap size may help.)
+
+6) The collector should not be compiled with -DREDIRECT_MALLOC.  This
+confuses some library calls made by the pthreads implementation, which
+expect the standard malloc.
+
diff --git a/src/gc/README.solaris2 b/src/gc/README.solaris2
new file mode 100644
index 000000000..cb15e30a1
--- /dev/null
+++ b/src/gc/README.solaris2
@@ -0,0 +1,62 @@
+The collector supports both incremental collection and threads under
+Solaris 2.  The incremental collector normally retrieves page dirty information
+through the appropriate /proc calls.  But it can also be configured
+(by defining MPROTECT_VDB instead of PROC_VDB in gcconfig.h) to use mprotect
+and signals.  This may result in shorter pause times, but it is no longer
+safe to issue arbitrary system calls that write to the heap.
+
+Under other UNIX versions,
+the collector normally obtains memory through sbrk.  There is some reason
+to expect that this is not safe if the client program also calls the system
+malloc, or especially realloc.  The sbrk man page strongly suggests this is
+not safe: "Many library routines use malloc() internally, so use brk()
+and sbrk() only when you know  that malloc() definitely will not be used by
+any library routine."  This doesn't make a lot of sense to me, since there
+seems to be no documentation as to which routines can transitively call malloc.
+Nonetheless, under Solaris2, the collector now (since 4.12) allocates
+memory using mmap by default.  (It defines USE_MMAP in gcconfig.h.)
+You may want to reverse this decisions if you use -DREDIRECT_MALLOC=...
+
+
+SOLARIS THREADS:
+
+The collector must be compiled with -DSOLARIS_THREADS to be thread safe.
+It is also essential that gc.h be included in files that call thr_create,
+thr_join, thr_suspend, thr_continue, or dlopen.  Gc.h macro defines
+these to also do GC bookkeeping, etc.  Gc.h must be included with
+SOLARIS_THREADS defined, otherwise these replacements are not visible.
+A collector built in this way way only be used by programs that are
+linked with the threads library.
+
+If you are using the Pthreads interface, also define _SOLARIS_PTHREADS.
+
+In this mode, the collector contains various workarounds for older Solaris
+bugs.  Mostly, these should not be noticeable unless you look at system
+call traces.  However, it cannot protect a guard page at the end of
+a thread stack.  If you know that you will only be running Solaris2.5
+or later, it should be possible to fix this by compiling the collector
+with -DSOLARIS23_MPROTECT_BUG_FIXED.
+
+Since 5.0 alpha5, dlopen disables collection temporarily,
+unless USE_PROC_FOR_LIBRARIES is defined.  In some unlikely cases, this
+can result in unpleasant heap growth.  But it seems better than the
+race/deadlock issues we had before.
+
+If solaris_threads are used on an X86 processor with malloc redirected to
+GC_malloc, it is necessary to call GC_thr_init explicitly before forking the
+first thread.  (This avoids a deadlock arising from calling GC_thr_init
+with the allocation lock held.)
+
+It appears that there is a problem in using gc_cpp.h in conjunction with
+Solaris threads and Sun's C++ runtime.  Apparently the overloaded new operator
+is invoked by some iostream initialization code before threads are correctly
+initialized.  As a result, call to thr_self() in garbage collector
+initialization  segfaults.  Currently the only known workaround is to not
+invoke the garbage collector from a user defined global operator new, or to
+have it invoke the garbage-collector's allocators only after main has started.
+(Note that the latter requires a moderately expensive test in operator
+delete.)
+
+Hans-J. Boehm
+(The above contains my personal opinions, which are probably not shared
+by anyone else.)
diff --git a/src/gc/README.uts b/src/gc/README.uts
new file mode 100644
index 000000000..6be49667d
--- /dev/null
+++ b/src/gc/README.uts
@@ -0,0 +1,2 @@
+Alistair Crooks supplied the port.  He used Lexa C version 2.1.3 with
+-Xa to compile.
diff --git a/src/gc/README.win32 b/src/gc/README.win32
new file mode 100644
index 000000000..d78816b55
--- /dev/null
+++ b/src/gc/README.win32
@@ -0,0 +1,149 @@
+The collector has only been compiled under Windows NT, with the
+original Microsoft SDK, with Visual C++ 2.0 and later, with
+the GNU win32 environment, with Borland 4.5, and recently with
+Watcom C.
+
+It runs under both win32s and win32, but with different semantics.
+Under win32, all writable pages outside of the heaps and stack are
+scanned for roots.  Thus the collector sees pointers in DLL data
+segments.  Under win32s, only the main data segment is scanned.
+(The main data segment should always be scanned.  Under some
+versions of win32s, other regions may also be scanned.)
+Thus all accessible objects should be accessible from local variables
+or variables in the main data segment.  Alternatively, other data
+segments (e.g. in DLLs) may be registered with the collector by
+calling GC_init() and then GC_register_root_section(a), where
+a is the address of some variable inside the data segment.  (Duplicate
+registrations are ignored, but not terribly quickly.)
+
+(There are two reasons for this.  We didn't want to see many 16:16
+pointers.  And the VirtualQuery call has different semantics under
+the two systems, and under different versions of win32s.)
+
+The collector test program "gctest" is linked as a GUI application,
+but does not open any windows.  Its output appears in the file
+"gc.log".  It may be started from the file manager.  The hour glass
+cursor will appear as long as it's running.  If it is started from the
+command line, it will usually run in the background.  Wait a few
+minutes (a few seconds on a modern machine) before you check the output.
+You should see either a failure indication or a "Collector appears to
+work" message.
+
+The cord test program has not been ported (but should port
+easily).  A toy editor (cord/de.exe) based on cords (heavyweight
+strings represented as trees) has been ported and is included.
+It runs fine under either win32 or win32S.  It serves as an example
+of a true Windows application, except that it was written by a
+nonexpert Windows programmer.  (There are some peculiarities
+in the way files are displayed.  The <cr> is displayed explicitly
+for standard DOS text files.  As in the UNIX version, control
+characters are displayed explicitly, but in this case as red text.
+This may be suboptimal for some tastes and/or sets of default
+window colors.)
+
+For Microsoft development tools, rename NT_MAKEFILE as
+MAKEFILE.  (Make sure that the CPU environment variable is defined
+to be i386.)
+
+For GNU-win32, use the regular makefile, possibly after uncommenting
+the line "include Makefile.DLLs".  The latter should be necessary only
+if you want to package the collector as a DLL.  The GNU-win32 port is
+believed to work only for b18, not b19, probably dues to linker changes
+in b19.  This is probably fixable with a different definition of
+DATASTART and DATAEND in gcconfig.h.
+
+For Borland tools, use BCC_MAKEFILE.  Note that
+Borland's compiler defaults to 1 byte alignment in structures (-a1),
+whereas Visual C++ appears to default to 8 byte alignment (/Zp8).
+The garbage collector in its default configuration EXPECTS AT
+LEAST 4 BYTE ALIGNMENT.  Thus the BORLAND DEFAULT MUST
+BE OVERRIDDEN.  (In my opinion, it should usually be anyway.
+I expect that -a1 introduces major performance penalties on a
+486 or Pentium.)  Note that this changes structure layouts.  (As a last
+resort, gcconfig.h can be changed to allow 1 byte alignment.  But
+this has significant negative performance implications.)
+The Makefile is set up to assume Borland 4.5.  If you have another
+version, change the line near the top.  By default, it does not
+require the assembler.  If you do have the assembler, I recommend
+removing the -DUSE_GENERIC.
+
+Incremental collection support was recently added.  This is
+currently pretty simpleminded.  Pages are protected.  Protection
+faults are caught by a handler installed at the bottom of the handler
+stack.  This is both slow and interacts poorly with a debugger.
+Whenever possible, I recommend adding a call to
+GC_enable_incremental at the last possible moment, after most
+debugging is complete.  Unlike the UNIX versions, no system
+calls are wrapped by the collector itself.  It may be necessary
+to wrap ReadFile calls that use a buffer in the heap, so that the
+call does not encounter a protection fault while it's running.
+(As usual, none of this is an issue unless GC_enable_incremental
+is called.)
+
+Note that incremental collection is disabled with -DSMALL_CONFIG,
+which is the default for win32.  If you need incremental collection,
+undefine SMALL_CONFIG.
+
+Incremental collection is not supported under win32s, and it may not
+be possible to do so.  However, win32 applications that attempt to use
+incremental collection should continue to run, since the
+collector detects if it's running under win32s and turns calls to
+GC_enable_incremental() into noops.
+
+James Clark has contributed the necessary code to support win32 threads.
+This code is known to exhibit some problems with incremental collection
+enabled.  Use NT_THREADS_MAKEFILE (a.k.a gc.mak) instead of NT_MAKEFILE
+to build this version.  Note that this requires some files whose names
+are more than 8 + 3 characters long.  Thus you should unpack the tar file
+so that long file names are preserved.  To build the garbage collector
+test with VC++ from the command line, use
+
+nmake /F ".\gc.mak" CFG="gctest - Win32 Release"
+
+This requires that the subdirectory gctest\Release exist.
+The test program and DLL will reside in the Release directory.
+
+This version relies on the collector residing in a dll.
+
+This version currently supports incremental collection only if it is
+enabled before any additional threads are created.
+Version 4.13 attempts to fix some of the earlier problems, but there
+may be other issues.  If you need solid support for win32 threads, you
+might check with Geodesic Systems.  Their collector must be licensed,
+but they have invested far more time in win32-specific issues.
+
+Hans
+
+Ivan V. Demakov's README for the Watcom port:
+
+The collector has been compiled with Watcom C 10.6 and 11.0.
+It runs under win32, win32s, and even under msdos with dos4gw
+dos-extender. It should also run under OS/2, though this isn't
+tested. Under win32 the collector can be built either as dll
+or as static library.
+
+Note that all compilations were done under Windows 95 or NT.
+For unknown reason compiling under Windows 3.11 for NT (one
+attempt has been made) leads to broken executables.
+
+Incremental collection is not supported.
+
+cord is not ported.
+
+Before compiling you may need to edit WCC_MAKEFILE to set target
+platform, library type (dynamic or static), calling conventions, and
+optimization options.
+
+To compile the collector and testing programs use the command:
+    wmake -f WCC_MAKEFILE
+
+All programs using gc should be compiled with 4-byte alignment.
+For further explanations on this see comments about Borland.
+
+If gc compiled as dll, the macro ``GC_DLL'' should be defined before
+including "gc.h" (for example, with -DGC_DLL compiler option). It's
+important, otherwise resulting programs will not run.
+
+Ivan Demakov (email: ivan@tgrad.nsk.su)
+
+
diff --git a/src/gc/SCoptions.amiga b/src/gc/SCoptions.amiga
new file mode 100644
index 000000000..a61e0cb1f
--- /dev/null
+++ b/src/gc/SCoptions.amiga
@@ -0,0 +1,16 @@
+CPU=68030
+NOSTACKCHECK
+OPTIMIZE
+VERBOSE
+MAPHUNK
+NOVERSION
+NOICONS
+OPTIMIZERTIME
+DEFINE SILENT
+DEFINE AMIGA_SKIP_SEG
+IGNORE=85
+IGNORE=154
+IGNORE=161
+IGNORE=100
+OPTIMIZERCOMPLEXITY=4
+OPTIMIZERDEPTH=3
diff --git a/src/gc/SMakefile.amiga b/src/gc/SMakefile.amiga
new file mode 100644
index 000000000..e9602c08c
--- /dev/null
+++ b/src/gc/SMakefile.amiga
@@ -0,0 +1,48 @@
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o real_malloc.o dyn_load.o dbg_mlc.o malloc.o stubborn.o checksums.o typd_mlc.o ptr_chck.o
+
+INC=  gc_private.h gc_hdrs.h gc.h gcconfig.h
+
+all: gctest setjmp_t
+
+alloc.o : alloc.c $(INC)
+reclaim.o : reclaim.c $(INC)
+allchblk.o : allchblk.c $(INC)
+misc.o : misc.c $(INC)
+os_dep.o : os_dep.c $(INC)
+mark_rts.o : mark_rts.c $(INC)
+headers.o : headers.c $(INC)
+mark.o : mark.c $(INC)
+obj_map.o : obj_map.c $(INC)
+blacklst.o : blacklst.c $(INC)
+finalize.o : finalize.c $(INC)
+  sc noopt finalize.c # There seems to be a bug in the optimizer (V6.51).
+                      # gctest won't work if you remove this...
+new_hblk.o : new_hblk.c $(INC)
+real_malloc.o : real_malloc.c $(INC)
+dyn_load.o : dyn_load.c $(INC)
+dbg_mlc.o : dbg_mlc.c $(INC)
+malloc.o : malloc.c $(INC)
+mallocx.o : malloc.c $(INC)
+stubborn.o : stubborn.c $(INC)
+checksums.o : checksums.c $(INC)
+typd_mlc.o: typd_mlc.c $(INC)
+mach_dep.o : mach_dep.c $(INC)
+ptr_chck.o: ptr_chck.c $(INC)
+test.o : test.c $(INC)
+
+gc.lib: $(OBJS)
+   oml gc.lib r $(OBJS)
+
+clean:
+   delete gc.lib gctest setjmp_t \#?.o
+
+gctest: gc.lib test.o
+   slink LIB:c.o test.o to $@ lib gc.lib LIB:sc.lib LIB:scm.lib
+
+setjmp_t: setjmp_t.c gc.h
+   sc setjmp_t.c
+   slink LIB:c.o $@.o to $@ lib LIB:sc.lib
+
+test: setjmp_t gctest
+   setjmp_t
+   gctest
diff --git a/src/gc/WCC_MAKEFILE b/src/gc/WCC_MAKEFILE
new file mode 100644
index 000000000..087ff6a31
--- /dev/null
+++ b/src/gc/WCC_MAKEFILE
@@ -0,0 +1,196 @@
+# Makefile for Watcom C/C++ 10.5, 10.6, 11.0 on NT, OS2 and DOS4GW.
+# May work with Watcom 10.0.
+
+# Uncoment one of the lines below for cross compilation.
+SYSTEM=MSWIN32
+#SYSTEM=DOS4GW
+#SYSTEM=OS2
+
+# The collector can be built either as dynamic or as static library.
+# Select the library type you need.
+#MAKE_AS_DLL=1
+MAKE_AS_LIB=1
+
+# Select calling conventions.
+# Possible choices are r and s.
+CALLING=s
+
+# Select target CPU.
+# Possible choices are 3, 4, 5, and 6.
+# The last choice available only since version 11.0.
+CPU=5
+
+# Set optimization options.
+# Watcom before 11.0 does not support option "-oh".
+OPTIM=-oneatx -s
+#OPTIM=-ohneatx -s
+
+DEFS=-DALL_INTERIOR_POINTERS -DSILENT -DNO_SIGNALS #-DSMALL_CONFIG #-DGC_DEBUG
+
+
+#####
+
+!ifndef SYSTEM
+!ifdef __MSDOS__
+SYSTEM=DOS4GW
+!else ifdef __NT__
+SYSTEM=MSWIN32
+!else ifdef __OS2__
+SYSTEM=OS2
+!else
+SYSTEM=Unknown
+!endif
+!endif
+
+!define $(SYSTEM)
+
+!ifdef DOS4GW
+SYSFLAG=-DDOS4GW -bt=dos
+!else ifdef MSWIN32
+SYSFLAG=-DMSWIN32 -bt=nt
+!else ifdef OS2
+SYSFLAG=-DOS2 -bt=os2
+!else
+!error undefined or unsupported target platform: $(SYSTEM)
+!endif
+!ifdef MAKE_AS_DLL
+DLLFLAG=-bd -DGC_DLL
+TEST_DLLFLAG=-DGC_DLL
+!else ifdef MAKE_AS_LIB
+DLLFLAG=
+TEST_DLLFLAG=
+!else
+!error Either MAKE_AS_LIB or MAKE_AS_DLL should be defined
+!endif
+
+CC=wcc386
+CXX=wpp386
+
+# -DUSE_GENERIC is required !
+CFLAGS=-$(CPU)$(CALLING) $(OPTIM) -zp4 -zc $(SYSFLAG) $(DLLFLAG) -DGC_BUILD -DUSE_GENERIC $(DEFS)
+CXXFLAGS= $(CFLAGS)
+TEST_CFLAGS=-$(CPU)$(CALLING) $(OPTIM) -zp4 -zc $(SYSFLAG) $(TEST_DLLFLAG) $(DEFS)
+TEST_CXXFLAGS= $(TEST_CFLAGS)
+
+OBJS= alloc.obj reclaim.obj allchblk.obj misc.obj &
+      mach_dep.obj os_dep.obj mark_rts.obj headers.obj mark.obj &
+      obj_map.obj blacklst.obj finalize.obj new_hblk.obj &
+      dbg_mlc.obj malloc.obj stubborn.obj dyn_load.obj &
+      typd_mlc.obj ptr_chck.obj mallocx.obj
+
+all: gc.lib gctest.exe test_cpp.exe
+
+!ifdef MAKE_AS_DLL
+
+gc.lib: gc.dll gc_cpp.obj
+        *wlib -b -c -n -p=512 $@ +gc.dll +gc_cpp.obj
+
+gc.dll: $(OBJS) .AUTODEPEND
+        @%create $*.lnk
+!ifdef DOS4GW
+        @%append $*.lnk sys os2v2_dll
+!else ifdef MSWIN32
+        @%append $*.lnk sys nt_dll
+!else ifdef OS2
+        @%append $*.lnk sys os2v2_dll
+!endif
+        @%append $*.lnk name $*
+        @for %i in ($(OBJS)) do @%append $*.lnk file '%i'
+!ifeq CALLING s
+      @%append $*.lnk export GC_is_marked
+      @%append $*.lnk export GC_incr_words_allocd
+      @%append $*.lnk export GC_incr_mem_freed
+      @%append $*.lnk export GC_generic_malloc_words_small
+!else
+      @%append $*.lnk export GC_is_marked_
+      @%append $*.lnk export GC_incr_words_allocd_
+      @%append $*.lnk export GC_incr_mem_freed_
+      @%append $*.lnk export GC_generic_malloc_words_small_
+!endif
+        *wlink @$*.lnk
+!else
+gc.lib: $(OBJS) gc_cpp.obj
+        @%create $*.lb1
+        @for %i in ($(OBJS)) do @%append $*.lb1 +'%i'
+      @%append $*.lb1 +'gc_cpp.obj'
+        *wlib -b -c -n -p=512 $@ @$*.lb1
+
+!endif
+
+
+gctest.exe: test.obj gc.lib
+        %create $*.lnk
+!ifdef DOS4GW
+        @%append $*.lnk sys dos4g
+!else ifdef MSWIN32
+        @%append $*.lnk sys nt
+!else ifdef OS2
+        @%append $*.lnk sys os2v2
+!endif
+        @%append $*.lnk op case
+        @%append $*.lnk op stack=256K
+        @%append $*.lnk name $*
+        @%append $*.lnk file test.obj
+        @%append $*.lnk library gc.lib
+!ifdef MAKE_AS_DLL
+!ifeq CALLING s
+      @%append $*.lnk import GC_is_marked gc
+!else
+      @%append $*.lnk import GC_is_marked_ gc
+!endif
+!endif
+        *wlink @$*.lnk
+test_cpp.exe: test_cpp.obj gc.lib
+        %create $*.lnk
+!ifdef DOS4GW
+        @%append $*.lnk sys dos4g
+!else ifdef MSWIN32
+        @%append $*.lnk sys nt
+!else ifdef OS2
+        @%append $*.lnk sys os2v2
+!endif
+        @%append $*.lnk op case
+        @%append $*.lnk op stack=256K
+        @%append $*.lnk name $*
+        @%append $*.lnk file test_cpp.obj
+        @%append $*.lnk library gc.lib
+!ifdef MAKE_AS_DLL
+!ifeq CALLING s
+      @%append $*.lnk import GC_incr_words_allocd gc
+      @%append $*.lnk import GC_incr_mem_freed gc
+      @%append $*.lnk import GC_generic_malloc_words_small gc
+!else
+      @%append $*.lnk import GC_incr_words_allocd_ gc
+      @%append $*.lnk import GC_incr_mem_freed_ gc
+      @%append $*.lnk import GC_generic_malloc_words_small_ gc
+!endif
+!endif
+        *wlink @$*.lnk
+
+gc_cpp.obj: gc_cpp.cc .AUTODEPEND
+        $(CXX) $(TEST_CXXFLAGS) -iinclude $*.cc
+test.obj: test.c .AUTODEPEND
+        $(CC) $(TEST_CFLAGS) $*.c
+test_cpp.obj: test_cpp.cc .AUTODEPEND
+        $(CXX) $(TEST_CXXFLAGS) -iinclude $*.cc
+
+
+.c.obj: .AUTODEPEND
+        $(CC) $(CFLAGS) $*.c
+
+.cc.obj: .AUTODEPEND
+        $(CXX) $(CXXFLAGS) $*.cc
+
+clean : .SYMBOLIC
+    @if exist *.obj del *.obj
+    @if exist *.map del *.map
+    @if exist *.lnk del *.lnk
+    @if exist *.lb1 del *.lb1
+    @if exist *.sym del *.sym
+    @if exist *.err del *.err
+    @if exist *.tmp del *.tmp
+    @if exist *.lst del *.lst
+    @if exist *.exe del *.exe
+    @if exist *.log del *.log
+    @if exist *.lib del *.lib
+    @if exist *.dll del *.dll
diff --git a/src/gc/add_gc_prefix.c b/src/gc/add_gc_prefix.c
new file mode 100644
index 000000000..0d1ab6d4d
--- /dev/null
+++ b/src/gc/add_gc_prefix.c
@@ -0,0 +1,14 @@
+# include <stdio.h>
+ 
+int main(argc, argv, envp)
+int argc;
+char ** argv;
+char ** envp;
+{
+    int i;
+    
+    for (i = 1; i < argc; i++) {
+    	printf("gc/%s ", argv[i]);
+    }
+    return(0);
+}
diff --git a/src/gc/allchblk.c b/src/gc/allchblk.c
new file mode 100644
index 000000000..41624c75a
--- /dev/null
+++ b/src/gc/allchblk.c
@@ -0,0 +1,743 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1998-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+#define DEBUG
+#undef DEBUG
+#include <stdio.h>
+#include "gc_priv.h"
+
+GC_bool GC_use_entire_heap = 0;
+
+/*
+ * Free heap blocks are kept on one of several free lists,
+ * depending on the size of the block.  Each free list is doubly linked.
+ * Adjacent free blocks are coalesced.
+ */
+
+ 
+# define MAX_BLACK_LIST_ALLOC (2*HBLKSIZE)
+		/* largest block we will allocate starting on a black   */
+		/* listed block.  Must be >= HBLKSIZE.			*/
+
+
+# define UNIQUE_THRESHOLD 32
+	/* Sizes up to this many HBLKs each have their own free list    */
+# define HUGE_THRESHOLD 256
+	/* Sizes of at least this many heap blocks are mapped to a	*/
+	/* single free list.						*/
+# define FL_COMPRESSION 8
+	/* In between sizes map this many distinct sizes to a single	*/
+	/* bin.								*/
+
+# define N_HBLK_FLS (HUGE_THRESHOLD - UNIQUE_THRESHOLD)/FL_COMPRESSION \
+				 + UNIQUE_THRESHOLD
+
+struct hblk * GC_hblkfreelist[N_HBLK_FLS+1] = { 0 };
+
+/* Map a number of blocks to the appropriate large block free list index. */
+int GC_hblk_fl_from_blocks(blocks_needed)
+word blocks_needed;
+{
+    if (blocks_needed <= UNIQUE_THRESHOLD) return blocks_needed;
+    if (blocks_needed >= HUGE_THRESHOLD) return N_HBLK_FLS;
+    return (blocks_needed - UNIQUE_THRESHOLD)/FL_COMPRESSION
+					+ UNIQUE_THRESHOLD;
+    
+}
+
+# define HBLK_IS_FREE(hdr) ((hdr) -> hb_map == GC_invalid_map)
+# define PHDR(hhdr) HDR(hhdr -> hb_prev)
+# define NHDR(hhdr) HDR(hhdr -> hb_next)
+
+# ifdef USE_MUNMAP
+#   define IS_MAPPED(hhdr) (((hhdr) -> hb_flags & WAS_UNMAPPED) == 0)
+# else  /* !USE_MMAP */
+#   define IS_MAPPED(hhdr) 1
+# endif /* USE_MUNMAP */
+
+# if !defined(NO_DEBUGGING)
+void GC_print_hblkfreelist()
+{
+    struct hblk * h;
+    word total_free = 0;
+    hdr * hhdr;
+    word sz;
+    int i;
+    
+    for (i = 0; i <= N_HBLK_FLS; ++i) {
+      h = GC_hblkfreelist[i];
+      if (0 != h) GC_printf1("Free list %ld:\n", (unsigned long)i);
+      while (h != 0) {
+        hhdr = HDR(h);
+        sz = hhdr -> hb_sz;
+    	GC_printf2("\t0x%lx size %lu ", (unsigned long)h, (unsigned long)sz);
+    	total_free += sz;
+        if (GC_is_black_listed(h, HBLKSIZE) != 0) {
+             GC_printf0("start black listed\n");
+        } else if (GC_is_black_listed(h, hhdr -> hb_sz) != 0) {
+             GC_printf0("partially black listed\n");
+        } else {
+             GC_printf0("not black listed\n");
+        }
+        h = hhdr -> hb_next;
+      }
+    }
+    if (total_free != GC_large_free_bytes) {
+	GC_printf1("GC_large_free_bytes = %lu (INCONSISTENT!!)\n",
+		   (unsigned long) GC_large_free_bytes);
+    }
+    GC_printf1("Total of %lu bytes on free list\n", (unsigned long)total_free);
+}
+
+/* Return the free list index on which the block described by the header */
+/* appears, or -1 if it appears nowhere.				 */
+int free_list_index_of(wanted)
+hdr * wanted;
+{
+    struct hblk * h;
+    hdr * hhdr;
+    int i;
+    
+    for (i = 0; i <= N_HBLK_FLS; ++i) {
+      h = GC_hblkfreelist[i];
+      while (h != 0) {
+        hhdr = HDR(h);
+	if (hhdr == wanted) return i;
+        h = hhdr -> hb_next;
+      }
+    }
+    return -1;
+}
+
+void GC_dump_regions()
+{
+    unsigned i;
+    ptr_t start, end;
+    ptr_t p;
+    size_t bytes;
+    hdr *hhdr;
+    for (i = 0; i < GC_n_heap_sects; ++i) {
+	start = GC_heap_sects[i].hs_start;
+	bytes = GC_heap_sects[i].hs_bytes;
+	end = start + bytes;
+	/* Merge in contiguous sections.	*/
+	  while (i+1 < GC_n_heap_sects && GC_heap_sects[i+1].hs_start == end) {
+	    ++i;
+	    end = GC_heap_sects[i].hs_start + GC_heap_sects[i].hs_bytes;
+	  }
+	GC_printf2("***Section from 0x%lx to 0x%lx\n", start, end);
+	for (p = start; p < end;) {
+	    hhdr = HDR(p);
+	    GC_printf1("\t0x%lx ", (unsigned long)p);
+	    if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+		GC_printf1("Missing header!!\n", hhdr);
+		p += HBLKSIZE;
+		continue;
+	    }
+	    if (HBLK_IS_FREE(hhdr)) {
+                int correct_index = GC_hblk_fl_from_blocks(
+					divHBLKSZ(hhdr -> hb_sz));
+	        int actual_index;
+		
+		GC_printf1("\tfree block of size 0x%lx bytes",
+			   (unsigned long)(hhdr -> hb_sz));
+	 	if (IS_MAPPED(hhdr)) {
+		    GC_printf0("\n");
+		} else {
+		    GC_printf0("(unmapped)\n");
+		}
+		actual_index = free_list_index_of(hhdr);
+		if (-1 == actual_index) {
+		    GC_printf1("\t\tBlock not on free list %ld!!\n",
+				correct_index);
+		} else if (correct_index != actual_index) {
+		    GC_printf2("\t\tBlock on list %ld, should be on %ld!!\n",
+			       actual_index, correct_index);
+		}
+		p += hhdr -> hb_sz;
+	    } else {
+		GC_printf1("\tused for blocks of size 0x%lx bytes\n",
+			   (unsigned long)WORDS_TO_BYTES(hhdr -> hb_sz));
+		p += HBLKSIZE * OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz);
+	    }
+	}
+    }
+}
+
+# endif /* NO_DEBUGGING */
+
+/* Initialize hdr for a block containing the indicated size and 	*/
+/* kind of objects.							*/
+/* Return FALSE on failure.						*/
+static GC_bool setup_header(hhdr, sz, kind, flags)
+register hdr * hhdr;
+word sz;	/* object size in words */
+int kind;
+unsigned char flags;
+{
+    register word descr;
+    
+    /* Add description of valid object pointers */
+      if (!GC_add_map_entry(sz)) return(FALSE);
+      hhdr -> hb_map = GC_obj_map[sz > MAXOBJSZ? 0 : sz];
+      
+    /* Set size, kind and mark proc fields */
+      hhdr -> hb_sz = sz;
+      hhdr -> hb_obj_kind = kind;
+      hhdr -> hb_flags = flags;
+      descr = GC_obj_kinds[kind].ok_descriptor;
+      if (GC_obj_kinds[kind].ok_relocate_descr) descr += WORDS_TO_BYTES(sz);
+      hhdr -> hb_descr = descr;
+      
+    /* Clear mark bits */
+      GC_clear_hdr_marks(hhdr);
+      
+    hhdr -> hb_last_reclaimed = (unsigned short)GC_gc_no;
+    return(TRUE);
+}
+
+#define FL_UNKNOWN -1
+/*
+ * Remove hhdr from the appropriate free list.
+ * We assume it is on the nth free list, or on the size
+ * appropriate free list if n is FL_UNKNOWN.
+ */
+void GC_remove_from_fl(hhdr, n)
+hdr * hhdr;
+int n;
+{
+    GC_ASSERT(((hhdr -> hb_sz) & (HBLKSIZE-1)) == 0);
+    if (hhdr -> hb_prev == 0) {
+        int index;
+	if (FL_UNKNOWN == n) {
+            index = GC_hblk_fl_from_blocks(divHBLKSZ(hhdr -> hb_sz));
+	} else {
+	    index = n;
+	}
+	GC_ASSERT(HDR(GC_hblkfreelist[index]) == hhdr);
+	GC_hblkfreelist[index] = hhdr -> hb_next;
+    } else {
+	hdr *phdr;
+	GET_HDR(hhdr -> hb_prev, phdr);
+	phdr -> hb_next = hhdr -> hb_next;
+    }
+    if (0 != hhdr -> hb_next) {
+	hdr * nhdr;
+	GC_ASSERT(!IS_FORWARDING_ADDR_OR_NIL(NHDR(hhdr)));
+	GET_HDR(hhdr -> hb_next, nhdr);
+	nhdr -> hb_prev = hhdr -> hb_prev;
+    }
+}
+
+/*
+ * Return a pointer to the free block ending just before h, if any.
+ */
+struct hblk * GC_free_block_ending_at(h)
+struct hblk *h;
+{
+    struct hblk * p = h - 1;
+    hdr * phdr;
+
+    GET_HDR(p, phdr);
+    while (0 != phdr && IS_FORWARDING_ADDR_OR_NIL(phdr)) {
+	p = FORWARDED_ADDR(p,phdr);
+	phdr = HDR(p);
+    }
+    if (0 != phdr) {
+        if(HBLK_IS_FREE(phdr)) {
+	    return p;
+	} else {
+	    return 0;
+	}
+    }
+    p = GC_prev_block(h - 1);
+    if (0 != p) {
+      phdr = HDR(p);
+      if (HBLK_IS_FREE(phdr) && (ptr_t)p + phdr -> hb_sz == (ptr_t)h) {
+	return p;
+      }
+    }
+    return 0;
+}
+
+/*
+ * Add hhdr to the appropriate free list.
+ * We maintain individual free lists sorted by address.
+ */
+void GC_add_to_fl(h, hhdr)
+struct hblk *h;
+hdr * hhdr;
+{
+    int index = GC_hblk_fl_from_blocks(divHBLKSZ(hhdr -> hb_sz));
+    struct hblk *second = GC_hblkfreelist[index];
+    hdr * second_hdr;
+#   ifdef GC_ASSERTIONS
+      struct hblk *next = (struct hblk *)((word)h + hhdr -> hb_sz);
+      hdr * nexthdr = HDR(next);
+      struct hblk *prev = GC_free_block_ending_at(h);
+      hdr * prevhdr = HDR(prev);
+      GC_ASSERT(nexthdr == 0 || !HBLK_IS_FREE(nexthdr) || !IS_MAPPED(nexthdr));
+      GC_ASSERT(prev == 0 || !HBLK_IS_FREE(prevhdr) || !IS_MAPPED(prevhdr));
+#   endif
+    GC_ASSERT(((hhdr -> hb_sz) & (HBLKSIZE-1)) == 0);
+    GC_hblkfreelist[index] = h;
+    hhdr -> hb_next = second;
+    hhdr -> hb_prev = 0;
+    if (0 != second) {
+      GET_HDR(second, second_hdr);
+      second_hdr -> hb_prev = h;
+    }
+    GC_invalidate_map(hhdr);
+}
+
+#ifdef USE_MUNMAP
+
+/* Unmap blocks that haven't been recently touched.  This is the only way */
+/* way blocks are ever unmapped.					  */
+void GC_unmap_old(void)
+{
+    struct hblk * h;
+    hdr * hhdr;
+    word sz;
+    unsigned short last_rec, threshold;
+    int i;
+#   define UNMAP_THRESHOLD 6
+    
+    for (i = 0; i <= N_HBLK_FLS; ++i) {
+      for (h = GC_hblkfreelist[i]; 0 != h; h = hhdr -> hb_next) {
+        hhdr = HDR(h);
+	if (!IS_MAPPED(hhdr)) continue;
+	threshold = (unsigned short)(GC_gc_no - UNMAP_THRESHOLD);
+	last_rec = hhdr -> hb_last_reclaimed;
+	if (last_rec > GC_gc_no
+	    || last_rec < threshold && threshold < GC_gc_no
+				       /* not recently wrapped */) {
+          sz = hhdr -> hb_sz;
+	  GC_unmap((ptr_t)h, sz);
+	  hhdr -> hb_flags |= WAS_UNMAPPED;
+    	}
+      }
+    }  
+}
+
+/* Merge all unmapped blocks that are adjacent to other free		*/
+/* blocks.  This may involve remapping, since all blocks are either	*/
+/* fully mapped or fully unmapped.					*/
+void GC_merge_unmapped(void)
+{
+    struct hblk * h, *next;
+    hdr * hhdr, *nexthdr;
+    word size, nextsize;
+    int i;
+    
+    for (i = 0; i <= N_HBLK_FLS; ++i) {
+      h = GC_hblkfreelist[i];
+      while (h != 0) {
+	GET_HDR(h, hhdr);
+	size = hhdr->hb_sz;
+	next = (struct hblk *)((word)h + size);
+	GET_HDR(next, nexthdr);
+	/* Coalesce with successor, if possible */
+	  if (0 != nexthdr && HBLK_IS_FREE(nexthdr)) {
+	    nextsize = nexthdr -> hb_sz;
+	    if (IS_MAPPED(hhdr)) {
+	      GC_ASSERT(!IS_MAPPED(nexthdr));
+	      /* make both consistent, so that we can merge */
+	        if (size > nextsize) {
+		  GC_remap((ptr_t)next, nextsize);
+		} else {
+		  GC_unmap((ptr_t)h, size);
+		  hhdr -> hb_flags |= WAS_UNMAPPED;
+		}
+	    } else if (IS_MAPPED(nexthdr)) {
+	      GC_ASSERT(!IS_MAPPED(hhdr));
+	      if (size > nextsize) {
+		GC_unmap((ptr_t)next, nextsize);
+	      } else {
+		GC_remap((ptr_t)h, size);
+		hhdr -> hb_flags &= ~WAS_UNMAPPED;
+	      }
+	    } else {
+	      /* Unmap any gap in the middle */
+		GC_unmap_gap((ptr_t)h, size, (ptr_t)next, nexthdr -> hb_sz);
+	    }
+	    /* If they are both unmapped, we merge, but leave unmapped. */
+	    GC_remove_from_fl(hhdr, i);
+	    GC_remove_from_fl(nexthdr, FL_UNKNOWN);
+	    hhdr -> hb_sz += nexthdr -> hb_sz; 
+	    GC_remove_header(next);
+	    GC_add_to_fl(h, hhdr); 
+	    /* Start over at beginning of list */
+	    h = GC_hblkfreelist[i];
+	  } else /* not mergable with successor */ {
+	    h = hhdr -> hb_next;
+	  }
+      } /* while (h != 0) ... */
+    } /* for ... */
+}
+
+#endif /* USE_MUNMAP */
+
+/*
+ * Return a pointer to a block starting at h of length bytes.
+ * Memory for the block is mapped.
+ * Remove the block from its free list, and return the remainder (if any)
+ * to its appropriate free list.
+ * May fail by returning 0.
+ * The header for the returned block must be set up by the caller.
+ * If the return value is not 0, then hhdr is the header for it.
+ */
+struct hblk * GC_get_first_part(h, hhdr, bytes, index)
+struct hblk *h;
+hdr * hhdr;
+word bytes;
+int index;
+{
+    word total_size = hhdr -> hb_sz;
+    struct hblk * rest;
+    hdr * rest_hdr;
+
+    GC_ASSERT((total_size & (HBLKSIZE-1)) == 0);
+    GC_remove_from_fl(hhdr, index);
+    if (total_size == bytes) return h;
+    rest = (struct hblk *)((word)h + bytes);
+    rest_hdr = GC_install_header(rest);
+    if (0 == rest_hdr) return(0);
+    rest_hdr -> hb_sz = total_size - bytes;
+    rest_hdr -> hb_flags = 0;
+#   ifdef GC_ASSERTIONS
+      // Mark h not free, to avoid assertion about adjacent free blocks.
+        hhdr -> hb_map = 0;
+#   endif
+    GC_add_to_fl(rest, rest_hdr);
+    return h;
+}
+
+/*
+ * H is a free block.  N points at an address inside it.
+ * A new header for n has already been set up.  Fix up h's header
+ * to reflect the fact that it is being split, move it to the
+ * appropriate free list.
+ * N replaces h in the original free list.
+ *
+ * Nhdr is not completely filled in, since it is about to allocated.
+ * It may in fact end up on the wrong free list for its size.
+ * (Hence adding it to a free list is silly.  But this path is hopefully
+ * rare enough that it doesn't matter.  The code is cleaner this way.)
+ */
+void GC_split_block(h, hhdr, n, nhdr, index)
+struct hblk *h;
+hdr * hhdr;
+struct hblk *n;
+hdr * nhdr;
+int index;	/* Index of free list */
+{
+    word total_size = hhdr -> hb_sz;
+    word h_size = (word)n - (word)h;
+    struct hblk *prev = hhdr -> hb_prev;
+    struct hblk *next = hhdr -> hb_next;
+
+    /* Replace h with n on its freelist */
+      nhdr -> hb_prev = prev;
+      nhdr -> hb_next = next;
+      nhdr -> hb_sz = total_size - h_size;
+      nhdr -> hb_flags = 0;
+      if (0 != prev) {
+	HDR(prev) -> hb_next = n;
+      } else {
+        GC_hblkfreelist[index] = n;
+      }
+      if (0 != next) {
+	HDR(next) -> hb_prev = n;
+      }
+#     ifdef GC_ASSERTIONS
+	nhdr -> hb_map = 0;	/* Don't fail test for consecutive	*/
+				/* free blocks in GC_add_to_fl.		*/
+#     endif
+#   ifdef USE_MUNMAP
+      hhdr -> hb_last_reclaimed = GC_gc_no;
+#   endif
+    hhdr -> hb_sz = h_size;
+    GC_add_to_fl(h, hhdr);
+    GC_invalidate_map(nhdr);
+}
+	
+struct hblk * GC_allochblk_nth();
+
+/*
+ * Allocate (and return pointer to) a heap block
+ *   for objects of size sz words, searching the nth free list.
+ *
+ * NOTE: We set obj_map field in header correctly.
+ *       Caller is responsible for building an object freelist in block.
+ *
+ * We clear the block if it is destined for large objects, and if
+ * kind requires that newly allocated objects be cleared.
+ */
+struct hblk *
+GC_allochblk(sz, kind, flags)
+word sz;
+int kind;
+unsigned char flags;  /* IGNORE_OFF_PAGE or 0 */
+{
+    int start_list = GC_hblk_fl_from_blocks(OBJ_SZ_TO_BLOCKS(sz));
+    int i;
+    for (i = start_list; i <= N_HBLK_FLS; ++i) {
+	struct hblk * result = GC_allochblk_nth(sz, kind, flags, i);
+	if (0 != result) return result;
+    }
+    return 0;
+}
+/*
+ * The same, but with search restricted to nth free list.
+ */
+struct hblk *
+GC_allochblk_nth(sz, kind, flags, n)
+word sz;
+int kind;
+unsigned char flags;  /* IGNORE_OFF_PAGE or 0 */
+int n;
+{
+    register struct hblk *hbp;
+    register hdr * hhdr;		/* Header corr. to hbp */
+    register struct hblk *thishbp;
+    register hdr * thishdr;		/* Header corr. to hbp */
+    signed_word size_needed;    /* number of bytes in requested objects */
+    signed_word size_avail;	/* bytes available in this block	*/
+
+    size_needed = HBLKSIZE * OBJ_SZ_TO_BLOCKS(sz);
+
+    /* search for a big enough block in free list */
+	hbp = GC_hblkfreelist[n];
+	for(; 0 != hbp; hbp = hhdr -> hb_next) {
+	    GET_HDR(hbp, hhdr);
+	    size_avail = hhdr->hb_sz;
+	    if (size_avail < size_needed) continue;
+	    if (!GC_use_entire_heap) {
+		if (size_avail != size_needed
+		    && USED_HEAP_SIZE >= GC_requested_heapsize
+		    && !GC_incremental && GC_should_collect()) {
+		    continue;
+		} 
+	    }
+	    /* If the next heap block is obviously better, go on.	*/
+	    /* This prevents us from disassembling a single large block */
+	    /* to get tiny blocks.					*/
+	    {
+	      signed_word next_size;
+	      
+	      thishbp = hhdr -> hb_next;
+	      if (thishbp != 0) {
+		GET_HDR(thishbp, thishdr);
+	        next_size = (signed_word)(thishdr -> hb_sz);
+	        if (next_size < size_avail
+	          && next_size >= size_needed
+	          && !GC_is_black_listed(thishbp, (word)size_needed)) {
+	          continue;
+	        }
+	      }
+	    }
+	    if ( !IS_UNCOLLECTABLE(kind) &&
+	         (kind != PTRFREE || size_needed > MAX_BLACK_LIST_ALLOC)) {
+	      struct hblk * lasthbp = hbp;
+	      ptr_t search_end = (ptr_t)hbp + size_avail - size_needed;
+	      signed_word orig_avail = size_avail;
+	      signed_word eff_size_needed = ((flags & IGNORE_OFF_PAGE)?
+	      					HBLKSIZE
+	      					: size_needed);
+	      
+	      
+	      while ((ptr_t)lasthbp <= search_end
+	             && (thishbp = GC_is_black_listed(lasthbp,
+	             				      (word)eff_size_needed))) {
+	        lasthbp = thishbp;
+	      }
+	      size_avail -= (ptr_t)lasthbp - (ptr_t)hbp;
+	      thishbp = lasthbp;
+	      if (size_avail >= size_needed) {
+	        if (thishbp != hbp &&
+		    0 != (thishdr = GC_install_header(thishbp))) {
+		  /* Make sure it's mapped before we mangle it. */
+#		    ifdef USE_MUNMAP
+		      if (!IS_MAPPED(hhdr)) {
+		        GC_remap((ptr_t)hbp, hhdr -> hb_sz);
+		        hhdr -> hb_flags &= ~WAS_UNMAPPED;
+		      }
+#		    endif
+	          /* Split the block at thishbp */
+		      GC_split_block(hbp, hhdr, thishbp, thishdr, n);
+		  /* Advance to thishbp */
+		      hbp = thishbp;
+		      hhdr = thishdr;
+		      /* We must now allocate thishbp, since it may	*/
+		      /* be on the wrong free list.			*/
+		}
+	      } else if (size_needed > (signed_word)BL_LIMIT
+	                 && orig_avail - size_needed
+			    > (signed_word)BL_LIMIT) {
+	        /* Punt, since anything else risks unreasonable heap growth. */
+	        WARN("Needed to allocate blacklisted block at 0x%lx\n",
+		     (word)hbp);
+	        size_avail = orig_avail;
+	      } else if (size_avail == 0 && size_needed == HBLKSIZE
+			 && IS_MAPPED(hhdr)) {
+		if (!GC_find_leak) {
+	      	  static unsigned count = 0;
+	      	  
+	      	  /* The block is completely blacklisted.  We need 	*/
+	      	  /* to drop some such blocks, since otherwise we spend */
+	      	  /* all our time traversing them if pointerfree	*/
+	      	  /* blocks are unpopular.				*/
+	          /* A dropped block will be reconsidered at next GC.	*/
+	          if ((++count & 3) == 0) {
+	            /* Allocate and drop the block in small chunks, to	*/
+	            /* maximize the chance that we will recover some	*/
+	            /* later.						*/
+		      word total_size = hhdr -> hb_sz;
+	              struct hblk * limit = hbp + divHBLKSZ(total_size);
+	              struct hblk * h;
+		      struct hblk * prev = hhdr -> hb_prev;
+	              
+		      GC_words_wasted += total_size;
+		      GC_large_free_bytes -= total_size;
+		      GC_remove_from_fl(hhdr, n);
+	              for (h = hbp; h < limit; h++) {
+	                if (h == hbp || 0 != (hhdr = GC_install_header(h))) {
+	                  (void) setup_header(
+	                	  hhdr,
+	              		  BYTES_TO_WORDS(HBLKSIZE - HDR_BYTES),
+	              		  PTRFREE, 0); /* Cant fail */
+	              	  if (GC_debugging_started) {
+	              	    BZERO(h + HDR_BYTES, HBLKSIZE - HDR_BYTES);
+	              	  }
+	                }
+	              }
+	            /* Restore hbp to point at free block */
+		      hbp = prev;
+		      if (0 == hbp) {
+			return GC_allochblk_nth(sz, kind, flags, n);
+		      }
+	   	      hhdr = HDR(hbp);
+	          }
+		}
+	      }
+	    }
+	    if( size_avail >= size_needed ) {
+#		ifdef USE_MUNMAP
+		  if (!IS_MAPPED(hhdr)) {
+		    GC_remap((ptr_t)hbp, hhdr -> hb_sz);
+		    hhdr -> hb_flags &= ~WAS_UNMAPPED;
+		  }
+#	        endif
+		/* hbp may be on the wrong freelist; the parameter n	*/
+		/* is important.					*/
+		hbp = GC_get_first_part(hbp, hhdr, size_needed, n);
+		break;
+	    }
+	}
+
+    if (0 == hbp) return 0;
+	
+    /* Notify virtual dirty bit implementation that we are about to write. */
+    	GC_write_hint(hbp);
+    
+    /* Add it to map of valid blocks */
+    	if (!GC_install_counts(hbp, (word)size_needed)) return(0);
+    	/* This leaks memory under very rare conditions. */
+    		
+    /* Set up header */
+        if (!setup_header(hhdr, sz, kind, flags)) {
+            GC_remove_counts(hbp, (word)size_needed);
+            return(0); /* ditto */
+        }
+        
+    /* Clear block if necessary */
+	if (GC_debugging_started
+	    || sz > MAXOBJSZ && GC_obj_kinds[kind].ok_init) {
+	    BZERO(hbp + HDR_BYTES,  size_needed - HDR_BYTES);
+	}
+
+    /* We just successfully allocated a block.  Restart count of	*/
+    /* consecutive failures.						*/
+    {
+	extern unsigned GC_fail_count;
+	
+	GC_fail_count = 0;
+    }
+
+    GC_large_free_bytes -= size_needed;
+    
+    GC_ASSERT(IS_MAPPED(hhdr));
+    return( hbp );
+}
+ 
+struct hblk * GC_freehblk_ptr = 0;  /* Search position hint for GC_freehblk */
+
+/*
+ * Free a heap block.
+ *
+ * Coalesce the block with its neighbors if possible.
+ *
+ * All mark words are assumed to be cleared.
+ */
+void
+GC_freehblk(hbp)
+struct hblk *hbp;
+{
+struct hblk *next, *prev;
+hdr *hhdr, *prevhdr, *nexthdr;
+signed_word size;
+
+
+    GET_HDR(hbp, hhdr);
+    size = hhdr->hb_sz;
+    size = HBLKSIZE * OBJ_SZ_TO_BLOCKS(size);
+    GC_remove_counts(hbp, (word)size);
+    hhdr->hb_sz = size;
+    
+    /* Check for duplicate deallocation in the easy case */
+      if (HBLK_IS_FREE(hhdr)) {
+        GC_printf1("Duplicate large block deallocation of 0x%lx\n",
+        	   (unsigned long) hbp);
+      }
+
+    GC_ASSERT(IS_MAPPED(hhdr));
+    GC_invalidate_map(hhdr);
+    next = (struct hblk *)((word)hbp + size);
+    GET_HDR(next, nexthdr);
+    prev = GC_free_block_ending_at(hbp);
+    /* Coalesce with successor, if possible */
+      if(0 != nexthdr && HBLK_IS_FREE(nexthdr) && IS_MAPPED(nexthdr)) {
+	GC_remove_from_fl(nexthdr, FL_UNKNOWN);
+	hhdr -> hb_sz += nexthdr -> hb_sz; 
+	GC_remove_header(next);
+      }
+    /* Coalesce with predecessor, if possible. */
+      if (0 != prev) {
+	prevhdr = HDR(prev);
+	if (IS_MAPPED(prevhdr)) {
+	  GC_remove_from_fl(prevhdr, FL_UNKNOWN);
+	  prevhdr -> hb_sz += hhdr -> hb_sz;
+	  GC_remove_header(hbp);
+	  hbp = prev;
+	  hhdr = prevhdr;
+	}
+      }
+
+    GC_large_free_bytes += size;
+    GC_add_to_fl(hbp, hhdr);    
+}
+
diff --git a/src/gc/alloc.c b/src/gc/alloc.c
new file mode 100644
index 000000000..233bfb962
--- /dev/null
+++ b/src/gc/alloc.c
@@ -0,0 +1,905 @@
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1996 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1998 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+
+
+# include "gc_priv.h"
+
+# include <stdio.h>
+# ifndef MACOS
+#   include <signal.h>
+#   include <sys/types.h>
+# endif
+
+/*
+ * Separate free lists are maintained for different sized objects
+ * up to MAXOBJSZ.
+ * The call GC_allocobj(i,k) ensures that the freelist for
+ * kind k objects of size i points to a non-empty
+ * free list. It returns a pointer to the first entry on the free list.
+ * In a single-threaded world, GC_allocobj may be called to allocate
+ * an object of (small) size i as follows:
+ *
+ *            opp = &(GC_objfreelist[i]);
+ *            if (*opp == 0) GC_allocobj(i, NORMAL);
+ *            ptr = *opp;
+ *            *opp = obj_link(ptr);
+ *
+ * Note that this is very fast if the free list is non-empty; it should
+ * only involve the execution of 4 or 5 simple instructions.
+ * All composite objects on freelists are cleared, except for
+ * their first word.
+ */
+
+/*
+ *  The allocator uses GC_allochblk to allocate large chunks of objects.
+ * These chunks all start on addresses which are multiples of
+ * HBLKSZ.   Each allocated chunk has an associated header,
+ * which can be located quickly based on the address of the chunk.
+ * (See headers.c for details.) 
+ * This makes it possible to check quickly whether an
+ * arbitrary address corresponds to an object administered by the
+ * allocator.
+ */
+
+word GC_non_gc_bytes = 0;  /* Number of bytes not intended to be collected */
+
+word GC_gc_no = 0;
+
+#ifndef SMALL_CONFIG
+  int GC_incremental = 0;    /* By default, stop the world.	*/
+#endif
+
+int GC_full_freq = 19;	   /* Every 20th collection is a full	*/
+			   /* collection, whether we need it 	*/
+			   /* or not.			        */
+
+GC_bool GC_need_full_gc = FALSE;
+			   /* Need full GC do to heap growth.	*/
+
+word GC_used_heap_size_after_full = 0;
+
+char * GC_copyright[] =
+{"Copyright 1988,1989 Hans-J. Boehm and Alan J. Demers ",
+"Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved. ",
+"Copyright (c) 1996-1998 by Silicon Graphics.  All rights reserved. ",
+"THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY",
+" EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.",
+"See source code for details." };
+
+# include "version.h"
+
+/* some more variables */
+
+extern signed_word GC_mem_found;  /* Number of reclaimed longwords	*/
+				  /* after garbage collection      	*/
+
+GC_bool GC_dont_expand = 0;
+
+word GC_free_space_divisor = 3;
+
+extern GC_bool GC_collection_in_progress();
+		/* Collection is in progress, or was abandoned.	*/
+
+int GC_never_stop_func GC_PROTO((void)) { return(0); }
+
+CLOCK_TYPE GC_start_time;  	/* Time at which we stopped world.	*/
+				/* used only in GC_timeout_stop_func.	*/
+
+int GC_n_attempts = 0;		/* Number of attempts at finishing	*/
+				/* collection within TIME_LIMIT		*/
+
+#ifdef SMALL_CONFIG
+#   define GC_timeout_stop_func GC_never_stop_func
+#else
+  int GC_timeout_stop_func GC_PROTO((void))
+  {
+    CLOCK_TYPE current_time;
+    static unsigned count = 0;
+    unsigned long time_diff;
+    
+    if ((count++ & 3) != 0) return(0);
+    GET_TIME(current_time);
+    time_diff = MS_TIME_DIFF(current_time,GC_start_time);
+    if (time_diff >= TIME_LIMIT) {
+#   	ifdef PRINTSTATS
+	    GC_printf0("Abandoning stopped marking after ");
+	    GC_printf1("%lu msecs", (unsigned long)time_diff);
+	    GC_printf1("(attempt %d)\n", (unsigned long) GC_n_attempts);
+#	endif
+    	return(1);
+    }
+    return(0);
+  }
+#endif /* !SMALL_CONFIG */
+
+/* Return the minimum number of words that must be allocated between	*/
+/* collections to amortize the collection cost.				*/
+static word min_words_allocd()
+{
+#   ifdef THREADS
+ 	/* We punt, for now. */
+ 	register signed_word stack_size = 10000;
+#   else
+        int dummy;
+        register signed_word stack_size = (ptr_t)(&dummy) - GC_stackbottom;
+#   endif
+    word total_root_size;  	    /* includes double stack size,	*/
+    				    /* since the stack is expensive	*/
+    				    /* to scan.				*/
+    word scan_size;		/* Estimate of memory to be scanned 	*/
+				/* during normal GC.			*/
+    
+    if (stack_size < 0) stack_size = -stack_size;
+    total_root_size = 2 * stack_size + GC_root_size;
+    scan_size = BYTES_TO_WORDS(GC_heapsize - GC_large_free_bytes
+			       + (GC_large_free_bytes >> 2)
+				   /* use a bit more of large empty heap */
+			       + total_root_size);
+    if (GC_incremental) {
+        return scan_size / (2 * GC_free_space_divisor);
+    } else {
+        return scan_size / GC_free_space_divisor;
+    }
+}
+
+/* Return the number of words allocated, adjusted for explicit storage	*/
+/* management, etc..  This number is used in deciding when to trigger	*/
+/* collections.								*/
+word GC_adj_words_allocd()
+{
+    register signed_word result;
+    register signed_word expl_managed =
+    		BYTES_TO_WORDS((long)GC_non_gc_bytes
+    				- (long)GC_non_gc_bytes_at_gc);
+    
+    /* Don't count what was explicitly freed, or newly allocated for	*/
+    /* explicit management.  Note that deallocating an explicitly	*/
+    /* managed object should not alter result, assuming the client	*/
+    /* is playing by the rules.						*/
+    result = (signed_word)GC_words_allocd
+    	     - (signed_word)GC_mem_freed - expl_managed;
+    if (result > (signed_word)GC_words_allocd) {
+        result = GC_words_allocd;
+    	/* probably client bug or unfortunate scheduling */
+    }
+    result += GC_words_finalized;
+    	/* We count objects enqueued for finalization as though they	*/
+    	/* had been reallocated this round. Finalization is user	*/
+    	/* visible progress.  And if we don't count this, we have	*/
+    	/* stability problems for programs that finalize all objects.	*/
+    result += GC_words_wasted;
+     	/* This doesn't reflect useful work.  But if there is lots of	*/
+     	/* new fragmentation, the same is probably true of the heap,	*/
+     	/* and the collection will be correspondingly cheaper.		*/
+    if (result < (signed_word)(GC_words_allocd >> 3)) {
+    	/* Always count at least 1/8 of the allocations.  We don't want	*/
+    	/* to collect too infrequently, since that would inhibit	*/
+    	/* coalescing of free storage blocks.				*/
+    	/* This also makes us partially robust against client bugs.	*/
+        return(GC_words_allocd >> 3);
+    } else {
+        return(result);
+    }
+}
+
+
+/* Clear up a few frames worth of garbage left at the top of the stack.	*/
+/* This is used to prevent us from accidentally treating garbade left	*/
+/* on the stack by other parts of the collector as roots.  This 	*/
+/* differs from the code in misc.c, which actually tries to keep the	*/
+/* stack clear of long-lived, client-generated garbage.			*/
+void GC_clear_a_few_frames()
+{
+#   define NWORDS 64
+    word frames[NWORDS];
+    register int i;
+    
+    for (i = 0; i < NWORDS; i++) frames[i] = 0;
+}
+
+/* Have we allocated enough to amortize a collection? */
+GC_bool GC_should_collect()
+{
+    return(GC_adj_words_allocd() >= min_words_allocd());
+}
+
+
+void GC_notify_full_gc()
+{
+    if (GC_start_call_back != (void (*)())0) {
+	(*GC_start_call_back)();
+    }
+}
+
+GC_bool GC_is_full_gc = FALSE;
+
+/* 
+ * Initiate a garbage collection if appropriate.
+ * Choose judiciously
+ * between partial, full, and stop-world collections.
+ * Assumes lock held, signals disabled.
+ */
+void GC_maybe_gc()
+{
+    static int n_partial_gcs = 0;
+
+    if (GC_should_collect()) {
+        if (!GC_incremental) {
+	    GC_notify_full_gc();
+            GC_gcollect_inner();
+            n_partial_gcs = 0;
+            return;
+        } else if (GC_need_full_gc || n_partial_gcs >= GC_full_freq) {
+#   	    ifdef PRINTSTATS
+	      GC_printf2(
+	        "***>Full mark for collection %lu after %ld allocd bytes\n",
+     		(unsigned long) GC_gc_no+1,
+	   	(long)WORDS_TO_BYTES(GC_words_allocd));
+#           endif
+	    GC_promote_black_lists();
+	    (void)GC_reclaim_all((GC_stop_func)0, TRUE);
+	    GC_clear_marks();
+            n_partial_gcs = 0;
+	    GC_notify_full_gc();
+ 	    GC_is_full_gc = TRUE;
+        } else {
+            n_partial_gcs++;
+        }
+        /* We try to mark with the world stopped.	*/
+        /* If we run out of time, this turns into	*/
+        /* incremental marking.			*/
+        GET_TIME(GC_start_time);
+        if (GC_stopped_mark(GC_timeout_stop_func)) {
+#           ifdef SAVE_CALL_CHAIN
+                GC_save_callers(GC_last_stack);
+#           endif
+            GC_finish_collection();
+        } else {
+	    if (!GC_is_full_gc) {
+		/* Count this as the first attempt */
+	        GC_n_attempts++;
+	    }
+	}
+    }
+}
+
+
+/*
+ * Stop the world garbage collection.  Assumes lock held, signals disabled.
+ * If stop_func is not GC_never_stop_func, then abort if stop_func returns TRUE.
+ */
+GC_bool GC_try_to_collect_inner(stop_func)
+GC_stop_func stop_func;
+{
+    if (GC_incremental && GC_collection_in_progress()) {
+#   ifdef PRINTSTATS
+	GC_printf0(
+	    "GC_try_to_collect_inner: finishing collection in progress\n");
+#    endif /* PRINTSTATS */
+      /* Just finish collection already in progress.	*/
+    	while(GC_collection_in_progress()) {
+    	    if (stop_func()) return(FALSE);
+    	    GC_collect_a_little_inner(1);
+    	}
+    }
+#   ifdef PRINTSTATS
+	GC_printf2(
+	   "Initiating full world-stop collection %lu after %ld allocd bytes\n",
+	   (unsigned long) GC_gc_no+1,
+	   (long)WORDS_TO_BYTES(GC_words_allocd));
+#   endif
+    GC_promote_black_lists();
+    /* Make sure all blocks have been reclaimed, so sweep routines	*/
+    /* don't see cleared mark bits.					*/
+    /* If we're guaranteed to finish, then this is unnecessary.		*/
+	if (stop_func != GC_never_stop_func
+	    && !GC_reclaim_all(stop_func, FALSE)) {
+	    /* Aborted.  So far everything is still consistent.	*/
+	    return(FALSE);
+	}
+    GC_invalidate_mark_state();  /* Flush mark stack.	*/
+    GC_clear_marks();
+#   ifdef SAVE_CALL_CHAIN
+        GC_save_callers(GC_last_stack);
+#   endif
+    GC_is_full_gc = TRUE;
+    if (!GC_stopped_mark(stop_func)) {
+      if (!GC_incremental) {
+    	/* We're partially done and have no way to complete or use 	*/
+    	/* current work.  Reestablish invariants as cheaply as		*/
+    	/* possible.							*/
+    	GC_invalidate_mark_state();
+	GC_unpromote_black_lists();
+      } /* else we claim the world is already still consistent.  We'll 	*/
+        /* finish incrementally.					*/
+      return(FALSE);
+    }
+    GC_finish_collection();
+    return(TRUE);
+}
+
+
+
+/*
+ * Perform n units of garbage collection work.  A unit is intended to touch
+ * roughly GC_RATE pages.  Every once in a while, we do more than that.
+ * This needa to be a fairly large number with our current incremental
+ * GC strategy, since otherwise we allocate too much during GC, and the
+ * cleanup gets expensive.
+ */
+# define GC_RATE 10 
+# define MAX_PRIOR_ATTEMPTS 1
+ 	/* Maximum number of prior attempts at world stop marking	*/
+ 	/* A value of 1 means that we finish the seconf time, no matter */
+ 	/* how long it takes.  Doesn't count the initial root scan	*/
+ 	/* for a full GC.						*/
+
+int GC_deficit = 0;	/* The number of extra calls to GC_mark_some	*/
+			/* that we have made.				*/
+
+void GC_collect_a_little_inner(n)
+int n;
+{
+    register int i;
+    
+    if (GC_incremental && GC_collection_in_progress()) {
+    	for (i = GC_deficit; i < GC_RATE*n; i++) {
+    	    if (GC_mark_some((ptr_t)0)) {
+    	        /* Need to finish a collection */
+#     		ifdef SAVE_CALL_CHAIN
+        	    GC_save_callers(GC_last_stack);
+#     		endif
+		if (GC_n_attempts < MAX_PRIOR_ATTEMPTS) {
+		  GET_TIME(GC_start_time);
+		  if (!GC_stopped_mark(GC_timeout_stop_func)) {
+		    GC_n_attempts++;
+		    break;
+		  }
+		} else {
+		  (void)GC_stopped_mark(GC_never_stop_func);
+		}
+    	        GC_finish_collection();
+    	        break;
+    	    }
+    	}
+    	if (GC_deficit > 0) GC_deficit -= GC_RATE*n;
+	if (GC_deficit < 0) GC_deficit = 0;
+    } else {
+        GC_maybe_gc();
+    }
+}
+
+int GC_collect_a_little GC_PROTO(())
+{
+    int result;
+    DCL_LOCK_STATE;
+
+    DISABLE_SIGNALS();
+    LOCK();
+    GC_collect_a_little_inner(1);
+    result = (int)GC_collection_in_progress();
+    UNLOCK();
+    ENABLE_SIGNALS();
+    return(result);
+}
+
+/*
+ * Assumes lock is held, signals are disabled.
+ * We stop the world.
+ * If stop_func() ever returns TRUE, we may fail and return FALSE.
+ * Increment GC_gc_no if we succeed.
+ */
+GC_bool GC_stopped_mark(stop_func)
+GC_stop_func stop_func;
+{
+    register int i;
+    int dummy;
+#   ifdef PRINTSTATS
+	CLOCK_TYPE start_time, current_time;
+#   endif
+	
+    STOP_WORLD();
+#   ifdef PRINTSTATS
+	GET_TIME(start_time);
+	GC_printf1("--> Marking for collection %lu ",
+	           (unsigned long) GC_gc_no + 1);
+	GC_printf2("after %lu allocd bytes + %lu wasted bytes\n",
+	   	   (unsigned long) WORDS_TO_BYTES(GC_words_allocd),
+	   	   (unsigned long) WORDS_TO_BYTES(GC_words_wasted));
+#   endif
+
+    /* Mark from all roots.  */
+        /* Minimize junk left in my registers and on the stack */
+            GC_clear_a_few_frames();
+            GC_noop(0,0,0,0,0,0);
+	GC_initiate_gc();
+	for(i = 0;;i++) {
+	    if ((*stop_func)()) {
+#   		    ifdef PRINTSTATS
+		    	GC_printf0("Abandoned stopped marking after ");
+			GC_printf1("%lu iterations\n",
+				   (unsigned long)i);
+#		    endif
+		    GC_deficit = i; /* Give the mutator a chance. */
+	            START_WORLD();
+	            return(FALSE);
+	    }
+	    if (GC_mark_some((ptr_t)(&dummy))) break;
+	}
+	
+    GC_gc_no++;
+#   ifdef PRINTSTATS
+      GC_printf2("Collection %lu reclaimed %ld bytes",
+		  (unsigned long) GC_gc_no - 1,
+	   	  (long)WORDS_TO_BYTES(GC_mem_found));
+      GC_printf1(" ---> heapsize = %lu bytes\n",
+      	        (unsigned long) GC_heapsize);
+      /* Printf arguments may be pushed in funny places.  Clear the	*/
+      /* space.								*/
+      GC_printf0("");
+#   endif      
+
+    /* Check all debugged objects for consistency */
+        if (GC_debugging_started) {
+            (*GC_check_heap)();
+        }
+    
+#   ifdef PRINTTIMES
+	GET_TIME(current_time);
+	GC_printf1("World-stopped marking took %lu msecs\n",
+	           MS_TIME_DIFF(current_time,start_time));
+#   endif
+    START_WORLD();
+    return(TRUE);
+}
+
+
+/* Finish up a collection.  Assumes lock is held, signals are disabled,	*/
+/* but the world is otherwise running.					*/
+void GC_finish_collection()
+{
+#   ifdef PRINTTIMES
+	CLOCK_TYPE start_time;
+	CLOCK_TYPE finalize_time;
+	CLOCK_TYPE done_time;
+	
+	GET_TIME(start_time);
+	finalize_time = start_time;
+#   endif
+
+#   ifdef GATHERSTATS
+        GC_mem_found = 0;
+#   endif
+    if (GC_find_leak) {
+      /* Mark all objects on the free list.  All objects should be */
+      /* marked when we're done.				   */
+	{
+	  register word size;		/* current object size		*/
+	  register ptr_t p;	/* pointer to current object	*/
+	  register struct hblk * h;	/* pointer to block containing *p */
+	  register hdr * hhdr;
+	  register int word_no;           /* "index" of *p in *q          */
+	  int kind;
+
+	  for (kind = 0; kind < GC_n_kinds; kind++) {
+	    for (size = 1; size <= MAXOBJSZ; size++) {
+	      for (p= GC_obj_kinds[kind].ok_freelist[size];
+	           p != 0; p=obj_link(p)){
+		h = HBLKPTR(p);
+		hhdr = HDR(h);
+		word_no = (((word *)p) - ((word *)h));
+		set_mark_bit_from_hdr(hhdr, word_no);
+	      }
+	    }
+	  }
+	}
+	GC_start_reclaim(TRUE);
+	  /* The above just checks; it doesn't really reclaim anything. */
+    }
+
+    GC_finalize();
+#   ifdef STUBBORN_ALLOC
+      GC_clean_changing_list();
+#   endif
+
+#   ifdef PRINTTIMES
+      GET_TIME(finalize_time);
+#   endif
+
+    /* Clear free list mark bits, in case they got accidentally marked   */
+    /* Note: HBLKPTR(p) == pointer to head of block containing *p        */
+    /* (or GC_find_leak is set and they were intentionally marked.)	 */
+    /* Also subtract memory remaining from GC_mem_found count.           */
+    /* Note that composite objects on free list are cleared.             */
+    /* Thus accidentally marking a free list is not a problem;  only     */
+    /* objects on the list itself will be marked, and that's fixed here. */
+      {
+	register word size;		/* current object size		*/
+	register ptr_t p;	/* pointer to current object	*/
+	register struct hblk * h;	/* pointer to block containing *p */
+	register hdr * hhdr;
+	register int word_no;           /* "index" of *p in *q          */
+	int kind;
+
+	for (kind = 0; kind < GC_n_kinds; kind++) {
+	  for (size = 1; size <= MAXOBJSZ; size++) {
+	    for (p= GC_obj_kinds[kind].ok_freelist[size];
+	         p != 0; p=obj_link(p)){
+		h = HBLKPTR(p);
+		hhdr = HDR(h);
+		word_no = (((word *)p) - ((word *)h));
+		clear_mark_bit_from_hdr(hhdr, word_no);
+#		ifdef GATHERSTATS
+		    GC_mem_found -= size;
+#		endif
+	    }
+	  }
+	}
+      }
+
+
+#   ifdef PRINTSTATS
+	GC_printf1("Bytes recovered before sweep - f.l. count = %ld\n",
+	          (long)WORDS_TO_BYTES(GC_mem_found));
+#   endif
+    /* Reconstruct free lists to contain everything not marked */
+        GC_start_reclaim(FALSE);
+        if (GC_is_full_gc)  {
+	    GC_used_heap_size_after_full = USED_HEAP_SIZE;
+	    GC_need_full_gc = FALSE;
+	} else {
+	    GC_need_full_gc =
+		 BYTES_TO_WORDS(USED_HEAP_SIZE - GC_used_heap_size_after_full)
+		 > min_words_allocd();
+	}
+
+#   ifdef PRINTSTATS
+	GC_printf2(
+		  "Immediately reclaimed %ld bytes in heap of size %lu bytes",
+	          (long)WORDS_TO_BYTES(GC_mem_found),
+	          (unsigned long)GC_heapsize);
+#	ifdef USE_MUNMAP
+	  GC_printf1("(%lu unmapped)", GC_unmapped_bytes);
+#	endif
+	GC_printf2(
+		"\n%lu (atomic) + %lu (composite) collectable bytes in use\n",
+	        (unsigned long)WORDS_TO_BYTES(GC_atomic_in_use),
+	        (unsigned long)WORDS_TO_BYTES(GC_composite_in_use));
+#   endif
+
+      GC_n_attempts = 0;
+      GC_is_full_gc = FALSE;
+    /* Reset or increment counters for next cycle */
+      GC_words_allocd_before_gc += GC_words_allocd;
+      GC_non_gc_bytes_at_gc = GC_non_gc_bytes;
+      GC_words_allocd = 0;
+      GC_words_wasted = 0;
+      GC_mem_freed = 0;
+      
+#   ifdef USE_MUNMAP
+      GC_unmap_old();
+#   endif
+#   ifdef PRINTTIMES
+	GET_TIME(done_time);
+	GC_printf2("Finalize + initiate sweep took %lu + %lu msecs\n",
+	           MS_TIME_DIFF(finalize_time,start_time),
+	           MS_TIME_DIFF(done_time,finalize_time));
+#   endif
+}
+
+/* Externally callable routine to invoke full, stop-world collection */
+# if defined(__STDC__) || defined(__cplusplus)
+    int GC_try_to_collect(GC_stop_func stop_func)
+# else
+    int GC_try_to_collect(stop_func)
+    GC_stop_func stop_func;
+# endif
+{
+    int result;
+    DCL_LOCK_STATE;
+    
+    GC_INVOKE_FINALIZERS();
+    DISABLE_SIGNALS();
+    LOCK();
+    ENTER_GC();
+    if (!GC_is_initialized) GC_init_inner();
+    /* Minimize junk left in my registers */
+      GC_noop(0,0,0,0,0,0);
+    result = (int)GC_try_to_collect_inner(stop_func);
+    EXIT_GC();
+    UNLOCK();
+    ENABLE_SIGNALS();
+    if(result) GC_INVOKE_FINALIZERS();
+    return(result);
+}
+
+void GC_gcollect GC_PROTO(())
+{
+    GC_notify_full_gc();
+    (void)GC_try_to_collect(GC_never_stop_func);
+}
+
+word GC_n_heap_sects = 0;	/* Number of sections currently in heap. */
+
+/*
+ * Use the chunk of memory starting at p of size bytes as part of the heap.
+ * Assumes p is HBLKSIZE aligned, and bytes is a multiple of HBLKSIZE.
+ */
+void GC_add_to_heap(p, bytes)
+struct hblk *p;
+word bytes;
+{
+    word words;
+    hdr * phdr;
+    
+    if (GC_n_heap_sects >= MAX_HEAP_SECTS) {
+    	ABORT("Too many heap sections: Increase MAXHINCR or MAX_HEAP_SECTS");
+    }
+    phdr = GC_install_header(p);
+    if (0 == phdr) {
+    	/* This is extremely unlikely. Can't add it.  This will		*/
+    	/* almost certainly result in a	0 return from the allocator,	*/
+    	/* which is entirely appropriate.				*/
+    	return;
+    }
+    GC_heap_sects[GC_n_heap_sects].hs_start = (ptr_t)p;
+    GC_heap_sects[GC_n_heap_sects].hs_bytes = bytes;
+    GC_n_heap_sects++;
+    words = BYTES_TO_WORDS(bytes - HDR_BYTES);
+    phdr -> hb_sz = words;
+    phdr -> hb_map = (char *)1;   /* A value != GC_invalid_map	*/
+    phdr -> hb_flags = 0;
+    GC_freehblk(p);
+    GC_heapsize += bytes;
+    if ((ptr_t)p <= GC_least_plausible_heap_addr
+        || GC_least_plausible_heap_addr == 0) {
+        GC_least_plausible_heap_addr = (ptr_t)p - sizeof(word);
+        	/* Making it a little smaller than necessary prevents	*/
+        	/* us from getting a false hit from the variable	*/
+        	/* itself.  There's some unintentional reflection	*/
+        	/* here.						*/
+    }
+    if ((ptr_t)p + bytes >= GC_greatest_plausible_heap_addr) {
+        GC_greatest_plausible_heap_addr = (ptr_t)p + bytes;
+    }
+}
+
+# if !defined(NO_DEBUGGING)
+void GC_print_heap_sects()
+{
+    register unsigned i;
+    
+    GC_printf1("Total heap size: %lu\n", (unsigned long) GC_heapsize);
+    for (i = 0; i < GC_n_heap_sects; i++) {
+        unsigned long start = (unsigned long) GC_heap_sects[i].hs_start;
+        unsigned long len = (unsigned long) GC_heap_sects[i].hs_bytes;
+        struct hblk *h;
+        unsigned nbl = 0;
+        
+    	GC_printf3("Section %ld from 0x%lx to 0x%lx ", (unsigned long)i,
+    		   start, (unsigned long)(start + len));
+    	for (h = (struct hblk *)start; h < (struct hblk *)(start + len); h++) {
+    	    if (GC_is_black_listed(h, HBLKSIZE)) nbl++;
+    	}
+    	GC_printf2("%lu/%lu blacklisted\n", (unsigned long)nbl,
+    		   (unsigned long)(len/HBLKSIZE));
+    }
+}
+# endif
+
+ptr_t GC_least_plausible_heap_addr = (ptr_t)ONES;
+ptr_t GC_greatest_plausible_heap_addr = 0;
+
+ptr_t GC_max(x,y)
+ptr_t x, y;
+{
+    return(x > y? x : y);
+}
+
+ptr_t GC_min(x,y)
+ptr_t x, y;
+{
+    return(x < y? x : y);
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+    void GC_set_max_heap_size(GC_word n)
+# else
+    void GC_set_max_heap_size(n)
+    GC_word n;
+# endif
+{
+    GC_max_heapsize = n;
+}
+
+GC_word GC_max_retries = 0;
+
+/*
+ * this explicitly increases the size of the heap.  It is used
+ * internally, but may also be invoked from GC_expand_hp by the user.
+ * The argument is in units of HBLKSIZE.
+ * Tiny values of n are rounded up.
+ * Returns FALSE on failure.
+ */
+GC_bool GC_expand_hp_inner(n)
+word n;
+{
+    word bytes;
+    struct hblk * space;
+    word expansion_slop;	/* Number of bytes by which we expect the */
+    				/* heap to expand soon.			  */
+
+    if (n < MINHINCR) n = MINHINCR;
+    bytes = n * HBLKSIZE;
+    /* Make sure bytes is a multiple of GC_page_size */
+      {
+	word mask = GC_page_size - 1;
+	bytes += mask;
+	bytes &= ~mask;
+      }
+    
+    if (GC_max_heapsize != 0 && GC_heapsize + bytes > GC_max_heapsize) {
+        /* Exceeded self-imposed limit */
+        return(FALSE);
+    }
+    space = GET_MEM(bytes);
+    if( space == 0 ) {
+	return(FALSE);
+    }
+#   ifdef PRINTSTATS
+	GC_printf2("Increasing heap size by %lu after %lu allocated bytes\n",
+	           (unsigned long)bytes,
+	           (unsigned long)WORDS_TO_BYTES(GC_words_allocd));
+# 	ifdef UNDEFINED
+	  GC_printf1("Root size = %lu\n", GC_root_size);
+	  GC_print_block_list(); GC_print_hblkfreelist();
+	  GC_printf0("\n");
+#	endif
+#   endif
+    expansion_slop = 8 * WORDS_TO_BYTES(min_words_allocd());
+    if (5 * HBLKSIZE * MAXHINCR > expansion_slop) {
+        expansion_slop = 5 * HBLKSIZE * MAXHINCR;
+    }
+    if (GC_last_heap_addr == 0 && !((word)space & SIGNB)
+        || GC_last_heap_addr != 0 && GC_last_heap_addr < (ptr_t)space) {
+        /* Assume the heap is growing up */
+        GC_greatest_plausible_heap_addr =
+            GC_max(GC_greatest_plausible_heap_addr,
+                   (ptr_t)space + bytes + expansion_slop);
+    } else {
+        /* Heap is growing down */
+        GC_least_plausible_heap_addr =
+            GC_min(GC_least_plausible_heap_addr,
+                   (ptr_t)space - expansion_slop);
+    }
+    GC_prev_heap_addr = GC_last_heap_addr;
+    GC_last_heap_addr = (ptr_t)space;
+    GC_add_to_heap(space, bytes);
+    return(TRUE);
+}
+
+/* Really returns a bool, but it's externally visible, so that's clumsy. */
+/* Arguments is in bytes.						*/
+# if defined(__STDC__) || defined(__cplusplus)
+  int GC_expand_hp(size_t bytes)
+# else
+  int GC_expand_hp(bytes)
+  size_t bytes;
+# endif
+{
+    int result;
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    if (!GC_is_initialized) GC_init_inner();
+    result = (int)GC_expand_hp_inner(divHBLKSZ((word)bytes));
+    if (result) GC_requested_heapsize += bytes;
+    UNLOCK();
+    ENABLE_SIGNALS();
+    return(result);
+}
+
+unsigned GC_fail_count = 0;  
+			/* How many consecutive GC/expansion failures?	*/
+			/* Reset by GC_allochblk.			*/
+
+GC_bool GC_collect_or_expand(needed_blocks, ignore_off_page)
+word needed_blocks;
+GC_bool ignore_off_page;
+{
+    if (!GC_incremental && !GC_dont_gc &&
+	(GC_dont_expand && GC_words_allocd > 0 || GC_should_collect())) {
+      GC_notify_full_gc();
+      GC_gcollect_inner();
+    } else {
+      word blocks_to_get = GC_heapsize/(HBLKSIZE*GC_free_space_divisor)
+      			   + needed_blocks;
+      
+      if (blocks_to_get > MAXHINCR) {
+          word slop;
+          
+          if (ignore_off_page) {
+              slop = 4;
+          } else {
+	      slop = 2*divHBLKSZ(BL_LIMIT);
+	      if (slop > needed_blocks) slop = needed_blocks;
+	  }
+          if (needed_blocks + slop > MAXHINCR) {
+              blocks_to_get = needed_blocks + slop;
+          } else {
+              blocks_to_get = MAXHINCR;
+          }
+      }
+      if (!GC_expand_hp_inner(blocks_to_get)
+        && !GC_expand_hp_inner(needed_blocks)) {
+      	if (GC_fail_count++ < GC_max_retries) {
+      	    WARN("Out of Memory!  Trying to continue ...\n", 0);
+	    GC_notify_full_gc();
+	    GC_gcollect_inner();
+	} else {
+	    WARN("Out of Memory!  Returning NIL!\n", 0);
+	    return(FALSE);
+	}
+      } else {
+#	  ifdef PRINTSTATS
+            if (GC_fail_count) {
+	      GC_printf0("Memory available again ...\n");
+	    }
+#	  endif
+      }
+    }
+    return(TRUE);
+}
+
+/*
+ * Make sure the object free list for sz is not empty.
+ * Return a pointer to the first object on the free list.
+ * The object MUST BE REMOVED FROM THE FREE LIST BY THE CALLER.
+ * Assumes we hold the allocator lock and signals are disabled.
+ *
+ */
+ptr_t GC_allocobj(sz, kind)
+word sz;
+int kind;
+{
+    register ptr_t * flh = &(GC_obj_kinds[kind].ok_freelist[sz]);
+    
+    if (sz == 0) return(0);
+
+    while (*flh == 0) {
+      ENTER_GC();
+      /* Do our share of marking work */
+        if(GC_incremental && !GC_dont_gc) GC_collect_a_little_inner(1);
+      /* Sweep blocks for objects of this size */
+          GC_continue_reclaim(sz, kind);
+      EXIT_GC();
+      if (*flh == 0) {
+        GC_new_hblk(sz, kind);
+      }
+      if (*flh == 0) {
+        ENTER_GC();
+        if (!GC_collect_or_expand((word)1,FALSE)) {
+	    EXIT_GC();
+	    return(0);
+	}
+	EXIT_GC();
+      }
+    }
+    
+    return(*flh);
+}
diff --git a/src/gc/alpha_mach_dep.s b/src/gc/alpha_mach_dep.s
new file mode 100644
index 000000000..157d541ec
--- /dev/null
+++ b/src/gc/alpha_mach_dep.s
@@ -0,0 +1,64 @@
+ # $Id$
+
+# This is BROKEN on a 21264 running gcc, and probably in other cases.
+# The compiler may spill pointers to fp registers, and this code doesn't
+# scan those.
+
+# define call_push(x)    						\
+	lda   $16, 0(x);    	/* copy x to first argument register */	\
+	jsr   $26, GC_push_one; /* call GC_push_one, ret addr in $26 */	\
+	ldgp  $gp, 0($26)	/* restore $gp register from $ra */
+	
+        .text
+        .align  4
+        .globl  GC_push_regs
+        .ent    GC_push_regs 2
+GC_push_regs:
+	ldgp    $gp, 0($27)		# set gp from the procedure value reg
+	lda     $sp, -32($sp)		# make stack frame
+	stq     $26, 8($sp)		# save return address
+        .mask   0x04000000, -8
+        .frame  $sp, 16, $26, 0
+
+ #      call_push($0)    # expression eval and int func result
+
+ #      call_push($1)    # temp regs - not preserved cross calls
+ #      call_push($2)
+ #      call_push($3)
+ #      call_push($4)
+ #      call_push($5)
+ #      call_push($6)
+ #      call_push($7)
+ #      call_push($8)
+
+        call_push($9)    # Saved regs
+        call_push($10)
+        call_push($11)
+        call_push($12)
+        call_push($13)
+        call_push($14)
+
+        call_push($15)   # frame ptr or saved reg
+
+ #      call_push($16)   # argument regs - not preserved cross calls
+ #      call_push($17)
+ #      call_push($18)
+ #      call_push($19)
+ #      call_push($20)
+ #      call_push($21)
+
+ #      call_push($22)   # temp regs - not preserved cross calls
+ #      call_push($23)
+ #      call_push($24)
+ #      call_push($25)
+
+ #      call_push($26)   # return address - expression eval
+ #      call_push($27)   # procedure value or temporary reg
+ #      call_push($28)   # assembler temp - not presrved
+        call_push($29)   # Global Pointer
+ #      call_push($30)   # Stack Pointer
+
+	ldq     $26, 8($sp)		# restore return address
+	lda     $sp, 32($sp)		# pop stack frame
+	ret     $31, ($26), 1		# return ($31 == hardwired zero)
+	.end    GC_push_regs
diff --git a/src/gc/backptr.h b/src/gc/backptr.h
new file mode 100644
index 000000000..f5b7c5aa2
--- /dev/null
+++ b/src/gc/backptr.h
@@ -0,0 +1,63 @@
+/*
+ * This is a simple API to implement pointer back tracing, i.e.
+ * to answer questions such as "who is pointing to this" or
+ * "why is this object being retained by the collector"
+ *
+ * This API assumes that we have an ANSI C compiler.
+ *
+ * Most of these calls yield useful information on only after
+ * a garbage collection.  Usually the client will first force
+ * a full collection and then gather information, preferably
+ * before much intervening allocation.
+ *
+ * The implementation of the interface is only about 99.9999%
+ * correct.  It is intended to be good enough for profiling,
+ * but is not intended to be used with production code.
+ *
+ * Results are likely to be much more useful if all allocation is
+ * accomplished through the debugging allocators.
+ *
+ * The implementation idea is due to A. Demers.
+ */
+
+/* Store information about the object referencing dest in *base_p     */
+/* and *offset_p.                                                     */
+/* If multiple objects or roots point to dest, the one reported	      */
+/* will be the last on used by the garbage collector to trace the     */
+/* object.							      */
+/*   source is root ==> *base_p = address, *offset_p = 0	      */
+/*   source is heap object ==> *base_p != 0, *offset_p = offset       */
+/*   Returns 1 on success, 0 if source couldn't be determined.        */
+/* Dest can be any address within a heap object.                      */
+typedef enum {  GC_UNREFERENCED, /* No reference info available.	*/
+		GC_NO_SPACE,	/* Dest not allocated with debug alloc  */
+		GC_REFD_FROM_ROOT, /* Referenced directly by root *base_p */
+		GC_REFD_FROM_REG,  /* Referenced from a register, i.e.	*/
+				   /* a root without an address.	*/
+		GC_REFD_FROM_HEAP, /* Referenced from another heap obj. */
+		GC_FINALIZER_REFD /* Finalizable and hence accessible.  */
+} GC_ref_kind;
+
+GC_ref_kind GC_get_back_ptr_info(void *dest, void **base_p, size_t *offset_p);
+
+/* Generate a random heap address.            */
+/* The resulting address is in the heap, but  */
+/* not necessarily inside a valid object.     */
+void * GC_generate_random_heap_address(void);
+
+/* Generate a random address inside a valid marked heap object. */
+void * GC_generate_random_valid_address(void);
+
+/* Force a garbage collection and generate a backtrace from a */
+/* random heap address.                                       */
+/* This uses the GC logging mechanism (GC_printf) to produce  */
+/* output.  It can often be called from a debugger.  The      */
+/* source in dbg_mlc.c also serves as a sample client.	      */
+void GC_generate_random_backtrace(void);
+
+/* Print a backtrace from a specific address.  Used by the 	*/
+/* above.  The client should call GC_gcollect() immediately	*/
+/* before invocation.						*/
+void GC_print_backtrace(void *);
+
+
diff --git a/src/gc/barrett_diagram b/src/gc/barrett_diagram
new file mode 100644
index 000000000..27e80dc15
--- /dev/null
+++ b/src/gc/barrett_diagram
@@ -0,0 +1,106 @@
+This is an ASCII diagram of the data structure used to check pointer
+validity.  It was provided by Dave Barrett <barrett@asgard.cs.colorado.edu>,
+and should be of use to others attempting to understand the code.
+The data structure in GC4.X is essentially the same.   -HB
+
+
+
+
+		Data Structure used by GC_base in gc3.7:
+			      21-Apr-94
+			 
+			
+
+
+    63                  LOG_TOP_SZ[11]  LOG_BOTTOM_SZ[10]   LOG_HBLKSIZE[13]
+   +------------------+----------------+------------------+------------------+
+ p:|                  |   TL_HASH(hi)  |                  |   HBLKDISPL(p)   |
+   +------------------+----------------+------------------+------------------+
+    \-----------------------HBLKPTR(p)-------------------/
+    \------------hi-------------------/ 
+                      \______ ________/ \________ _______/ \________ _______/
+                             V                   V                  V
+                             |                   |                  |
+           GC_top_index[]    |                   |                  | 
+ ---      +--------------+   |                   |                  |  
+  ^       |              |   |                   |                  |   
+  |       |              |   |                   |                  |   
+ TOP      +--------------+<--+                   |                  |      
+ _SZ   +-<|      []      | *                     |                  |     
+(items)|  +--------------+  if 0 < bi< HBLKSIZE  |                  |    
+  |    |  |              | then large object     |                  |    
+  |    |  |              | starts at the bi'th   |                  |    
+  v    |  |              | HBLK before p.        |             i    |    
+ ---   |  +--------------+                       |          (word-  |    
+       v                                         |         aligned) |    
+   bi= |GET_BI(p){->hash_link}->key==hi          |                  |   
+       v                                         |                  |    
+       |   (bottom_index)  \ scratch_alloc'd     |                  |    
+       |   ( struct  bi )  / by get_index()      |                  |    
+ ---   +->+--------------+                       |                  |    
+  ^       |              |                       |                  |
+  ^       |              |                       |                  |
+ BOTTOM   |              |   ha=GET_HDR_ADDR(p)  |                  |
+_SZ(items)+--------------+<----------------------+          +-------+
+  |   +--<|   index[]    |                                  |         
+  |   |   +--------------+                      GC_obj_map: v              
+  |   |   |              |              from      / +-+-+-----+-+-+-+-+  --- 
+  v   |   |              |              GC_add   < 0| | |     | | | | |   ^  
+ ---  |   +--------------+             _map_entry \ +-+-+-----+-+-+-+-+   |  
+      |   |   asc_link   |                          +-+-+-----+-+-+-+-+ MAXOBJSZ
+      |   +--------------+                      +-->| | |  j  | | | | |  +1   
+      |   |     key      |                      |   +-+-+-----+-+-+-+-+   |  
+      |   +--------------+                      |   +-+-+-----+-+-+-+-+   | 
+      |   |  hash_link   |                      |   | | |     | | | | |   v 
+      |   +--------------+                      |   +-+-+-----+-+-+-+-+  ---
+      |                                         |   |<--MAX_OFFSET--->|   
+      |                                         |         (bytes)
+HDR(p)| GC_find_header(p)                       |   |<--MAP_ENTRIES-->| 
+      |                           \ from        |    =HBLKSIZE/WORDSZ   
+      |    (hdr) (struct hblkhdr) / alloc_hdr() |    (1024 on Alpha)
+      +-->+----------------------+              |    (8/16 bits each)
+GET_HDR(p)| word   hb_sz (words) |              |          
+          +----------------------+              |     
+          | struct hblk *hb_next |              |
+          +----------------------+              |       
+          |mark_proc hb_mark_proc|              |
+          +----------------------+              |
+          | char * hb_map        |>-------------+
+          +----------------------+           
+          | ushort hb_obj_kind   |           
+          +----------------------+           
+          |   hb_last_reclaimed  |           
+ ---      +----------------------+                
+  ^       |                      |
+ MARK_BITS|       hb_marks[]     | *if hdr is free, hb_sz + DISCARD_WORDS
+_SZ(words)|                      |  is the size of a heap chunk (struct hblk)
+  v       |                      |  of at least MININCR*HBLKSIZE bytes (below),
+ ---      +----------------------+  otherwise, size of each object in chunk.
+
+Dynamic data structures above are interleaved throughout the heap in blocks of 
+size MININCR * HBLKSIZE bytes as done by gc_scratch_alloc which cannot be
+freed; free lists are used (e.g. alloc_hdr).  HBLKs's below are collected.
+
+	      (struct hblk)      
+ ---      +----------------------+ < HBLKSIZE ---         ---          DISCARD_
+  ^       |garbage[DISCARD_WORDS]|   aligned   ^           ^ HDR_BYTES WORDS
+  |       |                      |             |           v (bytes)   (words)
+  |       +-----hb_body----------+ < WORDSZ    |          ---   ---   
+  |       |                      |   aligned   |           ^     ^
+  |       |      Object 0        |             |           hb_sz |
+  |       |                      |           i |(word-    (words)|
+  |       |                      |      (bytes)|aligned)   v     |
+  |       + - - - - - - - - - - -+ ---         |          ---    |
+  |       |                      |  ^          |           ^     |
+  n *     |                      |  j (words)  |          hb_sz BODY_SZ 
+ HBLKSIZE |      Object 1        |  v          v           |   (words)
+ (bytes)  |                      |---------------          v   MAX_OFFSET
+  |       + - - - - - - - - - - -+                        ---  (bytes)
+  |       |                      | !All_INTERIOR_PTRS      ^     |
+  |       |                      | sets j only for       hb_sz   |
+  |       |      Object N        | valid object offsets.   |     |
+  v       |                      | All objects WORDSZ      v     v
+ ---      +----------------------+ aligned.               ---   ---
+
+DISCARD_WORDS is normally zero.  Indeed the collector has not been tested
+with another value in ages.
diff --git a/src/gc/blacklst.c b/src/gc/blacklst.c
new file mode 100644
index 000000000..e5a3a26a8
--- /dev/null
+++ b/src/gc/blacklst.c
@@ -0,0 +1,298 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, August 9, 1995 6:09 pm PDT */
+# include "gc_priv.h"
+
+/*
+ * We maintain several hash tables of hblks that have had false hits.
+ * Each contains one bit per hash bucket;  If any page in the bucket
+ * has had a false hit, we assume that all of them have.
+ * See the definition of page_hash_table in gc_private.h.
+ * False hits from the stack(s) are much more dangerous than false hits
+ * from elsewhere, since the former can pin a large object that spans the
+ * block, eventhough it does not start on the dangerous block.
+ */
+ 
+/*
+ * Externally callable routines are:
+ 
+ * GC_add_to_black_list_normal
+ * GC_add_to_black_list_stack
+ * GC_promote_black_lists
+ * GC_is_black_listed
+ *
+ * All require that the allocator lock is held.
+ */
+
+/* Pointers to individual tables.  We replace one table by another by 	*/
+/* switching these pointers. 						*/
+word * GC_old_normal_bl;
+		/* Nonstack false references seen at last full		*/
+		/* collection.						*/
+word * GC_incomplete_normal_bl;
+		/* Nonstack false references seen since last		*/
+		/* full collection.					*/
+word * GC_old_stack_bl;
+word * GC_incomplete_stack_bl;
+
+word GC_total_stack_black_listed;
+
+word GC_black_list_spacing = MINHINCR*HBLKSIZE;  /* Initial rough guess */
+
+void GC_clear_bl();
+
+void GC_default_print_heap_obj_proc(p)
+ptr_t p;
+{
+    ptr_t base = GC_base(p);
+
+    GC_err_printf2("start: 0x%lx, appr. length: %ld", base, GC_size(base));
+}
+
+void (*GC_print_heap_obj)(/* char * s, ptr_t p */) =
+				GC_default_print_heap_obj_proc;
+
+void GC_print_source_ptr(p)
+ptr_t p;
+{
+    ptr_t base = GC_base(p);
+    if (0 == base) {
+	if (0 == p) {
+	    GC_err_printf0("in register");
+	} else {
+	    GC_err_printf0("in root set");
+	}
+    } else {
+	GC_err_printf0("in object at ");
+	(*GC_print_heap_obj)(base);
+    }
+}
+
+void GC_bl_init()
+{
+# ifndef ALL_INTERIOR_POINTERS
+    GC_old_normal_bl = (word *)
+    			 GC_scratch_alloc((word)(sizeof (page_hash_table)));
+    GC_incomplete_normal_bl = (word *)GC_scratch_alloc
+    					((word)(sizeof(page_hash_table)));
+    if (GC_old_normal_bl == 0 || GC_incomplete_normal_bl == 0) {
+        GC_err_printf0("Insufficient memory for black list\n");
+        EXIT();
+    }
+    GC_clear_bl(GC_old_normal_bl);
+    GC_clear_bl(GC_incomplete_normal_bl);
+# endif
+    GC_old_stack_bl = (word *)GC_scratch_alloc((word)(sizeof(page_hash_table)));
+    GC_incomplete_stack_bl = (word *)GC_scratch_alloc
+    					((word)(sizeof(page_hash_table)));
+    if (GC_old_stack_bl == 0 || GC_incomplete_stack_bl == 0) {
+        GC_err_printf0("Insufficient memory for black list\n");
+        EXIT();
+    }
+    GC_clear_bl(GC_old_stack_bl);
+    GC_clear_bl(GC_incomplete_stack_bl);
+}
+		
+void GC_clear_bl(doomed)
+word *doomed;
+{
+    BZERO(doomed, sizeof(page_hash_table));
+}
+
+void GC_copy_bl(old, new)
+word *new, *old;
+{
+    BCOPY(old, new, sizeof(page_hash_table));
+}
+
+static word total_stack_black_listed();
+
+/* Signal the completion of a collection.  Turn the incomplete black	*/
+/* lists into new black lists, etc.					*/			 
+void GC_promote_black_lists()
+{
+    word * very_old_normal_bl = GC_old_normal_bl;
+    word * very_old_stack_bl = GC_old_stack_bl;
+    
+    GC_old_normal_bl = GC_incomplete_normal_bl;
+    GC_old_stack_bl = GC_incomplete_stack_bl;
+#   ifndef ALL_INTERIOR_POINTERS
+      GC_clear_bl(very_old_normal_bl);
+#   endif
+    GC_clear_bl(very_old_stack_bl);
+    GC_incomplete_normal_bl = very_old_normal_bl;
+    GC_incomplete_stack_bl = very_old_stack_bl;
+    GC_total_stack_black_listed = total_stack_black_listed();
+#   ifdef PRINTSTATS
+  	GC_printf1("%ld bytes in heap blacklisted for interior pointers\n",
+  		   (unsigned long)GC_total_stack_black_listed);
+#   endif
+    if (GC_total_stack_black_listed != 0) {
+        GC_black_list_spacing =
+		HBLKSIZE*(GC_heapsize/GC_total_stack_black_listed);
+    }
+    if (GC_black_list_spacing < 3 * HBLKSIZE) {
+    	GC_black_list_spacing = 3 * HBLKSIZE;
+    }
+    if (GC_black_list_spacing > MAXHINCR * HBLKSIZE) {
+	GC_black_list_spacing = MAXHINCR * HBLKSIZE;
+	/* Makes it easier to allocate really huge blocks, which otherwise */
+	/* may have problems with nonuniform blacklist distributions.	   */
+	/* This way we should always succeed immediately after growing the */ 
+	/* heap.							   */
+    }
+}
+
+void GC_unpromote_black_lists()
+{
+#   ifndef ALL_INTERIOR_POINTERS
+      GC_copy_bl(GC_old_normal_bl, GC_incomplete_normal_bl);
+#   endif
+    GC_copy_bl(GC_old_stack_bl, GC_incomplete_stack_bl);
+}
+
+# ifndef ALL_INTERIOR_POINTERS
+/* P is not a valid pointer reference, but it falls inside	*/
+/* the plausible heap bounds.					*/
+/* Add it to the normal incomplete black list if appropriate.	*/
+#ifdef PRINT_BLACK_LIST
+  void GC_add_to_black_list_normal(p, source)
+  ptr_t source;
+#else
+  void GC_add_to_black_list_normal(p)
+#endif
+word p;
+{
+    if (!(GC_modws_valid_offsets[p & (sizeof(word)-1)])) return;
+    {
+        register int index = PHT_HASH(p);
+        
+        if (HDR(p) == 0 || get_pht_entry_from_index(GC_old_normal_bl, index)) {
+#   	    ifdef PRINT_BLACK_LIST
+		if (!get_pht_entry_from_index(GC_incomplete_normal_bl, index)) {
+	    	  GC_err_printf2(
+			"Black listing (normal) 0x%lx referenced from 0x%lx ",
+	    	        (unsigned long) p, (unsigned long) source);
+		  GC_print_source_ptr(source);
+		  GC_err_puts("\n");
+	    	}
+#           endif
+            set_pht_entry_from_index(GC_incomplete_normal_bl, index);
+        } /* else this is probably just an interior pointer to an allocated */
+          /* object, and isn't worth black listing.			    */
+    }
+}
+# endif
+
+/* And the same for false pointers from the stack. */
+#ifdef PRINT_BLACK_LIST
+  void GC_add_to_black_list_stack(p, source)
+  ptr_t source;
+#else
+  void GC_add_to_black_list_stack(p)
+#endif
+word p;
+{
+    register int index = PHT_HASH(p);
+        
+    if (HDR(p) == 0 || get_pht_entry_from_index(GC_old_stack_bl, index)) {
+#   	ifdef PRINT_BLACK_LIST
+	    if (!get_pht_entry_from_index(GC_incomplete_stack_bl, index)) {
+	    	  GC_err_printf2(
+			"Black listing (stack) 0x%lx referenced from 0x%lx ",
+	    	        (unsigned long)p, (unsigned long)source);
+		  GC_print_source_ptr(source);
+		  GC_err_puts("\n");
+	    }
+#       endif
+	set_pht_entry_from_index(GC_incomplete_stack_bl, index);
+    }
+}
+
+/*
+ * Is the block starting at h of size len bytes black listed?   If so,
+ * return the address of the next plausible r such that (r, len) might not
+ * be black listed.  (R may not actually be in the heap.  We guarantee only
+ * that every smaller value of r after h is also black listed.)
+ * If (h,len) is not black listed, return 0.
+ * Knows about the structure of the black list hash tables.
+ */
+struct hblk * GC_is_black_listed(h, len)
+struct hblk * h;
+word len;
+{
+    register int index = PHT_HASH((word)h);
+    register word i;
+    word nblocks = divHBLKSZ(len);
+
+#   ifndef ALL_INTERIOR_POINTERS
+      if (get_pht_entry_from_index(GC_old_normal_bl, index)
+          || get_pht_entry_from_index(GC_incomplete_normal_bl, index)) {
+        return(h+1);
+      }
+#   endif
+    
+    for (i = 0; ; ) {
+        if (GC_old_stack_bl[divWORDSZ(index)] == 0
+            && GC_incomplete_stack_bl[divWORDSZ(index)] == 0) {
+            /* An easy case */
+            i += WORDSZ - modWORDSZ(index);
+        } else {
+          if (get_pht_entry_from_index(GC_old_stack_bl, index)
+              || get_pht_entry_from_index(GC_incomplete_stack_bl, index)) {
+            return(h+i+1);
+          }
+          i++;
+        }
+        if (i >= nblocks) break;
+        index = PHT_HASH((word)(h+i));
+    }
+    return(0);
+}
+
+
+/* Return the number of blacklisted blocks in a given range.	*/
+/* Used only for statistical purposes.				*/
+/* Looks only at the GC_incomplete_stack_bl.			*/
+word GC_number_stack_black_listed(start, endp1)
+struct hblk *start, *endp1;
+{
+    register struct hblk * h;
+    word result = 0;
+    
+    for (h = start; h < endp1; h++) {
+        register int index = PHT_HASH((word)h);
+        
+        if (get_pht_entry_from_index(GC_old_stack_bl, index)) result++;
+    }
+    return(result);
+}
+
+
+/* Return the total number of (stack) black-listed bytes. */
+static word total_stack_black_listed()
+{
+    register unsigned i;
+    word total = 0;
+    
+    for (i = 0; i < GC_n_heap_sects; i++) {
+    	struct hblk * start = (struct hblk *) GC_heap_sects[i].hs_start;
+    	word len = (word) GC_heap_sects[i].hs_bytes;
+    	struct hblk * endp1 = start + len/HBLKSIZE;
+    	
+    	total += GC_number_stack_black_listed(start, endp1);
+    }
+    return(total * HBLKSIZE);
+}
+
diff --git a/src/gc/callprocs b/src/gc/callprocs
new file mode 100755
index 000000000..a8793f0b7
--- /dev/null
+++ b/src/gc/callprocs
@@ -0,0 +1,4 @@
+#!/bin/sh
+GC_DEBUG=1
+export GC_DEBUG
+$* 2>&1 | awk '{print "0x3e=c\""$0"\""};/^\t##PC##=/ {if ($2 != 0) {print $2"?i"}}' | adb $1 | sed "s/^		>/>/"
diff --git a/src/gc/checksums.c b/src/gc/checksums.c
new file mode 100644
index 000000000..212655f4c
--- /dev/null
+++ b/src/gc/checksums.c
@@ -0,0 +1,201 @@
+/*
+ * Copyright (c) 1992-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, March 29, 1995 12:51 pm PST */
+# ifdef CHECKSUMS
+
+# include "gc_priv.h"
+
+/* This is debugging code intended to verify the results of dirty bit	*/
+/* computations. Works only in a single threaded environment.		*/
+/* We assume that stubborn objects are changed only when they are 	*/
+/* enabled for writing.  (Certain kinds of writing are actually		*/
+/* safe under other conditions.)					*/
+# define NSUMS 2000
+
+# define OFFSET 0x10000
+
+typedef struct {
+	GC_bool new_valid;
+	word old_sum;
+	word new_sum;
+	struct hblk * block;	/* Block to which this refers + OFFSET  */
+				/* to hide it from colector.		*/
+} page_entry;
+
+page_entry GC_sums [NSUMS];
+
+word GC_checksum(h)
+struct hblk *h;
+{
+    register word *p = (word *)h;
+    register word *lim = (word *)(h+1);
+    register word result = 0;
+    
+    while (p < lim) {
+        result += *p++;
+    }
+    return(result | 0x80000000 /* doesn't look like pointer */);
+}
+
+# ifdef STUBBORN_ALLOC
+/* Check whether a stubborn object from the given block appears on	*/
+/* the appropriate free list.						*/
+GC_bool GC_on_free_list(h)
+struct hblk *h;
+{
+    register hdr * hhdr = HDR(h);
+    register int sz = hhdr -> hb_sz;
+    ptr_t p;
+    
+    if (sz > MAXOBJSZ) return(FALSE);
+    for (p = GC_sobjfreelist[sz]; p != 0; p = obj_link(p)) {
+        if (HBLKPTR(p) == h) return(TRUE);
+    }
+    return(FALSE);
+}
+# endif
+ 
+int GC_n_dirty_errors;
+int GC_n_changed_errors;
+int GC_n_clean;
+int GC_n_dirty;
+
+void GC_update_check_page(h, index)
+struct hblk *h;
+int index;
+{
+    page_entry *pe = GC_sums + index;
+    register hdr * hhdr = HDR(h);
+    
+    if (pe -> block != 0 && pe -> block != h + OFFSET) ABORT("goofed");
+    pe -> old_sum = pe -> new_sum;
+    pe -> new_sum = GC_checksum(h);
+#   ifndef MSWIN32
+        if (pe -> new_sum != 0 && !GC_page_was_ever_dirty(h)) {
+            GC_printf1("GC_page_was_ever_dirty(0x%lx) is wrong\n",
+        	       (unsigned long)h);
+        }
+#   endif
+    if (GC_page_was_dirty(h)) {
+    	GC_n_dirty++;
+    } else {
+    	GC_n_clean++;
+    }
+    if (pe -> new_valid && pe -> old_sum != pe -> new_sum) {
+    	if (!GC_page_was_dirty(h) || !GC_page_was_ever_dirty(h)) {
+    	    /* Set breakpoint here */GC_n_dirty_errors++;
+    	}
+#	ifdef STUBBORN_ALLOC
+    	  if (!IS_FORWARDING_ADDR_OR_NIL(hhdr)
+    	    && hhdr -> hb_map != GC_invalid_map
+    	    && hhdr -> hb_obj_kind == STUBBORN
+    	    && !GC_page_was_changed(h)
+    	    && !GC_on_free_list(h)) {
+    	    /* if GC_on_free_list(h) then reclaim may have touched it	*/
+    	    /* without any allocations taking place.			*/
+    	    /* Set breakpoint here */GC_n_changed_errors++;
+    	  }
+#	endif
+    }
+    pe -> new_valid = TRUE;
+    pe -> block = h + OFFSET;
+}
+
+word GC_bytes_in_used_blocks;
+
+void GC_add_block(h, dummy)
+struct hblk *h;
+word dummy;
+{
+   register hdr * hhdr = HDR(h);
+   register bytes = WORDS_TO_BYTES(hhdr -> hb_sz);
+   
+   bytes += HDR_BYTES + HBLKSIZE-1;
+   bytes &= ~(HBLKSIZE-1);
+   GC_bytes_in_used_blocks += bytes;
+}
+
+void GC_check_blocks()
+{
+    word bytes_in_free_blocks = 0;
+    struct hblk * h = GC_hblkfreelist;
+    hdr * hhdr = HDR(h);
+    word sz;
+    
+    GC_bytes_in_used_blocks = 0;
+    GC_apply_to_all_blocks(GC_add_block, (word)0);
+    while (h != 0) {
+        sz = hhdr -> hb_sz;
+        bytes_in_free_blocks += sz;
+        h = hhdr -> hb_next;
+        hhdr = HDR(h);
+    }
+    GC_printf2("GC_bytes_in_used_blocks = %ld, bytes_in_free_blocks = %ld ",
+    		GC_bytes_in_used_blocks, bytes_in_free_blocks);
+    GC_printf1("GC_heapsize = %ld\n", GC_heapsize);
+    if (GC_bytes_in_used_blocks + bytes_in_free_blocks != GC_heapsize) {
+    	GC_printf0("LOST SOME BLOCKS!!\n");
+    }
+}
+
+/* Should be called immediately after GC_read_dirty and GC_read_changed. */
+void GC_check_dirty()
+{
+    register int index;
+    register unsigned i;
+    register struct hblk *h;
+    register ptr_t start;
+    
+    GC_check_blocks();
+    
+    GC_n_dirty_errors = 0;
+    GC_n_changed_errors = 0;
+    GC_n_clean = 0;
+    GC_n_dirty = 0;
+    
+    index = 0;
+    for (i = 0; i < GC_n_heap_sects; i++) {
+    	start = GC_heap_sects[i].hs_start;
+        for (h = (struct hblk *)start;
+             h < (struct hblk *)(start + GC_heap_sects[i].hs_bytes);
+             h++) {
+             GC_update_check_page(h, index);
+             index++;
+             if (index >= NSUMS) goto out;
+        }
+    }
+out:
+    GC_printf2("Checked %lu clean and %lu dirty pages\n",
+    	      (unsigned long) GC_n_clean, (unsigned long) GC_n_dirty);
+    if (GC_n_dirty_errors > 0) {
+        GC_printf1("Found %lu dirty bit errors\n",
+        	   (unsigned long)GC_n_dirty_errors);
+    }
+    if (GC_n_changed_errors > 0) {
+    	GC_printf1("Found %lu changed bit errors\n",
+        	   (unsigned long)GC_n_changed_errors);
+	GC_printf0("These may be benign (provoked by nonpointer changes)\n");
+#	ifdef THREADS
+	    GC_printf0(
+	    "Also expect 1 per thread currently allocating a stubborn obj.\n");
+#	endif
+    }
+}
+
+# else
+
+extern int GC_quiet;
+	/* ANSI C doesn't allow translation units to be empty.	*/
+	/* So we guarantee this one is nonempty.		*/
+
+# endif /* CHECKSUMS */
diff --git a/src/gc/cord/README b/src/gc/cord/README
new file mode 100644
index 000000000..621014523
--- /dev/null
+++ b/src/gc/cord/README
@@ -0,0 +1,31 @@
+Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+
+Permission is hereby granted to use or copy this program
+for any purpose,  provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is granted,
+provided the above notices are retained, and a notice that the code was
+modified is included with the above copyright notice.
+
+Please send bug reports to Hans-J. Boehm (boehm@sgi.com).
+
+This is a string packages that uses a tree-based representation.
+See cord.h for a description of the functions provided.  Ec.h describes
+"extensible cords", which are essentially output streams that write
+to a cord.  These allow for efficient construction of cords without
+requiring a bound on the size of a cord.
+
+de.c is a very dumb text editor that illustrates the use of cords.
+It maintains a list of file versions.  Each version is simply a
+cord representing the file contents.  Nonetheless, standard
+editing operations are efficient, even on very large files.
+(Its 3 line "user manual" can be obtained by invoking it without
+arguments.  Note that ^R^N and ^R^P move the cursor by
+almost a screen.  It does not understand tabs, which will show
+up as highlighred "I"s.  Use the UNIX "expand" program first.)
+To build the editor, type "make cord/de" in the gc directory.
+
+This package assumes an ANSI C compiler such as gcc.  It will
+not compile with an old-style K&R compiler.
diff --git a/src/gc/cord/SCOPTIONS.amiga b/src/gc/cord/SCOPTIONS.amiga
new file mode 100755
index 000000000..2a091970b
--- /dev/null
+++ b/src/gc/cord/SCOPTIONS.amiga
@@ -0,0 +1,14 @@
+MATH=STANDARD
+CPU=68030
+NOSTACKCHECK
+OPTIMIZE
+VERBOSE
+NOVERSION
+NOICONS
+OPTIMIZERTIME
+INCLUDEDIR=/
+DEFINE AMIGA
+LIBRARY=cord.lib
+LIBRARY=/gc.lib
+IGNORE=100
+IGNORE=161
diff --git a/src/gc/cord/SMakefile.amiga b/src/gc/cord/SMakefile.amiga
new file mode 100644
index 000000000..5aef131e6
--- /dev/null
+++ b/src/gc/cord/SMakefile.amiga
@@ -0,0 +1,20 @@
+# Makefile for cord.lib
+# Michel Schinz 1994/07/20
+
+OBJS = cordbscs.o cordprnt.o cordxtra.o
+
+all: cord.lib cordtest
+
+cordbscs.o: cordbscs.c
+cordprnt.o: cordprnt.c
+cordxtra.o: cordxtra.c
+cordtest.o: cordtest.c
+
+cord.lib: $(OBJS)
+	oml cord.lib r $(OBJS)
+
+cordtest: cordtest.o cord.lib
+	sc cordtest.o link
+
+clean:
+	delete cord.lib cordtest \#?.o \#?.lnk
diff --git a/src/gc/cord/cord.h b/src/gc/cord/cord.h
new file mode 100644
index 000000000..926089e86
--- /dev/null
+++ b/src/gc/cord/cord.h
@@ -0,0 +1,327 @@
+/* 
+ * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * Author: Hans-J. Boehm (boehm@parc.xerox.com)
+ */
+/* Boehm, October 5, 1995 4:20 pm PDT */
+ 
+/*
+ * Cords are immutable character strings.  A number of operations
+ * on long cords are much more efficient than their strings.h counterpart.
+ * In particular, concatenation takes constant time independent of the length
+ * of the arguments.  (Cords are represented as trees, with internal
+ * nodes representing concatenation and leaves consisting of either C
+ * strings or a functional description of the string.)
+ *
+ * The following are reasonable applications of cords.  They would perform
+ * unacceptably if C strings were used:
+ * - A compiler that produces assembly language output by repeatedly
+ *   concatenating instructions onto a cord representing the output file.
+ * - A text editor that converts the input file to a cord, and then
+ *   performs editing operations by producing a new cord representing
+ *   the file after echa character change (and keeping the old ones in an
+ *   edit history)
+ *
+ * For optimal performance, cords should be built by
+ * concatenating short sections.
+ * This interface is designed for maximum compatibility with C strings.
+ * ASCII NUL characters may be embedded in cords using CORD_from_fn.
+ * This is handled correctly, but CORD_to_char_star will produce a string
+ * with embedded NULs when given such a cord. 
+ *
+ * This interface is fairly big, largely for performance reasons.
+ * The most basic constants and functions:
+ *
+ * CORD - the type of a cord;
+ * CORD_EMPTY - empty cord;
+ * CORD_len(cord) - length of a cord;
+ * CORD_cat(cord1,cord2) - concatenation of two cords;
+ * CORD_substr(cord, start, len) - substring (or subcord);
+ * CORD_pos i;  CORD_FOR(i, cord) {  ... CORD_pos_fetch(i) ... } -
+ *    examine each character in a cord.  CORD_pos_fetch(i) is the char.
+ * CORD_fetch(int i) - Retrieve i'th character (slowly).
+ * CORD_cmp(cord1, cord2) - compare two cords.
+ * CORD_from_file(FILE * f) - turn a read-only file into a cord.
+ * CORD_to_char_star(cord) - convert to C string.
+ *   (Non-NULL C constant strings are cords.)
+ * CORD_printf (etc.) - cord version of printf. Use %r for cords.
+ */
+# ifndef CORD_H
+
+# define CORD_H
+# include <stddef.h>
+# include <stdio.h>
+/* Cords have type const char *.  This is cheating quite a bit, and not	*/
+/* 100% portable.  But it means that nonempty character string		*/
+/* constants may be used as cords directly, provided the string is	*/
+/* never modified in place.  The empty cord is represented by, and	*/
+/* can be written as, 0.						*/
+
+typedef const char * CORD;
+
+/* An empty cord is always represented as nil 	*/
+# define CORD_EMPTY 0
+
+/* Is a nonempty cord represented as a C string? */
+#define CORD_IS_STRING(s) (*(s) != '\0')
+
+/* Concatenate two cords.  If the arguments are C strings, they may 	*/
+/* not be subsequently altered.						*/
+CORD CORD_cat(CORD x, CORD y);
+
+/* Concatenate a cord and a C string with known length.  Except for the	*/
+/* empty string case, this is a special case of CORD_cat.  Since the	*/
+/* length is known, it can be faster.					*/
+/* The string y is shared with the resulting CORD.  Hence it should	*/
+/* not be altered by the caller.					*/
+CORD CORD_cat_char_star(CORD x, const char * y, size_t leny);
+
+/* Compute the length of a cord */
+size_t CORD_len(CORD x);
+
+/* Cords may be represented by functions defining the ith character */
+typedef char (* CORD_fn)(size_t i, void * client_data);
+
+/* Turn a functional description into a cord. 	*/
+CORD CORD_from_fn(CORD_fn fn, void * client_data, size_t len);
+
+/* Return the substring (subcord really) of x with length at most n,	*/
+/* starting at position i.  (The initial character has position 0.)	*/
+CORD CORD_substr(CORD x, size_t i, size_t n);
+
+/* Return the argument, but rebalanced to allow more efficient   	*/
+/* character retrieval, substring operations, and comparisons.		*/
+/* This is useful only for cords that were built using repeated 	*/
+/* concatenation.  Guarantees log time access to the result, unless	*/
+/* x was obtained through a large number of repeated substring ops	*/
+/* or the embedded functional descriptions take longer to evaluate.	*/
+/* May reallocate significant parts of the cord.  The argument is not	*/
+/* modified; only the result is balanced.				*/
+CORD CORD_balance(CORD x);
+
+/* The following traverse a cord by applying a function to each 	*/
+/* character.  This is occasionally appropriate, especially where	*/
+/* speed is crucial.  But, since C doesn't have nested functions,	*/
+/* clients of this sort of traversal are clumsy to write.  Consider	*/
+/* the functions that operate on cord positions instead.		*/
+
+/* Function to iteratively apply to individual characters in cord.	*/
+typedef int (* CORD_iter_fn)(char c, void * client_data);
+
+/* Function to apply to substrings of a cord.  Each substring is a 	*/
+/* a C character string, not a general cord.				*/
+typedef int (* CORD_batched_iter_fn)(const char * s, void * client_data);
+# define CORD_NO_FN ((CORD_batched_iter_fn)0)
+
+/* Apply f1 to each character in the cord, in ascending order,		*/
+/* starting at position i. If						*/
+/* f2 is not CORD_NO_FN, then multiple calls to f1 may be replaced by	*/
+/* a single call to f2.  The parameter f2 is provided only to allow	*/
+/* some optimization by the client.  This terminates when the right	*/
+/* end of this string is reached, or when f1 or f2 return != 0.  In the	*/
+/* latter case CORD_iter returns != 0.  Otherwise it returns 0.		*/
+/* The specified value of i must be < CORD_len(x).			*/
+int CORD_iter5(CORD x, size_t i, CORD_iter_fn f1,
+	       CORD_batched_iter_fn f2, void * client_data);
+
+/* A simpler version that starts at 0, and without f2:	*/
+int CORD_iter(CORD x, CORD_iter_fn f1, void * client_data);
+# define CORD_iter(x, f1, cd) CORD_iter5(x, 0, f1, CORD_NO_FN, cd)
+
+/* Similar to CORD_iter5, but end-to-beginning.	No provisions for	*/
+/* CORD_batched_iter_fn.						*/
+int CORD_riter4(CORD x, size_t i, CORD_iter_fn f1, void * client_data);
+
+/* A simpler version that starts at the end:	*/
+int CORD_riter(CORD x, CORD_iter_fn f1, void * client_data);
+
+/* Functions that operate on cord positions.  The easy way to traverse	*/
+/* cords.  A cord position is logically a pair consisting of a cord	*/
+/* and an index into that cord.  But it is much faster to retrieve a	*/
+/* charcter based on a position than on an index.  Unfortunately,	*/
+/* positions are big (order of a few 100 bytes), so allocate them with	*/
+/* caution.								*/
+/* Things in cord_pos.h should be treated as opaque, except as		*/
+/* described below.  Also note that					*/
+/* CORD_pos_fetch, CORD_next and CORD_prev have both macro and function	*/
+/* definitions.  The former may evaluate their argument more than once. */
+# include "private/cord_pos.h"
+
+/*
+	Visible definitions from above:
+	
+	typedef <OPAQUE but fairly big> CORD_pos[1];
+	
+	* Extract the cord from a position:
+	CORD CORD_pos_to_cord(CORD_pos p);
+	
+	* Extract the current index from a position:
+	size_t CORD_pos_to_index(CORD_pos p);
+	
+	* Fetch the character located at the given position:
+	char CORD_pos_fetch(CORD_pos p);
+	
+	* Initialize the position to refer to the given cord and index.
+	* Note that this is the most expensive function on positions:
+	void CORD_set_pos(CORD_pos p, CORD x, size_t i);
+	
+	* Advance the position to the next character.
+	* P must be initialized and valid.
+	* Invalidates p if past end:
+	void CORD_next(CORD_pos p);
+	
+	* Move the position to the preceding character.
+	* P must be initialized and valid.
+	* Invalidates p if past beginning:
+	void CORD_prev(CORD_pos p);
+	
+	* Is the position valid, i.e. inside the cord?
+	int CORD_pos_valid(CORD_pos p);
+*/
+# define CORD_FOR(pos, cord) \
+    for (CORD_set_pos(pos, cord, 0); CORD_pos_valid(pos); CORD_next(pos))
+
+			
+/* An out of memory handler to call.  May be supplied by client.	*/
+/* Must not return.							*/
+extern void (* CORD_oom_fn)(void);
+
+/* Dump the representation of x to stdout in an implementation defined	*/
+/* manner.  Intended for debugging only.				*/
+void CORD_dump(CORD x);
+
+/* The following could easily be implemented by the client.  They are	*/
+/* provided in cordxtra.c for convenience.				*/
+
+/* Concatenate a character to the end of a cord.	*/
+CORD CORD_cat_char(CORD x, char c);
+
+/* Concatenate n cords.	*/
+CORD CORD_catn(int n, /* CORD */ ...);
+
+/* Return the character in CORD_substr(x, i, 1)  	*/
+char CORD_fetch(CORD x, size_t i);
+
+/* Return < 0, 0, or > 0, depending on whether x < y, x = y, x > y	*/
+int CORD_cmp(CORD x, CORD y);
+
+/* A generalization that takes both starting positions for the 		*/
+/* comparison, and a limit on the number of characters to be compared.	*/
+int CORD_ncmp(CORD x, size_t x_start, CORD y, size_t y_start, size_t len);
+
+/* Find the first occurrence of s in x at position start or later.	*/
+/* Return the position of the first character of s in x, or		*/
+/* CORD_NOT_FOUND if there is none.					*/
+size_t CORD_str(CORD x, size_t start, CORD s);
+
+/* Return a cord consisting of i copies of (possibly NUL) c.  Dangerous	*/
+/* in conjunction with CORD_to_char_star.				*/
+/* The resulting representation takes constant space, independent of i.	*/
+CORD CORD_chars(char c, size_t i);
+# define CORD_nul(i) CORD_chars('\0', (i))
+
+/* Turn a file into cord.  The file must be seekable.  Its contents	*/
+/* must remain constant.  The file may be accessed as an immediate	*/
+/* result of this call and/or as a result of subsequent accesses to 	*/
+/* the cord.  Short files are likely to be immediately read, but	*/
+/* long files are likely to be read on demand, possibly relying on 	*/
+/* stdio for buffering.							*/
+/* We must have exclusive access to the descriptor f, i.e. we may	*/
+/* read it at any time, and expect the file pointer to be		*/
+/* where we left it.  Normally this should be invoked as		*/
+/* CORD_from_file(fopen(...))						*/
+/* CORD_from_file arranges to close the file descriptor when it is no	*/
+/* longer needed (e.g. when the result becomes inaccessible).		*/ 
+/* The file f must be such that ftell reflects the actual character	*/
+/* position in the file, i.e. the number of characters that can be 	*/
+/* or were read with fread.  On UNIX systems this is always true.  On	*/
+/* MS Windows systems, f must be opened in binary mode.			*/
+CORD CORD_from_file(FILE * f);
+
+/* Equivalent to the above, except that the entire file will be read	*/
+/* and the file pointer will be closed immediately.			*/
+/* The binary mode restriction from above does not apply.		*/
+CORD CORD_from_file_eager(FILE * f);
+
+/* Equivalent to the above, except that the file will be read on demand.*/
+/* The binary mode restriction applies.					*/
+CORD CORD_from_file_lazy(FILE * f);
+
+/* Turn a cord into a C string.	The result shares no structure with	*/
+/* x, and is thus modifiable.						*/
+char * CORD_to_char_star(CORD x);
+
+/* Turn a C string into a CORD.  The C string is copied, and so may	*/
+/* subsequently be modified.						*/
+CORD CORD_from_char_star(const char *s);
+
+/* Identical to the above, but the result may share structure with	*/
+/* the argument and is thus not modifiable.				*/
+const char * CORD_to_const_char_star(CORD x); 
+
+/* Write a cord to a file, starting at the current position.  No	*/
+/* trailing NULs are newlines are added.				*/
+/* Returns EOF if a write error occurs, 1 otherwise.			*/
+int CORD_put(CORD x, FILE * f);
+
+/* "Not found" result for the following two functions.			*/
+# define CORD_NOT_FOUND ((size_t)(-1))
+
+/* A vague analog of strchr.  Returns the position (an integer, not	*/
+/* a pointer) of the first occurrence of (char) c inside x at position 	*/
+/* i or later. The value i must be < CORD_len(x).			*/
+size_t CORD_chr(CORD x, size_t i, int c);
+
+/* A vague analog of strrchr.  Returns index of the last occurrence	*/
+/* of (char) c inside x at position i or earlier. The value i		*/
+/* must be < CORD_len(x).						*/
+size_t CORD_rchr(CORD x, size_t i, int c);
+
+
+/* The following are also not primitive, but are implemented in 	*/
+/* cordprnt.c.  They provide functionality similar to the ANSI C	*/
+/* functions with corresponding names, but with the following		*/
+/* additions and changes:						*/
+/* 1. A %r conversion specification specifies a CORD argument.  Field	*/
+/*    width, precision, etc. have the same semantics as for %s.		*/
+/*    (Note that %c,%C, and %S were already taken.)			*/
+/* 2. The format string is represented as a CORD.		        */
+/* 3. CORD_sprintf and CORD_vsprintf assign the result through the 1st	*/ 	/*    argument.	Unlike their ANSI C versions, there is no need to guess	*/
+/*    the correct buffer size.						*/
+/* 4. Most of the conversions are implement through the native 		*/
+/*    vsprintf.  Hence they are usually no faster, and 			*/
+/*    idiosyncracies of the native printf are preserved.  However,	*/
+/*    CORD arguments to CORD_sprintf and CORD_vsprintf are NOT copied;	*/
+/*    the result shares the original structure.  This may make them	*/
+/*    very efficient in some unusual applications.			*/
+/*    The format string is copied.					*/
+/* All functions return the number of characters generated or -1 on	*/
+/* error.  This complies with the ANSI standard, but is inconsistent	*/
+/* with some older implementations of sprintf.				*/
+
+/* The implementation of these is probably less portable than the rest	*/
+/* of this package.							*/
+
+#ifndef CORD_NO_IO
+
+#include <stdarg.h>
+
+int CORD_sprintf(CORD * out, CORD format, ...);
+int CORD_vsprintf(CORD * out, CORD format, va_list args);
+int CORD_fprintf(FILE * f, CORD format, ...);
+int CORD_vfprintf(FILE * f, CORD format, va_list args);
+int CORD_printf(CORD format, ...);
+int CORD_vprintf(CORD format, va_list args);
+
+#endif /* CORD_NO_IO */
+
+# endif /* CORD_H */
diff --git a/src/gc/cord/cordbscs.c b/src/gc/cord/cordbscs.c
new file mode 100644
index 000000000..9fc894d49
--- /dev/null
+++ b/src/gc/cord/cordbscs.c
@@ -0,0 +1,915 @@
+/*
+ * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * Author: Hans-J. Boehm (boehm@parc.xerox.com)
+ */
+/* Boehm, October 3, 1994 5:19 pm PDT */
+# include "gc.h"
+# include "cord.h"
+# include <stdlib.h>
+# include <stdio.h>
+# include <string.h>
+
+/* An implementation of the cord primitives.  These are the only 	*/
+/* Functions that understand the representation.  We perform only	*/
+/* minimal checks on arguments to these functions.  Out of bounds	*/
+/* arguments to the iteration functions may result in client functions	*/
+/* invoked on garbage data.  In most cases, client functions should be	*/
+/* programmed defensively enough that this does not result in memory	*/
+/* smashes.								*/ 
+
+typedef void (* oom_fn)(void);
+
+oom_fn CORD_oom_fn = (oom_fn) 0;
+
+# define OUT_OF_MEMORY {  if (CORD_oom_fn != (oom_fn) 0) (*CORD_oom_fn)(); \
+			  ABORT("Out of memory\n"); }
+# define ABORT(msg) { fprintf(stderr, "%s\n", msg); abort(); }
+
+typedef unsigned long word;
+
+typedef union {
+    struct Concatenation {
+    	char null;
+	char header;
+	char depth;	/* concatenation nesting depth. */
+	unsigned char left_len;
+			/* Length of left child if it is sufficiently	*/
+			/* short; 0 otherwise.				*/
+#	    define MAX_LEFT_LEN 255
+	word len;
+	CORD left;	/* length(left) > 0	*/
+	CORD right;	/* length(right) > 0	*/
+    } concatenation;
+    struct Function {
+	char null;
+	char header;
+	char depth;	/* always 0	*/
+	char left_len;	/* always 0	*/
+	word len;
+	CORD_fn fn;
+	void * client_data;
+    } function;
+    struct Generic {
+    	char null;
+	char header;
+	char depth;
+	char left_len;
+	word len;
+    } generic;
+    char string[1];
+} CordRep;
+
+# define CONCAT_HDR 1
+	
+# define FN_HDR 4
+# define SUBSTR_HDR 6
+	/* Substring nodes are a special case of function nodes.  	*/
+	/* The client_data field is known to point to a substr_args	*/
+	/* structure, and the function is either CORD_apply_access_fn 	*/
+	/* or CORD_index_access_fn.					*/
+
+/* The following may be applied only to function and concatenation nodes: */
+#define IS_CONCATENATION(s)  (((CordRep *)s)->generic.header == CONCAT_HDR)
+
+#define IS_FUNCTION(s)  ((((CordRep *)s)->generic.header & FN_HDR) != 0)
+
+#define IS_SUBSTR(s) (((CordRep *)s)->generic.header == SUBSTR_HDR)
+
+#define LEN(s) (((CordRep *)s) -> generic.len)
+#define DEPTH(s) (((CordRep *)s) -> generic.depth)
+#define GEN_LEN(s) (CORD_IS_STRING(s) ? strlen(s) : LEN(s))
+
+#define LEFT_LEN(c) ((c) -> left_len != 0? \
+				(c) -> left_len \
+				: (CORD_IS_STRING((c) -> left) ? \
+					(c) -> len - GEN_LEN((c) -> right) \
+					: LEN((c) -> left)))
+
+#define SHORT_LIMIT (sizeof(CordRep) - 1)
+	/* Cords shorter than this are C strings */
+
+
+/* Dump the internal representation of x to stdout, with initial 	*/
+/* indentation level n.							*/
+void CORD_dump_inner(CORD x, unsigned n)
+{
+    register size_t i;
+    
+    for (i = 0; i < (size_t)n; i++) {
+        fputs("  ", stdout);
+    }
+    if (x == 0) {
+      	fputs("NIL\n", stdout);
+    } else if (CORD_IS_STRING(x)) {
+        for (i = 0; i <= SHORT_LIMIT; i++) {
+            if (x[i] == '\0') break;
+            putchar(x[i]);
+        }
+        if (x[i] != '\0') fputs("...", stdout);
+        putchar('\n');
+    } else if (IS_CONCATENATION(x)) {
+        register struct Concatenation * conc =
+        			&(((CordRep *)x) -> concatenation);
+        printf("Concatenation: %p (len: %d, depth: %d)\n",
+               x, (int)(conc -> len), (int)(conc -> depth));
+        CORD_dump_inner(conc -> left, n+1);
+        CORD_dump_inner(conc -> right, n+1);
+    } else /* function */{
+        register struct Function * func =
+        			&(((CordRep *)x) -> function);
+        if (IS_SUBSTR(x)) printf("(Substring) ");
+        printf("Function: %p (len: %d): ", x, (int)(func -> len));
+        for (i = 0; i < 20 && i < func -> len; i++) {
+            putchar((*(func -> fn))(i, func -> client_data));
+        }
+        if (i < func -> len) fputs("...", stdout);
+        putchar('\n');
+    }
+}
+
+/* Dump the internal representation of x to stdout	*/
+void CORD_dump(CORD x)
+{
+    CORD_dump_inner(x, 0);
+    fflush(stdout);
+}
+
+CORD CORD_cat_char_star(CORD x, const char * y, size_t leny)
+{
+    register size_t result_len;
+    register size_t lenx;
+    register int depth;
+    
+    if (x == CORD_EMPTY) return(y);
+    if (leny == 0) return(x);
+    if (CORD_IS_STRING(x)) {
+        lenx = strlen(x);
+        result_len = lenx + leny;
+        if (result_len <= SHORT_LIMIT) {
+            register char * result = GC_MALLOC_ATOMIC(result_len+1);
+        
+            if (result == 0) OUT_OF_MEMORY;
+            memcpy(result, x, lenx);
+            memcpy(result + lenx, y, leny);
+            result[result_len] = '\0';
+            return((CORD) result);
+        } else {
+            depth = 1;
+        }
+    } else {
+    	register CORD right;
+    	register CORD left;
+    	register char * new_right;
+    	register size_t right_len;
+    	
+    	lenx = LEN(x);
+    	
+        if (leny <= SHORT_LIMIT/2
+    	    && IS_CONCATENATION(x)
+            && CORD_IS_STRING(right = ((CordRep *)x) -> concatenation.right)) {
+            /* Merge y into right part of x. */
+            if (!CORD_IS_STRING(left = ((CordRep *)x) -> concatenation.left)) {
+            	right_len = lenx - LEN(left);
+            } else if (((CordRep *)x) -> concatenation.left_len != 0) {
+                right_len = lenx - ((CordRep *)x) -> concatenation.left_len;
+            } else {
+            	right_len = strlen(right);
+            }
+            result_len = right_len + leny;  /* length of new_right */
+            if (result_len <= SHORT_LIMIT) {
+            	new_right = GC_MALLOC_ATOMIC(result_len + 1);
+            	memcpy(new_right, right, right_len);
+            	memcpy(new_right + right_len, y, leny);
+            	new_right[result_len] = '\0';
+            	y = new_right;
+            	leny = result_len;
+            	x = left;
+            	lenx -= right_len;
+            	/* Now fall through to concatenate the two pieces: */
+            }
+            if (CORD_IS_STRING(x)) {
+                depth = 1;
+            } else {
+                depth = DEPTH(x) + 1;
+            }
+        } else {
+            depth = DEPTH(x) + 1;
+        }
+        result_len = lenx + leny;
+    }
+    {
+      /* The general case; lenx, result_len is known: */
+    	register struct Concatenation * result;
+    	
+    	result = GC_NEW(struct Concatenation);
+    	if (result == 0) OUT_OF_MEMORY;
+    	result->header = CONCAT_HDR;
+    	result->depth = depth;
+    	if (lenx <= MAX_LEFT_LEN) result->left_len = lenx;
+    	result->len = result_len;
+    	result->left = x;
+    	result->right = y;
+    	if (depth > MAX_DEPTH) {
+    	    return(CORD_balance((CORD)result));
+    	} else {
+    	    return((CORD) result);
+    	}
+    }
+}
+
+
+CORD CORD_cat(CORD x, CORD y)
+{
+    register size_t result_len;
+    register int depth;
+    register size_t lenx;
+    
+    if (x == CORD_EMPTY) return(y);
+    if (y == CORD_EMPTY) return(x);
+    if (CORD_IS_STRING(y)) {
+        return(CORD_cat_char_star(x, y, strlen(y)));
+    } else if (CORD_IS_STRING(x)) {
+        lenx = strlen(x);
+        depth = DEPTH(y) + 1;
+    } else {
+        register int depthy = DEPTH(y);
+        
+        lenx = LEN(x);
+        depth = DEPTH(x) + 1;
+        if (depthy >= depth) depth = depthy + 1;
+    }
+    result_len = lenx + LEN(y);
+    {
+    	register struct Concatenation * result;
+    	
+    	result = GC_NEW(struct Concatenation);
+    	if (result == 0) OUT_OF_MEMORY;
+    	result->header = CONCAT_HDR;
+    	result->depth = depth;
+    	if (lenx <= MAX_LEFT_LEN) result->left_len = lenx;
+    	result->len = result_len;
+    	result->left = x;
+    	result->right = y;
+    	return((CORD) result);
+    }
+}
+
+
+
+CORD CORD_from_fn(CORD_fn fn, void * client_data, size_t len)
+{
+    if (len <= 0) return(0);
+    if (len <= SHORT_LIMIT) {
+        register char * result;
+        register size_t i;
+        char buf[SHORT_LIMIT+1];
+        register char c;
+        
+        for (i = 0; i < len; i++) {
+            c = (*fn)(i, client_data);
+            if (c == '\0') goto gen_case;
+            buf[i] = c;
+        }
+        buf[i] = '\0';
+        result = GC_MALLOC_ATOMIC(len+1);
+        if (result == 0) OUT_OF_MEMORY;
+        strcpy(result, buf);
+        result[len] = '\0';
+        return((CORD) result);
+    }
+  gen_case:
+    {
+    	register struct Function * result;
+    	
+    	result = GC_NEW(struct Function);
+    	if (result == 0) OUT_OF_MEMORY;
+    	result->header = FN_HDR;
+    	/* depth is already 0 */
+    	result->len = len;
+    	result->fn = fn;
+    	result->client_data = client_data;
+    	return((CORD) result);
+    }
+}
+
+size_t CORD_len(CORD x)
+{
+    if (x == 0) {
+     	return(0);
+    } else {
+	return(GEN_LEN(x));
+    }
+}
+
+struct substr_args {
+    CordRep * sa_cord;
+    size_t sa_index;
+};
+
+char CORD_index_access_fn(size_t i, void * client_data)
+{
+    register struct substr_args *descr = (struct substr_args *)client_data;
+    
+    return(((char *)(descr->sa_cord))[i + descr->sa_index]);
+}
+
+char CORD_apply_access_fn(size_t i, void * client_data)
+{
+    register struct substr_args *descr = (struct substr_args *)client_data;
+    register struct Function * fn_cord = &(descr->sa_cord->function);
+    
+    return((*(fn_cord->fn))(i + descr->sa_index, fn_cord->client_data));
+}
+
+/* A version of CORD_substr that simply returns a function node, thus	*/
+/* postponing its work.	The fourth argument is a function that may	*/
+/* be used for efficient access to the ith character.			*/
+/* Assumes i >= 0 and i + n < length(x).				*/
+CORD CORD_substr_closure(CORD x, size_t i, size_t n, CORD_fn f)
+{
+    register struct substr_args * sa = GC_NEW(struct substr_args);
+    CORD result;
+    
+    if (sa == 0) OUT_OF_MEMORY;
+    sa->sa_cord = (CordRep *)x;
+    sa->sa_index = i;
+    result = CORD_from_fn(f, (void *)sa, n);
+    ((CordRep *)result) -> function.header = SUBSTR_HDR;
+    return (result);
+}
+
+# define SUBSTR_LIMIT (10 * SHORT_LIMIT)
+	/* Substrings of function nodes and flat strings shorter than 	*/
+	/* this are flat strings.  Othewise we use a functional 	*/
+	/* representation, which is significantly slower to access.	*/
+
+/* A version of CORD_substr that assumes i >= 0, n > 0, and i + n < length(x).*/
+CORD CORD_substr_checked(CORD x, size_t i, size_t n)
+{
+    if (CORD_IS_STRING(x)) {
+        if (n > SUBSTR_LIMIT) {
+            return(CORD_substr_closure(x, i, n, CORD_index_access_fn));
+        } else {
+            register char * result = GC_MALLOC_ATOMIC(n+1);
+            
+            if (result == 0) OUT_OF_MEMORY;
+            strncpy(result, x+i, n);
+            result[n] = '\0';
+            return(result);
+        }
+    } else if (IS_CONCATENATION(x)) {
+    	register struct Concatenation * conc
+    			= &(((CordRep *)x) -> concatenation);
+    	register size_t left_len;
+    	register size_t right_len;
+    	
+    	left_len = LEFT_LEN(conc);
+    	right_len = conc -> len - left_len;
+    	if (i >= left_len) {
+    	    if (n == right_len) return(conc -> right);
+    	    return(CORD_substr_checked(conc -> right, i - left_len, n));
+    	} else if (i+n <= left_len) {
+    	    if (n == left_len) return(conc -> left);
+    	    return(CORD_substr_checked(conc -> left, i, n));
+    	} else {
+    	    /* Need at least one character from each side. */
+    	    register CORD left_part;
+    	    register CORD right_part;
+    	    register size_t left_part_len = left_len - i;
+     	
+    	    if (i == 0) {
+    	        left_part = conc -> left;
+    	    } else {
+    	        left_part = CORD_substr_checked(conc -> left, i, left_part_len);
+    	    }
+    	    if (i + n == right_len + left_len) {
+    	         right_part = conc -> right;
+    	    } else {
+    	         right_part = CORD_substr_checked(conc -> right, 0,
+    	    				          n - left_part_len);
+    	    }
+    	    return(CORD_cat(left_part, right_part));
+    	}
+    } else /* function */ {
+        if (n > SUBSTR_LIMIT) {
+            if (IS_SUBSTR(x)) {
+            	/* Avoid nesting substring nodes.	*/
+            	register struct Function * f = &(((CordRep *)x) -> function);
+            	register struct substr_args *descr =
+            			(struct substr_args *)(f -> client_data);
+            	
+            	return(CORD_substr_closure((CORD)descr->sa_cord,
+            				   i + descr->sa_index,
+            				   n, f -> fn));
+            } else {
+                return(CORD_substr_closure(x, i, n, CORD_apply_access_fn));
+            }
+        } else {
+            char * result;
+            register struct Function * f = &(((CordRep *)x) -> function);
+            char buf[SUBSTR_LIMIT+1];
+            register char * p = buf;
+            register char c;
+            register int j;
+            register int lim = i + n;
+            
+            for (j = i; j < lim; j++) {
+            	c = (*(f -> fn))(j, f -> client_data);
+            	if (c == '\0') {
+            	    return(CORD_substr_closure(x, i, n, CORD_apply_access_fn));
+            	}
+            	*p++ = c;
+            }
+            *p = '\0';
+            result = GC_MALLOC_ATOMIC(n+1);
+            if (result == 0) OUT_OF_MEMORY;
+            strcpy(result, buf);
+            return(result);
+        }
+    }
+}
+
+CORD CORD_substr(CORD x, size_t i, size_t n)
+{
+    register size_t len = CORD_len(x);
+    
+    if (i >= len || n <= 0) return(0);
+    	/* n < 0 is impossible in a correct C implementation, but	*/
+    	/* quite possible  under SunOS 4.X.				*/
+    if (i + n > len) n = len - i;
+#   ifndef __STDC__
+      if (i < 0) ABORT("CORD_substr: second arg. negative");
+    	/* Possible only if both client and C implementation are buggy.	*/
+    	/* But empirically this happens frequently.			*/
+#   endif
+    return(CORD_substr_checked(x, i, n));
+}
+
+/* See cord.h for definition.  We assume i is in range.	*/
+int CORD_iter5(CORD x, size_t i, CORD_iter_fn f1,
+			 CORD_batched_iter_fn f2, void * client_data)
+{
+    if (x == 0) return(0);
+    if (CORD_IS_STRING(x)) {
+    	register const char *p = x+i;
+    	
+    	if (*p == '\0') ABORT("2nd arg to CORD_iter5 too big");
+        if (f2 != CORD_NO_FN) {
+            return((*f2)(p, client_data));
+        } else {
+	    while (*p) {
+                if ((*f1)(*p, client_data)) return(1);
+                p++;
+	    }
+	    return(0);
+        }
+    } else if (IS_CONCATENATION(x)) {
+    	register struct Concatenation * conc
+    			= &(((CordRep *)x) -> concatenation);
+    	
+    	
+    	if (i > 0) {
+    	    register size_t left_len = LEFT_LEN(conc);
+    	    
+    	    if (i >= left_len) {
+    	        return(CORD_iter5(conc -> right, i - left_len, f1, f2,
+    	        		  client_data));
+    	    }
+    	}
+    	if (CORD_iter5(conc -> left, i, f1, f2, client_data)) {
+    	    return(1);
+    	}
+    	return(CORD_iter5(conc -> right, 0, f1, f2, client_data));
+    } else /* function */ {
+        register struct Function * f = &(((CordRep *)x) -> function);
+        register size_t j;
+        register size_t lim = f -> len;
+        
+        for (j = i; j < lim; j++) {
+            if ((*f1)((*(f -> fn))(j, f -> client_data), client_data)) {
+                return(1);
+            }
+        }
+        return(0);
+    }
+}
+			
+#undef CORD_iter
+int CORD_iter(CORD x, CORD_iter_fn f1, void * client_data)
+{
+    return(CORD_iter5(x, 0, f1, CORD_NO_FN, client_data));
+}
+
+int CORD_riter4(CORD x, size_t i, CORD_iter_fn f1, void * client_data)
+{
+    if (x == 0) return(0);
+    if (CORD_IS_STRING(x)) {
+	register const char *p = x + i;
+	register char c;
+               
+	for(;;) {
+	    c = *p;
+	    if (c == '\0') ABORT("2nd arg to CORD_riter4 too big");
+            if ((*f1)(c, client_data)) return(1);
+	    if (p == x) break;
+            p--;
+	}
+	return(0);
+    } else if (IS_CONCATENATION(x)) {
+    	register struct Concatenation * conc
+    			= &(((CordRep *)x) -> concatenation);
+    	register CORD left_part = conc -> left;
+    	register size_t left_len;
+    	
+    	left_len = LEFT_LEN(conc);
+    	if (i >= left_len) {
+    	    if (CORD_riter4(conc -> right, i - left_len, f1, client_data)) {
+    	    	return(1);
+    	    }
+    	    return(CORD_riter4(left_part, left_len - 1, f1, client_data));
+    	} else {
+    	    return(CORD_riter4(left_part, i, f1, client_data));
+    	}
+    } else /* function */ {
+        register struct Function * f = &(((CordRep *)x) -> function);
+        register size_t j;
+        
+        for (j = i; ; j--) {
+            if ((*f1)((*(f -> fn))(j, f -> client_data), client_data)) {
+                return(1);
+            }
+            if (j == 0) return(0);
+        }
+    }
+}
+
+int CORD_riter(CORD x, CORD_iter_fn f1, void * client_data)
+{
+    return(CORD_riter4(x, CORD_len(x) - 1, f1, client_data));
+}
+
+/*
+ * The following functions are concerned with balancing cords.
+ * Strategy:
+ * Scan the cord from left to right, keeping the cord scanned so far
+ * as a forest of balanced trees of exponentialy decreasing length.
+ * When a new subtree needs to be added to the forest, we concatenate all
+ * shorter ones to the new tree in the appropriate order, and then insert
+ * the result into the forest.
+ * Crucial invariants:
+ * 1. The concatenation of the forest (in decreasing order) with the
+ *     unscanned part of the rope is equal to the rope being balanced.
+ * 2. All trees in the forest are balanced.
+ * 3. forest[i] has depth at most i.
+ */
+
+typedef struct {
+    CORD c;
+    size_t len;		/* Actual length of c 	*/
+} ForestElement;
+
+static size_t min_len [ MAX_DEPTH ];
+
+static int min_len_init = 0;
+
+int CORD_max_len;
+
+typedef ForestElement Forest [ MAX_DEPTH ];
+			/* forest[i].len >= fib(i+1)	        */
+			/* The string is the concatenation	*/
+			/* of the forest in order of DECREASING */
+			/* indices.				*/
+
+void CORD_init_min_len()
+{
+    register int i;
+    register size_t last, previous, current;
+        
+    min_len[0] = previous = 1;
+    min_len[1] = last = 2;
+    for (i = 2; i < MAX_DEPTH; i++) {
+    	current = last + previous;
+    	if (current < last) /* overflow */ current = last;
+    	min_len[i] = current;
+    	previous = last;
+    	last = current;
+    }
+    CORD_max_len = last - 1;
+    min_len_init = 1;
+}
+
+
+void CORD_init_forest(ForestElement * forest, size_t max_len)
+{
+    register int i;
+    
+    for (i = 0; i < MAX_DEPTH; i++) {
+    	forest[i].c = 0;
+    	if (min_len[i] > max_len) return;
+    }
+    ABORT("Cord too long");
+}
+
+/* Add a leaf to the appropriate level in the forest, cleaning		*/
+/* out lower levels as necessary.					*/
+/* Also works if x is a balanced tree of concatenations; however	*/
+/* in this case an extra concatenation node may be inserted above x;	*/
+/* This node should not be counted in the statement of the invariants.	*/
+void CORD_add_forest(ForestElement * forest, CORD x, size_t len)
+{
+    register int i = 0;
+    register CORD sum = CORD_EMPTY;
+    register size_t sum_len = 0;
+    
+    while (len > min_len[i + 1]) {
+    	if (forest[i].c != 0) {
+    	    sum = CORD_cat(forest[i].c, sum);
+    	    sum_len += forest[i].len;
+    	    forest[i].c = 0;
+    	}
+        i++;
+    }
+    /* Sum has depth at most 1 greter than what would be required 	*/
+    /* for balance.							*/
+    sum = CORD_cat(sum, x);
+    sum_len += len;
+    /* If x was a leaf, then sum is now balanced.  To see this		*/
+    /* consider the two cases in which forest[i-1] either is or is 	*/
+    /* not empty.							*/
+    while (sum_len >= min_len[i]) {
+    	if (forest[i].c != 0) {
+    	    sum = CORD_cat(forest[i].c, sum);
+    	    sum_len += forest[i].len;
+    	    /* This is again balanced, since sum was balanced, and has	*/
+    	    /* allowable depth that differs from i by at most 1.	*/
+    	    forest[i].c = 0;
+    	}
+        i++;
+    }
+    i--;
+    forest[i].c = sum;
+    forest[i].len = sum_len;
+}
+
+CORD CORD_concat_forest(ForestElement * forest, size_t expected_len)
+{
+    register int i = 0;
+    CORD sum = 0;
+    size_t sum_len = 0;
+    
+    while (sum_len != expected_len) {
+    	if (forest[i].c != 0) {
+    	    sum = CORD_cat(forest[i].c, sum);
+    	    sum_len += forest[i].len;
+    	}
+        i++;
+    }
+    return(sum);
+}
+
+/* Insert the frontier of x into forest.  Balanced subtrees are	*/
+/* treated as leaves.  This potentially adds one to the depth	*/
+/* of the final tree.						*/
+void CORD_balance_insert(CORD x, size_t len, ForestElement * forest)
+{
+    register int depth;
+    
+    if (CORD_IS_STRING(x)) {
+        CORD_add_forest(forest, x, len);
+    } else if (IS_CONCATENATION(x)
+               && ((depth = DEPTH(x)) >= MAX_DEPTH
+                   || len < min_len[depth])) {
+    	register struct Concatenation * conc
+    			= &(((CordRep *)x) -> concatenation);
+    	size_t left_len = LEFT_LEN(conc);
+    	
+    	CORD_balance_insert(conc -> left, left_len, forest);
+    	CORD_balance_insert(conc -> right, len - left_len, forest);
+    } else /* function or balanced */ {
+    	CORD_add_forest(forest, x, len);
+    }
+}
+
+
+CORD CORD_balance(CORD x)
+{
+    Forest forest;
+    register size_t len;
+    
+    if (x == 0) return(0);
+    if (CORD_IS_STRING(x)) return(x);
+    if (!min_len_init) CORD_init_min_len();
+    len = LEN(x);
+    CORD_init_forest(forest, len);
+    CORD_balance_insert(x, len, forest);
+    return(CORD_concat_forest(forest, len));
+}
+
+
+/* Position primitives	*/
+
+/* Private routines to deal with the hard cases only: */
+
+/* P contains a prefix of the  path to cur_pos.	Extend it to a full	*/
+/* path and set up leaf info.						*/
+/* Return 0 if past the end of cord, 1 o.w.				*/
+void CORD__extend_path(register CORD_pos p)
+{
+     register struct CORD_pe * current_pe = &(p[0].path[p[0].path_len]);
+     register CORD top = current_pe -> pe_cord;
+     register size_t pos = p[0].cur_pos;
+     register size_t top_pos = current_pe -> pe_start_pos;
+     register size_t top_len = GEN_LEN(top);
+     
+     /* Fill in the rest of the path. */
+       while(!CORD_IS_STRING(top) && IS_CONCATENATION(top)) {
+     	 register struct Concatenation * conc =
+     	 		&(((CordRep *)top) -> concatenation);
+     	 register size_t left_len;
+     	 
+     	 left_len = LEFT_LEN(conc);
+     	 current_pe++;
+     	 if (pos >= top_pos + left_len) {
+     	     current_pe -> pe_cord = top = conc -> right;
+     	     current_pe -> pe_start_pos = top_pos = top_pos + left_len;
+     	     top_len -= left_len;
+     	 } else {
+     	     current_pe -> pe_cord = top = conc -> left;
+     	     current_pe -> pe_start_pos = top_pos;
+     	     top_len = left_len;
+     	 }
+     	 p[0].path_len++;
+       }
+     /* Fill in leaf description for fast access. */
+       if (CORD_IS_STRING(top)) {
+         p[0].cur_leaf = top;
+         p[0].cur_start = top_pos;
+         p[0].cur_end = top_pos + top_len;
+       } else {
+         p[0].cur_end = 0;
+       }
+       if (pos >= top_pos + top_len) p[0].path_len = CORD_POS_INVALID;
+}
+
+char CORD__pos_fetch(register CORD_pos p)
+{
+    /* Leaf is a function node */
+    struct CORD_pe * pe = &((p)[0].path[(p)[0].path_len]);
+    CORD leaf = pe -> pe_cord;
+    register struct Function * f = &(((CordRep *)leaf) -> function);
+    
+    if (!IS_FUNCTION(leaf)) ABORT("CORD_pos_fetch: bad leaf");
+    return ((*(f -> fn))(p[0].cur_pos - pe -> pe_start_pos, f -> client_data));
+}
+
+void CORD__next(register CORD_pos p)
+{
+    register size_t cur_pos = p[0].cur_pos + 1;
+    register struct CORD_pe * current_pe = &((p)[0].path[(p)[0].path_len]);
+    register CORD leaf = current_pe -> pe_cord;
+    
+    /* Leaf is not a string or we're at end of leaf */
+    p[0].cur_pos = cur_pos;
+    if (!CORD_IS_STRING(leaf)) {
+    	/* Function leaf	*/
+    	register struct Function * f = &(((CordRep *)leaf) -> function);
+    	register size_t start_pos = current_pe -> pe_start_pos;
+    	register size_t end_pos = start_pos + f -> len;
+    	
+    	if (cur_pos < end_pos) {
+    	  /* Fill cache and return. */
+    	    register size_t i;
+    	    register size_t limit = cur_pos + FUNCTION_BUF_SZ;
+    	    register CORD_fn fn = f -> fn;
+    	    register void * client_data = f -> client_data;
+    	    
+    	    if (limit > end_pos) {
+    	        limit = end_pos;
+    	    }
+    	    for (i = cur_pos; i < limit; i++) {
+    	        p[0].function_buf[i - cur_pos] =
+    	        	(*fn)(i - start_pos, client_data);
+    	    }
+    	    p[0].cur_start = cur_pos;
+    	    p[0].cur_leaf = p[0].function_buf;
+    	    p[0].cur_end = limit;
+    	    return;
+    	}
+    }
+    /* End of leaf	*/
+    /* Pop the stack until we find two concatenation nodes with the 	*/
+    /* same start position: this implies we were in left part.		*/
+    {
+    	while (p[0].path_len > 0
+    	       && current_pe[0].pe_start_pos != current_pe[-1].pe_start_pos) {
+    	    p[0].path_len--;
+    	    current_pe--;
+    	}
+    	if (p[0].path_len == 0) {
+	    p[0].path_len = CORD_POS_INVALID;
+            return;
+	}
+    }
+    p[0].path_len--;
+    CORD__extend_path(p);
+}
+
+void CORD__prev(register CORD_pos p)
+{
+    register struct CORD_pe * pe = &(p[0].path[p[0].path_len]);
+    
+    if (p[0].cur_pos == 0) {
+        p[0].path_len = CORD_POS_INVALID;
+        return;
+    }
+    p[0].cur_pos--;
+    if (p[0].cur_pos >= pe -> pe_start_pos) return;
+    
+    /* Beginning of leaf	*/
+    
+    /* Pop the stack until we find two concatenation nodes with the 	*/
+    /* different start position: this implies we were in right part.	*/
+    {
+    	register struct CORD_pe * current_pe = &((p)[0].path[(p)[0].path_len]);
+    	
+    	while (p[0].path_len > 0
+    	       && current_pe[0].pe_start_pos == current_pe[-1].pe_start_pos) {
+    	    p[0].path_len--;
+    	    current_pe--;
+    	}
+    }
+    p[0].path_len--;
+    CORD__extend_path(p);
+}
+
+#undef CORD_pos_fetch
+#undef CORD_next
+#undef CORD_prev
+#undef CORD_pos_to_index
+#undef CORD_pos_to_cord
+#undef CORD_pos_valid
+
+char CORD_pos_fetch(register CORD_pos p)
+{
+    if (p[0].cur_start <= p[0].cur_pos && p[0].cur_pos < p[0].cur_end) {
+    	return(p[0].cur_leaf[p[0].cur_pos - p[0].cur_start]);
+    } else {
+        return(CORD__pos_fetch(p));
+    }
+}
+
+void CORD_next(CORD_pos p)
+{
+    if (p[0].cur_pos < p[0].cur_end - 1) {
+    	p[0].cur_pos++;
+    } else {
+    	CORD__next(p);
+    }
+}
+
+void CORD_prev(CORD_pos p)
+{
+    if (p[0].cur_end != 0 && p[0].cur_pos > p[0].cur_start) {
+    	p[0].cur_pos--;
+    } else {
+    	CORD__prev(p);
+    }
+}
+
+size_t CORD_pos_to_index(CORD_pos p)
+{
+    return(p[0].cur_pos);
+}
+
+CORD CORD_pos_to_cord(CORD_pos p)
+{
+    return(p[0].path[0].pe_cord);
+}
+
+int CORD_pos_valid(CORD_pos p)
+{
+    return(p[0].path_len != CORD_POS_INVALID);
+}
+
+void CORD_set_pos(CORD_pos p, CORD x, size_t i)
+{
+    if (x == CORD_EMPTY) {
+    	p[0].path_len = CORD_POS_INVALID;
+    	return;
+    }
+    p[0].path[0].pe_cord = x;
+    p[0].path[0].pe_start_pos = 0;
+    p[0].path_len = 0;
+    p[0].cur_pos = i;
+    CORD__extend_path(p);
+}
diff --git a/src/gc/cord/cordprnt.c b/src/gc/cord/cordprnt.c
new file mode 100644
index 000000000..8d57f0467
--- /dev/null
+++ b/src/gc/cord/cordprnt.c
@@ -0,0 +1,390 @@
+/* 
+ * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* An sprintf implementation that understands cords.  This is probably	*/
+/* not terribly portable.  It assumes an ANSI stdarg.h.  It further	*/
+/* assumes that I can make copies of va_list variables, and read 	*/
+/* arguments repeatedly by applyting va_arg to the copies.  This	*/
+/* could be avoided at some performance cost.				*/
+/* We also assume that unsigned and signed integers of various kinds	*/
+/* have the same sizes, and can be cast back and forth.			*/
+/* We assume that void * and char * have the same size.			*/
+/* All this cruft is needed because we want to rely on the underlying	*/
+/* sprintf implementation whenever possible.				*/
+/* Boehm, September 21, 1995 6:00 pm PDT */
+
+#include "cord.h"
+#include "ec.h"
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
+#include "gc.h"
+
+#define CONV_SPEC_LEN 50	/* Maximum length of a single	*/
+				/* conversion specification.	*/
+#define CONV_RESULT_LEN 50	/* Maximum length of any 	*/
+				/* conversion with default	*/
+				/* width and prec.		*/
+
+
+static int ec_len(CORD_ec x)
+{
+    return(CORD_len(x[0].ec_cord) + (x[0].ec_bufptr - x[0].ec_buf));
+}
+
+/* Possible nonumeric precision values.	*/
+# define NONE -1
+# define VARIABLE -2
+/* Copy the conversion specification from CORD_pos into the buffer buf	*/
+/* Return negative on error.						*/
+/* Source initially points one past the leading %.			*/
+/* It is left pointing at the conversion type.				*/
+/* Assign field width and precision to *width and *prec.		*/
+/* If width or prec is *, VARIABLE is assigned.				*/
+/* Set *left to 1 if left adjustment flag is present.			*/
+/* Set *long_arg to 1 if long flag ('l' or 'L') is present, or to	*/
+/* -1 if 'h' is present.						*/
+static int extract_conv_spec(CORD_pos source, char *buf,
+			     int * width, int *prec, int *left, int * long_arg)
+{
+    register int result = 0;
+    register int current_number = 0;
+    register int saw_period = 0;
+    register int saw_number;
+    register int chars_so_far = 0;
+    register char current;
+    
+    *width = NONE;
+    buf[chars_so_far++] = '%';
+    while(CORD_pos_valid(source)) {
+        if (chars_so_far >= CONV_SPEC_LEN) return(-1);
+        current = CORD_pos_fetch(source);
+        buf[chars_so_far++] = current;
+        switch(current) {
+	  case '*':
+	    saw_number = 1;
+	    current_number = VARIABLE;
+	    break;
+          case '0':
+            if (!saw_number) {
+                /* Zero fill flag; ignore */
+                break;
+            } /* otherwise fall through: */
+          case '1':
+	  case '2':
+	  case '3':
+	  case '4':
+	  case '5':
+          case '6':
+	  case '7':
+	  case '8':
+	  case '9':
+	    saw_number = 1;
+	    current_number *= 10;
+	    current_number += current - '0';
+	    break;
+	  case '.':
+	    saw_period = 1;
+	    if(saw_number) {
+	        *width = current_number;
+	        saw_number = 0;
+	    }
+	    current_number = 0;
+	    break;
+	  case 'l':
+	  case 'L':
+	    *long_arg = 1;
+	    current_number = 0;
+	    break;
+	  case 'h':
+	    *long_arg = -1;
+	    current_number = 0;
+	    break;
+	  case ' ':
+	  case '+':
+	  case '#':
+	    current_number = 0;
+	    break;
+	  case '-':
+	    *left = 1;
+	    current_number = 0;
+	    break;
+	  case 'd':
+	  case 'i':
+	  case 'o':
+	  case 'u':
+	  case 'x':
+	  case 'X':
+	  case 'f':
+	  case 'e':
+	  case 'E':
+	  case 'g':
+	  case 'G':
+	  case 'c':
+	  case 'C':
+	  case 's':
+	  case 'S':
+	  case 'p':
+	  case 'n':
+	  case 'r':
+	    goto done;          
+          default:
+            return(-1);
+        }
+        CORD_next(source);
+    }
+    return(-1);
+  done:
+    if (saw_number) {
+    	if (saw_period) {
+    	    *prec = current_number;
+    	} else {
+    	    *prec = NONE;
+    	    *width = current_number;
+    	}
+    } else {
+    	*prec = NONE;
+    }
+    buf[chars_so_far] = '\0';
+    return(result);
+}
+
+int CORD_vsprintf(CORD * out, CORD format, va_list args)
+{
+    CORD_ec result;
+    register int count;
+    register char current;
+    CORD_pos pos;
+    char conv_spec[CONV_SPEC_LEN + 1];
+    
+    CORD_ec_init(result);
+    for (CORD_set_pos(pos, format, 0); CORD_pos_valid(pos); CORD_next(pos)) {
+       	current = CORD_pos_fetch(pos);
+       	if (current == '%') {
+            CORD_next(pos);
+            if (!CORD_pos_valid(pos)) return(-1);
+            current = CORD_pos_fetch(pos);
+            if (current == '%') {
+               	CORD_ec_append(result, current);
+            } else {
+             	int width, prec;
+             	int left_adj = 0;
+             	int long_arg = 0;
+		CORD arg;
+		size_t len;
+               
+              	if (extract_conv_spec(pos, conv_spec,
+              			      &width, &prec,
+              			      &left_adj, &long_arg) < 0) {
+              	    return(-1);
+              	}
+              	current = CORD_pos_fetch(pos);
+            	switch(current) {
+            	    case 'n':
+            	    	/* Assign length to next arg */
+            	    	if (long_arg == 0) {
+            	    	    int * pos_ptr;
+            	    	    pos_ptr = va_arg(args, int *);
+            	    	    *pos_ptr = ec_len(result);
+            	    	} else if (long_arg > 0) {
+            	    	    long * pos_ptr;
+            	    	    pos_ptr = va_arg(args, long *);
+            	    	    *pos_ptr = ec_len(result);
+            	    	} else {
+            	    	    short * pos_ptr;
+            	    	    pos_ptr = va_arg(args, short *);
+            	    	    *pos_ptr = ec_len(result);
+            	    	}
+            	    	goto done;
+            	    case 'r':
+            	    	/* Append cord and any padding	*/
+            	    	if (width == VARIABLE) width = va_arg(args, int);
+            	    	if (prec == VARIABLE) prec = va_arg(args, int);
+			arg = va_arg(args, CORD);
+			len = CORD_len(arg);
+			if (prec != NONE && len > prec) {
+			  if (prec < 0) return(-1);
+			  arg = CORD_substr(arg, 0, prec);
+			  len = prec;
+			}
+			if (width != NONE && len < width) {
+			  char * blanks = GC_MALLOC_ATOMIC(width-len+1);
+
+			  memset(blanks, ' ', width-len);
+			  blanks[width-len] = '\0';
+			  if (left_adj) {
+			    arg = CORD_cat(arg, blanks);
+			  } else {
+			    arg = CORD_cat(blanks, arg);
+			  }
+			}
+			CORD_ec_append_cord(result, arg);
+            	    	goto done;
+		    case 'c':
+			if (width == NONE && prec == NONE) {
+			    register char c;
+
+			    c = va_arg(args, int);
+			    CORD_ec_append(result, c);
+			    goto done;
+			}
+			break;
+		    case 's':
+		        if (width == NONE && prec == NONE) {
+			    char * str = va_arg(args, char *);
+			    register char c;
+
+			    while (c = *str++) {
+			        CORD_ec_append(result, c);
+			    }
+			    goto done;
+			}
+			break;
+            	    default:
+            	        break;
+            	}
+            	/* Use standard sprintf to perform conversion */
+            	{
+            	    register char * buf;
+            	    va_list vsprintf_args = args;
+            	    	/* The above does not appear to be sanctioned	*/
+            	    	/* by the ANSI C standard.			*/
+            	    int max_size = 0;
+            	    int res;
+            	    	
+            	    if (width == VARIABLE) width = va_arg(args, int);
+            	    if (prec == VARIABLE) prec = va_arg(args, int);
+            	    if (width != NONE) max_size = width;
+            	    if (prec != NONE && prec > max_size) max_size = prec;
+            	    max_size += CONV_RESULT_LEN;
+            	    if (max_size >= CORD_BUFSZ) {
+            	        buf = GC_MALLOC_ATOMIC(max_size + 1);
+            	    } else {
+            	        if (CORD_BUFSZ - (result[0].ec_bufptr-result[0].ec_buf)
+            	            < max_size) {
+            	            CORD_ec_flush_buf(result);
+            	        }
+            	        buf = result[0].ec_bufptr;
+            	    }
+            	    switch(current) {
+            	        case 'd':
+            	        case 'i':
+            	        case 'o':
+            	        case 'u':
+            	        case 'x':
+            	        case 'X':
+            	        case 'c':
+            	            if (long_arg <= 0) {
+            	              (void) va_arg(args, int);
+            	            } else if (long_arg > 0) {
+            	              (void) va_arg(args, long);
+            	            }
+            	            break;
+            	        case 's':
+            	        case 'p':
+            	            (void) va_arg(args, char *);
+            	            break;
+            	        case 'f':
+            	        case 'e':
+            	        case 'E':
+            	        case 'g':
+            	        case 'G':
+            	            (void) va_arg(args, double);
+            	            break;
+            	        default:
+            	            return(-1);
+            	    }
+            	    res = vsprintf(buf, conv_spec, vsprintf_args);
+            	    len = (size_t)res;
+            	    if ((char *)(GC_word)res == buf) {
+            	    	/* old style vsprintf */
+            	    	len = strlen(buf);
+            	    } else if (res < 0) {
+            	        return(-1);
+            	    }
+            	    if (buf != result[0].ec_bufptr) {
+            	        register char c;
+
+			while (c = *buf++) {
+			    CORD_ec_append(result, c);
+		        }
+		    } else {
+		        result[0].ec_bufptr = buf + len;
+		    }
+            	}
+              done:;
+            }
+        } else {
+            CORD_ec_append(result, current);
+        }
+    }
+    count = ec_len(result);
+    *out = CORD_balance(CORD_ec_to_cord(result));
+    return(count);
+}
+
+int CORD_sprintf(CORD * out, CORD format, ...)
+{
+    va_list args;
+    int result;
+    
+    va_start(args, format);
+    result = CORD_vsprintf(out, format, args);
+    va_end(args);
+    return(result);
+}
+
+int CORD_fprintf(FILE * f, CORD format, ...)
+{
+    va_list args;
+    int result;
+    CORD out;
+    
+    va_start(args, format);
+    result = CORD_vsprintf(&out, format, args);
+    va_end(args);
+    if (result > 0) CORD_put(out, f);
+    return(result);
+}
+
+int CORD_vfprintf(FILE * f, CORD format, va_list args)
+{
+    int result;
+    CORD out;
+    
+    result = CORD_vsprintf(&out, format, args);
+    if (result > 0) CORD_put(out, f);
+    return(result);
+}
+
+int CORD_printf(CORD format, ...)
+{
+    va_list args;
+    int result;
+    CORD out;
+    
+    va_start(args, format);
+    result = CORD_vsprintf(&out, format, args);
+    va_end(args);
+    if (result > 0) CORD_put(out, stdout);
+    return(result);
+}
+
+int CORD_vprintf(CORD format, va_list args)
+{
+    int result;
+    CORD out;
+    
+    result = CORD_vsprintf(&out, format, args);
+    if (result > 0) CORD_put(out, stdout);
+    return(result);
+}
diff --git a/src/gc/cord/cordtest.c b/src/gc/cord/cordtest.c
new file mode 100644
index 000000000..d11d7dd44
--- /dev/null
+++ b/src/gc/cord/cordtest.c
@@ -0,0 +1,228 @@
+/* 
+ * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, August 24, 1994 11:58 am PDT */
+# include "cord.h"
+# include <string.h>
+# include <stdio.h>
+/* This is a very incomplete test of the cord package.  It knows about	*/
+/* a few internals of the package (e.g. when C strings are returned)	*/
+/* that real clients shouldn't rely on.					*/
+
+# define ABORT(string) \
+{ int x = 0; fprintf(stderr, "FAILED: %s\n", string); x = 1 / x; abort(); }
+
+int count;
+
+int test_fn(char c, void * client_data)
+{
+    if (client_data != (void *)13) ABORT("bad client data");
+    if (count < 64*1024+1) {
+        if ((count & 1) == 0) {
+            if (c != 'b') ABORT("bad char");
+        } else {
+            if (c != 'a') ABORT("bad char");
+        }
+        count++;
+        return(0);
+    } else {
+        if (c != 'c') ABORT("bad char");
+        count++;
+        return(1);
+    }
+}
+
+char id_cord_fn(size_t i, void * client_data)
+{
+    return((char)i);
+}
+
+void test_basics()
+{
+    CORD x = CORD_from_char_star("ab");
+    register int i;
+    char c;
+    CORD y;
+    CORD_pos p;
+    
+    x = CORD_cat(x,x);
+    if (!CORD_IS_STRING(x)) ABORT("short cord should usually be a string");
+    if (strcmp(x, "abab") != 0) ABORT("bad CORD_cat result");
+    
+    for (i = 1; i < 16; i++) {
+        x = CORD_cat(x,x);
+    }
+    x = CORD_cat(x,"c");
+    if (CORD_len(x) != 128*1024+1) ABORT("bad length");
+    
+    count = 0;
+    if (CORD_iter5(x, 64*1024-1, test_fn, CORD_NO_FN, (void *)13) == 0) {
+        ABORT("CORD_iter5 failed");
+    }
+    if (count != 64*1024 + 2) ABORT("CORD_iter5 failed");
+    
+    count = 0;
+    CORD_set_pos(p, x, 64*1024-1);
+    while(CORD_pos_valid(p)) {
+       	(void) test_fn(CORD_pos_fetch(p), (void *)13);
+	CORD_next(p);
+    }
+    if (count != 64*1024 + 2) ABORT("Position based iteration failed");
+    
+    y = CORD_substr(x, 1023, 5);
+    if (!CORD_IS_STRING(y)) ABORT("short cord should usually be a string");
+    if (strcmp(y, "babab") != 0) ABORT("bad CORD_substr result");
+    
+    y = CORD_substr(x, 1024, 8);
+    if (!CORD_IS_STRING(y)) ABORT("short cord should usually be a string");
+    if (strcmp(y, "abababab") != 0) ABORT("bad CORD_substr result");
+    
+    y = CORD_substr(x, 128*1024-1, 8);
+    if (!CORD_IS_STRING(y)) ABORT("short cord should usually be a string");
+    if (strcmp(y, "bc") != 0) ABORT("bad CORD_substr result");
+    
+    x = CORD_balance(x);
+    if (CORD_len(x) != 128*1024+1) ABORT("bad length");
+    
+    count = 0;
+    if (CORD_iter5(x, 64*1024-1, test_fn, CORD_NO_FN, (void *)13) == 0) {
+        ABORT("CORD_iter5 failed");
+    }
+    if (count != 64*1024 + 2) ABORT("CORD_iter5 failed");
+    
+    y = CORD_substr(x, 1023, 5);
+    if (!CORD_IS_STRING(y)) ABORT("short cord should usually be a string");
+    if (strcmp(y, "babab") != 0) ABORT("bad CORD_substr result");
+    y = CORD_from_fn(id_cord_fn, 0, 13);
+    i = 0;
+    CORD_set_pos(p, y, i);
+    while(CORD_pos_valid(p)) {
+        c = CORD_pos_fetch(p);
+       	if(c != i) ABORT("Traversal of function node failed");
+	CORD_next(p); i++;
+    }
+    if (i != 13) ABORT("Bad apparent length for function node");
+}
+
+void test_extras()
+{
+#   if defined(__OS2__)
+#	define FNAME1 "tmp1"
+#	define FNAME2 "tmp2"
+#   elif defined(AMIGA)
+#	define FNAME1 "T:tmp1"
+#	define FNAME2 "T:tmp2"
+#   else
+#	define FNAME1 "/tmp/cord_test"
+#	define FNAME2 "/tmp/cord_test2"
+#   endif
+    register int i;
+    CORD y = "abcdefghijklmnopqrstuvwxyz0123456789";
+    CORD x = "{}";
+    CORD w, z;
+    FILE *f;
+    FILE *f1a, *f1b, *f2;
+    
+    w = CORD_cat(CORD_cat(y,y),y);
+    z = CORD_catn(3,y,y,y);
+    if (CORD_cmp(w,z) != 0) ABORT("CORD_catn comparison wrong");
+    for (i = 1; i < 100; i++) {
+        x = CORD_cat(x, y);
+    }
+    z = CORD_balance(x);
+    if (CORD_cmp(x,z) != 0) ABORT("balanced string comparison wrong");
+    if (CORD_cmp(x,CORD_cat(z, CORD_nul(13))) >= 0) ABORT("comparison 2");
+    if (CORD_cmp(CORD_cat(x, CORD_nul(13)), z) <= 0) ABORT("comparison 3");
+    if (CORD_cmp(x,CORD_cat(z, "13")) >= 0) ABORT("comparison 4");
+    if ((f = fopen(FNAME1, "w")) == 0) ABORT("open failed");
+    if (CORD_put(z,f) == EOF) ABORT("CORD_put failed");
+    if (fclose(f) == EOF) ABORT("fclose failed");
+    w = CORD_from_file(f1a = fopen(FNAME1, "rb"));
+    if (CORD_len(w) != CORD_len(z)) ABORT("file length wrong");
+    if (CORD_cmp(w,z) != 0) ABORT("file comparison wrong");
+    if (CORD_cmp(CORD_substr(w, 50*36+2, 36), y) != 0)
+    	ABORT("file substr wrong");
+    z = CORD_from_file_lazy(f1b = fopen(FNAME1, "rb"));
+    if (CORD_cmp(w,z) != 0) ABORT("File conversions differ");
+    if (CORD_chr(w, 0, '9') != 37) ABORT("CORD_chr failed 1");
+    if (CORD_chr(w, 3, 'a') != 38) ABORT("CORD_chr failed 2");
+    if (CORD_rchr(w, CORD_len(w) - 1, '}') != 1) ABORT("CORD_rchr failed");
+    x = y;
+    for (i = 1; i < 14; i++) {
+        x = CORD_cat(x,x);
+    }
+    if ((f = fopen(FNAME2, "w")) == 0) ABORT("2nd open failed");
+    if (CORD_put(x,f) == EOF) ABORT("CORD_put failed");
+    if (fclose(f) == EOF) ABORT("fclose failed");
+    w = CORD_from_file(f2 = fopen(FNAME2, "rb"));
+    if (CORD_len(w) != CORD_len(x)) ABORT("file length wrong");
+    if (CORD_cmp(w,x) != 0) ABORT("file comparison wrong");
+    if (CORD_cmp(CORD_substr(w, 1000*36, 36), y) != 0)
+    	ABORT("file substr wrong");
+    if (strcmp(CORD_to_char_star(CORD_substr(w, 1000*36, 36)), y) != 0)
+    	ABORT("char * file substr wrong");
+    if (strcmp(CORD_substr(w, 1000*36, 2), "ab") != 0)
+    	ABORT("short file substr wrong");
+    if (CORD_str(x,1,"9a") != 35) ABORT("CORD_str failed 1");
+    if (CORD_str(x,0,"9abcdefghijk") != 35) ABORT("CORD_str failed 2");
+    if (CORD_str(x,0,"9abcdefghijx") != CORD_NOT_FOUND)
+    	ABORT("CORD_str failed 3");
+    if (CORD_str(x,0,"9>") != CORD_NOT_FOUND) ABORT("CORD_str failed 4");
+    if (remove(FNAME1) != 0) {
+    	/* On some systems, e.g. OS2, this may fail if f1 is still open. */
+    	if ((fclose(f1a) == EOF) & (fclose(f1b) == EOF))
+    		ABORT("fclose(f1) failed");
+    	if (remove(FNAME1) != 0) ABORT("remove 1 failed");
+    }
+    if (remove(FNAME2) != 0) {
+    	if (fclose(f2) == EOF) ABORT("fclose(f2) failed");
+    	if (remove(FNAME2) != 0) ABORT("remove 2 failed");
+    }
+}
+
+void test_printf()
+{
+    CORD result;
+    char result2[200];
+    long l;
+    short s;
+    CORD x;
+    
+    if (CORD_sprintf(&result, "%7.2f%ln", 3.14159F, &l) != 7)
+    	ABORT("CORD_sprintf failed 1");
+    if (CORD_cmp(result, "   3.14") != 0)ABORT("CORD_sprintf goofed 1");
+    if (l != 7) ABORT("CORD_sprintf goofed 2");
+    if (CORD_sprintf(&result, "%-7.2s%hn%c%s", "abcd", &s, 'x', "yz") != 10)
+    	ABORT("CORD_sprintf failed 2");
+    if (CORD_cmp(result, "ab     xyz") != 0)ABORT("CORD_sprintf goofed 3");
+    if (s != 7) ABORT("CORD_sprintf goofed 4");
+    x = "abcdefghij";
+    x = CORD_cat(x,x);
+    x = CORD_cat(x,x);
+    x = CORD_cat(x,x);
+    if (CORD_sprintf(&result, "->%-120.78r!\n", x) != 124)
+    	ABORT("CORD_sprintf failed 3");
+    (void) sprintf(result2, "->%-120.78s!\n", CORD_to_char_star(x));
+    if (CORD_cmp(result, result2) != 0)ABORT("CORD_sprintf goofed 5");
+}
+
+main()
+{
+#   ifdef THINK_C
+        printf("cordtest:\n");
+#   endif
+    test_basics();
+    test_extras();
+    test_printf();
+    CORD_fprintf(stderr, "SUCCEEDED\n");
+    return(0);
+}
diff --git a/src/gc/cord/cordxtra.c b/src/gc/cord/cordxtra.c
new file mode 100644
index 000000000..a5be10de5
--- /dev/null
+++ b/src/gc/cord/cordxtra.c
@@ -0,0 +1,621 @@
+/*
+ * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * Author: Hans-J. Boehm (boehm@parc.xerox.com)
+ */
+/*
+ * These are functions on cords that do not need to understand their
+ * implementation.  They serve also serve as example client code for
+ * cord_basics.
+ */
+/* Boehm, December 8, 1995 1:53 pm PST */
+# include <stdio.h>
+# include <string.h>
+# include <stdlib.h>
+# include <stdarg.h>
+# include "cord.h"
+# include "ec.h"
+# define I_HIDE_POINTERS	/* So we get access to allocation lock.	*/
+				/* We use this for lazy file reading, 	*/
+				/* so that we remain independent 	*/
+				/* of the threads primitives.		*/
+# include "gc.h"
+
+/* For now we assume that pointer reads and writes are atomic, 	*/
+/* i.e. another thread always sees the state before or after	*/
+/* a write.  This might be false on a Motorola M68K with	*/
+/* pointers that are not 32-bit aligned.  But there probably	*/
+/* aren't too many threads packages running on those.		*/
+# define ATOMIC_WRITE(x,y) (x) = (y)
+# define ATOMIC_READ(x) (*(x))
+
+/* The standard says these are in stdio.h, but they aren't always: */
+# ifndef SEEK_SET
+#   define SEEK_SET 0
+# endif
+# ifndef SEEK_END
+#   define SEEK_END 2
+# endif
+
+# define BUFSZ 2048	/* Size of stack allocated buffers when		*/
+			/* we want large buffers.			*/
+
+typedef void (* oom_fn)(void);
+
+# define OUT_OF_MEMORY {  if (CORD_oom_fn != (oom_fn) 0) (*CORD_oom_fn)(); \
+			  ABORT("Out of memory\n"); }
+# define ABORT(msg) { fprintf(stderr, "%s\n", msg); abort(); }
+
+CORD CORD_cat_char(CORD x, char c)
+{
+    register char * string;
+    
+    if (c == '\0') return(CORD_cat(x, CORD_nul(1)));
+    string = GC_MALLOC_ATOMIC(2);
+    if (string == 0) OUT_OF_MEMORY;
+    string[0] = c;
+    string[1] = '\0';
+    return(CORD_cat_char_star(x, string, 1));
+}
+
+CORD CORD_catn(int nargs, ...)
+{
+    register CORD result = CORD_EMPTY;
+    va_list args;
+    register int i;
+
+    va_start(args, nargs);
+    for (i = 0; i < nargs; i++) {
+        register CORD next = va_arg(args, CORD);
+        result = CORD_cat(result, next);
+    }
+    va_end(args);
+    return(result);
+}
+
+typedef struct {
+	size_t len;
+	size_t count;
+	char * buf;
+} CORD_fill_data;
+
+int CORD_fill_proc(char c, void * client_data)
+{
+    register CORD_fill_data * d = (CORD_fill_data *)client_data;
+    register size_t count = d -> count;
+    
+    (d -> buf)[count] = c;
+    d -> count = ++count;
+    if (count >= d -> len) {
+    	return(1);
+    } else {
+    	return(0);
+    }
+}
+
+int CORD_batched_fill_proc(const char * s, void * client_data)
+{
+    register CORD_fill_data * d = (CORD_fill_data *)client_data;
+    register size_t count = d -> count;
+    register size_t max = d -> len;
+    register char * buf = d -> buf;
+    register const char * t = s;
+    
+    while((buf[count] = *t++) != '\0') {
+        count++;
+        if (count >= max) {
+            d -> count = count;
+            return(1);
+        }
+    }
+    d -> count = count;
+    return(0);
+}
+
+/* Fill buf with len characters starting at i.  			*/
+/* Assumes len characters are available.				*/ 
+void CORD_fill_buf(CORD x, size_t i, size_t len, char * buf)
+{
+    CORD_fill_data fd;
+    
+    fd.len = len;
+    fd.buf = buf;
+    fd.count = 0;
+    (void)CORD_iter5(x, i, CORD_fill_proc, CORD_batched_fill_proc, &fd);
+}
+
+int CORD_cmp(CORD x, CORD y)
+{
+    CORD_pos xpos;
+    CORD_pos ypos;
+    register size_t avail, yavail;
+    
+    if (y == CORD_EMPTY) return(x != CORD_EMPTY);
+    if (x == CORD_EMPTY) return(-1);
+    if (CORD_IS_STRING(y) && CORD_IS_STRING(x)) return(strcmp(x,y));
+    CORD_set_pos(xpos, x, 0);
+    CORD_set_pos(ypos, y, 0);
+    for(;;) {
+        if (!CORD_pos_valid(xpos)) {
+            if (CORD_pos_valid(ypos)) {
+            	return(-1);
+            } else {
+                return(0);
+            }
+        }
+        if (!CORD_pos_valid(ypos)) {
+            return(1);
+        }
+        if ((avail = CORD_pos_chars_left(xpos)) <= 0
+            || (yavail = CORD_pos_chars_left(ypos)) <= 0) {
+            register char xcurrent = CORD_pos_fetch(xpos);
+            register char ycurrent = CORD_pos_fetch(ypos);
+            if (xcurrent != ycurrent) return(xcurrent - ycurrent);
+            CORD_next(xpos);
+            CORD_next(ypos);
+        } else {
+            /* process as many characters as we can	*/
+            register int result;
+            
+            if (avail > yavail) avail = yavail;
+            result = strncmp(CORD_pos_cur_char_addr(xpos),
+            		     CORD_pos_cur_char_addr(ypos), avail);
+            if (result != 0) return(result);
+            CORD_pos_advance(xpos, avail);
+            CORD_pos_advance(ypos, avail);
+        }
+    }
+}
+
+int CORD_ncmp(CORD x, size_t x_start, CORD y, size_t y_start, size_t len)
+{
+    CORD_pos xpos;
+    CORD_pos ypos;
+    register size_t count;
+    register long avail, yavail;
+    
+    CORD_set_pos(xpos, x, x_start);
+    CORD_set_pos(ypos, y, y_start);
+    for(count = 0; count < len;) {
+        if (!CORD_pos_valid(xpos)) {
+            if (CORD_pos_valid(ypos)) {
+            	return(-1);
+            } else {
+                return(0);
+            }
+        }
+        if (!CORD_pos_valid(ypos)) {
+            return(1);
+        }
+        if ((avail = CORD_pos_chars_left(xpos)) <= 0
+            || (yavail = CORD_pos_chars_left(ypos)) <= 0) {
+            register char xcurrent = CORD_pos_fetch(xpos);
+            register char ycurrent = CORD_pos_fetch(ypos);
+            if (xcurrent != ycurrent) return(xcurrent - ycurrent);
+            CORD_next(xpos);
+            CORD_next(ypos);
+            count++;
+        } else {
+            /* process as many characters as we can	*/
+            register int result;
+            
+            if (avail > yavail) avail = yavail;
+            count += avail;
+            if (count > len) avail -= (count - len);
+            result = strncmp(CORD_pos_cur_char_addr(xpos),
+            		     CORD_pos_cur_char_addr(ypos), (size_t)avail);
+            if (result != 0) return(result);
+            CORD_pos_advance(xpos, (size_t)avail);
+            CORD_pos_advance(ypos, (size_t)avail);
+        }
+    }
+    return(0);
+}
+
+char * CORD_to_char_star(CORD x)
+{
+    register size_t len = CORD_len(x);
+    char * result = GC_MALLOC_ATOMIC(len + 1);
+    
+    if (result == 0) OUT_OF_MEMORY;
+    CORD_fill_buf(x, 0, len, result);
+    result[len] = '\0';
+    return(result);
+}
+
+CORD CORD_from_char_star(const char *s)
+{
+    char * result;
+    size_t len = strlen(s);
+
+    if (0 == len) return(CORD_EMPTY);
+    result = GC_MALLOC_ATOMIC(len + 1);
+    if (result == 0) OUT_OF_MEMORY;
+    memcpy(result, s, len+1);
+    return(result);
+}
+
+const char * CORD_to_const_char_star(CORD x)
+{
+    if (x == 0) return("");
+    if (CORD_IS_STRING(x)) return((const char *)x);
+    return(CORD_to_char_star(x));
+}
+
+char CORD_fetch(CORD x, size_t i)
+{
+    CORD_pos xpos;
+    
+    CORD_set_pos(xpos, x, i);
+    if (!CORD_pos_valid(xpos)) ABORT("bad index?");
+    return(CORD_pos_fetch(xpos));
+}
+
+
+int CORD_put_proc(char c, void * client_data)
+{
+    register FILE * f = (FILE *)client_data;
+    
+    return(putc(c, f) == EOF);
+}
+
+int CORD_batched_put_proc(const char * s, void * client_data)
+{
+    register FILE * f = (FILE *)client_data;
+    
+    return(fputs(s, f) == EOF);
+}
+    
+
+int CORD_put(CORD x, FILE * f)
+{
+    if (CORD_iter5(x, 0, CORD_put_proc, CORD_batched_put_proc, f)) {
+        return(EOF);
+    } else {
+    	return(1);
+    }
+}
+
+typedef struct {
+    size_t pos;		/* Current position in the cord */
+    char target;	/* Character we're looking for	*/
+} chr_data;
+
+int CORD_chr_proc(char c, void * client_data)
+{
+    register chr_data * d = (chr_data *)client_data;
+    
+    if (c == d -> target) return(1);
+    (d -> pos) ++;
+    return(0);
+}
+
+int CORD_rchr_proc(char c, void * client_data)
+{
+    register chr_data * d = (chr_data *)client_data;
+    
+    if (c == d -> target) return(1);
+    (d -> pos) --;
+    return(0);
+}
+
+int CORD_batched_chr_proc(const char *s, void * client_data)
+{
+    register chr_data * d = (chr_data *)client_data;
+    register char * occ = strchr(s, d -> target);
+    
+    if (occ == 0) {
+      	d -> pos += strlen(s);
+      	return(0);
+    } else {
+    	d -> pos += occ - s;
+    	return(1);
+    }
+}
+
+size_t CORD_chr(CORD x, size_t i, int c)
+{
+    chr_data d;
+    
+    d.pos = i;
+    d.target = c;
+    if (CORD_iter5(x, i, CORD_chr_proc, CORD_batched_chr_proc, &d)) {
+        return(d.pos);
+    } else {
+    	return(CORD_NOT_FOUND);
+    }
+}
+
+size_t CORD_rchr(CORD x, size_t i, int c)
+{
+    chr_data d;
+    
+    d.pos = i;
+    d.target = c;
+    if (CORD_riter4(x, i, CORD_rchr_proc, &d)) {
+        return(d.pos);
+    } else {
+    	return(CORD_NOT_FOUND);
+    }
+}
+
+/* Find the first occurrence of s in x at position start or later.	*/
+/* This uses an asymptotically poor algorithm, which should typically 	*/
+/* perform acceptably.  We compare the first few characters directly,	*/
+/* and call CORD_ncmp whenever there is a partial match.		*/
+/* This has the advantage that we allocate very little, or not at all.	*/
+/* It's very fast if there are few close misses.			*/
+size_t CORD_str(CORD x, size_t start, CORD s)
+{
+    CORD_pos xpos;
+    size_t xlen = CORD_len(x);
+    size_t slen;
+    register size_t start_len;
+    const char * s_start;
+    unsigned long s_buf = 0;	/* The first few characters of s	*/
+    unsigned long x_buf = 0;	/* Start of candidate substring.	*/
+    				/* Initialized only to make compilers	*/
+    				/* happy.				*/
+    unsigned long mask = 0;
+    register size_t i;
+    register size_t match_pos;
+    
+    if (s == CORD_EMPTY) return(start);
+    if (CORD_IS_STRING(s)) {
+        s_start = s;
+        slen = strlen(s);
+    } else {
+        s_start = CORD_to_char_star(CORD_substr(s, 0, sizeof(unsigned long)));
+        slen = CORD_len(s);
+    }
+    if (xlen < start || xlen - start < slen) return(CORD_NOT_FOUND);
+    start_len = slen;
+    if (start_len > sizeof(unsigned long)) start_len = sizeof(unsigned long);
+    CORD_set_pos(xpos, x, start);
+    for (i = 0; i < start_len; i++) {
+        mask <<= 8;
+        mask |= 0xff;
+        s_buf <<= 8;
+        s_buf |= s_start[i];
+        x_buf <<= 8;
+        x_buf |= CORD_pos_fetch(xpos);
+        CORD_next(xpos);
+    }
+    for (match_pos = start; ; match_pos++) {
+    	if ((x_buf & mask) == s_buf) {
+    	    if (slen == start_len ||
+    	     	CORD_ncmp(x, match_pos + start_len,
+    	     	 	  s, start_len, slen - start_len) == 0) {
+    	        return(match_pos);
+    	    }
+    	}
+	if ( match_pos == xlen - slen ) {
+	    return(CORD_NOT_FOUND);
+	}
+    	x_buf <<= 8;
+        x_buf |= CORD_pos_fetch(xpos);
+        CORD_next(xpos);
+    }
+}
+
+void CORD_ec_flush_buf(CORD_ec x)
+{
+    register size_t len = x[0].ec_bufptr - x[0].ec_buf;
+    char * s;
+
+    if (len == 0) return;
+    s = GC_MALLOC_ATOMIC(len+1);
+    memcpy(s, x[0].ec_buf, len);
+    s[len] = '\0';
+    x[0].ec_cord = CORD_cat_char_star(x[0].ec_cord, s, len);
+    x[0].ec_bufptr = x[0].ec_buf;
+}
+
+void CORD_ec_append_cord(CORD_ec x, CORD s)
+{
+    CORD_ec_flush_buf(x);
+    x[0].ec_cord = CORD_cat(x[0].ec_cord, s);
+}
+
+/*ARGSUSED*/
+char CORD_nul_func(size_t i, void * client_data)
+{
+    return((char)(unsigned long)client_data);
+}
+
+
+CORD CORD_chars(char c, size_t i)
+{
+    return(CORD_from_fn(CORD_nul_func, (void *)(unsigned long)c, i));
+}
+
+CORD CORD_from_file_eager(FILE * f)
+{
+    register int c;
+    CORD_ec ecord;
+    
+    CORD_ec_init(ecord);
+    for(;;) {
+        c = getc(f);
+        if (c == 0) {
+          /* Append the right number of NULs	*/
+          /* Note that any string of NULs is rpresented in 4 words,	*/
+          /* independent of its length.					*/
+            register size_t count = 1;
+            
+            CORD_ec_flush_buf(ecord);
+            while ((c = getc(f)) == 0) count++;
+            ecord[0].ec_cord = CORD_cat(ecord[0].ec_cord, CORD_nul(count));
+        }
+        if (c == EOF) break;
+        CORD_ec_append(ecord, c);
+    }
+    (void) fclose(f);
+    return(CORD_balance(CORD_ec_to_cord(ecord)));
+}
+
+/* The state maintained for a lazily read file consists primarily	*/
+/* of a large direct-mapped cache of previously read values.		*/
+/* We could rely more on stdio buffering.  That would have 2		*/
+/* disadvantages:							*/
+/*  	1) Empirically, not all fseek implementations preserve the	*/
+/*	   buffer whenever they could.					*/
+/*	2) It would fail if 2 different sections of a long cord		*/
+/*	   were being read alternately.					*/
+/* We do use the stdio buffer for read ahead.				*/
+/* To guarantee thread safety in the presence of atomic pointer		*/
+/* writes, cache lines are always replaced, and never modified in	*/
+/* place.								*/
+
+# define LOG_CACHE_SZ 14
+# define CACHE_SZ (1 << LOG_CACHE_SZ)
+# define LOG_LINE_SZ 9
+# define LINE_SZ (1 << LOG_LINE_SZ)
+
+typedef struct {
+    size_t tag;
+    char data[LINE_SZ];
+    	/* data[i%LINE_SZ] = ith char in file if tag = i/LINE_SZ	*/
+} cache_line;
+
+typedef struct {
+    FILE * lf_file;
+    size_t lf_current;	/* Current file pointer value */
+    cache_line * volatile lf_cache[CACHE_SZ/LINE_SZ];
+} lf_state;
+
+# define MOD_CACHE_SZ(n) ((n) & (CACHE_SZ - 1))
+# define DIV_CACHE_SZ(n) ((n) >> LOG_CACHE_SZ)
+# define MOD_LINE_SZ(n) ((n) & (LINE_SZ - 1))
+# define DIV_LINE_SZ(n) ((n) >> LOG_LINE_SZ)
+# define LINE_START(n) ((n) & ~(LINE_SZ - 1))
+
+typedef struct {
+    lf_state * state;
+    size_t file_pos;	/* Position of needed character. */
+    cache_line * new_cache;
+} refill_data;
+
+/* Executed with allocation lock. */
+static char refill_cache(client_data)
+refill_data * client_data;
+{
+    register lf_state * state = client_data -> state;
+    register size_t file_pos = client_data -> file_pos;
+    FILE *f = state -> lf_file;
+    size_t line_start = LINE_START(file_pos);
+    size_t line_no = DIV_LINE_SZ(MOD_CACHE_SZ(file_pos));
+    cache_line * new_cache = client_data -> new_cache;
+    
+    if (line_start != state -> lf_current
+        && fseek(f, line_start, SEEK_SET) != 0) {
+    	    ABORT("fseek failed");
+    }
+    if (fread(new_cache -> data, sizeof(char), LINE_SZ, f)
+    	<= file_pos - line_start) {
+    	ABORT("fread failed");
+    }
+    new_cache -> tag = DIV_LINE_SZ(file_pos);
+    /* Store barrier goes here. */
+    ATOMIC_WRITE(state -> lf_cache[line_no], new_cache);
+    state -> lf_current = line_start + LINE_SZ;
+    return(new_cache->data[MOD_LINE_SZ(file_pos)]);
+}
+
+char CORD_lf_func(size_t i, void * client_data)
+{
+    register lf_state * state = (lf_state *)client_data;
+    register cache_line * volatile * cl_addr =
+		&(state -> lf_cache[DIV_LINE_SZ(MOD_CACHE_SZ(i))]);
+    register cache_line * cl = (cache_line *)ATOMIC_READ(cl_addr);
+    
+    if (cl == 0 || cl -> tag != DIV_LINE_SZ(i)) {
+    	/* Cache miss */
+    	refill_data rd;
+    	
+        rd.state = state;
+        rd.file_pos =  i;
+        rd.new_cache = GC_NEW_ATOMIC(cache_line);
+        if (rd.new_cache == 0) OUT_OF_MEMORY;
+        return((char)(GC_word)
+        	  GC_call_with_alloc_lock((GC_fn_type) refill_cache, &rd));
+    }
+    return(cl -> data[MOD_LINE_SZ(i)]);
+}    
+
+/*ARGSUSED*/
+void CORD_lf_close_proc(void * obj, void * client_data)  
+{
+    if (fclose(((lf_state *)obj) -> lf_file) != 0) {
+    	ABORT("CORD_lf_close_proc: fclose failed");
+    }
+}			
+
+CORD CORD_from_file_lazy_inner(FILE * f, size_t len)
+{
+    register lf_state * state = GC_NEW(lf_state);
+    register int i;
+    
+    if (state == 0) OUT_OF_MEMORY;
+    if (len != 0) {
+	/* Dummy read to force buffer allocation.  	*/
+	/* This greatly increases the probability	*/
+	/* of avoiding deadlock if buffer allocation	*/
+	/* is redirected to GC_malloc and the		*/
+	/* world is multithreaded.			*/
+	char buf[1];
+
+	(void) fread(buf, 1, 1, f); 
+	rewind(f);
+    }
+    state -> lf_file = f;
+    for (i = 0; i < CACHE_SZ/LINE_SZ; i++) {
+        state -> lf_cache[i] = 0;
+    }
+    state -> lf_current = 0;
+    GC_REGISTER_FINALIZER(state, CORD_lf_close_proc, 0, 0, 0);
+    return(CORD_from_fn(CORD_lf_func, state, len));
+}
+
+CORD CORD_from_file_lazy(FILE * f)
+{
+    register long len;
+    
+    if (fseek(f, 0l, SEEK_END) != 0) {
+        ABORT("Bad fd argument - fseek failed");
+    }
+    if ((len = ftell(f)) < 0) {
+        ABORT("Bad fd argument - ftell failed");
+    }
+    rewind(f);
+    return(CORD_from_file_lazy_inner(f, (size_t)len));
+}
+
+# define LAZY_THRESHOLD (128*1024 + 1)
+
+CORD CORD_from_file(FILE * f)
+{
+    register long len;
+    
+    if (fseek(f, 0l, SEEK_END) != 0) {
+        ABORT("Bad fd argument - fseek failed");
+    }
+    if ((len = ftell(f)) < 0) {
+        ABORT("Bad fd argument - ftell failed");
+    }
+    rewind(f);
+    if (len < LAZY_THRESHOLD) {
+        return(CORD_from_file_eager(f));
+    } else {
+        return(CORD_from_file_lazy_inner(f, (size_t)len));
+    }
+}
diff --git a/src/gc/cord/de.c b/src/gc/cord/de.c
new file mode 100644
index 000000000..fda714241
--- /dev/null
+++ b/src/gc/cord/de.c
@@ -0,0 +1,603 @@
+/*
+ * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * Author: Hans-J. Boehm (boehm@parc.xerox.com)
+ */
+/*
+ * A really simple-minded text editor based on cords.
+ * Things it does right:
+ * 	No size bounds.
+ *	Inbounded undo.
+ *	Shouldn't crash no matter what file you invoke it on (e.g. /vmunix)
+ *		(Make sure /vmunix is not writable before you try this.)
+ *	Scrolls horizontally.
+ * Things it does wrong:
+ *	It doesn't handle tabs reasonably (use "expand" first).
+ *	The command set is MUCH too small.
+ *	The redisplay algorithm doesn't let curses do the scrolling.
+ *	The rule for moving the window over the file is suboptimal.
+ */
+/* Boehm, February 6, 1995 12:27 pm PST */
+
+/* Boehm, May 19, 1994 2:20 pm PDT */
+#include <stdio.h>
+#include "gc.h"
+#include "cord.h"
+
+#ifdef THINK_C
+#define MACINTOSH
+#include <ctype.h>
+#endif
+
+#if defined(__BORLANDC__) && !defined(WIN32)
+    /* If this is DOS or win16, we'll fail anyway.	*/
+    /* Might as well assume win32.			*/
+#   define WIN32
+#endif
+
+#if defined(WIN32)
+#  include <windows.h>
+#  include "de_win.h"
+#elif defined(MACINTOSH)
+#	include <console.h>
+/* curses emulation. */
+#	define initscr()
+#	define endwin()
+#	define nonl()
+#	define noecho() csetmode(C_NOECHO, stdout)
+#	define cbreak() csetmode(C_CBREAK, stdout)
+#	define refresh()
+#	define addch(c) putchar(c)
+#	define standout() cinverse(1, stdout)
+#	define standend() cinverse(0, stdout)
+#	define move(line,col) cgotoxy(col + 1, line + 1, stdout)
+#	define clrtoeol() ccleol(stdout)
+#	define de_error(s) { fprintf(stderr, s); getchar(); }
+#	define LINES 25
+#	define COLS 80
+#else
+#  include <curses.h>
+#  define de_error(s) { fprintf(stderr, s); sleep(2); }
+#endif
+#include "de_cmds.h"
+
+/* List of line number to position mappings, in descending order. */
+/* There may be holes.						  */
+typedef struct LineMapRep {
+    int line;
+    size_t pos;
+    struct LineMapRep * previous;
+} * line_map;
+
+/* List of file versions, one per edit operation */
+typedef struct HistoryRep {
+    CORD file_contents;
+    struct HistoryRep * previous;
+    line_map map;	/* Invalid for first record "now" */
+} * history;
+
+history now = 0;
+CORD current;		/* == now -> file_contents.	*/
+size_t current_len;	/* Current file length.		*/
+line_map current_map = 0;	/* Current line no. to pos. map	 */
+size_t current_map_size = 0;	/* Number of current_map entries.	*/
+				/* Not always accurate, but reset	*/
+				/* by prune_map.			*/
+# define MAX_MAP_SIZE 3000
+
+/* Current display position */
+int dis_line = 0;
+int dis_col = 0;
+
+# define ALL -1
+# define NONE - 2
+int need_redisplay = 0;	/* Line that needs to be redisplayed.	*/
+
+
+/* Current cursor position. Always within file. */
+int line = 0; 
+int col = 0;
+size_t file_pos = 0;	/* Character position corresponding to cursor.	*/
+
+/* Invalidate line map for lines > i */
+void invalidate_map(int i)
+{
+    while(current_map -> line > i) {
+        current_map = current_map -> previous;
+        current_map_size--;
+    }
+}
+
+/* Reduce the number of map entries to save space for huge files. */
+/* This also affects maps in histories.				  */
+void prune_map()
+{
+    line_map map = current_map;
+    int start_line = map -> line;
+    
+    current_map_size = 0;
+    for(; map != 0; map = map -> previous) {
+    	current_map_size++;
+    	if (map -> line < start_line - LINES && map -> previous != 0) {
+    	    map -> previous = map -> previous -> previous;
+    	}
+    }
+}
+/* Add mapping entry */
+void add_map(int line, size_t pos)
+{
+    line_map new_map = GC_NEW(struct LineMapRep);
+    
+    if (current_map_size >= MAX_MAP_SIZE) prune_map();
+    new_map -> line = line;
+    new_map -> pos = pos;
+    new_map -> previous = current_map;
+    current_map = new_map;
+    current_map_size++;
+}
+
+
+
+/* Return position of column *c of ith line in   */
+/* current file. Adjust *c to be within the line.*/
+/* A 0 pointer is taken as 0 column.		 */
+/* Returns CORD_NOT_FOUND if i is too big.	 */
+/* Assumes i > dis_line.			 */
+size_t line_pos(int i, int *c)
+{
+    int j;
+    size_t cur;
+    size_t next;
+    line_map map = current_map;
+    
+    while (map -> line > i) map = map -> previous;
+    if (map -> line < i - 2) /* rebuild */ invalidate_map(i);
+    for (j = map -> line, cur = map -> pos; j < i;) {
+	cur = CORD_chr(current, cur, '\n');
+        if (cur == current_len-1) return(CORD_NOT_FOUND);
+        cur++;
+        if (++j > current_map -> line) add_map(j, cur);
+    }
+    if (c != 0) {
+        next = CORD_chr(current, cur, '\n');
+        if (next == CORD_NOT_FOUND) next = current_len - 1;
+        if (next < cur + *c) {
+            *c = next - cur;
+        }
+        cur += *c;
+    }
+    return(cur);
+}
+
+void add_hist(CORD s)
+{
+    history new_file = GC_NEW(struct HistoryRep);
+    
+    new_file -> file_contents = current = s;
+    current_len = CORD_len(s);
+    new_file -> previous = now;
+    if (now != 0) now -> map = current_map;
+    now = new_file;
+}
+
+void del_hist(void)
+{
+    now = now -> previous;
+    current = now -> file_contents;
+    current_map = now -> map;
+    current_len = CORD_len(current);
+}
+
+/* Current screen_contents; a dynamically allocated array of CORDs	*/
+CORD * screen = 0;
+int screen_size = 0;
+
+# ifndef WIN32
+/* Replace a line in the curses stdscr.	All control characters are	*/
+/* displayed as upper case characters in standout mode.  This isn't	*/
+/* terribly appropriate for tabs.									*/
+void replace_line(int i, CORD s)
+{
+    register int c;
+    CORD_pos p;
+    size_t len = CORD_len(s);
+    
+    if (screen == 0 || LINES > screen_size) {
+        screen_size = LINES;
+    	screen = (CORD *)GC_MALLOC(screen_size * sizeof(CORD));
+    }
+#   if !defined(MACINTOSH)
+        /* A gross workaround for an apparent curses bug: */
+        if (i == LINES-1 && len == COLS) {
+            s = CORD_substr(s, 0, CORD_len(s) - 1);
+        }
+#   endif
+    if (CORD_cmp(screen[i], s) != 0) {
+        move(i, 0); clrtoeol(); move(i,0);
+
+        CORD_FOR (p, s) {
+            c = CORD_pos_fetch(p) & 0x7f;
+            if (iscntrl(c)) {
+            	standout(); addch(c + 0x40); standend();
+            } else {
+    	        addch(c);
+    	    }
+    	}
+    	screen[i] = s;
+    }
+}
+#else
+# define replace_line(i,s) invalidate_line(i)
+#endif
+
+/* Return up to COLS characters of the line of s starting at pos,	*/
+/* returning only characters after the given column.			*/
+CORD retrieve_line(CORD s, size_t pos, unsigned column)
+{
+    CORD candidate = CORD_substr(s, pos, column + COLS);
+    			/* avoids scanning very long lines	*/
+    int eol = CORD_chr(candidate, 0, '\n');
+    int len;
+    
+    if (eol == CORD_NOT_FOUND) eol = CORD_len(candidate);
+    len = (int)eol - (int)column;
+    if (len < 0) len = 0;
+    return(CORD_substr(s, pos + column, len));
+}
+
+# ifdef WIN32
+#   define refresh();
+
+    CORD retrieve_screen_line(int i)
+    {
+    	register size_t pos;
+    	
+    	invalidate_map(dis_line + LINES);	/* Prune search */
+    	pos = line_pos(dis_line + i, 0);
+    	if (pos == CORD_NOT_FOUND) return(CORD_EMPTY);
+    	return(retrieve_line(current, pos, dis_col));
+    }
+# endif
+
+/* Display the visible section of the current file	 */
+void redisplay(void)
+{
+    register int i;
+    
+    invalidate_map(dis_line + LINES);	/* Prune search */
+    for (i = 0; i < LINES; i++) {
+        if (need_redisplay == ALL || need_redisplay == i) {
+            register size_t pos = line_pos(dis_line + i, 0);
+            
+            if (pos == CORD_NOT_FOUND) break;
+            replace_line(i, retrieve_line(current, pos, dis_col));
+            if (need_redisplay == i) goto done;
+        }
+    }
+    for (; i < LINES; i++) replace_line(i, CORD_EMPTY);
+done:
+    refresh();
+    need_redisplay = NONE;
+}
+
+int dis_granularity;
+
+/* Update dis_line, dis_col, and dis_pos to make cursor visible.	*/
+/* Assumes line, col, dis_line, dis_pos are in bounds.			*/
+void normalize_display()
+{
+    int old_line = dis_line;
+    int old_col = dis_col;
+    
+    dis_granularity = 1;
+    if (LINES > 15 && COLS > 15) dis_granularity = 2;
+    while (dis_line > line) dis_line -= dis_granularity;
+    while (dis_col > col) dis_col -= dis_granularity;
+    while (line >= dis_line + LINES) dis_line += dis_granularity;
+    while (col >= dis_col + COLS) dis_col += dis_granularity;
+    if (old_line != dis_line || old_col != dis_col) {
+        need_redisplay = ALL;
+    }
+}
+
+# if defined(WIN32)
+# elif defined(MACINTOSH)
+#		define move_cursor(x,y) cgotoxy(x + 1, y + 1, stdout)
+# else
+#		define move_cursor(x,y) move(y,x)
+# endif
+
+/* Adjust display so that cursor is visible; move cursor into position	*/
+/* Update screen if necessary.						*/
+void fix_cursor(void)
+{
+    normalize_display();
+    if (need_redisplay != NONE) redisplay();
+    move_cursor(col - dis_col, line - dis_line);
+    refresh();
+#   ifndef WIN32
+      fflush(stdout);
+#   endif
+}
+
+/* Make sure line, col, and dis_pos are somewhere inside file.	*/
+/* Recompute file_pos.	Assumes dis_pos is accurate or past eof	*/
+void fix_pos()
+{
+    int my_col = col;
+    
+    if ((size_t)line > current_len) line = current_len;
+    file_pos = line_pos(line, &my_col);
+    if (file_pos == CORD_NOT_FOUND) {
+        for (line = current_map -> line, file_pos = current_map -> pos;
+             file_pos < current_len;
+             line++, file_pos = CORD_chr(current, file_pos, '\n') + 1);
+    	line--;
+        file_pos = line_pos(line, &col);
+    } else {
+    	col = my_col;
+    }
+}
+
+#if defined(WIN32)
+#  define beep() Beep(1000 /* Hz */, 300 /* msecs */) 
+#elif defined(MACINTOSH)
+#	define beep() SysBeep(1)
+#else
+/*
+ * beep() is part of some curses packages and not others.
+ * We try to match the type of the builtin one, if any.
+ */
+#ifdef __STDC__
+    int beep(void)
+#else
+    int beep()
+#endif
+{
+    putc('\007', stderr);
+    return(0);
+}
+#endif
+
+#   define NO_PREFIX -1
+#   define BARE_PREFIX -2
+int repeat_count = NO_PREFIX;	/* Current command prefix. */
+
+int locate_mode = 0;			/* Currently between 2 ^Ls	*/
+CORD locate_string = CORD_EMPTY;	/* Current search string.	*/
+
+char * arg_file_name;
+
+#ifdef WIN32
+/* Change the current position to whatever is currently displayed at	*/
+/* the given SCREEN coordinates.					*/
+void set_position(int c, int l)
+{
+    line = l + dis_line;
+    col = c + dis_col;
+    fix_pos();
+    move_cursor(col - dis_col, line - dis_line);
+}
+#endif /* WIN32 */
+
+/* Perform the command associated with character c.  C may be an	*/
+/* integer > 256 denoting a windows command, one of the above control	*/
+/* characters, or another ASCII character to be used as either a 	*/
+/* character to be inserted, a repeat count, or a search string, 	*/
+/* depending on the current state.					*/
+void do_command(int c)
+{
+    int i;
+    int need_fix_pos;
+    FILE * out;
+    
+    if ( c == '\r') c = '\n';
+    if (locate_mode) {
+        size_t new_pos;
+          
+        if (c == LOCATE) {
+              locate_mode = 0;
+              locate_string = CORD_EMPTY;
+              return;
+        }
+        locate_string = CORD_cat_char(locate_string, (char)c);
+        new_pos = CORD_str(current, file_pos - CORD_len(locate_string) + 1,
+          		   locate_string);
+        if (new_pos != CORD_NOT_FOUND) {
+            need_redisplay = ALL;
+            new_pos += CORD_len(locate_string);
+            for (;;) {
+              	file_pos = line_pos(line + 1, 0);
+              	if (file_pos > new_pos) break;
+              	line++;
+            }
+            col = new_pos - line_pos(line, 0);
+            file_pos = new_pos;
+            fix_cursor();
+        } else {
+            locate_string = CORD_substr(locate_string, 0,
+              				CORD_len(locate_string) - 1);
+            beep();
+        }
+        return;
+    }
+    if (c == REPEAT) {
+      	repeat_count = BARE_PREFIX; return;
+    } else if (c < 0x100 && isdigit(c)){
+        if (repeat_count == BARE_PREFIX) {
+          repeat_count = c - '0'; return;
+        } else if (repeat_count != NO_PREFIX) {
+          repeat_count = 10 * repeat_count + c - '0'; return;
+        }
+    }
+    if (repeat_count == NO_PREFIX) repeat_count = 1;
+    if (repeat_count == BARE_PREFIX && (c == UP || c == DOWN)) {
+      	repeat_count = LINES - dis_granularity;
+    }
+    if (repeat_count == BARE_PREFIX) repeat_count = 8;
+    need_fix_pos = 0;
+    for (i = 0; i < repeat_count; i++) {
+        switch(c) {
+          case LOCATE:
+            locate_mode = 1;
+            break;
+          case TOP:
+            line = col = file_pos = 0;
+            break;
+     	  case UP:
+     	    if (line != 0) {
+     	        line--;
+     	        need_fix_pos = 1;
+     	    }
+     	    break;
+     	  case DOWN:
+     	    line++;
+     	    need_fix_pos = 1;
+     	    break;
+     	  case LEFT:
+     	    if (col != 0) {
+     	        col--; file_pos--;
+     	    }
+     	    break;
+     	  case RIGHT:
+     	    if (CORD_fetch(current, file_pos) == '\n') break;
+     	    col++; file_pos++;
+     	    break;
+     	  case UNDO:
+     	    del_hist();
+     	    need_redisplay = ALL; need_fix_pos = 1;
+     	    break;
+     	  case BS:
+     	    if (col == 0) {
+     	        beep();
+     	        break;
+     	    }
+     	    col--; file_pos--;
+     	    /* fall through: */
+     	  case DEL:
+     	    if (file_pos == current_len-1) break;
+     	    	/* Can't delete trailing newline */
+     	    if (CORD_fetch(current, file_pos) == '\n') {
+     	        need_redisplay = ALL; need_fix_pos = 1;
+     	    } else {
+     	        need_redisplay = line - dis_line;
+     	    }
+     	    add_hist(CORD_cat(
+     	    		CORD_substr(current, 0, file_pos),
+     	    		CORD_substr(current, file_pos+1, current_len)));
+     	    invalidate_map(line);
+     	    break;
+     	  case WRITE:
+	    {
+  		CORD name = CORD_cat(CORD_from_char_star(arg_file_name),
+				     ".new");
+
+    	        if ((out = fopen(CORD_to_const_char_star(name), "wb")) == NULL
+  	            || CORD_put(current, out) == EOF) {
+        	    de_error("Write failed\n");
+        	    need_redisplay = ALL;
+                } else {
+                    fclose(out);
+                }
+	    }
+            break;
+     	  default:
+     	    {
+     	        CORD left_part = CORD_substr(current, 0, file_pos);
+     	        CORD right_part = CORD_substr(current, file_pos, current_len);
+     	        
+     	        add_hist(CORD_cat(CORD_cat_char(left_part, (char)c),
+     	        		  right_part));
+     	        invalidate_map(line);
+     	        if (c == '\n') {
+     	            col = 0; line++; file_pos++;
+     	            need_redisplay = ALL;
+     	        } else {
+     	            col++; file_pos++;
+     	            need_redisplay = line - dis_line;
+     	    	}
+     	        break;
+     	    }
+        }
+    }
+    if (need_fix_pos) fix_pos();
+    fix_cursor();
+    repeat_count = NO_PREFIX;
+}
+
+/* OS independent initialization */
+
+void generic_init(void)
+{
+    FILE * f;
+    CORD initial;
+    
+    if ((f = fopen(arg_file_name, "rb")) == NULL) {
+     	initial = "\n";
+    } else {
+        initial = CORD_from_file(f);
+        if (initial == CORD_EMPTY
+            || CORD_fetch(initial, CORD_len(initial)-1) != '\n') {
+            initial = CORD_cat(initial, "\n");
+        }
+    }
+    add_map(0,0);
+    add_hist(initial);
+    now -> map = current_map;
+    now -> previous = now;  /* Can't back up further: beginning of the world */
+    need_redisplay = ALL;
+    fix_cursor();
+}
+
+#ifndef WIN32
+
+main(argc, argv)
+int argc;
+char ** argv;
+{
+    int c;
+
+#if defined(MACINTOSH)
+	console_options.title = "\pDumb Editor";
+	cshow(stdout);
+	GC_init();
+	argc = ccommand(&argv);
+#endif
+    
+    if (argc != 2) goto usage;
+    arg_file_name = argv[1];
+    setvbuf(stdout, GC_MALLOC_ATOMIC(8192), _IOFBF, 8192);
+    initscr();
+    noecho(); nonl(); cbreak();
+    generic_init();
+    while ((c = getchar()) != QUIT) {
+		if (c == EOF) break;
+	    do_command(c);
+    }
+done:
+    move(LINES-1, 0);
+    clrtoeol();
+    refresh();
+    nl();
+    echo();
+    endwin();
+    exit(0);
+usage:
+    fprintf(stderr, "Usage: %s file\n", argv[0]);
+    fprintf(stderr, "Cursor keys: ^B(left) ^F(right) ^P(up) ^N(down)\n");
+    fprintf(stderr, "Undo: ^U    Write to <file>.new: ^W");
+    fprintf(stderr, "Quit:^D  Repeat count: ^R[n]\n");
+    fprintf(stderr, "Top: ^T   Locate (search, find): ^L text ^L\n");
+    exit(1);
+}
+
+#endif  /* !WIN32 */
diff --git a/src/gc/cord/de_cmds.h b/src/gc/cord/de_cmds.h
new file mode 100644
index 000000000..f42ddcf2d
--- /dev/null
+++ b/src/gc/cord/de_cmds.h
@@ -0,0 +1,33 @@
+/*
+ * Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, May 19, 1994 2:24 pm PDT */
+
+#ifndef DE_CMDS_H
+
+# define DE_CMDS_H
+
+# define UP     16	/* ^P */
+# define DOWN   14	/* ^N */
+# define LEFT   2	/* ^B */
+# define RIGHT  6	/* ^F */
+# define DEL	127	/* ^? */
+# define BS     8	/* ^H */
+# define UNDO   21	/* ^U */
+# define WRITE  23	/* ^W */
+# define QUIT   4	/* ^D */
+# define REPEAT 18	/* ^R */
+# define LOCATE 12	/* ^L */
+# define TOP    20	/* ^T */
+
+#endif
+
diff --git a/src/gc/cord/de_win.ICO b/src/gc/cord/de_win.ICO
new file mode 100755
index 000000000..b20ac3ee1
Binary files /dev/null and b/src/gc/cord/de_win.ICO differ
diff --git a/src/gc/cord/de_win.RC b/src/gc/cord/de_win.RC
new file mode 100644
index 000000000..554a30043
--- /dev/null
+++ b/src/gc/cord/de_win.RC
@@ -0,0 +1,78 @@
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to copy this garbage collector for any purpose,
+ * provided the above notices are retained on all copies.
+ */
+/* Boehm, May 13, 1994 9:50 am PDT */
+
+#include "windows.h"
+#include "de_cmds.h"
+#include "de_win.h"
+
+
+
+ABOUTBOX DIALOG 19, 21, 163, 47
+STYLE DS_MODALFRAME | WS_POPUP | WS_CAPTION | WS_SYSMENU
+CAPTION "About Demonstration Text Editor"
+BEGIN
+	ICON "DE", -1, 8, 8, 13, 13, WS_CHILD | WS_VISIBLE
+	LTEXT "Demonstration Text Editor", -1, 44, 8, 118, 8, WS_CHILD | WS_VISIBLE | WS_GROUP
+	LTEXT "Version 4.1", -1, 44, 16, 60, 8, WS_CHILD | WS_VISIBLE | WS_GROUP
+	PUSHBUTTON "OK", IDOK, 118, 27, 24, 14, WS_CHILD | WS_VISIBLE | WS_TABSTOP
+END
+
+
+DE MENU 
+BEGIN
+	POPUP "&File"
+	BEGIN
+		MENUITEM "&Save\t^W", IDM_FILESAVE
+		MENUITEM "E&xit\t^D", IDM_FILEEXIT
+	END
+
+	POPUP "&Edit"
+	BEGIN
+	    MENUITEM "Page &Down\t^R^N", IDM_EDITPDOWN
+	    MENUITEM "Page &Up\t^R^P", IDM_EDITPUP
+		MENUITEM "U&ndo\t^U", IDM_EDITUNDO
+		MENUITEM "&Locate\t^L ... ^L", IDM_EDITLOCATE
+		MENUITEM "D&own\t^N", IDM_EDITDOWN
+	    MENUITEM "U&p\t^P", IDM_EDITUP
+	    MENUITEM "Le&ft\t^B", IDM_EDITLEFT
+	    MENUITEM "&Right\t^F", IDM_EDITRIGHT
+	    MENUITEM "Delete &Backward\tBS", IDM_EDITBS
+	    MENUITEM "Delete F&orward\tDEL", IDM_EDITDEL
+	    MENUITEM "&Top\t^T", IDM_EDITTOP
+	END
+	
+	POPUP "&Help"
+	BEGIN
+		MENUITEM "&Contents", IDM_HELPCONTENTS
+		MENUITEM "&About...", IDM_HELPABOUT
+	END
+	
+	MENUITEM "Page_&Down", IDM_EDITPDOWN
+	MENUITEM "Page_&Up", IDM_EDITPUP
+END
+
+
+DE ACCELERATORS 
+BEGIN
+    "^R", IDM_EDITREPEAT
+    "^N", IDM_EDITDOWN
+    "^P", IDM_EDITUP
+    "^L", IDM_EDITLOCATE
+    "^B", IDM_EDITLEFT
+    "^F", IDM_EDITRIGHT
+    "^T", IDM_EDITTOP
+	VK_DELETE, IDM_EDITDEL, VIRTKEY
+	VK_BACK, IDM_EDITBS, VIRTKEY
+END
+
+
+DE ICON cord\de_win.ICO
+
diff --git a/src/gc/cord/de_win.c b/src/gc/cord/de_win.c
new file mode 100644
index 000000000..fedbfbe67
--- /dev/null
+++ b/src/gc/cord/de_win.c
@@ -0,0 +1,366 @@
+/*
+ * Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, February 6, 1995 12:29 pm PST */
+
+/*
+ * The MS Windows specific part of de.  
+ * This started as the generic Windows application template
+ * made available by Rob Haack (rhaack@polaris.unm.edu), but
+ * significant parts didn't survive to the final version.
+ *
+ * This was written by a nonexpert windows programmer.
+ */
+
+
+#include "windows.h"
+#include "gc.h"
+#include "cord.h"
+#include "de_cmds.h"
+#include "de_win.h"
+
+int LINES = 0;
+int COLS = 0;
+
+char       szAppName[]     = "DE";
+char       FullAppName[]   = "Demonstration Editor";
+
+HWND        hwnd;
+
+void de_error(char *s)
+{
+    MessageBox( hwnd, (LPSTR) s,
+                (LPSTR) FullAppName,
+                MB_ICONINFORMATION | MB_OK );
+    InvalidateRect(hwnd, NULL, TRUE);
+}
+
+int APIENTRY WinMain (HINSTANCE hInstance, HINSTANCE hPrevInstance,
+                      LPSTR command_line, int nCmdShow)
+{
+   MSG         msg;
+   WNDCLASS    wndclass;
+   HANDLE      hAccel;
+
+   if (!hPrevInstance)
+   {
+      wndclass.style          = CS_HREDRAW | CS_VREDRAW;
+      wndclass.lpfnWndProc    = WndProc;
+      wndclass.cbClsExtra     = 0;
+      wndclass.cbWndExtra     = DLGWINDOWEXTRA;
+      wndclass.hInstance      = hInstance;
+      wndclass.hIcon          = LoadIcon (hInstance, szAppName);
+      wndclass.hCursor        = LoadCursor (NULL, IDC_ARROW);
+      wndclass.hbrBackground  = GetStockObject(WHITE_BRUSH);
+      wndclass.lpszMenuName   = "DE";
+      wndclass.lpszClassName  = szAppName;
+
+      if (RegisterClass (&wndclass) == 0) {
+          char buf[50];
+   	
+   	  sprintf(buf, "RegisterClass: error code: 0x%X", GetLastError());
+   	  de_error(buf);
+   	  return(0);
+      }
+   }
+   
+   /* Empirically, the command line does not include the command name ...
+   if (command_line != 0) {
+       while (isspace(*command_line)) command_line++;
+       while (*command_line != 0 && !isspace(*command_line)) command_line++;
+       while (isspace(*command_line)) command_line++;
+   } */
+   
+   if (command_line == 0 || *command_line == 0) {
+        de_error("File name argument required");
+        return( 0 );
+   } else {
+        char *p = command_line;
+        
+        while (*p != 0 && !isspace(*p)) p++;
+   	arg_file_name = CORD_to_char_star(
+   			    CORD_substr(command_line, 0, p - command_line));
+   }
+
+   hwnd = CreateWindow (szAppName,
+   			FullAppName,
+   			WS_OVERLAPPEDWINDOW | WS_CAPTION, /* Window style */
+   			CW_USEDEFAULT, 0, /* default pos. */
+   			CW_USEDEFAULT, 0, /* default width, height */
+   			NULL,	/* No parent */
+   			NULL, 	/* Window class menu */
+   			hInstance, NULL);
+   if (hwnd == NULL) {
+   	char buf[50];
+   	
+   	sprintf(buf, "CreateWindow: error code: 0x%X", GetLastError());
+   	de_error(buf);
+   	return(0);
+   }
+
+   ShowWindow (hwnd, nCmdShow);
+
+   hAccel = LoadAccelerators( hInstance, szAppName );
+   
+   while (GetMessage (&msg, NULL, 0, 0))
+   {
+      if( !TranslateAccelerator( hwnd, hAccel, &msg ) )
+      {
+         TranslateMessage (&msg);
+         DispatchMessage (&msg);
+      }
+   }
+   return msg.wParam;
+}
+
+/* Return the argument with all control characters replaced by blanks.	*/
+char * plain_chars(char * text, size_t len)
+{
+    char * result = GC_MALLOC_ATOMIC(len + 1);
+    register size_t i;
+    
+    for (i = 0; i < len; i++) {
+       if (iscntrl(text[i])) {
+           result[i] = ' ';
+       } else {
+           result[i] = text[i];
+       }
+    }
+    result[len] = '\0';
+    return(result);
+}
+
+/* Return the argument with all non-control-characters replaced by 	*/
+/* blank, and all control characters c replaced by c + 32.		*/
+char * control_chars(char * text, size_t len)
+{
+    char * result = GC_MALLOC_ATOMIC(len + 1);
+    register size_t i;
+    
+    for (i = 0; i < len; i++) {
+       if (iscntrl(text[i])) {
+           result[i] = text[i] + 0x40;
+       } else {
+           result[i] = ' ';
+       }
+    }
+    result[len] = '\0';
+    return(result);
+}
+
+int char_width;
+int char_height;
+
+void get_line_rect(int line, int win_width, RECT * rectp)
+{
+    rectp -> top = line * char_height;
+    rectp -> bottom = rectp->top + char_height;
+    rectp -> left = 0;
+    rectp -> right = win_width;
+}
+
+int caret_visible = 0;	/* Caret is currently visible.	*/
+
+int screen_was_painted = 0;/* Screen has been painted at least once.	*/
+
+void update_cursor(void);
+
+LRESULT CALLBACK WndProc (HWND hwnd, UINT message,
+                          WPARAM wParam, LPARAM lParam)
+{
+   static FARPROC lpfnAboutBox;
+   static HANDLE  hInstance;
+   HDC dc;
+   PAINTSTRUCT ps;
+   RECT client_area;
+   RECT this_line;
+   RECT dummy;
+   TEXTMETRIC tm;
+   register int i;
+   int id;
+
+   switch (message)
+   {
+      case WM_CREATE:
+           hInstance = ( (LPCREATESTRUCT) lParam)->hInstance;
+           lpfnAboutBox = MakeProcInstance( (FARPROC) AboutBox, hInstance );
+           dc = GetDC(hwnd);
+           SelectObject(dc, GetStockObject(SYSTEM_FIXED_FONT));
+           GetTextMetrics(dc, &tm);
+           ReleaseDC(hwnd, dc);
+           char_width = tm.tmAveCharWidth;
+           char_height = tm.tmHeight + tm.tmExternalLeading;
+           GetClientRect(hwnd, &client_area);
+      	   COLS = (client_area.right - client_area.left)/char_width;
+      	   LINES = (client_area.bottom - client_area.top)/char_height;
+      	   generic_init();
+           return(0);
+
+      case WM_CHAR:
+      	   if (wParam == QUIT) {
+      	       SendMessage( hwnd, WM_CLOSE, 0, 0L );
+      	   } else {
+      	       do_command(wParam);
+      	   }
+      	   return(0);
+      
+      case WM_SETFOCUS:
+      	   CreateCaret(hwnd, NULL, char_width, char_height);
+      	   ShowCaret(hwnd);
+      	   caret_visible = 1;
+      	   update_cursor();
+      	   return(0);
+      	   
+      case WM_KILLFOCUS:
+      	   HideCaret(hwnd);
+      	   DestroyCaret();
+      	   caret_visible = 0;
+      	   return(0);
+      	   
+      case WM_LBUTTONUP:
+      	   {
+      	       unsigned xpos = LOWORD(lParam);	/* From left	*/
+      	       unsigned ypos = HIWORD(lParam);	/* from top */
+      	       
+      	       set_position( xpos/char_width, ypos/char_height );
+      	       return(0);
+      	   }
+      	   
+      case WM_COMMAND:
+      	   id = LOWORD(wParam);
+      	   if (id & EDIT_CMD_FLAG) {
+               if (id & REPEAT_FLAG) do_command(REPEAT);
+               do_command(CHAR_CMD(id));
+               return( 0 );
+           } else {
+             switch(id) {
+               case IDM_FILEEXIT:
+                  SendMessage( hwnd, WM_CLOSE, 0, 0L );
+                  return( 0 );
+
+               case IDM_HELPABOUT:
+                  if( DialogBox( hInstance, "ABOUTBOX",
+                                 hwnd, lpfnAboutBox ) );
+                     InvalidateRect( hwnd, NULL, TRUE );
+                  return( 0 );
+	       case IDM_HELPCONTENTS:
+	     	  de_error(
+	     	       "Cursor keys: ^B(left) ^F(right) ^P(up) ^N(down)\n"
+	     	       "Undo: ^U    Write: ^W   Quit:^D  Repeat count: ^R[n]\n"
+	     	       "Top: ^T   Locate (search, find): ^L text ^L\n");
+	     	  return( 0 );
+	     }
+	   }
+           break;
+
+      case WM_CLOSE:
+           DestroyWindow( hwnd );
+           return 0;
+
+      case WM_DESTROY:
+           PostQuitMessage (0);
+	   GC_win32_free_heap();
+           return 0;
+      
+      case WM_PAINT:
+      	   dc = BeginPaint(hwnd, &ps);
+      	   GetClientRect(hwnd, &client_area);
+      	   COLS = (client_area.right - client_area.left)/char_width;
+      	   LINES = (client_area.bottom - client_area.top)/char_height;
+      	   SelectObject(dc, GetStockObject(SYSTEM_FIXED_FONT));
+      	   for (i = 0; i < LINES; i++) {
+      	       get_line_rect(i, client_area.right, &this_line);
+      	       if (IntersectRect(&dummy, &this_line, &ps.rcPaint)) {
+      	           CORD raw_line = retrieve_screen_line(i);
+      	           size_t len = CORD_len(raw_line);
+      	           char * text = CORD_to_char_star(raw_line);
+      	           		/* May contain embedded NULLs	*/
+      	           char * plain = plain_chars(text, len);
+      	           char * blanks = CORD_to_char_star(CORD_chars(' ',
+      	           				                COLS - len));
+      	           char * control = control_chars(text, len);
+#		   define RED RGB(255,0,0)
+      	           
+      	           SetBkMode(dc, OPAQUE);
+      	           SetTextColor(dc, GetSysColor(COLOR_WINDOWTEXT));
+      	           
+      	           TextOut(dc, this_line.left, this_line.top,
+      	           	   plain, len);
+      	           TextOut(dc, this_line.left + len * char_width, this_line.top,
+      	           	   blanks, COLS - len);
+      	           SetBkMode(dc, TRANSPARENT);
+      	           SetTextColor(dc, RED);
+      	           TextOut(dc, this_line.left, this_line.top,
+      	           	   control, strlen(control));
+      	       }
+      	   }
+      	   EndPaint(hwnd, &ps);
+      	   screen_was_painted = 1;
+      	   return 0;
+   }
+   return DefWindowProc (hwnd, message, wParam, lParam);
+}
+
+int last_col;
+int last_line;
+
+void move_cursor(int c, int l)
+{
+    last_col = c;
+    last_line = l;
+    
+    if (caret_visible) update_cursor();
+}
+
+void update_cursor(void)
+{
+    SetCaretPos(last_col * char_width, last_line * char_height);
+    ShowCaret(hwnd);
+}
+
+void invalidate_line(int i)
+{
+    RECT line;
+    
+    if (!screen_was_painted) return;
+    	/* Invalidating a rectangle before painting seems result in a	*/
+    	/* major performance problem.					*/
+    get_line_rect(i, COLS*char_width, &line);
+    InvalidateRect(hwnd, &line, FALSE);
+}
+
+LRESULT CALLBACK AboutBox( HWND hDlg, UINT message,
+                           WPARAM wParam, LPARAM lParam )
+{
+   switch( message )
+   {
+      case WM_INITDIALOG:
+           SetFocus( GetDlgItem( hDlg, IDOK ) );
+           break;
+
+      case WM_COMMAND:
+           switch( wParam )
+           {
+              case IDOK:
+                   EndDialog( hDlg, TRUE );
+                   break;
+           }
+           break;
+
+      case WM_CLOSE:
+           EndDialog( hDlg, TRUE );
+           return TRUE;
+
+   }
+   return FALSE;
+}
+
diff --git a/src/gc/cord/de_win.h b/src/gc/cord/de_win.h
new file mode 100644
index 000000000..57a47b45c
--- /dev/null
+++ b/src/gc/cord/de_win.h
@@ -0,0 +1,103 @@
+/*
+ * Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, May 19, 1994 2:25 pm PDT */
+
+/* cord.h, de_cmds.h, and windows.h should be included before this. */
+
+
+# define OTHER_FLAG	0x100
+# define EDIT_CMD_FLAG	0x200
+# define REPEAT_FLAG	0x400
+
+# define CHAR_CMD(i) ((i) & 0xff)
+
+/* MENU: DE */
+#define IDM_FILESAVE		(EDIT_CMD_FLAG + WRITE)
+#define IDM_FILEEXIT		(OTHER_FLAG + 1)
+#define IDM_HELPABOUT		(OTHER_FLAG + 2)
+#define IDM_HELPCONTENTS	(OTHER_FLAG + 3)
+
+#define IDM_EDITPDOWN		(REPEAT_FLAG + EDIT_CMD_FLAG + DOWN)
+#define IDM_EDITPUP		(REPEAT_FLAG + EDIT_CMD_FLAG + UP)
+#define IDM_EDITUNDO		(EDIT_CMD_FLAG + UNDO)
+#define IDM_EDITLOCATE		(EDIT_CMD_FLAG + LOCATE)
+#define IDM_EDITDOWN		(EDIT_CMD_FLAG + DOWN)
+#define IDM_EDITUP		(EDIT_CMD_FLAG + UP)
+#define IDM_EDITLEFT		(EDIT_CMD_FLAG + LEFT)
+#define IDM_EDITRIGHT		(EDIT_CMD_FLAG + RIGHT)
+#define IDM_EDITBS		(EDIT_CMD_FLAG + BS)
+#define IDM_EDITDEL		(EDIT_CMD_FLAG + DEL)
+#define IDM_EDITREPEAT		(EDIT_CMD_FLAG + REPEAT)
+#define IDM_EDITTOP		(EDIT_CMD_FLAG + TOP)
+
+
+
+
+/* Windows UI stuff	*/
+
+LRESULT CALLBACK WndProc (HWND hwnd, UINT message,
+			  UINT wParam, LONG lParam);
+
+LRESULT CALLBACK AboutBox( HWND hDlg, UINT message,
+			   UINT wParam, LONG lParam );
+
+
+/* Screen dimensions.  Maintained by de_win.c.	*/
+extern int LINES;
+extern int COLS;
+
+/* File being edited.	*/
+extern char * arg_file_name;
+
+/* Current display position in file.  Maintained by de.c	*/
+extern int dis_line;
+extern int dis_col;
+
+/* Current cursor position in file.				*/
+extern int line;
+extern int col;
+
+/*
+ *  Calls from de_win.c to de.c
+ */
+  
+CORD retrieve_screen_line(int i);
+			/* Get the contents of i'th screen line.	*/
+			/* Relies on COLS.				*/
+
+void set_position(int x, int y);
+			/* Set column, row.  Upper left of window = (0,0). */
+
+void do_command(int);
+			/* Execute an editor command.			*/
+			/* Agument is a command character or one	*/
+			/* of the IDM_ commands.			*/
+
+void generic_init(void);
+			/* OS independent initialization */
+
+
+/*
+ * Calls from de.c to de_win.c
+ */
+ 
+void move_cursor(int column, int line);
+			/* Physically move the cursor on the display,	*/
+			/* so that it appears at			*/
+			/* (column, line).				*/
+
+void invalidate_line(int line);
+			/* Invalidate line i on the screen.	*/
+
+void de_error(char *s);
+			/* Display error message.	*/
\ No newline at end of file
diff --git a/src/gc/cord/ec.h b/src/gc/cord/ec.h
new file mode 100644
index 000000000..c829b83ad
--- /dev/null
+++ b/src/gc/cord/ec.h
@@ -0,0 +1,70 @@
+# ifndef EC_H
+# define EC_H
+
+# ifndef CORD_H
+#  include "cord.h"
+# endif
+
+/* Extensible cords are strings that may be destructively appended to.	*/
+/* They allow fast construction of cords from characters that are	*/
+/* being read from a stream.						*/
+/*
+ * A client might look like:
+ *
+ *	{
+ *	    CORD_ec x;
+ *	    CORD result;
+ *	    char c;
+ *	    FILE *f;
+ *
+ *	    ...
+ *	    CORD_ec_init(x);
+ *	    while(...) {
+ *		c = getc(f);
+ *		...
+ *		CORD_ec_append(x, c);
+ *	    }
+ *	    result = CORD_balance(CORD_ec_to_cord(x));
+ *
+ * If a C string is desired as the final result, the call to CORD_balance
+ * may be replaced by a call to CORD_to_char_star.
+ */
+
+# ifndef CORD_BUFSZ
+#   define CORD_BUFSZ 128
+# endif
+
+typedef struct CORD_ec_struct {
+    CORD ec_cord;
+    char * ec_bufptr;
+    char ec_buf[CORD_BUFSZ+1];
+} CORD_ec[1];
+
+/* This structure represents the concatenation of ec_cord with		*/
+/* ec_buf[0 ... (ec_bufptr-ec_buf-1)]					*/
+
+/* Flush the buffer part of the extended chord into ec_cord.	*/
+/* Note that this is almost the only real function, and it is	*/
+/* implemented in 6 lines in cordxtra.c				*/
+void CORD_ec_flush_buf(CORD_ec x);
+      
+/* Convert an extensible cord to a cord. */
+# define CORD_ec_to_cord(x) (CORD_ec_flush_buf(x), (x)[0].ec_cord)
+
+/* Initialize an extensible cord. */
+# define CORD_ec_init(x) ((x)[0].ec_cord = 0, (x)[0].ec_bufptr = (x)[0].ec_buf)
+
+/* Append a character to an extensible cord.	*/
+# define CORD_ec_append(x, c) \
+    {  \
+	if ((x)[0].ec_bufptr == (x)[0].ec_buf + CORD_BUFSZ) { \
+	  	CORD_ec_flush_buf(x); \
+	} \
+	*((x)[0].ec_bufptr)++ = (c); \
+    }
+
+/* Append a cord to an extensible cord.  Structure remains shared with 	*/
+/* original.								*/
+void CORD_ec_append_cord(CORD_ec x, CORD s);
+
+# endif /* EC_H */
diff --git a/src/gc/cord/gc.h b/src/gc/cord/gc.h
new file mode 100644
index 000000000..d7cd89960
--- /dev/null
+++ b/src/gc/cord/gc.h
@@ -0,0 +1,804 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright 1996-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright 1999 by Hewlett-Packard Company.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * Note that this defines a large number of tuning hooks, which can
+ * safely be ignored in nearly all cases.  For normal use it suffices
+ * to call only GC_MALLOC and perhaps GC_REALLOC.
+ * For better performance, also look at GC_MALLOC_ATOMIC, and
+ * GC_enable_incremental.  If you need an action to be performed
+ * immediately before an object is collected, look at GC_register_finalizer.
+ * If you are using Solaris threads, look at the end of this file.
+ * Everything else is best ignored unless you encounter performance
+ * problems.
+ */
+ 
+#ifndef _GC_H
+
+# define _GC_H
+# define __GC
+# include <stddef.h>
+
+#if defined(__CYGWIN32__) && defined(GC_USE_DLL)
+#include "libgc_globals.h"
+#endif
+
+#if defined(__MINGW32__) && defined(WIN32_THREADS)
+# ifdef GC_BUILD
+#   define GC_API __declspec(dllexport)
+# else
+#   define GC_API __declspec(dllimport)
+# endif
+#endif
+
+#if defined(_MSC_VER) && defined(_DLL)
+# ifdef GC_BUILD
+#   define GC_API __declspec(dllexport)
+# else
+#   define GC_API __declspec(dllimport)
+# endif
+#endif
+
+#if defined(__WATCOMC__) && defined(GC_DLL)
+# ifdef GC_BUILD
+#   define GC_API extern __declspec(dllexport)
+# else
+#   define GC_API extern __declspec(dllimport)
+# endif
+#endif
+
+#ifndef GC_API
+#define GC_API extern
+#endif
+
+# if defined(__STDC__) || defined(__cplusplus)
+#   define GC_PROTO(args) args
+    typedef void * GC_PTR;
+#   define GC_CONST const
+# else
+#   define GC_PROTO(args) ()
+    typedef char * GC_PTR;
+#   define GC_CONST
+#  endif
+
+# ifdef __cplusplus
+    extern "C" {
+# endif
+
+
+/* Define word and signed_word to be unsigned and signed types of the 	*/
+/* size as char * or void *.  There seems to be no way to do this	*/
+/* even semi-portably.  The following is probably no better/worse 	*/
+/* than almost anything else.						*/
+/* The ANSI standard suggests that size_t and ptr_diff_t might be 	*/
+/* better choices.  But those appear to have incorrect definitions	*/
+/* on may systems.  Notably "typedef int size_t" seems to be both	*/
+/* frequent and WRONG.							*/
+typedef unsigned long GC_word;
+typedef long GC_signed_word;
+
+/* Public read-only variables */
+
+GC_API GC_word GC_gc_no;/* Counter incremented per collection.  	*/
+			/* Includes empty GCs at startup.		*/
+			
+
+/* Public R/W variables */
+
+GC_API GC_PTR (*GC_oom_fn) GC_PROTO((size_t bytes_requested));
+			/* When there is insufficient memory to satisfy */
+			/* an allocation request, we return		*/
+			/* (*GC_oom_fn)().  By default this just	*/
+			/* returns 0.					*/
+			/* If it returns, it must return 0 or a valid	*/
+			/* pointer to a previously allocated heap 	*/
+			/* object.					*/
+
+GC_API int GC_find_leak;
+			/* Do not actually garbage collect, but simply	*/
+			/* report inaccessible memory that was not	*/
+			/* deallocated with GC_free.  Initial value	*/
+			/* is determined by FIND_LEAK macro.		*/
+
+GC_API int GC_quiet;	/* Disable statistics output.  Only matters if	*/
+			/* collector has been compiled with statistics	*/
+			/* enabled.  This involves a performance cost,	*/
+			/* and is thus not the default.			*/
+
+GC_API int GC_finalize_on_demand;
+			/* If nonzero, finalizers will only be run in 	*/
+			/* response to an eplit GC_invoke_finalizers	*/
+			/* call.  The default is determined by whether	*/
+			/* the FINALIZE_ON_DEMAND macro is defined	*/
+			/* when the collector is built.			*/
+
+GC_API int GC_java_finalization;
+			/* Mark objects reachable from finalizable 	*/
+			/* objects in a separate postpass.  This makes	*/
+			/* it a bit safer to use non-topologically-	*/
+			/* ordered finalization.  Default value is	*/
+			/* determined by JAVA_FINALIZATION macro.	*/
+
+GC_API int GC_dont_gc;	/* Dont collect unless explicitly requested, e.g. */
+			/* because it's not safe.			  */
+
+GC_API int GC_dont_expand;
+			/* Dont expand heap unless explicitly requested */
+			/* or forced to.				*/
+
+GC_API int GC_use_entire_heap;
+		/* Causes the nonincremental collector to use the	*/
+		/* entire heap before collecting.  This was the only 	*/
+		/* option for GC versions < 5.0.  This sometimes	*/
+		/* results in more large block fragmentation, since	*/
+		/* very larg blocks will tend to get broken up		*/
+		/* during each GC cycle.  It is likely to result in a	*/
+		/* larger working set, but lower collection		*/
+		/* frequencies, and hence fewer instructions executed	*/
+		/* in the collector.					*/
+
+GC_API int GC_full_freq;    /* Number of partial collections between	*/
+			    /* full collections.  Matters only if	*/
+			    /* GC_incremental is set.			*/
+			    /* Full collections are also triggered if	*/
+			    /* the collector detects a substantial	*/
+			    /* increase in the number of in-use heap	*/
+			    /* blocks.  Values in the tens are now	*/
+			    /* perfectly reasonable, unlike for		*/
+			    /* earlier GC versions.			*/
+			
+GC_API GC_word GC_non_gc_bytes;
+			/* Bytes not considered candidates for collection. */
+			/* Used only to control scheduling of collections. */
+
+GC_API GC_word GC_free_space_divisor;
+			/* We try to make sure that we allocate at 	*/
+			/* least N/GC_free_space_divisor bytes between	*/
+			/* collections, where N is the heap size plus	*/
+			/* a rough estimate of the root set size.	*/
+			/* Initially, GC_free_space_divisor = 4.	*/
+			/* Increasing its value will use less space	*/
+			/* but more collection time.  Decreasing it	*/
+			/* will appreciably decrease collection time	*/
+			/* at the expense of space.			*/
+			/* GC_free_space_divisor = 1 will effectively	*/
+			/* disable collections.				*/
+
+GC_API GC_word GC_max_retries;
+			/* The maximum number of GCs attempted before	*/
+			/* reporting out of memory after heap		*/
+			/* expansion fails.  Initially 0.		*/
+			
+
+GC_API char *GC_stackbottom;	/* Cool end of user stack.		*/
+				/* May be set in the client prior to	*/
+				/* calling any GC_ routines.  This	*/
+				/* avoids some overhead, and 		*/
+				/* potentially some signals that can 	*/
+				/* confuse debuggers.  Otherwise the	*/
+				/* collector attempts to set it 	*/
+				/* automatically.			*/
+				/* For multithreaded code, this is the	*/
+				/* cold end of the stack for the	*/
+				/* primordial thread.			*/
+				
+/* Public procedures */
+/*
+ * general purpose allocation routines, with roughly malloc calling conv.
+ * The atomic versions promise that no relevant pointers are contained
+ * in the object.  The nonatomic versions guarantee that the new object
+ * is cleared.  GC_malloc_stubborn promises that no changes to the object
+ * will occur after GC_end_stubborn_change has been called on the
+ * result of GC_malloc_stubborn. GC_malloc_uncollectable allocates an object
+ * that is scanned for pointers to collectable objects, but is not itself
+ * collectable.  GC_malloc_uncollectable and GC_free called on the resulting
+ * object implicitly update GC_non_gc_bytes appropriately.
+ */
+GC_API GC_PTR GC_malloc GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_atomic GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_uncollectable GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_stubborn GC_PROTO((size_t size_in_bytes));
+
+/* The following is only defined if the library has been suitably	*/
+/* compiled:								*/
+GC_API GC_PTR GC_malloc_atomic_uncollectable GC_PROTO((size_t size_in_bytes));
+
+/* Explicitly deallocate an object.  Dangerous if used incorrectly.     */
+/* Requires a pointer to the base of an object.				*/
+/* If the argument is stubborn, it should not be changeable when freed. */
+/* An object should not be enable for finalization when it is 		*/
+/* explicitly deallocated.						*/
+/* GC_free(0) is a no-op, as required by ANSI C for free.		*/
+GC_API void GC_free GC_PROTO((GC_PTR object_addr));
+
+/*
+ * Stubborn objects may be changed only if the collector is explicitly informed.
+ * The collector is implicitly informed of coming change when such
+ * an object is first allocated.  The following routines inform the
+ * collector that an object will no longer be changed, or that it will
+ * once again be changed.  Only nonNIL pointer stores into the object
+ * are considered to be changes.  The argument to GC_end_stubborn_change
+ * must be exacly the value returned by GC_malloc_stubborn or passed to
+ * GC_change_stubborn.  (In the second case it may be an interior pointer
+ * within 512 bytes of the beginning of the objects.)
+ * There is a performance penalty for allowing more than
+ * one stubborn object to be changed at once, but it is acceptable to
+ * do so.  The same applies to dropping stubborn objects that are still
+ * changeable.
+ */
+GC_API void GC_change_stubborn GC_PROTO((GC_PTR));
+GC_API void GC_end_stubborn_change GC_PROTO((GC_PTR));
+
+/* Return a pointer to the base (lowest address) of an object given	*/
+/* a pointer to a location within the object.				*/
+/* Return 0 if displaced_pointer doesn't point to within a valid	*/
+/* object.								*/
+GC_API GC_PTR GC_base GC_PROTO((GC_PTR displaced_pointer));
+
+/* Given a pointer to the base of an object, return its size in bytes.	*/
+/* The returned size may be slightly larger than what was originally	*/
+/* requested.								*/
+GC_API size_t GC_size GC_PROTO((GC_PTR object_addr));
+
+/* For compatibility with C library.  This is occasionally faster than	*/
+/* a malloc followed by a bcopy.  But if you rely on that, either here	*/
+/* or with the standard C library, your code is broken.  In my		*/
+/* opinion, it shouldn't have been invented, but now we're stuck. -HB	*/
+/* The resulting object has the same kind as the original.		*/
+/* If the argument is stubborn, the result will have changes enabled.	*/
+/* It is an error to have changes enabled for the original object.	*/
+/* Follows ANSI comventions for NULL old_object.			*/
+GC_API GC_PTR GC_realloc
+	GC_PROTO((GC_PTR old_object, size_t new_size_in_bytes));
+				   
+/* Explicitly increase the heap size.	*/
+/* Returns 0 on failure, 1 on success.  */
+GC_API int GC_expand_hp GC_PROTO((size_t number_of_bytes));
+
+/* Limit the heap size to n bytes.  Useful when you're debugging, 	*/
+/* especially on systems that don't handle running out of memory well.	*/
+/* n == 0 ==> unbounded.  This is the default.				*/
+GC_API void GC_set_max_heap_size GC_PROTO((GC_word n));
+
+/* Inform the collector that a certain section of statically allocated	*/
+/* memory contains no pointers to garbage collected memory.  Thus it 	*/
+/* need not be scanned.  This is sometimes important if the application */
+/* maps large read/write files into the address space, which could be	*/
+/* mistaken for dynamic library data segments on some systems.		*/
+GC_API void GC_exclude_static_roots GC_PROTO((GC_PTR start, GC_PTR finish));
+
+/* Clear the set of root segments.  Wizards only. */
+GC_API void GC_clear_roots GC_PROTO((void));
+
+/* Add a root segment.  Wizards only. */
+GC_API void GC_add_roots GC_PROTO((char * low_address,
+				   char * high_address_plus_1));
+
+/* Add a displacement to the set of those considered valid by the	*/
+/* collector.  GC_register_displacement(n) means that if p was returned */
+/* by GC_malloc, then (char *)p + n will be considered to be a valid	*/
+/* pointer to n.  N must be small and less than the size of p.		*/
+/* (All pointers to the interior of objects from the stack are		*/
+/* considered valid in any case.  This applies to heap objects and	*/
+/* static data.)							*/
+/* Preferably, this should be called before any other GC procedures.	*/
+/* Calling it later adds to the probability of excess memory		*/
+/* retention.								*/
+/* This is a no-op if the collector was compiled with recognition of	*/
+/* arbitrary interior pointers enabled, which is now the default.	*/
+GC_API void GC_register_displacement GC_PROTO((GC_word n));
+
+/* The following version should be used if any debugging allocation is	*/
+/* being done.								*/
+GC_API void GC_debug_register_displacement GC_PROTO((GC_word n));
+
+/* Explicitly trigger a full, world-stop collection. 	*/
+GC_API void GC_gcollect GC_PROTO((void));
+
+/* Trigger a full world-stopped collection.  Abort the collection if 	*/
+/* and when stop_func returns a nonzero value.  Stop_func will be 	*/
+/* called frequently, and should be reasonably fast.  This works even	*/
+/* if virtual dirty bits, and hence incremental collection is not 	*/
+/* available for this architecture.  Collections can be aborted faster	*/
+/* than normal pause times for incremental collection.  However,	*/
+/* aborted collections do no useful work; the next collection needs	*/
+/* to start from the beginning.						*/
+/* Return 0 if the collection was aborted, 1 if it succeeded.		*/
+typedef int (* GC_stop_func) GC_PROTO((void));
+GC_API int GC_try_to_collect GC_PROTO((GC_stop_func stop_func));
+
+/* Return the number of bytes in the heap.  Excludes collector private	*/
+/* data structures.  Includes empty blocks and fragmentation loss.	*/
+/* Includes some pages that were allocated but never written.		*/
+GC_API size_t GC_get_heap_size GC_PROTO((void));
+
+/* Return a lower bound on the number of free bytes in the heap.	*/
+GC_API size_t GC_get_free_bytes GC_PROTO((void));
+
+/* Return the number of bytes allocated since the last collection.	*/
+GC_API size_t GC_get_bytes_since_gc GC_PROTO((void));
+
+/* Enable incremental/generational collection.	*/
+/* Not advisable unless dirty bits are 		*/
+/* available or most heap objects are		*/
+/* pointerfree(atomic) or immutable.		*/
+/* Don't use in leak finding mode.		*/
+/* Ignored if GC_dont_gc is true.		*/
+GC_API void GC_enable_incremental GC_PROTO((void));
+
+/* Perform some garbage collection work, if appropriate.	*/
+/* Return 0 if there is no more work to be done.		*/
+/* Typically performs an amount of work corresponding roughly	*/
+/* to marking from one page.  May do more work if further	*/
+/* progress requires it, e.g. if incremental collection is	*/
+/* disabled.  It is reasonable to call this in a wait loop	*/
+/* until it returns 0.						*/
+GC_API int GC_collect_a_little GC_PROTO((void));
+
+/* Allocate an object of size lb bytes.  The client guarantees that	*/
+/* as long as the object is live, it will be referenced by a pointer	*/
+/* that points to somewhere within the first 256 bytes of the object.	*/
+/* (This should normally be declared volatile to prevent the compiler	*/
+/* from invalidating this assertion.)  This routine is only useful	*/
+/* if a large array is being allocated.  It reduces the chance of 	*/
+/* accidentally retaining such an array as a result of scanning an	*/
+/* integer that happens to be an address inside the array.  (Actually,	*/
+/* it reduces the chance of the allocator not finding space for such	*/
+/* an array, since it will try hard to avoid introducing such a false	*/
+/* reference.)  On a SunOS 4.X or MS Windows system this is recommended */
+/* for arrays likely to be larger than 100K or so.  For other systems,	*/
+/* or if the collector is not configured to recognize all interior	*/
+/* pointers, the threshold is normally much higher.			*/
+GC_API GC_PTR GC_malloc_ignore_off_page GC_PROTO((size_t lb));
+GC_API GC_PTR GC_malloc_atomic_ignore_off_page GC_PROTO((size_t lb));
+
+#if defined(__sgi) && !defined(__GNUC__) && _COMPILER_VERSION >= 720
+#   define GC_ADD_CALLER
+#   define GC_RETURN_ADDR (GC_word)__return_address
+#endif
+
+#ifdef GC_ADD_CALLER
+#  define GC_EXTRAS GC_RETURN_ADDR, __FILE__, __LINE__
+#  define GC_EXTRA_PARAMS GC_word ra, GC_CONST char * s, int i
+#else
+#  define GC_EXTRAS __FILE__, __LINE__
+#  define GC_EXTRA_PARAMS GC_CONST char * s, int i
+#endif
+
+/* Debugging (annotated) allocation.  GC_gcollect will check 		*/
+/* objects allocated in this way for overwrites, etc.			*/
+GC_API GC_PTR GC_debug_malloc
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_atomic
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_uncollectable
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_stubborn
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API void GC_debug_free GC_PROTO((GC_PTR object_addr));
+GC_API GC_PTR GC_debug_realloc
+	GC_PROTO((GC_PTR old_object, size_t new_size_in_bytes,
+  		  GC_EXTRA_PARAMS));
+  			 	 
+GC_API void GC_debug_change_stubborn GC_PROTO((GC_PTR));
+GC_API void GC_debug_end_stubborn_change GC_PROTO((GC_PTR));
+# ifdef GC_DEBUG
+#   define GC_MALLOC(sz) GC_debug_malloc(sz, GC_EXTRAS)
+#   define GC_MALLOC_ATOMIC(sz) GC_debug_malloc_atomic(sz, GC_EXTRAS)
+#   define GC_MALLOC_UNCOLLECTABLE(sz) GC_debug_malloc_uncollectable(sz, \
+							GC_EXTRAS)
+#   define GC_REALLOC(old, sz) GC_debug_realloc(old, sz, GC_EXTRAS)
+#   define GC_FREE(p) GC_debug_free(p)
+#   define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+	GC_debug_register_finalizer(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_IGNORE_SELF(p, f, d, of, od) \
+	GC_debug_register_finalizer_ignore_self(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
+	GC_debug_register_finalizer_no_order(p, f, d, of, od)
+#   define GC_MALLOC_STUBBORN(sz) GC_debug_malloc_stubborn(sz, GC_EXTRAS);
+#   define GC_CHANGE_STUBBORN(p) GC_debug_change_stubborn(p)
+#   define GC_END_STUBBORN_CHANGE(p) GC_debug_end_stubborn_change(p)
+#   define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
+	GC_general_register_disappearing_link(link, GC_base(obj))
+#   define GC_REGISTER_DISPLACEMENT(n) GC_debug_register_displacement(n)
+# else
+#   define GC_MALLOC(sz) GC_malloc(sz)
+#   define GC_MALLOC_ATOMIC(sz) GC_malloc_atomic(sz)
+#   define GC_MALLOC_UNCOLLECTABLE(sz) GC_malloc_uncollectable(sz)
+#   define GC_REALLOC(old, sz) GC_realloc(old, sz)
+#   define GC_FREE(p) GC_free(p)
+#   define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+	GC_register_finalizer(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_IGNORE_SELF(p, f, d, of, od) \
+	GC_register_finalizer_ignore_self(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
+	GC_register_finalizer_no_order(p, f, d, of, od)
+#   define GC_MALLOC_STUBBORN(sz) GC_malloc_stubborn(sz)
+#   define GC_CHANGE_STUBBORN(p) GC_change_stubborn(p)
+#   define GC_END_STUBBORN_CHANGE(p) GC_end_stubborn_change(p)
+#   define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
+	GC_general_register_disappearing_link(link, obj)
+#   define GC_REGISTER_DISPLACEMENT(n) GC_register_displacement(n)
+# endif
+/* The following are included because they are often convenient, and	*/
+/* reduce the chance for a misspecifed size argument.  But calls may	*/
+/* expand to something syntactically incorrect if t is a complicated	*/
+/* type expression.  							*/
+# define GC_NEW(t) (t *)GC_MALLOC(sizeof (t))
+# define GC_NEW_ATOMIC(t) (t *)GC_MALLOC_ATOMIC(sizeof (t))
+# define GC_NEW_STUBBORN(t) (t *)GC_MALLOC_STUBBORN(sizeof (t))
+# define GC_NEW_UNCOLLECTABLE(t) (t *)GC_MALLOC_UNCOLLECTABLE(sizeof (t))
+
+/* Finalization.  Some of these primitives are grossly unsafe.		*/
+/* The idea is to make them both cheap, and sufficient to build		*/
+/* a safer layer, closer to PCedar finalization.			*/
+/* The interface represents my conclusions from a long discussion	*/
+/* with Alan Demers, Dan Greene, Carl Hauser, Barry Hayes, 		*/
+/* Christian Jacobi, and Russ Atkinson.  It's not perfect, and		*/
+/* probably nobody else agrees with it.	    Hans-J. Boehm  3/13/92	*/
+typedef void (*GC_finalization_proc)
+  	GC_PROTO((GC_PTR obj, GC_PTR client_data));
+
+GC_API void GC_register_finalizer
+    	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer
+    	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+	/* When obj is no longer accessible, invoke		*/
+	/* (*fn)(obj, cd).  If a and b are inaccessible, and	*/
+	/* a points to b (after disappearing links have been	*/
+	/* made to disappear), then only a will be		*/
+	/* finalized.  (If this does not create any new		*/
+	/* pointers to b, then b will be finalized after the	*/
+	/* next collection.)  Any finalizable object that	*/
+	/* is reachable from itself by following one or more	*/
+	/* pointers will not be finalized (or collected).	*/
+	/* Thus cycles involving finalizable objects should	*/
+	/* be avoided, or broken by disappearing links.		*/
+	/* All but the last finalizer registered for an object  */
+	/* is ignored.						*/
+	/* Finalization may be removed by passing 0 as fn.	*/
+	/* Finalizers are implicitly unregistered just before   */
+	/* they are invoked.					*/
+	/* The old finalizer and client data are stored in	*/
+	/* *ofn and *ocd.					*/ 
+	/* Fn is never invoked on an accessible object,		*/
+	/* provided hidden pointers are converted to real 	*/
+	/* pointers only if the allocation lock is held, and	*/
+	/* such conversions are not performed by finalization	*/
+	/* routines.						*/
+	/* If GC_register_finalizer is aborted as a result of	*/
+	/* a signal, the object may be left with no		*/
+	/* finalization, even if neither the old nor new	*/
+	/* finalizer were NULL.					*/
+	/* Obj should be the nonNULL starting address of an 	*/
+	/* object allocated by GC_malloc or friends.		*/
+	/* Note that any garbage collectable object referenced	*/
+	/* by cd will be considered accessible until the	*/
+	/* finalizer is invoked.				*/
+
+/* Another versions of the above follow.  It ignores		*/
+/* self-cycles, i.e. pointers from a finalizable object to	*/
+/* itself.  There is a stylistic argument that this is wrong,	*/
+/* but it's unavoidable for C++, since the compiler may		*/
+/* silently introduce these.  It's also benign in that specific	*/
+/* case.							*/
+GC_API void GC_register_finalizer_ignore_self
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer_ignore_self
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+
+/* Another version of the above.  It ignores all cycles.        */
+/* It should probably only be used by Java implementations.      */
+GC_API void GC_register_finalizer_no_order
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer_no_order
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+
+
+/* The following routine may be used to break cycles between	*/
+/* finalizable objects, thus causing cyclic finalizable		*/
+/* objects to be finalized in the correct order.  Standard	*/
+/* use involves calling GC_register_disappearing_link(&p),	*/
+/* where p is a pointer that is not followed by finalization	*/
+/* code, and should not be considered in determining 		*/
+/* finalization order.						*/
+GC_API int GC_register_disappearing_link GC_PROTO((GC_PTR * /* link */));
+	/* Link should point to a field of a heap allocated 	*/
+	/* object obj.  *link will be cleared when obj is	*/
+	/* found to be inaccessible.  This happens BEFORE any	*/
+	/* finalization code is invoked, and BEFORE any		*/
+	/* decisions about finalization order are made.		*/
+	/* This is useful in telling the finalizer that 	*/
+	/* some pointers are not essential for proper		*/
+	/* finalization.  This may avoid finalization cycles.	*/
+	/* Note that obj may be resurrected by another		*/
+	/* finalizer, and thus the clearing of *link may	*/
+	/* be visible to non-finalization code.  		*/
+	/* There's an argument that an arbitrary action should  */
+	/* be allowed here, instead of just clearing a pointer. */
+	/* But this causes problems if that action alters, or 	*/
+	/* examines connectivity.				*/
+	/* Returns 1 if link was already registered, 0		*/
+	/* otherwise.						*/
+	/* Only exists for backward compatibility.  See below:	*/
+	
+GC_API int GC_general_register_disappearing_link
+	GC_PROTO((GC_PTR * /* link */, GC_PTR obj));
+	/* A slight generalization of the above. *link is	*/
+	/* cleared when obj first becomes inaccessible.  This	*/
+	/* can be used to implement weak pointers easily and	*/
+	/* safely. Typically link will point to a location	*/
+	/* holding a disguised pointer to obj.  (A pointer 	*/
+	/* inside an "atomic" object is effectively  		*/
+	/* disguised.)   In this way soft			*/
+	/* pointers are broken before any object		*/
+	/* reachable from them are finalized.  Each link	*/
+	/* May be registered only once, i.e. with one obj	*/
+	/* value.  This was added after a long email discussion */
+	/* with John Ellis.					*/
+	/* Obj must be a pointer to the first word of an object */
+	/* we allocated.  It is unsafe to explicitly deallocate */
+	/* the object containing link.  Explicitly deallocating */
+	/* obj may or may not cause link to eventually be	*/
+	/* cleared.						*/
+GC_API int GC_unregister_disappearing_link GC_PROTO((GC_PTR * /* link */));
+	/* Returns 0 if link was not actually registered.	*/
+	/* Undoes a registration by either of the above two	*/
+	/* routines.						*/
+
+/* Auxiliary fns to make finalization work correctly with displaced	*/
+/* pointers introduced by the debugging allocators.			*/
+GC_API GC_PTR GC_make_closure GC_PROTO((GC_finalization_proc fn, GC_PTR data));
+GC_API void GC_debug_invoke_finalizer GC_PROTO((GC_PTR obj, GC_PTR data));
+
+/* Returns !=0  if GC_invoke_finalizers has something to do. 		*/
+GC_API int GC_should_invoke_finalizers GC_PROTO((void));
+
+GC_API int GC_invoke_finalizers GC_PROTO((void));
+	/* Run finalizers for all objects that are ready to	*/
+	/* be finalized.  Return the number of finalizers	*/
+	/* that were run.  Normally this is also called		*/
+	/* implicitly during some allocations.	If		*/
+	/* GC-finalize_on_demand is nonzero, it must be called	*/
+	/* explicitly.						*/
+
+/* GC_set_warn_proc can be used to redirect or filter warning messages.	*/
+/* p may not be a NULL pointer.						*/
+typedef void (*GC_warn_proc) GC_PROTO((char *msg, GC_word arg));
+GC_API GC_warn_proc GC_set_warn_proc GC_PROTO((GC_warn_proc p));
+    /* Returns old warning procedure.	*/
+	
+/* The following is intended to be used by a higher level	*/
+/* (e.g. cedar-like) finalization facility.  It is expected	*/
+/* that finalization code will arrange for hidden pointers to	*/
+/* disappear.  Otherwise objects can be accessed after they	*/
+/* have been collected.						*/
+/* Note that putting pointers in atomic objects or in 		*/
+/* nonpointer slots of "typed" objects is equivalent to 	*/
+/* disguising them in this way, and may have other advantages.	*/
+# if defined(I_HIDE_POINTERS) || defined(GC_I_HIDE_POINTERS)
+    typedef GC_word GC_hidden_pointer;
+#   define HIDE_POINTER(p) (~(GC_hidden_pointer)(p))
+#   define REVEAL_POINTER(p) ((GC_PTR)(HIDE_POINTER(p)))
+    /* Converting a hidden pointer to a real pointer requires verifying	*/
+    /* that the object still exists.  This involves acquiring the  	*/
+    /* allocator lock to avoid a race with the collector.		*/
+# endif /* I_HIDE_POINTERS */
+
+typedef GC_PTR (*GC_fn_type) GC_PROTO((GC_PTR client_data));
+GC_API GC_PTR GC_call_with_alloc_lock
+        	GC_PROTO((GC_fn_type fn, GC_PTR client_data));
+
+/* Check that p and q point to the same object.  		*/
+/* Fail conspicuously if they don't.				*/
+/* Returns the first argument.  				*/
+/* Succeeds if neither p nor q points to the heap.		*/
+/* May succeed if both p and q point to between heap objects.	*/
+GC_API GC_PTR GC_same_obj GC_PROTO((GC_PTR p, GC_PTR q));
+
+/* Checked pointer pre- and post- increment operations.  Note that	*/
+/* the second argument is in units of bytes, not multiples of the	*/
+/* object size.  This should either be invoked from a macro, or the	*/
+/* call should be automatically generated.				*/
+GC_API GC_PTR GC_pre_incr GC_PROTO((GC_PTR *p, size_t how_much));
+GC_API GC_PTR GC_post_incr GC_PROTO((GC_PTR *p, size_t how_much));
+
+/* Check that p is visible						*/
+/* to the collector as a possibly pointer containing location.		*/
+/* If it isn't fail conspicuously.					*/
+/* Returns the argument in all cases.  May erroneously succeed		*/
+/* in hard cases.  (This is intended for debugging use with		*/
+/* untyped allocations.  The idea is that it should be possible, though	*/
+/* slow, to add such a call to all indirect pointer stores.)		*/
+/* Currently useless for multithreaded worlds.				*/
+GC_API GC_PTR GC_is_visible GC_PROTO((GC_PTR p));
+
+/* Check that if p is a pointer to a heap page, then it points to	*/
+/* a valid displacement within a heap object.				*/
+/* Fail conspicuously if this property does not hold.			*/
+/* Uninteresting with ALL_INTERIOR_POINTERS.				*/
+/* Always returns its argument.						*/
+GC_API GC_PTR GC_is_valid_displacement GC_PROTO((GC_PTR	p));
+
+/* Safer, but slow, pointer addition.  Probably useful mainly with 	*/
+/* a preprocessor.  Useful only for heap pointers.			*/
+#ifdef GC_DEBUG
+#   define GC_PTR_ADD3(x, n, type_of_result) \
+	((type_of_result)GC_same_obj((x)+(n), (x)))
+#   define GC_PRE_INCR3(x, n, type_of_result) \
+	((type_of_result)GC_pre_incr(&(x), (n)*sizeof(*x))
+#   define GC_POST_INCR2(x, type_of_result) \
+	((type_of_result)GC_post_incr(&(x), sizeof(*x))
+#   ifdef __GNUC__
+#       define GC_PTR_ADD(x, n) \
+	    GC_PTR_ADD3(x, n, typeof(x))
+#   define GC_PRE_INCR(x, n) \
+	    GC_PRE_INCR3(x, n, typeof(x))
+#   define GC_POST_INCR(x, n) \
+	    GC_POST_INCR3(x, typeof(x))
+#   else
+	/* We can't do this right without typeof, which ANSI	*/
+	/* decided was not sufficiently useful.  Repeatedly	*/
+	/* mentioning the arguments seems too dangerous to be	*/
+	/* useful.  So does not casting the result.		*/
+#   	define GC_PTR_ADD(x, n) ((x)+(n))
+#   endif
+#else	/* !GC_DEBUG */
+#   define GC_PTR_ADD3(x, n, type_of_result) ((x)+(n))
+#   define GC_PTR_ADD(x, n) ((x)+(n))
+#   define GC_PRE_INCR3(x, n, type_of_result) ((x) += (n))
+#   define GC_PRE_INCR(x, n) ((x) += (n))
+#   define GC_POST_INCR2(x, n, type_of_result) ((x)++)
+#   define GC_POST_INCR(x, n) ((x)++)
+#endif
+
+/* Safer assignment of a pointer to a nonstack location.	*/
+#ifdef GC_DEBUG
+# ifdef __STDC__
+#   define GC_PTR_STORE(p, q) \
+	(*(void **)GC_is_visible(p) = GC_is_valid_displacement(q))
+# else
+#   define GC_PTR_STORE(p, q) \
+	(*(char **)GC_is_visible(p) = GC_is_valid_displacement(q))
+# endif
+#else /* !GC_DEBUG */
+#   define GC_PTR_STORE(p, q) *((p) = (q))
+#endif
+
+/* Fynctions called to report pointer checking errors */
+GC_API void (*GC_same_obj_print_proc) GC_PROTO((GC_PTR p, GC_PTR q));
+
+GC_API void (*GC_is_valid_displacement_print_proc)
+	GC_PROTO((GC_PTR p));
+
+GC_API void (*GC_is_visible_print_proc)
+	GC_PROTO((GC_PTR p));
+
+#if defined(_SOLARIS_PTHREADS) && !defined(SOLARIS_THREADS)
+#   define SOLARIS_THREADS
+#endif
+
+#ifdef SOLARIS_THREADS
+/* We need to intercept calls to many of the threads primitives, so 	*/
+/* that we can locate thread stacks and stop the world.			*/
+/* Note also that the collector cannot see thread specific data.	*/
+/* Thread specific data should generally consist of pointers to		*/
+/* uncollectable objects, which are deallocated using the destructor	*/
+/* facility in thr_keycreate.						*/
+# include <thread.h>
+# include <signal.h>
+  int GC_thr_create(void *stack_base, size_t stack_size,
+                    void *(*start_routine)(void *), void *arg, long flags,
+                    thread_t *new_thread);
+  int GC_thr_join(thread_t wait_for, thread_t *departed, void **status);
+  int GC_thr_suspend(thread_t target_thread);
+  int GC_thr_continue(thread_t target_thread);
+  void * GC_dlopen(const char *path, int mode);
+
+# ifdef _SOLARIS_PTHREADS
+#   include <pthread.h>
+    extern int GC_pthread_create(pthread_t *new_thread,
+    			         const pthread_attr_t *attr,
+          			 void * (*thread_execp)(void *), void *arg);
+    extern int GC_pthread_join(pthread_t wait_for, void **status);
+
+#   undef thread_t
+
+#   define pthread_join GC_pthread_join
+#   define pthread_create GC_pthread_create
+#endif
+
+# define thr_create GC_thr_create
+# define thr_join GC_thr_join
+# define thr_suspend GC_thr_suspend
+# define thr_continue GC_thr_continue
+# define dlopen GC_dlopen
+
+# endif /* SOLARIS_THREADS */
+
+
+#if !defined(USE_LD_WRAP) && \
+    (defined(IRIX_THREADS) || defined(LINUX_THREADS) || defined(HPUX_THREADS))
+/* We treat these similarly. */
+# include <pthread.h>
+# include <signal.h>
+
+  int GC_pthread_create(pthread_t *new_thread,
+                        const pthread_attr_t *attr,
+		        void *(*start_routine)(void *), void *arg);
+  int GC_pthread_sigmask(int how, const sigset_t *set, sigset_t *oset);
+  int GC_pthread_join(pthread_t thread, void **retval);
+
+# define pthread_create GC_pthread_create
+# define pthread_sigmask GC_pthread_sigmask
+# define pthread_join GC_pthread_join
+# define dlopen GC_dlopen
+
+#endif /* xxxxx_THREADS */
+
+# if defined(PCR) || defined(SOLARIS_THREADS) || defined(WIN32_THREADS) || \
+	defined(IRIX_THREADS) || defined(LINUX_THREADS) || \
+	defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
+   	/* Any flavor of threads except SRC_M3.	*/
+/* This returns a list of objects, linked through their first		*/
+/* word.  Its use can greatly reduce lock contention problems, since	*/
+/* the allocation lock can be acquired and released many fewer times.	*/
+/* lb must be large enough to hold the pointer field.			*/
+GC_PTR GC_malloc_many(size_t lb);
+#define GC_NEXT(p) (*(GC_PTR *)(p)) 	/* Retrieve the next element	*/
+					/* in returned list.		*/
+extern void GC_thr_init();	/* Needed for Solaris/X86	*/
+
+#endif /* THREADS && !SRC_M3 */
+
+/*
+ * If you are planning on putting
+ * the collector in a SunOS 5 dynamic library, you need to call GC_INIT()
+ * from the statically loaded program section.
+ * This circumvents a Solaris 2.X (X<=4) linker bug.
+ */
+#if defined(sparc) || defined(__sparc)
+#   define GC_INIT() { extern end, etext; \
+		       GC_noop(&end, &etext); }
+#else
+# if defined(__CYGWIN32__) && defined(GC_USE_DLL)
+    /*
+     * Similarly gnu-win32 DLLs need explicit initialization
+     */
+#   define GC_INIT() { GC_add_roots(DATASTART, DATAEND); }
+# else
+#   define GC_INIT()
+# endif
+#endif
+
+#if (defined(_MSDOS) || defined(_MSC_VER)) && (_M_IX86 >= 300) \
+     || defined(_WIN32)
+  /* win32S may not free all resources on process exit.  */
+  /* This explicitly deallocates the heap.		 */
+    GC_API void GC_win32_free_heap ();
+#endif
+
+#ifdef __cplusplus
+    }  /* end of extern "C" */
+#endif
+
+#endif /* _GC_H */
diff --git a/src/gc/cord/private/cord_pos.h b/src/gc/cord/private/cord_pos.h
new file mode 100644
index 000000000..d2b24bb8a
--- /dev/null
+++ b/src/gc/cord/private/cord_pos.h
@@ -0,0 +1,118 @@
+/* 
+ * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, May 19, 1994 2:23 pm PDT */
+# ifndef CORD_POSITION_H
+
+/* The representation of CORD_position.  This is private to the	*/
+/* implementation, but the size is known to clients.  Also	*/
+/* the implementation of some exported macros relies on it.	*/
+/* Don't use anything defined here and not in cord.h.		*/
+
+# define MAX_DEPTH 48
+	/* The maximum depth of a balanced cord + 1.		*/
+	/* We don't let cords get deeper than MAX_DEPTH.	*/
+
+struct CORD_pe {
+    CORD pe_cord;
+    size_t pe_start_pos;
+};
+
+/* A structure describing an entry on the path from the root 	*/
+/* to current position.						*/
+typedef struct CORD_Pos {
+    size_t cur_pos;
+    int path_len;
+#	define CORD_POS_INVALID (0x55555555)
+		/* path_len == INVALID <==> position invalid */
+    const char *cur_leaf;	/* Current leaf, if it is a string.	*/
+    				/* If the current leaf is a function,	*/
+    				/* then this may point to function_buf	*/
+    				/* containing the next few characters.	*/
+    				/* Always points to a valid string	*/
+    				/* containing the current character 	*/
+    				/* unless cur_end is 0.			*/
+    size_t cur_start;	/* Start position of cur_leaf	*/
+    size_t cur_end;	/* Ending position of cur_leaf	*/
+    			/* 0 if cur_leaf is invalid.	*/
+    struct CORD_pe path[MAX_DEPTH + 1];
+    	/* path[path_len] is the leaf corresponding to cur_pos	*/
+    	/* path[0].pe_cord is the cord we point to.		*/
+#   define FUNCTION_BUF_SZ 8
+    char function_buf[FUNCTION_BUF_SZ];	/* Space for next few chars	*/
+    					/* from function node.		*/
+} CORD_pos[1];
+
+/* Extract the cord from a position:	*/
+CORD CORD_pos_to_cord(CORD_pos p);
+	
+/* Extract the current index from a position:	*/
+size_t CORD_pos_to_index(CORD_pos p);
+	
+/* Fetch the character located at the given position:	*/
+char CORD_pos_fetch(CORD_pos p);
+	
+/* Initialize the position to refer to the give cord and index.	*/
+/* Note that this is the most expensive function on positions:	*/
+void CORD_set_pos(CORD_pos p, CORD x, size_t i);
+	
+/* Advance the position to the next character.	*/
+/* P must be initialized and valid.		*/
+/* Invalidates p if past end:			*/
+void CORD_next(CORD_pos p);
+
+/* Move the position to the preceding character.	*/
+/* P must be initialized and valid.			*/
+/* Invalidates p if past beginning:			*/
+void CORD_prev(CORD_pos p);
+	
+/* Is the position valid, i.e. inside the cord?		*/
+int CORD_pos_valid(CORD_pos p);
+
+char CORD__pos_fetch(CORD_pos);
+void CORD__next(CORD_pos);
+void CORD__prev(CORD_pos);
+
+#define CORD_pos_fetch(p)	\
+    (((p)[0].cur_end != 0)? \
+     	(p)[0].cur_leaf[(p)[0].cur_pos - (p)[0].cur_start] \
+     	: CORD__pos_fetch(p))
+
+#define CORD_next(p)	\
+    (((p)[0].cur_pos + 1 < (p)[0].cur_end)? \
+    	(p)[0].cur_pos++ \
+    	: (CORD__next(p), 0))
+
+#define CORD_prev(p)	\
+    (((p)[0].cur_end != 0 && (p)[0].cur_pos > (p)[0].cur_start)? \
+    	(p)[0].cur_pos-- \
+    	: (CORD__prev(p), 0))
+
+#define CORD_pos_to_index(p) ((p)[0].cur_pos)
+
+#define CORD_pos_to_cord(p) ((p)[0].path[0].pe_cord)
+
+#define CORD_pos_valid(p) ((p)[0].path_len != CORD_POS_INVALID)
+
+/* Some grubby stuff for performance-critical friends:	*/
+#define CORD_pos_chars_left(p) ((long)((p)[0].cur_end) - (long)((p)[0].cur_pos))
+	/* Number of characters in cache.  <= 0 ==> none	*/
+
+#define CORD_pos_advance(p,n) ((p)[0].cur_pos += (n) - 1, CORD_next(p))
+	/* Advance position by n characters	*/
+	/* 0 < n < CORD_pos_chars_left(p)	*/
+
+#define CORD_pos_cur_char_addr(p) \
+	(p)[0].cur_leaf + ((p)[0].cur_pos - (p)[0].cur_start)
+	/* address of current character in cache.	*/
+
+#endif
diff --git a/src/gc/dbg_mlc.c b/src/gc/dbg_mlc.c
new file mode 100644
index 000000000..207687154
--- /dev/null
+++ b/src/gc/dbg_mlc.c
@@ -0,0 +1,780 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1997 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+#include "dbg_mlc.h"
+
+void GC_default_print_heap_obj_proc();
+GC_API void GC_register_finalizer_no_order
+    	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+
+
+/* Check whether object with base pointer p has debugging info	*/ 
+/* p is assumed to point to a legitimate object in our part	*/
+/* of the heap.							*/
+GC_bool GC_has_debug_info(p)
+ptr_t p;
+{
+    register oh * ohdr = (oh *)p;
+    register ptr_t body = (ptr_t)(ohdr + 1);
+    register word sz = GC_size((ptr_t) ohdr);
+    
+    if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body)
+        || sz < sizeof (oh)) {
+        return(FALSE);
+    }
+    if (ohdr -> oh_sz == sz) {
+    	/* Object may have had debug info, but has been deallocated	*/
+    	return(FALSE);
+    }
+    if (ohdr -> oh_sf == (START_FLAG ^ (word)body)) return(TRUE);
+    if (((word *)ohdr)[BYTES_TO_WORDS(sz)-1] == (END_FLAG ^ (word)body)) {
+        return(TRUE);
+    }
+    return(FALSE);
+}
+
+#ifdef KEEP_BACK_PTRS
+  /* Store back pointer to source in dest, if that appears to be possible. */
+  /* This is not completely safe, since we may mistakenly conclude that	   */
+  /* dest has a debugging wrapper.  But the error probability is very	   */
+  /* small, and this shouldn't be used in production code.		   */
+  /* We assume that dest is the real base pointer.  Source will usually    */
+  /* be a pointer to the interior of an object.				   */
+  void GC_store_back_pointer(ptr_t source, ptr_t dest)
+  {
+    if (GC_has_debug_info(dest)) {
+      ((oh *)dest) -> oh_back_ptr = (ptr_t)HIDE_POINTER(source);
+    }
+  }
+
+  void GC_marked_for_finalization(ptr_t dest) {
+    GC_store_back_pointer(MARKED_FOR_FINALIZATION, dest);
+  }
+
+  /* Store information about the object referencing dest in *base_p	*/
+  /* and *offset_p.							*/
+  /*   source is root ==> *base_p = address, *offset_p = 0		*/
+  /*   source is heap object ==> *base_p != 0, *offset_p = offset 	*/
+  /*   Returns 1 on success, 0 if source couldn't be determined.	*/
+  /* Dest can be any address within a heap object.			*/
+  GC_ref_kind GC_get_back_ptr_info(void *dest, void **base_p, size_t *offset_p)
+  {
+    oh * hdr = (oh *)GC_base(dest);
+    ptr_t bp;
+    ptr_t bp_base;
+    if (!GC_has_debug_info((ptr_t) hdr)) return GC_NO_SPACE;
+    bp = hdr -> oh_back_ptr;
+    if (MARKED_FOR_FINALIZATION == bp) return GC_FINALIZER_REFD;
+    if (MARKED_FROM_REGISTER == bp) return GC_REFD_FROM_REG;
+    if (0 == bp) return GC_UNREFERENCED;
+    bp = REVEAL_POINTER(bp);
+    bp_base = GC_base(bp);
+    if (0 == bp_base) {
+      *base_p = bp;
+      *offset_p = 0;
+      return GC_REFD_FROM_ROOT;
+    } else {
+      if (GC_has_debug_info(bp_base)) bp_base += sizeof(oh);
+      *base_p = bp_base;
+      *offset_p = bp - bp_base;
+      return GC_REFD_FROM_HEAP;
+    }
+  }
+
+  /* Generate a random heap address.		*/
+  /* The resulting address is in the heap, but	*/
+  /* not necessarily inside a valid object.	*/
+  void *GC_generate_random_heap_address(void)
+  {
+    int i;
+    int heap_offset = random() % GC_heapsize;
+    for (i = 0; i < GC_n_heap_sects; ++ i) {
+	int size = GC_heap_sects[i].hs_bytes;
+	if (heap_offset < size) {
+	    return GC_heap_sects[i].hs_start + heap_offset;
+	} else {
+	    heap_offset -= size;
+	}
+    }
+    ABORT("GC_generate_random_heap_address: size inconsistency");
+    /*NOTREACHED*/
+    return 0;
+  }
+
+  /* Generate a random address inside a valid marked heap object. */
+  void *GC_generate_random_valid_address(void)
+  {
+    ptr_t result;
+    ptr_t base;
+    for (;;) {
+	result = GC_generate_random_heap_address();
+  	base = GC_base(result);
+	if (0 == base) continue;
+	if (!GC_is_marked(base)) continue;
+	return result;
+    }
+  }
+
+  /* Print back trace for p */
+  void GC_print_backtrace(void *p)
+  {
+    void *current = p;
+    int i;
+    GC_ref_kind source;
+    size_t offset;
+    void *base;
+
+    GC_print_heap_obj(GC_base(current));
+    GC_err_printf0("\n");
+    for (i = 0; ; ++i) {
+      source = GC_get_back_ptr_info(current, &base, &offset);
+      if (GC_UNREFERENCED == source) {
+	GC_err_printf0("Reference could not be found\n");
+  	goto out;
+      }
+      if (GC_NO_SPACE == source) {
+	GC_err_printf0("No debug info in object: Can't find reference\n");
+	goto out;
+      }
+      GC_err_printf1("Reachable via %d levels of pointers from ",
+		 (unsigned long)i);
+      switch(source) {
+	case GC_REFD_FROM_ROOT:
+	  GC_err_printf1("root at 0x%lx\n", (unsigned long)base);
+	  goto out;
+	case GC_REFD_FROM_REG:
+	  GC_err_printf0("root in register\n");
+	  goto out;
+	case GC_FINALIZER_REFD:
+	  GC_err_printf0("list of finalizable objects\n");
+	  goto out;
+	case GC_REFD_FROM_HEAP:
+	  GC_err_printf1("offset %ld in object:\n", (unsigned long)offset);
+	  /* Take GC_base(base) to get real base, i.e. header. */
+	  GC_print_heap_obj(GC_base(base));
+	  GC_err_printf0("\n");
+	  break;
+      }
+      current = base;
+    }
+    out:;
+  }
+
+  /* Force a garbage collection and generate a backtrace from a	*/
+  /* random heap address.					*/
+  void GC_generate_random_backtrace(void)
+  {
+    void * current;
+    GC_gcollect();
+    current = GC_generate_random_valid_address();
+    GC_printf1("Chose address 0x%lx in object\n", (unsigned long)current);
+    GC_print_backtrace(current);
+  }
+    
+#endif /* KEEP_BACK_PTRS */
+
+/* Store debugging info into p.  Return displaced pointer. */
+/* Assumes we don't hold allocation lock.		   */
+ptr_t GC_store_debug_info(p, sz, string, integer)
+register ptr_t p;	/* base pointer */
+word sz; 	/* bytes */
+char * string;
+word integer;
+{
+    register word * result = (word *)((oh *)p + 1);
+    DCL_LOCK_STATE;
+    
+    /* There is some argument that we should dissble signals here.	*/
+    /* But that's expensive.  And this way things should only appear	*/
+    /* inconsistent while we're in the handler.				*/
+    LOCK();
+#   ifdef KEEP_BACK_PTRS
+      ((oh *)p) -> oh_back_ptr = 0;
+#   endif
+    ((oh *)p) -> oh_string = string;
+    ((oh *)p) -> oh_int = integer;
+    ((oh *)p) -> oh_sz = sz;
+    ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
+    ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
+         result[ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
+    UNLOCK();
+    return((ptr_t)result);
+}
+
+/* Check the object with debugging info at ohdr		*/
+/* return NIL if it's OK.  Else return clobbered	*/
+/* address.						*/
+ptr_t GC_check_annotated_obj(ohdr)
+register oh * ohdr;
+{
+    register ptr_t body = (ptr_t)(ohdr + 1);
+    register word gc_sz = GC_size((ptr_t)ohdr);
+    if (ohdr -> oh_sz + DEBUG_BYTES > gc_sz) {
+        return((ptr_t)(&(ohdr -> oh_sz)));
+    }
+    if (ohdr -> oh_sf != (START_FLAG ^ (word)body)) {
+        return((ptr_t)(&(ohdr -> oh_sf)));
+    }
+    if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) {
+        return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1));
+    }
+    if (((word *)body)[ROUNDED_UP_WORDS(ohdr -> oh_sz)]
+        != (END_FLAG ^ (word)body)) {
+        return((ptr_t)((word *)body + ROUNDED_UP_WORDS(ohdr -> oh_sz)));
+    }
+    return(0);
+}
+
+void GC_print_obj(p)
+ptr_t p;
+{
+    register oh * ohdr = (oh *)GC_base(p);
+    
+    GC_err_printf1("0x%lx (", ((unsigned long)ohdr + sizeof(oh)));
+    GC_err_puts(ohdr -> oh_string);
+    GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
+        			      (unsigned long)(ohdr -> oh_sz));
+    PRINT_CALL_CHAIN(ohdr);
+}
+
+void GC_debug_print_heap_obj_proc(p)
+ptr_t p;
+{
+    if (GC_has_debug_info(p)) {
+	GC_print_obj(p);
+    } else {
+	GC_default_print_heap_obj_proc(p);
+    }
+}
+
+void GC_print_smashed_obj(p, clobbered_addr)
+ptr_t p, clobbered_addr;
+{
+    register oh * ohdr = (oh *)GC_base(p);
+    
+    GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr,
+    					        (unsigned long)p);
+    if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))
+        || ohdr -> oh_string == 0) {
+        GC_err_printf1("<smashed>, appr. sz = %ld)\n",
+        	       (GC_size((ptr_t)ohdr) - DEBUG_BYTES));
+    } else {
+        if (ohdr -> oh_string[0] == '\0') {
+            GC_err_puts("EMPTY(smashed?)");
+        } else {
+            GC_err_puts(ohdr -> oh_string);
+        }
+        GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
+        			          (unsigned long)(ohdr -> oh_sz));
+        PRINT_CALL_CHAIN(ohdr);
+    }
+}
+
+void GC_check_heap_proc();
+
+void GC_start_debugging()
+{
+    GC_check_heap = GC_check_heap_proc;
+    GC_print_heap_obj = GC_debug_print_heap_obj_proc;
+    GC_debugging_started = TRUE;
+    GC_register_displacement((word)sizeof(oh));
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+    void GC_debug_register_displacement(GC_word offset)
+# else
+    void GC_debug_register_displacement(offset) 
+    GC_word offset;
+# endif
+{
+    GC_register_displacement(offset);
+    GC_register_displacement((word)sizeof(oh) + offset);
+}
+
+# ifdef __STDC__
+    GC_PTR GC_debug_malloc(size_t lb, GC_EXTRA_PARAMS)
+# else
+    GC_PTR GC_debug_malloc(lb, s, i)
+    size_t lb;
+    char * s;
+    int i;
+#   ifdef GC_ADD_CALLER
+	--> GC_ADD_CALLER not implemented for K&R C
+#   endif
+# endif
+{
+    GC_PTR result = GC_malloc(lb + DEBUG_BYTES);
+    
+    if (result == 0) {
+        GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
+        	       (unsigned long) lb);
+        GC_err_puts(s);
+        GC_err_printf1(":%ld)\n", (unsigned long)i);
+        return(0);
+    }
+    if (!GC_debugging_started) {
+    	GC_start_debugging();
+    }
+    ADD_CALL_CHAIN(result, ra);
+    return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+#ifdef STUBBORN_ALLOC
+# ifdef __STDC__
+    GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
+# else
+    GC_PTR GC_debug_malloc_stubborn(lb, s, i)
+    size_t lb;
+    char * s;
+    int i;
+# endif
+{
+    GC_PTR result = GC_malloc_stubborn(lb + DEBUG_BYTES);
+    
+    if (result == 0) {
+        GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
+        	       (unsigned long) lb);
+        GC_err_puts(s);
+        GC_err_printf1(":%ld)\n", (unsigned long)i);
+        return(0);
+    }
+    if (!GC_debugging_started) {
+    	GC_start_debugging();
+    }
+    ADD_CALL_CHAIN(result, ra);
+    return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+void GC_debug_change_stubborn(p)
+GC_PTR p;
+{
+    register GC_PTR q = GC_base(p);
+    register hdr * hhdr;
+    
+    if (q == 0) {
+        GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
+        	       (unsigned long) p);
+        ABORT("GC_debug_change_stubborn: bad arg");
+    }
+    hhdr = HDR(q);
+    if (hhdr -> hb_obj_kind != STUBBORN) {
+        GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
+        	       (unsigned long) p);
+        ABORT("GC_debug_change_stubborn: arg not stubborn");
+    }
+    GC_change_stubborn(q);
+}
+
+void GC_debug_end_stubborn_change(p)
+GC_PTR p;
+{
+    register GC_PTR q = GC_base(p);
+    register hdr * hhdr;
+    
+    if (q == 0) {
+        GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
+        	       (unsigned long) p);
+        ABORT("GC_debug_end_stubborn_change: bad arg");
+    }
+    hhdr = HDR(q);
+    if (hhdr -> hb_obj_kind != STUBBORN) {
+        GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
+        	       (unsigned long) p);
+        ABORT("GC_debug_end_stubborn_change: arg not stubborn");
+    }
+    GC_end_stubborn_change(q);
+}
+
+#else /* !STUBBORN_ALLOC */
+
+# ifdef __STDC__
+    GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
+# else
+    GC_PTR GC_debug_malloc_stubborn(lb, s, i)
+    size_t lb;
+    char * s;
+    int i;
+# endif
+{
+    return GC_debug_malloc(lb, OPT_RA s, i);
+}
+
+void GC_debug_change_stubborn(p)
+GC_PTR p;
+{
+}
+
+void GC_debug_end_stubborn_change(p)
+GC_PTR p;
+{
+}
+
+#endif /* !STUBBORN_ALLOC */
+
+# ifdef __STDC__
+    GC_PTR GC_debug_malloc_atomic(size_t lb, GC_EXTRA_PARAMS)
+# else
+    GC_PTR GC_debug_malloc_atomic(lb, s, i)
+    size_t lb;
+    char * s;
+    int i;
+# endif
+{
+    GC_PTR result = GC_malloc_atomic(lb + DEBUG_BYTES);
+    
+    if (result == 0) {
+        GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
+        	      (unsigned long) lb);
+        GC_err_puts(s);
+        GC_err_printf1(":%ld)\n", (unsigned long)i);
+        return(0);
+    }
+    if (!GC_debugging_started) {
+        GC_start_debugging();
+    }
+    ADD_CALL_CHAIN(result, ra);
+    return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+# ifdef __STDC__
+    GC_PTR GC_debug_malloc_uncollectable(size_t lb, GC_EXTRA_PARAMS)
+# else
+    GC_PTR GC_debug_malloc_uncollectable(lb, s, i)
+    size_t lb;
+    char * s;
+    int i;
+# endif
+{
+    GC_PTR result = GC_malloc_uncollectable(lb + DEBUG_BYTES);
+    
+    if (result == 0) {
+        GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
+        	      (unsigned long) lb);
+        GC_err_puts(s);
+        GC_err_printf1(":%ld)\n", (unsigned long)i);
+        return(0);
+    }
+    if (!GC_debugging_started) {
+        GC_start_debugging();
+    }
+    ADD_CALL_CHAIN(result, ra);
+    return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+#ifdef ATOMIC_UNCOLLECTABLE
+# ifdef __STDC__
+    GC_PTR GC_debug_malloc_atomic_uncollectable(size_t lb, GC_EXTRA_PARAMS)
+# else
+    GC_PTR GC_debug_malloc_atomic_uncollectable(lb, s, i)
+    size_t lb;
+    char * s;
+    int i;
+# endif
+{
+    GC_PTR result = GC_malloc_atomic_uncollectable(lb + DEBUG_BYTES);
+    
+    if (result == 0) {
+        GC_err_printf1(
+		"GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
+                (unsigned long) lb);
+        GC_err_puts(s);
+        GC_err_printf1(":%ld)\n", (unsigned long)i);
+        return(0);
+    }
+    if (!GC_debugging_started) {
+        GC_start_debugging();
+    }
+    ADD_CALL_CHAIN(result, ra);
+    return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+#endif /* ATOMIC_UNCOLLECTABLE */
+
+# ifdef __STDC__
+    void GC_debug_free(GC_PTR p)
+# else
+    void GC_debug_free(p)
+    GC_PTR p;
+# endif
+{
+    register GC_PTR base;
+    register ptr_t clobbered;
+    
+    if (0 == p) return;
+    base = GC_base(p);
+    if (base == 0) {
+        GC_err_printf1("Attempt to free invalid pointer %lx\n",
+        	       (unsigned long)p);
+        ABORT("free(invalid pointer)");
+    }
+    if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
+        GC_err_printf1(
+        	  "GC_debug_free called on pointer %lx wo debugging info\n",
+        	  (unsigned long)p);
+    } else {
+      clobbered = GC_check_annotated_obj((oh *)base);
+      if (clobbered != 0) {
+        if (((oh *)base) -> oh_sz == GC_size(base)) {
+            GC_err_printf0(
+                  "GC_debug_free: found previously deallocated (?) object at ");
+        } else {
+            GC_err_printf0("GC_debug_free: found smashed location at ");
+        }
+        GC_print_smashed_obj(p, clobbered);
+      }
+      /* Invalidate size */
+      ((oh *)base) -> oh_sz = GC_size(base);
+    }
+    if (GC_find_leak) {
+        GC_free(base);
+    } else {
+	register hdr * hhdr = HDR(p);
+	GC_bool uncollectable = FALSE;
+
+        if (hhdr ->  hb_obj_kind == UNCOLLECTABLE) {
+	    uncollectable = TRUE;
+	}
+#	ifdef ATOMIC_UNCOLLECTABLE
+	    if (hhdr ->  hb_obj_kind == AUNCOLLECTABLE) {
+		    uncollectable = TRUE;
+	    }
+#	endif
+	if (uncollectable) GC_free(base);
+    } /* !GC_find_leak */
+}
+
+# ifdef __STDC__
+    GC_PTR GC_debug_realloc(GC_PTR p, size_t lb, GC_EXTRA_PARAMS)
+# else
+    GC_PTR GC_debug_realloc(p, lb, s, i)
+    GC_PTR p;
+    size_t lb;
+    char *s;
+    int i;
+# endif
+{
+    register GC_PTR base = GC_base(p);
+    register ptr_t clobbered;
+    register GC_PTR result;
+    register size_t copy_sz = lb;
+    register size_t old_sz;
+    register hdr * hhdr;
+    
+    if (p == 0) return(GC_debug_malloc(lb, OPT_RA s, i));
+    if (base == 0) {
+        GC_err_printf1(
+              "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p);
+        ABORT("realloc(invalid pointer)");
+    }
+    if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
+        GC_err_printf1(
+        	"GC_debug_realloc called on pointer %lx wo debugging info\n",
+        	(unsigned long)p);
+        return(GC_realloc(p, lb));
+    }
+    hhdr = HDR(base);
+    switch (hhdr -> hb_obj_kind) {
+#    ifdef STUBBORN_ALLOC
+      case STUBBORN:
+        result = GC_debug_malloc_stubborn(lb, OPT_RA s, i);
+        break;
+#    endif
+      case NORMAL:
+        result = GC_debug_malloc(lb, OPT_RA s, i);
+        break;
+      case PTRFREE:
+        result = GC_debug_malloc_atomic(lb, OPT_RA s, i);
+        break;
+      case UNCOLLECTABLE:
+	result = GC_debug_malloc_uncollectable(lb, OPT_RA s, i);
+ 	break;
+#    ifdef ATOMIC_UNCOLLECTABLE
+      case AUNCOLLECTABLE:
+	result = GC_debug_malloc_atomic_uncollectable(lb, OPT_RA s, i);
+	break;
+#    endif
+      default:
+        GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
+        ABORT("bad kind");
+    }
+    clobbered = GC_check_annotated_obj((oh *)base);
+    if (clobbered != 0) {
+        GC_err_printf0("GC_debug_realloc: found smashed location at ");
+        GC_print_smashed_obj(p, clobbered);
+    }
+    old_sz = ((oh *)base) -> oh_sz;
+    if (old_sz < copy_sz) copy_sz = old_sz;
+    if (result == 0) return(0);
+    BCOPY(p, result,  copy_sz);
+    GC_debug_free(p);
+    return(result);
+}
+
+/* Check all marked objects in the given block for validity */
+/*ARGSUSED*/
+void GC_check_heap_block(hbp, dummy)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+word dummy;
+{
+    register struct hblkhdr * hhdr = HDR(hbp);
+    register word sz = hhdr -> hb_sz;
+    register int word_no;
+    register word *p, *plim;
+    
+    p = (word *)(hbp->hb_body);
+    word_no = HDR_WORDS;
+    if (sz > MAXOBJSZ) {
+	plim = p;
+    } else {
+    	plim = (word *)((((word)hbp) + HBLKSIZE) - WORDS_TO_BYTES(sz));
+    }
+    /* go through all words in block */
+	while( p <= plim ) {
+	    if( mark_bit_from_hdr(hhdr, word_no)
+	        && GC_has_debug_info((ptr_t)p)) {
+	        ptr_t clobbered = GC_check_annotated_obj((oh *)p);
+	        
+	        if (clobbered != 0) {
+	            GC_err_printf0(
+	                "GC_check_heap_block: found smashed location at ");
+        	    GC_print_smashed_obj((ptr_t)p, clobbered);
+	        }
+	    }
+	    word_no += sz;
+	    p += sz;
+	}
+}
+
+
+/* This assumes that all accessible objects are marked, and that	*/
+/* I hold the allocation lock.	Normally called by collector.		*/
+void GC_check_heap_proc()
+{
+#   ifndef SMALL_CONFIG
+	if (sizeof(oh) & (2 * sizeof(word) - 1) != 0) {
+	    ABORT("Alignment problem: object header has inappropriate size\n");
+	}
+#   endif
+    GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
+}
+
+struct closure {
+    GC_finalization_proc cl_fn;
+    GC_PTR cl_data;
+};
+
+# ifdef __STDC__
+    void * GC_make_closure(GC_finalization_proc fn, void * data)
+# else
+    GC_PTR GC_make_closure(fn, data)
+    GC_finalization_proc fn;
+    GC_PTR data;
+# endif
+{
+    struct closure * result =
+    		(struct closure *) GC_malloc(sizeof (struct closure));
+    
+    result -> cl_fn = fn;
+    result -> cl_data = data;
+    return((GC_PTR)result);
+}
+
+# ifdef __STDC__
+    void GC_debug_invoke_finalizer(void * obj, void * data)
+# else
+    void GC_debug_invoke_finalizer(obj, data)
+    char * obj;
+    char * data;
+# endif
+{
+    register struct closure * cl = (struct closure *) data;
+    
+    (*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data);
+} 
+
+
+# ifdef __STDC__
+    void GC_debug_register_finalizer(GC_PTR obj, GC_finalization_proc fn,
+    				     GC_PTR cd, GC_finalization_proc *ofn,
+				     GC_PTR *ocd)
+# else
+    void GC_debug_register_finalizer(obj, fn, cd, ofn, ocd)
+    GC_PTR obj;
+    GC_finalization_proc fn;
+    GC_PTR cd;
+    GC_finalization_proc *ofn;
+    GC_PTR *ocd;
+# endif
+{
+    ptr_t base = GC_base(obj);
+    if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
+        GC_err_printf1(
+	    "GC_register_finalizer called with non-base-pointer 0x%lx\n",
+	    obj);
+    }
+    GC_register_finalizer(base, GC_debug_invoke_finalizer,
+    			  GC_make_closure(fn,cd), ofn, ocd);
+}
+
+# ifdef __STDC__
+    void GC_debug_register_finalizer_no_order
+    				    (GC_PTR obj, GC_finalization_proc fn,
+    				     GC_PTR cd, GC_finalization_proc *ofn,
+				     GC_PTR *ocd)
+# else
+    void GC_debug_register_finalizer_no_order
+    				    (obj, fn, cd, ofn, ocd)
+    GC_PTR obj;
+    GC_finalization_proc fn;
+    GC_PTR cd;
+    GC_finalization_proc *ofn;
+    GC_PTR *ocd;
+# endif
+{
+    ptr_t base = GC_base(obj);
+    if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
+        GC_err_printf1(
+	  "GC_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
+	  obj);
+    }
+    GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer,
+     			  	      GC_make_closure(fn,cd), ofn, ocd);
+ }
+
+# ifdef __STDC__
+    void GC_debug_register_finalizer_ignore_self
+    				    (GC_PTR obj, GC_finalization_proc fn,
+    				     GC_PTR cd, GC_finalization_proc *ofn,
+				     GC_PTR *ocd)
+# else
+    void GC_debug_register_finalizer_ignore_self
+    				    (obj, fn, cd, ofn, ocd)
+    GC_PTR obj;
+    GC_finalization_proc fn;
+    GC_PTR cd;
+    GC_finalization_proc *ofn;
+    GC_PTR *ocd;
+# endif
+{
+    ptr_t base = GC_base(obj);
+    if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
+        GC_err_printf1(
+	    "GC_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
+	    obj);
+    }
+    GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer,
+    			  	      GC_make_closure(fn,cd), ofn, ocd);
+}
diff --git a/src/gc/dbg_mlc.h b/src/gc/dbg_mlc.h
new file mode 100644
index 000000000..6abeda8a6
--- /dev/null
+++ b/src/gc/dbg_mlc.h
@@ -0,0 +1,102 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1997 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * This is mostly an internal header file.  Typical clients should
+ * not use it.  Clients that define their own object kinds with
+ * debugging allocators will probably want to include this, however.
+ * No attempt is made to keep the namespace clean.  This should not be
+ * included from header filrd that are frequently included by clients.
+ */
+
+#ifndef _DBG_MLC_H
+
+#define _DBG_MLC_H
+
+# define I_HIDE_POINTERS
+# include "gc_priv.h"
+# ifdef KEEP_BACK_PTRS
+#   include "backptr.h"
+# endif
+
+# define START_FLAG ((word)0xfedcedcb)
+# define END_FLAG ((word)0xbcdecdef)
+	/* Stored both one past the end of user object, and one before	*/
+	/* the end of the object as seen by the allocator.		*/
+
+
+/* Object header */
+typedef struct {
+#   ifdef KEEP_BACK_PTRS
+	ptr_t oh_back_ptr;
+#	define MARKED_FOR_FINALIZATION (ptr_t)(-1)
+	    /* Object was marked because it is finalizable.	*/
+#	define MARKED_FROM_REGISTER (ptr_t)(-2)
+	    /* Object was marked from a rgister.  Hence the	*/
+	    /* source of the reference doesn't have an address.	*/
+#	ifdef ALIGN_DOUBLE
+	  word oh_dummy;
+#	endif
+#   endif
+    char * oh_string;		/* object descriptor string	*/
+    word oh_int;		/* object descriptor integers	*/
+#   ifdef NEED_CALLINFO
+      struct callinfo oh_ci[NFRAMES];
+#   endif
+    word oh_sz;			/* Original malloc arg.		*/
+    word oh_sf;			/* start flag */
+} oh;
+/* The size of the above structure is assumed not to dealign things,	*/
+/* and to be a multiple of the word length.				*/
+
+#define DEBUG_BYTES (sizeof (oh) + sizeof (word))
+#define USR_PTR_FROM_BASE(p) ((ptr_t)(p) + sizeof(oh))
+
+/* There is no reason to ever add a byte at the end explicitly, since we */
+/* already add a guard word.						 */
+#undef ROUNDED_UP_WORDS
+#define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1) - 1)
+
+#ifdef SAVE_CALL_CHAIN
+#   define ADD_CALL_CHAIN(base, ra) GC_save_callers(((oh *)(base)) -> oh_ci)
+#   define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
+#else
+# ifdef GC_ADD_CALLER
+#   define ADD_CALL_CHAIN(base, ra) ((oh *)(base)) -> oh_ci[0].ci_pc = (ra)
+#   define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
+# else
+#   define ADD_CALL_CHAIN(base, ra)
+#   define PRINT_CALL_CHAIN(base)
+# endif
+#endif
+
+# ifdef GC_ADD_CALLER
+#   define OPT_RA ra,
+# else
+#   define OPT_RA
+# endif
+
+
+/* Check whether object with base pointer p has debugging info	*/ 
+/* p is assumed to point to a legitimate object in our part	*/
+/* of the heap.							*/
+GC_bool GC_has_debug_info(/* p */);
+
+/* Store debugging info into p.  Return displaced pointer. */
+/* Assumes we don't hold allocation lock.		   */
+ptr_t GC_store_debug_info(/* p, sz, string, integer */);
+
+#endif /* _DBG_MLC_H */
diff --git a/src/gc/dyn_load.c b/src/gc/dyn_load.c
new file mode 100644
index 000000000..74aacd710
--- /dev/null
+++ b/src/gc/dyn_load.c
@@ -0,0 +1,844 @@
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1997 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * Original author: Bill Janssen
+ * Heavily modified by Hans Boehm and others
+ */
+
+/*
+ * This is incredibly OS specific code for tracking down data sections in
+ * dynamic libraries.  There appears to be no way of doing this quickly
+ * without groveling through undocumented data structures.  We would argue
+ * that this is a bug in the design of the dlopen interface.  THIS CODE
+ * MAY BREAK IN FUTURE OS RELEASES.  If this matters to you, don't hesitate
+ * to let your vendor know ...
+ *
+ * None of this is safe with dlclose and incremental collection.
+ * But then not much of anything is safe in the presence of dlclose.
+ */
+#ifndef MACOS
+#  include <sys/types.h>
+#endif
+#include "gc_priv.h"
+
+/* BTL: avoid circular redefinition of dlopen if SOLARIS_THREADS defined */
+# if (defined(LINUX_THREADS) || defined(SOLARIS_THREADS) \
+      || defined(HPUX_THREADS) || defined(IRIX_THREADS)) && defined(dlopen) \
+     && !defined(USE_LD_WRAP)
+    /* To support threads in Solaris, gc.h interposes on dlopen by       */
+    /* defining "dlopen" to be "GC_dlopen", which is implemented below.  */
+    /* However, both GC_FirstDLOpenedLinkMap() and GC_dlopen() use the   */
+    /* real system dlopen() in their implementation. We first remove     */
+    /* gc.h's dlopen definition and restore it later, after GC_dlopen(). */
+#   undef dlopen
+#   define GC_must_restore_redefined_dlopen
+# else
+#   undef GC_must_restore_redefined_dlopen
+# endif
+
+#if (defined(DYNAMIC_LOADING) || defined(MSWIN32)) && !defined(PCR)
+#if !defined(SUNOS4) && !defined(SUNOS5DL) && !defined(IRIX5) && \
+    !defined(MSWIN32) && !(defined(ALPHA) && defined(OSF1)) && \
+    !defined(HPUX) && !(defined(LINUX) && defined(__ELF__)) && \
+    !defined(RS6000) && !defined(SCO_ELF)
+ --> We only know how to find data segments of dynamic libraries for the
+ --> above.  Additional SVR4 variants might not be too
+ --> hard to add.
+#endif
+
+#include <stdio.h>
+#ifdef SUNOS5DL
+#   include <sys/elf.h>
+#   include <dlfcn.h>
+#   include <link.h>
+#endif
+#ifdef SUNOS4
+#   include <dlfcn.h>
+#   include <link.h>
+#   include <a.out.h>
+  /* struct link_map field overrides */
+#   define l_next	lm_next
+#   define l_addr	lm_addr
+#   define l_name	lm_name
+#endif
+
+
+#if defined(SUNOS5DL) && !defined(USE_PROC_FOR_LIBRARIES)
+
+#ifdef LINT
+    Elf32_Dyn _DYNAMIC;
+#endif
+
+static struct link_map *
+GC_FirstDLOpenedLinkMap()
+{
+    extern Elf32_Dyn _DYNAMIC;
+    Elf32_Dyn *dp;
+    struct r_debug *r;
+    static struct link_map * cachedResult = 0;
+    static Elf32_Dyn *dynStructureAddr = 0;
+    			/* BTL: added to avoid Solaris 5.3 ld.so _DYNAMIC bug */
+
+#   ifdef SUNOS53_SHARED_LIB
+	/* BTL: Avoid the Solaris 5.3 bug that _DYNAMIC isn't being set	*/
+	/* up properly in dynamically linked .so's. This means we have	*/
+	/* to use its value in the set of original object files loaded	*/
+	/* at program startup.						*/
+	if( dynStructureAddr == 0 ) {
+	  void* startupSyms = dlopen(0, RTLD_LAZY);
+	  dynStructureAddr = (Elf32_Dyn*)dlsym(startupSyms, "_DYNAMIC");
+		}
+#   else
+	dynStructureAddr = &_DYNAMIC;
+#   endif
+
+    if( dynStructureAddr == 0) {
+        return(0);
+    }
+    if( cachedResult == 0 ) {
+        int tag;
+        for( dp = ((Elf32_Dyn *)(&_DYNAMIC)); (tag = dp->d_tag) != 0; dp++ ) {
+            if( tag == DT_DEBUG ) {
+                struct link_map *lm
+                        = ((struct r_debug *)(dp->d_un.d_ptr))->r_map;
+                if( lm != 0 ) cachedResult = lm->l_next; /* might be NIL */
+                break;
+            }
+        }
+    }
+    return cachedResult;
+}
+
+#endif /* SUNOS5DL ... */
+
+#if defined(SUNOS4) && !defined(USE_PROC_FOR_LIBRARIES)
+
+#ifdef LINT
+    struct link_dynamic _DYNAMIC;
+#endif
+
+static struct link_map *
+GC_FirstDLOpenedLinkMap()
+{
+    extern struct link_dynamic _DYNAMIC;
+
+    if( &_DYNAMIC == 0) {
+        return(0);
+    }
+    return(_DYNAMIC.ld_un.ld_1->ld_loaded);
+}
+
+/* Return the address of the ld.so allocated common symbol	*/
+/* with the least address, or 0 if none.			*/
+static ptr_t GC_first_common()
+{
+    ptr_t result = 0;
+    extern struct link_dynamic _DYNAMIC;
+    struct rtc_symb * curr_symbol;
+    
+    if( &_DYNAMIC == 0) {
+        return(0);
+    }
+    curr_symbol = _DYNAMIC.ldd -> ldd_cp;
+    for (; curr_symbol != 0; curr_symbol = curr_symbol -> rtc_next) {
+        if (result == 0
+            || (ptr_t)(curr_symbol -> rtc_sp -> n_value) < result) {
+            result = (ptr_t)(curr_symbol -> rtc_sp -> n_value);
+        }
+    }
+    return(result);
+}
+
+#endif  /* SUNOS4 ... */
+
+# if defined(LINUX_THREADS) || defined(SOLARIS_THREADS) \
+     || defined(HPUX_THREADS) || defined(IRIX_THREADS)
+  /* Make sure we're not in the middle of a collection, and make	*/
+  /* sure we don't start any.	Returns previous value of GC_dont_gc.	*/
+  /* This is invoked prior to a dlopen call to avoid synchronization	*/
+  /* issues.  We can't just acquire the allocation lock, since startup 	*/
+  /* code in dlopen may try to allocate.				*/
+  /* This solution risks heap growth in the presence of many dlopen	*/
+  /* calls in either a multithreaded environment, or if the library	*/
+  /* initialization code allocates substantial amounts of GC'ed memory.	*/
+  /* But I don't know of a better solution.				*/
+  /* This can still deadlock if the client explicitly starts a GC 	*/
+  /* during the dlopen.  He shouldn't do that.				*/
+  static GC_bool disable_gc_for_dlopen()
+  {
+    GC_bool result;
+    LOCK();
+    result = GC_dont_gc;
+    while (GC_incremental && GC_collection_in_progress()) {
+	GC_collect_a_little_inner(1000);
+    }
+    GC_dont_gc = TRUE;
+    UNLOCK();
+    return(result);
+  }
+
+  /* Redefine dlopen to guarantee mutual exclusion with	*/
+  /* GC_register_dynamic_libraries.			*/
+  /* Should probably happen for other operating	systems, too. */
+
+#include <dlfcn.h>
+
+#ifdef USE_LD_WRAP
+  void * __wrap_dlopen(const char *path, int mode)
+#else
+  void * GC_dlopen(path, mode)
+  GC_CONST char * path;
+  int mode;
+#endif
+{
+    void * result;
+    GC_bool dont_gc_save;
+    
+#   ifndef USE_PROC_FOR_LIBRARIES
+      dont_gc_save = disable_gc_for_dlopen();
+#   endif
+#   ifdef USE_LD_WRAP
+      result = __real_dlopen(path, mode);
+#   else
+      result = dlopen(path, mode);
+#   endif
+#   ifndef USE_PROC_FOR_LIBRARIES
+      GC_dont_gc = dont_gc_save;
+#   endif
+    return(result);
+}
+# endif  /* SOLARIS_THREADS */
+
+/* BTL: added to fix circular dlopen definition if SOLARIS_THREADS defined */
+# if defined(GC_must_restore_redefined_dlopen)
+#   define dlopen GC_dlopen
+# endif
+
+# if defined(SUNOS4) || defined(SUNOS5DL)
+/* Add dynamic library data sections to the root set.		*/
+# if !defined(PCR) && !defined(SOLARIS_THREADS) && defined(THREADS)
+#   ifndef SRC_M3
+	--> fix mutual exclusion with dlopen
+#   endif  /* We assume M3 programs don't call dlopen for now */
+# endif
+
+# ifndef USE_PROC_FOR_LIBRARIES
+void GC_register_dynamic_libraries()
+{
+  struct link_map *lm = GC_FirstDLOpenedLinkMap();
+  
+
+  for (lm = GC_FirstDLOpenedLinkMap();
+       lm != (struct link_map *) 0;  lm = lm->l_next)
+    {
+#     ifdef SUNOS4
+	struct exec *e;
+	 
+        e = (struct exec *) lm->lm_addr;
+        GC_add_roots_inner(
+      		    ((char *) (N_DATOFF(*e) + lm->lm_addr)),
+		    ((char *) (N_BSSADDR(*e) + e->a_bss + lm->lm_addr)),
+		    TRUE);
+#     endif
+#     ifdef SUNOS5DL
+	Elf32_Ehdr * e;
+        Elf32_Phdr * p;
+        unsigned long offset;
+        char * start;
+        register int i;
+        
+	e = (Elf32_Ehdr *) lm->l_addr;
+        p = ((Elf32_Phdr *)(((char *)(e)) + e->e_phoff));
+        offset = ((unsigned long)(lm->l_addr));
+        for( i = 0; i < (int)(e->e_phnum); ((i++),(p++)) ) {
+          switch( p->p_type ) {
+            case PT_LOAD:
+              {
+                if( !(p->p_flags & PF_W) ) break;
+                start = ((char *)(p->p_vaddr)) + offset;
+                GC_add_roots_inner(
+                  start,
+                  start + p->p_memsz,
+                  TRUE
+                );
+              }
+              break;
+            default:
+              break;
+          }
+	}
+#     endif
+    }
+#   ifdef SUNOS4
+      {
+      	static ptr_t common_start = 0;
+      	ptr_t common_end;
+      	extern ptr_t GC_find_limit();
+      	
+      	if (common_start == 0) common_start = GC_first_common();
+      	if (common_start != 0) {
+      	    common_end = GC_find_limit(common_start, TRUE);
+      	    GC_add_roots_inner((char *)common_start, (char *)common_end, TRUE);
+      	}
+      }
+#   endif
+}
+
+# endif /* !USE_PROC ... */
+# endif /* SUNOS */
+
+#if defined(LINUX) && defined(__ELF__) || defined(SCO_ELF)
+
+/* Dynamic loading code for Linux running ELF. Somewhat tested on
+ * Linux/x86, untested but hopefully should work on Linux/Alpha. 
+ * This code was derived from the Solaris/ELF support. Thanks to
+ * whatever kind soul wrote that.  - Patrick Bridges */
+
+#include <elf.h>
+#include <link.h>
+
+/* Newer versions of Linux/Alpha and Linux/x86 define this macro.  We
+ * define it for those older versions that don't.  */
+#  ifndef ElfW
+#    if !defined(ELF_CLASS) || ELF_CLASS == ELFCLASS32
+#      define ElfW(type) Elf32_##type
+#    else
+#      define ElfW(type) Elf64_##type
+#    endif
+#  endif
+
+static struct link_map *
+GC_FirstDLOpenedLinkMap()
+{
+#   ifdef __GNUC__
+#     pragma weak _DYNAMIC
+#   endif
+    extern ElfW(Dyn) _DYNAMIC[];
+    ElfW(Dyn) *dp;
+    struct r_debug *r;
+    static struct link_map *cachedResult = 0;
+
+    if( _DYNAMIC == 0) {
+        return(0);
+    }
+    if( cachedResult == 0 ) {
+        int tag;
+        for( dp = _DYNAMIC; (tag = dp->d_tag) != 0; dp++ ) {
+            if( tag == DT_DEBUG ) {
+                struct link_map *lm
+                        = ((struct r_debug *)(dp->d_un.d_ptr))->r_map;
+                if( lm != 0 ) cachedResult = lm->l_next; /* might be NIL */
+                break;
+            }
+        }
+    }
+    return cachedResult;
+}
+
+
+void GC_register_dynamic_libraries()
+{
+  struct link_map *lm = GC_FirstDLOpenedLinkMap();
+  
+
+  for (lm = GC_FirstDLOpenedLinkMap();
+       lm != (struct link_map *) 0;  lm = lm->l_next)
+    {
+	ElfW(Ehdr) * e;
+        ElfW(Phdr) * p;
+        unsigned long offset;
+        char * start;
+        register int i;
+        
+	e = (ElfW(Ehdr) *) lm->l_addr;
+        p = ((ElfW(Phdr) *)(((char *)(e)) + e->e_phoff));
+        offset = ((unsigned long)(lm->l_addr));
+        for( i = 0; i < (int)(e->e_phnum); ((i++),(p++)) ) {
+          switch( p->p_type ) {
+            case PT_LOAD:
+              {
+                if( !(p->p_flags & PF_W) ) break;
+                start = ((char *)(p->p_vaddr)) + offset;
+                GC_add_roots_inner(start, start + p->p_memsz, TRUE);
+              }
+              break;
+            default:
+              break;
+          }
+	}
+    }
+}
+
+#endif
+
+#if defined(IRIX5) || defined(USE_PROC_FOR_LIBRARIES)
+
+#include <sys/procfs.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <elf.h>
+#include <errno.h>
+
+extern void * GC_roots_present();
+	/* The type is a lie, since the real type doesn't make sense here, */
+	/* and we only test for NULL.					   */
+
+#ifndef GC_scratch_last_end_ptr   /* Never an extern any more? */
+extern ptr_t GC_scratch_last_end_ptr; /* End of GC_scratch_alloc arena	*/
+#endif
+
+/* We use /proc to track down all parts of the address space that are	*/
+/* mapped by the process, and throw out regions we know we shouldn't	*/
+/* worry about.  This may also work under other SVR4 variants.		*/
+void GC_register_dynamic_libraries()
+{
+    static int fd = -1;
+    char buf[30];
+    static prmap_t * addr_map = 0;
+    static int current_sz = 0;	/* Number of records currently in addr_map */
+    static int needed_sz;	/* Required size of addr_map		*/
+    register int i;
+    register long flags;
+    register ptr_t start;
+    register ptr_t limit;
+    ptr_t heap_start = (ptr_t)HEAP_START;
+    ptr_t heap_end = heap_start;
+
+#   ifdef SUNOS5DL
+#     define MA_PHYS 0
+#   endif /* SUNOS5DL */
+
+    if (fd < 0) {
+      sprintf(buf, "/proc/%d", getpid());
+	/* The above generates a lint complaint, since pid_t varies.	*/
+	/* It's unclear how to improve this.				*/
+      fd = open(buf, O_RDONLY);
+      if (fd < 0) {
+    	ABORT("/proc open failed");
+      }
+    }
+    if (ioctl(fd, PIOCNMAP, &needed_sz) < 0) {
+	GC_err_printf2("fd = %d, errno = %d\n", fd, errno);
+    	ABORT("/proc PIOCNMAP ioctl failed");
+    }
+    if (needed_sz >= current_sz) {
+        current_sz = needed_sz * 2 + 1;
+        		/* Expansion, plus room for 0 record */
+        addr_map = (prmap_t *)GC_scratch_alloc((word)
+						(current_sz * sizeof(prmap_t)));
+    }
+    if (ioctl(fd, PIOCMAP, addr_map) < 0) {
+        GC_err_printf4("fd = %d, errno = %d, needed_sz = %d, addr_map = 0x%X\n",
+                        fd, errno, needed_sz, addr_map);
+    	ABORT("/proc PIOCMAP ioctl failed");
+    };
+    if (GC_n_heap_sects > 0) {
+    	heap_end = GC_heap_sects[GC_n_heap_sects-1].hs_start
+    			+ GC_heap_sects[GC_n_heap_sects-1].hs_bytes;
+    	if (heap_end < GC_scratch_last_end_ptr) heap_end = GC_scratch_last_end_ptr; 
+    }
+    for (i = 0; i < needed_sz; i++) {
+        flags = addr_map[i].pr_mflags;
+        if ((flags & (MA_BREAK | MA_STACK | MA_PHYS)) != 0) goto irrelevant;
+        if ((flags & (MA_READ | MA_WRITE)) != (MA_READ | MA_WRITE))
+            goto irrelevant;
+          /* The latter test is empirically useless.  Other than the	*/
+          /* main data and stack segments, everything appears to be	*/
+          /* mapped readable, writable, executable, and shared(!!).	*/
+          /* This makes no sense to me.	- HB				*/
+        start = (ptr_t)(addr_map[i].pr_vaddr);
+        if (GC_roots_present(start)) goto irrelevant;
+        if (start < heap_end && start >= heap_start)
+        	goto irrelevant;
+#	ifdef MMAP_STACKS
+	  if (GC_is_thread_stack(start)) goto irrelevant;
+#	endif /* MMAP_STACKS */
+
+        limit = start + addr_map[i].pr_size;
+	if (addr_map[i].pr_off == 0 && strncmp(start, ELFMAG, 4) == 0) {
+	    /* Discard text segments, i.e. 0-offset mappings against	*/
+	    /* executable files which appear to have ELF headers.	*/
+	    caddr_t arg;
+	    int obj;
+#	    define MAP_IRR_SZ 10
+	    static ptr_t map_irr[MAP_IRR_SZ];
+	    				/* Known irrelevant map entries	*/
+	    static int n_irr = 0;
+	    struct stat buf;
+	    register int i;
+	    
+	    for (i = 0; i < n_irr; i++) {
+	        if (map_irr[i] == start) goto irrelevant;
+	    }
+	    arg = (caddr_t)start;
+	    obj = ioctl(fd, PIOCOPENM, &arg);
+	    if (obj >= 0) {
+	        fstat(obj, &buf);
+	        close(obj);
+	        if ((buf.st_mode & 0111) != 0) {
+	            if (n_irr < MAP_IRR_SZ) {
+	                map_irr[n_irr++] = start;
+	            }
+	            goto irrelevant;
+	        }
+	    }
+	}
+        GC_add_roots_inner(start, limit, TRUE);
+      irrelevant: ;
+    }
+    /* Dont keep cached descriptor, for now.  Some kernels don't like us */
+    /* to keep a /proc file descriptor around during kill -9.		 */
+    	if (close(fd) < 0) ABORT("Couldnt close /proc file");
+	fd = -1;
+}
+
+# endif /* USE_PROC || IRIX5 */
+
+# ifdef MSWIN32
+
+# define WIN32_LEAN_AND_MEAN
+# define NOSERVICE
+# include <windows.h>
+# include <stdlib.h>
+
+  /* We traverse the entire address space and register all segments 	*/
+  /* that could possibly have been written to.				*/
+  DWORD GC_allocation_granularity;
+  
+  extern GC_bool GC_is_heap_base (ptr_t p);
+
+# ifdef WIN32_THREADS
+    extern void GC_get_next_stack(char *start, char **lo, char **hi);
+# endif
+  
+  void GC_cond_add_roots(char *base, char * limit)
+  {
+    char dummy;
+    char * stack_top
+           = (char *) ((word)(&dummy) & ~(GC_allocation_granularity-1));
+    if (base == limit) return;
+#   ifdef WIN32_THREADS
+    {
+        char * curr_base = base;
+	char * next_stack_lo;
+	char * next_stack_hi;
+	
+	for(;;) {
+	    GC_get_next_stack(curr_base, &next_stack_lo, &next_stack_hi);
+	    if (next_stack_lo >= limit) break;
+	    GC_add_roots_inner(curr_base, next_stack_lo, TRUE);
+	    curr_base = next_stack_hi;
+	}
+	if (curr_base < limit) GC_add_roots_inner(curr_base, limit, TRUE);
+    }
+#   else
+        if (limit > stack_top && base < GC_stackbottom) {
+    	    /* Part of the stack; ignore it. */
+    	    return;
+        }
+        GC_add_roots_inner(base, limit, TRUE);
+#   endif
+  }
+  
+  extern GC_bool GC_win32s;
+  
+  void GC_register_dynamic_libraries()
+  {
+    MEMORY_BASIC_INFORMATION buf;
+    SYSTEM_INFO sysinfo;
+    DWORD result;
+    DWORD protect;
+    LPVOID p;
+    char * base;
+    char * limit, * new_limit;
+    
+    if (GC_win32s) return;
+    GetSystemInfo(&sysinfo);
+    base = limit = p = sysinfo.lpMinimumApplicationAddress;
+    GC_allocation_granularity = sysinfo.dwAllocationGranularity;
+    while (p < sysinfo.lpMaximumApplicationAddress) {
+        result = VirtualQuery(p, &buf, sizeof(buf));
+        if (result != sizeof(buf)) {
+            ABORT("Weird VirtualQuery result");
+        }
+        new_limit = (char *)p + buf.RegionSize;
+        protect = buf.Protect;
+        if (buf.State == MEM_COMMIT
+            && (protect == PAGE_EXECUTE_READWRITE
+                || protect == PAGE_READWRITE)
+            && !GC_is_heap_base(buf.AllocationBase)) {
+            if ((char *)p == limit) {
+                limit = new_limit;
+            } else {
+                GC_cond_add_roots(base, limit);
+                base = p;
+                limit = new_limit;
+            }
+        }
+        if (p > (LPVOID)new_limit /* overflow */) break;
+        p = (LPVOID)new_limit;
+    }
+    GC_cond_add_roots(base, limit);
+  }
+
+#endif /* MSWIN32 */
+
+#if defined(ALPHA) && defined(OSF1)
+
+#include <loader.h>
+
+void GC_register_dynamic_libraries()
+{
+  int status;
+  ldr_process_t mypid;
+
+  /* module */
+    ldr_module_t moduleid = LDR_NULL_MODULE;
+    ldr_module_info_t moduleinfo;
+    size_t moduleinfosize = sizeof(moduleinfo);
+    size_t modulereturnsize;    
+
+  /* region */
+    ldr_region_t region; 
+    ldr_region_info_t regioninfo;
+    size_t regioninfosize = sizeof(regioninfo);
+    size_t regionreturnsize;
+
+  /* Obtain id of this process */
+    mypid = ldr_my_process();
+  
+  /* For each module */
+    while (TRUE) {
+
+      /* Get the next (first) module */
+        status = ldr_next_module(mypid, &moduleid);
+
+      /* Any more modules? */
+        if (moduleid == LDR_NULL_MODULE)
+            break;    /* No more modules */
+
+      /* Check status AFTER checking moduleid because */
+      /* of a bug in the non-shared ldr_next_module stub */
+        if (status != 0 ) {
+            GC_printf1("dynamic_load: status = %ld\n", (long)status);
+            {
+                extern char *sys_errlist[];
+                extern int sys_nerr;
+                extern int errno;
+                if (errno <= sys_nerr) {
+                    GC_printf1("dynamic_load: %s\n", (long)sys_errlist[errno]);
+               } else {
+                    GC_printf1("dynamic_load: %d\n", (long)errno);
+                }
+        }
+            ABORT("ldr_next_module failed");
+         }
+
+      /* Get the module information */
+        status = ldr_inq_module(mypid, moduleid, &moduleinfo,
+                                moduleinfosize, &modulereturnsize); 
+        if (status != 0 )
+            ABORT("ldr_inq_module failed");
+
+      /* is module for the main program (i.e. nonshared portion)? */
+          if (moduleinfo.lmi_flags & LDR_MAIN)
+              continue;    /* skip the main module */
+
+#     ifdef VERBOSE
+          GC_printf("---Module---\n");
+          GC_printf("Module ID            = %16ld\n", moduleinfo.lmi_modid);
+          GC_printf("Count of regions     = %16d\n", moduleinfo.lmi_nregion);
+          GC_printf("flags for module     = %16lx\n", moduleinfo.lmi_flags); 
+          GC_printf("pathname of module   = \"%s\"\n", moduleinfo.lmi_name);
+#     endif
+
+      /* For each region in this module */
+        for (region = 0; region < moduleinfo.lmi_nregion; region++) {
+
+          /* Get the region information */
+            status = ldr_inq_region(mypid, moduleid, region, &regioninfo,
+                                    regioninfosize, &regionreturnsize);
+            if (status != 0 )
+                ABORT("ldr_inq_region failed");
+
+          /* only process writable (data) regions */
+            if (! (regioninfo.lri_prot & LDR_W))
+                continue;
+
+#         ifdef VERBOSE
+              GC_printf("--- Region ---\n");
+              GC_printf("Region number    = %16ld\n",
+              	        regioninfo.lri_region_no);
+              GC_printf("Protection flags = %016x\n",  regioninfo.lri_prot);
+              GC_printf("Virtual address  = %16p\n",   regioninfo.lri_vaddr);
+              GC_printf("Mapped address   = %16p\n",   regioninfo.lri_mapaddr);
+              GC_printf("Region size      = %16ld\n",  regioninfo.lri_size);
+              GC_printf("Region name      = \"%s\"\n", regioninfo.lri_name);
+#         endif
+
+          /* register region as a garbage collection root */
+            GC_add_roots_inner (
+                (char *)regioninfo.lri_mapaddr,
+                (char *)regioninfo.lri_mapaddr + regioninfo.lri_size,
+                TRUE);
+
+        }
+    }
+}
+#endif
+
+#if defined(HPUX)
+
+#include <errno.h>
+#include <dl.h>
+
+extern int errno;
+extern char *sys_errlist[];
+extern int sys_nerr;
+
+void GC_register_dynamic_libraries()
+{
+  int status;
+  int index = 1; /* Ordinal position in shared library search list */
+  struct shl_descriptor *shl_desc; /* Shared library info, see dl.h */
+
+  /* For each dynamic library loaded */
+    while (TRUE) {
+
+      /* Get info about next shared library */
+        status = shl_get(index, &shl_desc);
+
+      /* Check if this is the end of the list or if some error occured */
+        if (status != 0) {
+#	 ifdef HPUX_THREADS
+	   /* I've seen errno values of 0.  The man page is not clear	*/
+	   /* as to whether errno should get set on a -1 return.	*/
+	   break;
+#	 else
+          if (errno == EINVAL) {
+              break; /* Moved past end of shared library list --> finished */
+          } else {
+              if (errno <= sys_nerr) {
+                    GC_printf1("dynamic_load: %s\n", (long) sys_errlist[errno]);
+              } else {
+                    GC_printf1("dynamic_load: %d\n", (long) errno);
+	      }
+              ABORT("shl_get failed");
+          }
+#	 endif
+        }
+
+#     ifdef VERBOSE
+          GC_printf0("---Shared library---\n");
+          GC_printf1("\tfilename        = \"%s\"\n", shl_desc->filename);
+          GC_printf1("\tindex           = %d\n", index);
+          GC_printf1("\thandle          = %08x\n",
+					(unsigned long) shl_desc->handle);
+          GC_printf1("\ttext seg. start = %08x\n", shl_desc->tstart);
+          GC_printf1("\ttext seg. end   = %08x\n", shl_desc->tend);
+          GC_printf1("\tdata seg. start = %08x\n", shl_desc->dstart);
+          GC_printf1("\tdata seg. end   = %08x\n", shl_desc->dend);
+          GC_printf1("\tref. count      = %lu\n", shl_desc->ref_count);
+#     endif
+
+      /* register shared library's data segment as a garbage collection root */
+        GC_add_roots_inner((char *) shl_desc->dstart,
+			   (char *) shl_desc->dend, TRUE);
+
+        index++;
+    }
+}
+#endif /* HPUX */
+
+#ifdef RS6000
+#pragma alloca
+#include <sys/ldr.h>
+#include <sys/errno.h>
+void GC_register_dynamic_libraries()
+{
+	int len;
+	char *ldibuf;
+	int ldibuflen;
+	struct ld_info *ldi;
+
+	ldibuf = alloca(ldibuflen = 8192);
+
+	while ( (len = loadquery(L_GETINFO,ldibuf,ldibuflen)) < 0) {
+		if (errno != ENOMEM) {
+			ABORT("loadquery failed");
+		}
+		ldibuf = alloca(ldibuflen *= 2);
+	}
+
+	ldi = (struct ld_info *)ldibuf;
+	while (ldi) {
+		len = ldi->ldinfo_next;
+		GC_add_roots_inner(
+				ldi->ldinfo_dataorg,
+				(unsigned long)ldi->ldinfo_dataorg
+			        + ldi->ldinfo_datasize,
+				TRUE);
+		ldi = len ? (struct ld_info *)((char *)ldi + len) : 0;
+	}
+}
+#endif /* RS6000 */
+
+
+
+#else /* !DYNAMIC_LOADING */
+
+#ifdef PCR
+
+#   include "il/PCR_IL.h"
+#   include "th/PCR_ThCtl.h"
+#   include "mm/PCR_MM.h"
+
+void GC_register_dynamic_libraries()
+{
+    /* Add new static data areas of dynamically loaded modules.	*/
+        {
+          PCR_IL_LoadedFile * p = PCR_IL_GetLastLoadedFile();
+          PCR_IL_LoadedSegment * q;
+          
+          /* Skip uncommited files */
+          while (p != NIL && !(p -> lf_commitPoint)) {
+              /* The loading of this file has not yet been committed	*/
+              /* Hence its description could be inconsistent.  		*/
+              /* Furthermore, it hasn't yet been run.  Hence its data	*/
+              /* segments can't possibly reference heap allocated	*/
+              /* objects.						*/
+              p = p -> lf_prev;
+          }
+          for (; p != NIL; p = p -> lf_prev) {
+            for (q = p -> lf_ls; q != NIL; q = q -> ls_next) {
+              if ((q -> ls_flags & PCR_IL_SegFlags_Traced_MASK)
+                  == PCR_IL_SegFlags_Traced_on) {
+                GC_add_roots_inner
+                	((char *)(q -> ls_addr), 
+                	 (char *)(q -> ls_addr) + q -> ls_bytes,
+                	 TRUE);
+              }
+            }
+          }
+        }
+}
+
+
+#else /* !PCR */
+
+void GC_register_dynamic_libraries(){}
+
+int GC_no_dynamic_loading;
+
+#endif /* !PCR */
+#endif /* !DYNAMIC_LOADING */
diff --git a/src/gc/finalize.c b/src/gc/finalize.c
new file mode 100644
index 000000000..e70a9ff1e
--- /dev/null
+++ b/src/gc/finalize.c
@@ -0,0 +1,766 @@
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1996 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
+
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, February 1, 1996 1:19 pm PST */
+# define I_HIDE_POINTERS
+# include "gc_priv.h"
+# include "gc_mark.h"
+
+# ifdef FINALIZE_ON_DEMAND
+    int GC_finalize_on_demand = 1;
+# else
+    int GC_finalize_on_demand = 0;
+# endif
+
+# ifdef JAVA_FINALIZATION
+    int GC_java_finalization = 1;
+# else
+    int GC_java_finalization = 0;
+# endif
+
+/* Type of mark procedure used for marking from finalizable object.	*/
+/* This procedure normally does not mark the object, only its		*/
+/* descendents.								*/
+typedef void finalization_mark_proc(/* ptr_t finalizable_obj_ptr */); 
+
+# define HASH3(addr,size,log_size) \
+    ((((word)(addr) >> 3) ^ ((word)(addr) >> (3+(log_size)))) \
+    & ((size) - 1))
+#define HASH2(addr,log_size) HASH3(addr, 1 << log_size, log_size)
+
+struct hash_chain_entry {
+    word hidden_key;
+    struct hash_chain_entry * next;
+};
+
+unsigned GC_finalization_failures = 0;
+	/* Number of finalization requests that failed for lack of memory. */
+
+static struct disappearing_link {
+    struct hash_chain_entry prolog;
+#   define dl_hidden_link prolog.hidden_key
+				/* Field to be cleared.		*/
+#   define dl_next(x) (struct disappearing_link *)((x) -> prolog.next)
+#   define dl_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
+
+    word dl_hidden_obj;		/* Pointer to object base	*/
+} **dl_head = 0;
+
+static signed_word log_dl_table_size = -1;
+			/* Binary log of				*/
+			/* current size of array pointed to by dl_head.	*/
+			/* -1 ==> size is 0.				*/
+
+word GC_dl_entries = 0;	/* Number of entries currently in disappearing	*/
+			/* link table.					*/
+
+static struct finalizable_object {
+    struct hash_chain_entry prolog;
+#   define fo_hidden_base prolog.hidden_key
+				/* Pointer to object base.	*/
+				/* No longer hidden once object */
+				/* is on finalize_now queue.	*/
+#   define fo_next(x) (struct finalizable_object *)((x) -> prolog.next)
+#   define fo_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
+    GC_finalization_proc fo_fn;	/* Finalizer.			*/
+    ptr_t fo_client_data;
+    word fo_object_size;	/* In bytes.			*/
+    finalization_mark_proc * fo_mark_proc;	/* Mark-through procedure */
+} **fo_head = 0;
+
+struct finalizable_object * GC_finalize_now = 0;
+	/* LIst of objects that should be finalized now.	*/
+
+static signed_word log_fo_table_size = -1;
+
+word GC_fo_entries = 0;
+
+# ifdef SRC_M3
+void GC_push_finalizer_structures()
+{
+    GC_push_all((ptr_t)(&dl_head), (ptr_t)(&dl_head) + sizeof(word));
+    GC_push_all((ptr_t)(&fo_head), (ptr_t)(&fo_head) + sizeof(word));
+}
+# endif
+
+/* Double the size of a hash table. *size_ptr is the log of its current	*/
+/* size.  May be a noop.						*/
+/* *table is a pointer to an array of hash headers.  If we succeed, we	*/
+/* update both *table and *log_size_ptr.				*/
+/* Lock is held.  Signals are disabled.					*/
+void GC_grow_table(table, log_size_ptr)
+struct hash_chain_entry ***table;
+signed_word * log_size_ptr;
+{
+    register word i;
+    register struct hash_chain_entry *p;
+    int log_old_size = *log_size_ptr;
+    register int log_new_size = log_old_size + 1;
+    word old_size = ((log_old_size == -1)? 0: (1 << log_old_size));
+    register word new_size = 1 << log_new_size;
+    struct hash_chain_entry **new_table = (struct hash_chain_entry **)
+    	GC_generic_malloc_inner_ignore_off_page(
+    		(size_t)new_size * sizeof(struct hash_chain_entry *), NORMAL);
+    
+    if (new_table == 0) {
+    	if (table == 0) {
+    	    ABORT("Insufficient space for initial table allocation");
+    	} else {
+    	    return;
+    	}
+    }
+    for (i = 0; i < old_size; i++) {
+      p = (*table)[i];
+      while (p != 0) {
+        register ptr_t real_key = (ptr_t)REVEAL_POINTER(p -> hidden_key);
+        register struct hash_chain_entry *next = p -> next;
+        register int new_hash = HASH3(real_key, new_size, log_new_size);
+        
+        p -> next = new_table[new_hash];
+        new_table[new_hash] = p;
+        p = next;
+      }
+    }
+    *log_size_ptr = log_new_size;
+    *table = new_table;
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+    int GC_register_disappearing_link(GC_PTR * link)
+# else
+    int GC_register_disappearing_link(link)
+    GC_PTR * link;
+# endif
+{
+    ptr_t base;
+    
+    base = (ptr_t)GC_base((GC_PTR)link);
+    if (base == 0)
+    	ABORT("Bad arg to GC_register_disappearing_link");
+    return(GC_general_register_disappearing_link(link, base));
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+    int GC_general_register_disappearing_link(GC_PTR * link,
+    					      GC_PTR obj)
+# else
+    int GC_general_register_disappearing_link(link, obj)
+    GC_PTR * link;
+    GC_PTR obj;
+# endif
+
+{
+    struct disappearing_link *curr_dl;
+    int index;
+    struct disappearing_link * new_dl;
+    DCL_LOCK_STATE;
+    
+    if ((word)link & (ALIGNMENT-1))
+    	ABORT("Bad arg to GC_general_register_disappearing_link");
+#   ifdef THREADS
+    	DISABLE_SIGNALS();
+    	LOCK();
+#   endif
+    if (log_dl_table_size == -1
+        || GC_dl_entries > ((word)1 << log_dl_table_size)) {
+#	ifndef THREADS
+	    DISABLE_SIGNALS();
+#	endif
+    	GC_grow_table((struct hash_chain_entry ***)(&dl_head),
+    		      &log_dl_table_size);
+#	ifdef PRINTSTATS
+	    GC_printf1("Grew dl table to %lu entries\n",
+	    		(unsigned long)(1 << log_dl_table_size));
+#	endif
+#	ifndef THREADS
+	    ENABLE_SIGNALS();
+#	endif
+    }
+    index = HASH2(link, log_dl_table_size);
+    curr_dl = dl_head[index];
+    for (curr_dl = dl_head[index]; curr_dl != 0; curr_dl = dl_next(curr_dl)) {
+        if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
+            curr_dl -> dl_hidden_obj = HIDE_POINTER(obj);
+#	    ifdef THREADS
+                UNLOCK();
+    	        ENABLE_SIGNALS();
+#	    endif
+            return(1);
+        }
+    }
+#   ifdef THREADS
+      new_dl = (struct disappearing_link *)
+    	GC_generic_malloc_inner(sizeof(struct disappearing_link),NORMAL);
+#   else
+      new_dl = (struct disappearing_link *)
+	GC_malloc(sizeof(struct disappearing_link));
+#   endif
+    if (new_dl != 0) {
+        new_dl -> dl_hidden_obj = HIDE_POINTER(obj);
+        new_dl -> dl_hidden_link = HIDE_POINTER(link);
+        dl_set_next(new_dl, dl_head[index]);
+        dl_head[index] = new_dl;
+        GC_dl_entries++;
+    } else {
+        GC_finalization_failures++;
+    }
+#   ifdef THREADS
+        UNLOCK();
+        ENABLE_SIGNALS();
+#   endif
+    return(0);
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+    int GC_unregister_disappearing_link(GC_PTR * link)
+# else
+    int GC_unregister_disappearing_link(link)
+    GC_PTR * link;
+# endif
+{
+    struct disappearing_link *curr_dl, *prev_dl;
+    int index;
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    index = HASH2(link, log_dl_table_size);
+    if (((unsigned long)link & (ALIGNMENT-1))) goto out;
+    prev_dl = 0; curr_dl = dl_head[index];
+    while (curr_dl != 0) {
+        if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
+            if (prev_dl == 0) {
+                dl_head[index] = dl_next(curr_dl);
+            } else {
+                dl_set_next(prev_dl, dl_next(curr_dl));
+            }
+            GC_dl_entries--;
+            UNLOCK();
+    	    ENABLE_SIGNALS();
+            GC_free((GC_PTR)curr_dl);
+            return(1);
+        }
+        prev_dl = curr_dl;
+        curr_dl = dl_next(curr_dl);
+    }
+out:
+    UNLOCK();
+    ENABLE_SIGNALS();
+    return(0);
+}
+
+/* Possible finalization_marker procedures.  Note that mark stack	*/
+/* overflow is handled by the caller, and is not a disaster.		*/
+GC_API void GC_normal_finalize_mark_proc(p)
+ptr_t p;
+{
+    hdr * hhdr = HDR(p);
+    
+    PUSH_OBJ((word *)p, hhdr, GC_mark_stack_top,
+	     &(GC_mark_stack[GC_mark_stack_size]));
+}
+
+/* This only pays very partial attention to the mark descriptor.	*/
+/* It does the right thing for normal and atomic objects, and treats	*/
+/* most others as normal.						*/
+GC_API void GC_ignore_self_finalize_mark_proc(p)
+ptr_t p;
+{
+    hdr * hhdr = HDR(p);
+    word descr = hhdr -> hb_descr;
+    ptr_t q, r;
+    ptr_t scan_limit;
+    ptr_t target_limit = p + WORDS_TO_BYTES(hhdr -> hb_sz) - 1;
+    
+    if ((descr & DS_TAGS) == DS_LENGTH) {
+       scan_limit = p + descr - sizeof(word);
+    } else {
+       scan_limit = target_limit + 1 - sizeof(word);
+    }
+    for (q = p; q <= scan_limit; q += ALIGNMENT) {
+    	r = *(ptr_t *)q;
+    	if (r < p || r > target_limit) {
+    	    GC_PUSH_ONE_HEAP((word)r, q);
+    	}
+    }
+}
+
+/*ARGSUSED*/
+GC_API void GC_null_finalize_mark_proc(p)
+ptr_t p;
+{
+}
+
+
+
+/* Register a finalization function.  See gc.h for details.	*/
+/* in the nonthreads case, we try to avoid disabling signals,	*/
+/* since it can be expensive.  Threads packages typically	*/
+/* make it cheaper.						*/
+/* The last parameter is a procedure that determines		*/
+/* marking for finalization ordering.  Any objects marked	*/
+/* by that procedure will be guaranteed to not have been	*/
+/* finalized when this finalizer is invoked.			*/
+GC_API void GC_register_finalizer_inner(obj, fn, cd, ofn, ocd, mp)
+GC_PTR obj;
+GC_finalization_proc fn;
+GC_PTR cd;
+GC_finalization_proc * ofn;
+GC_PTR * ocd;
+finalization_mark_proc * mp;
+{
+    ptr_t base;
+    struct finalizable_object * curr_fo, * prev_fo;
+    int index;
+    struct finalizable_object *new_fo;
+    DCL_LOCK_STATE;
+
+#   ifdef THREADS
+	DISABLE_SIGNALS();
+	LOCK();
+#   endif
+    if (log_fo_table_size == -1
+        || GC_fo_entries > ((word)1 << log_fo_table_size)) {
+#	ifndef THREADS
+    	    DISABLE_SIGNALS();
+#	endif
+    	GC_grow_table((struct hash_chain_entry ***)(&fo_head),
+    		      &log_fo_table_size);
+#	ifdef PRINTSTATS
+	    GC_printf1("Grew fo table to %lu entries\n",
+	    		(unsigned long)(1 << log_fo_table_size));
+#	endif
+#	ifndef THREADS
+	    ENABLE_SIGNALS();
+#	endif
+    }
+    /* in the THREADS case signals are disabled and we hold allocation	*/
+    /* lock; otherwise neither is true.  Proceed carefully.		*/
+    base = (ptr_t)obj;
+    index = HASH2(base, log_fo_table_size);
+    prev_fo = 0; curr_fo = fo_head[index];
+    while (curr_fo != 0) {
+        if (curr_fo -> fo_hidden_base == HIDE_POINTER(base)) {
+            /* Interruption by a signal in the middle of this	*/
+            /* should be safe.  The client may see only *ocd	*/
+            /* updated, but we'll declare that to be his	*/
+            /* problem.						*/
+            if (ocd) *ocd = (GC_PTR) curr_fo -> fo_client_data;
+            if (ofn) *ofn = curr_fo -> fo_fn;
+            /* Delete the structure for base. */
+                if (prev_fo == 0) {
+                  fo_head[index] = fo_next(curr_fo);
+                } else {
+                  fo_set_next(prev_fo, fo_next(curr_fo));
+                }
+            if (fn == 0) {
+                GC_fo_entries--;
+                  /* May not happen if we get a signal.  But a high	*/
+                  /* estimate will only make the table larger than	*/
+                  /* necessary.						*/
+#		ifndef THREADS
+                  GC_free((GC_PTR)curr_fo);
+#		endif
+            } else {
+                curr_fo -> fo_fn = fn;
+                curr_fo -> fo_client_data = (ptr_t)cd;
+                curr_fo -> fo_mark_proc = mp;
+		/* Reinsert it.  We deleted it first to maintain	*/
+		/* consistency in the event of a signal.		*/
+		if (prev_fo == 0) {
+                  fo_head[index] = curr_fo;
+                } else {
+                  fo_set_next(prev_fo, curr_fo);
+                }
+            }
+#	    ifdef THREADS
+                UNLOCK();
+    	    	ENABLE_SIGNALS();
+#	    endif
+            return;
+        }
+        prev_fo = curr_fo;
+        curr_fo = fo_next(curr_fo);
+    }
+    if (ofn) *ofn = 0;
+    if (ocd) *ocd = 0;
+    if (fn == 0) {
+#	ifdef THREADS
+            UNLOCK();
+    	    ENABLE_SIGNALS();
+#	endif
+        return;
+    }
+#   ifdef THREADS
+      new_fo = (struct finalizable_object *)
+    	GC_generic_malloc_inner(sizeof(struct finalizable_object),NORMAL);
+#   else
+      new_fo = (struct finalizable_object *)
+	GC_malloc(sizeof(struct finalizable_object));
+#   endif
+    if (new_fo != 0) {
+        new_fo -> fo_hidden_base = (word)HIDE_POINTER(base);
+	new_fo -> fo_fn = fn;
+	new_fo -> fo_client_data = (ptr_t)cd;
+	new_fo -> fo_object_size = GC_size(base);
+	new_fo -> fo_mark_proc = mp;
+	fo_set_next(new_fo, fo_head[index]);
+	GC_fo_entries++;
+	fo_head[index] = new_fo;
+    } else {
+     	GC_finalization_failures++;
+    }
+#   ifdef THREADS
+        UNLOCK();
+    	ENABLE_SIGNALS();
+#   endif
+}
+
+# if defined(__STDC__)
+    void GC_register_finalizer(void * obj,
+			       GC_finalization_proc fn, void * cd,
+			       GC_finalization_proc *ofn, void ** ocd)
+# else
+    void GC_register_finalizer(obj, fn, cd, ofn, ocd)
+    GC_PTR obj;
+    GC_finalization_proc fn;
+    GC_PTR cd;
+    GC_finalization_proc * ofn;
+    GC_PTR * ocd;
+# endif
+{
+    GC_register_finalizer_inner(obj, fn, cd, ofn,
+    				ocd, GC_normal_finalize_mark_proc);
+}
+
+# if defined(__STDC__)
+    void GC_register_finalizer_ignore_self(void * obj,
+			       GC_finalization_proc fn, void * cd,
+			       GC_finalization_proc *ofn, void ** ocd)
+# else
+    void GC_register_finalizer_ignore_self(obj, fn, cd, ofn, ocd)
+    GC_PTR obj;
+    GC_finalization_proc fn;
+    GC_PTR cd;
+    GC_finalization_proc * ofn;
+    GC_PTR * ocd;
+# endif
+{
+    GC_register_finalizer_inner(obj, fn, cd, ofn,
+    				ocd, GC_ignore_self_finalize_mark_proc);
+}
+
+# if defined(__STDC__)
+    void GC_register_finalizer_no_order(void * obj,
+			       GC_finalization_proc fn, void * cd,
+			       GC_finalization_proc *ofn, void ** ocd)
+# else
+    void GC_register_finalizer_no_order(obj, fn, cd, ofn, ocd)
+    GC_PTR obj;
+    GC_finalization_proc fn;
+    GC_PTR cd;
+    GC_finalization_proc * ofn;
+    GC_PTR * ocd;
+# endif
+{
+    GC_register_finalizer_inner(obj, fn, cd, ofn,
+    				ocd, GC_null_finalize_mark_proc);
+}
+
+/* Called with world stopped.  Cause disappearing links to disappear,	*/
+/* and invoke finalizers.						*/
+void GC_finalize()
+{
+    struct disappearing_link * curr_dl, * prev_dl, * next_dl;
+    struct finalizable_object * curr_fo, * prev_fo, * next_fo;
+    ptr_t real_ptr, real_link;
+    register int i;
+    int dl_size = (log_dl_table_size == -1 ) ? 0 : (1 << log_dl_table_size);
+    int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
+    
+  /* Make disappearing links disappear */
+    for (i = 0; i < dl_size; i++) {
+      curr_dl = dl_head[i];
+      prev_dl = 0;
+      while (curr_dl != 0) {
+        real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
+        real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
+        if (!GC_is_marked(real_ptr)) {
+            *(word *)real_link = 0;
+            next_dl = dl_next(curr_dl);
+            if (prev_dl == 0) {
+                dl_head[i] = next_dl;
+            } else {
+                dl_set_next(prev_dl, next_dl);
+            }
+            GC_clear_mark_bit((ptr_t)curr_dl);
+            GC_dl_entries--;
+            curr_dl = next_dl;
+        } else {
+            prev_dl = curr_dl;
+            curr_dl = dl_next(curr_dl);
+        }
+      }
+    }
+  /* Mark all objects reachable via chains of 1 or more pointers	*/
+  /* from finalizable objects.						*/
+#   ifdef PRINTSTATS
+        if (GC_mark_state != MS_NONE) ABORT("Bad mark state");
+#   endif
+    for (i = 0; i < fo_size; i++) {
+      for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
+        real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
+        if (!GC_is_marked(real_ptr)) {
+	    GC_MARKED_FOR_FINALIZATION(real_ptr);
+            GC_MARK_FO(real_ptr, curr_fo -> fo_mark_proc);
+            if (GC_is_marked(real_ptr)) {
+                WARN("Finalization cycle involving %lx\n", real_ptr);
+            }
+        }
+      }
+    }
+  /* Enqueue for finalization all objects that are still		*/
+  /* unreachable.							*/
+    GC_words_finalized = 0;
+    for (i = 0; i < fo_size; i++) {
+      curr_fo = fo_head[i];
+      prev_fo = 0;
+      while (curr_fo != 0) {
+        real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
+        if (!GC_is_marked(real_ptr)) {
+	    if (!GC_java_finalization) {
+              GC_set_mark_bit(real_ptr);
+	    }
+            /* Delete from hash table */
+              next_fo = fo_next(curr_fo);
+              if (prev_fo == 0) {
+                fo_head[i] = next_fo;
+              } else {
+                fo_set_next(prev_fo, next_fo);
+              }
+              GC_fo_entries--;
+            /* Add to list of objects awaiting finalization.	*/
+              fo_set_next(curr_fo, GC_finalize_now);
+              GC_finalize_now = curr_fo;
+              /* unhide object pointer so any future collections will	*/
+              /* see it.						*/
+              curr_fo -> fo_hidden_base = 
+              		(word) REVEAL_POINTER(curr_fo -> fo_hidden_base);
+              GC_words_finalized +=
+                 	ALIGNED_WORDS(curr_fo -> fo_object_size)
+              		+ ALIGNED_WORDS(sizeof(struct finalizable_object));
+#	    ifdef PRINTSTATS
+              if (!GC_is_marked((ptr_t)curr_fo)) {
+                ABORT("GC_finalize: found accessible unmarked object\n");
+              }
+#	    endif
+            curr_fo = next_fo;
+        } else {
+            prev_fo = curr_fo;
+            curr_fo = fo_next(curr_fo);
+        }
+      }
+    }
+
+  if (GC_java_finalization) {
+    /* make sure we mark everything reachable from objects finalized
+       using the no_order mark_proc */
+      for (curr_fo = GC_finalize_now; 
+  	 curr_fo != NULL; curr_fo = fo_next(curr_fo)) {
+  	real_ptr = (ptr_t)curr_fo -> fo_hidden_base;
+  	if (!GC_is_marked(real_ptr)) {
+  	    if (curr_fo -> fo_mark_proc == GC_null_finalize_mark_proc) {
+  	        GC_MARK_FO(real_ptr, GC_normal_finalize_mark_proc);
+  	    }
+  	    GC_set_mark_bit(real_ptr);
+  	}
+      }
+  }
+
+  /* Remove dangling disappearing links. */
+    for (i = 0; i < dl_size; i++) {
+      curr_dl = dl_head[i];
+      prev_dl = 0;
+      while (curr_dl != 0) {
+        real_link = GC_base((ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link));
+        if (real_link != 0 && !GC_is_marked(real_link)) {
+            next_dl = dl_next(curr_dl);
+            if (prev_dl == 0) {
+                dl_head[i] = next_dl;
+            } else {
+                dl_set_next(prev_dl, next_dl);
+            }
+            GC_clear_mark_bit((ptr_t)curr_dl);
+            GC_dl_entries--;
+            curr_dl = next_dl;
+        } else {
+            prev_dl = curr_dl;
+            curr_dl = dl_next(curr_dl);
+        }
+      }
+    }
+}
+
+#ifndef JAVA_FINALIZATION_NOT_NEEDED
+
+/* Enqueue all remaining finalizers to be run - Assumes lock is
+ * held, and signals are disabled */
+void GC_enqueue_all_finalizers()
+{
+    struct finalizable_object * curr_fo, * prev_fo, * next_fo;
+    ptr_t real_ptr;
+    register int i;
+    int fo_size;
+    
+    fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
+    GC_words_finalized = 0;
+    for (i = 0; i < fo_size; i++) {
+        curr_fo = fo_head[i];
+        prev_fo = 0;
+      while (curr_fo != 0) {
+          real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
+          GC_MARK_FO(real_ptr, GC_normal_finalize_mark_proc);
+          GC_set_mark_bit(real_ptr);
+ 
+          /* Delete from hash table */
+          next_fo = fo_next(curr_fo);
+          if (prev_fo == 0) {
+              fo_head[i] = next_fo;
+          } else {
+              fo_set_next(prev_fo, next_fo);
+          }
+          GC_fo_entries--;
+
+          /* Add to list of objects awaiting finalization.	*/
+          fo_set_next(curr_fo, GC_finalize_now);
+          GC_finalize_now = curr_fo;
+
+          /* unhide object pointer so any future collections will	*/
+          /* see it.						*/
+          curr_fo -> fo_hidden_base = 
+        		(word) REVEAL_POINTER(curr_fo -> fo_hidden_base);
+
+          GC_words_finalized +=
+           	ALIGNED_WORDS(curr_fo -> fo_object_size)
+        		+ ALIGNED_WORDS(sizeof(struct finalizable_object));
+          curr_fo = next_fo;
+        }
+    }
+
+    return;
+}
+
+/* Invoke all remaining finalizers that haven't yet been run. 
+ * This is needed for strict compliance with the Java standard, 
+ * which can make the runtime guarantee that all finalizers are run.
+ * Unfortunately, the Java standard implies we have to keep running
+ * finalizers until there are no more left, a potential infinite loop.
+ * YUCK.
+ * Note that this is even more dangerous than the usual Java
+ * finalizers, in that objects reachable from static variables
+ * may have been finalized when these finalizers are run.
+ * Finalizers run at this point must be prepared to deal with a
+ * mostly broken world.
+ * This routine is externally callable, so is called without 
+ * the allocation lock. 
+ */
+GC_API void GC_finalize_all()
+{
+    DCL_LOCK_STATE;
+
+    DISABLE_SIGNALS();
+    LOCK();
+    while (GC_fo_entries > 0) {
+      GC_enqueue_all_finalizers();
+      UNLOCK();
+      ENABLE_SIGNALS();
+      GC_INVOKE_FINALIZERS();
+      DISABLE_SIGNALS();
+      LOCK();
+    }
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+#endif
+
+/* Returns true if it is worth calling GC_invoke_finalizers. (Useful if	*/
+/* finalizers can only be called from some kind of `safe state' and	*/
+/* getting into that safe state is expensive.)				*/
+int GC_should_invoke_finalizers GC_PROTO((void))
+{
+    return GC_finalize_now != 0;
+}
+
+/* Invoke finalizers for all objects that are ready to be finalized.	*/
+/* Should be called without allocation lock.				*/
+int GC_invoke_finalizers()
+{
+    register struct finalizable_object * curr_fo;
+    register int count = 0;
+    DCL_LOCK_STATE;
+    
+    while (GC_finalize_now != 0) {
+#	ifdef THREADS
+	    DISABLE_SIGNALS();
+	    LOCK();
+#	endif
+    	curr_fo = GC_finalize_now;
+#	ifdef THREADS
+ 	    if (curr_fo != 0) GC_finalize_now = fo_next(curr_fo);
+	    UNLOCK();
+	    ENABLE_SIGNALS();
+	    if (curr_fo == 0) break;
+#	else
+	    GC_finalize_now = fo_next(curr_fo);
+#	endif
+ 	fo_set_next(curr_fo, 0);
+    	(*(curr_fo -> fo_fn))((ptr_t)(curr_fo -> fo_hidden_base),
+    			      curr_fo -> fo_client_data);
+    	curr_fo -> fo_client_data = 0;
+	++count;
+#	ifdef UNDEFINED
+	    /* This is probably a bad idea.  It throws off accounting if */
+	    /* nearly all objects are finalizable.  O.w. it shouldn't	 */
+	    /* matter.							 */
+    	    GC_free((GC_PTR)curr_fo);
+#	endif
+    }
+    return count;
+}
+
+# ifdef __STDC__
+    GC_PTR GC_call_with_alloc_lock(GC_fn_type fn,
+    					 GC_PTR client_data)
+# else
+    GC_PTR GC_call_with_alloc_lock(fn, client_data)
+    GC_fn_type fn;
+    GC_PTR client_data;
+# endif
+{
+    GC_PTR result;
+    DCL_LOCK_STATE;
+    
+#   ifdef THREADS
+      DISABLE_SIGNALS();
+      LOCK();
+      SET_LOCK_HOLDER();
+#   endif
+    result = (*fn)(client_data);
+#   ifdef THREADS
+      UNSET_LOCK_HOLDER();
+      UNLOCK();
+      ENABLE_SIGNALS();
+#   endif
+    return(result);
+}
diff --git a/src/gc/gc.h b/src/gc/gc.h
new file mode 100644
index 000000000..d7cd89960
--- /dev/null
+++ b/src/gc/gc.h
@@ -0,0 +1,804 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright 1996-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright 1999 by Hewlett-Packard Company.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * Note that this defines a large number of tuning hooks, which can
+ * safely be ignored in nearly all cases.  For normal use it suffices
+ * to call only GC_MALLOC and perhaps GC_REALLOC.
+ * For better performance, also look at GC_MALLOC_ATOMIC, and
+ * GC_enable_incremental.  If you need an action to be performed
+ * immediately before an object is collected, look at GC_register_finalizer.
+ * If you are using Solaris threads, look at the end of this file.
+ * Everything else is best ignored unless you encounter performance
+ * problems.
+ */
+ 
+#ifndef _GC_H
+
+# define _GC_H
+# define __GC
+# include <stddef.h>
+
+#if defined(__CYGWIN32__) && defined(GC_USE_DLL)
+#include "libgc_globals.h"
+#endif
+
+#if defined(__MINGW32__) && defined(WIN32_THREADS)
+# ifdef GC_BUILD
+#   define GC_API __declspec(dllexport)
+# else
+#   define GC_API __declspec(dllimport)
+# endif
+#endif
+
+#if defined(_MSC_VER) && defined(_DLL)
+# ifdef GC_BUILD
+#   define GC_API __declspec(dllexport)
+# else
+#   define GC_API __declspec(dllimport)
+# endif
+#endif
+
+#if defined(__WATCOMC__) && defined(GC_DLL)
+# ifdef GC_BUILD
+#   define GC_API extern __declspec(dllexport)
+# else
+#   define GC_API extern __declspec(dllimport)
+# endif
+#endif
+
+#ifndef GC_API
+#define GC_API extern
+#endif
+
+# if defined(__STDC__) || defined(__cplusplus)
+#   define GC_PROTO(args) args
+    typedef void * GC_PTR;
+#   define GC_CONST const
+# else
+#   define GC_PROTO(args) ()
+    typedef char * GC_PTR;
+#   define GC_CONST
+#  endif
+
+# ifdef __cplusplus
+    extern "C" {
+# endif
+
+
+/* Define word and signed_word to be unsigned and signed types of the 	*/
+/* size as char * or void *.  There seems to be no way to do this	*/
+/* even semi-portably.  The following is probably no better/worse 	*/
+/* than almost anything else.						*/
+/* The ANSI standard suggests that size_t and ptr_diff_t might be 	*/
+/* better choices.  But those appear to have incorrect definitions	*/
+/* on may systems.  Notably "typedef int size_t" seems to be both	*/
+/* frequent and WRONG.							*/
+typedef unsigned long GC_word;
+typedef long GC_signed_word;
+
+/* Public read-only variables */
+
+GC_API GC_word GC_gc_no;/* Counter incremented per collection.  	*/
+			/* Includes empty GCs at startup.		*/
+			
+
+/* Public R/W variables */
+
+GC_API GC_PTR (*GC_oom_fn) GC_PROTO((size_t bytes_requested));
+			/* When there is insufficient memory to satisfy */
+			/* an allocation request, we return		*/
+			/* (*GC_oom_fn)().  By default this just	*/
+			/* returns 0.					*/
+			/* If it returns, it must return 0 or a valid	*/
+			/* pointer to a previously allocated heap 	*/
+			/* object.					*/
+
+GC_API int GC_find_leak;
+			/* Do not actually garbage collect, but simply	*/
+			/* report inaccessible memory that was not	*/
+			/* deallocated with GC_free.  Initial value	*/
+			/* is determined by FIND_LEAK macro.		*/
+
+GC_API int GC_quiet;	/* Disable statistics output.  Only matters if	*/
+			/* collector has been compiled with statistics	*/
+			/* enabled.  This involves a performance cost,	*/
+			/* and is thus not the default.			*/
+
+GC_API int GC_finalize_on_demand;
+			/* If nonzero, finalizers will only be run in 	*/
+			/* response to an eplit GC_invoke_finalizers	*/
+			/* call.  The default is determined by whether	*/
+			/* the FINALIZE_ON_DEMAND macro is defined	*/
+			/* when the collector is built.			*/
+
+GC_API int GC_java_finalization;
+			/* Mark objects reachable from finalizable 	*/
+			/* objects in a separate postpass.  This makes	*/
+			/* it a bit safer to use non-topologically-	*/
+			/* ordered finalization.  Default value is	*/
+			/* determined by JAVA_FINALIZATION macro.	*/
+
+GC_API int GC_dont_gc;	/* Dont collect unless explicitly requested, e.g. */
+			/* because it's not safe.			  */
+
+GC_API int GC_dont_expand;
+			/* Dont expand heap unless explicitly requested */
+			/* or forced to.				*/
+
+GC_API int GC_use_entire_heap;
+		/* Causes the nonincremental collector to use the	*/
+		/* entire heap before collecting.  This was the only 	*/
+		/* option for GC versions < 5.0.  This sometimes	*/
+		/* results in more large block fragmentation, since	*/
+		/* very larg blocks will tend to get broken up		*/
+		/* during each GC cycle.  It is likely to result in a	*/
+		/* larger working set, but lower collection		*/
+		/* frequencies, and hence fewer instructions executed	*/
+		/* in the collector.					*/
+
+GC_API int GC_full_freq;    /* Number of partial collections between	*/
+			    /* full collections.  Matters only if	*/
+			    /* GC_incremental is set.			*/
+			    /* Full collections are also triggered if	*/
+			    /* the collector detects a substantial	*/
+			    /* increase in the number of in-use heap	*/
+			    /* blocks.  Values in the tens are now	*/
+			    /* perfectly reasonable, unlike for		*/
+			    /* earlier GC versions.			*/
+			
+GC_API GC_word GC_non_gc_bytes;
+			/* Bytes not considered candidates for collection. */
+			/* Used only to control scheduling of collections. */
+
+GC_API GC_word GC_free_space_divisor;
+			/* We try to make sure that we allocate at 	*/
+			/* least N/GC_free_space_divisor bytes between	*/
+			/* collections, where N is the heap size plus	*/
+			/* a rough estimate of the root set size.	*/
+			/* Initially, GC_free_space_divisor = 4.	*/
+			/* Increasing its value will use less space	*/
+			/* but more collection time.  Decreasing it	*/
+			/* will appreciably decrease collection time	*/
+			/* at the expense of space.			*/
+			/* GC_free_space_divisor = 1 will effectively	*/
+			/* disable collections.				*/
+
+GC_API GC_word GC_max_retries;
+			/* The maximum number of GCs attempted before	*/
+			/* reporting out of memory after heap		*/
+			/* expansion fails.  Initially 0.		*/
+			
+
+GC_API char *GC_stackbottom;	/* Cool end of user stack.		*/
+				/* May be set in the client prior to	*/
+				/* calling any GC_ routines.  This	*/
+				/* avoids some overhead, and 		*/
+				/* potentially some signals that can 	*/
+				/* confuse debuggers.  Otherwise the	*/
+				/* collector attempts to set it 	*/
+				/* automatically.			*/
+				/* For multithreaded code, this is the	*/
+				/* cold end of the stack for the	*/
+				/* primordial thread.			*/
+				
+/* Public procedures */
+/*
+ * general purpose allocation routines, with roughly malloc calling conv.
+ * The atomic versions promise that no relevant pointers are contained
+ * in the object.  The nonatomic versions guarantee that the new object
+ * is cleared.  GC_malloc_stubborn promises that no changes to the object
+ * will occur after GC_end_stubborn_change has been called on the
+ * result of GC_malloc_stubborn. GC_malloc_uncollectable allocates an object
+ * that is scanned for pointers to collectable objects, but is not itself
+ * collectable.  GC_malloc_uncollectable and GC_free called on the resulting
+ * object implicitly update GC_non_gc_bytes appropriately.
+ */
+GC_API GC_PTR GC_malloc GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_atomic GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_uncollectable GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_stubborn GC_PROTO((size_t size_in_bytes));
+
+/* The following is only defined if the library has been suitably	*/
+/* compiled:								*/
+GC_API GC_PTR GC_malloc_atomic_uncollectable GC_PROTO((size_t size_in_bytes));
+
+/* Explicitly deallocate an object.  Dangerous if used incorrectly.     */
+/* Requires a pointer to the base of an object.				*/
+/* If the argument is stubborn, it should not be changeable when freed. */
+/* An object should not be enable for finalization when it is 		*/
+/* explicitly deallocated.						*/
+/* GC_free(0) is a no-op, as required by ANSI C for free.		*/
+GC_API void GC_free GC_PROTO((GC_PTR object_addr));
+
+/*
+ * Stubborn objects may be changed only if the collector is explicitly informed.
+ * The collector is implicitly informed of coming change when such
+ * an object is first allocated.  The following routines inform the
+ * collector that an object will no longer be changed, or that it will
+ * once again be changed.  Only nonNIL pointer stores into the object
+ * are considered to be changes.  The argument to GC_end_stubborn_change
+ * must be exacly the value returned by GC_malloc_stubborn or passed to
+ * GC_change_stubborn.  (In the second case it may be an interior pointer
+ * within 512 bytes of the beginning of the objects.)
+ * There is a performance penalty for allowing more than
+ * one stubborn object to be changed at once, but it is acceptable to
+ * do so.  The same applies to dropping stubborn objects that are still
+ * changeable.
+ */
+GC_API void GC_change_stubborn GC_PROTO((GC_PTR));
+GC_API void GC_end_stubborn_change GC_PROTO((GC_PTR));
+
+/* Return a pointer to the base (lowest address) of an object given	*/
+/* a pointer to a location within the object.				*/
+/* Return 0 if displaced_pointer doesn't point to within a valid	*/
+/* object.								*/
+GC_API GC_PTR GC_base GC_PROTO((GC_PTR displaced_pointer));
+
+/* Given a pointer to the base of an object, return its size in bytes.	*/
+/* The returned size may be slightly larger than what was originally	*/
+/* requested.								*/
+GC_API size_t GC_size GC_PROTO((GC_PTR object_addr));
+
+/* For compatibility with C library.  This is occasionally faster than	*/
+/* a malloc followed by a bcopy.  But if you rely on that, either here	*/
+/* or with the standard C library, your code is broken.  In my		*/
+/* opinion, it shouldn't have been invented, but now we're stuck. -HB	*/
+/* The resulting object has the same kind as the original.		*/
+/* If the argument is stubborn, the result will have changes enabled.	*/
+/* It is an error to have changes enabled for the original object.	*/
+/* Follows ANSI comventions for NULL old_object.			*/
+GC_API GC_PTR GC_realloc
+	GC_PROTO((GC_PTR old_object, size_t new_size_in_bytes));
+				   
+/* Explicitly increase the heap size.	*/
+/* Returns 0 on failure, 1 on success.  */
+GC_API int GC_expand_hp GC_PROTO((size_t number_of_bytes));
+
+/* Limit the heap size to n bytes.  Useful when you're debugging, 	*/
+/* especially on systems that don't handle running out of memory well.	*/
+/* n == 0 ==> unbounded.  This is the default.				*/
+GC_API void GC_set_max_heap_size GC_PROTO((GC_word n));
+
+/* Inform the collector that a certain section of statically allocated	*/
+/* memory contains no pointers to garbage collected memory.  Thus it 	*/
+/* need not be scanned.  This is sometimes important if the application */
+/* maps large read/write files into the address space, which could be	*/
+/* mistaken for dynamic library data segments on some systems.		*/
+GC_API void GC_exclude_static_roots GC_PROTO((GC_PTR start, GC_PTR finish));
+
+/* Clear the set of root segments.  Wizards only. */
+GC_API void GC_clear_roots GC_PROTO((void));
+
+/* Add a root segment.  Wizards only. */
+GC_API void GC_add_roots GC_PROTO((char * low_address,
+				   char * high_address_plus_1));
+
+/* Add a displacement to the set of those considered valid by the	*/
+/* collector.  GC_register_displacement(n) means that if p was returned */
+/* by GC_malloc, then (char *)p + n will be considered to be a valid	*/
+/* pointer to n.  N must be small and less than the size of p.		*/
+/* (All pointers to the interior of objects from the stack are		*/
+/* considered valid in any case.  This applies to heap objects and	*/
+/* static data.)							*/
+/* Preferably, this should be called before any other GC procedures.	*/
+/* Calling it later adds to the probability of excess memory		*/
+/* retention.								*/
+/* This is a no-op if the collector was compiled with recognition of	*/
+/* arbitrary interior pointers enabled, which is now the default.	*/
+GC_API void GC_register_displacement GC_PROTO((GC_word n));
+
+/* The following version should be used if any debugging allocation is	*/
+/* being done.								*/
+GC_API void GC_debug_register_displacement GC_PROTO((GC_word n));
+
+/* Explicitly trigger a full, world-stop collection. 	*/
+GC_API void GC_gcollect GC_PROTO((void));
+
+/* Trigger a full world-stopped collection.  Abort the collection if 	*/
+/* and when stop_func returns a nonzero value.  Stop_func will be 	*/
+/* called frequently, and should be reasonably fast.  This works even	*/
+/* if virtual dirty bits, and hence incremental collection is not 	*/
+/* available for this architecture.  Collections can be aborted faster	*/
+/* than normal pause times for incremental collection.  However,	*/
+/* aborted collections do no useful work; the next collection needs	*/
+/* to start from the beginning.						*/
+/* Return 0 if the collection was aborted, 1 if it succeeded.		*/
+typedef int (* GC_stop_func) GC_PROTO((void));
+GC_API int GC_try_to_collect GC_PROTO((GC_stop_func stop_func));
+
+/* Return the number of bytes in the heap.  Excludes collector private	*/
+/* data structures.  Includes empty blocks and fragmentation loss.	*/
+/* Includes some pages that were allocated but never written.		*/
+GC_API size_t GC_get_heap_size GC_PROTO((void));
+
+/* Return a lower bound on the number of free bytes in the heap.	*/
+GC_API size_t GC_get_free_bytes GC_PROTO((void));
+
+/* Return the number of bytes allocated since the last collection.	*/
+GC_API size_t GC_get_bytes_since_gc GC_PROTO((void));
+
+/* Enable incremental/generational collection.	*/
+/* Not advisable unless dirty bits are 		*/
+/* available or most heap objects are		*/
+/* pointerfree(atomic) or immutable.		*/
+/* Don't use in leak finding mode.		*/
+/* Ignored if GC_dont_gc is true.		*/
+GC_API void GC_enable_incremental GC_PROTO((void));
+
+/* Perform some garbage collection work, if appropriate.	*/
+/* Return 0 if there is no more work to be done.		*/
+/* Typically performs an amount of work corresponding roughly	*/
+/* to marking from one page.  May do more work if further	*/
+/* progress requires it, e.g. if incremental collection is	*/
+/* disabled.  It is reasonable to call this in a wait loop	*/
+/* until it returns 0.						*/
+GC_API int GC_collect_a_little GC_PROTO((void));
+
+/* Allocate an object of size lb bytes.  The client guarantees that	*/
+/* as long as the object is live, it will be referenced by a pointer	*/
+/* that points to somewhere within the first 256 bytes of the object.	*/
+/* (This should normally be declared volatile to prevent the compiler	*/
+/* from invalidating this assertion.)  This routine is only useful	*/
+/* if a large array is being allocated.  It reduces the chance of 	*/
+/* accidentally retaining such an array as a result of scanning an	*/
+/* integer that happens to be an address inside the array.  (Actually,	*/
+/* it reduces the chance of the allocator not finding space for such	*/
+/* an array, since it will try hard to avoid introducing such a false	*/
+/* reference.)  On a SunOS 4.X or MS Windows system this is recommended */
+/* for arrays likely to be larger than 100K or so.  For other systems,	*/
+/* or if the collector is not configured to recognize all interior	*/
+/* pointers, the threshold is normally much higher.			*/
+GC_API GC_PTR GC_malloc_ignore_off_page GC_PROTO((size_t lb));
+GC_API GC_PTR GC_malloc_atomic_ignore_off_page GC_PROTO((size_t lb));
+
+#if defined(__sgi) && !defined(__GNUC__) && _COMPILER_VERSION >= 720
+#   define GC_ADD_CALLER
+#   define GC_RETURN_ADDR (GC_word)__return_address
+#endif
+
+#ifdef GC_ADD_CALLER
+#  define GC_EXTRAS GC_RETURN_ADDR, __FILE__, __LINE__
+#  define GC_EXTRA_PARAMS GC_word ra, GC_CONST char * s, int i
+#else
+#  define GC_EXTRAS __FILE__, __LINE__
+#  define GC_EXTRA_PARAMS GC_CONST char * s, int i
+#endif
+
+/* Debugging (annotated) allocation.  GC_gcollect will check 		*/
+/* objects allocated in this way for overwrites, etc.			*/
+GC_API GC_PTR GC_debug_malloc
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_atomic
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_uncollectable
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_stubborn
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API void GC_debug_free GC_PROTO((GC_PTR object_addr));
+GC_API GC_PTR GC_debug_realloc
+	GC_PROTO((GC_PTR old_object, size_t new_size_in_bytes,
+  		  GC_EXTRA_PARAMS));
+  			 	 
+GC_API void GC_debug_change_stubborn GC_PROTO((GC_PTR));
+GC_API void GC_debug_end_stubborn_change GC_PROTO((GC_PTR));
+# ifdef GC_DEBUG
+#   define GC_MALLOC(sz) GC_debug_malloc(sz, GC_EXTRAS)
+#   define GC_MALLOC_ATOMIC(sz) GC_debug_malloc_atomic(sz, GC_EXTRAS)
+#   define GC_MALLOC_UNCOLLECTABLE(sz) GC_debug_malloc_uncollectable(sz, \
+							GC_EXTRAS)
+#   define GC_REALLOC(old, sz) GC_debug_realloc(old, sz, GC_EXTRAS)
+#   define GC_FREE(p) GC_debug_free(p)
+#   define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+	GC_debug_register_finalizer(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_IGNORE_SELF(p, f, d, of, od) \
+	GC_debug_register_finalizer_ignore_self(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
+	GC_debug_register_finalizer_no_order(p, f, d, of, od)
+#   define GC_MALLOC_STUBBORN(sz) GC_debug_malloc_stubborn(sz, GC_EXTRAS);
+#   define GC_CHANGE_STUBBORN(p) GC_debug_change_stubborn(p)
+#   define GC_END_STUBBORN_CHANGE(p) GC_debug_end_stubborn_change(p)
+#   define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
+	GC_general_register_disappearing_link(link, GC_base(obj))
+#   define GC_REGISTER_DISPLACEMENT(n) GC_debug_register_displacement(n)
+# else
+#   define GC_MALLOC(sz) GC_malloc(sz)
+#   define GC_MALLOC_ATOMIC(sz) GC_malloc_atomic(sz)
+#   define GC_MALLOC_UNCOLLECTABLE(sz) GC_malloc_uncollectable(sz)
+#   define GC_REALLOC(old, sz) GC_realloc(old, sz)
+#   define GC_FREE(p) GC_free(p)
+#   define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+	GC_register_finalizer(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_IGNORE_SELF(p, f, d, of, od) \
+	GC_register_finalizer_ignore_self(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
+	GC_register_finalizer_no_order(p, f, d, of, od)
+#   define GC_MALLOC_STUBBORN(sz) GC_malloc_stubborn(sz)
+#   define GC_CHANGE_STUBBORN(p) GC_change_stubborn(p)
+#   define GC_END_STUBBORN_CHANGE(p) GC_end_stubborn_change(p)
+#   define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
+	GC_general_register_disappearing_link(link, obj)
+#   define GC_REGISTER_DISPLACEMENT(n) GC_register_displacement(n)
+# endif
+/* The following are included because they are often convenient, and	*/
+/* reduce the chance for a misspecifed size argument.  But calls may	*/
+/* expand to something syntactically incorrect if t is a complicated	*/
+/* type expression.  							*/
+# define GC_NEW(t) (t *)GC_MALLOC(sizeof (t))
+# define GC_NEW_ATOMIC(t) (t *)GC_MALLOC_ATOMIC(sizeof (t))
+# define GC_NEW_STUBBORN(t) (t *)GC_MALLOC_STUBBORN(sizeof (t))
+# define GC_NEW_UNCOLLECTABLE(t) (t *)GC_MALLOC_UNCOLLECTABLE(sizeof (t))
+
+/* Finalization.  Some of these primitives are grossly unsafe.		*/
+/* The idea is to make them both cheap, and sufficient to build		*/
+/* a safer layer, closer to PCedar finalization.			*/
+/* The interface represents my conclusions from a long discussion	*/
+/* with Alan Demers, Dan Greene, Carl Hauser, Barry Hayes, 		*/
+/* Christian Jacobi, and Russ Atkinson.  It's not perfect, and		*/
+/* probably nobody else agrees with it.	    Hans-J. Boehm  3/13/92	*/
+typedef void (*GC_finalization_proc)
+  	GC_PROTO((GC_PTR obj, GC_PTR client_data));
+
+GC_API void GC_register_finalizer
+    	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer
+    	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+	/* When obj is no longer accessible, invoke		*/
+	/* (*fn)(obj, cd).  If a and b are inaccessible, and	*/
+	/* a points to b (after disappearing links have been	*/
+	/* made to disappear), then only a will be		*/
+	/* finalized.  (If this does not create any new		*/
+	/* pointers to b, then b will be finalized after the	*/
+	/* next collection.)  Any finalizable object that	*/
+	/* is reachable from itself by following one or more	*/
+	/* pointers will not be finalized (or collected).	*/
+	/* Thus cycles involving finalizable objects should	*/
+	/* be avoided, or broken by disappearing links.		*/
+	/* All but the last finalizer registered for an object  */
+	/* is ignored.						*/
+	/* Finalization may be removed by passing 0 as fn.	*/
+	/* Finalizers are implicitly unregistered just before   */
+	/* they are invoked.					*/
+	/* The old finalizer and client data are stored in	*/
+	/* *ofn and *ocd.					*/ 
+	/* Fn is never invoked on an accessible object,		*/
+	/* provided hidden pointers are converted to real 	*/
+	/* pointers only if the allocation lock is held, and	*/
+	/* such conversions are not performed by finalization	*/
+	/* routines.						*/
+	/* If GC_register_finalizer is aborted as a result of	*/
+	/* a signal, the object may be left with no		*/
+	/* finalization, even if neither the old nor new	*/
+	/* finalizer were NULL.					*/
+	/* Obj should be the nonNULL starting address of an 	*/
+	/* object allocated by GC_malloc or friends.		*/
+	/* Note that any garbage collectable object referenced	*/
+	/* by cd will be considered accessible until the	*/
+	/* finalizer is invoked.				*/
+
+/* Another versions of the above follow.  It ignores		*/
+/* self-cycles, i.e. pointers from a finalizable object to	*/
+/* itself.  There is a stylistic argument that this is wrong,	*/
+/* but it's unavoidable for C++, since the compiler may		*/
+/* silently introduce these.  It's also benign in that specific	*/
+/* case.							*/
+GC_API void GC_register_finalizer_ignore_self
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer_ignore_self
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+
+/* Another version of the above.  It ignores all cycles.        */
+/* It should probably only be used by Java implementations.      */
+GC_API void GC_register_finalizer_no_order
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer_no_order
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+
+
+/* The following routine may be used to break cycles between	*/
+/* finalizable objects, thus causing cyclic finalizable		*/
+/* objects to be finalized in the correct order.  Standard	*/
+/* use involves calling GC_register_disappearing_link(&p),	*/
+/* where p is a pointer that is not followed by finalization	*/
+/* code, and should not be considered in determining 		*/
+/* finalization order.						*/
+GC_API int GC_register_disappearing_link GC_PROTO((GC_PTR * /* link */));
+	/* Link should point to a field of a heap allocated 	*/
+	/* object obj.  *link will be cleared when obj is	*/
+	/* found to be inaccessible.  This happens BEFORE any	*/
+	/* finalization code is invoked, and BEFORE any		*/
+	/* decisions about finalization order are made.		*/
+	/* This is useful in telling the finalizer that 	*/
+	/* some pointers are not essential for proper		*/
+	/* finalization.  This may avoid finalization cycles.	*/
+	/* Note that obj may be resurrected by another		*/
+	/* finalizer, and thus the clearing of *link may	*/
+	/* be visible to non-finalization code.  		*/
+	/* There's an argument that an arbitrary action should  */
+	/* be allowed here, instead of just clearing a pointer. */
+	/* But this causes problems if that action alters, or 	*/
+	/* examines connectivity.				*/
+	/* Returns 1 if link was already registered, 0		*/
+	/* otherwise.						*/
+	/* Only exists for backward compatibility.  See below:	*/
+	
+GC_API int GC_general_register_disappearing_link
+	GC_PROTO((GC_PTR * /* link */, GC_PTR obj));
+	/* A slight generalization of the above. *link is	*/
+	/* cleared when obj first becomes inaccessible.  This	*/
+	/* can be used to implement weak pointers easily and	*/
+	/* safely. Typically link will point to a location	*/
+	/* holding a disguised pointer to obj.  (A pointer 	*/
+	/* inside an "atomic" object is effectively  		*/
+	/* disguised.)   In this way soft			*/
+	/* pointers are broken before any object		*/
+	/* reachable from them are finalized.  Each link	*/
+	/* May be registered only once, i.e. with one obj	*/
+	/* value.  This was added after a long email discussion */
+	/* with John Ellis.					*/
+	/* Obj must be a pointer to the first word of an object */
+	/* we allocated.  It is unsafe to explicitly deallocate */
+	/* the object containing link.  Explicitly deallocating */
+	/* obj may or may not cause link to eventually be	*/
+	/* cleared.						*/
+GC_API int GC_unregister_disappearing_link GC_PROTO((GC_PTR * /* link */));
+	/* Returns 0 if link was not actually registered.	*/
+	/* Undoes a registration by either of the above two	*/
+	/* routines.						*/
+
+/* Auxiliary fns to make finalization work correctly with displaced	*/
+/* pointers introduced by the debugging allocators.			*/
+GC_API GC_PTR GC_make_closure GC_PROTO((GC_finalization_proc fn, GC_PTR data));
+GC_API void GC_debug_invoke_finalizer GC_PROTO((GC_PTR obj, GC_PTR data));
+
+/* Returns !=0  if GC_invoke_finalizers has something to do. 		*/
+GC_API int GC_should_invoke_finalizers GC_PROTO((void));
+
+GC_API int GC_invoke_finalizers GC_PROTO((void));
+	/* Run finalizers for all objects that are ready to	*/
+	/* be finalized.  Return the number of finalizers	*/
+	/* that were run.  Normally this is also called		*/
+	/* implicitly during some allocations.	If		*/
+	/* GC-finalize_on_demand is nonzero, it must be called	*/
+	/* explicitly.						*/
+
+/* GC_set_warn_proc can be used to redirect or filter warning messages.	*/
+/* p may not be a NULL pointer.						*/
+typedef void (*GC_warn_proc) GC_PROTO((char *msg, GC_word arg));
+GC_API GC_warn_proc GC_set_warn_proc GC_PROTO((GC_warn_proc p));
+    /* Returns old warning procedure.	*/
+	
+/* The following is intended to be used by a higher level	*/
+/* (e.g. cedar-like) finalization facility.  It is expected	*/
+/* that finalization code will arrange for hidden pointers to	*/
+/* disappear.  Otherwise objects can be accessed after they	*/
+/* have been collected.						*/
+/* Note that putting pointers in atomic objects or in 		*/
+/* nonpointer slots of "typed" objects is equivalent to 	*/
+/* disguising them in this way, and may have other advantages.	*/
+# if defined(I_HIDE_POINTERS) || defined(GC_I_HIDE_POINTERS)
+    typedef GC_word GC_hidden_pointer;
+#   define HIDE_POINTER(p) (~(GC_hidden_pointer)(p))
+#   define REVEAL_POINTER(p) ((GC_PTR)(HIDE_POINTER(p)))
+    /* Converting a hidden pointer to a real pointer requires verifying	*/
+    /* that the object still exists.  This involves acquiring the  	*/
+    /* allocator lock to avoid a race with the collector.		*/
+# endif /* I_HIDE_POINTERS */
+
+typedef GC_PTR (*GC_fn_type) GC_PROTO((GC_PTR client_data));
+GC_API GC_PTR GC_call_with_alloc_lock
+        	GC_PROTO((GC_fn_type fn, GC_PTR client_data));
+
+/* Check that p and q point to the same object.  		*/
+/* Fail conspicuously if they don't.				*/
+/* Returns the first argument.  				*/
+/* Succeeds if neither p nor q points to the heap.		*/
+/* May succeed if both p and q point to between heap objects.	*/
+GC_API GC_PTR GC_same_obj GC_PROTO((GC_PTR p, GC_PTR q));
+
+/* Checked pointer pre- and post- increment operations.  Note that	*/
+/* the second argument is in units of bytes, not multiples of the	*/
+/* object size.  This should either be invoked from a macro, or the	*/
+/* call should be automatically generated.				*/
+GC_API GC_PTR GC_pre_incr GC_PROTO((GC_PTR *p, size_t how_much));
+GC_API GC_PTR GC_post_incr GC_PROTO((GC_PTR *p, size_t how_much));
+
+/* Check that p is visible						*/
+/* to the collector as a possibly pointer containing location.		*/
+/* If it isn't fail conspicuously.					*/
+/* Returns the argument in all cases.  May erroneously succeed		*/
+/* in hard cases.  (This is intended for debugging use with		*/
+/* untyped allocations.  The idea is that it should be possible, though	*/
+/* slow, to add such a call to all indirect pointer stores.)		*/
+/* Currently useless for multithreaded worlds.				*/
+GC_API GC_PTR GC_is_visible GC_PROTO((GC_PTR p));
+
+/* Check that if p is a pointer to a heap page, then it points to	*/
+/* a valid displacement within a heap object.				*/
+/* Fail conspicuously if this property does not hold.			*/
+/* Uninteresting with ALL_INTERIOR_POINTERS.				*/
+/* Always returns its argument.						*/
+GC_API GC_PTR GC_is_valid_displacement GC_PROTO((GC_PTR	p));
+
+/* Safer, but slow, pointer addition.  Probably useful mainly with 	*/
+/* a preprocessor.  Useful only for heap pointers.			*/
+#ifdef GC_DEBUG
+#   define GC_PTR_ADD3(x, n, type_of_result) \
+	((type_of_result)GC_same_obj((x)+(n), (x)))
+#   define GC_PRE_INCR3(x, n, type_of_result) \
+	((type_of_result)GC_pre_incr(&(x), (n)*sizeof(*x))
+#   define GC_POST_INCR2(x, type_of_result) \
+	((type_of_result)GC_post_incr(&(x), sizeof(*x))
+#   ifdef __GNUC__
+#       define GC_PTR_ADD(x, n) \
+	    GC_PTR_ADD3(x, n, typeof(x))
+#   define GC_PRE_INCR(x, n) \
+	    GC_PRE_INCR3(x, n, typeof(x))
+#   define GC_POST_INCR(x, n) \
+	    GC_POST_INCR3(x, typeof(x))
+#   else
+	/* We can't do this right without typeof, which ANSI	*/
+	/* decided was not sufficiently useful.  Repeatedly	*/
+	/* mentioning the arguments seems too dangerous to be	*/
+	/* useful.  So does not casting the result.		*/
+#   	define GC_PTR_ADD(x, n) ((x)+(n))
+#   endif
+#else	/* !GC_DEBUG */
+#   define GC_PTR_ADD3(x, n, type_of_result) ((x)+(n))
+#   define GC_PTR_ADD(x, n) ((x)+(n))
+#   define GC_PRE_INCR3(x, n, type_of_result) ((x) += (n))
+#   define GC_PRE_INCR(x, n) ((x) += (n))
+#   define GC_POST_INCR2(x, n, type_of_result) ((x)++)
+#   define GC_POST_INCR(x, n) ((x)++)
+#endif
+
+/* Safer assignment of a pointer to a nonstack location.	*/
+#ifdef GC_DEBUG
+# ifdef __STDC__
+#   define GC_PTR_STORE(p, q) \
+	(*(void **)GC_is_visible(p) = GC_is_valid_displacement(q))
+# else
+#   define GC_PTR_STORE(p, q) \
+	(*(char **)GC_is_visible(p) = GC_is_valid_displacement(q))
+# endif
+#else /* !GC_DEBUG */
+#   define GC_PTR_STORE(p, q) *((p) = (q))
+#endif
+
+/* Fynctions called to report pointer checking errors */
+GC_API void (*GC_same_obj_print_proc) GC_PROTO((GC_PTR p, GC_PTR q));
+
+GC_API void (*GC_is_valid_displacement_print_proc)
+	GC_PROTO((GC_PTR p));
+
+GC_API void (*GC_is_visible_print_proc)
+	GC_PROTO((GC_PTR p));
+
+#if defined(_SOLARIS_PTHREADS) && !defined(SOLARIS_THREADS)
+#   define SOLARIS_THREADS
+#endif
+
+#ifdef SOLARIS_THREADS
+/* We need to intercept calls to many of the threads primitives, so 	*/
+/* that we can locate thread stacks and stop the world.			*/
+/* Note also that the collector cannot see thread specific data.	*/
+/* Thread specific data should generally consist of pointers to		*/
+/* uncollectable objects, which are deallocated using the destructor	*/
+/* facility in thr_keycreate.						*/
+# include <thread.h>
+# include <signal.h>
+  int GC_thr_create(void *stack_base, size_t stack_size,
+                    void *(*start_routine)(void *), void *arg, long flags,
+                    thread_t *new_thread);
+  int GC_thr_join(thread_t wait_for, thread_t *departed, void **status);
+  int GC_thr_suspend(thread_t target_thread);
+  int GC_thr_continue(thread_t target_thread);
+  void * GC_dlopen(const char *path, int mode);
+
+# ifdef _SOLARIS_PTHREADS
+#   include <pthread.h>
+    extern int GC_pthread_create(pthread_t *new_thread,
+    			         const pthread_attr_t *attr,
+          			 void * (*thread_execp)(void *), void *arg);
+    extern int GC_pthread_join(pthread_t wait_for, void **status);
+
+#   undef thread_t
+
+#   define pthread_join GC_pthread_join
+#   define pthread_create GC_pthread_create
+#endif
+
+# define thr_create GC_thr_create
+# define thr_join GC_thr_join
+# define thr_suspend GC_thr_suspend
+# define thr_continue GC_thr_continue
+# define dlopen GC_dlopen
+
+# endif /* SOLARIS_THREADS */
+
+
+#if !defined(USE_LD_WRAP) && \
+    (defined(IRIX_THREADS) || defined(LINUX_THREADS) || defined(HPUX_THREADS))
+/* We treat these similarly. */
+# include <pthread.h>
+# include <signal.h>
+
+  int GC_pthread_create(pthread_t *new_thread,
+                        const pthread_attr_t *attr,
+		        void *(*start_routine)(void *), void *arg);
+  int GC_pthread_sigmask(int how, const sigset_t *set, sigset_t *oset);
+  int GC_pthread_join(pthread_t thread, void **retval);
+
+# define pthread_create GC_pthread_create
+# define pthread_sigmask GC_pthread_sigmask
+# define pthread_join GC_pthread_join
+# define dlopen GC_dlopen
+
+#endif /* xxxxx_THREADS */
+
+# if defined(PCR) || defined(SOLARIS_THREADS) || defined(WIN32_THREADS) || \
+	defined(IRIX_THREADS) || defined(LINUX_THREADS) || \
+	defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
+   	/* Any flavor of threads except SRC_M3.	*/
+/* This returns a list of objects, linked through their first		*/
+/* word.  Its use can greatly reduce lock contention problems, since	*/
+/* the allocation lock can be acquired and released many fewer times.	*/
+/* lb must be large enough to hold the pointer field.			*/
+GC_PTR GC_malloc_many(size_t lb);
+#define GC_NEXT(p) (*(GC_PTR *)(p)) 	/* Retrieve the next element	*/
+					/* in returned list.		*/
+extern void GC_thr_init();	/* Needed for Solaris/X86	*/
+
+#endif /* THREADS && !SRC_M3 */
+
+/*
+ * If you are planning on putting
+ * the collector in a SunOS 5 dynamic library, you need to call GC_INIT()
+ * from the statically loaded program section.
+ * This circumvents a Solaris 2.X (X<=4) linker bug.
+ */
+#if defined(sparc) || defined(__sparc)
+#   define GC_INIT() { extern end, etext; \
+		       GC_noop(&end, &etext); }
+#else
+# if defined(__CYGWIN32__) && defined(GC_USE_DLL)
+    /*
+     * Similarly gnu-win32 DLLs need explicit initialization
+     */
+#   define GC_INIT() { GC_add_roots(DATASTART, DATAEND); }
+# else
+#   define GC_INIT()
+# endif
+#endif
+
+#if (defined(_MSDOS) || defined(_MSC_VER)) && (_M_IX86 >= 300) \
+     || defined(_WIN32)
+  /* win32S may not free all resources on process exit.  */
+  /* This explicitly deallocates the heap.		 */
+    GC_API void GC_win32_free_heap ();
+#endif
+
+#ifdef __cplusplus
+    }  /* end of extern "C" */
+#endif
+
+#endif /* _GC_H */
diff --git a/src/gc/gc.mak b/src/gc/gc.mak
new file mode 100644
index 000000000..0fd22b70d
--- /dev/null
+++ b/src/gc/gc.mak
@@ -0,0 +1,2087 @@
+# Microsoft Developer Studio Generated NMAKE File, Format Version 4.10
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Application" 0x0101
+# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
+
+!IF "$(CFG)" == ""
+CFG=gctest - Win32 Release
+!MESSAGE No configuration specified.  Defaulting to cord - Win32 Debug.
+!ENDIF 
+
+!IF "$(CFG)" != "gc - Win32 Release" && "$(CFG)" != "gc - Win32 Debug" &&\
+ "$(CFG)" != "gctest - Win32 Release" && "$(CFG)" != "gctest - Win32 Debug" &&\
+ "$(CFG)" != "cord - Win32 Release" && "$(CFG)" != "cord - Win32 Debug"
+!MESSAGE Invalid configuration "$(CFG)" specified.
+!MESSAGE You can specify a configuration when running NMAKE on this makefile
+!MESSAGE by defining the macro CFG on the command line.  For example:
+!MESSAGE 
+!MESSAGE NMAKE /f "gc.mak" CFG="cord - Win32 Debug"
+!MESSAGE 
+!MESSAGE Possible choices for configuration are:
+!MESSAGE 
+!MESSAGE "gc - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "gc - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "gctest - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "gctest - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE "cord - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "cord - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE 
+!ERROR An invalid configuration is specified.
+!ENDIF 
+
+!IF "$(OS)" == "Windows_NT"
+NULL=
+!ELSE 
+NULL=nul
+!ENDIF 
+################################################################################
+# Begin Project
+# PROP Target_Last_Scanned "gctest - Win32 Debug"
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+OUTDIR=.\Release
+INTDIR=.\Release
+
+ALL : ".\Release\gc.dll" ".\Release\gc.bsc"
+
+CLEAN : 
+	-@erase ".\Release\allchblk.obj"
+	-@erase ".\Release\allchblk.sbr"
+	-@erase ".\Release\alloc.obj"
+	-@erase ".\Release\alloc.sbr"
+	-@erase ".\Release\blacklst.obj"
+	-@erase ".\Release\blacklst.sbr"
+	-@erase ".\Release\checksums.obj"
+	-@erase ".\Release\checksums.sbr"
+	-@erase ".\Release\dbg_mlc.obj"
+	-@erase ".\Release\dbg_mlc.sbr"
+	-@erase ".\Release\dyn_load.obj"
+	-@erase ".\Release\dyn_load.sbr"
+	-@erase ".\Release\finalize.obj"
+	-@erase ".\Release\finalize.sbr"
+	-@erase ".\Release\gc.bsc"
+	-@erase ".\Release\gc.dll"
+	-@erase ".\Release\gc.exp"
+	-@erase ".\Release\gc.lib"
+	-@erase ".\Release\headers.obj"
+	-@erase ".\Release\headers.sbr"
+	-@erase ".\Release\mach_dep.obj"
+	-@erase ".\Release\mach_dep.sbr"
+	-@erase ".\Release\malloc.obj"
+	-@erase ".\Release\malloc.sbr"
+	-@erase ".\Release\mallocx.obj"
+	-@erase ".\Release\mallocx.sbr"
+	-@erase ".\Release\mark.obj"
+	-@erase ".\Release\mark.sbr"
+	-@erase ".\Release\mark_rts.obj"
+	-@erase ".\Release\mark_rts.sbr"
+	-@erase ".\Release\misc.obj"
+	-@erase ".\Release\misc.sbr"
+	-@erase ".\Release\new_hblk.obj"
+	-@erase ".\Release\new_hblk.sbr"
+	-@erase ".\Release\obj_map.obj"
+	-@erase ".\Release\obj_map.sbr"
+	-@erase ".\Release\os_dep.obj"
+	-@erase ".\Release\os_dep.sbr"
+	-@erase ".\Release\ptr_chck.obj"
+	-@erase ".\Release\ptr_chck.sbr"
+	-@erase ".\Release\reclaim.obj"
+	-@erase ".\Release\reclaim.sbr"
+	-@erase ".\Release\stubborn.obj"
+	-@erase ".\Release\stubborn.sbr"
+	-@erase ".\Release\typd_mlc.obj"
+	-@erase ".\Release\typd_mlc.sbr"
+	-@erase ".\Release\win32_threads.obj"
+	-@erase ".\Release\win32_threads.sbr"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /D "NDEBUG" /D "SILENT" /D "GC_BUILD" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /D "NDEBUG" /D "SILENT" /D "GC_BUILD" /D\
+ "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D\
+ "WIN32_THREADS" /FR"$(INTDIR)/" /Fp"$(INTDIR)/gc.pch" /YX /Fo"$(INTDIR)/" /c 
+CPP_OBJS=.\Release/
+CPP_SBRS=.\Release/
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gc.bsc" 
+BSC32_SBRS= \
+	".\Release\allchblk.sbr" \
+	".\Release\alloc.sbr" \
+	".\Release\blacklst.sbr" \
+	".\Release\checksums.sbr" \
+	".\Release\dbg_mlc.sbr" \
+	".\Release\dyn_load.sbr" \
+	".\Release\finalize.sbr" \
+	".\Release\headers.sbr" \
+	".\Release\mach_dep.sbr" \
+	".\Release\malloc.sbr" \
+	".\Release\mallocx.sbr" \
+	".\Release\mark.sbr" \
+	".\Release\mark_rts.sbr" \
+	".\Release\misc.sbr" \
+	".\Release\new_hblk.sbr" \
+	".\Release\obj_map.sbr" \
+	".\Release\os_dep.sbr" \
+	".\Release\ptr_chck.sbr" \
+	".\Release\reclaim.sbr" \
+	".\Release\stubborn.sbr" \
+	".\Release\typd_mlc.sbr" \
+	".\Release\win32_threads.sbr"
+
+".\Release\gc.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+    $(BSC32) @<<
+  $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /dll /incremental:no\
+ /pdb:"$(OUTDIR)/gc.pdb" /machine:I386 /out:"$(OUTDIR)/gc.dll"\
+ /implib:"$(OUTDIR)/gc.lib" 
+LINK32_OBJS= \
+	".\Release\allchblk.obj" \
+	".\Release\alloc.obj" \
+	".\Release\blacklst.obj" \
+	".\Release\checksums.obj" \
+	".\Release\dbg_mlc.obj" \
+	".\Release\dyn_load.obj" \
+	".\Release\finalize.obj" \
+	".\Release\headers.obj" \
+	".\Release\mach_dep.obj" \
+	".\Release\malloc.obj" \
+	".\Release\mallocx.obj" \
+	".\Release\mark.obj" \
+	".\Release\mark_rts.obj" \
+	".\Release\misc.obj" \
+	".\Release\new_hblk.obj" \
+	".\Release\obj_map.obj" \
+	".\Release\os_dep.obj" \
+	".\Release\ptr_chck.obj" \
+	".\Release\reclaim.obj" \
+	".\Release\stubborn.obj" \
+	".\Release\typd_mlc.obj" \
+	".\Release\win32_threads.obj"
+
+".\Release\gc.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+OUTDIR=.\Debug
+INTDIR=.\Debug
+
+ALL : ".\Debug\gc.dll" ".\Debug\gc.bsc"
+
+CLEAN : 
+	-@erase ".\Debug\allchblk.obj"
+	-@erase ".\Debug\allchblk.sbr"
+	-@erase ".\Debug\alloc.obj"
+	-@erase ".\Debug\alloc.sbr"
+	-@erase ".\Debug\blacklst.obj"
+	-@erase ".\Debug\blacklst.sbr"
+	-@erase ".\Debug\checksums.obj"
+	-@erase ".\Debug\checksums.sbr"
+	-@erase ".\Debug\dbg_mlc.obj"
+	-@erase ".\Debug\dbg_mlc.sbr"
+	-@erase ".\Debug\dyn_load.obj"
+	-@erase ".\Debug\dyn_load.sbr"
+	-@erase ".\Debug\finalize.obj"
+	-@erase ".\Debug\finalize.sbr"
+	-@erase ".\Debug\gc.bsc"
+	-@erase ".\Debug\gc.dll"
+	-@erase ".\Debug\gc.exp"
+	-@erase ".\Debug\gc.lib"
+	-@erase ".\Debug\gc.map"
+	-@erase ".\Debug\gc.pdb"
+	-@erase ".\Debug\headers.obj"
+	-@erase ".\Debug\headers.sbr"
+	-@erase ".\Debug\mach_dep.obj"
+	-@erase ".\Debug\mach_dep.sbr"
+	-@erase ".\Debug\malloc.obj"
+	-@erase ".\Debug\malloc.sbr"
+	-@erase ".\Debug\mallocx.obj"
+	-@erase ".\Debug\mallocx.sbr"
+	-@erase ".\Debug\mark.obj"
+	-@erase ".\Debug\mark.sbr"
+	-@erase ".\Debug\mark_rts.obj"
+	-@erase ".\Debug\mark_rts.sbr"
+	-@erase ".\Debug\misc.obj"
+	-@erase ".\Debug\misc.sbr"
+	-@erase ".\Debug\new_hblk.obj"
+	-@erase ".\Debug\new_hblk.sbr"
+	-@erase ".\Debug\obj_map.obj"
+	-@erase ".\Debug\obj_map.sbr"
+	-@erase ".\Debug\os_dep.obj"
+	-@erase ".\Debug\os_dep.sbr"
+	-@erase ".\Debug\ptr_chck.obj"
+	-@erase ".\Debug\ptr_chck.sbr"
+	-@erase ".\Debug\reclaim.obj"
+	-@erase ".\Debug\reclaim.sbr"
+	-@erase ".\Debug\stubborn.obj"
+	-@erase ".\Debug\stubborn.sbr"
+	-@erase ".\Debug\typd_mlc.obj"
+	-@erase ".\Debug\typd_mlc.sbr"
+	-@erase ".\Debug\vc40.idb"
+	-@erase ".\Debug\vc40.pdb"
+	-@erase ".\Debug\win32_threads.obj"
+	-@erase ".\Debug\win32_threads.sbr"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "SILENT" /D "GC_BUILD" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "SILENT" /D "GC_BUILD"\
+ /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D\
+ "WIN32_THREADS" /FR"$(INTDIR)/" /Fp"$(INTDIR)/gc.pch" /YX /Fo"$(INTDIR)/"\
+ /Fd"$(INTDIR)/" /c 
+CPP_OBJS=.\Debug/
+CPP_SBRS=.\Debug/
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gc.bsc" 
+BSC32_SBRS= \
+	".\Debug\allchblk.sbr" \
+	".\Debug\alloc.sbr" \
+	".\Debug\blacklst.sbr" \
+	".\Debug\checksums.sbr" \
+	".\Debug\dbg_mlc.sbr" \
+	".\Debug\dyn_load.sbr" \
+	".\Debug\finalize.sbr" \
+	".\Debug\headers.sbr" \
+	".\Debug\mach_dep.sbr" \
+	".\Debug\malloc.sbr" \
+	".\Debug\mallocx.sbr" \
+	".\Debug\mark.sbr" \
+	".\Debug\mark_rts.sbr" \
+	".\Debug\misc.sbr" \
+	".\Debug\new_hblk.sbr" \
+	".\Debug\obj_map.sbr" \
+	".\Debug\os_dep.sbr" \
+	".\Debug\ptr_chck.sbr" \
+	".\Debug\reclaim.sbr" \
+	".\Debug\stubborn.sbr" \
+	".\Debug\typd_mlc.sbr" \
+	".\Debug\win32_threads.sbr"
+
+".\Debug\gc.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+    $(BSC32) @<<
+  $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /incremental:no /map /debug /machine:I386
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /dll /incremental:no\
+ /pdb:"$(OUTDIR)/gc.pdb" /map:"$(INTDIR)/gc.map" /debug /machine:I386\
+ /out:"$(OUTDIR)/gc.dll" /implib:"$(OUTDIR)/gc.lib" 
+LINK32_OBJS= \
+	".\Debug\allchblk.obj" \
+	".\Debug\alloc.obj" \
+	".\Debug\blacklst.obj" \
+	".\Debug\checksums.obj" \
+	".\Debug\dbg_mlc.obj" \
+	".\Debug\dyn_load.obj" \
+	".\Debug\finalize.obj" \
+	".\Debug\headers.obj" \
+	".\Debug\mach_dep.obj" \
+	".\Debug\malloc.obj" \
+	".\Debug\mallocx.obj" \
+	".\Debug\mark.obj" \
+	".\Debug\mark_rts.obj" \
+	".\Debug\misc.obj" \
+	".\Debug\new_hblk.obj" \
+	".\Debug\obj_map.obj" \
+	".\Debug\os_dep.obj" \
+	".\Debug\ptr_chck.obj" \
+	".\Debug\reclaim.obj" \
+	".\Debug\stubborn.obj" \
+	".\Debug\typd_mlc.obj" \
+	".\Debug\win32_threads.obj"
+
+".\Debug\gc.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "gctest\Release"
+# PROP BASE Intermediate_Dir "gctest\Release"
+# PROP BASE Target_Dir "gctest"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "gctest\Release"
+# PROP Intermediate_Dir "gctest\Release"
+# PROP Target_Dir "gctest"
+OUTDIR=.\gctest\Release
+INTDIR=.\gctest\Release
+
+ALL : "gc - Win32 Release" ".\Release\gctest.exe"
+
+CLEAN : 
+	-@erase ".\gctest\Release\test.obj"
+	-@erase ".\Release\gctest.exe"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D\
+ "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS"\
+ /Fp"$(INTDIR)/gctest.pch" /YX /Fo"$(INTDIR)/" /c 
+CPP_OBJS=.\gctest\Release/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gctest.bsc" 
+BSC32_SBRS= \
+	
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /out:"Release/gctest.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no\
+ /pdb:"$(OUTDIR)/gctest.pdb" /machine:I386 /out:"Release/gctest.exe" 
+LINK32_OBJS= \
+	".\gctest\Release\test.obj" \
+	".\Release\gc.lib"
+
+".\Release\gctest.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "gctest\Debug"
+# PROP BASE Intermediate_Dir "gctest\Debug"
+# PROP BASE Target_Dir "gctest"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "gctest\Debug"
+# PROP Intermediate_Dir "gctest\Debug"
+# PROP Target_Dir "gctest"
+OUTDIR=.\gctest\Debug
+INTDIR=.\gctest\Debug
+
+ALL : "gc - Win32 Debug" ".\Debug\gctest.exe" ".\gctest\Debug\gctest.bsc"
+
+CLEAN : 
+	-@erase ".\Debug\gctest.exe"
+	-@erase ".\gctest\Debug\gctest.bsc"
+	-@erase ".\gctest\Debug\gctest.map"
+	-@erase ".\gctest\Debug\gctest.pdb"
+	-@erase ".\gctest\Debug\test.obj"
+	-@erase ".\gctest\Debug\test.sbr"
+	-@erase ".\gctest\Debug\vc40.idb"
+	-@erase ".\gctest\Debug\vc40.pdb"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "WIN32" /D "_WINDOWS"\
+ /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "WIN32_THREADS" /FR"$(INTDIR)/"\
+ /Fp"$(INTDIR)/gctest.pch" /YX /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c 
+CPP_OBJS=.\gctest\Debug/
+CPP_SBRS=.\gctest\Debug/
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gctest.bsc" 
+BSC32_SBRS= \
+	".\gctest\Debug\test.sbr"
+
+".\gctest\Debug\gctest.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+    $(BSC32) @<<
+  $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /incremental:no /map /debug /machine:I386 /out:"Debug/gctest.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no\
+ /pdb:"$(OUTDIR)/gctest.pdb" /map:"$(INTDIR)/gctest.map" /debug /machine:I386\
+ /out:"Debug/gctest.exe" 
+LINK32_OBJS= \
+	".\Debug\gc.lib" \
+	".\gctest\Debug\test.obj"
+
+".\Debug\gctest.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "cord\Release"
+# PROP BASE Intermediate_Dir "cord\Release"
+# PROP BASE Target_Dir "cord"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "cord\Release"
+# PROP Intermediate_Dir "cord\Release"
+# PROP Target_Dir "cord"
+OUTDIR=.\cord\Release
+INTDIR=.\cord\Release
+
+ALL : "gc - Win32 Release" ".\Release\de.exe"
+
+CLEAN : 
+	-@erase ".\cord\Release\cordbscs.obj"
+	-@erase ".\cord\Release\cordxtra.obj"
+	-@erase ".\cord\Release\de.obj"
+	-@erase ".\cord\Release\de_win.obj"
+	-@erase ".\cord\Release\de_win.res"
+	-@erase ".\Release\de.exe"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /I "." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /I "." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D\
+ "ALL_INTERIOR_POINTERS" /Fp"$(INTDIR)/cord.pch" /YX /Fo"$(INTDIR)/" /c 
+CPP_OBJS=.\cord\Release/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+RSC_PROJ=/l 0x809 /fo"$(INTDIR)/de_win.res" /d "NDEBUG" 
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/cord.bsc" 
+BSC32_SBRS= \
+	
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /out:"Release/de.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no /pdb:"$(OUTDIR)/de.pdb"\
+ /machine:I386 /out:"Release/de.exe" 
+LINK32_OBJS= \
+	".\cord\Release\cordbscs.obj" \
+	".\cord\Release\cordxtra.obj" \
+	".\cord\Release\de.obj" \
+	".\cord\Release\de_win.obj" \
+	".\cord\Release\de_win.res" \
+	".\Release\gc.lib"
+
+".\Release\de.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "cord\Debug"
+# PROP BASE Intermediate_Dir "cord\Debug"
+# PROP BASE Target_Dir "cord"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "cord\Debug"
+# PROP Intermediate_Dir "cord\Debug"
+# PROP Target_Dir "cord"
+OUTDIR=.\cord\Debug
+INTDIR=.\cord\Debug
+
+ALL : "gc - Win32 Debug" ".\Debug\de.exe"
+
+CLEAN : 
+	-@erase ".\cord\Debug\cordbscs.obj"
+	-@erase ".\cord\Debug\cordxtra.obj"
+	-@erase ".\cord\Debug\de.obj"
+	-@erase ".\cord\Debug\de.pdb"
+	-@erase ".\cord\Debug\de_win.obj"
+	-@erase ".\cord\Debug\de_win.res"
+	-@erase ".\cord\Debug\vc40.idb"
+	-@erase ".\cord\Debug\vc40.pdb"
+	-@erase ".\Debug\de.exe"
+	-@erase ".\Debug\de.ilk"
+
+"$(OUTDIR)" :
+    if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /I "." /D "_DEBUG" /D "WIN32" /D\
+ "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /Fp"$(INTDIR)/cord.pch" /YX\
+ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c 
+CPP_OBJS=.\cord\Debug/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_OBJS)}.obj:
+   $(CPP) $(CPP_PROJ) $<  
+
+.c{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cpp{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+.cxx{$(CPP_SBRS)}.sbr:
+   $(CPP) $(CPP_PROJ) $<  
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32 
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+RSC_PROJ=/l 0x809 /fo"$(INTDIR)/de_win.res" /d "_DEBUG" 
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/cord.bsc" 
+BSC32_SBRS= \
+	
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /out:"Debug/de.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:yes\
+ /pdb:"$(OUTDIR)/de.pdb" /debug /machine:I386 /out:"Debug/de.exe" 
+LINK32_OBJS= \
+	".\cord\Debug\cordbscs.obj" \
+	".\cord\Debug\cordxtra.obj" \
+	".\cord\Debug\de.obj" \
+	".\cord\Debug\de_win.obj" \
+	".\cord\Debug\de_win.res" \
+	".\Debug\gc.lib"
+
+".\Debug\de.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+    $(LINK32) @<<
+  $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ENDIF 
+
+################################################################################
+# Begin Target
+
+# Name "gc - Win32 Release"
+# Name "gc - Win32 Debug"
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+!ENDIF 
+
+################################################################################
+# Begin Source File
+
+SOURCE=.\reclaim.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_RECLA=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_RECLA=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\reclaim.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Release\reclaim.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_RECLA=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_RECLA=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\reclaim.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Debug\reclaim.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\os_dep.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_OS_DE=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\STAT.H"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_OS_DE=\
+	".\il\PCR_IL.h"\
+	".\mm\PCR_MM.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	".\vd\PCR_VD.h"\
+	
+
+".\Release\os_dep.obj" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+".\Release\os_dep.sbr" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_OS_DE=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\STAT.H"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_OS_DE=\
+	".\il\PCR_IL.h"\
+	".\mm\PCR_MM.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	".\vd\PCR_VD.h"\
+	
+
+".\Debug\os_dep.obj" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+".\Debug\os_dep.sbr" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\misc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MISC_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MISC_=\
+	".\il\PCR_IL.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\misc.obj" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+".\Release\misc.sbr" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MISC_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MISC_=\
+	".\il\PCR_IL.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\misc.obj" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+".\Debug\misc.sbr" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mark_rts.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MARK_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MARK_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\mark_rts.obj" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+".\Release\mark_rts.sbr" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MARK_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MARK_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\mark_rts.obj" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+".\Debug\mark_rts.sbr" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mach_dep.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MACH_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MACH_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\mach_dep.obj" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+".\Release\mach_dep.sbr" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MACH_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MACH_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\mach_dep.obj" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+".\Debug\mach_dep.sbr" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\headers.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_HEADE=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_HEADE=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\headers.obj" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+".\Release\headers.sbr" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_HEADE=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_HEADE=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\headers.obj" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+".\Debug\headers.sbr" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\alloc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_ALLOC=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_ALLOC=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\alloc.obj" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+".\Release\alloc.sbr" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_ALLOC=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_ALLOC=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\alloc.obj" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+".\Debug\alloc.sbr" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\allchblk.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_ALLCH=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_ALLCH=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\allchblk.obj" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+".\Release\allchblk.sbr" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_ALLCH=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_ALLCH=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\allchblk.obj" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+".\Debug\allchblk.sbr" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\stubborn.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_STUBB=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_STUBB=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\stubborn.obj" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+".\Release\stubborn.sbr" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_STUBB=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_STUBB=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\stubborn.obj" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+".\Debug\stubborn.sbr" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\obj_map.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_OBJ_M=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_OBJ_M=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\obj_map.obj" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+".\Release\obj_map.sbr" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_OBJ_M=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_OBJ_M=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\obj_map.obj" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+".\Debug\obj_map.sbr" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\new_hblk.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_NEW_H=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_NEW_H=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\new_hblk.obj" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+".\Release\new_hblk.sbr" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_NEW_H=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_NEW_H=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\new_hblk.obj" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+".\Debug\new_hblk.sbr" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mark.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MARK_C=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MARK_C=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\mark.obj" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+".\Release\mark.sbr" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MARK_C=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MARK_C=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\mark.obj" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+".\Debug\mark.sbr" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\malloc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MALLO=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MALLO=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\malloc.obj" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+".\Release\malloc.sbr" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MALLO=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MALLO=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\malloc.obj" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+".\Debug\malloc.sbr" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mallocx.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MALLX=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MALLX=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\mallocx.obj" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+".\Release\mallocx.sbr" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MALLX=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_MALLX=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\mallocx.obj" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+".\Debug\mallocx.sbr" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\finalize.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_FINAL=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_FINAL=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\finalize.obj" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+".\Release\finalize.sbr" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_FINAL=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_FINAL=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\finalize.obj" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+".\Debug\finalize.sbr" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\dbg_mlc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_DBG_M=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_DBG_M=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\dbg_mlc.obj" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+".\Release\dbg_mlc.sbr" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_DBG_M=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_DBG_M=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\dbg_mlc.obj" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+".\Debug\dbg_mlc.sbr" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\blacklst.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_BLACK=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_BLACK=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\blacklst.obj" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+".\Release\blacklst.sbr" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_BLACK=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_BLACK=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\blacklst.obj" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+".\Debug\blacklst.sbr" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\typd_mlc.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_TYPD_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	".\gc_typed.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_TYPD_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\typd_mlc.obj" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+".\Release\typd_mlc.sbr" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_TYPD_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	".\gc_typed.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_TYPD_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\typd_mlc.obj" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+".\Debug\typd_mlc.sbr" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\ptr_chck.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_PTR_C=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_PTR_C=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\ptr_chck.obj" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+".\Release\ptr_chck.sbr" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_PTR_C=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_mark.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_PTR_C=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\ptr_chck.obj" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+".\Debug\ptr_chck.sbr" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\dyn_load.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_DYN_L=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\STAT.H"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_DYN_L=\
+	".\il\PCR_IL.h"\
+	".\mm\PCR_MM.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\dyn_load.obj" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+".\Release\dyn_load.sbr" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_DYN_L=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\STAT.H"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_DYN_L=\
+	".\il\PCR_IL.h"\
+	".\mm\PCR_MM.h"\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\dyn_load.obj" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+".\Debug\dyn_load.sbr" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\win32_threads.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_WIN32=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_WIN32=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\win32_threads.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+".\Release\win32_threads.sbr" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_WIN32=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_WIN32=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\win32_threads.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+".\Debug\win32_threads.sbr" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\checksums.c
+
+!IF  "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_CHECK=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_CHECK=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Release\checksums.obj" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+".\Release\checksums.sbr" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_CHECK=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_CHECK=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+".\Debug\checksums.obj" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+".\Debug\checksums.sbr" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+# End Target
+################################################################################
+# Begin Target
+
+# Name "gctest - Win32 Release"
+# Name "gctest - Win32 Debug"
+
+!IF  "$(CFG)" == "gctest - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Debug"
+
+!ENDIF 
+
+################################################################################
+# Begin Project Dependency
+
+# Project_Dep_Name "gc"
+
+!IF  "$(CFG)" == "gctest - Win32 Release"
+
+"gc - Win32 Release" : 
+   $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Release" 
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Debug"
+
+"gc - Win32 Debug" : 
+   $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Debug" 
+
+!ENDIF 
+
+# End Project Dependency
+################################################################################
+# Begin Source File
+
+SOURCE=.\test.c
+DEP_CPP_TEST_=\
+	".\gcconfig.h"\
+	".\gc.h"\
+	".\gc_hdrs.h"\
+	".\gc_priv.h"\
+	".\gc_typed.h"\
+	{$(INCLUDE)}"\sys\TYPES.H"\
+	
+NODEP_CPP_TEST_=\
+	".\th\PCR_Th.h"\
+	".\th\PCR_ThCrSec.h"\
+	".\th\PCR_ThCtl.h"\
+	
+
+!IF  "$(CFG)" == "gctest - Win32 Release"
+
+
+".\gctest\Release\test.obj" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+
+!ELSEIF  "$(CFG)" == "gctest - Win32 Debug"
+
+
+".\gctest\Debug\test.obj" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+".\gctest\Debug\test.sbr" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+
+!ENDIF 
+
+# End Source File
+# End Target
+################################################################################
+# Begin Target
+
+# Name "cord - Win32 Release"
+# Name "cord - Win32 Debug"
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+!ENDIF 
+
+################################################################################
+# Begin Project Dependency
+
+# Project_Dep_Name "gc"
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+"gc - Win32 Release" : 
+   $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Release" 
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+"gc - Win32 Debug" : 
+   $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Debug" 
+
+!ENDIF 
+
+# End Project Dependency
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de_win.c
+DEP_CPP_DE_WI=\
+	".\cord\cord.h"\
+	".\cord\de_cmds.h"\
+	".\cord\de_win.h"\
+	".\cord\private\cord_pos.h"\
+	
+NODEP_CPP_DE_WI=\
+	".\cord\gc.h"\
+	
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de_win.obj" : $(SOURCE) $(DEP_CPP_DE_WI) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de_win.obj" : $(SOURCE) $(DEP_CPP_DE_WI) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de.c
+DEP_CPP_DE_C2e=\
+	".\cord\cord.h"\
+	".\cord\de_cmds.h"\
+	".\cord\de_win.h"\
+	".\cord\private\cord_pos.h"\
+	
+NODEP_CPP_DE_C2e=\
+	".\cord\gc.h"\
+	
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de.obj" : $(SOURCE) $(DEP_CPP_DE_C2e) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de.obj" : $(SOURCE) $(DEP_CPP_DE_C2e) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\cordxtra.c
+DEP_CPP_CORDX=\
+	".\cord\cord.h"\
+	".\cord\ec.h"\
+	".\cord\private\cord_pos.h"\
+	
+NODEP_CPP_CORDX=\
+	".\cord\gc.h"\
+	
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\cordxtra.obj" : $(SOURCE) $(DEP_CPP_CORDX) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\cordxtra.obj" : $(SOURCE) $(DEP_CPP_CORDX) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\cordbscs.c
+DEP_CPP_CORDB=\
+	".\cord\cord.h"\
+	".\cord\private\cord_pos.h"\
+	
+NODEP_CPP_CORDB=\
+	".\cord\gc.h"\
+	
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\cordbscs.obj" : $(SOURCE) $(DEP_CPP_CORDB) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\cordbscs.obj" : $(SOURCE) $(DEP_CPP_CORDB) "$(INTDIR)"
+   $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de_win.RC
+
+!IF  "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de_win.res" : $(SOURCE) "$(INTDIR)"
+   $(RSC) /l 0x809 /fo"$(INTDIR)/de_win.res" /i "cord" /d "NDEBUG" $(SOURCE)
+
+
+!ELSEIF  "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de_win.res" : $(SOURCE) "$(INTDIR)"
+   $(RSC) /l 0x809 /fo"$(INTDIR)/de_win.res" /i "cord" /d "_DEBUG" $(SOURCE)
+
+
+!ENDIF 
+
+# End Source File
+# End Target
+# End Project
+################################################################################
diff --git a/src/gc/gc.man b/src/gc/gc.man
new file mode 100644
index 000000000..5409e7065
--- /dev/null
+++ b/src/gc/gc.man
@@ -0,0 +1,80 @@
+.TH GC_MALLOC 1L "12 February 1996"
+.SH NAME
+GC_malloc, GC_malloc_atomic, GC_free, GC_realloc, GC_enable_incremental, GC_register_finalizer, GC_malloc_ignore_off_page, GC_malloc_atomic_ignore_off_page, GC_set_warn_proc \- Garbage collecting malloc replacement
+.SH SYNOPSIS
+#include "gc.h"
+.br
+# define malloc(n) GC_malloc(n)
+.br
+... malloc(...) ...
+.br
+.sp
+cc ... gc.a
+.LP
+.SH DESCRIPTION
+.I GC_malloc
+and
+.I GC_free
+are plug-in replacements for standard malloc and free.  However,
+.I
+GC_malloc
+will attempt to reclaim inaccessible space automatically by invoking a conservative garbage collector at appropriate points.  The collector traverses all data structures accessible by following pointers from the machines registers, stack(s), data, and bss segments.  Inaccessible structures will be reclaimed.  A machine word is considered to be a valid pointer if it is an address inside an object allocated by
+.I
+GC_malloc
+or friends.
+.LP
+See the documentation in the include file gc_cpp.h for an alternate, C++ specific interface to the garbage collector.
+.LP
+Unlike the standard implementations of malloc,
+.I
+GC_malloc
+clears the newly allocated storage.
+.I
+GC_malloc_atomic
+does not.  Furthermore, it informs the collector that the resulting object will never contain any pointers, and should therefore not be scanned by the collector.
+.LP
+.I
+GC_free
+can be used to deallocate objects, but its use is optional, and generally discouraged.
+.I
+GC_realloc
+has the standard realloc semantics.  It preserves pointer-free-ness.
+.I
+GC_register_finalizer
+allows for registration of functions that are invoked when an object becomes inaccessible.
+.LP
+The garbage collector tries to avoid allocating memory at locations that already appear to be referenced before allocation.  (Such apparent ``pointers'' are usually large integers and the like that just happen to look like an address.)  This may make it hard to allocate very large objects.  An attempt to do so may generate a warning.
+.LP
+.I
+GC_malloc_ignore_off_page
+and
+.I
+GC_malloc_atomic_ignore_off_page
+inform the collector that the client code will always maintain a pointer to near the beginning of the object (within the first 512 bytes), and that pointers beyond that can be ignored by the collector.  This makes it much easier for the collector to place large objects.  These are recommended for large object allocation.  (Objects expected to be larger than about 100KBytes should be allocated this way.)
+.LP
+It is also possible to use the collector to find storage leaks in programs destined to be run with standard malloc/free.  The collector can be compiled for thread-safe operation.  Unlike standard malloc, it is safe to call malloc after a previous malloc call was interrupted by a signal, provided the original malloc call is not resumed.
+.LP
+The collector may, on rare occasion produce warning messages.  On UNIX machines these appear on stderr.  Warning messages can be filtered, redirected, or ignored with
+.I
+GC_set_warn_proc.
+This is recommended for production code.  See gc.h for details.
+.LP
+Debugging versions of many of the above routines are provided as macros.  Their names are identical to the above, but consist of all capital letters.  If GC_DEBUG is defined before gc.h is included, these routines do additional checking, and allow the leak detecting version of the collector to produce slightly more useful output.  Without GC_DEBUG defined, they behave exactly like the lower-case versions.
+.LP
+On some machines, collection will be performed incrementally after a call to
+.I
+GC_enable_incremental.
+This may temporarily write protect pages in the heap.  See the README file for more information on how this interacts with system calls that write to the heap.
+.LP
+Other facilities not discussed here include limited facilities to support incremental collection on machines without appropriate VM support, provisions for providing more explicit object layout information to the garbage collector, more direct support for ``weak'' pointers, support for ``abortable'' garbage collections during idle time, etc.
+.LP
+.SH "SEE ALSO"
+The README and gc.h files in the distribution.  More detailed definitions of the functions exported by the collector are given there.  (The above list is not complete.)
+.LP
+Boehm, H., and M. Weiser, "Garbage Collection in an Uncooperative Environment",
+\fISoftware Practice & Experience\fP, September 1988, pp. 807-820.
+.LP
+The malloc(3) man page.
+.LP
+.SH AUTHOR
+Hans-J. Boehm (boehm@parc.xerox.com).  Some of the code was written by others, most notably Alan Demers.
diff --git a/src/gc/gc_alloc.h b/src/gc/gc_alloc.h
new file mode 100644
index 000000000..1f1d54aff
--- /dev/null
+++ b/src/gc/gc_alloc.h
@@ -0,0 +1,380 @@
+/*
+ * Copyright (c) 1996-1998 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+//
+// This is a C++ header file that is intended to replace the SGI STL
+// alloc.h.  This assumes SGI STL version < 3.0.
+//
+// This assumes the collector has been compiled with -DATOMIC_UNCOLLECTABLE
+// and -DALL_INTERIOR_POINTERS.  We also recommend
+// -DREDIRECT_MALLOC=GC_uncollectable_malloc.
+//
+// Some of this could be faster in the explicit deallocation case.  In particular,
+// we spend too much time clearing objects on the free lists.  That could be avoided.
+//
+// This uses template classes with static members, and hence does not work
+// with g++ 2.7.2 and earlier.
+//
+
+#include "gc.h"
+
+#ifndef GC_ALLOC_H
+
+#define GC_ALLOC_H
+#define __ALLOC_H	// Prevent inclusion of the default version.  Ugly.
+#define __SGI_STL_ALLOC_H
+#define __SGI_STL_INTERNAL_ALLOC_H
+
+#ifndef __ALLOC
+#   define __ALLOC alloc
+#endif
+
+#include <stddef.h>
+#include <string.h>
+
+// The following is just replicated from the conventional SGI alloc.h:
+
+template<class T, class alloc>
+class simple_alloc {
+
+public:
+    static T *allocate(size_t n)
+                { return 0 == n? 0 : (T*) alloc::allocate(n * sizeof (T)); }
+    static T *allocate(void)
+                { return (T*) alloc::allocate(sizeof (T)); }
+    static void deallocate(T *p, size_t n)
+                { if (0 != n) alloc::deallocate(p, n * sizeof (T)); }
+    static void deallocate(T *p)
+                { alloc::deallocate(p, sizeof (T)); }
+};
+
+#include "gc.h"
+
+// The following need to match collector data structures.
+// We can't include gc_priv.h, since that pulls in way too much stuff.
+// This should eventually be factored out into another include file.
+
+extern "C" {
+    extern void ** const GC_objfreelist_ptr;
+    extern void ** const GC_aobjfreelist_ptr;
+    extern void ** const GC_uobjfreelist_ptr;
+    extern void ** const GC_auobjfreelist_ptr;
+
+    extern void GC_incr_words_allocd(size_t words);
+    extern void GC_incr_mem_freed(size_t words);
+
+    extern char * GC_generic_malloc_words_small(size_t word, int kind);
+}
+
+// Object kinds; must match PTRFREE, NORMAL, UNCOLLECTABLE, and
+// AUNCOLLECTABLE in gc_priv.h.
+
+enum { GC_PTRFREE = 0, GC_NORMAL = 1, GC_UNCOLLECTABLE = 2,
+       GC_AUNCOLLECTABLE = 3 };
+
+enum { GC_max_fast_bytes = 255 };
+
+enum { GC_bytes_per_word = sizeof(char *) };
+
+enum { GC_byte_alignment = 8 };
+
+enum { GC_word_alignment = GC_byte_alignment/GC_bytes_per_word };
+
+inline void * &GC_obj_link(void * p)
+{   return *(void **)p;  }
+
+// Compute a number of words >= n+1 bytes.
+// The +1 allows for pointers one past the end.
+inline size_t GC_round_up(size_t n)
+{
+    return ((n + GC_byte_alignment)/GC_byte_alignment)*GC_word_alignment;
+}
+
+// The same but don't allow for extra byte.
+inline size_t GC_round_up_uncollectable(size_t n)
+{
+    return ((n + GC_byte_alignment - 1)/GC_byte_alignment)*GC_word_alignment;
+}
+
+template <int dummy>
+class GC_aux_template {
+public:
+  // File local count of allocated words.  Occasionally this is
+  // added into the global count.  A separate count is necessary since the
+  // real one must be updated with a procedure call.
+  static size_t GC_words_recently_allocd;
+
+  // Same for uncollectable mmory.  Not yet reflected in either
+  // GC_words_recently_allocd or GC_non_gc_bytes.
+  static size_t GC_uncollectable_words_recently_allocd;
+
+  // Similar counter for explicitly deallocated memory.
+  static size_t GC_mem_recently_freed;
+
+  // Again for uncollectable memory.
+  static size_t GC_uncollectable_mem_recently_freed;
+
+  static void * GC_out_of_line_malloc(size_t nwords, int kind);
+};
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_mem_recently_freed = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_mem_recently_freed = 0;
+
+template <int dummy>
+void * GC_aux_template<dummy>::GC_out_of_line_malloc(size_t nwords, int kind)
+{
+    GC_words_recently_allocd += GC_uncollectable_words_recently_allocd;
+    GC_non_gc_bytes +=
+                GC_bytes_per_word * GC_uncollectable_words_recently_allocd;
+    GC_uncollectable_words_recently_allocd = 0;
+
+    GC_mem_recently_freed += GC_uncollectable_mem_recently_freed;
+    GC_non_gc_bytes -= 
+                GC_bytes_per_word * GC_uncollectable_mem_recently_freed;
+    GC_uncollectable_mem_recently_freed = 0;
+
+    GC_incr_words_allocd(GC_words_recently_allocd);
+    GC_words_recently_allocd = 0;
+
+    GC_incr_mem_freed(GC_mem_recently_freed);
+    GC_mem_recently_freed = 0;
+
+    return GC_generic_malloc_words_small(nwords, kind);
+}
+
+typedef GC_aux_template<0> GC_aux;
+
+// A fast, single-threaded, garbage-collected allocator
+// We assume the first word will be immediately overwritten.
+// In this version, deallocation is not a noop, and explicit
+// deallocation is likely to help performance.
+template <int dummy>
+class single_client_gc_alloc_template {
+    public:
+     	static void * allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc(n);
+	    flh = GC_objfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_NORMAL);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_words_recently_allocd += nwords;
+	    return op;
+        }
+     	static void * ptr_free_allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc_atomic(n);
+	    flh = GC_aobjfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_PTRFREE);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_words_recently_allocd += nwords;
+	    return op;
+        }
+	static void deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes)  {
+		GC_free(p);
+	    } else {
+	        flh = GC_objfreelist_ptr + nwords;
+	        GC_obj_link(p) = *flh;
+		memset((char *)p + GC_bytes_per_word, 0,
+		       GC_bytes_per_word * (nwords - 1));
+	        *flh = p;
+	        GC_aux::GC_mem_recently_freed += nwords;
+	    }
+	}
+	static void ptr_free_deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes) {
+		GC_free(p);
+	    } else {
+	    	flh = GC_aobjfreelist_ptr + nwords;
+	    	GC_obj_link(p) = *flh;
+	    	*flh = p;
+	    	GC_aux::GC_mem_recently_freed += nwords;
+	    }
+	}
+};
+
+typedef single_client_gc_alloc_template<0> single_client_gc_alloc;
+
+// Once more, for uncollectable objects.
+template <int dummy>
+class single_client_alloc_template {
+    public:
+     	static void * allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up_uncollectable(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc_uncollectable(n);
+	    flh = GC_uobjfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_UNCOLLECTABLE);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+	    return op;
+        }
+     	static void * ptr_free_allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up_uncollectable(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc_atomic_uncollectable(n);
+	    flh = GC_auobjfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_AUNCOLLECTABLE);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+	    return op;
+        }
+	static void deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up_uncollectable(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes)  {
+		GC_free(p);
+	    } else {
+	        flh = GC_uobjfreelist_ptr + nwords;
+	        GC_obj_link(p) = *flh;
+	        *flh = p;
+	        GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+	    }
+	}
+	static void ptr_free_deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up_uncollectable(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes) {
+		GC_free(p);
+	    } else {
+	    	flh = GC_auobjfreelist_ptr + nwords;
+	    	GC_obj_link(p) = *flh;
+	    	*flh = p;
+	    	GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+	    }
+	}
+};
+
+typedef single_client_alloc_template<0> single_client_alloc;
+
+template < int dummy >
+class gc_alloc_template {
+    public:
+     	static void * allocate(size_t n) { return GC_malloc(n); }
+     	static void * ptr_free_allocate(size_t n)
+		{ return GC_malloc_atomic(n); }
+	static void deallocate(void *, size_t) { }
+	static void ptr_free_deallocate(void *, size_t) { }
+};
+
+typedef gc_alloc_template < 0 > gc_alloc;
+
+template < int dummy >
+class alloc_template {
+    public:
+     	static void * allocate(size_t n) { return GC_malloc_uncollectable(n); }
+     	static void * ptr_free_allocate(size_t n)
+		{ return GC_malloc_atomic_uncollectable(n); }
+	static void deallocate(void *p, size_t) { GC_free(p); }
+	static void ptr_free_deallocate(void *p, size_t) { GC_free(p); }
+};
+
+typedef alloc_template < 0 > alloc;
+
+#ifdef _SGI_SOURCE
+
+// We want to specialize simple_alloc so that it does the right thing
+// for all pointerfree types.  At the moment there is no portable way to
+// even approximate that.  The following approximation should work for
+// SGI compilers, and perhaps some others.
+
+# define __GC_SPECIALIZE(T,alloc) \
+class simple_alloc<T, alloc> { \
+public: \
+    static T *allocate(size_t n) \
+	{ return 0 == n? 0 : \
+			 (T*) alloc::ptr_free_allocate(n * sizeof (T)); } \
+    static T *allocate(void) \
+	{ return (T*) alloc::ptr_free_allocate(sizeof (T)); } \
+    static void deallocate(T *p, size_t n) \
+	{ if (0 != n) alloc::ptr_free_deallocate(p, n * sizeof (T)); } \
+    static void deallocate(T *p) \
+	{ alloc::ptr_free_deallocate(p, sizeof (T)); } \
+};
+
+__GC_SPECIALIZE(char, gc_alloc)
+__GC_SPECIALIZE(int, gc_alloc)
+__GC_SPECIALIZE(unsigned, gc_alloc)
+__GC_SPECIALIZE(float, gc_alloc)
+__GC_SPECIALIZE(double, gc_alloc)
+
+__GC_SPECIALIZE(char, alloc)
+__GC_SPECIALIZE(int, alloc)
+__GC_SPECIALIZE(unsigned, alloc)
+__GC_SPECIALIZE(float, alloc)
+__GC_SPECIALIZE(double, alloc)
+
+__GC_SPECIALIZE(char, single_client_gc_alloc)
+__GC_SPECIALIZE(int, single_client_gc_alloc)
+__GC_SPECIALIZE(unsigned, single_client_gc_alloc)
+__GC_SPECIALIZE(float, single_client_gc_alloc)
+__GC_SPECIALIZE(double, single_client_gc_alloc)
+
+__GC_SPECIALIZE(char, single_client_alloc)
+__GC_SPECIALIZE(int, single_client_alloc)
+__GC_SPECIALIZE(unsigned, single_client_alloc)
+__GC_SPECIALIZE(float, single_client_alloc)
+__GC_SPECIALIZE(double, single_client_alloc)
+
+#ifdef __STL_USE_STD_ALLOCATORS
+
+???copy stuff from stl_alloc.h or remove it to a different file ???
+
+#endif /* __STL_USE_STD_ALLOCATORS */
+
+#endif /* _SGI_SOURCE */
+
+#endif /* GC_ALLOC_H */
diff --git a/src/gc/gc_cpp.cc b/src/gc/gc_cpp.cc
new file mode 100644
index 000000000..547c56f96
--- /dev/null
+++ b/src/gc/gc_cpp.cc
@@ -0,0 +1,60 @@
+/*************************************************************************
+Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+    Last modified on Sat Nov 19 19:31:14 PST 1994 by ellis
+                  on Sat Jun  8 15:10:00 PST 1994 by boehm
+
+Permission is hereby granted to copy this code for any purpose,
+provided the above notices are retained on all copies.
+
+This implementation module for gc_c++.h provides an implementation of
+the global operators "new" and "delete" that calls the Boehm
+allocator.  All objects allocated by this implementation will be
+non-collectable but part of the root set of the collector.
+
+You should ensure (using implementation-dependent techniques) that the
+linker finds this module before the library that defines the default
+built-in "new" and "delete".
+
+Authors: John R. Ellis and Jesse Hull
+
+**************************************************************************/
+/* Boehm, December 20, 1994 7:26 pm PST */
+
+#include "gc_cpp.h"
+
+void* operator new( size_t size ) {
+    return GC_MALLOC_UNCOLLECTABLE( size );}
+  
+void operator delete( void* obj ) {
+    GC_FREE( obj );}
+  
+#ifdef _MSC_VER
+// This new operator is used by VC++ in case of Debug builds !
+void* operator new( size_t size,
+                    int ,//nBlockUse,
+                    const char * szFileName,
+                    int nLine
+                    ) {
+# ifndef GC_DEBUG
+    return GC_malloc_uncollectable( size );
+# else
+    return GC_debug_malloc_uncollectable(size, szFileName, nLine);
+# endif
+}
+#endif
+
+#ifdef OPERATOR_NEW_ARRAY
+
+void* operator new[]( size_t size ) {
+    return GC_MALLOC_UNCOLLECTABLE( size );}
+  
+void operator delete[]( void* obj ) {
+    GC_FREE( obj );}
+
+#endif /* OPERATOR_NEW_ARRAY */
+
+
diff --git a/src/gc/gc_cpp.h b/src/gc/gc_cpp.h
new file mode 100644
index 000000000..3b86824cf
--- /dev/null
+++ b/src/gc/gc_cpp.h
@@ -0,0 +1,310 @@
+#ifndef GC_CPP_H
+#define GC_CPP_H
+/****************************************************************************
+Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+Permission is hereby granted to use or copy this program for any
+purpose, provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is
+granted, provided the above notices are retained, and a notice that
+the code was modified is included with the above copyright notice.
+****************************************************************************
+
+C++ Interface to the Boehm Collector
+
+    John R. Ellis and Jesse Hull 
+
+This interface provides access to the Boehm collector.  It provides
+basic facilities similar to those described in "Safe, Efficient
+Garbage Collection for C++", by John R. Elis and David L. Detlefs
+(ftp://ftp.parc.xerox.com/pub/ellis/gc).
+
+All heap-allocated objects are either "collectable" or
+"uncollectable".  Programs must explicitly delete uncollectable
+objects, whereas the garbage collector will automatically delete
+collectable objects when it discovers them to be inaccessible.
+Collectable objects may freely point at uncollectable objects and vice
+versa.
+
+Objects allocated with the built-in "::operator new" are uncollectable.
+
+Objects derived from class "gc" are collectable.  For example:
+
+    class A: public gc {...};
+    A* a = new A;       // a is collectable. 
+
+Collectable instances of non-class types can be allocated using the GC
+(or UseGC) placement:
+
+    typedef int A[ 10 ];
+    A* a = new (GC) A;
+
+Uncollectable instances of classes derived from "gc" can be allocated
+using the NoGC placement:
+
+    class A: public gc {...};
+    A* a = new (NoGC) A;   // a is uncollectable.
+
+Both uncollectable and collectable objects can be explicitly deleted
+with "delete", which invokes an object's destructors and frees its
+storage immediately.
+
+A collectable object may have a clean-up function, which will be
+invoked when the collector discovers the object to be inaccessible.
+An object derived from "gc_cleanup" or containing a member derived
+from "gc_cleanup" has a default clean-up function that invokes the
+object's destructors.  Explicit clean-up functions may be specified as
+an additional placement argument:
+
+    A* a = ::new (GC, MyCleanup) A;
+
+An object is considered "accessible" by the collector if it can be
+reached by a path of pointers from static variables, automatic
+variables of active functions, or from some object with clean-up
+enabled; pointers from an object to itself are ignored.
+
+Thus, if objects A and B both have clean-up functions, and A points at
+B, B is considered accessible.  After A's clean-up is invoked and its
+storage released, B will then become inaccessible and will have its
+clean-up invoked.  If A points at B and B points to A, forming a
+cycle, then that's considered a storage leak, and neither will be
+collectable.  See the interface gc.h for low-level facilities for
+handling such cycles of objects with clean-up.
+
+The collector cannot guarrantee that it will find all inaccessible
+objects.  In practice, it finds almost all of them.
+
+
+Cautions:
+
+1. Be sure the collector has been augmented with "make c++".
+
+2.  If your compiler supports the new "operator new[]" syntax, then
+add -DOPERATOR_NEW_ARRAY to the Makefile.
+
+If your compiler doesn't support "operator new[]", beware that an
+array of type T, where T is derived from "gc", may or may not be
+allocated as a collectable object (it depends on the compiler).  Use
+the explicit GC placement to make the array collectable.  For example:
+
+    class A: public gc {...};
+    A* a1 = new A[ 10 ];        // collectable or uncollectable?
+    A* a2 = new (GC) A[ 10 ];   // collectable
+
+3. The destructors of collectable arrays of objects derived from
+"gc_cleanup" will not be invoked properly.  For example:
+
+    class A: public gc_cleanup {...};
+    A* a = new (GC) A[ 10 ];    // destructors not invoked correctly
+
+Typically, only the destructor for the first element of the array will
+be invoked when the array is garbage-collected.  To get all the
+destructors of any array executed, you must supply an explicit
+clean-up function:
+
+    A* a = new (GC, MyCleanUp) A[ 10 ];
+
+(Implementing clean-up of arrays correctly, portably, and in a way
+that preserves the correct exception semantics requires a language
+extension, e.g. the "gc" keyword.)
+
+4. Compiler bugs:
+
+* Solaris 2's CC (SC3.0) doesn't implement t->~T() correctly, so the
+destructors of classes derived from gc_cleanup won't be invoked.
+You'll have to explicitly register a clean-up function with
+new-placement syntax.
+
+* Evidently cfront 3.0 does not allow destructors to be explicitly
+invoked using the ANSI-conforming syntax t->~T().  If you're using
+cfront 3.0, you'll have to comment out the class gc_cleanup, which
+uses explicit invocation.
+
+5. GC name conflicts:
+
+Many other systems seem to use the identifier "GC" as an abbreviation
+for "Graphics Context".  Since version 5.0, GC placement has been replaced
+by UseGC.  GC is an alias for UseGC, unless GC_NAME_CONFLICT is defined.
+
+****************************************************************************/
+
+#include "gc.h"
+
+#ifndef THINK_CPLUS
+#define _cdecl
+#endif
+
+#if ! defined( OPERATOR_NEW_ARRAY ) \
+    && (__BORLANDC__ >= 0x450 || (__GNUC__ >= 2 && __GNUC_MINOR__ >= 6) \
+        || __WATCOMC__ >= 1050 || _MSC_VER >= 1100)
+#   define OPERATOR_NEW_ARRAY
+#endif
+
+enum GCPlacement {UseGC,
+#ifndef GC_NAME_CONFLICT
+		  GC=UseGC,
+#endif
+                  NoGC, PointerFreeGC};
+
+class gc {public:
+    inline void* operator new( size_t size );
+    inline void* operator new( size_t size, GCPlacement gcp );
+    inline void operator delete( void* obj );
+
+#ifdef OPERATOR_NEW_ARRAY
+    inline void* operator new[]( size_t size );
+    inline void* operator new[]( size_t size, GCPlacement gcp );
+    inline void operator delete[]( void* obj );
+#endif /* OPERATOR_NEW_ARRAY */
+    };    
+    /*
+    Instances of classes derived from "gc" will be allocated in the 
+    collected heap by default, unless an explicit NoGC placement is
+    specified. */
+
+class gc_cleanup: virtual public gc {public:
+    inline gc_cleanup();
+    inline virtual ~gc_cleanup();
+private:
+    inline static void _cdecl cleanup( void* obj, void* clientData );};
+    /*
+    Instances of classes derived from "gc_cleanup" will be allocated
+    in the collected heap by default.  When the collector discovers an
+    inaccessible object derived from "gc_cleanup" or containing a
+    member derived from "gc_cleanup", its destructors will be
+    invoked. */
+
+extern "C" {typedef void (*GCCleanUpFunc)( void* obj, void* clientData );}
+
+inline void* operator new( 
+    size_t size, 
+    GCPlacement gcp,
+    GCCleanUpFunc cleanup = 0,
+    void* clientData = 0 );
+    /*
+    Allocates a collectable or uncollected object, according to the
+    value of "gcp".
+
+    For collectable objects, if "cleanup" is non-null, then when the
+    allocated object "obj" becomes inaccessible, the collector will
+    invoke the function "cleanup( obj, clientData )" but will not
+    invoke the object's destructors.  It is an error to explicitly
+    delete an object allocated with a non-null "cleanup".
+
+    It is an error to specify a non-null "cleanup" with NoGC or for
+    classes derived from "gc_cleanup" or containing members derived
+    from "gc_cleanup". */
+
+#ifdef OPERATOR_NEW_ARRAY
+
+#ifdef _MSC_VER
+ /** This ensures that the system default operator new[] doesn't get
+  *  undefined, which is what seems to happen on VC++ 6 for some reason
+  *  if we define a multi-argument operator new[].
+  */
+ inline void *operator new[]( size_t size )
+ {
+    return ::operator new( size );
+ }
+#endif /* _MSC_VER */
+
+inline void* operator new[](
+    size_t size, 
+    GCPlacement gcp,
+    GCCleanUpFunc cleanup = 0,
+    void* clientData = 0 );
+    /*
+    The operator new for arrays, identical to the above. */
+
+#endif /* OPERATOR_NEW_ARRAY */
+
+/****************************************************************************
+
+Inline implementation
+
+****************************************************************************/
+
+inline void* gc::operator new( size_t size ) {
+    return GC_MALLOC( size );}
+    
+inline void* gc::operator new( size_t size, GCPlacement gcp ) {
+    if (gcp == UseGC) 
+        return GC_MALLOC( size );
+    else if (gcp == PointerFreeGC)
+	return GC_MALLOC_ATOMIC( size );
+    else
+        return GC_MALLOC_UNCOLLECTABLE( size );}
+
+inline void gc::operator delete( void* obj ) {
+    GC_FREE( obj );}
+    
+
+#ifdef OPERATOR_NEW_ARRAY
+
+inline void* gc::operator new[]( size_t size ) {
+    return gc::operator new( size );}
+    
+inline void* gc::operator new[]( size_t size, GCPlacement gcp ) {
+    return gc::operator new( size, gcp );}
+
+inline void gc::operator delete[]( void* obj ) {
+    gc::operator delete( obj );}
+    
+#endif /* OPERATOR_NEW_ARRAY */
+
+
+inline gc_cleanup::~gc_cleanup() {
+    GC_REGISTER_FINALIZER_IGNORE_SELF( GC_base(this), 0, 0, 0, 0 );}
+
+inline void gc_cleanup::cleanup( void* obj, void* displ ) {
+    ((gc_cleanup*) ((char*) obj + (ptrdiff_t) displ))->~gc_cleanup();}
+
+inline gc_cleanup::gc_cleanup() {
+    GC_finalization_proc oldProc;
+    void* oldData;
+    void* base = GC_base( (void *) this );
+    if (0 != base)  {
+      GC_REGISTER_FINALIZER_IGNORE_SELF( 
+        base, (GC_finalization_proc)cleanup, (void*) ((char*) this - (char*) base), 
+        &oldProc, &oldData );
+      if (0 != oldProc) {
+        GC_REGISTER_FINALIZER_IGNORE_SELF( base, oldProc, oldData, 0, 0 );}}}
+
+inline void* operator new( 
+    size_t size, 
+    GCPlacement gcp,
+    GCCleanUpFunc cleanup,
+    void* clientData )
+{
+    void* obj;
+
+    if (gcp == UseGC) {
+        obj = GC_MALLOC( size );
+        if (cleanup != 0) 
+            GC_REGISTER_FINALIZER_IGNORE_SELF( 
+                obj, cleanup, clientData, 0, 0 );}
+    else if (gcp == PointerFreeGC) {
+        obj = GC_MALLOC_ATOMIC( size );}
+    else {
+        obj = GC_MALLOC_UNCOLLECTABLE( size );};
+    return obj;}
+        
+
+#ifdef OPERATOR_NEW_ARRAY
+
+inline void* operator new[]( 
+    size_t size, 
+    GCPlacement gcp,
+    GCCleanUpFunc cleanup,
+    void* clientData )
+{
+    return ::operator new( size, gcp, cleanup, clientData );}
+
+#endif /* OPERATOR_NEW_ARRAY */
+
+
+#endif /* GC_CPP_H */
+
diff --git a/src/gc/gc_hdrs.h b/src/gc/gc_hdrs.h
new file mode 100644
index 000000000..6966a9a1a
--- /dev/null
+++ b/src/gc/gc_hdrs.h
@@ -0,0 +1,303 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, July 11, 1995 11:54 am PDT */
+# ifndef GC_HEADERS_H
+# define GC_HEADERS_H
+typedef struct hblkhdr hdr;
+
+# if CPP_WORDSZ != 32 && CPP_WORDSZ < 36
+	--> Get a real machine.
+# endif
+
+/*
+ * The 2 level tree data structure that is used to find block headers.
+ * If there are more than 32 bits in a pointer, the top level is a hash
+ * table.
+ *
+ * This defines HDR, GET_HDR, and SET_HDR, the main macros used to
+ * retrieve and set object headers.  We also define some variants to
+ * retrieve 2 unrelated headers in interleaved fashion.  This
+ * slightly improves scheduling.
+ *
+ * Since 5.0 alpha 5, we can also take advantage of a header lookup
+ * cache.  This is a locally declared direct mapped cache, used inside
+ * the marker.  The HC_GET_HDR and HC_GET_HDR2 macros use and maintain this
+ * cache.  Assuming we get reasonable hit rates, this shaves a few
+ * memory references from each pointer validation.
+ */
+
+# if CPP_WORDSZ > 32
+#   define HASH_TL
+# endif
+
+/* Define appropriate out-degrees for each of the two tree levels	*/
+# ifdef SMALL_CONFIG
+#   define LOG_BOTTOM_SZ 11
+	/* Keep top index size reasonable with smaller blocks. */
+# else
+#   define LOG_BOTTOM_SZ 10
+# endif
+# ifndef HASH_TL
+#   define LOG_TOP_SZ (WORDSZ - LOG_BOTTOM_SZ - LOG_HBLKSIZE)
+# else
+#   define LOG_TOP_SZ 11
+# endif
+# define TOP_SZ (1 << LOG_TOP_SZ)
+# define BOTTOM_SZ (1 << LOG_BOTTOM_SZ)
+
+#ifndef SMALL_CONFIG
+# define USE_HDR_CACHE
+#endif
+
+/* #define COUNT_HDR_CACHE_HITS  */
+
+extern hdr * GC_invalid_header; /* header for an imaginary block 	*/
+				/* containing no objects.		*/
+
+
+/* Check whether p and corresponding hhdr point to long or invalid	*/
+/* object.  If so, advance them	to					*/
+/* beginning of	block, or set hhdr to GC_invalid_header.		*/
+#define ADVANCE(p, hhdr, source) \
+            if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) { \
+              p = GC_FIND_START(p, hhdr, (word)source); \
+              if (p == 0) { \
+		hhdr = GC_invalid_header; \
+	      } else { \
+                hhdr = GC_find_header(p); \
+	      } \
+    	    }
+
+#ifdef USE_HDR_CACHE
+
+# ifdef COUNT_HDR_CACHE_HITS
+    extern word GC_hdr_cache_hits;
+    extern word GC_hdr_cache_misses;
+#   define HC_HIT() ++GC_hdr_cache_hits
+#   define HC_MISS() ++GC_hdr_cache_misses
+# else
+#   define HC_HIT()
+#   define HC_MISS()
+# endif
+
+  typedef struct hce {
+    word block_addr;  	/* right shifted by LOG_HBLKSIZE */
+    hdr * hce_hdr;
+  } hdr_cache_entry;
+
+# define HDR_CACHE_SIZE 8  /* power of 2 */
+
+# define DECLARE_HDR_CACHE \
+	hdr_cache_entry hdr_cache[HDR_CACHE_SIZE]
+
+# define INIT_HDR_CACHE BZERO(hdr_cache, sizeof(hdr_cache));
+
+# define HCE(h) hdr_cache + (((word)(h) >> LOG_HBLKSIZE) & (HDR_CACHE_SIZE-1))
+
+# define HCE_VALID_FOR(hce,h) ((hce) -> block_addr == \
+				((word)(h) >> LOG_HBLKSIZE))
+
+# define HCE_HDR(h) ((hce) -> hce_hdr)
+
+
+/* Analogous to GET_HDR, except that in the case of large objects, it	*/
+/* Returns the header for the object beginning, and updates p.		*/
+/* Returns &GC_bad_header instead of 0.  All of this saves a branch	*/
+/* in the fast path.							*/
+# define HC_GET_HDR(p, hhdr, source) \
+	{ \
+	  hdr_cache_entry * hce = HCE(p); \
+	  if (HCE_VALID_FOR(hce, p)) { \
+	    HC_HIT(); \
+	    hhdr = hce -> hce_hdr; \
+	  } else { \
+	    HC_MISS(); \
+	    GET_HDR(p, hhdr); \
+	    ADVANCE(p, hhdr, source); \
+	    hce -> block_addr = (word)(p) >> LOG_HBLKSIZE; \
+	    hce -> hce_hdr = hhdr; \
+	  } \
+	}
+
+# define HC_GET_HDR2(p1, hhdr1, source1, p2, hhdr2, source2) \
+	{ \
+	  hdr_cache_entry * hce1 = HCE(p1); \
+	  hdr_cache_entry * hce2 = HCE(p2); \
+	  if (HCE_VALID_FOR(hce1, p1)) { \
+	    HC_HIT(); \
+	    hhdr1 = hce1 -> hce_hdr; \
+	  } else { \
+	    HC_MISS(); \
+	    GET_HDR(p1, hhdr1); \
+	    ADVANCE(p1, hhdr1, source1); \
+	    hce1 -> block_addr = (word)(p1) >> LOG_HBLKSIZE; \
+	    hce1 -> hce_hdr = hhdr1; \
+	  } \
+	  if (HCE_VALID_FOR(hce2, p2)) { \
+	    HC_HIT(); \
+	    hhdr2 = hce2 -> hce_hdr; \
+	  } else { \
+	    HC_MISS(); \
+	    GET_HDR(p2, hhdr2); \
+	    ADVANCE(p2, hhdr2, source2); \
+	    hce2 -> block_addr = (word)(p2) >> LOG_HBLKSIZE; \
+	    hce2 -> hce_hdr = hhdr2; \
+	  } \
+	}
+
+#else /* !USE_HDR_CACHE */
+
+# define DECLARE_HDR_CACHE
+
+# define INIT_HDR_CACHE
+
+# define HC_GET_HDR(p, hhdr, source) \
+	{ \
+	  GET_HDR(p, hhdr); \
+	  ADVANCE(p, hhdr, source); \
+	}
+
+# define HC_GET_HDR2(p1, hhdr1, source1, p2, hhdr2, source2) \
+	{ \
+	  GET_HDR2(p1, hhdr1, p2, hhdr2); \
+	  ADVANCE(p1, hhdr1, source1); \
+	  ADVANCE(p2, hhdr2, source2); \
+	}
+
+#endif
+
+typedef struct bi {
+    hdr * index[BOTTOM_SZ];
+	/*
+ 	 * The bottom level index contains one of three kinds of values:
+	 * 0 means we're not responsible for this block,
+	 *   or this is a block other than the first one in a free block.
+	 * 1 < (long)X <= MAX_JUMP means the block starts at least
+	 *        X * HBLKSIZE bytes before the current address.
+	 * A valid pointer points to a hdr structure. (The above can't be
+	 * valid pointers due to the GET_MEM return convention.)
+	 */
+    struct bi * asc_link;	/* All indices are linked in	*/
+    				/* ascending order...		*/
+    struct bi * desc_link;	/* ... and in descending order.	*/
+    word key;			/* high order address bits.	*/
+# ifdef HASH_TL
+    struct bi * hash_link;	/* Hash chain link.		*/
+# endif
+} bottom_index;
+
+/* extern bottom_index GC_all_nils; - really part of GC_arrays */
+
+/* extern bottom_index * GC_top_index []; - really part of GC_arrays */
+				/* Each entry points to a bottom_index.	*/
+				/* On a 32 bit machine, it points to 	*/
+				/* the index for a set of high order	*/
+				/* bits equal to the index.  For longer	*/
+				/* addresses, we hash the high order	*/
+				/* bits to compute the index in 	*/
+				/* GC_top_index, and each entry points	*/
+				/* to a hash chain.			*/
+				/* The last entry in each chain is	*/
+				/* GC_all_nils.				*/
+
+
+# define MAX_JUMP (HBLKSIZE - 1)
+
+# define HDR_FROM_BI(bi, p) \
+		((bi)->index[((word)(p) >> LOG_HBLKSIZE) & (BOTTOM_SZ - 1)])
+# ifndef HASH_TL
+#   define BI(p) (GC_top_index \
+		[(word)(p) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE)])
+#   define HDR_INNER(p) HDR_FROM_BI(BI(p),p)
+#   ifdef SMALL_CONFIG
+#	define HDR(p) GC_find_header((ptr_t)(p))
+#   else
+#	define HDR(p) HDR_INNER(p)
+#   endif
+#   define GET_BI(p, bottom_indx) (bottom_indx) = BI(p)
+#   define GET_HDR(p, hhdr) (hhdr) = HDR(p)
+#   define SET_HDR(p, hhdr) HDR_INNER(p) = (hhdr)
+#   define GET_HDR_ADDR(p, ha) (ha) = &(HDR_INNER(p))
+#   define GET_HDR2(p1, hhdr1, p2, hhdr2) \
+	{ GET_HDR(p1, hhdr1); GET_HDR(p2, hhdr2); }
+# else /* hash */
+/*  Hash function for tree top level */
+#   define TL_HASH(hi) ((hi) & (TOP_SZ - 1))
+/*  Set bottom_indx to point to the bottom index for address p */
+#   define GET_BI(p, bottom_indx) \
+	{ \
+	    register word hi = \
+	        (word)(p) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE); \
+	    register bottom_index * _bi = GC_top_index[TL_HASH(hi)]; \
+	    \
+	    while (_bi -> key != hi && _bi != GC_all_nils) \
+	    	_bi = _bi -> hash_link; \
+	    (bottom_indx) = _bi; \
+	}
+#   define GET_HDR_ADDR(p, ha) \
+	{ \
+	    register bottom_index * bi; \
+	    \
+	    GET_BI(p, bi);	\
+	    (ha) = &(HDR_FROM_BI(bi, p)); \
+	}
+#   define GET_HDR(p, hhdr) { register hdr ** _ha; GET_HDR_ADDR(p, _ha); \
+			      (hhdr) = *_ha; }
+#   define SET_HDR(p, hhdr) { register hdr ** _ha; GET_HDR_ADDR(p, _ha); \
+			      *_ha = (hhdr); }
+#   define HDR(p) GC_find_header((ptr_t)(p))
+    /* And some interleaved versions for two pointers at once.  	*/
+    /* This hopefully helps scheduling on processors like IA64.		*/
+#   define GET_BI2(p1, bottom_indx1, p2, bottom_indx2) \
+	{ \
+	    register word hi1 = \
+	        (word)(p1) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE); \
+	    register word hi2 = \
+	        (word)(p2) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE); \
+	    register bottom_index * _bi1 = GC_top_index[TL_HASH(hi1)]; \
+	    register bottom_index * _bi2 = GC_top_index[TL_HASH(hi2)]; \
+	    \
+	    while (_bi1 -> key != hi1 && _bi1 != GC_all_nils) \
+	    	_bi1 = _bi1 -> hash_link; \
+	    while (_bi2 -> key != hi2 && _bi2 != GC_all_nils) \
+	    	_bi2 = _bi2 -> hash_link; \
+	    (bottom_indx1) = _bi1; \
+	    (bottom_indx2) = _bi2; \
+	}
+#   define GET_HDR_ADDR2(p1, ha1, p2, ha2) \
+	{ \
+	    register bottom_index * bi1; \
+	    register bottom_index * bi2; \
+	    \
+	    GET_BI2(p1, bi1, p2, bi2);	\
+	    (ha1) = &(HDR_FROM_BI(bi1, p1)); \
+	    (ha2) = &(HDR_FROM_BI(bi2, p2)); \
+	}
+#   define GET_HDR2(p1, hhdr1, p2, hhdr2) \
+	{ register hdr ** _ha1;  \
+	  register hdr ** _ha2;  \
+	  GET_HDR_ADDR2(p1, _ha1, p2, _ha2); \
+	  (hhdr1) = *_ha1;  \
+	  (hhdr2) = *_ha2;  \
+	}
+# endif
+			    
+/* Is the result a forwarding address to someplace closer to the	*/
+/* beginning of the block or NIL?					*/
+# define IS_FORWARDING_ADDR_OR_NIL(hhdr) ((unsigned long) (hhdr) <= MAX_JUMP)
+
+/* Get an HBLKSIZE aligned address closer to the beginning of the block */
+/* h.  Assumes hhdr == HDR(h) and IS_FORWARDING_ADDR(hhdr).		*/
+# define FORWARDED_ADDR(h, hhdr) ((struct hblk *)(h) - (unsigned long)(hhdr))
+# endif /*  GC_HEADERS_H */
diff --git a/src/gc/gc_mark.h b/src/gc/gc_mark.h
new file mode 100644
index 000000000..3a4908fb9
--- /dev/null
+++ b/src/gc/gc_mark.h
@@ -0,0 +1,342 @@
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+/* Boehm, November 7, 1994 4:56 pm PST */
+
+/*
+ * Declarations of mark stack.  Needed by marker and client supplied mark
+ * routines.  To be included after gc_priv.h.
+ */
+#ifndef GC_MARK_H
+# define GC_MARK_H
+
+# ifdef KEEP_BACK_PTRS
+#   include "dbg_mlc.h"
+# endif
+
+/* A client supplied mark procedure.  Returns new mark stack pointer.	*/
+/* Primary effect should be to push new entries on the mark stack.	*/
+/* Mark stack pointer values are passed and returned explicitly.	*/
+/* Global variables decribing mark stack are not necessarily valid.	*/
+/* (This usually saves a few cycles by keeping things in registers.)	*/
+/* Assumed to scan about PROC_BYTES on average.  If it needs to do	*/
+/* much more work than that, it should do it in smaller pieces by	*/
+/* pushing itself back on the mark stack.				*/
+/* Note that it should always do some work (defined as marking some	*/
+/* objects) before pushing more than one entry on the mark stack.	*/
+/* This is required to ensure termination in the event of mark stack	*/
+/* overflows.								*/
+/* This procedure is always called with at least one empty entry on the */
+/* mark stack.								*/
+/* Currently we require that mark procedures look for pointers in a	*/
+/* subset of the places the conservative marker would.  It must be safe	*/
+/* to invoke the normal mark procedure instead.				*/
+# define PROC_BYTES 100
+/* The real declarations of the following are in gc_priv.h, so that	*/
+/* we can avoid scanning the following table.				*/
+/*
+typedef struct ms_entry * (*mark_proc)(   word * addr,
+					  struct ms_entry *mark_stack_ptr,
+					  struct ms_entry *mark_stack_limit,
+					  word env   );
+					  
+# define LOG_MAX_MARK_PROCS 6
+# define MAX_MARK_PROCS (1 << LOG_MAX_MARK_PROCS)
+extern mark_proc GC_mark_procs[MAX_MARK_PROCS];
+*/
+
+extern word GC_n_mark_procs;
+
+/* In a few cases it's necessary to assign statically known indices to	*/
+/* certain mark procs.  Thus we reserve a few for well known clients.	*/
+/* (This is necessary if mark descriptors are compiler generated.)	*/
+#define GC_RESERVED_MARK_PROCS 8
+#   define GCJ_RESERVED_MARK_PROC_INDEX 0
+
+/* Object descriptors on mark stack or in objects.  Low order two	*/
+/* bits are tags distinguishing among the following 4 possibilities	*/
+/* for the high order 30 bits.						*/
+#define DS_TAG_BITS 2
+#define DS_TAGS   ((1 << DS_TAG_BITS) - 1)
+#define DS_LENGTH 0	/* The entire word is a length in bytes that	*/
+			/* must be a multiple of 4.			*/
+#define DS_BITMAP 1	/* 30 bits are a bitmap describing pointer	*/
+			/* fields.  The msb is 1 iff the first word	*/
+			/* is a pointer.				*/
+			/* (This unconventional ordering sometimes	*/
+			/* makes the marker slightly faster.)		*/
+			/* Zeroes indicate definite nonpointers.  Ones	*/
+			/* indicate possible pointers.			*/
+			/* Only usable if pointers are word aligned.	*/
+#   define BITMAP_BITS (WORDSZ - DS_TAG_BITS)
+#define DS_PROC   2
+			/* The objects referenced by this object can be */
+			/* pushed on the mark stack by invoking		*/
+			/* PROC(descr).  ENV(descr) is passed as the	*/
+			/* last argument.				*/
+#   define PROC(descr) \
+		(GC_mark_procs[((descr) >> DS_TAG_BITS) & (MAX_MARK_PROCS-1)])
+#   define ENV(descr) \
+		((descr) >> (DS_TAG_BITS + LOG_MAX_MARK_PROCS))
+#   define MAX_ENV \
+  	      (((word)1 << (WORDSZ - DS_TAG_BITS - LOG_MAX_MARK_PROCS)) - 1)
+#   define MAKE_PROC(proc_index, env) \
+	    (((((env) << LOG_MAX_MARK_PROCS) | (proc_index)) << DS_TAG_BITS) \
+	    | DS_PROC)
+#define DS_PER_OBJECT 3	/* The real descriptor is at the		*/
+			/* byte displacement from the beginning of the	*/
+			/* object given by descr & ~DS_TAGS		*/
+			/* If the descriptor is negative, the real	*/
+			/* descriptor is at (*<object_start>) -		*/
+			/* (descr & ~DS_TAGS) - INDIR_PER_OBJ_BIAS	*/
+			/* The latter alternative can be used if each	*/
+			/* object contains a type descriptor in the	*/
+			/* first word.					*/
+#define INDIR_PER_OBJ_BIAS 0x10
+			
+typedef struct ms_entry {
+    word * mse_start;   /* First word of object */
+    word mse_descr;	/* Descriptor; low order two bits are tags,	*/
+    			/* identifying the upper 30 bits as one of the	*/
+    			/* following:					*/
+} mse;
+
+extern word GC_mark_stack_size;
+
+extern mse * GC_mark_stack_top;
+
+extern mse * GC_mark_stack;
+
+ptr_t GC_find_start();
+
+mse * GC_signal_mark_stack_overflow();
+
+# ifdef GATHERSTATS
+#   define ADD_TO_ATOMIC(sz) GC_atomic_in_use += (sz)
+#   define ADD_TO_COMPOSITE(sz) GC_composite_in_use += (sz)
+# else
+#   define ADD_TO_ATOMIC(sz)
+#   define ADD_TO_COMPOSITE(sz)
+# endif
+
+/* Push the object obj with corresponding heap block header hhdr onto 	*/
+/* the mark stack.							*/
+# define PUSH_OBJ(obj, hhdr, mark_stack_top, mark_stack_limit) \
+{ \
+    register word _descr = (hhdr) -> hb_descr; \
+        \
+    if (_descr == 0) { \
+    	ADD_TO_ATOMIC((hhdr) -> hb_sz); \
+    } else { \
+        ADD_TO_COMPOSITE((hhdr) -> hb_sz); \
+        mark_stack_top++; \
+        if (mark_stack_top >= mark_stack_limit) { \
+          mark_stack_top = GC_signal_mark_stack_overflow(mark_stack_top); \
+        } \
+        mark_stack_top -> mse_start = (obj); \
+        mark_stack_top -> mse_descr = _descr; \
+    } \
+}
+
+#ifdef PRINT_BLACK_LIST
+#   define GC_FIND_START(current, hhdr, source) \
+	GC_find_start(current, hhdr, source)
+#else
+#   define GC_FIND_START(current, hhdr, source) \
+	GC_find_start(current, hhdr)
+#endif
+
+/* Push the contents of current onto the mark stack if it is a valid	*/
+/* ptr to a currently unmarked object.  Mark it.			*/
+/* If we assumed a standard-conforming compiler, we could probably	*/
+/* generate the exit_label transparently.				*/
+# define PUSH_CONTENTS(current, mark_stack_top, mark_stack_limit, \
+		       source, exit_label) \
+{ \
+    hdr * my_hhdr; \
+    ptr_t my_current = current; \
+ \
+    GET_HDR(my_current, my_hhdr); \
+    if (IS_FORWARDING_ADDR_OR_NIL(my_hhdr)) { \
+         my_current = GC_FIND_START(my_current, my_hhdr, (word)source); \
+         if (my_current == 0) goto exit_label; \
+         my_hhdr = GC_find_header(my_current); \
+    } \
+    PUSH_CONTENTS_HDR(my_current, mark_stack_top, mark_stack_limit, \
+		  source, exit_label, my_hhdr);	\
+exit_label: ; \
+}
+
+/* As above, but use header cache for header lookup.	*/
+# define HC_PUSH_CONTENTS(current, mark_stack_top, mark_stack_limit, \
+		       source, exit_label) \
+{ \
+    hdr * my_hhdr; \
+    ptr_t my_current = current; \
+ \
+    HC_GET_HDR(my_current, my_hhdr, source); \
+    PUSH_CONTENTS_HDR(my_current, mark_stack_top, mark_stack_limit, \
+		  source, exit_label, my_hhdr);	\
+exit_label: ; \
+}
+
+/* As above, but deal with two pointers in interleaved fashion.	*/
+# define HC_PUSH_CONTENTS2(current1, current2, mark_stack_top, \
+			   mark_stack_limit, \
+		           source1, source2, exit_label1, exit_label2) \
+{ \
+    hdr * hhdr1; \
+    ptr_t my_current1 = current1; \
+    hdr * hhdr2; \
+    ptr_t my_current2 = current2; \
+ \
+    HC_GET_HDR2(my_current1, hhdr1, source1, my_current2, hhdr2, source2); \
+    PUSH_CONTENTS_HDR(my_current1, mark_stack_top, mark_stack_limit, \
+		  source1, exit_label1, hhdr1);	\
+exit_label1: ; \
+    if (0 != hhdr2) { \
+      PUSH_CONTENTS_HDR(my_current2, mark_stack_top, mark_stack_limit, \
+		  source2, exit_label2, hhdr2);	\
+    } \
+exit_label2: ; \
+}
+
+# define PUSH_CONTENTS_HDR(current, mark_stack_top, mark_stack_limit, \
+		           source, exit_label, hhdr) \
+{ \
+    int displ;  /* Displacement in block; first bytes, then words */ \
+    map_entry_type map_entry; \
+    \
+    displ = HBLKDISPL(current); \
+    map_entry = MAP_ENTRY((hhdr -> hb_map), displ); \
+    if (map_entry == OBJ_INVALID) { \
+        GC_ADD_TO_BLACK_LIST_NORMAL(current, source); goto exit_label; \
+    } \
+    displ = BYTES_TO_WORDS(displ); \
+    displ -= map_entry; \
+	\
+    { \
+        register word * mark_word_addr = hhdr -> hb_marks + divWORDSZ(displ); \
+        register word mark_word = *mark_word_addr; \
+        register word mark_bit = (word)1 << modWORDSZ(displ); \
+          \
+        if (mark_word & mark_bit) { \
+	      /* Mark bit is already set */ \
+	      goto exit_label; \
+        } \
+        GC_STORE_BACK_PTR((ptr_t)source, (ptr_t)HBLKPTR(current) \
+				      + WORDS_TO_BYTES(displ)); \
+        *mark_word_addr = mark_word | mark_bit; \
+    } \
+    PUSH_OBJ(((word *)(HBLKPTR(current)) + displ), hhdr, \
+    	     mark_stack_top, mark_stack_limit) \
+}
+
+#if defined(PRINT_BLACK_LIST) || defined(KEEP_BACK_PTRS)
+#   define PUSH_ONE_CHECKED(p, ip, source) \
+	GC_push_one_checked(p, ip, (ptr_t)(source))
+#else
+#   define PUSH_ONE_CHECKED(p, ip, source) \
+	GC_push_one_checked(p, ip)
+#endif
+
+/*
+ * Push a single value onto mark stack. Mark from the object pointed to by p.
+ * P is considered valid even if it is an interior pointer.
+ * Previously marked objects are not pushed.  Hence we make progress even
+ * if the mark stack overflows.
+ */
+# define GC_PUSH_ONE_STACK(p, source) \
+    if ((ptr_t)(p) >= GC_least_plausible_heap_addr 	\
+	 && (ptr_t)(p) < GC_greatest_plausible_heap_addr) {	\
+	 PUSH_ONE_CHECKED(p, TRUE, source);	\
+    }
+
+/*
+ * As above, but interior pointer recognition as for
+ * normal for heap pointers.
+ */
+# ifdef ALL_INTERIOR_POINTERS
+#   define AIP TRUE
+# else
+#   define AIP FALSE
+# endif
+# define GC_PUSH_ONE_HEAP(p,source) \
+    if ((ptr_t)(p) >= GC_least_plausible_heap_addr 	\
+	 && (ptr_t)(p) < GC_greatest_plausible_heap_addr) {	\
+	 PUSH_ONE_CHECKED(p,AIP,source);	\
+    }
+
+/*
+ * Mark from one finalizable object using the specified
+ * mark proc. May not mark the object pointed to by 
+ * real_ptr. That is the job of the caller, if appropriate
+ */
+# define GC_MARK_FO(real_ptr, mark_proc) \
+{ \
+    (*(mark_proc))(real_ptr); \
+    while (!GC_mark_stack_empty()) GC_mark_from_mark_stack(); \
+    if (GC_mark_state != MS_NONE) { \
+        GC_set_mark_bit(real_ptr); \
+        while (!GC_mark_some((ptr_t)0)); \
+    } \
+}
+
+extern GC_bool GC_mark_stack_too_small;
+				/* We need a larger mark stack.  May be	*/
+				/* set by client supplied mark routines.*/
+
+typedef int mark_state_t;	/* Current state of marking, as follows:*/
+				/* Used to remember where we are during */
+				/* concurrent marking.			*/
+
+				/* We say something is dirty if it was	*/
+				/* written since the last time we	*/
+				/* retrieved dirty bits.  We say it's 	*/
+				/* grungy if it was marked dirty in the	*/
+				/* last set of bits we retrieved.	*/
+				
+				/* Invariant I: all roots and marked	*/
+				/* objects p are either dirty, or point */
+				/* to objects q that are either marked 	*/
+				/* or a pointer to q appears in a range	*/
+				/* on the mark stack.			*/
+
+# define MS_NONE 0		/* No marking in progress. I holds.	*/
+				/* Mark stack is empty.			*/
+
+# define MS_PUSH_RESCUERS 1	/* Rescuing objects are currently 	*/
+				/* being pushed.  I holds, except	*/
+				/* that grungy roots may point to 	*/
+				/* unmarked objects, as may marked	*/
+				/* grungy objects above scan_ptr.	*/
+
+# define MS_PUSH_UNCOLLECTABLE 2
+				/* I holds, except that marked 		*/
+				/* uncollectable objects above scan_ptr */
+				/* may point to unmarked objects.	*/
+				/* Roots may point to unmarked objects	*/
+
+# define MS_ROOTS_PUSHED 3	/* I holds, mark stack may be nonempty  */
+
+# define MS_PARTIALLY_INVALID 4	/* I may not hold, e.g. because of M.S. */
+				/* overflow.  However marked heap	*/
+				/* objects below scan_ptr point to	*/
+				/* marked or stacked objects.		*/
+
+# define MS_INVALID 5		/* I may not hold.			*/
+
+extern mark_state_t GC_mark_state;
+
+#endif  /* GC_MARK_H */
+
diff --git a/src/gc/gc_priv.h b/src/gc/gc_priv.h
new file mode 100644
index 000000000..ce6858755
--- /dev/null
+++ b/src/gc/gc_priv.h
@@ -0,0 +1,1884 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, February 16, 1996 2:30 pm PST */
+ 
+
+# ifndef GC_PRIVATE_H
+# define GC_PRIVATE_H
+
+#if defined(mips) && defined(SYSTYPE_BSD) && defined(sony_news)
+    /* sony RISC NEWS, NEWSOS 4 */
+#   define BSD_TIME
+/*    typedef long ptrdiff_t;   -- necessary on some really old systems	*/
+#endif
+
+#if defined(mips) && defined(SYSTYPE_BSD43)
+    /* MIPS RISCOS 4 */
+#   define BSD_TIME
+#endif
+
+#ifdef BSD_TIME
+#   include <sys/types.h>
+#   include <sys/time.h>
+#   include <sys/resource.h>
+#endif /* BSD_TIME */
+
+# ifndef GC_H
+#   include "gc.h"
+# endif
+
+typedef GC_word word;
+typedef GC_signed_word signed_word;
+
+# ifndef GCCONFIG_H
+#   include "gcconfig.h"
+# endif
+
+# ifndef HEADERS_H
+#   include "gc_hdrs.h"
+# endif
+
+typedef int GC_bool;
+# define TRUE 1
+# define FALSE 0
+
+typedef char * ptr_t;	/* A generic pointer to which we can add	*/
+			/* byte displacements.				*/
+			/* Preferably identical to caddr_t, if it 	*/
+			/* exists.					*/
+			
+#if defined(__STDC__)
+#   include <stdlib.h>
+#   if !(defined( sony_news ) )
+#       include <stddef.h>
+#   endif
+#   define VOLATILE volatile
+#else
+#   ifdef MSWIN32
+#   	include <stdlib.h>
+#   endif
+#   define VOLATILE
+#endif
+
+#define CONST GC_CONST
+
+#if 0 /* was once defined for AMIGA */
+#   define GC_FAR __far
+#else
+#   define GC_FAR
+#endif
+
+
+/*********************************/
+/*                               */
+/* Definitions for conservative  */
+/* collector                     */
+/*                               */
+/*********************************/
+
+/*********************************/
+/*                               */
+/* Easily changeable parameters  */
+/*                               */
+/*********************************/
+
+#define STUBBORN_ALLOC	/* Define stubborn allocation primitives	*/
+#if defined(SRC_M3) || defined(SMALL_CONFIG)
+# undef STUBBORN_ALLOC
+#endif
+
+
+/* #define ALL_INTERIOR_POINTERS */
+		    /* Forces all pointers into the interior of an 	*/
+		    /* object to be considered valid.  Also causes the	*/
+		    /* sizes of all objects to be inflated by at least 	*/
+		    /* one byte.  This should suffice to guarantee	*/
+		    /* that in the presence of a compiler that does	*/
+		    /* not perform garbage-collector-unsafe		*/
+		    /* optimizations, all portable, strictly ANSI	*/
+		    /* conforming C programs should be safely usable	*/
+		    /* with malloc replaced by GC_malloc and free	*/
+		    /* calls removed.  There are several disadvantages: */
+		    /* 1. There are probably no interesting, portable,	*/
+		    /*    strictly ANSI	conforming C programs.		*/
+		    /* 2. This option makes it hard for the collector	*/
+		    /*    to allocate space that is not ``pointed to''  */
+		    /*    by integers, etc.  Under SunOS 4.X with a 	*/
+		    /*    statically linked libc, we empiricaly		*/
+		    /*    observed that it would be difficult to 	*/
+		    /*	  allocate individual objects larger than 100K.	*/
+		    /* 	  Even if only smaller objects are allocated,	*/
+		    /*    more swap space is likely to be needed.       */
+		    /*    Fortunately, much of this will never be	*/
+		    /*    touched.					*/
+		    /* If you can easily avoid using this option, do.	*/
+		    /* If not, try to keep individual objects small.	*/
+		    
+#define PRINTSTATS  /* Print garbage collection statistics          	*/
+		    /* For less verbose output, undefine in reclaim.c 	*/
+
+#define PRINTTIMES  /* Print the amount of time consumed by each garbage   */
+		    /* collection.                                         */
+
+#define PRINTBLOCKS /* Print object sizes associated with heap blocks,     */
+		    /* whether the objects are atomic or composite, and    */
+		    /* whether or not the block was found to be empty      */
+		    /* during the reclaim phase.  Typically generates       */
+		    /* about one screenful per garbage collection.         */
+#undef PRINTBLOCKS
+
+#ifdef SILENT
+#  ifdef PRINTSTATS
+#    undef PRINTSTATS
+#  endif
+#  ifdef PRINTTIMES
+#    undef PRINTTIMES
+#  endif
+#  ifdef PRINTNBLOCKS
+#    undef PRINTNBLOCKS
+#  endif
+#endif
+
+#if defined(PRINTSTATS) && !defined(GATHERSTATS)
+#   define GATHERSTATS
+#endif
+
+#ifdef FINALIZE_ON_DEMAND
+#   define GC_INVOKE_FINALIZERS()
+#else
+#   define GC_INVOKE_FINALIZERS() (void)GC_invoke_finalizers()
+#endif
+
+#define MERGE_SIZES /* Round up some object sizes, so that fewer distinct */
+		    /* free lists are actually maintained.  This applies  */
+		    /* only to the top level routines in misc.c, not to   */
+		    /* user generated code that calls GC_allocobj and     */
+		    /* GC_allocaobj directly.                             */
+		    /* Slows down average programs slightly.  May however */
+		    /* substantially reduce fragmentation if allocation   */
+		    /* request sizes are widely scattered.                */
+		    /* May save significant amounts of space for obj_map  */
+		    /* entries.						  */
+
+/* ALIGN_DOUBLE requires MERGE_SIZES at present. */
+# if defined(ALIGN_DOUBLE) && !defined(MERGE_SIZES)
+#   define MERGE_SIZES
+# endif
+
+#if defined(ALL_INTERIOR_POINTERS) && !defined(DONT_ADD_BYTE_AT_END)
+# define ADD_BYTE_AT_END
+#endif
+
+
+# ifndef LARGE_CONFIG
+#   define MINHINCR 16	/* Minimum heap increment, in blocks of HBLKSIZE  */
+			/* Must be multiple of largest page size.	  */
+#   define MAXHINCR 512	/* Maximum heap increment, in blocks              */
+# else
+#   define MINHINCR 64
+#   define MAXHINCR 4096
+# endif
+
+# define TIME_LIMIT 50	   /* We try to keep pause times from exceeding	 */
+			   /* this by much. In milliseconds.		 */
+
+# define BL_LIMIT GC_black_list_spacing
+			   /* If we need a block of N bytes, and we have */
+			   /* a block of N + BL_LIMIT bytes available, 	 */
+			   /* and N > BL_LIMIT,				 */
+			   /* but all possible positions in it are 	 */
+			   /* blacklisted, we just use it anyway (and	 */
+			   /* print a warning, if warnings are enabled). */
+			   /* This risks subsequently leaking the block	 */
+			   /* due to a false reference.  But not using	 */
+			   /* the block risks unreasonable immediate	 */
+			   /* heap growth.				 */
+
+/*********************************/
+/*                               */
+/* Stack saving for debugging	 */
+/*                               */
+/*********************************/
+
+#ifdef SAVE_CALL_CHAIN
+
+/*
+ * Number of frames and arguments to save in objects allocated by
+ * debugging allocator.
+ */
+#   define NFRAMES 6	/* Number of frames to save. Even for		*/
+			/* alignment reasons.				*/
+#   define NARGS 2	/* Mumber of arguments to save for each call.	*/
+
+#   define NEED_CALLINFO
+
+/* Fill in the pc and argument information for up to NFRAMES of my	*/
+/* callers.  Ignore my frame and my callers frame.			*/
+void GC_save_callers (/* struct callinfo info[NFRAMES] */);
+
+void GC_print_callers (/* struct callinfo info[NFRAMES] */);
+
+#else
+
+# ifdef GC_ADD_CALLER
+#   define NFRAMES 1
+#   define NARGS 0
+#   define NEED_CALLINFO
+# endif
+
+#endif
+
+#ifdef NEED_CALLINFO
+    struct callinfo {
+	word ci_pc;
+#	if NARGS > 0
+	    word ci_arg[NARGS];	/* bit-wise complement to avoid retention */
+#	endif
+#	if defined(ALIGN_DOUBLE) && (NFRAMES * (NARGS + 1)) % 2 == 1
+	    /* Likely alignment problem. */
+	    word ci_dummy;
+#	endif
+    };
+#endif
+
+
+/*********************************/
+/*                               */
+/* OS interface routines	 */
+/*                               */
+/*********************************/
+
+#ifdef BSD_TIME
+#   undef CLOCK_TYPE
+#   undef GET_TIME
+#   undef MS_TIME_DIFF
+#   define CLOCK_TYPE struct timeval
+#   define GET_TIME(x) { struct rusage rusage; \
+			 getrusage (RUSAGE_SELF,  &rusage); \
+			 x = rusage.ru_utime; }
+#   define MS_TIME_DIFF(a,b) ((double) (a.tv_sec - b.tv_sec) * 1000.0 \
+                               + (double) (a.tv_usec - b.tv_usec) / 1000.0)
+#else /* !BSD_TIME */
+# ifdef MSWIN32
+#   include <windows.h>
+#   include <winbase.h>
+#   define CLOCK_TYPE DWORD
+#   define GET_TIME(x) x = GetTickCount()
+#   define MS_TIME_DIFF(a,b) ((long)((a)-(b)))
+# else /* !MSWIN32, !BSD_TIME */
+#   include <time.h>
+#   if !defined(__STDC__) && defined(SPARC) && defined(SUNOS4)
+      clock_t clock();	/* Not in time.h, where it belongs	*/
+#   endif
+#   if defined(FREEBSD) && !defined(CLOCKS_PER_SEC)
+#     include <machine/limits.h>
+#     define CLOCKS_PER_SEC CLK_TCK
+#   endif
+#   if !defined(CLOCKS_PER_SEC)
+#     define CLOCKS_PER_SEC 1000000
+/*
+ * This is technically a bug in the implementation.  ANSI requires that
+ * CLOCKS_PER_SEC be defined.  But at least under SunOS4.1.1, it isn't.
+ * Also note that the combination of ANSI C and POSIX is incredibly gross
+ * here. The type clock_t is used by both clock() and times().  But on
+ * some machines these use different notions of a clock tick,  CLOCKS_PER_SEC
+ * seems to apply only to clock.  Hence we use it here.  On many machines,
+ * including SunOS, clock actually uses units of microseconds (which are
+ * not really clock ticks).
+ */
+#   endif
+#   define CLOCK_TYPE clock_t
+#   define GET_TIME(x) x = clock()
+#   define MS_TIME_DIFF(a,b) ((unsigned long) \
+		(1000.0*(double)((a)-(b))/(double)CLOCKS_PER_SEC))
+# endif /* !MSWIN32 */
+#endif /* !BSD_TIME */
+
+/* We use bzero and bcopy internally.  They may not be available.	*/
+# if defined(SPARC) && defined(SUNOS4)
+#   define BCOPY_EXISTS
+# endif
+# if defined(M68K) && defined(AMIGA)
+#   define BCOPY_EXISTS
+# endif
+# if defined(M68K) && defined(NEXT)
+#   define BCOPY_EXISTS
+# endif
+# if defined(VAX)
+#   define BCOPY_EXISTS
+# endif
+# if defined(AMIGA)
+#   include <string.h>
+#   define BCOPY_EXISTS
+# endif
+
+# ifndef BCOPY_EXISTS
+#   include <string.h>
+#   define BCOPY(x,y,n) memcpy(y, x, (size_t)(n))
+#   define BZERO(x,n)  memset(x, 0, (size_t)(n))
+# else
+#   define BCOPY(x,y,n) bcopy((char *)(x),(char *)(y),(int)(n))
+#   define BZERO(x,n) bzero((char *)(x),(int)(n))
+# endif
+
+/* HBLKSIZE aligned allocation.  0 is taken to mean failure 	*/
+/* space is assumed to be cleared.				*/
+/* In the case os USE_MMAP, the argument must also be a 	*/
+/* physical page size.						*/
+/* GET_MEM is currently not assumed to retrieve 0 filled space, */
+/* though we should perhaps take advantage of the case in which */
+/* does.							*/
+# ifdef PCR
+    char * real_malloc();
+#   define GET_MEM(bytes) HBLKPTR(real_malloc((size_t)bytes + GC_page_size) \
+				  + GC_page_size-1)
+# else
+#   ifdef OS2
+      void * os2_alloc(size_t bytes);
+#     define GET_MEM(bytes) HBLKPTR((ptr_t)os2_alloc((size_t)bytes \
+				    + GC_page_size) \
+                                    + GC_page_size-1)
+#   else
+#     if defined(AMIGA) || defined(NEXT) || defined(MACOSX) || defined(DOS4GW)
+#       define GET_MEM(bytes) HBLKPTR((size_t) \
+				      calloc(1, (size_t)bytes + GC_page_size) \
+                                      + GC_page_size-1)
+#     else
+#	ifdef MSWIN32
+          extern ptr_t GC_win32_get_mem();
+#         define GET_MEM(bytes) (struct hblk *)GC_win32_get_mem(bytes)
+#	else
+#	  ifdef MACOS
+#	    if defined(USE_TEMPORARY_MEMORY)
+		extern Ptr GC_MacTemporaryNewPtr(size_t size,
+						 Boolean clearMemory);
+#               define GET_MEM(bytes) HBLKPTR( \
+		    GC_MacTemporaryNewPtr(bytes + GC_page_size, true) \
+		    + GC_page_size-1)
+#	    else
+#         	    define GET_MEM(bytes) HBLKPTR( \
+			NewPtrClear(bytes + GC_page_size) + GC_page_size-1)
+#	    endif
+#	  else
+              extern ptr_t GC_unix_get_mem();
+#             define GET_MEM(bytes) (struct hblk *)GC_unix_get_mem(bytes)
+#	  endif
+#	endif
+#     endif
+#   endif
+# endif
+
+/*
+ * Mutual exclusion between allocator/collector routines.
+ * Needed if there is more than one allocator thread.
+ * FASTLOCK() is assumed to try to acquire the lock in a cheap and
+ * dirty way that is acceptable for a few instructions, e.g. by
+ * inhibiting preemption.  This is assumed to have succeeded only
+ * if a subsequent call to FASTLOCK_SUCCEEDED() returns TRUE.
+ * FASTUNLOCK() is called whether or not FASTLOCK_SUCCEEDED().
+ * If signals cannot be tolerated with the FASTLOCK held, then
+ * FASTLOCK should disable signals.  The code executed under
+ * FASTLOCK is otherwise immune to interruption, provided it is
+ * not restarted.
+ * DCL_LOCK_STATE declares any local variables needed by LOCK and UNLOCK
+ * and/or DISABLE_SIGNALS and ENABLE_SIGNALS and/or FASTLOCK.
+ * (There is currently no equivalent for FASTLOCK.)
+ */  
+# ifdef THREADS
+#  ifdef PCR_OBSOLETE	/* Faster, but broken with multiple lwp's	*/
+#    include  "th/PCR_Th.h"
+#    include  "th/PCR_ThCrSec.h"
+     extern struct PCR_Th_MLRep GC_allocate_ml;
+#    define DCL_LOCK_STATE  PCR_sigset_t GC_old_sig_mask
+#    define LOCK() PCR_Th_ML_Acquire(&GC_allocate_ml) 
+#    define UNLOCK() PCR_Th_ML_Release(&GC_allocate_ml)
+#    define FASTLOCK() PCR_ThCrSec_EnterSys()
+     /* Here we cheat (a lot): */
+#        define FASTLOCK_SUCCEEDED() (*(int *)(&GC_allocate_ml) == 0)
+		/* TRUE if nobody currently holds the lock */
+#    define FASTUNLOCK() PCR_ThCrSec_ExitSys()
+#  endif
+#  ifdef PCR
+#    include <base/PCR_Base.h>
+#    include <th/PCR_Th.h>
+     extern PCR_Th_ML GC_allocate_ml;
+#    define DCL_LOCK_STATE \
+	 PCR_ERes GC_fastLockRes; PCR_sigset_t GC_old_sig_mask
+#    define LOCK() PCR_Th_ML_Acquire(&GC_allocate_ml)
+#    define UNLOCK() PCR_Th_ML_Release(&GC_allocate_ml)
+#    define FASTLOCK() (GC_fastLockRes = PCR_Th_ML_Try(&GC_allocate_ml))
+#    define FASTLOCK_SUCCEEDED() (GC_fastLockRes == PCR_ERes_okay)
+#    define FASTUNLOCK()  {\
+        if( FASTLOCK_SUCCEEDED() ) PCR_Th_ML_Release(&GC_allocate_ml); }
+#  endif
+#  ifdef SRC_M3
+     extern word RT0u__inCritical;
+#    define LOCK() RT0u__inCritical++
+#    define UNLOCK() RT0u__inCritical--
+#  endif
+#  ifdef SOLARIS_THREADS
+#    include <thread.h>
+#    include <signal.h>
+     extern mutex_t GC_allocate_ml;
+#    define LOCK() mutex_lock(&GC_allocate_ml);
+#    define UNLOCK() mutex_unlock(&GC_allocate_ml);
+#  endif
+#  if defined(LINUX_THREADS) 
+#   if defined(I386)|| defined(POWERPC) || defined(ALPHA) || defined(IA64) \
+    || defined(M68K)
+#    include <pthread.h>
+#    define USE_SPIN_LOCK
+#    if defined(I386)
+       inline static int GC_test_and_set(volatile unsigned int *addr) {
+	  int oldval;
+	  /* Note: the "xchg" instruction does not need a "lock" prefix */
+	  __asm__ __volatile__("xchgl %0, %1"
+		: "=r"(oldval), "=m"(*(addr))
+		: "0"(1), "m"(*(addr)));
+	  return oldval;
+       }
+#    endif
+#    if defined(IA64)
+       inline static int GC_test_and_set(volatile unsigned int *addr) {
+	  int oldval;
+	  __asm__ __volatile__("xchg4 %0=%1,%2"
+		: "=r"(oldval), "=m"(*addr)
+		: "r"(1), "1"(*addr));
+	  return oldval;
+       }
+       inline static void GC_clear(volatile unsigned int *addr) {
+	 __asm__ __volatile__("st4.rel %0=r0" : "=m" (*addr));
+       }
+#      define GC_CLEAR_DEFINED
+#    endif
+#    ifdef M68K
+       /* Contributed by Tony Mantler.  I'm not sure how well it was	*/
+       /* tested.							*/
+       inline static int GC_test_and_set(volatile unsigned int *addr) {
+          char oldval; /* this must be no longer than 8 bits */
+
+          /* The return value is semi-phony. */
+          /* 'tas' sets bit 7 while the return */
+          /* value pretends bit 0 was set */
+          __asm__ __volatile__(
+                 "tas %1@; sne %0; negb %0"
+                 : "=d" (oldval)
+                 : "a" (addr));
+          return oldval;
+       }
+#    endif
+#    if defined(POWERPC)
+      inline static int GC_test_and_set(volatile unsigned int *addr) {
+        int oldval;
+        int temp = 1; // locked value
+
+        __asm__ __volatile__(
+               "1:\tlwarx %0,0,%3\n"   // load and reserve
+               "\tcmpwi %0, 0\n"       // if load is
+               "\tbne 2f\n"            //   non-zero, return already set
+               "\tstwcx. %2,0,%1\n"    // else store conditional
+               "\tbne- 1b\n"           // retry if lost reservation
+               "2:\t\n"                // oldval is zero if we set
+              : "=&r"(oldval), "=p"(addr)
+              : "r"(temp), "1"(addr)
+              : "memory");
+        return (int)oldval;
+      }
+      inline static void GC_clear(volatile unsigned int *addr) {
+	 __asm__ __volatile__("eieio");
+         *(addr) = 0;
+      }
+#     define GC_CLEAR_DEFINED
+#    endif
+#    ifdef ALPHA
+      inline static int GC_test_and_set(volatile unsigned int * addr)
+      {
+        unsigned long oldvalue;
+        unsigned long temp;
+
+        __asm__ __volatile__(
+                             "1:     ldl_l %0,%1\n"
+                             "       and %0,%3,%2\n"
+                             "       bne %2,2f\n"
+                             "       xor %0,%3,%0\n"
+                             "       stl_c %0,%1\n"
+                             "       beq %0,3f\n"
+                             "       mb\n"
+                             "2:\n"
+                             ".section .text2,\"ax\"\n"
+                             "3:     br 1b\n"
+                             ".previous"
+                             :"=&r" (temp), "=m" (*addr), "=&r" (oldvalue)
+                             :"Ir" (1), "m" (*addr));
+
+        return oldvalue;
+      }
+      /* Should probably also define GC_clear, since it needs	*/
+      /* a memory barrier ??					*/
+#    endif /* ALPHA */
+#    ifdef ARM32
+      inline static int GC_test_and_set(volatile unsigned int *addr) {
+        int oldval;
+        /* SWP on ARM is very similar to XCHG on x86.  Doesn't lock the
+         * bus because there are no SMP ARM machines.  If/when there are,
+         * this code will likely need to be updated. */
+        /* See linuxthreads/sysdeps/arm/pt-machine.h in glibc-2.1 */
+        __asm__ __volatile__("swp %0, %1, [%2]"
+      			     : "=r"(oldval)
+      			     : "r"(1), "r"(addr));
+        return oldval;
+      }
+#    endif
+#    ifndef GC_CLEAR_DEFINED
+       inline static void GC_clear(volatile unsigned int *addr) {
+	  /* Try to discourage gcc from moving anything past this. */
+	  __asm__ __volatile__(" ");
+          *(addr) = 0;
+       }
+#    endif
+
+     extern volatile unsigned int GC_allocate_lock;
+     extern pthread_t GC_lock_holder;
+     extern void GC_lock(void);
+	/* Allocation lock holder.  Only set if acquired by client through */
+	/* GC_call_with_alloc_lock.					   */
+#    define SET_LOCK_HOLDER() GC_lock_holder = pthread_self()
+#    define NO_THREAD (pthread_t)(-1)
+#    define UNSET_LOCK_HOLDER() GC_lock_holder = NO_THREAD
+#    define I_HOLD_LOCK() (pthread_equal(GC_lock_holder, pthread_self()))
+#    define LOCK() \
+		{ if (GC_test_and_set(&GC_allocate_lock)) GC_lock(); }
+#    define UNLOCK() \
+		GC_clear(&GC_allocate_lock)
+     extern VOLATILE GC_bool GC_collecting;
+#    define ENTER_GC() \
+		{ \
+		    GC_collecting = 1; \
+		}
+#    define EXIT_GC() GC_collecting = 0;
+#   else /* LINUX_THREADS on hardware for which we don't know how	*/
+	 /* to do test and set.						*/
+#    include <pthread.h>
+     extern pthread_mutex_t GC_allocate_ml;
+#    define LOCK() pthread_mutex_lock(&GC_allocate_ml)
+#    define UNLOCK() pthread_mutex_unlock(&GC_allocate_ml)
+#   endif
+#  endif /* LINUX_THREADS */
+#  if defined(HPUX_THREADS)
+#    include <pthread.h>
+     extern pthread_mutex_t GC_allocate_ml;
+#    define LOCK() pthread_mutex_lock(&GC_allocate_ml)
+#    define UNLOCK() pthread_mutex_unlock(&GC_allocate_ml)
+#  endif
+#  if defined(IRIX_THREADS) || defined(IRIX_JDK_THREADS) 
+     /* This may also eventually be appropriate for HPUX_THREADS */
+#    include <pthread.h>
+#    ifndef HPUX_THREADS
+	/* This probably should never be included, but I can't test	*/
+	/* on Irix anymore.						*/
+#       include <mutex.h>
+#    endif
+
+#    ifndef HPUX_THREADS
+#      if __mips < 3 || !(defined (_ABIN32) || defined(_ABI64)) \
+	|| !defined(_COMPILER_VERSION) || _COMPILER_VERSION < 700
+#        define GC_test_and_set(addr, v) test_and_set(addr,v)
+#      else
+#	 define GC_test_and_set(addr, v) __test_and_set(addr,v)
+#      endif
+#    else
+       /* I couldn't find a way to do this inline on HP/UX	*/
+#    endif
+     extern unsigned long GC_allocate_lock;
+	/* This is not a mutex because mutexes that obey the (optional) 	*/
+	/* POSIX scheduling rules are subject to convoys in high contention	*/
+	/* applications.  This is basically a spin lock.			*/
+     extern pthread_t GC_lock_holder;
+     extern void GC_lock(void);
+	/* Allocation lock holder.  Only set if acquired by client through */
+	/* GC_call_with_alloc_lock.					   */
+#    define SET_LOCK_HOLDER() GC_lock_holder = pthread_self()
+#    define NO_THREAD (pthread_t)(-1)
+#    define UNSET_LOCK_HOLDER() GC_lock_holder = NO_THREAD
+#    define I_HOLD_LOCK() (pthread_equal(GC_lock_holder, pthread_self()))
+#    ifdef HPUX_THREADS
+#      define LOCK() { if (!GC_test_and_clear(&GC_allocate_lock)) GC_lock(); }
+       /* The following is INCORRECT, since the memory model is too weak. */
+#      define UNLOCK() { GC_noop1(&GC_allocate_lock); \
+			*(volatile unsigned long *)(&GC_allocate_lock) = 1; }
+#    else
+#      define LOCK() { if (GC_test_and_set(&GC_allocate_lock, 1)) GC_lock(); }
+#      if __mips >= 3 && (defined (_ABIN32) || defined(_ABI64)) \
+	   && defined(_COMPILER_VERSION) && _COMPILER_VERSION >= 700
+#	    define UNLOCK() __lock_release(&GC_allocate_lock)
+#      else
+	    /* The function call in the following should prevent the	*/
+	    /* compiler from moving assignments to below the UNLOCK.	*/
+	    /* This is probably not necessary for ucode or gcc 2.8.	*/
+	    /* It may be necessary for Ragnarok and future gcc		*/
+	    /* versions.						*/
+#           define UNLOCK() { GC_noop1(&GC_allocate_lock); \
+			*(volatile unsigned long *)(&GC_allocate_lock) = 0; }
+#      endif
+#    endif
+     extern VOLATILE GC_bool GC_collecting;
+#    define ENTER_GC() \
+		{ \
+		    GC_collecting = 1; \
+		}
+#    define EXIT_GC() GC_collecting = 0;
+#  endif /* IRIX_THREADS || IRIX_JDK_THREADS */
+#  ifdef WIN32_THREADS
+#    include <windows.h>
+     GC_API CRITICAL_SECTION GC_allocate_ml;
+#    define LOCK() EnterCriticalSection(&GC_allocate_ml);
+#    define UNLOCK() LeaveCriticalSection(&GC_allocate_ml);
+#  endif
+#  ifndef SET_LOCK_HOLDER
+#      define SET_LOCK_HOLDER()
+#      define UNSET_LOCK_HOLDER()
+#      define I_HOLD_LOCK() FALSE
+		/* Used on platforms were locks can be reacquired,	*/
+		/* so it doesn't matter if we lie.			*/
+#  endif
+# else
+#    define LOCK()
+#    define UNLOCK()
+# endif
+# ifndef SET_LOCK_HOLDER
+#   define SET_LOCK_HOLDER()
+#   define UNSET_LOCK_HOLDER()
+#   define I_HOLD_LOCK() FALSE
+		/* Used on platforms were locks can be reacquired,	*/
+		/* so it doesn't matter if we lie.			*/
+# endif
+# ifndef ENTER_GC
+#   define ENTER_GC()
+#   define EXIT_GC()
+# endif
+
+# ifndef DCL_LOCK_STATE
+#   define DCL_LOCK_STATE
+# endif
+# ifndef FASTLOCK
+#   define FASTLOCK() LOCK()
+#   define FASTLOCK_SUCCEEDED() TRUE
+#   define FASTUNLOCK() UNLOCK()
+# endif
+
+/* Delay any interrupts or signals that may abort this thread.  Data	*/
+/* structures are in a consistent state outside this pair of calls.	*/
+/* ANSI C allows both to be empty (though the standard isn't very	*/
+/* clear on that point).  Standard malloc implementations are usually	*/
+/* neither interruptable nor thread-safe, and thus correspond to	*/
+/* empty definitions.							*/
+# ifdef PCR
+#   define DISABLE_SIGNALS() \
+		 PCR_Th_SetSigMask(PCR_allSigsBlocked,&GC_old_sig_mask)
+#   define ENABLE_SIGNALS() \
+		PCR_Th_SetSigMask(&GC_old_sig_mask, NIL)
+# else
+#   if defined(SRC_M3) || defined(AMIGA) || defined(SOLARIS_THREADS) \
+	|| defined(MSWIN32) || defined(MACOS) || defined(DJGPP) \
+	|| defined(NO_SIGNALS) || defined(IRIX_THREADS) \
+	|| defined(IRIX_JDK_THREADS) || defined(LINUX_THREADS) 
+			/* Also useful for debugging.		*/
+	/* Should probably use thr_sigsetmask for SOLARIS_THREADS. */
+#     define DISABLE_SIGNALS()
+#     define ENABLE_SIGNALS()
+#   else
+#     define DISABLE_SIGNALS() GC_disable_signals()
+	void GC_disable_signals();
+#     define ENABLE_SIGNALS() GC_enable_signals()
+	void GC_enable_signals();
+#   endif
+# endif
+
+/*
+ * Stop and restart mutator threads.
+ */
+# ifdef PCR
+#     include "th/PCR_ThCtl.h"
+#     define STOP_WORLD() \
+ 	PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_stopNormal, \
+ 				   PCR_allSigsBlocked, \
+ 				   PCR_waitForever)
+#     define START_WORLD() \
+	PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_null, \
+ 				   PCR_allSigsBlocked, \
+ 				   PCR_waitForever);
+# else
+#   if defined(SOLARIS_THREADS) || defined(WIN32_THREADS) \
+	|| defined(IRIX_THREADS) || defined(LINUX_THREADS) \
+	|| defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
+      void GC_stop_world();
+      void GC_start_world();
+#     define STOP_WORLD() GC_stop_world()
+#     define START_WORLD() GC_start_world()
+#   else
+#     define STOP_WORLD()
+#     define START_WORLD()
+#   endif
+# endif
+
+/* Abandon ship */
+# ifdef PCR
+#   define ABORT(s) PCR_Base_Panic(s)
+# else
+#   ifdef SMALL_CONFIG
+#	define ABORT(msg) abort();
+#   else
+	GC_API void GC_abort();
+#       define ABORT(msg) GC_abort(msg);
+#   endif
+# endif
+
+/* Exit abnormally, but without making a mess (e.g. out of memory) */
+# ifdef PCR
+#   define EXIT() PCR_Base_Exit(1,PCR_waitForever)
+# else
+#   define EXIT() (void)exit(1)
+# endif
+
+/* Print warning message, e.g. almost out of memory.	*/
+# define WARN(msg,arg) (*GC_current_warn_proc)(msg, (GC_word)(arg))
+extern GC_warn_proc GC_current_warn_proc;
+
+/*********************************/
+/*                               */
+/* Word-size-dependent defines   */
+/*                               */
+/*********************************/
+
+#if CPP_WORDSZ == 32
+#  define WORDS_TO_BYTES(x)   ((x)<<2)
+#  define BYTES_TO_WORDS(x)   ((x)>>2)
+#  define LOGWL               ((word)5)    /* log[2] of CPP_WORDSZ */
+#  define modWORDSZ(n) ((n) & 0x1f)        /* n mod size of word	    */
+#  if ALIGNMENT != 4
+#	define UNALIGNED
+#  endif
+#endif
+
+#if CPP_WORDSZ == 64
+#  define WORDS_TO_BYTES(x)   ((x)<<3)
+#  define BYTES_TO_WORDS(x)   ((x)>>3)
+#  define LOGWL               ((word)6)    /* log[2] of CPP_WORDSZ */
+#  define modWORDSZ(n) ((n) & 0x3f)        /* n mod size of word	    */
+#  if ALIGNMENT != 8
+#	define UNALIGNED
+#  endif
+#endif
+
+#define WORDSZ ((word)CPP_WORDSZ)
+#define SIGNB  ((word)1 << (WORDSZ-1))
+#define BYTES_PER_WORD      ((word)(sizeof (word)))
+#define ONES                ((word)(-1))
+#define divWORDSZ(n) ((n) >> LOGWL)	   /* divide n by size of word      */
+
+/*********************/
+/*                   */
+/*  Size Parameters  */
+/*                   */
+/*********************/
+
+/*  heap block size, bytes. Should be power of 2 */
+
+#ifndef HBLKSIZE
+# ifdef SMALL_CONFIG
+#   define CPP_LOG_HBLKSIZE 10
+# else
+#   if CPP_WORDSZ == 32
+#     define CPP_LOG_HBLKSIZE 12
+#   else
+#     define CPP_LOG_HBLKSIZE 13
+#   endif
+# endif
+#else
+# if HBLKSIZE == 512
+#   define CPP_LOG_HBLKSIZE 9
+# endif
+# if HBLKSIZE == 1024
+#   define CPP_LOG_HBLKSIZE 10
+# endif
+# if HBLKSIZE == 2048
+#   define CPP_LOG_HBLKSIZE 11
+# endif
+# if HBLKSIZE == 4096
+#   define CPP_LOG_HBLKSIZE 12
+# endif
+# if HBLKSIZE == 8192
+#   define CPP_LOG_HBLKSIZE 13
+# endif
+# if HBLKSIZE == 16384
+#   define CPP_LOG_HBLKSIZE 14
+# endif
+# ifndef CPP_LOG_HBLKSIZE
+    --> fix HBLKSIZE
+# endif
+# undef HBLKSIZE
+#endif
+# define CPP_HBLKSIZE (1 << CPP_LOG_HBLKSIZE)
+# define LOG_HBLKSIZE   ((word)CPP_LOG_HBLKSIZE)
+# define HBLKSIZE ((word)CPP_HBLKSIZE)
+
+
+/*  max size objects supported by freelist (larger objects may be   */
+/*  allocated, but less efficiently)                                */
+
+#define CPP_MAXOBJSZ    BYTES_TO_WORDS(CPP_HBLKSIZE/2)
+#define MAXOBJSZ ((word)CPP_MAXOBJSZ)
+		
+# define divHBLKSZ(n) ((n) >> LOG_HBLKSIZE)
+
+# define HBLK_PTR_DIFF(p,q) divHBLKSZ((ptr_t)p - (ptr_t)q)
+	/* Equivalent to subtracting 2 hblk pointers.	*/
+	/* We do it this way because a compiler should	*/
+	/* find it hard to use an integer division	*/
+	/* instead of a shift.  The bundled SunOS 4.1	*/
+	/* o.w. sometimes pessimizes the subtraction to	*/
+	/* involve a call to .div.			*/
+ 
+# define modHBLKSZ(n) ((n) & (HBLKSIZE-1))
+ 
+# define HBLKPTR(objptr) ((struct hblk *)(((word) (objptr)) & ~(HBLKSIZE-1)))
+
+# define HBLKDISPL(objptr) (((word) (objptr)) & (HBLKSIZE-1))
+
+/* Round up byte allocation requests to integral number of words, etc. */
+# ifdef ADD_BYTE_AT_END
+#   define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1))
+#   ifdef ALIGN_DOUBLE
+#       define ALIGNED_WORDS(n) (BYTES_TO_WORDS((n) + WORDS_TO_BYTES(2)) & ~1)
+#   else
+#       define ALIGNED_WORDS(n) ROUNDED_UP_WORDS(n)
+#   endif
+#   define SMALL_OBJ(bytes) ((bytes) < WORDS_TO_BYTES(MAXOBJSZ))
+#   define ADD_SLOP(bytes) ((bytes)+1)
+# else
+#   define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + (WORDS_TO_BYTES(1) - 1))
+#   ifdef ALIGN_DOUBLE
+#       define ALIGNED_WORDS(n) \
+			(BYTES_TO_WORDS((n) + WORDS_TO_BYTES(2) - 1) & ~1)
+#   else
+#       define ALIGNED_WORDS(n) ROUNDED_UP_WORDS(n)
+#   endif
+#   define SMALL_OBJ(bytes) ((bytes) <= WORDS_TO_BYTES(MAXOBJSZ))
+#   define ADD_SLOP(bytes) (bytes)
+# endif
+
+
+/*
+ * Hash table representation of sets of pages.  This assumes it is
+ * OK to add spurious entries to sets.
+ * Used by black-listing code, and perhaps by dirty bit maintenance code.
+ */
+ 
+# ifdef LARGE_CONFIG
+#   define LOG_PHT_ENTRIES  17
+# else
+#   define LOG_PHT_ENTRIES  14	/* Collisions are likely if heap grows	*/
+				/* to more than 16K hblks = 64MB.	*/
+				/* Each hash table occupies 2K bytes.   */
+# endif
+# define PHT_ENTRIES ((word)1 << LOG_PHT_ENTRIES)
+# define PHT_SIZE (PHT_ENTRIES >> LOGWL)
+typedef word page_hash_table[PHT_SIZE];
+
+# define PHT_HASH(addr) ((((word)(addr)) >> LOG_HBLKSIZE) & (PHT_ENTRIES - 1))
+
+# define get_pht_entry_from_index(bl, index) \
+		(((bl)[divWORDSZ(index)] >> modWORDSZ(index)) & 1)
+# define set_pht_entry_from_index(bl, index) \
+		(bl)[divWORDSZ(index)] |= (word)1 << modWORDSZ(index)
+# define clear_pht_entry_from_index(bl, index) \
+		(bl)[divWORDSZ(index)] &= ~((word)1 << modWORDSZ(index))
+	
+
+
+/********************************************/
+/*                                          */
+/*    H e a p   B l o c k s                 */
+/*                                          */
+/********************************************/
+
+/*  heap block header */
+#define HBLKMASK   (HBLKSIZE-1)
+
+#define BITS_PER_HBLK (HBLKSIZE * 8)
+
+#define MARK_BITS_PER_HBLK (BITS_PER_HBLK/CPP_WORDSZ)
+	   /* upper bound                                    */
+	   /* We allocate 1 bit/word.  Only the first word   */
+	   /* in each object is actually marked.             */
+
+# ifdef ALIGN_DOUBLE
+#   define MARK_BITS_SZ (((MARK_BITS_PER_HBLK + 2*CPP_WORDSZ - 1) \
+			  / (2*CPP_WORDSZ))*2)
+# else
+#   define MARK_BITS_SZ ((MARK_BITS_PER_HBLK + CPP_WORDSZ - 1)/CPP_WORDSZ)
+# endif
+	   /* Upper bound on number of mark words per heap block  */
+
+struct hblkhdr {
+    word hb_sz;  /* If in use, size in words, of objects in the block. */
+		 /* if free, the size in bytes of the whole block      */
+    struct hblk * hb_next; 	/* Link field for hblk free list	 */
+    				/* and for lists of chunks waiting to be */
+    				/* reclaimed.				 */
+    struct hblk * hb_prev;	/* Backwards link for free list.	*/
+    word hb_descr;   		/* object descriptor for marking.  See	*/
+    				/* mark.h.				*/
+    char* hb_map;	/* A pointer to a pointer validity map of the block. */
+    		      	/* See GC_obj_map.				     */
+    		     	/* Valid for all blocks with headers.		     */
+    		     	/* Free blocks point to GC_invalid_map.		     */
+    unsigned char hb_obj_kind;
+    			 /* Kind of objects in the block.  Each kind 	*/
+    			 /* identifies a mark procedure and a set of 	*/
+    			 /* list headers.  Sometimes called regions.	*/
+    unsigned char hb_flags;
+#	define IGNORE_OFF_PAGE	1	/* Ignore pointers that do not	*/
+					/* point to the first page of 	*/
+					/* this object.			*/
+#	define WAS_UNMAPPED 2	/* This is a free block, which has	*/
+				/* been unmapped from the address 	*/
+				/* space.				*/
+				/* GC_remap must be invoked on it	*/
+				/* before it can be reallocated.	*/
+				/* Only set with USE_MUNMAP.		*/
+    unsigned short hb_last_reclaimed;
+    				/* Value of GC_gc_no when block was	*/
+    				/* last allocated or swept. May wrap.   */
+				/* For a free block, this is maintained */
+				/* unly for USE_MUNMAP, and indicates	*/
+				/* when the header was allocated, or	*/
+				/* when the size of the block last	*/
+				/* changed.				*/
+    word hb_marks[MARK_BITS_SZ];
+			    /* Bit i in the array refers to the             */
+			    /* object starting at the ith word (header      */
+			    /* INCLUDED) in the heap block.                 */
+			    /* The lsb of word 0 is numbered 0.		    */
+			    /* Unused bits are invalid, and are 	    */
+			    /* occasionally set, e.g for uncollectable	    */
+			    /* objects.					    */
+};
+
+/*  heap block body */
+
+# define DISCARD_WORDS 0
+	/* Number of words to be dropped at the beginning of each block	*/
+	/* Must be a multiple of WORDSZ.  May reasonably be nonzero	*/
+	/* on machines that don't guarantee longword alignment of	*/
+	/* pointers, so that the number of false hits is minimized.	*/
+	/* 0 and WORDSZ are probably the only reasonable values.	*/
+
+# define BODY_SZ ((HBLKSIZE-WORDS_TO_BYTES(DISCARD_WORDS))/sizeof(word))
+
+struct hblk {
+#   if (DISCARD_WORDS != 0)
+        word garbage[DISCARD_WORDS];
+#   endif
+    word hb_body[BODY_SZ];
+};
+
+# define HDR_WORDS ((word)DISCARD_WORDS)
+# define HDR_BYTES ((word)WORDS_TO_BYTES(DISCARD_WORDS))
+
+# define OBJ_SZ_TO_BLOCKS(sz) \
+    divHBLKSZ(HDR_BYTES + WORDS_TO_BYTES(sz) + HBLKSIZE-1)
+    /* Size of block (in units of HBLKSIZE) needed to hold objects of	*/
+    /* given sz (in words).						*/
+
+/* Object free list link */
+# define obj_link(p) (*(ptr_t *)(p))
+
+/* The type of mark procedures.  This really belongs in gc_mark.h.	*/
+/* But we put it here, so that we can avoid scanning the mark proc	*/
+/* table.								*/
+typedef struct ms_entry * (*mark_proc)(/* word * addr,
+					  struct ms_entry *mark_stack_ptr,
+					  struct ms_entry *mark_stack_limit,
+					  word env */);
+# define LOG_MAX_MARK_PROCS 6
+# define MAX_MARK_PROCS (1 << LOG_MAX_MARK_PROCS)
+
+/* Root sets.  Logically private to mark_rts.c.  But we don't want the	*/
+/* tables scanned, so we put them here.					*/
+/* MAX_ROOT_SETS is the maximum number of ranges that can be 	*/
+/* registered as static roots. 					*/
+# ifdef LARGE_CONFIG
+#   define MAX_ROOT_SETS 4096
+# else
+#   ifdef PCR
+#     define MAX_ROOT_SETS 1024
+#   else
+#     ifdef MSWIN32
+#	define MAX_ROOT_SETS 512
+	    /* Under NT, we add only written pages, which can result 	*/
+	    /* in many small root sets.					*/
+#     else
+#       define MAX_ROOT_SETS 64
+#     endif
+#   endif
+# endif
+
+# define MAX_EXCLUSIONS (MAX_ROOT_SETS/4)
+/* Maximum number of segments that can be excluded from root sets.	*/
+
+/*
+ * Data structure for excluded static roots.
+ */
+struct exclusion {
+    ptr_t e_start;
+    ptr_t e_end;
+};
+
+/* Data structure for list of root sets.				*/
+/* We keep a hash table, so that we can filter out duplicate additions.	*/
+/* Under Win32, we need to do a better job of filtering overlaps, so	*/
+/* we resort to sequential search, and pay the price.			*/
+struct roots {
+	ptr_t r_start;
+	ptr_t r_end;
+#	ifndef MSWIN32
+	  struct roots * r_next;
+#	endif
+	GC_bool r_tmp;
+	  	/* Delete before registering new dynamic libraries */
+};
+
+#ifndef MSWIN32
+    /* Size of hash table index to roots.	*/
+#   define LOG_RT_SIZE 6
+#   define RT_SIZE (1 << LOG_RT_SIZE) /* Power of 2, may be != MAX_ROOT_SETS */
+#endif
+
+/* Lists of all heap blocks and free lists	*/
+/* as well as other random data structures	*/
+/* that should not be scanned by the		*/
+/* collector.					*/
+/* These are grouped together in a struct	*/
+/* so that they can be easily skipped by the	*/
+/* GC_mark routine.				*/
+/* The ordering is weird to make GC_malloc	*/
+/* faster by keeping the important fields	*/
+/* sufficiently close together that a		*/
+/* single load of a base register will do.	*/
+/* Scalars that could easily appear to		*/
+/* be pointers are also put here.		*/
+/* The main fields should precede any 		*/
+/* conditionally included fields, so that	*/
+/* gc_inl.h will work even if a different set	*/
+/* of macros is defined when the client is	*/
+/* compiled.					*/
+
+struct _GC_arrays {
+  word _heapsize;
+  word _max_heapsize;
+  word _requested_heapsize;	/* Heap size due to explicit expansion */
+  ptr_t _last_heap_addr;
+  ptr_t _prev_heap_addr;
+  word _large_free_bytes;
+	/* Total bytes contained in blocks on large object free */
+	/* list.						*/
+  word _words_allocd_before_gc;
+		/* Number of words allocated before this	*/
+		/* collection cycle.				*/
+  word _words_allocd;
+  	/* Number of words allocated during this collection cycle */
+  word _words_wasted;
+  	/* Number of words wasted due to internal fragmentation	*/
+  	/* in large objects, or due to dropping blacklisted     */
+	/* blocks, since last gc.  Approximate.                 */
+  word _words_finalized;
+  	/* Approximate number of words in objects (and headers)	*/
+  	/* That became ready for finalization in the last 	*/
+  	/* collection.						*/
+  word _non_gc_bytes_at_gc;
+  	/* Number of explicitly managed bytes of storage 	*/
+  	/* at last collection.					*/
+  word _mem_freed;
+  	/* Number of explicitly deallocated words of memory	*/
+  	/* since last collection.				*/
+  ptr_t _scratch_end_ptr;
+  ptr_t _scratch_last_end_ptr;
+	/* Used by headers.c, and can easily appear to point to	*/
+	/* heap.						*/
+  mark_proc _mark_procs[MAX_MARK_PROCS];
+  	/* Table of user-defined mark procedures.  There is	*/
+	/* a small number of these, which can be referenced	*/
+	/* by DS_PROC mark descriptors.  See gc_mark.h.		*/
+  ptr_t _objfreelist[MAXOBJSZ+1];
+			  /* free list for objects */
+  ptr_t _aobjfreelist[MAXOBJSZ+1];
+			  /* free list for atomic objs 	*/
+
+  ptr_t _uobjfreelist[MAXOBJSZ+1];
+			  /* uncollectable but traced objs 	*/
+			  /* objects on this and auobjfreelist  */
+			  /* are always marked, except during   */
+			  /* garbage collections.		*/
+# ifdef ATOMIC_UNCOLLECTABLE
+    ptr_t _auobjfreelist[MAXOBJSZ+1];
+# endif
+			  /* uncollectable but traced objs 	*/
+
+# ifdef GATHERSTATS
+    word _composite_in_use;
+   		/* Number of words in accessible composite	*/
+		/* objects.					*/
+    word _atomic_in_use;
+   		/* Number of words in accessible atomic		*/
+		/* objects.					*/
+# endif
+# ifdef USE_MUNMAP
+    word _unmapped_bytes;
+# endif
+# ifdef MERGE_SIZES
+    unsigned _size_map[WORDS_TO_BYTES(MAXOBJSZ+1)];
+    	/* Number of words to allocate for a given allocation request in */
+    	/* bytes.							 */
+# endif 
+
+# ifdef STUBBORN_ALLOC
+    ptr_t _sobjfreelist[MAXOBJSZ+1];
+# endif
+  			  /* free list for immutable objects	*/
+  ptr_t _obj_map[MAXOBJSZ+1];
+                       /* If not NIL, then a pointer to a map of valid  */
+    		       /* object addresses. _obj_map[sz][i] is j if the	*/
+    		       /* address block_start+i is a valid pointer      */
+    		       /* to an object at				*/
+    		       /* block_start+i&~3 - WORDS_TO_BYTES(j).		*/
+    		       /* (If ALL_INTERIOR_POINTERS is defined, then	*/
+    		       /* instead ((short *)(hb_map[sz])[i] is j if	*/
+    		       /* block_start+WORDS_TO_BYTES(i) is in the	*/
+    		       /* interior of an object starting at		*/
+    		       /* block_start+WORDS_TO_BYTES(i-j)).		*/
+    		       /* It is OBJ_INVALID if				*/
+    		       /* block_start+WORDS_TO_BYTES(i) is not		*/
+    		       /* valid as a pointer to an object.              */
+    		       /* We assume all values of j <= OBJ_INVALID.	*/
+    		       /* The zeroth entry corresponds to large objects.*/
+#   ifdef ALL_INTERIOR_POINTERS
+#	define map_entry_type short
+#       define OBJ_INVALID 0x7fff
+#	define MAP_ENTRY(map, bytes) \
+		(((map_entry_type *)(map))[BYTES_TO_WORDS(bytes)])
+#	define MAP_ENTRIES BYTES_TO_WORDS(HBLKSIZE)
+#	define MAP_SIZE (MAP_ENTRIES * sizeof(map_entry_type))
+#	define OFFSET_VALID(displ) TRUE
+#	define CPP_MAX_OFFSET (HBLKSIZE - HDR_BYTES - 1)
+#	define MAX_OFFSET ((word)CPP_MAX_OFFSET)
+#   else
+#	define map_entry_type char
+#       define OBJ_INVALID 0x7f
+#	define MAP_ENTRY(map, bytes) \
+		(map)[bytes]
+#	define MAP_ENTRIES HBLKSIZE
+#	define MAP_SIZE MAP_ENTRIES
+#	define CPP_MAX_OFFSET (WORDS_TO_BYTES(OBJ_INVALID) - 1)	
+#	define MAX_OFFSET ((word)CPP_MAX_OFFSET)
+# 	define VALID_OFFSET_SZ \
+	  (CPP_MAX_OFFSET > WORDS_TO_BYTES(CPP_MAXOBJSZ)? \
+	   CPP_MAX_OFFSET+1 \
+	   : WORDS_TO_BYTES(CPP_MAXOBJSZ)+1)
+  	char _valid_offsets[VALID_OFFSET_SZ];
+				/* GC_valid_offsets[i] == TRUE ==> i 	*/
+				/* is registered as a displacement.	*/
+#	define OFFSET_VALID(displ) GC_valid_offsets[displ]
+  	char _modws_valid_offsets[sizeof(word)];
+				/* GC_valid_offsets[i] ==>		  */
+				/* GC_modws_valid_offsets[i%sizeof(word)] */
+#   endif
+# ifdef STUBBORN_ALLOC
+    page_hash_table _changed_pages;
+        /* Stubborn object pages that were changes since last call to	*/
+	/* GC_read_changed.						*/
+    page_hash_table _prev_changed_pages;
+        /* Stubborn object pages that were changes before last call to	*/
+	/* GC_read_changed.						*/
+# endif
+# if defined(PROC_VDB) || defined(MPROTECT_VDB)
+    page_hash_table _grungy_pages; /* Pages that were dirty at last 	   */
+				     /* GC_read_dirty.			   */
+# endif
+# ifdef MPROTECT_VDB
+    VOLATILE page_hash_table _dirty_pages;	
+			/* Pages dirtied since last GC_read_dirty. */
+# endif
+# ifdef PROC_VDB
+    page_hash_table _written_pages;	/* Pages ever dirtied	*/
+# endif
+# ifdef LARGE_CONFIG
+#   if CPP_WORDSZ > 32
+#     define MAX_HEAP_SECTS 4096 	/* overflows at roughly 64 GB	   */
+#   else
+#     define MAX_HEAP_SECTS 768		/* Separately added heap sections. */
+#   endif
+# else
+#   define MAX_HEAP_SECTS 256
+# endif
+  struct HeapSect {
+      ptr_t hs_start; word hs_bytes;
+  } _heap_sects[MAX_HEAP_SECTS];
+# ifdef MSWIN32
+    ptr_t _heap_bases[MAX_HEAP_SECTS];
+    		/* Start address of memory regions obtained from kernel. */
+# endif
+  struct roots _static_roots[MAX_ROOT_SETS];
+# ifndef MSWIN32
+    struct roots * _root_index[RT_SIZE];
+# endif
+  struct exclusion _excl_table[MAX_EXCLUSIONS];
+  /* Block header index; see gc_headers.h */
+  bottom_index * _all_nils;
+  bottom_index * _top_index [TOP_SZ];
+#ifdef SAVE_CALL_CHAIN
+  struct callinfo _last_stack[NFRAMES];	/* Stack at last garbage collection.*/
+  					/* Useful for debugging	mysterious  */
+  					/* object disappearances.	    */
+  					/* In the multithreaded case, we    */
+  					/* currently only save the calling  */
+  					/* stack.			    */
+#endif
+};
+
+GC_API GC_FAR struct _GC_arrays GC_arrays; 
+
+# define GC_objfreelist GC_arrays._objfreelist
+# define GC_aobjfreelist GC_arrays._aobjfreelist
+# define GC_uobjfreelist GC_arrays._uobjfreelist
+# ifdef ATOMIC_UNCOLLECTABLE
+#   define GC_auobjfreelist GC_arrays._auobjfreelist
+# endif
+# define GC_sobjfreelist GC_arrays._sobjfreelist
+# define GC_valid_offsets GC_arrays._valid_offsets
+# define GC_modws_valid_offsets GC_arrays._modws_valid_offsets
+# ifdef STUBBORN_ALLOC
+#    define GC_changed_pages GC_arrays._changed_pages
+#    define GC_prev_changed_pages GC_arrays._prev_changed_pages
+# endif
+# define GC_obj_map GC_arrays._obj_map
+# define GC_last_heap_addr GC_arrays._last_heap_addr
+# define GC_prev_heap_addr GC_arrays._prev_heap_addr
+# define GC_words_allocd GC_arrays._words_allocd
+# define GC_words_wasted GC_arrays._words_wasted
+# define GC_large_free_bytes GC_arrays._large_free_bytes
+# define GC_words_finalized GC_arrays._words_finalized
+# define GC_non_gc_bytes_at_gc GC_arrays._non_gc_bytes_at_gc
+# define GC_mem_freed GC_arrays._mem_freed
+# define GC_scratch_end_ptr GC_arrays._scratch_end_ptr
+# define GC_scratch_last_end_ptr GC_arrays._scratch_last_end_ptr
+# define GC_mark_procs GC_arrays._mark_procs
+# define GC_heapsize GC_arrays._heapsize
+# define GC_max_heapsize GC_arrays._max_heapsize
+# define GC_requested_heapsize GC_arrays._requested_heapsize
+# define GC_words_allocd_before_gc GC_arrays._words_allocd_before_gc
+# define GC_heap_sects GC_arrays._heap_sects
+# define GC_last_stack GC_arrays._last_stack
+# ifdef USE_MUNMAP
+#   define GC_unmapped_bytes GC_arrays._unmapped_bytes
+# endif
+# ifdef MSWIN32
+#   define GC_heap_bases GC_arrays._heap_bases
+# endif
+# define GC_static_roots GC_arrays._static_roots
+# define GC_root_index GC_arrays._root_index
+# define GC_excl_table GC_arrays._excl_table
+# define GC_all_nils GC_arrays._all_nils
+# define GC_top_index GC_arrays._top_index
+# if defined(PROC_VDB) || defined(MPROTECT_VDB)
+#   define GC_grungy_pages GC_arrays._grungy_pages
+# endif
+# ifdef MPROTECT_VDB
+#   define GC_dirty_pages GC_arrays._dirty_pages
+# endif
+# ifdef PROC_VDB
+#   define GC_written_pages GC_arrays._written_pages
+# endif
+# ifdef GATHERSTATS
+#   define GC_composite_in_use GC_arrays._composite_in_use
+#   define GC_atomic_in_use GC_arrays._atomic_in_use
+# endif
+# ifdef MERGE_SIZES
+#   define GC_size_map GC_arrays._size_map
+# endif
+
+# define beginGC_arrays ((ptr_t)(&GC_arrays))
+# define endGC_arrays (((ptr_t)(&GC_arrays)) + (sizeof GC_arrays))
+
+#define USED_HEAP_SIZE (GC_heapsize - GC_large_free_bytes)
+
+/* Object kinds: */
+# define MAXOBJKINDS 16
+
+extern struct obj_kind {
+   ptr_t *ok_freelist;	/* Array of free listheaders for this kind of object */
+   			/* Point either to GC_arrays or to storage allocated */
+   			/* with GC_scratch_alloc.			     */
+   struct hblk **ok_reclaim_list;
+   			/* List headers for lists of blocks waiting to be */
+   			/* swept.					  */
+   word ok_descriptor;  /* Descriptor template for objects in this	*/
+   			/* block.					*/
+   GC_bool ok_relocate_descr;
+   			/* Add object size in bytes to descriptor 	*/
+   			/* template to obtain descriptor.  Otherwise	*/
+   			/* template is used as is.			*/
+   GC_bool ok_init;   /* Clear objects before putting them on the free list. */
+} GC_obj_kinds[MAXOBJKINDS];
+
+# define endGC_obj_kinds (((ptr_t)(&GC_obj_kinds)) + (sizeof GC_obj_kinds))
+
+# define end_gc_area ((ptr_t)endGC_arrays == (ptr_t)(&GC_obj_kinds) ? \
+			endGC_obj_kinds : endGC_arrays)
+
+/* Predefined kinds: */
+# define PTRFREE 0
+# define NORMAL  1
+# define UNCOLLECTABLE 2
+# ifdef ATOMIC_UNCOLLECTABLE
+#   define AUNCOLLECTABLE 3
+#   define STUBBORN 4
+#   define IS_UNCOLLECTABLE(k) (((k) & ~1) == UNCOLLECTABLE)
+# else
+#   define STUBBORN 3
+#   define IS_UNCOLLECTABLE(k) ((k) == UNCOLLECTABLE)
+# endif
+
+extern int GC_n_kinds;
+
+GC_API word GC_fo_entries;
+
+extern word GC_n_heap_sects;	/* Number of separately added heap	*/
+				/* sections.				*/
+
+extern word GC_page_size;
+
+# ifdef MSWIN32
+extern word GC_n_heap_bases;	/* See GC_heap_bases.	*/
+# endif
+
+extern word GC_total_stack_black_listed;
+			/* Number of bytes on stack blacklist. 	*/
+
+extern word GC_black_list_spacing;
+			/* Average number of bytes between blacklisted	*/
+			/* blocks. Approximate.				*/
+			/* Counts only blocks that are 			*/
+			/* "stack-blacklisted", i.e. that are 		*/
+			/* problematic in the interior of an object.	*/
+
+extern char * GC_invalid_map;
+			/* Pointer to the nowhere valid hblk map */
+			/* Blocks pointing to this map are free. */
+
+extern struct hblk * GC_hblkfreelist[];
+				/* List of completely empty heap blocks	*/
+				/* Linked through hb_next field of 	*/
+				/* header structure associated with	*/
+				/* block.				*/
+
+extern GC_bool GC_is_initialized;	/* GC_init() has been run.	*/
+
+extern GC_bool GC_objects_are_marked;	/* There are marked objects in  */
+					/* the heap.			*/
+
+#ifndef SMALL_CONFIG
+  extern GC_bool GC_incremental;
+			/* Using incremental/generational collection. */
+#else
+# define GC_incremental FALSE
+			/* Hopefully allow optimizer to remove some code. */
+#endif
+
+extern GC_bool GC_dirty_maintained;
+				/* Dirty bits are being maintained, 	*/
+				/* either for incremental collection,	*/
+				/* or to limit the root set.		*/
+
+extern word GC_root_size;	/* Total size of registered root sections */
+
+extern GC_bool GC_debugging_started;	/* GC_debug_malloc has been called. */ 
+
+extern ptr_t GC_least_plausible_heap_addr;
+extern ptr_t GC_greatest_plausible_heap_addr;
+			/* Bounds on the heap.  Guaranteed valid	*/
+			/* Likely to include future heap expansion.	*/
+			
+/* Operations */
+# ifndef abs
+#   define abs(x)  ((x) < 0? (-(x)) : (x))
+# endif
+
+
+/*  Marks are in a reserved area in                          */
+/*  each heap block.  Each word has one mark bit associated  */
+/*  with it. Only those corresponding to the beginning of an */
+/*  object are used.                                         */
+
+
+/* Mark bit operations */
+
+/*
+ * Retrieve, set, clear the mark bit corresponding
+ * to the nth word in a given heap block.
+ *
+ * (Recall that bit n corresponds to object beginning at word n
+ * relative to the beginning of the block, including unused words)
+ */
+
+# define mark_bit_from_hdr(hhdr,n) (((hhdr)->hb_marks[divWORDSZ(n)] \
+			    >> (modWORDSZ(n))) & (word)1)
+# define set_mark_bit_from_hdr(hhdr,n) (hhdr)->hb_marks[divWORDSZ(n)] \
+				|= (word)1 << modWORDSZ(n)
+
+# define clear_mark_bit_from_hdr(hhdr,n) (hhdr)->hb_marks[divWORDSZ(n)] \
+				&= ~((word)1 << modWORDSZ(n))
+
+/* Important internal collector routines */
+
+ptr_t GC_approx_sp();
+
+GC_bool GC_should_collect();
+
+void GC_apply_to_all_blocks(/*fn, client_data*/);
+			/* Invoke fn(hbp, client_data) for each 	*/
+			/* allocated heap block.			*/
+struct hblk * GC_next_used_block(/* struct hblk * h */);
+			/* Return first in-use block >= h	*/
+struct hblk * GC_prev_block(/* struct hblk * h */);
+			/* Return last block <= h.  Returned block	*/
+			/* is managed by GC, but may or may not be in	*/
+			/* use.						*/
+void GC_mark_init();
+void GC_clear_marks();	/* Clear mark bits for all heap objects. */
+void GC_invalidate_mark_state();	/* Tell the marker that	marked 	   */
+					/* objects may point to	unmarked   */
+					/* ones, and roots may point to	   */
+					/* unmarked objects.		   */
+					/* Reset mark stack.		   */
+void GC_mark_from_mark_stack(); /* Mark from everything on the mark stack. */
+				/* Return after about one pages worth of   */
+				/* work.				   */
+GC_bool GC_mark_stack_empty();
+GC_bool GC_mark_some(/* cold_gc_frame */);
+			/* Perform about one pages worth of marking	*/
+			/* work of whatever kind is needed.  Returns	*/
+			/* quickly if no collection is in progress.	*/
+			/* Return TRUE if mark phase finished.		*/
+void GC_initiate_gc();		/* initiate collection.			*/
+				/* If the mark state is invalid, this	*/
+				/* becomes full colleection.  Otherwise */
+				/* it's partial.			*/
+void GC_push_all(/*b,t*/);	/* Push everything in a range 		*/
+				/* onto mark stack.			*/
+void GC_push_dirty(/*b,t*/);      /* Push all possibly changed	 	*/
+				  /* subintervals of [b,t) onto		*/
+				  /* mark stack.			*/
+#ifndef SMALL_CONFIG
+  void GC_push_conditional(/* ptr_t b, ptr_t t, GC_bool all*/);
+#else
+# define GC_push_conditional(b, t, all) GC_push_all(b, t)
+#endif
+                                /* Do either of the above, depending	*/
+				/* on the third arg.			*/
+void GC_push_all_stack(/*b,t*/);    /* As above, but consider		*/
+				    /*  interior pointers as valid  	*/
+void GC_push_all_eager(/*b,t*/);    /* Same as GC_push_all_stack, but   */
+				    /* ensures that stack is scanned	*/
+				    /* immediately, not just scheduled  */
+				    /* for scanning.			*/
+#ifndef THREADS
+  void GC_push_all_stack_partially_eager(/* bottom, top, cold_gc_frame */);
+			/* Similar to GC_push_all_eager, but only the	*/
+			/* part hotter than cold_gc_frame is scanned	*/
+			/* immediately.  Needed to endure that callee-	*/
+			/* save registers are not missed.		*/
+#else
+  /* In the threads case, we push part of the current thread stack	*/
+  /* with GC_push_all_eager when we push the registers.  This gets the  */
+  /* callee-save registers that may disappear.  The remainder of the	*/
+  /* stacks are scheduled for scanning in *GC_push_other_roots, which	*/
+  /* is thread-package-specific.					*/
+#endif
+void GC_push_current_stack(/* ptr_t cold_gc_frame */);
+			/* Push enough of the current stack eagerly to	*/
+			/* ensure that callee-save registers saved in	*/
+			/* GC frames are scanned.			*/
+			/* In the non-threads case, schedule entire	*/
+			/* stack for scanning.				*/
+void GC_push_roots(/* GC_bool all, ptr_t cold_gc_frame */);
+			/* Push all or dirty roots.	*/
+extern void (*GC_push_other_roots)();
+			/* Push system or application specific roots	*/
+			/* onto the mark stack.  In some environments	*/
+			/* (e.g. threads environments) this is		*/
+			/* predfined to be non-zero.  A client supplied */
+			/* replacement should also call the original	*/
+			/* function.					*/
+extern void (*GC_start_call_back)(/* void */);
+			/* Called at start of full collections.		*/
+			/* Not called if 0.  Called with allocation 	*/
+			/* lock held.					*/
+			/* 0 by default.				*/
+void GC_push_regs();	/* Push register contents onto mark stack.	*/
+			/* If NURSERY is defined, the default push	*/
+			/* action can be overridden with GC_push_proc	*/
+void GC_remark();	/* Mark from all marked objects.  Used	*/
+		 	/* only if we had to drop something.	*/
+
+# ifdef NURSERY
+    extern void (*GC_push_proc)(ptr_t);
+# endif
+# if defined(MSWIN32)
+  void __cdecl GC_push_one();
+# else
+  void GC_push_one(/*p*/);    /* If p points to an object, mark it    */
+                              /* and push contents on the mark stack  */
+# endif
+void GC_push_one_checked(/*p*/); /* Ditto, omits plausibility test	*/
+void GC_push_marked(/* struct hblk h, hdr * hhdr */);
+		/* Push contents of all marked objects in h onto	*/
+		/* mark stack.						*/
+#ifdef SMALL_CONFIG
+# define GC_push_next_marked_dirty(h) GC_push_next_marked(h)
+#else
+  struct hblk * GC_push_next_marked_dirty(/* h */);
+		/* Invoke GC_push_marked on next dirty block above h.	*/
+		/* Return a pointer just past the end of this block.	*/
+#endif /* !SMALL_CONFIG */
+struct hblk * GC_push_next_marked(/* h */);
+		/* Ditto, but also mark from clean pages.	*/
+struct hblk * GC_push_next_marked_uncollectable(/* h */);
+		/* Ditto, but mark only from uncollectable pages.	*/
+GC_bool GC_stopped_mark(); /* Stop world and mark from all roots	*/
+			/* and rescuers.			*/
+void GC_clear_hdr_marks(/* hhdr */);  /* Clear the mark bits in a header */
+void GC_set_hdr_marks(/* hhdr */);  /* Set the mark bits in a header */
+void GC_add_roots_inner();
+GC_bool GC_is_static_root(/* ptr_t p */);
+		/* Is the address p in one of the registered static	*/
+		/* root sections?					*/
+void GC_register_dynamic_libraries();
+		/* Add dynamic library data sections to the root set. */
+
+/* Machine dependent startup routines */
+ptr_t GC_get_stack_base();
+void GC_register_data_segments();
+
+/* Black listing: */
+void GC_bl_init(); 	
+# ifndef ALL_INTERIOR_POINTERS
+    void GC_add_to_black_list_normal(/* bits, maybe source */);
+			/* Register bits as a possible future false	*/
+			/* reference from the heap or static data	*/
+#   ifdef PRINT_BLACK_LIST
+#     define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+			GC_add_to_black_list_normal(bits, source)
+#   else
+#     define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+			GC_add_to_black_list_normal(bits)
+#   endif
+# else
+#   ifdef PRINT_BLACK_LIST
+#     define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+			GC_add_to_black_list_stack(bits, source)
+#   else
+#     define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+			GC_add_to_black_list_stack(bits)
+#   endif
+# endif
+
+void GC_add_to_black_list_stack(/* bits, maybe source */);
+struct hblk * GC_is_black_listed(/* h, len */);
+			/* If there are likely to be false references	*/
+			/* to a block starting at h of the indicated    */
+			/* length, then return the next plausible	*/
+			/* starting location for h that might avoid	*/
+			/* these false references.			*/
+void GC_promote_black_lists();
+			/* Declare an end to a black listing phase.	*/
+void GC_unpromote_black_lists();
+			/* Approximately undo the effect of the above.	*/
+			/* This actually loses some information, but	*/
+			/* only in a reasonably safe way.		*/
+word GC_number_stack_black_listed(/*struct hblk *start, struct hblk *endp1 */);
+			/* Return the number of (stack) blacklisted	*/
+			/* blocks in the range for statistical		*/
+			/* purposes.					*/
+		 	
+ptr_t GC_scratch_alloc(/*bytes*/);
+				/* GC internal memory allocation for	*/
+				/* small objects.  Deallocation is not  */
+				/* possible.				*/
+	
+/* Heap block layout maps: */			
+void GC_invalidate_map(/* hdr */);
+				/* Remove the object map associated	*/
+				/* with the block.  This identifies	*/
+				/* the block as invalid to the mark	*/
+				/* routines.				*/
+GC_bool GC_add_map_entry(/*sz*/);
+				/* Add a heap block map for objects of	*/
+				/* size sz to obj_map.			*/
+				/* Return FALSE on failure.		*/
+void GC_register_displacement_inner(/*offset*/);
+				/* Version of GC_register_displacement	*/
+				/* that assumes lock is already held	*/
+				/* and signals are already disabled.	*/
+
+/*  hblk allocation: */		
+void GC_new_hblk(/*size_in_words, kind*/);
+				/* Allocate a new heap block, and build */
+				/* a free list in it.			*/				
+struct hblk * GC_allochblk(/*size_in_words, kind*/);
+				/* Allocate a heap block, clear it if	*/
+				/* for composite objects, inform	*/
+				/* the marker that block is valid	*/
+				/* for objects of indicated size.	*/
+				/* sz < 0 ==> atomic.			*/ 
+void GC_freehblk();		/* Deallocate a heap block and mark it  */
+				/* as invalid.				*/
+				
+/*  Misc GC: */
+void GC_init_inner();
+GC_bool GC_expand_hp_inner();
+void GC_start_reclaim(/*abort_if_found*/);
+				/* Restore unmarked objects to free	*/
+				/* lists, or (if abort_if_found is	*/
+				/* TRUE) report them.			*/
+				/* Sweeping of small object pages is	*/
+				/* largely deferred.			*/
+void GC_continue_reclaim(/*size, kind*/);
+				/* Sweep pages of the given size and	*/
+				/* kind, as long as possible, and	*/
+				/* as long as the corr. free list is    */
+				/* empty.				*/
+void GC_reclaim_or_delete_all();
+				/* Arrange for all reclaim lists to be	*/
+				/* empty.  Judiciously choose between	*/
+				/* sweeping and discarding each page.	*/
+GC_bool GC_reclaim_all(/* GC_stop_func f*/);
+				/* Reclaim all blocks.  Abort (in a	*/
+				/* consistent state) if f returns TRUE. */
+GC_bool GC_block_empty(/* hhdr */); /* Block completely unmarked? 	*/
+GC_bool GC_never_stop_func();	/* Returns FALSE.		*/
+GC_bool GC_try_to_collect_inner(/* GC_stop_func f */);
+				/* Collect; caller must have acquired	*/
+				/* lock and disabled signals.		*/
+				/* Collection is aborted if f returns	*/
+				/* TRUE.  Returns TRUE if it completes	*/
+				/* successfully.			*/
+# define GC_gcollect_inner() \
+	(void) GC_try_to_collect_inner(GC_never_stop_func)
+void GC_finish_collection();	/* Finish collection.  Mark bits are	*/
+				/* consistent and lock is still held.	*/
+GC_bool GC_collect_or_expand(/* needed_blocks */);
+				/* Collect or expand heap in an attempt */
+				/* make the indicated number of free	*/
+				/* blocks available.  Should be called	*/
+				/* until the blocks are available or	*/
+				/* until it fails by returning FALSE.	*/
+GC_API void GC_init();		/* Initialize collector.		*/
+void GC_collect_a_little_inner(/* int n */);
+				/* Do n units worth of garbage 		*/
+				/* collection work, if appropriate.	*/
+				/* A unit is an amount appropriate for  */
+				/* HBLKSIZE bytes of allocation.	*/
+ptr_t GC_generic_malloc(/* bytes, kind */);
+				/* Allocate an object of the given	*/
+				/* kind.  By default, there are only	*/
+				/* a few kinds: composite(pointerfree), */
+				/* atomic, uncollectable, etc.		*/
+				/* We claim it's possible for clever	*/
+				/* client code that understands GC	*/
+				/* internals to add more, e.g. to	*/
+				/* communicate object layout info	*/
+				/* to the collector.			*/
+ptr_t GC_generic_malloc_ignore_off_page(/* bytes, kind */);
+				/* As above, but pointers past the 	*/
+				/* first page of the resulting object	*/
+				/* are ignored.				*/
+ptr_t GC_generic_malloc_inner(/* bytes, kind */);
+				/* Ditto, but I already hold lock, etc.	*/
+ptr_t GC_generic_malloc_words_small GC_PROTO((size_t words, int kind));
+				/* As above, but size in units of words */
+				/* Bypasses MERGE_SIZES.  Assumes	*/
+				/* words <= MAXOBJSZ.			*/
+ptr_t GC_generic_malloc_inner_ignore_off_page(/* bytes, kind */);
+				/* Allocate an object, where		*/
+				/* the client guarantees that there	*/
+				/* will always be a pointer to the 	*/
+				/* beginning of the object while the	*/
+				/* object is live.			*/
+ptr_t GC_allocobj(/* sz_inn_words, kind */);
+				/* Make the indicated 			*/
+				/* free list nonempty, and return its	*/
+				/* head.				*/
+
+void GC_init_headers();
+struct hblkhdr * GC_install_header(/*h*/);
+				/* Install a header for block h.	*/
+				/* Return 0 on failure, or the header	*/
+				/* otherwise.				*/
+GC_bool GC_install_counts(/*h, sz*/);
+				/* Set up forwarding counts for block	*/
+				/* h of size sz.			*/
+				/* Return FALSE on failure.		*/
+void GC_remove_header(/*h*/);
+				/* Remove the header for block h.	*/
+void GC_remove_counts(/*h, sz*/);
+				/* Remove forwarding counts for h.	*/
+hdr * GC_find_header(/*p*/);	/* Debugging only.			*/
+
+void GC_finalize();	/* Perform all indicated finalization actions	*/
+			/* on unmarked objects.				*/
+			/* Unreachable finalizable objects are enqueued	*/
+			/* for processing by GC_invoke_finalizers.	*/
+			/* Invoked with lock.				*/
+			
+void GC_add_to_heap(/*p, bytes*/);
+			/* Add a HBLKSIZE aligned chunk to the heap.	*/
+
+void GC_print_obj(/* ptr_t p */);
+			/* P points to somewhere inside an object with	*/
+			/* debugging info.  Print a human readable	*/
+			/* description of the object to stderr.		*/
+extern void (*GC_check_heap)();
+			/* Check that all objects in the heap with 	*/
+			/* debugging info are intact.  Print 		*/
+			/* descriptions of any that are not.		*/
+extern void (*GC_print_heap_obj)(/* ptr_t p */);
+			/* If possible print s followed by a more	*/
+			/* detailed description of the object 		*/
+			/* referred to by p.				*/
+			
+/* Memory unmapping: */
+#ifdef USE_MUNMAP
+  void GC_unmap_old(void);
+  void GC_merge_unmapped(void);
+  void GC_unmap(ptr_t start, word bytes);
+  void GC_remap(ptr_t start, word bytes);
+  void GC_unmap_gap(ptr_t start1, word bytes1, ptr_t start2, word bytes2);
+#endif
+
+/* Virtual dirty bit implementation:		*/
+/* Each implementation exports the following:	*/
+void GC_read_dirty();	/* Retrieve dirty bits.	*/
+GC_bool GC_page_was_dirty(/* struct hblk * h  */);
+			/* Read retrieved dirty bits.	*/
+GC_bool GC_page_was_ever_dirty(/* struct hblk * h  */);
+			/* Could the page contain valid heap pointers?	*/
+void GC_is_fresh(/* struct hblk * h, word number_of_blocks  */);
+			/* Assert the region currently contains no	*/
+			/* valid pointers.				*/
+void GC_write_hint(/* struct hblk * h  */);
+			/* h is about to be written.	*/
+void GC_dirty_init();
+
+/* Slow/general mark bit manipulation: */
+GC_API GC_bool GC_is_marked();
+void GC_clear_mark_bit();
+void GC_set_mark_bit();
+
+/* Stubborn objects: */
+void GC_read_changed();	/* Analogous to GC_read_dirty */
+GC_bool GC_page_was_changed(/* h */);	/* Analogous to GC_page_was_dirty */
+void GC_clean_changing_list();	/* Collect obsolete changing list entries */
+void GC_stubborn_init();
+
+/* Debugging print routines: */
+void GC_print_block_list();
+void GC_print_hblkfreelist();
+void GC_print_heap_sects();
+void GC_print_static_roots();
+void GC_dump();
+
+#ifdef KEEP_BACK_PTRS
+   void GC_store_back_pointer(ptr_t source, ptr_t dest);
+   void GC_marked_for_finalization(ptr_t dest);
+#  define GC_STORE_BACK_PTR(source, dest) GC_store_back_pointer(source, dest)
+#  define GC_MARKED_FOR_FINALIZATION(dest) GC_marked_for_finalization(dest)
+#else
+#  define GC_STORE_BACK_PTR(source, dest) 
+#  define GC_MARKED_FOR_FINALIZATION(dest)
+#endif
+
+/* Make arguments appear live to compiler */
+# ifdef __WATCOMC__
+  void GC_noop(void*, ...);
+# else
+  GC_API void GC_noop();
+# endif
+
+void GC_noop1(/* word arg */);
+
+/* Logging and diagnostic output: 	*/
+GC_API void GC_printf GC_PROTO((char * format, long, long, long, long, long, long));
+			/* A version of printf that doesn't allocate,	*/
+			/* is restricted to long arguments, and		*/
+			/* (unfortunately) doesn't use varargs for	*/
+			/* portability.  Restricted to 6 args and	*/
+			/* 1K total output length.			*/
+			/* (We use sprintf.  Hopefully that doesn't	*/
+			/* allocate for long arguments.)  		*/
+# define GC_printf0(f) GC_printf(f, 0l, 0l, 0l, 0l, 0l, 0l)
+# define GC_printf1(f,a) GC_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
+# define GC_printf2(f,a,b) GC_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
+# define GC_printf3(f,a,b,c) GC_printf(f, (long)a, (long)b, (long)c, 0l, 0l, 0l)
+# define GC_printf4(f,a,b,c,d) GC_printf(f, (long)a, (long)b, (long)c, \
+					    (long)d, 0l, 0l)
+# define GC_printf5(f,a,b,c,d,e) GC_printf(f, (long)a, (long)b, (long)c, \
+					      (long)d, (long)e, 0l)
+# define GC_printf6(f,a,b,c,d,e,g) GC_printf(f, (long)a, (long)b, (long)c, \
+						(long)d, (long)e, (long)g)
+
+void GC_err_printf(/* format, a, b, c, d, e, f */);
+# define GC_err_printf0(f) GC_err_puts(f)
+# define GC_err_printf1(f,a) GC_err_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
+# define GC_err_printf2(f,a,b) GC_err_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
+# define GC_err_printf3(f,a,b,c) GC_err_printf(f, (long)a, (long)b, (long)c, \
+						  0l, 0l, 0l)
+# define GC_err_printf4(f,a,b,c,d) GC_err_printf(f, (long)a, (long)b, \
+						    (long)c, (long)d, 0l, 0l)
+# define GC_err_printf5(f,a,b,c,d,e) GC_err_printf(f, (long)a, (long)b, \
+						      (long)c, (long)d, \
+						      (long)e, 0l)
+# define GC_err_printf6(f,a,b,c,d,e,g) GC_err_printf(f, (long)a, (long)b, \
+							(long)c, (long)d, \
+							(long)e, (long)g)
+			/* Ditto, writes to stderr.			*/
+			
+void GC_err_puts(/* char *s */);
+			/* Write s to stderr, don't buffer, don't add	*/
+			/* newlines, don't ...				*/
+
+
+#   ifdef GC_ASSERTIONS
+#	define GC_ASSERT(expr) if(!(expr)) {\
+		GC_err_printf2("Assertion failure: %s:%ld\n", \
+				__FILE__, (unsigned long)__LINE__); \
+		ABORT("assertion failure"); }
+#   else 
+#	define GC_ASSERT(expr)
+#   endif
+
+# endif /* GC_PRIVATE_H */
diff --git a/src/gc/gc_private.h b/src/gc/gc_private.h
new file mode 100644
index 000000000..3dd7c8553
--- /dev/null
+++ b/src/gc/gc_private.h
@@ -0,0 +1 @@
+# include "gc_priv.h"
diff --git a/src/gc/gc_typed.h b/src/gc/gc_typed.h
new file mode 100644
index 000000000..2e0598f20
--- /dev/null
+++ b/src/gc/gc_typed.h
@@ -0,0 +1,93 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright 1996 Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Some simple primitives for allocation with explicit type information.
+ * Facilities for dynamic type inference may be added later.
+ * Should be used only for extremely performance critical applications,
+ * or if conservative collector leakage is otherwise a problem (unlikely).
+ * Note that this is implemented completely separately from the rest
+ * of the collector, and is not linked in unless referenced.
+ * This does not currently support GC_DEBUG in any interesting way.
+ */
+/* Boehm, May 19, 1994 2:13 pm PDT */
+
+#ifndef _GC_TYPED_H
+# define _GC_TYPED_H
+# ifndef _GC_H
+#   include "gc.h"
+# endif
+
+typedef GC_word * GC_bitmap;
+	/* The least significant bit of the first word is one if	*/
+	/* the first word in the object may be a pointer.		*/
+	
+# define GC_get_bit(bm, index) \
+		(((bm)[divWORDSZ(index)] >> modWORDSZ(index)) & 1)
+# define GC_set_bit(bm, index) \
+		(bm)[divWORDSZ(index)] |= (word)1 << modWORDSZ(index)
+
+typedef GC_word GC_descr;
+
+GC_API GC_descr GC_make_descriptor GC_PROTO((GC_bitmap bm, size_t len));
+		/* Return a type descriptor for the object whose layout	*/
+		/* is described by the argument.			*/
+		/* The least significant bit of the first word is one	*/
+		/* if the first word in the object may be a pointer.	*/
+		/* The second argument specifies the number of		*/
+		/* meaningful bits in the bitmap.  The actual object 	*/
+		/* may be larger (but not smaller).  Any additional	*/
+		/* words in the object are assumed not to contain 	*/
+		/* pointers.						*/
+		/* Returns a conservative approximation in the		*/
+		/* (unlikely) case of insufficient memory to build	*/
+		/* the descriptor.  Calls to GC_make_descriptor		*/
+		/* may consume some amount of a finite resource.  This	*/
+		/* is intended to be called once per type, not once	*/
+		/* per allocation.					*/
+
+GC_API GC_PTR GC_malloc_explicitly_typed
+			GC_PROTO((size_t size_in_bytes, GC_descr d));
+		/* Allocate an object whose layout is described by d.	*/
+		/* The resulting object MAY NOT BE PASSED TO REALLOC.	*/
+		/* The returned object is cleared.			*/
+
+GC_API GC_PTR GC_malloc_explicitly_typed_ignore_off_page
+                        GC_PROTO((size_t size_in_bytes, GC_descr d));
+		
+GC_API GC_PTR GC_calloc_explicitly_typed
+			GC_PROTO((size_t nelements,
+  				  size_t element_size_in_bytes,
+  				  GC_descr d));
+  	/* Allocate an array of nelements elements, each of the	*/
+  	/* given size, and with the given descriptor.		*/
+  	/* The elemnt size must be a multiple of the byte	*/
+  	/* alignment required for pointers.  E.g. on a 32-bit	*/
+  	/* machine with 16-bit aligned pointers, size_in_bytes	*/
+  	/* must be a multiple of 2.				*/
+	/* Returned object is cleared.				*/
+
+#ifdef GC_DEBUG
+#   define GC_MALLOC_EXPLICTLY_TYPED(bytes, d) GC_MALLOC(bytes)
+#   define GC_CALLOC_EXPLICTLY_TYPED(n, bytes, d) GC_MALLOC(n*bytes)
+#else
+#  define GC_MALLOC_EXPLICTLY_TYPED(bytes, d) \
+	GC_malloc_explicitly_typed(bytes, d)
+#  define GC_CALLOC_EXPLICTLY_TYPED(n, bytes, d) \
+	GC_calloc_explicitly_typed(n, bytes, d)
+#endif /* !GC_DEBUG */
+
+
+#endif /* _GC_TYPED_H */
+
diff --git a/src/gc/gcc_support.c b/src/gc/gcc_support.c
new file mode 100644
index 000000000..e8a7b8201
--- /dev/null
+++ b/src/gc/gcc_support.c
@@ -0,0 +1,516 @@
+/***************************************************************************
+
+Interface between g++ and Boehm GC
+
+    Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+
+    THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+    OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+
+    Permission is hereby granted to copy this code for any purpose,
+    provided the above notices are retained on all copies.
+
+    Last modified on Sun Jul 16 23:21:14 PDT 1995 by ellis
+
+This module provides runtime support for implementing the
+Ellis/Detlefs GC proposal, "Safe, Efficient Garbage Collection for
+C++", within g++, using its -fgc-keyword extension.  It defines
+versions of __builtin_new, __builtin_new_gc, __builtin_vec_new,
+__builtin_vec_new_gc, __builtin_delete, and __builtin_vec_delete that
+invoke the Bohem GC.  It also implements the WeakPointer.h interface.
+
+This module assumes the following configuration options of the Boehm GC:
+
+    -DALL_INTERIOR_POINTERS
+    -DDONT_ADD_BYTE_AT_END   
+
+This module adds its own required padding to the end of objects to
+support C/C++ "one-past-the-object" pointer semantics.
+
+****************************************************************************/
+
+#include <stddef.h>
+#include "gc.h"
+
+#if defined(__STDC__) 
+#   define PROTO( args ) args
+#else
+#    define PROTO( args ) ()
+#    endif
+
+#define BITSPERBYTE 8     
+    /* What's the portable way to do this? */
+
+
+typedef void (*vfp) PROTO(( void ));
+extern vfp __new_handler;
+extern void __default_new_handler PROTO(( void ));
+
+
+/* A destructor_proc is the compiler generated procedure representing a 
+C++ destructor.  The "flag" argument is a hidden argument following some
+compiler convention. */
+
+typedef (*destructor_proc) PROTO(( void* this, int flag ));
+
+
+/***************************************************************************
+
+A BI_header is the header the compiler adds to the front of
+new-allocated arrays of objects with destructors.  The header is
+padded out to a double, because that's what the compiler does to
+ensure proper alignment of array elements on some architectures.  
+
+int NUM_ARRAY_ELEMENTS (void* o)
+    returns the number of array elements for array object o.
+
+char* FIRST_ELEMENT_P (void* o)
+    returns the address of the first element of array object o.
+
+***************************************************************************/
+
+typedef struct BI_header {
+    int nelts;
+    char padding [sizeof( double ) - sizeof( int )]; 
+        /* Better way to do this? */
+} BI_header;
+
+#define NUM_ARRAY_ELEMENTS( o ) \
+  (((BI_header*) o)->nelts)
+
+#define FIRST_ELEMENT_P( o ) \
+  ((char*) o + sizeof( BI_header ))
+
+
+/***************************************************************************
+
+The __builtin_new routines add a descriptor word to the end of each
+object.   The descriptor serves two purposes.  
+
+First, the descriptor acts as padding, implementing C/C++ pointer
+semantics.  C and C++ allow a valid array pointer to be incremented
+one past the end of an object.  The extra padding ensures that the
+collector will recognize that such a pointer points to the object and
+not the next object in memory.
+
+Second, the descriptor stores three extra pieces of information,
+whether an object has a registered finalizer (destructor), whether it
+may have any weak pointers referencing it, and for collectible arrays,
+the element size of the array.  The element size is required for the
+array's finalizer to iterate through the elements of the array.  (An
+alternative design would have the compiler generate a finalizer
+procedure for each different array type.  But given the overhead of
+finalization, there isn't any efficiency to be gained by that.)
+
+The descriptor must be added to non-collectible as well as collectible
+objects, since the Ellis/Detlefs proposal allows "pointer to gc T" to
+be assigned to a "pointer to T", which could then be deleted.  Thus,
+__builtin_delete must determine at runtime whether an object is
+collectible, whether it has weak pointers referencing it, and whether
+it may have a finalizer that needs unregistering.  Though
+GC_REGISTER_FINALIZER doesn't care if you ask it to unregister a
+finalizer for an object that doesn't have one, it is a non-trivial
+procedure that does a hash look-up, etc.  The descriptor trades a
+little extra space for a significant increase in time on the fast path
+through delete.  (A similar argument applies to
+GC_UNREGISTER_DISAPPEARING_LINK).
+
+For non-array types, the space for the descriptor could be shrunk to a
+single byte for storing the "has finalizer" flag.  But this would save
+space only on arrays of char (whose size is not a multiple of the word
+size) and structs whose largest member is less than a word in size
+(very infrequent).  And it would require that programmers actually
+remember to call "delete[]" instead of "delete" (which they should,
+but there are probably lots of buggy programs out there).  For the
+moment, the space savings seems not worthwhile, especially considering
+that the Boehm GC is already quite space competitive with other
+malloc's.
+
+
+Given a pointer o to the base of an object:
+
+Descriptor* DESCRIPTOR (void* o) 
+     returns a pointer to the descriptor for o.
+
+The implementation of descriptors relies on the fact that the GC
+implementation allocates objects in units of the machine's natural
+word size (e.g. 32 bits on a SPARC, 64 bits on an Alpha).
+
+**************************************************************************/
+
+typedef struct Descriptor {
+    unsigned has_weak_pointers: 1;
+    unsigned has_finalizer: 1;
+    unsigned element_size: BITSPERBYTE * sizeof( unsigned ) - 2; 
+} Descriptor;
+
+#define DESCRIPTOR( o ) \
+  ((Descriptor*) ((char*)(o) + GC_size( o ) - sizeof( Descriptor )))
+
+
+/**************************************************************************
+
+Implementations of global operator new() and operator delete()
+
+***************************************************************************/
+
+
+void* __builtin_new( size ) 
+    size_t size;
+    /* 
+    For non-gc non-array types, the compiler generates calls to
+    __builtin_new, which allocates non-collected storage via
+    GC_MALLOC_UNCOLLECTABLE.  This ensures that the non-collected
+    storage will be part of the collector's root set, required by the
+    Ellis/Detlefs semantics. */
+{
+    vfp handler = __new_handler ? __new_handler : __default_new_handler;
+
+    while (1) {
+        void* o = GC_MALLOC_UNCOLLECTABLE( size + sizeof( Descriptor ) );
+        if (o != 0) return o;
+        (*handler) ();}}
+
+
+void* __builtin_vec_new( size ) 
+    size_t size;
+    /* 
+    For non-gc array types, the compiler generates calls to
+    __builtin_vec_new. */
+{
+    return __builtin_new( size );}
+
+
+void* __builtin_new_gc( size )
+    size_t size;
+    /* 
+    For gc non-array types, the compiler generates calls to
+    __builtin_new_gc, which allocates collected storage via
+    GC_MALLOC. */
+{
+    vfp handler = __new_handler ? __new_handler : __default_new_handler;
+
+    while (1) {
+        void* o = GC_MALLOC( size + sizeof( Descriptor ) );
+        if (o != 0) return o;
+        (*handler) ();}}
+
+
+void* __builtin_new_gc_a( size )
+    size_t size;
+    /* 
+    For non-pointer-containing gc non-array types, the compiler
+    generates calls to __builtin_new_gc_a, which allocates collected
+    storage via GC_MALLOC_ATOMIC. */
+{
+    vfp handler = __new_handler ? __new_handler : __default_new_handler;
+
+    while (1) {
+        void* o = GC_MALLOC_ATOMIC( size + sizeof( Descriptor ) );
+        if (o != 0) return o;
+        (*handler) ();}}
+
+
+void* __builtin_vec_new_gc( size )
+    size_t size;
+    /*
+    For gc array types, the compiler generates calls to
+    __builtin_vec_new_gc. */
+{
+    return __builtin_new_gc( size );}
+
+
+void* __builtin_vec_new_gc_a( size )
+    size_t size;
+    /*
+    For non-pointer-containing gc array types, the compiler generates
+    calls to __builtin_vec_new_gc_a. */
+{
+    return __builtin_new_gc_a( size );}
+
+
+static void call_destructor( o, data )
+    void* o;
+    void* data;
+    /* 
+    call_destructor is the GC finalizer proc registered for non-array
+    gc objects with destructors.  Its client data is the destructor
+    proc, which it calls with the magic integer 2, a special flag
+    obeying the compiler convention for destructors. */
+{
+    ((destructor_proc) data)( o, 2 );}
+
+
+void* __builtin_new_gc_dtor( o, d )
+    void* o;
+    destructor_proc d;
+    /* 
+    The compiler generates a call to __builtin_new_gc_dtor to register
+    the destructor "d" of a non-array gc object "o" as a GC finalizer.
+    The destructor is registered via
+    GC_REGISTER_FINALIZER_IGNORE_SELF, which causes the collector to
+    ignore pointers from the object to itself when determining when
+    the object can be finalized.  This is necessary due to the self
+    pointers used in the internal representation of multiply-inherited
+    objects. */
+{
+    Descriptor* desc = DESCRIPTOR( o );
+
+    GC_REGISTER_FINALIZER_IGNORE_SELF( o, call_destructor, d, 0, 0 );
+    desc->has_finalizer = 1;}
+
+
+static void call_array_destructor( o, data )
+    void* o;
+    void* data;
+    /*
+    call_array_destructor is the GC finalizer proc registered for gc
+    array objects whose elements have destructors. Its client data is
+    the destructor proc.  It iterates through the elements of the
+    array in reverse order, calling the destructor on each. */
+{
+    int num = NUM_ARRAY_ELEMENTS( o );
+    Descriptor* desc = DESCRIPTOR( o );
+    size_t size = desc->element_size;
+    char* first_p = FIRST_ELEMENT_P( o );
+    char* p = first_p + (num - 1) * size;
+
+    if (num > 0) {
+        while (1) {
+            ((destructor_proc) data)( p, 2 );
+            if (p == first_p) break;
+            p -= size;}}}
+
+
+void* __builtin_vec_new_gc_dtor( first_elem, d, element_size )
+    void* first_elem;
+    destructor_proc d;
+    size_t element_size;
+    /* 
+    The compiler generates a call to __builtin_vec_new_gc_dtor to
+    register the destructor "d" of a gc array object as a GC
+    finalizer.  "first_elem" points to the first element of the array,
+    *not* the beginning of the object (this makes the generated call
+    to this function smaller).  The elements of the array are of size
+    "element_size".  The destructor is registered as in
+    _builtin_new_gc_dtor. */
+{
+    void* o = (char*) first_elem - sizeof( BI_header );
+    Descriptor* desc = DESCRIPTOR( o );
+
+    GC_REGISTER_FINALIZER_IGNORE_SELF( o, call_array_destructor, d, 0, 0 );
+    desc->element_size = element_size;
+    desc->has_finalizer = 1;}
+
+
+void __builtin_delete( o )
+    void* o;
+    /* 
+    The compiler generates calls to __builtin_delete for operator
+    delete().  The GC currently requires that any registered
+    finalizers be unregistered before explicitly freeing an object.
+    If the object has any weak pointers referencing it, we can't
+    actually free it now. */
+{
+  if (o != 0) { 
+      Descriptor* desc = DESCRIPTOR( o );
+      if (desc->has_finalizer) GC_REGISTER_FINALIZER( o, 0, 0, 0, 0 );
+      if (! desc->has_weak_pointers) GC_FREE( o );}}
+
+
+void __builtin_vec_delete( o )
+    void* o;
+    /* 
+    The compiler generates calls to __builitn_vec_delete for operator
+    delete[](). */
+{
+  __builtin_delete( o );}
+
+
+/**************************************************************************
+
+Implementations of the template class WeakPointer from WeakPointer.h
+
+***************************************************************************/
+
+typedef struct WeakPointer {
+    void* pointer; 
+} WeakPointer;
+
+
+void* _WeakPointer_New( t )
+    void* t;
+{
+    if (t == 0) {
+        return 0;}
+    else {
+        void* base = GC_base( t );
+        WeakPointer* wp = 
+            (WeakPointer*) GC_MALLOC_ATOMIC( sizeof( WeakPointer ) );
+        Descriptor* desc = DESCRIPTOR( base );
+
+        wp->pointer = t;
+        desc->has_weak_pointers = 1;
+        GC_general_register_disappearing_link( &wp->pointer, base );
+        return wp;}}
+
+
+static void* PointerWithLock( wp ) 
+    WeakPointer* wp;
+{
+    if (wp == 0 || wp->pointer == 0) {
+      return 0;}
+    else {
+        return (void*) wp->pointer;}}
+
+
+void* _WeakPointer_Pointer( wp )
+    WeakPointer* wp;
+{
+    return (void*) GC_call_with_alloc_lock( PointerWithLock, wp );}
+
+
+typedef struct EqualClosure {
+    WeakPointer* wp1;
+    WeakPointer* wp2;
+} EqualClosure;
+
+
+static void* EqualWithLock( ec )
+    EqualClosure* ec;
+{
+    if (ec->wp1 == 0 || ec->wp2 == 0) {
+        return (void*) (ec->wp1 == ec->wp2);}
+    else {
+      return (void*) (ec->wp1->pointer == ec->wp2->pointer);}}
+
+
+int _WeakPointer_Equal( wp1,  wp2 )
+    WeakPointer* wp1;
+    WeakPointer* wp2;
+{
+    EqualClosure ec;
+
+    ec.wp1 = wp1;
+    ec.wp2 = wp2;
+    return (int) GC_call_with_alloc_lock( EqualWithLock, &ec );}
+
+
+int _WeakPointer_Hash( wp )
+    WeakPointer* wp;
+{
+    return (int) _WeakPointer_Pointer( wp );}
+
+
+/**************************************************************************
+
+Implementations of the template class CleanUp from WeakPointer.h
+
+***************************************************************************/
+
+typedef struct Closure {
+    void (*c) PROTO(( void* d, void* t ));
+    ptrdiff_t t_offset; 
+    void* d;
+} Closure;
+
+
+static void _CleanUp_CallClosure( obj, data ) 
+    void* obj;
+    void* data;
+{
+    Closure* closure = (Closure*) data;
+    closure->c( closure->d, (char*) obj + closure->t_offset );}
+
+
+void _CleanUp_Set( t, c, d ) 
+    void* t;
+    void (*c) PROTO(( void* d, void* t ));
+    void* d;
+{
+    void* base = GC_base( t );
+    Descriptor* desc = DESCRIPTOR( t );
+
+    if (c == 0) {
+        GC_REGISTER_FINALIZER_IGNORE_SELF( base, 0, 0, 0, 0 );
+        desc->has_finalizer = 0;}
+    else {
+        Closure* closure = (Closure*) GC_MALLOC( sizeof( Closure ) );
+        closure->c = c;
+        closure->t_offset = (char*) t - (char*) base;
+        closure->d = d;
+        GC_REGISTER_FINALIZER_IGNORE_SELF( base, _CleanUp_CallClosure, 
+                                           closure, 0, 0 );
+        desc->has_finalizer = 1;}}
+
+
+void _CleanUp_Call( t ) 
+    void* t;
+{
+      /* ? Aren't we supposed to deactivate weak pointers to t too? 
+         Why? */
+    void* base = GC_base( t );
+    void* d;
+    GC_finalization_proc f;
+
+    GC_REGISTER_FINALIZER( base, 0, 0, &f, &d );
+    f( base, d );}
+
+
+typedef struct QueueElem {
+    void* o;
+    GC_finalization_proc f;
+    void* d;
+    struct QueueElem* next; 
+} QueueElem;
+
+
+void* _CleanUp_Queue_NewHead()
+{
+    return GC_MALLOC( sizeof( QueueElem ) );}
+    
+     
+static void _CleanUp_Queue_Enqueue( obj, data )
+    void* obj; 
+    void* data;
+{
+    QueueElem* q = (QueueElem*) data;
+    QueueElem* head = q->next;
+
+    q->o = obj;
+    q->next = head->next;
+    head->next = q;}
+    
+    
+void _CleanUp_Queue_Set( h, t ) 
+    void* h;
+    void* t;
+{
+    QueueElem* head = (QueueElem*) h;
+    void* base = GC_base( t );
+    void* d;
+    GC_finalization_proc f;
+    QueueElem* q = (QueueElem*) GC_MALLOC( sizeof( QueueElem ) );
+     
+    GC_REGISTER_FINALIZER( base, _CleanUp_Queue_Enqueue, q, &f, &d );
+    q->f = f;
+    q->d = d;
+    q->next = head;}
+    
+
+int _CleanUp_Queue_Call( h ) 
+    void* h;
+{
+    QueueElem* head = (QueueElem*) h;
+    QueueElem* q = head->next;
+
+    if (q == 0) {
+        return 0;}
+    else {
+        head->next = q->next;
+        q->next = 0;
+        if (q->f != 0) q->f( q->o, q->d );
+        return 1;}}
+
+
+
diff --git a/src/gc/gcconfig.h b/src/gc/gcconfig.h
new file mode 100644
index 000000000..045617a1d
--- /dev/null
+++ b/src/gc/gcconfig.h
@@ -0,0 +1,1327 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+ 
+#ifndef GCCONFIG_H
+
+# define GCCONFIG_H
+
+/* Machine dependent parameters.  Some tuning parameters can be found	*/
+/* near the top of gc_private.h.					*/
+
+/* Machine specific parts contributed by various people.  See README file. */
+
+/* First a unified test for Linux: */
+# if defined(linux) || defined(__linux__)
+#    define LINUX
+# endif
+
+/* Determine the machine type: */
+# if defined(sun) && defined(mc68000)
+#    define M68K
+#    define SUNOS4
+#    define mach_type_known
+# endif
+# if defined(hp9000s300)
+#    define M68K
+#    define HP
+#    define mach_type_known
+# endif
+# if defined(__OpenBSD__) && defined(m68k)
+#    define M68K
+#    define OPENBSD
+#    define mach_type_known
+# endif
+# if defined(__OpenBSD__) && defined(__sparc__)
+#    define SPARC
+#    define OPENBSD
+#    define mach_type_known
+# endif
+# if defined(__NetBSD__) && defined(m68k)
+#    define M68K
+#    define NETBSD
+#    define mach_type_known
+# endif
+# if defined(__NetBSD__) && defined(arm32)
+#    define ARM32
+#    define NETBSD
+#    define mach_type_known
+# endif
+# if defined(vax)
+#    define VAX
+#    ifdef ultrix
+#	define ULTRIX
+#    else
+#	define BSD
+#    endif
+#    define mach_type_known
+# endif
+# if defined(mips) || defined(__mips)
+#    define MIPS
+#    if !defined(LINUX)
+#      if defined(ultrix) || defined(__ultrix) || defined(__NetBSD__)
+#	 define ULTRIX
+#      else
+#	 if defined(_SYSTYPE_SVR4) || defined(SYSTYPE_SVR4) \
+	    || defined(__SYSTYPE_SVR4__)
+#	   define IRIX5   /* or IRIX 6.X */
+#	 else
+#	   define RISCOS  /* or IRIX 4.X */
+#	 endif
+#      endif
+#    endif /* !LINUX */
+#    define mach_type_known
+# endif
+# if defined(sequent) && defined(i386)
+#    define I386
+#    define SEQUENT
+#    define mach_type_known
+# endif
+# if defined(sun) && defined(i386)
+#    define I386
+#    define SUNOS5
+#    define mach_type_known
+# endif
+# if (defined(__OS2__) || defined(__EMX__)) && defined(__32BIT__)
+#    define I386
+#    define OS2
+#    define mach_type_known
+# endif
+# if defined(ibm032)
+#   define RT
+#   define mach_type_known
+# endif
+# if defined(sun) && (defined(sparc) || defined(__sparc))
+#   define SPARC
+    /* Test for SunOS 5.x */
+#     include <errno.h>
+#     ifdef ECHRNG
+#       define SUNOS5
+#     else
+#	define SUNOS4
+#     endif
+#   define mach_type_known
+# endif
+# if defined(sparc) && defined(unix) && !defined(sun) && !defined(linux) \
+     && !defined(__OpenBSD__)
+#   define SPARC
+#   define DRSNX
+#   define mach_type_known
+# endif
+# if defined(_IBMR2)
+#   define RS6000
+#   define mach_type_known
+# endif
+# if defined(_M_XENIX) && defined(_M_SYSV) && defined(_M_I386)
+	/* The above test may need refinement	*/
+#   define I386
+#   if defined(_SCO_ELF)
+#     define SCO_ELF
+#   else
+#     define SCO
+#   endif
+#   define mach_type_known
+# endif
+# if defined(_AUX_SOURCE)
+#   define M68K
+#   define SYSV
+#   define mach_type_known
+# endif
+# if defined(_PA_RISC1_0) || defined(_PA_RISC1_1) || defined(_PA_RISC2_0) \
+     || defined(hppa) || defined(__hppa__)
+#   define HP_PA
+#   ifndef LINUX
+#     define HPUX
+#   endif
+#   define mach_type_known
+# endif
+# if defined(LINUX) && (defined(i386) || defined(__i386__))
+#    define I386
+#    define mach_type_known
+# endif
+# if defined(LINUX) && (defined(__ia64__) || defined(__ia64))
+#    define IA64
+#    define mach_type_known
+# endif
+# if defined(LINUX) && defined(powerpc)
+#    define POWERPC
+#    define mach_type_known
+# endif
+# if defined(LINUX) && defined(__mc68000__)
+#    define M68K
+#    define mach_type_known
+# endif
+# if defined(LINUX) && (defined(sparc) || defined(__sparc__))
+#    define SPARC
+#    define mach_type_known
+# endif
+# if defined(LINUX) && defined(arm)
+#    define ARM32
+#    define mach_type_known
+# endif
+# if defined(__alpha) || defined(__alpha__)
+#   define ALPHA
+#   if !defined(LINUX)
+#     define OSF1	/* a.k.a Digital Unix */
+#   endif
+#   define mach_type_known
+# endif
+# if defined(_AMIGA) && !defined(AMIGA)
+#   define AMIGA
+# endif
+# ifdef AMIGA 
+#   define M68K
+#   define mach_type_known
+# endif
+# if defined(THINK_C) || defined(__MWERKS__) && !defined(__powerc)
+#   define M68K
+#   define MACOS
+#   define mach_type_known
+# endif
+# if defined(__MWERKS__) && defined(__powerc)
+#   define POWERPC
+#   define MACOS
+#   define mach_type_known
+# endif
+# if defined(macosx)
+#    define MACOSX
+#    define POWERPC
+#    define mach_type_known
+# endif
+# if defined(NeXT) && defined(mc68000)
+#   define M68K
+#   define NEXT
+#   define mach_type_known
+# endif
+# if defined(NeXT) && defined(i386)
+#   define I386
+#   define NEXT
+#   define mach_type_known
+# endif
+# if defined(__OpenBSD__) && defined(i386)
+#   define I386
+#   define OPENBSD
+#   define mach_type_known
+# endif
+# if defined(__FreeBSD__) && defined(i386)
+#   define I386
+#   define FREEBSD
+#   define mach_type_known
+# endif
+# if defined(__NetBSD__) && defined(i386)
+#   define I386
+#   define NETBSD
+#   define mach_type_known
+# endif
+# if defined(bsdi) && defined(i386)
+#    define I386
+#    define BSDI
+#    define mach_type_known
+# endif
+# if !defined(mach_type_known) && defined(__386BSD__)
+#   define I386
+#   define THREE86BSD
+#   define mach_type_known
+# endif
+# if defined(_CX_UX) && defined(_M88K)
+#   define M88K
+#   define CX_UX
+#   define mach_type_known
+# endif
+# if defined(DGUX)
+#   define M88K
+    /* DGUX defined */
+#   define mach_type_known
+# endif
+# if (defined(_MSDOS) || defined(_MSC_VER)) && (_M_IX86 >= 300) \
+     || defined(_WIN32) && !defined(__CYGWIN32__) && !defined(__CYGWIN__)
+#   define I386
+#   define MSWIN32	/* or Win32s */
+#   define mach_type_known
+# endif
+# if defined(__DJGPP__)
+#   define I386
+#   ifndef DJGPP
+#     define DJGPP  /* MSDOS running the DJGPP port of GCC */
+#   endif
+#   define mach_type_known
+# endif
+# if defined(__CYGWIN32__) || defined(__CYGWIN__)
+#   define I386
+#   define CYGWIN32
+#   define mach_type_known
+# endif
+# if defined(__MINGW32__)
+#   define I386
+#   define MSWIN32
+#   define mach_type_known
+# endif
+# if defined(__BORLANDC__)
+#   define I386
+#   define MSWIN32
+#   define mach_type_known
+# endif
+# if defined(_UTS) && !defined(mach_type_known)
+#   define S370
+#   define UTS4
+#   define mach_type_known
+# endif
+# if defined(__pj__)
+#   define PJ
+#   define mach_type_known
+# endif
+/* Ivan Demakov */
+# if defined(__WATCOMC__) && defined(__386__)
+#   define I386
+#   if !defined(OS2) && !defined(MSWIN32) && !defined(DOS4GW)
+#     if defined(__OS2__)
+#       define OS2
+#     else
+#       if defined(__WINDOWS_386__) || defined(__NT__)
+#         define MSWIN32
+#       else
+#         define DOS4GW
+#       endif
+#     endif
+#   endif
+#   define mach_type_known
+# endif
+
+/* Feel free to add more clauses here */
+
+/* Or manually define the machine type here.  A machine type is 	*/
+/* characterized by the architecture.  Some				*/
+/* machine types are further subdivided by OS.				*/
+/* the macros ULTRIX, RISCOS, and BSD to distinguish.			*/
+/* Note that SGI IRIX is treated identically to RISCOS.			*/
+/* SYSV on an M68K actually means A/UX.					*/
+/* The distinction in these cases is usually the stack starting address */
+# ifndef mach_type_known
+	--> unknown machine type
+# endif
+		    /* Mapping is: M68K       ==> Motorola 680X0	*/
+		    /*		   (SUNOS4,HP,NEXT, and SYSV (A/UX),	*/
+		    /*		   MACOS and AMIGA variants)		*/
+		    /*             I386       ==> Intel 386	 	*/
+		    /*		    (SEQUENT, OS2, SCO, LINUX, NETBSD,	*/
+		    /*		     FREEBSD, THREE86BSD, MSWIN32,	*/
+		    /* 		     BSDI,SUNOS5, NEXT, other variants)	*/
+                    /*             NS32K      ==> Encore Multimax 	*/
+                    /*             MIPS       ==> R2000 or R3000	*/
+                    /*			(RISCOS, ULTRIX variants)	*/
+                    /*		   VAX	      ==> DEC VAX		*/
+                    /*			(BSD, ULTRIX variants)		*/
+                    /*		   RS6000     ==> IBM RS/6000 AIX3.X	*/
+                    /*		   RT	      ==> IBM PC/RT		*/
+                    /*		   HP_PA      ==> HP9000/700 & /800	*/
+                    /*				  HP/UX			*/
+		    /*		   SPARC      ==> SPARC under SunOS	*/
+		    /*			(SUNOS4, SUNOS5,		*/
+		    /*			 DRSNX variants)		*/
+		    /* 		   ALPHA      ==> DEC Alpha 		*/
+		    /*			(OSF1 and LINUX variants)	*/
+		    /* 		   M88K       ==> Motorola 88XX0        */
+		    /* 		        (CX_UX and DGUX)		*/
+		    /* 		   S370	      ==> 370-like machine	*/
+		    /* 			running Amdahl UTS4		*/
+		    /* 		   ARM32      ==> Intel StrongARM	*/
+		    /* 		   IA64	      ==> Intel IA64		*/
+		    /*				  (e.g. Itanium)	*/
+
+
+/*
+ * For each architecture and OS, the following need to be defined:
+ *
+ * CPP_WORD_SZ is a simple integer constant representing the word size.
+ * in bits.  We assume byte addressibility, where a byte has 8 bits.
+ * We also assume CPP_WORD_SZ is either 32 or 64.
+ * (We care about the length of pointers, not hardware
+ * bus widths.  Thus a 64 bit processor with a C compiler that uses
+ * 32 bit pointers should use CPP_WORD_SZ of 32, not 64. Default is 32.)
+ *
+ * MACH_TYPE is a string representation of the machine type.
+ * OS_TYPE is analogous for the OS.
+ *
+ * ALIGNMENT is the largest N, such that
+ * all pointer are guaranteed to be aligned on N byte boundaries.
+ * defining it to be 1 will always work, but perform poorly.
+ *
+ * DATASTART is the beginning of the data segment.
+ * On UNIX systems, the collector will scan the area between DATASTART
+ * and DATAEND for root pointers.
+ *
+ * DATAEND, if not &end.
+ *
+ * ALIGN_DOUBLE of GC_malloc should return blocks aligned to twice
+ * the pointer size.
+ *
+ * STACKBOTTOM is the cool end of the stack, which is usually the
+ * highest address in the stack.
+ * Under PCR or OS/2, we have other ways of finding thread stacks.
+ * For each machine, the following should:
+ * 1) define STACK_GROWS_UP if the stack grows toward higher addresses, and
+ * 2) define exactly one of
+ *	STACKBOTTOM (should be defined to be an expression)
+ *	HEURISTIC1
+ *	HEURISTIC2
+ * If either of the last two macros are defined, then STACKBOTTOM is computed
+ * during collector startup using one of the following two heuristics:
+ * HEURISTIC1:  Take an address inside GC_init's frame, and round it up to
+ *		the next multiple of STACK_GRAN.
+ * HEURISTIC2:  Take an address inside GC_init's frame, increment it repeatedly
+ *		in small steps (decrement if STACK_GROWS_UP), and read the value
+ *		at each location.  Remember the value when the first
+ *		Segmentation violation or Bus error is signalled.  Round that
+ *		to the nearest plausible page boundary, and use that instead
+ *		of STACKBOTTOM.
+ *
+ * Gustavo Rodriguez-Rivera points out that on most (all?) Unix machines,
+ * the value of environ is a pointer that can serve as STACKBOTTOM.
+ * I expect that HEURISTIC2 can be replaced by this approach, which
+ * interferes far less with debugging. 
+ *
+ * If no expression for STACKBOTTOM can be found, and neither of the above
+ * heuristics are usable, the collector can still be used with all of the above
+ * undefined, provided one of the following is done:
+ * 1) GC_mark_roots can be changed to somehow mark from the correct stack(s)
+ *    without reference to STACKBOTTOM.  This is appropriate for use in
+ *    conjunction with thread packages, since there will be multiple stacks.
+ *    (Allocating thread stacks in the heap, and treating them as ordinary
+ *    heap data objects is also possible as a last resort.  However, this is
+ *    likely to introduce significant amounts of excess storage retention
+ *    unless the dead parts of the thread stacks are periodically cleared.)
+ * 2) Client code may set GC_stackbottom before calling any GC_ routines.
+ *    If the author of the client code controls the main program, this is
+ *    easily accomplished by introducing a new main program, setting
+ *    GC_stackbottom to the address of a local variable, and then calling
+ *    the original main program.  The new main program would read something
+ *    like:
+ *
+ *		# include "gc_private.h"
+ *
+ *		main(argc, argv, envp)
+ *		int argc;
+ *		char **argv, **envp;
+ *		{
+ *		    int dummy;
+ *
+ *		    GC_stackbottom = (ptr_t)(&dummy);
+ *		    return(real_main(argc, argv, envp));
+ *		}
+ *
+ *
+ * Each architecture may also define the style of virtual dirty bit
+ * implementation to be used:
+ *   MPROTECT_VDB: Write protect the heap and catch faults.
+ *   PROC_VDB: Use the SVR4 /proc primitives to read dirty bits.
+ *
+ * An architecture may define DYNAMIC_LOADING if dynamic_load.c
+ * defined GC_register_dynamic_libraries() for the architecture.
+ *
+ * An architecture may define PREFETCH(x) to preload the cache with *x.
+ * This defaults to a no-op.
+ *
+ * PREFETCH_FOR_WRITE(x) is used if *x is about to be written.
+ *
+ * An architecture may also define CLEAR_DOUBLE(x) to be a fast way to
+ * clear the two words at GC_malloc-aligned address x.  By default,
+ * word stores of 0 are used instead.
+ */
+
+
+# define STACK_GRAN 0x1000000
+# ifdef M68K
+#   define MACH_TYPE "M68K"
+#   define ALIGNMENT 2
+#   ifdef OPENBSD
+#	define OS_TYPE "OPENBSD"
+#	define HEURISTIC2
+	extern char etext;
+#	define DATASTART ((ptr_t)(&etext))
+#   endif
+#   ifdef NETBSD
+#	define OS_TYPE "NETBSD"
+#	define HEURISTIC2
+	extern char etext;
+#	define DATASTART ((ptr_t)(&etext))
+#   endif
+#   ifdef LINUX
+#       define OS_TYPE "LINUX"
+#       define STACKBOTTOM ((ptr_t)0xf0000000)
+#       define MPROTECT_VDB
+#       ifdef __ELF__
+#            define DYNAMIC_LOADING
+             extern char **__environ;
+#            define DATASTART ((ptr_t)(&__environ))
+                             /* hideous kludge: __environ is the first */
+                             /* word in crt0.o, and delimits the start */
+                             /* of the data segment, no matter which   */
+                             /* ld options were passed through.        */
+                             /* We could use _etext instead, but that  */
+                             /* would include .rodata, which may       */
+                             /* contain large read-only data tables    */
+                             /* that we'd rather not scan.             */
+             extern int _end;
+#            define DATAEND (&_end)
+#       else
+             extern int etext;
+#            define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       endif
+#   endif
+#   ifdef SUNOS4
+#	define OS_TYPE "SUNOS4"
+	extern char etext;
+#	define DATASTART ((ptr_t)((((word) (&etext)) + 0x1ffff) & ~0x1ffff))
+#	define HEURISTIC1	/* differs	*/
+#	define DYNAMIC_LOADING
+#   endif
+#   ifdef HP
+#	define OS_TYPE "HP"
+	extern char etext;
+#       define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       define STACKBOTTOM ((ptr_t) 0xffeffffc)
+			      /* empirically determined.  seems to work. */
+#  	include <unistd.h>
+#	define GETPAGESIZE() sysconf(_SC_PAGE_SIZE)
+#   endif
+#   ifdef SYSV
+#	define OS_TYPE "SYSV"
+	extern etext;
+#   	define DATASTART ((ptr_t)((((word) (&etext)) + 0x3fffff) \
+				   & ~0x3fffff) \
+				  +((word)&etext & 0x1fff))
+	/* This only works for shared-text binaries with magic number 0413.
+	   The other sorts of SysV binaries put the data at the end of the text,
+	   in which case the default of &etext would work.  Unfortunately,
+	   handling both would require having the magic-number available.
+	   	   		-- Parag
+	   */
+#	define STACKBOTTOM ((ptr_t)0xFFFFFFFE)
+			/* The stack starts at the top of memory, but   */
+			/* 0x0 cannot be used as setjump_test complains */
+			/* that the stack direction is incorrect.  Two  */
+			/* bytes down from 0x0 should be safe enough.   */
+			/* 		--Parag				*/
+#   	include <sys/mmu.h>
+#	define GETPAGESIZE() PAGESIZE	/* Is this still right? */
+#   endif
+#   ifdef AMIGA
+#	define OS_TYPE "AMIGA"
+ 	    	/* STACKBOTTOM and DATASTART handled specially	*/
+ 	    	/* in os_dep.c					*/
+# 	define DATAEND	/* not needed */
+#	define GETPAGESIZE() 4096
+#   endif
+#   ifdef MACOS
+#     ifndef __LOWMEM__
+#     include <LowMem.h>
+#     endif
+#     define OS_TYPE "MACOS"
+			/* see os_dep.c for details of global data segments. */
+#     define STACKBOTTOM ((ptr_t) LMGetCurStackBase())
+#     define DATAEND	/* not needed */
+#     define GETPAGESIZE() 4096
+#   endif
+#   ifdef NEXT
+#	define OS_TYPE "NEXT"
+#	define DATASTART ((ptr_t) get_etext())
+#	define STACKBOTTOM ((ptr_t) 0x4000000)
+#	define DATAEND	/* not needed */
+#   endif
+# endif
+
+# ifdef POWERPC
+#   define MACH_TYPE "POWERPC"
+#   ifdef MACOS
+#     define ALIGNMENT 2  /* Still necessary?  Could it be 4?	*/
+#     ifndef __LOWMEM__
+#     include <LowMem.h>
+#     endif
+#     define OS_TYPE "MACOS"
+			/* see os_dep.c for details of global data segments. */
+#     define STACKBOTTOM ((ptr_t) LMGetCurStackBase())
+#     define DATAEND  /* not needed */
+#   endif
+#   ifdef LINUX
+#     define ALIGNMENT 4	/* Guess.  Can someone verify?	*/
+				/* This was 2, but that didn't sound right. */
+#     define OS_TYPE "LINUX"
+#     define HEURISTIC1
+#     define DYNAMIC_LOADING
+#     undef STACK_GRAN
+#     define STACK_GRAN 0x10000000
+	/* Stack usually starts at 0x80000000 */
+#     define LINUX_DATA_START
+      extern int _end;
+#     define DATAEND (&_end)
+#   endif
+#   ifdef MACOSX
+#     define ALIGNMENT 4
+#     define OS_TYPE "MACOSX"
+#     define DATASTART ((ptr_t) get_etext())
+#     define STACKBOTTOM ((ptr_t) 0xc0000000)
+#     define DATAEND	/* not needed */
+#   endif
+# endif
+
+# ifdef VAX
+#   define MACH_TYPE "VAX"
+#   define ALIGNMENT 4	/* Pointers are longword aligned by 4.2 C compiler */
+    extern char etext;
+#   define DATASTART ((ptr_t)(&etext))
+#   ifdef BSD
+#	define OS_TYPE "BSD"
+#	define HEURISTIC1
+			/* HEURISTIC2 may be OK, but it's hard to test. */
+#   endif
+#   ifdef ULTRIX
+#	define OS_TYPE "ULTRIX"
+#	define STACKBOTTOM ((ptr_t) 0x7fffc800)
+#   endif
+# endif
+
+# ifdef RT
+#   define MACH_TYPE "RT"
+#   define ALIGNMENT 4
+#   define DATASTART ((ptr_t) 0x10000000)
+#   define STACKBOTTOM ((ptr_t) 0x1fffd800)
+# endif
+
+# ifdef SPARC
+#   define MACH_TYPE "SPARC"
+#   define ALIGNMENT 4	/* Required by hardware	*/
+#   define ALIGN_DOUBLE
+    extern int etext;
+#   ifdef SUNOS5
+#	define OS_TYPE "SUNOS5"
+	extern int _etext;
+	extern int _end;
+	extern char * GC_SysVGetDataStart();
+#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &_etext)
+#	define DATAEND (&_end)
+#	ifndef USE_MMAP
+#	    define USE_MMAP
+#	endif
+#       ifdef USE_MMAP
+#         define HEAP_START (ptr_t)0x40000000
+#       else
+#	  define HEAP_START DATAEND
+#       endif
+#	define PROC_VDB
+/*	HEURISTIC1 reportedly no longer works under 2.7.  Thus we	*/
+/* 	switched to HEURISTIC2, eventhough it creates some debugging	*/
+/*	issues.								*/
+#	define HEURISTIC2
+#	include <unistd.h>
+#       define GETPAGESIZE()  sysconf(_SC_PAGESIZE)
+		/* getpagesize() appeared to be missing from at least one */
+		/* Solaris 5.4 installation.  Weird.			  */
+#	define DYNAMIC_LOADING
+#   endif
+#   ifdef SUNOS4
+#	define OS_TYPE "SUNOS4"
+	/* [If you have a weak stomach, don't read this.]		*/
+	/* We would like to use:					*/
+/* #       define DATASTART ((ptr_t)((((word) (&etext)) + 0x1fff) & ~0x1fff)) */
+	/* This fails occasionally, due to an ancient, but very 	*/
+	/* persistent ld bug.  &etext is set 32 bytes too high.		*/
+	/* We instead read the text segment size from the a.out		*/
+	/* header, which happens to be mapped into our address space	*/
+	/* at the start of the text segment.  The detective work here	*/
+	/* was done by Robert Ehrlich, Manuel Serrano, and Bernard	*/
+	/* Serpette of INRIA.						*/
+	/* This assumes ZMAGIC, i.e. demand-loadable executables.	*/
+#	define TEXTSTART 0x2000
+#       define DATASTART ((ptr_t)(*(int *)(TEXTSTART+0x4)+TEXTSTART))
+#	define MPROTECT_VDB
+#	define HEURISTIC1
+# 	define DYNAMIC_LOADING
+#   endif
+#   ifdef DRSNX
+#       define CPP_WORDSZ 32
+#	define OS_TYPE "DRSNX"
+	extern char * GC_SysVGetDataStart();
+	extern int etext;
+#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &etext)
+#	define MPROTECT_VDB
+#       define STACKBOTTOM ((ptr_t) 0xdfff0000)
+#	define DYNAMIC_LOADING
+#   endif
+#   ifdef LINUX
+#     define OS_TYPE "LINUX"
+#     ifdef __ELF__
+#       define LINUX_DATA_START
+#       define DYNAMIC_LOADING
+#     else
+          Linux Sparc non elf ?
+#     endif
+      extern int _end;
+#     define DATAEND (&_end)
+#     define SVR4
+#     define STACKBOTTOM ((ptr_t) 0xf0000000)
+#   endif
+#   ifdef OPENBSD
+#     define OS_TYPE "OPENBSD"
+#     define STACKBOTTOM ((ptr_t) 0xf8000000)
+#     define DATASTART ((ptr_t)(&etext))
+#   endif
+# endif
+
+# ifdef I386
+#   define MACH_TYPE "I386"
+#   define ALIGNMENT 4	/* Appears to hold for all "32 bit" compilers	*/
+			/* except Borland.  The -a4 option fixes 	*/
+			/* Borland.					*/
+                        /* Ivan Demakov: For Watcom the option is -zp4. */
+#   ifndef SMALL_CONFIG
+#     define ALIGN_DOUBLE /* Not strictly necessary, but may give speed   */
+			  /* improvement on Pentiums.			  */
+#   endif
+#   ifdef SEQUENT
+#	define OS_TYPE "SEQUENT"
+	extern int etext;
+#       define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       define STACKBOTTOM ((ptr_t) 0x3ffff000) 
+#   endif
+#   ifdef SUNOS5
+#	define OS_TYPE "SUNOS5"
+  	extern int etext, _start;
+  	extern char * GC_SysVGetDataStart();
+#       define DATASTART GC_SysVGetDataStart(0x1000, &etext)
+#	define STACKBOTTOM ((ptr_t)(&_start))
+/** At least in Solaris 2.5, PROC_VDB gives wrong values for dirty bits. */
+/*#	define PROC_VDB*/
+#	define DYNAMIC_LOADING
+#	ifndef USE_MMAP
+#	    define USE_MMAP
+#	endif
+#       ifdef USE_MMAP
+#         define HEAP_START (ptr_t)0x40000000
+#       else
+#	  define HEAP_START DATAEND
+#       endif
+#   endif
+#   ifdef SCO
+#	define OS_TYPE "SCO"
+	extern int etext;
+#   	define DATASTART ((ptr_t)((((word) (&etext)) + 0x3fffff) \
+				  & ~0x3fffff) \
+				 +((word)&etext & 0xfff))
+#	define STACKBOTTOM ((ptr_t) 0x7ffffffc)
+#   endif
+#   ifdef SCO_ELF
+#       define OS_TYPE "SCO_ELF"
+        extern int etext;
+#       define DATASTART ((ptr_t)(&etext))
+#       define STACKBOTTOM ((ptr_t) 0x08048000)
+#       define DYNAMIC_LOADING
+#	define ELF_CLASS ELFCLASS32
+#   endif
+#   ifdef LINUX
+#	define OS_TYPE "LINUX"
+#       define LINUX_STACKBOTTOM
+#	if 0
+#	  define HEURISTIC1
+#         undef STACK_GRAN
+#         define STACK_GRAN 0x10000000
+	  /* STACKBOTTOM is usually 0xc0000000, but this changes with	*/
+	  /* different kernel configurations.  In particular, systems	*/
+	  /* with 2GB physical memory will usually move the user	*/
+	  /* address space limit, and hence initial SP to 0x80000000.	*/
+#       endif
+#       if !defined(LINUX_THREADS) || !defined(REDIRECT_MALLOC)
+#	    define MPROTECT_VDB
+#	else
+	    /* We seem to get random errors in incremental mode,	*/
+	    /* possibly because Linux threads is itself a malloc client */
+	    /* and can't deal with the signals.				*/
+#	endif
+#       ifdef __ELF__
+#            define DYNAMIC_LOADING
+#	     ifdef UNDEFINED	/* includes ro data */
+	       extern int _etext;
+#              define DATASTART ((ptr_t)((((word) (&_etext)) + 0xfff) & ~0xfff))
+#	     endif
+#	     include <features.h>
+#	     if defined(__GLIBC__) && __GLIBC__ >= 2
+#		 define LINUX_DATA_START
+#	     else
+     	         extern char **__environ;
+#                define DATASTART ((ptr_t)(&__environ))
+			      /* hideous kludge: __environ is the first */
+			      /* word in crt0.o, and delimits the start */
+			      /* of the data segment, no matter which   */
+			      /* ld options were passed through.        */
+			      /* We could use _etext instead, but that  */
+			      /* would include .rodata, which may       */
+			      /* contain large read-only data tables    */
+			      /* that we'd rather not scan.		*/
+#	     endif
+	     extern int _end;
+#	     define DATAEND (&_end)
+#	else
+	     extern int etext;
+#            define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       endif
+#	ifdef USE_I686_PREFETCH
+#	  define PREFETCH(x) \
+	    __asm__ __volatile__ ("	prefetchnta	%0": : "m"(*(char *)(x)))
+	    /* Empirically prefetcht0 is much more effective at reducing	*/
+	    /* cache miss stalls for the targetted load instructions.  But it	*/
+	    /* seems to interfere enough with other cache traffic that the net	*/
+	    /* result is worse than prefetchnta.				*/
+#         if 0 
+	    /* Using prefetches for write seems to have a slight negative	*/
+	    /* impact on performance, at least for a PIII/500.			*/
+#	    define PREFETCH_FOR_WRITE(x) \
+	      __asm__ __volatile__ ("	prefetcht0	%0": : "m"(*(char *)(x)))
+#	  endif
+#	endif
+#	ifdef USE_3DNOW_PREFETCH
+#	  define PREFETCH(x) \
+	    __asm__ __volatile__ ("	prefetch	%0": : "m"(*(char *)(x)))
+#	  define PREFETCH_FOR_WRITE(x) 
+	    __asm__ __volatile__ ("	prefetchw	%0": : "m"(*(char *)(x)))
+#	endif
+#   endif
+#   ifdef CYGWIN32
+#       define OS_TYPE "CYGWIN32"
+          extern int _data_start__;
+          extern int _data_end__;
+          extern int _bss_start__;
+          extern int _bss_end__;
+  	/* For binutils 2.9.1, we have			*/
+  	/*	DATASTART   = _data_start__		*/
+  	/*	DATAEND	    = _bss_end__		*/
+  	/* whereas for some earlier versions it was	*/
+  	/*	DATASTART   = _bss_start__		*/
+  	/*	DATAEND	    = _data_end__		*/
+  	/* To get it right for both, we take the	*/
+  	/* minumum/maximum of the two.			*/
+#   	define MAX(x,y) ((x) > (y) ? (x) : (y))
+#   	define MIN(x,y) ((x) < (y) ? (x) : (y))
+#       define DATASTART ((ptr_t) MIN(&_data_start__, &_bss_start__))
+#       define DATAEND	 ((ptr_t) MAX(&_data_end__, &_bss_end__))
+#	undef STACK_GRAN
+#       define STACK_GRAN 0x10000
+#       define HEURISTIC1
+#   endif
+#   ifdef OS2
+#	define OS_TYPE "OS2"
+ 	    	/* STACKBOTTOM and DATASTART are handled specially in 	*/
+		/* os_dep.c. OS2 actually has the right			*/
+		/* system call!						*/
+#	define DATAEND	/* not needed */
+#   endif
+#   ifdef MSWIN32
+#	define OS_TYPE "MSWIN32"
+		/* STACKBOTTOM and DATASTART are handled specially in 	*/
+		/* os_dep.c.						*/
+#       ifndef __WATCOMC__
+#	  define MPROTECT_VDB
+#	endif
+#       define DATAEND  /* not needed */
+#   endif
+#   ifdef DJGPP
+#       define OS_TYPE "DJGPP"
+#       include "stubinfo.h"
+        extern int etext;
+        extern int _stklen;
+        extern int __djgpp_stack_limit;
+#       define DATASTART ((ptr_t)((((word) (&etext)) + 0x1ff) & ~0x1ff))
+/* #       define STACKBOTTOM ((ptr_t)((word) _stubinfo + _stubinfo->size \
+                                                     + _stklen)) */
+#       define STACKBOTTOM ((ptr_t)((word) __djgpp_stack_limit + _stklen))
+		/* This may not be right.  */
+#   endif
+#   ifdef OPENBSD
+#	define OS_TYPE "OPENBSD"
+#   endif
+#   ifdef FREEBSD
+#	define OS_TYPE "FREEBSD"
+#	define MPROTECT_VDB
+#   endif
+#   ifdef NETBSD
+#	define OS_TYPE "NETBSD"
+#   endif
+#   ifdef THREE86BSD
+#	define OS_TYPE "THREE86BSD"
+#   endif
+#   ifdef BSDI
+#	define OS_TYPE "BSDI"
+#   endif
+#   if defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD) \
+        || defined(THREE86BSD) || defined(BSDI)
+#	define HEURISTIC2
+	extern char etext;
+#	define DATASTART ((ptr_t)(&etext))
+#   endif
+#   ifdef NEXT
+#	define OS_TYPE "NEXT"
+#	define DATASTART ((ptr_t) get_etext())
+#	define STACKBOTTOM ((ptr_t)0xc0000000)
+#	define DATAEND	/* not needed */
+#   endif
+#   ifdef DOS4GW
+#     define OS_TYPE "DOS4GW"
+      extern long __nullarea;
+      extern char _end;
+      extern char *_STACKTOP;
+      /* Depending on calling conventions Watcom C either precedes
+         or does not precedes with undescore names of C-variables.
+         Make sure startup code variables always have the same names.  */
+      #pragma aux __nullarea "*";
+      #pragma aux _end "*";
+#     define STACKBOTTOM ((ptr_t) _STACKTOP)
+                         /* confused? me too. */
+#     define DATASTART ((ptr_t) &__nullarea)
+#     define DATAEND ((ptr_t) &_end)
+#   endif
+# endif
+
+# ifdef NS32K
+#   define MACH_TYPE "NS32K"
+#   define ALIGNMENT 4
+    extern char **environ;
+#   define DATASTART ((ptr_t)(&environ))
+			      /* hideous kludge: environ is the first   */
+			      /* word in crt0.o, and delimits the start */
+			      /* of the data segment, no matter which   */
+			      /* ld options were passed through.        */
+#   define STACKBOTTOM ((ptr_t) 0xfffff000) /* for Encore */
+# endif
+
+# ifdef MIPS
+#   define MACH_TYPE "MIPS"
+/* #   define STACKBOTTOM ((ptr_t)0x7fff8000)  sometimes also works.  */
+#   ifdef LINUX
+      /* This was developed for a linuxce style platform.  Probably	*/
+      /* needs to be tweaked for workstation class machines.		*/
+#     define OS_TYPE "LINUX"
+      extern int __data_start;
+#     define DATASTART ((ptr_t)(&__data_start))
+#     define ALIGNMENT 4
+#     define USE_GENERIC_PUSH_REGS 1
+#     define STACKBOTTOM 0x80000000
+	/* In many cases, this should probably use LINUX_STACKBOTTOM 	*/
+	/* instead. But some kernel versions seem to give the wrong	*/
+	/* value from /proc.						*/
+#   endif /* Linux */
+#   ifdef ULTRIX
+#	define HEURISTIC2
+#       define DATASTART (ptr_t)0x10000000
+			      /* Could probably be slightly higher since */
+			      /* startup code allocates lots of stuff.   */
+#	define OS_TYPE "ULTRIX"
+#       define ALIGNMENT 4
+#   endif
+#   ifdef RISCOS
+#	define HEURISTIC2
+#       define DATASTART (ptr_t)0x10000000
+#	define OS_TYPE "RISCOS"
+#   	define ALIGNMENT 4  /* Required by hardware */
+#   endif
+#   ifdef IRIX5
+#	define HEURISTIC2
+        extern int _fdata;
+#       define DATASTART ((ptr_t)(&_fdata))
+#       ifdef USE_MMAP
+#         define HEAP_START (ptr_t)0x30000000
+#       else
+#	  define HEAP_START DATASTART
+#       endif
+			      /* Lowest plausible heap address.		*/
+			      /* In the MMAP case, we map there.	*/
+			      /* In either case it is used to identify	*/
+			      /* heap sections so they're not 		*/
+			      /* considered as roots.			*/
+#	define OS_TYPE "IRIX5"
+#       define MPROTECT_VDB
+#       ifdef _MIPS_SZPTR
+#	  define CPP_WORDSZ _MIPS_SZPTR
+#	  define ALIGNMENT (_MIPS_SZPTR/8)
+#	  if CPP_WORDSZ != 64
+#	    define ALIGN_DOUBLE
+#	  endif
+#	else
+#         define ALIGNMENT 4
+#	  define ALIGN_DOUBLE
+#	endif
+#	define DYNAMIC_LOADING
+#   endif
+# endif
+
+# ifdef RS6000
+#   define MACH_TYPE "RS6000"
+#   define ALIGNMENT 4
+#   define DATASTART ((ptr_t)0x20000000)
+    extern int errno;
+#   define STACKBOTTOM ((ptr_t)((ulong)&errno))
+#   define DYNAMIC_LOADING
+	/* For really old versions of AIX, this may have to be removed. */
+# endif
+
+# ifdef HP_PA
+    /* OS is assumed to be HP/UX	*/
+#   define MACH_TYPE "HP_PA"
+#   define OS_TYPE "HPUX"
+#   ifdef __LP64__
+#     define CPP_WORDSZ 64
+#     define ALIGNMENT 8
+#   else
+#     define CPP_WORDSZ 32
+#     define ALIGNMENT 4
+#     define ALIGN_DOUBLE
+#   endif
+    extern int __data_start;
+#   define DATASTART ((ptr_t)(&__data_start))
+#   if 0
+	/* The following appears to work for 7xx systems running HP/UX	*/
+	/* 9.xx Furthermore, it might result in much faster		*/
+	/* collections than HEURISTIC2, which may involve scanning	*/
+	/* segments that directly precede the stack.  It is not the	*/
+	/* default, since it may not work on older machine/OS		*/
+	/* combinations. (Thanks to Raymond X.T. Nijssen for uncovering	*/
+	/* this.)							*/
+#       define STACKBOTTOM ((ptr_t) 0x7b033000)  /* from /etc/conf/h/param.h */
+#   else
+	/* Gustavo Rodriguez-Rivera suggested changing HEURISTIC2	*/
+	/* to this.  We'll probably do this on other platforms, too.	*/
+	/* For now I'll use it where I can test it.			*/
+	extern char ** environ;
+#       define STACKBOTTOM ((ptr_t)environ)
+#   endif
+#   define STACK_GROWS_UP
+#   define DYNAMIC_LOADING
+#   ifndef HPUX_THREADS
+#     define MPROTECT_VDB
+#   endif
+#   include <unistd.h>
+#   define GETPAGESIZE() sysconf(_SC_PAGE_SIZE)
+# endif
+
+# ifdef ALPHA
+#   define MACH_TYPE "ALPHA"
+#   define ALIGNMENT 8
+#   define USE_GENERIC_PUSH_REGS
+	/* Gcc and probably the DEC/Compaq compiler spill pointers to preserved	*/
+	/* fp registers in some cases when the target is a 21264.  The assembly	*/
+	/* code doesn't handle that yet, and version dependencies make that a	*/
+	/* bit tricky.  Do the easy thing for now.				*/
+#   ifdef OSF1
+#	define OS_TYPE "OSF1"
+#   	define DATASTART ((ptr_t) 0x140000000)
+	extern _end;
+#   	define DATAEND ((ptr_t) &_end)
+#   	define HEURISTIC2
+	/* Normally HEURISTIC2 is too conervative, since		*/
+	/* the text segment immediately follows the stack.		*/
+	/* Hence we give an upper pound.				*/
+    	extern int __start;
+#   	define HEURISTIC2_LIMIT ((ptr_t)((word)(&__start) & ~(getpagesize()-1)))
+#   	define CPP_WORDSZ 64
+#   	define MPROTECT_VDB
+#   	define DYNAMIC_LOADING
+#   endif
+#   ifdef LINUX
+#       define OS_TYPE "LINUX"
+#       define CPP_WORDSZ 64
+#       define STACKBOTTOM ((ptr_t) 0x120000000)
+#       ifdef __ELF__
+#	  define LINUX_DATA_START
+#         define DYNAMIC_LOADING
+	  /* This doesn't work if the collector is in a dynamic library. */
+#       else
+#           define DATASTART ((ptr_t) 0x140000000)
+#       endif
+	extern int _end;
+#	define DATAEND (&_end)
+#	define MPROTECT_VDB
+		/* Has only been superficially tested.  May not	*/
+		/* work on all versions.			*/
+#   endif
+# endif
+
+# ifdef IA64
+#   define MACH_TYPE "IA64"
+#   define ALIGN_DOUBLE
+	/* Requires 16 byte alignment for malloc */
+#   define ALIGNMENT 8
+#   define USE_GENERIC_PUSH_REGS
+	/* We need to get preserved registers in addition to register windows.	*/
+	/* That's easiest to do with setjmp.					*/
+#   ifdef HPUX
+	--> needs work
+#   endif
+#   ifdef LINUX
+#       define OS_TYPE "LINUX"
+#       define CPP_WORDSZ 64
+	/* This should really be done through /proc, but that	*/
+	/* requires we run on an IA64 kernel.			*/
+#       define STACKBOTTOM ((ptr_t) 0xa000000000000000l)
+	/* We also need the base address of the register stack	*/
+	/* backing store.  There is probably a better way to	*/
+	/* get that, too ...					*/
+#	define BACKING_STORE_BASE ((ptr_t) 0x9fffffff80000000l)
+#	if 1
+#	    define SEARCH_FOR_DATA_START
+#	    define DATASTART GC_data_start
+#	else
+	    extern int data_start;
+#	    define DATASTART ((ptr_t)(&data_start))
+#	endif
+#       define DYNAMIC_LOADING
+#	define MPROTECT_VDB
+		/* Requires Linux 2.3.47 or later.	*/
+	extern int _end;
+#	define DATAEND (&_end)
+#	define PREFETCH(x) \
+	  __asm__ ("	lfetch	[%0]": : "r"((void *)(x)))
+#	define PREFETCH_FOR_WRITE(x) \
+	  __asm__ ("	lfetch.excl	[%0]": : "r"((void *)(x)))
+#	define CLEAR_DOUBLE(x) \
+	  __asm__ ("	stf.spill	[%0]=f0": : "r"((void *)(x)))
+#   endif
+# endif
+
+# ifdef M88K
+#   define MACH_TYPE "M88K"
+#   define ALIGNMENT 4
+#   define ALIGN_DOUBLE
+    extern int etext;
+#   ifdef CX_UX
+#	define OS_TYPE "CX_UX"
+#       define DATASTART ((((word)&etext + 0x3fffff) & ~0x3fffff) + 0x10000)
+#   endif
+#   ifdef  DGUX
+#	define OS_TYPE "DGUX"
+	extern char * GC_SysVGetDataStart();
+#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &etext)
+#   endif
+#   define STACKBOTTOM ((char*)0xf0000000) /* determined empirically */
+# endif
+
+# ifdef S370
+#   define MACH_TYPE "S370"
+#   define OS_TYPE "UTS4"
+#   define ALIGNMENT 4	/* Required by hardware	*/
+    extern int etext;
+	extern int _etext;
+	extern int _end;
+	extern char * GC_SysVGetDataStart();
+#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &_etext)
+#	define DATAEND (&_end)
+#	define HEURISTIC2
+# endif
+
+# if defined(PJ)
+#   define ALIGNMENT 4
+    extern int _etext;
+#   define DATASTART ((ptr_t)(&_etext))
+#   define HEURISTIC1
+# endif
+
+# ifdef ARM32
+#   define CPP_WORDSZ 32
+#   define MACH_TYPE "ARM32"
+#   define ALIGNMENT 4
+#   ifdef NETBSD
+#       define OS_TYPE "NETBSD"
+#       define HEURISTIC2
+        extern char etext;
+#       define DATASTART ((ptr_t)(&etext))
+#       define USE_GENERIC_PUSH_REGS
+#   endif
+#   ifdef LINUX
+#       define OS_TYPE "LINUX"
+#       define HEURISTIC1
+#       undef STACK_GRAN
+#       define STACK_GRAN 0x10000000
+#       define USE_GENERIC_PUSH_REGS
+#       ifdef __ELF__
+#            define DYNAMIC_LOADING
+#	     include <features.h>
+#	     if defined(__GLIBC__) && __GLIBC__ >= 2
+#		 define LINUX_DATA_START
+#	     else
+     	         extern char **__environ;
+#                define DATASTART ((ptr_t)(&__environ))
+			      /* hideous kludge: __environ is the first */
+			      /* word in crt0.o, and delimits the start */
+			      /* of the data segment, no matter which   */
+			      /* ld options were passed through.        */
+			      /* We could use _etext instead, but that  */
+			      /* would include .rodata, which may       */
+			      /* contain large read-only data tables    */
+			      /* that we'd rather not scan.		*/
+#	     endif
+	     extern int _end;
+#	     define DATAEND (&_end)
+#	else
+	     extern int etext;
+#            define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       endif
+#   endif
+#endif
+
+#ifdef LINUX_DATA_START
+    /* Some Linux distributions arrange to define __data_start.  Some	*/
+    /* define data_start as a weak symbol.  The latter is technically	*/
+    /* broken, since the user program may define data_start, in which	*/
+    /* case we lose.  Nonetheless, we try both, prefering __data_start.	*/
+    /* We assume gcc.	*/
+#   pragma weak __data_start
+    extern int __data_start;
+#   pragma weak data_start
+    extern int data_start;
+#   define DATASTART ((ptr_t)(&__data_start != 0? &__data_start : &data_start))
+#endif
+
+# ifndef STACK_GROWS_UP
+#   define STACK_GROWS_DOWN
+# endif
+
+# ifndef CPP_WORDSZ
+#   define CPP_WORDSZ 32
+# endif
+
+# ifndef OS_TYPE
+#   define OS_TYPE ""
+# endif
+
+# ifndef DATAEND
+    extern int end;
+#   define DATAEND (&end)
+# endif
+
+# if defined(SVR4) && !defined(GETPAGESIZE)
+#    include <unistd.h>
+#    define GETPAGESIZE()  sysconf(_SC_PAGESIZE)
+# endif
+
+# ifndef GETPAGESIZE
+#   if defined(SUNOS5) || defined(IRIX5)
+#	include <unistd.h>
+#   endif
+#   define GETPAGESIZE() getpagesize()
+# endif
+
+# if defined(SUNOS5) || defined(DRSNX) || defined(UTS4)
+    /* OS has SVR4 generic features.  Probably others also qualify.	*/
+#   define SVR4
+# endif
+
+# if defined(SUNOS5) || defined(DRSNX)
+    /* OS has SUNOS5 style semi-undocumented interface to dynamic 	*/
+    /* loader.								*/
+#   define SUNOS5DL
+    /* OS has SUNOS5 style signal handlers.				*/
+#   define SUNOS5SIGS
+# endif
+
+# if defined(HPUX)
+#   define SUNOS5SIGS
+# endif
+
+# if CPP_WORDSZ != 32 && CPP_WORDSZ != 64
+   -> bad word size
+# endif
+
+# ifdef PCR
+#   undef DYNAMIC_LOADING
+#   undef STACKBOTTOM
+#   undef HEURISTIC1
+#   undef HEURISTIC2
+#   undef PROC_VDB
+#   undef MPROTECT_VDB
+#   define PCR_VDB
+# endif
+
+# ifdef SRC_M3
+/* Postponed for now. */
+#   undef PROC_VDB
+#   undef MPROTECT_VDB
+# endif
+
+# ifdef SMALL_CONFIG
+/* Presumably not worth the space it takes. */
+#   undef PROC_VDB
+#   undef MPROTECT_VDB
+# endif
+
+# ifdef USE_MUNMAP
+#   undef MPROTECT_VDB  /* Can't deal with address space holes. */
+# endif
+
+# if !defined(PCR_VDB) && !defined(PROC_VDB) && !defined(MPROTECT_VDB)
+#   define DEFAULT_VDB
+# endif
+
+# ifndef PREFETCH
+#   define PREFETCH(x)
+#   define NO_PREFETCH
+# endif
+
+# ifndef PREFETCH_FOR_WRITE
+#   define PREFETCH_FOR_WRITE(x)
+#   define NO_PREFETCH_FOR_WRITE
+# endif
+
+# ifndef CACHE_LINE_SIZE
+#   define CACHE_LINE_SIZE 32	/* Wild guess	*/
+# endif
+
+# ifndef CLEAR_DOUBLE
+#   define CLEAR_DOUBLE(x) \
+	((word*)x)[0] = 0; \
+	((word*)x)[1] = 0;
+# endif /* CLEAR_DOUBLE */
+
+# if defined(_SOLARIS_PTHREADS) && !defined(SOLARIS_THREADS)
+#   define SOLARIS_THREADS
+# endif
+# if defined(IRIX_THREADS) && !defined(IRIX5)
+--> inconsistent configuration
+# endif
+# if defined(IRIX_JDK_THREADS) && !defined(IRIX5)
+--> inconsistent configuration
+# endif
+# if defined(LINUX_THREADS) && !defined(LINUX)
+--> inconsistent configuration
+# endif
+# if defined(SOLARIS_THREADS) && !defined(SUNOS5)
+--> inconsistent configuration
+# endif
+# if defined(HPUX_THREADS) && !defined(HPUX)
+--> inconsistent configuration
+# endif
+# if defined(PCR) || defined(SRC_M3) || \
+	defined(SOLARIS_THREADS) || defined(WIN32_THREADS) || \
+	defined(IRIX_THREADS) || defined(LINUX_THREADS) || \
+	defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
+#   define THREADS
+# endif
+
+# if defined(HP_PA) || defined(M88K) || defined(POWERPC) \
+     || (defined(I386) && defined(OS2)) || defined(UTS4) || defined(LINT)
+	/* Use setjmp based hack to mark from callee-save registers. */
+#	define USE_GENERIC_PUSH_REGS
+# endif
+# if defined(SPARC) && !defined(LINUX)
+#   define SAVE_CALL_CHAIN
+#   define ASM_CLEAR_CODE	/* Stack clearing is crucial, and we 	*/
+				/* include assembly code to do it well.	*/
+# endif
+
+# endif /* GCCONFIG_H */
diff --git a/src/gc/gcj_mlc.c b/src/gc/gcj_mlc.c
new file mode 100644
index 000000000..eb67eac1f
--- /dev/null
+++ b/src/gc/gcj_mlc.c
@@ -0,0 +1,289 @@
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+/* Boehm, July 31, 1995 5:02 pm PDT */
+
+#ifdef GC_GCJ_SUPPORT
+
+/*
+ * This is an allocator interface tuned for gcj (the GNU/Cygnus static
+ * java compiler).
+ *
+ * Each allocated object has a pointer in its first word to a vtable,
+ * which for our purposes is simply a structure describing the type of
+ * the object.
+ * This descriptor structur contains a GC marking descriptor at offset
+ * MARK_DESCR_OFFSET.
+ *
+ * It is hoped that this interface may also be useful for other systems,
+ * possibly with some tuning of the constants.  But the immediate goal
+ * is to get better gcj performance.
+ *
+ * We assume:
+ *  1) We have an ANSI conforming C compiler.
+ *  2) Counting on explicit initialization of this interface is OK.
+ *  3) FASTLOCK is not a significant win.
+ */
+
+#include "gc_priv.h"
+#include "gc_mark.h"
+#include "include/gc_gcj.h"
+#include "dbg_mlc.h"
+
+GC_bool GC_gcj_malloc_initialized = FALSE;
+
+int GC_gcj_kind;	/* Object kind for objects with descriptors     */
+			/* in "vtable".					*/
+int GC_gcj_debug_kind;	/* The kind of objects that is always marked 	*/
+			/* with a mark proc call.			*/
+
+ptr_t * GC_gcjobjfreelist;
+ptr_t * GC_gcjdebugobjfreelist;
+
+void * GC_default_oom_action(void) { return 0; }
+
+void * (*GC_oom_action)(void) = GC_default_oom_action;
+
+/* Caller does not hold allocation lock. */
+void GC_init_gcj_malloc(int mp_index, void * /* really mark_proc */mp)
+{
+    register int i;
+    DCL_LOCK_STATE;
+
+    GC_init();	/* In case it's not already done.	*/
+    DISABLE_SIGNALS();
+    LOCK();
+    if (GC_gcj_malloc_initialized) {
+      UNLOCK();
+      ENABLE_SIGNALS();
+      return;
+    }
+    GC_gcj_malloc_initialized = TRUE;
+    GC_mark_procs[mp_index] = (mark_proc)mp;
+    if (mp_index >= GC_n_mark_procs) ABORT("GC_init_gcj_malloc: bad index");
+    /* Set up object kind gcj-style indirect descriptor. */
+      GC_gcjobjfreelist = (ptr_t *)
+          GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+      if (GC_gcjobjfreelist == 0) ABORT("Couldn't allocate GC_gcjobjfreelist");
+      BZERO(GC_gcjobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+      GC_gcj_kind = GC_n_kinds++;
+      GC_obj_kinds[GC_gcj_kind].ok_freelist = GC_gcjobjfreelist;
+      GC_obj_kinds[GC_gcj_kind].ok_reclaim_list = 0;
+      GC_obj_kinds[GC_gcj_kind].ok_descriptor =
+    	(((word)(-MARK_DESCR_OFFSET - INDIR_PER_OBJ_BIAS)) | DS_PER_OBJECT);
+      GC_obj_kinds[GC_gcj_kind].ok_relocate_descr = FALSE;
+      GC_obj_kinds[GC_gcj_kind].ok_init = TRUE;
+    /* Set up object kind for objects that require mark proc call.	*/
+      GC_gcjdebugobjfreelist = (ptr_t *)
+          GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+      if (GC_gcjdebugobjfreelist == 0)
+	  ABORT("Couldn't allocate GC_gcjdebugobjfreelist");
+      BZERO(GC_gcjdebugobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+      GC_gcj_debug_kind = GC_n_kinds++;
+      GC_obj_kinds[GC_gcj_debug_kind].ok_freelist = GC_gcjdebugobjfreelist;
+      GC_obj_kinds[GC_gcj_debug_kind].ok_reclaim_list = 0;
+      GC_obj_kinds[GC_gcj_debug_kind].ok_descriptor =
+    	MAKE_PROC(mp_index, 1 /* allocated with debug info */);
+      GC_obj_kinds[GC_gcj_debug_kind].ok_relocate_descr = FALSE;
+      GC_obj_kinds[GC_gcj_debug_kind].ok_init = TRUE;
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+
+ptr_t GC_clear_stack();
+
+#define GENERAL_MALLOC(lb,k) \
+    (GC_PTR)GC_clear_stack(GC_generic_malloc_inner((word)lb, k))
+    
+#define GENERAL_MALLOC_IOP(lb,k) \
+    (GC_PTR)GC_clear_stack(GC_generic_malloc_inner_ignore_off_page(lb, k))
+
+/* Allocate an object, clear it, and store the pointer to the	*/
+/* type structure (vtable in gcj).				*/
+/* This adds a byte at the end of the object if GC_malloc would.*/
+void * GC_gcj_malloc(size_t lb, void * ptr_to_struct_containing_descr)
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_gcjobjfreelist[lw]);
+	LOCK();
+        if( (op = *opp) == 0 ) {
+            op = (ptr_t)GENERAL_MALLOC((word)lb, GC_gcj_kind);
+	    if (0 == op) {
+		UNLOCK();
+		return(GC_oom_action());
+	    }
+#	    ifdef MERGE_SIZES
+		lw = GC_size_map[lb];	/* May have been uninitialized.	*/
+#	    endif
+        } else {
+            *opp = obj_link(op);
+            GC_words_allocd += lw;
+            FASTUNLOCK();
+        }
+	*(void **)op = ptr_to_struct_containing_descr;
+	UNLOCK();
+    } else {
+	LOCK();
+	op = (ptr_t)GENERAL_MALLOC((word)lb, GC_gcj_kind);
+	if (0 == op) {
+	    UNLOCK();
+	    return(GC_oom_action());
+	}
+	*(void **)op = ptr_to_struct_containing_descr;
+	UNLOCK();
+    }
+    return((GC_PTR) op);
+}
+
+/* Similar to GC_gcj_malloc, but add debug info.  This is allocated	*/
+/* with GC_gcj_debug_kind.						*/
+GC_PTR GC_debug_gcj_malloc(size_t lb, void * ptr_to_struct_containing_descr,
+			   GC_EXTRA_PARAMS)
+{
+    GC_PTR result;
+
+    /* We clone the code from GC_debug_gcj_malloc, so that we 	*/
+    /* dont end up with extra frames on the stack, which could	*/
+    /* confuse the backtrace.					*/
+    LOCK();
+    result = GC_generic_malloc_inner(lb + DEBUG_BYTES, GC_gcj_debug_kind);
+    if (result == 0) {
+	UNLOCK();
+        GC_err_printf2("GC_debug_gcj_malloc(%ld, 0x%lx) returning NIL (",
+        	       (unsigned long) lb,
+		       (unsigned long) ptr_to_struct_containing_descr);
+        GC_err_puts(s);
+        GC_err_printf1(":%ld)\n", (unsigned long)i);
+        return(GC_oom_action());
+    }
+    *((void **)((ptr_t)result + sizeof(oh))) = ptr_to_struct_containing_descr;
+    UNLOCK();
+    if (!GC_debugging_started) {
+    	GC_start_debugging();
+    }
+    ADD_CALL_CHAIN(result, ra);
+    return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+/* Similar to GC_gcj_malloc, but the size is in words, and we don't	*/
+/* adjust it.  The size is assumed to be such that it can be 	*/
+/* allocated as a small object.					*/
+void * GC_gcj_fast_malloc(size_t lw, void * ptr_to_struct_containing_descr)
+{
+ptr_t op;
+ptr_t * opp;
+DCL_LOCK_STATE;
+
+    opp = &(GC_gcjobjfreelist[lw]);
+    LOCK();
+    if( (op = *opp) == 0 ) {
+        op = (ptr_t)GC_clear_stack(
+		GC_generic_malloc_words_small_inner(lw, GC_gcj_kind));
+	if (0 == op) {
+	    UNLOCK();
+	    return(GC_oom_action());
+	}
+    } else {
+        *opp = obj_link(op);
+        GC_words_allocd += lw;
+    }
+    *(void **)op = ptr_to_struct_containing_descr;
+    UNLOCK();
+    return((GC_PTR) op);
+}
+
+/* And a debugging version of the above:	*/
+void * GC_debug_gcj_fast_malloc(size_t lw,
+				void * ptr_to_struct_containing_descr,
+				GC_EXTRA_PARAMS)
+{
+    GC_PTR result;
+    size_t lb = WORDS_TO_BYTES(lw);
+
+    /* We clone the code from GC_debug_gcj_malloc, so that we 	*/
+    /* dont end up with extra frames on the stack, which could	*/
+    /* confuse the backtrace.					*/
+    LOCK();
+    result = GC_generic_malloc_inner(lb + DEBUG_BYTES, GC_gcj_debug_kind);
+    if (result == 0) {
+	UNLOCK();
+        GC_err_printf2("GC_debug_gcj_fast_malloc(%ld, 0x%lx) returning NIL (",
+        	       (unsigned long) lw,
+		       (unsigned long) ptr_to_struct_containing_descr);
+        GC_err_puts(s);
+        GC_err_printf1(":%ld)\n", (unsigned long)i);
+        return(GC_oom_action());
+    }
+    *((void **)((ptr_t)result + sizeof(oh))) = ptr_to_struct_containing_descr;
+    UNLOCK();
+    if (!GC_debugging_started) {
+    	GC_start_debugging();
+    }
+    ADD_CALL_CHAIN(result, ra);
+    return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+void * GC_gcj_malloc_ignore_off_page(size_t lb,
+				     void * ptr_to_struct_containing_descr) 
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_gcjobjfreelist[lw]);
+	LOCK();
+        if( (op = *opp) == 0 ) {
+            op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_gcj_kind);
+#	    ifdef MERGE_SIZES
+		lw = GC_size_map[lb];	/* May have been uninitialized.	*/
+#	    endif
+        } else {
+            *opp = obj_link(op);
+            GC_words_allocd += lw;
+            FASTUNLOCK();
+        }
+	*(void **)op = ptr_to_struct_containing_descr;
+	UNLOCK();
+    } else {
+        op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_gcj_kind);
+        if (0 != op) {
+          *(void **)op = ptr_to_struct_containing_descr;
+	}
+        UNLOCK();
+    }
+    return((GC_PTR) op);
+}
+
+#else
+
+char GC_no_gcj_support;
+
+#endif  /* GC_GCJ_SUPPORT */
diff --git a/src/gc/headers.c b/src/gc/headers.c
new file mode 100644
index 000000000..6e47bba8e
--- /dev/null
+++ b/src/gc/headers.c
@@ -0,0 +1,358 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+ 
+/*
+ * This implements:
+ * 1. allocation of heap block headers
+ * 2. A map from addresses to heap block addresses to heap block headers
+ *
+ * Access speed is crucial.  We implement an index structure based on a 2
+ * level tree.
+ */
+ 
+# include "gc_priv.h"
+
+bottom_index * GC_all_bottom_indices = 0;
+				/* Pointer to first (lowest addr) */
+				/* bottom_index.		  */
+
+bottom_index * GC_all_bottom_indices_end = 0;
+				/* Pointer to last (highest addr) */
+				/* bottom_index.		  */
+ 
+/* Non-macro version of header location routine */
+hdr * GC_find_header(h)
+ptr_t h;
+{
+#   ifdef HASH_TL
+	register hdr * result;
+	GET_HDR(h, result);
+	return(result);
+#   else
+	return(HDR_INNER(h));
+#   endif
+}
+ 
+/* Routines to dynamically allocate collector data structures that will */
+/* never be freed.							 */
+ 
+static ptr_t scratch_free_ptr = 0;
+ 
+/* GC_scratch_last_end_ptr is end point of last obtained scratch area.  */
+/* GC_scratch_end_ptr is end point of current scratch area.		*/
+ 
+ptr_t GC_scratch_alloc(bytes)
+register word bytes;
+{
+    register ptr_t result = scratch_free_ptr;
+
+#   ifdef ALIGN_DOUBLE
+#	define GRANULARITY (2 * sizeof(word))
+#   else
+#	define GRANULARITY sizeof(word)
+#   endif
+    bytes += GRANULARITY-1;
+    bytes &= ~(GRANULARITY-1);
+    scratch_free_ptr += bytes;
+    if (scratch_free_ptr <= GC_scratch_end_ptr) {
+        return(result);
+    }
+    {
+        word bytes_to_get = MINHINCR * HBLKSIZE;
+         
+        if (bytes_to_get <= bytes) {
+          /* Undo the damage, and get memory directly */
+	    bytes_to_get = bytes;
+#	    ifdef USE_MMAP
+		bytes_to_get += GC_page_size - 1;
+		bytes_to_get &= ~(GC_page_size - 1);
+#	    endif
+   	    result = (ptr_t)GET_MEM(bytes_to_get);
+            scratch_free_ptr -= bytes;
+	    GC_scratch_last_end_ptr = result + bytes;
+            return(result);
+        }
+        result = (ptr_t)GET_MEM(bytes_to_get);
+        if (result == 0) {
+#	    ifdef PRINTSTATS
+                GC_printf0("Out of memory - trying to allocate less\n");
+#	    endif
+            scratch_free_ptr -= bytes;
+	    bytes_to_get = bytes;
+#	    ifdef USE_MMAP
+		bytes_to_get += GC_page_size - 1;
+		bytes_to_get &= ~(GC_page_size - 1);
+#	    endif
+            return((ptr_t)GET_MEM(bytes_to_get));
+        }
+        scratch_free_ptr = result;
+        GC_scratch_end_ptr = scratch_free_ptr + bytes_to_get;
+        GC_scratch_last_end_ptr = GC_scratch_end_ptr;
+        return(GC_scratch_alloc(bytes));
+    }
+}
+
+static hdr * hdr_free_list = 0;
+
+/* Return an uninitialized header */
+static hdr * alloc_hdr()
+{
+    register hdr * result;
+    
+    if (hdr_free_list == 0) {
+        result = (hdr *) GC_scratch_alloc((word)(sizeof(hdr)));
+    } else {
+        result = hdr_free_list;
+        hdr_free_list = (hdr *) (result -> hb_next);
+    }
+    return(result);
+}
+
+static void free_hdr(hhdr)
+hdr * hhdr;
+{
+    hhdr -> hb_next = (struct hblk *) hdr_free_list;
+    hdr_free_list = hhdr;
+}
+
+hdr * GC_invalid_header;
+
+#ifdef USE_HDR_CACHE
+  word GC_hdr_cache_hits = 0;
+  word GC_hdr_cache_misses = 0;
+#endif
+ 
+void GC_init_headers()
+{
+    register unsigned i;
+    
+    GC_all_nils = (bottom_index *)GC_scratch_alloc((word)sizeof(bottom_index));
+    BZERO(GC_all_nils, sizeof(bottom_index));
+    for (i = 0; i < TOP_SZ; i++) {
+        GC_top_index[i] = GC_all_nils;
+    }
+    GC_invalid_header = alloc_hdr();
+    GC_invalidate_map(GC_invalid_header);
+}
+
+/* Make sure that there is a bottom level index block for address addr  */
+/* Return FALSE on failure.						*/
+static GC_bool get_index(addr)
+word addr;
+{
+    word hi = (word)(addr) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
+    bottom_index * r;
+    bottom_index * p;
+    bottom_index ** prev;
+    bottom_index *pi;
+    
+#   ifdef HASH_TL
+      unsigned i = TL_HASH(hi);
+      bottom_index * old;
+      
+      old = p = GC_top_index[i];
+      while(p != GC_all_nils) {
+          if (p -> key == hi) return(TRUE);
+          p = p -> hash_link;
+      }
+      r = (bottom_index*)GC_scratch_alloc((word)(sizeof (bottom_index)));
+      if (r == 0) return(FALSE);
+      BZERO(r, sizeof (bottom_index));
+      r -> hash_link = old;
+      GC_top_index[i] = r;
+#   else
+      if (GC_top_index[hi] != GC_all_nils) return(TRUE);
+      r = (bottom_index*)GC_scratch_alloc((word)(sizeof (bottom_index)));
+      if (r == 0) return(FALSE);
+      GC_top_index[hi] = r;
+      BZERO(r, sizeof (bottom_index));
+#   endif
+    r -> key = hi;
+    /* Add it to the list of bottom indices */
+      prev = &GC_all_bottom_indices;  	/* pointer to p */
+      pi = 0;				/* bottom_index preceding p */
+      while ((p = *prev) != 0 && p -> key < hi) {
+	pi = p;
+	prev = &(p -> asc_link);
+      }
+      r -> desc_link = pi;
+      if (0 == p) {
+	GC_all_bottom_indices_end = r;
+      } else {
+	p -> desc_link = r;
+      }
+      r -> asc_link = p;
+      *prev = r;
+    return(TRUE);
+}
+
+/* Install a header for block h.	*/
+/* The header is uninitialized.	  	*/
+/* Returns the header or 0 on failure.	*/
+struct hblkhdr * GC_install_header(h)
+register struct hblk * h;
+{
+    hdr * result;
+    
+    if (!get_index((word) h)) return(FALSE);
+    result = alloc_hdr();
+    SET_HDR(h, result);
+#   ifdef USE_MUNMAP
+	result -> hb_last_reclaimed = GC_gc_no;
+#   endif
+    return(result);
+}
+
+/* Set up forwarding counts for block h of size sz */
+GC_bool GC_install_counts(h, sz)
+register struct hblk * h;
+register word sz; /* bytes */
+{
+    register struct hblk * hbp;
+    register int i;
+    
+    for (hbp = h; (char *)hbp < (char *)h + sz; hbp += BOTTOM_SZ) {
+        if (!get_index((word) hbp)) return(FALSE);
+    }
+    if (!get_index((word)h + sz - 1)) return(FALSE);
+    for (hbp = h + 1; (char *)hbp < (char *)h + sz; hbp += 1) {
+        i = HBLK_PTR_DIFF(hbp, h);
+        SET_HDR(hbp, (hdr *)(i > MAX_JUMP? MAX_JUMP : i));
+    }
+    return(TRUE);
+}
+
+/* Remove the header for block h */
+void GC_remove_header(h)
+register struct hblk * h;
+{
+    hdr ** ha;
+    
+    GET_HDR_ADDR(h, ha);
+    free_hdr(*ha);
+    *ha = 0;
+}
+
+/* Remove forwarding counts for h */
+void GC_remove_counts(h, sz)
+register struct hblk * h;
+register word sz; /* bytes */
+{
+    register struct hblk * hbp;
+    
+    for (hbp = h+1; (char *)hbp < (char *)h + sz; hbp += 1) {
+        SET_HDR(hbp, 0);
+    }
+}
+
+/* Apply fn to all allocated blocks */
+/*VARARGS1*/
+void GC_apply_to_all_blocks(fn, client_data)
+void (*fn)(/* struct hblk *h, word client_data */);
+word client_data;
+{
+    register int j;
+    register bottom_index * index_p;
+    
+    for (index_p = GC_all_bottom_indices; index_p != 0;
+         index_p = index_p -> asc_link) {
+        for (j = BOTTOM_SZ-1; j >= 0;) {
+            if (!IS_FORWARDING_ADDR_OR_NIL(index_p->index[j])) {
+                if (index_p->index[j]->hb_map != GC_invalid_map) {
+                    (*fn)(((struct hblk *)
+                  	      (((index_p->key << LOG_BOTTOM_SZ) + (word)j)
+                  	       << LOG_HBLKSIZE)),
+                          client_data);
+                }
+                j--;
+             } else if (index_p->index[j] == 0) {
+                j--;
+             } else {
+                j -= (word)(index_p->index[j]);
+             }
+         }
+     }
+}
+
+/* Get the next valid block whose address is at least h	*/
+/* Return 0 if there is none.				*/
+struct hblk * GC_next_used_block(h)
+struct hblk * h;
+{
+    register bottom_index * bi;
+    register word j = ((word)h >> LOG_HBLKSIZE) & (BOTTOM_SZ-1);
+    
+    GET_BI(h, bi);
+    if (bi == GC_all_nils) {
+        register word hi = (word)h >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
+        bi = GC_all_bottom_indices;
+        while (bi != 0 && bi -> key < hi) bi = bi -> asc_link;
+        j = 0;
+    }
+    while(bi != 0) {
+        while (j < BOTTOM_SZ) {
+	    hdr * hhdr = bi -> index[j];
+            if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+                j++;
+            } else {
+                if (hhdr->hb_map != GC_invalid_map) {
+                    return((struct hblk *)
+                  	      (((bi -> key << LOG_BOTTOM_SZ) + j)
+                  	       << LOG_HBLKSIZE));
+                } else {
+                    j += divHBLKSZ(hhdr -> hb_sz);
+                }
+            }
+        }
+        j = 0;
+        bi = bi -> asc_link;
+    }
+    return(0);
+}
+
+/* Get the last (highest address) block whose address is 	*/
+/* at most h.  Return 0 if there is none.			*/
+/* Unlike the above, this may return a free block.		*/
+struct hblk * GC_prev_block(h)
+struct hblk * h;
+{
+    register bottom_index * bi;
+    register signed_word j = ((word)h >> LOG_HBLKSIZE) & (BOTTOM_SZ-1);
+    
+    GET_BI(h, bi);
+    if (bi == GC_all_nils) {
+        register word hi = (word)h >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
+        bi = GC_all_bottom_indices_end;
+        while (bi != 0 && bi -> key > hi) bi = bi -> desc_link;
+        j = BOTTOM_SZ - 1;
+    }
+    while(bi != 0) {
+        while (j >= 0) {
+	    hdr * hhdr = bi -> index[j];
+	    if (0 == hhdr) {
+		--j;
+            } else if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+                j -= (signed_word)hhdr;
+            } else {
+                return((struct hblk *)
+                          (((bi -> key << LOG_BOTTOM_SZ) + j)
+                  	       << LOG_HBLKSIZE));
+            }
+        }
+        j = BOTTOM_SZ - 1;
+        bi = bi -> desc_link;
+    }
+    return(0);
+}
diff --git a/src/gc/hpux_irix_threads.c b/src/gc/hpux_irix_threads.c
new file mode 100644
index 000000000..f6e743652
--- /dev/null
+++ b/src/gc/hpux_irix_threads.c
@@ -0,0 +1,746 @@
+/* 
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Support code for Irix (>=6.2) Pthreads.  This relies on properties
+ * not guaranteed by the Pthread standard.  It may or may not be portable
+ * to other implementations.
+ *
+ * This now also includes an initial attempt at thread support for
+ * HP/UX 11.
+ *
+ * Note that there is a lot of code duplication between linux_threads.c
+ * and hpux_irix_threads.c; any changes made here may need to be reflected
+ * there too.
+ */
+
+# if defined(IRIX_THREADS) || defined(HPUX_THREADS)
+
+# if defined(HPUX_THREADS)
+#   include <sys/semaphore.h>
+# endif
+
+# include "gc_priv.h"
+# include <pthread.h>
+# include <semaphore.h>
+# include <time.h>
+# include <errno.h>
+# include <unistd.h>
+# include <sys/mman.h>
+# include <sys/time.h>
+
+#undef pthread_create
+#undef pthread_sigmask
+#undef pthread_join
+
+void GC_thr_init();
+
+#if 0
+void GC_print_sig_mask()
+{
+    sigset_t blocked;
+    int i;
+
+    if (pthread_sigmask(SIG_BLOCK, NULL, &blocked) != 0)
+    	ABORT("pthread_sigmask");
+    GC_printf0("Blocked: ");
+    for (i = 1; i <= MAXSIG; i++) {
+        if (sigismember(&blocked, i)) { GC_printf1("%ld ",(long) i); }
+    }
+    GC_printf0("\n");
+}
+#endif
+
+/* We use the allocation lock to protect thread-related data structures. */
+
+/* The set of all known threads.  We intercept thread creation and 	*/
+/* joins.  We never actually create detached threads.  We allocate all 	*/
+/* new thread stacks ourselves.  These allow us to maintain this	*/
+/* data structure.							*/
+/* Protected by GC_thr_lock.						*/
+/* Some of this should be declared volatile, but that's incosnsistent	*/
+/* with some library routine declarations.  		 		*/
+typedef struct GC_Thread_Rep {
+    struct GC_Thread_Rep * next;  /* More recently allocated threads	*/
+				  /* with a given pthread id come 	*/
+				  /* first.  (All but the first are	*/
+				  /* guaranteed to be dead, but we may  */
+				  /* not yet have registered the join.) */
+    pthread_t id;
+    word stop;
+#	define NOT_STOPPED 0
+#	define PLEASE_STOP 1
+#	define STOPPED 2
+    word flags;
+#	define FINISHED 1   	/* Thread has exited.	*/
+#	define DETACHED 2	/* Thread is intended to be detached.	*/
+#	define CLIENT_OWNS_STACK	4
+				/* Stack was supplied by client.	*/
+    ptr_t stack;
+    ptr_t stack_ptr;  		/* Valid only when stopped. */
+				/* But must be within stack region at	*/
+				/* all times.				*/
+    size_t stack_size;		/* 0 for original thread.	*/
+    void * status;		/* Used only to avoid premature 	*/
+				/* reclamation of any data it might 	*/
+				/* reference.				*/
+} * GC_thread;
+
+GC_thread GC_lookup_thread(pthread_t id);
+
+/*
+ * The only way to suspend threads given the pthread interface is to send
+ * signals.  Unfortunately, this means we have to reserve
+ * a signal, and intercept client calls to change the signal mask.
+ */
+# define SIG_SUSPEND (SIGRTMIN + 6)
+
+pthread_mutex_t GC_suspend_lock = PTHREAD_MUTEX_INITIALIZER;
+				/* Number of threads stopped so far	*/
+pthread_cond_t GC_suspend_ack_cv = PTHREAD_COND_INITIALIZER;
+pthread_cond_t GC_continue_cv = PTHREAD_COND_INITIALIZER;
+
+void GC_suspend_handler(int sig)
+{
+    int dummy;
+    GC_thread me;
+    sigset_t all_sigs;
+    sigset_t old_sigs;
+    int i;
+
+    if (sig != SIG_SUSPEND) ABORT("Bad signal in suspend_handler");
+    me = GC_lookup_thread(pthread_self());
+    /* The lookup here is safe, since I'm doing this on behalf  */
+    /* of a thread which holds the allocation lock in order	*/
+    /* to stop the world.  Thus concurrent modification of the	*/
+    /* data structure is impossible.				*/
+    if (PLEASE_STOP != me -> stop) {
+	/* Misdirected signal.	*/
+	pthread_mutex_unlock(&GC_suspend_lock);
+	return;
+    }
+    pthread_mutex_lock(&GC_suspend_lock);
+    me -> stack_ptr = (ptr_t)(&dummy);
+    me -> stop = STOPPED;
+    pthread_cond_signal(&GC_suspend_ack_cv);
+    pthread_cond_wait(&GC_continue_cv, &GC_suspend_lock);
+    pthread_mutex_unlock(&GC_suspend_lock);
+    /* GC_printf1("Continuing 0x%x\n", pthread_self()); */
+}
+
+
+GC_bool GC_thr_initialized = FALSE;
+
+size_t GC_min_stack_sz;
+
+size_t GC_page_sz;
+
+# define N_FREE_LISTS 25
+ptr_t GC_stack_free_lists[N_FREE_LISTS] = { 0 };
+		/* GC_stack_free_lists[i] is free list for stacks of 	*/
+		/* size GC_min_stack_sz*2**i.				*/
+		/* Free lists are linked through first word.		*/
+
+/* Return a stack of size at least *stack_size.  *stack_size is	*/
+/* replaced by the actual stack size.				*/
+/* Caller holds allocation lock.				*/
+ptr_t GC_stack_alloc(size_t * stack_size)
+{
+    register size_t requested_sz = *stack_size;
+    register size_t search_sz = GC_min_stack_sz;
+    register int index = 0;	/* = log2(search_sz/GC_min_stack_sz) */
+    register ptr_t result;
+    
+    while (search_sz < requested_sz) {
+        search_sz *= 2;
+        index++;
+    }
+    if ((result = GC_stack_free_lists[index]) == 0
+        && (result = GC_stack_free_lists[index+1]) != 0) {
+        /* Try next size up. */
+        search_sz *= 2; index++;
+    }
+    if (result != 0) {
+        GC_stack_free_lists[index] = *(ptr_t *)result;
+    } else {
+        result = (ptr_t) GC_scratch_alloc(search_sz + 2*GC_page_sz);
+        result = (ptr_t)(((word)result + GC_page_sz) & ~(GC_page_sz - 1));
+        /* Protect hottest page to detect overflow. */
+#	ifdef STACK_GROWS_UP
+          /* mprotect(result + search_sz, GC_page_sz, PROT_NONE); */
+#	else
+          /* mprotect(result, GC_page_sz, PROT_NONE); */
+          result += GC_page_sz;
+#	endif
+    }
+    *stack_size = search_sz;
+    return(result);
+}
+
+/* Caller holds allocation lock.					*/
+void GC_stack_free(ptr_t stack, size_t size)
+{
+    register int index = 0;
+    register size_t search_sz = GC_min_stack_sz;
+    
+    while (search_sz < size) {
+        search_sz *= 2;
+        index++;
+    }
+    if (search_sz != size) ABORT("Bad stack size");
+    *(ptr_t *)stack = GC_stack_free_lists[index];
+    GC_stack_free_lists[index] = stack;
+}
+
+
+
+# define THREAD_TABLE_SZ 128	/* Must be power of 2	*/
+volatile GC_thread GC_threads[THREAD_TABLE_SZ];
+
+/* Add a thread to GC_threads.  We assume it wasn't already there.	*/
+/* Caller holds allocation lock.					*/
+GC_thread GC_new_thread(pthread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    GC_thread result;
+    static struct GC_Thread_Rep first_thread;
+    static GC_bool first_thread_used = FALSE;
+    
+    if (!first_thread_used) {
+    	result = &first_thread;
+    	first_thread_used = TRUE;
+    	/* Dont acquire allocation lock, since we may already hold it. */
+    } else {
+        result = (struct GC_Thread_Rep *)
+        	 GC_generic_malloc_inner(sizeof(struct GC_Thread_Rep), NORMAL);
+    }
+    if (result == 0) return(0);
+    result -> id = id;
+    result -> next = GC_threads[hv];
+    GC_threads[hv] = result;
+    /* result -> flags = 0;     */
+    /* result -> stop = 0;	*/
+    return(result);
+}
+
+/* Delete a thread from GC_threads.  We assume it is there.	*/
+/* (The code intentionally traps if it wasn't.)			*/
+/* Caller holds allocation lock.				*/
+void GC_delete_thread(pthread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    register GC_thread prev = 0;
+    
+    while (!pthread_equal(p -> id, id)) {
+        prev = p;
+        p = p -> next;
+    }
+    if (prev == 0) {
+        GC_threads[hv] = p -> next;
+    } else {
+        prev -> next = p -> next;
+    }
+}
+
+/* If a thread has been joined, but we have not yet		*/
+/* been notified, then there may be more than one thread 	*/
+/* in the table with the same pthread id.			*/
+/* This is OK, but we need a way to delete a specific one.	*/
+void GC_delete_gc_thread(pthread_t id, GC_thread gc_id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    register GC_thread prev = 0;
+
+    while (p != gc_id) {
+        prev = p;
+        p = p -> next;
+    }
+    if (prev == 0) {
+        GC_threads[hv] = p -> next;
+    } else {
+        prev -> next = p -> next;
+    }
+}
+
+/* Return a GC_thread corresponding to a given thread_t.	*/
+/* Returns 0 if it's not there.					*/
+/* Caller holds  allocation lock or otherwise inhibits 		*/
+/* updates.							*/
+/* If there is more than one thread with the given id we 	*/
+/* return the most recent one.					*/
+GC_thread GC_lookup_thread(pthread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    
+    while (p != 0 && !pthread_equal(p -> id, id)) p = p -> next;
+    return(p);
+}
+
+
+/* Caller holds allocation lock.	*/
+void GC_stop_world()
+{
+    pthread_t my_thread = pthread_self();
+    register int i;
+    register GC_thread p;
+    register int result;
+    struct timespec timeout;
+    
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> id != my_thread) {
+            if (p -> flags & FINISHED) {
+		p -> stop = STOPPED;
+		continue;
+	    }
+	    p -> stop = PLEASE_STOP;
+            result = pthread_kill(p -> id, SIG_SUSPEND);
+	    /* GC_printf1("Sent signal to 0x%x\n", p -> id); */
+	    switch(result) {
+                case ESRCH:
+                    /* Not really there anymore.  Possible? */
+                    p -> stop = STOPPED;
+                    break;
+                case 0:
+                    break;
+                default:
+                    ABORT("pthread_kill failed");
+            }
+        }
+      }
+    }
+    pthread_mutex_lock(&GC_suspend_lock);
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        while (p -> id != my_thread && p -> stop != STOPPED) {
+	    clock_gettime(CLOCK_REALTIME, &timeout);
+            timeout.tv_nsec += 50000000; /* 50 msecs */
+            if (timeout.tv_nsec >= 1000000000) {
+                timeout.tv_nsec -= 1000000000;
+                ++timeout.tv_sec;
+            }
+            result = pthread_cond_timedwait(&GC_suspend_ack_cv,
+					    &GC_suspend_lock,
+                                            &timeout);
+            if (result == ETIMEDOUT) {
+                /* Signal was lost or misdirected.  Try again.      */
+                /* Duplicate signals should be benign.              */
+                result = pthread_kill(p -> id, SIG_SUSPEND);
+	    }
+	}
+      }
+    }
+    pthread_mutex_unlock(&GC_suspend_lock);
+    /* GC_printf1("World stopped 0x%x\n", pthread_self()); */
+}
+
+/* Caller holds allocation lock.	*/
+void GC_start_world()
+{
+    GC_thread p;
+    unsigned i;
+
+    /* GC_printf0("World starting\n"); */
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+	p -> stop = NOT_STOPPED;
+      }
+    }
+    pthread_mutex_lock(&GC_suspend_lock);
+    /* All other threads are at pthread_cond_wait in signal handler.	*/
+    /* Otherwise we couldn't have acquired the lock.			*/
+    pthread_mutex_unlock(&GC_suspend_lock);
+    pthread_cond_broadcast(&GC_continue_cv);
+}
+
+# ifdef MMAP_STACKS
+--> not really supported yet.
+int GC_is_thread_stack(ptr_t addr)
+{
+    register int i;
+    register GC_thread p;
+
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> stack_size != 0) {
+            if (p -> stack <= addr &&
+                addr < p -> stack + p -> stack_size)
+                   return 1;
+       }
+      }
+    }
+    return 0;
+}
+# endif
+
+/* We hold allocation lock.  Should do exactly the right thing if the	*/
+/* world is stopped.  Should not fail if it isn't.			*/
+void GC_push_all_stacks()
+{
+    register int i;
+    register GC_thread p;
+    register ptr_t sp = GC_approx_sp();
+    register ptr_t hot, cold;
+    pthread_t me = pthread_self();
+    
+    if (!GC_thr_initialized) GC_thr_init();
+    /* GC_printf1("Pushing stacks from thread 0x%x\n", me); */
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> flags & FINISHED) continue;
+        if (pthread_equal(p -> id, me)) {
+	    hot = GC_approx_sp();
+	} else {
+	    hot = p -> stack_ptr;
+	}
+        if (p -> stack_size != 0) {
+#	  ifdef STACK_GROWS_UP
+	    cold = p -> stack;
+#	  else
+            cold = p -> stack + p -> stack_size;
+#	  endif
+        } else {
+            /* The original stack. */
+            cold = GC_stackbottom;
+        }
+#	ifdef STACK_GROWS_UP
+          GC_push_all_stack(cold, hot);
+#	else
+          GC_push_all_stack(hot, cold);
+#	endif
+      }
+    }
+}
+
+
+/* We hold the allocation lock.	*/
+void GC_thr_init()
+{
+    GC_thread t;
+    struct sigaction act;
+
+    if (GC_thr_initialized) return;
+    GC_thr_initialized = TRUE;
+    GC_min_stack_sz = HBLKSIZE;
+    GC_page_sz = sysconf(_SC_PAGESIZE);
+    (void) sigaction(SIG_SUSPEND, 0, &act);
+    if (act.sa_handler != SIG_DFL)
+    	ABORT("Previously installed SIG_SUSPEND handler");
+    /* Install handler.	*/
+	act.sa_handler = GC_suspend_handler;
+	act.sa_flags = SA_RESTART;
+	(void) sigemptyset(&act.sa_mask);
+        if (0 != sigaction(SIG_SUSPEND, &act, 0))
+	    ABORT("Failed to install SIG_SUSPEND handler");
+    /* Add the initial thread, so we can stop it.	*/
+      t = GC_new_thread(pthread_self());
+      t -> stack_size = 0;
+      t -> stack_ptr = (ptr_t)(&t);
+      t -> flags = DETACHED;
+}
+
+int GC_pthread_sigmask(int how, const sigset_t *set, sigset_t *oset)
+{
+    sigset_t fudged_set;
+    
+    if (set != NULL && (how == SIG_BLOCK || how == SIG_SETMASK)) {
+        fudged_set = *set;
+        sigdelset(&fudged_set, SIG_SUSPEND);
+        set = &fudged_set;
+    }
+    return(pthread_sigmask(how, set, oset));
+}
+
+struct start_info {
+    void *(*start_routine)(void *);
+    void *arg;
+    word flags;
+    ptr_t stack;
+    size_t stack_size;
+    sem_t registered;   	/* 1 ==> in our thread table, but 	*/
+				/* parent hasn't yet noticed.		*/
+};
+
+void GC_thread_exit_proc(void *arg)
+{
+    GC_thread me;
+
+    LOCK();
+    me = GC_lookup_thread(pthread_self());
+    if (me -> flags & DETACHED) {
+    	GC_delete_thread(pthread_self());
+    } else {
+	me -> flags |= FINISHED;
+    }
+    UNLOCK();
+}
+
+int GC_pthread_join(pthread_t thread, void **retval)
+{
+    int result;
+    GC_thread thread_gc_id;
+    
+    LOCK();
+    thread_gc_id = GC_lookup_thread(thread);
+    /* This is guaranteed to be the intended one, since the thread id	*/
+    /* cant have been recycled by pthreads.				*/
+    UNLOCK();
+    result = pthread_join(thread, retval);
+    /* Some versions of the Irix pthreads library can erroneously 	*/
+    /* return EINTR when the call succeeds.				*/
+	if (EINTR == result) result = 0;
+    LOCK();
+    /* Here the pthread thread id may have been recycled. */
+    GC_delete_gc_thread(thread, thread_gc_id);
+    UNLOCK();
+    return result;
+}
+
+void * GC_start_routine(void * arg)
+{
+    struct start_info * si = arg;
+    void * result;
+    GC_thread me;
+    pthread_t my_pthread;
+    void *(*start)(void *);
+    void *start_arg;
+
+    my_pthread = pthread_self();
+    /* If a GC occurs before the thread is registered, that GC will	*/
+    /* ignore this thread.  That's fine, since it will block trying to  */
+    /* acquire the allocation lock, and won't yet hold interesting 	*/
+    /* pointers.							*/
+    LOCK();
+    /* We register the thread here instead of in the parent, so that	*/
+    /* we don't need to hold the allocation lock during pthread_create. */
+    /* Holding the allocation lock there would make REDIRECT_MALLOC	*/
+    /* impossible.  It probably still doesn't work, but we're a little  */
+    /* closer ...							*/
+    /* This unfortunately means that we have to be careful the parent	*/
+    /* doesn't try to do a pthread_join before we're registered.	*/
+    me = GC_new_thread(my_pthread);
+    me -> flags = si -> flags;
+    me -> stack = si -> stack;
+    me -> stack_size = si -> stack_size;
+    me -> stack_ptr = (ptr_t)si -> stack + si -> stack_size - sizeof(word);
+    UNLOCK();
+    start = si -> start_routine;
+    start_arg = si -> arg;
+    sem_post(&(si -> registered));
+    pthread_cleanup_push(GC_thread_exit_proc, 0);
+    result = (*start)(start_arg);
+    me -> status = result;
+    me -> flags |= FINISHED;
+    pthread_cleanup_pop(1);
+	/* This involves acquiring the lock, ensuring that we can't exit */
+	/* while a collection that thinks we're alive is trying to stop  */
+	/* us.								 */
+    return(result);
+}
+
+# ifdef HPUX_THREADS
+  /* pthread_attr_t is not a structure, thus a simple structure copy	*/
+  /* won't work.							*/
+  static void copy_attr(pthread_attr_t * pa_ptr,
+			const pthread_attr_t  * source) {
+    int tmp;
+    size_t stmp;
+    void * vtmp;
+    struct sched_param sp_tmp;
+    pthread_spu_t ps_tmp;
+    (void) pthread_attr_init(pa_ptr);
+    (void) pthread_attr_getdetachstate(source, &tmp);
+    (void) pthread_attr_setdetachstate(pa_ptr, tmp);
+    (void) pthread_attr_getinheritsched(source, &tmp);
+    (void) pthread_attr_setinheritsched(pa_ptr, tmp);
+    (void) pthread_attr_getschedpolicy(source, &tmp);
+    (void) pthread_attr_setschedpolicy(pa_ptr, tmp);
+    (void) pthread_attr_getstacksize(source, &stmp);
+    (void) pthread_attr_setstacksize(pa_ptr, stmp);
+    (void) pthread_attr_getguardsize(source, &stmp);
+    (void) pthread_attr_setguardsize(pa_ptr, stmp);
+    (void) pthread_attr_getstackaddr(source, &vtmp);
+    (void) pthread_attr_setstackaddr(pa_ptr, vtmp);
+    (void) pthread_attr_getscope(source, &tmp);
+    (void) pthread_attr_setscope(pa_ptr, tmp);
+    (void) pthread_attr_getschedparam(source, &sp_tmp);
+    (void) pthread_attr_setschedparam(pa_ptr, &sp_tmp);
+    (void) pthread_attr_getprocessor_np(source, &ps_tmp, &tmp);
+    (void) pthread_attr_setprocessor_np(pa_ptr, ps_tmp, tmp);
+  }
+# else
+#   define copy_attr(pa_ptr, source) *(pa_ptr) = *(source)
+# endif
+
+int
+GC_pthread_create(pthread_t *new_thread,
+		  const pthread_attr_t *attr,
+                  void *(*start_routine)(void *), void *arg)
+{
+    int result;
+    GC_thread t;
+    void * stack;
+    size_t stacksize;
+    pthread_attr_t new_attr;
+    int detachstate;
+    word my_flags = 0;
+    struct start_info * si = GC_malloc(sizeof(struct start_info)); 
+	/* This is otherwise saved only in an area mmapped by the thread */
+	/* library, which isn't visible to the collector.		 */
+
+    if (0 == si) return(ENOMEM);
+    if (0 != sem_init(&(si -> registered), 0, 0)) {
+        ABORT("sem_init failed");
+    }
+    si -> start_routine = start_routine;
+    si -> arg = arg;
+    LOCK();
+    if (!GC_thr_initialized) GC_thr_init();
+    if (NULL == attr) {
+        stack = 0;
+	(void) pthread_attr_init(&new_attr);
+    } else {
+	copy_attr(&new_attr, attr);
+	pthread_attr_getstackaddr(&new_attr, &stack);
+    }
+    pthread_attr_getstacksize(&new_attr, &stacksize);
+    pthread_attr_getdetachstate(&new_attr, &detachstate);
+    if (stacksize < GC_min_stack_sz) ABORT("Stack too small");
+    if (0 == stack) {
+     	stack = (void *)GC_stack_alloc(&stacksize);
+     	if (0 == stack) {
+     	    UNLOCK();
+     	    return(ENOMEM);
+     	}
+	pthread_attr_setstackaddr(&new_attr, stack);
+    } else {
+    	my_flags |= CLIENT_OWNS_STACK;
+    }
+    if (PTHREAD_CREATE_DETACHED == detachstate) my_flags |= DETACHED;
+    si -> flags = my_flags;
+    si -> stack = stack;
+    si -> stack_size = stacksize;
+    result = pthread_create(new_thread, &new_attr, GC_start_routine, si);
+    if (0 == new_thread && !(my_flags & CLIENT_OWNS_STACK)) {
+      	GC_stack_free(stack, stacksize);
+    }        
+    UNLOCK();  
+    /* Wait until child has been added to the thread table.		*/
+    /* This also ensures that we hold onto si until the child is done	*/
+    /* with it.  Thus it doesn't matter whether it is otherwise		*/
+    /* visible to the collector.					*/
+        while (0 != sem_wait(&(si -> registered))) {
+	  if (errno != EINTR) {
+	    GC_printf1("Sem_wait: errno = %ld\n", (unsigned long) errno);
+	    ABORT("sem_wait failed");
+	  }
+	}
+        sem_destroy(&(si -> registered));
+    pthread_attr_destroy(&new_attr);  /* Not a no-op under HPUX */
+    return(result);
+}
+
+#ifndef HPUX_THREADS
+/* For now we use the pthreads locking primitives on HP/UX */
+
+GC_bool GC_collecting = 0; /* A hint that we're in the collector and       */
+                        /* holding the allocation lock for an           */
+                        /* extended period.                             */
+
+/* Reasonably fast spin locks.  Basically the same implementation */
+/* as STL alloc.h.						  */
+
+#define SLEEP_THRESHOLD 3
+
+#ifdef HPUX
+   unsigned long GC_allocate_lock = 1;
+#  define GC_TRY_LOCK() GC_test_and_clear(&GC_allocate_lock)
+#  define GC_LOCK_TAKEN !GC_allocate_lock
+#else
+   unsigned long GC_allocate_lock = 0;
+#  define GC_TRY_LOCK() !GC_test_and_set(&GC_allocate_lock,1)
+#  define GC_LOCK_TAKEN GC_allocate_lock
+#endif
+
+void GC_lock()
+{
+#   define low_spin_max 30  /* spin cycles if we suspect uniprocessor */
+#   define high_spin_max 1000 /* spin cycles for multiprocessor */
+    static unsigned spin_max = low_spin_max;
+    unsigned my_spin_max;
+    static unsigned last_spins = 0;
+    unsigned my_last_spins;
+    volatile unsigned junk;
+#   define PAUSE junk *= junk; junk *= junk; junk *= junk; junk *= junk
+    int i;
+
+    if (GC_TRY_LOCK()) {
+        return;
+    }
+    junk = 0;
+    my_spin_max = spin_max;
+    my_last_spins = last_spins;
+    for (i = 0; i < my_spin_max; i++) {
+        if (GC_collecting) goto yield;
+        if (i < my_last_spins/2 || GC_LOCK_TAKEN) {
+            PAUSE; 
+            continue;
+        }
+        if (GC_TRY_LOCK()) {
+	    /*
+             * got it!
+             * Spinning worked.  Thus we're probably not being scheduled
+             * against the other process with which we were contending.
+             * Thus it makes sense to spin longer the next time.
+	     */
+            last_spins = i;
+            spin_max = high_spin_max;
+            return;
+        }
+    }
+    /* We are probably being scheduled against the other process.  Sleep. */
+    spin_max = low_spin_max;
+yield:
+    for (i = 0;; ++i) {
+        if (GC_TRY_LOCK()) {
+            return;
+        }
+        if (i < SLEEP_THRESHOLD) {
+            sched_yield();
+	} else {
+	    struct timespec ts;
+	
+	    if (i > 26) i = 26;
+			/* Don't wait for more than about 60msecs, even	*/
+			/* under extreme contention.			*/
+	    ts.tv_sec = 0;
+	    ts.tv_nsec = 1 << i;
+	    nanosleep(&ts, 0);
+	}
+    }
+}
+
+#endif /* !HPUX_THREADS */
+
+# else
+
+#ifndef LINT
+  int GC_no_Irix_threads;
+#endif
+
+# endif /* IRIX_THREADS */
+
diff --git a/src/gc/hpux_test_and_clear.s b/src/gc/hpux_test_and_clear.s
new file mode 100644
index 000000000..f09b21140
--- /dev/null
+++ b/src/gc/hpux_test_and_clear.s
@@ -0,0 +1,21 @@
+	.SPACE $PRIVATE$
+	.SUBSPA $DATA$,QUAD=1,ALIGN=8,ACCESS=31
+	.SUBSPA $BSS$,QUAD=1,ALIGN=8,ACCESS=31,ZERO,SORT=82
+	.SPACE $TEXT$
+	.SUBSPA $LIT$,QUAD=0,ALIGN=8,ACCESS=44
+	.SUBSPA $CODE$,QUAD=0,ALIGN=8,ACCESS=44,CODE_ONLY
+	.IMPORT $global$,DATA
+	.IMPORT $$dyncall,MILLICODE
+	.SPACE $TEXT$
+	.SUBSPA $CODE$
+
+	.align 4
+	.EXPORT GC_test_and_clear,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
+GC_test_and_clear
+	.PROC
+	.CALLINFO FRAME=0,NO_CALLS
+	.ENTRY
+	ldcw,co (%r26),%r28
+	bv,n 0(%r2)
+	.EXIT
+	.PROCEND
diff --git a/src/gc/if_mach.c b/src/gc/if_mach.c
new file mode 100644
index 000000000..af013637b
--- /dev/null
+++ b/src/gc/if_mach.c
@@ -0,0 +1,25 @@
+/* Conditionally execute a command based on machine and OS from gcconfig.h */
+
+# include "gcconfig.h"
+# include <stdio.h>
+
+int main(argc, argv, envp)
+int argc;
+char ** argv;
+char ** envp;
+{
+    if (argc < 4) goto Usage;
+    if (strcmp(MACH_TYPE, argv[1]) != 0) return(0);
+    if (strcmp(OS_TYPE, "") != 0 && strcmp(argv[2], "") != 0
+        && strcmp(OS_TYPE, argv[2]) != 0) return(0);
+    printf("^^^^Starting command^^^^\n");
+    execvp(argv[3], argv+3);
+    perror("Couldn't execute");
+    
+Usage:
+    fprintf(stderr, "Usage: %s mach_type os_type command\n", argv[0]);
+    fprintf(stderr, "Currently mach_type = %s, os_type = %s\n",
+    	    MACH_TYPE, OS_TYPE);
+    return(1);
+}
+
diff --git a/src/gc/if_not_there.c b/src/gc/if_not_there.c
new file mode 100644
index 000000000..a93795f1c
--- /dev/null
+++ b/src/gc/if_not_there.c
@@ -0,0 +1,26 @@
+/* Conditionally execute a command based if the file argv[1] doesn't exist */
+/* Except for execvp, we stick to ANSI C.				   */
+# include "gcconfig.h"
+# include <stdio.h>
+
+int main(argc, argv, envp)
+int argc;
+char ** argv;
+char ** envp;
+{
+    FILE * f;
+    if (argc < 3) goto Usage;
+    if ((f = fopen(argv[1], "rb")) != 0
+        || (f = fopen(argv[1], "r")) != 0) {
+        fclose(f);
+        return(0);
+    }
+    printf("^^^^Starting command^^^^\n");
+    execvp(argv[2], argv+2);
+    exit(1);
+    
+Usage:
+    fprintf(stderr, "Usage: %s file_name command\n", argv[0]);
+    return(1);
+}
+
diff --git a/src/gc/include/backptr.h b/src/gc/include/backptr.h
new file mode 100644
index 000000000..f5b7c5aa2
--- /dev/null
+++ b/src/gc/include/backptr.h
@@ -0,0 +1,63 @@
+/*
+ * This is a simple API to implement pointer back tracing, i.e.
+ * to answer questions such as "who is pointing to this" or
+ * "why is this object being retained by the collector"
+ *
+ * This API assumes that we have an ANSI C compiler.
+ *
+ * Most of these calls yield useful information on only after
+ * a garbage collection.  Usually the client will first force
+ * a full collection and then gather information, preferably
+ * before much intervening allocation.
+ *
+ * The implementation of the interface is only about 99.9999%
+ * correct.  It is intended to be good enough for profiling,
+ * but is not intended to be used with production code.
+ *
+ * Results are likely to be much more useful if all allocation is
+ * accomplished through the debugging allocators.
+ *
+ * The implementation idea is due to A. Demers.
+ */
+
+/* Store information about the object referencing dest in *base_p     */
+/* and *offset_p.                                                     */
+/* If multiple objects or roots point to dest, the one reported	      */
+/* will be the last on used by the garbage collector to trace the     */
+/* object.							      */
+/*   source is root ==> *base_p = address, *offset_p = 0	      */
+/*   source is heap object ==> *base_p != 0, *offset_p = offset       */
+/*   Returns 1 on success, 0 if source couldn't be determined.        */
+/* Dest can be any address within a heap object.                      */
+typedef enum {  GC_UNREFERENCED, /* No reference info available.	*/
+		GC_NO_SPACE,	/* Dest not allocated with debug alloc  */
+		GC_REFD_FROM_ROOT, /* Referenced directly by root *base_p */
+		GC_REFD_FROM_REG,  /* Referenced from a register, i.e.	*/
+				   /* a root without an address.	*/
+		GC_REFD_FROM_HEAP, /* Referenced from another heap obj. */
+		GC_FINALIZER_REFD /* Finalizable and hence accessible.  */
+} GC_ref_kind;
+
+GC_ref_kind GC_get_back_ptr_info(void *dest, void **base_p, size_t *offset_p);
+
+/* Generate a random heap address.            */
+/* The resulting address is in the heap, but  */
+/* not necessarily inside a valid object.     */
+void * GC_generate_random_heap_address(void);
+
+/* Generate a random address inside a valid marked heap object. */
+void * GC_generate_random_valid_address(void);
+
+/* Force a garbage collection and generate a backtrace from a */
+/* random heap address.                                       */
+/* This uses the GC logging mechanism (GC_printf) to produce  */
+/* output.  It can often be called from a debugger.  The      */
+/* source in dbg_mlc.c also serves as a sample client.	      */
+void GC_generate_random_backtrace(void);
+
+/* Print a backtrace from a specific address.  Used by the 	*/
+/* above.  The client should call GC_gcollect() immediately	*/
+/* before invocation.						*/
+void GC_print_backtrace(void *);
+
+
diff --git a/src/gc/include/cord.h b/src/gc/include/cord.h
new file mode 100644
index 000000000..926089e86
--- /dev/null
+++ b/src/gc/include/cord.h
@@ -0,0 +1,327 @@
+/* 
+ * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * Author: Hans-J. Boehm (boehm@parc.xerox.com)
+ */
+/* Boehm, October 5, 1995 4:20 pm PDT */
+ 
+/*
+ * Cords are immutable character strings.  A number of operations
+ * on long cords are much more efficient than their strings.h counterpart.
+ * In particular, concatenation takes constant time independent of the length
+ * of the arguments.  (Cords are represented as trees, with internal
+ * nodes representing concatenation and leaves consisting of either C
+ * strings or a functional description of the string.)
+ *
+ * The following are reasonable applications of cords.  They would perform
+ * unacceptably if C strings were used:
+ * - A compiler that produces assembly language output by repeatedly
+ *   concatenating instructions onto a cord representing the output file.
+ * - A text editor that converts the input file to a cord, and then
+ *   performs editing operations by producing a new cord representing
+ *   the file after echa character change (and keeping the old ones in an
+ *   edit history)
+ *
+ * For optimal performance, cords should be built by
+ * concatenating short sections.
+ * This interface is designed for maximum compatibility with C strings.
+ * ASCII NUL characters may be embedded in cords using CORD_from_fn.
+ * This is handled correctly, but CORD_to_char_star will produce a string
+ * with embedded NULs when given such a cord. 
+ *
+ * This interface is fairly big, largely for performance reasons.
+ * The most basic constants and functions:
+ *
+ * CORD - the type of a cord;
+ * CORD_EMPTY - empty cord;
+ * CORD_len(cord) - length of a cord;
+ * CORD_cat(cord1,cord2) - concatenation of two cords;
+ * CORD_substr(cord, start, len) - substring (or subcord);
+ * CORD_pos i;  CORD_FOR(i, cord) {  ... CORD_pos_fetch(i) ... } -
+ *    examine each character in a cord.  CORD_pos_fetch(i) is the char.
+ * CORD_fetch(int i) - Retrieve i'th character (slowly).
+ * CORD_cmp(cord1, cord2) - compare two cords.
+ * CORD_from_file(FILE * f) - turn a read-only file into a cord.
+ * CORD_to_char_star(cord) - convert to C string.
+ *   (Non-NULL C constant strings are cords.)
+ * CORD_printf (etc.) - cord version of printf. Use %r for cords.
+ */
+# ifndef CORD_H
+
+# define CORD_H
+# include <stddef.h>
+# include <stdio.h>
+/* Cords have type const char *.  This is cheating quite a bit, and not	*/
+/* 100% portable.  But it means that nonempty character string		*/
+/* constants may be used as cords directly, provided the string is	*/
+/* never modified in place.  The empty cord is represented by, and	*/
+/* can be written as, 0.						*/
+
+typedef const char * CORD;
+
+/* An empty cord is always represented as nil 	*/
+# define CORD_EMPTY 0
+
+/* Is a nonempty cord represented as a C string? */
+#define CORD_IS_STRING(s) (*(s) != '\0')
+
+/* Concatenate two cords.  If the arguments are C strings, they may 	*/
+/* not be subsequently altered.						*/
+CORD CORD_cat(CORD x, CORD y);
+
+/* Concatenate a cord and a C string with known length.  Except for the	*/
+/* empty string case, this is a special case of CORD_cat.  Since the	*/
+/* length is known, it can be faster.					*/
+/* The string y is shared with the resulting CORD.  Hence it should	*/
+/* not be altered by the caller.					*/
+CORD CORD_cat_char_star(CORD x, const char * y, size_t leny);
+
+/* Compute the length of a cord */
+size_t CORD_len(CORD x);
+
+/* Cords may be represented by functions defining the ith character */
+typedef char (* CORD_fn)(size_t i, void * client_data);
+
+/* Turn a functional description into a cord. 	*/
+CORD CORD_from_fn(CORD_fn fn, void * client_data, size_t len);
+
+/* Return the substring (subcord really) of x with length at most n,	*/
+/* starting at position i.  (The initial character has position 0.)	*/
+CORD CORD_substr(CORD x, size_t i, size_t n);
+
+/* Return the argument, but rebalanced to allow more efficient   	*/
+/* character retrieval, substring operations, and comparisons.		*/
+/* This is useful only for cords that were built using repeated 	*/
+/* concatenation.  Guarantees log time access to the result, unless	*/
+/* x was obtained through a large number of repeated substring ops	*/
+/* or the embedded functional descriptions take longer to evaluate.	*/
+/* May reallocate significant parts of the cord.  The argument is not	*/
+/* modified; only the result is balanced.				*/
+CORD CORD_balance(CORD x);
+
+/* The following traverse a cord by applying a function to each 	*/
+/* character.  This is occasionally appropriate, especially where	*/
+/* speed is crucial.  But, since C doesn't have nested functions,	*/
+/* clients of this sort of traversal are clumsy to write.  Consider	*/
+/* the functions that operate on cord positions instead.		*/
+
+/* Function to iteratively apply to individual characters in cord.	*/
+typedef int (* CORD_iter_fn)(char c, void * client_data);
+
+/* Function to apply to substrings of a cord.  Each substring is a 	*/
+/* a C character string, not a general cord.				*/
+typedef int (* CORD_batched_iter_fn)(const char * s, void * client_data);
+# define CORD_NO_FN ((CORD_batched_iter_fn)0)
+
+/* Apply f1 to each character in the cord, in ascending order,		*/
+/* starting at position i. If						*/
+/* f2 is not CORD_NO_FN, then multiple calls to f1 may be replaced by	*/
+/* a single call to f2.  The parameter f2 is provided only to allow	*/
+/* some optimization by the client.  This terminates when the right	*/
+/* end of this string is reached, or when f1 or f2 return != 0.  In the	*/
+/* latter case CORD_iter returns != 0.  Otherwise it returns 0.		*/
+/* The specified value of i must be < CORD_len(x).			*/
+int CORD_iter5(CORD x, size_t i, CORD_iter_fn f1,
+	       CORD_batched_iter_fn f2, void * client_data);
+
+/* A simpler version that starts at 0, and without f2:	*/
+int CORD_iter(CORD x, CORD_iter_fn f1, void * client_data);
+# define CORD_iter(x, f1, cd) CORD_iter5(x, 0, f1, CORD_NO_FN, cd)
+
+/* Similar to CORD_iter5, but end-to-beginning.	No provisions for	*/
+/* CORD_batched_iter_fn.						*/
+int CORD_riter4(CORD x, size_t i, CORD_iter_fn f1, void * client_data);
+
+/* A simpler version that starts at the end:	*/
+int CORD_riter(CORD x, CORD_iter_fn f1, void * client_data);
+
+/* Functions that operate on cord positions.  The easy way to traverse	*/
+/* cords.  A cord position is logically a pair consisting of a cord	*/
+/* and an index into that cord.  But it is much faster to retrieve a	*/
+/* charcter based on a position than on an index.  Unfortunately,	*/
+/* positions are big (order of a few 100 bytes), so allocate them with	*/
+/* caution.								*/
+/* Things in cord_pos.h should be treated as opaque, except as		*/
+/* described below.  Also note that					*/
+/* CORD_pos_fetch, CORD_next and CORD_prev have both macro and function	*/
+/* definitions.  The former may evaluate their argument more than once. */
+# include "private/cord_pos.h"
+
+/*
+	Visible definitions from above:
+	
+	typedef <OPAQUE but fairly big> CORD_pos[1];
+	
+	* Extract the cord from a position:
+	CORD CORD_pos_to_cord(CORD_pos p);
+	
+	* Extract the current index from a position:
+	size_t CORD_pos_to_index(CORD_pos p);
+	
+	* Fetch the character located at the given position:
+	char CORD_pos_fetch(CORD_pos p);
+	
+	* Initialize the position to refer to the given cord and index.
+	* Note that this is the most expensive function on positions:
+	void CORD_set_pos(CORD_pos p, CORD x, size_t i);
+	
+	* Advance the position to the next character.
+	* P must be initialized and valid.
+	* Invalidates p if past end:
+	void CORD_next(CORD_pos p);
+	
+	* Move the position to the preceding character.
+	* P must be initialized and valid.
+	* Invalidates p if past beginning:
+	void CORD_prev(CORD_pos p);
+	
+	* Is the position valid, i.e. inside the cord?
+	int CORD_pos_valid(CORD_pos p);
+*/
+# define CORD_FOR(pos, cord) \
+    for (CORD_set_pos(pos, cord, 0); CORD_pos_valid(pos); CORD_next(pos))
+
+			
+/* An out of memory handler to call.  May be supplied by client.	*/
+/* Must not return.							*/
+extern void (* CORD_oom_fn)(void);
+
+/* Dump the representation of x to stdout in an implementation defined	*/
+/* manner.  Intended for debugging only.				*/
+void CORD_dump(CORD x);
+
+/* The following could easily be implemented by the client.  They are	*/
+/* provided in cordxtra.c for convenience.				*/
+
+/* Concatenate a character to the end of a cord.	*/
+CORD CORD_cat_char(CORD x, char c);
+
+/* Concatenate n cords.	*/
+CORD CORD_catn(int n, /* CORD */ ...);
+
+/* Return the character in CORD_substr(x, i, 1)  	*/
+char CORD_fetch(CORD x, size_t i);
+
+/* Return < 0, 0, or > 0, depending on whether x < y, x = y, x > y	*/
+int CORD_cmp(CORD x, CORD y);
+
+/* A generalization that takes both starting positions for the 		*/
+/* comparison, and a limit on the number of characters to be compared.	*/
+int CORD_ncmp(CORD x, size_t x_start, CORD y, size_t y_start, size_t len);
+
+/* Find the first occurrence of s in x at position start or later.	*/
+/* Return the position of the first character of s in x, or		*/
+/* CORD_NOT_FOUND if there is none.					*/
+size_t CORD_str(CORD x, size_t start, CORD s);
+
+/* Return a cord consisting of i copies of (possibly NUL) c.  Dangerous	*/
+/* in conjunction with CORD_to_char_star.				*/
+/* The resulting representation takes constant space, independent of i.	*/
+CORD CORD_chars(char c, size_t i);
+# define CORD_nul(i) CORD_chars('\0', (i))
+
+/* Turn a file into cord.  The file must be seekable.  Its contents	*/
+/* must remain constant.  The file may be accessed as an immediate	*/
+/* result of this call and/or as a result of subsequent accesses to 	*/
+/* the cord.  Short files are likely to be immediately read, but	*/
+/* long files are likely to be read on demand, possibly relying on 	*/
+/* stdio for buffering.							*/
+/* We must have exclusive access to the descriptor f, i.e. we may	*/
+/* read it at any time, and expect the file pointer to be		*/
+/* where we left it.  Normally this should be invoked as		*/
+/* CORD_from_file(fopen(...))						*/
+/* CORD_from_file arranges to close the file descriptor when it is no	*/
+/* longer needed (e.g. when the result becomes inaccessible).		*/ 
+/* The file f must be such that ftell reflects the actual character	*/
+/* position in the file, i.e. the number of characters that can be 	*/
+/* or were read with fread.  On UNIX systems this is always true.  On	*/
+/* MS Windows systems, f must be opened in binary mode.			*/
+CORD CORD_from_file(FILE * f);
+
+/* Equivalent to the above, except that the entire file will be read	*/
+/* and the file pointer will be closed immediately.			*/
+/* The binary mode restriction from above does not apply.		*/
+CORD CORD_from_file_eager(FILE * f);
+
+/* Equivalent to the above, except that the file will be read on demand.*/
+/* The binary mode restriction applies.					*/
+CORD CORD_from_file_lazy(FILE * f);
+
+/* Turn a cord into a C string.	The result shares no structure with	*/
+/* x, and is thus modifiable.						*/
+char * CORD_to_char_star(CORD x);
+
+/* Turn a C string into a CORD.  The C string is copied, and so may	*/
+/* subsequently be modified.						*/
+CORD CORD_from_char_star(const char *s);
+
+/* Identical to the above, but the result may share structure with	*/
+/* the argument and is thus not modifiable.				*/
+const char * CORD_to_const_char_star(CORD x); 
+
+/* Write a cord to a file, starting at the current position.  No	*/
+/* trailing NULs are newlines are added.				*/
+/* Returns EOF if a write error occurs, 1 otherwise.			*/
+int CORD_put(CORD x, FILE * f);
+
+/* "Not found" result for the following two functions.			*/
+# define CORD_NOT_FOUND ((size_t)(-1))
+
+/* A vague analog of strchr.  Returns the position (an integer, not	*/
+/* a pointer) of the first occurrence of (char) c inside x at position 	*/
+/* i or later. The value i must be < CORD_len(x).			*/
+size_t CORD_chr(CORD x, size_t i, int c);
+
+/* A vague analog of strrchr.  Returns index of the last occurrence	*/
+/* of (char) c inside x at position i or earlier. The value i		*/
+/* must be < CORD_len(x).						*/
+size_t CORD_rchr(CORD x, size_t i, int c);
+
+
+/* The following are also not primitive, but are implemented in 	*/
+/* cordprnt.c.  They provide functionality similar to the ANSI C	*/
+/* functions with corresponding names, but with the following		*/
+/* additions and changes:						*/
+/* 1. A %r conversion specification specifies a CORD argument.  Field	*/
+/*    width, precision, etc. have the same semantics as for %s.		*/
+/*    (Note that %c,%C, and %S were already taken.)			*/
+/* 2. The format string is represented as a CORD.		        */
+/* 3. CORD_sprintf and CORD_vsprintf assign the result through the 1st	*/ 	/*    argument.	Unlike their ANSI C versions, there is no need to guess	*/
+/*    the correct buffer size.						*/
+/* 4. Most of the conversions are implement through the native 		*/
+/*    vsprintf.  Hence they are usually no faster, and 			*/
+/*    idiosyncracies of the native printf are preserved.  However,	*/
+/*    CORD arguments to CORD_sprintf and CORD_vsprintf are NOT copied;	*/
+/*    the result shares the original structure.  This may make them	*/
+/*    very efficient in some unusual applications.			*/
+/*    The format string is copied.					*/
+/* All functions return the number of characters generated or -1 on	*/
+/* error.  This complies with the ANSI standard, but is inconsistent	*/
+/* with some older implementations of sprintf.				*/
+
+/* The implementation of these is probably less portable than the rest	*/
+/* of this package.							*/
+
+#ifndef CORD_NO_IO
+
+#include <stdarg.h>
+
+int CORD_sprintf(CORD * out, CORD format, ...);
+int CORD_vsprintf(CORD * out, CORD format, va_list args);
+int CORD_fprintf(FILE * f, CORD format, ...);
+int CORD_vfprintf(FILE * f, CORD format, va_list args);
+int CORD_printf(CORD format, ...);
+int CORD_vprintf(CORD format, va_list args);
+
+#endif /* CORD_NO_IO */
+
+# endif /* CORD_H */
diff --git a/src/gc/include/ec.h b/src/gc/include/ec.h
new file mode 100644
index 000000000..c829b83ad
--- /dev/null
+++ b/src/gc/include/ec.h
@@ -0,0 +1,70 @@
+# ifndef EC_H
+# define EC_H
+
+# ifndef CORD_H
+#  include "cord.h"
+# endif
+
+/* Extensible cords are strings that may be destructively appended to.	*/
+/* They allow fast construction of cords from characters that are	*/
+/* being read from a stream.						*/
+/*
+ * A client might look like:
+ *
+ *	{
+ *	    CORD_ec x;
+ *	    CORD result;
+ *	    char c;
+ *	    FILE *f;
+ *
+ *	    ...
+ *	    CORD_ec_init(x);
+ *	    while(...) {
+ *		c = getc(f);
+ *		...
+ *		CORD_ec_append(x, c);
+ *	    }
+ *	    result = CORD_balance(CORD_ec_to_cord(x));
+ *
+ * If a C string is desired as the final result, the call to CORD_balance
+ * may be replaced by a call to CORD_to_char_star.
+ */
+
+# ifndef CORD_BUFSZ
+#   define CORD_BUFSZ 128
+# endif
+
+typedef struct CORD_ec_struct {
+    CORD ec_cord;
+    char * ec_bufptr;
+    char ec_buf[CORD_BUFSZ+1];
+} CORD_ec[1];
+
+/* This structure represents the concatenation of ec_cord with		*/
+/* ec_buf[0 ... (ec_bufptr-ec_buf-1)]					*/
+
+/* Flush the buffer part of the extended chord into ec_cord.	*/
+/* Note that this is almost the only real function, and it is	*/
+/* implemented in 6 lines in cordxtra.c				*/
+void CORD_ec_flush_buf(CORD_ec x);
+      
+/* Convert an extensible cord to a cord. */
+# define CORD_ec_to_cord(x) (CORD_ec_flush_buf(x), (x)[0].ec_cord)
+
+/* Initialize an extensible cord. */
+# define CORD_ec_init(x) ((x)[0].ec_cord = 0, (x)[0].ec_bufptr = (x)[0].ec_buf)
+
+/* Append a character to an extensible cord.	*/
+# define CORD_ec_append(x, c) \
+    {  \
+	if ((x)[0].ec_bufptr == (x)[0].ec_buf + CORD_BUFSZ) { \
+	  	CORD_ec_flush_buf(x); \
+	} \
+	*((x)[0].ec_bufptr)++ = (c); \
+    }
+
+/* Append a cord to an extensible cord.  Structure remains shared with 	*/
+/* original.								*/
+void CORD_ec_append_cord(CORD_ec x, CORD s);
+
+# endif /* EC_H */
diff --git a/src/gc/include/gc.h b/src/gc/include/gc.h
new file mode 100644
index 000000000..d7cd89960
--- /dev/null
+++ b/src/gc/include/gc.h
@@ -0,0 +1,804 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright 1996-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright 1999 by Hewlett-Packard Company.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * Note that this defines a large number of tuning hooks, which can
+ * safely be ignored in nearly all cases.  For normal use it suffices
+ * to call only GC_MALLOC and perhaps GC_REALLOC.
+ * For better performance, also look at GC_MALLOC_ATOMIC, and
+ * GC_enable_incremental.  If you need an action to be performed
+ * immediately before an object is collected, look at GC_register_finalizer.
+ * If you are using Solaris threads, look at the end of this file.
+ * Everything else is best ignored unless you encounter performance
+ * problems.
+ */
+ 
+#ifndef _GC_H
+
+# define _GC_H
+# define __GC
+# include <stddef.h>
+
+#if defined(__CYGWIN32__) && defined(GC_USE_DLL)
+#include "libgc_globals.h"
+#endif
+
+#if defined(__MINGW32__) && defined(WIN32_THREADS)
+# ifdef GC_BUILD
+#   define GC_API __declspec(dllexport)
+# else
+#   define GC_API __declspec(dllimport)
+# endif
+#endif
+
+#if defined(_MSC_VER) && defined(_DLL)
+# ifdef GC_BUILD
+#   define GC_API __declspec(dllexport)
+# else
+#   define GC_API __declspec(dllimport)
+# endif
+#endif
+
+#if defined(__WATCOMC__) && defined(GC_DLL)
+# ifdef GC_BUILD
+#   define GC_API extern __declspec(dllexport)
+# else
+#   define GC_API extern __declspec(dllimport)
+# endif
+#endif
+
+#ifndef GC_API
+#define GC_API extern
+#endif
+
+# if defined(__STDC__) || defined(__cplusplus)
+#   define GC_PROTO(args) args
+    typedef void * GC_PTR;
+#   define GC_CONST const
+# else
+#   define GC_PROTO(args) ()
+    typedef char * GC_PTR;
+#   define GC_CONST
+#  endif
+
+# ifdef __cplusplus
+    extern "C" {
+# endif
+
+
+/* Define word and signed_word to be unsigned and signed types of the 	*/
+/* size as char * or void *.  There seems to be no way to do this	*/
+/* even semi-portably.  The following is probably no better/worse 	*/
+/* than almost anything else.						*/
+/* The ANSI standard suggests that size_t and ptr_diff_t might be 	*/
+/* better choices.  But those appear to have incorrect definitions	*/
+/* on may systems.  Notably "typedef int size_t" seems to be both	*/
+/* frequent and WRONG.							*/
+typedef unsigned long GC_word;
+typedef long GC_signed_word;
+
+/* Public read-only variables */
+
+GC_API GC_word GC_gc_no;/* Counter incremented per collection.  	*/
+			/* Includes empty GCs at startup.		*/
+			
+
+/* Public R/W variables */
+
+GC_API GC_PTR (*GC_oom_fn) GC_PROTO((size_t bytes_requested));
+			/* When there is insufficient memory to satisfy */
+			/* an allocation request, we return		*/
+			/* (*GC_oom_fn)().  By default this just	*/
+			/* returns 0.					*/
+			/* If it returns, it must return 0 or a valid	*/
+			/* pointer to a previously allocated heap 	*/
+			/* object.					*/
+
+GC_API int GC_find_leak;
+			/* Do not actually garbage collect, but simply	*/
+			/* report inaccessible memory that was not	*/
+			/* deallocated with GC_free.  Initial value	*/
+			/* is determined by FIND_LEAK macro.		*/
+
+GC_API int GC_quiet;	/* Disable statistics output.  Only matters if	*/
+			/* collector has been compiled with statistics	*/
+			/* enabled.  This involves a performance cost,	*/
+			/* and is thus not the default.			*/
+
+GC_API int GC_finalize_on_demand;
+			/* If nonzero, finalizers will only be run in 	*/
+			/* response to an eplit GC_invoke_finalizers	*/
+			/* call.  The default is determined by whether	*/
+			/* the FINALIZE_ON_DEMAND macro is defined	*/
+			/* when the collector is built.			*/
+
+GC_API int GC_java_finalization;
+			/* Mark objects reachable from finalizable 	*/
+			/* objects in a separate postpass.  This makes	*/
+			/* it a bit safer to use non-topologically-	*/
+			/* ordered finalization.  Default value is	*/
+			/* determined by JAVA_FINALIZATION macro.	*/
+
+GC_API int GC_dont_gc;	/* Dont collect unless explicitly requested, e.g. */
+			/* because it's not safe.			  */
+
+GC_API int GC_dont_expand;
+			/* Dont expand heap unless explicitly requested */
+			/* or forced to.				*/
+
+GC_API int GC_use_entire_heap;
+		/* Causes the nonincremental collector to use the	*/
+		/* entire heap before collecting.  This was the only 	*/
+		/* option for GC versions < 5.0.  This sometimes	*/
+		/* results in more large block fragmentation, since	*/
+		/* very larg blocks will tend to get broken up		*/
+		/* during each GC cycle.  It is likely to result in a	*/
+		/* larger working set, but lower collection		*/
+		/* frequencies, and hence fewer instructions executed	*/
+		/* in the collector.					*/
+
+GC_API int GC_full_freq;    /* Number of partial collections between	*/
+			    /* full collections.  Matters only if	*/
+			    /* GC_incremental is set.			*/
+			    /* Full collections are also triggered if	*/
+			    /* the collector detects a substantial	*/
+			    /* increase in the number of in-use heap	*/
+			    /* blocks.  Values in the tens are now	*/
+			    /* perfectly reasonable, unlike for		*/
+			    /* earlier GC versions.			*/
+			
+GC_API GC_word GC_non_gc_bytes;
+			/* Bytes not considered candidates for collection. */
+			/* Used only to control scheduling of collections. */
+
+GC_API GC_word GC_free_space_divisor;
+			/* We try to make sure that we allocate at 	*/
+			/* least N/GC_free_space_divisor bytes between	*/
+			/* collections, where N is the heap size plus	*/
+			/* a rough estimate of the root set size.	*/
+			/* Initially, GC_free_space_divisor = 4.	*/
+			/* Increasing its value will use less space	*/
+			/* but more collection time.  Decreasing it	*/
+			/* will appreciably decrease collection time	*/
+			/* at the expense of space.			*/
+			/* GC_free_space_divisor = 1 will effectively	*/
+			/* disable collections.				*/
+
+GC_API GC_word GC_max_retries;
+			/* The maximum number of GCs attempted before	*/
+			/* reporting out of memory after heap		*/
+			/* expansion fails.  Initially 0.		*/
+			
+
+GC_API char *GC_stackbottom;	/* Cool end of user stack.		*/
+				/* May be set in the client prior to	*/
+				/* calling any GC_ routines.  This	*/
+				/* avoids some overhead, and 		*/
+				/* potentially some signals that can 	*/
+				/* confuse debuggers.  Otherwise the	*/
+				/* collector attempts to set it 	*/
+				/* automatically.			*/
+				/* For multithreaded code, this is the	*/
+				/* cold end of the stack for the	*/
+				/* primordial thread.			*/
+				
+/* Public procedures */
+/*
+ * general purpose allocation routines, with roughly malloc calling conv.
+ * The atomic versions promise that no relevant pointers are contained
+ * in the object.  The nonatomic versions guarantee that the new object
+ * is cleared.  GC_malloc_stubborn promises that no changes to the object
+ * will occur after GC_end_stubborn_change has been called on the
+ * result of GC_malloc_stubborn. GC_malloc_uncollectable allocates an object
+ * that is scanned for pointers to collectable objects, but is not itself
+ * collectable.  GC_malloc_uncollectable and GC_free called on the resulting
+ * object implicitly update GC_non_gc_bytes appropriately.
+ */
+GC_API GC_PTR GC_malloc GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_atomic GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_uncollectable GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_stubborn GC_PROTO((size_t size_in_bytes));
+
+/* The following is only defined if the library has been suitably	*/
+/* compiled:								*/
+GC_API GC_PTR GC_malloc_atomic_uncollectable GC_PROTO((size_t size_in_bytes));
+
+/* Explicitly deallocate an object.  Dangerous if used incorrectly.     */
+/* Requires a pointer to the base of an object.				*/
+/* If the argument is stubborn, it should not be changeable when freed. */
+/* An object should not be enable for finalization when it is 		*/
+/* explicitly deallocated.						*/
+/* GC_free(0) is a no-op, as required by ANSI C for free.		*/
+GC_API void GC_free GC_PROTO((GC_PTR object_addr));
+
+/*
+ * Stubborn objects may be changed only if the collector is explicitly informed.
+ * The collector is implicitly informed of coming change when such
+ * an object is first allocated.  The following routines inform the
+ * collector that an object will no longer be changed, or that it will
+ * once again be changed.  Only nonNIL pointer stores into the object
+ * are considered to be changes.  The argument to GC_end_stubborn_change
+ * must be exacly the value returned by GC_malloc_stubborn or passed to
+ * GC_change_stubborn.  (In the second case it may be an interior pointer
+ * within 512 bytes of the beginning of the objects.)
+ * There is a performance penalty for allowing more than
+ * one stubborn object to be changed at once, but it is acceptable to
+ * do so.  The same applies to dropping stubborn objects that are still
+ * changeable.
+ */
+GC_API void GC_change_stubborn GC_PROTO((GC_PTR));
+GC_API void GC_end_stubborn_change GC_PROTO((GC_PTR));
+
+/* Return a pointer to the base (lowest address) of an object given	*/
+/* a pointer to a location within the object.				*/
+/* Return 0 if displaced_pointer doesn't point to within a valid	*/
+/* object.								*/
+GC_API GC_PTR GC_base GC_PROTO((GC_PTR displaced_pointer));
+
+/* Given a pointer to the base of an object, return its size in bytes.	*/
+/* The returned size may be slightly larger than what was originally	*/
+/* requested.								*/
+GC_API size_t GC_size GC_PROTO((GC_PTR object_addr));
+
+/* For compatibility with C library.  This is occasionally faster than	*/
+/* a malloc followed by a bcopy.  But if you rely on that, either here	*/
+/* or with the standard C library, your code is broken.  In my		*/
+/* opinion, it shouldn't have been invented, but now we're stuck. -HB	*/
+/* The resulting object has the same kind as the original.		*/
+/* If the argument is stubborn, the result will have changes enabled.	*/
+/* It is an error to have changes enabled for the original object.	*/
+/* Follows ANSI comventions for NULL old_object.			*/
+GC_API GC_PTR GC_realloc
+	GC_PROTO((GC_PTR old_object, size_t new_size_in_bytes));
+				   
+/* Explicitly increase the heap size.	*/
+/* Returns 0 on failure, 1 on success.  */
+GC_API int GC_expand_hp GC_PROTO((size_t number_of_bytes));
+
+/* Limit the heap size to n bytes.  Useful when you're debugging, 	*/
+/* especially on systems that don't handle running out of memory well.	*/
+/* n == 0 ==> unbounded.  This is the default.				*/
+GC_API void GC_set_max_heap_size GC_PROTO((GC_word n));
+
+/* Inform the collector that a certain section of statically allocated	*/
+/* memory contains no pointers to garbage collected memory.  Thus it 	*/
+/* need not be scanned.  This is sometimes important if the application */
+/* maps large read/write files into the address space, which could be	*/
+/* mistaken for dynamic library data segments on some systems.		*/
+GC_API void GC_exclude_static_roots GC_PROTO((GC_PTR start, GC_PTR finish));
+
+/* Clear the set of root segments.  Wizards only. */
+GC_API void GC_clear_roots GC_PROTO((void));
+
+/* Add a root segment.  Wizards only. */
+GC_API void GC_add_roots GC_PROTO((char * low_address,
+				   char * high_address_plus_1));
+
+/* Add a displacement to the set of those considered valid by the	*/
+/* collector.  GC_register_displacement(n) means that if p was returned */
+/* by GC_malloc, then (char *)p + n will be considered to be a valid	*/
+/* pointer to n.  N must be small and less than the size of p.		*/
+/* (All pointers to the interior of objects from the stack are		*/
+/* considered valid in any case.  This applies to heap objects and	*/
+/* static data.)							*/
+/* Preferably, this should be called before any other GC procedures.	*/
+/* Calling it later adds to the probability of excess memory		*/
+/* retention.								*/
+/* This is a no-op if the collector was compiled with recognition of	*/
+/* arbitrary interior pointers enabled, which is now the default.	*/
+GC_API void GC_register_displacement GC_PROTO((GC_word n));
+
+/* The following version should be used if any debugging allocation is	*/
+/* being done.								*/
+GC_API void GC_debug_register_displacement GC_PROTO((GC_word n));
+
+/* Explicitly trigger a full, world-stop collection. 	*/
+GC_API void GC_gcollect GC_PROTO((void));
+
+/* Trigger a full world-stopped collection.  Abort the collection if 	*/
+/* and when stop_func returns a nonzero value.  Stop_func will be 	*/
+/* called frequently, and should be reasonably fast.  This works even	*/
+/* if virtual dirty bits, and hence incremental collection is not 	*/
+/* available for this architecture.  Collections can be aborted faster	*/
+/* than normal pause times for incremental collection.  However,	*/
+/* aborted collections do no useful work; the next collection needs	*/
+/* to start from the beginning.						*/
+/* Return 0 if the collection was aborted, 1 if it succeeded.		*/
+typedef int (* GC_stop_func) GC_PROTO((void));
+GC_API int GC_try_to_collect GC_PROTO((GC_stop_func stop_func));
+
+/* Return the number of bytes in the heap.  Excludes collector private	*/
+/* data structures.  Includes empty blocks and fragmentation loss.	*/
+/* Includes some pages that were allocated but never written.		*/
+GC_API size_t GC_get_heap_size GC_PROTO((void));
+
+/* Return a lower bound on the number of free bytes in the heap.	*/
+GC_API size_t GC_get_free_bytes GC_PROTO((void));
+
+/* Return the number of bytes allocated since the last collection.	*/
+GC_API size_t GC_get_bytes_since_gc GC_PROTO((void));
+
+/* Enable incremental/generational collection.	*/
+/* Not advisable unless dirty bits are 		*/
+/* available or most heap objects are		*/
+/* pointerfree(atomic) or immutable.		*/
+/* Don't use in leak finding mode.		*/
+/* Ignored if GC_dont_gc is true.		*/
+GC_API void GC_enable_incremental GC_PROTO((void));
+
+/* Perform some garbage collection work, if appropriate.	*/
+/* Return 0 if there is no more work to be done.		*/
+/* Typically performs an amount of work corresponding roughly	*/
+/* to marking from one page.  May do more work if further	*/
+/* progress requires it, e.g. if incremental collection is	*/
+/* disabled.  It is reasonable to call this in a wait loop	*/
+/* until it returns 0.						*/
+GC_API int GC_collect_a_little GC_PROTO((void));
+
+/* Allocate an object of size lb bytes.  The client guarantees that	*/
+/* as long as the object is live, it will be referenced by a pointer	*/
+/* that points to somewhere within the first 256 bytes of the object.	*/
+/* (This should normally be declared volatile to prevent the compiler	*/
+/* from invalidating this assertion.)  This routine is only useful	*/
+/* if a large array is being allocated.  It reduces the chance of 	*/
+/* accidentally retaining such an array as a result of scanning an	*/
+/* integer that happens to be an address inside the array.  (Actually,	*/
+/* it reduces the chance of the allocator not finding space for such	*/
+/* an array, since it will try hard to avoid introducing such a false	*/
+/* reference.)  On a SunOS 4.X or MS Windows system this is recommended */
+/* for arrays likely to be larger than 100K or so.  For other systems,	*/
+/* or if the collector is not configured to recognize all interior	*/
+/* pointers, the threshold is normally much higher.			*/
+GC_API GC_PTR GC_malloc_ignore_off_page GC_PROTO((size_t lb));
+GC_API GC_PTR GC_malloc_atomic_ignore_off_page GC_PROTO((size_t lb));
+
+#if defined(__sgi) && !defined(__GNUC__) && _COMPILER_VERSION >= 720
+#   define GC_ADD_CALLER
+#   define GC_RETURN_ADDR (GC_word)__return_address
+#endif
+
+#ifdef GC_ADD_CALLER
+#  define GC_EXTRAS GC_RETURN_ADDR, __FILE__, __LINE__
+#  define GC_EXTRA_PARAMS GC_word ra, GC_CONST char * s, int i
+#else
+#  define GC_EXTRAS __FILE__, __LINE__
+#  define GC_EXTRA_PARAMS GC_CONST char * s, int i
+#endif
+
+/* Debugging (annotated) allocation.  GC_gcollect will check 		*/
+/* objects allocated in this way for overwrites, etc.			*/
+GC_API GC_PTR GC_debug_malloc
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_atomic
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_uncollectable
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_stubborn
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API void GC_debug_free GC_PROTO((GC_PTR object_addr));
+GC_API GC_PTR GC_debug_realloc
+	GC_PROTO((GC_PTR old_object, size_t new_size_in_bytes,
+  		  GC_EXTRA_PARAMS));
+  			 	 
+GC_API void GC_debug_change_stubborn GC_PROTO((GC_PTR));
+GC_API void GC_debug_end_stubborn_change GC_PROTO((GC_PTR));
+# ifdef GC_DEBUG
+#   define GC_MALLOC(sz) GC_debug_malloc(sz, GC_EXTRAS)
+#   define GC_MALLOC_ATOMIC(sz) GC_debug_malloc_atomic(sz, GC_EXTRAS)
+#   define GC_MALLOC_UNCOLLECTABLE(sz) GC_debug_malloc_uncollectable(sz, \
+							GC_EXTRAS)
+#   define GC_REALLOC(old, sz) GC_debug_realloc(old, sz, GC_EXTRAS)
+#   define GC_FREE(p) GC_debug_free(p)
+#   define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+	GC_debug_register_finalizer(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_IGNORE_SELF(p, f, d, of, od) \
+	GC_debug_register_finalizer_ignore_self(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
+	GC_debug_register_finalizer_no_order(p, f, d, of, od)
+#   define GC_MALLOC_STUBBORN(sz) GC_debug_malloc_stubborn(sz, GC_EXTRAS);
+#   define GC_CHANGE_STUBBORN(p) GC_debug_change_stubborn(p)
+#   define GC_END_STUBBORN_CHANGE(p) GC_debug_end_stubborn_change(p)
+#   define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
+	GC_general_register_disappearing_link(link, GC_base(obj))
+#   define GC_REGISTER_DISPLACEMENT(n) GC_debug_register_displacement(n)
+# else
+#   define GC_MALLOC(sz) GC_malloc(sz)
+#   define GC_MALLOC_ATOMIC(sz) GC_malloc_atomic(sz)
+#   define GC_MALLOC_UNCOLLECTABLE(sz) GC_malloc_uncollectable(sz)
+#   define GC_REALLOC(old, sz) GC_realloc(old, sz)
+#   define GC_FREE(p) GC_free(p)
+#   define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+	GC_register_finalizer(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_IGNORE_SELF(p, f, d, of, od) \
+	GC_register_finalizer_ignore_self(p, f, d, of, od)
+#   define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
+	GC_register_finalizer_no_order(p, f, d, of, od)
+#   define GC_MALLOC_STUBBORN(sz) GC_malloc_stubborn(sz)
+#   define GC_CHANGE_STUBBORN(p) GC_change_stubborn(p)
+#   define GC_END_STUBBORN_CHANGE(p) GC_end_stubborn_change(p)
+#   define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
+	GC_general_register_disappearing_link(link, obj)
+#   define GC_REGISTER_DISPLACEMENT(n) GC_register_displacement(n)
+# endif
+/* The following are included because they are often convenient, and	*/
+/* reduce the chance for a misspecifed size argument.  But calls may	*/
+/* expand to something syntactically incorrect if t is a complicated	*/
+/* type expression.  							*/
+# define GC_NEW(t) (t *)GC_MALLOC(sizeof (t))
+# define GC_NEW_ATOMIC(t) (t *)GC_MALLOC_ATOMIC(sizeof (t))
+# define GC_NEW_STUBBORN(t) (t *)GC_MALLOC_STUBBORN(sizeof (t))
+# define GC_NEW_UNCOLLECTABLE(t) (t *)GC_MALLOC_UNCOLLECTABLE(sizeof (t))
+
+/* Finalization.  Some of these primitives are grossly unsafe.		*/
+/* The idea is to make them both cheap, and sufficient to build		*/
+/* a safer layer, closer to PCedar finalization.			*/
+/* The interface represents my conclusions from a long discussion	*/
+/* with Alan Demers, Dan Greene, Carl Hauser, Barry Hayes, 		*/
+/* Christian Jacobi, and Russ Atkinson.  It's not perfect, and		*/
+/* probably nobody else agrees with it.	    Hans-J. Boehm  3/13/92	*/
+typedef void (*GC_finalization_proc)
+  	GC_PROTO((GC_PTR obj, GC_PTR client_data));
+
+GC_API void GC_register_finalizer
+    	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer
+    	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+	/* When obj is no longer accessible, invoke		*/
+	/* (*fn)(obj, cd).  If a and b are inaccessible, and	*/
+	/* a points to b (after disappearing links have been	*/
+	/* made to disappear), then only a will be		*/
+	/* finalized.  (If this does not create any new		*/
+	/* pointers to b, then b will be finalized after the	*/
+	/* next collection.)  Any finalizable object that	*/
+	/* is reachable from itself by following one or more	*/
+	/* pointers will not be finalized (or collected).	*/
+	/* Thus cycles involving finalizable objects should	*/
+	/* be avoided, or broken by disappearing links.		*/
+	/* All but the last finalizer registered for an object  */
+	/* is ignored.						*/
+	/* Finalization may be removed by passing 0 as fn.	*/
+	/* Finalizers are implicitly unregistered just before   */
+	/* they are invoked.					*/
+	/* The old finalizer and client data are stored in	*/
+	/* *ofn and *ocd.					*/ 
+	/* Fn is never invoked on an accessible object,		*/
+	/* provided hidden pointers are converted to real 	*/
+	/* pointers only if the allocation lock is held, and	*/
+	/* such conversions are not performed by finalization	*/
+	/* routines.						*/
+	/* If GC_register_finalizer is aborted as a result of	*/
+	/* a signal, the object may be left with no		*/
+	/* finalization, even if neither the old nor new	*/
+	/* finalizer were NULL.					*/
+	/* Obj should be the nonNULL starting address of an 	*/
+	/* object allocated by GC_malloc or friends.		*/
+	/* Note that any garbage collectable object referenced	*/
+	/* by cd will be considered accessible until the	*/
+	/* finalizer is invoked.				*/
+
+/* Another versions of the above follow.  It ignores		*/
+/* self-cycles, i.e. pointers from a finalizable object to	*/
+/* itself.  There is a stylistic argument that this is wrong,	*/
+/* but it's unavoidable for C++, since the compiler may		*/
+/* silently introduce these.  It's also benign in that specific	*/
+/* case.							*/
+GC_API void GC_register_finalizer_ignore_self
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer_ignore_self
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+
+/* Another version of the above.  It ignores all cycles.        */
+/* It should probably only be used by Java implementations.      */
+GC_API void GC_register_finalizer_no_order
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer_no_order
+	GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+		  GC_finalization_proc *ofn, GC_PTR *ocd));
+
+
+/* The following routine may be used to break cycles between	*/
+/* finalizable objects, thus causing cyclic finalizable		*/
+/* objects to be finalized in the correct order.  Standard	*/
+/* use involves calling GC_register_disappearing_link(&p),	*/
+/* where p is a pointer that is not followed by finalization	*/
+/* code, and should not be considered in determining 		*/
+/* finalization order.						*/
+GC_API int GC_register_disappearing_link GC_PROTO((GC_PTR * /* link */));
+	/* Link should point to a field of a heap allocated 	*/
+	/* object obj.  *link will be cleared when obj is	*/
+	/* found to be inaccessible.  This happens BEFORE any	*/
+	/* finalization code is invoked, and BEFORE any		*/
+	/* decisions about finalization order are made.		*/
+	/* This is useful in telling the finalizer that 	*/
+	/* some pointers are not essential for proper		*/
+	/* finalization.  This may avoid finalization cycles.	*/
+	/* Note that obj may be resurrected by another		*/
+	/* finalizer, and thus the clearing of *link may	*/
+	/* be visible to non-finalization code.  		*/
+	/* There's an argument that an arbitrary action should  */
+	/* be allowed here, instead of just clearing a pointer. */
+	/* But this causes problems if that action alters, or 	*/
+	/* examines connectivity.				*/
+	/* Returns 1 if link was already registered, 0		*/
+	/* otherwise.						*/
+	/* Only exists for backward compatibility.  See below:	*/
+	
+GC_API int GC_general_register_disappearing_link
+	GC_PROTO((GC_PTR * /* link */, GC_PTR obj));
+	/* A slight generalization of the above. *link is	*/
+	/* cleared when obj first becomes inaccessible.  This	*/
+	/* can be used to implement weak pointers easily and	*/
+	/* safely. Typically link will point to a location	*/
+	/* holding a disguised pointer to obj.  (A pointer 	*/
+	/* inside an "atomic" object is effectively  		*/
+	/* disguised.)   In this way soft			*/
+	/* pointers are broken before any object		*/
+	/* reachable from them are finalized.  Each link	*/
+	/* May be registered only once, i.e. with one obj	*/
+	/* value.  This was added after a long email discussion */
+	/* with John Ellis.					*/
+	/* Obj must be a pointer to the first word of an object */
+	/* we allocated.  It is unsafe to explicitly deallocate */
+	/* the object containing link.  Explicitly deallocating */
+	/* obj may or may not cause link to eventually be	*/
+	/* cleared.						*/
+GC_API int GC_unregister_disappearing_link GC_PROTO((GC_PTR * /* link */));
+	/* Returns 0 if link was not actually registered.	*/
+	/* Undoes a registration by either of the above two	*/
+	/* routines.						*/
+
+/* Auxiliary fns to make finalization work correctly with displaced	*/
+/* pointers introduced by the debugging allocators.			*/
+GC_API GC_PTR GC_make_closure GC_PROTO((GC_finalization_proc fn, GC_PTR data));
+GC_API void GC_debug_invoke_finalizer GC_PROTO((GC_PTR obj, GC_PTR data));
+
+/* Returns !=0  if GC_invoke_finalizers has something to do. 		*/
+GC_API int GC_should_invoke_finalizers GC_PROTO((void));
+
+GC_API int GC_invoke_finalizers GC_PROTO((void));
+	/* Run finalizers for all objects that are ready to	*/
+	/* be finalized.  Return the number of finalizers	*/
+	/* that were run.  Normally this is also called		*/
+	/* implicitly during some allocations.	If		*/
+	/* GC-finalize_on_demand is nonzero, it must be called	*/
+	/* explicitly.						*/
+
+/* GC_set_warn_proc can be used to redirect or filter warning messages.	*/
+/* p may not be a NULL pointer.						*/
+typedef void (*GC_warn_proc) GC_PROTO((char *msg, GC_word arg));
+GC_API GC_warn_proc GC_set_warn_proc GC_PROTO((GC_warn_proc p));
+    /* Returns old warning procedure.	*/
+	
+/* The following is intended to be used by a higher level	*/
+/* (e.g. cedar-like) finalization facility.  It is expected	*/
+/* that finalization code will arrange for hidden pointers to	*/
+/* disappear.  Otherwise objects can be accessed after they	*/
+/* have been collected.						*/
+/* Note that putting pointers in atomic objects or in 		*/
+/* nonpointer slots of "typed" objects is equivalent to 	*/
+/* disguising them in this way, and may have other advantages.	*/
+# if defined(I_HIDE_POINTERS) || defined(GC_I_HIDE_POINTERS)
+    typedef GC_word GC_hidden_pointer;
+#   define HIDE_POINTER(p) (~(GC_hidden_pointer)(p))
+#   define REVEAL_POINTER(p) ((GC_PTR)(HIDE_POINTER(p)))
+    /* Converting a hidden pointer to a real pointer requires verifying	*/
+    /* that the object still exists.  This involves acquiring the  	*/
+    /* allocator lock to avoid a race with the collector.		*/
+# endif /* I_HIDE_POINTERS */
+
+typedef GC_PTR (*GC_fn_type) GC_PROTO((GC_PTR client_data));
+GC_API GC_PTR GC_call_with_alloc_lock
+        	GC_PROTO((GC_fn_type fn, GC_PTR client_data));
+
+/* Check that p and q point to the same object.  		*/
+/* Fail conspicuously if they don't.				*/
+/* Returns the first argument.  				*/
+/* Succeeds if neither p nor q points to the heap.		*/
+/* May succeed if both p and q point to between heap objects.	*/
+GC_API GC_PTR GC_same_obj GC_PROTO((GC_PTR p, GC_PTR q));
+
+/* Checked pointer pre- and post- increment operations.  Note that	*/
+/* the second argument is in units of bytes, not multiples of the	*/
+/* object size.  This should either be invoked from a macro, or the	*/
+/* call should be automatically generated.				*/
+GC_API GC_PTR GC_pre_incr GC_PROTO((GC_PTR *p, size_t how_much));
+GC_API GC_PTR GC_post_incr GC_PROTO((GC_PTR *p, size_t how_much));
+
+/* Check that p is visible						*/
+/* to the collector as a possibly pointer containing location.		*/
+/* If it isn't fail conspicuously.					*/
+/* Returns the argument in all cases.  May erroneously succeed		*/
+/* in hard cases.  (This is intended for debugging use with		*/
+/* untyped allocations.  The idea is that it should be possible, though	*/
+/* slow, to add such a call to all indirect pointer stores.)		*/
+/* Currently useless for multithreaded worlds.				*/
+GC_API GC_PTR GC_is_visible GC_PROTO((GC_PTR p));
+
+/* Check that if p is a pointer to a heap page, then it points to	*/
+/* a valid displacement within a heap object.				*/
+/* Fail conspicuously if this property does not hold.			*/
+/* Uninteresting with ALL_INTERIOR_POINTERS.				*/
+/* Always returns its argument.						*/
+GC_API GC_PTR GC_is_valid_displacement GC_PROTO((GC_PTR	p));
+
+/* Safer, but slow, pointer addition.  Probably useful mainly with 	*/
+/* a preprocessor.  Useful only for heap pointers.			*/
+#ifdef GC_DEBUG
+#   define GC_PTR_ADD3(x, n, type_of_result) \
+	((type_of_result)GC_same_obj((x)+(n), (x)))
+#   define GC_PRE_INCR3(x, n, type_of_result) \
+	((type_of_result)GC_pre_incr(&(x), (n)*sizeof(*x))
+#   define GC_POST_INCR2(x, type_of_result) \
+	((type_of_result)GC_post_incr(&(x), sizeof(*x))
+#   ifdef __GNUC__
+#       define GC_PTR_ADD(x, n) \
+	    GC_PTR_ADD3(x, n, typeof(x))
+#   define GC_PRE_INCR(x, n) \
+	    GC_PRE_INCR3(x, n, typeof(x))
+#   define GC_POST_INCR(x, n) \
+	    GC_POST_INCR3(x, typeof(x))
+#   else
+	/* We can't do this right without typeof, which ANSI	*/
+	/* decided was not sufficiently useful.  Repeatedly	*/
+	/* mentioning the arguments seems too dangerous to be	*/
+	/* useful.  So does not casting the result.		*/
+#   	define GC_PTR_ADD(x, n) ((x)+(n))
+#   endif
+#else	/* !GC_DEBUG */
+#   define GC_PTR_ADD3(x, n, type_of_result) ((x)+(n))
+#   define GC_PTR_ADD(x, n) ((x)+(n))
+#   define GC_PRE_INCR3(x, n, type_of_result) ((x) += (n))
+#   define GC_PRE_INCR(x, n) ((x) += (n))
+#   define GC_POST_INCR2(x, n, type_of_result) ((x)++)
+#   define GC_POST_INCR(x, n) ((x)++)
+#endif
+
+/* Safer assignment of a pointer to a nonstack location.	*/
+#ifdef GC_DEBUG
+# ifdef __STDC__
+#   define GC_PTR_STORE(p, q) \
+	(*(void **)GC_is_visible(p) = GC_is_valid_displacement(q))
+# else
+#   define GC_PTR_STORE(p, q) \
+	(*(char **)GC_is_visible(p) = GC_is_valid_displacement(q))
+# endif
+#else /* !GC_DEBUG */
+#   define GC_PTR_STORE(p, q) *((p) = (q))
+#endif
+
+/* Fynctions called to report pointer checking errors */
+GC_API void (*GC_same_obj_print_proc) GC_PROTO((GC_PTR p, GC_PTR q));
+
+GC_API void (*GC_is_valid_displacement_print_proc)
+	GC_PROTO((GC_PTR p));
+
+GC_API void (*GC_is_visible_print_proc)
+	GC_PROTO((GC_PTR p));
+
+#if defined(_SOLARIS_PTHREADS) && !defined(SOLARIS_THREADS)
+#   define SOLARIS_THREADS
+#endif
+
+#ifdef SOLARIS_THREADS
+/* We need to intercept calls to many of the threads primitives, so 	*/
+/* that we can locate thread stacks and stop the world.			*/
+/* Note also that the collector cannot see thread specific data.	*/
+/* Thread specific data should generally consist of pointers to		*/
+/* uncollectable objects, which are deallocated using the destructor	*/
+/* facility in thr_keycreate.						*/
+# include <thread.h>
+# include <signal.h>
+  int GC_thr_create(void *stack_base, size_t stack_size,
+                    void *(*start_routine)(void *), void *arg, long flags,
+                    thread_t *new_thread);
+  int GC_thr_join(thread_t wait_for, thread_t *departed, void **status);
+  int GC_thr_suspend(thread_t target_thread);
+  int GC_thr_continue(thread_t target_thread);
+  void * GC_dlopen(const char *path, int mode);
+
+# ifdef _SOLARIS_PTHREADS
+#   include <pthread.h>
+    extern int GC_pthread_create(pthread_t *new_thread,
+    			         const pthread_attr_t *attr,
+          			 void * (*thread_execp)(void *), void *arg);
+    extern int GC_pthread_join(pthread_t wait_for, void **status);
+
+#   undef thread_t
+
+#   define pthread_join GC_pthread_join
+#   define pthread_create GC_pthread_create
+#endif
+
+# define thr_create GC_thr_create
+# define thr_join GC_thr_join
+# define thr_suspend GC_thr_suspend
+# define thr_continue GC_thr_continue
+# define dlopen GC_dlopen
+
+# endif /* SOLARIS_THREADS */
+
+
+#if !defined(USE_LD_WRAP) && \
+    (defined(IRIX_THREADS) || defined(LINUX_THREADS) || defined(HPUX_THREADS))
+/* We treat these similarly. */
+# include <pthread.h>
+# include <signal.h>
+
+  int GC_pthread_create(pthread_t *new_thread,
+                        const pthread_attr_t *attr,
+		        void *(*start_routine)(void *), void *arg);
+  int GC_pthread_sigmask(int how, const sigset_t *set, sigset_t *oset);
+  int GC_pthread_join(pthread_t thread, void **retval);
+
+# define pthread_create GC_pthread_create
+# define pthread_sigmask GC_pthread_sigmask
+# define pthread_join GC_pthread_join
+# define dlopen GC_dlopen
+
+#endif /* xxxxx_THREADS */
+
+# if defined(PCR) || defined(SOLARIS_THREADS) || defined(WIN32_THREADS) || \
+	defined(IRIX_THREADS) || defined(LINUX_THREADS) || \
+	defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
+   	/* Any flavor of threads except SRC_M3.	*/
+/* This returns a list of objects, linked through their first		*/
+/* word.  Its use can greatly reduce lock contention problems, since	*/
+/* the allocation lock can be acquired and released many fewer times.	*/
+/* lb must be large enough to hold the pointer field.			*/
+GC_PTR GC_malloc_many(size_t lb);
+#define GC_NEXT(p) (*(GC_PTR *)(p)) 	/* Retrieve the next element	*/
+					/* in returned list.		*/
+extern void GC_thr_init();	/* Needed for Solaris/X86	*/
+
+#endif /* THREADS && !SRC_M3 */
+
+/*
+ * If you are planning on putting
+ * the collector in a SunOS 5 dynamic library, you need to call GC_INIT()
+ * from the statically loaded program section.
+ * This circumvents a Solaris 2.X (X<=4) linker bug.
+ */
+#if defined(sparc) || defined(__sparc)
+#   define GC_INIT() { extern end, etext; \
+		       GC_noop(&end, &etext); }
+#else
+# if defined(__CYGWIN32__) && defined(GC_USE_DLL)
+    /*
+     * Similarly gnu-win32 DLLs need explicit initialization
+     */
+#   define GC_INIT() { GC_add_roots(DATASTART, DATAEND); }
+# else
+#   define GC_INIT()
+# endif
+#endif
+
+#if (defined(_MSDOS) || defined(_MSC_VER)) && (_M_IX86 >= 300) \
+     || defined(_WIN32)
+  /* win32S may not free all resources on process exit.  */
+  /* This explicitly deallocates the heap.		 */
+    GC_API void GC_win32_free_heap ();
+#endif
+
+#ifdef __cplusplus
+    }  /* end of extern "C" */
+#endif
+
+#endif /* _GC_H */
diff --git a/src/gc/include/gc_alloc.h b/src/gc/include/gc_alloc.h
new file mode 100644
index 000000000..1f1d54aff
--- /dev/null
+++ b/src/gc/include/gc_alloc.h
@@ -0,0 +1,380 @@
+/*
+ * Copyright (c) 1996-1998 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+//
+// This is a C++ header file that is intended to replace the SGI STL
+// alloc.h.  This assumes SGI STL version < 3.0.
+//
+// This assumes the collector has been compiled with -DATOMIC_UNCOLLECTABLE
+// and -DALL_INTERIOR_POINTERS.  We also recommend
+// -DREDIRECT_MALLOC=GC_uncollectable_malloc.
+//
+// Some of this could be faster in the explicit deallocation case.  In particular,
+// we spend too much time clearing objects on the free lists.  That could be avoided.
+//
+// This uses template classes with static members, and hence does not work
+// with g++ 2.7.2 and earlier.
+//
+
+#include "gc.h"
+
+#ifndef GC_ALLOC_H
+
+#define GC_ALLOC_H
+#define __ALLOC_H	// Prevent inclusion of the default version.  Ugly.
+#define __SGI_STL_ALLOC_H
+#define __SGI_STL_INTERNAL_ALLOC_H
+
+#ifndef __ALLOC
+#   define __ALLOC alloc
+#endif
+
+#include <stddef.h>
+#include <string.h>
+
+// The following is just replicated from the conventional SGI alloc.h:
+
+template<class T, class alloc>
+class simple_alloc {
+
+public:
+    static T *allocate(size_t n)
+                { return 0 == n? 0 : (T*) alloc::allocate(n * sizeof (T)); }
+    static T *allocate(void)
+                { return (T*) alloc::allocate(sizeof (T)); }
+    static void deallocate(T *p, size_t n)
+                { if (0 != n) alloc::deallocate(p, n * sizeof (T)); }
+    static void deallocate(T *p)
+                { alloc::deallocate(p, sizeof (T)); }
+};
+
+#include "gc.h"
+
+// The following need to match collector data structures.
+// We can't include gc_priv.h, since that pulls in way too much stuff.
+// This should eventually be factored out into another include file.
+
+extern "C" {
+    extern void ** const GC_objfreelist_ptr;
+    extern void ** const GC_aobjfreelist_ptr;
+    extern void ** const GC_uobjfreelist_ptr;
+    extern void ** const GC_auobjfreelist_ptr;
+
+    extern void GC_incr_words_allocd(size_t words);
+    extern void GC_incr_mem_freed(size_t words);
+
+    extern char * GC_generic_malloc_words_small(size_t word, int kind);
+}
+
+// Object kinds; must match PTRFREE, NORMAL, UNCOLLECTABLE, and
+// AUNCOLLECTABLE in gc_priv.h.
+
+enum { GC_PTRFREE = 0, GC_NORMAL = 1, GC_UNCOLLECTABLE = 2,
+       GC_AUNCOLLECTABLE = 3 };
+
+enum { GC_max_fast_bytes = 255 };
+
+enum { GC_bytes_per_word = sizeof(char *) };
+
+enum { GC_byte_alignment = 8 };
+
+enum { GC_word_alignment = GC_byte_alignment/GC_bytes_per_word };
+
+inline void * &GC_obj_link(void * p)
+{   return *(void **)p;  }
+
+// Compute a number of words >= n+1 bytes.
+// The +1 allows for pointers one past the end.
+inline size_t GC_round_up(size_t n)
+{
+    return ((n + GC_byte_alignment)/GC_byte_alignment)*GC_word_alignment;
+}
+
+// The same but don't allow for extra byte.
+inline size_t GC_round_up_uncollectable(size_t n)
+{
+    return ((n + GC_byte_alignment - 1)/GC_byte_alignment)*GC_word_alignment;
+}
+
+template <int dummy>
+class GC_aux_template {
+public:
+  // File local count of allocated words.  Occasionally this is
+  // added into the global count.  A separate count is necessary since the
+  // real one must be updated with a procedure call.
+  static size_t GC_words_recently_allocd;
+
+  // Same for uncollectable mmory.  Not yet reflected in either
+  // GC_words_recently_allocd or GC_non_gc_bytes.
+  static size_t GC_uncollectable_words_recently_allocd;
+
+  // Similar counter for explicitly deallocated memory.
+  static size_t GC_mem_recently_freed;
+
+  // Again for uncollectable memory.
+  static size_t GC_uncollectable_mem_recently_freed;
+
+  static void * GC_out_of_line_malloc(size_t nwords, int kind);
+};
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_mem_recently_freed = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_mem_recently_freed = 0;
+
+template <int dummy>
+void * GC_aux_template<dummy>::GC_out_of_line_malloc(size_t nwords, int kind)
+{
+    GC_words_recently_allocd += GC_uncollectable_words_recently_allocd;
+    GC_non_gc_bytes +=
+                GC_bytes_per_word * GC_uncollectable_words_recently_allocd;
+    GC_uncollectable_words_recently_allocd = 0;
+
+    GC_mem_recently_freed += GC_uncollectable_mem_recently_freed;
+    GC_non_gc_bytes -= 
+                GC_bytes_per_word * GC_uncollectable_mem_recently_freed;
+    GC_uncollectable_mem_recently_freed = 0;
+
+    GC_incr_words_allocd(GC_words_recently_allocd);
+    GC_words_recently_allocd = 0;
+
+    GC_incr_mem_freed(GC_mem_recently_freed);
+    GC_mem_recently_freed = 0;
+
+    return GC_generic_malloc_words_small(nwords, kind);
+}
+
+typedef GC_aux_template<0> GC_aux;
+
+// A fast, single-threaded, garbage-collected allocator
+// We assume the first word will be immediately overwritten.
+// In this version, deallocation is not a noop, and explicit
+// deallocation is likely to help performance.
+template <int dummy>
+class single_client_gc_alloc_template {
+    public:
+     	static void * allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc(n);
+	    flh = GC_objfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_NORMAL);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_words_recently_allocd += nwords;
+	    return op;
+        }
+     	static void * ptr_free_allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc_atomic(n);
+	    flh = GC_aobjfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_PTRFREE);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_words_recently_allocd += nwords;
+	    return op;
+        }
+	static void deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes)  {
+		GC_free(p);
+	    } else {
+	        flh = GC_objfreelist_ptr + nwords;
+	        GC_obj_link(p) = *flh;
+		memset((char *)p + GC_bytes_per_word, 0,
+		       GC_bytes_per_word * (nwords - 1));
+	        *flh = p;
+	        GC_aux::GC_mem_recently_freed += nwords;
+	    }
+	}
+	static void ptr_free_deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes) {
+		GC_free(p);
+	    } else {
+	    	flh = GC_aobjfreelist_ptr + nwords;
+	    	GC_obj_link(p) = *flh;
+	    	*flh = p;
+	    	GC_aux::GC_mem_recently_freed += nwords;
+	    }
+	}
+};
+
+typedef single_client_gc_alloc_template<0> single_client_gc_alloc;
+
+// Once more, for uncollectable objects.
+template <int dummy>
+class single_client_alloc_template {
+    public:
+     	static void * allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up_uncollectable(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc_uncollectable(n);
+	    flh = GC_uobjfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_UNCOLLECTABLE);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+	    return op;
+        }
+     	static void * ptr_free_allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up_uncollectable(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc_atomic_uncollectable(n);
+	    flh = GC_auobjfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_AUNCOLLECTABLE);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+	    return op;
+        }
+	static void deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up_uncollectable(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes)  {
+		GC_free(p);
+	    } else {
+	        flh = GC_uobjfreelist_ptr + nwords;
+	        GC_obj_link(p) = *flh;
+	        *flh = p;
+	        GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+	    }
+	}
+	static void ptr_free_deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up_uncollectable(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes) {
+		GC_free(p);
+	    } else {
+	    	flh = GC_auobjfreelist_ptr + nwords;
+	    	GC_obj_link(p) = *flh;
+	    	*flh = p;
+	    	GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+	    }
+	}
+};
+
+typedef single_client_alloc_template<0> single_client_alloc;
+
+template < int dummy >
+class gc_alloc_template {
+    public:
+     	static void * allocate(size_t n) { return GC_malloc(n); }
+     	static void * ptr_free_allocate(size_t n)
+		{ return GC_malloc_atomic(n); }
+	static void deallocate(void *, size_t) { }
+	static void ptr_free_deallocate(void *, size_t) { }
+};
+
+typedef gc_alloc_template < 0 > gc_alloc;
+
+template < int dummy >
+class alloc_template {
+    public:
+     	static void * allocate(size_t n) { return GC_malloc_uncollectable(n); }
+     	static void * ptr_free_allocate(size_t n)
+		{ return GC_malloc_atomic_uncollectable(n); }
+	static void deallocate(void *p, size_t) { GC_free(p); }
+	static void ptr_free_deallocate(void *p, size_t) { GC_free(p); }
+};
+
+typedef alloc_template < 0 > alloc;
+
+#ifdef _SGI_SOURCE
+
+// We want to specialize simple_alloc so that it does the right thing
+// for all pointerfree types.  At the moment there is no portable way to
+// even approximate that.  The following approximation should work for
+// SGI compilers, and perhaps some others.
+
+# define __GC_SPECIALIZE(T,alloc) \
+class simple_alloc<T, alloc> { \
+public: \
+    static T *allocate(size_t n) \
+	{ return 0 == n? 0 : \
+			 (T*) alloc::ptr_free_allocate(n * sizeof (T)); } \
+    static T *allocate(void) \
+	{ return (T*) alloc::ptr_free_allocate(sizeof (T)); } \
+    static void deallocate(T *p, size_t n) \
+	{ if (0 != n) alloc::ptr_free_deallocate(p, n * sizeof (T)); } \
+    static void deallocate(T *p) \
+	{ alloc::ptr_free_deallocate(p, sizeof (T)); } \
+};
+
+__GC_SPECIALIZE(char, gc_alloc)
+__GC_SPECIALIZE(int, gc_alloc)
+__GC_SPECIALIZE(unsigned, gc_alloc)
+__GC_SPECIALIZE(float, gc_alloc)
+__GC_SPECIALIZE(double, gc_alloc)
+
+__GC_SPECIALIZE(char, alloc)
+__GC_SPECIALIZE(int, alloc)
+__GC_SPECIALIZE(unsigned, alloc)
+__GC_SPECIALIZE(float, alloc)
+__GC_SPECIALIZE(double, alloc)
+
+__GC_SPECIALIZE(char, single_client_gc_alloc)
+__GC_SPECIALIZE(int, single_client_gc_alloc)
+__GC_SPECIALIZE(unsigned, single_client_gc_alloc)
+__GC_SPECIALIZE(float, single_client_gc_alloc)
+__GC_SPECIALIZE(double, single_client_gc_alloc)
+
+__GC_SPECIALIZE(char, single_client_alloc)
+__GC_SPECIALIZE(int, single_client_alloc)
+__GC_SPECIALIZE(unsigned, single_client_alloc)
+__GC_SPECIALIZE(float, single_client_alloc)
+__GC_SPECIALIZE(double, single_client_alloc)
+
+#ifdef __STL_USE_STD_ALLOCATORS
+
+???copy stuff from stl_alloc.h or remove it to a different file ???
+
+#endif /* __STL_USE_STD_ALLOCATORS */
+
+#endif /* _SGI_SOURCE */
+
+#endif /* GC_ALLOC_H */
diff --git a/src/gc/include/gc_copy_descr.h b/src/gc/include/gc_copy_descr.h
new file mode 100644
index 000000000..212c99e28
--- /dev/null
+++ b/src/gc/include/gc_copy_descr.h
@@ -0,0 +1,26 @@
+
+/* 
+ * Copyright (c) 1999 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Descriptor for allocation request. May be redefined by client. */
+typedef struct {
+    GC_word bitmap;	/* Bitmap describing pointer locations.	*/
+			/* High order bit correspond to 0th	*/
+			/* word.  2 lsbs must be 0.		*/
+    size_t length;      /* In bytes, must be multiple of word	*/
+			/* size.  Must be >0, <= 512		*/
+} * GC_copy_descriptor;
+
+/* The collector accesses descriptors only through these two macros. */
+#define GC_SIZE_FROM_DESCRIPTOR(d) ((d) -> length)
+#define GC_BIT_MAP_FROM_DESCRIPTOR(d) ((d) -> bitmap)
+
diff --git a/src/gc/include/gc_cpp.h b/src/gc/include/gc_cpp.h
new file mode 100644
index 000000000..3b86824cf
--- /dev/null
+++ b/src/gc/include/gc_cpp.h
@@ -0,0 +1,310 @@
+#ifndef GC_CPP_H
+#define GC_CPP_H
+/****************************************************************************
+Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+Permission is hereby granted to use or copy this program for any
+purpose, provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is
+granted, provided the above notices are retained, and a notice that
+the code was modified is included with the above copyright notice.
+****************************************************************************
+
+C++ Interface to the Boehm Collector
+
+    John R. Ellis and Jesse Hull 
+
+This interface provides access to the Boehm collector.  It provides
+basic facilities similar to those described in "Safe, Efficient
+Garbage Collection for C++", by John R. Elis and David L. Detlefs
+(ftp://ftp.parc.xerox.com/pub/ellis/gc).
+
+All heap-allocated objects are either "collectable" or
+"uncollectable".  Programs must explicitly delete uncollectable
+objects, whereas the garbage collector will automatically delete
+collectable objects when it discovers them to be inaccessible.
+Collectable objects may freely point at uncollectable objects and vice
+versa.
+
+Objects allocated with the built-in "::operator new" are uncollectable.
+
+Objects derived from class "gc" are collectable.  For example:
+
+    class A: public gc {...};
+    A* a = new A;       // a is collectable. 
+
+Collectable instances of non-class types can be allocated using the GC
+(or UseGC) placement:
+
+    typedef int A[ 10 ];
+    A* a = new (GC) A;
+
+Uncollectable instances of classes derived from "gc" can be allocated
+using the NoGC placement:
+
+    class A: public gc {...};
+    A* a = new (NoGC) A;   // a is uncollectable.
+
+Both uncollectable and collectable objects can be explicitly deleted
+with "delete", which invokes an object's destructors and frees its
+storage immediately.
+
+A collectable object may have a clean-up function, which will be
+invoked when the collector discovers the object to be inaccessible.
+An object derived from "gc_cleanup" or containing a member derived
+from "gc_cleanup" has a default clean-up function that invokes the
+object's destructors.  Explicit clean-up functions may be specified as
+an additional placement argument:
+
+    A* a = ::new (GC, MyCleanup) A;
+
+An object is considered "accessible" by the collector if it can be
+reached by a path of pointers from static variables, automatic
+variables of active functions, or from some object with clean-up
+enabled; pointers from an object to itself are ignored.
+
+Thus, if objects A and B both have clean-up functions, and A points at
+B, B is considered accessible.  After A's clean-up is invoked and its
+storage released, B will then become inaccessible and will have its
+clean-up invoked.  If A points at B and B points to A, forming a
+cycle, then that's considered a storage leak, and neither will be
+collectable.  See the interface gc.h for low-level facilities for
+handling such cycles of objects with clean-up.
+
+The collector cannot guarrantee that it will find all inaccessible
+objects.  In practice, it finds almost all of them.
+
+
+Cautions:
+
+1. Be sure the collector has been augmented with "make c++".
+
+2.  If your compiler supports the new "operator new[]" syntax, then
+add -DOPERATOR_NEW_ARRAY to the Makefile.
+
+If your compiler doesn't support "operator new[]", beware that an
+array of type T, where T is derived from "gc", may or may not be
+allocated as a collectable object (it depends on the compiler).  Use
+the explicit GC placement to make the array collectable.  For example:
+
+    class A: public gc {...};
+    A* a1 = new A[ 10 ];        // collectable or uncollectable?
+    A* a2 = new (GC) A[ 10 ];   // collectable
+
+3. The destructors of collectable arrays of objects derived from
+"gc_cleanup" will not be invoked properly.  For example:
+
+    class A: public gc_cleanup {...};
+    A* a = new (GC) A[ 10 ];    // destructors not invoked correctly
+
+Typically, only the destructor for the first element of the array will
+be invoked when the array is garbage-collected.  To get all the
+destructors of any array executed, you must supply an explicit
+clean-up function:
+
+    A* a = new (GC, MyCleanUp) A[ 10 ];
+
+(Implementing clean-up of arrays correctly, portably, and in a way
+that preserves the correct exception semantics requires a language
+extension, e.g. the "gc" keyword.)
+
+4. Compiler bugs:
+
+* Solaris 2's CC (SC3.0) doesn't implement t->~T() correctly, so the
+destructors of classes derived from gc_cleanup won't be invoked.
+You'll have to explicitly register a clean-up function with
+new-placement syntax.
+
+* Evidently cfront 3.0 does not allow destructors to be explicitly
+invoked using the ANSI-conforming syntax t->~T().  If you're using
+cfront 3.0, you'll have to comment out the class gc_cleanup, which
+uses explicit invocation.
+
+5. GC name conflicts:
+
+Many other systems seem to use the identifier "GC" as an abbreviation
+for "Graphics Context".  Since version 5.0, GC placement has been replaced
+by UseGC.  GC is an alias for UseGC, unless GC_NAME_CONFLICT is defined.
+
+****************************************************************************/
+
+#include "gc.h"
+
+#ifndef THINK_CPLUS
+#define _cdecl
+#endif
+
+#if ! defined( OPERATOR_NEW_ARRAY ) \
+    && (__BORLANDC__ >= 0x450 || (__GNUC__ >= 2 && __GNUC_MINOR__ >= 6) \
+        || __WATCOMC__ >= 1050 || _MSC_VER >= 1100)
+#   define OPERATOR_NEW_ARRAY
+#endif
+
+enum GCPlacement {UseGC,
+#ifndef GC_NAME_CONFLICT
+		  GC=UseGC,
+#endif
+                  NoGC, PointerFreeGC};
+
+class gc {public:
+    inline void* operator new( size_t size );
+    inline void* operator new( size_t size, GCPlacement gcp );
+    inline void operator delete( void* obj );
+
+#ifdef OPERATOR_NEW_ARRAY
+    inline void* operator new[]( size_t size );
+    inline void* operator new[]( size_t size, GCPlacement gcp );
+    inline void operator delete[]( void* obj );
+#endif /* OPERATOR_NEW_ARRAY */
+    };    
+    /*
+    Instances of classes derived from "gc" will be allocated in the 
+    collected heap by default, unless an explicit NoGC placement is
+    specified. */
+
+class gc_cleanup: virtual public gc {public:
+    inline gc_cleanup();
+    inline virtual ~gc_cleanup();
+private:
+    inline static void _cdecl cleanup( void* obj, void* clientData );};
+    /*
+    Instances of classes derived from "gc_cleanup" will be allocated
+    in the collected heap by default.  When the collector discovers an
+    inaccessible object derived from "gc_cleanup" or containing a
+    member derived from "gc_cleanup", its destructors will be
+    invoked. */
+
+extern "C" {typedef void (*GCCleanUpFunc)( void* obj, void* clientData );}
+
+inline void* operator new( 
+    size_t size, 
+    GCPlacement gcp,
+    GCCleanUpFunc cleanup = 0,
+    void* clientData = 0 );
+    /*
+    Allocates a collectable or uncollected object, according to the
+    value of "gcp".
+
+    For collectable objects, if "cleanup" is non-null, then when the
+    allocated object "obj" becomes inaccessible, the collector will
+    invoke the function "cleanup( obj, clientData )" but will not
+    invoke the object's destructors.  It is an error to explicitly
+    delete an object allocated with a non-null "cleanup".
+
+    It is an error to specify a non-null "cleanup" with NoGC or for
+    classes derived from "gc_cleanup" or containing members derived
+    from "gc_cleanup". */
+
+#ifdef OPERATOR_NEW_ARRAY
+
+#ifdef _MSC_VER
+ /** This ensures that the system default operator new[] doesn't get
+  *  undefined, which is what seems to happen on VC++ 6 for some reason
+  *  if we define a multi-argument operator new[].
+  */
+ inline void *operator new[]( size_t size )
+ {
+    return ::operator new( size );
+ }
+#endif /* _MSC_VER */
+
+inline void* operator new[](
+    size_t size, 
+    GCPlacement gcp,
+    GCCleanUpFunc cleanup = 0,
+    void* clientData = 0 );
+    /*
+    The operator new for arrays, identical to the above. */
+
+#endif /* OPERATOR_NEW_ARRAY */
+
+/****************************************************************************
+
+Inline implementation
+
+****************************************************************************/
+
+inline void* gc::operator new( size_t size ) {
+    return GC_MALLOC( size );}
+    
+inline void* gc::operator new( size_t size, GCPlacement gcp ) {
+    if (gcp == UseGC) 
+        return GC_MALLOC( size );
+    else if (gcp == PointerFreeGC)
+	return GC_MALLOC_ATOMIC( size );
+    else
+        return GC_MALLOC_UNCOLLECTABLE( size );}
+
+inline void gc::operator delete( void* obj ) {
+    GC_FREE( obj );}
+    
+
+#ifdef OPERATOR_NEW_ARRAY
+
+inline void* gc::operator new[]( size_t size ) {
+    return gc::operator new( size );}
+    
+inline void* gc::operator new[]( size_t size, GCPlacement gcp ) {
+    return gc::operator new( size, gcp );}
+
+inline void gc::operator delete[]( void* obj ) {
+    gc::operator delete( obj );}
+    
+#endif /* OPERATOR_NEW_ARRAY */
+
+
+inline gc_cleanup::~gc_cleanup() {
+    GC_REGISTER_FINALIZER_IGNORE_SELF( GC_base(this), 0, 0, 0, 0 );}
+
+inline void gc_cleanup::cleanup( void* obj, void* displ ) {
+    ((gc_cleanup*) ((char*) obj + (ptrdiff_t) displ))->~gc_cleanup();}
+
+inline gc_cleanup::gc_cleanup() {
+    GC_finalization_proc oldProc;
+    void* oldData;
+    void* base = GC_base( (void *) this );
+    if (0 != base)  {
+      GC_REGISTER_FINALIZER_IGNORE_SELF( 
+        base, (GC_finalization_proc)cleanup, (void*) ((char*) this - (char*) base), 
+        &oldProc, &oldData );
+      if (0 != oldProc) {
+        GC_REGISTER_FINALIZER_IGNORE_SELF( base, oldProc, oldData, 0, 0 );}}}
+
+inline void* operator new( 
+    size_t size, 
+    GCPlacement gcp,
+    GCCleanUpFunc cleanup,
+    void* clientData )
+{
+    void* obj;
+
+    if (gcp == UseGC) {
+        obj = GC_MALLOC( size );
+        if (cleanup != 0) 
+            GC_REGISTER_FINALIZER_IGNORE_SELF( 
+                obj, cleanup, clientData, 0, 0 );}
+    else if (gcp == PointerFreeGC) {
+        obj = GC_MALLOC_ATOMIC( size );}
+    else {
+        obj = GC_MALLOC_UNCOLLECTABLE( size );};
+    return obj;}
+        
+
+#ifdef OPERATOR_NEW_ARRAY
+
+inline void* operator new[]( 
+    size_t size, 
+    GCPlacement gcp,
+    GCCleanUpFunc cleanup,
+    void* clientData )
+{
+    return ::operator new( size, gcp, cleanup, clientData );}
+
+#endif /* OPERATOR_NEW_ARRAY */
+
+
+#endif /* GC_CPP_H */
+
diff --git a/src/gc/include/gc_gcj.h b/src/gc/include/gc_gcj.h
new file mode 100644
index 000000000..1dede5154
--- /dev/null
+++ b/src/gc/include/gc_gcj.h
@@ -0,0 +1,101 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright 1996-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright 1999 by Hewlett-Packard Company.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/* This file assumes the collector has been compiled with GC_GCJ_SUPPORT */
+/* and that an ANSI C compiler is available.				 */
+
+/*
+ * We allocate objects whose first word contains a pointer to a struct
+ * describing the object type.  This struct contains a garbage collector mark
+ * descriptor at offset MARK_DESCR_OFFSET.  Alternatively, the objects
+ * may be marked by the mark procedure passed to GC_init_gcj_malloc.
+ */
+
+#ifndef MARK_DESCR_OFFSET
+#  define MARK_DESCR_OFFSET	sizeof(word)
+#endif
+	/* Gcj keeps GC descriptor as second word of vtable.	This	*/
+	/* probably needs to be adjusted for other clients.		*/
+	/* We currently assume that this offset is such that:		*/
+	/*	- all objects of this kind are large enough to have	*/
+	/*	  a value at that offset, and				*/
+	/* 	- it is not zero.					*/
+	/* These assumptions allow objects on the free list to be 	*/
+	/* marked normally.						*/
+
+#ifndef _GC_H
+#   include "gc.h"
+#endif
+
+/* The following allocators signal an out of memory condition with	*/
+/* return GC_oom_action();						*/
+/* The default GC_oom_action returns 0.					*/
+/* This functionality is currently restricted to the gcj allocators.	*/
+/* We may want to extend it to the others.				*/
+
+extern void * (*GC_oom_action)(void);
+
+/* The following function must be called before the gcj allocators	*/
+/* can be invoked.							*/
+/* mp_index and mp are the index and mark_proc (see gc_mark.h)		*/
+/* respectively for the allocated objects.  Mark_proc will be 		*/
+/* used to build the descriptor for objects allocated through the	*/
+/* debugging interface.  The mark_proc will be invoked on all such 	*/
+/* objects with an "environment" value of 1.  The client may chose	*/
+/* to use the same mark_proc for some of its generated mark descriptors.*/
+/* In that case, it should use a different "environment" value to	*/
+/* detect the presence or absence of the debug header.			*/
+
+/* the debugging interface.						*/
+/* Mp is really of type mark_proc, as defined in gc_mark.h.  We don't 	*/
+/* want to include that here for namespace pollution reasons.		*/
+extern void GC_init_gcj_malloc(int mp_index, void * /* really mark_proc */mp);
+
+/* Allocate an object, clear it, and store the pointer to the	*/
+/* type structure (vtable in gcj).				*/
+/* This adds a byte at the end of the object if GC_malloc would.*/
+extern void * GC_gcj_malloc(size_t lb, void * ptr_to_struct_containing_descr);
+/* The debug versions allocate such that the specified mark_proc	*/
+/* is always invoked.							*/
+extern void * GC_debug_gcj_malloc(size_t lb,
+				  void * ptr_to_struct_containing_descr,
+				  GC_EXTRA_PARAMS);
+
+/* Similar to the above, but the size is in words, and we don't	*/
+/* adjust it.  The size is assumed to be such that it can be 	*/
+/* allocated as a small object.					*/
+extern void * GC_gcj_fast_malloc(size_t lw,
+				 void * ptr_to_struct_containing_descr);
+extern void * GC_debug_gcj_fast_malloc(size_t lw,
+				 void * ptr_to_struct_containing_descr,
+				 GC_EXTRA_PARAMS);
+
+/* Similar to GC_gcj_malloc, but assumes that a pointer to near the	*/
+/* beginning of the resulting object is always maintained.		*/
+extern void * GC_gcj_malloc_ignore_off_page(size_t lb,
+				void * ptr_to_struct_containing_descr);
+
+# ifdef GC_DEBUG
+#   define GC_GCJ_MALLOC(s,d) GC_debug_gcj_malloc(s,d,GC_EXTRAS)
+#   define GC_GCJ_FAST_MALLOC(s,d) GC_debug_gcj_fast_malloc(s,d,GC_EXTRAS)
+#   define GC_GCJ_MALLOC_IGNORE_OFF_PAGE(s,d) GC_gcj_debug_malloc(s,d,GC_EXTRAS)
+# else
+#   define GC_GCJ_MALLOC(s,d) GC_gcj_malloc(s,d)
+#   define GC_GCJ_FAST_MALLOC(s,d) GC_gcj_fast_malloc(s,d)
+#   define GC_GCJ_MALLOC_IGNORE_OFF_PAGE(s,d) \
+	GC_gcj_debug_malloc_ignore_off_page(s,d)
+# endif
+
diff --git a/src/gc/include/gc_inl.h b/src/gc/include/gc_inl.h
new file mode 100644
index 000000000..700843bbf
--- /dev/null
+++ b/src/gc/include/gc_inl.h
@@ -0,0 +1,103 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, October 3, 1995 2:07 pm PDT */
+ 
+# ifndef GC_PRIVATE_H
+#   include "private/gc_priv.h"
+# endif
+
+/* USE OF THIS FILE IS NOT RECOMMENDED unless the collector has been	*/
+/* compiled without -DALL_INTERIOR_POINTERS or with			*/
+/* -DDONT_ADD_BYTE_AT_END, or the specified size includes a pointerfree	*/
+/* word at the end.  In the standard collector configuration,		*/
+/* the final word of each object may not be scanned.			*/
+/* This is most useful for compilers that generate C.			*/
+/* Manual use is hereby discouraged.					*/
+
+/* Allocate n words (NOT BYTES).  X is made to point to the result.	*/
+/* It is assumed that n < MAXOBJSZ, and					*/
+/* that n > 0.  On machines requiring double word alignment of some	*/
+/* data, we also assume that n is 1 or even.  This bypasses the		*/
+/* MERGE_SIZES mechanism.  In order to minimize the number of distinct	*/
+/* free lists that are maintained, the caller should ensure that a 	*/
+/* small number of distinct values of n are used.  (The MERGE_SIZES	*/
+/* mechanism normally does this by ensuring that only the leading three	*/
+/* bits of n may be nonzero.  See misc.c for details.)  We really 	*/
+/* recommend this only in cases in which n is a constant, and no	*/
+/* locking is required.							*/
+/* In that case it may allow the compiler to perform substantial	*/
+/* additional optimizations.						*/
+# define GC_MALLOC_WORDS(result,n) \
+{	\
+    register ptr_t op;	\
+    register ptr_t *opp;	\
+    DCL_LOCK_STATE;	\
+	\
+    opp = &(GC_objfreelist[n]);	\
+    FASTLOCK();	\
+    if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {	\
+        FASTUNLOCK();	\
+        (result) = GC_generic_malloc_words_small((n), NORMAL);	\
+    } else { 	\
+        *opp = obj_link(op);	\
+        obj_link(op) = 0;	\
+        GC_words_allocd += (n);	\
+        FASTUNLOCK();	\
+        (result) = (GC_PTR) op;	\
+    }	\
+}
+
+
+/* The same for atomic objects:	*/
+# define GC_MALLOC_ATOMIC_WORDS(result,n) \
+{	\
+    register ptr_t op;	\
+    register ptr_t *opp;	\
+    DCL_LOCK_STATE;	\
+	\
+    opp = &(GC_aobjfreelist[n]);	\
+    FASTLOCK();	\
+    if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {	\
+        FASTUNLOCK();	\
+        (result) = GC_generic_malloc_words_small((n), PTRFREE);	\
+    } else { 	\
+        *opp = obj_link(op);	\
+        obj_link(op) = 0;	\
+        GC_words_allocd += (n);	\
+        FASTUNLOCK();	\
+        (result) = (GC_PTR) op;	\
+    }	\
+}
+
+/* And once more for two word initialized objects: */
+# define GC_CONS(result, first, second) \
+{	\
+    register ptr_t op;	\
+    register ptr_t *opp;	\
+    DCL_LOCK_STATE;	\
+	\
+    opp = &(GC_objfreelist[2]);	\
+    FASTLOCK();	\
+    if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {	\
+        FASTUNLOCK();	\
+        op = GC_generic_malloc_words_small(2, NORMAL);	\
+    } else {	\
+        *opp = obj_link(op);	\
+        GC_words_allocd += 2;	\
+        FASTUNLOCK();	\
+    } \
+    ((word *)op)[0] = (word)(first);	\
+    ((word *)op)[1] = (word)(second);	\
+    (result) = (GC_PTR) op;	\
+}
diff --git a/src/gc/include/gc_inline.h b/src/gc/include/gc_inline.h
new file mode 100644
index 000000000..db62d1d58
--- /dev/null
+++ b/src/gc/include/gc_inline.h
@@ -0,0 +1 @@
+# include "gc_inl.h"
diff --git a/src/gc/include/gc_nursery.h b/src/gc/include/gc_nursery.h
new file mode 100755
index 000000000..d109ff090
--- /dev/null
+++ b/src/gc/include/gc_nursery.h
@@ -0,0 +1,90 @@
+
+/* 
+ * Copyright (c) 1999 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * THIS IMPLEMENTATION FOR THIS INTERFACE IS INCOMPLETE.
+ * NONE OF THIS HAS BEEN TESTED.  DO NOT USE.
+ *
+ * Comments on the interface are appreciated, especially from
+ * potential users of the interface.
+ *
+ * This is a Bartlett style copying collector for young objects.
+ * We assume for now that all objects allocated through this
+ * mechanism have pointers only in the first BITMAP_BITS words.
+ * (On a 32-bit machine, BITMAP_BITS is 30.)
+ * Objects allocated in this manner should be rarely referenced
+ * by objects not allocated either through this interface, or through
+ * the typed allocation interface.
+ * If this interface is used, we assume that type information provided
+ * through either this or the typed allocation interface is valid
+ * in a stronger sense:
+ *
+ * 1) No pointers are stored in fields not marked as such.
+ *    (Otherwise it is only necessary that objects referenced by
+ *    fields marked as nonpointers are also reachable via another
+ *    path.)
+ * 2) Values stored in pointer fields are either not addresses in
+ *    the heap, or they really are pointers.  In the latter case, it
+ *    is acceptable to move the object they refer to, and to update
+ *    the pointer.
+ *
+ * GC_free may not be invoked on objects allocated with GC_copying_malloc.
+ *
+ * No extra space is added to the end of objects allocated through this
+ * interface.  If the client needs to maintain pointers past the
+ * end, the size should be explicitly padded.
+ * 
+ * We assume that calls to this will usually be compiler generated.
+ * Hence the interface is allowed to be a bit ugly in return for speed.
+ */
+
+#include "gc_copy_descr.h"
+
+/* GC_copy_descr.h must define						*/
+/* GC_SIZE_FROM_DESCRIPTOR(descr) and					*/
+/* GC_BIT_MAP_FROM_DESCRIPTOR(descr).					*/
+/* It may either be the GC supplied version of the header file, or a	*/
+/* client specific one that derives the information from a client-	*/
+/* specific type descriptor.						*/
+
+typedef GC_PTR GC_copy_alloc_state;
+				/* Current allocator state.	*/
+				/* Multiple allocation states	*/
+				/* may be used for concurrent	*/
+				/* allocation, or to enhance	*/
+				/* locality.			*/
+				/* Should be treated as opaque.	*/
+
+/* Allocate a memory block of size given in the descriptor, and with	*/
+/* pointer layout given by the descriptor.  The resulting block may not	*/
+/* be cleared, and should immediately be initialized by the client.	*/
+/* (A concurrent GC may see an uninitialized pointer field.  If it	*/
+/* points outside the nursery, that's fine.  If it points inside, it	*/
+/* may retain an object, and be relocated.  But that's also fine, since	*/
+/* the new value will be immediately overwritten.			*/
+/* This variant acquires the allocation lock, and uses a default 	*/
+/* global allocation state.						*/
+GC_PTR GC_copying_malloc(GC_copy_descriptor);
+
+/* A variant of the above that does no locking on the fast path,	*/
+/* and passes an explicit pointer to an allocation state.		*/
+/* The allocation state is updated.					*/
+/* There will eventually need to be a macro or inline function version	*/
+/* of this.								*/
+GC_PTR GC_copying_malloc2(GC_copy_descriptor, GC_copy_alloc_state *);
+
+/* Initialize an allocation state so that it can be used for 	*/
+/* allocation.  This implicitly reserves a small section of the	*/
+/* nursery for use with this allocator.				*/
+void GC_init_copy_alloc_state(GC_copy_alloc_state *);
diff --git a/src/gc/include/gc_typed.h b/src/gc/include/gc_typed.h
new file mode 100644
index 000000000..2e0598f20
--- /dev/null
+++ b/src/gc/include/gc_typed.h
@@ -0,0 +1,93 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright 1996 Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Some simple primitives for allocation with explicit type information.
+ * Facilities for dynamic type inference may be added later.
+ * Should be used only for extremely performance critical applications,
+ * or if conservative collector leakage is otherwise a problem (unlikely).
+ * Note that this is implemented completely separately from the rest
+ * of the collector, and is not linked in unless referenced.
+ * This does not currently support GC_DEBUG in any interesting way.
+ */
+/* Boehm, May 19, 1994 2:13 pm PDT */
+
+#ifndef _GC_TYPED_H
+# define _GC_TYPED_H
+# ifndef _GC_H
+#   include "gc.h"
+# endif
+
+typedef GC_word * GC_bitmap;
+	/* The least significant bit of the first word is one if	*/
+	/* the first word in the object may be a pointer.		*/
+	
+# define GC_get_bit(bm, index) \
+		(((bm)[divWORDSZ(index)] >> modWORDSZ(index)) & 1)
+# define GC_set_bit(bm, index) \
+		(bm)[divWORDSZ(index)] |= (word)1 << modWORDSZ(index)
+
+typedef GC_word GC_descr;
+
+GC_API GC_descr GC_make_descriptor GC_PROTO((GC_bitmap bm, size_t len));
+		/* Return a type descriptor for the object whose layout	*/
+		/* is described by the argument.			*/
+		/* The least significant bit of the first word is one	*/
+		/* if the first word in the object may be a pointer.	*/
+		/* The second argument specifies the number of		*/
+		/* meaningful bits in the bitmap.  The actual object 	*/
+		/* may be larger (but not smaller).  Any additional	*/
+		/* words in the object are assumed not to contain 	*/
+		/* pointers.						*/
+		/* Returns a conservative approximation in the		*/
+		/* (unlikely) case of insufficient memory to build	*/
+		/* the descriptor.  Calls to GC_make_descriptor		*/
+		/* may consume some amount of a finite resource.  This	*/
+		/* is intended to be called once per type, not once	*/
+		/* per allocation.					*/
+
+GC_API GC_PTR GC_malloc_explicitly_typed
+			GC_PROTO((size_t size_in_bytes, GC_descr d));
+		/* Allocate an object whose layout is described by d.	*/
+		/* The resulting object MAY NOT BE PASSED TO REALLOC.	*/
+		/* The returned object is cleared.			*/
+
+GC_API GC_PTR GC_malloc_explicitly_typed_ignore_off_page
+                        GC_PROTO((size_t size_in_bytes, GC_descr d));
+		
+GC_API GC_PTR GC_calloc_explicitly_typed
+			GC_PROTO((size_t nelements,
+  				  size_t element_size_in_bytes,
+  				  GC_descr d));
+  	/* Allocate an array of nelements elements, each of the	*/
+  	/* given size, and with the given descriptor.		*/
+  	/* The elemnt size must be a multiple of the byte	*/
+  	/* alignment required for pointers.  E.g. on a 32-bit	*/
+  	/* machine with 16-bit aligned pointers, size_in_bytes	*/
+  	/* must be a multiple of 2.				*/
+	/* Returned object is cleared.				*/
+
+#ifdef GC_DEBUG
+#   define GC_MALLOC_EXPLICTLY_TYPED(bytes, d) GC_MALLOC(bytes)
+#   define GC_CALLOC_EXPLICTLY_TYPED(n, bytes, d) GC_MALLOC(n*bytes)
+#else
+#  define GC_MALLOC_EXPLICTLY_TYPED(bytes, d) \
+	GC_malloc_explicitly_typed(bytes, d)
+#  define GC_CALLOC_EXPLICTLY_TYPED(n, bytes, d) \
+	GC_calloc_explicitly_typed(n, bytes, d)
+#endif /* !GC_DEBUG */
+
+
+#endif /* _GC_TYPED_H */
+
diff --git a/src/gc/include/javaxfc.h b/src/gc/include/javaxfc.h
new file mode 100644
index 000000000..880020c53
--- /dev/null
+++ b/src/gc/include/javaxfc.h
@@ -0,0 +1,41 @@
+# ifndef GC_H
+#   include "gc.h"
+# endif
+
+/*
+ * Invoke all remaining finalizers that haven't yet been run.
+ * This is needed for strict compliance with the Java standard, 
+ * which can make the runtime guarantee that all finalizers are run.
+ * This is problematic for several reasons:
+ * 1) It means that finalizers, and all methods calle by them,
+ *    must be prepared to deal with objects that have been finalized in
+ *    spite of the fact that they are still referenced by statically
+ *    allocated pointer variables.
+ * 1) It may mean that we get stuck in an infinite loop running
+ *    finalizers which create new finalizable objects, though that's
+ *    probably unlikely.
+ * Thus this is not recommended for general use.
+ */
+void GC_finalize_all();
+
+/*
+ * A version of GC_register_finalizer that allows the object to be
+ * finalized before the objects it references.  This is again error
+ * prone, in that it makes it easy to accidentally reference finalized
+ * objects.  Again, recommended only for JVM implementors.
+ */
+void GC_register_finalizer_no_order(GC_PTR obj,
+			       GC_finalization_proc fn, GC_PTR cd,
+			       GC_finalization_proc *ofn, GC_PTR * ocd);
+
+void GC_debug_register_finalizer_no_order(GC_PTR obj,
+			       GC_finalization_proc fn, GC_PTR cd,
+			       GC_finalization_proc *ofn, GC_PTR * ocd);
+
+#ifdef GC_DEBUG
+#   define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+	GC_debug_register_finalizer_no_order(p, f, d, of, od)
+#else
+#   define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+	GC_register_finalizer_no_order(p, f, d, of, od)
+#endif
diff --git a/src/gc/include/leak_detector.h b/src/gc/include/leak_detector.h
new file mode 100644
index 000000000..6786825ab
--- /dev/null
+++ b/src/gc/include/leak_detector.h
@@ -0,0 +1,7 @@
+#define GC_DEBUG
+#include "gc.h"
+#define malloc(n) GC_MALLOC(n)
+#define calloc(m,n) GC_MALLOC(m*n)
+#define free(p) GC_FREE(p)
+#define realloc(p,n) GC_REALLOC(n)
+#define CHECK_LEAKS() GC_gcollect()
diff --git a/src/gc/include/new_gc_alloc.h b/src/gc/include/new_gc_alloc.h
new file mode 100644
index 000000000..54b7bd448
--- /dev/null
+++ b/src/gc/include/new_gc_alloc.h
@@ -0,0 +1,452 @@
+/*
+ * Copyright (c) 1996-1998 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+//
+// This is a revision of gc_alloc.h for SGI STL versions > 3.0
+// Unlike earlier versions, it supplements the standard "alloc.h"
+// instead of replacing it.
+//
+// This is sloppy about variable names used in header files.
+// It also doesn't yet understand the new header file names or
+// namespaces.
+//
+// This assumes the collector has been compiled with -DATOMIC_UNCOLLECTABLE
+// and -DALL_INTERIOR_POINTERS.  We also recommend
+// -DREDIRECT_MALLOC=GC_uncollectable_malloc.
+//
+// Some of this could be faster in the explicit deallocation case.
+// In particular, we spend too much time clearing objects on the
+// free lists.  That could be avoided.
+//
+// This uses template classes with static members, and hence does not work
+// with g++ 2.7.2 and earlier.
+//
+// Unlike its predecessor, this one simply defines
+// 	gc_alloc
+//	single_client_gc_alloc
+//	traceable_alloc
+//	single_client_traceable_alloc
+//
+// It does not redefine alloc.  Nor does it change the default allocator,
+// though the user may wish to do so.  (The argument against changing
+// the default allocator is that it may introduce subtle link compatibility
+// problems.  The argument for changing it is that the usual default
+// allocator is usually a very bad choice for a garbage collected environment.)
+//
+
+#ifndef GC_ALLOC_H
+
+#include "gc.h"
+#include <alloc.h>
+
+#define GC_ALLOC_H
+
+#include <stddef.h>
+#include <string.h>
+
+// The following need to match collector data structures.
+// We can't include gc_priv.h, since that pulls in way too much stuff.
+// This should eventually be factored out into another include file.
+
+extern "C" {
+    extern void ** const GC_objfreelist_ptr;
+    extern void ** const GC_aobjfreelist_ptr;
+    extern void ** const GC_uobjfreelist_ptr;
+    extern void ** const GC_auobjfreelist_ptr;
+
+    extern void GC_incr_words_allocd(size_t words);
+    extern void GC_incr_mem_freed(size_t words);
+
+    extern char * GC_generic_malloc_words_small(size_t word, int kind);
+}
+
+// Object kinds; must match PTRFREE, NORMAL, UNCOLLECTABLE, and
+// AUNCOLLECTABLE in gc_priv.h.
+
+enum { GC_PTRFREE = 0, GC_NORMAL = 1, GC_UNCOLLECTABLE = 2,
+       GC_AUNCOLLECTABLE = 3 };
+
+enum { GC_max_fast_bytes = 255 };
+
+enum { GC_bytes_per_word = sizeof(char *) };
+
+enum { GC_byte_alignment = 8 };
+
+enum { GC_word_alignment = GC_byte_alignment/GC_bytes_per_word };
+
+inline void * &GC_obj_link(void * p)
+{   return *(void **)p;  }
+
+// Compute a number of words >= n+1 bytes.
+// The +1 allows for pointers one past the end.
+inline size_t GC_round_up(size_t n)
+{
+    return ((n + GC_byte_alignment)/GC_byte_alignment)*GC_word_alignment;
+}
+
+// The same but don't allow for extra byte.
+inline size_t GC_round_up_uncollectable(size_t n)
+{
+    return ((n + GC_byte_alignment - 1)/GC_byte_alignment)*GC_word_alignment;
+}
+
+template <int dummy>
+class GC_aux_template {
+public:
+  // File local count of allocated words.  Occasionally this is
+  // added into the global count.  A separate count is necessary since the
+  // real one must be updated with a procedure call.
+  static size_t GC_words_recently_allocd;
+
+  // Same for uncollectable mmory.  Not yet reflected in either
+  // GC_words_recently_allocd or GC_non_gc_bytes.
+  static size_t GC_uncollectable_words_recently_allocd;
+
+  // Similar counter for explicitly deallocated memory.
+  static size_t GC_mem_recently_freed;
+
+  // Again for uncollectable memory.
+  static size_t GC_uncollectable_mem_recently_freed;
+
+  static void * GC_out_of_line_malloc(size_t nwords, int kind);
+};
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_mem_recently_freed = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_mem_recently_freed = 0;
+
+template <int dummy>
+void * GC_aux_template<dummy>::GC_out_of_line_malloc(size_t nwords, int kind)
+{
+    GC_words_recently_allocd += GC_uncollectable_words_recently_allocd;
+    GC_non_gc_bytes +=
+                GC_bytes_per_word * GC_uncollectable_words_recently_allocd;
+    GC_uncollectable_words_recently_allocd = 0;
+
+    GC_mem_recently_freed += GC_uncollectable_mem_recently_freed;
+    GC_non_gc_bytes -= 
+                GC_bytes_per_word * GC_uncollectable_mem_recently_freed;
+    GC_uncollectable_mem_recently_freed = 0;
+
+    GC_incr_words_allocd(GC_words_recently_allocd);
+    GC_words_recently_allocd = 0;
+
+    GC_incr_mem_freed(GC_mem_recently_freed);
+    GC_mem_recently_freed = 0;
+
+    return GC_generic_malloc_words_small(nwords, kind);
+}
+
+typedef GC_aux_template<0> GC_aux;
+
+// A fast, single-threaded, garbage-collected allocator
+// We assume the first word will be immediately overwritten.
+// In this version, deallocation is not a noop, and explicit
+// deallocation is likely to help performance.
+template <int dummy>
+class single_client_gc_alloc_template {
+    public:
+     	static void * allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc(n);
+	    flh = GC_objfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_NORMAL);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_words_recently_allocd += nwords;
+	    return op;
+        }
+     	static void * ptr_free_allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc_atomic(n);
+	    flh = GC_aobjfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_PTRFREE);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_words_recently_allocd += nwords;
+	    return op;
+        }
+	static void deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes)  {
+		GC_free(p);
+	    } else {
+	        flh = GC_objfreelist_ptr + nwords;
+	        GC_obj_link(p) = *flh;
+		memset((char *)p + GC_bytes_per_word, 0,
+		       GC_bytes_per_word * (nwords - 1));
+	        *flh = p;
+	        GC_aux::GC_mem_recently_freed += nwords;
+	    }
+	}
+	static void ptr_free_deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes) {
+		GC_free(p);
+	    } else {
+	    	flh = GC_aobjfreelist_ptr + nwords;
+	    	GC_obj_link(p) = *flh;
+	    	*flh = p;
+	    	GC_aux::GC_mem_recently_freed += nwords;
+	    }
+	}
+};
+
+typedef single_client_gc_alloc_template<0> single_client_gc_alloc;
+
+// Once more, for uncollectable objects.
+template <int dummy>
+class single_client_traceable_alloc_template {
+    public:
+     	static void * allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up_uncollectable(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc_uncollectable(n);
+	    flh = GC_uobjfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_UNCOLLECTABLE);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+	    return op;
+        }
+     	static void * ptr_free_allocate(size_t n)
+        {
+	    size_t nwords = GC_round_up_uncollectable(n);
+	    void ** flh;
+	    void * op;
+
+  	    if (n > GC_max_fast_bytes) return GC_malloc_atomic_uncollectable(n);
+	    flh = GC_auobjfreelist_ptr + nwords;
+	    if (0 == (op = *flh)) {
+		return GC_aux::GC_out_of_line_malloc(nwords, GC_AUNCOLLECTABLE);
+	    }
+	    *flh = GC_obj_link(op);
+	    GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+	    return op;
+        }
+	static void deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up_uncollectable(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes)  {
+		GC_free(p);
+	    } else {
+	        flh = GC_uobjfreelist_ptr + nwords;
+	        GC_obj_link(p) = *flh;
+	        *flh = p;
+	        GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+	    }
+	}
+	static void ptr_free_deallocate(void *p, size_t n)
+	{
+            size_t nwords = GC_round_up_uncollectable(n);
+            void ** flh;
+	   
+	    if (n > GC_max_fast_bytes) {
+		GC_free(p);
+	    } else {
+	    	flh = GC_auobjfreelist_ptr + nwords;
+	    	GC_obj_link(p) = *flh;
+	    	*flh = p;
+	    	GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+	    }
+	}
+};
+
+typedef single_client_traceable_alloc_template<0> single_client_traceable_alloc;
+
+template < int dummy >
+class gc_alloc_template {
+    public:
+     	static void * allocate(size_t n) { return GC_malloc(n); }
+     	static void * ptr_free_allocate(size_t n)
+		{ return GC_malloc_atomic(n); }
+	static void deallocate(void *, size_t) { }
+	static void ptr_free_deallocate(void *, size_t) { }
+};
+
+typedef gc_alloc_template < 0 > gc_alloc;
+
+template < int dummy >
+class traceable_alloc_template {
+    public:
+     	static void * allocate(size_t n) { return GC_malloc_uncollectable(n); }
+     	static void * ptr_free_allocate(size_t n)
+		{ return GC_malloc_atomic_uncollectable(n); }
+	static void deallocate(void *p, size_t) { GC_free(p); }
+	static void ptr_free_deallocate(void *p, size_t) { GC_free(p); }
+};
+
+typedef traceable_alloc_template < 0 > traceable_alloc;
+
+// We want to specialize simple_alloc so that it does the right thing
+// for all pointerfree types.  At the moment there is no portable way to
+// even approximate that.  The following approximation should work for
+// SGI compilers, and recent versions of g++.
+
+# define __GC_SPECIALIZE(T,alloc) \
+class simple_alloc<T, alloc> { \
+public: \
+    static T *allocate(size_t n) \
+	{ return 0 == n? 0 : \
+			 (T*) alloc::ptr_free_allocate(n * sizeof (T)); } \
+    static T *allocate(void) \
+	{ return (T*) alloc::ptr_free_allocate(sizeof (T)); } \
+    static void deallocate(T *p, size_t n) \
+	{ if (0 != n) alloc::ptr_free_deallocate(p, n * sizeof (T)); } \
+    static void deallocate(T *p) \
+	{ alloc::ptr_free_deallocate(p, sizeof (T)); } \
+};
+
+__GC_SPECIALIZE(char, gc_alloc)
+__GC_SPECIALIZE(int, gc_alloc)
+__GC_SPECIALIZE(unsigned, gc_alloc)
+__GC_SPECIALIZE(float, gc_alloc)
+__GC_SPECIALIZE(double, gc_alloc)
+
+__GC_SPECIALIZE(char, traceable_alloc)
+__GC_SPECIALIZE(int, traceable_alloc)
+__GC_SPECIALIZE(unsigned, traceable_alloc)
+__GC_SPECIALIZE(float, traceable_alloc)
+__GC_SPECIALIZE(double, traceable_alloc)
+
+__GC_SPECIALIZE(char, single_client_gc_alloc)
+__GC_SPECIALIZE(int, single_client_gc_alloc)
+__GC_SPECIALIZE(unsigned, single_client_gc_alloc)
+__GC_SPECIALIZE(float, single_client_gc_alloc)
+__GC_SPECIALIZE(double, single_client_gc_alloc)
+
+__GC_SPECIALIZE(char, single_client_traceable_alloc)
+__GC_SPECIALIZE(int, single_client_traceable_alloc)
+__GC_SPECIALIZE(unsigned, single_client_traceable_alloc)
+__GC_SPECIALIZE(float, single_client_traceable_alloc)
+__GC_SPECIALIZE(double, single_client_traceable_alloc)
+
+#ifdef __STL_USE_STD_ALLOCATORS
+
+__STL_BEGIN_NAMESPACE
+
+template <class _T>
+struct _Alloc_traits<_T, gc_alloc >
+{
+  static const bool _S_instanceless = true;
+  typedef simple_alloc<_T, gc_alloc > _Alloc_type;
+  typedef __allocator<_T, gc_alloc > allocator_type;
+};
+
+inline bool operator==(const gc_alloc&,
+                       const gc_alloc&)
+{
+  return true;
+}
+
+inline bool operator!=(const gc_alloc&,
+                       const gc_alloc&)
+{
+  return false;
+}
+
+template <class _T>
+struct _Alloc_traits<_T, single_client_gc_alloc >
+{
+  static const bool _S_instanceless = true;
+  typedef simple_alloc<_T, single_client_gc_alloc > _Alloc_type;
+  typedef __allocator<_T, single_client_gc_alloc > allocator_type;
+};
+
+inline bool operator==(const single_client_gc_alloc&,
+                       const single_client_gc_alloc&)
+{
+  return true;
+}
+
+inline bool operator!=(const single_client_gc_alloc&,
+                       const single_client_gc_alloc&)
+{
+  return false;
+}
+
+template <class _T>
+struct _Alloc_traits<_T, traceable_alloc >
+{
+  static const bool _S_instanceless = true;
+  typedef simple_alloc<_T, traceable_alloc > _Alloc_type;
+  typedef __allocator<_T, traceable_alloc > allocator_type;
+};
+
+inline bool operator==(const traceable_alloc&,
+                       const traceable_alloc&)
+{
+  return true;
+}
+
+inline bool operator!=(const traceable_alloc&,
+                       const traceable_alloc&)
+{
+  return false;
+}
+
+template <class _T>
+struct _Alloc_traits<_T, single_client_traceable_alloc >
+{
+  static const bool _S_instanceless = true;
+  typedef simple_alloc<_T, single_client_traceable_alloc > _Alloc_type;
+  typedef __allocator<_T, single_client_traceable_alloc > allocator_type;
+};
+
+inline bool operator==(const single_client_traceable_alloc&,
+                       const single_client_traceable_alloc&)
+{
+  return true;
+}
+
+inline bool operator!=(const single_client_traceable_alloc&,
+                       const single_client_traceable_alloc&)
+{
+  return false;
+}
+
+__STL_END_NAMESPACE
+
+#endif /* __STL_USE_STD_ALLOCATORS */
+
+#endif /* GC_ALLOC_H */
diff --git a/src/gc/include/private/cord_pos.h b/src/gc/include/private/cord_pos.h
new file mode 100644
index 000000000..d2b24bb8a
--- /dev/null
+++ b/src/gc/include/private/cord_pos.h
@@ -0,0 +1,118 @@
+/* 
+ * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, May 19, 1994 2:23 pm PDT */
+# ifndef CORD_POSITION_H
+
+/* The representation of CORD_position.  This is private to the	*/
+/* implementation, but the size is known to clients.  Also	*/
+/* the implementation of some exported macros relies on it.	*/
+/* Don't use anything defined here and not in cord.h.		*/
+
+# define MAX_DEPTH 48
+	/* The maximum depth of a balanced cord + 1.		*/
+	/* We don't let cords get deeper than MAX_DEPTH.	*/
+
+struct CORD_pe {
+    CORD pe_cord;
+    size_t pe_start_pos;
+};
+
+/* A structure describing an entry on the path from the root 	*/
+/* to current position.						*/
+typedef struct CORD_Pos {
+    size_t cur_pos;
+    int path_len;
+#	define CORD_POS_INVALID (0x55555555)
+		/* path_len == INVALID <==> position invalid */
+    const char *cur_leaf;	/* Current leaf, if it is a string.	*/
+    				/* If the current leaf is a function,	*/
+    				/* then this may point to function_buf	*/
+    				/* containing the next few characters.	*/
+    				/* Always points to a valid string	*/
+    				/* containing the current character 	*/
+    				/* unless cur_end is 0.			*/
+    size_t cur_start;	/* Start position of cur_leaf	*/
+    size_t cur_end;	/* Ending position of cur_leaf	*/
+    			/* 0 if cur_leaf is invalid.	*/
+    struct CORD_pe path[MAX_DEPTH + 1];
+    	/* path[path_len] is the leaf corresponding to cur_pos	*/
+    	/* path[0].pe_cord is the cord we point to.		*/
+#   define FUNCTION_BUF_SZ 8
+    char function_buf[FUNCTION_BUF_SZ];	/* Space for next few chars	*/
+    					/* from function node.		*/
+} CORD_pos[1];
+
+/* Extract the cord from a position:	*/
+CORD CORD_pos_to_cord(CORD_pos p);
+	
+/* Extract the current index from a position:	*/
+size_t CORD_pos_to_index(CORD_pos p);
+	
+/* Fetch the character located at the given position:	*/
+char CORD_pos_fetch(CORD_pos p);
+	
+/* Initialize the position to refer to the give cord and index.	*/
+/* Note that this is the most expensive function on positions:	*/
+void CORD_set_pos(CORD_pos p, CORD x, size_t i);
+	
+/* Advance the position to the next character.	*/
+/* P must be initialized and valid.		*/
+/* Invalidates p if past end:			*/
+void CORD_next(CORD_pos p);
+
+/* Move the position to the preceding character.	*/
+/* P must be initialized and valid.			*/
+/* Invalidates p if past beginning:			*/
+void CORD_prev(CORD_pos p);
+	
+/* Is the position valid, i.e. inside the cord?		*/
+int CORD_pos_valid(CORD_pos p);
+
+char CORD__pos_fetch(CORD_pos);
+void CORD__next(CORD_pos);
+void CORD__prev(CORD_pos);
+
+#define CORD_pos_fetch(p)	\
+    (((p)[0].cur_end != 0)? \
+     	(p)[0].cur_leaf[(p)[0].cur_pos - (p)[0].cur_start] \
+     	: CORD__pos_fetch(p))
+
+#define CORD_next(p)	\
+    (((p)[0].cur_pos + 1 < (p)[0].cur_end)? \
+    	(p)[0].cur_pos++ \
+    	: (CORD__next(p), 0))
+
+#define CORD_prev(p)	\
+    (((p)[0].cur_end != 0 && (p)[0].cur_pos > (p)[0].cur_start)? \
+    	(p)[0].cur_pos-- \
+    	: (CORD__prev(p), 0))
+
+#define CORD_pos_to_index(p) ((p)[0].cur_pos)
+
+#define CORD_pos_to_cord(p) ((p)[0].path[0].pe_cord)
+
+#define CORD_pos_valid(p) ((p)[0].path_len != CORD_POS_INVALID)
+
+/* Some grubby stuff for performance-critical friends:	*/
+#define CORD_pos_chars_left(p) ((long)((p)[0].cur_end) - (long)((p)[0].cur_pos))
+	/* Number of characters in cache.  <= 0 ==> none	*/
+
+#define CORD_pos_advance(p,n) ((p)[0].cur_pos += (n) - 1, CORD_next(p))
+	/* Advance position by n characters	*/
+	/* 0 < n < CORD_pos_chars_left(p)	*/
+
+#define CORD_pos_cur_char_addr(p) \
+	(p)[0].cur_leaf + ((p)[0].cur_pos - (p)[0].cur_start)
+	/* address of current character in cache.	*/
+
+#endif
diff --git a/src/gc/include/private/gc_hdrs.h b/src/gc/include/private/gc_hdrs.h
new file mode 100644
index 000000000..6966a9a1a
--- /dev/null
+++ b/src/gc/include/private/gc_hdrs.h
@@ -0,0 +1,303 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, July 11, 1995 11:54 am PDT */
+# ifndef GC_HEADERS_H
+# define GC_HEADERS_H
+typedef struct hblkhdr hdr;
+
+# if CPP_WORDSZ != 32 && CPP_WORDSZ < 36
+	--> Get a real machine.
+# endif
+
+/*
+ * The 2 level tree data structure that is used to find block headers.
+ * If there are more than 32 bits in a pointer, the top level is a hash
+ * table.
+ *
+ * This defines HDR, GET_HDR, and SET_HDR, the main macros used to
+ * retrieve and set object headers.  We also define some variants to
+ * retrieve 2 unrelated headers in interleaved fashion.  This
+ * slightly improves scheduling.
+ *
+ * Since 5.0 alpha 5, we can also take advantage of a header lookup
+ * cache.  This is a locally declared direct mapped cache, used inside
+ * the marker.  The HC_GET_HDR and HC_GET_HDR2 macros use and maintain this
+ * cache.  Assuming we get reasonable hit rates, this shaves a few
+ * memory references from each pointer validation.
+ */
+
+# if CPP_WORDSZ > 32
+#   define HASH_TL
+# endif
+
+/* Define appropriate out-degrees for each of the two tree levels	*/
+# ifdef SMALL_CONFIG
+#   define LOG_BOTTOM_SZ 11
+	/* Keep top index size reasonable with smaller blocks. */
+# else
+#   define LOG_BOTTOM_SZ 10
+# endif
+# ifndef HASH_TL
+#   define LOG_TOP_SZ (WORDSZ - LOG_BOTTOM_SZ - LOG_HBLKSIZE)
+# else
+#   define LOG_TOP_SZ 11
+# endif
+# define TOP_SZ (1 << LOG_TOP_SZ)
+# define BOTTOM_SZ (1 << LOG_BOTTOM_SZ)
+
+#ifndef SMALL_CONFIG
+# define USE_HDR_CACHE
+#endif
+
+/* #define COUNT_HDR_CACHE_HITS  */
+
+extern hdr * GC_invalid_header; /* header for an imaginary block 	*/
+				/* containing no objects.		*/
+
+
+/* Check whether p and corresponding hhdr point to long or invalid	*/
+/* object.  If so, advance them	to					*/
+/* beginning of	block, or set hhdr to GC_invalid_header.		*/
+#define ADVANCE(p, hhdr, source) \
+            if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) { \
+              p = GC_FIND_START(p, hhdr, (word)source); \
+              if (p == 0) { \
+		hhdr = GC_invalid_header; \
+	      } else { \
+                hhdr = GC_find_header(p); \
+	      } \
+    	    }
+
+#ifdef USE_HDR_CACHE
+
+# ifdef COUNT_HDR_CACHE_HITS
+    extern word GC_hdr_cache_hits;
+    extern word GC_hdr_cache_misses;
+#   define HC_HIT() ++GC_hdr_cache_hits
+#   define HC_MISS() ++GC_hdr_cache_misses
+# else
+#   define HC_HIT()
+#   define HC_MISS()
+# endif
+
+  typedef struct hce {
+    word block_addr;  	/* right shifted by LOG_HBLKSIZE */
+    hdr * hce_hdr;
+  } hdr_cache_entry;
+
+# define HDR_CACHE_SIZE 8  /* power of 2 */
+
+# define DECLARE_HDR_CACHE \
+	hdr_cache_entry hdr_cache[HDR_CACHE_SIZE]
+
+# define INIT_HDR_CACHE BZERO(hdr_cache, sizeof(hdr_cache));
+
+# define HCE(h) hdr_cache + (((word)(h) >> LOG_HBLKSIZE) & (HDR_CACHE_SIZE-1))
+
+# define HCE_VALID_FOR(hce,h) ((hce) -> block_addr == \
+				((word)(h) >> LOG_HBLKSIZE))
+
+# define HCE_HDR(h) ((hce) -> hce_hdr)
+
+
+/* Analogous to GET_HDR, except that in the case of large objects, it	*/
+/* Returns the header for the object beginning, and updates p.		*/
+/* Returns &GC_bad_header instead of 0.  All of this saves a branch	*/
+/* in the fast path.							*/
+# define HC_GET_HDR(p, hhdr, source) \
+	{ \
+	  hdr_cache_entry * hce = HCE(p); \
+	  if (HCE_VALID_FOR(hce, p)) { \
+	    HC_HIT(); \
+	    hhdr = hce -> hce_hdr; \
+	  } else { \
+	    HC_MISS(); \
+	    GET_HDR(p, hhdr); \
+	    ADVANCE(p, hhdr, source); \
+	    hce -> block_addr = (word)(p) >> LOG_HBLKSIZE; \
+	    hce -> hce_hdr = hhdr; \
+	  } \
+	}
+
+# define HC_GET_HDR2(p1, hhdr1, source1, p2, hhdr2, source2) \
+	{ \
+	  hdr_cache_entry * hce1 = HCE(p1); \
+	  hdr_cache_entry * hce2 = HCE(p2); \
+	  if (HCE_VALID_FOR(hce1, p1)) { \
+	    HC_HIT(); \
+	    hhdr1 = hce1 -> hce_hdr; \
+	  } else { \
+	    HC_MISS(); \
+	    GET_HDR(p1, hhdr1); \
+	    ADVANCE(p1, hhdr1, source1); \
+	    hce1 -> block_addr = (word)(p1) >> LOG_HBLKSIZE; \
+	    hce1 -> hce_hdr = hhdr1; \
+	  } \
+	  if (HCE_VALID_FOR(hce2, p2)) { \
+	    HC_HIT(); \
+	    hhdr2 = hce2 -> hce_hdr; \
+	  } else { \
+	    HC_MISS(); \
+	    GET_HDR(p2, hhdr2); \
+	    ADVANCE(p2, hhdr2, source2); \
+	    hce2 -> block_addr = (word)(p2) >> LOG_HBLKSIZE; \
+	    hce2 -> hce_hdr = hhdr2; \
+	  } \
+	}
+
+#else /* !USE_HDR_CACHE */
+
+# define DECLARE_HDR_CACHE
+
+# define INIT_HDR_CACHE
+
+# define HC_GET_HDR(p, hhdr, source) \
+	{ \
+	  GET_HDR(p, hhdr); \
+	  ADVANCE(p, hhdr, source); \
+	}
+
+# define HC_GET_HDR2(p1, hhdr1, source1, p2, hhdr2, source2) \
+	{ \
+	  GET_HDR2(p1, hhdr1, p2, hhdr2); \
+	  ADVANCE(p1, hhdr1, source1); \
+	  ADVANCE(p2, hhdr2, source2); \
+	}
+
+#endif
+
+typedef struct bi {
+    hdr * index[BOTTOM_SZ];
+	/*
+ 	 * The bottom level index contains one of three kinds of values:
+	 * 0 means we're not responsible for this block,
+	 *   or this is a block other than the first one in a free block.
+	 * 1 < (long)X <= MAX_JUMP means the block starts at least
+	 *        X * HBLKSIZE bytes before the current address.
+	 * A valid pointer points to a hdr structure. (The above can't be
+	 * valid pointers due to the GET_MEM return convention.)
+	 */
+    struct bi * asc_link;	/* All indices are linked in	*/
+    				/* ascending order...		*/
+    struct bi * desc_link;	/* ... and in descending order.	*/
+    word key;			/* high order address bits.	*/
+# ifdef HASH_TL
+    struct bi * hash_link;	/* Hash chain link.		*/
+# endif
+} bottom_index;
+
+/* extern bottom_index GC_all_nils; - really part of GC_arrays */
+
+/* extern bottom_index * GC_top_index []; - really part of GC_arrays */
+				/* Each entry points to a bottom_index.	*/
+				/* On a 32 bit machine, it points to 	*/
+				/* the index for a set of high order	*/
+				/* bits equal to the index.  For longer	*/
+				/* addresses, we hash the high order	*/
+				/* bits to compute the index in 	*/
+				/* GC_top_index, and each entry points	*/
+				/* to a hash chain.			*/
+				/* The last entry in each chain is	*/
+				/* GC_all_nils.				*/
+
+
+# define MAX_JUMP (HBLKSIZE - 1)
+
+# define HDR_FROM_BI(bi, p) \
+		((bi)->index[((word)(p) >> LOG_HBLKSIZE) & (BOTTOM_SZ - 1)])
+# ifndef HASH_TL
+#   define BI(p) (GC_top_index \
+		[(word)(p) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE)])
+#   define HDR_INNER(p) HDR_FROM_BI(BI(p),p)
+#   ifdef SMALL_CONFIG
+#	define HDR(p) GC_find_header((ptr_t)(p))
+#   else
+#	define HDR(p) HDR_INNER(p)
+#   endif
+#   define GET_BI(p, bottom_indx) (bottom_indx) = BI(p)
+#   define GET_HDR(p, hhdr) (hhdr) = HDR(p)
+#   define SET_HDR(p, hhdr) HDR_INNER(p) = (hhdr)
+#   define GET_HDR_ADDR(p, ha) (ha) = &(HDR_INNER(p))
+#   define GET_HDR2(p1, hhdr1, p2, hhdr2) \
+	{ GET_HDR(p1, hhdr1); GET_HDR(p2, hhdr2); }
+# else /* hash */
+/*  Hash function for tree top level */
+#   define TL_HASH(hi) ((hi) & (TOP_SZ - 1))
+/*  Set bottom_indx to point to the bottom index for address p */
+#   define GET_BI(p, bottom_indx) \
+	{ \
+	    register word hi = \
+	        (word)(p) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE); \
+	    register bottom_index * _bi = GC_top_index[TL_HASH(hi)]; \
+	    \
+	    while (_bi -> key != hi && _bi != GC_all_nils) \
+	    	_bi = _bi -> hash_link; \
+	    (bottom_indx) = _bi; \
+	}
+#   define GET_HDR_ADDR(p, ha) \
+	{ \
+	    register bottom_index * bi; \
+	    \
+	    GET_BI(p, bi);	\
+	    (ha) = &(HDR_FROM_BI(bi, p)); \
+	}
+#   define GET_HDR(p, hhdr) { register hdr ** _ha; GET_HDR_ADDR(p, _ha); \
+			      (hhdr) = *_ha; }
+#   define SET_HDR(p, hhdr) { register hdr ** _ha; GET_HDR_ADDR(p, _ha); \
+			      *_ha = (hhdr); }
+#   define HDR(p) GC_find_header((ptr_t)(p))
+    /* And some interleaved versions for two pointers at once.  	*/
+    /* This hopefully helps scheduling on processors like IA64.		*/
+#   define GET_BI2(p1, bottom_indx1, p2, bottom_indx2) \
+	{ \
+	    register word hi1 = \
+	        (word)(p1) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE); \
+	    register word hi2 = \
+	        (word)(p2) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE); \
+	    register bottom_index * _bi1 = GC_top_index[TL_HASH(hi1)]; \
+	    register bottom_index * _bi2 = GC_top_index[TL_HASH(hi2)]; \
+	    \
+	    while (_bi1 -> key != hi1 && _bi1 != GC_all_nils) \
+	    	_bi1 = _bi1 -> hash_link; \
+	    while (_bi2 -> key != hi2 && _bi2 != GC_all_nils) \
+	    	_bi2 = _bi2 -> hash_link; \
+	    (bottom_indx1) = _bi1; \
+	    (bottom_indx2) = _bi2; \
+	}
+#   define GET_HDR_ADDR2(p1, ha1, p2, ha2) \
+	{ \
+	    register bottom_index * bi1; \
+	    register bottom_index * bi2; \
+	    \
+	    GET_BI2(p1, bi1, p2, bi2);	\
+	    (ha1) = &(HDR_FROM_BI(bi1, p1)); \
+	    (ha2) = &(HDR_FROM_BI(bi2, p2)); \
+	}
+#   define GET_HDR2(p1, hhdr1, p2, hhdr2) \
+	{ register hdr ** _ha1;  \
+	  register hdr ** _ha2;  \
+	  GET_HDR_ADDR2(p1, _ha1, p2, _ha2); \
+	  (hhdr1) = *_ha1;  \
+	  (hhdr2) = *_ha2;  \
+	}
+# endif
+			    
+/* Is the result a forwarding address to someplace closer to the	*/
+/* beginning of the block or NIL?					*/
+# define IS_FORWARDING_ADDR_OR_NIL(hhdr) ((unsigned long) (hhdr) <= MAX_JUMP)
+
+/* Get an HBLKSIZE aligned address closer to the beginning of the block */
+/* h.  Assumes hhdr == HDR(h) and IS_FORWARDING_ADDR(hhdr).		*/
+# define FORWARDED_ADDR(h, hhdr) ((struct hblk *)(h) - (unsigned long)(hhdr))
+# endif /*  GC_HEADERS_H */
diff --git a/src/gc/include/private/gc_priv.h b/src/gc/include/private/gc_priv.h
new file mode 100644
index 000000000..ce6858755
--- /dev/null
+++ b/src/gc/include/private/gc_priv.h
@@ -0,0 +1,1884 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, February 16, 1996 2:30 pm PST */
+ 
+
+# ifndef GC_PRIVATE_H
+# define GC_PRIVATE_H
+
+#if defined(mips) && defined(SYSTYPE_BSD) && defined(sony_news)
+    /* sony RISC NEWS, NEWSOS 4 */
+#   define BSD_TIME
+/*    typedef long ptrdiff_t;   -- necessary on some really old systems	*/
+#endif
+
+#if defined(mips) && defined(SYSTYPE_BSD43)
+    /* MIPS RISCOS 4 */
+#   define BSD_TIME
+#endif
+
+#ifdef BSD_TIME
+#   include <sys/types.h>
+#   include <sys/time.h>
+#   include <sys/resource.h>
+#endif /* BSD_TIME */
+
+# ifndef GC_H
+#   include "gc.h"
+# endif
+
+typedef GC_word word;
+typedef GC_signed_word signed_word;
+
+# ifndef GCCONFIG_H
+#   include "gcconfig.h"
+# endif
+
+# ifndef HEADERS_H
+#   include "gc_hdrs.h"
+# endif
+
+typedef int GC_bool;
+# define TRUE 1
+# define FALSE 0
+
+typedef char * ptr_t;	/* A generic pointer to which we can add	*/
+			/* byte displacements.				*/
+			/* Preferably identical to caddr_t, if it 	*/
+			/* exists.					*/
+			
+#if defined(__STDC__)
+#   include <stdlib.h>
+#   if !(defined( sony_news ) )
+#       include <stddef.h>
+#   endif
+#   define VOLATILE volatile
+#else
+#   ifdef MSWIN32
+#   	include <stdlib.h>
+#   endif
+#   define VOLATILE
+#endif
+
+#define CONST GC_CONST
+
+#if 0 /* was once defined for AMIGA */
+#   define GC_FAR __far
+#else
+#   define GC_FAR
+#endif
+
+
+/*********************************/
+/*                               */
+/* Definitions for conservative  */
+/* collector                     */
+/*                               */
+/*********************************/
+
+/*********************************/
+/*                               */
+/* Easily changeable parameters  */
+/*                               */
+/*********************************/
+
+#define STUBBORN_ALLOC	/* Define stubborn allocation primitives	*/
+#if defined(SRC_M3) || defined(SMALL_CONFIG)
+# undef STUBBORN_ALLOC
+#endif
+
+
+/* #define ALL_INTERIOR_POINTERS */
+		    /* Forces all pointers into the interior of an 	*/
+		    /* object to be considered valid.  Also causes the	*/
+		    /* sizes of all objects to be inflated by at least 	*/
+		    /* one byte.  This should suffice to guarantee	*/
+		    /* that in the presence of a compiler that does	*/
+		    /* not perform garbage-collector-unsafe		*/
+		    /* optimizations, all portable, strictly ANSI	*/
+		    /* conforming C programs should be safely usable	*/
+		    /* with malloc replaced by GC_malloc and free	*/
+		    /* calls removed.  There are several disadvantages: */
+		    /* 1. There are probably no interesting, portable,	*/
+		    /*    strictly ANSI	conforming C programs.		*/
+		    /* 2. This option makes it hard for the collector	*/
+		    /*    to allocate space that is not ``pointed to''  */
+		    /*    by integers, etc.  Under SunOS 4.X with a 	*/
+		    /*    statically linked libc, we empiricaly		*/
+		    /*    observed that it would be difficult to 	*/
+		    /*	  allocate individual objects larger than 100K.	*/
+		    /* 	  Even if only smaller objects are allocated,	*/
+		    /*    more swap space is likely to be needed.       */
+		    /*    Fortunately, much of this will never be	*/
+		    /*    touched.					*/
+		    /* If you can easily avoid using this option, do.	*/
+		    /* If not, try to keep individual objects small.	*/
+		    
+#define PRINTSTATS  /* Print garbage collection statistics          	*/
+		    /* For less verbose output, undefine in reclaim.c 	*/
+
+#define PRINTTIMES  /* Print the amount of time consumed by each garbage   */
+		    /* collection.                                         */
+
+#define PRINTBLOCKS /* Print object sizes associated with heap blocks,     */
+		    /* whether the objects are atomic or composite, and    */
+		    /* whether or not the block was found to be empty      */
+		    /* during the reclaim phase.  Typically generates       */
+		    /* about one screenful per garbage collection.         */
+#undef PRINTBLOCKS
+
+#ifdef SILENT
+#  ifdef PRINTSTATS
+#    undef PRINTSTATS
+#  endif
+#  ifdef PRINTTIMES
+#    undef PRINTTIMES
+#  endif
+#  ifdef PRINTNBLOCKS
+#    undef PRINTNBLOCKS
+#  endif
+#endif
+
+#if defined(PRINTSTATS) && !defined(GATHERSTATS)
+#   define GATHERSTATS
+#endif
+
+#ifdef FINALIZE_ON_DEMAND
+#   define GC_INVOKE_FINALIZERS()
+#else
+#   define GC_INVOKE_FINALIZERS() (void)GC_invoke_finalizers()
+#endif
+
+#define MERGE_SIZES /* Round up some object sizes, so that fewer distinct */
+		    /* free lists are actually maintained.  This applies  */
+		    /* only to the top level routines in misc.c, not to   */
+		    /* user generated code that calls GC_allocobj and     */
+		    /* GC_allocaobj directly.                             */
+		    /* Slows down average programs slightly.  May however */
+		    /* substantially reduce fragmentation if allocation   */
+		    /* request sizes are widely scattered.                */
+		    /* May save significant amounts of space for obj_map  */
+		    /* entries.						  */
+
+/* ALIGN_DOUBLE requires MERGE_SIZES at present. */
+# if defined(ALIGN_DOUBLE) && !defined(MERGE_SIZES)
+#   define MERGE_SIZES
+# endif
+
+#if defined(ALL_INTERIOR_POINTERS) && !defined(DONT_ADD_BYTE_AT_END)
+# define ADD_BYTE_AT_END
+#endif
+
+
+# ifndef LARGE_CONFIG
+#   define MINHINCR 16	/* Minimum heap increment, in blocks of HBLKSIZE  */
+			/* Must be multiple of largest page size.	  */
+#   define MAXHINCR 512	/* Maximum heap increment, in blocks              */
+# else
+#   define MINHINCR 64
+#   define MAXHINCR 4096
+# endif
+
+# define TIME_LIMIT 50	   /* We try to keep pause times from exceeding	 */
+			   /* this by much. In milliseconds.		 */
+
+# define BL_LIMIT GC_black_list_spacing
+			   /* If we need a block of N bytes, and we have */
+			   /* a block of N + BL_LIMIT bytes available, 	 */
+			   /* and N > BL_LIMIT,				 */
+			   /* but all possible positions in it are 	 */
+			   /* blacklisted, we just use it anyway (and	 */
+			   /* print a warning, if warnings are enabled). */
+			   /* This risks subsequently leaking the block	 */
+			   /* due to a false reference.  But not using	 */
+			   /* the block risks unreasonable immediate	 */
+			   /* heap growth.				 */
+
+/*********************************/
+/*                               */
+/* Stack saving for debugging	 */
+/*                               */
+/*********************************/
+
+#ifdef SAVE_CALL_CHAIN
+
+/*
+ * Number of frames and arguments to save in objects allocated by
+ * debugging allocator.
+ */
+#   define NFRAMES 6	/* Number of frames to save. Even for		*/
+			/* alignment reasons.				*/
+#   define NARGS 2	/* Mumber of arguments to save for each call.	*/
+
+#   define NEED_CALLINFO
+
+/* Fill in the pc and argument information for up to NFRAMES of my	*/
+/* callers.  Ignore my frame and my callers frame.			*/
+void GC_save_callers (/* struct callinfo info[NFRAMES] */);
+
+void GC_print_callers (/* struct callinfo info[NFRAMES] */);
+
+#else
+
+# ifdef GC_ADD_CALLER
+#   define NFRAMES 1
+#   define NARGS 0
+#   define NEED_CALLINFO
+# endif
+
+#endif
+
+#ifdef NEED_CALLINFO
+    struct callinfo {
+	word ci_pc;
+#	if NARGS > 0
+	    word ci_arg[NARGS];	/* bit-wise complement to avoid retention */
+#	endif
+#	if defined(ALIGN_DOUBLE) && (NFRAMES * (NARGS + 1)) % 2 == 1
+	    /* Likely alignment problem. */
+	    word ci_dummy;
+#	endif
+    };
+#endif
+
+
+/*********************************/
+/*                               */
+/* OS interface routines	 */
+/*                               */
+/*********************************/
+
+#ifdef BSD_TIME
+#   undef CLOCK_TYPE
+#   undef GET_TIME
+#   undef MS_TIME_DIFF
+#   define CLOCK_TYPE struct timeval
+#   define GET_TIME(x) { struct rusage rusage; \
+			 getrusage (RUSAGE_SELF,  &rusage); \
+			 x = rusage.ru_utime; }
+#   define MS_TIME_DIFF(a,b) ((double) (a.tv_sec - b.tv_sec) * 1000.0 \
+                               + (double) (a.tv_usec - b.tv_usec) / 1000.0)
+#else /* !BSD_TIME */
+# ifdef MSWIN32
+#   include <windows.h>
+#   include <winbase.h>
+#   define CLOCK_TYPE DWORD
+#   define GET_TIME(x) x = GetTickCount()
+#   define MS_TIME_DIFF(a,b) ((long)((a)-(b)))
+# else /* !MSWIN32, !BSD_TIME */
+#   include <time.h>
+#   if !defined(__STDC__) && defined(SPARC) && defined(SUNOS4)
+      clock_t clock();	/* Not in time.h, where it belongs	*/
+#   endif
+#   if defined(FREEBSD) && !defined(CLOCKS_PER_SEC)
+#     include <machine/limits.h>
+#     define CLOCKS_PER_SEC CLK_TCK
+#   endif
+#   if !defined(CLOCKS_PER_SEC)
+#     define CLOCKS_PER_SEC 1000000
+/*
+ * This is technically a bug in the implementation.  ANSI requires that
+ * CLOCKS_PER_SEC be defined.  But at least under SunOS4.1.1, it isn't.
+ * Also note that the combination of ANSI C and POSIX is incredibly gross
+ * here. The type clock_t is used by both clock() and times().  But on
+ * some machines these use different notions of a clock tick,  CLOCKS_PER_SEC
+ * seems to apply only to clock.  Hence we use it here.  On many machines,
+ * including SunOS, clock actually uses units of microseconds (which are
+ * not really clock ticks).
+ */
+#   endif
+#   define CLOCK_TYPE clock_t
+#   define GET_TIME(x) x = clock()
+#   define MS_TIME_DIFF(a,b) ((unsigned long) \
+		(1000.0*(double)((a)-(b))/(double)CLOCKS_PER_SEC))
+# endif /* !MSWIN32 */
+#endif /* !BSD_TIME */
+
+/* We use bzero and bcopy internally.  They may not be available.	*/
+# if defined(SPARC) && defined(SUNOS4)
+#   define BCOPY_EXISTS
+# endif
+# if defined(M68K) && defined(AMIGA)
+#   define BCOPY_EXISTS
+# endif
+# if defined(M68K) && defined(NEXT)
+#   define BCOPY_EXISTS
+# endif
+# if defined(VAX)
+#   define BCOPY_EXISTS
+# endif
+# if defined(AMIGA)
+#   include <string.h>
+#   define BCOPY_EXISTS
+# endif
+
+# ifndef BCOPY_EXISTS
+#   include <string.h>
+#   define BCOPY(x,y,n) memcpy(y, x, (size_t)(n))
+#   define BZERO(x,n)  memset(x, 0, (size_t)(n))
+# else
+#   define BCOPY(x,y,n) bcopy((char *)(x),(char *)(y),(int)(n))
+#   define BZERO(x,n) bzero((char *)(x),(int)(n))
+# endif
+
+/* HBLKSIZE aligned allocation.  0 is taken to mean failure 	*/
+/* space is assumed to be cleared.				*/
+/* In the case os USE_MMAP, the argument must also be a 	*/
+/* physical page size.						*/
+/* GET_MEM is currently not assumed to retrieve 0 filled space, */
+/* though we should perhaps take advantage of the case in which */
+/* does.							*/
+# ifdef PCR
+    char * real_malloc();
+#   define GET_MEM(bytes) HBLKPTR(real_malloc((size_t)bytes + GC_page_size) \
+				  + GC_page_size-1)
+# else
+#   ifdef OS2
+      void * os2_alloc(size_t bytes);
+#     define GET_MEM(bytes) HBLKPTR((ptr_t)os2_alloc((size_t)bytes \
+				    + GC_page_size) \
+                                    + GC_page_size-1)
+#   else
+#     if defined(AMIGA) || defined(NEXT) || defined(MACOSX) || defined(DOS4GW)
+#       define GET_MEM(bytes) HBLKPTR((size_t) \
+				      calloc(1, (size_t)bytes + GC_page_size) \
+                                      + GC_page_size-1)
+#     else
+#	ifdef MSWIN32
+          extern ptr_t GC_win32_get_mem();
+#         define GET_MEM(bytes) (struct hblk *)GC_win32_get_mem(bytes)
+#	else
+#	  ifdef MACOS
+#	    if defined(USE_TEMPORARY_MEMORY)
+		extern Ptr GC_MacTemporaryNewPtr(size_t size,
+						 Boolean clearMemory);
+#               define GET_MEM(bytes) HBLKPTR( \
+		    GC_MacTemporaryNewPtr(bytes + GC_page_size, true) \
+		    + GC_page_size-1)
+#	    else
+#         	    define GET_MEM(bytes) HBLKPTR( \
+			NewPtrClear(bytes + GC_page_size) + GC_page_size-1)
+#	    endif
+#	  else
+              extern ptr_t GC_unix_get_mem();
+#             define GET_MEM(bytes) (struct hblk *)GC_unix_get_mem(bytes)
+#	  endif
+#	endif
+#     endif
+#   endif
+# endif
+
+/*
+ * Mutual exclusion between allocator/collector routines.
+ * Needed if there is more than one allocator thread.
+ * FASTLOCK() is assumed to try to acquire the lock in a cheap and
+ * dirty way that is acceptable for a few instructions, e.g. by
+ * inhibiting preemption.  This is assumed to have succeeded only
+ * if a subsequent call to FASTLOCK_SUCCEEDED() returns TRUE.
+ * FASTUNLOCK() is called whether or not FASTLOCK_SUCCEEDED().
+ * If signals cannot be tolerated with the FASTLOCK held, then
+ * FASTLOCK should disable signals.  The code executed under
+ * FASTLOCK is otherwise immune to interruption, provided it is
+ * not restarted.
+ * DCL_LOCK_STATE declares any local variables needed by LOCK and UNLOCK
+ * and/or DISABLE_SIGNALS and ENABLE_SIGNALS and/or FASTLOCK.
+ * (There is currently no equivalent for FASTLOCK.)
+ */  
+# ifdef THREADS
+#  ifdef PCR_OBSOLETE	/* Faster, but broken with multiple lwp's	*/
+#    include  "th/PCR_Th.h"
+#    include  "th/PCR_ThCrSec.h"
+     extern struct PCR_Th_MLRep GC_allocate_ml;
+#    define DCL_LOCK_STATE  PCR_sigset_t GC_old_sig_mask
+#    define LOCK() PCR_Th_ML_Acquire(&GC_allocate_ml) 
+#    define UNLOCK() PCR_Th_ML_Release(&GC_allocate_ml)
+#    define FASTLOCK() PCR_ThCrSec_EnterSys()
+     /* Here we cheat (a lot): */
+#        define FASTLOCK_SUCCEEDED() (*(int *)(&GC_allocate_ml) == 0)
+		/* TRUE if nobody currently holds the lock */
+#    define FASTUNLOCK() PCR_ThCrSec_ExitSys()
+#  endif
+#  ifdef PCR
+#    include <base/PCR_Base.h>
+#    include <th/PCR_Th.h>
+     extern PCR_Th_ML GC_allocate_ml;
+#    define DCL_LOCK_STATE \
+	 PCR_ERes GC_fastLockRes; PCR_sigset_t GC_old_sig_mask
+#    define LOCK() PCR_Th_ML_Acquire(&GC_allocate_ml)
+#    define UNLOCK() PCR_Th_ML_Release(&GC_allocate_ml)
+#    define FASTLOCK() (GC_fastLockRes = PCR_Th_ML_Try(&GC_allocate_ml))
+#    define FASTLOCK_SUCCEEDED() (GC_fastLockRes == PCR_ERes_okay)
+#    define FASTUNLOCK()  {\
+        if( FASTLOCK_SUCCEEDED() ) PCR_Th_ML_Release(&GC_allocate_ml); }
+#  endif
+#  ifdef SRC_M3
+     extern word RT0u__inCritical;
+#    define LOCK() RT0u__inCritical++
+#    define UNLOCK() RT0u__inCritical--
+#  endif
+#  ifdef SOLARIS_THREADS
+#    include <thread.h>
+#    include <signal.h>
+     extern mutex_t GC_allocate_ml;
+#    define LOCK() mutex_lock(&GC_allocate_ml);
+#    define UNLOCK() mutex_unlock(&GC_allocate_ml);
+#  endif
+#  if defined(LINUX_THREADS) 
+#   if defined(I386)|| defined(POWERPC) || defined(ALPHA) || defined(IA64) \
+    || defined(M68K)
+#    include <pthread.h>
+#    define USE_SPIN_LOCK
+#    if defined(I386)
+       inline static int GC_test_and_set(volatile unsigned int *addr) {
+	  int oldval;
+	  /* Note: the "xchg" instruction does not need a "lock" prefix */
+	  __asm__ __volatile__("xchgl %0, %1"
+		: "=r"(oldval), "=m"(*(addr))
+		: "0"(1), "m"(*(addr)));
+	  return oldval;
+       }
+#    endif
+#    if defined(IA64)
+       inline static int GC_test_and_set(volatile unsigned int *addr) {
+	  int oldval;
+	  __asm__ __volatile__("xchg4 %0=%1,%2"
+		: "=r"(oldval), "=m"(*addr)
+		: "r"(1), "1"(*addr));
+	  return oldval;
+       }
+       inline static void GC_clear(volatile unsigned int *addr) {
+	 __asm__ __volatile__("st4.rel %0=r0" : "=m" (*addr));
+       }
+#      define GC_CLEAR_DEFINED
+#    endif
+#    ifdef M68K
+       /* Contributed by Tony Mantler.  I'm not sure how well it was	*/
+       /* tested.							*/
+       inline static int GC_test_and_set(volatile unsigned int *addr) {
+          char oldval; /* this must be no longer than 8 bits */
+
+          /* The return value is semi-phony. */
+          /* 'tas' sets bit 7 while the return */
+          /* value pretends bit 0 was set */
+          __asm__ __volatile__(
+                 "tas %1@; sne %0; negb %0"
+                 : "=d" (oldval)
+                 : "a" (addr));
+          return oldval;
+       }
+#    endif
+#    if defined(POWERPC)
+      inline static int GC_test_and_set(volatile unsigned int *addr) {
+        int oldval;
+        int temp = 1; // locked value
+
+        __asm__ __volatile__(
+               "1:\tlwarx %0,0,%3\n"   // load and reserve
+               "\tcmpwi %0, 0\n"       // if load is
+               "\tbne 2f\n"            //   non-zero, return already set
+               "\tstwcx. %2,0,%1\n"    // else store conditional
+               "\tbne- 1b\n"           // retry if lost reservation
+               "2:\t\n"                // oldval is zero if we set
+              : "=&r"(oldval), "=p"(addr)
+              : "r"(temp), "1"(addr)
+              : "memory");
+        return (int)oldval;
+      }
+      inline static void GC_clear(volatile unsigned int *addr) {
+	 __asm__ __volatile__("eieio");
+         *(addr) = 0;
+      }
+#     define GC_CLEAR_DEFINED
+#    endif
+#    ifdef ALPHA
+      inline static int GC_test_and_set(volatile unsigned int * addr)
+      {
+        unsigned long oldvalue;
+        unsigned long temp;
+
+        __asm__ __volatile__(
+                             "1:     ldl_l %0,%1\n"
+                             "       and %0,%3,%2\n"
+                             "       bne %2,2f\n"
+                             "       xor %0,%3,%0\n"
+                             "       stl_c %0,%1\n"
+                             "       beq %0,3f\n"
+                             "       mb\n"
+                             "2:\n"
+                             ".section .text2,\"ax\"\n"
+                             "3:     br 1b\n"
+                             ".previous"
+                             :"=&r" (temp), "=m" (*addr), "=&r" (oldvalue)
+                             :"Ir" (1), "m" (*addr));
+
+        return oldvalue;
+      }
+      /* Should probably also define GC_clear, since it needs	*/
+      /* a memory barrier ??					*/
+#    endif /* ALPHA */
+#    ifdef ARM32
+      inline static int GC_test_and_set(volatile unsigned int *addr) {
+        int oldval;
+        /* SWP on ARM is very similar to XCHG on x86.  Doesn't lock the
+         * bus because there are no SMP ARM machines.  If/when there are,
+         * this code will likely need to be updated. */
+        /* See linuxthreads/sysdeps/arm/pt-machine.h in glibc-2.1 */
+        __asm__ __volatile__("swp %0, %1, [%2]"
+      			     : "=r"(oldval)
+      			     : "r"(1), "r"(addr));
+        return oldval;
+      }
+#    endif
+#    ifndef GC_CLEAR_DEFINED
+       inline static void GC_clear(volatile unsigned int *addr) {
+	  /* Try to discourage gcc from moving anything past this. */
+	  __asm__ __volatile__(" ");
+          *(addr) = 0;
+       }
+#    endif
+
+     extern volatile unsigned int GC_allocate_lock;
+     extern pthread_t GC_lock_holder;
+     extern void GC_lock(void);
+	/* Allocation lock holder.  Only set if acquired by client through */
+	/* GC_call_with_alloc_lock.					   */
+#    define SET_LOCK_HOLDER() GC_lock_holder = pthread_self()
+#    define NO_THREAD (pthread_t)(-1)
+#    define UNSET_LOCK_HOLDER() GC_lock_holder = NO_THREAD
+#    define I_HOLD_LOCK() (pthread_equal(GC_lock_holder, pthread_self()))
+#    define LOCK() \
+		{ if (GC_test_and_set(&GC_allocate_lock)) GC_lock(); }
+#    define UNLOCK() \
+		GC_clear(&GC_allocate_lock)
+     extern VOLATILE GC_bool GC_collecting;
+#    define ENTER_GC() \
+		{ \
+		    GC_collecting = 1; \
+		}
+#    define EXIT_GC() GC_collecting = 0;
+#   else /* LINUX_THREADS on hardware for which we don't know how	*/
+	 /* to do test and set.						*/
+#    include <pthread.h>
+     extern pthread_mutex_t GC_allocate_ml;
+#    define LOCK() pthread_mutex_lock(&GC_allocate_ml)
+#    define UNLOCK() pthread_mutex_unlock(&GC_allocate_ml)
+#   endif
+#  endif /* LINUX_THREADS */
+#  if defined(HPUX_THREADS)
+#    include <pthread.h>
+     extern pthread_mutex_t GC_allocate_ml;
+#    define LOCK() pthread_mutex_lock(&GC_allocate_ml)
+#    define UNLOCK() pthread_mutex_unlock(&GC_allocate_ml)
+#  endif
+#  if defined(IRIX_THREADS) || defined(IRIX_JDK_THREADS) 
+     /* This may also eventually be appropriate for HPUX_THREADS */
+#    include <pthread.h>
+#    ifndef HPUX_THREADS
+	/* This probably should never be included, but I can't test	*/
+	/* on Irix anymore.						*/
+#       include <mutex.h>
+#    endif
+
+#    ifndef HPUX_THREADS
+#      if __mips < 3 || !(defined (_ABIN32) || defined(_ABI64)) \
+	|| !defined(_COMPILER_VERSION) || _COMPILER_VERSION < 700
+#        define GC_test_and_set(addr, v) test_and_set(addr,v)
+#      else
+#	 define GC_test_and_set(addr, v) __test_and_set(addr,v)
+#      endif
+#    else
+       /* I couldn't find a way to do this inline on HP/UX	*/
+#    endif
+     extern unsigned long GC_allocate_lock;
+	/* This is not a mutex because mutexes that obey the (optional) 	*/
+	/* POSIX scheduling rules are subject to convoys in high contention	*/
+	/* applications.  This is basically a spin lock.			*/
+     extern pthread_t GC_lock_holder;
+     extern void GC_lock(void);
+	/* Allocation lock holder.  Only set if acquired by client through */
+	/* GC_call_with_alloc_lock.					   */
+#    define SET_LOCK_HOLDER() GC_lock_holder = pthread_self()
+#    define NO_THREAD (pthread_t)(-1)
+#    define UNSET_LOCK_HOLDER() GC_lock_holder = NO_THREAD
+#    define I_HOLD_LOCK() (pthread_equal(GC_lock_holder, pthread_self()))
+#    ifdef HPUX_THREADS
+#      define LOCK() { if (!GC_test_and_clear(&GC_allocate_lock)) GC_lock(); }
+       /* The following is INCORRECT, since the memory model is too weak. */
+#      define UNLOCK() { GC_noop1(&GC_allocate_lock); \
+			*(volatile unsigned long *)(&GC_allocate_lock) = 1; }
+#    else
+#      define LOCK() { if (GC_test_and_set(&GC_allocate_lock, 1)) GC_lock(); }
+#      if __mips >= 3 && (defined (_ABIN32) || defined(_ABI64)) \
+	   && defined(_COMPILER_VERSION) && _COMPILER_VERSION >= 700
+#	    define UNLOCK() __lock_release(&GC_allocate_lock)
+#      else
+	    /* The function call in the following should prevent the	*/
+	    /* compiler from moving assignments to below the UNLOCK.	*/
+	    /* This is probably not necessary for ucode or gcc 2.8.	*/
+	    /* It may be necessary for Ragnarok and future gcc		*/
+	    /* versions.						*/
+#           define UNLOCK() { GC_noop1(&GC_allocate_lock); \
+			*(volatile unsigned long *)(&GC_allocate_lock) = 0; }
+#      endif
+#    endif
+     extern VOLATILE GC_bool GC_collecting;
+#    define ENTER_GC() \
+		{ \
+		    GC_collecting = 1; \
+		}
+#    define EXIT_GC() GC_collecting = 0;
+#  endif /* IRIX_THREADS || IRIX_JDK_THREADS */
+#  ifdef WIN32_THREADS
+#    include <windows.h>
+     GC_API CRITICAL_SECTION GC_allocate_ml;
+#    define LOCK() EnterCriticalSection(&GC_allocate_ml);
+#    define UNLOCK() LeaveCriticalSection(&GC_allocate_ml);
+#  endif
+#  ifndef SET_LOCK_HOLDER
+#      define SET_LOCK_HOLDER()
+#      define UNSET_LOCK_HOLDER()
+#      define I_HOLD_LOCK() FALSE
+		/* Used on platforms were locks can be reacquired,	*/
+		/* so it doesn't matter if we lie.			*/
+#  endif
+# else
+#    define LOCK()
+#    define UNLOCK()
+# endif
+# ifndef SET_LOCK_HOLDER
+#   define SET_LOCK_HOLDER()
+#   define UNSET_LOCK_HOLDER()
+#   define I_HOLD_LOCK() FALSE
+		/* Used on platforms were locks can be reacquired,	*/
+		/* so it doesn't matter if we lie.			*/
+# endif
+# ifndef ENTER_GC
+#   define ENTER_GC()
+#   define EXIT_GC()
+# endif
+
+# ifndef DCL_LOCK_STATE
+#   define DCL_LOCK_STATE
+# endif
+# ifndef FASTLOCK
+#   define FASTLOCK() LOCK()
+#   define FASTLOCK_SUCCEEDED() TRUE
+#   define FASTUNLOCK() UNLOCK()
+# endif
+
+/* Delay any interrupts or signals that may abort this thread.  Data	*/
+/* structures are in a consistent state outside this pair of calls.	*/
+/* ANSI C allows both to be empty (though the standard isn't very	*/
+/* clear on that point).  Standard malloc implementations are usually	*/
+/* neither interruptable nor thread-safe, and thus correspond to	*/
+/* empty definitions.							*/
+# ifdef PCR
+#   define DISABLE_SIGNALS() \
+		 PCR_Th_SetSigMask(PCR_allSigsBlocked,&GC_old_sig_mask)
+#   define ENABLE_SIGNALS() \
+		PCR_Th_SetSigMask(&GC_old_sig_mask, NIL)
+# else
+#   if defined(SRC_M3) || defined(AMIGA) || defined(SOLARIS_THREADS) \
+	|| defined(MSWIN32) || defined(MACOS) || defined(DJGPP) \
+	|| defined(NO_SIGNALS) || defined(IRIX_THREADS) \
+	|| defined(IRIX_JDK_THREADS) || defined(LINUX_THREADS) 
+			/* Also useful for debugging.		*/
+	/* Should probably use thr_sigsetmask for SOLARIS_THREADS. */
+#     define DISABLE_SIGNALS()
+#     define ENABLE_SIGNALS()
+#   else
+#     define DISABLE_SIGNALS() GC_disable_signals()
+	void GC_disable_signals();
+#     define ENABLE_SIGNALS() GC_enable_signals()
+	void GC_enable_signals();
+#   endif
+# endif
+
+/*
+ * Stop and restart mutator threads.
+ */
+# ifdef PCR
+#     include "th/PCR_ThCtl.h"
+#     define STOP_WORLD() \
+ 	PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_stopNormal, \
+ 				   PCR_allSigsBlocked, \
+ 				   PCR_waitForever)
+#     define START_WORLD() \
+	PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_null, \
+ 				   PCR_allSigsBlocked, \
+ 				   PCR_waitForever);
+# else
+#   if defined(SOLARIS_THREADS) || defined(WIN32_THREADS) \
+	|| defined(IRIX_THREADS) || defined(LINUX_THREADS) \
+	|| defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
+      void GC_stop_world();
+      void GC_start_world();
+#     define STOP_WORLD() GC_stop_world()
+#     define START_WORLD() GC_start_world()
+#   else
+#     define STOP_WORLD()
+#     define START_WORLD()
+#   endif
+# endif
+
+/* Abandon ship */
+# ifdef PCR
+#   define ABORT(s) PCR_Base_Panic(s)
+# else
+#   ifdef SMALL_CONFIG
+#	define ABORT(msg) abort();
+#   else
+	GC_API void GC_abort();
+#       define ABORT(msg) GC_abort(msg);
+#   endif
+# endif
+
+/* Exit abnormally, but without making a mess (e.g. out of memory) */
+# ifdef PCR
+#   define EXIT() PCR_Base_Exit(1,PCR_waitForever)
+# else
+#   define EXIT() (void)exit(1)
+# endif
+
+/* Print warning message, e.g. almost out of memory.	*/
+# define WARN(msg,arg) (*GC_current_warn_proc)(msg, (GC_word)(arg))
+extern GC_warn_proc GC_current_warn_proc;
+
+/*********************************/
+/*                               */
+/* Word-size-dependent defines   */
+/*                               */
+/*********************************/
+
+#if CPP_WORDSZ == 32
+#  define WORDS_TO_BYTES(x)   ((x)<<2)
+#  define BYTES_TO_WORDS(x)   ((x)>>2)
+#  define LOGWL               ((word)5)    /* log[2] of CPP_WORDSZ */
+#  define modWORDSZ(n) ((n) & 0x1f)        /* n mod size of word	    */
+#  if ALIGNMENT != 4
+#	define UNALIGNED
+#  endif
+#endif
+
+#if CPP_WORDSZ == 64
+#  define WORDS_TO_BYTES(x)   ((x)<<3)
+#  define BYTES_TO_WORDS(x)   ((x)>>3)
+#  define LOGWL               ((word)6)    /* log[2] of CPP_WORDSZ */
+#  define modWORDSZ(n) ((n) & 0x3f)        /* n mod size of word	    */
+#  if ALIGNMENT != 8
+#	define UNALIGNED
+#  endif
+#endif
+
+#define WORDSZ ((word)CPP_WORDSZ)
+#define SIGNB  ((word)1 << (WORDSZ-1))
+#define BYTES_PER_WORD      ((word)(sizeof (word)))
+#define ONES                ((word)(-1))
+#define divWORDSZ(n) ((n) >> LOGWL)	   /* divide n by size of word      */
+
+/*********************/
+/*                   */
+/*  Size Parameters  */
+/*                   */
+/*********************/
+
+/*  heap block size, bytes. Should be power of 2 */
+
+#ifndef HBLKSIZE
+# ifdef SMALL_CONFIG
+#   define CPP_LOG_HBLKSIZE 10
+# else
+#   if CPP_WORDSZ == 32
+#     define CPP_LOG_HBLKSIZE 12
+#   else
+#     define CPP_LOG_HBLKSIZE 13
+#   endif
+# endif
+#else
+# if HBLKSIZE == 512
+#   define CPP_LOG_HBLKSIZE 9
+# endif
+# if HBLKSIZE == 1024
+#   define CPP_LOG_HBLKSIZE 10
+# endif
+# if HBLKSIZE == 2048
+#   define CPP_LOG_HBLKSIZE 11
+# endif
+# if HBLKSIZE == 4096
+#   define CPP_LOG_HBLKSIZE 12
+# endif
+# if HBLKSIZE == 8192
+#   define CPP_LOG_HBLKSIZE 13
+# endif
+# if HBLKSIZE == 16384
+#   define CPP_LOG_HBLKSIZE 14
+# endif
+# ifndef CPP_LOG_HBLKSIZE
+    --> fix HBLKSIZE
+# endif
+# undef HBLKSIZE
+#endif
+# define CPP_HBLKSIZE (1 << CPP_LOG_HBLKSIZE)
+# define LOG_HBLKSIZE   ((word)CPP_LOG_HBLKSIZE)
+# define HBLKSIZE ((word)CPP_HBLKSIZE)
+
+
+/*  max size objects supported by freelist (larger objects may be   */
+/*  allocated, but less efficiently)                                */
+
+#define CPP_MAXOBJSZ    BYTES_TO_WORDS(CPP_HBLKSIZE/2)
+#define MAXOBJSZ ((word)CPP_MAXOBJSZ)
+		
+# define divHBLKSZ(n) ((n) >> LOG_HBLKSIZE)
+
+# define HBLK_PTR_DIFF(p,q) divHBLKSZ((ptr_t)p - (ptr_t)q)
+	/* Equivalent to subtracting 2 hblk pointers.	*/
+	/* We do it this way because a compiler should	*/
+	/* find it hard to use an integer division	*/
+	/* instead of a shift.  The bundled SunOS 4.1	*/
+	/* o.w. sometimes pessimizes the subtraction to	*/
+	/* involve a call to .div.			*/
+ 
+# define modHBLKSZ(n) ((n) & (HBLKSIZE-1))
+ 
+# define HBLKPTR(objptr) ((struct hblk *)(((word) (objptr)) & ~(HBLKSIZE-1)))
+
+# define HBLKDISPL(objptr) (((word) (objptr)) & (HBLKSIZE-1))
+
+/* Round up byte allocation requests to integral number of words, etc. */
+# ifdef ADD_BYTE_AT_END
+#   define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1))
+#   ifdef ALIGN_DOUBLE
+#       define ALIGNED_WORDS(n) (BYTES_TO_WORDS((n) + WORDS_TO_BYTES(2)) & ~1)
+#   else
+#       define ALIGNED_WORDS(n) ROUNDED_UP_WORDS(n)
+#   endif
+#   define SMALL_OBJ(bytes) ((bytes) < WORDS_TO_BYTES(MAXOBJSZ))
+#   define ADD_SLOP(bytes) ((bytes)+1)
+# else
+#   define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + (WORDS_TO_BYTES(1) - 1))
+#   ifdef ALIGN_DOUBLE
+#       define ALIGNED_WORDS(n) \
+			(BYTES_TO_WORDS((n) + WORDS_TO_BYTES(2) - 1) & ~1)
+#   else
+#       define ALIGNED_WORDS(n) ROUNDED_UP_WORDS(n)
+#   endif
+#   define SMALL_OBJ(bytes) ((bytes) <= WORDS_TO_BYTES(MAXOBJSZ))
+#   define ADD_SLOP(bytes) (bytes)
+# endif
+
+
+/*
+ * Hash table representation of sets of pages.  This assumes it is
+ * OK to add spurious entries to sets.
+ * Used by black-listing code, and perhaps by dirty bit maintenance code.
+ */
+ 
+# ifdef LARGE_CONFIG
+#   define LOG_PHT_ENTRIES  17
+# else
+#   define LOG_PHT_ENTRIES  14	/* Collisions are likely if heap grows	*/
+				/* to more than 16K hblks = 64MB.	*/
+				/* Each hash table occupies 2K bytes.   */
+# endif
+# define PHT_ENTRIES ((word)1 << LOG_PHT_ENTRIES)
+# define PHT_SIZE (PHT_ENTRIES >> LOGWL)
+typedef word page_hash_table[PHT_SIZE];
+
+# define PHT_HASH(addr) ((((word)(addr)) >> LOG_HBLKSIZE) & (PHT_ENTRIES - 1))
+
+# define get_pht_entry_from_index(bl, index) \
+		(((bl)[divWORDSZ(index)] >> modWORDSZ(index)) & 1)
+# define set_pht_entry_from_index(bl, index) \
+		(bl)[divWORDSZ(index)] |= (word)1 << modWORDSZ(index)
+# define clear_pht_entry_from_index(bl, index) \
+		(bl)[divWORDSZ(index)] &= ~((word)1 << modWORDSZ(index))
+	
+
+
+/********************************************/
+/*                                          */
+/*    H e a p   B l o c k s                 */
+/*                                          */
+/********************************************/
+
+/*  heap block header */
+#define HBLKMASK   (HBLKSIZE-1)
+
+#define BITS_PER_HBLK (HBLKSIZE * 8)
+
+#define MARK_BITS_PER_HBLK (BITS_PER_HBLK/CPP_WORDSZ)
+	   /* upper bound                                    */
+	   /* We allocate 1 bit/word.  Only the first word   */
+	   /* in each object is actually marked.             */
+
+# ifdef ALIGN_DOUBLE
+#   define MARK_BITS_SZ (((MARK_BITS_PER_HBLK + 2*CPP_WORDSZ - 1) \
+			  / (2*CPP_WORDSZ))*2)
+# else
+#   define MARK_BITS_SZ ((MARK_BITS_PER_HBLK + CPP_WORDSZ - 1)/CPP_WORDSZ)
+# endif
+	   /* Upper bound on number of mark words per heap block  */
+
+struct hblkhdr {
+    word hb_sz;  /* If in use, size in words, of objects in the block. */
+		 /* if free, the size in bytes of the whole block      */
+    struct hblk * hb_next; 	/* Link field for hblk free list	 */
+    				/* and for lists of chunks waiting to be */
+    				/* reclaimed.				 */
+    struct hblk * hb_prev;	/* Backwards link for free list.	*/
+    word hb_descr;   		/* object descriptor for marking.  See	*/
+    				/* mark.h.				*/
+    char* hb_map;	/* A pointer to a pointer validity map of the block. */
+    		      	/* See GC_obj_map.				     */
+    		     	/* Valid for all blocks with headers.		     */
+    		     	/* Free blocks point to GC_invalid_map.		     */
+    unsigned char hb_obj_kind;
+    			 /* Kind of objects in the block.  Each kind 	*/
+    			 /* identifies a mark procedure and a set of 	*/
+    			 /* list headers.  Sometimes called regions.	*/
+    unsigned char hb_flags;
+#	define IGNORE_OFF_PAGE	1	/* Ignore pointers that do not	*/
+					/* point to the first page of 	*/
+					/* this object.			*/
+#	define WAS_UNMAPPED 2	/* This is a free block, which has	*/
+				/* been unmapped from the address 	*/
+				/* space.				*/
+				/* GC_remap must be invoked on it	*/
+				/* before it can be reallocated.	*/
+				/* Only set with USE_MUNMAP.		*/
+    unsigned short hb_last_reclaimed;
+    				/* Value of GC_gc_no when block was	*/
+    				/* last allocated or swept. May wrap.   */
+				/* For a free block, this is maintained */
+				/* unly for USE_MUNMAP, and indicates	*/
+				/* when the header was allocated, or	*/
+				/* when the size of the block last	*/
+				/* changed.				*/
+    word hb_marks[MARK_BITS_SZ];
+			    /* Bit i in the array refers to the             */
+			    /* object starting at the ith word (header      */
+			    /* INCLUDED) in the heap block.                 */
+			    /* The lsb of word 0 is numbered 0.		    */
+			    /* Unused bits are invalid, and are 	    */
+			    /* occasionally set, e.g for uncollectable	    */
+			    /* objects.					    */
+};
+
+/*  heap block body */
+
+# define DISCARD_WORDS 0
+	/* Number of words to be dropped at the beginning of each block	*/
+	/* Must be a multiple of WORDSZ.  May reasonably be nonzero	*/
+	/* on machines that don't guarantee longword alignment of	*/
+	/* pointers, so that the number of false hits is minimized.	*/
+	/* 0 and WORDSZ are probably the only reasonable values.	*/
+
+# define BODY_SZ ((HBLKSIZE-WORDS_TO_BYTES(DISCARD_WORDS))/sizeof(word))
+
+struct hblk {
+#   if (DISCARD_WORDS != 0)
+        word garbage[DISCARD_WORDS];
+#   endif
+    word hb_body[BODY_SZ];
+};
+
+# define HDR_WORDS ((word)DISCARD_WORDS)
+# define HDR_BYTES ((word)WORDS_TO_BYTES(DISCARD_WORDS))
+
+# define OBJ_SZ_TO_BLOCKS(sz) \
+    divHBLKSZ(HDR_BYTES + WORDS_TO_BYTES(sz) + HBLKSIZE-1)
+    /* Size of block (in units of HBLKSIZE) needed to hold objects of	*/
+    /* given sz (in words).						*/
+
+/* Object free list link */
+# define obj_link(p) (*(ptr_t *)(p))
+
+/* The type of mark procedures.  This really belongs in gc_mark.h.	*/
+/* But we put it here, so that we can avoid scanning the mark proc	*/
+/* table.								*/
+typedef struct ms_entry * (*mark_proc)(/* word * addr,
+					  struct ms_entry *mark_stack_ptr,
+					  struct ms_entry *mark_stack_limit,
+					  word env */);
+# define LOG_MAX_MARK_PROCS 6
+# define MAX_MARK_PROCS (1 << LOG_MAX_MARK_PROCS)
+
+/* Root sets.  Logically private to mark_rts.c.  But we don't want the	*/
+/* tables scanned, so we put them here.					*/
+/* MAX_ROOT_SETS is the maximum number of ranges that can be 	*/
+/* registered as static roots. 					*/
+# ifdef LARGE_CONFIG
+#   define MAX_ROOT_SETS 4096
+# else
+#   ifdef PCR
+#     define MAX_ROOT_SETS 1024
+#   else
+#     ifdef MSWIN32
+#	define MAX_ROOT_SETS 512
+	    /* Under NT, we add only written pages, which can result 	*/
+	    /* in many small root sets.					*/
+#     else
+#       define MAX_ROOT_SETS 64
+#     endif
+#   endif
+# endif
+
+# define MAX_EXCLUSIONS (MAX_ROOT_SETS/4)
+/* Maximum number of segments that can be excluded from root sets.	*/
+
+/*
+ * Data structure for excluded static roots.
+ */
+struct exclusion {
+    ptr_t e_start;
+    ptr_t e_end;
+};
+
+/* Data structure for list of root sets.				*/
+/* We keep a hash table, so that we can filter out duplicate additions.	*/
+/* Under Win32, we need to do a better job of filtering overlaps, so	*/
+/* we resort to sequential search, and pay the price.			*/
+struct roots {
+	ptr_t r_start;
+	ptr_t r_end;
+#	ifndef MSWIN32
+	  struct roots * r_next;
+#	endif
+	GC_bool r_tmp;
+	  	/* Delete before registering new dynamic libraries */
+};
+
+#ifndef MSWIN32
+    /* Size of hash table index to roots.	*/
+#   define LOG_RT_SIZE 6
+#   define RT_SIZE (1 << LOG_RT_SIZE) /* Power of 2, may be != MAX_ROOT_SETS */
+#endif
+
+/* Lists of all heap blocks and free lists	*/
+/* as well as other random data structures	*/
+/* that should not be scanned by the		*/
+/* collector.					*/
+/* These are grouped together in a struct	*/
+/* so that they can be easily skipped by the	*/
+/* GC_mark routine.				*/
+/* The ordering is weird to make GC_malloc	*/
+/* faster by keeping the important fields	*/
+/* sufficiently close together that a		*/
+/* single load of a base register will do.	*/
+/* Scalars that could easily appear to		*/
+/* be pointers are also put here.		*/
+/* The main fields should precede any 		*/
+/* conditionally included fields, so that	*/
+/* gc_inl.h will work even if a different set	*/
+/* of macros is defined when the client is	*/
+/* compiled.					*/
+
+struct _GC_arrays {
+  word _heapsize;
+  word _max_heapsize;
+  word _requested_heapsize;	/* Heap size due to explicit expansion */
+  ptr_t _last_heap_addr;
+  ptr_t _prev_heap_addr;
+  word _large_free_bytes;
+	/* Total bytes contained in blocks on large object free */
+	/* list.						*/
+  word _words_allocd_before_gc;
+		/* Number of words allocated before this	*/
+		/* collection cycle.				*/
+  word _words_allocd;
+  	/* Number of words allocated during this collection cycle */
+  word _words_wasted;
+  	/* Number of words wasted due to internal fragmentation	*/
+  	/* in large objects, or due to dropping blacklisted     */
+	/* blocks, since last gc.  Approximate.                 */
+  word _words_finalized;
+  	/* Approximate number of words in objects (and headers)	*/
+  	/* That became ready for finalization in the last 	*/
+  	/* collection.						*/
+  word _non_gc_bytes_at_gc;
+  	/* Number of explicitly managed bytes of storage 	*/
+  	/* at last collection.					*/
+  word _mem_freed;
+  	/* Number of explicitly deallocated words of memory	*/
+  	/* since last collection.				*/
+  ptr_t _scratch_end_ptr;
+  ptr_t _scratch_last_end_ptr;
+	/* Used by headers.c, and can easily appear to point to	*/
+	/* heap.						*/
+  mark_proc _mark_procs[MAX_MARK_PROCS];
+  	/* Table of user-defined mark procedures.  There is	*/
+	/* a small number of these, which can be referenced	*/
+	/* by DS_PROC mark descriptors.  See gc_mark.h.		*/
+  ptr_t _objfreelist[MAXOBJSZ+1];
+			  /* free list for objects */
+  ptr_t _aobjfreelist[MAXOBJSZ+1];
+			  /* free list for atomic objs 	*/
+
+  ptr_t _uobjfreelist[MAXOBJSZ+1];
+			  /* uncollectable but traced objs 	*/
+			  /* objects on this and auobjfreelist  */
+			  /* are always marked, except during   */
+			  /* garbage collections.		*/
+# ifdef ATOMIC_UNCOLLECTABLE
+    ptr_t _auobjfreelist[MAXOBJSZ+1];
+# endif
+			  /* uncollectable but traced objs 	*/
+
+# ifdef GATHERSTATS
+    word _composite_in_use;
+   		/* Number of words in accessible composite	*/
+		/* objects.					*/
+    word _atomic_in_use;
+   		/* Number of words in accessible atomic		*/
+		/* objects.					*/
+# endif
+# ifdef USE_MUNMAP
+    word _unmapped_bytes;
+# endif
+# ifdef MERGE_SIZES
+    unsigned _size_map[WORDS_TO_BYTES(MAXOBJSZ+1)];
+    	/* Number of words to allocate for a given allocation request in */
+    	/* bytes.							 */
+# endif 
+
+# ifdef STUBBORN_ALLOC
+    ptr_t _sobjfreelist[MAXOBJSZ+1];
+# endif
+  			  /* free list for immutable objects	*/
+  ptr_t _obj_map[MAXOBJSZ+1];
+                       /* If not NIL, then a pointer to a map of valid  */
+    		       /* object addresses. _obj_map[sz][i] is j if the	*/
+    		       /* address block_start+i is a valid pointer      */
+    		       /* to an object at				*/
+    		       /* block_start+i&~3 - WORDS_TO_BYTES(j).		*/
+    		       /* (If ALL_INTERIOR_POINTERS is defined, then	*/
+    		       /* instead ((short *)(hb_map[sz])[i] is j if	*/
+    		       /* block_start+WORDS_TO_BYTES(i) is in the	*/
+    		       /* interior of an object starting at		*/
+    		       /* block_start+WORDS_TO_BYTES(i-j)).		*/
+    		       /* It is OBJ_INVALID if				*/
+    		       /* block_start+WORDS_TO_BYTES(i) is not		*/
+    		       /* valid as a pointer to an object.              */
+    		       /* We assume all values of j <= OBJ_INVALID.	*/
+    		       /* The zeroth entry corresponds to large objects.*/
+#   ifdef ALL_INTERIOR_POINTERS
+#	define map_entry_type short
+#       define OBJ_INVALID 0x7fff
+#	define MAP_ENTRY(map, bytes) \
+		(((map_entry_type *)(map))[BYTES_TO_WORDS(bytes)])
+#	define MAP_ENTRIES BYTES_TO_WORDS(HBLKSIZE)
+#	define MAP_SIZE (MAP_ENTRIES * sizeof(map_entry_type))
+#	define OFFSET_VALID(displ) TRUE
+#	define CPP_MAX_OFFSET (HBLKSIZE - HDR_BYTES - 1)
+#	define MAX_OFFSET ((word)CPP_MAX_OFFSET)
+#   else
+#	define map_entry_type char
+#       define OBJ_INVALID 0x7f
+#	define MAP_ENTRY(map, bytes) \
+		(map)[bytes]
+#	define MAP_ENTRIES HBLKSIZE
+#	define MAP_SIZE MAP_ENTRIES
+#	define CPP_MAX_OFFSET (WORDS_TO_BYTES(OBJ_INVALID) - 1)	
+#	define MAX_OFFSET ((word)CPP_MAX_OFFSET)
+# 	define VALID_OFFSET_SZ \
+	  (CPP_MAX_OFFSET > WORDS_TO_BYTES(CPP_MAXOBJSZ)? \
+	   CPP_MAX_OFFSET+1 \
+	   : WORDS_TO_BYTES(CPP_MAXOBJSZ)+1)
+  	char _valid_offsets[VALID_OFFSET_SZ];
+				/* GC_valid_offsets[i] == TRUE ==> i 	*/
+				/* is registered as a displacement.	*/
+#	define OFFSET_VALID(displ) GC_valid_offsets[displ]
+  	char _modws_valid_offsets[sizeof(word)];
+				/* GC_valid_offsets[i] ==>		  */
+				/* GC_modws_valid_offsets[i%sizeof(word)] */
+#   endif
+# ifdef STUBBORN_ALLOC
+    page_hash_table _changed_pages;
+        /* Stubborn object pages that were changes since last call to	*/
+	/* GC_read_changed.						*/
+    page_hash_table _prev_changed_pages;
+        /* Stubborn object pages that were changes before last call to	*/
+	/* GC_read_changed.						*/
+# endif
+# if defined(PROC_VDB) || defined(MPROTECT_VDB)
+    page_hash_table _grungy_pages; /* Pages that were dirty at last 	   */
+				     /* GC_read_dirty.			   */
+# endif
+# ifdef MPROTECT_VDB
+    VOLATILE page_hash_table _dirty_pages;	
+			/* Pages dirtied since last GC_read_dirty. */
+# endif
+# ifdef PROC_VDB
+    page_hash_table _written_pages;	/* Pages ever dirtied	*/
+# endif
+# ifdef LARGE_CONFIG
+#   if CPP_WORDSZ > 32
+#     define MAX_HEAP_SECTS 4096 	/* overflows at roughly 64 GB	   */
+#   else
+#     define MAX_HEAP_SECTS 768		/* Separately added heap sections. */
+#   endif
+# else
+#   define MAX_HEAP_SECTS 256
+# endif
+  struct HeapSect {
+      ptr_t hs_start; word hs_bytes;
+  } _heap_sects[MAX_HEAP_SECTS];
+# ifdef MSWIN32
+    ptr_t _heap_bases[MAX_HEAP_SECTS];
+    		/* Start address of memory regions obtained from kernel. */
+# endif
+  struct roots _static_roots[MAX_ROOT_SETS];
+# ifndef MSWIN32
+    struct roots * _root_index[RT_SIZE];
+# endif
+  struct exclusion _excl_table[MAX_EXCLUSIONS];
+  /* Block header index; see gc_headers.h */
+  bottom_index * _all_nils;
+  bottom_index * _top_index [TOP_SZ];
+#ifdef SAVE_CALL_CHAIN
+  struct callinfo _last_stack[NFRAMES];	/* Stack at last garbage collection.*/
+  					/* Useful for debugging	mysterious  */
+  					/* object disappearances.	    */
+  					/* In the multithreaded case, we    */
+  					/* currently only save the calling  */
+  					/* stack.			    */
+#endif
+};
+
+GC_API GC_FAR struct _GC_arrays GC_arrays; 
+
+# define GC_objfreelist GC_arrays._objfreelist
+# define GC_aobjfreelist GC_arrays._aobjfreelist
+# define GC_uobjfreelist GC_arrays._uobjfreelist
+# ifdef ATOMIC_UNCOLLECTABLE
+#   define GC_auobjfreelist GC_arrays._auobjfreelist
+# endif
+# define GC_sobjfreelist GC_arrays._sobjfreelist
+# define GC_valid_offsets GC_arrays._valid_offsets
+# define GC_modws_valid_offsets GC_arrays._modws_valid_offsets
+# ifdef STUBBORN_ALLOC
+#    define GC_changed_pages GC_arrays._changed_pages
+#    define GC_prev_changed_pages GC_arrays._prev_changed_pages
+# endif
+# define GC_obj_map GC_arrays._obj_map
+# define GC_last_heap_addr GC_arrays._last_heap_addr
+# define GC_prev_heap_addr GC_arrays._prev_heap_addr
+# define GC_words_allocd GC_arrays._words_allocd
+# define GC_words_wasted GC_arrays._words_wasted
+# define GC_large_free_bytes GC_arrays._large_free_bytes
+# define GC_words_finalized GC_arrays._words_finalized
+# define GC_non_gc_bytes_at_gc GC_arrays._non_gc_bytes_at_gc
+# define GC_mem_freed GC_arrays._mem_freed
+# define GC_scratch_end_ptr GC_arrays._scratch_end_ptr
+# define GC_scratch_last_end_ptr GC_arrays._scratch_last_end_ptr
+# define GC_mark_procs GC_arrays._mark_procs
+# define GC_heapsize GC_arrays._heapsize
+# define GC_max_heapsize GC_arrays._max_heapsize
+# define GC_requested_heapsize GC_arrays._requested_heapsize
+# define GC_words_allocd_before_gc GC_arrays._words_allocd_before_gc
+# define GC_heap_sects GC_arrays._heap_sects
+# define GC_last_stack GC_arrays._last_stack
+# ifdef USE_MUNMAP
+#   define GC_unmapped_bytes GC_arrays._unmapped_bytes
+# endif
+# ifdef MSWIN32
+#   define GC_heap_bases GC_arrays._heap_bases
+# endif
+# define GC_static_roots GC_arrays._static_roots
+# define GC_root_index GC_arrays._root_index
+# define GC_excl_table GC_arrays._excl_table
+# define GC_all_nils GC_arrays._all_nils
+# define GC_top_index GC_arrays._top_index
+# if defined(PROC_VDB) || defined(MPROTECT_VDB)
+#   define GC_grungy_pages GC_arrays._grungy_pages
+# endif
+# ifdef MPROTECT_VDB
+#   define GC_dirty_pages GC_arrays._dirty_pages
+# endif
+# ifdef PROC_VDB
+#   define GC_written_pages GC_arrays._written_pages
+# endif
+# ifdef GATHERSTATS
+#   define GC_composite_in_use GC_arrays._composite_in_use
+#   define GC_atomic_in_use GC_arrays._atomic_in_use
+# endif
+# ifdef MERGE_SIZES
+#   define GC_size_map GC_arrays._size_map
+# endif
+
+# define beginGC_arrays ((ptr_t)(&GC_arrays))
+# define endGC_arrays (((ptr_t)(&GC_arrays)) + (sizeof GC_arrays))
+
+#define USED_HEAP_SIZE (GC_heapsize - GC_large_free_bytes)
+
+/* Object kinds: */
+# define MAXOBJKINDS 16
+
+extern struct obj_kind {
+   ptr_t *ok_freelist;	/* Array of free listheaders for this kind of object */
+   			/* Point either to GC_arrays or to storage allocated */
+   			/* with GC_scratch_alloc.			     */
+   struct hblk **ok_reclaim_list;
+   			/* List headers for lists of blocks waiting to be */
+   			/* swept.					  */
+   word ok_descriptor;  /* Descriptor template for objects in this	*/
+   			/* block.					*/
+   GC_bool ok_relocate_descr;
+   			/* Add object size in bytes to descriptor 	*/
+   			/* template to obtain descriptor.  Otherwise	*/
+   			/* template is used as is.			*/
+   GC_bool ok_init;   /* Clear objects before putting them on the free list. */
+} GC_obj_kinds[MAXOBJKINDS];
+
+# define endGC_obj_kinds (((ptr_t)(&GC_obj_kinds)) + (sizeof GC_obj_kinds))
+
+# define end_gc_area ((ptr_t)endGC_arrays == (ptr_t)(&GC_obj_kinds) ? \
+			endGC_obj_kinds : endGC_arrays)
+
+/* Predefined kinds: */
+# define PTRFREE 0
+# define NORMAL  1
+# define UNCOLLECTABLE 2
+# ifdef ATOMIC_UNCOLLECTABLE
+#   define AUNCOLLECTABLE 3
+#   define STUBBORN 4
+#   define IS_UNCOLLECTABLE(k) (((k) & ~1) == UNCOLLECTABLE)
+# else
+#   define STUBBORN 3
+#   define IS_UNCOLLECTABLE(k) ((k) == UNCOLLECTABLE)
+# endif
+
+extern int GC_n_kinds;
+
+GC_API word GC_fo_entries;
+
+extern word GC_n_heap_sects;	/* Number of separately added heap	*/
+				/* sections.				*/
+
+extern word GC_page_size;
+
+# ifdef MSWIN32
+extern word GC_n_heap_bases;	/* See GC_heap_bases.	*/
+# endif
+
+extern word GC_total_stack_black_listed;
+			/* Number of bytes on stack blacklist. 	*/
+
+extern word GC_black_list_spacing;
+			/* Average number of bytes between blacklisted	*/
+			/* blocks. Approximate.				*/
+			/* Counts only blocks that are 			*/
+			/* "stack-blacklisted", i.e. that are 		*/
+			/* problematic in the interior of an object.	*/
+
+extern char * GC_invalid_map;
+			/* Pointer to the nowhere valid hblk map */
+			/* Blocks pointing to this map are free. */
+
+extern struct hblk * GC_hblkfreelist[];
+				/* List of completely empty heap blocks	*/
+				/* Linked through hb_next field of 	*/
+				/* header structure associated with	*/
+				/* block.				*/
+
+extern GC_bool GC_is_initialized;	/* GC_init() has been run.	*/
+
+extern GC_bool GC_objects_are_marked;	/* There are marked objects in  */
+					/* the heap.			*/
+
+#ifndef SMALL_CONFIG
+  extern GC_bool GC_incremental;
+			/* Using incremental/generational collection. */
+#else
+# define GC_incremental FALSE
+			/* Hopefully allow optimizer to remove some code. */
+#endif
+
+extern GC_bool GC_dirty_maintained;
+				/* Dirty bits are being maintained, 	*/
+				/* either for incremental collection,	*/
+				/* or to limit the root set.		*/
+
+extern word GC_root_size;	/* Total size of registered root sections */
+
+extern GC_bool GC_debugging_started;	/* GC_debug_malloc has been called. */ 
+
+extern ptr_t GC_least_plausible_heap_addr;
+extern ptr_t GC_greatest_plausible_heap_addr;
+			/* Bounds on the heap.  Guaranteed valid	*/
+			/* Likely to include future heap expansion.	*/
+			
+/* Operations */
+# ifndef abs
+#   define abs(x)  ((x) < 0? (-(x)) : (x))
+# endif
+
+
+/*  Marks are in a reserved area in                          */
+/*  each heap block.  Each word has one mark bit associated  */
+/*  with it. Only those corresponding to the beginning of an */
+/*  object are used.                                         */
+
+
+/* Mark bit operations */
+
+/*
+ * Retrieve, set, clear the mark bit corresponding
+ * to the nth word in a given heap block.
+ *
+ * (Recall that bit n corresponds to object beginning at word n
+ * relative to the beginning of the block, including unused words)
+ */
+
+# define mark_bit_from_hdr(hhdr,n) (((hhdr)->hb_marks[divWORDSZ(n)] \
+			    >> (modWORDSZ(n))) & (word)1)
+# define set_mark_bit_from_hdr(hhdr,n) (hhdr)->hb_marks[divWORDSZ(n)] \
+				|= (word)1 << modWORDSZ(n)
+
+# define clear_mark_bit_from_hdr(hhdr,n) (hhdr)->hb_marks[divWORDSZ(n)] \
+				&= ~((word)1 << modWORDSZ(n))
+
+/* Important internal collector routines */
+
+ptr_t GC_approx_sp();
+
+GC_bool GC_should_collect();
+
+void GC_apply_to_all_blocks(/*fn, client_data*/);
+			/* Invoke fn(hbp, client_data) for each 	*/
+			/* allocated heap block.			*/
+struct hblk * GC_next_used_block(/* struct hblk * h */);
+			/* Return first in-use block >= h	*/
+struct hblk * GC_prev_block(/* struct hblk * h */);
+			/* Return last block <= h.  Returned block	*/
+			/* is managed by GC, but may or may not be in	*/
+			/* use.						*/
+void GC_mark_init();
+void GC_clear_marks();	/* Clear mark bits for all heap objects. */
+void GC_invalidate_mark_state();	/* Tell the marker that	marked 	   */
+					/* objects may point to	unmarked   */
+					/* ones, and roots may point to	   */
+					/* unmarked objects.		   */
+					/* Reset mark stack.		   */
+void GC_mark_from_mark_stack(); /* Mark from everything on the mark stack. */
+				/* Return after about one pages worth of   */
+				/* work.				   */
+GC_bool GC_mark_stack_empty();
+GC_bool GC_mark_some(/* cold_gc_frame */);
+			/* Perform about one pages worth of marking	*/
+			/* work of whatever kind is needed.  Returns	*/
+			/* quickly if no collection is in progress.	*/
+			/* Return TRUE if mark phase finished.		*/
+void GC_initiate_gc();		/* initiate collection.			*/
+				/* If the mark state is invalid, this	*/
+				/* becomes full colleection.  Otherwise */
+				/* it's partial.			*/
+void GC_push_all(/*b,t*/);	/* Push everything in a range 		*/
+				/* onto mark stack.			*/
+void GC_push_dirty(/*b,t*/);      /* Push all possibly changed	 	*/
+				  /* subintervals of [b,t) onto		*/
+				  /* mark stack.			*/
+#ifndef SMALL_CONFIG
+  void GC_push_conditional(/* ptr_t b, ptr_t t, GC_bool all*/);
+#else
+# define GC_push_conditional(b, t, all) GC_push_all(b, t)
+#endif
+                                /* Do either of the above, depending	*/
+				/* on the third arg.			*/
+void GC_push_all_stack(/*b,t*/);    /* As above, but consider		*/
+				    /*  interior pointers as valid  	*/
+void GC_push_all_eager(/*b,t*/);    /* Same as GC_push_all_stack, but   */
+				    /* ensures that stack is scanned	*/
+				    /* immediately, not just scheduled  */
+				    /* for scanning.			*/
+#ifndef THREADS
+  void GC_push_all_stack_partially_eager(/* bottom, top, cold_gc_frame */);
+			/* Similar to GC_push_all_eager, but only the	*/
+			/* part hotter than cold_gc_frame is scanned	*/
+			/* immediately.  Needed to endure that callee-	*/
+			/* save registers are not missed.		*/
+#else
+  /* In the threads case, we push part of the current thread stack	*/
+  /* with GC_push_all_eager when we push the registers.  This gets the  */
+  /* callee-save registers that may disappear.  The remainder of the	*/
+  /* stacks are scheduled for scanning in *GC_push_other_roots, which	*/
+  /* is thread-package-specific.					*/
+#endif
+void GC_push_current_stack(/* ptr_t cold_gc_frame */);
+			/* Push enough of the current stack eagerly to	*/
+			/* ensure that callee-save registers saved in	*/
+			/* GC frames are scanned.			*/
+			/* In the non-threads case, schedule entire	*/
+			/* stack for scanning.				*/
+void GC_push_roots(/* GC_bool all, ptr_t cold_gc_frame */);
+			/* Push all or dirty roots.	*/
+extern void (*GC_push_other_roots)();
+			/* Push system or application specific roots	*/
+			/* onto the mark stack.  In some environments	*/
+			/* (e.g. threads environments) this is		*/
+			/* predfined to be non-zero.  A client supplied */
+			/* replacement should also call the original	*/
+			/* function.					*/
+extern void (*GC_start_call_back)(/* void */);
+			/* Called at start of full collections.		*/
+			/* Not called if 0.  Called with allocation 	*/
+			/* lock held.					*/
+			/* 0 by default.				*/
+void GC_push_regs();	/* Push register contents onto mark stack.	*/
+			/* If NURSERY is defined, the default push	*/
+			/* action can be overridden with GC_push_proc	*/
+void GC_remark();	/* Mark from all marked objects.  Used	*/
+		 	/* only if we had to drop something.	*/
+
+# ifdef NURSERY
+    extern void (*GC_push_proc)(ptr_t);
+# endif
+# if defined(MSWIN32)
+  void __cdecl GC_push_one();
+# else
+  void GC_push_one(/*p*/);    /* If p points to an object, mark it    */
+                              /* and push contents on the mark stack  */
+# endif
+void GC_push_one_checked(/*p*/); /* Ditto, omits plausibility test	*/
+void GC_push_marked(/* struct hblk h, hdr * hhdr */);
+		/* Push contents of all marked objects in h onto	*/
+		/* mark stack.						*/
+#ifdef SMALL_CONFIG
+# define GC_push_next_marked_dirty(h) GC_push_next_marked(h)
+#else
+  struct hblk * GC_push_next_marked_dirty(/* h */);
+		/* Invoke GC_push_marked on next dirty block above h.	*/
+		/* Return a pointer just past the end of this block.	*/
+#endif /* !SMALL_CONFIG */
+struct hblk * GC_push_next_marked(/* h */);
+		/* Ditto, but also mark from clean pages.	*/
+struct hblk * GC_push_next_marked_uncollectable(/* h */);
+		/* Ditto, but mark only from uncollectable pages.	*/
+GC_bool GC_stopped_mark(); /* Stop world and mark from all roots	*/
+			/* and rescuers.			*/
+void GC_clear_hdr_marks(/* hhdr */);  /* Clear the mark bits in a header */
+void GC_set_hdr_marks(/* hhdr */);  /* Set the mark bits in a header */
+void GC_add_roots_inner();
+GC_bool GC_is_static_root(/* ptr_t p */);
+		/* Is the address p in one of the registered static	*/
+		/* root sections?					*/
+void GC_register_dynamic_libraries();
+		/* Add dynamic library data sections to the root set. */
+
+/* Machine dependent startup routines */
+ptr_t GC_get_stack_base();
+void GC_register_data_segments();
+
+/* Black listing: */
+void GC_bl_init(); 	
+# ifndef ALL_INTERIOR_POINTERS
+    void GC_add_to_black_list_normal(/* bits, maybe source */);
+			/* Register bits as a possible future false	*/
+			/* reference from the heap or static data	*/
+#   ifdef PRINT_BLACK_LIST
+#     define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+			GC_add_to_black_list_normal(bits, source)
+#   else
+#     define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+			GC_add_to_black_list_normal(bits)
+#   endif
+# else
+#   ifdef PRINT_BLACK_LIST
+#     define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+			GC_add_to_black_list_stack(bits, source)
+#   else
+#     define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+			GC_add_to_black_list_stack(bits)
+#   endif
+# endif
+
+void GC_add_to_black_list_stack(/* bits, maybe source */);
+struct hblk * GC_is_black_listed(/* h, len */);
+			/* If there are likely to be false references	*/
+			/* to a block starting at h of the indicated    */
+			/* length, then return the next plausible	*/
+			/* starting location for h that might avoid	*/
+			/* these false references.			*/
+void GC_promote_black_lists();
+			/* Declare an end to a black listing phase.	*/
+void GC_unpromote_black_lists();
+			/* Approximately undo the effect of the above.	*/
+			/* This actually loses some information, but	*/
+			/* only in a reasonably safe way.		*/
+word GC_number_stack_black_listed(/*struct hblk *start, struct hblk *endp1 */);
+			/* Return the number of (stack) blacklisted	*/
+			/* blocks in the range for statistical		*/
+			/* purposes.					*/
+		 	
+ptr_t GC_scratch_alloc(/*bytes*/);
+				/* GC internal memory allocation for	*/
+				/* small objects.  Deallocation is not  */
+				/* possible.				*/
+	
+/* Heap block layout maps: */			
+void GC_invalidate_map(/* hdr */);
+				/* Remove the object map associated	*/
+				/* with the block.  This identifies	*/
+				/* the block as invalid to the mark	*/
+				/* routines.				*/
+GC_bool GC_add_map_entry(/*sz*/);
+				/* Add a heap block map for objects of	*/
+				/* size sz to obj_map.			*/
+				/* Return FALSE on failure.		*/
+void GC_register_displacement_inner(/*offset*/);
+				/* Version of GC_register_displacement	*/
+				/* that assumes lock is already held	*/
+				/* and signals are already disabled.	*/
+
+/*  hblk allocation: */		
+void GC_new_hblk(/*size_in_words, kind*/);
+				/* Allocate a new heap block, and build */
+				/* a free list in it.			*/				
+struct hblk * GC_allochblk(/*size_in_words, kind*/);
+				/* Allocate a heap block, clear it if	*/
+				/* for composite objects, inform	*/
+				/* the marker that block is valid	*/
+				/* for objects of indicated size.	*/
+				/* sz < 0 ==> atomic.			*/ 
+void GC_freehblk();		/* Deallocate a heap block and mark it  */
+				/* as invalid.				*/
+				
+/*  Misc GC: */
+void GC_init_inner();
+GC_bool GC_expand_hp_inner();
+void GC_start_reclaim(/*abort_if_found*/);
+				/* Restore unmarked objects to free	*/
+				/* lists, or (if abort_if_found is	*/
+				/* TRUE) report them.			*/
+				/* Sweeping of small object pages is	*/
+				/* largely deferred.			*/
+void GC_continue_reclaim(/*size, kind*/);
+				/* Sweep pages of the given size and	*/
+				/* kind, as long as possible, and	*/
+				/* as long as the corr. free list is    */
+				/* empty.				*/
+void GC_reclaim_or_delete_all();
+				/* Arrange for all reclaim lists to be	*/
+				/* empty.  Judiciously choose between	*/
+				/* sweeping and discarding each page.	*/
+GC_bool GC_reclaim_all(/* GC_stop_func f*/);
+				/* Reclaim all blocks.  Abort (in a	*/
+				/* consistent state) if f returns TRUE. */
+GC_bool GC_block_empty(/* hhdr */); /* Block completely unmarked? 	*/
+GC_bool GC_never_stop_func();	/* Returns FALSE.		*/
+GC_bool GC_try_to_collect_inner(/* GC_stop_func f */);
+				/* Collect; caller must have acquired	*/
+				/* lock and disabled signals.		*/
+				/* Collection is aborted if f returns	*/
+				/* TRUE.  Returns TRUE if it completes	*/
+				/* successfully.			*/
+# define GC_gcollect_inner() \
+	(void) GC_try_to_collect_inner(GC_never_stop_func)
+void GC_finish_collection();	/* Finish collection.  Mark bits are	*/
+				/* consistent and lock is still held.	*/
+GC_bool GC_collect_or_expand(/* needed_blocks */);
+				/* Collect or expand heap in an attempt */
+				/* make the indicated number of free	*/
+				/* blocks available.  Should be called	*/
+				/* until the blocks are available or	*/
+				/* until it fails by returning FALSE.	*/
+GC_API void GC_init();		/* Initialize collector.		*/
+void GC_collect_a_little_inner(/* int n */);
+				/* Do n units worth of garbage 		*/
+				/* collection work, if appropriate.	*/
+				/* A unit is an amount appropriate for  */
+				/* HBLKSIZE bytes of allocation.	*/
+ptr_t GC_generic_malloc(/* bytes, kind */);
+				/* Allocate an object of the given	*/
+				/* kind.  By default, there are only	*/
+				/* a few kinds: composite(pointerfree), */
+				/* atomic, uncollectable, etc.		*/
+				/* We claim it's possible for clever	*/
+				/* client code that understands GC	*/
+				/* internals to add more, e.g. to	*/
+				/* communicate object layout info	*/
+				/* to the collector.			*/
+ptr_t GC_generic_malloc_ignore_off_page(/* bytes, kind */);
+				/* As above, but pointers past the 	*/
+				/* first page of the resulting object	*/
+				/* are ignored.				*/
+ptr_t GC_generic_malloc_inner(/* bytes, kind */);
+				/* Ditto, but I already hold lock, etc.	*/
+ptr_t GC_generic_malloc_words_small GC_PROTO((size_t words, int kind));
+				/* As above, but size in units of words */
+				/* Bypasses MERGE_SIZES.  Assumes	*/
+				/* words <= MAXOBJSZ.			*/
+ptr_t GC_generic_malloc_inner_ignore_off_page(/* bytes, kind */);
+				/* Allocate an object, where		*/
+				/* the client guarantees that there	*/
+				/* will always be a pointer to the 	*/
+				/* beginning of the object while the	*/
+				/* object is live.			*/
+ptr_t GC_allocobj(/* sz_inn_words, kind */);
+				/* Make the indicated 			*/
+				/* free list nonempty, and return its	*/
+				/* head.				*/
+
+void GC_init_headers();
+struct hblkhdr * GC_install_header(/*h*/);
+				/* Install a header for block h.	*/
+				/* Return 0 on failure, or the header	*/
+				/* otherwise.				*/
+GC_bool GC_install_counts(/*h, sz*/);
+				/* Set up forwarding counts for block	*/
+				/* h of size sz.			*/
+				/* Return FALSE on failure.		*/
+void GC_remove_header(/*h*/);
+				/* Remove the header for block h.	*/
+void GC_remove_counts(/*h, sz*/);
+				/* Remove forwarding counts for h.	*/
+hdr * GC_find_header(/*p*/);	/* Debugging only.			*/
+
+void GC_finalize();	/* Perform all indicated finalization actions	*/
+			/* on unmarked objects.				*/
+			/* Unreachable finalizable objects are enqueued	*/
+			/* for processing by GC_invoke_finalizers.	*/
+			/* Invoked with lock.				*/
+			
+void GC_add_to_heap(/*p, bytes*/);
+			/* Add a HBLKSIZE aligned chunk to the heap.	*/
+
+void GC_print_obj(/* ptr_t p */);
+			/* P points to somewhere inside an object with	*/
+			/* debugging info.  Print a human readable	*/
+			/* description of the object to stderr.		*/
+extern void (*GC_check_heap)();
+			/* Check that all objects in the heap with 	*/
+			/* debugging info are intact.  Print 		*/
+			/* descriptions of any that are not.		*/
+extern void (*GC_print_heap_obj)(/* ptr_t p */);
+			/* If possible print s followed by a more	*/
+			/* detailed description of the object 		*/
+			/* referred to by p.				*/
+			
+/* Memory unmapping: */
+#ifdef USE_MUNMAP
+  void GC_unmap_old(void);
+  void GC_merge_unmapped(void);
+  void GC_unmap(ptr_t start, word bytes);
+  void GC_remap(ptr_t start, word bytes);
+  void GC_unmap_gap(ptr_t start1, word bytes1, ptr_t start2, word bytes2);
+#endif
+
+/* Virtual dirty bit implementation:		*/
+/* Each implementation exports the following:	*/
+void GC_read_dirty();	/* Retrieve dirty bits.	*/
+GC_bool GC_page_was_dirty(/* struct hblk * h  */);
+			/* Read retrieved dirty bits.	*/
+GC_bool GC_page_was_ever_dirty(/* struct hblk * h  */);
+			/* Could the page contain valid heap pointers?	*/
+void GC_is_fresh(/* struct hblk * h, word number_of_blocks  */);
+			/* Assert the region currently contains no	*/
+			/* valid pointers.				*/
+void GC_write_hint(/* struct hblk * h  */);
+			/* h is about to be written.	*/
+void GC_dirty_init();
+
+/* Slow/general mark bit manipulation: */
+GC_API GC_bool GC_is_marked();
+void GC_clear_mark_bit();
+void GC_set_mark_bit();
+
+/* Stubborn objects: */
+void GC_read_changed();	/* Analogous to GC_read_dirty */
+GC_bool GC_page_was_changed(/* h */);	/* Analogous to GC_page_was_dirty */
+void GC_clean_changing_list();	/* Collect obsolete changing list entries */
+void GC_stubborn_init();
+
+/* Debugging print routines: */
+void GC_print_block_list();
+void GC_print_hblkfreelist();
+void GC_print_heap_sects();
+void GC_print_static_roots();
+void GC_dump();
+
+#ifdef KEEP_BACK_PTRS
+   void GC_store_back_pointer(ptr_t source, ptr_t dest);
+   void GC_marked_for_finalization(ptr_t dest);
+#  define GC_STORE_BACK_PTR(source, dest) GC_store_back_pointer(source, dest)
+#  define GC_MARKED_FOR_FINALIZATION(dest) GC_marked_for_finalization(dest)
+#else
+#  define GC_STORE_BACK_PTR(source, dest) 
+#  define GC_MARKED_FOR_FINALIZATION(dest)
+#endif
+
+/* Make arguments appear live to compiler */
+# ifdef __WATCOMC__
+  void GC_noop(void*, ...);
+# else
+  GC_API void GC_noop();
+# endif
+
+void GC_noop1(/* word arg */);
+
+/* Logging and diagnostic output: 	*/
+GC_API void GC_printf GC_PROTO((char * format, long, long, long, long, long, long));
+			/* A version of printf that doesn't allocate,	*/
+			/* is restricted to long arguments, and		*/
+			/* (unfortunately) doesn't use varargs for	*/
+			/* portability.  Restricted to 6 args and	*/
+			/* 1K total output length.			*/
+			/* (We use sprintf.  Hopefully that doesn't	*/
+			/* allocate for long arguments.)  		*/
+# define GC_printf0(f) GC_printf(f, 0l, 0l, 0l, 0l, 0l, 0l)
+# define GC_printf1(f,a) GC_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
+# define GC_printf2(f,a,b) GC_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
+# define GC_printf3(f,a,b,c) GC_printf(f, (long)a, (long)b, (long)c, 0l, 0l, 0l)
+# define GC_printf4(f,a,b,c,d) GC_printf(f, (long)a, (long)b, (long)c, \
+					    (long)d, 0l, 0l)
+# define GC_printf5(f,a,b,c,d,e) GC_printf(f, (long)a, (long)b, (long)c, \
+					      (long)d, (long)e, 0l)
+# define GC_printf6(f,a,b,c,d,e,g) GC_printf(f, (long)a, (long)b, (long)c, \
+						(long)d, (long)e, (long)g)
+
+void GC_err_printf(/* format, a, b, c, d, e, f */);
+# define GC_err_printf0(f) GC_err_puts(f)
+# define GC_err_printf1(f,a) GC_err_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
+# define GC_err_printf2(f,a,b) GC_err_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
+# define GC_err_printf3(f,a,b,c) GC_err_printf(f, (long)a, (long)b, (long)c, \
+						  0l, 0l, 0l)
+# define GC_err_printf4(f,a,b,c,d) GC_err_printf(f, (long)a, (long)b, \
+						    (long)c, (long)d, 0l, 0l)
+# define GC_err_printf5(f,a,b,c,d,e) GC_err_printf(f, (long)a, (long)b, \
+						      (long)c, (long)d, \
+						      (long)e, 0l)
+# define GC_err_printf6(f,a,b,c,d,e,g) GC_err_printf(f, (long)a, (long)b, \
+							(long)c, (long)d, \
+							(long)e, (long)g)
+			/* Ditto, writes to stderr.			*/
+			
+void GC_err_puts(/* char *s */);
+			/* Write s to stderr, don't buffer, don't add	*/
+			/* newlines, don't ...				*/
+
+
+#   ifdef GC_ASSERTIONS
+#	define GC_ASSERT(expr) if(!(expr)) {\
+		GC_err_printf2("Assertion failure: %s:%ld\n", \
+				__FILE__, (unsigned long)__LINE__); \
+		ABORT("assertion failure"); }
+#   else 
+#	define GC_ASSERT(expr)
+#   endif
+
+# endif /* GC_PRIVATE_H */
diff --git a/src/gc/include/private/gcconfig.h b/src/gc/include/private/gcconfig.h
new file mode 100644
index 000000000..045617a1d
--- /dev/null
+++ b/src/gc/include/private/gcconfig.h
@@ -0,0 +1,1327 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+ 
+#ifndef GCCONFIG_H
+
+# define GCCONFIG_H
+
+/* Machine dependent parameters.  Some tuning parameters can be found	*/
+/* near the top of gc_private.h.					*/
+
+/* Machine specific parts contributed by various people.  See README file. */
+
+/* First a unified test for Linux: */
+# if defined(linux) || defined(__linux__)
+#    define LINUX
+# endif
+
+/* Determine the machine type: */
+# if defined(sun) && defined(mc68000)
+#    define M68K
+#    define SUNOS4
+#    define mach_type_known
+# endif
+# if defined(hp9000s300)
+#    define M68K
+#    define HP
+#    define mach_type_known
+# endif
+# if defined(__OpenBSD__) && defined(m68k)
+#    define M68K
+#    define OPENBSD
+#    define mach_type_known
+# endif
+# if defined(__OpenBSD__) && defined(__sparc__)
+#    define SPARC
+#    define OPENBSD
+#    define mach_type_known
+# endif
+# if defined(__NetBSD__) && defined(m68k)
+#    define M68K
+#    define NETBSD
+#    define mach_type_known
+# endif
+# if defined(__NetBSD__) && defined(arm32)
+#    define ARM32
+#    define NETBSD
+#    define mach_type_known
+# endif
+# if defined(vax)
+#    define VAX
+#    ifdef ultrix
+#	define ULTRIX
+#    else
+#	define BSD
+#    endif
+#    define mach_type_known
+# endif
+# if defined(mips) || defined(__mips)
+#    define MIPS
+#    if !defined(LINUX)
+#      if defined(ultrix) || defined(__ultrix) || defined(__NetBSD__)
+#	 define ULTRIX
+#      else
+#	 if defined(_SYSTYPE_SVR4) || defined(SYSTYPE_SVR4) \
+	    || defined(__SYSTYPE_SVR4__)
+#	   define IRIX5   /* or IRIX 6.X */
+#	 else
+#	   define RISCOS  /* or IRIX 4.X */
+#	 endif
+#      endif
+#    endif /* !LINUX */
+#    define mach_type_known
+# endif
+# if defined(sequent) && defined(i386)
+#    define I386
+#    define SEQUENT
+#    define mach_type_known
+# endif
+# if defined(sun) && defined(i386)
+#    define I386
+#    define SUNOS5
+#    define mach_type_known
+# endif
+# if (defined(__OS2__) || defined(__EMX__)) && defined(__32BIT__)
+#    define I386
+#    define OS2
+#    define mach_type_known
+# endif
+# if defined(ibm032)
+#   define RT
+#   define mach_type_known
+# endif
+# if defined(sun) && (defined(sparc) || defined(__sparc))
+#   define SPARC
+    /* Test for SunOS 5.x */
+#     include <errno.h>
+#     ifdef ECHRNG
+#       define SUNOS5
+#     else
+#	define SUNOS4
+#     endif
+#   define mach_type_known
+# endif
+# if defined(sparc) && defined(unix) && !defined(sun) && !defined(linux) \
+     && !defined(__OpenBSD__)
+#   define SPARC
+#   define DRSNX
+#   define mach_type_known
+# endif
+# if defined(_IBMR2)
+#   define RS6000
+#   define mach_type_known
+# endif
+# if defined(_M_XENIX) && defined(_M_SYSV) && defined(_M_I386)
+	/* The above test may need refinement	*/
+#   define I386
+#   if defined(_SCO_ELF)
+#     define SCO_ELF
+#   else
+#     define SCO
+#   endif
+#   define mach_type_known
+# endif
+# if defined(_AUX_SOURCE)
+#   define M68K
+#   define SYSV
+#   define mach_type_known
+# endif
+# if defined(_PA_RISC1_0) || defined(_PA_RISC1_1) || defined(_PA_RISC2_0) \
+     || defined(hppa) || defined(__hppa__)
+#   define HP_PA
+#   ifndef LINUX
+#     define HPUX
+#   endif
+#   define mach_type_known
+# endif
+# if defined(LINUX) && (defined(i386) || defined(__i386__))
+#    define I386
+#    define mach_type_known
+# endif
+# if defined(LINUX) && (defined(__ia64__) || defined(__ia64))
+#    define IA64
+#    define mach_type_known
+# endif
+# if defined(LINUX) && defined(powerpc)
+#    define POWERPC
+#    define mach_type_known
+# endif
+# if defined(LINUX) && defined(__mc68000__)
+#    define M68K
+#    define mach_type_known
+# endif
+# if defined(LINUX) && (defined(sparc) || defined(__sparc__))
+#    define SPARC
+#    define mach_type_known
+# endif
+# if defined(LINUX) && defined(arm)
+#    define ARM32
+#    define mach_type_known
+# endif
+# if defined(__alpha) || defined(__alpha__)
+#   define ALPHA
+#   if !defined(LINUX)
+#     define OSF1	/* a.k.a Digital Unix */
+#   endif
+#   define mach_type_known
+# endif
+# if defined(_AMIGA) && !defined(AMIGA)
+#   define AMIGA
+# endif
+# ifdef AMIGA 
+#   define M68K
+#   define mach_type_known
+# endif
+# if defined(THINK_C) || defined(__MWERKS__) && !defined(__powerc)
+#   define M68K
+#   define MACOS
+#   define mach_type_known
+# endif
+# if defined(__MWERKS__) && defined(__powerc)
+#   define POWERPC
+#   define MACOS
+#   define mach_type_known
+# endif
+# if defined(macosx)
+#    define MACOSX
+#    define POWERPC
+#    define mach_type_known
+# endif
+# if defined(NeXT) && defined(mc68000)
+#   define M68K
+#   define NEXT
+#   define mach_type_known
+# endif
+# if defined(NeXT) && defined(i386)
+#   define I386
+#   define NEXT
+#   define mach_type_known
+# endif
+# if defined(__OpenBSD__) && defined(i386)
+#   define I386
+#   define OPENBSD
+#   define mach_type_known
+# endif
+# if defined(__FreeBSD__) && defined(i386)
+#   define I386
+#   define FREEBSD
+#   define mach_type_known
+# endif
+# if defined(__NetBSD__) && defined(i386)
+#   define I386
+#   define NETBSD
+#   define mach_type_known
+# endif
+# if defined(bsdi) && defined(i386)
+#    define I386
+#    define BSDI
+#    define mach_type_known
+# endif
+# if !defined(mach_type_known) && defined(__386BSD__)
+#   define I386
+#   define THREE86BSD
+#   define mach_type_known
+# endif
+# if defined(_CX_UX) && defined(_M88K)
+#   define M88K
+#   define CX_UX
+#   define mach_type_known
+# endif
+# if defined(DGUX)
+#   define M88K
+    /* DGUX defined */
+#   define mach_type_known
+# endif
+# if (defined(_MSDOS) || defined(_MSC_VER)) && (_M_IX86 >= 300) \
+     || defined(_WIN32) && !defined(__CYGWIN32__) && !defined(__CYGWIN__)
+#   define I386
+#   define MSWIN32	/* or Win32s */
+#   define mach_type_known
+# endif
+# if defined(__DJGPP__)
+#   define I386
+#   ifndef DJGPP
+#     define DJGPP  /* MSDOS running the DJGPP port of GCC */
+#   endif
+#   define mach_type_known
+# endif
+# if defined(__CYGWIN32__) || defined(__CYGWIN__)
+#   define I386
+#   define CYGWIN32
+#   define mach_type_known
+# endif
+# if defined(__MINGW32__)
+#   define I386
+#   define MSWIN32
+#   define mach_type_known
+# endif
+# if defined(__BORLANDC__)
+#   define I386
+#   define MSWIN32
+#   define mach_type_known
+# endif
+# if defined(_UTS) && !defined(mach_type_known)
+#   define S370
+#   define UTS4
+#   define mach_type_known
+# endif
+# if defined(__pj__)
+#   define PJ
+#   define mach_type_known
+# endif
+/* Ivan Demakov */
+# if defined(__WATCOMC__) && defined(__386__)
+#   define I386
+#   if !defined(OS2) && !defined(MSWIN32) && !defined(DOS4GW)
+#     if defined(__OS2__)
+#       define OS2
+#     else
+#       if defined(__WINDOWS_386__) || defined(__NT__)
+#         define MSWIN32
+#       else
+#         define DOS4GW
+#       endif
+#     endif
+#   endif
+#   define mach_type_known
+# endif
+
+/* Feel free to add more clauses here */
+
+/* Or manually define the machine type here.  A machine type is 	*/
+/* characterized by the architecture.  Some				*/
+/* machine types are further subdivided by OS.				*/
+/* the macros ULTRIX, RISCOS, and BSD to distinguish.			*/
+/* Note that SGI IRIX is treated identically to RISCOS.			*/
+/* SYSV on an M68K actually means A/UX.					*/
+/* The distinction in these cases is usually the stack starting address */
+# ifndef mach_type_known
+	--> unknown machine type
+# endif
+		    /* Mapping is: M68K       ==> Motorola 680X0	*/
+		    /*		   (SUNOS4,HP,NEXT, and SYSV (A/UX),	*/
+		    /*		   MACOS and AMIGA variants)		*/
+		    /*             I386       ==> Intel 386	 	*/
+		    /*		    (SEQUENT, OS2, SCO, LINUX, NETBSD,	*/
+		    /*		     FREEBSD, THREE86BSD, MSWIN32,	*/
+		    /* 		     BSDI,SUNOS5, NEXT, other variants)	*/
+                    /*             NS32K      ==> Encore Multimax 	*/
+                    /*             MIPS       ==> R2000 or R3000	*/
+                    /*			(RISCOS, ULTRIX variants)	*/
+                    /*		   VAX	      ==> DEC VAX		*/
+                    /*			(BSD, ULTRIX variants)		*/
+                    /*		   RS6000     ==> IBM RS/6000 AIX3.X	*/
+                    /*		   RT	      ==> IBM PC/RT		*/
+                    /*		   HP_PA      ==> HP9000/700 & /800	*/
+                    /*				  HP/UX			*/
+		    /*		   SPARC      ==> SPARC under SunOS	*/
+		    /*			(SUNOS4, SUNOS5,		*/
+		    /*			 DRSNX variants)		*/
+		    /* 		   ALPHA      ==> DEC Alpha 		*/
+		    /*			(OSF1 and LINUX variants)	*/
+		    /* 		   M88K       ==> Motorola 88XX0        */
+		    /* 		        (CX_UX and DGUX)		*/
+		    /* 		   S370	      ==> 370-like machine	*/
+		    /* 			running Amdahl UTS4		*/
+		    /* 		   ARM32      ==> Intel StrongARM	*/
+		    /* 		   IA64	      ==> Intel IA64		*/
+		    /*				  (e.g. Itanium)	*/
+
+
+/*
+ * For each architecture and OS, the following need to be defined:
+ *
+ * CPP_WORD_SZ is a simple integer constant representing the word size.
+ * in bits.  We assume byte addressibility, where a byte has 8 bits.
+ * We also assume CPP_WORD_SZ is either 32 or 64.
+ * (We care about the length of pointers, not hardware
+ * bus widths.  Thus a 64 bit processor with a C compiler that uses
+ * 32 bit pointers should use CPP_WORD_SZ of 32, not 64. Default is 32.)
+ *
+ * MACH_TYPE is a string representation of the machine type.
+ * OS_TYPE is analogous for the OS.
+ *
+ * ALIGNMENT is the largest N, such that
+ * all pointer are guaranteed to be aligned on N byte boundaries.
+ * defining it to be 1 will always work, but perform poorly.
+ *
+ * DATASTART is the beginning of the data segment.
+ * On UNIX systems, the collector will scan the area between DATASTART
+ * and DATAEND for root pointers.
+ *
+ * DATAEND, if not &end.
+ *
+ * ALIGN_DOUBLE of GC_malloc should return blocks aligned to twice
+ * the pointer size.
+ *
+ * STACKBOTTOM is the cool end of the stack, which is usually the
+ * highest address in the stack.
+ * Under PCR or OS/2, we have other ways of finding thread stacks.
+ * For each machine, the following should:
+ * 1) define STACK_GROWS_UP if the stack grows toward higher addresses, and
+ * 2) define exactly one of
+ *	STACKBOTTOM (should be defined to be an expression)
+ *	HEURISTIC1
+ *	HEURISTIC2
+ * If either of the last two macros are defined, then STACKBOTTOM is computed
+ * during collector startup using one of the following two heuristics:
+ * HEURISTIC1:  Take an address inside GC_init's frame, and round it up to
+ *		the next multiple of STACK_GRAN.
+ * HEURISTIC2:  Take an address inside GC_init's frame, increment it repeatedly
+ *		in small steps (decrement if STACK_GROWS_UP), and read the value
+ *		at each location.  Remember the value when the first
+ *		Segmentation violation or Bus error is signalled.  Round that
+ *		to the nearest plausible page boundary, and use that instead
+ *		of STACKBOTTOM.
+ *
+ * Gustavo Rodriguez-Rivera points out that on most (all?) Unix machines,
+ * the value of environ is a pointer that can serve as STACKBOTTOM.
+ * I expect that HEURISTIC2 can be replaced by this approach, which
+ * interferes far less with debugging. 
+ *
+ * If no expression for STACKBOTTOM can be found, and neither of the above
+ * heuristics are usable, the collector can still be used with all of the above
+ * undefined, provided one of the following is done:
+ * 1) GC_mark_roots can be changed to somehow mark from the correct stack(s)
+ *    without reference to STACKBOTTOM.  This is appropriate for use in
+ *    conjunction with thread packages, since there will be multiple stacks.
+ *    (Allocating thread stacks in the heap, and treating them as ordinary
+ *    heap data objects is also possible as a last resort.  However, this is
+ *    likely to introduce significant amounts of excess storage retention
+ *    unless the dead parts of the thread stacks are periodically cleared.)
+ * 2) Client code may set GC_stackbottom before calling any GC_ routines.
+ *    If the author of the client code controls the main program, this is
+ *    easily accomplished by introducing a new main program, setting
+ *    GC_stackbottom to the address of a local variable, and then calling
+ *    the original main program.  The new main program would read something
+ *    like:
+ *
+ *		# include "gc_private.h"
+ *
+ *		main(argc, argv, envp)
+ *		int argc;
+ *		char **argv, **envp;
+ *		{
+ *		    int dummy;
+ *
+ *		    GC_stackbottom = (ptr_t)(&dummy);
+ *		    return(real_main(argc, argv, envp));
+ *		}
+ *
+ *
+ * Each architecture may also define the style of virtual dirty bit
+ * implementation to be used:
+ *   MPROTECT_VDB: Write protect the heap and catch faults.
+ *   PROC_VDB: Use the SVR4 /proc primitives to read dirty bits.
+ *
+ * An architecture may define DYNAMIC_LOADING if dynamic_load.c
+ * defined GC_register_dynamic_libraries() for the architecture.
+ *
+ * An architecture may define PREFETCH(x) to preload the cache with *x.
+ * This defaults to a no-op.
+ *
+ * PREFETCH_FOR_WRITE(x) is used if *x is about to be written.
+ *
+ * An architecture may also define CLEAR_DOUBLE(x) to be a fast way to
+ * clear the two words at GC_malloc-aligned address x.  By default,
+ * word stores of 0 are used instead.
+ */
+
+
+# define STACK_GRAN 0x1000000
+# ifdef M68K
+#   define MACH_TYPE "M68K"
+#   define ALIGNMENT 2
+#   ifdef OPENBSD
+#	define OS_TYPE "OPENBSD"
+#	define HEURISTIC2
+	extern char etext;
+#	define DATASTART ((ptr_t)(&etext))
+#   endif
+#   ifdef NETBSD
+#	define OS_TYPE "NETBSD"
+#	define HEURISTIC2
+	extern char etext;
+#	define DATASTART ((ptr_t)(&etext))
+#   endif
+#   ifdef LINUX
+#       define OS_TYPE "LINUX"
+#       define STACKBOTTOM ((ptr_t)0xf0000000)
+#       define MPROTECT_VDB
+#       ifdef __ELF__
+#            define DYNAMIC_LOADING
+             extern char **__environ;
+#            define DATASTART ((ptr_t)(&__environ))
+                             /* hideous kludge: __environ is the first */
+                             /* word in crt0.o, and delimits the start */
+                             /* of the data segment, no matter which   */
+                             /* ld options were passed through.        */
+                             /* We could use _etext instead, but that  */
+                             /* would include .rodata, which may       */
+                             /* contain large read-only data tables    */
+                             /* that we'd rather not scan.             */
+             extern int _end;
+#            define DATAEND (&_end)
+#       else
+             extern int etext;
+#            define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       endif
+#   endif
+#   ifdef SUNOS4
+#	define OS_TYPE "SUNOS4"
+	extern char etext;
+#	define DATASTART ((ptr_t)((((word) (&etext)) + 0x1ffff) & ~0x1ffff))
+#	define HEURISTIC1	/* differs	*/
+#	define DYNAMIC_LOADING
+#   endif
+#   ifdef HP
+#	define OS_TYPE "HP"
+	extern char etext;
+#       define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       define STACKBOTTOM ((ptr_t) 0xffeffffc)
+			      /* empirically determined.  seems to work. */
+#  	include <unistd.h>
+#	define GETPAGESIZE() sysconf(_SC_PAGE_SIZE)
+#   endif
+#   ifdef SYSV
+#	define OS_TYPE "SYSV"
+	extern etext;
+#   	define DATASTART ((ptr_t)((((word) (&etext)) + 0x3fffff) \
+				   & ~0x3fffff) \
+				  +((word)&etext & 0x1fff))
+	/* This only works for shared-text binaries with magic number 0413.
+	   The other sorts of SysV binaries put the data at the end of the text,
+	   in which case the default of &etext would work.  Unfortunately,
+	   handling both would require having the magic-number available.
+	   	   		-- Parag
+	   */
+#	define STACKBOTTOM ((ptr_t)0xFFFFFFFE)
+			/* The stack starts at the top of memory, but   */
+			/* 0x0 cannot be used as setjump_test complains */
+			/* that the stack direction is incorrect.  Two  */
+			/* bytes down from 0x0 should be safe enough.   */
+			/* 		--Parag				*/
+#   	include <sys/mmu.h>
+#	define GETPAGESIZE() PAGESIZE	/* Is this still right? */
+#   endif
+#   ifdef AMIGA
+#	define OS_TYPE "AMIGA"
+ 	    	/* STACKBOTTOM and DATASTART handled specially	*/
+ 	    	/* in os_dep.c					*/
+# 	define DATAEND	/* not needed */
+#	define GETPAGESIZE() 4096
+#   endif
+#   ifdef MACOS
+#     ifndef __LOWMEM__
+#     include <LowMem.h>
+#     endif
+#     define OS_TYPE "MACOS"
+			/* see os_dep.c for details of global data segments. */
+#     define STACKBOTTOM ((ptr_t) LMGetCurStackBase())
+#     define DATAEND	/* not needed */
+#     define GETPAGESIZE() 4096
+#   endif
+#   ifdef NEXT
+#	define OS_TYPE "NEXT"
+#	define DATASTART ((ptr_t) get_etext())
+#	define STACKBOTTOM ((ptr_t) 0x4000000)
+#	define DATAEND	/* not needed */
+#   endif
+# endif
+
+# ifdef POWERPC
+#   define MACH_TYPE "POWERPC"
+#   ifdef MACOS
+#     define ALIGNMENT 2  /* Still necessary?  Could it be 4?	*/
+#     ifndef __LOWMEM__
+#     include <LowMem.h>
+#     endif
+#     define OS_TYPE "MACOS"
+			/* see os_dep.c for details of global data segments. */
+#     define STACKBOTTOM ((ptr_t) LMGetCurStackBase())
+#     define DATAEND  /* not needed */
+#   endif
+#   ifdef LINUX
+#     define ALIGNMENT 4	/* Guess.  Can someone verify?	*/
+				/* This was 2, but that didn't sound right. */
+#     define OS_TYPE "LINUX"
+#     define HEURISTIC1
+#     define DYNAMIC_LOADING
+#     undef STACK_GRAN
+#     define STACK_GRAN 0x10000000
+	/* Stack usually starts at 0x80000000 */
+#     define LINUX_DATA_START
+      extern int _end;
+#     define DATAEND (&_end)
+#   endif
+#   ifdef MACOSX
+#     define ALIGNMENT 4
+#     define OS_TYPE "MACOSX"
+#     define DATASTART ((ptr_t) get_etext())
+#     define STACKBOTTOM ((ptr_t) 0xc0000000)
+#     define DATAEND	/* not needed */
+#   endif
+# endif
+
+# ifdef VAX
+#   define MACH_TYPE "VAX"
+#   define ALIGNMENT 4	/* Pointers are longword aligned by 4.2 C compiler */
+    extern char etext;
+#   define DATASTART ((ptr_t)(&etext))
+#   ifdef BSD
+#	define OS_TYPE "BSD"
+#	define HEURISTIC1
+			/* HEURISTIC2 may be OK, but it's hard to test. */
+#   endif
+#   ifdef ULTRIX
+#	define OS_TYPE "ULTRIX"
+#	define STACKBOTTOM ((ptr_t) 0x7fffc800)
+#   endif
+# endif
+
+# ifdef RT
+#   define MACH_TYPE "RT"
+#   define ALIGNMENT 4
+#   define DATASTART ((ptr_t) 0x10000000)
+#   define STACKBOTTOM ((ptr_t) 0x1fffd800)
+# endif
+
+# ifdef SPARC
+#   define MACH_TYPE "SPARC"
+#   define ALIGNMENT 4	/* Required by hardware	*/
+#   define ALIGN_DOUBLE
+    extern int etext;
+#   ifdef SUNOS5
+#	define OS_TYPE "SUNOS5"
+	extern int _etext;
+	extern int _end;
+	extern char * GC_SysVGetDataStart();
+#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &_etext)
+#	define DATAEND (&_end)
+#	ifndef USE_MMAP
+#	    define USE_MMAP
+#	endif
+#       ifdef USE_MMAP
+#         define HEAP_START (ptr_t)0x40000000
+#       else
+#	  define HEAP_START DATAEND
+#       endif
+#	define PROC_VDB
+/*	HEURISTIC1 reportedly no longer works under 2.7.  Thus we	*/
+/* 	switched to HEURISTIC2, eventhough it creates some debugging	*/
+/*	issues.								*/
+#	define HEURISTIC2
+#	include <unistd.h>
+#       define GETPAGESIZE()  sysconf(_SC_PAGESIZE)
+		/* getpagesize() appeared to be missing from at least one */
+		/* Solaris 5.4 installation.  Weird.			  */
+#	define DYNAMIC_LOADING
+#   endif
+#   ifdef SUNOS4
+#	define OS_TYPE "SUNOS4"
+	/* [If you have a weak stomach, don't read this.]		*/
+	/* We would like to use:					*/
+/* #       define DATASTART ((ptr_t)((((word) (&etext)) + 0x1fff) & ~0x1fff)) */
+	/* This fails occasionally, due to an ancient, but very 	*/
+	/* persistent ld bug.  &etext is set 32 bytes too high.		*/
+	/* We instead read the text segment size from the a.out		*/
+	/* header, which happens to be mapped into our address space	*/
+	/* at the start of the text segment.  The detective work here	*/
+	/* was done by Robert Ehrlich, Manuel Serrano, and Bernard	*/
+	/* Serpette of INRIA.						*/
+	/* This assumes ZMAGIC, i.e. demand-loadable executables.	*/
+#	define TEXTSTART 0x2000
+#       define DATASTART ((ptr_t)(*(int *)(TEXTSTART+0x4)+TEXTSTART))
+#	define MPROTECT_VDB
+#	define HEURISTIC1
+# 	define DYNAMIC_LOADING
+#   endif
+#   ifdef DRSNX
+#       define CPP_WORDSZ 32
+#	define OS_TYPE "DRSNX"
+	extern char * GC_SysVGetDataStart();
+	extern int etext;
+#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &etext)
+#	define MPROTECT_VDB
+#       define STACKBOTTOM ((ptr_t) 0xdfff0000)
+#	define DYNAMIC_LOADING
+#   endif
+#   ifdef LINUX
+#     define OS_TYPE "LINUX"
+#     ifdef __ELF__
+#       define LINUX_DATA_START
+#       define DYNAMIC_LOADING
+#     else
+          Linux Sparc non elf ?
+#     endif
+      extern int _end;
+#     define DATAEND (&_end)
+#     define SVR4
+#     define STACKBOTTOM ((ptr_t) 0xf0000000)
+#   endif
+#   ifdef OPENBSD
+#     define OS_TYPE "OPENBSD"
+#     define STACKBOTTOM ((ptr_t) 0xf8000000)
+#     define DATASTART ((ptr_t)(&etext))
+#   endif
+# endif
+
+# ifdef I386
+#   define MACH_TYPE "I386"
+#   define ALIGNMENT 4	/* Appears to hold for all "32 bit" compilers	*/
+			/* except Borland.  The -a4 option fixes 	*/
+			/* Borland.					*/
+                        /* Ivan Demakov: For Watcom the option is -zp4. */
+#   ifndef SMALL_CONFIG
+#     define ALIGN_DOUBLE /* Not strictly necessary, but may give speed   */
+			  /* improvement on Pentiums.			  */
+#   endif
+#   ifdef SEQUENT
+#	define OS_TYPE "SEQUENT"
+	extern int etext;
+#       define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       define STACKBOTTOM ((ptr_t) 0x3ffff000) 
+#   endif
+#   ifdef SUNOS5
+#	define OS_TYPE "SUNOS5"
+  	extern int etext, _start;
+  	extern char * GC_SysVGetDataStart();
+#       define DATASTART GC_SysVGetDataStart(0x1000, &etext)
+#	define STACKBOTTOM ((ptr_t)(&_start))
+/** At least in Solaris 2.5, PROC_VDB gives wrong values for dirty bits. */
+/*#	define PROC_VDB*/
+#	define DYNAMIC_LOADING
+#	ifndef USE_MMAP
+#	    define USE_MMAP
+#	endif
+#       ifdef USE_MMAP
+#         define HEAP_START (ptr_t)0x40000000
+#       else
+#	  define HEAP_START DATAEND
+#       endif
+#   endif
+#   ifdef SCO
+#	define OS_TYPE "SCO"
+	extern int etext;
+#   	define DATASTART ((ptr_t)((((word) (&etext)) + 0x3fffff) \
+				  & ~0x3fffff) \
+				 +((word)&etext & 0xfff))
+#	define STACKBOTTOM ((ptr_t) 0x7ffffffc)
+#   endif
+#   ifdef SCO_ELF
+#       define OS_TYPE "SCO_ELF"
+        extern int etext;
+#       define DATASTART ((ptr_t)(&etext))
+#       define STACKBOTTOM ((ptr_t) 0x08048000)
+#       define DYNAMIC_LOADING
+#	define ELF_CLASS ELFCLASS32
+#   endif
+#   ifdef LINUX
+#	define OS_TYPE "LINUX"
+#       define LINUX_STACKBOTTOM
+#	if 0
+#	  define HEURISTIC1
+#         undef STACK_GRAN
+#         define STACK_GRAN 0x10000000
+	  /* STACKBOTTOM is usually 0xc0000000, but this changes with	*/
+	  /* different kernel configurations.  In particular, systems	*/
+	  /* with 2GB physical memory will usually move the user	*/
+	  /* address space limit, and hence initial SP to 0x80000000.	*/
+#       endif
+#       if !defined(LINUX_THREADS) || !defined(REDIRECT_MALLOC)
+#	    define MPROTECT_VDB
+#	else
+	    /* We seem to get random errors in incremental mode,	*/
+	    /* possibly because Linux threads is itself a malloc client */
+	    /* and can't deal with the signals.				*/
+#	endif
+#       ifdef __ELF__
+#            define DYNAMIC_LOADING
+#	     ifdef UNDEFINED	/* includes ro data */
+	       extern int _etext;
+#              define DATASTART ((ptr_t)((((word) (&_etext)) + 0xfff) & ~0xfff))
+#	     endif
+#	     include <features.h>
+#	     if defined(__GLIBC__) && __GLIBC__ >= 2
+#		 define LINUX_DATA_START
+#	     else
+     	         extern char **__environ;
+#                define DATASTART ((ptr_t)(&__environ))
+			      /* hideous kludge: __environ is the first */
+			      /* word in crt0.o, and delimits the start */
+			      /* of the data segment, no matter which   */
+			      /* ld options were passed through.        */
+			      /* We could use _etext instead, but that  */
+			      /* would include .rodata, which may       */
+			      /* contain large read-only data tables    */
+			      /* that we'd rather not scan.		*/
+#	     endif
+	     extern int _end;
+#	     define DATAEND (&_end)
+#	else
+	     extern int etext;
+#            define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       endif
+#	ifdef USE_I686_PREFETCH
+#	  define PREFETCH(x) \
+	    __asm__ __volatile__ ("	prefetchnta	%0": : "m"(*(char *)(x)))
+	    /* Empirically prefetcht0 is much more effective at reducing	*/
+	    /* cache miss stalls for the targetted load instructions.  But it	*/
+	    /* seems to interfere enough with other cache traffic that the net	*/
+	    /* result is worse than prefetchnta.				*/
+#         if 0 
+	    /* Using prefetches for write seems to have a slight negative	*/
+	    /* impact on performance, at least for a PIII/500.			*/
+#	    define PREFETCH_FOR_WRITE(x) \
+	      __asm__ __volatile__ ("	prefetcht0	%0": : "m"(*(char *)(x)))
+#	  endif
+#	endif
+#	ifdef USE_3DNOW_PREFETCH
+#	  define PREFETCH(x) \
+	    __asm__ __volatile__ ("	prefetch	%0": : "m"(*(char *)(x)))
+#	  define PREFETCH_FOR_WRITE(x) 
+	    __asm__ __volatile__ ("	prefetchw	%0": : "m"(*(char *)(x)))
+#	endif
+#   endif
+#   ifdef CYGWIN32
+#       define OS_TYPE "CYGWIN32"
+          extern int _data_start__;
+          extern int _data_end__;
+          extern int _bss_start__;
+          extern int _bss_end__;
+  	/* For binutils 2.9.1, we have			*/
+  	/*	DATASTART   = _data_start__		*/
+  	/*	DATAEND	    = _bss_end__		*/
+  	/* whereas for some earlier versions it was	*/
+  	/*	DATASTART   = _bss_start__		*/
+  	/*	DATAEND	    = _data_end__		*/
+  	/* To get it right for both, we take the	*/
+  	/* minumum/maximum of the two.			*/
+#   	define MAX(x,y) ((x) > (y) ? (x) : (y))
+#   	define MIN(x,y) ((x) < (y) ? (x) : (y))
+#       define DATASTART ((ptr_t) MIN(&_data_start__, &_bss_start__))
+#       define DATAEND	 ((ptr_t) MAX(&_data_end__, &_bss_end__))
+#	undef STACK_GRAN
+#       define STACK_GRAN 0x10000
+#       define HEURISTIC1
+#   endif
+#   ifdef OS2
+#	define OS_TYPE "OS2"
+ 	    	/* STACKBOTTOM and DATASTART are handled specially in 	*/
+		/* os_dep.c. OS2 actually has the right			*/
+		/* system call!						*/
+#	define DATAEND	/* not needed */
+#   endif
+#   ifdef MSWIN32
+#	define OS_TYPE "MSWIN32"
+		/* STACKBOTTOM and DATASTART are handled specially in 	*/
+		/* os_dep.c.						*/
+#       ifndef __WATCOMC__
+#	  define MPROTECT_VDB
+#	endif
+#       define DATAEND  /* not needed */
+#   endif
+#   ifdef DJGPP
+#       define OS_TYPE "DJGPP"
+#       include "stubinfo.h"
+        extern int etext;
+        extern int _stklen;
+        extern int __djgpp_stack_limit;
+#       define DATASTART ((ptr_t)((((word) (&etext)) + 0x1ff) & ~0x1ff))
+/* #       define STACKBOTTOM ((ptr_t)((word) _stubinfo + _stubinfo->size \
+                                                     + _stklen)) */
+#       define STACKBOTTOM ((ptr_t)((word) __djgpp_stack_limit + _stklen))
+		/* This may not be right.  */
+#   endif
+#   ifdef OPENBSD
+#	define OS_TYPE "OPENBSD"
+#   endif
+#   ifdef FREEBSD
+#	define OS_TYPE "FREEBSD"
+#	define MPROTECT_VDB
+#   endif
+#   ifdef NETBSD
+#	define OS_TYPE "NETBSD"
+#   endif
+#   ifdef THREE86BSD
+#	define OS_TYPE "THREE86BSD"
+#   endif
+#   ifdef BSDI
+#	define OS_TYPE "BSDI"
+#   endif
+#   if defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD) \
+        || defined(THREE86BSD) || defined(BSDI)
+#	define HEURISTIC2
+	extern char etext;
+#	define DATASTART ((ptr_t)(&etext))
+#   endif
+#   ifdef NEXT
+#	define OS_TYPE "NEXT"
+#	define DATASTART ((ptr_t) get_etext())
+#	define STACKBOTTOM ((ptr_t)0xc0000000)
+#	define DATAEND	/* not needed */
+#   endif
+#   ifdef DOS4GW
+#     define OS_TYPE "DOS4GW"
+      extern long __nullarea;
+      extern char _end;
+      extern char *_STACKTOP;
+      /* Depending on calling conventions Watcom C either precedes
+         or does not precedes with undescore names of C-variables.
+         Make sure startup code variables always have the same names.  */
+      #pragma aux __nullarea "*";
+      #pragma aux _end "*";
+#     define STACKBOTTOM ((ptr_t) _STACKTOP)
+                         /* confused? me too. */
+#     define DATASTART ((ptr_t) &__nullarea)
+#     define DATAEND ((ptr_t) &_end)
+#   endif
+# endif
+
+# ifdef NS32K
+#   define MACH_TYPE "NS32K"
+#   define ALIGNMENT 4
+    extern char **environ;
+#   define DATASTART ((ptr_t)(&environ))
+			      /* hideous kludge: environ is the first   */
+			      /* word in crt0.o, and delimits the start */
+			      /* of the data segment, no matter which   */
+			      /* ld options were passed through.        */
+#   define STACKBOTTOM ((ptr_t) 0xfffff000) /* for Encore */
+# endif
+
+# ifdef MIPS
+#   define MACH_TYPE "MIPS"
+/* #   define STACKBOTTOM ((ptr_t)0x7fff8000)  sometimes also works.  */
+#   ifdef LINUX
+      /* This was developed for a linuxce style platform.  Probably	*/
+      /* needs to be tweaked for workstation class machines.		*/
+#     define OS_TYPE "LINUX"
+      extern int __data_start;
+#     define DATASTART ((ptr_t)(&__data_start))
+#     define ALIGNMENT 4
+#     define USE_GENERIC_PUSH_REGS 1
+#     define STACKBOTTOM 0x80000000
+	/* In many cases, this should probably use LINUX_STACKBOTTOM 	*/
+	/* instead. But some kernel versions seem to give the wrong	*/
+	/* value from /proc.						*/
+#   endif /* Linux */
+#   ifdef ULTRIX
+#	define HEURISTIC2
+#       define DATASTART (ptr_t)0x10000000
+			      /* Could probably be slightly higher since */
+			      /* startup code allocates lots of stuff.   */
+#	define OS_TYPE "ULTRIX"
+#       define ALIGNMENT 4
+#   endif
+#   ifdef RISCOS
+#	define HEURISTIC2
+#       define DATASTART (ptr_t)0x10000000
+#	define OS_TYPE "RISCOS"
+#   	define ALIGNMENT 4  /* Required by hardware */
+#   endif
+#   ifdef IRIX5
+#	define HEURISTIC2
+        extern int _fdata;
+#       define DATASTART ((ptr_t)(&_fdata))
+#       ifdef USE_MMAP
+#         define HEAP_START (ptr_t)0x30000000
+#       else
+#	  define HEAP_START DATASTART
+#       endif
+			      /* Lowest plausible heap address.		*/
+			      /* In the MMAP case, we map there.	*/
+			      /* In either case it is used to identify	*/
+			      /* heap sections so they're not 		*/
+			      /* considered as roots.			*/
+#	define OS_TYPE "IRIX5"
+#       define MPROTECT_VDB
+#       ifdef _MIPS_SZPTR
+#	  define CPP_WORDSZ _MIPS_SZPTR
+#	  define ALIGNMENT (_MIPS_SZPTR/8)
+#	  if CPP_WORDSZ != 64
+#	    define ALIGN_DOUBLE
+#	  endif
+#	else
+#         define ALIGNMENT 4
+#	  define ALIGN_DOUBLE
+#	endif
+#	define DYNAMIC_LOADING
+#   endif
+# endif
+
+# ifdef RS6000
+#   define MACH_TYPE "RS6000"
+#   define ALIGNMENT 4
+#   define DATASTART ((ptr_t)0x20000000)
+    extern int errno;
+#   define STACKBOTTOM ((ptr_t)((ulong)&errno))
+#   define DYNAMIC_LOADING
+	/* For really old versions of AIX, this may have to be removed. */
+# endif
+
+# ifdef HP_PA
+    /* OS is assumed to be HP/UX	*/
+#   define MACH_TYPE "HP_PA"
+#   define OS_TYPE "HPUX"
+#   ifdef __LP64__
+#     define CPP_WORDSZ 64
+#     define ALIGNMENT 8
+#   else
+#     define CPP_WORDSZ 32
+#     define ALIGNMENT 4
+#     define ALIGN_DOUBLE
+#   endif
+    extern int __data_start;
+#   define DATASTART ((ptr_t)(&__data_start))
+#   if 0
+	/* The following appears to work for 7xx systems running HP/UX	*/
+	/* 9.xx Furthermore, it might result in much faster		*/
+	/* collections than HEURISTIC2, which may involve scanning	*/
+	/* segments that directly precede the stack.  It is not the	*/
+	/* default, since it may not work on older machine/OS		*/
+	/* combinations. (Thanks to Raymond X.T. Nijssen for uncovering	*/
+	/* this.)							*/
+#       define STACKBOTTOM ((ptr_t) 0x7b033000)  /* from /etc/conf/h/param.h */
+#   else
+	/* Gustavo Rodriguez-Rivera suggested changing HEURISTIC2	*/
+	/* to this.  We'll probably do this on other platforms, too.	*/
+	/* For now I'll use it where I can test it.			*/
+	extern char ** environ;
+#       define STACKBOTTOM ((ptr_t)environ)
+#   endif
+#   define STACK_GROWS_UP
+#   define DYNAMIC_LOADING
+#   ifndef HPUX_THREADS
+#     define MPROTECT_VDB
+#   endif
+#   include <unistd.h>
+#   define GETPAGESIZE() sysconf(_SC_PAGE_SIZE)
+# endif
+
+# ifdef ALPHA
+#   define MACH_TYPE "ALPHA"
+#   define ALIGNMENT 8
+#   define USE_GENERIC_PUSH_REGS
+	/* Gcc and probably the DEC/Compaq compiler spill pointers to preserved	*/
+	/* fp registers in some cases when the target is a 21264.  The assembly	*/
+	/* code doesn't handle that yet, and version dependencies make that a	*/
+	/* bit tricky.  Do the easy thing for now.				*/
+#   ifdef OSF1
+#	define OS_TYPE "OSF1"
+#   	define DATASTART ((ptr_t) 0x140000000)
+	extern _end;
+#   	define DATAEND ((ptr_t) &_end)
+#   	define HEURISTIC2
+	/* Normally HEURISTIC2 is too conervative, since		*/
+	/* the text segment immediately follows the stack.		*/
+	/* Hence we give an upper pound.				*/
+    	extern int __start;
+#   	define HEURISTIC2_LIMIT ((ptr_t)((word)(&__start) & ~(getpagesize()-1)))
+#   	define CPP_WORDSZ 64
+#   	define MPROTECT_VDB
+#   	define DYNAMIC_LOADING
+#   endif
+#   ifdef LINUX
+#       define OS_TYPE "LINUX"
+#       define CPP_WORDSZ 64
+#       define STACKBOTTOM ((ptr_t) 0x120000000)
+#       ifdef __ELF__
+#	  define LINUX_DATA_START
+#         define DYNAMIC_LOADING
+	  /* This doesn't work if the collector is in a dynamic library. */
+#       else
+#           define DATASTART ((ptr_t) 0x140000000)
+#       endif
+	extern int _end;
+#	define DATAEND (&_end)
+#	define MPROTECT_VDB
+		/* Has only been superficially tested.  May not	*/
+		/* work on all versions.			*/
+#   endif
+# endif
+
+# ifdef IA64
+#   define MACH_TYPE "IA64"
+#   define ALIGN_DOUBLE
+	/* Requires 16 byte alignment for malloc */
+#   define ALIGNMENT 8
+#   define USE_GENERIC_PUSH_REGS
+	/* We need to get preserved registers in addition to register windows.	*/
+	/* That's easiest to do with setjmp.					*/
+#   ifdef HPUX
+	--> needs work
+#   endif
+#   ifdef LINUX
+#       define OS_TYPE "LINUX"
+#       define CPP_WORDSZ 64
+	/* This should really be done through /proc, but that	*/
+	/* requires we run on an IA64 kernel.			*/
+#       define STACKBOTTOM ((ptr_t) 0xa000000000000000l)
+	/* We also need the base address of the register stack	*/
+	/* backing store.  There is probably a better way to	*/
+	/* get that, too ...					*/
+#	define BACKING_STORE_BASE ((ptr_t) 0x9fffffff80000000l)
+#	if 1
+#	    define SEARCH_FOR_DATA_START
+#	    define DATASTART GC_data_start
+#	else
+	    extern int data_start;
+#	    define DATASTART ((ptr_t)(&data_start))
+#	endif
+#       define DYNAMIC_LOADING
+#	define MPROTECT_VDB
+		/* Requires Linux 2.3.47 or later.	*/
+	extern int _end;
+#	define DATAEND (&_end)
+#	define PREFETCH(x) \
+	  __asm__ ("	lfetch	[%0]": : "r"((void *)(x)))
+#	define PREFETCH_FOR_WRITE(x) \
+	  __asm__ ("	lfetch.excl	[%0]": : "r"((void *)(x)))
+#	define CLEAR_DOUBLE(x) \
+	  __asm__ ("	stf.spill	[%0]=f0": : "r"((void *)(x)))
+#   endif
+# endif
+
+# ifdef M88K
+#   define MACH_TYPE "M88K"
+#   define ALIGNMENT 4
+#   define ALIGN_DOUBLE
+    extern int etext;
+#   ifdef CX_UX
+#	define OS_TYPE "CX_UX"
+#       define DATASTART ((((word)&etext + 0x3fffff) & ~0x3fffff) + 0x10000)
+#   endif
+#   ifdef  DGUX
+#	define OS_TYPE "DGUX"
+	extern char * GC_SysVGetDataStart();
+#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &etext)
+#   endif
+#   define STACKBOTTOM ((char*)0xf0000000) /* determined empirically */
+# endif
+
+# ifdef S370
+#   define MACH_TYPE "S370"
+#   define OS_TYPE "UTS4"
+#   define ALIGNMENT 4	/* Required by hardware	*/
+    extern int etext;
+	extern int _etext;
+	extern int _end;
+	extern char * GC_SysVGetDataStart();
+#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &_etext)
+#	define DATAEND (&_end)
+#	define HEURISTIC2
+# endif
+
+# if defined(PJ)
+#   define ALIGNMENT 4
+    extern int _etext;
+#   define DATASTART ((ptr_t)(&_etext))
+#   define HEURISTIC1
+# endif
+
+# ifdef ARM32
+#   define CPP_WORDSZ 32
+#   define MACH_TYPE "ARM32"
+#   define ALIGNMENT 4
+#   ifdef NETBSD
+#       define OS_TYPE "NETBSD"
+#       define HEURISTIC2
+        extern char etext;
+#       define DATASTART ((ptr_t)(&etext))
+#       define USE_GENERIC_PUSH_REGS
+#   endif
+#   ifdef LINUX
+#       define OS_TYPE "LINUX"
+#       define HEURISTIC1
+#       undef STACK_GRAN
+#       define STACK_GRAN 0x10000000
+#       define USE_GENERIC_PUSH_REGS
+#       ifdef __ELF__
+#            define DYNAMIC_LOADING
+#	     include <features.h>
+#	     if defined(__GLIBC__) && __GLIBC__ >= 2
+#		 define LINUX_DATA_START
+#	     else
+     	         extern char **__environ;
+#                define DATASTART ((ptr_t)(&__environ))
+			      /* hideous kludge: __environ is the first */
+			      /* word in crt0.o, and delimits the start */
+			      /* of the data segment, no matter which   */
+			      /* ld options were passed through.        */
+			      /* We could use _etext instead, but that  */
+			      /* would include .rodata, which may       */
+			      /* contain large read-only data tables    */
+			      /* that we'd rather not scan.		*/
+#	     endif
+	     extern int _end;
+#	     define DATAEND (&_end)
+#	else
+	     extern int etext;
+#            define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
+#       endif
+#   endif
+#endif
+
+#ifdef LINUX_DATA_START
+    /* Some Linux distributions arrange to define __data_start.  Some	*/
+    /* define data_start as a weak symbol.  The latter is technically	*/
+    /* broken, since the user program may define data_start, in which	*/
+    /* case we lose.  Nonetheless, we try both, prefering __data_start.	*/
+    /* We assume gcc.	*/
+#   pragma weak __data_start
+    extern int __data_start;
+#   pragma weak data_start
+    extern int data_start;
+#   define DATASTART ((ptr_t)(&__data_start != 0? &__data_start : &data_start))
+#endif
+
+# ifndef STACK_GROWS_UP
+#   define STACK_GROWS_DOWN
+# endif
+
+# ifndef CPP_WORDSZ
+#   define CPP_WORDSZ 32
+# endif
+
+# ifndef OS_TYPE
+#   define OS_TYPE ""
+# endif
+
+# ifndef DATAEND
+    extern int end;
+#   define DATAEND (&end)
+# endif
+
+# if defined(SVR4) && !defined(GETPAGESIZE)
+#    include <unistd.h>
+#    define GETPAGESIZE()  sysconf(_SC_PAGESIZE)
+# endif
+
+# ifndef GETPAGESIZE
+#   if defined(SUNOS5) || defined(IRIX5)
+#	include <unistd.h>
+#   endif
+#   define GETPAGESIZE() getpagesize()
+# endif
+
+# if defined(SUNOS5) || defined(DRSNX) || defined(UTS4)
+    /* OS has SVR4 generic features.  Probably others also qualify.	*/
+#   define SVR4
+# endif
+
+# if defined(SUNOS5) || defined(DRSNX)
+    /* OS has SUNOS5 style semi-undocumented interface to dynamic 	*/
+    /* loader.								*/
+#   define SUNOS5DL
+    /* OS has SUNOS5 style signal handlers.				*/
+#   define SUNOS5SIGS
+# endif
+
+# if defined(HPUX)
+#   define SUNOS5SIGS
+# endif
+
+# if CPP_WORDSZ != 32 && CPP_WORDSZ != 64
+   -> bad word size
+# endif
+
+# ifdef PCR
+#   undef DYNAMIC_LOADING
+#   undef STACKBOTTOM
+#   undef HEURISTIC1
+#   undef HEURISTIC2
+#   undef PROC_VDB
+#   undef MPROTECT_VDB
+#   define PCR_VDB
+# endif
+
+# ifdef SRC_M3
+/* Postponed for now. */
+#   undef PROC_VDB
+#   undef MPROTECT_VDB
+# endif
+
+# ifdef SMALL_CONFIG
+/* Presumably not worth the space it takes. */
+#   undef PROC_VDB
+#   undef MPROTECT_VDB
+# endif
+
+# ifdef USE_MUNMAP
+#   undef MPROTECT_VDB  /* Can't deal with address space holes. */
+# endif
+
+# if !defined(PCR_VDB) && !defined(PROC_VDB) && !defined(MPROTECT_VDB)
+#   define DEFAULT_VDB
+# endif
+
+# ifndef PREFETCH
+#   define PREFETCH(x)
+#   define NO_PREFETCH
+# endif
+
+# ifndef PREFETCH_FOR_WRITE
+#   define PREFETCH_FOR_WRITE(x)
+#   define NO_PREFETCH_FOR_WRITE
+# endif
+
+# ifndef CACHE_LINE_SIZE
+#   define CACHE_LINE_SIZE 32	/* Wild guess	*/
+# endif
+
+# ifndef CLEAR_DOUBLE
+#   define CLEAR_DOUBLE(x) \
+	((word*)x)[0] = 0; \
+	((word*)x)[1] = 0;
+# endif /* CLEAR_DOUBLE */
+
+# if defined(_SOLARIS_PTHREADS) && !defined(SOLARIS_THREADS)
+#   define SOLARIS_THREADS
+# endif
+# if defined(IRIX_THREADS) && !defined(IRIX5)
+--> inconsistent configuration
+# endif
+# if defined(IRIX_JDK_THREADS) && !defined(IRIX5)
+--> inconsistent configuration
+# endif
+# if defined(LINUX_THREADS) && !defined(LINUX)
+--> inconsistent configuration
+# endif
+# if defined(SOLARIS_THREADS) && !defined(SUNOS5)
+--> inconsistent configuration
+# endif
+# if defined(HPUX_THREADS) && !defined(HPUX)
+--> inconsistent configuration
+# endif
+# if defined(PCR) || defined(SRC_M3) || \
+	defined(SOLARIS_THREADS) || defined(WIN32_THREADS) || \
+	defined(IRIX_THREADS) || defined(LINUX_THREADS) || \
+	defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
+#   define THREADS
+# endif
+
+# if defined(HP_PA) || defined(M88K) || defined(POWERPC) \
+     || (defined(I386) && defined(OS2)) || defined(UTS4) || defined(LINT)
+	/* Use setjmp based hack to mark from callee-save registers. */
+#	define USE_GENERIC_PUSH_REGS
+# endif
+# if defined(SPARC) && !defined(LINUX)
+#   define SAVE_CALL_CHAIN
+#   define ASM_CLEAR_CODE	/* Stack clearing is crucial, and we 	*/
+				/* include assembly code to do it well.	*/
+# endif
+
+# endif /* GCCONFIG_H */
diff --git a/src/gc/include/weakpointer.h b/src/gc/include/weakpointer.h
new file mode 100644
index 000000000..84906b00a
--- /dev/null
+++ b/src/gc/include/weakpointer.h
@@ -0,0 +1,221 @@
+#ifndef	_weakpointer_h_
+#define	_weakpointer_h_
+
+/****************************************************************************
+
+WeakPointer and CleanUp
+
+    Copyright (c) 1991 by Xerox Corporation.  All rights reserved.
+
+    THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+    OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+
+    Permission is hereby granted to copy this code for any purpose,
+    provided the above notices are retained on all copies.
+
+    Last modified on Mon Jul 17 18:16:01 PDT 1995 by ellis
+
+****************************************************************************/
+
+/****************************************************************************
+
+WeakPointer
+
+A weak pointer is a pointer to a heap-allocated object that doesn't
+prevent the object from being garbage collected. Weak pointers can be
+used to track which objects haven't yet been reclaimed by the
+collector. A weak pointer is deactivated when the collector discovers
+its referent object is unreachable by normal pointers (reachability
+and deactivation are defined more precisely below). A deactivated weak
+pointer remains deactivated forever.
+
+****************************************************************************/
+
+
+template< class T > class WeakPointer {
+public:
+
+WeakPointer( T* t = 0 )
+    /* Constructs a weak pointer for *t. t may be null. It is an error
+       if t is non-null and *t is not a collected object. */
+    {impl = _WeakPointer_New( t );}
+
+T* Pointer()
+    /* wp.Pointer() returns a pointer to the referent object of wp or
+       null if wp has been deactivated (because its referent object
+       has been discovered unreachable by the collector). */
+    {return (T*) _WeakPointer_Pointer( this->impl );}
+
+int operator==( WeakPointer< T > wp2 )
+    /* Given weak pointers wp1 and wp2, if wp1 == wp2, then wp1 and
+       wp2 refer to the same object. If wp1 != wp2, then either wp1
+       and wp2 don't refer to the same object, or if they do, one or
+       both of them has been deactivated. (Note: If objects t1 and t2
+       are never made reachable by their clean-up functions, then
+       WeakPointer<T>(t1) == WeakPointer<T>(t2) if and only t1 == t2.) */
+    {return _WeakPointer_Equal( this->impl, wp2.impl );}
+
+int Hash()
+    /* Returns a hash code suitable for use by multiplicative- and
+       division-based hash tables. If wp1 == wp2, then wp1.Hash() ==
+       wp2.Hash(). */
+    {return _WeakPointer_Hash( this->impl );}
+
+private:
+void* impl;
+};
+
+/*****************************************************************************
+
+CleanUp
+
+A garbage-collected object can have an associated clean-up function
+that will be invoked some time after the collector discovers the
+object is unreachable via normal pointers. Clean-up functions can be
+used to release resources such as open-file handles or window handles
+when their containing objects become unreachable.  If a C++ object has
+a non-empty explicit destructor (i.e. it contains programmer-written
+code), the destructor will be automatically registered as the object's
+initial clean-up function.
+
+There is no guarantee that the collector will detect every unreachable
+object (though it will find almost all of them). Clients should not
+rely on clean-up to cause some action to occur immediately -- clean-up
+is only a mechanism for improving resource usage.
+
+Every object with a clean-up function also has a clean-up queue. When
+the collector finds the object is unreachable, it enqueues it on its
+queue. The clean-up function is applied when the object is removed
+from the queue. By default, objects are enqueued on the garbage
+collector's queue, and the collector removes all objects from its
+queue after each collection. If a client supplies another queue for
+objects, it is his responsibility to remove objects (and cause their
+functions to be called) by polling it periodically.
+
+Clean-up queues allow clean-up functions accessing global data to
+synchronize with the main program. Garbage collection can occur at any
+time, and clean-ups invoked by the collector might access data in an
+inconsistent state. A client can control this by defining an explicit
+queue for objects and polling it at safe points.
+
+The following definitions are used by the specification below:
+
+Given a pointer t to a collected object, the base object BO(t) is the
+value returned by new when it created the object. (Because of multiple
+inheritance, t and BO(t) may not be the same address.)
+
+A weak pointer wp references an object *t if BO(wp.Pointer()) ==
+BO(t).
+
+***************************************************************************/
+
+template< class T, class Data > class CleanUp {
+public:
+
+static void Set( T* t, void c( Data* d, T* t ), Data* d = 0 )
+    /* Sets the clean-up function of object BO(t) to be <c, d>,
+       replacing any previously defined clean-up function for BO(t); c
+       and d can be null, but t cannot. Sets the clean-up queue for
+       BO(t) to be the collector's queue. When t is removed from its
+       clean-up queue, its clean-up will be applied by calling c(d,
+       t). It is an error if *t is not a collected object. */ 
+       {_CleanUp_Set( t, c, d );}
+
+static void Call( T* t )
+    /* Sets the new clean-up function for BO(t) to be null and, if the
+       old one is non-null, calls it immediately, even if BO(t) is
+       still reachable. Deactivates any weak pointers to BO(t). */
+       {_CleanUp_Call( t );}
+
+class Queue {public:
+    Queue()
+        /* Constructs a new queue. */
+            {this->head = _CleanUp_Queue_NewHead();}
+
+    void Set( T* t )
+        /* q.Set(t) sets the clean-up queue of BO(t) to be q. */
+            {_CleanUp_Queue_Set( this->head, t );}
+
+    int Call()
+        /* If q is non-empty, q.Call() removes the first object and
+           calls its clean-up function; does nothing if q is
+           empty. Returns true if there are more objects in the
+           queue. */
+           {return _CleanUp_Queue_Call( this->head );}
+
+    private:
+    void* head;
+    };
+};
+
+/**********************************************************************
+
+Reachability and Clean-up
+
+An object O is reachable if it can be reached via a non-empty path of
+normal pointers from the registers, stacks, global variables, or an
+object with a non-null clean-up function (including O itself),
+ignoring pointers from an object to itself.
+
+This definition of reachability ensures that if object B is accessible
+from object A (and not vice versa) and if both A and B have clean-up
+functions, then A will always be cleaned up before B. Note that as
+long as an object with a clean-up function is contained in a cycle of
+pointers, it will always be reachable and will never be cleaned up or
+collected.
+
+When the collector finds an unreachable object with a null clean-up
+function, it atomically deactivates all weak pointers referencing the
+object and recycles its storage. If object B is accessible from object
+A via a path of normal pointers, A will be discovered unreachable no
+later than B, and a weak pointer to A will be deactivated no later
+than a weak pointer to B.
+
+When the collector finds an unreachable object with a non-null
+clean-up function, the collector atomically deactivates all weak
+pointers referencing the object, redefines its clean-up function to be
+null, and enqueues it on its clean-up queue. The object then becomes
+reachable again and remains reachable at least until its clean-up
+function executes.
+
+The clean-up function is assured that its argument is the only
+accessible pointer to the object. Nothing prevents the function from
+redefining the object's clean-up function or making the object
+reachable again (for example, by storing the pointer in a global
+variable).
+
+If the clean-up function does not make its object reachable again and
+does not redefine its clean-up function, then the object will be
+collected by a subsequent collection (because the object remains
+unreachable and now has a null clean-up function). If the clean-up
+function does make its object reachable again and a clean-up function
+is subsequently redefined for the object, then the new clean-up
+function will be invoked the next time the collector finds the object
+unreachable.
+
+Note that a destructor for a collected object cannot safely redefine a
+clean-up function for its object, since after the destructor executes,
+the object has been destroyed into "raw memory". (In most
+implementations, destroying an object mutates its vtbl.)
+
+Finally, note that calling delete t on a collected object first
+deactivates any weak pointers to t and then invokes its clean-up
+function (destructor).
+
+**********************************************************************/
+
+extern "C" {
+    void* _WeakPointer_New( void* t );
+    void* _WeakPointer_Pointer( void* wp );
+    int _WeakPointer_Equal( void* wp1, void* wp2 );
+    int _WeakPointer_Hash( void* wp );
+    void _CleanUp_Set( void* t, void (*c)( void* d, void* t ), void* d );
+    void _CleanUp_Call( void* t );
+    void* _CleanUp_Queue_NewHead ();
+    void _CleanUp_Queue_Set( void* h, void* t );
+    int _CleanUp_Queue_Call( void* h );
+}
+
+#endif /* _weakpointer_h_ */
+
+
diff --git a/src/gc/linux_threads.c b/src/gc/linux_threads.c
new file mode 100644
index 000000000..4b8088231
--- /dev/null
+++ b/src/gc/linux_threads.c
@@ -0,0 +1,765 @@
+/* 
+ * Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1998 by Fergus Henderson.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Support code for LinuxThreads, the clone()-based kernel
+ * thread package for Linux which is included in libc6.
+ *
+ * This code relies on implementation details of LinuxThreads,
+ * (i.e. properties not guaranteed by the Pthread standard):
+ *
+ *	- the function GC_linux_thread_top_of_stack(void)
+ *	  relies on the way LinuxThreads lays out thread stacks
+ *	  in the address space.
+ *
+ * Note that there is a lot of code duplication between linux_threads.c
+ * and irix_threads.c; any changes made here may need to be reflected
+ * there too.
+ */
+
+/* #define DEBUG_THREADS 1 */
+
+/* ANSI C requires that a compilation unit contains something */
+# include "gc_priv.h"
+
+# if defined(LINUX_THREADS)
+
+# include <pthread.h>
+# include <sched.h>
+# include <time.h>
+# include <errno.h>
+# include <unistd.h>
+# include <sys/mman.h>
+# include <sys/time.h>
+# include <semaphore.h>
+# include <signal.h>
+
+#ifdef USE_LD_WRAP
+#   define WRAP_FUNC(f) __wrap_##f
+#   define REAL_FUNC(f) __real_##f
+#else
+#   define WRAP_FUNC(f) GC_##f
+#   define REAL_FUNC(f) f
+#   undef pthread_create
+#   undef pthread_sigmask
+#   undef pthread_join
+#endif
+
+
+void GC_thr_init();
+
+#if 0
+void GC_print_sig_mask()
+{
+    sigset_t blocked;
+    int i;
+
+    if (pthread_sigmask(SIG_BLOCK, NULL, &blocked) != 0)
+    	ABORT("pthread_sigmask");
+    GC_printf0("Blocked: ");
+    for (i = 1; i <= MAXSIG; i++) {
+        if (sigismember(&blocked, i)) { GC_printf1("%ld ",(long) i); }
+    }
+    GC_printf0("\n");
+}
+#endif
+
+/* We use the allocation lock to protect thread-related data structures. */
+
+/* The set of all known threads.  We intercept thread creation and 	*/
+/* joins.  We never actually create detached threads.  We allocate all 	*/
+/* new thread stacks ourselves.  These allow us to maintain this	*/
+/* data structure.							*/
+/* Protected by GC_thr_lock.						*/
+/* Some of this should be declared volatile, but that's incosnsistent	*/
+/* with some library routine declarations.  		 		*/
+typedef struct GC_Thread_Rep {
+    struct GC_Thread_Rep * next;  /* More recently allocated threads	*/
+				  /* with a given pthread id come 	*/
+				  /* first.  (All but the first are	*/
+				  /* guaranteed to be dead, but we may  */
+				  /* not yet have registered the join.) */
+    pthread_t id;
+    word flags;
+#	define FINISHED 1   	/* Thread has exited.	*/
+#	define DETACHED 2	/* Thread is intended to be detached.	*/
+#	define MAIN_THREAD 4	/* True for the original thread only.	*/
+
+    ptr_t stack_end;		/* Cold end of the stack.		*/
+    ptr_t stack_ptr;  		/* Valid only when stopped.      	*/
+#   ifdef IA64
+	ptr_t backing_store_end;
+	ptr_t backing_store_ptr;
+#   endif
+    int	signal;
+    void * status;		/* The value returned from the thread.  */
+    				/* Used only to avoid premature 	*/
+				/* reclamation of any data it might 	*/
+				/* reference.				*/
+} * GC_thread;
+
+GC_thread GC_lookup_thread(pthread_t id);
+
+/*
+ * The only way to suspend threads given the pthread interface is to send
+ * signals.  We can't use SIGSTOP directly, because we need to get the
+ * thread to save its stack pointer in the GC thread table before
+ * suspending.  So we have to reserve a signal of our own for this.
+ * This means we have to intercept client calls to change the signal mask.
+ * The linuxthreads package already uses SIGUSR1 and SIGUSR2,
+ * so we need to reuse something else.  I chose SIGPWR.
+ * (Perhaps SIGUNUSED would be a better choice.)
+ */
+#define SIG_SUSPEND SIGPWR
+
+#define SIG_RESTART SIGXCPU
+
+sem_t GC_suspend_ack_sem;
+
+/*
+GC_linux_thread_top_of_stack() relies on implementation details of
+LinuxThreads, namely that thread stacks are allocated on 2M boundaries
+and grow to no more than 2M.
+To make sure that we're using LinuxThreads and not some other thread
+package, we generate a dummy reference to `pthread_kill_other_threads_np'
+(was `__pthread_initial_thread_bos' but that disappeared),
+which is a symbol defined in LinuxThreads, but (hopefully) not in other
+thread packages.
+*/
+void (*dummy_var_to_force_linux_threads)() = pthread_kill_other_threads_np;
+
+#define LINUX_THREADS_STACK_SIZE  (2 * 1024 * 1024)
+
+static inline ptr_t GC_linux_thread_top_of_stack(void)
+{
+  char *sp = GC_approx_sp();
+  ptr_t tos = (ptr_t) (((unsigned long)sp | (LINUX_THREADS_STACK_SIZE - 1)) + 1);
+#if DEBUG_THREADS
+  GC_printf1("SP = %lx\n", (unsigned long)sp);
+  GC_printf1("TOS = %lx\n", (unsigned long)tos);
+#endif
+  return tos;
+}
+
+#ifdef IA64
+  extern word GC_save_regs_in_stack();
+#endif
+
+void GC_suspend_handler(int sig)
+{
+    int dummy;
+    pthread_t my_thread = pthread_self();
+    GC_thread me;
+    sigset_t all_sigs;
+    sigset_t old_sigs;
+    int i;
+    sigset_t mask;
+
+    if (sig != SIG_SUSPEND) ABORT("Bad signal in suspend_handler");
+
+#if DEBUG_THREADS
+    GC_printf1("Suspending 0x%x\n", my_thread);
+#endif
+
+    me = GC_lookup_thread(my_thread);
+    /* The lookup here is safe, since I'm doing this on behalf  */
+    /* of a thread which holds the allocation lock in order	*/
+    /* to stop the world.  Thus concurrent modification of the	*/
+    /* data structure is impossible.				*/
+    me -> stack_ptr = (ptr_t)(&dummy);
+#   ifdef IA64
+	me -> backing_store_ptr = (ptr_t)GC_save_regs_in_stack();
+#   endif
+
+    /* Tell the thread that wants to stop the world that this   */
+    /* thread has been stopped.  Note that sem_post() is  	*/
+    /* the only async-signal-safe primitive in LinuxThreads.    */
+    sem_post(&GC_suspend_ack_sem);
+
+    /* Wait until that thread tells us to restart by sending    */
+    /* this thread a SIG_RESTART signal.			*/
+    /* SIG_RESTART should be masked at this point.  Thus there	*/
+    /* is no race.						*/
+    if (sigfillset(&mask) != 0) ABORT("sigfillset() failed");
+    if (sigdelset(&mask, SIG_RESTART) != 0) ABORT("sigdelset() failed");
+#   ifdef NO_SIGNALS
+      if (sigdelset(&mask, SIGINT) != 0) ABORT("sigdelset() failed");
+      if (sigdelset(&mask, SIGQUIT) != 0) ABORT("sigdelset() failed");
+      if (sigdelset(&mask, SIGTERM) != 0) ABORT("sigdelset() failed");
+#   endif
+    do {
+	    me->signal = 0;
+	    sigsuspend(&mask);             /* Wait for signal */
+    } while (me->signal != SIG_RESTART);
+
+#if DEBUG_THREADS
+    GC_printf1("Continuing 0x%x\n", my_thread);
+#endif
+}
+
+void GC_restart_handler(int sig)
+{
+    GC_thread me;
+
+    if (sig != SIG_RESTART) ABORT("Bad signal in suspend_handler");
+
+    /* Let the GC_suspend_handler() know that we got a SIG_RESTART. */
+    /* The lookup here is safe, since I'm doing this on behalf  */
+    /* of a thread which holds the allocation lock in order	*/
+    /* to stop the world.  Thus concurrent modification of the	*/
+    /* data structure is impossible.				*/
+    me = GC_lookup_thread(pthread_self());
+    me->signal = SIG_RESTART;
+
+    /*
+    ** Note: even if we didn't do anything useful here,
+    ** it would still be necessary to have a signal handler,
+    ** rather than ignoring the signals, otherwise
+    ** the signals will not be delivered at all, and
+    ** will thus not interrupt the sigsuspend() above.
+    */
+
+#if DEBUG_THREADS
+    GC_printf1("In GC_restart_handler for 0x%x\n", pthread_self());
+#endif
+}
+
+GC_bool GC_thr_initialized = FALSE;
+
+# define THREAD_TABLE_SZ 128	/* Must be power of 2	*/
+volatile GC_thread GC_threads[THREAD_TABLE_SZ];
+
+/* Add a thread to GC_threads.  We assume it wasn't already there.	*/
+/* Caller holds allocation lock.					*/
+GC_thread GC_new_thread(pthread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    GC_thread result;
+    static struct GC_Thread_Rep first_thread;
+    static GC_bool first_thread_used = FALSE;
+    
+    if (!first_thread_used) {
+    	result = &first_thread;
+    	first_thread_used = TRUE;
+    	/* Dont acquire allocation lock, since we may already hold it. */
+    } else {
+        result = (struct GC_Thread_Rep *)
+        	 GC_generic_malloc_inner(sizeof(struct GC_Thread_Rep), NORMAL);
+    }
+    if (result == 0) return(0);
+    result -> id = id;
+    result -> next = GC_threads[hv];
+    GC_threads[hv] = result;
+    /* result -> flags = 0; */
+    return(result);
+}
+
+/* Delete a thread from GC_threads.  We assume it is there.	*/
+/* (The code intentionally traps if it wasn't.)			*/
+/* Caller holds allocation lock.				*/
+void GC_delete_thread(pthread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    register GC_thread prev = 0;
+    
+    while (!pthread_equal(p -> id, id)) {
+        prev = p;
+        p = p -> next;
+    }
+    if (prev == 0) {
+        GC_threads[hv] = p -> next;
+    } else {
+        prev -> next = p -> next;
+    }
+}
+
+/* If a thread has been joined, but we have not yet		*/
+/* been notified, then there may be more than one thread 	*/
+/* in the table with the same pthread id.			*/
+/* This is OK, but we need a way to delete a specific one.	*/
+void GC_delete_gc_thread(pthread_t id, GC_thread gc_id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    register GC_thread prev = 0;
+
+    while (p != gc_id) {
+        prev = p;
+        p = p -> next;
+    }
+    if (prev == 0) {
+        GC_threads[hv] = p -> next;
+    } else {
+        prev -> next = p -> next;
+    }
+}
+
+/* Return a GC_thread corresponding to a given thread_t.	*/
+/* Returns 0 if it's not there.					*/
+/* Caller holds  allocation lock or otherwise inhibits 		*/
+/* updates.							*/
+/* If there is more than one thread with the given id we 	*/
+/* return the most recent one.					*/
+GC_thread GC_lookup_thread(pthread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    
+    while (p != 0 && !pthread_equal(p -> id, id)) p = p -> next;
+    return(p);
+}
+
+/* Caller holds allocation lock.	*/
+void GC_stop_world()
+{
+    pthread_t my_thread = pthread_self();
+    register int i;
+    register GC_thread p;
+    register int n_live_threads = 0;
+    register int result;
+
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> id != my_thread) {
+            if (p -> flags & FINISHED) continue;
+            n_live_threads++;
+	    #if DEBUG_THREADS
+	      GC_printf1("Sending suspend signal to 0x%x\n", p -> id);
+	    #endif
+            result = pthread_kill(p -> id, SIG_SUSPEND);
+	    switch(result) {
+                case ESRCH:
+                    /* Not really there anymore.  Possible? */
+                    n_live_threads--;
+                    break;
+                case 0:
+                    break;
+                default:
+                    ABORT("pthread_kill failed");
+            }
+        }
+      }
+    }
+    for (i = 0; i < n_live_threads; i++) {
+    	sem_wait(&GC_suspend_ack_sem);
+    }
+    #if DEBUG_THREADS
+    GC_printf1("World stopped 0x%x\n", pthread_self());
+    #endif
+}
+
+/* Caller holds allocation lock.	*/
+void GC_start_world()
+{
+    pthread_t my_thread = pthread_self();
+    register int i;
+    register GC_thread p;
+    register int n_live_threads = 0;
+    register int result;
+    
+#   if DEBUG_THREADS
+      GC_printf0("World starting\n");
+#   endif
+
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> id != my_thread) {
+            if (p -> flags & FINISHED) continue;
+            n_live_threads++;
+	    #if DEBUG_THREADS
+	      GC_printf1("Sending restart signal to 0x%x\n", p -> id);
+	    #endif
+            result = pthread_kill(p -> id, SIG_RESTART);
+	    switch(result) {
+                case ESRCH:
+                    /* Not really there anymore.  Possible? */
+                    n_live_threads--;
+                    break;
+                case 0:
+                    break;
+                default:
+                    ABORT("pthread_kill failed");
+            }
+        }
+      }
+    }
+    #if DEBUG_THREADS
+      GC_printf0("World started\n");
+    #endif
+}
+
+# ifdef IA64
+#   define IF_IA64(x) x
+# else
+#   define IF_IA64(x)
+# endif
+/* We hold allocation lock.  Should do exactly the right thing if the	*/
+/* world is stopped.  Should not fail if it isn't.			*/
+void GC_push_all_stacks()
+{
+    int i;
+    GC_thread p;
+    ptr_t sp = GC_approx_sp();
+    ptr_t lo, hi;
+    /* On IA64, we also need to scan the register backing store. */
+    IF_IA64(ptr_t bs_lo; ptr_t bs_hi;)
+    pthread_t me = pthread_self();
+    
+    if (!GC_thr_initialized) GC_thr_init();
+    #if DEBUG_THREADS
+        GC_printf1("Pushing stacks from thread 0x%lx\n", (unsigned long) me);
+    #endif
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> flags & FINISHED) continue;
+        if (pthread_equal(p -> id, me)) {
+	    lo = GC_approx_sp();
+	    IF_IA64(bs_hi = (ptr_t)GC_save_regs_in_stack();)
+	} else {
+	    lo = p -> stack_ptr;
+	    IF_IA64(bs_hi = p -> backing_store_ptr;)
+	}
+        if ((p -> flags & MAIN_THREAD) == 0) {
+	    hi = p -> stack_end;
+	    IF_IA64(bs_lo = p -> backing_store_end);
+        } else {
+            /* The original stack. */
+            hi = GC_stackbottom;
+	    IF_IA64(bs_lo = BACKING_STORE_BASE;)
+        }
+        #if DEBUG_THREADS
+            GC_printf3("Stack for thread 0x%lx = [%lx,%lx)\n",
+    	        (unsigned long) p -> id,
+		(unsigned long) lo, (unsigned long) hi);
+        #endif
+	if (0 == lo) ABORT("GC_push_all_stacks: sp not set!\n");
+        GC_push_all_stack(lo, hi);
+#	ifdef IA64
+          if (pthread_equal(p -> id, me)) {
+	    GC_push_all_eager(bs_lo, bs_hi);
+	  } else {
+	    GC_push_all_stack(bs_lo, bs_hi);
+	  }
+#	endif
+      }
+    }
+}
+
+
+/* We hold the allocation lock.	*/
+void GC_thr_init()
+{
+    int dummy;
+    GC_thread t;
+    struct sigaction act;
+
+    if (GC_thr_initialized) return;
+    GC_thr_initialized = TRUE;
+
+    if (sem_init(&GC_suspend_ack_sem, 0, 0) != 0)
+    	ABORT("sem_init failed");
+
+    act.sa_flags = SA_RESTART;
+    if (sigfillset(&act.sa_mask) != 0) {
+    	ABORT("sigfillset() failed");
+    }
+#   ifdef NO_SIGNALS
+      if (sigdelset(&act.sa_mask, SIGINT) != 0
+	  || sigdelset(&act.sa_mask, SIGQUIT != 0)
+	  || sigdelset(&act.sa_mask, SIGTERM != 0)) {
+        ABORT("sigdelset() failed");
+      }
+#   endif
+
+    /* SIG_RESTART is unmasked by the handler when necessary. 	*/
+    act.sa_handler = GC_suspend_handler;
+    if (sigaction(SIG_SUSPEND, &act, NULL) != 0) {
+    	ABORT("Cannot set SIG_SUSPEND handler");
+    }
+
+    act.sa_handler = GC_restart_handler;
+    if (sigaction(SIG_RESTART, &act, NULL) != 0) {
+    	ABORT("Cannot set SIG_SUSPEND handler");
+    }
+
+    /* Add the initial thread, so we can stop it.	*/
+      t = GC_new_thread(pthread_self());
+      t -> stack_ptr = (ptr_t)(&dummy);
+      t -> flags = DETACHED | MAIN_THREAD;
+}
+
+int WRAP_FUNC(pthread_sigmask)(int how, const sigset_t *set, sigset_t *oset)
+{
+    sigset_t fudged_set;
+    
+    if (set != NULL && (how == SIG_BLOCK || how == SIG_SETMASK)) {
+        fudged_set = *set;
+        sigdelset(&fudged_set, SIG_SUSPEND);
+        set = &fudged_set;
+    }
+    return(REAL_FUNC(pthread_sigmask)(how, set, oset));
+}
+
+struct start_info {
+    void *(*start_routine)(void *);
+    void *arg;
+    word flags;
+    sem_t registered;   	/* 1 ==> in our thread table, but 	*/
+				/* parent hasn't yet noticed.		*/
+};
+
+
+void GC_thread_exit_proc(void *arg)
+{
+    GC_thread me;
+    struct start_info * si = arg;
+
+    LOCK();
+    me = GC_lookup_thread(pthread_self());
+    if (me -> flags & DETACHED) {
+    	GC_delete_thread(pthread_self());
+    } else {
+	me -> flags |= FINISHED;
+    }
+    if (GC_incremental && GC_collection_in_progress()) {
+	int old_gc_no = GC_gc_no;
+
+	/* Make sure that no part of our stack is still on the mark stack, */
+	/* since it's about to be unmapped.				   */
+	while (GC_incremental && GC_collection_in_progress()
+	       && old_gc_no == GC_gc_no) {
+	    ENTER_GC();
+            GC_collect_a_little_inner(1);
+	    EXIT_GC();
+	    UNLOCK();
+	    sched_yield();
+	    LOCK();
+	}
+    }
+    UNLOCK();
+}
+
+int WRAP_FUNC(pthread_join)(pthread_t thread, void **retval)
+{
+    int result;
+    GC_thread thread_gc_id;
+    
+    LOCK();
+    thread_gc_id = GC_lookup_thread(thread);
+    /* This is guaranteed to be the intended one, since the thread id	*/
+    /* cant have been recycled by pthreads.				*/
+    UNLOCK();
+    result = REAL_FUNC(pthread_join)(thread, retval);
+    LOCK();
+    /* Here the pthread thread id may have been recycled. */
+    GC_delete_gc_thread(thread, thread_gc_id);
+    UNLOCK();
+    return result;
+}
+
+void * GC_start_routine(void * arg)
+{
+    int dummy;
+    struct start_info * si = arg;
+    void * result;
+    GC_thread me;
+    pthread_t my_pthread;
+    void *(*start)(void *);
+    void *start_arg;
+
+    my_pthread = pthread_self();
+#   ifdef DEBUG_THREADS
+        GC_printf1("Starting thread 0x%lx\n", my_pthread);
+        GC_printf1("pid = %ld\n", (long) getpid());
+        GC_printf1("sp = 0x%lx\n", (long) &arg);
+#   endif
+    LOCK();
+    me = GC_new_thread(my_pthread);
+    me -> flags = si -> flags;
+    me -> stack_ptr = 0;
+    /* me -> stack_end = GC_linux_stack_base(); -- currently (11/99)	*/
+    /* doesn't work because the stack base in /proc/self/stat is the 	*/
+    /* one for the main thread.  There is a strong argument that that's	*/
+    /* a kernel bug, but a pervasive one.				*/
+#   ifdef STACK_GROWS_DOWN
+      me -> stack_end = (ptr_t)(((word)(&dummy) + (GC_page_size - 1))
+		                & ~(GC_page_size - 1));
+      me -> stack_ptr = me -> stack_end - 0x10;
+	/* Needs to be plausible, since an asynchronous stack mark	*/
+	/* should not crash.						*/
+#   else
+      me -> stack_end = (ptr_t)(((word)(&dummy) & ~(GC_page_size - 1));
+      me -> stack_ptr = me -> stack_end + 0x10;
+#   endif
+    /* This is dubious, since we may be more than a page into the stack, */
+    /* and hence skip some of it, though it's not clear that matters.	 */
+#   ifdef IA64
+      me -> backing_store_end = (ptr_t)
+			(GC_save_regs_in_stack() & ~(GC_page_size - 1));
+      /* This is also < 100% convincing.  We should also read this 	*/
+      /* from /proc, but the hook to do so isn't there yet.		*/
+#   endif /* IA64 */
+    UNLOCK();
+    start = si -> start_routine;
+#   ifdef DEBUG_THREADS
+	GC_printf1("start_routine = 0x%lx\n", start);
+#   endif
+    start_arg = si -> arg;
+    sem_post(&(si -> registered));
+    pthread_cleanup_push(GC_thread_exit_proc, si);
+    result = (*start)(start_arg);
+#if DEBUG_THREADS
+        GC_printf1("Finishing thread 0x%x\n", pthread_self());
+#endif
+    me -> status = result;
+    me -> flags |= FINISHED;
+    pthread_cleanup_pop(1);
+    /* Cleanup acquires lock, ensuring that we can't exit		*/
+    /* while a collection that thinks we're alive is trying to stop     */
+    /* us.								*/
+    return(result);
+}
+
+int
+WRAP_FUNC(pthread_create)(pthread_t *new_thread,
+		  const pthread_attr_t *attr,
+                  void *(*start_routine)(void *), void *arg)
+{
+    int result;
+    GC_thread t;
+    pthread_t my_new_thread;
+    void * stack;
+    size_t stacksize;
+    pthread_attr_t new_attr;
+    int detachstate;
+    word my_flags = 0;
+    struct start_info * si = GC_malloc(sizeof(struct start_info)); 
+	/* This is otherwise saved only in an area mmapped by the thread */
+	/* library, which isn't visible to the collector.		 */
+
+    if (0 == si) return(ENOMEM);
+    sem_init(&(si -> registered), 0, 0);
+    si -> start_routine = start_routine;
+    si -> arg = arg;
+    LOCK();
+    if (!GC_thr_initialized) GC_thr_init();
+    if (NULL == attr) {
+        stack = 0;
+	(void) pthread_attr_init(&new_attr);
+    } else {
+        new_attr = *attr;
+    }
+    pthread_attr_getdetachstate(&new_attr, &detachstate);
+    if (PTHREAD_CREATE_DETACHED == detachstate) my_flags |= DETACHED;
+    si -> flags = my_flags;
+    UNLOCK();
+#   ifdef DEBUG_THREADS
+        GC_printf1("About to start new thread from thread 0x%X\n",
+		   pthread_self());
+#   endif
+    result = REAL_FUNC(pthread_create)(new_thread, &new_attr, GC_start_routine, si);
+#   ifdef DEBUG_THREADS
+        GC_printf1("Started thread 0x%X\n", *new_thread);
+#   endif
+    /* Wait until child has been added to the thread table.		*/
+    /* This also ensures that we hold onto si until the child is done	*/
+    /* with it.  Thus it doesn't matter whether it is otherwise		*/
+    /* visible to the collector.					*/
+        if (0 != sem_wait(&(si -> registered))) ABORT("sem_wait failed");
+        sem_destroy(&(si -> registered));
+    /* pthread_attr_destroy(&new_attr); */
+    /* pthread_attr_destroy(&new_attr); */
+    return(result);
+}
+
+#if defined(USE_SPIN_LOCK)
+
+VOLATILE GC_bool GC_collecting = 0;
+			/* A hint that we're in the collector and       */
+                        /* holding the allocation lock for an           */
+                        /* extended period.                             */
+
+/* Reasonably fast spin locks.  Basically the same implementation */
+/* as STL alloc.h.  This isn't really the right way to do this.   */
+/* but until the POSIX scheduling mess gets straightened out ...  */
+
+volatile unsigned int GC_allocate_lock = 0;
+
+
+void GC_lock()
+{
+#   define low_spin_max 30  /* spin cycles if we suspect uniprocessor */
+#   define high_spin_max 1000 /* spin cycles for multiprocessor */
+    static unsigned spin_max = low_spin_max;
+    unsigned my_spin_max;
+    static unsigned last_spins = 0;
+    unsigned my_last_spins;
+    volatile unsigned junk;
+#   define PAUSE junk *= junk; junk *= junk; junk *= junk; junk *= junk
+    int i;
+
+    if (!GC_test_and_set(&GC_allocate_lock)) {
+        return;
+    }
+    junk = 0;
+    my_spin_max = spin_max;
+    my_last_spins = last_spins;
+    for (i = 0; i < my_spin_max; i++) {
+        if (GC_collecting) goto yield;
+        if (i < my_last_spins/2 || GC_allocate_lock) {
+            PAUSE; 
+            continue;
+        }
+        if (!GC_test_and_set(&GC_allocate_lock)) {
+	    /*
+             * got it!
+             * Spinning worked.  Thus we're probably not being scheduled
+             * against the other process with which we were contending.
+             * Thus it makes sense to spin longer the next time.
+	     */
+            last_spins = i;
+            spin_max = high_spin_max;
+            return;
+        }
+    }
+    /* We are probably being scheduled against the other process.  Sleep. */
+    spin_max = low_spin_max;
+yield:
+    for (i = 0;; ++i) {
+        if (!GC_test_and_set(&GC_allocate_lock)) {
+            return;
+        }
+#       define SLEEP_THRESHOLD 12
+		/* nanosleep(<= 2ms) just spins under Linux.  We	*/
+		/* want to be careful to avoid that behavior.		*/
+        if (i < SLEEP_THRESHOLD) {
+            sched_yield();
+	} else {
+	    struct timespec ts;
+	
+	    if (i > 26) i = 26;
+			/* Don't wait for more than about 60msecs, even	*/
+			/* under extreme contention.			*/
+	    ts.tv_sec = 0;
+	    ts.tv_nsec = 1 << i;
+	    nanosleep(&ts, 0);
+	}
+    }
+}
+
+#endif /* known architecture */
+
+# endif /* LINUX_THREADS */
+
diff --git a/src/gc/mach_dep.c b/src/gc/mach_dep.c
new file mode 100644
index 000000000..12c3f0760
--- /dev/null
+++ b/src/gc/mach_dep.c
@@ -0,0 +1,517 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, November 17, 1995 12:13 pm PST */
+# include "gc_priv.h"
+# include <stdio.h>
+# include <setjmp.h>
+# if defined(OS2) || defined(CX_UX)
+#   define _setjmp(b) setjmp(b)
+#   define _longjmp(b,v) longjmp(b,v)
+# endif
+# ifdef AMIGA
+#   ifndef __GNUC__
+#     include <dos/dos.h>
+#   else
+#     include <machine/reg.h>
+#   endif
+# endif
+
+#if defined(__MWERKS__) && !defined(POWERPC)
+
+asm static void PushMacRegisters()
+{
+    sub.w   #4,sp                   // reserve space for one parameter.
+    move.l  a2,(sp)
+    jsr		GC_push_one
+    move.l  a3,(sp)
+    jsr		GC_push_one
+    move.l  a4,(sp)
+    jsr		GC_push_one
+#   if !__option(a6frames)
+	// <pcb> perhaps a6 should be pushed if stack frames are not being used.    
+  	move.l	a6,(sp)
+  	jsr		GC_push_one
+#   endif
+	// skip a5 (globals), a6 (frame pointer), and a7 (stack pointer)
+    move.l  d2,(sp)
+    jsr		GC_push_one
+    move.l  d3,(sp)
+    jsr		GC_push_one
+    move.l  d4,(sp)
+    jsr		GC_push_one
+    move.l  d5,(sp)
+    jsr		GC_push_one
+    move.l  d6,(sp)
+    jsr		GC_push_one
+    move.l  d7,(sp)
+    jsr		GC_push_one
+    add.w   #4,sp                   // fix stack.
+    rts
+}
+
+#endif /* __MWERKS__ */
+
+# if defined(SPARC) || defined(IA64)
+    /* Value returned from register flushing routine; either sp (SPARC) */
+    /* or ar.bsp (IA64)							*/
+    word GC_save_regs_ret_val;
+# endif
+
+/* Routine to mark from registers that are preserved by the C compiler. */
+/* This must be ported to every new architecture.  There is a generic   */
+/* version at the end, that is likely, but not guaranteed to work       */
+/* on your architecture.  Run the test_setjmp program to see whether    */
+/* there is any chance it will work.                                    */
+
+#ifndef USE_GENERIC_PUSH_REGS
+void GC_push_regs()
+{
+#       ifdef RT
+	  register long TMP_SP; /* must be bound to r11 */
+#       endif
+
+#       if defined(MIPS) && defined(LINUX)
+	  /* I'm not sure whether this has actually been tested. */
+#         define call_push(x)     asm("move $4," x ";"); asm("jal GC_push_one")
+	  call_push("$2");
+	  call_push("$3");
+	  call_push("$16");
+	  call_push("$17");
+	  call_push("$18");
+	  call_push("$19");
+	  call_push("$20");
+	  call_push("$21");
+	  call_push("$22");
+	  call_push("$23");
+	  call_push("$30");
+#         undef call_push
+#       endif	/* MIPS && LINUX */
+
+#       ifdef VAX
+	  /* VAX - generic code below does not work under 4.2 */
+	  /* r1 through r5 are caller save, and therefore     */
+	  /* on the stack or dead.                            */
+	  asm("pushl r11");     asm("calls $1,_GC_push_one");
+	  asm("pushl r10"); 	asm("calls $1,_GC_push_one");
+	  asm("pushl r9");	asm("calls $1,_GC_push_one");
+	  asm("pushl r8");	asm("calls $1,_GC_push_one");
+	  asm("pushl r7");	asm("calls $1,_GC_push_one");
+	  asm("pushl r6");	asm("calls $1,_GC_push_one");
+#       endif
+#       if defined(M68K) && (defined(SUNOS4) || defined(NEXT))
+	/*  M68K SUNOS - could be replaced by generic code */
+	  /* a0, a1 and d1 are caller save          */
+	  /*  and therefore are on stack or dead.   */
+	
+	  asm("subqw #0x4,sp");		/* allocate word on top of stack */
+
+	  asm("movl a2,sp@");	asm("jbsr _GC_push_one");
+	  asm("movl a3,sp@");	asm("jbsr _GC_push_one");
+	  asm("movl a4,sp@");	asm("jbsr _GC_push_one");
+	  asm("movl a5,sp@");	asm("jbsr _GC_push_one");
+	  /* Skip frame pointer and stack pointer */
+	  asm("movl d1,sp@");	asm("jbsr _GC_push_one");
+	  asm("movl d2,sp@");	asm("jbsr _GC_push_one");
+	  asm("movl d3,sp@");	asm("jbsr _GC_push_one");
+	  asm("movl d4,sp@");	asm("jbsr _GC_push_one");
+	  asm("movl d5,sp@");	asm("jbsr _GC_push_one");
+	  asm("movl d6,sp@");	asm("jbsr _GC_push_one");
+	  asm("movl d7,sp@");	asm("jbsr _GC_push_one");
+
+	  asm("addqw #0x4,sp");		/* put stack back where it was	*/
+#       endif
+
+#       if defined(M68K) && defined(HP)
+	/*  M68K HP - could be replaced by generic code */
+	  /* a0, a1 and d1 are caller save.  */
+	
+	  asm("subq.w &0x4,%sp");	/* allocate word on top of stack */
+
+	  asm("mov.l %a2,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %a3,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %a4,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %a5,(%sp)"); asm("jsr _GC_push_one");
+	  /* Skip frame pointer and stack pointer */
+	  asm("mov.l %d1,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d2,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d3,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d4,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d5,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d6,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d7,(%sp)"); asm("jsr _GC_push_one");
+
+	  asm("addq.w &0x4,%sp");	/* put stack back where it was	*/
+#       endif /* M68K HP */
+
+#	if defined(M68K) && defined(AMIGA)
+ 	 /*  AMIGA - could be replaced by generic code 			*/
+ 	 /* a0, a1, d0 and d1 are caller save */
+
+#        ifdef __GNUC__
+	  asm("subq.w &0x4,%sp");	/* allocate word on top of stack */
+
+	  asm("mov.l %a2,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %a3,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %a4,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %a5,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %a6,(%sp)"); asm("jsr _GC_push_one");
+	  /* Skip frame pointer and stack pointer */
+	  asm("mov.l %d2,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d3,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d4,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d5,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d6,(%sp)"); asm("jsr _GC_push_one");
+	  asm("mov.l %d7,(%sp)"); asm("jsr _GC_push_one");
+
+	  asm("addq.w &0x4,%sp");	/* put stack back where it was	*/
+#        else /* !__GNUC__ */
+	  GC_push_one(getreg(REG_A2));
+	  GC_push_one(getreg(REG_A3));
+	  GC_push_one(getreg(REG_A4));
+	  GC_push_one(getreg(REG_A5));
+	  GC_push_one(getreg(REG_A6));
+	  /* Skip stack pointer */
+	  GC_push_one(getreg(REG_D2));
+	  GC_push_one(getreg(REG_D3));
+	  GC_push_one(getreg(REG_D4));
+	  GC_push_one(getreg(REG_D5));
+	  GC_push_one(getreg(REG_D6));
+	  GC_push_one(getreg(REG_D7));
+#	 endif /* !__GNUC__ */
+#       endif /* AMIGA */
+
+#	if defined(M68K) && defined(MACOS)
+#	if defined(THINK_C)
+#         define PushMacReg(reg) \
+              move.l  reg,(sp) \
+              jsr             GC_push_one
+	  asm {
+              sub.w   #4,sp                   ; reserve space for one parameter.
+              PushMacReg(a2);
+              PushMacReg(a3);
+              PushMacReg(a4);
+              ; skip a5 (globals), a6 (frame pointer), and a7 (stack pointer)
+              PushMacReg(d2);
+              PushMacReg(d3);
+              PushMacReg(d4);
+              PushMacReg(d5);
+              PushMacReg(d6);
+              PushMacReg(d7);
+              add.w   #4,sp                   ; fix stack.
+	  }
+#	  undef PushMacReg
+#	endif /* THINK_C */
+#	if defined(__MWERKS__)
+	  PushMacRegisters();
+#	endif	/* __MWERKS__ */
+#   endif	/* MACOS */
+
+#       if defined(I386) &&!defined(OS2) &&!defined(SVR4) \
+	&& (defined(__MINGW32__) || !defined(MSWIN32)) \
+	&& !defined(SCO) && !defined(SCO_ELF) \
+ 	&& !(defined(LINUX)       && defined(__ELF__)) \
+	&& !(defined(FREEBSD) && defined(__ELF__)) \
+	&& !defined(DOS4GW)
+	/* I386 code, generic code does not appear to work */
+	/* It does appear to work under OS2, and asms dont */
+	/* This is used for some 38g UNIX variants and for CYGWIN32 */
+	  asm("pushl %eax");  asm("call _GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %ecx");  asm("call _GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %edx");  asm("call _GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %ebp");  asm("call _GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %esi");  asm("call _GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %edi");  asm("call _GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %ebx");  asm("call _GC_push_one"); asm("addl $4,%esp");
+#       endif
+
+#	if ( defined(I386) && defined(LINUX) && defined(__ELF__) ) \
+	|| ( defined(I386) && defined(FREEBSD) && defined(__ELF__) )
+
+	/* This is modified for Linux with ELF (Note: _ELF_ only) */
+	/* This section handles FreeBSD with ELF. */
+	/* Eax is caller-save and dead here.  Other caller-save 	*/
+	/* registers could also be skipped.  We assume there are no	*/
+	/* pointers in MMX registers, etc.				*/
+	/* We combine instructions in a single asm to prevent gcc from 	*/
+	/* inserting code in the middle.				*/
+	  asm("pushl %ecx; call GC_push_one; addl $4,%esp");
+	  asm("pushl %edx; call GC_push_one; addl $4,%esp");
+	  asm("pushl %ebp; call GC_push_one; addl $4,%esp");
+	  asm("pushl %esi; call GC_push_one; addl $4,%esp");
+	  asm("pushl %edi; call GC_push_one; addl $4,%esp");
+	  asm("pushl %ebx; call GC_push_one; addl $4,%esp");
+#	endif
+
+#       if defined(I386) && defined(MSWIN32) && !defined(__MINGW32__) \
+	   && !defined(USE_GENERIC)
+	/* I386 code, Microsoft variant		*/
+	  __asm  push eax
+	  __asm  call GC_push_one
+	  __asm  add esp,4
+	  __asm  push ebx
+	  __asm  call GC_push_one
+	  __asm  add esp,4
+	  __asm  push ecx
+	  __asm  call GC_push_one
+	  __asm  add esp,4
+	  __asm  push edx
+	  __asm  call GC_push_one
+	  __asm  add esp,4
+	  __asm  push ebp
+	  __asm  call GC_push_one
+	  __asm  add esp,4
+	  __asm  push esi
+	  __asm  call GC_push_one
+	  __asm  add esp,4
+	  __asm  push edi
+	  __asm  call GC_push_one
+	  __asm  add esp,4
+#       endif
+
+#       if defined(I386) && (defined(SVR4) || defined(SCO) || defined(SCO_ELF))
+	/* I386 code, SVR4 variant, generic code does not appear to work */
+	  asm("pushl %eax");  asm("call GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %ebx");  asm("call GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %ecx");  asm("call GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %edx");  asm("call GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %ebp");  asm("call GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %esi");  asm("call GC_push_one"); asm("addl $4,%esp");
+	  asm("pushl %edi");  asm("call GC_push_one"); asm("addl $4,%esp");
+#       endif
+
+#       ifdef NS32K
+	  asm ("movd r3, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+	  asm ("movd r4, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+	  asm ("movd r5, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+	  asm ("movd r6, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+	  asm ("movd r7, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+#       endif
+
+#       if defined(SPARC)
+	  {
+	      word GC_save_regs_in_stack();
+	      
+	      GC_save_regs_ret_val = GC_save_regs_in_stack();
+	  }
+#       endif
+
+#	ifdef RT
+	    GC_push_one(TMP_SP);    /* GC_push_one from r11 */
+
+	    asm("cas r11, r6, r0"); GC_push_one(TMP_SP);	/* r6 */
+	    asm("cas r11, r7, r0"); GC_push_one(TMP_SP);	/* through */
+	    asm("cas r11, r8, r0"); GC_push_one(TMP_SP);	/* r10 */
+	    asm("cas r11, r9, r0"); GC_push_one(TMP_SP);
+	    asm("cas r11, r10, r0"); GC_push_one(TMP_SP);
+
+	    asm("cas r11, r12, r0"); GC_push_one(TMP_SP); /* r12 */
+	    asm("cas r11, r13, r0"); GC_push_one(TMP_SP); /* through */
+	    asm("cas r11, r14, r0"); GC_push_one(TMP_SP); /* r15 */
+	    asm("cas r11, r15, r0"); GC_push_one(TMP_SP);
+#       endif
+
+#       if defined(M68K) && defined(SYSV)
+  	/*  Once again similar to SUN and HP, though setjmp appears to work.
+  		--Parag
+  	 */
+#        ifdef __GNUC__
+  	  asm("subqw #0x4,%sp");	/* allocate word on top of stack */
+  
+  	  asm("movl %a2,%sp@");	asm("jbsr GC_push_one");
+  	  asm("movl %a3,%sp@");	asm("jbsr GC_push_one");
+  	  asm("movl %a4,%sp@");	asm("jbsr GC_push_one");
+  	  asm("movl %a5,%sp@");	asm("jbsr GC_push_one");
+  	  /* Skip frame pointer and stack pointer */
+  	  asm("movl %d1,%sp@");	asm("jbsr GC_push_one");
+  	  asm("movl %d2,%sp@");	asm("jbsr GC_push_one");
+  	  asm("movl %d3,%sp@");	asm("jbsr GC_push_one");
+  	  asm("movl %d4,%sp@");	asm("jbsr GC_push_one");
+  	  asm("movl %d5,%sp@");	asm("jbsr GC_push_one");
+  	  asm("movl %d6,%sp@");	asm("jbsr GC_push_one");
+  	  asm("movl %d7,%sp@");	asm("jbsr GC_push_one");
+  
+  	  asm("addqw #0x4,%sp");	/* put stack back where it was	*/
+#        else /* !__GNUC__*/
+  	  asm("subq.w &0x4,%sp");	/* allocate word on top of stack */
+  
+  	  asm("mov.l %a2,(%sp)"); asm("jsr GC_push_one");
+  	  asm("mov.l %a3,(%sp)"); asm("jsr GC_push_one");
+  	  asm("mov.l %a4,(%sp)"); asm("jsr GC_push_one");
+  	  asm("mov.l %a5,(%sp)"); asm("jsr GC_push_one");
+  	  /* Skip frame pointer and stack pointer */
+  	  asm("mov.l %d1,(%sp)"); asm("jsr GC_push_one");
+  	  asm("mov.l %d2,(%sp)"); asm("jsr GC_push_one");
+  	  asm("mov.l %d3,(%sp)"); asm("jsr GC_push_one");
+  	  asm("mov.l %d4,(%sp)"); asm("jsr GC_push_one");
+  	  asm("mov.l %d5,(%sp)"); asm("jsr GC_push_one");
+   	  asm("mov.l %d6,(%sp)"); asm("jsr GC_push_one");
+  	  asm("mov.l %d7,(%sp)"); asm("jsr GC_push_one");
+  
+  	  asm("addq.w &0x4,%sp");	/* put stack back where it was	*/
+#        endif /* !__GNUC__ */
+#       endif /* M68K/SYSV */
+
+#     if defined(PJ)
+	{
+	    register int * sp asm ("optop");
+	    extern int *__libc_stack_end;
+
+	    GC_push_all_stack (sp, __libc_stack_end);
+        }
+#     endif
+
+      /* other machines... */
+#       if !(defined M68K) && !(defined VAX) && !(defined RT) 
+#	if !(defined SPARC) && !(defined I386) && !(defined NS32K)
+#	if !defined(POWERPC) && !defined(UTS4) 
+#       if !defined(PJ) && !(defined(MIPS) && defined(LINUX))
+	    --> bad news <--
+#	endif
+#       endif
+#       endif
+#       endif
+}
+#endif /* !USE_GENERIC_PUSH_REGS */
+
+#if defined(USE_GENERIC_PUSH_REGS)
+void GC_generic_push_regs(cold_gc_frame)
+ptr_t cold_gc_frame;
+{
+	/* Generic code                          */
+	/* The idea is due to Parag Patel at HP. */
+	/* We're not sure whether he would like  */
+	/* to be he acknowledged for it or not.  */
+	{
+	    static jmp_buf regs;
+	    register word * i = (word *) regs;
+	    register ptr_t lim = (ptr_t)(regs) + (sizeof regs);
+
+	    /* Setjmp on Sun 3s doesn't clear all of the buffer.  */
+	    /* That tends to preserve garbage.  Clear it.         */
+		for (; (char *)i < lim; i++) {
+		    *i = 0;
+		}
+#	    if defined(POWERPC) || defined(MSWIN32) || defined(UTS4) || defined(LINUX)
+		(void) setjmp(regs);
+#	    else
+	        (void) _setjmp(regs);
+#	    endif
+#           if defined(SPARC) || defined(IA64)
+	      /* On a register window machine, we need to save register	*/
+	      /* contents on the stack for this to work.  The setjmp	*/
+	      /* is probably not needed on SPARC, since pointers are	*/
+	      /* only stored in windowed or scratch registers.  It is	*/
+	      /* needed on IA64, since some non-windowed registers are	*/
+	      /* preserved.						*/
+	      {
+	        word GC_save_regs_in_stack();
+	      
+	        GC_save_regs_ret_val = GC_save_regs_in_stack();
+	      }
+#           endif
+	    GC_push_current_stack(cold_gc_frame);
+	}
+}
+#endif /* USE_GENERIC_PUSH_REGS */
+
+/* On register window machines, we need a way to force registers into 	*/
+/* the stack.	Return sp.						*/
+# ifdef SPARC
+    asm("	.seg 	\"text\"");
+#   ifdef SVR4
+      asm("	.globl	GC_save_regs_in_stack");
+      asm("GC_save_regs_in_stack:");
+      asm("	.type GC_save_regs_in_stack,#function");
+#   else
+      asm("	.globl	_GC_save_regs_in_stack");
+      asm("_GC_save_regs_in_stack:");
+#   endif
+    asm("	ta	0x3   ! ST_FLUSH_WINDOWS");
+    asm("	mov	%sp,%o0");
+    asm("	retl");
+    asm("	nop");
+#   ifdef SVR4
+      asm("	.GC_save_regs_in_stack_end:");
+      asm("	.size GC_save_regs_in_stack,.GC_save_regs_in_stack_end-GC_save_regs_in_stack");
+#   endif
+#   ifdef LINT
+	word GC_save_regs_in_stack() { return(0 /* sp really */);}
+#   endif
+# endif
+
+/* On IA64, we also need to flush register windows.  But they end	*/
+/* up on the other side of the stack segment.				*/
+/* Returns the backing store pointer for the register stack.		*/
+# ifdef IA64
+	asm("        .text");
+	asm("        .psr abi64");
+	asm("        .psr lsb");
+	asm("        .lsb");
+	asm("");
+	asm("        .text");
+	asm("        .align 16");
+	asm("        .global GC_save_regs_in_stack");
+	asm("        .proc GC_save_regs_in_stack");
+	asm("GC_save_regs_in_stack:");
+	asm("        .body");
+	asm("        flushrs");
+	asm("        ;;");
+	asm("        mov r8=ar.bsp");
+	asm("        br.ret.sptk.few rp");
+	asm("        .endp GC_save_regs_in_stack");
+# endif
+
+/* GC_clear_stack_inner(arg, limit) clears stack area up to limit and	*/
+/* returns arg.  Stack clearing is crucial on SPARC, so we supply	*/
+/* an assembly version that's more careful.  Assumes limit is hotter	*/
+/* than sp, and limit is 8 byte aligned.				*/
+#if defined(ASM_CLEAR_CODE) && !defined(THREADS)
+#ifndef SPARC
+	--> fix it
+#endif
+# ifdef SUNOS4
+    asm(".globl _GC_clear_stack_inner");
+    asm("_GC_clear_stack_inner:");
+# else
+    asm(".globl GC_clear_stack_inner");
+    asm("GC_clear_stack_inner:");
+    asm(".type GC_save_regs_in_stack,#function");
+# endif
+  asm("mov %sp,%o2");		/* Save sp	*/
+  asm("add %sp,-8,%o3");	/* p = sp-8	*/
+  asm("clr %g1");		/* [g0,g1] = 0	*/
+  asm("add %o1,-0x60,%sp");	/* Move sp out of the way,	*/
+  				/* so that traps still work.	*/
+  				/* Includes some extra words	*/
+  				/* so we can be sloppy below.	*/
+  asm("loop:");
+  asm("std %g0,[%o3]");		/* *(long long *)p = 0	*/
+  asm("cmp %o3,%o1");
+  asm("bgu loop	");		/* if (p > limit) goto loop	*/
+    asm("add %o3,-8,%o3");	/* p -= 8 (delay slot) */
+  asm("retl");
+    asm("mov %o2,%sp");		/* Restore sp., delay slot	*/
+  /* First argument = %o0 = return value */
+#   ifdef SVR4
+      asm("	.GC_clear_stack_inner_end:");
+      asm("	.size GC_clear_stack_inner,.GC_clear_stack_inner_end-GC_clear_stack_inner");
+#   endif
+  
+# ifdef LINT
+    /*ARGSUSED*/
+    ptr_t GC_clear_stack_inner(arg, limit)
+    ptr_t arg; word limit;
+    { return(arg); }
+# endif
+#endif  
diff --git a/src/gc/makefile.depend b/src/gc/makefile.depend
new file mode 100644
index 000000000..e69de29bb
diff --git a/src/gc/malloc.c b/src/gc/malloc.c
new file mode 100644
index 000000000..a5a93ad81
--- /dev/null
+++ b/src/gc/malloc.c
@@ -0,0 +1,447 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, February 7, 1996 4:32 pm PST */
+ 
+#include <stdio.h>
+#include "gc_priv.h"
+
+extern ptr_t GC_clear_stack();	/* in misc.c, behaves like identity */
+void GC_extend_size_map();	/* in misc.c. */
+
+/* Allocate reclaim list for kind:	*/
+/* Return TRUE on success		*/
+GC_bool GC_alloc_reclaim_list(kind)
+register struct obj_kind * kind;
+{
+    struct hblk ** result = (struct hblk **)
+    		GC_scratch_alloc((MAXOBJSZ+1) * sizeof(struct hblk *));
+    if (result == 0) return(FALSE);
+    BZERO(result, (MAXOBJSZ+1)*sizeof(struct hblk *));
+    kind -> ok_reclaim_list = result;
+    return(TRUE);
+}
+
+/* allocate lb bytes for an object of kind.	*/
+/* Should not be used to directly to allocate	*/
+/* objects such as STUBBORN objects that	*/
+/* require special handling on allocation.	*/
+/* First a version that assumes we already	*/
+/* hold lock:					*/
+ptr_t GC_generic_malloc_inner(lb, k)
+register word lb;
+register int k;
+{
+register word lw;
+register ptr_t op;
+register ptr_t *opp;
+
+    if( SMALL_OBJ(lb) ) {
+        register struct obj_kind * kind = GC_obj_kinds + k;
+#       ifdef MERGE_SIZES
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+	  if (lw == 0) lw = 1;
+#       endif
+	opp = &(kind -> ok_freelist[lw]);
+        if( (op = *opp) == 0 ) {
+#	    ifdef MERGE_SIZES
+	      if (GC_size_map[lb] == 0) {
+	        if (!GC_is_initialized)  GC_init_inner();
+	        if (GC_size_map[lb] == 0) GC_extend_size_map(lb);
+	        return(GC_generic_malloc_inner(lb, k));
+	      }
+#	    else
+	      if (!GC_is_initialized) {
+	        GC_init_inner();
+	        return(GC_generic_malloc_inner(lb, k));
+	      }
+#	    endif
+	    if (kind -> ok_reclaim_list == 0) {
+	    	if (!GC_alloc_reclaim_list(kind)) goto out;
+	    }
+	    op = GC_allocobj(lw, k);
+	    if (op == 0) goto out;
+        }
+        /* Here everything is in a consistent state.	*/
+        /* We assume the following assignment is	*/
+        /* atomic.  If we get aborted			*/
+        /* after the assignment, we lose an object,	*/
+        /* but that's benign.				*/
+        /* Volatile declarations may need to be added	*/
+        /* to prevent the compiler from breaking things.*/
+	/* If we only execute the second of the 	*/
+	/* following assignments, we lose the free	*/
+	/* list, but that should still be OK, at least	*/
+	/* for garbage collected memory.		*/
+        *opp = obj_link(op);
+        obj_link(op) = 0;
+    } else {
+	register struct hblk * h;
+	register word n_blocks = divHBLKSZ(ADD_SLOP(lb)
+					   + HDR_BYTES + HBLKSIZE-1);
+	
+	if (!GC_is_initialized) GC_init_inner();
+	/* Do our share of marking work */
+          if(GC_incremental && !GC_dont_gc)
+		GC_collect_a_little_inner((int)n_blocks);
+	lw = ROUNDED_UP_WORDS(lb);
+        h = GC_allochblk(lw, k, 0);
+#       ifdef USE_MUNMAP
+	  if (0 == h) {
+	    GC_merge_unmapped();
+	    h = GC_allochblk(lw, k, 0);
+	  }
+#	endif
+	while (0 == h && GC_collect_or_expand(n_blocks, FALSE)) {
+	  h = GC_allochblk(lw, k, 0);
+	}
+	if (h == 0) {
+	    op = 0;
+	} else {
+	    op = (ptr_t) (h -> hb_body);
+	    GC_words_wasted += BYTES_TO_WORDS(n_blocks * HBLKSIZE) - lw;
+	}
+    }
+    GC_words_allocd += lw;
+    
+out:
+    return((ptr_t)op);
+}
+
+ptr_t GC_generic_malloc(lb, k)
+register word lb;
+register int k;
+{
+    ptr_t result;
+    DCL_LOCK_STATE;
+
+    GC_INVOKE_FINALIZERS();
+    DISABLE_SIGNALS();
+    LOCK();
+    result = GC_generic_malloc_inner(lb, k);
+    UNLOCK();
+    ENABLE_SIGNALS();
+    if (0 == result) {
+        return((*GC_oom_fn)(lb));
+    } else {
+        return(result);
+    }
+}   
+
+
+#define GENERAL_MALLOC(lb,k) \
+    (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
+/* We make the GC_clear_stack_call a tail call, hoping to get more of	*/
+/* the stack.								*/
+
+/* Allocate lb bytes of atomic (pointerfree) data */
+# ifdef __STDC__
+    GC_PTR GC_malloc_atomic(size_t lb)
+# else
+    GC_PTR GC_malloc_atomic(lb)
+    size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_aobjfreelist[lw]);
+	FASTLOCK();
+        if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+            FASTUNLOCK();
+            return(GENERAL_MALLOC((word)lb, PTRFREE));
+        }
+        /* See above comment on signals.	*/
+        *opp = obj_link(op);
+        GC_words_allocd += lw;
+        FASTUNLOCK();
+        return((GC_PTR) op);
+   } else {
+       return(GENERAL_MALLOC((word)lb, PTRFREE));
+   }
+}
+
+/* Allocate lb bytes of composite (pointerful) data */
+# ifdef __STDC__
+    GC_PTR GC_malloc(size_t lb)
+# else
+    GC_PTR GC_malloc(lb)
+    size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t *opp;
+register word lw;
+DCL_LOCK_STATE;
+
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_objfreelist[lw]);
+	FASTLOCK();
+        if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+            FASTUNLOCK();
+            return(GENERAL_MALLOC((word)lb, NORMAL));
+        }
+        /* See above comment on signals.	*/
+        *opp = obj_link(op);
+        obj_link(op) = 0;
+        GC_words_allocd += lw;
+        FASTUNLOCK();
+        return((GC_PTR) op);
+   } else {
+       return(GENERAL_MALLOC((word)lb, NORMAL));
+   }
+}
+
+# ifdef REDIRECT_MALLOC
+# ifdef __STDC__
+    GC_PTR malloc(size_t lb)
+# else
+    GC_PTR malloc(lb)
+    size_t lb;
+# endif
+  {
+    /* It might help to manually inline the GC_malloc call here.	*/
+    /* But any decent compiler should reduce the extra procedure call	*/
+    /* to at most a jump instruction in this case.			*/
+#   if defined(I386) && defined(SOLARIS_THREADS)
+      /*
+       * Thread initialisation can call malloc before
+       * we're ready for it.
+       * It's not clear that this is enough to help matters.
+       * The thread implementation may well call malloc at other
+       * inopportune times.
+       */
+      if (!GC_is_initialized) return sbrk(lb);
+#   endif /* I386 && SOLARIS_THREADS */
+    return(REDIRECT_MALLOC(lb));
+  }
+
+# ifdef __STDC__
+    GC_PTR calloc(size_t n, size_t lb)
+# else
+    GC_PTR calloc(n, lb)
+    size_t n, lb;
+# endif
+  {
+    return(REDIRECT_MALLOC(n*lb));
+  }
+# endif /* REDIRECT_MALLOC */
+
+GC_PTR GC_generic_or_special_malloc(lb,knd)
+word lb;
+int knd;
+{
+    switch(knd) {
+#     ifdef STUBBORN_ALLOC
+	case STUBBORN:
+	    return(GC_malloc_stubborn((size_t)lb));
+#     endif
+	case PTRFREE:
+	    return(GC_malloc_atomic((size_t)lb));
+	case NORMAL:
+	    return(GC_malloc((size_t)lb));
+	case UNCOLLECTABLE:
+	    return(GC_malloc_uncollectable((size_t)lb));
+#       ifdef ATOMIC_UNCOLLECTABLE
+	  case AUNCOLLECTABLE:
+	    return(GC_malloc_atomic_uncollectable((size_t)lb));
+#	endif /* ATOMIC_UNCOLLECTABLE */
+	default:
+	    return(GC_generic_malloc(lb,knd));
+    }
+}
+
+
+/* Change the size of the block pointed to by p to contain at least   */
+/* lb bytes.  The object may be (and quite likely will be) moved.     */
+/* The kind (e.g. atomic) is the same as that of the old.	      */
+/* Shrinking of large blocks is not implemented well.                 */
+# ifdef __STDC__
+    GC_PTR GC_realloc(GC_PTR p, size_t lb)
+# else
+    GC_PTR GC_realloc(p,lb)
+    GC_PTR p;
+    size_t lb;
+# endif
+{
+register struct hblk * h;
+register hdr * hhdr;
+register word sz;	 /* Current size in bytes	*/
+register word orig_sz;	 /* Original sz in bytes	*/
+int obj_kind;
+
+    if (p == 0) return(GC_malloc(lb));	/* Required by ANSI */
+    h = HBLKPTR(p);
+    hhdr = HDR(h);
+    sz = hhdr -> hb_sz;
+    obj_kind = hhdr -> hb_obj_kind;
+    sz = WORDS_TO_BYTES(sz);
+    orig_sz = sz;
+
+    if (sz > WORDS_TO_BYTES(MAXOBJSZ)) {
+	/* Round it up to the next whole heap block */
+	  register word descr;
+	  
+	  sz = (sz+HDR_BYTES+HBLKSIZE-1)
+		& (~HBLKMASK);
+	  sz -= HDR_BYTES;
+	  hhdr -> hb_sz = BYTES_TO_WORDS(sz);
+	  descr = GC_obj_kinds[obj_kind].ok_descriptor;
+          if (GC_obj_kinds[obj_kind].ok_relocate_descr) descr += sz;
+          hhdr -> hb_descr = descr;
+	  if (IS_UNCOLLECTABLE(obj_kind)) GC_non_gc_bytes += (sz - orig_sz);
+	  /* Extra area is already cleared by allochblk. */
+    }
+    if (ADD_SLOP(lb) <= sz) {
+	if (lb >= (sz >> 1)) {
+#	    ifdef STUBBORN_ALLOC
+	        if (obj_kind == STUBBORN) GC_change_stubborn(p);
+#	    endif
+	    if (orig_sz > lb) {
+	      /* Clear unneeded part of object to avoid bogus pointer */
+	      /* tracing.					      */
+	      /* Safe for stubborn objects.			      */
+	        BZERO(((ptr_t)p) + lb, orig_sz - lb);
+	    }
+	    return(p);
+	} else {
+	    /* shrink */
+	      GC_PTR result =
+	      		GC_generic_or_special_malloc((word)lb, obj_kind);
+
+	      if (result == 0) return(0);
+	          /* Could also return original object.  But this 	*/
+	          /* gives the client warning of imminent disaster.	*/
+	      BCOPY(p, result, lb);
+#	      ifndef IGNORE_FREE
+	        GC_free(p);
+#	      endif
+	      return(result);
+	}
+    } else {
+	/* grow */
+	  GC_PTR result =
+	  	GC_generic_or_special_malloc((word)lb, obj_kind);
+
+	  if (result == 0) return(0);
+	  BCOPY(p, result, sz);
+#	  ifndef IGNORE_FREE
+	    GC_free(p);
+#	  endif
+	  return(result);
+    }
+}
+
+# ifdef REDIRECT_MALLOC
+# ifdef __STDC__
+    GC_PTR realloc(GC_PTR p, size_t lb)
+# else
+    GC_PTR realloc(p,lb)
+    GC_PTR p;
+    size_t lb;
+# endif
+  {
+    return(GC_realloc(p, lb));
+  }
+# endif /* REDIRECT_MALLOC */
+
+/* Explicitly deallocate an object p.				*/
+# ifdef __STDC__
+    void GC_free(GC_PTR p)
+# else
+    void GC_free(p)
+    GC_PTR p;
+# endif
+{
+    register struct hblk *h;
+    register hdr *hhdr;
+    register signed_word sz;
+    register ptr_t * flh;
+    register int knd;
+    register struct obj_kind * ok;
+    DCL_LOCK_STATE;
+
+    if (p == 0) return;
+    	/* Required by ANSI.  It's not my fault ...	*/
+    h = HBLKPTR(p);
+    hhdr = HDR(h);
+#   if defined(REDIRECT_MALLOC) && \
+	(defined(SOLARIS_THREADS) || defined(LINUX_THREADS))
+	/* We have to redirect malloc calls during initialization.	*/
+	/* Don't try to deallocate that memory.				*/
+	if (0 == hhdr) return;
+#   endif
+    knd = hhdr -> hb_obj_kind;
+    sz = hhdr -> hb_sz;
+    ok = &GC_obj_kinds[knd];
+    if (sz <= MAXOBJSZ) {
+#	ifdef THREADS
+	    DISABLE_SIGNALS();
+	    LOCK();
+#	endif
+	GC_mem_freed += sz;
+	/* A signal here can make GC_mem_freed and GC_non_gc_bytes	*/
+	/* inconsistent.  We claim this is benign.			*/
+	if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
+		/* Its unnecessary to clear the mark bit.  If the 	*/
+		/* object is reallocated, it doesn't matter.  O.w. the	*/
+		/* collector will do it, since it's on a free list.	*/
+	if (ok -> ok_init) {
+	    BZERO((word *)p + 1, WORDS_TO_BYTES(sz-1));
+	}
+	flh = &(ok -> ok_freelist[sz]);
+	obj_link(p) = *flh;
+	*flh = (ptr_t)p;
+#	ifdef THREADS
+	    UNLOCK();
+	    ENABLE_SIGNALS();
+#	endif
+    } else {
+    	DISABLE_SIGNALS();
+        LOCK();
+        GC_mem_freed += sz;
+	if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
+        GC_freehblk(h);
+        UNLOCK();
+        ENABLE_SIGNALS();
+    }
+}
+
+# ifdef REDIRECT_MALLOC
+#   ifdef __STDC__
+      void free(GC_PTR p)
+#   else
+      void free(p)
+      GC_PTR p;
+#   endif
+  {
+#   ifndef IGNORE_FREE
+      GC_free(p);
+#   endif
+  }
+# endif  /* REDIRECT_MALLOC */
diff --git a/src/gc/mallocx.c b/src/gc/mallocx.c
new file mode 100644
index 000000000..c84266523
--- /dev/null
+++ b/src/gc/mallocx.c
@@ -0,0 +1,387 @@
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * These are extra allocation routines which are likely to be less
+ * frequently used than those in malloc.c.  They are separate in the
+ * hope that the .o file will be excluded from statically linked
+ * executables.  We should probably break this up further.
+ */
+
+#include <stdio.h>
+#include "gc_priv.h"
+
+extern ptr_t GC_clear_stack();  /* in misc.c, behaves like identity */
+void GC_extend_size_map();      /* in misc.c. */
+GC_bool GC_alloc_reclaim_list();	/* in malloc.c */
+
+/* Some externally visible but unadvertised variables to allow access to */
+/* free lists from inlined allocators without including gc_priv.h	 */
+/* or introducing dependencies on internal data structure layouts.	 */
+ptr_t * CONST GC_objfreelist_ptr = GC_objfreelist;
+ptr_t * CONST GC_aobjfreelist_ptr = GC_aobjfreelist;
+ptr_t * CONST GC_uobjfreelist_ptr = GC_uobjfreelist;
+# ifdef ATOMIC_UNCOLLECTABLE
+    ptr_t * CONST GC_auobjfreelist_ptr = GC_auobjfreelist;
+# endif
+
+/* Allocate a composite object of size n bytes.  The caller guarantees  */
+/* that pointers past the first page are not relevant.  Caller holds    */
+/* allocation lock.                                                     */
+ptr_t GC_generic_malloc_inner_ignore_off_page(lb, k)
+register size_t lb;
+register int k;
+{
+    register struct hblk * h;
+    register word n_blocks;
+    register word lw;
+    register ptr_t op;
+
+    if (lb <= HBLKSIZE)
+        return(GC_generic_malloc_inner((word)lb, k));
+    n_blocks = divHBLKSZ(ADD_SLOP(lb) + HDR_BYTES + HBLKSIZE-1);
+    if (!GC_is_initialized) GC_init_inner();
+    /* Do our share of marking work */
+    if(GC_incremental && !GC_dont_gc)
+        GC_collect_a_little_inner((int)n_blocks);
+    lw = ROUNDED_UP_WORDS(lb);
+    h = GC_allochblk(lw, k, IGNORE_OFF_PAGE);
+#   ifdef USE_MUNMAP
+      if (0 == h) {
+        GC_merge_unmapped();
+        h = GC_allochblk(lw, k, IGNORE_OFF_PAGE);
+      }
+#   endif
+    while (0 == h && GC_collect_or_expand(n_blocks, TRUE)) {
+      h = GC_allochblk(lw, k, IGNORE_OFF_PAGE);
+    }
+    if (h == 0) {
+        op = 0;
+    } else {
+        op = (ptr_t) (h -> hb_body);
+        GC_words_wasted += BYTES_TO_WORDS(n_blocks * HBLKSIZE) - lw;
+    }
+    GC_words_allocd += lw;
+    return((ptr_t)op);
+}
+
+ptr_t GC_generic_malloc_ignore_off_page(lb, k)
+register size_t lb;
+register int k;
+{
+    register ptr_t result;
+    DCL_LOCK_STATE;
+    
+    GC_INVOKE_FINALIZERS();
+    DISABLE_SIGNALS();
+    LOCK();
+    result = GC_generic_malloc_inner_ignore_off_page(lb,k);
+    UNLOCK();
+    ENABLE_SIGNALS();
+    if (0 == result) {
+        return((*GC_oom_fn)(lb));
+    } else {
+        return(result);
+    }
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+  void * GC_malloc_ignore_off_page(size_t lb)
+# else
+  char * GC_malloc_ignore_off_page(lb)
+  register size_t lb;
+# endif
+{
+    return((GC_PTR)GC_generic_malloc_ignore_off_page(lb, NORMAL));
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+  void * GC_malloc_atomic_ignore_off_page(size_t lb)
+# else
+  char * GC_malloc_atomic_ignore_off_page(lb)
+  register size_t lb;
+# endif
+{
+    return((GC_PTR)GC_generic_malloc_ignore_off_page(lb, PTRFREE));
+}
+
+/* Increment GC_words_allocd from code that doesn't have direct access 	*/
+/* to GC_arrays.							*/
+# ifdef __STDC__
+void GC_incr_words_allocd(size_t n)
+{
+    GC_words_allocd += n;
+}
+
+/* The same for GC_mem_freed.				*/
+void GC_incr_mem_freed(size_t n)
+{
+    GC_mem_freed += n;
+}
+# endif /* __STDC__ */
+
+/* Analogous to the above, but assumes a small object size, and 	*/
+/* bypasses MERGE_SIZES mechanism.  Used by gc_inline.h.		*/
+ptr_t GC_generic_malloc_words_small_inner(lw, k)
+register word lw;
+register int k;
+{
+register ptr_t op;
+register ptr_t *opp;
+register struct obj_kind * kind = GC_obj_kinds + k;
+
+    opp = &(kind -> ok_freelist[lw]);
+    if( (op = *opp) == 0 ) {
+        if (!GC_is_initialized) {
+            GC_init_inner();
+        }
+	if (kind -> ok_reclaim_list != 0 || GC_alloc_reclaim_list(kind)) {
+	    op = GC_clear_stack(GC_allocobj((word)lw, k));
+	}
+	if (op == 0) {
+	    UNLOCK();
+	    ENABLE_SIGNALS();
+	    return ((*GC_oom_fn)(WORDS_TO_BYTES(lw)));
+	}
+    }
+    *opp = obj_link(op);
+    obj_link(op) = 0;
+    GC_words_allocd += lw;
+    return((ptr_t)op);
+}
+
+/* Analogous to the above, but assumes a small object size, and 	*/
+/* bypasses MERGE_SIZES mechanism.  Used by gc_inline.h.		*/
+#ifdef __STDC__
+     ptr_t GC_generic_malloc_words_small(size_t lw, int k)
+#else 
+     ptr_t GC_generic_malloc_words_small(lw, k)
+     register word lw;
+     register int k;
+#endif
+{
+register ptr_t op;
+DCL_LOCK_STATE;
+
+    GC_INVOKE_FINALIZERS();
+    DISABLE_SIGNALS();
+    LOCK();
+    op = GC_generic_malloc_words_small_inner(lw, k);
+    UNLOCK();
+    ENABLE_SIGNALS();
+    return((ptr_t)op);
+}
+
+#if defined(THREADS) && !defined(SRC_M3)
+/* Return a list of 1 or more objects of the indicated size, linked	*/
+/* through the first word in the object.  This has the advantage that	*/
+/* it acquires the allocation lock only once, and may greatly reduce	*/
+/* time wasted contending for the allocation lock.  Typical usage would */
+/* be in a thread that requires many items of the same size.  It would	*/
+/* keep its own free list in thread-local storage, and call		*/
+/* GC_malloc_many or friends to replenish it.  (We do not round up	*/
+/* object sizes, since a call indicates the intention to consume many	*/
+/* objects of exactly this size.)					*/
+/* Note that the client should usually clear the link field.		*/
+ptr_t GC_generic_malloc_many(lb, k)
+register word lb;
+register int k;
+{
+ptr_t op;
+register ptr_t p;
+ptr_t *opp;
+word lw;
+register word my_words_allocd;
+DCL_LOCK_STATE;
+
+    if (!SMALL_OBJ(lb)) {
+        op = GC_generic_malloc(lb, k);
+        if(0 != op) obj_link(op) = 0;
+        return(op);
+    }
+    lw = ALIGNED_WORDS(lb);
+    GC_INVOKE_FINALIZERS();
+    DISABLE_SIGNALS();
+    LOCK();
+    opp = &(GC_obj_kinds[k].ok_freelist[lw]);
+    if( (op = *opp) == 0 ) {
+        if (!GC_is_initialized) {
+            GC_init_inner();
+        }
+	op = GC_clear_stack(GC_allocobj(lw, k));
+	if (op == 0) {
+	    UNLOCK();
+	    ENABLE_SIGNALS();
+	    op = (*GC_oom_fn)(lb);
+	    if(0 != op) obj_link(op) = 0;
+            return(op);
+	}
+    }
+    *opp = 0;
+    my_words_allocd = 0;
+    for (p = op; p != 0; p = obj_link(p)) {
+        my_words_allocd += lw;
+        if (my_words_allocd >= BODY_SZ) {
+            *opp = obj_link(p);
+            obj_link(p) = 0;
+            break;
+        }
+    }
+    GC_words_allocd += my_words_allocd;
+    
+out:
+    UNLOCK();
+    ENABLE_SIGNALS();
+    return(op);
+
+}
+
+void * GC_malloc_many(size_t lb)
+{
+    return(GC_generic_malloc_many(lb, NORMAL));
+}
+
+/* Note that the "atomic" version of this would be unsafe, since the	*/
+/* links would not be seen by the collector.				*/
+# endif
+
+/* Allocate lb bytes of pointerful, traced, but not collectable data */
+# ifdef __STDC__
+    GC_PTR GC_malloc_uncollectable(size_t lb)
+# else
+    GC_PTR GC_malloc_uncollectable(lb)
+    size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t *opp;
+register word lw;
+DCL_LOCK_STATE;
+
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+#	  ifdef ADD_BYTE_AT_END
+	    if (lb != 0) lb--;
+	    	  /* We don't need the extra byte, since this won't be	*/
+	    	  /* collected anyway.					*/
+#	  endif
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_uobjfreelist[lw]);
+	FASTLOCK();
+        if( FASTLOCK_SUCCEEDED() && (op = *opp) != 0 ) {
+            /* See above comment on signals.	*/
+            *opp = obj_link(op);
+            obj_link(op) = 0;
+            GC_words_allocd += lw;
+            /* Mark bit ws already set on free list.  It will be	*/
+	    /* cleared only temporarily during a collection, as a 	*/
+	    /* result of the normal free list mark bit clearing.	*/
+            GC_non_gc_bytes += WORDS_TO_BYTES(lw);
+            FASTUNLOCK();
+            return((GC_PTR) op);
+        }
+        FASTUNLOCK();
+        op = (ptr_t)GC_generic_malloc((word)lb, UNCOLLECTABLE);
+    } else {
+	op = (ptr_t)GC_generic_malloc((word)lb, UNCOLLECTABLE);
+    }
+    if (0 == op) return(0);
+    /* We don't need the lock here, since we have an undisguised 	*/
+    /* pointer.  We do need to hold the lock while we adjust		*/
+    /* mark bits.							*/
+    {
+	register struct hblk * h;
+	
+	h = HBLKPTR(op);
+	lw = HDR(h) -> hb_sz;
+	
+	DISABLE_SIGNALS();
+	LOCK();
+	GC_set_mark_bit(op);
+	GC_non_gc_bytes += WORDS_TO_BYTES(lw);
+	UNLOCK();
+	ENABLE_SIGNALS();
+	return((GC_PTR) op);
+    }
+}
+
+# ifdef ATOMIC_UNCOLLECTABLE
+/* Allocate lb bytes of pointerfree, untraced, uncollectable data 	*/
+/* This is normally roughly equivalent to the system malloc.		*/
+/* But it may be useful if malloc is redefined.				*/
+# ifdef __STDC__
+    GC_PTR GC_malloc_atomic_uncollectable(size_t lb)
+# else
+    GC_PTR GC_malloc_atomic_uncollectable(lb)
+    size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t *opp;
+register word lw;
+DCL_LOCK_STATE;
+
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+#	  ifdef ADD_BYTE_AT_END
+	    if (lb != 0) lb--;
+	    	  /* We don't need the extra byte, since this won't be	*/
+	    	  /* collected anyway.					*/
+#	  endif
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_auobjfreelist[lw]);
+	FASTLOCK();
+        if( FASTLOCK_SUCCEEDED() && (op = *opp) != 0 ) {
+            /* See above comment on signals.	*/
+            *opp = obj_link(op);
+            obj_link(op) = 0;
+            GC_words_allocd += lw;
+	    /* Mark bit was already set while object was on free list. */
+            GC_non_gc_bytes += WORDS_TO_BYTES(lw);
+            FASTUNLOCK();
+            return((GC_PTR) op);
+        }
+        FASTUNLOCK();
+        op = (ptr_t)GC_generic_malloc((word)lb, AUNCOLLECTABLE);
+    } else {
+	op = (ptr_t)GC_generic_malloc((word)lb, AUNCOLLECTABLE);
+    }
+    if (0 == op) return(0);
+    /* We don't need the lock here, since we have an undisguised 	*/
+    /* pointer.  We do need to hold the lock while we adjust		*/
+    /* mark bits.							*/
+    {
+	register struct hblk * h;
+	
+	h = HBLKPTR(op);
+	lw = HDR(h) -> hb_sz;
+	
+	DISABLE_SIGNALS();
+	LOCK();
+	GC_set_mark_bit(op);
+	GC_non_gc_bytes += WORDS_TO_BYTES(lw);
+	UNLOCK();
+	ENABLE_SIGNALS();
+	return((GC_PTR) op);
+    }
+}
+
+#endif /* ATOMIC_UNCOLLECTABLE */
diff --git a/src/gc/mark.c b/src/gc/mark.c
new file mode 100644
index 000000000..c54d894e8
--- /dev/null
+++ b/src/gc/mark.c
@@ -0,0 +1,1282 @@
+
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+
+
+# include <stdio.h>
+# include "gc_priv.h"
+# include "gc_mark.h"
+
+/* We put this here to minimize the risk of inlining. */
+/*VARARGS*/
+#ifdef __WATCOMC__
+  void GC_noop(void *p, ...) {}
+#else
+  void GC_noop() {}
+#endif
+
+/* Single argument version, robust against whole program analysis. */
+void GC_noop1(x)
+word x;
+{
+    static VOLATILE word sink;
+
+    sink = x;
+}
+
+/* mark_proc GC_mark_procs[MAX_MARK_PROCS] = {0} -- declared in gc_priv.h */
+
+word GC_n_mark_procs = GC_RESERVED_MARK_PROCS;
+
+/* Initialize GC_obj_kinds properly and standard free lists properly.  	*/
+/* This must be done statically since they may be accessed before 	*/
+/* GC_init is called.							*/
+/* It's done here, since we need to deal with mark descriptors.		*/
+struct obj_kind GC_obj_kinds[MAXOBJKINDS] = {
+/* PTRFREE */ { &GC_aobjfreelist[0], 0 /* filled in dynamically */,
+		0 | DS_LENGTH, FALSE, FALSE },
+/* NORMAL  */ { &GC_objfreelist[0], 0,
+#		if defined(ADD_BYTE_AT_END) && ALIGNMENT > DS_TAGS
+		(word)(-ALIGNMENT) | DS_LENGTH,
+#		else
+		0 | DS_LENGTH,
+#		endif
+		TRUE /* add length to descr */, TRUE },
+/* UNCOLLECTABLE */
+	      { &GC_uobjfreelist[0], 0,
+		0 | DS_LENGTH, TRUE /* add length to descr */, TRUE },
+# ifdef ATOMIC_UNCOLLECTABLE
+   /* AUNCOLLECTABLE */
+	      { &GC_auobjfreelist[0], 0,
+		0 | DS_LENGTH, FALSE /* add length to descr */, FALSE },
+# endif
+# ifdef STUBBORN_ALLOC
+/*STUBBORN*/ { &GC_sobjfreelist[0], 0,
+		0 | DS_LENGTH, TRUE /* add length to descr */, TRUE },
+# endif
+};
+
+# ifdef ATOMIC_UNCOLLECTABLE
+#   ifdef STUBBORN_ALLOC
+      int GC_n_kinds = 5;
+#   else
+      int GC_n_kinds = 4;
+#   endif
+# else
+#   ifdef STUBBORN_ALLOC
+      int GC_n_kinds = 4;
+#   else
+      int GC_n_kinds = 3;
+#   endif
+# endif
+
+
+# ifndef INITIAL_MARK_STACK_SIZE
+#   define INITIAL_MARK_STACK_SIZE (1*HBLKSIZE)
+		/* INITIAL_MARK_STACK_SIZE * sizeof(mse) should be a 	*/
+		/* multiple of HBLKSIZE.				*/
+		/* The incremental collector actually likes a larger	*/
+		/* size, since it want to push all marked dirty objs	*/
+		/* before marking anything new.  Currently we let it	*/
+		/* grow dynamically.					*/
+# endif
+
+/*
+ * Limits of stack for GC_mark routine.
+ * All ranges between GC_mark_stack(incl.) and GC_mark_stack_top(incl.) still
+ * need to be marked from.
+ */
+
+word GC_n_rescuing_pages;	/* Number of dirty pages we marked from */
+				/* excludes ptrfree pages, etc.		*/
+
+mse * GC_mark_stack;
+
+word GC_mark_stack_size = 0;
+ 
+mse * GC_mark_stack_top;
+
+static struct hblk * scan_ptr;
+
+mark_state_t GC_mark_state = MS_NONE;
+
+GC_bool GC_mark_stack_too_small = FALSE;
+
+GC_bool GC_objects_are_marked = FALSE;	/* Are there collectable marked	*/
+					/* objects in the heap?		*/
+
+/* Is a collection in progress?  Note that this can return true in the	*/
+/* nonincremental case, if a collection has been abandoned and the	*/
+/* mark state is now MS_INVALID.					*/
+GC_bool GC_collection_in_progress()
+{
+    return(GC_mark_state != MS_NONE);
+}
+
+/* clear all mark bits in the header */
+void GC_clear_hdr_marks(hhdr)
+register hdr * hhdr;
+{
+    BZERO(hhdr -> hb_marks, MARK_BITS_SZ*sizeof(word));
+}
+
+/* Set all mark bits in the header.  Used for uncollectable blocks. */
+void GC_set_hdr_marks(hhdr)
+register hdr * hhdr;
+{
+    register int i;
+
+    for (i = 0; i < MARK_BITS_SZ; ++i) {
+    	hhdr -> hb_marks[i] = ONES;
+    }
+}
+
+/*
+ * Clear all mark bits associated with block h.
+ */
+/*ARGSUSED*/
+static void clear_marks_for_block(h, dummy)
+struct hblk *h;
+word dummy;
+{
+    register hdr * hhdr = HDR(h);
+    
+    if (IS_UNCOLLECTABLE(hhdr -> hb_obj_kind)) return;
+        /* Mark bit for these is cleared only once the object is 	*/
+        /* explicitly deallocated.  This either frees the block, or	*/
+        /* the bit is cleared once the object is on the free list.	*/
+    GC_clear_hdr_marks(hhdr);
+}
+
+/* Slow but general routines for setting/clearing/asking about mark bits */
+void GC_set_mark_bit(p)
+ptr_t p;
+{
+    register struct hblk *h = HBLKPTR(p);
+    register hdr * hhdr = HDR(h);
+    register int word_no = (word *)p - (word *)h;
+    
+    set_mark_bit_from_hdr(hhdr, word_no);
+}
+
+void GC_clear_mark_bit(p)
+ptr_t p;
+{
+    register struct hblk *h = HBLKPTR(p);
+    register hdr * hhdr = HDR(h);
+    register int word_no = (word *)p - (word *)h;
+    
+    clear_mark_bit_from_hdr(hhdr, word_no);
+}
+
+GC_bool GC_is_marked(p)
+ptr_t p;
+{
+    register struct hblk *h = HBLKPTR(p);
+    register hdr * hhdr = HDR(h);
+    register int word_no = (word *)p - (word *)h;
+    
+    return(mark_bit_from_hdr(hhdr, word_no));
+}
+
+
+/*
+ * Clear mark bits in all allocated heap blocks.  This invalidates
+ * the marker invariant, and sets GC_mark_state to reflect this.
+ * (This implicitly starts marking to reestablish the invariant.)
+ */
+void GC_clear_marks()
+{
+    GC_apply_to_all_blocks(clear_marks_for_block, (word)0);
+    GC_objects_are_marked = FALSE;
+    GC_mark_state = MS_INVALID;
+    scan_ptr = 0;
+#   ifdef GATHERSTATS
+	/* Counters reflect currently marked objects: reset here */
+        GC_composite_in_use = 0;
+        GC_atomic_in_use = 0;
+#   endif
+
+}
+
+/* Initiate a garbage collection.  Initiates a full collection if the	*/
+/* mark	state is invalid.						*/
+/*ARGSUSED*/
+void GC_initiate_gc()
+{
+    if (GC_dirty_maintained) GC_read_dirty();
+#   ifdef STUBBORN_ALLOC
+    	GC_read_changed();
+#   endif
+#   ifdef CHECKSUMS
+	{
+	    extern void GC_check_dirty();
+	    
+	    if (GC_dirty_maintained) GC_check_dirty();
+	}
+#   endif
+#   ifdef GATHERSTATS
+	GC_n_rescuing_pages = 0;
+#   endif
+    if (GC_mark_state == MS_NONE) {
+        GC_mark_state = MS_PUSH_RESCUERS;
+    } else if (GC_mark_state != MS_INVALID) {
+    	ABORT("unexpected state");
+    } /* else this is really a full collection, and mark	*/
+      /* bits are invalid.					*/
+    scan_ptr = 0;
+}
+
+
+static void alloc_mark_stack();
+
+/* Perform a small amount of marking.			*/
+/* We try to touch roughly a page of memory.		*/
+/* Return TRUE if we just finished a mark phase.	*/
+/* Cold_gc_frame is an address inside a GC frame that	*/
+/* remains valid until all marking is complete.		*/
+/* A zero value indicates that it's OK to miss some	*/
+/* register values.					*/
+GC_bool GC_mark_some(cold_gc_frame)
+ptr_t cold_gc_frame;
+{
+#ifdef MSWIN32
+  /* Windows 98 appears to asynchronously create and remove writable	*/
+  /* memory mappings, for reasons we haven't yet understood.  Since	*/
+  /* we look for writable regions to determine the root set, we may	*/
+  /* try to mark from an address range that disappeared since we 	*/
+  /* started the collection.  Thus we have to recover from faults here. */
+  /* This code does not appear to be necessary for Windows 95/NT/2000.	*/ 
+  /* Note that this code should never generate an incremental GC write	*/
+  /* fault.								*/
+  __try {
+#endif
+    switch(GC_mark_state) {
+    	case MS_NONE:
+    	    return(FALSE);
+    	    
+    	case MS_PUSH_RESCUERS:
+    	    if (GC_mark_stack_top
+    	        >= GC_mark_stack + GC_mark_stack_size
+		   - INITIAL_MARK_STACK_SIZE/2) {
+		/* Go ahead and mark, even though that might cause us to */
+		/* see more marked dirty objects later on.  Avoid this	 */
+		/* in the future.					 */
+		GC_mark_stack_too_small = TRUE;
+    	        GC_mark_from_mark_stack();
+    	        return(FALSE);
+    	    } else {
+    	        scan_ptr = GC_push_next_marked_dirty(scan_ptr);
+    	        if (scan_ptr == 0) {
+#		    ifdef PRINTSTATS
+			GC_printf1("Marked from %lu dirty pages\n",
+				   (unsigned long)GC_n_rescuing_pages);
+#		    endif
+    	    	    GC_push_roots(FALSE, cold_gc_frame);
+    	    	    GC_objects_are_marked = TRUE;
+    	    	    if (GC_mark_state != MS_INVALID) {
+    	    	        GC_mark_state = MS_ROOTS_PUSHED;
+    	    	    }
+    	    	}
+    	    }
+    	    return(FALSE);
+    	
+    	case MS_PUSH_UNCOLLECTABLE:
+    	    if (GC_mark_stack_top
+    	        >= GC_mark_stack + INITIAL_MARK_STACK_SIZE/4) {
+    	        GC_mark_from_mark_stack();
+    	        return(FALSE);
+    	    } else {
+    	        scan_ptr = GC_push_next_marked_uncollectable(scan_ptr);
+    	        if (scan_ptr == 0) {
+    	    	    GC_push_roots(TRUE, cold_gc_frame);
+    	    	    GC_objects_are_marked = TRUE;
+    	    	    if (GC_mark_state != MS_INVALID) {
+    	    	        GC_mark_state = MS_ROOTS_PUSHED;
+    	    	    }
+    	    	}
+    	    }
+    	    return(FALSE);
+    	
+    	case MS_ROOTS_PUSHED:
+    	    if (GC_mark_stack_top >= GC_mark_stack) {
+    	        GC_mark_from_mark_stack();
+    	        return(FALSE);
+    	    } else {
+    	        GC_mark_state = MS_NONE;
+    	        if (GC_mark_stack_too_small) {
+    	            alloc_mark_stack(2*GC_mark_stack_size);
+    	        }
+    	        return(TRUE);
+    	    }
+    	    
+    	case MS_INVALID:
+    	case MS_PARTIALLY_INVALID:
+	    if (!GC_objects_are_marked) {
+		GC_mark_state = MS_PUSH_UNCOLLECTABLE;
+		return(FALSE);
+	    }
+    	    if (GC_mark_stack_top >= GC_mark_stack) {
+    	        GC_mark_from_mark_stack();
+    	        return(FALSE);
+    	    }
+    	    if (scan_ptr == 0 && GC_mark_state == MS_INVALID) {
+		/* About to start a heap scan for marked objects. */
+		/* Mark stack is empty.  OK to reallocate.	  */
+		if (GC_mark_stack_too_small) {
+    	            alloc_mark_stack(2*GC_mark_stack_size);
+		}
+		GC_mark_state = MS_PARTIALLY_INVALID;
+    	    }
+    	    scan_ptr = GC_push_next_marked(scan_ptr);
+    	    if (scan_ptr == 0 && GC_mark_state == MS_PARTIALLY_INVALID) {
+    	    	GC_push_roots(TRUE, cold_gc_frame);
+    	    	GC_objects_are_marked = TRUE;
+    	    	if (GC_mark_state != MS_INVALID) {
+    	    	    GC_mark_state = MS_ROOTS_PUSHED;
+    	    	}
+    	    }
+    	    return(FALSE);
+    	default:
+    	    ABORT("GC_mark_some: bad state");
+    	    return(FALSE);
+    }
+#ifdef MSWIN32
+  } __except (GetExceptionCode() == EXCEPTION_ACCESS_VIOLATION ?
+	    EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) {
+#   ifdef PRINTSTATS
+	GC_printf0("Caught ACCESS_VIOLATION in marker. "
+		   "Memory mapping disappeared.\n");
+#   endif /* PRINTSTATS */
+    /* We have bad roots on the stack.  Discard mark stack.  	*/
+    /* Rescan from marked objects.  Redetermine roots.		*/
+    GC_invalidate_mark_state();	
+    scan_ptr = 0;
+    return FALSE;
+  }
+#endif /* MSWIN32 */
+}
+
+
+GC_bool GC_mark_stack_empty()
+{
+    return(GC_mark_stack_top < GC_mark_stack);
+}	
+
+#ifdef PROF_MARKER
+    word GC_prof_array[10];
+#   define PROF(n) GC_prof_array[n]++
+#else
+#   define PROF(n)
+#endif
+
+/* Given a pointer to someplace other than a small object page or the	*/
+/* first page of a large object, return a pointer either to the		*/
+/* start of the large object or NIL.					*/
+/* In the latter case black list the address current.			*/
+/* Returns NIL without black listing if current points to a block	*/
+/* with IGNORE_OFF_PAGE set.						*/
+/*ARGSUSED*/
+# ifdef PRINT_BLACK_LIST
+  ptr_t GC_find_start(current, hhdr, source)
+  word source;
+# else
+  ptr_t GC_find_start(current, hhdr)
+# define source 0
+# endif
+register ptr_t current;
+register hdr * hhdr;
+{
+#   ifdef ALL_INTERIOR_POINTERS
+	if (hhdr != 0) {
+	    register ptr_t orig = current;
+	    
+	    current = (ptr_t)HBLKPTR(current) + HDR_BYTES;
+	    do {
+	      current = current - HBLKSIZE*(word)hhdr;
+	      hhdr = HDR(current);
+	    } while(IS_FORWARDING_ADDR_OR_NIL(hhdr));
+	    /* current points to the start of the large object */
+	    if (hhdr -> hb_flags & IGNORE_OFF_PAGE) return(0);
+	    if ((word *)orig - (word *)current
+	         >= (ptrdiff_t)(hhdr->hb_sz)) {
+	        /* Pointer past the end of the block */
+	        GC_ADD_TO_BLACK_LIST_NORMAL(orig, source);
+	        return(0);
+	    }
+	    return(current);
+	} else {
+	    GC_ADD_TO_BLACK_LIST_NORMAL(current, source);
+	    return(0);
+        }
+#   else
+        GC_ADD_TO_BLACK_LIST_NORMAL(current, source);
+        return(0);
+#   endif
+#   undef source
+}
+
+void GC_invalidate_mark_state()
+{
+    GC_mark_state = MS_INVALID;
+    GC_mark_stack_top = GC_mark_stack-1;
+}
+
+mse * GC_signal_mark_stack_overflow(msp)
+mse * msp;
+{
+    GC_mark_state = MS_INVALID;
+    GC_mark_stack_too_small = TRUE;
+#   ifdef PRINTSTATS
+	GC_printf1("Mark stack overflow; current size = %lu entries\n",
+	    	    GC_mark_stack_size);
+#    endif
+     return(msp-INITIAL_MARK_STACK_SIZE/8);
+}
+
+
+/*
+ * Mark objects pointed to by the regions described by
+ * mark stack entries between GC_mark_stack and GC_mark_stack_top,
+ * inclusive.  Assumes the upper limit of a mark stack entry
+ * is never 0.  A mark stack entry never has size 0.
+ * We try to traverse on the order of a hblk of memory before we return.
+ * Caller is responsible for calling this until the mark stack is empty.
+ * Note that this is the most performance critical routine in the
+ * collector.  Hence it contains all sorts of ugly hacks to speed
+ * things up.  In particular, we avoid procedure calls on the common
+ * path, we take advantage of peculiarities of the mark descriptor
+ * encoding, we optionally maintain a cache for the block address to
+ * header mapping, we prefetch when an object is "grayed", etc. 
+ */
+void GC_mark_from_mark_stack()
+{
+  mse * GC_mark_stack_reg = GC_mark_stack;
+  mse * GC_mark_stack_top_reg = GC_mark_stack_top;
+  mse * mark_stack_limit = &(GC_mark_stack[GC_mark_stack_size]);
+  int credit = HBLKSIZE;	/* Remaining credit for marking work	*/
+  register word * current_p;	/* Pointer to current candidate ptr.	*/
+  register word current;	/* Candidate pointer.			*/
+  register word * limit;	/* (Incl) limit of current candidate 	*/
+  				/* range				*/
+  register word descr;
+  register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+  register ptr_t least_ha = GC_least_plausible_heap_addr;
+  DECLARE_HDR_CACHE;
+
+# define SPLIT_RANGE_WORDS 128  /* Must be power of 2.		*/
+
+  GC_objects_are_marked = TRUE;
+  INIT_HDR_CACHE;
+# ifdef OS2 /* Use untweaked version to circumvent compiler problem */
+  while (GC_mark_stack_top_reg >= GC_mark_stack_reg && credit >= 0) {
+# else
+  while ((((ptr_t)GC_mark_stack_top_reg - (ptr_t)GC_mark_stack_reg) | credit)
+  	>= 0) {
+# endif
+    current_p = GC_mark_stack_top_reg -> mse_start;
+    descr = GC_mark_stack_top_reg -> mse_descr;
+  retry:
+    /* current_p and descr describe the current object.		*/
+    /* *GC_mark_stack_top_reg is vacant.			*/
+    /* The following is 0 only for small objects described by a simple	*/
+    /* length descriptor.  For many applications this is the common	*/
+    /* case, so we try to detect it quickly.				*/
+    if (descr & ((~(WORDS_TO_BYTES(SPLIT_RANGE_WORDS) - 1)) | DS_TAGS)) {
+      word tag = descr & DS_TAGS;
+      
+      switch(tag) {
+        case DS_LENGTH:
+          /* Large length.					        */
+          /* Process part of the range to avoid pushing too much on the	*/
+          /* stack.							*/
+          GC_mark_stack_top_reg -> mse_start =
+         	limit = current_p + SPLIT_RANGE_WORDS-1;
+          GC_mark_stack_top_reg -> mse_descr =
+          		descr - WORDS_TO_BYTES(SPLIT_RANGE_WORDS-1);
+          /* Make sure that pointers overlapping the two ranges are	*/
+          /* considered. 						*/
+          limit = (word *)((char *)limit + sizeof(word) - ALIGNMENT);
+          break;
+        case DS_BITMAP:
+          GC_mark_stack_top_reg--;
+          descr &= ~DS_TAGS;
+          credit -= WORDS_TO_BYTES(WORDSZ/2); /* guess */
+          while (descr != 0) {
+            if ((signed_word)descr < 0) {
+              current = *current_p;
+	      if ((ptr_t)current >= least_ha && (ptr_t)current < greatest_ha) {
+		PREFETCH(current);
+                HC_PUSH_CONTENTS((ptr_t)current, GC_mark_stack_top_reg,
+			      mark_stack_limit, current_p, exit1);
+	      }
+            }
+	    descr <<= 1;
+	    ++ current_p;
+          }
+          continue;
+        case DS_PROC:
+          GC_mark_stack_top_reg--;
+          credit -= PROC_BYTES;
+          GC_mark_stack_top_reg =
+              (*PROC(descr))
+              	    (current_p, GC_mark_stack_top_reg,
+              	    mark_stack_limit, ENV(descr));
+          continue;
+        case DS_PER_OBJECT:
+	  if ((signed_word)descr >= 0) {
+	    /* Descriptor is in the object.	*/
+            descr = *(word *)((ptr_t)current_p + descr - DS_PER_OBJECT);
+	  } else {
+	    /* Descriptor is in type descriptor pointed to by first	*/
+	    /* word in object.						*/
+	    ptr_t type_descr = *(ptr_t *)current_p;
+	    /* type_descr is either a valid pointer to the descriptor	*/
+	    /* structure, or this object was on a free list.  If it 	*/
+	    /* it was anything but the last object on the free list,	*/
+	    /* we will misinterpret the next object on the free list as */
+	    /* the type descriptor, and get a 0 GC descriptor, which	*/
+	    /* is ideal.  Unfortunately, we need to check for the last	*/
+	    /* object case explicitly.					*/
+	    if (0 == type_descr) {
+		/* Rarely executed.	*/
+		GC_mark_stack_top_reg--;
+		continue;
+	    }
+            descr = *(word *)(type_descr
+			      - (descr - (DS_PER_OBJECT - INDIR_PER_OBJ_BIAS)));
+	  }
+	  if (0 == descr) {
+	    GC_mark_stack_top_reg--;
+	    continue;
+	  }
+          goto retry;
+      }
+    } else /* Small object with length descriptor */ {
+      GC_mark_stack_top_reg--;
+      limit = (word *)(((ptr_t)current_p) + (word)descr);
+    }
+    /* The simple case in which we're scanning a range.	*/
+    credit -= (ptr_t)limit - (ptr_t)current_p;
+    limit -= 1;
+    {
+#     define PREF_DIST 4
+
+#     ifndef SMALL_CONFIG
+        word deferred;
+
+	/* Try to prefetch the next pointer to be examined asap.	*/
+	/* Empirically, this also seems to help slightly without	*/
+	/* prefetches, at least on linux/X86.  Presumably this loop 	*/
+	/* ends up with less register pressure, and gcc thus ends up 	*/
+	/* generating slightly better code.  Overall gcc code quality	*/
+	/* for this loop is still not great.				*/
+	for(;;) {
+	  PREFETCH((ptr_t)limit - PREF_DIST*CACHE_LINE_SIZE);
+	  deferred = *limit;
+	  limit = (word *)((char *)limit - ALIGNMENT);
+	  if ((ptr_t)deferred >= least_ha && (ptr_t)deferred <  greatest_ha) {
+	    PREFETCH(deferred);
+	    break;
+	  }
+	  if (current_p > limit) goto next_object;
+	  /* Unroll once, so we don't do too many of the prefetches 	*/
+	  /* based on limit.						*/
+	  deferred = *limit;
+	  limit = (word *)((char *)limit - ALIGNMENT);
+	  if ((ptr_t)deferred >= least_ha && (ptr_t)deferred <  greatest_ha) {
+	    PREFETCH(deferred);
+	    break;
+	  }
+	  if (current_p > limit) goto next_object;
+	}
+#     endif
+
+      while (current_p <= limit) {
+	/* Empirically, unrolling this loop doesn't help a lot.	*/
+	/* Since HC_PUSH_CONTENTS expands to a lot of code,	*/
+	/* we don't.						*/
+        current = *current_p;
+        PREFETCH((ptr_t)current_p + PREF_DIST*CACHE_LINE_SIZE);
+        if ((ptr_t)current >= least_ha && (ptr_t)current <  greatest_ha) {
+  	  /* Prefetch the contents of the object we just pushed.  It's	*/
+  	  /* likely we will need them soon.				*/
+  	  PREFETCH(current);
+          HC_PUSH_CONTENTS((ptr_t)current, GC_mark_stack_top_reg,
+  		           mark_stack_limit, current_p, exit2);
+        }
+        current_p = (word *)((char *)current_p + ALIGNMENT);
+      }
+
+#     ifndef SMALL_CONFIG
+	/* We still need to mark the entry we previously prefetched.	*/
+	/* We alrady know that it passes the preliminary pointer	*/
+	/* validity test.						*/
+        HC_PUSH_CONTENTS((ptr_t)deferred, GC_mark_stack_top_reg,
+  		         mark_stack_limit, current_p, exit4);
+	next_object:;
+#     endif
+    }
+  }
+  GC_mark_stack_top = GC_mark_stack_top_reg;
+}
+
+/* Allocate or reallocate space for mark stack of size s words  */
+/* May silently fail.						*/
+static void alloc_mark_stack(n)
+word n;
+{
+    mse * new_stack = (mse *)GC_scratch_alloc(n * sizeof(struct ms_entry));
+    
+    GC_mark_stack_too_small = FALSE;
+    if (GC_mark_stack_size != 0) {
+        if (new_stack != 0) {
+          word displ = (word)GC_mark_stack & (GC_page_size - 1);
+          signed_word size = GC_mark_stack_size * sizeof(struct ms_entry);
+          
+          /* Recycle old space */
+	      if (0 != displ) displ = GC_page_size - displ;
+	      size = (size - displ) & ~(GC_page_size - 1);
+	      if (size > 0) {
+	        GC_add_to_heap((struct hblk *)
+	      			((word)GC_mark_stack + displ), (word)size);
+	      }
+          GC_mark_stack = new_stack;
+          GC_mark_stack_size = n;
+#	  ifdef PRINTSTATS
+	      GC_printf1("Grew mark stack to %lu frames\n",
+		    	 (unsigned long) GC_mark_stack_size);
+#	  endif
+        } else {
+#	  ifdef PRINTSTATS
+	      GC_printf1("Failed to grow mark stack to %lu frames\n",
+		    	 (unsigned long) n);
+#	  endif
+        }
+    } else {
+        if (new_stack == 0) {
+            GC_err_printf0("No space for mark stack\n");
+            EXIT();
+        }
+        GC_mark_stack = new_stack;
+        GC_mark_stack_size = n;
+    }
+    GC_mark_stack_top = GC_mark_stack-1;
+}
+
+void GC_mark_init()
+{
+    alloc_mark_stack(INITIAL_MARK_STACK_SIZE);
+}
+
+/*
+ * Push all locations between b and t onto the mark stack.
+ * b is the first location to be checked. t is one past the last
+ * location to be checked.
+ * Should only be used if there is no possibility of mark stack
+ * overflow.
+ */
+void GC_push_all(bottom, top)
+ptr_t bottom;
+ptr_t top;
+{
+    register word length;
+    
+    bottom = (ptr_t)(((word) bottom + ALIGNMENT-1) & ~(ALIGNMENT-1));
+    top = (ptr_t)(((word) top) & ~(ALIGNMENT-1));
+    if (top == 0 || bottom == top) return;
+    GC_mark_stack_top++;
+    if (GC_mark_stack_top >= GC_mark_stack + GC_mark_stack_size) {
+	ABORT("unexpected mark stack overflow");
+    }
+    length = top - bottom;
+#   if DS_TAGS > ALIGNMENT - 1
+	length += DS_TAGS;
+	length &= ~DS_TAGS;
+#   endif
+    GC_mark_stack_top -> mse_start = (word *)bottom;
+    GC_mark_stack_top -> mse_descr = length;
+}
+
+/*
+ * Analogous to the above, but push only those pages that may have been
+ * dirtied.  A block h is assumed dirty if dirty_fn(h) != 0.
+ * We use push_fn to actually push the block.
+ * Will not overflow mark stack if push_fn pushes a small fixed number
+ * of entries.  (This is invoked only if push_fn pushes a single entry,
+ * or if it marks each object before pushing it, thus ensuring progress
+ * in the event of a stack overflow.)
+ */
+void GC_push_dirty(bottom, top, dirty_fn, push_fn)
+ptr_t bottom;
+ptr_t top;
+int (*dirty_fn)(/* struct hblk * h */);
+void (*push_fn)(/* ptr_t bottom, ptr_t top */);
+{
+    register struct hblk * h;
+
+    bottom = (ptr_t)(((long) bottom + ALIGNMENT-1) & ~(ALIGNMENT-1));
+    top = (ptr_t)(((long) top) & ~(ALIGNMENT-1));
+
+    if (top == 0 || bottom == top) return;
+    h = HBLKPTR(bottom + HBLKSIZE);
+    if (top <= (ptr_t) h) {
+  	if ((*dirty_fn)(h-1)) {
+	    (*push_fn)(bottom, top);
+	}
+	return;
+    }
+    if ((*dirty_fn)(h-1)) {
+        (*push_fn)(bottom, (ptr_t)h);
+    }
+    while ((ptr_t)(h+1) <= top) {
+	if ((*dirty_fn)(h)) {
+	    if ((word)(GC_mark_stack_top - GC_mark_stack)
+		> 3 * GC_mark_stack_size / 4) {
+	 	/* Danger of mark stack overflow */
+		(*push_fn)((ptr_t)h, top);
+		return;
+	    } else {
+		(*push_fn)((ptr_t)h, (ptr_t)(h+1));
+	    }
+	}
+	h++;
+    }
+    if ((ptr_t)h != top) {
+	if ((*dirty_fn)(h)) {
+            (*push_fn)((ptr_t)h, top);
+        }
+    }
+    if (GC_mark_stack_top >= GC_mark_stack + GC_mark_stack_size) {
+        ABORT("unexpected mark stack overflow");
+    }
+}
+
+# ifndef SMALL_CONFIG
+void GC_push_conditional(bottom, top, all)
+ptr_t bottom;
+ptr_t top;
+int all;
+{
+    if (all) {
+      if (GC_dirty_maintained) {
+#	ifdef PROC_VDB
+	    /* Pages that were never dirtied cannot contain pointers	*/
+	    GC_push_dirty(bottom, top, GC_page_was_ever_dirty, GC_push_all);
+#	else
+	    GC_push_all(bottom, top);
+#	endif
+      } else {
+      	GC_push_all(bottom, top);
+      }
+    } else {
+	GC_push_dirty(bottom, top, GC_page_was_dirty, GC_push_all);
+    }
+}
+#endif
+
+# ifdef MSWIN32
+  void __cdecl GC_push_one(p)
+# else
+  void GC_push_one(p)
+# endif
+word p;
+{
+#   ifdef NURSERY
+      if (0 != GC_push_proc) {
+	GC_push_proc(p);
+	return;
+      }
+#   endif
+    GC_PUSH_ONE_STACK(p, MARKED_FROM_REGISTER);
+}
+
+# ifdef __STDC__
+#   define BASE(p) (word)GC_base((void *)(p))
+# else
+#   define BASE(p) (word)GC_base((char *)(p))
+# endif
+
+/* As above, but argument passed preliminary test. */
+# if defined(PRINT_BLACK_LIST) || defined(KEEP_BACK_PTRS)
+    void GC_push_one_checked(p, interior_ptrs, source)
+    ptr_t source;
+# else
+    void GC_push_one_checked(p, interior_ptrs)
+#   define source 0
+# endif
+register word p;
+register GC_bool interior_ptrs;
+{
+    register word r;
+    register hdr * hhdr; 
+    register int displ;
+  
+    GET_HDR(p, hhdr);
+    if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+        if (hhdr != 0 && interior_ptrs) {
+          r = BASE(p);
+	  hhdr = HDR(r);
+	  displ = BYTES_TO_WORDS(HBLKDISPL(r));
+	} else {
+	  hhdr = 0;
+	}
+    } else {
+        register map_entry_type map_entry;
+        
+        displ = HBLKDISPL(p);
+        map_entry = MAP_ENTRY((hhdr -> hb_map), displ);
+        if (map_entry == OBJ_INVALID) {
+#	  ifndef ALL_INTERIOR_POINTERS
+            if (interior_ptrs) {
+              r = BASE(p);
+	      displ = BYTES_TO_WORDS(HBLKDISPL(r));
+	      if (r == 0) hhdr = 0;
+            } else {
+              hhdr = 0;
+            }
+#	  else
+	    /* map already reflects interior pointers */
+	    hhdr = 0;
+#	  endif
+        } else {
+          displ = BYTES_TO_WORDS(displ);
+          displ -= map_entry;
+          r = (word)((word *)(HBLKPTR(p)) + displ);
+        }
+    }
+    /* If hhdr != 0 then r == GC_base(p), only we did it faster. */
+    /* displ is the word index within the block.		 */
+    if (hhdr == 0) {
+    	if (interior_ptrs) {
+#	    ifdef PRINT_BLACK_LIST
+	      GC_add_to_black_list_stack(p, source);
+#	    else
+	      GC_add_to_black_list_stack(p);
+#	    endif
+	} else {
+	    GC_ADD_TO_BLACK_LIST_NORMAL(p, source);
+#	    undef source  /* In case we had to define it. */
+	}
+    } else {
+	if (!mark_bit_from_hdr(hhdr, displ)) {
+	    set_mark_bit_from_hdr(hhdr, displ);
+ 	    GC_STORE_BACK_PTR(source, (ptr_t)r);
+	    PUSH_OBJ((word *)r, hhdr, GC_mark_stack_top,
+	             &(GC_mark_stack[GC_mark_stack_size]));
+	}
+    }
+}
+
+# ifdef TRACE_BUF
+
+# define TRACE_ENTRIES 1000
+
+struct trace_entry {
+    char * kind;
+    word gc_no;
+    word words_allocd;
+    word arg1;
+    word arg2;
+} GC_trace_buf[TRACE_ENTRIES];
+
+int GC_trace_buf_ptr = 0;
+
+void GC_add_trace_entry(char *kind, word arg1, word arg2)
+{
+    GC_trace_buf[GC_trace_buf_ptr].kind = kind;
+    GC_trace_buf[GC_trace_buf_ptr].gc_no = GC_gc_no;
+    GC_trace_buf[GC_trace_buf_ptr].words_allocd = GC_words_allocd;
+    GC_trace_buf[GC_trace_buf_ptr].arg1 = arg1 ^ 0x80000000;
+    GC_trace_buf[GC_trace_buf_ptr].arg2 = arg2 ^ 0x80000000;
+    GC_trace_buf_ptr++;
+    if (GC_trace_buf_ptr >= TRACE_ENTRIES) GC_trace_buf_ptr = 0;
+}
+
+void GC_print_trace(word gc_no, GC_bool lock)
+{
+    int i;
+    struct trace_entry *p;
+    
+    if (lock) LOCK();
+    for (i = GC_trace_buf_ptr-1; i != GC_trace_buf_ptr; i--) {
+    	if (i < 0) i = TRACE_ENTRIES-1;
+    	p = GC_trace_buf + i;
+    	if (p -> gc_no < gc_no || p -> kind == 0) return;
+    	printf("Trace:%s (gc:%d,words:%d) 0x%X, 0x%X\n",
+    		p -> kind, p -> gc_no, p -> words_allocd,
+    		(p -> arg1) ^ 0x80000000, (p -> arg2) ^ 0x80000000);
+    }
+    printf("Trace incomplete\n");
+    if (lock) UNLOCK();
+}
+
+# endif /* TRACE_BUF */
+
+/*
+ * A version of GC_push_all that treats all interior pointers as valid
+ * and scans the entire region immediately, in case the contents
+ * change.
+ */
+void GC_push_all_eager(bottom, top)
+ptr_t bottom;
+ptr_t top;
+{
+    word * b = (word *)(((long) bottom + ALIGNMENT-1) & ~(ALIGNMENT-1));
+    word * t = (word *)(((long) top) & ~(ALIGNMENT-1));
+    register word *p;
+    register word q;
+    register word *lim;
+    register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+    register ptr_t least_ha = GC_least_plausible_heap_addr;
+#   define GC_greatest_plausible_heap_addr greatest_ha
+#   define GC_least_plausible_heap_addr least_ha
+
+    if (top == 0) return;
+    /* check all pointers in range and put in push if they appear */
+    /* to be valid.						  */
+      lim = t - 1 /* longword */;
+      for (p = b; p <= lim; p = (word *)(((char *)p) + ALIGNMENT)) {
+	q = *p;
+	GC_PUSH_ONE_STACK(q, p);
+      }
+#   undef GC_greatest_plausible_heap_addr
+#   undef GC_least_plausible_heap_addr
+}
+
+#ifndef THREADS
+/*
+ * A version of GC_push_all that treats all interior pointers as valid
+ * and scans part of the area immediately, to make sure that saved
+ * register values are not lost.
+ * Cold_gc_frame delimits the stack section that must be scanned
+ * eagerly.  A zero value indicates that no eager scanning is needed.
+ */
+void GC_push_all_stack_partially_eager(bottom, top, cold_gc_frame)
+ptr_t bottom;
+ptr_t top;
+ptr_t cold_gc_frame;
+{
+# ifdef ALL_INTERIOR_POINTERS
+#   define EAGER_BYTES 1024
+    /* Push the hot end of the stack eagerly, so that register values   */
+    /* saved inside GC frames are marked before they disappear.		*/
+    /* The rest of the marking can be deferred until later.		*/
+    if (0 == cold_gc_frame) {
+	GC_push_all_stack(bottom, top);
+	return;
+    }
+#   ifdef STACK_GROWS_DOWN
+	GC_push_all_eager(bottom, cold_gc_frame);
+	GC_push_all(cold_gc_frame - sizeof(ptr_t), top);
+#   else /* STACK_GROWS_UP */
+	GC_push_all_eager(cold_gc_frame, top);
+	GC_push_all(bottom, cold_gc_frame + sizeof(ptr_t));
+#   endif /* STACK_GROWS_UP */
+# else
+    GC_push_all_eager(bottom, top);
+# endif
+# ifdef TRACE_BUF
+      GC_add_trace_entry("GC_push_all_stack", bottom, top);
+# endif
+}
+#endif /* !THREADS */
+
+void GC_push_all_stack(bottom, top)
+ptr_t bottom;
+ptr_t top;
+{
+# ifdef ALL_INTERIOR_POINTERS
+    GC_push_all(bottom, top);
+# else
+    GC_push_all_eager(bottom, top);
+# endif
+}
+
+#ifndef SMALL_CONFIG
+/* Push all objects reachable from marked objects in the given block */
+/* of size 1 objects.						     */
+void GC_push_marked1(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+    word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
+    register word *p;
+    word *plim;
+    register int i;
+    register word q;
+    register word mark_word;
+    register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+    register ptr_t least_ha = GC_least_plausible_heap_addr;
+#   define GC_greatest_plausible_heap_addr greatest_ha
+#   define GC_least_plausible_heap_addr least_ha
+    
+    p = (word *)(h->hb_body);
+    plim = (word *)(((word)h) + HBLKSIZE);
+
+    /* go through all words in block */
+	while( p < plim )  {
+	    mark_word = *mark_word_addr++;
+	    i = 0;
+	    while(mark_word != 0) {
+	      if (mark_word & 1) {
+	          q = p[i];
+	          GC_PUSH_ONE_HEAP(q, p + i);
+	      }
+	      i++;
+	      mark_word >>= 1;
+	    }
+	    p += WORDSZ;
+	}
+#   undef GC_greatest_plausible_heap_addr
+#   undef GC_least_plausible_heap_addr        
+}
+
+
+#ifndef UNALIGNED
+
+/* Push all objects reachable from marked objects in the given block */
+/* of size 2 objects.						     */
+void GC_push_marked2(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+    word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
+    register word *p;
+    word *plim;
+    register int i;
+    register word q;
+    register word mark_word;
+    register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+    register ptr_t least_ha = GC_least_plausible_heap_addr;
+#   define GC_greatest_plausible_heap_addr greatest_ha
+#   define GC_least_plausible_heap_addr least_ha
+    
+    p = (word *)(h->hb_body);
+    plim = (word *)(((word)h) + HBLKSIZE);
+
+    /* go through all words in block */
+	while( p < plim )  {
+	    mark_word = *mark_word_addr++;
+	    i = 0;
+	    while(mark_word != 0) {
+	      if (mark_word & 1) {
+	          q = p[i];
+	          GC_PUSH_ONE_HEAP(q, p + i);
+	          q = p[i+1];
+	          GC_PUSH_ONE_HEAP(q, p + i);
+	      }
+	      i += 2;
+	      mark_word >>= 2;
+	    }
+	    p += WORDSZ;
+	}
+#   undef GC_greatest_plausible_heap_addr
+#   undef GC_least_plausible_heap_addr        
+}
+
+/* Push all objects reachable from marked objects in the given block */
+/* of size 4 objects.						     */
+/* There is a risk of mark stack overflow here.  But we handle that. */
+/* And only unmarked objects get pushed, so it's not very likely.    */
+void GC_push_marked4(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+    word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
+    register word *p;
+    word *plim;
+    register int i;
+    register word q;
+    register word mark_word;
+    register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+    register ptr_t least_ha = GC_least_plausible_heap_addr;
+#   define GC_greatest_plausible_heap_addr greatest_ha
+#   define GC_least_plausible_heap_addr least_ha
+    
+    p = (word *)(h->hb_body);
+    plim = (word *)(((word)h) + HBLKSIZE);
+
+    /* go through all words in block */
+	while( p < plim )  {
+	    mark_word = *mark_word_addr++;
+	    i = 0;
+	    while(mark_word != 0) {
+	      if (mark_word & 1) {
+	          q = p[i];
+	          GC_PUSH_ONE_HEAP(q, p + i);
+	          q = p[i+1];
+	          GC_PUSH_ONE_HEAP(q, p + i + 1);
+	          q = p[i+2];
+	          GC_PUSH_ONE_HEAP(q, p + i + 2);
+	          q = p[i+3];
+	          GC_PUSH_ONE_HEAP(q, p + i + 3);
+	      }
+	      i += 4;
+	      mark_word >>= 4;
+	    }
+	    p += WORDSZ;
+	}
+#   undef GC_greatest_plausible_heap_addr
+#   undef GC_least_plausible_heap_addr        
+}
+
+#endif /* UNALIGNED */
+
+#endif /* SMALL_CONFIG */
+
+/* Push all objects reachable from marked objects in the given block */
+void GC_push_marked(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+    register int sz = hhdr -> hb_sz;
+    register int descr = hhdr -> hb_descr;
+    register word * p;
+    register int word_no;
+    register word * lim;
+    register mse * GC_mark_stack_top_reg;
+    register mse * mark_stack_limit = &(GC_mark_stack[GC_mark_stack_size]);
+    
+    /* Some quick shortcuts: */
+	if ((0 | DS_LENGTH) == descr) return;
+        if (GC_block_empty(hhdr)/* nothing marked */) return;
+#   ifdef GATHERSTATS
+        GC_n_rescuing_pages++;
+#   endif
+    GC_objects_are_marked = TRUE;
+    if (sz > MAXOBJSZ) {
+        lim = (word *)h + HDR_WORDS;
+    } else {
+        lim = (word *)(h + 1) - sz;
+    }
+    
+    switch(sz) {
+#   if !defined(SMALL_CONFIG)    
+     case 1:
+       GC_push_marked1(h, hhdr);
+       break;
+#   endif
+#   if !defined(SMALL_CONFIG) && !defined(UNALIGNED)
+     case 2:
+       GC_push_marked2(h, hhdr);
+       break;
+     case 4:
+       GC_push_marked4(h, hhdr);
+       break;
+#   endif       
+     default:
+      GC_mark_stack_top_reg = GC_mark_stack_top;
+      for (p = (word *)h + HDR_WORDS, word_no = HDR_WORDS; p <= lim;
+         p += sz, word_no += sz) {
+         if (mark_bit_from_hdr(hhdr, word_no)) {
+           /* Mark from fields inside the object */
+             PUSH_OBJ((word *)p, hhdr, GC_mark_stack_top_reg, mark_stack_limit);
+#	     ifdef GATHERSTATS
+		/* Subtract this object from total, since it was	*/
+		/* added in twice.					*/
+		GC_composite_in_use -= sz;
+#	     endif
+         }
+      }
+      GC_mark_stack_top = GC_mark_stack_top_reg;
+    }
+}
+
+#ifndef SMALL_CONFIG
+/* Test whether any page in the given block is dirty	*/
+GC_bool GC_block_was_dirty(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+    register int sz = hhdr -> hb_sz;
+    
+    if (sz < MAXOBJSZ) {
+         return(GC_page_was_dirty(h));
+    } else {
+    	 register ptr_t p = (ptr_t)h;
+         sz += HDR_WORDS;
+         sz = WORDS_TO_BYTES(sz);
+         while (p < (ptr_t)h + sz) {
+             if (GC_page_was_dirty((struct hblk *)p)) return(TRUE);
+             p += HBLKSIZE;
+         }
+         return(FALSE);
+    }
+}
+#endif /* SMALL_CONFIG */
+
+/* Similar to GC_push_next_marked, but return address of next block	*/
+struct hblk * GC_push_next_marked(h)
+struct hblk *h;
+{
+    register hdr * hhdr;
+    
+    h = GC_next_used_block(h);
+    if (h == 0) return(0);
+    hhdr = HDR(h);
+    GC_push_marked(h, hhdr);
+    return(h + OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz));
+}
+
+#ifndef SMALL_CONFIG
+/* Identical to above, but mark only from dirty pages	*/
+struct hblk * GC_push_next_marked_dirty(h)
+struct hblk *h;
+{
+    register hdr * hhdr;
+    
+    if (!GC_dirty_maintained) { ABORT("dirty bits not set up"); }
+    for (;;) {
+        h = GC_next_used_block(h);
+        if (h == 0) return(0);
+        hhdr = HDR(h);
+#	ifdef STUBBORN_ALLOC
+          if (hhdr -> hb_obj_kind == STUBBORN) {
+            if (GC_page_was_changed(h) && GC_block_was_dirty(h, hhdr)) {
+                break;
+            }
+          } else {
+            if (GC_block_was_dirty(h, hhdr)) break;
+          }
+#	else
+	  if (GC_block_was_dirty(h, hhdr)) break;
+#	endif
+        h += OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz);
+    }
+    GC_push_marked(h, hhdr);
+    return(h + OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz));
+}
+#endif
+
+/* Similar to above, but for uncollectable pages.  Needed since we	*/
+/* do not clear marks for such pages, even for full collections.	*/
+struct hblk * GC_push_next_marked_uncollectable(h)
+struct hblk *h;
+{
+    register hdr * hhdr = HDR(h);
+    
+    for (;;) {
+        h = GC_next_used_block(h);
+        if (h == 0) return(0);
+        hhdr = HDR(h);
+	if (hhdr -> hb_obj_kind == UNCOLLECTABLE) break;
+        h += OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz);
+    }
+    GC_push_marked(h, hhdr);
+    return(h + OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz));
+}
+
+
diff --git a/src/gc/mark_rts.c b/src/gc/mark_rts.c
new file mode 100644
index 000000000..5bafd07ed
--- /dev/null
+++ b/src/gc/mark_rts.c
@@ -0,0 +1,514 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, October 9, 1995 1:06 pm PDT */
+# include <stdio.h>
+# include "gc_priv.h"
+
+/* Data structure for list of root sets.				*/
+/* We keep a hash table, so that we can filter out duplicate additions.	*/
+/* Under Win32, we need to do a better job of filtering overlaps, so	*/
+/* we resort to sequential search, and pay the price.			*/
+/* This is really declared in gc_priv.h:
+struct roots {
+	ptr_t r_start;
+	ptr_t r_end;
+ #	ifndef MSWIN32
+	  struct roots * r_next;
+ #	endif
+	GC_bool r_tmp;
+	  	-- Delete before registering new dynamic libraries
+};
+
+struct roots GC_static_roots[MAX_ROOT_SETS];
+*/
+
+static int n_root_sets = 0;
+
+	/* GC_static_roots[0..n_root_sets) contains the valid root sets. */
+
+# if !defined(NO_DEBUGGING)
+/* For debugging:	*/
+void GC_print_static_roots()
+{
+    register int i;
+    size_t total = 0;
+    
+    for (i = 0; i < n_root_sets; i++) {
+        GC_printf2("From 0x%lx to 0x%lx ",
+        	   (unsigned long) GC_static_roots[i].r_start,
+        	   (unsigned long) GC_static_roots[i].r_end);
+        if (GC_static_roots[i].r_tmp) {
+            GC_printf0(" (temporary)\n");
+        } else {
+            GC_printf0("\n");
+        }
+        total += GC_static_roots[i].r_end - GC_static_roots[i].r_start;
+    }
+    GC_printf1("Total size: %ld\n", (unsigned long) total);
+    if (GC_root_size != total) {
+     	GC_printf1("GC_root_size incorrect: %ld!!\n",
+     		   (unsigned long) GC_root_size);
+    }
+}
+# endif /* NO_DEBUGGING */
+
+/* Primarily for debugging support:	*/
+/* Is the address p in one of the registered static			*/
+/* root sections?							*/
+GC_bool GC_is_static_root(p)
+ptr_t p;
+{
+    static int last_root_set = 0;
+    register int i;
+    
+    
+    if (p >= GC_static_roots[last_root_set].r_start
+        && p < GC_static_roots[last_root_set].r_end) return(TRUE);
+    for (i = 0; i < n_root_sets; i++) {
+    	if (p >= GC_static_roots[i].r_start
+            && p < GC_static_roots[i].r_end) {
+            last_root_set = i;
+            return(TRUE);
+        }
+    }
+    return(FALSE);
+}
+
+#ifndef MSWIN32
+/* 
+#   define LOG_RT_SIZE 6
+#   define RT_SIZE (1 << LOG_RT_SIZE)  -- Power of 2, may be != MAX_ROOT_SETS
+
+    struct roots * GC_root_index[RT_SIZE];
+	-- Hash table header.  Used only to check whether a range is
+	-- already present.
+	-- really defined in gc_priv.h
+*/
+
+static int rt_hash(addr)
+char * addr;
+{
+    word result = (word) addr;
+#   if CPP_WORDSZ > 8*LOG_RT_SIZE
+	result ^= result >> 8*LOG_RT_SIZE;
+#   endif
+#   if CPP_WORDSZ > 4*LOG_RT_SIZE
+	result ^= result >> 4*LOG_RT_SIZE;
+#   endif
+    result ^= result >> 2*LOG_RT_SIZE;
+    result ^= result >> LOG_RT_SIZE;
+    result &= (RT_SIZE-1);
+    return(result);
+}
+
+/* Is a range starting at b already in the table? If so return a	*/
+/* pointer to it, else NIL.						*/
+struct roots * GC_roots_present(b)
+char *b;
+{
+    register int h = rt_hash(b);
+    register struct roots *p = GC_root_index[h];
+    
+    while (p != 0) {
+        if (p -> r_start == (ptr_t)b) return(p);
+        p = p -> r_next;
+    }
+    return(FALSE);
+}
+
+/* Add the given root structure to the index. */
+static void add_roots_to_index(p)
+struct roots *p;
+{
+    register int h = rt_hash(p -> r_start);
+    
+    p -> r_next = GC_root_index[h];
+    GC_root_index[h] = p;
+}
+
+# else /* MSWIN32 */
+
+#   define add_roots_to_index(p)
+
+# endif
+
+
+
+
+word GC_root_size = 0;
+
+void GC_add_roots(b, e)
+char * b; char * e;
+{
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    GC_add_roots_inner(b, e, FALSE);
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+
+
+/* Add [b,e) to the root set.  Adding the same interval a second time	*/
+/* is a moderately fast noop, and hence benign.  We do not handle	*/
+/* different but overlapping intervals efficiently.  (We do handle	*/
+/* them correctly.)							*/
+/* Tmp specifies that the interval may be deleted before 		*/
+/* reregistering dynamic libraries.					*/ 
+void GC_add_roots_inner(b, e, tmp)
+char * b; char * e;
+GC_bool tmp;
+{
+    struct roots * old;
+    
+#   ifdef MSWIN32
+      /* Spend the time to ensure that there are no overlapping	*/
+      /* or adjacent intervals.					*/
+      /* This could be done faster with e.g. a			*/
+      /* balanced tree.  But the execution time here is		*/
+      /* virtually guaranteed to be dominated by the time it	*/
+      /* takes to scan the roots.				*/
+      {
+        register int i;
+        
+        for (i = 0; i < n_root_sets; i++) {
+            old = GC_static_roots + i;
+            if ((ptr_t)b <= old -> r_end && (ptr_t)e >= old -> r_start) {
+                if ((ptr_t)b < old -> r_start) {
+                    old -> r_start = (ptr_t)b;
+                    GC_root_size += (old -> r_start - (ptr_t)b);
+                }
+                if ((ptr_t)e > old -> r_end) {
+                    old -> r_end = (ptr_t)e;
+                    GC_root_size += ((ptr_t)e - old -> r_end);
+                }
+                old -> r_tmp &= tmp;
+                break;
+            }
+        }
+        if (i < n_root_sets) {
+          /* merge other overlapping intervals */
+            struct roots *other;
+            
+            for (i++; i < n_root_sets; i++) {
+              other = GC_static_roots + i;
+              b = (char *)(other -> r_start);
+              e = (char *)(other -> r_end);
+              if ((ptr_t)b <= old -> r_end && (ptr_t)e >= old -> r_start) {
+                if ((ptr_t)b < old -> r_start) {
+                    old -> r_start = (ptr_t)b;
+                    GC_root_size += (old -> r_start - (ptr_t)b);
+                }
+                if ((ptr_t)e > old -> r_end) {
+                    old -> r_end = (ptr_t)e;
+                    GC_root_size += ((ptr_t)e - old -> r_end);
+                }
+                old -> r_tmp &= other -> r_tmp;
+                /* Delete this entry. */
+                  GC_root_size -= (other -> r_end - other -> r_start);
+                  other -> r_start = GC_static_roots[n_root_sets-1].r_start;
+                  other -> r_end = GC_static_roots[n_root_sets-1].r_end;
+                                  n_root_sets--;
+              }
+            }
+          return;
+        }
+      }
+#   else
+      old = GC_roots_present(b);
+      if (old != 0) {
+        if ((ptr_t)e <= old -> r_end) /* already there */ return;
+        /* else extend */
+        GC_root_size += (ptr_t)e - old -> r_end;
+        old -> r_end = (ptr_t)e;
+        return;
+      }
+#   endif
+    if (n_root_sets == MAX_ROOT_SETS) {
+        ABORT("Too many root sets\n");
+    }
+    GC_static_roots[n_root_sets].r_start = (ptr_t)b;
+    GC_static_roots[n_root_sets].r_end = (ptr_t)e;
+    GC_static_roots[n_root_sets].r_tmp = tmp;
+#   ifndef MSWIN32
+      GC_static_roots[n_root_sets].r_next = 0;
+#   endif
+    add_roots_to_index(GC_static_roots + n_root_sets);
+    GC_root_size += (ptr_t)e - (ptr_t)b;
+    n_root_sets++;
+}
+
+void GC_clear_roots GC_PROTO((void))
+{
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    n_root_sets = 0;
+    GC_root_size = 0;
+#   ifndef MSWIN32
+    {
+    	register int i;
+    	
+    	for (i = 0; i < RT_SIZE; i++) GC_root_index[i] = 0;
+    }
+#   endif
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+
+/* Internal use only; lock held.	*/
+void GC_remove_tmp_roots()
+{
+    register int i;
+    
+    for (i = 0; i < n_root_sets; ) {
+    	if (GC_static_roots[i].r_tmp) {
+    	    GC_root_size -=
+		(GC_static_roots[i].r_end - GC_static_roots[i].r_start);
+    	    GC_static_roots[i].r_start = GC_static_roots[n_root_sets-1].r_start;
+    	    GC_static_roots[i].r_end = GC_static_roots[n_root_sets-1].r_end;
+    	    GC_static_roots[i].r_tmp = GC_static_roots[n_root_sets-1].r_tmp;
+    	    n_root_sets--;
+    	} else {
+    	    i++;
+    	}
+    }
+#   ifndef MSWIN32
+    {
+    	register int i;
+    	
+    	for (i = 0; i < RT_SIZE; i++) GC_root_index[i] = 0;
+    	for (i = 0; i < n_root_sets; i++)
+		add_roots_to_index(GC_static_roots + i);
+    }
+#   endif
+    
+}
+
+ptr_t GC_approx_sp()
+{
+    word dummy;
+    
+    return((ptr_t)(&dummy));
+}
+
+/*
+ * Data structure for excluded static roots.
+ * Real declaration is in gc_priv.h.
+
+struct exclusion {
+    ptr_t e_start;
+    ptr_t e_end;
+};
+
+struct exclusion GC_excl_table[MAX_EXCLUSIONS];
+					-- Array of exclusions, ascending
+					-- address order.
+*/
+
+size_t GC_excl_table_entries = 0;	/* Number of entries in use.	  */
+
+/* Return the first exclusion range that includes an address >= start_addr */
+/* Assumes the exclusion table contains at least one entry (namely the	   */
+/* GC data structures).							   */
+struct exclusion * GC_next_exclusion(start_addr)
+ptr_t start_addr;
+{
+    size_t low = 0;
+    size_t high = GC_excl_table_entries - 1;
+    size_t mid;
+
+    while (high > low) {
+	mid = (low + high) >> 1;
+	/* low <= mid < high	*/
+	if ((word) GC_excl_table[mid].e_end <= (word) start_addr) {
+	    low = mid + 1;
+	} else {
+	    high = mid;
+	}
+    }
+    if ((word) GC_excl_table[low].e_end <= (word) start_addr) return 0;
+    return GC_excl_table + low;
+}
+
+void GC_exclude_static_roots(start, finish)
+GC_PTR start;
+GC_PTR finish;
+{
+    struct exclusion * next;
+    size_t next_index, i;
+
+    if (0 == GC_excl_table_entries) {
+	next = 0;
+    } else {
+	next = GC_next_exclusion(start);
+    }
+    if (0 != next) {
+      if ((word)(next -> e_start) < (word) finish) {
+	/* incomplete error check. */
+	ABORT("exclusion ranges overlap");
+      }  
+      if ((word)(next -> e_start) == (word) finish) {
+        /* extend old range backwards	*/
+          next -> e_start = (ptr_t)start;
+	  return;
+      }
+      next_index = next - GC_excl_table;
+      for (i = GC_excl_table_entries; i > next_index; --i) {
+	GC_excl_table[i] = GC_excl_table[i-1];
+      }
+    } else {
+      next_index = GC_excl_table_entries;
+    }
+    if (GC_excl_table_entries == MAX_EXCLUSIONS) ABORT("Too many exclusions");
+    GC_excl_table[next_index].e_start = (ptr_t)start;
+    GC_excl_table[next_index].e_end = (ptr_t)finish;
+    ++GC_excl_table_entries;
+}
+
+/* Invoke push_conditional on ranges that are not excluded. */
+void GC_push_conditional_with_exclusions(bottom, top, all)
+ptr_t bottom;
+ptr_t top;
+int all;
+{
+    struct exclusion * next;
+    ptr_t excl_start;
+
+    while (bottom < top) {
+        next = GC_next_exclusion(bottom);
+	if (0 == next || (excl_start = next -> e_start) >= top) {
+	    GC_push_conditional(bottom, top, all);
+	    return;
+	}
+	if (excl_start > bottom) GC_push_conditional(bottom, excl_start, all);
+	bottom = next -> e_end;
+    }
+}
+
+/*
+ * In the absence of threads, push the stack contents.
+ * In the presence of threads, push enough of the current stack
+ * to ensure that callee-save registers saved in collector frames have been
+ * seen.
+ */
+void GC_push_current_stack(cold_gc_frame)
+ptr_t cold_gc_frame;
+{
+#   if defined(THREADS)
+	if (0 == cold_gc_frame) return;
+#       ifdef STACK_GROWS_DOWN
+    	  GC_push_all_eager(GC_approx_sp(), cold_gc_frame);
+	  /* For IA64, the register stack backing store is handled 	*/
+	  /* in the thread-specific code.				*/
+#       else
+	  GC_push_all_eager( cold_gc_frame, GC_approx_sp() );
+#       endif
+#   else
+#   	ifdef STACK_GROWS_DOWN
+    	    GC_push_all_stack_partially_eager( GC_approx_sp(), GC_stackbottom,
+					       cold_gc_frame );
+#	    ifdef IA64
+	      /* We also need to push the register stack backing store. */
+	      /* This should really be done in the same way as the	*/
+	      /* regular stack.  For now we fudge it a bit.		*/
+	      /* Note that the backing store grows up, so we can't use	*/
+	      /* GC_push_all_stack_partially_eager.			*/
+	      {
+		extern word GC_save_regs_ret_val;
+			/* Previously set to backing store pointer.	*/
+		ptr_t bsp = (ptr_t) GC_save_regs_ret_val;
+	        ptr_t cold_gc_bs_pointer;
+#		ifdef ALL_INTERIOR_POINTERS
+	          cold_gc_bs_pointer = bsp - 2048;
+		  if (cold_gc_bs_pointer < BACKING_STORE_BASE) {
+		    cold_gc_bs_pointer = BACKING_STORE_BASE;
+		  }
+		  GC_push_all(BACKING_STORE_BASE, cold_gc_bs_pointer);
+#		else
+		  cold_gc_bs_pointer = BACKING_STORE_BASE;
+#		endif
+		GC_push_all_eager(cold_gc_bs_pointer, bsp);
+		/* All values should be sufficiently aligned that we	*/
+		/* dont have to worry about the boundary.		*/
+	      }
+#	    endif
+#       else
+	    GC_push_all_stack_partially_eager( GC_stackbottom, GC_approx_sp(),
+					       cold_gc_frame );
+#       endif
+#   endif /* !THREADS */
+}
+
+/*
+ * Call the mark routines (GC_tl_push for a single pointer, GC_push_conditional
+ * on groups of pointers) on every top level accessible pointer.
+ * If all is FALSE, arrange to push only possibly altered values.
+ * Cold_gc_frame is an address inside a GC frame that
+ * remains valid until all marking is complete.
+ * A zero value indicates that it's OK to miss some
+ * register values.
+ */
+void GC_push_roots(all, cold_gc_frame)
+GC_bool all;
+ptr_t cold_gc_frame;
+{
+    register int i;
+
+    /*
+     * push registers - i.e., call GC_push_one(r) for each
+     * register contents r.
+     */
+#   ifdef USE_GENERIC_PUSH_REGS
+	GC_generic_push_regs(cold_gc_frame);
+#   else
+        GC_push_regs(); /* usually defined in machine_dep.c */
+#   endif
+        
+    /*
+     * Next push static data.  This must happen early on, since it's
+     * not robust against mark stack overflow.
+     */
+     /* Reregister dynamic libraries, in case one got added.	*/
+#      if (defined(DYNAMIC_LOADING) || defined(MSWIN32) || defined(PCR)) \
+           && !defined(SRC_M3)
+         GC_remove_tmp_roots();
+         GC_register_dynamic_libraries();
+#      endif
+     /* Mark everything in static data areas                             */
+       for (i = 0; i < n_root_sets; i++) {
+         GC_push_conditional_with_exclusions(
+			     GC_static_roots[i].r_start,
+			     GC_static_roots[i].r_end, all);
+       }
+
+    /*
+     * Now traverse stacks.
+     */
+#   if !defined(USE_GENERIC_PUSH_REGS)
+	GC_push_current_stack(cold_gc_frame);
+	/* IN the threads case, this only pushes collector frames.      */
+	/* In the USE_GENERIC_PUSH_REGS case, this is done inside	*/
+	/* GC_push_regs, so that we catch callee-save registers saved	*/
+	/* inside the GC_push_regs frame.				*/
+	/* In the case of linux threads on Ia64, the hot section of	*/
+	/* the main stack is marked here, but the register stack	*/
+	/* backing store is handled in the threads-specific code.	*/
+#   endif
+    if (GC_push_other_roots != 0) (*GC_push_other_roots)();
+    	/* In the threads case, this also pushes thread stacks.	*/
+}
+
diff --git a/src/gc/mips_sgi_mach_dep.s b/src/gc/mips_sgi_mach_dep.s
new file mode 100644
index 000000000..03c4b9806
--- /dev/null
+++ b/src/gc/mips_sgi_mach_dep.s
@@ -0,0 +1,40 @@
+#include <sys/regdef.h>
+#include <sys/asm.h>
+
+# define call_push(x)     move    $4,x;    jal     GC_push_one
+
+    .text
+/* Mark from machine registers that are saved by C compiler */
+#   define FRAMESZ 32
+#   define RAOFF FRAMESZ-SZREG
+#   define GPOFF FRAMESZ-(2*SZREG)
+    NESTED(GC_push_regs, FRAMESZ, ra)
+    .mask 0x80000000,-SZREG	# inform debugger of saved ra loc
+    move 	t0,gp
+    SETUP_GPX(t8)
+    PTR_SUBU	sp,FRAMESZ
+#   ifdef SETUP_GP64
+      SETUP_GP64(GPOFF, GC_push_regs)
+#   endif
+    SAVE_GP(GPOFF)
+    REG_S 	ra,RAOFF(sp)
+#   if (_MIPS_SIM == _MIPS_SIM_ABI32)
+    	call_push($2)
+    	call_push($3)
+#   endif
+    call_push($16)
+    call_push($17)
+    call_push($18)
+    call_push($19)
+    call_push($20)
+    call_push($21)
+    call_push($22)
+    call_push($23)
+    call_push($30)
+    REG_L	ra,RAOFF(sp)
+#   ifdef RESTORE_GP64
+      RESTORE_GP64
+#   endif
+    PTR_ADDU	sp,FRAMESZ
+    j		ra
+    .end    GC_push_regs
diff --git a/src/gc/mips_ultrix_mach_dep.s b/src/gc/mips_ultrix_mach_dep.s
new file mode 100644
index 000000000..178224e31
--- /dev/null
+++ b/src/gc/mips_ultrix_mach_dep.s
@@ -0,0 +1,26 @@
+# define call_push(x)     move    $4,x;    jal     GC_push_one
+
+    .text
+ # Mark from machine registers that are saved by C compiler
+    .globl  GC_push_regs
+    .ent    GC_push_regs
+GC_push_regs:
+    subu    $sp,8       ## Need to save only return address
+    sw      $31,4($sp)
+    .mask   0x80000000,-4
+    .frame  $sp,8,$31
+    call_push($2)
+    call_push($3)
+    call_push($16)
+    call_push($17)
+    call_push($18)
+    call_push($19)
+    call_push($20)
+    call_push($21)
+    call_push($22)
+    call_push($23)
+    call_push($30)
+    lw      $31,4($sp)
+    addu    $sp,8
+    j       $31
+    .end    GC_push_regs
diff --git a/src/gc/misc.c b/src/gc/misc.c
new file mode 100644
index 000000000..780dc7b56
--- /dev/null
+++ b/src/gc/misc.c
@@ -0,0 +1,846 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, July 31, 1995 5:02 pm PDT */
+
+
+#include <stdio.h>
+#include <signal.h>
+
+#define I_HIDE_POINTERS	/* To make GC_call_with_alloc_lock visible */
+#include "gc_priv.h"
+
+#ifdef SOLARIS_THREADS
+# include <sys/syscall.h>
+#endif
+#ifdef MSWIN32
+# include <windows.h>
+#endif
+
+# ifdef THREADS
+#   ifdef PCR
+#     include "il/PCR_IL.h"
+      PCR_Th_ML GC_allocate_ml;
+#   else
+#     ifdef SRC_M3
+	/* Critical section counter is defined in the M3 runtime 	*/
+	/* That's all we use.						*/
+#     else
+#	ifdef SOLARIS_THREADS
+	  mutex_t GC_allocate_ml;	/* Implicitly initialized.	*/
+#	else
+#          ifdef WIN32_THREADS
+	      GC_API CRITICAL_SECTION GC_allocate_ml;
+#          else
+#             if defined(IRIX_THREADS) || defined(IRIX_JDK_THREADS) \
+		 || (defined(LINUX_THREADS) && defined(USE_SPIN_LOCK))
+	        pthread_t GC_lock_holder = NO_THREAD;
+#	      else
+#	        if defined(HPUX_THREADS) \
+		   || defined(LINUX_THREADS) && !defined(USE_SPIN_LOCK)
+		  pthread_mutex_t GC_allocate_ml = PTHREAD_MUTEX_INITIALIZER;
+#		else 
+	          --> declare allocator lock here
+#		endif
+#	      endif
+#	   endif
+#	endif
+#     endif
+#   endif
+# endif
+
+GC_FAR struct _GC_arrays GC_arrays /* = { 0 } */;
+
+
+GC_bool GC_debugging_started = FALSE;
+	/* defined here so we don't have to load debug_malloc.o */
+
+void (*GC_check_heap)() = (void (*)())0;
+
+void (*GC_start_call_back)() = (void (*)())0;
+
+ptr_t GC_stackbottom = 0;
+
+GC_bool GC_dont_gc = 0;
+
+GC_bool GC_quiet = 0;
+
+#ifdef FIND_LEAK
+  int GC_find_leak = 1;
+#else
+  int GC_find_leak = 0;
+#endif
+
+/*ARGSUSED*/
+GC_PTR GC_default_oom_fn GC_PROTO((size_t bytes_requested))
+{
+    return(0);
+}
+
+GC_PTR (*GC_oom_fn) GC_PROTO((size_t bytes_requested)) = GC_default_oom_fn;
+
+extern signed_word GC_mem_found;
+
+# ifdef MERGE_SIZES
+    /* Set things up so that GC_size_map[i] >= words(i),		*/
+    /* but not too much bigger						*/
+    /* and so that size_map contains relatively few distinct entries 	*/
+    /* This is stolen from Russ Atkinson's Cedar quantization		*/
+    /* alogrithm (but we precompute it).				*/
+
+
+    void GC_init_size_map()
+    {
+	register unsigned i;
+
+	/* Map size 0 to 1.  This avoids problems at lower levels. */
+	  GC_size_map[0] = 1;
+	/* One word objects don't have to be 2 word aligned.	   */
+	  for (i = 1; i < sizeof(word); i++) {
+	      GC_size_map[i] = 1;
+	  }
+	  GC_size_map[sizeof(word)] = ROUNDED_UP_WORDS(sizeof(word));
+	for (i = sizeof(word) + 1; i <= 8 * sizeof(word); i++) {
+#           ifdef ALIGN_DOUBLE
+	      GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1);
+#           else
+	      GC_size_map[i] = ROUNDED_UP_WORDS(i);
+#           endif
+	}
+	for (i = 8*sizeof(word) + 1; i <= 16 * sizeof(word); i++) {
+	      GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1);
+	}
+#	ifdef GC_GCJ_SUPPORT
+	   /* Make all sizes up to 32 words predictable, so that a 	*/
+	   /* compiler can statically perform the same computation,	*/
+	   /* or at least a computation that results in similar size	*/
+	   /* classes.							*/
+	   for (i = 16*sizeof(word) + 1; i <= 32 * sizeof(word); i++) {
+	      GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 3) & (~3);
+	   }
+#	endif
+	/* We leave the rest of the array to be filled in on demand. */
+    }
+    
+    /* Fill in additional entries in GC_size_map, including the ith one */
+    /* We assume the ith entry is currently 0.				*/
+    /* Note that a filled in section of the array ending at n always    */
+    /* has length at least n/4.						*/
+    void GC_extend_size_map(i)
+    word i;
+    {
+        word orig_word_sz = ROUNDED_UP_WORDS(i);
+        word word_sz = orig_word_sz;
+    	register word byte_sz = WORDS_TO_BYTES(word_sz);
+    				/* The size we try to preserve.		*/
+    				/* Close to to i, unless this would	*/
+    				/* introduce too many distinct sizes.	*/
+    	word smaller_than_i = byte_sz - (byte_sz >> 3);
+    	word much_smaller_than_i = byte_sz - (byte_sz >> 2);
+    	register word low_limit;	/* The lowest indexed entry we 	*/
+    					/* initialize.			*/
+    	register word j;
+    	
+    	if (GC_size_map[smaller_than_i] == 0) {
+    	    low_limit = much_smaller_than_i;
+    	    while (GC_size_map[low_limit] != 0) low_limit++;
+    	} else {
+    	    low_limit = smaller_than_i + 1;
+    	    while (GC_size_map[low_limit] != 0) low_limit++;
+    	    word_sz = ROUNDED_UP_WORDS(low_limit);
+    	    word_sz += word_sz >> 3;
+    	    if (word_sz < orig_word_sz) word_sz = orig_word_sz;
+    	}
+#	ifdef ALIGN_DOUBLE
+	    word_sz += 1;
+	    word_sz &= ~1;
+#	endif
+	if (word_sz > MAXOBJSZ) {
+	    word_sz = MAXOBJSZ;
+	}
+	/* If we can fit the same number of larger objects in a block,	*/
+	/* do so.							*/ 
+	{
+	    size_t number_of_objs = BODY_SZ/word_sz;
+	    word_sz = BODY_SZ/number_of_objs;
+#	    ifdef ALIGN_DOUBLE
+		word_sz &= ~1;
+#	    endif
+	}
+    	byte_sz = WORDS_TO_BYTES(word_sz);
+#	ifdef ADD_BYTE_AT_END
+	    /* We need one extra byte; don't fill in GC_size_map[byte_sz] */
+	    byte_sz--;
+#	endif
+
+    	for (j = low_limit; j <= byte_sz; j++) GC_size_map[j] = word_sz;  
+    }
+# endif
+
+
+/*
+ * The following is a gross hack to deal with a problem that can occur
+ * on machines that are sloppy about stack frame sizes, notably SPARC.
+ * Bogus pointers may be written to the stack and not cleared for
+ * a LONG time, because they always fall into holes in stack frames
+ * that are not written.  We partially address this by clearing
+ * sections of the stack whenever we get control.
+ */
+word GC_stack_last_cleared = 0;	/* GC_no when we last did this */
+# ifdef THREADS
+#   define CLEAR_SIZE 2048
+# else
+#   define CLEAR_SIZE 213
+# endif
+# define DEGRADE_RATE 50
+
+word GC_min_sp;		/* Coolest stack pointer value from which we've */
+			/* already cleared the stack.			*/
+			
+# ifdef STACK_GROWS_DOWN
+#   define COOLER_THAN >
+#   define HOTTER_THAN <
+#   define MAKE_COOLER(x,y) if ((word)(x)+(y) > (word)(x)) {(x) += (y);} \
+			    else {(x) = (word)ONES;}
+#   define MAKE_HOTTER(x,y) (x) -= (y)
+# else
+#   define COOLER_THAN <
+#   define HOTTER_THAN >
+#   define MAKE_COOLER(x,y) if ((word)(x)-(y) < (word)(x)) {(x) -= (y);} else {(x) = 0;}
+#   define MAKE_HOTTER(x,y) (x) += (y)
+# endif
+
+word GC_high_water;
+			/* "hottest" stack pointer value we have seen	*/
+			/* recently.  Degrades over time.		*/
+
+word GC_words_allocd_at_reset;
+
+#if defined(ASM_CLEAR_CODE) && !defined(THREADS)
+  extern ptr_t GC_clear_stack_inner();
+#endif  
+
+#if !defined(ASM_CLEAR_CODE) && !defined(THREADS)
+/* Clear the stack up to about limit.  Return arg. */
+/*ARGSUSED*/
+ptr_t GC_clear_stack_inner(arg, limit)
+ptr_t arg;
+word limit;
+{
+    word dummy[CLEAR_SIZE];
+    
+    BZERO(dummy, CLEAR_SIZE*sizeof(word));
+    if ((word)(dummy) COOLER_THAN limit) {
+        (void) GC_clear_stack_inner(arg, limit);
+    }
+    /* Make sure the recursive call is not a tail call, and the bzero	*/
+    /* call is not recognized as dead code.				*/
+    GC_noop1((word)dummy);
+    return(arg);
+}
+#endif
+
+/* Clear some of the inaccessible part of the stack.  Returns its	*/
+/* argument, so it can be used in a tail call position, hence clearing  */
+/* another frame.							*/
+ptr_t GC_clear_stack(arg)
+ptr_t arg;
+{
+    register word sp = (word)GC_approx_sp();  /* Hotter than actual sp */
+#   ifdef THREADS
+        word dummy[CLEAR_SIZE];
+#   else
+    	register word limit;
+#   endif
+    
+#   define SLOP 400
+	/* Extra bytes we clear every time.  This clears our own	*/
+	/* activation record, and should cause more frequent		*/
+	/* clearing near the cold end of the stack, a good thing.	*/
+#   define GC_SLOP 4000
+	/* We make GC_high_water this much hotter than we really saw   	*/
+	/* saw it, to cover for GC noise etc. above our current frame.	*/
+#   define CLEAR_THRESHOLD 100000
+	/* We restart the clearing process after this many bytes of	*/
+	/* allocation.  Otherwise very heavily recursive programs	*/
+	/* with sparse stacks may result in heaps that grow almost	*/
+	/* without bounds.  As the heap gets larger, collection 	*/
+	/* frequency decreases, thus clearing frequency would decrease, */
+	/* thus more junk remains accessible, thus the heap gets	*/
+	/* larger ...							*/
+# ifdef THREADS
+    BZERO(dummy, CLEAR_SIZE*sizeof(word));
+# else
+    if (GC_gc_no > GC_stack_last_cleared) {
+        /* Start things over, so we clear the entire stack again */
+        if (GC_stack_last_cleared == 0) GC_high_water = (word) GC_stackbottom;
+        GC_min_sp = GC_high_water;
+        GC_stack_last_cleared = GC_gc_no;
+        GC_words_allocd_at_reset = GC_words_allocd;
+    }
+    /* Adjust GC_high_water */
+        MAKE_COOLER(GC_high_water, WORDS_TO_BYTES(DEGRADE_RATE) + GC_SLOP);
+        if (sp HOTTER_THAN GC_high_water) {
+            GC_high_water = sp;
+        }
+        MAKE_HOTTER(GC_high_water, GC_SLOP);
+    limit = GC_min_sp;
+    MAKE_HOTTER(limit, SLOP);
+    if (sp COOLER_THAN limit) {
+        limit &= ~0xf;	/* Make it sufficiently aligned for assembly	*/
+        		/* implementations of GC_clear_stack_inner.	*/
+        GC_min_sp = sp;
+        return(GC_clear_stack_inner(arg, limit));
+    } else if (WORDS_TO_BYTES(GC_words_allocd - GC_words_allocd_at_reset)
+    	       > CLEAR_THRESHOLD) {
+    	/* Restart clearing process, but limit how much clearing we do. */
+    	GC_min_sp = sp;
+    	MAKE_HOTTER(GC_min_sp, CLEAR_THRESHOLD/4);
+    	if (GC_min_sp HOTTER_THAN GC_high_water) GC_min_sp = GC_high_water;
+    	GC_words_allocd_at_reset = GC_words_allocd;
+    }  
+# endif
+  return(arg);
+}
+
+
+/* Return a pointer to the base address of p, given a pointer to a	*/
+/* an address within an object.  Return 0 o.w.				*/
+# ifdef __STDC__
+    GC_PTR GC_base(GC_PTR p)
+# else
+    GC_PTR GC_base(p)
+    GC_PTR p;
+# endif
+{
+    register word r;
+    register struct hblk *h;
+    register bottom_index *bi;
+    register hdr *candidate_hdr;
+    register word limit;
+    
+    r = (word)p;
+    if (!GC_is_initialized) return 0;
+    h = HBLKPTR(r);
+    GET_BI(r, bi);
+    candidate_hdr = HDR_FROM_BI(bi, r);
+    if (candidate_hdr == 0) return(0);
+    /* If it's a pointer to the middle of a large object, move it	*/
+    /* to the beginning.						*/
+	while (IS_FORWARDING_ADDR_OR_NIL(candidate_hdr)) {
+	   h = FORWARDED_ADDR(h,candidate_hdr);
+	   r = (word)h + HDR_BYTES;
+	   candidate_hdr = HDR(h);
+	}
+    if (candidate_hdr -> hb_map == GC_invalid_map) return(0);
+    /* Make sure r points to the beginning of the object */
+	r &= ~(WORDS_TO_BYTES(1) - 1);
+        {
+	    register int offset = (char *)r - (char *)(HBLKPTR(r));
+	    register signed_word sz = candidate_hdr -> hb_sz;
+	    
+#	    ifdef ALL_INTERIOR_POINTERS
+	      register map_entry_type map_entry;
+	      
+	      map_entry = MAP_ENTRY((candidate_hdr -> hb_map), offset);
+	      if (map_entry == OBJ_INVALID) {
+            	return(0);
+              }
+              r -= WORDS_TO_BYTES(map_entry);
+              limit = r + WORDS_TO_BYTES(sz);
+#	    else
+	      register int correction;
+	      
+	      offset = BYTES_TO_WORDS(offset - HDR_BYTES);
+	      correction = offset % sz;
+	      r -= (WORDS_TO_BYTES(correction));
+	      limit = r + WORDS_TO_BYTES(sz);
+	      if (limit > (word)(h + 1)
+	        && sz <= BYTES_TO_WORDS(HBLKSIZE) - HDR_WORDS) {
+	        return(0);
+	      }
+#	    endif
+	    if ((word)p >= limit) return(0);
+	}
+    return((GC_PTR)r);
+}
+
+
+/* Return the size of an object, given a pointer to its base.		*/
+/* (For small obects this also happens to work from interior pointers,	*/
+/* but that shouldn't be relied upon.)					*/
+# ifdef __STDC__
+    size_t GC_size(GC_PTR p)
+# else
+    size_t GC_size(p)
+    GC_PTR p;
+# endif
+{
+    register int sz;
+    register hdr * hhdr = HDR(p);
+    
+    sz = WORDS_TO_BYTES(hhdr -> hb_sz);
+    if (sz < 0) {
+        return(-sz);
+    } else {
+        return(sz);
+    }
+}
+
+size_t GC_get_heap_size GC_PROTO(())
+{
+    return ((size_t) GC_heapsize);
+}
+
+size_t GC_get_free_bytes GC_PROTO(())
+{
+    return ((size_t) GC_large_free_bytes);
+}
+
+size_t GC_get_bytes_since_gc GC_PROTO(())
+{
+    return ((size_t) WORDS_TO_BYTES(GC_words_allocd));
+}
+
+GC_bool GC_is_initialized = FALSE;
+
+void GC_init()
+{
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    GC_init_inner();
+    UNLOCK();
+    ENABLE_SIGNALS();
+
+}
+
+#ifdef MSWIN32
+    extern void GC_init_win32();
+#endif
+
+extern void GC_setpagesize();
+
+void GC_init_inner()
+{
+#   ifndef THREADS
+        word dummy;
+#   endif
+    
+    if (GC_is_initialized) return;
+    GC_setpagesize();
+    GC_exclude_static_roots(beginGC_arrays, end_gc_area);
+#   ifdef PRINTSTATS
+	if ((ptr_t)endGC_arrays != (ptr_t)(&GC_obj_kinds)) {
+	    GC_printf0("Reordering linker, didn't exclude obj_kinds\n");
+	}
+#   endif
+#   ifdef MSWIN32
+ 	GC_init_win32();
+#   endif
+#   if defined(SEARCH_FOR_DATA_START)
+	/* This doesn't really work if the collector is in a shared library. */
+	GC_init_linux_data_start();
+#   endif
+#   ifdef SOLARIS_THREADS
+	GC_thr_init();
+	/* We need dirty bits in order to find live stack sections.	*/
+        GC_dirty_init();
+#   endif
+#   if defined(IRIX_THREADS) || defined(LINUX_THREADS) \
+       || defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
+        GC_thr_init();
+#   endif
+#   if !defined(THREADS) || defined(SOLARIS_THREADS) || defined(WIN32_THREADS) \
+       || defined(IRIX_THREADS) || defined(LINUX_THREADS) \
+       || defined(HPUX_THREADS)
+      if (GC_stackbottom == 0) {
+	GC_stackbottom = GC_get_stack_base();
+      }
+#   endif
+    if  (sizeof (ptr_t) != sizeof(word)) {
+        ABORT("sizeof (ptr_t) != sizeof(word)\n");
+    }
+    if  (sizeof (signed_word) != sizeof(word)) {
+        ABORT("sizeof (signed_word) != sizeof(word)\n");
+    }
+    if  (sizeof (struct hblk) != HBLKSIZE) {
+        ABORT("sizeof (struct hblk) != HBLKSIZE\n");
+    }
+#   ifndef THREADS
+#     if defined(STACK_GROWS_UP) && defined(STACK_GROWS_DOWN)
+  	ABORT(
+  	  "Only one of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
+#     endif
+#     if !defined(STACK_GROWS_UP) && !defined(STACK_GROWS_DOWN)
+  	ABORT(
+  	  "One of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
+#     endif
+#     ifdef STACK_GROWS_DOWN
+        if ((word)(&dummy) > (word)GC_stackbottom) {
+          GC_err_printf0(
+          	"STACK_GROWS_DOWN is defd, but stack appears to grow up\n");
+#	  ifndef UTS4  /* Compiler bug workaround */
+            GC_err_printf2("sp = 0x%lx, GC_stackbottom = 0x%lx\n",
+          	   	   (unsigned long) (&dummy),
+          	   	   (unsigned long) GC_stackbottom);
+#	  endif
+          ABORT("stack direction 3\n");
+        }
+#     else
+        if ((word)(&dummy) < (word)GC_stackbottom) {
+          GC_err_printf0(
+          	"STACK_GROWS_UP is defd, but stack appears to grow down\n");
+          GC_err_printf2("sp = 0x%lx, GC_stackbottom = 0x%lx\n",
+          	       	 (unsigned long) (&dummy),
+          	     	 (unsigned long) GC_stackbottom);
+          ABORT("stack direction 4");
+        }
+#     endif
+#   endif
+#   if !defined(_AUX_SOURCE) || defined(__GNUC__)
+      if ((word)(-1) < (word)0) {
+    	GC_err_printf0("The type word should be an unsigned integer type\n");
+    	GC_err_printf0("It appears to be signed\n");
+    	ABORT("word");
+      }
+#   endif
+    if ((signed_word)(-1) >= (signed_word)0) {
+    	GC_err_printf0(
+    		"The type signed_word should be a signed integer type\n");
+    	GC_err_printf0("It appears to be unsigned\n");
+    	ABORT("signed_word");
+    }
+    
+    /* Add initial guess of root sets.  Do this first, since sbrk(0)	*/
+    /* might be used.							*/
+      GC_register_data_segments();
+    GC_init_headers();
+    GC_bl_init();
+    GC_mark_init();
+    if (!GC_expand_hp_inner((word)MINHINCR)) {
+        GC_err_printf0("Can't start up: not enough memory\n");
+        EXIT();
+    }
+    /* Preallocate large object map.  It's otherwise inconvenient to 	*/
+    /* deal with failure.						*/
+      if (!GC_add_map_entry((word)0)) {
+        GC_err_printf0("Can't start up: not enough memory\n");
+        EXIT();
+      }
+    GC_register_displacement_inner(0L);
+#   ifdef MERGE_SIZES
+      GC_init_size_map();
+#   endif
+#   ifdef PCR
+      if (PCR_IL_Lock(PCR_Bool_false, PCR_allSigsBlocked, PCR_waitForever)
+          != PCR_ERes_okay) {
+          ABORT("Can't lock load state\n");
+      } else if (PCR_IL_Unlock() != PCR_ERes_okay) {
+          ABORT("Can't unlock load state\n");
+      }
+      PCR_IL_Unlock();
+      GC_pcr_install();
+#   endif
+    /* Get black list set up */
+      GC_gcollect_inner();
+#   ifdef STUBBORN_ALLOC
+    	GC_stubborn_init();
+#   endif
+    GC_is_initialized = TRUE;
+    /* Convince lint that some things are used */
+#   ifdef LINT
+      {
+          extern char * GC_copyright[];
+          extern int GC_read();
+          extern void GC_register_finalizer_no_order();
+          
+          GC_noop(GC_copyright, GC_find_header,
+                  GC_push_one, GC_call_with_alloc_lock, GC_read,
+                  GC_dont_expand,
+#		  ifndef NO_DEBUGGING
+		    GC_dump,
+#		  endif
+                  GC_register_finalizer_no_order);
+      }
+#   endif
+}
+
+void GC_enable_incremental GC_PROTO(())
+{
+# if !defined(SMALL_CONFIG)
+  if (!GC_find_leak) {
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    if (GC_incremental) goto out;
+    GC_setpagesize();
+#   ifdef MSWIN32
+      {
+        extern GC_bool GC_is_win32s();
+
+	/* VirtualProtect is not functional under win32s.	*/
+	if (GC_is_win32s()) goto out;
+      }
+#   endif /* MSWIN32 */
+#   ifndef SOLARIS_THREADS
+        GC_dirty_init();
+#   endif
+    if (!GC_is_initialized) {
+        GC_init_inner();
+    }
+    if (GC_dont_gc) {
+        /* Can't easily do it. */
+        UNLOCK();
+    	ENABLE_SIGNALS();
+    	return;
+    }
+    if (GC_words_allocd > 0) {
+    	/* There may be unmarked reachable objects	*/
+    	GC_gcollect_inner();
+    }   /* else we're OK in assuming everything's	*/
+    	/* clean since nothing can point to an	  	*/
+    	/* unmarked object.			  	*/
+    GC_read_dirty();
+    GC_incremental = TRUE;
+out:
+    UNLOCK();
+    ENABLE_SIGNALS();
+  }
+# endif
+}
+
+
+#ifdef MSWIN32
+# define LOG_FILE "gc.log"
+
+  HANDLE GC_stdout = 0, GC_stderr;
+  int GC_tmp;
+  DWORD GC_junk;
+
+  void GC_set_files()
+  {
+    if (!GC_stdout) {
+        GC_stdout = CreateFile(LOG_FILE, GENERIC_WRITE,
+        		       FILE_SHARE_READ | FILE_SHARE_WRITE,
+        		       NULL, CREATE_ALWAYS, FILE_FLAG_WRITE_THROUGH,
+        		       NULL); 
+    	if (INVALID_HANDLE_VALUE == GC_stdout) ABORT("Open of log file failed");
+    }
+    if (GC_stderr == 0) {
+	GC_stderr = GC_stdout;
+    }
+  }
+
+#endif
+
+#if defined(OS2) || defined(MACOS)
+FILE * GC_stdout = NULL;
+FILE * GC_stderr = NULL;
+int GC_tmp;  /* Should really be local ... */
+
+  void GC_set_files()
+  {
+      if (GC_stdout == NULL) {
+	GC_stdout = stdout;
+    }
+    if (GC_stderr == NULL) {
+	GC_stderr = stderr;
+    }
+  }
+#endif
+
+#if !defined(OS2) && !defined(MACOS) && !defined(MSWIN32)
+  int GC_stdout = 1;
+  int GC_stderr = 2;
+# if !defined(AMIGA)
+#   include <unistd.h>
+# endif
+#endif
+
+#if !defined(MSWIN32)  && !defined(OS2) && !defined(MACOS)
+int GC_write(fd, buf, len)
+int fd;
+char *buf;
+size_t len;
+{
+     register int bytes_written = 0;
+     register int result;
+     
+     while (bytes_written < len) {
+#	ifdef SOLARIS_THREADS
+	    result = syscall(SYS_write, fd, buf + bytes_written,
+	    			  	    len - bytes_written);
+#	else
+     	    result = write(fd, buf + bytes_written, len - bytes_written);
+#	endif
+	if (-1 == result) return(result);
+	bytes_written += result;
+    }
+    return(bytes_written);
+}
+#endif /* UN*X */
+
+#ifdef MSWIN32
+#   define WRITE(f, buf, len) (GC_set_files(), \
+			       GC_tmp = WriteFile((f), (buf), \
+			       			  (len), &GC_junk, NULL),\
+			       (GC_tmp? 1 : -1))
+#else
+#   if defined(OS2) || defined(MACOS)
+#   define WRITE(f, buf, len) (GC_set_files(), \
+			       GC_tmp = fwrite((buf), 1, (len), (f)), \
+			       fflush(f), GC_tmp)
+#   else
+#     define WRITE(f, buf, len) GC_write((f), (buf), (len))
+#   endif
+#endif
+
+/* A version of printf that is unlikely to call malloc, and is thus safer */
+/* to call from the collector in case malloc has been bound to GC_malloc. */
+/* Assumes that no more than 1023 characters are written at once.	  */
+/* Assumes that all arguments have been converted to something of the	  */
+/* same size as long, and that the format conversions expect something	  */
+/* of that size.							  */
+void GC_printf(format, a, b, c, d, e, f)
+char * format;
+long a, b, c, d, e, f;
+{
+    char buf[1025];
+    
+    if (GC_quiet) return;
+    buf[1024] = 0x15;
+    (void) sprintf(buf, format, a, b, c, d, e, f);
+    if (buf[1024] != 0x15) ABORT("GC_printf clobbered stack");
+    if (WRITE(GC_stdout, buf, strlen(buf)) < 0) ABORT("write to stdout failed");
+}
+
+void GC_err_printf(format, a, b, c, d, e, f)
+char * format;
+long a, b, c, d, e, f;
+{
+    char buf[1025];
+    
+    buf[1024] = 0x15;
+    (void) sprintf(buf, format, a, b, c, d, e, f);
+    if (buf[1024] != 0x15) ABORT("GC_err_printf clobbered stack");
+    if (WRITE(GC_stderr, buf, strlen(buf)) < 0) ABORT("write to stderr failed");
+}
+
+void GC_err_puts(s)
+char *s;
+{
+    if (WRITE(GC_stderr, s, strlen(s)) < 0) ABORT("write to stderr failed");
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+    void GC_default_warn_proc(char *msg, GC_word arg)
+# else
+    void GC_default_warn_proc(msg, arg)
+    char *msg;
+    GC_word arg;
+# endif
+{
+    GC_err_printf1(msg, (unsigned long)arg);
+}
+
+GC_warn_proc GC_current_warn_proc = GC_default_warn_proc;
+
+# if defined(__STDC__) || defined(__cplusplus)
+    GC_warn_proc GC_set_warn_proc(GC_warn_proc p)
+# else
+    GC_warn_proc GC_set_warn_proc(p)
+    GC_warn_proc p;
+# endif
+{
+    GC_warn_proc result;
+
+    LOCK();
+    result = GC_current_warn_proc;
+    GC_current_warn_proc = p;
+    UNLOCK();
+    return(result);
+}
+
+
+#ifndef PCR
+void GC_abort(msg)
+char * msg;
+{
+    GC_err_printf1("%s\n", msg);
+    (void) abort();
+}
+#endif
+
+#ifdef NEED_CALLINFO
+
+void GC_print_callers (info)
+struct callinfo info[NFRAMES];
+{
+    register int i;
+    
+#   if NFRAMES == 1
+      GC_err_printf0("\tCaller at allocation:\n");
+#   else
+      GC_err_printf0("\tCall chain at allocation:\n");
+#   endif
+    for (i = 0; i < NFRAMES; i++) {
+     	if (info[i].ci_pc == 0) break;
+#	if NARGS > 0
+	{
+	  int j;
+
+     	  GC_err_printf0("\t\targs: ");
+     	  for (j = 0; j < NARGS; j++) {
+     	    if (j != 0) GC_err_printf0(", ");
+     	    GC_err_printf2("%d (0x%X)", ~(info[i].ci_arg[j]),
+     	    				~(info[i].ci_arg[j]));
+     	  }
+	  GC_err_printf0("\n");
+	}
+# 	endif
+     	GC_err_printf1("\t\t##PC##= 0x%X\n", info[i].ci_pc);
+    }
+}
+
+#endif /* SAVE_CALL_CHAIN */
+
+/* Needed by SRC_M3, gcj, and should perhaps be the official interface	*/
+/* to GC_dont_gc.							*/
+void GC_enable()
+{
+    GC_dont_gc--;
+}
+
+void GC_disable()
+{
+    GC_dont_gc++;
+}
+
+#if !defined(NO_DEBUGGING)
+
+void GC_dump()
+{
+    GC_printf0("***Static roots:\n");
+    GC_print_static_roots();
+    GC_printf0("\n***Heap sections:\n");
+    GC_print_heap_sects();
+    GC_printf0("\n***Free blocks:\n");
+    GC_print_hblkfreelist();
+    GC_printf0("\n***Blocks in use:\n");
+    GC_print_block_list();
+}
+
+# endif /* NO_DEBUGGING */
diff --git a/src/gc/new_hblk.c b/src/gc/new_hblk.c
new file mode 100644
index 000000000..1e1273f85
--- /dev/null
+++ b/src/gc/new_hblk.c
@@ -0,0 +1,249 @@
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * This file contains the functions:
+ *	ptr_t GC_build_flXXX(h, old_fl)
+ *	void GC_new_hblk(n)
+ */
+/* Boehm, May 19, 1994 2:09 pm PDT */
+
+
+# include <stdio.h>
+# include "gc_priv.h"
+
+#ifndef SMALL_CONFIG
+/*
+ * Build a free list for size 1 objects inside hblk h.  Set the last link to
+ * be ofl.  Return a pointer tpo the first free list entry.
+ */
+ptr_t GC_build_fl1(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+    register word * p = (word *)h;
+    register word * lim = (word *)(h + 1);
+    
+    p[0] = (word)ofl;
+    p[1] = (word)(p);
+    p[2] = (word)(p+1);
+    p[3] = (word)(p+2);
+    p += 4;
+    for (; p < lim; p += 4) {
+        p[0] = (word)(p-1);
+        p[1] = (word)(p);
+        p[2] = (word)(p+1);
+        p[3] = (word)(p+2);
+    };
+    return((ptr_t)(p-1));
+}
+
+/* The same for size 2 cleared objects */
+ptr_t GC_build_fl_clear2(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+    register word * p = (word *)h;
+    register word * lim = (word *)(h + 1);
+    
+    p[0] = (word)ofl;
+    p[1] = 0;
+    p[2] = (word)p;
+    p[3] = 0;
+    p += 4;
+    for (; p < lim; p += 4) {
+        p[0] = (word)(p-2);
+        p[1] = 0;
+        p[2] = (word)p;
+        p[3] = 0;
+    };
+    return((ptr_t)(p-2));
+}
+
+/* The same for size 3 cleared objects */
+ptr_t GC_build_fl_clear3(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+    register word * p = (word *)h;
+    register word * lim = (word *)(h + 1) - 2;
+    
+    p[0] = (word)ofl;
+    p[1] = 0;
+    p[2] = 0;
+    p += 3;
+    for (; p < lim; p += 3) {
+        p[0] = (word)(p-3);
+        p[1] = 0;
+        p[2] = 0;
+    };
+    return((ptr_t)(p-3));
+}
+
+/* The same for size 4 cleared objects */
+ptr_t GC_build_fl_clear4(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+    register word * p = (word *)h;
+    register word * lim = (word *)(h + 1);
+    
+    p[0] = (word)ofl;
+    p[1] = 0;
+    p[2] = 0;
+    p[3] = 0;
+    p += 4;
+    for (; p < lim; p += 4) {
+	PREFETCH_FOR_WRITE(p+64);
+        p[0] = (word)(p-4);
+        p[1] = 0;
+	CLEAR_DOUBLE(p+2);
+    };
+    return((ptr_t)(p-4));
+}
+
+/* The same for size 2 uncleared objects */
+ptr_t GC_build_fl2(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+    register word * p = (word *)h;
+    register word * lim = (word *)(h + 1);
+    
+    p[0] = (word)ofl;
+    p[2] = (word)p;
+    p += 4;
+    for (; p < lim; p += 4) {
+        p[0] = (word)(p-2);
+        p[2] = (word)p;
+    };
+    return((ptr_t)(p-2));
+}
+
+/* The same for size 4 uncleared objects */
+ptr_t GC_build_fl4(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+    register word * p = (word *)h;
+    register word * lim = (word *)(h + 1);
+    
+    p[0] = (word)ofl;
+    p[4] = (word)p;
+    p += 8;
+    for (; p < lim; p += 8) {
+	PREFETCH_FOR_WRITE(p+64);
+        p[0] = (word)(p-4);
+        p[4] = (word)p;
+    };
+    return((ptr_t)(p-4));
+}
+
+#endif /* !SMALL_CONFIG */
+
+/*
+ * Allocate a new heapblock for small objects of size n.
+ * Add all of the heapblock's objects to the free list for objects
+ * of that size.
+ * Set all mark bits if objects are uncollectable.
+ * Will fail to do anything if we are out of memory.
+ */
+void GC_new_hblk(sz, kind)
+register word sz;
+int kind;
+{
+    register word *p,
+		  *prev;
+    word *last_object;		/* points to last object in new hblk	*/
+    register struct hblk *h;	/* the new heap block			*/
+    register GC_bool clear = GC_obj_kinds[kind].ok_init;
+
+#   ifdef PRINTSTATS
+	if ((sizeof (struct hblk)) > HBLKSIZE) {
+	    ABORT("HBLK SZ inconsistency");
+        }
+#   endif
+
+  /* Allocate a new heap block */
+    h = GC_allochblk(sz, kind, 0);
+    if (h == 0) return;
+
+  /* Mark all objects if appropriate. */
+      if (IS_UNCOLLECTABLE(kind)) GC_set_hdr_marks(HDR(h));
+
+  PREFETCH_FOR_WRITE((char *)h);
+  PREFETCH_FOR_WRITE((char *)h + 128);
+  PREFETCH_FOR_WRITE((char *)h + 256);
+  PREFETCH_FOR_WRITE((char *)h + 378);
+  /* Handle small objects sizes more efficiently.  For larger objects 	*/
+  /* the difference is less significant.				*/
+#  ifndef SMALL_CONFIG
+    switch (sz) {
+        case 1: GC_obj_kinds[kind].ok_freelist[1] =
+        	  GC_build_fl1(h, GC_obj_kinds[kind].ok_freelist[1]);
+        	return;
+        case 2: if (clear) {
+         	    GC_obj_kinds[kind].ok_freelist[2] =
+        	      GC_build_fl_clear2(h, GC_obj_kinds[kind].ok_freelist[2]);
+        	} else {
+        	    GC_obj_kinds[kind].ok_freelist[2] =
+        	      GC_build_fl2(h, GC_obj_kinds[kind].ok_freelist[2]);
+        	}
+        	return;
+        case 3: if (clear) {
+         	    GC_obj_kinds[kind].ok_freelist[3] =
+        	      GC_build_fl_clear3(h, GC_obj_kinds[kind].ok_freelist[3]);
+        	    return;
+        	} else {
+        	    /* It's messy to do better than the default here. */
+        	    break;
+        	}
+        case 4: if (clear) {
+        	    GC_obj_kinds[kind].ok_freelist[4] =
+        	      GC_build_fl_clear4(h, GC_obj_kinds[kind].ok_freelist[4]);
+        	} else {
+        	    GC_obj_kinds[kind].ok_freelist[4] =
+        	      GC_build_fl4(h, GC_obj_kinds[kind].ok_freelist[4]);
+        	}
+        	return;
+        default:
+        	break;
+    }
+#  endif /* !SMALL_CONFIG */
+    
+  /* Clear the page if necessary. */
+    if (clear) BZERO(h, HBLKSIZE);
+    
+  /* Add objects to free list */
+    p = &(h -> hb_body[sz]);	/* second object in *h	*/
+    prev = &(h -> hb_body[0]);       	/* One object behind p	*/
+    last_object = (word *)((char *)h + HBLKSIZE);
+    last_object -= sz;
+			    /* Last place for last object to start */
+
+  /* make a list of all objects in *h with head as last object */
+    while (p <= last_object) {
+      /* current object's link points to last object */
+        obj_link(p) = (ptr_t)prev;
+	prev = p;
+	p += sz;
+    }
+    p -= sz;			/* p now points to last object */
+
+  /*
+   * put p (which is now head of list of objects in *h) as first
+   * pointer in the appropriate free list for this size.
+   */
+      obj_link(h -> hb_body) = GC_obj_kinds[kind].ok_freelist[sz];
+      GC_obj_kinds[kind].ok_freelist[sz] = ((ptr_t)p);
+}
+
diff --git a/src/gc/nursery.c b/src/gc/nursery.c
new file mode 100644
index 000000000..ab83afbaa
--- /dev/null
+++ b/src/gc/nursery.c
@@ -0,0 +1,312 @@
+/* 
+ * Copyright (c) 1999 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+#ifdef NURSERY
+??? This implementation is incomplete.  If you are trying to
+??? compile this you are doing something wrong.
+
+#include "nursery.h"
+
+#define SCAN_STATICS_FOR_NURSERY
+	/* If this is not defined, the collector will not see 	*/
+	/* references from static data areas to the nursery.	*/
+
+struct copy_obj {
+    ptr_t forward;	/* Forwarding link for copied objects.	*/
+    GC_copy_descriptor descr; /* Object descriptor	*/
+    word data[1];
+}
+
+ptr_t GC_nursery_start;	/* Start of nursery area.	*/
+			/* Must be NURSERY_BLOCK_SIZE	*/
+			/* aligned.			*/
+ptr_t GC_nursery_end;	/* End of nursery area.		*/
+unsigned char * GC_nursery_map;
+			/* GC_nursery_map[i] != 0 if an object	*/
+			/* starts on the ith 64-bit "word" of 	*/
+			/* nursery.  This simple structure has	*/
+			/* the advantage that 			*/
+			/* allocation is cheap.  Lookup is 	*/
+			/* cheap for pointers to the head of	*/
+			/* an object, which should be the	*/
+			/* usual case.				*/
+#   define NURSERY_MAP_NOT_START	0  /* Not start of object. */
+#   define NURSERY_MAP_START		1  /* Start of object.	   */
+#   define NURSERY_MAP_PINNED		2  /* Start of pinned obj. */
+
+# ifdef ALIGN_DOUBLE
+#   define NURSERY_WORD_SIZE (2 * sizeof(word))
+# else
+#   define NURSERY_WORD_SIZE sizeof(word)
+# endif
+
+# define NURSERY_BLOCK_SIZE (HBLKSIZE/2)	
+	/* HBLKSIZE must be a multiple of NURSERY_BLOCK_SIZE */
+# define NURSERY_SIZE (1024 * NURSERY_BLOCK_SIZE)
+
+size_t GC_nursery_size = NURSERY_SIZE;
+			/* Must be multiple of NURSERY_BLOCK_SIZE	*/
+
+size_t GC_nursery_blocks; /* Number of blocks in the nursery.	*/
+
+unsigned GC_next_nursery_block; /* index of next block we will attempt 	*/
+				/* allocate from during this cycle.	*/
+				/* If it is pinned, we won't actually	*/
+				/* use it.				*/
+
+unsigned short *GC_pinned;	/* Number of pinned objects in ith	*/
+				/* nursery block.			*/
+				/* GC_pinned[i] != 0 if the ith nursery */
+				/* block is pinned, and thus not used	*/
+				/* for allocation.			*/
+
+GC_copy_alloc_state global_alloc_state = (ptr_t)(-1);	/* will overflow. */
+
+/* Array of known rescuing pointers from the heap to the nursery.	*/
+  ptr_t ** nursery_rescuers;
+  /* Pointer to one past the last slot in rescuer table	*/
+  ptr_t ** nursery_rescuers_end;
+  /* Maximum number of known rescuing pointers.			*/
+# define MAX_NURSERY_RESCUERS 32*1024
+  /* Add a rescuer to the list	*/
+# define ADD_NURSERY_RESCUER(p) \
+    if (nursery_rescuers_end >= nursery_rescuers + MAX_NURSERY_RESCUERS) { \
+      ABORT("Nursery recuers overflow"); /* Fix later !!! */ \
+    } else { \
+      *nursery_rescuers_end++ = p; \
+    }
+  /* Remove rescuer at the given position in the table	*/
+# define REMOVE_RESCUER(p) \
+    *p = *--nursery_rescuers_end
+
+/* Should be called with allocator lock held.	*/
+GC_nursery_init() {
+    GC_nursery_start = GET_MEM(GC_nursery_size);
+    GC_nursery_end = GC_nursery_start + GC_nursery_size;
+    GC_next_nursery_block = 0;
+    if (GC_nursery_start < GC_least_plausible_heap_addr) { 
+        GC_least_plausible_heap_addr = GC_nursery_start;   
+    }
+    if (GC_nursery_end > GC_greatest_plausible_heap_addr) {
+        GC_greatest_plausible_heap_addr = GC_nursery_end;  
+    }
+    if (GC_nursery_start & (NURSERY_BLOCK_SIZE-1)) {
+	GC_err_printf1("Nursery area is misaligned!!");
+	/* This should be impossible, since GET_MEM returns HBLKSIZE */
+	/* aligned chunks, and that should be a multiple of 	     */
+	/* NURSERY_BLOCK_SIZE					     */
+	ABORT("misaligned nursery");
+    }
+    GC_nursery_map = GET_MEM(GC_nursery_size/NURSERY_WORD_SIZE);
+    /* Map is cleared a block at a time when we allocate from the block. */
+    /* BZERO(GC_nursery_map, GC_nursery_size/NURSERY_WORD_SIZE);	 */
+    GC_nursery_blocks = GC_nursery_size/NURSERY_BLOCK_SIZE;
+    GC_pinned = GC_scratch_alloc(GC_nursery_blocks * sizeof(unsigned short));
+    BZERO(GC_pinned, GC_nursery_blocks);
+    nursery_rescuers = GET_MEM(MAX_NURSERY_RESCUERS * sizeof(ptr_t *));
+    nursery_rescuers_end = nursery_rescuers;
+    if (0 == GC_nursery_start || 0 == GC_nursery_map || 0 == nursery_rescuers)
+	ABORT("Insufficient memory for nursery");
+}
+
+#define PIN_OBJ(p) \
+    if (p >= GC_nursery_start && p < GC_nursery_end) { GC_pin_obj_checked(p); }
+
+/* Pin the object at p, if it's in the nursery.	*/
+void GC_pin_obj(ptr_t p) {
+    PIN_OBJ(p);
+}
+
+void (*GC_push_proc)(ptr_t) = 0;
+
+/* Pin the object at p, which is known to be in the nursery.	*/
+void GC_pin_obj_checked(ptr_t p) {
+    unsigned offset = p - GC_nursery_start;
+    unsigned word_offset = BYTES_TO_WORDS(offset);
+    unsigned blockno = (current - GC_nursery_start)/NURSERY_BLOCK_SIZE;
+    while (GC_nursery_map[word_offset] == NURSERY_MAP_NOT_START) {
+	--word_offset;    
+    }
+    if (GC_nursery_map[word_offset] != NURSERY_MAP_PINNED) {
+        GC_nursery_map[word_offset] = NURSERY_MAP_PINNED;
+        ++GC_pinned[blockno];
+        ??Push object at GC_nursery_start + WORDS_TO_BYTES(word_offset)
+        ??onto mark stack. 
+    }
+}
+
+void GC_scan_region_for_nursery(ptr_t low, ptr_t high) {
+#   if CPP_WORDSZ/8 != ALIGNMENT
+      --> fix this
+#   endif
+    word * l = (word *)((word)low + ALIGNMENT - 1 & ~(ALIGNMENT - 1));
+    word * h = (word *)((word)high & ~(ALIGNMENT - 1));
+    word * p;
+    for (p = l; p < h; ++p) {
+	PIN_OBJ(p);
+    }
+}
+
+/* Invoke GC_scan_region_for_nursery on ranges that are not excluded. */
+void GC_scan_region_for_nursery_with_exclusions(ptr_t bottom, ptr_t top)
+{
+    struct exclusion * next;
+    ptr_t excl_start;
+
+    while (bottom < top) {
+        next = GC_next_exclusion(bottom);
+	if (0 == next || (excl_start = next -> e_start) >= top) {
+	    GC_scan_region_for_nursery(bottom, top);
+	    return;
+	}
+	if (excl_start > bottom)
+		GC_scan_region_for_nursery(bottom, excl_start);
+	bottom = next -> e_end;
+    }
+}
+
+
+void GC_scan_stacks_for_nursery(void) {
+#   ifdef THREADS
+	--> fix this
+#   endif
+#   ifdef STACK_GROWS_DOWN
+      ptr_t stack_low = GC_approx_sp();
+      ptr_t stack_high = GC_stackbottom;
+#   else
+      ptr_t stack_low = GC_stackbottom;
+      ptr_t stack_high = GC_approx_sp();
+#   endif
+    GC_scan_region_for_nursery(stack_low, stack_high);
+#   ifdef IA64
+      GC_scan_region_for_nursery(BACKING_STORE_BASE,
+				 (ptr_t) GC_save_regs_ret_val);
+#   endif
+}
+
+void GC_scan_roots_for_nursery(void) {
+  /* Scan registers.	*/
+    /* Direct GC_push_one to call GC_pin_obj instead of marking	*/
+    /* and pushing objects.					*/
+    /* This is a bit ugly, but we don't have to touch the	*/
+    /* platform-dependent code.					*/
+     
+    void (*old_push_proc)(ptr_t) = GC_push_proc;
+    GC_push_proc = GC_pin_obj;
+    GC_push_regs();
+    GC_push_proc = old_push_proc;
+  GC_scan_stacks_for_nursery();
+# ifdef SCAN_STATICS_FOR_NURSERY
+#   if (defined(DYNAMIC_LOADING) || defined(MSWIN32) || defined(PCR)) \
+        && !defined(SRC_M3)
+      GC_remove_tmp_roots();
+      GC_register_dynamic_libraries();
+#   endif
+    /* Mark everything in static data areas                             */
+      for (i = 0; i < n_root_sets; i++) {
+        GC_scan_region_for_nursery_with_exclusions (
+			     GC_static_roots[i].r_start,
+			     GC_static_roots[i].r_end);
+     }
+# endif
+}
+
+/* Array of known rescuing pointers from the heap to the nursery.	*/
+ptr_t ** nursery_rescuers;
+
+/* Caller holds allocation lock.	*/
+void GC_collect_nursery(void) {
+    int i;
+    ptr_t scan_ptr = 0;
+    STOP_WORLD;
+    for (i = 0; i < GC_nursery_blocks; ++i) GC_pinned[i] = 0;
+    GC_scan_roots_for_nursery();
+    /* All objects referenced by roots are now pinned. 		*/
+    /* Their contents are described by 			 	*/
+    /* mark stack entries.					*/
+
+    /* Pin blocks corresponding to valid allocation states.	*/
+    /* that probably happens automagically if the allocation	*/
+    /* states are kept where we can see them.			*/
+    /* It will take work if static roots are not scanned.	*/
+    /* We want to do this both for correctness and to avoid	*/
+    /* promoting very young objects.				*/
+
+    /* Somehow capture dirty bits.  Update rescuers array to	*/
+    /* reflect newly valid and invalid references from dirty 	*/
+    /* pages.  Other references should remain valid, since the	*/
+    /* referents should have been pinned.			*/
+
+    /* Traverse the old object heap.  Pin objects in the 	*/
+    /* nursery that are ambiguously referenced, copy those	*/
+    /* that are unambiguously referenced.			*/
+
+    /* Traverse objects in mark stack.				*/
+    /* If referenced object is in pinned block, add contents	*/
+    /* to mark stack.  If referenced object is forwarded,	*/
+    /* update pointer.  Otherwise reallocate the object	in the	*/
+    /* old heap, copy its contents, and then enqueue its 	*/
+    /* contents in the mark stack.				*/
+    START_WORLD;
+}
+
+/* Initialize an allocation state so that it can be used for 	*/
+/* allocation.  This implicitly reserves a small section of the	*/
+/* nursery for use with this allocator.				*/
+/* Also called to replenish an allocator that has been 		*/
+/* exhausted.							*/
+void GC_init_copy_alloc_state(GC_copy_alloc_state *)
+    unsigned next_block;
+    ptr_t block_addr;
+    LOCK();
+    next_block = GC_next_nursery_block;
+    while(is_pinned[next_block] && next_block < GC_nursery_blocks) {
+	++next_block;
+    }
+    if (next_block < GC_nursery_blocks) {
+	block_addr = GC_nursery_start + NURSERY_BLOCK_SIZE * next_block;
+   	GC_next_nursery_block = next_block + 1;
+	BZERO(GC_nursery_map + next_block *
+				(NURSERY_BLOCK_SIZE/NURSERY_WORD_SIZE),
+	      NURSERY_BLOCK_SIZE/NURSERY_WORD_SIZE);
+	*GC_copy_alloc_state = block_addr;
+	UNLOCK();
+    } else {
+     	GC_collect_nursery();
+    	GC_next_nursery_block = 0;
+    	UNLOCK();
+    	get_new_block(s);
+    }
+}
+
+GC_PTR GC_copying_malloc2(GC_copy_descriptor *d, GC_copy_alloc_state *s) {
+    size_t sz = GC_SIZE_FROM_DESCRIPTOR(d);
+    ptrdiff_t offset;
+    ptr_t result = *s;
+    ptr_t new = result + sz;
+    if (new & COPY_BLOCK_MASK <= result & COPY_BLOCK_MASK> {
+	GC_init_copy_alloc_state(s);
+	result = *s;
+	new = result + sz;
+        GC_ASSERT(new & COPY_BLOCK_MASK > result & COPY_BLOCK_MASK>
+    }
+    (struct copy_obj *)result -> descr = d;      
+    (struct copy_obj *)result -> forward = 0;      
+    offset = (result - GC_nursery_start)/NURSERY_WORD_SIZE;
+    GC_nursery_map[offset] = NURSERY_MAP_NOT_START;
+}
+
+GC_PTR GC_copying_malloc(GC_copy_descriptor *d) {
+}
+
+#endif /* NURSERY */
diff --git a/src/gc/obj_map.c b/src/gc/obj_map.c
new file mode 100644
index 000000000..82ebf3119
--- /dev/null
+++ b/src/gc/obj_map.c
@@ -0,0 +1,142 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991, 1992 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, October 9, 1995 1:09 pm PDT */
+  
+/* Routines for maintaining maps describing heap block
+ * layouts for various object sizes.  Allows fast pointer validity checks
+ * and fast location of object start locations on machines (such as SPARC)
+ * with slow division.
+ */
+ 
+# include "gc_priv.h"
+
+char * GC_invalid_map = 0;
+
+/* Invalidate the object map associated with a block.	Free blocks	*/
+/* are identified by invalid maps.					*/
+void GC_invalidate_map(hhdr)
+hdr *hhdr;
+{
+    register int displ;
+    
+    if (GC_invalid_map == 0) {
+        GC_invalid_map = GC_scratch_alloc(MAP_SIZE);
+        if (GC_invalid_map == 0) {
+            GC_err_printf0(
+            	"Cant initialize GC_invalid_map: insufficient memory\n");
+            EXIT();
+        }
+        for (displ = 0; displ < HBLKSIZE; displ++) {
+            MAP_ENTRY(GC_invalid_map, displ) = OBJ_INVALID;
+        }
+    }
+    hhdr -> hb_map = GC_invalid_map;
+}
+
+/* Consider pointers that are offset bytes displaced from the beginning */
+/* of an object to be valid.                                            */
+
+# if defined(__STDC__) || defined(__cplusplus)
+    void GC_register_displacement(GC_word offset)
+# else
+    void GC_register_displacement(offset) 
+    GC_word offset;
+# endif
+{
+# ifndef ALL_INTERIOR_POINTERS
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    GC_register_displacement_inner(offset);
+    UNLOCK();
+    ENABLE_SIGNALS();
+# endif
+}
+
+void GC_register_displacement_inner(offset) 
+word offset;
+{
+# ifndef ALL_INTERIOR_POINTERS
+    register unsigned i;
+    
+    if (offset > MAX_OFFSET) {
+        ABORT("Bad argument to GC_register_displacement");
+    }
+    if (!GC_valid_offsets[offset]) {
+      GC_valid_offsets[offset] = TRUE;
+      GC_modws_valid_offsets[offset % sizeof(word)] = TRUE;
+      for (i = 0; i <= MAXOBJSZ; i++) {
+          if (GC_obj_map[i] != 0) {
+             if (i == 0) {
+               GC_obj_map[i][offset + HDR_BYTES] = (char)BYTES_TO_WORDS(offset);
+             } else {
+               register unsigned j;
+               register unsigned lb = WORDS_TO_BYTES(i);
+               
+               if (offset < lb) {
+                 for (j = offset + HDR_BYTES; j < HBLKSIZE; j += lb) {
+                   GC_obj_map[i][j] = (char)BYTES_TO_WORDS(offset);
+                 }
+               }
+             }
+          }
+      }
+    }
+# endif
+}
+
+
+/* Add a heap block map for objects of size sz to obj_map.	*/
+/* Return FALSE on failure.					*/
+GC_bool GC_add_map_entry(sz)
+word sz;
+{
+    register unsigned obj_start;
+    register unsigned displ;
+    register char * new_map;
+    
+    if (sz > MAXOBJSZ) sz = 0;
+    if (GC_obj_map[sz] != 0) {
+        return(TRUE);
+    }
+    new_map = GC_scratch_alloc(MAP_SIZE);
+    if (new_map == 0) return(FALSE);
+#   ifdef PRINTSTATS
+        GC_printf1("Adding block map for size %lu\n", (unsigned long)sz);
+#   endif
+    for (displ = 0; displ < HBLKSIZE; displ++) {
+        MAP_ENTRY(new_map,displ) = OBJ_INVALID;
+    }
+    if (sz == 0) {
+        for(displ = 0; displ <= MAX_OFFSET; displ++) {
+            if (OFFSET_VALID(displ)) {
+                MAP_ENTRY(new_map,displ+HDR_BYTES) = BYTES_TO_WORDS(displ);
+            }
+        }
+    } else {
+        for (obj_start = HDR_BYTES;
+             obj_start + WORDS_TO_BYTES(sz) <= HBLKSIZE;
+             obj_start += WORDS_TO_BYTES(sz)) {
+             for (displ = 0; displ < WORDS_TO_BYTES(sz); displ++) {
+                 if (OFFSET_VALID(displ)) {
+                     MAP_ENTRY(new_map, obj_start + displ) =
+                     				BYTES_TO_WORDS(displ);
+                 }
+             }
+        }
+    }
+    GC_obj_map[sz] = new_map;
+    return(TRUE);
+}
diff --git a/src/gc/os_dep.c b/src/gc/os_dep.c
new file mode 100644
index 000000000..34b871d86
--- /dev/null
+++ b/src/gc/os_dep.c
@@ -0,0 +1,2606 @@
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+# include "gc_priv.h"
+
+# if defined(LINUX) && !defined(POWERPC)
+#   include <linux/version.h>
+#   if (LINUX_VERSION_CODE <= 0x10400)
+      /* Ugly hack to get struct sigcontext_struct definition.  Required      */
+      /* for some early 1.3.X releases.  Will hopefully go away soon. */
+      /* in some later Linux releases, asm/sigcontext.h may have to   */
+      /* be included instead.                                         */
+#     define __KERNEL__
+#     include <asm/signal.h>
+#     undef __KERNEL__
+#   else
+      /* Kernels prior to 2.1.1 defined struct sigcontext_struct instead of */
+      /* struct sigcontext.  libc6 (glibc2) uses "struct sigcontext" in     */
+      /* prototypes, so we have to include the top-level sigcontext.h to    */
+      /* make sure the former gets defined to be the latter if appropriate. */
+#     include <features.h>
+#     if 2 <= __GLIBC__
+#       if 2 == __GLIBC__ && 0 == __GLIBC_MINOR__
+	  /* glibc 2.1 no longer has sigcontext.h.  But signal.h	*/
+	  /* has the right declaration for glibc 2.1.			*/
+#         include <sigcontext.h>
+#       endif /* 0 == __GLIBC_MINOR__ */
+#     else /* not 2 <= __GLIBC__ */
+        /* libc5 doesn't have <sigcontext.h>: go directly with the kernel   */
+        /* one.  Check LINUX_VERSION_CODE to see which we should reference. */
+#       include <asm/sigcontext.h>
+#     endif /* 2 <= __GLIBC__ */
+#   endif
+# endif
+# if !defined(OS2) && !defined(PCR) && !defined(AMIGA) && !defined(MACOS)
+#   include <sys/types.h>
+#   if !defined(MSWIN32) && !defined(SUNOS4)
+#   	include <unistd.h>
+#   endif
+# endif
+
+# include <stdio.h>
+# include <signal.h>
+
+/* Blatantly OS dependent routines, except for those that are related 	*/
+/* to dynamic loading.							*/
+
+# if !defined(THREADS) && !defined(STACKBOTTOM) && defined(HEURISTIC2)
+#   define NEED_FIND_LIMIT
+# endif
+
+# if defined(IRIX_THREADS) || defined(HPUX_THREADS)
+#   define NEED_FIND_LIMIT
+# endif
+
+# if (defined(SUNOS4) && defined(DYNAMIC_LOADING)) && !defined(PCR)
+#   define NEED_FIND_LIMIT
+# endif
+
+# if (defined(SVR4) || defined(AUX) || defined(DGUX)) && !defined(PCR)
+#   define NEED_FIND_LIMIT
+# endif
+
+# if defined(LINUX) && \
+     (defined(POWERPC) || defined(SPARC) || defined(ALPHA) || defined(IA64) \
+      || defined(MIPS))
+#   define NEED_FIND_LIMIT
+# endif
+
+#ifdef NEED_FIND_LIMIT
+#   include <setjmp.h>
+#endif
+
+#ifdef FREEBSD
+#  include <machine/trap.h>
+#endif
+
+#ifdef AMIGA
+# include <proto/exec.h>
+# include <proto/dos.h>
+# include <dos/dosextens.h>
+# include <workbench/startup.h>
+#endif
+
+#ifdef MSWIN32
+# define WIN32_LEAN_AND_MEAN
+# define NOSERVICE
+# include <windows.h>
+#endif
+
+#ifdef MACOS
+# include <Processes.h>
+#endif
+
+#ifdef IRIX5
+# include <sys/uio.h>
+# include <malloc.h>   /* for locking */
+#endif
+#ifdef USE_MMAP
+# include <sys/types.h>
+# include <sys/mman.h>
+# include <sys/stat.h>
+# include <fcntl.h>
+#endif
+
+#ifdef SUNOS5SIGS
+# include <sys/siginfo.h>
+# undef setjmp
+# undef longjmp
+# define setjmp(env) sigsetjmp(env, 1)
+# define longjmp(env, val) siglongjmp(env, val)
+# define jmp_buf sigjmp_buf
+#endif
+
+#ifdef DJGPP
+  /* Apparently necessary for djgpp 2.01.  May casuse problems with	*/
+  /* other versions.							*/
+  typedef long unsigned int caddr_t;
+#endif
+
+#ifdef PCR
+# include "il/PCR_IL.h"
+# include "th/PCR_ThCtl.h"
+# include "mm/PCR_MM.h"
+#endif
+
+#if !defined(NO_EXECUTE_PERMISSION)
+# define OPT_PROT_EXEC PROT_EXEC
+#else
+# define OPT_PROT_EXEC 0
+#endif
+
+#if defined(SEARCH_FOR_DATA_START)
+  /* The following doesn't work if the GC is in a dynamic library.	*/
+  /* The I386 case can be handled without a search.  The Alpha case	*/
+  /* used to be handled differently as well, but the rules changed	*/
+  /* for recent Linux versions.  This seems to be the easiest way to	*/
+  /* cover all versions.						*/
+  ptr_t GC_data_start;
+
+  extern char * GC_copyright[];  /* Any data symbol would do. */
+
+  void GC_init_linux_data_start()
+  {
+    extern ptr_t GC_find_limit();
+
+    GC_data_start = GC_find_limit((ptr_t)GC_copyright, FALSE);
+  }
+#endif
+
+# ifdef OS2
+
+# include <stddef.h>
+
+# if !defined(__IBMC__) && !defined(__WATCOMC__) /* e.g. EMX */
+
+struct exe_hdr {
+    unsigned short      magic_number;
+    unsigned short      padding[29];
+    long                new_exe_offset;
+};
+
+#define E_MAGIC(x)      (x).magic_number
+#define EMAGIC          0x5A4D  
+#define E_LFANEW(x)     (x).new_exe_offset
+
+struct e32_exe {
+    unsigned char       magic_number[2]; 
+    unsigned char       byte_order; 
+    unsigned char       word_order; 
+    unsigned long       exe_format_level;
+    unsigned short      cpu;       
+    unsigned short      os;
+    unsigned long       padding1[13];
+    unsigned long       object_table_offset;
+    unsigned long       object_count;    
+    unsigned long       padding2[31];
+};
+
+#define E32_MAGIC1(x)   (x).magic_number[0]
+#define E32MAGIC1       'L'
+#define E32_MAGIC2(x)   (x).magic_number[1]
+#define E32MAGIC2       'X'
+#define E32_BORDER(x)   (x).byte_order
+#define E32LEBO         0
+#define E32_WORDER(x)   (x).word_order
+#define E32LEWO         0
+#define E32_CPU(x)      (x).cpu
+#define E32CPU286       1
+#define E32_OBJTAB(x)   (x).object_table_offset
+#define E32_OBJCNT(x)   (x).object_count
+
+struct o32_obj {
+    unsigned long       size;  
+    unsigned long       base;
+    unsigned long       flags;  
+    unsigned long       pagemap;
+    unsigned long       mapsize; 
+    unsigned long       reserved;
+};
+
+#define O32_FLAGS(x)    (x).flags
+#define OBJREAD         0x0001L
+#define OBJWRITE        0x0002L
+#define OBJINVALID      0x0080L
+#define O32_SIZE(x)     (x).size
+#define O32_BASE(x)     (x).base
+
+# else  /* IBM's compiler */
+
+/* A kludge to get around what appears to be a header file bug */
+# ifndef WORD
+#   define WORD unsigned short
+# endif
+# ifndef DWORD
+#   define DWORD unsigned long
+# endif
+
+# define EXE386 1
+# include <newexe.h>
+# include <exe386.h>
+
+# endif  /* __IBMC__ */
+
+# define INCL_DOSEXCEPTIONS
+# define INCL_DOSPROCESS
+# define INCL_DOSERRORS
+# define INCL_DOSMODULEMGR
+# define INCL_DOSMEMMGR
+# include <os2.h>
+
+
+/* Disable and enable signals during nontrivial allocations	*/
+
+void GC_disable_signals(void)
+{
+    ULONG nest;
+    
+    DosEnterMustComplete(&nest);
+    if (nest != 1) ABORT("nested GC_disable_signals");
+}
+
+void GC_enable_signals(void)
+{
+    ULONG nest;
+    
+    DosExitMustComplete(&nest);
+    if (nest != 0) ABORT("GC_enable_signals");
+}
+
+
+# else
+
+#  if !defined(PCR) && !defined(AMIGA) && !defined(MSWIN32) \
+      && !defined(MACOS) && !defined(DJGPP) && !defined(DOS4GW)
+
+#   if defined(sigmask) && !defined(UTS4)
+	/* Use the traditional BSD interface */
+#	define SIGSET_T int
+#	define SIG_DEL(set, signal) (set) &= ~(sigmask(signal))
+#	define SIG_FILL(set)  (set) = 0x7fffffff
+    	  /* Setting the leading bit appears to provoke a bug in some	*/
+    	  /* longjmp implementations.  Most systems appear not to have	*/
+    	  /* a signal 32.						*/
+#	define SIGSETMASK(old, new) (old) = sigsetmask(new)
+#   else
+	/* Use POSIX/SYSV interface	*/
+#	define SIGSET_T sigset_t
+#	define SIG_DEL(set, signal) sigdelset(&(set), (signal))
+#	define SIG_FILL(set) sigfillset(&set)
+#	define SIGSETMASK(old, new) sigprocmask(SIG_SETMASK, &(new), &(old))
+#   endif
+
+static GC_bool mask_initialized = FALSE;
+
+static SIGSET_T new_mask;
+
+static SIGSET_T old_mask;
+
+static SIGSET_T dummy;
+
+#if defined(PRINTSTATS) && !defined(THREADS)
+# define CHECK_SIGNALS
+  int GC_sig_disabled = 0;
+#endif
+
+void GC_disable_signals()
+{
+    if (!mask_initialized) {
+    	SIG_FILL(new_mask);
+
+	SIG_DEL(new_mask, SIGSEGV);
+	SIG_DEL(new_mask, SIGILL);
+	SIG_DEL(new_mask, SIGQUIT);
+#	ifdef SIGBUS
+	    SIG_DEL(new_mask, SIGBUS);
+#	endif
+#	ifdef SIGIOT
+	    SIG_DEL(new_mask, SIGIOT);
+#	endif
+#	ifdef SIGEMT
+	    SIG_DEL(new_mask, SIGEMT);
+#	endif
+#	ifdef SIGTRAP
+	    SIG_DEL(new_mask, SIGTRAP);
+#	endif 
+	mask_initialized = TRUE;
+    }
+#   ifdef CHECK_SIGNALS
+	if (GC_sig_disabled != 0) ABORT("Nested disables");
+	GC_sig_disabled++;
+#   endif
+    SIGSETMASK(old_mask,new_mask);
+}
+
+void GC_enable_signals()
+{
+#   ifdef CHECK_SIGNALS
+	if (GC_sig_disabled != 1) ABORT("Unmatched enable");
+	GC_sig_disabled--;
+#   endif
+    SIGSETMASK(dummy,old_mask);
+}
+
+#  endif  /* !PCR */
+
+# endif /*!OS/2 */
+
+/* Ivan Demakov: simplest way (to me) */
+#ifdef DOS4GW
+  void GC_disable_signals() { }
+  void GC_enable_signals() { }
+#endif
+
+/* Find the page size */
+word GC_page_size;
+
+# ifdef MSWIN32
+  void GC_setpagesize()
+  {
+    SYSTEM_INFO sysinfo;
+    
+    GetSystemInfo(&sysinfo);
+    GC_page_size = sysinfo.dwPageSize;
+  }
+
+# else
+#   if defined(MPROTECT_VDB) || defined(PROC_VDB) || defined(USE_MMAP) \
+       || defined(USE_MUNMAP)
+	void GC_setpagesize()
+	{
+	    GC_page_size = GETPAGESIZE();
+	}
+#   else
+	/* It's acceptable to fake it. */
+	void GC_setpagesize()
+	{
+	    GC_page_size = HBLKSIZE;
+	}
+#   endif
+# endif
+
+/* 
+ * Find the base of the stack. 
+ * Used only in single-threaded environment.
+ * With threads, GC_mark_roots needs to know how to do this.
+ * Called with allocator lock held.
+ */
+# ifdef MSWIN32 
+# define is_writable(prot) ((prot) == PAGE_READWRITE \
+			    || (prot) == PAGE_WRITECOPY \
+			    || (prot) == PAGE_EXECUTE_READWRITE \
+			    || (prot) == PAGE_EXECUTE_WRITECOPY)
+/* Return the number of bytes that are writable starting at p.	*/
+/* The pointer p is assumed to be page aligned.			*/
+/* If base is not 0, *base becomes the beginning of the 	*/
+/* allocation region containing p.				*/
+word GC_get_writable_length(ptr_t p, ptr_t *base)
+{
+    MEMORY_BASIC_INFORMATION buf;
+    word result;
+    word protect;
+    
+    result = VirtualQuery(p, &buf, sizeof(buf));
+    if (result != sizeof(buf)) ABORT("Weird VirtualQuery result");
+    if (base != 0) *base = (ptr_t)(buf.AllocationBase);
+    protect = (buf.Protect & ~(PAGE_GUARD | PAGE_NOCACHE));
+    if (!is_writable(protect)) {
+        return(0);
+    }
+    if (buf.State != MEM_COMMIT) return(0);
+    return(buf.RegionSize);
+}
+
+ptr_t GC_get_stack_base()
+{
+    int dummy;
+    ptr_t sp = (ptr_t)(&dummy);
+    ptr_t trunc_sp = (ptr_t)((word)sp & ~(GC_page_size - 1));
+    word size = GC_get_writable_length(trunc_sp, 0);
+   
+    return(trunc_sp + size);
+}
+
+
+# else
+
+# ifdef OS2
+
+ptr_t GC_get_stack_base()
+{
+    PTIB ptib;
+    PPIB ppib;
+    
+    if (DosGetInfoBlocks(&ptib, &ppib) != NO_ERROR) {
+    	GC_err_printf0("DosGetInfoBlocks failed\n");
+    	ABORT("DosGetInfoBlocks failed\n");
+    }
+    return((ptr_t)(ptib -> tib_pstacklimit));
+}
+
+# else
+
+# ifdef AMIGA
+
+ptr_t GC_get_stack_base()
+{
+    struct Process *proc = (struct Process*)SysBase->ThisTask;
+ 
+    /* Reference: Amiga Guru Book Pages: 42,567,574 */
+    if (proc->pr_Task.tc_Node.ln_Type==NT_PROCESS
+        && proc->pr_CLI != NULL) {
+	/* first ULONG is StackSize */
+	/*longPtr = proc->pr_ReturnAddr;
+	size = longPtr[0];*/
+
+	return (char *)proc->pr_ReturnAddr + sizeof(ULONG);
+    } else {
+	return (char *)proc->pr_Task.tc_SPUpper;
+    }
+}
+
+#if 0 /* old version */
+ptr_t GC_get_stack_base()
+{
+    extern struct WBStartup *_WBenchMsg;
+    extern long __base;
+    extern long __stack;
+    struct Task *task;
+    struct Process *proc;
+    struct CommandLineInterface *cli;
+    long size;
+
+    if ((task = FindTask(0)) == 0) {
+	GC_err_puts("Cannot find own task structure\n");
+	ABORT("task missing");
+    }
+    proc = (struct Process *)task;
+    cli = BADDR(proc->pr_CLI);
+
+    if (_WBenchMsg != 0 || cli == 0) {
+	size = (char *)task->tc_SPUpper - (char *)task->tc_SPLower;
+    } else {
+	size = cli->cli_DefaultStack * 4;
+    }
+    return (ptr_t)(__base + GC_max(size, __stack));
+}
+#endif /* 0 */
+
+# else /* !AMIGA, !OS2, ... */
+
+# ifdef NEED_FIND_LIMIT
+  /* Some tools to implement HEURISTIC2	*/
+#   define MIN_PAGE_SIZE 256	/* Smallest conceivable page size, bytes */
+    /* static */ jmp_buf GC_jmp_buf;
+    
+    /*ARGSUSED*/
+    void GC_fault_handler(sig)
+    int sig;
+    {
+        longjmp(GC_jmp_buf, 1);
+    }
+
+#   ifdef __STDC__
+	typedef void (*handler)(int);
+#   else
+	typedef void (*handler)();
+#   endif
+
+#   if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1)
+	static struct sigaction old_segv_act;
+#	if defined(_sigargs) || defined(HPUX) /* !Irix6.x */
+	    static struct sigaction old_bus_act;
+#	endif
+#   else
+        static handler old_segv_handler, old_bus_handler;
+#   endif
+    
+    void GC_setup_temporary_fault_handler()
+    {
+#	if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1)
+	  struct sigaction	act;
+
+	  act.sa_handler	= GC_fault_handler;
+          act.sa_flags          = SA_RESTART | SA_NODEFER;
+          /* The presence of SA_NODEFER represents yet another gross    */
+          /* hack.  Under Solaris 2.3, siglongjmp doesn't appear to     */
+          /* interact correctly with -lthread.  We hide the confusion   */
+          /* by making sure that signal handling doesn't affect the     */
+          /* signal mask.                                               */
+
+	  (void) sigemptyset(&act.sa_mask);
+#	  ifdef IRIX_THREADS
+		/* Older versions have a bug related to retrieving and	*/
+		/* and setting a handler at the same time.		*/
+	        (void) sigaction(SIGSEGV, 0, &old_segv_act);
+	        (void) sigaction(SIGSEGV, &act, 0);
+#	  else
+	        (void) sigaction(SIGSEGV, &act, &old_segv_act);
+#		if defined(IRIX5) && defined(_sigargs) /* Irix 5.x, not 6.x */ \
+		   || defined(HPUX)
+		    /* Under Irix 5.x or HP/UX, we may get SIGBUS.	*/
+		    /* Pthreads doesn't exist under Irix 5.x, so we	*/
+		    /* don't have to worry in the threads case.		*/
+		    (void) sigaction(SIGBUS, &act, &old_bus_act);
+#		endif
+#	  endif	/* IRIX_THREADS */
+#	else
+    	  old_segv_handler = signal(SIGSEGV, GC_fault_handler);
+#	  ifdef SIGBUS
+	    old_bus_handler = signal(SIGBUS, GC_fault_handler);
+#	  endif
+#	endif
+    }
+    
+    void GC_reset_fault_handler()
+    {
+#       if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1)
+	  (void) sigaction(SIGSEGV, &old_segv_act, 0);
+#	  if defined(IRIX5) && defined(_sigargs) /* Irix 5.x, not 6.x */ \
+	     || defined(HPUX)
+	      (void) sigaction(SIGBUS, &old_bus_act, 0);
+#	  endif
+#       else
+  	  (void) signal(SIGSEGV, old_segv_handler);
+#	  ifdef SIGBUS
+	    (void) signal(SIGBUS, old_bus_handler);
+#	  endif
+#       endif
+    }
+
+    /* Return the first nonaddressible location > p (up) or 	*/
+    /* the smallest location q s.t. [q,p] is addressible (!up).	*/
+    ptr_t GC_find_limit(p, up)
+    ptr_t p;
+    GC_bool up;
+    {
+        static VOLATILE ptr_t result;
+    		/* Needs to be static, since otherwise it may not be	*/
+    		/* preserved across the longjmp.  Can safely be 	*/
+    		/* static since it's only called once, with the		*/
+    		/* allocation lock held.				*/
+
+
+	GC_setup_temporary_fault_handler();
+	if (setjmp(GC_jmp_buf) == 0) {
+	    result = (ptr_t)(((word)(p))
+			      & ~(MIN_PAGE_SIZE-1));
+	    for (;;) {
+ 	        if (up) {
+		    result += MIN_PAGE_SIZE;
+ 	        } else {
+		    result -= MIN_PAGE_SIZE;
+ 	        }
+		GC_noop1((word)(*result));
+	    }
+	}
+	GC_reset_fault_handler();
+ 	if (!up) {
+	    result += MIN_PAGE_SIZE;
+ 	}
+	return(result);
+    }
+# endif
+
+#ifdef LINUX_STACKBOTTOM
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+
+# define STAT_SKIP 27   /* Number of fields preceding startstack	*/
+			/* field in /proc/self/stat			*/
+
+  ptr_t GC_linux_stack_base(void)
+  {
+    /* We read the stack base value from /proc/self/stat.  We do this	*/
+    /* using direct I/O system calls in order to avoid calling malloc   */
+    /* in case REDIRECT_MALLOC is defined.				*/ 
+#   define STAT_BUF_SIZE 4096
+#   ifdef USE_LD_WRAP
+#	define STAT_READ __real_read
+#   else
+#	define STAT_READ read
+#   endif    
+    char stat_buf[STAT_BUF_SIZE];
+    int f;
+    char c;
+    word result = 0;
+    size_t i, buf_offset = 0;
+
+    f = open("/proc/self/stat", O_RDONLY);
+    if (f < 0 || STAT_READ(f, stat_buf, STAT_BUF_SIZE) < 2 * STAT_SKIP) {
+	ABORT("Couldn't read /proc/self/stat");
+    }
+    c = stat_buf[buf_offset++];
+    /* Skip the required number of fields.  This number is hopefully	*/
+    /* constant across all Linux implementations.			*/
+      for (i = 0; i < STAT_SKIP; ++i) {
+	while (isspace(c)) c = stat_buf[buf_offset++];
+	while (!isspace(c)) c = stat_buf[buf_offset++];
+      }
+    while (isspace(c)) c = stat_buf[buf_offset++];
+    while (isdigit(c)) {
+      result *= 10;
+      result += c - '0';
+      c = stat_buf[buf_offset++];
+    }
+    close(f);
+    if (result < 0x10000000) ABORT("Absurd stack bottom value");
+    return (ptr_t)result;
+  }
+
+#endif /* LINUX_STACKBOTTOM */
+
+ptr_t GC_get_stack_base()
+{
+    word dummy;
+    ptr_t result;
+
+#   define STACKBOTTOM_ALIGNMENT_M1 ((word)STACK_GRAN - 1)
+
+#   ifdef STACKBOTTOM
+	return(STACKBOTTOM);
+#   else
+#	ifdef HEURISTIC1
+#	   ifdef STACK_GROWS_DOWN
+	     result = (ptr_t)((((word)(&dummy))
+	     		       + STACKBOTTOM_ALIGNMENT_M1)
+			      & ~STACKBOTTOM_ALIGNMENT_M1);
+#	   else
+	     result = (ptr_t)(((word)(&dummy))
+			      & ~STACKBOTTOM_ALIGNMENT_M1);
+#	   endif
+#	endif /* HEURISTIC1 */
+#	ifdef LINUX_STACKBOTTOM
+	   result = GC_linux_stack_base();
+#	endif
+#	ifdef HEURISTIC2
+#	    ifdef STACK_GROWS_DOWN
+		result = GC_find_limit((ptr_t)(&dummy), TRUE);
+#           	ifdef HEURISTIC2_LIMIT
+		    if (result > HEURISTIC2_LIMIT
+		        && (ptr_t)(&dummy) < HEURISTIC2_LIMIT) {
+		            result = HEURISTIC2_LIMIT;
+		    }
+#	        endif
+#	    else
+		result = GC_find_limit((ptr_t)(&dummy), FALSE);
+#           	ifdef HEURISTIC2_LIMIT
+		    if (result < HEURISTIC2_LIMIT
+		        && (ptr_t)(&dummy) > HEURISTIC2_LIMIT) {
+		            result = HEURISTIC2_LIMIT;
+		    }
+#	        endif
+#	    endif
+
+#	endif /* HEURISTIC2 */
+#	ifdef STACK_GROWS_DOWN
+	    if (result == 0) result = (ptr_t)(signed_word)(-sizeof(ptr_t));
+#	endif
+    	return(result);
+#   endif /* STACKBOTTOM */
+}
+
+# endif /* ! AMIGA */
+# endif /* ! OS2 */
+# endif /* ! MSWIN32 */
+
+/*
+ * Register static data segment(s) as roots.
+ * If more data segments are added later then they need to be registered
+ * add that point (as we do with SunOS dynamic loading),
+ * or GC_mark_roots needs to check for them (as we do with PCR).
+ * Called with allocator lock held.
+ */
+
+# ifdef OS2
+
+void GC_register_data_segments()
+{
+    PTIB ptib;
+    PPIB ppib;
+    HMODULE module_handle;
+#   define PBUFSIZ 512
+    UCHAR path[PBUFSIZ];
+    FILE * myexefile;
+    struct exe_hdr hdrdos;	/* MSDOS header.	*/
+    struct e32_exe hdr386;	/* Real header for my executable */
+    struct o32_obj seg;	/* Currrent segment */
+    int nsegs;
+    
+    
+    if (DosGetInfoBlocks(&ptib, &ppib) != NO_ERROR) {
+    	GC_err_printf0("DosGetInfoBlocks failed\n");
+    	ABORT("DosGetInfoBlocks failed\n");
+    }
+    module_handle = ppib -> pib_hmte;
+    if (DosQueryModuleName(module_handle, PBUFSIZ, path) != NO_ERROR) {
+    	GC_err_printf0("DosQueryModuleName failed\n");
+    	ABORT("DosGetInfoBlocks failed\n");
+    }
+    myexefile = fopen(path, "rb");
+    if (myexefile == 0) {
+        GC_err_puts("Couldn't open executable ");
+        GC_err_puts(path); GC_err_puts("\n");
+        ABORT("Failed to open executable\n");
+    }
+    if (fread((char *)(&hdrdos), 1, sizeof hdrdos, myexefile) < sizeof hdrdos) {
+        GC_err_puts("Couldn't read MSDOS header from ");
+        GC_err_puts(path); GC_err_puts("\n");
+        ABORT("Couldn't read MSDOS header");
+    }
+    if (E_MAGIC(hdrdos) != EMAGIC) {
+        GC_err_puts("Executable has wrong DOS magic number: ");
+        GC_err_puts(path); GC_err_puts("\n");
+        ABORT("Bad DOS magic number");
+    }
+    if (fseek(myexefile, E_LFANEW(hdrdos), SEEK_SET) != 0) {
+        GC_err_puts("Seek to new header failed in ");
+        GC_err_puts(path); GC_err_puts("\n");
+        ABORT("Bad DOS magic number");
+    }
+    if (fread((char *)(&hdr386), 1, sizeof hdr386, myexefile) < sizeof hdr386) {
+        GC_err_puts("Couldn't read MSDOS header from ");
+        GC_err_puts(path); GC_err_puts("\n");
+        ABORT("Couldn't read OS/2 header");
+    }
+    if (E32_MAGIC1(hdr386) != E32MAGIC1 || E32_MAGIC2(hdr386) != E32MAGIC2) {
+        GC_err_puts("Executable has wrong OS/2 magic number:");
+        GC_err_puts(path); GC_err_puts("\n");
+        ABORT("Bad OS/2 magic number");
+    }
+    if ( E32_BORDER(hdr386) != E32LEBO || E32_WORDER(hdr386) != E32LEWO) {
+        GC_err_puts("Executable %s has wrong byte order: ");
+        GC_err_puts(path); GC_err_puts("\n");
+        ABORT("Bad byte order");
+    }
+    if ( E32_CPU(hdr386) == E32CPU286) {
+        GC_err_puts("GC can't handle 80286 executables: ");
+        GC_err_puts(path); GC_err_puts("\n");
+        EXIT();
+    }
+    if (fseek(myexefile, E_LFANEW(hdrdos) + E32_OBJTAB(hdr386),
+    	      SEEK_SET) != 0) {
+        GC_err_puts("Seek to object table failed: ");
+        GC_err_puts(path); GC_err_puts("\n");
+        ABORT("Seek to object table failed");
+    }
+    for (nsegs = E32_OBJCNT(hdr386); nsegs > 0; nsegs--) {
+      int flags;
+      if (fread((char *)(&seg), 1, sizeof seg, myexefile) < sizeof seg) {
+        GC_err_puts("Couldn't read obj table entry from ");
+        GC_err_puts(path); GC_err_puts("\n");
+        ABORT("Couldn't read obj table entry");
+      }
+      flags = O32_FLAGS(seg);
+      if (!(flags & OBJWRITE)) continue;
+      if (!(flags & OBJREAD)) continue;
+      if (flags & OBJINVALID) {
+          GC_err_printf0("Object with invalid pages?\n");
+          continue;
+      } 
+      GC_add_roots_inner(O32_BASE(seg), O32_BASE(seg)+O32_SIZE(seg), FALSE);
+    }
+}
+
+# else
+
+# ifdef MSWIN32
+  /* Unfortunately, we have to handle win32s very differently from NT, 	*/
+  /* Since VirtualQuery has very different semantics.  In particular,	*/
+  /* under win32s a VirtualQuery call on an unmapped page returns an	*/
+  /* invalid result.  Under GC_register_data_segments is a noop and	*/
+  /* all real work is done by GC_register_dynamic_libraries.  Under	*/
+  /* win32s, we cannot find the data segments associated with dll's.	*/
+  /* We rgister the main data segment here.				*/
+  GC_bool GC_win32s = FALSE;	/* We're running under win32s.	*/
+  
+  GC_bool GC_is_win32s()
+  {
+      DWORD v = GetVersion();
+      
+      /* Check that this is not NT, and Windows major version <= 3	*/
+      return ((v & 0x80000000) && (v & 0xff) <= 3);
+  }
+  
+  void GC_init_win32()
+  {
+      GC_win32s = GC_is_win32s();
+  }
+  
+  /* Return the smallest address a such that VirtualQuery		*/
+  /* returns correct results for all addresses between a and start.	*/
+  /* Assumes VirtualQuery returns correct information for start.	*/
+  ptr_t GC_least_described_address(ptr_t start)
+  {  
+    MEMORY_BASIC_INFORMATION buf;
+    SYSTEM_INFO sysinfo;
+    DWORD result;
+    LPVOID limit;
+    ptr_t p;
+    LPVOID q;
+    
+    GetSystemInfo(&sysinfo);
+    limit = sysinfo.lpMinimumApplicationAddress;
+    p = (ptr_t)((word)start & ~(GC_page_size - 1));
+    for (;;) {
+    	q = (LPVOID)(p - GC_page_size);
+    	if ((ptr_t)q > (ptr_t)p /* underflow */ || q < limit) break;
+    	result = VirtualQuery(q, &buf, sizeof(buf));
+    	if (result != sizeof(buf) || buf.AllocationBase == 0) break;
+    	p = (ptr_t)(buf.AllocationBase);
+    }
+    return(p);
+  }
+  
+  /* Is p the start of either the malloc heap, or of one of our */
+  /* heap sections?						*/
+  GC_bool GC_is_heap_base (ptr_t p)
+  {
+     
+     register unsigned i;
+     
+#    ifndef REDIRECT_MALLOC
+       static ptr_t malloc_heap_pointer = 0;
+     
+       if (0 == malloc_heap_pointer) {
+         MEMORY_BASIC_INFORMATION buf;
+         register DWORD result = VirtualQuery(malloc(1), &buf, sizeof(buf));
+         
+         if (result != sizeof(buf)) {
+             ABORT("Weird VirtualQuery result");
+         }
+         malloc_heap_pointer = (ptr_t)(buf.AllocationBase);
+       }
+       if (p == malloc_heap_pointer) return(TRUE);
+#    endif
+     for (i = 0; i < GC_n_heap_bases; i++) {
+         if (GC_heap_bases[i] == p) return(TRUE);
+     }
+     return(FALSE);
+  }
+  
+  void GC_register_root_section(ptr_t static_root)
+  {
+      MEMORY_BASIC_INFORMATION buf;
+      SYSTEM_INFO sysinfo;
+      DWORD result;
+      DWORD protect;
+      LPVOID p;
+      char * base;
+      char * limit, * new_limit;
+    
+      if (!GC_win32s) return;
+      p = base = limit = GC_least_described_address(static_root);
+      GetSystemInfo(&sysinfo);
+      while (p < sysinfo.lpMaximumApplicationAddress) {
+        result = VirtualQuery(p, &buf, sizeof(buf));
+        if (result != sizeof(buf) || buf.AllocationBase == 0
+            || GC_is_heap_base(buf.AllocationBase)) break;
+        new_limit = (char *)p + buf.RegionSize;
+        protect = buf.Protect;
+        if (buf.State == MEM_COMMIT
+            && is_writable(protect)) {
+            if ((char *)p == limit) {
+                limit = new_limit;
+            } else {
+                if (base != limit) GC_add_roots_inner(base, limit, FALSE);
+                base = p;
+                limit = new_limit;
+            }
+        }
+        if (p > (LPVOID)new_limit /* overflow */) break;
+        p = (LPVOID)new_limit;
+      }
+      if (base != limit) GC_add_roots_inner(base, limit, FALSE);
+  }
+  
+  void GC_register_data_segments()
+  {
+      static char dummy;
+      
+      GC_register_root_section((ptr_t)(&dummy));
+  }
+# else
+# ifdef AMIGA
+
+   void GC_register_data_segments()
+   {
+     struct Process	*proc;
+     struct CommandLineInterface *cli;
+     BPTR myseglist;
+     ULONG *data;
+ 
+     int	num;
+
+
+#    ifdef __GNUC__
+        ULONG dataSegSize;
+        GC_bool found_segment = FALSE;
+	extern char __data_size[];
+
+	dataSegSize=__data_size+8;
+	/* Can`t find the Location of __data_size, because
+           it`s possible that is it, inside the segment. */
+
+#     endif
+
+	proc= (struct Process*)SysBase->ThisTask;
+
+	/* Reference: Amiga Guru Book Pages: 538ff,565,573
+		     and XOper.asm */
+	if (proc->pr_Task.tc_Node.ln_Type==NT_PROCESS) {
+	  if (proc->pr_CLI == NULL) {
+	    myseglist = proc->pr_SegList;
+	  } else {
+	    /* ProcLoaded	'Loaded as a command: '*/
+	    cli = BADDR(proc->pr_CLI);
+	    myseglist = cli->cli_Module;
+	  }
+	} else {
+	  ABORT("Not a Process.");
+ 	}
+
+	if (myseglist == NULL) {
+	    ABORT("Arrrgh.. can't find segments, aborting");
+ 	}
+
+	/* xoper hunks Shell Process */
+
+	num=0;
+        for (data = (ULONG *)BADDR(myseglist); data != NULL;
+             data = (ULONG *)BADDR(data[0])) {
+	  if (((ULONG) GC_register_data_segments < (ULONG) &data[1]) ||
+	      ((ULONG) GC_register_data_segments > (ULONG) &data[1] + data[-1])) {
+#             ifdef __GNUC__
+		if (dataSegSize == data[-1]) {
+		  found_segment = TRUE;
+		}
+# 	      endif
+	      GC_add_roots_inner((char *)&data[1],
+				 ((char *)&data[1]) + data[-1], FALSE);
+          }
+          ++num;
+        } /* for */
+# 	ifdef __GNUC__
+	   if (!found_segment) {
+	     ABORT("Can`t find correct Segments.\nSolution: Use an newer version of ixemul.library");
+	   }
+# 	endif
+  }
+
+#if 0 /* old version */
+  void GC_register_data_segments()
+  {
+    extern struct WBStartup *_WBenchMsg;
+    struct Process	*proc;
+    struct CommandLineInterface *cli;
+    BPTR myseglist;
+    ULONG *data;
+
+    if ( _WBenchMsg != 0 ) {
+	if ((myseglist = _WBenchMsg->sm_Segment) == 0) {
+	    GC_err_puts("No seglist from workbench\n");
+	    return;
+	}
+    } else {
+	if ((proc = (struct Process *)FindTask(0)) == 0) {
+	    GC_err_puts("Cannot find process structure\n");
+	    return;
+	}
+	if ((cli = BADDR(proc->pr_CLI)) == 0) {
+	    GC_err_puts("No CLI\n");
+	    return;
+	}
+	if ((myseglist = cli->cli_Module) == 0) {
+	    GC_err_puts("No seglist from CLI\n");
+	    return;
+	}
+    }
+
+    for (data = (ULONG *)BADDR(myseglist); data != 0;
+         data = (ULONG *)BADDR(data[0])) {
+#        ifdef AMIGA_SKIP_SEG
+           if (((ULONG) GC_register_data_segments < (ULONG) &data[1]) ||
+           ((ULONG) GC_register_data_segments > (ULONG) &data[1] + data[-1])) {
+#	 else
+      	   {
+#	 endif /* AMIGA_SKIP_SEG */
+          GC_add_roots_inner((char *)&data[1],
+          		     ((char *)&data[1]) + data[-1], FALSE);
+         }
+    }
+  }
+#endif /* old version */
+
+
+# else
+
+# if (defined(SVR4) || defined(AUX) || defined(DGUX)) && !defined(PCR)
+char * GC_SysVGetDataStart(max_page_size, etext_addr)
+int max_page_size;
+int * etext_addr;
+{
+    word text_end = ((word)(etext_addr) + sizeof(word) - 1)
+    		    & ~(sizeof(word) - 1);
+    	/* etext rounded to word boundary	*/
+    word next_page = ((text_end + (word)max_page_size - 1)
+    		      & ~((word)max_page_size - 1));
+    word page_offset = (text_end & ((word)max_page_size - 1));
+    VOLATILE char * result = (char *)(next_page + page_offset);
+    /* Note that this isnt equivalent to just adding		*/
+    /* max_page_size to &etext if &etext is at a page boundary	*/
+    
+    GC_setup_temporary_fault_handler();
+    if (setjmp(GC_jmp_buf) == 0) {
+    	/* Try writing to the address.	*/
+    	*result = *result;
+        GC_reset_fault_handler();
+    } else {
+        GC_reset_fault_handler();
+    	/* We got here via a longjmp.  The address is not readable.	*/
+    	/* This is known to happen under Solaris 2.4 + gcc, which place	*/
+    	/* string constants in the text segment, but after etext.	*/
+    	/* Use plan B.  Note that we now know there is a gap between	*/
+    	/* text and data segments, so plan A bought us something.	*/
+    	result = (char *)GC_find_limit((ptr_t)(DATAEND) - MIN_PAGE_SIZE, FALSE);
+    }
+    return((char *)result);
+}
+# endif
+
+
+void GC_register_data_segments()
+{
+#   if !defined(PCR) && !defined(SRC_M3) && !defined(NEXT) && !defined(MACOS) \
+       && !defined(MACOSX)
+#     if defined(REDIRECT_MALLOC) && defined(SOLARIS_THREADS)
+	/* As of Solaris 2.3, the Solaris threads implementation	*/
+	/* allocates the data structure for the initial thread with	*/
+	/* sbrk at process startup.  It needs to be scanned, so that	*/
+	/* we don't lose some malloc allocated data structures		*/
+	/* hanging from it.  We're on thin ice here ...			*/
+        extern caddr_t sbrk();
+
+	GC_add_roots_inner(DATASTART, (char *)sbrk(0), FALSE);
+#     else
+	GC_add_roots_inner(DATASTART, (char *)(DATAEND), FALSE);
+#     endif
+#   endif
+#   if !defined(PCR) && (defined(NEXT) || defined(MACOSX))
+      GC_add_roots_inner(DATASTART, (char *) get_end(), FALSE);
+#   endif
+#   if defined(MACOS)
+    {
+#   if defined(THINK_C)
+	extern void* GC_MacGetDataStart(void);
+	/* globals begin above stack and end at a5. */
+	GC_add_roots_inner((ptr_t)GC_MacGetDataStart(),
+			   (ptr_t)LMGetCurrentA5(), FALSE);
+#   else
+#     if defined(__MWERKS__)
+#       if !__POWERPC__
+	  extern void* GC_MacGetDataStart(void);
+	  /* MATTHEW: Function to handle Far Globals (CW Pro 3) */
+#         if __option(far_data)
+	  extern void* GC_MacGetDataEnd(void);
+#         endif
+	  /* globals begin above stack and end at a5. */
+	  GC_add_roots_inner((ptr_t)GC_MacGetDataStart(),
+          		     (ptr_t)LMGetCurrentA5(), FALSE);
+	  /* MATTHEW: Handle Far Globals */          		     
+#         if __option(far_data)
+      /* Far globals follow he QD globals: */
+	  GC_add_roots_inner((ptr_t)LMGetCurrentA5(),
+          		     (ptr_t)GC_MacGetDataEnd(), FALSE);
+#         endif
+#       else
+	  extern char __data_start__[], __data_end__[];
+	  GC_add_roots_inner((ptr_t)&__data_start__,
+	  		     (ptr_t)&__data_end__, FALSE);
+#       endif /* __POWERPC__ */
+#     endif /* __MWERKS__ */
+#   endif /* !THINK_C */
+    }
+#   endif /* MACOS */
+
+    /* Dynamic libraries are added at every collection, since they may  */
+    /* change.								*/
+}
+
+# endif  /* ! AMIGA */
+# endif  /* ! MSWIN32 */
+# endif  /* ! OS2 */
+
+/*
+ * Auxiliary routines for obtaining memory from OS.
+ */
+ 
+# if !defined(OS2) && !defined(PCR) && !defined(AMIGA) \
+	&& !defined(MSWIN32) && !defined(MACOS) && !defined(DOS4GW)
+
+# ifdef SUNOS4
+    extern caddr_t sbrk();
+# endif
+# ifdef __STDC__
+#   define SBRK_ARG_T ptrdiff_t
+# else
+#   define SBRK_ARG_T int
+# endif
+
+# ifdef RS6000
+/* The compiler seems to generate speculative reads one past the end of	*/
+/* an allocated object.  Hence we need to make sure that the page 	*/
+/* following the last heap page is also mapped.				*/
+ptr_t GC_unix_get_mem(bytes)
+word bytes;
+{
+    caddr_t cur_brk = (caddr_t)sbrk(0);
+    caddr_t result;
+    SBRK_ARG_T lsbs = (word)cur_brk & (GC_page_size-1);
+    static caddr_t my_brk_val = 0;
+    
+    if ((SBRK_ARG_T)bytes < 0) return(0); /* too big */
+    if (lsbs != 0) {
+        if((caddr_t)(sbrk(GC_page_size - lsbs)) == (caddr_t)(-1)) return(0);
+    }
+    if (cur_brk == my_brk_val) {
+    	/* Use the extra block we allocated last time. */
+        result = (ptr_t)sbrk((SBRK_ARG_T)bytes);
+        if (result == (caddr_t)(-1)) return(0);
+        result -= GC_page_size;
+    } else {
+        result = (ptr_t)sbrk(GC_page_size + (SBRK_ARG_T)bytes);
+        if (result == (caddr_t)(-1)) return(0);
+    }
+    my_brk_val = result + bytes + GC_page_size;	/* Always page aligned */
+    return((ptr_t)result);
+}
+
+#else  /* Not RS6000 */
+
+#if defined(USE_MMAP)
+/* Tested only under IRIX5 and Solaris 2 */
+
+#ifdef USE_MMAP_FIXED
+#   define GC_MMAP_FLAGS MAP_FIXED | MAP_PRIVATE
+	/* Seems to yield better performance on Solaris 2, but can	*/
+	/* be unreliable if something is already mapped at the address.	*/
+#else
+#   define GC_MMAP_FLAGS MAP_PRIVATE
+#endif
+
+ptr_t GC_unix_get_mem(bytes)
+word bytes;
+{
+    static GC_bool initialized = FALSE;
+    static int fd;
+    void *result;
+    static ptr_t last_addr = HEAP_START;
+
+    if (!initialized) {
+	fd = open("/dev/zero", O_RDONLY);
+	initialized = TRUE;
+    }
+    if (bytes & (GC_page_size -1)) ABORT("Bad GET_MEM arg");
+    result = mmap(last_addr, bytes, PROT_READ | PROT_WRITE | OPT_PROT_EXEC,
+		  GC_MMAP_FLAGS, fd, 0/* offset */);
+    if (result == MAP_FAILED) return(0);
+    last_addr = (ptr_t)result + bytes + GC_page_size - 1;
+    last_addr = (ptr_t)((word)last_addr & ~(GC_page_size - 1));
+    return((ptr_t)result);
+}
+
+#else /* Not RS6000, not USE_MMAP */
+ptr_t GC_unix_get_mem(bytes)
+word bytes;
+{
+  ptr_t result;
+# ifdef IRIX5
+    /* Bare sbrk isn't thread safe.  Play by malloc rules.	*/
+    /* The equivalent may be needed on other systems as well. 	*/
+    __LOCK_MALLOC();
+# endif
+  {
+    ptr_t cur_brk = (ptr_t)sbrk(0);
+    SBRK_ARG_T lsbs = (word)cur_brk & (GC_page_size-1);
+    
+    if ((SBRK_ARG_T)bytes < 0) return(0); /* too big */
+    if (lsbs != 0) {
+        if((ptr_t)sbrk(GC_page_size - lsbs) == (ptr_t)(-1)) return(0);
+    }
+    result = (ptr_t)sbrk((SBRK_ARG_T)bytes);
+    if (result == (ptr_t)(-1)) result = 0;
+  }
+# ifdef IRIX5
+    __UNLOCK_MALLOC();
+# endif
+  return(result);
+}
+
+#endif /* Not USE_MMAP */
+#endif /* Not RS6000 */
+
+# endif /* UN*X */
+
+# ifdef OS2
+
+void * os2_alloc(size_t bytes)
+{
+    void * result;
+
+    if (DosAllocMem(&result, bytes, PAG_EXECUTE | PAG_READ |
+    				    PAG_WRITE | PAG_COMMIT)
+		    != NO_ERROR) {
+	return(0);
+    }
+    if (result == 0) return(os2_alloc(bytes));
+    return(result);
+}
+
+# endif /* OS2 */
+
+
+# ifdef MSWIN32
+word GC_n_heap_bases = 0;
+
+ptr_t GC_win32_get_mem(bytes)
+word bytes;
+{
+    ptr_t result;
+    
+    if (GC_win32s) {
+    	/* VirtualAlloc doesn't like PAGE_EXECUTE_READWRITE.	*/
+    	/* There are also unconfirmed rumors of other		*/
+    	/* problems, so we dodge the issue.			*/
+        result = (ptr_t) GlobalAlloc(0, bytes + HBLKSIZE);
+        result = (ptr_t)(((word)result + HBLKSIZE) & ~(HBLKSIZE-1));
+    } else {
+        result = (ptr_t) VirtualAlloc(NULL, bytes,
+    				      MEM_COMMIT | MEM_RESERVE,
+    				      PAGE_EXECUTE_READWRITE);
+    }
+    if (HBLKDISPL(result) != 0) ABORT("Bad VirtualAlloc result");
+    	/* If I read the documentation correctly, this can	*/
+    	/* only happen if HBLKSIZE > 64k or not a power of 2.	*/
+    if (GC_n_heap_bases >= MAX_HEAP_SECTS) ABORT("Too many heap sections");
+    GC_heap_bases[GC_n_heap_bases++] = result;
+    return(result);			  
+}
+
+void GC_win32_free_heap ()
+{
+    if (GC_win32s) {
+ 	while (GC_n_heap_bases > 0) {
+ 	    GlobalFree (GC_heap_bases[--GC_n_heap_bases]);
+ 	    GC_heap_bases[GC_n_heap_bases] = 0;
+ 	}
+    }
+}
+
+
+# endif
+
+#ifdef USE_MUNMAP
+
+/* For now, this only works on some Unix-like systems.  If you 	*/
+/* have something else, don't define USE_MUNMAP.		*/
+/* We assume ANSI C to support this feature.			*/
+#include <unistd.h>
+#include <sys/mman.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <fcntl.h>
+
+/* Compute a page aligned starting address for the unmap 	*/
+/* operation on a block of size bytes starting at start.	*/
+/* Return 0 if the block is too small to make this feasible.	*/
+ptr_t GC_unmap_start(ptr_t start, word bytes)
+{
+    ptr_t result = start;
+    /* Round start to next page boundary.       */
+        result += GC_page_size - 1;
+        result = (ptr_t)((word)result & ~(GC_page_size - 1));
+    if (result + GC_page_size > start + bytes) return 0;
+    return result;
+}
+
+/* Compute end address for an unmap operation on the indicated	*/
+/* block.							*/
+ptr_t GC_unmap_end(ptr_t start, word bytes)
+{
+    ptr_t end_addr = start + bytes;
+    end_addr = (ptr_t)((word)end_addr & ~(GC_page_size - 1));
+    return end_addr;
+}
+
+/* We assume that GC_remap is called on exactly the same range	*/
+/* as a previous call to GC_unmap.  It is safe to consistently	*/
+/* round the endpoints in both places.				*/
+void GC_unmap(ptr_t start, word bytes)
+{
+    ptr_t start_addr = GC_unmap_start(start, bytes);
+    ptr_t end_addr = GC_unmap_end(start, bytes);
+    word len = end_addr - start_addr;
+    if (0 == start_addr) return;
+    if (munmap(start_addr, len) != 0) ABORT("munmap failed");
+    GC_unmapped_bytes += len;
+}
+
+
+void GC_remap(ptr_t start, word bytes)
+{
+    static int zero_descr = -1;
+    ptr_t start_addr = GC_unmap_start(start, bytes);
+    ptr_t end_addr = GC_unmap_end(start, bytes);
+    word len = end_addr - start_addr;
+    ptr_t result;
+
+    if (-1 == zero_descr) zero_descr = open("/dev/zero", O_RDWR);
+    if (0 == start_addr) return;
+    result = mmap(start_addr, len, PROT_READ | PROT_WRITE | OPT_PROT_EXEC,
+	          MAP_FIXED | MAP_PRIVATE, zero_descr, 0);
+    if (result != start_addr) {
+	ABORT("mmap remapping failed");
+    }
+    GC_unmapped_bytes -= len;
+}
+
+/* Two adjacent blocks have already been unmapped and are about to	*/
+/* be merged.  Unmap the whole block.  This typically requires		*/
+/* that we unmap a small section in the middle that was not previously	*/
+/* unmapped due to alignment constraints.				*/
+void GC_unmap_gap(ptr_t start1, word bytes1, ptr_t start2, word bytes2)
+{
+    ptr_t start1_addr = GC_unmap_start(start1, bytes1);
+    ptr_t end1_addr = GC_unmap_end(start1, bytes1);
+    ptr_t start2_addr = GC_unmap_start(start2, bytes2);
+    ptr_t end2_addr = GC_unmap_end(start2, bytes2);
+    ptr_t start_addr = end1_addr;
+    ptr_t end_addr = start2_addr;
+    word len;
+    GC_ASSERT(start1 + bytes1 == start2);
+    if (0 == start1_addr) start_addr = GC_unmap_start(start1, bytes1 + bytes2);
+    if (0 == start2_addr) end_addr = GC_unmap_end(start1, bytes1 + bytes2);
+    if (0 == start_addr) return;
+    len = end_addr - start_addr;
+    if (len != 0 && munmap(start_addr, len) != 0) ABORT("munmap failed");
+    GC_unmapped_bytes += len;
+}
+
+#endif /* USE_MUNMAP */
+
+/* Routine for pushing any additional roots.  In THREADS 	*/
+/* environment, this is also responsible for marking from 	*/
+/* thread stacks.  In the SRC_M3 case, it also handles		*/
+/* global variables.						*/
+#ifndef THREADS
+void (*GC_push_other_roots)() = 0;
+#else /* THREADS */
+
+# ifdef PCR
+PCR_ERes GC_push_thread_stack(PCR_Th_T *t, PCR_Any dummy)
+{
+    struct PCR_ThCtl_TInfoRep info;
+    PCR_ERes result;
+    
+    info.ti_stkLow = info.ti_stkHi = 0;
+    result = PCR_ThCtl_GetInfo(t, &info);
+    GC_push_all_stack((ptr_t)(info.ti_stkLow), (ptr_t)(info.ti_stkHi));
+    return(result);
+}
+
+/* Push the contents of an old object. We treat this as stack	*/
+/* data only becasue that makes it robust against mark stack	*/
+/* overflow.							*/
+PCR_ERes GC_push_old_obj(void *p, size_t size, PCR_Any data)
+{
+    GC_push_all_stack((ptr_t)p, (ptr_t)p + size);
+    return(PCR_ERes_okay);
+}
+
+
+void GC_default_push_other_roots()
+{
+    /* Traverse data allocated by previous memory managers.		*/
+	{
+	  extern struct PCR_MM_ProcsRep * GC_old_allocator;
+	  
+	  if ((*(GC_old_allocator->mmp_enumerate))(PCR_Bool_false,
+	  					   GC_push_old_obj, 0)
+	      != PCR_ERes_okay) {
+	      ABORT("Old object enumeration failed");
+	  }
+	}
+    /* Traverse all thread stacks. */
+	if (PCR_ERes_IsErr(
+                PCR_ThCtl_ApplyToAllOtherThreads(GC_push_thread_stack,0))
+              || PCR_ERes_IsErr(GC_push_thread_stack(PCR_Th_CurrThread(), 0))) {
+              ABORT("Thread stack marking failed\n");
+	}
+}
+
+# endif /* PCR */
+
+# ifdef SRC_M3
+
+# ifdef ALL_INTERIOR_POINTERS
+    --> misconfigured
+# endif
+
+
+extern void ThreadF__ProcessStacks();
+
+void GC_push_thread_stack(start, stop)
+word start, stop;
+{
+   GC_push_all_stack((ptr_t)start, (ptr_t)stop + sizeof(word));
+}
+
+/* Push routine with M3 specific calling convention. */
+GC_m3_push_root(dummy1, p, dummy2, dummy3)
+word *p;
+ptr_t dummy1, dummy2;
+int dummy3;
+{
+    word q = *p;
+    
+    if ((ptr_t)(q) >= GC_least_plausible_heap_addr
+	 && (ptr_t)(q) < GC_greatest_plausible_heap_addr) {
+	 GC_push_one_checked(q,FALSE);
+    }
+}
+
+/* M3 set equivalent to RTHeap.TracedRefTypes */
+typedef struct { int elts[1]; }  RefTypeSet;
+RefTypeSet GC_TracedRefTypes = {{0x1}};
+
+/* From finalize.c */
+extern void GC_push_finalizer_structures();
+
+/* From stubborn.c: */
+# ifdef STUBBORN_ALLOC
+    extern GC_PTR * GC_changing_list_start;
+# endif
+
+
+void GC_default_push_other_roots()
+{
+    /* Use the M3 provided routine for finding static roots.	*/
+    /* This is a bit dubious, since it presumes no C roots.	*/
+    /* We handle the collector roots explicitly.		*/
+       {
+# 	 ifdef STUBBORN_ALLOC
+           GC_push_one(GC_changing_list_start);
+#	 endif
+      	 GC_push_finalizer_structures();
+      	 RTMain__GlobalMapProc(GC_m3_push_root, 0, GC_TracedRefTypes);
+       }
+	if (GC_words_allocd > 0) {
+	    ThreadF__ProcessStacks(GC_push_thread_stack);
+	}
+	/* Otherwise this isn't absolutely necessary, and we have	*/
+	/* startup ordering problems.					*/
+}
+
+# endif /* SRC_M3 */
+
+# if defined(SOLARIS_THREADS) || defined(WIN32_THREADS) \
+     || defined(IRIX_THREADS) || defined(LINUX_THREADS) \
+     || defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
+
+extern void GC_push_all_stacks();
+
+void GC_default_push_other_roots()
+{
+    GC_push_all_stacks();
+}
+
+# endif /* SOLARIS_THREADS || ... */
+
+void (*GC_push_other_roots)() = GC_default_push_other_roots;
+
+#endif
+
+/*
+ * Routines for accessing dirty  bits on virtual pages.
+ * We plan to eventaually implement four strategies for doing so:
+ * DEFAULT_VDB:	A simple dummy implementation that treats every page
+ *		as possibly dirty.  This makes incremental collection
+ *		useless, but the implementation is still correct.
+ * PCR_VDB:	Use PPCRs virtual dirty bit facility.
+ * PROC_VDB:	Use the /proc facility for reading dirty bits.  Only
+ *		works under some SVR4 variants.  Even then, it may be
+ *		too slow to be entirely satisfactory.  Requires reading
+ *		dirty bits for entire address space.  Implementations tend
+ *		to assume that the client is a (slow) debugger.
+ * MPROTECT_VDB:Protect pages and then catch the faults to keep track of
+ *		dirtied pages.  The implementation (and implementability)
+ *		is highly system dependent.  This usually fails when system
+ *		calls write to a protected page.  We prevent the read system
+ *		call from doing so.  It is the clients responsibility to
+ *		make sure that other system calls are similarly protected
+ *		or write only to the stack.
+ */
+ 
+GC_bool GC_dirty_maintained = FALSE;
+
+# ifdef DEFAULT_VDB
+
+/* All of the following assume the allocation lock is held, and	*/
+/* signals are disabled.					*/
+
+/* The client asserts that unallocated pages in the heap are never	*/
+/* written.								*/
+
+/* Initialize virtual dirty bit implementation.			*/
+void GC_dirty_init()
+{
+    GC_dirty_maintained = TRUE;
+}
+
+/* Retrieve system dirty bits for heap to a local buffer.	*/
+/* Restore the systems notion of which pages are dirty.		*/
+void GC_read_dirty()
+{}
+
+/* Is the HBLKSIZE sized page at h marked dirty in the local buffer?	*/
+/* If the actual page size is different, this returns TRUE if any	*/
+/* of the pages overlapping h are dirty.  This routine may err on the	*/
+/* side of labelling pages as dirty (and this implementation does).	*/
+/*ARGSUSED*/
+GC_bool GC_page_was_dirty(h)
+struct hblk *h;
+{
+    return(TRUE);
+}
+
+/*
+ * The following two routines are typically less crucial.  They matter
+ * most with large dynamic libraries, or if we can't accurately identify
+ * stacks, e.g. under Solaris 2.X.  Otherwise the following default
+ * versions are adequate.
+ */
+ 
+/* Could any valid GC heap pointer ever have been written to this page?	*/
+/*ARGSUSED*/
+GC_bool GC_page_was_ever_dirty(h)
+struct hblk *h;
+{
+    return(TRUE);
+}
+
+/* Reset the n pages starting at h to "was never dirty" status.	*/
+void GC_is_fresh(h, n)
+struct hblk *h;
+word n;
+{
+}
+
+/* A call hints that h is about to be written.	*/
+/* May speed up some dirty bit implementations.	*/
+/*ARGSUSED*/
+void GC_write_hint(h)
+struct hblk *h;
+{
+}
+
+# endif /* DEFAULT_VDB */
+
+
+# ifdef MPROTECT_VDB
+
+/*
+ * See DEFAULT_VDB for interface descriptions.
+ */
+
+/*
+ * This implementation maintains dirty bits itself by catching write
+ * faults and keeping track of them.  We assume nobody else catches
+ * SIGBUS or SIGSEGV.  We assume no write faults occur in system calls
+ * except as a result of a read system call.  This means clients must
+ * either ensure that system calls do not touch the heap, or must
+ * provide their own wrappers analogous to the one for read.
+ * We assume the page size is a multiple of HBLKSIZE.
+ * This implementation is currently SunOS 4.X and IRIX 5.X specific, though we
+ * tried to use portable code where easily possible.  It is known
+ * not to work under a number of other systems.
+ */
+
+# ifndef MSWIN32
+
+#   include <sys/mman.h>
+#   include <signal.h>
+#   include <sys/syscall.h>
+
+#   define PROTECT(addr, len) \
+    	  if (mprotect((caddr_t)(addr), (size_t)(len), \
+    	      	       PROT_READ | OPT_PROT_EXEC) < 0) { \
+    	    ABORT("mprotect failed"); \
+    	  }
+#   define UNPROTECT(addr, len) \
+    	  if (mprotect((caddr_t)(addr), (size_t)(len), \
+    	  	       PROT_WRITE | PROT_READ | OPT_PROT_EXEC ) < 0) { \
+    	    ABORT("un-mprotect failed"); \
+    	  }
+    	  
+# else
+
+#   include <signal.h>
+
+    static DWORD protect_junk;
+#   define PROTECT(addr, len) \
+	  if (!VirtualProtect((addr), (len), PAGE_EXECUTE_READ, \
+	  		      &protect_junk)) { \
+	    DWORD last_error = GetLastError(); \
+	    GC_printf1("Last error code: %lx\n", last_error); \
+	    ABORT("VirtualProtect failed"); \
+	  }
+#   define UNPROTECT(addr, len) \
+	  if (!VirtualProtect((addr), (len), PAGE_EXECUTE_READWRITE, \
+	  		      &protect_junk)) { \
+	    ABORT("un-VirtualProtect failed"); \
+	  }
+	  
+# endif
+
+#if defined(SUNOS4) || defined(FREEBSD)
+    typedef void (* SIG_PF)();
+#endif
+#if defined(SUNOS5SIGS) || defined(OSF1) || defined(LINUX)
+# ifdef __STDC__
+    typedef void (* SIG_PF)(int);
+# else
+    typedef void (* SIG_PF)();
+# endif
+#endif
+#if defined(MSWIN32)
+    typedef LPTOP_LEVEL_EXCEPTION_FILTER SIG_PF;
+#   undef SIG_DFL
+#   define SIG_DFL (LPTOP_LEVEL_EXCEPTION_FILTER) (-1)
+#endif
+
+#if defined(IRIX5) || defined(OSF1)
+    typedef void (* REAL_SIG_PF)(int, int, struct sigcontext *);
+#endif
+#if defined(SUNOS5SIGS)
+# ifdef HPUX
+#   define SIGINFO __siginfo
+# else
+#   define SIGINFO siginfo
+# endif
+# ifdef __STDC__
+    typedef void (* REAL_SIG_PF)(int, struct SIGINFO *, void *);
+# else
+    typedef void (* REAL_SIG_PF)();
+# endif
+#endif
+#if defined(LINUX)
+#   include <linux/version.h>
+#   if (LINUX_VERSION_CODE >= 0x20100) && !defined(M68K) || defined(ALPHA) || defined(IA64)
+      typedef struct sigcontext s_c;
+#   else
+      typedef struct sigcontext_struct s_c;
+#   endif
+#   if defined(ALPHA) || defined(M68K)
+      typedef void (* REAL_SIG_PF)(int, int, s_c *);
+#   else
+#     if defined(IA64)
+        typedef void (* REAL_SIG_PF)(int, siginfo_t *, s_c *);
+#     else
+        typedef void (* REAL_SIG_PF)(int, s_c);
+#     endif
+#   endif
+#   ifdef ALPHA
+    /* Retrieve fault address from sigcontext structure by decoding	*/
+    /* instruction.							*/
+    char * get_fault_addr(s_c *sc) {
+        unsigned instr;
+	word faultaddr;
+
+	instr = *((unsigned *)(sc->sc_pc));
+	faultaddr = sc->sc_regs[(instr >> 16) & 0x1f];
+	faultaddr += (word) (((int)instr << 16) >> 16);
+	return (char *)faultaddr;
+    }
+#   endif /* !ALPHA */
+# endif
+
+SIG_PF GC_old_bus_handler;
+SIG_PF GC_old_segv_handler;	/* Also old MSWIN32 ACCESS_VIOLATION filter */
+
+/*ARGSUSED*/
+# if defined (SUNOS4) || defined(FREEBSD)
+    void GC_write_fault_handler(sig, code, scp, addr)
+    int sig, code;
+    struct sigcontext *scp;
+    char * addr;
+#   ifdef SUNOS4
+#     define SIG_OK (sig == SIGSEGV || sig == SIGBUS)
+#     define CODE_OK (FC_CODE(code) == FC_PROT \
+              	    || (FC_CODE(code) == FC_OBJERR \
+              	       && FC_ERRNO(code) == FC_PROT))
+#   endif
+#   ifdef FREEBSD
+#     define SIG_OK (sig == SIGBUS)
+#     define CODE_OK (code == BUS_PAGE_FAULT)
+#   endif
+# endif
+# if defined(IRIX5) || defined(OSF1)
+#   include <errno.h>
+    void GC_write_fault_handler(int sig, int code, struct sigcontext *scp)
+#   define SIG_OK (sig == SIGSEGV)
+#   ifdef OSF1
+#     define CODE_OK (code == 2 /* experimentally determined */)
+#   endif
+#   ifdef IRIX5
+#     define CODE_OK (code == EACCES)
+#   endif
+# endif
+# if defined(LINUX)
+#   if defined(ALPHA) || defined(M68K)
+      void GC_write_fault_handler(int sig, int code, s_c * sc)
+#   else
+#     if defined(IA64)
+        void GC_write_fault_handler(int sig, siginfo_t * si, s_c * scp)
+#     else
+        void GC_write_fault_handler(int sig, s_c sc)
+#     endif
+#   endif
+#   define SIG_OK (sig == SIGSEGV)
+#   define CODE_OK TRUE
+	/* Empirically c.trapno == 14, on IA32, but is that useful?     */
+	/* Should probably consider alignment issues on other 		*/
+	/* architectures.						*/
+# endif
+# if defined(SUNOS5SIGS)
+#  ifdef __STDC__
+    void GC_write_fault_handler(int sig, struct SIGINFO *scp, void * context)
+#  else
+    void GC_write_fault_handler(sig, scp, context)
+    int sig;
+    struct SIGINFO *scp;
+    void * context;
+#  endif
+#   ifdef HPUX
+#     define SIG_OK (sig == SIGSEGV || sig == SIGBUS)
+#     define CODE_OK (scp -> si_code == SEGV_ACCERR) \
+		     || (scp -> si_code == BUS_ADRERR) \
+		     || (scp -> si_code == BUS_UNKNOWN) \
+		     || (scp -> si_code == SEGV_UNKNOWN) \
+		     || (scp -> si_code == BUS_OBJERR)
+#   else
+#     define SIG_OK (sig == SIGSEGV)
+#     define CODE_OK (scp -> si_code == SEGV_ACCERR)
+#   endif
+# endif
+# if defined(MSWIN32)
+    LONG WINAPI GC_write_fault_handler(struct _EXCEPTION_POINTERS *exc_info)
+#   define SIG_OK (exc_info -> ExceptionRecord -> ExceptionCode == \
+			EXCEPTION_ACCESS_VIOLATION)
+#   define CODE_OK (exc_info -> ExceptionRecord -> ExceptionInformation[0] == 1)
+			/* Write fault */
+# endif
+{
+    register unsigned i;
+#   ifdef IRIX5
+	char * addr = (char *) (size_t) (scp -> sc_badvaddr);
+#   endif
+#   if defined(OSF1) && defined(ALPHA)
+	char * addr = (char *) (scp -> sc_traparg_a0);
+#   endif
+#   ifdef SUNOS5SIGS
+	char * addr = (char *) (scp -> si_addr);
+#   endif
+#   ifdef LINUX
+#     ifdef I386
+	char * addr = (char *) (sc.cr2);
+#     else
+#	if defined(M68K)
+          char * addr = NULL;
+
+	  struct sigcontext *scp = (struct sigcontext *)(&sc);
+
+	  int format = (scp->sc_formatvec >> 12) & 0xf;
+	  unsigned long *framedata = (unsigned long *)(scp + 1); 
+	  unsigned long ea;
+
+	  if (format == 0xa || format == 0xb) {
+	  	/* 68020/030 */
+	  	ea = framedata[2];
+	  } else if (format == 7) {
+	  	/* 68040 */
+	  	ea = framedata[3];
+	  } else if (format == 4) {
+	  	/* 68060 */
+	  	ea = framedata[0];
+	  	if (framedata[1] & 0x08000000) {
+	  		/* correct addr on misaligned access */
+	  		ea = (ea+4095)&(~4095);
+	  	}
+	  }	
+	  addr = (char *)ea;
+#	else
+#	  ifdef ALPHA
+            char * addr = get_fault_addr(sc);
+#	  else
+#	    ifdef IA64
+	      char * addr = si -> si_addr;
+	      /* I believe this is claimed to work on all platforms for	*/
+	      /* Linux 2.3.47 and later.  Hopefully we don't have to	*/
+	      /* worry about earlier kernels on IA64.			*/
+#	    else
+#             if defined(POWERPC)
+                char * addr = (char *) (sc.regs->dar);
+#	      else
+		--> architecture not supported
+#	      endif
+#	    endif
+#	  endif
+#	endif
+#     endif
+#   endif
+#   if defined(MSWIN32)
+	char * addr = (char *) (exc_info -> ExceptionRecord
+				-> ExceptionInformation[1]);
+#	define sig SIGSEGV
+#   endif
+    
+    if (SIG_OK && CODE_OK) {
+        register struct hblk * h =
+        		(struct hblk *)((word)addr & ~(GC_page_size-1));
+        GC_bool in_allocd_block;
+        
+#	ifdef SUNOS5SIGS
+	    /* Address is only within the correct physical page.	*/
+	    in_allocd_block = FALSE;
+            for (i = 0; i < divHBLKSZ(GC_page_size); i++) {
+              if (HDR(h+i) != 0) {
+                in_allocd_block = TRUE;
+              }
+            }
+#	else
+	    in_allocd_block = (HDR(addr) != 0);
+#	endif
+        if (!in_allocd_block) {
+	    /* Heap blocks now begin and end on page boundaries */
+            SIG_PF old_handler;
+            
+            if (sig == SIGSEGV) {
+            	old_handler = GC_old_segv_handler;
+            } else {
+                old_handler = GC_old_bus_handler;
+            }
+            if (old_handler == SIG_DFL) {
+#		ifndef MSWIN32
+		    GC_err_printf1("Segfault at 0x%lx\n", addr);
+                    ABORT("Unexpected bus error or segmentation fault");
+#		else
+		    return(EXCEPTION_CONTINUE_SEARCH);
+#		endif
+            } else {
+#		if defined (SUNOS4) || defined(FREEBSD)
+		    (*old_handler) (sig, code, scp, addr);
+		    return;
+#		endif
+#		if defined (SUNOS5SIGS)
+		    (*(REAL_SIG_PF)old_handler) (sig, scp, context);
+		    return;
+#		endif
+#		if defined (LINUX)
+#		    if defined(ALPHA) || defined(M68K)
+		        (*(REAL_SIG_PF)old_handler) (sig, code, sc);
+#		    else 
+#		      if defined(IA64)
+		        (*(REAL_SIG_PF)old_handler) (sig, si, scp);
+#		      else
+		        (*(REAL_SIG_PF)old_handler) (sig, sc);
+#		      endif
+#		    endif
+		    return;
+#		endif
+#		if defined (IRIX5) || defined(OSF1)
+		    (*(REAL_SIG_PF)old_handler) (sig, code, scp);
+		    return;
+#		endif
+#		ifdef MSWIN32
+		    return((*old_handler)(exc_info));
+#		endif
+            }
+        }
+        for (i = 0; i < divHBLKSZ(GC_page_size); i++) {
+            register int index = PHT_HASH(h+i);
+            
+            set_pht_entry_from_index(GC_dirty_pages, index);
+        }
+        UNPROTECT(h, GC_page_size);
+#	if defined(OSF1) || defined(LINUX)
+	    /* These reset the signal handler each time by default. */
+	    signal(SIGSEGV, (SIG_PF) GC_write_fault_handler);
+#	endif
+    	/* The write may not take place before dirty bits are read.	*/
+    	/* But then we'll fault again ...				*/
+#	ifdef MSWIN32
+	    return(EXCEPTION_CONTINUE_EXECUTION);
+#	else
+	    return;
+#	endif
+    }
+#ifdef MSWIN32
+    return EXCEPTION_CONTINUE_SEARCH;
+#else
+    GC_err_printf1("Segfault at 0x%lx\n", addr);
+    ABORT("Unexpected bus error or segmentation fault");
+#endif
+}
+
+/*
+ * We hold the allocation lock.  We expect block h to be written
+ * shortly.
+ */
+void GC_write_hint(h)
+struct hblk *h;
+{
+    register struct hblk * h_trunc;
+    register unsigned i;
+    register GC_bool found_clean;
+    
+    if (!GC_dirty_maintained) return;
+    h_trunc = (struct hblk *)((word)h & ~(GC_page_size-1));
+    found_clean = FALSE;
+    for (i = 0; i < divHBLKSZ(GC_page_size); i++) {
+        register int index = PHT_HASH(h_trunc+i);
+            
+        if (!get_pht_entry_from_index(GC_dirty_pages, index)) {
+            found_clean = TRUE;
+            set_pht_entry_from_index(GC_dirty_pages, index);
+        }
+    }
+    if (found_clean) {
+    	UNPROTECT(h_trunc, GC_page_size);
+    }
+}
+
+void GC_dirty_init()
+{
+#if defined(SUNOS5SIGS) || defined(IRIX5) /* || defined(OSF1) */
+    struct sigaction	act, oldact;
+#   ifdef IRIX5
+    	act.sa_flags	= SA_RESTART;
+        act.sa_handler  = GC_write_fault_handler;
+#   else
+    	act.sa_flags	= SA_RESTART | SA_SIGINFO;
+        act.sa_sigaction = GC_write_fault_handler;
+#   endif
+    (void)sigemptyset(&act.sa_mask); 
+#endif
+#   ifdef PRINTSTATS
+	GC_printf0("Inititalizing mprotect virtual dirty bit implementation\n");
+#   endif
+    GC_dirty_maintained = TRUE;
+    if (GC_page_size % HBLKSIZE != 0) {
+        GC_err_printf0("Page size not multiple of HBLKSIZE\n");
+        ABORT("Page size not multiple of HBLKSIZE");
+    }
+#   if defined(SUNOS4) || defined(FREEBSD)
+      GC_old_bus_handler = signal(SIGBUS, GC_write_fault_handler);
+      if (GC_old_bus_handler == SIG_IGN) {
+        GC_err_printf0("Previously ignored bus error!?");
+        GC_old_bus_handler = SIG_DFL;
+      }
+      if (GC_old_bus_handler != SIG_DFL) {
+#	ifdef PRINTSTATS
+          GC_err_printf0("Replaced other SIGBUS handler\n");
+#	endif
+      }
+#   endif
+#   if defined(OSF1) || defined(SUNOS4) || defined(LINUX)
+      GC_old_segv_handler = signal(SIGSEGV, (SIG_PF)GC_write_fault_handler);
+      if (GC_old_segv_handler == SIG_IGN) {
+        GC_err_printf0("Previously ignored segmentation violation!?");
+        GC_old_segv_handler = SIG_DFL;
+      }
+      if (GC_old_segv_handler != SIG_DFL) {
+#	ifdef PRINTSTATS
+          GC_err_printf0("Replaced other SIGSEGV handler\n");
+#	endif
+      }
+#   endif
+#   if defined(SUNOS5SIGS) || defined(IRIX5)
+#     if defined(IRIX_THREADS) || defined(IRIX_JDK_THREADS)
+      	sigaction(SIGSEGV, 0, &oldact);
+      	sigaction(SIGSEGV, &act, 0);
+#     else
+      	sigaction(SIGSEGV, &act, &oldact);
+#     endif
+#     if defined(_sigargs)
+	/* This is Irix 5.x, not 6.x.  Irix 5.x does not have	*/
+	/* sa_sigaction.					*/
+	GC_old_segv_handler = oldact.sa_handler;
+#     else /* Irix 6.x or SUNOS5SIGS */
+        if (oldact.sa_flags & SA_SIGINFO) {
+          GC_old_segv_handler = (SIG_PF)(oldact.sa_sigaction);
+        } else {
+          GC_old_segv_handler = oldact.sa_handler;
+        }
+#     endif
+      if (GC_old_segv_handler == SIG_IGN) {
+	     GC_err_printf0("Previously ignored segmentation violation!?");
+	     GC_old_segv_handler = SIG_DFL;
+      }
+      if (GC_old_segv_handler != SIG_DFL) {
+#       ifdef PRINTSTATS
+	  GC_err_printf0("Replaced other SIGSEGV handler\n");
+#       endif
+      }
+#     ifdef HPUX
+      	  sigaction(SIGBUS, &act, &oldact);
+          GC_old_bus_handler = oldact.sa_handler;
+          if (GC_old_segv_handler != SIG_DFL) {
+#           ifdef PRINTSTATS
+	      GC_err_printf0("Replaced other SIGBUS handler\n");
+#           endif
+          }
+#     endif
+#    endif
+#   if defined(MSWIN32)
+      GC_old_segv_handler = SetUnhandledExceptionFilter(GC_write_fault_handler);
+      if (GC_old_segv_handler != NULL) {
+#	ifdef PRINTSTATS
+          GC_err_printf0("Replaced other UnhandledExceptionFilter\n");
+#	endif
+      } else {
+          GC_old_segv_handler = SIG_DFL;
+      }
+#   endif
+}
+
+
+
+void GC_protect_heap()
+{
+    ptr_t start;
+    word len;
+    unsigned i;
+    
+    for (i = 0; i < GC_n_heap_sects; i++) {
+        start = GC_heap_sects[i].hs_start;
+        len = GC_heap_sects[i].hs_bytes;
+        PROTECT(start, len);
+    }
+}
+
+/* We assume that either the world is stopped or its OK to lose dirty	*/
+/* bits while this is happenning (as in GC_enable_incremental).		*/
+void GC_read_dirty()
+{
+    BCOPY((word *)GC_dirty_pages, GC_grungy_pages,
+          (sizeof GC_dirty_pages));
+    BZERO((word *)GC_dirty_pages, (sizeof GC_dirty_pages));
+    GC_protect_heap();
+}
+
+GC_bool GC_page_was_dirty(h)
+struct hblk * h;
+{
+    register word index = PHT_HASH(h);
+    
+    return(HDR(h) == 0 || get_pht_entry_from_index(GC_grungy_pages, index));
+}
+
+/*
+ * Acquiring the allocation lock here is dangerous, since this
+ * can be called from within GC_call_with_alloc_lock, and the cord
+ * package does so.  On systems that allow nested lock acquisition, this
+ * happens to work.
+ * On other systems, SET_LOCK_HOLDER and friends must be suitably defined.
+ */
+ 
+void GC_begin_syscall()
+{
+    if (!I_HOLD_LOCK()) LOCK();
+}
+
+void GC_end_syscall()
+{
+    if (!I_HOLD_LOCK()) UNLOCK();
+}
+
+void GC_unprotect_range(addr, len)
+ptr_t addr;
+word len;
+{
+    struct hblk * start_block;
+    struct hblk * end_block;
+    register struct hblk *h;
+    ptr_t obj_start;
+    
+    if (!GC_incremental) return;
+    obj_start = GC_base(addr);
+    if (obj_start == 0) return;
+    if (GC_base(addr + len - 1) != obj_start) {
+        ABORT("GC_unprotect_range(range bigger than object)");
+    }
+    start_block = (struct hblk *)((word)addr & ~(GC_page_size - 1));
+    end_block = (struct hblk *)((word)(addr + len - 1) & ~(GC_page_size - 1));
+    end_block += GC_page_size/HBLKSIZE - 1;
+    for (h = start_block; h <= end_block; h++) {
+        register word index = PHT_HASH(h);
+        
+        set_pht_entry_from_index(GC_dirty_pages, index);
+    }
+    UNPROTECT(start_block,
+    	      ((ptr_t)end_block - (ptr_t)start_block) + HBLKSIZE);
+}
+
+#if !defined(MSWIN32) && !defined(LINUX_THREADS)
+/* Replacement for UNIX system call.	 */
+/* Other calls that write to the heap	 */
+/* should be handled similarly.		 */
+# if defined(__STDC__) && !defined(SUNOS4)
+#   include <unistd.h>
+#   include <sys/uio.h>
+    ssize_t read(int fd, void *buf, size_t nbyte)
+# else
+#   ifndef LINT
+      int read(fd, buf, nbyte)
+#   else
+      int GC_read(fd, buf, nbyte)
+#   endif
+    int fd;
+    char *buf;
+    int nbyte;
+# endif
+{
+    int result;
+    
+    GC_begin_syscall();
+    GC_unprotect_range(buf, (word)nbyte);
+#   if defined(IRIX5) || defined(LINUX_THREADS)
+	/* Indirect system call may not always be easily available.	*/
+	/* We could call _read, but that would interfere with the	*/
+	/* libpthread interception of read.				*/
+	/* On Linux, we have to be careful with the linuxthreads	*/
+	/* read interception.						*/
+	{
+	    struct iovec iov;
+
+	    iov.iov_base = buf;
+	    iov.iov_len = nbyte;
+	    result = readv(fd, &iov, 1);
+	}
+#   else
+    	result = syscall(SYS_read, fd, buf, nbyte);
+#   endif
+    GC_end_syscall();
+    return(result);
+}
+#endif /* !MSWIN32 && !LINUX */
+
+#ifdef USE_LD_WRAP
+    /* We use the GNU ld call wrapping facility.			*/
+    /* This requires that the linker be invoked with "--wrap read".	*/
+    /* This can be done by passing -Wl,"--wrap read" to gcc.		*/
+    /* I'm not sure that this actually wraps whatever version of read	*/
+    /* is called by stdio.  That code also mentions __read.		*/
+#   include <unistd.h>
+    ssize_t __wrap_read(int fd, void *buf, size_t nbyte)
+    {
+ 	int result;
+
+	GC_begin_syscall();
+    	GC_unprotect_range(buf, (word)nbyte);
+	result = __real_read(fd, buf, nbyte);
+	GC_end_syscall();
+	return(result);
+    }
+
+    /* We should probably also do this for __read, or whatever stdio	*/
+    /* actually calls.							*/
+#endif
+
+/*ARGSUSED*/
+GC_bool GC_page_was_ever_dirty(h)
+struct hblk *h;
+{
+    return(TRUE);
+}
+
+/* Reset the n pages starting at h to "was never dirty" status.	*/
+/*ARGSUSED*/
+void GC_is_fresh(h, n)
+struct hblk *h;
+word n;
+{
+}
+
+# endif /* MPROTECT_VDB */
+
+# ifdef PROC_VDB
+
+/*
+ * See DEFAULT_VDB for interface descriptions.
+ */
+ 
+/*
+ * This implementaion assumes a Solaris 2.X like /proc pseudo-file-system
+ * from which we can read page modified bits.  This facility is far from
+ * optimal (e.g. we would like to get the info for only some of the
+ * address space), but it avoids intercepting system calls.
+ */
+
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/signal.h>
+#include <sys/fault.h>
+#include <sys/syscall.h>
+#include <sys/procfs.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+
+#define INITIAL_BUF_SZ 4096
+word GC_proc_buf_size = INITIAL_BUF_SZ;
+char *GC_proc_buf;
+
+#ifdef SOLARIS_THREADS
+/* We don't have exact sp values for threads.  So we count on	*/
+/* occasionally declaring stack pages to be fresh.  Thus we 	*/
+/* need a real implementation of GC_is_fresh.  We can't clear	*/
+/* entries in GC_written_pages, since that would declare all	*/
+/* pages with the given hash address to be fresh.		*/
+#   define MAX_FRESH_PAGES 8*1024	/* Must be power of 2 */
+    struct hblk ** GC_fresh_pages;	/* A direct mapped cache.	*/
+    					/* Collisions are dropped.	*/
+
+#   define FRESH_PAGE_SLOT(h) (divHBLKSZ((word)(h)) & (MAX_FRESH_PAGES-1))
+#   define ADD_FRESH_PAGE(h) \
+	GC_fresh_pages[FRESH_PAGE_SLOT(h)] = (h)
+#   define PAGE_IS_FRESH(h) \
+	(GC_fresh_pages[FRESH_PAGE_SLOT(h)] == (h) && (h) != 0)
+#endif
+
+/* Add all pages in pht2 to pht1 */
+void GC_or_pages(pht1, pht2)
+page_hash_table pht1, pht2;
+{
+    register int i;
+    
+    for (i = 0; i < PHT_SIZE; i++) pht1[i] |= pht2[i];
+}
+
+int GC_proc_fd;
+
+void GC_dirty_init()
+{
+    int fd;
+    char buf[30];
+
+    GC_dirty_maintained = TRUE;
+    if (GC_words_allocd != 0 || GC_words_allocd_before_gc != 0) {
+    	register int i;
+    
+        for (i = 0; i < PHT_SIZE; i++) GC_written_pages[i] = (word)(-1);
+#       ifdef PRINTSTATS
+	    GC_printf1("Allocated words:%lu:all pages may have been written\n",
+	    	       (unsigned long)
+	    	      		(GC_words_allocd + GC_words_allocd_before_gc));
+#	endif       
+    }
+    sprintf(buf, "/proc/%d", getpid());
+    fd = open(buf, O_RDONLY);
+    if (fd < 0) {
+    	ABORT("/proc open failed");
+    }
+    GC_proc_fd = syscall(SYS_ioctl, fd, PIOCOPENPD, 0);
+    close(fd);
+    if (GC_proc_fd < 0) {
+    	ABORT("/proc ioctl failed");
+    }
+    GC_proc_buf = GC_scratch_alloc(GC_proc_buf_size);
+#   ifdef SOLARIS_THREADS
+	GC_fresh_pages = (struct hblk **)
+	  GC_scratch_alloc(MAX_FRESH_PAGES * sizeof (struct hblk *));
+	if (GC_fresh_pages == 0) {
+	    GC_err_printf0("No space for fresh pages\n");
+	    EXIT();
+	}
+	BZERO(GC_fresh_pages, MAX_FRESH_PAGES * sizeof (struct hblk *));
+#   endif
+}
+
+/* Ignore write hints. They don't help us here.	*/
+/*ARGSUSED*/
+void GC_write_hint(h)
+struct hblk *h;
+{
+}
+
+#ifdef SOLARIS_THREADS
+#   define READ(fd,buf,nbytes) syscall(SYS_read, fd, buf, nbytes)
+#else
+#   define READ(fd,buf,nbytes) read(fd, buf, nbytes)
+#endif
+
+void GC_read_dirty()
+{
+    unsigned long ps, np;
+    int nmaps;
+    ptr_t vaddr;
+    struct prasmap * map;
+    char * bufp;
+    ptr_t current_addr, limit;
+    int i;
+int dummy;
+
+    BZERO(GC_grungy_pages, (sizeof GC_grungy_pages));
+    
+    bufp = GC_proc_buf;
+    if (READ(GC_proc_fd, bufp, GC_proc_buf_size) <= 0) {
+#	ifdef PRINTSTATS
+            GC_printf1("/proc read failed: GC_proc_buf_size = %lu\n",
+            	       GC_proc_buf_size);
+#	endif       
+        {
+            /* Retry with larger buffer. */
+            word new_size = 2 * GC_proc_buf_size;
+            char * new_buf = GC_scratch_alloc(new_size);
+            
+            if (new_buf != 0) {
+                GC_proc_buf = bufp = new_buf;
+                GC_proc_buf_size = new_size;
+            }
+            if (syscall(SYS_read, GC_proc_fd, bufp, GC_proc_buf_size) <= 0) {
+                WARN("Insufficient space for /proc read\n", 0);
+                /* Punt:	*/
+        	memset(GC_grungy_pages, 0xff, sizeof (page_hash_table));
+		memset(GC_written_pages, 0xff, sizeof(page_hash_table));
+#		ifdef SOLARIS_THREADS
+		    BZERO(GC_fresh_pages,
+		    	  MAX_FRESH_PAGES * sizeof (struct hblk *)); 
+#		endif
+		return;
+            }
+        }
+    }
+    /* Copy dirty bits into GC_grungy_pages */
+    	nmaps = ((struct prpageheader *)bufp) -> pr_nmap;
+	/* printf( "nmaps = %d, PG_REFERENCED = %d, PG_MODIFIED = %d\n",
+		     nmaps, PG_REFERENCED, PG_MODIFIED); */
+	bufp = bufp + sizeof(struct prpageheader);
+	for (i = 0; i < nmaps; i++) {
+	    map = (struct prasmap *)bufp;
+	    vaddr = (ptr_t)(map -> pr_vaddr);
+	    ps = map -> pr_pagesize;
+	    np = map -> pr_npage;
+	    /* printf("vaddr = 0x%X, ps = 0x%X, np = 0x%X\n", vaddr, ps, np); */
+	    limit = vaddr + ps * np;
+	    bufp += sizeof (struct prasmap);
+	    for (current_addr = vaddr;
+	         current_addr < limit; current_addr += ps){
+	        if ((*bufp++) & PG_MODIFIED) {
+	            register struct hblk * h = (struct hblk *) current_addr;
+	            
+	            while ((ptr_t)h < current_addr + ps) {
+	                register word index = PHT_HASH(h);
+	                
+	                set_pht_entry_from_index(GC_grungy_pages, index);
+#			ifdef SOLARIS_THREADS
+			  {
+			    register int slot = FRESH_PAGE_SLOT(h);
+			    
+			    if (GC_fresh_pages[slot] == h) {
+			        GC_fresh_pages[slot] = 0;
+			    }
+			  }
+#			endif
+	                h++;
+	            }
+	        }
+	    }
+	    bufp += sizeof(long) - 1;
+	    bufp = (char *)((unsigned long)bufp & ~(sizeof(long)-1));
+	}
+    /* Update GC_written_pages. */
+        GC_or_pages(GC_written_pages, GC_grungy_pages);
+#   ifdef SOLARIS_THREADS
+      /* Make sure that old stacks are considered completely clean	*/
+      /* unless written again.						*/
+	GC_old_stacks_are_fresh();
+#   endif
+}
+
+#undef READ
+
+GC_bool GC_page_was_dirty(h)
+struct hblk *h;
+{
+    register word index = PHT_HASH(h);
+    register GC_bool result;
+    
+    result = get_pht_entry_from_index(GC_grungy_pages, index);
+#   ifdef SOLARIS_THREADS
+	if (result && PAGE_IS_FRESH(h)) result = FALSE;
+	/* This happens only if page was declared fresh since	*/
+	/* the read_dirty call, e.g. because it's in an unused  */
+	/* thread stack.  It's OK to treat it as clean, in	*/
+	/* that case.  And it's consistent with 		*/
+	/* GC_page_was_ever_dirty.				*/
+#   endif
+    return(result);
+}
+
+GC_bool GC_page_was_ever_dirty(h)
+struct hblk *h;
+{
+    register word index = PHT_HASH(h);
+    register GC_bool result;
+    
+    result = get_pht_entry_from_index(GC_written_pages, index);
+#   ifdef SOLARIS_THREADS
+	if (result && PAGE_IS_FRESH(h)) result = FALSE;
+#   endif
+    return(result);
+}
+
+/* Caller holds allocation lock.	*/
+void GC_is_fresh(h, n)
+struct hblk *h;
+word n;
+{
+
+    register word index;
+    
+#   ifdef SOLARIS_THREADS
+      register word i;
+      
+      if (GC_fresh_pages != 0) {
+        for (i = 0; i < n; i++) {
+          ADD_FRESH_PAGE(h + i);
+        }
+      }
+#   endif
+}
+
+# endif /* PROC_VDB */
+
+
+# ifdef PCR_VDB
+
+# include "vd/PCR_VD.h"
+
+# define NPAGES (32*1024)	/* 128 MB */
+
+PCR_VD_DB  GC_grungy_bits[NPAGES];
+
+ptr_t GC_vd_base;	/* Address corresponding to GC_grungy_bits[0]	*/
+			/* HBLKSIZE aligned.				*/
+
+void GC_dirty_init()
+{
+    GC_dirty_maintained = TRUE;
+    /* For the time being, we assume the heap generally grows up */
+    GC_vd_base = GC_heap_sects[0].hs_start;
+    if (GC_vd_base == 0) {
+   	ABORT("Bad initial heap segment");
+    }
+    if (PCR_VD_Start(HBLKSIZE, GC_vd_base, NPAGES*HBLKSIZE)
+	!= PCR_ERes_okay) {
+	ABORT("dirty bit initialization failed");
+    }
+}
+
+void GC_read_dirty()
+{
+    /* lazily enable dirty bits on newly added heap sects */
+    {
+        static int onhs = 0;
+        int nhs = GC_n_heap_sects;
+        for( ; onhs < nhs; onhs++ ) {
+            PCR_VD_WriteProtectEnable(
+                    GC_heap_sects[onhs].hs_start,
+                    GC_heap_sects[onhs].hs_bytes );
+        }
+    }
+
+
+    if (PCR_VD_Clear(GC_vd_base, NPAGES*HBLKSIZE, GC_grungy_bits)
+        != PCR_ERes_okay) {
+	ABORT("dirty bit read failed");
+    }
+}
+
+GC_bool GC_page_was_dirty(h)
+struct hblk *h;
+{
+    if((ptr_t)h < GC_vd_base || (ptr_t)h >= GC_vd_base + NPAGES*HBLKSIZE) {
+	return(TRUE);
+    }
+    return(GC_grungy_bits[h - (struct hblk *)GC_vd_base] & PCR_VD_DB_dirtyBit);
+}
+
+/*ARGSUSED*/
+void GC_write_hint(h)
+struct hblk *h;
+{
+    PCR_VD_WriteProtectDisable(h, HBLKSIZE);
+    PCR_VD_WriteProtectEnable(h, HBLKSIZE);
+}
+
+# endif /* PCR_VDB */
+
+/*
+ * Call stack save code for debugging.
+ * Should probably be in mach_dep.c, but that requires reorganization.
+ */
+#if defined(SPARC) && !defined(LINUX)
+#   if defined(SUNOS4)
+#     include <machine/frame.h>
+#   else
+#     if defined (DRSNX)
+#	include <sys/sparc/frame.h>
+#     else
+#        if defined(OPENBSD)
+#          include <frame.h>
+#        else
+#          include <sys/frame.h>
+#        endif
+#     endif
+#   endif
+#   if NARGS > 6
+	--> We only know how to to get the first 6 arguments
+#   endif
+
+#ifdef SAVE_CALL_CHAIN
+/* Fill in the pc and argument information for up to NFRAMES of my	*/
+/* callers.  Ignore my frame and my callers frame.			*/
+
+#ifdef OPENBSD
+#  define FR_SAVFP fr_fp
+#  define FR_SAVPC fr_pc
+#else
+#  define FR_SAVFP fr_savfp
+#  define FR_SAVPC fr_savpc
+#endif
+
+void GC_save_callers (info) 
+struct callinfo info[NFRAMES];
+{
+  struct frame *frame;
+  struct frame *fp;
+  int nframes = 0;
+  word GC_save_regs_in_stack();
+
+  frame = (struct frame *) GC_save_regs_in_stack ();
+  
+  for (fp = frame -> FR_SAVFP; fp != 0 && nframes < NFRAMES;
+       fp = fp -> FR_SAVFP, nframes++) {
+      register int i;
+      
+      info[nframes].ci_pc = fp->FR_SAVPC;
+      for (i = 0; i < NARGS; i++) {
+	info[nframes].ci_arg[i] = ~(fp->fr_arg[i]);
+      }
+  }
+  if (nframes < NFRAMES) info[nframes].ci_pc = 0;
+}
+
+#endif /* SAVE_CALL_CHAIN */
+#endif /* SPARC */
+
+
+
diff --git a/src/gc/pc_excludes b/src/gc/pc_excludes
new file mode 100644
index 000000000..52da43110
--- /dev/null
+++ b/src/gc/pc_excludes
@@ -0,0 +1,15 @@
+solaris_threads.c
+pcr_interface.c
+real_malloc.c
+mips_mach_dep.s
+rs6000_mach_dep.s
+alpha_mach_dep.s
+sparc_mach_dep.s
+PCR-Makefile
+setjmp_t.c
+callprocs
+gc.man
+pc_excludes
+barrett_diagram
+include/gc_c++.h
+include/gc_inline.h
\ No newline at end of file
diff --git a/src/gc/pcr_interface.c b/src/gc/pcr_interface.c
new file mode 100644
index 000000000..4c9509337
--- /dev/null
+++ b/src/gc/pcr_interface.c
@@ -0,0 +1,173 @@
+/* 
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, February 7, 1996 11:09 am PST */
+# include "gc_priv.h"
+
+# ifdef PCR
+/*
+ * Note that POSIX PCR requires an ANSI C compiler.  Hence we are allowed
+ * to make the same assumption here.
+ * We wrap all of the allocator functions to avoid questions of
+ * compatibility between the prototyped and nonprototyped versions of the f
+ */
+# include "config/PCR_StdTypes.h"
+# include "mm/PCR_MM.h"
+# include <errno.h>
+
+# define MY_MAGIC 17L
+# define MY_DEBUGMAGIC 42L
+
+void * GC_AllocProc(size_t size, PCR_Bool ptrFree, PCR_Bool clear )
+{
+    if (ptrFree) {
+        void * result = (void *)GC_malloc_atomic(size);
+        if (clear && result != 0) BZERO(result, size);
+        return(result);
+    } else {
+        return((void *)GC_malloc(size));
+    }
+}
+
+void * GC_DebugAllocProc(size_t size, PCR_Bool ptrFree, PCR_Bool clear )
+{
+    if (ptrFree) {
+        void * result = (void *)GC_debug_malloc_atomic(size, __FILE__,
+        						     __LINE__);
+        if (clear && result != 0) BZERO(result, size);
+        return(result);
+    } else {
+        return((void *)GC_debug_malloc(size, __FILE__, __LINE__));
+    }
+}
+
+# define GC_ReallocProc GC_realloc
+void * GC_DebugReallocProc(void * old_object, size_t new_size_in_bytes)
+{
+    return(GC_debug_realloc(old_object, new_size_in_bytes, __FILE__, __LINE__));
+}
+
+# define GC_FreeProc GC_free
+# define GC_DebugFreeProc GC_debug_free
+
+typedef struct {
+  PCR_ERes (*ed_proc)(void *p, size_t size, PCR_Any data);
+  GC_bool ed_pointerfree;
+  PCR_ERes ed_fail_code;
+  PCR_Any ed_client_data;
+} enumerate_data;
+
+void GC_enumerate_block(h, ed)
+register struct hblk *h;
+enumerate_data * ed;
+{
+    register hdr * hhdr;
+    register int sz;
+    word *p;
+    word * lim;
+    
+    hhdr = HDR(h);
+    sz = hhdr -> hb_sz;
+    if (sz >= 0 && ed -> ed_pointerfree
+    	|| sz <= 0 && !(ed -> ed_pointerfree)) return;
+    if (sz < 0) sz = -sz;
+    lim = (word *)(h+1) - sz;
+    p = (word *)h;
+    do {
+        if (PCR_ERes_IsErr(ed -> ed_fail_code)) return;
+        ed -> ed_fail_code =
+            (*(ed -> ed_proc))(p, WORDS_TO_BYTES(sz), ed -> ed_client_data);
+        p+= sz;
+    } while (p <= lim);
+}
+
+struct PCR_MM_ProcsRep * GC_old_allocator = 0;
+
+PCR_ERes GC_EnumerateProc(
+    PCR_Bool ptrFree,
+    PCR_ERes (*proc)(void *p, size_t size, PCR_Any data),
+    PCR_Any data
+)
+{
+    enumerate_data ed;
+    
+    ed.ed_proc = proc;
+    ed.ed_pointerfree = ptrFree;
+    ed.ed_fail_code = PCR_ERes_okay;
+    ed.ed_client_data = data;
+    GC_apply_to_all_blocks(GC_enumerate_block, &ed);
+    if (ed.ed_fail_code != PCR_ERes_okay) {
+        return(ed.ed_fail_code);
+    } else {
+    	/* Also enumerate objects allocated by my predecessors */
+    	return((*(GC_old_allocator->mmp_enumerate))(ptrFree, proc, data));
+    }
+}
+
+void GC_DummyFreeProc(void *p) {}
+
+void GC_DummyShutdownProc(void) {}
+
+struct PCR_MM_ProcsRep GC_Rep = {
+	MY_MAGIC,
+	GC_AllocProc,
+	GC_ReallocProc,
+	GC_DummyFreeProc,  	/* mmp_free */
+	GC_FreeProc,  		/* mmp_unsafeFree */
+	GC_EnumerateProc,
+	GC_DummyShutdownProc	/* mmp_shutdown */
+};
+
+struct PCR_MM_ProcsRep GC_DebugRep = {
+	MY_DEBUGMAGIC,
+	GC_DebugAllocProc,
+	GC_DebugReallocProc,
+	GC_DummyFreeProc,  	/* mmp_free */
+	GC_DebugFreeProc,  		/* mmp_unsafeFree */
+	GC_EnumerateProc,
+	GC_DummyShutdownProc	/* mmp_shutdown */
+};
+
+GC_bool GC_use_debug = 0;
+
+void GC_pcr_install()
+{
+    PCR_MM_Install((GC_use_debug? &GC_DebugRep : &GC_Rep), &GC_old_allocator);
+}
+
+PCR_ERes
+PCR_GC_Setup(void)
+{
+    return PCR_ERes_okay;
+}
+
+PCR_ERes
+PCR_GC_Run(void)
+{
+
+    if( !PCR_Base_TestPCRArg("-nogc") ) {
+        GC_quiet = ( PCR_Base_TestPCRArg("-gctrace") ? 0 : 1 );
+        GC_use_debug = (GC_bool)PCR_Base_TestPCRArg("-debug_alloc");
+        GC_init();
+        if( !PCR_Base_TestPCRArg("-nogc_incremental") ) {
+            /*
+             * awful hack to test whether VD is implemented ...
+             */
+            if( PCR_VD_Start( 0, NIL, 0) != PCR_ERes_FromErr(ENOSYS) ) {
+	        GC_enable_incremental();
+	    }
+	}
+    }
+    return PCR_ERes_okay;
+}
+
+# endif
diff --git a/src/gc/ptr_chck.c b/src/gc/ptr_chck.c
new file mode 100644
index 000000000..f3451ee6f
--- /dev/null
+++ b/src/gc/ptr_chck.c
@@ -0,0 +1,326 @@
+/* 
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, September 19, 1995 1:26 pm PDT */
+
+#include "gc_priv.h"
+#include "gc_mark.h"
+
+#ifdef __STDC__
+void GC_default_same_obj_print_proc(GC_PTR p, GC_PTR q)
+#else
+void GC_default_same_obj_print_proc (p, q)
+GC_PTR p, q;
+#endif
+{
+    GC_err_printf2("0x%lx and 0x%lx are not in the same object\n",
+    		   (unsigned long)p, (unsigned long)q);
+    ABORT("GC_same_obj test failed");
+}
+
+void (*GC_same_obj_print_proc) GC_PROTO((GC_PTR, GC_PTR))
+		= GC_default_same_obj_print_proc;
+
+/* Check that p and q point to the same object.  Call		*/
+/* *GC_same_obj_print_proc if they don't.			*/
+/* Returns the first argument.  (Return value may be hard 	*/
+/* to use,due to typing issues.  But if we had a suitable 	*/
+/* preprocessor ...)						*/
+/* Succeeds if neither p nor q points to the heap.		*/
+/* We assume this is performance critical.  (It shouldn't	*/
+/* be called by production code, but this can easily make	*/
+/* debugging intolerably slow.)					*/
+#ifdef __STDC__
+  GC_PTR GC_same_obj(register void *p, register void *q)
+#else
+  GC_PTR GC_same_obj(p, q)
+  register char *p, *q;
+#endif
+{
+    register struct hblk *h;
+    register hdr *hhdr;
+    register ptr_t base, limit;
+    register word sz;
+    
+    if (!GC_is_initialized) GC_init();
+    hhdr = HDR((word)p);
+    if (hhdr == 0) {
+   	if (divHBLKSZ((word)p) != divHBLKSZ((word)q)
+   	    && HDR((word)q) != 0) {
+   	    goto fail;
+   	}
+   	return(p);
+    }
+    /* If it's a pointer to the middle of a large object, move it	*/
+    /* to the beginning.						*/
+    if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+    	h = HBLKPTR(p) - (word)hhdr;
+    	hhdr = HDR(h);
+	while (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+	   h = FORWARDED_ADDR(h, hhdr);
+	   hhdr = HDR(h);
+	}
+	limit = (ptr_t)((word *)h + HDR_WORDS + hhdr -> hb_sz);
+	if ((ptr_t)p >= limit || (ptr_t)q >= limit || (ptr_t)q < (ptr_t)h ) {
+	    goto fail;
+	}
+	return(p);
+    }
+    sz = WORDS_TO_BYTES(hhdr -> hb_sz);
+    if (sz > WORDS_TO_BYTES(MAXOBJSZ)) {
+      base = (ptr_t)HBLKPTR(p);
+      limit = base + sz;
+      if ((ptr_t)p >= limit) {
+        goto fail;
+      }
+    } else {
+#     ifdef ALL_INTERIOR_POINTERS
+	register map_entry_type map_entry;
+	register int pdispl;
+	
+	pdispl = HBLKDISPL(p);
+	map_entry = MAP_ENTRY((hhdr -> hb_map), pdispl);
+	if (map_entry == OBJ_INVALID) {
+            goto fail;
+        } else {
+            base = (char *)((word)p & ~(WORDS_TO_BYTES(1) - 1));
+            base -= WORDS_TO_BYTES(map_entry);
+	}
+#     else
+	register int offset = HBLKDISPL(p) - HDR_BYTES;
+	register word correction = offset % sz;
+	
+	if (HBLKPTR(p) != HBLKPTR(q)) {
+	    /* The following computation otherwise fails in this case */
+	    goto fail;
+	}
+	base = (ptr_t)p - correction;
+#     endif
+      limit = base + sz;
+    }
+    /* [base, limit) delimits the object containing p, if any.	*/
+    /* If p is not inside a valid object, then either q is	*/
+    /* also outside any valid object, or it is outside 		*/
+    /* [base, limit).						*/
+    if ((ptr_t)q >= limit || (ptr_t)q < base) {
+    	goto fail;
+    }
+    return(p);
+fail:
+    (*GC_same_obj_print_proc)((ptr_t)p, (ptr_t)q);
+    return(p);
+}
+
+#ifdef __STDC__
+void GC_default_is_valid_displacement_print_proc (GC_PTR p)
+#else
+void GC_default_is_valid_displacement_print_proc (p)
+GC_PTR p;
+#endif
+{
+    GC_err_printf1("0x%lx does not point to valid object displacement\n",
+    		   (unsigned long)p);
+    ABORT("GC_is_valid_displacement test failed");
+}
+
+void (*GC_is_valid_displacement_print_proc) GC_PROTO((GC_PTR)) = 
+	GC_default_is_valid_displacement_print_proc;
+
+/* Check that if p is a pointer to a heap page, then it points to	*/
+/* a valid displacement within a heap object.				*/
+/* Uninteresting with ALL_INTERIOR_POINTERS.				*/
+/* Always returns its argument.						*/
+/* Note that we don't lock, since nothing relevant about the header	*/
+/* should change while we have a valid object pointer to the block.	*/
+#ifdef __STDC__
+  void * GC_is_valid_displacement(void *p)
+#else
+  char *GC_is_valid_displacement(p)
+  char *p;
+#endif
+{
+    register hdr *hhdr;
+    register word pdispl;
+    register struct hblk *h;
+    register map_entry_type map_entry;
+    register word sz;
+    
+    if (!GC_is_initialized) GC_init();
+    hhdr = HDR((word)p);
+    if (hhdr == 0) return(p);
+    h = HBLKPTR(p);
+#   ifdef ALL_INTERIOR_POINTERS
+	while (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+	   h = FORWARDED_ADDR(h, hhdr);
+	   hhdr = HDR(h);
+	}
+#   endif
+    if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+    	goto fail;
+    }
+    sz = WORDS_TO_BYTES(hhdr -> hb_sz);
+    pdispl = HBLKDISPL(p);
+    map_entry = MAP_ENTRY((hhdr -> hb_map), pdispl);
+    if (map_entry == OBJ_INVALID
+    	|| sz > MAXOBJSZ && (ptr_t)p >= (ptr_t)h + sz) {
+    	goto fail;
+    }
+    return(p);
+fail:
+    (*GC_is_valid_displacement_print_proc)((ptr_t)p);
+    return(p);
+}
+
+#ifdef __STDC__
+void GC_default_is_visible_print_proc(GC_PTR p)
+#else
+void GC_default_is_visible_print_proc(p)
+GC_PTR p;
+#endif
+{
+    GC_err_printf1("0x%lx is not a GC visible pointer location\n",
+    		   (unsigned long)p);
+    ABORT("GC_is_visible test failed");
+}
+
+void (*GC_is_visible_print_proc) GC_PROTO((GC_PTR p)) = 
+	GC_default_is_visible_print_proc;
+
+/* Could p be a stack address? */
+GC_bool GC_on_stack(p)
+ptr_t p;
+{
+#   ifdef THREADS
+	return(TRUE);
+#   else
+	int dummy;
+#   	ifdef STACK_GROWS_DOWN
+	    if ((ptr_t)p >= (ptr_t)(&dummy) && (ptr_t)p < GC_stackbottom ) {
+	    	return(TRUE);
+	    }
+#	else
+	    if ((ptr_t)p <= (ptr_t)(&dummy) && (ptr_t)p > GC_stackbottom ) {
+	    	return(TRUE);
+	    }
+#	endif
+	return(FALSE);
+#   endif
+}
+
+/* Check that p is visible						*/
+/* to the collector as a possibly pointer containing location.		*/
+/* If it isn't invoke *GC_is_visible_print_proc.			*/
+/* Returns the argument in all cases.  May erroneously succeed		*/
+/* in hard cases.  (This is intended for debugging use with		*/
+/* untyped allocations.  The idea is that it should be possible, though	*/
+/* slow, to add such a call to all indirect pointer stores.)		*/
+/* Currently useless for multithreaded worlds.				*/
+#ifdef __STDC__
+  void * GC_is_visible(void *p)
+#else
+  char *GC_is_visible(p)
+  char *p;
+#endif
+{
+    register hdr *hhdr;
+    
+    if ((word)p & (ALIGNMENT - 1)) goto fail;
+    if (!GC_is_initialized) GC_init();
+#   ifdef THREADS
+	hhdr = HDR((word)p);
+        if (hhdr != 0 && GC_base(p) == 0) {
+            goto fail;
+        } else {
+            /* May be inside thread stack.  We can't do much. */
+            return(p);
+        }
+#   else
+	/* Check stack first: */
+	  if (GC_on_stack(p)) return(p);
+	hhdr = HDR((word)p);
+    	if (hhdr == 0) {
+    	    GC_bool result;
+    	    
+    	    if (GC_is_static_root(p)) return(p);
+    	    /* Else do it again correctly:	*/
+#           if (defined(DYNAMIC_LOADING) || defined(MSWIN32) || defined(PCR)) \
+                && !defined(SRC_M3)
+    	        DISABLE_SIGNALS();
+    	        GC_register_dynamic_libraries();
+    	        result = GC_is_static_root(p);
+    	        ENABLE_SIGNALS();
+    	        if (result) return(p);
+#	    endif
+    	    goto fail;
+    	} else {
+    	    /* p points to the heap. */
+    	    word descr;
+    	    ptr_t base = GC_base(p);	/* Should be manually inlined? */
+    	    
+    	    if (base == 0) goto fail;
+    	    if (HBLKPTR(base) != HBLKPTR(p)) hhdr = HDR((word)p);
+    	    descr = hhdr -> hb_descr;
+    retry:
+    	    switch(descr & DS_TAGS) {
+    	        case DS_LENGTH:
+    	            if ((word)((ptr_t)p - (ptr_t)base) > (word)descr) goto fail;
+    	            break;
+    	        case DS_BITMAP:
+    	            if ((ptr_t)p - (ptr_t)base
+    	                 >= WORDS_TO_BYTES(BITMAP_BITS)
+    	                 || ((word)p & (sizeof(word) - 1))) goto fail;
+    	            if (!((1 << (WORDSZ - ((ptr_t)p - (ptr_t)base) - 1))
+    	            	  & descr)) goto fail;
+    	            break;
+    	        case DS_PROC:
+    	            /* We could try to decipher this partially. 	*/
+    	            /* For now we just punt.				*/
+    	            break;
+    	        case DS_PER_OBJECT:
+    	            descr = *(word *)((ptr_t)base + (descr & ~DS_TAGS));
+    	            goto retry;
+    	    }
+    	    return(p);
+    	}
+#   endif
+fail:
+    (*GC_is_visible_print_proc)((ptr_t)p);
+    return(p);
+}
+
+
+GC_PTR GC_pre_incr (p, how_much)
+GC_PTR *p;
+size_t how_much;
+{
+    GC_PTR initial = *p;
+    GC_PTR result = GC_same_obj((GC_PTR)((word)initial + how_much), initial);
+    
+#   ifndef ALL_INTERIOR_POINTERS
+    	(void) GC_is_valid_displacement(result);
+#   endif
+    return (*p = result);
+}
+
+GC_PTR GC_post_incr (p, how_much)
+GC_PTR *p;
+size_t how_much;
+{
+    GC_PTR initial = *p;
+    GC_PTR result = GC_same_obj((GC_PTR)((word)initial + how_much), initial);
+ 
+#   ifndef ALL_INTERIOR_POINTERS
+    	(void) GC_is_valid_displacement(result);
+#   endif   
+    *p = result;
+    return(initial);
+}
diff --git a/src/gc/real_malloc.c b/src/gc/real_malloc.c
new file mode 100644
index 000000000..dece9fdc0
--- /dev/null
+++ b/src/gc/real_malloc.c
@@ -0,0 +1,36 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, May 19, 1994 2:04 pm PDT */
+
+
+# ifdef PCR
+/*
+ * This definition should go in its own file that includes no other
+ * header files.  Otherwise, we risk not getting the underlying system
+ * malloc.
+ */
+# define PCR_NO_RENAME
+# include <stdlib.h>
+
+# ifdef __STDC__
+    char * real_malloc(size_t size)
+# else 
+    char * real_malloc()
+    int size;
+# endif
+{
+    return((char *)malloc(size));
+}
+#endif /* PCR */
+
diff --git a/src/gc/reclaim.c b/src/gc/reclaim.c
new file mode 100644
index 000000000..4ace1107d
--- /dev/null
+++ b/src/gc/reclaim.c
@@ -0,0 +1,923 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1996 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+#include <stdio.h>
+#include "gc_priv.h"
+
+signed_word GC_mem_found = 0;
+			/* Number of words of memory reclaimed     */
+
+static void report_leak(p, sz)
+ptr_t p;
+word sz;
+{
+    if (HDR(p) -> hb_obj_kind == PTRFREE) {
+        GC_err_printf0("Leaked atomic object at ");
+    } else {
+        GC_err_printf0("Leaked composite object at ");
+    }
+    GC_print_heap_obj(p);
+    GC_err_printf0("\n");
+}
+
+#   define FOUND_FREE(hblk, word_no) \
+      { \
+         report_leak((ptr_t)hblk + WORDS_TO_BYTES(word_no), \
+         	     HDR(hblk) -> hb_sz); \
+      }
+
+/*
+ * reclaim phase
+ *
+ */
+
+
+/*
+ * Test whether a block is completely empty, i.e. contains no marked
+ * objects.  This does not require the block to be in physical
+ * memory.
+ */
+ 
+GC_bool GC_block_empty(hhdr)
+register hdr * hhdr;
+{
+    register word *p = (word *)(&(hhdr -> hb_marks[0]));
+    register word * plim =
+	    		(word *)(&(hhdr -> hb_marks[MARK_BITS_SZ]));
+    while (p < plim) {
+	if (*p++) return(FALSE);
+    }
+    return(TRUE);
+}
+
+/* The following functions sometimes return a DONT_KNOW value. */
+#define DONT_KNOW  2
+
+#ifdef SMALL_CONFIG
+# define GC_block_nearly_full1(hhdr, pat1) DONT_KNOW
+# define GC_block_nearly_full3(hhdr, pat1, pat2) DONT_KNOW
+# define GC_block_nearly_full(hhdr) DONT_KNOW
+#else
+
+/*
+ * Test whether nearly all of the mark words consist of the same
+ * repeating pattern.
+ */
+#define FULL_THRESHOLD (MARK_BITS_SZ/16)
+
+GC_bool GC_block_nearly_full1(hhdr, pat1)
+hdr *hhdr;
+word pat1;
+{
+    unsigned i;
+    unsigned misses = 0;
+    GC_ASSERT((MARK_BITS_SZ & 1) == 0);
+    for (i = 0; i < MARK_BITS_SZ; ++i) {
+	if ((hhdr -> hb_marks[i] | ~pat1) != ONES) {
+	    if (++misses > FULL_THRESHOLD) return FALSE;
+	}
+    }
+    return TRUE;
+}
+
+/*
+ * Test whether the same repeating 3 word pattern occurs in nearly
+ * all the mark bit slots.
+ * This is used as a heuristic, so we're a bit sloppy and ignore
+ * the last one or two words.
+ */
+GC_bool GC_block_nearly_full3(hhdr, pat1, pat2, pat3)
+hdr *hhdr;
+word pat1, pat2, pat3;
+{
+    unsigned i;
+    unsigned misses = 0;
+
+    if (MARK_BITS_SZ < 4) {
+      return DONT_KNOW;
+    }
+    for (i = 0; i < MARK_BITS_SZ - 2; i += 3) {
+	if ((hhdr -> hb_marks[i] | ~pat1) != ONES) {
+	    if (++misses > FULL_THRESHOLD) return FALSE;
+	}
+	if ((hhdr -> hb_marks[i+1] | ~pat2) != ONES) {
+	    if (++misses > FULL_THRESHOLD) return FALSE;
+	}
+	if ((hhdr -> hb_marks[i+2] | ~pat3) != ONES) {
+	    if (++misses > FULL_THRESHOLD) return FALSE;
+	}
+    }
+    return TRUE;
+}
+
+/* Check whether a small object block is nearly full by looking at only */
+/* the mark bits.							*/
+/* We manually precomputed the mark bit patterns that need to be 	*/
+/* checked for, and we give up on the ones that are unlikely to occur,	*/
+/* or have period > 3.							*/
+/* This would be a lot easier with a mark bit per object instead of per	*/
+/* word, but that would rewuire computing object numbers in the mark	*/
+/* loop, which would require different data structures ...		*/
+GC_bool GC_block_nearly_full(hhdr)
+hdr *hhdr;
+{
+    int sz = hhdr -> hb_sz;
+
+#   if CPP_WORDSZ != 32 && CPP_WORDSZ != 64
+      return DONT_KNOW;	/* Shouldn't be used in any standard config.	*/
+#   endif
+    if (0 != HDR_WORDS) return DONT_KNOW;
+	/* Also shouldn't happen */
+#   if CPP_WORDSZ == 32
+      switch(sz) {
+        case 1:
+	  return GC_block_nearly_full1(hhdr, 0xffffffffl);
+	case 2:
+	  return GC_block_nearly_full1(hhdr, 0x55555555l);
+	case 4:
+	  return GC_block_nearly_full1(hhdr, 0x11111111l);
+	case 6:
+	  return GC_block_nearly_full3(hhdr, 0x41041041l,
+					      0x10410410l,
+					       0x04104104l);
+	case 8:
+	  return GC_block_nearly_full1(hhdr, 0x01010101l);
+	case 12:
+	  return GC_block_nearly_full3(hhdr, 0x01001001l,
+					      0x10010010l,
+					       0x00100100l);
+	case 16:
+	  return GC_block_nearly_full1(hhdr, 0x00010001l);
+	case 32:
+	  return GC_block_nearly_full1(hhdr, 0x00000001l);
+	default:
+	  return DONT_KNOW;
+      }
+#   endif
+#   if CPP_WORDSZ == 64
+      switch(sz) {
+        case 1:
+	  return GC_block_nearly_full1(hhdr, 0xffffffffffffffffl);
+	case 2:
+	  return GC_block_nearly_full1(hhdr, 0x5555555555555555l);
+	case 4:
+	  return GC_block_nearly_full1(hhdr, 0x1111111111111111l);
+	case 6:
+	  return GC_block_nearly_full3(hhdr, 0x1041041041041041l,
+					       0x4104104104104104l,
+					         0x0410410410410410l);
+	case 8:
+	  return GC_block_nearly_full1(hhdr, 0x0101010101010101l);
+	case 12:
+	  return GC_block_nearly_full3(hhdr, 0x1001001001001001l,
+					       0x0100100100100100l,
+					         0x0010010010010010l);
+	case 16:
+	  return GC_block_nearly_full1(hhdr, 0x0001000100010001l);
+	case 32:
+	  return GC_block_nearly_full1(hhdr, 0x0000000100000001l);
+	default:
+	  return DONT_KNOW;
+      }
+#   endif
+}
+#endif /* !SMALL_CONFIG */
+
+# ifdef GATHERSTATS
+#   define INCR_WORDS(sz) n_words_found += (sz)
+# else
+#   define INCR_WORDS(sz)
+# endif
+/*
+ * Restore unmarked small objects in h of size sz to the object
+ * free list.  Returns the new list.
+ * Clears unmarked objects.
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_clear(hbp, hhdr, sz, list)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+register hdr * hhdr;
+register ptr_t list;
+register word sz;
+{
+    register int word_no;
+    register word *p, *q, *plim;
+#   ifdef GATHERSTATS
+        register int n_words_found = 0;
+#   endif        
+    
+    p = (word *)(hbp->hb_body);
+    word_no = HDR_WORDS;
+    plim = (word *)((((word)hbp) + HBLKSIZE)
+		   - WORDS_TO_BYTES(sz));
+
+    /* go through all words in block */
+	while( p <= plim )  {
+	    if( mark_bit_from_hdr(hhdr, word_no) ) {
+		p += sz;
+	    } else {
+		INCR_WORDS(sz);
+		/* object is available - put on list */
+		    obj_link(p) = list;
+		    list = ((ptr_t)p);
+		/* Clear object, advance p to next object in the process */
+		    q = p + sz;
+                    p++; /* Skip link field */
+                    while (p < q) {
+			*p++ = 0;
+		    }
+	    }
+	    word_no += sz;
+	}
+#   ifdef GATHERSTATS
+	GC_mem_found += n_words_found;
+#   endif
+    return(list);
+}
+
+#ifndef SMALL_CONFIG
+
+/*
+ * A special case for 2 word composite objects (e.g. cons cells):
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_clear2(hbp, hhdr, list)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+hdr * hhdr;
+register ptr_t list;
+{
+    register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
+    register word *p, *plim;
+#   ifdef GATHERSTATS
+        register int n_words_found = 0;
+#   endif
+    register word mark_word;
+    register int i;
+#   define DO_OBJ(start_displ) \
+	if (!(mark_word & ((word)1 << start_displ))) { \
+	    p[start_displ] = (word)list; \
+	    list = (ptr_t)(p+start_displ); \
+	    p[start_displ+1] = 0; \
+	    INCR_WORDS(2); \
+	}
+    
+    p = (word *)(hbp->hb_body);
+    plim = (word *)(((word)hbp) + HBLKSIZE);
+
+    /* go through all words in block */
+	while( p < plim )  {
+	    mark_word = *mark_word_addr++;
+	    for (i = 0; i < WORDSZ; i += 8) {
+		DO_OBJ(0);
+		DO_OBJ(2);
+		DO_OBJ(4);
+		DO_OBJ(6);
+		p += 8;
+		mark_word >>= 8;
+	    }
+	}	        
+#   ifdef GATHERSTATS
+	GC_mem_found += n_words_found;
+#   endif
+    return(list);
+#   undef DO_OBJ
+}
+
+/*
+ * Another special case for 4 word composite objects:
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_clear4(hbp, hhdr, list)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+hdr * hhdr;
+register ptr_t list;
+{
+    register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
+    register word *p, *plim;
+#   ifdef GATHERSTATS
+        register int n_words_found = 0;
+#   endif
+    register word mark_word;
+#   define DO_OBJ(start_displ) \
+	if (!(mark_word & ((word)1 << start_displ))) { \
+	    p[start_displ] = (word)list; \
+	    list = (ptr_t)(p+start_displ); \
+	    p[start_displ+1] = 0; \
+	    CLEAR_DOUBLE(p + start_displ + 2); \
+	    INCR_WORDS(4); \
+	}
+    
+    p = (word *)(hbp->hb_body);
+    plim = (word *)(((word)hbp) + HBLKSIZE);
+
+    /* go through all words in block */
+	while( p < plim )  {
+	    mark_word = *mark_word_addr++;
+	    DO_OBJ(0);
+	    DO_OBJ(4);
+	    DO_OBJ(8);
+	    DO_OBJ(12);
+	    DO_OBJ(16);
+	    DO_OBJ(20);
+	    DO_OBJ(24);
+	    DO_OBJ(28);
+#	    if CPP_WORDSZ == 64
+	      DO_OBJ(32);
+	      DO_OBJ(36);
+	      DO_OBJ(40);
+	      DO_OBJ(44);
+	      DO_OBJ(48);
+	      DO_OBJ(52);
+	      DO_OBJ(56);
+	      DO_OBJ(60);
+#	    endif
+	    p += WORDSZ;
+	}	        
+#   ifdef GATHERSTATS
+	GC_mem_found += n_words_found;
+#   endif
+    return(list);
+#   undef DO_OBJ
+}
+
+#endif /* !SMALL_CONFIG */
+
+/* The same thing, but don't clear objects: */
+/*ARGSUSED*/
+ptr_t GC_reclaim_uninit(hbp, hhdr, sz, list)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+register hdr * hhdr;
+register ptr_t list;
+register word sz;
+{
+    register int word_no;
+    register word *p, *plim;
+#   ifdef GATHERSTATS
+        register int n_words_found = 0;
+#   endif
+    
+    p = (word *)(hbp->hb_body);
+    word_no = HDR_WORDS;
+    plim = (word *)((((word)hbp) + HBLKSIZE)
+		   - WORDS_TO_BYTES(sz));
+
+    /* go through all words in block */
+	while( p <= plim )  {
+	    if( !mark_bit_from_hdr(hhdr, word_no) ) {
+		INCR_WORDS(sz);
+		/* object is available - put on list */
+		    obj_link(p) = list;
+		    list = ((ptr_t)p);
+	    }
+	    p += sz;
+	    word_no += sz;
+	}
+#   ifdef GATHERSTATS
+	GC_mem_found += n_words_found;
+#   endif
+    return(list);
+}
+
+/* Don't really reclaim objects, just check for unmarked ones: */
+/*ARGSUSED*/
+void GC_reclaim_check(hbp, hhdr, sz)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+register hdr * hhdr;
+register word sz;
+{
+    register int word_no;
+    register word *p, *plim;
+#   ifdef GATHERSTATS
+        register int n_words_found = 0;
+#   endif
+    
+    p = (word *)(hbp->hb_body);
+    word_no = HDR_WORDS;
+    plim = (word *)((((word)hbp) + HBLKSIZE)
+		   - WORDS_TO_BYTES(sz));
+
+    /* go through all words in block */
+	while( p <= plim )  {
+	    if( !mark_bit_from_hdr(hhdr, word_no) ) {
+		FOUND_FREE(hbp, word_no);
+	    }
+	    p += sz;
+	    word_no += sz;
+	}
+}
+
+#ifndef SMALL_CONFIG
+/*
+ * Another special case for 2 word atomic objects:
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_uninit2(hbp, hhdr, list)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+hdr * hhdr;
+register ptr_t list;
+{
+    register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
+    register word *p, *plim;
+#   ifdef GATHERSTATS
+        register int n_words_found = 0;
+#   endif
+    register word mark_word;
+    register int i;
+#   define DO_OBJ(start_displ) \
+	if (!(mark_word & ((word)1 << start_displ))) { \
+	    p[start_displ] = (word)list; \
+	    list = (ptr_t)(p+start_displ); \
+	    INCR_WORDS(2); \
+	}
+    
+    p = (word *)(hbp->hb_body);
+    plim = (word *)(((word)hbp) + HBLKSIZE);
+
+    /* go through all words in block */
+	while( p < plim )  {
+	    mark_word = *mark_word_addr++;
+	    for (i = 0; i < WORDSZ; i += 8) {
+		DO_OBJ(0);
+		DO_OBJ(2);
+		DO_OBJ(4);
+		DO_OBJ(6);
+		p += 8;
+		mark_word >>= 8;
+	    }
+	}	        
+#   ifdef GATHERSTATS
+	GC_mem_found += n_words_found;
+#   endif
+    return(list);
+#   undef DO_OBJ
+}
+
+/*
+ * Another special case for 4 word atomic objects:
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_uninit4(hbp, hhdr, list)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+hdr * hhdr;
+register ptr_t list;
+{
+    register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
+    register word *p, *plim;
+#   ifdef GATHERSTATS
+        register int n_words_found = 0;
+#   endif
+    register word mark_word;
+#   define DO_OBJ(start_displ) \
+	if (!(mark_word & ((word)1 << start_displ))) { \
+	    p[start_displ] = (word)list; \
+	    list = (ptr_t)(p+start_displ); \
+	    INCR_WORDS(4); \
+	}
+    
+    p = (word *)(hbp->hb_body);
+    plim = (word *)(((word)hbp) + HBLKSIZE);
+
+    /* go through all words in block */
+	while( p < plim )  {
+	    mark_word = *mark_word_addr++;
+	    DO_OBJ(0);
+	    DO_OBJ(4);
+	    DO_OBJ(8);
+	    DO_OBJ(12);
+	    DO_OBJ(16);
+	    DO_OBJ(20);
+	    DO_OBJ(24);
+	    DO_OBJ(28);
+#	    if CPP_WORDSZ == 64
+	      DO_OBJ(32);
+	      DO_OBJ(36);
+	      DO_OBJ(40);
+	      DO_OBJ(44);
+	      DO_OBJ(48);
+	      DO_OBJ(52);
+	      DO_OBJ(56);
+	      DO_OBJ(60);
+#	    endif
+	    p += WORDSZ;
+	}	        
+#   ifdef GATHERSTATS
+	GC_mem_found += n_words_found;
+#   endif
+    return(list);
+#   undef DO_OBJ
+}
+
+/* Finally the one word case, which never requires any clearing: */
+/*ARGSUSED*/
+ptr_t GC_reclaim1(hbp, hhdr, list)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+hdr * hhdr;
+register ptr_t list;
+{
+    register word * mark_word_addr = &(hhdr->hb_marks[divWORDSZ(HDR_WORDS)]);
+    register word *p, *plim;
+#   ifdef GATHERSTATS
+        register int n_words_found = 0;
+#   endif
+    register word mark_word;
+    register int i;
+#   define DO_OBJ(start_displ) \
+	if (!(mark_word & ((word)1 << start_displ))) { \
+	    p[start_displ] = (word)list; \
+	    list = (ptr_t)(p+start_displ); \
+	    INCR_WORDS(1); \
+	}
+    
+    p = (word *)(hbp->hb_body);
+    plim = (word *)(((word)hbp) + HBLKSIZE);
+
+    /* go through all words in block */
+	while( p < plim )  {
+	    mark_word = *mark_word_addr++;
+	    for (i = 0; i < WORDSZ; i += 4) {
+		DO_OBJ(0);
+		DO_OBJ(1);
+		DO_OBJ(2);
+		DO_OBJ(3);
+		p += 4;
+		mark_word >>= 4;
+	    }
+	}	        
+#   ifdef GATHERSTATS
+	GC_mem_found += n_words_found;
+#   endif
+    return(list);
+#   undef DO_OBJ
+}
+
+#endif /* !SMALL_CONFIG */
+
+/*
+ * Restore unmarked small objects in the block pointed to by hbp
+ * to the appropriate object free list.
+ * If entirely empty blocks are to be completely deallocated, then
+ * caller should perform that check.
+ */
+void GC_reclaim_small_nonempty_block(hbp, report_if_found)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+int report_if_found;		/* Abort if a reclaimable object is found */
+{
+    hdr * hhdr;
+    word sz;		/* size of objects in current block	*/
+    struct obj_kind * ok;
+    ptr_t * flh;
+    int kind;
+    GC_bool full;
+    
+    hhdr = HDR(hbp);
+    sz = hhdr -> hb_sz;
+    hhdr -> hb_last_reclaimed = (unsigned short) GC_gc_no;
+    kind = hhdr -> hb_obj_kind;
+    ok = &GC_obj_kinds[kind];
+    flh = &(ok -> ok_freelist[sz]);
+
+    if (report_if_found) {
+	GC_reclaim_check(hbp, hhdr, sz);
+    } else if (ok -> ok_init) {
+      switch(sz) {
+#      ifndef SMALL_CONFIG
+        case 1:
+#           if CPP_WORDSZ == 64
+	      full = GC_block_nearly_full1(hhdr, 0xffffffffffffffffl);
+#	    else
+	      full = GC_block_nearly_full1(hhdr, 0xffffffffl);
+#	    endif
+	    if (TRUE == full) goto out;
+	    if (FALSE == full) GC_write_hint(hbp);
+	    /* In the DONT_KNOW case, we let reclaim fault.	*/
+            *flh = GC_reclaim1(hbp, hhdr, *flh);
+            break;
+        case 2:
+#           if CPP_WORDSZ == 64
+	      full = GC_block_nearly_full1(hhdr, 0x5555555555555555l);
+#	    else
+	      full = GC_block_nearly_full1(hhdr, 0x55555555l);
+#	    endif
+	    if (TRUE == full) goto out;
+	    if (FALSE == full) GC_write_hint(hbp);
+            *flh = GC_reclaim_clear2(hbp, hhdr, *flh);
+            break;
+        case 4:
+#           if CPP_WORDSZ == 64
+	      full = GC_block_nearly_full1(hhdr, 0x1111111111111111l);
+#	    else
+	      full = GC_block_nearly_full1(hhdr, 0x11111111l);
+#	    endif
+	    if (TRUE == full) goto out;
+	    if (FALSE == full) GC_write_hint(hbp);
+            *flh = GC_reclaim_clear4(hbp, hhdr, *flh);
+            break;
+#      endif
+        default:
+	    full = GC_block_nearly_full(hhdr);
+	    if (TRUE == full) goto out;
+	    if (FALSE == full) GC_write_hint(hbp);
+            *flh = GC_reclaim_clear(hbp, hhdr, sz, *flh);
+            break;
+      }
+    } else {
+      switch(sz) {
+#      ifndef SMALL_CONFIG
+        case 1:
+#           if CPP_WORDSZ == 64
+	      full = GC_block_nearly_full1(hhdr, 0xffffffffffffffffl);
+#	    else
+	      full = GC_block_nearly_full1(hhdr, 0xffffffffl);
+#	    endif
+	    if (TRUE == full) goto out;
+	    if (FALSE == full) GC_write_hint(hbp);
+            *flh = GC_reclaim1(hbp, hhdr, *flh);
+            break;
+        case 2:
+#           if CPP_WORDSZ == 64
+	      full = GC_block_nearly_full1(hhdr, 0x5555555555555555l);
+#	    else
+	      full = GC_block_nearly_full1(hhdr, 0x55555555l);
+#	    endif
+	    if (TRUE == full) goto out;
+	    if (FALSE == full) GC_write_hint(hbp);
+            *flh = GC_reclaim_uninit2(hbp, hhdr, *flh);
+            break;
+        case 4:
+#           if CPP_WORDSZ == 64
+	      full = GC_block_nearly_full1(hhdr, 0x1111111111111111l);
+#	    else
+	      full = GC_block_nearly_full1(hhdr, 0x11111111l);
+#	    endif
+	    if (TRUE == full) goto out;
+	    if (FALSE == full) GC_write_hint(hbp);
+            *flh = GC_reclaim_uninit4(hbp, hhdr, *flh);
+            break;
+#      endif
+        default:
+	    full = GC_block_nearly_full(hhdr);
+	    if (TRUE == full) goto out;
+	    if (FALSE == full) GC_write_hint(hbp);
+            *flh = GC_reclaim_uninit(hbp, hhdr, sz, *flh);
+            break;
+      }
+    } 
+out:
+    if (IS_UNCOLLECTABLE(kind)) GC_set_hdr_marks(hhdr);
+}
+
+/*
+ * Restore an unmarked large object or an entirely empty blocks of small objects
+ * to the heap block free list.
+ * Otherwise enqueue the block for later processing
+ * by GC_reclaim_small_nonempty_block.
+ * If report_if_found is TRUE, then process any block immediately, and
+ * simply report free objects; do not actually reclaim them.
+ */
+void GC_reclaim_block(hbp, report_if_found)
+register struct hblk *hbp;	/* ptr to current heap block		*/
+word report_if_found;		/* Abort if a reclaimable object is found */
+{
+    register hdr * hhdr;
+    register word sz;		/* size of objects in current block	*/
+    register struct obj_kind * ok;
+    struct hblk ** rlh;
+
+    hhdr = HDR(hbp);
+    sz = hhdr -> hb_sz;
+    ok = &GC_obj_kinds[hhdr -> hb_obj_kind];
+
+    if( sz > MAXOBJSZ ) {  /* 1 big object */
+        if( !mark_bit_from_hdr(hhdr, HDR_WORDS) ) {
+	    if (report_if_found) {
+	      FOUND_FREE(hbp, HDR_WORDS);
+	    } else {
+#	      ifdef GATHERSTATS
+	        GC_mem_found += sz;
+#	      endif
+	      GC_freehblk(hbp);
+	    }
+	}
+    } else {
+        GC_bool empty = GC_block_empty(hhdr);
+        if (report_if_found) {
+    	  GC_reclaim_small_nonempty_block(hbp, (int)report_if_found);
+        } else if (empty) {
+#	  ifdef GATHERSTATS
+            GC_mem_found += BYTES_TO_WORDS(HBLKSIZE);
+#	  endif
+          GC_freehblk(hbp);
+        } else {
+          /* group of smaller objects, enqueue the real work */
+          rlh = &(ok -> ok_reclaim_list[sz]);
+          hhdr -> hb_next = *rlh;
+          *rlh = hbp;
+        }
+    }
+}
+
+#if !defined(NO_DEBUGGING)
+/* Routines to gather and print heap block info 	*/
+/* intended for debugging.  Otherwise should be called	*/
+/* with lock.						*/
+static size_t number_of_blocks;
+static size_t total_bytes;
+
+/* Number of set bits in a word.  Not performance critical.	*/
+static int set_bits(n)
+word n;
+{
+    register word m = n;
+    register int result = 0;
+    
+    while (m > 0) {
+    	if (m & 1) result++;
+    	m >>= 1;
+    }
+    return(result);
+}
+
+/* Return the number of set mark bits in the given header	*/
+int GC_n_set_marks(hhdr)
+hdr * hhdr;
+{
+    register int result = 0;
+    register int i;
+    
+    for (i = 0; i < MARK_BITS_SZ; i++) {
+        result += set_bits(hhdr -> hb_marks[i]);
+    }
+    return(result);
+}
+
+/*ARGSUSED*/
+void GC_print_block_descr(h, dummy)
+struct hblk *h;
+word dummy;
+{
+    register hdr * hhdr = HDR(h);
+    register size_t bytes = WORDS_TO_BYTES(hhdr -> hb_sz);
+    
+    GC_printf3("(%lu:%lu,%lu)", (unsigned long)(hhdr -> hb_obj_kind),
+    			        (unsigned long)bytes,
+    			        (unsigned long)(GC_n_set_marks(hhdr)));
+    bytes += HDR_BYTES + HBLKSIZE-1;
+    bytes &= ~(HBLKSIZE-1);
+    total_bytes += bytes;
+    number_of_blocks++;
+}
+
+void GC_print_block_list()
+{
+    GC_printf0("(kind(0=ptrfree,1=normal,2=unc.,3=stubborn):size_in_bytes, #_marks_set)\n");
+    number_of_blocks = 0;
+    total_bytes = 0;
+    GC_apply_to_all_blocks(GC_print_block_descr, (word)0);
+    GC_printf2("\nblocks = %lu, bytes = %lu\n",
+    	       (unsigned long)number_of_blocks,
+    	       (unsigned long)total_bytes);
+}
+
+#endif /* NO_DEBUGGING */
+
+/*
+ * Perform GC_reclaim_block on the entire heap, after first clearing
+ * small object free lists (if we are not just looking for leaks).
+ */
+void GC_start_reclaim(report_if_found)
+int report_if_found;		/* Abort if a GC_reclaimable object is found */
+{
+    int kind;
+    
+    /* Clear reclaim- and free-lists */
+      for (kind = 0; kind < GC_n_kinds; kind++) {
+        register ptr_t *fop;
+        register ptr_t *lim;
+        register struct hblk ** rlp;
+        register struct hblk ** rlim;
+        register struct hblk ** rlist = GC_obj_kinds[kind].ok_reclaim_list;
+        
+        if (rlist == 0) continue;	/* This kind not used.	*/
+        if (!report_if_found) {
+            lim = &(GC_obj_kinds[kind].ok_freelist[MAXOBJSZ+1]);
+	    for( fop = GC_obj_kinds[kind].ok_freelist; fop < lim; fop++ ) {
+	      *fop = 0;
+	    }
+	} /* otherwise free list objects are marked, 	*/
+	  /* and its safe to leave them			*/
+	rlim = rlist + MAXOBJSZ+1;
+	for( rlp = rlist; rlp < rlim; rlp++ ) {
+	    *rlp = 0;
+	}
+      }
+    
+#   ifdef PRINTBLOCKS
+        GC_printf0("GC_reclaim: current block sizes:\n");
+        GC_print_block_list();
+#   endif
+
+  /* Go through all heap blocks (in hblklist) and reclaim unmarked objects */
+  /* or enqueue the block for later processing.				   */
+    GC_apply_to_all_blocks(GC_reclaim_block, (word)report_if_found);
+
+# ifdef EAGER_SWEEP
+    /* This is a very stupid thing to do.  We make it possible anyway,	*/
+    /* so that you can convince yourself that it really is very stupid.	*/
+    GC_reclaim_all((GC_stop_func)0, FALSE);
+# endif
+    
+}
+
+/*
+ * Sweep blocks of the indicated object size and kind until either the
+ * appropriate free list is nonempty, or there are no more blocks to
+ * sweep.
+ */
+void GC_continue_reclaim(sz, kind)
+word sz;	/* words */
+int kind;
+{
+    register hdr * hhdr;
+    register struct hblk * hbp;
+    register struct obj_kind * ok = &(GC_obj_kinds[kind]);
+    struct hblk ** rlh = ok -> ok_reclaim_list;
+    ptr_t *flh = &(ok -> ok_freelist[sz]);
+    
+    if (rlh == 0) return;	/* No blocks of this kind.	*/
+    rlh += sz;
+    while ((hbp = *rlh) != 0) {
+        hhdr = HDR(hbp);
+        *rlh = hhdr -> hb_next;
+        GC_reclaim_small_nonempty_block(hbp, FALSE);
+        if (*flh != 0) break;
+    }
+}
+
+/*
+ * Reclaim all small blocks waiting to be reclaimed.
+ * Abort and return FALSE when/if (*stop_func)() returns TRUE.
+ * If this returns TRUE, then it's safe to restart the world
+ * with incorrectly cleared mark bits.
+ * If ignore_old is TRUE, then reclaim only blocks that have been 
+ * recently reclaimed, and discard the rest.
+ * Stop_func may be 0.
+ */
+GC_bool GC_reclaim_all(stop_func, ignore_old)
+GC_stop_func stop_func;
+GC_bool ignore_old;
+{
+    register word sz;
+    register int kind;
+    register hdr * hhdr;
+    register struct hblk * hbp;
+    register struct obj_kind * ok;
+    struct hblk ** rlp;
+    struct hblk ** rlh;
+#   ifdef PRINTTIMES
+	CLOCK_TYPE start_time;
+	CLOCK_TYPE done_time;
+	
+	GET_TIME(start_time);
+#   endif
+    
+    for (kind = 0; kind < GC_n_kinds; kind++) {
+    	ok = &(GC_obj_kinds[kind]);
+    	rlp = ok -> ok_reclaim_list;
+    	if (rlp == 0) continue;
+    	for (sz = 1; sz <= MAXOBJSZ; sz++) {
+    	    rlh = rlp + sz;
+    	    while ((hbp = *rlh) != 0) {
+    	        if (stop_func != (GC_stop_func)0 && (*stop_func)()) {
+    	            return(FALSE);
+    	        }
+        	hhdr = HDR(hbp);
+        	*rlh = hhdr -> hb_next;
+        	if (!ignore_old || hhdr -> hb_last_reclaimed == GC_gc_no - 1) {
+        	    /* It's likely we'll need it this time, too	*/
+        	    /* It's been touched recently, so this	*/
+        	    /* shouldn't trigger paging.		*/
+        	    GC_reclaim_small_nonempty_block(hbp, FALSE);
+        	}
+            }
+        }
+    }
+#   ifdef PRINTTIMES
+	GET_TIME(done_time);
+	GC_printf1("Disposing of reclaim lists took %lu msecs\n",
+	           MS_TIME_DIFF(done_time,start_time));
+#   endif
+    return(TRUE);
+}
diff --git a/src/gc/rs6000_mach_dep.s b/src/gc/rs6000_mach_dep.s
new file mode 100644
index 000000000..e0dbe8085
--- /dev/null
+++ b/src/gc/rs6000_mach_dep.s
@@ -0,0 +1,105 @@
+    .csect
+    .set   r0,0
+    .set   r1,1
+    .set   r2,2
+    .set   r3,3
+    .set   r4,4
+    .set   r5,5
+    .set   r6,6
+    .set   r7,7
+    .set   r8,8
+    .set   r9,9
+    .set   r10,10
+    .set   r11,11
+    .set   r12,12
+    .set   r13,13
+    .set   r14,14
+    .set   r15,15
+    .set   r16,16
+    .set   r17,17
+    .set   r18,18
+    .set   r19,19
+    .set   r20,20
+    .set   r21,21
+    .set   r22,22
+    .set   r23,23
+    .set   r24,24
+    .set   r25,25
+    .set   r26,26
+    .set   r27,27
+    .set   r28,28
+    .set   r29,29
+    .set   r30,30
+    .set   r31,31
+
+ # Mark from machine registers that are saved by C compiler
+    .globl  .GC_push_regs
+.GC_push_regs:
+    .extern .GC_push_one
+    stu	    r1,-64(r1)  # reserve stack frame
+    mflr    r0		# save link register
+    st      r0,0x48(r1)
+    oril    r3,r2,0x0   # mark from r2
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r13,0x0   # mark from r13-r31
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r14,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r15,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r16,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r17,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r18,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r19,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r20,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r21,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r22,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r23,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r24,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r25,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r26,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r27,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r28,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r29,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r30,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    oril    r3,r31,0x0
+    bl 	    .GC_push_one
+    cror    15,15,15
+    l       r0,0x48(r1)
+    mtlr    r0
+    ai      r1,r1,64
+    br
diff --git a/src/gc/setjmp_t.c b/src/gc/setjmp_t.c
new file mode 100644
index 000000000..1c9253e98
--- /dev/null
+++ b/src/gc/setjmp_t.c
@@ -0,0 +1,115 @@
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, September 21, 1995 5:39 pm PDT */
+ 
+/* Check whether setjmp actually saves registers in jmp_buf. */
+/* If it doesn't, the generic mark_regs code won't work.     */
+/* Compilers vary as to whether they will put x in a 	     */
+/* (callee-save) register without -O.  The code is	     */
+/* contrived such that any decent compiler should put x in   */
+/* a callee-save register with -O.  Thus it is is 	     */
+/* recommended that this be run optimized.  (If the machine  */
+/* has no callee-save registers, then the generic code is    */
+/* safe, but this will not be noticed by this piece of       */
+/* code.)						     */
+#include <stdio.h>
+#include <setjmp.h>
+#include <string.h>
+#include "gcconfig.h"
+
+#ifdef OS2
+/* GETPAGESIZE() is set to getpagesize() by default, but that	*/
+/* doesn't really exist, and the collector doesn't need it.	*/
+#define INCL_DOSFILEMGR
+#define INCL_DOSMISC
+#define INCL_DOSERRORS
+#include <os2.h>
+
+int
+getpagesize()
+{
+    ULONG result[1];
+    
+    if (DosQuerySysInfo(QSV_PAGE_SIZE, QSV_PAGE_SIZE,
+    		        (void *)result, sizeof(ULONG)) != NO_ERROR) {
+    	fprintf(stderr, "DosQuerySysInfo failed\n");
+    	result[0] = 4096;
+    }
+    return((int)(result[0]));
+}
+#endif
+
+struct {char a_a; char * a_b;} a;
+
+int * nested_sp()
+{
+    int dummy;
+    
+    return(&dummy);
+}
+
+main()
+{
+	int dummy;
+	long ps = GETPAGESIZE();
+	jmp_buf b;
+	register int x = (int)strlen("a");  /* 1, slightly disguised */
+	static int y = 0;
+
+	printf("This appears to be a %s running %s\n", MACH_TYPE, OS_TYPE);
+	if (nested_sp() < &dummy) {
+	  printf("Stack appears to grow down, which is the default.\n");
+	  printf("A good guess for STACKBOTTOM on this machine is 0x%lx.\n",
+	         ((unsigned long)(&dummy) + ps) & ~(ps-1));
+	} else {
+	  printf("Stack appears to grow up.\n");
+	  printf("Define STACK_GROWS_UP in gc_private.h\n");
+	  printf("A good guess for STACKBOTTOM on this machine is 0x%lx.\n",
+	         ((unsigned long)(&dummy) + ps) & ~(ps-1));
+	}
+	printf("Note that this may vary between machines of ostensibly\n");
+	printf("the same architecture (e.g. Sun 3/50s and 3/80s).\n");
+	printf("On many machines the value is not fixed.\n");
+	printf("A good guess for ALIGNMENT on this machine is %ld.\n",
+	       (unsigned long)(&(a.a_b))-(unsigned long)(&a));
+	
+	/* Encourage the compiler to keep x in a callee-save register */
+	x = 2*x-1;
+	printf("");
+	x = 2*x-1;
+	setjmp(b);
+	if (y == 1) {
+	    if (x == 2) {
+		printf("Generic mark_regs code probably wont work\n");
+#		if defined(SPARC) || defined(RS6000) || defined(VAX) || defined(MIPS) || defined(M68K) || defined(I386) || defined(NS32K) || defined(RT)
+		    printf("Assembly code supplied\n");
+#		else
+		    printf("Need assembly code\n");
+#		endif
+	    } else if (x == 1) {
+		printf("Generic mark_regs code may work\n");
+	    } else {
+		printf("Very strange setjmp implementation\n");
+	    }
+	}
+	y++;
+	x = 2;
+	if (y == 1) longjmp(b,1);
+	return(0);
+}
+
+int g(x)
+int x;
+{
+	return(x);
+}
diff --git a/src/gc/solaris_pthreads.c b/src/gc/solaris_pthreads.c
new file mode 100644
index 000000000..acbe1c909
--- /dev/null
+++ b/src/gc/solaris_pthreads.c
@@ -0,0 +1,180 @@
+/* 
+ * Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Support code for Solaris threads.  Provides functionality we wish Sun
+ * had provided.  Relies on some information we probably shouldn't rely on.
+ * Modified Peter C. for Solaris Posix Threads.
+ */
+/* Boehm, September 14, 1994 4:44 pm PDT */
+/* $Id$ */
+
+# if defined(_SOLARIS_PTHREADS)
+# include "gc_priv.h"
+# include <pthread.h>
+# include <thread.h>
+# include <signal.h>
+# include <fcntl.h>
+# include <sys/types.h>
+# include <sys/mman.h>
+# include <sys/time.h>
+# include <sys/resource.h>
+# include <sys/stat.h>
+# include <sys/syscall.h>
+# include <sys/procfs.h>
+# include <sys/lwp.h>
+# include <sys/reg.h>
+# define _CLASSIC_XOPEN_TYPES
+# include <unistd.h>
+# include <errno.h>
+# include "solaris_threads.h"
+# include <stdio.h>
+
+#undef pthread_join
+#undef pthread_create
+
+pthread_cond_t GC_prom_join_cv;		/* Broadcast when any thread terminates	*/
+pthread_cond_t GC_create_cv;		/* Signalled when a new undetached	*/
+				/* thread starts.			*/
+				
+extern GC_bool GC_multithreaded;
+
+/* We use the allocation lock to protect thread-related data structures. */
+
+/* We stop the world using /proc primitives.  This makes some	*/
+/* minimal assumptions about the threads implementation.	*/
+/* We don't play by the rules, since the rules make this	*/
+/* impossible (as of Solaris 2.3).  Also note that as of	*/
+/* Solaris 2.3 the various thread and lwp suspension		*/
+/* primitives failed to stop threads by the time the request	*/
+/* is completed.						*/
+
+
+
+int GC_pthread_join(pthread_t wait_for, void **status)
+{
+	return GC_thr_join((thread_t)wait_for, NULL, status);
+}
+
+
+int
+GC_pthread_create(pthread_t *new_thread,
+          const pthread_attr_t *attr_in,
+          void * (*thread_execp)(void *), void *arg)
+{
+    int result;
+    GC_thread t;
+    pthread_t my_new_thread;
+    pthread_attr_t  attr;
+    word my_flags = 0;
+    int  flag;
+    void * stack = 0;
+    size_t stack_size = 0;
+    int    n;
+    struct sched_param schedparam;
+   
+    (void)pthread_attr_init(&attr);
+    if (attr_in != 0) {
+	(void)pthread_attr_getstacksize(attr_in, &stack_size);
+	(void)pthread_attr_getstackaddr(attr_in, &stack);
+    }
+
+    LOCK();
+    if (!GC_thr_initialized) {
+	    GC_thr_init();
+    }
+    GC_multithreaded++;
+	    
+    if (stack == 0) {
+     	if (stack_size == 0)
+		stack_size = 1048576;
+			  /* ^-- 1 MB (this was GC_min_stack_sz, but that
+			   * violates the pthread_create documentation which
+			   * says the default value if none is supplied is
+			   * 1MB) */
+	else
+		stack_size += thr_min_stack();
+
+     	stack = (void *)GC_stack_alloc(&stack_size);
+     	if (stack == 0) {
+	    GC_multithreaded--;
+     	    UNLOCK();
+	    errno = ENOMEM;
+     	    return -1;
+     	}
+    } else {
+    	my_flags |= CLIENT_OWNS_STACK;
+    }
+    (void)pthread_attr_setstacksize(&attr, stack_size);
+    (void)pthread_attr_setstackaddr(&attr, stack);
+    if (attr_in != 0) {
+	(void)pthread_attr_getscope(attr_in, &n);
+	(void)pthread_attr_setscope(&attr, n);
+	(void)pthread_attr_getschedparam(attr_in, &schedparam);
+	(void)pthread_attr_setschedparam(&attr, &schedparam);
+	(void)pthread_attr_getschedpolicy(attr_in, &n);
+	(void)pthread_attr_setschedpolicy(&attr, n);
+	(void)pthread_attr_getinheritsched(attr_in, &n);
+	(void)pthread_attr_setinheritsched(&attr, n);
+
+	(void)pthread_attr_getdetachstate(attr_in, &flag);
+	if (flag == PTHREAD_CREATE_DETACHED) {
+		my_flags |= DETACHED;
+	}
+	(void)pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
+    }
+    /*
+     * thr_create can call malloc(), which if redirected will
+     * attempt to acquire the allocation lock.
+     * Unlock here to prevent deadlock.
+     */
+
+
+#if 0
+#ifdef I386
+    UNLOCK();
+#endif
+#endif
+    result = 
+	    pthread_create(&my_new_thread, &attr, thread_execp, arg);
+#if 0
+#ifdef I386
+    LOCK();
+#endif
+#endif
+    if (result == 0) {
+        t = GC_new_thread(my_new_thread);
+        t -> flags = my_flags;
+        if (!(my_flags & DETACHED)) cond_init(&(t->join_cv), USYNC_THREAD, 0);
+        t -> stack = stack;
+        t -> stack_size = stack_size;
+        if (new_thread != 0) *new_thread = my_new_thread;
+        pthread_cond_signal(&GC_create_cv);
+    } else {
+	    if (!(my_flags & CLIENT_OWNS_STACK)) {
+		    GC_stack_free(stack, stack_size);
+	    }        
+	    GC_multithreaded--;
+    }
+    UNLOCK();
+    pthread_attr_destroy(&attr);
+    return(result);
+}
+
+# else
+
+#ifndef LINT
+  int GC_no_sunOS_pthreads;
+#endif
+
+# endif /* SOLARIS_THREADS */
+
diff --git a/src/gc/solaris_threads.c b/src/gc/solaris_threads.c
new file mode 100644
index 000000000..c3b0b15b9
--- /dev/null
+++ b/src/gc/solaris_threads.c
@@ -0,0 +1,941 @@
+/* 
+ * Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Support code for Solaris threads.  Provides functionality we wish Sun
+ * had provided.  Relies on some information we probably shouldn't rely on.
+ */
+/* Boehm, September 14, 1994 4:44 pm PDT */
+
+# if defined(SOLARIS_THREADS)
+
+# include "gc_priv.h"
+# include "solaris_threads.h"
+# include <thread.h>
+# include <synch.h>
+# include <signal.h>
+# include <fcntl.h>
+# include <sys/types.h>
+# include <sys/mman.h>
+# include <sys/time.h>
+# include <sys/resource.h>
+# include <sys/stat.h>
+# include <sys/syscall.h>
+# include <sys/procfs.h>
+# include <sys/lwp.h>
+# include <sys/reg.h>
+# define _CLASSIC_XOPEN_TYPES
+# include <unistd.h>
+# include <errno.h>
+
+/*
+ * This is the default size of the LWP arrays. If there are more LWPs
+ * than this when a stop-the-world GC happens, set_max_lwps will be
+ * called to cope.
+ * This must be higher than the number of LWPs at startup time.
+ * The threads library creates a thread early on, so the min. is 3
+ */
+# define DEFAULT_MAX_LWPS	4
+
+#undef thr_join
+#undef thr_create
+#undef thr_suspend
+#undef thr_continue
+
+cond_t GC_prom_join_cv;		/* Broadcast when any thread terminates	*/
+cond_t GC_create_cv;		/* Signalled when a new undetached	*/
+				/* thread starts.			*/
+				
+
+#ifdef MMAP_STACKS
+static int GC_zfd;
+#endif /* MMAP_STACKS */
+
+/* We use the allocation lock to protect thread-related data structures. */
+
+/* We stop the world using /proc primitives.  This makes some	*/
+/* minimal assumptions about the threads implementation.	*/
+/* We don't play by the rules, since the rules make this	*/
+/* impossible (as of Solaris 2.3).  Also note that as of	*/
+/* Solaris 2.3 the various thread and lwp suspension		*/
+/* primitives failed to stop threads by the time the request	*/
+/* is completed.						*/
+
+
+static sigset_t old_mask;
+
+/* Sleep for n milliseconds, n < 1000	*/
+void GC_msec_sleep(int n)
+{
+    struct timespec ts;
+                            
+    ts.tv_sec = 0;
+    ts.tv_nsec = 1000000*n;
+    if (syscall(SYS_nanosleep, &ts, 0) < 0) {
+	ABORT("nanosleep failed");
+    }
+}
+/* Turn off preemption;  gross but effective.  		*/
+/* Caller has allocation lock.				*/
+/* Actually this is not needed under Solaris 2.3 and	*/
+/* 2.4, but hopefully that'll change.			*/
+void preempt_off()
+{
+    sigset_t set;
+
+    (void)sigfillset(&set);
+    sigdelset(&set, SIGABRT);
+    syscall(SYS_sigprocmask, SIG_SETMASK, &set, &old_mask);
+}
+
+void preempt_on()
+{
+    syscall(SYS_sigprocmask, SIG_SETMASK, &old_mask, NULL);
+}
+
+int GC_main_proc_fd = -1;
+
+
+struct lwp_cache_entry {
+    lwpid_t lc_id;
+    int lc_descr;	/* /proc file descriptor.	*/
+}  GC_lwp_cache_default[DEFAULT_MAX_LWPS];
+
+static int max_lwps = DEFAULT_MAX_LWPS;
+static struct lwp_cache_entry *GC_lwp_cache = GC_lwp_cache_default;
+
+static prgregset_t GC_lwp_registers_default[DEFAULT_MAX_LWPS];
+static prgregset_t *GC_lwp_registers = GC_lwp_registers_default;
+
+/* Return a file descriptor for the /proc entry corresponding	*/
+/* to the given lwp.  The file descriptor may be stale if the	*/
+/* lwp exited and a new one was forked.				*/
+static int open_lwp(lwpid_t id)
+{
+    int result;
+    static int next_victim = 0;
+    register int i;
+    
+    for (i = 0; i < max_lwps; i++) {
+    	if (GC_lwp_cache[i].lc_id == id) return(GC_lwp_cache[i].lc_descr);
+    }
+    result = syscall(SYS_ioctl, GC_main_proc_fd, PIOCOPENLWP, &id);
+    /*
+     * If PIOCOPENLWP fails, try closing fds in the cache until it succeeds.
+     */
+    if (result < 0 && errno == EMFILE) {
+	    for (i = 0; i < max_lwps; i++) {
+		if (GC_lwp_cache[i].lc_id != 0) {
+        		(void)syscall(SYS_close, GC_lwp_cache[i].lc_descr);
+			result = syscall(SYS_ioctl, GC_main_proc_fd, PIOCOPENLWP, &id);
+			if (result >= 0 || (result < 0 && errno != EMFILE))
+				break;
+		}
+	    }
+    }
+    if (result < 0) {
+	if (errno == EMFILE) {
+		ABORT("Too many open files");
+	}
+        return(-1) /* exited? */;
+    }
+    if (GC_lwp_cache[next_victim].lc_id != 0)
+        (void)syscall(SYS_close, GC_lwp_cache[next_victim].lc_descr);
+    GC_lwp_cache[next_victim].lc_id = id;
+    GC_lwp_cache[next_victim].lc_descr = result;
+    if (++next_victim >= max_lwps)
+	next_victim = 0;
+    return(result);
+}
+
+static void uncache_lwp(lwpid_t id)
+{
+    register int i;
+    
+    for (i = 0; i < max_lwps; i++) {
+    	if (GC_lwp_cache[i].lc_id == id) {
+    	    (void)syscall(SYS_close, GC_lwp_cache[id].lc_descr);
+    	    GC_lwp_cache[i].lc_id = 0;
+    	    break;
+    	}
+    }
+}
+	/* Sequence of current lwp ids	*/
+static lwpid_t GC_current_ids_default[DEFAULT_MAX_LWPS + 1];
+static lwpid_t *GC_current_ids = GC_current_ids_default;
+
+	/* Temporary used below (can be big if large number of LWPs) */
+static lwpid_t last_ids_default[DEFAULT_MAX_LWPS + 1];
+static lwpid_t *last_ids = last_ids_default;
+
+
+#define ROUNDUP(n)    WORDS_TO_BYTES(ROUNDED_UP_WORDS(n))
+
+static void set_max_lwps(GC_word n)
+{
+    char *mem;
+    char *oldmem;
+    int required_bytes = ROUNDUP(n * sizeof(struct lwp_cache_entry))
+	+ ROUNDUP(n * sizeof(prgregset_t))
+	+ ROUNDUP((n + 1) * sizeof(lwpid_t))
+	+ ROUNDUP((n + 1) * sizeof(lwpid_t));
+
+    GC_expand_hp_inner(divHBLKSZ((word)required_bytes));
+    oldmem = mem = GC_scratch_alloc(required_bytes);
+    if (0 == mem) ABORT("No space for lwp data structures");
+
+    /*
+     * We can either flush the old lwp cache or copy it over. Do the latter.
+     */
+    memcpy(mem, GC_lwp_cache, max_lwps * sizeof(struct lwp_cache_entry));
+    GC_lwp_cache = (struct lwp_cache_entry*)mem;
+    mem += ROUNDUP(n * sizeof(struct lwp_cache_entry));
+
+    BZERO(GC_lwp_registers, max_lwps * sizeof(GC_lwp_registers[0]));
+    GC_lwp_registers = (prgregset_t *)mem;
+    mem += ROUNDUP(n * sizeof(prgregset_t));
+
+
+    GC_current_ids = (lwpid_t *)mem;
+    mem += ROUNDUP((n + 1) * sizeof(lwpid_t));
+
+    last_ids = (lwpid_t *)mem;
+    mem += ROUNDUP((n + 1)* sizeof(lwpid_t));
+
+    if (mem > oldmem + required_bytes)
+	ABORT("set_max_lwps buffer overflow");
+
+    max_lwps = n;
+}
+
+
+/* Stop all lwps in process.  Assumes preemption is off.	*/
+/* Caller has allocation lock (and any other locks he may	*/
+/* need).							*/
+static void stop_all_lwps()
+{
+    int lwp_fd;
+    char buf[30];
+    prstatus_t status;
+    register int i;
+    GC_bool changed;
+    lwpid_t me = _lwp_self();
+
+    if (GC_main_proc_fd == -1) {
+    	sprintf(buf, "/proc/%d", getpid());
+    	GC_main_proc_fd = syscall(SYS_open, buf, O_RDONLY);
+        if (GC_main_proc_fd < 0) {
+		if (errno == EMFILE)
+			ABORT("/proc open failed: too many open files");
+		GC_printf1("/proc open failed: errno %d", errno);
+		abort();
+        }
+    }
+    BZERO(GC_lwp_registers, sizeof (prgregset_t) * max_lwps);
+    for (i = 0; i < max_lwps; i++)
+	last_ids[i] = 0;
+    for (;;) {
+    if (syscall(SYS_ioctl, GC_main_proc_fd, PIOCSTATUS, &status) < 0)
+    	ABORT("Main PIOCSTATUS failed");
+    	if (status.pr_nlwp < 1)
+    		ABORT("Invalid number of lwps returned by PIOCSTATUS");
+    	if (status.pr_nlwp >= max_lwps) {
+    		set_max_lwps(status.pr_nlwp*2 + 10);
+		/*
+		 * The data in the old GC_current_ids and
+		 * GC_lwp_registers has been trashed. Cleaning out last_ids
+		 * will make sure every LWP gets re-examined.
+		 */
+        	for (i = 0; i < max_lwps; i++)
+			last_ids[i] = 0;
+		continue;
+    }
+        if (syscall(SYS_ioctl, GC_main_proc_fd, PIOCLWPIDS, GC_current_ids) < 0)
+            ABORT("PIOCLWPIDS failed");
+        changed = FALSE;
+        for (i = 0; GC_current_ids[i] != 0 && i < max_lwps; i++) {
+            if (GC_current_ids[i] != last_ids[i]) {
+                changed = TRUE;
+                if (GC_current_ids[i] != me) {
+		    /* PIOCSTOP doesn't work without a writable		*/
+		    /* descriptor.  And that makes the process		*/
+		    /* undebuggable.					*/
+                    if (_lwp_suspend(GC_current_ids[i]) < 0) {
+                        /* Could happen if the lwp exited */
+                        uncache_lwp(GC_current_ids[i]);
+                        GC_current_ids[i] = me; /* ignore */
+                    }
+                }
+            }
+        }
+        /*
+         * In the unlikely event something does a fork between the
+	 * PIOCSTATUS and the PIOCLWPIDS. 
+         */
+        if (i >= max_lwps)
+		continue;
+        /* All lwps in GC_current_ids != me have been suspended.  Note	*/
+        /* that _lwp_suspend is idempotent.				*/
+        for (i = 0; GC_current_ids[i] != 0; i++) {
+            if (GC_current_ids[i] != last_ids[i]) {
+                if (GC_current_ids[i] != me) {
+                    lwp_fd = open_lwp(GC_current_ids[i]);
+		    if (lwp_fd == -1)
+		    {
+			    GC_current_ids[i] = me;
+			    continue;
+		    }
+		    /* LWP should be stopped.  Empirically it sometimes	*/
+		    /* isn't, and more frequently the PR_STOPPED flag	*/
+		    /* is not set.  Wait for PR_STOPPED.		*/
+                    if (syscall(SYS_ioctl, lwp_fd,
+                                PIOCSTATUS, &status) < 0) {
+			/* Possible if the descriptor was stale, or */
+			/* we encountered the 2.3 _lwp_suspend bug. */
+			uncache_lwp(GC_current_ids[i]);
+                        GC_current_ids[i] = me; /* handle next time. */
+                    } else {
+                        while (!(status.pr_flags & PR_STOPPED)) {
+                            GC_msec_sleep(1);
+			    if (syscall(SYS_ioctl, lwp_fd,
+				    	PIOCSTATUS, &status) < 0) {
+                            	ABORT("Repeated PIOCSTATUS failed");
+			    }
+			    if (status.pr_flags & PR_STOPPED) break;
+			    
+			    GC_msec_sleep(20);
+			    if (syscall(SYS_ioctl, lwp_fd,
+				    	PIOCSTATUS, &status) < 0) {
+                            	ABORT("Repeated PIOCSTATUS failed");
+			    }
+                        }
+                        if (status.pr_who !=  GC_current_ids[i]) {
+				/* can happen if thread was on death row */
+				uncache_lwp(GC_current_ids[i]);
+				GC_current_ids[i] = me; /* handle next time. */
+				continue;	
+                        }
+                        /* Save registers where collector can */
+			/* find them.			  */
+			    BCOPY(status.pr_reg, GC_lwp_registers[i],
+				  sizeof (prgregset_t));
+                    }
+                }
+            }
+        }
+        if (!changed) break;
+        for (i = 0; i < max_lwps; i++) last_ids[i] = GC_current_ids[i];
+    }
+}
+
+/* Restart all lwps in process.  Assumes preemption is off.	*/
+static void restart_all_lwps()
+{
+    int lwp_fd;
+    register int i;
+    GC_bool changed;
+    lwpid_t me = _lwp_self();
+#   define PARANOID
+
+    for (i = 0; GC_current_ids[i] != 0; i++) {
+#	ifdef PARANOID
+	  if (GC_current_ids[i] != me) {
+	    int lwp_fd = open_lwp(GC_current_ids[i]);
+	    prstatus_t status;
+	    
+	    if (lwp_fd < 0) ABORT("open_lwp failed");
+	    if (syscall(SYS_ioctl, lwp_fd,
+			PIOCSTATUS, &status) < 0) {
+                ABORT("PIOCSTATUS failed in restart_all_lwps");
+	    }
+	    if (memcmp(status.pr_reg, GC_lwp_registers[i],
+		       sizeof (prgregset_t)) != 0) {
+		    int j;
+
+		    for(j = 0; j < NGREG; j++)
+		    {
+			    GC_printf3("%i: %x -> %x\n", j,
+				       GC_lwp_registers[i][j],
+				       status.pr_reg[j]);
+		    }
+		ABORT("Register contents changed");
+	    }
+	    if (!status.pr_flags & PR_STOPPED) {
+	    	ABORT("lwp no longer stopped");
+	    }
+#ifdef SPARC
+	    {
+		    gwindows_t windows;
+	      if (syscall(SYS_ioctl, lwp_fd,
+			PIOCGWIN, &windows) < 0) {
+                ABORT("PIOCSTATUS failed in restart_all_lwps");
+	      }
+	      if (windows.wbcnt > 0) ABORT("unsaved register windows");
+	    }
+#endif
+	  }
+#	endif /* PARANOID */
+	if (GC_current_ids[i] == me) continue;
+        if (_lwp_continue(GC_current_ids[i]) < 0) {
+            ABORT("Failed to restart lwp");
+        }
+    }
+    if (i >= max_lwps) ABORT("Too many lwps");
+}
+
+GC_bool GC_multithreaded = 0;
+
+void GC_stop_world()
+{
+    preempt_off();
+    if (GC_multithreaded)
+        stop_all_lwps();
+}
+
+void GC_start_world()
+{
+    if (GC_multithreaded)
+        restart_all_lwps();
+    preempt_on();
+}
+
+void GC_thr_init(void);
+
+GC_bool GC_thr_initialized = FALSE;
+
+size_t GC_min_stack_sz;
+
+size_t GC_page_sz;
+
+/*
+ * stack_head is stored at the top of free stacks
+ */
+struct stack_head {
+	struct stack_head	*next;
+	ptr_t			base;
+	thread_t		owner;
+};
+
+# define N_FREE_LISTS 25
+struct stack_head *GC_stack_free_lists[N_FREE_LISTS] = { 0 };
+		/* GC_stack_free_lists[i] is free list for stacks of 	*/
+		/* size GC_min_stack_sz*2**i.				*/
+		/* Free lists are linked through stack_head stored	*/			/* at top of stack.					*/
+
+/* Return a stack of size at least *stack_size.  *stack_size is	*/
+/* replaced by the actual stack size.				*/
+/* Caller holds allocation lock.				*/
+ptr_t GC_stack_alloc(size_t * stack_size)
+{
+    register size_t requested_sz = *stack_size;
+    register size_t search_sz = GC_min_stack_sz;
+    register int index = 0;	/* = log2(search_sz/GC_min_stack_sz) */
+    register ptr_t base;
+    register struct stack_head *result;
+    
+    while (search_sz < requested_sz) {
+        search_sz *= 2;
+        index++;
+    }
+    if ((result = GC_stack_free_lists[index]) == 0
+        && (result = GC_stack_free_lists[index+1]) != 0) {
+        /* Try next size up. */
+        search_sz *= 2; index++;
+    }
+    if (result != 0) {
+        base =  GC_stack_free_lists[index]->base;
+        GC_stack_free_lists[index] = GC_stack_free_lists[index]->next;
+    } else {
+#ifdef MMAP_STACKS
+        base = (ptr_t)mmap(0, search_sz + GC_page_sz,
+			     PROT_READ|PROT_WRITE, MAP_PRIVATE |MAP_NORESERVE,
+			     GC_zfd, 0);
+	if (base == (ptr_t)-1)
+	{
+		*stack_size = 0;
+		return NULL;
+	}
+
+	mprotect(base, GC_page_sz, PROT_NONE);
+	/* Should this use divHBLKSZ(search_sz + GC_page_sz) ? -- cf */
+	GC_is_fresh((struct hblk *)base, divHBLKSZ(search_sz));
+	base += GC_page_sz;
+
+#else
+        base = (ptr_t) GC_scratch_alloc(search_sz + 2*GC_page_sz);
+	if (base == NULL)
+	{
+		*stack_size = 0;
+		return NULL;
+	}
+
+        base = (ptr_t)(((word)base + GC_page_sz) & ~(GC_page_sz - 1));
+        /* Protect hottest page to detect overflow. */
+#	ifdef SOLARIS23_MPROTECT_BUG_FIXED
+            mprotect(base, GC_page_sz, PROT_NONE);
+#	endif
+        GC_is_fresh((struct hblk *)base, divHBLKSZ(search_sz));
+
+        base += GC_page_sz;
+#endif
+    }
+    *stack_size = search_sz;
+    return(base);
+}
+
+/* Caller holds  allocationlock.					*/
+void GC_stack_free(ptr_t stack, size_t size)
+{
+    register int index = 0;
+    register size_t search_sz = GC_min_stack_sz;
+    register struct stack_head *head;
+    
+#ifdef MMAP_STACKS
+    /* Zero pointers */
+    mmap(stack, size, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_NORESERVE|MAP_FIXED,
+	 GC_zfd, 0);
+#endif
+    while (search_sz < size) {
+        search_sz *= 2;
+        index++;
+    }
+    if (search_sz != size) ABORT("Bad stack size");
+
+    head = (struct stack_head *)(stack + search_sz - sizeof(struct stack_head));
+    head->next = GC_stack_free_lists[index];
+    head->base = stack;
+    GC_stack_free_lists[index] = head;
+}
+
+void GC_my_stack_limits();
+
+/* Notify virtual dirty bit implementation that known empty parts of	*/
+/* stacks do not contain useful data.					*/ 
+/* Caller holds allocation lock.					*/
+void GC_old_stacks_are_fresh()
+{
+/* No point in doing this for MMAP stacks - and pointers are zero'd out */
+/* by the mmap in GC_stack_free */
+#ifndef MMAP_STACKS
+    register int i;
+    register struct stack_head *s;
+    register ptr_t p;
+    register size_t sz;
+    register struct hblk * h;
+    int dummy;
+    
+    for (i = 0, sz= GC_min_stack_sz; i < N_FREE_LISTS;
+         i++, sz *= 2) {
+         for (s = GC_stack_free_lists[i]; s != 0; s = s->next) {
+             p = s->base;
+             h = (struct hblk *)(((word)p + HBLKSIZE-1) & ~(HBLKSIZE-1));
+             if ((ptr_t)h == p) {
+                 GC_is_fresh((struct hblk *)p, divHBLKSZ(sz));
+             } else {
+                 GC_is_fresh((struct hblk *)p, divHBLKSZ(sz) - 1);
+                 BZERO(p, (ptr_t)h - p);
+             }
+         }
+    }
+#endif /* MMAP_STACKS */
+    GC_my_stack_limits();
+}
+
+/* The set of all known threads.  We intercept thread creation and 	*/
+/* joins.  We never actually create detached threads.  We allocate all 	*/
+/* new thread stacks ourselves.  These allow us to maintain this	*/
+/* data structure.							*/
+
+# define THREAD_TABLE_SZ 128	/* Must be power of 2	*/
+volatile GC_thread GC_threads[THREAD_TABLE_SZ];
+
+/* Add a thread to GC_threads.  We assume it wasn't already there.	*/
+/* Caller holds allocation lock.					*/
+GC_thread GC_new_thread(thread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    GC_thread result;
+    static struct GC_Thread_Rep first_thread;
+    static GC_bool first_thread_used = FALSE;
+    
+    if (!first_thread_used) {
+    	result = &first_thread;
+    	first_thread_used = TRUE;
+    	/* Dont acquire allocation lock, since we may already hold it. */
+    } else {
+        result = (struct GC_Thread_Rep *)
+        	 GC_generic_malloc_inner(sizeof(struct GC_Thread_Rep), NORMAL);
+    }
+    if (result == 0) return(0);
+    result -> id = id;
+    result -> next = GC_threads[hv];
+    GC_threads[hv] = result;
+    /* result -> finished = 0; */
+    (void) cond_init(&(result->join_cv), USYNC_THREAD, 0);
+    return(result);
+}
+
+/* Delete a thread from GC_threads.  We assume it is there.	*/
+/* (The code intentionally traps if it wasn't.)			*/
+/* Caller holds allocation lock.				*/
+void GC_delete_thread(thread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    register GC_thread prev = 0;
+    
+    while (p -> id != id) {
+        prev = p;
+        p = p -> next;
+    }
+    if (prev == 0) {
+        GC_threads[hv] = p -> next;
+    } else {
+        prev -> next = p -> next;
+    }
+}
+
+/* Return the GC_thread correpsonding to a given thread_t.	*/
+/* Returns 0 if it's not there.					*/
+/* Caller holds  allocation lock.				*/
+GC_thread GC_lookup_thread(thread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    
+    while (p != 0 && p -> id != id) p = p -> next;
+    return(p);
+}
+
+# define MAX_ORIG_STACK_SIZE (8 * 1024 * 1024)
+
+word GC_get_orig_stack_size() {
+    struct rlimit rl;
+    static int warned = 0;
+    int result;
+
+    if (getrlimit(RLIMIT_STACK, &rl) != 0) ABORT("getrlimit failed");
+    result = (word)rl.rlim_cur & ~(HBLKSIZE-1);
+    if (result > MAX_ORIG_STACK_SIZE) {
+	if (!warned) {
+	    WARN("Large stack limit(%ld): only scanning 8 MB", result);
+	    warned = 1;
+	}
+	result = MAX_ORIG_STACK_SIZE;
+    }
+    return result;
+}
+
+/* Notify dirty bit implementation of unused parts of my stack. */
+/* Caller holds allocation lock.				*/
+void GC_my_stack_limits()
+{
+    int dummy;
+    register ptr_t hottest = (ptr_t)((word)(&dummy) & ~(HBLKSIZE-1));
+    register GC_thread me = GC_lookup_thread(thr_self());
+    register size_t stack_size = me -> stack_size;
+    register ptr_t stack;
+    
+    if (stack_size == 0) {
+      /* original thread */
+        /* Empirically, what should be the stack page with lowest	*/
+        /* address is actually inaccessible.				*/
+        stack_size = GC_get_orig_stack_size() - GC_page_sz;
+        stack = GC_stackbottom - stack_size + GC_page_sz;
+    } else {
+        stack = me -> stack;
+    }
+    if (stack > hottest || stack + stack_size < hottest) {
+    	ABORT("sp out of bounds");
+    }
+    GC_is_fresh((struct hblk *)stack, divHBLKSZ(hottest - stack));
+}
+
+
+/* We hold allocation lock.  Should do exactly the right thing if the	*/
+/* world is stopped.  Should not fail if it isn't.			*/
+void GC_push_all_stacks()
+{
+    register int i;
+    register GC_thread p;
+    register ptr_t sp = GC_approx_sp();
+    register ptr_t bottom, top;
+    struct rlimit rl;
+    
+#   define PUSH(bottom,top) \
+      if (GC_dirty_maintained) { \
+	GC_push_dirty((bottom), (top), GC_page_was_ever_dirty, \
+		      GC_push_all_stack); \
+      } else { \
+        GC_push_all_stack((bottom), (top)); \
+      }
+    GC_push_all_stack((ptr_t)GC_lwp_registers,
+		      (ptr_t)GC_lwp_registers
+		      + max_lwps * sizeof(GC_lwp_registers[0]));
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> stack_size != 0) {
+            bottom = p -> stack;
+            top = p -> stack + p -> stack_size;
+        } else {
+            /* The original stack. */
+            bottom = GC_stackbottom - GC_get_orig_stack_size() + GC_page_sz;
+            top = GC_stackbottom;
+        }
+        if ((word)sp > (word)bottom && (word)sp < (word)top) bottom = sp;
+        PUSH(bottom, top);
+      }
+    }
+}
+
+
+int GC_is_thread_stack(ptr_t addr)
+{
+    register int i;
+    register GC_thread p;
+    register ptr_t bottom, top;
+    struct rlimit rl;
+    
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> stack_size != 0) {
+            if (p -> stack <= addr &&
+		addr < p -> stack + p -> stack_size)
+		    return 1;
+	}
+      }
+    }
+}
+
+/* The only thread that ever really performs a thr_join.	*/
+void * GC_thr_daemon(void * dummy)
+{
+    void *status;
+    thread_t departed;
+    register GC_thread t;
+    register int i;
+    register int result;
+    
+    for(;;) {
+      start:
+        result = thr_join((thread_t)0, &departed, &status);
+    	LOCK();
+    	if (result != 0) {
+    	    /* No more threads; wait for create. */
+    	    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+    	        for (t = GC_threads[i]; t != 0; t = t -> next) {
+                    if (!(t -> flags & (DETACHED | FINISHED))) {
+                      UNLOCK();
+                      goto start; /* Thread started just before we */
+                      		  /* acquired the lock.		   */
+                    }
+                }
+            }
+            cond_wait(&GC_create_cv, &GC_allocate_ml);
+            UNLOCK();
+    	} else {
+    	    t = GC_lookup_thread(departed);
+	    GC_multithreaded--;
+    	    if (!(t -> flags & CLIENT_OWNS_STACK)) {
+    	    	GC_stack_free(t -> stack, t -> stack_size);
+    	    }
+    	    if (t -> flags & DETACHED) {
+    	    	GC_delete_thread(departed);
+    	    } else {
+    	        t -> status = status;
+    	    	t -> flags |= FINISHED;
+    	    	cond_signal(&(t -> join_cv));
+    	    	cond_broadcast(&GC_prom_join_cv);
+    	    }
+    	    UNLOCK();
+    	}
+    }
+}
+
+/* We hold the allocation lock, or caller ensures that 2 instances	*/
+/* cannot be invoked concurrently.					*/
+void GC_thr_init(void)
+{
+    GC_thread t;
+    thread_t tid;
+
+    if (GC_thr_initialized)
+	    return;
+    GC_thr_initialized = TRUE;
+    GC_min_stack_sz = ((thr_min_stack() + 32*1024 + HBLKSIZE-1)
+    		       & ~(HBLKSIZE - 1));
+    GC_page_sz = sysconf(_SC_PAGESIZE);
+#ifdef MMAP_STACKS
+    GC_zfd = open("/dev/zero", O_RDONLY);
+    if (GC_zfd == -1)
+	    ABORT("Can't open /dev/zero");
+#endif /* MMAP_STACKS */
+    cond_init(&GC_prom_join_cv, USYNC_THREAD, 0);
+    cond_init(&GC_create_cv, USYNC_THREAD, 0);
+    /* Add the initial thread, so we can stop it.	*/
+      t = GC_new_thread(thr_self());
+      t -> stack_size = 0;
+      t -> flags = DETACHED | CLIENT_OWNS_STACK;
+    if (thr_create(0 /* stack */, 0 /* stack_size */, GC_thr_daemon,
+    		   0 /* arg */, THR_DETACHED | THR_DAEMON,
+    		   &tid /* thread_id */) != 0) {
+    	ABORT("Cant fork daemon");
+    }
+    thr_setprio(tid, 126);
+}
+
+/* We acquire the allocation lock to prevent races with 	*/
+/* stopping/starting world.					*/
+/* This is no more correct than the underlying Solaris 2.X	*/
+/* implementation.  Under 2.3 THIS IS BROKEN.			*/
+int GC_thr_suspend(thread_t target_thread)
+{
+    GC_thread t;
+    int result;
+    
+    LOCK();
+    result = thr_suspend(target_thread);
+    if (result == 0) {
+    	t = GC_lookup_thread(target_thread);
+    	if (t == 0) ABORT("thread unknown to GC");
+        t -> flags |= SUSPENDED;
+    }
+    UNLOCK();
+    return(result);
+}
+
+int GC_thr_continue(thread_t target_thread)
+{
+    GC_thread t;
+    int result;
+    
+    LOCK();
+    result = thr_continue(target_thread);
+    if (result == 0) {
+    	t = GC_lookup_thread(target_thread);
+    	if (t == 0) ABORT("thread unknown to GC");
+        t -> flags &= ~SUSPENDED;
+    }
+    UNLOCK();
+    return(result);
+}
+
+int GC_thr_join(thread_t wait_for, thread_t *departed, void **status)
+{
+    register GC_thread t;
+    int result = 0;
+    
+    LOCK();
+    if (wait_for == 0) {
+        register int i;
+        register GC_bool thread_exists;
+    
+    	for (;;) {
+    	  thread_exists = FALSE;
+    	  for (i = 0; i < THREAD_TABLE_SZ; i++) {
+    	    for (t = GC_threads[i]; t != 0; t = t -> next) {
+              if (!(t -> flags & DETACHED)) {
+                if (t -> flags & FINISHED) {
+                  goto found;
+                }
+                thread_exists = TRUE;
+              }
+            }
+          }
+          if (!thread_exists) {
+              result = ESRCH;
+    	      goto out;
+          }
+          cond_wait(&GC_prom_join_cv, &GC_allocate_ml);
+        }
+    } else {
+        t = GC_lookup_thread(wait_for);
+    	if (t == 0 || t -> flags & DETACHED) {
+    	    result = ESRCH;
+    	    goto out;
+    	}
+    	if (wait_for == thr_self()) {
+    	    result = EDEADLK;
+    	    goto out;
+    	}
+    	while (!(t -> flags & FINISHED)) {
+            cond_wait(&(t -> join_cv), &GC_allocate_ml);
+    	}
+    	
+    }
+  found:
+    if (status) *status = t -> status;
+    if (departed) *departed = t -> id;
+    cond_destroy(&(t -> join_cv));
+    GC_delete_thread(t -> id);
+  out:
+    UNLOCK();
+    return(result);
+}
+
+
+int
+GC_thr_create(void *stack_base, size_t stack_size,
+              void *(*start_routine)(void *), void *arg, long flags,
+              thread_t *new_thread)
+{
+    int result;
+    GC_thread t;
+    thread_t my_new_thread;
+    word my_flags = 0;
+    void * stack = stack_base;
+   
+    LOCK();
+    if (!GC_thr_initialized)
+    {
+    GC_thr_init();
+    }
+    GC_multithreaded++;
+    if (stack == 0) {
+     	if (stack_size == 0) stack_size = 1024*1024;
+     	stack = (void *)GC_stack_alloc(&stack_size);
+     	if (stack == 0) {
+	    GC_multithreaded--;
+     	    UNLOCK();
+     	    return(ENOMEM);
+     	}
+    } else {
+    	my_flags |= CLIENT_OWNS_STACK;
+    }
+    if (flags & THR_DETACHED) my_flags |= DETACHED;
+    if (flags & THR_SUSPENDED) my_flags |= SUSPENDED;
+    result = thr_create(stack, stack_size, start_routine,
+   		        arg, flags & ~THR_DETACHED, &my_new_thread);
+    if (result == 0) {
+        t = GC_new_thread(my_new_thread);
+        t -> flags = my_flags;
+        if (!(my_flags & DETACHED)) cond_init(&(t -> join_cv), USYNC_THREAD, 0);
+        t -> stack = stack;
+        t -> stack_size = stack_size;
+        if (new_thread != 0) *new_thread = my_new_thread;
+        cond_signal(&GC_create_cv);
+    } else {
+	GC_multithreaded--;
+        if (!(my_flags & CLIENT_OWNS_STACK)) {
+      	    GC_stack_free(stack, stack_size);
+	}
+    }        
+    UNLOCK();  
+    return(result);
+}
+
+# else /* SOLARIS_THREADS */
+
+#ifndef LINT
+  int GC_no_sunOS_threads;
+#endif
+#endif
diff --git a/src/gc/solaris_threads.h b/src/gc/solaris_threads.h
new file mode 100644
index 000000000..b2cdb36e9
--- /dev/null
+++ b/src/gc/solaris_threads.h
@@ -0,0 +1,34 @@
+#ifdef SOLARIS_THREADS
+
+/* The set of all known threads.  We intercept thread creation and     */
+/* joins.  We never actually create detached threads.  We allocate all */
+/* new thread stacks ourselves.  These allow us to maintain this       */
+/* data structure.                                                     */
+/* Protected by GC_thr_lock.                                           */
+/* Some of this should be declared volatile, but that's incosnsistent  */
+/* with some library routine declarations.  In particular, the 	       */
+/* definition of cond_t doesn't mention volatile!                      */
+  typedef struct GC_Thread_Rep {
+    struct GC_Thread_Rep * next;
+    thread_t id;
+    word flags;
+#      define FINISHED 1       /* Thread has exited.   */
+#      define DETACHED 2       /* Thread is intended to be detached.   */
+#      define CLIENT_OWNS_STACK        4
+                               /* Stack was supplied by client.        */
+#      define SUSPENDED 8      /* Currently suspended. */
+    ptr_t stack;
+    size_t stack_size;
+    cond_t join_cv;
+    void * status;
+  } * GC_thread;
+  extern GC_thread GC_new_thread(thread_t id);
+
+  extern GC_bool GC_thr_initialized;
+  extern volatile GC_thread GC_threads[];
+  extern size_t GC_min_stack_sz;
+  extern size_t GC_page_sz;
+  extern void GC_thr_init(void);
+
+# endif /* SOLARIS_THREADS */
+
diff --git a/src/gc/sparc_mach_dep.s b/src/gc/sparc_mach_dep.s
new file mode 100644
index 000000000..9831c6ca4
--- /dev/null
+++ b/src/gc/sparc_mach_dep.s
@@ -0,0 +1,38 @@
+!	SPARCompiler 3.0 and later apparently no longer handles
+!	asm outside functions.  So we need a separate .s file
+!	This is only set up for SunOS 5, not SunOS 4.
+!	Assumes this is called before the stack contents are
+!	examined.
+
+	.seg 	"text"
+	.globl	GC_save_regs_in_stack
+	.globl 	GC_push_regs
+GC_save_regs_in_stack:
+GC_push_regs:
+	ta	0x3   ! ST_FLUSH_WINDOWS
+	mov	%sp,%o0
+	retl
+	nop
+	
+	.globl	GC_clear_stack_inner
+GC_clear_stack_inner:
+	mov	%sp,%o2		! Save sp
+	add	%sp,-8,%o3	! p = sp-8
+	clr	%g1		! [g0,g1] = 0
+	add	%o1,-0x60,%sp	! Move sp out of the way,
+				! so that traps still work.
+				! Includes some extra words
+				! so we can be sloppy below.
+loop:
+	std	%g0,[%o3]	! *(long long *)p = 0
+	cmp	%o3,%o1
+	bgu	loop		! if (p > limit) goto loop
+	  add	%o3,-8,%o3	! p -= 8 (delay slot)
+	retl
+	  mov	%o2,%sp		! Restore sp., delay slot
+	
+		
+		
+		
+		
+	
diff --git a/src/gc/sparc_sunos4_mach_dep.s b/src/gc/sparc_sunos4_mach_dep.s
new file mode 100644
index 000000000..41858073e
--- /dev/null
+++ b/src/gc/sparc_sunos4_mach_dep.s
@@ -0,0 +1,38 @@
+!	SPARCompiler 3.0 and later apparently no longer handles
+!	asm outside functions.  So we need a separate .s file
+!	This is only set up for SunOS 4.
+!	Assumes this is called before the stack contents are
+!	examined.
+
+	.seg 	"text"
+	.globl	_GC_save_regs_in_stack
+	.globl 	_GC_push_regs
+_GC_save_regs_in_stack:
+_GC_push_regs:
+	ta	0x3   ! ST_FLUSH_WINDOWS
+	mov	%sp,%o0
+	retl
+	nop
+	
+	.globl	_GC_clear_stack_inner
+_GC_clear_stack_inner:
+	mov	%sp,%o2		! Save sp
+	add	%sp,-8,%o3	! p = sp-8
+	clr	%g1		! [g0,g1] = 0
+	add	%o1,-0x60,%sp	! Move sp out of the way,
+				! so that traps still work.
+				! Includes some extra words
+				! so we can be sloppy below.
+loop:
+	std	%g0,[%o3]	! *(long long *)p = 0
+	cmp	%o3,%o1
+	bgu	loop		! if (p > limit) goto loop
+	  add	%o3,-8,%o3	! p -= 8 (delay slot)
+	retl
+	  mov	%o2,%sp		! Restore sp., delay slot
+	
+		
+		
+		
+		
+	
diff --git a/src/gc/stubborn.c b/src/gc/stubborn.c
new file mode 100644
index 000000000..bef7b98a4
--- /dev/null
+++ b/src/gc/stubborn.c
@@ -0,0 +1,317 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, July 31, 1995 5:02 pm PDT */
+
+
+#include "gc_priv.h"
+
+# ifdef STUBBORN_ALLOC
+/* Stubborn object (hard to change, nearly immutable) allocation. */
+
+extern ptr_t GC_clear_stack();	/* in misc.c, behaves like identity */
+
+#define GENERAL_MALLOC(lb,k) \
+    (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
+
+/* Data structure representing immutable objects that 	*/
+/* are still being initialized.				*/
+/* This is a bit baroque in order to avoid acquiring	*/
+/* the lock twice for a typical allocation.		*/
+
+GC_PTR * GC_changing_list_start;
+
+# ifdef THREADS
+  VOLATILE GC_PTR * VOLATILE GC_changing_list_current;
+# else
+  GC_PTR * GC_changing_list_current;
+# endif
+	/* Points at last added element.  Also (ab)used for		*/
+	/* synchronization.  Updates and reads are assumed atomic.	*/
+
+GC_PTR * GC_changing_list_limit;
+	/* Points at the last word of the buffer, which is always 0	*/
+	/* All entries in (GC_changing_list_current,			*/
+	/* GC_changing_list_limit] are 0				*/
+
+
+void GC_stubborn_init()
+{
+#   define INIT_SIZE 10
+
+    GC_changing_list_start = (GC_PTR *)
+    			GC_generic_malloc_inner(
+    				(word)(INIT_SIZE * sizeof(GC_PTR)),
+    				PTRFREE);
+    BZERO(GC_changing_list_start,
+    	  INIT_SIZE * sizeof(GC_PTR));
+    if (GC_changing_list_start == 0) {
+        GC_err_printf0("Insufficient space to start up\n");
+        ABORT("GC_stubborn_init: put of space");
+    }
+    GC_changing_list_current = GC_changing_list_start;
+    GC_changing_list_limit = GC_changing_list_start + INIT_SIZE - 1;
+    * GC_changing_list_limit = 0;
+}
+
+/* Compact and possibly grow GC_uninit_list.  The old copy is		*/
+/* left alone.	Lock must be held.					*/
+/* When called GC_changing_list_current == GC_changing_list_limit	*/
+/* which is one past the current element.				*/
+/* When we finish GC_changing_list_current again points one past last	*/
+/* element.								*/
+/* Invariant while this is running: GC_changing_list_current    	*/
+/* points at a word containing 0.					*/
+/* Returns FALSE on failure.						*/
+GC_bool GC_compact_changing_list()
+{
+    register GC_PTR *p, *q;
+    register word count = 0;
+    word old_size = (char **)GC_changing_list_limit
+    		    - (char **)GC_changing_list_start+1;
+    		    /* The casts are needed as a workaround for an Amiga bug */
+    register word new_size = old_size;
+    GC_PTR * new_list;
+    
+    for (p = GC_changing_list_start; p < GC_changing_list_limit; p++) {
+        if (*p != 0) count++;
+    }
+    if (2 * count > old_size) new_size = 2 * count;
+    new_list = (GC_PTR *)
+    		GC_generic_malloc_inner(
+    				new_size * sizeof(GC_PTR), PTRFREE);
+    		/* PTRFREE is a lie.  But we don't want the collector to  */
+    		/* consider these.  We do want the list itself to be  	  */
+    		/* collectable.						  */
+    if (new_list == 0) return(FALSE);
+    BZERO(new_list, new_size * sizeof(GC_PTR));
+    q = new_list;
+    for (p = GC_changing_list_start; p < GC_changing_list_limit; p++) {
+        if (*p != 0) *q++ = *p;
+    }
+    GC_changing_list_start = new_list;
+    GC_changing_list_limit = new_list + new_size - 1;
+    GC_changing_list_current = q;
+    return(TRUE);
+}
+
+/* Add p to changing list.  Clear p on failure.	*/
+# define ADD_CHANGING(p) \
+	{	\
+	    register struct hblk * h = HBLKPTR(p);	\
+	    register word index = PHT_HASH(h);	\
+	    \
+	    set_pht_entry_from_index(GC_changed_pages, index);	\
+	}	\
+	if (*GC_changing_list_current != 0 \
+	    && ++GC_changing_list_current == GC_changing_list_limit) { \
+	    if (!GC_compact_changing_list()) (p) = 0; \
+	} \
+	*GC_changing_list_current = p;
+
+void GC_change_stubborn(p)
+GC_PTR p;
+{
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    ADD_CHANGING(p);
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+
+void GC_end_stubborn_change(p)
+GC_PTR p;
+{
+#   ifdef THREADS
+      register VOLATILE GC_PTR * my_current = GC_changing_list_current;
+#   else
+      register GC_PTR * my_current = GC_changing_list_current;
+#   endif
+    register GC_bool tried_quick;
+    DCL_LOCK_STATE;
+    
+    if (*my_current == p) {
+        /* Hopefully the normal case.					*/
+        /* Compaction could not have been running when we started.	*/
+        *my_current = 0;
+#	ifdef THREADS
+          if (my_current == GC_changing_list_current) {
+            /* Compaction can't have run in the interim. 	*/
+            /* We got away with the quick and dirty approach.   */
+            return;
+          }
+          tried_quick = TRUE;
+#	else
+	  return;
+#	endif
+    } else {
+        tried_quick = FALSE;
+    }
+    DISABLE_SIGNALS();
+    LOCK();
+    my_current = GC_changing_list_current;
+    for (; my_current >= GC_changing_list_start; my_current--) {
+        if (*my_current == p) {
+            *my_current = 0;
+            UNLOCK();
+            ENABLE_SIGNALS();
+            return;
+        }
+    }
+    if (!tried_quick) {
+        GC_err_printf1("Bad arg to GC_end_stubborn_change: 0x%lx\n",
+        	       (unsigned long)p);
+        ABORT("Bad arg to GC_end_stubborn_change");
+    }
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+
+/* Allocate lb bytes of composite (pointerful) data	*/
+/* No pointer fields may be changed after a call to	*/
+/* GC_end_stubborn_change(p) where p is the value	*/
+/* returned by GC_malloc_stubborn.			*/
+# ifdef __STDC__
+    GC_PTR GC_malloc_stubborn(size_t lb)
+# else
+    GC_PTR GC_malloc_stubborn(lb)
+    size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t *opp;
+register word lw;
+ptr_t result;
+DCL_LOCK_STATE;
+
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_sobjfreelist[lw]);
+	FASTLOCK();
+        if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+            FASTUNLOCK();
+            result = GC_generic_malloc((word)lb, STUBBORN);
+            goto record;
+        }
+        *opp = obj_link(op);
+        obj_link(op) = 0;
+        GC_words_allocd += lw;
+        result = (GC_PTR) op;
+        ADD_CHANGING(result);
+        FASTUNLOCK();
+        return((GC_PTR)result);
+   } else {
+       result = (GC_PTR)
+          	GC_generic_malloc((word)lb, STUBBORN);
+   }
+record:
+   DISABLE_SIGNALS();
+   LOCK();
+   ADD_CHANGING(result);
+   UNLOCK();
+   ENABLE_SIGNALS();
+   return((GC_PTR)GC_clear_stack(result));
+}
+
+
+/* Functions analogous to GC_read_dirty and GC_page_was_dirty.	*/
+/* Report pages on which stubborn objects were changed.		*/
+void GC_read_changed()
+{
+    register GC_PTR * p = GC_changing_list_start;
+    register GC_PTR q;
+    register struct hblk * h;
+    register word index;
+    
+    if (p == 0) /* initializing */ return;
+    BCOPY(GC_changed_pages, GC_prev_changed_pages,
+          (sizeof GC_changed_pages));
+    BZERO(GC_changed_pages, (sizeof GC_changed_pages));
+    for (; p <= GC_changing_list_current; p++) {
+        if ((q = *p) != 0) {
+            h = HBLKPTR(q);
+            index = PHT_HASH(h);
+            set_pht_entry_from_index(GC_changed_pages, index);
+        }
+    }
+}
+
+GC_bool GC_page_was_changed(h)
+struct hblk * h;
+{
+    register word index = PHT_HASH(h);
+    
+    return(get_pht_entry_from_index(GC_prev_changed_pages, index));
+}
+
+/* Remove unreachable entries from changed list. Should only be	*/
+/* called with mark bits consistent and lock held.		*/
+void GC_clean_changing_list()
+{
+    register GC_PTR * p = GC_changing_list_start;
+    register GC_PTR q;
+    register ptr_t r;
+    register unsigned long count = 0;
+    register unsigned long dropped_count = 0;
+    
+    if (p == 0) /* initializing */ return;
+    for (; p <= GC_changing_list_current; p++) {
+        if ((q = *p) != 0) {
+            count++;
+            r = (ptr_t)GC_base(q);
+            if (r == 0 || !GC_is_marked(r)) {
+                *p = 0;
+                dropped_count++;
+	    }
+        }
+    }
+#   ifdef PRINTSTATS
+      if (count > 0) {
+        GC_printf2("%lu entries in changing list: reclaimed %lu\n",
+                  (unsigned long)count, (unsigned long)dropped_count);
+      }
+#   endif
+}
+
+#else /* !STUBBORN_ALLOC */
+
+# ifdef __STDC__
+    GC_PTR GC_malloc_stubborn(size_t lb)
+# else
+    GC_PTR GC_malloc_stubborn(lb)
+    size_t lb;
+# endif
+{
+    return(GC_malloc(lb));
+}
+
+/*ARGSUSED*/
+void GC_end_stubborn_change(p)
+GC_PTR p;
+{
+}
+
+/*ARGSUSED*/
+void GC_change_stubborn(p)
+GC_PTR p;
+{
+}
+
+
+#endif
diff --git a/src/gc/test.c b/src/gc/test.c
new file mode 100644
index 000000000..96a54150a
--- /dev/null
+++ b/src/gc/test.c
@@ -0,0 +1,1390 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* An incomplete test for the garbage collector.  		*/
+/* Some more obscure entry points are not tested at all.	*/
+
+# undef GC_BUILD
+
+# if defined(mips) && defined(SYSTYPE_BSD43)
+    /* MIPS RISCOS 4 */
+# else
+#   include <stdlib.h>
+# endif
+# include <stdio.h>
+# include <assert.h>	/* Not normally used, but handy for debugging. */
+# include "gc.h"
+# include "gc_typed.h"
+# include "gc_priv.h"	/* For output, locking,  and some statistics	*/
+# include "gcconfig.h"
+
+# ifdef MSWIN32
+#   include <windows.h>
+# endif
+
+# ifdef PCR
+#   include "th/PCR_ThCrSec.h"
+#   include "th/PCR_Th.h"
+#   undef GC_printf0
+#   define GC_printf0 printf
+#   undef GC_printf1
+#   define GC_printf1 printf
+# endif
+
+# ifdef SOLARIS_THREADS
+#   include <thread.h>
+#   include <synch.h>
+# endif
+
+# if defined(IRIX_THREADS) || defined(LINUX_THREADS) || defined(HPUX_THREADS)
+#   include <pthread.h>
+# endif
+
+# ifdef WIN32_THREADS
+#   include <process.h>
+    static CRITICAL_SECTION incr_cs;
+# endif
+
+# ifdef AMIGA
+   long __stack = 200000;
+# endif
+
+# define FAIL (void)abort()
+
+/* AT_END may be defined to excercise the interior pointer test	*/
+/* if the collector is configured with ALL_INTERIOR_POINTERS.   */
+/* As it stands, this test should succeed with either		*/
+/* configuration.  In the FIND_LEAK configuration, it should	*/
+/* find lots of leaks, since we free almost nothing.		*/
+
+struct SEXPR {
+    struct SEXPR * sexpr_car;
+    struct SEXPR * sexpr_cdr;
+};
+
+
+typedef struct SEXPR * sexpr;
+
+# define INT_TO_SEXPR(x) ((sexpr)(unsigned long)(x))
+
+# undef nil
+# define nil (INT_TO_SEXPR(0))
+# define car(x) ((x) -> sexpr_car)
+# define cdr(x) ((x) -> sexpr_cdr)
+# define is_nil(x) ((x) == nil)
+
+
+int extra_count = 0;        /* Amount of space wasted in cons node */
+
+/* Silly implementation of Lisp cons. Intentionally wastes lots of space */
+/* to test collector.                                                    */
+sexpr cons (x, y)
+sexpr x;
+sexpr y;
+{
+    register sexpr r;
+    register int *p;
+    register int my_extra = extra_count;
+    
+    r = (sexpr) GC_MALLOC_STUBBORN(sizeof(struct SEXPR) + my_extra);
+    if (r == 0) {
+        (void)GC_printf0("Out of memory\n");
+        exit(1);
+    }
+    for (p = (int *)r;
+         ((char *)p) < ((char *)r) + my_extra + sizeof(struct SEXPR); p++) {
+	if (*p) {
+	    (void)GC_printf1("Found nonzero at 0x%lx - allocator is broken\n",
+	    		     (unsigned long)p);
+	    FAIL;
+        }
+        *p = 13;
+    }
+#   ifdef AT_END
+	r = (sexpr)((char *)r + (my_extra & ~7));
+#   endif
+    r -> sexpr_car = x;
+    r -> sexpr_cdr = y;
+    my_extra++;
+    if ( my_extra >= 5000 ) {
+        extra_count = 0;
+    } else {
+        extra_count = my_extra;
+    }
+    GC_END_STUBBORN_CHANGE((char *)r);
+    return(r);
+}
+
+sexpr small_cons (x, y)
+sexpr x;
+sexpr y;
+{
+    register sexpr r;
+    
+    r = (sexpr) GC_MALLOC(sizeof(struct SEXPR));
+    if (r == 0) {
+        (void)GC_printf0("Out of memory\n");
+        exit(1);
+    }
+    r -> sexpr_car = x;
+    r -> sexpr_cdr = y;
+    return(r);
+}
+
+sexpr small_cons_uncollectable (x, y)
+sexpr x;
+sexpr y;
+{
+    register sexpr r;
+    
+    r = (sexpr) GC_MALLOC_UNCOLLECTABLE(sizeof(struct SEXPR));
+    if (r == 0) {
+        (void)GC_printf0("Out of memory\n");
+        exit(1);
+    }
+    r -> sexpr_car = x;
+    r -> sexpr_cdr = (sexpr)(~(unsigned long)y);
+    return(r);
+}
+
+#ifdef GC_GCJ_SUPPORT
+
+#include "gc_mark.h"
+#include "dbg_mlc.h"
+#include "include/gc_gcj.h"
+
+/* The following struct emulates the vtable in gcj.	*/
+/* This assumes the default value of MARK_DESCR_OFFSET. */
+struct fake_vtable {
+  void * dummy;		/* class pointer in real gcj.	*/
+  size_t descr;
+};
+
+struct fake_vtable gcj_class_struct1 = { 0, sizeof(struct SEXPR)
+					    + sizeof(struct fake_vtable *) };
+			/* length based descriptor.	*/
+struct fake_vtable gcj_class_struct2 =
+				{ 0, (3l << (CPP_WORDSZ - 3)) | DS_BITMAP};
+			/* Bitmap based descriptor.	*/
+
+struct ms_entry * fake_gcj_mark_proc(word * addr,
+				     struct ms_entry *mark_stack_ptr,
+				     struct ms_entry *mark_stack_limit,
+				     word env   )
+{
+    sexpr x;
+    if (1 == env) {
+	/* Object allocated with debug allocator.	*/
+	addr = (word *)USR_PTR_FROM_BASE(addr);
+    }
+    x = (sexpr)(addr + 1); /* Skip the vtable pointer. */
+    /* We could just call PUSH_CONTENTS directly here.  But any real	*/
+    /* real client would try to filter out the obvious misses.		*/
+    if (0 != x -> sexpr_cdr) {
+	PUSH_CONTENTS((ptr_t)(x -> sexpr_cdr), mark_stack_ptr,
+			      mark_stack_limit, &(x -> sexpr_cdr), exit1);
+    }
+    if ((ptr_t)(x -> sexpr_car) > GC_least_plausible_heap_addr) {
+	PUSH_CONTENTS((ptr_t)(x -> sexpr_car), mark_stack_ptr,
+			      mark_stack_limit, &(x -> sexpr_car), exit2);
+    }
+    return(mark_stack_ptr);
+}
+
+sexpr gcj_cons(x, y)
+sexpr x;
+sexpr y;
+{
+    GC_word * r;
+    sexpr result;
+    static int count = 0;
+    
+    if (++count & 1) {
+        r = (GC_word *) GC_GCJ_FAST_MALLOC(3, &gcj_class_struct1);
+    } else {
+        r = (GC_word *) GC_GCJ_MALLOC(sizeof(struct SEXPR)
+				      + sizeof(struct fake_vtable*),
+				      &gcj_class_struct2);
+    }
+    if (r == 0) {
+        (void)GC_printf0("Out of memory\n");
+        exit(1);
+    }
+    result = (sexpr)(r + 1);
+    result -> sexpr_car = x;
+    result -> sexpr_cdr = y;
+    return(result);
+}
+#endif
+
+/* Return reverse(x) concatenated with y */
+sexpr reverse1(x, y)
+sexpr x, y;
+{
+    if (is_nil(x)) {
+        return(y);
+    } else {
+        return( reverse1(cdr(x), cons(car(x), y)) );
+    }
+}
+
+sexpr reverse(x)
+sexpr x;
+{
+    return( reverse1(x, nil) );
+}
+
+sexpr ints(low, up)
+int low, up;
+{
+    if (low > up) {
+	return(nil);
+    } else {
+        return(small_cons(small_cons(INT_TO_SEXPR(low), nil), ints(low+1, up)));
+    }
+}
+
+#ifdef GC_GCJ_SUPPORT
+/* Return reverse(x) concatenated with y */
+sexpr gcj_reverse1(x, y)
+sexpr x, y;
+{
+    if (is_nil(x)) {
+        return(y);
+    } else {
+        return( gcj_reverse1(cdr(x), gcj_cons(car(x), y)) );
+    }
+}
+
+sexpr gcj_reverse(x)
+sexpr x;
+{
+    return( gcj_reverse1(x, nil) );
+}
+
+sexpr gcj_ints(low, up)
+int low, up;
+{
+    if (low > up) {
+	return(nil);
+    } else {
+        return(gcj_cons(gcj_cons(INT_TO_SEXPR(low), nil), gcj_ints(low+1, up)));
+    }
+}
+#endif /* GC_GCJ_SUPPORT */
+
+/* To check uncollectable allocation we build lists with disguised cdr	*/
+/* pointers, and make sure they don't go away.				*/
+sexpr uncollectable_ints(low, up)
+int low, up;
+{
+    if (low > up) {
+	return(nil);
+    } else {
+        return(small_cons_uncollectable(small_cons(INT_TO_SEXPR(low), nil),
+               uncollectable_ints(low+1, up)));
+    }
+}
+
+void check_ints(list, low, up)
+sexpr list;
+int low, up;
+{
+    if ((int)(GC_word)(car(car(list))) != low) {
+        (void)GC_printf0(
+           "List reversal produced incorrect list - collector is broken\n");
+        FAIL;
+    }
+    if (low == up) {
+        if (cdr(list) != nil) {
+           (void)GC_printf0("List too long - collector is broken\n");
+           FAIL;
+        }
+    } else {
+        check_ints(cdr(list), low+1, up);
+    }
+}
+
+# define UNCOLLECTABLE_CDR(x) (sexpr)(~(unsigned long)(cdr(x)))
+
+void check_uncollectable_ints(list, low, up)
+sexpr list;
+int low, up;
+{
+assert(GC_is_marked(list));
+    if ((int)(GC_word)(car(car(list))) != low) {
+        (void)GC_printf0(
+           "Uncollectable list corrupted - collector is broken\n");
+        FAIL;
+    }
+    if (low == up) {
+        if (UNCOLLECTABLE_CDR(list) != nil) {
+           (void)GC_printf0("Uncollectable list too long - collector is broken\n");
+           FAIL;
+        }
+    } else {
+        check_uncollectable_ints(UNCOLLECTABLE_CDR(list), low+1, up);
+    }
+}
+
+/* Not used, but useful for debugging: */
+void print_int_list(x)
+sexpr x;
+{
+    if (is_nil(x)) {
+        (void)GC_printf0("NIL\n");
+    } else {
+        (void)GC_printf1("(%ld)", (long)(car(car(x))));
+        if (!is_nil(cdr(x))) {
+            (void)GC_printf0(", ");
+            (void)print_int_list(cdr(x));
+        } else {
+            (void)GC_printf0("\n");
+        }
+    }
+}
+
+/* Try to force a to be strangely aligned */
+struct {
+  char dummy;
+  sexpr aa;
+} A;
+#define a A.aa
+
+/*
+ * A tiny list reversal test to check thread creation.
+ */
+#ifdef THREADS
+
+# ifdef WIN32_THREADS
+    unsigned __stdcall tiny_reverse_test(void * arg)
+# else
+    void * tiny_reverse_test(void * arg)
+# endif
+{
+    check_ints(reverse(reverse(ints(1,10))), 1, 10);
+    return 0;
+}
+
+# if defined(IRIX_THREADS) || defined(LINUX_THREADS) \
+     || defined(SOLARIS_PTHREADS) || defined(HPUX_THREADS)
+    void fork_a_thread()
+    {
+      pthread_t t;
+      int code;
+      if ((code = pthread_create(&t, 0, tiny_reverse_test, 0)) != 0) {
+    	(void)GC_printf1("Small thread creation failed %lu\n",
+		         (unsigned long)code);
+    	FAIL;
+      }
+      if ((code = pthread_join(t, 0)) != 0) {
+        (void)GC_printf1("Small thread join failed %lu\n",
+	(unsigned long)code);
+        FAIL;
+      }
+    }
+
+# elif defined(WIN32_THREADS)
+    void fork_a_thread()
+    {
+  	unsigned thread_id;
+	HANDLE h;
+    	h = (HANDLE)_beginthreadex(NULL, 0, tiny_reverse_test,
+				   0, 0, &thread_id);
+        if (h == (HANDLE)-1) {
+            (void)GC_printf1("Small thread creation failed %lu\n",
+			     (unsigned long)GetLastError());
+      	    FAIL;
+        }
+    	if (WaitForSingleObject(h, INFINITE) != WAIT_OBJECT_0) {
+      	    (void)GC_printf1("Small thread wait failed %lu\n",
+			     (unsigned long)GetLastError());
+      	    FAIL;
+    	}
+    }
+
+/* # elif defined(SOLARIS_THREADS) */
+
+# else
+
+#   define fork_a_thread()
+
+# endif
+
+#else
+
+# define fork_a_thread()
+
+#endif 
+
+/*
+ * Repeatedly reverse lists built out of very different sized cons cells.
+ * Check that we didn't lose anything.
+ */
+void reverse_test()
+{
+    int i;
+    sexpr b;
+    sexpr c;
+    sexpr d;
+    sexpr e;
+    sexpr *f, *g, *h;
+#   if defined(MSWIN32) || defined(MACOS)
+      /* Win32S only allows 128K stacks */
+#     define BIG 1000
+#   else
+#     if defined PCR
+	/* PCR default stack is 100K.  Stack frames are up to 120 bytes. */
+#	define BIG 700
+#     else
+#       define BIG 4500
+#     endif
+#   endif
+
+    A.dummy = 17;
+    a = ints(1, 49);
+    b = ints(1, 50);
+    c = ints(1, BIG);
+    d = uncollectable_ints(1, 100);
+    e = uncollectable_ints(1, 1);
+    /* Check that realloc updates object descriptors correctly */
+    f = (sexpr *)GC_MALLOC(4 * sizeof(sexpr));
+    f = (sexpr *)GC_REALLOC((GC_PTR)f, 6 * sizeof(sexpr));
+    f[5] = ints(1,17);
+    g = (sexpr *)GC_MALLOC(513 * sizeof(sexpr));
+    g = (sexpr *)GC_REALLOC((GC_PTR)g, 800 * sizeof(sexpr));
+    g[799] = ints(1,18);
+    h = (sexpr *)GC_MALLOC(1025 * sizeof(sexpr));
+    h = (sexpr *)GC_REALLOC((GC_PTR)h, 2000 * sizeof(sexpr));
+#   ifdef GC_GCJ_SUPPORT
+      h[1999] = gcj_ints(1,200);
+      h[1999] = gcj_reverse(h[1999]);
+#   else
+      h[1999] = ints(1,200);
+#   endif
+    /* Try to force some collections and reuse of small list elements */
+      for (i = 0; i < 10; i++) {
+        (void)ints(1, BIG);
+      }
+    /* Superficially test interior pointer recognition on stack */
+    c = (sexpr)((char *)c + sizeof(char *));
+    d = (sexpr)((char *)d + sizeof(char *));
+
+#   ifdef __STDC__
+        GC_FREE((void *)e);
+#   else
+        GC_FREE((char *)e);
+#   endif
+    check_ints(b,1,50);
+    check_ints(a,1,49);
+    for (i = 0; i < 50; i++) {
+        check_ints(b,1,50);
+        b = reverse(reverse(b));
+    }
+    check_ints(b,1,50);
+    check_ints(a,1,49);
+    for (i = 0; i < 60; i++) {
+	if (i % 10 == 0) fork_a_thread();
+    	/* This maintains the invariant that a always points to a list of */
+    	/* 49 integers.  Thus this is thread safe without locks,	  */
+    	/* assuming atomic pointer assignments.				  */
+        a = reverse(reverse(a));
+#	if !defined(AT_END) && !defined(THREADS)
+	  /* This is not thread safe, since realloc explicitly deallocates */
+          if (i & 1) {
+            a = (sexpr)GC_REALLOC((GC_PTR)a, 500);
+          } else {
+            a = (sexpr)GC_REALLOC((GC_PTR)a, 8200);
+          }
+#	endif
+    }
+    check_ints(a,1,49);
+    check_ints(b,1,50);
+    c = (sexpr)((char *)c - sizeof(char *));
+    d = (sexpr)((char *)d - sizeof(char *));
+    check_ints(c,1,BIG);
+    check_uncollectable_ints(d, 1, 100);
+    check_ints(f[5], 1,17);
+    check_ints(g[799], 1,18);
+#   ifdef GC_GCJ_SUPPORT
+      h[1999] = gcj_reverse(h[1999]);
+#   endif
+    check_ints(h[1999], 1,200);
+#   ifndef THREADS
+	a = 0;
+#   endif  
+    b = c = 0;
+}
+
+/*
+ * The rest of this builds balanced binary trees, checks that they don't
+ * disappear, and tests finalization.
+ */
+typedef struct treenode {
+    int level;
+    struct treenode * lchild;
+    struct treenode * rchild;
+} tn;
+
+int finalizable_count = 0;
+int finalized_count = 0;
+VOLATILE int dropped_something = 0;
+
+# ifdef __STDC__
+  void finalizer(void * obj, void * client_data)
+# else
+  void finalizer(obj, client_data)
+  char * obj;
+  char * client_data;
+# endif
+{
+  tn * t = (tn *)obj;
+
+# ifdef PCR
+     PCR_ThCrSec_EnterSys();
+# endif
+# ifdef SOLARIS_THREADS
+    static mutex_t incr_lock;
+    mutex_lock(&incr_lock);
+# endif
+# if  defined(IRIX_THREADS) || defined(LINUX_THREADS) || defined(HPUX_THREADS)
+    static pthread_mutex_t incr_lock = PTHREAD_MUTEX_INITIALIZER;
+    pthread_mutex_lock(&incr_lock);
+# endif
+# ifdef WIN32_THREADS
+    EnterCriticalSection(&incr_cs);
+# endif
+  if ((int)(GC_word)client_data != t -> level) {
+     (void)GC_printf0("Wrong finalization data - collector is broken\n");
+     FAIL;
+  }
+  finalized_count++;
+# ifdef PCR
+    PCR_ThCrSec_ExitSys();
+# endif
+# ifdef SOLARIS_THREADS
+    mutex_unlock(&incr_lock);
+# endif
+# if defined(IRIX_THREADS) || defined(LINUX_THREADS) || defined(HPUX_THREADS)
+    pthread_mutex_unlock(&incr_lock);
+# endif
+# ifdef WIN32_THREADS
+    LeaveCriticalSection(&incr_cs);
+# endif
+}
+
+size_t counter = 0;
+
+# define MAX_FINALIZED 8000
+
+# if !defined(MACOS)
+  GC_FAR GC_word live_indicators[MAX_FINALIZED] = {0};
+#else
+  /* Too big for THINK_C. have to allocate it dynamically. */
+  GC_word *live_indicators = 0;
+#endif
+
+int live_indicators_count = 0;
+
+tn * mktree(n)
+int n;
+{
+    tn * result = (tn *)GC_MALLOC(sizeof(tn));
+    
+#if defined(MACOS)
+	/* get around static data limitations. */
+	if (!live_indicators)
+		live_indicators =
+		    (GC_word*)NewPtrClear(MAX_FINALIZED * sizeof(GC_word));
+	if (!live_indicators) {
+        (void)GC_printf0("Out of memory\n");
+        exit(1);
+    }
+#endif
+    if (n == 0) return(0);
+    if (result == 0) {
+        (void)GC_printf0("Out of memory\n");
+        exit(1);
+    }
+    result -> level = n;
+    result -> lchild = mktree(n-1);
+    result -> rchild = mktree(n-1);
+    if (counter++ % 17 == 0 && n >= 2) {
+        tn * tmp = result -> lchild -> rchild;
+        
+        result -> lchild -> rchild = result -> rchild -> lchild;
+        result -> rchild -> lchild = tmp;
+    }
+    if (counter++ % 119 == 0) {
+        int my_index;
+        
+        {
+#	  ifdef PCR
+ 	    PCR_ThCrSec_EnterSys();
+#	  endif
+#	  ifdef SOLARIS_THREADS
+	    static mutex_t incr_lock;
+	    mutex_lock(&incr_lock);
+#	  endif
+#         if defined(IRIX_THREADS) || defined(LINUX_THREADS) \
+	     || defined(HPUX_THREADS)
+            static pthread_mutex_t incr_lock = PTHREAD_MUTEX_INITIALIZER;
+            pthread_mutex_lock(&incr_lock);
+#         endif
+#         ifdef WIN32_THREADS
+            EnterCriticalSection(&incr_cs);
+#         endif
+		/* Losing a count here causes erroneous report of failure. */
+          finalizable_count++;
+          my_index = live_indicators_count++;
+#	  ifdef PCR
+ 	    PCR_ThCrSec_ExitSys();
+#	  endif
+#	  ifdef SOLARIS_THREADS
+	    mutex_unlock(&incr_lock);
+#	  endif
+#	  if defined(IRIX_THREADS) || defined(LINUX_THREADS) \
+	     || defined(HPUX_THREADS)
+	    pthread_mutex_unlock(&incr_lock);
+#	  endif
+#         ifdef WIN32_THREADS
+            LeaveCriticalSection(&incr_cs);
+#         endif
+	}
+
+        GC_REGISTER_FINALIZER((GC_PTR)result, finalizer, (GC_PTR)(GC_word)n,
+        		      (GC_finalization_proc *)0, (GC_PTR *)0);
+        if (my_index >= MAX_FINALIZED) {
+		GC_printf0("live_indicators overflowed\n");
+		FAIL;
+	}
+        live_indicators[my_index] = 13;
+        if (GC_GENERAL_REGISTER_DISAPPEARING_LINK(
+         	(GC_PTR *)(&(live_indicators[my_index])),
+         	(GC_PTR)result) != 0) {
+         	GC_printf0("GC_general_register_disappearing_link failed\n");
+         	FAIL;
+        }
+        if (GC_unregister_disappearing_link(
+         	(GC_PTR *)
+         	   (&(live_indicators[my_index]))) == 0) {
+         	GC_printf0("GC_unregister_disappearing_link failed\n");
+         	FAIL;
+        }
+        if (GC_GENERAL_REGISTER_DISAPPEARING_LINK(
+         	(GC_PTR *)(&(live_indicators[my_index])),
+         	(GC_PTR)result) != 0) {
+         	GC_printf0("GC_general_register_disappearing_link failed 2\n");
+         	FAIL;
+        }
+    }
+    return(result);
+}
+
+void chktree(t,n)
+tn *t;
+int n;
+{
+    if (n == 0 && t != 0) {
+        (void)GC_printf0("Clobbered a leaf - collector is broken\n");
+        FAIL;
+    }
+    if (n == 0) return;
+    if (t -> level != n) {
+        (void)GC_printf1("Lost a node at level %lu - collector is broken\n",
+        		 (unsigned long)n);
+        FAIL;
+    }
+    if (counter++ % 373 == 0) (void) GC_MALLOC(counter%5001);
+    chktree(t -> lchild, n-1);
+    if (counter++ % 73 == 0) (void) GC_MALLOC(counter%373);
+    chktree(t -> rchild, n-1);
+}
+
+# if defined(SOLARIS_THREADS) && !defined(_SOLARIS_PTHREADS)
+thread_key_t fl_key;
+
+void * alloc8bytes()
+{
+# if defined(SMALL_CONFIG) || defined(GC_DEBUG)
+    return(GC_MALLOC(8));
+# else
+    void ** my_free_list_ptr;
+    void * my_free_list;
+    
+    if (thr_getspecific(fl_key, (void **)(&my_free_list_ptr)) != 0) {
+    	(void)GC_printf0("thr_getspecific failed\n");
+    	FAIL;
+    }
+    if (my_free_list_ptr == 0) {
+        my_free_list_ptr = GC_NEW_UNCOLLECTABLE(void *);
+        if (thr_setspecific(fl_key, my_free_list_ptr) != 0) {
+    	    (void)GC_printf0("thr_setspecific failed\n");
+    	    FAIL;
+        }
+    }
+    my_free_list = *my_free_list_ptr;
+    if (my_free_list == 0) {
+        my_free_list = GC_malloc_many(8);
+        if (my_free_list == 0) {
+            (void)GC_printf0("alloc8bytes out of memory\n");
+    	    FAIL;
+        }
+    }
+    *my_free_list_ptr = GC_NEXT(my_free_list);
+    GC_NEXT(my_free_list) = 0;
+    return(my_free_list);
+# endif
+}
+
+#else
+
+# if defined(_SOLARIS_PTHREADS) || defined(IRIX_THREADS) \
+     || defined(LINUX_THREADS) || defined(HPUX_THREADS)
+pthread_key_t fl_key;
+
+void * alloc8bytes()
+{
+# ifdef SMALL_CONFIG
+    return(GC_malloc(8));
+# else
+    void ** my_free_list_ptr;
+    void * my_free_list;
+    
+    my_free_list_ptr = (void **)pthread_getspecific(fl_key);
+    if (my_free_list_ptr == 0) {
+        my_free_list_ptr = GC_NEW_UNCOLLECTABLE(void *);
+        if (pthread_setspecific(fl_key, my_free_list_ptr) != 0) {
+    	    (void)GC_printf0("pthread_setspecific failed\n");
+    	    FAIL;
+        }
+    }
+    my_free_list = *my_free_list_ptr;
+    if (my_free_list == 0) {
+        my_free_list = GC_malloc_many(8);
+        if (my_free_list == 0) {
+            (void)GC_printf0("alloc8bytes out of memory\n");
+    	    FAIL;
+        }
+    }
+    *my_free_list_ptr = GC_NEXT(my_free_list);
+    GC_NEXT(my_free_list) = 0;
+    return(my_free_list);
+# endif
+}
+
+# else
+#   define alloc8bytes() GC_MALLOC_ATOMIC(8)
+# endif
+#endif
+
+void alloc_small(n)
+int n;
+{
+    register int i;
+    
+    for (i = 0; i < n; i += 8) {
+        if (alloc8bytes() == 0) {
+            (void)GC_printf0("Out of memory\n");
+            FAIL;
+        }
+    }
+}
+
+# if defined(THREADS) && defined(GC_DEBUG)
+#   define TREE_HEIGHT 15
+# else
+#   define TREE_HEIGHT 16
+# endif
+void tree_test()
+{
+    tn * root;
+    register int i;
+    
+    root = mktree(TREE_HEIGHT);
+    alloc_small(5000000);
+    chktree(root, TREE_HEIGHT);
+    if (finalized_count && ! dropped_something) {
+        (void)GC_printf0("Premature finalization - collector is broken\n");
+        FAIL;
+    }
+    dropped_something = 1;
+    GC_noop(root);	/* Root needs to remain live until	*/
+    			/* dropped_something is set.		*/
+    root = mktree(TREE_HEIGHT);
+    chktree(root, TREE_HEIGHT);
+    for (i = TREE_HEIGHT; i >= 0; i--) {
+        root = mktree(i);
+        chktree(root, i);
+    }
+    alloc_small(5000000);
+}
+
+unsigned n_tests = 0;
+
+GC_word bm_huge[10] = {
+    0xffffffff,
+    0xffffffff,
+    0xffffffff,
+    0xffffffff,
+    0xffffffff,
+    0xffffffff,
+    0xffffffff,
+    0xffffffff,
+    0xffffffff,
+    0x00ffffff,
+};
+
+
+/* A very simple test of explicitly typed allocation	*/
+void typed_test()
+{
+    GC_word * old, * new;
+    GC_word bm3 = 0x3;
+    GC_word bm2 = 0x2;
+    GC_word bm_large = 0xf7ff7fff;
+    GC_descr d1 = GC_make_descriptor(&bm3, 2);
+    GC_descr d2 = GC_make_descriptor(&bm2, 2);
+#   ifndef LINT
+      GC_descr dummy = GC_make_descriptor(&bm_large, 32);
+#   endif
+    GC_descr d3 = GC_make_descriptor(&bm_large, 32);
+    GC_descr d4 = GC_make_descriptor(bm_huge, 320);
+    GC_word * x = (GC_word *)GC_malloc_explicitly_typed(2000, d4);
+    register int i;
+    
+    old = 0;
+    for (i = 0; i < 4000; i++) {
+        new = (GC_word *) GC_malloc_explicitly_typed(4 * sizeof(GC_word), d1);
+        if (0 != new[0] || 0 != new[1]) {
+	    GC_printf0("Bad initialization by GC_malloc_explicitly_typed\n");
+	    FAIL;
+	}
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+        new = (GC_word *) GC_malloc_explicitly_typed(4 * sizeof(GC_word), d2);
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+        new = (GC_word *) GC_malloc_explicitly_typed(33 * sizeof(GC_word), d3);
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+        new = (GC_word *) GC_calloc_explicitly_typed(4, 2 * sizeof(GC_word),
+        					     d1);
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+        if (i & 0xff) {
+          new = (GC_word *) GC_calloc_explicitly_typed(7, 3 * sizeof(GC_word),
+        					     d2);
+        } else {
+          new = (GC_word *) GC_calloc_explicitly_typed(1001,
+          					       3 * sizeof(GC_word),
+        					       d2);
+          if (0 != new[0] || 0 != new[1]) {
+	    GC_printf0("Bad initialization by GC_malloc_explicitly_typed\n");
+	    FAIL;
+	  }
+        }
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+    }
+    for (i = 0; i < 20000; i++) {
+        if (new[0] != 17) {
+            (void)GC_printf1("typed alloc failed at %lu\n",
+            		     (unsigned long)i);
+            FAIL;
+        }
+        new[0] = 0;
+        old = new;
+        new = (GC_word *)(old[1]);
+    }
+    GC_gcollect();
+    GC_noop(x);
+}
+
+int fail_count = 0;
+
+#ifndef __STDC__
+/*ARGSUSED*/
+void fail_proc1(x)
+GC_PTR x;
+{
+    fail_count++;
+}
+
+#else
+
+/*ARGSUSED*/
+void fail_proc1(GC_PTR x)
+{
+    fail_count++;
+}   
+
+#endif /* __STDC__ */
+
+#ifdef THREADS
+#   define TEST_FAIL_COUNT(n) 1
+#else 
+#   define TEST_FAIL_COUNT(n) (fail_count >= (n))
+#endif
+
+void run_one_test()
+{
+    char *x;
+#   ifdef LINT
+    	char *y = 0;
+#   else
+    	char *y = (char *)(size_t)fail_proc1;
+#   endif
+    DCL_LOCK_STATE;
+    
+#   ifdef FIND_LEAK
+	(void)GC_printf0(
+		"This test program is not designed for leak detection mode\n");
+	(void)GC_printf0("Expect lots of problems.\n");
+#   endif
+    if (GC_size(GC_malloc(7)) != 8
+	|| GC_size(GC_malloc(15)) != 16) {
+	    (void)GC_printf0("GC_size produced unexpected results\n");
+	    FAIL;
+    }
+    if (GC_size(GC_malloc(0)) != 4 && GC_size(GC_malloc(0)) != 8) {
+    	(void)GC_printf0("GC_malloc(0) failed\n");
+	    FAIL;
+    }
+    if (GC_size(GC_malloc_uncollectable(0)) != 4
+        && GC_size(GC_malloc_uncollectable(0)) != 8) {
+    	(void)GC_printf0("GC_malloc_uncollectable(0) failed\n");
+	    FAIL;
+    }
+    GC_FREE(0);
+    GC_is_valid_displacement_print_proc = fail_proc1;
+    GC_is_visible_print_proc = fail_proc1;
+    x = GC_malloc(16);
+    if (GC_base(x + 13) != x) {
+    	(void)GC_printf0("GC_base(heap ptr) produced incorrect result\n");
+	FAIL;
+    }
+#   ifndef PCR
+      if (GC_base(y) != 0) {
+    	(void)GC_printf0("GC_base(fn_ptr) produced incorrect result\n");
+	FAIL;
+      }
+#   endif
+    if (GC_same_obj(x+5, x) != x + 5) {
+    	(void)GC_printf0("GC_same_obj produced incorrect result\n");
+	FAIL;
+    }
+    if (GC_is_visible(y) != y || GC_is_visible(x) != x) {
+    	(void)GC_printf0("GC_is_visible produced incorrect result\n");
+	FAIL;
+    }
+    if (!TEST_FAIL_COUNT(1)) {
+#	if!(defined(RS6000) || defined(POWERPC) || defined(IA64))
+	  /* ON RS6000s function pointers point to a descriptor in the	*/
+	  /* data segment, so there should have been no failures.	*/
+    	  (void)GC_printf0("GC_is_visible produced wrong failure indication\n");
+    	  FAIL;
+#	endif
+    }
+    if (GC_is_valid_displacement(y) != y
+        || GC_is_valid_displacement(x) != x
+        || GC_is_valid_displacement(x + 3) != x + 3) {
+    	(void)GC_printf0(
+    		"GC_is_valid_displacement produced incorrect result\n");
+	FAIL;
+    }
+#   ifndef ALL_INTERIOR_POINTERS
+#    if defined(RS6000) || defined(POWERPC)
+      if (!TEST_FAIL_COUNT(1)) {
+#    else
+      if (!TEST_FAIL_COUNT(2)) {
+#    endif
+    	(void)GC_printf0("GC_is_valid_displacement produced wrong failure indication\n");
+    	FAIL;
+      }
+#   endif
+    /* Test floating point alignment */
+	*(double *)GC_MALLOC(sizeof(double)) = 1.0;
+	*(double *)GC_MALLOC(sizeof(double)) = 1.0;
+#   ifdef GC_GCJ_SUPPORT
+      GC_REGISTER_DISPLACEMENT(sizeof(struct fake_vtable *));
+      GC_init_gcj_malloc(0, (void *)fake_gcj_mark_proc);
+#   endif
+    /* Repeated list reversal test. */
+	reverse_test();
+#   ifdef PRINTSTATS
+	GC_printf0("-------------Finished reverse_test\n");
+#   endif
+    typed_test();
+#   ifdef PRINTSTATS
+	GC_printf0("-------------Finished typed_test\n");
+#   endif
+    tree_test();
+    LOCK();
+    n_tests++;
+    UNLOCK();
+    /* GC_printf1("Finished %x\n", pthread_self()); */
+}
+
+void check_heap_stats()
+{
+    unsigned long max_heap_sz;
+    register int i;
+    int still_live;
+    int late_finalize_count = 0;
+    
+    if (sizeof(char *) > 4) {
+        max_heap_sz = 15000000;
+    } else {
+    	max_heap_sz = 11000000;
+    }
+#   ifdef GC_DEBUG
+	max_heap_sz *= 2;
+#       ifdef SPARC
+	    max_heap_sz *= 2;
+#       endif
+#   endif
+    /* Garbage collect repeatedly so that all inaccessible objects	*/
+    /* can be finalized.						*/
+      while (GC_collect_a_little()) { }
+      for (i = 0; i < 16; i++) {
+        GC_gcollect();
+        late_finalize_count += GC_invoke_finalizers();
+      }
+    (void)GC_printf1("Completed %lu tests\n", (unsigned long)n_tests);
+    (void)GC_printf2("Finalized %lu/%lu objects - ",
+    		     (unsigned long)finalized_count,
+    		     (unsigned long)finalizable_count);
+#   ifdef FINALIZE_ON_DEMAND
+	if (finalized_count != late_finalize_count) {
+            (void)GC_printf0("Demand finalization error\n");
+	    FAIL;
+	}
+#   endif
+    if (finalized_count > finalizable_count
+        || finalized_count < finalizable_count/2) {
+        (void)GC_printf0("finalization is probably broken\n");
+        FAIL;
+    } else {
+        (void)GC_printf0("finalization is probably ok\n");
+    }
+    still_live = 0;
+    for (i = 0; i < MAX_FINALIZED; i++) {
+    	if (live_indicators[i] != 0) {
+    	    still_live++;
+    	}
+    }
+    i = finalizable_count - finalized_count - still_live;
+    if (0 != i) {
+        (void)GC_printf2
+            ("%lu disappearing links remain and %lu more objects were not finalized\n",
+             (unsigned long) still_live, (unsigned long)i);
+        if (i > 10) {
+	    GC_printf0("\tVery suspicious!\n");
+	} else {
+	    GC_printf0("\tSlightly suspicious, but probably OK.\n");
+	}
+    }
+    (void)GC_printf1("Total number of bytes allocated is %lu\n",
+    		(unsigned long)
+    	           WORDS_TO_BYTES(GC_words_allocd + GC_words_allocd_before_gc));
+    (void)GC_printf1("Final heap size is %lu bytes\n",
+    		     (unsigned long)GC_get_heap_size());
+    if (WORDS_TO_BYTES(GC_words_allocd + GC_words_allocd_before_gc)
+        < 33500000*n_tests) {
+        (void)GC_printf0("Incorrect execution - missed some allocations\n");
+        FAIL;
+    }
+    if (GC_get_heap_size() > max_heap_sz*n_tests) {
+        (void)GC_printf0("Unexpected heap growth - collector may be broken\n");
+        FAIL;
+    }
+    (void)GC_printf0("Collector appears to work\n");
+}
+
+#if defined(MACOS)
+void SetMinimumStack(long minSize)
+{
+	long newApplLimit;
+
+	if (minSize > LMGetDefltStack())
+	{
+		newApplLimit = (long) GetApplLimit()
+				- (minSize - LMGetDefltStack());
+		SetApplLimit((Ptr) newApplLimit);
+		MaxApplZone();
+	}
+}
+
+#define cMinStackSpace (512L * 1024L)
+
+#endif
+
+#ifdef __STDC__
+    void warn_proc(char *msg, GC_word p)
+#else
+    void warn_proc(msg, p)
+    char *msg;
+    GC_word p;
+#endif
+{
+    GC_printf1(msg, (unsigned long)p);
+    FAIL;
+}
+
+
+#if !defined(PCR) && !defined(SOLARIS_THREADS) && !defined(WIN32_THREADS) \
+  && !defined(IRIX_THREADS) && !defined(LINUX_THREADS) \
+  && !defined(HPUX_THREADS) || defined(LINT)
+#if defined(MSWIN32) && !defined(__MINGW32__)
+  int APIENTRY WinMain(HINSTANCE instance, HINSTANCE prev, LPSTR cmd, int n)
+#else
+  int main()
+#endif
+{
+#   if defined(DJGPP)
+	int dummy;
+#   endif
+    n_tests = 0;
+    
+#   if defined(DJGPP)
+	/* No good way to determine stack base from library; do it */
+	/* manually on this platform.				   */
+    	GC_stackbottom = (GC_PTR)(&dummy);
+#   endif
+#   if defined(MACOS)
+	/* Make sure we have lots and lots of stack space. 	*/
+	SetMinimumStack(cMinStackSpace);
+	/* Cheat and let stdio initialize toolbox for us.	*/
+	printf("Testing GC Macintosh port.\n");
+#   endif
+    GC_INIT();	/* Only needed if gc is dynamic library.	*/
+    (void) GC_set_warn_proc(warn_proc);
+#   if defined(MPROTECT_VDB) || defined(PROC_VDB)
+      GC_enable_incremental();
+      (void) GC_printf0("Switched to incremental mode\n");
+#     if defined(MPROTECT_VDB)
+	(void)GC_printf0("Emulating dirty bits with mprotect/signals\n");
+#     else
+	(void)GC_printf0("Reading dirty bits from /proc\n");
+#      endif
+#   endif
+    run_one_test();
+    check_heap_stats();
+    (void)fflush(stdout);
+#   ifdef LINT
+	/* Entry points we should be testing, but aren't.		   */
+	/* Some can be tested by defining GC_DEBUG at the top of this file */
+	/* This is a bit SunOS4 specific.				   */			
+	GC_noop(GC_expand_hp, GC_add_roots, GC_clear_roots,
+	        GC_register_disappearing_link,
+	        GC_register_finalizer_ignore_self,
+		GC_debug_register_displacement,
+	        GC_print_obj, GC_debug_change_stubborn,
+	        GC_debug_end_stubborn_change, GC_debug_malloc_uncollectable,
+	        GC_debug_free, GC_debug_realloc, GC_generic_malloc_words_small,
+	        GC_init, GC_make_closure, GC_debug_invoke_finalizer,
+	        GC_page_was_ever_dirty, GC_is_fresh,
+		GC_malloc_ignore_off_page, GC_malloc_atomic_ignore_off_page,
+		GC_set_max_heap_size, GC_get_bytes_since_gc,
+		GC_pre_incr, GC_post_incr);
+#   endif
+#   ifdef MSWIN32
+      GC_win32_free_heap();
+#   endif
+    return(0);
+}
+# endif
+
+#ifdef WIN32_THREADS
+
+unsigned __stdcall thr_run_one_test(void *arg)
+{
+  run_one_test();
+  return 0;
+}
+
+#define NTEST 2 
+
+int APIENTRY WinMain(HINSTANCE instance, HINSTANCE prev, LPSTR cmd, int n)
+{
+# if NTEST > 0
+   HANDLE h[NTEST];
+# endif
+  int i;
+  unsigned thread_id;
+# if 0
+    GC_enable_incremental();
+# endif
+  InitializeCriticalSection(&incr_cs);
+  (void) GC_set_warn_proc(warn_proc);
+# if NTEST > 0
+   for (i = 0; i < NTEST; i++) {
+    h[i] = (HANDLE)_beginthreadex(NULL, 0, thr_run_one_test, 0, 0, &thread_id);
+    if (h[i] == (HANDLE)-1) {
+      (void)GC_printf1("Thread creation failed %lu\n", (unsigned long)GetLastError());
+      FAIL;
+    }
+   }
+# endif /* NTEST > 0 */
+  run_one_test();
+# if NTEST > 0
+   for (i = 0; i < NTEST; i++) {
+    if (WaitForSingleObject(h[i], INFINITE) != WAIT_OBJECT_0) {
+      (void)GC_printf1("Thread wait failed %lu\n", (unsigned long)GetLastError());
+      FAIL;
+    }
+   }
+# endif /* NTEST > 0 */
+  check_heap_stats();
+  (void)fflush(stdout);
+  return(0);
+}
+
+#endif /* WIN32_THREADS */
+
+
+#ifdef PCR
+test()
+{
+    PCR_Th_T * th1;
+    PCR_Th_T * th2;
+    int code;
+
+    n_tests = 0;
+    /* GC_enable_incremental(); */
+    (void) GC_set_warn_proc(warn_proc);
+    th1 = PCR_Th_Fork(run_one_test, 0);
+    th2 = PCR_Th_Fork(run_one_test, 0);
+    run_one_test();
+    if (PCR_Th_T_Join(th1, &code, NIL, PCR_allSigsBlocked, PCR_waitForever)
+        != PCR_ERes_okay || code != 0) {
+        (void)GC_printf0("Thread 1 failed\n");
+    }
+    if (PCR_Th_T_Join(th2, &code, NIL, PCR_allSigsBlocked, PCR_waitForever)
+        != PCR_ERes_okay || code != 0) {
+        (void)GC_printf0("Thread 2 failed\n");
+    }
+    check_heap_stats();
+    (void)fflush(stdout);
+    return(0);
+}
+#endif
+
+#if defined(SOLARIS_THREADS) || defined(IRIX_THREADS) \
+ || defined(HPUX_THREADS) || defined(LINUX_THREADS)
+void * thr_run_one_test(void * arg)
+{
+    run_one_test();
+    return(0);
+}
+
+#ifdef GC_DEBUG
+#  define GC_free GC_debug_free
+#endif
+
+#ifdef SOLARIS_THREADS
+main()
+{
+    thread_t th1;
+    thread_t th2;
+    int code;
+
+    n_tests = 0;
+    GC_INIT();	/* Only needed if gc is dynamic library.	*/
+    GC_enable_incremental();
+    (void) GC_set_warn_proc(warn_proc);
+    if (thr_keycreate(&fl_key, GC_free) != 0) {
+        (void)GC_printf1("Key creation failed %lu\n", (unsigned long)code);
+    	FAIL;
+    }
+    if ((code = thr_create(0, 1024*1024, thr_run_one_test, 0, 0, &th1)) != 0) {
+    	(void)GC_printf1("Thread 1 creation failed %lu\n", (unsigned long)code);
+    	FAIL;
+    }
+    if ((code = thr_create(0, 1024*1024, thr_run_one_test, 0, THR_NEW_LWP, &th2)) != 0) {
+    	(void)GC_printf1("Thread 2 creation failed %lu\n", (unsigned long)code);
+    	FAIL;
+    }
+    run_one_test();
+    if ((code = thr_join(th1, 0, 0)) != 0) {
+        (void)GC_printf1("Thread 1 failed %lu\n", (unsigned long)code);
+        FAIL;
+    }
+    if (thr_join(th2, 0, 0) != 0) {
+        (void)GC_printf1("Thread 2 failed %lu\n", (unsigned long)code);
+        FAIL;
+    }
+    check_heap_stats();
+    (void)fflush(stdout);
+    return(0);
+}
+#else /* pthreads */
+main()
+{
+    pthread_t th1;
+    pthread_t th2;
+    pthread_attr_t attr;
+    int code;
+
+#   ifdef IRIX_THREADS
+	/* Force a larger stack to be preallocated      */
+	/* Since the initial cant always grow later.	*/
+	*((volatile char *)&code - 1024*1024) = 0;      /* Require 1 Mb */
+#   endif /* IRIX_THREADS */
+    pthread_attr_init(&attr);
+#   if defined(IRIX_THREADS) || defined(HPUX_THREADS)
+    	pthread_attr_setstacksize(&attr, 1000000);
+#   endif
+    n_tests = 0;
+#   ifdef MPROTECT_VDB
+    	GC_enable_incremental();
+        (void) GC_printf0("Switched to incremental mode\n");
+	(void) GC_printf0("Emulating dirty bits with mprotect/signals\n");
+#   endif
+    (void) GC_set_warn_proc(warn_proc);
+    if ((code = pthread_key_create(&fl_key, 0)) != 0) {
+        (void)GC_printf1("Key creation failed %lu\n", (unsigned long)code);
+    	FAIL;
+    }
+    if ((code = pthread_create(&th1, &attr, thr_run_one_test, 0)) != 0) {
+    	(void)GC_printf1("Thread 1 creation failed %lu\n", (unsigned long)code);
+    	FAIL;
+    }
+    if ((code = pthread_create(&th2, &attr, thr_run_one_test, 0)) != 0) {
+    	(void)GC_printf1("Thread 2 creation failed %lu\n", (unsigned long)code);
+    	FAIL;
+    }
+    run_one_test();
+    if ((code = pthread_join(th1, 0)) != 0) {
+        (void)GC_printf1("Thread 1 failed %lu\n", (unsigned long)code);
+        FAIL;
+    }
+    if (pthread_join(th2, 0) != 0) {
+        (void)GC_printf1("Thread 2 failed %lu\n", (unsigned long)code);
+        FAIL;
+    }
+    check_heap_stats();
+    (void)fflush(stdout);
+    pthread_attr_destroy(&attr);
+    GC_printf1("Completed %d collections\n", GC_gc_no);
+    return(0);
+}
+#endif /* pthreads */
+#endif /* SOLARIS_THREADS || IRIX_THREADS || LINUX_THREADS || HPUX_THREADS */
diff --git a/src/gc/test_cpp.cc b/src/gc/test_cpp.cc
new file mode 100644
index 000000000..0d4507765
--- /dev/null
+++ b/src/gc/test_cpp.cc
@@ -0,0 +1,271 @@
+/****************************************************************************
+Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+Permission is hereby granted to use or copy this program for any
+purpose, provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is
+granted, provided the above notices are retained, and a notice that
+the code was modified is included with the above copyright notice.
+****************************************************************************
+Last modified on Mon Jul 10 21:06:03 PDT 1995 by ellis
+     modified on December 20, 1994 7:27 pm PST by boehm
+
+usage: test_cpp number-of-iterations
+
+This program tries to test the specific C++ functionality provided by
+gc_c++.h that isn't tested by the more general test routines of the
+collector.
+
+A recommended value for number-of-iterations is 10, which will take a
+few minutes to complete.
+
+***************************************************************************/
+
+#include "gc_cpp.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#ifndef __GNUC__
+#   include "gc_alloc.h"
+#endif
+extern "C" {
+#include "gc_priv.h"
+}
+#ifdef MSWIN32
+#   include <windows.h>
+#endif
+#ifdef GC_NAME_CONFLICT
+#   define USE_GC UseGC
+    struct foo * GC;
+#else
+#   define USE_GC GC
+#endif
+
+
+#define my_assert( e ) \
+    if (! (e)) { \
+        GC_printf1( "Assertion failure in " __FILE__ ", line %d: " #e "\n", \
+                    __LINE__ ); \
+        exit( 1 ); }
+
+
+class A {public:
+    /* An uncollectable class. */
+
+    A( int iArg ): i( iArg ) {}
+    void Test( int iArg ) {
+        my_assert( i == iArg );} 
+    int i;};
+
+
+class B: public gc, public A {public:
+    /* A collectable class. */
+
+    B( int j ): A( j ) {}
+    ~B() {
+        my_assert( deleting );}
+    static void Deleting( int on ) {
+        deleting = on;}
+    static int deleting;};
+
+int B::deleting = 0;
+
+
+class C: public gc_cleanup, public A {public:
+    /* A collectable class with cleanup and virtual multiple inheritance. */
+
+    C( int levelArg ): A( levelArg ), level( levelArg ) {
+        nAllocated++;
+        if (level > 0) {
+            left = new C( level - 1 );
+            right = new C( level - 1 );}
+        else {
+            left = right = 0;}}
+    ~C() {
+        this->A::Test( level );
+        nFreed++;
+        my_assert( level == 0 ? 
+                   left == 0 && right == 0 :
+                   level == left->level + 1 && level == right->level + 1 );
+        left = right = 0;
+        level = -123456;}
+    static void Test() {
+        my_assert( nFreed <= nAllocated && nFreed >= .8 * nAllocated );}
+
+    static int nFreed;
+    static int nAllocated;
+    int level;
+    C* left;
+    C* right;};
+
+int C::nFreed = 0;
+int C::nAllocated = 0;
+
+
+class D: public gc {public:
+    /* A collectable class with a static member function to be used as
+    an explicit clean-up function supplied to ::new. */
+
+    D( int iArg ): i( iArg ) {
+        nAllocated++;}
+    static void CleanUp( void* obj, void* data ) {
+        D* self = (D*) obj;
+        nFreed++;
+        my_assert( self->i == (int) (long) data );}
+    static void Test() {
+        my_assert( nFreed >= .8 * nAllocated );}
+       
+    int i;
+    static int nFreed;
+    static int nAllocated;};
+
+int D::nFreed = 0;
+int D::nAllocated = 0;
+
+
+class E: public gc_cleanup {public:
+    /* A collectable class with clean-up for use by F. */
+
+    E() {
+        nAllocated++;}
+    ~E() {
+        nFreed++;}
+
+    static int nFreed;
+    static int nAllocated;};
+    
+int E::nFreed = 0;
+int E::nAllocated = 0;
+   
+
+class F: public E {public:
+    /* A collectable class with clean-up, a base with clean-up, and a
+    member with clean-up. */
+
+    F() {
+        nAllocated++;}
+    ~F() {
+        nFreed++;}
+    static void Test() {
+        my_assert( nFreed >= .8 * nAllocated );
+        my_assert( 2 * nFreed == E::nFreed );}
+       
+    E e;
+    static int nFreed;
+    static int nAllocated;};
+    
+int F::nFreed = 0;
+int F::nAllocated = 0;
+   
+
+long Disguise( void* p ) {
+    return ~ (long) p;}
+
+void* Undisguise( long i ) {
+    return (void*) ~ i;}
+
+
+#ifdef MSWIN32
+int APIENTRY WinMain(
+    HINSTANCE instance, HINSTANCE prev, LPSTR cmd, int cmdShow ) 
+{
+    int argc;
+    char* argv[ 3 ];
+
+    for (argc = 1; argc < sizeof( argv ) / sizeof( argv[ 0 ] ); argc++) {
+        argv[ argc ] = strtok( argc == 1 ? cmd : 0, " \t" );
+        if (0 == argv[ argc ]) break;}
+
+#else
+# ifdef MACOS
+    int main() {
+# else
+    int main( int argc, char* argv[] ) {
+# endif
+#endif
+
+#  if defined(MACOS)                        // MacOS
+    char* argv_[] = {"test_cpp", "10"};     //   doesn't
+    argv = argv_;                           //     have a
+    argc = sizeof(argv_)/sizeof(argv_[0]);  //       commandline
+#  endif 
+    int i, iters, n;
+#   if !defined(__GNUC__) && !defined(MACOS)
+      int *x = (int *)alloc::allocate(sizeof(int));
+
+      *x = 29;
+      x -= 3;
+#   endif
+    if (argc != 2 || (0 >= (n = atoi( argv[ 1 ] )))) {
+        GC_printf0( "usage: test_cpp number-of-iterations\n" );
+        exit( 1 );}
+        
+    for (iters = 1; iters <= n; iters++) {
+        GC_printf1( "Starting iteration %d\n", iters );
+
+            /* Allocate some uncollectable As and disguise their pointers.
+            Later we'll check to see if the objects are still there.  We're
+            checking to make sure these objects really are uncollectable. */
+        long as[ 1000 ];
+        long bs[ 1000 ];
+        for (i = 0; i < 1000; i++) {
+            as[ i ] = Disguise( new (NoGC) A( i ) );
+            bs[ i ] = Disguise( new (NoGC) B( i ) );}
+
+            /* Allocate a fair number of finalizable Cs, Ds, and Fs.
+            Later we'll check to make sure they've gone away. */
+        for (i = 0; i < 1000; i++) {
+            C* c = new C( 2 );
+            C c1( 2 );           /* stack allocation should work too */
+            D* d = ::new (USE_GC, D::CleanUp, (void*) i) D( i );
+            F* f = new F;
+            if (0 == i % 10) delete c;}
+
+            /* Allocate a very large number of collectable As and Bs and
+            drop the references to them immediately, forcing many
+            collections. */
+        for (i = 0; i < 1000000; i++) {
+            A* a = new (USE_GC) A( i );
+            B* b = new B( i );
+            b = new (USE_GC) B( i );
+            if (0 == i % 10) {
+                B::Deleting( 1 );
+                delete b;
+                B::Deleting( 0 );}
+#	    ifdef FINALIZE_ON_DEMAND
+	      GC_invoke_finalizers();
+#	    endif
+	    }
+
+            /* Make sure the uncollectable As and Bs are still there. */
+        for (i = 0; i < 1000; i++) {
+            A* a = (A*) Undisguise( as[ i ] );
+            B* b = (B*) Undisguise( bs[ i ] );
+            a->Test( i );
+            delete a;
+            b->Test( i );
+            B::Deleting( 1 );
+            delete b;
+            B::Deleting( 0 );
+#	    ifdef FINALIZE_ON_DEMAND
+	   	 GC_invoke_finalizers();
+#	    endif
+
+	    }
+
+            /* Make sure most of the finalizable Cs, Ds, and Fs have
+            gone away. */
+        C::Test();
+        D::Test();
+        F::Test();}
+
+#   if !defined(__GNUC__) && !defined(MACOS)
+      my_assert (29 == x[3]);
+#   endif
+    GC_printf0( "The test appears to have succeeded.\n" );
+    return( 0 );}
+    
+
diff --git a/src/gc/threadlibs.c b/src/gc/threadlibs.c
new file mode 100644
index 000000000..7379454c4
--- /dev/null
+++ b/src/gc/threadlibs.c
@@ -0,0 +1,26 @@
+# include "gcconfig.h"
+# include <stdio.h>
+
+int main()
+{
+#   if defined(LINUX_THREADS)
+#     ifdef USE_LD_WRAP
+	printf("-Wl,--wrap -Wl,read -Wl,--wrap -Wl,dlopen "
+	       "-Wl,--wrap -Wl,pthread_create -Wl,--wrap -Wl,pthread_join "
+	       "-Wl,--wrap -Wl,pthread_sigmask -lpthread -ldl\n");
+#     else
+	printf("-lpthread -ldl\n");
+#     endif
+#   endif
+#   if defined(IRIX_THREADS)
+	printf("-lpthread\n");
+#   endif
+#   if defined(HPUX_THREADS)
+	printf("-lpthread -lrt\n");
+#   endif
+#   ifdef SOLARIS_THREADS
+        printf("-lthread -ldl\n");
+#   endif
+    return 0;
+}
+
diff --git a/src/gc/typd_mlc.c b/src/gc/typd_mlc.c
new file mode 100644
index 000000000..a198f6c15
--- /dev/null
+++ b/src/gc/typd_mlc.c
@@ -0,0 +1,817 @@
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+/* Boehm, July 31, 1995 5:02 pm PDT */
+
+
+/*
+ * Some simple primitives for allocation with explicit type information.
+ * Simple objects are allocated such that they contain a GC_descr at the
+ * end (in the last allocated word).  This descriptor may be a procedure
+ * which then examines an extended descriptor passed as its environment.
+ *
+ * Arrays are treated as simple objects if they have sufficiently simple
+ * structure.  Otherwise they are allocated from an array kind that supplies
+ * a special mark procedure.  These arrays contain a pointer to a
+ * complex_descriptor as their last word.
+ * This is done because the environment field is too small, and the collector
+ * must trace the complex_descriptor.
+ *
+ * Note that descriptors inside objects may appear cleared, if we encounter a
+ * false refrence to an object on a free list.  In the GC_descr case, this
+ * is OK, since a 0 descriptor corresponds to examining no fields.
+ * In the complex_descriptor case, we explicitly check for that case.
+ *
+ * MAJOR PARTS OF THIS CODE HAVE NOT BEEN TESTED AT ALL and are not testable,
+ * since they are not accessible through the current interface.
+ */
+
+#include "gc_priv.h"
+#include "gc_mark.h"
+#include "gc_typed.h"
+
+# ifdef ADD_BYTE_AT_END
+#   define EXTRA_BYTES (sizeof(word) - 1)
+# else
+#   define EXTRA_BYTES (sizeof(word))
+# endif
+
+GC_bool GC_explicit_typing_initialized = FALSE;
+
+int GC_explicit_kind;	/* Object kind for objects with indirect	*/
+			/* (possibly extended) descriptors.		*/
+
+int GC_array_kind;	/* Object kind for objects with complex		*/
+			/* descriptors and GC_array_mark_proc.		*/
+
+/* Extended descriptors.  GC_typed_mark_proc understands these.	*/
+/* These are used for simple objects that are larger than what	*/
+/* can be described by a BITMAP_BITS sized bitmap.		*/
+typedef struct {
+	word ed_bitmap;	/* lsb corresponds to first word.	*/
+	GC_bool ed_continued;	/* next entry is continuation.	*/
+} ext_descr;
+
+/* Array descriptors.  GC_array_mark_proc understands these.	*/
+/* We may eventually need to add provisions for headers and	*/
+/* trailers.  Hence we provide for tree structured descriptors, */
+/* though we don't really use them currently.			*/
+typedef union ComplexDescriptor {
+    struct LeafDescriptor {	/* Describes simple array	*/
+        word ld_tag;
+#	define LEAF_TAG 1
+	word ld_size;		/* bytes per element	*/
+				/* multiple of ALIGNMENT	*/
+	word ld_nelements;	/* Number of elements.	*/
+	GC_descr ld_descriptor; /* A simple length, bitmap,	*/
+				/* or procedure descriptor.	*/
+    } ld;
+    struct ComplexArrayDescriptor {
+        word ad_tag;
+#	define ARRAY_TAG 2
+	word ad_nelements;
+	union ComplexDescriptor * ad_element_descr;
+    } ad;
+    struct SequenceDescriptor {
+        word sd_tag;
+#	define SEQUENCE_TAG 3
+	union ComplexDescriptor * sd_first;
+	union ComplexDescriptor * sd_second;
+    } sd;
+} complex_descriptor;
+#define TAG ld.ld_tag
+
+ext_descr * GC_ext_descriptors;	/* Points to array of extended 	*/
+				/* descriptors.			*/
+
+word GC_ed_size = 0;	/* Current size of above arrays.	*/
+# define ED_INITIAL_SIZE 100;
+
+word GC_avail_descr = 0;	/* Next available slot.		*/
+
+int GC_typed_mark_proc_index;	/* Indices of my mark		*/
+int GC_array_mark_proc_index;	/* procedures.			*/
+
+/* Add a multiword bitmap to GC_ext_descriptors arrays.  Return	*/
+/* starting index.						*/
+/* Returns -1 on failure.					*/
+/* Caller does not hold allocation lock.			*/
+signed_word GC_add_ext_descriptor(bm, nbits)
+GC_bitmap bm;
+word nbits;
+{
+    register size_t nwords = divWORDSZ(nbits + WORDSZ-1);
+    register signed_word result;
+    register word i;
+    register word last_part;
+    register int extra_bits;
+    DCL_LOCK_STATE;
+
+    DISABLE_SIGNALS();
+    LOCK();
+    while (GC_avail_descr + nwords >= GC_ed_size) {
+    	ext_descr * new;
+    	size_t new_size;
+    	word ed_size = GC_ed_size;
+    	
+    	UNLOCK();
+        ENABLE_SIGNALS();
+    	if (ed_size == 0) {
+    	    new_size = ED_INITIAL_SIZE;
+    	} else {
+    	    new_size = 2 * ed_size;
+    	    if (new_size > MAX_ENV) return(-1);
+    	} 
+    	new = (ext_descr *) GC_malloc_atomic(new_size * sizeof(ext_descr));
+    	if (new == 0) return(-1);
+    	DISABLE_SIGNALS();
+        LOCK();
+        if (ed_size == GC_ed_size) {
+            if (GC_avail_descr != 0) {
+    	        BCOPY(GC_ext_descriptors, new,
+    	              GC_avail_descr * sizeof(ext_descr));
+    	    }
+    	    GC_ed_size = new_size;
+    	    GC_ext_descriptors = new;
+    	}  /* else another thread already resized it in the meantime */
+    }
+    result = GC_avail_descr;
+    for (i = 0; i < nwords-1; i++) {
+        GC_ext_descriptors[result + i].ed_bitmap = bm[i];
+        GC_ext_descriptors[result + i].ed_continued = TRUE;
+    }
+    last_part = bm[i];
+    /* Clear irrelevant bits. */
+    extra_bits = nwords * WORDSZ - nbits;
+    last_part <<= extra_bits;
+    last_part >>= extra_bits;
+    GC_ext_descriptors[result + i].ed_bitmap = last_part;
+    GC_ext_descriptors[result + i].ed_continued = FALSE;
+    GC_avail_descr += nwords;
+    UNLOCK();
+    ENABLE_SIGNALS();
+    return(result);
+}
+
+/* Table of bitmap descriptors for n word long all pointer objects.	*/
+GC_descr GC_bm_table[WORDSZ/2];
+	
+/* Return a descriptor for the concatenation of 2 nwords long objects,	*/
+/* each of which is described by descriptor.				*/
+/* The result is known to be short enough to fit into a bitmap		*/
+/* descriptor.								*/
+/* Descriptor is a DS_LENGTH or DS_BITMAP descriptor.			*/
+GC_descr GC_double_descr(descriptor, nwords)
+register GC_descr descriptor;
+register word nwords;
+{
+    if (descriptor & DS_TAGS == DS_LENGTH) {
+        descriptor = GC_bm_table[BYTES_TO_WORDS((word)descriptor)];
+    };
+    descriptor |= (descriptor & ~DS_TAGS) >> nwords;
+    return(descriptor);
+}
+
+complex_descriptor * GC_make_sequence_descriptor();
+
+/* Build a descriptor for an array with nelements elements,	*/
+/* each of which can be described by a simple descriptor.	*/
+/* We try to optimize some common cases.			*/
+/* If the result is COMPLEX, then a complex_descr* is returned  */
+/* in *complex_d.							*/
+/* If the result is LEAF, then we built a LeafDescriptor in	*/
+/* the structure pointed to by leaf.				*/
+/* The tag in the leaf structure is not set.			*/
+/* If the result is SIMPLE, then a GC_descr			*/
+/* is returned in *simple_d.					*/
+/* If the result is NO_MEM, then				*/
+/* we failed to allocate the descriptor.			*/
+/* The implementation knows that DS_LENGTH is 0.		*/
+/* *leaf, *complex_d, and *simple_d may be used as temporaries	*/
+/* during the construction.					*/
+# define COMPLEX 2
+# define LEAF 1
+# define SIMPLE 0
+# define NO_MEM (-1)
+int GC_make_array_descriptor(nelements, size, descriptor,
+			     simple_d, complex_d, leaf)
+word size;
+word nelements;
+GC_descr descriptor;
+GC_descr *simple_d;
+complex_descriptor **complex_d;
+struct LeafDescriptor * leaf;
+{
+#   define OPT_THRESHOLD 50
+	/* For larger arrays, we try to combine descriptors of adjacent	*/
+	/* descriptors to speed up marking, and to reduce the amount	*/
+	/* of space needed on the mark stack.				*/
+    if ((descriptor & DS_TAGS) == DS_LENGTH) {
+      if ((word)descriptor == size) {
+    	*simple_d = nelements * descriptor;
+    	return(SIMPLE);
+      } else if ((word)descriptor == 0) {
+        *simple_d = (GC_descr)0;
+        return(SIMPLE);
+      }
+    }
+    if (nelements <= OPT_THRESHOLD) {
+      if (nelements <= 1) {
+        if (nelements == 1) {
+            *simple_d = descriptor;
+            return(SIMPLE);
+        } else {
+            *simple_d = (GC_descr)0;
+            return(SIMPLE);
+        }
+      }
+    } else if (size <= BITMAP_BITS/2
+    	       && (descriptor & DS_TAGS) != DS_PROC
+    	       && (size & (sizeof(word)-1)) == 0) {
+      int result =      
+          GC_make_array_descriptor(nelements/2, 2*size,
+      				   GC_double_descr(descriptor,
+      				   		   BYTES_TO_WORDS(size)),
+      				   simple_d, complex_d, leaf);
+      if ((nelements & 1) == 0) {
+          return(result);
+      } else {
+          struct LeafDescriptor * one_element =
+              (struct LeafDescriptor *)
+        	GC_malloc_atomic(sizeof(struct LeafDescriptor));
+          
+          if (result == NO_MEM || one_element == 0) return(NO_MEM);
+          one_element -> ld_tag = LEAF_TAG;
+          one_element -> ld_size = size;
+          one_element -> ld_nelements = 1;
+          one_element -> ld_descriptor = descriptor;
+          switch(result) {
+            case SIMPLE:
+            {
+              struct LeafDescriptor * beginning =
+                (struct LeafDescriptor *)
+        	  GC_malloc_atomic(sizeof(struct LeafDescriptor));
+              if (beginning == 0) return(NO_MEM);
+              beginning -> ld_tag = LEAF_TAG;
+              beginning -> ld_size = size;
+              beginning -> ld_nelements = 1;
+              beginning -> ld_descriptor = *simple_d;
+              *complex_d = GC_make_sequence_descriptor(
+              			(complex_descriptor *)beginning,
+              			(complex_descriptor *)one_element);
+              break;
+            }
+            case LEAF:
+            {
+              struct LeafDescriptor * beginning =
+                (struct LeafDescriptor *)
+        	  GC_malloc_atomic(sizeof(struct LeafDescriptor));
+              if (beginning == 0) return(NO_MEM);
+              beginning -> ld_tag = LEAF_TAG;
+              beginning -> ld_size = leaf -> ld_size;
+              beginning -> ld_nelements = leaf -> ld_nelements;
+              beginning -> ld_descriptor = leaf -> ld_descriptor;
+              *complex_d = GC_make_sequence_descriptor(
+              			(complex_descriptor *)beginning,
+              			(complex_descriptor *)one_element);
+              break;
+            }
+            case COMPLEX:
+              *complex_d = GC_make_sequence_descriptor(
+              			*complex_d,
+              			(complex_descriptor *)one_element);
+              break;
+          }
+          return(COMPLEX);
+      }
+    }
+    {
+        leaf -> ld_size = size;
+        leaf -> ld_nelements = nelements;
+        leaf -> ld_descriptor = descriptor;
+        return(LEAF);
+    }
+}
+
+complex_descriptor * GC_make_sequence_descriptor(first, second)
+complex_descriptor * first;
+complex_descriptor * second;
+{
+    struct SequenceDescriptor * result =
+        (struct SequenceDescriptor *)
+        	GC_malloc(sizeof(struct SequenceDescriptor));
+    /* Can't result in overly conservative marking, since tags are	*/
+    /* very small integers. Probably faster than maintaining type	*/
+    /* info.								*/    
+    if (result != 0) {
+    	result -> sd_tag = SEQUENCE_TAG;
+        result -> sd_first = first;
+        result -> sd_second = second;
+    }
+    return((complex_descriptor *)result);
+}
+
+#ifdef UNDEFINED
+complex_descriptor * GC_make_complex_array_descriptor(nelements, descr)
+word nelements;
+complex_descriptor * descr;
+{
+    struct ComplexArrayDescriptor * result =
+        (struct ComplexArrayDescriptor *)
+        	GC_malloc(sizeof(struct ComplexArrayDescriptor));
+    
+    if (result != 0) {
+    	result -> ad_tag = ARRAY_TAG;
+        result -> ad_nelements = nelements;
+        result -> ad_element_descr = descr;
+    }
+    return((complex_descriptor *)result);
+}
+#endif
+
+ptr_t * GC_eobjfreelist;
+
+ptr_t * GC_arobjfreelist;
+
+mse * GC_typed_mark_proc();
+
+mse * GC_array_mark_proc();
+
+GC_descr GC_generic_array_descr;
+
+/* Caller does not hold allocation lock. */
+void GC_init_explicit_typing()
+{
+    register int i;
+    DCL_LOCK_STATE;
+
+    
+#   ifdef PRINTSTATS
+     	if (sizeof(struct LeafDescriptor) % sizeof(word) != 0)
+     	    ABORT("Bad leaf descriptor size");
+#   endif
+    DISABLE_SIGNALS();
+    LOCK();
+    if (GC_explicit_typing_initialized) {
+      UNLOCK();
+      ENABLE_SIGNALS();
+      return;
+    }
+    GC_explicit_typing_initialized = TRUE;
+    /* Set up object kind with simple indirect descriptor. */
+      GC_eobjfreelist = (ptr_t *)
+          GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+      if (GC_eobjfreelist == 0) ABORT("Couldn't allocate GC_eobjfreelist");
+      BZERO(GC_eobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+      GC_explicit_kind = GC_n_kinds++;
+      GC_obj_kinds[GC_explicit_kind].ok_freelist = GC_eobjfreelist;
+      GC_obj_kinds[GC_explicit_kind].ok_reclaim_list = 0;
+      GC_obj_kinds[GC_explicit_kind].ok_descriptor =
+    		(((word)WORDS_TO_BYTES(-1)) | DS_PER_OBJECT);
+      GC_obj_kinds[GC_explicit_kind].ok_relocate_descr = TRUE;
+      GC_obj_kinds[GC_explicit_kind].ok_init = TRUE;
+    		/* Descriptors are in the last word of the object. */
+      GC_typed_mark_proc_index = GC_n_mark_procs;
+      GC_mark_procs[GC_typed_mark_proc_index] = GC_typed_mark_proc;
+      GC_n_mark_procs++;
+        /* Moving this up breaks DEC AXP compiler.      */
+    /* Set up object kind with array descriptor. */
+      GC_arobjfreelist = (ptr_t *)
+          GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+      if (GC_arobjfreelist == 0) ABORT("Couldn't allocate GC_arobjfreelist");
+      BZERO(GC_arobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+      if (GC_n_mark_procs >= MAX_MARK_PROCS)
+      		ABORT("No slot for array mark proc");
+      GC_array_mark_proc_index = GC_n_mark_procs++;
+      if (GC_n_kinds >= MAXOBJKINDS)
+      		ABORT("No kind available for array objects");
+      GC_array_kind = GC_n_kinds++;
+      GC_obj_kinds[GC_array_kind].ok_freelist = GC_arobjfreelist;
+      GC_obj_kinds[GC_array_kind].ok_reclaim_list = 0;
+      GC_obj_kinds[GC_array_kind].ok_descriptor =
+    		MAKE_PROC(GC_array_mark_proc_index, 0);;
+      GC_obj_kinds[GC_array_kind].ok_relocate_descr = FALSE;
+      GC_obj_kinds[GC_array_kind].ok_init = TRUE;
+    		/* Descriptors are in the last word of the object. */
+            GC_mark_procs[GC_array_mark_proc_index] = GC_array_mark_proc;
+      for (i = 0; i < WORDSZ/2; i++) {
+          GC_descr d = (((word)(-1)) >> (WORDSZ - i)) << (WORDSZ - i);
+          d |= DS_BITMAP;
+          GC_bm_table[i] = d;
+      }
+      GC_generic_array_descr = MAKE_PROC(GC_array_mark_proc_index, 0); 
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+
+mse * GC_typed_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
+register word * addr;
+register mse * mark_stack_ptr;
+mse * mark_stack_limit;
+word env;
+{
+    register word bm = GC_ext_descriptors[env].ed_bitmap;
+    register word * current_p = addr;
+    register word current;
+    register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+    register ptr_t least_ha = GC_least_plausible_heap_addr;
+    
+    for (; bm != 0; bm >>= 1, current_p++) {
+    	if (bm & 1) {
+    	    current = *current_p;
+    	    if ((ptr_t)current >= least_ha && (ptr_t)current <= greatest_ha) {
+    	        PUSH_CONTENTS((ptr_t)current, mark_stack_ptr,
+			      mark_stack_limit, current_p, exit1);
+    	    }
+    	}
+    }
+    if (GC_ext_descriptors[env].ed_continued) {
+        /* Push an entry with the rest of the descriptor back onto the	*/
+        /* stack.  Thus we never do too much work at once.  Note that	*/
+        /* we also can't overflow the mark stack unless we actually 	*/
+        /* mark something.						*/
+        mark_stack_ptr++;
+        if (mark_stack_ptr >= mark_stack_limit) {
+            mark_stack_ptr = GC_signal_mark_stack_overflow(mark_stack_ptr);
+        }
+        mark_stack_ptr -> mse_start = addr + WORDSZ;
+        mark_stack_ptr -> mse_descr =
+        	MAKE_PROC(GC_typed_mark_proc_index, env+1);
+    }
+    return(mark_stack_ptr);
+}
+
+/* Return the size of the object described by d.  It would be faster to	*/
+/* store this directly, or to compute it as part of			*/
+/* GC_push_complex_descriptor, but hopefully it doesn't matter.		*/
+word GC_descr_obj_size(d)
+register complex_descriptor *d;
+{
+    switch(d -> TAG) {
+      case LEAF_TAG:
+      	return(d -> ld.ld_nelements * d -> ld.ld_size);
+      case ARRAY_TAG:
+        return(d -> ad.ad_nelements
+               * GC_descr_obj_size(d -> ad.ad_element_descr));
+      case SEQUENCE_TAG:
+        return(GC_descr_obj_size(d -> sd.sd_first)
+               + GC_descr_obj_size(d -> sd.sd_second));
+      default:
+        ABORT("Bad complex descriptor");
+        /*NOTREACHED*/ return 0; /*NOTREACHED*/
+    }
+}
+
+/* Push descriptors for the object at addr with complex descriptor d	*/
+/* onto the mark stack.  Return 0 if the mark stack overflowed.  	*/
+mse * GC_push_complex_descriptor(addr, d, msp, msl)
+word * addr;
+register complex_descriptor *d;
+register mse * msp;
+mse * msl;
+{
+    register ptr_t current = (ptr_t) addr;
+    register word nelements;
+    register word sz;
+    register word i;
+    
+    switch(d -> TAG) {
+      case LEAF_TAG:
+        {
+          register GC_descr descr = d -> ld.ld_descriptor;
+          
+          nelements = d -> ld.ld_nelements;
+          if (msl - msp <= (ptrdiff_t)nelements) return(0);
+          sz = d -> ld.ld_size;
+          for (i = 0; i < nelements; i++) {
+              msp++;
+              msp -> mse_start = (word *)current;
+              msp -> mse_descr = descr;
+              current += sz;
+          }
+          return(msp);
+        }
+      case ARRAY_TAG:
+        {
+          register complex_descriptor *descr = d -> ad.ad_element_descr;
+          
+          nelements = d -> ad.ad_nelements;
+          sz = GC_descr_obj_size(descr);
+          for (i = 0; i < nelements; i++) {
+              msp = GC_push_complex_descriptor((word *)current, descr,
+              					msp, msl);
+              if (msp == 0) return(0);
+              current += sz;
+          }
+          return(msp);
+        }
+      case SEQUENCE_TAG:
+        {
+          sz = GC_descr_obj_size(d -> sd.sd_first);
+          msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_first,
+          				   msp, msl);
+          if (msp == 0) return(0);
+          current += sz;
+          msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_second,
+          				   msp, msl);
+          return(msp);
+        }
+      default:
+        ABORT("Bad complex descriptor");
+        /*NOTREACHED*/ return 0; /*NOTREACHED*/
+   }
+}
+
+/*ARGSUSED*/
+mse * GC_array_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
+register word * addr;
+register mse * mark_stack_ptr;
+mse * mark_stack_limit;
+word env;
+{
+    register hdr * hhdr = HDR(addr);
+    register word sz = hhdr -> hb_sz;
+    register complex_descriptor * descr = (complex_descriptor *)(addr[sz-1]);
+    mse * orig_mark_stack_ptr = mark_stack_ptr;
+    mse * new_mark_stack_ptr;
+    
+    if (descr == 0) {
+    	/* Found a reference to a free list entry.  Ignore it. */
+    	return(orig_mark_stack_ptr);
+    }
+    /* In use counts were already updated when array descriptor was	*/
+    /* pushed.  Here we only replace it by subobject descriptors, so 	*/
+    /* no update is necessary.						*/
+    new_mark_stack_ptr = GC_push_complex_descriptor(addr, descr,
+    						    mark_stack_ptr,
+    						    mark_stack_limit-1);
+    if (new_mark_stack_ptr == 0) {
+    	/* Doesn't fit.  Conservatively push the whole array as a unit	*/
+    	/* and request a mark stack expansion.				*/
+    	/* This cannot cause a mark stack overflow, since it replaces	*/
+    	/* the original array entry.					*/
+    	GC_mark_stack_too_small = TRUE;
+    	new_mark_stack_ptr = orig_mark_stack_ptr + 1;
+    	new_mark_stack_ptr -> mse_start = addr;
+    	new_mark_stack_ptr -> mse_descr = WORDS_TO_BYTES(sz) | DS_LENGTH;
+    } else {
+        /* Push descriptor itself */
+        new_mark_stack_ptr++;
+        new_mark_stack_ptr -> mse_start = addr + sz - 1;
+        new_mark_stack_ptr -> mse_descr = sizeof(word) | DS_LENGTH;
+    }
+    return(new_mark_stack_ptr);
+}
+
+#if defined(__STDC__) || defined(__cplusplus)
+  GC_descr GC_make_descriptor(GC_bitmap bm, size_t len)
+#else
+  GC_descr GC_make_descriptor(bm, len)
+  GC_bitmap bm;
+  size_t len;
+#endif
+{
+    register signed_word last_set_bit = len - 1;
+    register word result;
+    register int i;
+#   define HIGH_BIT (((word)1) << (WORDSZ - 1))
+    
+    if (!GC_explicit_typing_initialized) GC_init_explicit_typing();
+    while (last_set_bit >= 0 && !GC_get_bit(bm, last_set_bit)) last_set_bit --;
+    if (last_set_bit < 0) return(0 /* no pointers */);
+#   if ALIGNMENT == CPP_WORDSZ/8
+    {
+      register GC_bool all_bits_set = TRUE;
+      for (i = 0; i < last_set_bit; i++) {
+    	if (!GC_get_bit(bm, i)) {
+    	    all_bits_set = FALSE;
+    	    break;
+    	}
+      }
+      if (all_bits_set) {
+    	/* An initial section contains all pointers.  Use length descriptor. */
+        return(WORDS_TO_BYTES(last_set_bit+1) | DS_LENGTH);
+      }
+    }
+#   endif
+    if (last_set_bit < BITMAP_BITS) {
+    	/* Hopefully the common case.			*/
+    	/* Build bitmap descriptor (with bits reversed)	*/
+    	result = HIGH_BIT;
+    	for (i = last_set_bit - 1; i >= 0; i--) {
+    	    result >>= 1;
+    	    if (GC_get_bit(bm, i)) result |= HIGH_BIT;
+    	}
+    	result |= DS_BITMAP;
+    	return(result);
+    } else {
+    	signed_word index;
+    	
+    	index = GC_add_ext_descriptor(bm, (word)last_set_bit+1);
+    	if (index == -1) return(WORDS_TO_BYTES(last_set_bit+1) | DS_LENGTH);
+    				/* Out of memory: use conservative	*/
+    				/* approximation.			*/
+    	result = MAKE_PROC(GC_typed_mark_proc_index, (word)index);
+    	return(result);
+    }
+}
+
+ptr_t GC_clear_stack();
+
+#define GENERAL_MALLOC(lb,k) \
+    (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
+    
+#define GENERAL_MALLOC_IOP(lb,k) \
+    (GC_PTR)GC_clear_stack(GC_generic_malloc_ignore_off_page(lb, k))
+
+#if defined(__STDC__) || defined(__cplusplus)
+  void * GC_malloc_explicitly_typed(size_t lb, GC_descr d)
+#else
+  char * GC_malloc_explicitly_typed(lb, d)
+  size_t lb;
+  GC_descr d;
+#endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+    lb += EXTRA_BYTES;
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_eobjfreelist[lw]);
+	FASTLOCK();
+        if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+            FASTUNLOCK();
+            op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
+	    if (0 == op) return(0);
+#	    ifdef MERGE_SIZES
+		lw = GC_size_map[lb];	/* May have been uninitialized.	*/            
+#	    endif
+        } else {
+            *opp = obj_link(op);
+	    obj_link(op) = 0;
+            GC_words_allocd += lw;
+            FASTUNLOCK();
+        }
+   } else {
+       op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
+       if (op != NULL)
+	    lw = BYTES_TO_WORDS(GC_size(op));
+   }
+   if (op != NULL)
+       ((word *)op)[lw - 1] = d;
+   return((GC_PTR) op);
+}
+
+#if defined(__STDC__) || defined(__cplusplus)
+  void * GC_malloc_explicitly_typed_ignore_off_page(size_t lb, GC_descr d)
+#else
+  char * GC_malloc_explicitly_typed_ignore_off_page(lb, d)
+  size_t lb;
+  GC_descr d;
+#endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+    lb += EXTRA_BYTES;
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_eobjfreelist[lw]);
+	FASTLOCK();
+        if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+            FASTUNLOCK();
+            op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
+#	    ifdef MERGE_SIZES
+		lw = GC_size_map[lb];	/* May have been uninitialized.	*/            
+#	    endif
+        } else {
+            *opp = obj_link(op);
+	    obj_link(op) = 0;
+            GC_words_allocd += lw;
+            FASTUNLOCK();
+        }
+   } else {
+       op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
+       if (op != NULL)
+       lw = BYTES_TO_WORDS(GC_size(op));
+   }
+   if (op != NULL)
+       ((word *)op)[lw - 1] = d;
+   return((GC_PTR) op);
+}
+
+#if defined(__STDC__) || defined(__cplusplus)
+  void * GC_calloc_explicitly_typed(size_t n,
+  				    size_t lb,
+  				    GC_descr d)
+#else
+  char * GC_calloc_explicitly_typed(n, lb, d)
+  size_t n;
+  size_t lb;
+  GC_descr d;
+#endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+GC_descr simple_descr;
+complex_descriptor *complex_descr;
+register int descr_type;
+struct LeafDescriptor leaf;
+DCL_LOCK_STATE;
+
+    descr_type = GC_make_array_descriptor((word)n, (word)lb, d,
+    					  &simple_descr, &complex_descr, &leaf);
+    switch(descr_type) {
+    	case NO_MEM: return(0);
+    	case SIMPLE: return(GC_malloc_explicitly_typed(n*lb, simple_descr));
+    	case LEAF:
+    	    lb *= n;
+    	    lb += sizeof(struct LeafDescriptor) + EXTRA_BYTES;
+    	    break;
+    	case COMPLEX:
+    	    lb *= n;
+    	    lb += EXTRA_BYTES;
+    	    break;
+    }
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+	  lw = GC_size_map[lb];
+#	else
+	  lw = ALIGNED_WORDS(lb);
+#       endif
+	opp = &(GC_arobjfreelist[lw]);
+	FASTLOCK();
+        if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+            FASTUNLOCK();
+            op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
+	    if (0 == op) return(0);
+#	    ifdef MERGE_SIZES
+		lw = GC_size_map[lb];	/* May have been uninitialized.	*/            
+#	    endif
+        } else {
+            *opp = obj_link(op);
+	    obj_link(op) = 0;
+            GC_words_allocd += lw;
+            FASTUNLOCK();
+        }
+   } else {
+       op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
+       if (0 == op) return(0);
+       lw = BYTES_TO_WORDS(GC_size(op));
+   }
+   if (descr_type == LEAF) {
+       /* Set up the descriptor inside the object itself. */
+       VOLATILE struct LeafDescriptor * lp =
+           (struct LeafDescriptor *)
+               ((word *)op
+                + lw - (BYTES_TO_WORDS(sizeof(struct LeafDescriptor)) + 1));
+                
+       lp -> ld_tag = LEAF_TAG;
+       lp -> ld_size = leaf.ld_size;
+       lp -> ld_nelements = leaf.ld_nelements;
+       lp -> ld_descriptor = leaf.ld_descriptor;
+       ((VOLATILE word *)op)[lw - 1] = (word)lp;
+   } else {
+       extern unsigned GC_finalization_failures;
+       unsigned ff = GC_finalization_failures;
+       
+       ((word *)op)[lw - 1] = (word)complex_descr;
+       /* Make sure the descriptor is cleared once there is any danger	*/
+       /* it may have been collected.					*/
+       (void)
+         GC_general_register_disappearing_link((GC_PTR *)
+         					  ((word *)op+lw-1),
+       					          (GC_PTR) op);
+       if (ff != GC_finalization_failures) {
+	   /* Couldn't register it due to lack of memory.  Punt.	*/
+	   /* This will probably fail too, but gives the recovery code  */
+	   /* a chance.							*/
+	   return(GC_malloc(n*lb));
+       }			          
+   }
+   return((GC_PTR) op);
+}
diff --git a/src/gc/version.h b/src/gc/version.h
new file mode 100644
index 000000000..01b1f3d07
--- /dev/null
+++ b/src/gc/version.h
@@ -0,0 +1,11 @@
+#define GC_VERSION_MAJOR 5
+#define GC_VERSION_MINOR 2
+#define GC_ALPHA_VERSION GC_NOT_ALPHA
+
+#   define GC_NOT_ALPHA 0xff
+
+#ifndef GC_NO_VERSION_VAR
+
+unsigned GC_version = ((GC_VERSION_MAJOR << 16) | (GC_VERSION_MINOR << 8) | GC_ALPHA_VERSION);
+
+#endif /* GC_NO_VERSION_VAR */ 
diff --git a/src/gc/weakpointer.h b/src/gc/weakpointer.h
new file mode 100644
index 000000000..84906b00a
--- /dev/null
+++ b/src/gc/weakpointer.h
@@ -0,0 +1,221 @@
+#ifndef	_weakpointer_h_
+#define	_weakpointer_h_
+
+/****************************************************************************
+
+WeakPointer and CleanUp
+
+    Copyright (c) 1991 by Xerox Corporation.  All rights reserved.
+
+    THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+    OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+
+    Permission is hereby granted to copy this code for any purpose,
+    provided the above notices are retained on all copies.
+
+    Last modified on Mon Jul 17 18:16:01 PDT 1995 by ellis
+
+****************************************************************************/
+
+/****************************************************************************
+
+WeakPointer
+
+A weak pointer is a pointer to a heap-allocated object that doesn't
+prevent the object from being garbage collected. Weak pointers can be
+used to track which objects haven't yet been reclaimed by the
+collector. A weak pointer is deactivated when the collector discovers
+its referent object is unreachable by normal pointers (reachability
+and deactivation are defined more precisely below). A deactivated weak
+pointer remains deactivated forever.
+
+****************************************************************************/
+
+
+template< class T > class WeakPointer {
+public:
+
+WeakPointer( T* t = 0 )
+    /* Constructs a weak pointer for *t. t may be null. It is an error
+       if t is non-null and *t is not a collected object. */
+    {impl = _WeakPointer_New( t );}
+
+T* Pointer()
+    /* wp.Pointer() returns a pointer to the referent object of wp or
+       null if wp has been deactivated (because its referent object
+       has been discovered unreachable by the collector). */
+    {return (T*) _WeakPointer_Pointer( this->impl );}
+
+int operator==( WeakPointer< T > wp2 )
+    /* Given weak pointers wp1 and wp2, if wp1 == wp2, then wp1 and
+       wp2 refer to the same object. If wp1 != wp2, then either wp1
+       and wp2 don't refer to the same object, or if they do, one or
+       both of them has been deactivated. (Note: If objects t1 and t2
+       are never made reachable by their clean-up functions, then
+       WeakPointer<T>(t1) == WeakPointer<T>(t2) if and only t1 == t2.) */
+    {return _WeakPointer_Equal( this->impl, wp2.impl );}
+
+int Hash()
+    /* Returns a hash code suitable for use by multiplicative- and
+       division-based hash tables. If wp1 == wp2, then wp1.Hash() ==
+       wp2.Hash(). */
+    {return _WeakPointer_Hash( this->impl );}
+
+private:
+void* impl;
+};
+
+/*****************************************************************************
+
+CleanUp
+
+A garbage-collected object can have an associated clean-up function
+that will be invoked some time after the collector discovers the
+object is unreachable via normal pointers. Clean-up functions can be
+used to release resources such as open-file handles or window handles
+when their containing objects become unreachable.  If a C++ object has
+a non-empty explicit destructor (i.e. it contains programmer-written
+code), the destructor will be automatically registered as the object's
+initial clean-up function.
+
+There is no guarantee that the collector will detect every unreachable
+object (though it will find almost all of them). Clients should not
+rely on clean-up to cause some action to occur immediately -- clean-up
+is only a mechanism for improving resource usage.
+
+Every object with a clean-up function also has a clean-up queue. When
+the collector finds the object is unreachable, it enqueues it on its
+queue. The clean-up function is applied when the object is removed
+from the queue. By default, objects are enqueued on the garbage
+collector's queue, and the collector removes all objects from its
+queue after each collection. If a client supplies another queue for
+objects, it is his responsibility to remove objects (and cause their
+functions to be called) by polling it periodically.
+
+Clean-up queues allow clean-up functions accessing global data to
+synchronize with the main program. Garbage collection can occur at any
+time, and clean-ups invoked by the collector might access data in an
+inconsistent state. A client can control this by defining an explicit
+queue for objects and polling it at safe points.
+
+The following definitions are used by the specification below:
+
+Given a pointer t to a collected object, the base object BO(t) is the
+value returned by new when it created the object. (Because of multiple
+inheritance, t and BO(t) may not be the same address.)
+
+A weak pointer wp references an object *t if BO(wp.Pointer()) ==
+BO(t).
+
+***************************************************************************/
+
+template< class T, class Data > class CleanUp {
+public:
+
+static void Set( T* t, void c( Data* d, T* t ), Data* d = 0 )
+    /* Sets the clean-up function of object BO(t) to be <c, d>,
+       replacing any previously defined clean-up function for BO(t); c
+       and d can be null, but t cannot. Sets the clean-up queue for
+       BO(t) to be the collector's queue. When t is removed from its
+       clean-up queue, its clean-up will be applied by calling c(d,
+       t). It is an error if *t is not a collected object. */ 
+       {_CleanUp_Set( t, c, d );}
+
+static void Call( T* t )
+    /* Sets the new clean-up function for BO(t) to be null and, if the
+       old one is non-null, calls it immediately, even if BO(t) is
+       still reachable. Deactivates any weak pointers to BO(t). */
+       {_CleanUp_Call( t );}
+
+class Queue {public:
+    Queue()
+        /* Constructs a new queue. */
+            {this->head = _CleanUp_Queue_NewHead();}
+
+    void Set( T* t )
+        /* q.Set(t) sets the clean-up queue of BO(t) to be q. */
+            {_CleanUp_Queue_Set( this->head, t );}
+
+    int Call()
+        /* If q is non-empty, q.Call() removes the first object and
+           calls its clean-up function; does nothing if q is
+           empty. Returns true if there are more objects in the
+           queue. */
+           {return _CleanUp_Queue_Call( this->head );}
+
+    private:
+    void* head;
+    };
+};
+
+/**********************************************************************
+
+Reachability and Clean-up
+
+An object O is reachable if it can be reached via a non-empty path of
+normal pointers from the registers, stacks, global variables, or an
+object with a non-null clean-up function (including O itself),
+ignoring pointers from an object to itself.
+
+This definition of reachability ensures that if object B is accessible
+from object A (and not vice versa) and if both A and B have clean-up
+functions, then A will always be cleaned up before B. Note that as
+long as an object with a clean-up function is contained in a cycle of
+pointers, it will always be reachable and will never be cleaned up or
+collected.
+
+When the collector finds an unreachable object with a null clean-up
+function, it atomically deactivates all weak pointers referencing the
+object and recycles its storage. If object B is accessible from object
+A via a path of normal pointers, A will be discovered unreachable no
+later than B, and a weak pointer to A will be deactivated no later
+than a weak pointer to B.
+
+When the collector finds an unreachable object with a non-null
+clean-up function, the collector atomically deactivates all weak
+pointers referencing the object, redefines its clean-up function to be
+null, and enqueues it on its clean-up queue. The object then becomes
+reachable again and remains reachable at least until its clean-up
+function executes.
+
+The clean-up function is assured that its argument is the only
+accessible pointer to the object. Nothing prevents the function from
+redefining the object's clean-up function or making the object
+reachable again (for example, by storing the pointer in a global
+variable).
+
+If the clean-up function does not make its object reachable again and
+does not redefine its clean-up function, then the object will be
+collected by a subsequent collection (because the object remains
+unreachable and now has a null clean-up function). If the clean-up
+function does make its object reachable again and a clean-up function
+is subsequently redefined for the object, then the new clean-up
+function will be invoked the next time the collector finds the object
+unreachable.
+
+Note that a destructor for a collected object cannot safely redefine a
+clean-up function for its object, since after the destructor executes,
+the object has been destroyed into "raw memory". (In most
+implementations, destroying an object mutates its vtbl.)
+
+Finally, note that calling delete t on a collected object first
+deactivates any weak pointers to t and then invokes its clean-up
+function (destructor).
+
+**********************************************************************/
+
+extern "C" {
+    void* _WeakPointer_New( void* t );
+    void* _WeakPointer_Pointer( void* wp );
+    int _WeakPointer_Equal( void* wp1, void* wp2 );
+    int _WeakPointer_Hash( void* wp );
+    void _CleanUp_Set( void* t, void (*c)( void* d, void* t ), void* d );
+    void _CleanUp_Call( void* t );
+    void* _CleanUp_Queue_NewHead ();
+    void _CleanUp_Queue_Set( void* h, void* t );
+    int _CleanUp_Queue_Call( void* h );
+}
+
+#endif /* _weakpointer_h_ */
+
+
diff --git a/src/gc/win32_threads.c b/src/gc/win32_threads.c
new file mode 100755
index 000000000..469fd2320
--- /dev/null
+++ b/src/gc/win32_threads.c
@@ -0,0 +1,211 @@
+#ifdef WIN32_THREADS
+
+#include "gc_priv.h"
+
+#if 0
+#define STRICT
+#include <windows.h>
+#endif
+
+#define MAX_THREADS 64
+
+struct thread_entry {
+  LONG in_use;
+  DWORD id;
+  HANDLE handle;
+  void *stack;		/* The cold end of the stack.   */
+			/* 0 ==> entry not valid.	*/
+			/* !in_use ==> stack == 0	*/
+  CONTEXT context;
+  GC_bool suspended;
+};
+
+volatile GC_bool GC_please_stop = FALSE;
+
+volatile struct thread_entry thread_table[MAX_THREADS];
+
+void GC_stop_world()
+{
+  DWORD thread_id = GetCurrentThreadId();
+  int i;
+
+  GC_please_stop = TRUE;
+  for (i = 0; i < MAX_THREADS; i++)
+    if (thread_table[i].stack != 0
+	&& thread_table[i].id != thread_id) {
+      if (SuspendThread(thread_table[i].handle) == (DWORD)-1)
+	ABORT("SuspendThread failed");
+      thread_table[i].suspended = TRUE;
+    }
+}
+
+void GC_start_world()
+{
+  DWORD thread_id = GetCurrentThreadId();
+  int i;
+  for (i = 0; i < MAX_THREADS; i++)
+    if (thread_table[i].stack != 0 && thread_table[i].suspended
+	&& thread_table[i].id != thread_id) {
+      if (ResumeThread(thread_table[i].handle) == (DWORD)-1)
+	ABORT("ResumeThread failed");
+      thread_table[i].suspended = FALSE;
+    }
+  GC_please_stop = FALSE;
+}
+
+ptr_t GC_current_stackbottom()
+{
+  DWORD thread_id = GetCurrentThreadId();
+  int i;
+  for (i = 0; i < MAX_THREADS; i++)
+    if (thread_table[i].stack && thread_table[i].id == thread_id)
+      return thread_table[i].stack;
+  ABORT("no thread table entry for current thread");
+}
+
+static ptr_t GC_get_lo_stack_addr(ptr_t s)
+{
+    ptr_t bottom;
+    MEMORY_BASIC_INFORMATION info;
+    VirtualQuery(s, &info, sizeof(info));
+    do {
+	bottom = info.BaseAddress;
+	VirtualQuery(bottom - 1, &info, sizeof(info));
+    } while ((info.Protect & PAGE_READWRITE) && !(info.Protect & PAGE_GUARD));
+    return(bottom);
+}
+
+void GC_push_all_stacks()
+{
+  DWORD thread_id = GetCurrentThreadId();
+  int i;
+  for (i = 0; i < MAX_THREADS; i++)
+    if (thread_table[i].stack) {
+      ptr_t bottom = GC_get_lo_stack_addr(thread_table[i].stack);
+      if (thread_table[i].id == thread_id)
+	GC_push_all_stack(&i, thread_table[i].stack);
+      else {
+	thread_table[i].context.ContextFlags
+			= (CONTEXT_INTEGER|CONTEXT_CONTROL);
+	if (!GetThreadContext(thread_table[i].handle,
+	    		      &thread_table[i].context))
+	  ABORT("GetThreadContext failed");
+	if (thread_table[i].context.Esp >= (DWORD)thread_table[i].stack
+	    || thread_table[i].context.Esp < (DWORD)bottom)
+	    ABORT("Thread stack pointer out of range");
+	GC_push_one ((word) thread_table[i].context.Edi);
+    	GC_push_one ((word) thread_table[i].context.Esi);
+    	GC_push_one ((word) thread_table[i].context.Ebx);
+    	GC_push_one ((word) thread_table[i].context.Edx);
+    	GC_push_one ((word) thread_table[i].context.Ecx);
+    	GC_push_one ((word) thread_table[i].context.Eax);
+	GC_push_all_stack(thread_table[i].context.Esp, thread_table[i].stack);
+      }
+    }
+}
+
+void GC_get_next_stack(char *start, char **lo, char **hi)
+{
+    int i;
+#   define ADDR_LIMIT (char *)(-1L)
+    char * current_min = ADDR_LIMIT;
+
+    for (i = 0; i < MAX_THREADS; i++) {
+    	char * s = (char *)thread_table[i].stack;
+
+	if (0 != s && s > start && s < current_min) {
+	    current_min = s;
+	}
+    }
+    *hi = current_min;
+    if (current_min == ADDR_LIMIT) {
+    	*lo = ADDR_LIMIT;
+	return;
+    }
+    *lo = GC_get_lo_stack_addr(current_min);
+    if (*lo < start) *lo = start;
+}
+
+LONG WINAPI GC_write_fault_handler(struct _EXCEPTION_POINTERS *exc_info);
+
+/*
+ * This isn't generally safe, since DllMain is not premptible.
+ * If another thread holds the lock while this runs we're in trouble.
+ * Pontus Rydin suggests wrapping the thread start routine instead.
+ */
+BOOL WINAPI DllMain(HINSTANCE inst, ULONG reason, LPVOID reserved)
+{
+  switch (reason) {
+  case DLL_PROCESS_ATTACH:
+    InitializeCriticalSection(&GC_allocate_ml);
+    GC_init();	/* Force initialization before thread attach.	*/
+    /* fall through */
+  case DLL_THREAD_ATTACH:
+    {
+      int i;
+      /* It appears to be unsafe to acquire a lock here, since this	*/
+      /* code is apparently not preeemptible on some systems.		*/
+      /* (This is based on complaints, not on Microsoft's official	*/
+      /* documentation, which says this should perform "only simple	*/
+      /* inititalization tasks".)					*/
+      /* Hence we make do with nonblocking synchronization.		*/
+
+      /* The following should be a noop according to the win32	*/
+      /* documentation.  There is empirical evidence that it	*/
+      /* isn't.		- HB					*/
+#     ifndef SMALL_CONFIG
+       if (GC_incremental) SetUnhandledExceptionFilter(GC_write_fault_handler);
+#     endif
+
+      for (i = 0; InterlockedExchange(&thread_table[i].in_use,1) != 0; i++) {
+	/* Compare-and-swap would make this cleaner, but that's not 	*/
+	/* supported before Windows 98 and NT 4.0.  In Windows 2000,	*/
+	/* InterlockedExchange is supposed to be replaced by		*/
+	/* InterlockedExchangePointer, but that's not really what I	*/
+	/* want here.							*/
+	if (i == MAX_THREADS - 1)
+	  ABORT("too many threads");
+      }
+      thread_table[i].id = GetCurrentThreadId();
+      if (!DuplicateHandle(GetCurrentProcess(),
+	                   GetCurrentThread(),
+			   GetCurrentProcess(),
+			   &thread_table[i].handle,
+			   0,
+			   0,
+			   DUPLICATE_SAME_ACCESS)) {
+	    DWORD last_error = GetLastError();
+	    GC_printf1("Last error code: %lx\n", last_error);
+	    ABORT("DuplicateHandle failed");
+      }
+      thread_table[i].stack = GC_get_stack_base();
+      /* If this thread is being created while we are trying to stop	*/
+      /* the world, wait here.  Hopefully this can't happen on any	*/
+      /* systems that don't allow us to block here.			*/
+      while (GC_please_stop) Sleep(20);
+    }
+    break;
+  case DLL_PROCESS_DETACH:
+  case DLL_THREAD_DETACH:
+    {
+      int i;
+      DWORD thread_id = GetCurrentThreadId();
+      LOCK();
+      for (i = 0;
+           thread_table[i].stack == 0 || thread_table[i].id != thread_id;
+	   i++) {
+	if (i == MAX_THREADS - 1)
+	  ABORT("thread not found on detach");
+      }
+      thread_table[i].stack = 0;
+      thread_table[i].in_use = FALSE;
+      CloseHandle(thread_table[i].handle);
+      BZERO(&thread_table[i].context, sizeof(CONTEXT));
+      UNLOCK();
+    }
+    break;
+  }
+  return TRUE;
+}
+
+#endif /* WIN32_THREADS */
diff --git a/src/gmp/AUTHORS b/src/gmp/AUTHORS
new file mode 100644
index 000000000..1fa057af6
--- /dev/null
+++ b/src/gmp/AUTHORS
@@ -0,0 +1,12 @@
+Authors if GNU MP (in chronological order)
+Torbjörn Granlund
+John Amanatides
+Paul Zimmermann
+Ken Weber
+Bennet Yee
+Andreas Schwab
+Robert Harley
+Linus Nordberg
+Kent Boortz
+Kevin Ryde
+Guillaume Hanrot
diff --git a/src/gmp/COPYING b/src/gmp/COPYING
new file mode 100644
index 000000000..a6d7d0188
--- /dev/null
+++ b/src/gmp/COPYING
@@ -0,0 +1,336 @@
+		    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) <year>  <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) year  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.  Hereny 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 Section
\ No newline at end of file
diff --git a/src/gmp/COPYING.LIB b/src/gmp/COPYING.LIB
new file mode 100644
index 000000000..c4792dd27
--- /dev/null
+++ b/src/gmp/COPYING.LIB
@@ -0,0 +1,515 @@
+
+                  GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 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.
+
+[This is the first released version of the Lesser GPL.  It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+                            Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it.  You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations
+below.
+
+  When we speak of free software, we are referring to freedom of use,
+not price.  Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+  To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights.  These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  To protect each distributor, we want to make it very clear that
+there is no warranty for the free library.  Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+^L
+  Finally, software patents pose a constant threat to the existence of
+any free program.  We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder.  Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+  Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License.  This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License.  We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+  When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library.  The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom.  The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+  We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License.  It also provides other free software developers Less
+of an advantage over competing non-free programs.  These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries.  However, the Lesser license provides advantages in certain
+special circumstances.
+
+  For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it
+becomes
+a de-facto standard.  To achieve this, non-free programs must be
+allowed to use the library.  A more frequent case is that a free
+library does the same job as widely used non-free libraries.  In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+  In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software.  For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+  Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+^L
+                  GNU LESSER GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control
+compilation
+and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+^L
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+^L
+  6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Use a suitable shared library mechanism for linking with the
+    Library.  A suitable mechanism is one that (1) uses at run time a
+    copy of the library already present on the user's computer system,
+    rather than copying library functions into the executable, and (2)
+    will operate properly with a modified version of the library, if
+    the user installs one, as long as the modified version is
+    interface-compatible with the version that the work was made with.
+
+    c) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    d) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    e) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+^L
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+^L
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply, and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License
+may add an explicit geographical distribution limitation excluding those
+countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+^L
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+                            NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+                     END OF TERMS AND CONDITIONS
+^L
+           How to Apply These Terms to Your New Libraries
+
+  If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change.  You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms
+of the ordinary General Public License).
+
+  To apply these terms, attach the following notices to the library.
+It is safest to attach them to the start of each source file to most
+effectively convey the exclusion of warranty; and each file should
+have at least the "copyright" line and a pointer to where the full
+notice is found.
+
+
+    <one line to give the library's name and a brief idea of what it
+does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
+
+Also add information on how to contact you by electronic and paper
+mail.
+
+You should also get your employer (if you work as a programmer) or
+your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  library `Frob' (a library for tweaking knobs) written by James
+Random Hacker.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
+That's all there is to it!
+
+
diff --git a/src/gmp/ChangeLog b/src/gmp/ChangeLog
new file mode 100644
index 000000000..613a7c542
--- /dev/null
+++ b/src/gmp/ChangeLog
@@ -0,0 +1,7972 @@
+2000-08-02  Torbjorn Granlund  <tege@swox.com>
+
+	* Version 3.1 released.
+
+	* gmp.texi: Rephrase mpf_urandomb documentation.
+
+	* mpn/alpha/ev6: New directory with ev6/21264 optimized code.
+	* mpn/alpha/ev6/addmul_1.asm: New file.
+	* mpn/alpha/ev6/gmp-mparam.h: New file.
+
+2000-08-02  Kevin Ryde  <kevin@swox.se>
+
+	* demos/factorize.c (random): Don't use "inline".
+
+	* mpfr/{log,mul_ui,round,set,set_d}.c: Corrections to K&R parts.
+
+	* Makefile.am (EXTRA_HEADERS): Omit $(MPFR_HEADERS_OPTION).
+	* mpfr/Makefile.am (EXTRA_DIST): Add mpfr.h.
+
+	* gmp.texi (Known Build Problems): Note problem stripping libgmp.a.
+
+2000-08-02  Kent Boortz  <kent@swox.com>
+
+	* mpfr: Integrated experimental version of mpfr-0.4.
+	* configure.in: Changes for option --enable-mpfr.
+	* Makefile.am: Changes for option --enable-mpfr.
+
+2000-08-01  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/popcount.c: Disable SPARC v9 popc_limb pattern.
+	* mpn/generic/hamdist.c: Likewise.
+
+2000-08-01  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/tests/try.c (try_init): Account for ALIGNMENTS when sizing
+	source and dest regions.
+
+2000-07-31  Torbjorn Granlund  <tege@swox.com>
+
+	* mpf/get_str.c: Develop three extra digits, not just one.
+
+2000-07-31  Kevin Ryde  <kevin@swox.se>
+
+	* gmp.texi (References): Add URL for invariant division.
+
+2000-07-30  Kevin Ryde  <kevin@swox.se>
+
+	* tune/time.c (speed_cpu_frequency_proc_cpuinfo): Add support for
+	alpha linux "cycle frequency".
+
+	* mpn/sparc64/gmp-mparam.h: Re-run tune program for FFT thresholds.
+
+2000-07-29  Kevin Ryde  <kevin@swox.se>
+
+	* gmp.texi (ABI and ISA): Add sparc64-*-linux*.
+	* configure.in [sparc64-*-linux*] (gmp_cflags64_gcc): Same flags
+	as under solaris.
+
+	* configure.in (--enable-fft): New option, default "no".
+	* gmp.texi (Build Options): Describe it.
+	* mpn/generic/{mul,mul_n}.c [WANT_FFT]: Use it.
+	* tune/tuneup.c [WANT_FFT]: By default don't probe FFTs if not enabled.
+	* NEWS: Multiplication optionally using FFT.
+
+	* tune/README: Notes on FFT and GCD thresholds, other minor updates.
+
+	* Makefile.am: Expunge the macos generated files update stuff.
+
+2000-07-28  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/*/gmp-mparam.h: Add some FFT thresholds.
+
+2000-07-28  Kent Boortz  <kent@swox.se>
+
+	* macos/Asm*, macos/CmnObj, macos/Mp*: Delete directories.
+	* macos/Makefile: Delete file.
+	* macos/Makefile.cw: Delete file.
+	* macos/config.h: Delete file.
+	* macos/Asm/*.s: Delete files.
+	* macos/configure: Create target directories. Don't transform
+	'(C)' to '(;)' in a 'dnl' line comment in .asm file.
+	* Makefile.am: Delete macos targets.
+	* macos/README: Reflect that we reverted back to a build
+	process that require ""macos/configure" to run on MacOS.
+	This imply that MacPerl is needed for a build in MacOS.
+
+2000-07-27  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/generic/mul_fft.c: New file, by Paul Zimmermann, minor mods
+	applied.
+	* configure.in (gmp_mpn_functions): Add it.
+	* mpn/generic/{mul,mul_n}.c: Use it.
+	* doc/multiplication: Describe it (briefly).
+
+	* gmp-impl.h (FFT_MUL_THRESHOLD etc): New thresholds.
+	(mpn_fft_best_k, mpn_fft_next_size, mpn_mul_fft, mpn_mul_fft_full):
+	New functions.
+	(numberof, TMP_ALLOC_TYPE etc, _MP_ALLOCATE_FUNC_TYPE etc,
+	UNSIGNED_TYPE_MAX etc): New macros.
+
+	* tune/*: Add FFT threshold tuning and speed measuring.
+	* tune/common.c: Avoid huge macro expansions for umul and udiv.
+
+	* mpz/tests/t-{bin,jac,misc}.c, mp{bsd,f}/tests/t-misc.c,
+	mpn/tests/{try,spinner}.c: Use new gmp-impl.h macros.
+
+	* demos/Makefile.am (BUILT_SOURCES): Don't need calc.c etc under this.
+
+2000-07-27  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/ia64/gmp-mparam.h: New file.
+
+2000-07-26  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/isprime.c: Handle any number of arguments and print
+	classification for each.  Add `-q' option for old behaviour.
+
+2000-07-26  Kevin Ryde  <kevin@swox.se>
+
+	* gmp.texi (Build Options): Mention djgpp stack size.
+	(Notes for Package Builds): New section.
+	(Compatibility with older versions): Update for 3.1, add mpf_get_prec.
+
+	* demos/factorize.c: Don't declare random() for glibc.
+
+	* gmp.h (gmp_version): Add prototype and define.
+
+	* Makefile.am: Keep macos directory generated files up-to-date
+	during development and on a "make dist".
+
+2000-07-25  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/hppa/gmp-mparam.h: Update threshold values from new `tune' run.
+
+	* mpn/pa64/gmp-mparam.h: Fill in values from `make tune' run.
+	* mpn/pa64w/gmp-mparam.h: Likewise.
+	* mpn/mips3/gmp-mparam.h: Likewise.
+
+	* tune/hppa2.asm: Fix typo in .level directive.
+
+	* configure.in: Add sparc64-*-linux* support (from Jakub Jelinek).
+	* configure: Regenerate.
+
+	* mpn/sparc64/rshift.asm: Use %g5 instead of volatile stack frame area
+	for return value (from Jakub Jelinek).
+	* mpn/sparc64/lshift.asm: Likewise.
+
+	* mpf/get_prc.c: Revert Aug 8, 1996 change.
+
+	* version.c: No longer static.
+
+	* mpn/pa64/gmp-mparam.h: Only #define *_THRESHOLD if not already
+	defined.
+	* mpn/pa64w/gmp-mparam.h: Likewise.
+	* mpn/arm/gmp-mparam.h: Likewise.
+	* mpn/mips3/gmp-mparam.h: Likewise.
+
+2000-07-25  Kevin Ryde  <kevin@swox.se>
+
+	* INSTALL: It's "info -f ./gmp.info" to be sure of hitting the
+	gmp.info in the current directory.
+
+	* Makefile.am (libmp_la_DEPENDENCIES): Add mpz/cmp.lo, for last
+	mpz/powm.c fix.
+
+	* mpn/sparc64/{add,sub}mul1h.asm: Renamed from {add,sub}mul_1h.asm
+	to avoid name conflicts on an 8.3 filesystem.
+	* mpn/sparc64/{add,sub,}mul_1.asm: Update include_mpn()s.
+
+2000-07-24  Torbjorn Granlund  <tege@swox.com>
+
+	* Update header of all files previously under the Library GPL
+	to instead be under the Lesser GPL.
+
+	* COPYING.LIB: Now Lesser GPL.
+	* demos/primes.c: Change license to GPL (was Library GPL).
+	* demos/isprime.c: Change license to GPL (was Library GPL).
+
+	* gmp.h (error code enum): Add GMP_ERROR_BAD_STRING (currently unused).
+
+	* mpz/tests/t-mul.c: Default SIZE to a function of TOOM3_MUL_THRESHOLD.
+	Improve error messages.  Decrease reps.
+
+2000-07-22  Kevin Ryde  <kevin@swox.se>
+
+	* tune/speed.h: Decrease the amount of data used for gcd and powm
+	measuring, to make the tune go a bit faster.
+
+2000-07-21  Kent Boortz  <kent@swox.se>
+
+	* macos/Asm*, macos/CmnObj, macos/Mp*: Directories no longer created
+	from configure script, now part of dist.
+	* macos/Makefile
+	* macos/Makefile.cw
+	* macos/config.h
+	* macos/Asm/*.s
+	New files and directories that is the output from configure. This way
+	no Perl installation is required to build on MacOS, just MPW.
+	* macos/configure: Added prefix '__g' to exported assembler labels.
+	Changed to handle new m4 syntax instead of the old cpp syntax in asm.
+	* macos/Makefile.in: Corrected 'clean' target, added 'distclean'
+	and 'maintainer_clean'. Added "mpn/mp_bases.c" to build.
+	* macos/README: Reflect the new build process without configure.
+	Corrected the file structure for Apple MPW installation.
+
+2000-07-21  Torbjorn Granlund  <tege@swox.com>
+
+	* mpf/tests/t-muldiv.c: Relax error limit.  Make precision depend
+	on SIZE.  Misc changes.
+
+	* configure: Regenerate.
+
+2000-07-20  Kent Boortz  <kent@swox.com>
+
+	* macos/Makefile.in: Removed hard coded targets, added special
+	targets found in Makefile.am files.
+	* macos/configure: Generate targets from top configure script and
+	Makefile.am files. Made script runnable from Unix for testing.
+	* macos/README: Notes about search paths for includes, contributed
+	by Marco Bambini.
+	* configure.in: Added comment about lines that the "macos/configure"
+	script depend on.
+
+2000-07-20  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/powm.c (mpz_powm): After final mpz_redc call, subtract `mod'
+	from result if it is greater than `mod'.
+
+2000-07-19  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/hppa/gmp-mparam.h: Fill in values from `make tune' run.
+	* mpn/alpha/gmp-mparam.h: Likewise.
+	* mpn/powerpc32/gmp-mparam.h: Likewise.
+
+	* tune/hppa.asm: New file.
+	* tune/hppa2.asm: New file.
+	* configure.in (SPEED_CYCLECOUNTER_OBJS): Set for hppa2*-*-* and
+	hppa*-*-*.
+	* tune/Makefile.am (EXTRA_DIST): Add hppa.asm and hppa2.asm.
+
+	* tune/speed.h (SPEED_ROUTINE_MPN_BZ_DIVREM_CALL): Declare `marker';
+	invoke TMP_FREE.
+
+	* mpn/hppa/hppa1_1/udiv_qrnnd.S: Use "%" instead of "'" for
+	reloc/symbol delimiter.
+
+2000-07-16  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/powerpc64/gmp-mparam.h: Update with output from tune utility.
+	* mpn/powerpc64/copyi.asm: New file.
+	* mpn/powerpc64/copyd.asm: New file.
+
+2000-07-16  Kevin Ryde  <kevin@swox.se>
+
+	* tune/*: Add measuring for umul_ppmm and udiv_qrnnd.
+
+2000-07-14  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/k6/k62mmx: New directory.
+	* configure.in (k6[23]*-*-*): Use it.
+	* mpn/x86/k6/k62mmx/copy{i,d}.asm: Move from mmx directory,
+	improve code alignment a bit.
+	* mpn/x86/k6/k62mmx/{l,r}shift.asm: Ditto, and improve addressing
+	modes for pre-CXT cores.
+	* mpn/x86/x86-defs.m4 (Zdisp): Add an instruction.
+	* mpn/x86/k6/mmx/{l,r}shift.asm: New files, suiting plain K6.
+	* mpn/x86/{README,k6/README}: Updates.
+	* mpn/x86/k6/mmx/*.asm: Update some comments.
+
+	* mpn/tests/Makefile.am: Use $(MAKE) in .asm rules, not "m".
+	* tune/Makefile.am: Use $(EXEEXT) and libtool --config objdir, for
+	the benefit of djgpp.
+
+	* */Makefile.in: Regenerate with patched automake that adds
+	$(EXEEXT) to EXTRA_PROGRAMS.
+
+	* mpn/tests/try.c: Add #ifdef to SIGBUS, for the benefit of djgpp.
+	* config.guess: Recognise pc:*:*:* as an x86, for djgpp.
+
+	* configure: Regenerate with patched autoconf to fix temp file
+	".hdr" which is invalid on a DOS 8.3 filesystem, and to fix two
+	sed substitutes that clobbered a ":" in $srcdir (eg. a DOS drive
+	spec).
+
+	* mpz/tests/io.c: Use one fp opened "w+", since separately opened
+	input and output doesn't work on MS-DOS 6.21.
+
+2000-07-13  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/tests/t-root.c: Also test mpz_perfect_power_p.
+	Generate `nth' so that there will be fewer trivial values.
+
+	* mpz/root.c: Reverse return value in tests for detecting root of +1
+	and -1.
+
+	* mpz/perfpow.c: Use TMP_ALLOC interface.
+
+2000-07-12  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/perfpow.c (primes): Make it const.
+
+2000-07-06  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/k6/cross.pl: New file.
+
+	* mpn/x86/*/gmp-mparam.h: Updates to thresholds, conditionalize
+	all _TIME defines.
+	* mpn/x86/pentium/mmx/gmp-mparam.h: New file.
+	* mpn/sparc64/gmp-mparam.h: Update thresholds.
+	* mpn/sparc32/v9/gmp-mparam.h: Ditto.
+
+2000-07-04  Kevin Ryde  <kevin@swox.se>
+
+	* NEWS: Updates.
+	* mpn/x86/*/README: Miscellaneous updates.
+
+	* tune/speed-ext.c: New file.
+	* tune/Makefile.am: Add it.
+	* tune/README: Updates.
+	* tune/speed.h (SPEED_ROUTINE_MPN_DIVREM_2): Bug fixes.
+
+	* demos/calc.y,calclex.l: New files.
+	* demos/calc.c,calc.h,calclex.c: New files, generated from .y and .l.
+	* demos/Makefile.am: Add them.
+
+	* gmp.h (mpq_swap, mpf_swap): Add prototypes and defines.
+
+2000-07-01  Kevin Ryde  <kevin@swox.se>
+
+	* gmp.texi (ABI and ISA): New section, bringing together ABI notes.
+	(Build Options): Add MPN_PATH, various updates.
+	(Build Options): Add note on setting CFLAGS when setting CC.
+	(Notes for Particular Systems): Add -march=pentiumpro problem.
+	(Known Build Problems): Note on gmp-mparam.h for 64-bit generic C.
+	(GMP Variable Conventions): Add some info on user defined functions.
+	(Reporting Bugs): Minor rewording.
+
+	* configure.in (MPN_PATH): Renamed from mpn_path.
+
+	* gmp-impl.h (ULONG_MAX,ULONG_HIGHBIT,...,SHORT_MAX): New defines.
+	* mp[zf]/tests/t-misc.c: Use them.
+
+	* mpbsd/tests/t-misc.c: New file.
+	* mpbsd/tests/Makefile.am: Add it.
+
+	* Makefile.am (LIBGMP_LT_*, LIBMP_LT_*): Bump version info.
+	* gmp.h (__GNU_MP_VERSION_*): Bump to 3.1.
+
+	* mpf/tests/Makefile.am (AUTOMAKE_OPTIONS): Add ansi2knr.
+
+	* Makefile.am (libmp_la_SOURCES): Add mp_set_fns.c, accidentally
+	omitted in gmp 3.0.x.
+	* gmp.texi (Custom Allocation): Note this is available in mpbsd,
+	and some minor rewording.
+
+2000-06-30  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/factorize.c (random): New function, defined conditionally.
+	(factor_using_pollard_rho): Use it, not mrand48.
+
+2000-06-30  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/pentium/aorsmul_1.asm: Add MULFUNC_PROLOGUE.
+
+	* mpz/tests/t-jac.c: Test limbs on mpn_jacobi_base, not just ulongs.
+
+	* gmp-impl.h, mpn/tests/try.c, mpn/tests/spinner.c, tune/speed.c:
+	Use config.h unconditionally, not under HAVE_CONFIG_H.
+
+	* demos/pexpr.c [__DJGPP__]: Patch by Richard Dawe to not use
+	setup_error_handler on djgpp.
+
+	* tune/*: Locate data to help direct-mapped caches, add measuring
+	of mpz_init/clear, mpz_add and mpz_bin_uiui, various cleanups.
+	* configure.in (AC_CHECK_FUNCS): Add popen.
+
+2000-06-29  Torbjorn Granlund  <tege@swox.com>
+
+	* mpf/mul_2exp.c: Streamline criterion for whether to use mpn_lshift or
+	mpn_rshift.  Increase precision when exp is a multiple of
+	BITS_PER_MP_LIMB primarily to make exp==0 be a noop.
+	* mpf/div_2exp.c: Analogous changes.
+
+	* mpf/tests/t-dm2exp.c: Set u randomly in loop.  Perform more
+	mpf_mul_2exp testing.
+
+	* configure.in: Recognize cray vector processors with a broad `*';
+	move after alpha* not to match that.
+
+2000-06-28  Kevin Ryde  <kevin@swox.se>
+
+	* mpz/tests/io.c: Use a disk file, not a pipe, switch to ansi2knr
+	style, switch from MP_INT to mpz_t, add a couple of error checks.
+	* mpz/tests/Makefile.am (CLEANFILES): Add io.tmp, in case io.c fails.
+
+2000-06-27  Torbjorn Granlund  <tege@swox.com>
+
+	* mpf/tests/t-get_d.c: Be more lax about relative error, to handle Cray
+	floating point format.
+
+	* mpq/tests/t-get_d.c: Decrease default reps to 1000.
+
+	* mpf/tests/t-conv.c: Correct type of `bexp'.
+
+	* configure.in (cray vector machines): Don't inherit gmp_cflags_cc.
+
+	* tune/Makefile.am (EXTRA_DIST): Delete sparc64.asm.
+
+	* configure.in (cray vector machines): Set extra_functions.
+
+	* mpn/cray/mulww.f: New file with vectorizing cray code.
+	* mpn/cray/mulww.s: Generated from mulww.f.
+	* mpn/cray/mul_1.c: New file.
+	* mpn/cray/addmul_1.c: New file.
+	* mpn/cray/submul_1.c: New file.
+	* mpn/cray/add_n.c: New file.
+	* mpn/cray/sub_n.c: New file.
+
+2000-06-26  Kevin Ryde  <kevin@swox.se>
+
+	* acinclude.m4 (GMP_CHECK_ASM_ALIGN_FILL_0x90): Fix so it actually
+	detects solaris 2.6, and also suppress warning on solaris 2.8.
+	* configure.in (SPEED_CYCLECOUNTER): Remove spurious "athlon" from
+	sparc case.
+
+	* mpn/lisp/gmpasm-mode.el: Move keymap to the top of the docstring.
+
+2000-06-21  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/generic/mul_n.c (mpn_kara_mul_n, mpn_kara_sqr_n): Use
+	mp_size_t for n2.
+	(mpn_toom3_mul_n, mpn_toom3_sqr_n): Use mp_size_t for size
+	parameters and "l" variables.
+	* gmp-impl.h (mpn_toom3_mul_n, mpn_toom3_sqr_n): Update prototypes.
+
+	* mpbsd/{itom,sdiv}.c: Add casts for correct handling of -0x80...00
+	on systems with sizeof(short)==sizeof(int).
+
+	* mpz/tests/t-misc.c: Move "bin" test from here ...
+	* mpz/tests/t-bin.c: ... to here, and add a new (2k,k) test too.
+	* mpz/tests/Makefile.am (check_PROGRAMS): Add t-bin.
+
+	* mpz/bin_ui.c [_LONG_LONG_LIMB]: Use mpn_divrem_1, since kacc is
+	a limb not a ulong.
+	* mpz/bin_uiui.c [_LONG_LONG_LIMB]: Ditto, and use mpn_mul_1 too,
+	since nacc is a limb.
+
+	* mpf/tests/t-misc.c (check_mpf_set_si, check_mpf_cmp_si):
+	New file, testing mpf_set_si, mpf_init_set_si, and mpf_cmp_si.
+	* mpf/tests/Makefile.am (check_PROGRAMS): Add it.
+
+	* mpz/tests/t-misc.c (check_mpz_set_si, check_mpz_cmp_si):
+	New tests, for mpz_set_si, mpz_init_set_si, and mpz_cmp_si.
+
+	* mpz/{set,iset,cmp}_si.c [_LONG_LONG_LIMB]: Fix handling of -0x80..00.
+	* mpf/{set,iset,cmp}_si.c [_LONG_LONG_LIMB]: Ditto.
+
+2000-06-19  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/primes.c: Properly handle arguments `m +n'.
+
+2000-06-17  Torbjorn Granlund  <tege@swox.com>
+
+	* config.sub: Recognize k5 and k6 with common pattern.
+
+	* mpq/tests/t-get_d.c: Also test mpq_set_d.  Misc improvements.
+
+	* mpq/set_d.c: Special case 0.0.  Don't call mpn_rshift with 0 count.
+	Allocate correct amount of memory for numerator.  Delete spurious
+	ASSERT_ALWAYS(1).
+
+2000-06-17  Kevin Ryde  <kevin@swox.se>
+
+	* mpz/perfsqr.c: Fix so that zero is considered a perfect square.
+	(Was wrongly calling mpn_perfect_square_p with size==0.)
+
+2000-06-16  Kevin Ryde  <kevin@swox.se>
+
+	* configure.in: Set k5*-*-* to use basic i386 code until there's
+	something specific.  Add path=x86 as a default for x86s.
+
+	* acinclude.m4 (GMP_CHECK_ASM_ALIGN_LOG): Generate
+	ALIGN_LOGARITHMIC setting, not a full ALIGN definition.
+	(GMP_CHECK_ASM_ALIGN_FILL_0x90): New test.
+	* configure.in [x86-*-*]: Use GMP_CHECK_ASM_ALIGN_FILL_0x90.
+	* mpn/asm-defs.m4 (ALIGN): New macro.
+	* mpn/x86/x86-defs.m4 (ALIGN): Remove supplementary definition.
+
+	* tune/*: Plain "unsigned" for speed_cyclecounter.
+	* configure.in: Use tune/sparcv9.asm for 32 and 64 bit modes.
+	* tune/sparc64.asm: Remove file.
+
+2000-06-15  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/x86/k7/mmx/copyi.asm: Use `testb' instead of `test'.
+	* mpn/x86/k7/mmx/copyd.asm: Likewise.
+
+	* mpn/x86/k7/mmx/lshift.asm: Avoid using `~' (Solaris as problems).
+	* mpn/x86/k7/mmx/rshift.asm: Likewise.
+	* mpn/x86/k6/aors_n.asm: Likewise.
+	* mpn/x86/k7/aors_n.asm: Likewise.
+	* mpn/x86/k7/mul_basecase.asm: Likewise.
+
+2000-06-13  Torbjorn Granlund  <tege@swox.com>
+
+	* tune/sparcv9.asm: Tune, deleting two instructions.
+
+	* tune/alpha.asm: Update to unified speed_cyclecounter.
+
+2000-06-11  Kevin Ryde  <kevin@swox.se>
+
+	* mpz/tests/reuse.c (FAIL): Add a K&R version.
+	Use _PROTO on some typedefs.
+	* mpz/tests/t-misc.c: Add gmp-impl.h for "const".
+
+	* configure.in: Rework mpn multi-function and optional files.
+	Names standardized, no need for explicit declarations, all picked
+	up in one $path traversal.
+	* doc/configuration: Updates.
+
+2000-06-10  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/{pentium/mmx,p6/mmx,p6/p3mmx}/popham.asm,
+	mpn/x86/p6/diveby3.asm: Add MULFUNC_PROLOGUE for correct
+	HAVE_NATIVE_* matching.
+
+	* mpn/x86/x86-defs.m4 (cmov_bytes_tttn): Use eval() on expressions.
+	(cmov_available_p): Switch to list CPUs which do have cmov.
+	* mpn/x86/{p6,k6,k7}/sqr_basecase.asm: Use eval() for multiplication.
+	* mpn/x86/README.family: Various updates.
+
+2000-06-09  Kevin Ryde  <kevin@swox.se>
+
+	* mpbsd/tests/allfuns.c (main): Call exit() instead of doing return.
+
+	* doc/{tasks.html,projects.html}: Moved from projects directory.
+	* doc/multiplication: New file.
+	* Makefile.am (EXTRA_DIST): Remove projects, add doc.
+
+	* Makefile.am (libgmp_la_LIBADD, libmp_la_LIBADD): Remove
+	unnecessary -lm.
+	* INSTALL: Remove -lm from instructions.
+	* demos/Makefile.am (qcn_LDADD): Add -lm.
+
+	* tune/*: Add measuring for mpn_divrem_2 and modlimb_invert,
+	improve addsub_n.  Switch to unified speed_cyclecounter.
+	* configure.in: Update configs for speed_cyclecounter.
+
+	* gmp-impl.h (MP_LIMB_T_MAX, MP_LIMB_T_HIGHBIT): New macros.
+	* mpn/generic/{diveby3,mul_n,gcd}, tune/speed.c, mpn/tests/ref.c:
+	Use them.
+
+	* mpn/tests/spinner.c: Remove setitimer, just alarm is enough.
+	* configure.in (AC_CHECK_FUNCS): Remove setitimer.
+	* mpn/tests/x86call.asm: Start with junk in %eax, %ecx, %edx.
+	* mpn/tests/ref.[ch] (refmpn_addsub_nc): New function.
+	* mpn/tests/try.c: Add some support for mpn_addsub_nc.
+	* mpn/tests/Makefile.am (EXTRA_PROGRAMS): Remove addsub_n and
+	addsub_n_2 which don't currently build.
+	* mpn/tests/copy.c: Test MPN_COPY_INCR, not __gmpn_copy.
+
+2000-06-08  Torbjorn Granlund  <tege@swox.com>
+
+	* configure.in (alpha*-*-osf*): Default `flavour' to ev6 for ev6 and
+	higher.
+	(alpha*-*-*): Likewise.
+	(alpha*-*-osf*: gmp_optcflags_cc): Move -arch/-tune flags from
+	gmp_xoptcflags_gcc.
+
+	* mpn/Makefile.am (TARG_DIST): Add pa64w.
+
+	* longlong.h: Wrap 64-bit hppa code in #ifndef LONGLONG_STANDALONE.
+
+2000-06-07  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/remove.c: Fail for `src' being zero.
+
+	* mpz/tests/reuse.c: Test more functions.
+	(FAIL): New define.
+
+	* mpz/tests/t-powm.c: Loop during operand generation while they
+	are mathematically ill-defined (used to just skip such tests).
+
+	* mpz/powm.c (mpz_redc): Clean up argument declarations.
+
+	* configure.in (gmp_cflags64_gcc): Don't add bogus -mWHAT option.
+	(sparcv9-*-solaris2.[7-9]], gmp_cflags64_gcc):
+	Inherit from previous gmp_cflags64_gcc; pass `-m64 -mptr64'.
+	(ia64*-*-*): New.
+
+	* mpn/generic/dump.c: Make it work when an mp_limb_t is not `long'.
+
+	* mpf/set_prc.c: MPN_COPY => MPN_COPY_INCR.
+
+2000-06-06  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/mul_n.c (mpn_toom3_mul_n, mpn_toom3_sqr_n):
+	Use mpn_incr_u for final carry propagation.
+
+	* mpz/tests/t-gcd.c: Add calls to mpz_gcdext with argument t == NULL.
+
+	* mpz/tests/reuse.c: Major rewrite; test many more functions.
+
+	* mpz/powm_ui.c: When exp is 0, change res assign order in order
+	to handle argument overlap.
+	* mpz/powm.c: When exp is 0, change res assign order in order
+	to handle argument overlap.  Handle negative exp and mod arguments.
+
+	* mpz/gcdext.c: Rework code after mpn_gcdext call to handle
+	argument overlap.
+
+	* mpz/fdiv_qr.c: Read dividend->_mp_size before calling mpz_tdiv_qr
+	in order to handle argument overlap.
+	* mpz/cdiv_qr.c: Likewise.
+
+	* mpf/tests/reuse.c: Fix typo that effectively disabled `dis_funcs'
+	tests.  Clean up test for mpf_ui_div.
+
+2000-06-06  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/p6/sqr_basecase.asm: New file.
+	* mpn/x86/mod_1.asm: Avoid one conditional jump.
+	* mpn/x86/p6/gmp-mparam.h: Update thresholds, #ifndef UMUL_TIME
+	and UDIV_TIME, add COUNT_TRAILING_ZEROS_TIME.
+
+	* mp_minv_tab.c: New file.
+	* Makefile.am (libgmp_la_SOURCES, libmp_la_SOURCES): Add it.
+	* gmp-impl.h (modlimb_invert): New macro.
+	* mpz/powm.c: Remove mpz_dmprepare, use modlimb_invert instead.
+	* mpn/generic/bdivmod.c: Use modlimb_invert instead of a loop.
+	* mpn/generic/gcd.c: Inline two small mpn_bdivmod calls, use
+	MPN_COPY_INCR not MPN_COPY in one place.
+
+2000-06-05  Torbjorn Granlund  <tege@swox.com>
+
+	* mpf/tests/reuse.c (dsi_funcs): Add mpf_mul_2exp and mpf_div_2exp.
+	(main): Clean up test for mpf_div_ui.
+
+	* mpf/mul_2exp.c: Correct criterion for whether to use mpn_lshift or
+	mpn_rshift.  MPN_COPY => MPN_COPY_INCR.  Coerce the two assignments to
+	r->_mp_size.
+
+	* mpf/div_2exp.c: Use mpn_rshift instead of mpn_lshift when overlap
+	so requires.  MPN_COPY => MPN_COPY_INCR.
+
+	* mpf/tests/t-dm2exp.c: Correct type of res_prec.
+
+2000-06-04  Kevin Ryde  <kevin@swox.se>
+
+	* mpz/bin_uiui.c: Fix result for n==0 and n==k.
+	* mpz/bin_ui.c: Fix result for k>n, add support for n<0.
+	* gmp.texi (Number Theoretic Functions): Update mpz_bin_ui to
+	note n<0 is supported.
+
+	* mpz/tests/t-misc.c: New file.
+	* mpz/tests/Makefile.am (check_PROGRAMS): Add it.
+
+2000-05-31  Kevin Ryde  <kevin@swox.se>
+
+	* tune/speed.* (FLAG_R_OPTIONAL): New option for routines, use on
+	mpn_gcd_1 and mpn_mul_basecase.
+	* tune/README: Update.
+
+	* tune/alpha.asm: New file, by Torbjorn.
+	* tune/Makefile.am (EXTRA_DIST): Add it.
+	* configure.in (alpha*-*-*): Use it.
+
+2000-05-30  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/mul_basecase.c: Call mpn_mul_2 and mpn_addmul_2
+	if available.  Don't include longlong.h.
+
+2000-05-30  Linus Nordberg  <linus@swox.se>
+
+	* configure.in (NM): Use AC_PROG_NM rather than AC_CHECK_TOOL to
+	find `nm'.  (AC_PROG_NM comes with Libtool and is needed to get
+	the `-B' option (BSD compatible output) included in $NM.)
+	(AR): Use AC_CHECK_PROG rather than AC_CHECK_TOOL to find `ar'.
+	(Now that NM isn't a cross compilation tool, don't give the
+	impression that we know how to cross compile.)
+	(CCAS): Remove spurious comment.
+
+	* gmp.texi (Notes for Particular Systems): Remove comment about
+	using GNU `nm' on AIX since system nm now works.
+
+2000-05-29  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/power/mul_1.s: Remove [PR] from first word in function
+	descriptor.
+	* mpn/power/addmul_1.s: Likewise.
+	* mpn/power/submul_1.s: Likewise.
+
+2000-05-28  Kevin Ryde  <kevin@swox.se>
+
+	* configure.in, tune/*: Change pentium rdtsc cycle scheme to
+	HAVE_SPEED_CYCLECOUNTER and SPEED_CYCLECOUNTER_OBJS.
+	* tune/pentium.asm: Renamed and converted from rdtsc.asm.
+	* tune/sparcv9.asm: New file, by Torbjorn.
+	* tune/sparc64.asm: New file.
+	* tune/tuneup.c: Put a limit on gcdext search.
+
+	* gmp.h (mp_set_memory_functions): Add extern "C".
+	* mp.h (__GNU_MP__): Bump to "3".
+	* mpz/add.c,mul.c,powm.c,sub.c,sqrtrem.c,tdiv_qr.c [BERKELEY_MP]:
+	Include mp.h for mpbsd compile.
+	* mpz/gcd.c: Ditto, and remove _mpz_realloc declaration.
+
+	* gmp.texi (Integer Functions): Flatten @subsections into @sections.
+	(Floating-point Functions): Ditto.
+	(Integer Random Numbers): Split from miscellaneous as a sep section.
+	(Installing GMP): Make nodes for the sections.
+	Add more "@cindex"s.
+	(Known Build Problems): Remove SunOS get_d problem, believed fixed.
+	(Notes for Particular Systems): Remove HPPA note since now PIC.
+	(References): URL for Jebelean.
+
+2000-05-27  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/pa64w: New directory, contents based on corresponding mpn/pa64
+	files.
+	* configure.in (hppa2.0w-*-*): New.
+	* mpz/tests/io.c (_INCLUDE_POSIX_SOURCE): Define when __hpux before
+	including stdio.h.
+	* gmp-impl.h: Always define DItype and UDItype.
+
+2000-05-27  Kevin Ryde  <kevin@swox.se>
+
+	* tune/common.c (speed_measure): Correction to array sorting,
+	better diagnostic when measuring fails.
+	* tune/time.c: Add microsecond accurate getrusage method.
+
+	* tune/time.c (speed_cpu_frequency_processor_info): New function.
+	* configure.in (AC_CHECK_FUNCS): Add processor_info.
+
+2000-05-26  Linus Nordberg  <linus@swox.se>
+
+	* gmp.texi (Installing GMP): Shared libraries work for AIX < 4.3
+	if using GNU nm.
+
+2000-05-26  Torbjorn Granlund  <tege@swox.com>
+
+	* tune/tuneup.c (SIGNED_TYPE_MAX): Shift `-1' instead of `1' to
+	avoid signed overflow.
+
+	* demos/pexpr.c (setup_error_handler): Don't call sigaltstack on
+	Unicos.
+
+2000-05-25  Torbjorn Granlund  <tege@swox.com>
+
+	* insert-dbl.c: Work around GCC 2.8 bug.
+	* extract-dbl.c: Likewise.
+
+	* config.sub: Allow i586, i686, i786 again.
+
+	* config.guess: Use X86CPU for lots more systems.
+
+2000-05-25  Linus Nordberg  <linus@swox.se>
+
+	* mpbsd/tests/dummy.c (main): Call exit() instead of doing return
+	(some old SysV machines don't get this correct, I've heard.)
+
+2000-05-25  Kevin Ryde  <kevin@swox.se>
+
+	* mpf/iset_str.c: Initialize _mp_size and _mp_exp to 0, in case no
+	digits in string, so it's the same as a separate init and set_str.
+
+2000-05-24  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/tests/reuse.c: Use mpz_random2 instead of mpz_random.
+
+	* mpz/divexact.c: Read pointers after reallocation.
+	Compare `quot' and `den' instead of `qp' and `dp' in overlap check.
+	Use MPN_COPY_INCR for copying from `np'.
+
+	(*-*-aix4.[3-9]*): Disable shared libs just for problematic AIX
+	versions.
+	* configure.in (*-cray-unicos*): Disable asm syntax checking; set
+	compiler explicitly.
+	* configure.in (hppa*-*-*): Remove code disabling shared libs.
+
+2000-05-24  Linus Nordberg  <linus@swox.se>
+
+	* acinclude.m4 (GMP_PROG_CC_WORKS): Don't report progress to user
+	when doing the AIX specific test to avoid "nested output".
+
+2000-05-22  Kevin Ryde  <kevin@swox.se>
+
+	* mp.h (_PROTO): Copy from gmp.h, use on prototypes.
+	Add extern "C" too.
+	* mpbsd/tests/Makefile.am (AUTOMAKE_OPTIONS): Enable ansi2knr.
+	* mpbsd/tests/allfuns.c: Don't execute mout, just link to it.
+	(main): ANSI style definition.
+
+	* gmp-impl.h (MP_BASE_AS_DOUBLE): Change the expression to
+	something that works on SunOS native cc.  Seems to fix the
+	mp*_get_d problems.
+
+	* mpn/tests/ref.c (refmpn_strip_twos): Use MPN_COPY_INCR.
+	* mpn/tests/Makefile.am: Let .asm.o rules work with absolute $srcdir.
+
+2000-05-21  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/k7/sqr_basecase.asm: Replace file with K7 specific code.
+	* mpn/x86/k7/README: Update.
+	* mpn/x86/k7/gmp-mparam.h: Tune thresholds.
+	(COUNT_TRAILING_ZEROS_TIME): New define.
+	* mpn/x86/k6/gmp-mparam.h: Ditto.
+
+	* mpn/x86/pentium/mmx/popham.asm: New file (include_mpn of K6 version).
+	* mpn/x86/p6/diveby3.asm: New file (include_mpn of P5 version).
+	* mpn/x86/p6/mmx/popham.asm: New file (include_mpn of K6 version).
+	* mpn/x86/p6/p3mmx/popham.asm: New file (include_mpn of K7 version).
+	* configure.in (pentium3-*-*): Add p3mmx to $path.
+
+	* gmp.texi (Integer Arithmetic): Clarify mpz_jacobi op2; add
+	mpz_*_kronecker_*.
+	(Miscellaneous Integer Functions): Add mpz_odd_p and mpz_even_p.
+	(Low-level Functions): Put mpn_divmod_1 with mpn_divrem_1 and note
+	it's now a macro.
+	(References): Add Henri Cohen.
+
+	* gmp.h (mpn_addmul_1c, mpn_divrem_1c, mpn_mod_1c, mpn_mul_1c,
+	mpn_submul_1c): Add prototypes.
+	(mpz_odd_p, mpz_even_p): New macros.
+
+	* mpn/asm-defs.m4 (m4wrap_prepend): New macro.
+	(m4_error): Use it.
+	(m4_not_for_expansion): Corrections to OPERATION symbols.
+	More comments about variations between m4 versions.
+	* mpn/x86/x86-defs.m4 (PROLOGUE): Use m4wrap_prepend (fixes error
+	exit under BSD m4, previously m4_error printed the message but the
+	exit code was 0).
+
+	* gmp.h (mpn_divmod_1): Change to a macro calling mpn_divrem_1.
+	* mpn/generic/divrem_1.c: Move divmod_1.c code to here, make it
+	static and call it __gmpn_divmod_1_internal.
+	* mpn/generic/divmod_1.c: Remove file.
+	* configure.in (gmp_mpn_functions): Remove divmod_1.
+	* mpn/asm-defs.m4 (define_mpn): Remove divmod_1 and divmod_1c.
+	* compat.c (mpn_divmod_1): Add compatibility function.
+	* tune/*: Remove mpn_divmod_1 measuring (leave just divrem_1).
+
+	* acconfig.h (HAVE_NATIVE_mpn_*): Add some missing carry-in
+	variants, remove divmod_1.
+
+	* mpn/x86/diveby3.asm: Use imul, update comments.
+
+	* demos/qcn.c: New file.
+	* demos/Makefile.am (EXTRA_PROGRAMS): Add it.
+
+	* mpz/tests/t-jac.c: New file.
+	* mpz/tests/Makefile.am (check_PROGRAMS): Add it. Enable ansi2knr.
+
+	* mpz/kronsz.c: New file.
+	* mpz/kronuz.c: New file.
+	* mpz/kronzs.c: New file.
+	* mpz/kronzu.c: New file.
+	* mpz/Makefile.am (libmpz_la_SOURCES): Add them.
+	* Makefile.am (MPZ_OBJECTS): Add them.
+	* gmp-impl.h (JACOBI_*, MPN_STRIP_LOW_ZEROS_NOT_ZERO): New macros.
+	* gmp.h (mpz_*_kronecker_*): New defines and prototypes.
+
+	* mpn/generic/jacbase.c: New file.
+	* mpn/generic/mod_1_rs.c: New file.
+	* configure.in (gmp_mpn_functions): Add them.
+	* gmp.h (mpn_jacobi_base, mpn_mod_1_rshift): New defines and
+	prototypes.
+	* longlong.h (COUNT_TRAILING_ZEROS_TIME): New define.
+	* mpn/tests/ref.c (refmpn_mod_1_rshift): New function.
+	* mpn/tests/try.c: Add mpn_mod_1_rshift.
+	* tune/*: Add measuring for mpn_jacobi_base.
+
+	* acinclude.m4 (GMP_FINISH): Add ifdefs to allow multiple
+	inclusion of config.m4.
+	(GMP_PROG_M4): Put "good" message through to config.log.
+
+	* mpz/powm.c: Use a POWM_THRESHOLD for where redc stops.
+	* tune/*: Add mpz_powm measuring, and tune POWM_THRESHOLD.
+	* gmp-impl.h [TUNE_PROGRAM_BUILD] (POWM_THRESHOLD): Conditional
+	redefinition for use when tuning.
+
+	* mpz/powm_ui.c: Use DIVIDE_BY_ZERO.
+
+	* mpz/iset_str.c: Initialize _mp_size to 0, in case no digits in
+	string; this makes it the same as a separate init and set_str.
+
+2000-05-20  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/asm-defs.m4: Note &,|,^ aren't bitwise in BSD m4 eval().
+	* mpn/x86/k6/sqr_basecase.asm: Use "%" not "&" in m4 eval()s.
+
+	* mpn/x86/x86-defs.m4 (Zdisp): Yet more instruction forms.
+
+2000-05-19  Linus Nordberg  <linus@swox.se>
+
+	* acinclude.m4 (GMP_CHECK_CC_64BIT): Don't use shell variable
+	`ac_compile' for our own compile command string since other
+	Autoconf macros may depend on it.
+
+2000-05-19  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/generic/mul_n.c (mpn_toom3_mul_n, mpn_toom3_sqr_n): Fix
+	carry propagation in final coefficient additions.
+
+2000-05-18  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Set NM before looking for compiler since
+	GMP_CHECK_CC_64BIT needs it.
+
+	* acinclude.m4 (GMP_CHECK_CC_64BIT): Don't execute on target.
+	(GMP_PROG_CC_FIND): Before checking if the compiler knows how to
+	produce 64-bit code, verify that it works at all.  The background
+	is that /usr/ucb/cc on Solaris 7 successfully compiles in 64-bit
+	mode but fails when doing final link.
+	(GMP_PROG_CC_WORKS): Report to user what's happening.
+
+2000-05-17  Linus Nordberg  <linus@swox.se>
+
+	* config.guess: Use X86CPU for x86 Cygwin.
+
+2000-05-16  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/p6/mmx/divrem_1.asm: New file.
+	* mpn/x86/p6/mmx/mod_1.asm: New file.
+	* mpn/x86/p6/README: Update.
+	* mpn/x86/divrem_1.asm: Update comments.
+	* mpn/x86/mod_1.asm: Ditto.
+
+2000-05-14  Kevin Ryde  <kevin@swox.se>
+
+	* tune/speed.h: Run gcd functions on a set of data.
+
+	* mpn/tests/try.c: New file.
+	* mpn/tests/try.h: New file.
+	* mpn/tests/spinner.c: New file.
+	* mpn/tests/trace.c: New file.
+	* mpn/tests/x86call.asm: New file.
+	* mpn/tests/x86check.c: New file.
+	* mpn/tests/ref.c (refmpn_hamdist): Allow size==0.
+	(refmpn_gcd): New function, and other additions supporting it.
+	* mpn/tests/ref.h: More prototypes.
+	* mpn/tests/Makefile.am: Add try program, use ansi2knr.
+
+	* mpn/x86/k7/mmx/popham.asm: New file.
+	* mpn/x86/k6/mmx/popham.asm: New file.
+	* mpn/x86/k6/sqr_basecase.asm: Unroll the addmul, for approx 1.3x
+	speedup above 15 limbs.
+	* mpn/x86/k7/README: Update.
+	* mpn/x86/k6/README: Update, and add notes on plain K6 and pre-CXT
+	K6-2 problems.
+	* configure.in (k6*-*-*, athlon-*-*): Add popham.
+
+	* mpn/x86/pentium/diveby3.asm: New file.
+	* mpn/x86/pentium/README: Update.
+
+	* gmp.texi (Installing GMP): Add note on bad OpenBSD 2.6 m4.
+	(Reporting Bugs): Ask for config.m4 if asm file related.
+	(I/O of Rationals): New section, add mpq_out_str.
+	(References): Add url for on-line gcc manuals.
+	A few node and menu updates.
+
+	* INSTALL: Better command line argument checking for test progs.
+	Change MP -> GMP.
+
+	* configure.in (WANT_ASSERT, USE_STACK_ALLOC, HAVE_PENTIUM_RDTSC):
+	Put descriptions here, not in acconfig.h.
+	(CALLING_CONVENTIONS_OBJS): New AC_SUBST (for mpn/tests/try).
+	(HAVE_CALLING_CONVENTIONS): New AC_DEFINE.
+	(AC_CHECK_HEADERS): Add sys/time.h.
+	(AC_CHECK_FUNCS): Add getpagesize, setitimer.
+	(KARATSUBA_SQR_THRESHOLD): Strip trailing comments from the
+	#define when passing through to config.m4.
+	* acconfig.h (PACKAGE, VERSION, WANT_ASSERT, USE_STACK_ALLOC,
+	HAVE_PENTIUM_RDTSC): No need for #undefs, autoheader gets them
+	from configure.in.
+
+	* acinclude.m4 (GMP_PROG_M4): Check for broken OpenBSD 2.6 m4
+	eval(), put messages into config.log.
+	* mpn/asm-defs.m4: Add notes and test for OpenBSD 2.6 m4.
+
+	* mpq/out_str.c: New file.
+	* mpq/Makefile.am (libmpq_la_SOURCES): Add it.
+	* Makefile.am (MPQ_OBJECTS): Ditto.
+	* gmp.h (mpq_out_str): New define and prototype.
+
+2000-05-12  Kevin Ryde  <kevin@swox.se>
+
+	* configure.in (CONFIG_TOP_SRCDIR): Fix to use $srcdir not
+	$top_srcdir (which doesn't exist).
+	* acinclude.m4 (GMP_C_ANSI2KNR): Fix setting U=_.
+	* gmp-impl.h (mpn_com_n, MPN_LOGOPS_N_INLINE): Fix missing "do"
+	(not currently used, probably no ill effect anyway).
+
+2000-05-11  Torbjorn Granlund  <tege@swox.com>
+
+	* randraw.c (lc): Major overhaul (pending rewrite).
+	(_gmp_rand): Rewrite.
+
+2000-05-08  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/tests/convert.c: Call free via _mp_free_func.
+	* mpf/tests/t-conv.c: Likewise.
+
+	* memory.c: Add code enabled for DEBUG that adds special patterns
+	around allocated blocks.
+
+2000-05-05  Linus Nordberg  <linus@swox.se>
+
+	* gmp.texi (Miscellaneous Float Functions): Correct parameter list
+	for mpf_urandomb().
+
+	* configure.in: Invoke AC_REVISION.
+
+2000-05-05  Kevin Ryde  <kevin@swox.se>
+
+	* gmp.texi: Use @dircategory and @direntry.
+	(Installing GMP): Clarification for --target, updates on SunOS
+	problems.
+	(Integer Arithmetic): Add mpz_mul_si.
+	(Initializing Rationals): Add mpq_swap.
+	(Assigning Floats): Add mpf_swap.
+	(Low-level Functions): Add mpn_divexact_by3c, and details of what
+	the calculation actually gives.
+	(Low-level Functions): Note extra space needed by mpn_gcdext,
+	clarify the details a bit.
+
+	* compat.c: New file, entry points for upward binary compatibility.
+	(mpn_divexact_by3): Compatibility function.
+	* Makefile.am (libgmp_la_SOURCES): Add compat.c.
+
+	* mpn/tests/ref.c: Rearrange macros for ansi2knr.
+	(div1): Renamed from div to avoid library function.
+	(refmpn_divexact_by3c, refmpn_gcd_1, refmpn_popcount,
+	refmpn_hamdist): New functions.
+	* mpn/tests/ref.h: Add extern "C", add new prototypes.
+
+	* gmp.h (gmp_randinit, etc): Add extern "C".
+	(_mpq_cmp_ui): Fix prototype name from mpq_cmp_ui.
+	(mpn_divexact_by3): Now a macro calling mpn_divexact_by3c.
+	(mpn_divexact_by3c): New prototype and define.
+
+	* mpn/x86/diveby3.asm: Change to mpn_divexact_by3c.
+	* mpn/x86/k6/diveby3.asm: Ditto.
+	* mpn/generic/diveby3.c: Ditto.
+	* mpn/asm-defs.m4: Ditto on the define_mpn.
+	* acconfig.h (HAVE_NATIVE_mpn_divexact_by3c): New define.
+
+	* mpq/swap.c: New file, derived from mpz/swap.c.
+	* mpf/swap.c: Ditto.
+	* mpq/Makefile.am: Add swap.c.
+	* mpf/Makefile.am: Ditto.
+	* Makefile.am: Add two new "swap.lo"s.
+
+	* mpn/x86/k6/mmx/com_n.asm: Fix an addressing bug (fortunately
+	this code hasn't been used anywhere yet).
+
+	* mpn/x86/k7/mmx/divrem_1.asm: New file.
+	* mpn/x86/k7/mmx/mod_1.asm: New file.
+	* mpn/x86/k7/diveby3.asm: New file.
+	* mpn/x86/k7/README: Update.
+
+	* mpn/x86/k7/aorsmul_1.asm: Use new cmovCC, no object code change.
+	* mpn/x86/k7/mul_basecase.asm: Ditto.
+	* mpn/x86/p6/aorsmul_1.asm: Ditto.
+
+	* mpn/x86/x86-defs.m4 (defframe_empty_if_zero): Eval the argument.
+	(cmovCC): New macros, replacing individual cmovCC_reg_reg forms.
+	(Zdisp): Recognise more instructions.
+	(shldl,etc): Use m4_instruction_wrapper().
+	(ASSERT, movl_text_address): New macros.
+
+	* mpn/asm-defs.m4: Add remarks on SunOS /usr/bin/m4 and new
+	OpenBSD m4.
+	(m4_assert_numargs_internal_check): Remove a spurious parameter.
+	(m4_empty_if_zero): Eval the argument.
+	(m4_assert, m4_assert_numargs_range, m4_config_gmp_mparam,
+	m4_instruction_wrapper): New macros.
+
+2000-05-04  Linus Nordberg  <linus@swox.se>
+
+	* gmp.texi (Reporting Bugs): Be explicit about output from running
+	a command.
+
+2000-05-02  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/bz_divrem_n.c (mpn_bz_divrem_n): Handle non-zero return
+	from first mpn_bz_div_3_halves_by_2 call.
+	(mpn_bz_divrem_aux): Likewise.
+
+2000-04-30  Kevin Ryde  <kevin@swox.se>
+
+	* tune/* (GCD_ACCEL_THRESHOLD, GCDEXT_THRESHOLD): Tune these.
+
+	* mpn/generic/gcdext.c (GCDEXT_THRESHOLD): Rename from THRESHOLD,
+	use with >=, adjust default to 17 accordingly.
+	Use new *_SWAP macros.
+
+	* mpn/generic/gcd.c (GCD_ACCEL_THRESHOLD): Rename from
+	ACCEL_THRESHOLD, use with >=, adjust default to 5 accordingly.
+	Use new *_SWAP macros.
+
+	* mpf/get_str.c, mpf/set_str.c, mpf/sub.c, mpz/add.c, mpz/ior.c,
+	mpz/and.c, mpz/sub.c, mpz/xor.c, mpz/ui_pow_ui.c,
+	mpn/generic/mul.c: Use new *_SWAP macros.
+
+	* stack-alloc.h: Add extern "C" around prototypes.
+
+	* gmp-impl.h: (MP_PTR_SWAP, etc): New macros.
+	(_mp_allocate_func, etc): Use _PROTO.
+	[TUNE_PROGRAM_BUILD]: More changes in tune program build part.
+
+2000-04-28  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/pa64/add_n.s: Add `,entry' to export directive.
+	* mpn/pa64/{addmul_1.S,lshift.s,mul_1.S,rshift.s,sub_n.s,submul_1.S,
+	umul_ppmm.S}: Likewise.
+	* mpn/hppa/hppa1_1/udiv_qrnnd.S: New name for udiv_qrnnd.s.
+	Add PIC support.
+
+2000-04-29  Kevin Ryde  <kevin@swox.se>
+
+	* gmp-impl.h [TUNE_PROGRAM_BUILD] (TOOM3_MUL_THRESHOLD_LIMIT): New
+	define.
+	* mpn/generic/mul_n.c [TUNE_PROGRAM_BUILD] (mpn_mul_n): Use
+	TOOM3_MUL_THRESHOLD_LIMIT, not a hard coded 500.
+
+	* memory.c: Use <stdlib.h> for malloc etc, and use _PROTO.
+	* stack-alloc.c: Don't use C++ reserved word "this".
+	* urandom.h: Put extern "C" around prototypes.
+	* mpz/powm.c: Switch a couple of parameters to "const", which they
+	are, to satisfy g++.
+
+	* randraw.c, stack-alloc.c, mpbsd/mout.c, mpbsd/mtox.c: Add casts to
+	help g++.
+
+	* stack-alloc.c: Provide dual ANSI/K&R function definitions.
+	* mpz/addmul_ui.c,get_d.c,inp_str.c,perfpow.c,powm.c,pprime_p.c,
+	rrandomb.c,set_str.c,ui_pow_ui.c: Ditto.
+	* mpf/integer.c,set_str.c: Ditto.
+	* mpbsd/min.c,xtom.c: Ditto.
+	* mpn/generic/bz_divrem_n.c,dump.c,gcd_1.c,get_str.c,hamdist.c,
+	popcount.c,random.c,random2.c,set_str.c: Ditto.
+
+	* rand.c: Use <stdio.h> for NULL.
+	* mpz/gcd_ui.c,gcdext.c,mul.c,perfpow.c,powm_ui.c,root.c,sqrt.c,
+	sqrtrem.c: Ditto
+	* mpf/sqrt.c,sqrt_ui.c: Ditto.
+	* mpn/generic/perfsqr.c,sqrtrem.c: Ditto.
+
+	* gmp-impl.h (NULL, malloc, realloc, free): Don't define/declare.
+	(extern "C"): Add around function prototypes.
+	(mpn_kara_mul_n, mpn_kara_sqr_n, mpn_toom3_mul_n, mpn_toom3_sqr_n):
+	Add prototypes.
+	[TUNE_PROGRAM_BUILD] (FIB_THRESHOLD): Add necessary redefinitions for
+	use by tune program.
+	* mpn/generic/mul_n.c: Remove mpn_toom3_mul_n prototype.
+
+	* acinclude.m4 (GMP_C_ANSI2KNR): New macro.
+	(GMP_CHECK_ASM_MMX, GMP_CHECK_ASM_SHLDL_CL): Fix to use
+	$gmp_cv_check_asm_text which is what GMP_CHECK_ASM_TEXT sets.
+	* configure.in (GMP_C_ANSI2KNR): Use this instead of AM_C_PROTOTYPES,
+	for reasons described with its definition.
+
+	* demos/Makefile.am (ansi2knr): Use $(top_builddir) nor $(top_srcdir).
+
+	* mpz/fib_ui.c (FIB_THRESHOLD): Rename from FIB_THRES, for consistency.
+	(FIB_THRESHOLD): Conditionalize so gmp-mparam.h can define a value.
+	(mpz_fib_bigcase): Use >= FIB_THRESHOLD, same as main mpz_fib_ui.
+	* tune/tuneup.c,Makefile.am (FIB_THRESHOLD): Tune this.
+
+	* configure.in (*-*-aix* gmp_m4postinc): Fix setting (don't overwrite
+	a value just stored).
+
+2000-04-26  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/sparc32/udiv_fp.asm: Use mpn_udiv_qrnnd macro.
+	* mpn/sparc32/udiv_nfp.asm: Ditto.
+	* mpn/sparc32/v8/supersparc/udiv.asm: Ditto.
+	* mpn/sparc32/umul.asm: Name the function mpn_umul_ppmm.
+	* mpn/sparc32/v8/umul.asm: Ditto.
+	* mpn/powerpc32/umul.asm: Ditto.
+
+	* mpn/x86/syntax.h: Remove file, since now unused.
+
+	* configure.in (x86): Remove -DBROKEN_ALIGN and -DOLD_GAS
+	previously used by .S files.
+	(x86 extra_functions): Add udiv and umul.
+	(GMP_PROG_M4): Use this instead of AC_CHECK_PROG(M4,m4,...)
+	(HAVE_NATIVE_*): Loosen up the regexp to "PROLOGUE.*" so as to
+	accept PROLOGUE_GP on alpha.
+
+	* acconfig.h (HAVE_NATIVE_mpn_umul_ppmm, udiv_qrnnd, invert_limb):
+	New template defines.
+	* mpn/asm-defs.m4 (mpn_umul_ppmm, mpn_udiv_qrnnd): New define_mpn()s.
+	* longlong.h (umul_ppmm, udiv_qrnnd): Use a library version if
+	it's available and an asm macro isn't.
+	* gmp-impl.h (invert_limb): Ditto.
+
+	* gmp-impl.h (ASSERT_NOREALLOC): Not a good idea, remove it.
+
+	* acinclude.m4 (GMP_PROG_M4): New macro.
+
+2000-04-25  Linus Nordberg  <linus@swox.se>
+
+	* gmp.texi (Random State Initialization): Correct arguments to
+	`gmp_randinit'.
+
+	* acinclude.m4 (GMP_VERSION): Change `eval' --> `m4_eval'.  Fix
+	from Kevin.
+	* aclocal.m4: Regenerate.
+
+2000-04-25  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/aors_n.asm: Remove parentheses around an immediate that
+	Solaris "as" doesn't like, change by Torbjorn.
+
+2000-04-24  Kevin Ryde  <kevin@swox.se>
+
+	* configure.in (AC_CHECK_FUNCS): Add strtoul.
+
+	* mpn/generic/mul_n.c [TUNE_PROGRAM_BUILD] (mpn_mul_n): Bigger
+	array for karatsuba temporary space for tune program build.
+	(mpn_toom3_sqr_n) Remove an unused variable.
+
+	* demos/Makefile.am (AUTOMAKE_OPTIONS): Add ansi2knr.
+	Add "allprogs:" pseudo-target.
+	* demos/factorize.c, demos/isprime.c: Switch to ANSI functions,
+	rely on ansi2knr.
+
+	* gmp.texi (Getting the Latest Version of GMP): Add reference to
+	ftp.gnu.org mirrors list.
+	* INSTALL: Add arg count check to example programs.
+
+	* mpn/x86/*/*.asm: Convert to FORTRAN ... or rather to
+	FORTRAN-style "C" commenting to support Solaris "as".
+	* mpn/x86/x86-defs.m4: Ditto, and add another Zdisp insn.
+	* mpn/asm-defs.m4 (C): Update comments.
+	* mpn/x86/README.family: Add a note on commenting, remove
+	description of .S files.
+
+	* mpn/sparc64/addmul_1.asm, mul_1.asm, submul_1.asm: Use
+	include_mpn().
+
+2000-04-23  Torbjorn Granlund  <tege@swox.com>
+
+	* config.sub: Merge with FSF version of April 23.
+
+	* mpn/powerpc32: Use dnl/C instead of `#' for comments.
+
+	* config.guess: Get "model" limit between pentium 2 and pentium3 right.
+	Get rid of code determining `_' prefix;	use double labels instead.
+	* config.guess: Partially merge with FSF version of April 22.
+	(Don't bring over NetBSD changes for now.)
+
+2000-04-23  Kevin Ryde  <kevin@swox.se>
+
+	* tune/Makefile.am, README, common.c, rdtsc.asm, speed.c, speed.h,
+	time.c, tuneup.c: New files.
+	* tune/Makefile.in: New file, generated from Makefile.am.
+
+	* gmp-impl.h (ASSERT_NOREALLOC,TMP_ALLOC_LIMBS): New macros.
+	[TUNE_PROGRAM_BUILD] Further mods for tune program builds.
+
+	* mpz/Makefile.am: Add -DOPERATION_$* for new mul_siui.c.
+	Add rules to build mul_si and mul_ui from a common mul_siui.c.
+	* mpz/mul_siui.c: New file, derived from and replacing mul_ui.c.
+	* gmp.h (mpz_mul_si): New prototype and define.
+
+	* mpn/tests/*.c [__i386__] (CLOCK): Don't use floating point in
+	CLOCK because cpp can't handle floats in #if's (TIMES is derived
+	from CLOCK by default).
+
+	* mpn/asm-defs.m4 (include_mpn): New macro.
+	(m4_assert_numargs) Changes to implementation.
+
+	* mpf/Makefile.am: Add -DOPERATION_$* for new integer.c.
+	Remove explicit rules for floor.o etc.
+	* mpf/integer.c: Use OPERATION_$* for floor/ceil/trunc.
+
+	* mpn/Makefile.am: Put "tests" in SUBDIRS.
+	* mpn/tests/Makefile.am: New file providing rules to build test
+	programs, nothing done in a "make all" or "make check" though.
+	* mpn/tests/README: New file.
+
+	* acconfig.h (HAVE_PENTIUM_RDTSC): New define.
+
+	* configure.in (x86): Rearrange target cases.
+	Add mulfunc aors_n and aorsmul_1 for x86 and pentium (now all x86s).
+	Remove asm-syntax.h generation not needed.
+	Remove now unused family=x86.
+	(sparc) Remove unused family=sparc.
+	(HAVE_PENTIUM_RDTSC) New AC_DEFINE and AM_CONDITIONAL.
+	(AM_C_PROTOTYPES) New test, supporting ansi2knr.
+	(AC_CHECK_HEADERS) Add getopt.h, unistd.h and sys/sysctl.h for
+	tune progs.
+	(AC_CHECK_FUNCS) Add getopt_long, sysconf and sysctlbyname for
+	tune progs.
+	(config.m4 CONFIG_TOP_SRCDIR) Renamed from CONFIG_SRCDIR.
+	(config.m4 asm-defs.m4) Use CONFIG_TOP_SRCDIR and include().
+	(gmp_m4postinc) Use include_mpn().
+	(gmp_links) Omit asm-defs.m4/asm.m4 and gmp_m4postinc's.
+	(MULFUNC_PROLOGUE) Fix regexps so all functions get AC_DEFINE'd.
+	(PROLOGUE) Ditto (native copyi and copyd were unused in gmp 3).
+	(KARATSUBA_SQR_THRESHOLD) Copy from gmp-mparam.h into config.m4.
+	(AC_OUTPUT) Add tune/Makefile, mpn/tests/Makefile.
+
+	* Makefile.am (AUTOMAKE_OPTIONS): Add ansi2knr.
+	(SUBDIRS): Add tune, reorder directories.
+	(MPZ_OBJECTS): Add mpz/mul_si.lo.
+	(libmp_la_SOURCES): Use this for top-level objects, not .lo's.
+	* ansi2knr.{c,1}: New files, provided by automake.
+
+	* mpn/x86/aors_n.asm: Convert add_n.S and sub_n.S to a
+	multi-function aors_n.asm, no object code change.
+	* mpn/x86/pentium/aors_n.asm: Ditto.
+	* mpn/x86/aorsmul_1.asm: Ditto for addmul/submul.
+	* mpn/x86/pentium/aorsmul_1.asm: Ditto.
+
+	* mpn/x86/{lshift,mul_1,mul_basecase,rshift}.asm: Convert from .S,
+	no object code change.
+	* mpn/x86/pentium/{lshift,mul_1,mul_basecase,rshift}.asm: Ditto.
+
+	* gmp.texi (Reporting Bugs): Itemize the list of things to include.
+	(Miscellaneous Float Functions): Correct typo in mpf_ceil etc
+	argument types.
+	Change @ifinfo -> @ifnottex for benefit of makeinfo --html.
+	Remove unnecessary @iftex's around @tex.
+
+2000-04-22  Torbjorn Granlund  <tege@swox.com>
+
+	* config.guess: Generalize x86 cpu determination code.
+	Now works on Solaris.
+
+	* mpz/nextprime.c: Rewrite still disabled code.
+
+	* configure.in: Specifically match freebsd[3-9].
+
+2000-04-21  Torbjorn Granlund  <tege@swox.com>
+
+	* rand.c: Call mpz_clear for otherwise leaking mpz_t.
+
+	* mpz/pprime_p.c (mpz_probab_prime_p): Merge handling of negative
+	n into code for handling small positive n.  Merge variables m and n.
+	After dividing, simply call mpz_millerrabin.
+	(isprime): Local variables now use attribute `long'.
+	(mpz_millerrabin): New static function, based on code from
+	mpz_probab_prime_p.
+	(millerrabin): Now simple workhorse for mpz_millerrabin.
+
+2000-04-19  Torbjorn Granlund  <tege@swox.com>
+
+	* gmp-impl.h: Fix parenthesis error in test for __APPLE_CC__.
+
+2000-04-18  Linus Nordberg  <linus@swox.se>
+
+	* NEWS: Add info about shared libraries.  Remove reference to
+	gmp_randinit_lc.
+
+2000-04-17  Torbjorn Granlund  <tege@swox.com>
+
+	* Version 3.0 released.
+
+	* mpn/arm/add_n.S: New version from Robert Harley.
+	* mpn/arm/addmul_1.S: Likewise.
+	* mpn/arm/mul_1.S: Likewise.
+	* mpn/arm/sub_n.S: Likewise.
+
+	* gmp.h (__GNU_MP_VERSION_PATCHLEVEL): Now 0.
+
+2000-04-17  Linus Nordberg  <linus@swox.se>
+
+	* configure.in (hppa2.0*-*-*): Pass `+O3' to cc/c89 in 64-bit mode
+	to avoid compiler bug.
+	(ns32k*-*-*): Fix typo in path.  Change by Kevin.
+	(alpha*-*-osf*): New case.  Pass assembly flags for architecture
+	to gcc.
+	(alpha*-*-*): Don't bother searching for cc.
+	* configure: Regenerate.
+
+	* Makefile.am (EXTRA_DIST): Add `macos', `.gdbinit'.
+	* Makefile.in: Regenerate.
+	* mpn/Makefile.am (EXTRA_DIST): Add `m88k', `lisp'.
+	* mpn/Makefile.in: Regenerate.
+
+2000-04-16  Kevin Ryde  <kevin@swox.se>
+
+	* README: Updates, and don't duplicate the example in INSTALL.
+	* INSTALL: Minor updates.
+	* gmp.texi (Installing MP): Minor edits, restore CC/CFLAGS description.
+
+2000-04-16  Linus Nordberg  <linus@swox.se>
+
+	* configure.in (*-*-cygwin*): Select BSD_SYNTAX to avoid
+	.type/.size in PROLOGUE for ELF_SYNTAX.  Override ALIGN definition
+	from x86/syntax.h.
+	(gmp_xoptcflags_${CC}): New set of variables, indicating
+	``exclusive optional cflags''.
+	(most sparcs): Use gmp_xoptcflags instead of gmp_optcflags to
+	ensure that we pass CPU type to older gcc.
+	(CFLAGS): CFLAGS on the command line was spoiled.
+	* configure: Regenerate.
+
+2000-04-16  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Invoke AC_PROG_LIBTOOL directly.
+
+	* acinclude.m4 (GMP_PROG_CC_FIND): Quote source variable when
+	setting CC64 and CFLAGS64.
+	(GMP_PROG_CC_SELECT): Cache result.
+	(GMP_PROG_LIBTOOL): Remove.
+
+	* aclocal.m4: Regenerate.
+	* configure: Regenerate.
+
+2000-04-16  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/dump.c: Suppress output of leadign zeros.
+
+	* mpz/inp_str.c: Fix memory leakage.
+
+	* mpz/tests/reuse.c (dss_func_division): Add a final 1.
+
+	* longlong.h (alpha count_leading_zeros): Wrap in __MPN.
+	* mpn/alpha/cntlz.asm: Use __gmpn prefix (by means of __MPN).
+
+	* longlong.h (__umul_ppmm, __udiv_qrnnd): Wrap in __MPN.
+	* mpn/alpha/udiv_qrnnd.S: Use __gmpn prefix.
+	* mpn/hppa/udiv_qrnnd.s: Likewise.
+	* mpn/hppa/hppa1_1/udiv_qrnnd.s: Likewise.
+	* mpn/pa64/udiv_qrnnd.c: Likewise (by means of __MPN).
+	* mpn/pa64/umul_ppmm.S: Likewise.
+	* mpn/sparc32/udiv_fp.asm: Likewise (by means of MPN).
+	* mpn/sparc32/udiv_nfp.asm: Likewise (by means of MPN).
+	* mpn/sparc32/v8/supersparc/udiv.asm: Likewise (by means of MPN).
+
+	* mpn/generic/tdiv_qr.c: Work around gcc 2.7.2.3 i386 register handling
+	bug.
+
+	* mpn/generic/tdiv_qr.c: Use udiv_qrnnd instead of mpn_divrem_1
+	when computing appropriate quotient; mpn_divrem_1 writes too
+	many quotient limbs.
+
+	* mpn/asm-defs.m4: invert_normalized_limb => invert_limb.
+	* mpn/alpha/invert_limb.asm: mpn_invert_normalized_limb =>
+	mpn_invert_limb.
+	* gmp.h: Likewise.
+	* gmp-impl.h (alpha specific): invert_normalized_limb => invert_limb;
+	wrap with __MPN.
+	* longlong.h (alpha udiv_qrnnd): Likewise.
+
+2000-04-16  Kevin Ryde  <kevin@swox.se>
+
+	* gmp.h (mp_set_memory_functions,mp_bits_per_limb,gmp_errno): Add
+	#defines so the library symbols are __gmp_*.
+	* errno.c: Include gmp.h.
+	* gmp-impl.h (_mp_allocate_func,etc): Add #defines to __gmp_*.
+	(__clz_tab): New #define to __MPN(clz_tab).
+	* stack-alloc.c (__gmp_allocate_func,etc): Change from _mp_*.
+
+	* Makefile.am (libmp_la_DEPENDENCIES): Add some mpz files needed
+	for new mpz_powm (pow in libmp).
+	(EXTRA_DIST): Add projects directory.
+
+	* mpn/*: Change __mpn to __gmpn.
+	* gmp.h (__MPN): Ditto.
+	* stack_alloc.c,stack-alloc.h: Change __tmp to __gmp_tmp.
+
+	* mpn/generic/sb_divrem_mn.c (mpn_sb_divrem_mn): Avoid gcc 2.7.2.3
+	i386 register handling bug (same as previously in mpn_divrem_classic).
+
+	* mpn/generic/divrem.c: Now contains mpn_divrem, which is not an
+	internal function, so remove warning comment.
+
+	* gmp.texi (Compatibility with Version 2.0.x): Source level only.
+
+2000-04-16  Linus Nordberg  <linus@swox.se>
+
+	* configure.in (hppa1.0*): Prefer c89 to cc.
+	* configure: Regenerate.
+
+2000-04-15  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: If `mpn_path' is set by user on configure command
+	line, use that as path.
+	* configure: Regenerate.
+
+2000-04-15  Linus Nordberg  <linus@swox.se>
+
+	* configure.in (hppa2.0*): Use path "hppa/hppa1_1 hppa" if no
+	64-bit compiler was found.
+	* configure: Regenerate.
+
+2000-04-15  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Honor `CC' and `CFLAGS' set by user on configure
+	command line.
+	* acinclude.m4: (GMP_PROG_CC_SELECT): Set CFLAGS if not set already.
+	* aclocal.m4: Regenerate.
+	* configure: Regenerate.
+
+2000-04-15  Linus Nordberg  <linus@swox.se>
+
+	* acinclude.m4 (GMP_PROG_CC_FIND): Remove debug output.  Remove
+	commented out code.
+	* aclocal.m4: Regenerate.
+	* configure: Regenerate.
+
+	* configure.in: Make all `-mcpu' options to gcc optional.
+	* configure: Regenerate.
+
+2000-04-15  Kevin Ryde  <kevin@swox.se>
+
+	* README: Small updates.
+	* NEWS: Add some things about 3.0.
+
+	* mpz/Makefile.am (EXTRA_DIST): Remove dmincl.c.
+
+	* Makefile.am: Use -version-info on libraries, not -release.
+
+	* mpz/tdiv_qr.c: Add mdiv function header #ifdef BERKELEY_MP.
+	* mpbsd/Makefile.am: Use mpz/tdiv_qr.c, not mdiv.c.
+	* Makefile.am (MPBSD_OBJECTS): Change mdiv.lo to tdiv_qr.lo.
+	(libmp_la_DEPENDENCIES): Add mp_clz_tab.lo.
+	* mpbsd/mdiv.c: Remove file.
+
+	* config/mt-linux,mt-m68k,mt-m88110,mt-ppc,mt-ppc64-aix,mt-pwr,
+	mt-sprc8-gcc,mt-sprc9-gcc,mt-supspc-gcc,mt-vax,mt-x86,
+	mpn/config/mt-pa2hpux,mt-sprc9,t-oldgas,t-ppc-aix,t-pwr-aix:
+	Remove configure fragments not used since change to autoconf.
+
+	* mpn/generic/bz_divrem_n.c,sb_divrem_mn.c: Add comment that
+	internal functions are changeable and shouldn't be used directly.
+
+2000-04-15  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Remove debug output.
+	* configure: Regenerate.
+
+2000-04-15  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/tdiv_qr.c: Don't use alloca directly.
+
+	* mpz/tdiv_qr.c: Fix typo.
+	* mpz/tdiv_r.c: Fix typo.
+	* mpz/tdiv_q.c: Fix typo.
+
+	* configure.in: Disable -march=pentiumpro due to apparent compiler
+	problems.
+
+	* mpz/powm.c: Replace with new code from Paul Zimmermann.
+
+	* mpz/tdiv_q.c: Remove debug code.
+
+	* mpn/generic/divrem.c: Remove C++ style `//' commented-out code.
+	* mpn/generic/sb_divrem_mn.c: Likewise.
+
+2000-04-14  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/cdiv_q.c: Change temp allocation for new requirements of
+	mpz_tdiv_qr.
+	* mpz/fdiv_q.c: Likewise.
+
+	* mpn/sparc64/gmp-mparam.h: Set up parameters for TOOM3.
+
+	* mpz/dmincl.c: Delete file.
+	* mpz/tdiv_qr.c: Rewrite using mpn_tdiv_qr.
+	* mpz/tdiv_r.c: Likewise.
+	* mpz/tdiv_q.c: Likewise.
+
+	* mpn/generic/tdiv_qr.c: New file.
+	* mpn/generic/bz_divrem_n.c: New file.
+	* mpn/generic/sb_divrem_mn.c: New file.
+
+	* gmp-impl.h (MPZ_REALLOC): New macro.
+	(mpn_sb_divrem_mn): Declare.
+	(mpn_bz_divrem_n): Declare.
+	(mpn_tdiv_qr): Declare.
+
+	* configure.in (gmp_mpn_functions): Delete divrem_newt and divrem_1n;
+	add tdiv_qr, bz_divrem_n, and sb_divrem_mn.
+	* mpn/generic/divrem_newt.c: Delete file.
+	* mpn/generic/divrem_1n.c: Delete file.
+
+	* gmp.h (mpn_divrem_newton): Remove declaration.
+	(mpn_divrem_classic): Remove declaration.
+
+	* gmp.h (mpn_divrem): Remove function definition.
+	* mpn/generic/divrem.c: Replace mpn_divrem_classic with a
+	mpn_divrem wrapper.
+
+2000-04-14  Kevin Ryde  <kevin@swox.se>
+
+	* mpf/dump.c, mpz/dump.c, mpn/generic/dump.c,
+	mpn/generic/divrem.c, mpn/generic/divrem_1n.c,
+	mpn/generic/divrem_2.c, mpn/generic/divrem_newt.c,
+	mpn/generic/mul.c, mpn/generic/mul_basecase.c,
+	mpn/generic/mul_n.c, mpn/generic/sqr_basecase.c,
+	mpn/generic/udiv_w_sdiv.c: Add comment that internal functions are
+	changeable and shouldn't be used directly.
+
+	* mpq/div.c: Use DIVIDE_BY_ZERO (previously didn't get an
+	exception on zero divisor).
+
+	* mpf/tests/t-get_d.c, mpz/tests/reuse.c: Add K&R function
+	definitions.
+	* mpz/tests/t-2exp.c: Don't use ANSI-ism 2ul.
+
+	* gmp.texi (Installing MP): Build problem notes for GSYM_PREFIX
+	and ranlib on native SunOS.
+	Particular systems notes about AIX and HPPA shared libraries
+	disabled.
+	(MP Basics): Add that undocumented things shouldn't be used.
+	(Introduction to MP): Add to CPUs listed.
+
+	* acinclude.m4 (GMP_CHECK_ASM_UNDERSCORE): Don't depend on C
+	having "void".
+
+2000-04-13  Linus Nordberg  <linus@swox.se>
+
+	* mpn/pa64/udiv_qrnnd.c (__udiv_qrnnd64): Add K&R function
+	definition.
+
+	* configure.in: Disable shared libraries for hppa*.
+	(mips-sgi-irix6.*): Fix flags for 64-bit gcc.
+	(hppa2.0*-*-*): Prefer c89 to cc.
+	* configure: Regenerate.
+
+	* gmp.h (gmp_randalg_t): Remove comma after last element.
+
+2000-04-13  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/generic/mul_n.c, mpn/generic/gcdext.c, mpz/nextprime.c,
+	mpz/remove.c, mpz/root.c: Add K&R function definitions.
+	* mpz/rrandomb.c: Fix typo in K&R part.
+	* stack-alloc.c: Add K&R style function pointer declarations.
+
+	* mpz/root.c: Use SQRT_OF_NEGATIVE on even roots of negatives.
+	Use DIVIDE_BY_ZERO on a "zero'th" root.
+
+	* configure: Regenerate with autoconf backpatched to fix --srcdir
+	absolute path wildcards that bash doesn't like, change by Linus.
+
+	* gmp.texi (Integer Arithmetic): Document mpz_nextprime.
+	(Miscellaneous Integer Functions): Fix mpz_fits_* formatting.
+	(Installing MP): Comment-out CC and CFLAGS description.
+
+2000-04-13  Linus Nordberg  <linus@swox.se>
+
+	* rand.c (gmp_randinit): Don't combine va_alist with ordinary
+	arguments for non STDC.
+
+2000-04-13  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/nextprime.c: Use proper names of new random types and functions.
+
+	* mpz/rrandomb.c: New file.
+	* mpz/Makefile.am: List it.
+	* mpz/Makefile.in: Regenerate.
+	* Makefile.am: Here too.
+	* Makefile.in: Regenerate.
+	* gmp.h: Declare mpz_rrandomb.
+
+2000-04-12  Linus Nordberg  <linus@swox.se>
+
+	* Makefile.am, demos/Makefile.am, mpbsd/Makefile.am,
+	mpbsd/tests/Makefile.am, mpf/Makefile.am, mpf/tests/Makefile.am,
+	mpn/Makefile.am, mpq/Makefile.am, mpq/tests/Makefile.am,
+	mpz/Makefile.am, mpz/tests/Makefile.am, tests/Makefile.am,
+	tests/rand/Makefile.am (AUTOMAKE_OPTIONS): Add 'no-dependencies'.
+
+	* Makefile.in, demos/Makefile.in, mpbsd/Makefile.in,
+	mpbsd/tests/Makefile.in, mpf/Makefile.in, mpf/tests/Makefile.in,
+	mpn/Makefile.in, mpq/Makefile.in, mpq/tests/Makefile.in,
+	mpz/Makefile.in, mpz/tests/Makefile.in, tests/Makefile.in,
+	tests/rand/Makefile.in: Regenerate.
+
+2000-04-12  Linus Nordberg  <linus@swox.se>
+
+	* randlc.c (gmp_randinit_lc): Disable function.
+	* gmp.texi (Random State Initialization): Remove gmp_randinit_lc.
+
+	* acinclude.m4 (GMP_CHECK_CC_64BIT): Compiling an empty main
+	successfully with `-n32' will have to suffice on irix6.
+	* aclocal.m4: Regenerate.
+
+	* configure.in (sparc): Don't pass -D_LONG_LONG_LIMB to compiler.
+	(mips-sgi-irix6.*): Use compiler option `-n32' rather than `-64'
+	for 64-bit `cc'.  Add options for gcc.
+	* configure: Regenerate.
+
+	* mpf/urandomb.c (mpf_urandomb): Add third parameter 'nbits'.  If
+	'nbits' doesn't make even limbs, shift up result before
+	normalizing.
+
+	* gmp.h (mpf_urandomb): Add parameter to prototype.
+
+	* mpf/urandom.c: Rename file to ...
+	* mpf/urandomb.c: ... this.
+	* Makefile.am (MPF_OBJECTS): Change urandom.lo --> urandomb.lo.
+	* Makefile.in: Regenerate.
+	* mpf/Makefile.am (libmpf_la_SOURCES): Change urandom.c --> urandomb.c.
+	* mpf/Makefile.in: Regenerate.
+
+	* config.in: Regenerate for HAVE_DECL_OPTARG.
+
+	* randraw.c (_gmp_rand): Fix bug with _LONG_LONG_LIMB.
+	(lc): Change return type.
+	Use one temporary storage instead of two.
+	Handle seed of size 0.
+	Avoid modulus operation in some cases.
+	Abort if M is not a power of 2.
+	Fix bug with 64-bit limbs.
+	Fix bug with small seed, small A and large M.
+
+2000-04-12  Kevin Ryde  <kevin@swox.se>
+
+	* gmp-impl.h: Include config.h before TMP_ALLOC, so
+	--disable-alloca works.
+
+	* mpbsd/Makefile.am: Don't recompile top-level sources here.
+	* Makefile.am (libmp_la_DEPENDENCIES): Put objects here instead,
+	add errno.lo and stack-alloc.lo.
+
+	* mpn/asm-defs.m4: Add a test and message for the unsuitable SunOS m4.
+	* gmp.texi (Installing MP): Update note on SunOS m4 failure.
+
+	* acconfig.h: Add copyright notice using @TOP@.
+
+	* stack-alloc.c: Use _mp_allocate_func, not malloc.
+	* gmp.texi (Installing MP): Note this under --disable-alloca.
+
+	* gmp.texi (Comparison Functions): mpz_cmp_abs => mpz_cmpabs.
+	(Integer Arithmetic): mpz_prime_p not yet implemented, comment out.
+	(Float Arithmetic): mpf_pow_ui now implemented, uncomment-out.
+	(Miscellaneous Float Functions): Add mpf_ceil, mpf_floor, mpf_trunc.
+	(Low-level Functions): Add mpn_random2, with mpn_random.
+
+	* mpn/m68k/mc68020/udiv.S: Rename from udiv.s.
+	* mpn/m68k/mc68020/umul.S: Ditto.
+
+	* mpn/alpha/umul.asm: Rename from umul.s, remove .file and
+	compiler identifiers.
+
+	* mpn/powerpc32/syntax.h: Removed, no longer used.
+
+	* mpn/a29k/udiv.s: Remove .file and compiler identifiers.
+	* mpn/a29k/umul.s: Ditto.
+
+	* mpn/tests/ref.c: Use WANT_ASSERT.
+	* mpn/tests/ref.h: Use _PROTO.
+
+	* mpbsd/configure.in: Removed, no longer required.
+
+	* mpf/div.c: Use DIVIDE_BY_ZERO.
+	* mpf/div_ui.c: Ditto.
+	* mpf/ui_div.c: Ditto.
+	* mpq/inv.c: Ditto.
+	* mpf/sqrt.c: Use SQRT_OF_NEGATIVE.
+	* mpz/sqrt.c: Ditto.
+	* mpz/sqrtrem.c: Ditto.
+
+	* gmp-impl.h (GMP_ERROR,SQRT_OF_NEGATIVE): New macros.
+	(DIVIDE_BY_ZERO): Use GMP_ERROR.
+	(__mp_bases): #define to __MPN(mp_bases).
+
+2000-04-11  Kevin Ryde  <kevin@swox.se>
+
+	* mpz/fib_ui.c: Add K&R function definitions.
+
+	* mpbsd/tests/Makefile.am (TESTS): Add a dummy test to avoid a
+	shell problem with an empty "for tst in $(TESTS) ; ...".
+	* mpbsd/tests/dummy.c: New file.
+
+2000-04-10  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/bin_uiui.c: Delete several unused variables.
+	Add copyright notice.
+	* mpz/bin_ui.c: Add copyright notice.
+
+	* longlong.h: Declare __count_leading_zeros for alpha.
+
+2000-04-10  Linus Nordberg  <linus@swox.se>
+
+	* rand.c (gmp_randinit): Change parameter list to (rstate, alg, ...).
+	* gmp.h: Change prototype accordingly.
+	* mpz/pprime_p.c (millerrabin): Change call accordingly.
+
+	* configure.in: Check for `optarg'.
+	* configure: Regenerate.
+
+	* mpn/Makefile.am: Remove incorrect comment.
+	* mpn/Makefile.in: Regenerate.
+
+	* gmp.h: Rename most of the random number functions, structs and
+	  some of the struct members.
+	* rand.c (gmp_randinit): Likewise.
+	* randclr.c (gmp_randclear): Likewise.
+	* randlc.c (gmp_randinit_lc): Likewise.
+	* randlc2x.c (gmp_randinit_lc_2exp): Likewise.
+	* randraw.c (lc): Likewise.
+	(_gmp_rand_getraw): Likewise.
+	* randsd.c (gmp_randseed): Likewise.
+	* randsdui.c (gmp_randseed_ui): Likewise.
+	* gmp.texi: Likewise.
+
+	* gmp.texi: Use three hyphens for a dash.
+	(Low-level Functions): Remove documentation for gmp_rand_getraw.
+	(Random Number Functions): Add info on where to find documentation
+	on the random number functions.
+
+2000-04-10  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/pprime_p.c: Pass 0L for mpz_scan1.  mpz_mmod => mpz_mod.
+	(millerrabin): Use new random interface.
+	(millerrabin): ... and don't forget to call gmp_randclear.
+
+	* mpz/nextprime.c: New file.
+	* gmp.h: Declare mpz_nextprime.
+	* mpz/Makefile.am: List nextprime.c.
+	* mpz/Makefile.in: Regenerate.
+	* Makefile.am: List mpz/nextprime.lo.
+	* Makefile.in: Regenerate.
+
+2000-04-10  Kevin Ryde  <kevin@swox.se>
+
+	* move-if-change: Removed, no longer used.
+	* mp{z,q,f}/tests/move-if-change: Ditto.
+
+	* Makefile.am (SUBDIRS): Add tests, demos, mpbsd.
+	(libmp.la): New target, conditional on WANT_MPBSD.
+	(libgmp_la_LIBADD): Add -lm.
+	(AUTOMAKE_OPTIONS): Add check-news.
+	(include_HEADERS): Setup to install gmp.h and possibly mp.h.
+	(DISTCLEANFILES): Add generated files.
+	(check): Remove explicit target (now uses check-recursive).
+
+	* configure.in: Use AM_CONFIG_HEADER.
+	Add --enable-mpbsd setting automake conditional WANT_MPBSD.
+	Output demos/Makefile, mpbsd/Makefile and mpbsd/tests/Makefile.
+
+	* mpz/Makefile.am: Add SUBDIRS=tests, shorten INCLUDES since now
+	using AM_CONFIG_HEADER.
+	* mpq/Makefile.am: Ditto.
+	* mpf/Makefile.am: Ditto, and add DISTCLEANFILES.
+	* mpn/Makefile.am: Shorten INCLUDES, amend some comments.
+	* mpz/tests/Makefile.am: Use TESTS and $(top_builddir).
+	* mpf/tests/Makefile.am: Ditto.
+	* mpq/tests/Makefile.am: Ditto.
+	* demos/Makefile.am: New file.
+
+	* mpbsd/Makefile.am: New file, derived from old mpbsd/Makefile.in.
+	* mpbsd/Makefile.in: Now generated from Makefile.am.
+	* mpbsd/realloc.c: Removed, use mpz/realloc.c instead.
+	* mpbsd/tests/Makefile.am: New file.
+	* mpbsd/tests/Makefile.in: New file, generated from Makefile.am.
+	* mpbsd/tests/allfuns.c: New file.
+
+	* gmp.texi (Top): Use @ifnottex, to help makeinfo --html.
+	(Installing MP): Describe --enable-mpbsd and demo programs.
+
+2000-04-09  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/urandomm.c: Get type of count right.
+	Simplify computation of nbits.
+
+2000-04-08  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/urandomb.c: Fix reallocation condition.
+	Simplify size computation.
+
+2000-04-08  Linus Nordberg  <linus@swox.se>
+
+	* acinclude.m4 (GMP_CHECK_CC_64BIT): Add special handling for
+	HPUX.
+	(GMP_CHECK_ASM_W32): Ditto.
+	* aclocal.m4: Regenerate.
+
+	* mpn/Makefile.am: Use $(CCAS) for assembling.
+	(.asm.obj): Add rule.
+	* mpn/Makefile.in: Regenerate.
+
+	* gmp.texi (Miscellaneous Integer Functions): Fix typos.
+
+	* configure.in: Never pass `-h' to grep.
+	(mips-sgi-irix6.[2-9]*): Try to find 64-bit compiler.
+	(hppa1.0*-*-*): New flag for cc.
+	(hppa2.0*-*-*): Try to find 64-bit compiler.  Chose path, set
+	CCAS.
+	* configure: Regenerate.
+
+2000-04-08  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/bin_ui.c: Don't depend on ANSI C features.
+	* mpz/bin_uiui.c: Likewise.
+
+	* Makefile.am (MPZ_OBJECTS): mpz/cmp_abs* => mpz/cmpabs*.
+	(MPQ_OBJECTS): Add mpq/set_d.lo.
+	(MPZ_OBJECTS): Add mpz/fits*.lo.
+	* Makefile.in: Regenerate.
+
+	* mpz/cmpabs.c: New name for mpz/cmp_abs.c.
+	* mpz/cmpabs_ui.c: New name for mpz/cmp_abs_ui.c.
+	* mpz/Makefile.am: Corresponding changes.
+	* mpz/Makefile.in: Regenerate.
+	* gmp.h: mpz_cmp_abs* => mpz_cmpabs*.
+
+	* mpz/addmul_ui.c (mpn_neg1): Don't depend on ANSI C features.
+
+	* mpz/invert.c: Use TMP_MARK since we invoke MPZ_TMP_INIT.
+
+	* gmp.h (mpq_set_d): Declare correctly.
+	(mpz_root): Use _PROTO.
+	(mpz_remove): Use _PROTO.
+	(mpf_pow_iu): Use _PROTO.
+
+	* mpn/asm-defs.m4 (MPN_PREFIX): Revert previous change.
+	* gmp.h (__MPN): Revert previous change.
+
+	* mpz/perfpow.c: De-ANSI-fy.  Add copyright notice.
+
+	* mpz/set_d.c: Misc cleanups.
+
+	* mpq/set_d: New file.
+	* gmp.h: Declare mpq_set_d.
+	* mpq/Makefile.am: List set_d.c.
+	* mpq/Makefile.in: Regenerate.
+
+2000-04-07  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/fits_sint_p.c: New file.
+	* mpz/fits_slong_p.c: New file.
+	* mpz/fits_sshort_p.c: New file.
+	* mpz/fits_uint_p.c: New file.
+	* mpz/fits_ulong_p.c: New file.
+	* mpz/fits_ushort_p.c: New file.
+	* gmp.h: Declare mpz_fits_*.
+	* mpz/Makefile.am: List fits_* files.
+	* mpz/Makefile.in: Regenerate.
+
+2000-04-06  Kevin Ryde  <kevin@swox.se>
+
+	* gmp.texi (Installing MP): Add known build problem SunOS 4.1.4 m4
+	failure.
+
+	* mpn/x86/pentium/gmp-mparam.h: Tune thresholds.
+	* mpn/x86/p6/gmp-mparam.h: Ditto.
+	* mpn/x86/k6/gmp-mparam.h: Tune thresholds, add UMUL_TIME, UDIV_TIME.
+	* mpn/x86/k7/gmp-mparam.h: Tune thresholds, amend UMUL_TIME.
+
+	* mpn/generic/mul_n.c (mpn_kara_mul_n): Add an ASSERT.
+	(mpn_kara_sqr_n): Add an ASSERT, use KARATSUBA_SQR_THRESHOLD.
+	(mpn_toom3_sqr_n): Eliminate second evaluate3.
+
+	* gmp-impl.h (mpn_com_n,MPN_LOGOPS_N_INLINE): Don't allow size==0.
+	(tune_mul_threshold,tune_sqr_threshold): Conditionalize
+	declarations on TUNE_PROGRAM_BUILD.
+
+	* mpn/generic/sqr_basecase.c: Add an assert.
+
+2000-04-05  Torbjorn Granlund  <tege@swox.com>
+
+	* gmp.h, mpn/asm-defs.m4: List the same functions for __MPN, but
+	leave some commented out.
+
+	* gmp-impl.h (MPN_LOGOPS_N_INLINE): Optimize.
+	(mpn_com_n): Optimize.
+
+	* gmp.h (__MPN): Make it use __gmpn instead of __mpn for consistency.
+	* mpn/asm-defs.m4 (MPN_PREFIX): Likewise.
+
+	* gmp.h (GMP_ERROR_ALLOCATE): New errcode.
+
+	* gmp-impl.h (MPN_MUL_N_RECURSE): Delete.
+	(MPN_SQR_RECURSE): Delete.
+
+	* gmp-impl.h (TARGET_REGISTER_STARVED): New define.
+
+	* gmp-impl.h (mpn_kara_sqr_n): Remap with __MPN.
+	(mpn_toom3_sqr_n): Likewise.
+	(mpn_kara_mul_n): Likewise.
+	(mpn_toom3_mul_n): Likewise.
+	(mpn_reciprocal): Likewise.
+
+	* gmp-impl.h (__gmpn_mul_n): Remove declaration.
+	(__gmpn_sqr): Likewise.
+	* gmp.h (mpn_sqr_n): Declare/remap.
+	* mpn/generic/mul.c (mpn_sqr_n): New name for mpn_sqr.
+
+	* gmp.h (mpn_udiv_w_sdiv): Move __MPN remap from here...
+	* gmp-impl.h: ...to here.
+
+2000-04-05  Linus Nordberg  <linus@swox.se>
+
+	* gmp.texi (Top): Add `Random Number Functions' to menu.
+	(Introduction to MP): Fix typo.
+	(MP Basics): Create menu for all sections.  Move `Random Number
+	Functions' to its own chapter.  Add nodes for all sections.
+	(Function Classes): Mention random generation functions under
+	miscellaneous.
+	(Miscellaneous Integer Functions): Update mpz_urandomb,
+	mpz_urandomm.
+	(Low-level Functions): Remove mpn_rawrandom.
+	(Random State Initialization): Update.
+
+	* mpf/urandom.c (mpf_urandomb): Remove SIZE parameter.  Normalize
+	result correctly.
+
+	* gmp.h (mpf_urandomb): Remove SIZE parameter.
+
+	* randraw.c (gmp_rand_getraw): Handle the case where (1) the LC
+	scheme doesn't generate even limbs and (2) more than one LC
+	invokation is necessary to produce the requested number of bits.
+
+2000-04-05  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/mul_n.c (INVERSE_3): New name for THIRD, define for
+	any BITS_PER_MP_LIMB.
+	(MP_LIMB_T_MAX): New.
+	(mpn_divexact3_n): Remove.
+	(interpolate3): Use mpn_divexact_by3 instead of mpn_divexact3_n.
+
+2000-04-05  Kevin Ryde  <kevin@swox.se>
+
+	* gmp-impl.h (KARATSUBA_MUL_THRESHOLD<2): Remove cpp test.
+	(tune_mul_threshold,tune_sqr_threshold): Add declarations, used in
+	development only.
+
+	* mpn/x86/k7/sqr_basecase.asm: New file, only a copy of k6 for now.
+
+2000-04-04  Torbjorn Granlund  <tege@swox.com>
+
+	* gmp-impl.h (TOOM3_MUL_THRESHOLD): Provide default.
+	(TOOM3_SQR_THRESHOLD): Provide default.
+
+	* mpn/generic/mul_n.c: Rewrite (mostly by Robert Harley).
+	* mpn/generic/mul.c: Rewrite (mostly by Robert Harley).
+
+	* configure.in (sparcv9 64-bit OS): Set extra_functions.
+
+2000-04-04  Linus Nordberg  <linus@swox.se>
+
+	* mpn/generic/rawrandom.c: Remove file and replace with randraw.c
+	on top level.
+	(mpn_rawrandom): Rename to gmp_rand_getraw.
+
+	* randraw.c: New file; essentially a copy of
+	mpn/generic/rawrandom.c.
+	(gmp_rand_getraw): New function (formerly known as mpn_rawrandom).
+
+	* mpz/urandomb.c (mpz_urandomb): Change mpn_rawrandom -->
+	gmp_rand_getraw.
+	* mpz/urandomm.c (mpz_urandomb): Ditto.
+	* mpf/urandom.c (mpf_urandomb): Ditto.
+
+	* gmp.h (gmp_rand_getraw): Add function prototype.
+	(mpn_rawrandom): Remove function prototype.
+
+	* Makefile.am (libgmp_la_SOURCES): Add randraw.c.
+	* Makefile.in: Regenerate.
+
+	* configure.in (gmp_mpn_functions): Remove rawrandom.
+	* configure: Regenerate.
+
+2000-04-04  Linus Nordberg  <linus@swox.se>
+
+	* gmp.h (GMP_ERROR enum): Remove comma after last enumeration
+	since the AIX compiler (xlc) doesn't like that.
+
+	* randlc.c (gmp_rand_init_lc): Allocate enough space for seed to
+	hold any upcoming seed.
+	* randlc2x.c (gmp_rand_init_lc_2exp): Likewise.
+
+	* mpn/generic/rawrandom.c: Remove debugging code.
+	(mpn_lc): Don't reallocate seed.
+
+	* mpz/urandomm.c (mpz_urandomm): Implement function.
+
+	* mpz/urandomb.c (mpz_urandomb): Fix typo in function definition.
+
+2000-04-04  Kevin Ryde  <kevin@swox.se>
+
+	* make.bat: Removed (no longer works, no longer supported).
+	* mpn/msdos/asm-syntax.h: Removed (was used only by make.bat).
+
+2000-04-03  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/brandom.c: New file, replacing random2.
+
+2000-04-02  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc32/v9/submul_1.asm: Change some carry-form instructions
+	into their plain counterparts.
+
+	* mpn/sparc64/copyi.asm: Avoid executing ALIGN.
+
+	* mpn/sparc64/mul_1.asm: Handle overlap of rp/sp.
+	* mpn/sparc64/addmul_1.asm: Likewise.
+	* mpn/sparc64/submul_1.asm: Likewise.
+
+2000-04-01  Linus Nordberg  <linus@swox.se>
+
+	* gmp.h: Fix function prototypes for randomization functions.
+	(__gmp_rand_lc_scheme_struct): Replace `m' with `m2exp'. Remove
+	unused `bits'.
+	(__gmp_rand_data_lc): Add `m2exp' as another way of representing
+	the modulus.
+	(__gmp_rand_state_struct): Remove unused `size'.
+
+	* rand.c (__gmp_rand_scheme): Use better multipliers.  Remove test
+	schemes.  Replace `m' with `m2exp'.
+	(gmp_rand_init): Change parameters and return type.  Use `m2exp'
+	instead of `m'.  Set `gmp_errno' on error.  Disable BBS algorithm.
+
+	* randlc.c (gmp_rand_init_lc): Don't use malloc().  Change
+	parameters.
+
+	* randclr.c (gmp_rand_clear): Don't use free().  Disable BBS
+	algorithm.  Set `gmp_errno' on error.
+
+	* randlc2x.c (gmp_rand_init_lc_2exp): New function.
+	* randsd.c (gmp_rand_seed): New function.
+	* randsdui.c (gmp_rand_seed_ui): New function.
+	* randlcui.c: Remove unused file.
+
+	* mpn/generic/rawrandom.c (mpn_rawrandom): Rewrite.
+	(mpn_lc): New static function.
+
+	* mpz/urandomb.c (mpz_urandomb): Use ABSIZ() instead of SIZ() for
+	determining size of ROP.
+
+	* mpf/urandom.c (mpf_urandomb): Add third parameter, nbits.  (Not
+	used yet!)
+	Change parameter order to mpn_rawrandom().
+
+	* Makefile.am (libgmp_la_SOURCES): Add errno.c, randlc2x.c,
+	randsd.c, randsdui.c.  Remove randui.c.
+	(MPZ_OBJECTS): Rename urandom.lo --> urandomb.lo.  Add urandomm.lo.
+	* Makefile.in: Regenerate.
+
+	* mpz/Makefile.am (libmpz_la_SOURCES): Change urandom.c -->
+	urandomb.c.  Add urandomm.c.
+	* mpz/Makefile.in: Regenerate.
+
+2000-04-01  Kevin Ryde  <kevin@swox.se>
+
+	* acinclude.m4 (GMP_CHECK_ASM_DATA): Plain .data for hpux.
+	* configure.in (CCAS): No CFLAGS, they're added when it's used.
+	(CONFIG_SRCDIR): New define for config.m4.
+	* mpn/sparc64/addmul_1.asm: Use it for an include().
+	* mpn/sparc64/submul_1.asm: Ditto.
+	* mpn/sparc64/mul_1.asm: Ditto.
+
+2000-03-31  Linus Nordberg  <linus@swox.se>
+
+	* mpz/urandom.c: Rename to...
+	* mpz/urandomb.c: ...this.
+
+	* mpz/urandomb.c (mpz_urandomb): Change operand order in call to
+	mpn_rawrandom().  Use ABSIZ() instead of SIZ() when checking size
+	of ROP.
+
+	* mpz/urandomm.c: New file.
+
+2000-03-31  Kevin Ryde  <kevin@swox.se>
+
+	* acinclude.m4 (GMP_CHECK_ASM_MMX): Give a warning when mmx code
+	will be omitted.
+
+2000-03-30  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc64/mul_1h.asm: New file.
+	* mpn/sparc64/addmul_1h.asm: New file.
+	* mpn/sparc64/submul_1h.asm: New file.
+	* mpn/sparc64/mul_1.asm: Rewrite.
+	* mpn/sparc64/addmul_1.asm: Rewrite.
+	* mpn/sparc64/submul_1.asm: Rewrite.
+
+2000-03-28  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc32/v9/mul_1.asm: Fix typo in branch prediction.
+	* mpn/sparc32/v9/addmul_1.asm: Likewise.
+	* mpn/sparc32/v9/submul_1.asm: Likewise.
+
+2000-03-25  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/lisp/gmpasm-mode.el: Fix some comment detection, use custom,
+	fontify more keywords, turn into a standalone mode.
+
+	* stamp-vti: New file, generated together with version.texi.
+
+	* acinclude.m4 (GMP_VERSION,GMP_HEADER_GETVAL): New macros.
+	* configure.in (AM_INIT_AUTOMAKE): Use GMP_VERSION.
+
+2000-03-24  Kevin Ryde  <kevin@swox.se>
+
+	* INSTALL: Updates for new configure system.
+
+	* configure.in: Add gmp_optcflags_gcc for the x86s, setting -mcpu
+	and -march.
+
+2000-03-23  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/pexpr.c (mpz_eval_expr): Properly initialize rhs/lhs
+	for ROOT.
+
+2000-03-23  Kevin Ryde  <kevin@swox.se>
+
+	* config.guess (i?86:*:*:*): Use uname -m if detection program fails.
+
+	* mpn/x86/README: Remove remarks on the now implemented MMX shifts.
+	* mpn/x86/k6/README: Add speed of mpn_divexact_by3, update mpn_mul_1.
+
+	* gmp.texi (Installing MP): Corrections to target CPUs.
+
+	* version.c: Use VERSION from config.h, add copyright comment,
+	restore "const" somehow lost.
+
+	* configure.in (a29k*-*-*): Fix directory name.
+
+2000-03-22  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/pexpr.c (op_t): Add ROOT.
+	(fns): Add ROOT.
+	(mpz_eval_expr): Add ROOT.
+
+	* mpz/root.c: Handle roots of negative numbers.
+	Fix other border cases.
+	Fix rare memory leakage.
+
+	* errno.c: New file.
+
+2000-03-21  Torbjorn Granlund  <tege@swox.com>
+
+	* gmp.h (error number enum): New anonymous enum.
+	(gmp_errno): New.
+
+	* gmp.h (__GNU_MP_VERSION, __GNU_MP_VERSION_MINOR): Bump for GMP 3.0.
+
+2000-03-20  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/alpha/unicos.m4 (FLOAT64): New define.
+	* mpn/alpha/default.m4 (FLOAT64): New define.
+	* mpn/alpha/invert_limb.asm (C36): Use FLOAT64.
+
+2000-03-21  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/k6/diveby3.asm: Tiny speedup.
+
+	* acinclude.m4 (GMP_CHECK_ASM_SHLDL_CL): New macro.
+	* configure.in: Use it, set WANT_SHLDL_CL in config.m4.
+	* mpn/x86/x86-defs.m4 (shldl,shrdl,shldw,shrdw): New macros, using
+	WANT_SHLDL_CL.
+	* mpn/x86/k6/mmx/lshift.asm: Use shldl macro.
+	* mpn/x86/k7/mmx/lshift.asm: Ditto.
+	* mpn/x86/pentium/mmx/lshift.asm: Ditto.
+	* mpn/x86/k6/mmx/rshift.asm: Use shrdl macro.
+	* mpn/x86/k7/mmx/rshift.asm: Ditto.
+	* mpn/x86/pentium/mmx/rshift.asm: Ditto.
+	* mpn/x86/README.family: Add a note about this.
+
+2000-03-20  Linus Nordberg  <linus@swox.se>
+
+	* mpn/generic/rawrandom.c (mpn_rawrandom): Handle seed value of 0
+	correctly.
+
+	* configure.in: Fix detection of alpha flavour.
+	Set compiler options for `sparcv8'.
+	* configure: Regenerate.
+
+	* rand.c (__gmp_rand_scheme): Clean up some.  Use slightly better
+	multipliers.
+
+	* configure.in (AC_OUTPUT): Add tests/Makefile and
+	tests/rand/Makefile.
+
+	* acinclude.m4 (AC_CANONICAL_BUILD): Define to
+	`_AC_CANONICAL_BUILD' to deal with incompabilities between
+	Autoconf and Libtool.
+	(AC_CHECK_TOOL_PREFIX): Likewise.
+
+	* Makefile.am (EXTRA_DIST): Add directory `tests'.
+
+	* mkinstalldirs: Update (Automake 2000-03-17).
+	* ltconfig: Update (Libtool 2000-03-17).
+	* ltmain.sh: Ditto.
+
+	* configure: Regenerate with new autoconf/-make/libtool suite.
+	* aclocal.m4: Ditto.
+	* config.in: Ditto.
+	* all Makefile.in's: Ditto.
+
+2000-03-20  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/pexpr.c (main): Don't allow `-N' for base, require `-bN'.
+
+	* mpn/alpha/unicos.m4 (cvttqc): New define.
+	* mpn/alpha/invert_limb.asm: Use new define for cvttqc.
+
+2000-03-19  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/k6/sqr_basecase.asm: Tiny amendments for 3x3 case.
+
+	* gmp.texi: Use @include version.texi.
+	Use @email and @uref.
+	(Installing MP): Rewrite for new configure.
+	(Low-level Functions): Add mpn_divexact_by3.
+
+	* configure.in (--enable-alloca): New option.
+	* acconfig.h (USE_STACK_ALLOC): For --disable-alloca.
+
+2000-03-18  Kent Boortz  <kent@swox.com>
+
+	* macos: New directory with macos port files.
+
+2000-03-17  Torbjorn Granlund  <tege@swox.com>
+
+	* gmp-impl.h (union ieee_double_extract): Check _CRAYMPP.
+
+	* mpn/asm-defs.m4 (invert_normalized_limb): Define.
+
+	* mpn/alpha: Translate `.s' files to `.asm'.
+
+	* configure: Regenerate.
+
+	* mpn/alpha/invert_limb.asm: Replace dash in file name with underscore.
+	* configure.in: Corresponding change.
+
+	* configure.in: Assign special "path" for alphaev6.
+
+	* mpn/alpha/unicos.m4: New file.
+	* configure.in (alpha*-cray-unicos*): [This part of the change
+	commited 2000-03-13 by linus]
+	* mpn/alpha/default.m4: New file.
+	* configure.in (alpha*-*-*): Use it.
+
+2000-03-17  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/pentium/rshift.S: Use plain rcrl (not rcrl $1) for
+	shift-by-1 case, significant speedup.
+	* mpn/x86/pentium/README: Add shift-by-1 speed.
+
+2000-03-16  Torbjorn Granlund  <tege@swox.com>
+
+	* config.guess: Handle Cray T3D/E.
+
+2000-03-15  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/generic/diveby3.c: New file.
+	* mpn/x86/diveby3.asm: New file.
+	* mpn/x86/k6/diveby3.asm: New file.
+	* gmp.h (mpn_divexact_by3): Prototype and define.
+	* mpn/asm-defs.m4: define_mpn(divexact_by3).
+	* configure.in (gmp_mpn_functions): Add diveby3.
+
+	* mpn/x86/pentium/sqr_basecase.asm: A few better addressing modes.
+
+	* configure.in: Add AC_C_STRINGIZE and AC_CHECK_TYPES((void)).
+	* gmp-impl.h (ASSERT): Use them.
+
+	* mpn/x86/k7/mmx/lshift.asm: New file.
+	* mpn/x86/k7/mmx/rshift.asm: Rewrite simple loop and return value
+	handling, add some pictures.
+
+2000-03-14  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc32/v8/mul_1.asm: Make PIC actually work.
+	* mpn/sparc32/v8/addmul_1.asm: Likewise.
+
+	* mpn/sparc32/v8/mul_1.asm: Use m4 ifdef, not cpp #if.
+	* mpn/sparc32/v8/addmul_1.asm: Likewise.
+
+	* mpn/asm-defs.m4 (C): New define for comments.
+	* mpn/sparc32: Start comments with `C'.
+
+	* config.guess: Remove `SunOS 6' handling.
+	Recognize sun4m and sun4d architectures under old SunOS.
+
+2000-03-14  Linus Nordberg  <linus@swox.se>
+
+	* configure.in (gmp_srclinks): Set to list of links created by
+	configure.
+	* configure: Regenerate.
+
+	* Makefile.am (libgmp_la_LDFLAGS): Set version info.
+	(DISTCLEANFILES): Include @gmp_srclinks@.
+	* Makefile.in: Regenerate.
+
+2000-03-13  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Remove some changequote's by quoting the strings
+	containing `[]'.
+	Add support for `alpha*-cray-unicos*'.
+	AC_DEFINE `_LONG_LONG_LIMB' instead of passing it in CFLAGS.
+	Conditionalize the assembler syntax checks.
+	* configure: Regenerate.
+	* config.in: Regenerate.
+
+	* acinclude.m4 (GMP_PROG_CCAS): Remove macro.
+	* aclocal.m4: Regenerate.
+
+2000-03-13  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/p6/README: New file.
+
+	* mpn/x86/k6/mul_1.asm: Rewrite, smaller and slightly faster.
+
+	* mpn/lisp/gmpasm-mode.el: Rewrite assembler comment detection and
+	handling.
+
+	* configure.in: Separate mmx directories for each x86 flavour.
+	* configure: Regenerate.
+
+2000-03-12  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/x86-defs.m4 (ALIGN): Supplement definition from
+	config.m4 so as to pad with nops not zeros on old gas.
+
+	* mpn/x86/k7/mmx/copyd.asm: Use plain emms (femms is just an alias
+	for emms now).
+	* mpn/x86/k7/mmx/copyi.asm: Ditto.
+	* mpn/x86/k7/mmx/rshift.asm: Ditto.
+	* mpn/x86/x86-defs.m4: Amend comments.
+
+	* mpn/x86/mod_1.asm: Add comments on speeds.
+
+	* mpn/x86/pentium/mmx/lshift.asm: New file.
+	* mpn/x86/pentium/mmx/rshift.asm: New file.
+	* mpn/x86/pentium/README: Add speeds of various routines.
+
+2000-03-10  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Reorganize.
+	Use AC_CHECK_TOOL to find `ar'.
+	Add post-includes `regmap.m4' and `aix.m4' for AIX targets.
+	asm-syntax.h is not needed for PPC or sparc anymore.
+	(powerpc64-*-aix*): Compiler is always 64-bit. Use `-q64
+	-qtune=pwr3' to xlc and `-maix64 -mpowerpc64' to gcc.  Pass `-X
+	64' to `ar' and `nm'.
+	(pentiummmx): Use GMP_CHECK_ASM_MMX and avoid MMX assembly path if
+	assembler is not MMX capable.
+	(pentium[23]): Likewise.
+	(athlon): Likewise.
+	(k6*): Likewise.
+	* configure: Regenerate.
+
+	* acinclude.m4 (GMP_PROG_CC_WORKS): New macro.
+	(GMP_PROG_CC_FIND): Use GMP_PROG_CC_WORKS instead of
+	AC_TRY_COMPILER.  Make sure that the *first* working 32-bit
+	compiler is used if no 64-bit compiler is found.
+	(GMP_CHECK_ASM_MMX): New macro.
+	* aclocal.m4: Regenerate.
+
+	* Makefile.in: Regenerate.  (CC_TEST removed.)
+	* mpf/Makefile.in: Likewise.
+	* mpn/Makefile.in: Likewise.
+	* mpq/Makefile.in: Likewise.
+	* mpz/Makefile.in: Likewise.
+	* mpf/tests/Makefile.in: Likewise.
+	* mpq/tests/Makefile.in: Likewise.
+	* mpz/tests/Makefile.in: Likewise.
+
+	* acconfig.h (_LONG_LONG_LIMB): Add.
+
+	* gmp-impl.h: Include config.h only if HAVE_CONFIG_H is defined.
+
+2000-03-09  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/pentium/mul_basecase.S: Small speedup by avoiding an AGI.
+
+	* mpn/x86/k7/mmx/copyd.asm: Tiny speedup by avoiding popl.
+	* mpn/x86/k7/mmx/copyi.asm: Ditto.
+	* mpn/x86/k7/mul_basecase.asm: Ditto.
+
+2000-03-07  Torbjorn Granlund  <tege@swox.com>
+
+	* config.guess: Better recognize POWER/PowerPC processor type.
+
+2000-03-07  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/generic/addsub_n.c: Use HAVE_NATIVE_* now in config.h.
+
+	* mpn/asm-defs.m4: Add comments about SysV m4.
+	(m4_log2): Don't use <<.
+	(m4_lshift,m4_rshift): New macros.
+
+2000-03-06  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/powerpc32/regmap.m4: Map cr0 => `0', etc.
+
+2000-03-06  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/tests/ref.c (refmpn_divexact_by3): New function.
+	* mpn/tests/ref.h: Prototype.
+
+	* acconfig.h (WANT_ASSERT): New define.
+	* configure.in (--enable-assert): Turn on WANT_ASSERT.
+	* assert.c: New file.
+	* Makefile.am: Add to build.
+	* gmp-impl.h (ASSERT): New macro.
+	(ASSERT_NOCARRY) Renamed from assert_nocarry.
+	(MPZ_CHECK_FORMAT): Use ASSERT_ALWAYS.
+	* mpn/tests/ref.c: Use ASSERT.
+	* mpf/get_str.c: Use ASSERT_ALWAYS.
+	* mpf/set_str.c: Remove old assert macro.
+
+	* mpn/x86/x86-defs.m4 (cmovnz_ebx_ecx): New macro.
+	* mpn/x86/p6/aorsmul_1.asm: Use cmov.
+
+	* mpn/x86/lshift.S: Use %dl with testb, not %edx. No object code
+	change, testb was still getting generated.
+	* mpn/x86/rshift.S: Ditto.
+
+2000-03-03  Torbjorn Granlund  <tege@swox.com>
+
+	* longlong.h: Add IA-64 support.
+
+	* mpn/powerpc32: Misc cleanups.
+	* mpn/powerpc32/aix.m4: New file (mainly by Linus).
+	* mpn/powerpc64/aix.m4: New file (mainly by Linus).
+	* mpn/powerpc64: Translate `.S' files to `.asm'.
+
+	* configure.in: Fix tyops.
+	* configure: Regenerate.
+
+2000-03-02  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/powerpc32/regmap.m4: New file.
+	* mpn/powerpc32: Translate `.S' files to `.asm'.
+	* configure.in: Use mpn/powerpc32/regmap.m4 for powerpc targets
+	except some weird ones.
+
+2000-03-03  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/lisp/gmpasm-mode.el: Suppress postscript comment prefixes in
+	filladapt.
+
+	* mpn/x86/pentium/sqr_basecase.asm: New file.
+	* mpn/x86/pentium/gmp-mparam.h (KARATSUBA_SQR_THRESHOLD): Update.
+
+	* configure.in: Add --enable-assert, enable k6 logops functions.
+
+	* mpn/x86/k6/mmx/copyi.asm: Use m4 for divide, not as.
+	* mpn/x86/k6/mmx/copyd.asm: Ditto.
+	* mpn/x86/README.family: Add a note on this.
+
+2000-03-02  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/k6/aors_n.asm: Don't use stosl.
+	* mpn/x86/copyi.asm: Use cld to clear direction flag.
+	* mpn/x86/divrem_1.asm: Ditto.
+	* mpn/x86/README.family: Add a note on this.
+
+	* mpn/x86/k6/mmx/copyi.asm: Rewrite.
+	* mpn/x86/k6/mmx/copyd.asm: New file.
+	* mpn/x86/k6/README: Update, and small amendments.
+
+	* mpn/x86/x86-defs.m4 (Zdisp): New macro.
+	* mpn/asm-defs.m4 (m4_stringequal_p): New macro.
+
+	* mpn/x86/p6/aorsmul_1.asm: Use Zdisp to force zero displacements.
+	* mpn/x86/k6/aorsmul_1.asm: Ditto.
+	* mpn/x86/k6/mul_1.asm: Ditto.
+	* mpn/x86/k6/mul_basecase.asm: Ditto.
+	* mpn/x86/k7/aors_n.asm: Ditto.
+	* mpn/x86/k7/aorsmul_1.asm: Ditto.
+	* mpn/x86/k7/mul_1.asm: Ditto.
+	* mpn/x86/k7/mul_basecase.asm: Ditto.
+	* mpn/x86/README.family: Add a note on this.
+
+2000-02-27  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/generic/divrem.c (mpn_divrem_classic): Patch to avoid gcc
+	2.7.2.3 i386 register handling bug.
+
+	* mpn/x86/k6/aors_n.asm: Rewrite.
+	* mpn/x86/k6/mmx/lshift.asm: Rewrite.
+	* mpn/x86/k6/mmx/rshift.asm: Rewrite.
+	* mpn/x86/k6/README: Update.
+
+	* mpn/x86/k7/mmx/copyd.asm: Support size==0.
+	* mpn/x86/k7/mmx/copyi.asm: Ditto.
+	* mpn/x86/k6/mmx/copyi.asm: Ditto.
+	* gmp-impl.h: Comment size==0 allowed in MPN_COPY_INCR and
+	MPN_COPY_DECR.
+	* configure.in: Enable x86 copyi, copyd; add k6 com_n.
+
+2000-02-25  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/pexpr.c (power): Move factorial handing code from `factor'
+	to `power'.
+
+	* demos/factorize.c (factor_using_pollard_rho): Move resetting of `c'
+	to before checking for a non-zero gcd.
+
+2000-02-25  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/asm-defs.m4 (MULFUNC_PROLOGUE): New macro by Linus.
+	* mpn/x86/k6/aors_n.asm: Use MULFUNC_PROLOGUE.
+	* mpn/x86/k6/aorsmul_1.asm: Ditto.
+	* mpn/x86/k7/aors_n.asm: Ditto.
+	* mpn/x86/k7/aorsmul_1.asm: Ditto.
+	* mpn/x86/p6/aorsmul_1.asm: Ditto.
+
+	* mpn/tests/ref.c (refmpn_copyi,refmpn_copyd): Allow size==0.
+
+	* gmp-impl.h: Move mpn_and_n, mpn_andn_n, mpn_com_n, mpn_ior_n,
+	mpn_iorn_n, mpn_nand_n, mpn_nior_n, mpn_xor_n and mpn_xorn_n here
+	from gmp.h.  Use HAVE_NATIVE_mpn_* to make these functions or
+	inlines.
+
+	* gmp-impl.h: Move mpn_copyd, mpn_copyi here from gmp.h.
+	* gmp-impl.h (MPN_COPY_INCR): Use mpn_copyi if available.
+	* gmp-impl.h (MPN_COPY_DECR): Use mpn_copyd if available.
+
+	* mpn/x86/k6/mmx/com_n.asm: Moved into mmx subdirectory.
+	* mpn/x86/k6/mmx/copyi.asm: Ditto.
+	* mpn/x86/k6/mmx/lshift.asm: Ditto.
+	* mpn/x86/k6/mmx/rshift.asm: Ditto.
+	* mpn/x86/k7/mmx/rshift.asm: Ditto.
+	* mpn/x86/k6/mmx/logops_n.asm: New file.
+	* configure.in (k6*-*-*): Add logops_n.asm.
+	* mpn/x86/k6/README: Update.
+
+	* mpn/x86/k7/mmx/copyi.asm: New file.
+	* mpn/x86/k7/mmx/copyd.asm: New file.
+	* mpn/x86/k7/README: Update.
+
+2000-02-24  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/x86-defs.m4 (femms): Generate emms if 3dnow not available.
+	* mpn/x86/x86-defs.m4 (FRAME_popl): New macro.
+
+	* Makefile.am: Add info_TEXINFOS = gmp.texi
+
+	* mpn/x86/divrem_1.asm: Moved from mpn/x86/k6, allow size==0,
+	conditionalize loop versus decl/jnz.
+	* mpn/x86/mod_1.asm: Ditto.
+	* mpn/x86/divmod_1.asm: Removed.
+	* gmp.texi (mpn_divrem_1,mpn_mod_1): Add that size==0 is allowed.
+	* mpn/tests/ref.c (refmpn_divrem_1c,etc): Allow size==0.
+
+	* mpn/x86/k6/aors_n.asm: Avoid gas 1.92.3 leal displacement
+	expression problem.
+	* mpn/x86/k6/aorsmul_1.asm: Ditto.
+	* mpn/x86/k6/mul_1.asm: Ditto.
+	* mpn/x86/k6/mul_basecase.asm: Ditto
+	* mpn/x86/k7/aors_n.asm: Ditto.
+	* mpn/x86/k7/aorsmul_1.asm: Ditto.
+	* mpn/x86/k7/mul_1.asm: Ditto.
+	* mpn/x86/k7/mul_basecase.asm: Ditto.
+	* mpn/x86/k7/rshift.asm: Ditto.
+	* mpn/x86/p6/aorsmul_1.asm: Ditto.
+	* mpn/x86/README.family: Describe problem.
+
+2000-02-24  Linus Nordberg  <linus@swox.se>
+
+	* acinclude.m4 (GMP_CHECK_ASM_LSYM_PREFIX): Add dummy symbol to
+	testcase to avoid nm failure.  Try nm before piping to grep.
+
+	* acconfig.h: Undef HAVE_NATIVE_func for every mpn function found
+	in gmp.h.
+
+	* configure.in: Invoke AC_CONFIG_HEADERS.
+	Don't invoke AM_CONFIG_HEADER; it makes autoconf confused.
+	Dig out entry points declared in assembly code and AC_DEFINE proper
+	HAVE_NATIVE_func.
+
+	* mpn/asm-defs.m4 (MULFUNC_PROLOGUE): New macro.
+
+	* mpn/x86/p6/aorsmul_1.asm: Use MULFUNC_PROLOGUE.
+	* mpn/x86/k6/aors_n.asm: Likewise.
+
+	* Makefile.am (EXTRA_DIST): Add config.in; needed when we don't
+	use AM_CONFIG_HEADER in configure.in.
+
+	* mpn/Makefile.am (INCLUDES): Add `-I..' for config.h and
+	gmp-mparam.h.
+	* mpf/Makefile.am: Likewise.
+	* mpq/Makefile.am: Likewise.
+	* mpz/Makefile.am: Likewise.
+
+	* mpf/tests/Makefile.am (INCLUDES): Add `-I../..' for config.h and
+	gmp-mparam.h.
+	* mpq/tests/Makefile.am: Likewise.
+	* mpz/tests/Makefile.am: Likewise.
+
+	* configure: Regenerate.
+	* aclocal.m4: Regenerate.
+	* config.in: Regenerate.
+	* Makefile.in: Regenerate.
+	* mpf/Makefile.in: Regenerate.
+	* mpn/Makefile.in: Regenerate.
+	* mpq/Makefile.in: Regenerate.
+	* mpz/Makefile.in: Regenerate.
+	* mpf/tests/Makefile.in: Regenerate.
+	* mpq/tests/Makefile.in: Regenerate.
+	* mpz/tests/Makefile.in: Regenerate.
+
+2000-02-23  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/addmul_1.S: Amend comments, this code no longer used by
+	PentiumPro.
+	* mpn/x86/submul_1.S: Ditto.
+
+	* mpn/x86/k6/com_n.asm: Rewrite, smaller but same speed.
+
+	* mpn/x86/addmul_1.S: Add PROLOGUE and EPILOGUE to get .type and
+	.size for ELF.  Rename #define size to n to avoid .size.
+	* mpn/x86/lshift.S: Ditto.
+	* mpn/x86/mul_1.S: Ditto.
+	* mpn/x86/mul_basecase.S: Ditto.
+	* mpn/x86/rshift.S: Ditto.
+	* mpn/x86/submul_1.S: Ditto.
+	* mpn/x86/udiv.S: Ditto.
+	* mpn/x86/umul.S: Ditto.
+	* mpn/x86/pentium/add_n.S: Ditto.
+	* mpn/x86/pentium/addmul_1.S: Ditto.
+	* mpn/x86/pentium/lshift.S: Ditto.
+	* mpn/x86/pentium/mul_1.S: Ditto.
+	* mpn/x86/pentium/mul_basecase.S: Ditto.
+	* mpn/x86/pentium/rshift.S: Ditto.
+	* mpn/x86/pentium/sub_n.S: Ditto.
+	* mpn/x86/pentium/submul_1.S: Ditto.
+
+2000-02-22  Linus Nordberg  <linus@swox.se>
+
+	* acinclude.m4 (GMP_INIT): Use temporary file cnfm4p.tmp for
+	post-defines.
+	(GMP_FINISH): Ditto.
+	(GMP_DEFINE): Add third optional argument specifying location in
+	outfile.
+	(GMP_DEFINE_RAW): New macro.
+	* aclocal.m4: Regenerate.
+
+	* configure.in: Add `HAVE_TARGET_CPU_$target_cpu' using
+	GMP_DEFINE_RAW.
+	* configure: Regenerate.
+
+	* mpz/tests/Makefile.am: New test t-root.
+	* mpz/tests/Makefile.in: Regenerate.
+
+2000-02-22  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/root.c: Complete rewrite; still primitive, but at least correct.
+	* mpz/tests/t-root.c: New test.
+
+2000-02-22  Kevin Ryde  <kevin@swox.se>
+
+	* mpn/x86/k7/mul_basecase.asm: New file.
+	* mpn/x86/k7/README: Add mpn_mul_basecase speed.
+	* mpn/x86/k7/gmp-mparam.h: New file.
+
+	* mpn/x86/x86-defs.m4 (loop_or_decljnz,cmov_bytes): New macros.
+	* mpn/asm-defs.m4 (m4_ifdef_anyof_p): New macro.
+
+	* mpn/x86/k6/aorsmul_1.asm: New file.
+	* mpn/x86/k6/addmul_1.S: Removed (was a copy of pentium version).
+	* mpn/x86/k6/submul_1.S: Removed (was a copy of pentium version).
+
+	* mpn/x86/p6/aorsmul_1.asm: Use OPERATION_addmul_1 and
+	OPERATION_submul_1.
+	* mpn/x86/k6/aors_n.asm: Use OPERATION_add_n and OPERATION_sub_n.
+	* configure.in: Declare multi-function files for k6 and p6.
+
+	* configure.in: Add HAVE_TARGET_CPU_$target_cpu for config.m4.
+	* mpn/asm-defs.m4 (define_not_for_expansion): New macro.
+
+	* mpn/generic/divrem_1n.c (__gmpn_divrem_1n): New file, split from
+	mpn/generic/divrem_1.c.
+	* mpn/generic/divrem_1.c: Ditto.
+	* configure.in (gmp_mpn_functions): Ditto.
+
+2000-02-21  Torbjorn Granlund  <tege@swox.com>
+
+	* gmp.h: Undo 1996-10-06 NeXT change, it was clearly improperly
+	written.
+
+2000-02-21  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Link <src>/mpn/asm-defs.m4 to <build>mpn/asm.m4.
+	* configure: Regenerate.
+
+2000-02-21  Linus Nordberg  <linus@swox.se>
+
+	* mpn/x86/k7/aorsmul_1.asm: Change OPERATION_ADDMUL -->
+	OPERATION_addmul_1.  Change OPERATION_SUBMUL -->
+	OPERATION_submul_1.
+
+	* mpn/x86/k7/aors_n.asm: Change OPERATION_ADD --> OPERATION_add_n.
+	Change OPERATION_SUB --> OPERATION_sub_n.
+
+	* mpn/Makefile.am: Pass -DOPERATION_$* to preprocessors.
+	* mpn/Makefile.in: Regenerate.
+
+	* configure.in: Symlink mpn/asm-defs.m4 to build-dir/mpn.  Link
+	multi-function files to mpn/<function>.asm and remove function
+	name from `gmp_mpn_functions'.
+	* configure: Regenerate.
+
+	* acinclude.m4 (GMP_FINISH): Tell user what we're doing.
+	* aclocal.m4: Regenerate.
+
+2000-02-21  Kevin Ryde  <kevin@swox.se>
+
+	* gmp-impl.h: Rename __gmpn_mul_basecase to mpn_mul_basecase and
+	__gmpn_sqr_basecase to mpn_sqr_basecase, remove __gmpn prototypes.
+	* mpn/x86/mul_basecase.S: Ditto.
+	* mpn/x86/pentium/mul_basecase.S: Ditto.
+
+	* configure.in (gmp_m4postinc): Use x86-defs.m4 on athlon-*-* too.
+
+2000-02-20  Kevin Ryde  <kevin@swox.se>
+
+	* acinclude.m4 (GSYM_PREFIX): Drop $1, change by Linus.
+	* mpn/asm-defs.m4 (PROLOGUE,EPILOGUE): Use GSYM_PREFIX as a
+	string, change by Linus.
+	* mpn/x86/x86-defs.m4: Use GSYM_PREFIX as a string.
+
+	* mpn/x86/k6/gmp-mparam.h: New file.
+	* mpn/asm-defs.m4 (m4_warning): New macro.
+
+	* mpn/x86/README: Amendments per new code and directories.
+	* mpn/x86/README.family: New file.
+	* mpn/x86/k6/README: New file.
+	* mpn/x86/k7/README: New file.
+
+	* mpn/generic/mul_n.c: Rename __gmpn_mul_basecase to
+	mpn_mul_basecase and __gmpn_sqr_basecase to mpn_sqr_basecase.
+	* mpn/generic/mul_basecase.c: Ditto.
+	* mpn/generic/sqr_basecase.c: Ditto.
+	* mpn/generic/mul.c: Ditto.
+
+2000-02-19  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Don't try to symlink more than one multi-func
+	file.
+	* configure: Regenerate.
+
+2000-02-18  Linus Nordberg  <linus@swox.se>
+
+	* acinclude.m4 (GMP_CHECK_ASM_UNDERSCORE): GMP_DEFINE
+	`GSYM_PREFIX'.  Run ACTIONs even when value is found in cache.
+	(GMP_CHECK_ASM_ALIGN_LOG): GMP_DEFINE `ALIGN'.  Run ACTIONs even
+	when value is found in cache.
+	* aclocal.m4: Regenerate.
+
+	* configure.in: Don't define GSYM_PREFIX or ALIGN.
+	Add mechanism for multi-function files.
+	* configure: Regenerate.
+
+2000-02-18  Kevin Ryde  <kevin@swox.se>
+
+	* configure.in (gmp_m4postinc): Enable x86-defs.m4.
+	* mpn/x86/k7/mul_1.asm: Fix include.
+	* mpn/x86/k6/mul_basecase.S: Removed (copy of the pentium version).
+	* mpn/x86/k6/mul_basecase.asm: New file.
+	* mpn/x86/k6/sqr_basecase.asm: New file.
+	* mpn/x86/k6/com_n.asm: New file.
+	* mpn/x86/k6/copyi.asm: New file.
+	* gmp.texi (Low-level Functions): Clarify mpn overlaps permitted.
+	* gmp-impl.h (MPN_OVERLAP_P): New macro.
+	* gmp-impl.h (assert_nocarry): New macro.
+	* mpn/tests/ref.c: New file, based in part on other mpn/tests/*.c.
+	* mpn/tests/ref.h: New file.
+
+2000-02-17  Linus Nordberg  <linus@swox.se>
+
+	* Makefile.am (dist-hook): Don't include any emacs backup files
+	(*.~*) in dist.
+	* Makefile.in: Regenerate.
+
+2000-02-17  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc32/v9/mul_1.asm: Use `rd' to get current PC; get rid of
+	getpc function.
+	* mpn/sparc32/v9/addmul_1.asm: Likewise.
+	* mpn/sparc32/v9/submul_1.asm: Likewise.
+
+2000-02-17  Kevin Ryde  <kevin@swox.se>
+
+	* gmp.h: Add prototypes and defines for mpn_and_n, mpn_andn_n,
+	mpn_com_n, mpn_copyd, mpn_copyi, mpn_ior_n, mpn_iorn_n,
+	mpn_mul_basecase, mpn_nand_n, mpn_nior_n, mpn_sqr_basecase,
+	mpn_xor_n, mpn_xorn_n.
+
+	* mpn/asm-defs.m4: Many additions making up initial version.
+	* mpn/asm-defs.m4 (L): Use defn(`LSYM_PREFIX').
+	* mpn/x86/x86-defs.m4: New file.
+	* mpn/x86/k6/aors_n.asm: New file.
+	* mpn/x86/k6/divmod_1.asm: New file.
+	* mpn/x86/k6/divrem_1.asm: New file.
+	* mpn/x86/k6/lshift.S: Removed (was a copy of the pentium version).
+	* mpn/x86/k6/lshift.asm: New file.
+	* mpn/x86/k6/mod_1.asm: New file.
+	* mpn/x86/k6/mul_1.S: Removed (was a copy of the pentium version).
+	* mpn/x86/k6/mul_1.asm: New file.
+	* mpn/x86/k6/rshift.S: Removed (was a copy of the pentium version).
+	* mpn/x86/k6/rshift.asm: New file.
+	* mpn/x86/k7/aors_n.asm: New file.
+	* mpn/x86/k7/aorsmul_1.asm: New file.
+	* mpn/x86/k7/mul_1.asm: New file.
+	* mpn/x86/k7/rshift.asm: New file.
+	* mpn/x86/p6/aorsmul_1.asm: New file.
+	* mpn/x86/copyi.asm: New file.
+	* mpn/x86/copyd.asm: New file.
+	* mpn/lisp/gmpasm-mode.el: New file.
+
+2000-02-16  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc32/v9/mul_1.asm: Conditionalize for PIC.
+	* mpn/sparc32/v9/addmul_1.asm: Likewise.
+	* mpn/sparc32/v9/submul_1.asm: Likewise.
+	* mpn/sparc32/v8/supersparc/udiv.asm: Likewise.
+	* mpn/sparc32/udiv_fp.asm: Likewise.
+
+2000-02-16  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Add mechanism for including target specific
+	m4-files in config.m4.
+	* configure: Regenerate.
+
+	* acinclude.m4 (GMP_PROG_CCAS): Begin assembly lines (except
+	labels) with a tab character.  HP-UX demands it.
+	(GMP_CHECK_ASM_SIZE): Ditto.
+	(GMP_CHECK_ASM_LSYM_PREFIX): Ditto.
+	(GMP_CHECK_ASM_LABEL_SUFFIX): Set to empty string for HP-UX.
+	(GMP_CHECK_ASM_GLOBL): Change `.xport' --> `.export'.
+	* aclocal.m4: Regenerate.
+
+2000-02-16  Linus Nordberg  <linus@swox.se>
+
+	* acinclude.m4 (GMP_CHECK_ASM_LSYM_PREFIX): Define LSYM_PREFIX as
+	the prefix only, no argument.
+	* aclocal.m4: Regenerate.
+	* configure: Regenerate.
+
+	* mpn/asm-defs.m4 (L): No argument to LSYM_PREFIX.
+
+2000-02-15  Linus Nordberg  <linus@swox.se>
+
+	* acinclude.m4: Prefix all temporary shell variables with
+	`gmp_tmp_'.
+	(GMP_PROG_CC_FIND): Use defaults if no arguments are passed.
+	Quote use of arguments.
+	(GMP_PROG_CCAS): New macro.
+	(GMP_INIT): New macro.
+	(GMP_FINISH): New macro.
+	(GMP_INCLUDE): New macro.
+	(GMP_SINCLUDE): New macro.
+	(GMP_DEFINE): New macro.
+	(GMP_CHECK_ASM_LABEL_SUFFIX): New macro.
+	(GMP_CHECK_ASM_TEXT): New macro.
+	(GMP_CHECK_ASM_DATA): New macro.
+	(GMP_CHECK_ASM_GLOBL): New macro.
+	(GMP_CHECK_ASM_TYPE): New macro.
+	(GMP_CHECK_ASM_SIZE): New macro.
+	(GMP_CHECK_ASM_LSYM_PREFIX): New macro.
+	(GMP_CHECK_ASM_W32): New macro.
+	* aclocal.m4: Regenerate.
+
+	* configure.in: Find m4 and nm for target.
+	Use new macros to create config.m4.
+	Prefix all temporary shell variables with `tmp_'.
+	Pass `-X 64' to nm for 64-bit PPC target with 64-bit compiler.
+	* configure: Regenerate.
+
+	* Makefile.am (dist-hook): *Really* remove all CVS dirs in
+	dist.
+	* Makefile.in: Regenerate.
+
+	* mpn/Makefile.am: Add target for building .lo and .o from
+	.asm.
+	Pass -DPIC to preprocessor (CPP/m4) when building .lo.
+	Build .o a second time for target .lo, without -DPIC to
+	preprocessor.
+	(SUFFIX): Add `.asm'.
+	(EXTRA_DIST): Add asm-defs.m4.
+	* mpn/Makefile.in: Regenerate.
+
+	* mpf/Makefile.in: Regenerate.
+	* mpf/tests/Makefile.in: Regenerate.
+	* mpq/Makefile.in: Regenerate.
+	* mpq/tests/Makefile.in: Regenerate.
+	* mpz/Makefile.in: Regenerate.
+	* mpz/tests/Makefile.in: Regenerate.
+
+2000-02-15  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc32/udiv_fp.asm: Change `RODATA' to `DATA'.
+	* mpn/sparc32/v8/supersparc/udiv.asm: Likewise.
+	* mpn/sparc32/v9/addmul_1.asm: Likewise.
+	* mpn/sparc32/v9/submul_1.asm: Likewise.
+	* mpn/sparc32/v9/mul_1.asm: Likewise.
+
+	* mpn/sparc32/add_n.asm: Rename `size' -> `n'.
+	* mpn/sparc32/sub_n.asm: Likewise.
+
+	* sparc32: Rename `.s' and `.S' files to `.asm'.
+	* sparc64: Rename `.s' and `.S' files to `.asm'.
+
+2000-02-11  Torbjorn Granlund  <tege@swox.com>
+
+	* config.sub: Adopt to new config.guess sparc naming conventions.
+
+	* config.guess (sun4u:SunOS:5.*:*): Change `sparc9' to `sparcv9'.
+	* config.guess (sun4m:SunOS:5.*:*): Change to sun4[md]:SunOS:5.*:* and
+	change `sparc8' to `sparcv8'.
+
+	* mpn/x86/add_n.S: Use PROLOGUE/EPILOGUE.
+	* mpn/x86/sub_n.S: Likewise.
+
+	* mpn/x86/syntax.h (PROLOGUE): New name for PROLOG.
+	* mpn/x86/syntax.h (EPILOGUE): New name for EPILOG.
+
+2000-02-11  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Better path for 64-bit sparc without 64-bit cc.
+	Change sparc8 --> sparcv8.
+	Change sparc9 --> sparcv9.
+	* configure: Regenerate.
+
+2000-02-10  Linus Nordberg  <linus@swox.se>
+
+	* configure.in: Use Autoconf.
+	* Makefile.am: New file.
+
+	* AUTHORS: New file.
+	* COPYING: New file.
+	* acinclude.m4: New file.
+	* acconfig.h: New file.
+
+	* configure: Generate.
+	* Makefile.in: Generate.
+	* aclocal.m4: Generate.
+	* config.in: Generate.
+
+	* install.sh: Remove.
+	* install-sh: New file from Automake.
+	* missing: New file from Automake.
+	* ltconfig: New file from Libtool.
+	* ltmain.sh: New file from Libtool.
+
+	* mpf/Makefile.am: New file.
+	* mpf/Makefile.in: Generate.
+	* mpf/configure.in: Remove.
+	* mpf/tests/Makefile.am: New file.
+	* mpf/tests/Makefile.in: Generate.
+	* mpf/tests/configure.in: Remove.
+
+	* mpn/Makefile.am: New file.
+	* mpn/Makefile.in: Generate.
+	* mpn/configure.in: Remove.
+
+	* mpq/Makefile.am: New file.
+	* mpq/Makefile.in: Generate.
+	* mpq/configure.in: Remove.
+	* mpq/tests/Makefile.am: New file.
+	* mpq/tests/Makefile.in: Generate.
+	* mpq/tests/configure.in: Remove.
+
+	* mpz/Makefile.am: New file.
+	* mpz/Makefile.in: Generate.
+	* mpz/configure.in: Remove.
+	* mpz/tests/Makefile.am: New file.
+	* mpz/tests/Makefile.in: Generate.
+	* mpz/tests/configure.in: Remove.
+
+2000-02-10  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/x86/add_n.S: Don't use label L0 twice.
+	* mpn/x86/sub_n.S: Likewise.
+
+2000-01-20  Linus Nordberg  <linus@swox.se>
+
+	* demos/pexpr.c: Don't use setup_error_handler() in windoze.
+
+2000-01-19  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/pexpr.c (sigaltstack): #define to sigstack for AIX.
+	(setup_error_handler): Don't write to ss_size and ss_flags
+	on AIX.
+
+2000-01-11  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/configure.in (hppa2.0*-*-*): Move assignment of
+	target_makefile_frag to where it belongs.
+
+1999-12-21  Torbjorn Granlund  <tege@swox.com>
+
+	* longlong.h (v9 umul_ppmm): New #define.
+	(v9 udiv_qrnnd): New #define.
+
+1999-12-14  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/divmod_1.c: Use invert_limb.
+	* mpn/generic/mod_1.c: Use invert_limb.
+
+	* gmp-impl.h (invert_limb): Put definition here.
+	* mpn/generic/divrem.c (invert_limb): Delete definition.
+	* mpn/generic/divrem_2.c (invert_limb): Delete definition.
+
+	* gmp.h (mpn_divrem): Inhibit for non-gcc.
+	But declare (undo 1999-11-22 change).
+
+	* gmp-impl.h (DItype,UDItype): Do these also if _LONG_LONG_LIMB.
+
+	* longlong.h: Move 64-bit hppa code out of __GNUC__ conditional.
+
+	* stack-alloc.c (HSIZ): New #define.
+	(__tmp_alloc): Use HSIZ instead of sizeof(tmp_stack).
+
+1999-12-10  Torbjorn Granlund  <tege@swox.com>
+
+	* config.sub: Clean up handling of x86 CPUs: Properly recognize
+	Amd CPUs as unique entities.  Use manufacturer's names of
+	processors ("pentium", etc); still match ambiguous names like
+	"i586", "i686", "p6" but be conservative in interpreting them.
+
+	* configure.in: Recognize x86 CPU types known by config.guess.
+	* mpn/configure.in: Likewise.  Add x86/mmx path component as
+	appropriate.
+	(athlon-*-*): Fix typo.
+
+	* config.guess: Update x86 recog code to intiallly match
+	more than just i386.
+	Call K6-2 and K6-III for "k62" and "k63" respectively.
+
+	* config.guess: Recognize x86 CPU types.
+	Update code for FreeBSD, NetBSD, OpenBSD, Linux.
+
+1999-12-08  Torbjorn Granlund  <tege@swox.com>
+
+	* mpf/pow_ui.c: Avoid final squaring in loop.
+
+1999-12-07  Torbjorn Granlund  <tege@swox.com>
+
+	* gmp-impl.h (udiv_qrnnd_preinv2gen): Prefix local variables with `_'.
+	(udiv_qrnnd_preinv2norm): Likewise.
+	From Kevin Ryde:
+	(HAVE_ALLOCA): #define also if defined (alloca).
+
+1999-12-04  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/tests/add_n.c: Set OPS from CLOCK.
+	* mpn/tests/sub_n.c: Likewise.
+	* mpn/tests/mul_1.c: Likewise.
+	* mpn/tests/addmul_1.c: Likewise.
+	* mpn/tests/submul_1.c: Likewise.
+
+	* mpn/tests/lshift.c: Update from add_n.c.
+	* mpn/tests/rshift.c: Likewise.
+
+1999-12-03  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/powerpc64/copy.S: New file.
+
+1999-12-02  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc64/copy.s: New file.
+
+	* mpn/tests/copy.c: New file.
+
+	* mpn/configure.in: Recognize more Amd CPUs; Set special paths for
+	k7 CPU.
+
+	* configure.in: Recognize Amd x86 CPUs.
+
+	* mpz/fdiv_r_2exp.c: In rounding code, read in->_mp_size before
+	writing to res->_mp_size.
+
+	* mpn/powerpc64/*.S: Clean up assembly syntax, add function headers.
+	* mpn/powerpc64/gmp-mparam.h: (KARATSUBA_MUL_THRESHOLD): #define.
+	(KARATSUBA_SQR_THRESHOLD): #define.
+
+	* mpn/tests/add_n.c (main): Only print test number if TIMES==1
+	and not printing.
+	(main): Don't run reference code if NOCHECK.
+	* mpn/tests/sub_n.c: Likewise.
+	* mpn/tests/mul_1.c: Likewise.
+	* mpn/tests/addmul_1.c: Likewise.
+	* mpn/tests/submul_1.c: Likewise.
+
+	* mpn/tests/lshift.c: (main): Only print test number if TIMES==1
+	and not printing.
+	* mpn/tests/rshift.c: Likewise.
+
+1999-11-22  Torbjorn Granlund  <tege@swox.com>
+
+	* gmp.h (mpz_init_set_str): Declare using __gmp_const.
+	(mpz_set_str): Likewise.
+	(mpf_init_set_str): Likewise.
+	(mpf_set_str): Likewise.
+	(mpn_set_str): Likewise.
+	(__gmp_0): Likewise.
+	(mpn_divrem): Remove separate declaration; it's defined later in
+	this file.
+
+	* gmp.h: Replace "defined (__STD__)' by (__STDC__-0) in
+	expressions involving more than one term, to handle Sun's compiler
+	that most helpfully sets __STDC__ to 0.
+	* gmp-impl.h: Likewise.
+	* longlong.h: Likewise.
+
+1999-11-21  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc64/gmp-mparam.h (KARATSUBA_MUL_THRESHOLD): #define.
+	(KARATSUBA_SQR_THRESHOLD): #define.
+
+	* mpn/sparc64/lshift.s: Compensate stack references for odd stack ptr.
+	* mpn/sparc64/rshift.s: Likewise.
+
+	* mpn/sparc64/addmul_1.s: Propagate carry properly.
+	* mpn/sparc64/submul_1.s: Likewise.
+
+	* mpn/sparc64/sub_n.s: Rewrite.
+
+	* mpn/sparc64/sub_n.s: Get operand order for main subcc right
+	(before scrapping this code for new code).
+
+1999-11-20  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/sparc64/add_n.s: Rewrite.
+
+1999-11-17  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/x86/syntax.h (PROLOG): New #define.
+	(EPILOG): New #define.
+
+	* gmp.h (mpn_addsub_n): Declare.
+	* gmp.h (mpn_add_nc): Declare.
+	* gmp.h (mpn_sub_nc): Declare.
+	* mpn/powerpc64/addsub_n.S: New file.
+
+1999-11-17  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/alpha/gmp-mparam.h
+	(KARATSUBA_MUL_THRESHOLD): Only #define #ifndef.
+	(KARATSUBA_SQR_THRESHOLD): Likewise.
+
+1999-11-14  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/x86/mul_1.S: Unroll and optimize for P6 and K7.
+
+1999-11-09  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/x86/p6/gmp-mparam.h
+	(KARATSUBA_MUL_THRESHOLD): Only #define #ifndef.
+	(KARATSUBA_SQR_THRESHOLD): Likewise.
+
+1999-11-05  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/addsub_n.c: New file.
+
+1999-11-02  Torbjorn Granlund  <tege@swox.com>
+
+	* config.guess: Handle alpha:FreeBSD with alpha:NetBSD.
+
+	* configure.in (vax*-*-*): New case.
+	* config/mt-vax: New file.
+	* mpn/vax/add_n.s: Rewrite.
+	* mpn/vax/sub_n.s: Rewrite.
+
+1999-10-31  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/vax/rshift.s: New file.
+	* mpn/vax/lshift.s: New file.
+
+1999-10-29  Torbjorn Granlund  <tege@swox.com>
+
+	* config.sub: Handle k5 and k6.
+	* mpn/configure.in: Recognize k6.
+
+	* mpf/tests/t-get_d.c (LOW_BOUND, HIGH_BOUND): New #defines.
+	(main): Tighten error bounds to 14 digits.
+
+	* longlong.h (default umul_ppmm, when smul_ppmm exists):
+	Rename __m0 => __xm0, __m1 => __xm1.
+	(default smul_ppmm): Likewise.
+
+1999-10-11  Torbjorn Granlund  <tege@swox.com>
+
+	* config.guess: Reverse the test for POWER vs PowerPC.
+	* config.guess (sun4m:SunOS:5.*:*): New case.
+	* config.guess (sun4u:SunOS:5.*:*): New case.
+
+1999-09-29  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/divrem_2.c: Clean up comments.
+
+1999-09-23  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/tests/Makefile.in: Use move-if-change when generating binaries.
+	* mpf/tests/Makefile.in: Likewise.
+	* mpq/tests/Makefile.in: Likewise.
+	* mpz/tests/move-if-change: New file.
+	* mpf/tests/move-if-change: New file.
+	* mpq/tests/move-if-change: New file.
+
+	* gmp.h (mpn_incr_u): New macro (from mpn/generic/mul_n.c).
+	(mpn_decr_u): New macro.
+
+	* mpn/generic/mul_n.c (mpn_incr): Delete.
+	* mpn/generic/mul_n.c: Update usages mpn_incr => mpn_incr_u.
+	* mpn/generic/divrem_newt.c: Use mpn_incr_u and mpn_decr_u instead of
+	mpn_add_1 and mpn_sub_1.
+	* mpn/generic/sqrtrem.c: Likewise.
+	* mpz/cdiv_q_ui.c: Likewise.
+	* mpz/cdiv_qr_ui.c: Likewise.
+	* mpz/fdiv_q_ui.c: Likewise.
+	* mpz/fdiv_qr_ui.c: Likewise.
+
+	* mpn/generic/sqrtrem.c: Start single-limb Newton iteration from 18
+	bits.
+
+1999-07-27  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/divrem_1.c (__gmpn_divrem_1n): New function.
+
+	* mpn/generic/divrem_2.c: New file, code from divrem.c, `case 2:'.
+	* mpn/Makefile.in: Compile divrem_2.c.
+	* make.bat: Compile divrem_2.c.
+	* mpn/configure.in (functions): Add divrem_2.
+	* gmp.h: Declare mpn_divrem_2.
+
+	* mpn/generic/divrem.c: Delete special cases, handle just divisors
+	of more than 2 limbs.
+	* gmp.h (mpn_divrem): Call mpn_divrem_1, mpn_divrem_2, as appropriate.
+
+	* mpn/generic/divrem.c: Rework variable usage for better register
+	allocation.
+
+1999-07-26  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/alpha/ev5/add_n.s: Rewrite for better ev6 speed.
+	* mpn/alpha/ev5/sub_n.s: Likewise.
+
+1999-07-21  Torbjorn Granlund  <tege@swox.com>
+
+	* longlong.h (alpha): Define umul_ppmm for cc.
+
+	* gmp-impl.h (DItype, UDItype): Define for non-gcc if _LONGLONG is
+	defined.
+
+1999-07-15  Torbjorn Granlund  <tege@swox.com>
+
+	* longlong.h (powerpc64 count_leading_zeros): Fix typo.
+	(powerpc64 add_ssaaaa): Fix typos.
+	(powerpc64 sub_ddmmss): Fix typos.
+
+1999-07-14  Torbjorn Granlund  <tege@swox.com>
+
+	* mpz/tests/Makefile.in: Pass XCFLAGS when linking.
+	* mpf/tests/Makefile.in: Likewise.
+	* mpq/tests/Makefile.in: Likewise.
+	* mpn/Makefile.in (.S.o): Pass XCFLAGS.
+
+	* longlong.h: Add support for 64-bit PowerPC.
+	* config.sub: Handle "powerpc64".
+	* configure.in: Likewise.
+	* mpn/configure.in: Suppress use of config/t-ppc-aix for now,
+	it seems compiler passes proper options.
+	* mpn/powerpc64/*.S: New files.
+
+	* Makefile.in (FLAGS_TO_PASS): Pass "AR=$(AR)".
+
+1999-07-07  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/pexpr.c (factor): Change alloca call to a malloc/free pair.
+
+	* mpn/powerpc32/syntax.h: Add #define's for crN.
+
+	* gmp.h (gmp_rand_algorithm): Remove spurious `,'.
+
+1999-07-05  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/generic/divrem_1.c: Normalize divisor when needed.
+
+1999-07-02  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/configure.in (powerpc*-apple-mach): New configuration.
+	* mpn/powerpc32/*: Add support for apple-macho syntax.
+	* mpn/powerpc32/syntax.h: New file.
+	* gmp-impl.h: Don't use `__attribute__' syntax for Apple's perversion
+	of GCC.
+
+1999-05-26  Linus Nordberg  <linus@swox.se>
+
+	* rand.c (gmp_rand_init): Fix typo.
+
+	* mpn/generic/rawrandom.c (mpn_rawrandom): Count bits, not limbs,
+	to keep track of how many rounds to do in loop.  Clean up
+	temporary allocation.  Update `seedsize' inside loop.  Mask off
+	the correct number of bits from final result.  Init `mcopyp' even
+	when not normalizing `m'.
+
+	* randlc.c (gmp_rand_init_lc): Fix typo (don't call
+	mpz_init_set_ui()).
+
+	* mpn/generic/rawrandom.c (mpn_rawrandom): Set SIZ(s->seed) when
+	reallocating.
+
+1999-05-25  Linus Nordberg  <linus@swox.se>
+
+	* randcm.c: Remove.
+	* randcmui.c: Remove.
+	* Makefile.in: Remove randcm and randcmui.
+	* make.bat: Ditto.
+	* gmp-impl.h: Remove prototypes for __gmp_rand_init_common() and
+	__gmp_rand_init_common_ui().
+	* randlc.c (gmp_rand_init_lc): Don't call
+	__gmp_rand_init_common().
+
+	* randlcui.c (gmp_rand_init_lc_ui): Don't call
+	__gmp_rand_init_common_ui().
+
+	* gmp.h (__gmp_rand_state_struct): Remove unused member `maxval'.
+	* randclr.c (gmp_rand_clear): Remove reference to s->maxval.
+	* randcm.c (__gmp_rand_init_common): Ditto
+
+	* mpn/generic/rawrandom.c (mpn_rawrandom): Don't calculate nlimbs
+	twice.
+
+	* gmp.h (__gmp_rand_dist): Remove.
+
+1999-05-24  Linus Nordberg  <linus@swox.se>
+
+	* mpn/generic/rawrandom.c: Clean up comments.
+
+	* gmp.texi: Add documentation for random number generation.
+
+1999-05-21  Linus Nordberg  <linus@swox.se>
+
+	* gmp.h: Typedef `gmp_rand_state' as an array with one element.
+	Change prototypes accordingly.
+	* gmp-impl.h: Change prototypes using `gmp_rand_state'.
+	* rand.c (gmp_rand_init): Take `gmp_rand_state' as argument
+	instead of a pointer to a `gmp_rand_state'.
+	* mpf/urandom.c (mpf_urandomb): Ditto.
+	* mpz/urandom.c (mpz_urandomb): Ditto.
+	* mpn/generic/rawrandom.c (mpn_rawrandom): Ditto.
+	* randcmui.c (__gmp_rand_init_common_ui): Ditto.
+	* randlc.c (gmp_rand_init_lc): Ditto.
+	* randlcui.c (gmp_rand_init_lc_ui): Ditto.
+	* randui.c (gmp_rand_init_ui): Ditto.
+	* randcm.c (__gmp_rand_init_common): Ditto.
+	* randclr.c (gmp_rand_clear): Ditto.
+
+1999-05-20  Linus Nordberg  <linus@swox.se>
+
+	* Makefile.in: Rename randi.c --> rand.c, randi_lc.c --> randlc.c,
+	randicom.c --> randcm.c.  Add randui.c, randcmui.c, randlcui.c.
+	* make.bat: Ditto.
+
+	* gmp.h: Add prototypes for gmp_rand_init_ui() and
+	gmp_rand_init_lc_ui().
+	* gmp-impl.h: Add prototypes for __gmp_rand_init_common() and
+	__gmp_rand_init_common_ui().
+
+	* randlc.c, randcm.c, randclr.c, rand.c: Change #include of
+	<gmp.h> to "gmp.h".
+	* randclr.c: Include stdlib.h for free().
+	* rand.c: Include gmp-impl.h.
+
+1999-05-12  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/configure.in: Put generic m68k alternative last.
+
+1999-05-04  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/pexpr.c (setup_error_handler): Use sigemptyset to create
+	empty set (for portability).
+	(fns): Fix typo '#if #if'.
+	(mpz_eval_expr): Implement FERMAT and MERSENNE.
+
+	* demos/pexpr.c: Cast longjmp argument via long to silent warnings on
+	64-bit hosts.
+
+1999-05-03  Torbjorn Granlund  <tege@swox.com>
+
+	* demos/pexpr.c: Add #defines for GMP 1.x and 2.0 compatibility.
+
+	* demos/pexpr.c (setup_error_handler): New function; take signal
+	handler setup code from main(), with major modifications to use modern
+	signal interface.
+	(main): Remove signal handler setup code; call setup_error_handler.
+
+1999-04-27  Torbjorn Granlund  <tege@swox.com>
+
+	* mpn/configure.in: Fix typo, "sparc-*)" was "sparc)".
+
+1999-04-21  Torbjorn Granlund  <tege@swox.com>
+
+	* config.sub: Recognize ev6.
+
+1999-04-12  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* urandom.c: Split up into randclr.c, randi.c, randi_lc.c,
+	randicom.c.
+	* randclr.c, randi.c, randi_lc.c, randicom.c: New files.
+	* Makefile.in: Remove urandom.  Add randclr, randi, randi_lc,
+	randicom.
+	* make.bat: Ditto
+
+1999-03-31  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* configure.in (sparc9-*-solaris2.[789]*, etc): New alternative.
+	* mpn/configure.in: Use mt-sprc9 also for ultrasparc*-*-solaris2*.
+
+1999-03-30  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* urandom.c (__gmp_rand_scheme): Change NULL->0.
+	Include "gmp.h" instead of <gmp.h>.
+
+1999-03-29  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* gmp.h (__gmp_rand_data_lc): Now holds a, c, m instead of scheme
+	struct.
+	(__gmp_rand_lc_scheme_struct): Remove mpz_t's `a' and `m'.
+
+1999-03-23  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* Makefile.in: Compile top-dir/urandom.c.
+	* make.bat: Ditto.
+
+	* mpn/Makefile.in: Compile rawrandom.c.
+	* make.bat: Ditto.
+
+	* mpn/configure.in (functions): Add rawrandom.
+
+	* gmp.h (__gmp_rand_scheme_struct): Rename to
+	__gmp_rand_lc_scheme_struct.
+	(__gmp_rand_data_lc): Remove member 'n'.  Allocate a
+	__gmp_rand_lc_scheme_struct instead of a pointer to one.
+	Add prototype for gmp_rand_init_lc(), mpn_rawrandom().
+	New prototype for mpz_urandomb().
+
+	* urandom.c: New file.
+	(__gmp_rand_init_common): New function.
+	(gmp_rand_init_lc): New function.
+	(gmp_rand_init): Don't init data_lc->n.  Call gmp_rand_init_lc()
+	and __gmp_rand_init_common().
+	(gmp_rand_clear): Remove reference to data_lc->n.
+
+	* mpz/urandom.c (gmp_rand_init, gmp_rand_clear): Move to new file
+	urandom.c in top-dir.
+	(mpz_urandomb): Add function parameter nbits.  Call mpn_rawrandom().
+
+	* mpf/urandom.c (mpf_urandomb): Call mpn_rawrandom().
+
+	* mpn/generic/rawrandom.c: New file.
+	(mpn_rawrandom): New function.
+
+1999-03-17  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* extract-dbl.c: When packing result, adjust exp when sc == 0.
+
+	* mpf/tests/t-get_d.c: New file.
+	* mpf/tests/Makefile.in: Compile t-get_d.c.
+
+1999-03-16  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* mpz/urandom.c (__gmp_rand_scheme): Add extra braces around the
+	mpz_t members.
+
+	* make.bat: Compile mpz/urandom.c and mpf/urandom.c
+
+1999-03-15  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* mpz/urandom.c (gmp_rand_init): New function.
+	(gmp_rand_clear): New function.
+	(mpz_urandomb): New function.
+
+	* mpz/Makefile.in: Compile urandom.c
+
+	* mpf/urandom.c (mpf_urandomb): New function.
+
+	* mpf/Makefile.in: Compile urandom.c.
+
+	* gmp.h (__gmp_rand_state_struct, __gmp_rand_scheme_struct): New
+	structs for randomization functions.
+	(gmp_rand_dist, gmp_rand_alogrithm): New enums for randomization
+	functions.
+	(mpz_urandomb, mpf_urandomb): Add prototype.
+	(gmp_rand_init, gmp_rand_clear): Add prototype.
+
+1999-03-15  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* .gdbinit: New file.
+
+	* mpz/dump.c: New file.
+	* mpz/Makefile.in: Compile dump.c.
+	* make.bat: Likewise.
+	* gmp.h (mpz_dump): Declare.
+
+1999-03-14  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/tests/reuse.c: Also test mpz_invert and mpz_divexact.
+
+	* mpz/tests/convert.c: Update to GMP 2 variable syntax.
+
+1999-03-13  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/README: New file.
+	* mpz/README: New file.
+
+	* mpf/pow_ui.c: New file.
+	* mpf/Makefile.in: Compile pow_ui.c.
+	* make.bat: Likewise.
+	* gmp.h (mpf_pow_ui): Declare.
+
+1999-03-12  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/configure.in: Stage 1 of rewrite.
+	* mpn/underscore.h: New name for bsd.h.
+	* mpn/sysv.h: Deleted.
+
+	* mpn/m68k/*: Don't include sysdep.h.
+
+1999-03-11  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/powerpc32/add_n.S: Add support for both AIX and ELF syntax.
+	Renamed from `.s'.
+	* mpn/powerpc32/sub_n.S: Likewise.
+	* mpn/powerpc32/lshift.S: Likewise.
+	* mpn/powerpc32/rshift.S: Likewise.
+	* mpn/powerpc32/mul_1.S: Likewise.
+	* mpn/powerpc32/addmul_1.S: Likewise.
+	* mpn/powerpc32/submul_1.S: Likewise.
+
+	* mpn/powerpc32/umul.S: New file.
+	* mpn/sparc32/v8/umul.S: New file.
+	* mpn/sparc32/umul.S: New file.
+	* mpn/x86/umul.S: New file.
+	* mpn/x86/udiv.S: New file.
+
+	* mpn/Makefile.in (mul_basecase.o): Delete rule.
+
+1999-02-22  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* configure.in (hppa2.0*-*-*): Force use of GCC.
+
+	* extract-dbl.c: Handle IEEE denormalized numbrs.  Clean up.
+
+1998-12-02  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/Makefile.in (CCAS): New macro.
+	(.s.o): Use CCAS.
+	(.S.o): Likewise.
+
+	* mpn/Makefile.in (mul_basecase.o): Add dependency.
+	(sqr_basecase.o): Likewise.
+	(mod_1.o): Likewise.
+
+	* demos/pexpr.c (cputime): Test also __hpux.
+	(cleanup_and_exit): Check SIGXCPU only #ifdef LIMIT_RESOURCE_USAGE.
+
+	* mpz/tests/t-2exp.c: Use urandom, not random.
+
+	* mpn/configure.in (arm*-*-*): New alternative.
+
+1998-11-30  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* gmp-impl.h (union ieee_double_extract): Special case for
+	little-endian arm.
+	(LIMBS): Alias for PTR.
+
+1998-11-26  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* longlong.h (m68000 umul_ppmm): Use `muluw', not `mulu'.
+	(m68k stuff): Clean up; add coldfire support.
+
+1998-11-23  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/mips3/gmp-mparam.h (KARATSUBA_MUL_THRESHOLD): #define.
+	(KARATSUBA_SQR_THRESHOLD): #define.
+
+	* mpn/sparc32/v9/README: New file.
+
+1998-11-20  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/x86/README: New file.
+
+	* mpn/arm/gmp-mparam.h: New file.
+	* mpn/pa64/gmp-mparam.h: New file.
+	* mpn/hppa/gmp-mparam.h: New file.
+	* mpn/x86/pentium/gmp-mparam.h: New file.
+	* mpn/sparc32/v9/gmp-mparam.h: New file.
+	* mpn/powerpc32/gmp-mparam.h: New file.
+	* mpn/x86/p6/gmp-mparam.h: New file.
+
+	* mpn/alpha/gmp-mparam.h (KARATSUBA_MUL_THRESHOLD): #define.
+	(KARATSUBA_SQR_THRESHOLD): #define.
+
+	* mpn/configure.in: Point to x86/p6 when appropriate.
+
+	* mpn/power/umul.s: New file.
+	* mpn/power/sdiv.s: New file.
+	* mpn/pa64/addmul_1.S: New file.
+	* mpn/pa64/submul_1.S: New file.
+	* mpn/pa64/mul_1.S: New file.
+	* mpn/pa64/udiv_qrnnd.c: New file.
+	* mpn/pa64/umul_ppmm.S: New file.
+	* mpn/mips2/umul.s: New file.
+	* mpn/m68k/mc68020/umul.s: New file.
+	* mpn/m68k/mc68020/udiv.s: New file.
+	* mpn/hppa/hppa1_1/umul.s: New file.
+	* mpn/alpha/umul.s: New file.
+	* mpn/a29k/udiv.s: New file.
+	* mpn/a29k/umul.s: New file.
+
+1998-11-17  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/x86/mul_basecase.S: New file for non-pentiums.
+	* mpn/x86/mul_basecase.S: Move to mpn/x86/pentium.
+
+1998-11-16  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* make.bat: Compile mul_basecase.c and sqr_basecase.c.
+
+1998-11-10  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/invert.c: Defer writing to parameter `invert' until
+	end.
+
+1998-11-03  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/pa64/udiv_qrnnd.c: Handle more border cases.
+
+1998-10-29  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* insert-dbl.c: Special case biased exponents < 1; Get boundary for
+	Inf right.
+
+	* longlong.h (COUNT_LEADING_ZEROS_NEED_CLZ_TAB): New #define.
+
+1998-10-28  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/powerpc32/submul_1.s: Rewrite, optimizing for PPC604.
+	* mpn/powerpc32/addmul_1.s: Likewise.
+	* mpn/powerpc32/lshift.s: Likewise.
+
+1998-10-23  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* config/mt-sprc9-gcc (XCFLAGS): Add -Wa,-xarch=v8plus.
+
+	* mpn/sparc32/v9/submul_1.s: New file.
+
+1998-10-21  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/config/mt-pa2hpux: New file.
+	* mpn/configure.in (hppa2.0*-*-*): Use new 64-bit code.
+
+	* config.sub: Recognize hppa2.0 as CPU type.
+
+	* longlong.h (64-bit hppa): Add umul_ppmm and udiv_qrnnd.
+	* mpn/pa64/mul_1.S: New file.
+	* mpn/pa64/addmul_1.S: New file.
+	* mpn/pa64/submul_1.S: New file.
+	* mpn/pa64/umul_ppmm.S: New file.
+	* mpn/pa64/udiv_qrnnd.c: New file.
+
+1998-10-20  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/pprime_p.c: Pass 1L, not 1, to mpz_cmp_ui.
+
+	* mpz/fdiv_q_2exp.c: Cast `long' argument to `mp_limb_t' for mpn calls.
+	* mpz/gcd_ui.c: Likewise.
+	* mpz/add_ui.c: Likewise.
+	* mpz/sub_ui.c: Likewise.
+
+1998-10-19  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/generic/bdivmod.c: Avoid using switch statement with mp_limb_t
+	index.
+
+1998-10-17  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/sparc32/v9/mul_1.s: Misc cleanups.
+	* mpn/sparc32/v9/addmul_1.s: Misc cleanups.
+
+1998-10-16  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/tests/{add,sub,}mul_1.c: Print xlimb using mpn_print.
+
+	* mpz/tests/t-powm.c (SIZE): Increase to 50.
+	(EXP_SIZE): New parameter; use it for computing exp_size.
+
+1998-10-15  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/generic/divrem_newt.c: Use TMP_ALLOC interface.
+
+	* mpn/generic/sqrtrem.c: Check BITS_PER_MP_LIMB before defining
+	assembly variants of SQRT.
+
+1998-10-14  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/tests: Clean up timing routines.  Don't include longlong.h
+	where it is not needed.
+	(mpn_print): Handle printing when _LONG_LONG_LIMB.
+	* mpn/tests/{add,sub,}mul_1.c: Generate xlimb with mpn_random2
+	and do it whether TIMES != 1 or not.
+
+	* mpn/generic/mul_n.c: Delay assignment of `sign' for lower
+	register pressure.
+
+	* mpn/sparc32/v9/mul_1.s: New file.
+
+	* config/mt-sprc9-gcc: New file.
+	* configure.in: Use it.
+
+	* mpn/configure.in: Use sparc64 for Solaris 2.7 and later with a
+	sparc v9 CPU.
+	* mpn/configure.in: Use sparc32/v9 for Solaris 2.6 or earlier with
+	a sparc v9 CPU.
+
+	* mpf/sub.c: In initial code for ediff == 0, limit precision
+	before jumping to `normalize'.
+
+1998-10-13  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/hppa/hppa2_0/add_n.s: New file.
+	* mpn/hppa/hppa2_0/sub_n.s: New file.
+	* mpn/configure.in: Handle hppa2.0 (32-bit code for now).
+
+	* config.guess: Update from egcs 1.1.
+	(9000/[3478]??:HP-UX:*:*): Properly return 2.0 for all known 2.0
+	machines.
+
+1998-10-07  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/root.c (mpz_root): New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_root): Declare.
+
+	* mpz/perfpow.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_perfect_power_p): Declare.
+
+	* mpz/remove.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_remove): Declare.
+
+	* mpz/bin_ui.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_bin_ui): Declare.
+
+	* mpz/bin_uiui.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_bin_uiui): Declare.
+
+1998-09-16  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* longlong.h: Test for __powerpc__ in addition to _ARCH_PPC.
+
+Sat Sep  5 17:22:28 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/cmp_si.c: Compare most significant mantissa limb before
+	trying to deduce anything from the limb count.
+	* mpf/cmp_ui.c: Likewise.
+
+Tue Aug 18 10:24:39 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/pprime_p.c (mpz_probab_prime_p): Add new code block
+	for doing more dividing.
+
+Sat Aug 15 18:43:17 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/generic/divrem_newt.c: New name for divrem_newton.c.
+	* mpn/Makefile.in: Corresponding changes.
+	* mpn/configure.in: Likewise.
+
+Wed Aug 12 23:07:09 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* config.guess: Handle powerpc for NetBSD.
+
+Tue Jul 28 23:10:55 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/fib_ui.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_fib_ui): Declare.
+
+Wed Jun 17 22:52:58 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* make.bat: Fix typo, `asm-synt.h' => `asm-syntax.h'.
+
+Wed Jun  3 11:27:32 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* config/mt-pwr: New file.
+	* config/mt-ppc: New file.
+	* configure.in: Use the new files.
+
+Tue Jun  2 13:04:17 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/sparc32/v9/addmul_1.s: New file.
+	* mpn/config/mt-sprc9: New file.
+	* mpn/configure.in: Use mt-sprc9.
+
+Tue May 26 11:24:18 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* demos/factorize.c (factor_using_pollard_rho): Pass correct
+	parameters in recursive calls; join the two recursion arms.
+
+	* mpf/set_q.c: Set result sign.
+	When normalizing the numerator, don't allow it to increase in size
+	beyond prec.
+
+Tue May 19 17:28:14 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* demos/factorize.c (factor_using_division): Call fflush
+	also for the factor 2.
+
+Mon May 18 15:51:01 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* make.bat: Pass -fomit-frame-pointer.  Do not pass -g.
+
+Tue May  5 01:42:50 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/Makefile.in (LOCAL_CC): Remove definition.
+
+	* gmp.h: Get rid of GMP_SMALL stuff.
+	* mpz/Makefile.in: Likewise.
+	* mpq/Makefile.in: Likewise.
+	* mpf/Makefile.in: Likewise.
+
+	* mpz/invert.c: Fix typo in comment.
+
+Mon May  4 23:05:32 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/generic/sqrtrem.c: Check that __arch64__ is not defined
+	before defining sparc SQRT.
+
+Mon Apr 20 19:16:17 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/generic/gcdext.c: Allow gp to be NULL.
+
+1998-04-03  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/configure.in: Recognize `alphaev5*', not `alphaev5'.
+
+	* config.guess: Handle CPU variants for NetBSD.
+
+Mon Mar 16 13:07:54 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/pprime_p.c: Use mpn_mod_1/mpn_preinv_mod_1 for computing mod PP,
+	not mpz_tdiv_r_ui (which expects an `unsigned long').
+	(mpz_probab_prime_p): Change type of `r' to mp_limb_t.
+
+Thu Mar 12 17:19:04 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* gmp.h (mpf_ceil, mpf_floor, mpf_trunc): Add declarations.
+
+	* config.guess: Update from FSF version.
+	* config.sub: Likewise.
+
+	* config.guess: Add special handling of alpha-*-NetBSD.
+
+Wed Mar 11 00:55:34 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/inp_str.c: Update from set_str.c.
+	Properly increment `nread' when skipping minus sign.
+
+	* mpz/set_str.c: Check for empty string after having skipped
+	leading zeros.
+
+Mon Mar  9 19:28:00 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/set_str.c: Skip leading zeros.
+
+Wed Mar  4 19:29:16 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* gmp.h (mpz_cmp_si): Cast argument before calling mpz_cmp_ui.
+
+	* demos/factorize.c: Rewrite.
+
+1998-02-04  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* configure.in (i[3456]86* etc): Check if using gcc before
+	choosing mt-x86.
+
+	* configure.in (m68*-*-*): New alterantive.
+	* config/mt-m68k: New file.
+
+	* mpn/alpha/invert-limb.s: Put tables in text segment,
+	since not all systems support "rdata".
+
+Wed Feb  4 02:20:57 1998  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* gmp.h (__GNU_MP_VERSION_SNAP): New #define.
+	(__GNU_MP_VERSION_MINOR): Now 1.
+
+Wed Jan 28 22:29:36 1998  Torbjorn Granlund  <tege@tunnis.tmg.se>
+
+	* longlong.h (alpha udiv_qrnnd): #define UDIV_NEEDS_NORMALIZATION.
+
+Wed Jan 28 20:28:19 1998  Torbjorn Granlund  <tege@sophie.matematik.su.se>
+
+	* mpz/pprime_p.c (mpz_probab_prime_p): Delete 59 from tried divisors.
+
+Mon Jan 26 01:39:02 1998  Torbjorn Granlund  <tege@tunnis.tmg.se>
+
+	* mpz/pprime_p.c (mpz_probab_prime_p): Major overhaul: Check small
+	numers specifically; check small factors, then perform a fermat test.
+
+Tue Jan 13 14:58:28 1998  Torbjorn Granlund  <tege@tunnis.tmg.se>
+
+	* longlong.h (alpha udiv_qrnnd): Call __mpn_invert_normalized_limb
+	and udiv_qrnnd_preinv.
+
+Wed Jan  7 01:52:54 1998  Torbjorn Granlund  <tege@tunnis.tmg.se>
+
+	* mpn/configure.in (alpha*, extra_functions): Add invert-limb and
+	remove udiv_qrnnd.
+
+	* mpn/tests/divrem.c: Get allocations right.
+
+	* mpn/generic/divrem.c: Conditionally pre-invert most significant
+	divisor limb.
+
+Tue Jan  6 23:08:54 1998  Torbjorn Granlund  <tege@tunnis.tmg.se>
+
+	* mpn/generic/divrem_1.c: Rename variables to comply to conventions.
+	Make `i' have type `mp_size_t'.
+
+Tue Dec 30 22:21:42 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/tdiv_qr_ui.c: Return the remainder.
+	* mpz/tdiv_r_ui.c: Likewise.
+	* mpz/tdiv_q_ui.c: Likewise.
+	* gmp.h: Change return type of mpz_tdiv_qr_ui, mpz_tdiv_r_ui,
+	mpz_tdiv_q_ui.
+
+	* mpz/tdiv_ui.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_tdiv_ui): Declare.
+
+Fri Nov  7 04:21:15 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/integer.c (FUNC_NAME): Fix bogus test for mpf_trunc.
+
+	* demos/isprime.c: New file.
+
+	Sat Nov  1 19:32:25 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/cmp_abs.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_cmp_abs): Declare.
+
+	* mpz/cmp_abs_ui.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_cmp_abs_ui): Declare.
+
+Sat Sep 27 04:49:52 1997  Torbjorn Granlund  <tege@tunnis.tmg.se>
+
+	* mpz/fdiv_r_2exp.c: Get allocation for `tmp' right.
+
+	* mpz/fdiv_q_2exp.c: In final result adjustment code, handle
+	that intermediate result is zero.
+
+	* mpz/tests/t-2exp.c: New file.
+	* mpz/tests/Makefile.in: Handle t-2exp.c.
+
+Fri Sep 26 16:29:21 1997  Torbjorn Granlund  <tege@tunnis.tmg.se>
+
+	* mpz/divexact.c: Fix typo in test for whether to copy numerator to
+	quotient and move that statement to after handling quotient and
+	denominator overlap.  Misc cleanups.
+
+	* mpn/generic/gcd.c: Change count argument of mpn_lshift/mpn_rshift
+	calls to `unsigned int'.
+	* mpz/divexact.c: Likewise.
+
+Mon Sep 22 02:19:52 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpz/tests/t-powm.c: Decrease `reps' to 2500.
+
+	* mpz/tests/t-pow_ui.c: New file.
+	* mpz/tests/Makefile.in: Handle t-pow_ui.c.
+
+	* mpz/ui_pow_ui.c: Get special cases for exponent and base right.
+
+	* mpz/pow_ui.c: Increase temp space allocation by 1 limb.
+	Split `rsize' into two variables; compute space allocation into
+	`ralloc'.
+
+Sun Sep  7 04:15:12 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpn/pa64/lshift.s: New file.
+	* mpn/pa64/rshift.s: New file.
+	* mpn/pa64/sub_n.s: New file.
+
+Sat Sep  6 19:14:13 1997  Torbjorn Granlund  <tege@gmp.tmg.se>
+
+	* mpn/pa64/add_n.s: New file.
+	* mpn/pa64: New directory.
+
+Tue Aug 19 16:17:09 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpz/swap.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_swap): Declare.
+
+	* mpn/generic/mul_n.c: Push assignment of x and y pointers into the
+	if/else clauses in several places.  (Decreases register pressure.)
+
+Mon Aug 18 03:29:50 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpn/thumb/add_n.s: New file.
+	* mpn/thumb/sub_n.s: New file.
+	* mpn/arm/add_n.s: New file.
+	* mpn/arm/sub_n.s: New file.
+
+	* mpz/powm.c: After mpn_mul_n and mpn_mul calls, adjust product size
+	if most significant limb is zero.
+	* mpz/powm_ui.c: Likewise.
+
+Fri Aug 15 02:13:57 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpn/arm/m/mul_1.s: New file.
+	* mpn/arm/m/addmul_1.s: New file.
+
+	* mpn/powerpc32/mul_1.s: Rewrite.
+
+	* mpn/alpha/mul_1.s: Prefix labels with `.'.
+
+Mon Aug 11 02:37:16 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpn/powerpc32/add_n.s: Rewrite.
+	* mpn/powerpc32/sub_n.s: Rewrite.
+
+Sun Aug 10 17:07:15 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpn/powerpc32/addmul_1.s: Delete obsolete comments.
+	* mpn/powerpc32/submul_1.s: Likewise.
+
+Fri Jul 25 20:07:54 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpz/addmul_ui.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_addmul_ui): Declare.
+
+	* mpz/setbit.c: Add missing code after final `else'.
+
+Tue Jul 22 17:45:01 1997  Torbjorn Granlund  <tege@tunnis.tmg.se>
+
+	* mpn/sh/add_n.s: Fix typo.
+	* mpn/sh/sub_n.s: Likewise.
+
+	* longlong.h (ns32k count_trailing_zeros): Fix typo.
+
+	* insert-dbl.c: Check for exponent overflow and return Inf.
+
+	* mpz/get_d.c: Rewrite to avoid rounding errors.
+
+Thu May 29 11:51:07 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpq/add.c: Swap some usages of tmp1 and tmp2 to make sure
+	their allocation suffices.
+	* mpq/sub.c: Likewise.
+
+Wed Apr 16 02:24:25 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* demos/pexpr.c: New file.
+
+	* mpn/generic/mul_n.c: Misc optimizations from Robert Harley.
+
+	* gmp-impl.h (MPZ_PROVOKE_REALLOC): New #define.
+
+Sat Apr 12 17:54:04 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* mpz/tstbit.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_tstbit): Declare.
+
+	* mpz/tests/logic.c: Use MPZ_CHECK_FORMAT.
+	* mpz/tests/bit.c: New test.
+	* mpz/tests/Makefile.in: Handle bit.c.
+
+	* mpz/ior.c: In -OP2,+OP1 case, normalize OP2 after call to mpn_sub_1.
+
+	* gmp-impl.h (MPZ_CHECK_FORMAT): New #define.
+
+Thu Apr 10 00:30:14 1997  Torbjorn Granlund  <tege@tmg.se>
+
+	* longlong.h (POWER/PowerPC): Test _ARCH_PWR instead of _IBMR2.
+
+Wed Apr  9 18:23:31 1997  Torbjorn Granlund  <tege@pro.tmg.se>
+
+	* gmp-impl.h: Move defaulting of UMUL_TIME and UDIV_TIME from here...
+	* longlong.h: ...to here.
+
+Sun Mar 30 12:16:23 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/generic/next_prime.c: New file.
+
+	* mpn/generic/perfsqr.c: Remove definitions of PP and PP_INVERTED.
+	* gmp-impl.h: Put them here.
+
+Fri Mar 28 08:18:05 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* gmp-impl.h (MPN_COPY_INCR, MPN_COPY_DECR): Define as inline asm for
+	for x86, but leave disabled for now.
+
+Fri Feb 28 02:39:47 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/Makefile.in (.S.o): Pass SFLAGS and CFLAGS also to compiler
+	for assembly phase.
+	(.s.o): Pass SFLAGS.
+
+Wed Feb 26 06:46:08 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/configure.in: For Pentium Pro, use default code, not Pentium
+	optimized code.
+
+	* mpn/x86/addmul_1.S: Unroll and optimize for Pentium Pro.
+	* mpn/x86/submul_1.S: Likewise.
+
+Thu Feb 13 08:26:09 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/Makefile.in: Compile floor.o, ceil.o and trunc.o (from
+	integer.c).
+	* make.bat: Likewise.
+
+Wed Feb  5 05:58:44 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/configure.in (alpha*): Add cntlz to extra_functions.
+
+Wed Feb  4 03:30:45 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/integer.c: New file (supporting mpf_floor, mpf_ceil, mpf_trunc).
+
+Mon Feb  3 14:21:36 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* make.bat: Fix typo, set_dfl_prc => set_dfl_prec.
+
+Sun Feb  2 02:34:33 1997  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/out_str.c: After outputting `-', decrement n_digits.
+
+Wed Jan  8 02:50:20 1997  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/generic/divrem.c: qextra_limbs => qxn.
+
+Wed Dec 18 07:50:46 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpz/tests/t-tdiv.c (SIZE): Increase to 200.
+
+Tue Dec 17 19:32:48 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/generic/divrem.c (mpn_divrem_classic): New name for mpn_divrem.
+	* gmp.h (mpn_divrem): New function.
+	* mpn/generic/divrem_newton.c: New file.
+	* mpn/configure.in (functions): Add divrem_newton.
+	* make.bat: Likewise.
+
+Thu Dec 12 17:55:13 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* gmp.h (_GMP_H_HAVE_FILE): Test also __dj_include_stdio_h_.
+
+Sat Dec  7 09:40:06 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/alpha/invert-limb.s: New file.
+
+Thu Dec  5 01:25:31 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpz/ui_pow_ui.c (mpz_pow2): New (static) function.
+	(mpz_ui_pow_ui): Rewrite.
+
+	* make.bat: `pre_mod_1.c' => `pre_mod_.c'.  Fix typo in path to
+	gmp-mpar.h.
+
+Fri Nov 15 00:49:55 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpz/ui_pow_ui.c: Rewrite for better speed.
+
+Fri Nov  1 16:36:56 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* Makefile.in (recursive make rules): Use `&&' instead of `;' as
+	delimiter.
+
+Fri Oct 25 17:12:36 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* gmp-impl.h (Cray/uxp MPN_COPY): Really declare as inline.
+
+Thu Oct 24 15:08:19 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/fujitsu/rshift.c: Fix typo in loop boundaries.
+
+Fri Oct 18 03:13:54 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/configure.in: Recognize `nextstep' for m68k variants; likewise
+	for x86 variants.
+
+	* mpn/x86/syntax.h (INSND): New macro.
+	* mpn/x86/[lr]shift.S: Use INSND.
+	* mpn/x86/pentium/[lr]shift.S: Likewise.
+	* mpn/config/t-oldgas (SFLAGS): Pass -DOLD_GAS.
+
+	* gmp-impl.h: In code for determining endianess, test also
+	__BIG_ENDIAN__ and __hppa__.  Remove test of __NeXT__.
+
+Wed Oct 16 03:50:34 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpf/set_str.c: Let `prec' determine precision used in
+	exponentialization code; decrease allocation accordingly.
+
+	* mpn/vax: Change `jsob*' to `sob*' in all files.
+
+Tue Oct 15 03:54:06 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* longlong.h (m88110 udiv_qrnnd): Change type of intermediate quotient
+	to DImode (divu.d generates a 64-bit quotient).
+
+	* configure.in (m88110*): Fix typo.
+
+	* mpf/get_str.c: Compute exp_in_base using `double' to avoid overflow.
+
+	* gmp-impl.h (struct bases): Change type of chars_per_bit_exactly from
+	float to double.
+	* mpn/mp_bases.c (__mp_bases): Give 17 digits for chars_per_bit_exactly
+	field.
+
+	* mpf/get_str.c: Let `prec' determine precision used in
+	exponentialization code; decrease allocation accordingly.
+
+Sun Oct 13 03:31:53 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* longlong.h: Major cleanup.
+	(__udiv_qrnnd_c): Compute remainders using multiply and subtract,
+	not explicit `%' operator.
+	(C umul_ppmm): Get rid of a redundant __ll_lowpart.
+
+	* mpz/invert.c: Properly detect all operands that would yield an
+	undefined inverse; make sure the inverse is always positive.
+
+	* mpz/xor.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_xor): Declare.
+
+	* mpz/tests/logic.c: Also test mpz_xor.
+
+	* mpz/lcm.c: Special case for when either operand equals 0.
+
+Sat Oct 12 01:57:09 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/generic/gcd.c (find_a): Don't inline on x86.
+
+	* Makefile.in (CFLAGS): Default to just `-g'.
+
+	* configure.in: Recognize 386 and 486 wherever other x86 cpus are
+	recognized.
+	* configure.in: Use mt-x86 for all x86 cpus.
+	* config/mt-x86: New file.
+
+	* mpn/alpha/cntlz.s: New file.
+
+Tue Oct  8 00:16:18 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* longlong.h: Define smul_ppmm for Fujitsu vpp/uxp.
+	Rewrite umul_ppmm to actually work on the hardware.
+
+	* mpn/x86/sub_n.S: Avoid parens around displacement of `leal'.
+	* mpn/x86/add_n.S: Likewise.
+
+	* mpn/x86/syntax.h (R): Define differently depending on __STDC__.
+
+Mon Oct  7 16:48:08 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* longlong.h: Don't test for __NeXT__ in outer 68k conditional;
+	add test for __m68k__.
+
+Sun Oct  6 00:59:09 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* gmp.h: Declare mpn_random.
+	* make.bat: Compile mpn/generic/random.c.
+
+	* longlong.h: Define umul_ppmm for Fujitsu vpp/uxp.
+
+	* gmp-impl.h: Protect definitions using `__attribute__ ((mode (...)))'
+	with test also for __GNUC_MINOR__.
+
+	* gmp.h: Don't define macros using __builtin_constant_p when using
+	NeXT's compiler.
+
+Fri Oct  4 16:53:50 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpz/lcm.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h (mpz_lcm): Declare.
+
+Wed Sep 25 00:06:21 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpq/tests/t-cmp_ui.c: Make sure numerator and denominator of `b' is
+	within limits of an `unsigned long int'.
+
+	* mpz/tests/t-powm_ui.c: Change type of exp2 to `unsigned long int'.
+
+Tue Sep 24 18:58:20 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpz/powm_ui.c: Make result always positive.
+
+	* urandom.h (urandom): Make it return mp_limb_t.
+
+	* gmp-impl.h (CNST_LIMB): New macro.
+	* mpn/mp_bases.c: Use CNST_LIMB.
+	* mpn/generic/hamdist.c (popc_limb): Likewise.
+	* mpn/generic/popcount.c (popc_limb): Likewise.
+	* mpn/generic/perfsqr.c: Likewise.
+
+Fri Sep 20 03:08:10 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpz/pprime_p.c: When n <= 3, don't clear out n before using it.
+
+Wed Sep 18 11:22:45 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/fujitsu/mul_1.c: New file.
+	* mpn/fujitsu/addmul_1.c: New file.
+	* mpn/fujitsu/sub_n.c: New file.
+	* mpn/fujitsu/add_n.c: Mew file.
+
+Sun Sep 15 03:13:02 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/generic/random.c: New file.
+	* mpn/configure.in (functions): Add `random'.
+
+	* gmp-impl.h (MPN_COPY): Define as annotated inline function for
+	Crays and Fujitsu VPPs.
+
+	* gmp.h (mp_size_t): Define as `int' for non-MPP Cray.
+	(mp_exp_t): Likewise.
+
+	* configure.in: Add support for Fujitsu VPP machines.
+	* mpn/configure.in: Likewise.
+	* config.guess: Likewise.
+	* config.sub: Likewise.
+
+	* mpn/fujitsu/rshift.c: New file.
+	* mpn/fujitsu/lshift.c: New file.
+	* mpn/fujitsu: New directory, for Fujitsu VPP machines.
+
+Wed Sep 11 11:34:38 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/generic/mul_n.c (__gmpn_mul_n): New name for impn_mul_n.
+	Call __gmpn_mul_basecase, not impn_mul_n_basecase; update parameter
+	list to work with __gmpn_mul_basecase.
+	(__gmpn_sqr): New name for impn_sqr_n.
+	Call __gmpn_sqr_basecase, not impn_sqr_n_basecase; update parameter
+	list to work with __gmpn_sqr_basecase.
+	(mpn_mul_n): Update calls to match new names and parameter conventions.
+	* gmp-impl.h (MPN_MUL_N_RECURSE): Likewise.
+	(MPN_SQR_RECURSE): New name for MPN_SQR_N_RECURSE.
+	Update calls to match new names and parameter conventions.
+	* mpn/generic/mul.c: Never perform multiply explicitly here, call
+	__gmpn_mul_basecase instead.
+	Update calls to match new names and parameter conventions.
+
+	* mpn/x86/mul_basecase.S: New file.
+	* mpn/generic/mul_basecase.c: New file.
+	* mpn/generic/sqr_basecase.c: New file.
+
+Wed Sep  4 02:59:21 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpz/set_str.c: Let `0b' and `0B' mean base 2.
+
+Fri Aug 30 00:44:00 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* longlong.h (x86 umul_ppmm): Work around GCC bug that was
+	triggered by Aug 28 change.
+
+	* mpbsd/min.c (digit_value_in_base): New function.
+
+	* mpz/set_str.c: Refine allocation size computation, use
+	chars_per_bit_exactly instead of chars_per_limb.
+
+	* mpbsd/Makefile.in (.c.o): Add -D_mpz_realloc=_mp_realloc.
+
+Wed Aug 28 02:52:14 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* longlong.h (x86 umul_ppmm): Don't cast result operands.
+	(x86 udiv_qrnnd): Likewise.
+	(default smul_ppmm): Fix typo, umul_ppmm => smul_ppmm.
+	(default umul_ppmm): New #define using smul_ppmm.
+	(vax smul_ppmm): New #define.
+	(vax umul_ppmm): Delete.
+	(POWER umul_ppmm): Delete.
+	(IBM 370 smul_ppmm): New #define.
+	(IBM 370 umul_ppmm): Delete.
+	(IBM RT/ROMP smul_ppmm): New #define.
+	(IBM RT/ROMP umul_ppmm): Delete.
+
+Tue Aug 27 01:03:25 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* gmp-impl.h (__gmp_0): Make it `const'.
+
+	* mpn/Makefile.in (clean mostlyclean): Comment out recursive clean
+	of `tests'.
+
+	* mpn/generic/mul.c: Identify when we do squaring, and call
+	impn_sqr_n_basecase/impn_sqr_n as appropriate.  Use
+	KARATSUBA_MUL_THRESHOLD and KARATSUBA_SQR_THRESHOLD.
+	Don't #define KARATSUBA_THRESHOLD.
+
+	* mpn/generic/mul_n.c: Don't #define KARATSUBA_THRESHOLD.
+	(impn_mul_n, impn_sqr_n): Rewrite, based on code contributed by
+	Robert Harley.
+	(impn_sqr_n_basecase): Rewrite.
+
+	* gmp-impl.h (KARATSUBA_MUL_THRESHOLD): New #define.
+	(KARATSUBA_SQR_THRESHOLD): Likewise.
+	(MPN_SQR_N_RECURSE): Use KARATSUBA_SQR_THRESHOLD.
+	(MPN_MUL_N_RECURSE): Use KARATSUBA_MUL_THRESHOLD.
+
+	* configure.in: Fix typo in last change.
+
+Mon Aug 26 22:25:18 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpn/generic/random2.c: Fix typo, `alpha__' => `__alpha'.
+	* mpf/random2.c: Likewise.
+
+Sun Aug 25 00:07:09 1996  Torbjorn Granlund  <tege@quiet.matematik.su.se>
+
+	* mpz/tests/t-mul.c: Also test squaring.
+
+Fri Aug 16 05:12:08 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mp_clz_tab.c (__clz_tab): Declare as `const'.
+	* version.c (gmp_version): Likewise.
+	* mpn/generic/sqrtrem.c (even_approx_tab, odd_approx_tab): Likewise.
+
+Thu Aug 15 02:34:47 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp.h: Fix typo, `mips__' => `__mips'.
+
+	* mpf/set_str.c: Allow a number to start with a period, if next
+	position contains a digit.
+
+Tue Aug 13 18:41:25 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/gcdext.c: Get cofactor sign right for negative input operands.
+	Clean up code for computing tt.
+
+	* mpz/invert.c: Get rid of variable `rv'.
+
+	* mpz/divexact.c: Test for zero divisor in special case for zero
+	dividend.
+
+Mon Aug 12 18:04:07 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/?div_*_ui.c: Special case for division by 0.
+	* mpz/tdiv_q.c: Likewise.
+
+Sat Aug 10 14:45:26 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/dmincl.c: Special case for division by 0.
+
+	* mpz/tdiv_*_ui.c: Delete special case for dividend being 0; handle
+	it when computing size after mpn_divmod_1 call.
+
+	* mp_bpl.c: (__gmp_junk): New variable.
+	(__gmp_0): New constant.
+
+	* gmp-impl.h (DIVIDE_BY_ZERO): New #define.
+
+Fri Aug  9 20:03:27 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/divexact.c: Test for dividend being zero before testing
+	for small divisors.
+
+Thu Aug  8 13:20:23 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* configure.in: Require operating system specification for cpus
+	where assembly syntax differs between system.
+
+	* Makefile.in (many targets): Change `-' action prefix to `@'.
+
+	* mpn/Makefile.in: (distclean): Fix typo.
+
+	* mpq/cmp_ui.c: Rename function to _mpq_cmp_ui.
+	(mpq_cmp_ui): #undef deleted.
+	* mpz/cmp_si.c: Rename function to _mpz_cmp_si.
+	(mpz_cmp_si): #undef deleted.
+	* mpz/cmp_ui.c: Rename function to _mpz_cmp_ui.
+	(mpz_cmp_ui): #undef deleted.
+	* Makefile.in: Corresponding changes.
+
+	* mpf/get_prc.c: Return the *highest* precision achievable.
+
+	* mpf/get_str.c: Complete rewrite.
+
+	* mpf/set_str.c (swapptr): New #define.
+	(assert): New #define.
+	* mpf/set_str.c: Set prec to one more than the saved _mp_prec.
+	Misc cleanups.
+
+	* mpz/set_str.c: #include string.h.
+	* mpf/out_str.c: #include string.h.
+	* mpbsd/xtom.c: #include string.h and ctype.h.
+	* mpbsd/mout.c: #include string.h.
+
+Wed Aug  7 11:46:04 EDT 1996  Ken Weber <kweber@mcs.kent.edu>
+
+	* mpn/generic/gcd.c: Reorder mpn_gcd argument list.
+	* mpz/gcd.c: Change call to mpn_gcd.
+	* gmp.texi: Update manual entry on mpn_gcd.
+	* mpn/generic/bdivmod.c: Delete limb cache to make mpn_bdivmod
+	reentrant.
+
+Wed Aug  7 02:15:38 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/get_str.c: Rewrite code for converting integral part of a
+	number with both an integral and fractional part.
+
+	* mpf/set_str.c: Get rid of variable xxx.  New variables madj and radj.
+	In exp_in_base==0 case, add madj to msize for EXP field.
+
+	* mpz/tests/t-gcd.c: Test deleted.  Rename t-gcd2.c to t-gcd.c.
+	Increase reps to 2000.
+	* mpz/tests/t-gcd2.c: Get rid of mpz_refgcd.
+
+	* mpf/set_str.c: Ignore excess limbs in MP,MSIZE.
+
+Thu Jul 25 04:39:10 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/configure.in: Fix typo in setting path, "sparc" => "sparc32".
+
+Wed Jul 24 02:27:02 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/gcdext.c: Reorganize and clean up.  Get rid of all
+	signed limb arithmetic.
+
+Mon Jul 22 02:39:56 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/gcdext.c (mpn_gcdext): For large enough operands,
+	work with most significant *two* limbs.
+	(div2): New function (two variants).
+	(THRESHOLD): New #define.
+
+	* mpz/gcdext.c: Fix typo in MPZ_TMP_INIT call.
+
+	* longlong.h (alpha UMUL_TIME): Now 30.
+	(alpha UDIV_TIME): Now 350.
+	(x86 UMUL_TIME): Now 10 (let Pentium decide).
+	(SuperSPARC UDIV_TIME): Override default.
+
+	* extract-dbl.c (MP_BASE_AS_DOUBLE): Don't redefine here.
+
+	* extract-dbl.c: New name for extract-double.c.
+	* insert-dbl.c: New name for insert-double.c.
+	* Makefile.in: Corresponding changes.
+	* make.bat: Likewise.
+
+	* mpz/Makefile.in (.c.o): Don't pass non-portable `-f' to cp.
+	* mpq/Makefile.in: Likewise.
+	* mpf/Makefile.in: Likewise.
+
+Sat Jul 20 01:35:18 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/getlimbn.c: Take ABS of integer->_mp_size.
+
+	* mpz/divexact.c: Use mpn_divmod_1 if divisor is a single limb.
+
+Thu Jul 18 00:31:15 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/popcount.c (popc_limb): Use different masking trick
+	for first step (due to David Seal).
+	* mpn/generic/hamdist.c (popc_limb): Likewise.
+
+Wed Jul 17 23:21:48 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/divrem.c: In MPN_COPY_DECR call, copy dsize - 1 limbs.
+
+Sun Jul 14 17:47:46 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* configure.in: Handle sparc9, sparc64, and ultrasparc like sparc8.
+
+Thu Jul 11 14:05:54 1996  J.T. Conklin  <jtc@rtl.cygnus.com>
+
+	* longlong.h (mc680x0): Define umul_ppmm, udiv_qrnnd, sdiv_qrnnd
+	for the '020, '030, '040, and '332.  Define count_leading_zeros
+	for the '020, '030, '040, and '060.
+
+Sun Jul 14 15:24:53 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	From Joe Keane:
+	* mpq/equal.c: Take ABS of num1_size before passing it to mpn_cmp.
+
+Fri Jul 12 17:11:17 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/sqrtrem.c (SQRT): New asm for x86, but leave it
+	disabled for now.
+
+	* mpn/generic/sqrtrem.c: Use MP_BASE_AS_DOUBLE.
+
+Wed Jul 10 03:17:45 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* cre-mparam.c: Delete obsolete file.
+
+	* gmp.h: #define _LONG_LONG_LIMB if __mips && _ABIN32.
+	* longlong.h: Test __mips instead of __mips__.
+
+Sun Jul  7 23:19:13 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* longlong.h (_PROTO): Define, unless already defined.
+	(alpha __udiv_qrnnd): Declare using _PROTO.
+	(hppa __udiv_qrnnd): Likewise.
+	(sparc __udiv_qrnnd): Likewise.
+
+Mon Jul  1 01:44:30 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* config.guess: Update from master version; add Cray x90 handling.
+
+Wed Jun 26 05:35:02 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/power/add_n.s (__mpn_add_n): Work around GAS bug.
+	* mpn/power/sub_n.s (__mpn_sub_n): Likewise.
+
+	* insert-double.c: Rework loop to avoid potential overflow.
+
+	* mpq/get_d.c: For vax, if qsize > N_QLIMBS, ignore excess limbs.
+
+	* mpq/tests/t-get_d.c (SIZE): Special case for vax.
+
+	* gmp.h (mpX_cmp_ui): #define also when ! __GNUC__.
+
+Mon Jun 24 17:13:21 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* longlong.h (vax sdiv_qrnnd): Fix typo.
+
+Sat Jun 15 01:33:33 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp.h: Support `small' and `large' type and function variants,
+	controlled by GMP_SMALL.
+
+	* mpz/Makefile.in (.c.o): Compile each function twice, for small and
+	large variant.
+	(MPZS_OBJS): New variable.
+	(libmpz.a): Include MPZS_OBJS in archive.
+	* mpf/Makefile.in: Analogous changes.
+	* mpq/Makefile.in: Analogous changes.
+
+	* gmp.h: Prefix all functions with __gmp, to allow namespace-clean
+	internal calls.
+
+	* mp.h: Rip out __MP_SMALL__ stuff.
+	(__mpz_struct): mp_size_t => int.
+
+	* mpz/invert.c: #include "gmp-impl.h".
+	Use MPZ_TMP_INIT, not mpz_init.
+
+	* mpz/gcdext.c: Rewrite to call mpn_gcdext.
+
+Fri Jun 14 18:05:29 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/gcdext.c (s0size): New parameter.
+	* gmp.h (mpn_gcdext): Update prototype.
+
+	* mpn/generic/gcdext.c: Major rewrite.
+
+Mon Jun 10 00:14:27 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/dump.c: Add missing `else'.
+
+Fri Jun  7 03:35:12 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* Makefile.in (gmp_toc.html): Pass -expandinfo to texi2html.
+
+Thu Jun  6 19:00:53 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* Version 2.0.2 released.
+
+	* install.sh: New file.
+	* Makefile.in (INSTALL): Use install.sh.
+	(install-normal): New name for target `install'.
+	(install): New dummy target.
+
+	* mpz/pow_ui.c: Swap tests for (e == 0) and (bsize == 0).
+	* mpz/ui_pow_ui.c: Swap tests for (e == 0) and (blimb == 0).
+
+	* config/mt-linux (AR_FLAGS): New file.
+	* configure.in: Use config/mt-linux for all linux systems.
+
+Tue Jun  4 03:42:18 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* Version 2.0.1 released.
+
+	* mpf/tests/ref.c: Cast result of TMP_ALLOC to the right pointer type.
+
+	* extract-double.c: Test _GMP_IEEE_FLOATS with #if, not plain if.
+
+	* insert-double.c: Don't #include stdlib.h.
+
+	* gmp-impl.h (union ieee_double_extract): Test sparc and __sparc.
+	Do not test __sparc__.
+
+	* mpf/reldiff.c: Change declaration to work around irix5 compiler bug.
+	* mpq/equal.c: Likewise.
+
+	* mpn/generic/gcd.c: Delete spurious comma at end of enumeration.
+
+	* mpn/generic/gcdext.c: Add K&R declaration syntax.
+	* stack-alloc.h: Likewise.
+	* insert-double.c: Likewise.
+	* extract-double.c: Likewise.
+	* mpf/tests/reuse.c: Likewise.
+	* mpz/tests/reuse.c: Likewise.
+	* mpf/tests/t-sub.c: Likewise.
+	* mpf/tests/t-add.c: Likewise.
+	* mpf/tests/t-muldiv.c: Likewise.
+	* mpf/tests/t-conv.c: Likewise.
+	* mpf/tests/ref.c: Likewise.
+
+	* mpn/config/t-oldgas: Renamed from t-freebsd.
+	* mpn/configure.in: Use t-oldgas for freebsd, netbsd, and some linux
+	configurations.
+
+	* mpn/powerpc32/mul_1.s: Really clear cy before entering loop.
+	* mpn/powerpc32/*.s: Fix power/powerpc syntax issues.
+
+	* mpn/config/t-ppc-aix: New file.
+	* mpn/configure.in: Use t-ppc-aix for powerpc like t-pwr-aix for power.
+
+Wed May 29 02:07:31 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp.h (mp_bits_per_limb): Change qualifier from `const' to
+	__gmp_const.
+
+	* gmp.h (mpf_init_set_str): Add `const' qualifier for 2nd parameter.
+	* mpf/iset_str.c: Likewise.
+
+Mon May 27 00:15:58 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp-impl.h: Declare __gmp_extract_double.
+
+	* mpz/set_q.c: Delete unused variables.
+
+	* gmp.h (mpq_equal): Declare.
+
+	* mpf/eq.c: mpf_cmp2 -> mpf_eq.
+
+Fri May 24 03:20:44 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/iset_d.c: Don't include <math.h>.
+
+	* insert-double.c (__gmp_scale2): New name for scal2.
+	* mpz/get_d.c: Corresponding change.
+	* mpf/get_d.c: Likewise.
+	* mpq/get_d.c: Likewise.
+	* gmp-impl.h: Declare __gmp_scale2.
+
+	* mpn/generic/scan0.c: Clarify comment.
+
+	* mpz/set_q.c: New file.
+	* Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h: Declare mpz_set_q.
+
+	* insert-double.c: New file.
+	* Makefile.in: Compile it.
+	* make.bat: Likewise.
+
+	* mpz/get_d.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h: Declare mpz_get_d.
+
+	* mpf/get_d.c: New file.
+	* mpf/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h: Declare mpf_get_d.
+
+	* make.bat: Compile things in alphabetical order.
+
+	* gmp-impl.h (MP_BASE_AS_DOUBLE): New #define.
+	(LIMBS_PER_DOUBLE): New #define.
+
+	* extract-double.c: New file.
+	* Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* mpz/set_d.c: Rewrite to use __gmp_extract_double.
+	* mpf/set_d.c: Likewise.
+
+	* mpn/configure.in: Use t-pwr-aix also for aix 3.2.4 and up.
+
+Wed May 22 02:48:35 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp-impl.h: Rework code for defining ieee_double_extract.
+	(IEEE_DOUBLE_BIG_ENDIAN): Macro removed.
+	(_GMP_IEEE_FLOATS): New macro.
+	* mpn/vax/gmp-mparam.h: Delete.
+
+	* mpn/config/t-pwr-aix: New file.
+	* mpn/configure.in: Use t-pwr-aix for aix 4 and later.
+
+Mon May 20 16:30:31 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp.h: In code for setting _GMP_H_HAVE_FILE, test more symbols.
+
+	* mpf/tests/t-add.c (oo): Add some `l' printf modifiers.
+	* mpf/tests/t-sub.c (oo): Likewise.
+	* mpf/tests/t-conv.c (oo): Likewise.
+	* mpf/tests/t-sqrt.c (oo): Likewise.
+
+	* mpz/tests/t-mul.c (_mpn_mul_classic): Remove unused variables.
+
+	* mpn/{pyr,i960,clipper}/*.s: Add missing copyright headers.
+
+Fri May 17 02:24:43 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/set_d.c: Call _mpz_realloc.
+
+	* mpq/set_z.c: New file.
+	* mpq/Makefile.in: Compile it.
+	* make.bat: Likewise.
+	* gmp.h: Declare mpq_set_z.
+
+	* mp?/Makefile.in (libmp?.a): Depend on Makefile, not Makefile.in.
+	* mpf/Makefile.in (test): Delete spurious target.
+	* mpq/Makefile.in (test): Likewise.
+
+	* mpf/out_str.c: Use `e' to separate exponent when base <= 10.
+
+	* mpn/configure.in: Treat ultrasparc just like sparc v8,
+	until 64-bit compilers are ready.
+
+	* mpf/set_d.c: Make it work for 64-bit machines.
+
+Thu May 16 20:53:57 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp-impl.h: Set IEEE_DOUBLE_BIG_ENDIAN to 0 for little-endian
+	machines.
+	* mpn/x86/gmp-mparam.h: Delete file.
+
+	* configure.in: Treat microsparc like sparc8.
+
+	* urandom.h: Test __alpha instead of __alpha__, since the former
+	is the standard symbol.
+	* mpn/generic/random2.c: Likewise.
+	* mpf/random2.c: Likewise.
+
+Tue May 14 13:42:39 1996  Torbjorn Granlund  (tege@tiny.matematik.su.se)
+
+	* mpz/set_f.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* gmp.h: Declare mpz_set_f.
+
+	* mpf/set_q.c: Simplify expression in rsize == nsize if-then-else arms.
+
+Tue May 14 13:03:07 1996  Torbjorn Granlund  (tege@tiny.matematik.su.se)
+
+	* make.bat: Add all new files.
+
+Sun May 12 22:24:36 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/set_z.c: New file.
+	* mpf/Makefile.in: Compile it.
+	* gmp.h: Declare mpf_set_z.
+
+Sat May 11 19:26:25 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp.h: Declare mpf_set_q.
+
+	* mpf/set_q.c: Compute prec-1 limbs in mpn_divrem call.
+
+Fri May 10 17:37:38 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/set_q.c: New file.
+	* mpf/Makefile.in: Compile it.
+
+	* config.sub: Recognize sparc8.
+
+Wed May  8 09:19:11 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/tests/t-dm2exp.c: New file.
+
+	* mpf/tests/t-add.c: Correct header comment.
+	* mpf/tests/t-sub.c: Likewise.
+	* mpf/tests/t-sqrt.c: Likewise.
+
+	* mpf/div.c: Misc variable name cleanups.
+	* mpf/div_ui.c: Base more closely on mpf/div.c.
+	* mpf/ui_div.c: Likewise.
+
+	* mpz/tests/Makefile.in (check): Depend on Makefile.
+	* mpq/tests/Makefile.in (check): Likewise.
+	* mpf/tests/Makefile.in (check): Likewise.
+
+	* mpf/tests/t-muldiv.c: New file.
+	* mpf/tests/Makefile.in: Compile and run `t-muldiv'.
+	(t-ref.o): Delete spurious rule.
+
+	* mpf/sqrt.c: Properly detect negative input operand.
+
+	* mpf/sqrt_ui.c: Delete spurious header comment.
+	* mpf/sqrt.c: Likewise.
+	* mpz/sqrt.c: Likewise.
+
+	* mpz/tests/reuse.c (main): Read `reps' from command line.
+
+	* mpf/tests/reuse.c: New file.
+	* mpf/tests/Makefile.in: Compile and run `reuse'.
+
+	* mpf/mul_ui.c: Disable code for removing low zero limbs.
+
+	* mpf/div.c: Fix condition for when vp and qp overlaps.
+
+	* mpf/add_ui.c: When sum equals u, copy up to prec+1 limbs.
+
+	* mpf/out_str.c: Don't output '\n' after exponent.
+
+	* mpf/add_ui.c: New special case for when U is completely cancelled.
+
+Wed Apr 24 05:33:28 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* Version 2.0 released.
+
+	* All files: Upfate FSF's address.
+
+	* Makefile.in (gmp_toc.html): New name for gmp.html.
+	(TAGS): Depend on force.
+
+	* mpf/tests/t-conv.c: Pass -base to mpf_set_str.
+
+Sat Apr 20 03:54:06 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* Makefile.in (ps): New target, depend on gmp.ps.
+
+Fri Apr 19 14:03:15 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/out_str.c: Print `@' before exponent, not `e'.
+
+	* make.bat: Update from Makefiles.
+
+Thu Apr 18 01:22:05 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/set_str.c: If parameter `base' is negative, expect exponent
+	to be decimal, otherwise in the same base as the mantissa.
+
+Wed Apr 17 17:28:36 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/set_dfl_prec.c: Don't return anything.
+	* gmp.h: Corresponding changes.
+
+	* mpf/set_dfl_prec.c: Use `unsigned long int' for bit counts.
+	* mpf/init2.c: Likewise.
+	* mpf/get_prc.c: Likewise.
+	* mpf/set_prc.c: Likewise.
+	* mpf/set_prc_raw.c: Likewise.
+	* mpz/popcount.c: Likewise.
+	* mpz/hamdist.c: Likewise.
+	* mpz/scan1.c: Likewise.
+	* mpz/scan0.c: Likewise.
+	* mpn/generic/popcount.c: Likewise.
+	* mpn/generic/hamdist.c: Likewise.
+	* mpn/generic/scan1.c: Likewise.
+	* mpn/generic/scan0.c: Likewise.
+	* gmp.h: Likewise.
+
+	* mpf/eq.c: New file, based on mpf/diff.c.
+	* mpf/diff.c: Delete.
+	* mpf/Makefile.in: Corresponding changes.
+	* gmp.h: Likewise.
+
+	* mpf/reldiff.c: New file.
+	* mpf/Makefile.in: Compile it.
+	* gmp.h: Declare mpf_reldiff.
+
+	* mpz/iset_d.c: New file.
+	* mpz/Makefile.in: Compile it.
+	* gmp.h: Declare mpz_init_set_d.
+
+Tue Apr 16 16:28:31 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* Makefile.in (gmp.html): Pass -acc to texi2html.
+
+Mon Apr 15 16:20:24 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/set_str.c: Switch off code for defaulting the base from the
+	leading characters.
+
+	* gmp.h (mp?_sign): Delete.
+	(mp?_sgn): New macros.
+
+Fri Apr 12 17:23:33 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* Makefile.in (gmp.dvi): Delete tmp.* at end of rule.
+
+Wed Apr 10 22:52:02 1996  Torbjorn Granlund  (tege@tiny.matematik.su.se)
+
+	* mpf/random2.c: Change of `exp' param, mp_size_t => mp_exp_t.
+	* gmp.h: Corresponding change.
+
+	* gmp.h (mp_bits_per_limb): Make it const.
+
+Sat Mar 30 01:20:23 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* configure.in: Re-enable recognition of with_gcc.
+
+	* mpf/Makefile.in (.c.o): Pass XCFLAGS.
+	* mpn/Makefile.in (.c.o): Likewise.
+	* mpz/Makefile.in (.c.o): Likewise.
+	* mpq/Makefile.in (.c.o): Likewise.
+	* mpbsd/Makefile.in (.c.o): Likewise.
+	* mpf/tests/Makefile.in (.c.o): Likewise.
+	* mpz/tests/Makefile.in (.c.o): Likewise.
+	* mpq/tests/Makefile.in (.c.o): Likewise.
+
+	* Makefile.in (XCFLAGS): Default to empty.
+	(FLAGS_TO_PASS): Pass on XCFLAGS.
+	(.c.o): Pass XCFLAGS.
+
+	* config/mt-m88110 (XCFLAGS): Define instead of CC.
+	* config/mt-sprc8-gcc (XCFLAGS): Likewise.
+	* config/mt-supspc-gcc (XCFLAGS): Likewise.
+
+	* configure: Don't default CC to "gcc -O2" is -with-gcc=no was
+	specified.
+
+Mon Mar 25 01:07:54 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* urandom.h: Test for __SVR4 in addition to __svr4__.
+
+	* mp_bpl.c (mp_bits_per_limb): Declare as `const'.
+
+	* Makefile.in (CFLAGS): `-O2' => `-O'.
+	* mpn/Makefile.in (CFLAGS): Likewise.
+
+	* gmp-impl.h: Get rid of obsolete field access macros.
+
+	* mpn/mp_bases.c (__mp_bases): 1e39 => 1e38 to work around Solaris
+	cc compiler bug.
+
+	* gmp.h (__MPN): Make it work also for non-ANSI compilers.
+
+Thu Mar 21 01:07:54 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/sub.c: New special case for ediff <= 1 before generic code.
+	Simplify generic code for ediff == 0.
+	Rename uexp => exp.
+
+Mon Mar 11 18:24:57 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/tests/*.c: Use ref_mpf_sub for error calculation.
+	* mpf/tests/Makefile.in: Link ref.o to all executables.
+
+	* mpf/tests/t-sub.c: Make u = v + 1 with 50% probability.
+
+Sun Mar 10 21:03:17 1996  Torbjorn Granlund  (tege@tiny.matematik.su.se)
+
+	* mpf/get_str.c: In digit development loop for fractions, change
+	loop condition from `<' to `<='.
+
+Thu Mar  7 04:58:11 1996  Torbjorn Granlund  <tege@tiny.matematik.su.se>
+
+	* mpn/mp_bases.c (__mp_bases): 1e100 => 1e39 to avoid overflow warning.
+
+Wed Mar  6 01:10:42 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpf/tests/t-sqrt.c: New file.
+	* mpf/tests/Makefile.in: Corresponding changes.
+
+	* mpf/sqrt.c: Special case for square root of zero.
+
+	* mpq/add.c: Clean up variable names.
+	* mpq/sub.c: Update from mpq/add.c.
+
+	* mpz/divexact.c: abs => ABS.
+	* mpz/gcd.c: Likewise.  Rewrite final fixup code, to decrease
+	allocation.  Misc cleanups.
+
+Tue Mar  5 22:24:56 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/configure.in: Recognize linuxoldld as a synonym for linuxaout.
+
+	* gmp.h (mpn_add, mpn_add_1, mpn_sub, mpn_sub_1): Add prototypes.
+
+	* mpn/configure.in: Use t-freebsd also for netbsd.
+
+Mon Mar  4 15:13:28 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpq/Makefile.in (cmp.o): Depend on longlong.h.
+
+	* mpq/equal.c: New file.
+	* mpq/Makefile.in: Corresponding changes.
+
+	* mpf/tests/t-add.c: New file.
+	* mpf/tests/t-sub.c: Renamed from t-addsub.c.
+	* mpf/tests/ref.c: New file.
+	* mpf/tests/Makefile.in: Corresponding changes.
+
+	* gmp-impl.h (SIZ, ABSIZ, PTR, EXP, PREC, ALLOC): New #defines.
+
+Sun Mar  3 07:45:46 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/set_str.c: In exponentialization code, allocate 3 extra
+	limbs, not just 2.
+
+	* mpf/get_str.c: Allocate sufficient space for tstr.
+	When calculating exp_in_base, round result down.
+
+	* mpf/tests/t-conv.c: New file.
+	* mpf/tests/Makefile.in: Corresponding changes.
+
+	* mp_bpl.c: New file.
+	* gmp.h: Declare it.
+	* Makefile.in: Corresponding changes.
+
+Sat Mar  2 06:27:56 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/set_prc_raw.c: New file.
+	* mpf/set_prc.c: Renamed from set_prec.c.
+	* mpf/get_prc.c: New file.
+	* mpf/Makefile.in: Corresponding changes.
+	* gmp.h: Declare new functions.
+
+	* mpn/generic/gcdext.c: Add copyright header.
+
+Fri Mar  1 01:22:24 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/configure.in: For ppc601, search "power" before "powerpc32".
+
+	* mp?/Makefile.in (AR_FLAGS): New variable.
+	(libmp?.a): Use it.
+
+	* make.bat: New file.
+	* mpn/msdos: New directory.
+	* mpn/msdos/asm-syntax.h: New file.
+
+	* mpn/Makefile.in (distclean maintainer-clean): Delete asm-syntax.h.
+
+	* config.sub: Recognize [ctj]90-cray.
+
+	* mpn/configure.in: Recognize [ctj]90-cray-unicos*.
+
+	* mpn/generic/gcdext.c: Don't use alloca directly, use TMP_* macros.
+
+	* mpn/generic/gcd.c: Split increment from use of USIZE to avoid
+	undefined behaviour.
+
+Thu Feb 29 04:11:24 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* Makefile.in (install-info-files): Update for new install-info
+	behaviour.
+
+	* mpn/power/add_n.s: Rewrite.
+	* mpn/power/sub_n.s: Rewrite.
+
+Wed Feb 28 01:34:30 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/pow_ui.c: Compute allocation more aggressively for small bases.
+	* mpz/ui_pow_ui.c: Likewise.
+
+	* mpn/mp_bases.c (__mp_bases): Put huge value in 2nd field for index 1.
+
+	* mpn/generic/sqrtrem.c: sizeof (mp_limb_t) => BYTES_PER_MP_LIMB.
+	* mpn/generic/gcd.c: Likewise.
+	(SIGN_BIT): Compute differently.
+
+Mon Feb 26 00:07:36 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* All files: mp_limb => mp_limb_t, mp_limb_signed => mp_limb_signed_t.
+
+	* Makefile.in (install, install-bsdmp, install-info-files): Depend
+	on installdirs.  chmod all installed files.
+
+Sun Feb 25 01:47:41 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpbsd/configure.in: Delete debugging code.
+
+	* All Makefile.in: Update clean targets.
+
+	* Makefile.in (AR_FLAGS): New variable.
+	(libgmp.a): Use it.
+	(libmp.a): Likewise.
+
+	* VERSION: Delete file.
+
+	* Makefile.in (installdirs): New target.
+	* mkinstalldirs: New file (from the texinfo package).
+
+	* Makefile.in (INSTALL, INSTALL_DATA, INSTALL_PROGRAM): New variables.
+	(MAKEINFO, MAKEINFOFLAGS, TEXI2DVI): New variables.
+	(install-info): New target.
+	(install, install-bsdmp): Depend on install-info.
+	($(srcdir)/gmp.info): Changed from plain gmp.info; put info files
+	into source directory.
+	(distclean, mostlyclean): New targets.
+	(maintainer-clean): New name for realclean.
+	(uninstall): New target.
+	(TAGS): New target.
+	(info, dvi): New targets.
+	(.PHONY): Assign.
+
+	* Makefile.in (install, install-bsdmp): Use INSTALL_DATA.
+
+	* mp{n,z,f,bsd}/move-if-change: Delete.
+
+	* mpbsd/Makefile.in (stamp-stddefh): Delete target.
+
+	* Makefile.in (.c.o): Pass CFLAGS last.
+	* mpbsd/Makefile.in (.c.o): Likewise.
+	* mpf/Makefile.in (.c.o): Likewise.
+	* mpq/Makefile.in (.c.o): Likewise.
+	* mpz/Makefile.in (.c.o): Likewise.
+	* mpn/Makefile.in (.c.o): Likewise.
+	(.S.o): Likewise.
+
+	* memory.c: Change allocation error message.
+
+	* Makefile.in (install): Prefix gmp.h with $(srcdir).
+	(install-bsdmp): Prefix mp.h with $(srcdir).
+
+	* mp{n,z,f,bsd}/{configure,config.sub}: Delete.
+
+	* Makefile.in (gmp.dvi): Set TEXINPUTS also for 2nd tex invocation
+	(install targets): Install gmp.info-N.
+
+Sat Feb 24 03:36:52 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/get_str.c: Fix typo.
+
+	* mpz/legendre.c: Clarify expression with extra parens.
+
+	* version.c (gmp_version): Not static.
+
+	* mpf/iset_str.c: Properly return error code.
+
+	* mpf/add.c: Delete unused variables.
+	* mpf/inp_str.c: Likewise.
+	* mpq/get_d.c: Likewise.
+
+	* mpn/generic/dump.c: #include <stdio.h>.
+	* mpf/dump.c: Likewise.
+	* mpf/set_str.c: #include <ctype.h>.
+	(strtol): Declare.
+
+	* gmp.h: mpn_sqrt => mpn_sqrtrem.
+
+	* Makefile.in (clean, realclean): Clean in mpbsd.
+	(check): Test in mpf.
+
+	* mpf/Makefile.in (clean): Clean in tests.
+	* mpq/Makefile.in (clean): Clean in tests.
+
+	* mpf/tests/Makefile.in: New file.
+	* mpf/tests/configure.in: New file.
+	* mpf/tests/t-addsub.c: New file.
+
+	* mpf/sub_ui.c: Simply call mpf_sub for now.
+
+	* mpf/sub.c: Increase prec by 1.
+	* mpf/ui_sub.c: Likewise.
+
+Fri Feb 23 00:59:54 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpf/ui_sub.c: Fix typos.
+
+	* mpf/get_str.c: When allocating space for tmp, allow for an extra
+	limb.  In code for fraction conversion, add special case for bases
+	that are a power of 2.
+
+	* mpf/out_str.c: Output leading "0.".
+	Default base to 10, before computing string allocation.
+
+	* mpf/get_str.c: Make variables for string size have type size_t.
+	* gmp.h: Corresponding change.
+
+	* mpf/random2.c: Allow creation of prec+1 large mantissas.
+
+	* mpf/add_ui.c: Don't abort if u < 0; special case for u <= 0.
+	Fix typo in MPN_COPY offset.
+	* mpf/sub_ui.c: Analogous changes.
+
+	* mpf/set_prec.c: Rewrite.
+
+	* mpf/init2.c: Compute precision as in set_prec.c.
+
+	* mpf/div_2exp.c: Special case for u == 0.
+	* mpf/mul_2exp.c: Likewise.  Write r->_mp_size always.
+
+	* mpf/sqrt_ui.c: mpn_sqrt => mpn_sqrtrem.
+	* mpf/sqrt.c: Likewise.  When computing new exponent, round quotient
+	towards -infinity.
+
+	* mpf/add.c: Fix typos.
+	* mpf/sub.c: Fix typos.
+
+Thu Feb 22 00:24:48 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/Makefile.in (stamp-stddefh): Delete target.
+	(test): Delete target.
+	* Makefile.in (stamp-stddefh): Delete target.
+	(cre-stddefh.o): Delete target.
+	(gmp.dvi): Set TEXINPUTS before invoking tex.
+
+	* cre-stddefh.c: Delete.
+
+	* mpz/sqrt.c: Fix typo.
+
+	* mpz/powm.c: Special case for mod == 0.
+	* mpz/powm_ui.c: Likewise.
+
+	* mpz/get_si.c: Handle -0x80000000 correctly.
+
+	* mpz/inp_str.c: Now returns size_t.
+	Make it return number of bytes read or error indication.
+	* mpf/inp_str.c: Likewise.
+
+	* mpz/out_raw.c: Replace by mpz/out_binary.c, with modifications.
+	* mpz/inp_raw.c: Rewrite, using mpz/inp_binary as a base.
+	* mpz/inp_binary.c: Delete.
+
+	* mpn/Makefile.in (XCFLAGS): Remove variable.
+	(.c.o): Don't pass XCFLAGS.
+	(SFLAGS): Set to nothing.
+	(.S.o): Pass SFLAGS, not XCFLAGS.
+
+	* mpn/config/t-freebsd (SFLAGS): New name for XCFLAGS.
+
+	* mpf/out_str.c: Make return number of bytes written or error
+	indication.
+	* mpz/out_str.c: Likewise.
+	* gmp.h: Corresponding changes.
+
+	* gmp.h (__mpz_struct): mp_size_t => int.
+	(__mpq_struct): Likewise.
+	(__mpf_struct): Likewise.
+	(mp_size_t): int => long int.
+
+	* mpn/cray: New directory.
+	* mpn/cray/gmp-mparam.h: New file.
+	* mpn/configure.in: Recognize cray variants.
+
+	* Makefile.in: Set defaults for prefix, libdir, etc.
+	(install): New target.
+	(install-bsdmp): New target.
+	(gmp.html): New target.
+
+	* stack-alloc.c (__tmp_alloc): Cast void ptrs to char * in comparison.
+
+Wed Feb 21 04:35:02 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* gmp.h: Sort mpn declarations.
+	(mpn_gcdext): Add declaration.
+
+	* mpn/generic/divrem_1.c: New file.
+	* mpn/Makefile.in (divrem_1.o): New rule.
+	* configure.in (functions): Add divrem_1.
+
+	* mpn/generic/divmod.c: Delete file.
+	* mpn/configure.in (functions): Delete divmod.
+	* Makefile.in (divmod.o): Delete rule.
+	* gmp.h (mpn_divmod): New #define.
+
+	* gmp.h (mpn_next_bit_set): Delete spurious declaration.
+
+	* mpn/generic/divrem.c (default case): In code assigning
+	most_significant_q_limb, move reassignment of n0 into if statement.
+
+	* gmp.h (mpf_inp_str): Fix typo.
+	(mpf_out_str): Make prototype match reality.
+	* mpf/inp_str.c: New file.
+	* mpf/out_str.c: New file.
+	* mpf/Makefile.in: Compile new files.
+
+	* mpn/Makefile.in (dump.o): Fix dependency path.
+	(inlines.o): Likewise.
+
+	* mpn/configure.in: Make m68060 be the same as m68000.  Clean up
+	m68k configs.
+
+Tue Feb 20 01:35:11 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/generic/sqrtrem.c: Renamed from sqrt.
+	* mpn/configure.in (functions): Corresponding change.
+	* mpn/Makefile.in: Likewise.
+	* mpz/sqrtrem.c: Likewise.
+	* mpz/sqrt.c: Likewise.
+	* mpn/generic/perfsqr.c: Likewise.
+
+	* Makefile.in (clean): Also remove libmp.a.
+	Don't compile cre-conv-tab.c or mp_bases.c.
+	cre-conv-tab.c: Delete file.
+	(gmp.ps): New rule.
+
+	* mpn/mp_bases.c: New file.
+	* mpn/Makefile.in: Compile mp_bases.c.
+
+	* mpz/set_str.c: Skip initial whitespace.
+	* mpf/set_str.c: Likewise.
+	* mpbsd/xtom.c: Likewise.
+
+	* gmp.h: Add missing mpz declarations.
+	Delete all formal parameter names from declarations.
+
+	* mpn/Makefile.in: Add dependencies for .c files.
+
+	* Makefile.in (check): Write recursive make calls separately, not as
+	a loop.
+	(FLAGS_TO_PASS): New variable.  Use it for most recursive makes.
+
+Mon Feb 19 01:02:20 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpn/Makefile.in (.S.o): Pipe cpp output to grep in order to delete
+	lines starting with #.
+	(CPP): Set to $(CC) -E to avoid gcc dependency.
+
+	* mpn/m68k/syntax.h (moveql): Define to moveq for MIT_SYNTAX.
+
+	* mpn/hppa/hppa1_1/pa7100/addmul_1.S: Fix typo in s1_ptr alignment
+	code.
+	* mpn/hppa/hppa1_1/pa7100/submul_1.S: Likewise.
+
+	* gmp.h: Fix typos in #defines of recently added mpn functions.
+
+	* mpz/inp_str.c: Skip all whitespace, not just plain space.
+	* mpbsd/min.c: Likewise.
+
+	* mpn/configure.in (functions): Add gcdext.
+	* mpn/generic/gcdext.c: New file.
+
+	* mpz/legendre.c: mpz_div_2exp => mpz_tdiv_q_2exp.
+
+	* gmp.h: Surround mpn declarations with extern "C" { ... }.
+
+	* Makefile.in (check): New target.
+
+	* mpq/get_d.c: Update comments.  Use rsize instead of dsize + N_QLIMBS
+	when possible.  Add special case for nsize == 0.
+
+	* gmp.h (mpq_get_d): Add declaration.
+	(mpq_canonicalize): Likewise.
+	(mpq_cmp_ui): Likewise.
+	(mpf_diff): Likewise.
+	(mpf_ui_sub): Likewise.
+	(mpf_set_prec): Likewise.
+	(mpf_random2): Likewise.
+
+	* gmp.h (mpz_cmp_ui): New #define.
+	(mpz_cmp_si): New #define.
+	(mpq_cmp_ui): New #define.
+	(mpz_sign): New #define.
+	(mpq_sign): New #define.
+	(mpf_sign): New #define.
+	(mpq_numref): New #define.
+	(mpq_denref): New #define.
+
+	* mpq/set_z.c: File deleted.
+	* mpq/Makefile.in: Corresponding changes.
+
+Sun Feb 18 01:34:47 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpbsd/sdiv.c: Use _mp_realloc, not _mpz_realloc.
+
+	* mpz/inp_binary.c: Default stream to stdin.
+	* mpz/inp_str.c: Likewise.
+	* mpz/inp_raw.c: Likewise.
+	* mpz/out_binary.c: Default stream to stdout.
+	* mpz/out_raw.c: Likewise.
+	* mpz/out_str.c: Likewise.
+
+	* mpbsd/realloc.c: New file.
+	* mpbsd/Makefile.in: Corresponding changes.
+
+	* mpbsd/min.c: Rewrite (base on mpz/inp_str.c).
+	* mpbsd/mtox.c: Rewrite (base on mpz/get_str.c).
+
+	* mpbsd/mout.c: Rewrite (base on mpz/out_str) but make it output
+	spaces in each 10th position.
+	* mpbsd/xtom.c: Rewrite (base on mpz/set_str).
+
+	* mpq/tests/Makefile.in (st-cmp): New file.
+	* mpq/tests/configure.in (srcname): New file.
+
+	* mpz/tests/configure.in (srcname): Fix typo.
+
+	* mpq/cmp.c: Add check using number of significant bits, to avoid
+	general multiplication.
+
+Sat Feb 17 11:58:30 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpq/cmp_ui.c: Store cy_limb after the mpn_mul_1 calls.
+
+	* mpq/tests: New directory.
+	* mpq/tests/t-cmp.c: New file.
+	* mpq/tests/t-cmp_ui.c: New file.
+
+	* mpz/tests/dive.c (main): Generate zero numerator.
+	(get_random_size) : Delete.
+
+	* mpz/divexact.c: Add special case for 0/x.
+
+	* gmp.h (mpz_mod): Add declaration.
+
+Fri Feb 16 18:18:39 1996  Andreas Schwab  <schwab@informatik.uni-dortmund.de>
+
+	* mpn/m68k/*: Rewrite code not to use the INSN macros.
+	(L): New macro to properly prefix local labels for ELF.
+
+Fri Feb 16 00:20:56 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* gmp-impl.h (ieee_double_extract): Use plain `unsigned int' for
+	fields.
+	* mpn/generic/inlines.c (_FORCE_INLINES): New #define.  Delete
+	conditional __GNUC__.
+	* gmp.h (mpn_add, mpn_sub, mpn_add_1, mpn_sub_1):
+	Only define these if __GNUC__ || _FORCE_INLINES.
+	* mpf/random2.c: Add missing parameter in non-ANSI header.
+	* mpn/generic/gcd.c (SIGN_BIT): Do as #define to work around bug
+	in AIX compilers.
+	* mpq/get_d.c: #define N_QLIMBS.
+	* mpz/divexact.c: Obscure division by 0 to silent compiler warnings.
+	* stack-alloc.c: Cast void* pointer to char* before doing arithmetic
+	on it.
+
+	* Makefile.in (mpbsd/libmpbsd.a): New rule.
+	* configure.in (configdirs): Add mpbsd.
+
+	* gmp.h: Add declarations for a few missing mpn functions.
+
+	* Makefile.in (libmp.a): New rule.
+
+	* mpbsd/mdiv.c: #include "dmincl.c", not "mpz_dmincl.c"
+	* gmp.h: Move #define of __GNU_MP__ into the `#if __GNU_MP__' block.
+	* mp.h: Likewise.  Update typedefs from gmp.h.
+	* mpbsd/configure.in: New file.
+	* mpbsd/Makefile.in: New file.
+	* mpbsd/configure: Link to master configure.
+	* mpbsd/config.sub: Link to master config.sub.
+
+	* Makefile.in: Set RANLIB_TEST.
+	* (libgmp.a): Use it.
+	* (libgmp.a): Do ranlib before moving the libgmp.a to the build
+	directory.
+	* mp?/Makefile.in: Don't use or set RANLIB.
+
+Thu Feb 15 16:38:41 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/add_ui.c: MP_INT => mpz_t.
+	* mpz/cmp_ui.c: Likewise.
+	* mpz/fac_ui.c: Likewise.
+	* mpz/inp_binary.c: Likewise.
+	* mpz/inp_raw.c: Likewise.
+	* mpz/legendre.c: Likewise.
+	* mpz/jacobi.c: Likewise.
+	* mpz/out_binary.c: Likewise.
+	* mpz/out_raw.c: Likewise.
+	* mpz/random2.c: Likewise.
+	* mpz/random.c: Likewise.
+	* mpz/realloc.c: Likewise.
+
+	* mpz/legendre.c: __mpz_2factor(X) => mpz_scan1(X,0),
+	__mpz_odd_less1_2factor => mpz_scan1(X,1).
+	* mpz/ntsup.c: File deleted.
+	* mpz/Makefile.in: Corresponding changes.
+
+	* mpz/pprime_p: Use mpz_scan1 to avoid looping.
+
+	* mpz/fac_ui.c: Type of `k' and `p' is `unsigned long'.
+	* mpz/pprime_p.c: Pass long to *_ui functions.
+	* mpz/gcdext.c: Likewise.
+	* mpz/fdiv_r_2exp.c: Likewise.
+	* mpz/fac_ui.c: Likewise.
+
+	* mpz/powm.c: Don't use mpn_rshift when mod_shift_cnt is 0.
+
+	* mpz/tests/Makefile.in (st-sqrtrem): Fix typo.
+
+	* mpz/cmp_ui.c: #undef mpz_cmp_ui.
+	* mpz/cmp_si.c: #undef mpz_cmp_si.
+	* gmp.h (mpz_cmp_ui): New #define.
+	(mpz_cmp_si): New #define.
+
+Wed Feb 14 22:11:24 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* gmp.h: Test __cplusplus in addition to __STDC__.
+	* gmp-impl.h: Likewise.
+
+	* gmp.h: Surround declarations with extern "C" { ... }.
+
+Tue Feb 13 15:20:45 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/fdiv_r_2exp.c: Use MPN_NORMALIZE.
+	* mpz/tdiv_r_2exp.c: Likewise.
+
+	* mpz/fdiv_r_2exp.c: New file.
+	* mpz/fdiv_q_2exp.c: New file.
+	* mpz/tdiv_r_2exp.c: Renamed from mpz/mod_2exp.c.
+	* mpz/tdiv_q_2exp.c: Renamed from mpz/div_2exp.c
+	* mpz/Makefile.in: Corresponding changes.
+
+	* mpz/scan0.c,scan1.c: New files.
+	* mpz/Makefile.in: Compile them.
+
+	* gmp.h (mpn_normal_size): Delete.
+
+	* config.guess: Update from Cygnus version.
+
+	* mpn/m68k/rshift.S: Use INSN2 macro for lea instructions.
+	* mpn/m68k/lshift.S: Likewise.
+
+	* mpn/configure.in: Fix configuration for plain 68000.
+
+Mon Feb 12 01:06:06 1996  Torbjorn Granlund  <tege@matematik.su.se>
+
+	* mpz/tests/t-powm.c: Generate negative BASE operand.
+
+	* mpz/powm.c: Make result always positive.
+
+Sun Feb 11 01:44:56 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/tests/*.c: Add t- prefix.
+	* mpz/tests/Makefile.in: Corresponding changes.
+	* mpz/tests/configure.in: Update srctrigger.
+
+	* mpz/tests/gcd.c: Generate negative operands.
+	* mpz/tests/gcd2.c: Likewise.
+
+	* mpz/gcdext.c: At end, if G is negative, negate all G, S, and T.
+
+Thu Feb  8 17:16:12 UTC 1996 Ken Weber <kweber@mat.ufrgs.br>
+
+	* mp{z,n}/gcd.c: Change mpn_gcd interface.
+	* gmp.h: Ditto.
+	* gmp.texi: update documentation.
+
+Mon Feb  7 23:58:43 1996  Andreas Schwab  <schwab@informatik.uni-dortmund.de>
+
+	* mpn/m68k/{lshift,rshift}.S: New files.
+	* mpn/m68k/syntax.h: New ELF_SYNTAX macros.
+	(MEM_INDX, R, PROLOG, EPILOG): New macros.
+	* mpn/m68k/*.S: Use R macro with register name.  Use PROLOG and EPILOG
+	macros.  Rename `size' to `s_size' or s1_size to avoid clash with ELF
+	.size directive.
+	* mpn/configure.in: New target m68k-*-linux*.
+
+Wed Feb  7 07:41:31 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* Makefile.in (cre-conv-tab): Workaround for SunOS make.
+
+	* mpz/tests/reuse.c: New file.
+	* mpz/tests/Makefile.in: Handle reuse.c.
+
+Tue Feb  6 11:56:24 UTC 1996 Ken Weber <kweber@mat.ufrgs.br>
+
+	* mpz/gcd.c: Fix g->size when one op is 0 and g == other op.
+
+Tue Feb  6 01:36:39 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp.h (mpz_divexact): Delete parameter names.
+	(mpz_lcm): Delete spurious declaration.
+
+	* mpz/dmincl.c: Fix typo.
+
+Mon Feb  5 01:11:56 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/gcd.c (gcd_2): Declare consistently.
+
+	* mpz/tdiv_q.c: Optimize division by a single-limb divisor.
+	* mpz/dmincl.c: Likewise.
+
+	* mpz/add.c: Use MPN_NORMALIZE instead of mpn_normal_size.
+	* mpz/sub.c: Likewise.
+	* mpn/generic/sqrt.c: Likewise.
+
+	* mpn/tests/{add_n,sub_n,lshift,rshift}.c: Put garbage in the
+	destination arrays.
+
+Fri Feb  2 02:21:27 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/{jacobi.c,legendre.c,ntsup.c,invert.c}: New files.
+	* mpz/Makefile.in: Compile them.
+
+	* mpn/Makefile.in (INCLUDES): Don't search in `generic'.
+
+Thu Feb  1 02:15:11 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	Change from Ken Weber:
+	* mpz/divexact.c: Make it work when quot is identical to either input.
+
+	* mpf/ui_sub.c: New file.
+	* mpf/Makefile.in: Compile it.
+
+	* gmp-impl.h (MPZ_TMP_INIT): alloca -> TMP_ALLOC.
+	* mpz/{c,f}div_{q,qr,r}.c: Use TMP_DECL/TMP_MARK/TMP_FREE since
+	these use MPZ_TMP_INIT.
+	* mpz/mod.c: Likewise.
+	* mpq/{add,sub}.c: Likewise.
+	* mpq/canonicalize: Likewise.
+
+	* mpq/{add,sub,mul,div}.c: Use mpz_divexact. MP_INT -> mpz_t.
+	* mpq/canonicalize.c: Likewise.
+
+Wed Jan 31 01:45:00 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/gcd.c: Misc changes from Ken.
+
+	* mpz/tests/gcd2.c: New file.
+	* mpz/tests/Makefile.in: Handle gcd2.c.
+
+	* mpn/generic/gcd.c (mpn_gcd): When GCD == ORIG_V, return vsize,
+	not orig_vsize.  Fix parameter declaration.
+
+	* mpz/mod_ui.c: Delete file.
+	* mpz/Makefile.in: Don't try to compile mod_ui.
+
+	* mpz/cdiv_*_ui.c): Make them work right.
+	* gmp.h: Declare cdiv*.
+
+Tue Jan 30 02:22:56 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/{cdiv_q.c,cdiv_q_ui.c,cdiv_qr.c,cdiv_qr_ui.c,cdiv_r.c,
+	cdiv_r_ui.c,cdiv_ui.c}: New files.
+	* mpz/Makefile.in: Compile them.
+
+	* All files: Make file permissions right.
+
+	Changes from Ken Weber:
+	* mpn/generic/accelgcd.c: Delete.
+	* mpn/generic/bingcd.c: Delete.
+	* mpn/generic/numbits.c: Delete.
+	* mpn/generic/gcd.c: New file.
+	* mpn/configure.in (functions): Update accordingly.
+	* mpz/divexact.c: New file.
+	* mpz/Makefile.in: Compile divexact.c.
+	* mpz/gcd.c: Rewrite to accommodate for gcd changes in mpn.
+	* gmp.h: declare new functions, delete obsolete declarations.
+	* mpz/tests/dive.c: New file.
+	* mpz/tests/Makefile.in: Handle dive.c.
+
+Mon Jan 29 03:53:24 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/random.c: Handle negative SIZE parameter.
+
+	* mpz/tests/tdiv(_ui).c: New name for tst-dm(_ui).c.
+	* mpz/tests/tst-mdm(_ui).c: Delete.
+	* mpz/tests/fdiv(_ui).c: New test based in tst-mdm(_ui).
+	* mpz/tests/*.c: Get rid of tst- prefix for DOS 8+3 naming.
+	* mpz/tests/Makefile.in: Corresponding changes.
+	* mpz/tests/configure.in: Update srctrigger.
+
+	* mpn/generic/divmod.c: Update from divrem.
+	* mpn/generic/divrem.c: Misc cleanups.
+
+Sun Jan 28 03:25:08 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* All files: Use new TMP_ALLOC interface.
+
+	* mpz/powm_ui.c: Make Jan 25 changes to powm.c also here.
+
+	* mpz/tests/powm_ui.c: New file.
+	* mpz/tests/Makefile.in: Add rules for tst-powm and tst-powm_ui.
+
+	* Makefile.in: Update dependency list.
+	* mpf/Makefile.in: Likewise.
+	* mpz/Makefile.in: Likewise.
+	* mpq/Makefile.in: Likewise.
+	* Makefile.in: Set RANLIB simply to ranlib, and allow configure
+	to override it.
+
+	* mpz/Makefile.in (conf): Delete spurious target.
+	(mp_bases.c): Delete.
+	(cre-conv-tab rules): Delete.
+
+	* Makefile.in (cre-conv-tab): Greatly simplify.
+
+Sat Jan 27 13:38:15 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* stack-alloc.c: New file.
+	* stack-alloc.h: New file.
+
+	* gmp.h (__gmp_inline): Define using __inline__.
+
+Thu Jan 25 00:28:37 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/generic/scan0.c: New file.
+	* mpn/generic/scan1.c: Renamed from next_bit.c.
+	* mpn/configure.in (functions): Include scan0 and scan1.
+
+	* mpn/m68k/*: #include sysdep.h.  Use C_GLOBAL_NAME.
+
+	* configure: Update from Cygnus version.
+	* config.guess: Likewise.
+	* config.sub: Likewise.
+	* configure: Pass --nfp to recursive configures.
+
+	* mpz/tests/tst-*.c: Adjust SIZE and reps.
+
+	* mpz/powm.c: Move esize==0 test earlier.
+	In final reduction of rp,rsize, don't call mpn_divmod unless
+	reduction is really needed.
+
+	* mpz/tests/tst-powm.c: Fix thinko in checking code.
+
+	* All files: Get rid of `__' prefix from mpn_* calls and declarations.
+	* gmp.h: #define __MPN.
+	* gmp.h: Use __MPN in #defines for mpn calls.
+
+	* mpn/generic/mul_n.c: Prepend `i' to internal routines.
+	* gmp-impl.h: Add #defines using __MPN for those internal routines.
+
+	* mpn/generic/sqrt.c: Change call to mpn_mul to mpn_mul_n.
+
+Wed Jan 24 13:28:19 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/sparc32/udiv_fp.S: New name for udiv_qrnnd.S.
+	* mpn/sparc32/udiv_nfp.S: New name for v8/udiv_qrnnd.S.
+	* mpn/sparc32/v8/supersparc: New directory.
+	* mpn/sparc32/v8/supersparc/udiv.S: New file.
+
+Tue Jan 23 01:10:11 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	This major contribution is from Ken Weber:
+	* mpn/generic/accelgcd.c: New file.
+	* mpn/generic/bdivmod.c: New file.
+	* mpn/generic/bingcd.c: New file.
+	* mpn/generic/gcd_1.c: Rewrite.
+	* mpn/generic/numbits.c: New file (to go away soon).
+	* mpz/gcd.c: Rewrite.
+	* mpz/tests/tst-gcd.c (SIZE): Now 128.
+	* gmp.h: Declare new functions.
+	* mpn/configure.in (functions): List new files.
+	* gmp-impl.h (MPN_SWAP): Delete.
+	(MPN_LESS_BITS_LIMB, MPN_LESS_BITS, MPN_MORE_BITS): Delete.
+	(MPN_COMPL_INCR, MPN_COMPL): Delete.
+
+Mon Jan 22 02:04:59 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp.h (mpn_name): New #define.
+
+	* mpn/m88k/mc88110/addmul_1.s: New file.
+	* mpn/m88k/mc88110/add_n.S: New file.
+	* mpn/m88k/mc88110/sub_n.S: New file.
+
+	* mpn/m88k/sub_n.s: Correctly initialize carry.
+
+	* mpn/sparc32/{add_n.S,sub_n.S,lshift.S,rshift.S): `beq' => `be'.
+
+Sun Jan 21 00:04:35 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/sparc64/addmul_1.s: New file.
+	* mpn/sparc64/submul_1.s: New file.
+	* mpn/sparc64/rshift.s: New file.
+
+Sat Jan 20 00:32:54 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpz/iset.c: Fix typo introduced Dec 25.
+
+Wed Jan 17 13:16:44 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* config/mt-sprc8-gcc: New name for mt-sparc8-gcc.
+	* config/mt-sparcv8-gcc: Delete.
+	* configure.in: Corresponding changes.
+
+Tue Jan 16 16:31:01 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp-impl.h: #include alloca.h when necessary.
+
+	* longlong.h: Test __alpha instead of __alpha__, since the former
+	is the standard symbol.
+
+Mon Jan 15 18:06:57 1996  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/sparc64/mul_1.s: Swap operands of mulx instructions.
+	* mpn/sparc64/lshift.s: New file.
+
+Fri Dec 29 17:34:03 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/x86/pentium/add_n.S: Get rid of #defines for register names.
+	* mpn/x86/pentium/sub_n.S: Likewise.
+
+Thu Dec 28 03:16:57 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/x86/pentium/mul_1.S: Rework loop to avoid AGI between update
+	of loop induction variable and load insn at beginning of loop.
+	* mpn/x86/pentium/addmul_1.S: Likewise.
+	* mpn/x86/pentium/submul_1.S: Likewise.
+
+Mon Dec 25 23:22:55 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* All files: Prefix user-visible structure fields with _mp_.
+
+Fri Dec 22 20:42:17 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/configure.in (m68k configs): Terminate path variable with
+	plain "m68k".
+
+Fri Dec 22 03:29:33 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/sparc32/add_n.S: Update from sub_n.S to fix bugs, and to
+	clean things up.
+
+	* mpn/configure.in (m68k configs): Update #include path for new
+	mpn directory organization.
+
+Tue Dec 12 02:53:02 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* gmp.h: Prefix all structure field with _mp_.
+	* gmp-impl.h: Define access macros for these fields.
+
+Sun Dec 10 00:47:17 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/alpha/addmul_1.s: Prefix labels with `.'.
+	* mpn/alpha/submul_1.s: Likewise.
+	* mpn/alpha/[lr]shift.s: Likewise.
+	* mpn/alpha/udiv_qrnnd.S: Likewise.
+	* mpn/alpha/ev5/[lr]shift.s: Likewise.
+
+	* mpn/alpha/ev5/lshift.s: Fix typos.
+
+Fri Dec  1 14:28:20 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/Makefile.in (.SUFFIXES): Define.
+
+Wed Nov 29 23:11:57 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/sparc64/{add_n.s, sub_n.s}: New files.
+
+Tue Nov 28 06:03:13 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/x86/syntax.h: Handle ELF_SYNTAX.
+	Rename GAS_SYNTAX => BSD_SYNTAX.
+
+	* mpn/configure.in: Handle linuxelf and SysV for x86 variants.
+
+Mon Nov 27 01:32:12 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/hppa/hppa1_1/pa7100/submul_1.S: New file.
+
+Sun Nov 26 04:30:47 1995  Torbjorn Granlund  <tege@noisy.matematik.su.se>
+
+	* mpn/hppa/hppa1_1/pa7100/addmul_1.S: New file.
+
+	* mpn/sparc32/add_n.S: Rewrite to use 64 bit loads/stores.
+	* mpn/sparc32/sub_n.S: Likewise.
+
+Fri Nov 17 00:18:46 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/configure.in: Handle m68k on NextStep.
+
+Thu Nov 16 02:30:26 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn: Reorganize machine-specific directories.
+	* mpn/configure.in: Corresponding changes.
+	(sh, sh2): Handle these.
+	(m68k targets): Create asm-syntax.h.
+
+Thu Nov  9 02:20:50 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/generic/mul_n.c (____mpn_sqr_n): Delete code that calls abort.
+	(____mpn_mul_n): Likewise.
+
+Tue Nov  7 03:25:12 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpf/get_str.c: In exponentiation code (two places), don't swap
+	input and output areas when calling mpn_mul_1.
+	* mpf/set_str.c: Likewise.
+
+Fri Nov  3 02:35:58 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpf/Makefile.in: Make sure all objects are listed in dependency list;
+	delete spurious entries.
+
+	* mpf/mul.c: Handle U or V being 0.  Allow prec+1 for result precision.
+
+	* mpf/set_prec.c: New computation of limb precision.
+	* mpf/set_dfl_prec.c: Likewise.
+
+	* mpf/random2.c: Fix typo computing exp.
+	* mpf/get_str.c: In (uexp > usize) case, set n_limbs as a function of
+	the user-requested number of digits, n_digits.
+
+Thu Nov  2 16:25:07 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/generic/divrem.c (case 2): Don't move np vector back, it is
+	never read.
+	(default case): Put most significant limb from np in new variable n2;
+	decrease size argument for MPN_COPY_DECR; use n2 instead of np[dsize].
+
+Wed Nov  1 02:59:53 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/sparc/[lr]shift.S: New files.
+
+Tue Oct 31 00:08:12 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpz/gcd_ui.c: Set w->size unconditionally when v is zero.
+
+	* gmp-impl.h (assert): Delete definition.
+
+	* mpf/sub.c: Delete all assert calls.  Delete variable `cy'.
+
+	* mpf/neg.c: Use prec+1 as precision.  Optimize for when arguments
+	are the same.
+	* mpf/abs.c: Likewise.
+	* mpf/{set,neg,abs}.c: Make structure and variable names similar.
+
+Mon Oct 30 12:45:26 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpf/random2.c (random): Test __SVR4 in addition to __svr4__.
+	* mpn/generic/random2.c (random): Likewise.
+
+Sun Oct 29 01:54:28 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpf/div.c: Special handle U or V being 0.
+
+	* mpf/random2.c: New file.
+
+	* longlong.h (i860 rshift_rhlc): Define.
+	(i960 udiv_qrnnd): Define.
+	(i960 count_leading_zeros): Define.
+	(i960 add_ssaaaa): Define.
+	(i960 sub_ddmmss): Define.
+	(i960 rshift_rhlc): Define.
+
+Sat Oct 28 19:09:15 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/pentium/rshift.S: Fix and generalize condition for when to use
+	special code for shift by 1.
+	* mpn/pentium/lshift.S: Likewise.
+
+Thu Oct 26 00:02:56 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* gmp.h: #undef __need_size_t.
+	* mp.h: Update from gmp.h.
+
+Wed Oct 25 00:17:27 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpf/Makefile.in: Compile set_prec.c.
+	* mpf/realloc.c: Delete this file.
+	* mpf/Makefile.in: Delete mentions of realloc.c.
+
+	* gmp.h (__mpf_struct): Get rid of `alloc' field.
+	* mpf/clear.c: Likewise.
+	* mpf/init*.c: Likewise.
+	* mpf/set_prec.c: Likewise.
+	* mpf/iset*.c: Likewise.
+
+	* mpf/iset_str.c: New file.
+
+	* mpn/configure.in: Handle pyramid.
+
+	* mpf/set.c: Use prec+1 as precision.
+
+	* mpf/set_prec.c: New file.
+
+Tue Oct 24 00:56:41 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/generic/divrem.c: New file.  Will replace mpn/generic/divmod.c
+	when rest of source is converted.
+	* mpn/configure.in (functions): Add `divrem'
+	* mpn/generic/set_str.c: Never call __mpn_mul_1 with zero size.
+
+	* mpf/get_str.c: Completely rewritten.
+	* mpf/add.c: Fix several problems.
+	* mpf/sub.c: Compare operands from most significant end until
+	first difference, exclude skipped limbs from computation.
+	Accordingly simplify normalization code.
+	* mpf/set_str.c: Fix several problems.
+	* mpf/dump.c: New file.
+	* mpf/Makefile.in: Compile dump.c.
+	* mpf/init2.c: Set prec field correctly.
+
+Sun Oct 22 03:02:09 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* cre-conv-tab.c: #include math.h; don't declare log and floor.
+
+Sat Oct 21 23:04:10 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpf/mul_ui.c: Handle U being 0.
+
+Wed Oct 18 19:39:27 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/generic/set_str.c: Correctly handle input like "000000000000".
+	Misc cleanups.
+
+Tue Oct 17 15:14:13 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* longlong.h: Define COUNT_LEADING_ZEROS_0 for machines where
+	appropriate.
+
+Mon Oct 16 19:14:43 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpf/add.c: Rewrite.
+	* mpf/set_str.c: New file.  Needs more work.
+
+Sat Oct 14 00:14:04 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpf/div_2exp.c: Vastly simplify.
+	* mpf/mul_2exp.c: Likewise.
+
+	* mpf/sub.c: Rewrite.
+
+	* gmp-impl.h (udiv_qrnnd_preinv2gen): Terminate comment.
+
+	* mpf/dump.c: Free allocated memory.
+
+	* gmp-impl.h (assert): Define.
+
+Wed Oct 11 13:31:00 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/pentium/rshift.S: Install new code to optimize shift-by-1.
+
+Tue Oct 10 00:37:21 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/pentium/lshift.S: Install new code to optimize shift-by-1.
+
+	* mpn/powerpc32/{lshift.s,rshift.s}: New files.
+
+	* configure.in: Fix typo.
+
+Sat Oct  7 08:17:09 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* longlong.h (smul_ppmm): Correct type of __m0 and __m1.
+
+Wed Oct  4 16:31:28 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/configure.in: Handle alphaev5.
+	* mpn/ev4: New name for alpha subdir.
+	* mpn/ev5: New subdir.
+	* mpn/ev5/lshift.s: New file.
+
+Tue Oct  3 15:06:45 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/alpha/mul_1.s: Avoid static increments of pointers; use
+	corresponding offsets in ldq and stq instructions instead.
+	(Loop): Swap cmpult and stq to save one cycle on EV5.
+
+	* mpn/tests/{add_n.s,sub_n.s,lshift.s,rshift.s,mul_1.s,addmul_1.s,
+	submul_1.s}: Don't check results if NOCHECK is defined.
+
+Mon Oct  2 11:40:18 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* longlong.h (mips umul_ppmm [32 and 64 bit versions]):
+	Make new variants, based on GCC version number, that use `l' and `h'
+	constraints instead of explicit mflo and mfhi instructions
+
+Sun Oct  1 00:17:47 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/mc88100/add_n.s: Decrease unrolling factor from 16 to 8.
+	* mpn/mc88100/sub_n.s: Likewise.
+
+	* config/mt-m88110: New file.
+	* configure.in: Use it.
+
+	* mpn/mc88110/mul_1.s: Fix thinko.
+
+Sat Sep 30 21:28:19 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpz/set_d.c: Declare `size' at function start.
+
+	* experimental: New directory for mpx and mpz2.
+
+	* mpz/tdiv_q.c: Clarify comments.
+	* mpz/{mod.c,mod_ui.c}: New file, for math mod function.
+
+	* mpn/sh2/{mul_1.s,addmul_1.s,submul_1.s}: New files.
+
+	* mpn/sh/{add_n.s,sub_n.s}: New files.
+
+	* mpn/pyr/{add_n.s,sub_n.s,mul_1.s,addmul_1.s}: New files.
+
+	* mpn/i960/{add_n.s,sub_n.s}: New files.
+
+	* mpn/alpha/addmul_1.s (Loop): Move decrement of r18 to before umulh,
+	to save cycles on EV5.
+	* mpn/alpha/submul_1.s: Ditto.
+	* mpn/alpha/mul_1.s: Ditto.
+
+Thu Sep 28 02:48:59 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* gmp.h (mp_limb, mp_limb_signed): Define as `long long' if
+	_LONG_LONG_LIMB is defined.
+
+	* longlong.h (m88110): Test __m88110__, not __mc88110__
+
+	* mpn/mc88110/mul_1.s: Rewrite.
+
+Tue Sep 26 23:29:05 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* config.sub: Update from current Cygnus version.
+
+	* mpn/configure.in: Recognize canonical m88*, not mc88*.
+
+Fri Sep 22 14:58:05 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpz/set_d.c: New file.
+	* mpz/Makefile.in: Build new files.
+
+	* mpq/get_d.c: Replace usage of scalbn with ldexp.
+
+	* mpn/{vax,i386}/gmp-mparam.h: New files.
+	* gmp-impl.h (ieee_double_extract): Define here.
+	* mpf/set_d.c (ieee_double_extract): Not here.
+
+Thu Sep 21 00:56:36 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* longlong.h (C umul_ppmm): Use UWtype, not USItype for temps.
+	(udiv_qrnnd): For cases implemented with call to __udiv_qrnnd,
+	protect with new symbol LONGLONG_STANDALONE.
+	(68000 umul_ppmm): Use %# prefix for immediate constants.
+
+Wed Sep 20 15:36:23 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/generic/divmod_1.c: Handle
+	divisor_limb == 1 << (BITS_PER_MP_LIMB - 1)
+	specifically also when normalization_steps != 0.
+
+Mon Sep 18 15:42:30 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpq/get_d.c: New file.
+
+Sun Sep 17 02:04:36 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* longlong.h (pyr): Botch up for now.
+
+Sat Sep 16 00:11:50 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/clipper/mul_1.s: New file.
+	* mpn/clipper/add_n.s: New file.
+	* mpn/clipper/sub_n.s: New file.
+	* mpn/configure.in: Handle clipper*-*-*.
+
+	* mpn/configure.in: Recognize rs6000-*-*.
+
+Fri Sep 15 00:41:34 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/alpha/add_n.s: New file.
+	* mpn/alpha/sub_n.s: New file.
+
+	* mpn/mips3: New name for mpn/r4000.
+	* mpn/mips2: New name for mpn/r3000.
+	* mpn/configure.in: Corresponding changes.
+
+	* mpn/generic/perfsqr.c (primes): Delete.
+	(residue_map): Delete.
+
+Thu Sep 14 00:07:58 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/r3000/sub_n.s: Fix typo.
+
+	* dm_trunc.c: Delete spurious file.
+
+	* mpz/out_binary.c: Fix typo.
+
+	* mpn/configure.in (per-target): Make mips*-*-irix6* imply r4000.
+
+	* gmp-impl.h: For sparc and sgi, include alloca.h.
+
+	* mpn/z8000/mul_1.s: Replace `test r' with `and r,r'.  Replace
+	`ldk r,#0' with `xor r,r'.
+
+Wed Sep  6 00:58:38 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpz/inp_binary.c: New file.
+	* mpz/out_binary.c: New file.
+	* mpz/Makefile.in: Build new files.
+
+Tue Sep  5 22:53:51 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* gmp.h (__mpz_struct): Change `long int' => `mp_size_t' for alloc
+	and size fields.
+
+Sat Sep  2 17:47:59 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/r4000/{add_n.s,sub_n.s}: Optimize away some pointer arithmetic.
+	* mpn/r3000/{add_n.s,sub_n.s,lshift.s,rshift.s}: New files,
+	derived from r4000 code.
+
+Fri Sep  1 05:35:52 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/r3000/mul_1.s: Fix typo.
+
+	* mpn/powerpc32: Fix some old vs new mnemonic issues.
+
+	* mpn/powerpc32/{add_n.s,sub_n.s}: New files.
+	* mpn/r4000/{add_n.s,sub_n.s,lshift.s,rshift.s}: New files.
+
+Wed Aug 30 10:43:47 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/r3000/mul_1.s ($LC1): Use addiu for immediate add.
+	* mpn/r4000/{mul_1.s,addmul_1.s,submul_1.s}: New files.
+
+	* config.guess: Update to latest FSF revision.
+
+Mon Aug 28 02:18:13 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpz/out_str.c: Cast str to char * in fputs call.
+
+	* gmp-impl.h: Define UQItype, SItype, and USItype also
+	when not __GNUC__.
+
+Fri Aug 25 01:45:04 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/i386/syntax.h: Renamed from asm-syntax.h.
+	* mpn/mc68020/syntax.h: Renamed from asm-syntax.h.
+	* mpn/configure.in: Corresponding changes.
+
+Sun Aug 13 19:20:04 1995  Torbjorn Granlund  <tege@bozo.matematik.su.se>
+
+	* mpn/generic/random2.c: Test __hpux, not hpux.
+
+Sat Apr 15 20:50:33 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/sparc/add_n.S: Make it work for PIC.
+	* mpn/sparc/sub_n.s: Likewise.
+	* mpn/sparc8/addmul_1.S: Likewise.
+	* mpn/sparc8/mul_1.S: Likewise.
+	* mpn/i386/add_n.S: Likewise.
+	* mpn/i386/sub_n.S: Likewise.
+
+Thu Apr 13 23:15:03 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/configure.in: Don't search power subdir for generic ppc configs.
+	Add some ppc cpu-specific configs.  Misc clean up.
+
+Mon Apr 10 00:16:35 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpz/ui_pow_ui.c: Delete spurious code to handle negative results.
+
+Sun Apr  9 12:38:11 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* longlong.h (SPARC v8 udiv_qrnnd): Generate remainder in C,
+	not in asm.
+
+	* mpn/generic/sqrt.c (SQRT): Test for __SOFT_FLOAT.
+
+Tue Mar 28 00:19:52 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/generic/hamdist.c (popc_limb): Make Mar 16 change here too.
+
+Fri Mar 17 23:29:22 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* longlong.h (SH umul_ppmm): Define.
+
+Thu Mar 16 16:40:44 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/generic/popcount.c (popc_limb): Rearrange 32 bit case
+	to help CSE.
+
+Fri Mar 10 20:03:49 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/powerpc32/mul_1.s: Clear cy before entering loop.
+	Rearrange loop to save a cycle.
+	* mpn/powerpc32/addmul_1.s: New file.
+	* mpn/powerpc32/submul_1.s: New file.
+
+Fri Feb 17 22:44:45 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/configure.in: Set target_makefile_frag for freebsd
+	in new case stmt.
+	* mpn/config/t-freebsd: New file.
+	* mpn/Makefile.in: Add #### for frag insertion.
+	(XCFLAGS): Clear by default.
+	(.c.o, .S.o rules): Pass XCFLAGS.
+
+Tue Feb  7 16:27:50 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* longlong.h (68000 umul_ppmm): Merge improvements from henderson.
+
+Tue Jan 24 04:23:20 1995  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* longlong.h (default umul_ppmm): Store input parameters in temporaries
+	to avoid reading them twice.
+	(default smul_ppmm): New definition.
+
+Thu Dec 29 04:20:07 1994  Jim Meyering  (meyering@comco.com)
+
+	* generic/perfsqr.c (__mpn_perfect_square_p): Remove declaration
+	of unused variable.
+	* generic/pre_mod_1.c (__mpn_preinv_mod_1): Likewise.
+	* mpz/powm.c (pow): Likewise.
+
+	* mpz/and.c (mpz_and): Use {} instead of `;' for empty else clause
+	to placate `gcc -Wall'.
+	* mpz/ior.c (mpz_ior): Likewise.
+
+Wed Dec 28 13:31:40 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/m*68*/*.S: #include asm-syntax.h, not asm.h.
+
+Mon Dec 26 17:15:36 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* longlong.h: Test for more symbols, in __mc68000__ case.
+
+	* mpn/mpn/config.sub: Recognize m68060.
+	* mpn/configure.in: Change mc* to m* for 68k targets.
+	* mpn/Makefile.in (.S.o): Delete spurious creation of temp .c file.
+
+Mon Dec 19 01:56:30 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* config.sub: Recognize pentium as a valid CPU.
+	* mpn/configure.in: Handle pentium specifically, to use new assembly
+	code.
+
+Mon Dec 19 00:13:01 1994  Jim Meyering  (meyering@comco.com)
+
+	* gmp.h: Define _GMP_H_HAVE_FILE if FILE, __STDIO_H__, or H_STDIO
+	is defined.
+	* gmp.h: test _GMP_H_HAVE_FILE instead of FILE everywhere else.
+
+Mon Dec 19 00:04:54 1994  Kent Boortz  (boortz@sics.se)
+
+	* Makefile.in (recursive makes): Pass CFLAGS.
+
+Sun Dec 18 22:34:49 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/pentium: New directory.
+
+	* mpz/pprime.c: Make sure to mpz_clear all temporaries.
+
+	* longlong.h: Don't use udiv instruction when SUPERSPARC is defined.
+	* configure.in: Handle supersparc*-.
+	* config/mt-supspc-gcc: New file.
+	* config/mt-sparc8-gcc: New name for mt-sparcv8-gcc.
+
+Mon Dec 12 22:22:10 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/i386/*.S: #include "asm-syntax.h", not "asm.h".
+	#include sysdep.h before asm-syntax.h.
+
+	* mpn/mc68020/asm-syntax.h: #undef ALIGN before defining it.
+	* mpn/i386/asm-syntax.h: Likewise.
+
+	* mpn/mc68020/asm-syntax.h: New name for asm.h.
+	* mpn/i386/asm-syntax.h: New name for asm.h.
+
+Tue Dec  6 21:55:25 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpz/array_init.c: Fix typo in declaration.
+
+Fri Nov 18 19:50:52 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/Makefile.in (.S.o): Pass CFLAGS and INCLUDES.
+
+Mon Nov 14 00:34:12 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/generic/random2.c (random): Test for __svr4__.
+
+Wed Oct 12 23:28:16 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* cre-conv-tab.c (main): Avoid upper-case X in printf format string.
+
+Tue Aug 23 17:16:35 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpz/perfsqr.c: Use mpn_perfect_square_p.
+	* mpn/generic/perfsqr.c: New file.
+
+Wed Jul  6 13:46:51 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpz/array_init.c: New file.
+	* mpz/Makefile.in: Compile array_init.
+	* gmp.h: Declare mpz_array_init.
+
+Mon Jul  4 01:10:03 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpz/add.c: Fix bogus comment.
+	* mpz/sub.c: Likewise.
+
+Sat Jul  2 02:14:56 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* mpn/generic/pre_mod_1.c: New file.
+	* mpz/perfsqr.c: Use __mpn_preinv_mod_1 when faster.
+
+Fri Jul 01 22:10:19 1994  Richard Earnshaw (rwe11@cl.cam.ac.uk)
+
+	* longlong.h (arm umul_ppmm): Fix typos in last change.  Mark
+	hard-coded registers with "%|"
+
+Thu Jun 30 03:59:33 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpz/perfsqr.c: Define PP, etc, for machines with 64 bit limbs.
+	Use __mpn_mod_1.
+	* mpz/perfsqr.c: Don't clobber REM in quadratic residue check loop.
+
+Wed Jun 29 18:45:41 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* mpn/generic/sqrt.c (SQRT): New asm for IBM POWER2.
+
+	* mpz/gcd_ui.c: Return 0 if result does not fit an unsigned long.
+
+	* gmp.h: Use "defined (__STDC__)" consistently.
+
+Tue Jun 28 18:44:58 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* gmp.h (mpz_get_si): Don't use "signed" keyword for return type.
+
+	* mpz/tests/Makefile.in: Use CFLAGS for linking.
+
+	* Makefile.in (CFLAGS): Use -O2 here.
+	* mpn/Makefile (CFLAGS): Not here.
+
+	* mpq/cmp_ui.c: Fix typo.
+	* mpq/canonicalize.c: Fix typo.
+	* mpz/gcd_ui.c: Handle gcd(0,v) and gcd(u,0) correctly.
+	* mpn/generic/gcd_1.c: Fix braino in last change.
+
+Mon Jun 27 16:10:27 1994  Torbjorn Granlund  (tege@rtl.cygnus.com)
+
+	* mpz/gcd_ui.c: Change return type and return result.
+	Allow destination param to be NULL.
+	* gmp.h: Corresponding change.
+	* mpn/generic/gcd_1.c: Handle zero return from mpn_mod_1.
+
+Tue Jun 14 02:17:43 1994  Torbjorn Granlund  (tege@tiny.cygnus.com)
+
+	* mpn/i386/asm.h (ALIGN): Make it take a parameter.
+	* mpn/i386/*.S: Use ALIGN to align all loops.
+
+	* mpn/i386/*.S: Move colon inside C_GLOBAL_NAME expression.
+	(Makes old versions of GAS happy.)
+
+Sat May 28 01:43:54 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* Many files: Delete unused variables and labels.
+	* mpn/generic/dump.c: cast printf width argument to int.
+
+Wed May 25 00:42:37 1994  Torbjorn Granlund  (tege@thepub.cygnus.com)
+
+	* mpz/gcd.c (mpz_gcd): Normalize after __mpn_sub calls.
+	(xmod): Ignore return value of __mpn_divmod.
+	(xmod): Improve normalization code.
+
+Sat May 21 01:30:09 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* mpz/gcdext.c: Cosmetic changes.
+
+	* mpz/fdiv_ui.c: New file.
+
+Fri May 20 00:24:53 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* mpz/tests/Makefile.in: Use explicit rules for running tests,
+	not a shell loop.
+	(clean): Delete stmp-*.
+
+	* mpz/Makefile.in: Update.
+
+	* mpz/div_ui.c: Don't include longlong.h.
+	* mpz/dm_ui.c: Likewise.
+
+	* mpz/fdiv_q.c, mpz/fdiv_q_ui.c, mpz/fdiv_qr.c, mpz/fdiv_qr_ui.c,
+	mpz/fdiv_r.c, mpz/fdiv_r_ui.c: New files.  Code partly from deleted
+	mdm.c, mdm_ui.c, etc, partly rewritten.
+	* mpz/dm_floor_ui.c, mpz/dm_floor.c: Delete.
+	* mpz/mdm.c, mpz/mdm_ui.c, mpz/mdiv.c, mpz/mdiv_ui.c, mpz/mmod.c,
+	mpz/mmod_ui.c: Delete.
+
+	* mpz/tdiv_q.c, mpz/tdiv_q_ui.c, mpz/tdiv_qr.c, mpz/tdiv_qr_ui.c,
+	mpz/tdiv_r.c, mpz/tdiv_r_ui.c:
+	New names for files implementing truncating division.
+	* mpz/div_ui.c, mpz/dm_ui.c, mpz/mod_ui.c: Simplify.
+
+	* mpn/Makefile.in (.S.o): Don't rely on CPP being defined, use CC
+	instead.
+	(clean): Delete tmp-*.
+
+Thu May 19 01:37:44 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* mpz/cmp.c: Call __mpn_cmp.
+
+	* mpz/popcount.c: Fix typo.
+
+	* mpz/powm_ui.c: Simplify main loop.  Keep principal operand size
+	smaller than MSIZE when possible.
+	* mpz/powm.c: Likewise.
+
+	* mpn/generic/sqrt.c: Move alloca calls into where the memory is
+	needed.  Simplify.
+
+	* gmp.h: (_PROTO): New macro.
+	Add many function declarations; use _PROTO macro in all declarations.
+
+	* mpf/*.c: Prepend mpn calls with __.
+
+Wed May 18 20:57:06 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* mpf/*ui*.c: Make ui argument `long' for consistency with mpz
+	functions.
+
+	* mpf/div_ui.c: Simplify.
+
+Tue May 17 01:05:14 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* mpz/*.c: Prepend mpn calls with __.
+
+	* mpz/mul_ui.c: Use mpn_mul_1.
+
+Mon May 16 17:19:41 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* mpn/i386/mul_1.S: Use C_GLOBAL_NAME.
+	* mpn/i386/mul_1.S, mpn/i386/addmul_1.S, mpn/i386/submul_1.S:
+	Nuke use of LAB.
+
+Sat May 14 14:21:02 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* gmp-impl.h: Don't define abort here.
+
+	* mpz/pow_ui.c: Increase temporary allocation.
+	* mpz/ui_pow_ui.c: Likewise.
+
+	* gmp.h (mpz_add_1, mpz_sub_1): Don't call memcpy.
+
+	* All Makefile.in: Delete spurious -I arguments.
+	Update dependencies.
+
+	* mpz/popcount.c: New file.
+	* mpz/hamdist.c: New file.
+
+	* All configure: Latest version from Cygnus.
+
+	* mpq/Makefile.in: New file.
+	* mpq/configure.in: New file.
+	* Makefile.in, configure.in: Enable compilation of mpq.
+
+	* mpq/set_z.c: Fix typos.
+	* mpq/canonicalize.c: Fix typos.
+	* mpq/cmp_ui.c: Fix typos.
+
+	* mpf/add_ui.c: Read U->D into UP always.  Delete spurious MPN_COPY.
+	* mpf/sub_ui.c: Likewise.
+
+	* gmp-impl.h: Don't redefine alloca.
+
+	* COPYING.LIB: Renamed from COPYING.
+
+Wed May 11 01:45:44 1994  Torbjorn Granlund  (tege@adder.cygnus.com)
+
+	* mpz/powm_ui.c: When shifting E left by C+1, handle out-of-range
+	shift counts.  Fix typo when testing negative_result.
+	* mpz/powm.c: Likewise.
+
+	* mpz/ui_pow_ui.c: New file.
+	* mpz/Makefile.in: Update.
+
+	* mpz/pow_ui.c: Call __mpn_mul_n instead of __mpn_mul when possible.
+
+	* mpz/div.c, mpz/div_ui.c, mpz/gcd.c: Prefix external mpn calls.
+	* mpz/gcd.c: Declare mpn_xmod.
+
+	* mpz/powm.c: Major changes to accommodate changed mpn semantics.
+	* mpz/powm_ui.c: Update from mpz/powm.c.
+
+	* mpz/tests/tst-io.c: New file.
+	* mpz/tests/tst-logic: New file.
+	* mpz/tests/Makefile.in: Update.
+
+	* mpz/inp_str.c: Get base right when checking for first digit.
+	* mpz/inp_str.c: Allocate more space for DEST when needed.
+
+	* mpz/com.c: Use mpn_add_1 and mpn_sub_1.
+	* mpz/and.c, mpz/ior.c: Likewise.  Simplify somewhat.
+
+	* mpz/add_ui.c: Use mpn_add_1 and mpn_sub_1.
+	Rename parameters to be consistent with mpz/sub_ui.
+	General simplifications.
+	* mpz/sub_ui.x: Likewise.
+
+Tue Aug 10 19:41:16 1993  Torbjorn Granlund  (tege@prudens.matematik.su.se)
+
+	* mpf: New directory.
+	* mpf/*.c: Merge basic set of mpf functions.
+
+	* Many logs missing...
+
+Sun Apr 25 18:40:26 1993  Torbjorn Granlund  (tege@pde.nada.kth.se)
+
+	* memory.c: Use #if instead of #ifdef for __STDC__ for consistency.
+	* bsd/xtom.c: Likewise.
+
+	* mpz/div.c: Remove free_me and free_me_size and their usage.
+	Use mpn_divmod for division; corresponding changes in return value
+	convention.
+	* mpz/powm.c: `carry_digit' => `carry_limb'.
+	* bsd/sdiv.c: Clearify comment.
+
+Sun Apr 25 00:31:28 1993  Torbjorn Granlund  (tege@pde.nada.kth.se)
+
+	* longlong.h (__udiv_qrnnd_c): Make all variables `unsigned long int'.
+
+Sat Apr 24 16:23:33 1993  Torbjorn Granlund  (tege@pde.nada.kth.se)
+
+	* longlong.h (__udiv_qrnnd_c): Make all variables `unsigned long int'.
+
+	* gmp-impl.h: #define ABS.
+	* (Many files): Use ABS instead of abs.
+
+	* mpn/generic/sqrt.c, mpz/clrbit.c, mpz/get_si.c, mpz/mod_2exp.c,
+	mpz/pow_ui.c: Cast 1 to mp_limb before shifting.
+
+	* mpz/perfsqr.c: Use #if, not plain if for exclusion of code for
+	non-32-bit machines.
+
+Tue Apr 20 13:13:58 1993  Torbjorn Granlund  (tege@du.nada.kth.se)
+
+	* mpn/generic/sqrt.c: Handle overflow for intermediate quotients by
+	rounding them down to fit.
+
+	* mpz/perfsqr.c (PP): Define in hexadecimal to avoid GCC warnings.
+
+	* mpz/inp_str.c (char_ok_for_base): New function.
+	(mpz_inp_str): Use it.
+
+Sun Mar 28 21:54:06 1993  Torbjorn Granlund  (tege@cyklop.nada.kth.se)
+
+	* mpz/inp_raw.c: Allocate x_index, not xsize limbs.
+
+Mon Mar 15 11:44:06 1993  Torbjorn Granlund  (tege@pde.nada.kth.se)
+
+	* mpz/pprime.c: Declare param `const'.
+	* gmp.h: Add declarations for mpz_com.
+
+Thu Feb 18 14:10:34 1993  Torbjorn Granlund  (tege@pde.nada.kth.se)
+
+	* mpq/add.c, mpq/sub.c: Call mpz_clear for t.
+
+Fri Feb 12 20:27:34 1993  Torbjorn Granlund  (tege@cyklop.nada.kth.se)
+
+	* mpz/inp_str.c: Recog minus sign as first character.
+
+Wed Feb  3 01:36:02 1993  Torbjorn Granlund  (tege@cyklop.nada.kth.se)
+
+	* mpz/iset.c: Handle 0 size.
+
+Tue Feb  2 13:03:33 1993  Torbjorn Granlund  (tege@cyklop.nada.kth.se)
+
+	* mpz/mod_ui.c: Initialize dividend_size before it's used.
+
+Mon Jan  4 09:11:15 1993  Torbjorn Granlund  (tege@sics.se)
+
+	* bsd/itom.c: Declare param explicitly 'signed'.
+	* bsd/sdiv.c: Likewise.
+
+	* mpq/cmp.c: Remove unused variable tmp_size.
+	* mpz/powm_ui.c: Fix typo in esize==0 if stmt.
+	* mpz/powm.c: Likewise.
+
+Sun Nov 29 01:16:11 1992  Torbjorn Granlund  (tege@sics.se)
+
+	* mpn/generic/divmod_1.c (mpn_divmod_1): Handle
+	divisor_limb == 1 << (BITS_PER_MP_LIMB - 1)
+	specifically.
+
+	* Reorganize sources.  New directories mpn, mpn/MACH, mpn/generic,
+	mpz, mpq, bsd.  Use full file name for change logs hereafter.
+
+Wed Oct 28 17:40:04 1992  Torbjorn Granlund  (tege@jupiter.sics.se)
+
+	* longlong.h (__hppa umul_ppmm): Fix typos.
+	(__hppa sub_ddmmss): Swap input arguments.
+
+	* mpz_perfsqr.c (mpz_perfect_square_p): Avoid , before } in
+	initializator.
+
+Sun Oct 25 20:30:06 1992  Torbjorn Granlund  (tege@jupiter.sics.se)
+
+	* mpz_pprime.c (mpz_probab_prime_p): Handle numbers <= 3
+	specifically (used to consider all negative numbers prime).
+
+	* mpz_powm_ui: `carry_digit' => `carry_limb'.
+
+	* sdiv: Handle zero dividend specifically.  Replace most code in
+	this function with a call to mpn_divmod_1.
+
+Fri Sep 11 22:15:55 1992  Torbjorn Granlund  (tege@tarrega.sics.se)
+
+	* mpq_clear: Don't free the MP_RAT!
+
+	* mpn_lshift, mpn_rshift, mpn_rshiftci: Remove `long' from 4:th arg.
+
+Thu Sep  3 01:47:07 1992  Torbjorn Granlund  (tege@jupiter.sics.se)
+
+	* All files: Remove leading _ from mpn function names.
+
+Wed Sep  2 22:21:16 1992  Torbjorn Granlund  (tege@jupiter.sics.se)
+
+	Fix from Jan-Hein Buhrman:
+	* mpz_mdiv.c, mpz_mmod.c, mpz_mdm.c: Make them work as documented.
+
+	* mpz_mmod.c, mpz_mdm.c: Move decl of TEMP_DIVISOR to reflect its
+	life.
+
+Sun Aug 30 18:37:15 1992  Torbjorn Granlund  (tege@jupiter.sics.se)
+
+	* _mpz_get_str: Use mpz_sizeinbase for computing out_len.
+	* _mpz_get_str: Don't remove leading zeros.  Abort if there are some.
+
+Wed Mar  4 17:56:56 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* gmp.h: Change definition of MP_INT to make the & before params
+	optional.  Use typedef to define it.
+	* mp.h: Use typedef to define MINT.
+
+Tue Feb 18 14:38:39 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	longlong.h (hppa umul_ppmm): Add missing semicolon.  Declare type
+	of __w1 and __w0.
+
+Fri Feb 14 21:33:21 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h: Make default count_leading_zeros work for machines >
+	32 bits.  Prepend `__' before local variables to avoid conflicts
+	with users' variables.
+
+	* mpn_dm_1.c: Remove udiv_qrnnd_preinv ...
+	* gmp-impl.h: ... and put it here.
+	* mpn_mod_1: Use udiv_qrnnd_preinv if it is faster than udiv_qrnnd.
+
+Tue Feb 11 17:20:12 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_mul: Enhance base case by handling small multiplicands.
+	* mpn_dm_1.c: Revert last change.
+
+Mon Feb 10 11:55:15 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_dm_1.c: Don't define udiv_qrnnd_preinv unless needed.
+
+Fri Feb  7 16:26:16 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_mul: Replace code for base case.
+
+Thu Feb  6 15:10:42 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_dm_1.c (_mpn_divmod_1): Add code for avoiding division by
+	pre-inverting divisor.
+
+Sun Feb  2 11:10:25 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h: Make __LLDEBUG__ work differently.
+	(_IBMR2): Reinsert old code.
+
+Sat Feb  1 16:43:00 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h (#ifdef _IBMR2): Replace udiv_qrnnd with new code
+	using floating point operations.  Don't define
+	UDIV_NEEDS_NORMALIZATION any longer.
+
+Fri Jan 31 15:09:13 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h: Define UMUL_TIME and UDIV_TIME for most machines.
+	* longlong.h (#ifdef __hppa): Define umul_ppmm.
+
+Wed Jan 29 16:41:36 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_cmp: Only one length parameter, assume operand lengths are
+	the same.  Don't require normalization.
+	* mpq_cmp, mpz_add, mpz_sub, mpz_gcd, mpn_mul, mpn_sqrt: Change for
+	new mpn_cmp definition.
+
+Tue Jan 28 11:18:55 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* _mpz_get_str: Fix typo in comment.
+
+Mon Jan 27 09:44:16 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* Makefile.in: Add new files.
+
+	* mpn_dm_1.c: New file with function _mpn_divmod_1.
+	* mpz_dm_ui.c (mpz_divmod_ui): Use _mpn_divmod_1.
+	* mpz_div_ui: Likewise.
+
+	* mpn_mod_1.c: New file with function _mpn_mod_1.
+	* mpz_mod_ui: Use _mpn_mod_1.
+
+Thu Jan 23 18:54:09 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Bug found by Paul Zimmermann (zimmermann@inria.inria.fr):
+	* mpz_div_ui.c (mpz_div_ui), mpz_dm_ui.c (mpz_divmod_ui):
+	Handle dividend == 0.
+
+Wed Jan 22 12:02:26 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_pprime.c: Use "" for #include.
+
+Sun Jan 19 13:36:55 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_rshiftci.c (header): Correct comment.
+
+Wed Jan 15 18:56:04 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_powm, mpz_powm_ui (if (bsize > msize)): Do alloca (bsize + 1)
+	to make space for ignored quotient at the end.  (The quotient might
+	always be an extra limb.)
+
+Tue Jan 14 21:28:48 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_powm_ui: Fix comment.
+	* mpz_powm: Likewise.
+
+Mon Jan 13 18:16:25 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* tests/Makefile.in: Prepend $(TEST_PREFIX) to Makefile target.
+
+Sun Jan 12 13:54:28 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Fixes from Kazumaro Aoki:
+	* mpz_out_raw: Take abs of size to handle negative values.
+	* mpz_inp_raw: Reallocate before reading ptr from X.
+	* mpz_inp_raw: Store, don't read, size to x->size.
+
+Tue Jan  7 17:50:25 1992  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* gmp.h, mp.h: Remove parameter names from prototypes.
+
+Sun Dec 15 00:09:36 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* tests/Makefile.in: Prepend "./" to file names when executing
+	tests.
+
+	* Makefile.in: Fix many problems.
+
+Sat Dec 14 01:00:02 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_sqrt.c: New file with _mpn_sqrt.
+	* mpz_sqrt, mpz_sqrtrem, mpz_perfect_square_p: Use _mpn_sqrt.
+	* msqrt.c: Delete.  Create from mpz_sqrtrem.c in Makefile.in.
+	* mpz_do_sqrt.c: Delete.
+	* Makefile.in: Update to reflect these changes.
+
+	* Makefile.in, configure, configure.subr: New files
+	(from bothner@cygnus.com).
+	* dist-Makefile: Delete.
+
+	* mpz_fac_ui: Fix comment.
+
+	* mpz_random2: Rewrite a bit to make it possible for the most
+	significant limb to be == 1.
+
+	* mpz_pprime.c (mpz_probab_prime_p): Remove \t\n.
+
+Fri Dec 13 23:10:02 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_do_sqrt: Simplify special case for U == 0.
+	* m*sqrt*.c, mpz_perfsqr.c (mpz_perfect_square_p):
+	  Rename _mpz_impl_sqrt to _mpz_do_sqrt.
+
+Fri Dec 13 12:52:28 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* gmp-impl.h (MPZ_TMP_INIT): Cast to the right type.
+
+Thu Dec 12 22:17:29 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_add, mpn_sub, mpn_mul, mpn_div: Change type of several
+	variables to mp_size.
+
+Wed Dec 11 22:00:34 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_rshift.c: Fix header comments.
+
+Mon Dec  9 17:46:10 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Released 1.2.
+
+	* gmp-impl.h (MPZ_TMP_INIT): Cast alloca return value.
+
+	* dist-Makefile: Add missing dependency for cre-mparam.
+
+	* mpz_mdiv.c, mpz_mmod.c, mpz_mdm.c, mpz_mdiv_ui.c,
+	  mpz_mmod_ui.c, mpz_mdm_ui.c: Remove obsolete comment.
+
+	* dist-Makefile (clean): clean in tests subdir too.
+	* tests/Makefile: Define default values for ROOT and SUB.
+
+	* longlong.h (__a29k__ udiv_qrnnd): Change "q" to "1" for operand
+	2 constraint.
+
+Mon Nov 11 00:06:05 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_sizeinb.c (mpz_sizeinbase): Special code for size == 0.
+
+Sat Nov  9 23:47:38 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Released 1.1.94.
+
+	* dist-Makefile, Makefile, tests/Makefile: Merge tests into
+	distribution.
+
+Fri Nov  8 22:57:19 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* gmp.h: Don't use keyword `signed' for non-ANSI compilers.
+
+Thu Nov  7 22:06:46 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h: Cosmetic changes to keep it identical to gcc2 version
+	of longlong.h.
+	* longlong.h (__ibm032__): Fix operand order for add_ssaaaa and
+	sub_ddmmss.
+
+Mon Nov  4 00:36:46 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_mul: Fix indentation.
+
+	* mpz_do_sqrt: Don't assume 32 bit limbs (had constant
+	4294967296.0).
+	* mpz_do_sqrt: Handle overflow in conversion from double returned
+	by SQRT to mp_limb.
+
+	* gmp.h: Add missing function definitions.
+
+Sun Nov  3 18:25:25 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_pow_ui: Change type of `i' to int.
+
+	* ChangeLog: Add change log entry.
+	* ChangeLog: Add change log entry.
+	* ChangeLog: Add change log entry.
+	* ChangeLog: Add change log entry.
+	* ChangeLog: Add change log entry.
+	* ChangeLog: Add change log entry.
+	* ChangeLog: Add change log entry.
+	* ChangeLog: Add change log entry.
+Stack overflow.
+
+	* mpz_pow_ui.c: Fix typo in comment.
+
+	* dist-Makefile: Create rpow.c from mpz_powm_ui.c.
+	* mpz_powm_ui.c: Add code for rpow.
+	* rpow.c: Delete this file.  The rpow function is now implemented
+	in mpz_powm_ui.c.
+
+	* mpz_fac_ui.c: New file.
+	* gmp.h, dist-Makefile: Add stuff for mpz_fac_ui.
+
+	Bug found by John Amanatides (amana@sasquatch.cs.yorku.ca):
+	* mpz_powm_ui, mpz_powm: Call _mpn_mul in the right way, with
+	the first argument not smaller than the second.
+
+Tue Oct 29 13:56:55 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* cre-conv-tab.c (main), cre-mparam.c (main): Fix typo in output
+	header text.
+
+Mon Oct 28 00:35:29 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_random2: Handle size == 0.
+
+	* gmp-impl.h (struct __mp_bases): Rename chars_per_limb_exactly to
+	chars_per_bit_exactly, and change its definition.
+	* cre-conv-tab.c (main): Output field according to its new
+	definition.
+	* mpz_out_str, _mpz_get_str, mpz_sizeinb, mout:
+	Use chars_per_bit_exactly.
+
+	* mpz_random2: Change the loop termination condition in order to
+	get a large most significant limb with higher probability.
+
+	* gmp.h: Add declaration of new mpz_random2 and mpz_get_si.
+	* mpz_get_si.c: New file.
+	* dist-Makefile: Add mpz_random2 and mpz_get_si.
+
+	* mpz_sizeinb.c (mpz_sizeinbase): Special code for base being a
+	power of 2, giving exact result.
+
+	* mpn_mul: Fix MPN_MUL_VERIFY in various ways.
+	* mpn_mul: New macro KARATSUBA_THRESHOLD.
+	* mpn_mul (karatsuba's algorithm): Don't write intermediate results
+	to prodp, use temporary pp instead.  (Intermediate results can be
+	larger than the final result, possibly writing into hyperspace.)
+	* mpn_mul: Make smarter choice between Karatsuba's algorithm and the
+	shortcut algorithm.
+	* mpn_mul: Fix typo, cy instead of xcy.  Unify carry handling code.
+
+Sun Oct 27 19:57:32 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_mul: In non-classical case, choose Karatsuba's algorithm only
+	when usize > 1.5 vsize.
+
+	* mpn_mul: Break between classical and Karatsuba's algorithm at
+	KARATSUBA_THRESHOLD, if defined.  Default to 8.
+
+	* mpn_div: Kludge to fix stray memory read.
+
+Sat Oct 26 20:06:14 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_gcdext: Handle a = b = 0.  Remove memory leakage by calling
+	mpz_clear for all temporary variables.
+
+	* mpz_gcd: Reduce w_bcnt in _mpn_lshift call to hold that
+	function's argument constraints.  Compute wsize correctly.
+
+	* mpz_gcd: Fix typo in comment.
+
+	* memory.c (_mp_default_allocate, _mp_default_reallocate): Call
+	abort if allocation fails, don't just exit.
+
+Fri Oct 25 22:17:20 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_random2.c: New file.
+
+Thu Oct 17 18:06:42 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Bugs found by Pierre-Joseph Gailly (pjg@sunbim.be):
+	* mpq_cmp: Take sign into account, don't just compare the
+	magnitudes.
+	* mpq_cmp: Call _mpn_mul in the right way, with the first argument
+	not smaller than the second.
+
+Wed Oct 16 19:27:32 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_random: Ensure the result is normalized.
+
+Tue Oct 15 14:55:13 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_clrbit: Support non-ANSI compilers.
+
+Wed Oct  9 18:03:28 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h (68k add_ssaaaa, sub_ddmmss): Generalize constraints.
+
+Tue Oct  8 17:42:59 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_mdm_ui: Add comments.
+
+	* mpz_mdiv: Use MPZ_TMP_INIT instead of mpz_init.
+	* mpz_init_ui: Change spacing and header comment.
+
+Thu Oct  3 18:36:13 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* dist-Makefile: Prepend `./' before some filenames.
+
+Sun Sep 29 14:02:11 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Released 1.1 (public).
+
+	* mpz_com: New name of mpz_not.
+	* dist-Makefile: Change mpz_not to mpz_com.
+
+Tue Sep 24 12:44:11 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h: Fix header comment.
+
+Mon Sep  9 15:16:24 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Released 1.0.92.
+
+	* mpn_mul.c (_mpn_mul): Handle leading zero limbs in non-Karatsuba
+	case.
+
+	* longlong.h (m68000 umul_ppmm): Clobber one register less by
+	slightly rearranging the code.
+
+Sun Sep  1 18:53:25 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* dist-Makefile (stamp-stddefh): Fix typo.
+
+Sat Aug 31 20:41:31 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Released 1.0.91.
+
+	* mpz_mdiv.c, mpz_mmod.c, mpz_mdm.c, mpz_mdiv_ui.c,
+	  mpz_mmod_ui.c, mpz_mdm_ui.c: New files and functions.
+	* gmp.h, gmp.texi: Define the new functions.
+
+Fri Aug 30 08:32:56 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_gcdext: Compute t argument from the other quantities at the
+	  end, of the function, not in the loop.  New feature: Allow t to be
+	  NULL.
+
+	* mpz_add.c, mpz_sub.c, mpz_mul.c, mpz_powm.c, mpz_gcd.c: Don't
+	  include "mp.h".  Use type name `MP_INT' always.
+
+	* dist-Makefile, mpz_cmp.c: Merge mcmp.c from mpz_cmp.c.
+
+Wed Aug 28 00:45:11 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* dist-Makefile (documentation): Go via tmp.texi to avoid the
+	  creation of gmp.dvi if any errors occur.  Make tex read input
+	  from /dev/null.
+
+Fri Aug 23 15:58:52 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h (68020, i386): Don't define machine-dependent
+	  __umulsidi3 (so the default definition is used).
+	* longlong.h (all machines): Cast all operands, sources and
+	  destinations, to `unsigned long int'.
+	* longlong.h: Add gmicro support.
+
+Thu Aug 22 00:28:29 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h: Rename BITS_PER_LONG to LONG_TYPE_SIZE.
+	* longlong.h (__ibm032__): Define count_leading_zeros and umul_ppmm.
+	* longlong.h: Define UMUL_TIME and UDIV_TIME for some CPUs.
+	* _mpz_get_str.c: Add code to do division by big_base using only
+	  umul_qrnnd, if that is faster.  Use UMUL_TIME and UDIV_TIME to
+	  decide which variant to use.
+
+Wed Aug 21 15:45:23 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h (__sparc__ umul_ppmm): Move two insn from end to the
+	  nops.  (Saves two insn.)
+
+	* longlong.h (__sparc__ umul_ppmm): Rewrite in order to avoid
+	  branch, and to permit input/output register overlap.
+
+	* longlong.h (__29k__): Remove duplicated udiv_qrnnd definition.
+	* longlong.h (__29k__ umul_ppmm): Split asm instructions into two
+	  asm statements (gives better code if either the upper or lower
+	  part of the product is unused.
+
+Tue Aug 20 17:57:59 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* _mpz_get_str.c (outside of functions): Remove
+	  num_to_ascii_lower_case and num_to_ascii_upper_case.  Use string
+	  constants in the function instead.
+
+Mon Aug 19 00:37:42 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* cre-conv-tab.c (main): Output table in hex.  Output 4 fields, not
+	  3, for components 0 and 1.
+
+	* gmp.h: Add declaration of mpq_neg.
+
+	Released 1.0beta.13.
+
+	* _mpz_set_str.c (mpz_set_str): Cast EOF and SPC to char before
+	  comparing to enum literals SPC and EOF.  This makes the code work
+	  for compilers where `char' is unsigned.  (Bug found by Brian
+	  Beuning).
+
+	Released 1.0beta.12.
+
+	* mpz_mod_ui: Remove references to quot.  Remove quot_ptr, quot_size
+	  declarations and assignment code.
+
+Sun Aug 18 14:44:26 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_mod_ui: Handle dividend < 0.
+
+	Released 1.0beta.11.
+
+	* mpz_dm_ui, mpz_div_ui, mpz_mod_ui, sdiv: Make them share the same
+	  general structure, variable names, etc.
+
+	* sdiv: Un-normalize the remainder in n1 before it is negated.
+
+	* longlong.h: Mention UDIV_NEEDS_NORMALIZATION in description of
+	  udiv_qrnnd.
+
+	* mpz_dm_ui.c (mpz_divmod_ui), mpz_div_ui.c (mpz_div_ui): Increment
+	  the quotient size if the dividend size is incremented.  (Bug found
+	  by Brian Beuning.)
+
+	* mpz_mod_ui: Shift back the remainder, if UDIV_NEEDS_NORMALIZATION.
+	  (Bug found by Brian Beuning.)
+
+	* mpz_mod_ui: Replace "digit" by "limb".
+
+	* mpz_perfsqr.c (mpz_perfect_square_p): Disable second test case
+	  for non-32-bit machines (PP is hardwired for such machines).
+	* mpz_perfsqr.c (outside of functions): Define PP value with an L.
+
+	* mpn_mul.c (_mpn_mul): Add verification code that is activated if
+	  DEBUG is defined.  Replace "digit" by "limb".
+	* mpn_mul.c (_mpn_mul: Karatsuba's algorithm: 4.): Normalize temp
+	  after the addition.
+	* mpn_mul.c (_mpn_mul: Karatsuba's algorithm: 1.): Compare u0_size
+	  and v0_size, and according to the result, swap arguments in
+	  recursive call.  (Don't violate mpn_mul's own argument
+	  constraints.)
+
+Fri Aug 16 13:47:12 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Released 1.0beta.10.
+
+	* longlong.h (IBMR2): Add udiv_qrnnd.
+
+	* mpz_perfsqr: Remove unused variables.
+
+	* mpz_and (case for different signs): Initialize loop variable i!
+
+	* dist-Makefile: Update automatically generated dependencies.
+	* dist-Makefile (madd.c, msub.c, pow.c, mult.c, gcd.c): Add mp.h,
+	  etc to dependency file lists.
+
+	* longlong.h (add_ssaaaa, sub_ddmmss [C default versions]): Make __x
+	  `unsigned long int'.
+	* longlong.h: Add `int' after `unsigned' and `long' everywhere.
+
+Wed Aug 14 18:06:48 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h: Add ARM, i860 support.
+
+	* mpn_lshift, mpn_rshift, mpn_rshiftci: Rename *_word with *_limb.
+
+Tue Aug 13 21:57:43 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* _mpz_get_str.c, _mpz_set_str.c, mpz_sizeinb.c (mpz_sizeinbase),
+	  mpz_out_str.c, mout.c: Remove declaration of __mp_bases.
+	* gmp-impl.h: Put it here, and make it `const'.
+	* cre-conv-tab.c (main): Make struct __mp_bases `const'.
+
+Mon Aug 12 17:11:46 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* cre-conv-tab.c (main): Use %lu in printf for long ints.
+
+	* dist-Makefile: Fix cre-* dependencies.
+
+	* cre-conv-tab.c (main): Output field big_base_inverted.
+
+	* gmp-impl.h (struct bases): New field big_base_inverted.
+	* gmp-impl.h (struct bases): Change type of chars_per_limb_exactly
+	  to float (in order to keep the structure smaller).
+
+	* mp.h, gmp.h: Change names of macros for avoiding multiple
+	  includes.
+
+Fri Aug  9 18:01:36 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* _mpz_get_str: Only shift limb array if normalization_steps != 0
+	  (optimization).
+
+	* longlong.h (sparc umul_ppmm): Use __asm__, not asm.
+	* longlong.h (IBMR2 umul_ppmm): Refer to __m0 and __m1, not to m0
+	  and m1 (overlap between output and input operands did not work).
+	* longlong.h: Add VAX, ROMP and HP-PA support.
+	* longlong.h: Sort the machine dependent code in alphabetical order
+	  on the CPU name.
+	* longlong.h: Hack comments.
+
+Thu Aug  8 14:13:36 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	Released 1.0beta.9.
+
+	* longlong.h: Define BITS_PER_LONG to 32 if it's not already
+	  defined.
+	* Define __BITS4 to BITS_PER_LONG / 4.
+	* Don't assume 32 bit word size in "count_leading_zeros" C macro.
+	  Use __BITS4 and BITS_PER_LONG instead.
+
+	* longlong.h: Don't #undef internal macros (reverse change of Aug 3).
+
+	* longlong.h (68k): Define add_ssaaaa sub_ddmmss, and umul_ppmm
+	  even for plain mc68000.
+
+	* mpq_div: Flip the sign of the numerator *and* denominator of the
+	  result if the intermediate denominator is negative.
+
+	* mpz_and.c, mpz_ior.c: Use MPN_COPY for all copying operations.
+
+	* mpz_and.c: Compute the result size more conservatively.
+	* mpz_ior.c: Likewise.
+
+	* mpz_realloc: Never allocate zero space even if NEW_SIZE == 0.
+
+	* dist-Makefile: Remove madd.c, msub.c, pow.c, mult.c, gcd.c from
+	  BSDMP_SRCS.
+
+	* dist-Makefile: Create mult.c from mpz_mul.c.
+	* mult.c: Delete this file.
+
+	* _mpz_set_str: Normalize the result (for bases 2, 4, 8... it was
+	  not done properly if the input string had many leading zeros).
+
+Sun Aug  4 16:54:14 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* dist-Makefile (gcd.c, pow.c, madd.c, msub.c): Make these targets
+	  work with VPATH and GNU MP.
+
+	* mpz_gcd: Don't call mpz_set; inline its functionality.
+
+	* mpq_mul, mpq_div: Fix several serious typos.
+
+	* mpz_dmincl, mpz_div: Don't normalize the quotient if it's already
+	  zero.
+
+	* mpq_neg.c: New file.
+
+	* dist-Makefile: Remove obsolete dependencies.
+
+	* mpz_sub: Fix typo.
+
+	Bugs found by Pierre-Joseph Gailly (pjg@sunbim.be):
+	* mpq_mul, mpq_div: Initialize tmp[12] variables even when the gcd
+	  is just 1.
+	* mpz_gcd: Handle gcd(0,v) and gcd(u,0) in special cases.
+
+Sat Aug  3 23:45:28 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h: Clean up comments.
+	* longlong.h: #undef internal macros.
+
+Fri Aug  2 18:29:11 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpq_set_si, mpq_set_ui: Canonicalize 0/x to 0/1.
+	* mpq_set_si, mpq_set_ui: Cosmetic formatting changes.
+
+	* mpz_dmincl.c: Normalize the remainder before shifting it back.
+
+	* mpz_dm_ui.c (mpz_divmod_ui): Handle rem == dividend.
+
+	* mpn_div.c: Fix comment.
+
+	* mpz_add.c, mpz_sub.c: Use __MP_INT (not MP_INT) for intermediate
+	  type, in order to work for both GNU and Berkeley functions.
+
+	* dist-Makefile: Create gcd.c from mpz_gcd.c, pow.c from mpz_powm,
+	  madd.c from mpz_add.c, msub.c from mpz_sub.c.
+	  respectively.
+	* pow.c, gcd.c, mpz_powmincl.c, madd.c, msub.c: Remove these.
+	* mpz_powm.c, mpz_gcd.c, mpz_add.c, mpz_sub.c: #ifdef for GNU and
+	  Berkeley function name variants.
+	* dist-Makefile: Add created files to "clean" target.
+
+Tue Jul 16 15:19:46 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpq_get_den: No need for absolute value of the size, the
+	  denominator is always positive.
+
+	* mpz_get_ui: If the operand is zero, return zero.  Don't read the
+	  limb array!
+
+	* mpz_dmincl.c: Don't ignore the return value from _mpn_rshift, it
+	  is the size of the remainder.
+
+Mon Jul 15 11:08:05 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* Several files: Remove unused variables and functions.
+
+	* gmp-impl.h: Declare _mpz_impl_sqrt.
+
+	* mpz_dm_ui (mpz_divmod_ui), sdiv: Shift back the remainder if
+	  UDIV_NEEDS_NORMALIZATION.  (Fix from Brian Beuning.)
+
+	* mpz_dm_ui.c, sdiv: Replace *digit with *limb.
+
+	* mpz_ior: Add missing else statement in -OP1 | -OP2 case.
+	* mpz_ior: Add missing else statement in OP1 | -OP2 case.
+	* mpz_ior: Swap also OP1 and OP2 pointers in -OP1 & OP2 case.
+	* mpz_ior: Duplicate _mpz_realloc code.
+
+	* mpz_and: Add missing else statement in -OP1 & -OP2 case.
+	* mpz_and: Rewrite OP1 & -OP2 case.
+	* mpz_and: Swap also OP1 and OP2 pointers in -OP1 & OP2 case.
+
+	* mpz_gcdext: Loop in d1.size (not b->size).  (Fix from Brian
+	  Beuning.)
+
+	* mpz_perfsqr: Fix argument order in _mpz_impl_sqrt call.  (Fix from
+	  Brian Beuning.)
+
+Fri Jul 12 17:10:33 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpq_set.c, mpq_set_ui.c, mpq_set_si.c, mpq_inv.c,
+	  mpq_get_num.c, mpq_get_den.c, mpq_set_num.c, mpq_set_den.c:
+	  New files.
+
+	* mpz_dmincl.c: Remove second re-allocation of rem->d.  It
+	  was never executed.
+
+	* dist-Makefile: Use `-r' instead of `-x' for test for ranlib (as
+	  some unixes' test doesn't have the -r option).
+
+	* *.*: Cast allocated pointers to the appropriate type (makes old C
+	  compilers happier).
+
+	* cre-conv-tab.c (main): Divide max_uli by 2 and multiply again
+	  after conversion to double.  (Kludge for broken C compilers.)
+
+	* dist-Makefile (stamp-stddefh): New target.  Test if "stddef.h"
+	  exists in the system and creates a minimal one if it does not
+	  exist.
+	* cre-stddefh.c: New file.
+	* dist-Makefile: Make libgmp.a and libmp.a depend on stamp-stddefh.
+	* dist-Makefile (clean): Add some more.
+	* gmp.h, mp.h: Unconditionally include "stddef.h".
+
+Thu Jul 11 10:08:21 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* min: Do ungetc of last read character.
+	* min.c: include stdio.h.
+
+	* dist-Makefile: Go via tmp- files for cre* redirection.
+	* dist-Makefile: Add tmp* to "clean" target.
+
+	* dist-Makefile: Use LOCAL_CC for cre*, to simplyfy cross
+	  compilation.
+
+	* gmp.h, mp.h: Don't define NULL here.
+	* gmp-impl.h: Define it here.
+
+Wed Jul 10 14:13:33 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_mod_2exp: Don't copy too much, overwriting most significant
+	  limb.
+
+	* mpz_and, mpz_ior: Don't read op[12]_ptr from op[12] when
+	  reallocating res, if op[12]_ptr got their value from alloca.
+
+	* mpz_and, mpz_ior: Clear up comments.
+
+	* cre-mparam.c: Output parameters for `short int' and `int'.
+
+	* mpz_and, mpz_ior: Negate negative op[12]_size in several places.
+
+Tue Jul  9 18:40:30 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* gmp.h, mp.h: Test for _SIZE_T defined before typedef'ing size_t.
+	  (Fix for Sun lossage.)
+
+	* gmp.h: Add declaration of mpq_clear.
+
+	* dist-Makefile: Chack if "ranlib" exists, before using it.
+	* dist-Makefile: Add mpz_sqrtrem.c and mpz_size.c.
+	* mpz_powm: Fix typo, "pow" instead of "mpz_powm".
+
+Fri Jul  5 19:08:09 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* move: Remove incorrect comment.
+
+	* mpz_free, mpq_free: Rename to *_clear.
+	* dist-Makefile: Likewise.
+	* mpq_add, mpq_sub, mpq_mul, mpq_div: Likewise.
+
+	* mpz_dmincl.c: Don't call "move", inline its functionality.
+
+Thu Jul  4 00:06:39 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* Makefile: Include dist-Makefile.  Fix dist target to include
+	  dist-Makefile (with the name "Makefile" in the archive).
+
+	* dist-Makefile: New file made from Makefile.  Add new mpz_...
+	  functions.
+
+	* mpz_powincl.c New file for mpz_powm (Berkeley MP pow)
+	  functionality.  Avoids code duplication.
+	* pow.c, mpz_powm.c: Include mpz_powincl.c
+
+	* mpz_dmincl.c: New file containing general division code.  Avoids
+	  code duplication.
+	* mpz_dm.c (mpz_divmod), mpz_mod.c (mpz_mod), mdiv.c (mdiv): Include
+	  mpz_dmincl.c.
+
+	* _mpz_get_str: Don't call memmove, unless HAS_MEMMOVE is defined.
+	  Instead, write the overlapping memory copying inline.
+
+	* mpz_dm_ui.c: New name for mpz_divmod_ui.c (SysV file name limit).
+
+	* longlong.h: Don't use #elif.
+	* mpz_do_sqrt.c: Likewise.
+
+	* longlong.h: Use __asm__ instead of asm.
+	* longlong.h (sparc udiv_qrnnd): Make it to one string over several
+	  lines.
+
+	* longlong.h: Preend __ll_ to B, highpart, and lowpart.
+
+	* longlong.h: Move array t in count_leading_zeros to the new file
+	  mp_clz_tab.c.  Rename the array __clz_tab.
+	* All files: #ifdef for traditional C compatibility.
+
+Wed Jul  3 11:42:14 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_and: Initialize res_ptr always (used to be initialized only
+	  when reallocating).
+
+	* longlong.h (umul_ppmm [C variant]): Make __ul...__vh
+	  `unsigned int', and cast the multiplications.  This way
+	  compilers more easily can choose cheaper multiplication
+	  instructions.
+
+	* mpz_mod_2exp: Handle input argument < modulo argument.
+	* mpz_many: Make sure mp_size is the type for sizes, not int.
+
+	* mpz_init, mpz_init_set*, mpq_init, mpq_add, mpq_sub, mpq_mul,
+	  mpq_div: Change mpz_init* interface.  Structure pointer as first
+	  arg to initialization function, no longer *return* struct.
+
+Sun Jun 30 19:21:44 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* Rename mpz_impl_sqrt.c to mpz_do_sqrt.c to satisfy SysV 14
+	  character file name length limit.
+
+	* Most files: Rename MINT to MP_INT.  Rename MRAT to MP_RAT.
+	* mpz_sizeinb.c: New file with function mpz_sizeinbase.
+	* mp_bases.c: New file, with array __mp_bases.
+	* _mpz_get_str, _mpz_set_str: Remove struct bases, use extern
+	  __mp_bases instead.
+	* mout, mpz_out_str: Use array __mp_bases instead of function
+	  _mpz_get_cvtlen.
+	* mpz_get_cvtlen.c: Remove.
+	* Makefile: Update.
+
+Sat Jun 29 21:57:28 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* longlong.h (__sparc8__ umul_ppmm): Insert 3 nop:s for wr delay.
+	* longlong.h (___IBMR2__): Define umul_ppmm, add_ssaaaa, sub_ddmmss.
+	* longlong.h (__sparc__): Don't call .umul; expand asm instead.
+	  Don't define __umulsidi3 (i.e. use default definition).
+
+Mon Jun 24 17:37:23 1991  Torbjorn Granlund  (tege@amon.sics.se)
+
+	* _mpz_get_str.c (num_to_ascii_lower_case, num_to_ascii_upper_case):
+	  Swap 't' and 's'.
+
+Sat Jun 22 13:54:01 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_gcdext.c: New file.
+
+	* mpn_mul: Handle carry and unexpected operand sizes in last
+	  additions/subtractions.  (Bug trigged when v1_size == 1.)
+
+	* mp*_alloc*: Rename functions to mp*_init* (files to mp*_iset*.c).
+	* mpq_*: Call mpz_init*.
+
+	* mpz_pow_ui, rpow: Use _mpn_mul instead of mult.  Restructure.
+
+Wed May 29 20:32:33 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_get_cvtlen: multiply by size.
+
+Sun May 26 15:01:15 1991  Torbjorn Granlund  (tege@bella.nada.kth.se)
+
+	Alpha-release 0.95.
+
+	Fixes from Doug Lea (dl@g.oswego.edu):
+	* mpz_mul_ui: Loop to MULT_SIZE (not PROD_SIZE).  Adjust PROD_SIZE
+	  correctly.
+	* mpz_div: Prepend _ to mpz_realloc.
+	* mpz_set_xs, mpz_set_ds: Fix typos in function name.
+
+Sat May 25 22:51:16 1991  Torbjorn Granlund  (tege@bella.nada.kth.se)
+
+	* mpz_divmod_ui: New function.
+
+	* sdiv: Make the sign of the remainder correct.
+
+Thu May 23 15:28:24 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* Alpha-release 0.94.
+
+	* mpz_mul_ui: Include longlong.h.
+
+	* mpz_perfsqr.c (mpz_perfect_square_p): Call _mpz_impl_sqrt instead
+	  of msqrt.
+
+	* mpz_impl_sqrt: Don't call "move", inline its functionality.
+
+	* mdiv: Use MPN_COPY instead of memcpy.
+	* rpow, mpz_mul, mpz_mod_2exp: Likewise.
+	* pow.c: Likewise, and fix bug in the size arg.
+
+	* xtom: Don't use mpz_alloc, inline needed code instead.  Call
+	  _mpz_set_str instead of mpz_set_str.
+
+	* Makefile: Make two libraries, libmp.a and libgmp.a.
+
+Thu May 22 20:25:29 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* Add manual to distribution.
+	* Fold in many missing routines descibed in the manual.
+	* Update Makefile.
+
+Wed May 22 13:48:46 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_set_str: Make it handle 0x prefix OK.
+
+Sat May 18 18:31:02 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* memory.c (_mp_default_reallocate): Swap OLD_SIZE and NEW_SIZE
+	  arguments.
+	* mpz_realloc (_mpz_realloc): Swap in call to _mp_reallocate_func.
+	* min: Likewise.
+
+Thu May 16 20:43:05 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* memory.c: Make the default allocations functions global.
+	* mp_set_fns (mp_set_memory_functions): Make a NULL pointer mean the
+	  default memory function.
+
+Wed May  8 20:02:42 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_div: Handle DEN the same as QUOT correctly by copying DEN->D
+	  even if no normalization is needed.
+	* mpz_div: Rework reallocation scheme, to avoid excess copying.
+
+	* mpz_sub_ui.c, mpz_add_ui.c: New files.
+
+	* mpz_cmp.c, mpz_cmp_ui.c: New files.
+
+	* mpz_mul_2exp: Handle zero input MINT correctly.
+
+	* mpn_rshiftci:  Don't handle shift counts > BITS_PER_MP_DIGIT.
+
+	* mpz_out_raw.c, mpz_inp_raw.c: New files for raw I/O.
+
+Tue May  7 15:44:58 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_rshift: Don't handle shift counts > BITS_PER_MP_DIGIT.
+	* mpz_div_2exp: Don't call _mpn_rshift with cnt > BITS_PER_MP_DIGIT.
+	* gcd, mpz_gcd: Likewise.
+
+	* gcd, mpz_gcd: Handle common 2 factors correctly.
+
+Mon May  6 20:22:59 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* gmp-impl.h (MPN_COPY): Inline a loop instead of calling memcpy.
+
+	* gmp-impl.h, mpz_get_str, rpow: Swap DST and SRC in TMPCOPY* macros.
+
+Sun May  5 15:16:23 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpz_div: Remove test for QUOT == 0.
+
+Sun Apr 28 20:21:04 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* pow: Don't make MOD normalization in place, as it's a bad idea to
+	  write on an input parameter.
+	* pow: Reduce BASE if it's > MOD.
+	* pow, mult, mpz_mul: Simplify realloc code.
+
+Sat Apr 27 21:03:11 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* Install multplication using Karatsuba's algorithm as default.
+
+Fri Apr 26 01:03:57 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* msqrt: Store in ROOT even for U==0, to make msqrt(0) defined.
+
+	* mpz_div_2exp.c, mpz_mul_2exp.c: New files for shifting right and
+	  left, respectively.
+	* gmp.h: Add definitions for mpz_div_2exp and mpz_mul_2exp.
+
+	* mlshift.c, mrshift.c: Remove.
+
+Wed Apr 24 21:39:22 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* mpn_mul: Check only for m2_size == 0 in function header.
+
+Mon Apr 22 01:31:57 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* karatsuba.c: New file for Karatsuba's multplication algorithm.
+
+	* mpz_random, mpz_init, mpz_mod_2exp: New files and functions.
+
+	* mpn_cmp: Fix header comment.
+
+Sun Apr 21 00:10:44 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* pow: Switch off initial base reduction.
+
+Sat Apr 20 22:06:05 1991  Torbjorn Granlund  (tege@echnaton.sics.se)
+
+	* mpz_get_str: Don't generate initial zeros for initial word.
+	  Used to write outside of allocated storage.
+
+Mon Apr 15 15:48:08 1991  Torbjorn Granlund  (tege@zevs.sics.se)
+
+	* _mpz_realloc: Make it accept size in number of mp_digits.
+	* Most functions: Use new _mpz_realloc definition.
+
+	* mpz_set_str: Remove calls _mp_free_func.
+
+	* Most functions: Rename mpn_* to _mpn_*.  Rename mpz_realloc to
+	  _mpz_realloc.
+	* mpn_lshift: Redefine _mpn_lshift to only handle small shifts.
+	* mdiv, mpz_div, ...: Changes for new definition of _mpn_lshift.
+	* msqrt, mp*_*shift*: Define cnt as unsigned (for speed).
+
+Sat Apr  6 14:05:16 1991  Torbjorn Granlund  (tege@musta.nada.kth.se)
+
+	* mpn_mul: Multiply by the first digit in M2 in a special
+	  loop instead of zeroing the product area.
+
+	* mpz_abs.c: New file.
+
+	* sdiv: Implement as mpz_div_si for speed.
+
+	* mpn_add: Make it work for second source operand == 0.
+
+	* msub: Negate the correct operand, i.e. V before swapping, not
+	  the smaller of U and V!
+	* madd, msub: Update abs_* when swapping operands, and not after
+	  (optimization).
+
+Fri Apr  5 00:19:36 1991  Torbjorn Granlund  (tege@black.nada.kth.se)
+
+	* mpn_sub: Make it work for subtrahend == 0.
+
+	* madd, msub: Rewrite to minimize mpn_cmp calls.  Ensure
+	  mpn_cmp is called with positive sizes (used to be called
+	  incorrectly with negative sizes sometimes).
+
+	* msqrt: Make it divide by zero if fed with a negative number.
+	* Remove if statement at end of precision calculation that was
+	  never true.
+
+	* itom, mp.h: The argument is of type short, not int.
+
+	* mpz_realloc, gmp.h: Make mpz_realloc return the new digit pointer.
+
+	* mpz_get_str.c, mpz_set_str.c, mpz_new_str.c: Don't include mp.h.
+
+	* Add COPYING to distribution.
+
+	* mpz_div_ui.c, mpz_div_si.c, mpz_new_ui.c, mpz_new_si.c: New files.
+
+Fri Mar 15 00:26:29 1991  Torbjorn Granlund  (tege@musta.nada.kth.se)
+
+	* Add Copyleft headers to all files.
+
+	* mpn_mul.c, mpn_div.c: Add header comments.
+	* mult.c, mdiv.c: Update header comments.
+
+	* mpq_add.c, mpq_sub.c, mpq_div.c, mpq_new.c, mpq_new_ui.c,
+	  mpq_free.c: New files for rational arithmetics.
+
+	* mpn_lshift.c: Avoid writing the most significant word if it is 0.
+
+	* mdiv.c: Call mpn_lshift for the normalization.
+	* mdiv.c: Remove #ifdefs.
+
+	* Makefile: Add ChangeLog to DISTFILES.
+
+	* mpn_div.c: Make the add_back code work (by removing abort()).
+	* mpn_div.c: Make it return if the quotient is size as compared
+	  with the difference NSIZE - DSIZE.  If the stored quotient is
+	  larger than that, return 1, otherwise 0.
+	* gmp.h: Fix mpn_div declaration.
+	* mdiv.c: Adopt call to mpn_div.
+	* mpz_div.c: New file (developed from mdiv.c).
+
+	* README: Update routine names.
+
+Thu Mar 14 18:45:28 1991  Torbjorn Granlund  (tege@musta.nada.kth.se)
+
+	* mpq_mul.c: New file for rational multplication.
+
+	* gmp.h: Add definitions for rational arithmetics.
+
+	* mpn_div: Kludge the case where the high numerator digit > the
+	  high denominator digit.  (This code is going to be optimized later.)
+
+	* New files: gmp.h for GNU specific functions, gmp-common.h for
+	  definitions common for mp.h and gmp.h.
+
+	* Ensure mp.h just defines what BSD mp.h defines.
+
+	* pow.c: Fix typo for bp allocation.
+
+	* Rename natural number functions to mpn_*, integer functions to
+	  mpz_*.
+
+Tue Mar  5 18:47:04 1991  Torbjorn Granlund  (tege@musta.nada.kth.se)
+
+	* mdiv.c (_mp_divide, case 2): Change test for estimate of Q from
+	  "n0 >= r" to "n0 > r".
+
+	* msqrt: Tune the increasing precision scheme, to do fewer steps.
+
+Tue Mar  3 18:50:10 1991  Torbjorn Granlund  (tege@musta.nada.kth.se)
+
+	* msqrt: Use the low level routines.  Use low precision in the
+	beginning, and increase the precision as the result converges.
+	(This optimization gave a 6-fold speedup.)
+
+Local Variables:
+mode: indented-text
+left-margin: 8
+fill-column: 75
+version-control: never
+End:
diff --git a/src/gmp/INSTALL b/src/gmp/INSTALL
new file mode 100644
index 000000000..62faa1a2e
--- /dev/null
+++ b/src/gmp/INSTALL
@@ -0,0 +1,146 @@
+
+                          INSTALLING GNU MP
+                          =================
+
+
+These instructions are only for the impatient.  Others should read the install
+instructions in the manual, gmp.info.  Use
+
+	info -f ./gmp.info
+
+or in emacs
+
+	C-u C-h i gmp.info
+
+
+Here are some brief instructions on how to install GMP, and some examples to
+help you get started using GMP.
+
+First, you need to compile, and optionally install, GMP.  Since you're
+impatient, try this:
+
+	./configure; make
+
+If that fails, or you care about the performance of GMP, you need to read the
+full instructions in the chapter "Installing GMP", in the manual.
+
+Next, try some small test programs, for example the ones below.
+
+In GMP programs, all variables need to be initialized before they are
+assigned, and cleared out before program flow leaves the scope in which they
+were declared.  Here is an example program that reads two numbers from the
+command line, multiplies them, and prints the result to stdout.
+
+
+    #include <stdio.h>
+    #include <gmp.h>         /* All GMP programs need to include gmp.h */
+
+    main (int argc, char **argv)
+    {
+      mpz_t a, b, p;
+
+      if (argc != 3)
+        { printf ("Usage: %s <number> <number>\n", argv[0]); exit (1); }
+
+      /* Initialize variables */
+      mpz_init (a);
+      mpz_init (b);
+      mpz_init (p);
+
+      /* Assign a and b from base 10 strings in argv */
+      mpz_set_str (a, argv[1], 10);
+      mpz_set_str (b, argv[2], 10);
+
+      /* Multiply a and b and put the result in p */
+      mpz_mul (p, a, b);
+
+      /* Print p in base 10 */
+      mpz_out_str (stdout, 10, p);
+      fputc ('\n', stdout);
+
+      /* Clear out variables */
+      mpz_clear (a);
+      mpz_clear (b);
+      mpz_clear (p);
+      exit (0);
+    }
+
+
+This might look tedious, with all the initializing and clearing.  Fortunately
+some of these operations can be combined, and other operations can often be
+avoided.  An experienced GMP user might write:
+
+
+    #include <stdio.h>
+    #include <gmp.h>
+
+    main (int argc, char **argv)
+    {
+      mpz_t a, b, p;
+
+      if (argc != 3)
+        { printf ("Usage: %s <number> <number>\n", argv[0]); exit (1); }
+
+      /* Initialize and assign a and b from base 10 strings in argv */
+      mpz_init_set_str (a, argv[1], 10);
+      mpz_init_set_str (b, argv[2], 10);
+      /* Initialize p */
+      mpz_init (p);
+
+      /* Multiply a and b and put the result in p */
+      mpz_mul (p, a, b);
+
+      /* Print p in base 10 */
+      mpz_out_str (stdout, 10, p);
+      fputc ('\n', stdout);
+
+      /* Since we're about to exit, no need to clear out variables */
+      exit (0);
+    }
+
+
+Now you have to compile your test program, and link it with the GMP library.
+Assuming your working directory is still the gmp source directory, and your
+source file is called example.c, enter:
+
+	gcc -g -I. example.c .libs/libgmp.a
+
+After installing, the command becomes: "gcc -g example.c -lgmp".  Also, GMP is
+libtool based so you can use that to link if you want.
+
+Now try to run the example:
+
+	./a.out 98365871231256752134 319378318340103345227
+	31415926535897932384618573336104570964418
+
+The functions used here all operate on signed integers, and have names
+starting with "mpz_".  There are many more such functions than used in these
+examples.  See the chapter "Integer Functions" in the manual, for a complete
+list.
+
+There are two other main classes of functions in GMP.  They operate on
+rational numbers and floating-point numbers, respectively.  The chapters
+"Rational Number Functions", and "Floating-point Functions" document these
+classes.
+
+To run a set of tests, do "make check".  This will take a while.
+
+To create the printable documentation from the texinfo source, type "make
+gmp.dvi" or "make gmp.ps".  This requires various "tex" commands.
+
+To install the library, do "make install" (then you can use -lgmp instead of
+.libs/libgmp.a).
+
+If you decide to use GMP, it is a good idea you at least read the chapter "GMP
+Basics" in the manual.
+
+Some known build problems are noted in the "Installing GMP" chapter of
+the manual.  Please report other problems to bug-gmp@gnu.org.
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 78
+End:
diff --git a/src/gmp/Makefile.am b/src/gmp/Makefile.am
new file mode 100644
index 000000000..79bf65b41
--- /dev/null
+++ b/src/gmp/Makefile.am
@@ -0,0 +1,196 @@
+## Process this file with automake to generate Makefile.in
+
+
+# Copyright (C) 1991, 1993, 1994, 1996, 1997, 1999, 2000 Free Software
+# Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# make check
+#
+#     It'd be good if "make check" first did a "make all" or whatever to
+#     build libgmp.la, but it's not clear how best to do this.  Putting a
+#     "check:" target is overridden by automake, and a "check-local:" runs
+#     too late (due to depth-first subdirectory processing).  For now it's
+#     necessary to do "make && make check".
+#
+# MPF_OBJECTS etc
+#
+#     Libtool needs all the .lo files passed to it if it's going to build
+#     both a static and shared library.  If a convenience library like
+#     mpf/libmpf.la is passed then the resulting libgmp.a gets the PIC .lo
+#     objects rather than the non-PIC .o's.
+#
+#     Unfortunately this leads to the big lists of objects below.  Something
+#     like mpz/*.lo would probably work, but might risk missing something
+#     out or getting something extra.  The source files for each .lo are
+#     listed in the Makefile.am's in the subdirectories.
+
+
+# Libtool -version-info for libgmp.la and libmp.la.  See (libtool)Versioning
+#
+# 1. No interfaces changed, only implementations (good): Increment REVISION.
+#
+# 2. Interfaces added, none removed (good): Increment CURRENT, increment
+#    AGE, set REVISION to 0.
+#
+# 3. Interfaces removed (BAD, breaks upward compatibility): Increment
+#    CURRENT, set AGE and REVISION to 0.
+#
+# Do this separately for libgmp and libmp, only do it just before a release.
+#
+#	  GMP	   -version-info
+#	release   libgmp  libmp
+#	 2.0.x      -       -
+#	 3.0      3:0:0   3:0:0
+#        3.0.1    3:1:0   3:0:0
+#        3.1      4:0:1   4:0:1
+#
+#
+# Starting at 3:0:0 is a slight abuse of the versioning system, but it
+# ensures we're past soname libgmp.so.2, which is what has been used on
+# Debian GNU/Linux packages of gmp 2.  Pretend gmp 2 was 2:0:0, so the
+# interface changes for gmp 3 mean 3:0:0 is right.
+
+LIBGMP_LT_CURRENT =  4
+LIBGMP_LT_REVISION = 0
+LIBGMP_LT_AGE =      1
+
+LIBMP_LT_CURRENT =  4
+LIBMP_LT_REVISION = 0
+LIBMP_LT_AGE =      1
+
+
+AUTOMAKE_OPTIONS = gnu check-news no-dependencies ansi2knr
+
+SUBDIRS = mpn mpz mpq mpf mpbsd mpfr tests demos tune
+
+include_HEADERS = gmp.h $(MPBSD_HEADERS_OPTION) $(MPFR_HEADERS_OPTION)
+EXTRA_HEADERS = mp.h
+
+lib_LTLIBRARIES = libgmp.la $(MPBSD_LTLIBRARIES_OPTION)
+
+EXTRA_DIST = .gdbinit gmp-impl.h longlong.h stack-alloc.h urandom.h doc macos
+
+DISTCLEANFILES = asm-syntax.h config.m4 @gmp_srclinks@
+
+
+MPF_OBJECTS = mpf/init.lo mpf/init2.lo mpf/set.lo mpf/set_ui.lo mpf/set_si.lo \
+  mpf/set_str.lo mpf/set_d.lo mpf/set_z.lo mpf/iset.lo mpf/iset_ui.lo \
+  mpf/iset_si.lo mpf/iset_str.lo mpf/iset_d.lo mpf/clear.lo mpf/get_str.lo \
+  mpf/dump.lo mpf/size.lo mpf/eq.lo mpf/reldiff.lo mpf/sqrt.lo mpf/random2.lo \
+  mpf/inp_str.lo mpf/out_str.lo mpf/add.lo mpf/add_ui.lo mpf/sub.lo \
+  mpf/sub_ui.lo mpf/ui_sub.lo mpf/mul.lo mpf/mul_ui.lo mpf/div.lo \
+  mpf/div_ui.lo mpf/cmp.lo mpf/cmp_ui.lo mpf/cmp_si.lo mpf/mul_2exp.lo \
+  mpf/div_2exp.lo mpf/abs.lo mpf/neg.lo mpf/set_q.lo mpf/get_d.lo \
+  mpf/set_dfl_prec.lo mpf/set_prc.lo mpf/set_prc_raw.lo mpf/get_prc.lo \
+  mpf/ui_div.lo mpf/sqrt_ui.lo mpf/floor.lo mpf/ceil.lo mpf/trunc.lo \
+  mpf/pow_ui.lo mpf/urandomb.lo mpf/swap.lo
+MPZ_OBJECTS = mpz/abs.lo mpz/add.lo mpz/add_ui.lo mpz/addmul_ui.lo mpz/and.lo \
+  mpz/array_init.lo mpz/bin_ui.lo mpz/bin_uiui.lo mpz/cdiv_q.lo \
+  mpz/cdiv_q_ui.lo mpz/cdiv_qr.lo mpz/cdiv_qr_ui.lo mpz/cdiv_r.lo \
+  mpz/cdiv_r_ui.lo mpz/cdiv_ui.lo mpz/clear.lo mpz/clrbit.lo mpz/cmp.lo \
+  mpz/cmp_si.lo mpz/cmp_ui.lo mpz/cmpabs.lo mpz/cmpabs_ui.lo mpz/com.lo \
+  mpz/divexact.lo mpz/dump.lo mpz/fac_ui.lo mpz/fdiv_q.lo mpz/fdiv_q_2exp.lo \
+  mpz/fdiv_q_ui.lo mpz/fdiv_qr.lo mpz/fdiv_qr_ui.lo mpz/fdiv_r.lo \
+  mpz/fdiv_r_2exp.lo mpz/fdiv_r_ui.lo mpz/fdiv_ui.lo mpz/fib_ui.lo \
+  mpz/fits_sint_p.lo mpz/fits_slong_p.lo mpz/fits_sshort_p.lo \
+  mpz/fits_uint_p.lo mpz/fits_ulong_p.lo mpz/fits_ushort_p.lo mpz/gcd.lo \
+  mpz/gcd_ui.lo mpz/gcdext.lo mpz/get_d.lo mpz/get_si.lo mpz/get_str.lo \
+  mpz/get_ui.lo mpz/getlimbn.lo mpz/hamdist.lo mpz/init.lo mpz/inp_raw.lo \
+  mpz/inp_str.lo mpz/invert.lo mpz/ior.lo mpz/iset.lo mpz/iset_d.lo \
+  mpz/iset_si.lo mpz/iset_str.lo mpz/iset_ui.lo mpz/jacobi.lo \
+  mpz/kronsz.lo mpz/kronuz.lo mpz/kronzs.lo mpz/kronzu.lo \
+  mpz/lcm.lo mpz/legendre.lo \
+  mpz/mod.lo mpz/mul.lo mpz/mul_2exp.lo mpz/mul_si.lo mpz/mul_ui.lo \
+  mpz/neg.lo mpz/nextprime.lo mpz/out_raw.lo mpz/out_str.lo mpz/perfpow.lo mpz/perfsqr.lo \
+  mpz/popcount.lo mpz/pow_ui.lo mpz/powm.lo mpz/powm_ui.lo mpz/pprime_p.lo \
+  mpz/random.lo mpz/random2.lo mpz/realloc.lo mpz/remove.lo mpz/root.lo \
+  mpz/rrandomb.lo \
+  mpz/scan0.lo mpz/scan1.lo mpz/set.lo mpz/set_d.lo mpz/set_f.lo mpz/set_q.lo \
+  mpz/set_si.lo mpz/set_str.lo mpz/set_ui.lo mpz/setbit.lo mpz/size.lo \
+  mpz/sizeinbase.lo mpz/sqrt.lo mpz/sqrtrem.lo mpz/sub.lo mpz/sub_ui.lo \
+  mpz/swap.lo mpz/tdiv_ui.lo mpz/tdiv_q.lo mpz/tdiv_q_2exp.lo mpz/tdiv_q_ui.lo \
+  mpz/tdiv_qr.lo mpz/tdiv_qr_ui.lo mpz/tdiv_r.lo mpz/tdiv_r_2exp.lo \
+  mpz/tdiv_r_ui.lo mpz/tstbit.lo mpz/ui_pow_ui.lo mpz/urandomb.lo \
+  mpz/urandomm.lo mpz/xor.lo
+MPQ_OBJECTS = mpq/add.lo mpq/canonicalize.lo mpq/clear.lo mpq/cmp.lo \
+  mpq/cmp_ui.lo mpq/div.lo mpq/get_d.lo mpq/get_den.lo mpq/get_num.lo \
+  mpq/init.lo mpq/inv.lo mpq/mul.lo mpq/neg.lo mpq/out_str.lo \
+  mpq/set.lo mpq/set_den.lo \
+  mpq/set_num.lo mpq/set_si.lo mpq/set_ui.lo mpq/sub.lo mpq/equal.lo \
+  mpq/set_z.lo mpq/set_d.lo mpq/swap.lo
+MPN_OBJECTS = @mpn_objs_in_libgmp@
+
+MPBSD_OBJECTS = mpbsd/add.lo mpbsd/tdiv_qr.lo mpbsd/move.lo mpbsd/powm.lo \
+  mpbsd/sub.lo mpbsd/cmp.lo mpbsd/mfree.lo mpbsd/mtox.lo mpbsd/realloc.lo \
+  mpbsd/gcd.lo mpbsd/itom.lo mpbsd/min.lo mpbsd/mul.lo mpbsd/mout.lo	  \
+  mpbsd/pow_ui.lo mpbsd/sdiv.lo mpbsd/sqrtrem.lo mpbsd/xtom.lo 
+
+# FIXME: Add mpfr/rnd_mode.lo when it's clean.
+MPFR_OBJECTS = mpfr/add.lo mpfr/div_2exp.lo mpfr/neg.lo mpfr/set_dfl_prec.lo \
+  mpfr/set_str_raw.lo mpfr/agm.lo mpfr/get_str.lo mpfr/print_raw.lo \
+  mpfr/set_dfl_rnd.lo mpfr/sqrt.lo mpfr/clear.lo mpfr/init.lo \
+  mpfr/set_f.lo mpfr/sub.lo mpfr/cmp.lo mpfr/mul.lo mpfr/round.lo \
+  mpfr/set_prec.lo mpfr/cmp_ui.lo mpfr/mul_2exp.lo mpfr/set.lo mpfr/set_si.lo \
+  mpfr/div.lo mpfr/mul_ui.lo mpfr/set_d.lo mpfr/pow.lo mpfr/out_str.lo \
+  mpfr/pi.lo mpfr/set_z.lo mpfr/add_ulp.lo mpfr/log2.lo mpfr/random.lo \
+  mpfr/log.lo mpfr/exp.lo mpfr/div_ui.lo mpfr/zeta.lo mpfr/karadiv.lo \
+  mpfr/karasqrt.lo mpfr/print_rnd_mode.lo
+
+
+if WANT_MPFR
+MPFR_HEADERS_OPTION = mpfr/mpfr.h
+MPFR_OBJECTS_OPTION = $(MPFR_OBJECTS)
+MPFR_LIBADD_OPTION = -lm
+endif
+libgmp_la_SOURCES = assert.c compat.c errno.c memory.c mp_set_fns.c	 \
+  mp_clz_tab.c mp_minv_tab.c						 \
+  rand.c randclr.c randlc.c randlc2x.c randraw.c randsd.c		 \
+  randsdui.c version.c stack-alloc.c mp_bpl.c extract-dbl.c insert-dbl.c
+libgmp_la_DEPENDENCIES = \
+  $(MPF_OBJECTS) $(MPZ_OBJECTS) $(MPN_OBJECTS) $(MPQ_OBJECTS) \
+  $(MPFR_OBJECTS_OPTION)
+libgmp_la_LIBADD = $(libgmp_la_DEPENDENCIES) $(MPFR_LIBADD_OPTION)
+libgmp_la_LDFLAGS = \
+  -version-info $(LIBGMP_LT_CURRENT):$(LIBGMP_LT_REVISION):$(LIBGMP_LT_AGE)
+
+
+if WANT_MPBSD
+MPBSD_HEADERS_OPTION = mp.h
+MPBSD_LTLIBRARIES_OPTION = libmp.la
+endif
+libmp_la_SOURCES = assert.c errno.c memory.c mp_bpl.c mp_clz_tab.c	\
+  mp_minv_tab.c mp_set_fns.c stack-alloc.c
+libmp_la_DEPENDENCIES = $(MPBSD_OBJECTS) $(MPN_OBJECTS)			\
+  mpz/add.lo mpz/clear.lo mpz/cmp.lo mpz/init.lo mpz/mod.lo mpz/mul.lo	\
+  mpz/mul_2exp.lo mpz/realloc.lo mpz/set.lo mpz/set_ui.lo mpz/tdiv_r.lo	\
+  mpz/sub.lo
+libmp_la_LIBADD = $(libmp_la_DEPENDENCIES)
+libmp_la_LDFLAGS = \
+  -version-info $(LIBMP_LT_CURRENT):$(LIBMP_LT_REVISION):$(LIBMP_LT_AGE)
+
+
+info_TEXINFOS = gmp.texi
+
+
+# Don't ship CVS directories or emacs backups.
+dist-hook:
+	-find $(distdir) \( -name CVS -type d \) -o -name "*.~*" \
+		| xargs rm -rf
diff --git a/src/gmp/Makefile.in b/src/gmp/Makefile.in
new file mode 100644
index 000000000..957323748
--- /dev/null
+++ b/src/gmp/Makefile.in
@@ -0,0 +1,957 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 1991, 1993, 1994, 1996, 1997, 1999, 2000 Free Software
+# Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+# make check
+#
+#     It'd be good if "make check" first did a "make all" or whatever to
+#     build libgmp.la, but it's not clear how best to do this.  Putting a
+#     "check:" target is overridden by automake, and a "check-local:" runs
+#     too late (due to depth-first subdirectory processing).  For now it's
+#     necessary to do "make && make check".
+#
+# MPF_OBJECTS etc
+#
+#     Libtool needs all the .lo files passed to it if it's going to build
+#     both a static and shared library.  If a convenience library like
+#     mpf/libmpf.la is passed then the resulting libgmp.a gets the PIC .lo
+#     objects rather than the non-PIC .o's.
+#
+#     Unfortunately this leads to the big lists of objects below.  Something
+#     like mpz/*.lo would probably work, but might risk missing something
+#     out or getting something extra.  The source files for each .lo are
+#     listed in the Makefile.am's in the subdirectories.
+
+# Libtool -version-info for libgmp.la and libmp.la.  See (libtool)Versioning
+#
+# 1. No interfaces changed, only implementations (good): Increment REVISION.
+#
+# 2. Interfaces added, none removed (good): Increment CURRENT, increment
+#    AGE, set REVISION to 0.
+#
+# 3. Interfaces removed (BAD, breaks upward compatibility): Increment
+#    CURRENT, set AGE and REVISION to 0.
+#
+# Do this separately for libgmp and libmp, only do it just before a release.
+#
+#	  GMP	   -version-info
+#	release   libgmp  libmp
+#	 2.0.x      -       -
+#	 3.0      3:0:0   3:0:0
+#        3.0.1    3:1:0   3:0:0
+#        3.1      4:0:1   4:0:1
+#
+#
+# Starting at 3:0:0 is a slight abuse of the versioning system, but it
+# ensures we're past soname libgmp.so.2, which is what has been used on
+# Debian GNU/Linux packages of gmp 2.  Pretend gmp 2 was 2:0:0, so the
+# interface changes for gmp 3 mean 3:0:0 is right.
+
+
+LIBGMP_LT_CURRENT = 4
+LIBGMP_LT_REVISION = 0
+LIBGMP_LT_AGE = 1
+
+LIBMP_LT_CURRENT = 4
+LIBMP_LT_REVISION = 0
+LIBMP_LT_AGE = 1
+
+AUTOMAKE_OPTIONS = gnu check-news no-dependencies ansi2knr
+
+SUBDIRS = mpn mpz mpq mpf mpbsd mpfr tests demos tune
+
+include_HEADERS = gmp.h $(MPBSD_HEADERS_OPTION) $(MPFR_HEADERS_OPTION)
+EXTRA_HEADERS = mp.h
+
+lib_LTLIBRARIES = libgmp.la $(MPBSD_LTLIBRARIES_OPTION)
+
+EXTRA_DIST = .gdbinit gmp-impl.h longlong.h stack-alloc.h urandom.h doc macos
+
+DISTCLEANFILES = asm-syntax.h config.m4 @gmp_srclinks@
+
+MPF_OBJECTS = mpf/init.lo mpf/init2.lo mpf/set.lo mpf/set_ui.lo mpf/set_si.lo \
+  mpf/set_str.lo mpf/set_d.lo mpf/set_z.lo mpf/iset.lo mpf/iset_ui.lo \
+  mpf/iset_si.lo mpf/iset_str.lo mpf/iset_d.lo mpf/clear.lo mpf/get_str.lo \
+  mpf/dump.lo mpf/size.lo mpf/eq.lo mpf/reldiff.lo mpf/sqrt.lo mpf/random2.lo \
+  mpf/inp_str.lo mpf/out_str.lo mpf/add.lo mpf/add_ui.lo mpf/sub.lo \
+  mpf/sub_ui.lo mpf/ui_sub.lo mpf/mul.lo mpf/mul_ui.lo mpf/div.lo \
+  mpf/div_ui.lo mpf/cmp.lo mpf/cmp_ui.lo mpf/cmp_si.lo mpf/mul_2exp.lo \
+  mpf/div_2exp.lo mpf/abs.lo mpf/neg.lo mpf/set_q.lo mpf/get_d.lo \
+  mpf/set_dfl_prec.lo mpf/set_prc.lo mpf/set_prc_raw.lo mpf/get_prc.lo \
+  mpf/ui_div.lo mpf/sqrt_ui.lo mpf/floor.lo mpf/ceil.lo mpf/trunc.lo \
+  mpf/pow_ui.lo mpf/urandomb.lo mpf/swap.lo
+
+MPZ_OBJECTS = mpz/abs.lo mpz/add.lo mpz/add_ui.lo mpz/addmul_ui.lo mpz/and.lo \
+  mpz/array_init.lo mpz/bin_ui.lo mpz/bin_uiui.lo mpz/cdiv_q.lo \
+  mpz/cdiv_q_ui.lo mpz/cdiv_qr.lo mpz/cdiv_qr_ui.lo mpz/cdiv_r.lo \
+  mpz/cdiv_r_ui.lo mpz/cdiv_ui.lo mpz/clear.lo mpz/clrbit.lo mpz/cmp.lo \
+  mpz/cmp_si.lo mpz/cmp_ui.lo mpz/cmpabs.lo mpz/cmpabs_ui.lo mpz/com.lo \
+  mpz/divexact.lo mpz/dump.lo mpz/fac_ui.lo mpz/fdiv_q.lo mpz/fdiv_q_2exp.lo \
+  mpz/fdiv_q_ui.lo mpz/fdiv_qr.lo mpz/fdiv_qr_ui.lo mpz/fdiv_r.lo \
+  mpz/fdiv_r_2exp.lo mpz/fdiv_r_ui.lo mpz/fdiv_ui.lo mpz/fib_ui.lo \
+  mpz/fits_sint_p.lo mpz/fits_slong_p.lo mpz/fits_sshort_p.lo \
+  mpz/fits_uint_p.lo mpz/fits_ulong_p.lo mpz/fits_ushort_p.lo mpz/gcd.lo \
+  mpz/gcd_ui.lo mpz/gcdext.lo mpz/get_d.lo mpz/get_si.lo mpz/get_str.lo \
+  mpz/get_ui.lo mpz/getlimbn.lo mpz/hamdist.lo mpz/init.lo mpz/inp_raw.lo \
+  mpz/inp_str.lo mpz/invert.lo mpz/ior.lo mpz/iset.lo mpz/iset_d.lo \
+  mpz/iset_si.lo mpz/iset_str.lo mpz/iset_ui.lo mpz/jacobi.lo \
+  mpz/kronsz.lo mpz/kronuz.lo mpz/kronzs.lo mpz/kronzu.lo \
+  mpz/lcm.lo mpz/legendre.lo \
+  mpz/mod.lo mpz/mul.lo mpz/mul_2exp.lo mpz/mul_si.lo mpz/mul_ui.lo \
+  mpz/neg.lo mpz/nextprime.lo mpz/out_raw.lo mpz/out_str.lo mpz/perfpow.lo mpz/perfsqr.lo \
+  mpz/popcount.lo mpz/pow_ui.lo mpz/powm.lo mpz/powm_ui.lo mpz/pprime_p.lo \
+  mpz/random.lo mpz/random2.lo mpz/realloc.lo mpz/remove.lo mpz/root.lo \
+  mpz/rrandomb.lo \
+  mpz/scan0.lo mpz/scan1.lo mpz/set.lo mpz/set_d.lo mpz/set_f.lo mpz/set_q.lo \
+  mpz/set_si.lo mpz/set_str.lo mpz/set_ui.lo mpz/setbit.lo mpz/size.lo \
+  mpz/sizeinbase.lo mpz/sqrt.lo mpz/sqrtrem.lo mpz/sub.lo mpz/sub_ui.lo \
+  mpz/swap.lo mpz/tdiv_ui.lo mpz/tdiv_q.lo mpz/tdiv_q_2exp.lo mpz/tdiv_q_ui.lo \
+  mpz/tdiv_qr.lo mpz/tdiv_qr_ui.lo mpz/tdiv_r.lo mpz/tdiv_r_2exp.lo \
+  mpz/tdiv_r_ui.lo mpz/tstbit.lo mpz/ui_pow_ui.lo mpz/urandomb.lo \
+  mpz/urandomm.lo mpz/xor.lo
+
+MPQ_OBJECTS = mpq/add.lo mpq/canonicalize.lo mpq/clear.lo mpq/cmp.lo \
+  mpq/cmp_ui.lo mpq/div.lo mpq/get_d.lo mpq/get_den.lo mpq/get_num.lo \
+  mpq/init.lo mpq/inv.lo mpq/mul.lo mpq/neg.lo mpq/out_str.lo \
+  mpq/set.lo mpq/set_den.lo \
+  mpq/set_num.lo mpq/set_si.lo mpq/set_ui.lo mpq/sub.lo mpq/equal.lo \
+  mpq/set_z.lo mpq/set_d.lo mpq/swap.lo
+
+MPN_OBJECTS = @mpn_objs_in_libgmp@
+
+MPBSD_OBJECTS = mpbsd/add.lo mpbsd/tdiv_qr.lo mpbsd/move.lo mpbsd/powm.lo \
+  mpbsd/sub.lo mpbsd/cmp.lo mpbsd/mfree.lo mpbsd/mtox.lo mpbsd/realloc.lo \
+  mpbsd/gcd.lo mpbsd/itom.lo mpbsd/min.lo mpbsd/mul.lo mpbsd/mout.lo	  \
+  mpbsd/pow_ui.lo mpbsd/sdiv.lo mpbsd/sqrtrem.lo mpbsd/xtom.lo 
+
+
+# FIXME: Add mpfr/rnd_mode.lo when it's clean.
+MPFR_OBJECTS = mpfr/add.lo mpfr/div_2exp.lo mpfr/neg.lo mpfr/set_dfl_prec.lo \
+  mpfr/set_str_raw.lo mpfr/agm.lo mpfr/get_str.lo mpfr/print_raw.lo \
+  mpfr/set_dfl_rnd.lo mpfr/sqrt.lo mpfr/clear.lo mpfr/init.lo \
+  mpfr/set_f.lo mpfr/sub.lo mpfr/cmp.lo mpfr/mul.lo mpfr/round.lo \
+  mpfr/set_prec.lo mpfr/cmp_ui.lo mpfr/mul_2exp.lo mpfr/set.lo mpfr/set_si.lo \
+  mpfr/div.lo mpfr/mul_ui.lo mpfr/set_d.lo mpfr/pow.lo mpfr/out_str.lo \
+  mpfr/pi.lo mpfr/set_z.lo mpfr/add_ulp.lo mpfr/log2.lo mpfr/random.lo \
+  mpfr/log.lo mpfr/exp.lo mpfr/div_ui.lo mpfr/zeta.lo mpfr/karadiv.lo \
+  mpfr/karasqrt.lo mpfr/print_rnd_mode.lo
+
+
+@WANT_MPFR_TRUE@MPFR_HEADERS_OPTION = @WANT_MPFR_TRUE@mpfr/mpfr.h
+@WANT_MPFR_TRUE@MPFR_OBJECTS_OPTION = @WANT_MPFR_TRUE@$(MPFR_OBJECTS)
+@WANT_MPFR_TRUE@MPFR_LIBADD_OPTION = @WANT_MPFR_TRUE@-lm
+libgmp_la_SOURCES = assert.c compat.c errno.c memory.c mp_set_fns.c	 \
+  mp_clz_tab.c mp_minv_tab.c						 \
+  rand.c randclr.c randlc.c randlc2x.c randraw.c randsd.c		 \
+  randsdui.c version.c stack-alloc.c mp_bpl.c extract-dbl.c insert-dbl.c
+
+libgmp_la_DEPENDENCIES = \
+  $(MPF_OBJECTS) $(MPZ_OBJECTS) $(MPN_OBJECTS) $(MPQ_OBJECTS) \
+  $(MPFR_OBJECTS_OPTION)
+
+libgmp_la_LIBADD = $(libgmp_la_DEPENDENCIES) $(MPFR_LIBADD_OPTION)
+libgmp_la_LDFLAGS = \
+  -version-info $(LIBGMP_LT_CURRENT):$(LIBGMP_LT_REVISION):$(LIBGMP_LT_AGE)
+
+
+@WANT_MPBSD_TRUE@MPBSD_HEADERS_OPTION = @WANT_MPBSD_TRUE@mp.h
+@WANT_MPBSD_TRUE@MPBSD_LTLIBRARIES_OPTION = @WANT_MPBSD_TRUE@libmp.la
+libmp_la_SOURCES = assert.c errno.c memory.c mp_bpl.c mp_clz_tab.c	\
+  mp_minv_tab.c mp_set_fns.c stack-alloc.c
+
+libmp_la_DEPENDENCIES = $(MPBSD_OBJECTS) $(MPN_OBJECTS)			\
+  mpz/add.lo mpz/clear.lo mpz/cmp.lo mpz/init.lo mpz/mod.lo mpz/mul.lo	\
+  mpz/mul_2exp.lo mpz/realloc.lo mpz/set.lo mpz/set_ui.lo mpz/tdiv_r.lo	\
+  mpz/sub.lo
+
+libmp_la_LIBADD = $(libmp_la_DEPENDENCIES)
+libmp_la_LDFLAGS = \
+  -version-info $(LIBMP_LT_CURRENT):$(LIBMP_LT_REVISION):$(LIBMP_LT_AGE)
+
+
+info_TEXINFOS = gmp.texi
+subdir = .
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = config.h
+CONFIG_CLEAN_FILES = 
+LTLIBRARIES =  $(lib_LTLIBRARIES)
+
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I.
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+ANSI2KNR = @ANSI2KNR@
+am_libgmp_la_OBJECTS =  assert$U.lo compat$U.lo errno$U.lo memory$U.lo \
+mp_set_fns$U.lo mp_clz_tab$U.lo mp_minv_tab$U.lo rand$U.lo randclr$U.lo \
+randlc$U.lo randlc2x$U.lo randraw$U.lo randsd$U.lo randsdui$U.lo \
+version$U.lo stack-alloc$U.lo mp_bpl$U.lo extract-dbl$U.lo \
+insert-dbl$U.lo
+libgmp_la_OBJECTS =  $(am_libgmp_la_OBJECTS)
+am_libmp_la_OBJECTS =  assert$U.lo errno$U.lo memory$U.lo mp_bpl$U.lo \
+mp_clz_tab$U.lo mp_minv_tab$U.lo mp_set_fns$U.lo stack-alloc$U.lo
+libmp_la_OBJECTS =  $(am_libmp_la_OBJECTS)
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(libgmp_la_SOURCES) $(libmp_la_SOURCES)
+TEXI2DVI = texi2dvi
+INFO_DEPS = gmp.info
+DVIS = gmp.dvi
+TEXINFOS = gmp.texi
+HEADERS =  $(include_HEADERS)
+
+DIST_COMMON =  README $(EXTRA_HEADERS) $(include_HEADERS) ./stamp-h.in \
+AUTHORS COPYING COPYING.LIB ChangeLog INSTALL Makefile.am Makefile.in \
+NEWS acconfig.h acinclude.m4 aclocal.m4 ansi2knr.1 ansi2knr.c \
+config.guess config.in config.sub configure configure.in depcomp \
+install-sh ltconfig ltmain.sh mdate-sh missing mkinstalldirs stamp-vti \
+texinfo.tex version.texi
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(libgmp_la_SOURCES) $(libmp_la_SOURCES)
+OBJECTS = $(am_libgmp_la_OBJECTS) $(am_libmp_la_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .dvi .info .lo .o .obj .ps .texi .texinfo .txi
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ configure.in  acinclude.m4
+	cd $(srcdir) && $(ACLOCAL)
+
+config.status: $(srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+	$(SHELL) ./config.status --recheck
+$(srcdir)/configure: @MAINTAINER_MODE_TRUE@$(srcdir)/configure.in $(ACLOCAL_M4) $(CONFIGURE_DEPENDENCIES)
+	cd $(srcdir) && $(AUTOCONF)
+
+config.h: stamp-h
+	@if test ! -f $@; then \
+		rm -f stamp-h; \
+		$(MAKE) stamp-h; \
+	else :; fi
+stamp-h: $(srcdir)/config.in $(top_builddir)/config.status
+	@rm -f stamp-h stamp-hT
+	@echo timestamp > stamp-hT 2> /dev/null
+	cd $(top_builddir) \
+	  && CONFIG_FILES= CONFIG_HEADERS=config.h:config.in \
+	     $(SHELL) ./config.status
+	@mv stamp-hT stamp-h
+$(srcdir)/config.in: @MAINTAINER_MODE_TRUE@$(srcdir)/./stamp-h.in
+	@if test ! -f $@; then \
+		rm -f $(srcdir)/./stamp-h.in; \
+		$(MAKE) $(srcdir)/./stamp-h.in; \
+	else :; fi
+$(srcdir)/./stamp-h.in: $(top_srcdir)/configure.in $(ACLOCAL_M4) acconfig.h
+	@rm -f $(srcdir)/./stamp-h.in $(srcdir)/./stamp-h.inT
+	@echo timestamp > $(srcdir)/./stamp-h.inT 2> /dev/null
+	cd $(top_srcdir) && $(AUTOHEADER)
+	@mv $(srcdir)/./stamp-h.inT $(srcdir)/./stamp-h.in
+
+mostlyclean-hdr:
+
+clean-hdr:
+
+distclean-hdr:
+	-rm -f config.h
+
+maintainer-clean-hdr:
+
+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) $(INSTALL_STRIP_FLAG) $$p $(DESTDIR)$(libdir)/$$p"; \
+	    $(LIBTOOL)  --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$p $(DESTDIR)$(libdir)/$$p; \
+	  else :; fi; \
+	done
+
+uninstall-libLTLIBRARIES:
+	@$(NORMAL_UNINSTALL)
+	@list='$(lib_LTLIBRARIES)'; for p in $$list; do \
+	  echo " $(LIBTOOL)  --mode=uninstall rm -f $(DESTDIR)$(libdir)/$$p"; \
+	  $(LIBTOOL)  --mode=uninstall rm -f $(DESTDIR)$(libdir)/$$p; \
+	done
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+
+mostlyclean-krextra:
+
+clean-krextra:
+	-rm -f ansi2knr
+
+distclean-krextra:
+
+maintainer-clean-krextra:
+ansi2knr: ansi2knr.$(OBJEXT)
+	$(LINK) ansi2knr.$(OBJEXT) $(LIBS)
+ansi2knr.$(OBJEXT): $(CONFIG_HEADER)
+
+
+mostlyclean-kr:
+	-rm -f *_.c
+
+clean-kr:
+
+distclean-kr:
+
+maintainer-clean-kr:
+
+libgmp.la: $(libgmp_la_OBJECTS) $(libgmp_la_DEPENDENCIES)
+	$(LINK) -rpath $(libdir) $(libgmp_la_LDFLAGS) $(libgmp_la_OBJECTS) $(libgmp_la_LIBADD) $(LIBS)
+
+libmp.la: $(libmp_la_OBJECTS) $(libmp_la_DEPENDENCIES)
+	$(LINK) -rpath $(libdir) $(libmp_la_LDFLAGS) $(libmp_la_OBJECTS) $(libmp_la_LIBADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+assert_.c: assert.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/assert.c; then echo $(srcdir)/assert.c; else echo assert.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > assert_.c
+compat_.c: compat.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/compat.c; then echo $(srcdir)/compat.c; else echo compat.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > compat_.c
+errno_.c: errno.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/errno.c; then echo $(srcdir)/errno.c; else echo errno.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > errno_.c
+extract-dbl_.c: extract-dbl.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/extract-dbl.c; then echo $(srcdir)/extract-dbl.c; else echo extract-dbl.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > extract-dbl_.c
+insert-dbl_.c: insert-dbl.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/insert-dbl.c; then echo $(srcdir)/insert-dbl.c; else echo insert-dbl.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > insert-dbl_.c
+memory_.c: memory.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/memory.c; then echo $(srcdir)/memory.c; else echo memory.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > memory_.c
+mp_bpl_.c: mp_bpl.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/mp_bpl.c; then echo $(srcdir)/mp_bpl.c; else echo mp_bpl.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > mp_bpl_.c
+mp_clz_tab_.c: mp_clz_tab.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/mp_clz_tab.c; then echo $(srcdir)/mp_clz_tab.c; else echo mp_clz_tab.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > mp_clz_tab_.c
+mp_minv_tab_.c: mp_minv_tab.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/mp_minv_tab.c; then echo $(srcdir)/mp_minv_tab.c; else echo mp_minv_tab.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > mp_minv_tab_.c
+mp_set_fns_.c: mp_set_fns.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/mp_set_fns.c; then echo $(srcdir)/mp_set_fns.c; else echo mp_set_fns.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > mp_set_fns_.c
+rand_.c: rand.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/rand.c; then echo $(srcdir)/rand.c; else echo rand.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > rand_.c
+randclr_.c: randclr.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randclr.c; then echo $(srcdir)/randclr.c; else echo randclr.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randclr_.c
+randlc_.c: randlc.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randlc.c; then echo $(srcdir)/randlc.c; else echo randlc.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randlc_.c
+randlc2x_.c: randlc2x.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randlc2x.c; then echo $(srcdir)/randlc2x.c; else echo randlc2x.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randlc2x_.c
+randraw_.c: randraw.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randraw.c; then echo $(srcdir)/randraw.c; else echo randraw.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randraw_.c
+randsd_.c: randsd.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randsd.c; then echo $(srcdir)/randsd.c; else echo randsd.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randsd_.c
+randsdui_.c: randsdui.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randsdui.c; then echo $(srcdir)/randsdui.c; else echo randsdui.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randsdui_.c
+stack-alloc_.c: stack-alloc.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/stack-alloc.c; then echo $(srcdir)/stack-alloc.c; else echo stack-alloc.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > stack-alloc_.c
+version_.c: version.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/version.c; then echo $(srcdir)/version.c; else echo version.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > version_.c
+assert_.$(OBJEXT) assert_.lo compat_.$(OBJEXT) compat_.lo \
+errno_.$(OBJEXT) errno_.lo extract-dbl_.$(OBJEXT) extract-dbl_.lo \
+insert-dbl_.$(OBJEXT) insert-dbl_.lo memory_.$(OBJEXT) memory_.lo \
+mp_bpl_.$(OBJEXT) mp_bpl_.lo mp_clz_tab_.$(OBJEXT) mp_clz_tab_.lo \
+mp_minv_tab_.$(OBJEXT) mp_minv_tab_.lo mp_set_fns_.$(OBJEXT) \
+mp_set_fns_.lo rand_.$(OBJEXT) rand_.lo randclr_.$(OBJEXT) randclr_.lo \
+randlc_.$(OBJEXT) randlc_.lo randlc2x_.$(OBJEXT) randlc2x_.lo \
+randraw_.$(OBJEXT) randraw_.lo randsd_.$(OBJEXT) randsd_.lo \
+randsdui_.$(OBJEXT) randsdui_.lo stack-alloc_.$(OBJEXT) stack-alloc_.lo \
+version_.$(OBJEXT) version_.lo : $(ANSI2KNR)
+
+$(srcdir)/version.texi: @MAINTAINER_MODE_TRUE@stamp-vti
+	@:
+
+$(srcdir)/stamp-vti: gmp.texi $(top_srcdir)/configure.in
+	@echo "@set UPDATED `$(SHELL) $(srcdir)/mdate-sh $(srcdir)/gmp.texi`" > vti.tmp
+	@echo "@set EDITION $(VERSION)" >> vti.tmp
+	@echo "@set VERSION $(VERSION)" >> vti.tmp
+	@cmp -s vti.tmp $(srcdir)/version.texi \
+	  || (echo "Updating $(srcdir)/version.texi"; \
+	      cp vti.tmp $(srcdir)/version.texi)
+	-@rm -f vti.tmp
+	@cp $(srcdir)/version.texi $@
+
+mostlyclean-vti:
+	-rm -f vti.tmp
+
+clean-vti:
+
+distclean-vti:
+
+maintainer-clean-vti:
+	-@MAINTAINER_MODE_TRUE@rm -f $(srcdir)/stamp-vti $(srcdir)/version.texi
+
+gmp.info: gmp.texi version.texi
+gmp.dvi: gmp.texi version.texi
+
+
+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)
+	@list='$(INFO_DEPS)'; \
+	for file in $$list; do \
+	  d=$(srcdir); \
+	  for ifile in `CDPATH=: && 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 \
+	  list='$(INFO_DEPS)'; \
+	  for file in $$list; 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 \
+	  list='$(INFO_DEPS)'; \
+	  for file in $$list; do \
+	    echo " install-info --info-dir=$(DESTDIR)$(infodir) --remove $(DESTDIR)$(infodir)/$$file"; \
+	    install-info --info-dir=$(DESTDIR)$(infodir) --remove $(DESTDIR)$(infodir)/$$file; \
+	  done; \
+	else :; fi
+	@$(NORMAL_UNINSTALL)
+	@list='$(INFO_DEPS)'; \
+	for file in $$list; do \
+	  (if cd $(DESTDIR)$(infodir); then \
+	     echo " rm -f $$file $$file-[0-9] $$file-[0-9][0-9])"; \
+	     rm -f $$file $$file-[0-9] $$file-[0-9][0-9]; \
+	   else :; fi); \
+	done
+
+dist-info: $(INFO_DEPS)
+	list='$(INFO_DEPS)'; \
+	for base in $$list; do \
+	  d=$(srcdir); \
+	  for file in `CDPATH=: && cd $$d && eval echo $$base*`; do \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file; \
+	  done; \
+	done
+
+mostlyclean-aminfo:
+	-rm -f gmp.aux gmp.cp gmp.cps gmp.dvi gmp.fn gmp.fns gmp.pgs gmp.ky \
+	  gmp.kys gmp.ps gmp.log gmp.pg gmp.toc gmp.tp gmp.tps gmp.vr \
+	  gmp.vrs gmp.op gmp.tr gmp.cv gmp.cn gmp.cm gmp.ov
+
+clean-aminfo:
+
+distclean-aminfo:
+
+maintainer-clean-aminfo:
+	cd $(srcdir) && 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
+
+install-includeHEADERS: $(include_HEADERS)
+	@$(NORMAL_INSTALL)
+	$(mkinstalldirs) $(DESTDIR)$(includedir)
+	@list='$(include_HEADERS)'; for p in $$list; do \
+	  if test -f "$$p"; then d= ; else d="$(srcdir)/"; fi; \
+	  f="`echo $$p | sed -e 's|^.*/||'`"; \
+	  echo " $(INSTALL_DATA) $$d$$p $(DESTDIR)$(includedir)/$$f"; \
+	  $(INSTALL_DATA) $$d$$p $(DESTDIR)$(includedir)/$$f; \
+	done
+
+uninstall-includeHEADERS:
+	@$(NORMAL_UNINSTALL)
+	@list='$(include_HEADERS)'; for p in $$list; do \
+	  f="`echo $$p | sed -e 's|^.*/||'`"; \
+	  echo " rm -f $(DESTDIR)$(includedir)/$$f"; \
+	  rm -f $(DESTDIR)$(includedir)/$$f; \
+	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.
+
+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; \
+	dot_seen=no; \
+	target=`echo $@ | sed s/-recursive//`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    dot_seen=yes; \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+	done; \
+	if test "$$dot_seen" = "no"; then \
+	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+	fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+	@set fnord $(MAKEFLAGS); amf=$$2; \
+	dot_seen=no; \
+	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
+	  rev="$$subdir $$rev"; \
+	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
+	done; \
+	test "$$dot_seen" = "no" && rev=". $$rev"; \
+	target=`echo $@ | sed s/-recursive//`; \
+	for subdir in $$rev; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_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 \
+	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+	done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES) config.in $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+   if test "$$subdir" = .; then :; else \
+	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+   fi; \
+	done; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)config.in$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags config.in $$unique $(LISP)
+
+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
+	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
+	GZIP=$(GZIP_ENV) gunzip -c $(distdir).tar.gz | $(AMTAR) xf -
+	chmod -R a-w $(distdir); chmod a+w $(distdir)
+	mkdir $(distdir)/=build
+	mkdir $(distdir)/=inst
+	chmod a-w $(distdir)
+	dc_install_base=`CDPATH=: && cd $(distdir)/=inst && pwd` \
+	  && cd $(distdir)/=build \
+	  && ../configure --srcdir=.. --prefix=$$dc_install_base \
+	  && $(MAKE) $(AM_MAKEFLAGS) \
+	  && $(MAKE) $(AM_MAKEFLAGS) dvi \
+	  && $(MAKE) $(AM_MAKEFLAGS) check \
+	  && $(MAKE) $(AM_MAKEFLAGS) install \
+	  && $(MAKE) $(AM_MAKEFLAGS) installcheck \
+	  && $(MAKE) $(AM_MAKEFLAGS) uninstall \
+	  && test `find $$dc_install_base -type f -print | wc -l` -le 1 \
+	  && $(MAKE) $(AM_MAKEFLAGS) dist \
+	  && $(MAKE) $(AM_MAKEFLAGS) distclean \
+	  && rm -f $(distdir).tar.gz \
+	  && test `find . -type f -print | wc -l` -eq 0
+	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
+	@banner="$(distdir).tar.gz is ready for distribution"; \
+	dashes=`echo "$$banner" | sed s/./=/g`; \
+	echo "$$dashes"; \
+	echo "$$banner"; \
+	echo "$$dashes"
+dist: distdir
+	-find $(distdir) -type d ! -perm -777 -exec chmod a+rwx {} \; -o \
+	  ! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \
+	  ! -type d ! -perm -400 -exec chmod a+r {} \; -o \
+	  ! -type d ! -perm -444 -exec $(SHELL) $(install_sh) -c -m a+r {} {} \; \
+	|| chmod -R a+r $(distdir)
+	$(AMTAR) chof - $(distdir) | GZIP=$(GZIP_ENV) gzip -c > $(distdir).tar.gz
+	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
+dist-all: distdir
+	-find $(distdir) -type d ! -perm -777 -exec chmod a+rwx {} \; -o \
+	  ! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \
+	  ! -type d ! -perm -400 -exec chmod a+r {} \; -o \
+	  ! -type d ! -perm -444 -exec $(SHELL) $(install_sh) -c -m a+r {} {} \; \
+	|| chmod -R a+r $(distdir)
+	$(AMTAR) chof - $(distdir) | GZIP=$(GZIP_ENV) gzip -c > $(distdir).tar.gz
+	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
+distdir: $(DISTFILES)
+	@if sed 15q $(srcdir)/NEWS | fgrep -e "$(VERSION)" > /dev/null; then :; else \
+	  echo "NEWS not updated; not releasing" 1>&2; \
+	  exit 1; \
+	fi
+	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
+	mkdir $(distdir)
+	$(mkinstalldirs) $(distdir)/mpfr
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+	for subdir in $(SUBDIRS); do \
+	  if test "$$subdir" = .; then :; else \
+	    test -d $(distdir)/$$subdir \
+	    || mkdir $(distdir)/$$subdir \
+	    || exit 1; \
+	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(distdir) distdir=../$(distdir)/$$subdir distdir) \
+	      || exit 1; \
+	  fi; \
+	done
+	$(MAKE) $(AM_MAKEFLAGS) top_distdir="$(top_distdir)" distdir="$(distdir)" dist-info
+	$(MAKE) $(AM_MAKEFLAGS) top_distdir="$(top_distdir)" distdir="$(distdir)" dist-hook
+info-am: $(INFO_DEPS)
+info: info-recursive
+dvi-am: $(DVIS)
+dvi: dvi-recursive
+check-am: all-am
+check: check-recursive
+installcheck-am:
+installcheck: installcheck-recursive
+all-recursive-am: config.h
+	$(MAKE) $(AM_MAKEFLAGS) all-recursive
+
+install-exec-am: install-libLTLIBRARIES
+install-exec: install-exec-recursive
+
+install-data-am: install-info-am install-includeHEADERS
+install-data: install-data-recursive
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-recursive
+uninstall-am: uninstall-libLTLIBRARIES uninstall-info \
+		uninstall-includeHEADERS
+uninstall: uninstall-recursive
+all-am: Makefile $(INFO_DEPS) $(ANSI2KNR) $(LTLIBRARIES) $(HEADERS) \
+		config.h
+all-redirect: all-recursive-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs: installdirs-recursive
+installdirs-am:
+	$(mkinstalldirs)  $(DESTDIR)$(libdir) $(DESTDIR)$(infodir) \
+		$(DESTDIR)$(includedir)
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+	-test -z "$(DISTCLEANFILES)" || rm -f $(DISTCLEANFILES)
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-hdr mostlyclean-libLTLIBRARIES \
+		mostlyclean-compile mostlyclean-libtool \
+		mostlyclean-krextra mostlyclean-kr mostlyclean-vti \
+		mostlyclean-aminfo mostlyclean-tags mostlyclean-generic
+
+mostlyclean: mostlyclean-recursive
+
+clean-am:  clean-hdr clean-libLTLIBRARIES clean-compile clean-libtool \
+		clean-krextra clean-kr clean-vti clean-aminfo \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-recursive
+
+distclean-am:  distclean-hdr distclean-libLTLIBRARIES distclean-compile \
+		distclean-libtool distclean-krextra distclean-kr \
+		distclean-vti distclean-aminfo distclean-tags \
+		distclean-generic clean-am
+	-rm -f libtool
+
+distclean: distclean-recursive
+	-rm -f config.status
+
+maintainer-clean-am:  maintainer-clean-hdr \
+		maintainer-clean-libLTLIBRARIES \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-krextra maintainer-clean-kr \
+		maintainer-clean-vti maintainer-clean-aminfo \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-recursive
+	-rm -f config.status
+
+.PHONY: mostlyclean-hdr distclean-hdr clean-hdr maintainer-clean-hdr \
+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 mostlyclean-krextra distclean-krextra \
+clean-krextra maintainer-clean-krextra mostlyclean-kr distclean-kr \
+clean-kr maintainer-clean-kr mostlyclean-vti distclean-vti clean-vti \
+maintainer-clean-vti install-info-am uninstall-info mostlyclean-aminfo \
+distclean-aminfo clean-aminfo maintainer-clean-aminfo \
+uninstall-includeHEADERS install-includeHEADERS install-recursive \
+uninstall-recursive 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-am info \
+dvi-am dvi check check-am installcheck-am installcheck all-recursive-am \
+install-exec-am install-exec install-data-am install-data install-am \
+install uninstall-am uninstall all-redirect all-am all install-strip \
+installdirs-am installdirs mostlyclean-generic distclean-generic \
+clean-generic maintainer-clean-generic clean mostlyclean distclean \
+maintainer-clean
+
+
+# Don't ship CVS directories or emacs backups.
+dist-hook:
+	-find $(distdir) \( -name CVS -type d \) -o -name "*.~*" \
+		| xargs rm -rf
+
+# 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/src/gmp/NEWS b/src/gmp/NEWS
new file mode 100644
index 000000000..f41af938a
--- /dev/null
+++ b/src/gmp/NEWS
@@ -0,0 +1,131 @@
+Changes between MP version 3.0 and 3.1
+
+* Bug fixes.
+* Improved `make check' running more tests.
+* Tuned algorithm cutoff points for many machines.  This will improve speed for
+  a lot of operations, in some cases by a large amount.
+* Major speed improvments: Alpha 21264.
+* Some speed improvments: Cray vector computers, AMD K6 and Athlon, Intel P5
+  and Pentium Pro/II/III.
+* The mpf_get_prec function now works as it did in GMP 2.
+* New utilities for auto-tuning and speed measuring.
+* Multiplication now optionally uses FFT for very large operands.  (To enable
+  it, pass --enable-fft to configure.)
+* Support for new systems: Solaris running on x86, FreeBSD 5, HP-UX 11, Cray
+  vector computers, Rhapsody, Nextstep/Openstep, MacOS.
+* Support for shared libraries on 32-bit HPPA.
+* New integer functions: mpz_mul_si, mpz_odd_p, mpz_even_p.
+* New Kronecker symbol functions: mpz_kronecker_si, mpz_kronecker_ui,
+  mpz_si_kronecker, mpz_ui_kronecker.
+* New rational functions: mpq_out_str, mpq_swap.
+* New float functions: mpf_swap.
+* New mpn functions: mpn_divexact_by3c, mpn_tdiv_qr.
+* New EXPERIMENTAL function layer for accurate floating-point arithmetic, mpfr.
+  To try it, pass --enable-mpfr to configure.  See the mpfr subdirectory for
+  more information; it is not documented in the main GMP manual.
+
+Changes between MP version 3.0 and 3.0.1
+
+* Memory leaks in gmp_randinit and mpz_probab_prime_p fixed.
+* Documentation for gmp_randinit fixed.  Misc documentation errors fixed.
+
+Changes between MP version 2.0 and 3.0
+
+* Source level compatibility with past releases (except mpn_gcd).
+* Bug fixes.
+* Much improved speed thanks to both host independent and host dependent
+  optimizations.
+* Switch to autoconf/automake/libtool.
+* Support for building libgmp as a shared library.
+* Multiplication and squaring using 3-way Toom-Cook.
+* Division using the Burnikel-Ziegler method.
+* New functions computing binomial coefficients: mpz_bin_ui, mpz_bin_uiui.
+* New function computing Fibonacci numbers: mpz_fib_ui.
+* New random number generators: mpf_urandomb, mpz_rrandomb, mpz_urandomb,
+  mpz_urandomm, gmp_randclear, gmp_randinit, gmp_randinit_lc_2exp, gmp_randseed, 
+  gmp_randseed_ui.
+* New function for quickly extracting limbs: mpz_getlimbn.
+* New functions performing integer size tests: mpz_fits_sint_p,
+  mpz_fits_slong_p, mpz_fits_sshort_p, mpz_fits_uint_p, mpz_fits_ulong_p,
+  mpz_fits_ushort_p.
+* New mpf functions: mpf_ceil, mpf_floor, mpf_pow_ui, mpf_trunc.
+* New mpq function: mpq_set_d.
+* New mpz functions: mpz_addmul_ui, mpz_cmpabs, mpz_cmpabs_ui, mpz_lcm,
+  mpz_nextprime, mpz_perfect_power_p, mpz_remove, mpz_root, mpz_swap,
+  mpz_tdiv_ui, mpz_tstbit, mpz_xor.
+* New mpn function: mpn_divexact_by3.
+* New CPU support: DEC Alpha 21264, AMD K6 and Athlon, HPPA 2.0 and 64,
+  Intel Pentium Pro and Pentium-II/III, Sparc 64, PowerPC 64.
+* Almost 10 times faster mpz_invert and mpn_gcdext.
+* The interface of mpn_gcd has changed.
+* Better support for MIPS R4x000 and R5000 under Irix 6.
+* Improved support for SPARCv8 and SPARCv9 processors.
+
+Changes between MP version 2.0 and 2.0.2
+
+* Many bug fixes.
+
+Changes between MP version 1.3.2 and 2.0
+
+* Division routines in the mpz class have changed.  There are three classes of
+  functions, that rounds the quotient to -infinity, 0, and +infinity,
+  respectively.  The first class of functions have names that begin with
+  mpz_fdiv (f is short for floor), the second class' names begin with mpz_tdiv
+  (t is short for trunc), and the third class' names begin with mpz_cdiv (c is
+  short for ceil).
+
+  The old division routines beginning with mpz_m are similar to the new
+  mpz_fdiv, with the exception that some of the new functions return useful
+  values.
+
+  The old function names can still be used.  All the old functions names will
+  now do floor division, not trunc division as some of them used to.  This was
+  changed to make the functions more compatible with common mathematical
+  practice.
+
+  The mpz_mod and mpz_mod_ui functions now compute the mathematical mod
+  function.  I.e., the sign of the 2nd argument is ignored.
+
+* The mpq assignment functions do not canonicalize their results.  A new
+  function, mpq_canonicalize must be called by the user if the result is not
+  known to be canonical.
+* The mpn functions are now documented.  These functions are intended for
+  very time critical applications, or applications that need full control over
+  memory allocation.  Note that the mpn interface is irregular and hard to
+  use.
+* New functions for arbitrary precision floating point arithmetic.  Names
+  begin with `mpf_'.  Associated type mpf_t.
+* New and improved mpz functions, including much faster GCD, fast exact
+  division (mpz_divexact), bit scan (mpz_scan0 and mpz_scan1), and number
+  theoretical functions like Jacobi (mpz_jacobi) and multiplicative inverse
+  (mpz_invert).
+* New variable types (mpz_t and mpq_t) are available that makes syntax of
+  mpz and mpq calls nicer (no need for & before variables).  The MP_INT and
+  MP_RAT types are still available for compatibility.
+* Uses GNU configure.  This makes it possible to choose target architecture
+  and CPU variant, and to compile into a separate object directory.
+* Carefully optimized assembly for important inner loops.  Support for DEC
+  Alpha, Amd 29000, HPPA 1.0 and 1.1, Intel Pentium and generic x86, Intel
+  i960, Motorola MC68000, MC68020, MC88100, and MC88110, Motorola/IBM
+  PowerPC, National NS32000, IBM POWER, MIPS R3000, R4000, SPARCv7,
+  SuperSPARC, generic SPARCv8, and DEC VAX.  Some support also for ARM,
+  Clipper, IBM ROMP (RT), and Pyramid AP/XP.
+* Faster.  Thanks to the assembler code, new algorithms, and general tuning.
+  In particular, the speed on machines without GCC is improved.
+* Support for machines without alloca.
+* Now under the LGPL.
+
+INCOMPATIBILITIES BETWEEN GMP 1 AND GMP 2
+
+* mpq assignment functions do not canonicalize their results.
+* mpz division functions round differently.
+* mpz mod functions now really compute mod.
+* mpz_powm and mpz_powm_ui now really use mod for reduction.
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 76
+End:
diff --git a/src/gmp/README b/src/gmp/README
new file mode 100644
index 000000000..177c97eb1
--- /dev/null
+++ b/src/gmp/README
@@ -0,0 +1,84 @@
+
+			THE GNU MP LIBRARY
+
+
+GNU MP is a library for arbitrary precision arithmetic, operating on signed
+integers, rational numbers, and floating point numbers.  It has a rich set of
+functions, and the functions have a regular interface.
+
+GNU MP is designed to be as fast as possible, both for small operands and huge
+operands.  The speed is achieved by using fullwords as the basic arithmetic
+type, by using fast algorithms, with carefully optimized assembly code for the
+most common inner loops for lots of CPUs, and by a general emphasis on speed
+(instead of simplicity or elegance).
+
+GNU MP is believed to be faster than any other similar library.  Its advantage
+increases with operand sizes for certain operations, since GNU MP in many
+cases has asymptotically faster algorithms.
+
+GNU MP is free software and may be freely copied on the terms contained in the
+files COPYING.LIB and COPYING (most of GNU MP is under the former, some under
+the latter).
+
+
+
+			OVERVIEW OF GNU MP
+
+There are five classes of functions in GNU MP.
+
+ 1. Signed integer arithmetic functions (mpz).  These functions are intended
+    to be easy to use, with their regular interface.  The associated type is
+    `mpz_t'.
+
+ 2. Rational arithmetic functions (mpq).  For now, just a small set of
+    functions necessary for basic rational arithmetics.  The associated type
+    is `mpq_t'.
+
+ 3. Floating-point arithmetic functions (mpf).  If the C type `double'
+    doesn't give enough precision for your application, declare your
+    variables as `mpf_t' instead, set the precision to any number desired,
+    and call the functions in the mpf class for the arithmetic operations.
+
+ 4. Positive-integer, hard-to-use, very low overhead functions are in the
+    mpn class.  No memory management is performed.  The caller must ensure
+    enough space is available for the results.  The set of functions is not
+    regular, nor is the calling interface.  These functions accept input
+    arguments in the form of pairs consisting of a pointer to the least
+    significant word, and an integral size telling how many limbs (= words)
+    the pointer points to.
+
+    Almost all calculations, in the entire package, are made by calling these
+    low-level functions.
+
+ 5. Berkeley MP compatible functions.
+
+    To use these functions, include the file "mp.h".  You can test if you are
+    using the GNU version by testing if the symbol __GNU_MP__ is defined.
+
+For more information on how to use GNU MP, please refer to the documentation.
+It is composed from the file gmp.texi, and can be displayed on the screen or
+printed.  How to do that, as well how to build the library, is described in
+the INSTALL file in this directory.
+
+
+
+			REPORTING BUGS
+
+If you find a bug in the library, please make sure to tell us about it!
+
+You should first check the GNU MP web pages at http://www.swox.com/gmp/,
+under "Status of the current release".  There will be patches for all known
+serious bugs there.
+
+Report bugs to bug-gmp@gnu.org.  What information is needed in a good bug
+report is described in the manual.  The same address can be used for
+suggesting modifications and enhancements.
+
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 78
+End:
diff --git a/src/gmp/acconfig.h b/src/gmp/acconfig.h
new file mode 100644
index 000000000..dfb1b0b03
--- /dev/null
+++ b/src/gmp/acconfig.h
@@ -0,0 +1,92 @@
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+@TOP@
+
+/* Define if a limb is long long. */
+#undef _LONG_LONG_LIMB
+
+/* Define if we have native implementation of function. */
+#undef HAVE_NATIVE_
+#undef HAVE_NATIVE_mpn_add                 
+#undef HAVE_NATIVE_mpn_add_1               
+#undef HAVE_NATIVE_mpn_add_n               
+#undef HAVE_NATIVE_mpn_add_nc              
+#undef HAVE_NATIVE_mpn_addmul_1            
+#undef HAVE_NATIVE_mpn_addmul_1c
+#undef HAVE_NATIVE_mpn_addsub_n            
+#undef HAVE_NATIVE_mpn_addsub_nc
+#undef HAVE_NATIVE_mpn_and_n               
+#undef HAVE_NATIVE_mpn_andn_n              
+#undef HAVE_NATIVE_mpn_bdivmod             
+#undef HAVE_NATIVE_mpn_cmp                 
+#undef HAVE_NATIVE_mpn_com_n               
+#undef HAVE_NATIVE_mpn_copyd               
+#undef HAVE_NATIVE_mpn_copyi               
+#undef HAVE_NATIVE_mpn_divexact_by3c
+#undef HAVE_NATIVE_mpn_divrem              
+#undef HAVE_NATIVE_mpn_divrem_1            
+#undef HAVE_NATIVE_mpn_divrem_1c
+#undef HAVE_NATIVE_mpn_divrem_2            
+#undef HAVE_NATIVE_mpn_divrem_newton       
+#undef HAVE_NATIVE_mpn_divrem_classic      
+#undef HAVE_NATIVE_mpn_dump                
+#undef HAVE_NATIVE_mpn_gcd                 
+#undef HAVE_NATIVE_mpn_gcd_1               
+#undef HAVE_NATIVE_mpn_gcdext              
+#undef HAVE_NATIVE_mpn_get_str             
+#undef HAVE_NATIVE_mpn_hamdist             
+#undef HAVE_NATIVE_mpn_invert_limb
+#undef HAVE_NATIVE_mpn_ior_n               
+#undef HAVE_NATIVE_mpn_iorn_n              
+#undef HAVE_NATIVE_mpn_lshift              
+#undef HAVE_NATIVE_mpn_mod_1               
+#undef HAVE_NATIVE_mpn_mod_1c
+#undef HAVE_NATIVE_mpn_mul                 
+#undef HAVE_NATIVE_mpn_mul_1               
+#undef HAVE_NATIVE_mpn_mul_1c
+#undef HAVE_NATIVE_mpn_mul_basecase        
+#undef HAVE_NATIVE_mpn_mul_n               
+#undef HAVE_NATIVE_mpn_nand_n              
+#undef HAVE_NATIVE_mpn_nior_n              
+#undef HAVE_NATIVE_mpn_perfect_square_p    
+#undef HAVE_NATIVE_mpn_popcount            
+#undef HAVE_NATIVE_mpn_preinv_mod_1        
+#undef HAVE_NATIVE_mpn_random2             
+#undef HAVE_NATIVE_mpn_random              
+#undef HAVE_NATIVE_mpn_rawrandom           
+#undef HAVE_NATIVE_mpn_rshift              
+#undef HAVE_NATIVE_mpn_scan0               
+#undef HAVE_NATIVE_mpn_scan1               
+#undef HAVE_NATIVE_mpn_set_str             
+#undef HAVE_NATIVE_mpn_sqrtrem             
+#undef HAVE_NATIVE_mpn_sqr_basecase        
+#undef HAVE_NATIVE_mpn_sub                 
+#undef HAVE_NATIVE_mpn_sub_1               
+#undef HAVE_NATIVE_mpn_sub_n               
+#undef HAVE_NATIVE_mpn_sub_nc              
+#undef HAVE_NATIVE_mpn_submul_1            
+#undef HAVE_NATIVE_mpn_submul_1c
+#undef HAVE_NATIVE_mpn_udiv_w_sdiv         
+#undef HAVE_NATIVE_mpn_umul_ppmm
+#undef HAVE_NATIVE_mpn_udiv_qrnnd
+#undef HAVE_NATIVE_mpn_xor_n               
+#undef HAVE_NATIVE_mpn_xnor_n              
diff --git a/src/gmp/acinclude.m4 b/src/gmp/acinclude.m4
new file mode 100644
index 000000000..a02394a96
--- /dev/null
+++ b/src/gmp/acinclude.m4
@@ -0,0 +1,835 @@
+dnl  GMP specific autoconf macros
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+dnl  GMP_HEADER_GETVAL(NAME,FILE)
+dnl  ----------------------------
+dnl  Expand to the value of a "#define NAME" from the given FILE.
+dnl  The regexps here aren't very rugged, but are enough for gmp.
+dnl  /dev/null as a parameter prevents a hang if $2 is accidentally omitted.
+
+define(GMP_HEADER_GETVAL,
+[patsubst(patsubst(
+esyscmd([grep "^#define $1 " $2 /dev/null 2>/dev/null]),
+[^.*$1[ 	]+],[]),
+[[
+ 	]*$],[])])
+
+
+dnl  GMP_VERSION
+dnl  -----------
+dnl  The gmp version number, extracted from the #defines in gmp.h.
+dnl  Two digits like 3.0 if patchlevel <= 0, or three digits like 3.0.1 if
+dnl  patchlevel > 0.
+
+define(GMP_VERSION,
+[GMP_HEADER_GETVAL(__GNU_MP_VERSION,gmp.h)[]dnl
+.GMP_HEADER_GETVAL(__GNU_MP_VERSION_MINOR,gmp.h)[]dnl
+ifelse(m4_eval(GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp.h) > 0),1,
+[.GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp.h)])])
+
+
+dnl  GMP_PROG_M4()
+dnl  -------------
+dnl
+dnl  Find a working m4, either in $PATH or likely locations, and setup $M4
+dnl  and an AC_SUBST accordingly.  If $M4 is already set then it's a user
+dnl  choice and is accepted with no checks.  GMP_PROG_M4 is like
+dnl  AC_PATH_PROG or AC_CHECK_PROG, but it tests each m4 found to see if
+dnl  it's good enough.
+dnl 
+dnl  See mpn/asm-defs.m4 for details on the known bad m4s.
+
+AC_DEFUN(GMP_PROG_M4,
+[AC_CACHE_CHECK([for suitable m4],
+                gmp_cv_prog_m4,
+[if test -n "$M4"; then
+  gmp_cv_prog_m4="$M4"
+else
+  cat >conftest.m4 <<\EOF
+dnl  must protect this against being expanded during autoconf m4!
+[define(dollarhash,``$][#'')dnl
+ifelse(dollarhash(x),1,`define(t1,Y)',
+``bad: $][# not supported (SunOS /usr/bin/m4)
+'')dnl
+ifelse(eval(89),89,`define(t2,Y)',
+`bad: eval() doesnt support 8 or 9 in a constant (OpenBSD 2.6 m4)
+')dnl
+ifelse(t1`'t2,YY,`good
+')dnl]
+EOF
+  echo "trying m4" 1>&AC_FD_CC
+  gmp_tmp_val="`(m4 conftest.m4) 2>&AC_FD_CC`"
+  echo "$gmp_tmp_val" 1>&AC_FD_CC
+  if test "$gmp_tmp_val" = good; then
+    gmp_cv_prog_m4="m4"
+  else
+    IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+dnl $ac_dummy forces splitting on constant user-supplied paths.
+dnl POSIX.2 word splitting is done only on the output of word expansions,
+dnl not every word.  This closes a longstanding sh security hole.
+    ac_dummy="$PATH:/usr/5bin"
+    for ac_dir in $ac_dummy; do
+      test -z "$ac_dir" && ac_dir=.
+      echo "trying $ac_dir/m4" 1>&AC_FD_CC
+      gmp_tmp_val="`($ac_dir/m4 conftest.m4) 2>&AC_FD_CC`"
+      echo "$gmp_tmp_val" 1>&AC_FD_CC
+      if test "$gmp_tmp_val" = good; then
+        gmp_cv_prog_m4="$ac_dir/m4"
+        break
+      fi
+    done
+    IFS="$ac_save_ifs"
+    if test -z "$gmp_cv_prog_m4"; then
+      AC_MSG_ERROR([No usable m4 in \$PATH or /usr/5bin (see config.log for reasons).])
+    fi
+  fi
+  rm -f conftest.m4
+fi])
+M4="$gmp_cv_prog_m4"
+AC_SUBST(M4)
+])
+
+
+dnl  GMP_PROG_CC_FIND([CC_LIST], [REQ_64BIT_CC])
+dnl  Find first working compiler in CC_LIST.
+dnl  If REQ_64BIT_CC is "yes", the compiler is required to be able to 
+dnl  produce 64-bit code.
+dnl  NOTE: If a compiler needs any special flags for producing 64-bit code,
+dnl  these have to be found in shell variable `gmp_cflags64_{cc}', where `{cc}'
+dnl  is the name of the compiler.
+dnl  Set CC to the name of the first working compiler.
+dnl  If a 64-bit compiler is found, set CC64 to the name of the compiler and
+dnl  CFLAGS64 to flags to use.
+dnl  This macro does not test if any of the compilers found is a GNU compiler.
+dnl  To do this, when you have finally made up your mind on which one to use, 
+dnl  and set CC accordingly, invoke [GMP_PROG_CC_SELECT].  That macro will 
+dnl  also make sure that your selection of CFLAGS is valid.
+dnl
+AC_DEFUN(GMP_PROG_CC_FIND,
+[AC_BEFORE([$0], [CC_PROG_CPP])
+ifelse([$1], , gmp_cc_list="gcc cc", gmp_cc_list="[$1]")
+ifelse([$2], , gmp_req_64bit_cc="no", gmp_req_64bit_cc="[$2]")
+
+CC32=
+CC64=
+for c in $gmp_cc_list; do
+  # Avoid cache hits.
+  unset CC
+  unset ac_cv_prog_CC
+  AC_CHECK_TOOL(CC, $c, $c)
+  if test -n "$CC"; then
+    eval c_flags=\$gmp_cflags_$c
+    GMP_PROG_CC_WORKS($CC, $c_flags,
+		      gmp_prog_cc_works=yes, 
+		      gmp_prog_cc_works=no)
+
+    if test "$gmp_prog_cc_works" != "yes"; then
+      continue
+    fi
+
+    # Save first working compiler, whether 32- or 64-bit capable.
+    if test -z "$CC32"; then
+      CC32="$CC"
+    fi
+    if test "$gmp_req_64bit_cc" = "yes"; then
+      eval c_flags=\$gmp_cflags64_$c
+
+      # Verify that the compiler works in 64-bit mode as well.
+      # /usr/ucb/cc on Solaris 7 can *compile* in 64-bit mode, but not link.
+      GMP_PROG_CC_WORKS($c, $c_flags,
+		      	gmp_prog_cc_works=yes, 
+		      	gmp_prog_cc_works=no)
+
+      if test "$gmp_prog_cc_works" = "yes"; then
+        GMP_CHECK_CC_64BIT($c, $c_flags)
+        if test "$gmp_cv_cc_64bit" = "yes"; then
+          test -z "$CC64" && CC64="$c"
+          test -z "$CFLAGS64" && CFLAGS64="$c_flags"
+	  # We have CC64 so we're done.
+          break
+        fi
+      fi
+    else
+      # We have CC32, and we don't need a 64-bit compiler so we're done.
+      break
+    fi
+  fi
+done
+CC="$CC32"
+])dnl
+
+dnl  GMP_PROG_CC_SELECT
+dnl  Check that `CC' works with `CFLAGS'.  Check if `CC' is a GNU compiler.
+dnl  Cache the result as `ac_cv_prog_CC'.
+AC_DEFUN(GMP_PROG_CC_SELECT,
+[AC_BEFORE([$0], [CC_PROG_CPP])
+AC_PROG_CC_WORKS
+AC_PROG_CC_GNU
+
+if test "$ac_cv_prog_gcc" = "yes"; then
+  GCC=yes
+else
+  GCC=
+fi
+
+# Set CFLAGS if not already set.
+if test -z "$CFLAGS"; then
+  CFLAGS="-g"
+  if test "$GCC" = "yes"; then
+    CFLAGS="$CFLAGS -O2"
+  fi
+fi
+
+AC_SUBST(CC)
+AC_CACHE_VAL(ac_cv_prog_CC, ac_cv_prog_CC="$CC")
+AC_PROVIDE([AC_PROG_CC])
+])dnl
+
+dnl  GMP_CHECK_CC_64BIT(cc, cflags64)
+dnl  Find out if `CC' can produce 64-bit code.
+dnl  Requires NM to be set to nm for target.
+dnl  FIXME: Cache result.
+AC_DEFUN(GMP_CHECK_CC_64BIT,
+[
+  gmp_tmp_CC_save="$CC"
+  CC="[$1]"
+  AC_MSG_CHECKING([whether the C compiler ($CC) is 64-bit capable])
+  if test -z "$NM"; then
+    echo; echo ["configure: $0: fatal: need nm"]
+    exit 1
+  fi
+  gmp_tmp_CFLAGS_save="$CFLAGS"
+  CFLAGS="[$2]"
+
+  case "$target" in 
+    hppa2.0*-*-*)
+      # FIXME: If gcc is installed under another name than "gcc", we will 
+      # test the wrong thing.
+      if test "$CC" != "gcc"; then
+        dnl Let compiler version A.10.32.30 or higher be ok.
+        dnl Bad compiler output:
+        dnl   ccom: HP92453-01 G.10.32.05 HP C Compiler
+        dnl Good compiler output:
+        dnl   ccom: HP92453-01 A.10.32.30 HP C Compiler
+        echo >conftest.c
+        gmp_tmp_vs=`$CC $CFLAGS -V -c -o conftest.o conftest.c 2>&1 | grep "^ccom:"`
+        rm conftest*
+        gmp_tmp_v1=`echo $gmp_tmp_vs | sed 's/.* .\.\(.*\)\..*\..* HP C.*/\1/'`
+        gmp_tmp_v2=`echo $gmp_tmp_vs | sed 's/.* .\..*\.\(.*\)\..* HP C.*/\1/'`
+        gmp_tmp_v3=`echo $gmp_tmp_vs | sed 's/.* .\..*\..*\.\(.*\) HP C.*/\1/'`
+	gmp_cv_cc_64bit=no
+	test -n "$gmp_tmp_v1" && test "$gmp_tmp_v1" -ge "10" \
+  	  && test -n "$gmp_tmp_v2" && test "$gmp_tmp_v2" -ge "32" \
+    	  && test -n "$gmp_tmp_v3" && test "$gmp_tmp_v3" -ge "30" \
+	  && gmp_cv_cc_64bit=yes
+      else	# gcc
+	# FIXME: Compile a minimal file and determine if the resulting object 
+	# file is an ELF file.  If so, gcc can produce 64-bit code.
+	# Do we have file(1) for target?
+	gmp_cv_cc_64bit=no
+      fi
+      ;;
+    mips-sgi-irix6.*)
+      # We use `-n32' to cc and `-mabi=n32' to gcc, resulting in 64-bit 
+      # arithmetic but not 64-bit pointers, so the general test for sizeof
+      # (void *) is not valid.
+      # Simply try to compile an empty main.  If that succeeds return
+      # true.
+      AC_TRY_COMPILE( , ,
+                     gmp_cv_cc_64bit=yes, gmp_cv_cc_64bit=no,
+                     gmp_cv_cc_64bit=no)
+      ;;
+    *-*-*)
+      # Allocate an array of size sizeof (void *) and use nm to determine its 
+      # size.  We depend on the first declared variable being put at address 0.
+      cat >conftest.c <<EOF
+[char arr[sizeof (void *)]={0};
+char post=0;]
+EOF
+      gmp_compile="$CC $CFLAGS -c conftest.c 1>&AC_FD_CC"
+      if AC_TRY_EVAL(gmp_compile); then
+        changequote(<,>)dnl
+	gmp_tmp_val=`$NM conftest.o | grep post | sed -e 's;[[][0-9][]]\(.*\);\1;' \
+          -e 's;[^1-9]*\([0-9]*\).*;\1;'`
+        changequote([, ])dnl
+        if test "$gmp_tmp_val" = "8"; then
+	  gmp_cv_cc_64bit=yes
+	else
+	  gmp_cv_cc_64bit=no
+        fi
+      else
+        echo "configure: failed program was:" >&AC_FD_CC
+        cat conftest.$ac_ext >&AC_FD_CC
+        gmp_cv_cc_64bit=no
+      fi
+      rm -f conftest*
+      ;;
+  esac
+
+  CC="$gmp_tmp_CC_save"
+  CFLAGS="$gmp_tmp_CFLAGS_save"
+  AC_MSG_RESULT($gmp_cv_cc_64bit)
+])dnl
+
+dnl  GMP_INIT([M4-DEF-FILE])
+dnl  
+AC_DEFUN(GMP_INIT,
+[ifelse([$1], , gmp_configm4=config.m4, gmp_configm4="[$1]")
+gmp_tmpconfigm4=cnfm4.tmp
+gmp_tmpconfigm4i=cnfm4i.tmp
+gmp_tmpconfigm4p=cnfm4p.tmp
+test -f $gmp_tmpconfigm4 && rm $gmp_tmpconfigm4
+test -f $gmp_tmpconfigm4i && rm $gmp_tmpconfigm4i
+test -f $gmp_tmpconfigm4p && rm $gmp_tmpconfigm4p
+])dnl
+
+dnl  GMP_FINISH
+dnl  ----------
+dnl  Create config.m4 from its accumulated parts.
+dnl
+dnl  __CONFIG_M4_INCLUDED__ is used so that a second or subsequent include
+dnl  of config.m4 is harmless.
+dnl
+dnl  A separate ifdef on the angle bracket quoted part ensures the quoting
+dnl  style there is respected.  The basic defines from gmp_tmpconfigm4 are
+dnl  fully quoted but are still put under an ifdef in case any have been
+dnl  redefined by one of the m4 include files.
+dnl
+dnl  Doing a big ifdef within asm-defs.m4 and/or other macro files wouldn't
+dnl  work, since it'd interpret parentheses and quotes in dnl comments, and
+dnl  having a whole file as a macro argument would overflow the string space
+dnl  on BSD m4.
+
+AC_DEFUN(GMP_FINISH,
+[AC_REQUIRE([GMP_INIT])
+echo "creating $gmp_configm4"
+echo ["dnl $gmp_configm4.  Generated automatically by configure."] > $gmp_configm4
+if test -f $gmp_tmpconfigm4; then
+  echo ["changequote(<,>)dnl"] >> $gmp_configm4
+  echo ["ifdef(<__CONFIG_M4_INCLUDED__>,,<"] >> $gmp_configm4
+  cat $gmp_tmpconfigm4 >> $gmp_configm4
+  echo [">)"] >> $gmp_configm4
+  echo ["changequote(\`,')dnl"] >> $gmp_configm4
+  rm $gmp_tmpconfigm4
+fi
+echo ["ifdef(\`__CONFIG_M4_INCLUDED__',,\`"] >> $gmp_configm4
+if test -f $gmp_tmpconfigm4i; then
+  cat $gmp_tmpconfigm4i >> $gmp_configm4
+  rm $gmp_tmpconfigm4i
+fi
+if test -f $gmp_tmpconfigm4p; then
+  cat $gmp_tmpconfigm4p >> $gmp_configm4
+  rm $gmp_tmpconfigm4p
+fi
+echo ["')"] >> $gmp_configm4
+echo ["define(\`__CONFIG_M4_INCLUDED__')"] >> $gmp_configm4
+])dnl
+
+dnl  GMP_INCLUDE(FILE)
+AC_DEFUN(GMP_INCLUDE,
+[AC_REQUIRE([GMP_INIT])
+echo ["include(\`$1')"] >> $gmp_tmpconfigm4i
+])dnl
+
+dnl  GMP_SINCLUDE(FILE)
+AC_DEFUN(GMP_SINCLUDE,
+[AC_REQUIRE([GMP_INIT])
+echo ["sinclude(\`$1')"] >> $gmp_tmpconfigm4i
+])dnl
+
+dnl GMP_DEFINE(MACRO, DEFINITION [, LOCATION])
+dnl [ Define M4 macro MACRO as DEFINITION in temporary file.		]
+dnl [ If LOCATION is `POST', the definition will appear after any	]
+dnl [ include() directives inserted by GMP_INCLUDE/GMP_SINCLUDE.	]
+dnl [ Mind the quoting!  No shell variables will get expanded.		]
+dnl [ Don't forget to invoke GMP_FINISH to create file config.m4.	]
+dnl [ config.m4 uses `<' and '>' as quote characters for all defines.	]
+AC_DEFUN(GMP_DEFINE, 
+[AC_REQUIRE([GMP_INIT])
+echo ['define(<$1>, <$2>)'] >> ifelse([$3], [POST], $gmp_tmpconfigm4p, $gmp_tmpconfigm4)
+])dnl
+
+dnl GMP_DEFINE_RAW(STRING, [, LOCATION])
+dnl [ Put STRING in temporary file.					]
+dnl [ If LOCATION is `POST', the definition will appear after any	]
+dnl [ include() directives inserted by GMP_INCLUDE/GMP_SINCLUDE.	]
+dnl [ Don't forget to invoke GMP_FINISH to create file config.m4.	]
+AC_DEFUN(GMP_DEFINE_RAW,
+[AC_REQUIRE([GMP_INIT])
+echo [$1] >> ifelse([$2], [POST], $gmp_tmpconfigm4p, $gmp_tmpconfigm4)
+])dnl
+
+dnl  GMP_CHECK_ASM_LABEL_SUFFIX
+dnl  Should a label have a colon or not?
+AC_DEFUN(GMP_CHECK_ASM_LABEL_SUFFIX,
+[AC_CACHE_CHECK([what assembly label suffix to use],
+               gmp_cv_check_asm_label_suffix,
+[case "$target" in 
+  *-*-hpux*) gmp_cv_check_asm_label_suffix=[""] ;;
+  *) gmp_cv_check_asm_label_suffix=[":"] ;;
+esac
+])
+echo ["define(<LABEL_SUFFIX>, <\$][1$gmp_cv_check_asm_label_suffix>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_UNDERSCORE([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
+dnl  Shamelessly borrowed from glibc.
+AC_DEFUN(GMP_CHECK_ASM_UNDERSCORE,
+[AC_CACHE_CHECK([if symbols are prefixed by underscore], 
+	        gmp_cv_check_asm_underscore,
+[cat > conftest.$ac_ext <<EOF
+dnl This sometimes fails to find confdefs.h, for some reason.
+dnl [#]line __oline__ "[$]0"
+[#]line __oline__ "configure"
+#include "confdefs.h"
+int underscore_test() {
+return; }
+EOF
+if AC_TRY_EVAL(ac_compile); then
+  if grep _underscore_test conftest* >/dev/null; then
+    gmp_cv_check_asm_underscore=yes
+  else
+    gmp_cv_check_asm_underscore=no
+  fi
+else
+  echo "configure: failed program was:" >&AC_FD_CC
+  cat conftest.$ac_ext >&AC_FD_CC
+fi
+rm -f conftest*
+])
+if test "$gmp_cv_check_asm_underscore" = "yes"; then
+  GMP_DEFINE(GSYM_PREFIX, [_])
+  ifelse([$1], , :, [$1])
+else
+  GMP_DEFINE(GSYM_PREFIX, [])
+  ifelse([$2], , :, [$2])
+fi    
+])dnl
+
+dnl  GMP_CHECK_ASM_ALIGN_LOG([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
+dnl  Is parameter to `.align' logarithmic?
+dnl  Requires NM to be set to nm for target.
+AC_DEFUN(GMP_CHECK_ASM_ALIGN_LOG,
+[AC_REQUIRE([GMP_CHECK_ASM_GLOBL])
+AC_REQUIRE([GMP_CHECK_ASM_DATA])
+AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
+AC_CACHE_CHECK([if .align assembly directive is logarithmic],
+		gmp_cv_check_asm_align_log,
+[if test -z "$NM"; then
+  echo; echo ["configure: $0: fatal: need nm"]
+  exit 1
+fi
+cat > conftest.s <<EOF
+      	$gmp_cv_check_asm_data
+      	.align  4
+	$gmp_cv_check_asm_globl	foo
+	.byte	1
+	.align	4
+foo$gmp_cv_check_asm_label_suffix
+	.byte	2
+EOF
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+if AC_TRY_EVAL(ac_assemble); then
+  changequote(<,>)
+  gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
+       -e 's;[^1-9]*\([0-9]*\).*;\1;'`
+  changequote([, ])dnl
+  if test "$gmp_tmp_val" = "10" || test "$gmp_tmp_val" = "16"; then
+    gmp_cv_check_asm_align_log=yes
+  else
+    gmp_cv_check_asm_align_log=no
+  fi
+else 
+  echo "configure: failed program was:" >&AC_FD_CC
+  cat conftest.s >&AC_FD_CC
+fi
+rm -f conftest*
+])
+GMP_DEFINE_RAW(["define(<ALIGN_LOGARITHMIC>,<$gmp_cv_check_asm_align_log>)"])
+if test "$gmp_cv_check_asm_align_log" = "yes"; then
+  ifelse([$1], , :, [$1])
+else
+  ifelse([$2], , :, [$2])
+fi  
+])dnl
+
+
+dnl  GMP_CHECK_ASM_ALIGN_FILL_0x90
+dnl  -----------------------------
+dnl  Determine whether a ",0x90" suffix works on a .align directive.
+dnl  This is only meant for use on x86, where 0x90 is a "nop".
+dnl
+dnl  Old gas, eg. 1.92.3 - needs ",0x90" or else the fill is an invalid 0x00.
+dnl  New gas, eg. 2.91 - generates the good multibyte nop fills even when
+dnl                      ",0x90" is given.
+dnl  Solaris 2.6 as - doesn't allow ",0x90", gives a fatal error.
+dnl  Solaris 2.8 as - gives a warning for ",0x90", no ill effect.
+dnl
+dnl  Note that both solaris "as"s only care about ",0x90" if they actually
+dnl  have to use it to fill something, hence the .byte in the sample.  It's
+dnl  only the second .align that provokes an error or warning.
+dnl
+dnl  We prefer to suppress the warning from solaris 2.8 to stop anyone
+dnl  worrying something might be wrong.
+
+AC_DEFUN(GMP_CHECK_ASM_ALIGN_FILL_0x90,
+[AC_CACHE_CHECK([if the .align directive accepts an 0x90 fill in .text],
+                gmp_cv_check_asm_align_fill_0x90,
+[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
+cat > conftest.s <<EOF
+      	$gmp_cv_check_asm_text
+      	.align  4, 0x90
+	.byte   0
+      	.align  4, 0x90
+EOF
+gmp_tmp_val="`$CCAS $CFLAGS conftest.s 2>&1`"
+if test $? = 0; then
+  echo "$gmp_tmp_val" 1>&AC_FD_CC
+  if echo "$gmp_tmp_val" | grep "Warning: Fill parameter ignored for executable section"; then
+    echo "Supressing this warning by omitting 0x90" 1>&AC_FD_CC
+    gmp_cv_check_asm_align_fill_0x90=no
+  else
+    gmp_cv_check_asm_align_fill_0x90=yes
+  fi
+else
+  echo "Non-zero exit code" 1>&AC_FD_CC
+  echo "$gmp_tmp_val" 1>&AC_FD_CC
+  gmp_cv_check_asm_align_fill_0x90=no
+fi
+rm -f conftest*
+])
+GMP_DEFINE_RAW(
+["define(<ALIGN_FILL_0x90>,<$gmp_cv_check_asm_align_fill_0x90>)"])
+])
+
+
+dnl  GMP_CHECK_ASM_TEXT
+AC_DEFUN(GMP_CHECK_ASM_TEXT,
+[AC_CACHE_CHECK([how to switch to text section], gmp_cv_check_asm_text,
+[case "$target" in
+  *-*-aix*)
+    changequote({, })
+    gmp_cv_check_asm_text={".csect .text[PR]"}
+    changequote([, ])
+    ;;
+  *-*-hpux*) gmp_cv_check_asm_text=[".code"] ;;
+  *) gmp_cv_check_asm_text=[".text"] ;;
+esac
+])
+echo ["define(<TEXT>, <$gmp_cv_check_asm_text>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_DATA
+dnl  Can we say `.data'?
+AC_DEFUN(GMP_CHECK_ASM_DATA,
+[AC_CACHE_CHECK([how to switch to data section], gmp_cv_check_asm_data,
+[case "$target" in
+  *-*-aix*)
+    changequote({, })
+    gmp_cv_check_asm_data={".csect .data[RW]"}
+    changequote([, ])
+    ;;
+  *) gmp_cv_check_asm_data=[".data"] ;;
+esac
+])
+echo ["define(<DATA>, <$gmp_cv_check_asm_data>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_GLOBL
+dnl  Can we say `.global'?
+AC_DEFUN(GMP_CHECK_ASM_GLOBL,
+[AC_CACHE_CHECK([how to export a symbol], gmp_cv_check_asm_globl,
+[case "$target" in
+  *-*-hpux*) gmp_cv_check_asm_globl=[".export"] ;;
+  *) gmp_cv_check_asm_globl=[".globl"] ;;
+esac
+])
+echo ["define(<GLOBL>, <$gmp_cv_check_asm_globl>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_TYPE
+dnl  Can we say `.type'?
+AC_DEFUN(GMP_CHECK_ASM_TYPE,
+[AC_CACHE_CHECK([how the .type assembly directive should be used],
+gmp_cv_check_asm_type,
+[ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+for gmp_tmp_prefix in @ \# %; do
+  echo "	.type	sym,${gmp_tmp_prefix}function" > conftest.s
+  if AC_TRY_EVAL(ac_assemble); then
+    gmp_cv_check_asm_type="[.type	\$][1,${gmp_tmp_prefix}\$][2]"
+    break
+  fi
+done
+if test -z "$gmp_cv_check_asm_type"; then
+  gmp_cv_check_asm_type="[dnl]"
+fi
+])
+echo ["define(<TYPE>, <$gmp_cv_check_asm_type>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_SIZE
+dnl  Can we say `.size'?
+AC_DEFUN(GMP_CHECK_ASM_SIZE,
+[AC_CACHE_CHECK([if the .size assembly directive works], gmp_cv_check_asm_size,
+[ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+echo '	.size	sym,1' > conftest.s
+if AC_TRY_EVAL(ac_assemble); then
+  gmp_cv_check_asm_size="[.size	\$][1,\$][2]"
+else
+  gmp_cv_check_asm_size="[dnl]"
+fi
+])
+echo ["define(<SIZE>, <$gmp_cv_check_asm_size>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_LSYM_PREFIX
+dnl  What is the prefix for a local label?
+dnl  Requires NM to be set to nm for target.
+AC_DEFUN(GMP_CHECK_ASM_LSYM_PREFIX,
+[AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
+AC_CACHE_CHECK([what prefix to use for a local label], 
+gmp_cv_check_asm_lsym_prefix,
+[if test -z "$NM"; then
+  echo; echo ["$0: fatal: need nm"]
+  exit 1
+fi
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+gmp_cv_check_asm_lsym_prefix="L"
+for gmp_tmp_pre in L .L $ L$; do
+  cat > conftest.s <<EOF
+dummy${gmp_cv_check_asm_label_suffix}
+${gmp_tmp_pre}gurkmacka${gmp_cv_check_asm_label_suffix}
+	.byte 0
+EOF
+  if AC_TRY_EVAL(ac_assemble); then
+    $NM conftest.o >/dev/null 2>&1
+    gmp_rc=$?
+    if test "$gmp_rc" != "0"; then
+      echo "configure: $NM failure, using default"
+      break
+    fi
+    if $NM conftest.o | grep gurkmacka >/dev/null; then true; else
+      gmp_cv_check_asm_lsym_prefix="$gmp_tmp_pre"
+      break
+    fi
+  else
+    echo "configure: failed program was:" >&AC_FD_CC
+    cat conftest.s >&AC_FD_CC
+    # Use default.
+  fi
+done
+rm -f conftest*
+])
+echo ["define(<LSYM_PREFIX>, <${gmp_cv_check_asm_lsym_prefix}>)"] >> $gmp_tmpconfigm4
+])
+
+dnl  GMP_CHECK_ASM_W32
+dnl  How to [define] a 32-bit word.
+dnl  Requires NM to be set to nm for target.
+AC_DEFUN(GMP_CHECK_ASM_W32,
+[AC_REQUIRE([GMP_CHECK_ASM_DATA])
+AC_REQUIRE([GMP_CHECK_ASM_GLOBL])
+AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
+AC_CACHE_CHECK([how to [define] a 32-bit word],
+	       gmp_cv_check_asm_w32,
+[if test -z "$NM"; then
+  echo; echo ["configure: $0: fatal: need nm"]
+  exit 1
+fi
+
+# FIXME: HPUX puts first symbol at 0x40000000, breaking our assumption
+# that it's at 0x0.  We'll have to declare another symbol before the
+# .long/.word and look at the distance between the two symbols.  The
+# only problem is that the sed expression(s) barfs (on Solaris, for
+# example) for the symbol with value 0.  For now, HPUX uses .word.
+
+case "$target" in 
+  *-*-hpux*)
+    gmp_cv_check_asm_w32=".word"
+    ;;
+  *-*-*)
+    ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+    for gmp_tmp_op in .long .word; do
+      cat > conftest.s <<EOF
+	$gmp_cv_check_asm_data
+	$gmp_cv_check_asm_globl	foo
+	$gmp_tmp_op	0
+foo${gmp_cv_check_asm_label_suffix}
+	.byte	0
+EOF
+      if AC_TRY_EVAL(ac_assemble); then
+        changequote(<,>)
+        gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
+             -e 's;[^1-9]*\([0-9]*\).*;\1;'`
+        changequote([, ])dnl
+        if test "$gmp_tmp_val" = "4"; then
+          gmp_cv_check_asm_w32="$gmp_tmp_op"
+          break
+        fi
+      fi
+    done
+    ;;
+esac
+
+if test -z "$gmp_cv_check_asm_w32"; then
+  echo; echo ["configure: $0: fatal: do not know how to define a 32-bit word"]
+  exit 1
+fi
+rm -f conftest*
+])
+echo ["define(<W32>, <$gmp_cv_check_asm_w32>)"] >> $gmp_tmpconfigm4
+])
+
+dnl  GMP_CHECK_ASM_MMX([ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND]])
+dnl  Can we assemble MMX insns?
+AC_DEFUN(GMP_CHECK_ASM_MMX,
+[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
+AC_CACHE_CHECK([if the assembler knows about MMX instructions],
+		gmp_cv_check_asm_mmx,
+[cat > conftest.s <<EOF
+	$gmp_cv_check_asm_text
+	por	%mm0, %mm0
+EOF
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+if AC_TRY_EVAL(ac_assemble); then
+  gmp_cv_check_asm_mmx=yes
+else 
+  gmp_cv_check_asm_mmx=no
+fi
+rm -f conftest*
+])
+if test "$gmp_cv_check_asm_mmx" = "yes"; then
+  ifelse([$1], , :, [$1])
+else
+  AC_MSG_WARN([+----------------------------------------------------------])
+  AC_MSG_WARN([| WARNING WARNING WARNING])
+  AC_MSG_WARN([| Target CPU has MMX code, but it can't be assembled by])
+  AC_MSG_WARN([|     $CCAS $CFLAGS])
+  AC_MSG_WARN([| Non-MMX replacements will be used.])
+  AC_MSG_WARN([| This will be an inferior build.])
+  AC_MSG_WARN([+----------------------------------------------------------])
+  ifelse([$2], , :, [$2])
+fi
+])dnl
+
+dnl  GMP_CHECK_ASM_SHLDL_CL([ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND]])
+AC_DEFUN(GMP_CHECK_ASM_SHLDL_CL,
+[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
+AC_CACHE_CHECK([if the assembler takes cl with shldl],
+		gmp_cv_check_asm_shldl_cl,
+[cat > conftest.s <<EOF
+	$gmp_cv_check_asm_text
+	shldl	%cl, %eax, %ebx
+EOF
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+if AC_TRY_EVAL(ac_assemble); then
+  gmp_cv_check_asm_shldl_cl=yes
+else 
+  gmp_cv_check_asm_shldl_cl=no
+fi
+rm -f conftest*
+])
+if test "$gmp_cv_check_asm_shldl_cl" = "yes"; then
+  ifelse([$1], , :, [$1])
+else
+  ifelse([$2], , :, [$2])
+fi
+])dnl
+
+dnl  GMP_PROG_CC_WORKS(CC, CFLAGS, ACTION-IF-WORKS, [ACTION-IF-NOT-WORKS])
+dnl  Check if CC can compile and link.  Perform various target specific tests.
+dnl  FIXME: Require `$target'.
+AC_DEFUN(GMP_PROG_CC_WORKS,
+[AC_LANG_C	dnl  Note: Destructive.
+CC="[$1]"
+CFLAGS="[$2]"
+AC_MSG_CHECKING([if the C compiler ($CC) works with flags $CFLAGS])
+
+# Simple test for all targets.
+AC_TRY_COMPILER([int main(){return(0);}],
+                tmp_works, tmp_cross)
+
+# Target specific tests.
+if test "$tmp_works" = "yes"; then
+  case "$target" in 
+    *-*-aix*)	# Returning a funcptr.
+      AC_TRY_COMPILE( , [} void *g(); void *f() { return g(); } int bar(){],
+                      tmp_works=yes, tmp_works=no)
+      ;;
+  esac
+fi
+
+if test "$tmp_works" = "yes"; then
+  [$3]
+else
+  ifelse([$4], , :, [$4])
+fi
+
+AC_MSG_RESULT($tmp_works)
+])dnl
+
+
+dnl  GMP_C_ANSI2KNR
+dnl  --------------
+dnl  Setup to use ansi2knr if necessary.
+dnl
+dnl  The test here is simply that if an ANSI style function works then
+dnl  ansi2knr isn't needed.  The normal tests for whether $CC works mean we
+dnl  don't need to worry here about anything badly broken.
+dnl
+dnl  AM_C_PROTOTYPES is the normal way to set up ansi2knr, but (in automake
+dnl  March 2000) it gives the wrong answer on a C++ compiler because its
+dnl  test requires that the compiler accept both ANSI and K&R, or otherwise
+dnl  ansi2knr is used.  A C++ compiler fails on the K&R part, which makes
+dnl  AM_C_PROTOTYPES think it needs ansi2knr!  GMP has no bare K&R so we
+dnl  only need ANSI or K&R to work, not both.
+
+AC_DEFUN(GMP_C_ANSI2KNR,
+[AC_CACHE_CHECK([if ansi2knr should be used],
+                gmp_cv_c_ansi2knr,
+[cat >conftest.c <<EOF
+int main (int argc, char *argv[]) { return 0; }
+EOF
+if AC_TRY_EVAL(ac_compile); then
+  gmp_cv_c_ansi2knr=no
+else
+  gmp_cv_c_ansi2knr=yes
+fi
+rm -f conftest.*
+])
+if test $gmp_cv_c_ansi2knr = no; then
+  U= ANSI2KNR=
+else
+  U=_ ANSI2KNR=./ansi2knr
+  # Ensure some checks needed by ansi2knr itself.
+  AC_HEADER_STDC
+  AC_CHECK_HEADERS(string.h)
+fi
+AC_SUBST(U)
+AC_SUBST(ANSI2KNR)
+])
+
+
+dnl  Deal with bad synchronization of Autoconf with Libtool.
+AC_DEFUN(AC_CANONICAL_BUILD, [_AC_CANONICAL_BUILD])
+AC_DEFUN(AC_CHECK_TOOL_PREFIX, [_AC_CHECK_TOOL_PREFIX])
diff --git a/src/gmp/aclocal.m4 b/src/gmp/aclocal.m4
new file mode 100644
index 000000000..cd2aa5de9
--- /dev/null
+++ b/src/gmp/aclocal.m4
@@ -0,0 +1,1515 @@
+dnl aclocal.m4 generated automatically by aclocal 1.4
+
+dnl Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl 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  GMP specific autoconf macros
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+dnl  GMP_HEADER_GETVAL(NAME,FILE)
+dnl  ----------------------------
+dnl  Expand to the value of a "#define NAME" from the given FILE.
+dnl  The regexps here aren't very rugged, but are enough for gmp.
+dnl  /dev/null as a parameter prevents a hang if $2 is accidentally omitted.
+
+define(GMP_HEADER_GETVAL,
+[patsubst(patsubst(
+esyscmd([grep "^#define $1 " $2 /dev/null 2>/dev/null]),
+[^.*$1[ 	]+],[]),
+[[
+ 	]*$],[])])
+
+
+dnl  GMP_VERSION
+dnl  -----------
+dnl  The gmp version number, extracted from the #defines in gmp.h.
+dnl  Two digits like 3.0 if patchlevel <= 0, or three digits like 3.0.1 if
+dnl  patchlevel > 0.
+
+define(GMP_VERSION,
+[GMP_HEADER_GETVAL(__GNU_MP_VERSION,gmp.h)[]dnl
+.GMP_HEADER_GETVAL(__GNU_MP_VERSION_MINOR,gmp.h)[]dnl
+ifelse(m4_eval(GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp.h) > 0),1,
+[.GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp.h)])])
+
+
+dnl  GMP_PROG_M4()
+dnl  -------------
+dnl
+dnl  Find a working m4, either in $PATH or likely locations, and setup $M4
+dnl  and an AC_SUBST accordingly.  If $M4 is already set then it's a user
+dnl  choice and is accepted with no checks.  GMP_PROG_M4 is like
+dnl  AC_PATH_PROG or AC_CHECK_PROG, but it tests each m4 found to see if
+dnl  it's good enough.
+dnl 
+dnl  See mpn/asm-defs.m4 for details on the known bad m4s.
+
+AC_DEFUN(GMP_PROG_M4,
+[AC_CACHE_CHECK([for suitable m4],
+                gmp_cv_prog_m4,
+[if test -n "$M4"; then
+  gmp_cv_prog_m4="$M4"
+else
+  cat >conftest.m4 <<\EOF
+dnl  must protect this against being expanded during autoconf m4!
+[define(dollarhash,``$][#'')dnl
+ifelse(dollarhash(x),1,`define(t1,Y)',
+``bad: $][# not supported (SunOS /usr/bin/m4)
+'')dnl
+ifelse(eval(89),89,`define(t2,Y)',
+`bad: eval() doesnt support 8 or 9 in a constant (OpenBSD 2.6 m4)
+')dnl
+ifelse(t1`'t2,YY,`good
+')dnl]
+EOF
+  echo "trying m4" 1>&AC_FD_CC
+  gmp_tmp_val="`(m4 conftest.m4) 2>&AC_FD_CC`"
+  echo "$gmp_tmp_val" 1>&AC_FD_CC
+  if test "$gmp_tmp_val" = good; then
+    gmp_cv_prog_m4="m4"
+  else
+    IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+dnl $ac_dummy forces splitting on constant user-supplied paths.
+dnl POSIX.2 word splitting is done only on the output of word expansions,
+dnl not every word.  This closes a longstanding sh security hole.
+    ac_dummy="$PATH:/usr/5bin"
+    for ac_dir in $ac_dummy; do
+      test -z "$ac_dir" && ac_dir=.
+      echo "trying $ac_dir/m4" 1>&AC_FD_CC
+      gmp_tmp_val="`($ac_dir/m4 conftest.m4) 2>&AC_FD_CC`"
+      echo "$gmp_tmp_val" 1>&AC_FD_CC
+      if test "$gmp_tmp_val" = good; then
+        gmp_cv_prog_m4="$ac_dir/m4"
+        break
+      fi
+    done
+    IFS="$ac_save_ifs"
+    if test -z "$gmp_cv_prog_m4"; then
+      AC_MSG_ERROR([No usable m4 in \$PATH or /usr/5bin (see config.log for reasons).])
+    fi
+  fi
+  rm -f conftest.m4
+fi])
+M4="$gmp_cv_prog_m4"
+AC_SUBST(M4)
+])
+
+
+dnl  GMP_PROG_CC_FIND([CC_LIST], [REQ_64BIT_CC])
+dnl  Find first working compiler in CC_LIST.
+dnl  If REQ_64BIT_CC is "yes", the compiler is required to be able to 
+dnl  produce 64-bit code.
+dnl  NOTE: If a compiler needs any special flags for producing 64-bit code,
+dnl  these have to be found in shell variable `gmp_cflags64_{cc}', where `{cc}'
+dnl  is the name of the compiler.
+dnl  Set CC to the name of the first working compiler.
+dnl  If a 64-bit compiler is found, set CC64 to the name of the compiler and
+dnl  CFLAGS64 to flags to use.
+dnl  This macro does not test if any of the compilers found is a GNU compiler.
+dnl  To do this, when you have finally made up your mind on which one to use, 
+dnl  and set CC accordingly, invoke [GMP_PROG_CC_SELECT].  That macro will 
+dnl  also make sure that your selection of CFLAGS is valid.
+dnl
+AC_DEFUN(GMP_PROG_CC_FIND,
+[AC_BEFORE([$0], [CC_PROG_CPP])
+ifelse([$1], , gmp_cc_list="gcc cc", gmp_cc_list="[$1]")
+ifelse([$2], , gmp_req_64bit_cc="no", gmp_req_64bit_cc="[$2]")
+
+CC32=
+CC64=
+for c in $gmp_cc_list; do
+  # Avoid cache hits.
+  unset CC
+  unset ac_cv_prog_CC
+  AC_CHECK_TOOL(CC, $c, $c)
+  if test -n "$CC"; then
+    eval c_flags=\$gmp_cflags_$c
+    GMP_PROG_CC_WORKS($CC, $c_flags,
+		      gmp_prog_cc_works=yes, 
+		      gmp_prog_cc_works=no)
+
+    if test "$gmp_prog_cc_works" != "yes"; then
+      continue
+    fi
+
+    # Save first working compiler, whether 32- or 64-bit capable.
+    if test -z "$CC32"; then
+      CC32="$CC"
+    fi
+    if test "$gmp_req_64bit_cc" = "yes"; then
+      eval c_flags=\$gmp_cflags64_$c
+
+      # Verify that the compiler works in 64-bit mode as well.
+      # /usr/ucb/cc on Solaris 7 can *compile* in 64-bit mode, but not link.
+      GMP_PROG_CC_WORKS($c, $c_flags,
+		      	gmp_prog_cc_works=yes, 
+		      	gmp_prog_cc_works=no)
+
+      if test "$gmp_prog_cc_works" = "yes"; then
+        GMP_CHECK_CC_64BIT($c, $c_flags)
+        if test "$gmp_cv_cc_64bit" = "yes"; then
+          test -z "$CC64" && CC64="$c"
+          test -z "$CFLAGS64" && CFLAGS64="$c_flags"
+	  # We have CC64 so we're done.
+          break
+        fi
+      fi
+    else
+      # We have CC32, and we don't need a 64-bit compiler so we're done.
+      break
+    fi
+  fi
+done
+CC="$CC32"
+])dnl
+
+dnl  GMP_PROG_CC_SELECT
+dnl  Check that `CC' works with `CFLAGS'.  Check if `CC' is a GNU compiler.
+dnl  Cache the result as `ac_cv_prog_CC'.
+AC_DEFUN(GMP_PROG_CC_SELECT,
+[AC_BEFORE([$0], [CC_PROG_CPP])
+AC_PROG_CC_WORKS
+AC_PROG_CC_GNU
+
+if test "$ac_cv_prog_gcc" = "yes"; then
+  GCC=yes
+else
+  GCC=
+fi
+
+# Set CFLAGS if not already set.
+if test -z "$CFLAGS"; then
+  CFLAGS="-g"
+  if test "$GCC" = "yes"; then
+    CFLAGS="$CFLAGS -O2"
+  fi
+fi
+
+AC_SUBST(CC)
+AC_CACHE_VAL(ac_cv_prog_CC, ac_cv_prog_CC="$CC")
+AC_PROVIDE([AC_PROG_CC])
+])dnl
+
+dnl  GMP_CHECK_CC_64BIT(cc, cflags64)
+dnl  Find out if `CC' can produce 64-bit code.
+dnl  Requires NM to be set to nm for target.
+dnl  FIXME: Cache result.
+AC_DEFUN(GMP_CHECK_CC_64BIT,
+[
+  gmp_tmp_CC_save="$CC"
+  CC="[$1]"
+  AC_MSG_CHECKING([whether the C compiler ($CC) is 64-bit capable])
+  if test -z "$NM"; then
+    echo; echo ["configure: $0: fatal: need nm"]
+    exit 1
+  fi
+  gmp_tmp_CFLAGS_save="$CFLAGS"
+  CFLAGS="[$2]"
+
+  case "$target" in 
+    hppa2.0*-*-*)
+      # FIXME: If gcc is installed under another name than "gcc", we will 
+      # test the wrong thing.
+      if test "$CC" != "gcc"; then
+        dnl Let compiler version A.10.32.30 or higher be ok.
+        dnl Bad compiler output:
+        dnl   ccom: HP92453-01 G.10.32.05 HP C Compiler
+        dnl Good compiler output:
+        dnl   ccom: HP92453-01 A.10.32.30 HP C Compiler
+        echo >conftest.c
+        gmp_tmp_vs=`$CC $CFLAGS -V -c -o conftest.o conftest.c 2>&1 | grep "^ccom:"`
+        rm conftest*
+        gmp_tmp_v1=`echo $gmp_tmp_vs | sed 's/.* .\.\(.*\)\..*\..* HP C.*/\1/'`
+        gmp_tmp_v2=`echo $gmp_tmp_vs | sed 's/.* .\..*\.\(.*\)\..* HP C.*/\1/'`
+        gmp_tmp_v3=`echo $gmp_tmp_vs | sed 's/.* .\..*\..*\.\(.*\) HP C.*/\1/'`
+	gmp_cv_cc_64bit=no
+	test -n "$gmp_tmp_v1" && test "$gmp_tmp_v1" -ge "10" \
+  	  && test -n "$gmp_tmp_v2" && test "$gmp_tmp_v2" -ge "32" \
+    	  && test -n "$gmp_tmp_v3" && test "$gmp_tmp_v3" -ge "30" \
+	  && gmp_cv_cc_64bit=yes
+      else	# gcc
+	# FIXME: Compile a minimal file and determine if the resulting object 
+	# file is an ELF file.  If so, gcc can produce 64-bit code.
+	# Do we have file(1) for target?
+	gmp_cv_cc_64bit=no
+      fi
+      ;;
+    mips-sgi-irix6.*)
+      # We use `-n32' to cc and `-mabi=n32' to gcc, resulting in 64-bit 
+      # arithmetic but not 64-bit pointers, so the general test for sizeof
+      # (void *) is not valid.
+      # Simply try to compile an empty main.  If that succeeds return
+      # true.
+      AC_TRY_COMPILE( , ,
+                     gmp_cv_cc_64bit=yes, gmp_cv_cc_64bit=no,
+                     gmp_cv_cc_64bit=no)
+      ;;
+    *-*-*)
+      # Allocate an array of size sizeof (void *) and use nm to determine its 
+      # size.  We depend on the first declared variable being put at address 0.
+      cat >conftest.c <<EOF
+[char arr[sizeof (void *)]={0};
+char post=0;]
+EOF
+      gmp_compile="$CC $CFLAGS -c conftest.c 1>&AC_FD_CC"
+      if AC_TRY_EVAL(gmp_compile); then
+        changequote(<,>)dnl
+	gmp_tmp_val=`$NM conftest.o | grep post | sed -e 's;[[][0-9][]]\(.*\);\1;' \
+          -e 's;[^1-9]*\([0-9]*\).*;\1;'`
+        changequote([, ])dnl
+        if test "$gmp_tmp_val" = "8"; then
+	  gmp_cv_cc_64bit=yes
+	else
+	  gmp_cv_cc_64bit=no
+        fi
+      else
+        echo "configure: failed program was:" >&AC_FD_CC
+        cat conftest.$ac_ext >&AC_FD_CC
+        gmp_cv_cc_64bit=no
+      fi
+      rm -f conftest*
+      ;;
+  esac
+
+  CC="$gmp_tmp_CC_save"
+  CFLAGS="$gmp_tmp_CFLAGS_save"
+  AC_MSG_RESULT($gmp_cv_cc_64bit)
+])dnl
+
+dnl  GMP_INIT([M4-DEF-FILE])
+dnl  
+AC_DEFUN(GMP_INIT,
+[ifelse([$1], , gmp_configm4=config.m4, gmp_configm4="[$1]")
+gmp_tmpconfigm4=cnfm4.tmp
+gmp_tmpconfigm4i=cnfm4i.tmp
+gmp_tmpconfigm4p=cnfm4p.tmp
+test -f $gmp_tmpconfigm4 && rm $gmp_tmpconfigm4
+test -f $gmp_tmpconfigm4i && rm $gmp_tmpconfigm4i
+test -f $gmp_tmpconfigm4p && rm $gmp_tmpconfigm4p
+])dnl
+
+dnl  GMP_FINISH
+dnl  ----------
+dnl  Create config.m4 from its accumulated parts.
+dnl
+dnl  __CONFIG_M4_INCLUDED__ is used so that a second or subsequent include
+dnl  of config.m4 is harmless.
+dnl
+dnl  A separate ifdef on the angle bracket quoted part ensures the quoting
+dnl  style there is respected.  The basic defines from gmp_tmpconfigm4 are
+dnl  fully quoted but are still put under an ifdef in case any have been
+dnl  redefined by one of the m4 include files.
+dnl
+dnl  Doing a big ifdef within asm-defs.m4 and/or other macro files wouldn't
+dnl  work, since it'd interpret parentheses and quotes in dnl comments, and
+dnl  having a whole file as a macro argument would overflow the string space
+dnl  on BSD m4.
+
+AC_DEFUN(GMP_FINISH,
+[AC_REQUIRE([GMP_INIT])
+echo "creating $gmp_configm4"
+echo ["dnl $gmp_configm4.  Generated automatically by configure."] > $gmp_configm4
+if test -f $gmp_tmpconfigm4; then
+  echo ["changequote(<,>)dnl"] >> $gmp_configm4
+  echo ["ifdef(<__CONFIG_M4_INCLUDED__>,,<"] >> $gmp_configm4
+  cat $gmp_tmpconfigm4 >> $gmp_configm4
+  echo [">)"] >> $gmp_configm4
+  echo ["changequote(\`,')dnl"] >> $gmp_configm4
+  rm $gmp_tmpconfigm4
+fi
+echo ["ifdef(\`__CONFIG_M4_INCLUDED__',,\`"] >> $gmp_configm4
+if test -f $gmp_tmpconfigm4i; then
+  cat $gmp_tmpconfigm4i >> $gmp_configm4
+  rm $gmp_tmpconfigm4i
+fi
+if test -f $gmp_tmpconfigm4p; then
+  cat $gmp_tmpconfigm4p >> $gmp_configm4
+  rm $gmp_tmpconfigm4p
+fi
+echo ["')"] >> $gmp_configm4
+echo ["define(\`__CONFIG_M4_INCLUDED__')"] >> $gmp_configm4
+])dnl
+
+dnl  GMP_INCLUDE(FILE)
+AC_DEFUN(GMP_INCLUDE,
+[AC_REQUIRE([GMP_INIT])
+echo ["include(\`$1')"] >> $gmp_tmpconfigm4i
+])dnl
+
+dnl  GMP_SINCLUDE(FILE)
+AC_DEFUN(GMP_SINCLUDE,
+[AC_REQUIRE([GMP_INIT])
+echo ["sinclude(\`$1')"] >> $gmp_tmpconfigm4i
+])dnl
+
+dnl GMP_DEFINE(MACRO, DEFINITION [, LOCATION])
+dnl [ Define M4 macro MACRO as DEFINITION in temporary file.		]
+dnl [ If LOCATION is `POST', the definition will appear after any	]
+dnl [ include() directives inserted by GMP_INCLUDE/GMP_SINCLUDE.	]
+dnl [ Mind the quoting!  No shell variables will get expanded.		]
+dnl [ Don't forget to invoke GMP_FINISH to create file config.m4.	]
+dnl [ config.m4 uses `<' and '>' as quote characters for all defines.	]
+AC_DEFUN(GMP_DEFINE, 
+[AC_REQUIRE([GMP_INIT])
+echo ['define(<$1>, <$2>)'] >> ifelse([$3], [POST], $gmp_tmpconfigm4p, $gmp_tmpconfigm4)
+])dnl
+
+dnl GMP_DEFINE_RAW(STRING, [, LOCATION])
+dnl [ Put STRING in temporary file.					]
+dnl [ If LOCATION is `POST', the definition will appear after any	]
+dnl [ include() directives inserted by GMP_INCLUDE/GMP_SINCLUDE.	]
+dnl [ Don't forget to invoke GMP_FINISH to create file config.m4.	]
+AC_DEFUN(GMP_DEFINE_RAW,
+[AC_REQUIRE([GMP_INIT])
+echo [$1] >> ifelse([$2], [POST], $gmp_tmpconfigm4p, $gmp_tmpconfigm4)
+])dnl
+
+dnl  GMP_CHECK_ASM_LABEL_SUFFIX
+dnl  Should a label have a colon or not?
+AC_DEFUN(GMP_CHECK_ASM_LABEL_SUFFIX,
+[AC_CACHE_CHECK([what assembly label suffix to use],
+               gmp_cv_check_asm_label_suffix,
+[case "$target" in 
+  *-*-hpux*) gmp_cv_check_asm_label_suffix=[""] ;;
+  *) gmp_cv_check_asm_label_suffix=[":"] ;;
+esac
+])
+echo ["define(<LABEL_SUFFIX>, <\$][1$gmp_cv_check_asm_label_suffix>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_UNDERSCORE([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
+dnl  Shamelessly borrowed from glibc.
+AC_DEFUN(GMP_CHECK_ASM_UNDERSCORE,
+[AC_CACHE_CHECK([if symbols are prefixed by underscore], 
+	        gmp_cv_check_asm_underscore,
+[cat > conftest.$ac_ext <<EOF
+dnl This sometimes fails to find confdefs.h, for some reason.
+dnl [#]line __oline__ "[$]0"
+[#]line __oline__ "configure"
+#include "confdefs.h"
+int underscore_test() {
+return; }
+EOF
+if AC_TRY_EVAL(ac_compile); then
+  if grep _underscore_test conftest* >/dev/null; then
+    gmp_cv_check_asm_underscore=yes
+  else
+    gmp_cv_check_asm_underscore=no
+  fi
+else
+  echo "configure: failed program was:" >&AC_FD_CC
+  cat conftest.$ac_ext >&AC_FD_CC
+fi
+rm -f conftest*
+])
+if test "$gmp_cv_check_asm_underscore" = "yes"; then
+  GMP_DEFINE(GSYM_PREFIX, [_])
+  ifelse([$1], , :, [$1])
+else
+  GMP_DEFINE(GSYM_PREFIX, [])
+  ifelse([$2], , :, [$2])
+fi    
+])dnl
+
+dnl  GMP_CHECK_ASM_ALIGN_LOG([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
+dnl  Is parameter to `.align' logarithmic?
+dnl  Requires NM to be set to nm for target.
+AC_DEFUN(GMP_CHECK_ASM_ALIGN_LOG,
+[AC_REQUIRE([GMP_CHECK_ASM_GLOBL])
+AC_REQUIRE([GMP_CHECK_ASM_DATA])
+AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
+AC_CACHE_CHECK([if .align assembly directive is logarithmic],
+		gmp_cv_check_asm_align_log,
+[if test -z "$NM"; then
+  echo; echo ["configure: $0: fatal: need nm"]
+  exit 1
+fi
+cat > conftest.s <<EOF
+      	$gmp_cv_check_asm_data
+      	.align  4
+	$gmp_cv_check_asm_globl	foo
+	.byte	1
+	.align	4
+foo$gmp_cv_check_asm_label_suffix
+	.byte	2
+EOF
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+if AC_TRY_EVAL(ac_assemble); then
+  changequote(<,>)
+  gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
+       -e 's;[^1-9]*\([0-9]*\).*;\1;'`
+  changequote([, ])dnl
+  if test "$gmp_tmp_val" = "10" || test "$gmp_tmp_val" = "16"; then
+    gmp_cv_check_asm_align_log=yes
+  else
+    gmp_cv_check_asm_align_log=no
+  fi
+else 
+  echo "configure: failed program was:" >&AC_FD_CC
+  cat conftest.s >&AC_FD_CC
+fi
+rm -f conftest*
+])
+GMP_DEFINE_RAW(["define(<ALIGN_LOGARITHMIC>,<$gmp_cv_check_asm_align_log>)"])
+if test "$gmp_cv_check_asm_align_log" = "yes"; then
+  ifelse([$1], , :, [$1])
+else
+  ifelse([$2], , :, [$2])
+fi  
+])dnl
+
+
+dnl  GMP_CHECK_ASM_ALIGN_FILL_0x90
+dnl  -----------------------------
+dnl  Determine whether a ",0x90" suffix works on a .align directive.
+dnl  This is only meant for use on x86, where 0x90 is a "nop".
+dnl
+dnl  Old gas, eg. 1.92.3 - needs ",0x90" or else the fill is an invalid 0x00.
+dnl  New gas, eg. 2.91 - generates the good multibyte nop fills even when
+dnl                      ",0x90" is given.
+dnl  Solaris 2.6 as - doesn't allow ",0x90", gives a fatal error.
+dnl  Solaris 2.8 as - gives a warning for ",0x90", no ill effect.
+dnl
+dnl  Note that both solaris "as"s only care about ",0x90" if they actually
+dnl  have to use it to fill something, hence the .byte in the sample.  It's
+dnl  only the second .align that provokes an error or warning.
+dnl
+dnl  We prefer to suppress the warning from solaris 2.8 to stop anyone
+dnl  worrying something might be wrong.
+
+AC_DEFUN(GMP_CHECK_ASM_ALIGN_FILL_0x90,
+[AC_CACHE_CHECK([if the .align directive accepts an 0x90 fill in .text],
+                gmp_cv_check_asm_align_fill_0x90,
+[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
+cat > conftest.s <<EOF
+      	$gmp_cv_check_asm_text
+      	.align  4, 0x90
+	.byte   0
+      	.align  4, 0x90
+EOF
+gmp_tmp_val="`$CCAS $CFLAGS conftest.s 2>&1`"
+if test $? = 0; then
+  echo "$gmp_tmp_val" 1>&AC_FD_CC
+  if echo "$gmp_tmp_val" | grep "Warning: Fill parameter ignored for executable section"; then
+    echo "Supressing this warning by omitting 0x90" 1>&AC_FD_CC
+    gmp_cv_check_asm_align_fill_0x90=no
+  else
+    gmp_cv_check_asm_align_fill_0x90=yes
+  fi
+else
+  echo "Non-zero exit code" 1>&AC_FD_CC
+  echo "$gmp_tmp_val" 1>&AC_FD_CC
+  gmp_cv_check_asm_align_fill_0x90=no
+fi
+rm -f conftest*
+])
+GMP_DEFINE_RAW(
+["define(<ALIGN_FILL_0x90>,<$gmp_cv_check_asm_align_fill_0x90>)"])
+])
+
+
+dnl  GMP_CHECK_ASM_TEXT
+AC_DEFUN(GMP_CHECK_ASM_TEXT,
+[AC_CACHE_CHECK([how to switch to text section], gmp_cv_check_asm_text,
+[case "$target" in
+  *-*-aix*)
+    changequote({, })
+    gmp_cv_check_asm_text={".csect .text[PR]"}
+    changequote([, ])
+    ;;
+  *-*-hpux*) gmp_cv_check_asm_text=[".code"] ;;
+  *) gmp_cv_check_asm_text=[".text"] ;;
+esac
+])
+echo ["define(<TEXT>, <$gmp_cv_check_asm_text>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_DATA
+dnl  Can we say `.data'?
+AC_DEFUN(GMP_CHECK_ASM_DATA,
+[AC_CACHE_CHECK([how to switch to data section], gmp_cv_check_asm_data,
+[case "$target" in
+  *-*-aix*)
+    changequote({, })
+    gmp_cv_check_asm_data={".csect .data[RW]"}
+    changequote([, ])
+    ;;
+  *) gmp_cv_check_asm_data=[".data"] ;;
+esac
+])
+echo ["define(<DATA>, <$gmp_cv_check_asm_data>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_GLOBL
+dnl  Can we say `.global'?
+AC_DEFUN(GMP_CHECK_ASM_GLOBL,
+[AC_CACHE_CHECK([how to export a symbol], gmp_cv_check_asm_globl,
+[case "$target" in
+  *-*-hpux*) gmp_cv_check_asm_globl=[".export"] ;;
+  *) gmp_cv_check_asm_globl=[".globl"] ;;
+esac
+])
+echo ["define(<GLOBL>, <$gmp_cv_check_asm_globl>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_TYPE
+dnl  Can we say `.type'?
+AC_DEFUN(GMP_CHECK_ASM_TYPE,
+[AC_CACHE_CHECK([how the .type assembly directive should be used],
+gmp_cv_check_asm_type,
+[ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+for gmp_tmp_prefix in @ \# %; do
+  echo "	.type	sym,${gmp_tmp_prefix}function" > conftest.s
+  if AC_TRY_EVAL(ac_assemble); then
+    gmp_cv_check_asm_type="[.type	\$][1,${gmp_tmp_prefix}\$][2]"
+    break
+  fi
+done
+if test -z "$gmp_cv_check_asm_type"; then
+  gmp_cv_check_asm_type="[dnl]"
+fi
+])
+echo ["define(<TYPE>, <$gmp_cv_check_asm_type>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_SIZE
+dnl  Can we say `.size'?
+AC_DEFUN(GMP_CHECK_ASM_SIZE,
+[AC_CACHE_CHECK([if the .size assembly directive works], gmp_cv_check_asm_size,
+[ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+echo '	.size	sym,1' > conftest.s
+if AC_TRY_EVAL(ac_assemble); then
+  gmp_cv_check_asm_size="[.size	\$][1,\$][2]"
+else
+  gmp_cv_check_asm_size="[dnl]"
+fi
+])
+echo ["define(<SIZE>, <$gmp_cv_check_asm_size>)"] >> $gmp_tmpconfigm4
+])dnl
+
+dnl  GMP_CHECK_ASM_LSYM_PREFIX
+dnl  What is the prefix for a local label?
+dnl  Requires NM to be set to nm for target.
+AC_DEFUN(GMP_CHECK_ASM_LSYM_PREFIX,
+[AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
+AC_CACHE_CHECK([what prefix to use for a local label], 
+gmp_cv_check_asm_lsym_prefix,
+[if test -z "$NM"; then
+  echo; echo ["$0: fatal: need nm"]
+  exit 1
+fi
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+gmp_cv_check_asm_lsym_prefix="L"
+for gmp_tmp_pre in L .L $ L$; do
+  cat > conftest.s <<EOF
+dummy${gmp_cv_check_asm_label_suffix}
+${gmp_tmp_pre}gurkmacka${gmp_cv_check_asm_label_suffix}
+	.byte 0
+EOF
+  if AC_TRY_EVAL(ac_assemble); then
+    $NM conftest.o >/dev/null 2>&1
+    gmp_rc=$?
+    if test "$gmp_rc" != "0"; then
+      echo "configure: $NM failure, using default"
+      break
+    fi
+    if $NM conftest.o | grep gurkmacka >/dev/null; then true; else
+      gmp_cv_check_asm_lsym_prefix="$gmp_tmp_pre"
+      break
+    fi
+  else
+    echo "configure: failed program was:" >&AC_FD_CC
+    cat conftest.s >&AC_FD_CC
+    # Use default.
+  fi
+done
+rm -f conftest*
+])
+echo ["define(<LSYM_PREFIX>, <${gmp_cv_check_asm_lsym_prefix}>)"] >> $gmp_tmpconfigm4
+])
+
+dnl  GMP_CHECK_ASM_W32
+dnl  How to [define] a 32-bit word.
+dnl  Requires NM to be set to nm for target.
+AC_DEFUN(GMP_CHECK_ASM_W32,
+[AC_REQUIRE([GMP_CHECK_ASM_DATA])
+AC_REQUIRE([GMP_CHECK_ASM_GLOBL])
+AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
+AC_CACHE_CHECK([how to [define] a 32-bit word],
+	       gmp_cv_check_asm_w32,
+[if test -z "$NM"; then
+  echo; echo ["configure: $0: fatal: need nm"]
+  exit 1
+fi
+
+# FIXME: HPUX puts first symbol at 0x40000000, breaking our assumption
+# that it's at 0x0.  We'll have to declare another symbol before the
+# .long/.word and look at the distance between the two symbols.  The
+# only problem is that the sed expression(s) barfs (on Solaris, for
+# example) for the symbol with value 0.  For now, HPUX uses .word.
+
+case "$target" in 
+  *-*-hpux*)
+    gmp_cv_check_asm_w32=".word"
+    ;;
+  *-*-*)
+    ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+    for gmp_tmp_op in .long .word; do
+      cat > conftest.s <<EOF
+	$gmp_cv_check_asm_data
+	$gmp_cv_check_asm_globl	foo
+	$gmp_tmp_op	0
+foo${gmp_cv_check_asm_label_suffix}
+	.byte	0
+EOF
+      if AC_TRY_EVAL(ac_assemble); then
+        changequote(<,>)
+        gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
+             -e 's;[^1-9]*\([0-9]*\).*;\1;'`
+        changequote([, ])dnl
+        if test "$gmp_tmp_val" = "4"; then
+          gmp_cv_check_asm_w32="$gmp_tmp_op"
+          break
+        fi
+      fi
+    done
+    ;;
+esac
+
+if test -z "$gmp_cv_check_asm_w32"; then
+  echo; echo ["configure: $0: fatal: do not know how to define a 32-bit word"]
+  exit 1
+fi
+rm -f conftest*
+])
+echo ["define(<W32>, <$gmp_cv_check_asm_w32>)"] >> $gmp_tmpconfigm4
+])
+
+dnl  GMP_CHECK_ASM_MMX([ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND]])
+dnl  Can we assemble MMX insns?
+AC_DEFUN(GMP_CHECK_ASM_MMX,
+[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
+AC_CACHE_CHECK([if the assembler knows about MMX instructions],
+		gmp_cv_check_asm_mmx,
+[cat > conftest.s <<EOF
+	$gmp_cv_check_asm_text
+	por	%mm0, %mm0
+EOF
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+if AC_TRY_EVAL(ac_assemble); then
+  gmp_cv_check_asm_mmx=yes
+else 
+  gmp_cv_check_asm_mmx=no
+fi
+rm -f conftest*
+])
+if test "$gmp_cv_check_asm_mmx" = "yes"; then
+  ifelse([$1], , :, [$1])
+else
+  AC_MSG_WARN([+----------------------------------------------------------])
+  AC_MSG_WARN([| WARNING WARNING WARNING])
+  AC_MSG_WARN([| Target CPU has MMX code, but it can't be assembled by])
+  AC_MSG_WARN([|     $CCAS $CFLAGS])
+  AC_MSG_WARN([| Non-MMX replacements will be used.])
+  AC_MSG_WARN([| This will be an inferior build.])
+  AC_MSG_WARN([+----------------------------------------------------------])
+  ifelse([$2], , :, [$2])
+fi
+])dnl
+
+dnl  GMP_CHECK_ASM_SHLDL_CL([ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND]])
+AC_DEFUN(GMP_CHECK_ASM_SHLDL_CL,
+[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
+AC_CACHE_CHECK([if the assembler takes cl with shldl],
+		gmp_cv_check_asm_shldl_cl,
+[cat > conftest.s <<EOF
+	$gmp_cv_check_asm_text
+	shldl	%cl, %eax, %ebx
+EOF
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
+if AC_TRY_EVAL(ac_assemble); then
+  gmp_cv_check_asm_shldl_cl=yes
+else 
+  gmp_cv_check_asm_shldl_cl=no
+fi
+rm -f conftest*
+])
+if test "$gmp_cv_check_asm_shldl_cl" = "yes"; then
+  ifelse([$1], , :, [$1])
+else
+  ifelse([$2], , :, [$2])
+fi
+])dnl
+
+dnl  GMP_PROG_CC_WORKS(CC, CFLAGS, ACTION-IF-WORKS, [ACTION-IF-NOT-WORKS])
+dnl  Check if CC can compile and link.  Perform various target specific tests.
+dnl  FIXME: Require `$target'.
+AC_DEFUN(GMP_PROG_CC_WORKS,
+[AC_LANG_C	dnl  Note: Destructive.
+CC="[$1]"
+CFLAGS="[$2]"
+AC_MSG_CHECKING([if the C compiler ($CC) works with flags $CFLAGS])
+
+# Simple test for all targets.
+AC_TRY_COMPILER([int main(){return(0);}],
+                tmp_works, tmp_cross)
+
+# Target specific tests.
+if test "$tmp_works" = "yes"; then
+  case "$target" in 
+    *-*-aix*)	# Returning a funcptr.
+      AC_TRY_COMPILE( , [} void *g(); void *f() { return g(); } int bar(){],
+                      tmp_works=yes, tmp_works=no)
+      ;;
+  esac
+fi
+
+if test "$tmp_works" = "yes"; then
+  [$3]
+else
+  ifelse([$4], , :, [$4])
+fi
+
+AC_MSG_RESULT($tmp_works)
+])dnl
+
+
+dnl  GMP_C_ANSI2KNR
+dnl  --------------
+dnl  Setup to use ansi2knr if necessary.
+dnl
+dnl  The test here is simply that if an ANSI style function works then
+dnl  ansi2knr isn't needed.  The normal tests for whether $CC works mean we
+dnl  don't need to worry here about anything badly broken.
+dnl
+dnl  AM_C_PROTOTYPES is the normal way to set up ansi2knr, but (in automake
+dnl  March 2000) it gives the wrong answer on a C++ compiler because its
+dnl  test requires that the compiler accept both ANSI and K&R, or otherwise
+dnl  ansi2knr is used.  A C++ compiler fails on the K&R part, which makes
+dnl  AM_C_PROTOTYPES think it needs ansi2knr!  GMP has no bare K&R so we
+dnl  only need ANSI or K&R to work, not both.
+
+AC_DEFUN(GMP_C_ANSI2KNR,
+[AC_CACHE_CHECK([if ansi2knr should be used],
+                gmp_cv_c_ansi2knr,
+[cat >conftest.c <<EOF
+int main (int argc, char *argv[]) { return 0; }
+EOF
+if AC_TRY_EVAL(ac_compile); then
+  gmp_cv_c_ansi2knr=no
+else
+  gmp_cv_c_ansi2knr=yes
+fi
+rm -f conftest.*
+])
+if test $gmp_cv_c_ansi2knr = no; then
+  U= ANSI2KNR=
+else
+  U=_ ANSI2KNR=./ansi2knr
+  # Ensure some checks needed by ansi2knr itself.
+  AC_HEADER_STDC
+  AC_CHECK_HEADERS(string.h)
+fi
+AC_SUBST(U)
+AC_SUBST(ANSI2KNR)
+])
+
+
+dnl  Deal with bad synchronization of Autoconf with Libtool.
+AC_DEFUN(AC_CANONICAL_BUILD, [_AC_CANONICAL_BUILD])
+AC_DEFUN(AC_CHECK_TOOL_PREFIX, [_AC_CHECK_TOOL_PREFIX])
+
+
+# serial 1
+
+AC_DEFUN(AM_C_PROTOTYPES,
+[AC_REQUIRE([AM_PROG_CC_STDC])
+AC_REQUIRE([AC_PROG_CPP])
+AC_MSG_CHECKING([for function prototypes])
+if test "$am_cv_prog_cc_stdc" != no; then
+  AC_MSG_RESULT(yes)
+  AC_DEFINE(PROTOTYPES,1,[Define if compiler has function prototypes])
+  U= ANSI2KNR=
+else
+  AC_MSG_RESULT(no)
+  U=_ ANSI2KNR=./ansi2knr
+  # Ensure some checks needed by ansi2knr itself.
+  AC_HEADER_STDC
+  AC_CHECK_HEADERS(string.h)
+fi
+AC_SUBST(U)dnl
+AC_SUBST(ANSI2KNR)dnl
+])
+
+
+# serial 1
+
+# @defmac AC_PROG_CC_STDC
+# @maindex PROG_CC_STDC
+# @ovindex CC
+# If the C compiler in not in ANSI C mode by default, try to add an option
+# to output variable @code{CC} to make it so.  This macro tries various
+# options that select ANSI C on some system or another.  It considers the
+# compiler to be in ANSI C mode if it handles function prototypes correctly.
+#
+# If you use this macro, you should check after calling it whether the C
+# compiler has been set to accept ANSI C; if not, the shell variable
+# @code{am_cv_prog_cc_stdc} is set to @samp{no}.  If you wrote your source
+# code in ANSI C, you can make an un-ANSIfied copy of it by using the
+# program @code{ansi2knr}, which comes with Ghostscript.
+# @end defmac
+
+AC_DEFUN(AM_PROG_CC_STDC,
+[AC_REQUIRE([AC_PROG_CC])
+AC_BEFORE([$0], [AC_C_INLINE])
+AC_BEFORE([$0], [AC_C_CONST])
+dnl Force this before AC_PROG_CPP.  Some cpp's, eg on HPUX, require
+dnl a magic option to avoid problems with ANSI preprocessor commands
+dnl like #elif.
+dnl FIXME: can't do this because then AC_AIX won't work due to a
+dnl circular dependency.
+dnl AC_BEFORE([$0], [AC_PROG_CPP])
+AC_MSG_CHECKING(for ${CC-cc} option to accept ANSI C)
+AC_CACHE_VAL(am_cv_prog_cc_stdc,
+[am_cv_prog_cc_stdc=no
+ac_save_CC="$CC"
+# Don't try gcc -ansi; that turns off useful extensions and
+# breaks some systems' header files.
+# AIX			-qlanglvl=ansi
+# Ultrix and OSF/1	-std1
+# HP-UX			-Aa -D_HPUX_SOURCE
+# SVR4			-Xc -D__EXTENSIONS__
+for ac_arg in "" -qlanglvl=ansi -std1 "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+  CC="$ac_save_CC $ac_arg"
+  AC_TRY_COMPILE(
+[#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+     char **p;
+     int i;
+{
+  return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+  char *s;
+  va_list v;
+  va_start (v,p);
+  s = g (p, va_arg (v,int));
+  va_end (v);
+  return s;
+}
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+], [
+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
+],
+[am_cv_prog_cc_stdc="$ac_arg"; break])
+done
+CC="$ac_save_CC"
+])
+if test -z "$am_cv_prog_cc_stdc"; then
+  AC_MSG_RESULT([none needed])
+else
+  AC_MSG_RESULT($am_cv_prog_cc_stdc)
+fi
+case "x$am_cv_prog_cc_stdc" in
+  x|xno) ;;
+  *) CC="$CC $am_cv_prog_cc_stdc" ;;
+esac
+])
+
+# 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([AC_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", [Name of package])
+AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package]))
+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])])
+
+#
+# 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)])
+
+# 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([,]))])
+
+# 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)
+  AM_CONDITIONAL(MAINTAINER_MODE, test $USE_MAINTAINER_MODE = yes)
+  MAINT=$MAINTAINER_MODE_TRUE
+  AC_SUBST(MAINT)dnl
+]
+)
+
+# Define a conditional.
+
+AC_DEFUN(AM_CONDITIONAL,
+[AC_SUBST($1_TRUE)
+AC_SUBST($1_FALSE)
+if $2; then
+  $1_TRUE=
+  $1_FALSE='#'
+else
+  $1_TRUE='#'
+  $1_FALSE=
+fi])
+
+
+# serial 40 AC_PROG_LIBTOOL
+AC_DEFUN(AC_PROG_LIBTOOL,
+[AC_REQUIRE([AC_LIBTOOL_SETUP])dnl
+
+# Save cache, so that ltconfig can load it
+AC_CACHE_SAVE
+
+# Actually configure libtool.  ac_aux_dir is where install-sh is found.
+CC="$CC" CFLAGS="$CFLAGS" CPPFLAGS="$CPPFLAGS" \
+LD="$LD" LDFLAGS="$LDFLAGS" LIBS="$LIBS" \
+LN_S="$LN_S" NM="$NM" RANLIB="$RANLIB" \
+DLLTOOL="$DLLTOOL" AS="$AS" OBJDUMP="$OBJDUMP" \
+${CONFIG_SHELL-/bin/sh} $ac_aux_dir/ltconfig --no-reexec \
+$libtool_flags --no-verify $ac_aux_dir/ltmain.sh $lt_target \
+|| AC_MSG_ERROR([libtool configure failed])
+
+# Reload cache, that may have been modified by ltconfig
+AC_CACHE_LOAD
+
+# This can be used to rebuild libtool when needed
+LIBTOOL_DEPS="$ac_aux_dir/ltconfig $ac_aux_dir/ltmain.sh"
+
+# Always use our own libtool.
+LIBTOOL='$(SHELL) $(top_builddir)/libtool'
+AC_SUBST(LIBTOOL)dnl
+
+# Redirect the config.log output again, so that the ltconfig log is not
+# clobbered by the next message.
+exec 5>>./config.log
+])
+
+AC_DEFUN(AC_LIBTOOL_SETUP,
+[AC_PREREQ(2.13)dnl
+AC_REQUIRE([AC_ENABLE_SHARED])dnl
+AC_REQUIRE([AC_ENABLE_STATIC])dnl
+AC_REQUIRE([AC_ENABLE_FAST_INSTALL])dnl
+AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_CANONICAL_BUILD])dnl
+AC_REQUIRE([AC_PROG_RANLIB])dnl
+AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([AC_PROG_LD])dnl
+AC_REQUIRE([AC_PROG_NM])dnl
+AC_REQUIRE([AC_PROG_LN_S])dnl
+dnl
+
+case "$target" in
+NONE) lt_target="$host" ;;
+*) lt_target="$target" ;;
+esac
+
+# Check for any special flags to pass to ltconfig.
+libtool_flags="--cache-file=$cache_file"
+test "$enable_shared" = no && libtool_flags="$libtool_flags --disable-shared"
+test "$enable_static" = no && libtool_flags="$libtool_flags --disable-static"
+test "$enable_fast_install" = no && libtool_flags="$libtool_flags --disable-fast-install"
+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"
+ifdef([AC_PROVIDE_AC_LIBTOOL_DLOPEN],
+[libtool_flags="$libtool_flags --enable-dlopen"])
+ifdef([AC_PROVIDE_AC_LIBTOOL_WIN32_DLL],
+[libtool_flags="$libtool_flags --enable-win32-dll"])
+AC_ARG_ENABLE(libtool-lock,
+  [  --disable-libtool-lock  avoid locking (might break parallel builds)])
+test "x$enable_libtool_lock" = xno && libtool_flags="$libtool_flags --disable-lock"
+test x"$silent" = xyes && libtool_flags="$libtool_flags --silent"
+
+# Some flags need to be propagated to the compiler or linker for good
+# libtool support.
+case "$lt_target" 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.
+  SAVE_CFLAGS="$CFLAGS"
+  CFLAGS="$CFLAGS -belf"
+  AC_CACHE_CHECK([whether the C compiler needs -belf], lt_cv_cc_needs_belf,
+    [AC_TRY_LINK([],[],[lt_cv_cc_needs_belf=yes],[lt_cv_cc_needs_belf=no])])
+  if test x"$lt_cv_cc_needs_belf" != x"yes"; then
+    # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
+    CFLAGS="$SAVE_CFLAGS"
+  fi
+  ;;
+
+ifdef([AC_PROVIDE_AC_LIBTOOL_WIN32_DLL],
+[*-*-cygwin* | *-*-mingw*)
+  AC_CHECK_TOOL(DLLTOOL, dlltool, false)
+  AC_CHECK_TOOL(AS, as, false)
+  AC_CHECK_TOOL(OBJDUMP, objdump, false)
+  ;;
+])
+esac
+])
+
+# AC_LIBTOOL_DLOPEN - enable checks for dlopen support
+AC_DEFUN(AC_LIBTOOL_DLOPEN, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])])
+
+# AC_LIBTOOL_WIN32_DLL - declare package support for building win32 dll's
+AC_DEFUN(AC_LIBTOOL_WIN32_DLL, [AC_BEFORE([$0], [AC_LIBTOOL_SETUP])])
+
+# AC_ENABLE_SHARED - implement the --enable-shared flag
+# Usage: AC_ENABLE_SHARED[(DEFAULT)]
+#   Where DEFAULT is either `yes' or `no'.  If omitted, it defaults to
+#   `yes'.
+AC_DEFUN(AC_ENABLE_SHARED, [dnl
+define([AC_ENABLE_SHARED_DEFAULT], ifelse($1, no, no, yes))dnl
+AC_ARG_ENABLE(shared,
+changequote(<<, >>)dnl
+<<  --enable-shared[=PKGS]  build shared libraries [default=>>AC_ENABLE_SHARED_DEFAULT],
+changequote([, ])dnl
+[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=AC_ENABLE_SHARED_DEFAULT)dnl
+])
+
+# AC_DISABLE_SHARED - set the default shared flag to --disable-shared
+AC_DEFUN(AC_DISABLE_SHARED, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+AC_ENABLE_SHARED(no)])
+
+# AC_ENABLE_STATIC - implement the --enable-static flag
+# Usage: AC_ENABLE_STATIC[(DEFAULT)]
+#   Where DEFAULT is either `yes' or `no'.  If omitted, it defaults to
+#   `yes'.
+AC_DEFUN(AC_ENABLE_STATIC, [dnl
+define([AC_ENABLE_STATIC_DEFAULT], ifelse($1, no, no, yes))dnl
+AC_ARG_ENABLE(static,
+changequote(<<, >>)dnl
+<<  --enable-static[=PKGS]  build static libraries [default=>>AC_ENABLE_STATIC_DEFAULT],
+changequote([, ])dnl
+[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=AC_ENABLE_STATIC_DEFAULT)dnl
+])
+
+# AC_DISABLE_STATIC - set the default static flag to --disable-static
+AC_DEFUN(AC_DISABLE_STATIC, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+AC_ENABLE_STATIC(no)])
+
+
+# AC_ENABLE_FAST_INSTALL - implement the --enable-fast-install flag
+# Usage: AC_ENABLE_FAST_INSTALL[(DEFAULT)]
+#   Where DEFAULT is either `yes' or `no'.  If omitted, it defaults to
+#   `yes'.
+AC_DEFUN(AC_ENABLE_FAST_INSTALL, [dnl
+define([AC_ENABLE_FAST_INSTALL_DEFAULT], ifelse($1, no, no, yes))dnl
+AC_ARG_ENABLE(fast-install,
+changequote(<<, >>)dnl
+<<  --enable-fast-install[=PKGS]  optimize for fast installation [default=>>AC_ENABLE_FAST_INSTALL_DEFAULT],
+changequote([, ])dnl
+[p=${PACKAGE-default}
+case "$enableval" in
+yes) enable_fast_install=yes ;;
+no) enable_fast_install=no ;;
+*)
+  enable_fast_install=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_fast_install=yes
+    fi
+  done
+  IFS="$ac_save_ifs"
+  ;;
+esac],
+enable_fast_install=AC_ENABLE_FAST_INSTALL_DEFAULT)dnl
+])
+
+# AC_ENABLE_FAST_INSTALL - set the default to --disable-fast-install
+AC_DEFUN(AC_DISABLE_FAST_INSTALL, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+AC_ENABLE_FAST_INSTALL(no)])
+
+# AC_PROG_LD - find the path to the GNU or non-GNU linker
+AC_DEFUN(AC_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])dnl
+AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_CANONICAL_BUILD])dnl
+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.
+changequote(,)dnl
+    [\\/]* | [A-Za-z]:[\\/]*)
+      re_direlt='/[^/][^/]*/\.\./'
+changequote([,])dnl
+      # Canonicalize the path of ld
+      ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
+      while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
+	ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
+      done
+      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}${PATH_SEPARATOR-:}"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; 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_PROG_LD_GNU
+])
+
+AC_DEFUN(AC_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])
+])
+
+# AC_PROG_NM - find the path to a BSD-compatible name lister
+AC_DEFUN(AC_PROG_NM,
+[AC_MSG_CHECKING([for BSD-compatible nm])
+AC_CACHE_VAL(ac_cv_path_NM,
+[if test -n "$NM"; then
+  # Let the user override the test.
+  ac_cv_path_NM="$NM"
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
+  for ac_dir in $PATH /usr/ccs/bin /usr/ucb /bin; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/nm || test -f $ac_dir/nm$ac_exeext ; 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"
+	break
+      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"
+	break
+      else
+	ac_cv_path_NM=${ac_cv_path_NM="$ac_dir/nm"} # keep the first match, but
+	continue # so that we can try to find one that supports BSD flags
+      fi
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_path_NM" && ac_cv_path_NM=nm
+fi])
+NM="$ac_cv_path_NM"
+AC_MSG_RESULT([$NM])
+])
+
+# AC_CHECK_LIBM - check for math library
+AC_DEFUN(AC_CHECK_LIBM,
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+LIBM=
+case "$lt_target" in
+*-*-beos* | *-*-cygwin*)
+  # These system don't have libm
+  ;;
+*-ncr-sysv4.3*)
+  AC_CHECK_LIB(mw, _mwvalidcheckl, LIBM="-lmw")
+  AC_CHECK_LIB(m, main, LIBM="$LIBM -lm")
+  ;;
+*)
+  AC_CHECK_LIB(m, main, LIBM="-lm")
+  ;;
+esac
+])
+
+# AC_LIBLTDL_CONVENIENCE[(dir)] - sets LIBLTDL to the link flags for
+# the libltdl convenience library, adds --enable-ltdl-convenience to
+# the configure arguments.  Note that LIBLTDL is not AC_SUBSTed, nor
+# is AC_CONFIG_SUBDIRS called.  If DIR is not provided, it is assumed
+# to be `${top_builddir}/libltdl'.  Make sure you start DIR with
+# '${top_builddir}/' (note the single quotes!) if your package is not
+# flat, and, if you're not using automake, define top_builddir as
+# appropriate in the Makefiles.
+AC_DEFUN(AC_LIBLTDL_CONVENIENCE, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+  case "$enable_ltdl_convenience" in
+  no) AC_MSG_ERROR([this package needs a convenience libltdl]) ;;
+  "") enable_ltdl_convenience=yes
+      ac_configure_args="$ac_configure_args --enable-ltdl-convenience" ;;
+  esac
+  LIBLTDL=ifelse($#,1,$1,['${top_builddir}/libltdl'])/libltdlc.la
+  INCLTDL=ifelse($#,1,-I$1,['-I${top_builddir}/libltdl'])
+])
+
+# AC_LIBLTDL_INSTALLABLE[(dir)] - sets LIBLTDL to the link flags for
+# the libltdl installable library, and adds --enable-ltdl-install to
+# the configure arguments.  Note that LIBLTDL is not AC_SUBSTed, nor
+# is AC_CONFIG_SUBDIRS called.  If DIR is not provided, it is assumed
+# to be `${top_builddir}/libltdl'.  Make sure you start DIR with
+# '${top_builddir}/' (note the single quotes!) if your package is not
+# flat, and, if you're not using automake, define top_builddir as
+# appropriate in the Makefiles.
+# In the future, this macro may have to be called after AC_PROG_LIBTOOL.
+AC_DEFUN(AC_LIBLTDL_INSTALLABLE, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+  AC_CHECK_LIB(ltdl, main,
+  [test x"$enable_ltdl_install" != xyes && enable_ltdl_install=no],
+  [if test x"$enable_ltdl_install" = xno; then
+     AC_MSG_WARN([libltdl not installed, but installation disabled])
+   else
+     enable_ltdl_install=yes
+   fi
+  ])
+  if test x"$enable_ltdl_install" = x"yes"; then
+    ac_configure_args="$ac_configure_args --enable-ltdl-install"
+    LIBLTDL=ifelse($#,1,$1,['${top_builddir}/libltdl'])/libltdl.la
+    INCLTDL=ifelse($#,1,-I$1,['-I${top_builddir}/libltdl'])
+  else
+    ac_configure_args="$ac_configure_args --enable-ltdl-install=no"
+    LIBLTDL="-lltdl"
+    INCLTDL=
+  fi
+])
+
+dnl old names
+AC_DEFUN(AM_PROG_LIBTOOL, [indir([AC_PROG_LIBTOOL])])dnl
+AC_DEFUN(AM_ENABLE_SHARED, [indir([AC_ENABLE_SHARED], $@)])dnl
+AC_DEFUN(AM_ENABLE_STATIC, [indir([AC_ENABLE_STATIC], $@)])dnl
+AC_DEFUN(AM_DISABLE_SHARED, [indir([AC_DISABLE_SHARED], $@)])dnl
+AC_DEFUN(AM_DISABLE_STATIC, [indir([AC_DISABLE_STATIC], $@)])dnl
+AC_DEFUN(AM_PROG_LD, [indir([AC_PROG_LD])])dnl
+AC_DEFUN(AM_PROG_NM, [indir([AC_PROG_NM])])dnl
+
+dnl This is just to silence aclocal about the macro not being used
+ifelse([AC_DISABLE_FAST_INSTALL])dnl
+
diff --git a/src/gmp/ansi2knr.1 b/src/gmp/ansi2knr.1
new file mode 100644
index 000000000..f9ee5a631
--- /dev/null
+++ b/src/gmp/ansi2knr.1
@@ -0,0 +1,36 @@
+.TH ANSI2KNR 1 "19 Jan 1996"
+.SH NAME
+ansi2knr \- convert ANSI C to Kernighan & Ritchie C
+.SH SYNOPSIS
+.I ansi2knr
+[--varargs] input_file [output_file]
+.SH DESCRIPTION
+If no output_file is supplied, output goes to stdout.
+.br
+There are no error messages.
+.sp
+.I ansi2knr
+recognizes function definitions by seeing a non-keyword identifier at the left
+margin, followed by a left parenthesis, with a right parenthesis as the last
+character on the line, and with a left brace as the first token on the
+following line (ignoring possible intervening comments).  It will recognize a
+multi-line header provided that no intervening line ends with a left or right
+brace or a semicolon.  These algorithms ignore whitespace and comments, except
+that the function name must be the first thing on the line.
+.sp
+The following constructs will confuse it:
+.br
+     - Any other construct that starts at the left margin and follows the
+above syntax (such as a macro or function call).
+.br
+     - Some macros that tinker with the syntax of the function header.
+.sp
+The --varargs switch is obsolete, and is recognized only for
+backwards compatibility.  The present version of
+.I ansi2knr
+will always attempt to convert a ... argument to va_alist and va_dcl.
+.SH AUTHOR
+L. Peter Deutsch <ghost@aladdin.com> wrote the original ansi2knr and
+continues to maintain the current version; most of the code in the current
+version is his work.  ansi2knr also includes contributions by Francois
+Pinard <pinard@iro.umontreal.ca> and Jim Avera <jima@netcom.com>.
diff --git a/src/gmp/ansi2knr.c b/src/gmp/ansi2knr.c
new file mode 100644
index 000000000..8142b3856
--- /dev/null
+++ b/src/gmp/ansi2knr.c
@@ -0,0 +1,678 @@
+/* Copyright (C) 1989, 1997, 1998, 1999 Aladdin Enterprises.  All rights reserved. */
+
+/*$Id$*/
+/* Convert ANSI C function definitions to K&R ("traditional C") syntax */
+
+/*
+ansi2knr is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY.  No author or distributor accepts responsibility to anyone for the
+consequences of using it or for whether it serves any particular purpose or
+works at all, unless he says so in writing.  Refer to the GNU General Public
+License (the "GPL") for full details.
+
+Everyone is granted permission to copy, modify and redistribute ansi2knr,
+but only under the conditions described in the GPL.  A copy of this license
+is supposed to have been given to you along with ansi2knr so you can know
+your rights and responsibilities.  It should be in a file named COPYLEFT,
+or, if there is no file named COPYLEFT, a file named COPYING.  Among other
+things, the copyright notice and this notice must be preserved on all
+copies.
+
+We explicitly state here what we believe is already implied by the GPL: if
+the ansi2knr program is distributed as a separate set of sources and a
+separate executable file which are aggregated on a storage medium together
+with another program, this in itself does not bring the other program under
+the GPL, nor does the mere fact that such a program or the procedures for
+constructing it invoke the ansi2knr executable bring any other part of the
+program under the GPL.
+*/
+
+/*
+ * Usage:
+	ansi2knr [--filename FILENAME] [INPUT_FILE [OUTPUT_FILE]]
+ * --filename provides the file name for the #line directive in the output,
+ * overriding input_file (if present).
+ * If no input_file is supplied, input is read from stdin.
+ * If no output_file is supplied, output goes to stdout.
+ * There are no error messages.
+ *
+ * ansi2knr recognizes function definitions by seeing a non-keyword
+ * identifier at the left margin, followed by a left parenthesis,
+ * with a right parenthesis as the last character on the line,
+ * and with a left brace as the first token on the following line
+ * (ignoring possible intervening comments), except that a line
+ * consisting of only
+ *	identifier1(identifier2)
+ * will not be considered a function definition unless identifier2 is
+ * the word "void", and a line consisting of
+ *	identifier1(identifier2, <<arbitrary>>)
+ * will not be considered a function definition.
+ * ansi2knr will recognize a multi-line header provided
+ * that no intervening line ends with a left or right brace or a semicolon.
+ * These algorithms ignore whitespace and comments, except that
+ * the function name must be the first thing on the line.
+ * The following constructs will confuse it:
+ *	- Any other construct that starts at the left margin and
+ *	    follows the above syntax (such as a macro or function call).
+ *	- Some macros that tinker with the syntax of function headers.
+ */
+
+/*
+ * The original and principal author of ansi2knr is L. Peter Deutsch
+ * <ghost@aladdin.com>.  Other authors are noted in the change history
+ * that follows (in reverse chronological order):
+	lpd 1999-04-12 added minor fixes from Pavel Roskin
+		<pavel_roskin@geocities.com> for clean compilation with
+		gcc -W -Wall
+	lpd 1999-03-22 added hack to recognize lines consisting of
+		identifier1(identifier2, xxx) as *not* being procedures
+	lpd 1999-02-03 made indentation of preprocessor commands consistent
+	lpd 1999-01-28 fixed two bugs: a '/' in an argument list caused an
+		endless loop; quoted strings within an argument list
+		confused the parser
+	lpd 1999-01-24 added a check for write errors on the output,
+		suggested by Jim Meyering <meyering@ascend.com>
+	lpd 1998-11-09 added further hack to recognize identifier(void)
+		as being a procedure
+	lpd 1998-10-23 added hack to recognize lines consisting of
+		identifier1(identifier2) as *not* being procedures
+	lpd 1997-12-08 made input_file optional; only closes input and/or
+		output file if not stdin or stdout respectively; prints
+		usage message on stderr rather than stdout; adds
+		--filename switch (changes suggested by
+		<ceder@lysator.liu.se>)
+	lpd 1996-01-21 added code to cope with not HAVE_CONFIG_H and with
+		compilers that don't understand void, as suggested by
+		Tom Lane
+	lpd 1996-01-15 changed to require that the first non-comment token
+		on the line following a function header be a left brace,
+		to reduce sensitivity to macros, as suggested by Tom Lane
+		<tgl@sss.pgh.pa.us>
+	lpd 1995-06-22 removed #ifndefs whose sole purpose was to define
+		undefined preprocessor symbols as 0; changed all #ifdefs
+		for configuration symbols to #ifs
+	lpd 1995-04-05 changed copyright notice to make it clear that
+		including ansi2knr in a program does not bring the entire
+		program under the GPL
+	lpd 1994-12-18 added conditionals for systems where ctype macros
+		don't handle 8-bit characters properly, suggested by
+		Francois Pinard <pinard@iro.umontreal.ca>;
+		removed --varargs switch (this is now the default)
+	lpd 1994-10-10 removed CONFIG_BROKETS conditional
+	lpd 1994-07-16 added some conditionals to help GNU `configure',
+		suggested by Francois Pinard <pinard@iro.umontreal.ca>;
+		properly erase prototype args in function parameters,
+		contributed by Jim Avera <jima@netcom.com>;
+		correct error in writeblanks (it shouldn't erase EOLs)
+	lpd 1989-xx-xx original version
+ */
+
+/* Most of the conditionals here are to make ansi2knr work with */
+/* or without the GNU configure machinery. */
+
+#if HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+
+#if HAVE_CONFIG_H
+
+/*
+   For properly autoconfiguring ansi2knr, use AC_CONFIG_HEADER(config.h).
+   This will define HAVE_CONFIG_H and so, activate the following lines.
+ */
+
+# if STDC_HEADERS || HAVE_STRING_H
+#  include <string.h>
+# else
+#  include <strings.h>
+# endif
+
+#else /* not HAVE_CONFIG_H */
+
+/* Otherwise do it the hard way */
+
+# ifdef BSD
+#  include <strings.h>
+# else
+#  ifdef VMS
+    extern int strlen(), strncmp();
+#  else
+#   include <string.h>
+#  endif
+# endif
+
+#endif /* not HAVE_CONFIG_H */
+
+#if STDC_HEADERS
+# include <stdlib.h>
+#else
+/*
+   malloc and free should be declared in stdlib.h,
+   but if you've got a K&R compiler, they probably aren't.
+ */
+# ifdef MSDOS
+#  include <malloc.h>
+# else
+#  ifdef VMS
+     extern char *malloc();
+     extern void free();
+#  else
+     extern char *malloc();
+     extern int free();
+#  endif
+# endif
+
+#endif
+
+/* Define NULL (for *very* old compilers). */
+#ifndef NULL
+# define NULL (0)
+#endif
+
+/*
+ * The ctype macros don't always handle 8-bit characters correctly.
+ * Compensate for this here.
+ */
+#ifdef isascii
+# undef HAVE_ISASCII		/* just in case */
+# define HAVE_ISASCII 1
+#else
+#endif
+#if STDC_HEADERS || !HAVE_ISASCII
+# define is_ascii(c) 1
+#else
+# define is_ascii(c) isascii(c)
+#endif
+
+#define is_space(c) (is_ascii(c) && isspace(c))
+#define is_alpha(c) (is_ascii(c) && isalpha(c))
+#define is_alnum(c) (is_ascii(c) && isalnum(c))
+
+/* Scanning macros */
+#define isidchar(ch) (is_alnum(ch) || (ch) == '_')
+#define isidfirstchar(ch) (is_alpha(ch) || (ch) == '_')
+
+/* Forward references */
+char *skipspace();
+char *scanstring();
+int writeblanks();
+int test1();
+int convert1();
+
+/* The main program */
+int
+main(argc, argv)
+    int argc;
+    char *argv[];
+{	FILE *in = stdin;
+	FILE *out = stdout;
+	char *filename = 0;
+	char *program_name = argv[0];
+	char *output_name = 0;
+#define bufsize 5000			/* arbitrary size */
+	char *buf;
+	char *line;
+	char *more;
+	char *usage =
+	  "Usage: ansi2knr [--filename FILENAME] [INPUT_FILE [OUTPUT_FILE]]\n";
+	/*
+	 * In previous versions, ansi2knr recognized a --varargs switch.
+	 * If this switch was supplied, ansi2knr would attempt to convert
+	 * a ... argument to va_alist and va_dcl; if this switch was not
+	 * supplied, ansi2knr would simply drop any such arguments.
+	 * Now, ansi2knr always does this conversion, and we only
+	 * check for this switch for backward compatibility.
+	 */
+	int convert_varargs = 1;
+	int output_error;
+
+	while ( argc > 1 && argv[1][0] == '-' ) {
+	  if ( !strcmp(argv[1], "--varargs") ) {
+	    convert_varargs = 1;
+	    argc--;
+	    argv++;
+	    continue;
+	  }
+	  if ( !strcmp(argv[1], "--filename") && argc > 2 ) {
+	    filename = argv[2];
+	    argc -= 2;
+	    argv += 2;
+	    continue;
+	  }
+	  fprintf(stderr, "%s: Unrecognized switch: %s\n", program_name,
+		  argv[1]);
+	  fprintf(stderr, usage);
+	  exit(1);
+	}
+	switch ( argc )
+	   {
+	default:
+		fprintf(stderr, usage);
+		exit(0);
+	case 3:
+		output_name = argv[2];
+		out = fopen(output_name, "w");
+		if ( out == NULL ) {
+		  fprintf(stderr, "%s: Cannot open output file %s\n",
+			  program_name, output_name);
+		  exit(1);
+		}
+		/* falls through */
+	case 2:
+		in = fopen(argv[1], "r");
+		if ( in == NULL ) {
+		  fprintf(stderr, "%s: Cannot open input file %s\n",
+			  program_name, argv[1]);
+		  exit(1);
+		}
+		if ( filename == 0 )
+		  filename = argv[1];
+		/* falls through */
+	case 1:
+		break;
+	   }
+	if ( filename )
+	  fprintf(out, "#line 1 \"%s\"\n", filename);
+	buf = malloc(bufsize);
+	if ( buf == NULL )
+	   {
+		fprintf(stderr, "Unable to allocate read buffer!\n");
+		exit(1);
+	   }
+	line = buf;
+	while ( fgets(line, (unsigned)(buf + bufsize - line), in) != NULL )
+	   {
+test:		line += strlen(line);
+		switch ( test1(buf) )
+		   {
+		case 2:			/* a function header */
+			convert1(buf, out, 1, convert_varargs);
+			break;
+		case 1:			/* a function */
+			/* Check for a { at the start of the next line. */
+			more = ++line;
+f:			if ( line >= buf + (bufsize - 1) ) /* overflow check */
+			  goto wl;
+			if ( fgets(line, (unsigned)(buf + bufsize - line), in) == NULL )
+			  goto wl;
+			switch ( *skipspace(more, 1) )
+			  {
+			  case '{':
+			    /* Definitely a function header. */
+			    convert1(buf, out, 0, convert_varargs);
+			    fputs(more, out);
+			    break;
+			  case 0:
+			    /* The next line was blank or a comment: */
+			    /* keep scanning for a non-comment. */
+			    line += strlen(line);
+			    goto f;
+			  default:
+			    /* buf isn't a function header, but */
+			    /* more might be. */
+			    fputs(buf, out);
+			    strcpy(buf, more);
+			    line = buf;
+			    goto test;
+			  }
+			break;
+		case -1:		/* maybe the start of a function */
+			if ( line != buf + (bufsize - 1) ) /* overflow check */
+			  continue;
+			/* falls through */
+		default:		/* not a function */
+wl:			fputs(buf, out);
+			break;
+		   }
+		line = buf;
+	   }
+	if ( line != buf )
+	  fputs(buf, out);
+	free(buf);
+	if ( output_name ) {
+	  output_error = ferror(out);
+	  output_error |= fclose(out);
+	} else {		/* out == stdout */
+	  fflush(out);
+	  output_error = ferror(out);
+	}
+	if ( output_error ) {
+	  fprintf(stderr, "%s: error writing to %s\n", program_name,
+		  (output_name ? output_name : "stdout"));
+	  exit(1);
+	}
+	if ( in != stdin )
+	  fclose(in);
+	return 0;
+}
+
+/* Skip over whitespace and comments, in either direction. */
+char *
+skipspace(p, dir)
+    register char *p;
+    register int dir;			/* 1 for forward, -1 for backward */
+{	for ( ; ; )
+	   {	while ( is_space(*p) )
+		  p += dir;
+		if ( !(*p == '/' && p[dir] == '*') )
+		  break;
+		p += dir;  p += dir;
+		while ( !(*p == '*' && p[dir] == '/') )
+		   {	if ( *p == 0 )
+			  return p;	/* multi-line comment?? */
+			p += dir;
+		   }
+		p += dir;  p += dir;
+	   }
+	return p;
+}
+
+/* Scan over a quoted string, in either direction. */
+char *
+scanstring(p, dir)
+    register char *p;
+    register int dir;
+{
+    for (p += dir; ; p += dir)
+	if (*p == '"' && p[-dir] != '\\')
+	    return p + dir;
+}
+
+/*
+ * Write blanks over part of a string.
+ * Don't overwrite end-of-line characters.
+ */
+int
+writeblanks(start, end)
+    char *start;
+    char *end;
+{	char *p;
+	for ( p = start; p < end; p++ )
+	  if ( *p != '\r' && *p != '\n' )
+	    *p = ' ';
+	return 0;
+}
+
+/*
+ * Test whether the string in buf is a function definition.
+ * The string may contain and/or end with a newline.
+ * Return as follows:
+ *	0 - definitely not a function definition;
+ *	1 - definitely a function definition;
+ *	2 - definitely a function prototype (NOT USED);
+ *	-1 - may be the beginning of a function definition,
+ *		append another line and look again.
+ * The reason we don't attempt to convert function prototypes is that
+ * Ghostscript's declaration-generating macros look too much like
+ * prototypes, and confuse the algorithms.
+ */
+int
+test1(buf)
+    char *buf;
+{	register char *p = buf;
+	char *bend;
+	char *endfn;
+	int contin;
+
+	if ( !isidfirstchar(*p) )
+	  return 0;		/* no name at left margin */
+	bend = skipspace(buf + strlen(buf) - 1, -1);
+	switch ( *bend )
+	   {
+	   case ';': contin = 0 /*2*/; break;
+	   case ')': contin = 1; break;
+	   case '{': return 0;		/* not a function */
+	   case '}': return 0;		/* not a function */
+	   default: contin = -1;
+	   }
+	while ( isidchar(*p) )
+	  p++;
+	endfn = p;
+	p = skipspace(p, 1);
+	if ( *p++ != '(' )
+	  return 0;		/* not a function */
+	p = skipspace(p, 1);
+	if ( *p == ')' )
+	  return 0;		/* no parameters */
+	/* Check that the apparent function name isn't a keyword. */
+	/* We only need to check for keywords that could be followed */
+	/* by a left parenthesis (which, unfortunately, is most of them). */
+	   {	static char *words[] =
+		   {	"asm", "auto", "case", "char", "const", "double",
+			"extern", "float", "for", "if", "int", "long",
+			"register", "return", "short", "signed", "sizeof",
+			"static", "switch", "typedef", "unsigned",
+			"void", "volatile", "while", 0
+		   };
+		char **key = words;
+		char *kp;
+		unsigned len = endfn - buf;
+
+		while ( (kp = *key) != 0 )
+		   {	if ( strlen(kp) == len && !strncmp(kp, buf, len) )
+			  return 0;	/* name is a keyword */
+			key++;
+		   }
+	   }
+	   {
+	       char *id = p;
+	       int len;
+	       /*
+		* Check for identifier1(identifier2) and not
+		* identifier1(void), or identifier1(identifier2, xxxx).
+		*/
+
+	       while ( isidchar(*p) )
+		   p++;
+	       len = p - id;
+	       p = skipspace(p, 1);
+	       if (*p == ',' ||
+		   (*p == ')' && (len != 4 || strncmp(id, "void", 4)))
+		   )
+		   return 0;	/* not a function */
+	   }
+	/*
+	 * If the last significant character was a ), we need to count
+	 * parentheses, because it might be part of a formal parameter
+	 * that is a procedure.
+	 */
+	if (contin > 0) {
+	    int level = 0;
+
+	    for (p = skipspace(buf, 1); *p; p = skipspace(p + 1, 1))
+		level += (*p == '(' ? 1 : *p == ')' ? -1 : 0);
+	    if (level > 0)
+		contin = -1;
+	}
+	return contin;
+}
+
+/* Convert a recognized function definition or header to K&R syntax. */
+int
+convert1(buf, out, header, convert_varargs)
+    char *buf;
+    FILE *out;
+    int header;			/* Boolean */
+    int convert_varargs;	/* Boolean */
+{	char *endfn;
+	register char *p;
+	/*
+	 * The breaks table contains pointers to the beginning and end
+	 * of each argument.
+	 */
+	char **breaks;
+	unsigned num_breaks = 2;	/* for testing */
+	char **btop;
+	char **bp;
+	char **ap;
+	char *vararg = 0;
+
+	/* Pre-ANSI implementations don't agree on whether strchr */
+	/* is called strchr or index, so we open-code it here. */
+	for ( endfn = buf; *(endfn++) != '('; )
+	  ;
+top:	p = endfn;
+	breaks = (char **)malloc(sizeof(char *) * num_breaks * 2);
+	if ( breaks == NULL )
+	   {	/* Couldn't allocate break table, give up */
+		fprintf(stderr, "Unable to allocate break table!\n");
+		fputs(buf, out);
+		return -1;
+	   }
+	btop = breaks + num_breaks * 2 - 2;
+	bp = breaks;
+	/* Parse the argument list */
+	do
+	   {	int level = 0;
+		char *lp = NULL;
+		char *rp = NULL;
+		char *end = NULL;
+
+		if ( bp >= btop )
+		   {	/* Filled up break table. */
+			/* Allocate a bigger one and start over. */
+			free((char *)breaks);
+			num_breaks <<= 1;
+			goto top;
+		   }
+		*bp++ = p;
+		/* Find the end of the argument */
+		for ( ; end == NULL; p++ )
+		   {	switch(*p)
+			   {
+			   case ',':
+				if ( !level ) end = p;
+				break;
+			   case '(':
+				if ( !level ) lp = p;
+				level++;
+				break;
+			   case ')':
+				if ( --level < 0 ) end = p;
+				else rp = p;
+				break;
+			   case '/':
+				if (p[1] == '*')
+				    p = skipspace(p, 1) - 1;
+				break;
+			   case '"':
+			       p = scanstring(p, 1) - 1;
+			       break;
+			   default:
+				;
+			   }
+		   }
+		/* Erase any embedded prototype parameters. */
+		if ( lp && rp )
+		  writeblanks(lp + 1, rp);
+		p--;			/* back up over terminator */
+		/* Find the name being declared. */
+		/* This is complicated because of procedure and */
+		/* array modifiers. */
+		for ( ; ; )
+		   {	p = skipspace(p - 1, -1);
+			switch ( *p )
+			   {
+			   case ']':	/* skip array dimension(s) */
+			   case ')':	/* skip procedure args OR name */
+			   {	int level = 1;
+				while ( level )
+				 switch ( *--p )
+				   {
+				   case ']': case ')':
+				       level++;
+				       break;
+				   case '[': case '(':
+				       level--;
+				       break;
+				   case '/':
+				       if (p > buf && p[-1] == '*')
+					   p = skipspace(p, -1) + 1;
+				       break;
+				   case '"':
+				       p = scanstring(p, -1) + 1;
+				       break;
+				   default: ;
+				   }
+			   }
+				if ( *p == '(' && *skipspace(p + 1, 1) == '*' )
+				   {	/* We found the name being declared */
+					while ( !isidfirstchar(*p) )
+					  p = skipspace(p, 1) + 1;
+					goto found;
+				   }
+				break;
+			   default:
+				goto found;
+			   }
+		   }
+found:		if ( *p == '.' && p[-1] == '.' && p[-2] == '.' )
+		  {	if ( convert_varargs )
+			  {	*bp++ = "va_alist";
+				vararg = p-2;
+			  }
+			else
+			  {	p++;
+				if ( bp == breaks + 1 )	/* sole argument */
+				  writeblanks(breaks[0], p);
+				else
+				  writeblanks(bp[-1] - 1, p);
+				bp--;
+			  }
+		   }
+		else
+		   {	while ( isidchar(*p) ) p--;
+			*bp++ = p+1;
+		   }
+		p = end;
+	   }
+	while ( *p++ == ',' );
+	*bp = p;
+	/* Make a special check for 'void' arglist */
+	if ( bp == breaks+2 )
+	   {	p = skipspace(breaks[0], 1);
+		if ( !strncmp(p, "void", 4) )
+		   {	p = skipspace(p+4, 1);
+			if ( p == breaks[2] - 1 )
+			   {	bp = breaks;	/* yup, pretend arglist is empty */
+				writeblanks(breaks[0], p + 1);
+			   }
+		   }
+	   }
+	/* Put out the function name and left parenthesis. */
+	p = buf;
+	while ( p != endfn ) putc(*p, out), p++;
+	/* Put out the declaration. */
+	if ( header )
+	  {	fputs(");", out);
+		for ( p = breaks[0]; *p; p++ )
+		  if ( *p == '\r' || *p == '\n' )
+		    putc(*p, out);
+	  }
+	else
+	  {	for ( ap = breaks+1; ap < bp; ap += 2 )
+		  {	p = *ap;
+			while ( isidchar(*p) )
+			  putc(*p, out), p++;
+			if ( ap < bp - 1 )
+			  fputs(", ", out);
+		  }
+		fputs(")  ", out);
+		/* Put out the argument declarations */
+		for ( ap = breaks+2; ap <= bp; ap += 2 )
+		  (*ap)[-1] = ';';
+		if ( vararg != 0 )
+		  {	*vararg = 0;
+			fputs(breaks[0], out);		/* any prior args */
+			fputs("va_dcl", out);		/* the final arg */
+			fputs(bp[0], out);
+		  }
+		else
+		  fputs(breaks[0], out);
+	  }
+	free((char *)breaks);
+	return 0;
+}
diff --git a/src/gmp/assert.c b/src/gmp/assert.c
new file mode 100644
index 000000000..65eccfa30
--- /dev/null
+++ b/src/gmp/assert.c
@@ -0,0 +1,52 @@
+/* GMP assertion failure handler. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+int
+#if __STDC__
+__gmp_assert_fail (const char *filename, int linenum,
+                   const char *expr)
+#else
+__gmp_assert_fail (filename, linenum, expr)
+char *filename;
+int  linenum;
+char *expr;
+#endif
+{
+  if (filename != NULL && filename[0] != '\0')
+    {
+      fprintf (stderr, "%s:", filename);
+      if (linenum != -1)
+        fprintf (stderr, "%d: ", linenum);
+    }
+
+  fprintf (stderr, "GNU MP assertion failed: %s\n", expr);
+  abort();
+
+  /*NOTREACHED*/
+  return 0;
+}
diff --git a/src/gmp/compat.c b/src/gmp/compat.c
new file mode 100644
index 000000000..ab7529f52
--- /dev/null
+++ b/src/gmp/compat.c
@@ -0,0 +1,46 @@
+/* Old function entrypoints retained for binary compatibility. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+/* mpn_divexact_by3 was a function in gmp 3.0, but as of gmp 3.1 it's a
+   macro calling mpn_divexact_by3c.  */
+int
+__MPN (divexact_by3) (mp_ptr dst, mp_srcptr src, mp_size_t size)
+{
+  mpn_divexact_by3 (dst, src, size);
+}
+
+
+/* mpn_divmod_1 was a function in gmp 3.0 and earlier, but marked obsolete
+   in gmp 2 and 3.  As of gmp 3.1 it's a macro calling mpn_divrem_1. */
+int
+__MPN (divmod_1) (mp_ptr dst, mp_srcptr src, mp_size_t size, mp_limb_t divisor)
+{
+  mpn_divmod_1 (dst, src, size, divisor);
+}
+
+
diff --git a/src/gmp/config.guess b/src/gmp/config.guess
new file mode 100755
index 000000000..08018f497
--- /dev/null
+++ b/src/gmp/config.guess
@@ -0,0 +1,1373 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+#
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000
+# 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>.
+# Please send patches to <config-patches@gnu.org>.
+#
+# 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
+
+dummy=dummy-$$
+trap 'rm -f $dummy.c $dummy.o $dummy ${dummy}1.s ${dummy}2.c ; exit 1' 1 2 15
+
+# Use $HOST_CC if defined. $CC may point to a cross-compiler
+if test x"$CC_FOR_BUILD" = x; then
+  if test x"$HOST_CC" != x; then
+    CC_FOR_BUILD="$HOST_CC"
+  else
+    if test x"$CC" != x; then
+      CC_FOR_BUILD="$CC"
+    else
+      echo 'dummy(){}' >$dummy.c
+      for c in cc c89 gcc; do 
+	  ($c $dummy.c -c) >/dev/null 2>&1
+	  if test $? = 0; then
+	      CC_FOR_BUILD="$c"; break
+	  fi
+      done
+      rm -f $dummy.c $dummy.o
+      if test x"$CC_FOR_BUILD" = x; then
+	CC_FOR_BUILD=no_compiler_found
+      fi
+    fi
+  fi
+fi
+
+
+# First make a best effort at recognizing x86 CPU type and leave it in X86CPU.
+# If we fail, set X86CPU to UNAME_MACHINE
+#
+# DJGPP v2 (or 2.03 at least) always gives "pc" for uname -m, and the
+# OEM for uname -s.  Eg. pc:MS-DOS:6:2 on MS-DOS 6.21.  The list of
+# possible OEMs is in src/libc/dos/dos/getdos_v.c of djlsr203.zip, but
+# just pc:*:*:* seems ok.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+    i?86:*:*:* | i86pc:*:*:* | pc:*:*:*)
+	case "${UNAME_MACHINE}" in
+	i86pc | pc)  UNAME_MACHINE=i386 ;;
+	esac
+	cat <<EOF >${dummy}1.s
+	.globl cpuid
+	.globl _cpuid
+cpuid:
+_cpuid:
+	pushl %esi
+	pushl %ebx
+	movl 16(%esp),%eax
+	.byte 0x0f
+	.byte 0xa2
+	movl 12(%esp),%esi
+	movl %ebx,(%esi)
+	movl %edx,4(%esi)
+	movl %ecx,8(%esi)
+	popl %ebx
+	popl %esi
+	ret
+EOF
+	cat <<EOF >${dummy}2.c
+main ()
+{
+  char vendor_string[13];
+  char dummy_string[12];
+  long fms;
+  int family, model;
+  char *modelstr;
+
+  cpuid (vendor_string, 0);
+  vendor_string[12] = 0;
+
+  fms = cpuid (dummy_string, 1);
+
+  family = (fms >> 8) & 15;
+  model = (fms >> 4) & 15;
+
+  modelstr = "i486";
+  if (strcmp (vendor_string, "GenuineIntel") == 0)
+    {
+      switch (family)
+	{
+	case 5:
+	  if (model <= 2)
+	    modelstr = "pentium";
+	  else if (model >= 4)
+	    modelstr = "pentiummmx";
+	  break;
+	case 6:
+	  if (model == 1)
+	    modelstr = "pentiumpro";
+	  else if (model <= 6)
+	    modelstr = "pentium2";
+	  else
+	    modelstr = "pentium3";
+	  break;
+	}
+    }
+  else if (strcmp (vendor_string, "AuthenticAMD") == 0)
+    {
+      switch (family)
+	{
+	case 5:
+	  if (model <= 3)
+	    modelstr = "k5";
+	  else if (model <= 7)
+	    modelstr = "k6";
+	  else if (model <= 8)
+	    modelstr = "k62";
+	  else if (model <= 9)
+	    modelstr = "k63";
+	  break;
+	case 6:
+	  modelstr = "athlon";
+	  break;
+	}
+    }
+  else if (strcmp (vendor_string, "CyrixInstead") == 0)
+    {
+      /* Should recognize Cyrix' processors too.  */
+    }
+
+  printf ("%s\n", modelstr);
+  return 0;
+}
+EOF
+	$CC_FOR_BUILD ${dummy}1.s ${dummy}2.c -o $dummy >/dev/null 2>&1
+	if test "$?" = 0 ; then
+	  X86CPU=`./$dummy`
+	fi
+
+
+	# Default to believing uname -m if the program fails to compile or
+	# run.  Will fail to run on 386 since cpuid was only added on 486.
+	if test -z "$X86CPU"
+	then
+	    X86CPU="$UNAME_MACHINE"
+	fi
+	rm -f ${dummy}1.s ${dummy}2.c $dummy
+  ;;
+esac
+
+# 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
+	.data
+\$Lformat:
+	.byte 37,100,45,37,120,10,0	# "%d-%x\n"
+
+	.text
+	.globl main
+	.align 4
+	.ent main
+main:
+	.frame \$30,16,\$26,0
+	ldgp \$29,0(\$27)
+	.prologue 1
+	.long 0x47e03d80 # implver \$0
+	lda \$2,-1
+	.long 0x47e20c21 # amask \$2,\$1
+	lda \$16,\$Lformat
+	mov \$0,\$17
+	not \$1,\$18
+	jsr \$26,printf
+	ldgp \$29,0(\$26)
+	mov 0,\$16
+	jsr \$26,exit
+	.end main
+EOF
+	$CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
+	if test "$?" = 0 ; then
+		case `./$dummy` in
+			0-0)
+				UNAME_MACHINE="alpha"
+				;;
+			1-0)
+				UNAME_MACHINE="alphaev5"
+				;;
+			1-1)
+				UNAME_MACHINE="alphaev56"
+				;;
+			1-101)
+				UNAME_MACHINE="alphapca56"
+				;;
+			2-303)
+				UNAME_MACHINE="alphaev6"
+				;;
+			2-307)
+				UNAME_MACHINE="alphaev67"
+				;;
+		esac
+	fi
+	rm -f $dummy.s $dummy
+	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+	exit 0 ;;
+    alpha:NetBSD:*:* | alpha:FreeBSD:*:*)
+	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_FOR_BUILD $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}-unknown-`echo ${UNAME_SYSTEM}${UNAME_RELEASE} | sed -e 's/^[VTX]//' -e 's/[-(].*//' | tr [[A-Z]] [[a-z]]`
+	exit 0 ;;
+    Alpha\ *:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# Should we change UNAME_MACHINE based on the output of uname instead
+	# of the specific Alpha model?
+	echo alpha-pc-interix
+	exit 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 ;;
+    *:[Aa]miga[Oo][Ss]:*:*)
+	echo ${UNAME_MACHINE}-unknown-amigaos
+	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 ;;
+    *:OS/390:*:*)
+	echo i370-ibm-openedition
+	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*:*:* | MIS*:SMP_DC-OSx*:*:*)
+	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+	if test "`(/bin/universe) 2>/dev/null`" = att ; then
+		echo pyramid-pyramid-sysv3
+	else
+		echo pyramid-pyramid-bsd
+	fi
+	exit 0 ;;
+    NILE*:*:*:dcosx)
+	echo pyramid-pyramid-svr4
+	exit 0 ;;
+    sun4H:SunOS:5.*:*)
+	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    sun4[md]:SunOS:5.*:*)
+	echo sparcv8-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    sun4u:SunOS:5.*:*)
+	echo sparcv9-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    i386:SunOS:5.*:*)
+	echo ${X86CPU}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit 0 ;;
+    sun4[md]: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 sparcv8-sun-sunos`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 ;;
+    # The situation for MiNT is a little confusing.  The machine name
+    # can be virtually everything (everything which is not
+    # "atarist" or "atariste" at least should have a processor
+    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"
+    # to the lowercase version "mint" (or "freemint").  Finally
+    # the system name "TOS" denotes a system which is actually not
+    # MiNT.  But MiNT is downward compatible to TOS, so this should
+    # be no problem.
+    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+        echo m68k-atari-mint${UNAME_RELEASE}
+	exit 0 ;;
+    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+	echo m68k-atari-mint${UNAME_RELEASE}
+        exit 0 ;;
+    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+        echo m68k-atari-mint${UNAME_RELEASE}
+	exit 0 ;;
+    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+        echo m68k-milan-mint${UNAME_RELEASE}
+        exit 0 ;;
+    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+        echo m68k-hades-mint${UNAME_RELEASE}
+        exit 0 ;;
+    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+        echo m68k-unknown-mint${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 ;;
+    macppc:NetBSD:*:*)
+	echo powerpc-apple-netbsd${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:*:* | 2430:CLIX:*:*)
+	echo clipper-intergraph-clix${UNAME_RELEASE}
+	exit 0 ;;
+    mips:*:*:UMIPS | mips:*:*:RISCos)
+	sed 's/^	//' << EOF >$dummy.c
+#ifdef __cplusplus
+#include <stdio.h>  /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+	#if defined (host_mips) && defined (MIPSEB)
+	#if defined (SYSTYPE_SYSV)
+	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_SVR4)
+	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+	#endif
+	#endif
+	  exit (-1);
+	}
+EOF
+	$CC_FOR_BUILD $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 ] || [ $UNAME_PROCESSOR = mc88110 ]
+	then
+	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
+	       [ ${TARGET_BINARY_INTERFACE}x = x ]
+	    then
+		echo m88k-dg-dgux${UNAME_RELEASE}
+	    else
+		echo m88k-dg-dguxbcs${UNAME_RELEASE}
+	    fi
+	else
+	    echo i586-dg-dgux${UNAME_RELEASE}
+	fi
+ 	exit 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_FOR_BUILD $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)
+	sed 's/^	//' << EOF >$dummy.c
+	#include <stdio.h>
+	#include <sys/systemcfg.h>
+	main ()
+	{
+	  if (_system_configuration.architecture == POWER_RS
+	      || _system_configuration.implementation == POWER_601)
+	    puts ("power");
+	  else
+	    {
+	      if (_system_configuration.width == 64)
+		puts ("powerpc64");
+	      else
+		puts ("powerpc");
+	    }
+	  exit (0);
+	}
+EOF
+	$CC_FOR_BUILD $dummy.c -o $dummy
+	IBM_ARCH=`./$dummy`
+	rm -f $dummy.c $dummy
+	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 BSD 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/[34678]??:HP-UX:*:*)
+	case "${UNAME_MACHINE}" in
+	    9000/31? )            HP_ARCH=m68000 ;;
+	    9000/[34]?? )         HP_ARCH=m68k ;;
+	    9000/[678][0-9][0-9])
+              sed 's/^              //' << EOF >$dummy.c
+
+              #define _HPUX_SOURCE
+              #include <stdlib.h>
+              #include <unistd.h>
+
+              int main ()
+              {
+              #if defined(_SC_KERNEL_BITS)
+                  long bits = sysconf(_SC_KERNEL_BITS);
+              #endif
+                  long cpu  = sysconf (_SC_CPU_VERSION);
+
+                  switch (cpu)
+              	{
+              	case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+              	case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+              	case CPU_PA_RISC2_0:
+              #if defined(_SC_KERNEL_BITS)
+              	    switch (bits)
+              		{
+              		case 64: puts ("hppa2.0w"); break;
+              		case 32: puts ("hppa2.0n"); break;
+              		default: puts ("hppa2.0"); break;
+              		} break;
+              #else  /* !defined(_SC_KERNEL_BITS) */
+              	    puts ("hppa2.0"); break;
+              #endif
+              	default: puts ("hppa1.0"); break;
+              	}
+                  exit (0);
+              }
+EOF
+	(CCOPTS= $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null ) && HP_ARCH=`./$dummy`
+	rm -f $dummy.c $dummy
+	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_FOR_BUILD $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 ;;
+    *9??*:MPE/iX:*:*)
+	echo hppa1.0-hp-mpeix
+	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 ;;
+    hppa*:OpenBSD:*:*)
+	echo hppa-unknown-openbsd
+	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} | sed -e 's/\.[^.]*$/.X/'
+	exit 0 ;;
+    CRAY*T3D:*:*:*)
+	echo alpha-cray-unicos
+	exit 0 ;;
+    CRAY*T3E:*:*:*)
+	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit 0 ;;
+    CRAY*SV1:*:*:*)
+	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit 0 ;;
+    CRAY-2:*:*:*)
+	echo cray2-cray-unicos
+        exit 0 ;;
+    F300:UNIX_System_V:*:*)
+        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | 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:*:* | i?86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+	echo ${X86CPU}-pc-bsdi${UNAME_RELEASE}
+	exit 0 ;;
+    sparc*:BSD/OS:*:*)
+	echo sparc-unknown-bsdi${UNAME_RELEASE}
+	exit 0 ;;
+    *:BSD/OS:*:*)
+	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+	exit 0 ;;
+    i386:FreeBSD:*:*)
+	echo ${X86CPU}-pc-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+	exit 0 ;;
+    *:FreeBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+	exit 0 ;;
+    i386:NetBSD:*:*)
+	echo ${X86CPU}-pc-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+	exit 0 ;;
+    *:NetBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+	exit 0 ;;
+    i386:OpenBSD:*:*)
+	echo ${X86CPU}-pc-openbsd`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 ${X86CPU}-pc-cygwin
+	exit 0 ;;
+    i*:MINGW*:*)
+	echo ${UNAME_MACHINE}-pc-mingw32
+	exit 0 ;;
+    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
+	# UNAME_MACHINE based on the output of uname instead of i386?
+	echo i386-pc-interix
+	exit 0 ;;
+    i*:UWIN*:*)
+	echo ${UNAME_MACHINE}-pc-uwin
+	exit 0 ;;
+    p*:CYGWIN*:*)
+	echo powerpcle-unknown-cygwin
+	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. cd to the root directory to prevent
+	# problems with other programs or directories called `ld' in the path.
+	ld_help_string=`cd /; 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
+	  *ia64)
+		echo "${UNAME_MACHINE}-unknown-linux"
+		exit 0
+		;;
+	  i?86linux)
+		echo "${X86CPU}-pc-linux-gnuaout"
+		exit 0
+		;;
+	  i?86coff)
+		echo "${X86CPU}-pc-linux-gnucoff"
+		exit 0
+		;;
+	  sparclinux)
+		echo "${UNAME_MACHINE}-unknown-linux-gnuaout"
+		exit 0
+		;;
+	  armlinux)
+		echo "${UNAME_MACHINE}-unknown-linux-gnuaout"
+		exit 0
+		;;
+	  elf32arm*)
+		echo "${UNAME_MACHINE}-unknown-linux-gnuoldld"
+		exit 0
+		;;
+	  armelf_linux*)
+		echo "${UNAME_MACHINE}-unknown-linux-gnu"
+		exit 0
+		;;
+	  m68klinux)
+		echo "${UNAME_MACHINE}-unknown-linux-gnuaout"
+		exit 0
+		;;
+	  elf32ppc | elf32ppclinux)
+		# Determine Lib Version
+		cat >$dummy.c <<EOF
+#include <features.h>
+#if defined(__GLIBC__)
+extern char __libc_version[];
+extern char __libc_release[];
+#endif
+main(argc, argv)
+     int argc;
+     char *argv[];
+{
+#if defined(__GLIBC__)
+  printf("%s %s\n", __libc_version, __libc_release);
+#else
+  printf("unkown\n");
+#endif
+  return 0;
+}
+EOF
+		LIBC=""
+		$CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null
+		if test "$?" = 0 ; then
+			./$dummy | grep 1\.99 > /dev/null
+			if test "$?" = 0 ; then
+				LIBC="libc1"
+			fi
+		fi
+		rm -f $dummy.c $dummy
+		echo powerpc-unknown-linux-gnu${LIBC}
+		exit 0
+		;;
+	esac
+
+	if test "${UNAME_MACHINE}" = "alpha" ; then
+		cat <<EOF >$dummy.s
+			.data
+		\$Lformat:
+			.byte 37,100,45,37,120,10,0	# "%d-%x\n"
+
+			.text
+			.globl main
+			.align 4
+			.ent main
+		main:
+			.frame \$30,16,\$26,0
+			ldgp \$29,0(\$27)
+			.prologue 1
+			.long 0x47e03d80 # implver \$0
+			lda \$2,-1
+			.long 0x47e20c21 # amask \$2,\$1
+			lda \$16,\$Lformat
+			mov \$0,\$17
+			not \$1,\$18
+			jsr \$26,printf
+			ldgp \$29,0(\$26)
+			mov 0,\$16
+			jsr \$26,exit
+			.end main
+EOF
+		LIBC=""
+		$CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
+		if test "$?" = 0 ; then
+			case `./$dummy` in
+			0-0)
+				UNAME_MACHINE="alpha"
+				;;
+			1-0)
+				UNAME_MACHINE="alphaev5"
+				;;
+			1-1)
+				UNAME_MACHINE="alphaev56"
+				;;
+			1-101)
+				UNAME_MACHINE="alphapca56"
+				;;
+			2-303)
+				UNAME_MACHINE="alphaev6"
+				;;
+			2-307)
+				UNAME_MACHINE="alphaev67"
+				;;
+			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
+#ifdef __cplusplus
+#include <stdio.h>  /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+#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_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0
+	  rm -f $dummy.c $dummy
+	elif test "${UNAME_MACHINE}" = "s390"; then
+	  echo s390-ibm-linux && exit 0
+	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 "${X86CPU}-pc-linux-gnuoldld" && exit 0
+
+	  case "${UNAME_MACHINE}" in
+	  i?86)
+	    VENDOR=pc;
+	    UNAME_MACHINE=${X86CPU}
+	    ;;
+	  *)
+	    VENDOR=unknown;
+	    ;;
+	  esac
+	  # Determine whether the default compiler is a.out or elf
+	  cat >$dummy.c <<EOF
+#include <features.h>
+#ifdef __cplusplus
+#include <stdio.h>  /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+#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_FOR_BUILD $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 ${X86CPU}-pc-sysv4.2uw${UNAME_VERSION}
+	exit 0 ;;
+    i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*)
+	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
+	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+		echo ${X86CPU}-univel-sysv${UNAME_REL}
+	else
+		echo ${X86CPU}-pc-sysv${UNAME_REL}
+	fi
+	exit 0 ;;
+    i?86:*:5:7*)
+        # Fixed at (any) Pentium or better
+        UNAME_MACHINE=i586
+        if [ ${UNAME_SYSTEM} = "UnixWare" ] ; then
+	    echo ${X86CPU}-sco-sysv${UNAME_RELEASE}uw${UNAME_VERSION}
+	else
+	    echo ${X86CPU}-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 ${X86CPU}-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
+		(/bin/uname -X|egrep '^Machine.*Pent ?II' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		(/bin/uname -X|egrep '^Machine.*Pentium Pro' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		echo ${X86CPU}-pc-sco$UNAME_REL
+	else
+		echo ${X86CPU}-pc-sysv32
+	fi
+	exit 0 ;;
+    i?86:*DOS:*:*)
+	echo ${X86CPU}-pc-msdosdjgpp
+	exit 0 ;;
+    pc:*:*:*)
+	# Left here for compatibility:
+        # uname -m prints for DJGPP always 'pc', but it prints nothing about
+        # the processor, so we play safe by assuming i386.
+	echo i386-pc-msdosdjgpp
+        exit 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.*:* | i?86:LynxOS:3.[01]*:*)
+	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*:ReliantUNIX-*:*:*)
+	echo mips-sni-sysv4
+	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 ;;
+    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+	if [ -d /usr/nec ]; then
+	        echo mips-nec-sysv${UNAME_RELEASE}
+	else
+	        echo mips-unknown-sysv${UNAME_RELEASE}
+	fi
+        exit 0 ;;
+    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.
+	echo powerpc-be-beos
+	exit 0 ;;
+    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.
+	echo powerpc-apple-beos
+	exit 0 ;;
+    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.
+	echo i586-pc-beos
+	exit 0 ;;
+    SX-4:SUPER-UX:*:*)
+	echo sx4-nec-superux${UNAME_RELEASE}
+	exit 0 ;;
+    SX-5:SUPER-UX:*:*)
+	echo sx5-nec-superux${UNAME_RELEASE}
+	exit 0 ;;
+    Power*:Rhapsody:*:*)
+	echo powerpc-apple-rhapsody${UNAME_RELEASE}
+	exit 0 ;;
+    *:Rhapsody:*:*)
+	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
+	exit 0 ;;
+    Power*:Mac*OS:*:*)
+	echo powerpc-apple-macos${UNAME_RELEASE}
+	exit 0 ;;
+    *:Mac*OS:*:*)
+	echo ${UNAME_MACHINE}-apple-macos${UNAME_RELEASE}
+	exit 0 ;;
+    *:Darwin:*:*)
+	echo `uname -p`-apple-darwin${UNAME_RELEASE}
+	exit 0 ;;
+    *:procnto*:*:* | *:QNX:[0123456789]*:*)
+	if test "${UNAME_MACHINE}" = "x86pc"; then
+		UNAME_MACHINE=pc
+	fi
+	echo `uname -p`-${UNAME_MACHINE}-nto-qnx
+	exit 0 ;;
+    *:QNX:*:4*)
+	echo i386-pc-qnx
+	exit 0 ;;
+    NSR-W:NONSTOP_KERNEL:*:*)
+	echo nsr-tandem-nsk${UNAME_RELEASE}
+	exit 0 ;;
+    BS2000:POSIX*:*:*)
+	echo bs2000-siemens-sysv
+	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`;
+  if (version < 4)
+    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+  else
+    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+  exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+  printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+  printf ("ns32k-encore-mach\n"); exit (0);
+#else
+  printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+  printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+  printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+  printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+    struct utsname un;
+
+    uname(&un);
+
+    if (strncmp(un.version, "V2", 2) == 0) {
+	printf ("i386-sequent-ptx2\n"); exit (0);
+    }
+    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+	printf ("i386-sequent-ptx1\n"); exit (0);
+    }
+    printf ("i386-sequent-ptx\n"); exit (0);
+
+#endif
+
+#if defined (vax)
+#if !defined (ultrix)
+  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_FOR_BUILD $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/src/gmp/config.in b/src/gmp/config.in
new file mode 100644
index 000000000..8b2546ef1
--- /dev/null
+++ b/src/gmp/config.in
@@ -0,0 +1,162 @@
+/* config.in.  Generated automatically from configure.in by autoheader.  */
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+
+/* Define if a limb is long long. */
+#undef _LONG_LONG_LIMB
+
+/* Define if we have native implementation of function. */
+#undef HAVE_NATIVE_
+#undef HAVE_NATIVE_mpn_add                 
+#undef HAVE_NATIVE_mpn_add_1               
+#undef HAVE_NATIVE_mpn_add_n               
+#undef HAVE_NATIVE_mpn_add_nc              
+#undef HAVE_NATIVE_mpn_addmul_1            
+#undef HAVE_NATIVE_mpn_addmul_1c
+#undef HAVE_NATIVE_mpn_addsub_n            
+#undef HAVE_NATIVE_mpn_addsub_nc
+#undef HAVE_NATIVE_mpn_and_n               
+#undef HAVE_NATIVE_mpn_andn_n              
+#undef HAVE_NATIVE_mpn_bdivmod             
+#undef HAVE_NATIVE_mpn_cmp                 
+#undef HAVE_NATIVE_mpn_com_n               
+#undef HAVE_NATIVE_mpn_copyd               
+#undef HAVE_NATIVE_mpn_copyi               
+#undef HAVE_NATIVE_mpn_divexact_by3c
+#undef HAVE_NATIVE_mpn_divrem              
+#undef HAVE_NATIVE_mpn_divrem_1            
+#undef HAVE_NATIVE_mpn_divrem_1c
+#undef HAVE_NATIVE_mpn_divrem_2            
+#undef HAVE_NATIVE_mpn_divrem_newton       
+#undef HAVE_NATIVE_mpn_divrem_classic      
+#undef HAVE_NATIVE_mpn_dump                
+#undef HAVE_NATIVE_mpn_gcd                 
+#undef HAVE_NATIVE_mpn_gcd_1               
+#undef HAVE_NATIVE_mpn_gcdext              
+#undef HAVE_NATIVE_mpn_get_str             
+#undef HAVE_NATIVE_mpn_hamdist             
+#undef HAVE_NATIVE_mpn_invert_limb
+#undef HAVE_NATIVE_mpn_ior_n               
+#undef HAVE_NATIVE_mpn_iorn_n              
+#undef HAVE_NATIVE_mpn_lshift              
+#undef HAVE_NATIVE_mpn_mod_1               
+#undef HAVE_NATIVE_mpn_mod_1c
+#undef HAVE_NATIVE_mpn_mul                 
+#undef HAVE_NATIVE_mpn_mul_1               
+#undef HAVE_NATIVE_mpn_mul_1c
+#undef HAVE_NATIVE_mpn_mul_basecase        
+#undef HAVE_NATIVE_mpn_mul_n               
+#undef HAVE_NATIVE_mpn_nand_n              
+#undef HAVE_NATIVE_mpn_nior_n              
+#undef HAVE_NATIVE_mpn_perfect_square_p    
+#undef HAVE_NATIVE_mpn_popcount            
+#undef HAVE_NATIVE_mpn_preinv_mod_1        
+#undef HAVE_NATIVE_mpn_random2             
+#undef HAVE_NATIVE_mpn_random              
+#undef HAVE_NATIVE_mpn_rawrandom           
+#undef HAVE_NATIVE_mpn_rshift              
+#undef HAVE_NATIVE_mpn_scan0               
+#undef HAVE_NATIVE_mpn_scan1               
+#undef HAVE_NATIVE_mpn_set_str             
+#undef HAVE_NATIVE_mpn_sqrtrem             
+#undef HAVE_NATIVE_mpn_sqr_basecase        
+#undef HAVE_NATIVE_mpn_sub                 
+#undef HAVE_NATIVE_mpn_sub_1               
+#undef HAVE_NATIVE_mpn_sub_n               
+#undef HAVE_NATIVE_mpn_sub_nc              
+#undef HAVE_NATIVE_mpn_submul_1            
+#undef HAVE_NATIVE_mpn_submul_1c
+#undef HAVE_NATIVE_mpn_udiv_w_sdiv         
+#undef HAVE_NATIVE_mpn_umul_ppmm
+#undef HAVE_NATIVE_mpn_udiv_qrnnd
+#undef HAVE_NATIVE_mpn_xor_n               
+#undef HAVE_NATIVE_mpn_xnor_n              
+
+/* Define to 1 if you have the declaration of `optarg', and to 0 if you don't.
+   */
+#undef HAVE_DECL_OPTARG
+
+/* ./configure --enable-assert option, to enable some ASSERT()s */
+#undef WANT_ASSERT
+
+/* Define if you have the <sys/sysctl.h> header file. */
+#undef HAVE_SYS_SYSCTL_H
+
+/* Define if you have the `strtoul' function. */
+#undef HAVE_STRTOUL
+
+/* Name of package */
+#undef PACKAGE
+
+/* Define if you have the `sysctlbyname' function. */
+#undef HAVE_SYSCTLBYNAME
+
+/* Define if the system has the type `void'. */
+#undef HAVE_VOID
+
+/* Define if you have the `popen' function. */
+#undef HAVE_POPEN
+
+/* ./configure --disable-alloca option, to use stack-alloc.c, not alloca */
+#undef USE_STACK_ALLOC
+
+/* Define if cpp supports the ANSI # stringizing operator. */
+#undef HAVE_STRINGIZE
+
+/* Define if you have the <sys/time.h> header file. */
+#undef HAVE_SYS_TIME_H
+
+/* Define if you have the `sysconf' function. */
+#undef HAVE_SYSCONF
+
+/* Define if you have the `getpagesize' function. */
+#undef HAVE_GETPAGESIZE
+
+/* Define if you have the `processor_info' function. */
+#undef HAVE_PROCESSOR_INFO
+
+/* Version number of package */
+#undef VERSION
+
+/* Define if you have the `getopt_long' function. */
+#undef HAVE_GETOPT_LONG
+
+/* Define if you have the <getopt.h> header file. */
+#undef HAVE_GETOPT_H
+
+/* Define if you have the ANSI C header files. */
+#undef STDC_HEADERS
+
+/* Define if a speed_cyclecounter exists (for the tune programs) */
+#undef HAVE_SPEED_CYCLECOUNTER
+
+/* Define if mpn/tests has calling conventions checking for the CPU */
+#undef HAVE_CALLING_CONVENTIONS
+
+/* ./configure --enable-fft option, to enable FFTs for multiplication */
+#undef WANT_FFT
+
+/* Define if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* Define if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
diff --git a/src/gmp/config.sub b/src/gmp/config.sub
new file mode 100755
index 000000000..c4123f28f
--- /dev/null
+++ b/src/gmp/config.sub
@@ -0,0 +1,1273 @@
+#! /bin/sh
+# Configuration validation subroutine script, version 1.1.
+#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000
+#   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.
+
+# Written by Per Bothner <bothner@cygnus.com>.
+# Please send patches to <config-patches@gnu.org>.
+#
+# 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
+  nto-qnx* | 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
+		;;
+	-sim | -cisco | -oki | -wec | -winbond)
+		os=
+		basic_machine=$1
+		;;
+	-scout)
+		;;
+	-wrs)
+		os=-vxworks
+		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/'`
+		;;
+	-udk*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-isc)
+		os=-isc2.2
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-clix*)
+		basic_machine=clipper-intergraph
+		;;
+	-isc*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-lynx*)
+		os=-lynxos
+		;;
+	-ptx*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+		;;
+	-windowsnt*)
+		os=`echo $os | sed -e 's/windowsnt/winnt/'`
+		;;
+	-psos*)
+		os=-psos
+		;;
+	-mint | -mint[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+	# Recognize the basic CPU types without company name.
+	# Some are omitted here because they have special meanings below.
+	tahoe | i860 | ia64 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \
+		| arme[lb] | pyramid | mn10200 | mn10300 | tron | a29k \
+		| 580 | i960 | h8300 \
+		| x86 | ppcbe | mipsbe | mipsle | shbe | shle | armbe | armle \
+		| hppa | hppa1.0 | hppa1.1 | hppa2.0 | hppa2.0w | hppa2.0n \
+		| alpha | alphaev[4-8] | alphaev56 | alphapca5[67] \
+		| alphaev6[78] \
+		| we32k | ns16k | clipper | i370 | sh | powerpc | powerpcle \
+		| 1750a | dsp16xx | pdp11 | mips16 | mips64 | mipsel | mips64el \
+		| mips64orion | mips64orionel | mipstx39 | mipstx39el \
+		| mips64vr4300 | mips64vr4300el | mips64vr4100 | mips64vr4100el \
+		| mips64vr5000 | miprs64vr5000el | mcore \
+		| sparc | sparclet | sparclite | sparc64 | sparcv9 | v850 | c4x \
+		| powerpc64 | sparcv8 | supersparc | microsparc | ultrasparc \
+		| thumb | d10v | fr30 | avr)
+		basic_machine=$basic_machine-unknown
+		;;
+	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | z8k | v70 | h8500 | w65 | pj | pjl)
+		;;
+
+	# 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[34567]86 | pentium[23] | k[56] | k6[23] | athlon)
+	  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[34567]86-* | pentium[23]-* | i860-* | ia64-* | m32r-* | m68k-* | m68000-* \
+	      | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \
+	      | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \
+	      | power-* | none-* | 580-* | cray2-* | h8300-* | h8500-* | i960-* \
+	      | xmp-* | ymp-* \
+	      | x86-* | ppcbe-* | mipsbe-* | mipsle-* | shbe-* | shle-* | armbe-* | armle-* \
+	      | hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* | hppa2.0w-* | hppa2.0n-* \
+	      | alpha-* | alphaev[4-8]-* | alphaev56-* | alphapca5[67]-* \
+	      | alphaev6[78]-* \
+	      | we32k-* | cydra-* | ns16k-* | pn-* | np1-* | xps100-* \
+	      | clipper-* | orion-* \
+	      | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \
+	      | sparc64-* | sparcv9-* | sparc86x-* | mips16-* | mips64-* | mipsel-* \
+	      | mips64el-* | mips64orion-* | mips64orionel-* \
+	      | mips64vr4100-* | mips64vr4100el-* | mips64vr4300-* | mips64vr4300el-* \
+	      | mipstx39-* | mipstx39el-* | mcore-* \
+	      | f301-* | armv*-* | s390-* | sv1-* | t3e-* \
+	      | m88110-* | m680[01234]0-* | m683?2-* | m68360-* | z8k-* | d10v-* \
+	      | k[56]-* | k6[23]-* | athlon-* | powerpc64-* \
+	      | sparcv8-* | supersparc-* | microsparc-* | ultrasparc-* \
+	      | thumb-* | v850-* | d30v-* | tic30-* | c30-* | fr30-* )
+		;;
+	# 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
+		;;
+	a29khif)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	adobe68k)
+		basic_machine=m68010-adobe
+		os=-scout
+		;;
+	alliant | fx80)
+		basic_machine=fx80-alliant
+		;;
+	altos | altos3068)
+		basic_machine=m68k-altos
+		;;
+	am29k)
+		basic_machine=a29k-none
+		os=-bsd
+		;;
+	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
+		;;
+	apollo68bsd)
+		basic_machine=m68k-apollo
+		os=-bsd
+		;;
+	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
+		;;
+	es1800 | OSE68k | ose68k | ose | OSE)
+		basic_machine=m68k-ericsson
+		os=-ose
+		;;
+	fx2800)
+		basic_machine=i860-alliant
+		;;
+	genix)
+		basic_machine=ns32k-ns
+		;;
+	gmicro)
+		basic_machine=tron-gmicro
+		os=-sysv
+		;;
+	h3050r* | hiux*)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	h8300hms)
+		basic_machine=h8300-hitachi
+		os=-hms
+		;;
+	h8300xray)
+		basic_machine=h8300-hitachi
+		os=-xray
+		;;
+	h8500hms)
+		basic_machine=h8500-hitachi
+		os=-hms
+		;;
+	harris)
+		basic_machine=m88k-harris
+		os=-sysv3
+		;;
+	hp300-*)
+		basic_machine=m68k-hp
+		;;
+	hp300bsd)
+		basic_machine=m68k-hp
+		os=-bsd
+		;;
+	hp300hpux)
+		basic_machine=m68k-hp
+		os=-hpux
+		;;
+	hp3k9[0-9][0-9] | hp9[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k2[0-9][0-9] | hp9k31[0-9])
+		basic_machine=m68000-hp
+		;;
+	hp9k3[2-9][0-9])
+		basic_machine=m68k-hp
+		;;
+	hp9k6[0-9][0-9] | hp6[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k7[0-79][0-9] | hp7[0-79][0-9])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k78[0-9] | hp78[0-9])
+		basic_machine=hppa2.0-hp
+		;;
+	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+		basic_machine=hppa2.0-hp
+		;;
+	hp9k8[0-9][13679] | hp8[0-9][13679])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][0-9] | hp8[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hppa-next)
+		os=-nextstep3
+		;;
+	hppaosf)
+		basic_machine=hppa1.1-hp
+		os=-osf
+		;;
+	hppro)
+		basic_machine=hppa1.1-hp
+		os=-proelf
+		;;
+	i370-ibm* | ibm*)
+		basic_machine=i370-ibm
+		;;
+# I'm not sure what "Sysv32" means.  Should this be sysv3.2?
+	i[34567]86v32)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv32
+		;;
+	i[34567]86v4*)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv4
+		;;
+	i[34567]86v)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv
+		;;
+	i[34567]86sol2)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-solaris2
+		;;
+	i386mach)
+		basic_machine=i386-mach
+		os=-mach
+		;;
+	i386-vsta | vsta)
+		basic_machine=i386-unknown
+		os=-vsta
+		;;
+	i386-go32 | go32)
+		basic_machine=i386-unknown
+		os=-go32
+		;;
+	i386-mingw32 | mingw32)
+		basic_machine=i386-unknown
+		os=-mingw32
+		;;
+	iris | iris4d)
+		basic_machine=mips-sgi
+		case $os in
+		    -irix*)
+			;;
+		    *)
+			os=-irix4
+			;;
+		esac
+		;;
+	isi68 | isi)
+		basic_machine=m68k-isi
+		os=-sysv
+		;;
+	macppc*)
+		basic_machine=powerpc-apple
+		;;
+	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
+		;;
+	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+	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
+		;;
+	mmix*)
+		basic_machine=mmix-knuth
+		os=-mmixware
+		;;
+	monitor)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	msdos)
+		basic_machine=i386-unknown
+		os=-msdos
+		;;
+	mvs)
+		basic_machine=i370-ibm
+		os=-mvs
+		;;
+	ncr3000)
+		basic_machine=i486-ncr
+		os=-sysv4
+		;;
+	netbsd386)
+		basic_machine=i386-unknown
+		os=-netbsd
+		;;
+	netwinder)
+		basic_machine=armv4l-rebel
+		os=-linux
+		;;
+	news | news700 | news800 | news900)
+		basic_machine=m68k-sony
+		os=-newsos
+		;;
+	news1000)
+		basic_machine=m68030-sony
+		os=-newsos
+		;;
+	news-3600 | risc-news)
+		basic_machine=mips-sony
+		os=-newsos
+		;;
+	necv70)
+		basic_machine=v70-nec
+		os=-sysv
+		;;
+	next | m*-next )
+		basic_machine=m68k-next
+		case $os in
+		    -nextstep* )
+			;;
+		    -ns2*)
+		      os=-nextstep2
+			;;
+		    *)
+		      os=-nextstep3
+			;;
+		esac
+		;;
+	nh3000)
+		basic_machine=m68k-harris
+		os=-cxux
+		;;
+	nh[45]000)
+		basic_machine=m88k-harris
+		os=-cxux
+		;;
+	nindy960)
+		basic_machine=i960-intel
+		os=-nindy
+		;;
+	mon960)
+		basic_machine=i960-intel
+		os=-mon960
+		;;
+	np1)
+		basic_machine=np1-gould
+		;;
+	nsr-tandem)
+		basic_machine=nsr-tandem
+		;;
+	op50n-* | op60c-*)
+		basic_machine=hppa1.1-oki
+		os=-proelf
+		;;
+	OSE68000 | ose68000)
+		basic_machine=m68000-ericsson
+		os=-ose
+		;;
+	os68k)
+		basic_machine=m68k-none
+		os=-os68k
+		;;
+	pa-hitachi)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	paragon)
+		basic_machine=i860-intel
+		os=-osf
+		;;
+	pbd)
+		basic_machine=sparc-tti
+		;;
+	pbb)
+		basic_machine=m68k-tti
+		;;
+        pc532 | pc532-*)
+		basic_machine=ns32k-pc532
+		;;
+	pentiummmx | p55)
+		basic_machine=pentiummmx-pc
+		;;
+	pentium | p5 | i586)
+		basic_machine=pentium-pc
+		;;
+	pentiumpro | p6)
+		basic_machine=pentiumpro-pc
+		;;
+	pentiummmx-* | p55-*)
+		basic_machine=pentiummmx-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentium-* | p5-* | i586-*)
+		basic_machine=pentium-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentiumpro-* | p6-*)
+		basic_machine=pentiumpro-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	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/^[^-]*-//'`
+		;;
+	ppc64)	basic_machine=powerpc64-unknown
+	        ;;
+	ppc64-*)
+		basic_machine=powerpc64-`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
+		;;
+	rom68k)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	rm[46]00)
+		basic_machine=mips-siemens
+		;;
+	rtpc | rtpc-*)
+		basic_machine=romp-ibm
+		;;
+	sa29200)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	sequent)
+		basic_machine=i386-sequent
+		;;
+	sh)
+		basic_machine=sh-hitachi
+		os=-hms
+		;;
+	sparclite-wrs)
+		basic_machine=sparclite-wrs
+		os=-vxworks
+		;;
+	sps7)
+		basic_machine=m68k-bull
+		os=-sysv2
+		;;
+	spur)
+		basic_machine=spur-unknown
+		;;
+	st2000)
+		basic_machine=m68k-tandem
+		;;
+	stratus)
+		basic_machine=i860-stratus
+		os=-sysv4
+		;;
+	sun2)
+		basic_machine=m68000-sun
+		;;
+	sun2os3)
+		basic_machine=m68000-sun
+		os=-sunos3
+		;;
+	sun2os4)
+		basic_machine=m68000-sun
+		os=-sunos4
+		;;
+	sun3os3)
+		basic_machine=m68k-sun
+		os=-sunos3
+		;;
+	sun3os4)
+		basic_machine=m68k-sun
+		os=-sunos4
+		;;
+	sun4os3)
+		basic_machine=sparc-sun
+		os=-sunos3
+		;;
+	sun4os4)
+		basic_machine=sparc-sun
+		os=-sunos4
+		;;
+	sun4sol2)
+		basic_machine=sparc-sun
+		os=-solaris2
+		;;
+	sun3 | sun3-*)
+		basic_machine=m68k-sun
+		;;
+	sun4)
+		basic_machine=sparc-sun
+		;;
+	sun386 | sun386i | roadrunner)
+		basic_machine=i386-sun
+		;;
+	sv1)
+		basic_machine=sv1-cray
+		os=-unicos
+		;;
+	symmetry)
+		basic_machine=i386-sequent
+		os=-dynix
+		;;
+	t3e)
+		basic_machine=t3e-cray
+		os=-unicos
+		;;
+	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
+		;;
+	v810 | necv810)
+		basic_machine=v810-nec
+		os=-none
+		;;
+	vaxv)
+		basic_machine=vax-dec
+		os=-sysv
+		;;
+	vms)
+		basic_machine=vax-dec
+		os=-vms
+		;;
+	vpp*|vx|vx-*)
+               basic_machine=f301-fujitsu
+               ;;
+	vxworks960)
+		basic_machine=i960-wrs
+		os=-vxworks
+		;;
+	vxworks68)
+		basic_machine=m68k-wrs
+		os=-vxworks
+		;;
+	vxworks29k)
+		basic_machine=a29k-wrs
+		os=-vxworks
+		;;
+	w65*)
+		basic_machine=w65-wdc
+		os=-none
+		;;
+	w89k-*)
+		basic_machine=hppa1.1-winbond
+		os=-proelf
+		;;
+	xmp)
+		basic_machine=xmp-cray
+		os=-unicos
+		;;
+        xps | xps100)
+		basic_machine=xps100-honeywell
+		;;
+	z8k-*-coff)
+		basic_machine=z8k-unknown
+		os=-sim
+		;;
+	none)
+		basic_machine=none-none
+		os=-none
+		;;
+
+# Here we handle the default manufacturer of certain CPU types.  It is in
+# some cases the only manufacturer, in others, it is the most popular.
+	w89k)
+		basic_machine=hppa1.1-winbond
+		;;
+	op50n)
+		basic_machine=hppa1.1-oki
+		;;
+	op60c)
+		basic_machine=hppa1.1-oki
+		;;
+	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 | sparcv9)
+		basic_machine=sparc-sun
+		;;
+        cydra)
+		basic_machine=cydra-cydrome
+		;;
+	orion)
+		basic_machine=orion-highlevel
+		;;
+	orion105)
+		basic_machine=clipper-highlevel
+		;;
+	mac | mpw | mac-mpw)
+		basic_machine=m68k-apple
+		;;
+	pmac | pmac-mpw)
+		basic_machine=powerpc-apple
+		;;
+	c4x*)
+		basic_machine=c4x-none
+		os=-coff
+		;;
+	*)
+		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* | -oabi* \
+	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+	      | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+	      | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \
+	      | -interix* | -uwin* | -rhapsody* | -darwin* | -opened* \
+	      | -openstep* | -oskit*)
+	# Remember, each alternative MUST END IN *, to match a version number.
+		;;
+	-qnx*)
+		case $basic_machine in
+		    x86-* | i[34567]86-*)
+			;;
+		    *)
+			os=-nto$os
+			;;
+		esac
+		;;
+	-nto*)
+		os=-nto-qnx
+		;;
+	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
+	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* \
+	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
+		;;
+	-mac*)
+		os=`echo $os | sed -e 's|mac|macos|'`
+		;;
+	-linux*)
+		os=`echo $os | sed -e 's|linux|linux-gnu|'`
+		;;
+	-sunos5*)
+		os=`echo $os | sed -e 's|sunos5|solaris2|'`
+		;;
+	-sunos6*)
+		os=`echo $os | sed -e 's|sunos6|solaris3|'`
+		;;
+	-opened*)
+		os=-openedition
+		;;
+	-wince*)
+		os=-wince
+		;;
+	-osfrose*)
+		os=-osfrose
+		;;
+	-osf*)
+		os=-osf
+		;;
+	-utek*)
+		os=-bsd
+		;;
+	-dynix*)
+		os=-bsd
+		;;
+	-acis*)
+		os=-aos
+		;;
+	-386bsd)
+		os=-bsd
+		;;
+	-ctix* | -uts*)
+		os=-sysv
+		;;
+	-ns2 )
+	        os=-nextstep2
+		;;
+	-nsk)
+		os=-nsk
+		;;
+	# 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*)
+		;;
+	-ose*)
+		os=-ose
+		;;
+	-es1800*)
+		os=-ose
+		;;
+	-xenix)
+		os=-xenix
+		;;
+        -*mint | -*MiNT)
+	        os=-mint
+		;;
+	-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*-rebel)
+		os=-linux
+		;;
+	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
+		;;
+	m68*-cisco)
+		os=-aout
+		;;
+	mips*-cisco)
+		os=-elf
+		;;
+	mips*-*)
+		os=-elf
+		;;
+	*-tti)	# must be before sparc entry or we get the wrong os.
+		os=-sysv3
+		;;
+	sparc-* | *-sun)
+		os=-sunos4.1.1
+		;;
+	*-be)
+		os=-beos
+		;;
+	*-ibm)
+		os=-aix
+		;;
+	*-wec)
+		os=-proelf
+		;;
+	*-winbond)
+		os=-proelf
+		;;
+	*-oki)
+		os=-proelf
+		;;
+	*-hp)
+		os=-hpux
+		;;
+	*-hitachi)
+		os=-hiux
+		;;
+	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+		os=-sysv
+		;;
+	*-cbm)
+		os=-amigaos
+		;;
+	*-dg)
+		os=-dgux
+		;;
+	*-dolphin)
+		os=-sysv3
+		;;
+	m68k-ccur)
+		os=-rtu
+		;;
+	m88k-omron*)
+		os=-luna
+		;;
+	*-next )
+		os=-nextstep
+		;;
+	*-sequent)
+		os=-ptx
+		;;
+	*-crds)
+		os=-unos
+		;;
+	*-ns)
+		os=-genix
+		;;
+	i370-*)
+		os=-mvs
+		;;
+	*-next)
+		os=-nextstep3
+		;;
+        *-gould)
+		os=-sysv
+		;;
+        *-highlevel)
+		os=-bsd
+		;;
+	*-encore)
+		os=-bsd
+		;;
+        *-sgi)
+		os=-irix
+		;;
+        *-siemens)
+		os=-sysv4
+		;;
+	*-masscomp)
+		os=-rtu
+		;;
+	f301-fujitsu)
+		os=-uxpv
+		;;
+	*-rom68k)
+		os=-coff
+		;;
+	*-*bug)
+		os=-coff
+		;;
+	*-apple)
+		os=-macos
+		;;
+	*-atari*)
+		os=-mint
+		;;
+	*)
+		os=-none
+		;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer.  We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+	*-unknown)
+		case $os in
+			-riscix*)
+				vendor=acorn
+				;;
+			-sunos*)
+				vendor=sun
+				;;
+			-aix*)
+				vendor=ibm
+				;;
+			-beos*)
+				vendor=be
+				;;
+			-hpux*)
+				vendor=hp
+				;;
+			-mpeix*)
+				vendor=hp
+				;;
+			-hiux*)
+				vendor=hitachi
+				;;
+			-unos*)
+				vendor=crds
+				;;
+			-dgux*)
+				vendor=dg
+				;;
+			-luna*)
+				vendor=omron
+				;;
+			-genix*)
+				vendor=ns
+				;;
+			-mvs* | -opened*)
+				vendor=ibm
+				;;
+			-ptx*)
+				vendor=sequent
+				;;
+			-vxsim* | -vxworks*)
+				vendor=wrs
+				;;
+			-aux*)
+				vendor=apple
+				;;
+			-hms*)
+				vendor=hitachi
+				;;
+			-mpw* | -macos*)
+				vendor=apple
+				;;
+			-*mint | -*MiNT)
+				vendor=atari
+				;;
+		esac
+		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+		;;
+esac
+
+echo $basic_machine$os
diff --git a/src/gmp/configure b/src/gmp/configure
new file mode 100755
index 000000000..cafadc3fa
--- /dev/null
+++ b/src/gmp/configure
@@ -0,0 +1,5176 @@
+#! /bin/sh
+# From configure.in Revision: 1.129
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using Autoconf version 2.14a.
+# Copyright (C) 1992, 93, 94, 95, 96, 98, 99, 2000
+# 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_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+ac_init_help=false
+ac_init_version=false
+# 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=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+: ${ac_max_here_lines=48}
+# Sed expression to map a string onto a valid sh and CPP variable names.
+ac_tr_sh='sed -e y%*+%pp%;s%[^a-zA-Z0-9_]%_%g'
+ac_tr_cpp='sed -e y%*abcdefghijklmnopqrstuvwxyz%PABCDEFGHIJKLMNOPQRSTUVWXYZ%;s%[^A-Z0-9_]%_%g'
+
+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
+
+  ac_optarg=`echo "$ac_option" | sed -n 's/^[^=]*=//p'`
+
+  # 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 echo "$ac_feature" | grep '[^-a-zA-Z0-9_]' >/dev/null 2>&1; then
+      { echo "configure: error: invalid feature: $ac_feature" 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 echo "$ac_feature" | grep '[^-a-zA-Z0-9_]' >/dev/null 2>&1; then
+      { echo "configure: error: invalid feature: $ac_feature" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+      *) 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 | -h)
+    ac_init_help=: ;;
+  -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 | -V)
+    ac_init_version=: ;;
+
+  -with-* | --with-*)
+    ac_package=`echo "$ac_option"|sed -e 's/-*with-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if echo "$ac_package" | grep '[^-a-zA-Z0-9_]' >/dev/null 2>&1; then
+      { echo "configure: error: invalid package: $ac_package" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+      *) 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 echo "$ac_package" | grep '[^-a-zA-Z0-9_]' >/dev/null 2>&1; then
+      { echo "configure: error: invalid package: $ac_package" 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: unrecognized option: $ac_option
+Try \`configure --help' for more information." 1>&2; exit 1; }
+    ;;
+
+  *=*)
+    ac_envvar=`echo "$ac_option" | sed -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if echo "$ac_envvar" | grep '[^a-zA-Z0-9_]' >/dev/null 2>&1; then
+      { echo "configure: error: invalid variable name: $ac_envvar" 1>&2; exit 1; }
+    fi
+    ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
+    eval "$ac_envvar='$ac_optarg'"
+    export $ac_envvar ;;
+
+  *)
+    if echo "$ac_option" | grep '[^-a-zA-Z0-9.]' >/dev/null 2>&1; then
+      echo "configure: warning: invalid host type: $ac_option" 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
+if $ac_init_help; then
+  # 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
+`configure' configures software source code packages to adapt to many kinds
+of systems.
+
+Usage: configure [OPTION]... [VAR=VALUE]... [HOST]
+
+To safely assign special values to environment variables (e.g., CC,
+CFLAGS...), give to `configure' the definition as VAR=VALUE.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+  -h, --help              print this message
+  -V, --version           print the version of autoconf that created configure
+  -q, --quiet, --silent   do not print `checking...' messages
+      --cache-file=FILE   cache test results in FILE
+  -n, --no-create         do not create output files
+
+EOF
+
+  cat <<EOF
+Directories:
+  --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 ..]
+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]
+EOF
+
+  cat <<\EOF
+
+Program names:
+  --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
+
+Optional Features:
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE=ARG  include FEATURE ARG=yes
+  --disable-dependency-tracking Speeds up one-time builds
+  --enable-dependency-tracking  Do not reject slow dependency extractors
+  --enable-maintainer-mode enable make rules and dependencies not useful
+                          (and sometimes confusing) to the casual installer
+  --enable-assert         enable ASSERT checking default=no
+  --enable-alloca         use alloca for temp space default=yes
+  --enable-fft            enable FFTs for multiplication default=no
+  --enable-mpbsd          build Berkley MP compatibility library default=no
+  --enable-mpfr           build MPFR default=no
+  --enable-shared=PKGS  build shared libraries default=yes
+  --enable-static=PKGS  build static libraries default=yes
+  --enable-fast-install=PKGS  optimize for fast installation default=yes
+  --disable-libtool-lock  avoid locking (might break parallel builds)
+
+Optional Packages:
+  --with-PACKAGE=ARG    use PACKAGE ARG=yes
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --with-gnu-ld           assume the C compiler uses GNU ld default=no
+  --with-pic              try to use only PIC/non-PIC objects default=use both
+EOF
+  exit 0
+fi
+if $ac_init_version; then
+  cat <<\EOF
+Generated automatically using Autoconf version 2.14a.
+Copyright (C) 1992, 93, 94, 95, 96, 98, 99, 2000
+Free Software Foundation, Inc.
+
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+EOF
+  exit 0
+fi
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell meta-characters.
+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_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"`
+  ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+  *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+  esac
+done
+
+# 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.
+
+It was created by configure version 2.14a, executed with
+ > $0 $ac_configure_args
+" 1>&5
+
+# 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=
+
+# 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: cannot find sources in $ac_confdir or .." 1>&2; exit 1; }
+  else
+    { echo "configure: error: cannot 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"
+      test -f "$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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#include <sys/types.h>
+#if STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# if HAVE_STDLIB_H
+#  include <stdlib.h>
+# endif
+#endif
+#if HAVE_STRING_H
+# if !STDC_HEADERS && HAVE_MEMORY_H
+#  include <memory.h>
+# endif
+# include <string.h>
+#else
+# if HAVE_STRINGS_H
+#  include <strings.h>
+# endif
+#endif
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#endif
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif"
+
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+  # Stardent Vistra SVR4 grep lacks -e, says Kaveh R. Ghazi.
+  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+    ECHO_N= ECHO_C='
+' ECHO_T='	'
+  else
+    ECHO_N=-n ECHO_C= ECHO_T=
+  fi
+else
+  ECHO_N= ECHO_C='\c' ECHO_T=
+fi
+
+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
+  elif test -f $ac_dir/shtool; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/shtool install -c"
+    break
+  fi
+done
+if test -z "$ac_aux_dir"; then
+  { echo "configure: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess="$SHELL $ac_aux_dir/config.guess"
+ac_config_sub="$SHELL $ac_aux_dir/config.sub"
+ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure.
+
+echo $ECHO_N "checking host system type... $ECHO_C" 1>&6
+echo "configure:636: checking host system type" 1>&5
+if test "x$ac_cv_host" = "x" || (test "x$host" != "xNONE" && test "x$host" != "x$ac_cv_host_alias"); then
+
+  # Make sure we can run config.sub.
+  if $ac_config_sub sun4 >/dev/null 2>&1; then :; else
+    { echo "configure: error: cannot run $ac_config_sub" 1>&2; exit 1; }
+  fi
+
+  ac_cv_host_alias=$host
+  case "$ac_cv_host_alias" in
+  NONE)
+    case $nonopt in
+    NONE)
+      if ac_cv_host_alias=`$ac_config_guess`; then :
+      else { echo "configure: error: cannot guess host type; you must specify one" 1>&2; exit 1; }
+      fi ;;    *) ac_cv_host_alias=$nonopt ;;
+    esac ;;
+  esac
+
+  ac_cv_host=`$ac_config_sub $ac_cv_host_alias` || exit 1
+  ac_cv_host_cpu=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+  ac_cv_host_vendor=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+  ac_cv_host_os=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+else
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+fi
+
+echo "$ECHO_T""$ac_cv_host" 1>&6
+
+host=$ac_cv_host
+host_alias=$ac_cv_host_alias
+host_cpu=$ac_cv_host_cpu
+host_vendor=$ac_cv_host_vendor
+host_os=$ac_cv_host_os
+
+echo $ECHO_N "checking target system type... $ECHO_C" 1>&6
+echo "configure:672: checking target system type" 1>&5
+if test "x$ac_cv_target" = "x" || (test "x$target" != "xNONE" && test "x$target" != "x$ac_cv_target_alias"); then
+
+  # Make sure we can run config.sub.
+  if $ac_config_sub sun4 >/dev/null 2>&1; then :; else
+    { echo "configure: error: cannot run $ac_config_sub" 1>&2; exit 1; }
+  fi
+
+  ac_cv_target_alias=$target
+  case "$ac_cv_target_alias" in
+  NONE)
+    case $nonopt in
+    NONE)
+      ac_cv_target_alias=$host_alias ;;
+    *) ac_cv_target_alias=$nonopt ;;
+    esac ;;
+  esac
+
+  ac_cv_target=`$ac_config_sub $ac_cv_target_alias` || exit 1
+  ac_cv_target_cpu=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+  ac_cv_target_vendor=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+  ac_cv_target_os=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+else
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+fi
+
+echo "$ECHO_T""$ac_cv_target" 1>&6
+
+target=$ac_cv_target
+target_alias=$ac_cv_target_alias
+target_cpu=$ac_cv_target_cpu
+target_vendor=$ac_cv_target_vendor
+target_os=$ac_cv_target_os
+
+echo $ECHO_N "checking build system type... $ECHO_C" 1>&6
+echo "configure:707: checking build system type" 1>&5
+if test "x$ac_cv_build" = "x" || (test "x$build" != "xNONE" && test "x$build" != "x$ac_cv_build_alias"); then
+
+  # Make sure we can run config.sub.
+  if $ac_config_sub sun4 >/dev/null 2>&1; then :; else
+    { echo "configure: error: cannot run $ac_config_sub" 1>&2; exit 1; }
+  fi
+
+  ac_cv_build_alias=$build
+  case "$ac_cv_build_alias" in
+  NONE)
+    case $nonopt in
+    NONE)
+      ac_cv_build_alias=$host_alias ;;
+    *) ac_cv_build_alias=$nonopt ;;
+    esac ;;
+  esac
+
+  ac_cv_build=`$ac_config_sub $ac_cv_build_alias` || exit 1
+  ac_cv_build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+  ac_cv_build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+  ac_cv_build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+else
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+fi
+
+echo "$ECHO_T""$ac_cv_build" 1>&6
+
+build=$ac_cv_build
+build_alias=$ac_cv_build_alias
+build_cpu=$ac_cv_build_cpu
+build_vendor=$ac_cv_build_vendor
+build_os=$ac_cv_build_os
+
+# Do some error checking and defaulting for the host and target type.
+# The inputs are:
+#    configure --host=HOST --target=TARGET --build=BUILD NONOPT
+#
+# The rules are:
+# 1. You are not allowed to specify --host, --target, and nonopt at the
+#    same time.
+# 2. Host defaults to nonopt.
+# 3. If nonopt is not specified, then host defaults to the current host,
+#    as determined by config.guess.
+# 4. Target and build default to nonopt.
+# 5. If nonopt is not specified, then target and build default to host.
+
+# The aliases save the names the user supplied, while $host etc.
+# will get canonicalized.
+case $host---$target---$nonopt in
+NONE---*---* | *---NONE---* | *---*---NONE) ;;
+*) { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } ;;
+esac
+
+test "$host_alias" != "$target_alias" &&
+  test "$program_prefix$program_suffix$program_transform_name" = \
+    NONENONEs,x,x, &&
+  program_prefix=${target_alias}-
+
+# 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
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# 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 $ECHO_N "checking for a BSD compatible install... $ECHO_C" 1>&6
+echo "configure:778: checking for a BSD compatible install" 1>&5
+if test -z "$INSTALL"; then
+if test "${ac_cv_path_install+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+    IFS="${IFS= 	}"; ac_save_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.
+      # Don't use installbsd from OSF since it installs stuff as root
+      # by default.
+      for ac_prog in ginstall 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.
+	    :
+	  elif test $ac_prog = install &&
+	    grep pwplus $ac_dir/$ac_prog >/dev/null 2>&1; then
+	    # program-specific install script used by HP pwplus--don't use.
+	    :
+	  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 "$ECHO_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_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+echo $ECHO_N "checking whether build environment is sane... $ECHO_C" 1>&6
+echo "configure:835: checking whether build environment is sane" 1>&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 "$ECHO_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 >conftestsed
+s,\\,\\\\,g; s,\$,$$,g
+EOF
+  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,"
+
+test x"${MISSING+set}" = xset || \
+  MISSING="\${SHELL} `CDPATH=: && cd $ac_aux_dir && pwd`/missing"
+if eval "$MISSING --run :"; then
+  am_missing_run="$MISSING --run "
+else
+  am_missing_run=
+  am_backtick='`'
+  echo "configure: warning: ${am_backtick}missing' script is too old or missing" 1>&2
+fi
+
+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 $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
+echo "configure:906: checking for $ac_word" 1>&5
+if test "${ac_cv_prog_AWK+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$AWK"; then
+  ac_cv_prog_AWK="$AWK" # Let the user override the test.
+else
+  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+ac_dummy="$PATH"
+for ac_dir in $ac_dummy; do
+  test -z "$ac_dir" && ac_dir=.
+  if test -f $ac_dir/$ac_word; then
+    echo "$ac_dir/$ac_word"
+  fi
+done
+IFS="$ac_save_ifs"
+`; do
+    ac_cv_prog_AWK="$ac_prog"
+    break
+  done
+fi
+fi
+AWK="$ac_cv_prog_AWK"
+if test -n "$AWK"; then
+  echo "$ECHO_T""$AWK" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+test -n "$AWK" && break
+done
+
+echo $ECHO_N "checking whether ${MAKE-make} sets \${MAKE}... $ECHO_C" 1>&6
+echo "configure:939: checking whether ${MAKE-make} sets \${MAKE}" 1>&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_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 "$ECHO_T""yes" 1>&6
+  SET_MAKE=
+else
+  echo "$ECHO_T""no" 1>&6
+  SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+# Check whether --enable-dependency-tracking or --disable-dependency-tracking was given.
+if test "${enable_dependency_tracking+set}" = set; then
+  enableval="$enable_dependency_tracking"
+
+fi
+if test "x$enable_dependency_tracking" = xno; then
+  AMDEP="#"
+else
+  am_depcomp="$ac_aux_dir/depcomp"
+  if test ! -f "$am_depcomp"; then
+    AMDEP="#"
+  else
+    AMDEP=
+  fi
+fi
+
+if test -z "$AMDEP"; then
+  AMDEPBACKSLASH='\'
+else
+  AMDEPBACKSLASH=
+fi
+
+if test -d .deps || mkdir .deps 2> /dev/null || test -d .deps; then
+  DEPDIR=.deps
+else
+  DEPDIR=_deps
+fi
+
+PACKAGE=gmp
+
+VERSION=3.1
+
+if test "`CDPATH=: && 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
+cat >>confdefs.h <<EOF
+#define PACKAGE "$PACKAGE"
+EOF
+
+cat >>confdefs.h <<EOF
+#define VERSION "$VERSION"
+EOF
+
+ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal"}
+
+AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"}
+
+AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake"}
+
+AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"}
+
+MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"}
+
+AMTAR=${AMTAR-"${am_missing_run}tar"}
+
+if test -z "$install_sh"; then
+   install_sh="$ac_aux_dir/install-sh"
+   test -f "$install_sh" || install_sh="$ac_aux_dir/install.sh"
+   test -f "$install_sh" || install_sh="${am_missing_run}${ac_auxdir}/install-sh"
+         install_sh="`echo $install_sh | sed -e 's/\${SHELL}//'`"
+fi
+
+echo $ECHO_N "checking whether to enable maintainer-specific portions of Makefiles... $ECHO_C" 1>&6
+echo "configure:1029: checking whether to enable maintainer-specific portions of Makefiles" 1>&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 "$ECHO_T""$USE_MAINTAINER_MODE" 1>&6
+
+if test $USE_MAINTAINER_MODE = yes; then
+  MAINTAINER_MODE_TRUE=
+  MAINTAINER_MODE_FALSE='#'
+else
+  MAINTAINER_MODE_TRUE='#'
+  MAINTAINER_MODE_FALSE=
+fi
+  MAINT=$MAINTAINER_MODE_TRUE
+
+gmp_configm4="config.m4"
+gmp_tmpconfigm4=cnfm4.tmp
+gmp_tmpconfigm4i=cnfm4i.tmp
+gmp_tmpconfigm4p=cnfm4p.tmp
+test -f $gmp_tmpconfigm4 && rm $gmp_tmpconfigm4
+test -f $gmp_tmpconfigm4i && rm $gmp_tmpconfigm4i
+test -f $gmp_tmpconfigm4p && rm $gmp_tmpconfigm4p
+
+# Check whether --enable-assert or --disable-assert was given.
+if test "${enable_assert+set}" = set; then
+  enableval="$enable_assert"
+  case "${enableval}" in
+yes|no) ;;
+*) { echo "configure: error: bad value ${enableval} for --enable-assert, need yes or no" 1>&2; exit 1; } ;;
+esac
+else
+  enable_assert=no
+fi
+
+if test "$enable_assert" = "yes"; then
+  cat >>confdefs.h <<\EOF
+#define WANT_ASSERT 1
+EOF
+
+fi
+
+# Check whether --enable-alloca or --disable-alloca was given.
+if test "${enable_alloca+set}" = set; then
+  enableval="$enable_alloca"
+  case "${enableval}" in
+yes|no) ;;
+*) { echo "configure: error: bad value ${enableval} for --enable-alloca, need yes or no" 1>&2; exit 1; } ;;
+esac
+else
+  enable_alloca=yes
+fi
+
+if test "$enable_alloca" = "no"; then
+  cat >>confdefs.h <<\EOF
+#define USE_STACK_ALLOC 1
+EOF
+
+fi
+
+# Check whether --enable-fft or --disable-fft was given.
+if test "${enable_fft+set}" = set; then
+  enableval="$enable_fft"
+  case "${enableval}" in
+yes|no) ;;
+*) { echo "configure: error: bad value ${enableval} for --enable-fft, need yes or no" 1>&2; exit 1; } ;;
+esac
+else
+  enable_fft=no
+fi
+
+if test "$enable_fft" = "yes"; then
+  cat >>confdefs.h <<\EOF
+#define WANT_FFT 1
+EOF
+
+fi
+
+# Check whether --enable-mpbsd or --disable-mpbsd was given.
+if test "${enable_mpbsd+set}" = set; then
+  enableval="$enable_mpbsd"
+  case "${enableval}" in
+yes|no) ;;
+*) { echo "configure: error: bad value ${enableval} for --enable-mpbsd, need yes or no" 1>&2; exit 1; } ;;
+esac
+else
+  enable_mpbsd=no
+fi
+
+if test "$enable_mpbsd" = "yes"; then
+  WANT_MPBSD_TRUE=
+  WANT_MPBSD_FALSE='#'
+else
+  WANT_MPBSD_TRUE='#'
+  WANT_MPBSD_FALSE=
+fi
+
+# Check whether --enable-mpfr or --disable-mpfr was given.
+if test "${enable_mpfr+set}" = set; then
+  enableval="$enable_mpfr"
+  case "${enableval}" in
+yes|no) ;;
+*) { echo "configure: error: bad value ${enableval} for --enable-mpfr, need yes or no" 1>&2; exit 1; } ;;
+esac
+else
+  enable_mpfr=no
+fi
+
+if test "$enable_mpfr" = "yes"; then
+  WANT_MPFR_TRUE=
+  WANT_MPFR_FALSE='#'
+else
+  WANT_MPFR_TRUE='#'
+  WANT_MPFR_FALSE=
+fi
+
+os_64bit="no"
+cclist="gcc cc"		# FIXME: Prefer c89 to cc.
+gmp_cflags_gcc="-g -O2"
+gmp_cflags64_gcc="-g -O2"
+gmp_cflags_cc="-g"
+gmp_cflags64_cc="-g"
+
+case "$target" in
+  # Alpha
+  alpha*-cray-unicos*)
+    # Don't perform any assembly syntax tests on this beast.
+    gmp_no_asm_syntax_testing=yes
+    cclist=cc
+    gmp_cflags_cc="$gmp_cflags_cc -O"
+    ;;
+  alpha*-*-osf*)
+    flavour=`echo $target_cpu | sed 's/^alpha//g'`
+    if test -n "$flavour"; then
+      case $flavour in	   # compilers don't seem to understand `ev67' and such.
+	ev6? | ev7*) flavour=ev6;;
+      esac
+      gmp_optcflags_gcc="-mcpu=$flavour"
+      # FIXME: We shouldn't fail fatally if none of these work, but that's
+      # how xoptcflags work and we don't have any other mechanism right now.
+      # Why do we need this here and not for alpha*-*-* below?
+      gmp_xoptcflags_gcc="-Wa,-arch,${flavour} -Wa,-m${flavour}"
+      gmp_optcflags_cc="-arch $flavour -tune $flavour"
+    fi
+    ;;
+  alpha*-*-*)
+    cclist="gcc"
+    flavour=`echo $target_cpu | sed 's/^alpha//g'`
+    if test -n "$flavour"; then
+      case $flavour in
+	ev6? | ev7*) flavour=ev6;;
+      esac
+      gmp_optcflags_gcc="-mcpu=$flavour"
+    fi
+    ;;
+  # Cray vector machines.  This must come after alpha* so that we can
+  # recognize present and future vector processors with a wildcard.
+  *-cray-unicos*)
+    # Don't perform any assembly syntax tests on this beast.
+    gmp_no_asm_syntax_testing=yes
+    cclist=cc
+    # Don't inherit default gmp_cflags_cc value; it comes with -g which
+    # disables all optimization on Cray vector systems
+    gmp_cflags_cc="-O"
+    ;;
+
+  # AMD and Intel x86 configurations
+  i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*)
+    # Rumour has it -O2 used to give worse register allocation than just -O.
+    gmp_cflags_gcc="-g -O -fomit-frame-pointer"
+
+    case "${target}" in
+      i386*-*-*)    gmp_optcflags_gcc="-mcpu=i386 -march=i386";;
+      i486*-*-*)    gmp_optcflags_gcc="-mcpu=i486 -march=i486";;
+      i586*-*-* | pentium-*-* | pentiummmx-*-*)
+                    gmp_optcflags_gcc="-mcpu=pentium -march=pentium";;
+
+      # -march=pentiumpro not used because mpz/powm.c (swox cvs rev 1.4)
+      # tickles a bug in gcc 2.95.2 (believed fixed in 2.96).
+      i686*-*-* | pentiumpro-*-* | pentium[23]-*-*)
+                    gmp_optcflags_gcc="-mcpu=pentiumpro";;
+
+      k6*-*-*)      gmp_optcflags_gcc="-mcpu=k6 -march=k6";;
+
+      # Athlon instruction costs are close to p6: 3 cycle load latency, 4-6
+      # cycle mul, 40 cycle div, pairable adc, ...
+      # FIXME: Change this when gcc gets something specific for Athlon.
+      # -march=pentiumpro not used, per i686 above.
+      athlon-*-*)   gmp_optcflags_gcc="-mcpu=pentiumpro";;
+    esac
+    ;;
+
+  # Sparc
+  ultrasparc*-*-solaris2.[7-9] | sparcv9-*-solaris2.[7-9])
+    os_64bit=yes
+    gmp_cflags_gcc="$gmp_cflags_gcc -Wa,-xarch=v8plus"
+    gmp_xoptcflags_gcc="-mcpu=v9 -mcpu=v8 -mv8"
+    gmp_cflags64_gcc="$gmp_cflags64_gcc -m64 -mptr64 -Wa,-xarch=v9 -mcpu=v9"
+    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
+    gmp_cflags64_cc="-xtarget=native -xarch=v9 -xO4"
+    ;;
+  sparc64-*-linux*)
+    os_64bit=yes
+    gmp_cflags64_gcc="$gmp_cflags64_gcc -m64 -mptr64 -Wa,-xarch=v9 -mcpu=v9"
+    gmp_cflags_gcc="$gmp_cflags_gcc -m32"
+    gmp_xoptflags_gcc="-mcpu=ultrasparc -mvis"
+    ;;
+  ultrasparc*-*-* | sparcv9-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -Wa,-xarch=v8plus"
+    gmp_xoptcflags_gcc="-mcpu=v9 -mcpu=v8 -mv8"
+    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
+    ;;
+  sparcv8*-*-solaris2.* | microsparc*-*-solaris2.*)
+    gmp_cflags_gcc="$gmp_cflags_gcc"
+    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
+    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
+    ;;
+  sparcv8*-*-* | microsparc*-*-*)		# SunOS, Linux, *BSD
+    cclist="gcc acc cc"
+    gmp_cflags_gcc="$gmp_cflags_gcc"
+    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
+    gmp_cflags_acc="-g -O2 -cg92"
+    gmp_cflags_cc="-O2"		# FIXME: Flag for v8?
+    ;;
+  supersparc*-*-solaris2.*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -DSUPERSPARC"
+    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
+    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4 -DSUPERSPARC"
+    ;;
+  supersparc*-*-*)		# SunOS, Linux, *BSD
+    cclist="gcc acc cc"
+    gmp_cflags_gcc="$gmp_cflags_gcc -DSUPERSPARC"
+    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
+    gmp_cflags_acc="-g -O2 -cg92 -DSUPERSPARC"
+    gmp_cflags_cc="-O2 -DSUPERSPARC"	# FIXME: Flag for v8?
+    ;;
+  *sparc*-*-*)
+    cclist="gcc acc cc"
+    gmp_cflags_acc="-g -O2"
+    gmp_cflags_cc="-g -O2"
+    ;;
+
+  # POWER/PowerPC
+  powerpc64-*-aix*)
+    cclist="gcc xlc"
+    gmp_cflags_gcc="$gmp_cflags_gcc -maix64 -mpowerpc64"
+    gmp_cflags_xlc="-g -O2 -q64 -qtune=pwr3"
+    ;;
+  powerpc*-*-aix*)
+    cclist="gcc xlc"
+    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc"
+    gmp_cflags_xlc="$gmp_cflags_cc -qarch=ppc -O2"
+    ;;
+  power-*-aix*)
+    cclist="gcc xlc"
+    gmp_cflags_gcc="$gmp_cflags_gcc -mpower"
+    gmp_cflags_xlc="$gmp_cflags_cc -qarch=pwr -O2"
+    ;;
+  powerpc64*-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc64"
+    cat >>confdefs.h <<\EOF
+#define _LONG_LONG_LIMB 1
+EOF
+	    ;;
+  powerpc*-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc"
+    ;;
+
+  # MIPS
+  mips-sgi-irix6.*)
+    os_64bit=yes
+    gmp_cflags64_gcc="-g -O2 -mabi=n32"
+    gmp_cflags64_cc="$gmp_cflags64_cc -O2 -n32"
+    ;;
+
+  # Motorola 68k family
+  m88110*-*-*)
+    gmp_cflags_gcc="-g -O -m88110"	    ;;
+  m68*-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -fomit-frame-pointer"
+    ;;
+
+  # HP
+  hppa1.0*-*-*)
+    cclist="gcc c89 cc"
+    gmp_cflags_c89="$gmp_cflags_cc +O2"
+    gmp_cflags_cc="$gmp_cflags_cc +O2"
+    ;;
+  hppa2.0w*-*-*)
+    cclist="c89 cc"
+    gmp_cflags_c89="+DD64 +O3"
+    gmp_cflags_cc="+DD64 +O3"
+    ;;
+  hppa2.0*-*-*)
+    os_64bit=yes
+    cclist="gcc c89 cc"
+    gmp_cflags64_gcc="$gmp_cflags64_gcc -mWHAT -D_LONG_LONG_LIMB"
+    # +O2 to cc triggers bug in mpz/powm.c (1.4)
+    gmp_cflags64_c89="+DA2.0 +e +O3 -D_LONG_LONG_LIMB"
+    gmp_cflags64_cc="+DA2.0 +e +O3 -D_LONG_LONG_LIMB"
+    gmp_cflags_c89="$gmp_cflags_cc +O2"
+    gmp_cflags_cc="$gmp_cflags_cc +O2"
+    ;;
+
+  # VAX
+  vax*-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -fomit-frame-pointer"
+    ;;
+
+  # Fujitsu
+  f30[01]-fujitsu-sysv*)
+    cclist="gcc vcc"
+    gmp_cflags_vcc="-g"		# FIXME: flags for vcc?
+    ;;
+esac
+
+echo $ECHO_N "checking for BSD-compatible nm... $ECHO_C" 1>&6
+echo "configure:1349: checking for BSD-compatible nm" 1>&5
+if test "${ac_cv_path_NM+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$NM"; then
+  # Let the user override the test.
+  ac_cv_path_NM="$NM"
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
+  for ac_dir in $PATH /usr/ccs/bin /usr/ucb /bin; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/nm || test -f $ac_dir/nm$ac_exeext ; 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"
+	break
+      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"
+	break
+      else
+	ac_cv_path_NM=${ac_cv_path_NM="$ac_dir/nm"} # keep the first match, but
+	continue # so that we can try to find one that supports BSD flags
+      fi
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_path_NM" && ac_cv_path_NM=nm
+fi
+fi
+
+NM="$ac_cv_path_NM"
+echo "$ECHO_T""$NM" 1>&6
+	# nm on 64-bit AIX needs to know the object file format
+case "$target" in
+  powerpc64*-*-aix*)
+    NM="$NM -X 64"
+    ;;
+esac
+
+# Save CFLAGS given on command line.
+gmp_user_CFLAGS="$CFLAGS"
+
+if test -z "$CC"; then
+  # Find compiler.
+
+if test $host != $build; then
+  ac_tool_prefix=${host_alias}-
+else
+  ac_tool_prefix=
+fi
+
+gmp_cc_list="$cclist"
+gmp_req_64bit_cc="$os_64bit"
+
+CC32=
+CC64=
+for c in $gmp_cc_list; do
+  # Avoid cache hits.
+  unset CC
+  unset ac_cv_prog_CC
+
+# Extract the first word of "${ac_tool_prefix}$c", so it can be a program name with args.
+set dummy ${ac_tool_prefix}$c; ac_word=$2
+echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
+echo "configure:1415: checking for $ac_word" 1>&5
+if test "${ac_cv_prog_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+ac_dummy="$PATH"
+for ac_dir in $ac_dummy; do
+  test -z "$ac_dir" && ac_dir=.
+  if test -f $ac_dir/$ac_word; then
+    echo "$ac_dir/$ac_word"
+  fi
+done
+IFS="$ac_save_ifs"
+`; do
+    ac_cv_prog_CC="${ac_tool_prefix}$c"
+    break
+  done
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ECHO_T""$CC" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+if test -z "$ac_cv_prog_CC"; then
+  if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "$c", so it can be a program name with args.
+set dummy $c; ac_word=$2
+echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
+echo "configure:1449: checking for $ac_word" 1>&5
+if test "${ac_cv_prog_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+ac_dummy="$PATH"
+for ac_dir in $ac_dummy; do
+  test -z "$ac_dir" && ac_dir=.
+  if test -f $ac_dir/$ac_word; then
+    echo "$ac_dir/$ac_word"
+  fi
+done
+IFS="$ac_save_ifs"
+`; do
+    ac_cv_prog_CC="$c"
+    break
+  done
+  test -z "$ac_cv_prog_CC" && ac_cv_prog_CC="$c"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ECHO_T""$CC" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+  else
+    CC="$c"
+  fi
+fi
+
+  if test -n "$CC"; then
+    eval c_flags=\$gmp_cflags_$c
+    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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+	CC="$CC"
+CFLAGS="$c_flags"
+echo $ECHO_N "checking if the C compiler ($CC) works with flags $CFLAGS... $ECHO_C" 1>&6
+echo "configure:1495: checking if the C compiler ($CC) works with flags $CFLAGS" 1>&5
+
+# Simple test for all targets.
+cat >conftest.$ac_ext <<EOF
+
+#line 1500 "configure"
+#include "confdefs.h"
+
+int main(){return(0);}
+EOF
+if { (eval echo configure:1505: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  tmp_works=yes
+  # If we can't run a trivial program, we are probably using a cross compiler.
+  if (./conftest; exit) 2>/dev/null; then
+    tmp_cross=no
+  else
+    tmp_cross=yes
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  tmp_works=no
+fi
+rm -fr conftest*
+
+# Target specific tests.
+if test "$tmp_works" = "yes"; then
+  case "$target" in
+    *-*-aix*)	# Returning a funcptr.
+      cat >conftest.$ac_ext <<EOF
+#line 1525 "configure"
+#include "confdefs.h"
+
+int
+main ()
+{
+} void *g(); void *f() { return g(); } int bar(){
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:1536: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  tmp_works=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tmp_works=no
+fi
+rm -f conftest*
+      ;;
+  esac
+fi
+
+if test "$tmp_works" = "yes"; then
+  gmp_prog_cc_works=yes
+else
+  gmp_prog_cc_works=no
+fi
+
+echo "$ECHO_T""$tmp_works" 1>&6
+
+    if test "$gmp_prog_cc_works" != "yes"; then
+      continue
+    fi
+
+    # Save first working compiler, whether 32- or 64-bit capable.
+    if test -z "$CC32"; then
+      CC32="$CC"
+    fi
+    if test "$gmp_req_64bit_cc" = "yes"; then
+      eval c_flags=\$gmp_cflags64_$c
+
+      # Verify that the compiler works in 64-bit mode as well.
+      # /usr/ucb/cc on Solaris 7 can *compile* in 64-bit mode, but not link.
+      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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+	CC="$c"
+CFLAGS="$c_flags"
+echo $ECHO_N "checking if the C compiler ($CC) works with flags $CFLAGS... $ECHO_C" 1>&6
+echo "configure:1580: checking if the C compiler ($CC) works with flags $CFLAGS" 1>&5
+
+# Simple test for all targets.
+cat >conftest.$ac_ext <<EOF
+
+#line 1585 "configure"
+#include "confdefs.h"
+
+int main(){return(0);}
+EOF
+if { (eval echo configure:1590: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  tmp_works=yes
+  # If we can't run a trivial program, we are probably using a cross compiler.
+  if (./conftest; exit) 2>/dev/null; then
+    tmp_cross=no
+  else
+    tmp_cross=yes
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  tmp_works=no
+fi
+rm -fr conftest*
+
+# Target specific tests.
+if test "$tmp_works" = "yes"; then
+  case "$target" in
+    *-*-aix*)	# Returning a funcptr.
+      cat >conftest.$ac_ext <<EOF
+#line 1610 "configure"
+#include "confdefs.h"
+
+int
+main ()
+{
+} void *g(); void *f() { return g(); } int bar(){
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:1621: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  tmp_works=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tmp_works=no
+fi
+rm -f conftest*
+      ;;
+  esac
+fi
+
+if test "$tmp_works" = "yes"; then
+  gmp_prog_cc_works=yes
+else
+  gmp_prog_cc_works=no
+fi
+
+echo "$ECHO_T""$tmp_works" 1>&6
+
+      if test "$gmp_prog_cc_works" = "yes"; then
+
+  gmp_tmp_CC_save="$CC"
+  CC="$c"
+  echo $ECHO_N "checking whether the C compiler ($CC) is 64-bit capable... $ECHO_C" 1>&6
+echo "configure:1648: checking whether the C compiler ($CC) is 64-bit capable" 1>&5
+  if test -z "$NM"; then
+    echo; echo "configure: GMP_CHECK_CC_64BIT: fatal: need nm"
+    exit 1
+  fi
+  gmp_tmp_CFLAGS_save="$CFLAGS"
+  CFLAGS="$c_flags"
+
+  case "$target" in
+    hppa2.0*-*-*)
+      # FIXME: If gcc is installed under another name than "gcc", we will
+      # test the wrong thing.
+      if test "$CC" != "gcc"; then
+                                                echo >conftest.c
+        gmp_tmp_vs=`$CC $CFLAGS -V -c -o conftest.o conftest.c 2>&1 | grep "^ccom:"`
+        rm conftest*
+        gmp_tmp_v1=`echo $gmp_tmp_vs | sed 's/.* .\.\(.*\)\..*\..* HP C.*/\1/'`
+        gmp_tmp_v2=`echo $gmp_tmp_vs | sed 's/.* .\..*\.\(.*\)\..* HP C.*/\1/'`
+        gmp_tmp_v3=`echo $gmp_tmp_vs | sed 's/.* .\..*\..*\.\(.*\) HP C.*/\1/'`
+	gmp_cv_cc_64bit=no
+	test -n "$gmp_tmp_v1" && test "$gmp_tmp_v1" -ge "10" \
+  	  && test -n "$gmp_tmp_v2" && test "$gmp_tmp_v2" -ge "32" \
+    	  && test -n "$gmp_tmp_v3" && test "$gmp_tmp_v3" -ge "30" \
+	  && gmp_cv_cc_64bit=yes
+      else	# gcc
+	# FIXME: Compile a minimal file and determine if the resulting object
+	# file is an ELF file.  If so, gcc can produce 64-bit code.
+	# Do we have file(1) for target?
+	gmp_cv_cc_64bit=no
+      fi
+      ;;
+    mips-sgi-irix6.*)
+      # We use `-n32' to cc and `-mabi=n32' to gcc, resulting in 64-bit
+      # arithmetic but not 64-bit pointers, so the general test for sizeof
+      # (void *) is not valid.
+      # Simply try to compile an empty main.  If that succeeds return
+      # true.
+      cat >conftest.$ac_ext <<EOF
+#line 1686 "configure"
+#include "confdefs.h"
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:1697: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  gmp_cv_cc_64bit=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  gmp_cv_cc_64bit=no
+fi
+rm -f conftest*
+      ;;
+    *-*-*)
+      # Allocate an array of size sizeof (void *) and use nm to determine its
+      # size.  We depend on the first declared variable being put at address 0.
+      cat >conftest.c <<EOF
+char arr[sizeof (void *)]={0};
+char post=0;
+EOF
+      gmp_compile="$CC $CFLAGS -c conftest.c 1>&5"
+      if { (eval echo configure:1716: \"$gmp_compile\") 1>&5; (eval $gmp_compile) 2>&5; }; then
+        	gmp_tmp_val=`$NM conftest.o | grep post | sed -e 's;[[][0-9][]]\(.*\);\1;' \
+          -e 's;[^1-9]*\([0-9]*\).*;\1;'`
+                if test "$gmp_tmp_val" = "8"; then
+	  gmp_cv_cc_64bit=yes
+	else
+	  gmp_cv_cc_64bit=no
+        fi
+      else
+        echo "configure: failed program was:" >&5
+        cat conftest.$ac_ext >&5
+        gmp_cv_cc_64bit=no
+      fi
+      rm -f conftest*
+      ;;
+  esac
+
+  CC="$gmp_tmp_CC_save"
+  CFLAGS="$gmp_tmp_CFLAGS_save"
+  echo "$ECHO_T""$gmp_cv_cc_64bit" 1>&6
+
+        if test "$gmp_cv_cc_64bit" = "yes"; then
+          test -z "$CC64" && CC64="$c"
+          test -z "$CFLAGS64" && CFLAGS64="$c_flags"
+	  # We have CC64 so we're done.
+          break
+        fi
+      fi
+    else
+      # We have CC32, and we don't need a 64-bit compiler so we're done.
+      break
+    fi
+  fi
+done
+CC="$CC32"
+
+  # If 64-bit OS and we have a 64-bit compiler, use it.
+  if test -n "$os_64bit" && test -n "$CC64"; then
+    CC=$CC64
+    CFLAGS=$CFLAGS64
+  else
+    eval CFLAGS=\$gmp_cflags_$CC
+  fi
+
+  # Try compiler flags that may work with only some compiler versions.
+  # gmp_optcflags: All or nothing.
+  eval optcflags=\$gmp_optcflags_$CC
+  if test -n "$optcflags"; then
+    CFLAGS_save="$CFLAGS"
+    CFLAGS="$CFLAGS $optcflags"
+    echo $ECHO_N "checking whether $CC accepts $optcflags... $ECHO_C" 1>&6
+echo "configure:1767: checking whether $CC accepts $optcflags" 1>&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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+    cat >conftest.$ac_ext <<EOF
+
+#line 1777 "configure"
+#include "confdefs.h"
+
+int main(){return(0);}
+EOF
+if { (eval echo configure:1782: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  optok=yes
+  # If we can't run a trivial program, we are probably using a cross compiler.
+  if (./conftest; exit) 2>/dev/null; then
+    cross=no
+  else
+    cross=yes
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  optok=no
+fi
+rm -fr conftest*
+    if test "$optok" = "yes"; then
+      echo "$ECHO_T""yes" 1>&6
+    else
+      echo "$ECHO_T""no" 1>&6
+      CFLAGS="$CFLAGS_save"
+    fi
+  fi
+  # gmp_xoptcflags: First is best, one has to work.
+  eval xoptcflags=\$gmp_xoptcflags_$CC
+  if test -n "$xoptcflags"; then
+    gmp_found="no"
+    for xopt in $xoptcflags; do
+      CFLAGS_save="$CFLAGS"
+      CFLAGS="$CFLAGS $xopt"
+      echo $ECHO_N "checking whether $CC accepts $xopt... $ECHO_C" 1>&6
+echo "configure:1811: checking whether $CC accepts $xopt" 1>&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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+      cat >conftest.$ac_ext <<EOF
+
+#line 1821 "configure"
+#include "confdefs.h"
+
+int main(){return(0);}
+EOF
+if { (eval echo configure:1826: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  optok=yes
+  # If we can't run a trivial program, we are probably using a cross compiler.
+  if (./conftest; exit) 2>/dev/null; then
+    cross=no
+  else
+    cross=yes
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  optok=no
+fi
+rm -fr conftest*
+      if test "$optok" = "yes"; then
+        echo "$ECHO_T""yes" 1>&6
+        gmp_found="yes"
+        break
+      else
+        echo "$ECHO_T""no" 1>&6
+        CFLAGS="$CFLAGS_save"
+      fi
+    done
+    if test "$gmp_found" = "no"; then
+      echo "$0: fatal: need a compiler that understands one of $xoptcflags"
+      exit 1
+    fi
+  fi
+fi
+
+# Restore CFLAGS given on command line.
+# FIXME: We've run through quite some unnecessary code looking for a
+# nice compiler and working flags for it, just to spoil that with user
+# supplied flags.
+test -n "$gmp_user_CFLAGS" && CFLAGS="$gmp_user_CFLAGS"
+
+# Select chosen compiler.
+
+echo $ECHO_N "checking whether the C compiler ($CC $CFLAGS $CPPFLAGS $LDFLAGS) works... $ECHO_C" 1>&6
+echo "configure:1865: checking whether the C compiler ($CC $CFLAGS $CPPFLAGS $LDFLAGS) works" 1>&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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat >conftest.$ac_ext <<EOF
+
+#line 1876 "configure"
+#include "confdefs.h"
+
+int main(){return(0);}
+EOF
+if { (eval echo configure:1881: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; 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*
+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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ECHO_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 77; }
+fi
+echo $ECHO_N "checking whether the C compiler ($CC $CFLAGS $CPPFLAGS $LDFLAGS) is a cross-compiler... $ECHO_C" 1>&6
+echo "configure:1907: checking whether the C compiler ($CC $CFLAGS $CPPFLAGS $LDFLAGS) is a cross-compiler" 1>&5
+echo "$ECHO_T""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ECHO_N "checking whether we are using GNU C... $ECHO_C" 1>&6
+echo "configure:1912: checking whether we are using GNU C" 1>&5
+if test "${ac_cv_prog_gcc+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat >conftest.c <<EOF
+#ifdef __GNUC__
+  yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1921: \"$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 "$ECHO_T""$ac_cv_prog_gcc" 1>&6
+
+if test "$ac_cv_prog_gcc" = "yes"; then
+  GCC=yes
+else
+  GCC=
+fi
+
+# Set CFLAGS if not already set.
+if test -z "$CFLAGS"; then
+  CFLAGS="-g"
+  if test "$GCC" = "yes"; then
+    CFLAGS="$CFLAGS -O2"
+  fi
+fi
+
+if test "${ac_cv_prog_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  ac_cv_prog_CC="$CC"
+fi
+
+# How to assemble.
+CCAS="$CC -c"
+
+echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" 1>&6
+echo "configure:1953: checking how to run the C preprocessor" 1>&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+if test "${ac_cv_prog_CPP+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_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 1969 "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:1975: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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 1987 "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:1993: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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} -nologo -E"
+
+cat >conftest.$ac_ext <<EOF
+#line 2005 "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:2011: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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*
+fi
+rm -f conftest*
+  ac_cv_prog_CPP="$CPP"
+fi
+  CPP="$ac_cv_prog_CPP"
+else
+  ac_cv_prog_CPP="$CPP"
+fi
+echo "$ECHO_T""$CPP" 1>&6
+
+# 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
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# 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 $ECHO_N "checking for a BSD compatible install... $ECHO_C" 1>&6
+echo "configure:2047: checking for a BSD compatible install" 1>&5
+if test -z "$INSTALL"; then
+if test "${ac_cv_path_install+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+    IFS="${IFS= 	}"; ac_save_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.
+      # Don't use installbsd from OSF since it installs stuff as root
+      # by default.
+      for ac_prog in ginstall 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.
+	    :
+	  elif test $ac_prog = install &&
+	    grep pwplus $ac_dir/$ac_prog >/dev/null 2>&1; then
+	    # program-specific install script used by HP pwplus--don't use.
+	    :
+	  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 "$ECHO_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_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+echo $ECHO_N "checking whether ln -s works... $ECHO_C" 1>&6
+echo "configure:2104: checking whether ln -s works" 1>&5
+if test "${ac_cv_prog_LN_S+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_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 "$ECHO_T""yes" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+echo $ECHO_N "checking for suitable m4... $ECHO_C" 1>&6
+echo "configure:2125: checking for suitable m4" 1>&5
+if test "${gmp_cv_prog_m4+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$M4"; then
+  gmp_cv_prog_m4="$M4"
+else
+  cat >conftest.m4 <<\EOF
+define(dollarhash,``$#'')dnl
+ifelse(dollarhash(x),1,`define(t1,Y)',
+``bad: $# not supported (SunOS /usr/bin/m4)
+'')dnl
+ifelse(eval(89),89,`define(t2,Y)',
+`bad: eval() doesnt support 8 or 9 in a constant (OpenBSD 2.6 m4)
+')dnl
+ifelse(t1`'t2,YY,`good
+')dnl
+EOF
+  echo "trying m4" 1>&5
+  gmp_tmp_val="`(m4 conftest.m4) 2>&5`"
+  echo "$gmp_tmp_val" 1>&5
+  if test "$gmp_tmp_val" = good; then
+    gmp_cv_prog_m4="m4"
+  else
+    IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+    ac_dummy="$PATH:/usr/5bin"
+    for ac_dir in $ac_dummy; do
+      test -z "$ac_dir" && ac_dir=.
+      echo "trying $ac_dir/m4" 1>&5
+      gmp_tmp_val="`($ac_dir/m4 conftest.m4) 2>&5`"
+      echo "$gmp_tmp_val" 1>&5
+      if test "$gmp_tmp_val" = good; then
+        gmp_cv_prog_m4="$ac_dir/m4"
+        break
+      fi
+    done
+    IFS="$ac_save_ifs"
+    if test -z "$gmp_cv_prog_m4"; then
+      { echo "configure: error: No usable m4 in \$PATH or /usr/5bin (see config.log for reasons)." 1>&2; exit 1; }
+    fi
+  fi
+  rm -f conftest.m4
+fi
+fi
+echo "$ECHO_T""$gmp_cv_prog_m4" 1>&6
+M4="$gmp_cv_prog_m4"
+
+# Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
+echo "configure:2175: checking for $ac_word" 1>&5
+if test "${ac_cv_prog_AR+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$AR"; then
+  ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+ac_dummy="$PATH"
+for ac_dir in $ac_dummy; do
+  test -z "$ac_dir" && ac_dir=.
+  if test -f $ac_dir/$ac_word; then
+    echo "$ac_dir/$ac_word"
+  fi
+done
+IFS="$ac_save_ifs"
+`; do
+    ac_cv_prog_AR="ar"
+    break
+  done
+fi
+fi
+AR="$ac_cv_prog_AR"
+if test -n "$AR"; then
+  echo "$ECHO_T""$AR" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+# ar on AIX needs to know the object file format
+case "$target" in
+  powerpc64*-*-aix*)
+    AR="$AR -X 64"
+    ;;
+esac
+
+if test "$gmp_no_asm_syntax_testing" != "yes"; then
+  echo $ECHO_N "checking how to switch to text section... $ECHO_C" 1>&6
+echo "configure:2213: checking how to switch to text section" 1>&5
+if test "${gmp_cv_check_asm_text+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  case "$target" in
+  *-*-aix*)
+
+    gmp_cv_check_asm_text=".csect .text[PR]"
+
+    ;;
+  *-*-hpux*) gmp_cv_check_asm_text=".code" ;;
+  *) gmp_cv_check_asm_text=".text" ;;
+esac
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_text" 1>&6
+echo "define(<TEXT>, <$gmp_cv_check_asm_text>)" >> $gmp_tmpconfigm4
+
+  echo $ECHO_N "checking how to switch to data section... $ECHO_C" 1>&6
+echo "configure:2232: checking how to switch to data section" 1>&5
+if test "${gmp_cv_check_asm_data+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  case "$target" in
+  *-*-aix*)
+
+    gmp_cv_check_asm_data=".csect .data[RW]"
+
+    ;;
+  *) gmp_cv_check_asm_data=".data" ;;
+esac
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_data" 1>&6
+echo "define(<DATA>, <$gmp_cv_check_asm_data>)" >> $gmp_tmpconfigm4
+
+  echo $ECHO_N "checking how to export a symbol... $ECHO_C" 1>&6
+echo "configure:2250: checking how to export a symbol" 1>&5
+if test "${gmp_cv_check_asm_globl+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  case "$target" in
+  *-*-hpux*) gmp_cv_check_asm_globl=".export" ;;
+  *) gmp_cv_check_asm_globl=".globl" ;;
+esac
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_globl" 1>&6
+echo "define(<GLOBL>, <$gmp_cv_check_asm_globl>)" >> $gmp_tmpconfigm4
+
+  echo $ECHO_N "checking what assembly label suffix to use... $ECHO_C" 1>&6
+echo "configure:2264: checking what assembly label suffix to use" 1>&5
+if test "${gmp_cv_check_asm_label_suffix+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  case "$target" in
+  *-*-hpux*) gmp_cv_check_asm_label_suffix="" ;;
+  *) gmp_cv_check_asm_label_suffix=":" ;;
+esac
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_label_suffix" 1>&6
+echo "define(<LABEL_SUFFIX>, <\$1$gmp_cv_check_asm_label_suffix>)" >> $gmp_tmpconfigm4
+
+  echo $ECHO_N "checking how the .type assembly directive should be used... $ECHO_C" 1>&6
+echo "configure:2278: checking how the .type assembly directive should be used" 1>&5
+if test "${gmp_cv_check_asm_type+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
+for gmp_tmp_prefix in @ \# %; do
+  echo "	.type	sym,${gmp_tmp_prefix}function" > conftest.s
+  if { (eval echo configure:2285: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
+    gmp_cv_check_asm_type=".type	\$1,${gmp_tmp_prefix}\$2"
+    break
+  fi
+done
+if test -z "$gmp_cv_check_asm_type"; then
+  gmp_cv_check_asm_type="dnl"
+fi
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_type" 1>&6
+echo "define(<TYPE>, <$gmp_cv_check_asm_type>)" >> $gmp_tmpconfigm4
+
+  echo $ECHO_N "checking if the .size assembly directive works... $ECHO_C" 1>&6
+echo "configure:2299: checking if the .size assembly directive works" 1>&5
+if test "${gmp_cv_check_asm_size+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
+echo '	.size	sym,1' > conftest.s
+if { (eval echo configure:2305: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
+  gmp_cv_check_asm_size=".size	\$1,\$2"
+else
+  gmp_cv_check_asm_size="dnl"
+fi
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_size" 1>&6
+echo "define(<SIZE>, <$gmp_cv_check_asm_size>)" >> $gmp_tmpconfigm4
+
+echo $ECHO_N "checking what prefix to use for a local label... $ECHO_C" 1>&6
+echo "configure:2316: checking what prefix to use for a local label" 1>&5
+if test "${gmp_cv_check_asm_lsym_prefix+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -z "$NM"; then
+  echo; echo "GMP_CHECK_ASM_LSYM_PREFIX: fatal: need nm"
+  exit 1
+fi
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
+gmp_cv_check_asm_lsym_prefix="L"
+for gmp_tmp_pre in L .L $ L$; do
+  cat > conftest.s <<EOF
+dummy${gmp_cv_check_asm_label_suffix}
+${gmp_tmp_pre}gurkmacka${gmp_cv_check_asm_label_suffix}
+	.byte 0
+EOF
+  if { (eval echo configure:2332: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
+    $NM conftest.o >/dev/null 2>&1
+    gmp_rc=$?
+    if test "$gmp_rc" != "0"; then
+      echo "configure: $NM failure, using default"
+      break
+    fi
+    if $NM conftest.o | grep gurkmacka >/dev/null; then true; else
+      gmp_cv_check_asm_lsym_prefix="$gmp_tmp_pre"
+      break
+    fi
+  else
+    echo "configure: failed program was:" >&5
+    cat conftest.s >&5
+    # Use default.
+  fi
+done
+rm -f conftest*
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_lsym_prefix" 1>&6
+echo "define(<LSYM_PREFIX>, <${gmp_cv_check_asm_lsym_prefix}>)" >> $gmp_tmpconfigm4
+
+echo $ECHO_N "checking how to define a 32-bit word... $ECHO_C" 1>&6
+echo "configure:2356: checking how to [define] a 32-bit word" 1>&5
+if test "${gmp_cv_check_asm_w32+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -z "$NM"; then
+  echo; echo "configure: GMP_CHECK_ASM_W32: fatal: need nm"
+  exit 1
+fi
+
+# FIXME: HPUX puts first symbol at 0x40000000, breaking our assumption
+# that it's at 0x0.  We'll have to declare another symbol before the
+# .long/.word and look at the distance between the two symbols.  The
+# only problem is that the sed expression(s) barfs (on Solaris, for
+# example) for the symbol with value 0.  For now, HPUX uses .word.
+
+case "$target" in
+  *-*-hpux*)
+    gmp_cv_check_asm_w32=".word"
+    ;;
+  *-*-*)
+    ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
+    for gmp_tmp_op in .long .word; do
+      cat > conftest.s <<EOF
+	$gmp_cv_check_asm_data
+	$gmp_cv_check_asm_globl	foo
+	$gmp_tmp_op	0
+foo${gmp_cv_check_asm_label_suffix}
+	.byte	0
+EOF
+      if { (eval echo configure:2385: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
+
+        gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
+             -e 's;[^1-9]*\([0-9]*\).*;\1;'`
+                if test "$gmp_tmp_val" = "4"; then
+          gmp_cv_check_asm_w32="$gmp_tmp_op"
+          break
+        fi
+      fi
+    done
+    ;;
+esac
+
+if test -z "$gmp_cv_check_asm_w32"; then
+  echo; echo "configure: GMP_CHECK_ASM_W32: fatal: do not know how to define a 32-bit word"
+  exit 1
+fi
+rm -f conftest*
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_w32" 1>&6
+echo "define(<W32>, <$gmp_cv_check_asm_w32>)" >> $gmp_tmpconfigm4
+
+  echo $ECHO_N "checking if symbols are prefixed by underscore... $ECHO_C" 1>&6
+echo "configure:2409: checking if symbols are prefixed by underscore" 1>&5
+if test "${gmp_cv_check_asm_underscore+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2414 "configure"
+#include "confdefs.h"
+int underscore_test() {
+return; }
+EOF
+if { (eval echo configure:2419: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  if grep _underscore_test conftest* >/dev/null; then
+    gmp_cv_check_asm_underscore=yes
+  else
+    gmp_cv_check_asm_underscore=no
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_underscore" 1>&6
+if test "$gmp_cv_check_asm_underscore" = "yes"; then
+
+echo 'define(<GSYM_PREFIX>, <_>)' >> $gmp_tmpconfigm4
+
+  underscore=yes
+else
+
+echo 'define(<GSYM_PREFIX>, <>)' >> $gmp_tmpconfigm4
+
+  underscore=no
+fi
+
+echo $ECHO_N "checking if .align assembly directive is logarithmic... $ECHO_C" 1>&6
+echo "configure:2446: checking if .align assembly directive is logarithmic" 1>&5
+if test "${gmp_cv_check_asm_align_log+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -z "$NM"; then
+  echo; echo "configure: GMP_CHECK_ASM_ALIGN_LOG: fatal: need nm"
+  exit 1
+fi
+cat > conftest.s <<EOF
+      	$gmp_cv_check_asm_data
+      	.align  4
+	$gmp_cv_check_asm_globl	foo
+	.byte	1
+	.align	4
+foo$gmp_cv_check_asm_label_suffix
+	.byte	2
+EOF
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
+if { (eval echo configure:2464: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
+
+  gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
+       -e 's;[^1-9]*\([0-9]*\).*;\1;'`
+    if test "$gmp_tmp_val" = "10" || test "$gmp_tmp_val" = "16"; then
+    gmp_cv_check_asm_align_log=yes
+  else
+    gmp_cv_check_asm_align_log=no
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.s >&5
+fi
+rm -f conftest*
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_align_log" 1>&6
+
+echo "define(<ALIGN_LOGARITHMIC>,<$gmp_cv_check_asm_align_log>)" >> $gmp_tmpconfigm4
+
+if test "$gmp_cv_check_asm_align_log" = "yes"; then
+  asm_align=log
+else
+  asm_align=nolog
+fi
+
+fi
+
+family=generic
+
+case ${target} in
+  arm*-*-*)
+    path="arm"
+    ;;
+  sparcv9*-*-solaris2.[789]* | sparc64*-*-solaris2.[789]* | ultrasparc*-*-solaris2.[789]*)
+    if test -n "$CC64"; then
+      path="sparc64"
+    else
+      path="sparc32/v9 sparc32/v8 sparc32"
+    fi
+    ;;
+  sparc64-*-linux*)
+    path="sparc64"
+    ;;
+  sparcv8*-*-* | microsparc*-*-*)
+	path="sparc32/v8 sparc32"
+	if test x${floating_point} = xno
+	  then extra_functions="udiv_nfp"
+	  else extra_functions="udiv_fp"
+	fi
+	;;
+  sparcv9*-*-* | ultrasparc*-*-*)
+	path="sparc32/v9 sparc32/v8 sparc32"
+	extra_functions="udiv_fp"
+	;;
+  supersparc*-*-*)
+	path="sparc32/v8/supersparc sparc32/v8 sparc32"
+	extra_functions="udiv"
+	;;
+  sparc*-*-*) path="sparc32"
+	if test x${floating_point} = xno
+	  then extra_functions="udiv_nfp"
+	  else extra_functions="udiv_fp"
+	fi
+	;;
+  hppa7000*-*-*)
+    path="hppa/hppa1_1 hppa"
+    extra_functions="udiv_qrnnd"
+    ;;
+  hppa1.0*-*-*)
+    path="hppa"
+    extra_functions="udiv_qrnnd"
+    ;;
+  hppa2.0w-*-*)
+    path="pa64w"
+    extra_functions="umul_ppmm udiv_qrnnd"
+    ;;
+  hppa2.0*-*-*)
+    if test -n "$CC64"; then
+      path="pa64"
+      extra_functions="umul_ppmm udiv_qrnnd"
+      # We need to use the system compiler, or actually the system assembler,
+      # since GAS has not been ported to understand the 2.0 instructions.
+      CCAS="$CC64 -c"
+    else
+      # FIXME: path should be "hppa/hppa2_0 hppa/hppa1_1 hppa"
+      path="hppa/hppa1_1 hppa"
+      extra_functions="udiv_qrnnd"
+    fi
+    ;;
+  hppa*-*-*)					#assume pa7100
+    path="hppa/hppa1_1/pa7100 hppa/hppa1_1 hppa"
+    extra_functions="udiv_qrnnd";;
+  f30[01]-fujitsu-sysv*)
+    path=fujitsu;;
+  alphaev6*-*-*) path="alpha/ev6 alpha"; extra_functions="invert_limb cntlz";;
+  alphaev5*-*-*) path="alpha/ev5 alpha"; extra_functions="invert_limb cntlz";;
+  alpha*-*-*) path="alpha"; extra_functions="invert_limb cntlz";;
+  # Cray vector machines.  This must come after alpha* so that we can
+  # recognize present and future vector processors with a wildcard.
+  *-cray-unicos*)
+    path="cray"
+    extra_functions="mulww";;
+  am29000*-*-*) path="a29k";;
+  a29k*-*-*) path="a29k";;
+
+  # AMD and Intel x86 configurations
+
+  i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*)
+    gmp_m4postinc="x86/x86-defs.m4"
+    extra_functions="udiv umul"
+    CALLING_CONVENTIONS_OBJS="x86call.o x86check.o"
+
+echo $ECHO_N "checking if the assembler takes cl with shldl... $ECHO_C" 1>&6
+echo "configure:2578: checking if the assembler takes cl with shldl" 1>&5
+if test "${gmp_cv_check_asm_shldl_cl+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat > conftest.s <<EOF
+	$gmp_cv_check_asm_text
+	shldl	%cl, %eax, %ebx
+EOF
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
+if { (eval echo configure:2587: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
+  gmp_cv_check_asm_shldl_cl=yes
+else
+  gmp_cv_check_asm_shldl_cl=no
+fi
+rm -f conftest*
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_shldl_cl" 1>&6
+if test "$gmp_cv_check_asm_shldl_cl" = "yes"; then
+
+echo 'define(<WANT_SHLDL_CL>, <1>)' >> $gmp_tmpconfigm4
+
+else
+
+echo 'define(<WANT_SHLDL_CL>, <0>)' >> $gmp_tmpconfigm4
+
+fi
+
+    echo $ECHO_N "checking if the .align directive accepts an 0x90 fill in .text... $ECHO_C" 1>&6
+echo "configure:2607: checking if the .align directive accepts an 0x90 fill in .text" 1>&5
+if test "${gmp_cv_check_asm_align_fill_0x90+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+
+cat > conftest.s <<EOF
+      	$gmp_cv_check_asm_text
+      	.align  4, 0x90
+	.byte   0
+      	.align  4, 0x90
+EOF
+gmp_tmp_val="`$CCAS $CFLAGS conftest.s 2>&1`"
+if test $? = 0; then
+  echo "$gmp_tmp_val" 1>&5
+  if echo "$gmp_tmp_val" | grep "Warning: Fill parameter ignored for executable section"; then
+    echo "Supressing this warning by omitting 0x90" 1>&5
+    gmp_cv_check_asm_align_fill_0x90=no
+  else
+    gmp_cv_check_asm_align_fill_0x90=yes
+  fi
+else
+  echo "Non-zero exit code" 1>&5
+  echo "$gmp_tmp_val" 1>&5
+  gmp_cv_check_asm_align_fill_0x90=no
+fi
+rm -f conftest*
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_align_fill_0x90" 1>&6
+
+echo "define(<ALIGN_FILL_0x90>,<$gmp_cv_check_asm_align_fill_0x90>)" >> $gmp_tmpconfigm4
+
+    # the CPUs below wanting to know about mmx
+    case ${target} in
+      pentiummmx-*-* | pentium[23]-*-* | k6*-*-* | athlon-*-*)
+
+echo $ECHO_N "checking if the assembler knows about MMX instructions... $ECHO_C" 1>&6
+echo "configure:2644: checking if the assembler knows about MMX instructions" 1>&5
+if test "${gmp_cv_check_asm_mmx+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat > conftest.s <<EOF
+	$gmp_cv_check_asm_text
+	por	%mm0, %mm0
+EOF
+ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
+if { (eval echo configure:2653: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
+  gmp_cv_check_asm_mmx=yes
+else
+  gmp_cv_check_asm_mmx=no
+fi
+rm -f conftest*
+
+fi
+echo "$ECHO_T""$gmp_cv_check_asm_mmx" 1>&6
+if test "$gmp_cv_check_asm_mmx" = "yes"; then
+  tmp_mmx=yes
+else
+  echo "configure: warning: +----------------------------------------------------------" 1>&2
+  echo "configure: warning: | WARNING WARNING WARNING" 1>&2
+  echo "configure: warning: | Target CPU has MMX code, but it can't be assembled by" 1>&2
+  echo "configure: warning: |     $CCAS $CFLAGS" 1>&2
+  echo "configure: warning: | Non-MMX replacements will be used." 1>&2
+  echo "configure: warning: | This will be an inferior build." 1>&2
+  echo "configure: warning: +----------------------------------------------------------" 1>&2
+  tmp_mmx=no
+fi
+
+        ;;
+    esac
+
+    # default for anything not otherwise mentioned
+    path="x86"
+
+    case ${target} in
+      i[34]86*-*-*)
+        path="x86"
+        ;;
+      k5*-*-*)
+        # don't know what best suits k5
+        path="x86"
+        ;;
+      i586*-*-* | pentium-*-*)
+	path="x86/pentium x86"
+        ;;
+      pentiummmx-*-*)
+	path="x86/pentium x86"
+	if test "$tmp_mmx" = yes; then
+          path="x86/pentium/mmx $path"
+        fi
+        ;;
+      i686*-*-* | pentiumpro-*-*)
+	path="x86/p6 x86"
+        ;;
+      pentium2-*-*)
+	path="x86/p6 x86"
+	# The pentium/mmx lshift and rshift are good on p6 and can be used
+        # until there's something specific for p6.
+	if test "$tmp_mmx" = yes; then
+          path="x86/p6/mmx x86/pentium/mmx $path"
+        fi
+        ;;
+      pentium3-*-*)
+	path="x86/p6 x86"
+	# The pentium/mmx lshift and rshift are good on p6 and can be used
+        # until there's something specific for p6.
+	if test "$tmp_mmx" = yes; then
+          path="x86/p6/p3mmx x86/p6/mmx x86/pentium/mmx $path"
+        fi
+        ;;
+      k6[23]*-*-*)
+	path="x86/k6 x86"
+	if test "$tmp_mmx" = yes; then
+          path="x86/k6/k62mmx x86/k6/mmx $path"
+        fi
+        ;;
+      k6*-*-*)
+	path="x86/k6 x86"
+	if test "$tmp_mmx" = yes; then
+          path="x86/k6/mmx $path"
+        fi
+        ;;
+      athlon-*-*)
+	path="x86/k7 x86"
+	if test "$tmp_mmx" = yes; then
+          path="x86/k7/mmx $path"
+        fi
+        ;;
+    esac
+    ;;
+
+  i960*-*-*) path="i960";;
+
+  ia64*-*-*) path="ia64";;
+
+# Motorola 68k configurations.  Let m68k mean 68020-68040.
+  m680[234]0*-*-* | m68k*-*-* | \
+  m68*-next-nextstep*)		# Nexts are at least '020
+    path="m68k/mc68020 m68k"
+    family=m68k
+    ;;
+  m68000*-*-*)
+    path="m68k"
+    family=m68k
+    ;;
+
+  m88k*-*-* | m88k*-*-*) path="m88k";;
+  m88110*-*-*) path="m88k/mc88110 m88k";;
+  ns32k*-*-*) path="ns32k";;
+
+  pyramid-*-*) path="pyr";;
+
+  ppc601-*-*) path="power powerpc32";;
+  powerpc64*-*-*) path="powerpc64";;
+  powerpc*-*-*) path="powerpc32";;
+  rs6000-*-* | power-*-* | power2-*-*)
+    path="power"
+    extra_functions="udiv_w_sdiv"
+    ;;
+
+  sh-*-*) path="sh";;
+  sh2-*-*) path="sh/sh2 sh";;
+
+  mips[34]*-*-*) path="mips3";;
+  mips*-*-irix6*) path="mips3";;
+  mips*-*-*) path="mips2";;
+
+  vax*-*-*) path="vax"; extra_functions="udiv_w_sdiv";;
+
+  z8000x*-*-*) path="z8000x"; extra_functions="udiv_w_sdiv";;
+  z8000*-*-*) path="z8000"; extra_functions="udiv_w_sdiv";;
+
+  clipper*-*-*) path="clipper";;
+esac
+
+if test -n "$CALLING_CONVENTIONS_OBJS"; then
+  cat >>confdefs.h <<\EOF
+#define HAVE_CALLING_CONVENTIONS 1
+EOF
+
+fi
+
+case ${target} in
+  i[5-8]86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*)
+    # rdtsc is in pentium and up, not in i386 and i486
+    SPEED_CYCLECOUNTER_OBJS=pentium.lo
+    ;;
+  alpha*-*-*)
+    SPEED_CYCLECOUNTER_OBJS=alpha.lo
+    ;;
+  sparcv9*-*-* | ultrasparc*-*-* | sparc64*-*-*)
+    SPEED_CYCLECOUNTER_OBJS=sparcv9.lo
+    ;;
+  hppa2*-*-*)
+    SPEED_CYCLECOUNTER_OBJS=hppa2.lo
+    ;;
+  hppa*-*-*)
+    SPEED_CYCLECOUNTER_OBJS=hppa.lo
+    ;;
+esac
+
+if test -n "$SPEED_CYCLECOUNTER_OBJS"
+then
+  cat >>confdefs.h <<\EOF
+#define HAVE_SPEED_CYCLECOUNTER 1
+EOF
+
+fi
+
+echo $ECHO_N "checking for Cygwin environment... $ECHO_C" 1>&6
+echo "configure:2817: checking for Cygwin environment" 1>&5
+if test "${ac_cv_cygwin+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat >conftest.$ac_ext <<EOF
+#line 2822 "configure"
+#include "confdefs.h"
+
+int
+main ()
+{
+#ifndef __CYGWIN__
+# define __CYGWIN__ __CYGWIN32__
+#endif
+return __CYGWIN__;
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:2836: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_cygwin=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_cygwin=no
+fi
+rm -f conftest*
+fi
+echo "$ECHO_T""$ac_cv_cygwin" 1>&6
+CYGWIN=
+test "$ac_cv_cygwin" = yes && CYGWIN=yes
+echo $ECHO_N "checking for mingw32 environment... $ECHO_C" 1>&6
+echo "configure:2851: checking for mingw32 environment" 1>&5
+if test "${ac_cv_mingw32+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat >conftest.$ac_ext <<EOF
+#line 2856 "configure"
+#include "confdefs.h"
+
+int
+main ()
+{
+return __MINGW32__;
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:2867: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_mingw32=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_mingw32=no
+fi
+rm -f conftest*
+fi
+echo "$ECHO_T""$ac_cv_mingw32" 1>&6
+MINGW32=
+test "$ac_cv_mingw32" = yes && MINGW32=yes
+echo $ECHO_N "checking for EMX OS/2 environment... $ECHO_C" 1>&6
+echo "configure:2882: checking for EMX OS/2 environment" 1>&5
+if test "${ac_cv_emxos2+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat >conftest.$ac_ext <<EOF
+#line 2887 "configure"
+#include "confdefs.h"
+
+int
+main ()
+{
+return __EMX__;
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:2898: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_emxos2=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_emxos2=no
+fi
+rm -f conftest*
+fi
+echo "$ECHO_T""$ac_cv_emxos2" 1>&6
+EMXOS2=
+test "$ac_cv_emxos2" = yes && EMXOS2=yes
+
+echo $ECHO_N "checking for executable suffix... $ECHO_C" 1>&6
+echo "configure:2914: checking for executable suffix" 1>&5
+if test "${ac_cv_exeext+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test "$CYGWIN" = yes || test "$MINGW32" = yes || test "$EMXOS2" = yes; then
+  ac_cv_exeext=.exe
+else
+  rm -f conftest*
+  echo 'int main () { return 0; }' >conftest.$ac_ext
+  ac_cv_exeext=
+  if { (eval echo configure:2924: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+    for ac_file in conftest.*; do
+      case $ac_file in
+      *.c | *.C | *.o | *.obj | *.xcoff) ;;
+      *) ac_cv_exeext=`echo $ac_file | sed -e s/conftest//` ;;
+      esac
+    done
+  else
+    { echo "configure: error: installation or configuration problem: compiler cannot create executables." 1>&2; exit 1; }
+  fi
+  rm -f conftest*
+  test x"${ac_cv_exeext}" = x && ac_cv_exeext=no
+fi
+fi
+
+EXEEXT=""
+test x"${ac_cv_exeext}" != xno && EXEEXT=${ac_cv_exeext}
+echo "$ECHO_T""${ac_cv_exeext}" 1>&6
+ac_exeext=$EXEEXT
+
+echo $ECHO_N "checking for object suffix... $ECHO_C" 1>&6
+echo "configure:2945: checking for object suffix" 1>&5
+if test "${ac_cv_objext+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  rm -f conftest*
+echo 'int i = 1;' >conftest.$ac_ext
+if { (eval echo configure:2951: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  for ac_file in conftest.*; do
+    case $ac_file in
+    *.c) ;;
+    *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
+    esac
+  done
+else
+  { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
+fi
+rm -f conftest*
+fi
+
+echo "$ECHO_T""$ac_cv_objext" 1>&6
+OBJEXT=$ac_cv_objext
+ac_objext=$ac_cv_objext
+
+case "$target" in
+  *-*-aix4.[3-9]*) enable_shared=no ;;
+esac
+# 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=no
+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
+# Check whether --enable-fast-install or --disable-fast-install was given.
+if test "${enable_fast_install+set}" = set; then
+  enableval="$enable_fast_install"
+  p=${PACKAGE-default}
+case "$enableval" in
+yes) enable_fast_install=yes ;;
+no) enable_fast_install=no ;;
+*)
+  enable_fast_install=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_fast_install=yes
+    fi
+  done
+  IFS="$ac_save_ifs"
+  ;;
+esac
+else
+  enable_fast_install=yes
+fi
+
+echo $ECHO_N "checking build system type... $ECHO_C" 1>&6
+echo "configure:3039: checking build system type" 1>&5
+if test "x$ac_cv_build" = "x" || (test "x$build" != "xNONE" && test "x$build" != "x$ac_cv_build_alias"); then
+
+  # Make sure we can run config.sub.
+  if $ac_config_sub sun4 >/dev/null 2>&1; then :; else
+    { echo "configure: error: cannot run $ac_config_sub" 1>&2; exit 1; }
+  fi
+
+  ac_cv_build_alias=$build
+  case "$ac_cv_build_alias" in
+  NONE)
+    case $nonopt in
+    NONE)
+      ac_cv_build_alias=$host_alias ;;
+    *) ac_cv_build_alias=$nonopt ;;
+    esac ;;
+  esac
+
+  ac_cv_build=`$ac_config_sub $ac_cv_build_alias` || exit 1
+  ac_cv_build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+  ac_cv_build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+  ac_cv_build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+else
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+fi
+
+echo "$ECHO_T""$ac_cv_build" 1>&6
+
+build=$ac_cv_build
+build_alias=$ac_cv_build_alias
+build_cpu=$ac_cv_build_cpu
+build_vendor=$ac_cv_build_vendor
+build_os=$ac_cv_build_os
+
+# 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 $ECHO_N "checking for ld used by GCC... $ECHO_C" 1>&6
+echo "configure:3085: checking for ld used by GCC" 1>&5
+  case $lt_target in
+  *-*-mingw*)
+    # gcc leaves a trailing carriage return which upsets mingw
+    ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+  *)
+    ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+  esac
+  case "$ac_prog" in
+    # Accept absolute paths.
+    [\\/]* | [A-Za-z]:[\\/]*)
+      re_direlt='/[^/][^/]*/\.\./'
+      # Canonicalize the path of ld
+      ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
+      while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
+	ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
+      done
+      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 $ECHO_N "checking for GNU ld... $ECHO_C" 1>&6
+echo "configure:3115: checking for GNU ld" 1>&5
+else
+  echo $ECHO_N "checking for non-GNU ld... $ECHO_C" 1>&6
+echo "configure:3118: checking for non-GNU ld" 1>&5
+fi
+if test "${ac_cv_path_LD+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -z "$LD"; then
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; 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 "$ECHO_T""$LD" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+test -z "$LD" && { echo "configure: error: no acceptable ld found in \$PATH" 1>&2; exit 1; }
+echo $ECHO_N "checking if the linker ($LD) is GNU ld... $ECHO_C" 1>&6
+echo "configure:3153: checking if the linker ($LD) is GNU ld" 1>&5
+if test "${ac_cv_prog_gnu_ld+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_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 "$ECHO_T""$ac_cv_prog_gnu_ld" 1>&6
+with_gnu_ld=$ac_cv_prog_gnu_ld
+
+echo $ECHO_N "checking for $LD option to reload object files... $ECHO_C" 1>&6
+echo "configure:3168: checking for $LD option to reload object files" 1>&5
+if test "${lt_cv_ld_reload_flag+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  lt_cv_ld_reload_flag='-r'
+fi
+echo "$ECHO_T""$lt_cv_ld_reload_flag" 1>&6
+reload_flag=$lt_cv_ld_reload_flag
+test -n "$reload_flag" && reload_flag=" $reload_flag"
+
+echo $ECHO_N "checking how to recognise dependant libraries... $ECHO_C" 1>&6
+echo "configure:3179: checking how to recognise dependant libraries" 1>&5
+if test "${lt_cv_deplibs_check_method+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  lt_cv_file_magic_cmd='${MAGIC}'
+lt_cv_file_magic_test_file=
+lt_cv_deplibs_check_method='unknown'
+# Need to set the preceding variable on all platforms that support
+# interlibrary dependencies.
+# 'none' -- dependencies not supported.
+# `unknown' -- same as none, but documents that we really don't know.
+# 'pass_all' -- all dependencies passed with no checks.
+# 'test_compile' -- check by making test program.
+# 'file_magic [regex]' -- check by looking for files in library path
+# which responds to the $file_magic_cmd with a given egrep regex.
+# If you have `file' or equivalent on your system and you're not sure
+# whether `pass_all' will *always* work, you probably want this one.
+
+case "$host_os" in
+aix4* | beos*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+bsdi4*)
+    lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)'
+    lt_cv_file_magic_test_file=/shlib/libc.so
+  ;;
+
+cygwin* | mingw*)
+  lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?'
+  lt_cv_file_magic_cmd='${OBJDUMP} -f'
+  ;;
+
+freebsd*)
+  case "$version_type" in
+  freebsd-elf*)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  esac
+  ;;
+
+gnu*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+irix5* | irix6*)
+  case "$host_os" in
+  irix5*)
+    # this will be overridden with pass_all, but let us keep it just in case
+    lt_cv_deplibs_check_method="file_magic ELF 32-bit MSB dynamic lib MIPS - version 1"
+    ;;
+  *)
+    case "$LD" in
+    *-32|*"-32 ") libmagic=32-bit;;
+    *-n32|*"-n32 ") libmagic=N32;;
+    *-64|*"-64 ") libmagic=64-bit;;
+    *) libmagic=never-match;;
+    esac
+    # this will be overridden with pass_all, but let us keep it just in case
+        lt_cv_deplibs_check_method="file_magic ELF ${libmagic} MSB mips-[1234] dynamic lib MIPS - version 1"
+        ;;
+  esac
+  lt_cv_file_magic_test_file=`echo /lib${libsuff}/libc.so*`
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+# This must be Linux ELF.
+linux-gnu*)
+  case "$host_cpu" in
+  alpha* | i*86 | powerpc* | sparc* )
+    lt_cv_deplibs_check_method=pass_all ;;
+  *)
+    # glibc up to 2.1.1 does not perform some relocations on ARM
+        lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' ;;
+      esac
+  lt_cv_file_magic_test_file=`echo /lib/libc.so* /lib/libc-*.so`
+  ;;
+
+osf3* | osf4* | osf5*)
+  # this will be overridden with pass_all, but let us keep it just in case
+  lt_cv_deplibs_check_method='file_magic COFF format alpha shared library'
+  lt_cv_file_magic_test_file=/shlib/libc.so
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+sco3.2v5*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+solaris*)
+  lt_cv_deplibs_check_method=pass_all
+  lt_cv_file_magic_test_file=/lib/libc.so
+  ;;
+
+sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+  case "$host_vendor" in
+  ncr)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  motorola)
+        lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]'
+        lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
+    ;;
+  esac
+  ;;
+esac
+
+fi
+echo "$ECHO_T""$lt_cv_deplibs_check_method" 1>&6
+file_magic_cmd=$lt_cv_file_magic_cmd
+deplibs_check_method=$lt_cv_deplibs_check_method
+
+if test $host != $build; then
+  ac_tool_prefix=${host_alias}-
+else
+  ac_tool_prefix=
+fi
+
+# Only perform the check for file, if the check method requires it
+case "$deplibs_check_method" in
+file_magic*)
+  if test "$file_magic_cmd" = '${MAGIC}'; then
+
+echo $ECHO_N "checking for ${ac_tool_prefix}file... $ECHO_C" 1>&6
+echo "configure:3303: checking for ${ac_tool_prefix}file" 1>&5
+if test "${lt_cv_path_MAGIC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  case "$MAGIC" in
+  /*)
+  lt_cv_path_MAGIC="$MAGIC" # Let the user override the test with a path.
+  ;;
+  ?:/*)
+  ac_cv_path_MAGIC="$MAGIC" # Let the user override the test with a dos path.
+  ;;
+  *)
+  ac_save_MAGIC="$MAGIC"
+  IFS="${IFS=   }"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="/usr/bin:$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/${ac_tool_prefix}file; then
+      lt_cv_path_MAGIC="$ac_dir/${ac_tool_prefix}file"
+      if test -n "$file_magic_test_file"; then
+	case "$deplibs_check_method" in
+	"file_magic "*)
+	  file_magic_regex="`expr \"$deplibs_check_method\" : \"file_magic \(.*\)\"`"
+	  MAGIC="$lt_cv_path_MAGIC"
+	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+	    egrep "$file_magic_regex" > /dev/null; then
+	    :
+	  else
+	    cat <<EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such.  This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem.  Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+EOF
+	  fi ;;
+	esac
+      fi
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  MAGIC="$ac_save_MAGIC"
+  ;;
+esac
+fi
+
+MAGIC="$lt_cv_path_MAGIC"
+if test -n "$MAGIC"; then
+  echo "$ECHO_T""$MAGIC" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+if test -z "$lt_cv_path_MAGIC"; then
+  if test -n "$ac_tool_prefix"; then
+    echo $ECHO_N "checking for file... $ECHO_C" 1>&6
+echo "configure:3365: checking for file" 1>&5
+if test "${lt_cv_path_MAGIC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  case "$MAGIC" in
+  /*)
+  lt_cv_path_MAGIC="$MAGIC" # Let the user override the test with a path.
+  ;;
+  ?:/*)
+  ac_cv_path_MAGIC="$MAGIC" # Let the user override the test with a dos path.
+  ;;
+  *)
+  ac_save_MAGIC="$MAGIC"
+  IFS="${IFS=   }"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="/usr/bin:$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/file; then
+      lt_cv_path_MAGIC="$ac_dir/file"
+      if test -n "$file_magic_test_file"; then
+	case "$deplibs_check_method" in
+	"file_magic "*)
+	  file_magic_regex="`expr \"$deplibs_check_method\" : \"file_magic \(.*\)\"`"
+	  MAGIC="$lt_cv_path_MAGIC"
+	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+	    egrep "$file_magic_regex" > /dev/null; then
+	    :
+	  else
+	    cat <<EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such.  This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem.  Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+EOF
+	  fi ;;
+	esac
+      fi
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  MAGIC="$ac_save_MAGIC"
+  ;;
+esac
+fi
+
+MAGIC="$lt_cv_path_MAGIC"
+if test -n "$MAGIC"; then
+  echo "$ECHO_T""$MAGIC" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+  else
+    MAGIC=:
+  fi
+fi
+
+  fi
+  ;;
+esac
+
+case "$target" in
+NONE) lt_target="$host" ;;
+*) lt_target="$target" ;;
+esac
+
+# Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
+echo "configure:3441: checking for $ac_word" 1>&5
+if test "${ac_cv_prog_RANLIB+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+ac_dummy="$PATH"
+for ac_dir in $ac_dummy; do
+  test -z "$ac_dir" && ac_dir=.
+  if test -f $ac_dir/$ac_word; then
+    echo "$ac_dir/$ac_word"
+  fi
+done
+IFS="$ac_save_ifs"
+`; do
+    ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+    break
+  done
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+  echo "$ECHO_T""$RANLIB" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+if test -z "$ac_cv_prog_RANLIB"; then
+  if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
+echo "configure:3475: checking for $ac_word" 1>&5
+if test "${ac_cv_prog_RANLIB+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+ac_dummy="$PATH"
+for ac_dir in $ac_dummy; do
+  test -z "$ac_dir" && ac_dir=.
+  if test -f $ac_dir/$ac_word; then
+    echo "$ac_dir/$ac_word"
+  fi
+done
+IFS="$ac_save_ifs"
+`; do
+    ac_cv_prog_RANLIB="ranlib"
+    break
+  done
+  test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+  echo "$ECHO_T""$RANLIB" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+  else
+    RANLIB=":"
+  fi
+fi
+
+# Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args.
+set dummy ${ac_tool_prefix}strip; ac_word=$2
+echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
+echo "configure:3513: checking for $ac_word" 1>&5
+if test "${ac_cv_prog_STRIP+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$STRIP"; then
+  ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
+else
+  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+ac_dummy="$PATH"
+for ac_dir in $ac_dummy; do
+  test -z "$ac_dir" && ac_dir=.
+  if test -f $ac_dir/$ac_word; then
+    echo "$ac_dir/$ac_word"
+  fi
+done
+IFS="$ac_save_ifs"
+`; do
+    ac_cv_prog_STRIP="${ac_tool_prefix}strip"
+    break
+  done
+fi
+fi
+STRIP="$ac_cv_prog_STRIP"
+if test -n "$STRIP"; then
+  echo "$ECHO_T""$STRIP" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+if test -z "$ac_cv_prog_STRIP"; then
+  if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "strip", so it can be a program name with args.
+set dummy strip; ac_word=$2
+echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
+echo "configure:3547: checking for $ac_word" 1>&5
+if test "${ac_cv_prog_STRIP+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  if test -n "$STRIP"; then
+  ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
+else
+  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+ac_dummy="$PATH"
+for ac_dir in $ac_dummy; do
+  test -z "$ac_dir" && ac_dir=.
+  if test -f $ac_dir/$ac_word; then
+    echo "$ac_dir/$ac_word"
+  fi
+done
+IFS="$ac_save_ifs"
+`; do
+    ac_cv_prog_STRIP="strip"
+    break
+  done
+  test -z "$ac_cv_prog_STRIP" && ac_cv_prog_STRIP=":"
+fi
+fi
+STRIP="$ac_cv_prog_STRIP"
+if test -n "$STRIP"; then
+  echo "$ECHO_T""$STRIP" 1>&6
+else
+  echo "$ECHO_T""no" 1>&6
+fi
+
+  else
+    STRIP=":"
+  fi
+fi
+
+# Check for any special flags to pass to ltconfig.
+libtool_flags="--cache-file=$cache_file"
+test "$enable_shared" = no && libtool_flags="$libtool_flags --disable-shared"
+test "$enable_static" = no && libtool_flags="$libtool_flags --disable-static"
+test "$enable_fast_install" = no && libtool_flags="$libtool_flags --disable-fast-install"
+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"
+
+# Check whether --enable-libtool-lock or --disable-libtool-lock was given.
+if test "${enable_libtool_lock+set}" = set; then
+  enableval="$enable_libtool_lock"
+
+fi
+test "x$enable_libtool_lock" = xno && libtool_flags="$libtool_flags --disable-lock"
+test x"$silent" = xyes && libtool_flags="$libtool_flags --silent"
+
+# Check whether --with-pic or --without-pic was given.
+if test "${with_pic+set}" = set; then
+  withval="$with_pic"
+  pic_mode="$withval"
+else
+  pic_mode=default
+fi
+test x"$pic_mode" = xyes && libtool_flags="$libtool_flags --prefer-pic"
+test x"$pic_mode" = xno && libtool_flags="$libtool_flags --prefer-non-pic"
+
+# Some flags need to be propagated to the compiler or linker for good
+# libtool support.
+case "$lt_target" in
+*-*-irix6*)
+  # Find out which ABI we are using.
+  echo '#line 3613 "configure"' > conftest.$ac_ext
+  if { (eval echo configure:3614: \"$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.
+  SAVE_CFLAGS="$CFLAGS"
+  CFLAGS="$CFLAGS -belf"
+  echo $ECHO_N "checking whether the C compiler needs -belf... $ECHO_C" 1>&6
+echo "configure:3635: checking whether the C compiler needs -belf" 1>&5
+if test "${lt_cv_cc_needs_belf+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+
+     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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+     cat >conftest.$ac_ext <<EOF
+#line 3648 "configure"
+#include "confdefs.h"
+
+int
+main()
+{
+
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:3659: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  lt_cv_cc_needs_belf=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  lt_cv_cc_needs_belf=no
+fi
+rm -f conftest*
+
+     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${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+fi
+echo "$ECHO_T""$lt_cv_cc_needs_belf" 1>&6
+  if test x"$lt_cv_cc_needs_belf" != x"yes"; then
+    # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
+    CFLAGS="$SAVE_CFLAGS"
+  fi
+  ;;
+
+esac
+
+# Save cache, so that ltconfig can load it
+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 | grep ac_space) 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
+
+# Actually configure libtool.  ac_aux_dir is where install-sh is found.
+AR="$AR" CC="$CC" CFLAGS="$CFLAGS" CPPFLAGS="$CPPFLAGS" \
+MAGIC="$MAGIC" LD="$LD" LDFLAGS="$LDFLAGS" LIBS="$LIBS" \
+LN_S="$LN_S" NM="$NM" RANLIB="$RANLIB" STRIP="$STRIP" \
+AS="$AS" DLLTOOL="$DLLTOOL" OBJDUMP="$OBJDUMP" \
+objext="$OBJEXT" exeext="$EXEEXT" reload_flag="$reload_flag" \
+deplibs_check_method="$deplibs_check_method" file_magic_cmd="$file_magic_cmd" \
+${CONFIG_SHELL-/bin/sh} $ac_aux_dir/ltconfig --no-reexec \
+$libtool_flags --no-verify --build="$build" $ac_aux_dir/ltmain.sh $lt_target \
+|| { echo "configure: error: libtool configure failed" 1>&2; exit 1; }
+
+# Reload cache, that may have been modified by ltconfig
+if test -r "$cache_file"; then
+  echo "loading cache $cache_file"
+      test -f "$cache_file" && . $cache_file
+else
+  echo "creating cache $cache_file"
+  >$cache_file
+fi
+
+# This can be used to rebuild libtool when needed
+LIBTOOL_DEPS="$ac_aux_dir/ltconfig $ac_aux_dir/ltmain.sh"
+
+# Always use our own libtool.
+LIBTOOL='$(SHELL) $(top_builddir)/libtool'
+
+# Redirect the config.log output again, so that the ltconfig log is not
+# clobbered by the next message.
+exec 5>>./config.log
+
+echo $ECHO_N "checking whether optarg is declared... $ECHO_C" 1>&6
+echo "configure:3764: checking whether optarg is declared" 1>&5
+if test "${ac_cv_have_decl_optarg+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat >conftest.$ac_ext <<EOF
+#line 3769 "configure"
+#include "confdefs.h"
+$ac_includes_default
+int
+main ()
+{
+#ifndef optarg
+  char *p = (char *) optarg;
+#endif
+
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:3783: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_have_decl_optarg=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_have_decl_optarg=no
+fi
+rm -f conftest*
+fi
+echo "$ECHO_T""$ac_cv_have_decl_optarg" 1>&6
+if test $ac_cv_have_decl_optarg = yes; then
+  cat >>confdefs.h <<EOF
+#define HAVE_DECL_OPTARG 1
+EOF
+
+else
+  cat >>confdefs.h <<EOF
+#define HAVE_DECL_OPTARG 0
+EOF
+
+fi
+
+echo $ECHO_N "checking for ANSI C header files... $ECHO_C" 1>&6
+echo "configure:3808: checking for ANSI C header files" 1>&5
+if test "${ac_cv_header_stdc+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+
+cat >conftest.$ac_ext <<EOF
+#line 3814 "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:3823: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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 3841 "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 3861 "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 3883 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) (('a' <= (c) && (c) <= 'i') \
+                     || ('j' <= (c) && (c) <= 'r') \
+                     || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#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:3908: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./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 "$ECHO_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
+
+for ac_header in getopt.h unistd.h sys/sysctl.h sys/time.h
+do
+ac_ac_Header=`echo "ac_cv_header_$ac_header" | $ac_tr_sh`
+echo $ECHO_N "checking for $ac_header... $ECHO_C" 1>&6
+echo "configure:3935: checking for $ac_header" 1>&5
+if eval "test \"\${$ac_ac_Header+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+
+cat >conftest.$ac_ext <<EOF
+#line 3941 "configure"
+#include "confdefs.h"
+#include <$ac_header>
+
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:3947: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "$ac_ac_Header=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "$ac_ac_Header=no"
+fi
+rm -f conftest*
+fi
+echo "$ECHO_T""`eval echo '${'$ac_ac_Header'}'`" 1>&6
+if test `eval echo '${'$ac_ac_Header'}'` = yes; then
+  cat >>confdefs.h <<EOF
+#define `echo "HAVE_$ac_header" | $ac_tr_cpp` 1
+EOF
+
+fi
+done
+
+echo $ECHO_N "checking for void... $ECHO_C" 1>&6
+echo "configure:3971: checking for void" 1>&5
+if test "${ac_cv_type_void+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat >conftest.$ac_ext <<EOF
+#line 3976 "configure"
+#include "confdefs.h"
+$ac_includes_default
+int
+main ()
+{
+if ((void *) 0)
+  return 0;
+if (sizeof (void))
+  return 0;
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:3990: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_type_void=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_type_void=no
+fi
+rm -f conftest*
+fi
+echo "$ECHO_T""$ac_cv_type_void" 1>&6
+if test $ac_cv_type_void = yes; then
+  cat >>confdefs.h <<EOF
+#define HAVE_VOID 1
+EOF
+
+fi
+
+echo $ECHO_N "checking for preprocessor stringizing operator... $ECHO_C" 1>&6
+echo "configure:4010: checking for preprocessor stringizing operator" 1>&5
+if test "${ac_cv_c_stringize+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+
+cat >conftest.$ac_ext <<EOF
+#line 4016 "configure"
+#include "confdefs.h"
+
+#define x(y) #y
+
+char *s = x(teststring);
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "#teststring" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_c_stringize=no
+else
+  rm -rf conftest*
+  ac_cv_c_stringize=yes
+fi
+rm -f conftest*
+
+fi
+
+if test "${ac_cv_c_stringize}" = yes; then
+  cat >>confdefs.h <<\EOF
+#define HAVE_STRINGIZE 1
+EOF
+
+fi
+echo "$ECHO_T""${ac_cv_c_stringize}" 1>&6
+
+for ac_func in getopt_long getpagesize popen processor_info strtoul sysconf sysctlbyname
+do
+ac_ac_var=`echo "ac_cv_func_$ac_func" | $ac_tr_sh`
+echo $ECHO_N "checking for $ac_func... $ECHO_C" 1>&6
+echo "configure:4048: checking for $ac_func" 1>&5
+if eval "test \"\${$ac_ac_var+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat >conftest.$ac_ext <<EOF
+#line 4053 "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();
+char (*f)();
+
+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
+f = $ac_func;
+#endif
+
+  ;
+  return 0;
+}
+EOF
+if { (eval echo configure:4081: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "$ac_ac_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "$ac_ac_var=no"
+fi
+rm -f conftest*
+
+fi
+echo "$ECHO_T""`eval echo '${'$ac_ac_var'}'`" 1>&6
+if test `eval echo '${'$ac_ac_var'}'` = yes; then
+  cat >>confdefs.h <<EOF
+#define `echo "HAVE_$ac_func" | $ac_tr_cpp` 1
+EOF
+
+fi
+done
+
+echo $ECHO_N "checking if ansi2knr should be used... $ECHO_C" 1>&6
+echo "configure:4103: checking if ansi2knr should be used" 1>&5
+if test "${gmp_cv_c_ansi2knr+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+  cat >conftest.c <<EOF
+int main (int argc, char *argv) { return 0; }
+EOF
+if { (eval echo configure:4110: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  gmp_cv_c_ansi2knr=no
+else
+  gmp_cv_c_ansi2knr=yes
+fi
+rm -f conftest.*
+
+fi
+echo "$ECHO_T""$gmp_cv_c_ansi2knr" 1>&6
+if test $gmp_cv_c_ansi2knr = no; then
+  U= ANSI2KNR=
+else
+  U=_ ANSI2KNR=./ansi2knr
+  # Ensure some checks needed by ansi2knr itself.
+
+echo $ECHO_N "checking for ANSI C header files... $ECHO_C" 1>&6
+echo "configure:4126: checking for ANSI C header files" 1>&5
+if test "${ac_cv_header_stdc+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+
+cat >conftest.$ac_ext <<EOF
+#line 4132 "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:4141: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+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 4159 "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 4179 "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 4201 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) (('a' <= (c) && (c) <= 'i') \
+                     || ('j' <= (c) && (c) <= 'r') \
+                     || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#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:4226: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./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 "$ECHO_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
+
+  for ac_header in string.h
+do
+ac_ac_Header=`echo "ac_cv_header_$ac_header" | $ac_tr_sh`
+echo $ECHO_N "checking for $ac_header... $ECHO_C" 1>&6
+echo "configure:4253: checking for $ac_header" 1>&5
+if eval "test \"\${$ac_ac_Header+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_C" 1>&6
+else
+
+cat >conftest.$ac_ext <<EOF
+#line 4259 "configure"
+#include "confdefs.h"
+#include <$ac_header>
+
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:4265: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "$ac_ac_Header=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "$ac_ac_Header=no"
+fi
+rm -f conftest*
+fi
+echo "$ECHO_T""`eval echo '${'$ac_ac_Header'}'`" 1>&6
+if test `eval echo '${'$ac_ac_Header'}'` = yes; then
+  cat >>confdefs.h <<EOF
+#define `echo "HAVE_$ac_header" | $ac_tr_cpp` 1
+EOF
+
+fi
+done
+
+fi
+
+syntax=
+# For now, we use the old switch for setting syntax.
+# FIXME: Remove when conversion to .asm is completed.
+case "${target}" in
+  m680[234]0*-*-linuxaout* | m68k*-*-linuxaout* | \
+  m68k-next-nextstep* | \
+  m68000*-*-*)
+    syntax=mit
+    ;;
+  m680[234]0*-*-linux* | m68k*-*-linux*)
+    syntax=elf
+    ;;
+  m680[234]0*-*-* | m68k*-*-*)
+    syntax=mit
+    ;;
+esac
+
+# Now build an asm-syntax.h file for targets that include that from the
+# assembly files.
+# FIXME: Remove when conversion to .asm is completed.
+case "${family}-${underscore}-${asm_align}-${syntax}" in
+  m68k-yes-log-mit)
+    echo '#define MIT_SYNTAX' >asm-syntax.h
+    cat $srcdir/mpn/underscore.h >>asm-syntax.h
+    echo '#include "'$srcdir'/mpn/m68k/syntax.h"' >>asm-syntax.h;;
+  m68k-no-nolog-elf)
+    echo '#define ELF_SYNTAX' >asm-syntax.h
+    echo '#define C_SYMBOL_NAME(name) name' >>asm-syntax.h
+    echo '#include "'$srcdir'/mpn/m68k/syntax.h"' >>asm-syntax.h;;
+esac
+
+# The pattern here tests for an absolute path the same way as
+# _AC_OUTPUT_FILES in autoconf acgeneral.m4.
+
+echo "dnl  CONFIG_TOP_SRCDIR is a path from the mpn builddir to the top srcdir" >> $gmp_tmpconfigm4
+
+case "$srcdir" in
+[\\/]* | ?:[\\/]* )
+
+echo "define(<CONFIG_TOP_SRCDIR>,<\`$srcdir'>)" >> $gmp_tmpconfigm4
+    ;;
+*)
+
+echo "define(<CONFIG_TOP_SRCDIR>,<\`../$srcdir'>)" >> $gmp_tmpconfigm4
+ ;;
+esac
+
+echo "include(CONFIG_TOP_SRCDIR\`/mpn/asm-defs.m4')" >> $gmp_tmpconfigm4p
+
+# Must be after asm-defs.m4
+
+echo "define_not_for_expansion(\`HAVE_TARGET_CPU_$target_cpu')" >> $gmp_tmpconfigm4p
+
+case "$target" in
+  alpha*-cray-unicos*)
+    gmp_m4postinc="alpha/unicos.m4"
+    ;;
+  alpha*-*-*)
+    gmp_m4postinc="alpha/default.m4"
+    ;;
+  power*-*-*)
+    case "$target" in
+      *-*-mach* | *-*-rhapsody* | *-*-nextstep*)
+        ;;	# these use non-conventional assembly syntax.
+      powerpc64-*-aix*)
+	gmp_m4postinc="powerpc32/regmap.m4 powerpc64/aix.m4"
+        ;;
+      *-*-aix*)
+	gmp_m4postinc="powerpc32/regmap.m4 powerpc32/aix.m4"
+        ;;
+      *)
+	gmp_m4postinc="powerpc32/regmap.m4"
+	;;
+    esac
+    ;;
+esac
+
+for tmp_f in $gmp_m4postinc; do
+
+echo "include_mpn(\`$tmp_f')" >> $gmp_tmpconfigm4p
+
+done
+
+# Set up `gmp_links'.  It's a list of link:file pairs that configure will
+# process to create link -> file.
+gmp_links=
+
+# If the user specified `MPN_PATH', use that instead of the path we've
+# come up with.
+if test -z "$MPN_PATH"; then
+  path="$path generic"
+else
+  path="$MPN_PATH"
+fi
+
+# Pick the correct source files in $path and link them to mpn/.
+# $gmp_mpn_functions lists all functions we need.
+#
+# The rule is to find a file with the function name and a .asm, .S,
+# .s, or .c extension.  Certain multi-function files with special names
+# can provide some functions too.  (mpn/Makefile.am passes
+# -DOPERATION_<func> to get them to generate the right code.)
+
+# FIXME: udiv and umul aren't in $gmp_mpn_functions_optional yet since
+# there's some versions of those files which should be checked for bit
+# rot first.  Put them in $extra_functions for each target for now,
+# change to standard optionals when all are ready.
+
+# Note: The following lines defining $gmp_mpn_functions_optional
+#       and $gmp_mpn_functions are parsed by the "macos/configure"
+#       Perl script. So if you change the lines in a major way
+#       make sure to run and examine the output from
+#
+#           % (cd macos; perl configure)
+
+gmp_mpn_functions_optional="copyi copyd com_n		\
+  and_n andn_n nand_n ior_n iorn_n nior_n xor_n xnor_n"
+
+gmp_mpn_functions="${extra_functions} inlines add_n sub_n mul_1 addmul_1   \
+  submul_1 lshift rshift diveby3 divrem divrem_1 divrem_2                  \
+  mod_1 mod_1_rs pre_mod_1 dump                                            \
+  mul mul_fft mul_n mul_basecase sqr_basecase random                       \
+  random2 sqrtrem get_str set_str scan0 scan1 popcount hamdist cmp perfsqr \
+  bdivmod gcd_1 gcd gcdext tdiv_qr bz_divrem_n sb_divrem_mn jacbase        \
+  $gmp_mpn_functions_optional"
+
+# the list of all object files used by mpn/Makefile.in and the
+# top-level Makefile.in, respectively
+mpn_objects=
+mpn_objs_in_libgmp="mpn/mp_bases.lo"
+
+for tmp_fn in ${gmp_mpn_functions} ; do
+  rm -f mpn/${tmp_fn}.[Ssc] mpn/${tmp_fn}.asm
+
+  # functions that can be provided by multi-function files
+  tmp_mulfunc=
+  case $tmp_fn in
+  add_n|sub_n)       tmp_mulfunc="aors_n"    ;;
+  addmul_1|submul_1) tmp_mulfunc="aorsmul_1" ;;
+  popcount|hamdist)  tmp_mulfunc="popham"    ;;
+  and_n|andn_n|nand_n | ior_n|iorn_n|nior_n | xor_n|xnor_n)
+                     tmp_mulfunc="logops_n"  ;;
+  esac
+
+  found=no
+  for tmp_dir in $path; do
+    for tmp_base in $tmp_fn $tmp_mulfunc; do
+      for tmp_ext in asm S s c; do
+        tmp_file=$srcdir/mpn/$tmp_dir/$tmp_base.$tmp_ext
+        if test -f $tmp_file; then
+          found=yes
+
+          mpn_objects="$mpn_objects ${tmp_fn}.lo"
+          mpn_objs_in_libgmp="$mpn_objs_in_libgmp mpn/${tmp_fn}.lo"
+          gmp_links="$gmp_links mpn/$tmp_fn.$tmp_ext:mpn/$tmp_dir/$tmp_base.$tmp_ext"
+
+          # duplicate AC_DEFINEs are harmless, so it doesn't matter
+          # that multi-function files get grepped here repeatedly
+          gmp_ep="`
+            sed -n 's/^[ 	]*MULFUNC_PROLOGUE(\(.*\))/\1/p' $tmp_file ;
+            sed -n 's/^[ 	]*PROLOGUE(\(.*\))/\1/p' $tmp_file
+          `"
+          for gmp_tmp in $gmp_ep; do
+            cat >>confdefs.h <<EOF
+#define HAVE_NATIVE_${gmp_tmp} 1
+EOF
+
+          done
+
+          break
+        fi
+      done
+      if test $found = yes; then break ; fi
+    done
+    if test $found = yes; then break ; fi
+  done
+
+  if test $found = no; then
+    for tmp_optional in $gmp_mpn_functions_optional; do
+      if test $tmp_optional = $tmp_fn; then
+        found=yes
+      fi
+    done
+    if test $found = no; then
+      { echo "configure: error: no version of $tmp_fn found in path: $path" 1>&2; exit 1; }
+    fi
+  fi
+done
+
+# Create link for gmp-mparam.h.
+for tmp_dir in $path ; do
+  rm -f gmp-mparam.h
+  if test -f $srcdir/mpn/${tmp_dir}/gmp-mparam.h ; then
+    gmp_links="$gmp_links gmp-mparam.h:mpn/${tmp_dir}/gmp-mparam.h"
+
+    # Copy any KARATSUBA_SQR_THRESHOLD in gmp-mparam.h to config.m4.
+    # Some versions of sqr_basecase.asm use this.
+    tmp_gmp_karatsuba_sqr_threshold="`sed -n 's/^#define KARATSUBA_SQR_THRESHOLD[ 	]*\([0-9][0-9]*\).*$/\1/p' $srcdir/mpn/${tmp_dir}/gmp-mparam.h`"
+    if test -n "$tmp_gmp_karatsuba_sqr_threshold"; then
+
+echo "define(<KARATSUBA_SQR_THRESHOLD>,<$tmp_gmp_karatsuba_sqr_threshold>)" >> $gmp_tmpconfigm4
+
+    fi
+
+    break
+  fi
+done
+
+# Dig out the links from `gmp_links' for inclusion in DISTCLEANFILES.
+gmp_srclinks=
+for f in $gmp_links; do
+  gmp_srclinks="$gmp_srclinks `echo $f | sed 's/\(.*\):.*/\1/'`"
+done
+
+echo "creating $gmp_configm4"
+echo "dnl $gmp_configm4.  Generated automatically by configure." > $gmp_configm4
+if test -f $gmp_tmpconfigm4; then
+  echo "changequote(<,>)dnl" >> $gmp_configm4
+  echo "ifdef(<__CONFIG_M4_INCLUDED__>,,<" >> $gmp_configm4
+  cat $gmp_tmpconfigm4 >> $gmp_configm4
+  echo ">)" >> $gmp_configm4
+  echo "changequote(\`,')dnl" >> $gmp_configm4
+  rm $gmp_tmpconfigm4
+fi
+echo "ifdef(\`__CONFIG_M4_INCLUDED__',,\`" >> $gmp_configm4
+if test -f $gmp_tmpconfigm4i; then
+  cat $gmp_tmpconfigm4i >> $gmp_configm4
+  rm $gmp_tmpconfigm4i
+fi
+if test -f $gmp_tmpconfigm4p; then
+  cat $gmp_tmpconfigm4p >> $gmp_configm4
+  rm $gmp_tmpconfigm4p
+fi
+echo "')" >> $gmp_configm4
+echo "define(\`__CONFIG_M4_INCLUDED__')" >> $gmp_configm4
+
+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 | grep ac_space) 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
+
+DEFS=-DHAVE_CONFIG_H
+
+: ${CONFIG_STATUS=./config.status}
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+echo creating $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.
+
+# Files that config.status was made for.
+config_files="\\
+  Makefile mpf/Makefile mpz/Makefile mpn/Makefile mpq/Makefile
+  mpf/tests/Makefile mpz/tests/Makefile mpq/tests/Makefile mpn/tests/Makefile
+  tests/Makefile tests/rand/Makefile demos/Makefile tune/Makefile
+  mpbsd/Makefile mpbsd/tests/Makefile mpfr/Makefile mpfr/tests/Makefile"
+config_headers="\\
+  config.h:config.in"
+config_links="\\
+  $gmp_links"
+config_commands="\\
+  default-1"
+
+ac_cs_usage="\\
+\\\`$CONFIG_STATUS' instantiates files from templates according to the
+current configuration.
+
+Usage: $CONFIG_STATUS [OPTIONS] FILE...
+
+  --recheck    Update $CONFIG_STATUS by reconfiguring in the same conditions
+  --version    Print the version of Autoconf and exit
+  --help       Display this help and exit
+  --file=FILE[:TEMPLATE]
+               Instantiate the configuration file FILE
+  --header=FILE[:TEMPLATE]
+               Instantiate the configuration header FILE
+
+Configuration files:
+\$config_files
+
+Configuration headers:
+\$config_headers
+
+Configuration links:
+\$config_links
+
+Configuration commands:
+\$config_commands
+
+Report bugs to <bug-autoconf@gnu.org>."
+
+ac_cs_version="\\
+$CONFIG_STATUS generated by autoconf version 2.14a.
+Configured on host `(hostname || uname -n) 2>/dev/null | sed 1q` by
+  `echo "$0 $ac_configure_args" | sed 's/[\\"\`\$]/\\\\&/g'`"
+
+# Root of the tmp file names.  Use pid to allow concurrent executions.
+ac_cs_root=cs\$\$
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+# If no file are specified by the user, then we need to provide default
+# value.  By we need to know if files were specified by the user.
+ac_need_defaults=:
+while test \$# != 0
+do
+  case "\$1" in
+  --*=*)
+    ac_option=\`echo "\$1" | sed -e 's/=.*//'\`
+    ac_optarg=\`echo "\$1" | sed -e 's/[^=]*=//'\`
+    shift
+    set dummy "\$ac_option" "\$ac_optarg" \${1+"\$@"}
+    shift
+    ;;
+  -*);;
+  *) # This is not an option, so the user has probably given explicit
+     # arguments.
+     ac_need_defaults=false;;
+  esac
+
+  case "\$1" in
+
+  # Handling of the options.
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    echo "running \${CONFIG_SHELL-/bin/sh} $0 `echo "$ac_configure_args" | sed 's/[\\"\`\$]/\\\\&/g'` --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 "\$ac_cs_version"; exit 0 ;;
+  --he | --h)
+    # Conflict between --help and --header
+    echo "$CONFIG_STATUS: ambiguous option: \$ac_option
+Try \\\`$CONFIG_STATUS --help' for more information."; exit 1 ;;
+  -help | --help | --hel )
+    echo "\$ac_cs_usage"; exit 0 ;;
+  --file | --fil | --fi | --f )
+    shift
+    CONFIG_FILES="\$CONFIG_FILES \$1"
+    ac_need_defaults=false;;
+  --header | --heade | --head | --hea )
+    shift
+    CONFIG_HEADERS="\$CONFIG_FILES \$1"
+    ac_need_defaults=false;;
+
+  # Handling of arguments.
+  'Makefile' ) CONFIG_FILES="\$CONFIG_FILES Makefile" ;;
+  'mpf/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpf/Makefile" ;;
+  'mpz/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpz/Makefile" ;;
+  'mpn/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpn/Makefile" ;;
+  'mpq/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpq/Makefile" ;;
+  'mpf/tests/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpf/tests/Makefile" ;;
+  'mpz/tests/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpz/tests/Makefile" ;;
+  'mpq/tests/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpq/tests/Makefile" ;;
+  'mpn/tests/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpn/tests/Makefile" ;;
+  'tests/Makefile' ) CONFIG_FILES="\$CONFIG_FILES tests/Makefile" ;;
+  'tests/rand/Makefile' ) CONFIG_FILES="\$CONFIG_FILES tests/rand/Makefile" ;;
+  'demos/Makefile' ) CONFIG_FILES="\$CONFIG_FILES demos/Makefile" ;;
+  'tune/Makefile' ) CONFIG_FILES="\$CONFIG_FILES tune/Makefile" ;;
+  'mpbsd/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpbsd/Makefile" ;;
+  'mpbsd/tests/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpbsd/tests/Makefile" ;;
+  'mpfr/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpfr/Makefile" ;;
+  'mpfr/tests/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpfr/tests/Makefile" ;;
+  '$gmp_links' ) CONFIG_LINKS="\$CONFIG_LINKS $gmp_links" ;;
+  'default-1' ) CONFIG_COMMANDS="\$CONFIG_COMMANDS default-1" ;;
+  'config.h' ) CONFIG_HEADERS="\$CONFIG_HEADERS config.h:config.in" ;;
+
+  # This is an error.
+  -*) echo "$CONFIG_STATUS: unrecognized option: \$1
+Try \\\`$CONFIG_STATUS --help' for more information."; exit 1 ;;
+  *) echo "$CONFIG_STATUS: invalid argument: \$1"; exit 1 ;;
+  esac
+  shift
+done
+
+EOF
+
+cat >>$CONFIG_STATUS <<\EOF
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used.  Set only those that are not.
+if $ac_need_defaults; then
+  : ${CONFIG_FILES=$config_files}
+  : ${CONFIG_HEADERS=$config_headers}
+  : ${CONFIG_LINKS=$config_links}
+  : ${CONFIG_COMMANDS=$config_commands}
+fi
+
+# Trap to remove the temp files.
+trap 'rm -fr $ac_cs_root*; exit 1' 1 2 15
+
+EOF
+
+cat >>$CONFIG_STATUS <<EOF
+#
+# INIT-COMMANDS section.
+#
+
+EOF
+
+cat >>$CONFIG_STATUS <<EOF
+
+#
+# CONFIG_FILES section.
+#
+
+# No need to generate the scripts if there are no CONFIG_FILES.
+# This happens for instance when ./config.status config.h
+if test -n "\$CONFIG_FILES"; then
+  # Protect against being on the right side of a sed subst in config.status.
+  sed 's/%@/@@/; s/@%/@@/; s/%;t t\$/@;t t/; /@;t t\$/s/[\\\\&%]/\\\\&/g;
+   s/@@/%@/; s/@@/@%/; s/@;t t\$/%;t t/' >\$ac_cs_root.subs <<\\CEOF
+s%@exec_prefix@%$exec_prefix%;t t
+s%@prefix@%$prefix%;t t
+s%@program_transform_name@%$program_transform_name%;t t
+s%@bindir@%$bindir%;t t
+s%@sbindir@%$sbindir%;t t
+s%@libexecdir@%$libexecdir%;t t
+s%@datadir@%$datadir%;t t
+s%@sysconfdir@%$sysconfdir%;t t
+s%@sharedstatedir@%$sharedstatedir%;t t
+s%@localstatedir@%$localstatedir%;t t
+s%@libdir@%$libdir%;t t
+s%@includedir@%$includedir%;t t
+s%@oldincludedir@%$oldincludedir%;t t
+s%@infodir@%$infodir%;t t
+s%@mandir@%$mandir%;t t
+s%@SHELL@%$SHELL%;t t
+s%@ECHO_C@%$ECHO_C%;t t
+s%@ECHO_N@%$ECHO_N%;t t
+s%@ECHO_T@%$ECHO_T%;t t
+s%@CFLAGS@%$CFLAGS%;t t
+s%@CPPFLAGS@%$CPPFLAGS%;t t
+s%@CXXFLAGS@%$CXXFLAGS%;t t
+s%@FFLAGS@%$FFLAGS%;t t
+s%@DEFS@%$DEFS%;t t
+s%@LDFLAGS@%$LDFLAGS%;t t
+s%@LIBS@%$LIBS%;t t
+s%@host@%$host%;t t
+s%@host_alias@%$host_alias%;t t
+s%@host_cpu@%$host_cpu%;t t
+s%@host_vendor@%$host_vendor%;t t
+s%@host_os@%$host_os%;t t
+s%@target@%$target%;t t
+s%@target_alias@%$target_alias%;t t
+s%@target_cpu@%$target_cpu%;t t
+s%@target_vendor@%$target_vendor%;t t
+s%@target_os@%$target_os%;t t
+s%@build@%$build%;t t
+s%@build_alias@%$build_alias%;t t
+s%@build_cpu@%$build_cpu%;t t
+s%@build_vendor@%$build_vendor%;t t
+s%@build_os@%$build_os%;t t
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%;t t
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%;t t
+s%@INSTALL_DATA@%$INSTALL_DATA%;t t
+s%@PACKAGE@%$PACKAGE%;t t
+s%@VERSION@%$VERSION%;t t
+s%@ACLOCAL@%$ACLOCAL%;t t
+s%@AUTOCONF@%$AUTOCONF%;t t
+s%@AUTOMAKE@%$AUTOMAKE%;t t
+s%@AUTOHEADER@%$AUTOHEADER%;t t
+s%@MAKEINFO@%$MAKEINFO%;t t
+s%@AMTAR@%$AMTAR%;t t
+s%@install_sh@%$install_sh%;t t
+s%@AWK@%$AWK%;t t
+s%@SET_MAKE@%$SET_MAKE%;t t
+s%@AMDEP@%$AMDEP%;t t
+s%@AMDEPBACKSLASH@%$AMDEPBACKSLASH%;t t
+s%@DEPDIR@%$DEPDIR%;t t
+s%@MAINTAINER_MODE_TRUE@%$MAINTAINER_MODE_TRUE%;t t
+s%@MAINTAINER_MODE_FALSE@%$MAINTAINER_MODE_FALSE%;t t
+s%@MAINT@%$MAINT%;t t
+s%@WANT_MPBSD_TRUE@%$WANT_MPBSD_TRUE%;t t
+s%@WANT_MPBSD_FALSE@%$WANT_MPBSD_FALSE%;t t
+s%@WANT_MPFR_TRUE@%$WANT_MPFR_TRUE%;t t
+s%@WANT_MPFR_FALSE@%$WANT_MPFR_FALSE%;t t
+s%@CC@%$CC%;t t
+s%@CCAS@%$CCAS%;t t
+s%@CPP@%$CPP%;t t
+s%@LN_S@%$LN_S%;t t
+s%@M4@%$M4%;t t
+s%@AR@%$AR%;t t
+s%@CALLING_CONVENTIONS_OBJS@%$CALLING_CONVENTIONS_OBJS%;t t
+s%@SPEED_CYCLECOUNTER_OBJS@%$SPEED_CYCLECOUNTER_OBJS%;t t
+s%@EXEEXT@%$EXEEXT%;t t
+s%@OBJEXT@%$OBJEXT%;t t
+s%@RANLIB@%$RANLIB%;t t
+s%@STRIP@%$STRIP%;t t
+s%@LIBTOOL@%$LIBTOOL%;t t
+s%@U@%$U%;t t
+s%@ANSI2KNR@%$ANSI2KNR%;t t
+s%@mpn_objects@%$mpn_objects%;t t
+s%@mpn_objs_in_libgmp@%$mpn_objs_in_libgmp%;t t
+s%@gmp_srclinks@%$gmp_srclinks%;t t
+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_lines=48
+  ac_sed_frag=1 # Number of current file.
+  ac_beg=1 # First line for current file.
+  ac_end=$ac_max_sed_lines # 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" $ac_cs_root.subs >$ac_cs_root.sfrag
+    else
+      sed "${ac_end}q" $ac_cs_root.subs >$ac_cs_root.sfrag
+    fi
+    if test ! -s $ac_cs_root.sfrag; then
+      ac_more_lines=false
+      rm -f $ac_cs_root.sfrag
+    else
+      # The purpose of the label and of the branching condition is to
+      # speed up the sed processing (if there are no `@' at all, there
+      # is no need to browse any of the substitutions).
+      # These are the two extra sed commands mentioned above.
+      (echo ':t
+  /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $ac_cs_root.sfrag) >$ac_cs_root.s$ac_sed_frag
+      if test -z "$ac_sed_cmds"; then
+  	ac_sed_cmds="sed -f $ac_cs_root.s$ac_sed_frag"
+      else
+  	ac_sed_cmds="$ac_sed_cmds | sed -f $ac_cs_root.s$ac_sed_frag"
+      fi
+      ac_sed_frag=`expr $ac_sed_frag + 1`
+      ac_beg=$ac_end
+      ac_end=`expr $ac_end + $ac_max_sed_lines`
+    fi
+  done
+  if test -z "$ac_sed_cmds"; then
+    ac_sed_cmds=cat
+  fi
+fi # test -n "$CONFIG_FILES"
+
+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
+  *[Mm]akefile*) ac_comsub="1i\\
+# $configure_input" ;;
+  *) ac_comsub= ;;
+  esac
+
+  # Don't redirect the output to AC_FILE directly: use `mv' so that updating
+  # is atomic, and doesn't need trapping.
+  ac_file_inputs=`echo "$ac_file_in" |
+                  sed -e "s%:% $ac_given_srcdir/%g;s%^%$ac_given_srcdir/%"`
+  for ac_file_input in $ac_file_inputs;
+  do
+    test -f "$ac_file_input" ||
+        { echo "configure: error: cannot find input file \`$ac_file_input'" 1>&2; exit 1; }
+  done
+EOF
+cat >>$CONFIG_STATUS <<EOF
+  sed -e "$ac_comsub
+$ac_vpsub
+$extrasub
+EOF
+cat >>$CONFIG_STATUS <<\EOF
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s%@configure_input@%$configure_input%;t t
+s%@srcdir@%$srcdir%;t t
+s%@top_srcdir@%$top_srcdir%;t t
+s%@INSTALL@%$INSTALL%;t t
+" $ac_file_inputs | (eval "$ac_sed_cmds") >$ac_cs_root.out
+  mv $ac_cs_root.out $ac_file
+
+fi; done
+rm -f $ac_cs_root.s*
+EOF
+cat >>$CONFIG_STATUS <<\EOF
+
+#
+# CONFIG_HEADER section.
+#
+
+# 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=' '
+ac_dD='%;t'
+# ac_u turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
+ac_uA='s%^\([ 	]*\)#\([ 	]*\)undef\([ 	][ 	]*\)'
+ac_uB='$%\1#\2define\3'
+ac_uC=' '
+ac_uD='%;t'
+
+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 $ac_cs_root.frag $ac_cs_root.in $ac_cs_root.out
+  ac_file_inputs=`echo "$ac_file_in" |
+                  sed -e "s%:% $ac_given_srcdir/%g;s%^%$ac_given_srcdir/%"`
+    for ac_file_input in $ac_file_inputs;
+  do
+    test -f "$ac_file_input" ||
+        { echo "configure: error: cannot find input file \`$ac_file_input'" 1>&2; exit 1; }
+  done
+  # Remove the trailing spaces.
+  sed -e 's/[ 	]*$//' $ac_file_inputs >$ac_cs_root.in
+
+EOF
+
+# Transform confdefs.h into two sed scripts, `conftest.defines' and
+# `conftest.undefs', that substitutes the proper values into
+# config.h.in to produce config.h.  The first handles `#define'
+# templates, and the second `#undef' templates.
+# 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.defines conftest.undefs
+ac_cs_root=conftest
+cat >$ac_cs_root.hdr <<\EOF
+s/[\\&%]/\\&/g
+s%[\\$`]%\\&%g
+t clear
+: clear
+s%^[ 	]*#[ 	]*define[ 	][ 	]*\(\([^ 	(][^ 	(]*\)([^)]*)\)[ 	]*\(.*\)$%${ac_dA}\2${ac_dB}\1${ac_dC}\3${ac_dD}%gp
+t cleanup
+s%^[ 	]*#[ 	]*define[ 	][ 	]*\([^ 	][^ 	]*\)[ 	]*\(.*\)$%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp
+: cleanup
+EOF
+# If some macros were called several times there might be several times
+# the same #defines, which is useless.  Nevertheless, we may not want to
+# sort them, since we want the *last* AC_DEFINE to be honored.
+uniq confdefs.h | sed -n -f $ac_cs_root.hdr >conftest.defines
+sed -e 's/ac_d/ac_u/g' conftest.defines >conftest.undefs
+rm -f $ac_cs_root.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.undefs <<\EOF
+s%^[ 	]*#[ 	]*undef[ 	][ 	]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */%
+EOF
+
+# Break up conftest.defines because some shells have a limit on the size
+# of here documents, and old seds have small limits too (100 cmds).
+echo '  # Handle all the #define templates only if necessary.' >>$CONFIG_STATUS
+echo '  if egrep "^[ 	]*#[ 	]*define" $ac_cs_root.in >/dev/null; then' >>$CONFIG_STATUS
+echo '  # If there are no defines, we may have an empty if/fi' >>$CONFIG_STATUS
+echo '  :' >>$CONFIG_STATUS
+rm -f conftest.tail
+while grep . conftest.defines >/dev/null
+do
+  # Write a limited-size here document to $ac_cs_root.frag.
+  echo '  cat >$ac_cs_root.frag <<CEOF' >>$CONFIG_STATUS
+  echo '/^[ 	]*#[ 	]*define/!b' >>$CONFIG_STATUS
+  sed ${ac_max_here_lines}q conftest.defines >>$CONFIG_STATUS
+  echo 'CEOF
+  sed -f $ac_cs_root.frag $ac_cs_root.in >$ac_cs_root.out
+  rm -f $ac_cs_root.in
+  mv $ac_cs_root.out $ac_cs_root.in
+' >>$CONFIG_STATUS
+  sed 1,${ac_max_here_lines}d conftest.defines >conftest.tail
+  rm -f conftest.defines
+  mv conftest.tail conftest.defines
+done
+rm -f conftest.defines
+echo '  fi # egrep' >>$CONFIG_STATUS
+echo >>$CONFIG_STATUS
+
+# Break up conftest.undefs because some shells have a limit on the size
+# of here documents, and old seds have small limits too (100 cmds).
+echo '  # Handle all the #undef templates' >>$CONFIG_STATUS
+rm -f conftest.tail
+while grep . conftest.undefs >/dev/null
+do
+  # Write a limited-size here document to $ac_cs_root.frag.
+  echo '  cat >$ac_cs_root.frag <<CEOF' >>$CONFIG_STATUS
+  echo '/^[ 	]*#[ 	]*undef/!b' >>$CONFIG_STATUS
+  sed ${ac_max_here_lines}q conftest.undefs >>$CONFIG_STATUS
+  echo 'CEOF
+  sed -f $ac_cs_root.frag $ac_cs_root.in >$ac_cs_root.out
+  rm -f $ac_cs_root.in
+  mv $ac_cs_root.out $ac_cs_root.in
+' >>$CONFIG_STATUS
+  sed 1,${ac_max_here_lines}d conftest.undefs >conftest.tail
+  rm -f conftest.undefs
+  mv conftest.tail conftest.undefs
+done
+rm -f conftest.undefs
+
+cat >>$CONFIG_STATUS <<\EOF
+  rm -f $ac_cs_root.frag $ac_cs_root.h
+  echo "/* $ac_file.  Generated automatically by configure.  */" >$ac_cs_root.h
+  cat $ac_cs_root.in >>$ac_cs_root.h
+  rm -f $ac_cs_root.in
+  if cmp -s $ac_file $ac_cs_root.h 2>/dev/null; then
+    echo "$ac_file is unchanged"
+    rm -f $ac_cs_root.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 $ac_cs_root.h $ac_file
+  fi
+fi; done
+EOF
+cat >>$CONFIG_STATUS <<\EOF
+
+#
+# CONFIG_LINKS section.
+#
+srcdir=$ac_given_srcdir
+
+for ac_file in : $CONFIG_LINKS; do if test "x$ac_file" != x:; then
+  ac_dest=`echo "$ac_file" | sed 's%:.*%%'`
+  ac_source=`echo "$ac_file" | sed 's%[^:]*:%%'`
+
+  echo "linking $srcdir/$ac_source to $ac_dest"
+
+  if test ! -r $srcdir/$ac_source; then
+    { echo "configure: error: $srcdir/$ac_source: File not found" 1>&2; exit 1; }
+  fi
+  rm -f $ac_dest
+
+  # Make relative symlinks.
+  # Remove last slash and all that follows it.  Not all systems have dirname.
+  ac_dest_dir=`echo $ac_dest | sed 's%/[^/][^/]*$%%'`
+  if test "$ac_dest_dir" != "$ac_dest" && test "$ac_dest_dir" != .; then
+    # The dest file is in a subdirectory.
+    test ! -d "$ac_dest_dir" && mkdir "$ac_dest_dir"
+    ac_dest_dir_suffix="/`echo $ac_dest_dir|sed 's%^\./%%'`"
+    # A "../" for each directory in $ac_dest_dir_suffix.
+    ac_dots=`echo $ac_dest_dir_suffix|sed 's%/[^/]*%../%g'`
+  else
+    ac_dest_dir_suffix= ac_dots=
+  fi
+
+  case "$srcdir" in
+  [\\/$]* | ?:[\\/]* ) ac_rel_source="$srcdir/$ac_source" ;;
+      *) ac_rel_source="$ac_dots$srcdir/$ac_source" ;;
+  esac
+
+  # Make a symlink if possible; otherwise try a hard link.
+  if ln -s $ac_rel_source $ac_dest 2>/dev/null ||
+     ln $srcdir/$ac_source $ac_dest; then :
+  else
+    { echo "configure: error: cannot link $ac_dest to $srcdir/$ac_source" 1>&2; exit 1; }
+  fi
+fi; done
+EOF
+cat >>$CONFIG_STATUS <<\EOF
+
+#
+# CONFIG_COMMANDS section.
+#
+for ac_file in .. $CONFIG_COMMANDS; do if test "x$ac_file" != x..; then
+  ac_dest=`echo "$ac_file" | sed 's%:.*%%'`
+  ac_source=`echo "$ac_file" | sed 's%[^:]*:%%'`
+
+  case "$ac_dest" in
+    default-1 ) test -z "$CONFIG_HEADERS" || echo timestamp > stamp-h ;;
+  esac
+fi;done
+EOF
+
+cat >>$CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+trap 'exit 1' 1 2 15
+
+test "$no_create" = yes || $SHELL $CONFIG_STATUS || exit 1
diff --git a/src/gmp/configure.in b/src/gmp/configure.in
new file mode 100644
index 000000000..24abf9c23
--- /dev/null
+++ b/src/gmp/configure.in
@@ -0,0 +1,941 @@
+dnl  Process this file with autoconf to produce a configure script.
+
+
+dnl  Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+dnl
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+AC_REVISION($Revision$)dnl
+AC_PREREQ(2.14)dnl
+AC_INIT(gmp-impl.h)
+
+dnl Check system.
+AC_CANONICAL_SYSTEM
+
+dnl  Automake
+AM_INIT_AUTOMAKE(gmp, GMP_VERSION)
+AM_CONFIG_HEADER(config.h:config.in)
+AM_MAINTAINER_MODE
+
+dnl  GMP specific
+GMP_INIT(config.m4)
+
+
+AC_ARG_ENABLE(assert,
+AC_HELP_STRING([--enable-assert],[enable ASSERT checking [default=no]]),
+[case "${enableval}" in
+yes|no) ;;
+*) AC_MSG_ERROR([bad value ${enableval} for --enable-assert, need yes or no]) ;;
+esac],
+[enable_assert=no])
+
+if test "$enable_assert" = "yes"; then
+  AC_DEFINE(WANT_ASSERT,1,
+  [./configure --enable-assert option, to enable some ASSERT()s])
+fi
+
+
+AC_ARG_ENABLE(alloca,
+AC_HELP_STRING([--enable-alloca],[use alloca for temp space [default=yes]]),
+[case "${enableval}" in
+yes|no) ;;
+*) AC_MSG_ERROR([bad value ${enableval} for --enable-alloca, need yes or no]) ;;
+esac],
+[enable_alloca=yes])
+
+if test "$enable_alloca" = "no"; then
+  AC_DEFINE(USE_STACK_ALLOC,1,
+  [./configure --disable-alloca option, to use stack-alloc.c, not alloca])
+fi
+
+
+AC_ARG_ENABLE(fft,
+AC_HELP_STRING([--enable-fft],[enable FFTs for multiplication [default=no]]),
+[case "${enableval}" in
+yes|no) ;;
+*) AC_MSG_ERROR([bad value ${enableval} for --enable-fft, need yes or no]) ;;
+esac],
+[enable_fft=no])
+
+if test "$enable_fft" = "yes"; then
+  AC_DEFINE(WANT_FFT,1,
+  [./configure --enable-fft option, to enable FFTs for multiplication])
+fi
+
+
+AC_ARG_ENABLE(mpbsd,
+AC_HELP_STRING([--enable-mpbsd],[build Berkley MP compatibility library [default=no]]),
+[case "${enableval}" in
+yes|no) ;;
+*) AC_MSG_ERROR([bad value ${enableval} for --enable-mpbsd, need yes or no]) ;;
+esac],
+[enable_mpbsd=no])
+AM_CONDITIONAL(WANT_MPBSD, test "$enable_mpbsd" = "yes")
+
+
+AC_ARG_ENABLE(mpfr,
+AC_HELP_STRING([--enable-mpfr],[build MPFR [default=no]]),
+[case "${enableval}" in
+yes|no) ;;
+*) AC_MSG_ERROR([bad value ${enableval} for --enable-mpfr, need yes or no]) ;;
+esac],
+[enable_mpfr=no])
+AM_CONDITIONAL(WANT_MPFR, test "$enable_mpfr" = "yes")
+
+
+dnl Switch on OS and determine what compiler to use.
+dnl
+dnl  os_64bit	           Set to "yes" if OS is 64-bit capable.
+dnl                        FIXME: Rename to `check_64bit_compiler'!
+dnl  cclist		   List of compilers, best first.
+dnl  gmp_cflags_{cc}	   Flags for compiler named {cc}.
+dnl  gmp_cflags64_{cc}     Flags for compiler named {cc} for 64-bit code.
+dnl  gmp_optcflags_{cc}	   Optional compiler flags.
+dnl  gmp_xoptcflags_{cc}   Exclusive optional compiler flags.
+dnl
+os_64bit="no"
+cclist="gcc cc"		# FIXME: Prefer c89 to cc.
+gmp_cflags_gcc="-g -O2"
+gmp_cflags64_gcc="-g -O2"
+gmp_cflags_cc="-g"
+gmp_cflags64_cc="-g"
+
+case "$target" in
+  # Alpha
+  alpha*-cray-unicos*)
+    # Don't perform any assembly syntax tests on this beast.
+    gmp_no_asm_syntax_testing=yes
+    cclist=cc
+    gmp_cflags_cc="$gmp_cflags_cc -O"
+    ;;
+  alpha*-*-osf*)
+    flavour=`echo $target_cpu | sed 's/^alpha//g'`
+    if test -n "$flavour"; then
+      case $flavour in	   # compilers don't seem to understand `ev67' and such.
+	ev6? | ev7*) flavour=ev6;;
+      esac
+      gmp_optcflags_gcc="-mcpu=$flavour"
+      # FIXME: We shouldn't fail fatally if none of these work, but that's
+      # how xoptcflags work and we don't have any other mechanism right now.
+      # Why do we need this here and not for alpha*-*-* below?
+      gmp_xoptcflags_gcc="-Wa,-arch,${flavour} -Wa,-m${flavour}"
+      gmp_optcflags_cc="-arch $flavour -tune $flavour"
+    fi
+    ;;
+  alpha*-*-*)
+    cclist="gcc"
+    flavour=`echo $target_cpu | sed 's/^alpha//g'`
+    if test -n "$flavour"; then
+      case $flavour in
+	ev6? | ev7*) flavour=ev6;;
+      esac
+      gmp_optcflags_gcc="-mcpu=$flavour"
+    fi
+    ;;
+  # Cray vector machines.  This must come after alpha* so that we can
+  # recognize present and future vector processors with a wildcard.
+  *-cray-unicos*)
+    # Don't perform any assembly syntax tests on this beast.
+    gmp_no_asm_syntax_testing=yes
+    cclist=cc
+    # Don't inherit default gmp_cflags_cc value; it comes with -g which
+    # disables all optimization on Cray vector systems
+    gmp_cflags_cc="-O"
+    ;;
+
+  # AMD and Intel x86 configurations
+  [i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*])
+    # Rumour has it -O2 used to give worse register allocation than just -O.
+    gmp_cflags_gcc="-g -O -fomit-frame-pointer"
+
+    case "${target}" in
+      i386*-*-*)    gmp_optcflags_gcc="-mcpu=i386 -march=i386";;
+      i486*-*-*)    gmp_optcflags_gcc="-mcpu=i486 -march=i486";;
+      i586*-*-* | pentium-*-* | pentiummmx-*-*)
+                    gmp_optcflags_gcc="-mcpu=pentium -march=pentium";;
+
+      # -march=pentiumpro not used because mpz/powm.c (swox cvs rev 1.4)
+      # tickles a bug in gcc 2.95.2 (believed fixed in 2.96).
+      [i686*-*-* | pentiumpro-*-* | pentium[23]-*-*])
+                    gmp_optcflags_gcc="-mcpu=pentiumpro";;
+
+      k6*-*-*)      gmp_optcflags_gcc="-mcpu=k6 -march=k6";;
+
+      # Athlon instruction costs are close to p6: 3 cycle load latency, 4-6
+      # cycle mul, 40 cycle div, pairable adc, ...
+      # FIXME: Change this when gcc gets something specific for Athlon.
+      # -march=pentiumpro not used, per i686 above.
+      athlon-*-*)   gmp_optcflags_gcc="-mcpu=pentiumpro";;
+    esac
+    ;;
+
+  # Sparc
+  [ultrasparc*-*-solaris2.[7-9] | sparcv9-*-solaris2.[7-9]])
+    os_64bit=yes
+    gmp_cflags_gcc="$gmp_cflags_gcc -Wa,-xarch=v8plus"
+    gmp_xoptcflags_gcc="-mcpu=v9 -mcpu=v8 -mv8"
+    gmp_cflags64_gcc="$gmp_cflags64_gcc -m64 -mptr64 -Wa,-xarch=v9 -mcpu=v9"
+    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
+    gmp_cflags64_cc="-xtarget=native -xarch=v9 -xO4"
+    ;;
+  sparc64-*-linux*)
+    os_64bit=yes
+    gmp_cflags64_gcc="$gmp_cflags64_gcc -m64 -mptr64 -Wa,-xarch=v9 -mcpu=v9"
+    gmp_cflags_gcc="$gmp_cflags_gcc -m32"
+    gmp_xoptflags_gcc="-mcpu=ultrasparc -mvis"
+    ;;
+  ultrasparc*-*-* | sparcv9-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -Wa,-xarch=v8plus"
+    gmp_xoptcflags_gcc="-mcpu=v9 -mcpu=v8 -mv8"
+    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
+    ;;
+  sparcv8*-*-solaris2.* | microsparc*-*-solaris2.*)
+    gmp_cflags_gcc="$gmp_cflags_gcc"
+    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
+    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
+    ;;
+  sparcv8*-*-* | microsparc*-*-*)		# SunOS, Linux, *BSD
+    cclist="gcc acc cc"
+    gmp_cflags_gcc="$gmp_cflags_gcc"
+    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
+    gmp_cflags_acc="-g -O2 -cg92"
+    gmp_cflags_cc="-O2"		# FIXME: Flag for v8?
+    ;;
+  supersparc*-*-solaris2.*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -DSUPERSPARC"
+    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
+    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4 -DSUPERSPARC"
+    ;;
+  supersparc*-*-*)		# SunOS, Linux, *BSD
+    cclist="gcc acc cc"
+    gmp_cflags_gcc="$gmp_cflags_gcc -DSUPERSPARC"
+    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
+    gmp_cflags_acc="-g -O2 -cg92 -DSUPERSPARC"
+    gmp_cflags_cc="-O2 -DSUPERSPARC"	# FIXME: Flag for v8?
+    ;;
+  *sparc*-*-*)
+    cclist="gcc acc cc"
+    gmp_cflags_acc="-g -O2"
+    gmp_cflags_cc="-g -O2"
+    ;;
+
+  # POWER/PowerPC
+  powerpc64-*-aix*)
+    cclist="gcc xlc"
+    gmp_cflags_gcc="$gmp_cflags_gcc -maix64 -mpowerpc64"
+    gmp_cflags_xlc="-g -O2 -q64 -qtune=pwr3"
+    ;;
+  powerpc*-*-aix*)
+    cclist="gcc xlc"
+    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc"
+    gmp_cflags_xlc="$gmp_cflags_cc -qarch=ppc -O2"
+    ;;
+  power-*-aix*)
+    cclist="gcc xlc"
+    gmp_cflags_gcc="$gmp_cflags_gcc -mpower"
+    gmp_cflags_xlc="$gmp_cflags_cc -qarch=pwr -O2"
+    ;;
+  powerpc64*-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc64"
+    AC_DEFINE(_LONG_LONG_LIMB)	dnl FIXME: Remove.
+    ;;
+  powerpc*-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc"
+    ;;
+
+  # MIPS
+  mips-sgi-irix6.*)
+    os_64bit=yes
+    gmp_cflags64_gcc="-g -O2 -mabi=n32"
+    gmp_cflags64_cc="$gmp_cflags64_cc -O2 -n32"
+    ;;
+
+  # Motorola 68k family
+  m88110*-*-*)
+    gmp_cflags_gcc="-g -O -m88110"	dnl  FIXME: Use `-O2'?
+    ;;
+  m68*-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -fomit-frame-pointer"
+    ;;
+
+  # HP
+  hppa1.0*-*-*)
+    cclist="gcc c89 cc"
+    gmp_cflags_c89="$gmp_cflags_cc +O2"
+    gmp_cflags_cc="$gmp_cflags_cc +O2"
+    ;;
+  hppa2.0w*-*-*)
+    cclist="c89 cc"
+    gmp_cflags_c89="+DD64 +O3"
+    gmp_cflags_cc="+DD64 +O3"
+    ;;
+  hppa2.0*-*-*)
+    os_64bit=yes
+    cclist="gcc c89 cc"
+    gmp_cflags64_gcc="$gmp_cflags64_gcc -mWHAT -D_LONG_LONG_LIMB"
+    # +O2 to cc triggers bug in mpz/powm.c (1.4)
+    gmp_cflags64_c89="+DA2.0 +e +O3 -D_LONG_LONG_LIMB"
+    gmp_cflags64_cc="+DA2.0 +e +O3 -D_LONG_LONG_LIMB"
+    gmp_cflags_c89="$gmp_cflags_cc +O2"
+    gmp_cflags_cc="$gmp_cflags_cc +O2"
+    ;;
+
+  # VAX
+  vax*-*-*)
+    gmp_cflags_gcc="$gmp_cflags_gcc -fomit-frame-pointer"
+    ;;
+
+  # Fujitsu
+  [f30[01]-fujitsu-sysv*])
+    cclist="gcc vcc"
+    gmp_cflags_vcc="-g"		# FIXME: flags for vcc?
+    ;;
+esac
+
+dnl  Check for programs needed by macros for finding compiler.
+dnl  More programs are checked for below, when a compiler is found.
+AC_PROG_NM	dnl  Macro from Libtool.
+# nm on 64-bit AIX needs to know the object file format 
+case "$target" in
+  powerpc64*-*-aix*)
+    NM="$NM -X 64"
+    ;;
+esac   
+
+# Save CFLAGS given on command line.
+gmp_user_CFLAGS="$CFLAGS"
+
+if test -z "$CC"; then
+  # Find compiler.
+  GMP_PROG_CC_FIND($cclist, $os_64bit)
+
+  # If 64-bit OS and we have a 64-bit compiler, use it.
+  if test -n "$os_64bit" && test -n "$CC64"; then
+    CC=$CC64
+    CFLAGS=$CFLAGS64
+  else
+    eval CFLAGS=\$gmp_cflags_$CC  
+  fi
+
+  # Try compiler flags that may work with only some compiler versions.
+  # gmp_optcflags: All or nothing.
+  eval optcflags=\$gmp_optcflags_$CC
+  if test -n "$optcflags"; then
+    CFLAGS_save="$CFLAGS"
+    CFLAGS="$CFLAGS $optcflags"
+    AC_MSG_CHECKING([whether $CC accepts $optcflags])
+    AC_LANG_C
+    AC_TRY_COMPILER([int main(){return(0);}], optok, cross)
+    if test "$optok" = "yes"; then
+      AC_MSG_RESULT([yes])
+    else
+      AC_MSG_RESULT([no])
+      CFLAGS="$CFLAGS_save"
+    fi
+  fi
+  # gmp_xoptcflags: First is best, one has to work.
+  eval xoptcflags=\$gmp_xoptcflags_$CC
+  if test -n "$xoptcflags"; then
+    gmp_found="no"
+    for xopt in $xoptcflags; do
+      CFLAGS_save="$CFLAGS"
+      CFLAGS="$CFLAGS $xopt"
+      AC_MSG_CHECKING([whether $CC accepts $xopt])
+      AC_LANG_C
+      AC_TRY_COMPILER([int main(){return(0);}], optok, cross)
+      if test "$optok" = "yes"; then
+        AC_MSG_RESULT([yes])
+        gmp_found="yes"
+        break
+      else
+        AC_MSG_RESULT([no])
+        CFLAGS="$CFLAGS_save"
+      fi
+    done
+    if test "$gmp_found" = "no"; then
+      echo ["$0: fatal: need a compiler that understands one of $xoptcflags"]
+      exit 1
+    fi
+  fi
+fi
+
+# Restore CFLAGS given on command line.
+# FIXME: We've run through quite some unnecessary code looking for a
+# nice compiler and working flags for it, just to spoil that with user
+# supplied flags.
+test -n "$gmp_user_CFLAGS" && CFLAGS="$gmp_user_CFLAGS"
+
+# Select chosen compiler.
+GMP_PROG_CC_SELECT
+
+# How to assemble.
+CCAS="$CC -c"
+AC_SUBST(CCAS)
+
+dnl Checks for programs.
+dnl --------------------
+AC_PROG_CPP
+AC_PROG_INSTALL
+AC_PROG_LN_S
+GMP_PROG_M4
+AC_CHECK_PROG(AR, ar, ar)
+# ar on AIX needs to know the object file format 
+case "$target" in
+  powerpc64*-*-aix*)
+    AR="$AR -X 64"
+    ;;
+esac   
+dnl  FIXME: Find good ld?  /usr/ucb/ld on Solaris won't work.
+
+dnl Checks for assembly syntax.
+if test "$gmp_no_asm_syntax_testing" != "yes"; then
+  GMP_CHECK_ASM_TEXT
+  GMP_CHECK_ASM_DATA
+  GMP_CHECK_ASM_GLOBL
+  GMP_CHECK_ASM_LABEL_SUFFIX
+  GMP_CHECK_ASM_TYPE
+  GMP_CHECK_ASM_SIZE
+  GMP_CHECK_ASM_LSYM_PREFIX
+  GMP_CHECK_ASM_W32
+  GMP_CHECK_ASM_UNDERSCORE(underscore=yes, underscore=no)
+  GMP_CHECK_ASM_ALIGN_LOG(asm_align=log, asm_align=nolog)
+fi
+
+dnl  FIXME: Check for FPU and set `floating_point' appropriately.
+
+dnl  ========================================
+dnl  Configuring mpn.
+dnl  ----------------------------------------
+dnl  Set the following target specific variables:
+dnl  path		where to search for source files
+dnl  family		processor family (Needed for building 
+dnl 			asm-syntax.h for now.  FIXME: Remove.)
+dnl  extra_functions	extra functions
+
+family=generic
+
+case ${target} in
+  arm*-*-*)
+    path="arm"
+    ;;
+  [sparcv9*-*-solaris2.[789]* | sparc64*-*-solaris2.[789]* | ultrasparc*-*-solaris2.[789]*])
+    if test -n "$CC64"; then
+      path="sparc64"
+    else
+      path="sparc32/v9 sparc32/v8 sparc32"
+    fi
+    ;;
+  sparc64-*-linux*)
+    path="sparc64"
+    ;;
+  sparcv8*-*-* | microsparc*-*-*)
+	path="sparc32/v8 sparc32"
+	if test x${floating_point} = xno
+	  then extra_functions="udiv_nfp"
+	  else extra_functions="udiv_fp"
+	fi
+	;;
+  sparcv9*-*-* | ultrasparc*-*-*)
+	path="sparc32/v9 sparc32/v8 sparc32"
+	extra_functions="udiv_fp"
+	;;
+  supersparc*-*-*)
+	path="sparc32/v8/supersparc sparc32/v8 sparc32"
+	extra_functions="udiv"
+	;;
+  sparc*-*-*) path="sparc32"
+	if test x${floating_point} = xno
+	  then extra_functions="udiv_nfp"
+	  else extra_functions="udiv_fp"
+	fi
+	;;
+  hppa7000*-*-*)
+    path="hppa/hppa1_1 hppa"
+    extra_functions="udiv_qrnnd"
+    ;;
+  hppa1.0*-*-*)
+    path="hppa"
+    extra_functions="udiv_qrnnd"
+    ;;
+  hppa2.0w-*-*)
+    path="pa64w"
+    extra_functions="umul_ppmm udiv_qrnnd"
+    ;;
+  hppa2.0*-*-*)
+    if test -n "$CC64"; then
+      path="pa64"
+      extra_functions="umul_ppmm udiv_qrnnd"
+      # We need to use the system compiler, or actually the system assembler,
+      # since GAS has not been ported to understand the 2.0 instructions.
+      CCAS="$CC64 -c"
+    else
+      # FIXME: path should be "hppa/hppa2_0 hppa/hppa1_1 hppa"
+      path="hppa/hppa1_1 hppa"
+      extra_functions="udiv_qrnnd"
+    fi
+    ;;
+  hppa*-*-*)					#assume pa7100
+    path="hppa/hppa1_1/pa7100 hppa/hppa1_1 hppa"
+    extra_functions="udiv_qrnnd";;
+  [f30[01]-fujitsu-sysv*])
+    path=fujitsu;;
+  alphaev6*-*-*) path="alpha/ev6 alpha"; extra_functions="invert_limb cntlz";;
+  alphaev5*-*-*) path="alpha/ev5 alpha"; extra_functions="invert_limb cntlz";;
+  alpha*-*-*) path="alpha"; extra_functions="invert_limb cntlz";;
+  # Cray vector machines.  This must come after alpha* so that we can
+  # recognize present and future vector processors with a wildcard.
+  *-cray-unicos*)
+    path="cray"
+    extra_functions="mulww";;
+  am29000*-*-*) path="a29k";;
+  a29k*-*-*) path="a29k";;
+
+  # AMD and Intel x86 configurations
+
+  [i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*])
+    gmp_m4postinc="x86/x86-defs.m4"
+    extra_functions="udiv umul"
+    CALLING_CONVENTIONS_OBJS="x86call.o x86check.o"
+
+    GMP_CHECK_ASM_SHLDL_CL(
+      [GMP_DEFINE(WANT_SHLDL_CL,1)],
+      [GMP_DEFINE(WANT_SHLDL_CL,0)])
+    GMP_CHECK_ASM_ALIGN_FILL_0x90
+
+    # the CPUs below wanting to know about mmx
+    case ${target} in
+      [pentiummmx-*-* | pentium[23]-*-* | k6*-*-* | athlon-*-*])
+	GMP_CHECK_ASM_MMX(tmp_mmx=yes, tmp_mmx=no)
+        ;;
+    esac
+
+    # default for anything not otherwise mentioned
+    path="x86"
+ 
+    case ${target} in
+      [i[34]86*-*-*])
+        path="x86"
+        ;;
+      k5*-*-*)
+        # don't know what best suits k5
+        path="x86"
+        ;;
+      i586*-*-* | pentium-*-*)
+	path="x86/pentium x86"
+        ;;
+      pentiummmx-*-*)
+	path="x86/pentium x86"
+	if test "$tmp_mmx" = yes; then
+          path="x86/pentium/mmx $path"
+        fi
+        ;;
+      i686*-*-* | pentiumpro-*-*)
+	path="x86/p6 x86"
+        ;;
+      pentium2-*-*)
+	path="x86/p6 x86"
+	# The pentium/mmx lshift and rshift are good on p6 and can be used
+        # until there's something specific for p6.
+	if test "$tmp_mmx" = yes; then
+          path="x86/p6/mmx x86/pentium/mmx $path"
+        fi
+        ;;
+      pentium3-*-*)
+	path="x86/p6 x86"
+	# The pentium/mmx lshift and rshift are good on p6 and can be used
+        # until there's something specific for p6.
+	if test "$tmp_mmx" = yes; then
+          path="x86/p6/p3mmx x86/p6/mmx x86/pentium/mmx $path"
+        fi
+        ;;
+      [k6[23]*-*-*])
+	path="x86/k6 x86"
+	if test "$tmp_mmx" = yes; then
+          path="x86/k6/k62mmx x86/k6/mmx $path"
+        fi
+        ;;
+      k6*-*-*)
+	path="x86/k6 x86"
+	if test "$tmp_mmx" = yes; then
+          path="x86/k6/mmx $path"
+        fi
+        ;;
+      athlon-*-*)
+	path="x86/k7 x86"
+	if test "$tmp_mmx" = yes; then
+          path="x86/k7/mmx $path"
+        fi
+        ;;
+    esac
+    ;;
+
+
+  i960*-*-*) path="i960";;
+
+  ia64*-*-*) path="ia64";;
+
+# Motorola 68k configurations.  Let m68k mean 68020-68040.
+  [m680[234]0*-*-* | m68k*-*-* | \
+  m68*-next-nextstep*])		# Nexts are at least '020
+    path="m68k/mc68020 m68k"
+    family=m68k
+    ;;
+  m68000*-*-*)
+    path="m68k"
+    family=m68k
+    ;;
+
+  m88k*-*-* | m88k*-*-*) path="m88k";;
+  m88110*-*-*) path="m88k/mc88110 m88k";;
+  ns32k*-*-*) path="ns32k";;
+
+  pyramid-*-*) path="pyr";;
+
+  ppc601-*-*) path="power powerpc32";;
+  powerpc64*-*-*) path="powerpc64";;
+  powerpc*-*-*) path="powerpc32";;
+  rs6000-*-* | power-*-* | power2-*-*)
+    path="power"
+    extra_functions="udiv_w_sdiv"
+    ;;
+
+  sh-*-*) path="sh";;
+  sh2-*-*) path="sh/sh2 sh";;
+
+  [mips[34]*-*-*]) path="mips3";;
+  mips*-*-irix6*) path="mips3";;
+  mips*-*-*) path="mips2";;
+
+  vax*-*-*) path="vax"; extra_functions="udiv_w_sdiv";;
+
+  z8000x*-*-*) path="z8000x"; extra_functions="udiv_w_sdiv";;
+  z8000*-*-*) path="z8000"; extra_functions="udiv_w_sdiv";;
+
+  clipper*-*-*) path="clipper";;
+esac
+
+AC_SUBST(CALLING_CONVENTIONS_OBJS)
+if test -n "$CALLING_CONVENTIONS_OBJS"; then
+  AC_DEFINE(HAVE_CALLING_CONVENTIONS,1,
+  [Define if mpn/tests has calling conventions checking for the CPU])
+fi
+
+
+case ${target} in
+  [i[5-8]86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*])
+    # rdtsc is in pentium and up, not in i386 and i486
+    SPEED_CYCLECOUNTER_OBJS=pentium.lo
+    ;;
+  alpha*-*-*)
+    SPEED_CYCLECOUNTER_OBJS=alpha.lo
+    ;;
+  sparcv9*-*-* | ultrasparc*-*-* | sparc64*-*-*)
+    SPEED_CYCLECOUNTER_OBJS=sparcv9.lo
+    ;;
+  hppa2*-*-*)
+    SPEED_CYCLECOUNTER_OBJS=hppa2.lo
+    ;;
+  hppa*-*-*)
+    SPEED_CYCLECOUNTER_OBJS=hppa.lo
+    ;;
+esac
+
+AC_SUBST(SPEED_CYCLECOUNTER_OBJS)
+
+if test -n "$SPEED_CYCLECOUNTER_OBJS"
+then
+  AC_DEFINE(HAVE_SPEED_CYCLECOUNTER, 1,
+  [Define if a speed_cyclecounter exists (for the tune programs)])
+fi
+
+
+dnl Extensions for executable and object files.
+dnl -------------------------------------------
+AC_EXEEXT
+AC_OBJEXT
+
+dnl Use Libtool.
+dnl ------------
+dnl  FIXME: Shared libs seem to fail on aix4.3.
+dnl  FIXME: Should invoke [AC_DISABLE_SHARED], but m4 recurses to death.
+case "$target" in
+  [*-*-aix4.[3-9]*]) enable_shared=no ;;
+esac
+AC_PROG_LIBTOOL
+
+dnl Checks for libraries.
+dnl ---------------------
+AC_CHECK_DECLS((optarg))
+
+dnl Checks for header files.
+dnl ------------------------
+AC_HEADER_STDC
+AC_CHECK_HEADERS(getopt.h unistd.h sys/sysctl.h sys/time.h)
+
+dnl Checks for typedefs, structures, and compiler characteristics.
+dnl --------------------------------------------------------------
+AC_CHECK_TYPES((void))
+AC_C_STRINGIZE
+
+dnl Checks for library functions.
+dnl -----------------------------
+dnl Most of these are only for the benefit of supplementary programs.  The
+dnl library itself doesn't use anything weird.
+dnl AC_FUNC_MEMCMP
+dnl AC_TYPE_SIGNAL
+dnl AC_CHECK_FUNCS(strtol)
+AC_CHECK_FUNCS(getopt_long getpagesize popen processor_info strtoul sysconf sysctlbyname)
+
+dnl Trick automake into thinking we've run AM_C_PROTOTYPES which it wants
+dnl for ansi2knr, and instead use our own test.  (It's only a warning
+dnl automake prints, but it's good to suppress it.)
+ifelse(0,1,[
+AM_C_PROTOTYPES
+])
+GMP_C_ANSI2KNR
+
+
+dnl  Set `syntax' to one of <blank>, "mit", "elf", "aix", "macho".
+syntax=
+# For now, we use the old switch for setting syntax.  
+# FIXME: Remove when conversion to .asm is completed.
+changequote(,)dnl
+case "${target}" in
+  m680[234]0*-*-linuxaout* | m68k*-*-linuxaout* | \
+  m68k-next-nextstep* | \
+  m68000*-*-*)
+    syntax=mit
+    ;;
+  m680[234]0*-*-linux* | m68k*-*-linux*)
+    syntax=elf
+    ;;
+  m680[234]0*-*-* | m68k*-*-*)
+    syntax=mit
+    ;;
+esac
+changequote([,])dnl
+
+dnl  ----------------------------------------
+# Now build an asm-syntax.h file for targets that include that from the
+# assembly files.
+# FIXME: Remove when conversion to .asm is completed.
+case "${family}-${underscore}-${asm_align}-${syntax}" in
+  m68k-yes-log-mit)
+    echo '#define MIT_SYNTAX' >asm-syntax.h
+    cat $srcdir/mpn/underscore.h >>asm-syntax.h
+    echo '#include "'$srcdir'/mpn/m68k/syntax.h"' >>asm-syntax.h;;
+  m68k-no-nolog-elf)
+    echo '#define ELF_SYNTAX' >asm-syntax.h
+    echo '#define C_SYMBOL_NAME(name) name' >>asm-syntax.h
+    echo '#include "'$srcdir'/mpn/m68k/syntax.h"' >>asm-syntax.h;;
+esac
+
+
+# The pattern here tests for an absolute path the same way as
+# _AC_OUTPUT_FILES in autoconf acgeneral.m4.
+GMP_DEFINE_RAW(["dnl  CONFIG_TOP_SRCDIR is a path from the mpn builddir to the top srcdir"])
+case "$srcdir" in
+[[\\/]]* | ?:[[\\/]]* )
+     GMP_DEFINE_RAW(["define(<CONFIG_TOP_SRCDIR>,<\`$srcdir'>)"])    ;;
+*)   GMP_DEFINE_RAW(["define(<CONFIG_TOP_SRCDIR>,<\`../$srcdir'>)"]) ;;
+esac
+ 
+GMP_DEFINE_RAW(["include(CONFIG_TOP_SRCDIR\`/mpn/asm-defs.m4')"], POST)
+
+# Must be after asm-defs.m4
+GMP_DEFINE_RAW("define_not_for_expansion(\`HAVE_TARGET_CPU_$target_cpu')", POST)
+
+
+dnl  config.m4 post-includes
+dnl  -----------------------
+dnl  (Note x86 post include set with $path above.)
+changequote(,)dnl
+case "$target" in
+  alpha*-cray-unicos*)
+    gmp_m4postinc="alpha/unicos.m4"
+    ;;
+  alpha*-*-*)
+    gmp_m4postinc="alpha/default.m4"
+    ;;
+  power*-*-*)
+    case "$target" in
+      *-*-mach* | *-*-rhapsody* | *-*-nextstep*)
+        ;;	# these use non-conventional assembly syntax.
+      powerpc64-*-aix*)
+	gmp_m4postinc="powerpc32/regmap.m4 powerpc64/aix.m4"
+        ;;
+      *-*-aix*)
+	gmp_m4postinc="powerpc32/regmap.m4 powerpc32/aix.m4"
+        ;;
+      *)
+	gmp_m4postinc="powerpc32/regmap.m4"
+	;;
+    esac
+    ;;
+esac
+changequote([, ])dnl
+
+for tmp_f in $gmp_m4postinc; do
+  GMP_DEFINE_RAW(["include_mpn(\`$tmp_f')"], POST)
+done
+
+
+# Set up `gmp_links'.  It's a list of link:file pairs that configure will
+# process to create link -> file.
+gmp_links=
+
+# If the user specified `MPN_PATH', use that instead of the path we've
+# come up with.
+if test -z "$MPN_PATH"; then
+  path="$path generic"
+else
+  path="$MPN_PATH"
+fi
+
+# Pick the correct source files in $path and link them to mpn/.
+# $gmp_mpn_functions lists all functions we need.
+#
+# The rule is to find a file with the function name and a .asm, .S,
+# .s, or .c extension.  Certain multi-function files with special names
+# can provide some functions too.  (mpn/Makefile.am passes
+# -DOPERATION_<func> to get them to generate the right code.)
+
+# FIXME: udiv and umul aren't in $gmp_mpn_functions_optional yet since
+# there's some versions of those files which should be checked for bit
+# rot first.  Put them in $extra_functions for each target for now,
+# change to standard optionals when all are ready.
+
+# Note: The following lines defining $gmp_mpn_functions_optional
+#       and $gmp_mpn_functions are parsed by the "macos/configure"
+#       Perl script. So if you change the lines in a major way
+#       make sure to run and examine the output from
+#       
+#           % (cd macos; perl configure)
+
+gmp_mpn_functions_optional="copyi copyd com_n		\
+  and_n andn_n nand_n ior_n iorn_n nior_n xor_n xnor_n"
+
+gmp_mpn_functions="${extra_functions} inlines add_n sub_n mul_1 addmul_1   \
+  submul_1 lshift rshift diveby3 divrem divrem_1 divrem_2                  \
+  mod_1 mod_1_rs pre_mod_1 dump                                            \
+  mul mul_fft mul_n mul_basecase sqr_basecase random                       \
+  random2 sqrtrem get_str set_str scan0 scan1 popcount hamdist cmp perfsqr \
+  bdivmod gcd_1 gcd gcdext tdiv_qr bz_divrem_n sb_divrem_mn jacbase        \
+  $gmp_mpn_functions_optional"
+
+# the list of all object files used by mpn/Makefile.in and the
+# top-level Makefile.in, respectively
+mpn_objects=
+mpn_objs_in_libgmp="mpn/mp_bases.lo"
+
+for tmp_fn in ${gmp_mpn_functions} ; do
+  [rm -f mpn/${tmp_fn}.[Ssc] mpn/${tmp_fn}.asm]
+
+  # functions that can be provided by multi-function files
+  tmp_mulfunc=
+  case $tmp_fn in
+  add_n|sub_n)       tmp_mulfunc="aors_n"    ;;
+  addmul_1|submul_1) tmp_mulfunc="aorsmul_1" ;;
+  popcount|hamdist)  tmp_mulfunc="popham"    ;;
+  and_n|andn_n|nand_n | ior_n|iorn_n|nior_n | xor_n|xnor_n)
+                     tmp_mulfunc="logops_n"  ;;
+  esac
+
+  found=no
+  for tmp_dir in $path; do
+    for tmp_base in $tmp_fn $tmp_mulfunc; do
+      for tmp_ext in asm S s c; do
+        tmp_file=$srcdir/mpn/$tmp_dir/$tmp_base.$tmp_ext
+        if test -f $tmp_file; then
+          found=yes
+
+          mpn_objects="$mpn_objects ${tmp_fn}.lo"
+          mpn_objs_in_libgmp="$mpn_objs_in_libgmp mpn/${tmp_fn}.lo"
+          gmp_links="$gmp_links mpn/$tmp_fn.$tmp_ext:mpn/$tmp_dir/$tmp_base.$tmp_ext"
+
+          # duplicate AC_DEFINEs are harmless, so it doesn't matter
+          # that multi-function files get grepped here repeatedly
+          gmp_ep=["`
+            sed -n 's/^[ 	]*MULFUNC_PROLOGUE(\(.*\))/\1/p' $tmp_file ;
+            sed -n 's/^[ 	]*PROLOGUE(\(.*\))/\1/p' $tmp_file
+          `"]
+          for gmp_tmp in $gmp_ep; do
+            AC_DEFINE_UNQUOTED(HAVE_NATIVE_${gmp_tmp})
+          done
+
+          break
+        fi
+      done
+      if test $found = yes; then break ; fi
+    done
+    if test $found = yes; then break ; fi
+  done
+
+  if test $found = no; then
+    for tmp_optional in $gmp_mpn_functions_optional; do
+      if test $tmp_optional = $tmp_fn; then
+        found=yes
+      fi
+    done
+    if test $found = no; then
+      AC_MSG_ERROR([no version of $tmp_fn found in path: $path])
+    fi
+  fi
+done
+
+# Create link for gmp-mparam.h.
+for tmp_dir in $path ; do
+  rm -f gmp-mparam.h
+  if test -f $srcdir/mpn/${tmp_dir}/gmp-mparam.h ; then
+    gmp_links="$gmp_links gmp-mparam.h:mpn/${tmp_dir}/gmp-mparam.h"
+
+    # Copy any KARATSUBA_SQR_THRESHOLD in gmp-mparam.h to config.m4.
+    # Some versions of sqr_basecase.asm use this.
+    tmp_gmp_karatsuba_sqr_threshold="`sed -n 's/^#define KARATSUBA_SQR_THRESHOLD[ 	]*\([0-9][0-9]*\).*$/\1/p' $srcdir/mpn/${tmp_dir}/gmp-mparam.h`"
+    if test -n "$tmp_gmp_karatsuba_sqr_threshold"; then
+      GMP_DEFINE_RAW(["define(<KARATSUBA_SQR_THRESHOLD>,<$tmp_gmp_karatsuba_sqr_threshold>)"])
+    fi
+
+    break
+  fi
+done
+
+# Dig out the links from `gmp_links' for inclusion in DISTCLEANFILES.
+gmp_srclinks=
+for f in $gmp_links; do
+  gmp_srclinks="$gmp_srclinks `echo $f | sed 's/\(.*\):.*/\1/'`"
+done
+
+AC_SUBST(mpn_objects)
+AC_SUBST(mpn_objs_in_libgmp)
+AC_SUBST(gmp_srclinks)
+
+dnl  ----------------------------------------
+dnl  Make links.
+AC_CONFIG_LINKS($gmp_links)
+
+dnl  Create config.m4.
+GMP_FINISH
+
+dnl  Create Makefiles
+dnl  FIXME: Upcoming version of autoconf/automake may not like broken lines.
+AC_OUTPUT(Makefile mpf/Makefile mpz/Makefile mpn/Makefile mpq/Makefile \
+  mpf/tests/Makefile mpz/tests/Makefile mpq/tests/Makefile mpn/tests/Makefile \
+  tests/Makefile tests/rand/Makefile demos/Makefile tune/Makefile \
+  mpbsd/Makefile mpbsd/tests/Makefile mpfr/Makefile mpfr/tests/Makefile)
diff --git a/src/gmp/demos/Makefile.am b/src/gmp/demos/Makefile.am
new file mode 100644
index 000000000..76c72088c
--- /dev/null
+++ b/src/gmp/demos/Makefile.am
@@ -0,0 +1,62 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+EXTRA_DIST = calc.y calclex.l
+
+calc_SOURCES = calc.c calclex.c calc.h
+qcn_LDADD = $(LDADD) -lm
+
+# None of these programs are built by default, but "make <whatever>" will
+# build them once libgmp.la is built.
+#
+EXTRA_PROGRAMS = calc factorize isprime pexpr primes qcn
+
+CLEANFILES = $(EXTRA_PROGRAMS)
+
+allprogs: $(EXTRA_PROGRAMS)
+
+
+# The distribution includes calc.c, calc.h and calclex.c, generated with
+# bison and flex, so the calc program will build even if yacc and lex aren't
+# available.  The rules below regenerate those files if you modify calc.y or
+# calclex.l.
+#
+# Using "cd"s instead of a $(srcdir) path ensures $(srcdir) doesn't get into
+# the "#line"s in the generated files.
+#
+# FIXME: Automake yacc handling isn't quite right when building in a
+# separate object directory, hence the explicit rules used for now.
+#
+# FIXME: With ansi2knr and no-dependencies, there doesn't seem any easy way
+# to manually express that calclex$U.lo depends on calc.h.  Making calclex.c
+# depend on calc.h gets the right result, but the extra lex runs are
+# unnecessary.
+
+$(srcdir)/calclex.c: calclex.l calc.h
+	cd $(srcdir); lex -ocalclex.c calclex.l
+$(srcdir)/calc.c $(srcdir)/calc.h: calc.y
+	cd $(srcdir); yacc -d -ocalc.c calc.y
diff --git a/src/gmp/demos/Makefile.in b/src/gmp/demos/Makefile.in
new file mode 100644
index 000000000..5299f9111
--- /dev/null
+++ b/src/gmp/demos/Makefile.in
@@ -0,0 +1,432 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+EXTRA_DIST = calc.y calclex.l
+
+calc_SOURCES = calc.c calclex.c calc.h
+qcn_LDADD = $(LDADD) -lm
+
+# None of these programs are built by default, but "make <whatever>" will
+# build them once libgmp.la is built.
+#
+EXTRA_PROGRAMS = calc factorize isprime pexpr primes qcn
+
+CLEANFILES = $(EXTRA_PROGRAMS)
+subdir = demos
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES = 
+EXTRA_PROGRAMS =  calc$(EXEEXT) factorize$(EXEEXT) isprime$(EXEEXT) \
+pexpr$(EXEEXT) primes$(EXEEXT) qcn$(EXEEXT)
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+ANSI2KNR = $(top_builddir)/ansi2knr
+am_calc_OBJECTS =  calc$U.$(OBJEXT) calclex$U.$(OBJEXT)
+calc_OBJECTS =  $(am_calc_OBJECTS)
+calc_LDADD = $(LDADD)
+calc_DEPENDENCIES =  $(top_builddir)/libgmp.la
+calc_LDFLAGS = 
+factorize_SOURCES = factorize.c
+factorize_OBJECTS =  factorize$U.$(OBJEXT)
+factorize_LDADD = $(LDADD)
+factorize_DEPENDENCIES =  $(top_builddir)/libgmp.la
+factorize_LDFLAGS = 
+isprime_SOURCES = isprime.c
+isprime_OBJECTS =  isprime$U.$(OBJEXT)
+isprime_LDADD = $(LDADD)
+isprime_DEPENDENCIES =  $(top_builddir)/libgmp.la
+isprime_LDFLAGS = 
+pexpr_SOURCES = pexpr.c
+pexpr_OBJECTS =  pexpr$U.$(OBJEXT)
+pexpr_LDADD = $(LDADD)
+pexpr_DEPENDENCIES =  $(top_builddir)/libgmp.la
+pexpr_LDFLAGS = 
+primes_SOURCES = primes.c
+primes_OBJECTS =  primes$U.$(OBJEXT)
+primes_LDADD = $(LDADD)
+primes_DEPENDENCIES =  $(top_builddir)/libgmp.la
+primes_LDFLAGS = 
+qcn_SOURCES = qcn.c
+qcn_OBJECTS =  qcn$U.$(OBJEXT)
+qcn_DEPENDENCIES =  $(top_builddir)/libgmp.la
+qcn_LDFLAGS = 
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(calc_SOURCES) factorize.c isprime.c pexpr.c primes.c \
+qcn.c
+DIST_COMMON =  Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(calc_SOURCES) factorize.c isprime.c pexpr.c primes.c qcn.c
+OBJECTS = $(am_calc_OBJECTS) factorize$U.$(OBJEXT) isprime$U.$(OBJEXT) pexpr$U.$(OBJEXT) primes$U.$(OBJEXT) qcn$U.$(OBJEXT)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .h .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu demos/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+$(top_builddir)/ansi2knr: $(top_builddir)/ansi2knr.$(OBJEXT)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr
+
+$(top_builddir)/ansi2knr.$(OBJEXT):
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr.$(OBJEXT)
+
+
+mostlyclean-kr:
+	-rm -f *_.c
+
+clean-kr:
+
+distclean-kr:
+
+maintainer-clean-kr:
+
+calc$(EXEEXT): $(calc_OBJECTS) $(calc_DEPENDENCIES)
+	@rm -f calc$(EXEEXT)
+	$(LINK) $(calc_LDFLAGS) $(calc_OBJECTS) $(calc_LDADD) $(LIBS)
+
+factorize$(EXEEXT): $(factorize_OBJECTS) $(factorize_DEPENDENCIES)
+	@rm -f factorize$(EXEEXT)
+	$(LINK) $(factorize_LDFLAGS) $(factorize_OBJECTS) $(factorize_LDADD) $(LIBS)
+
+isprime$(EXEEXT): $(isprime_OBJECTS) $(isprime_DEPENDENCIES)
+	@rm -f isprime$(EXEEXT)
+	$(LINK) $(isprime_LDFLAGS) $(isprime_OBJECTS) $(isprime_LDADD) $(LIBS)
+
+pexpr$(EXEEXT): $(pexpr_OBJECTS) $(pexpr_DEPENDENCIES)
+	@rm -f pexpr$(EXEEXT)
+	$(LINK) $(pexpr_LDFLAGS) $(pexpr_OBJECTS) $(pexpr_LDADD) $(LIBS)
+
+primes$(EXEEXT): $(primes_OBJECTS) $(primes_DEPENDENCIES)
+	@rm -f primes$(EXEEXT)
+	$(LINK) $(primes_LDFLAGS) $(primes_OBJECTS) $(primes_LDADD) $(LIBS)
+
+qcn$(EXEEXT): $(qcn_OBJECTS) $(qcn_DEPENDENCIES)
+	@rm -f qcn$(EXEEXT)
+	$(LINK) $(qcn_LDFLAGS) $(qcn_OBJECTS) $(qcn_LDADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+calc_.c: calc.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/calc.c; then echo $(srcdir)/calc.c; else echo calc.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > calc_.c
+calclex_.c: calclex.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/calclex.c; then echo $(srcdir)/calclex.c; else echo calclex.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > calclex_.c
+factorize_.c: factorize.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/factorize.c; then echo $(srcdir)/factorize.c; else echo factorize.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > factorize_.c
+isprime_.c: isprime.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/isprime.c; then echo $(srcdir)/isprime.c; else echo isprime.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > isprime_.c
+pexpr_.c: pexpr.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/pexpr.c; then echo $(srcdir)/pexpr.c; else echo pexpr.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > pexpr_.c
+primes_.c: primes.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/primes.c; then echo $(srcdir)/primes.c; else echo primes.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > primes_.c
+qcn_.c: qcn.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/qcn.c; then echo $(srcdir)/qcn.c; else echo qcn.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > qcn_.c
+calc_.$(OBJEXT) calc_.lo calclex_.$(OBJEXT) calclex_.lo \
+factorize_.$(OBJEXT) factorize_.lo isprime_.$(OBJEXT) isprime_.lo \
+pexpr_.$(OBJEXT) pexpr_.lo primes_.$(OBJEXT) primes_.lo qcn_.$(OBJEXT) \
+qcn_.lo : $(ANSI2KNR)
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am: all-am
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am:
+install-data: install-data-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am:
+uninstall: uninstall-am
+all-am: Makefile
+all-redirect: all-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs:
+
+
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-compile mostlyclean-libtool mostlyclean-kr \
+		mostlyclean-tags mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am:  clean-compile clean-libtool clean-kr clean-tags clean-generic \
+		mostlyclean-am
+
+clean: clean-am
+
+distclean-am:  distclean-compile distclean-libtool distclean-kr \
+		distclean-tags distclean-generic clean-am
+	-rm -f libtool
+
+distclean: distclean-am
+
+maintainer-clean-am:  maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-kr maintainer-clean-tags \
+		maintainer-clean-generic distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool mostlyclean-kr distclean-kr \
+clean-kr maintainer-clean-kr tags mostlyclean-tags distclean-tags \
+clean-tags maintainer-clean-tags distdir info-am info dvi-am dvi check \
+check-am installcheck-am installcheck install-exec-am install-exec \
+install-data-am install-data install-am install uninstall-am uninstall \
+all-redirect all-am all install-strip installdirs mostlyclean-generic \
+distclean-generic clean-generic maintainer-clean-generic clean \
+mostlyclean distclean maintainer-clean
+
+
+allprogs: $(EXTRA_PROGRAMS)
+
+# The distribution includes calc.c, calc.h and calclex.c, generated with
+# bison and flex, so the calc program will build even if yacc and lex aren't
+# available.  The rules below regenerate those files if you modify calc.y or
+# calclex.l.
+#
+# Using "cd"s instead of a $(srcdir) path ensures $(srcdir) doesn't get into
+# the "#line"s in the generated files.
+#
+# FIXME: Automake yacc handling isn't quite right when building in a
+# separate object directory, hence the explicit rules used for now.
+#
+# FIXME: With ansi2knr and no-dependencies, there doesn't seem any easy way
+# to manually express that calclex$U.lo depends on calc.h.  Making calclex.c
+# depend on calc.h gets the right result, but the extra lex runs are
+# unnecessary.
+
+$(srcdir)/calclex.c: calclex.l calc.h
+	cd $(srcdir); lex -ocalclex.c calclex.l
+$(srcdir)/calc.c $(srcdir)/calc.h: calc.y
+	cd $(srcdir); yacc -d -ocalc.c calc.y
+
+# 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/src/gmp/demos/calc.c b/src/gmp/demos/calc.c
new file mode 100644
index 000000000..46b9e1305
--- /dev/null
+++ b/src/gmp/demos/calc.c
@@ -0,0 +1,1301 @@
+
+/*  A Bison parser, made from calc.y
+    by GNU Bison version 1.28  */
+
+#define YYBISON 1  /* Identify Bison output.  */
+
+#define	EOS	257
+#define	BAD	258
+#define	HEX	259
+#define	DECIMAL	260
+#define	QUIT	261
+#define	ABS	262
+#define	BIN	263
+#define	FIB	264
+#define	GCD	265
+#define	LCM	266
+#define	NEXTPRIME	267
+#define	POWM	268
+#define	ROOT	269
+#define	SQRT	270
+#define	NUMBER	271
+#define	VARIABLE	272
+#define	LOR	273
+#define	LAND	274
+#define	EQ	275
+#define	NE	276
+#define	LE	277
+#define	GE	278
+#define	LSHIFT	279
+#define	RSHIFT	280
+#define	UMINUS	281
+
+#line 99 "calc.y"
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "gmp.h"
+
+#define numberof(x)  (sizeof (x) / sizeof ((x)[0]))
+
+
+int  ibase = 0;
+int  obase = 10;
+
+
+/* The stack is a fixed size, which means there's a limit on the nesting
+   allowed in expressions.  A more sophisticated program could let it grow
+   dynamically.  */
+
+mpz_t    stack[100];
+mpz_ptr  sp = stack[0];
+
+#define CHECK_OVERFLOW()                                                  \
+  if (sp >= stack[numberof(stack)])                                       \
+    {                                                                     \
+      fprintf (stderr,                                                    \
+               "Value stack overflow, too much nesting in expression\n"); \
+      YYERROR;                                                            \
+    }
+
+#define CHECK_EMPTY()                                                   \
+  if (sp != stack[0])                                                   \
+    {                                                                   \
+      fprintf (stderr, "Oops, expected the value stack to be empty\n"); \
+      sp = stack[0];                                                    \
+    }
+
+
+mpz_t  variable[26];
+
+#define CHECK_VARIABLE(var)                                             \
+  if ((var) < 0 || (var) >= numberof (variable))                        \
+    {                                                                   \
+      fprintf (stderr, "Oops, bad variable somehow: %d\n", var);        \
+      YYERROR;                                                          \
+    }
+
+
+#define CHECK_UI(name,z)                                                   \
+  if (! mpz_fits_ulong_p (z))                                              \
+    {                                                                      \
+      fprintf (stderr,                                                     \
+               "Operand must fit in an \"unsigned long\" for %s\n", name); \
+      YYERROR;                                                             \
+    }
+
+
+#line 155 "calc.y"
+typedef union {
+  char  *str;
+  int   var;
+} YYSTYPE;
+#include <stdio.h>
+
+#ifndef __cplusplus
+#ifndef __STDC__
+#define const
+#endif
+#endif
+
+
+
+#define	YYFINAL		107
+#define	YYFLAG		-32768
+#define	YYNTBASE	41
+
+#define YYTRANSLATE(x) ((unsigned)(x) <= 281 ? yytranslate[x] : 47)
+
+static const char yytranslate[] = {     0,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,    36,     2,     2,     2,    33,     2,     2,    38,
+    39,    31,    29,    40,    30,     2,    32,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,    21,
+    37,    22,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,    35,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     1,     3,     4,     5,     6,
+     7,     8,     9,    10,    11,    12,    13,    14,    15,    16,
+    17,    18,    19,    20,    23,    24,    25,    26,    27,    28,
+    34
+};
+
+#if YYDEBUG != 0
+static const short yyprhs[] = {     0,
+     0,     2,     5,     8,    12,    15,    16,    18,    22,    24,
+    26,    28,    32,    36,    40,    44,    48,    52,    56,    60,
+    64,    67,    70,    74,    78,    82,    86,    90,    94,    98,
+   102,   107,   114,   119,   124,   129,   134,   143,   150,   155,
+   157,   159,   161,   165,   167
+};
+
+static const short yyrhs[] = {    43,
+     0,    42,    43,     0,    43,     3,     0,    42,    43,     3,
+     0,     1,     3,     0,     0,    44,     0,    18,    37,    44,
+     0,     5,     0,     6,     0,     7,     0,    38,    44,    39,
+     0,    44,    29,    44,     0,    44,    30,    44,     0,    44,
+    31,    44,     0,    44,    32,    44,     0,    44,    33,    44,
+     0,    44,    35,    44,     0,    44,    27,    44,     0,    44,
+    28,    44,     0,    44,    36,     0,    30,    44,     0,    44,
+    21,    44,     0,    44,    25,    44,     0,    44,    23,    44,
+     0,    44,    24,    44,     0,    44,    26,    44,     0,    44,
+    22,    44,     0,    44,    20,    44,     0,    44,    19,    44,
+     0,     8,    38,    44,    39,     0,     9,    38,    44,    40,
+    44,    39,     0,    10,    38,    44,    39,     0,    11,    38,
+    45,    39,     0,    12,    38,    46,    39,     0,    13,    38,
+    44,    39,     0,    14,    38,    44,    40,    44,    40,    44,
+    39,     0,    15,    38,    44,    40,    44,    39,     0,    16,
+    38,    44,    39,     0,    18,     0,    17,     0,    44,     0,
+    45,    40,    44,     0,    44,     0,    46,    40,    44,     0
+};
+
+#endif
+
+#if YYDEBUG != 0
+static const short yyrline[] = { 0,
+   179,   181,   183,   185,   186,   188,   190,   195,   201,   202,
+   203,   208,   210,   211,   212,   213,   214,   215,   217,   219,
+   221,   223,   225,   226,   227,   228,   229,   230,   232,   233,
+   235,   236,   238,   240,   241,   242,   243,   244,   246,   248,
+   254,   264,   266,   268,   270
+};
+#endif
+
+
+#if YYDEBUG != 0 || defined (YYERROR_VERBOSE)
+
+static const char * const yytname[] = {   "$","error","$undefined.","EOS","BAD",
+"HEX","DECIMAL","QUIT","ABS","BIN","FIB","GCD","LCM","NEXTPRIME","POWM","ROOT",
+"SQRT","NUMBER","VARIABLE","LOR","LAND","'<'","'>'","EQ","NE","LE","GE","LSHIFT",
+"RSHIFT","'+'","'-'","'*'","'/'","'%'","UMINUS","'^'","'!'","'='","'('","')'",
+"','","top","statements","statement","e","gcdlist","lcmlist", NULL
+};
+#endif
+
+static const short yyr1[] = {     0,
+    41,    41,    42,    42,    42,    43,    43,    43,    43,    43,
+    43,    44,    44,    44,    44,    44,    44,    44,    44,    44,
+    44,    44,    44,    44,    44,    44,    44,    44,    44,    44,
+    44,    44,    44,    44,    44,    44,    44,    44,    44,    44,
+    44,    45,    45,    46,    46
+};
+
+static const short yyr2[] = {     0,
+     1,     2,     2,     3,     2,     0,     1,     3,     1,     1,
+     1,     3,     3,     3,     3,     3,     3,     3,     3,     3,
+     2,     2,     3,     3,     3,     3,     3,     3,     3,     3,
+     4,     6,     4,     4,     4,     4,     8,     6,     4,     1,
+     1,     1,     3,     1,     3
+};
+
+static const short yydefact[] = {     0,
+     0,     9,    10,    11,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,    41,    40,     0,     0,     6,     1,     7,
+     5,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,    40,    22,     0,     2,     3,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,    21,     0,     0,     0,    42,     0,    44,     0,
+     0,     0,     0,     0,     8,    12,     4,    30,    29,    23,
+    28,    25,    26,    24,    27,    19,    20,    13,    14,    15,
+    16,    17,    18,    31,     0,    33,    34,     0,    35,     0,
+    36,     0,     0,    39,     0,    43,    45,     0,     0,    32,
+     0,    38,     0,    37,     0,     0,     0
+};
+
+static const short yydefgoto[] = {   105,
+    18,    19,    20,    58,    60
+};
+
+static const short yypact[] = {    37,
+    15,-32768,-32768,-32768,   -19,   -18,     1,     3,    23,    26,
+    28,    30,    32,-32768,    34,    92,    92,    81,    62,   368,
+-32768,    92,    92,    92,    92,    92,    92,    92,    92,    92,
+    92,-32768,   -33,   200,    70,-32768,    92,    92,    92,    92,
+    92,    92,    92,    92,    92,    92,    92,    92,    92,    92,
+    92,    92,-32768,   221,   112,   242,   368,   -35,   368,   -23,
+   263,   134,   156,   284,   368,-32768,-32768,   385,   401,   417,
+   417,   417,   417,   417,   417,    27,    27,    47,    47,   -33,
+   -33,   -33,   -33,-32768,    92,-32768,-32768,    92,-32768,    92,
+-32768,    92,    92,-32768,   305,   368,   368,   178,   326,-32768,
+    92,-32768,   347,-32768,    84,   113,-32768
+};
+
+static const short yypgoto[] = {-32768,
+-32768,    63,   -16,-32768,-32768
+};
+
+
+#define	YYLAST		453
+
+
+static const short yytable[] = {    33,
+    34,    52,    53,    87,    88,    54,    55,    56,    57,    59,
+    61,    62,    63,    64,    65,    89,    90,    21,    22,    23,
+    68,    69,    70,    71,    72,    73,    74,    75,    76,    77,
+    78,    79,    80,    81,    82,    83,    -6,     1,    24,    -6,
+    25,     2,     3,     4,     5,     6,     7,     8,     9,    10,
+    11,    12,    13,    14,    15,    47,    48,    49,    50,    51,
+    26,    52,    53,    27,    36,    28,    16,    29,    95,    30,
+    31,    96,    67,    97,    17,    98,    99,    49,    50,    51,
+    35,    52,    53,   106,   103,     2,     3,     4,     5,     6,
+     7,     8,     9,    10,    11,    12,    13,    14,    15,     5,
+     6,     7,     8,     9,    10,    11,    12,    13,    14,    32,
+    16,     0,   107,     0,     0,     0,     0,     0,    17,     0,
+     0,    16,     0,     0,     0,     0,     0,     0,     0,    17,
+    37,    38,    39,    40,    41,    42,    43,    44,    45,    46,
+    47,    48,    49,    50,    51,     0,    52,    53,     0,     0,
+     0,    85,    37,    38,    39,    40,    41,    42,    43,    44,
+    45,    46,    47,    48,    49,    50,    51,     0,    52,    53,
+     0,     0,     0,    92,    37,    38,    39,    40,    41,    42,
+    43,    44,    45,    46,    47,    48,    49,    50,    51,     0,
+    52,    53,     0,     0,     0,    93,    37,    38,    39,    40,
+    41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
+    51,     0,    52,    53,     0,     0,     0,   101,    37,    38,
+    39,    40,    41,    42,    43,    44,    45,    46,    47,    48,
+    49,    50,    51,     0,    52,    53,     0,     0,    66,    37,
+    38,    39,    40,    41,    42,    43,    44,    45,    46,    47,
+    48,    49,    50,    51,     0,    52,    53,     0,     0,    84,
+    37,    38,    39,    40,    41,    42,    43,    44,    45,    46,
+    47,    48,    49,    50,    51,     0,    52,    53,     0,     0,
+    86,    37,    38,    39,    40,    41,    42,    43,    44,    45,
+    46,    47,    48,    49,    50,    51,     0,    52,    53,     0,
+     0,    91,    37,    38,    39,    40,    41,    42,    43,    44,
+    45,    46,    47,    48,    49,    50,    51,     0,    52,    53,
+     0,     0,    94,    37,    38,    39,    40,    41,    42,    43,
+    44,    45,    46,    47,    48,    49,    50,    51,     0,    52,
+    53,     0,     0,   100,    37,    38,    39,    40,    41,    42,
+    43,    44,    45,    46,    47,    48,    49,    50,    51,     0,
+    52,    53,     0,     0,   102,    37,    38,    39,    40,    41,
+    42,    43,    44,    45,    46,    47,    48,    49,    50,    51,
+     0,    52,    53,     0,     0,   104,    37,    38,    39,    40,
+    41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
+    51,     0,    52,    53,    38,    39,    40,    41,    42,    43,
+    44,    45,    46,    47,    48,    49,    50,    51,     0,    52,
+    53,    39,    40,    41,    42,    43,    44,    45,    46,    47,
+    48,    49,    50,    51,     0,    52,    53,-32768,-32768,-32768,
+-32768,-32768,-32768,    45,    46,    47,    48,    49,    50,    51,
+     0,    52,    53
+};
+
+static const short yycheck[] = {    16,
+    17,    35,    36,    39,    40,    22,    23,    24,    25,    26,
+    27,    28,    29,    30,    31,    39,    40,     3,    38,    38,
+    37,    38,    39,    40,    41,    42,    43,    44,    45,    46,
+    47,    48,    49,    50,    51,    52,     0,     1,    38,     3,
+    38,     5,     6,     7,     8,     9,    10,    11,    12,    13,
+    14,    15,    16,    17,    18,    29,    30,    31,    32,    33,
+    38,    35,    36,    38,     3,    38,    30,    38,    85,    38,
+    37,    88,     3,    90,    38,    92,    93,    31,    32,    33,
+    18,    35,    36,     0,   101,     5,     6,     7,     8,     9,
+    10,    11,    12,    13,    14,    15,    16,    17,    18,     8,
+     9,    10,    11,    12,    13,    14,    15,    16,    17,    18,
+    30,    -1,     0,    -1,    -1,    -1,    -1,    -1,    38,    -1,
+    -1,    30,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    38,
+    19,    20,    21,    22,    23,    24,    25,    26,    27,    28,
+    29,    30,    31,    32,    33,    -1,    35,    36,    -1,    -1,
+    -1,    40,    19,    20,    21,    22,    23,    24,    25,    26,
+    27,    28,    29,    30,    31,    32,    33,    -1,    35,    36,
+    -1,    -1,    -1,    40,    19,    20,    21,    22,    23,    24,
+    25,    26,    27,    28,    29,    30,    31,    32,    33,    -1,
+    35,    36,    -1,    -1,    -1,    40,    19,    20,    21,    22,
+    23,    24,    25,    26,    27,    28,    29,    30,    31,    32,
+    33,    -1,    35,    36,    -1,    -1,    -1,    40,    19,    20,
+    21,    22,    23,    24,    25,    26,    27,    28,    29,    30,
+    31,    32,    33,    -1,    35,    36,    -1,    -1,    39,    19,
+    20,    21,    22,    23,    24,    25,    26,    27,    28,    29,
+    30,    31,    32,    33,    -1,    35,    36,    -1,    -1,    39,
+    19,    20,    21,    22,    23,    24,    25,    26,    27,    28,
+    29,    30,    31,    32,    33,    -1,    35,    36,    -1,    -1,
+    39,    19,    20,    21,    22,    23,    24,    25,    26,    27,
+    28,    29,    30,    31,    32,    33,    -1,    35,    36,    -1,
+    -1,    39,    19,    20,    21,    22,    23,    24,    25,    26,
+    27,    28,    29,    30,    31,    32,    33,    -1,    35,    36,
+    -1,    -1,    39,    19,    20,    21,    22,    23,    24,    25,
+    26,    27,    28,    29,    30,    31,    32,    33,    -1,    35,
+    36,    -1,    -1,    39,    19,    20,    21,    22,    23,    24,
+    25,    26,    27,    28,    29,    30,    31,    32,    33,    -1,
+    35,    36,    -1,    -1,    39,    19,    20,    21,    22,    23,
+    24,    25,    26,    27,    28,    29,    30,    31,    32,    33,
+    -1,    35,    36,    -1,    -1,    39,    19,    20,    21,    22,
+    23,    24,    25,    26,    27,    28,    29,    30,    31,    32,
+    33,    -1,    35,    36,    20,    21,    22,    23,    24,    25,
+    26,    27,    28,    29,    30,    31,    32,    33,    -1,    35,
+    36,    21,    22,    23,    24,    25,    26,    27,    28,    29,
+    30,    31,    32,    33,    -1,    35,    36,    21,    22,    23,
+    24,    25,    26,    27,    28,    29,    30,    31,    32,    33,
+    -1,    35,    36
+};
+/* -*-C-*-  Note some compilers choke on comments on `#line' lines.  */
+#line 3 "/usr/share/misc/bison.simple"
+/* This file comes from bison-1.28.  */
+
+/* Skeleton output parser for bison,
+   Copyright (C) 1984, 1989, 1990 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 program; if not, write to the Free Software
+   Foundation, Inc., 59 Temple Place - Suite 330,
+   Boston, MA 02111-1307, USA.  */
+
+/* As a special exception, when this file is copied by Bison into a
+   Bison output file, you may use that output file without restriction.
+   This special exception was added by the Free Software Foundation
+   in version 1.24 of Bison.  */
+
+/* This is the parser code that is written into each bison parser
+  when the %semantic_parser declaration is not specified in the grammar.
+  It was written by Richard Stallman by simplifying the hairy parser
+  used when %semantic_parser is specified.  */
+
+#ifndef YYSTACK_USE_ALLOCA
+#ifdef alloca
+#define YYSTACK_USE_ALLOCA
+#else /* alloca not defined */
+#ifdef __GNUC__
+#define YYSTACK_USE_ALLOCA
+#define alloca __builtin_alloca
+#else /* not GNU C.  */
+#if (!defined (__STDC__) && defined (sparc)) || defined (__sparc__) || defined (__sparc) || defined (__sgi) || (defined (__sun) && defined (__i386))
+#define YYSTACK_USE_ALLOCA
+#include <alloca.h>
+#else /* not sparc */
+/* We think this test detects Watcom and Microsoft C.  */
+/* This used to test MSDOS, but that is a bad idea
+   since that symbol is in the user namespace.  */
+#if (defined (_MSDOS) || defined (_MSDOS_)) && !defined (__TURBOC__)
+#if 0 /* No need for malloc.h, which pollutes the namespace;
+	 instead, just don't use alloca.  */
+#include <malloc.h>
+#endif
+#else /* not MSDOS, or __TURBOC__ */
+#if defined(_AIX)
+/* I don't know what this was needed for, but it pollutes the namespace.
+   So I turned it off.   rms, 2 May 1997.  */
+/* #include <malloc.h>  */
+ #pragma alloca
+#define YYSTACK_USE_ALLOCA
+#else /* not MSDOS, or __TURBOC__, or _AIX */
+#if 0
+#ifdef __hpux /* haible@ilog.fr says this works for HPUX 9.05 and up,
+		 and on HPUX 10.  Eventually we can turn this on.  */
+#define YYSTACK_USE_ALLOCA
+#define alloca __builtin_alloca
+#endif /* __hpux */
+#endif
+#endif /* not _AIX */
+#endif /* not MSDOS, or __TURBOC__ */
+#endif /* not sparc */
+#endif /* not GNU C */
+#endif /* alloca not defined */
+#endif /* YYSTACK_USE_ALLOCA not defined */
+
+#ifdef YYSTACK_USE_ALLOCA
+#define YYSTACK_ALLOC alloca
+#else
+#define YYSTACK_ALLOC malloc
+#endif
+
+/* Note: there must be only one dollar sign in this file.
+   It is replaced by the list of actions, each action
+   as one case of the switch.  */
+
+#define yyerrok		(yyerrstatus = 0)
+#define yyclearin	(yychar = YYEMPTY)
+#define YYEMPTY		-2
+#define YYEOF		0
+#define YYACCEPT	goto yyacceptlab
+#define YYABORT 	goto yyabortlab
+#define YYERROR		goto yyerrlab1
+/* Like YYERROR except do call yyerror.
+   This remains here temporarily to ease the
+   transition to the new meaning of YYERROR, for GCC.
+   Once GCC version 2 has supplanted version 1, this can go.  */
+#define YYFAIL		goto yyerrlab
+#define YYRECOVERING()  (!!yyerrstatus)
+#define YYBACKUP(token, value) \
+do								\
+  if (yychar == YYEMPTY && yylen == 1)				\
+    { yychar = (token), yylval = (value);			\
+      yychar1 = YYTRANSLATE (yychar);				\
+      YYPOPSTACK;						\
+      goto yybackup;						\
+    }								\
+  else								\
+    { yyerror ("syntax error: cannot back up"); YYERROR; }	\
+while (0)
+
+#define YYTERROR	1
+#define YYERRCODE	256
+
+#ifndef YYPURE
+#define YYLEX		yylex()
+#endif
+
+#ifdef YYPURE
+#ifdef YYLSP_NEEDED
+#ifdef YYLEX_PARAM
+#define YYLEX		yylex(&yylval, &yylloc, YYLEX_PARAM)
+#else
+#define YYLEX		yylex(&yylval, &yylloc)
+#endif
+#else /* not YYLSP_NEEDED */
+#ifdef YYLEX_PARAM
+#define YYLEX		yylex(&yylval, YYLEX_PARAM)
+#else
+#define YYLEX		yylex(&yylval)
+#endif
+#endif /* not YYLSP_NEEDED */
+#endif
+
+/* If nonreentrant, generate the variables here */
+
+#ifndef YYPURE
+
+int	yychar;			/*  the lookahead symbol		*/
+YYSTYPE	yylval;			/*  the semantic value of the		*/
+				/*  lookahead symbol			*/
+
+#ifdef YYLSP_NEEDED
+YYLTYPE yylloc;			/*  location data for the lookahead	*/
+				/*  symbol				*/
+#endif
+
+int yynerrs;			/*  number of parse errors so far       */
+#endif  /* not YYPURE */
+
+#if YYDEBUG != 0
+int yydebug;			/*  nonzero means print parse trace	*/
+/* Since this is uninitialized, it does not stop multiple parsers
+   from coexisting.  */
+#endif
+
+/*  YYINITDEPTH indicates the initial size of the parser's stacks	*/
+
+#ifndef	YYINITDEPTH
+#define YYINITDEPTH 200
+#endif
+
+/*  YYMAXDEPTH is the maximum size the stacks can grow to
+    (effective only if the built-in stack extension method is used).  */
+
+#if YYMAXDEPTH == 0
+#undef YYMAXDEPTH
+#endif
+
+#ifndef YYMAXDEPTH
+#define YYMAXDEPTH 10000
+#endif
+
+/* Define __yy_memcpy.  Note that the size argument
+   should be passed with type unsigned int, because that is what the non-GCC
+   definitions require.  With GCC, __builtin_memcpy takes an arg
+   of type size_t, but it can handle unsigned int.  */
+
+#if __GNUC__ > 1		/* GNU C and GNU C++ define this.  */
+#define __yy_memcpy(TO,FROM,COUNT)	__builtin_memcpy(TO,FROM,COUNT)
+#else				/* not GNU C or C++ */
+#ifndef __cplusplus
+
+/* This is the most reliable way to avoid incompatibilities
+   in available built-in functions on various systems.  */
+static void
+__yy_memcpy (to, from, count)
+     char *to;
+     char *from;
+     unsigned int count;
+{
+  register char *f = from;
+  register char *t = to;
+  register int i = count;
+
+  while (i-- > 0)
+    *t++ = *f++;
+}
+
+#else /* __cplusplus */
+
+/* This is the most reliable way to avoid incompatibilities
+   in available built-in functions on various systems.  */
+static void
+__yy_memcpy (char *to, char *from, unsigned int count)
+{
+  register char *t = to;
+  register char *f = from;
+  register int i = count;
+
+  while (i-- > 0)
+    *t++ = *f++;
+}
+
+#endif
+#endif
+
+#line 217 "/usr/share/misc/bison.simple"
+
+/* The user can define YYPARSE_PARAM as the name of an argument to be passed
+   into yyparse.  The argument should have type void *.
+   It should actually point to an object.
+   Grammar actions can access the variable by casting it
+   to the proper pointer type.  */
+
+#ifdef YYPARSE_PARAM
+#ifdef __cplusplus
+#define YYPARSE_PARAM_ARG void *YYPARSE_PARAM
+#define YYPARSE_PARAM_DECL
+#else /* not __cplusplus */
+#define YYPARSE_PARAM_ARG YYPARSE_PARAM
+#define YYPARSE_PARAM_DECL void *YYPARSE_PARAM;
+#endif /* not __cplusplus */
+#else /* not YYPARSE_PARAM */
+#define YYPARSE_PARAM_ARG
+#define YYPARSE_PARAM_DECL
+#endif /* not YYPARSE_PARAM */
+
+/* Prevent warning if -Wstrict-prototypes.  */
+#ifdef __GNUC__
+#ifdef YYPARSE_PARAM
+int yyparse (void *);
+#else
+int yyparse (void);
+#endif
+#endif
+
+int
+yyparse(YYPARSE_PARAM_ARG)
+     YYPARSE_PARAM_DECL
+{
+  register int yystate;
+  register int yyn;
+  register short *yyssp;
+  register YYSTYPE *yyvsp;
+  int yyerrstatus;	/*  number of tokens to shift before error messages enabled */
+  int yychar1 = 0;		/*  lookahead token as an internal (translated) token number */
+
+  short	yyssa[YYINITDEPTH];	/*  the state stack			*/
+  YYSTYPE yyvsa[YYINITDEPTH];	/*  the semantic value stack		*/
+
+  short *yyss = yyssa;		/*  refer to the stacks thru separate pointers */
+  YYSTYPE *yyvs = yyvsa;	/*  to allow yyoverflow to reallocate them elsewhere */
+
+#ifdef YYLSP_NEEDED
+  YYLTYPE yylsa[YYINITDEPTH];	/*  the location stack			*/
+  YYLTYPE *yyls = yylsa;
+  YYLTYPE *yylsp;
+
+#define YYPOPSTACK   (yyvsp--, yyssp--, yylsp--)
+#else
+#define YYPOPSTACK   (yyvsp--, yyssp--)
+#endif
+
+  int yystacksize = YYINITDEPTH;
+  int yyfree_stacks = 0;
+
+#ifdef YYPURE
+  int yychar;
+  YYSTYPE yylval;
+  int yynerrs;
+#ifdef YYLSP_NEEDED
+  YYLTYPE yylloc;
+#endif
+#endif
+
+  YYSTYPE yyval;		/*  the variable used to return		*/
+				/*  semantic values from the action	*/
+				/*  routines				*/
+
+  int yylen;
+
+#if YYDEBUG != 0
+  if (yydebug)
+    fprintf(stderr, "Starting parse\n");
+#endif
+
+  yystate = 0;
+  yyerrstatus = 0;
+  yynerrs = 0;
+  yychar = YYEMPTY;		/* Cause a token to be read.  */
+
+  /* Initialize stack pointers.
+     Waste one element of value and location stack
+     so that they stay on the same level as the state stack.
+     The wasted elements are never initialized.  */
+
+  yyssp = yyss - 1;
+  yyvsp = yyvs;
+#ifdef YYLSP_NEEDED
+  yylsp = yyls;
+#endif
+
+/* Push a new state, which is found in  yystate  .  */
+/* In all cases, when you get here, the value and location stacks
+   have just been pushed. so pushing a state here evens the stacks.  */
+yynewstate:
+
+  *++yyssp = yystate;
+
+  if (yyssp >= yyss + yystacksize - 1)
+    {
+      /* Give user a chance to reallocate the stack */
+      /* Use copies of these so that the &'s don't force the real ones into memory. */
+      YYSTYPE *yyvs1 = yyvs;
+      short *yyss1 = yyss;
+#ifdef YYLSP_NEEDED
+      YYLTYPE *yyls1 = yyls;
+#endif
+
+      /* Get the current used size of the three stacks, in elements.  */
+      int size = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+      /* Each stack pointer address is followed by the size of
+	 the data in use in that stack, in bytes.  */
+#ifdef YYLSP_NEEDED
+      /* This used to be a conditional around just the two extra args,
+	 but that might be undefined if yyoverflow is a macro.  */
+      yyoverflow("parser stack overflow",
+		 &yyss1, size * sizeof (*yyssp),
+		 &yyvs1, size * sizeof (*yyvsp),
+		 &yyls1, size * sizeof (*yylsp),
+		 &yystacksize);
+#else
+      yyoverflow("parser stack overflow",
+		 &yyss1, size * sizeof (*yyssp),
+		 &yyvs1, size * sizeof (*yyvsp),
+		 &yystacksize);
+#endif
+
+      yyss = yyss1; yyvs = yyvs1;
+#ifdef YYLSP_NEEDED
+      yyls = yyls1;
+#endif
+#else /* no yyoverflow */
+      /* Extend the stack our own way.  */
+      if (yystacksize >= YYMAXDEPTH)
+	{
+	  yyerror("parser stack overflow");
+	  if (yyfree_stacks)
+	    {
+	      free (yyss);
+	      free (yyvs);
+#ifdef YYLSP_NEEDED
+	      free (yyls);
+#endif
+	    }
+	  return 2;
+	}
+      yystacksize *= 2;
+      if (yystacksize > YYMAXDEPTH)
+	yystacksize = YYMAXDEPTH;
+#ifndef YYSTACK_USE_ALLOCA
+      yyfree_stacks = 1;
+#endif
+      yyss = (short *) YYSTACK_ALLOC (yystacksize * sizeof (*yyssp));
+      __yy_memcpy ((char *)yyss, (char *)yyss1,
+		   size * (unsigned int) sizeof (*yyssp));
+      yyvs = (YYSTYPE *) YYSTACK_ALLOC (yystacksize * sizeof (*yyvsp));
+      __yy_memcpy ((char *)yyvs, (char *)yyvs1,
+		   size * (unsigned int) sizeof (*yyvsp));
+#ifdef YYLSP_NEEDED
+      yyls = (YYLTYPE *) YYSTACK_ALLOC (yystacksize * sizeof (*yylsp));
+      __yy_memcpy ((char *)yyls, (char *)yyls1,
+		   size * (unsigned int) sizeof (*yylsp));
+#endif
+#endif /* no yyoverflow */
+
+      yyssp = yyss + size - 1;
+      yyvsp = yyvs + size - 1;
+#ifdef YYLSP_NEEDED
+      yylsp = yyls + size - 1;
+#endif
+
+#if YYDEBUG != 0
+      if (yydebug)
+	fprintf(stderr, "Stack size increased to %d\n", yystacksize);
+#endif
+
+      if (yyssp >= yyss + yystacksize - 1)
+	YYABORT;
+    }
+
+#if YYDEBUG != 0
+  if (yydebug)
+    fprintf(stderr, "Entering state %d\n", yystate);
+#endif
+
+  goto yybackup;
+ yybackup:
+
+/* Do appropriate processing given the current state.  */
+/* Read a lookahead token if we need one and don't already have one.  */
+/* yyresume: */
+
+  /* First try to decide what to do without reference to lookahead token.  */
+
+  yyn = yypact[yystate];
+  if (yyn == YYFLAG)
+    goto yydefault;
+
+  /* Not known => get a lookahead token if don't already have one.  */
+
+  /* yychar is either YYEMPTY or YYEOF
+     or a valid token in external form.  */
+
+  if (yychar == YYEMPTY)
+    {
+#if YYDEBUG != 0
+      if (yydebug)
+	fprintf(stderr, "Reading a token: ");
+#endif
+      yychar = YYLEX;
+    }
+
+  /* Convert token to internal form (in yychar1) for indexing tables with */
+
+  if (yychar <= 0)		/* This means end of input. */
+    {
+      yychar1 = 0;
+      yychar = YYEOF;		/* Don't call YYLEX any more */
+
+#if YYDEBUG != 0
+      if (yydebug)
+	fprintf(stderr, "Now at end of input.\n");
+#endif
+    }
+  else
+    {
+      yychar1 = YYTRANSLATE(yychar);
+
+#if YYDEBUG != 0
+      if (yydebug)
+	{
+	  fprintf (stderr, "Next token is %d (%s", yychar, yytname[yychar1]);
+	  /* Give the individual parser a way to print the precise meaning
+	     of a token, for further debugging info.  */
+#ifdef YYPRINT
+	  YYPRINT (stderr, yychar, yylval);
+#endif
+	  fprintf (stderr, ")\n");
+	}
+#endif
+    }
+
+  yyn += yychar1;
+  if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != yychar1)
+    goto yydefault;
+
+  yyn = yytable[yyn];
+
+  /* yyn is what to do for this token type in this state.
+     Negative => reduce, -yyn is rule number.
+     Positive => shift, yyn is new state.
+       New state is final state => don't bother to shift,
+       just return success.
+     0, or most negative number => error.  */
+
+  if (yyn < 0)
+    {
+      if (yyn == YYFLAG)
+	goto yyerrlab;
+      yyn = -yyn;
+      goto yyreduce;
+    }
+  else if (yyn == 0)
+    goto yyerrlab;
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  /* Shift the lookahead token.  */
+
+#if YYDEBUG != 0
+  if (yydebug)
+    fprintf(stderr, "Shifting token %d (%s), ", yychar, yytname[yychar1]);
+#endif
+
+  /* Discard the token being shifted unless it is eof.  */
+  if (yychar != YYEOF)
+    yychar = YYEMPTY;
+
+  *++yyvsp = yylval;
+#ifdef YYLSP_NEEDED
+  *++yylsp = yylloc;
+#endif
+
+  /* count tokens shifted since error; after three, turn off error status.  */
+  if (yyerrstatus) yyerrstatus--;
+
+  yystate = yyn;
+  goto yynewstate;
+
+/* Do the default action for the current state.  */
+yydefault:
+
+  yyn = yydefact[yystate];
+  if (yyn == 0)
+    goto yyerrlab;
+
+/* Do a reduction.  yyn is the number of a rule to reduce with.  */
+yyreduce:
+  yylen = yyr2[yyn];
+  if (yylen > 0)
+    yyval = yyvsp[1-yylen]; /* implement default value of the action */
+
+#if YYDEBUG != 0
+  if (yydebug)
+    {
+      int i;
+
+      fprintf (stderr, "Reducing via rule %d (line %d), ",
+	       yyn, yyrline[yyn]);
+
+      /* Print the symbols being reduced, and their result.  */
+      for (i = yyprhs[yyn]; yyrhs[i] > 0; i++)
+	fprintf (stderr, "%s ", yytname[yyrhs[i]]);
+      fprintf (stderr, " -> %s\n", yytname[yyr1[yyn]]);
+    }
+#endif
+
+
+  switch (yyn) {
+
+case 5:
+#line 186 "calc.y"
+{ sp = stack[0]; yyerrok; ;
+    break;}
+case 7:
+#line 190 "calc.y"
+{
+      mpz_out_str (stdout, obase, sp); putchar ('\n');
+      sp--;
+      CHECK_EMPTY ();
+    ;
+    break;}
+case 8:
+#line 195 "calc.y"
+{
+      CHECK_VARIABLE (yyvsp[-2].var);
+      mpz_swap (variable[yyvsp[-2].var], sp);
+      sp--;
+      CHECK_EMPTY ();
+    ;
+    break;}
+case 9:
+#line 201 "calc.y"
+{ ibase = 16; obase = -16; ;
+    break;}
+case 10:
+#line 202 "calc.y"
+{ ibase = 0;  obase = 10; ;
+    break;}
+case 11:
+#line 203 "calc.y"
+{ exit (0); ;
+    break;}
+case 13:
+#line 210 "calc.y"
+{ sp--; mpz_add    (sp, sp, sp+1); ;
+    break;}
+case 14:
+#line 211 "calc.y"
+{ sp--; mpz_sub    (sp, sp, sp+1); ;
+    break;}
+case 15:
+#line 212 "calc.y"
+{ sp--; mpz_mul    (sp, sp, sp+1); ;
+    break;}
+case 16:
+#line 213 "calc.y"
+{ sp--; mpz_fdiv_q (sp, sp, sp+1); ;
+    break;}
+case 17:
+#line 214 "calc.y"
+{ sp--; mpz_fdiv_r (sp, sp, sp+1); ;
+    break;}
+case 18:
+#line 215 "calc.y"
+{ CHECK_UI ("exponentiation", sp);
+                     sp--; mpz_pow_ui (sp, sp, mpz_get_ui (sp+1)); ;
+    break;}
+case 19:
+#line 217 "calc.y"
+{ CHECK_UI ("lshift", sp);
+                     sp--; mpz_mul_2exp (sp, sp, mpz_get_ui (sp+1)); ;
+    break;}
+case 20:
+#line 219 "calc.y"
+{ CHECK_UI ("rshift", sp);
+                     sp--; mpz_fdiv_q_2exp (sp, sp, mpz_get_ui (sp+1)); ;
+    break;}
+case 21:
+#line 221 "calc.y"
+{ CHECK_UI ("factorial", sp);
+                     mpz_fac_ui (sp, mpz_get_ui (sp)); ;
+    break;}
+case 22:
+#line 223 "calc.y"
+{ mpz_neg (sp, sp); ;
+    break;}
+case 23:
+#line 225 "calc.y"
+{ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) <  0); ;
+    break;}
+case 24:
+#line 226 "calc.y"
+{ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) <= 0); ;
+    break;}
+case 25:
+#line 227 "calc.y"
+{ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) == 0); ;
+    break;}
+case 26:
+#line 228 "calc.y"
+{ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) != 0); ;
+    break;}
+case 27:
+#line 229 "calc.y"
+{ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) >= 0); ;
+    break;}
+case 28:
+#line 230 "calc.y"
+{ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) >  0); ;
+    break;}
+case 29:
+#line 232 "calc.y"
+{ sp--; mpz_set_ui (sp, mpz_sgn (sp) && mpz_sgn (sp+1)); ;
+    break;}
+case 30:
+#line 233 "calc.y"
+{ sp--; mpz_set_ui (sp, mpz_sgn (sp) || mpz_sgn (sp+1)); ;
+    break;}
+case 31:
+#line 235 "calc.y"
+{ mpz_abs (sp, sp); ;
+    break;}
+case 32:
+#line 236 "calc.y"
+{ sp--; CHECK_UI ("binomial", sp+1);
+                                    mpz_bin_ui (sp, sp, mpz_get_ui (sp+1)); ;
+    break;}
+case 33:
+#line 238 "calc.y"
+{ CHECK_UI ("fibonacci", sp);
+                                    mpz_fib_ui (sp, mpz_get_ui (sp)); ;
+    break;}
+case 36:
+#line 242 "calc.y"
+{ mpz_nextprime (sp, sp); ;
+    break;}
+case 37:
+#line 243 "calc.y"
+{ sp -= 2; mpz_powm (sp, sp, sp+1, sp+2); ;
+    break;}
+case 38:
+#line 244 "calc.y"
+{ sp--; CHECK_UI ("nth-root", sp+1);
+                                    mpz_root (sp, sp, mpz_get_ui (sp+1)); ;
+    break;}
+case 39:
+#line 246 "calc.y"
+{ mpz_sqrt (sp, sp); ;
+    break;}
+case 40:
+#line 248 "calc.y"
+{
+        sp++;
+        CHECK_OVERFLOW ();
+        CHECK_VARIABLE (yyvsp[0].var);
+        mpz_set (sp, variable[yyvsp[0].var]);
+      ;
+    break;}
+case 41:
+#line 254 "calc.y"
+{
+        sp++;
+        CHECK_OVERFLOW ();
+        if (mpz_set_str (sp, yyvsp[0].str, ibase) != 0)
+          {
+            fprintf (stderr, "Invalid number: %s\n", yyvsp[0].str);
+            YYERROR;
+          }
+      ;
+    break;}
+case 43:
+#line 266 "calc.y"
+{ sp--; mpz_gcd (sp, sp, sp+1); ;
+    break;}
+case 45:
+#line 270 "calc.y"
+{ sp--; mpz_lcm (sp, sp, sp+1); ;
+    break;}
+}
+   /* the action file gets copied in in place of this dollarsign */
+#line 543 "/usr/share/misc/bison.simple"
+
+  yyvsp -= yylen;
+  yyssp -= yylen;
+#ifdef YYLSP_NEEDED
+  yylsp -= yylen;
+#endif
+
+#if YYDEBUG != 0
+  if (yydebug)
+    {
+      short *ssp1 = yyss - 1;
+      fprintf (stderr, "state stack now");
+      while (ssp1 != yyssp)
+	fprintf (stderr, " %d", *++ssp1);
+      fprintf (stderr, "\n");
+    }
+#endif
+
+  *++yyvsp = yyval;
+
+#ifdef YYLSP_NEEDED
+  yylsp++;
+  if (yylen == 0)
+    {
+      yylsp->first_line = yylloc.first_line;
+      yylsp->first_column = yylloc.first_column;
+      yylsp->last_line = (yylsp-1)->last_line;
+      yylsp->last_column = (yylsp-1)->last_column;
+      yylsp->text = 0;
+    }
+  else
+    {
+      yylsp->last_line = (yylsp+yylen-1)->last_line;
+      yylsp->last_column = (yylsp+yylen-1)->last_column;
+    }
+#endif
+
+  /* Now "shift" the result of the reduction.
+     Determine what state that goes to,
+     based on the state we popped back to
+     and the rule number reduced by.  */
+
+  yyn = yyr1[yyn];
+
+  yystate = yypgoto[yyn - YYNTBASE] + *yyssp;
+  if (yystate >= 0 && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+    yystate = yytable[yystate];
+  else
+    yystate = yydefgoto[yyn - YYNTBASE];
+
+  goto yynewstate;
+
+yyerrlab:   /* here on detecting error */
+
+  if (! yyerrstatus)
+    /* If not already recovering from an error, report this error.  */
+    {
+      ++yynerrs;
+
+#ifdef YYERROR_VERBOSE
+      yyn = yypact[yystate];
+
+      if (yyn > YYFLAG && yyn < YYLAST)
+	{
+	  int size = 0;
+	  char *msg;
+	  int x, count;
+
+	  count = 0;
+	  /* Start X at -yyn if nec to avoid negative indexes in yycheck.  */
+	  for (x = (yyn < 0 ? -yyn : 0);
+	       x < (sizeof(yytname) / sizeof(char *)); x++)
+	    if (yycheck[x + yyn] == x)
+	      size += strlen(yytname[x]) + 15, count++;
+	  msg = (char *) malloc(size + 15);
+	  if (msg != 0)
+	    {
+	      strcpy(msg, "parse error");
+
+	      if (count < 5)
+		{
+		  count = 0;
+		  for (x = (yyn < 0 ? -yyn : 0);
+		       x < (sizeof(yytname) / sizeof(char *)); x++)
+		    if (yycheck[x + yyn] == x)
+		      {
+			strcat(msg, count == 0 ? ", expecting `" : " or `");
+			strcat(msg, yytname[x]);
+			strcat(msg, "'");
+			count++;
+		      }
+		}
+	      yyerror(msg);
+	      free(msg);
+	    }
+	  else
+	    yyerror ("parse error; also virtual memory exceeded");
+	}
+      else
+#endif /* YYERROR_VERBOSE */
+	yyerror("parse error");
+    }
+
+  goto yyerrlab1;
+yyerrlab1:   /* here on error raised explicitly by an action */
+
+  if (yyerrstatus == 3)
+    {
+      /* if just tried and failed to reuse lookahead token after an error, discard it.  */
+
+      /* return failure if at end of input */
+      if (yychar == YYEOF)
+	YYABORT;
+
+#if YYDEBUG != 0
+      if (yydebug)
+	fprintf(stderr, "Discarding token %d (%s).\n", yychar, yytname[yychar1]);
+#endif
+
+      yychar = YYEMPTY;
+    }
+
+  /* Else will try to reuse lookahead token
+     after shifting the error token.  */
+
+  yyerrstatus = 3;		/* Each real token shifted decrements this */
+
+  goto yyerrhandle;
+
+yyerrdefault:  /* current state does not do anything special for the error token. */
+
+#if 0
+  /* This is wrong; only states that explicitly want error tokens
+     should shift them.  */
+  yyn = yydefact[yystate];  /* If its default is to accept any token, ok.  Otherwise pop it.*/
+  if (yyn) goto yydefault;
+#endif
+
+yyerrpop:   /* pop the current state because it cannot handle the error token */
+
+  if (yyssp == yyss) YYABORT;
+  yyvsp--;
+  yystate = *--yyssp;
+#ifdef YYLSP_NEEDED
+  yylsp--;
+#endif
+
+#if YYDEBUG != 0
+  if (yydebug)
+    {
+      short *ssp1 = yyss - 1;
+      fprintf (stderr, "Error: state stack now");
+      while (ssp1 != yyssp)
+	fprintf (stderr, " %d", *++ssp1);
+      fprintf (stderr, "\n");
+    }
+#endif
+
+yyerrhandle:
+
+  yyn = yypact[yystate];
+  if (yyn == YYFLAG)
+    goto yyerrdefault;
+
+  yyn += YYTERROR;
+  if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != YYTERROR)
+    goto yyerrdefault;
+
+  yyn = yytable[yyn];
+  if (yyn < 0)
+    {
+      if (yyn == YYFLAG)
+	goto yyerrpop;
+      yyn = -yyn;
+      goto yyreduce;
+    }
+  else if (yyn == 0)
+    goto yyerrpop;
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+#if YYDEBUG != 0
+  if (yydebug)
+    fprintf(stderr, "Shifting error token, ");
+#endif
+
+  *++yyvsp = yylval;
+#ifdef YYLSP_NEEDED
+  *++yylsp = yylloc;
+#endif
+
+  yystate = yyn;
+  goto yynewstate;
+
+ yyacceptlab:
+  /* YYACCEPT comes here.  */
+  if (yyfree_stacks)
+    {
+      free (yyss);
+      free (yyvs);
+#ifdef YYLSP_NEEDED
+      free (yyls);
+#endif
+    }
+  return 0;
+
+ yyabortlab:
+  /* YYABORT comes here.  */
+  if (yyfree_stacks)
+    {
+      free (yyss);
+      free (yyvs);
+#ifdef YYLSP_NEEDED
+      free (yyls);
+#endif
+    }
+  return 1;
+}
+#line 272 "calc.y"
+
+
+yyerror (char *s)
+{
+  fprintf (stderr, "%s\n", s);
+}
+
+int
+main (void)
+{
+  int  i;
+
+  for (i = 0; i < numberof (variable); i++)
+    mpz_init (variable[i]);
+
+  for (i = 0; i < numberof (stack); i++)
+    mpz_init (stack[i]);
+
+  return yyparse ();
+}
diff --git a/src/gmp/demos/calc.h b/src/gmp/demos/calc.h
new file mode 100644
index 000000000..98e745a8d
--- /dev/null
+++ b/src/gmp/demos/calc.h
@@ -0,0 +1,32 @@
+typedef union {
+  char  *str;
+  int   var;
+} YYSTYPE;
+#define	EOS	257
+#define	BAD	258
+#define	HEX	259
+#define	DECIMAL	260
+#define	QUIT	261
+#define	ABS	262
+#define	BIN	263
+#define	FIB	264
+#define	GCD	265
+#define	LCM	266
+#define	NEXTPRIME	267
+#define	POWM	268
+#define	ROOT	269
+#define	SQRT	270
+#define	NUMBER	271
+#define	VARIABLE	272
+#define	LOR	273
+#define	LAND	274
+#define	EQ	275
+#define	NE	276
+#define	LE	277
+#define	GE	278
+#define	LSHIFT	279
+#define	RSHIFT	280
+#define	UMINUS	281
+
+
+extern YYSTYPE yylval;
diff --git a/src/gmp/demos/calc.y b/src/gmp/demos/calc.y
new file mode 100644
index 000000000..da5c5217c
--- /dev/null
+++ b/src/gmp/demos/calc.y
@@ -0,0 +1,291 @@
+/* A simple integer desk calculator using yacc and gmp. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+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.
+*/
+
+
+/* This is a simple program, meant only to show one way to use GMP for this
+   sort of thing.  There's few features, and error checking is minimal.
+   Standard input is read, there's no command line options.
+
+   Examples:
+       2+3*4        expressions are evaluated
+       x=5^6        variables a to z can be set and used
+
+   Operators:
+       + - *        arithmetic
+       / %          division and remainder (rounding towards negative infinity)
+       ^            exponentiation
+       !            factorial
+       << >>        left and right shifts
+       <= >= >      \ comparisons, giving 1 if true, 0 if false
+       == != <      /
+       && ||        logical and/or, giving 1 if true, 0 if false
+
+   Functions:
+       abs(n)       absolute value
+       bin(n,m)     binomial coefficient
+       fib(n)       fibonacci number
+       gcd(a,b,..)  greatest common divisor
+       lcm(a,b,..)  least common multiple
+       nextprime(n) next prime after n
+       powm(b,e,m)  modulo powering, b^e%m
+       root(n,r)    r-th root (rounded down)
+       sqrt(n)      square root (rounded down)
+
+   Other:
+       hex          \ set hex or decimal for input and output
+       decimal      /   ("0x" can be used for hex too)
+       quit         exit program (EOF works too)
+       ;            statements are separated with a ; or newline
+       \            continue expressions with \ before newline
+       # xxx        comments are # though to newline
+
+   Hex numbers must be entered in upper case, to distinguish them from the
+   variables a to f (like in bc).
+
+
+   Expressions are evaluated as they're read.  If user defined functions
+   were wanted it'd be necessary to build a parse tree like pexpr.c does, or
+   a list of operations for a stack based evaluator.  That would also make
+   it possible to detect and optimize evaluations "mod m" like pexpr.c does.
+
+   A stack is used for intermediate values in the expression evaluation,
+   separate from the yacc parser stack.  This is simple, makes error
+   recovery easy, minimizes the junk around mpz calls in the rules, and
+   saves initializing or clearing "mpz_t"s during a calculation.  A
+   disadvantage though is that variables must be copied to the stack to be
+   worked on.  A more sophisticated calculator or language system might be
+   able to avoid that when executing a compiled or semi-compiled form.
+
+   Avoiding repeated initializing and clearing of "mpz_t"s is important.  In
+   this program the time spent parsing is obviously much greater than any
+   possible saving from this, but a proper calculator or language should
+   take some trouble over it.  Don't be surprised if an init/clear takes 3
+   or more times as long as a 10 limb addition, depending on the system (see
+   the mpz_init_realloc_clear example in tune/README).
+
+   In a calculator or language using dynamic memory allocation, a good idea
+   would be to keep some "mpz_t"s on a free list.  A structure like the
+   following is effectively an "mpz_t" with an extra field tacked on the end
+   for that purpose.
+
+           struct foo {
+             mpz_t       z;
+             struct foo  *next;
+           };
+
+   A pointer "struct foo *p" used as "p->z" will be just a type-safe cast.
+   With care a free list could be made thread safe, and it should never be
+   larger than the deepest nested calculation.  */
+
+
+%{
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "gmp.h"
+
+#define numberof(x)  (sizeof (x) / sizeof ((x)[0]))
+
+
+int  ibase = 0;
+int  obase = 10;
+
+
+/* The stack is a fixed size, which means there's a limit on the nesting
+   allowed in expressions.  A more sophisticated program could let it grow
+   dynamically.  */
+
+mpz_t    stack[100];
+mpz_ptr  sp = stack[0];
+
+#define CHECK_OVERFLOW()                                                  \
+  if (sp >= stack[numberof(stack)])                                       \
+    {                                                                     \
+      fprintf (stderr,                                                    \
+               "Value stack overflow, too much nesting in expression\n"); \
+      YYERROR;                                                            \
+    }
+
+#define CHECK_EMPTY()                                                   \
+  if (sp != stack[0])                                                   \
+    {                                                                   \
+      fprintf (stderr, "Oops, expected the value stack to be empty\n"); \
+      sp = stack[0];                                                    \
+    }
+
+
+mpz_t  variable[26];
+
+#define CHECK_VARIABLE(var)                                             \
+  if ((var) < 0 || (var) >= numberof (variable))                        \
+    {                                                                   \
+      fprintf (stderr, "Oops, bad variable somehow: %d\n", var);        \
+      YYERROR;                                                          \
+    }
+
+
+#define CHECK_UI(name,z)                                                   \
+  if (! mpz_fits_ulong_p (z))                                              \
+    {                                                                      \
+      fprintf (stderr,                                                     \
+               "Operand must fit in an \"unsigned long\" for %s\n", name); \
+      YYERROR;                                                             \
+    }
+
+%}
+
+%union {
+  char  *str;
+  int   var;
+}
+
+%token EOS BAD
+%token HEX DECIMAL QUIT
+%token ABS BIN FIB GCD LCM NEXTPRIME POWM ROOT SQRT
+%token <str> NUMBER
+%token <var> VARIABLE
+
+/* operators, increasing precedence */
+%left     LOR
+%left     LAND
+%nonassoc '<' '>' EQ NE LE GE
+%left     LSHIFT RSHIFT
+%left     '+' '-'
+%left     '*' '/' '%'
+%nonassoc UMINUS
+%right    '^'
+%nonassoc '!'
+
+%%
+
+top:
+  statement
+  | statements statement
+
+statements:
+  statement EOS
+  | statements statement EOS
+  | error EOS ={ sp = stack[0]; yyerrok; }
+
+statement:
+  /* empty */
+  | e ={
+      mpz_out_str (stdout, obase, sp); putchar ('\n');
+      sp--;
+      CHECK_EMPTY ();
+    }
+  | VARIABLE '=' e ={
+      CHECK_VARIABLE ($1);
+      mpz_swap (variable[$1], sp);
+      sp--;
+      CHECK_EMPTY ();
+    }
+  | HEX     ={ ibase = 16; obase = -16; }
+  | DECIMAL ={ ibase = 0;  obase = 10; }
+  | QUIT    ={ exit (0); }
+
+/* "e" leaves it's value on the top of the mpz stack.  A rule like "e '+' e"
+   will have done a reduction for the first "e" first and the second "e"
+   second, so the code receives the values in that order on the stack.  */
+e:
+    '(' e ')'     /* value on stack */
+    | e '+' e     ={ sp--; mpz_add    (sp, sp, sp+1); }
+    | e '-' e     ={ sp--; mpz_sub    (sp, sp, sp+1); }
+    | e '*' e     ={ sp--; mpz_mul    (sp, sp, sp+1); }
+    | e '/' e     ={ sp--; mpz_fdiv_q (sp, sp, sp+1); }
+    | e '%' e     ={ sp--; mpz_fdiv_r (sp, sp, sp+1); }
+    | e '^' e     ={ CHECK_UI ("exponentiation", sp);
+                     sp--; mpz_pow_ui (sp, sp, mpz_get_ui (sp+1)); }
+    | e LSHIFT e  ={ CHECK_UI ("lshift", sp);
+                     sp--; mpz_mul_2exp (sp, sp, mpz_get_ui (sp+1)); }
+    | e RSHIFT e  ={ CHECK_UI ("rshift", sp);
+                     sp--; mpz_fdiv_q_2exp (sp, sp, mpz_get_ui (sp+1)); }
+    | e '!'       ={ CHECK_UI ("factorial", sp);
+                     mpz_fac_ui (sp, mpz_get_ui (sp)); }
+    | '-' e %prec UMINUS   ={ mpz_neg (sp, sp); }
+
+    | e '<' e     ={ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) <  0); }
+    | e LE  e     ={ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) <= 0); }
+    | e EQ  e     ={ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) == 0); }
+    | e NE  e     ={ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) != 0); }
+    | e GE  e     ={ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) >= 0); }
+    | e '>' e     ={ sp--; mpz_set_ui (sp, mpz_cmp (sp, sp+1) >  0); }
+
+    | e LAND e    ={ sp--; mpz_set_ui (sp, mpz_sgn (sp) && mpz_sgn (sp+1)); }
+    | e LOR e     ={ sp--; mpz_set_ui (sp, mpz_sgn (sp) || mpz_sgn (sp+1)); }
+
+    | ABS '(' e ')'              ={ mpz_abs (sp, sp); }
+    | BIN '(' e ',' e ')'        ={ sp--; CHECK_UI ("binomial", sp+1);
+                                    mpz_bin_ui (sp, sp, mpz_get_ui (sp+1)); }
+    | FIB '(' e ')'              ={ CHECK_UI ("fibonacci", sp);
+                                    mpz_fib_ui (sp, mpz_get_ui (sp)); }
+    | GCD '(' gcdlist ')'        /* value on stack */
+    | LCM '(' lcmlist ')'        /* value on stack */
+    | NEXTPRIME '(' e ')'        ={ mpz_nextprime (sp, sp); }
+    | POWM '(' e ',' e ',' e ')' ={ sp -= 2; mpz_powm (sp, sp, sp+1, sp+2); }
+    | ROOT '(' e ',' e ')'       ={ sp--; CHECK_UI ("nth-root", sp+1);
+                                    mpz_root (sp, sp, mpz_get_ui (sp+1)); }
+    | SQRT '(' e ')'             ={ mpz_sqrt (sp, sp); }
+
+    | VARIABLE ={
+        sp++;
+        CHECK_OVERFLOW ();
+        CHECK_VARIABLE ($1);
+        mpz_set (sp, variable[$1]);
+      }
+    | NUMBER ={
+        sp++;
+        CHECK_OVERFLOW ();
+        if (mpz_set_str (sp, $1, ibase) != 0)
+          {
+            fprintf (stderr, "Invalid number: %s\n", $1);
+            YYERROR;
+          }
+      }
+
+gcdlist:
+    e                /* value on stack */
+    | gcdlist ',' e  ={ sp--; mpz_gcd (sp, sp, sp+1); }
+
+lcmlist:
+    e                /* value on stack */
+    | lcmlist ',' e  ={ sp--; mpz_lcm (sp, sp, sp+1); }
+
+%%
+
+yyerror (char *s)
+{
+  fprintf (stderr, "%s\n", s);
+}
+
+int
+main (void)
+{
+  int  i;
+
+  for (i = 0; i < numberof (variable); i++)
+    mpz_init (variable[i]);
+
+  for (i = 0; i < numberof (stack); i++)
+    mpz_init (stack[i]);
+
+  return yyparse ();
+}
diff --git a/src/gmp/demos/calclex.c b/src/gmp/demos/calclex.c
new file mode 100644
index 000000000..d782c9028
--- /dev/null
+++ b/src/gmp/demos/calclex.c
@@ -0,0 +1,1671 @@
+#line 2 "calclex.c"
+/* A lexical scanner generated by flex */
+
+/* Scanner skeleton version:
+ * $FreeBSD: src/usr.bin/lex/skel.c,v 1.2.2.1 1999/08/29 15:29:33 peter Exp $
+ */
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+
+#include <stdio.h>
+
+
+/* cfront 1.2 defines "c_plusplus" instead of "__cplusplus" */
+#ifdef c_plusplus
+#ifndef __cplusplus
+#define __cplusplus
+#endif
+#endif
+
+
+#ifdef __cplusplus
+
+#include <stdlib.h>
+#include <unistd.h>
+
+/* Use prototypes in function declarations. */
+#define YY_USE_PROTOS
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else	/* ! __cplusplus */
+
+#if __STDC__
+
+#define YY_USE_PROTOS
+#define YY_USE_CONST
+
+#endif	/* __STDC__ */
+#endif	/* ! __cplusplus */
+
+#ifdef __TURBOC__
+ #pragma warn -rch
+ #pragma warn -use
+#include <io.h>
+#include <stdlib.h>
+#define YY_USE_CONST
+#define YY_USE_PROTOS
+#endif
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+
+#ifdef YY_USE_PROTOS
+#define YY_PROTO(proto) proto
+#else
+#define YY_PROTO(proto) ()
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index.  If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition.  This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN yy_start = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state.  The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START ((yy_start - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE yyrestart( yyin )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#define YY_BUF_SIZE 16384
+
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+
+extern int yyleng;
+extern FILE *yyin, *yyout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+/* The funky do-while in the following #define is used to turn the definition
+ * int a single C statement (which needs a semi-colon terminator).  This
+ * avoids problems with code like:
+ *
+ * 	if ( condition_holds )
+ *		yyless( 5 );
+ *	else
+ *		do_something_else();
+ *
+ * Prior to using the do-while the compiler would get upset at the
+ * "else" because it interpreted the "if" statement as being all
+ * done when it reached the ';' after the yyless() call.
+ */
+
+/* Return all but the first 'n' matched characters back to the input stream. */
+
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up yytext. */ \
+		*yy_cp = yy_hold_char; \
+		YY_RESTORE_YY_MORE_OFFSET \
+		yy_c_buf_p = yy_cp = yy_bp + n - YY_MORE_ADJ; \
+		YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+		} \
+	while ( 0 )
+
+#define unput(c) yyunput( c, yytext_ptr )
+
+/* The following is because we cannot portably get our hands on size_t
+ * (without autoconf's help, which isn't available because we want
+ * flex-generated scanners to compile on their own).
+ */
+typedef unsigned int yy_size_t;
+
+
+struct yy_buffer_state
+	{
+	FILE *yy_input_file;
+
+	char *yy_ch_buf;		/* input buffer */
+	char *yy_buf_pos;		/* current position in input buffer */
+
+	/* Size of input buffer in bytes, not including room for EOB
+	 * characters.
+	 */
+	yy_size_t yy_buf_size;
+
+	/* Number of characters read into yy_ch_buf, not including EOB
+	 * characters.
+	 */
+	int yy_n_chars;
+
+	/* Whether we "own" the buffer - i.e., we know we created it,
+	 * and can realloc() it to grow it, and should free() it to
+	 * delete it.
+	 */
+	int yy_is_our_buffer;
+
+	/* Whether this is an "interactive" input source; if so, and
+	 * if we're using stdio for input, then we want to use getc()
+	 * instead of fread(), to make sure we stop fetching input after
+	 * each newline.
+	 */
+	int yy_is_interactive;
+
+	/* Whether we're considered to be at the beginning of a line.
+	 * If so, '^' rules will be active on the next match, otherwise
+	 * not.
+	 */
+	int yy_at_bol;
+
+	/* Whether to try to fill the input buffer when we reach the
+	 * end of it.
+	 */
+	int yy_fill_buffer;
+
+	int yy_buffer_status;
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+	/* When an EOF's been seen but there's still some text to process
+	 * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+	 * shouldn't try reading from the input source any more.  We might
+	 * still have a bunch of tokens to match, though, because of
+	 * possible backing-up.
+	 *
+	 * When we actually see the EOF, we change the status to "new"
+	 * (via yyrestart()), so that the user can continue scanning by
+	 * just pointing yyin at a new input file.
+	 */
+#define YY_BUFFER_EOF_PENDING 2
+	};
+
+static YY_BUFFER_STATE yy_current_buffer = 0;
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ */
+#define YY_CURRENT_BUFFER yy_current_buffer
+
+
+/* yy_hold_char holds the character lost when yytext is formed. */
+static char yy_hold_char;
+
+static int yy_n_chars;		/* number of characters read into yy_ch_buf */
+
+
+int yyleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 1;		/* whether we need to initialize */
+static int yy_start = 0;	/* start state number */
+
+/* Flag which is used to allow yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin.  A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void yyrestart YY_PROTO(( FILE *input_file ));
+
+void yy_switch_to_buffer YY_PROTO(( YY_BUFFER_STATE new_buffer ));
+void yy_load_buffer_state YY_PROTO(( void ));
+YY_BUFFER_STATE yy_create_buffer YY_PROTO(( FILE *file, int size ));
+void yy_delete_buffer YY_PROTO(( YY_BUFFER_STATE b ));
+void yy_init_buffer YY_PROTO(( YY_BUFFER_STATE b, FILE *file ));
+void yy_flush_buffer YY_PROTO(( YY_BUFFER_STATE b ));
+#define YY_FLUSH_BUFFER yy_flush_buffer( yy_current_buffer )
+
+YY_BUFFER_STATE yy_scan_buffer YY_PROTO(( char *base, yy_size_t size ));
+YY_BUFFER_STATE yy_scan_string YY_PROTO(( yyconst char *yy_str ));
+YY_BUFFER_STATE yy_scan_bytes YY_PROTO(( yyconst char *bytes, int len ));
+
+static void *yy_flex_alloc YY_PROTO(( yy_size_t ));
+static void *yy_flex_realloc YY_PROTO(( void *, yy_size_t ));
+static void yy_flex_free YY_PROTO(( void * ));
+
+#define yy_new_buffer yy_create_buffer
+
+#define yy_set_interactive(is_interactive) \
+	{ \
+	if ( ! yy_current_buffer ) \
+		yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE ); \
+	yy_current_buffer->yy_is_interactive = is_interactive; \
+	}
+
+#define yy_set_bol(at_bol) \
+	{ \
+	if ( ! yy_current_buffer ) \
+		yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE ); \
+	yy_current_buffer->yy_at_bol = at_bol; \
+	}
+
+#define YY_AT_BOL() (yy_current_buffer->yy_at_bol)
+
+typedef unsigned char YY_CHAR;
+FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+typedef int yy_state_type;
+extern char *yytext;
+#define yytext_ptr yytext
+
+static yy_state_type yy_get_previous_state YY_PROTO(( void ));
+static yy_state_type yy_try_NUL_trans YY_PROTO(( yy_state_type current_state ));
+static int yy_get_next_buffer YY_PROTO(( void ));
+static void yy_fatal_error YY_PROTO(( yyconst char msg[] ));
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up yytext.
+ */
+#define YY_DO_BEFORE_ACTION \
+	yytext_ptr = yy_bp; \
+	yyleng = (int) (yy_cp - yy_bp); \
+	yy_hold_char = *yy_cp; \
+	*yy_cp = '\0'; \
+	yy_c_buf_p = yy_cp;
+
+#define YY_NUM_RULES 19
+#define YY_END_OF_BUFFER 20
+static yyconst short int yy_accept[39] =
+    {   0,
+        0,    0,   20,   18,    1,    2,    7,    6,    7,   18,
+       16,   16,    2,    7,    7,    7,   16,   17,   18,   18,
+       11,    6,    5,    6,   14,   16,    0,   12,    8,   10,
+        9,   13,   16,   17,    3,   15,    4,    0
+    } ;
+
+static yyconst int yy_ec[256] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
+        1,    2,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    2,    4,    1,    5,    1,    6,    7,    1,    6,
+        6,    6,    6,    6,    6,    1,    6,    8,    9,    9,
+        9,    9,    9,    9,    9,    9,    9,    1,   10,   11,
+       12,   13,    1,    1,   14,   14,   14,   14,   14,   14,
+       15,   15,   15,   15,   15,   15,   15,   15,   15,   15,
+       15,   15,   15,   15,   15,   15,   15,   16,   15,   15,
+        1,   17,    1,    6,    1,    1,   15,   15,   15,   15,
+
+       15,   15,   15,   15,   15,   15,   15,   15,   15,   15,
+       15,   15,   15,   15,   15,   15,   15,   15,   15,   16,
+       15,   15,    1,   18,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1
+    } ;
+
+static yyconst int yy_meta[19] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    2,    2,    1,
+        1,    1,    1,    2,    3,    2,    1,    1
+    } ;
+
+static yyconst short int yy_base[43] =
+    {   0,
+        0,    0,   39,   49,   49,   49,   26,   16,   49,   30,
+       20,   19,   49,    9,   22,   10,    9,    0,   29,   13,
+       49,   23,   49,   24,   49,    0,    0,   49,   49,   49,
+       49,   49,   13,    0,   49,   49,   49,   49,   41,   28,
+       43,   45
+    } ;
+
+static yyconst short int yy_def[43] =
+    {   0,
+       38,    1,   38,   38,   38,   38,   38,   39,   38,   38,
+       40,   40,   38,   38,   38,   38,   41,   42,   38,   38,
+       38,   39,   38,   39,   38,   12,   12,   38,   38,   38,
+       38,   38,   41,   42,   38,   38,   38,    0,   38,   38,
+       38,   38
+    } ;
+
+static yyconst short int yy_nxt[68] =
+    {   0,
+        4,    5,    6,    7,    8,    9,   10,   11,   12,   13,
+       14,   15,   16,   17,   18,   18,   19,   20,   23,   28,
+       29,   31,   32,   34,   34,   23,   37,   34,   34,   26,
+       36,   35,   24,   30,   38,   27,   25,   21,   38,   24,
+       24,   22,   22,   22,   33,   33,   34,   34,    3,   38,
+       38,   38,   38,   38,   38,   38,   38,   38,   38,   38,
+       38,   38,   38,   38,   38,   38,   38
+    } ;
+
+static yyconst short int yy_chk[68] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    8,   14,
+       14,   16,   16,   17,   17,   22,   24,   33,   33,   40,
+       20,   19,    8,   15,   12,   11,   10,    7,    3,   22,
+       24,   39,   39,   39,   41,   41,   42,   42,   38,   38,
+       38,   38,   38,   38,   38,   38,   38,   38,   38,   38,
+       38,   38,   38,   38,   38,   38,   38
+    } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *yytext;
+#line 1 "calclex.l"
+#define INITIAL 0
+/* Lexical analyzer for calc.y. */
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+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.
+*/
+#line 24 "calclex.l"
+#include "calc.h"
+
+#define numberof(x)  (sizeof (x) / sizeof ((x)[0]))
+#line 411 "calclex.c"
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int yywrap YY_PROTO(( void ));
+#else
+extern int yywrap YY_PROTO(( void ));
+#endif
+#endif
+
+#ifndef YY_NO_UNPUT
+static void yyunput YY_PROTO(( int c, char *buf_ptr ));
+#endif
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy YY_PROTO(( char *, yyconst char *, int ));
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen YY_PROTO(( yyconst char * ));
+#endif
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+static int yyinput YY_PROTO(( void ));
+#else
+static int input YY_PROTO(( void ));
+#endif
+#endif
+
+#if YY_STACK_USED
+static int yy_start_stack_ptr = 0;
+static int yy_start_stack_depth = 0;
+static int *yy_start_stack = 0;
+#ifndef YY_NO_PUSH_STATE
+static void yy_push_state YY_PROTO(( int new_state ));
+#endif
+#ifndef YY_NO_POP_STATE
+static void yy_pop_state YY_PROTO(( void ));
+#endif
+#ifndef YY_NO_TOP_STATE
+static int yy_top_state YY_PROTO(( void ));
+#endif
+
+#else
+#define YY_NO_PUSH_STATE 1
+#define YY_NO_POP_STATE 1
+#define YY_NO_TOP_STATE 1
+#endif
+
+#ifdef YY_MALLOC_DECL
+YY_MALLOC_DECL
+#else
+#if __STDC__
+#ifndef __cplusplus
+#include <stdlib.h>
+#endif
+#else
+/* Just try to get by without declaring the routines.  This will fail
+ * miserably on non-ANSI systems for which sizeof(size_t) != sizeof(int)
+ * or sizeof(void*) != sizeof(int).
+ */
+#endif
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO (void) fwrite( yytext, yyleng, 1, yyout )
+#endif
+
+/* Gets input and stuffs it into "buf".  number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+	if ( yy_current_buffer->yy_is_interactive ) \
+		{ \
+		int c = '*', n; \
+		for ( n = 0; n < max_size && \
+			     (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+			buf[n] = (char) c; \
+		if ( c == '\n' ) \
+			buf[n++] = (char) c; \
+		if ( c == EOF && ferror( yyin ) ) \
+			YY_FATAL_ERROR( "input in flex scanner failed" ); \
+		result = n; \
+		} \
+	else if ( ((result = fread( buf, 1, max_size, yyin )) == 0) \
+		  && ferror( yyin ) ) \
+		YY_FATAL_ERROR( "input in flex scanner failed" );
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL int yylex YY_PROTO(( void ))
+#endif
+
+/* Code executed at the beginning of each rule, after yytext and yyleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+	YY_USER_ACTION
+
+YY_DECL
+	{
+	register yy_state_type yy_current_state;
+	register char *yy_cp, *yy_bp;
+	register int yy_act;
+
+#line 29 "calclex.l"
+
+
+#line 565 "calclex.c"
+
+	if ( yy_init )
+		{
+		yy_init = 0;
+
+#ifdef YY_USER_INIT
+		YY_USER_INIT;
+#endif
+
+		if ( ! yy_start )
+			yy_start = 1;	/* first start state */
+
+		if ( ! yyin )
+			yyin = stdin;
+
+		if ( ! yyout )
+			yyout = stdout;
+
+		if ( ! yy_current_buffer )
+			yy_current_buffer =
+				yy_create_buffer( yyin, YY_BUF_SIZE );
+
+		yy_load_buffer_state();
+		}
+
+	while ( 1 )		/* loops until end-of-file is reached */
+		{
+		yy_cp = yy_c_buf_p;
+
+		/* Support of yytext. */
+		*yy_cp = yy_hold_char;
+
+		/* yy_bp points to the position in yy_ch_buf of the start of
+		 * the current run.
+		 */
+		yy_bp = yy_cp;
+
+		yy_current_state = yy_start;
+yy_match:
+		do
+			{
+			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+			if ( yy_accept[yy_current_state] )
+				{
+				yy_last_accepting_state = yy_current_state;
+				yy_last_accepting_cpos = yy_cp;
+				}
+			while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+				{
+				yy_current_state = (int) yy_def[yy_current_state];
+				if ( yy_current_state >= 39 )
+					yy_c = yy_meta[(unsigned int) yy_c];
+				}
+			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+			++yy_cp;
+			}
+		while ( yy_base[yy_current_state] != 49 );
+
+yy_find_action:
+		yy_act = yy_accept[yy_current_state];
+		if ( yy_act == 0 )
+			{ /* have to back up */
+			yy_cp = yy_last_accepting_cpos;
+			yy_current_state = yy_last_accepting_state;
+			yy_act = yy_accept[yy_current_state];
+			}
+
+		YY_DO_BEFORE_ACTION;
+
+
+do_action:	/* This label is used only to access EOF actions. */
+
+
+		switch ( yy_act )
+	{ /* beginning of action switch */
+			case 0: /* must back up */
+			/* undo the effects of YY_DO_BEFORE_ACTION */
+			*yy_cp = yy_hold_char;
+			yy_cp = yy_last_accepting_cpos;
+			yy_current_state = yy_last_accepting_state;
+			goto yy_find_action;
+
+case 1:
+YY_RULE_SETUP
+#line 31 "calclex.l"
+{ /* white space is skipped */ }
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 33 "calclex.l"
+{ /* semicolon or newline separates statements */
+          return EOS; }
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 35 "calclex.l"
+{ /* escaped newlines are skipped */ }
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 38 "calclex.l"
+{
+            /* comment through to escaped newline is skipped */ }
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 40 "calclex.l"
+{ /* comment through to newline is a separator */
+            return EOS; }
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 42 "calclex.l"
+{   /* comment through to EOF skipped */ }
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 45 "calclex.l"
+{ return yytext[0]; }
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 46 "calclex.l"
+{ return LE; }
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 47 "calclex.l"
+{ return GE; }
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 48 "calclex.l"
+{ return EQ; }
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 49 "calclex.l"
+{ return NE; }
+	YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 50 "calclex.l"
+{ return LSHIFT; }
+	YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 51 "calclex.l"
+{ return RSHIFT; }
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 52 "calclex.l"
+{ return LAND; }
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 53 "calclex.l"
+{ return LOR; }
+	YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 55 "calclex.l"
+{
+        yylval.str = yytext;
+        return NUMBER; }
+	YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 59 "calclex.l"
+{
+        static struct {
+          char  *name;
+          int   value;
+        } table[] = {
+          { "abs",       ABS },
+          { "bin",       BIN },
+          { "decimal",   DECIMAL },
+          { "fib",       FIB },
+          { "hex",       HEX },
+          { "gcd",       GCD },
+          { "lcm",       LCM },
+          { "nextprime", NEXTPRIME },
+          { "powm",      POWM },
+          { "quit",      QUIT },
+          { "root",      ROOT },
+          { "sqrt",      SQRT },
+        };
+        int  i;
+
+        for (i = 0; i < numberof (table); i++)
+          if (strcmp (yytext, table[i].name) == 0)
+            return table[i].value;
+
+        if (yytext[0] >= 'a' && yytext[0] <= 'z' && yytext[1] == '\0')
+          {
+            yylval.var = yytext[0] - 'a';
+            return VARIABLE;
+          }
+
+        return BAD;
+}
+	YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 92 "calclex.l"
+{ return BAD; }
+	YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 94 "calclex.l"
+ECHO;
+	YY_BREAK
+#line 779 "calclex.c"
+case YY_STATE_EOF(INITIAL):
+	yyterminate();
+
+	case YY_END_OF_BUFFER:
+		{
+		/* Amount of text matched not including the EOB char. */
+		int yy_amount_of_matched_text = (int) (yy_cp - yytext_ptr) - 1;
+
+		/* Undo the effects of YY_DO_BEFORE_ACTION. */
+		*yy_cp = yy_hold_char;
+		YY_RESTORE_YY_MORE_OFFSET
+
+		if ( yy_current_buffer->yy_buffer_status == YY_BUFFER_NEW )
+			{
+			/* We're scanning a new file or input source.  It's
+			 * possible that this happened because the user
+			 * just pointed yyin at a new source and called
+			 * yylex().  If so, then we have to assure
+			 * consistency between yy_current_buffer and our
+			 * globals.  Here is the right place to do so, because
+			 * this is the first action (other than possibly a
+			 * back-up) that will match for the new input source.
+			 */
+			yy_n_chars = yy_current_buffer->yy_n_chars;
+			yy_current_buffer->yy_input_file = yyin;
+			yy_current_buffer->yy_buffer_status = YY_BUFFER_NORMAL;
+			}
+
+		/* Note that here we test for yy_c_buf_p "<=" to the position
+		 * of the first EOB in the buffer, since yy_c_buf_p will
+		 * already have been incremented past the NUL character
+		 * (since all states make transitions on EOB to the
+		 * end-of-buffer state).  Contrast this with the test
+		 * in input().
+		 */
+		if ( yy_c_buf_p <= &yy_current_buffer->yy_ch_buf[yy_n_chars] )
+			{ /* This was really a NUL. */
+			yy_state_type yy_next_state;
+
+			yy_c_buf_p = yytext_ptr + yy_amount_of_matched_text;
+
+			yy_current_state = yy_get_previous_state();
+
+			/* Okay, we're now positioned to make the NUL
+			 * transition.  We couldn't have
+			 * yy_get_previous_state() go ahead and do it
+			 * for us because it doesn't know how to deal
+			 * with the possibility of jamming (and we don't
+			 * want to build jamming into it because then it
+			 * will run more slowly).
+			 */
+
+			yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+			yy_bp = yytext_ptr + YY_MORE_ADJ;
+
+			if ( yy_next_state )
+				{
+				/* Consume the NUL. */
+				yy_cp = ++yy_c_buf_p;
+				yy_current_state = yy_next_state;
+				goto yy_match;
+				}
+
+			else
+				{
+				yy_cp = yy_c_buf_p;
+				goto yy_find_action;
+				}
+			}
+
+		else switch ( yy_get_next_buffer() )
+			{
+			case EOB_ACT_END_OF_FILE:
+				{
+				yy_did_buffer_switch_on_eof = 0;
+
+				if ( yywrap() )
+					{
+					/* Note: because we've taken care in
+					 * yy_get_next_buffer() to have set up
+					 * yytext, we can now set up
+					 * yy_c_buf_p so that if some total
+					 * hoser (like flex itself) wants to
+					 * call the scanner after we return the
+					 * YY_NULL, it'll still work - another
+					 * YY_NULL will get returned.
+					 */
+					yy_c_buf_p = yytext_ptr + YY_MORE_ADJ;
+
+					yy_act = YY_STATE_EOF(YY_START);
+					goto do_action;
+					}
+
+				else
+					{
+					if ( ! yy_did_buffer_switch_on_eof )
+						YY_NEW_FILE;
+					}
+				break;
+				}
+
+			case EOB_ACT_CONTINUE_SCAN:
+				yy_c_buf_p =
+					yytext_ptr + yy_amount_of_matched_text;
+
+				yy_current_state = yy_get_previous_state();
+
+				yy_cp = yy_c_buf_p;
+				yy_bp = yytext_ptr + YY_MORE_ADJ;
+				goto yy_match;
+
+			case EOB_ACT_LAST_MATCH:
+				yy_c_buf_p =
+				&yy_current_buffer->yy_ch_buf[yy_n_chars];
+
+				yy_current_state = yy_get_previous_state();
+
+				yy_cp = yy_c_buf_p;
+				yy_bp = yytext_ptr + YY_MORE_ADJ;
+				goto yy_find_action;
+			}
+		break;
+		}
+
+	default:
+		YY_FATAL_ERROR(
+			"fatal flex scanner internal error--no action found" );
+	} /* end of action switch */
+		} /* end of scanning one token */
+	} /* end of yylex */
+
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ *	EOB_ACT_LAST_MATCH -
+ *	EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ *	EOB_ACT_END_OF_FILE - end of file
+ */
+
+static int yy_get_next_buffer()
+	{
+	register char *dest = yy_current_buffer->yy_ch_buf;
+	register char *source = yytext_ptr;
+	register int number_to_move, i;
+	int ret_val;
+
+	if ( yy_c_buf_p > &yy_current_buffer->yy_ch_buf[yy_n_chars + 1] )
+		YY_FATAL_ERROR(
+		"fatal flex scanner internal error--end of buffer missed" );
+
+	if ( yy_current_buffer->yy_fill_buffer == 0 )
+		{ /* Don't try to fill the buffer, so this is an EOF. */
+		if ( yy_c_buf_p - yytext_ptr - YY_MORE_ADJ == 1 )
+			{
+			/* We matched a single character, the EOB, so
+			 * treat this as a final EOF.
+			 */
+			return EOB_ACT_END_OF_FILE;
+			}
+
+		else
+			{
+			/* We matched some text prior to the EOB, first
+			 * process it.
+			 */
+			return EOB_ACT_LAST_MATCH;
+			}
+		}
+
+	/* Try to read more data. */
+
+	/* First move last chars to start of buffer. */
+	number_to_move = (int) (yy_c_buf_p - yytext_ptr) - 1;
+
+	for ( i = 0; i < number_to_move; ++i )
+		*(dest++) = *(source++);
+
+	if ( yy_current_buffer->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+		/* don't do the read, it's not guaranteed to return an EOF,
+		 * just force an EOF
+		 */
+		yy_current_buffer->yy_n_chars = yy_n_chars = 0;
+
+	else
+		{
+		int num_to_read =
+			yy_current_buffer->yy_buf_size - number_to_move - 1;
+
+		while ( num_to_read <= 0 )
+			{ /* Not enough room in the buffer - grow it. */
+#ifdef YY_USES_REJECT
+			YY_FATAL_ERROR(
+"input buffer overflow, can't enlarge buffer because scanner uses REJECT" );
+#else
+
+			/* just a shorter name for the current buffer */
+			YY_BUFFER_STATE b = yy_current_buffer;
+
+			int yy_c_buf_p_offset =
+				(int) (yy_c_buf_p - b->yy_ch_buf);
+
+			if ( b->yy_is_our_buffer )
+				{
+				int new_size = b->yy_buf_size * 2;
+
+				if ( new_size <= 0 )
+					b->yy_buf_size += b->yy_buf_size / 8;
+				else
+					b->yy_buf_size *= 2;
+
+				b->yy_ch_buf = (char *)
+					/* Include room in for 2 EOB chars. */
+					yy_flex_realloc( (void *) b->yy_ch_buf,
+							 b->yy_buf_size + 2 );
+				}
+			else
+				/* Can't grow it, we don't own it. */
+				b->yy_ch_buf = 0;
+
+			if ( ! b->yy_ch_buf )
+				YY_FATAL_ERROR(
+				"fatal error - scanner input buffer overflow" );
+
+			yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+			num_to_read = yy_current_buffer->yy_buf_size -
+						number_to_move - 1;
+#endif
+			}
+
+		if ( num_to_read > YY_READ_BUF_SIZE )
+			num_to_read = YY_READ_BUF_SIZE;
+
+		/* Read in more data. */
+		YY_INPUT( (&yy_current_buffer->yy_ch_buf[number_to_move]),
+			yy_n_chars, num_to_read );
+
+		yy_current_buffer->yy_n_chars = yy_n_chars;
+		}
+
+	if ( yy_n_chars == 0 )
+		{
+		if ( number_to_move == YY_MORE_ADJ )
+			{
+			ret_val = EOB_ACT_END_OF_FILE;
+			yyrestart( yyin );
+			}
+
+		else
+			{
+			ret_val = EOB_ACT_LAST_MATCH;
+			yy_current_buffer->yy_buffer_status =
+				YY_BUFFER_EOF_PENDING;
+			}
+		}
+
+	else
+		ret_val = EOB_ACT_CONTINUE_SCAN;
+
+	yy_n_chars += number_to_move;
+	yy_current_buffer->yy_ch_buf[yy_n_chars] = YY_END_OF_BUFFER_CHAR;
+	yy_current_buffer->yy_ch_buf[yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR;
+
+	yytext_ptr = &yy_current_buffer->yy_ch_buf[0];
+
+	return ret_val;
+	}
+
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+static yy_state_type yy_get_previous_state()
+	{
+	register yy_state_type yy_current_state;
+	register char *yy_cp;
+
+	yy_current_state = yy_start;
+
+	for ( yy_cp = yytext_ptr + YY_MORE_ADJ; yy_cp < yy_c_buf_p; ++yy_cp )
+		{
+		register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+		if ( yy_accept[yy_current_state] )
+			{
+			yy_last_accepting_state = yy_current_state;
+			yy_last_accepting_cpos = yy_cp;
+			}
+		while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+			{
+			yy_current_state = (int) yy_def[yy_current_state];
+			if ( yy_current_state >= 39 )
+				yy_c = yy_meta[(unsigned int) yy_c];
+			}
+		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+		}
+
+	return yy_current_state;
+	}
+
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ *	next_state = yy_try_NUL_trans( current_state );
+ */
+
+#ifdef YY_USE_PROTOS
+static yy_state_type yy_try_NUL_trans( yy_state_type yy_current_state )
+#else
+static yy_state_type yy_try_NUL_trans( yy_current_state )
+yy_state_type yy_current_state;
+#endif
+	{
+	register int yy_is_jam;
+	register char *yy_cp = yy_c_buf_p;
+
+	register YY_CHAR yy_c = 1;
+	if ( yy_accept[yy_current_state] )
+		{
+		yy_last_accepting_state = yy_current_state;
+		yy_last_accepting_cpos = yy_cp;
+		}
+	while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+		{
+		yy_current_state = (int) yy_def[yy_current_state];
+		if ( yy_current_state >= 39 )
+			yy_c = yy_meta[(unsigned int) yy_c];
+		}
+	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+	yy_is_jam = (yy_current_state == 38);
+
+	return yy_is_jam ? 0 : yy_current_state;
+	}
+
+
+#ifndef YY_NO_UNPUT
+#ifdef YY_USE_PROTOS
+static void yyunput( int c, register char *yy_bp )
+#else
+static void yyunput( c, yy_bp )
+int c;
+register char *yy_bp;
+#endif
+	{
+	register char *yy_cp = yy_c_buf_p;
+
+	/* undo effects of setting up yytext */
+	*yy_cp = yy_hold_char;
+
+	if ( yy_cp < yy_current_buffer->yy_ch_buf + 2 )
+		{ /* need to shift things up to make room */
+		/* +2 for EOB chars. */
+		register int number_to_move = yy_n_chars + 2;
+		register char *dest = &yy_current_buffer->yy_ch_buf[
+					yy_current_buffer->yy_buf_size + 2];
+		register char *source =
+				&yy_current_buffer->yy_ch_buf[number_to_move];
+
+		while ( source > yy_current_buffer->yy_ch_buf )
+			*--dest = *--source;
+
+		yy_cp += (int) (dest - source);
+		yy_bp += (int) (dest - source);
+		yy_current_buffer->yy_n_chars =
+			yy_n_chars = yy_current_buffer->yy_buf_size;
+
+		if ( yy_cp < yy_current_buffer->yy_ch_buf + 2 )
+			YY_FATAL_ERROR( "flex scanner push-back overflow" );
+		}
+
+	*--yy_cp = (char) c;
+
+
+	yytext_ptr = yy_bp;
+	yy_hold_char = *yy_cp;
+	yy_c_buf_p = yy_cp;
+	}
+#endif	/* ifndef YY_NO_UNPUT */
+
+
+#ifdef __cplusplus
+static int yyinput()
+#else
+static int input()
+#endif
+	{
+	int c;
+
+	*yy_c_buf_p = yy_hold_char;
+
+	if ( *yy_c_buf_p == YY_END_OF_BUFFER_CHAR )
+		{
+		/* yy_c_buf_p now points to the character we want to return.
+		 * If this occurs *before* the EOB characters, then it's a
+		 * valid NUL; if not, then we've hit the end of the buffer.
+		 */
+		if ( yy_c_buf_p < &yy_current_buffer->yy_ch_buf[yy_n_chars] )
+			/* This was really a NUL. */
+			*yy_c_buf_p = '\0';
+
+		else
+			{ /* need more input */
+			int offset = yy_c_buf_p - yytext_ptr;
+			++yy_c_buf_p;
+
+			switch ( yy_get_next_buffer() )
+				{
+				case EOB_ACT_LAST_MATCH:
+					/* This happens because yy_g_n_b()
+					 * sees that we've accumulated a
+					 * token and flags that we need to
+					 * try matching the token before
+					 * proceeding.  But for input(),
+					 * there's no matching to consider.
+					 * So convert the EOB_ACT_LAST_MATCH
+					 * to EOB_ACT_END_OF_FILE.
+					 */
+
+					/* Reset buffer status. */
+					yyrestart( yyin );
+
+					/* fall through */
+
+				case EOB_ACT_END_OF_FILE:
+					{
+					if ( yywrap() )
+						return EOF;
+
+					if ( ! yy_did_buffer_switch_on_eof )
+						YY_NEW_FILE;
+#ifdef __cplusplus
+					return yyinput();
+#else
+					return input();
+#endif
+					}
+
+				case EOB_ACT_CONTINUE_SCAN:
+					yy_c_buf_p = yytext_ptr + offset;
+					break;
+				}
+			}
+		}
+
+	c = *(unsigned char *) yy_c_buf_p;	/* cast for 8-bit char's */
+	*yy_c_buf_p = '\0';	/* preserve yytext */
+	yy_hold_char = *++yy_c_buf_p;
+
+
+	return c;
+	}
+
+
+#ifdef YY_USE_PROTOS
+void yyrestart( FILE *input_file )
+#else
+void yyrestart( input_file )
+FILE *input_file;
+#endif
+	{
+	if ( ! yy_current_buffer )
+		yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE );
+
+	yy_init_buffer( yy_current_buffer, input_file );
+	yy_load_buffer_state();
+	}
+
+
+#ifdef YY_USE_PROTOS
+void yy_switch_to_buffer( YY_BUFFER_STATE new_buffer )
+#else
+void yy_switch_to_buffer( new_buffer )
+YY_BUFFER_STATE new_buffer;
+#endif
+	{
+	if ( yy_current_buffer == new_buffer )
+		return;
+
+	if ( yy_current_buffer )
+		{
+		/* Flush out information for old buffer. */
+		*yy_c_buf_p = yy_hold_char;
+		yy_current_buffer->yy_buf_pos = yy_c_buf_p;
+		yy_current_buffer->yy_n_chars = yy_n_chars;
+		}
+
+	yy_current_buffer = new_buffer;
+	yy_load_buffer_state();
+
+	/* We don't actually know whether we did this switch during
+	 * EOF (yywrap()) processing, but the only time this flag
+	 * is looked at is after yywrap() is called, so it's safe
+	 * to go ahead and always set it.
+	 */
+	yy_did_buffer_switch_on_eof = 1;
+	}
+
+
+#ifdef YY_USE_PROTOS
+void yy_load_buffer_state( void )
+#else
+void yy_load_buffer_state()
+#endif
+	{
+	yy_n_chars = yy_current_buffer->yy_n_chars;
+	yytext_ptr = yy_c_buf_p = yy_current_buffer->yy_buf_pos;
+	yyin = yy_current_buffer->yy_input_file;
+	yy_hold_char = *yy_c_buf_p;
+	}
+
+
+#ifdef YY_USE_PROTOS
+YY_BUFFER_STATE yy_create_buffer( FILE *file, int size )
+#else
+YY_BUFFER_STATE yy_create_buffer( file, size )
+FILE *file;
+int size;
+#endif
+	{
+	YY_BUFFER_STATE b;
+
+	b = (YY_BUFFER_STATE) yy_flex_alloc( sizeof( struct yy_buffer_state ) );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+	b->yy_buf_size = size;
+
+	/* yy_ch_buf has to be 2 characters longer than the size given because
+	 * we need to put in 2 end-of-buffer characters.
+	 */
+	b->yy_ch_buf = (char *) yy_flex_alloc( b->yy_buf_size + 2 );
+	if ( ! b->yy_ch_buf )
+		YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+	b->yy_is_our_buffer = 1;
+
+	yy_init_buffer( b, file );
+
+	return b;
+	}
+
+
+#ifdef YY_USE_PROTOS
+void yy_delete_buffer( YY_BUFFER_STATE b )
+#else
+void yy_delete_buffer( b )
+YY_BUFFER_STATE b;
+#endif
+	{
+	if ( ! b )
+		return;
+
+	if ( b == yy_current_buffer )
+		yy_current_buffer = (YY_BUFFER_STATE) 0;
+
+	if ( b->yy_is_our_buffer )
+		yy_flex_free( (void *) b->yy_ch_buf );
+
+	yy_flex_free( (void *) b );
+	}
+
+
+#ifndef YY_ALWAYS_INTERACTIVE
+#ifndef YY_NEVER_INTERACTIVE
+extern int isatty YY_PROTO(( int ));
+#endif
+#endif
+
+#ifdef YY_USE_PROTOS
+void yy_init_buffer( YY_BUFFER_STATE b, FILE *file )
+#else
+void yy_init_buffer( b, file )
+YY_BUFFER_STATE b;
+FILE *file;
+#endif
+
+
+	{
+	yy_flush_buffer( b );
+
+	b->yy_input_file = file;
+	b->yy_fill_buffer = 1;
+
+#if YY_ALWAYS_INTERACTIVE
+	b->yy_is_interactive = 1;
+#else
+#if YY_NEVER_INTERACTIVE
+	b->yy_is_interactive = 0;
+#else
+	b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+#endif
+#endif
+	}
+
+
+#ifdef YY_USE_PROTOS
+void yy_flush_buffer( YY_BUFFER_STATE b )
+#else
+void yy_flush_buffer( b )
+YY_BUFFER_STATE b;
+#endif
+
+	{
+	if ( ! b )
+		return;
+
+	b->yy_n_chars = 0;
+
+	/* We always need two end-of-buffer characters.  The first causes
+	 * a transition to the end-of-buffer state.  The second causes
+	 * a jam in that state.
+	 */
+	b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+	b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+	b->yy_buf_pos = &b->yy_ch_buf[0];
+
+	b->yy_at_bol = 1;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	if ( b == yy_current_buffer )
+		yy_load_buffer_state();
+	}
+
+
+#ifndef YY_NO_SCAN_BUFFER
+#ifdef YY_USE_PROTOS
+YY_BUFFER_STATE yy_scan_buffer( char *base, yy_size_t size )
+#else
+YY_BUFFER_STATE yy_scan_buffer( base, size )
+char *base;
+yy_size_t size;
+#endif
+	{
+	YY_BUFFER_STATE b;
+
+	if ( size < 2 ||
+	     base[size-2] != YY_END_OF_BUFFER_CHAR ||
+	     base[size-1] != YY_END_OF_BUFFER_CHAR )
+		/* They forgot to leave room for the EOB's. */
+		return 0;
+
+	b = (YY_BUFFER_STATE) yy_flex_alloc( sizeof( struct yy_buffer_state ) );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+
+	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
+	b->yy_buf_pos = b->yy_ch_buf = base;
+	b->yy_is_our_buffer = 0;
+	b->yy_input_file = 0;
+	b->yy_n_chars = b->yy_buf_size;
+	b->yy_is_interactive = 0;
+	b->yy_at_bol = 1;
+	b->yy_fill_buffer = 0;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	yy_switch_to_buffer( b );
+
+	return b;
+	}
+#endif
+
+
+#ifndef YY_NO_SCAN_STRING
+#ifdef YY_USE_PROTOS
+YY_BUFFER_STATE yy_scan_string( yyconst char *yy_str )
+#else
+YY_BUFFER_STATE yy_scan_string( yy_str )
+yyconst char *yy_str;
+#endif
+	{
+	int len;
+	for ( len = 0; yy_str[len]; ++len )
+		;
+
+	return yy_scan_bytes( yy_str, len );
+	}
+#endif
+
+
+#ifndef YY_NO_SCAN_BYTES
+#ifdef YY_USE_PROTOS
+YY_BUFFER_STATE yy_scan_bytes( yyconst char *bytes, int len )
+#else
+YY_BUFFER_STATE yy_scan_bytes( bytes, len )
+yyconst char *bytes;
+int len;
+#endif
+	{
+	YY_BUFFER_STATE b;
+	char *buf;
+	yy_size_t n;
+	int i;
+
+	/* Get memory for full buffer, including space for trailing EOB's. */
+	n = len + 2;
+	buf = (char *) yy_flex_alloc( n );
+	if ( ! buf )
+		YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+
+	for ( i = 0; i < len; ++i )
+		buf[i] = bytes[i];
+
+	buf[len] = buf[len+1] = YY_END_OF_BUFFER_CHAR;
+
+	b = yy_scan_buffer( buf, n );
+	if ( ! b )
+		YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+
+	/* It's okay to grow etc. this buffer, and we should throw it
+	 * away when we're done.
+	 */
+	b->yy_is_our_buffer = 1;
+
+	return b;
+	}
+#endif
+
+
+#ifndef YY_NO_PUSH_STATE
+#ifdef YY_USE_PROTOS
+static void yy_push_state( int new_state )
+#else
+static void yy_push_state( new_state )
+int new_state;
+#endif
+	{
+	if ( yy_start_stack_ptr >= yy_start_stack_depth )
+		{
+		yy_size_t new_size;
+
+		yy_start_stack_depth += YY_START_STACK_INCR;
+		new_size = yy_start_stack_depth * sizeof( int );
+
+		if ( ! yy_start_stack )
+			yy_start_stack = (int *) yy_flex_alloc( new_size );
+
+		else
+			yy_start_stack = (int *) yy_flex_realloc(
+					(void *) yy_start_stack, new_size );
+
+		if ( ! yy_start_stack )
+			YY_FATAL_ERROR(
+			"out of memory expanding start-condition stack" );
+		}
+
+	yy_start_stack[yy_start_stack_ptr++] = YY_START;
+
+	BEGIN(new_state);
+	}
+#endif
+
+
+#ifndef YY_NO_POP_STATE
+static void yy_pop_state()
+	{
+	if ( --yy_start_stack_ptr < 0 )
+		YY_FATAL_ERROR( "start-condition stack underflow" );
+
+	BEGIN(yy_start_stack[yy_start_stack_ptr]);
+	}
+#endif
+
+
+#ifndef YY_NO_TOP_STATE
+static int yy_top_state()
+	{
+	return yy_start_stack[yy_start_stack_ptr - 1];
+	}
+#endif
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+#ifdef YY_USE_PROTOS
+static void yy_fatal_error( yyconst char msg[] )
+#else
+static void yy_fatal_error( msg )
+char msg[];
+#endif
+	{
+	(void) fprintf( stderr, "%s\n", msg );
+	exit( YY_EXIT_FAILURE );
+	}
+
+
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up yytext. */ \
+		yytext[yyleng] = yy_hold_char; \
+		yy_c_buf_p = yytext + n; \
+		yy_hold_char = *yy_c_buf_p; \
+		*yy_c_buf_p = '\0'; \
+		yyleng = n; \
+		} \
+	while ( 0 )
+
+
+/* Internal utility routines. */
+
+#ifndef yytext_ptr
+#ifdef YY_USE_PROTOS
+static void yy_flex_strncpy( char *s1, yyconst char *s2, int n )
+#else
+static void yy_flex_strncpy( s1, s2, n )
+char *s1;
+yyconst char *s2;
+int n;
+#endif
+	{
+	register int i;
+	for ( i = 0; i < n; ++i )
+		s1[i] = s2[i];
+	}
+#endif
+
+#ifdef YY_NEED_STRLEN
+#ifdef YY_USE_PROTOS
+static int yy_flex_strlen( yyconst char *s )
+#else
+static int yy_flex_strlen( s )
+yyconst char *s;
+#endif
+	{
+	register int n;
+	for ( n = 0; s[n]; ++n )
+		;
+
+	return n;
+	}
+#endif
+
+
+#ifdef YY_USE_PROTOS
+static void *yy_flex_alloc( yy_size_t size )
+#else
+static void *yy_flex_alloc( size )
+yy_size_t size;
+#endif
+	{
+	return (void *) malloc( size );
+	}
+
+#ifdef YY_USE_PROTOS
+static void *yy_flex_realloc( void *ptr, yy_size_t size )
+#else
+static void *yy_flex_realloc( ptr, size )
+void *ptr;
+yy_size_t size;
+#endif
+	{
+	/* The cast to (char *) in the following accommodates both
+	 * implementations that use char* generic pointers, and those
+	 * that use void* generic pointers.  It works with the latter
+	 * because both ANSI C and C++ allow castless assignment from
+	 * any pointer type to void*, and deal with argument conversions
+	 * as though doing an assignment.
+	 */
+	return (void *) realloc( (char *) ptr, size );
+	}
+
+#ifdef YY_USE_PROTOS
+static void yy_flex_free( void *ptr )
+#else
+static void yy_flex_free( ptr )
+void *ptr;
+#endif
+	{
+	free( ptr );
+	}
+
+#if YY_MAIN
+int main()
+	{
+	yylex();
+	return 0;
+	}
+#endif
+#line 94 "calclex.l"
+
+
+int
+yywrap ()
+{
+  return 1;
+}
diff --git a/src/gmp/demos/calclex.l b/src/gmp/demos/calclex.l
new file mode 100644
index 000000000..c28a8c895
--- /dev/null
+++ b/src/gmp/demos/calclex.l
@@ -0,0 +1,100 @@
+/* Lexical analyzer for calc.y. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+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.
+*/
+
+
+%{
+#include "calc.h"
+
+#define numberof(x)  (sizeof (x) / sizeof ((x)[0]))
+%}
+
+%%
+
+[ \t\f] { /* white space is skipped */ }
+
+[;\n]   { /* semicolon or newline separates statements */
+          return EOS; }
+\\\n    { /* escaped newlines are skipped */ }
+
+
+#(([^\\\n]*)\\)+\n {
+            /* comment through to escaped newline is skipped */ }
+#[^\n]*\n { /* comment through to newline is a separator */
+            return EOS; }
+#[^\n]* {   /* comment through to EOF skipped */ }
+
+
+[-+*/%()<>^!=,] { return yytext[0]; }
+"<="    { return LE; }
+">="    { return GE; }
+"=="    { return EQ; }
+"!="    { return NE; }
+"<<"    { return LSHIFT; }
+">>"    { return RSHIFT; }
+"&&"    { return LAND; }
+"||"    { return LOR; }
+
+(0[xX])?[0-9A-F]+ {
+        yylval.str = yytext;
+        return NUMBER; }
+
+[a-zA-Z][a-zA-Z0-9]* {
+        static struct {
+          char  *name;
+          int   value;
+        } table[] = {
+          { "abs",       ABS },
+          { "bin",       BIN },
+          { "decimal",   DECIMAL },
+          { "fib",       FIB },
+          { "hex",       HEX },
+          { "gcd",       GCD },
+          { "lcm",       LCM },
+          { "nextprime", NEXTPRIME },
+          { "powm",      POWM },
+          { "quit",      QUIT },
+          { "root",      ROOT },
+          { "sqrt",      SQRT },
+        };
+        int  i;
+
+        for (i = 0; i < numberof (table); i++)
+          if (strcmp (yytext, table[i].name) == 0)
+            return table[i].value;
+
+        if (yytext[0] >= 'a' && yytext[0] <= 'z' && yytext[1] == '\0')
+          {
+            yylval.var = yytext[0] - 'a';
+            return VARIABLE;
+          }
+
+        return BAD;
+}
+
+. { return BAD; }
+
+%%
+
+int
+yywrap ()
+{
+  return 1;
+}
diff --git a/src/gmp/demos/factorize.c b/src/gmp/demos/factorize.c
new file mode 100644
index 000000000..d776e6b01
--- /dev/null
+++ b/src/gmp/demos/factorize.c
@@ -0,0 +1,363 @@
+/* Factoring with Pollard's rho method.
+
+   Copyright (C) 1995, 1997, 1998, 1999, 2000 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 program; see the file COPYING.  If not, write to the Free
+   Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+   02111-1307, USA.  */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "gmp.h"
+
+int flag_verbose = 0;
+
+static unsigned add[] = {4, 2, 4, 2, 4, 6, 2, 6};
+
+#if defined (__hpux) || defined (__alpha)  || defined (__svr4__) || defined (__SVR4)
+/* HPUX lacks random().  DEC OSF/1 1.2 random() returns a double.  */
+long mrand48 ();
+static long
+random ()
+{
+  return mrand48 ();
+}
+#else
+/* Glibc stdlib.h has "int32_t random();" which, on i386 at least, conflicts
+   with a redeclaration as "long". */
+#ifndef __GLIBC__
+long random ();
+#endif
+#endif
+
+void
+factor_using_division (mpz_t t, unsigned int limit)
+{
+  mpz_t q, r;
+  unsigned long int f;
+  int ai;
+  unsigned *addv = add;
+  unsigned int failures;
+
+  if (flag_verbose)
+    {
+      printf ("[trial division (%u)] ", limit);
+      fflush (stdout);
+    }
+
+  mpz_init (q);
+  mpz_init (r);
+
+  f = mpz_scan1 (t, 0);
+  mpz_div_2exp (t, t, f);
+  while (f)
+    {
+      printf ("2 ");
+      fflush (stdout);
+      --f;
+    }
+
+  for (;;)
+    {
+      mpz_tdiv_qr_ui (q, r, t, 3);
+      if (mpz_cmp_ui (r, 0) != 0)
+	break;
+      mpz_set (t, q);
+      printf ("3 ");
+      fflush (stdout);
+    }
+
+  for (;;)
+    {
+      mpz_tdiv_qr_ui (q, r, t, 5);
+      if (mpz_cmp_ui (r, 0) != 0)
+	break;
+      mpz_set (t, q);
+      printf ("5 ");
+      fflush (stdout);
+    }
+
+  failures = 0;
+  f = 7;
+  ai = 0;
+  while (mpz_cmp_ui (t, 1) != 0)
+    {
+      mpz_tdiv_qr_ui (q, r, t, f);
+      if (mpz_cmp_ui (r, 0) != 0)
+	{
+	  f += addv[ai];
+	  if (mpz_cmp_ui (q, f) < 0)
+	    break;
+	  ai = (ai + 1) & 7;
+	  failures++;
+	  if (failures > limit)
+	    break;
+	}
+      else
+	{
+	  mpz_swap (t, q);
+	  printf ("%lu ", f);
+	  fflush (stdout);
+	  failures = 0;
+	}
+    }
+
+  mpz_clear (q);
+  mpz_clear (r);
+}
+
+void
+factor_using_division_2kp (mpz_t t, unsigned int limit, unsigned long p)
+{
+  mpz_t r;
+  mpz_t f;
+  unsigned int k;
+
+  mpz_init (r);
+  mpz_init_set_ui (f, 2 * p);
+  mpz_add_ui (f, f, 1);
+  for (k = 1; k < limit; k++)
+    {
+      mpz_tdiv_r (r, t, f);
+      while (mpz_cmp_ui (r, 0) == 0)
+	{
+	  mpz_tdiv_q (t, t, f);
+	  mpz_tdiv_r (r, t, f);
+	  mpz_out_str (stdout, 10, f);
+	  fflush (stdout);
+	  fputc (' ', stdout);
+	}
+      mpz_add_ui (f, f, 2 * p);
+    }
+
+  mpz_clear (f);
+  mpz_clear (r);
+}
+
+void
+factor_using_pollard_rho (mpz_t n, int a_int, unsigned long p)
+{
+  mpz_t x, x1, y, P;
+  mpz_t a;
+  mpz_t g;
+  mpz_t t1, t2;
+  int k, l, c, i;
+
+  if (flag_verbose)
+    {
+      printf ("[pollard-rho (%d)] ", a_int);
+      fflush (stdout);
+    }
+
+  mpz_init (g);
+  mpz_init (t1);
+  mpz_init (t2);
+
+  mpz_init_set_si (a, a_int);
+  mpz_init_set_si (y, 2);
+  mpz_init_set_si (x, 2);
+  mpz_init_set_si (x1, 2);
+  k = 1;
+  l = 1;
+  mpz_init_set_ui (P, 1);
+  c = 0;
+
+  while (mpz_cmp_ui (n, 1) != 0)
+    {
+S2:
+      if (p != 0)
+	{
+	  mpz_powm_ui (x, x, p, n); mpz_add (x, x, a);
+	}
+      else
+	{
+	  mpz_mul (x, x, x); mpz_add (x, x, a); mpz_mod (x, x, n);
+	}
+      mpz_sub (t1, x1, x); mpz_mul (t2, P, t1); mpz_mod (P, t2, n);
+      c++;
+      if (c == 20)
+	{
+	  c = 0;
+	  mpz_gcd (g, P, n);
+	  if (mpz_cmp_ui (g, 1) != 0)
+	    goto S4;
+	  mpz_set (y, x);
+	}
+S3:
+      k--;
+      if (k != 0)
+	goto S2;
+
+      mpz_gcd (g, P, n);
+      if (mpz_cmp_ui (g, 1) != 0)
+	goto S4;
+
+      mpz_set (x1, x);
+      k = l;
+      l = 2 * l;
+      for (i = 0; i < k; i++)
+	{
+	  if (p != 0)
+	    {
+	      mpz_powm_ui (x, x, p, n); mpz_add (x, x, a);
+	    }
+	  else
+	    {
+	      mpz_mul (x, x, x); mpz_add (x, x, a); mpz_mod (x, x, n);
+	    }
+	}
+      mpz_set (y, x);
+      c = 0;
+      goto S2;
+S4:
+      do
+	{
+	  if (p != 0)
+	    {
+	      mpz_powm_ui (y, y, p, n); mpz_add (y, y, a); 
+	    }
+	  else
+	    {
+	      mpz_mul (y, y, y); mpz_add (y, y, a); mpz_mod (y, y, n);
+	    }
+	  mpz_sub (t1, x1, y); mpz_gcd (g, t1, n);
+	}
+      while (mpz_cmp_ui (g, 1) == 0);
+
+      if (!mpz_probab_prime_p (g, 3))
+	{
+	  do
+	    a_int = random ();
+	  while (a_int == -2 || a_int == 0);
+
+	  if (flag_verbose)
+	    {
+	      printf ("[composite factor--restarting pollard-rho] ");
+	      fflush (stdout);
+	    }
+	  factor_using_pollard_rho (g, a_int, p);
+	  break;
+	}
+      else
+	{
+	  mpz_out_str (stdout, 10, g);
+	  fflush (stdout);
+	  fputc (' ', stdout);
+	}
+      mpz_div (n, n, g);
+      mpz_mod (x, x, n);
+      mpz_mod (x1, x1, n);
+      mpz_mod (y, y, n);
+      if (mpz_probab_prime_p (n, 3))
+	{
+	  mpz_out_str (stdout, 10, n);
+	  fflush (stdout);
+	  fputc (' ', stdout);
+	  break;
+	}
+    }
+
+  mpz_clear (g);
+  mpz_clear (P);
+  mpz_clear (t2);
+  mpz_clear (t1);
+  mpz_clear (a);
+  mpz_clear (x1);
+  mpz_clear (x);
+  mpz_clear (y);
+}
+
+void
+factor (mpz_t t, unsigned long p)
+{
+  unsigned int division_limit;
+
+  /* Set the trial division limit according the size of t.  */
+  division_limit = mpz_sizeinbase (t, 2);
+  if (division_limit > 1000)
+    division_limit = 1000 * 1000;
+  else
+    division_limit = division_limit * division_limit;
+
+  if (p != 0)
+    factor_using_division_2kp (t, division_limit / 10, p);
+  else
+    factor_using_division (t, division_limit);
+
+  if (mpz_cmp_ui (t, 1) != 0)
+    {
+      if (flag_verbose)
+	{
+	  printf ("[is number prime?] ");
+	  fflush (stdout);
+	}
+      if (mpz_probab_prime_p (t, 3))
+	mpz_out_str (stdout, 10, t);
+      else
+	factor_using_pollard_rho (t, 1, p);
+    }
+}
+
+main (int argc, char *argv[])
+{
+  mpz_t t;
+  unsigned long p;
+  int i;
+
+  if (argc > 1 && !strcmp (argv[1], "-v"))
+    {
+      flag_verbose = 1;
+      argv++;
+      argc--;
+    }
+
+  p = 0;
+  for (i = 1; i < argc; i++)
+    {
+      if (!strncmp (argv[i], "-Mp", 3))
+	{
+	  p = atoi (argv[i] + 3);
+	  mpz_init_set_ui (t, 1);
+	  mpz_mul_2exp (t, t, p);
+	  mpz_sub_ui (t, t, 1);
+	}
+      else if (!strncmp (argv[i], "-2kp", 4))
+	{
+	  p = atoi (argv[i] + 4);
+	  continue;
+	}
+      else
+	{
+	  mpz_init_set_str (t, argv[i], 0);
+	}
+
+      if (mpz_cmp_ui (t, 0) == 0)
+	puts ("-");
+      else
+	{
+	  factor (t, p);
+	  puts ("");
+	}
+    }
+  exit (0);
+}
+
+void
+dmp (mpz_t x)
+{
+  mpz_out_str (stdout, 10, x);
+  puts ("");
+}
diff --git a/src/gmp/demos/isprime.c b/src/gmp/demos/isprime.c
new file mode 100644
index 000000000..c31ba5b31
--- /dev/null
+++ b/src/gmp/demos/isprime.c
@@ -0,0 +1,65 @@
+/* Classify numbers as probable primes, primes or composites.
+   With -q return true if the folowing argument is a (probable) prime.
+
+Copyright (C) 1999, 2000 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 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.  */
+
+#include <stdio.h>
+#include "gmp.h"
+
+char *progname;
+
+main (int argc, char **argv)
+{
+  mpz_t n;
+  int i;
+
+  progname = argv[0];
+
+  if (argc < 2)
+    print_usage_and_exit ();
+
+  mpz_init (n);
+
+  if (argc == 3 && strcmp (argv[1], "-q") == 0)
+    {
+      if (mpz_set_str (n, argv[2], 0) != 0)
+	print_usage_and_exit ();
+      exit (mpz_probab_prime_p (n, 5) == 0);
+    }
+
+  for (i = 1; i < argc; i++)
+    {
+      int class;
+      if (mpz_set_str (n, argv[i], 0) != 0)
+	print_usage_and_exit ();
+      class = mpz_probab_prime_p (n, 5);
+      mpz_out_str (stdout, 10, n);
+      if (class == 0)
+	puts (" is composite");
+      else if (class == 1)
+	puts (" is a probable prime");
+      else /* class == 2 */
+	puts (" is a prime");
+    }
+  exit (0);
+}
+
+print_usage_and_exit ()
+{
+  fprintf (stderr, "usage: %s -q nnn\n", progname);
+  fprintf (stderr, "usage: %s nnn ...\n", progname);
+  exit (-1);
+}
diff --git a/src/gmp/demos/pexpr.c b/src/gmp/demos/pexpr.c
new file mode 100644
index 000000000..c7d6ab4c7
--- /dev/null
+++ b/src/gmp/demos/pexpr.c
@@ -0,0 +1,1206 @@
+/* Program for computing integer expressions using the GNU Multiple Precision
+   Arithmetic Library.
+
+Copyright (C) 1997, 1999, 2000 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 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.  */
+
+
+/* This expressions evaluator works by building an expression tree (using a
+   recursive descent parser) which is then evaluated.  The expression tree is
+   useful since we want to optimize certain expressions (like a^b % c).
+
+   Usage: pexpr [options] expr ...
+   (Assuming you called the executable `pexpr' of course.)
+
+   Command line options:
+
+   -b        print output in binary
+   -o        print output in octal
+   -d        print output in decimal (the default)
+   -x        print output in hexadecimal
+   -<NUM>    print output in base NUM
+   -t        print timing information
+   -html     output html
+   -nosplit  do not split long lines each 60th digit
+*/
+
+/* Define LIMIT_RESOURCE_USAGE if you want to make sure the program doesn't
+   use up extensive resources (cpu, memory).  Useful for the GMP demo on the
+   GMP web site, since we cannot load the server too much.  */
+
+#ifdef LIMIT_RESOURCE_USAGE
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif
+
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <setjmp.h>
+#include <signal.h>
+#include <ctype.h>
+
+#include "gmp.h"
+
+/* GMP version 1.x compatibility.  */
+#if ! (__GNU_MP_VERSION >= 2)
+typedef MP_INT __mpz_struct;
+typedef __mpz_struct mpz_t[1];
+typedef __mpz_struct *mpz_ptr;
+#define mpz_fdiv_q	mpz_div
+#define mpz_fdiv_r	mpz_mod
+#define mpz_tdiv_q_2exp	mpz_div_2exp
+#define mpz_sgn(Z) ((Z)->size < 0 ? -1 : (Z)->size > 0)
+#endif
+
+/* GMP version 2.0 compatibility.  */
+#if ! (__GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1)
+#define mpz_swap(a,b) \
+  do { __mpz_struct __t; __t = *a; *a = *b; *b = __t;} while (0)
+#endif
+
+jmp_buf errjmpbuf;
+
+enum op_t {NOP, LIT, NEG, NOT, PLUS, MINUS, MULT, DIV, MOD, REM, INVMOD, POW,
+	   AND, IOR, XOR, SLL, SRA, POPCNT, HAMDIST, GCD, LCM, SQRT, ROOT, FAC,
+	   LOG, LOG2, FERMAT, MERSENNE, FIBONACCI};
+
+/* Type for the expression tree.  */
+struct expr
+{
+  enum op_t op;
+  union
+  {
+    struct {struct expr *lhs, *rhs;} ops;
+    mpz_t val;
+  } operands;
+};
+
+typedef struct expr *expr_t;
+
+void cleanup_and_exit (int);
+
+char *skipspace (char *);
+void makeexp (expr_t *, enum op_t, expr_t, expr_t);
+void free_expr (expr_t);
+char *expr (char *, expr_t *);
+char *term (char *, expr_t *);
+char *power (char *, expr_t *);
+char *factor (char *, expr_t *);
+int match (char *, char *);
+int matchp (char *, char *);
+int cputime (void);
+
+void mpz_eval_expr (mpz_ptr, expr_t);
+void mpz_eval_mod_expr (mpz_ptr, expr_t, mpz_ptr);
+
+char *error;
+int flag_print = 1;
+int print_timing = 0;
+int flag_html = 0;
+int flag_splitup_output = 0;
+char *newline = "";
+
+#ifdef _AIX
+#define sigaltstack sigstack
+#endif
+
+#if !defined(_WIN32) && !defined(__DJGPP__)
+void
+setup_error_handler ()
+{
+  struct sigaction act;
+  struct sigaltstack sigstk;
+
+  /* Set up a stack for signal handling.  A typical cause of error is stack
+     overflow, and in such situation a signal can not be delivered on the
+     overflown stack.  */
+  sigstk.ss_sp = malloc (SIGSTKSZ);
+#ifndef _AIX
+  sigstk.ss_size = SIGSTKSZ;
+  sigstk.ss_flags = 0;
+#endif /* ! _AIX */
+
+#ifndef _UNICOS
+  if (sigaltstack (&sigstk, 0) < 0)
+    perror("sigaltstack");
+#endif
+
+  /* Initialize structure for sigaction (called below).  */
+  act.sa_handler = cleanup_and_exit;
+  sigemptyset (&(act.sa_mask));
+  act.sa_flags = SA_ONSTACK;
+
+#ifdef LIMIT_RESOURCE_USAGE
+  {
+    struct rlimit limit;
+
+    limit.rlim_cur = limit.rlim_max = 0;
+    setrlimit (RLIMIT_CORE, &limit);
+
+    limit.rlim_cur = 3;
+    limit.rlim_max = 4;
+    setrlimit (RLIMIT_CPU, &limit);
+
+    limit.rlim_cur = limit.rlim_max = 4 * 1024 * 1024;
+    setrlimit (RLIMIT_DATA, &limit);
+
+    getrlimit (RLIMIT_STACK, &limit);
+    limit.rlim_cur = 1 * 1024 * 1024;
+    setrlimit (RLIMIT_STACK, &limit);
+
+    sigaction (SIGXCPU, &act, 0);
+  }
+#endif /* LIMIT_RESOURCE_USAGE */
+
+  sigaction (SIGILL, &act, 0);
+  sigaction (SIGSEGV, &act, 0);
+  sigaction (SIGBUS, &act, 0);
+  sigaction (SIGFPE, &act, 0);
+}
+#endif /* ! _WIN32 && ! __DJGPP__ */
+
+main (int argc, char **argv)
+{
+  struct expr *e;
+  int i;
+  mpz_t r;
+  int errcode = 0;
+  char *str;
+  int base = 10;
+
+#if !defined(_WIN32) && !defined(__DJGPP__)
+  setup_error_handler ();
+#endif
+
+  mpz_init (r);
+
+  while (argc > 1 && argv[1][0] == '-')
+    {
+      char *arg = argv[1];
+
+      if (arg[1] >= '0' && arg[1] <= '9')
+	break;
+
+      if (arg[1] == 't')
+	print_timing = 1;
+      else if (arg[1] == 'b' && arg[2] >= '0' && arg[2] <= '9')
+	{
+	  base = atoi (arg + 2);
+	  if (base < 2 || base > 36)
+	    {
+	      fprintf (stderr, "error: invalid output base\n");
+	      exit (-1);
+	    }
+	}
+      else if (arg[1] == 'b' && arg[2] == 0)
+	base = 2;
+      else if (arg[1] == 'x' && arg[2] == 0)
+	base = 16;
+      else if (arg[1] == 'o' && arg[2] == 0)
+	base = 8;
+      else if (arg[1] == 'd' && arg[2] == 0)
+	base = 10;
+      else if (strcmp (arg, "-html") == 0)
+	{
+	  flag_html = 1;
+	  newline = "<BR>";
+	}
+      else if (strcmp (arg, "-split") == 0)
+	{
+	  flag_splitup_output = 1;
+	}
+      else if (strcmp (arg, "-noprint") == 0)
+	{
+	  flag_print = 0;
+	}
+      else
+	{
+	  fprintf (stderr, "error: unknown option `%s'\n", arg);
+	  exit (-1);
+	}
+      argv++;
+      argc--;
+    }
+
+  for (i = 1; i < argc; i++)
+    {
+      int s;
+      int jmpval;
+
+      /* Set up error handler for parsing expression.  */
+      jmpval = setjmp (errjmpbuf);
+      if (jmpval != 0)
+	{
+	  fprintf (stderr, "error: %s%s\n", error, newline);
+	  fprintf (stderr, "       %s%s\n", argv[i], newline);
+	  if (! flag_html)
+	    {
+	      /* ??? Dunno how to align expression position with arrow in
+		 HTML ??? */
+	      fprintf (stderr, "       ");
+	      for (s = jmpval - (long) argv[i]; --s >= 0; )
+		putc (' ', stderr);
+	      fprintf (stderr, "^\n");
+	    }
+
+	  errcode |= 1;
+	  continue;
+	}
+
+      str = expr (argv[i], &e);
+
+      if (str[0] != 0)
+	{
+	  fprintf (stderr,
+		   "error: garbage where end of expression expected%s\n",
+		   newline);
+	  fprintf (stderr, "       %s%s\n", argv[i], newline);
+	  if (! flag_html)
+	    {
+	      /* ??? Dunno how to align expression position with arrow in
+		 HTML ??? */
+	      fprintf (stderr, "        ");
+	      for (s = str - argv[i]; --s; )
+		putc (' ', stderr);
+	      fprintf (stderr, "^\n");
+	    }
+
+	  errcode |= 1;
+	  free_expr (e);
+	  continue;
+	}
+
+      /* Set up error handler for evaluating expression.  */
+      if (setjmp (errjmpbuf))
+	{
+	  fprintf (stderr, "error: %s%s\n", error, newline);
+	  fprintf (stderr, "       %s%s\n", argv[i], newline);
+	  if (! flag_html)
+	    {
+	      /* ??? Dunno how to align expression position with arrow in
+		 HTML ??? */
+	      fprintf (stderr, "       ");
+	      for (s = str - argv[i]; --s >= 0; )
+		putc (' ', stderr);
+	      fprintf (stderr, "^\n");
+	    }
+
+	  errcode |= 2;
+	  continue;
+	}
+
+      {
+	int t0;
+
+	if (print_timing)
+	  t0 = cputime ();
+
+	mpz_eval_expr (r, e);
+
+	if (print_timing)
+	  printf ("computation took %d ms%s\n", cputime () - t0, newline);
+      }
+
+      if (flag_print)
+	{
+	  size_t out_len;
+	  char *tmp, *s;
+	  int t0;
+
+	  out_len = mpz_sizeinbase (r, base) + 1;
+	  tmp = malloc (out_len);
+
+	  if (print_timing)
+	    t0 = cputime ();
+
+	  if (print_timing)
+	    /* Print first half of message... */
+	    printf ("output conversion ");
+
+	  mpz_get_str (tmp, -base, r);
+
+	  if (print_timing)
+	    /* ...print 2nd half of message unless we caught a time limit
+	       and therefore longjmp'ed */
+	    printf ("took %d ms%s\n", cputime () - t0, newline);
+
+	  out_len = strlen (tmp);
+	  if (flag_splitup_output)
+	    {
+	      for (s = tmp; out_len > 60; s += 60)
+		{
+		  fwrite (s, 1, 60, stdout);
+		  printf ("%s\n", newline);
+		  out_len -= 60;
+		}
+
+	      fwrite (s, 1, out_len, stdout);
+	    }
+	  else
+	    {
+	      fwrite (tmp, 1, out_len, stdout);
+	    }
+
+	  free (tmp);
+	  printf ("%s\n", newline);
+	}
+      else
+	{
+	  printf ("result is approximately %ld digits%s\n",
+		  (long) mpz_sizeinbase (r, 10), newline);
+	}
+
+      free_expr (e);
+    }
+
+  exit (errcode);
+}
+
+char *
+expr (char *str, expr_t *e)
+{
+  expr_t e2;
+
+  str = skipspace (str);
+  if (str[0] == '+')
+    {
+      str = term (str + 1, e);
+    }
+  else if (str[0] == '-')
+    {
+      str = term (str + 1, e);
+      makeexp (e, NEG, *e, NULL);
+    }
+  else if (str[0] == '~')
+    {
+      str = term (str + 1, e);
+      makeexp (e, NOT, *e, NULL);
+    }
+  else
+    {
+      str = term (str, e);
+    }
+
+  for (;;)
+    {
+      str = skipspace (str);
+      switch (str[0])
+	{
+	case 'p':
+	  if (match ("plus", str))
+	    {
+	      str = term (str + 4, &e2);
+	      makeexp (e, PLUS, *e, e2);
+	    }
+	  else
+	    return str;
+	  break;
+	case 'm':
+	  if (match ("minus", str))
+	    {
+	      str = term (str + 5, &e2);
+	      makeexp (e, MINUS, *e, e2);
+	    }
+	  else
+	    return str;
+	  break;
+	case '+':
+	  str = term (str + 1, &e2);
+	  makeexp (e, PLUS, *e, e2);
+	  break;
+	case '-':
+	  str = term (str + 1, &e2);
+	  makeexp (e, MINUS, *e, e2);
+	  break;
+	default:
+	  return str;
+	}
+    }
+}
+
+char *
+term (char *str, expr_t *e)
+{
+  expr_t e2;
+
+  str = power (str, e);
+  for (;;)
+    {
+      str = skipspace (str);
+      switch (str[0])
+	{
+	case 'm':
+	  if (match ("mul", str))
+	    {
+	      str = power (str + 3, &e2);
+	      makeexp (e, MULT, *e, e2);
+	      break;
+	    }
+	  if (match ("mod", str))
+	    {
+	      str = power (str + 3, &e2);
+	      makeexp (e, MOD, *e, e2);
+	      break;
+	    }
+	  return str;
+	case 'd':
+	  if (match ("div", str))
+	    {
+	      str = power (str + 3, &e2);
+	      makeexp (e, DIV, *e, e2);
+	      break;
+	    }
+	  return str;
+	case 'r':
+	  if (match ("rem", str))
+	    {
+	      str = power (str + 3, &e2);
+	      makeexp (e, REM, *e, e2);
+	      break;
+	    }
+	  return str;
+	case 'i':
+	  if (match ("invmod", str))
+	    {
+	      str = power (str + 6, &e2);
+	      makeexp (e, REM, *e, e2);
+	      break;
+	    }
+	  return str;
+	case 't':
+	  if (match ("times", str))
+	    {
+	      str = power (str + 5, &e2);
+	      makeexp (e, MULT, *e, e2);
+	      break;
+	    }
+	  if (match ("thru", str))
+	    {
+	      str = power (str + 4, &e2);
+	      makeexp (e, DIV, *e, e2);
+	      break;
+	    }
+	  if (match ("through", str))
+	    {
+	      str = power (str + 7, &e2);
+	      makeexp (e, DIV, *e, e2);
+	      break;
+	    }
+	  return str;
+	case '*':
+	  str = power (str + 1, &e2);
+	  makeexp (e, MULT, *e, e2);
+	  break;
+	case '/':
+	  str = power (str + 1, &e2);
+	  makeexp (e, DIV, *e, e2);
+	  break;
+	case '%':
+	  str = power (str + 1, &e2);
+	  makeexp (e, MOD, *e, e2);
+	  break;
+	default:
+	  return str;
+	}
+    }
+}
+
+char *
+power (char *str, expr_t *e)
+{
+  expr_t e2;
+
+  str = factor (str, e);
+  while (str[0] == '!')
+    {
+      str++;
+      makeexp (e, FAC, *e, NULL);
+    }
+  str = skipspace (str);
+  if (str[0] == '^')
+    {
+      str = power (str + 1, &e2);
+      makeexp (e, POW, *e, e2);
+    }
+  return str;
+}
+
+int
+match (char *s, char *str)
+{
+  char *ostr = str;
+  int i;
+
+  for (i = 0; s[i] != 0; i++)
+    {
+      if (str[i] != s[i])
+	return 0;
+    }
+  str = skipspace (str + i);
+  return str - ostr;
+}
+
+int
+matchp (char *s, char *str)
+{
+  char *ostr = str;
+  int i;
+
+  for (i = 0; s[i] != 0; i++)
+    {
+      if (str[i] != s[i])
+	return 0;
+    }
+  str = skipspace (str + i);
+  if (str[0] == '(')
+    return str - ostr + 1;
+  return 0;
+}
+
+struct functions
+{
+  char *spelling;
+  enum op_t op;
+  int arity; /* 1 or 2 means real arity; 0 means arbitrary.  */
+};
+
+struct functions fns[] =
+{
+  {"sqrt", SQRT, 1},
+#if __GNU_MP_VERSION >= 2
+  {"root", ROOT, 2},
+  {"popc", POPCNT, 1},
+#endif
+  {"gcd", GCD, 0},
+#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1
+  {"lcm", LCM, 0},
+#endif
+  {"and", AND, 0},
+  {"ior", IOR, 0},
+#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1
+  {"xor", XOR, 0},
+#endif
+  {"plus", PLUS, 0},
+  {"minus", MINUS, 2},
+  {"mul", MULT, 0},
+  {"div", DIV, 2},
+  {"mod", MOD, 2},
+  {"rem", REM, 2},
+#if __GNU_MP_VERSION >= 2
+  {"invmod", INVMOD, 2},
+#endif
+  {"log", LOG, 2},
+  {"log2", LOG2, 1},
+  {"F", FERMAT, 1},
+  {"M", MERSENNE, 1},
+  {"fib", FIBONACCI, 1},
+  {"Fib", FIBONACCI, 1},
+  {"", NOP, 0}
+};
+
+char *
+factor (char *str, expr_t *e)
+{
+  expr_t e1, e2;
+
+  str = skipspace (str);
+
+  if (isalpha (str[0]))
+    {
+      int i;
+      int cnt;
+
+      for (i = 0; fns[i].op != NOP; i++)
+	{
+	  if (fns[i].arity == 1)
+	    {
+	      cnt = matchp (fns[i].spelling, str);
+	      if (cnt != 0)
+		{
+		  str = expr (str + cnt, &e1);
+		  str = skipspace (str);
+		  if (str[0] != ')')
+		    {
+		      error = "expected `)'";
+		      longjmp (errjmpbuf, (int) (long) str);
+		    }
+		  makeexp (e, fns[i].op, e1, NULL);
+		  return str + 1;
+		}
+	    }
+	}
+
+      for (i = 0; fns[i].op != NOP; i++)
+	{
+	  if (fns[i].arity != 1)
+	    {
+	      cnt = matchp (fns[i].spelling, str);
+	      if (cnt != 0)
+		{
+		  str = expr (str + cnt, &e1);
+		  str = skipspace (str);
+
+		  if (str[0] != ',')
+		    {
+		      error = "expected `,' and another operand";
+		      longjmp (errjmpbuf, (int) (long) str);
+		    }
+
+		  str = skipspace (str + 1);
+		  str = expr (str, &e2);
+		  str = skipspace (str);
+
+		  if (fns[i].arity == 0)
+		    {
+		      while (str[0] == ',')
+			{
+			  makeexp (&e1, fns[i].op, e1, e2);
+			  str = skipspace (str + 1);
+			  str = expr (str, &e2);
+			  str = skipspace (str);
+			}
+		    }
+
+		  if (str[0] != ')')
+		    {
+		      error = "expected `)'";
+		      longjmp (errjmpbuf, (int) (long) str);
+		    }
+
+		  makeexp (e, fns[i].op, e1, e2);
+		  return str + 1;
+		}
+	    }
+	}
+    }
+
+  if (str[0] == '(')
+    {
+      str = expr (str + 1, e);
+      str = skipspace (str);
+      if (str[0] != ')')
+	{
+	  error = "expected `)'";
+	  longjmp (errjmpbuf, (int) (long) str);
+	}
+      str++;
+    }
+  else if (str[0] >= '0' && str[0] <= '9')
+    {
+      expr_t res;
+      char *s, *sc;
+
+      res = malloc (sizeof (struct expr));
+      res -> op = LIT;
+      mpz_init (res->operands.val);
+
+      s = str;
+      while (isalnum (str[0]))
+	str++;
+      sc = malloc (str - s + 1);
+      memcpy (sc, s, str - s);
+      sc[str - s] = 0;
+
+      mpz_set_str (res->operands.val, sc, 0);
+      *e = res;
+      free (sc);
+    }
+  else
+    {
+      error = "operand expected";
+      longjmp (errjmpbuf, (int) (long) str);
+    }
+  return str;
+}
+
+char *
+skipspace (char *str)
+{
+  while (str[0] == ' ')
+    str++;
+  return str;
+}
+
+/* Make a new expression with operation OP and right hand side
+   RHS and left hand side lhs.  Put the result in R.  */
+void
+makeexp (expr_t *r, enum op_t op, expr_t lhs, expr_t rhs)
+{
+  expr_t res;
+  res = malloc (sizeof (struct expr));
+  res -> op = op;
+  res -> operands.ops.lhs = lhs;
+  res -> operands.ops.rhs = rhs;
+  *r = res;
+  return;
+}
+
+/* Free the memory used by expression E.  */
+void
+free_expr (expr_t e)
+{
+  if (e->op != LIT)
+    {
+      free_expr (e->operands.ops.lhs);
+      if (e->operands.ops.rhs != NULL)
+	free_expr (e->operands.ops.rhs);
+    }
+  else
+    {
+      mpz_clear (e->operands.val);
+    }
+}
+
+/* Evaluate the expression E and put the result in R.  */
+void
+mpz_eval_expr (mpz_ptr r, expr_t e)
+{
+  mpz_t lhs, rhs;
+
+  switch (e->op)
+    {
+    case LIT:
+      mpz_set (r, e->operands.val);
+      return;
+    case PLUS:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_add (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+    case MINUS:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_sub (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+    case MULT:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_mul (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+    case DIV:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_fdiv_q (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+    case MOD:
+      mpz_init (rhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_abs (rhs, rhs);
+      mpz_eval_mod_expr (r, e->operands.ops.lhs, rhs);
+      mpz_clear (rhs);
+      return;
+    case REM:
+      /* Check if lhs operand is POW expression and optimize for that case.  */
+      if (e->operands.ops.lhs->op == POW)
+	{
+	  mpz_t powlhs, powrhs;
+	  mpz_init (powlhs);
+	  mpz_init (powrhs);
+	  mpz_init (rhs);
+	  mpz_eval_expr (powlhs, e->operands.ops.lhs->operands.ops.lhs);
+	  mpz_eval_expr (powrhs, e->operands.ops.lhs->operands.ops.rhs);
+	  mpz_eval_expr (rhs, e->operands.ops.rhs);
+	  mpz_powm (r, powlhs, powrhs, rhs);
+	  if (mpz_cmp_si (rhs, 0L) < 0)
+	    mpz_neg (r, r);
+	  mpz_clear (powlhs);
+	  mpz_clear (powrhs);
+	  mpz_clear (rhs);
+	  return;
+	}
+
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_fdiv_r (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+#if __GNU_MP_VERSION >= 2
+    case INVMOD:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_invert (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+#endif
+    case POW:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      if (mpz_cmp_si (rhs, 0L) == 0)
+	/* x^0 is 1 */
+	mpz_set_ui (r, 1L);
+      else if (mpz_cmp_si (lhs, 0L) == 0)
+	/* 0^y (where y != 0) is 0 */
+	mpz_set_ui (r, 0L);
+      else if (mpz_cmp_ui (lhs, 1L) == 0)
+	/* 1^y is 1 */
+	mpz_set_ui (r, 1L);
+      else if (mpz_cmp_si (lhs, -1L) == 0)
+	/* (-1)^y just depends on whether y is even or odd */
+	mpz_set_si (r, (mpz_get_ui (rhs) & 1) ? -1L : 1L);
+      else if (mpz_cmp_si (rhs, 0L) < 0)
+	/* x^(-n) is 0 */
+	mpz_set_ui (r, 0L);
+      else
+	{
+	  unsigned long int cnt;
+	  unsigned long int y;
+	  /* error if exponent does not fit into an unsigned long int.  */
+	  if (mpz_cmp_ui (rhs, ~(unsigned long int) 0) > 0)
+	    goto pow_err;
+
+	  y = mpz_get_ui (rhs);
+	  /* x^y == (x/(2^c))^y * 2^(c*y) */
+#if __GNU_MP_VERSION >= 2
+	  cnt = mpz_scan1 (lhs, 0);
+#else
+	  cnt = 0;
+#endif
+	  if (cnt != 0)
+	    {
+	      if (y * cnt / cnt != y)
+		goto pow_err;
+	      mpz_tdiv_q_2exp (lhs, lhs, cnt);
+	      mpz_pow_ui (r, lhs, y);
+	      mpz_mul_2exp (r, r, y * cnt);
+	    }
+	  else
+	    mpz_pow_ui (r, lhs, y);
+	}
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+    pow_err:
+      error = "result of `pow' operator too large";
+      mpz_clear (lhs); mpz_clear (rhs);
+      longjmp (errjmpbuf, 1);
+    case GCD:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_gcd (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1
+    case LCM:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_lcm (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+#endif
+    case AND:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_and (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+    case IOR:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_ior (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1
+    case XOR:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      mpz_xor (r, lhs, rhs);
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+#endif
+    case NEG:
+      mpz_eval_expr (r, e->operands.ops.lhs);
+      mpz_neg (r, r);
+      return;
+    case NOT:
+      mpz_eval_expr (r, e->operands.ops.lhs);
+      mpz_com (r, r);
+      return;
+    case SQRT:
+      mpz_init (lhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      if (mpz_sgn (lhs) < 0)
+	{
+	  error = "cannot take square root of negative numbers";
+	  mpz_clear (lhs);
+	  longjmp (errjmpbuf, 1);
+	}
+      mpz_sqrt (r, lhs);
+      return;
+#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1
+    case ROOT:
+      mpz_init (lhs); mpz_init (rhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      mpz_eval_expr (rhs, e->operands.ops.rhs);
+      if (mpz_sgn (rhs) <= 0)
+	{
+	  error = "cannot take non-positive root orders";
+	  mpz_clear (lhs); mpz_clear (rhs);
+	  longjmp (errjmpbuf, 1);
+	}
+      if (mpz_sgn (lhs) < 0 && (mpz_get_ui (rhs) & 1) == 0)
+	{
+	  error = "cannot take even root orders of negative numbers";
+	  mpz_clear (lhs); mpz_clear (rhs);
+	  longjmp (errjmpbuf, 1);
+	}
+
+      {
+	unsigned long int nth = mpz_get_ui (rhs);
+	if (mpz_cmp_ui (rhs, ~(unsigned long int) 0) > 0)
+	  {
+	    /* If we are asked to take an awfully large root order, cheat and
+	       ask for the largest order we can pass to mpz_root.  This saves
+	       some error prone special cases.  */
+	    nth = ~(unsigned long int) 0;
+	  }
+	mpz_root (r, lhs, nth);
+      }
+      mpz_clear (lhs); mpz_clear (rhs);
+      return;
+#endif
+    case FAC:
+      mpz_eval_expr (r, e->operands.ops.lhs);
+      if (mpz_size (r) > 1)
+	{
+	  error = "result of `!' operator too large";
+	  longjmp (errjmpbuf, 1);
+	}
+      mpz_fac_ui (r, mpz_get_ui (r));
+      return;
+#if __GNU_MP_VERSION >= 2
+    case POPCNT:
+      mpz_eval_expr (r, e->operands.ops.lhs);
+      { unsigned long int cnt;
+	cnt = mpz_popcount (r);
+	mpz_set_ui (r, cnt);
+      }
+      return;
+#endif
+    case LOG2:
+      mpz_eval_expr (r, e->operands.ops.lhs);
+      { unsigned long int cnt;
+	if (mpz_sgn (r) <= 0)
+	  {
+	    error = "logarithm of non-positive number";
+	    longjmp (errjmpbuf, 1);
+	  }
+	cnt = mpz_sizeinbase (r, 2);
+	mpz_set_ui (r, cnt - 1);
+      }
+      return;
+    case LOG:
+      { unsigned long int cnt;
+	mpz_init (lhs); mpz_init (rhs);
+	mpz_eval_expr (lhs, e->operands.ops.lhs);
+	mpz_eval_expr (rhs, e->operands.ops.rhs);
+	if (mpz_sgn (lhs) <= 0)
+	  {
+	    error = "logarithm of non-positive number";
+	    mpz_clear (lhs); mpz_clear (rhs);
+	    longjmp (errjmpbuf, 1);
+	  }
+	if (mpz_cmp_ui (rhs, 256) >= 0)
+	  {
+	    error = "logarithm base too large";
+	    mpz_clear (lhs); mpz_clear (rhs);
+	    longjmp (errjmpbuf, 1);
+	  }
+	cnt = mpz_sizeinbase (lhs, mpz_get_ui (rhs));
+	mpz_set_ui (r, cnt - 1);
+	mpz_clear (lhs); mpz_clear (rhs);
+      }
+      return;
+    case FERMAT:
+      {
+	unsigned long int t;
+	mpz_init (lhs);
+	mpz_eval_expr (lhs, e->operands.ops.lhs);
+	t = (unsigned long int) 1 << mpz_get_ui (lhs);
+	if (mpz_cmp_ui (lhs, ~(unsigned long int) 0) > 0 || t == 0)
+	  {
+	    error = "too large Mersenne number index";
+	    mpz_clear (lhs);
+	    longjmp (errjmpbuf, 1);
+	  }
+	mpz_set_ui (r, 1);
+	mpz_mul_2exp (r, r, t);
+	mpz_add_ui (r, r, 1);
+	mpz_clear (lhs);
+      }
+      return;
+    case MERSENNE:
+      mpz_init (lhs);
+      mpz_eval_expr (lhs, e->operands.ops.lhs);
+      if (mpz_cmp_ui (lhs, ~(unsigned long int) 0) > 0)
+	{
+	  error = "too large Mersenne number index";
+	  mpz_clear (lhs);
+	  longjmp (errjmpbuf, 1);
+	}
+      mpz_set_ui (r, 1);
+      mpz_mul_2exp (r, r, mpz_get_ui (lhs));
+      mpz_sub_ui (r, r, 1);
+      mpz_clear (lhs);
+      return;
+    case FIBONACCI:
+      { mpz_t t;
+	unsigned long int n, i;
+	mpz_init (lhs);
+	mpz_eval_expr (lhs, e->operands.ops.lhs);
+	if (mpz_sgn (lhs) <= 0 || mpz_cmp_si (lhs, 1000000000) > 0)
+	  {
+	    error = "Fibonacci index out of range";
+	    mpz_clear (lhs);
+	    longjmp (errjmpbuf, 1);
+	  }
+	n = mpz_get_ui (lhs);
+	mpz_clear (lhs);
+
+#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1
+	mpz_fib_ui (r, n);
+#else
+	mpz_init_set_ui (t, 1);
+	mpz_set_ui (r, 1);
+
+	if (n <= 2)
+	  mpz_set_ui (r, 1);
+	else
+	  {
+	    for (i = 3; i <= n; i++)
+	      {
+		mpz_add (t, t, r);
+		mpz_swap (t, r);
+	      }
+	  }
+	mpz_clear (t);
+#endif
+      }
+      return;
+    default:
+      abort ();
+    }
+}
+
+/* Evaluate the expression E modulo MOD and put the result in R.  */
+void
+mpz_eval_mod_expr (mpz_ptr r, expr_t e, mpz_ptr mod)
+{
+  mpz_t lhs, rhs;
+
+  switch (e->op)
+    {
+      case POW:
+	mpz_init (lhs); mpz_init (rhs);
+	mpz_eval_mod_expr (lhs, e->operands.ops.lhs, mod);
+	mpz_eval_expr (rhs, e->operands.ops.rhs);
+	mpz_powm (r, lhs, rhs, mod);
+	mpz_clear (lhs); mpz_clear (rhs);
+	return;
+      case PLUS:
+	mpz_init (lhs); mpz_init (rhs);
+	mpz_eval_mod_expr (lhs, e->operands.ops.lhs, mod);
+	mpz_eval_mod_expr (rhs, e->operands.ops.rhs, mod);
+	mpz_add (r, lhs, rhs);
+	if (mpz_cmp_si (r, 0L) < 0)
+	  mpz_add (r, r, mod);
+	else if (mpz_cmp (r, mod) >= 0)
+	  mpz_sub (r, r, mod);
+	mpz_clear (lhs); mpz_clear (rhs);
+	return;
+      case MINUS:
+	mpz_init (lhs); mpz_init (rhs);
+	mpz_eval_mod_expr (lhs, e->operands.ops.lhs, mod);
+	mpz_eval_mod_expr (rhs, e->operands.ops.rhs, mod);
+	mpz_sub (r, lhs, rhs);
+	if (mpz_cmp_si (r, 0L) < 0)
+	  mpz_add (r, r, mod);
+	else if (mpz_cmp (r, mod) >= 0)
+	  mpz_sub (r, r, mod);
+	mpz_clear (lhs); mpz_clear (rhs);
+	return;
+      case MULT:
+	mpz_init (lhs); mpz_init (rhs);
+	mpz_eval_mod_expr (lhs, e->operands.ops.lhs, mod);
+	mpz_eval_mod_expr (rhs, e->operands.ops.rhs, mod);
+	mpz_mul (r, lhs, rhs);
+	mpz_mod (r, r, mod);
+	mpz_clear (lhs); mpz_clear (rhs);
+	return;
+      default:
+	mpz_init (lhs);
+	mpz_eval_expr (lhs, e);
+	mpz_mod (r, lhs, mod);
+	mpz_clear (lhs);
+	return;
+    }
+}
+
+void
+cleanup_and_exit (int sig)
+{
+#ifdef LIMIT_RESOURCE_USAGE
+  if (sig == SIGXCPU)
+    printf ("expression took too long time to evaluate%s\n", newline);
+  else if (sig == SIGFPE)
+    printf ("divide by zero%s\n", newline);
+  else
+#endif
+    printf ("expression required too much memory to evaluate%s\n", newline);
+  exit (-2);
+}
+
+/* Return user CPU time measured in milliseconds.  */
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
diff --git a/src/gmp/demos/primes.c b/src/gmp/demos/primes.c
new file mode 100644
index 000000000..d19c3f750
--- /dev/null
+++ b/src/gmp/demos/primes.c
@@ -0,0 +1,145 @@
+/* List and count primes.
+
+Copyright (C) 2000 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 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.  */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include "gmp.h"
+
+/* Sieve table size */
+#define ST_SIZE 30000
+/* Largest prime to sieve with */
+#define MAX_S_PRIME 1000
+
+main (int argc, char **argv)
+{
+  char *progname = argv[0];
+  mpz_t r0, r1;			/* range */
+  mpz_t cur;
+  unsigned char *st;
+  unsigned long i, ii;
+  unsigned long nprimes = 0;
+  unsigned long last;
+  int flag_print = 1;
+  int flag_count = 0;
+
+  st = malloc (ST_SIZE);
+
+  while (argc != 1)
+    {
+      if (strcmp (argv[1], "-c") == 0)
+	{
+	  flag_count = 1;
+	  argv++;
+	  argc--;
+	}
+      else if (strcmp (argv[1], "-p") == 0)
+	{
+	  flag_print = 2;
+	  argv++;
+	  argc--;
+	}
+      else
+	break;
+    }
+
+  if (flag_count)
+    flag_print--;		/* clear unless an explicit -p  */
+
+  mpz_init (r0);
+  mpz_init (r1);
+  mpz_init (cur);
+
+  if (argc == 2)
+    {
+      mpz_set_ui (r0, 2);
+      mpz_set_str (r1, argv[1], 0);
+    }
+  else if (argc == 3)
+    {
+      mpz_set_str (r0, argv[1], 0);
+      if (argv[2][0] == '+')
+	{
+	  mpz_set_str (r1, argv[2] + 1, 0);
+	  mpz_add (r1, r1, r0);
+	}
+      else
+	mpz_set_str (r1, argv[2], 0);
+    }
+  else
+    {
+      fprintf (stderr, "usage: %s [-c] [-g] [from [+]]to\n", progname);
+      exit (1);
+    }
+
+  if (mpz_cmp_ui (r0, 2) < 0)
+    mpz_set_ui (r0, 2);
+
+  if ((mpz_get_ui (r0) & 1) == 0)
+    {
+      if (mpz_cmp_ui (r0, 2) == 0)
+	{
+	  if (flag_print)
+	    puts ("2");
+	  nprimes++;
+	}
+      mpz_add_ui (r0, r0, 1);
+    }
+
+  mpz_set (cur, r0);
+
+  while (mpz_cmp (cur, r1) <= 0)
+    {
+      memset (st, 1, ST_SIZE);
+      for (i = 3; i < MAX_S_PRIME; i += 2)
+	{
+	  unsigned long start;
+	  start = mpz_tdiv_ui (cur, i);
+	  if (start != 0)
+	    start = i - start;
+	  
+	  if (mpz_cmp_ui (cur, i - start) == 0)
+	    start += i;
+	  for (ii = start; ii < ST_SIZE; ii += i)
+	    st[ii] = 0;
+	}
+      last = 0;
+      for (ii = 0; ii < ST_SIZE; ii += 2)
+	{
+	  if (st[ii] != 0)
+	    {
+	      mpz_add_ui (cur, cur, ii - last);
+	      last = ii;
+	      if (mpz_cmp (cur, r1) > 0)
+		goto done;
+	      if (mpz_probab_prime_p (cur, 3))
+		{
+		  nprimes++;
+		  if (flag_print)
+		    {
+		      mpz_out_str (stdout, 10, cur); puts ("");
+		    }
+		}
+	    }
+	}
+      mpz_add_ui (cur, cur, ST_SIZE - last);
+    }
+ done:
+  if (flag_count)
+    printf ("Pi(interval) = %lu\n", nprimes);
+
+  exit (0);
+}
diff --git a/src/gmp/demos/qcn.c b/src/gmp/demos/qcn.c
new file mode 100644
index 000000000..744980304
--- /dev/null
+++ b/src/gmp/demos/qcn.c
@@ -0,0 +1,151 @@
+/* Use mpz_kronecker_ui() to calculate an estimate for the quadratic
+   class number h(d), for a given negative fundamental discriminant, using
+   Dirichlet's analytic formula. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+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.  */
+
+
+/* Usage: qcn <discriminant>...
+
+   A fundamental discriminant means one of the form D or 4*D with D
+   square-free.  Each argument is checked to see it's congruent to 0 or 1
+   mod 4 (as all discriminants must be), and that it's negative, but there's
+   no check on D being square-free.
+
+   This program is a bit of a toy, there are better methods for calculating
+   the class number and class group structure.
+
+   Reference:
+
+   Daniel Shanks, "Class Number, A Theory of Factorization, and Genera",
+   Proc. Symp. Pure Math., vol 20, 1970, pages 415-440.
+
+*/
+
+#include <math.h>
+#include <stdio.h>
+
+#include "gmp.h"
+
+
+/* A simple but slow primality test.  */
+int
+prime_p (unsigned long n)
+{
+  unsigned long  i, limit;
+
+  if (n == 2)
+    return 1;
+  if (n < 2 || !(n&1))
+    return 0;
+
+  limit = (unsigned long) floor (sqrt ((double) n));
+  for (i = 3; i <= limit; i+=2)
+    if ((n % i) == 0)
+      return 0;
+
+  return 1;
+}
+
+
+/* The formula is as follows, with d < 0.
+
+               w * sqrt(-d)      inf      p
+        h(d) = ------------ *  product --------
+                  2 * pi         p=2   p - (d/p)
+                             
+
+   (d/p) is the Kronecker symbol and the product is over primes p.  w is 6
+   when d=-3, 4 when d=-4, or 2 otherwise.
+  
+   Calculating the product up to p=infinity would take a long time, so for
+   the estimate primes up to 132,000 are used.  Shanks found this giving an
+   accuracy of about 1 part in 1000, in normal cases.  */
+
+double
+qcn_estimate (mpz_t d)
+{
+#define P_LIMIT  132000
+
+  double  h;
+  unsigned long  p;
+
+  /* p=2 */
+  h = sqrt (-mpz_get_d (d)) / M_PI
+    * 2.0 / (2.0 - mpz_kronecker_ui (d, 2));
+
+  if (mpz_cmp_si (d, -3) == 0)       h *= 3;
+  else if (mpz_cmp_si (d, -4) == 0)  h *= 2;
+
+  for (p = 3; p < P_LIMIT; p += 2)
+    if (prime_p (p))
+      h *= (double) p / (double) (p - mpz_kronecker_ui (d, p));
+
+  return h;
+}
+
+
+void
+qcn_str (char *num)
+{
+  mpz_t  z;
+
+  mpz_init_set_str (z, num, 0);
+
+  if (mpz_sgn (z) >= 0)
+    {
+      mpz_out_str (stdout, 0, z);
+      printf (" is not supported (negatives only)\n");
+    }
+  else if (mpz_fdiv_ui (z, 4) != 0 && mpz_fdiv_ui (z, 4) != 1)
+    {
+      mpz_out_str (stdout, 0, z);
+      printf (" is not a discriminant (must == 0 or 1 mod 4)\n");
+    }
+  else
+    {
+      printf ("h(");
+      mpz_out_str (stdout, 0, z);
+      printf (") approx %.1f\n", qcn_estimate (z));
+    }
+  mpz_clear (z);
+}
+
+
+int
+main (int argc, char *argv[])
+{
+  int  i;
+
+  if (argc < 2)
+    {
+      qcn_str ("-85702502803");           /* is 16259   */
+      qcn_str ("-328878692999");          /* is 1499699 */
+      qcn_str ("-928185925902146563");    /* is 52739552 */
+      qcn_str ("-84148631888752647283");  /* is 496652272 */
+    }
+  else
+    {
+      for (i = 1; i < argc; i++)
+        qcn_str (argv[i]);
+    }
+
+  return 0;
+}
diff --git a/src/gmp/depcomp b/src/gmp/depcomp
new file mode 100755
index 000000000..790609673
--- /dev/null
+++ b/src/gmp/depcomp
@@ -0,0 +1,269 @@
+#! /bin/sh
+
+# depcomp - compile a program generating dependencies as side-effects
+# Copyright (C) 1999 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 program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# Originally written by Alexandre Oliva <oliva@dcc.unicamp.br>.
+
+if test -z "$depmode" || test -z "$source" || test -z "$object"; then
+  echo "depcomp: Variables source, object and depmode must be set" 1>&2
+  exit 1
+fi
+# `libtool' can also be set to `yes' or `no'.
+
+depfile=${depfile-`echo "$object" | sed 's,\([^/]*\)$,.deps/\1,;s/\.\([^.]*\)$/.P\1/'`}
+tmpdepfile=${tmpdepfile-`echo "$depfile" | sed 's/\.\([^.]*\)$/.T\1/'`}
+
+rm -f "$tmpdepfile"
+
+# Some modes work just like other modes, but use different flags.  We
+# parameterize here, but still list the modes in the big case below,
+# to make depend.m4 easier to write.  Note that we *cannot* use a case
+# here, because this file can only contain one case statement.
+if test "$depmode" = hp; then
+  # HP compiler uses -M and no extra arg.
+  gccflag=-M
+  depmode=gcc
+fi
+
+if test "$depmode" = dashXmstdout; then
+   # This is just like dashmstdout with a different argument.
+   dashmflag=-xM
+   depmode=dashmstdout
+fi
+
+case "$depmode" in
+gcc)
+## There are various ways to get dependency output from gcc.  Here's
+## why we pick this rather obscure method:
+## - Don't want to use -MD because we'd like the dependencies to end
+##   up in a subdir.  Having to rename by hand is ugly.
+##   (We might end up doing this anyway to support other compilers.)
+## - The DEPENDENCIES_OUTPUT environment variable makes gcc act like
+##   -MM, not -M (despite what the docs say).
+## - Using -M directly means running the compiler twice (even worse
+##   than renaming).
+  if test -z "$gccflag"; then
+    gccflag=-MD,
+  fi
+  if "$@" -Wp,"$gccflag$tmpdepfile"; then :
+  else
+    stat=$?
+    rm -f "$tmpdepfile"
+    exit $stat
+  fi
+  rm -f "$depfile" 
+  echo "$object : \\" > "$depfile"
+  sed 's/^[^:]*: / /' < "$tmpdepfile" >> "$depfile"
+## This next piece of magic avoids the `deleted header file' problem.
+## The problem is that when a header file which appears in a .P file
+## is deleted, the dependency causes make to die (because there is
+## typically no way to rebuild the header).  We avoid this by adding
+## dummy dependencies for each header file.  Too bad gcc doesn't do
+## this for us directly.
+  tr ' ' '
+' < "$tmpdepfile" |
+## Some versions of gcc put a space before the `:'.  On the theory
+## that the space means something, we add a space to the output as
+## well.
+## Some versions of the HPUX 10.20 sed can't process this invocation
+## correctly.  Breaking it into two sed invocations is a workaround.
+    sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
+  rm -f "$tmpdepfile"
+  ;;
+
+hp)
+  # This case exists only to let depend.m4 do its work.  It works by
+  # looking at the text of this script.  This case will never be run,
+  # since it is checked for above.
+  exit 1
+  ;;
+
+dashmd)
+  # The Java front end to gcc doesn't run cpp, so we can't use the -Wp
+  # trick.  Instead we must use -M and then rename the resulting .d
+  # file.  This is also the case for older versions of gcc, which
+  # don't implement -Wp.
+  if "$@" -MD; then :
+  else
+    stat=$?
+    rm -f FIXME
+    exit $stat
+  fi
+  FIXME: rewrite the file
+  ;;
+
+sgi)
+  if test "$libtool" = yes; then
+    "$@" "-Wc,-MDupdate,$tmpdepfile"
+  else
+    "$@" -MDupdate "$tmpdepfile"
+  fi
+  stat=$?
+  if test $stat -eq 0; then :
+  else
+    stat=$?
+    rm -f "$tmpdepfile"
+    exit $stat
+  fi
+  rm -f "$depfile" 
+  echo "$object : \\" > "$depfile"
+  sed 's/^[^:]*: / /' < "$tmpdepfile" >> "$depfile"
+  tr ' ' '
+' < "$tmpdepfile" | \
+## Some versions of the HPUX 10.20 sed can't process this invocation
+## correctly.  Breaking it into two sed invocations is a workaround.
+    sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
+  rm -f "$tmpdepfile"
+  ;;
+
+#nosideeffect)
+  # This comment above is used by automake to tell side-effect
+  # dependency tracking mechanisms from slower ones.
+
+dashmstdout)
+  # Important note: in order to support this mode, a compiler *must*
+  # always write the proprocessed file to stdout, regardless of -o,
+  # because we must use -o when running libtool.
+  test -z "$dashmflag" && dashmflag=-M
+  ( IFS=" "
+    case " $* " in
+    *" --mode=compile "*) # this is libtool, let us make it quiet
+      for arg
+      do # cycle over the arguments
+        case "$arg" in
+	"--mode=compile")
+	  # insert --quiet before "--mode=compile"
+	  set fnord "$@" --quiet
+	  shift # fnord
+	  ;;
+	esac
+	set fnord "$@" "$arg"
+	shift # fnord
+	shift # "$arg"
+      done
+      ;;
+    esac
+    "$@" $dashmflag | sed 's:^[^:]*\:[ 	]*:'"$object"'\: :' > "$tmpdepfile"
+  ) &
+  proc=$!
+  "$@"
+  stat=$?
+  wait "$proc"
+  if test "$stat" != 0; then exit $stat; fi
+  rm -f "$depfile" 
+  cat < "$tmpdepfile" > "$depfile"
+  tr ' ' '
+' < "$tmpdepfile" | \
+## Some versions of the HPUX 10.20 sed can't process this invocation
+## correctly.  Breaking it into two sed invocations is a workaround.
+    sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
+  rm -f "$tmpdepfile"
+  ;;
+
+dashXmstdout)
+  # This case only exists to satisfy depend.m4.  It is never actually
+  # run, as this mode is specially recognized in the preamble.
+  exit 1
+  ;;
+
+makedepend)
+  # X makedepend
+  (
+    shift
+    cleared=no
+    for arg in "$@"; do
+      case $cleared in no)
+        set ""; shift
+	cleared=yes
+      esac
+      case "$arg" in
+        -D*|-I*)
+	  set fnord "$@" "$arg"; shift;;
+	-*)
+	  ;;
+	*)
+	  set fnord "$@" "$arg"; shift;;
+      esac
+    done
+    obj_suffix="`echo $object | sed 's/^.*\././'`"
+    touch "$tmpdepfile"
+    ${MAKEDEPEND-makedepend} 2>/dev/null -o"$obj_suffix" -f"$tmpdepfile" "$@"
+  ) &
+  proc=$!
+  "$@"
+  stat=$?
+  wait "$proc"
+  if test "$stat" != 0; then exit $stat; fi
+  rm -f "$depfile" 
+  cat < "$tmpdepfile" > "$depfile"
+  tail +3 "$tmpdepfile" | tr ' ' '
+' | \
+## Some versions of the HPUX 10.20 sed can't process this invocation
+## correctly.  Breaking it into two sed invocations is a workaround.
+    sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
+  rm -f "$tmpdepfile" "$tmpdepfile".bak
+  ;;
+
+cpp)
+  # Important note: in order to support this mode, a compiler *must*
+  # always write the proprocessed file to stdout, regardless of -o,
+  # because we must use -o when running libtool.
+  ( IFS=" "
+    case " $* " in
+    *" --mode=compile "*)
+      for arg
+      do # cycle over the arguments
+        case "$arg" in
+	"--mode=compile")
+	  # insert --quiet before "--mode=compile"
+	  set fnord "$@" --quiet
+	  shift # fnord
+	  ;;
+	esac
+	set fnord "$@" "$arg"
+	shift # fnord
+	shift # "$arg"
+      done
+      ;;
+    esac
+    "$@" -E |
+    sed -n '/^# [0-9][0-9]* "\([^"]*\)"/ s::'"$object"'\: \1:p' > "$tmpdepfile"
+  ) &
+  proc=$!
+  "$@"
+  stat=$?
+  wait "$proc"
+  if test "$stat" != 0; then exit $stat; fi
+  rm -f "$depfile"
+  cat < "$tmpdepfile" > "$depfile"
+  sed < "$tmpdepfile" -e 's/^[^:]*: //' -e 's/$/ :/' >> "$depfile"
+  rm -f "$tmpdepfile"
+  ;;
+
+none)
+  exec "$@"
+  ;;
+
+*)
+  echo "Unknown depmode $depmode" 1>&2
+  exit 1
+  ;;
+esac
+
+exit 0
diff --git a/src/gmp/doc/assembly_code b/src/gmp/doc/assembly_code
new file mode 100644
index 000000000..3b371a560
--- /dev/null
+++ b/src/gmp/doc/assembly_code
@@ -0,0 +1,57 @@
+Most mpn subdirectories contain machine-dependent code, written in
+assembly or C.  The `generic' subdirectory contains default code, used
+when there is no machine-dependent replacement for a particular
+machine.
+
+There is one subdirectory for each ISA family.  Note that e.g., 32-bit SPARC
+and 64-bit SPARC are very different ISA's, and thus cannot share any code.
+
+A particular compile will only use code from one subdirectory, and the
+`generic' subdirectory.  The ISA-specific subdirectories contain hierarchies of
+directories for various architecture variants and implementations; the
+top-most level contains code that runs correctly on all variants.
+
+HOW TO WRITE FAST ASSEMBLY CODE FOR GMP
+
+[This should ultimately be made into a chapter of the GMP manual.]
+
+The most basic techniques are software pipelining and loop unrolling.
+
+Software pipelining is the technique of scheduling instructions around
+the branch point in a loop, so that consecutive iterations overlap.
+It is very much like juggling.
+
+Unrolling is useful when software pipelining does not get us close
+enough to the peek performance of a processor's pipeline.  Unrolling
+decreases the loop overhead, but also often allows a more even load on
+a processor's functional units.
+
+For processors with very few registers, software pipelining is not
+feasible as it increases register pressure.
+
+For superscalar machines, it is often the case that all available
+execution capabilities are not used.  Scheduling some instructions
+for these otherwise unused resources will never cost us anything.
+
+Try to determine the alternative instructions that can be used for a
+particular processor.  For GMP, the problem that presents most
+challenges is propagating carry from one iteration to the next.
+Explore the different possibilities for doing that with the available
+instructions!
+
+For wide superscalar processors, the performance might be completely
+determined by the number of dependent instruction required from
+accepting carry-in from the previous iteration until producing
+carry-out for the next iteration.  This is particularly true for
+simple operations like mpn_add_n and mpn_sub_n.  Some carry
+propagation schemes require 4 instructions, translating to at least
+four cycles per iterations.  Other schemes can propagate carry in two
+cycles or even just one cycle.
+
+Therefore, for wide superscalar processors, finding methods with
+"shallow" carry propagation given an instruction set is often the
+central problem we need to address.  The rest is just is hard coding
+work.
+
+[Describe: First find issue maps with desired performance
+	   Then schedule for latency]
diff --git a/src/gmp/doc/configuration b/src/gmp/doc/configuration
new file mode 100644
index 000000000..6ac831ecd
--- /dev/null
+++ b/src/gmp/doc/configuration
@@ -0,0 +1,187 @@
+/* doc/configuration (in Emacs -*-outline-*- format). */
+
+* How to add a new file
+
+** A file in the `mpn' subdirectory
+
+The way we build libmpn (in the `mpn' subdirectory) is quite special.
+
+There is (currently) only one ``generic'' file, one that is truly
+target independent.  That is `mp_bases.c'.  All other files are kept
+in subdirectories of `mpn' with the subdirectory names indicating the
+target processor.  For example, in the `alpha' subdirectory, code
+specific to the Alpha processor is found.
+
+When running `configure', a bunch of symbolic links are made in the
+`mpn' subdirectory.  If the the build host doesn't support symlinks
+then either hard links or copying is used.
+
+There are four types of mpn source files.
+
+  .asm	  Assembly code preprocessed with m4
+  .S	  Assembly code preprocessed with CPP
+  .s	  Assembly code not preprocessed at all
+  .c	  C code
+
+There are two types of .asm files.
+
+  i) ``Normal'' files containing one function, possibly with more than
+     one entry point.
+
+  ii) Multi-function files that generate one of a set of functions
+      according to build options.
+
+
+When adding a new implementation of an existing function,
+
+  i) Put it in the appropriate mpn subdirectory.  It'll be detected and
+     used.
+
+  ii) If it's a .asm or .S, be sure to have a PROLOGUE(func) entry
+      point since configure greps for that to set up the
+      HAVE_NATIVE_func defines in config.h.
+
+When adding a new implementation using a multi-function file, in
+addition do the following,
+
+  i) Use a MULFUNC_PROLOGUE(func1 func2 ...) in the .asm, declaring
+     all the functions implemented, including carry-in variants.
+
+     If there's a separate PROLOGUE(func) for each possible function,
+     then MULFUNC_PROLOGUE isn't necessary (but this is usually not
+     the case).
+
+When adding a new style of multi-function file, in addition do the
+following,
+
+  i) Add to the "case" statement in configure.in which lists each
+     multi-function filename and what function files it can provide.
+
+When adding a completely new mpn function file, do the following,
+
+  i) Add it to configure.in under one of the following
+
+     a) `gmp_mpn_functions' if it exists for every target.  This means
+        there must be a C version in mpn/generic.  (Eg. add_n)
+
+     b) `gmp_mpn_functions_optional' if it's a standard function, but
+        doesn't need to exist for every target.  Code wanting to use
+        this will test HAVE_NATIVE_func to see if it's available.
+        (Eg. copyi)
+
+     c) `extra_functions' for some targets, if it's a special function
+        that only ever needs to exist for certain targets.  Code
+        wanting to use it will generally look for the target, but
+        HAVE_NATIVE_func can be used if desired.
+
+  ii) If you want `HAVE_NATIVE_func' defined in config.h, add 
+      `#undef HAVE_NATIVE_func' to acconfig.h.
+
+  iii) If the function can be provided by a multi-function file,
+       then follow the directions above for them too.
+
+** Add a file in any other directory
+
+When adding a top-level file,
+
+  i) Add it to libgmp_la_SOURCES in Makefile.am.
+
+  ii) If libmp.la needs it, then add it to libmp_la_SOURCES too.
+
+When adding an mpz file,
+
+  i) Add file.c to libmpz_la_SOURCES in mpz/Makefile.am.
+
+  ii) Add mpz/file.lo to MPZ_OBJECTS in the top-level Makefile.am.
+
+If a multi-function mpz file is being added,
+
+  i) In mpz/Makefile.am,
+
+     a) Add the file to EXTRA_DIST.
+
+     b) Add rules copying the file at build time to duplicates with
+        appropriate names.
+
+     c) Add each such func.c to nodist_libmpz_la_SOURCES.
+
+  ii) Add each c) above also as mpz/func.lo in MPZ_OBJECTS in the
+      top-level Makefile.am.
+
+  iii) In the multi-function file, expect a preprocessor symbol
+       OPERATION_func to indicate what form is being compiled.
+
+The same applies to mpf and mpq (except that multi-function support
+doesn't exist in mpq/Makefile.am at the moment).
+
+See mpz/mul_siui.c or mpf/integer.c for example multi-function files.
+
+* Selecting compiler and its flags by hand
+
+Specifying CC on the configure command line, will result in a default
+set of compiler flags, CFLAGS; `-g' for all compilers plus `-O2' for
+gcc.  Specify CFLAGS to set better flags.
+
+Example
+
+  $ configure CC=my-gcc
+
+will give 
+
+  CFLAGS = -g -O2
+
+Specifying CC on the configure command line will make configure
+believe it's a 32-bit compiler and not choose a source path with
+64-bit assembly code.  Specify CC64 as well as CC to make configure
+pick 64-bit assembly code.
+
+  $ configure CC=my64bit-cc CC64=my64bit-cc CFLAGS="-my -flags"
+
+* The configure system
+
+** What we use
+We use the tools in <ftp://ftp.swox.com/pub/gmp/infrastructure/>.
+
+** How to install new versions of Autoconf / Automake / Libtool
+
+*** Build Libtool
+With a fresh CVS checkout, run the bootstrap script with released
+versions (not CVS versions) of Autoconf and Automake in PATH.
+
+*** Update gmp directory
+gmp$ rm ltconfig ltmain.sh
+gmp$ libtoolize --copy
+gmp$ automake --add-missing --copy
+
+** How it works
+During development:
+
+    Input files        Tool       Output files
+    ------------------------------------------
+                     aclocal
+    acinclude.m4  --------------> aclocal.m4
+    
+                     autoconf
+    configure.in \ -------------> configure
+    aclocal.m4   /
+    
+                     automake
+    Makefile.am  \ -------------> Makefile.in
+    configure.in / 
+    
+                     autoheader
+    configure.in \ -------------> config.in
+    acconfig.h   /
+
+
+At build time:
+
+    Input files        Tool       Output files
+    ------------------------------------------
+    
+                     configure
+    Makefile.in  \ -------------> / Makefile
+    config.in    /                | config.h
+                                  \ config.m4
+
+/* eof doc/configuration */
diff --git a/src/gmp/doc/isa_abi_headache b/src/gmp/doc/isa_abi_headache
new file mode 100644
index 000000000..c3e3188a7
--- /dev/null
+++ b/src/gmp/doc/isa_abi_headache
@@ -0,0 +1,97 @@
+Terms Used In This Document:
+  ISA = Instruction Set Architecture.   The instructions the current
+        processor provides.
+  ABI = Application Binary Interface.  Specifies calling convention,
+        type sizes, etc.
+  AR64 = Arithmetic operations are 64-bit using 64-bit instructions
+	 (E.g., addition, subtraction, load, store, of 64-bit integer types
+	 are done with single instructions, not 32 bits at a time.)
+  Environment = The operating system and compiler.
+
+GMP is a very complex package to build since its speed is very
+sensitive to the ISA and ABI.  For example, if the ISA provides 64-bit
+instructions, it is crucial that GMP is configured to use them.
+
+Most environments that run on a 64-bit ISA provide more than one ABI.
+Typically one of the supported ABI's is a backward compatible 32-bit
+ABI, and one ABI provides 64-bit addressing and `long' (sometimes
+known as LP64).  But a few environments (IRIX, HP-UX) provide
+intermediate ABI's using 32-bit addressing but allow efficient 64-bit
+operations through a `long long' type.  For the latter to be useful to
+GMP, the ABI must allow operations using the native 64-bit
+instructions provided by the ISA, and allow passing of 64-bit
+quantities atomically.
+
+The ABI is typically chosen by means of command line options to the
+compiler tools (gcc, cc, c89, nm, ar, ld, as).  Different environments
+use different defaults, but as of this writing (May 2000) the
+dominating default is to the plain 32-bit ABI in its most arcane form.
+
+The GMP 3.0.x approach was to compile using the ABI that gives the
+best performance.  That places the burden on users to pass special
+options to the compiler when they compile their GMP applications.
+That approach has its advantages and disadvantages.  The main
+advantage is that users don't unknowingly get bad GMP performance.
+The main disadvantage is that users' compiles (actually links) will
+fail unless they pass special compiler options.
+
+** SPARC
+
+System vendors often confuse ABI, ISA, and implementation.  The worst
+case is Solaris, were the unbundled compiler confuses ISA and ABI, and
+the options have very confusing names.
+
+     option		interpretation
+     ======		==============
+cc   -xarch=v8plus	ISA=sparcv9, ABI=V8plus (PTR=32, see below)
+gcc  -mv8plus		ISA=sparcv9, ABI=V8plus (see below)
+cc   -xarch=v9		ISA=sparcv9, ABI=V9 (implying AR=64, PTR=64)
+
+It's hard to believe, but the option v8plus really means ISA=V9!
+
+Solaris releases prior to version 7 running on a V9 CPU fails to
+save/restore the upper 32 bits of the `i' and `l' registers.  The
+`v8plus' option generates code that use as many V9 features as
+possible under such circumstances.
+
+** MIPS
+
+The IRIX 6 compilers gets things right.  They have a clear
+understanding of the differences between ABI and ISA.  The option
+names are descriptive.
+
+     option		interpretation
+     ======		==============
+cc   -n32		ABI=n32 (implying AR=64, PTR=32)
+gcc  -mabi=n32		ABI=n32 (implying AR=64, PTR=32)
+cc   -64		ABI=64 (implying AR=64, PTR=64)
+gcc  -mabi=64		ABI=64 (implying AR=64, PTR=64)
+cc   -mips3		ISA=mips3
+gcc  -mips3		ISA=mips3
+cc   -mips4		ISA=mips4
+gcc  -mips4		ISA=mips4
+
+** HP-PA
+
+HP-UX is somewhat weird, but not as broken as Solaris.
+
+     option		interpretation
+     ======		==============
+cc   +DA2.0		ABI=32bit (implying AR=64, PTR=32)
+cc   +DD64		ABI=64bit (implying AR=64, PTR=64)
+
+Code performing 64-bit arithmetic in the HP-UX 32-bit is not
+compatible with the 64-bit ABI; the former has a calling convention
+that passes/returns 64-bit integer quantities as two 32-bit chunks.
+
+** PowerPC
+
+While the PowerPC ABI's are capable of supporting 64-bit
+registers/operations, the compilers under AIX are similar to Solaris'
+cc in that they don't currently provide any 32-bit addressing with
+64-bit arithmetic.
+
+     option			interpretation
+     ======			==============
+cc   -q64			ABI=64bit (implying AR=64, PTR=64)
+gcc  -maix64 -mpowerpc64	ABI=64bit (implying AR=64, PTR=64)
diff --git a/src/gmp/doc/multiplication b/src/gmp/doc/multiplication
new file mode 100644
index 000000000..cefcb2cb2
--- /dev/null
+++ b/src/gmp/doc/multiplication
@@ -0,0 +1,404 @@
+
+                         GMP MULTIPLICATION
+
+
+This file describes briefly the multiplication and squaring used in GMP.
+The code is likely to be hard to understand without knowing something about
+the algorithms.
+
+GMP does NxN limb multiplications and squares using one of four algorithms,
+according to the size N.
+
+         Algorithm      Sizes
+
+         basecase    < KARATSUBA_MUL_THRESHOLD
+	 karatsuba   >= KARATSUBA_MUL_THRESHOLD
+	 toom3       >= TOOM3_MUL_THRESHOLD
+	 fft         >= FFT_MUL_THRESHOLD
+
+Similarly for squaring, with the SQR thresholds.  Note though that the FFT
+is only used if GMP is configured with --enable-fft.
+
+MxN multiplications of operands with different sizes are currently done by
+splitting it up into various NxN pieces while above KARATSUBA_MUL_THRESHOLD.
+The karatsuba and toom3 routines then operate only on equal size operands.
+This is rather inefficient, and is slated for improvement in the future.
+
+
+
+BASECASE MULTIPLY
+
+This a straightforward rectangular set of cross-products, the same as long
+multiplication done by hand and for that reason sometimes known as the
+schoolbook or grammar school method.
+
+See Knuth (reference in gmp.texi) volume 2 section 4.3.1 algorithm M, or the
+mpn/generic/mul_basecase.c code.
+
+Assembler implementations of mul_basecase are essentially the same as the
+generic C version, but have all the usual assembler tricks and obscurities
+introduced for speed.
+
+
+
+BASECASE SQUARE
+
+A square can be done in roughly half the time of a multiply, by using the
+fact that the cross products above and below the diagonal are the same.  In
+practice squaring isn't 2x faster than multiplying, but it's always faster
+by a decent factor.
+
+             u0  u1  u2  u3  u4
+           +---+---+---+---+---+
+        u0 | x |   |   |   |   |
+           +---+---+---+---+---+
+        u1 |   | x |   |   |   |
+           +---+---+---+---+---+
+        u2 |   |   | x |   |   |
+           +---+---+---+---+---+
+        u3 |   |   |   | x |   |
+           +---+---+---+---+---+
+        u4 |   |   |   |   | x |
+           +---+---+---+---+---+
+
+The basic algorithm is to calculate a triangle of products below the
+diagonal, double it (left shift by one bit), and add in the products on the
+diagonal.  This can be seen in mpn/generic/sqr_basecase.c.  Again the
+assembler implementations take essentially this same approach.
+
+
+
+
+KARATSUBA MULTIPLY
+
+The Karatsuba multiplication algorithm is described in Knuth volume 2
+section 4.3.3 part A, and in other texts like Geddes et al. section 4.3
+(reference below).  A brief description is given here.
+
+The Karatsuba algorithm treats its inputs x and y as each split in two parts
+of equal length (or the most significant part one limb shorter if N is odd).
+
+         high              low
+        +----------+----------+
+        |    x1    |    x0    |
+        +----------+----------+
+
+        +----------+----------+
+        |    y1    |    y0    |
+        +----------+----------+
+
+Let b be the power of 2 where the split occurs, ie. if x0 is k limbs (y0 the
+same) then b=2^(k*mp_bits_per_limb).  Then x=x1*b+x0 and y=y1*b+y0, and the
+following holds,
+
+	x*y = (b^2+b)*x1*y1 + b*(x1-x0)*(y1-y0) + (b+1)*x0*y0
+
+This formula means doing only three multiplies of (N/2)x(N/2) limbs, whereas
+a basecase multiply of NxN limbs is roughly equivalent to four multiplies of
+(N/2)x(N/2).
+
+The factors (b^2+b) etc in the formula look worse than they are,
+representing simply the positions where the products must be added in.
+
+         high                              low
+        +--------+--------+ +--------+--------+
+        |      x1*y1      | |      x0*y0      |
+        +--------+--------+ +--------+--------+
+                  +--------+--------+
+                  |      x1*y1      |
+                  +--------+--------+
+                  +--------+--------+
+                  |      x0*y0      |
+                  +--------+--------+
+                  +--------+--------+
+                  | (x1-x0)*(y1-y0) |
+                  +--------+--------+
+
+The term (x1-x0)*(y1-y0) can be negative, meaning a subtraction, but the
+final result is of course always positive.
+
+The use of three multiplies of N/2 limbs each leads to an asymptotic speed
+O(N^1.585).  (The exponent is log(3)/log(2).)  This is a big improvement
+over the basecase multiply at O(N^2) and the algorithmic advantage soon
+overcomes the extra additions Karatsuba must perform.
+
+
+
+
+KARATSUBA SQUARE
+
+A square is very similar to a multiply, but with x==y the formula reduces to
+an equivalent with three squares,
+
+        x^2 = (b^2+b)*x1^2 + b*(x1-x0)^2 + (b+1)*x0^2
+ 
+The final result is accumulated from those three squares the same way as for
+the three multiplies above.  The middle term (x1-x0)^2 however is now always
+positive.
+
+
+
+
+TOOM-COOK 3-WAY MULTIPLY
+
+The Karatsuba formula is part of a general approach to splitting inputs
+leading to both Toom-Cook and FFT algorithms.  A description of Toom-Cook
+can be found in Knuth volume 2 section 4.3.3, with an example 3-way
+calculation after Theorem A.
+
+Toom-Cook 3-way treats the operands as split into 3 pieces of equal size (or
+the most significant part 1 or 2 limbs shorter than the others).
+
+         high                         low
+        +----------+----------+----------+
+        |    x2    |    x1    |    x0    |
+        +----------+----------+----------+
+
+        +----------+----------+----------+
+        |    y2    |    y1    |    y0    |
+        +----------+----------+----------+
+
+These parts are treated as the coefficients of two polynomials
+
+	X(t) = x2*t^2 + x1*t + x0
+	Y(t) = y2*t^2 + y1*t + y0
+
+Again let b equal the power of 2 which is the size of the x0, x1, y0 and y1
+pieces, ie. if they're k limbs each then b=2^(k*mp_bits_per_limb).  With
+this then x=X(b) and y=Y(b).
+
+Let a polynomial W(t)=X(t)*Y(t) and suppose it's coefficients are
+
+	W(t) = w4*t^4 + w3*t^3 + w2*t^2 + w1*t + w0
+
+The w[i] are going to be determined, and when they are they'll give the
+final result using w=W(b), since x*y=X(b)*Y(b)=W(b).  The coefficients will
+each be roughly b^2, so the final W(b) will be an addition like,
+
+         high                                        low
+        +-------+-------+
+        |       w4      |
+        +-------+-------+
+               +--------+-------+
+               |        w3      |
+               +--------+-------+
+                       +--------+-------+
+                       |        w2      |
+                       +--------+-------+
+                               +--------+-------+
+                               |        w1      |
+                               +--------+-------+
+                                        +-------+-------+
+                                        |       w0      |
+                                        +-------+-------+
+        -------------------------------------------------
+
+
+The w[i] coefficients could be formed by a simple set of cross products,
+like w4=x2*x2, w3=x2*y1+x1*y2, w2=x2*y0+x1*y1+x0*y2 etc, but this would need
+all nine x[i]*y[j] for i,j=0,1,2, and would be equivalent merely to a
+basecase multiply.  Instead the following approach is used.
+
+X(t) and Y(t) are evaluated and multiplied at 5 points, giving values of
+W(t) at those points.  The points used can be chosen in various ways, but in
+GMP the following are used
+  
+	t=0    meaning x0*y0, which gives w0 immediately
+        t=2    meaning (4*x2+2*x1*x0)*(4*y2+2*y1+y0)
+        t=1    meaning (x2+x1+x0)*(y2+y1+y0)
+        t=1/2  meaning (x2+2*x1+4*x0)*(y2+2*y1+4*y0)
+        t=inf  meaning x2*y2, which gives w4 immediately
+
+At t=1/2 the value calculated is actually 4*X(1/2)*Y(1/2), giving a value
+for 16*W(1/2) (this is always an integer).  At t=inf the value is actually
+X(t)*Y(t)/t^2 in the limit as t approaches infinity, but it's much easier to
+think of that as simply x2*y2 giving w4 immediately (much like at t=0 x0*y0
+gives w0 immediately).
+
+Now each of the points substituted into W(t)=w4*t^4+...+w0 gives a linear
+combination of the w[i] coefficients, and the value of those combinations
+has just been calculated.
+
+           W(0)   =                                 w0
+        16*W(1/2) =    w4 + 2*w3 + 4*w2 + 8*w1 + 16*w0
+           W(1)   =    w4 +   w3 +   w2 +   w1 +    w0
+           W(2)   = 16*w4 + 8*w3 + 4*w2 + 2*w1 +    w0
+           W(inf) =    w4
+
+This is a set of five equations in five unknowns, and some elementary linear
+algebra quickly isolates each w[i], by subtracting multiples of one equation
+from another.
+
+In the code the set of five values W(0),...,W(inf) will represent those
+certain linear combinations.  By adding or subtracting one from another as
+necessary, values which are each w[i] alone are arrived at.  This involves
+only a few subtractions of small multiples (some of which are powers of 2),
+and so is very fast.  A couple of divisions remain by powers of 2 and one
+division by 3 (or by 6 rather), and that last uses the special fast
+mpn_divexact_by3.
+
+In the code the values w4, w2 and w0 are formed in the destination, and w3
+and w1 are added to them.  There's an extra word at the high end of w3, w2
+and w1 that are handled separately.  With A=w0,B=w1,...,E=w4, the additions
+are as follows.
+
+         high                                        low
+        +-------+-------+-------+-------+-------+-------+
+        |       E       |       C       |       A       |
+        +-------+-------+-------+-------+-------+-------+
+                 +------+-------++------+-------+
+                 |      D       ||      B       |
+                 +------+-------++------+-------+
+              --      --      --
+             |tD|    |tC|    |tB|        
+              --      --      --
+        -------------------------------------------------
+
+
+The conversion of W(t) values to the coefficients is called interpolation.
+A polynomial of degree 5 like W(t) is uniquely determined by values known at
+5 different points.  The points can be chosen to make the linear equations
+come out with a convenient set of steps for isolating the w[i]s.
+
+In mpn/generic/mul_n.c the interpolate3() routine performs the
+interpolation.  The open-coded one-pass version may be a bit hard to
+understand, the steps performed can be better seen in the USE_MORE_MPN
+version.
+
+The use of five multiplies of N/3 limbs each leads to an asymptotic speed
+O(N^1.465).  (The exponent is log(5)/log(3).)  This is an improvement over
+Karatsuba at O(N^1.585), though Toom-Cook does more work in the evaluation
+and interpolation and so it's only above a certain size that Toom-Cook
+realizes its advantage.
+
+The formula given above for the Karatsuba algorithm has an equivalent for
+Toom-Cook 3-way, involving only five multiplies, but this would be
+complicated and unenlightening.
+
+An alternate view of Toom-Cook 3-way can be found in Zuras (reference
+below).  He uses a vector to represent the x and y splits and a matrix
+multiplication for the evaluation and interpolation stages.  The matrix
+inverses are not meant to be actually used, and they have elements with
+values much greater than in fact arise in the interpolation steps.  The
+diagram shown for the 3-way is attractive, but again it doesn't have to be
+implemented that way and for example with a bit of rearrangement just one
+division by 6 (not two of them) can be done.
+
+
+
+
+TOOM-COOK 3-WAY SQUARE
+
+Toom-Cook squaring follows the same procedure as multiplication, but there's
+only one X(t) and it's evaluated at 5 points, and those values squared to
+give values of W(t).  The interpolation is then identical, and in fact the
+same interpolate3() subroutine is used for both squaring and multiplying.
+
+
+
+
+FFT MULTIPLY
+
+At large to very large sizes a Fermat style FFT is used, meaning an FFT in a
+ring of integers modulo 2^M+1.  This is asymptotically fast, but overheads
+mean it's only worthwhile for large products.
+
+Some brief notes are given here.  Full explanations can be found in various
+texts.  Knuth section 4.3.3 part C describes the method, but using complex
+numbers.  In the references below Schonhage and Strassen is the original
+paper, and Pollard gives some of the mathematics for a finite field as used
+here.
+
+The FFT does its multiplication modulo 2^N+1, but by choosing
+N>=bits(A)+bits(B), a full product A*B is obtained.  The algorithm splits
+the inputs into 2^k pieces, for a chosen k, and will recursively perform 2^k
+pointwise multiplications modulo 2^M+1, where M=N/2^k.  N must be a multiple
+of 2^k.  Those multiplications are either done by recursing into a further
+FFT, or by a plain toom3 etc multiplication, whichever is optimal at the
+resultant size.  Note that in the current implementation M is always a
+multiple of the limb size.
+
+The steps leading to the pointwise products are like the evaluation and
+interpolation stages of the Karatsuba and Toom-Cook algorithms, but use a
+convolution, which can be efficiently calculated because 2^(2N/2^k) is a
+2^k'th root of unity.
+
+As operand sizes gets bigger, bigger splits are used.  Each time a bigger k
+is used some multiplying is effectively swapped for some shifts, adds and
+overheads.  A table of thresholds gives the points where a k+1 FFT is faster
+than a k FFT.  A separate threshold gives the point where a mod 2^N+1 FFT
+first becomes faster than a plain multiply of that size, and this normally
+happens in the k=4 range.  A further threshold gives the point where an
+N/2xN/2 multiply done with an FFT mod 2^N+1 is faster than a plain multiply
+of that size, and this is normally in the k=7 or k=8 range.
+
+
+
+
+TOOM-COOK N-WAY (NOT USED)
+
+The 3-way Toom-Cook procedure described above generalizes to split into an
+arbitrary number of pieces, as per Knuth volume 2 section 4.3.3 algorithm C.
+Some code implementing this for GMP exists, but is not present since it has
+yet to prove worthwhile.  The notes here are merely for interest.
+
+In general a split into r+1 pieces will be made, and evaluations and
+pointwise multiplications done at 2*r+1 points.  So a 4-way split does 7
+pointwise multiplies, 5-way does 9, etc.
+
+Asymptotically an r+1-way algorithm is O(n^(log(2*r+1)/log(r+1)).  Only the
+pointwise multiplications count towards big O() complexity, but the time
+spent in the evaluate and interpolate stages grows with r and has a
+significant practical impact, with the asymptotic advantage of each r
+realized only at bigger and bigger sizes.
+
+Knuth algorithm C presents a version evaluating at points 0,1,2,...,2*r, but
+exercise 4 uses -r,...,0,...,r and the latter saves some small multiplies in
+the evaluate stage (or rather trades them for additions), and has a further
+saving of nearly half the interpolate steps.  The answer to the exercise
+doesn't give full details of the interpolate, but essentially the idea is to
+separate odd and even final coefficients and then perform algorithm C steps
+C7 and C8 on them separately.  The multipliers and divisors at step C7 then
+become j^2 and 2*t*j-j*j respectively.
+
+In the references below, Zuras presents 3-way and 4-way Toom-Cook methods,
+and compares them to small order FFTs.  Hollerbach presents an N-way
+algorithm from first principles.  Bernstein presents the N-way algorithm in
+a style that facilitates comparing its mathematics to other multiplication
+algorithms.
+
+
+
+
+REFERENCES
+
+"Algorithms for Computer Algebra", Keith O. Geddes, Stephen R. Czapor,
+George Labahn, Kluwer Academic Publishers, 1992, ISBN 0-7923-9259-0.
+
+"Schnelle Multiplikation grosser Zahlen", by Arnold Schonhage and Volker
+Strassen, Computing 7, p. 281-292, 1971.
+
+"The Fast Fourier Transform in a Finite Field", J.M. Pollard, Mathematics of
+Computation, vol 25, num 114, April 1971.
+
+"On Squaring and Multiplying Large Integers", Dan Zuras, ARITH-11: IEEE
+Symposium on Computer Arithmetic, 1993, pages 260 to 271.  And reprinted as
+"More on Multiplying and Squaring Large Integers", IEEE Transactions on
+Computers, August 1994.
+
+"Fast Multiplication & Division of Very Large Numbers", Uwe Hollerbach, post
+to sci.math.research, Jan 1996, archived at Swarthmore,
+http://forum.swarthmore.edu/epigone/sci.math.research/zhouyimpzimp/x1ybdbxz5w4v@forum.swarthmore.edu
+
+"Multidigit Multiplication for Mathematicians", Daniel J. Bernstein,
+preprint available at http://koobera.math.uic.edu/www/papers.  (Every known
+multiplication technique, many references.)
+
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 76
+End:
diff --git a/src/gmp/doc/projects.html b/src/gmp/doc/projects.html
new file mode 100644
index 000000000..416e50a05
--- /dev/null
+++ b/src/gmp/doc/projects.html
@@ -0,0 +1,194 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<html>
+<head>
+  <title>
+    GMP Development Projects
+  </title>
+</head>
+<body bgcolor=pink>
+
+<center>
+  <h1>
+    GMP Development Projects
+  </h1>
+</center>
+
+<comment>
+  An up-to-date version of this file is available at
+  <a href="http://www.swox.com/gmp/projects.html">http://www.swox.com/gmp/projects.html</a>.
+</comment>
+
+<p> This file lists projects suitable for volunteers.  Please see the
+    <a href="tasks.html">tasks file</a> for smaller tasks.
+
+<p> If you want to work on any of the projects below, please let tege@swox.com
+    know.  If you want to help with a project that already somebody else is
+    working on, please talk to that person too, tege@swox.com can put you in
+    touch.  (There are no email addresses of volunteers below, due to spamming
+    problems.)
+
+<ul>
+<li> <strong>C++ wrapper</strong>
+
+  <p> A C++ wrapper for GMP is highly desirable.  Several people have started
+  writing one, but nobody has so far finished it.  For a wrapper to be useful,
+  one needs to pay attention to efficiency.
+
+  <ol>
+    <li> Write arithmetic functions for direct applications of most
+         elementary C++ types.  This might be necessary to avoid
+         ambiguities, but it is also desirable from an efficiency
+         standpoint.
+    <li> Avoid running constructors/destructors when not necessary.
+         For example, implement <code>a&nbsp+=&nbsp;b</code> by directly applying mpz_add.
+  </ol>
+
+<p> <li> <strong>Faster multiplication</strong>
+
+  <p> The current multiplication code uses Karatsuba, 3-way Toom-Cook,
+      or Fermat FFT.  Several new developments are desirable:
+
+  <ol>
+    <li> Handle multiplication of operands with different digit count
+	 better than today.  We now split the operands in a very
+	 inefficient way, see mpn/generic/mul.c.
+
+    <li> Consider N-way Toom-Cook.  See Knuth's Seminumerical
+	 Algorithms for details on the method.  Code implementing it
+	 exists.  This is asymptotically inferior to FFTs, but is finer
+	 grained.  A toom-4 might fit in between toom-3 and the FFTs
+	 (or it might not).
+
+    <li> It's possible CPU dependent effects like cache locality will
+         have a greater impact on speed than algorithmic improvements.
+
+  </ol>
+
+
+<p> <li> <strong>Assembly routines</strong>
+
+  <p> Write new and tune existing assembly routines.  The programs in mpn/tests
+  and the tune/speed.c program are useful for testing and timing the routines
+  you write.  See the README files in those directories for more information.
+
+  <p> Please make sure your new routines are fast for these three situations:
+  <ol>
+    <li> Operands that fit into the cache.
+    <li> Small operands of less than, say, 10 limbs.
+    <li> Huge operands that does not fit into the cache.
+  </ol>
+
+  <p> The most important routines are mpn_addmul_1, mpn_mul_basecase and
+  mpn_sqr_basecase.  The latter two don't exist for all machines, while
+  mpn_addmul_1 exists for almost all machines.
+
+  <p> Standard techniques for these routines are unrolling, software
+  pipelining, and specialization for common operand values.  For machines with
+  poor integer multiplication, it is often possible to improve the performance
+  using floating-point operations, or SIMD operations such as MMX or Sun's VIS.
+
+  <p> Using floating-point operations is interesting but somewhat tricky.
+  Since IEEE double has 53 bit of mantissa, one has to split the operands in
+  small prices, so that no result is greater than 2^53.  For 32-bit computers,
+  splitting one operand into 16-bit pieces works.  For 64-bit machines, one
+  operand can be split into 21-bit pieces and the other into 32-bit pieces.  (A
+  64-bit operand can be split into just three 21-bit pieces if one allows the
+  split operands to be negative!)
+
+
+<p> <li> <strong>Faster extended GCD</strong>
+
+  <p> We currently have extended GCD based on Lehmer's method.
+  But the binary method can quite easily be improved for bignums
+  in a similar way Lehmer improved Euclid's algorithm.  The result should
+  beat Lehmer's method by about a factor of 2.  Furthermore, the multiprecision
+  step of Lehmer's method and the binary method will be identical, so the
+  current code can mostly be reused.  It should be possible to share code
+  between GCD and GCDEXT, and probably with Jacobi symbols too.
+
+<p> <li> <strong>Math functions for the mpf layer</strong>
+
+  <p> Implement the functions of math.h for the GMP mpf layer!  Check the book
+  "Pi and the AGM" by Borwein and Borwein for ideas how to do this.  These
+  functions are desirable: acos, acosh, asin, asinh, atan, atanh, atan2, cos,
+  cosh, exp, log, log10, pow, sin, sinh, tan, tanh.
+
+<p> <li> <strong>Faster sqrt</strong>
+
+  <p> The current code for computing square roots use a Newton iteration that
+  rely on division.  It is possible to avoid using division by computing
+  1/sqrt(A) using this formula:
+  <pre>
+                                    2
+                   x   = x  (3 - A x )/2.
+                    i+1   i         i  </pre>
+  The final result is then computed without division using,
+  <pre>
+                     sqrt(A) = A x .
+                                  n  </pre>
+  The resulting code should be substantially faster than the current code.
+
+<p> <li> <strong>Nth root</strong>
+
+  <p> Implement, at the mpn level, a routine for computing the nth root of a
+  number.  The routine should use Newton's method, preferably without using
+  division.
+
+  <p> If the routine becomes fast enough, perhaps square roots could be computed
+  using this function.
+
+<p> <li> <strong>More random number generators</strong>
+
+  <p> Implement some more pseudo random number generator algorithms.
+      Today there's only Linear Congruential.
+
+
+<p> <li> <strong>Test Suite</strong>
+
+  <p> Add a test suite for old bugs.  These tests wouldn't loop or use
+      random numbers, but just test for specific bugs found in the
+      past.
+
+  <p> More importantly, improve the random number controls for test
+      collections:
+
+      <ol>
+        <li> Use the new random number framework.
+        <li> Have every test accept a seed parameter.
+        <li> Allow `make check' to set the seed parameter.
+        <li> Add more tests for important, now untested functions.
+      </ol>
+
+  <p> With this in place, it should be possible to rid GMP of
+      practically all bugs by having some dedicated GMP test machines
+      running "make check" with ever increasing seeds (and
+      periodically updating to the latest GMP).
+
+  <p> If a few more ASSERTs were sprinkled through the code, running
+      some tests with --enable-assert might be useful, though not a
+      substitute for tests on the normal build.
+
+  <p> An important feature of any random tests will be to record the
+      seeds used, and perhaps to snapshot operands before performing
+      each test, so any problem exposed can be reproduced.
+
+</ul>
+
+<hr>
+
+<table width="100%">
+  <tr>
+    <td>
+      <font size=2>
+      Please send comments about this page to
+      <a href="mailto:tege@swox.com">tege@swox.com</a>.<br>
+      Copyright (C) 1999, 2000 Torbjörn Granlund.
+      </font>
+    </td>
+    <td align=right>
+    </td>
+  </tr>
+</table>
+
+</body>
+</html>
diff --git a/src/gmp/doc/tasks.html b/src/gmp/doc/tasks.html
new file mode 100644
index 000000000..c549bf176
--- /dev/null
+++ b/src/gmp/doc/tasks.html
@@ -0,0 +1,379 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<html>
+<head>
+  <title>
+    GMP Itemized Development Tasks
+  </title>
+</head>
+<body bgcolor=lightgreen>
+
+<center>
+  <h1>
+    GMP Itemized Development Tasks
+  </h1>
+</center>
+
+<comment>
+  An up-to-date html version of this file is available at
+  <a href="http://www.swox.com/gmp/tasks.html">http://www.swox.com/gmp/tasks.html</a>.
+</comment>
+
+<p> This file lists itemized GMP development tasks.  Not all the tasks
+    listed here are suitable for volunteers, but many of them are.
+    Please see the <a href="projects.html">projects file</a> for more
+    sizeable projects.
+
+<h4>Correctness and Completeness</h4>
+<ul>
+<li> HPUX 10.20 assembler requires a `.LEVEL 1.1' directive for accepting the
+     new instructions.  Unfortunately, the HPUX 9 assembler as well as earlier
+     assemblers reject that directive.  How very clever of HP!  We will have to
+     pass assembler options, and make sure it works with new and old systems
+     and GNU assembler.
+<li> The various reuse.c tests need to force reallocation by calling
+     <code>_mpz_realloc</code> with a small (1 limb) size.
+<li> One reuse case is missing from mpX/tests/reuse.c: <code>mpz_XXX(a,a,a)</code>.
+<li> When printing mpf_t numbers with exponents > 2^53 on machines with 64-bit
+     <code>mp_exp_t</code>, the precision of
+     <code>__mp_bases[base].chars_per_bit_exactly</code> is insufficient and
+     <code>mpf_get_str</code> aborts.  Detect and compensate.
+<li> Fix <code>mpz_get_si</code> to work properly for MIPS N32 ABI (and other
+     machines that use <code>long long</code> for storing limbs.)
+<li> Make the string reading functions allow the `0x' prefix when the base is
+     explicitly 16.  They currently only allow that prefix when the base is
+     unspecified.
+<li> In the development sources, we return abs(a%b) in the
+     <code>mpz_*_ui</code> division routines.  Perhaps make them return the
+     real remainder instead?  Changes return type to <code>signed long int</code>.
+<li> <code>mpf_eq</code> is not always correct, when one operand is
+     1000000000... and the other operand is 0111111111..., i.e., extremely
+     close.  There is a special case in <code>mpf_sub</code> for this
+     situation; put similar code in <code>mpf_eq</code>.
+<li> mpf_eq doesn't implement what gmp.texi specifies.  It should not use just
+     whole limbs, but partial limbs.
+<li> Install Alpha assembly changes (prec/gmp-alpha-patches).
+<li> NeXT has problems with newlines in asm strings in longlong.h.  Also,
+     <code>__builtin_constant_p</code> is unavailable?  Same problem with MacOS
+     X.
+<li> Shut up SGI's compiler by declaring <code>dump_abort</code> in
+     mp?/tests/*.c.
+<li> <code>mpz_get_si</code> returns 0x80000000 for -0x100000000.
+</ul>
+
+
+
+<h4>Machine Independent Optimization</h4>
+<ul>
+<li> In hundreds of places in the code, we invoke count_leading_zeros and then
+     check if the returned count is zero.  Instead check the most significant
+     bit of the operand, and avoid invoking <code>count_leading_zeros</code> if
+     the bit is set.  This is an optimization on all machines, and significant
+     on machines with slow <code>count_leading_zeros</code>.
+<li> In a couple of places <code>count_trailing_zeros</code> is used
+     on more or less uniformly distributed numbers.  For some CPUs
+     <code>count_trailing_zeros</code> is slow and it's probably worth
+     handling the frequently occurring 0 to 2 trailing zeros cases specially.
+<li> Change all places that use <code>udiv_qrnnd</code> for inverting limbs to
+     instead use <code>invert_limb</code>.
+<li> Reorganize longlong.h so that we can inline the operations even for the
+     system compiler.  When there is no such compiler feature, make calls to
+     stub functions.  Write such stub functions for as many machines as
+     possible.
+<li> Rewrite <code>umul_ppmm</code> to use floating-point for generating the
+     most significant limb (if <code>BITS_PER_MP_LIMB</code> &lt= 52 bits).
+     (Peter Montgomery has some ideas on this subject.)
+<li> Improve the default <code>umul_ppmm</code> code in longlong.h: Add partial
+     products with fewer operations.
+<li> Write new <code>mpn_get_str</code> and <code>mpn_set_str</code> running in
+     the sub O(n^2) range, using some divide-and-conquer approach, preferably
+     without using division.
+<li> Copy tricky code for converting a limb from development version of
+     <code>mpn_get_str</code> to mpf/get_str.  (Talk to Torbjörn about this.)
+<li> Consider inlining these functions: <code>mpz_size</code>,
+     <code>mpz_set_ui</code>, <code>mpz_set_q</code>, <code>mpz_clear</code>,
+     <code>mpz_init</code>, <code>mpz_get_ui</code>, <code>mpz_scan0</code>,
+     <code>mpz_scan1</code>, <code>mpz_getlimbn</code>,
+     <code>mpz_init_set_ui</code>, <code>mpz_perfect_square_p</code>,
+     <code>mpz_popcount</code>, <code>mpf_size</code>,
+     <code>mpf_get_prec</code>, <code>mpf_set_prec_raw</code>,
+     <code>mpf_set_ui</code>, <code>mpf_init</code>, <code>mpf_init2</code>,
+     <code>mpf_clear</code>, <code>mpf_set_si</code>.
+<li> <code>mpz_powm</code> and <code>mpz_powm_ui</code> aren't very
+     fast on one or two limb moduli, due to a lot of function call
+     overheads.  These could perhaps be handled as special cases.
+<li> <code>mpz_powm</code> and <code>mpz_powm_ui</code> want better
+     algorithm selection, and the latter should use REDC.  Both could
+     change to use an <code>mpn_powm</code> and <code>mpn_redc</code>.
+<li> <code>mpn_gcd</code> might be able to be sped up on small to
+     moderate sizes by improving <code>find_a</code>, possibly just by
+     providing an alternate implementation for CPUs with slowish
+     <code>count_leading_zeros</code>.
+<li> Implement a cache localized evaluate and interpolate for the
+     toom3 <code>USE_MORE_MPN</code> code.  The necessary
+     right-to-left <code>mpn_divexact_by3c</code> exists.
+<li> <code>mpn_mul_basecase</code> on NxM with big N but small M could try for
+     better cache locality by taking N piece by piece.  The current code could
+     be left available for CPUs without caching.  Depending how karatsuba etc
+     is applied to unequal size operands it might be possible to assume M is
+     always smallish.
+</ul>
+
+
+<h4>Machine Dependent Optimization</h4>
+<ul>
+<li> Run the `tune' utility for more compiler/CPU combinations.  We would like
+     to have gmp-mparam.h files in practically every implementation specific
+     mpn subdirectory, and repeat each *_THRESHOLD for gcc and the system
+     compiler.  See the `tune' top-level directory for more information.
+<li> Alpha: Rewrite <code>mpn_addmul_1</code>, <code>mpn_submul_1</code>, and
+     <code>mpn_mul_1</code> for the 21264.  On 21264, they should run at 4, 3,
+     and 3 cycles/limb respectively, if the code is unrolled properly.  (Ask
+     Torbjörn for his xm.s and xam.s skeleton files.)
+<li> Alpha: Rewrite <code>mpn_addmul_1</code>, <code>mpn_submul_1</code>, and
+     <code>mpn_mul_1</code> for the 21164.  This should use both integer
+     multiplies and floating-point multiplies.  For the floating-point
+     operations, the single-limb multiplier should be split into three 21-bit
+     chunks.
+<li> UltraSPARC: Rewrite 64-bit <code>mpn_addmul_1</code>,
+     <code>mpn_submul_1</code>, and <code>mpn_mul_1</code>.  Should use
+     floating-point operations, and split the invariant single-limb multiplier
+     into 21-bit chunks.  Should give about 18 cycles/limb, but the pipeline
+     will become very deep.  (Torbjörn has C code that is useful as a starting
+     point.)
+<li> UltraSPARC: Rewrite <code>mpn_lshift</code> and <code>mpn_rshift</code>.
+     Should give 2 cycles/limb.  (Torbjörn has code that just needs to be
+     finished.)
+<li> SPARC32/V9: Find out why the speed of <code>mpn_addmul_1</code>
+     and the other multiplies varies so much on successive sizes.
+<li> PA64: Improve <code>mpn_addmul_1</code>, <code>mpn_submul_1</code>, and
+     <code>mpn_mul_1</code>.  The current development code runs at 11
+     cycles/limb, which is already very good.  But it should be possible to
+     saturate the cache, which will happen at 7.5 cycles/limb.
+<li> Sparc & SparcV8: Enable umul.asm for native cc.  The generic
+     longlong.h umul_ppmm is suspected to be causing sqr_basecase to
+     be slower than mul_basecase.
+<li> UltraSPARC: Write <code>umul_ppmm</code>.  Important in particular for
+     <code>mpn_sqr_basecase</code>.  Using four "<code>mulx</code>"s either
+     with an asm block or via the generic C code is about 90 cycles.
+<li> Implement <code>mpn_mul_basecase</code> and <code>mpn_sqr_basecase</code>
+     for important machines.  Helping the generic sqr_basecase.c with an
+     <code>mpn_sqr_diagonal</code> might be enough for some of the RISCs.
+<li> POWER2/POWER2SC: Schedule <code>mpn_lshift</code>/<code>mpn_rshift</code>.
+     Will bring time from 1.75 to 1.25 cycles/limb.
+<li> X86: Optimize non-MMX <code>mpn_lshift</code> for shifts by 1.  (See Pentium code.)
+<li> Alpha: Optimize <code>count_leading_zeros</code>.
+<li> Alpha: Optimize <code>udiv_qrnnd</code>.  (Ask Torbjörn for the file
+     test-udiv-preinv.c as a starting point.)
+<li> R10000/R12000: Rewrite <code>mpn_add_n</code> and <code>mpn_sub_n</code>.
+     It should just require 3 cycles/limb, but the current code propagates
+     carry poorly.  The trick is to add carry-in later than we do now,
+     decreasing the number of operations used to generate carry-out from 4 to
+     to 3.
+<li> PPC32: Try using fewer registers in the current <code>mpn_lshift</code>.
+     The pipeline is now extremely deep, perhaps unnecessarily deep.  Also, r5
+     is unused.  (Ask Torbjörn for a copy of the current code.)
+<li> PPC32: Write <code>mpn_rshift</code> based on new <code>mpn_lshift</code>.
+<li> PPC32: Rewrite <code>mpn_add_n</code> and <code>mpn_sub_n</code>.  Should
+     run at just 3.25 cycles/limb.  (Ask for xxx-add_n.s as a starting point.)
+<li> Fujitsu VPP: Vectorize main functions, perhaps in assembly language.
+<li> Fujitsu VPP: Write <code>mpn_mul_basecase</code> and
+     <code>mpn_sqr_basecase</code>.  This should use a "vertical multiplication
+     method", to avoid carry propagation.  splitting one of the operands in
+     11-bit chunks.
+<li> Cray: Vectorize main functions, perhaps in assembly language.
+<li> Cray: Write <code>mpn_mul_basecase</code> and
+     <code>mpn_sqr_basecase</code>.  Same comment applies to this as to the
+     same functions for Fujitsu VPP.
+<li> Improve <code>count_leading_zeros</code> for 64-bit machines:
+
+  <pre>
+  if ((x &gt&gt W_TYPE_SIZE-W_TYPE_SIZE/2) == 0) { x &lt&lt= W_TYPE_SIZE/2; cnt += W_TYPE_SIZE/2}
+  if ((x &gt&gt W_TYPE_SIZE-W_TYPE_SIZE/4) == 0) { x &lt&lt= W_TYPE_SIZE/4; cnt += W_TYPE_SIZE/4}
+  ... </pre>
+
+</ul>
+
+<h4>New Functionality</h4>
+<ul>
+<li> <code>mpz_get_nth_ui</code>.  Return the nth word (not necessarily the nth limb).
+<li> Maybe add <code>mpz_crr</code> (Chinese Remainder Reconstruction).
+<li> Let `0b' and `0B' mean binary input everywhere.
+<li> Add <code>mpq_set_f</code> for assignment from <code>mpf_t</code>
+     (cf. <code>mpq_set_d</code>).
+<li> Maybe make <code>mpz_init</code> (and <code>mpq_init</code>) do lazy
+     allocation.  Set <code>ALLOC(var)</code> to 0, and have
+     <code>mpz_realloc</code> special-handle that case.  Update functions that
+     rely on a single limb (like <code>mpz_set_ui</code>,
+     <code>mpz_[tfc]div_r_ui</code>, and others).
+<li> Add <code>mpf_out_raw</code> and <code>mpf_inp_raw</code>.  Make sure
+     format is portable between 32-bit and 64-bit machines, and between
+     little-endian and big-endian machines.
+<li> Handle numeric exceptions: Call an error handler, and/or set
+     <code>gmp_errno</code>.
+<li> Implement <code>gmp_fprintf</code>, <code>gmp_sprintf</code>, and
+     <code>gmp_snprintf</code>.  Think about some sort of wrapper
+     around <code>printf</code> so it and its several variants don't
+     have to be completely reimplemented.
+<li> Implement some <code>mpq</code> input and output functions.
+<li> Implement a full precision <code>mpz_kronecker</code>, leave
+     <code>mpz_jacobi</code> for compatibility.
+<li> Make the mpn logops and copys available in gmp.h.  Since they can
+     be either library functions or inlines, gmp.h would need to be
+     generated from a gmp.in based on what's in the library.  gmp.h
+     would still be compiler-independent though.
+<li> Make versions of <code>mpz_set_str</code> etc taking string
+     lengths rather than null-terminators.
+<li> Consider changing the thresholds to apply the simpler algorithm when
+     "<code>&lt;=</code>" rather than "<code>&lt;</code>", so a threshold can
+     be set to <code>MP_SIZE_T_MAX</code> to get only the simpler code (the
+     compiler will know <code>size &lt;= MP_SIZE_T_MAX</code> is always true).
+<li> <code>mpz_cdiv_q_2exp</code> and <code>mpz_cdiv_r_2exp</code>
+     could be implemented to match the corresponding tdiv and fdiv.
+     Maybe some code sharing is possible.
+</ul>
+
+
+<h4>Configuration</h4>
+
+<ul>
+<li> Improve config.guess.  We want to recognize the processor very
+     accurately, more accurately than other GNU packages.
+     config.guess does not currently make the distinctions we would
+     like it to do and a --target often needs to be set explicitly.
+
+     For example, "sparc" is not very useful as a machine architecture
+     denotation.  We want to distinguish old 32-bit SPARC without
+     multiply support from newer 32-bit SPARC with such support.  We
+     want to recognize a SuperSPARC, since its implementation of the
+     UDIV instruction is not complete, and will trap to the OS kernel
+     for certain operands.  And we want to recognize 64-bit capable
+     SPARC processors as such.  While the assembly routines can use
+     64-bit operations on all 64-bit SPARC processors, one can not use
+     64-bit limbs under all operating system.  E.g., Solaris 2.5 and
+     2.6 doesn't preserve the upper 32 bits of most processor
+     registers.  For SPARC we therefore sometimes need to choose GMP
+     configuration depending both on processor and operating system.
+
+<li> Remember to make sure config.sub accepts any output from config.guess.
+
+<li> Find out whether there's an alloca available and how to use it.
+     AC_FUNC_ALLOCA has various system dependencies covered, but we
+     don't want its alloca.c replacement.  (One thing current cpp
+     tests don't cover: HPUX 10 C compiler supports alloca, but
+     cannot find any symbol to test in order to know if we're on
+     HPUX 10.  Damn.)
+<li> Identify Mips processor under Irix: `hinv -c processor'.
+     config.guess should say mips2, mips3, and mips4.
+<li> Identify Alpha processor under OSF: "/usr/sbin/sizer -c".
+     Unfortunately, sizer is not available before some revision of
+     Dec Unix 4.0, and it also returns some rather cryptic names for
+     processors.  Perhaps the <code>implver</code> and
+     <code>amask</code> assembly instructions are better, but that
+     doesn't differentiate between ev5 and ev56.
+<li> Identify Sparc processors.  config.guess should say supersparc,
+     microsparc, ultrasparc1, ultrasparc2, etc.
+<li> Identify HPPA processors similarly.
+<li> Get lots of information about a Solaris system: prtconf -vp
+<li> For some target machines and some compilers, specific options
+     are needed (sparcv8/gcc needs -mv8, sparcv8/cc needs -cg92,
+     Irix64/cc needs -64, Irix32/cc might need -n32, etc).  Some are
+     set already, add more, see configure.in.
+<li> Options to be passed to the assembler (via the compiler, using
+     whatever syntax the compiler uses for passing options to the
+     assembler).
+<li> On Solaris 7, check if gcc supports native v9 64-bit
+     arithmetic.  If not compile using "cc -fast -xarch=v9".
+     (Problem: -fast requires that we link with -fast too, which
+     might not be very good.  Pass "-xO4 -xtarget=native" instead?)
+<li> Extend the "optional" compiler arguments to choose the first
+     that works from from a set, so when gcc gets athlon support it
+     can try -mcpu=athlon, -mcpu=pentiumpro, or -mcpu=i486,
+     whichever works.
+<li> Detect gcc >=2.96 and enable -march=pentiumpro for relevant
+     x86s.  (A bug in gcc 2.95.2 prevents it being used
+     unconditionally.)
+<li> Build multiple variants of the library under certain systems.
+     An example is -n32, -o32, and -64 on Irix.
+<li> There's a few filenames that don't fit in 14 chars, if this
+     matters.
+<li> Enable support for FORTRAN versions of mpn files (eg. for
+     mpn/cray/mulww.f).  Add "f" to the mpn path searching, run AC_PROG_F77 if
+     such a file is found.  Automake will generate some of what's needed in the
+     makefiles, but libtool doesn't know fortran and so rules like the current
+     ".asm.lo" will be needed.
+<li> Only run GMP_PROG_M4 if it's needed, ie. if there's .asm files
+     selected from the mpn path.  This might help say a generic C
+     build on weird systems.
+</ul>
+
+<p> In general, getting the exact right configuration, passing the
+exact right options to the compiler, etc, might mean that the GMP
+performance more than doubles.
+
+<p> When testing, make sure to test at least the following for all out
+target machines: (1) Both gcc and cc (and c89).  (2) Both 32-bit mode
+and 64-bit mode (such as -n32 vs -64 under Irix). (3) Both the system
+`make' and GNU `make'. (4) With and without GNU binutils.
+
+
+<h4>Miscellaneous</h4>
+<ul>
+
+<li> Work on the way we build the library.  We now do it building
+     convenience libraries but then listing all the object files a
+     second time in the top level Makefile.am.
+<li> Get rid of mp[zq]/sub.c, and instead define a compile parameter to
+     mp[zq]/add.c to decide whether it will add or subtract.  Will decrease
+     redundancy.  Similarly in other places.
+<li> Make <code>mpz_div</code> and <code>mpz_divmod</code> use rounding
+     analogous to <code>mpz_mod</code>.  Document, and list as an
+     incompatibility.
+<li> Maybe make mpz_pow_ui.c more like mpz/ui_pow_ui.c, or write new
+     mpn/generic/pow_ui.
+<li> Make mpz_invert call mpn_gcdext directly.
+<li> Make a build option to enable execution profiling with gprof.  In
+     particular look at getting the right <code>mcount</code> call at
+     the start of each assembler subroutine (for important targets at
+     least).
+</ul>
+
+
+<h4>Aids to Debugging</h4>
+<ul>
+<li> Make an option for stack-alloc.c to call <code>malloc</code>
+     separately for each <code>TMP_ALLOC</code> block, so a redzoning
+     malloc debugger could be used during development.
+<li> Add <code>ASSERT</code>s at the start of each user-visible
+     mpz/mpq/mpf function to check the validity of each
+     <code>mp?_t</code> parameter, in particular to check they've been
+     <code>mp?_init</code>ed.  This might catch elementary mistakes in
+     user programs.  Care would need to be taken over
+     <code>MPZ_TMP_INIT</code>ed variables used internally.
+</ul>
+
+
+<h4>Documentation</h4>
+<ul>
+<li> Document conventions, like that <code> unsigned long int</code> is used for
+     bit counts/ranges, and that <code>mp_size_t</code> is used for limb counts.
+<li> <code>mpz_inp_str</code> (etc) doesn't say when it stops reading digits.
+</ul>
+
+<hr>
+
+<table width="100%">
+  <tr>
+    <td>
+      <font size=2>
+      Please send comments about this page to
+      <a href="mailto:tege@swox.com">tege@swox.com</a>.<br>
+      Copyright (C) 1999, 2000 Torbjörn Granlund.
+      </font>
+    </td>
+    <td align=right>
+    </td>
+  </tr>
+</table>
+
+</body>
+</html>
diff --git a/src/gmp/errno.c b/src/gmp/errno.c
new file mode 100644
index 000000000..7dd223c19
--- /dev/null
+++ b/src/gmp/errno.c
@@ -0,0 +1,26 @@
+/* gmp_errno -- The largest and most complex file in GMP.
+
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int gmp_errno = 0;
diff --git a/src/gmp/extract-dbl.c b/src/gmp/extract-dbl.c
new file mode 100644
index 000000000..2d70d9a3b
--- /dev/null
+++ b/src/gmp/extract-dbl.c
@@ -0,0 +1,187 @@
+/* __gmp_extract_double -- convert from double to array of mp_limb_t.
+
+Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#ifdef XDEBUG
+#undef _GMP_IEEE_FLOATS
+#endif
+
+#ifndef _GMP_IEEE_FLOATS
+#define _GMP_IEEE_FLOATS 0
+#endif
+
+/* Extract a non-negative double in d.  */
+
+int
+#if __STDC__
+__gmp_extract_double (mp_ptr rp, double d)
+#else
+__gmp_extract_double (rp, d)
+     mp_ptr rp;
+     double d;
+#endif
+{
+  long exp;
+  unsigned sc;
+  mp_limb_t manh, manl;
+
+  /* BUGS
+
+     1. Should handle Inf and NaN in IEEE specific code.
+     2. Handle Inf and NaN also in default code, to avoid hangs.
+     3. Generalize to handle all BITS_PER_MP_LIMB >= 32.
+     4. This lits is incomplete and misspelled.
+   */
+
+  if (d == 0.0)
+    {
+      rp[0] = 0;
+      rp[1] = 0;
+#if BITS_PER_MP_LIMB == 32
+      rp[2] = 0;
+#endif
+      return 0;
+    }
+
+#if _GMP_IEEE_FLOATS
+  {
+#if defined (__alpha) && __GNUC__ == 2 && __GNUC_MINOR__ == 8
+    /* Work around alpha-specific bug in GCC 2.8.x.  */
+    volatile
+#endif
+    union ieee_double_extract x;
+    x.d = d;
+    exp = x.s.exp;
+#if BITS_PER_MP_LIMB == 64
+    manl = (((mp_limb_t) 1 << 63)
+	    | ((mp_limb_t) x.s.manh << 43) | ((mp_limb_t) x.s.manl << 11));
+    if (exp == 0)
+      {
+	/* Denormalized number.  Don't try to be clever about this,
+	   since it is not an important case to make fast.  */
+	exp = 1;
+	do
+	  {
+	    manl = manl << 1;
+	    exp--;
+	  }
+	while ((mp_limb_signed_t) manl >= 0);
+      }
+#else
+    manh = ((mp_limb_t) 1 << 31) | (x.s.manh << 11) | (x.s.manl >> 21);
+    manl = x.s.manl << 11;
+    if (exp == 0)
+      {
+	/* Denormalized number.  Don't try to be clever about this,
+	   since it is not an important case to make fast.  */
+	exp = 1;
+	do
+	  {
+	    manh = (manh << 1) | (manl >> 31);
+	    manl = manl << 1;
+	    exp--;
+	  }
+	while ((mp_limb_signed_t) manh >= 0);
+      }
+#endif
+    exp -= 1022;		/* Remove IEEE bias.  */
+  }
+#else
+  {
+    /* Unknown (or known to be non-IEEE) double format.  */
+    exp = 0;
+    if (d >= 1.0)
+      {
+	if (d * 0.5 == d)
+	  abort ();
+
+	while (d >= 32768.0)
+	  {
+	    d *= (1.0 / 65536.0);
+	    exp += 16;
+	  }
+	while (d >= 1.0)
+	  {
+	    d *= 0.5;
+	    exp += 1;
+	  }
+      }
+    else if (d < 0.5)
+      {
+	while (d < (1.0 / 65536.0))
+	  {
+	    d *=  65536.0;
+	    exp -= 16;
+	  }
+	while (d < 0.5)
+	  {
+	    d *= 2.0;
+	    exp -= 1;
+	  }
+      }
+
+    d *= MP_BASE_AS_DOUBLE;
+#if BITS_PER_MP_LIMB == 64
+    manl = d;
+#else
+    manh = d;
+    manl = (d - manh) * MP_BASE_AS_DOUBLE;
+#endif
+  }
+#endif
+
+  sc = (unsigned) exp % BITS_PER_MP_LIMB;
+
+  /* We add something here to get rounding right.  */
+  exp = (exp + 2048) / BITS_PER_MP_LIMB - 2048 / BITS_PER_MP_LIMB + 1;
+
+#if BITS_PER_MP_LIMB == 64
+  if (sc != 0)
+    {
+      rp[1] = manl >> (BITS_PER_MP_LIMB - sc);
+      rp[0] = manl << sc;
+    }
+  else
+    {
+      rp[1] = manl;
+      rp[0] = 0;
+      exp--;
+    }
+#else
+  if (sc != 0)
+    {
+      rp[2] = manh >> (BITS_PER_MP_LIMB - sc);
+      rp[1] = (manl >> (BITS_PER_MP_LIMB - sc)) | (manh << sc);
+      rp[0] = manl << sc;
+    }
+  else
+    {
+      rp[2] = manh;
+      rp[1] = manl;
+      rp[0] = 0;
+      exp--;
+    }
+#endif
+
+  return exp;
+}
diff --git a/src/gmp/gmp-impl.h b/src/gmp/gmp-impl.h
new file mode 100644
index 000000000..e5636222d
--- /dev/null
+++ b/src/gmp/gmp-impl.h
@@ -0,0 +1,1072 @@
+/* Include file for internal GNU MP types and definitions.
+
+   THE CONTENTS OF THIS FILE ARE FOR INTERNAL USE AND ARE ALMOST CERTAIN TO
+   BE SUBJECT TO INCOMPATIBLE CHANGES IN FUTURE GNU MP RELEASES.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 1999, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "config.h"
+#include "gmp-mparam.h"
+/* #include "longlong.h" */
+
+/* When using gcc, make sure to use its builtin alloca.  */
+#if ! defined (alloca) && defined (__GNUC__)
+#define alloca __builtin_alloca
+#define HAVE_ALLOCA
+#endif
+
+/* When using cc, do whatever necessary to allow use of alloca.  For many
+   machines, this means including alloca.h.  IBM's compilers need a #pragma
+   in "each module that needs to use alloca".  */
+#if ! defined (alloca)
+/* We need lots of variants for MIPS, to cover all versions and perversions
+   of OSes for MIPS.  */
+#if defined (__mips) || defined (MIPSEL) || defined (MIPSEB) \
+ || defined (_MIPSEL) || defined (_MIPSEB) || defined (__sgi) \
+ || defined (__alpha) || defined (__sparc) || defined (sparc) \
+ || defined (__ksr__)
+#include <alloca.h>
+#define HAVE_ALLOCA
+#endif
+#if defined (_IBMR2)
+#pragma alloca
+#define HAVE_ALLOCA
+#endif
+#if defined (__DECC)
+#define alloca(x) __ALLOCA(x)
+#define HAVE_ALLOCA
+#endif
+#endif
+
+#if defined (alloca)
+#define HAVE_ALLOCA
+#endif
+
+#if ! defined (HAVE_ALLOCA) || USE_STACK_ALLOC
+#include "stack-alloc.h"
+#else
+#define TMP_DECL(m)
+#define TMP_ALLOC(x) alloca(x)
+#define TMP_MARK(m)
+#define TMP_FREE(m)
+#endif
+
+/* Allocating various types. */
+#define TMP_ALLOC_TYPE(n,type) ((type *) TMP_ALLOC ((n) * sizeof (type)))
+#define TMP_ALLOC_LIMBS(n)     TMP_ALLOC_TYPE(n,mp_limb_t)
+#define TMP_ALLOC_MP_PTRS(n)   TMP_ALLOC_TYPE(n,mp_ptr)
+
+
+#if ! defined (__GNUC__)	/* FIXME: Test for C++ compilers here,
+				   __DECC understands __inline */
+#define inline			/* Empty */
+#endif
+
+#define ABS(x) (x >= 0 ? x : -x)
+#define MIN(l,o) ((l) < (o) ? (l) : (o))
+#define MAX(h,i) ((h) > (i) ? (h) : (i))
+#define numberof(x)  (sizeof (x) / sizeof ((x)[0]))
+
+/* Field access macros.  */
+#define SIZ(x) ((x)->_mp_size)
+#define ABSIZ(x) ABS (SIZ (x))
+#define PTR(x) ((x)->_mp_d)
+#define LIMBS(x) ((x)->_mp_d)
+#define EXP(x) ((x)->_mp_exp)
+#define PREC(x) ((x)->_mp_prec)
+#define ALLOC(x) ((x)->_mp_alloc)
+
+/* Extra casts because shorts are promoted to ints by "~" and "<<".  "-1"
+   rather than "1" in SIGNED_TYPE_MIN avoids warnings from some compilers
+   about arithmetic overflow.  */
+#define UNSIGNED_TYPE_MAX(type)      ((type) ~ (type) 0)
+#define UNSIGNED_TYPE_HIGHBIT(type)  ((type) ~ (UNSIGNED_TYPE_MAX(type) >> 1))
+#define SIGNED_TYPE_MIN(type)        (((type) -1) << (8*sizeof(type)-1))
+#define SIGNED_TYPE_MAX(type)        ((type) ~ SIGNED_TYPE_MIN(type))
+#define SIGNED_TYPE_HIGHBIT(type)    SIGNED_TYPE_MIN(type)
+
+#define MP_LIMB_T_MAX      UNSIGNED_TYPE_MAX (mp_limb_t)
+#define MP_LIMB_T_HIGHBIT  UNSIGNED_TYPE_HIGHBIT (mp_limb_t)
+
+#define MP_SIZE_T_MAX      SIGNED_TYPE_MAX (mp_size_t)
+
+#ifndef ULONG_MAX
+#define ULONG_MAX          UNSIGNED_TYPE_MAX (unsigned long)
+#endif
+#define ULONG_HIGHBIT      UNSIGNED_TYPE_HIGHBIT (unsigned long)
+#define LONG_HIGHBIT       SIGNED_TYPE_HIGHBIT (long)
+#ifndef LONG_MAX
+#define LONG_MAX           SIGNED_TYPE_MAX (long)
+#endif
+
+#ifndef USHORT_MAX
+#define USHORT_MAX         UNSIGNED_TYPE_MAX (unsigned short)
+#endif
+#define USHORT_HIGHBIT     UNSIGNED_TYPE_HIGHBIT (unsigned short)
+#define SHORT_HIGHBIT      SIGNED_TYPE_HIGHBIT (short)
+#ifndef SHORT_MAX
+#define SHORT_MAX          SIGNED_TYPE_MAX (short)
+#endif
+
+
+/* Swap macros. */
+
+#define MP_LIMB_T_SWAP(x, y)                    \
+  do {                                          \
+    mp_limb_t __mp_limb_t_swap__tmp = (x);      \
+    (x) = (y);                                  \
+    (y) = __mp_limb_t_swap__tmp;                \
+  } while (0)
+#define MP_SIZE_T_SWAP(x, y)                    \
+  do {                                          \
+    mp_size_t __mp_size_t_swap__tmp = (x);      \
+    (x) = (y);                                  \
+    (y) = __mp_size_t_swap__tmp;                \
+  } while (0)
+
+#define MP_PTR_SWAP(x, y)               \
+  do {                                  \
+    mp_ptr __mp_ptr_swap__tmp = (x);    \
+    (x) = (y);                          \
+    (y) = __mp_ptr_swap__tmp;           \
+  } while (0)
+#define MP_SRCPTR_SWAP(x, y)                    \
+  do {                                          \
+    mp_srcptr __mp_srcptr_swap__tmp = (x);      \
+    (x) = (y);                                  \
+    (y) = __mp_srcptr_swap__tmp;                \
+  } while (0)
+
+#define MPN_PTR_SWAP(xp,xs, yp,ys)      \
+  do {                                  \
+    MP_PTR_SWAP (xp, yp);               \
+    MP_SIZE_T_SWAP (xs, ys);            \
+  } while(0)
+#define MPN_SRCPTR_SWAP(xp,xs, yp,ys)   \
+  do {                                  \
+    MP_SRCPTR_SWAP (xp, yp);            \
+    MP_SIZE_T_SWAP (xs, ys);            \
+  } while(0)
+
+#define MPZ_PTR_SWAP(x, y)              \
+  do {                                  \
+    mpz_ptr __mpz_ptr_swap__tmp = (x);  \
+    (x) = (y);                          \
+    (y) = __mpz_ptr_swap__tmp;          \
+  } while (0)
+#define MPZ_SRCPTR_SWAP(x, y)                   \
+  do {                                          \
+    mpz_srcptr __mpz_srcptr_swap__tmp = (x);    \
+    (x) = (y);                                  \
+    (y) = __mpz_srcptr_swap__tmp;               \
+  } while (0)
+
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+
+/* FIXME: These are purely internal, so do a search and replace to change
+   them to __gmp forms, rather than using these macros. */
+#define _mp_allocate_func      __gmp_allocate_func
+#define _mp_reallocate_func    __gmp_reallocate_func
+#define _mp_free_func          __gmp_free_func
+#define _mp_default_allocate   __gmp_default_allocate
+#define _mp_default_reallocate __gmp_default_reallocate
+#define _mp_default_free       __gmp_default_free
+
+extern void *	(*_mp_allocate_func) _PROTO ((size_t));
+extern void *	(*_mp_reallocate_func) _PROTO ((void *, size_t, size_t));
+extern void	(*_mp_free_func) _PROTO ((void *, size_t));
+
+void *_mp_default_allocate _PROTO ((size_t));
+void *_mp_default_reallocate _PROTO ((void *, size_t, size_t));
+void _mp_default_free _PROTO ((void *, size_t));
+
+#define _MP_ALLOCATE_FUNC_TYPE(n,type) \
+  ((type *) (*_mp_allocate_func) ((n) * sizeof (type)))
+#define _MP_ALLOCATE_FUNC_LIMBS(n)   _MP_ALLOCATE_FUNC_TYPE(n,mp_limb_t)
+
+#define _MP_FREE_FUNC_TYPE(p,n,type) (*_mp_free_func) (p, (n) * sizeof (type))
+#define _MP_FREE_FUNC_LIMBS(p,n)     _MP_FREE_FUNC_TYPE(p,n,mp_limb_t)
+
+
+#if (__STDC__-0) || defined (__cplusplus)
+
+#else
+
+#define const			/* Empty */
+#define signed			/* Empty */
+
+#endif
+
+#if defined (__GNUC__) && defined (__i386__)
+#if 0			/* check that these actually improve things */
+#define MPN_COPY_INCR(DST, SRC, N)					\
+  __asm__ ("cld\n\trep\n\tmovsl" : :					\
+	   "D" (DST), "S" (SRC), "c" (N) :				\
+	   "cx", "di", "si", "memory")
+#define MPN_COPY_DECR(DST, SRC, N)					\
+  __asm__ ("std\n\trep\n\tmovsl" : :					\
+	   "D" ((DST) + (N) - 1), "S" ((SRC) + (N) - 1), "c" (N) :	\
+	   "cx", "di", "si", "memory")
+#define MPN_NORMALIZE_NOT_ZERO(P, N)					\
+  do {									\
+    __asm__ ("std\n\trepe\n\tscasl" : "=c" (N) :			\
+	     "a" (0), "D" ((P) + (N) - 1), "0" (N) :			\
+	     "cx", "di");						\
+    (N)++;								\
+  } while (0)
+#endif
+#endif
+
+#if HAVE_NATIVE_mpn_copyi
+#define mpn_copyi __MPN(copyi)
+void mpn_copyi _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
+#endif
+
+/* Remap names of internal mpn functions.  */
+#define __clz_tab               __MPN(clz_tab)
+#define mpn_udiv_w_sdiv		__MPN(udiv_w_sdiv)
+#define mpn_reciprocal		__MPN(reciprocal)
+
+#define mpn_sb_divrem_mn	__MPN(sb_divrem_mn)
+#define mpn_bz_divrem_n		__MPN(bz_divrem_n)
+#define mpn_tdiv_qr		__MPN(tdiv_qr)
+/* #define mpn_tdiv_q		__MPN(tdiv_q) */
+
+#define mpn_kara_mul_n	__MPN(kara_mul_n)
+void mpn_kara_mul_n _PROTO((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t, mp_ptr));
+
+#define mpn_kara_sqr_n  __MPN(kara_sqr_n)
+void mpn_kara_sqr_n _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_ptr));
+
+#define mpn_toom3_mul_n  __MPN(toom3_mul_n)
+void mpn_toom3_mul_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t,mp_ptr));
+
+#define mpn_toom3_sqr_n  __MPN(toom3_sqr_n)
+void mpn_toom3_sqr_n _PROTO((mp_ptr, mp_srcptr, mp_size_t, mp_ptr));
+
+#define mpn_fft_best_k  __MPN(fft_best_k)
+int mpn_fft_best_k _PROTO ((mp_size_t n, int sqr));
+
+#define mpn_mul_fft  __MPN(mul_fft)
+void mpn_mul_fft _PROTO ((mp_ptr op, mp_size_t pl,
+                          mp_srcptr n, mp_size_t nl,
+                          mp_srcptr m, mp_size_t ml,
+                          int k));
+
+#define mpn_mul_fft_full  __MPN(mul_fft_full)
+void mpn_mul_fft_full _PROTO ((mp_ptr op,
+                               mp_srcptr n, mp_size_t nl,
+                               mp_srcptr m, mp_size_t ml));
+
+#define mpn_fft_next_size  __MPN(fft_next_size)
+mp_size_t mpn_fft_next_size _PROTO ((mp_size_t pl, int k));
+
+mp_limb_t mpn_sb_divrem_mn _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_srcptr, mp_size_t));
+mp_limb_t mpn_bz_divrem_n _PROTO ((mp_ptr, mp_ptr, mp_srcptr, mp_size_t));
+void mpn_tdiv_qr _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t));
+/* void mpn_tdiv_q _PROTO ((mp_ptr, mp_size_t, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t)); */
+
+/* Copy NLIMBS *limbs* from SRC to DST, NLIMBS==0 allowed.  */
+#ifndef MPN_COPY_INCR
+#if HAVE_NATIVE_mpn_copyi
+#define MPN_COPY_INCR(DST, SRC, NLIMBS)   mpn_copyi (DST, SRC, NLIMBS)
+#else
+#define MPN_COPY_INCR(DST, SRC, NLIMBS) \
+  do {									\
+    mp_size_t __i;							\
+    for (__i = 0; __i < (NLIMBS); __i++)				\
+      (DST)[__i] = (SRC)[__i];						\
+  } while (0)
+#endif
+#endif
+
+#if HAVE_NATIVE_mpn_copyd
+#define mpn_copyd __MPN(copyd)
+void mpn_copyd _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
+#endif
+
+/* NLIMBS==0 allowed */
+#ifndef MPN_COPY_DECR
+#if HAVE_NATIVE_mpn_copyd
+#define MPN_COPY_DECR(DST, SRC, NLIMBS)   mpn_copyd (DST, SRC, NLIMBS)
+#else
+#define MPN_COPY_DECR(DST, SRC, NLIMBS) \
+  do {									\
+    mp_size_t __i;							\
+    for (__i = (NLIMBS) - 1; __i >= 0; __i--)				\
+      (DST)[__i] = (SRC)[__i];						\
+  } while (0)
+#endif
+#endif
+
+/* Define MPN_COPY for vector computers.  Since #pragma cannot be in a macro,
+   rely on function inlining. */
+#if defined (_CRAY) || defined (__uxp__)
+static inline void
+_MPN_COPY (d, s, n) mp_ptr d; mp_srcptr s; mp_size_t n;
+{
+  int i;				/* Faster for Cray with plain int */
+#pragma _CRI ivdep			/* Cray PVP systems */
+#pragma loop noalias d,s		/* Fujitsu VPP systems */
+  for (i = 0; i < n; i++)
+    d[i] = s[i];
+}
+#define MPN_COPY _MPN_COPY
+#endif
+
+#ifndef MPN_COPY
+#define MPN_COPY MPN_COPY_INCR
+#endif
+
+/* Zero NLIMBS *limbs* AT DST.  */
+#ifndef MPN_ZERO
+#define MPN_ZERO(DST, NLIMBS) \
+  do {									\
+    mp_size_t __i;							\
+    for (__i = 0; __i < (NLIMBS); __i++)				\
+      (DST)[__i] = 0;							\
+  } while (0)
+#endif
+
+#ifndef MPN_NORMALIZE
+#define MPN_NORMALIZE(DST, NLIMBS) \
+  do {									\
+    while (NLIMBS > 0)							\
+      {									\
+	if ((DST)[(NLIMBS) - 1] != 0)					\
+	  break;							\
+	NLIMBS--;							\
+      }									\
+  } while (0)
+#endif
+#ifndef MPN_NORMALIZE_NOT_ZERO
+#define MPN_NORMALIZE_NOT_ZERO(DST, NLIMBS) \
+  do {									\
+    while (1)								\
+      {									\
+	if ((DST)[(NLIMBS) - 1] != 0)					\
+	  break;							\
+	NLIMBS--;							\
+      }									\
+  } while (0)
+#endif
+
+/* Strip least significant zero limbs from ptr,size by incrementing ptr and
+   decrementing size.  The number in ptr,size must be non-zero, ie. size!=0
+   and somewhere a non-zero limb.  */
+#define MPN_STRIP_LOW_ZEROS_NOT_ZERO(ptr, size) \
+  do                                            \
+    {                                           \
+      ASSERT ((size) != 0);                     \
+      while ((ptr)[0] == 0)                     \
+        {                                       \
+          (ptr)++;                              \
+          (size)--;                             \
+          ASSERT (size >= 0);                   \
+	}                                       \
+    }                                           \
+  while (0)
+
+/* Initialize X of type mpz_t with space for NLIMBS limbs.  X should be a
+   temporary variable; it will be automatically cleared out at function
+   return.  We use __x here to make it possible to accept both mpz_ptr and
+   mpz_t arguments.  */
+#define MPZ_TMP_INIT(X, NLIMBS) \
+  do {									\
+    mpz_ptr __x = (X);							\
+    __x->_mp_alloc = (NLIMBS);						\
+    __x->_mp_d = (mp_ptr) TMP_ALLOC ((NLIMBS) * BYTES_PER_MP_LIMB);	\
+  } while (0)
+
+/* Realloc for an mpz_t WHAT if it has less thann NEEDED limbs.  */
+#define MPZ_REALLOC(what,needed) \
+  do {								\
+    if ((needed) > ALLOC (what))				\
+      _mpz_realloc (what, needed);				\
+  } while (0)
+
+/* If KARATSUBA_MUL_THRESHOLD is not already defined, define it to a
+   value which is good on most machines.  */
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD 32
+#endif
+
+/* If TOOM3_MUL_THRESHOLD is not already defined, define it to a
+   value which is good on most machines.  */
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD 256
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD (2*KARATSUBA_MUL_THRESHOLD)
+#endif
+
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD (2*TOOM3_MUL_THRESHOLD)
+#endif
+
+/* First k to use for an FFT modF multiply.  A modF FFT is an order
+   log(2^k)/log(2^(k-1)) algorithm, so k=3 is merely 1.5 like karatsuba,
+   whereas k=4 is 1.33 which is faster than toom3 at 1.485.    */
+#define FFT_FIRST_K  4
+
+/* Threshold at which FFT should be used to do a modF NxN -> N multiply. */
+#ifndef FFT_MODF_MUL_THRESHOLD
+#define FFT_MODF_MUL_THRESHOLD   (TOOM3_MUL_THRESHOLD * 3)
+#endif
+#ifndef FFT_MODF_SQR_THRESHOLD
+#define FFT_MODF_SQR_THRESHOLD   (TOOM3_SQR_THRESHOLD * 3)
+#endif
+
+/* Threshold at which FFT should be used to do an NxN -> 2N multiply.  This
+   will be a size where FFT is using k=7 or k=8, since an FFT-k used for an
+   NxN->2N multiply and not recursing into itself is an order
+   log(2^k)/log(2^(k-2)) algorithm, so it'll be at least k=7 at 1.39 which
+   is the first better than toom3.  */
+#ifndef FFT_MUL_THRESHOLD
+#define FFT_MUL_THRESHOLD   (FFT_MODF_MUL_THRESHOLD * 10)
+#endif
+#ifndef FFT_SQR_THRESHOLD
+#define FFT_SQR_THRESHOLD   (FFT_MODF_SQR_THRESHOLD * 10)
+#endif
+
+/* Table of thresholds for successive modF FFT "k"s.  The first entry is
+   where FFT_FIRST_K+1 should be used, the second FFT_FIRST_K+2,
+   etc.  See mpn_fft_best_k(). */
+#ifndef FFT_MUL_TABLE
+#define FFT_MUL_TABLE                           \
+  { TOOM3_MUL_THRESHOLD * 4,   /* k=5 */        \
+    TOOM3_MUL_THRESHOLD * 8,   /* k=6 */        \
+    TOOM3_MUL_THRESHOLD * 16,  /* k=7 */        \
+    TOOM3_MUL_THRESHOLD * 32,  /* k=8 */        \
+    TOOM3_MUL_THRESHOLD * 96,  /* k=9 */        \
+    TOOM3_MUL_THRESHOLD * 288, /* k=10 */       \
+    0 }
+#endif
+#ifndef FFT_SQR_TABLE
+#define FFT_SQR_TABLE                           \
+  { TOOM3_SQR_THRESHOLD * 4,   /* k=5 */        \
+    TOOM3_SQR_THRESHOLD * 8,   /* k=6 */        \
+    TOOM3_SQR_THRESHOLD * 16,  /* k=7 */        \
+    TOOM3_SQR_THRESHOLD * 32,  /* k=8 */        \
+    TOOM3_SQR_THRESHOLD * 96,  /* k=9 */        \
+    TOOM3_SQR_THRESHOLD * 288, /* k=10 */       \
+    0 }
+#endif
+
+#ifndef FFT_TABLE_ATTRS
+#define FFT_TABLE_ATTRS   static const
+#endif
+
+#define MPN_FFT_TABLE_SIZE  16
+
+
+/* Return non-zero if xp,xsize and yp,ysize overlap.
+   If xp+xsize<=yp there's no overlap, or if yp+ysize<=xp there's no
+   overlap.  If both these are false, there's an overlap. */
+#define MPN_OVERLAP_P(xp, xsize, yp, ysize) \
+  ((xp) + (xsize) > (yp) && (yp) + (ysize) > (xp))
+
+
+/* ASSERT() is a private assertion checking scheme, similar to <assert.h>.
+   ASSERT() does the check only if WANT_ASSERT is selected, ASSERT_ALWAYS()
+   does it always.  Generally assertions are meant for development, but
+   might help when looking for a problem later too.
+
+   ASSERT_NOCARRY() uses ASSERT() to check the expression is zero, but if
+   assertion checking is disabled, the expression is still evaluated.  This
+   is meant for use with routines like mpn_add_n() where the return value
+   represents a carry or whatever that shouldn't occur.  For example,
+   ASSERT_NOCARRY (mpn_add_n (rp, s1p, s2p, size)); */
+
+#ifdef __LINE__
+#define ASSERT_LINE  __LINE__
+#else
+#define ASSERT_LINE  -1
+#endif
+
+#ifdef __FILE__
+#define ASSERT_FILE  __FILE__
+#else
+#define ASSERT_FILE  ""
+#endif
+
+int __gmp_assert_fail _PROTO((const char *filename, int linenum,
+                              const char *expr));
+
+#if HAVE_STRINGIZE
+#define ASSERT_FAIL(expr)  __gmp_assert_fail (ASSERT_FILE, ASSERT_LINE, #expr)
+#else
+#define ASSERT_FAIL(expr)  __gmp_assert_fail (ASSERT_FILE, ASSERT_LINE, "expr")
+#endif
+
+#if HAVE_VOID
+#define CAST_TO_VOID        (void)
+#else
+#define CAST_TO_VOID
+#endif
+
+#define ASSERT_ALWAYS(expr) ((expr) ? 0 : ASSERT_FAIL (expr))
+
+#if WANT_ASSERT
+#define ASSERT(expr)           ASSERT_ALWAYS (expr)
+#define ASSERT_NOCARRY(expr)   ASSERT_ALWAYS ((expr) == 0)
+
+#else
+#define ASSERT(expr)           (CAST_TO_VOID 0)
+#define ASSERT_NOCARRY(expr)   (expr)
+#endif
+
+
+#if HAVE_NATIVE_mpn_com_n
+#define mpn_com_n __MPN(com_n)
+void mpn_com_n _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
+#else
+#define mpn_com_n(d,s,n)        \
+  do                            \
+    {                           \
+      mp_ptr     __d = (d);     \
+      mp_srcptr  __s = (s);     \
+      mp_size_t  __n = (n);     \
+      do                        \
+        *__d++ = *__s++;        \
+      while (--__n);            \
+    }                           \
+  while (0)
+#endif
+
+#define MPN_LOGOPS_N_INLINE(d,s1,s2,n,dop,op,s2op)      \
+  do                                                    \
+    {                                                   \
+      mp_ptr     __d = (d);                             \
+      mp_srcptr  __s1 = (s1);                           \
+      mp_srcptr  __s2 = (s2);                           \
+      mp_size_t  __n = (n);                             \
+      do                                                \
+        *__d++ = dop (*__s1++ op s2op *__s2++);         \
+      while (--__n);                                    \
+    }                                                   \
+  while (0)
+
+#if HAVE_NATIVE_mpn_and_n
+#define mpn_and_n __MPN(and_n)
+void mpn_and_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+#else
+#define mpn_and_n(d,s1,s2,n)  MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,&, )
+#endif
+
+#if HAVE_NATIVE_mpn_andn_n
+#define mpn_andn_n __MPN(andn_n)
+void mpn_andn_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+#else
+#define mpn_andn_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,&,~)
+#endif
+
+#if HAVE_NATIVE_mpn_nand_n
+#define mpn_nand_n __MPN(nand_n)
+void mpn_nand_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+#else
+#define mpn_nand_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n,~,&, )
+#endif
+
+#if HAVE_NATIVE_mpn_ior_n
+#define mpn_ior_n __MPN(ior_n)
+void mpn_ior_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+#else
+#define mpn_ior_n(d,s1,s2,n)  MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,|, )
+#endif
+
+#if HAVE_NATIVE_mpn_iorn_n
+#define mpn_iorn_n __MPN(iorn_n)
+void mpn_iorn_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+#else
+#define mpn_iorn_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,|,~)
+#endif
+
+#if HAVE_NATIVE_mpn_nior_n
+#define mpn_nior_n __MPN(nior_n)
+void mpn_nior_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+#else
+#define mpn_nior_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n,~,|, )
+#endif
+
+#if HAVE_NATIVE_mpn_xor_n
+#define mpn_xor_n __MPN(xor_n)
+void mpn_xor_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+#else
+#define mpn_xor_n(d,s1,s2,n)  MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,^, )
+#endif
+
+#if HAVE_NATIVE_mpn_xnor_n
+#define mpn_xnor_n __MPN(xnor_n)
+void mpn_xnor_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+#else
+#define mpn_xnor_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n,~,^, )
+#endif
+
+/* Structure for conversion between internal binary format and
+   strings in base 2..36.  */
+struct bases
+{
+  /* Number of digits in the conversion base that always fits in an mp_limb_t.
+     For example, for base 10 on a machine where a mp_limb_t has 32 bits this
+     is 9, since 10**9 is the largest number that fits into a mp_limb_t.  */
+  int chars_per_limb;
+
+  /* log(2)/log(conversion_base) */
+  double chars_per_bit_exactly;
+
+  /* base**chars_per_limb, i.e. the biggest number that fits a word, built by
+     factors of base.  Exception: For 2, 4, 8, etc, big_base is log2(base),
+     i.e. the number of bits used to represent each digit in the base.  */
+  mp_limb_t big_base;
+
+  /* A BITS_PER_MP_LIMB bit approximation to 1/big_base, represented as a
+     fixed-point number.  Instead of dividing by big_base an application can
+     choose to multiply by big_base_inverted.  */
+  mp_limb_t big_base_inverted;
+};
+
+#define __mp_bases __MPN(mp_bases)
+extern const struct bases __mp_bases[];
+extern mp_size_t __gmp_default_fp_limb_precision;
+
+#if defined (__i386__)
+#define TARGET_REGISTER_STARVED 1
+#else
+#define TARGET_REGISTER_STARVED 0
+#endif
+
+/* Use a library function for invert_limb, if available. */
+#if ! defined (invert_limb) && HAVE_NATIVE_mpn_invert_limb
+#define mpn_invert_limb  __MPN(invert_limb)
+mp_limb_t mpn_invert_limb _PROTO ((mp_limb_t));
+#define invert_limb(invxl,xl)  (invxl = __MPN(invert_limb) (xl))
+#endif
+
+#ifndef invert_limb
+#define invert_limb(invxl,xl) \
+  do {									\
+    mp_limb_t dummy;							\
+    if (xl << 1 == 0)							\
+      invxl = ~(mp_limb_t) 0;						\
+    else								\
+      udiv_qrnnd (invxl, dummy, -xl, 0, xl);				\
+  } while (0)
+#endif
+
+/* Divide the two-limb number in (NH,,NL) by D, with DI being the largest
+   limb not larger than (2**(2*BITS_PER_MP_LIMB))/D - (2**BITS_PER_MP_LIMB).
+   If this would yield overflow, DI should be the largest possible number
+   (i.e., only ones).  For correct operation, the most significant bit of D
+   has to be set.  Put the quotient in Q and the remainder in R.  */
+#define udiv_qrnnd_preinv(q, r, nh, nl, d, di) \
+  do {									\
+    mp_limb_t _q, _ql, _r;						\
+    mp_limb_t _xh, _xl;							\
+    umul_ppmm (_q, _ql, (nh), (di));					\
+    _q += (nh);			/* DI is 2**BITS_PER_MP_LIMB too small */\
+    umul_ppmm (_xh, _xl, _q, (d));					\
+    sub_ddmmss (_xh, _r, (nh), (nl), _xh, _xl);				\
+    if (_xh != 0)							\
+      {									\
+	sub_ddmmss (_xh, _r, _xh, _r, 0, (d));				\
+	_q += 1;							\
+	if (_xh != 0)							\
+	  {								\
+	    sub_ddmmss (_xh, _r, _xh, _r, 0, (d));			\
+	    _q += 1;							\
+	  }								\
+      }									\
+    if (_r >= (d))							\
+      {									\
+	_r -= (d);							\
+	_q += 1;							\
+      }									\
+    (r) = _r;								\
+    (q) = _q;								\
+  } while (0)
+/* Like udiv_qrnnd_preinv, but for for any value D.  DNORM is D shifted left
+   so that its most significant bit is set.  LGUP is ceil(log2(D)).  */
+#define udiv_qrnnd_preinv2gen(q, r, nh, nl, d, di, dnorm, lgup) \
+  do {									\
+    mp_limb_t _n2, _n10, _n1, _nadj, _q1;				\
+    mp_limb_t _xh, _xl;							\
+    _n2 = ((nh) << (BITS_PER_MP_LIMB - (lgup))) + ((nl) >> 1 >> (l - 1));\
+    _n10 = (nl) << (BITS_PER_MP_LIMB - (lgup));				\
+    _n1 = ((mp_limb_signed_t) _n10 >> (BITS_PER_MP_LIMB - 1));		\
+    _nadj = _n10 + (_n1 & (dnorm));					\
+    umul_ppmm (_xh, _xl, di, _n2 - _n1);				\
+    add_ssaaaa (_xh, _xl, _xh, _xl, 0, _nadj);				\
+    _q1 = ~(_n2 + _xh);							\
+    umul_ppmm (_xh, _xl, _q1, d);					\
+    add_ssaaaa (_xh, _xl, _xh, _xl, nh, nl);				\
+    _xh -= (d);								\
+    (r) = _xl + ((d) & _xh);						\
+    (q) = _xh - _q1;							\
+  } while (0)
+/* Exactly like udiv_qrnnd_preinv, but branch-free.  It is not clear which
+   version to use.  */
+#define udiv_qrnnd_preinv2norm(q, r, nh, nl, d, di) \
+  do {									\
+    mp_limb_t _n2, _n10, _n1, _nadj, _q1;				\
+    mp_limb_t _xh, _xl;							\
+    _n2 = (nh);								\
+    _n10 = (nl);							\
+    _n1 = ((mp_limb_signed_t) _n10 >> (BITS_PER_MP_LIMB - 1));		\
+    _nadj = _n10 + (_n1 & (d));						\
+    umul_ppmm (_xh, _xl, di, _n2 - _n1);				\
+    add_ssaaaa (_xh, _xl, _xh, _xl, 0, _nadj);				\
+    _q1 = ~(_n2 + _xh);							\
+    umul_ppmm (_xh, _xl, _q1, d);					\
+    add_ssaaaa (_xh, _xl, _xh, _xl, nh, nl);				\
+    _xh -= (d);								\
+    (r) = _xl + ((d) & _xh);						\
+    (q) = _xh - _q1;							\
+  } while (0)
+
+
+/* modlimb_invert() sets "inv" to the multiplicative inverse of "n" modulo
+   2^BITS_PER_MP_LIMB, ie. so that inv*n == 1 mod 2^BITS_PER_MP_LIMB.
+   "n" must be odd (otherwise such an inverse doesn't exist).
+
+   This is not to be confused with invert_limb(), which is completely
+   different.
+
+   The table lookup gives an inverse with the low 8 bits valid, and each
+   multiply step doubles the number of bits.  See Jebelean's exact division
+   paper, end of section 4 (reference in gmp.texi). */
+
+#define modlimb_invert_table  __gmp_modlimb_invert_table
+extern const unsigned char  modlimb_invert_table[128];
+
+#if BITS_PER_MP_LIMB <= 32
+#define modlimb_invert(inv,n)                                   \
+  do {                                                          \
+    mp_limb_t  __n = (n);                                       \
+    mp_limb_t  __inv;                                           \
+    ASSERT ((__n & 1) == 1);                                    \
+    __inv = modlimb_invert_table[(__n&0xFF)/2]; /*  8 */        \
+    __inv = 2 * __inv - __inv * __inv * __n;    /* 16 */        \
+    __inv = 2 * __inv - __inv * __inv * __n;    /* 32 */        \
+    ASSERT (__inv * __n == 1);                                  \
+    (inv) = __inv;                                              \
+  } while (0)
+#endif
+
+#if BITS_PER_MP_LIMB > 32 && BITS_PER_MP_LIMB <= 64
+#define modlimb_invert(inv,n)                                   \
+  do {                                                          \
+    mp_limb_t  __n = (n);                                       \
+    mp_limb_t  __inv;                                           \
+    ASSERT ((__n & 1) == 1);                                    \
+    __inv = modlimb_invert_table[(__n&0xFF)/2]; /*  8 */        \
+    __inv = 2 * __inv - __inv * __inv * __n;    /* 16 */        \
+    __inv = 2 * __inv - __inv * __inv * __n;    /* 32 */        \
+    __inv = 2 * __inv - __inv * __inv * __n;    /* 64 */        \
+    ASSERT (__inv * __n == 1);                                  \
+    (inv) = __inv;                                              \
+  } while (0)
+#endif
+
+
+/* The `mode' attribute was introduced in GCC 2.2, but we can only distinguish
+   between GCC 2 releases from 2.5, since __GNUC_MINOR__ wasn't introduced
+   until then.  */
+#if (__GNUC__ - 0 > 2 || defined (__GNUC_MINOR__)) && ! defined (__APPLE_CC__)
+/* Define stuff for longlong.h.  */
+typedef unsigned int UQItype	__attribute__ ((mode (QI)));
+typedef		 int SItype	__attribute__ ((mode (SI)));
+typedef unsigned int USItype	__attribute__ ((mode (SI)));
+typedef		 int DItype	__attribute__ ((mode (DI)));
+typedef unsigned int UDItype	__attribute__ ((mode (DI)));
+#else
+typedef unsigned char UQItype;
+typedef		 long SItype;
+typedef unsigned long USItype;
+#if defined _LONGLONG || defined _LONG_LONG_LIMB
+typedef	long long int DItype;
+typedef unsigned long long int UDItype;
+#else /* Assume `long' gives us a wide enough type.  Needed for hppa2.0w.  */
+typedef long int DItype;
+typedef unsigned long int UDItype;
+#endif
+#endif
+
+typedef mp_limb_t UWtype;
+typedef unsigned int UHWtype;
+#define W_TYPE_SIZE BITS_PER_MP_LIMB
+
+/* Define ieee_double_extract and _GMP_IEEE_FLOATS.  */
+
+#if (defined (__arm__) && (defined (__ARMWEL__) || defined (__linux__)))
+/* Special case for little endian ARM since floats remain in big-endian.  */
+#define _GMP_IEEE_FLOATS 1
+union ieee_double_extract
+{
+  struct
+    {
+      unsigned int manh:20;
+      unsigned int exp:11;
+      unsigned int sig:1;
+      unsigned int manl:32;
+    } s;
+  double d;
+};
+#else
+#if defined (_LITTLE_ENDIAN) || defined (__LITTLE_ENDIAN__)		\
+ || defined (__alpha)							\
+ || defined (__clipper__)						\
+ || defined (__cris)							\
+ || defined (__i386__)							\
+ || defined (__i860__)							\
+ || defined (__i960__)							\
+ || defined (MIPSEL) || defined (_MIPSEL)				\
+ || defined (__ns32000__)						\
+ || defined (__WINNT) || defined (_WIN32)
+#define _GMP_IEEE_FLOATS 1
+union ieee_double_extract
+{
+  struct
+    {
+      unsigned int manl:32;
+      unsigned int manh:20;
+      unsigned int exp:11;
+      unsigned int sig:1;
+    } s;
+  double d;
+};
+#else /* Need this as an #else since the tests aren't made exclusive.  */
+#if defined (_BIG_ENDIAN) || defined (__BIG_ENDIAN__)			\
+ || defined (__a29k__) || defined (_AM29K)				\
+ || defined (__arm__)							\
+ || (defined (__convex__) && defined (_IEEE_FLOAT_))			\
+ || defined (_CRAYMPP)							\
+ || defined (__i370__) || defined (__mvs__)				\
+ || defined (__mc68000__) || defined (__mc68020__) || defined (__m68k__)\
+    || defined(mc68020)							\
+ || defined (__m88000__)						\
+ || defined (MIPSEB) || defined (_MIPSEB)				\
+ || defined (__hppa) || defined (__hppa__)				\
+ || defined (__pyr__)							\
+ || defined (__ibm032__)						\
+ || defined (_IBMR2) || defined (_ARCH_PPC)				\
+ || defined (__sh__)							\
+ || defined (__sparc) || defined (sparc)				\
+ || defined (__we32k__)
+#define _GMP_IEEE_FLOATS 1
+union ieee_double_extract
+{
+  struct
+    {
+      unsigned int sig:1;
+      unsigned int exp:11;
+      unsigned int manh:20;
+      unsigned int manl:32;
+    } s;
+  double d;
+};
+#endif
+#endif
+#endif
+
+/* Using "(2.0 * ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1)))" doesn't work on
+   SunOS 4.1.4 native /usr/ucb/cc (K&R), it comes out as -4294967296.0,
+   presumably due to treating the mp_limb_t constant as signed rather than
+   unsigned. */
+#define MP_BASE_AS_DOUBLE (4.0 * ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 2)))
+#if BITS_PER_MP_LIMB == 64
+#define LIMBS_PER_DOUBLE 2
+#else
+#define LIMBS_PER_DOUBLE 3
+#endif
+
+double __gmp_scale2 _PROTO ((double, int));
+int __gmp_extract_double _PROTO ((mp_ptr, double));
+
+extern int __gmp_junk;
+extern const int __gmp_0;
+#define GMP_ERROR(code)   (gmp_errno |= (code), __gmp_junk = 10/__gmp_0)
+#define DIVIDE_BY_ZERO    GMP_ERROR(GMP_ERROR_DIVISION_BY_ZERO)
+#define SQRT_OF_NEGATIVE  GMP_ERROR(GMP_ERROR_SQRT_OF_NEGATIVE)
+
+#if defined _LONG_LONG_LIMB
+#if defined (__STDC__)
+#define CNST_LIMB(C) C##LL
+#else
+#define CNST_LIMB(C) C/**/LL
+#endif
+#else /* not _LONG_LONG_LIMB */
+#if defined (__STDC__)
+#define CNST_LIMB(C) C##L
+#else
+#define CNST_LIMB(C) C/**/L
+#endif
+#endif /* _LONG_LONG_LIMB */
+
+/*** Stuff used by mpn/generic/prefsqr.c and mpn/generic/next_prime.c ***/
+#if BITS_PER_MP_LIMB == 32
+#define PP 0xC0CFD797L		/* 3 x 5 x 7 x 11 x 13 x ... x 29 */
+#define PP_INVERTED 0x53E5645CL
+#define PP_MAXPRIME 29
+#define PP_MASK 0x208A28A8L
+#endif
+
+#if BITS_PER_MP_LIMB == 64
+#define PP CNST_LIMB(0xE221F97C30E94E1D)	/* 3 x 5 x 7 x 11 x 13 x ... x 53 */
+#define PP_INVERTED CNST_LIMB(0x21CFE6CFC938B36B)
+#define PP_MAXPRIME 53
+#define PP_MASK CNST_LIMB(0x208A20A08A28A8)
+#endif
+
+
+/* BIT1 means a result value in bit 1 (second least significant bit), with a
+   zero bit representing +1 and a one bit representing -1.  Bits other than
+   bit 1 are garbage.
+
+   JACOBI_TWOS_U_BIT1 and JACOBI_RECIP_UU_BIT1 are used in mpn_jacobi_base
+   and their speed is important.  Expressions are used rather than
+   conditionals to accumulate sign changes, which effectively means XORs
+   instead of conditional JUMPs. */
+
+/* (a/0), with a signed; is 1 if a=+/-1, 0 otherwise */
+#define JACOBI_S0(a) \
+  (((a) == 1) | ((a) == -1))
+
+/* (a/0), with a unsigned; is 1 if a=+/-1, 0 otherwise */
+#define JACOBI_U0(a) \
+  ((a) == 1)
+
+/* (a/0), with a an mpz_t; is 1 if a=+/-1, 0 otherwise
+   An mpz_t always has at least one limb of allocated space, so the fetch of
+   the low limb is valid. */
+#define JACOBI_Z0(a) \
+  (((SIZ(a) == 1) | (SIZ(a) == -1)) & (PTR(a)[0] == 1))
+
+/* Convert a bit1 to +1 or -1. */
+#define JACOBI_BIT1_TO_PN(result_bit1) \
+  (1 - ((result_bit1) & 2))
+
+/* (2/b), with b unsigned and odd;
+   is (-1)^((b^2-1)/8) which is 1 if b==1,7mod8 or -1 if b==3,5mod8 and
+   hence obtained from (b>>1)^b */
+#define JACOBI_TWO_U_BIT1(b) \
+  (ASSERT (b & 1), (((b) >> 1) ^ (b)))
+
+/* (2/b)^twos, with b unsigned and odd */
+#define JACOBI_TWOS_U_BIT1(twos, b) \
+  (((twos) << 1) & JACOBI_TWO_U_BIT1 (b))
+
+/* (2/b)^twos, with b unsigned and odd */
+#define JACOBI_TWOS_U(twos, b) \
+  (JACOBI_BIT1_TO_PN (JACOBI_TWOS_U_BIT1 (twos, b)))
+
+/* (a/b) effect due to sign of a: signed/unsigned, b odd;
+   is (-1)^((b-1)/2) if a<0, or +1 if a>=0 */
+#define JACOBI_ASGN_SU_BIT1(a, b) \
+  ((((a) < 0) << 1) & (b))
+
+/* (a/b) effect due to sign of b: signed/mpz;
+   is -1 if a and b both negative, +1 otherwise */
+#define JACOBI_BSGN_SZ_BIT1(a, b) \
+  ((((a) < 0) & (SIZ(b) < 0)) << 1)
+
+/* (a/b) effect due to sign of b: mpz/signed */
+#define JACOBI_BSGN_ZS_BIT1(a, b) \
+  JACOBI_BSGN_SZ_BIT1(b, a)
+
+/* (a/b) reciprocity to switch to (b/a), a,b both unsigned and odd.
+   Is (-1)^((a-1)*(b-1)/4), which means +1 if either a,b==1mod4 or -1 if
+   both a,b==3mod4, achieved in bit 1 by a&b.  No ASSERT()s about a,b odd
+   because this is used in a couple of places with only bit 1 of a or b
+   valid. */
+#define JACOBI_RECIP_UU_BIT1(a, b) \
+  ((a) & (b))
+
+
+/* For testing and debugging.  */
+#define MPZ_CHECK_FORMAT(z)                                     	\
+  (ASSERT_ALWAYS (SIZ(z) == 0 || PTR(z)[ABSIZ(z) - 1] != 0),    	\
+   ASSERT_ALWAYS (ALLOC(z) >= ABSIZ(z)))
+#define MPZ_PROVOKE_REALLOC(z)						\
+  do { ALLOC(z) = ABSIZ(z); } while (0)
+
+
+#if TUNE_PROGRAM_BUILD
+/* Some extras wanted when recompiling some .c files for use by the tune
+   program.  Not part of a normal build. */
+
+extern mp_size_t  mul_threshold[];
+extern mp_size_t  fft_modf_mul_threshold;
+extern mp_size_t  sqr_threshold[];
+extern mp_size_t  fft_modf_sqr_threshold;
+extern mp_size_t  bz_threshold[];
+extern mp_size_t  fib_threshold[];
+extern mp_size_t  powm_threshold[];
+extern mp_size_t  gcd_accel_threshold[];
+extern mp_size_t  gcdext_threshold[];
+
+#undef KARATSUBA_MUL_THRESHOLD
+#undef TOOM3_MUL_THRESHOLD
+#undef FFT_MUL_TABLE
+#undef FFT_MUL_THRESHOLD
+#undef FFT_MODF_MUL_THRESHOLD
+#undef KARATSUBA_SQR_THRESHOLD
+#undef TOOM3_SQR_THRESHOLD
+#undef FFT_SQR_TABLE
+#undef FFT_SQR_THRESHOLD
+#undef FFT_MODF_SQR_THRESHOLD
+#undef BZ_THRESHOLD
+#undef FIB_THRESHOLD
+#undef POWM_THRESHOLD
+#undef GCD_ACCEL_THRESHOLD
+#undef GCDEXT_THRESHOLD
+
+#define KARATSUBA_MUL_THRESHOLD  mul_threshold[0]
+#define TOOM3_MUL_THRESHOLD      mul_threshold[1]
+#define FFT_MUL_TABLE            0
+#define FFT_MUL_THRESHOLD        mul_threshold[2]
+#define FFT_MODF_MUL_THRESHOLD   fft_modf_mul_threshold
+#define KARATSUBA_SQR_THRESHOLD  sqr_threshold[0]
+#define TOOM3_SQR_THRESHOLD      sqr_threshold[1]
+#define FFT_SQR_TABLE            0
+#define FFT_SQR_THRESHOLD        sqr_threshold[2]
+#define FFT_MODF_SQR_THRESHOLD   fft_modf_sqr_threshold
+#define BZ_THRESHOLD             bz_threshold[0]
+#define FIB_THRESHOLD            fib_threshold[0]
+#define POWM_THRESHOLD           powm_threshold[0]
+#define GCD_ACCEL_THRESHOLD      gcd_accel_threshold[0]
+#define GCDEXT_THRESHOLD         gcdext_threshold[0]
+
+#define TOOM3_MUL_THRESHOLD_LIMIT  700
+
+#undef  FFT_TABLE_ATTRS
+#define FFT_TABLE_ATTRS
+extern mp_size_t mpn_fft_table[2][MPN_FFT_TABLE_SIZE];
+
+#endif /* TUNE_PROGRAM_BUILD */
+
+#if defined (__cplusplus)
+}
+#endif
diff --git a/src/gmp/gmp.h b/src/gmp/gmp.h
new file mode 100644
index 000000000..eac9b4248
--- /dev/null
+++ b/src/gmp/gmp.h
@@ -0,0 +1,1073 @@
+/* gmp.h -- Definitions for GNU multiple precision functions.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 1999, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#ifndef __GMP_H__
+
+#ifndef __GNU_MP__		/* to allow inclusion of both gmp.h and mp.h */
+#define __GNU_MP__ 2
+#define __need_size_t
+#include <stddef.h>
+#undef __need_size_t
+
+#if defined (__mips) && defined (_ABIN32)
+/* Force the use of 64-bit limbs for all 64-bit MIPS CPUs if ABI permits.  */
+#define _LONG_LONG_LIMB
+#endif
+
+#if (__STDC__-0) || defined (__cplusplus)
+#define __gmp_const const
+#define __gmp_signed signed
+#else
+#define __gmp_const
+#define __gmp_signed
+#endif
+
+#if defined (__GNUC__)
+#define __gmp_inline __inline__
+#else
+#define __gmp_inline
+#endif
+
+#ifndef _EXTERN_INLINE
+#ifdef __GNUC__
+#define _EXTERN_INLINE extern __inline__
+#else
+#define _EXTERN_INLINE static
+#endif
+#endif
+
+#ifdef _SHORT_LIMB
+typedef unsigned int		mp_limb_t;
+typedef int			mp_limb_signed_t;
+#else
+#ifdef _LONG_LONG_LIMB
+typedef unsigned long long int	mp_limb_t;
+typedef long long int		mp_limb_signed_t;
+#else
+typedef unsigned long int	mp_limb_t;
+typedef long int		mp_limb_signed_t;
+#endif
+#endif
+
+typedef mp_limb_t *		mp_ptr;
+typedef __gmp_const mp_limb_t *	mp_srcptr;
+#if defined (_CRAY) && ! defined (_CRAYMPP)
+/* plain `int' is much faster (48 bits) */
+typedef int			mp_size_t;
+typedef int			mp_exp_t;
+#else
+typedef long int		mp_size_t;
+typedef long int		mp_exp_t;
+#endif
+
+typedef struct
+{
+  int _mp_alloc;		/* Number of *limbs* allocated and pointed
+				   to by the _mp_d field.  */
+  int _mp_size;			/* abs(_mp_size) is the number of limbs the
+				   last field points to.  If _mp_size is
+				   negative this is a negative number.  */
+  mp_limb_t *_mp_d;		/* Pointer to the limbs.  */
+} __mpz_struct;
+#endif /* __GNU_MP__ */
+
+typedef __mpz_struct MP_INT;
+typedef __mpz_struct mpz_t[1];
+
+typedef struct
+{
+  __mpz_struct _mp_num;
+  __mpz_struct _mp_den;
+} __mpq_struct;
+
+typedef __mpq_struct MP_RAT;
+typedef __mpq_struct mpq_t[1];
+
+typedef struct
+{
+  int _mp_prec;			/* Max precision, in number of `mp_limb_t's.
+				   Set by mpf_init and modified by
+				   mpf_set_prec.  The area pointed to by the
+				   _mp_d field contains `prec' + 1 limbs.  */
+  int _mp_size;			/* abs(_mp_size) is the number of limbs the
+				   last field points to.  If _mp_size is
+				   negative this is a negative number.  */
+  mp_exp_t _mp_exp;		/* Exponent, in the base of `mp_limb_t'.  */
+  mp_limb_t *_mp_d;		/* Pointer to the limbs.  */
+} __mpf_struct;
+
+/* typedef __mpf_struct MP_FLOAT; */
+typedef __mpf_struct mpf_t[1];
+
+/* Available random number generation algorithms.  */
+typedef enum
+{
+  GMP_RAND_ALG_DEFAULT = 0,
+  GMP_RAND_ALG_LC = GMP_RAND_ALG_DEFAULT /* Linear congruential.  */
+} gmp_randalg_t;
+
+/* Linear congruential data struct.  */
+typedef struct {
+  mpz_t a;			/* Multiplier. */
+  unsigned long int c;		/* Adder. */
+  mpz_t m;			/* Modulus (valid only if m2exp == 0).  */
+  unsigned long int m2exp;	/* If != 0, modulus is 2 ^ m2exp.  */
+} __gmp_randata_lc;
+
+/* Random state struct.  */
+typedef struct
+{
+  mpz_t seed;			/* Current seed.  */
+  gmp_randalg_t alg;		/* Algorithm used.  */
+  union {			/* Algorithm specific data.  */
+    __gmp_randata_lc *lc;	/* Linear congruential.  */
+  } algdata;
+} __gmp_randstate_struct;
+typedef __gmp_randstate_struct gmp_randstate_t[1];
+
+/* Types for function declarations in gmp files.  */
+/* ??? Should not pollute user name space with these ??? */
+typedef __gmp_const __mpz_struct *mpz_srcptr;
+typedef __mpz_struct *mpz_ptr;
+typedef __gmp_const __mpf_struct *mpf_srcptr;
+typedef __mpf_struct *mpf_ptr;
+typedef __gmp_const __mpq_struct *mpq_srcptr;
+typedef __mpq_struct *mpq_ptr;
+
+#ifndef _PROTO
+#if (__STDC__-0) || defined (__cplusplus)
+#define _PROTO(x) x
+#else
+#define _PROTO(x) ()
+#endif
+#endif
+
+#ifndef __MPN
+/* Really use `defined (__STDC__)' here; we want it to be true for Sun C */
+#if defined (__STDC__) || defined (__cplusplus)
+#define __MPN(x) __gmpn_##x
+#else
+#define __MPN(x) __gmpn_/**/x
+#endif
+#endif
+
+#if defined (FILE) || defined (H_STDIO) || defined (_H_STDIO) \
+ || defined (_STDIO_H) || defined (_STDIO_H_) || defined (__STDIO_H__) \
+ || defined (_STDIO_INCLUDED) || defined (__dj_include_stdio_h_)
+#define _GMP_H_HAVE_FILE 1
+#endif
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+
+#define mp_set_memory_functions __gmp_set_memory_functions
+void mp_set_memory_functions _PROTO ((void *(*) (size_t),
+				      void *(*) (void *, size_t, size_t),
+				      void (*) (void *, size_t)));
+
+#define mp_bits_per_limb __gmp_bits_per_limb
+extern __gmp_const int mp_bits_per_limb;
+
+#if defined (__cplusplus)
+}
+#endif
+
+
+/**************** Random number routines.  ****************/
+
+#define _gmp_rand __gmp_rand
+#define gmp_randinit __gmp_randinit
+#define gmp_randinit_lc __gmp_randinit_lc
+#define gmp_randinit_lc_2exp __gmp_randinit_lc_2exp
+#define gmp_randseed __gmp_randseed
+#define gmp_randseed_ui __gmp_randseed_ui
+#define gmp_randclear __gmp_randclear
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+
+void _gmp_rand _PROTO ((mp_ptr, gmp_randstate_t, unsigned long int));
+void gmp_randinit _PROTO ((gmp_randstate_t, gmp_randalg_t, ...));
+void gmp_randinit_lc _PROTO ((gmp_randstate_t, mpz_t, unsigned long int,
+			      mpz_t));
+void gmp_randinit_lc_2exp _PROTO ((gmp_randstate_t, mpz_t, unsigned long int,
+				   unsigned long int));
+void gmp_randseed _PROTO ((gmp_randstate_t, mpz_t));
+void gmp_randseed_ui _PROTO ((gmp_randstate_t, unsigned long int));
+void gmp_randclear _PROTO ((gmp_randstate_t));
+
+#if defined (__cplusplus)
+}
+#endif
+
+/**************** Integer (i.e. Z) routines.  ****************/
+
+#define _mpz_realloc __gmpz_realloc
+#define mpz_realloc __gmpz_realloc
+#define mpz_abs __gmpz_abs
+#define mpz_add __gmpz_add
+#define mpz_add_ui __gmpz_add_ui
+#define mpz_addmul_ui __gmpz_addmul_ui
+#define mpz_and __gmpz_and
+#define mpz_array_init __gmpz_array_init
+#define mpz_bin_ui __gmpz_bin_ui
+#define mpz_bin_uiui __gmpz_bin_uiui
+#define mpz_cdiv_q __gmpz_cdiv_q
+#define mpz_cdiv_q_ui __gmpz_cdiv_q_ui
+#define mpz_cdiv_qr __gmpz_cdiv_qr
+#define mpz_cdiv_qr_ui __gmpz_cdiv_qr_ui
+#define mpz_cdiv_r __gmpz_cdiv_r
+#define mpz_cdiv_r_ui __gmpz_cdiv_r_ui
+#define mpz_cdiv_ui __gmpz_cdiv_ui
+#define mpz_clear __gmpz_clear
+#define mpz_clrbit __gmpz_clrbit
+#define mpz_cmp __gmpz_cmp
+#define _mpz_cmp_si __gmpz_cmp_si
+#define _mpz_cmp_ui __gmpz_cmp_ui
+#define mpz_cmpabs __gmpz_cmpabs
+#define mpz_cmpabs_ui __gmpz_cmpabs_ui
+#define mpz_com __gmpz_com
+#define mpz_divexact __gmpz_divexact
+#define mpz_dump __gmpz_dump
+#define mpz_fac_ui __gmpz_fac_ui
+#define mpz_fdiv_q __gmpz_fdiv_q
+#define mpz_fdiv_q_2exp __gmpz_fdiv_q_2exp
+#define mpz_fdiv_q_ui __gmpz_fdiv_q_ui
+#define mpz_fdiv_qr __gmpz_fdiv_qr
+#define mpz_fdiv_qr_ui __gmpz_fdiv_qr_ui
+#define mpz_fdiv_r __gmpz_fdiv_r
+#define mpz_fdiv_r_2exp __gmpz_fdiv_r_2exp
+#define mpz_fdiv_r_ui __gmpz_fdiv_r_ui
+#define mpz_fdiv_ui __gmpz_fdiv_ui
+#define mpz_fib_ui __gmpz_fib_ui
+#define mpz_fits_sint_p __gmpz_fits_sint_p
+#define mpz_fits_slong_p __gmpz_fits_slong_p
+#define mpz_fits_sshort_p __gmpz_fits_sshort_p
+#define mpz_fits_uint_p __gmpz_fits_uint_p
+#define mpz_fits_ulong_p __gmpz_fits_ulong_p
+#define mpz_fits_ushort_p __gmpz_fits_ushort_p
+#define mpz_gcd __gmpz_gcd
+#define mpz_gcd_ui __gmpz_gcd_ui
+#define mpz_gcdext __gmpz_gcdext
+#define mpz_get_d __gmpz_get_d
+#define mpz_get_si __gmpz_get_si
+#define mpz_get_str __gmpz_get_str
+#define mpz_get_ui __gmpz_get_ui
+#define mpz_getlimbn __gmpz_getlimbn
+#define mpz_hamdist __gmpz_hamdist
+#define mpz_init __gmpz_init
+#define mpz_inp_binary __gmpz_inp_binary
+#define mpz_inp_raw __gmpz_inp_raw
+#define mpz_inp_str __gmpz_inp_str
+#define mpz_init_set __gmpz_init_set
+#define mpz_init_set_d __gmpz_init_set_d
+#define mpz_init_set_si __gmpz_init_set_si
+#define mpz_init_set_str __gmpz_init_set_str
+#define mpz_init_set_ui __gmpz_init_set_ui
+#define mpz_invert __gmpz_invert
+#define mpz_ior __gmpz_ior
+#define mpz_jacobi __gmpz_jacobi
+#define mpz_lcm __gmpz_lcm
+#define mpz_legendre __gmpz_legendre
+#define mpz_mod __gmpz_mod
+#define mpz_mul __gmpz_mul
+#define mpz_mul_2exp __gmpz_mul_2exp
+#define mpz_neg __gmpz_neg
+#define mpz_nextprime __gmpz_nextprime
+#define mpz_out_binary __gmpz_out_binary
+#define mpz_out_raw __gmpz_out_raw
+#define mpz_out_str __gmpz_out_str
+#define mpz_perfect_power_p __gmpz_perfect_power_p
+#define mpz_perfect_square_p __gmpz_perfect_square_p
+#define mpz_popcount __gmpz_popcount
+#define mpz_pow_ui __gmpz_pow_ui
+#define mpz_powm __gmpz_powm
+#define mpz_powm_ui __gmpz_powm_ui
+#define mpz_probab_prime_p __gmpz_probab_prime_p
+#define mpz_random __gmpz_random
+#define mpz_random2 __gmpz_random2
+#define mpz_remove __gmpz_remove
+#define mpz_root __gmpz_root
+#define mpz_rrandomb __gmpz_rrandomb
+#define mpz_scan0 __gmpz_scan0
+#define mpz_scan1 __gmpz_scan1
+#define mpz_set __gmpz_set
+#define mpz_set_d __gmpz_set_d
+#define mpz_set_f __gmpz_set_f
+#define mpz_set_q __gmpz_set_q
+#define mpz_set_si __gmpz_set_si
+#define mpz_set_str __gmpz_set_str
+#define mpz_set_ui __gmpz_set_ui
+#define mpz_setbit __gmpz_setbit
+#define mpz_size __gmpz_size
+#define mpz_sizeinbase __gmpz_sizeinbase
+#define mpz_sqrt __gmpz_sqrt
+#define mpz_sqrtrem __gmpz_sqrtrem
+#define mpz_sub __gmpz_sub
+#define mpz_sub_ui __gmpz_sub_ui
+#define mpz_swap __gmpz_swap
+#define mpz_tdiv_ui __gmpz_tdiv_ui
+#define mpz_tdiv_q __gmpz_tdiv_q
+#define mpz_tdiv_q_2exp __gmpz_tdiv_q_2exp
+#define mpz_tdiv_q_ui __gmpz_tdiv_q_ui
+#define mpz_tdiv_qr __gmpz_tdiv_qr
+#define mpz_tdiv_qr_ui __gmpz_tdiv_qr_ui
+#define mpz_tdiv_r __gmpz_tdiv_r
+#define mpz_tdiv_r_2exp __gmpz_tdiv_r_2exp
+#define mpz_tdiv_r_ui __gmpz_tdiv_r_ui
+#define mpz_tstbit __gmpz_tstbit
+#define mpz_ui_pow_ui __gmpz_ui_pow_ui
+#define mpz_urandomb __gmpz_urandomb
+#define mpz_urandomm __gmpz_urandomm
+#define mpz_xor __gmpz_xor
+#define mpz_eor __gmpz_xor
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+void *_mpz_realloc _PROTO ((mpz_ptr, mp_size_t));
+
+void mpz_abs _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_add _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_add_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_addmul_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_and _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_array_init _PROTO ((mpz_ptr, mp_size_t, mp_size_t));
+void mpz_bin_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_bin_uiui _PROTO ((mpz_ptr, unsigned long int, unsigned long int));
+void mpz_cdiv_q _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_cdiv_q_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_cdiv_qr _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_cdiv_qr_ui _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_cdiv_r _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_cdiv_r_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_cdiv_ui _PROTO ((mpz_srcptr, unsigned long int));
+void mpz_clear _PROTO ((mpz_ptr));
+void mpz_clrbit _PROTO ((mpz_ptr, unsigned long int));
+int mpz_cmp _PROTO ((mpz_srcptr, mpz_srcptr));
+int _mpz_cmp_si _PROTO ((mpz_srcptr, signed long int));
+int _mpz_cmp_ui _PROTO ((mpz_srcptr, unsigned long int));
+int mpz_cmpabs _PROTO ((mpz_srcptr, mpz_srcptr));
+int mpz_cmpabs_ui _PROTO ((mpz_srcptr, unsigned long int));
+void mpz_com _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_divexact _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_dump _PROTO ((mpz_srcptr));
+void mpz_fac_ui _PROTO ((mpz_ptr, unsigned long int));
+void mpz_fdiv_q _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_fdiv_q_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_fdiv_q_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_fdiv_qr _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_fdiv_qr_ui _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_fdiv_r _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_fdiv_r_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_fdiv_r_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_fdiv_ui _PROTO ((mpz_srcptr, unsigned long int));
+void mpz_fib_ui _PROTO ((mpz_ptr, unsigned long int));
+int mpz_fits_sint_p _PROTO ((mpz_srcptr));
+int mpz_fits_slong_p _PROTO ((mpz_srcptr));
+int mpz_fits_sshort_p _PROTO ((mpz_srcptr));
+int mpz_fits_uint_p _PROTO ((mpz_srcptr));
+int mpz_fits_ulong_p _PROTO ((mpz_srcptr));
+int mpz_fits_ushort_p _PROTO ((mpz_srcptr));
+void mpz_gcd _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_gcd_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_gcdext _PROTO ((mpz_ptr, mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
+double mpz_get_d _PROTO ((mpz_srcptr));
+/* signed */ long int mpz_get_si _PROTO ((mpz_srcptr));
+char *mpz_get_str _PROTO ((char *, int, mpz_srcptr));
+unsigned long int mpz_get_ui _PROTO ((mpz_srcptr));
+mp_limb_t mpz_getlimbn _PROTO ((mpz_srcptr, mp_size_t));
+unsigned long int mpz_hamdist _PROTO ((mpz_srcptr, mpz_srcptr));
+void mpz_init _PROTO ((mpz_ptr));
+#ifdef _GMP_H_HAVE_FILE
+size_t mpz_inp_binary _PROTO ((mpz_ptr, FILE *));
+size_t mpz_inp_raw _PROTO ((mpz_ptr, FILE *));
+size_t mpz_inp_str _PROTO ((mpz_ptr, FILE *, int));
+#endif
+void mpz_init_set _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_init_set_d _PROTO ((mpz_ptr, double));
+void mpz_init_set_si _PROTO ((mpz_ptr, signed long int));
+int mpz_init_set_str _PROTO ((mpz_ptr, __gmp_const char *, int));
+void mpz_init_set_ui _PROTO ((mpz_ptr, unsigned long int));
+int mpz_invert _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_ior _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+int mpz_jacobi _PROTO ((mpz_srcptr, mpz_srcptr));
+
+#define mpz_kronecker_si __gmpz_kronecker_si
+int mpz_kronecker_si _PROTO ((mpz_srcptr, long));
+
+#define mpz_kronecker_ui __gmpz_kronecker_ui
+int mpz_kronecker_ui _PROTO ((mpz_srcptr, unsigned long));
+
+#define mpz_si_kronecker __gmpz_si_kronecker
+int mpz_si_kronecker _PROTO ((long, mpz_srcptr));
+
+#define mpz_ui_kronecker __gmpz_ui_kronecker
+int mpz_ui_kronecker _PROTO ((unsigned long, mpz_srcptr));
+
+void mpz_lcm _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+int mpz_legendre _PROTO ((mpz_srcptr, mpz_srcptr));
+void mpz_mod _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_mul _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_mul_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+
+#define mpz_mul_si __gmpz_mul_si
+void mpz_mul_si _PROTO ((mpz_ptr, mpz_srcptr, long int));
+
+#define mpz_mul_ui __gmpz_mul_ui
+void mpz_mul_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+
+void mpz_neg _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_nextprime _PROTO ((mpz_ptr, mpz_srcptr));
+#ifdef _GMP_H_HAVE_FILE
+size_t mpz_out_binary _PROTO ((FILE *, mpz_srcptr));
+size_t mpz_out_raw _PROTO ((FILE *, mpz_srcptr));
+size_t mpz_out_str _PROTO ((FILE *, int, mpz_srcptr));
+#endif
+int mpz_perfect_power_p _PROTO ((mpz_srcptr));
+int mpz_perfect_square_p _PROTO ((mpz_srcptr));
+unsigned long int mpz_popcount _PROTO ((mpz_srcptr));
+void mpz_pow_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_powm _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr, mpz_srcptr));
+void mpz_powm_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int, mpz_srcptr));
+int mpz_probab_prime_p _PROTO ((mpz_srcptr, int));
+void mpz_random _PROTO ((mpz_ptr, mp_size_t));
+void mpz_random2 _PROTO ((mpz_ptr, mp_size_t));
+unsigned long int mpz_remove _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+int mpz_root _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_rrandomb _PROTO ((mpz_ptr, gmp_randstate_t, unsigned long int));
+unsigned long int mpz_scan0 _PROTO ((mpz_srcptr, unsigned long int));
+unsigned long int mpz_scan1 _PROTO ((mpz_srcptr, unsigned long int));
+void mpz_set _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_set_d _PROTO ((mpz_ptr, double));
+void mpz_set_f _PROTO ((mpz_ptr, mpf_srcptr));
+void mpz_set_q _PROTO ((mpz_ptr, mpq_srcptr));
+void mpz_set_si _PROTO ((mpz_ptr, signed long int));
+int mpz_set_str _PROTO ((mpz_ptr, __gmp_const char *, int));
+void mpz_set_ui _PROTO ((mpz_ptr, unsigned long int));
+void mpz_setbit _PROTO ((mpz_ptr, unsigned long int));
+size_t mpz_size _PROTO ((mpz_srcptr));
+size_t mpz_sizeinbase _PROTO ((mpz_srcptr, int));
+void mpz_sqrt _PROTO ((mpz_ptr, mpz_srcptr));
+void mpz_sqrtrem _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr));
+void mpz_sub _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_sub_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_swap _PROTO ((mpz_ptr, mpz_ptr));
+void mpz_tdiv_q _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_tdiv_q_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_tdiv_ui _PROTO ((mpz_srcptr, unsigned long int));
+unsigned long int mpz_tdiv_q_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_tdiv_qr _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
+unsigned long int mpz_tdiv_qr_ui _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
+void mpz_tdiv_r _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+void mpz_tdiv_r_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+unsigned long int mpz_tdiv_r_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+int mpz_tstbit _PROTO ((mpz_srcptr, unsigned long int));
+void mpz_ui_pow_ui _PROTO ((mpz_ptr, unsigned long int, unsigned long int));
+void mpz_urandomb _PROTO ((mpz_t, gmp_randstate_t, unsigned long int));
+void mpz_urandomm _PROTO ((mpz_t, gmp_randstate_t, mpz_t));
+void mpz_xor _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+#if defined (__cplusplus)
+}
+#endif
+
+/**************** Rational (i.e. Q) routines.  ****************/
+
+#define mpq_init __gmpq_init
+#define mpq_clear __gmpq_clear
+#define mpq_set __gmpq_set
+#define mpq_set_ui __gmpq_set_ui
+#define mpq_set_si __gmpq_set_si
+#define mpq_set_z __gmpq_set_z
+#define mpq_add __gmpq_add
+#define mpq_sub __gmpq_sub
+#define mpq_mul __gmpq_mul
+#define mpq_div __gmpq_div
+#define mpq_neg __gmpq_neg
+#define mpq_cmp __gmpq_cmp
+#define _mpq_cmp_ui __gmpq_cmp_ui
+#define mpq_equal __gmpq_equal
+#define mpq_inv __gmpq_inv
+#define mpq_set_num __gmpq_set_num
+#define mpq_set_den __gmpq_set_den
+#define mpq_get_num __gmpq_get_num
+#define mpq_get_den __gmpq_get_den
+#define mpq_get_d __gmpq_get_d
+#define mpq_set_d __gmpq_set_d
+#define mpq_canonicalize __gmpq_canonicalize
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+void mpq_init _PROTO ((mpq_ptr));
+void mpq_clear _PROTO ((mpq_ptr));
+void mpq_set _PROTO ((mpq_ptr, mpq_srcptr));
+void mpq_set_ui _PROTO ((mpq_ptr, unsigned long int, unsigned long int));
+void mpq_set_si _PROTO ((mpq_ptr, signed long int, unsigned long int));
+void mpq_set_z _PROTO ((mpq_ptr, mpz_srcptr));
+void mpq_add _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
+void mpq_sub _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
+void mpq_mul _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
+void mpq_div _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
+void mpq_neg _PROTO ((mpq_ptr, mpq_srcptr));
+int mpq_cmp _PROTO ((mpq_srcptr, mpq_srcptr));
+int _mpq_cmp_ui _PROTO ((mpq_srcptr, unsigned long int, unsigned long int));
+int mpq_equal _PROTO ((mpq_srcptr, mpq_srcptr));
+void mpq_inv _PROTO ((mpq_ptr, mpq_srcptr));
+void mpq_set_num _PROTO ((mpq_ptr, mpz_srcptr));
+void mpq_set_den _PROTO ((mpq_ptr, mpz_srcptr));
+void mpq_get_num _PROTO ((mpz_ptr, mpq_srcptr));
+void mpq_get_den _PROTO ((mpz_ptr, mpq_srcptr));
+double mpq_get_d _PROTO ((mpq_srcptr));
+void mpq_set_d _PROTO ((mpq_ptr, double));
+void mpq_canonicalize _PROTO ((mpq_ptr));
+
+#define mpq_swap __gmpq_swap
+void mpq_swap _PROTO ((mpq_ptr, mpq_ptr));
+
+#ifdef _GMP_H_HAVE_FILE
+#define mpq_out_str __gmpq_out_str
+size_t mpq_out_str _PROTO ((FILE *, int, mpq_srcptr));
+#endif
+
+#if defined (__cplusplus)
+}
+#endif
+
+/**************** Float (i.e. F) routines.  ****************/
+
+#define mpf_abs __gmpf_abs
+#define mpf_add __gmpf_add
+#define mpf_add_ui __gmpf_add_ui
+#define mpf_ceil __gmpf_ceil
+#define mpf_clear __gmpf_clear
+#define mpf_cmp __gmpf_cmp
+#define mpf_cmp_si __gmpf_cmp_si
+#define mpf_cmp_ui __gmpf_cmp_ui
+#define mpf_div __gmpf_div
+#define mpf_div_2exp __gmpf_div_2exp
+#define mpf_div_ui __gmpf_div_ui
+#define mpf_dump __gmpf_dump
+#define mpf_floor __gmpf_floor
+#define mpf_eq __gmpf_eq
+#define mpf_get_d __gmpf_get_d
+#define mpf_get_prec __gmpf_get_prec
+#define mpf_get_str __gmpf_get_str
+#define mpf_init __gmpf_init
+#define mpf_init2 __gmpf_init2
+#define mpf_inp_str __gmpf_inp_str
+#define mpf_init_set __gmpf_init_set
+#define mpf_init_set_d __gmpf_init_set_d
+#define mpf_init_set_si __gmpf_init_set_si
+#define mpf_init_set_str __gmpf_init_set_str
+#define mpf_init_set_ui __gmpf_init_set_ui
+#define mpf_mul __gmpf_mul
+#define mpf_mul_2exp __gmpf_mul_2exp
+#define mpf_mul_ui __gmpf_mul_ui
+#define mpf_neg __gmpf_neg
+#define mpf_out_str __gmpf_out_str
+#define mpf_pow_ui __gmpf_pow_ui
+#define mpf_random2 __gmpf_random2
+#define mpf_reldiff __gmpf_reldiff
+#define mpf_set __gmpf_set
+#define mpf_set_d __gmpf_set_d
+#define mpf_set_default_prec __gmpf_set_default_prec
+#define mpf_set_prec __gmpf_set_prec
+#define mpf_set_prec_raw __gmpf_set_prec_raw
+#define mpf_set_q __gmpf_set_q
+#define mpf_set_si __gmpf_set_si
+#define mpf_set_str __gmpf_set_str
+#define mpf_set_ui __gmpf_set_ui
+#define mpf_set_z __gmpf_set_z
+#define mpf_size __gmpf_size
+#define mpf_sqrt __gmpf_sqrt
+#define mpf_sqrt_ui __gmpf_sqrt_ui
+#define mpf_sub __gmpf_sub
+#define mpf_sub_ui __gmpf_sub_ui
+#define mpf_trunc __gmpf_trunc
+#define mpf_ui_div __gmpf_ui_div
+#define mpf_ui_sub __gmpf_ui_sub
+#define mpf_urandomb __gmpf_urandomb
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+void mpf_abs _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_add _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_add_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_ceil _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_clear _PROTO ((mpf_ptr));
+int mpf_cmp _PROTO ((mpf_srcptr, mpf_srcptr));
+int mpf_cmp_si _PROTO ((mpf_srcptr, signed long int));
+int mpf_cmp_ui _PROTO ((mpf_srcptr, unsigned long int));
+void mpf_div _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_div_2exp _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_div_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_dump _PROTO ((mpf_srcptr));
+int mpf_eq _PROTO ((mpf_srcptr, mpf_srcptr, unsigned long int));
+void mpf_floor _PROTO ((mpf_ptr, mpf_srcptr));
+double mpf_get_d _PROTO ((mpf_srcptr));
+unsigned long int mpf_get_prec _PROTO ((mpf_srcptr));
+char *mpf_get_str _PROTO ((char *, mp_exp_t *, int, size_t, mpf_srcptr));
+void mpf_init _PROTO ((mpf_ptr));
+void mpf_init2 _PROTO ((mpf_ptr, unsigned long int));
+#ifdef _GMP_H_HAVE_FILE
+size_t mpf_inp_str _PROTO ((mpf_ptr, FILE *, int));
+#endif
+void mpf_init_set _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_init_set_d _PROTO ((mpf_ptr, double));
+void mpf_init_set_si _PROTO ((mpf_ptr, signed long int));
+int mpf_init_set_str _PROTO ((mpf_ptr, __gmp_const char *, int));
+void mpf_init_set_ui _PROTO ((mpf_ptr, unsigned long int));
+void mpf_mul _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_mul_2exp _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_mul_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_neg _PROTO ((mpf_ptr, mpf_srcptr));
+#ifdef _GMP_H_HAVE_FILE
+size_t mpf_out_str _PROTO ((FILE *, int, size_t, mpf_srcptr));
+#endif
+void mpf_pow_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_random2 _PROTO ((mpf_ptr, mp_size_t, mp_exp_t));
+void mpf_reldiff _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_set _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_set_d _PROTO ((mpf_ptr, double));
+void mpf_set_default_prec _PROTO ((unsigned long int));
+void mpf_set_prec _PROTO ((mpf_ptr, unsigned long int));
+void mpf_set_prec_raw _PROTO ((mpf_ptr, unsigned long int));
+void mpf_set_q _PROTO ((mpf_ptr, mpq_srcptr));
+void mpf_set_si _PROTO ((mpf_ptr, signed long int));
+int mpf_set_str _PROTO ((mpf_ptr, __gmp_const char *, int));
+void mpf_set_ui _PROTO ((mpf_ptr, unsigned long int));
+void mpf_set_z _PROTO ((mpf_ptr, mpz_srcptr));
+size_t mpf_size _PROTO ((mpf_srcptr));
+void mpf_sqrt _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_sqrt_ui _PROTO ((mpf_ptr, unsigned long int));
+void mpf_sub _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
+void mpf_sub_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
+void mpf_trunc _PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_ui_div _PROTO ((mpf_ptr, unsigned long int, mpf_srcptr));
+void mpf_ui_sub _PROTO ((mpf_ptr, unsigned long int, mpf_srcptr));
+void mpf_urandomb _PROTO ((mpf_t, gmp_randstate_t, unsigned long int));
+
+#define mpf_swap __gmpf_swap
+void mpf_swap _PROTO ((mpf_ptr, mpf_ptr));
+
+#if defined (__cplusplus)
+}
+#endif
+/************ Low level positive-integer (i.e. N) routines.  ************/
+
+/* This is ugly, but we need to make user calls reach the prefixed function. */
+#define mpn_add			__MPN(add)
+#define mpn_add_1		__MPN(add_1)
+#define mpn_add_n		__MPN(add_n)
+#define mpn_add_nc		__MPN(add_nc)
+#define mpn_addmul_1		__MPN(addmul_1)
+#define mpn_addsub_n		__MPN(addsub_n)
+#define mpn_addsub_nc		__MPN(addsub_nc)
+/* #define mpn_and_n		__MPN(and_n) */
+/* #define mpn_andn_n		__MPN(andn_n) */
+#define mpn_bdivmod		__MPN(bdivmod)
+#define mpn_cmp			__MPN(cmp)
+/* #define mpn_com_n		__MPN(com_n) */
+#define mpn_copyd		__MPN(copyd)
+#define mpn_copyi		__MPN(copyi)
+#define mpn_divrem		__MPN(divrem)
+#define mpn_divrem_1		__MPN(divrem_1)
+#define mpn_divrem_2		__MPN(divrem_2)
+#define mpn_dump		__MPN(dump)
+#define mpn_gcd			__MPN(gcd)
+#define mpn_gcd_1		__MPN(gcd_1)
+#define mpn_gcdext		__MPN(gcdext)
+#define mpn_get_str		__MPN(get_str)
+#define mpn_hamdist		__MPN(hamdist)
+#define mpn_invert_limb 	__MPN(invert_limb)
+/* #define mpn_ior_n		__MPN(ior_n) */
+/* #define mpn_iorn_n		__MPN(iorn_n) */
+/* #define mpn_kara_mul_n	__MPN(kara_mul_n)  internal */
+/* #define mpn_kara_sqr_n	__MPN(kara_sqr_n)  internal */
+#define mpn_lshift		__MPN(lshift)
+#define mpn_lshiftc		__MPN(lshiftc)
+#define mpn_mod_1		__MPN(mod_1)
+#define mpn_mul			__MPN(mul)
+#define mpn_mul_1		__MPN(mul_1)
+#define mpn_mul_basecase	__MPN(mul_basecase)
+#define mpn_mul_n		__MPN(mul_n)
+#define mpn_perfect_square_p	__MPN(perfect_square_p)
+#define mpn_popcount		__MPN(popcount)
+#define mpn_preinv_mod_1	__MPN(preinv_mod_1)
+/* #define mpn_nand_n		__MPN(nand_n) */
+/* #define mpn_nior_n		__MPN(nior_n) */
+#define mpn_random		__MPN(random)
+#define mpn_random2		__MPN(random2)
+#define mpn_rshift		__MPN(rshift)
+#define mpn_rshiftc		__MPN(rshiftc)
+#define mpn_scan0		__MPN(scan0)
+#define mpn_scan1		__MPN(scan1)
+#define mpn_set_str		__MPN(set_str)
+#define mpn_sqr_basecase	__MPN(sqr_basecase)
+#define mpn_sqr_n		__MPN(sqr_n)
+#define mpn_sqrtrem		__MPN(sqrtrem)
+#define mpn_sub			__MPN(sub)
+#define mpn_sub_1		__MPN(sub_1)
+#define mpn_sub_n		__MPN(sub_n)
+#define mpn_sub_nc		__MPN(sub_nc)
+#define mpn_submul_1		__MPN(submul_1)
+/* #define mpn_toom3_mul_n		__MPN(toom3_mul_n)  internal */
+/* #define mpn_toom3_sqr_n		__MPN(toom3_sqr_n)  internal */
+/* #define mpn_xnor_n		__MPN(xnor_n) */
+/* #define mpn_xor_n		__MPN(xor_n) */
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+mp_limb_t mpn_add _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr,mp_size_t));
+mp_limb_t mpn_add_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+mp_limb_t mpn_add_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+mp_limb_t mpn_add_nc _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t, mp_limb_t));
+
+mp_limb_t mpn_addmul_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+
+#define mpn_addmul_1c  __MPN(addmul_1c)
+mp_limb_t mpn_addmul_1c _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
+
+mp_limb_t mpn_addsub_n _PROTO ((mp_ptr, mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+mp_limb_t mpn_bdivmod _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_srcptr, mp_size_t, unsigned long int));
+int mpn_cmp _PROTO ((mp_srcptr, mp_srcptr, mp_size_t));
+
+#define mpn_divexact_by3(dst, src, size)  mpn_divexact_by3c (dst, src, size, 0)
+
+#define mpn_divexact_by3c  __MPN(divexact_by3c)
+mp_limb_t mpn_divexact_by3c _PROTO ((mp_ptr dst, mp_srcptr src,
+                                     mp_size_t size, mp_limb_t carry));
+
+#define mpn_divmod_1(qp,np,nsize,dlimb) mpn_divrem_1 (qp,0,np,nsize,dlimb)
+
+mp_limb_t mpn_divrem _PROTO((mp_ptr, mp_size_t, mp_ptr, mp_size_t, mp_srcptr, mp_size_t));
+
+mp_limb_t mpn_divrem_1 _PROTO ((mp_ptr, mp_size_t, mp_srcptr, mp_size_t, mp_limb_t));
+
+#define mpn_divrem_1c  __MPN(divrem_1c)
+mp_limb_t mpn_divrem_1c _PROTO ((mp_ptr, mp_size_t, mp_srcptr, mp_size_t,
+                                 mp_limb_t, mp_limb_t));
+
+mp_limb_t mpn_divrem_2 _PROTO ((mp_ptr, mp_size_t, mp_ptr, mp_size_t, mp_srcptr));
+void mpn_dump _PROTO ((mp_srcptr, mp_size_t));
+mp_size_t mpn_gcd _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_ptr, mp_size_t));
+mp_limb_t mpn_gcd_1 _PROTO ((mp_srcptr, mp_size_t, mp_limb_t));
+mp_size_t mpn_gcdext _PROTO ((mp_ptr, mp_ptr, mp_size_t *, mp_ptr, mp_size_t, mp_ptr, mp_size_t));
+size_t mpn_get_str _PROTO ((unsigned char *, int, mp_ptr, mp_size_t));
+unsigned long int mpn_hamdist _PROTO ((mp_srcptr, mp_srcptr, mp_size_t));
+
+#define mpn_jacobi_base __MPN(jacobi_base)
+int mpn_jacobi_base _PROTO ((mp_limb_t a, mp_limb_t b, int result_bit1));
+
+mp_limb_t mpn_lshift _PROTO ((mp_ptr, mp_srcptr, mp_size_t, unsigned int));
+mp_limb_t mpn_mod_1 _PROTO ((mp_srcptr, mp_size_t, mp_limb_t));
+
+#define mpn_mod_1c  __MPN(mod_1c)
+mp_limb_t mpn_mod_1c _PROTO ((mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
+
+#define mpn_mod_1_rshift __MPN(mod_1_rshift)
+mp_limb_t mpn_mod_1_rshift _PROTO ((mp_srcptr, mp_size_t, unsigned,mp_limb_t));
+
+mp_limb_t mpn_mul _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t));
+mp_limb_t mpn_mul_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+
+#define mpn_mul_1c  __MPN(mul_1c)
+mp_limb_t mpn_mul_1c _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
+
+void mpn_mul_basecase _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t));
+void mpn_mul_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+int mpn_perfect_square_p _PROTO ((mp_srcptr, mp_size_t));
+unsigned long int mpn_popcount _PROTO ((mp_srcptr, mp_size_t));
+mp_limb_t mpn_preinv_mod_1 _PROTO ((mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
+void mpn_random _PROTO ((mp_ptr, mp_size_t));
+void mpn_random2 _PROTO ((mp_ptr, mp_size_t));
+mp_limb_t mpn_rshift _PROTO ((mp_ptr, mp_srcptr, mp_size_t, unsigned int));
+unsigned long int mpn_scan0 _PROTO ((mp_srcptr, unsigned long int));
+unsigned long int mpn_scan1 _PROTO ((mp_srcptr, unsigned long int));
+mp_size_t mpn_set_str _PROTO ((mp_ptr, __gmp_const unsigned char *, size_t, int));
+void mpn_sqr_n _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
+void mpn_sqr_basecase _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
+mp_size_t mpn_sqrtrem _PROTO ((mp_ptr, mp_ptr, mp_srcptr, mp_size_t));
+mp_limb_t mpn_sub _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr,mp_size_t));
+mp_limb_t mpn_sub_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+mp_limb_t mpn_sub_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+mp_limb_t mpn_sub_nc _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t, mp_limb_t));
+mp_limb_t mpn_submul_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
+
+#define mpn_submul_1c  __MPN(submul_1c)
+mp_limb_t mpn_submul_1c _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
+
+#if defined (__cplusplus)
+}
+#endif
+
+#define mpn_incr_u(p,incr) \
+  do { mp_limb_t __x; mp_ptr __p = p;			\
+    __x = *__p + incr;					\
+    *__p = __x;						\
+    if (__x < incr)					\
+      while (++(*(++__p)) == 0)				\
+        ;						\
+  } while (0)
+
+#define mpn_decr_u(p,incr) \
+  do { mp_limb_t __x; mp_ptr __p = p;			\
+    __x = *__p;						\
+    *__p = __x - incr;					\
+    if (__x < incr)					\
+      while ((*(++__p))-- == 0)				\
+        ;						\
+  } while (0)
+
+#if defined (__GNUC__) || defined (_FORCE_INLINES)
+_EXTERN_INLINE mp_limb_t
+#if (__STDC__-0) || defined (__cplusplus)
+mpn_add_1 (register mp_ptr res_ptr,
+	   register mp_srcptr s1_ptr,
+	   register mp_size_t s1_size,
+	   register mp_limb_t s2_limb)
+#else
+mpn_add_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_size_t s1_size;
+     register mp_limb_t s2_limb;
+#endif
+{
+  register mp_limb_t x;
+
+  x = *s1_ptr++;
+  s2_limb = x + s2_limb;
+  *res_ptr++ = s2_limb;
+  if (s2_limb < x)
+    {
+      while (--s1_size != 0)
+	{
+	  x = *s1_ptr++ + 1;
+	  *res_ptr++ = x;
+	  if (x != 0)
+	    goto fin;
+	}
+
+      return 1;
+    }
+
+ fin:
+  if (res_ptr != s1_ptr)
+    {
+      mp_size_t i;
+      for (i = 0; i < s1_size - 1; i++)
+	res_ptr[i] = s1_ptr[i];
+    }
+  return 0;
+}
+
+_EXTERN_INLINE mp_limb_t
+#if (__STDC__-0) || defined (__cplusplus)
+mpn_add (register mp_ptr res_ptr,
+	 register mp_srcptr s1_ptr,
+	 register mp_size_t s1_size,
+	 register mp_srcptr s2_ptr,
+	 register mp_size_t s2_size)
+#else
+mpn_add (res_ptr, s1_ptr, s1_size, s2_ptr, s2_size)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_size_t s1_size;
+     register mp_srcptr s2_ptr;
+     register mp_size_t s2_size;
+#endif
+{
+  mp_limb_t cy_limb = 0;
+
+  if (s2_size != 0)
+    cy_limb = mpn_add_n (res_ptr, s1_ptr, s2_ptr, s2_size);
+
+  if (s1_size - s2_size != 0)
+    cy_limb = mpn_add_1 (res_ptr + s2_size,
+			 s1_ptr + s2_size,
+			 s1_size - s2_size,
+			 cy_limb);
+  return cy_limb;
+}
+
+_EXTERN_INLINE mp_limb_t
+#if (__STDC__-0) || defined (__cplusplus)
+mpn_sub_1 (register mp_ptr res_ptr,
+	   register mp_srcptr s1_ptr,
+	   register mp_size_t s1_size,
+	   register mp_limb_t s2_limb)
+#else
+mpn_sub_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_size_t s1_size;
+     register mp_limb_t s2_limb;
+#endif
+{
+  register mp_limb_t x;
+
+  x = *s1_ptr++;
+  s2_limb = x - s2_limb;
+  *res_ptr++ = s2_limb;
+  if (s2_limb > x)
+    {
+      while (--s1_size != 0)
+	{
+	  x = *s1_ptr++;
+	  *res_ptr++ = x - 1;
+	  if (x != 0)
+	    goto fin;
+	}
+
+      return 1;
+    }
+
+ fin:
+  if (res_ptr != s1_ptr)
+    {
+      mp_size_t i;
+      for (i = 0; i < s1_size - 1; i++)
+	res_ptr[i] = s1_ptr[i];
+    }
+  return 0;
+}
+
+_EXTERN_INLINE mp_limb_t
+#if (__STDC__-0) || defined (__cplusplus)
+mpn_sub (register mp_ptr res_ptr,
+	 register mp_srcptr s1_ptr,
+	 register mp_size_t s1_size,
+	 register mp_srcptr s2_ptr,
+	 register mp_size_t s2_size)
+#else
+mpn_sub (res_ptr, s1_ptr, s1_size, s2_ptr, s2_size)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_size_t s1_size;
+     register mp_srcptr s2_ptr;
+     register mp_size_t s2_size;
+#endif
+{
+  mp_limb_t cy_limb = 0;
+
+  if (s2_size != 0)
+    cy_limb = mpn_sub_n (res_ptr, s1_ptr, s2_ptr, s2_size);
+
+  if (s1_size - s2_size != 0)
+    cy_limb = mpn_sub_1 (res_ptr + s2_size,
+			 s1_ptr + s2_size,
+			 s1_size - s2_size,
+			 cy_limb);
+  return cy_limb;
+}
+#endif /* __GNUC__ */
+
+/* Allow faster testing for negative, zero, and positive.  */
+#define mpz_sgn(Z) ((Z)->_mp_size < 0 ? -1 : (Z)->_mp_size > 0)
+#define mpf_sgn(F) ((F)->_mp_size < 0 ? -1 : (F)->_mp_size > 0)
+#define mpq_sgn(Q) ((Q)->_mp_num._mp_size < 0 ? -1 : (Q)->_mp_num._mp_size > 0)
+
+/* When using GCC, optimize certain common comparisons.  */
+#if defined (__GNUC__)
+#define mpz_cmp_ui(Z,UI) \
+  (__builtin_constant_p (UI) && (UI) == 0				\
+   ? mpz_sgn (Z) : _mpz_cmp_ui (Z,UI))
+#define mpz_cmp_si(Z,SI) \
+  (__builtin_constant_p (SI) && (SI) == 0 ? mpz_sgn (Z)			\
+   : __builtin_constant_p (SI) && (SI) > 0				\
+    ? _mpz_cmp_ui (Z, (unsigned long int) SI)				\
+   : _mpz_cmp_si (Z,SI))
+#define mpq_cmp_ui(Q,NUI,DUI) \
+  (__builtin_constant_p (NUI) && (NUI) == 0				\
+   ? mpq_sgn (Q) : _mpq_cmp_ui (Q,NUI,DUI))
+#else
+#define mpz_cmp_ui(Z,UI) _mpz_cmp_ui (Z,UI)
+#define mpz_cmp_si(Z,UI) _mpz_cmp_si (Z,UI)
+#define mpq_cmp_ui(Q,NUI,DUI) _mpq_cmp_ui (Q,NUI,DUI)
+#endif
+
+
+/* Using "&" rather than "&&" means these can come out branch-free.  Every
+   mpz_t has at least one limb allocated, so fetching the low limb is always
+   allowed.  */
+#define mpz_odd_p(z)   ((int) ((z)->_mp_size != 0) & (int) (z)->_mp_d[0])
+#define mpz_even_p(z)  (! mpz_odd_p (z))
+
+
+/* Allow direct user access to numerator and denominator of a mpq_t object.  */
+#define mpq_numref(Q) (&((Q)->_mp_num))
+#define mpq_denref(Q) (&((Q)->_mp_den))
+
+
+/* Compatibility with GMP 2 and earlier. */
+#define mpn_divmod(qp,np,nsize,dp,dsize) mpn_divrem (qp,0,np,nsize,dp,dsize)
+
+/* Compatibility with GMP 1.  */
+#define mpz_mdiv	mpz_fdiv_q
+#define mpz_mdivmod	mpz_fdiv_qr
+#define mpz_mmod	mpz_fdiv_r
+#define mpz_mdiv_ui	mpz_fdiv_q_ui
+#define mpz_mdivmod_ui(q,r,n,d) \
+  ((r == 0) ? mpz_fdiv_q_ui (q,n,d) : mpz_fdiv_qr_ui (q,r,n,d))
+#define mpz_mmod_ui(r,n,d) \
+  ((r == 0) ? mpz_fdiv_ui (n,d) : mpz_fdiv_r_ui (r,n,d))
+
+/* Useful synonyms, but not quite compatible with GMP 1.  */
+#define mpz_div		mpz_fdiv_q
+#define mpz_divmod	mpz_fdiv_qr
+#define mpz_div_ui	mpz_fdiv_q_ui
+#define mpz_divmod_ui	mpz_fdiv_qr_ui
+#define mpz_mod_ui	mpz_fdiv_r_ui
+#define mpz_div_2exp	mpz_fdiv_q_2exp
+#define mpz_mod_2exp	mpz_fdiv_r_2exp
+
+#define gmp_errno __gmp_errno
+extern int gmp_errno;
+
+enum
+{
+  GMP_ERROR_NONE = 0,
+  GMP_ERROR_UNSUPPORTED_ARGUMENT = 1,
+  GMP_ERROR_DIVISION_BY_ZERO = 2,
+  GMP_ERROR_SQRT_OF_NEGATIVE = 4,
+  GMP_ERROR_INVALID_ARGUMENT = 8,
+  GMP_ERROR_ALLOCATE = 16,
+  GMP_ERROR_BAD_STRING = 32,
+  GMP_ERROR_UNUSED_ERROR
+};
+
+/* Note: major version number is in mp.h too */
+#define __GNU_MP_VERSION 3
+#define __GNU_MP_VERSION_MINOR 1
+#define __GNU_MP_VERSION_PATCHLEVEL 0
+
+#define gmp_version __gmp_version
+extern __gmp_const char *gmp_version;
+
+#define __GMP_H__
+#endif /* __GMP_H__ */
diff --git a/src/gmp/gmp.texi b/src/gmp/gmp.texi
new file mode 100644
index 000000000..9f9a2c863
--- /dev/null
+++ b/src/gmp/gmp.texi
@@ -0,0 +1,3950 @@
+\input texinfo    @c -*-texinfo-*-
+@c %**start of header
+@setfilename gmp.info
+@include version.texi
+@settitle GNU MP @value{VERSION}
+@synindex tp fn
+@iftex
+@afourpaper
+@end iftex
+@comment %**end of header
+
+@dircategory GNU libraries
+@direntry
+* gmp: (gmp).                   GNU Multiple Precision Arithmetic Library.
+@end direntry
+
+@c smallbook
+
+@iftex
+@finalout
+@end iftex
+
+@c Texinfo version 4 or up will be needed to process this into .info files.
+@c
+@c The edition number is in three places and the month/year in one, all
+@c taken from version.texi.  version.texi is created when you configure with
+@c --enable-maintainer-mode, and is included in a distribution made with
+@c "make dist".
+
+
+@ifnottex
+This file documents GNU MP, a library for arbitrary-precision arithmetic.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000 Free
+Software Foundation, Inc.
+
+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 Foundation.
+@end ifnottex
+
+@setchapternewpage on
+@titlepage
+@c  use the new format for titles
+
+@title GNU MP
+@subtitle The GNU Multiple Precision Arithmetic Library
+@subtitle Edition @value{EDITION}
+@subtitle @value{UPDATED}
+
+@author by Torbj@"orn Granlund, Swox AB
+@email{tege@@swox.com}
+
+@c Include the Distribution inside the titlepage so
+@c that headings are turned off.
+
+@tex
+\global\parindent=0pt
+\global\parskip=8pt
+\global\baselineskip=13pt
+@end tex
+
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000
+Free Software Foundation, Inc.
+
+@sp 2
+
+Published by the Free Software Foundation @*
+59 Temple Place - Suite 330 @*
+Boston, MA 02111-1307, USA @*
+
+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 the Foundation.
+@end titlepage
+@headings double
+
+@ifnottex
+@node Top, Copying, (dir), (dir)
+
+@top GNU MP
+
+This manual documents how to install and use the GNU multiple precision
+arithmetic library, version @value{VERSION}.
+
+@end ifnottex
+
+@menu
+* Copying::                    GMP Copying Conditions (LGPL).
+* Introduction to GMP::        Brief introduction to GNU MP.
+* Installing GMP::             How to configure and compile the GMP library.
+* GMP Basics::                 What every GMP user should now.
+* Reporting Bugs::             How to usefully report bugs.
+* Integer Functions::          Functions for arithmetic on signed integers.
+* Rational Number Functions::  Functions for arithmetic on rational numbers.
+* Floating-point Functions::   Functions for arithmetic on floats.
+* Low-level Functions::        Fast functions for natural numbers.
+* Random Number Functions::    Functions for generating random numbers.
+* BSD Compatible Functions::   All functions found in BSD MP.
+* Custom Allocation::          How to customize the internal allocation.
+
+* Contributors::	       Who brings your this library?
+* References::                 Some useful papers and books to read.
+* Concept Index::
+* Function Index::
+@end menu
+
+@node Copying, Introduction to GMP, Top, Top
+@comment  node-name, next, previous,  up
+@unnumbered GNU MP Copying Conditions
+@cindex Copying conditions
+@cindex Conditions for copying GNU MP
+
+This library is @dfn{free}; this means that everyone is free to use it and
+free to redistribute it on a free basis.  The library is not in the public
+domain; it is copyrighted and there are restrictions on its distribution, but
+these restrictions are designed to permit everything that a good cooperating
+citizen would want to do.  What is not allowed is to try to prevent others
+from further sharing any version of this library that they might get from
+you.@refill
+
+Specifically, we want to make sure that you have the right to give away copies
+of the library, that you receive source code or else can get it if you want
+it, that you can change this library or use pieces of it in new free programs,
+and that you know you can do these things.@refill
+
+To make sure that everyone has such rights, we have to forbid you to deprive
+anyone else of these rights.  For example, if you distribute copies of the GNU
+MP library, 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 tell them their rights.@refill
+
+Also, for our own protection, we must make certain that everyone finds out
+that there is no warranty for the GNU MP library.  If it is modified by
+someone else and passed on, we want their recipients to know that what they
+have is not what we distributed, so that any problems introduced by others
+will not reflect on our reputation.@refill
+
+The precise conditions of the license for the GNU MP library are found in the
+Library General Public License that accompany the source code.@refill
+
+
+@node Introduction to GMP, Installing GMP, Copying, Top
+@comment  node-name,  next,  previous,  up
+@chapter Introduction to GNU MP
+@cindex Introduction
+
+GNU MP is a portable library written in C for arbitrary precision arithmetic
+on integers, rational numbers, and floating-point numbers.  It aims to provide
+the fastest possible arithmetic for all applications that need higher
+precision than is directly supported by the basic C types.
+
+Many applications use just a few hundred bits of precision; but some
+applications may need thousands or even millions of bits.  GMP is designed to
+give good performance for both, by choosing algorithms based on the sizes of
+the operands, and by carefully keeping the overhead at a minimum.
+
+The speed of GMP is achieved by using fullwords as the basic arithmetic type,
+by using sophisticated algorithms, by including carefully optimized assembly
+code for the most common inner loops for many different CPUs, and by a general
+emphasis on speed (as opposed to simplicity or elegance).
+
+There is carefully optimized assembly code for these CPUs:
+@cindex CPUs supported
+ARM,
+DEC Alpha 21064, 21164, and 21264,
+AMD 29000,
+AMD K6 and Athlon,
+Hitachi SuperH and SH-2,
+HPPA 1.0, 1.1 and 2.0,
+Intel Pentium, Pentium Pro/Pentium II, generic x86,
+Intel i960,
+Motorola MC68000, MC68020, MC88100, and MC88110,
+Motorola/IBM PowerPC 32 and 64,
+National NS32000,
+IBM POWER,
+MIPS R3000, R4000,
+SPARCv7, SuperSPARC, generic SPARCv8, UltraSPARC,
+DEC VAX,
+and Zilog Z8000.
+Some optimizations also for Clipper, IBM ROMP (RT), and Pyramid AP/XP.
+
+@cindex Mailing list
+There is a mailing list for GMP users.  To join it, send a mail to
+@email{gmp-request@@swox.com} with the word @samp{subscribe} in the message
+@strong{body} (not in the subject line).
+
+@cindex Home page
+@cindex Web page
+For up-to-date information on GMP, please see the GMP Home Pages at
+@uref{http://www.swox.com/gmp/}.
+
+
+@section How to use this Manual
+@cindex About this manual
+
+Everyone should read @ref{GMP Basics}.  If you need to install the library
+yourself, you need to read @ref{Installing GMP}, too.
+
+The rest of the manual can be used for later reference, although it is
+probably a good idea to glance through it.
+
+
+@node Installing GMP, GMP Basics, Introduction to GMP, Top
+@comment  node-name,  next,  previous,  up
+@chapter Installing GMP
+@cindex Installing GMP
+@cindex Configuring GMP
+
+@noindent
+GMP has an autoconf/automake/libtool based configuration system.  On a
+Unix-like system a basic build can be done with
+
+@example
+./configure
+make
+@end example
+
+@noindent
+Some self-tests can be run with
+
+@example
+make check
+@end example
+
+@noindent
+And you can install (under @file{/usr/local} by default) with
+
+@example
+make install
+@end example
+
+@noindent
+If you experience problems, please report them to @email{bug-gmp@@gnu.org}.
+(@xref{Reporting Bugs}, for information on what to include in useful bug
+reports.)
+
+@menu
+* Build Options::               
+* ABI and ISA::                 
+* Notes for Package Builds::    
+* Notes for Particular Systems::  
+* Known Build Problems::        
+@end menu
+
+
+@node Build Options, ABI and ISA, Installing GMP, Installing GMP
+@section Build Options
+@cindex Build options
+
+@noindent
+All the usual autoconf configure options are available, run @samp{./configure
+--help} for a summary.
+
+@table @asis
+@item Non-Unix Systems
+
+@samp{configure} needs various Unix-like tools installed.  On an MS-DOS system
+cygwin or djgpp should work.  It might be possible to build without the help
+of @samp{configure}, certainly all the code is there, but unfortunately you'll
+be on your own.
+
+@item Object Directory
+
+To compile in a separate object directory, @command{cd} to that directory, and
+prefix the configure command with the path to the GMP source directory.  For
+example @samp{../src/gmp/configure}.  Not all @samp{make} programs have the
+necessary features (@code{VPATH}) to support this.  In particular, SunOS and
+Slowaris @command{make} have bugs that make them unable to build from a
+separate object directory.  Use GNU @command{make} instead.
+
+@item @option{--disable-shared}, @option{--disable-static}
+
+By default both shared and static libraries are built (where possible), but
+one or other can be disabled.  Shared libraries are very slightly slower,
+having a small cost on each function call, but result in smaller executables
+and permit code sharing between separate running processes.
+
+@item @option{--target=CPU-VENDOR-OS}
+
+The build target can be specified in the usual way, for either native or cross
+compilation.
+
+If @option{--target} isn't given, @samp{./configure} builds for the host
+system as determined by @samp{./config.guess}.  On some systems this can't
+distinguish between different CPUs in a family, and you should check the
+guess.  Running @samp{./config.guess} on the target system will also show the
+relevant @samp{VENDOR-OS}, if you don't already know what it should be.
+
+In general, if you want a library that runs as fast as possible, you should
+configure GMP for the exact CPU type your system uses.  However, this may mean
+the binaries won't run on older members of the family, and might run slower on
+other members, older or newer.  The best idea is always to build GMP for the
+exact machine type you intend to run it on.
+
+The following CPU targets have specific assembly code support.  See
+@file{configure.in} for which @file{mpn} subdirectories get used by each.
+
+@itemize @bullet
+
+@c Keep this formatting, it's easy to read and it can be grepped to
+@c automatically test that targets listed get through ./config.sub
+
+@item
+Alpha:
+@samp{alpha},
+@samp{alphaev5},
+@samp{alphaev6}
+
+@item
+Hitachi:
+@samp{sh},
+@samp{sh2}
+
+@item
+HPPA:
+@samp{hppa1.0},
+@samp{hppa1.1},
+@samp{hppa2.0},
+@samp{hppa2.0w}
+
+@item
+MIPS:
+@samp{mips},
+@samp{mips3},
+
+@item
+Motorola:
+@samp{m68000},
+@samp{m68k},
+@samp{m88k},
+@samp{m88110}
+
+@item
+POWER: 
+@samp{power1},
+@samp{power2},
+@samp{power2sc},
+@samp{powerpc},
+@samp{powerpc64}
+
+@item
+SPARC:
+@samp{sparc},
+@samp{sparcv8},
+@samp{microsparc},
+@samp{supersparc},
+@samp{sparcv9},
+@samp{ultrasparc},
+@samp{sparc64}
+
+@item
+80x86 family:
+@samp{i386},
+@samp{i486},
+@samp{i586},
+@samp{pentium},
+@samp{pentiummmx},
+@samp{pentiumpro},
+@samp{pentium2},
+@samp{pentium3},
+@samp{k6},
+@samp{k62},
+@samp{k63},
+@samp{athlon}
+
+@item
+Other:
+@samp{a29k},
+@samp{arm},
+@samp{clipper},
+@samp{i960},
+@samp{ns32k},
+@samp{pyramid},
+@samp{vax},
+@samp{z8k}
+@end itemize
+
+CPUs not listed use generic C code.  If some of the assembly code causes
+problems, the generic C code can be selected with CPU @samp{none}.
+
+@item @option{CC}, @option{CFLAGS}
+
+The C compiler used is chosen from among some likely candidates, with GCC
+normally preferred if it's present.  The usual @samp{CC=whatever} can be
+passed to @samp{./configure} to choose something different.
+
+For some configurations specific compiler flags are set based on the target
+CPU and compiler, for others @samp{CFLAGS="-whatever"} can be used to
+set the best flags.
+
+If @samp{CC} is set then @samp{CFLAGS} must also be set.  This applies even if
+@samp{CC} is merely one of the choices GMP would make itself.  This may change
+in a future release.
+
+@item @option{--disable-alloca}
+@cindex Stack overflow segfaults
+@cindex @code{alloca}
+
+By default, GMP allocates temporary workspace using @code{alloca} if that
+function is available, or @code{malloc} if not.  If you're working with large
+numbers and @code{alloca} overflows the available stack space, you can build
+with @option{--disable-alloca} to use @code{malloc} instead.  @code{malloc}
+will probably be slightly slower than @code{alloca}.
+
+When not using @code{alloca}, it's actually the allocation function
+selected with @code{mp_set_memory_functions} that's used, this being
+@code{malloc} by default.  @xref{Custom Allocation}.
+
+Depending on your system, the only indication of stack overflow might be a
+segmentation violation.  It might be possible to increase available stack
+space with @command{limit}, @command{ulimit} or @code{setrlimit}, or under
+DJGPP with @command{stubedit} or @code{_stklen}.
+
+@item @option{--enable-fft}
+
+By default multiplications are done using Karatsuba and 3-way Toom-Cook
+algorithms, but a Fermat FFT can be enabled, for use on large to very large
+operands.  Currently the FFT is recommended only for knowledgeable users who
+check the algorithm thresholds for their CPU.
+
+@item @option{--enable-mpbsd}
+
+The Berkeley MP compatibility library (@file{libmp.a}) and header file
+(@file{mp.h}) are built and installed only if @option{--enable-mpbsd} is used.
+@xref{BSD Compatible Functions}.
+
+@item @option{MPN_PATH}
+
+Various assembler versions of mpn subroutines are provided, and, for a given
+CPU target, a search is made though a path to choose a version of each.  For
+example @samp{sparcv8} has path @samp{"sparc32/v8 sparc32 generic"}, which
+means it looks first for v8 code, falls back on plain sparc32, and finally
+falls back on generic C.  Knowledgeable users with special requirements can
+specify a path with @samp{MPN_PATH="dir list"}.  This will normally be
+unnecessary because all sensible paths should be available under one or other
+CPU target.
+
+@item Demonstration Programs
+@cindex Demonstration programs
+@cindex Example programs
+
+The @file{demos} subdirectory has some sample programs using GMP.  These
+aren't built or installed, but there's a @file{Makefile} with rules for them.
+For instance, @samp{make pexpr} and then @samp{./pexpr 68^975+10}.
+
+@item Documentation
+
+The document you're now reading is @file{gmp.texi}.  The usual automake
+targets are available to make @file{gmp.ps} and/or @file{gmp.dvi}.  Some
+supplementary notes can be found in the @file{doc} subdirectory.
+@end table
+
+
+@need 2000
+@node ABI and ISA, Notes for Package Builds, Build Options, Installing GMP
+@section ABI and ISA
+@cindex ABI
+@cindex ISA
+
+ABI (Application Binary Interface) refers to the calling conventions between
+functions, meaning what registers are used and what sizes the various C data
+types are.  ISA (Instruction Set Architecture) refers to the instructions and
+registers a CPU has available.
+
+Some 64-bit ISA CPUs have both a 64-bit ABI and a 32-bit ABI defined, the
+latter for compatibility with older CPUs in the family.  GMP chooses the best
+ABI available for a given target system, and this generally gives
+significantly greater speed.
+
+The burden is on application programs and cooperating libraries to ensure they
+match the ABI chosen by GMP.  Fortunately this presents a difficulty only on a
+few systems, and if you have one of them then the performance gains are enough
+to make it worth the trouble.
+
+Some of what's described in this section may change in future releases of GMP.
+
+@table @asis
+@need 1000
+@item HPPA 2.0
+
+CPU target @samp{hppa2.0} uses the hppa2.0n 32-bit ABI, but either a 32-bit or
+64-bit limb.
+
+A 64-bit limb is available on HP-UX 10 or up when using @command{c89}.  No
+@command{gcc} support is planned for 64-bit operations in this ABI.
+Applications must be compiled with the same options as GMP, which means
+
+@example
+c89  +DA2.0 +e -D_LONG_LONG_LIMB
+@end example
+
+A 32-bit limb is used in other cases, and no special compiler options are
+needed.
+
+CPU target @samp{hppa2.0w} uses the hppa2.0w 64-bit ABI, which is available on
+HP-UX 11 or up when using @command{c89}.  @command{gcc} support for this is in
+progress.  Applications must be compiled for the same ABI, which means
+
+@example
+c89  +DD64
+@end example
+
+@need 1000
+@item MIPS 3 and 4 under IRIX 6
+
+Targets @samp{mips*-*-irix6*} use the n32 ABI and a 64-bit limb.  Applications
+must be compiled for the same ABI, which means either
+
+@example
+gcc  -mabi=n32
+cc   -n32
+@end example
+
+@need 1000
+@item PowerPC 64
+
+CPU target @samp{powerpc64} uses either the 32-bit ABI or the AIX 64-bit ABI.
+The latter is used on targets @samp{powerpc64-*-aix*} and applications must be
+compiled using either
+
+@example
+gcc  -maix64
+xlc  -q64
+@end example
+
+On other systems the 32-bit ABI is used, but with 64-bit limbs provided by
+@code{long long} in @command{gcc}.  Applications must be compiled using
+
+@example
+gcc  -D_LONG_LONG_LIMB
+@end example
+
+@need 1000
+@item Sparc V9
+
+On a sparc v9 CPU, either the v8plus 32-bit ABI or v9 64-bit ABI is used.
+Targets @samp{ultrasparc*-*-solaris2.[7-9]}, @samp{sparcv9-*-solaris2.[7-9]}
+and @samp{sparc64-*-linux*} use the v9 ABI, if the compiler supports it.
+Other targets use the v8plus ABI (but with as much of the v9 ISA as possible
+in the circumstances).  Note that Solaris prior to 2.7 doesn't save all
+registers properly, and hence uses the v8plus ABI.
+
+For the v8plus ABI, applications can be compiled with either
+
+@example
+gcc  -mv8plus
+cc   -xarch=v8plus
+@end example
+
+For the v9 ABI, applications must be compiled with either
+
+@example
+gcc  -m64 -mptr64 -Wa,-xarch=v9 -mcpu=v9
+cc   -xarch=v9
+@end example
+
+Don't be confused by the names of these options, they're called @samp{arch}
+but they effectively control the ABI.
+@end table
+
+
+@need 2000
+@node Notes for Package Builds, Notes for Particular Systems, ABI and ISA, Installing GMP
+@section Notes for Package Builds
+@cindex Build notes for binary packaging
+@cindex Packaged builds
+
+GMP should present no great difficulties for packaging in a binary
+distribution.
+
+@cindex Libtool versioning
+Libtool is used to build the library and @samp{-version-info} is set
+appropriately, having started from @samp{3:0:0} in GMP 3.0.  The GMP 3 series
+will be upwardly binary compatible in each release, but may be adding
+additional function interfaces.  On systems where libtool versioning is not
+fully checked by the loader, an auxiliary mechanism may be needed to express
+that a dynamic linked application depends on a new enough minor version of
+GMP.
+
+When building a package for a CPU family, care should be taken to use
+@samp{--target} to choose the least common denominator among the CPUs which
+might use the package.  For example this might necessitate @samp{i386} for
+x86s, or plain @samp{sparc} (meaning V7) for SPARCs.
+
+Users who care about speed will want GMP built for their exact CPU type, to
+make use of the available optimizations.  Providing a way to suitably rebuild
+a package may be useful.  This could be as simple as making it possible for a
+user to omit @samp{--target} in a build so @samp{./config.guess} will detect
+the CPU.  But a way to manually specify a @samp{--target} will be wanted for
+systems where @samp{./config.guess} is inexact.
+
+
+@need 2000
+@node Notes for Particular Systems, Known Build Problems, Notes for Package Builds, Installing GMP
+@section Notes for Particular Systems
+@cindex Build notes for particular systems
+@table @asis
+
+@c This section is more or less meant for notes about performance or about
+@c build problems that have been worked around but might leave a user
+@c scratching their head.  Fun with different ABIs on a system belongs in the
+@c above section.
+
+@item AIX 4.3
+
+Targets @samp{*-*-aix4.[3-9]*} have shared libraries disabled since they seem
+to fail on AIX 4.3.
+
+@item OpenBSD 2.6
+
+@command{m4} in this release of OpenBSD has a bug in @code{eval} that makes it
+unsuitable for @file{.asm} file processing.  @samp{./configure} will detect
+the problem and either abort or choose another m4 in the @env{PATH}.  The bug
+is fixed in OpenBSD 2.7, so either upgrade or use GNU m4.
+
+@item Sparc V8
+
+Using CPU target @samp{sparcv8} or @samp{supersparc} on relevant systems will
+give a significant performance increase over the V7 code.
+
+@item SunOS 4
+
+@command{/usr/bin/m4} lacks various features needed to process @file{.asm}
+files, and instead @samp{./configure} will automatically use
+@command{/usr/5bin/m4}, which we believe is always available (if not then use
+GNU m4).
+
+@item x86 Pentium and PentiumPro
+
+The Intel Pentium P5 code is good for its intended P5, but quite slow when run
+on Intel P6 class chips (PPro, P-II, P-III)@.  @samp{i386} is a better choice
+if you're making binaries that must run on both.
+
+@item x86 MMX and old GAS
+
+Old versions of GAS don't support MMX instructions, in particular version
+1.92.3 that comes with FreeBSD 2.2.8 doesn't (and unfortunately there's no
+newer assembler for that system).
+
+If the target CPU has MMX code but the assembler doesn't support it, a warning
+is given and non-MMX code is used instead.  This will be an inferior build,
+since the MMX code that's present is there because it's faster than the
+corresponding plain integer code.
+
+@item x86 GCC 2.95.2 @samp{-march=pentiumpro}
+
+GCC 2.95.2 miscompiles @file{mpz/powm.c} when @samp{-march=pentiumpro} is
+used, so that option is omitted from the @env{CFLAGS} chosen for relevant
+CPUs.  The problem is believed to be fixed in GCC 2.96.
+@end table
+
+
+@need 2000
+@node Known Build Problems,  , Notes for Particular Systems, Installing GMP
+@section Known Build Problems
+@cindex Build problems known
+
+@c This section is more or less meant for known build problems that are not
+@c otherwise worked around and require some sort of manual intervention.
+
+You might find more up-to-date information at @uref{http://www.swox.com/gmp/}.
+
+@table @asis
+
+@item Generic C on a 64-bit system
+
+When making a generic C build using @samp{--target=none} on a 64-bit system
+(meaning where @code{unsigned long} is 64 bits), @code{BITS_PER_MP_LIMB},
+@code{BITS_PER_LONGINT} and @code{BYTES_PER_MP_LIMB} in
+@file{mpn/generic/gmp-mparam.h} need to be changed to 64 and 8.  This will
+hopefully be automated in a future version of GMP.
+
+@item NeXT prior to 3.3
+
+The system compiler on old versions of NeXT was a massacred and old GCC, even
+if it called itself @file{cc}.  This compiler cannot be used to build GMP, you
+need to get a real GCC, and install that before you compile GMP.  (NeXT may
+have fixed this in release 3.3 of their system.)
+
+@item POWER and PowerPC
+
+Bugs in GCC 2.7.2 (and 2.6.3) mean it can't be used to compile GMP on POWER or
+PowerPC.  If you want to use GCC for these machines, get GCC 2.7.2.1 (or
+later).
+
+@item Sequent Symmetry
+
+Use the GNU assembler instead of the system assembler, since the latter has
+serious bugs.
+
+@item Stripped Libraries
+@cindex Stripped libraries
+
+GNU binutils @samp{strip} should not be used on the static libraries
+@file{libgmp.a} and @file{libmp.a}, neither directly nor via @samp{make
+install-strip}.  It can be used on the shared libraries @file{libgmp.so} and
+@file{libmp.so} though.
+
+Currently (binutils 2.10.0), @samp{strip} extracts archives into a single
+directory, but GMP contains multiple object files of the same name (eg. three
+versions of @file{init.o}), and they overwrite each other, leaving only the
+one that happens to be last.
+
+If stripped static libraries are wanted, the suggested workaround is to build
+normally, strip the separate object files, and do another @samp{make all} to
+rebuild.  Alternately @samp{CFLAGS} with @samp{-g} omitted can always be used
+if it's just debugging which is unwanted.
+
+@item SunOS 4 Native Tools
+
+The setting for @code{GSYM_PREFIX} in @file{config.m4} may be incorrectly
+determined when using the native @command{grep}, leading at link-time to
+undefined symbols like @code{___gmpn_add_n}.  To fix this, after running
+@samp{./configure}, change the relevant line in @file{config.m4} to
+@samp{define(<GSYM_PREFIX>, <_>)}.
+
+The @command{ranlib} command will need to be run manually when building a
+static library with the native @command{ar}.  After @samp{make}, run
+@samp{ranlib .libs/libgmp.a}, and when using @option{--enable-mpbsd} run
+@samp{ranlib .libs/libmp.a} too.
+
+@item VAX running Ultrix
+
+You need to build and install the GNU assembler before you compile GMP.  The VAX
+assembly in GMP uses an instruction (@code{jsobgtr}) that cannot be assembled by
+the Ultrix assembler.
+@end table
+
+
+
+@node GMP Basics, Reporting Bugs, Installing GMP, Top
+@comment  node-name,  next,  previous,  up
+@chapter GMP Basics
+@cindex Basics
+
+@cindex @file{gmp.h}
+All declarations needed to use GMP are collected in the include file
+@file{gmp.h}.  It is designed to work with both C and C++ compilers.
+
+@strong{Using functions, macros, data types, etc.@: not documented in this
+manual is strongly discouraged.  If you do so your application is guaranteed
+to be incompatible with future versions of GMP.}
+
+@menu
+* Nomenclature and Types::      	Which data types are there?
+* Function Classes::            	How the functions are organized.
+* GMP Variable Conventions::     	Some rules and hints about variables.
+* GMP and Reentrancy::           	What about reentrancy?
+* Useful Macros and Constants::  	Convenient helpers.
+* Compatibility with older versions::	Compatibility issues.
+* Getting the Latest Version of GMP::  	How to get the software.
+@end menu
+
+@node Nomenclature and Types, Function Classes, GMP Basics, GMP Basics
+@section Nomenclature and Types
+@cindex Nomenclature
+@cindex Types
+
+@cindex Integer
+@tindex @code{mpz_t}
+@noindent
+In this manual, @dfn{integer} usually means a multiple precision integer, as
+defined by the GMP library.  The C data type for such integers is @code{mpz_t}.
+Here are some examples of how to declare such integers:
+
+@example
+mpz_t sum;
+
+struct foo @{ mpz_t x, y; @};
+
+mpz_t vec[20];
+@end example
+
+@cindex Rational number
+@tindex @code{mpq_t}
+@noindent
+@dfn{Rational number} means a multiple precision fraction.  The C data type
+for these fractions is @code{mpq_t}.  For example:
+
+@example
+mpq_t quotient;
+@end example
+
+@cindex Floating-point number
+@tindex @code{mpf_t}
+@noindent
+@dfn{Floating point number} or @dfn{Float} for short, is an arbitrary precision
+mantissa with a limited precision exponent.  The C data type for such objects
+is @code{mpf_t}.
+
+@cindex Limb
+@tindex @code{mp_limb_t}
+@noindent
+A @dfn{limb} means the part of a multi-precision number that fits in a single
+word.  (We chose this word because a limb of the human body is analogous to a
+digit, only larger, and containing several digits.)  Normally a limb contains
+32 or 64 bits.  The C data type for a limb is @code{mp_limb_t}.
+
+
+@node Function Classes, GMP Variable Conventions, Nomenclature and Types, GMP Basics
+@section Function Classes
+@cindex Function classes
+
+There are six classes of functions in the GMP library:
+
+@enumerate
+@item
+Functions for signed integer arithmetic, with names beginning with
+@code{mpz_}.  The associated type is @code{mpz_t}.  There are about 100
+functions in this class.
+
+@item
+Functions for rational number arithmetic, with names beginning with
+@code{mpq_}.  The associated type is @code{mpq_t}.  There are about 20
+functions in this class, but the functions in the previous class can be used
+for performing arithmetic on the numerator and denominator separately.
+
+@item
+Functions for floating-point arithmetic, with names beginning with
+@code{mpf_}.  The associated type is @code{mpf_t}.  There are about 50
+functions is this class.
+
+@item
+Functions compatible with Berkeley GMP, such as @code{itom}, @code{madd}, and
+@code{mult}.  The associated type is @code{MINT}.
+
+@item
+Fast low-level functions that operate on natural numbers.  These are used by
+the functions in the preceding groups, and you can also call them directly
+from very time-critical user programs.  These functions' names begin with
+@code{mpn_}.  There are about 30 (hard-to-use) functions in this class.
+
+The associated type is array of @code{mp_limb_t}.
+
+@item
+Miscellaneous functions.  Functions for setting up custom allocation and
+functions for generating random numbers.
+@end enumerate
+
+
+@node GMP Variable Conventions, GMP and Reentrancy, Function Classes, GMP Basics
+@section GMP Variable Conventions
+@cindex Variable conventions
+@cindex Parameter conventions
+@cindex Conventions for variables
+
+As a general rule, all GMP functions expect output arguments before input
+arguments.  This notation is based on an analogy with the assignment operator.
+(The BSD MP compatibility functions disobey this rule, having the output
+argument(s) last.)
+
+GMP lets you use the same variable for both input and output in one call.  For
+example, the main function for integer multiplication, @code{mpz_mul}, can be
+used to square @code{x} and put the result back in @code{x} with
+
+@example
+mpz_mul (x, x, x);
+@end example
+
+Before you can assign to a GMP variable, you need to initialize it by calling
+one of the special initialization functions.  When you're done with a
+variable, you need to clear it out, using one of the functions for that
+purpose.  Which function to use depends on the type of variable.  See the
+chapters on integer functions, rational number functions, and floating-point
+functions for details.
+
+A variable should only be initialized once, or at least cleared out between
+each initialization.  After a variable has been initialized, it may be
+assigned to any number of times.
+
+For efficiency reasons, avoid initializing and clearing out a GMP variable in
+a loop.  Instead, initialize it before entering the loop, and clear it out
+after the loop has exited.
+
+GMP variables are small, containing only a couple of sizes, and pointers to
+allocated data.  Once you have initialized a GMP variable, you don't need to
+worry about space allocation.  All functions in GMP automatically allocate
+additional space when a variable does not already have enough.  They do not,
+however, reduce the space when a smaller value is stored.  Most of the time
+this policy is best, since it avoids frequent re-allocation.
+
+When a variable of type @code{mpz_t} is used as a function parameter, it's
+effectively a call-by-reference, meaning anything the function does to it will
+be be done to the original in the caller.  When a function is going to return
+an @code{mpz_t} result, it should provide a separate parameter or parameters
+that it sets, like the GMP library functions do.  A @code{return} of an
+@code{mpz_t} doesn't return the object, only a pointer to it, and this is
+almost certainly not what you want.  All this applies to @code{mpq_t} and
+@code{mpf_t} too.
+
+Here's an example function accepting an @code{mpz_t} parameter, doing a
+certain calculation, and returning a result.
+
+@example
+void
+myfunction (mpz_t result, mpz_t param, unsigned long n)
+@{
+  unsigned long  i;
+  
+  mpz_mul_ui (result, param, n);
+  for (i = 1; i < n; i++)
+    mpz_add_ui (result, result, i*7);
+@}
+
+int
+main (void)
+@{
+  mpz_t  r, n;
+  mpz_init (r);
+  mpz_init_set_str (n, "123456", 0);
+
+  myfunction (r, n, 20L);
+  mpz_out_str (stdout, 10, r); printf ("\n");
+
+  return 0;
+@}
+@end example
+
+This example will work if @code{result} and @code{param} are the same
+variable, just like the library functions.  But sometimes this is tricky to
+arrange, and an application might not want to bother for its own subroutines.
+
+@code{mpz_t} is actually implemented as a one-element array of a certain
+structure type.  This is why using it to declare a variable gives an object
+with the fields GMP needs, but then using it as a parameter passes a pointer
+to the object.  Note that the actual contents of an @code{mpz_t} are for
+internal use only and you should not access them directly if you want your
+code to be compatible with future GMP releases.
+
+
+@node GMP and Reentrancy, Useful Macros and Constants, GMP Variable Conventions, GMP Basics
+@section GMP and Reentrancy
+@cindex Reentrancy
+@cindex Thread safety
+@cindex Multi-threading
+
+The GMP code is reentrant and thread-safe, with some exceptions:
+
+@itemize @bullet
+@item
+The function @code{mpf_set_default_prec} saves the selected precision in
+a global variable.
+
+@item
+The function @code{mp_set_memory_functions} uses several global
+variables for storing the selected memory allocation functions.
+
+@item
+If the memory allocation functions set by a call to
+@code{mp_set_memory_functions} (or @code{malloc} and friends by default) are
+not reentrant, GMP will not be reentrant either.
+
+@item
+The old random number functions (@code{mpz_random}, etc) use a random number
+generator from the C library, usually @code{mrand48} or @code{random}.  These
+routines are not reentrant, since they rely on global state.
+(However the newer random number functions that accept a
+@code{gmp_randstate_t} parameter are reentrant.)
+@end itemize
+
+
+@need 2000
+@node Useful Macros and Constants, Compatibility with older versions, GMP and Reentrancy, GMP Basics
+@section Useful Macros and Constants
+@cindex Useful macros and constants
+@cindex Constants
+
+@deftypevr {Global Constant} {const int} mp_bits_per_limb
+@cindex Bits per limb
+@cindex Limb size
+The number of bits per limb.
+@end deftypevr
+
+@defmac __GNU_MP_VERSION
+@defmacx __GNU_MP_VERSION_MINOR
+@defmacx __GNU_MP_VERSION_PATCHLEVEL
+@cindex Version number
+@cindex GMP version number
+The major and minor GMP version, and patch level, respectively, as integers.
+For GMP i.j, these numbers will be i, j, and 0, respectively.
+For GMP i.j.k, these numbers will be i, j, and k, respectively.
+@end defmac
+
+
+@node Compatibility with older versions, Getting the Latest Version of GMP, Useful Macros and Constants, GMP Basics
+@section Compatibility with older versions
+@cindex Compatibility with older versions
+@cindex Upward compatibility
+
+This version of GMP is upwardly binary compatible with versions 3.0 and 3.0.1,
+and upwardly compatible at the source level with versions 2.0, 2.0.1, and
+2.0.2, with the following exceptions.
+
+@itemize @bullet
+@item
+@code{mpn_gcd} had its source arguments swapped as of GMP 3.0 for consistency
+with other @code{mpn} functions.
+
+@item
+@code{mpf_get_prec} counted precision slightly differently in GMP 3.0 and
+3.0.1, but in 3.1 has reverted to the 2.0.x style.
+
+@end itemize
+
+There are a number of compatibility issues between GMP 1 and GMP 2 that of
+course also apply when porting applications from GMP 1 to GMP 3.  Please
+see the GMP 2 manual for details.
+
+@c @enumerate
+@c @item Integer division functions round the result differently.  The obsolete
+@c functions (@code{mpz_div}, @code{mpz_divmod}, @code{mpz_mdiv},
+@c @code{mpz_mdivmod}, etc) now all use floor rounding (i.e., they round the
+@c quotient towards
+@c @ifinfo
+@c @minus{}infinity).
+@c @end ifinfo
+@c @iftex
+@c @tex
+@c $-\infty$).
+@c @end tex
+@c @end iftex
+@c There are a lot of functions for integer division, giving the user better
+@c control over the rounding.
+
+@c @item The function @code{mpz_mod} now compute the true @strong{mod} function.
+
+@c @item The functions @code{mpz_powm} and @code{mpz_powm_ui} now use
+@c @strong{mod} for reduction.
+
+@c @item The assignment functions for rational numbers do no longer canonicalize
+@c their results.  In the case a non-canonical result could arise from an
+@c assignment, the user need to insert an explicit call to
+@c @code{mpq_canonicalize}.  This change was made for efficiency.
+
+@c @item Output generated by @code{mpz_out_raw} in this release cannot be read
+@c by @code{mpz_inp_raw} in previous releases.  This change was made for making
+@c the file format truly portable between machines with different word sizes.
+
+@c @item Several @code{mpn} functions have changed.  But they were intentionally
+@c undocumented in previous releases.
+
+@c @item The functions @code{mpz_cmp_ui}, @code{mpz_cmp_si}, and @code{mpq_cmp_ui}
+@c are now implemented as macros, and thereby sometimes evaluate their
+@c arguments multiple times.
+
+@c @item The functions @code{mpz_pow_ui} and @code{mpz_ui_pow_ui} now yield 1
+@c for 0^0.  (In version 1, they yielded 0.)
+
+@c @end enumerate
+
+
+@node  Getting the Latest Version of GMP,  , Compatibility with older versions, GMP Basics
+@section Getting the Latest Version of GMP
+@cindex Latest version of GMP
+@cindex Anonymous FTP of latest version
+@cindex FTP of latest version
+
+The latest version of the GMP library is available at
+@uref{ftp://ftp.gnu.org/pub/gnu/gmp}.  Many sites around the world mirror
+@samp{ftp.gnu.org}; please use a mirror site near you, see
+@uref{http://www.gnu.org/order/ftp.html}.
+
+
+@node Reporting Bugs, Integer Functions, GMP Basics, Top
+@comment  node-name,  next,  previous,  up
+@chapter Reporting Bugs
+@cindex Reporting bugs
+@cindex Bug reporting
+
+If you think you have found a bug in the GMP library, please investigate it
+and report it.  We have made this library available to you, and it is not too
+much to ask you to report the bugs you find.  Before you report a bug, you may
+want to check @uref{http://www.swox.com/gmp/} for patches for this release.
+
+Please include the following in any report,
+
+@itemize @bullet
+@item
+The GMP version number, and if pre-packaged or patched then say so.
+
+@item
+A test program that makes it possible for us to reproduce the bug.  Include
+instructions on how to run the program.
+
+@item
+A description of what is wrong.  If the results are incorrect, in what way.
+If you get a crash, say so.
+
+@item
+If you get a crash, include a stack backtrace from the debugger if it's
+informative (@samp{where} in @command{gdb}, or @samp{$C} in @command{adb}).
+
+@item
+@strong{Please do not send core dumps, executables or @command{strace}s.}
+
+@item
+The configuration options you used when building GMP, if any.
+
+@item
+The name of the compiler and its version.  For @command{gcc}, get the version
+with @samp{gcc -v}, otherwise perhaps @samp{what `which cc`}, or similar.
+
+@item
+The output from running @samp{uname -a}.
+
+@item
+The output from running @samp{./config.guess}.
+
+@item
+If the bug is related to @samp{configure}, then the contents of
+@file{config.log}.
+
+@item
+If the bug is related to an @file{asm} file not assembling, then the contents
+of @file{config.m4}.
+@end itemize
+
+It is not uncommon that an observed problem is actually due to a bug in the
+compiler; the GMP code tends to explore interesting corners in compilers.
+
+If your bug report is good, we will do our best to help you get a corrected
+version of the library; if the bug report is poor, we won't do anything about
+it (except maybe ask you to send a better report).
+
+Send your report to: @email{bug-gmp@@gnu.org}.
+
+If you think something in this manual is unclear, or downright incorrect, or if
+the language needs to be improved, please send a note to the same address.
+
+
+@node Integer Functions, Rational Number Functions, Reporting Bugs, Top
+@comment  node-name,  next,  previous,  up
+@chapter Integer Functions
+@cindex Integer functions
+
+This chapter describes the GMP functions for performing integer arithmetic.
+These functions start with the prefix @code{mpz_}.
+
+GMP integers are stored in objects of type @code{mpz_t}.
+
+@menu
+* Initializing Integers::       
+* Assigning Integers::          
+* Simultaneous Integer Init & Assign::  
+* Converting Integers::         
+* Integer Arithmetic::          
+* Integer Division::            
+* Integer Exponentiation::      
+* Integer Roots::               
+* Number Theoretic Functions::  
+* Integer Comparisons::         
+* Integer Logic and Bit Fiddling::  
+* I/O of Integers::             
+* Integer Random Numbers::      
+* Miscellaneous Integer Functions::  
+@end menu
+
+@node Initializing Integers, Assigning Integers, Integer Functions, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Initialization Functions
+@cindex Integer initialization functions
+@cindex Initialization functions
+
+The functions for integer arithmetic assume that all integer objects are
+initialized.  You do that by calling the function @code{mpz_init}.
+
+@deftypefun void mpz_init (mpz_t @var{integer})
+Initialize @var{integer} with limb space and set the initial numeric value to
+0.  Each variable should normally only be initialized once, or at least cleared
+out (using @code{mpz_clear}) between each initialization.
+@end deftypefun
+
+Here is an example of using @code{mpz_init}:
+
+@example
+@{
+  mpz_t integ;
+  mpz_init (integ);
+  @dots{}
+  mpz_add (integ, @dots{});
+  @dots{}
+  mpz_sub (integ, @dots{});
+
+  /* Unless the program is about to exit, do ... */
+  mpz_clear (integ);
+@}
+@end example
+
+@noindent
+As you can see, you can store new values any number of times, once an
+object is initialized.
+
+@deftypefun void mpz_clear (mpz_t @var{integer})
+Free the limb space occupied by @var{integer}.  Make sure to call this
+function for all @code{mpz_t} variables when you are done with them.
+@end deftypefun
+
+@deftypefun {void *} _mpz_realloc (mpz_t @var{integer}, mp_size_t @var{new_alloc})
+Change the limb space allocation to @var{new_alloc} limbs.  This function is
+not normally called from user code, but it can be used to give memory back to
+the heap, or to increase the space of a variable to avoid repeated automatic
+re-allocation.
+@end deftypefun
+
+@deftypefun void mpz_array_init (mpz_t @var{integer_array}[], size_t @var{array_size}, mp_size_t @var{fixed_num_bits})
+Allocate @strong{fixed} limb space for all @var{array_size} integers in
+@var{integer_array}.  The fixed allocation for each integer in the array is
+enough to store @var{fixed_num_bits}.  If the fixed space will be insufficient
+for storing the result of a subsequent calculation, the result is
+unpredictable.
+
+This function is useful for decreasing the working set for some algorithms
+that use large integer arrays.
+
+There is no way to de-allocate the storage allocated by this function.
+Don't call @code{mpz_clear}!
+@end deftypefun
+
+
+@node Assigning Integers, Simultaneous Integer Init & Assign, Initializing Integers, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Assignment Functions
+@cindex Integer assignment functions
+@cindex Assignment functions
+
+These functions assign new values to already initialized integers
+(@pxref{Initializing Integers}).
+
+@deftypefun void mpz_set (mpz_t @var{rop}, mpz_t @var{op})
+@deftypefunx void mpz_set_ui (mpz_t @var{rop}, unsigned long int @var{op})
+@deftypefunx void mpz_set_si (mpz_t @var{rop}, signed long int @var{op})
+@deftypefunx void mpz_set_d (mpz_t @var{rop}, double @var{op})
+@deftypefunx void mpz_set_q (mpz_t @var{rop}, mpq_t @var{op})
+@deftypefunx void mpz_set_f (mpz_t @var{rop}, mpf_t @var{op})
+Set the value of @var{rop} from @var{op}.
+@end deftypefun
+
+@deftypefun int mpz_set_str (mpz_t @var{rop}, char *@var{str}, int @var{base})
+Set the value of @var{rop} from @var{str}, a '\0'-terminated C string in base
+@var{base}.  White space is allowed in the string, and is simply ignored.  The
+base may vary from 2 to 36.  If @var{base} is 0, the actual base is determined
+from the leading characters: if the first two characters are `0x' or `0X',
+hexadecimal is assumed, otherwise if the first character is `0', octal is
+assumed, otherwise decimal is assumed.
+
+This function returns 0 if the entire string up to the '\0' is a valid
+number in base @var{base}.  Otherwise it returns @minus{}1.
+
+[It turns out that it is not entirely true that this function ignores
+white-space.  It does ignore it between digits, but not after a minus sign
+or within or after "0x".  We are considering changing the definition of
+this function, making it fail when there is any white-space in the input,
+since that makes a lot of sense.  Please tell us your opinion about this
+change.  Do you really want it to accept "3 14" as meaning 314 as it does
+now?]
+@end deftypefun
+
+@deftypefun void mpz_swap (mpz_t @var{rop1}, mpz_t @var{rop2})
+Swap the values @var{rop1} and @var{rop2} efficiently.
+@end deftypefun
+
+
+@node Simultaneous Integer Init & Assign, Converting Integers, Assigning Integers, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Combined Initialization and Assignment Functions
+@cindex Initialization and assignment functions
+@cindex Integer init and assign
+
+For convenience, GMP provides a parallel series of initialize-and-set functions
+which initialize the output and then store the value there.  These functions'
+names have the form @code{mpz_init_set@dots{}}
+
+Here is an example of using one:
+
+@example
+@{
+  mpz_t pie;
+  mpz_init_set_str (pie, "3141592653589793238462643383279502884", 10);
+  @dots{}
+  mpz_sub (pie, @dots{});
+  @dots{}
+  mpz_clear (pie);
+@}
+@end example
+
+@noindent
+Once the integer has been initialized by any of the @code{mpz_init_set@dots{}}
+functions, it can be used as the source or destination operand for the ordinary
+integer functions.  Don't use an initialize-and-set function on a variable
+already initialized!
+
+@deftypefun void mpz_init_set (mpz_t @var{rop}, mpz_t @var{op})
+@deftypefunx void mpz_init_set_ui (mpz_t @var{rop}, unsigned long int @var{op})
+@deftypefunx void mpz_init_set_si (mpz_t @var{rop}, signed long int @var{op})
+@deftypefunx void mpz_init_set_d (mpz_t @var{rop}, double @var{op})
+Initialize @var{rop} with limb space and set the initial numeric value from
+@var{op}.
+@end deftypefun
+
+@deftypefun int mpz_init_set_str (mpz_t @var{rop}, char *@var{str}, int @var{base})
+Initialize @var{rop} and set its value like @code{mpz_set_str} (see its
+documentation above for details).
+
+If the string is a correct base @var{base} number, the function returns 0;
+if an error occurs it returns @minus{}1.  @var{rop} is initialized even if
+an error occurs.  (I.e., you have to call @code{mpz_clear} for it.)
+@end deftypefun
+
+
+@node Converting Integers, Integer Arithmetic, Simultaneous Integer Init & Assign, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Conversion Functions
+@cindex Integer conversion functions
+@cindex Conversion functions
+
+This section describes functions for converting GMP integers to standard C
+types.  Functions for converting @emph{to} GMP integers are described in
+@ref{Assigning Integers} and @ref{I/O of Integers}.
+
+@deftypefun mp_limb_t mpz_getlimbn (mpz_t @var{op}, mp_size_t @var{n})
+Return limb #@var{n} from @var{op}.  This function allows for very efficient
+decomposition of a number in its limbs.
+
+The function @code{mpz_size} can be used to determine the useful range for
+@var{n}.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_get_ui (mpz_t @var{op})
+Return the least significant part from @var{op}.  This function combined with
+@* @code{mpz_tdiv_q_2exp(@dots{}, @var{op}, CHAR_BIT*sizeof(unsigned long
+int))} can be used to decompose an integer into unsigned longs.
+@end deftypefun
+
+@deftypefun {signed long int} mpz_get_si (mpz_t @var{op})
+If @var{op} fits into a @code{signed long int} return the value of @var{op}.
+Otherwise return the least significant part of @var{op}, with the same sign
+as @var{op}.
+
+If @var{op} is too large to fit in a @code{signed long int}, the returned
+result is probably not very useful.  To find out if the value will fit, use
+the function @code{mpz_fits_slong_p}.
+@end deftypefun
+
+@deftypefun double mpz_get_d (mpz_t @var{op})
+Convert @var{op} to a double.
+@end deftypefun
+
+@deftypefun {char *} mpz_get_str (char *@var{str}, int @var{base}, mpz_t @var{op})
+Convert @var{op} to a string of digits in base @var{base}.  The base may vary
+from 2 to 36.
+
+If @var{str} is @code{NULL}, space for the result string is allocated using the
+default allocation function.
+
+If @var{str} is not @code{NULL}, it should point to a block of storage enough large
+for the result.  To find out the right amount of space to provide for
+@var{str}, use @code{mpz_sizeinbase (@var{op}, @var{base}) + 2}.  The two
+extra bytes are for a possible minus sign, and for the terminating null
+character.
+
+A pointer to the result string is returned.  This pointer will will either
+equal @var{str}, or if that is @code{NULL}, will point to the allocated storage.
+@end deftypefun
+
+
+@need 2000
+@node Integer Arithmetic, Integer Division, Converting Integers, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Arithmetic Functions
+@cindex Integer arithmetic functions
+@cindex Arithmetic functions
+
+@deftypefun void mpz_add (mpz_t @var{rop}, mpz_t @var{op1}, mpz_t @var{op2})
+@deftypefunx void mpz_add_ui (mpz_t @var{rop}, mpz_t @var{op1}, unsigned long int @var{op2})
+@ifnottex
+Set @var{rop} to @var{op1} + @var{op2}.
+@end ifnottex
+@tex
+Set @var{rop} to $@var{op1} + @var{op2}$.
+@end tex
+@end deftypefun
+
+@deftypefun void mpz_sub (mpz_t @var{rop}, mpz_t @var{op1}, mpz_t @var{op2})
+@deftypefunx void mpz_sub_ui (mpz_t @var{rop}, mpz_t @var{op1}, unsigned long int @var{op2})
+Set @var{rop} to @var{op1} @minus{} @var{op2}.
+@end deftypefun
+
+@deftypefun void mpz_mul (mpz_t @var{rop}, mpz_t @var{op1}, mpz_t @var{op2})
+@deftypefunx void mpz_mul_si (mpz_t @var{rop}, mpz_t @var{op1}, long int @var{op2})
+@deftypefunx void mpz_mul_ui (mpz_t @var{rop}, mpz_t @var{op1}, unsigned long int @var{op2})
+@ifnottex
+Set @var{rop} to @var{op1} times @var{op2}.
+@end ifnottex
+@tex
+Set @var{rop} to $@var{op1} \times @var{op2}$.
+@end tex
+@end deftypefun
+
+@deftypefun void mpz_addmul_ui (mpz_t @var{rop}, mpz_t @var{op1}, unsigned long int @var{op2})
+@ifnottex
+Add @var{op1} times @var{op2} to @var{rop}.
+@end ifnottex
+@tex
+Set @var{rop} to $@var{rop} + @var{op1} \times @var{op2}$.
+@end tex
+@end deftypefun
+
+@deftypefun void mpz_mul_2exp (mpz_t @var{rop}, mpz_t @var{op1}, unsigned long int @var{op2})
+@cindex Bit shift left
+@ifnottex
+Set @var{rop} to @var{op1} times 2 raised to @var{op2}.  This operation can
+also be defined as a left shift, @var{op2} steps.
+@end ifnottex
+@tex
+Set @var{rop} to $@var{op1} \times 2^{op2}$.  This operation can also be
+defined as a left shift, @var{op2} steps.
+@end tex
+@end deftypefun
+
+@deftypefun void mpz_neg (mpz_t @var{rop}, mpz_t @var{op})
+Set @var{rop} to @minus{}@var{op}.
+@end deftypefun
+
+@deftypefun void mpz_abs (mpz_t @var{rop}, mpz_t @var{op})
+Set @var{rop} to the absolute value of @var{op}.
+@end deftypefun
+
+
+@need 2000
+@node Integer Division, Integer Exponentiation, Integer Arithmetic, Integer Functions
+@section Division Functions
+@cindex Integer division functions
+@cindex Division functions
+
+Division is undefined if the divisor is zero, and passing a zero divisor to the
+divide or modulo functions, as well passing a zero mod argument to the
+@code{mpz_powm} and @code{mpz_powm_ui} functions, will make these functions
+intentionally divide by zero.  This lets the user handle arithmetic exceptions
+in these functions in the same manner as other arithmetic exceptions.
+
+There are three main groups of division functions:
+@itemize @bullet
+@item
+Functions that truncate the quotient towards 0.  The names of these functions
+start with @code{mpz_tdiv}.  The @samp{t} in the name is short for
+@samp{truncate}.
+@item
+Functions that round the quotient towards
+@ifnottex
+@minus{}infinity).
+@end ifnottex
+@tex
+$-\infty$
+@end tex
+The names of these routines start with @code{mpz_fdiv}.  The @samp{f} in the
+name is short for @samp{floor}.
+@item
+Functions that round the quotient towards
+@ifnottex
++infinity.
+@end ifnottex
+@tex
+$+\infty$
+@end tex
+The names of these routines start with @code{mpz_cdiv}.  The @samp{c} in the
+name is short for @samp{ceil}.
+@end itemize
+
+For each rounding mode, there are a couple of variants.  Here @samp{q} means
+that the quotient is computed, while @samp{r} means that the remainder is
+computed.  Functions that compute both the quotient and remainder have
+@samp{qr} in the name.
+
+@deftypefun void mpz_tdiv_q (mpz_t @var{q}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_tdiv_q_ui (mpz_t @var{q}, mpz_t @var{n}, unsigned long int @var{d})
+Set @var{q} to [@var{n}/@var{d}], truncated towards 0.
+
+The function @code{mpz_tdiv_q_ui} returns the absolute value of the true
+remainder.
+@end deftypefun
+
+@deftypefun void mpz_tdiv_r (mpz_t @var{r}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_tdiv_r_ui (mpz_t @var{r}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Set @var{r} to (@var{n} - [@var{n}/@var{d}] * @var{d}), where the quotient is
+truncated towards 0.  Unless @var{r} becomes zero, it will get the same sign as
+@var{n}.
+@end ifnottex
+@tex
+Set @var{r} to $(@var{n} - [@var{n}/@var{d}] \times @var{d})$, where the
+quotient is truncated towards 0.  Unless @var{r} becomes zero, it will get the
+same sign as @var{n}.
+@end tex
+
+The function @code{mpz_tdiv_r_ui} returns the absolute value of the remainder.
+@end deftypefun
+
+@deftypefun void mpz_tdiv_qr (mpz_t @var{q}, mpz_t @var{r}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_tdiv_qr_ui (mpz_t @var{q}, mpz_t @var{r}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Set @var{q} to [@var{n}/@var{d}], truncated towards 0.  Set @var{r} to (@var{n}
+- [@var{n}/@var{d}] * @var{d}).  Unless @var{r} becomes zero, it will get the
+same sign as @var{n}.  If @var{q} and @var{r} are the same variable, the
+results are undefined.
+@end ifnottex
+@tex
+Set @var{q} to [@var{n}/@var{d}], truncated towards 0.  Set @var{r} to $(@var{n}
+- [@var{n}/@var{d}] \times @var{d})$.  Unless @var{r} becomes zero, it will get the
+same sign as @var{n}.  If @var{q} and @var{r} are the same variable, the
+results are undefined.
+@end tex
+
+The function @code{mpz_tdiv_qr_ui} returns the absolute value of the remainder.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_tdiv_ui (mpz_t @var{n}, unsigned long int @var{d})
+Like @code{mpz_tdiv_r_ui}, but the remainder is not stored anywhere; its
+absolute value is just returned.
+@end deftypefun
+
+@deftypefun void mpz_fdiv_q (mpz_t @var{q}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_fdiv_q_ui (mpz_t @var{q}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Set @var{q} to @var{n}/@var{d}, rounded towards @minus{}infinity.
+@end ifnottex
+@tex
+Set @var{q} to $\lfloor@var{n}/@var{d}\rfloor$.
+@end tex
+
+The function @code{mpz_fdiv_q_ui} returns the remainder.
+@end deftypefun
+
+@deftypefun void mpz_fdiv_r (mpz_t @var{r}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_fdiv_r_ui (mpz_t @var{r}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Set @var{r} to (@var{n} - @var{n}/@var{d} * @var{d}), where the quotient is
+rounded towards @minus{}infinity.  Unless @var{r} becomes zero, it will get the
+same sign as @var{d}.
+@end ifnottex
+@tex
+Set @var{r} to $(@var{n} - \lfloor@var{n}/@var{d}\rfloor \times @var{d})$.
+Unless @var{r} becomes zero, it will get the same sign as @var{d}.
+@end tex
+
+The function @code{mpz_fdiv_r_ui} returns the remainder.
+@end deftypefun
+
+@deftypefun void mpz_fdiv_qr (mpz_t @var{q}, mpz_t @var{r}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_fdiv_qr_ui (mpz_t @var{q}, mpz_t @var{r}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Set @var{q} to @var{n}/@var{d}, rounded towards @minus{}infinity.  Set @var{r}
+to (@var{n} - @var{n}/@var{d} * @var{d}).  Unless @var{r} becomes zero, it
+will get the same sign as @var{d}.  If @var{q} and @var{r} are the same
+variable, the results are undefined.
+@end ifnottex
+@tex
+Set @var{q} to $\lfloor@var{n}/@var{d}\rfloor$.  Set @var{r} to $(@var{n} -
+\lfloor@var{n}/@var{d}\rfloor \times @var{d})$.  Unless @var{r} becomes zero,
+it will get the same sign as @var{d}.  If @var{q} and @var{r} are the same
+variable, the results are undefined.
+@end tex
+
+The function @code{mpz_fdiv_qr_ui} returns the remainder.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_fdiv_ui (mpz_t @var{n}, unsigned long int @var{d})
+Like @code{mpz_fdiv_r_ui}, but the remainder is not stored anywhere; it is just
+returned.
+@end deftypefun
+
+@deftypefun void mpz_cdiv_q (mpz_t @var{q}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_cdiv_q_ui (mpz_t @var{q}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Set @var{q} to @var{n}/@var{d}, rounded towards +infinity.
+@end ifnottex
+@tex
+Set @var{q} to $\lceil@var{n}/@var{d}\rceil$.
+@end tex
+
+The function @code{mpz_cdiv_q_ui} returns the negated remainder.
+@end deftypefun
+
+@deftypefun void mpz_cdiv_r (mpz_t @var{r}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_cdiv_r_ui (mpz_t @var{r}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Set @var{r} to (@var{n} - @var{n}/@var{d} * @var{d}), where the quotient is
+rounded towards +infinity.  Unless @var{r} becomes zero, it will get the
+opposite sign as @var{d}.
+@end ifnottex
+@tex
+Set @var{r} to $(@var{n} - \lceil@var{n}/@var{d}\rceil \times @var{d})$.  Unless
+@var{r} becomes zero, it will get the opposite sign as @var{d}.
+@end tex
+
+The function @code{mpz_cdiv_r_ui} returns the negated remainder.
+@end deftypefun
+
+@deftypefun void mpz_cdiv_qr (mpz_t @var{q}, mpz_t @var{r}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_cdiv_qr_ui (mpz_t @var{q}, mpz_t @var{r}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Set @var{q} to @var{n}/@var{d}, rounded towards +infinity.  Set @var{r}
+to (@var{n} - @var{n}/@var{d} * @var{d}).  Unless @var{r} becomes zero, it
+will get the opposite sign as @var{d}.  If @var{q} and @var{r} are the same
+variable, the results are undefined.
+@end ifnottex
+@tex
+Set @var{q} to $\lceil@var{n}/@var{d}\rceil$.  Set @var{r} to $(@var{n} -
+\lceil@var{n}/@var{d}\rceil \times @var{d})$.  Unless @var{r} becomes zero, it will
+get the opposite sign as @var{d}.  If @var{q} and @var{r} are the same
+variable, the results are undefined.
+@end tex
+
+The function @code{mpz_cdiv_qr_ui} returns the negated remainder.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_cdiv_ui (mpz_t @var{n}, unsigned long int @var{d})
+Like @code{mpz_tdiv_r_ui}, but the remainder is not stored anywhere; its
+negated value is just returned.
+@end deftypefun
+
+@deftypefun void mpz_mod (mpz_t @var{r}, mpz_t @var{n}, mpz_t @var{d})
+@deftypefunx {unsigned long int} mpz_mod_ui (mpz_t @var{r}, mpz_t @var{n}, unsigned long int @var{d})
+Set @var{r} to @var{n} @code{mod} @var{d}.  The sign of the divisor is ignored;
+the result is always non-negative.
+
+The function @code{mpz_mod_ui} returns the remainder.
+@end deftypefun
+
+@deftypefun void mpz_divexact (mpz_t @var{q}, mpz_t @var{n}, mpz_t @var{d})
+@cindex Exact division functions
+Set @var{q} to @var{n}/@var{d}.  This function produces correct results only
+when it is known in advance that @var{d} divides @var{n}.
+
+Since mpz_divexact is much faster than any of the other routines that produce
+the quotient (@pxref{References} Jebelean), it is the best choice for instances
+in which exact division is known to occur, such as reducing a rational to
+lowest terms.
+@end deftypefun
+
+@deftypefun void mpz_tdiv_q_2exp (mpz_t @var{q}, mpz_t @var{n}, unsigned long int @var{d})
+@cindex Bit shift right
+@ifnottex
+Set @var{q} to @var{n} divided by 2 raised to @var{d}.  The quotient is truncated
+towards 0.
+@end ifnottex
+@tex
+Set @var{q} to $[{n}/2^{d}]$, truncated towards 0.
+@end tex
+@end deftypefun
+
+@deftypefun void mpz_tdiv_r_2exp (mpz_t @var{r}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Divide @var{n} by (2 raised to @var{d}), rounding the quotient towards 0, and
+put the remainder in @var{r}.
+@end ifnottex
+@tex
+Set @var{r} to $n - [n / 2^{d}] \times 2^{d}$, where [ ] indicates rounding towards
+0.
+@end tex
+Unless it is zero, @var{r} will have the same sign as @var{n}.
+@end deftypefun
+
+@deftypefun void mpz_fdiv_q_2exp (mpz_t @var{q}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Set @var{q} to @var{n} divided by 2 raised to @var{d}, rounded towards
+@minus{}infinity.
+@end ifnottex
+@tex
+Set @var{q} to $\lfloor{n}/2^{d}\rfloor$.
+@end tex
+This operation can also be defined as arithmetic right shift @var{d} bit
+positions.
+@end deftypefun
+
+@deftypefun void mpz_fdiv_r_2exp (mpz_t @var{r}, mpz_t @var{n}, unsigned long int @var{d})
+@ifnottex
+Divide @var{n} by (2 raised to @var{d}), rounding the quotient towards
+@minus{}infinity, and put the remainder in @var{r}.
+@end ifnottex
+@tex
+Set @var{r} to $n - \lfloor{n}/2^{d}\rfloor \times 2^{d}$.
+@end tex
+The sign of @var{r} will always be positive.
+This operation can also be defined as masking of the @var{d} least significant
+bits.
+@end deftypefun
+
+
+@need 2000
+@node Integer Exponentiation, Integer Roots, Integer Division, Integer Functions
+@section Exponentiation Functions
+@cindex Integer exponentiation functions
+@cindex Exponentiation functions
+
+@deftypefun void mpz_powm (mpz_t @var{rop}, mpz_t @var{base}, mpz_t @var{exp}, mpz_t @var{mod})
+@deftypefunx void mpz_powm_ui (mpz_t @var{rop}, mpz_t @var{base}, unsigned long int @var{exp}, mpz_t @var{mod})
+@ifnottex
+Set @var{rop} to (@var{base} raised to @var{exp}) @code{mod} @var{mod}.  If
+@var{exp} is negative, the result is undefined.
+@end ifnottex
+@tex
+Set @var{rop} to $base^{exp} \bmod mod$.  If
+@var{exp} is negative, the result is undefined.
+@end tex
+
+@end deftypefun
+
+@deftypefun void mpz_pow_ui (mpz_t @var{rop}, mpz_t @var{base}, unsigned long int @var{exp})
+@deftypefunx void mpz_ui_pow_ui (mpz_t @var{rop}, unsigned long int @var{base}, unsigned long int @var{exp})
+@ifnottex
+Set @var{rop} to @var{base} raised to @var{exp}.  The case of 0^0 yields 1.
+@end ifnottex
+@tex
+Set @var{rop} to $base^{exp}$.  The case of $0^0$ yields 1.
+@end tex
+@end deftypefun
+
+
+@need 2000
+@node Integer Roots, Number Theoretic Functions, Integer Exponentiation, Integer Functions
+@section Root Extraction Functions
+@cindex Integer root functions
+@cindex Root extraction functions
+
+@deftypefun int mpz_root (mpz_t @var{rop}, mpz_t @var{op}, unsigned long int @var{n})
+@ifnottex
+Set @var{rop} to the truncated integer part of the @var{n}th root of @var{op}.
+@end ifnottex
+@tex
+Set @var{rop} to $\lfloor\root n \of {op}\rfloor$, the truncated integer
+part of the @var{n}th root of @var{op}.
+@end tex
+Return non-zero if the computation was exact, i.e., if @var{op} is
+@var{rop} to the @var{n}th power.
+@end deftypefun
+
+@deftypefun void mpz_sqrt (mpz_t @var{rop}, mpz_t @var{op})
+@ifnottex
+Set @var{rop} to the truncated integer part of the square root of @var{op}.
+@end ifnottex
+@tex
+Set @var{rop} to $\lfloor\sqrt{@var{op}}\rfloor$, the truncated integer part of
+the square root of @var{op}.
+@end tex
+@end deftypefun
+
+@deftypefun void mpz_sqrtrem (mpz_t @var{rop1}, mpz_t @var{rop2}, mpz_t @var{op})
+@ifnottex
+Set @var{rop1} to the truncated integer part of the square root of @var{op},
+like @code{mpz_sqrt}.  Set @var{rop2} to
+@var{op}@minus{}@var{rop1}*@var{rop1},
+@end ifnottex
+@tex
+Set @var{rop1} to $\lfloor\sqrt{@var{op}}\rfloor$, like @code{mpz_sqrt}.
+Set @var{rop2} to $(@var{op} - @var{rop1}^2)$,
+@end tex
+(i.e., zero if @var{op} is a perfect square).
+
+If @var{rop1} and @var{rop2} are the same variable, the results are
+undefined.
+@end deftypefun
+
+@deftypefun int mpz_perfect_power_p (mpz_t @var{op})
+@ifnottex
+Return non-zero if @var{op} is a perfect power, i.e., if there exist integers
+@var{a} and @var{b}, with @var{b} > 1, such that @var{op} equals a raised to
+b.  Return zero otherwise.
+@end ifnottex
+@tex
+Return non-zero if @var{op} is a perfect power, i.e., if there exist integers
+$a$ and $b$, with $b>1$, such that $@var{op}=a^b$.  Return zero otherwise.
+@end tex
+@end deftypefun
+
+@deftypefun int mpz_perfect_square_p (mpz_t @var{op})
+Return non-zero if @var{op} is a perfect square, i.e., if the square root of
+@var{op} is an integer.  Return zero otherwise.
+@end deftypefun
+
+
+@need 2000
+@node Number Theoretic Functions, Integer Comparisons, Integer Roots, Integer Functions
+@section Number Theoretic Functions
+@cindex Number theoretic functions
+
+@deftypefun int mpz_probab_prime_p (mpz_t @var{n}, int @var{reps})
+@cindex Prime testing functions
+If this function returns 0, @var{n} is definitely not prime.  If it
+returns 1, then @var{n} is `probably' prime.  If it returns 2, then
+@var{n} is surely prime.  Reasonable values of reps vary from 5 to 10; a
+higher value lowers the probability for a non-prime to pass as a
+`probable' prime.
+
+The function uses Miller-Rabin's probabilistic test.
+@end deftypefun
+
+@deftypefun int mpz_nextprime (mpz_t @var{rop}, mpz_t @var{op})
+Set @var{rop} to the next prime greater than @var{op}.
+
+This function uses a probabilistic algorithm to identify primes, but for for
+practical purposes it's adequate, since the chance of a composite passing will
+be extremely small.
+@end deftypefun
+
+@c mpz_prime_p not implemented as of gmp 3.0.
+
+@c @deftypefun int mpz_prime_p (mpz_t @var{n})
+@c Return non-zero if @var{n} is prime and zero if @var{n} is a non-prime.
+@c This function is far slower than @code{mpz_probab_prime_p}, but then it
+@c never returns non-zero for composite numbers.
+
+@c (For practical purposes, using @code{mpz_probab_prime_p} is adequate.
+@c The likelihood of a programming error or hardware malfunction is orders
+@c of magnitudes greater than the likelihood for a composite to pass as a
+@c prime, if the @var{reps} argument is in the suggested range.)
+@c @end deftypefun
+
+@deftypefun void mpz_gcd (mpz_t @var{rop}, mpz_t @var{op1}, mpz_t @var{op2})
+@cindex Greatest common divisor functions
+Set @var{rop} to the greatest common divisor of @var{op1} and @var{op2}.
+The result is always positive even if either of or both input operands
+are negative.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_gcd_ui (mpz_t @var{rop}, mpz_t @var{op1}, unsigned long int @var{op2})
+Compute the greatest common divisor of @var{op1} and @var{op2}.  If
+@var{rop} is not @code{NULL}, store the result there.
+
+If the result is small enough to fit in an @code{unsigned long int}, it is
+returned.  If the result does not fit, 0 is returned, and the result is equal
+to the argument @var{op1}.  Note that the result will always fit if @var{op2}
+is non-zero.
+@end deftypefun
+
+@deftypefun void mpz_gcdext (mpz_t @var{g}, mpz_t @var{s}, mpz_t @var{t}, mpz_t @var{a}, mpz_t @var{b})
+@cindex Extended GCD
+Compute @var{g}, @var{s}, and @var{t}, such that @var{a}@var{s} +
+@var{b}@var{t} = @var{g} = @code{gcd}(@var{a}, @var{b}).  If @var{t} is
+@code{NULL}, that argument is not computed.
+@end deftypefun
+
+@deftypefun void mpz_lcm (mpz_t @var{rop}, mpz_t @var{op1}, mpz_t @var{op2})
+@cindex Least common multiple functions
+Set @var{rop} to the least common multiple of @var{op1} and @var{op2}.
+@end deftypefun
+
+@deftypefun int mpz_invert (mpz_t @var{rop}, mpz_t @var{op1}, mpz_t @var{op2})
+@cindex Modular inverse functions
+Compute the inverse of @var{op1} modulo @var{op2} and put the result in
+@var{rop}.  Return non-zero if an inverse exists, zero otherwise.  When the
+function returns zero, @var{rop} is undefined.
+@end deftypefun
+
+@deftypefun int mpz_jacobi (mpz_t @var{op1}, mpz_t @var{op2})
+@deftypefunx int mpz_legendre (mpz_t @var{op1}, mpz_t @var{op2})
+@cindex Jabobi symbol functions
+Compute the Jacobi and Legendre symbols, respectively.  @var{op2} should be
+odd and must be positive.
+@end deftypefun
+
+@deftypefun int mpz_si_kronecker (long @var{a}, mpz_t @var{b});
+@deftypefunx int mpz_ui_kronecker (unsigned long @var{a}, mpz_t @var{b});
+@deftypefunx int mpz_kronecker_si (mpz_t @var{a}, long @var{b});
+@deftypefunx int mpz_kronecker_ui (mpz_t @var{a}, unsigned long @var{b});
+@cindex Kronecker symbol functions
+@tex
+Calculate the value of the Kronecker/Jacobi symbol $\left(a \over b\right)$,
+with the Kronecker extension $\left(a \over 2\right) = \left(2 \over a\right)$
+when $a$ odd, or $\left(a \over 2\right) = 0$ when $a$ even.
+@end tex
+@ifnottex
+Calculate the value of the Kronecker/Jacobi symbol (@var{a}/@var{b}), with the
+Kronecker extension (a/2)=(2/a) when a odd, or (a/2)=0 when a even.
+@end ifnottex
+All values of @var{a} and @var{b} give a well-defined result.  See Henri
+Cohen, section 1.4.2, for more information (@pxref{References}).  See also the
+example program @file{demos/qcn.c} which uses @code{mpz_kronecker_ui}.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_remove (mpz_t @var{rop}, mpz_t @var{op}, mpz_t @var{f})
+Remove all occurrences of the factor @var{f} from @var{op} and store the
+result in @var{rop}.  Return the multiplicity of @var{f} in @var{op}.
+@end deftypefun
+
+@deftypefun void mpz_fac_ui (mpz_t @var{rop}, unsigned long int @var{op})
+@cindex Factorial functions
+Set @var{rop} to @var{op}!, the factorial of @var{op}.
+@end deftypefun
+
+@deftypefun void mpz_bin_ui (mpz_t @var{rop}, mpz_t @var{n}, unsigned long int @var{k})
+@deftypefunx void mpz_bin_uiui (mpz_t @var{rop}, unsigned long int @var{n}, @w{unsigned long int @var{k}})
+@cindex Binomial coefficient functions
+Compute the binomial coefficient
+@ifnottex
+@var{n} over @var{k}
+@end ifnottex
+@tex
+$\left({n}\atop{k}\right)$
+@end tex
+and store the result in @var{rop}.  Negative values of @var{n} are supported
+by @code{mpz_bin_ui}, using the identity
+@ifnottex
+bin(-n,k) = (-1)^k * bin(n+k-1,k)
+@end ifnottex
+@tex
+$\left({-n}\atop{k}\right) = (-1)^k \left({n+k-1}\atop{k}\right)$
+@end tex
+(see Knuth volume 1 section 1.2.6 part G).
+@end deftypefun
+
+@deftypefun void mpz_fib_ui (mpz_t @var{rop}, unsigned long int @var{n})
+@cindex Fibonacci sequence functions
+Compute the @var{n}th Fibonacci number and store the result in @var{rop}.
+@end deftypefun
+
+
+@node Integer Comparisons, Integer Logic and Bit Fiddling, Number Theoretic Functions, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Comparison Functions
+@cindex Integer comparison functions
+@cindex Comparison functions
+
+@deftypefun int mpz_cmp (mpz_t @var{op1}, mpz_t @var{op2})
+@ifnottex
+Compare @var{op1} and @var{op2}.  Return a positive value if @var{op1} >
+@var{op2}, zero if @var{op1} = @var{op2}, and a negative value if @var{op1} <
+@var{op2}.
+@end ifnottex
+@tex
+Compare @var{op1} and @var{op2}.  Return a positive value if $@var{op1} >
+@var{op2}$, zero if $@var{op1} = @var{op2}$, and a negative value if $@var{op1}
+< @var{op2}$.
+@end tex
+@end deftypefun
+
+@deftypefn Macro int mpz_cmp_ui (mpz_t @var{op1}, unsigned long int @var{op2})
+@deftypefnx Macro int mpz_cmp_si (mpz_t @var{op1}, signed long int @var{op2})
+@ifnottex
+Compare @var{op1} and @var{op2}.  Return a positive value if @var{op1} >
+@var{op2}, zero if @var{op1} = @var{op2}, and a negative value if @var{op1} <
+@var{op2}.
+@end ifnottex
+@tex
+Compare @var{op1} and @var{op2}.  Return a positive value if $@var{op1} >
+@var{op2}$, zero if $@var{op1} = @var{op2}$, and a negative value if $@var{op1}
+< @var{op2}$.
+@end tex
+
+These functions are actually implemented as macros.  They evaluate their
+arguments multiple times.
+@end deftypefn
+
+
+@deftypefun int mpz_cmpabs (mpz_t @var{op1}, mpz_t @var{op2})
+@deftypefunx int mpz_cmpabs_ui (mpz_t @var{op1}, unsigned long int @var{op2})
+@ifnottex
+Compare the absolute values of @var{op1} and @var{op2}.  Return a positive
+value if @var{op1} > @var{op2}, zero if @var{op1} = @var{op2}, and a negative
+value if @var{op1} < @var{op2}.
+@end ifnottex
+@tex
+Compare the absolute values of @var{op1} and @var{op2}.  Return a positive
+value if $|@var{op1}| > |@var{op2}|$, zero if $|@var{op1}| = |@var{op2}|$, and a
+negative value if $|@var{op1}| < |@var{op2}|$.
+@end tex
+@end deftypefun
+
+@deftypefn Macro int mpz_sgn (mpz_t @var{op})
+@ifnottex
+Return +1 if @var{op} > 0, 0 if @var{op} = 0, and @minus{}1 if @var{op} < 0.
+@end ifnottex
+@tex
+Return $+1$ if $@var{op} > 0$, 0 if $@var{op} = 0$, and $-1$ if $@var{op} < 0$.
+@end tex
+
+This function is actually implemented as a macro.  It evaluates its
+arguments multiple times.
+@end deftypefn
+
+@node Integer Logic and Bit Fiddling, I/O of Integers, Integer Comparisons, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Logical and Bit Manipulation Functions
+@cindex Logical functions
+@cindex Bit manipulation functions
+@cindex Integer bit manipulation functions
+
+These functions behave as if two's complement arithmetic were used (although
+sign-magnitude is used by the actual implementation).
+
+@deftypefun void mpz_and (mpz_t @var{rop}, mpz_t @var{op1}, mpz_t @var{op2})
+Set @var{rop} to @var{op1} logical-and @var{op2}.
+@end deftypefun
+
+@deftypefun void mpz_ior (mpz_t @var{rop}, mpz_t @var{op1}, mpz_t @var{op2})
+Set @var{rop} to @var{op1} inclusive-or @var{op2}.
+@end deftypefun
+
+@deftypefun void mpz_xor (mpz_t @var{rop}, mpz_t @var{op1}, mpz_t @var{op2})
+Set @var{rop} to @var{op1} exclusive-or @var{op2}.
+@end deftypefun
+
+@deftypefun void mpz_com (mpz_t @var{rop}, mpz_t @var{op})
+Set @var{rop} to the one's complement of @var{op}.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_popcount (mpz_t @var{op})
+For non-negative numbers, return the population count of @var{op}.  For
+negative numbers, return the largest possible value (@var{MAX_ULONG}).
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_hamdist (mpz_t @var{op1}, mpz_t @var{op2})
+If @var{op1} and @var{op2} are both non-negative, return the hamming distance
+between the two operands.  Otherwise, return the largest possible value
+(@var{MAX_ULONG}).
+
+It is possible to extend this function to return a useful value when the
+operands are both negative, but the current implementation returns
+@var{MAX_ULONG} in this case.  @strong{Do not depend on this behavior, since
+it will change in a future release.}
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_scan0 (mpz_t @var{op}, unsigned long int @var{starting_bit})
+Scan @var{op}, starting with bit @var{starting_bit}, towards more significant
+bits, until the first clear bit is found.  Return the index of the found bit.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpz_scan1 (mpz_t @var{op}, unsigned long int @var{starting_bit})
+Scan @var{op}, starting with bit @var{starting_bit}, towards more significant
+bits, until the first set bit is found.  Return the index of the found bit.
+@end deftypefun
+
+@deftypefun void mpz_setbit (mpz_t @var{rop}, unsigned long int @var{bit_index})
+Set bit @var{bit_index} in @var{rop}.
+@end deftypefun
+
+@deftypefun void mpz_clrbit (mpz_t @var{rop}, unsigned long int @var{bit_index})
+Clear bit @var{bit_index} in @var{rop}.
+@end deftypefun
+
+@deftypefun int mpz_tstbit (mpz_t @var{op}, unsigned long int @var{bit_index})
+Check bit @var{bit_index} in @var{op} and return 0 or 1 accordingly.
+@end deftypefun
+
+@node I/O of Integers, Integer Random Numbers, Integer Logic and Bit Fiddling, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Input and Output Functions
+@cindex Integer input and output functions
+@cindex Input functions
+@cindex Output functions
+@cindex I/O functions
+
+Functions that perform input from a stdio stream, and functions that output to
+a stdio stream.  Passing a @code{NULL} pointer for a @var{stream} argument to any of
+these functions will make them read from @code{stdin} and write to
+@code{stdout}, respectively.
+
+When using any of these functions, it is a good idea to include @file{stdio.h}
+before @file{gmp.h}, since that will allow @file{gmp.h} to define prototypes
+for these functions.
+
+@deftypefun size_t mpz_out_str (FILE *@var{stream}, int @var{base}, mpz_t @var{op})
+Output @var{op} on stdio stream @var{stream}, as a string of digits in base
+@var{base}.  The base may vary from 2 to 36.
+
+Return the number of bytes written, or if an error occurred, return 0.
+@end deftypefun
+
+@deftypefun size_t mpz_inp_str (mpz_t @var{rop}, FILE *@var{stream}, int @var{base})
+Input a possibly white-space preceded string in base @var{base} from stdio
+stream @var{stream}, and put the read integer in @var{rop}.  The base may vary
+from 2 to 36.  If @var{base} is 0, the actual base is determined from the
+leading characters: if the first two characters are `0x' or `0X', hexadecimal
+is assumed, otherwise if the first character is `0', octal is assumed,
+otherwise decimal is assumed.
+
+Return the number of bytes read, or if an error occurred, return 0.
+@end deftypefun
+
+@deftypefun size_t mpz_out_raw (FILE *@var{stream}, mpz_t @var{op})
+Output @var{op} on stdio stream @var{stream}, in raw binary format.  The
+integer is written in a portable format, with 4 bytes of size information, and
+that many bytes of limbs.  Both the size and the limbs are written in
+decreasing significance order (i.e., in big-endian).
+
+The output can be read with @code{mpz_inp_raw}.
+
+Return the number of bytes written, or if an error occurred, return 0.
+
+The output of this can not be read by @code{mpz_inp_raw} from GMP 1, because
+of changes necessary for compatibility between 32-bit and 64-bit machines.
+@end deftypefun
+
+@deftypefun size_t mpz_inp_raw (mpz_t @var{rop}, FILE *@var{stream})
+Input from stdio stream @var{stream} in the format written by
+@code{mpz_out_raw}, and put the result in @var{rop}.  Return the number of
+bytes read, or if an error occurred, return 0.
+
+This routine can read the output from @code{mpz_out_raw} also from GMP 1, in
+spite of changes necessary for compatibility between 32-bit and 64-bit
+machines.
+@end deftypefun
+
+
+@need 2000
+@node Integer Random Numbers, Miscellaneous Integer Functions, I/O of Integers, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Random Number Functions
+@cindex Integer random number functions
+@cindex Random number functions
+
+The random number functions of GMP come in two groups; older function
+that rely on a global state, and newer functions that accept a state
+parameter that is read and modified.  Please see the @ref{Random Number
+Functions} for more information on how to use and not to use random
+number functions.
+
+@deftypefun void mpz_urandomb (mpz_t @var{rop}, gmp_randstate_t @var{state},
+unsigned long int @var{n})
+Generate a uniformly distributed random integer in the range
+@ifnottex
+0 to 2^@var{n} @minus{} 1,
+@end ifnottex
+@tex
+0 to $2^n-1$,
+@end tex
+inclusive.
+
+The variable @var{state} must be initialized by calling one of the
+@code{gmp_randinit} functions (@ref{Random State Initialization}) before
+invoking this function.
+@end deftypefun
+
+@deftypefun void mpz_urandomm (mpz_t @var{rop}, gmp_randstate_t @var{state},
+mpz_t @var{n})
+Generate a uniform random integer in the range 0 to
+@ifnottex
+@var{n} @minus{} 1, inclusive.
+@end ifnottex
+@tex
+$n-1$, inclusive.
+@end tex
+
+The variable @var{state} must be initialized by calling one of the
+@code{gmp_randinit} functions (@ref{Random State Initialization})
+before invoking this function.
+@end deftypefun
+
+@deftypefun void mpz_rrandomb (mpz_t @var{rop}, gmp_randstate_t @var{state}, unsigned long int @var{n})
+Generate a random integer with long strings of zeros and ones in the
+binary representation.  Useful for testing functions and algorithms,
+since this kind of random numbers have proven to be more likely to
+trigger corner-case bugs.  The random number will be in the range
+@ifnottex
+0 to 2^@var{n} @minus{} 1,
+@end ifnottex
+@tex
+0 to $2^n-1$,
+@end tex
+inclusive.
+
+The variable @var{state} must be initialized by calling one of the
+@code{gmp_randinit} functions (@ref{Random State Initialization})
+before invoking this function.
+@end deftypefun
+
+@deftypefun void mpz_random (mpz_t @var{rop}, mp_size_t @var{max_size})
+Generate a random integer of at most @var{max_size} limbs.  The generated
+random number doesn't satisfy any particular requirements of randomness.
+Negative random numbers are generated when @var{max_size} is negative.
+
+This function is obsolete.  Use @code{mpz_urandomb} or
+@code{mpz_urandomm} instead.
+@end deftypefun
+
+@deftypefun void mpz_random2 (mpz_t @var{rop}, mp_size_t @var{max_size})
+Generate a random integer of at most @var{max_size} limbs, with long strings
+of zeros and ones in the binary representation.  Useful for testing functions
+and algorithms, since this kind of random numbers have proven to be more
+likely to trigger corner-case bugs.  Negative random numbers are generated
+when @var{max_size} is negative.
+
+This function is obsolete.  Use @code{mpz_rrandomb} instead.
+@end deftypefun
+
+
+@need 2000
+@node Miscellaneous Integer Functions,  , Integer Random Numbers, Integer Functions
+@comment  node-name,  next,  previous,  up
+@section Miscellaneous Functions
+@cindex Miscellaneous integer functions
+@cindex Integer miscellaneous functions
+
+@deftypefun int mpz_fits_ulong_p (mpz_t @var{op})
+@deftypefunx int mpz_fits_slong_p (mpz_t @var{op})
+@deftypefunx int mpz_fits_uint_p (mpz_t @var{op})
+@deftypefunx int mpz_fits_sint_p (mpz_t @var{op})
+@deftypefunx int mpz_fits_ushort_p (mpz_t @var{op})
+@deftypefunx int mpz_fits_sshort_p (mpz_t @var{op})
+Return non-zero iff the value of @var{op} fits in an @code{unsigned long int},
+@code{signed long int}, @code{unsigned int}, @code{signed int}, @code{unsigned
+short int}, or @code{signed short int}, respectively.  Otherwise, return zero.
+@end deftypefun
+
+@deftypefn Macro int mpz_odd_p (mpz_t @var{op})
+@deftypefnx Macro int mpz_even_p (mpz_t @var{op})
+Determine whether @var{op} is odd or even, respectively.  Return non-zero if
+yes, zero if no.  These macros evaluate their arguments more than once.
+@end deftypefn
+
+@deftypefun size_t mpz_size (mpz_t @var{op})
+Return the size of @var{op} measured in number of limbs.  If @var{op} is zero,
+the returned value will be zero.
+@c (@xref{Nomenclature}, for an explanation of the concept @dfn{limb}.)
+@end deftypefun
+
+@deftypefun size_t mpz_sizeinbase (mpz_t @var{op}, int @var{base})
+Return the size of @var{op} measured in number of digits in base @var{base}.
+The base may vary from 2 to 36.  The returned value will be exact or 1 too
+big.  If @var{base} is a power of 2, the returned value will always be exact.
+
+This function is useful in order to allocate the right amount of space before
+converting @var{op} to a string.  The right amount of allocation is normally
+two more than the value returned by @code{mpz_sizeinbase} (one extra for a
+minus sign and one for the terminating '\0').
+@end deftypefun
+
+
+@node Rational Number Functions, Floating-point Functions, Integer Functions, Top
+@comment  node-name,  next,  previous,  up
+@chapter Rational Number Functions
+@cindex Rational number functions
+
+This chapter describes the GMP functions for performing arithmetic on rational
+numbers.  These functions start with the prefix @code{mpq_}.
+
+Rational numbers are stored in objects of type @code{mpq_t}.
+
+All rational arithmetic functions assume operands have a canonical form, and
+canonicalize their result.  The canonical from means that the denominator and
+the numerator have no common factors, and that the denominator is positive.
+Zero has the unique representation 0/1.
+
+Pure assignment functions do not canonicalize the assigned variable.  It is
+the responsibility of the user to canonicalize the assigned variable before
+any arithmetic operations are performed on that variable.  @strong{Note that
+this is an incompatible change from version 1 of the library.}
+
+@deftypefun void mpq_canonicalize (mpq_t @var{op})
+Remove any factors that are common to the numerator and denominator of
+@var{op}, and make the denominator positive.
+@end deftypefun
+
+@menu
+* Initializing Rationals::      
+* Rational Arithmetic::         
+* Comparing Rationals::         
+* Applying Integer Functions::  
+* I/O of Rationals::            
+* Miscellaneous Rational Functions::  
+@end menu
+
+@node Initializing Rationals, Rational Arithmetic, Rational Number Functions, Rational Number Functions
+@comment  node-name,  next,  previous,  up
+@section Initialization and Assignment Functions
+@cindex Initialization and assignment functions
+@cindex Rational init and assign
+
+@deftypefun void mpq_init (mpq_t @var{dest_rational})
+Initialize @var{dest_rational} and set it to 0/1.  Each variable should
+normally only be initialized once, or at least cleared out (using the function
+@code{mpq_clear}) between each initialization.
+@end deftypefun
+
+@deftypefun void mpq_clear (mpq_t @var{rational_number})
+Free the space occupied by @var{rational_number}.  Make sure to call this
+function for all @code{mpq_t} variables when you are done with them.
+@end deftypefun
+
+@deftypefun void mpq_set (mpq_t @var{rop}, mpq_t @var{op})
+@deftypefunx void mpq_set_z (mpq_t @var{rop}, mpz_t @var{op})
+Assign @var{rop} from @var{op}.
+@end deftypefun
+
+@deftypefun void mpq_set_ui (mpq_t @var{rop}, unsigned long int @var{op1}, unsigned long int @var{op2})
+@deftypefunx void mpq_set_si (mpq_t @var{rop}, signed long int @var{op1}, unsigned long int @var{op2})
+Set the value of @var{rop} to @var{op1}/@var{op2}.  Note that if @var{op1} and
+@var{op2} have common factors, @var{rop} has to be passed to
+@code{mpq_canonicalize} before any operations are performed on @var{rop}.
+@end deftypefun
+
+@deftypefun void mpq_swap (mpq_t @var{rop1}, mpq_t @var{rop2})
+Swap the values @var{rop1} and @var{rop2} efficiently.
+@end deftypefun
+
+
+@node Rational Arithmetic, Comparing Rationals, Initializing Rationals, Rational Number Functions
+@comment  node-name,  next,  previous,  up
+@section Arithmetic Functions
+@cindex Rational arithmetic functions
+@cindex Arithmetic functions
+
+@deftypefun void mpq_add (mpq_t @var{sum}, mpq_t @var{addend1}, mpq_t @var{addend2})
+Set @var{sum} to @var{addend1} + @var{addend2}.
+@end deftypefun
+
+@deftypefun void mpq_sub (mpq_t @var{difference}, mpq_t @var{minuend}, mpq_t @var{subtrahend})
+Set @var{difference} to @var{minuend} @minus{} @var{subtrahend}.
+@end deftypefun
+
+@deftypefun void mpq_mul (mpq_t @var{product}, mpq_t @var{multiplier}, mpq_t @var{multiplicand})
+@ifnottex
+Set @var{product} to @var{multiplier} times @var{multiplicand}.
+@end ifnottex
+@tex
+Set @var{product} to $@var{multiplier} \times @var{multiplicand}$.
+@end tex
+@end deftypefun
+
+@deftypefun void mpq_div (mpq_t @var{quotient}, mpq_t @var{dividend}, mpq_t @var{divisor})
+@cindex Division functions
+Set @var{quotient} to @var{dividend}/@var{divisor}.
+@end deftypefun
+
+@deftypefun void mpq_neg (mpq_t @var{negated_operand}, mpq_t @var{operand})
+Set @var{negated_operand} to @minus{}@var{operand}.
+@end deftypefun
+
+@deftypefun void mpq_inv (mpq_t @var{inverted_number}, mpq_t @var{number})
+Set @var{inverted_number} to 1/@var{number}.  If the new denominator is
+zero, this routine will divide by zero.
+@end deftypefun
+
+@node Comparing Rationals, Applying Integer Functions, Rational Arithmetic, Rational Number Functions
+@comment  node-name,  next,  previous,  up
+@section Comparison Functions
+@cindex Rational comparison functions
+@cindex Comparison functions
+
+@deftypefun int mpq_cmp (mpq_t @var{op1}, mpq_t @var{op2})
+@ifnottex
+Compare @var{op1} and @var{op2}.  Return a positive value if @var{op1} >
+@var{op2}, zero if @var{op1} = @var{op2}, and a negative value if @var{op1} <
+@var{op2}.
+@end ifnottex
+@tex
+Compare @var{op1} and @var{op2}.  Return a positive value if $@var{op1} >
+@var{op2}$, zero if $@var{op1} = @var{op2}$, and a negative value if $@var{op1}
+< @var{op2}$.
+@end tex
+
+To determine if two rationals are equal, @code{mpq_equal} is faster than
+@code{mpq_cmp}.
+@end deftypefun
+
+@deftypefn Macro int mpq_cmp_ui (mpq_t @var{op1}, unsigned long int @var{num2}, unsigned long int @var{den2})
+@ifnottex
+Compare @var{op1} and @var{num2}/@var{den2}.  Return a positive value if
+@var{op1} > @var{num2}/@var{den2}, zero if @var{op1} = @var{num2}/@var{den2},
+and a negative value if @var{op1} < @var{num2}/@var{den2}.
+@end ifnottex
+@tex
+Compare @var{op1} and @var{num2}/@var{den2}.  Return a positive value if
+$@var{op1} > @var{num2}/@var{den2}$, zero if $@var{op1} =
+@var{num2}/@var{den2}$, and a negative value if $@var{op1} <
+@var{num2}/@var{den2}$.
+@end tex
+
+This routine allows that @var{num2} and @var{den2} have common factors.
+
+This function is actually implemented as a macro.  It evaluates its
+arguments multiple times.
+@end deftypefn
+
+@deftypefn Macro int mpq_sgn (mpq_t @var{op})
+@ifnottex
+Return +1 if @var{op} > 0, 0 if @var{op} = 0, and @minus{}1 if @var{op} < 0.
+@end ifnottex
+@tex
+Return $+1$ if $@var{op} > 0$, 0 if $@var{op} = 0$, and $-1$ if $@var{op} < 0$.
+@end tex
+
+This function is actually implemented as a macro.  It evaluates its
+arguments multiple times.
+@end deftypefn
+
+@deftypefun int mpq_equal (mpq_t @var{op1}, mpq_t @var{op2})
+Return non-zero if @var{op1} and @var{op2} are equal, zero if they are
+non-equal.  Although @code{mpq_cmp} can be used for the same purpose, this
+function is much faster.
+@end deftypefun
+
+@node Applying Integer Functions, I/O of Rationals, Comparing Rationals, Rational Number Functions
+@comment  node-name,  next,  previous,  up
+@section Applying Integer Functions to Rationals
+@cindex Rational numerator and denominator
+@cindex Numerator and denominator
+
+The set of @code{mpq} functions is quite small.  In particular, there are few
+functions for either input or output.  But there are two macros that allow us
+to apply any @code{mpz} function on the numerator or denominator of a rational
+number.  If these macros are used to assign to the rational number,
+@code{mpq_canonicalize} normally need to be called afterwards.
+
+@deftypefn Macro mpz_t mpq_numref (mpq_t @var{op})
+@deftypefnx Macro mpz_t mpq_denref (mpq_t @var{op})
+Return a reference to the numerator and denominator of @var{op}, respectively.
+The @code{mpz} functions can be used on the result of these macros.
+@end deftypefn
+
+
+@need 2000
+@node I/O of Rationals, Miscellaneous Rational Functions, Applying Integer Functions, Rational Number Functions
+@comment  node-name,  next,  previous,  up
+@section Input and Output Functions
+@cindex Rational input and output functions
+@cindex Input functions
+@cindex Output functions
+@cindex I/O functions
+
+Functions that perform input from a stdio stream, and functions that output to
+a stdio stream.  Passing a @code{NULL} pointer for a @var{stream} argument to
+any of these functions will make them read from @code{stdin} and write to
+@code{stdout}, respectively.
+
+When using any of these functions, it is a good idea to include @file{stdio.h}
+before @file{gmp.h}, since that will allow @file{gmp.h} to define prototypes
+for these functions.
+
+@deftypefun size_t mpq_out_str (FILE *@var{stream}, int @var{base}, mpq_t @var{op})
+Output @var{op} on stdio stream @var{stream}, as a string of digits in base
+@var{base}.  The base may vary from 2 to 36.  Output is in the form
+@samp{num/den} or if the denominator is 1 then just @samp{num}.
+
+Return the number of bytes written, or if an error occurred, return 0.
+@end deftypefun
+
+
+@need 2000
+@node Miscellaneous Rational Functions,  , I/O of Rationals, Rational Number Functions
+@comment  node-name,  next,  previous,  up
+@section Miscellaneous Functions
+@cindex Rational miscellaneous functions
+@cindex Miscellaneous rational functions
+
+@deftypefun double mpq_get_d (mpq_t @var{op})
+Convert @var{op} to a double.
+@end deftypefun
+
+@deftypefun double mpq_set_d (mpq_t @var{rop}, double @var{d})
+Set @var{rop} to the value of d, without rounding.
+@end deftypefun
+
+These functions assign between either the numerator or denominator of a
+rational, and an integer.  Instead of using these functions, it is preferable
+to use the more general mechanisms @code{mpq_numref} and @code{mpq_denref},
+together with @code{mpz_set}.
+
+@deftypefun void mpq_set_num (mpq_t @var{rational}, mpz_t @var{numerator})
+Copy @var{numerator} to the numerator of @var{rational}.  When this risks to
+make the numerator and denominator of @var{rational} have common factors, you
+have to pass @var{rational} to @code{mpq_canonicalize} before any operations
+are performed on @var{rational}.
+
+This function is equivalent to
+@code{mpz_set (mpq_numref (@var{rational}), @var{numerator})}.
+@end deftypefun
+
+@deftypefun void mpq_set_den (mpq_t @var{rational}, mpz_t @var{denominator})
+Copy @var{denominator} to the denominator of @var{rational}.  When this risks
+to make the numerator and denominator of @var{rational} have common factors,
+or if the denominator might be negative, you have to pass @var{rational} to
+@code{mpq_canonicalize} before any operations are performed on @var{rational}.
+
+@strong{In version 1 of the library, negative denominators were handled by
+copying the sign to the numerator.  That is no longer done.}
+
+This function is equivalent to
+@code{mpz_set (mpq_denref (@var{rational}), @var{denominators})}.
+@end deftypefun
+
+@deftypefun void mpq_get_num (mpz_t @var{numerator}, mpq_t @var{rational})
+Copy the numerator of @var{rational} to the integer @var{numerator}, to
+prepare for integer operations on the numerator.
+
+This function is equivalent to
+@code{mpz_set (@var{numerator}, mpq_numref (@var{rational}))}.
+@end deftypefun
+
+@deftypefun void mpq_get_den (mpz_t @var{denominator}, mpq_t @var{rational})
+Copy the denominator of @var{rational} to the integer @var{denominator}, to
+prepare for integer operations on the denominator.
+
+This function is equivalent to
+@code{mpz_set (@var{denominator}, mpq_denref (@var{rational}))}.
+@end deftypefun
+
+
+@node Floating-point Functions, Low-level Functions, Rational Number Functions, Top
+@comment  node-name,  next,  previous,  up
+@chapter Floating-point Functions
+@cindex Floating-point functions
+@cindex Float functions
+
+This chapter describes the GMP functions for performing floating point
+arithmetic.  These functions start with the prefix @code{mpf_}.
+
+GMP floating point numbers are stored in objects of type @code{mpf_t}.
+
+The GMP floating-point functions have an interface that is similar to the GMP
+integer functions.  The function prefix for floating-point operations is
+@code{mpf_}.
+
+There is one significant characteristic of floating-point numbers that has
+motivated a difference between this function class and other GMP function
+classes: the inherent inexactness of floating point arithmetic.  The user has
+to specify the precision of each variable.  A computation that assigns a
+variable will take place with the precision of the assigned variable; the
+precision of variables used as input is ignored.
+
+@cindex User-defined precision
+@cindex Precision of floats
+The precision of a calculation is defined as follows: Compute the requested
+operation exactly (with ``infinite precision''), and truncate the result to
+the destination variable precision.  Even if the user has asked for a very
+high precision, GMP will not calculate with superfluous digits.  For example,
+if two low-precision numbers of nearly equal magnitude are added, the
+precision of the result will be limited to what is required to represent the
+result accurately.
+
+The GMP floating-point functions are @emph{not} intended as a smooth extension
+to the IEEE P754 arithmetic.  Specifically, the results obtained on one
+computer often differs from the results obtained on a computer with a
+different word size.
+
+@menu
+* Initializing Floats::         
+* Assigning Floats::            
+* Simultaneous Float Init & Assign::  
+* Converting Floats::           
+* Float Arithmetic::            
+* Float Comparison::            
+* I/O of Floats::               
+* Miscellaneous Float Functions::  
+@end menu
+
+@node Initializing Floats, Assigning Floats, Floating-point Functions, Floating-point Functions
+@comment  node-name,  next,  previous,  up
+@section Initialization Functions
+@cindex Float initialization functions
+@cindex Initialization functions
+
+@deftypefun void mpf_set_default_prec (unsigned long int @var{prec})
+Set the default precision to be @strong{at least} @var{prec} bits.  All
+subsequent calls to @code{mpf_init} will use this precision, but previously
+initialized variables are unaffected.
+@end deftypefun
+
+An @code{mpf_t} object must be initialized before storing the first value in
+it.  The functions @code{mpf_init} and @code{mpf_init2} are used for that
+purpose.
+
+@deftypefun void mpf_init (mpf_t @var{x})
+Initialize @var{x} to 0.  Normally, a variable should be initialized once only
+or at least be cleared, using @code{mpf_clear}, between initializations.  The
+precision of @var{x} is undefined unless a default precision has already been
+established by a call to @code{mpf_set_default_prec}.
+@end deftypefun
+
+@deftypefun void mpf_init2 (mpf_t @var{x}, unsigned long int @var{prec})
+Initialize @var{x} to 0 and set its precision to be @strong{at least}
+@var{prec} bits.  Normally, a variable should be initialized once only or at
+least be cleared, using @code{mpf_clear}, between initializations.
+@end deftypefun
+
+@deftypefun void mpf_clear (mpf_t @var{x})
+Free the space occupied by @var{x}.  Make sure to call this function for all
+@code{mpf_t} variables when you are done with them.
+@end deftypefun
+
+@need 2000
+Here is an example on how to initialize floating-point variables:
+@example
+@{
+  mpf_t x, y;
+  mpf_init (x);			/* use default precision */
+  mpf_init2 (y, 256);		/* precision @emph{at least} 256 bits */
+  @dots{}
+  /* Unless the program is about to exit, do ... */
+  mpf_clear (x);
+  mpf_clear (y);
+@}
+@end example
+
+The following three functions are useful for changing the precision during a
+calculation.  A typical use would be for adjusting the precision gradually in
+iterative algorithms like Newton-Raphson, making the computation precision
+closely match the actual accurate part of the numbers.
+
+@deftypefun void mpf_set_prec (mpf_t @var{rop}, unsigned long int @var{prec})
+Set the precision of @var{rop} to be @strong{at least} @var{prec} bits.
+Since changing the precision involves calls to @code{realloc}, this routine
+should not be called in a tight loop.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpf_get_prec (mpf_t @var{op})
+Return the precision actually used for assignments of @var{op}.
+@end deftypefun
+
+@deftypefun void mpf_set_prec_raw (mpf_t @var{rop}, unsigned long int @var{prec})
+Set the precision of @var{rop} to be @strong{at least} @var{prec} bits.  This
+is a low-level function that does not change the allocation.  The @var{prec}
+argument must not be larger that the precision previously returned by
+@code{mpf_get_prec}.  It is crucial that the precision of @var{rop} is
+ultimately reset to exactly the value returned by @code{mpf_get_prec} before
+the first call to @code{mpf_set_prec_raw}.
+@end deftypefun
+
+
+@need 2000
+@node Assigning Floats, Simultaneous Float Init & Assign, Initializing Floats, Floating-point Functions
+@comment  node-name,  next,  previous,  up
+@section Assignment Functions
+@cindex Float assignment functions
+@cindex Assignment functions
+
+These functions assign new values to already initialized floats
+(@pxref{Initializing Floats}).
+
+@deftypefun void mpf_set (mpf_t @var{rop}, mpf_t @var{op})
+@deftypefunx void mpf_set_ui (mpf_t @var{rop}, unsigned long int @var{op})
+@deftypefunx void mpf_set_si (mpf_t @var{rop}, signed long int @var{op})
+@deftypefunx void mpf_set_d (mpf_t @var{rop}, double @var{op})
+@deftypefunx void mpf_set_z (mpf_t @var{rop}, mpz_t @var{op})
+@deftypefunx void mpf_set_q (mpf_t @var{rop}, mpq_t @var{op})
+Set the value of @var{rop} from @var{op}.
+@end deftypefun
+
+@deftypefun int mpf_set_str (mpf_t @var{rop}, char *@var{str}, int @var{base})
+Set the value of @var{rop} from the string in @var{str}.  The string is of the
+form @samp{M@@N} or, if the base is 10 or less, alternatively @samp{MeN}.
+@samp{M} is the mantissa and @samp{N} is the exponent.  The mantissa is always
+in the specified base.  The exponent is either in the specified base or, if
+@var{base} is negative, in decimal.
+
+The argument @var{base} may be in the ranges 2 to 36, or @minus{}36 to
+@minus{}2.  Negative values are used to specify that the exponent is in
+decimal.
+
+Unlike the corresponding @code{mpz} function, the base will not be determined
+from the leading characters of the string if @var{base} is 0.  This is so that
+numbers like @samp{0.23} are not interpreted as octal.
+
+White space is allowed in the string, and is simply ignored.  [This is not
+really true; white-space is ignored in the beginning of the string and within
+the mantissa, but not in other places, such as after a minus sign or in the
+exponent.  We are considering changing the definition of this function, making
+it fail when there is any white-space in the input, since that makes a lot of
+sense.  Please tell us your opinion about this change.  Do you really want it
+to accept "3 14" as meaning 314 as it does now?]
+
+This function returns 0 if the entire string up to the '\0' is a valid number
+in base @var{base}.  Otherwise it returns @minus{}1.
+@end deftypefun
+
+@deftypefun void mpf_swap (mpf_t @var{rop1}, mpf_t @var{rop2})
+Swap the values @var{rop1} and @var{rop2} efficiently.
+@end deftypefun
+
+
+@node Simultaneous Float Init & Assign, Converting Floats, Assigning Floats, Floating-point Functions
+@comment  node-name,  next,  previous,  up
+@section Combined Initialization and Assignment Functions
+@cindex Initialization and assignment functions
+@cindex Float init and assign functions
+
+For convenience, GMP provides a parallel series of initialize-and-set functions
+which initialize the output and then store the value there.  These functions'
+names have the form @code{mpf_init_set@dots{}}
+
+Once the float has been initialized by any of the @code{mpf_init_set@dots{}}
+functions, it can be used as the source or destination operand for the ordinary
+float functions.  Don't use an initialize-and-set function on a variable
+already initialized!
+
+@deftypefun void mpf_init_set (mpf_t @var{rop}, mpf_t @var{op})
+@deftypefunx void mpf_init_set_ui (mpf_t @var{rop}, unsigned long int @var{op})
+@deftypefunx void mpf_init_set_si (mpf_t @var{rop}, signed long int @var{op})
+@deftypefunx void mpf_init_set_d (mpf_t @var{rop}, double @var{op})
+Initialize @var{rop} and set its value from @var{op}.
+
+The precision of @var{rop} will be taken from the active default precision, as
+set by @code{mpf_set_default_prec}.
+@end deftypefun
+
+@deftypefun int mpf_init_set_str (mpf_t @var{rop}, char *@var{str}, int @var{base})
+Initialize @var{rop} and set its value from the string in @var{str}.  See
+@code{mpf_set_str} above for details on the assignment operation.
+
+Note that @var{rop} is initialized even if an error occurs.  (I.e., you have to
+call @code{mpf_clear} for it.)
+
+The precision of @var{rop} will be taken from the active default precision, as
+set by @code{mpf_set_default_prec}.
+@end deftypefun
+
+
+@node Converting Floats, Float Arithmetic, Simultaneous Float Init & Assign, Floating-point Functions
+@comment  node-name,  next,  previous,  up
+@section Conversion Functions
+@cindex Float conversion functions
+@cindex Conversion functions
+
+@deftypefun double mpf_get_d (mpf_t @var{op})
+Convert @var{op} to a double.
+@end deftypefun
+
+@deftypefun {char *} mpf_get_str (char *@var{str}, mp_exp_t *@var{expptr}, int @var{base}, size_t @var{n_digits}, mpf_t @var{op})
+Convert @var{op} to a string of digits in base @var{base}.  The base may vary
+from 2 to 36.  Generate at most @var{n_digits} significant digits, or if
+@var{n_digits} is 0, the maximum number of digits accurately representable by
+@var{op}.
+
+If @var{str} is @code{NULL}, space for the mantissa is allocated using the default
+allocation function.
+
+If @var{str} is not @code{NULL}, it should point to a block of storage enough large
+for the mantissa, i.e., @var{n_digits} + 2.  The two extra bytes are for a
+possible minus sign, and for the terminating null character.
+
+The exponent is written through the pointer @var{expptr}.
+
+If @var{n_digits} is 0, the maximum number of digits meaningfully achievable
+from the precision of @var{op} will be generated.  Note that the space
+requirements for @var{str} in this case will be impossible for the user to
+predetermine.  Therefore, you need to pass @code{NULL} for the string argument
+whenever @var{n_digits} is 0.
+
+The generated string is a fraction, with an implicit radix point immediately
+to the left of the first digit.  For example, the number 3.1416 would be
+returned as "31416" in the string and 1 written at @var{expptr}.
+
+A pointer to the result string is returned.  This pointer will will either
+equal @var{str}, or if that is @code{NULL}, will point to the allocated storage.
+@end deftypefun
+
+
+@node Float Arithmetic, Float Comparison, Converting Floats, Floating-point Functions
+@comment  node-name,  next,  previous,  up
+@section Arithmetic Functions
+@cindex Float arithmetic functions
+@cindex Arithmetic functions
+
+@deftypefun void mpf_add (mpf_t @var{rop}, mpf_t @var{op1}, mpf_t @var{op2})
+@deftypefunx void mpf_add_ui (mpf_t @var{rop}, mpf_t @var{op1}, unsigned long int @var{op2})
+@ifnottex
+Set @var{rop} to @var{op1} + @var{op2}.
+@end ifnottex
+@tex
+Set @var{rop} to $@var{op1} + @var{op2}$.
+@end tex
+@end deftypefun
+
+@deftypefun void mpf_sub (mpf_t @var{rop}, mpf_t @var{op1}, mpf_t @var{op2})
+@deftypefunx void mpf_ui_sub (mpf_t @var{rop}, unsigned long int @var{op1}, mpf_t @var{op2})
+@deftypefunx void mpf_sub_ui (mpf_t @var{rop}, mpf_t @var{op1}, unsigned long int @var{op2})
+Set @var{rop} to @var{op1} @minus{} @var{op2}.
+@end deftypefun
+
+@deftypefun void mpf_mul (mpf_t @var{rop}, mpf_t @var{op1}, mpf_t @var{op2})
+@deftypefunx void mpf_mul_ui (mpf_t @var{rop}, mpf_t @var{op1}, unsigned long int @var{op2})
+@ifnottex
+Set @var{rop} to @var{op1} times @var{op2}.
+@end ifnottex
+@tex
+Set @var{rop} to $@var{op1} \times @var{op2}$.
+@end tex
+@end deftypefun
+
+Division is undefined if the divisor is zero, and passing a zero divisor to
+the divide functions will make these functions intentionally divide by zero.
+This lets the user handle arithmetic exceptions in these functions in the same
+manner as other arithmetic exceptions.
+
+@deftypefun void mpf_div (mpf_t @var{rop}, mpf_t @var{op1}, mpf_t @var{op2})
+@deftypefunx void mpf_ui_div (mpf_t @var{rop}, unsigned long int @var{op1}, mpf_t @var{op2})
+@deftypefunx void mpf_div_ui (mpf_t @var{rop}, mpf_t @var{op1}, unsigned long int @var{op2})
+@cindex Division functions
+Set @var{rop} to @var{op1}/@var{op2}.
+@end deftypefun
+
+@deftypefun void mpf_sqrt (mpf_t @var{rop}, mpf_t @var{op})
+@deftypefunx void mpf_sqrt_ui (mpf_t @var{rop}, unsigned long int @var{op})
+@cindex Root extraction functions
+@ifnottex
+Set @var{rop} to the square root of @var{op}.
+@end ifnottex
+@tex
+Set @var{rop} to $\sqrt{@var{op}}$.
+@end tex
+@end deftypefun
+
+@deftypefun void mpf_pow_ui (mpf_t @var{rop}, mpf_t @var{op1}, unsigned long int @var{op2})
+@cindex Exponentiation functions
+@ifnottex
+Set @var{rop} to @var{op1} raised to the power @var{op2}.
+@end ifnottex
+@tex
+Set @var{rop} to $@var{op1}^{op2}$.
+@end tex
+@end deftypefun
+
+@deftypefun void mpf_neg (mpf_t @var{rop}, mpf_t @var{op})
+Set @var{rop} to @minus{}@var{op}.
+@end deftypefun
+
+@deftypefun void mpf_abs (mpf_t @var{rop}, mpf_t @var{op})
+Set @var{rop} to the absolute value of @var{op}.
+@end deftypefun
+
+@deftypefun void mpf_mul_2exp (mpf_t @var{rop}, mpf_t @var{op1}, unsigned long int @var{op2})
+@ifnottex
+Set @var{rop} to @var{op1} times 2 raised to @var{op2}.
+@end ifnottex
+@tex
+Set @var{rop} to $@var{op1} \times 2^{op2}$.
+@end tex
+@end deftypefun
+
+@deftypefun void mpf_div_2exp (mpf_t @var{rop}, mpf_t @var{op1}, unsigned long int @var{op2})
+@ifnottex
+Set @var{rop} to @var{op1} divided by 2 raised to @var{op2}.
+@end ifnottex
+@tex
+Set @var{rop} to $@var{op1}/2^{op2}$.
+@end tex
+@end deftypefun
+
+@node Float Comparison, I/O of Floats, Float Arithmetic, Floating-point Functions
+@comment  node-name,  next,  previous,  up
+@section Comparison Functions
+@cindex Float comparison functions
+@cindex Comparison functions
+
+@deftypefun int mpf_cmp (mpf_t @var{op1}, mpf_t @var{op2})
+@deftypefunx int mpf_cmp_ui (mpf_t @var{op1}, unsigned long int @var{op2})
+@deftypefunx int mpf_cmp_si (mpf_t @var{op1}, signed long int @var{op2})
+@ifnottex
+Compare @var{op1} and @var{op2}.  Return a positive value if @var{op1} >
+@var{op2}, zero if @var{op1} = @var{op2}, and a negative value if @var{op1} <
+@var{op2}.
+@end ifnottex
+@tex
+Compare @var{op1} and @var{op2}.  Return a positive value if $@var{op1} >
+@var{op2}$, zero if $@var{op1} = @var{op2}$, and a negative value if $@var{op1}
+< @var{op2}$.
+@end tex
+@end deftypefun
+
+@deftypefun int mpf_eq (mpf_t @var{op1}, mpf_t @var{op2}, unsigned long int op3)
+Return non-zero if the first @var{op3} bits of @var{op1} and @var{op2} are
+equal, zero otherwise.  I.e., test of @var{op1} and @var{op2} are
+approximately equal.
+@end deftypefun
+
+@deftypefun void mpf_reldiff (mpf_t @var{rop}, mpf_t @var{op1}, mpf_t @var{op2})
+Compute the relative difference between @var{op1} and @var{op2} and store the
+result in @var{rop}.
+@end deftypefun
+
+@deftypefn Macro int mpf_sgn (mpf_t @var{op})
+@ifnottex
+Return +1 if @var{op} > 0, 0 if @var{op} = 0, and @minus{}1 if @var{op} < 0.
+@end ifnottex
+@tex
+Return $+1$ if $@var{op} > 0$, 0 if $@var{op} = 0$, and $-1$ if $@var{op} < 0$.
+@end tex
+
+This function is actually implemented as a macro.  It evaluates its
+arguments multiple times.
+@end deftypefn
+
+@node I/O of Floats, Miscellaneous Float Functions, Float Comparison, Floating-point Functions
+@comment  node-name,  next,  previous,  up
+@section Input and Output Functions
+@cindex Float input and output functions
+@cindex Input functions
+@cindex Output functions
+@cindex I/O functions
+
+Functions that perform input from a stdio stream, and functions that output to
+a stdio stream.  Passing a @code{NULL} pointer for a @var{stream} argument to any of
+these functions will make them read from @code{stdin} and write to
+@code{stdout}, respectively.
+
+When using any of these functions, it is a good idea to include @file{stdio.h}
+before @file{gmp.h}, since that will allow @file{gmp.h} to define prototypes
+for these functions.
+
+@deftypefun size_t mpf_out_str (FILE *@var{stream}, int @var{base}, size_t @var{n_digits}, mpf_t @var{op})
+Output @var{op} on stdio stream @var{stream}, as a string of digits in
+base @var{base}.  The base may vary from 2 to 36.  Print at most
+@var{n_digits} significant digits, or if @var{n_digits} is 0, the maximum
+number of digits accurately representable by @var{op}.
+
+In addition to the significant digits, a leading @samp{0.} and a
+trailing exponent, in the form @samp{eNNN}, are printed.  If @var{base}
+is greater than 10, @samp{@@} will be used instead of @samp{e} as
+exponent delimiter.
+
+Return the number of bytes written, or if an error occurred, return 0.
+@end deftypefun
+
+@deftypefun size_t mpf_inp_str (mpf_t @var{rop}, FILE *@var{stream}, int @var{base})
+Input a string in base @var{base} from stdio stream @var{stream}, and put the
+read float in @var{rop}.  The string is of the form @samp{M@@N} or, if the
+base is 10 or less, alternatively @samp{MeN}.  @samp{M} is the mantissa and
+@samp{N} is the exponent.  The mantissa is always in the specified base.  The
+exponent is either in the specified base or, if @var{base} is negative, in
+decimal.
+
+The argument @var{base} may be in the ranges 2 to 36, or @minus{}36 to
+@minus{}2.  Negative values are used to specify that the exponent is in
+decimal.
+
+Unlike the corresponding @code{mpz} function, the base will not be determined
+from the leading characters of the string if @var{base} is 0.  This is so that
+numbers like @samp{0.23} are not interpreted as octal.
+
+Return the number of bytes read, or if an error occurred, return 0.
+@end deftypefun
+
+@c @deftypefun void mpf_out_raw (FILE *@var{stream}, mpf_t @var{float})
+@c Output @var{float} on stdio stream @var{stream}, in raw binary
+@c format.  The float is written in a portable format, with 4 bytes of
+@c size information, and that many bytes of limbs.  Both the size and the
+@c limbs are written in decreasing significance order.
+@c @end deftypefun
+
+@c @deftypefun void mpf_inp_raw (mpf_t @var{float}, FILE *@var{stream})
+@c Input from stdio stream @var{stream} in the format written by
+@c @code{mpf_out_raw}, and put the result in @var{float}.
+@c @end deftypefun
+
+
+@node Miscellaneous Float Functions,  , I/O of Floats, Floating-point Functions
+@comment  node-name,  next,  previous,  up
+@section Miscellaneous Functions
+@cindex Miscellaneous float functions
+@cindex Float miscellaneous functions
+
+@deftypefun void mpf_ceil (mpf_t @var{rop}, mpf_t @var{op})
+@deftypefunx void mpf_floor (mpf_t @var{rop}, mpf_t @var{op})
+@deftypefunx void mpf_trunc (mpf_t @var{rop}, mpf_t @var{op})
+Set @var{rop} to @var{op} rounded to an integer.  @code{mpf_ceil} rounds to
+the next higher integer, @code{mpf_floor} to the next lower, and
+@code{mpf_trunc} to the integer towards zero.
+@end deftypefun
+
+@deftypefun void mpf_urandomb (mpf_t @var{rop}, gmp_randstate_t @var{state}, unsigned long int @var{nbits}) 
+Generate a uniformly distributed random float in @var{rop}, such that 0 <=
+@var{rop} < 1, with @var{nbits} significant bits in the mantissa.
+
+The variable @var{state} must be initialized by calling one of the
+@code{gmp_randinit} functions (@ref{Random State Initialization})
+before invoking this function.
+@end deftypefun
+
+@deftypefun void mpf_random2 (mpf_t @var{rop}, mp_size_t @var{max_size}, mp_exp_t @var{max_exp})
+Generate a random float of at most @var{max_size} limbs, with long strings of
+zeros and ones in the binary representation.  The exponent of the number is in
+the interval @minus{}@var{exp} to @var{exp}.  This function is useful for
+testing functions and algorithms, since this kind of random numbers have
+proven to be more likely to trigger corner-case bugs.  Negative random numbers
+are generated when @var{max_size} is negative.
+@end deftypefun
+
+
+
+@c @deftypefun size_t mpf_size (mpf_t @var{op})
+@c Return the size of @var{op} measured in number of limbs.  If @var{op} is
+@c zero, the returned value will be zero.  (@xref{Nomenclature}, for an
+@c explanation of the concept @dfn{limb}.)
+@c
+@c @strong{This function is obsolete.  It will disappear from future GMP
+@c releases.}
+@c @end deftypefun
+
+@node Low-level Functions, Random Number Functions, Floating-point Functions, Top
+@comment  node-name,  next,  previous,  up
+@chapter Low-level Functions
+@cindex Low-level functions
+
+This chapter describes low-level GMP functions, used to implement the high-level
+GMP functions, but also intended for time-critical user code.
+
+These functions start with the prefix @code{mpn_}.
+
+@c 1. Some of these function clobber input operands.
+@c
+
+The @code{mpn} functions are designed to be as fast as possible, @strong{not}
+to provide a coherent calling interface.  The different functions have somewhat
+similar interfaces, but there are variations that make them hard to use.  These
+functions do as little as possible apart from the real multiple precision
+computation, so that no time is spent on things that not all callers need.
+
+A source operand is specified by a pointer to the least significant limb and a
+limb count.  A destination operand is specified by just a pointer.  It is the
+responsibility of the caller to ensure that the destination has enough space
+for storing the result.
+
+With this way of specifying operands, it is possible to perform computations
+on subranges of an argument, and store the result into a subrange of a
+destination.
+
+A common requirement for all functions is that each source area needs at
+least one limb.  No size argument may be zero.  Unless otherwise stated,
+in-place operations are allowed where source and destination are the
+same, but not where they only partly overlap.
+
+The @code{mpn} functions are the base for the implementation of the
+@code{mpz_}, @code{mpf_}, and @code{mpq_} functions.
+
+This example adds the number beginning at @var{s1p} and the number
+beginning at @var{s2p} and writes the sum at @var{destp}.  All areas
+have @var{size} limbs.
+
+@example
+cy = mpn_add_n (destp, s1p, s2p, size)
+@end example
+
+@noindent
+In the notation used here, a source operand is identified by the pointer to
+the least significant limb, and the limb count in braces.  For example,
+@{s1p, s1size@}.
+
+@deftypefun mp_limb_t mpn_add_n (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, const mp_limb_t *@var{s2p}, mp_size_t @var{size})
+Add @{@var{s1p}, @var{size}@} and @{@var{s2p}, @var{size}@}, and
+write the @var{size} least significant limbs of the result to @var{rp}.
+Return carry, either 0 or 1.
+
+This is the lowest-level function for addition.  It is the preferred function
+for addition, since it is written in assembly for most targets.  For addition
+of a variable to itself (i.e., @var{s1p} equals @var{s2p}, use
+@code{mpn_lshift} with a count of 1 for optimal speed.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_add_1 (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, mp_size_t @var{size}, mp_limb_t @var{s2limb})
+Add @{@var{s1p}, @var{size}@} and @var{s2limb}, and write the
+@var{size} least significant limbs of the result to @var{rp}.  Return
+carry, either 0 or 1.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_add (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, mp_size_t @var{s1size}, const mp_limb_t *@var{s2p}, mp_size_t @var{s2size})
+Add @{@var{s1p}, @var{s1size}@} and @{@var{s2p},
+@var{s2size}@}, and write the @var{s1size} least significant limbs of
+the result to @var{rp}.  Return carry, either 0 or 1.
+
+This function requires that @var{s1size} is greater than or equal to
+@var{s2size}.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_sub_n (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, const mp_limb_t *@var{s2p}, mp_size_t @var{size})
+Subtract @{@var{s2p}, @var{s2size}@} from @{@var{s1p},
+@var{size}@}, and write the @var{size} least significant limbs of the result
+to @var{rp}.  Return borrow, either 0 or 1.
+
+This is the lowest-level function for subtraction.  It is the preferred
+function for subtraction, since it is written in assembly for most targets.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_sub_1 (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, mp_size_t @var{size}, mp_limb_t @var{s2limb})
+Subtract @var{s2limb} from @{@var{s1p}, @var{size}@}, and write the
+@var{size} least significant limbs of the result to @var{rp}.  Return
+borrow, either 0 or 1.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_sub (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, mp_size_t @var{s1size}, const mp_limb_t *@var{s2p}, mp_size_t @var{s2size})
+Subtract @{@var{s2p}, @var{s2size}@} from @{@var{s1p},
+@var{s1size}@}, and write the @var{s1size} least significant limbs of
+the result to @var{rp}.  Return borrow, either 0 or 1.
+
+This function requires that @var{s1size} is greater than or equal to
+@var{s2size}.
+@end deftypefun
+
+@deftypefun void mpn_mul_n (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, const mp_limb_t *@var{s2p}, mp_size_t @var{size})
+Multiply @{@var{s1p}, @var{size}@} and @{@var{s2p}, @var{size}@},
+and write the @strong{entire} result to @var{rp}.
+
+The destination has to have space for 2*@var{size} limbs, even if the
+significant result might be one limb smaller.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_mul_1 (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, mp_size_t @var{size}, mp_limb_t @var{s2limb})
+Multiply @{@var{s1p}, @var{size}@} and @var{s2limb}, and write the
+@var{size} least significant limbs of the product to @var{rp}.  Return
+the most significant limb of the product.
+
+This is a low-level function that is a building block for general
+multiplication as well as other operations in GMP.  It is written in assembly
+for most targets.
+
+Don't call this function if @var{s2limb} is a power of 2; use
+@code{mpn_lshift} with a count equal to the logarithm of @var{s2limb}
+instead, for optimal speed.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_addmul_1 (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, mp_size_t @var{size}, mp_limb_t @var{s2limb})
+Multiply @{@var{s1p}, @var{size}@} and @var{s2limb}, and add the
+@var{size} least significant limbs of the product to @{@var{rp},
+@var{size}@} and write the result to @var{rp}.  Return
+the most significant limb of the product, plus carry-out from the addition.
+
+This is a low-level function that is a building block for general
+multiplication as well as other operations in GMP.  It is written in assembly
+for most targets.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_submul_1 (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, mp_size_t @var{size}, mp_limb_t @var{s2limb})
+Multiply @{@var{s1p}, @var{size}@} and @var{s2limb}, and subtract the
+@var{size} least significant limbs of the product from @{@var{rp},
+@var{size}@} and write the result to @var{rp}.  Return the most
+significant limb of the product, minus borrow-out from the subtraction.
+
+This is a low-level function that is a building block for general
+multiplication and division as well as other operations in GMP.  It is written
+in assembly for most targets.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_mul (mp_limb_t *@var{rp}, const mp_limb_t *@var{s1p}, mp_size_t @var{s1size}, const mp_limb_t *@var{s2p}, mp_size_t @var{s2size})
+Multiply @{@var{s1p}, @var{s1size}@} and @{@var{s2p},
+@var{s2size}@}, and write the result to @var{rp}.  Return the most
+significant limb of the result.
+
+The destination has to have space for @var{s1size} + @var{s2size}
+limbs, even if the result might be one limb smaller.
+
+This function requires that @var{s1size} is greater than or equal to
+@var{s2size}.  The destination must be distinct from either input operands.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_tdiv_qr (mp_limb_t *@var{qp}, mp_limb_t *@var{rp}, mp_size_t @var{qxn}, const mp_limb_t *@var{np}, mp_size_t @var{nn}, const mp_limb_t *@var{dp}, mp_size_t @var{dn})
+Divide @{@var{np}, @var{nn}@} by @{@var{dp}, @var{dn}@}.  Write the quotient
+at @var{qp} and the remainder at @var{rp}.
+
+The quotient written at @var{qp} will be @var{nn} @minus{} @var{dn} + 1 limbs.
+The remainder written at @var{rp} will be @var{dn} limbs.
+
+It is required that @var{nn} is greater than or equal to @var{dn}.  The
+@var{qxn} operand must be zero.
+
+The quotient is rounded towards 0.
+
+No overlap between arguments is permitted.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_divrem (mp_limb_t *@var{r1p}, mp_size_t @var{xsize}, mp_limb_t *@var{rs2p}, mp_size_t @var{rs2size}, const mp_limb_t *@var{s3p}, mp_size_t @var{s3size})
+[This function is obsolete.  Please call @code{mpn_tdiv_qr} instead for
+best performance.]
+
+Divide @{@var{rs2p}, @var{rs2size}@} by @{@var{s3p}, @var{s3size}@}, and write
+the quotient at @var{r1p}, with the exception of the most significant limb,
+which is returned.  The remainder replaces the dividend at @var{rs2p}; it will
+be @var{s3size} limbs long (i.e., as many limbs as the divisor).
+
+In addition to an integer quotient, @var{xsize} fraction limbs are developed,
+and stored after the integral limbs.  For most usages, @var{xsize} will be
+zero.
+
+It is required that @var{rs2size} is greater than or equal to @var{s3size}.
+It is required that the most significant bit of the divisor is set.
+
+If the quotient is not needed, pass @var{rs2p} + @var{s3size} as @var{r1p}.
+Aside from that special case, no overlap between arguments is permitted.
+
+Return the most significant limb of the quotient, either 0 or 1.
+
+The area at @var{r1p} needs to be @var{rs2size} @minus{} @var{s3size} +
+@var{xsize} limbs large.
+@end deftypefun
+
+@deftypefn Function mp_limb_t mpn_divrem_1 (mp_limb_t *@var{r1p}, mp_size_t @var{xsize}, @w{mp_limb_t *@var{s2p}}, mp_size_t @var{s2size}, mp_limb_t @var{s3limb})
+@deftypefnx Macro mp_limb_t mpn_divmod_1 (mp_limb_t *@var{r1p}, mp_limb_t *@var{s2p}, @w{mp_size_t @var{s2size}}, @w{mp_limb_t @var{s3limb}})
+Divide @{@var{s2p}, @var{s2size}@} by @var{s3limb}, and write the quotient
+at @var{r1p}.  Return the remainder.
+
+The integer quotient is written to @{@var{r1p}+@var{xsize}, @var{s2size}@} and
+in addition @var{xsize} fraction limbs are developed and written to
+@{@var{r1p}, @var{xsize}@}.  Either or both @var{s2size} and @var{xsize} can
+be zero.  For most usages, @var{xsize} will be zero.
+
+@code{mpn_divmod_1} exists for upward source compatibility and is simply a
+macro calling @code{mpn_divrem_1} with an @var{xsize} of 0.
+
+The areas at @var{r1p} and @var{s2p} have to be identical or completely
+separate, not partially overlapping.
+@end deftypefn
+
+@deftypefun mp_limb_t mpn_divmod (mp_limb_t *@var{r1p}, mp_limb_t *@var{rs2p}, mp_size_t @var{rs2size}, const mp_limb_t *@var{s3p}, mp_size_t @var{s3size})
+@strong{This interface is obsolete.  It will disappear from future releases.
+Use @code{mpn_divrem} in its stead.}
+@end deftypefun
+
+@deftypefn Macro mp_limb_t mpn_divexact_by3 (mp_limb_t *@var{rp}, mp_limb_t *@var{sp}, @w{mp_size_t @var{size}})
+@deftypefnx Function mp_limb_t mpn_divexact_by3c (mp_limb_t *@var{rp}, mp_limb_t *@var{sp}, @w{mp_size_t @var{size}}, mp_limb_t @var{carry})
+Divide @{@var{sp}, @var{size}@} by 3, expecting it to divide exactly, and
+writing the result to @{@var{rp}, @var{size}@}.  If 3 divides exactly, the
+return value is zero and the result is the quotient.  If not, the return value
+is non-zero and the result won't be anything useful.
+
+@code{mpn_divexact_by3c} takes an initial carry parameter, which can be the
+return value from a previous call, so a large calculation can be done piece by
+piece.  @code{mpn_divexact_by3} is simply a macro calling
+@code{mpn_divexact_by3c} with a 0 carry parameter.
+
+These routines use a multiply-by-inverse and will be faster than
+@code{mpn_divrem_1} on CPUs with fast multiplication but slow division.
+
+The source @math{a}, result @math{q}, size @math{n}, initial carry @math{i},
+and return value @math{c} satisfy
+@tex
+$c b^n + a - i = 3q$,
+@end tex
+@ifnottex
+@math{c*b^n + a-i = 3*q},
+@end ifnottex
+where @math{b} is the size of a limb
+@tex
+($2^{32}$ or $2^{64}$).
+@end tex
+@ifnottex
+(@math{2^32} or @math{2^64}).
+@end ifnottex
+@math{c} is always 0, 1 or 2, and the initial carry must also be 0, 1 or 2
+(these are both borrows really).  When @math{c=0}, clearly @math{q=(a-i)/3}.
+When
+@tex
+$c \neq 0$,
+the remainder $(a-i) \, mod \, 3$
+@end tex
+@ifnottex
+@math{c!=0}, the remainder @math{(a-i) mod 3}
+@end ifnottex
+is given by @math{3-c}, because
+@tex
+$b \equiv 1 \, mod \, 3$.
+@end tex
+@ifnottex
+@math{b @equiv{} 1 mod 3}.
+@end ifnottex
+@end deftypefn
+
+@deftypefun mp_limb_t mpn_mod_1 (mp_limb_t *@var{s1p}, mp_size_t @var{s1size}, mp_limb_t @var{s2limb})
+Divide @{@var{s1p}, @var{s1size}@} by @var{s2limb}, and return the remainder.
+@var{s1size} can be zero.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_preinv_mod_1 (mp_limb_t *@var{s1p}, mp_size_t @var{s1size}, mp_limb_t @var{s2limb}, mp_limb_t @var{s3limb})
+@strong{This interface is obsolete.  It will disappear from future releases.
+Use @code{mpn_mod_1} in its stead.}
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_bdivmod (mp_limb_t *@var{rp}, mp_limb_t *@var{s1p}, mp_size_t @var{s1size}, const mp_limb_t *@var{s2p}, mp_size_t @var{s2size}, unsigned long int @var{d})
+The function puts the low [@var{d}/@var{BITS_PER_MP_LIMB}] limbs of
+@var{q} =
+@{@var{s1p}, @var{s1size}@}/@{@var{s2p}, @var{s2size}@}
+mod 2^@var{d}
+at @var{rp},
+and returns the high @var{d} mod @var{BITS_PER_MP_LIMB} bits of @var{q}.
+
+@{@var{s1p}, @var{s1size}@} - @var{q} * @{@var{s2p}, @var{s2size}@}
+mod 2^(@var{s1size}*@var{BITS_PER_MP_LIMB})
+is placed at @var{s1p}.
+Since the low [@var{d}/@var{BITS_PER_MP_LIMB}] limbs of
+this difference are zero, it is possible to overwrite the low limbs at
+@var{s1p} with this difference,
+provided @var{rp} <= @var{s1p}.
+
+This function requires that @var{s1size} * @var{BITS_PER_MP_LIMB} >= @var{D},
+and that @{@var{s2p}, @var{s2size}@} is odd.
+
+@strong{This interface is preliminary.  It might change incompatibly in
+future revisions.}
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_lshift (mp_limb_t *@var{rp}, const mp_limb_t *@var{src_ptr}, mp_size_t @var{src_size}, unsigned long int @var{count})
+Shift @{@var{src_ptr}, @var{src_size}@} @var{count} bits to the left, and
+write the @var{src_size} least significant limbs of the result to
+@var{rp}.  @var{count} might be in the range 1 to n @minus{} 1, on an
+n-bit machine. The bits shifted out to the left are returned.
+
+Overlapping of the destination space and the source space is allowed in this
+function, provided @var{rp} >= @var{src_ptr}.
+
+This function is written in assembly for most targets.
+@end deftypefun
+
+@deftypefun mp_limp_t mpn_rshift (mp_limb_t *@var{rp}, const mp_limb_t *@var{src_ptr}, mp_size_t @var{src_size}, unsigned long int @var{count})
+Shift @{@var{src_ptr}, @var{src_size}@} @var{count} bits to the right, and
+write the @var{src_size} most significant limbs of the result to
+@var{rp}.  @var{count} might be in the range 1 to n @minus{} 1, on an
+n-bit machine.  The bits shifted out to the right are returned.
+
+Overlapping of the destination space and the source space is allowed in this
+function, provided @var{rp} <= @var{src_ptr}.
+
+This function is written in assembly for most targets.
+@end deftypefun
+
+@deftypefun int mpn_cmp (const mp_limb_t *@var{s1p}, const mp_limb_t *@var{s2p}, mp_size_t @var{size})
+Compare @{@var{s1p}, @var{size}@} and @{@var{s2p}, @var{size}@} and
+return a positive value if s1 > src2, 0 of they are equal, and a negative
+value if s1 < src2.
+@end deftypefun
+
+@deftypefun mp_size_t mpn_gcd (mp_limb_t *@var{rp}, mp_limb_t *@var{s1p}, mp_size_t @var{s1size}, mp_limb_t *@var{s2p}, mp_size_t @var{s2size})
+Puts at @var{rp} the greatest common divisor of @{@var{s1p},
+@var{s1size}@} and @{@var{s2p}, @var{s2size}@}; both source
+operands are destroyed by the operation.  The size in limbs of the greatest
+common divisor is returned.
+
+@{@var{s1p}, @var{s1size}@} must have at least as many bits as
+@{@var{s2p}, @var{s2size}@}, and @{@var{s2p}, @var{s2size}@} must be odd.
+@end deftypefun
+
+@deftypefun mp_limb_t mpn_gcd_1 (const mp_limb_t *@var{s1p}, mp_size_t @var{s1size}, mp_limb_t @var{s2limb})
+Return the greatest common divisor of @{@var{s1p}, @var{s1size}@}
+and @var{s2limb}, where @var{s2limb} (as well as @var{s1size})
+must be different from 0.
+@end deftypefun
+
+@deftypefun mp_size_t mpn_gcdext (mp_limb_t *@var{r1p}, mp_limb_t *@var{r2p}, mp_size_t *@var{r2size}, mp_limb_t *@var{s1p}, mp_size_t @var{s1size}, mp_limb_t *@var{s2p}, mp_size_t @var{s2size})
+Compute the greatest common divisor of @{@var{s1p}, @var{s1size}@} and
+@{@var{s2p}, @var{s2size}@}.  Store the gcd at @var{r1p} and return its size
+in limbs.  Write the first cofactor at @var{r2p} and store its size in
+*@var{r2size}.  If the cofactor is negative, *@var{r2size} is negative and
+@var{r2p} is the absolute value of the cofactor.
+
+@{@var{s1p}, @var{s1size}@} must be greater than or equal to @{@var{s2p},
+@var{s2size}@}.  Neither operand may equal 0.  Both source operands are
+destroyed, plus one limb past the end of each, ie. @{@var{s1p},
+@var{s1size}+1@} and @{@var{s2p}, @var{s2size}+1@}.
+@end deftypefun
+
+@deftypefun mp_size_t mpn_sqrtrem (mp_limb_t *@var{r1p}, mp_limb_t *@var{r2p}, const mp_limb_t *@var{sp}, mp_size_t @var{size})
+Compute the square root of @{@var{sp}, @var{size}@} and put the result at
+@var{r1p}.  Write the remainder at @var{r2p}, unless @var{r2p} is @code{NULL}.
+
+Return the size of the remainder, whether @var{r2p} was @code{NULL} or non-@code{NULL}.
+Iff the operand was a perfect square, the return value will be 0.
+
+The areas at @var{r1p} and @var{sp} have to be distinct.  The areas at
+@var{r2p} and @var{sp} have to be identical or completely separate, not
+partially overlapping.
+
+@ifnottex
+The area at @var{r1p} needs to have space for ceil(@var{size}/2) limbs.
+@end ifnottex
+@tex
+The area at @var{r1p} needs to have space for $\lceil@var{size}/2\rceil$ limbs.
+@end tex
+The area at @var{r2p} needs to be @var{size} limbs large.
+@end deftypefun
+
+@deftypefun mp_size_t mpn_get_str (unsigned char *@var{str}, int @var{base}, mp_limb_t *@var{s1p}, mp_size_t @var{s1size})
+Convert @{@var{s1p}, @var{s1size}@} to a raw unsigned char array in base
+@var{base}.  The string is not in ASCII; to convert it to printable format,
+add the ASCII codes for @samp{0} or @samp{A}, depending on the base and
+range.  There may be leading zeros in the string.
+
+The area at @var{s1p} is clobbered.
+
+Return the number of characters in @var{str}.
+
+The area at @var{str} has to have space for the largest possible number
+represented by a @var{s1size} long limb array, plus one extra character.
+@end deftypefun
+
+@deftypefun mp_size_t mpn_set_str (mp_limb_t *@var{r1p}, const char *@var{str}, size_t @var{strsize}, int @var{base})
+Convert the raw unsigned char array at @var{str} of length @var{strsize} to
+a limb array @{@var{s1p}, @var{s1size}@}.  The base of @var{str} is
+@var{base}.
+
+Return the number of limbs stored in @var{r1p}.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpn_scan0 (const mp_limb_t *@var{s1p}, unsigned long int @var{bit})
+Scan @var{s1p} from bit position @var{bit} for the next clear bit.
+
+It is required that there be a clear bit within the area at @var{s1p} at or
+beyond bit position @var{bit}, so that the function has something to return.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpn_scan1 (const mp_limb_t *@var{s1p}, unsigned long int @var{bit})
+Scan @var{s1p} from bit position @var{bit} for the next set bit.
+
+It is required that there be a set bit within the area at @var{s1p} at or
+beyond bit position @var{bit}, so that the function has something to return.
+@end deftypefun
+
+@deftypefun void mpn_random (mp_limb_t *@var{r1p}, mp_size_t @var{r1size})
+@deftypefunx void mpn_random2 (mp_limb_t *@var{r1p}, mp_size_t @var{r1size})
+Generate a random number of length @var{r1size} and store it at @var{r1p}.
+The most significant limb is always non-zero.  @code{mpn_random} generates
+uniformly distributed limb data, @code{mpn_random2} generates long strings of
+zeros and ones in the binary representation.
+
+@code{mpn_random2} is intended for testing the correctness of the @code{mpn}
+routines.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpn_popcount (const mp_limb_t *@var{s1p}, unsigned long int @var{size})
+Count the number of set bits in @{@var{s1p}, @var{size}@}.
+@end deftypefun
+
+@deftypefun {unsigned long int} mpn_hamdist (const mp_limb_t *@var{s1p}, const mp_limb_t *@var{s2p}, unsigned long int @var{size})
+Compute the hamming distance between @{@var{s1p}, @var{size}@} and
+@{@var{s2p}, @var{size}@}.
+@end deftypefun
+
+@deftypefun int mpn_perfect_square_p (const mp_limb_t *@var{s1p}, mp_size_t @var{size})
+Return non-zero iff @{@var{s1p}, @var{size}@} is a perfect square.
+@end deftypefun
+
+
+@node  Random Number Functions, BSD Compatible Functions, Low-level Functions, Top
+@chapter Random Number Functions
+@cindex Random number functions
+
+There are two groups of random number functions in GNU MP; older
+functions that call C library random number generators, rely on a global
+state, and aren't very random; and newer functions that don't have these
+problems.  The newer functions are self-contained, they accept a random
+state parameter that supplants global state, and generate good random
+numbers.
+
+The random state parameter is of the type @code{gmp_randstate_t}.  It must be
+initialized by a call to one of the @code{gmp_randinit} functions (@ref{Random
+State Initialization}).  The initial seed is set using one of the
+@code{gmp_randseed} functions (@ref{Random State Initialization}).
+
+The size of the seed determines the number of different sequences of
+random numbers that is possible to generate.  The ``quality'' of the
+seed is the randomness of a given seed compared to the previous seed
+used and affects the randomness of separate number sequences.
+
+The algorithm for assigning seed is critical if the generated random numbers
+are to be used for important applications, such as generating cryptographic
+keys.
+
+The traditional method is to use the current system time for seeding.  One has
+to be careful when using the current time though.  If the application seeds the
+random functions very often, say several times per second, and the resolution
+of the system clock is comparatively low, like one second, the same sequence of
+numbers will be generated until the system clock ticks.  Furthermore, the
+current system time is quite easy to guess, so a system depending on any
+unpredictability of the random number sequence should absolutely not use that
+as its only source for a seed value.
+
+On some systems there is a special device, often called @code{/dev/random},
+which provides a source of somewhat random numbers more usable as seed.
+
+The functions actually generating random functions are documented under
+``Miscellaneous Functions'' in their respective function class:
+@ref{Miscellaneous Integer Functions}, @ref{Miscellaneous Float Functions}.
+
+@menu
+* Random State Initialization::  How to initialize a random state.
+@end menu
+
+@node  Random State Initialization,  , Random Number Functions, Random Number Functions
+@section Random State Initialization
+@cindex Random number state
+
+See @ref{Random Number Functions} for a discussion on how to choose the
+initial seed value passed to these functions.
+
+@deftypefun void gmp_randinit (gmp_randstate_t @var{state}, gmp_randalg_t @var{alg}, ...)
+Initialize random state variable @var{state}.
+
+@var{alg} denotes what algorithm to use for random number generation.
+Use one of
+@itemize @minus
+@item GMP_RAND_ALG_LC --- Linear congruential.
+
+A fast generator defined by @math{X = (aX + c) mod m}.
+
+A third argument @var{size} of type unsigned long int is required.  @var{size}
+is the size of the largest good quality random number to be generated,
+expressed in number of bits.  If the random generation functions are asked for
+a bigger random number than indicated by this parameter, two or more numbers
+of @var{size} bits will be generated and concatenated, resulting in a ``bad''
+random number.  This can be used to generate big random numbers relatively
+cheap if the quality of randomness isn't of great importance.
+
+a, c, and m are picked from a table where the modulus (m) is a power of 2 and
+the multiplier is congruent to 5 (mod 8).  The choice is based on the
+@var{size} parameter.  The maximum @var{size} supported by this algorithm is
+128.  If you need bigger random numbers, use your own scheme and call one of
+the other @code{gmp_randinit} functions.
+
+@ignore
+@item GMP_RAND_ALG_BBS --- Blum, Blum, and Shub.
+@end ignore
+@end itemize
+
+If @var{alg} is 0 or GMP_RAND_ALG_DEFAULT, the default algorithm is used.  The
+default algorithm is typically a fast algorithm like the linear congruential
+and requires a third @var{size} argument (see GMP_RAND_ALG_LC).
+
+When you're done with a @var{state} variable, call @code{gmp_randclear}
+to deallocate any memory allocated by this function.
+
+@code{gmp_randinit} may set the following bits in @var{gmp_errno}:
+@c FIXME: gmp_errno is printed in uppercase.  That's wrong.
+@itemize
+@item GMP_ERROR_UNSUPPORTED_ARGUMENT --- @var{alg} is unsupported
+@item GMP_ERROR_INVALID_ARGUMENT --- @var{size} is too big
+@end itemize
+@end deftypefun
+
+
+@ignore
+@deftypefun void gmp_randinit_lc (gmp_randstate_t @var{state}, mpz_t @var{a},
+unsigned long int @var{c}, mpz_t @var{m})
+
+Initialize random state variable @var{state} with given linear congruential
+scheme.
+
+Parameters @var{a}, @var{c}, and @var{m} are the multiplier, adder, and modulus
+for the linear congruential scheme to use, respectively.
+
+When you're done with a @var{state} variable, call @code{gmp_randclear}
+to deallocate any memory allocated by this function.
+@end deftypefun
+@end ignore
+
+@deftypefun void gmp_randinit_lc_2exp (gmp_randstate_t @var{state}, mpz_t @var{a},
+unsigned long int @var{c}, unsigned long int @var{m2exp})
+
+Initialize random state variable @var{state} with given linear congruential
+scheme.
+
+Parameters @var{a}, @var{c}, and @var{m2exp} are the multiplier, adder, and
+modulus for the linear congruential scheme to use, respectively.  The modulus
+is expressed as a power of 2, so that
+@ifnottex
+@var{m} = 2^@var{m2exp}.
+@end ifnottex
+@tex
+$m = 2^{m2exp}$.
+@end tex
+
+The least significant bits of a random number generated by the linear
+congruential algorithm where the modulus is a power of two are not very random.
+Therefore, the lower half of a random number generated by an LC scheme
+initialized with this function is discarded.  Thus, the size of a random number
+is @var{m2exp} / 2 (rounded upwards) bits when this function has been used for
+initializing the random state.
+
+When you're done with a @var{state} variable, call @code{gmp_randclear}
+to deallocate any memory allocated by this function.
+@end deftypefun
+
+@deftypefun void gmp_randseed (gmp_randstate_t @var{state}, mpz_t @var{seed})
+@deftypefunx void gmp_randseed_ui (gmp_randstate_t @var{state}, unsigned long int @var{seed})
+
+Set the initial seed value.
+
+Parameter @var{seed} is the initial random seed.  The function
+@code{gmp_randseed_ui} takes the @var{seed} as an unsigned long int rather
+than as an mpz_t.
+@end deftypefun
+
+@deftypefun void gmp_randclear (gmp_randstate_t @var{state})
+Free all memory occupied by @var{state}.  Make sure to call this
+function for all @code{gmp_randstate_t} variables when you are done with
+them.
+@end deftypefun
+
+@node BSD Compatible Functions, Custom Allocation, Random Number Functions, Top
+@comment  node-name,  next,  previous,  up
+@chapter Berkeley MP Compatible Functions
+@cindex Berkeley MP compatible functions
+@cindex BSD MP compatible functions
+
+These functions are intended to be fully compatible with the Berkeley MP
+library which is available on many BSD derived U*ix systems.  The
+@samp{--enable-mpbsd} option must be used when building GNU MP to make these
+available (@pxref{Installing GMP}).
+
+The original Berkeley MP library has a usage restriction: you cannot use the
+same variable as both source and destination in a single function call.  The
+compatible functions in GNU MP do not share this restriction---inputs and
+outputs may overlap.
+
+It is not recommended that new programs are written using these functions.
+Apart from the incomplete set of functions, the interface for initializing
+@code{MINT} objects is more error prone, and the @code{pow} function collides
+with @code{pow} in @file{libm.a}.
+
+@cindex @file{mp.h}
+Include the header @file{mp.h} to get the definition of the necessary types
+and functions.  If you are on a BSD derived system, make sure to include GNU
+@file{mp.h} if you are going to link the GNU @file{libmp.a} to your program.
+This means that you probably need to give the -I<dir> option to the compiler,
+where <dir> is the directory where you have GNU @file{mp.h}.
+
+@deftypefun {MINT *} itom (signed short int @var{initial_value})
+Allocate an integer consisting of a @code{MINT} object and dynamic limb space.
+Initialize the integer to @var{initial_value}.  Return a pointer to the
+@code{MINT} object.
+@end deftypefun
+
+@deftypefun {MINT *} xtom (char *@var{initial_value})
+Allocate an integer consisting of a @code{MINT} object and dynamic limb space.
+Initialize the integer from @var{initial_value}, a hexadecimal, '\0'-terminate
+C string.  Return a pointer to the @code{MINT} object.
+@end deftypefun
+
+@deftypefun void move (MINT *@var{src}, MINT *@var{dest})
+Set @var{dest} to @var{src} by copying.  Both variables must be previously
+initialized.
+@end deftypefun
+
+@deftypefun void madd (MINT *@var{src_1}, MINT *@var{src_2}, MINT *@var{destination})
+Add @var{src_1} and @var{src_2} and put the sum in @var{destination}.
+@end deftypefun
+
+@deftypefun void msub (MINT *@var{src_1}, MINT *@var{src_2}, MINT *@var{destination})
+Subtract @var{src_2} from @var{src_1} and put the difference in
+@var{destination}.
+@end deftypefun
+
+@deftypefun void mult (MINT *@var{src_1}, MINT *@var{src_2}, MINT *@var{destination})
+Multiply @var{src_1} and @var{src_2} and put the product in
+@var{destination}.
+@end deftypefun
+
+@deftypefun void mdiv (MINT *@var{dividend}, MINT *@var{divisor}, MINT *@var{quotient}, MINT *@var{remainder})
+@deftypefunx void sdiv (MINT *@var{dividend}, signed short int @var{divisor}, MINT *@var{quotient}, signed short int *@var{remainder})
+Set @var{quotient} to @var{dividend}/@var{divisor}, and @var{remainder} to
+@var{dividend} mod @var{divisor}.  The quotient is rounded towards zero; the
+remainder has the same sign as the dividend unless it is zero.
+
+Some implementations of these functions work differently---or not at all---for
+negative arguments.
+@end deftypefun
+
+@deftypefun void msqrt (MINT *@var{operand}, MINT *@var{root}, MINT *@var{remainder})
+@ifnottex
+Set @var{root} to the truncated integer part of the square root of
+@var{operand}.  Set @var{remainder} to
+@var{operand}@minus{}@var{root}*@var{root},
+@end ifnottex
+@tex
+Set @var{root} to $\lfloor\sqrt{@var{operand}}\rfloor$, like
+@code{mpz_sqrt}.  Set @var{remainder} to $(operand - root^2)$,
+@end tex
+(i.e., zero if @var{operand} is a perfect square).
+
+If @var{root} and @var{remainder} are the same variable, the results are
+undefined.
+@end deftypefun
+
+@deftypefun void pow (MINT *@var{base}, MINT *@var{exp}, MINT *@var{mod}, MINT *@var{dest})
+Set @var{dest} to (@var{base} raised to @var{exp}) modulo @var{mod}.
+@end deftypefun
+
+@deftypefun void rpow (MINT *@var{base}, signed short int @var{exp}, MINT *@var{dest})
+Set @var{dest} to @var{base} raised to @var{exp}.
+@end deftypefun
+
+@deftypefun void gcd (MINT *@var{operand1}, MINT *@var{operand2}, MINT *@var{res})
+Set @var{res} to the greatest common divisor of @var{operand1} and
+@var{operand2}.
+@end deftypefun
+
+@deftypefun int mcmp (MINT *@var{operand1}, MINT *@var{operand2})
+Compare @var{operand1} and @var{operand2}.  Return a positive value if
+@var{operand1} > @var{operand2}, zero if @var{operand1} =
+@var{operand2}, and a negative value if @var{operand1} < @var{operand2}.
+@end deftypefun
+
+@deftypefun void min (MINT *@var{dest})
+Input a decimal string from @code{stdin}, and put the read integer in
+@var{dest}.  SPC and TAB are allowed in the number string, and are ignored.
+@end deftypefun
+
+@deftypefun void mout (MINT *@var{src})
+Output @var{src} to @code{stdout}, as a decimal string.  Also output a newline.
+@end deftypefun
+
+@deftypefun {char *} mtox (MINT *@var{operand})
+Convert @var{operand} to a hexadecimal string, and return a pointer to the
+string.  The returned string is allocated using the default memory allocation
+function, @code{malloc} by default.
+@end deftypefun
+
+@deftypefun void mfree (MINT *@var{operand})
+De-allocate, the space used by @var{operand}.  @strong{This function should
+only be passed a value returned by @code{itom} or @code{xtom}.}
+@end deftypefun
+
+
+@node Custom Allocation, Contributors, BSD Compatible Functions, Top
+@comment  node-name,  next,  previous,  up
+@chapter Custom Allocation
+@cindex Custom allocation
+@cindex Memory allocation
+@cindex Allocation of memory
+
+By default, GMP uses @code{malloc}, @code{realloc} and @code{free} for memory
+allocation.  If @code{malloc} or @code{realloc} fails, GMP prints a message to
+the standard error output and terminates execution.
+
+Some applications might want to allocate memory in other ways, or might not
+want a fatal error when there is no more memory available.  To accomplish
+this, you can specify alternative memory allocation functions.
+
+This can be done in the Berkeley compatibility library as well as the main GMP
+library.
+
+@deftypefun void mp_set_memory_functions (@* void *(*@var{alloc_func_ptr}) (size_t), @* void *(*@var{realloc_func_ptr}) (void *, size_t, size_t), @* void (*@var{free_func_ptr}) (void *, size_t))
+Replace the current allocation functions from the arguments.  If an argument
+is @code{NULL}, the corresponding default function is retained.
+
+@strong{Be sure to call this function only when there are no active GMP
+objects allocated using the previous memory functions!  Usually, that means
+that you have to call this function before any other GMP function.}
+@end deftypefun
+
+The functions you supply should fit the following declarations:
+
+@deftypefun {void *} allocate_function (size_t @var{alloc_size})
+This function should return a pointer to newly allocated space with at least
+@var{alloc_size} storage units.
+@end deftypefun
+
+@deftypefun {void *} reallocate_function (void *@var{ptr}, size_t @var{old_size}, size_t @var{new_size})
+This function should return a pointer to newly allocated space of at least
+@var{new_size} storage units, after copying at least the first @var{old_size}
+storage units from @var{ptr}.  It should also de-allocate the space at
+@var{ptr}.
+
+You can assume that the space at @var{ptr} was formerly returned from
+@code{allocate_function} or @code{reallocate_function}, for a request for
+@var{old_size} storage units.
+@end deftypefun
+
+@deftypefun void deallocate_function (void *@var{ptr}, size_t @var{size})
+De-allocate the space pointed to by @var{ptr}.
+
+You can assume that the space at @var{ptr} was formerly returned from
+@code{allocate_function} or @code{reallocate_function}, for a request for
+@var{size} storage units.
+@end deftypefun
+
+(A @dfn{storage unit} is the unit in which the @code{sizeof} operator returns
+the size of an object, normally an 8 bit byte.)
+
+
+@node Contributors, References, Custom Allocation, Top
+@comment  node-name,  next,  previous,  up
+@unnumbered Contributors
+@cindex Contributors
+
+Torbjorn Granlund wrote the original GMP library and is still developing and
+maintaining it.  Several other individuals and organizations have contributed
+to GMP in various ways.  Here is a list in chronological order:
+
+Gunnar Sjoedin and Hans Riesel helped with mathematical problems in early
+versions of the library.
+
+Richard Stallman contributed to the interface design and revised the first
+version of this manual.
+
+Brian Beuning and Doug Lea helped with testing of early versions of the
+library and made creative suggestions.
+
+John Amanatides of York University in Canada contributed the function
+@code{mpz_probab_prime_p}.
+
+Paul Zimmermann of Inria sparked the development of GMP 2, with his
+comparisons between bignum packages.
+
+Ken Weber (Kent State University, Universidade Federal do Rio Grande do Sul)
+contributed @code{mpz_gcd}, @code{mpz_divexact}, @code{mpn_gcd}, and
+@code{mpn_bdivmod}, partially supported by CNPq (Brazil) grant 301314194-2.
+
+Per Bothner of Cygnus Support helped to set up GMP to use Cygnus' configure.
+He has also made valuable suggestions and tested numerous intermediary
+releases.
+
+Joachim Hollman was involved in the design of the @code{mpf} interface, and in
+the @code{mpz} design revisions for version 2.
+
+Bennet Yee contributed the functions @code{mpz_jacobi} and @code{mpz_legendre}.
+
+Andreas Schwab contributed the files @file{mpn/m68k/lshift.S} and
+@file{mpn/m68k/rshift.S}.
+
+The development of floating point functions of GNU MP 2, were supported in part
+by the ESPRIT-BRA (Basic Research Activities) 6846 project POSSO (POlynomial
+System SOlving).
+
+GNU MP 2 was finished and released by SWOX AB (formerly known as TMG
+Datakonsult), Swedenborgsgatan 23, SE-118 27 STOCKHOLM, SWEDEN, in
+cooperation with the IDA Center for Computing Sciences, USA.
+
+Robert Harley of Inria, France and David Seal of ARM, England, suggested clever
+improvements for population count.
+
+Robert Harley also wrote highly optimized Karatsuba and 3-way Toom
+multiplication functions for GMP 3.  He also contributed the ARM assembly
+code.
+
+Torsten Ekedahl of the Mathematical department of Stockholm University provided
+significant inspiration during several phases of the GMP development.  His
+mathematical expertise helped improve several algorithms.
+
+Paul Zimmermann wrote the Burnikel-Ziegler division code, the REDC code, the
+REDC-based mpz_powm code, and the FFT multiply code.  The ECMNET project Paul
+is organizing has been a driving force behind many of the optimization of GMP
+3.
+
+Linus Nordberg wrote the new configure system based on autoconf and
+implemented the new random functions.
+
+Kent Boortz made the Macintosh port.
+
+Kevin Ryde wrote a lot of very high quality x86 code, optimized for most CPU
+variants.  He also made countless other valuable contributions.
+
+Steve Root helped write the optimized alpha 21264 assembly code.
+
+GNU MP 3.1 was finished and released by Torbjorn Granlund and Kevin Ryde.
+Torbjorn's work was partially funded by the IDA Center for Computing Sciences,
+USA.
+
+(This list is chronological, not ordered after significance.  If you have
+contributed to GMP but are not listed above, please tell @email{tege@@swox.com}
+about the omission!)
+
+@node References, Concept Index, Contributors, Top
+@comment  node-name,  next,  previous,  up
+@unnumbered References
+@cindex References
+
+@itemize @bullet
+
+@item
+Donald E. Knuth, "The Art of Computer Programming", vol 2,
+"Seminumerical Algorithms", 3rd edition, Addison-Wesley, 1988.
+
+@item
+John D. Lipson, "Elements of Algebra and Algebraic Computing",
+The Benjamin Cummings Publishing Company Inc, 1981.
+
+@item
+Richard M. Stallman, "Using and Porting GCC", Free Software Foundation, 1999,
+available online @uref{http://www.gnu.org/software/gcc/onlinedocs/}, and in
+the GCC package @uref{ftp://ftp.gnu.org/pub/gnu/gcc/}.
+
+@item
+Peter L. Montgomery, "Modular Multiplication Without Trial Division", in
+Mathematics of Computation, volume 44, number 170, April 1985.
+
+@item
+Torbjorn Granlund and Peter L. Montgomery, "Division by Invariant
+Integers using Multiplication", in Proceedings of the SIGPLAN
+PLDI'94 Conference, June 1994.  Available online, @*
+@uref{ftp://ftp.cwi.nl/pub/pmontgom/divcnst.psa4.gz} (and .psl.gz too).
+
+@item
+Tudor Jebelean,
+"An algorithm for exact division",
+Journal of Symbolic Computation,
+v. 15, 1993, pp. 169-180.
+Research report version available online @*
+@uref{ftp://ftp.risc.uni-linz.ac.at/pub/techreports/1992/92-35.ps.gz}
+
+@item
+Kenneth Weber, "The accelerated integer GCD algorithm",
+ACM Transactions on Mathematical Software,
+v. 21 (March), 1995, pp. 111-122.
+
+@item
+Christoph Burnikel and Joachim Ziegler, "Fast Recursive Division",
+Max-Planck-Institut fuer Informatik Research Report MPI-I-98-1-022, @*
+@uref{http://www.mpi-sb.mpg.de/~ziegler/TechRep.ps.gz}.
+
+@item
+Alfred J. Menezes, Paul C. van Oorschot and Scott A. Vanstone, "Handbook of
+Applied Cryptography", @uref{http://cacr.math.uwaterloo.ca/hac/}.
+
+@item
+Henri Cohen, "A Course in Computational Algebraic Number Theory", Graduate
+Texts in Mathematics number 138, Springer-Verlag, 1993.  Errata available
+online @* @uref{http://www.math.u-bordeaux.fr/~cohen}
+@end itemize
+
+@node Concept Index, Function Index, References, Top
+@comment  node-name,  next,  previous,  up
+@unnumbered Concept Index
+@printindex cp
+
+@node Function Index,  , Concept Index, Top
+@comment  node-name,  next,  previous,  up
+@unnumbered Function and Type Index
+@printindex fn
+
+
+@contents
+@bye
+
+@c Local variables:
+@c fill-column: 78
+@c End:
diff --git a/src/gmp/insert-dbl.c b/src/gmp/insert-dbl.c
new file mode 100644
index 000000000..dc88a56f6
--- /dev/null
+++ b/src/gmp/insert-dbl.c
@@ -0,0 +1,98 @@
+/* __gmp_insert_double -- convert from array of mp_limb_t to double.
+
+Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#ifdef XDEBUG
+#undef _GMP_IEEE_FLOATS
+#endif
+
+#ifndef _GMP_IEEE_FLOATS
+#define _GMP_IEEE_FLOATS 0
+#endif
+
+double
+#if __STDC__
+__gmp_scale2 (double d, int exp)
+#else
+__gmp_scale2 (d, exp)
+     double d;
+     int exp;
+#endif
+{
+#if _GMP_IEEE_FLOATS
+  {
+#if defined (__alpha) && __GNUC__ == 2 && __GNUC_MINOR__ == 8
+    /* Work around alpha-specific bug in GCC 2.8.x.  */
+    volatile
+#endif
+    union ieee_double_extract x;
+    x.d = d;
+    exp += x.s.exp;
+    x.s.exp = exp;
+    if (exp >= 2047)
+      {
+	/* Return +-infinity */
+	x.s.exp = 2047;
+	x.s.manl = x.s.manh = 0;
+      }
+    else if (exp < 1)
+      {
+	x.s.exp = 1;		/* smallest exponent (biased) */
+	/* Divide result by 2 until we have scaled it to the right IEEE
+	   denormalized number, but stop if it becomes zero.  */
+	while (exp < 1 && x.d != 0)
+	  {
+	    x.d *= 0.5;
+	    exp++;
+	  }
+      }
+    return x.d;
+  }
+#else
+  {
+    double factor, r;
+
+    factor = 2.0;
+    if (exp < 0)
+      {
+	factor = 0.5;
+	exp = -exp;
+      }
+    r = d;
+    if (exp != 0)
+      {
+	if ((exp & 1) != 0)
+	  r *= factor;
+	exp >>= 1;
+	while (exp != 0)
+	  {
+	    factor *= factor;
+	    if ((exp & 1) != 0)
+	      r *= factor;
+	    exp >>= 1;
+	  }
+      }
+    return r;
+  }
+#endif
+}
diff --git a/src/gmp/install-sh b/src/gmp/install-sh
new file mode 100755
index 000000000..e9de23842
--- /dev/null
+++ b/src/gmp/install-sh
@@ -0,0 +1,251 @@
+#!/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=:
+		chmodcmd=""
+	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/src/gmp/longlong.h b/src/gmp/longlong.h
new file mode 100644
index 000000000..9869e01cc
--- /dev/null
+++ b/src/gmp/longlong.h
@@ -0,0 +1,1347 @@
+/* longlong.h -- definitions for mixed size 32/64 bit arithmetic.
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996, 1997, 1999, 2000 Free Software
+Foundation, Inc.
+
+This file is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+This 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 Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with this file; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/* You have to define the following before including this file:
+
+   UWtype -- An unsigned type, default type for operations (typically a "word")
+   UHWtype -- An unsigned type, at least half the size of UWtype.
+   UDWtype -- An unsigned type, at least twice as large a UWtype
+   W_TYPE_SIZE -- size in bits of UWtype
+
+   SItype, USItype -- Signed and unsigned 32 bit types.
+   DItype, UDItype -- Signed and unsigned 64 bit types.
+
+   On a 32 bit machine UWtype should typically be USItype;
+   on a 64 bit machine, UWtype should typically be UDItype.
+*/
+
+#define __BITS4 (W_TYPE_SIZE / 4)
+#define __ll_B ((UWtype) 1 << (W_TYPE_SIZE / 2))
+#define __ll_lowpart(t) ((UWtype) (t) & (__ll_B - 1))
+#define __ll_highpart(t) ((UWtype) (t) >> (W_TYPE_SIZE / 2))
+
+/* This is used to make sure no undesirable sharing between different libraries
+   that use this file takes place.  */
+#ifndef __MPN
+#define __MPN(x) __##x
+#endif
+
+#ifndef _PROTO
+#if (__STDC__-0) || defined (__cplusplus)
+#define _PROTO(x) x
+#else
+#define _PROTO(x) ()
+#endif
+#endif
+
+/* Define auxiliary asm macros.
+
+   1) umul_ppmm(high_prod, low_prod, multipler, multiplicand) multiplies two
+   UWtype integers MULTIPLER and MULTIPLICAND, and generates a two UWtype
+   word product in HIGH_PROD and LOW_PROD.
+
+   2) __umulsidi3(a,b) multiplies two UWtype integers A and B, and returns a
+   UDWtype product.  This is just a variant of umul_ppmm.
+
+   3) udiv_qrnnd(quotient, remainder, high_numerator, low_numerator,
+   denominator) divides a UDWtype, composed by the UWtype integers
+   HIGH_NUMERATOR and LOW_NUMERATOR, by DENOMINATOR and places the quotient
+   in QUOTIENT and the remainder in REMAINDER.  HIGH_NUMERATOR must be less
+   than DENOMINATOR for correct operation.  If, in addition, the most
+   significant bit of DENOMINATOR must be 1, then the pre-processor symbol
+   UDIV_NEEDS_NORMALIZATION is defined to 1.
+
+   4) sdiv_qrnnd(quotient, remainder, high_numerator, low_numerator,
+   denominator).  Like udiv_qrnnd but the numbers are signed.  The quotient
+   is rounded towards 0.
+
+   5) count_leading_zeros(count, x) counts the number of zero-bits from the
+   msb to the first non-zero bit in the UWtype X.  This is the number of
+   steps X needs to be shifted left to set the msb.  Undefined for X == 0,
+   unless the symbol COUNT_LEADING_ZEROS_0 is defined to some value.
+
+   6) count_trailing_zeros(count, x) like count_leading_zeros, but counts
+   from the least significant end.
+
+   7) add_ssaaaa(high_sum, low_sum, high_addend_1, low_addend_1,
+   high_addend_2, low_addend_2) adds two UWtype integers, composed by
+   HIGH_ADDEND_1 and LOW_ADDEND_1, and HIGH_ADDEND_2 and LOW_ADDEND_2
+   respectively.  The result is placed in HIGH_SUM and LOW_SUM.  Overflow
+   (i.e. carry out) is not stored anywhere, and is lost.
+
+   8) sub_ddmmss(high_difference, low_difference, high_minuend, low_minuend,
+   high_subtrahend, low_subtrahend) subtracts two two-word UWtype integers,
+   composed by HIGH_MINUEND_1 and LOW_MINUEND_1, and HIGH_SUBTRAHEND_2 and
+   LOW_SUBTRAHEND_2 respectively.  The result is placed in HIGH_DIFFERENCE
+   and LOW_DIFFERENCE.  Overflow (i.e. carry out) is not stored anywhere,
+   and is lost.
+
+   If any of these macros are left undefined for a particular CPU,
+   C macros are used.  */
+
+/* The CPUs come in alphabetical order below.
+
+   Please add support for more CPUs here, or improve the current support
+   for the CPUs below!  */
+
+#if defined (__alpha) && W_TYPE_SIZE == 64
+#if defined (__GNUC__)
+#define umul_ppmm(ph, pl, m0, m1) \
+  do {									\
+    UDItype __m0 = (m0), __m1 = (m1);					\
+    __asm__ ("umulh %r1,%2,%0"						\
+	     : "=r" (ph)						\
+	     : "%rJ" (m0), "rI" (m1));					\
+    (pl) = __m0 * __m1;							\
+  } while (0)
+#define UMUL_TIME 18
+#ifndef LONGLONG_STANDALONE
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  do { UDItype __di;							\
+    __di = __MPN(invert_limb) (d);					\
+    udiv_qrnnd_preinv (q, r, n1, n0, d, __di);				\
+  } while (0)
+#define UDIV_NEEDS_NORMALIZATION 1
+#define UDIV_TIME 220
+long __MPN(count_leading_zeros) ();
+#define count_leading_zeros(count, x) \
+  ((count) = __MPN(count_leading_zeros) (x))
+#endif /* LONGLONG_STANDALONE */
+#else /* ! __GNUC__ */
+#include <machine/builtins.h>
+#define umul_ppmm(ph, pl, m0, m1) \
+  do {									\
+    UDItype __m0 = (m0), __m1 = (m1);					\
+    (ph) = __UMULH (m0, m1);						\
+    (pl) = __m0 * __m1;							\
+  } while (0)
+#endif
+#endif /* __alpha */
+
+#if defined (__hppa) && W_TYPE_SIZE == 64
+/* We put the result pointer parameter last here, since it makes passing
+   of the other parameters more efficient.  */
+#ifndef LONGLONG_STANDALONE
+#define umul_ppmm(wh, wl, u, v) \
+  do {									\
+    UDItype __p0;							\
+    (wh) = __MPN(umul_ppmm) (u, v, &__p0);				\
+    (wl) = __p0;							\
+  } while (0)
+extern UDItype __MPN(umul_ppmm) _PROTO ((UDItype, UDItype, UDItype *));
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  do { UDItype __r;							\
+    (q) = __MPN(udiv_qrnnd) (n1, n0, d, &__r);				\
+    (r) = __r;								\
+  } while (0)
+extern UDItype __MPN(udiv_qrnnd) _PROTO ((UDItype, UDItype, UDItype, UDItype *));
+#define UMUL_TIME 8
+#define UDIV_TIME 60
+#endif /* LONGLONG_STANDALONE */
+#endif /* hppa */
+
+#if defined (__ia64) && W_TYPE_SIZE == 64
+#if defined (__GNUC__)
+#define umul_ppmm(ph, pl, m0, m1) \
+  do {									\
+    UDItype __m0 = (m0), __m1 = (m1);					\
+    __asm__ ("xma.hu %0 = %1, %2, f0"					\
+	     : "=e" (ph)						\
+	     : "e" (m0), "e" (m1));					\
+    (pl) = __m0 * __m1;							\
+  } while (0)
+#endif
+#endif
+
+
+#if defined (__GNUC__) && !defined (NO_ASM)
+
+/* We sometimes need to clobber "cc" with gcc2, but that would not be
+   understood by gcc1.  Use cpp to avoid major code duplication.  */
+#if __GNUC__ < 2
+#define __CLOBBER_CC
+#define __AND_CLOBBER_CC
+#else /* __GNUC__ >= 2 */
+#define __CLOBBER_CC : "cc"
+#define __AND_CLOBBER_CC , "cc"
+#endif /* __GNUC__ < 2 */
+
+#if (defined (__a29k__) || defined (_AM29K)) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("add %1,%4,%5\n\taddc %0,%2,%3"				\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "%r" (ah), "rI" (bh), "%r" (al), "rI" (bl))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("sub %1,%4,%5\n\tsubc %0,%2,%3"				\
+	   : "=r" (sh),	"=&r" (sl)					\
+	   : "r" (ah), "rI" (bh), "r" (al), "rI" (bl))
+#define umul_ppmm(xh, xl, m0, m1) \
+  do {									\
+    USItype __m0 = (m0), __m1 = (m1);					\
+    __asm__ ("multiplu %0,%1,%2"					\
+	     : "=r" (xl)						\
+	     : "r" (__m0), "r" (__m1));					\
+    __asm__ ("multmu %0,%1,%2"						\
+	     : "=r" (xh)						\
+	     : "r" (__m0), "r" (__m1));					\
+  } while (0)
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  __asm__ ("dividu %0,%3,%4"						\
+	   : "=r" (q), "=q" (r)						\
+	   : "1" (n1), "r" (n0), "r" (d))
+#define count_leading_zeros(count, x) \
+    __asm__ ("clz %0,%1"						\
+	     : "=r" (count)						\
+	     : "r" (x))
+#define COUNT_LEADING_ZEROS_0 32
+#endif /* __a29k__ */
+
+#if defined (__arm__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("adds\t%1, %4, %5\n\tadc\t%0, %2, %3"			\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "%r" (ah), "rI" (bh), "%r" (al), "rI" (bl))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("subs\t%1, %4, %5\n\tsbc\t%0, %2, %3"			\
+	   : "=r" (sh),	"=&r" (sl)					\
+	   : "r" (ah), "rI" (bh), "r" (al), "rI" (bl))
+#if 1 || defined (__arm_m__)		/* `M' series has widening multiply support */
+#define umul_ppmm(xh, xl, a, b) \
+  __asm__ ("umull %0,%1,%2,%3" : "=&r" (xl), "=&r" (xh) : "r" (a), "r" (b))
+#define smul_ppmm(xh, xl, a, b) \
+  __asm__ ("smull %0,%1,%2,%3" : "=&r" (xl), "=&r" (xh) : "r" (a), "r" (b))
+#define UMUL_TIME 5
+#else
+#define umul_ppmm(xh, xl, a, b) \
+  __asm__ ("%@ Inlined umul_ppmm
+	mov	%|r0, %2, lsr #16
+	mov	%|r2, %3, lsr #16
+	bic	%|r1, %2, %|r0, lsl #16
+	bic	%|r2, %3, %|r2, lsl #16
+	mul	%1, %|r1, %|r2
+	mul	%|r2, %|r0, %|r2
+	mul	%|r1, %0, %|r1
+	mul	%0, %|r0, %0
+	adds	%|r1, %|r2, %|r1
+	addcs	%0, %0, #65536
+	adds	%1, %1, %|r1, lsl #16
+	adc	%0, %0, %|r1, lsr #16"					\
+	   : "=&r" (xh), "=r" (xl)					\
+	   : "r" (a), "r" (b)						\
+	   : "r0", "r1", "r2")
+#define UMUL_TIME 20
+#endif
+#define UDIV_TIME 100
+#endif /* __arm__ */
+
+#if defined (__clipper__) && W_TYPE_SIZE == 32
+#define umul_ppmm(w1, w0, u, v) \
+  ({union {UDItype __ll;						\
+	   struct {USItype __l, __h;} __i;				\
+	  } __x;							\
+  __asm__ ("mulwux %2,%0"						\
+	   : "=r" (__x.__ll)						\
+	   : "%0" ((USItype)(u)), "r" ((USItype)(v)));			\
+  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
+#define smul_ppmm(w1, w0, u, v) \
+  ({union {DItype __ll;							\
+	   struct {SItype __l, __h;} __i;				\
+	  } __x;							\
+  __asm__ ("mulwx %2,%0"						\
+	   : "=r" (__x.__ll)						\
+	   : "%0" ((SItype)(u)), "r" ((SItype)(v)));			\
+  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
+#define __umulsidi3(u, v) \
+  ({UDItype __w;							\
+    __asm__ ("mulwux %2,%0"						\
+	     : "=r" (__w) : "%0" ((USItype)(u)), "r" ((USItype)(v)));	\
+    __w; })
+#endif /* __clipper__ */
+
+/* Fujitsu vector computers.  */
+#if defined (__uxp__) && W_TYPE_SIZE == 32
+#define umul_ppmm(ph, pl, u, v) \
+  do {									\
+    union {UDItype __ll;						\
+	   struct {USItype __h, __l;} __i;				\
+	  } __x;							\
+    __asm__ ("mult.lu %1,%2,%0"	: "=r" (__x.__ll) : "%r" (u), "rK" (v));\
+    (ph) = __x.__i.__h;							\
+    (pl) = __x.__i.__l;							\
+  } while (0)
+#define smul_ppmm(ph, pl, u, v) \
+  do {									\
+    union {UDItype __ll;						\
+	   struct {USItype __h, __l;} __i;				\
+	  } __x;							\
+    __asm__ ("mult.l %1,%2,%0" : "=r" (__x.__ll) : "%r" (u), "rK" (v));	\
+    (ph) = __x.__i.__h;							\
+    (pl) = __x.__i.__l;							\
+  } while (0)
+#endif
+
+#if defined (__gmicro__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("add.w %5,%1\n\taddx %3,%0"					\
+	   : "=g" ((USItype)(sh)), "=&g" ((USItype)(sl))		\
+	   : "%0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
+	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("sub.w %5,%1\n\tsubx %3,%0"					\
+	   : "=g" ((USItype)(sh)), "=&g" ((USItype)(sl))		\
+	   : "0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
+	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
+#define umul_ppmm(ph, pl, m0, m1) \
+  __asm__ ("mulx %3,%0,%1"						\
+	   : "=g" ((USItype)(ph)), "=r" ((USItype)(pl))			\
+	   : "%0" ((USItype)(m0)), "g" ((USItype)(m1)))
+#define udiv_qrnnd(q, r, nh, nl, d) \
+  __asm__ ("divx %4,%0,%1"						\
+	   : "=g" ((USItype)(q)), "=r" ((USItype)(r))			\
+	   : "1" ((USItype)(nh)), "0" ((USItype)(nl)), "g" ((USItype)(d)))
+#define count_leading_zeros(count, x) \
+  __asm__ ("bsch/1 %1,%0"						\
+	   : "=g" (count) : "g" ((USItype)(x)), "0" ((USItype)0))
+#endif
+
+#if defined (__hppa) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("add %4,%5,%1\n\taddc %2,%3,%0"				\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "%rM" (ah), "rM" (bh), "%rM" (al), "rM" (bl))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("sub %4,%5,%1\n\tsubb %2,%3,%0"				\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "rM" (ah), "rM" (bh), "rM" (al), "rM" (bl))
+#if defined (_PA_RISC1_1)
+#define umul_ppmm(wh, wl, u, v) \
+  do {									\
+    union {UDItype __ll;						\
+	   struct {USItype __h, __l;} __i;				\
+	  } __x;							\
+    __asm__ ("xmpyu %1,%2,%0" : "=*f" (__x.__ll) : "*f" (u), "*f" (v));	\
+    (wh) = __x.__i.__h;							\
+    (wl) = __x.__i.__l;							\
+  } while (0)
+#define UMUL_TIME 8
+#define UDIV_TIME 60
+#else
+#define UMUL_TIME 40
+#define UDIV_TIME 80
+#endif
+#ifndef LONGLONG_STANDALONE
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  do { USItype __r;							\
+    (q) = __MPN(udiv_qrnnd) (&__r, (n1), (n0), (d));			\
+    (r) = __r;								\
+  } while (0)
+extern USItype __MPN(udiv_qrnnd) _PROTO ((USItype *, USItype, USItype, USItype));
+#endif /* LONGLONG_STANDALONE */
+#define count_leading_zeros(count, x) \
+  do {									\
+    USItype __tmp;							\
+    __asm__ (								\
+       "ldi		1,%0
+	extru,=		%1,15,16,%%r0		; Bits 31..16 zero?
+	extru,tr	%1,15,16,%1		; No.  Shift down, skip add.
+	ldo		16(%0),%0		; Yes.  Perform add.
+	extru,=		%1,23,8,%%r0		; Bits 15..8 zero?
+	extru,tr	%1,23,8,%1		; No.  Shift down, skip add.
+	ldo		8(%0),%0		; Yes.  Perform add.
+	extru,=		%1,27,4,%%r0		; Bits 7..4 zero?
+	extru,tr	%1,27,4,%1		; No.  Shift down, skip add.
+	ldo		4(%0),%0		; Yes.  Perform add.
+	extru,=		%1,29,2,%%r0		; Bits 3..2 zero?
+	extru,tr	%1,29,2,%1		; No.  Shift down, skip add.
+	ldo		2(%0),%0		; Yes.  Perform add.
+	extru		%1,30,1,%1		; Extract bit 1.
+	sub		%0,%1,%0		; Subtract it.
+	" : "=r" (count), "=r" (__tmp) : "1" (x));			\
+  } while (0)
+#endif /* hppa */
+
+#if (defined (__i370__) || defined (__mvs__)) && W_TYPE_SIZE == 32
+#define smul_ppmm(xh, xl, m0, m1) \
+  do {									\
+    union {DItype __ll;							\
+	   struct {USItype __h, __l;} __i;				\
+	  } __x;							\
+    __asm__ ("mr %0,%3"							\
+	     : "=r" (__x.__i.__h), "=r" (__x.__i.__l)			\
+	     : "%1" (m0), "r" (m1));					\
+    (xh) = __x.__i.__h; (xl) = __x.__i.__l;				\
+  } while (0)
+#define sdiv_qrnnd(q, r, n1, n0, d) \
+  do {									\
+    union {DItype __ll;							\
+	   struct {USItype __h, __l;} __i;				\
+	  } __x;							\
+    __x.__i.__h = n1; __x.__i.__l = n0;					\
+    __asm__ ("dr %0,%2"							\
+	     : "=r" (__x.__ll)						\
+	     : "0" (__x.__ll), "r" (d));				\
+    (q) = __x.__i.__l; (r) = __x.__i.__h;				\
+  } while (0)
+#endif
+
+#if (defined (__i386__) || defined (__i486__)) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("addl %5,%1\n\tadcl %3,%0"					\
+	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
+	   : "%0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
+	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("subl %5,%1\n\tsbbl %3,%0"					\
+	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
+	   : "0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
+	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("mull %3"							\
+	   : "=a" (w0), "=d" (w1)					\
+	   : "%0" ((USItype)(u)), "rm" ((USItype)(v)))
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  __asm__ ("divl %4"							\
+	   : "=a" (q), "=d" (r)						\
+	   : "0" ((USItype)(n0)), "1" ((USItype)(n1)), "rm" ((USItype)(d)))
+#define count_leading_zeros(count, x) \
+  do {									\
+    USItype __cbtmp;							\
+    __asm__ ("bsrl %1,%0" : "=r" (__cbtmp) : "rm" ((USItype)(x)));	\
+    (count) = __cbtmp ^ 31;						\
+  } while (0)
+#define count_trailing_zeros(count, x) \
+  __asm__ ("bsfl %1,%0" : "=r" (count) : "rm" ((USItype)(x)))
+#ifndef UMUL_TIME
+#define UMUL_TIME 10
+#endif
+#ifndef UDIV_TIME
+#define UDIV_TIME 40
+#endif
+#endif /* 80x86 */
+
+#if defined (__i860__) && W_TYPE_SIZE == 32
+#define rshift_rhlc(r,h,l,c) \
+  __asm__ ("shr %3,r0,r0\;shrd %1,%2,%0"				\
+	   "=r" (r) : "r" (h), "r" (l), "rn" (c))
+#endif /* i860 */
+
+#if defined (__i960__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("cmpo 1,0\;addc %5,%4,%1\;addc %3,%2,%0"			\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "%dI" (ah), "dI" (bh), "%dI" (al), "dI" (bl))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("cmpo 0,0\;subc %5,%4,%1\;subc %3,%2,%0"			\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "dI" (ah), "dI" (bh), "dI" (al), "dI" (bl))
+#define umul_ppmm(w1, w0, u, v) \
+  ({union {UDItype __ll;						\
+	   struct {USItype __l, __h;} __i;				\
+	  } __x;							\
+  __asm__ ("emul %2,%1,%0"						\
+	   : "=d" (__x.__ll) : "%dI" (u), "dI" (v));			\
+  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
+#define __umulsidi3(u, v) \
+  ({UDItype __w;							\
+    __asm__ ("emul %2,%1,%0" : "=d" (__w) : "%dI" (u), "dI" (v));	\
+    __w; })
+#define udiv_qrnnd(q, r, nh, nl, d) \
+  do {									\
+    union {UDItype __ll;						\
+	   struct {USItype __l, __h;} __i;				\
+	  } __nn;							\
+    __nn.__i.__h = (nh); __nn.__i.__l = (nl);				\
+    __asm__ ("ediv %d,%n,%0"						\
+	   : "=d" (__rq.__ll) : "dI" (__nn.__ll), "dI" (d));		\
+    (r) = __rq.__i.__l; (q) = __rq.__i.__h;				\
+  } while (0)
+#define count_leading_zeros(count, x) \
+  do {									\
+    USItype __cbtmp;							\
+    __asm__ ("scanbit %1,%0" : "=r" (__cbtmp) : "r" (x));		\
+    (count) = __cbtmp ^ 31;						\
+  } while (0)
+#define COUNT_LEADING_ZEROS_0 (-32) /* sic */
+#if defined (__i960mx)		/* what is the proper symbol to test??? */
+#define rshift_rhlc(r,h,l,c) \
+  do {									\
+    union {UDItype __ll;						\
+	   struct {USItype __l, __h;} __i;				\
+	  } __nn;							\
+    __nn.__i.__h = (h); __nn.__i.__l = (l);				\
+    __asm__ ("shre %2,%1,%0" : "=d" (r) : "dI" (__nn.__ll), "dI" (c));	\
+  }
+#endif /* i960mx */
+#endif /* i960 */
+
+#if (defined (__mc68000__) || defined (__mc68020__) || defined(mc68020) \
+     || defined (__m68k__) || defined (__mc5200__) || defined (__mc5206e__) \
+     || defined (__mc5307__)) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("add%.l %5,%1\n\taddx%.l %3,%0"				\
+	   : "=d" ((USItype)(sh)), "=&d" ((USItype)(sl))		\
+	   : "%0" ((USItype)(ah)), "d" ((USItype)(bh)),			\
+	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("sub%.l %5,%1\n\tsubx%.l %3,%0"				\
+	   : "=d" ((USItype)(sh)), "=&d" ((USItype)(sl))		\
+	   : "0" ((USItype)(ah)), "d" ((USItype)(bh)),			\
+	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
+/* The '020, '030, '040 and CPU32 have 32x32->64 and 64/32->32q-32r.  */
+#if defined (__mc68020__) || defined(mc68020) \
+     || defined (__mc68030__) || defined (mc68030) \
+     || defined (__mc68040__) || defined (mc68040) \
+     || defined (__mc68332__) || defined (mc68332) \
+     || defined (__NeXT__)
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("mulu%.l %3,%1:%0"						\
+	   : "=d" ((USItype)(w0)), "=d" ((USItype)(w1))			\
+	   : "%0" ((USItype)(u)), "dmi" ((USItype)(v)))
+#define UMUL_TIME 45
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  __asm__ ("divu%.l %4,%1:%0"						\
+	   : "=d" ((USItype)(q)), "=d" ((USItype)(r))			\
+	   : "0" ((USItype)(n0)), "1" ((USItype)(n1)), "dmi" ((USItype)(d)))
+#define UDIV_TIME 90
+#define sdiv_qrnnd(q, r, n1, n0, d) \
+  __asm__ ("divs%.l %4,%1:%0"						\
+	   : "=d" ((USItype)(q)), "=d" ((USItype)(r))			\
+	   : "0" ((USItype)(n0)), "1" ((USItype)(n1)), "dmi" ((USItype)(d)))
+#else /* for other 68k family members use 16x16->32 multiplication */
+#define umul_ppmm(xh, xl, a, b) \
+  do { USItype __umul_tmp1, __umul_tmp2;				\
+	__asm__ ("| Inlined umul_ppmm
+	move%.l	%5,%3
+	move%.l	%2,%0
+	move%.w	%3,%1
+	swap	%3
+	swap	%0
+	mulu%.w	%2,%1
+	mulu%.w	%3,%0
+	mulu%.w	%2,%3
+	swap	%2
+	mulu%.w	%5,%2
+	add%.l	%3,%2
+	jcc	1f
+	add%.l	%#0x10000,%0
+1:	move%.l	%2,%3
+	clr%.w	%2
+	swap	%2
+	swap	%3
+	clr%.w	%3
+	add%.l	%3,%1
+	addx%.l	%2,%0
+	| End inlined umul_ppmm"					\
+	      : "=&d" ((USItype)(xh)), "=&d" ((USItype)(xl)),		\
+	        "=d" (__umul_tmp1), "=&d" (__umul_tmp2)			\
+	      : "%2" ((USItype)(a)), "d" ((USItype)(b)));		\
+  } while (0)
+#define UMUL_TIME 100
+#define UDIV_TIME 400
+#endif /* not mc68020 */
+/* The '020, '030, '040 and '060 have bitfield insns.  */
+#if defined (__mc68020__) || defined (mc68020) \
+     || defined (__mc68030__) || defined (mc68030) \
+     || defined (__mc68040__) || defined (mc68040) \
+     || defined (__mc68060__) || defined (mc68060) \
+     || defined (__NeXT__)
+#define count_leading_zeros(count, x) \
+  __asm__ ("bfffo %1{%b2:%b2},%0"					\
+	   : "=d" ((USItype) (count))					\
+	   : "od" ((USItype) (x)), "n" (0))
+#define COUNT_LEADING_ZEROS_0 32
+#endif
+#endif /* mc68000 */
+
+#if defined (__m88000__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("addu.co %1,%r4,%r5\n\taddu.ci %0,%r2,%r3"			\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "%rJ" (ah), "rJ" (bh), "%rJ" (al), "rJ" (bl))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("subu.co %1,%r4,%r5\n\tsubu.ci %0,%r2,%r3"			\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "rJ" (ah), "rJ" (bh), "rJ" (al), "rJ" (bl))
+#define count_leading_zeros(count, x) \
+  do {									\
+    USItype __cbtmp;							\
+    __asm__ ("ff1 %0,%1" : "=r" (__cbtmp) : "r" (x));			\
+    (count) = __cbtmp ^ 31;						\
+  } while (0)
+#define COUNT_LEADING_ZEROS_0 63 /* sic */
+#if defined (__m88110__)
+#define umul_ppmm(wh, wl, u, v) \
+  do {									\
+    union {UDItype __ll;						\
+	   struct {USItype __h, __l;} __i;				\
+	  } __x;							\
+    __asm__ ("mulu.d %0,%1,%2" : "=r" (__x.__ll) : "r" (u), "r" (v));	\
+    (wh) = __x.__i.__h;							\
+    (wl) = __x.__i.__l;							\
+  } while (0)
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  ({union {UDItype __ll;						\
+	   struct {USItype __h, __l;} __i;				\
+	  } __x, __q;							\
+  __x.__i.__h = (n1); __x.__i.__l = (n0);				\
+  __asm__ ("divu.d %0,%1,%2"						\
+	   : "=r" (__q.__ll) : "r" (__x.__ll), "r" (d));		\
+  (r) = (n0) - __q.__l * (d); (q) = __q.__l; })
+#define UMUL_TIME 5
+#define UDIV_TIME 25
+#else
+#define UMUL_TIME 17
+#define UDIV_TIME 150
+#endif /* __m88110__ */
+#endif /* __m88000__ */
+
+#if defined (__mips) && W_TYPE_SIZE == 32
+#if __GNUC__ > 2 || __GNUC_MINOR__ >= 7
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("multu %2,%3" : "=l" (w0), "=h" (w1) : "d" (u), "d" (v))
+#else
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("multu %2,%3\n\tmflo %0\n\tmfhi %1"				\
+	   : "=d" (w0), "=d" (w1) : "d" (u), "d" (v))
+#endif
+#define UMUL_TIME 10
+#define UDIV_TIME 100
+#endif /* __mips */
+
+#if (defined (__mips) && __mips >= 3) && W_TYPE_SIZE == 64
+#if __GNUC__ > 2 || __GNUC_MINOR__ >= 7
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("dmultu %2,%3" : "=l" (w0), "=h" (w1) : "d" (u), "d" (v))
+#else
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("dmultu %2,%3\n\tmflo %0\n\tmfhi %1"				\
+	   : "=d" (w0), "=d" (w1) : "d" (u), "d" (v))
+#endif
+#define UMUL_TIME 20
+#define UDIV_TIME 140
+#endif /* __mips */
+
+#if defined (__ns32000__) && W_TYPE_SIZE == 32
+#define umul_ppmm(w1, w0, u, v) \
+  ({union {UDItype __ll;						\
+	   struct {USItype __l, __h;} __i;				\
+	  } __x;							\
+  __asm__ ("meid %2,%0"							\
+	   : "=g" (__x.__ll)						\
+	   : "%0" ((USItype)(u)), "g" ((USItype)(v)));			\
+  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
+#define __umulsidi3(u, v) \
+  ({UDItype __w;							\
+    __asm__ ("meid %2,%0"						\
+	     : "=g" (__w)						\
+	     : "%0" ((USItype)(u)), "g" ((USItype)(v)));		\
+    __w; })
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  ({union {UDItype __ll;						\
+	   struct {USItype __l, __h;} __i;				\
+	  } __x;							\
+  __x.__i.__h = (n1); __x.__i.__l = (n0);				\
+  __asm__ ("deid %2,%0"							\
+	   : "=g" (__x.__ll)						\
+	   : "0" (__x.__ll), "g" ((USItype)(d)));			\
+  (r) = __x.__i.__l; (q) = __x.__i.__h; })
+#define count_trailing_zeros(count,x) \
+  do {									\
+    __asm__ ("ffsd	%2,%0"						\
+	     : "=r" ((USItype) (count))					\
+	     : "0" ((USItype) 0), "r" ((USItype) (x)));			\
+  } while (0)
+#endif /* __ns32000__ */
+
+/* We should test _IBMR2 here when we add assembly support for the system
+   vendor compilers.  */
+#if (defined (_ARCH_PPC) || defined (_ARCH_PWR) || defined (__powerpc__)) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  do {									\
+    if (__builtin_constant_p (bh) && (bh) == 0)				\
+      __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{aze|addze} %0,%2"		\
+	     : "=r" (sh), "=&r" (sl) : "%r" (ah), "%r" (al), "rI" (bl));\
+    else if (__builtin_constant_p (bh) && (bh) == ~(USItype) 0)		\
+      __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{ame|addme} %0,%2"		\
+	     : "=r" (sh), "=&r" (sl) : "%r" (ah), "%r" (al), "rI" (bl));\
+    else								\
+      __asm__ ("{a%I5|add%I5c} %1,%4,%5\n\t{ae|adde} %0,%2,%3"		\
+	     : "=r" (sh), "=&r" (sl)					\
+	     : "%r" (ah), "r" (bh), "%r" (al), "rI" (bl));		\
+  } while (0)
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  do {									\
+    if (__builtin_constant_p (ah) && (ah) == 0)				\
+      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfze|subfze} %0,%2"	\
+	       : "=r" (sh), "=&r" (sl) : "r" (bh), "rI" (al), "r" (bl));\
+    else if (__builtin_constant_p (ah) && (ah) == ~(USItype) 0)		\
+      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfme|subfme} %0,%2"	\
+	       : "=r" (sh), "=&r" (sl) : "r" (bh), "rI" (al), "r" (bl));\
+    else if (__builtin_constant_p (bh) && (bh) == 0)			\
+      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{ame|addme} %0,%2"		\
+	       : "=r" (sh), "=&r" (sl) : "r" (ah), "rI" (al), "r" (bl));\
+    else if (__builtin_constant_p (bh) && (bh) == ~(USItype) 0)		\
+      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{aze|addze} %0,%2"		\
+	       : "=r" (sh), "=&r" (sl) : "r" (ah), "rI" (al), "r" (bl));\
+    else								\
+      __asm__ ("{sf%I4|subf%I4c} %1,%5,%4\n\t{sfe|subfe} %0,%3,%2"	\
+	       : "=r" (sh), "=&r" (sl)					\
+	       : "r" (ah), "r" (bh), "rI" (al), "r" (bl));		\
+  } while (0)
+#define count_leading_zeros(count, x) \
+  __asm__ ("{cntlz|cntlzw} %0,%1" : "=r" (count) : "r" (x))
+#define COUNT_LEADING_ZEROS_0 32
+#if defined (_ARCH_PPC) || defined (__powerpc__)
+#define umul_ppmm(ph, pl, m0, m1) \
+  do {									\
+    USItype __m0 = (m0), __m1 = (m1);					\
+    __asm__ ("mulhwu %0,%1,%2" : "=r" (ph) : "%r" (m0), "r" (m1));	\
+    (pl) = __m0 * __m1;							\
+  } while (0)
+#define UMUL_TIME 15
+#define smul_ppmm(ph, pl, m0, m1) \
+  do {									\
+    SItype __m0 = (m0), __m1 = (m1);					\
+    __asm__ ("mulhw %0,%1,%2" : "=r" (ph) : "%r" (m0), "r" (m1));	\
+    (pl) = __m0 * __m1;							\
+  } while (0)
+#define SMUL_TIME 14
+#define UDIV_TIME 120
+#else
+#define UMUL_TIME 8
+#define smul_ppmm(xh, xl, m0, m1) \
+  __asm__ ("mul %0,%2,%3" : "=r" (xh), "=q" (xl) : "r" (m0), "r" (m1))
+#define SMUL_TIME 4
+#define sdiv_qrnnd(q, r, nh, nl, d) \
+  __asm__ ("div %0,%2,%4" : "=r" (q), "=q" (r) : "r" (nh), "1" (nl), "r" (d))
+#define UDIV_TIME 100
+#endif
+#endif /* 32-bit POWER architecture variants.  */
+
+/* We should test _IBMR2 here when we add assembly support for the system
+   vendor compilers.  */
+#if (defined (_ARCH_PPC) || defined (__powerpc__)) && W_TYPE_SIZE == 64
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  do {									\
+    if (__builtin_constant_p (bh) && (bh) == 0)				\
+      __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{aze|addze} %0,%2"		\
+	     : "=r" (sh), "=&r" (sl) : "%r" (ah), "%r" (al), "rI" (bl));\
+    else if (__builtin_constant_p (bh) && (bh) == ~(UDItype) 0)		\
+      __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{ame|addme} %0,%2"		\
+	     : "=r" (sh), "=&r" (sl) : "%r" (ah), "%r" (al), "rI" (bl));\
+    else								\
+      __asm__ ("{a%I5|add%I5c} %1,%4,%5\n\t{ae|adde} %0,%2,%3"		\
+	     : "=r" (sh), "=&r" (sl)					\
+	     : "%r" (ah), "r" (bh), "%r" (al), "rI" (bl));		\
+  } while (0)
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  do {									\
+    if (__builtin_constant_p (ah) && (ah) == 0)				\
+      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfze|subfze} %0,%2"	\
+	       : "=r" (sh), "=&r" (sl) : "r" (bh), "rI" (al), "r" (bl));\
+    else if (__builtin_constant_p (ah) && (ah) == ~(UDItype) 0)		\
+      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfme|subfme} %0,%2"	\
+	       : "=r" (sh), "=&r" (sl) : "r" (bh), "rI" (al), "r" (bl));\
+    else if (__builtin_constant_p (bh) && (bh) == 0)			\
+      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{ame|addme} %0,%2"		\
+	       : "=r" (sh), "=&r" (sl) : "r" (ah), "rI" (al), "r" (bl));\
+    else if (__builtin_constant_p (bh) && (bh) == ~(UDItype) 0)		\
+      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{aze|addze} %0,%2"		\
+	       : "=r" (sh), "=&r" (sl) : "r" (ah), "rI" (al), "r" (bl));\
+    else								\
+      __asm__ ("{sf%I4|subf%I4c} %1,%5,%4\n\t{sfe|subfe} %0,%3,%2"	\
+	       : "=r" (sh), "=&r" (sl)					\
+	       : "r" (ah), "r" (bh), "rI" (al), "r" (bl));		\
+  } while (0)
+#define count_leading_zeros(count, x) \
+  __asm__ ("cntlzd %0,%1" : "=r" (count) : "r" (x))
+#define COUNT_LEADING_ZEROS_0 64
+#define umul_ppmm(ph, pl, m0, m1) \
+  do {									\
+    UDItype __m0 = (m0), __m1 = (m1);					\
+    __asm__ ("mulhdu %0,%1,%2" : "=r" (ph) : "%r" (m0), "r" (m1));	\
+    (pl) = __m0 * __m1;							\
+  } while (0)
+#define UMUL_TIME 15
+#define smul_ppmm(ph, pl, m0, m1) \
+  do {									\
+    DItype __m0 = (m0), __m1 = (m1);					\
+    __asm__ ("mulhd %0,%1,%2" : "=r" (ph) : "%r" (m0), "r" (m1));	\
+    (pl) = __m0 * __m1;							\
+  } while (0)
+#define SMUL_TIME 14  /* ??? */
+#define UDIV_TIME 120 /* ??? */
+#endif /* 64-bit PowerPC.  */
+
+#if defined (__pyr__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("addw %5,%1\n\taddwc %3,%0"					\
+	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
+	   : "%0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
+	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("subw %5,%1\n\tsubwb %3,%0"					\
+	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
+	   : "0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
+	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
+/* This insn works on Pyramids with AP, XP, or MI CPUs, but not with SP.  */
+#define umul_ppmm(w1, w0, u, v) \
+  ({union {UDItype __ll;						\
+	   struct {USItype __h, __l;} __i;				\
+	  } __x;							\
+  __asm__ ("movw %1,%R0\n\tuemul %2,%0"					\
+	   : "=&r" (__x.__ll)						\
+	   : "g" ((USItype) (u)), "g" ((USItype)(v)));			\
+  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
+#endif /* __pyr__ */
+
+#if defined (__ibm032__) /* RT/ROMP */  && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("a %1,%5\n\tae %0,%3"					\
+	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
+	   : "%0" ((USItype)(ah)), "r" ((USItype)(bh)),			\
+	     "%1" ((USItype)(al)), "r" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("s %1,%5\n\tse %0,%3"					\
+	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
+	   : "0" ((USItype)(ah)), "r" ((USItype)(bh)),			\
+	     "1" ((USItype)(al)), "r" ((USItype)(bl)))
+#define smul_ppmm(ph, pl, m0, m1) \
+  __asm__ (								\
+       "s	r2,r2
+	mts r10,%2
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	m	r2,%3
+	cas	%0,r2,r0
+	mfs	r10,%1"							\
+	   : "=r" ((USItype)(ph)), "=r" ((USItype)(pl))			\
+	   : "%r" ((USItype)(m0)), "r" ((USItype)(m1))			\
+	   : "r2");							\
+#define UMUL_TIME 20
+#define UDIV_TIME 200
+#define count_leading_zeros(count, x) \
+  do {									\
+    if ((x) >= 0x10000)							\
+      __asm__ ("clz	%0,%1"						\
+	       : "=r" ((USItype)(count)) : "r" ((USItype)(x) >> 16));	\
+    else								\
+      {									\
+	__asm__ ("clz	%0,%1"						\
+		 : "=r" ((USItype)(count)) : "r" ((USItype)(x)));	\
+	(count) += 16;							\
+      }									\
+  } while (0)
+#endif /* RT/ROMP */
+
+#if defined (__sh2__) && W_TYPE_SIZE == 32
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("dmulu.l %2,%3\n\tsts macl,%1\n\tsts mach,%0"		\
+	   : "=r" (w1), "=r" (w0) : "r" (u), "r" (v) : "macl", "mach")
+#define UMUL_TIME 5
+#endif
+
+#if defined (__sparc__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("addcc %r4,%5,%1\n\taddx %r2,%3,%0"				\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "%rJ" (ah), "rI" (bh),"%rJ" (al), "rI" (bl)		\
+	   __CLOBBER_CC)
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("subcc %r4,%5,%1\n\tsubx %r2,%3,%0"				\
+	   : "=r" (sh), "=&r" (sl)					\
+	   : "rJ" (ah), "rI" (bh), "rJ" (al), "rI" (bl)	\
+	   __CLOBBER_CC)
+#if defined (__sparc_v9__) || defined (__sparcv9)
+/* Perhaps we should use floating-point operations here?  */
+#if 0
+/* Triggers a bug making mpz/tests/t-gcd.c fail.
+   Perhaps we simply need explicitly zero-extend the inputs?  */
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("mulx %2,%3,%%g1; srl %%g1,0,%1; srlx %%g1,32,%0" :		\
+	   "=r" (w1), "=r" (w0) : "r" (u), "r" (v) : "g1")
+#else
+/* Use v8 umul until above bug is fixed.  */
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("umul %2,%3,%1;rd %%y,%0" : "=r" (w1), "=r" (w0) : "r" (u), "r" (v))
+#endif
+/* Use a plain v8 divide for v9.  */
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  do {									\
+    USItype __q;							\
+    __asm__ ("mov %1,%%y;nop;nop;nop;udiv %2,%3,%0"			\
+	     : "=r" (__q) : "r" (n1), "r" (n0), "r" (d));		\
+    (r) = (n0) - __q * (d);						\
+    (q) = __q;								\
+  } while (0)
+#else
+#if defined (__sparc_v8__)
+/* Don't match immediate range because, 1) it is not often useful,
+   2) the 'I' flag thinks of the range as a 13 bit signed interval,
+   while we want to match a 13 bit interval, sign extended to 32 bits,
+   but INTERPRETED AS UNSIGNED.  */
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("umul %2,%3,%1;rd %%y,%0" : "=r" (w1), "=r" (w0) : "r" (u), "r" (v))
+#define UMUL_TIME 5
+#ifndef SUPERSPARC	/* SuperSPARC's udiv only handles 53 bit dividends */
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  do {									\
+    USItype __q;							\
+    __asm__ ("mov %1,%%y;nop;nop;nop;udiv %2,%3,%0"			\
+	     : "=r" (__q) : "r" (n1), "r" (n0), "r" (d));		\
+    (r) = (n0) - __q * (d);						\
+    (q) = __q;								\
+  } while (0)
+#define UDIV_TIME 25
+#else
+#define UDIV_TIME 60		/* SuperSPARC timing */
+#endif /* SUPERSPARC */
+#else /* ! __sparc_v8__ */
+#if defined (__sparclite__)
+/* This has hardware multiply but not divide.  It also has two additional
+   instructions scan (ffs from high bit) and divscc.  */
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("umul %2,%3,%1;rd %%y,%0" : "=r" (w1), "=r" (w0) : "r" (u), "r" (v))
+#define UMUL_TIME 5
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  __asm__ ("! Inlined udiv_qrnnd
+	wr	%%g0,%2,%%y	! Not a delayed write for sparclite
+	tst	%%g0
+	divscc	%3,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%%g1
+	divscc	%%g1,%4,%0
+	rd	%%y,%1
+	bl,a 1f
+	add	%1,%4,%1
+1:	! End of inline udiv_qrnnd"					\
+	   : "=r" (q), "=r" (r) : "r" (n1), "r" (n0), "rI" (d)
+	   : "%g1" __AND_CLOBBER_CC)
+#define UDIV_TIME 37
+#define count_leading_zeros(count, x) \
+  __asm__ ("scan %1,0,%0" : "=r" (x) : "r" (count))
+/* Early sparclites return 63 for an argument of 0, but they warn that future
+   implementations might change this.  Therefore, leave COUNT_LEADING_ZEROS_0
+   undefined.  */
+#endif /* __sparclite__ */
+#endif /* __sparc_v8__ */
+#endif /* __sparc_v9__ */
+/* Default to sparc v7 versions of umul_ppmm and udiv_qrnnd.  */
+#ifndef umul_ppmm
+#define umul_ppmm(w1, w0, u, v) \
+  __asm__ ("! Inlined umul_ppmm
+	wr	%%g0,%2,%%y	! SPARC has 0-3 delay insn after a wr
+	sra	%3,31,%%g2	! Don't move this insn
+	and	%2,%%g2,%%g2	! Don't move this insn
+	andcc	%%g0,0,%%g1	! Don't move this insn
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,%3,%%g1
+	mulscc	%%g1,0,%%g1
+	add	%%g1,%%g2,%0
+	rd	%%y,%1"							\
+	   : "=r" (w1), "=r" (w0) : "%rI" (u), "r" (v)			\
+	   : "%g1", "%g2" __AND_CLOBBER_CC)
+#define UMUL_TIME 39		/* 39 instructions */
+#endif
+#ifndef udiv_qrnnd
+#ifndef LONGLONG_STANDALONE
+#define udiv_qrnnd(q, r, n1, n0, d) \
+  do { USItype __r;							\
+    (q) = __MPN(udiv_qrnnd) (&__r, (n1), (n0), (d));			\
+    (r) = __r;								\
+  } while (0)
+extern USItype __MPN(udiv_qrnnd) _PROTO ((USItype *, USItype, USItype, USItype));
+#ifndef UDIV_TIME
+#define UDIV_TIME 140
+#endif
+#endif /* LONGLONG_STANDALONE */
+#endif /* udiv_qrnnd */
+#endif /* __sparc__ */
+
+#if defined (__vax__) && W_TYPE_SIZE == 32
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("addl2 %5,%1\n\tadwc %3,%0"					\
+	   : "=g" ((USItype)(sh)), "=&g" ((USItype)(sl))		\
+	   : "%0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
+	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("subl2 %5,%1\n\tsbwc %3,%0"					\
+	   : "=g" ((USItype)(sh)), "=&g" ((USItype)(sl))		\
+	   : "0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
+	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
+#define smul_ppmm(xh, xl, m0, m1) \
+  do {									\
+    union {UDItype __ll;						\
+	   struct {USItype __l, __h;} __i;				\
+	  } __x;							\
+    USItype __m0 = (m0), __m1 = (m1);					\
+    __asm__ ("emul %1,%2,$0,%0"						\
+	     : "=g" (__x.__ll) : "g" (__m0), "g" (__m1));		\
+    (xh) = __x.__i.__h; (xl) = __x.__i.__l;				\
+  } while (0)
+#define sdiv_qrnnd(q, r, n1, n0, d) \
+  do {									\
+    union {DItype __ll;							\
+	   struct {SItype __l, __h;} __i;				\
+	  } __x;							\
+    __x.__i.__h = n1; __x.__i.__l = n0;					\
+    __asm__ ("ediv %3,%2,%0,%1"						\
+	     : "=g" (q), "=g" (r) : "g" (__x.__ll), "g" (d));		\
+  } while (0)
+#endif /* __vax__ */
+
+#if defined (__z8000__) && W_TYPE_SIZE == 16
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  __asm__ ("add	%H1,%H5\n\tadc	%H0,%H3"				\
+	   : "=r" ((unsigned int)(sh)), "=&r" ((unsigned int)(sl))	\
+	   : "%0" ((unsigned int)(ah)), "r" ((unsigned int)(bh)),	\
+	     "%1" ((unsigned int)(al)), "rQR" ((unsigned int)(bl)))
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  __asm__ ("sub	%H1,%H5\n\tsbc	%H0,%H3"				\
+	   : "=r" ((unsigned int)(sh)), "=&r" ((unsigned int)(sl))	\
+	   : "0" ((unsigned int)(ah)), "r" ((unsigned int)(bh)),	\
+	     "1" ((unsigned int)(al)), "rQR" ((unsigned int)(bl)))
+#define umul_ppmm(xh, xl, m0, m1) \
+  do {									\
+    union {long int __ll;						\
+	   struct {unsigned int __h, __l;} __i;				\
+	  } __x;							\
+    unsigned int __m0 = (m0), __m1 = (m1);				\
+    __asm__ ("mult	%S0,%H3"					\
+	     : "=r" (__x.__i.__h), "=r" (__x.__i.__l)			\
+	     : "%1" (m0), "rQR" (m1));					\
+    (xh) = __x.__i.__h; (xl) = __x.__i.__l;				\
+    (xh) += ((((signed int) __m0 >> 15) & __m1)				\
+	     + (((signed int) __m1 >> 15) & __m0));			\
+  } while (0)
+#endif /* __z8000__ */
+
+#endif /* __GNUC__ */
+
+
+#if !defined (umul_ppmm) && defined (__umulsidi3)
+#define umul_ppmm(ph, pl, m0, m1) \
+  {									\
+    UDWtype __ll = __umulsidi3 (m0, m1);				\
+    ph = (UWtype) (__ll >> W_TYPE_SIZE);				\
+    pl = (UWtype) __ll;							\
+  }
+#endif
+
+#if !defined (__umulsidi3)
+#define __umulsidi3(u, v) \
+  ({UWtype __hi, __lo;							\
+    umul_ppmm (__hi, __lo, u, v);					\
+    ((UDWtype) __hi << W_TYPE_SIZE) | __lo; })
+#endif
+
+
+/* Note the prototypes are under !define(umul_ppmm) etc too, since the HPPA
+   versions above are different and we don't want to conflict.  */
+
+#if ! defined (umul_ppmm) && HAVE_NATIVE_mpn_umul_ppmm
+#define mpn_umul_ppmm  __MPN(umul_ppmm)
+extern mp_limb_t mpn_umul_ppmm _PROTO ((mp_limb_t *, mp_limb_t, mp_limb_t));
+#define umul_ppmm(wh, wl, u, v)                                 \
+  do {                                                          \
+    mp_limb_t __umul_ppmm__p0;                                  \
+    (wh) = __MPN(umul_ppmm) (&__umul_ppmm__p0,                  \
+                             (mp_limb_t) (u), (mp_limb_t) (v)); \
+    (wl) = __umul_ppmm__p0;                                     \
+  } while (0)
+#endif
+
+#if ! defined (udiv_qrnnd) && HAVE_NATIVE_mpn_udiv_qrnnd
+#define mpn_udiv_qrnnd  __MPN(udiv_qrnnd)
+extern mp_limb_t mpn_udiv_qrnnd _PROTO ((mp_limb_t *,
+                                         mp_limb_t, mp_limb_t, mp_limb_t));
+#define udiv_qrnnd(q, r, n1, n0, d)                                           \
+  do {                                                                        \
+    mp_limb_t __udiv_qrnnd__r;                                                \
+    (q) = mpn_udiv_qrnnd (&__udiv_qrnnd__r,                                   \
+                          (mp_limb_t) (n1), (mp_limb_t) (n0), (mp_limb_t) d); \
+    (r) = __udiv_qrnnd__r;                                                    \
+  } while (0)
+#endif
+
+
+/* If this machine has no inline assembler, use C macros.  */
+
+#if !defined (add_ssaaaa)
+#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
+  do {									\
+    UWtype __x;								\
+    __x = (al) + (bl);							\
+    (sh) = (ah) + (bh) + (__x < (al));					\
+    (sl) = __x;								\
+  } while (0)
+#endif
+
+#if !defined (sub_ddmmss)
+#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
+  do {									\
+    UWtype __x;								\
+    __x = (al) - (bl);							\
+    (sh) = (ah) - (bh) - (__x > (al));					\
+    (sl) = __x;								\
+  } while (0)
+#endif
+
+/* If we lack umul_ppmm but have smul_ppmm, define umul_ppmm in terms of
+   smul_ppmm.  */
+#if !defined (umul_ppmm) && defined (smul_ppmm)
+#define umul_ppmm(w1, w0, u, v)						\
+  do {									\
+    UWtype __w1;							\
+    UWtype __xm0 = (u), __xm1 = (v);					\
+    smul_ppmm (__w1, w0, __xm0, __xm1);					\
+    (w1) = __w1 + (-(__xm0 >> (W_TYPE_SIZE - 1)) & __xm1)		\
+		+ (-(__xm1 >> (W_TYPE_SIZE - 1)) & __xm0);		\
+  } while (0)
+#endif
+
+/* If we still don't have umul_ppmm, define it using plain C.  */
+#if !defined (umul_ppmm)
+#define umul_ppmm(w1, w0, u, v)						\
+  do {									\
+    UWtype __x0, __x1, __x2, __x3;					\
+    UHWtype __ul, __vl, __uh, __vh;					\
+    UWtype __u = (u), __v = (v);					\
+									\
+    __ul = __ll_lowpart (__u);						\
+    __uh = __ll_highpart (__u);						\
+    __vl = __ll_lowpart (__v);						\
+    __vh = __ll_highpart (__v);						\
+									\
+    __x0 = (UWtype) __ul * __vl;					\
+    __x1 = (UWtype) __ul * __vh;					\
+    __x2 = (UWtype) __uh * __vl;					\
+    __x3 = (UWtype) __uh * __vh;					\
+									\
+    __x1 += __ll_highpart (__x0);/* this can't give carry */		\
+    __x1 += __x2;		/* but this indeed can */		\
+    if (__x1 < __x2)		/* did we get it? */			\
+      __x3 += __ll_B;		/* yes, add it in the proper pos. */	\
+									\
+    (w1) = __x3 + __ll_highpart (__x1);					\
+    (w0) = (__x1 << W_TYPE_SIZE/2) + __ll_lowpart (__x0);		\
+  } while (0)
+#endif
+
+/* If we don't have smul_ppmm, define it using umul_ppmm (which surely will
+   exist in one form or another.  */
+#if !defined (smul_ppmm)
+#define smul_ppmm(w1, w0, u, v)						\
+  do {									\
+    UWtype __w1;							\
+    UWtype __xm0 = (u), __xm1 = (v);					\
+    umul_ppmm (__w1, w0, __xm0, __xm1);					\
+    (w1) = __w1 - (-(__xm0 >> (W_TYPE_SIZE - 1)) & __xm1)		\
+		- (-(__xm1 >> (W_TYPE_SIZE - 1)) & __xm0);		\
+  } while (0)
+#endif
+
+/* Define this unconditionally, so it can be used for debugging.  */
+#define __udiv_qrnnd_c(q, r, n1, n0, d) \
+  do {									\
+    UWtype __d1, __d0, __q1, __q0, __r1, __r0, __m;			\
+    __d1 = __ll_highpart (d);						\
+    __d0 = __ll_lowpart (d);						\
+									\
+    __q1 = (n1) / __d1;							\
+    __r1 = (n1) - __q1 * __d1;						\
+    __m = (UWtype) __q1 * __d0;						\
+    __r1 = __r1 * __ll_B | __ll_highpart (n0);				\
+    if (__r1 < __m)							\
+      {									\
+	__q1--, __r1 += (d);						\
+	if (__r1 >= (d)) /* i.e. we didn't get carry when adding to __r1 */\
+	  if (__r1 < __m)						\
+	    __q1--, __r1 += (d);					\
+      }									\
+    __r1 -= __m;							\
+									\
+    __q0 = __r1 / __d1;							\
+    __r0 = __r1  - __q0 * __d1;						\
+    __m = (UWtype) __q0 * __d0;						\
+    __r0 = __r0 * __ll_B | __ll_lowpart (n0);				\
+    if (__r0 < __m)							\
+      {									\
+	__q0--, __r0 += (d);						\
+	if (__r0 >= (d))						\
+	  if (__r0 < __m)						\
+	    __q0--, __r0 += (d);					\
+      }									\
+    __r0 -= __m;							\
+									\
+    (q) = (UWtype) __q1 * __ll_B | __q0;				\
+    (r) = __r0;								\
+  } while (0)
+
+/* If the processor has no udiv_qrnnd but sdiv_qrnnd, go through
+   __udiv_w_sdiv (defined in libgcc or elsewhere).  */
+#if !defined (udiv_qrnnd) && defined (sdiv_qrnnd)
+#define udiv_qrnnd(q, r, nh, nl, d) \
+  do {									\
+    UWtype __r;								\
+    (q) = __MPN(udiv_w_sdiv) (&__r, nh, nl, d);				\
+    (r) = __r;								\
+  } while (0)
+#endif
+
+/* If udiv_qrnnd was not defined for this processor, use __udiv_qrnnd_c.  */
+#if !defined (udiv_qrnnd)
+#define UDIV_NEEDS_NORMALIZATION 1
+#define udiv_qrnnd __udiv_qrnnd_c
+#endif
+
+#if !defined (count_leading_zeros)
+extern
+#if __STDC__
+const
+#endif
+unsigned char __clz_tab[];
+#define count_leading_zeros(count, x) \
+  do {									\
+    UWtype __xr = (x);							\
+    UWtype __a;								\
+									\
+    if (W_TYPE_SIZE <= 32)						\
+      {									\
+	__a = __xr < ((UWtype) 1 << 2*__BITS4)				\
+	  ? (__xr < ((UWtype) 1 << __BITS4) ? 0 : __BITS4)		\
+	  : (__xr < ((UWtype) 1 << 3*__BITS4) ?  2*__BITS4 : 3*__BITS4);\
+      }									\
+    else								\
+      {									\
+	for (__a = W_TYPE_SIZE - 8; __a > 0; __a -= 8)			\
+	  if (((__xr >> __a) & 0xff) != 0)				\
+	    break;							\
+      }									\
+									\
+    (count) = W_TYPE_SIZE - (__clz_tab[__xr >> __a] + __a);		\
+  } while (0)
+/* This version gives a well-defined value for zero. */
+#define COUNT_LEADING_ZEROS_0 W_TYPE_SIZE
+#define COUNT_LEADING_ZEROS_NEED_CLZ_TAB
+#endif
+
+#if !defined (count_trailing_zeros)
+/* Define count_trailing_zeros using count_leading_zeros.  The latter might be
+   defined in asm, but if it is not, the C version above is good enough.  */
+#define count_trailing_zeros(count, x) \
+  do {									\
+    UWtype __ctz_x = (x);						\
+    UWtype __ctz_c;							\
+    count_leading_zeros (__ctz_c, __ctz_x & -__ctz_x);			\
+    (count) = W_TYPE_SIZE - 1 - __ctz_c;				\
+  } while (0)
+#endif
+
+#ifndef UDIV_NEEDS_NORMALIZATION
+#define UDIV_NEEDS_NORMALIZATION 0
+#endif
+
+/* Give defaults for UMUL_TIME and UDIV_TIME.  */
+#ifndef UMUL_TIME
+#define UMUL_TIME 1
+#endif
+
+#ifndef UDIV_TIME
+#define UDIV_TIME UMUL_TIME
+#endif
+
+/* count_trailing_zeros is often on the slow side, so make that the default */
+#ifndef COUNT_TRAILING_ZEROS_TIME
+#define COUNT_TRAILING_ZEROS_TIME  15  /* cycles */
+#endif
+
+
diff --git a/src/gmp/ltconfig b/src/gmp/ltconfig
new file mode 100755
index 000000000..6d8cf33e8
--- /dev/null
+++ b/src/gmp/ltconfig
@@ -0,0 +1,3109 @@
+#! /bin/sh
+
+# ltconfig - Create a system-specific libtool.
+# Copyright (C) 1996-2000 Free Software Foundation, Inc.
+# Originally by 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.
+
+# Check that we are running under the correct shell.
+SHELL=${CONFIG_SHELL-/bin/sh}
+echo=echo
+if test "X$1" = X--no-reexec; then
+  # Discard the --no-reexec flag, and continue.
+  shift
+elif test "X$1" = X--fallback-echo; then
+  # Avoid inline document here, it may be left over
+  :
+elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then
+  # Yippee, $echo works!
+  :
+else
+  # Restart under the correct shell.
+  exec "$SHELL" "$0" --no-reexec ${1+"$@"}
+fi
+
+if test "X$1" = X--fallback-echo; then
+  # used as fallback echo
+  shift
+  cat <<EOF
+$*
+EOF
+  exit 0
+fi
+
+# Find the correct PATH separator.  Usually this is `:', but
+# DJGPP uses `;' like DOS.
+if test "X${PATH_SEPARATOR+set}" != Xset; then
+  UNAME=${UNAME-`uname 2>/dev/null`}
+  case X$UNAME in
+    *-DOS) PATH_SEPARATOR=';' ;;
+    *)     PATH_SEPARATOR=':' ;;
+  esac
+fi
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+if test "X${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
+
+if test "X${echo_test_string+set}" != Xset; then
+  # find a string as large as possible, as long as the shell can cope with it
+  for cmd in 'sed 50q "$0"' 'sed 20q "$0"' 'sed 10q "$0"' 'sed 2q "$0"' 'echo test'; do
+    # expected sizes: less than 2Kb, 1Kb, 512 bytes, 16 bytes, ...
+    if (echo_test_string="`eval $cmd`") 2>/dev/null &&
+       echo_test_string="`eval $cmd`" &&
+       (test "X$echo_test_string" = "X$echo_test_string") 2>/dev/null; then
+      break
+    fi
+  done
+fi
+
+if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
+   echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
+   test "X$echo_testing_string" = "X$echo_test_string"; then
+  :
+else
+  # The Solaris, AIX, and Digital Unix default echo programs unquote
+  # backslashes.  This makes it impossible to quote backslashes using
+  #   echo "$something" | sed 's/\\/\\\\/g'
+  #
+  # So, first we look for a working echo in the user's PATH.
+
+  IFS="${IFS= 	}"; save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR}"
+  for dir in $PATH /usr/ucb; do
+    if (test -f $dir/echo || test -f $dir/echo$ac_exeext) &&
+       test "X`($dir/echo '\t') 2>/dev/null`" = 'X\t' &&
+       echo_testing_string=`($dir/echo "$echo_test_string") 2>/dev/null` &&
+       test "X$echo_testing_string" = "X$echo_test_string"; then
+      echo="$dir/echo"
+      break
+    fi
+  done
+  IFS="$save_ifs"
+
+  if test "X$echo" = Xecho; then
+    # We didn't find a better echo, so look for alternatives.
+    if test "X`(print -r '\t') 2>/dev/null`" = 'X\t' &&
+       echo_testing_string=`(print -r "$echo_test_string") 2>/dev/null` &&
+       test "X$echo_testing_string" = "X$echo_test_string"; then
+      # This shell has a builtin print -r that does the trick.
+      echo='print -r'
+    elif (test -f /bin/ksh || test -f /bin/ksh$ac_exeext) &&
+	 test "X$CONFIG_SHELL" != X/bin/ksh; then
+      # If we have ksh, try running ltconfig again with it.
+      ORIGINAL_CONFIG_SHELL="${CONFIG_SHELL-/bin/sh}"
+      export ORIGINAL_CONFIG_SHELL
+      CONFIG_SHELL=/bin/ksh
+      export CONFIG_SHELL
+      exec "$CONFIG_SHELL" "$0" --no-reexec ${1+"$@"}
+    else
+      # Try using printf.
+      echo='printf "%s\n"'
+      if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
+	 echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
+	 test "X$echo_testing_string" = "X$echo_test_string"; then
+	# Cool, printf works
+	:
+      elif echo_testing_string=`("$ORIGINAL_CONFIG_SHELL" "$0" --fallback-echo '\t') 2>/dev/null` &&
+	   test "X$echo_testing_string" = 'X\t' &&
+	   echo_testing_string=`("$ORIGINAL_CONFIG_SHELL" "$0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
+	   test "X$echo_testing_string" = "X$echo_test_string"; then
+	CONFIG_SHELL="$ORIGINAL_CONFIG_SHELL"
+	export CONFIG_SHELL
+	SHELL="$CONFIG_SHELL"
+	export SHELL
+	echo="$CONFIG_SHELL $0 --fallback-echo"
+      elif echo_testing_string=`("$CONFIG_SHELL" "$0" --fallback-echo '\t') 2>/dev/null` &&
+	   test "X$echo_testing_string" = 'X\t' &&
+	   echo_testing_string=`("$CONFIG_SHELL" "$0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
+	   test "X$echo_testing_string" = "X$echo_test_string"; then
+	echo="$CONFIG_SHELL $0 --fallback-echo"
+      else
+	# maybe with a smaller string...
+	prev=:
+
+	for cmd in 'echo test' 'sed 2q "$0"' 'sed 10q "$0"' 'sed 20q "$0"' 'sed 50q "$0"'; do
+	  if (test "X$echo_test_string" = "X`eval $cmd`") 2>/dev/null; then
+	    break
+	  fi
+	  prev="$cmd"
+	done
+
+	if test "$prev" != 'sed 50q "$0"'; then
+	  echo_test_string=`eval $prev`
+	  export echo_test_string
+	  exec "${ORIGINAL_CONFIG_SHELL}" "$0" ${1+"$@"}
+	else
+	  # Oops.  We lost completely, so just stick with echo.
+	  echo=echo
+	fi
+      fi
+    fi
+  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'
+
+# Sed substitution to delay expansion of an escaped shell variable in a
+# double_quote_subst'ed string.
+delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
+
+# The name of this program.
+progname=`$echo "X$0" | $Xsed -e 's%^.*/%%'`
+
+# Constants:
+PROGRAM=ltconfig
+PACKAGE=libtool
+VERSION=1.3c
+TIMESTAMP=" (1.696 2000/03/14 20:22:42)"
+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'
+rm="rm -f"
+
+help="Try \`$progname --help' for more information."
+
+# Global variables:
+default_ofile=libtool
+can_build_shared=yes
+enable_shared=yes
+# All known linkers require a `.a' archive for static linking (except M$VC,
+# which needs '.lib').
+enable_static=yes
+enable_fast_install=yes
+enable_dlopen=unknown
+enable_win32_dll=no
+pic_mode=default
+ltmain=
+silent=
+srcdir=
+ac_config_guess=
+ac_config_sub=
+host=
+build=NONE
+nonopt=NONE
+ofile="$default_ofile"
+verify_host=yes
+with_gcc=no
+with_gnu_ld=no
+need_locks=yes
+ac_ext=c
+libext=a
+cache_file=
+
+old_AR="$AR"
+old_CC="$CC"
+old_CFLAGS="$CFLAGS"
+old_CPPFLAGS="$CPPFLAGS"
+old_LDFLAGS="$LDFLAGS"
+old_LIBS="$LIBS"
+old_MAGIC="$MAGIC"
+old_LD="$LD"
+old_LN_S="$LN_S"
+old_NM="$NM"
+old_RANLIB="$RANLIB"
+old_STRIP="$STRIP"
+old_AS="$AS"
+old_DLLTOOL="$DLLTOOL"
+old_OBJDUMP="$OBJDUMP"
+old_OBJEXT="$OBJEXT"
+old_EXEEXT="$EXEEXT"
+old_reload_Flag="$reload_flag"
+old_deplibs_check_method="$deplibs_check_method"
+old_file_magic_cmd="$file_magic_cmd"
+
+# 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.
+
+    --build                configure for building on BUILD [BUILD=HOST]
+    --debug                enable verbose shell tracing
+    --disable-shared       do not build shared libraries
+    --disable-static       do not build static libraries
+    --disable-fast-install do not optimize for fast installation
+    --enable-dlopen        enable dlopen support
+    --enable-win32-dll     enable building dlls on win32 hosts
+    --help                 display this help and exit
+    --no-verify            do not verify that HOST is a valid host type
+-o, --output=FILE          specify the output file [default=$default_ofile]
+    --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
+    --prefer-pic           try to use only PIC objects
+    --prefer-non-pic       try to use only non-PIC objects
+    --disable-lock         disable file locking
+    --cache-file=FILE      configure cache file
+
+LTMAIN is the \`ltmain.sh' shell script fragment or \`ltmain.c' program
+that provides basic libtool functionality.
+
+HOST is the canonical host system name [default=guessed].
+EOM
+  exit 0
+  ;;
+
+  --build) prev=build ;;
+  --build=*) build="$optarg" ;;
+
+  --debug)
+    echo "$progname: enabling shell trace mode"
+    set -x
+    ;;
+
+  --disable-shared) enable_shared=no ;;
+
+  --disable-static) enable_static=no ;;
+
+  --disable-fast-install) enable_fast_install=no ;;
+
+  --enable-dlopen) enable_dlopen=yes ;;
+
+  --enable-win32-dll) enable_win32_dll=yes ;;
+
+  --quiet | --silent) silent=yes ;;
+
+  --srcdir) prev=srcdir ;;
+  --srcdir=*) srcdir="$optarg" ;;
+
+  --no-verify) verify_host=no ;;
+
+  --output | -o) prev=ofile ;;
+  --output=*) ofile="$optarg" ;;
+
+  --version) echo "$PROGRAM (GNU $PACKAGE) $VERSION$TIMESTAMP"; exit 0 ;;
+
+  --with-gcc) with_gcc=yes ;;
+  --with-gnu-ld) with_gnu_ld=yes ;;
+
+  --prefer-pic) pic_mode=yes ;;
+  --prefer-non-pic) pic_mode=no ;;
+
+  --disable-lock) need_locks=no ;;
+
+  --cache-file=*) cache_file="$optarg" ;;
+
+  -*)
+    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
+  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 "X${LC_ALL+set}" = Xset; then LC_ALL=C; export LC_ALL; fi
+if test "X${LANG+set}"   = Xset; then LANG=C;   export LANG;   fi
+
+if test -n "$cache_file" && test -r "$cache_file"; then
+  echo "loading cache $cache_file within ltconfig"
+  . $cache_file
+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.
+  srcdir=`$echo "X$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 $SHELL $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=`$SHELL $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=`$SHELL $ac_config_sub $host_alias`
+  echo "$ac_t$host" 1>&6
+
+  # Make sure the host verified.
+  test -z "$host" && exit 1
+
+  # Check for the build system type
+  echo $ac_n "checking build system type... $ac_c" 1>&6
+
+  build_alias=$build
+  case "$build_alias" in
+  NONE)
+    case $nonopt in
+    NONE) build_alias=$host_alias ;;
+    *) build_alias=$nonopt ;;
+    esac ;;
+  esac
+
+  build=`$SHELL $ac_config_sub $build_alias`
+  build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+  build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+  build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+  echo "$ac_t""$build" 1>&6
+
+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
+  build_alias=$host_alias
+  build=$host
+fi
+
+if test x"$host" != x"$build"; then
+  ac_tool_prefix=${host_alias}-
+else
+  ac_tool_prefix=
+fi
+
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+
+# 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
+
+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 "X${COLLECT_NAMES+set}" != Xset; then
+    COLLECT_NAMES=
+    export COLLECT_NAMES
+  fi
+  ;;
+esac
+
+# Determine commands to create old-style static archives.
+old_archive_cmds='$AR cru $oldlib$oldobjs$old_deplibs'
+old_postinstall_cmds='chmod 644 $oldlib'
+old_postuninstall_cmds=
+
+# Set sane defaults for various variables
+test -z "$AR" && AR=ar
+test -z "$AS" && AS=as
+test -z "$CC" && CC=cc
+test -z "$DLLTOOL" && DLLTOOL=dlltool
+test -z "$MAGIC" && MAGIC=file
+test -z "$LD" && LD=ld
+test -z "$LN_S" && LN_S="ln -s"
+test -z "$NM" && NM=nm
+test -z "$OBJDUMP" && OBJDUMP=objdump
+test -z "$RANLIB" && RANLIB=:
+test -z "$STRIP" && STRIP=:
+test -z "$objext" && objext=o
+
+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
+
+# Allow CC to be a program name with arguments.
+set dummy $CC
+compiler="$2"
+
+# We assume here that the value for ac_cv_prog_cc_pic will not be cached
+# in isolation, and that seeing it set (from the cache) indicates that
+# the associated values are set (in the cache) correctly too.
+echo $ac_n "checking for $compiler option to produce PIC... $ac_c" 1>&6
+echo "$progname:563:checking for $compiler option to produce PIC" 1>&5
+if test "X${ac_cv_prog_cc_pic+set}" = Xset; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_cv_prog_cc_pic=
+  ac_cv_prog_cc_shlib=
+  ac_cv_prog_cc_wl=
+  ac_cv_prog_cc_static=
+  ac_cv_prog_cc_no_builtin=
+  ac_cv_prog_cc_can_build_shared=$can_build_shared
+
+  if test "$with_gcc" = yes; then
+    ac_cv_prog_cc_wl='-Wl,'
+    ac_cv_prog_cc_static='-static'
+
+    case "$host_os" in
+    beos* | irix5* | irix6* | osf3* | osf4* | osf5*)
+      # PIC is the default for these OSes.
+      ;;
+    aix*)
+      # Below there is a dirty hack to force normal static linking with -ldl
+      # The problem is because libdl dynamically linked with both libc and
+      # libC (AIX C++ library), which obviously doesn't included in libraries
+      # list by gcc. This cause undefined symbols with -static flags.
+      # This hack allows C programs to be linked with "-static -ldl", but
+      # we not sure about C++ programs.
+      ac_cv_prog_cc_static="$ac_cv_prog_cc_static ${ac_cv_prog_cc_wl}-lC"
+      ;;
+    cygwin* | mingw* | os2*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      ac_cv_prog_cc_pic='-DDLL_EXPORT'
+      ;;
+    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'.
+      ac_cv_prog_cc_pic='-m68020 -resident32 -malways-restore-a4'
+      ;;
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	 ac_cv_prog_cc_pic=-Kconform_pic
+      fi
+      ;;
+    *)
+      ac_cv_prog_cc_pic='-fPIC'
+      ;;
+    esac
+  else
+    # PORTME Check for PIC flags for the system compiler.
+    case "$host_os" in
+    aix3* | aix4*)
+     # All AIX code is PIC.
+      ac_cv_prog_cc_static='-bnso -bI:/lib/syscalls.exp'
+      ;;
+
+    hpux9* | hpux10* | hpux11*)
+      # Is there a better ac_cv_prog_cc_static that works with the bundled CC?
+      ac_cv_prog_cc_wl='-Wl,'
+      ac_cv_prog_cc_static="${ac_cv_prog_cc_wl}-a ${ac_cv_prog_cc_wl}archive"
+      ac_cv_prog_cc_pic='+Z'
+      ;;
+
+    irix5* | irix6*)
+      ac_cv_prog_cc_wl='-Wl,'
+      ac_cv_prog_cc_static='-non_shared'
+      # PIC (with -KPIC) is the default.
+      ;;
+
+    cygwin* | mingw* | os2*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      ac_cv_prog_cc_pic='-DDLL_EXPORT'
+      ;;
+
+    osf3* | osf4* | osf5*)
+      # All OSF/1 code is PIC.
+      ac_cv_prog_cc_wl='-Wl,'
+      ac_cv_prog_cc_static='-non_shared'
+      ;;
+
+    sco3.2v5*)
+      ac_cv_prog_cc_pic='-Kpic'
+      ac_cv_prog_cc_static='-dn'
+      ac_cv_prog_cc_shlib='-belf'
+      ;;
+
+    solaris*)
+      ac_cv_prog_cc_pic='-KPIC'
+      ac_cv_prog_cc_static='-Bstatic'
+      ac_cv_prog_cc_wl='-Wl,'
+      ;;
+
+    sunos4*)
+      ac_cv_prog_cc_pic='-PIC'
+      ac_cv_prog_cc_static='-Bstatic'
+      ac_cv_prog_cc_wl='-Qoption ld '
+      ;;
+
+    sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+      ac_cv_prog_cc_pic='-KPIC'
+      ac_cv_prog_cc_static='-Bstatic'
+      ac_cv_prog_cc_wl='-Wl,'
+      ;;
+
+    uts4*)
+      ac_cv_prog_cc_pic='-pic'
+      ac_cv_prog_cc_static='-Bstatic'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec ;then
+	ac_cv_prog_cc_pic='-Kconform_pic'
+	ac_cv_prog_cc_static='-Bstatic'
+      fi
+      ;;
+
+    *)
+      ac_cv_prog_cc_can_build_shared=no
+      ;;
+    esac
+  fi
+fi
+if test -z "$ac_cv_prog_cc_pic"; then
+  echo "$ac_t"none 1>&6
+else
+  echo "$ac_t""$ac_cv_prog_cc_pic" 1>&6
+
+  # Check to make sure the pic_flag actually works.
+  echo $ac_n "checking if $compiler PIC flag $ac_cv_prog_cc_pic works... $ac_c" 1>&6
+  echo "$progname:693:checking that $compiler PIC flag $ac_cv_prog_cc_pic works." 1>&5
+  if test "X${ac_cv_prog_cc_pic_works+set}" = Xset; then
+    echo $ac_n "(cached) $ac_c" 1>&6
+  else
+    ac_cv_prog_cc_pic_works=yes
+    $rm conftest*
+    echo "int some_variable = 0;" > conftest.c
+    save_CFLAGS="$CFLAGS"
+    CFLAGS="$CFLAGS $ac_cv_prog_cc_pic -DPIC"
+    if { (eval echo $progname:702: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>conftest.err; } && test -s conftest.$objext; then
+      # Append any warnings to the config.log.
+      cat conftest.err 1>&5
+
+      case "$host_os" in
+      hpux9* | hpux10* | hpux11*)
+	# 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
+	  ac_cv_prog_cc_pic_works=no
+	  ac_cv_prog_cc_can_build_shared=no
+	  ac_cv_prog_cc_pic=
+	else
+	  ac_cv_prog_cc_pic_works=yes
+	  ac_cv_prog_cc_pic=" $ac_cv_prog_cc_pic"
+	fi
+	;;
+      *)
+	ac_cv_prog_cc_pic_works=yes
+	ac_cv_prog_cc_pic=" $ac_cv_prog_cc_pic"
+	;;
+      esac
+    else
+      # Append any errors to the config.log.
+      cat conftest.err 1>&5
+      ac_cv_prog_cc_pic_works=no
+      ac_cv_prog_cc_can_build_shared=no
+      ac_cv_prog_cc_pic=
+    fi
+    CFLAGS="$save_CFLAGS"
+    $rm conftest*
+  fi
+  # Belt *and* braces to stop my trousers falling down:
+  if test "X$ac_cv_prog_cc_pic_works" = Xno; then
+    ac_cv_prog_cc_pic=
+    ac_cv_prog_cc_can_build_shared=no
+  fi
+  echo "$ac_t""$ac_cv_prog_cc_pic_works" 1>&6
+fi
+
+# Check for any special shared library compilation flags.
+if test -n "$ac_cv_prog_cc_shlib"; then
+  echo "$progname: warning: \`$CC' requires \`$ac_cv_prog_cc_shlib' to build shared libraries" 1>&2
+  if echo "$old_CC $old_CFLAGS " | egrep -e "[ 	]$ac_cv_prog_cc_shlib[ 	]" >/dev/null; then :
+  else
+    echo "$progname: add \`$ac_cv_prog_cc_shlib' to the CC or CFLAGS env variable and reconfigure" 1>&2
+    ac_cv_prog_cc_can_build_shared=no
+  fi
+fi
+
+echo $ac_n "checking if $compiler static flag $ac_cv_prog_cc_static works... $ac_c" 1>&6
+echo "$progname:754: checking if $compiler static flag $ac_cv_prog_cc_static works" >&5
+if test "X${ac_cv_prog_cc_static_works+set}" = Xset; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  $rm conftest*
+  echo 'main(){return(0);}' > conftest.c
+  save_LDFLAGS="$LDFLAGS"
+  LDFLAGS="$LDFLAGS $ac_cv_prog_cc_static"
+  if { (eval echo $progname:762: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+    ac_cv_prog_cc_static_works=yes
+  else
+    ac_cv_prog_cc_static_works=no
+    ac_cv_prog_cc_static=
+  fi
+  LDFLAGS="$save_LDFLAGS"
+  $rm conftest*
+fi
+# Belt *and* braces to stop my trousers falling down:
+if test "X$ac_cv_prog_cc_static_works" = Xno; then
+  ac_cv_prog_cc_static=
+fi
+echo "$ac_t""$ac_cv_prog_cc_static_works" 1>&6
+pic_flag="$ac_cv_prog_cc_pic"
+special_shlib_compile_flags="$ac_cv_prog_cc_shlib"
+wl="$ac_cv_prog_cc_wl"
+link_static_flag="$ac_cv_prog_cc_static"
+no_builtin_flag="$ac_cv_prog_cc_no_builtin"
+can_build_shared="$ac_cv_prog_cc_can_build_shared"
+
+# Check to see if options -o and -c are simultaneously supported by compiler
+echo $ac_n "checking if $compiler supports -c -o file.o... $ac_c" 1>&6
+$rm -r conftest 2>/dev/null
+mkdir conftest
+cd conftest
+$rm conftest*
+echo "int some_variable = 0;" > conftest.c
+mkdir out
+# According to Tom Tromey, Ian Lance Taylor reported there are C compilers
+# that will create temporary files in the current directory regardless of
+# the output directory.  Thus, making CWD read-only will cause this test
+# to fail, enabling locking or at least warning the user not to do parallel
+# builds.
+chmod -w .
+save_CFLAGS="$CFLAGS"
+CFLAGS="$CFLAGS -o out/conftest2.o"
+echo "$progname:799: checking if $compiler supports -c -o file.o" >&5
+if { (eval echo $progname:800: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>out/conftest.err; } && test -s out/conftest2.o; then
+
+  # The compiler can only warn and ignore the option if not recognized
+  # So say no if there are warnings
+    if test -s out/conftest.err; then
+      echo "$ac_t"no 1>&6
+      compiler_c_o=no
+    else
+      echo "$ac_t"yes 1>&6
+      compiler_c_o=yes
+    fi
+else
+  # Append any errors to the config.log.
+  cat out/conftest.err 1>&5
+  compiler_c_o=no
+  echo "$ac_t"no 1>&6
+fi
+CFLAGS="$save_CFLAGS"
+chmod u+w .
+$rm conftest* out/*
+rmdir out
+cd ..
+rmdir conftest
+$rm -r conftest 2>/dev/null
+
+if test x"$compiler_c_o" = x"yes"; then
+  # Check to see if we can write to a .lo
+  echo $ac_n "checking if $compiler supports -c -o file.lo... $ac_c" 1>&6
+  $rm conftest*
+  echo "int some_variable = 0;" > conftest.c
+  save_CFLAGS="$CFLAGS"
+  CFLAGS="$CFLAGS -c -o conftest.lo"
+  echo "$progname:832: checking if $compiler supports -c -o file.lo" >&5
+if { (eval echo $progname:833: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>conftest.err; } && test -s conftest.lo; then
+
+    # The compiler can only warn and ignore the option if not recognized
+    # So say no if there are warnings
+      if test -s conftest.err; then
+	echo "$ac_t"no 1>&6
+	compiler_o_lo=no
+      else
+	echo "$ac_t"yes 1>&6
+	compiler_o_lo=yes
+      fi
+  else
+    # Append any errors to the config.log.
+    cat conftest.err 1>&5
+    compiler_o_lo=no
+    echo "$ac_t"no 1>&6
+  fi
+  CFLAGS="$save_CFLAGS"
+  $rm conftest*
+else
+  compiler_o_lo=no
+fi
+
+# Check to see if we can do hard links to lock some files if needed
+hard_links="nottested"
+if test "$compiler_c_o" = no && test "$need_locks" != no; then
+  # do not overwrite the value of need_locks provided by the user
+  echo $ac_n "checking if we can lock with hard links... $ac_c" 1>&6
+  hard_links=yes
+  $rm conftest*
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  touch conftest.a
+  ln conftest.a conftest.b 2>&5 || hard_links=no
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  echo "$ac_t$hard_links" 1>&6
+  $rm conftest*
+  if test "$hard_links" = no; then
+    echo "*** WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2
+    need_locks=warn
+  fi
+else
+  need_locks=no
+fi
+
+if test "$with_gcc" = yes; then
+  # Check to see if options -fno-rtti -fno-exceptions are supported by compiler
+  echo $ac_n "checking if $compiler supports -fno-rtti -fno-exceptions ... $ac_c" 1>&6
+  $rm conftest*
+  echo "int some_variable = 0;" > conftest.c
+  save_CFLAGS="$CFLAGS"
+  CFLAGS="$CFLAGS -fno-rtti -fno-exceptions -c conftest.c"
+  echo "$progname:884: checking if $compiler supports -fno-rtti -fno-exceptions" >&5
+  if { (eval echo $progname:885: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>conftest.err; } && test -s conftest.o; then
+
+    # The compiler can only warn and ignore the option if not recognized
+    # So say no if there are warnings
+      if test -s conftest.err; then
+	echo "$ac_t"no 1>&6
+	compiler_rtti_exceptions=no
+      else
+	echo "$ac_t"yes 1>&6
+	compiler_rtti_exceptions=yes
+      fi
+  else
+    # Append any errors to the config.log.
+    cat conftest.err 1>&5
+    compiler_rtti_exceptions=no
+    echo "$ac_t"no 1>&6
+  fi
+  CFLAGS="$save_CFLAGS"
+  $rm conftest*
+
+  if test "$compiler_rtti_exceptions" = "yes"; then
+    no_builtin_flag=' -fno-builtin -fno-rtti -fno-exceptions'
+  else
+    no_builtin_flag=' -fno-builtin'
+  fi
+
+fi
+
+# 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=
+need_lib_prefix=unknown
+need_version=unknown
+# when you set need_version to no, make sure it does not cause -set_version
+# flags to be left without arguments
+archive_cmds=
+archive_expsym_cmds=
+old_archive_from_new_cmds=
+old_archive_from_expsyms_cmds=
+striplib=
+old_striplib=
+export_dynamic_flag_spec=
+whole_archive_flag_spec=
+thread_safe_flag_spec=
+hardcode_into_libs=no
+hardcode_libdir_flag_spec=
+hardcode_libdir_separator=
+hardcode_direct=no
+hardcode_minus_L=no
+hardcode_shlibpath_var=unsupported
+runpath_var=
+link_all_deplibs=unknown
+always_export_symbols=no
+export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | sed '\''s/.* //'\'' | sort | uniq > $export_symbols'
+# include_expsyms should be a list of space-separated symbols to be *always*
+# included in the symbol list
+include_expsyms=
+# exclude_expsyms can be an egrep regular expression of symbols to exclude
+# it will be wrapped by ` (' and `)$', so one must not match beginning or
+# end of line.  Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
+# as well as any symbol that contains `d'.
+exclude_expsyms="_GLOBAL_OFFSET_TABLE_"
+# Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
+# platforms (ab)use it in PIC code, but their linkers get confused if
+# the symbol is explicitly referenced.  Since portable code cannot
+# rely on this symbol name, it's probably fine to never include it in
+# preloaded symbol tables.
+extract_expsyms_cmds=
+
+case "$host_os" in
+cygwin* | mingw*)
+  # FIXME: the MSVC++ port hasn't been tested in a loooong time
+  # When not using gcc, we currently assume that we are using
+  # Microsoft Visual C++.
+  if test "$with_gcc" != yes; then
+    with_gnu_ld=no
+  fi
+  ;;
+
+esac
+
+ld_shlibs=yes
+if test "$with_gnu_ld" = yes; then
+  # If archive_cmds runs LD, not CC, wlarc should be empty
+  wlarc='${wl}'
+
+  # See if GNU ld supports shared libraries.
+  case "$host_os" in
+  aix3* | aix4*)
+    # On AIX, the GNU linker is very broken
+    ld_shlibs=no
+    cat <<EOF 1>&2
+
+*** Warning: the GNU linker, at least up to release 2.9.1, is reported
+*** to be unable to reliably create shared libraries on AIX.
+*** Therefore, libtool is disabling shared libraries support.  If you
+*** really care for shared libraries, you may want to modify your PATH
+*** so that a non-GNU linker is found, and then restart.
+
+EOF
+    ;;
+
+  amigaos*)
+    archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR cru $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+    hardcode_libdir_flag_spec='-L$libdir'
+    hardcode_minus_L=yes
+
+    # Samuel A. Falvo II <kc5tja@dolphin.openprojects.net> reports
+    # that the semantics of dynamic libraries on AmigaOS, at least up
+    # to version 4, is to share data among multiple programs linked
+    # with the same dynamic library.  Since this doesn't match the
+    # behavior of shared libraries on other platforms, we can use
+    # them.
+    ld_shlibs=no
+    ;;
+
+  beos*)
+    if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+      allow_undefined_flag=unsupported
+      # Joseph Beckenbach <jrb3@best.com> says some releases of gcc
+      # support --undefined.  This deserves some investigation.  FIXME
+      archive_cmds='$CC -nostart $libobjs $deplibs $linker_flags ${wl}-soname $wl$soname -o $lib'
+    else
+      ld_shlibs=no
+    fi
+    ;;
+
+  cygwin* | mingw*)
+    # hardcode_libdir_flag_spec is actually meaningless, as there is
+    # no search path for DLLs.
+    hardcode_libdir_flag_spec='-L$libdir'
+    allow_undefined_flag=unsupported
+    always_export_symbols=yes
+
+    extract_expsyms_cmds='test -f $output_objdir/impgen.c || \
+      sed -e "/^# \/\* impgen\.c starts here \*\//,/^# \/\* impgen.c ends here \*\// { s/^# //; p; }" -e d < $0 > $output_objdir/impgen.c~
+      test -f $output_objdir/impgen.exe || (cd $output_objdir && \
+      if test "x$HOST_CC" != "x" ; then $HOST_CC -o impgen impgen.c ; \
+      else $CC -o impgen impgen.c ; fi)~
+      $output_objdir/impgen $dir/$soname > $output_objdir/$soname-def'
+
+    old_archive_from_expsyms_cmds='$DLLTOOL --as=$AS --dllname $soname --def $output_objdir/$soname-def --output-lib $output_objdir/$newlib'
+
+    # cygwin and mingw dlls have different entry points and sets of symbols
+    # to exclude.
+    # FIXME: what about values for MSVC?
+    dll_entry=__cygwin_dll_entry@12
+    dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12~
+    case "$host_os" in
+    mingw*)
+      # mingw values
+      dll_entry=_DllMainCRTStartup@12
+      dll_exclude_symbols=DllMain@12,DllMainCRTStartup@12,DllEntryPoint@12~
+      ;;
+    esac
+
+    # mingw and cygwin differ, and it's simplest to just exclude the union
+    # of the two symbol sets.
+    dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12,DllMainCRTStartup@12,DllEntryPoint@12
+
+    # recent cygwin and mingw systems supply a stub DllMain which the user
+    # can override, but on older systems we have to supply one (in ltdll.c)
+    if test "x$lt_cv_need_dllmain" = "xyes"; then
+      ltdll_obj='$output_objdir/$soname-ltdll.'"$objext "
+      ltdll_cmds='test -f $output_objdir/$soname-ltdll.c || sed -e "/^# \/\* ltdll\.c starts here \*\//,/^# \/\* ltdll.c ends here \*\// { s/^# //; p; }" -e d < $0 > $output_objdir/$soname-ltdll.c~
+	test -f $output_objdir/$soname-ltdll.$objext || (cd $output_objdir && $CC -c $soname-ltdll.c)~'
+    else
+      ltdll_obj=
+      ltdll_cmds=
+    fi
+
+    # Extract the symbol export list from an `--export-all' def file,
+    # then regenerate the def file from the symbol export list, so that
+    # the compiled dll only exports the symbol export list.
+    # Be careful not to strip the DATA tag left be newer dlltools.
+    export_symbols_cmds="$ltdll_cmds"'
+      $DLLTOOL --export-all --exclude-symbols '$dll_exclude_symbols' --output-def $output_objdir/$soname-def '$ltdll_obj'$libobjs $convenience~
+      sed -e "1,/EXPORTS/d" -e "s/ @ [0-9]*//" -e "s/ *;.*$//" < $output_objdir/$soname-def > $export_symbols'
+
+    # If DATA tags from a recent dlltool are present, honour them!
+    archive_expsym_cmds='echo EXPORTS > $output_objdir/$soname-def~
+      _lt_hint=1;
+      cat $export_symbols | while read symbol; do
+	set dummy \$symbol;
+	case \$# in
+	  2) echo "	\$2 @ \$_lt_hint ; " >> $output_objdir/$soname-def;;
+	  *) echo "     \$2 @ \$_lt_hint \$3 ; " >> $output_objdir/$soname-def;;
+	esac;
+	_lt_hint=`expr 1 + \$_lt_hint`;
+      done~
+      '"$ltdll_cmds"'
+      $CC -Wl,--base-file,$output_objdir/$soname-base '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $lib '$ltdll_obj'$libobjs $deplibs $compiler_flags~
+      $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp~
+      $CC -Wl,--base-file,$output_objdir/$soname-base $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $lib '$ltdll_obj'$libobjs $deplibs $compiler_flags~
+      $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp~
+      $CC $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $lib '$ltdll_obj'$libobjs $deplibs $compiler_flags'
+    ;;
+
+  netbsd*)
+    if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+      archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+      archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+    else
+      archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
+    fi
+    ;;
+
+  solaris* | sysv5*)
+    if $LD -v 2>&1 | egrep 'BFD 2\.8' > /dev/null; then
+      ld_shlibs=no
+      cat <<EOF 1>&2
+
+*** Warning: The releases 2.8.* of the GNU linker cannot reliably
+*** create shared libraries on Solaris systems.  Therefore, libtool
+*** is disabling shared libraries support.  We urge you to upgrade GNU
+*** binutils to release 2.9.1 or newer.  Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+EOF
+    elif $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+      archive_cmds='$CC -shared $libobjs $deplibs $linker_flags ${wl}-soname $wl$soname -o $lib'
+      archive_expsym_cmds='$CC -shared $libobjs $deplibs $linker_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+    else
+      ld_shlibs=no
+    fi
+    ;;
+
+  sunos4*)
+    archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+    wlarc=
+    hardcode_direct=yes
+    hardcode_shlibpath_var=no
+    ;;
+
+  *)
+    if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+      archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+      archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+    else
+      ld_shlibs=no
+    fi
+    ;;
+  esac
+
+  if test "$ld_shlibs" = yes; then
+    runpath_var=LD_RUN_PATH
+    hardcode_libdir_flag_spec='${wl}--rpath ${wl}$libdir'
+    export_dynamic_flag_spec='${wl}--export-dynamic'
+    case $host_os in
+    cygwin* | mingw*)
+      # dlltool doesn't understand --whole-archive et. al.
+      whole_archive_flag_spec=
+      ;;
+    *)
+      # ancient GNU ld didn't support --whole-archive et. al.
+      if $LD --help 2>&1 | egrep 'no-whole-archive' > /dev/null; then
+	whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
+      else
+	whole_archive_flag_spec=
+      fi
+      ;;
+    esac
+  fi
+else
+  # PORTME fill in a description of your system's linker (not GNU ld)
+  case "$host_os" in
+  aix3*)
+    allow_undefined_flag=unsupported
+    always_export_symbols=yes
+    archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR cru $lib $output_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*)
+    hardcode_libdir_flag_spec='${wl}-b ${wl}nolibpath ${wl}-b ${wl}libpath:$libdir:/usr/lib:/lib'
+    hardcode_libdir_separator=':'
+    if test "$with_gcc" = yes; then
+      collect2name=`${CC} -print-prog-name=collect2`
+      if test -f "$collect2name" && \
+	 strings "$collect2name" | grep resolve_lib_name >/dev/null
+      then
+	# We have reworked collect2
+	hardcode_direct=yes
+      else
+	# We have old collect2
+	hardcode_direct=unsupported
+	# It fails to find uninstalled libraries when the uninstalled
+	# path is not listed in the libpath.  Setting hardcode_minus_L
+	# to unsupported forces relinking
+	hardcode_minus_L=yes
+	hardcode_libdir_flag_spec='-L$libdir'
+	hardcode_libdir_separator=
+      fi
+      shared_flag='-shared'
+    else
+      shared_flag='${wl}-bM:SRE'
+      hardcode_direct=yes
+    fi
+    allow_undefined_flag=' ${wl}-berok'
+    archive_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags ${wl}-bexpall ${wl}-bnoentry${allow_undefined_flag}'
+    archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags ${wl}-bE:$export_symbols ${wl}-bnoentry${allow_undefined_flag}'
+    case "$host_os" in aix4.[01]|aix4.[01].*)
+      # According to Greg Wooledge, -bexpall is only supported from AIX 4.2 on
+      always_export_symbols=yes ;;
+    esac
+   ;;
+
+  amigaos*)
+    archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR cru $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+    hardcode_libdir_flag_spec='-L$libdir'
+    hardcode_minus_L=yes
+    # see comment about different semantics on the GNU ld section
+    ld_shlibs=no
+    ;;
+
+  cygwin* | mingw*)
+    # When not using gcc, we currently assume that we are using
+    # Microsoft Visual C++.
+    # hardcode_libdir_flag_spec is actually meaningless, as there is
+    # no search path for DLLs.
+    hardcode_libdir_flag_spec=' '
+    allow_undefined_flag=unsupported
+    # Tell ltmain to make .lib files, not .a files.
+    libext=lib
+    # FIXME: Setting linknames here is a bad hack.
+    archive_cmds='$CC -o $lib $libobjs $compiler_flags `echo "$deplibs" | sed -e '\''s/ -lc$//'\''` -link -dll~linknames='
+    # The linker will automatically build a .lib file if we build a DLL.
+    old_archive_from_new_cmds='true'
+    # FIXME: Should let the user specify the lib program.
+    old_archive_cmds='lib /OUT:$oldlib$oldobjs$old_deplibs'
+    fix_srcfile_path='`cygpath -w $srcfile`'
+    ;;
+
+  freebsd1*)
+    ld_shlibs=no
+    ;;
+
+  # 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 $deplibs $linker_flags /usr/lib/c++rt0.o'
+    hardcode_libdir_flag_spec='-R$libdir'
+    hardcode_direct=yes
+    hardcode_shlibpath_var=no
+    ;;
+
+  # Unfortunately, older versions of FreeBSD 2 do not have this feature.
+  freebsd2*)
+    archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+    hardcode_direct=yes
+    hardcode_minus_L=yes
+    hardcode_shlibpath_var=no
+    ;;
+
+  # FreeBSD 3 and greater uses gcc -shared to do shared libraries.
+  freebsd*)
+    archive_cmds='$CC -shared -o $lib $libobjs $deplibs $compiler_flags'
+    hardcode_libdir_flag_spec='-R$libdir'
+    hardcode_direct=yes
+    hardcode_shlibpath_var=no
+    ;;
+
+  hpux9* | hpux10* | hpux11*)
+    case "$host_os" in
+    hpux9*) archive_cmds='$rm $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' ;;
+    *) archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' ;;
+    esac
+    hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
+    hardcode_libdir_separator=:
+    hardcode_direct=yes
+    hardcode_minus_L=yes # Not in the search PATH, but as the default
+			 # location of the library.
+    export_dynamic_flag_spec='${wl}-E'
+    ;;
+
+  irix5* | irix6*)
+    if test "$with_gcc" = yes; then
+      archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+    else
+      archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+    fi
+    hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+    hardcode_libdir_separator=:
+    link_all_deplibs=yes
+    ;;
+
+  netbsd*)
+    if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+      archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'  # a.out
+    else
+      archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags'      # ELF
+    fi
+    hardcode_libdir_flag_spec='${wl}-R$libdir'
+    hardcode_direct=yes
+    hardcode_shlibpath_var=no
+    ;;
+
+  openbsd*)
+    archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+    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" > $output_objdir/$libname.def~$echo "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~$echo DATA >> $output_objdir/$libname.def~$echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~$echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
+    old_archive_from_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
+    ;;
+
+  osf3*)
+    if test "$with_gcc" = yes; then
+      allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+      archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+    else
+      allow_undefined_flag=' -expect_unresolved \*'
+      archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+    fi
+    hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+    hardcode_libdir_separator=:
+    ;;
+
+  osf4* | osf5*)	# as osf3* with the addition of -msym flag
+    if test "$with_gcc" = yes; then
+      allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+      archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+    else
+      allow_undefined_flag=' -expect_unresolved \*'
+      archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -msym -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+    fi
+    hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+    hardcode_libdir_separator=:
+    ;;
+
+  sco3.2v5*)
+    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+    hardcode_shlibpath_var=no
+    runpath_var=LD_RUN_PATH
+    hardcode_runpath_var=yes
+    ;;
+
+  solaris*)
+    no_undefined_flag=' -z text'
+    # $CC -shared without GNU ld will not create a library from C++
+    # object files and a static libstdc++, better avoid it by now
+    archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
+    archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
+		$LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
+    hardcode_libdir_flag_spec='-R$libdir'
+    hardcode_shlibpath_var=no
+    case "$host_os" in
+    solaris2.[0-5] | solaris2.[0-5].*) ;;
+    *) # Supported since Solaris 2.6 (maybe 2.5.1?)
+      whole_archive_flag_spec='-z allextract$convenience -z defaultextract' ;;
+    esac
+    link_all_deplibs=yes
+    ;;
+
+  sunos4*)
+    archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
+    hardcode_libdir_flag_spec='-L$libdir'
+    hardcode_direct=yes
+    hardcode_minus_L=yes
+    hardcode_shlibpath_var=no
+    ;;
+
+  sysv4)
+    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+    runpath_var='LD_RUN_PATH'
+    hardcode_shlibpath_var=no
+    hardcode_direct=no #Motorola manual says yes, but my tests say they lie
+    ;;
+
+  sysv4.3*)
+    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+    hardcode_shlibpath_var=no
+    export_dynamic_flag_spec='-Bexport'
+    ;;
+
+  sysv5*)
+    no_undefined_flag=' -z text'
+    # $CC -shared without GNU ld will not create a library from C++
+    # object files and a static libstdc++, better avoid it by now
+    archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
+    archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
+		$LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
+    hardcode_libdir_flag_spec=
+    hardcode_shlibpath_var=no
+    runpath_var='LD_RUN_PATH'
+    ;;
+
+  uts4*)
+    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+    hardcode_libdir_flag_spec='-L$libdir'
+    hardcode_shlibpath_var=no
+    ;;
+
+  dgux*)
+    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+    hardcode_libdir_flag_spec='-L$libdir'
+    hardcode_shlibpath_var=no
+    ;;
+
+  sysv4*MP*)
+    if test -d /usr/nec; then
+      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_shlibpath_var=no
+      runpath_var=LD_RUN_PATH
+      hardcode_runpath_var=yes
+      ld_shlibs=yes
+    fi
+    ;;
+
+  sysv4.2uw2*)
+    archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags'
+    hardcode_direct=yes
+    hardcode_minus_L=no
+    hardcode_shlibpath_var=no
+    hardcode_runpath_var=yes
+    runpath_var=LD_RUN_PATH
+    ;;
+
+  unixware7*)
+    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+    runpath_var='LD_RUN_PATH'
+    hardcode_shlibpath_var=no
+    ;;
+
+  *)
+    ld_shlibs=no
+    ;;
+  esac
+fi
+echo "$ac_t$ld_shlibs" 1>&6
+test "$ld_shlibs" = no && can_build_shared=no
+
+# 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 &&
+     # If the only mechanism to avoid hardcoding is shlibpath_var, we
+     # have to relink, otherwise we might link with an installed library
+     # when we should be linking with a yet-to-be-installed one
+     ## test "$hardcode_shlibpath_var" != no &&
+     test "$hardcode_minus_L" != 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
+else
+  # We cannot hardcode anything, or else we can only hardcode existing
+  # directories.
+  hardcode_action=unsupported
+fi
+echo "$ac_t$hardcode_action" 1>&6
+
+echo $ac_n "checking whether stripping libraries is possible... $ac_c" 1>&6
+if test -n "$STRIP" && $STRIP -V 2>&1 | grep "GNU strip" >/dev/null; then
+  test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
+  test -z "$striplib" && striplib="$STRIP --strip-unneeded"
+  echo "${ac_t}yes" 1>&6
+else
+  echo "${ac_t}no" 1>&6
+fi
+
+reload_cmds='$LD$reload_flag -o $output$reload_objs'
+test -z "$deplibs_check_method" && deplibs_check_method=unknown
+
+# 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=
+shlibpath_overrides_runpath=unknown
+version_type=none
+dynamic_linker="$host_os ld.so"
+sys_lib_dlsearch_path_spec="/lib /usr/lib"
+sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
+
+echo $ac_n "checking dynamic linker characteristics... $ac_c" 1>&6
+case "$host_os" in
+aix3*)
+  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'
+  ;;
+
+aix4*)
+  version_type=linux
+  # AIX has no versioning support, so currently we can not hardcode correct
+  # soname into executable. Probably we can add versioning support to
+  # collect2, so additional links can be useful in future.
+  # We preserve .a as extension for shared libraries though AIX4.2
+  # and later linker supports .so
+  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.a'
+  shlibpath_var=LIBPATH
+  ;;
+
+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'
+  ;;
+
+beos*)
+  library_names_spec='${libname}.so'
+  dynamic_linker="$host_os ld.so"
+  shlibpath_var=LIBRARY_PATH
+  lt_cv_dlopen="load_add_on"
+  lt_cv_dlopen_libs=
+  lt_cv_dlopen_self=yes
+  ;;
+
+bsdi4*)
+  version_type=linux
+  need_version=no
+  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 $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
+  sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
+  export_dynamic_flag_spec=-rdynamic
+  # the default ld.so.conf also contains /usr/contrib/lib and
+  # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
+  # libtool to hard-code these into programs
+  ;;
+
+cygwin* | mingw*)
+  version_type=windows
+  need_version=no
+  need_lib_prefix=no
+  if test "$with_gcc" = yes; then
+    library_names_spec='${libname}`echo ${release} | sed -e 's/[.]/-/g'`${versuffix}.dll'
+  else
+    library_names_spec='${libname}`echo ${release} | sed -e 's/[.]/-/g'`${versuffix}.dll $libname.lib'
+  fi
+  dynamic_linker='Win32 ld.exe'
+  # FIXME: first we should search . and the directory the executable is in
+  shlibpath_var=PATH
+  lt_cv_dlopen="LoadLibrary"
+  lt_cv_dlopen_libs=
+  ;;
+
+freebsd1*)
+  dynamic_linker=no
+  ;;
+
+freebsd*)
+  objformat=`test -x /usr/bin/objformat && /usr/bin/objformat || echo aout`
+  version_type=freebsd-$objformat
+  case "$version_type" in
+    freebsd-elf*)
+      library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
+      need_version=no
+      need_lib_prefix=no
+      ;;
+    freebsd-*)
+      library_names_spec='${libname}${release}.so$versuffix $libname.so$versuffix'
+      need_version=yes
+      ;;
+  esac
+  shlibpath_var=LD_LIBRARY_PATH
+  case "$host_os" in
+  freebsd2*)
+    shlibpath_overrides_runpath=yes
+    ;;
+  freebsd3.[01]* | freebsdelf3.[01]*)
+    shlibpath_overrides_runpath=yes
+    hardcode_into_libs=yes
+    ;;
+  *) # from 3.2 on
+    shlibpath_overrides_runpath=no
+    hardcode_into_libs=yes
+    ;;
+  esac
+  ;;
+
+gnu*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so${major} ${libname}.so'
+  soname_spec='${libname}${release}.so$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  hardcode_into_libs=yes
+  ;;
+
+hpux9* | hpux10* | hpux11*)
+  # 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
+  need_lib_prefix=no
+  need_version=no
+  shlibpath_var=SHLIB_PATH
+  shlibpath_overrides_runpath=no # +s is required to enable 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=irix
+  need_lib_prefix=no
+  need_version=no
+  soname_spec='${libname}${release}.so.$major'
+  library_names_spec='${libname}${release}.so.$versuffix ${libname}${release}.so.$major ${libname}${release}.so $libname.so'
+  case "$host_os" in
+  irix5*)
+    libsuff= shlibsuff=
+    ;;
+  *)
+    case "$LD" in # libtool.m4 will add one of these switches to LD
+    *-32|*"-32 ") libsuff= shlibsuff= libmagic=32-bit;;
+    *-n32|*"-n32 ") libsuff=32 shlibsuff=N32 libmagic=N32;;
+    *-64|*"-64 ") libsuff=64 shlibsuff=64 libmagic=64-bit;;
+    *) libsuff= shlibsuff= libmagic=never-match;;
+    esac
+    ;;
+  esac
+  shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
+  shlibpath_overrides_runpath=no
+  sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
+  sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
+  ;;
+
+# 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
+  need_lib_prefix=no
+  need_version=no
+  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
+  shlibpath_overrides_runpath=no
+  # This implies no fast_install, which is unacceptable.
+  # Some rework will be needed to allow for fast_install
+  # before this can be enabled.
+  hardcode_into_libs=yes
+
+  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*)
+  version_type=sunos
+  if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+    library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+    finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+    dynamic_linker='NetBSD (a.out) ld.so'
+  else
+    library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major ${libname}${release}.so ${libname}.so'
+    soname_spec='${libname}${release}.so$major'
+    dynamic_linker='NetBSD ld.elf_so'
+  fi
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+openbsd*)
+  version_type=sunos
+  if test "$with_gnu_ld" = yes; then
+    need_lib_prefix=no
+    need_version=no
+  fi
+  library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+os2*)
+  libname_spec='$name'
+  need_lib_prefix=no
+  library_names_spec='$libname.dll $libname.a'
+  dynamic_linker='OS/2 ld.exe'
+  shlibpath_var=LIBPATH
+  ;;
+
+osf3* | osf4* | osf5*)
+  version_type=osf
+  need_version=no
+  soname_spec='${libname}${release}.so'
+  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
+  sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
+  ;;
+
+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
+  ;;
+
+solaris*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+  soname_spec='${libname}${release}.so$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  # ldd complains unless libraries are executable
+  postinstall_cmds='chmod +x $lib'
+  ;;
+
+sunos4*)
+  version_type=sunos
+  library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+  finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  if test "$with_gnu_ld" = yes; then
+    need_lib_prefix=no
+  fi
+  need_version=yes
+  ;;
+
+sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+  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
+  case "$host_vendor" in
+    motorola)
+      need_lib_prefix=no
+      need_version=no
+      shlibpath_overrides_runpath=no
+      sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
+      ;;
+  esac
+  ;;
+
+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
+  ;;
+
+dgux*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+  soname_spec='${libname}${release}.so$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+sysv4*MP*)
+  if test -d /usr/nec ;then
+    version_type=linux
+    library_names_spec='$libname.so.$versuffix $libname.so.$major $libname.so'
+    soname_spec='$libname.so.$major'
+    shlibpath_var=LD_LIBRARY_PATH
+  fi
+  ;;
+
+*)
+  dynamic_linker=no
+  ;;
+esac
+echo "$ac_t$dynamic_linker" 1>&6
+test "$dynamic_linker" = no && can_build_shared=no
+
+# 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='[BCDEGRST]'
+
+# 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 \2\3 \3'
+
+# Transform an extracted symbol line into a proper C declaration
+global_symbol_to_cdecl="sed -n -e 's/^. .* \(.*\)$/extern char \1;/p'"
+
+# Define system-specific variables.
+case "$host_os" in
+aix*)
+  symcode='[BCDT]'
+  ;;
+cygwin* | mingw*)
+  symcode='[ABCDGISTW]'
+  ;;
+hpux*) # Its linker distinguishes data from code symbols
+  global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern char \1();/p' -e 's/^. .* \(.*\)$/extern char \1;/p'"
+  ;;
+irix*)
+  symcode='[BCDEGRST]'
+  ;;
+solaris* | sysv5*)
+  symcode='[BDT]'
+  ;;
+sysv4)
+  symcode='[DFNSTU]'
+  ;;
+esac
+
+# Handle CRLF in mingw too chain
+opt_cr=
+case "$host_os" in
+mingw*)
+  opt_cr=`echo 'x\{0,1\}' | tr x '\015'` # option cr in regexp
+  ;;
+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='[ABCDGISTW]'
+fi
+
+# Try without a prefix undercore, then with it.
+for ac_symprfx in "" "_"; do
+
+  # Write the raw and C identifiers.
+global_symbol_pipe="sed -n -e 's/^.*[ 	]\($symcode\)[ 	][ 	]*\($ac_symprfx\)$sympat$opt_cr$/$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:1867: checking if global_symbol_pipe works" >&5
+  if { (eval echo $progname:1868: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; } && test -s conftest.$objext; then
+    # Now try to grab the symbols.
+    nlist=conftest.nm
+    if { echo "$progname:1871: eval \"$NM conftest.$objext | $global_symbol_pipe > $nlist\"" >&5; eval "$NM conftest.$objext | $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"
+      else
+	rm -f "$nlist"T
+      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.
+	  eval "$global_symbol_to_cdecl"' < "$nlist" >> conftest.c'
+
+	  cat <<EOF >> conftest.c
+#if defined (__STDC__) && __STDC__
+# define lt_ptr_t void *
+#else
+# define lt_ptr_t char *
+# define const
+#endif
+
+/* The mapping between symbol names and symbols. */
+const struct {
+  const char *name;
+  lt_ptr_t address;
+}
+lt_preloaded_symbols[] =
+{
+EOF
+	  sed 's/^. \(.*\) \(.*\)$/  {"\2", (lt_ptr_t) \&\2},/' < "$nlist" >> conftest.c
+	  cat <<\EOF >> conftest.c
+  {0, (lt_ptr_t) 0}
+};
+
+#ifdef __cplusplus
+}
+#endif
+EOF
+	  # Now try linking the two files.
+	  mv conftest.$objext conftstm.$objext
+	  save_LIBS="$LIBS"
+	  save_CFLAGS="$CFLAGS"
+	  LIBS="conftstm.$objext"
+	  CFLAGS="$CFLAGS$no_builtin_flag"
+	  if { (eval echo $progname:1923: \"$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* conftst*
+
+  # Do not use the global_symbol_pipe unless it works.
+  if test "$pipe_works" = yes; then
+    break
+  else
+    global_symbol_pipe=
+  fi
+done
+if test "$pipe_works" = yes; then
+  echo "${ac_t}ok" 1>&6
+else
+  echo "${ac_t}failed" 1>&6
+fi
+
+if test -z "$global_symbol_pipe"; then
+  global_symbol_to_cdecl=
+fi
+
+# Report the final consequences.
+echo "checking if libtool supports shared libraries... $can_build_shared" 1>&6
+
+# Only try to build win32 dlls if AC_LIBTOOL_WIN32_DLL was used in
+# configure.in, otherwise build static only libraries.
+case "$host_os" in
+cygwin* | mingw* | os2*)
+  if test x$can_build_shared = xyes; then
+    test x$enable_win32_dll = xno && can_build_shared=no
+    echo "checking if package supports dlls... $can_build_shared" 1>&6
+  fi
+;;
+esac
+
+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
+aix3*)
+  test "$enable_shared" = yes && enable_static=no
+  if test -n "$RANLIB"; then
+    archive_cmds="$archive_cmds~\$RANLIB \$lib"
+    postinstall_cmds='$RANLIB $lib'
+  fi
+  ;;
+
+aix4*)
+  test "$enable_shared" = yes && enable_static=no
+  ;;
+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
+
+if test "$hardcode_action" = relink || test "$hardcode_into_libs" = all; then
+  # Fast installation is not supported
+  enable_fast_install=no
+elif test "$shlibpath_overrides_runpath" = yes ||
+     test "$enable_shared" = no; then
+  # Fast installation is not necessary
+  enable_fast_install=needless
+fi
+
+# Check whether we must set pic_mode to default
+test -z "$pic_flag" && pic_mode=default
+# On Cygwin there's no "real" PIC flag so we must build both object types
+case "$host_os" in
+cygwin* | mingw* | os2*)
+  pic_mode=default
+  ;;
+esac
+if test $pic_mode = no && test "$deplibs_check_method" != pass_all; then
+  # non-PIC code in shared libraries is not supported
+  pic_mode=default
+fi
+
+if test "x$enable_dlopen" != xyes; then
+  enable_dlopen=unknown
+  enable_dlopen_self=unknown
+  enable_dlopen_self_static=unknown
+else
+if test "X${lt_cv_dlopen+set}" != Xset; then
+  lt_cv_dlopen=no lt_cv_dlopen_libs=
+echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
+echo "$progname:2032: checking for dlopen in -ldl" >&5
+if test "X${ac_cv_lib_dl_dlopen+set}" = Xset; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-ldl  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2039 "ltconfig"
+/* 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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dlopen();
+
+int main() {
+dlopen()
+; return 0; }
+EOF
+if { (eval echo $progname:2052: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  ac_cv_lib_dl_dlopen=yes
+else
+  echo "$progname: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_lib_dl_dlopen=no
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if test "X$ac_cv_lib_dl_dlopen" = Xyes; then
+  echo "$ac_t""yes" 1>&6
+  lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"
+else
+  echo "$ac_t""no" 1>&6
+echo $ac_n "checking for dlopen""... $ac_c" 1>&6
+echo "$progname:2071: checking for dlopen" >&5
+if test "X${ac_cv_func_dlopen+set}" = Xset; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2076 "ltconfig"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char dlopen(); 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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dlopen();
+
+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_dlopen) || defined (__stub___dlopen)
+choke me
+#else
+dlopen();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo $progname:2101: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  ac_cv_func_dlopen=yes
+else
+  echo "$progname: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_func_dlopen=no
+fi
+rm -f conftest*
+fi
+if test "X$ac_cv_func_dlopen" = Xyes; then
+  echo "$ac_t""yes" 1>&6
+  lt_cv_dlopen="dlopen"
+else
+  echo "$ac_t""no" 1>&6
+echo $ac_n "checking for dld_link in -ldld""... $ac_c" 1>&6
+echo "$progname:2118: checking for dld_link in -ldld" >&5
+if test "X${ac_cv_lib_dld_dld_link+set}" = Xset; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-ldld  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2125 "ltconfig"
+/* 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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dld_link();
+
+int main() {
+dld_link()
+; return 0; }
+EOF
+if { (eval echo $progname:2138: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  ac_cv_lib_dld_dld_link=yes
+else
+  echo "$progname: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_lib_dld_dld_link=no
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if test "X$ac_cv_lib_dld_dld_link" = Xyes; then
+  echo "$ac_t""yes" 1>&6
+  lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-ldld"
+else
+  echo "$ac_t""no" 1>&6
+echo $ac_n "checking for shl_load""... $ac_c" 1>&6
+echo "$progname:2157: checking for shl_load" >&5
+if test "X${ac_cv_func_shl_load+set}" = Xset; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2162 "ltconfig"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char shl_load(); 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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char shl_load();
+
+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_shl_load) || defined (__stub___shl_load)
+choke me
+#else
+shl_load();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo $progname:2187: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  ac_cv_func_shl_load=yes
+else
+  echo "$progname: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_func_shl_load=no
+fi
+rm -f conftest*
+fi
+
+if test "X$ac_cv_func_shl_load" = Xyes; then
+  echo "$ac_t""yes" 1>&6
+  lt_cv_dlopen="shl_load"
+else
+  echo "$ac_t""no" 1>&6
+echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
+echo "$progname:2205: checking for shl_load in -ldld" >&5
+if test "X${ac_cv_lib_dld_shl_load+set}" = Xset; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-ldld  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2212 "ltconfig"
+#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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char shl_load();
+
+int main() {
+shl_load()
+; return 0; }
+EOF
+if { (eval echo $progname:2226: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  ac_cv_lib_dld_shl_load=yes
+else
+  echo "$progname: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_lib_dld_shl_load=no
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if test "X$ac_cv_lib_dld_shl_load" = Xyes; then
+  echo "$ac_t""yes" 1>&6
+  lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-ldld"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+fi
+
+  if test "x$lt_cv_dlopen" != xno; then
+    enable_dlopen=yes
+  fi
+
+  case "$lt_cv_dlopen" in
+  dlopen)
+for ac_hdr in dlfcn.h; do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "$progname:2269: checking for $ac_hdr" >&5
+if eval "test \"`echo 'X$''{'ac_cv_header_$ac_safe'+set}'`\" = Xset"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2274 "ltconfig"
+#include <$ac_hdr>
+int fnord = 0;
+int main () { }
+EOF
+ac_try="$ac_compile >/dev/null 2>conftest.out"
+{ (eval echo $progname:2280: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "$progname: 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
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+    if test "x$ac_cv_header_dlfcn_h" = xyes; then
+      CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
+    fi
+    eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
+    LIBS="$lt_cv_dlopen_libs $LIBS"
+
+  echo $ac_n "checking whether a program can dlopen itself""... $ac_c" 1>&6
+echo "$progname:2308: checking whether a program can dlopen itself" >&5
+if test "X${lt_cv_dlopen_self+set}" = Xset; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test "$cross_compiling" = yes; then
+    lt_cv_dlopen_self=cross
+  else
+    cat > conftest.c <<EOF
+#line 2316 "ltconfig"
+
+#if HAVE_DLFCN_H
+#include <dlfcn.h>
+#endif
+
+#include <stdio.h>
+
+#ifdef RTLD_GLOBAL
+# define LTDL_GLOBAL	RTLD_GLOBAL
+#else
+# ifdef DL_GLOBAL
+#  define LTDL_GLOBAL	DL_GLOBAL
+# else
+#  define LTDL_GLOBAL	0
+# endif
+#endif
+
+/* We may have to define LTDL_LAZY_OR_NOW in the command line if we
+   find out it does not work in some platform. */
+#ifndef LTDL_LAZY_OR_NOW
+# ifdef RTLD_LAZY
+#  define LTDL_LAZY_OR_NOW	RTLD_LAZY
+# else
+#  ifdef DL_LAZY
+#   define LTDL_LAZY_OR_NOW	DL_LAZY
+#  else
+#   ifdef RTLD_NOW
+#    define LTDL_LAZY_OR_NOW	RTLD_NOW
+#   else
+#    ifdef DL_NOW
+#     define LTDL_LAZY_OR_NOW	DL_NOW
+#    else
+#     define LTDL_LAZY_OR_NOW	0
+#    endif
+#   endif
+#  endif
+# endif
+#endif
+
+fnord() { int i=42;}
+main() { void *self, *ptr1, *ptr2; self=dlopen(0,LTDL_GLOBAL|LTDL_LAZY_OR_NOW);
+    if(self) { ptr1=dlsym(self,"fnord"); ptr2=dlsym(self,"_fnord");
+	       if(ptr1 || ptr2) { dlclose(self); exit(0); } } exit(1); }
+
+EOF
+if { (eval echo $progname:2362: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
+then
+  lt_cv_dlopen_self=yes
+else
+  echo "$progname: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  lt_cv_dlopen_self=no
+fi
+rm -fr conftest*
+fi
+
+fi
+
+echo "$ac_t""$lt_cv_dlopen_self" 1>&6
+
+  if test "$lt_cv_dlopen_self" = yes; then
+    LDFLAGS="$LDFLAGS $link_static_flag"
+  echo $ac_n "checking whether a statically linked program can dlopen itself""... $ac_c" 1>&6
+echo "$progname:2381: checking whether a statically linked program can dlopen itself" >&5
+if test "X${lt_cv_dlopen_self_static+set}" = Xset; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test "$cross_compiling" = yes; then
+    lt_cv_dlopen_self_static=cross
+  else
+    cat > conftest.c <<EOF
+#line 2389 "ltconfig"
+
+#if HAVE_DLFCN_H
+#include <dlfcn.h>
+#endif
+
+#include <stdio.h>
+
+#ifdef RTLD_GLOBAL
+# define LTDL_GLOBAL	RTLD_GLOBAL
+#else
+# ifdef DL_GLOBAL
+#  define LTDL_GLOBAL	DL_GLOBAL
+# else
+#  define LTDL_GLOBAL	0
+# endif
+#endif
+
+/* We may have to define LTDL_LAZY_OR_NOW in the command line if we
+   find out it does not work in some platform. */
+#ifndef LTDL_LAZY_OR_NOW
+# ifdef RTLD_LAZY
+#  define LTDL_LAZY_OR_NOW	RTLD_LAZY
+# else
+#  ifdef DL_LAZY
+#   define LTDL_LAZY_OR_NOW	DL_LAZY
+#  else
+#   ifdef RTLD_NOW
+#    define LTDL_LAZY_OR_NOW	RTLD_NOW
+#   else
+#    ifdef DL_NOW
+#     define LTDL_LAZY_OR_NOW	DL_NOW
+#    else
+#     define LTDL_LAZY_OR_NOW	0
+#    endif
+#   endif
+#  endif
+# endif
+#endif
+
+fnord() { int i=42;}
+main() { void *self, *ptr1, *ptr2; self=dlopen(0,LTDL_GLOBAL|LTDL_LAZY_OR_NOW);
+    if(self) { ptr1=dlsym(self,"fnord"); ptr2=dlsym(self,"_fnord");
+    if(ptr1 || ptr2) { dlclose(self); exit(0); } } exit(1); }
+
+EOF
+if { (eval echo $progname:2435: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
+then
+  lt_cv_dlopen_self_static=yes
+else
+  echo "$progname: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  lt_cv_dlopen_self_static=no
+fi
+rm -fr conftest*
+fi
+
+fi
+
+echo "$ac_t""$lt_cv_dlopen_self_static" 1>&6
+fi
+    ;;
+  esac
+
+  case "$lt_cv_dlopen_self" in
+  yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
+  *) enable_dlopen_self=unknown ;;
+  esac
+
+  case "$lt_cv_dlopen_self_static" in
+  yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
+  *) enable_dlopen_self_static=unknown ;;
+  esac
+fi
+
+# Copy echo and quote the copy, instead of the original, because it is
+# used later.
+ltecho="$echo"
+if test "X$ltecho" = "X$CONFIG_SHELL $0 --fallback-echo"; then
+   ltecho="$CONFIG_SHELL \$0 --fallback-echo"
+fi
+LTSHELL="$SHELL"
+
+LTCONFIG_VERSION="$VERSION"
+
+# Only quote variables if we're using ltmain.sh.
+case "$ltmain" in
+*.sh)
+  # Now quote all the things that may contain metacharacters.
+  for var in ltecho old_AR old_CC old_CFLAGS old_CPPFLAGS \
+    old_MAGIC old_LD old_LDFLAGS old_LIBS \
+    old_LN_S old_NM old_RANLIB old_STRIP \
+    old_AS old_DLLTOOL old_OBJDUMP \
+    old_OBJEXT old_EXEEXT old_reload_flag \
+    old_deplibs_check_method old_file_magic_cmd \
+    AR CC LD LN_S NM LTSHELL LTCONFIG_VERSION \
+    reload_flag reload_cmds wl \
+    pic_flag link_static_flag no_builtin_flag export_dynamic_flag_spec \
+    thread_safe_flag_spec whole_archive_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 archive_expsym_cmds postinstall_cmds \
+    postuninstall_cmds extract_expsyms_cmds old_archive_from_expsyms_cmds \
+    old_striplib striplib file_magic_cmd export_symbols_cmds \
+    deplibs_check_method allow_undefined_flag no_undefined_flag \
+    finish_cmds finish_eval global_symbol_pipe global_symbol_to_cdecl \
+    hardcode_libdir_flag_spec hardcode_libdir_separator  \
+    sys_lib_search_path_spec sys_lib_dlsearch_path_spec \
+    compiler_c_o compiler_o_lo need_locks exclude_expsyms include_expsyms; do
+
+    case "$var" in
+    reload_cmds | old_archive_cmds | old_archive_from_new_cmds | \
+    old_postinstall_cmds | old_postuninstall_cmds | \
+    export_symbols_cmds | archive_cmds | archive_expsym_cmds | \
+    extract_expsyms_cmds | old_archive_from_expsyms_cmds | \
+    postinstall_cmds | postuninstall_cmds | \
+    finish_cmds | sys_lib_search_path_spec | sys_lib_dlsearch_path_spec)
+      # Double-quote double-evaled strings.
+      eval "$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\"" ### testsuite: skip nested quoting test
+      ;;
+    *)
+      eval "$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\"" ### testsuite: skip nested quoting test
+      ;;
+    esac
+  done
+
+  case "$ltecho" in
+  *'\$0 --fallback-echo"')
+    ltecho=`$echo "X$ltecho" | $Xsed -e 's/\\\\\\\$0 --fallback-echo"$/$0 --fallback-echo"/'`
+    ;;
+  esac
+
+  trap "$rm \"$ofile\"; exit 1" 1 2 15
+  echo "creating $ofile"
+  $rm "$ofile"
+  cat <<EOF > "$ofile"
+#! $SHELL
+
+# `$echo "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services.
+# Generated automatically by $PROGRAM (GNU $PACKAGE $VERSION$TIMESTAMP)
+# NOTE: Changes made to this file will be lost: look at ltconfig or ltmain.sh.
+#
+# Copyright (C) 1996-2000 Free Software Foundation, Inc.
+# Originally by 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.
+
+# 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 "X\${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
+
+### BEGIN LIBTOOL CONFIG
+EOF
+  cfgfile="$ofile"
+  ;;
+
+*)
+  # Double-quote the variables that need it (for aesthetics).
+  for var in old_AR old_CC old_CFLAGS old_CPPFLAGS \
+    old_MAGIC old_LD old_LDFLAGS old_LIBS \
+    old_LN_S old_NM old_RANLIB old_STRIP \
+    old_AS old_DLLTOOL old_OBJDUMP \
+    old_OBJEXT old_EXEEXT old_reload_flag \
+    old_deplibs_check_method old_file_magic_cmd; do
+    eval "$var=\\\"\$var\\\""
+  done
+
+  # Just create a config file.
+  cfgfile="$ofile.cfg"
+  trap "$rm \"$cfgfile\"; exit 1" 1 2 15
+  echo "creating $cfgfile"
+  $rm "$cfgfile"
+  cat <<EOF > "$cfgfile"
+# `$echo "$cfgfile" | sed 's%^.*/%%'` - Libtool configuration file.
+# Generated automatically by $PROGRAM (GNU $PACKAGE $VERSION$TIMESTAMP)
+EOF
+  ;;
+esac
+
+cat <<EOF >> "$cfgfile"
+# Libtool was configured as follows, on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# AR=$old_AR CC=$old_CC CFLAGS=$old_CFLAGS CPPFLAGS=$old_CPPFLAGS \\
+# MAGIC=$old_MAGIC LD=$old_LD LDFLAGS=$old_LDFLAGS LIBS=$old_LIBS \\
+# LN_S=$old_LN_S NM=$old_NM RANLIB=$old_RANLIB STRIP=$old_STRIP \\
+# AS=$old_AS DLLTOOL=$old_DLLTOOL OBJDUMP=$old_OBJDUMP \\
+# objext=$old_OBJEXT exeext=$old_EXEEXT reload_flag=$old_reload_flag \\
+# deplibs_check_method=$old_deplibs_check_method file_magic_cmd=$old_file_magic_cmd \\
+#   $0$ltconfig_args
+#
+# Compiler and other test output produced by $progname, useful for
+# debugging $progname, is in ./config.log if it exists.
+# The version of $progname that generated this script.
+LTCONFIG_VERSION=$LTCONFIG_VERSION
+
+# Shell to use when invoking shell scripts.
+SHELL=$LTSHELL
+
+# Whether or not to build shared libraries.
+build_libtool_libs=$enable_shared
+
+# Whether or not to build static libraries.
+build_old_libs=$enable_static
+
+# Whether or not to optimize for fast installation.
+fast_install=$enable_fast_install
+
+# The host system.
+host_alias=$host_alias
+host=$host
+
+# An echo program that does not interpret backslashes.
+echo=$ltecho
+
+# 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
+
+# A symbol stripping program
+STRIP=$STRIP
+
+# Used to examine libraries when file_magic_cmd begins "file"
+MAGIC=$MAGIC
+
+# Used on cygwin: DLL creation program.
+DLLTOOL="$DLLTOOL"
+
+# Used on cygwin: object dumper.
+OBJDUMP="$OBJDUMP"
+
+# Used on cygwin: assembler.
+AS="$AS"
+
+# 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
+
+# Object file suffix (normally "o").
+objext="$objext"
+
+# Old archive suffix (normally "a").
+libext="$libext"
+
+# Executable file suffix (normally "").
+exeext="$exeext"
+
+# Additional compiler flags for building library objects.
+pic_flag=$pic_flag
+pic_mode=$pic_mode
+
+# Does compiler simultaneously support -c and -o options?
+compiler_c_o=$compiler_c_o
+
+# Can we write directly to a .lo ?
+compiler_o_lo=$compiler_o_lo
+
+# Must we lock files when doing compilation ?
+need_locks=$need_locks
+
+# Do we need the lib prefix for modules?
+need_lib_prefix=$need_lib_prefix
+
+# Do we need a version for libraries?
+need_version=$need_version
+
+# Whether dlopen is supported.
+dlopen_support=$enable_dlopen
+
+# Whether dlopen of programs is supported.
+dlopen_self=$enable_dlopen_self
+
+# Whether dlopen of statically linked programs is supported.
+dlopen_self_static=$enable_dlopen_self_static
+
+# 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
+
+# Compiler flag to generate shared objects directly from archives.
+whole_archive_flag_spec=$whole_archive_flag_spec
+
+# Compiler flag to generate thread-safe objects.
+thread_safe_flag_spec=$thread_safe_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
+
+# Create a temporary old-style archive to link instead of a shared archive.
+old_archive_from_expsyms_cmds=$old_archive_from_expsyms_cmds
+
+# Commands used to build and install a shared archive.
+archive_cmds=$archive_cmds
+archive_expsym_cmds=$archive_expsym_cmds
+postinstall_cmds=$postinstall_cmds
+postuninstall_cmds=$postuninstall_cmds
+
+# Commands to strip libraries.
+old_striplib=$old_striplib
+striplib=$striplib
+
+# Method to check whether dependent libraries are shared objects.
+deplibs_check_method=$deplibs_check_method
+
+# Command to use when deplibs_check_method == file_magic.
+file_magic_cmd=$file_magic_cmd
+
+# 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
+
+# Transform the output of nm in a proper C declaration
+global_symbol_to_cdecl=$global_symbol_to_cdecl
+
+# This is the shared library runtime path variable.
+runpath_var=$runpath_var
+
+# This is the shared library path variable.
+shlibpath_var=$shlibpath_var
+
+# Is shlibpath searched before the hard-coded library search path?
+shlibpath_overrides_runpath=$shlibpath_overrides_runpath
+
+# How to hardcode a shared library path into an executable.
+hardcode_action=$hardcode_action
+
+# Whether we should hardcode library paths into libraries.
+hardcode_into_libs=$hardcode_into_libs
+
+# 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
+
+# Whether libtool must link a program against all its dependency libraries.
+link_all_deplibs=$link_all_deplibs
+
+# Compile-time system search path for libraries
+sys_lib_search_path_spec=$sys_lib_search_path_spec
+
+# Run-time system search path for libraries
+sys_lib_dlsearch_path_spec=$sys_lib_dlsearch_path_spec
+
+# Fix the shell variable \$srcfile for the compiler.
+fix_srcfile_path="$fix_srcfile_path"
+
+# Set to yes if exported symbols are required.
+always_export_symbols=$always_export_symbols
+
+# The commands to list exported symbols.
+export_symbols_cmds=$export_symbols_cmds
+
+# The commands to extract the exported symbol list from a shared archive.
+extract_expsyms_cmds=$extract_expsyms_cmds
+
+# Symbols that should not be listed in the preloaded symbols.
+exclude_expsyms=$exclude_expsyms
+
+# Symbols that must always be exported.
+include_expsyms=$include_expsyms
+
+EOF
+
+case "$ltmain" in
+*.sh)
+  echo '### END LIBTOOL CONFIG' >> "$ofile"
+  echo >> "$ofile"
+  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 "X${COLLECT_NAMES+set}" != Xset; then
+  COLLECT_NAMES=
+  export COLLECT_NAMES
+fi
+EOF
+    ;;
+  esac
+  case "$host" in
+  *-*-cygwin* | *-*-mingw* | *-*-os2*)
+    cat <<'EOF' >> "$ofile"
+      # This is a source program that is used to create dlls on Windows
+      # Don't remove nor modify the starting and closing comments
+# /* ltdll.c starts here */
+# #define WIN32_LEAN_AND_MEAN
+# #include <windows.h>
+# #undef WIN32_LEAN_AND_MEAN
+# #include <stdio.h>
+#
+# #ifndef __CYGWIN__
+# #  ifdef __CYGWIN32__
+# #    define __CYGWIN__ __CYGWIN32__
+# #  endif
+# #endif
+#
+# #ifdef __cplusplus
+# extern "C" {
+# #endif
+# BOOL APIENTRY DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved);
+# #ifdef __cplusplus
+# }
+# #endif
+#
+# #ifdef __CYGWIN__
+# #include <cygwin/cygwin_dll.h>
+# DECLARE_CYGWIN_DLL( DllMain );
+# #endif
+# HINSTANCE __hDllInstance_base;
+#
+# BOOL APIENTRY
+# DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved)
+# {
+#   __hDllInstance_base = hInst;
+#   return TRUE;
+# }
+# /* ltdll.c ends here */
+      # This is a source program that is used to create import libraries
+      # on Windows for dlls which lack them. Don't remove nor modify the
+      # starting and closing comments
+# /* impgen.c starts here */
+# /*   Copyright (C) 1999-2000 Free Software Foundation, Inc.
+#
+#  This file is part of GNU libtool.
+#
+#  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.
+#  */
+#
+#  #include <stdio.h>		/* for printf() */
+#  #include <unistd.h>		/* for open(), lseek(), read() */
+#  #include <fcntl.h>		/* for O_RDONLY, O_BINARY */
+#  #include <string.h>		/* for strdup() */
+#
+#  /* O_BINARY isn't required (or even defined sometimes) under Unix */
+#  #ifndef O_BINARY
+#  #define O_BINARY 0
+#  #endif
+#
+#  static unsigned int
+#  pe_get16 (fd, offset)
+#       int fd;
+#       int offset;
+#  {
+#    unsigned char b[2];
+#    lseek (fd, offset, SEEK_SET);
+#    read (fd, b, 2);
+#    return b[0] + (b[1]<<8);
+#  }
+#
+#  static unsigned int
+#  pe_get32 (fd, offset)
+#      int fd;
+#      int offset;
+#  {
+#    unsigned char b[4];
+#    lseek (fd, offset, SEEK_SET);
+#    read (fd, b, 4);
+#    return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
+#  }
+#
+#  static unsigned int
+#  pe_as32 (ptr)
+#       void *ptr;
+#  {
+#    unsigned char *b = ptr;
+#    return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
+#  }
+#
+#  int
+#  main (argc, argv)
+#      int argc;
+#      char *argv[];
+#  {
+#      int dll;
+#      unsigned long pe_header_offset, opthdr_ofs, num_entries, i;
+#      unsigned long export_rva, export_size, nsections, secptr, expptr;
+#      unsigned long name_rvas, nexp;
+#      unsigned char *expdata, *erva;
+#      char *filename, *dll_name;
+#
+#      filename = argv[1];
+#
+#      dll = open(filename, O_RDONLY|O_BINARY);
+#      if (!dll)
+#  	return 1;
+#
+#      dll_name = filename;
+#
+#      for (i=0; filename[i]; i++)
+#  	if (filename[i] == '/' || filename[i] == '\\'  || filename[i] == ':')
+#  	    dll_name = filename + i +1;
+#
+#      pe_header_offset = pe_get32 (dll, 0x3c);
+#      opthdr_ofs = pe_header_offset + 4 + 20;
+#      num_entries = pe_get32 (dll, opthdr_ofs + 92);
+#
+#      if (num_entries < 1) /* no exports */
+#  	return 1;
+#
+#      export_rva = pe_get32 (dll, opthdr_ofs + 96);
+#      export_size = pe_get32 (dll, opthdr_ofs + 100);
+#      nsections = pe_get16 (dll, pe_header_offset + 4 +2);
+#      secptr = (pe_header_offset + 4 + 20 +
+#  	      pe_get16 (dll, pe_header_offset + 4 + 16));
+#
+#      expptr = 0;
+#      for (i = 0; i < nsections; i++)
+#      {
+#  	char sname[8];
+#  	unsigned long secptr1 = secptr + 40 * i;
+#  	unsigned long vaddr = pe_get32 (dll, secptr1 + 12);
+#  	unsigned long vsize = pe_get32 (dll, secptr1 + 16);
+#  	unsigned long fptr = pe_get32 (dll, secptr1 + 20);
+#  	lseek(dll, secptr1, SEEK_SET);
+#  	read(dll, sname, 8);
+#  	if (vaddr <= export_rva && vaddr+vsize > export_rva)
+#  	{
+#  	    expptr = fptr + (export_rva - vaddr);
+#  	    if (export_rva + export_size > vaddr + vsize)
+#  		export_size = vsize - (export_rva - vaddr);
+#  	    break;
+#  	}
+#      }
+#
+#      expdata = (unsigned char*)malloc(export_size);
+#      lseek (dll, expptr, SEEK_SET);
+#      read (dll, expdata, export_size);
+#      erva = expdata - export_rva;
+#
+#      nexp = pe_as32 (expdata+24);
+#      name_rvas = pe_as32 (expdata+32);
+#
+#      printf ("EXPORTS\n");
+#      for (i = 0; i<nexp; i++)
+#      {
+#  	unsigned long name_rva = pe_as32 (erva+name_rvas+i*4);
+#  	printf ("\t%s @ %ld ;\n", erva+name_rva, 1+ i);
+#      }
+#
+#      return 0;
+#  }
+# /* impgen.c ends here */
+
+EOF
+    ;;
+  esac
+
+
+  # Append the ltmain.sh script.
+  sed '$q' "$ltmain" >> "$ofile" || (rm -f "$ofile"; exit 1)
+  # We use sed instead of cat because bash on DJGPP gets confused if
+  # if finds mixed CR/LF and LF-only lines.  Since sed operates in
+  # text mode, it properly converts lines to CR/LF.  This bash problem
+  # is reportedly fixed, but why not run on old versions too?
+
+  chmod +x "$ofile"
+  ;;
+
+*)
+  # Compile the libtool program.
+  echo "FIXME: would compile $ltmain"
+  ;;
+esac
+
+test -n "$cache_file" || exit 0
+
+# AC_CACHE_SAVE
+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 | grep ac_space) 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
+
+exit 0
+
+# Local Variables:
+# mode:shell-script
+# sh-indentation:2
+# End:
diff --git a/src/gmp/ltmain.sh b/src/gmp/ltmain.sh
new file mode 100644
index 000000000..d81d89f87
--- /dev/null
+++ b/src/gmp/ltmain.sh
@@ -0,0 +1,4692 @@
+# ltmain.sh - Provide generalized library-building support services.
+# NOTE: Changing this file will not affect anything until you rerun ltconfig.
+#
+# Copyright (C) 1996-2000 Free Software Foundation, Inc.
+# Originally by 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.
+
+# Check that we have a working $echo.
+if test "X$1" = X--no-reexec; then
+  # Discard the --no-reexec flag, and continue.
+  shift
+elif test "X$1" = X--fallback-echo; then
+  # Avoid inline document here, it may be left over
+  :
+elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then
+  # Yippee, $echo works!
+  :
+else
+  # Restart under the correct shell, and then maybe $echo will work.
+  exec $SHELL "$0" --no-reexec ${1+"$@"}
+fi
+
+if test "X$1" = X--fallback-echo; then
+  # used as fallback echo
+  shift
+  cat <<EOF
+$*
+EOF
+  exit 0
+fi
+
+# The name of this program.
+progname=`$echo "$0" | sed 's%^.*/%%'`
+modename="$progname"
+
+# Constants.
+PROGRAM=ltmain.sh
+PACKAGE=libtool
+VERSION=1.3c
+TIMESTAMP=" (1.696 2000/03/14 20:22:42)"
+
+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 1s/^X//'
+sed_quote_subst='s/\([\\`\\"$\\\\]\)/\\\1/g'
+SP2NL='tr \040 \012'
+NL2SP='tr \015\012 \040\040'
+
+# 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).
+# We save the old values to restore during execute mode.
+if test "${LC_ALL+set}" = set; then
+  save_LC_ALL="$LC_ALL"; LC_ALL=C; export LC_ALL
+fi
+if test "${LANG+set}" = set; then
+  save_LANG="$LANG"; 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=
+lo2o="s/\\.lo\$/.${objext}/"
+o2lo="s/\\.${objext}\$/.lo/"
+
+# 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$TIMESTAMP"
+    exit 0
+    ;;
+
+  --config)
+    sed -e '1,/^### BEGIN LIBTOOL CONFIG/d' -e '/^### END LIBTOOL CONFIG/,$d' $0
+    exit 0
+    ;;
+
+  --debug)
+    echo "$progname: enabling shell trace mode"
+    set -x
+    ;;
+
+  --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 | *strace | *truss)
+      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=
+    prev=
+    lastarg=
+    srcfile="$nonopt"
+    suppress_output=
+
+    user_target=no
+    for arg
+    do
+      case "$prev" in
+      "") ;;
+      xcompiler)
+	# Aesthetically quote the previous argument.
+	prev=
+	lastarg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
+
+	case "$arg" in
+	# Double-quote args containing other shell metacharacters.
+	# Many Bourne shells cannot handle close brackets correctly
+	# in scan sets, so we specify it separately.
+	*[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
+	  arg="\"$arg\""
+	  ;;
+	esac
+
+	# Add the previous argument to base_compile.
+	if test -z "$base_compile"; then
+	  base_compile="$lastarg"
+	else
+	  base_compile="$base_compile $lastarg"
+	fi
+	continue
+	;;
+      esac
+
+      # Accept any command-line options.
+      case "$arg" in
+      -o)
+	if test "$user_target" != "no"; then
+	  $echo "$modename: you cannot specify \`-o' more than once" 1>&2
+	  exit 1
+	fi
+	user_target=next
+	;;
+
+      -static)
+	build_old_libs=yes
+	continue
+	;;
+
+      -Xcompiler)
+	prev=xcompiler
+	continue
+	;;
+
+      -Wc,*)
+	args=`$echo "X$arg" | $Xsed -e "s/^-Wc,//"`
+	lastarg=
+	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS=','
+	for arg in $args; do
+	  IFS="$save_ifs"
+
+	  # Double-quote args containing other shell metacharacters.
+	  # Many Bourne shells cannot handle close brackets correctly
+	  # in scan sets, so we specify it separately.
+	  case "$arg" in
+	    *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
+	    arg="\"$arg\""
+	    ;;
+	  esac
+	  lastarg="$lastarg $arg"
+	done
+	IFS="$save_ifs"
+	lastarg=`$echo "X$lastarg" | $Xsed -e "s/^ //"`
+
+	# Add the arguments to base_compile.
+	if test -z "$base_compile"; then
+	  base_compile="$lastarg"
+	else
+	  base_compile="$base_compile $lastarg"
+	fi
+	continue
+	;;
+      esac
+
+      case "$user_target" in
+      next)
+	# The next one is the -o target name
+	user_target=yes
+	continue
+	;;
+      yes)
+	# We got the output file
+	user_target=set
+	libobj="$arg"
+	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
+
+    case "$user_target" in
+    set)
+      ;;
+    no)
+      # Get the name of the library object.
+      libobj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%'`
+      ;;
+    *)
+      $echo "$modename: you must specify a target with \`-o'" 1>&2
+      exit 1
+      ;;
+    esac
+
+    # Recognize several different file suffixes.
+    # If the user specifies -o file.o, it is replaced with file.lo
+    xform='[cCFSfmso]'
+    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 "$lo2o"` ;;
+    *)
+      $echo "$modename: cannot determine name of library object from \`$libobj'" 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
+      removelist="$obj $libobj"
+    else
+      removelist="$libobj"
+    fi
+
+    $run $rm $removelist
+    trap "$run $rm $removelist; exit 1" 1 2 15
+
+    # Calculate the filename of the output object if compiler does
+    # not support -o with -c
+    if test "$compiler_c_o" = no; then
+      output_obj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%' -e 's%\..*$%%'`.${objext}
+      lockfile="$output_obj.lock"
+      removelist="$removelist $output_obj $lockfile"
+      trap "$run $rm $removelist; exit 1" 1 2 15
+    else
+      need_locks=no
+      lockfile=
+    fi
+
+    # Lock this critical section if it is needed
+    # We use this script file to make the link, it avoids creating a new file
+    if test "$need_locks" = yes; then
+      until ln "$0" "$lockfile" 2>/dev/null; do
+	$show "Waiting for $lockfile to be removed"
+	sleep 2
+      done
+    elif test "$need_locks" = warn; then
+      if test -f "$lockfile"; then
+	echo "\
+*** ERROR, $lockfile exists and contains:
+`cat $lockfile 2>/dev/null`
+
+This indicates that another process is trying to use the same
+temporary object file, and libtool could not work around it because
+your compiler does not support \`-c' and \`-o' together.  If you
+repeat this compilation, it may succeed, by chance, but you had better
+avoid parallel builds (make -j) in this platform, or get a better
+compiler."
+
+	$run $rm $removelist
+	exit 1
+      fi
+      echo $srcfile > "$lockfile"
+    fi
+
+    if test -n "$fix_srcfile_path"; then
+      eval srcfile=\"$fix_srcfile_path\"
+    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
+
+      if test "$pic_mode" != no; then
+	# All platforms use -DPIC, to notify preprocessed assembler code.
+	command="$base_compile $srcfile $pic_flag -DPIC"
+      else
+	# Don't build PIC code
+	command="$base_compile $srcfile"
+      fi
+      if test "$build_old_libs" = yes; then
+	lo_libobj="$libobj"
+	dir=`$echo "X$libobj" | $Xsed -e 's%/[^/]*$%%'`
+	if test "X$dir" = "X$libobj"; then
+	  dir="$objdir"
+	else
+	  dir="$dir/$objdir"
+	fi
+	libobj="$dir/"`$echo "X$libobj" | $Xsed -e 's%^.*/%%'`
+
+	if test -d "$dir"; then
+	  $show "$rm $libobj"
+	  $run $rm $libobj
+	else
+	  $show "$mkdir $dir"
+	  $run $mkdir $dir
+	  status=$?
+	  if test $status -ne 0 && test ! -d $dir; then
+	    exit $status
+	  fi
+	fi
+      fi
+      if test "$compiler_o_lo" = yes; then
+	output_obj="$libobj"
+	command="$command -o $output_obj"
+      elif test "$compiler_c_o" = yes; then
+	output_obj="$obj"
+	command="$command -o $output_obj"
+      fi
+
+      $run $rm "$output_obj"
+      $show "$command"
+      if $run eval "$command"; then :
+      else
+	test -n "$output_obj" && $run $rm $removelist
+	exit 1
+      fi
+
+      if test "$need_locks" = warn &&
+	 test x"`cat $lockfile 2>/dev/null`" != x"$srcfile"; then
+	echo "\
+*** ERROR, $lockfile contains:
+`cat $lockfile 2>/dev/null`
+
+but it should contain:
+$srcfile
+
+This indicates that another process is trying to use the same
+temporary object file, and libtool could not work around it because
+your compiler does not support \`-c' and \`-o' together.  If you
+repeat this compilation, it may succeed, by chance, but you had better
+avoid parallel builds (make -j) in this platform, or get a better
+compiler."
+
+	$run $rm $removelist
+	exit 1
+      fi
+
+      # Just move the object if needed, then go on to compile the next one
+      if test x"$output_obj" != x"$libobj"; then
+	$show "$mv $output_obj $libobj"
+	if $run $mv $output_obj $libobj; then :
+	else
+	  error=$?
+	  $run $rm $removelist
+	  exit $error
+	fi
+      fi
+
+      # If we have no pic_flag, then copy the object into place and finish.
+      if (test -z "$pic_flag" || test "$pic_mode" != default) &&
+	 test "$build_old_libs" = yes; then
+	# Rename the .lo from within objdir to obj
+	if test -f $obj; then
+	  $show $rm $obj
+	  $run $rm $obj
+	fi
+
+	$show "$mv $libobj $obj"
+	if $run $mv $libobj $obj; then :
+	else
+	  error=$?
+	  $run $rm $removelist
+	  exit $error
+	fi
+
+	xdir=`$echo "X$obj" | $Xsed -e 's%/[^/]*$%%'`
+	if test "X$xdir" = "X$obj"; then
+	  xdir="."
+	else
+	  xdir="$xdir"
+	fi
+	baseobj=`$echo "X$obj" | $Xsed -e "s%.*/%%"`
+	libobj=`$echo "X$baseobj" | $Xsed -e "$o2lo"`
+	# Now arrange that obj and lo_libobj become the same file
+	$show "(cd $xdir && $LN_S $baseobj $libobj)"
+	if $run eval '(cd $xdir && $LN_S $baseobj $libobj)'; then
+	  exit 0
+	else
+	  error=$?
+	  $run $rm $removelist
+	  exit $error
+	fi
+      fi
+
+      # 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
+      if test "$pic_mode" != yes; then
+	# Don't build PIC code
+	command="$base_compile $srcfile"
+      else
+	# All platforms use -DPIC, to notify preprocessed assembler code.
+	command="$base_compile $srcfile $pic_flag -DPIC"
+      fi
+      if test "$compiler_c_o" = yes; then
+	command="$command -o $obj"
+	output_obj="$obj"
+      fi
+
+      # Suppress compiler output if we already did a PIC compilation.
+      command="$command$suppress_output"
+      $run $rm "$output_obj"
+      $show "$command"
+      if $run eval "$command"; then :
+      else
+	$run $rm $removelist
+	exit 1
+      fi
+
+      if test "$need_locks" = warn &&
+	 test x"`cat $lockfile 2>/dev/null`" != x"$srcfile"; then
+	echo "\
+*** ERROR, $lockfile contains:
+`cat $lockfile 2>/dev/null`
+
+but it should contain:
+$srcfile
+
+This indicates that another process is trying to use the same
+temporary object file, and libtool could not work around it because
+your compiler does not support \`-c' and \`-o' together.  If you
+repeat this compilation, it may succeed, by chance, but you had better
+avoid parallel builds (make -j) in this platform, or get a better
+compiler."
+
+	$run $rm $removelist
+	exit 1
+      fi
+
+      # Just move the object if needed
+      if test x"$output_obj" != x"$obj"; then
+	$show "$mv $output_obj $obj"
+	if $run $mv $output_obj $obj; then :
+	else
+	  error=$?
+	  $run $rm $removelist
+	  exit $error
+	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 $?
+      else
+	# Move the .lo from within objdir
+	$show "$mv $libobj $lo_libobj"
+	if $run $mv $libobj $lo_libobj; then :
+	else
+	  error=$?
+	  $run $rm $removelist
+	  exit $error
+	fi
+      fi
+    fi
+
+    # Unlock the critical section if it was locked
+    if test "$need_locks" != no; then
+      $rm "$lockfile"
+    fi
+
+    exit 0
+    ;;
+
+  # libtool link mode
+  link | relink)
+    modename="$modename: link"
+    case "$host" in
+    *-*-cygwin* | *-*-mingw* | *-*-os2*)
+      # It is impossible to link a dll without this setting, and
+      # we shouldn't force the makefile maintainer to figure out
+      # which system we are compiling for in order to pass an extra
+      # flag for every libtool invokation.
+      # allow_undefined=no
+
+      # FIXME: Unfortunately, there are problems with the above when trying
+      # to make a dll which has undefined symbols, in which case not
+      # even a static library is built.  For now, we need to specify
+      # -no-undefined on the libtool link line when we can be certain
+      # that all symbols are satisfied, otherwise we get a static library.
+      allow_undefined=yes
+      ;;
+    *)
+      allow_undefined=yes
+      ;;
+    esac
+    libtool_args="$nonopt"
+    compile_command="$nonopt"
+    finalize_command="$nonopt"
+
+    compile_rpath=
+    finalize_rpath=
+    compile_shlibpath=
+    finalize_shlibpath=
+    convenience=
+    old_convenience=
+    deplibs=
+    old_deplibs=
+    compiler_flags=
+    linker_flags=
+    dllsearchpath=
+    lib_search_path=`pwd`
+
+    avoid_version=no
+    dlfiles=
+    dlprefiles=
+    dlself=no
+    export_dynamic=no
+    export_symbols=
+    export_symbols_regex=
+    generated=
+    libobjs=
+    ltlibs=
+    module=no
+    no_install=no
+    objs=
+    prefer_static_libs=no
+    preload=no
+    prev=
+    prevarg=
+    release=
+    rpath=
+    xrpath=
+    perm_rpath=
+    temp_rpath=
+    thread_safe=no
+    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"; then
+	  if 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
+	  if test -n "$link_static_flag"; then
+	    dlopen_self=$dlopen_self_static
+	  fi
+	else
+	  if test -z "$pic_flag" && test -n "$link_static_flag"; then
+	    dlopen_self=$dlopen_self_static
+	  fi
+	fi
+	build_libtool_libs=no
+	build_old_libs=yes
+	prefer_static_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.
+    while test $# -gt 0; do
+      arg="$1"
+      shift
+      case "$arg" in
+      *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
+	qarg=\"`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`\" ### testsuite: skip nested quoting test
+	;;
+      *) qarg=$arg ;;
+      esac
+      libtool_args="$libtool_args $qarg"
+
+      # 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)
+	  if test "$preload" = no; then
+	    # Add the symbol object into the linking commands.
+	    compile_command="$compile_command @SYMFILE@"
+	    finalize_command="$finalize_command @SYMFILE@"
+	    preload=yes
+	  fi
+	  case "$arg" in
+	  *.la | *.lo) ;;  # We handle these cases below.
+	  force)
+	    if test "$dlself" = no; then
+	      dlself=needless
+	      export_dynamic=yes
+	    fi
+	    prev=
+	    continue
+	    ;;
+	  self)
+	    if test "$prev" = dlprefiles; then
+	      dlself=yes
+	    elif test "$prev" = dlfiles && test "$dlopen_self" != yes; then
+	      dlself=yes
+	    else
+	      dlself=needless
+	      export_dynamic=yes
+	    fi
+	    prev=
+	    continue
+	    ;;
+	  *)
+	    if test "$prev" = dlfiles; then
+	      dlfiles="$dlfiles $arg"
+	    else
+	      dlprefiles="$dlprefiles $arg"
+	    fi
+	    prev=
+	    continue
+	    ;;
+	  esac
+	  ;;
+	expsyms)
+	  export_symbols="$arg"
+	  if test ! -f "$arg"; then
+	    $echo "$modename: symbol file \`$arg' does not exist"
+	    exit 1
+	  fi
+	  prev=
+	  continue
+	  ;;
+	expsyms_regex)
+	  export_symbols_regex="$arg"
+	  prev=
+	  continue
+	  ;;
+	release)
+	  release="-$arg"
+	  prev=
+	  continue
+	  ;;
+	rpath | xrpath)
+	  # We need an absolute path.
+	  case "$arg" in
+	  [\\/]* | [A-Za-z]:[\\/]*) ;;
+	  *)
+	    $echo "$modename: only absolute run-paths are allowed" 1>&2
+	    exit 1
+	    ;;
+	  esac
+	  if test "$prev" = rpath; then
+	    case "$rpath " in
+	    *" $arg "*) ;;
+	    *) rpath="$rpath $arg" ;;
+	    esac
+	  else
+	    case "$xrpath " in
+	    *" $arg "*) ;;
+	    *) xrpath="$xrpath $arg" ;;
+	    esac
+	  fi
+	  prev=
+	  continue
+	  ;;
+	xcompiler)
+	  compiler_flags="$compiler_flags $qarg"
+	  prev=
+	  compile_command="$compile_command $qarg"
+	  finalize_command="$finalize_command $qarg"
+	  continue
+	  ;;
+	xlinker)
+	  linker_flags="$linker_flags $qarg"
+	  compiler_flags="$compiler_flags $wl$qarg"
+	  prev=
+	  compile_command="$compile_command $wl$qarg"
+	  finalize_command="$finalize_command $wl$qarg"
+	  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
+	;;
+
+      -avoid-version)
+	avoid_version=yes
+	continue
+	;;
+
+      -dlopen)
+	prev=dlfiles
+	continue
+	;;
+
+      -dlpreopen)
+	prev=dlprefiles
+	continue
+	;;
+
+      -export-dynamic)
+	export_dynamic=yes
+	continue
+	;;
+
+      -export-symbols | -export-symbols-regex)
+	if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
+	  $echo "$modename: not more than one -exported-symbols argument allowed"
+	  exit 1
+	fi
+	if test "X$arg" = "X-export-symbols"; then
+	  prev=expsyms
+	else
+	  prev=expsyms_regex
+	fi
+	continue
+	;;
+
+      -L*)
+	dir=`$echo "X$arg" | $Xsed -e 's/^-L//'`
+	# 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
+	case "$deplibs " in
+	*" -L$dir "*) ;;
+	*)
+	  deplibs="$deplibs -L$dir"
+	  lib_search_path="$lib_search_path $dir"
+	  ;;
+	esac
+	case "$host" in
+	*-*-cygwin* | *-*-mingw* | *-*-os2*)
+	  case ":$dllsearchpath:" in
+	  *":$dir:"*) ;;
+	  *) dllsearchpath="$dllsearchpath:$dir";;
+	  esac
+	  ;;
+	esac
+	continue
+	;;
+
+      -l*)
+	if test "$arg" = "-lc"; then
+	  case "$host" in
+	  *-*-cygwin* | *-*-mingw* | *-*-os2* | *-*-beos*)
+	    # These systems don't actually have c library (as such)
+	    continue
+	    ;;
+	  esac
+	elif test "$arg" = "-lm"; then
+	  case "$host" in
+	  *-*-cygwin* | *-*-beos*)
+	    # These systems don't actually have math library (as such)
+	    continue
+	    ;;
+	  esac
+	fi
+	deplibs="$deplibs $arg"
+	continue
+	;;
+
+      -module)
+	module=yes
+	continue
+	;;
+
+      -no-fast-install)
+	fast_install=no
+	continue
+	;;
+
+      -no-install)
+	case "$host" in
+	*-*-cygwin* | *-*-mingw* | *-*-os2*)
+	  # The PATH hackery in wrapper scripts is required on Windows
+	  # in order for the loader to find any dlls it needs.
+	  $echo "$modename: warning: \`-no-install' is ignored for $host" 1>&2
+	  $echo "$modename: warning: assuming \`-no-fast-install' instead" 1>&2
+	  fast_install=no
+	  ;;
+	*)
+	  no_install=yes
+	  ;;
+	esac
+	continue
+	;;
+
+      -no-undefined)
+	allow_undefined=no
+	continue
+	;;
+
+      -o) prev=output ;;
+
+      -release)
+	prev=release
+	continue
+	;;
+
+      -rpath)
+	prev=rpath
+	continue
+	;;
+
+      -R)
+	prev=xrpath
+	continue
+	;;
+
+      -R*)
+	dir=`$echo "X$arg" | $Xsed -e 's/^-R//'`
+	# We need an absolute path.
+	case "$dir" in
+	[\\/]* | [A-Za-z]:[\\/]*) ;;
+	*)
+	  $echo "$modename: only absolute run-paths are allowed" 1>&2
+	  exit 1
+	  ;;
+	esac
+	case "$xrpath " in
+	*" $dir "*) ;;
+	*) xrpath="$xrpath $dir" ;;
+	esac
+	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
+	;;
+
+      -thread-safe)
+	thread_safe=yes
+	continue
+	;;
+
+      -version-info)
+	prev=vinfo
+	continue
+	;;
+
+      -Wc,*)
+	args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wc,//'`
+	arg=
+	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS=','
+	for flag in $args; do
+	  IFS="$save_ifs"
+	  case "$flag" in
+	    *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
+	    flag="\"$flag\""
+	    ;;
+	  esac
+	  arg="$arg $wl$flag"
+	  compiler_flags="$compiler_flags $flag"
+	done
+	IFS="$save_ifs"
+	arg=`$echo "X$arg" | $Xsed -e "s/^ //"`
+	;;
+
+      -Wl,*)
+	args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wl,//'`
+	arg=
+	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS=','
+	for flag in $args; do
+	  IFS="$save_ifs"
+	  case "$flag" in
+	    *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
+	    flag="\"$flag\""
+	    ;;
+	  esac
+	  arg="$arg $wl$flag"
+	  compiler_flags="$compiler_flags $wl$flag"
+	  linker_flags="$linker_flags $flag"
+	done
+	IFS="$save_ifs"
+	arg=`$echo "X$arg" | $Xsed -e "s/^ //"`
+	;;
+
+      -Xcompiler)
+	prev=xcompiler
+	continue
+	;;
+
+      -Xlinker)
+	prev=xlinker
+	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
+	;;
+
+      *.$objext)
+	# A standard object.
+	objs="$objs $arg"
+	;;
+
+      *.lo)
+	# A library object.
+	if test "$prev" = dlfiles; then
+	  # This file was specified with -dlopen.
+	  if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then
+	    dlfiles="$dlfiles $arg"
+	    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 "$lo2o"`
+	  prev=
+	else
+	  libobjs="$libobjs $arg"
+	fi
+	;;
+
+      *.$libext)
+	# An archive.
+	deplibs="$deplibs $arg"
+	old_deplibs="$old_deplibs $arg"
+	continue
+	;;
+
+      *.la)
+	# A libtool-controlled library.
+
+	if test "$prev" = dlfiles; then
+	  # This library was specified with -dlopen.
+	  dlfiles="$dlfiles $arg"
+	  prev=
+	elif test "$prev" = dlprefiles; then
+	  # The library was specified with -dlpreopen.
+	  dlprefiles="$dlprefiles $arg"
+	  prev=
+	else
+	  deplibs="$deplibs $arg"
+	fi
+	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 "$export_dynamic" = yes && test -n "$export_dynamic_flag_spec"; then
+      eval arg=\"$export_dynamic_flag_spec\"
+      compile_command="$compile_command $arg"
+      finalize_command="$finalize_command $arg"
+    fi
+
+    oldlibs=
+    # calculate the name of the file, without its directory
+    outputname=`$echo "X$output" | $Xsed -e 's%^.*/%%'`
+    libobjs_save="$libobjs"
+
+    if test -n "$shlibpath_var"; then
+      # get the directories listed in $shlibpath_var
+      eval shlib_search_path=\`\$echo \"X \${$shlibpath_var}\" \| \$Xsed -e \'s/:/ /g\'\`
+    else
+      shlib_search_path=
+    fi
+    eval sys_lib_search_path=\"$sys_lib_search_path_spec\"
+    eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\"
+    lib_search_path="$lib_search_path $sys_lib_search_path $shlib_search_path"
+
+    output_objdir=`$echo "X$output" | $Xsed -e 's%/[^/]*$%%'`
+    if test "X$output_objdir" = "X$output"; then
+      output_objdir="$objdir"
+    else
+      output_objdir="$output_objdir/$objdir"
+    fi
+    # Create the object directory.
+    if test ! -d $output_objdir; then
+      $show "$mkdir $output_objdir"
+      $run $mkdir $output_objdir
+      status=$?
+      if test $status -ne 0 && test ! -d $output_objdir; then
+	exit $status
+      fi
+    fi
+
+    case "$output" in
+    "")
+      $echo "$modename: you must specify an output file" 1>&2
+      $echo "$help" 1>&2
+      exit 1
+      ;;
+    *.$libext)
+      linkmode=oldlib ;;
+    *.lo | *.$objext)
+      linkmode=obj ;;
+    *.la)
+      linkmode=lib ;;
+    *) # Anything else should be a program.
+      linkmode=prog ;;
+    esac
+
+    specialdeplibs=
+    libs=
+    # Find all interdependent deplibs that
+    # are linked more than once (e.g. -la -lb -la)
+    for deplib in $deplibs; do
+      case "$libs " in
+      *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
+      esac
+      libs="$libs $deplib"
+    done
+    deplibs=
+    newdependency_libs=
+    uninst_path= # paths that contain uninstalled libtool libraries
+    new_lib_search_path=
+    need_relink=no # whether we're linking any uninstalled libtool libraries
+    case $linkmode in
+    lib)
+	passes="link"
+	for file in $dlfiles $dlprefiles; do
+	  case "$file" in
+	  *.la) ;;
+	  *)
+	    $echo "$modename: libraries can \`-dlopen' only libtool libraries" 1>&2
+	    exit 1
+	    ;;
+	  esac
+	done
+	;;
+    prog)
+	compile_deplibs=
+	finalize_deplibs=
+	alldeplibs=no
+	newdlfiles=
+	newdlprefiles=
+	link_against_libtool_libs=
+	passes="scan dlopen dlpreopen link"
+	;;
+    *)	passes="link"
+	;;
+    esac
+    for pass in $passes; do
+      if test $linkmode = prog; then
+	case $pass in
+	dlopen) libs="$dlfiles" ;;
+	dlpreopen) libs="$dlprefiles" ;;
+	link) libs="$deplibs %DEPLIBS% $dependency_libs" ;;
+	esac
+      fi
+      if test $pass = dlopen; then
+	# Collect dlpreopened libraries
+	save_deplibs="$deplibs"
+	deplibs=
+      fi
+      for deplib in $libs; do
+	lib=
+	found=no
+	case "$deplib" in
+	-l*)
+	  if test $linkmode != lib && test $linkmode != prog; then
+	    $echo "$modename: warning: \`-l' is ignored for archives/objects" 1>&2
+	    continue
+	  fi
+	  name=`$echo "X$deplib" | $Xsed -e 's/^-l//'`
+	  for searchdir in $lib_search_path; do
+	    # Search the libtool library
+	    lib="$searchdir/lib${name}.la"
+	    if test -f "$lib"; then
+	      found=yes
+	      break
+	    fi
+	  done
+	  if test "$found" != yes; then
+	    if test "$linkmode,$pass" = "prog,link"; then
+	      compile_deplibs="$deplib $compile_deplibs"
+	      finalize_deplibs="$deplib $finalize_deplibs"
+	    else
+	      deplibs="$deplib $deplibs"
+	      test $linkmode = lib && newdependency_libs="$deplib $newdependency_libs"
+	    fi
+	    continue
+	  fi
+	  ;;
+	-L*)
+	  case $linkmode in
+	  lib)
+	    deplibs="$deplib $deplibs"
+	    newdependency_libs="$deplib $newdependency_libs"
+	    new_lib_search_path="$new_lib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`
+	    ;;
+	  prog)
+	    if test $pass = scan; then
+	      deplibs="$deplib $deplibs"
+	      new_lib_search_path="$new_lib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`
+	    else
+	      compile_deplibs="$deplib $compile_deplibs"
+	      finalize_deplibs="$deplib $finalize_deplibs"
+	    fi
+	    ;;
+	  *)
+	    $echo "$modename: warning: \`-L' is ignored for archives/objects" 1>&2
+	    ;;
+	  esac
+	  continue
+	  ;;
+	-R*)
+	  if test "$linkmode,$pass" = "prog,link"; then
+	    dir=`$echo "X$deplib" | $Xsed -e 's/^-R//'`
+	    # Make sure the xrpath contains only unique directories.
+	    case "$xrpath " in
+	    *" $dir "*) ;;
+	    *) xrpath="$xrpath $dir" ;;
+	    esac
+	  fi
+	  continue
+	  ;;
+	*.la) lib="$deplib" ;;
+	*.$libext)
+	  case $linkmode in
+	  lib)
+	    if test "$deplibs_check_method" != pass_all; then
+	      echo
+	      echo "*** Warning: This library needs some functionality provided by $deplib."
+	      echo "*** I have the capability to make that library automatically link in when"
+	      echo "*** you link to this library.  But I can only do this if you have a"
+	      echo "*** shared version of the library, which you do not appear to have."
+	    else
+	      echo
+	      echo "*** Warning: Linking the shared library $output against the"
+	      echo "*** static library $deplib is not portable!"
+	      deplibs="$deplib $deplibs"
+	    fi
+	    continue
+	    ;;
+	  prog)
+	    if test $pass != link; then
+	      deplibs="$deplib $deplibs"
+	    else
+	      compile_deplibs="$deplib $compile_deplibs"
+	      finalize_deplibs="$deplib $finalize_deplibs"
+	    fi
+	    continue
+	    ;;
+	  esac
+	  ;;
+	*.lo | *.$objext)
+	  if test $linkmode = prog; then
+	    if test $pass = dlpreopen || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then
+	      # If there is no dlopen support or we're linking statically,
+	      # we need to preload.
+	      newdlprefiles="$newdlprefiles $deplib"
+	      compile_deplibs="$deplib $compile_deplibs"
+	      finalize_deplibs="$deplib $finalize_deplibs"
+	    else
+	      newdlfiles="$newdlfiles $deplib"
+	    fi
+	  fi
+	  continue
+	  ;;
+	%DEPLIBS%)
+	  alldeplibs=yes
+	  continue
+	  ;;
+	esac
+	if test $found = yes || test -f "$lib"; then :
+	else
+	  $echo "$modename: cannot find the library \`$lib'" 1>&2
+	  exit 1
+	fi
+
+	# Check to see that this really is a libtool archive.
+	if (sed -e '2q' $lib | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then :
+	else
+	  $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
+	  exit 1
+	fi
+
+	ladir=`$echo "X$lib" | $Xsed -e 's%/[^/]*$%%'`
+	test "X$ladir" = "X$lib" && ladir="."
+
+	dlname=
+	dlopen=
+	dlpreopen=
+	libdir=
+	library_names=
+	old_library=
+	# If the library was installed with an old release of libtool,
+	# it will not redefine variable installed.
+	installed=yes
+
+	# Read the .la file
+	case "$lib" in
+	*/* | *\\*) . $lib ;;
+	*) . ./$lib ;;
+	esac
+
+	if test $linkmode = lib || test "$linkmode,$pass" = "prog,scan"; then
+	  test -n "$dlopen" && dlfiles="$dlfiles $dlopen"
+	  test -n "$dlpreopen" && dlprefiles="$dlprefiles $dlpreopen"
+	fi
+
+	if test $linkmode != lib && test $linkmode != prog; then
+	  # only check for convenience libraries
+	  if test -z "$old_library"; then
+	    $echo "$modename: cannot find name of link library for \`$lib'" 1>&2
+	    exit 1
+	  fi
+	  if test -n "$libdir"; then
+	    $echo "$modename: \`$lib' is not a convenience library" 1>&2
+	    exit 1
+	  fi
+	  # It is a libtool convenience library, so add in its objects.
+	  convenience="$convenience $ladir/$objdir/$old_library"
+	  old_convenience="$old_convenience $ladir/$objdir/$old_library"
+	  continue
+	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 \`$lib'" 1>&2
+	  exit 1
+	fi
+
+	# This library was specified with -dlopen.
+	if test $pass = dlopen; then
+	  if test -z "$dlname" || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then
+	    # If there is no dlname, no dlopen support or we're linking statically,
+	    # we need to preload.
+	    dlprefiles="$dlprefiles $lib"
+	  else
+	    newdlfiles="$newdlfiles $lib"
+	  fi
+	  continue
+	fi
+
+	# We need an absolute path.
+	case "$ladir" in
+	[\\/]* | [A-Za-z]:[\\/]*) abs_ladir="$ladir" ;;
+	*)
+	  abs_ladir=`cd "$ladir" && pwd`
+	  if test -z "$abs_ladir"; then
+	    $echo "$modename: warning: cannot determine absolute directory name of \`$ladir'" 1>&2
+	    $echo "$modename: passing it literally to the linker, although it might fail" 1>&2
+	    abs_ladir="$ladir"
+	  fi
+	  ;;
+	esac
+	laname=`$echo "X$lib" | $Xsed -e 's%^.*/%%'`
+
+	# Find the relevant object directory and library name.
+	if test "X$installed" = Xyes; then
+	  if test ! -f "$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then
+	    $echo "$modename: warning: library \`$lib' was moved." 1>&2
+	    dir="$ladir"
+	    absdir="$abs_ladir"
+	    libdir="$abs_ladir"
+	  else
+	    dir="$libdir"
+	    absdir="$libdir"
+	  fi
+	else
+	  dir="$ladir/$objdir"
+	  absdir="$abs_ladir/$objdir"
+	  # Remove this search path later
+	  uninst_path="$uninst_path $abs_ladir"
+	fi
+	name=`$echo "X$laname" | $Xsed -e 's/\.la$//' -e 's/^lib//'`
+
+	# This library was specified with -dlpreopen.
+	if test $pass = dlpreopen; then
+	  # Prefer using a static library (so that no silly _DYNAMIC symbols
+	  # are required to link).
+	  if test -n "$old_library"; then
+	    newdlprefiles="$newdlprefiles $dir/$old_library"
+	  else
+	    newdlprefiles="$newdlprefiles $dir/$linklib"
+	  fi
+	fi
+
+	if test $linkmode = prog && test $pass != link; then
+	  new_lib_search_path="$new_lib_search_path $ladir"
+	  deplibs="$lib $deplibs"
+
+	  linkalldeplibs=no
+	  if test "$link_all_deplibs" != no || test "$fast_install" != no || \
+	     test "$build_libtool_libs" = no || test -z "$library_names"; then
+	    linkalldeplibs=yes
+	  fi
+
+	  tmp_libs=
+	  for deplib in $dependency_libs; do
+	    case "$deplib" in
+	    -L*) new_lib_search_path="$new_lib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`;; ### testsuite: skip nested quoting test
+	    esac
+	    # Need to link against all dependency_libs?
+	    if test $linkalldeplibs = yes; then
+	      deplibs="$deplib $deplibs"
+	    else
+	      # Need to hardcode shared library paths
+	      # or/and link against static libraries
+	      newdependency_libs="$deplib $newdependency_libs"
+	    fi
+	    case "$tmp_libs " in
+	    *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
+	    esac
+	    tmp_libs="$tmp_libs $deplib"
+	  done
+	  continue
+	fi
+
+	if test -z "$libdir"; then
+	  # It is a libtool convenience library, so add in its objects.
+	  convenience="$convenience $dir/$old_library"
+	  old_convenience="$old_convenience $dir/$old_library"
+	  if test $linkmode = lib; then
+	    deplibs="$dir/$old_library $deplibs"
+	    tmp_libs=
+	    for deplib in $dependency_libs; do
+	      newdependency_libs="$deplib $newdependency_libs"
+	      case "$tmp_libs " in
+	      *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
+	      esac
+	      tmp_libs="$tmp_libs $deplib"
+	    done
+	  elif test "$linkmode,$pass" = "prog,link"; then
+	    compile_deplibs="$dir/$old_library $compile_deplibs"
+	    finalize_deplibs="$dir/$old_library $finalize_deplibs"
+	  fi
+	  continue
+	fi
+
+	if test "$linkmode,$pass" = "prog,link"; then
+	  if test -n "$library_names" &&
+	     { test "$hardcode_into_libs" != all || test "$alldeplibs" != yes; } &&
+	     { test "$prefer_static_libs" = no || test -z "$old_library"; }; then
+	    # We need to hardcode the library path
+	    if test -n "$shlibpath_var"; then
+	      # Make sure the rpath contains only unique directories.
+	      case "$temp_rpath " in
+	      *" $dir "*) ;;
+	      *" $absdir "*) ;;
+	      *) temp_rpath="$temp_rpath $dir" ;;
+	      esac
+	    fi
+
+	    # Hardcode the library path.
+	    # Skip directories that are in the system default run-time
+	    # search path.
+	    case " $sys_lib_dlsearch_path " in
+	    *" $absdir "*) ;;
+	    *)
+	      case "$compile_rpath " in
+	      *" $absdir "*) ;;
+	      *) compile_rpath="$compile_rpath $absdir"
+	      esac
+	      ;;
+	    esac
+
+	    case " $sys_lib_dlsearch_path " in
+	    *" $libdir "*) ;;
+	    *)
+	      case "$finalize_rpath " in
+	      *" $libdir "*) ;;
+	      *) finalize_rpath="$finalize_rpath $libdir"
+	      esac
+	      ;;
+	    esac
+	  fi
+
+	  if test "$alldeplibs" = yes &&
+	     { test "$deplibs_check_method" = pass_all ||
+	       { test "$build_libtool_libs" = yes &&
+		 test -n "$library_names"; }; }; then
+	    # Do we only need to link against static libraries?
+	    continue
+	  fi
+	fi
+
+	link_static=no # Whether this library is linked statically
+	if test -n "$library_names" &&
+	   { test "$prefer_static_libs" = no || test -z "$old_library"; }; then
+	  link_against_libtool_libs="$link_against_libtool_libs $lib"
+	  test "X$installed" = xno && need_relink=yes
+	  # This is a shared library
+	  if test $linkmode = lib && test "$hardcode_into_libs" = all; then
+	    # Hardcode the library path.
+	    # Skip directories that are in the system default run-time
+	    # search path.
+	    case " $sys_lib_dlsearch_path " in
+	    *" $absdir "*) ;;
+	    *)
+	      case "$compile_rpath " in
+	      *" $absdir "*) ;;
+	      *) compile_rpath="$compile_rpath $absdir"
+	      esac
+	      ;;
+	    esac
+	    case " $sys_lib_dlsearch_path " in
+	    *" $libdir "*) ;;
+	    *)
+	      case "$finalize_rpath " in
+	      *" $libdir "*) ;;
+	      *) finalize_rpath="$finalize_rpath $libdir"
+	      esac
+	      ;;
+	    esac
+	  fi
+
+	  if test -n "$old_archive_from_expsyms_cmds"; then
+	    # figure out the soname
+	    set dummy $library_names
+	    realname="$2"
+	    shift; shift
+	    libname=`eval \\$echo \"$libname_spec\"`
+	    if test -n "$soname_spec"; then
+	      eval soname=\"$soname_spec\"
+	    else
+	      soname="$realname"
+	    fi
+
+	    # Make a new name for the extract_expsyms_cmds to use
+	    newlib="libimp-`echo $soname | sed 's/^lib//;s/\.dll$//'`.a"
+
+	    # If the library has no export list, then create one now
+	    if test -f "$output_objdir/$soname-def"; then :
+	    else
+	      $show "extracting exported symbol list from \`$soname'"
+	      IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
+	      eval cmds=\"$extract_expsyms_cmds\"
+	      for cmd in $cmds; do
+		IFS="$save_ifs"
+		$show "$cmd"
+		$run eval "$cmd" || exit $?
+	      done
+	      IFS="$save_ifs"
+	    fi
+
+	    # Create $newlib
+	    if test -f "$output_objdir/$newlib"; then :; else
+	      $show "generating import library for \`$soname'"
+	      IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
+	      eval cmds=\"$old_archive_from_expsyms_cmds\"
+	      for cmd in $cmds; do
+		IFS="$save_ifs"
+		$show "$cmd"
+		$run eval "$cmd" || exit $?
+	      done
+	      IFS="$save_ifs"
+	    fi
+	    # make sure the library variables are pointing to the new library
+	    dir=$output_objdir
+	    linklib=$newlib
+	  fi
+
+	  if test $linkmode = prog || test "$mode" != relink; then
+	    add_shlibpath=
+	    add_dir=
+	    add=
+	    lib_linked=yes
+	    case "$hardcode_action" in
+	    immediate | unsupported)
+	      if test "$hardcode_direct" = no; then
+		add="$dir/$linklib"
+	      elif test "$hardcode_minus_L" = no; then
+		case "$host" in
+		*-*-sunos*) add_shlibpath="$dir" ;;
+		esac
+		add_dir="-L$dir"
+		add="-l$name"
+	      elif test "$hardcode_shlibpath_var" = no; then
+		add_shlibpath="$dir"
+		add="-l$name"
+	      else
+		lib_linked=no
+	      fi
+	      ;;
+	    relink)
+	      if test "$hardcode_direct" = yes; then
+		add="$dir/$linklib"
+	      elif test "$hardcode_minus_L" = yes; then
+		add_dir="-L$dir"
+		add="-l$name"
+	      elif test "$hardcode_shlibpath_var" = yes; then
+		add_shlibpath="$dir"
+		add="-l$name"
+	      else
+		lib_linked=no
+	      fi
+	      ;;
+	    *) lib_linked=no ;;
+	    esac
+
+	    if test "$lib_linked" != yes; then
+	      $echo "$modename: configuration error: unsupported hardcode properties"
+	      exit 1
+	    fi
+
+	    if test -n "$add_shlibpath"; then
+	      case ":$compile_shlibpath:" in
+	      *":$add_shlibpath:"*) ;;
+	      *) compile_shlibpath="$compile_shlibpath$add_shlibpath:" ;;
+	      esac
+	    fi
+	    if test $linkmode = prog; then
+	      test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs"
+	      test -n "$add" && compile_deplibs="$add $compile_deplibs"
+	    else
+	      test -n "$add_dir" && deplibs="$add_dir $deplibs"
+	      test -n "$add" && deplibs="$add $deplibs"
+	      if test "$hardcode_direct" != yes && \
+		 test "$hardcode_minus_L" != yes && \
+		 test "$hardcode_shlibpath_var" = yes; then
+		case ":$finalize_shlibpath:" in
+		*":$libdir:"*) ;;
+		*) finalize_shlibpath="$finalize_shlibpath$libdir:" ;;
+		esac
+	      fi
+	    fi
+	  fi
+
+	  if test $linkmode = prog || test "$mode" = relink; then
+	    add_shlibpath=
+	    add_dir=
+	    add=
+	    # Finalize command for both is simple: just hardcode it.
+	    if test "$hardcode_direct" = yes; then
+	      add="$libdir/$linklib"
+	    elif test "$hardcode_minus_L" = yes; then
+	      add_dir="-L$libdir"
+	      add="-l$name"
+	    elif test "$hardcode_shlibpath_var" = yes; then
+	      case ":$finalize_shlibpath:" in
+	      *":$libdir:"*) ;;
+	      *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;;
+	      esac
+	      add="-l$name"
+	    else
+	      # We cannot seem to hardcode it, guess we'll fake it.
+	      add_dir="-L$libdir"
+	      add="-l$name"
+	    fi
+
+	    if test $linkmode = prog; then
+	      test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs"
+	      test -n "$add" && finalize_deplibs="$add $finalize_deplibs"
+	    else
+	      test -n "$add_dir" && deplibs="$add_dir $deplibs"
+	      test -n "$add" && deplibs="$add deplibs"
+	    fi
+	  fi
+	elif test $linkmode = prog; then
+	  # 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_deplibs="$dir/$linklib $compile_deplibs"
+	    finalize_deplibs="$dir/$linklib $finalize_deplibs"
+	  else
+	    compile_deplibs="-l$name -L$dir $compile_deplibs"
+	    finalize_deplibs="-l$name -L$dir $finalize_deplibs"
+	  fi
+	elif test "$build_libtool_libs" = yes; then
+	  # Not a shared library
+	  if test "$deplibs_check_method" != pass_all; then
+	    # We're trying link a shared library against a static one
+	    # but the system doesn't support it.
+	    # Just print a warning and add the library to dependency_libs so
+	    # that the program can be linked against the static library.
+	    echo
+	    echo "*** Warning: This library needs some functionality provided by $lib."
+	    echo "*** I have the capability to make that library automatically link in when"
+	    echo "*** you link to this library.  But I can only do this if you have a"
+	    echo "*** shared version of the library, which you do not appear to have."
+	  else
+	    convenience="$convenience $dir/$old_library"
+	    old_convenience="$old_convenience $dir/$old_library"
+	    deplibs="$dir/$old_library $deplibs"
+	    link_static=yes
+	  fi
+	fi
+
+	if test $linkmode = lib; then
+	  if test -n "$dependency_libs" &&
+	     { test "$hardcode_into_libs" = no || test $build_old_libs = yes ||
+	       test $link_static = yes; }; then
+	    # Extract -R from dependency_libs
+	    temp_deplibs=
+	    for libdir in $dependency_libs; do
+	      case "$libdir" in
+	      -R*) temp_xrpath=`$echo "X$libdir" | $Xsed -e 's/^-R//'`
+		   case " $xrpath " in
+		   *" $temp_xrpath "*) ;;
+		   *) xrpath="$xrpath $temp_xrpath";;
+		   esac;;
+	      *) temp_deplibs="$temp_deplibs $libdir";;
+	      esac
+	    done
+	    dependency_libs="$temp_deplibs"
+	  fi
+
+	  new_lib_search_path="$new_lib_search_path $absdir"
+	  # Link against this library
+	  test "$link_static" = no && newdependency_libs="$abs_ladir/$laname $newdependency_libs"
+	  # ... and its dependency_libs
+	  tmp_libs=
+	  for deplib in $dependency_libs; do
+	    newdependency_libs="$deplib $newdependency_libs"
+	    case "$tmp_libs " in
+	    *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
+	    esac
+	    tmp_libs="$tmp_libs $deplib"
+	  done
+
+	  if test $link_all_deplibs != no; then
+	    # Add the search paths of all dependency libraries
+	    for deplib in $dependency_libs; do
+	      case "$deplib" in
+	      -L*) path="$deplib" ;;
+	      *.la)
+		dir=`$echo "X$deplib" | $Xsed -e 's%/[^/]*$%%'`
+		test "X$dir" = "X$deplib" && dir="."
+		# We need an absolute path.
+		case "$dir" in
+		[\\/]* | [A-Za-z]:[\\/]*) absdir="$dir" ;;
+		*)
+		  absdir=`cd "$dir" && pwd`
+		  if test -z "$absdir"; then
+		    $echo "$modename: warning: cannot determine absolute directory name of \`$dir'" 1>&2
+		    absdir="$dir"
+		  fi
+		  ;;
+		esac
+		if grep "^installed=no" $deplib > /dev/null; then
+		  path="-L$absdir/$objdir"
+		else
+		  eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
+		  if test -z "$libdir"; then
+		    $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2
+		    exit 1
+		  fi
+		  if test "$absdir" != "$libdir"; then
+		    $echo "$modename: warning: \`$deplib' seems to be moved" 1>&2
+		  fi
+		  path="-L$absdir"
+		fi
+		;;
+	      *) continue ;;
+	      esac
+	      case " $deplibs " in
+	      *" $path "*) ;;
+	      *) deplibs="$deplibs $path" ;;
+	      esac
+	    done
+	  fi
+	fi
+      done
+      dependency_libs="$newdependency_libs"
+      if test $pass = dlpreopen; then
+	# Link the dlpreopened libraries before other libraries
+	deplibs="$deplibs $save_deplibs"
+      elif test $pass != dlopen; then
+	# Make sure lib_search_path contains only unique directories.
+	lib_search_path=
+	for dir in $new_lib_search_path; do
+	  case "$lib_search_path " in
+	  *" $dir "*) ;;
+	  *) lib_search_path="$lib_search_path $dir" ;;
+	  esac
+	done
+	lib_search_path="$lib_search_path $sys_lib_search_path"
+
+	if test "$linkmode,$pass" != "prog,link"; then
+	  vars="deplibs"
+	else
+	  vars="compile_deplibs finalize_deplibs"
+	fi
+	for var in $vars dependency_libs; do
+	  # Make sure that $var contains only unique libraries
+	  # and add them in reverse order
+	  eval tmp_libs=\"\$$var\"
+	  new_libs=
+	  for deplib in $tmp_libs; do
+	    case "$deplib" in
+	    -L*) new_libs="$deplib $new_libs" ;;
+	    *)
+	      case " $specialdeplibs " in
+	      *" $deplib "*) new_libs="$deplib $new_libs" ;;
+	      *)
+		case " $new_libs " in
+		*" $deplib "*) ;;
+		*) new_libs="$deplib $new_libs" ;;
+		esac
+		;;
+	      esac
+	      ;;
+	    esac
+	  done
+	  tmp_libs=
+	  for deplib in $new_libs; do
+	    case "$deplib" in
+	    -L*)
+	      case " $tmp_libs " in
+	      *" $deplib "*) ;;
+	      *) tmp_libs="$tmp_libs $deplib" ;;
+	      esac
+	      ;;
+	    *) tmp_libs="$tmp_libs $deplib" ;;
+	    esac
+	  done
+	  eval $var=\"$tmp_libs\"
+	done
+      fi
+    done
+    if test $linkmode = prog; then
+      dlfiles="$newdlfiles"
+      dlprefiles="$newdlprefiles"
+    fi
+
+    case $linkmode in
+    oldlib)
+      if test -n "$deplibs"; then
+	$echo "$modename: warning: \`-l' and \`-L' are ignored for archives" 1>&2
+      fi
+
+      if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
+	$echo "$modename: warning: \`-dlopen' is ignored for archives" 1>&2
+      fi
+
+      if test -n "$rpath"; then
+	$echo "$modename: warning: \`-rpath' is ignored for archives" 1>&2
+      fi
+
+      if test -n "$xrpath"; then
+	$echo "$modename: warning: \`-R' is ignored for archives" 1>&2
+      fi
+
+      if test -n "$vinfo"; then
+	$echo "$modename: warning: \`-version-info' is ignored for archives" 1>&2
+      fi
+
+      if test -n "$release"; then
+	$echo "$modename: warning: \`-release' is ignored for archives" 1>&2
+      fi
+
+      if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
+	$echo "$modename: warning: \`-export-symbols' is ignored for archives" 1>&2
+      fi
+
+      # Now set the variables for building old libraries.
+      build_libtool_libs=no
+      oldlibs="$output"
+      objs="$objs$old_deplibs"
+      ;;
+
+    lib)
+      # Make sure we only generate libraries of the form `libNAME.la'.
+      case "$outputname" in
+      lib*)
+	name=`$echo "X$outputname" | $Xsed -e 's/\.la$//' -e 's/^lib//'`
+	eval libname=\"$libname_spec\"
+	;;
+      *)
+	if test "$module" = no; then
+	  $echo "$modename: libtool library \`$output' must begin with \`lib'" 1>&2
+	  $echo "$help" 1>&2
+	  exit 1
+	fi
+	if test "$need_lib_prefix" != no; then
+	  # Add the "lib" prefix for modules if required
+	  name=`$echo "X$outputname" | $Xsed -e 's/\.la$//'`
+	  eval libname=\"$libname_spec\"
+	else
+	  libname=`$echo "X$outputname" | $Xsed -e 's/\.la$//'`
+	fi
+	;;
+      esac
+
+      if test -n "$objs"; then
+	if test "$deplibs_check_method" != pass_all; then
+	  $echo "$modename: cannot build libtool library \`$output' from non-libtool objects on this host:$objs" 2>&1
+	  exit 1
+	else
+	  echo
+	  echo "*** Warning: Linking the shared library $output against the non-libtool"
+	  echo "*** objects $objs is not portable!"
+	  libobjs="$libobjs $objs"
+	fi
+      fi
+
+      if test "$dlself" != no; then
+	$echo "$modename: warning: \`-dlopen self' is ignored for libtool libraries" 1>&2
+      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"
+
+      oldlibs=
+      if test -z "$rpath"; then
+	if test "$build_libtool_libs" = yes; then
+	  # Building a libtool convenience library.
+	  libext=al
+	  oldlibs="$output_objdir/$libname.$libext $oldlibs"
+	  build_libtool_libs=convenience
+	  build_old_libs=yes
+	fi
+
+	if test -n "$vinfo"; then
+	  $echo "$modename: warning: \`-version-info' is ignored for convenience libraries" 1>&2
+	fi
+
+	if test -n "$release"; then
+	  $echo "$modename: warning: \`-release' is ignored for convenience libraries" 1>&2
+	fi
+      else
+
+	# Parse the version information argument.
+	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS=':'
+	set dummy $vinfo 0 0 0
+	IFS="$save_ifs"
+
+	if test -n "$8"; then
+	  $echo "$modename: too many parameters to \`-version-info'" 1>&2
+	  $echo "$help" 1>&2
+	  exit 1
+	fi
+
+	current="$2"
+	revision="$3"
+	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.
+	major=
+	versuffix=
+	verstring=
+	case "$version_type" in
+	none) ;;
+
+	irix)
+	  major=`expr $current - $age + 1`
+	  versuffix="$major.$revision"
+	  verstring="sgi$major.$revision"
+
+	  # Add in all the interfaces that we are compatible with.
+	  loop=$revision
+	  while test $loop != 0; do
+	    iface=`expr $revision - $loop`
+	    loop=`expr $loop - 1`
+	    verstring="sgi$major.$iface:$verstring"
+	  done
+	  ;;
+
+	linux)
+	  major=.`expr $current - $age`
+	  versuffix="$major.$age.$revision"
+	  ;;
+
+	osf)
+	  major=`expr $current - $age`
+	  versuffix=".$current.$age.$revision"
+	  verstring="$current.$age.$revision"
+
+	  # 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)
+	  major=".$current"
+	  versuffix=".$current.$revision"
+	  ;;
+
+	freebsd-aout)
+	  major=".$current"
+	  versuffix=".$current.$revision";
+	  ;;
+
+	freebsd-elf)
+	  major=".$current"
+	  versuffix=".$current";
+	  ;;
+
+	windows)
+	  # Like Linux, but with '-' rather than '.', since we only
+	  # want one extension on Windows 95.
+	  major=`expr $current - $age`
+	  versuffix="-$major-$age-$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
+
+	# Clear the version info if we defaulted, and they specified a release.
+	if test -z "$vinfo" && test -n "$release"; then
+	  major=
+	  verstring="0.0"
+	  if test "$need_version" = no; then
+	    versuffix=
+	  else
+	    versuffix=".0.0"
+	  fi
+	fi
+
+	# Remove version info from name if versioning should be avoided
+	if test "$avoid_version" = yes && test "$need_version" = no; then
+	  major=
+	  versuffix=
+	  verstring=""
+	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
+      fi
+
+      if test "$mode" != relink; then
+	# Remove our outputs.
+	$show "${rm}r $output_objdir/$outputname $output_objdir/$libname.* $output_objdir/${libname}${release}.*"
+	$run ${rm}r $output_objdir/$outputname $output_objdir/$libname.* $output_objdir/${libname}${release}.*
+      fi
+
+      # Now set the variables for building old libraries.
+      if test "$build_old_libs" = yes && test "$build_libtool_libs" != convenience ; then
+	oldlibs="$oldlibs $output_objdir/$libname.$libext"
+
+	# Transform .lo files to .o files.
+	oldobjs="$objs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}'$/d' -e "$lo2o" | $NL2SP`
+      fi
+
+      # Eliminate all temporary directories.
+      for path in $uninst_path; do
+	lib_search_path=`echo "$lib_search_path " | sed -e 's% $path % %g'`
+	deplibs=`echo "$deplibs " | sed -e 's% -L$path % %g'`
+	dependency_libs=`echo "$dependency_libs " | sed -e 's% -L$path % %g'`
+      done
+
+      if test -n "$xrpath"; then
+	# If the user specified any rpath flags, then add them.
+	temp_xrpath=
+	for libdir in $xrpath; do
+	  temp_xrpath="$temp_xrpath -R$libdir"
+	  case "$finalize_rpath " in
+	  *" $libdir "*) ;;
+	  *) finalize_rpath="$finalize_rpath $libdir" ;;
+	  esac
+	done
+	if test "$hardcode_into_libs" = no || test $build_old_libs = yes; then
+	  dependency_libs="$temp_xrpath $dependency_libs"
+	fi
+      fi
+
+      # Make sure dlfiles contains only unique files that won't be dlpreopened
+      old_dlfiles="$dlfiles"
+      dlfiles=
+      for lib in $old_dlfiles; do
+	case " $dlprefiles $dlfiles " in
+	*" $lib "*) ;;
+	*) dlfiles="$dlfiles $lib" ;;
+	esac
+      done
+
+      # Make sure dlprefiles contains only unique files
+      old_dlprefiles="$dlprefiles"
+      dlprefiles=
+      for lib in $old_dlprefiles; do
+	case "$dlprefiles " in
+	*" $lib "*) ;;
+	*) dlprefiles="$dlprefiles $lib" ;;
+	esac
+      done
+
+      if test "$build_libtool_libs" = yes; then
+	if test -n "$rpath"; then
+	  case "$host" in
+	  *-*-cygwin* | *-*-mingw* | *-*-os2* | *-*-beos*)
+	    # these systems don't actually have a c library (as such)!
+	    ;;
+	  *)
+	    # Add libc to deplibs on all other systems.
+	    deplibs="$deplibs -lc"
+	    ;;
+	  esac
+	fi
+
+	# Transform deplibs into only deplibs that can be linked in shared.
+	name_save=$name
+	libname_save=$libname
+	release_save=$release
+	versuffix_save=$versuffix
+	major_save=$major
+	# I'm not sure if I'm treating the release correctly.  I think
+	# release should show up in the -l (ie -lgmp5) so we don't want to
+	# add it in twice.  Is that correct?
+	release=""
+	versuffix=""
+	major=""
+	newdeplibs=
+	droppeddeps=no
+	case "$deplibs_check_method" in
+	pass_all)
+	  # Don't check for shared/static.  Everything works.
+	  # This might be a little naive.  We might want to check
+	  # whether the library exists or not.  But this is on
+	  # osf3 & osf4 and I'm not really sure... Just
+	  # implementing what was already the behaviour.
+	  newdeplibs=$deplibs
+	  ;;
+	test_compile)
+	  # This code stresses the "libraries are programs" paradigm to its
+	  # limits. Maybe even breaks it.  We compile a program, linking it
+	  # against the deplibs as a proxy for the library.  Then we can check
+	  # whether they linked in statically or dynamically with ldd.
+	  $rm conftest.c
+	  cat > conftest.c <<EOF
+	  int main() { return 0; }
+EOF
+	  $rm conftest
+	  $CC -o conftest conftest.c $deplibs
+	  if test $? -eq 0 ; then
+	    ldd_output=`ldd conftest`
+	    for i in $deplibs; do
+	      name="`expr $i : '-l\(.*\)'`"
+	      # If $name is empty we are operating on a -L argument.
+	      if test "$name" != "" ; then
+		libname=`eval \\$echo \"$libname_spec\"`
+		deplib_matches=`eval \\$echo \"$library_names_spec\"`
+		set dummy $deplib_matches
+		deplib_match=$2
+		if test `expr "$ldd_output" : ".*$deplib_match"` -ne 0 ; then
+		  newdeplibs="$newdeplibs $i"
+		else
+		  droppeddeps=yes
+		  echo
+		  echo "*** Warning: This library needs some functionality provided by $i."
+		  echo "*** I have the capability to make that library automatically link in when"
+		  echo "*** you link to this library.  But I can only do this if you have a"
+		  echo "*** shared version of the library, which you do not appear to have."
+		fi
+	      else
+		newdeplibs="$newdeplibs $i"
+	      fi
+	    done
+	  else
+	    # Error occured in the first compile.  Let's try to salvage the situation:
+	    # Compile a seperate program for each library.
+	    for i in $deplibs; do
+	      name="`expr $i : '-l\(.*\)'`"
+	     # If $name is empty we are operating on a -L argument.
+	      if test "$name" != "" ; then
+		$rm conftest
+		$CC -o conftest conftest.c $i
+		# Did it work?
+		if test $? -eq 0 ; then
+		  ldd_output=`ldd conftest`
+		  libname=`eval \\$echo \"$libname_spec\"`
+		  deplib_matches=`eval \\$echo \"$library_names_spec\"`
+		  set dummy $deplib_matches
+		  deplib_match=$2
+		  if test `expr "$ldd_output" : ".*$deplib_match"` -ne 0 ; then
+		    newdeplibs="$newdeplibs $i"
+		  else
+		    droppeddeps=yes
+		    echo
+		    echo "*** Warning: This library needs some functionality provided by $i."
+		    echo "*** I have the capability to make that library automatically link in when"
+		    echo "*** you link to this library.  But I can only do this if you have a"
+		    echo "*** shared version of the library, which you do not appear to have."
+		  fi
+		else
+		  droppeddeps=yes
+		  echo
+		  echo "*** Warning!  Library $i is needed by this library but I was not able to"
+		  echo "***  make it link in!  You will probably need to install it or some"
+		  echo "*** library that it depends on before this library will be fully"
+		  echo "*** functional.  Installing it before continuing would be even better."
+		fi
+	      else
+		newdeplibs="$newdeplibs $i"
+	      fi
+	    done
+	  fi
+	  ;;
+	file_magic*)
+	  set dummy $deplibs_check_method
+	  file_magic_regex=`expr "$deplibs_check_method" : "$2 \(.*\)"`
+	  for a_deplib in $deplibs; do
+	    name="`expr $a_deplib : '-l\(.*\)'`"
+	    # If $name is empty we are operating on a -L argument.
+	    if test "$name" != "" ; then
+	      libname=`eval \\$echo \"$libname_spec\"`
+	      for i in $lib_search_path; do
+		    potential_libs=`ls $i/$libname[.-]* 2>/dev/null`
+		    for potent_lib in $potential_libs; do
+		      # Follow soft links.
+		      if ls -lLd "$potent_lib" 2>/dev/null \
+			 | grep " -> " >/dev/null; then
+			continue
+		      fi
+		      # The statement above tries to avoid entering an
+		      # endless loop below, in case of cyclic links.
+		      # We might still enter an endless loop, since a link
+		      # loop can be closed while we follow links,
+		      # but so what?
+		      potlib="$potent_lib"
+		      while test -h "$potlib" 2>/dev/null; do
+			potliblink=`ls -ld $potlib | sed 's/.* -> //'`
+			case "$potliblink" in
+			[\\/]* | [A-Za-z]:[\\/]*) potlib="$potliblink";;
+			*) potlib=`$echo "X$potlib" | $Xsed -e 's,[^/]*$,,'`"$potliblink";;
+			esac
+		      done
+		      if eval $file_magic_cmd \"\$potlib\" 2>/dev/null \
+			 | sed 10q \
+			 | egrep "$file_magic_regex" > /dev/null; then
+			newdeplibs="$newdeplibs $a_deplib"
+			a_deplib=""
+			break 2
+		      fi
+		    done
+	      done
+	      if test -n "$a_deplib" ; then
+		droppeddeps=yes
+		echo
+		echo "*** Warning: This library needs some functionality provided by $a_deplib."
+		echo "*** I have the capability to make that library automatically link in when"
+		echo "*** you link to this library.  But I can only do this if you have a"
+		echo "*** shared version of the library, which you do not appear to have."
+	      fi
+	    else
+	      # Add a -L argument.
+	      newdeplibs="$newdeplibs $a_deplib"
+	    fi
+	  done # Gone through all deplibs.
+	  ;;
+	none | unknown | *)
+	  newdeplibs=""
+	  if $echo "X $deplibs" | $Xsed -e 's/ -lc$//' \
+	       -e 's/ -[LR][^ ]*//g' -e 's/[ 	]//g' |
+	     grep . >/dev/null; then
+	    echo
+	    if test "X$deplibs_check_method" = "Xnone"; then
+	      echo "*** Warning: inter-library dependencies are not supported in this platform."
+	    else
+	      echo "*** Warning: inter-library dependencies are not known to be supported."
+	    fi
+	    echo "*** All declared inter-library dependencies are being dropped."
+	    droppeddeps=yes
+	  fi
+	  ;;
+	esac
+	versuffix=$versuffix_save
+	major=$major_save
+	release=$release_save
+	libname=$libname_save
+	name=$name_save
+
+	if test "$droppeddeps" = yes; then
+	  if test "$module" = yes; then
+	    echo
+	    echo "*** Warning: libtool could not satisfy all declared inter-library"
+	    echo "*** dependencies of module $libname.  Therefore, libtool will create"
+	    echo "*** a static module, that should work as long as the dlopening"
+	    echo "*** application is linked with the -dlopen flag."
+	    if test -z "$global_symbol_pipe"; then
+	      echo
+	      echo "*** However, this would only work if libtool was able to extract symbol"
+	      echo "*** lists from a program, using \`nm' or equivalent, but libtool could"
+	      echo "*** not find such a program.  So, this module is probably useless."
+	      echo "*** \`nm' from GNU binutils and a full rebuild may help."
+	    fi
+	    if test "$build_old_libs" = no; then
+	      oldlibs="$output_objdir/$libname.$libext"
+	      build_libtool_libs=module
+	      build_old_libs=yes
+	    else
+	      build_libtool_libs=no
+	    fi
+	  else
+	    echo "*** The inter-library dependencies that have been dropped here will be"
+	    echo "*** automatically added whenever a program is linked with this library"
+	    echo "*** or is declared to -dlopen it."
+	  fi
+	fi
+	# Done checking deplibs!
+	deplibs=$newdeplibs
+      fi
+
+      # All the library-specific variables (install_libdir is set above).
+      library_names=
+      old_library=
+      dlname=
+
+      # Test again, we may have decided not to build it any more
+      if test "$build_libtool_libs" = yes; then
+	if test "$hardcode_into_libs" != no; then
+	  # Hardcode the library paths
+	  hardcode_libdirs=
+	  dep_rpath=
+	  rpath="$finalize_rpath"
+	  test "$mode" != relink && rpath="$compile_rpath$rpath"
+	  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
+		  hardcode_libdirs="$libdir"
+		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
+		fi
+	      else
+		eval flag=\"$hardcode_libdir_flag_spec\"
+		dep_rpath="$dep_rpath $flag"
+	      fi
+	    elif test -n "$runpath_var"; then
+	      case "$perm_rpath " in
+	      *" $libdir "*) ;;
+	      *) perm_rpath="$perm_rpath $libdir" ;;
+	      esac
+	    fi
+	  done
+	  # Substitute the hardcoded libdirs into the rpath.
+	  if test -n "$hardcode_libdir_separator" &&
+	     test -n "$hardcode_libdirs"; then
+	    libdir="$hardcode_libdirs"
+	    eval dep_rpath=\"$hardcode_libdir_flag_spec\"
+	  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
+	    eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var"
+	  fi
+	  test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs"
+	fi
+
+	shlibpath="$finalize_shlibpath"
+	test "$mode" != relink && shlibpath="$compile_shlibpath$shlibpath"
+	if test -n "$shlibpath"; then
+	  eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var"
+	fi
+
+	# 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="$output_objdir/$realname"
+	for link
+	do
+	  linknames="$linknames $link"
+	done
+
+	# Ensure that we have .o objects for linkers which dislike .lo
+	# (e.g. aix) in case we are running --disable-static
+	for obj in $libobjs; do
+	  xdir=`$echo "X$obj" | $Xsed -e 's%/[^/]*$%%'`
+	  if test "X$xdir" = "X$obj"; then
+	    xdir="."
+	  else
+	    xdir="$xdir"
+	  fi
+	  baseobj=`$echo "X$obj" | $Xsed -e 's%^.*/%%'`
+	  oldobj=`$echo "X$baseobj" | $Xsed -e "$lo2o"`
+	  if test ! -f $xdir/$oldobj; then
+	    $show "(cd $xdir && ${LN_S} $baseobj $oldobj)"
+	    $run eval '(cd $xdir && ${LN_S} $baseobj $oldobj)' || exit $?
+	  fi
+	done
+
+	# Use standard objects if they are pic
+	test -z "$pic_flag" && libobjs=`$echo "X$libobjs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
+
+	# Prepare the list of exported symbols
+	if test -z "$export_symbols"; then
+	  if test "$always_export_symbols" = yes || test -n "$export_symbols_regex"; then
+	    $show "generating symbol list for \`$libname.la'"
+	    export_symbols="$output_objdir/$libname.exp"
+	    $run $rm $export_symbols
+	    eval cmds=\"$export_symbols_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"
+	    if test -n "$export_symbols_regex"; then
+	      $show "egrep -e \"$export_symbols_regex\" \"$export_symbols\" > \"${export_symbols}T\""
+	      $run eval 'egrep -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
+	      $show "$mv \"${export_symbols}T\" \"$export_symbols\""
+	      $run eval '$mv "${export_symbols}T" "$export_symbols"'
+	    fi
+	  fi
+	fi
+
+	if test -n "$export_symbols" && test -n "$include_expsyms"; then
+	  $run eval '$echo "X$include_expsyms" | $SP2NL >> "$export_symbols"'
+	fi
+
+	if test -n "$convenience"; then
+	  if test -n "$whole_archive_flag_spec"; then
+	    eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
+	  else
+	    gentop="$output_objdir/${outputname}x"
+	    $show "${rm}r $gentop"
+	    $run ${rm}r "$gentop"
+	    $show "mkdir $gentop"
+	    $run mkdir "$gentop"
+	    status=$?
+	    if test $status -ne 0 && test ! -d "$gentop"; then
+	      exit $status
+	    fi
+	    generated="$generated $gentop"
+
+	    for xlib in $convenience; do
+	      # Extract the objects.
+	      case "$xlib" in
+	      [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;;
+	      *) xabs=`pwd`"/$xlib" ;;
+	      esac
+	      xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'`
+	      xdir="$gentop/$xlib"
+
+	      $show "${rm}r $xdir"
+	      $run ${rm}r "$xdir"
+	      $show "mkdir $xdir"
+	      $run mkdir "$xdir"
+	      status=$?
+	      if test $status -ne 0 && test ! -d "$xdir"; then
+		exit $status
+	      fi
+	      $show "(cd $xdir && $AR x $xabs)"
+	      $run eval "(cd \$xdir && $AR x \$xabs)" || exit $?
+
+	      libobjs="$libobjs "`find $xdir -name \*.o -print -o -name \*.lo -print | $NL2SP`
+	    done
+	  fi
+	fi
+
+	if test "$thread_safe" = yes && test -n "$thread_safe_flag_spec"; then
+	  eval flag=\"$thread_safe_flag_spec\"
+	  linker_flags="$linker_flags $flag"
+	fi
+
+	# Make a backup of the uninstalled library when relinking
+	if test "$mode" = relink && test "$hardcode_into_libs" = all; then
+	  $run eval '(cd $output_objdir && $rm ${realname}U && $mv $realname ${realname}U)' || exit $?
+	fi
+
+	# Do each of the archive commands.
+	if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
+	  eval cmds=\"$archive_expsym_cmds\"
+	else
+	  eval cmds=\"$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"
+
+	# Restore the uninstalled library and exit
+	if test "$mode" = relink && test "$hardcode_into_libs" = all; then
+	  $run eval '(cd $output_objdir && $rm ${realname}T && $mv $realname ${realname}T && $mv "$realname"U $realname)' || exit $?
+	  exit 0
+	fi
+
+	# Create links to the real library.
+	for linkname in $linknames; do
+	  if test "$realname" != "$linkname"; then
+	    $show "(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)"
+	    $run eval '(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)' || exit $?
+	  fi
+	done
+
+	# If -module or -export-dynamic was specified, set the dlname.
+	if test "$module" = yes || test "$export_dynamic" = yes; then
+	  # On all known operating systems, these are identical.
+	  dlname="$soname"
+	fi
+      fi
+      ;;
+
+    obj)
+      if test -n "$deplibs"; then
+	$echo "$modename: warning: \`-l' and \`-L' are ignored for objects" 1>&2
+      fi
+
+      if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
+	$echo "$modename: warning: \`-dlopen' is ignored for objects" 1>&2
+      fi
+
+      if test -n "$rpath"; then
+	$echo "$modename: warning: \`-rpath' is ignored for objects" 1>&2
+      fi
+
+      if test -n "$xrpath"; then
+	$echo "$modename: warning: \`-R' is ignored for objects" 1>&2
+      fi
+
+      if test -n "$vinfo"; then
+	$echo "$modename: warning: \`-version-info' is ignored for objects" 1>&2
+      fi
+
+      if test -n "$release"; then
+	$echo "$modename: warning: \`-release' is ignored for objects" 1>&2
+      fi
+
+      case "$output" in
+      *.lo)
+	if test -n "$objs$old_deplibs"; 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 "$lo2o"`
+	;;
+      *)
+	libobj=
+	obj="$output"
+	;;
+      esac
+
+      # Delete the old objects.
+      $run $rm $obj $libobj
+
+      # Objects from convenience libraries.  This assumes
+      # single-version convenience libraries.  Whenever we create
+      # different ones for PIC/non-PIC, this we'll have to duplicate
+      # the extraction.
+      reload_conv_objs=
+      gentop=
+      # reload_cmds runs $LD directly, so let us get rid of
+      # -Wl from whole_archive_flag_spec
+      wl=
+
+      if test -n "$convenience"; then
+	if test -n "$whole_archive_flag_spec"; then
+	  eval reload_conv_objs=\"\$reload_objs $whole_archive_flag_spec\"
+	else
+	  gentop="$output_objdir/${obj}x"
+	  $show "${rm}r $gentop"
+	  $run ${rm}r "$gentop"
+	  $show "mkdir $gentop"
+	  $run mkdir "$gentop"
+	  status=$?
+	  if test $status -ne 0 && test ! -d "$gentop"; then
+	    exit $status
+	  fi
+	  generated="$generated $gentop"
+
+	  for xlib in $convenience; do
+	    # Extract the objects.
+	    case "$xlib" in
+	    [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;;
+	    *) xabs=`pwd`"/$xlib" ;;
+	    esac
+	    xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'`
+	    xdir="$gentop/$xlib"
+
+	    $show "${rm}r $xdir"
+	    $run ${rm}r "$xdir"
+	    $show "mkdir $xdir"
+	    $run mkdir "$xdir"
+	    status=$?
+	    if test $status -ne 0 && test ! -d "$xdir"; then
+	      exit $status
+	    fi
+	    $show "(cd $xdir && $AR x $xabs)"
+	    $run eval "(cd \$xdir && $AR x \$xabs)" || exit $?
+
+	    reload_conv_objs="$reload_objs "`find $xdir -name \*.o -print -o -name \*.lo -print | $NL2SP`
+	  done
+	fi
+      fi
+
+      # Create the old-style object.
+      reload_objs="$objs$old_deplibs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}$'/d' -e '/\.lib$/d' -e "$lo2o" | $NL2SP`" $reload_conv_objs" ### testsuite: skip nested quoting test
+
+      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.
+      if test -z "$libobj"; then
+	if test -n "$gentop"; then
+	  $show "${rm}r $gentop"
+	  $run ${rm}r $gentop
+	fi
+
+	exit 0
+      fi
+
+      if test "$build_libtool_libs" != yes; then
+	if test -n "$gentop"; then
+	  $show "${rm}r $gentop"
+	  $run ${rm}r $gentop
+	fi
+
+	# 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" || test "$pic_mode" != default; then
+	# Only do commands if we really have different PIC objects.
+	reload_objs="$libobjs $reload_conv_objs"
+	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 $rm $libobj
+	$run $rm $libobj
+	xdir=`$echo "X$libobj" | $Xsed -e 's%/[^/]*$%%'`
+	if test "X$xdir" = "X$libobj"; then
+	  xdir="."
+	else
+	  xdir="$xdir"
+	fi
+	baseobj=`$echo "X$libobj" | $Xsed -e 's%^.*/%%'`
+	oldobj=`$echo "X$baseobj" | $Xsed -e "$lo2o"`
+	$show "(cd $xdir && $LN_S $oldobj $baseobj)"
+	$run eval '(cd $xdir && $LN_S $oldobj $baseobj)' || exit $?
+      fi
+
+      if test -n "$gentop"; then
+	$show "${rm}r $gentop"
+	$run ${rm}r $gentop
+      fi
+
+      exit 0
+      ;;
+
+    prog)
+      if test -n "$vinfo"; then
+	$echo "$modename: warning: \`-version-info' is ignored for programs" 1>&2
+      fi
+
+      if test -n "$release"; then
+	$echo "$modename: warning: \`-release' is ignored for programs" 1>&2
+      fi
+
+      if test "$preload" = yes; then
+	if test "$dlopen_support" = unknown && test "$dlopen_self" = unknown &&
+	   test "$dlopen_self_static" = unknown; then
+	  $echo "$modename: warning: \`AC_LIBTOOL_DLOPEN' not used. Assuming no dlopen support."
+	fi
+      fi
+
+      compile_command="$compile_command $compile_deplibs"
+      finalize_command="$finalize_command $finalize_deplibs"
+
+      if test -n "$rpath$xrpath"; then
+	# If the user specified any rpath flags, then add them.
+	for libdir in $rpath $xrpath; do
+	  # This is the magic to use -rpath.
+	  case "$finalize_rpath " in
+	  *" $libdir "*) ;;
+	  *) finalize_rpath="$finalize_rpath $libdir" ;;
+	  esac
+	done
+      fi
+
+      # Now hardcode the library paths
+      rpath=
+      hardcode_libdirs=
+      for libdir in $compile_rpath $finalize_rpath; do
+	if test -n "$hardcode_libdir_flag_spec"; then
+	  if test -n "$hardcode_libdir_separator"; then
+	    if test -z "$hardcode_libdirs"; then
+	      hardcode_libdirs="$libdir"
+	    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
+	    fi
+	  else
+	    eval flag=\"$hardcode_libdir_flag_spec\"
+	    rpath="$rpath $flag"
+	  fi
+	elif test -n "$runpath_var"; then
+	  case "$perm_rpath " in
+	  *" $libdir "*) ;;
+	  *) perm_rpath="$perm_rpath $libdir" ;;
+	  esac
+	fi
+	case "$host" in
+	*-*-cygwin* | *-*-mingw* | *-*-os2*)
+	  case ":$dllsearchpath:" in
+	  *":$libdir:"*) ;;
+	  *) dllsearchpath="$dllsearchpath:$libdir";;
+	  esac
+	  ;;
+	esac
+      done
+      # Substitute the hardcoded libdirs into the rpath.
+      if test -n "$hardcode_libdir_separator" &&
+	 test -n "$hardcode_libdirs"; then
+	libdir="$hardcode_libdirs"
+	eval rpath=\" $hardcode_libdir_flag_spec\"
+      fi
+      compile_rpath="$rpath"
+
+      rpath=
+      hardcode_libdirs=
+      for libdir in $finalize_rpath; do
+	if test -n "$hardcode_libdir_flag_spec"; then
+	  if test -n "$hardcode_libdir_separator"; then
+	    if test -z "$hardcode_libdirs"; then
+	      hardcode_libdirs="$libdir"
+	    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
+	    fi
+	  else
+	    eval flag=\"$hardcode_libdir_flag_spec\"
+	    rpath="$rpath $flag"
+	  fi
+	elif test -n "$runpath_var"; then
+	  case "$finalize_perm_rpath " in
+	  *" $libdir "*) ;;
+	  *) finalize_perm_rpath="$finalize_perm_rpath $libdir" ;;
+	  esac
+	fi
+      done
+      # Substitute the hardcoded libdirs into the rpath.
+      if test -n "$hardcode_libdir_separator" &&
+	 test -n "$hardcode_libdirs"; then
+	libdir="$hardcode_libdirs"
+	eval rpath=\" $hardcode_libdir_flag_spec\"
+      fi
+      finalize_rpath="$rpath"
+
+      if test -n "$libobjs" && test "$build_old_libs" = yes; then
+	# Transform all the library objects into standard objects.
+	compile_command=`$echo "X$compile_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
+	finalize_command=`$echo "X$finalize_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
+      fi
+
+      dlsyms=
+      if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
+	if test -n "$NM" && test -n "$global_symbol_pipe"; then
+	  dlsyms="${outputname}S.c"
+	else
+	  $echo "$modename: not configured to extract global symbols from dlpreopened files" 1>&2
+	fi
+      fi
+
+      if test -n "$dlsyms"; then
+	case "$dlsyms" in
+	"") ;;
+	*.c)
+	  # Discover the nlist of each of the dlfiles.
+	  nlist="$output_objdir/${outputname}.nm"
+
+	  $show "$rm $nlist ${nlist}S ${nlist}T"
+	  $run $rm "$nlist" "${nlist}S" "${nlist}T"
+
+	  # Parse the name list into a source file.
+	  $show "creating $output_objdir/$dlsyms"
+
+	  test -z "$run" && $echo > "$output_objdir/$dlsyms" "\
+/* $dlsyms - symbol resolution table for \`$outputname' dlsym emulation. */
+/* Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP */
+
+#ifdef __cplusplus
+extern \"C\" {
+#endif
+
+/* Prevent the only kind of declaration conflicts we can make. */
+#define lt_preloaded_symbols some_other_symbol
+
+/* External symbol declarations for the compiler. */\
+"
+
+	  if test "$dlself" = yes; then
+	    $show "generating symbol list for \`$output'"
+
+	    test -z "$run" && $echo ': @PROGRAM@ ' > "$nlist"
+
+	    # Add our own program objects to the symbol list.
+	    progfiles=`$echo "X$objs$old_deplibs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
+	    for arg in $progfiles; do
+	      $show "extracting global C symbols from \`$arg'"
+	      $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'"
+	    done
+
+	    if test -n "$exclude_expsyms"; then
+	      $run eval 'egrep -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T'
+	      $run eval '$mv "$nlist"T "$nlist"'
+	    fi
+
+	    if test -n "$export_symbols_regex"; then
+	      $run eval 'egrep -e "$export_symbols_regex" "$nlist" > "$nlist"T'
+	      $run eval '$mv "$nlist"T "$nlist"'
+	    fi
+
+	    # Prepare the list of exported symbols
+	    if test -z "$export_symbols"; then
+	      export_symbols="$output_objdir/$output.exp"
+	      $run $rm $export_symbols
+	      $run eval "sed -n -e '/^: @PROGRAM@$/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"'
+	    else
+	      $run eval "sed -e 's/\([][.*^$]\)/\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$output.exp"'
+	      $run eval 'grep -f "$output_objdir/$output.exp" < "$nlist" > "$nlist"T'
+	      $run eval 'mv "$nlist"T "$nlist"'
+	    fi
+	  fi
+
+	  for arg in $dlprefiles; do
+	    $show "extracting global C symbols from \`$arg'"
+	    name=`echo "$arg" | sed -e 's%^.*/%%'`
+	    $run eval 'echo ": $name " >> "$nlist"'
+	    $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'"
+	  done
+
+	  if test -z "$run"; then
+	    # Make sure we have at least an empty file.
+	    test -f "$nlist" || : > "$nlist"
+
+	    if test -n "$exclude_expsyms"; then
+	      egrep -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T
+	      $mv "$nlist"T "$nlist"
+	    fi
+
+	    # Try sorting and uniquifying the output.
+	    if grep -v "^: " < "$nlist" | sort +2 | uniq > "$nlist"S; then
+	      :
+	    else
+	      grep -v "^: " < "$nlist" > "$nlist"S
+	    fi
+
+	    if test -f "$nlist"S; then
+	      eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$dlsyms"'
+	    else
+	      echo '/* NONE */' >> "$output_objdir/$dlsyms"
+	    fi
+
+	    $echo >> "$output_objdir/$dlsyms" "\
+
+#undef lt_preloaded_symbols
+
+#if defined (__STDC__) && __STDC__
+# define lt_ptr_t void *
+#else
+# define lt_ptr_t char *
+# define const
+#endif
+
+/* The mapping between symbol names and symbols. */
+const struct {
+  const char *name;
+  lt_ptr_t address;
+}
+lt_preloaded_symbols[] =
+{\
+"
+
+	    sed -n -e 's/^: \([^ ]*\) $/  {\"\1\", (lt_ptr_t) 0},/p' \
+		-e 's/^. \([^ ]*\) \([^ ]*\)$/  {"\2", (lt_ptr_t) \&\2},/p' \
+		  < "$nlist" >> "$output_objdir/$dlsyms"
+
+	    $echo >> "$output_objdir/$dlsyms" "\
+  {0, (lt_ptr_t) 0}
+};
+
+/* This works around a problem in FreeBSD linker */
+#ifdef FREEBSD_WORKAROUND
+static const void *lt_preloaded_setup() {
+  return lt_preloaded_symbols;
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif\
+"
+	  fi
+
+	  pic_flag_for_symtable=
+	  case "$host" in
+	  # compiling the symbol table file with pic_flag works around
+	  # a FreeBSD bug that causes programs to crash when -lm is
+	  # linked before any other PIC object.  But we must not use
+	  # pic_flag when linking with -static.  The problem exists in
+	  # FreeBSD 2.2.6 and is fixed in FreeBSD 3.1.
+	  *-*-freebsd2*|*-*-freebsd3.0*|*-*-freebsdelf3.0*)
+	    case "$compile_command " in
+	    *" -static "*) ;;
+	    *) pic_flag_for_symtable=" $pic_flag -DPIC -DFREEBSD_WORKAROUND";;
+	    esac;;
+	  *-*-hpux*)
+	    case "$compile_command " in
+	    *" -static "*) ;;
+	    *) pic_flag_for_symtable=" $pic_flag -DPIC";;
+	    esac
+	  esac
+
+	  # Now compile the dynamic symbol file.
+	  $show "(cd $output_objdir && $CC -c$no_builtin_flag$pic_flag_for_symtable \"$dlsyms\")"
+	  $run eval '(cd $output_objdir && $CC -c$no_builtin_flag$pic_flag_for_symtable "$dlsyms")' || exit $?
+
+	  # Clean up the generated files.
+	  $show "$rm $output_objdir/$dlsyms $nlist ${nlist}S ${nlist}T"
+	  $run $rm "$output_objdir/$dlsyms" "$nlist" "${nlist}S" "${nlist}T"
+
+	  # Transform the symbol file into the correct name.
+	  compile_command=`$echo "X$compile_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"`
+	  finalize_command=`$echo "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"`
+	  ;;
+	*)
+	  $echo "$modename: unknown suffix for \`$dlsyms'" 1>&2
+	  exit 1
+	  ;;
+	esac
+      else
+	# We keep going just in case the user didn't refer to
+	# lt_preloaded_symbols.  The linker will fail if global_symbol_pipe
+	# really was required.
+
+	# 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'`
+	link_command="$compile_command$compile_rpath"
+
+	# We have no uninstalled library dependencies, so finalize right now.
+	$show "$link_command"
+	$run eval "$link_command"
+	status=$?
+
+	# Delete the generated files.
+	if test -n "$dlsyms"; then
+	  $show "$rm $output_objdir/${outputname}S.${objext}"
+	  $run $rm "$output_objdir/${outputname}S.${objext}"
+	fi
+
+	exit $status
+      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
+
+      if test -n "$compile_shlibpath$finalize_shlibpath"; then
+	compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command"
+      fi
+      if test -n "$finalize_shlibpath"; then
+	finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command"
+      fi
+
+      compile_var=
+      finalize_var=
+      if test -n "$runpath_var"; then
+	if test -n "$perm_rpath"; then
+	  # We should set the runpath_var.
+	  rpath=
+	  for dir in $perm_rpath; do
+	    rpath="$rpath$dir:"
+	  done
+	  compile_var="$runpath_var=\"$rpath\$$runpath_var\" "
+	fi
+	if test -n "$finalize_perm_rpath"; then
+	  # We should set the runpath_var.
+	  rpath=
+	  for dir in $finalize_perm_rpath; do
+	    rpath="$rpath$dir:"
+	  done
+	  finalize_var="$runpath_var=\"$rpath\$$runpath_var\" "
+	fi
+      fi
+
+      if test "$no_install" = yes; then
+	# We don't need to create a wrapper script.
+	link_command="$compile_var$compile_command$compile_rpath"
+	# Replace the output file specification.
+	link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'`
+	# Delete the old output file.
+	$run $rm $output
+	# Link the executable and exit
+	$show "$link_command"
+	$run eval "$link_command" || exit $?
+	exit 0
+      fi
+
+      if test "$hardcode_action" = relink || test "$hardcode_into_libs" = all; then
+	# Fast installation is not supported
+	link_command="$compile_var$compile_command$compile_rpath"
+	relink_command="$finalize_var$finalize_command$finalize_rpath"
+
+	$echo "$modename: warning: this platform does not like uninstalled shared libraries" 1>&2
+	$echo "$modename: \`$output' will be relinked during installation" 1>&2
+      else
+	if test "$fast_install" != no; then
+	  link_command="$finalize_var$compile_command$finalize_rpath"
+	  if test "$fast_install" = yes; then
+	    relink_command=`$echo "X$compile_var$compile_command$compile_rpath" | $Xsed -e 's%@OUTPUT@%\$progdir/\$file%g'`
+	  else
+	    # fast_install is set to needless
+	    relink_command=
+	  fi
+	else
+	  link_command="$compile_var$compile_command$compile_rpath"
+	  relink_command="$finalize_var$finalize_command$finalize_rpath"
+	fi
+      fi
+
+      # Replace the output file specification.
+      link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'`
+
+      # Delete the old output files.
+      $run $rm $output $output_objdir/$outputname $output_objdir/lt-$outputname
+
+      $show "$link_command"
+      $run eval "$link_command" || exit $?
+
+      # Now create the wrapper script.
+      $show "creating $output"
+
+      # Quote the relink command for shipping.
+      if test -n "$relink_command"; then
+	relink_command="cd `pwd`; $relink_command"
+	relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"`
+      fi
+
+      # Quote $echo for shipping.
+      if test "X$echo" = "X$SHELL $0 --fallback-echo"; then
+	case "$0" in
+	[\\/]* | [A-Za-z]:[\\/]*) qecho="$SHELL $0 --fallback-echo";;
+	*) qecho="$SHELL `pwd`/$0 --fallback-echo";;
+	esac
+	qecho=`$echo "X$qecho" | $Xsed -e "$sed_quote_subst"`
+      else
+	qecho=`$echo "X$echo" | $Xsed -e "$sed_quote_subst"`
+      fi
+
+      # Only actually do things if our run command is non-null.
+      if test -z "$run"; then
+	# win32 will think the script is a binary if it has
+	# a .exe suffix, so we strip it off here.
+	case $output in
+	  *.exe) output=`echo $output|sed 's,.exe$,,'` ;;
+	esac
+	$rm $output
+	trap "$rm $output; exit 1" 1 2 15
+
+	$echo > $output "\
+#! $SHELL
+
+# $output - temporary wrapper script for $objdir/$outputname
+# Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP
+#
+# 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 the build directory.
+# 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 1s/^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
+
+relink_command=\"$relink_command\"
+
+# This environment variable determines our operation mode.
+if test \"\$libtool_install_magic\" = \"$magic\"; then
+  # install mode needs the following variable:
+  link_against_libtool_libs='$link_against_libtool_libs'
+else
+  # When we are sourced in execute mode, \$file and \$echo are already set.
+  if test \"\$libtool_execute_magic\" != \"$magic\"; then
+    echo=\"$qecho\"
+    file=\"\$0\"
+    # Make sure echo works.
+    if test \"X\$1\" = X--no-reexec; then
+      # Discard the --no-reexec flag, and continue.
+      shift
+    elif test \"X\`(\$echo '\t') 2>/dev/null\`\" = 'X\t'; then
+      # Yippee, \$echo works!
+      :
+    else
+      # Restart under the correct shell, and then maybe \$echo will work.
+      exec $SHELL \"\$0\" --no-reexec \${1+\"\$@\"}
+    fi
+  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\"
+"
+
+	if test "$fast_install" = yes; then
+	  echo >> $output "\
+  program=lt-'$outputname'
+  progdir=\"\$thisdir/$objdir\"
+
+  if test ! -f \"\$progdir/\$program\" || \\
+     { file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | sed 1q\`; \\
+       test \"X\$file\" != \"X\$progdir/\$program\"; }; then
+
+    file=\"\$\$-\$program\"
+
+    if test ! -d \"\$progdir\"; then
+      $mkdir \"\$progdir\"
+    else
+      $rm \"\$progdir/\$file\"
+    fi"
+
+	  echo >> $output "\
+
+    # relink executable if necessary
+    if test -n \"\$relink_command\"; then
+      if (eval \$relink_command); then :
+      else
+	$rm \"\$progdir/\$file\"
+	exit 1
+      fi
+    fi
+
+    $mv \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null ||
+    { $rm \"\$progdir/\$program\";
+      $mv \"\$progdir/\$file\" \"\$progdir/\$program\"; }
+    $rm \"\$progdir/\$file\"
+  fi"
+	else
+	  echo >> $output "\
+  program='$outputname'
+  progdir=\"\$thisdir/$objdir\"
+"
+	fi
+
+	echo >> $output "\
+
+  if test -f \"\$progdir/\$program\"; then"
+
+	# Export our shlibpath_var if we have one.
+	if test "$shlibpath_overrides_runpath" = yes && 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
+    # The second colon is a workaround for a bug in BeOS R4 sed
+    $shlibpath_var=\`\$echo \"X\$$shlibpath_var\" | \$Xsed -e 's/::*\$//'\`
+
+    export $shlibpath_var
+"
+	fi
+
+	# fixup the dll searchpath if we need to.
+	if test -n "$dllsearchpath"; then
+	  $echo >> $output "\
+    # Add the dll search path components to the executable PATH
+    PATH=$dllsearchpath:\$PATH
+"
+	fi
+
+	$echo >> $output "\
+    if test \"\$libtool_execute_magic\" != \"$magic\"; then
+      # Run the actual program with our arguments.
+"
+	case $host in
+	*-*-cygwin* | *-*-mingw | *-*-os2*)
+	  # win32 systems need to use the prog path for dll
+	  # lookup to work
+	  $echo >> $output "\
+      exec \$progdir\\\\\$program \${1+\"\$@\"}
+"
+	  ;;
+	*)
+	  $echo >> $output "\
+      # Export the path to the program.
+      PATH=\"\$progdir:\$PATH\"
+      export PATH
+
+      exec \$program \${1+\"\$@\"}
+"
+	  ;;
+	esac
+	$echo >> $output "\
+      \$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.
+    for oldlib in $oldlibs; do
+
+      if test "$build_libtool_libs" = convenience; then
+	oldobjs="$libobjs_save"
+	addlibs="$convenience"
+	build_libtool_libs=no
+      else
+	if test "$build_libtool_libs" = module; then
+	  oldobjs="$libobjs_save"
+	  build_libtool_libs=no
+	else
+	  oldobjs="$objs$old_deplibs "`$echo "X$libobjs_save" | $SP2NL | $Xsed -e '/\.'${libext}'$/d' -e '/\.lib$/d' -e "$lo2o" | $NL2SP`
+	fi
+	addlibs="$old_convenience"
+      fi
+
+      if test -n "$addlibs"; then
+	gentop="$output_objdir/${outputname}x"
+	$show "${rm}r $gentop"
+	$run ${rm}r "$gentop"
+	$show "mkdir $gentop"
+	$run mkdir "$gentop"
+	status=$?
+	if test $status -ne 0 && test ! -d "$gentop"; then
+	  exit $status
+	fi
+	generated="$generated $gentop"
+
+	# Add in members from convenience archives.
+	for xlib in $addlibs; do
+	  # Extract the objects.
+	  case "$xlib" in
+	  [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;;
+	  *) xabs=`pwd`"/$xlib" ;;
+	  esac
+	  xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'`
+	  xdir="$gentop/$xlib"
+
+	  $show "${rm}r $xdir"
+	  $run ${rm}r "$xdir"
+	  $show "mkdir $xdir"
+	  $run mkdir "$xdir"
+	  status=$?
+	  if test $status -ne 0 && test ! -d "$xdir"; then
+	    exit $status
+	  fi
+	  $show "(cd $xdir && $AR x $xabs)"
+	  $run eval "(cd \$xdir && $AR x \$xabs)" || exit $?
+
+	  oldobjs="$oldobjs "`find $xdir -name \*.${objext} -print -o -name \*.lo -print | $NL2SP`
+	done
+      fi
+
+      # 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
+	# Ensure that we have .o objects in place in case we decided
+	# not to build a shared library, and have fallen back to building
+	# static libs even though --disable-static was passed!
+	for oldobj in $oldobjs; do
+	  if test ! -f $oldobj; then
+	    xdir=`$echo "X$oldobj" | $Xsed -e 's%/[^/]*$%%'`
+	    if test "X$xdir" = "X$oldobj"; then
+	      xdir="."
+	    else
+	      xdir="$xdir"
+	    fi
+	    baseobj=`$echo "X$oldobj" | $Xsed -e 's%^.*/%%'`
+	    obj=`$echo "X$baseobj" | $Xsed -e "$o2lo"`
+	    $show "(cd $xdir && ${LN_S} $obj $baseobj)"
+	    $run eval '(cd $xdir && ${LN_S} $obj $baseobj)' || exit $?
+	  fi
+	done
+
+	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"
+    done
+
+    if test -n "$generated"; then
+      $show "${rm}r$generated"
+      $run ${rm}r$generated
+    fi
+
+    # Now create the libtool archive.
+    case "$output" in
+    *.la)
+      old_library=
+      test "$build_old_libs" = yes && old_library="$libname.$libext"
+      $show "creating $output"
+
+      # Quote the link command for shipping.
+      relink_command="cd `pwd`; $SHELL $0 --mode=relink $libtool_args"
+      relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"`
+
+      # Only create the output if not a dry run.
+      if test -z "$run"; then
+	for installed in no yes; do
+	  if test "$installed" = yes; then
+	    if test -z "$install_libdir"; then
+	      break
+	    fi
+	    output="$output_objdir/$outputname"i
+	    # Replace all uninstalled libtool libraries with the installed ones
+	    newdependency_libs=
+	    for deplib in $dependency_libs; do
+	      case "$deplib" in
+	      *.la)
+		name=`$echo "X$deplib" | $Xsed -e 's%^.*/%%'`
+		eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
+		if test -z "$libdir"; then
+		  $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2
+		  exit 1
+		fi
+		newdependency_libs="$newdependency_libs $libdir/$name"
+		;;
+	      *) newdependency_libs="$newdependency_libs $deplib" ;;
+	      esac
+	    done
+	    dependency_libs="$newdependency_libs"
+	    newdlfiles=
+	    for lib in $dlfiles; do
+	      name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'`
+	      eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
+	      if test -z "$libdir"; then
+		$echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
+		exit 1
+	      fi
+	      newdlfiles="$newdlfiles $libdir/$name"
+	    done
+	    dlfiles="$newdlfiles"
+	    newdlprefiles=
+	    for lib in $dlprefiles; do
+	      name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'`
+	      eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
+	      if test -z "$libdir"; then
+		$echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
+		exit 1
+	      fi
+	      newdlprefiles="$newdlprefiles $libdir/$name"
+	    done
+	    dlprefiles="$newdlprefiles"
+	  fi
+	  $rm $output
+	  $echo > $output "\
+# $outputname - a libtool library file
+# Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP
+#
+# Please DO NOT delete this file!
+# It is necessary for linking the library.
+
+# 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
+
+# Is this an already installed library?
+installed=$installed
+
+# Files to dlopen/dlpreopen
+dlopen='$dlfiles'
+dlpreopen='$dlprefiles'
+
+# Directory that this library needs to be installed in:
+libdir='$install_libdir'"
+	  if test "$installed" = no; then
+	    $echo >> $output "\
+relink_command=\"$relink_command\""
+	  fi
+	done
+      fi
+
+      # Do a symbolic link so that the libtool archive can be found in
+      # LD_LIBRARY_PATH before the program is installed.
+      $show "(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)"
+      $run eval '(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)' || exit $?
+      ;;
+    esac
+    exit 0
+    ;;
+
+  # libtool install mode
+  install)
+    modename="$modename: install"
+
+    # There may be an optional sh(1) argument at the beginning of
+    # install_prog (especially on Windows NT).
+    if test "$nonopt" = "$SHELL" || test "$nonopt" = /bin/sh; 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=no
+    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 "$isdir" = yes; 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
+      *.$libext)
+	# 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 .*$PACKAGE") >/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=
+	relink_command=
+	# 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"
+
+	if test "$hardcode_into_libs" = all; then
+	  if test -z "$relink_command"; then
+	    $echo "$modename: invalid libtool pseudo library \`$file'" 1>&2
+	    exit 1
+	  fi
+	  $echo "$modename: warning: relinking \`$file'" 1>&2
+	  $show "$relink_command"
+	  if $run eval "$relink_command"; then :
+	  else
+	    $echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2
+	    continue
+	  fi
+	fi
+
+	# See the names of the shared library.
+	set dummy $library_names
+	if test -n "$2"; then
+	  realname="$2"
+	  shift
+	  shift
+
+	  srcname="$realname"
+	  test "$hardcode_into_libs" = all && srcname="$realname"T
+
+	  # Install the shared library and build the symlinks.
+	  $show "$install_prog $dir/$srcname $destdir/$realname"
+	  $run eval "$install_prog $dir/$srcname $destdir/$realname" || exit $?
+	  if test -n "$stripme" && test -n "$striplib"; then
+	    $show "$striplib $destdir/$realname"
+	    $run eval "$striplib $destdir/$realname" || exit $?
+	  fi
+
+	  if test $# -gt 0; then
+	    # Delete the old symlinks, and create new ones.
+	    for linkname
+	    do
+	      if test "$linkname" != "$realname"; then
+		$show "(cd $destdir && $rm $linkname && $LN_S $realname $linkname)"
+		$run eval "(cd $destdir && $rm $linkname && $LN_S $realname $linkname)"
+	      fi
+	    done
+	  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%^.*/%%'`
+	instname="$dir/$name"i
+	$show "$install_prog $instname $destdir/$name"
+	$run eval "$install_prog $instname $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 "$lo2o"`
+	  ;;
+	*.$objext)
+	  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 "$lo2o"`
+
+	  $show "$install_prog $staticobj $staticdest"
+	  $run eval "$install_prog \$staticobj \$staticdest" || exit $?
+	fi
+	exit 0
+	;;
+
+      *)
+	# 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
+
+	# Do a test to see if this is really a libtool program.
+	if (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
+	  link_against_libtool_libs=
+	  relink_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"; 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'` ### testsuite: skip nested quoting test
+	    if test -n "$libdir" && test ! -f "$libfile"; then
+	      $echo "$modename: warning: \`$lib' has not been installed in \`$libdir'" 1>&2
+	      finalize=no
+	    fi
+	  done
+
+	  relink_command=
+	  # If there is no directory component, then add one.
+	  case "$file" in
+	  */* | *\\*) . $file ;;
+	  *) . ./$file ;;
+	  esac
+
+	  outputname=
+	  if test "$fast_install" = no && test -n "$relink_command"; then
+	    if test "$finalize" = yes && test -z "$run"; then
+	      tmpdir="/tmp"
+	      test -n "$TMPDIR" && tmpdir="$TMPDIR"
+	      tmpdir="$tmpdir/libtool-$$"
+	      if $mkdir -p "$tmpdir" && chmod 700 "$tmpdir"; then :
+	      else
+		$echo "$modename: error: cannot create temporary directory \`$tmpdir'" 1>&2
+		continue
+	      fi
+	      outputname="$tmpdir/$file"
+	      # Replace the output file specification.
+	      relink_command=`$echo "X$relink_command" | $Xsed -e 's%@OUTPUT@%'"$outputname"'%g'`
+
+	      $show "$relink_command"
+	      if $run eval "$relink_command"; then :
+	      else
+		$echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2
+		${rm}r "$tmpdir"
+		continue
+	      fi
+	      file="$outputname"
+	    else
+	      $echo "$modename: warning: cannot relink \`$file'" 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 $destfile"
+	$run eval "$install_prog\$stripme \$file \$destfile" || exit $?
+	test -n "$outputname" && ${rm}r "$tmpdir"
+	;;
+      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 $?
+
+      if test -n "$stripme" && test -n "$striplib"; then
+	$show "$old_striplib $oldlib"
+	$run eval "$old_striplib $oldlib" || exit $?
+      fi
+
+      # 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"
+    admincmds=
+
+    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" || admincmds="$admincmds
+       $cmd"
+	  done
+	  IFS="$save_ifs"
+	fi
+	if test -n "$finish_eval"; then
+	  # Do the single finish_eval.
+	  eval cmds=\"$finish_eval\"
+	  $run eval "$cmds" || admincmds="$admincmds
+       $cmds"
+	fi
+      done
+    fi
+
+    # Exit here if they wanted silent mode.
+    test "$show" = : && exit 0
+
+    echo "----------------------------------------------------------------------"
+    echo "Libraries have been installed in:"
+    for libdir in $libdirs; do
+      echo "   $libdir"
+    done
+    echo
+    echo "If you ever happen to want to link against installed libraries"
+    echo "in a given directory, LIBDIR, you must either use libtool, and"
+    echo "specify the full pathname of the library, or use \`-LLIBDIR'"
+    echo "flag during linking and do at least 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 -n "$admincmds"; then
+      echo "   - have your system administrator run these commands:$admincmds"
+    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
+	$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 .*$PACKAGE") >/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 .*$PACKAGE") >/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
+      if test -n "$shlibpath_var"; then
+	# Export the shlibpath_var.
+	eval "export $shlibpath_var"
+      fi
+
+      # Restore saved enviroment variables
+      if test "${save_LC_ALL+set}" = set; then
+	LC_ALL="$save_LC_ALL"; export LC_ALL
+      fi
+      if test "${save_LANG+set}" = set; then
+	LANG="$save_LANG"; export LANG
+      fi
+
+      # Now actually exec the command.
+      eval "exec \$cmd$args"
+
+      $echo "$modename: cannot exec \$cmd$args"
+      exit 1
+    else
+      # Display what would be done.
+      if test -n "$shlibpath_var"; then
+	eval "\$echo \"\$shlibpath_var=\$$shlibpath_var\""
+	$echo "export $shlibpath_var"
+      fi
+      $echo "$cmd$args"
+      exit 0
+    fi
+    ;;
+
+  # libtool clean and uninstall mode
+  clean | uninstall)
+    modename="$modename: $mode"
+    rm="$nonopt"
+    files=
+
+    # This variable tells wrapper scripts just to set variables rather
+    # than running their programs.
+    libtool_install_magic="$magic"
+
+    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%/[^/]*$%%'`
+      if test "X$dir" = "X$file"; then
+	dir=.
+	objdir="$objdir"
+      else
+	objdir="$dir/$objdir"
+      fi
+      name=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
+      test $mode = uninstall && objdir="$dir"
+
+      rmfiles="$file"
+
+      case "$name" in
+      *.la)
+	# Possibly a libtool archive, so verify it.
+	if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
+	  . $dir/$name
+
+	  # Delete the libtool libraries and symlinks.
+	  for n in $library_names; do
+	    rmfiles="$rmfiles $objdir/$n"
+	  done
+	  test -n "$old_library" && rmfiles="$rmfiles $objdir/$old_library"
+	  test $mode = clean && rmfiles="$rmfiles $objdir/$name $objdir/${name}i"
+
+	  if test $mode = uninstall; then
+	    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
+	fi
+	;;
+
+      *.lo)
+	if test "$build_old_libs" = yes; then
+	  oldobj=`$echo "X$name" | $Xsed -e "$lo2o"`
+	  rmfiles="$rmfiles $dir/$oldobj"
+	fi
+	;;
+
+      *)
+	# Do a test to see if this is a libtool program.
+	if test $mode = clean &&
+	   (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
+	  relink_command=
+	  . $dir/$file
+
+	  rmfiles="$rmfiles $objdir/$name $objdir/${name}S.${objext}"
+	  if test "$fast_install" = yes && test -n "$relink_command"; then
+	    rmfiles="$rmfiles $objdir/lt-$name"
+	  fi
+	fi
+	;;
+      esac
+      $show "$rm $rmfiles"
+      $run $rm $rmfiles
+    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.
+
+    --config          show all configuration variables
+    --debug           enable verbose shell tracing
+-n, --dry-run         display commands without modifying any files
+    --features        display basic 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:
+
+      clean           remove files from the build directory
+      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
+  ;;
+
+clean)
+  $echo \
+"Usage: $modename [OPTION]... --mode=clean RM [RM-OPTION]... FILE...
+
+Remove files from the build 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, object or program, all the files associated
+with it are deleted. Otherwise, only FILE itself is deleted using RM."
+  ;;
+
+compile)
+  $echo \
+"Usage: $modename [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE
+
+Compile a source file into a libtool library object.
+
+This mode accepts the following additional options:
+
+  -o OUTPUT-FILE    set the output file name to OUTPUT-FILE
+  -static           always build a \`.o' file suitable for static linking
+
+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
+  -avoid-version    do not add a version suffix if possible
+  -dlopen FILE      \`-dlpreopen' FILE if it cannot be dlopened at runtime
+  -dlpreopen FILE   link in FILE and add its symbols to lt_preloaded_symbols
+  -export-dynamic   allow symbols from OUTPUT-FILE to be resolved with dlsym(3)
+  -export-symbols SYMFILE
+		    try to export only the symbols listed in SYMFILE
+  -export-symbols-regex REGEX
+		    try to export only the symbols matching REGEX
+  -LLIBDIR          search LIBDIR for required installed libraries
+  -lNAME            OUTPUT-FILE requires the installed library libNAME
+  -module           build a library that can dlopened
+  -no-fast-install  disable the fast-install mode
+  -no-install       link a not-installable executable
+  -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
+  -R[ ]LIBDIR       add LIBDIR to the runtime path of programs and libraries
+  -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, except when creating a convenience library.
+
+If OUTPUT-FILE ends in \`.a' or \`.lib', then a standard library is created
+using \`ar' and \`ranlib', or on Windows using \`lib'.
+
+If OUTPUT-FILE ends in \`.lo' or \`.${objext}', 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/src/gmp/macos/Makefile.in b/src/gmp/macos/Makefile.in
new file mode 100644
index 000000000..d9f5fe263
--- /dev/null
+++ b/src/gmp/macos/Makefile.in
@@ -0,0 +1,295 @@
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+VERSION 	= @version@
+
+C		= @cc@
+COptions	= @coptions@
+Link		= @link@
+LinkOptions	= @linkoptions@
+ToolOptions     = @tooloptions@
+Asm		= @asm@
+AOptions	= @aoptions@
+
+Lib	= "libgmp.{VERSION}"
+
+# These are only needed for creating test programs as MPW tools
+
+
+SysLibs		= @syslibs@
+
+# Where to put object code. The reason we don't put them into
+# the same directory is that some objectfiles have the same
+# name.
+
+MpfObjDir	= :MpfObj:
+MpnObjDir	= :MpnObj:
+MpqObjDir	= :MpqObj:
+MpzObjDir	= :MpzObj:
+CmnObjDir	= :CmnObj:
+AsmObjDir	= :AsmObj:
+AsmSrcDir	= :Asm:
+MpfBinDir	= :MpfBin:
+MpqBinDir	= :MpqBin:
+MpzBinDir	= :MpzBin:
+
+ObjDirs		= {MpfObjDir} {MpnObjDir} {MpqObjDir} {MpzObjDir} @c@
+		  {CmnObjDir} {AsmObjDir} {AsmSrcDir} @c@
+                  {MpfBinDir} {MpqBinDir} {MpzBinDir}
+
+###########################################################################
+
+AsmObjs = @asm_objects@
+
+AsmSrc = @asm_sources@
+
+MpnObjs = {MpnObjDir}mp_bases.o @c@
+	@mpn_objects@
+
+MpfObjs = @c@
+	@mpf_objects@
+
+MpqObjs = @c@
+	@mpq_objects@
+
+MpzObjs = @c@
+	@mpz_objects@
+
+CmnObjs = @c@
+	@gmp_objects@
+
+Objs = {AsmObjs} {MpfObjs} {MpnObjs} {MpqObjs} {MpzObjs} {CmnObjs}
+
+
+
+###########################################################################
+
+all	@dep@ {Lib}
+
+{Lib} @dep@ {Objs} Makefile
+	{Link} {LinkOptions} -o {Lib} {Objs}
+
+
+###########################################################################
+# Special rules, got them from "mp[fqz]/Makefile.am"
+
+{MpzObjDir}mul_si.o @dep@ ::mpz:mul_siui.c Makefile
+	{C} ::mpz:mul_siui.c -o {Targ} {COptions} -d OPERATION_mul_si
+
+{MpzObjDir}mul_ui.o @dep@ ::mpz:mul_siui.c Makefile
+	{C} ::mpz:mul_siui.c -o {Targ} {COptions} -d OPERATION_mul_ui
+
+
+{MpfObjDir}floor.o @dep@ ::mpf:integer.c Makefile
+	{C} ::mpf:integer.c -o {Targ} {COptions} -d OPERATION_floor
+
+{MpfObjDir}ceil.o @dep@ ::mpf:integer.c Makefile
+	{C} ::mpf:integer.c -o {Targ} {COptions} -d OPERATION_ceil
+
+{MpfObjDir}trunc.o @dep@ ::mpf:integer.c Makefile
+	{C} ::mpf:integer.c -o {Targ} {COptions} -d OPERATION_trunc
+
+
+###########################################################################
+# Default rules/ directory rules
+
+{MpfObjDir} @dep@ ::mpf:
+
+{MpnObjDir} @dep@ ::mpn: ::mpn:generic:
+
+{MpqObjDir} @dep@ ::mpq:
+
+{MpzObjDir} @dep@ ::mpz:
+
+{CmnObjDir} @dep@ ::
+
+{AsmObjDir} @dep@ :Asm:
+
+{MpzBinDir} @dep@ ::mpz:tests:
+{MpqBinDir} @dep@ ::mpq:tests:
+{MpfBinDir} @dep@ ::mpf:tests:
+
+.o	@dep@ .c Makefile
+	{C} {DepDir}{default}.c -o {TargDir}{default}.o {COptions}
+
+.o	@dep@ .s Makefile
+	{Asm} {DepDir}{default}.s -o {TargDir}{default}.o {AOptions}
+
+
+clean @dep@
+	Delete -c -i ::mpz:tests:@wildcard@.o
+	Delete -c -i ::mpq:tests:@wildcard@.o
+	Delete -c -i ::mpf:tests:@wildcard@.o
+	Delete -c -i :@wildcard@:@wildcard@.o
+	Delete -c -i :@wildcard@:@wildcard@.s
+	Delete -c -i @wildcard@~
+
+distclean @dep@ clean
+	Delete -c -i {Lib}
+	Delete -c -i @wildcard@~
+	Delete -c -i @wildcard@.bak
+
+maintainer_clean @dep@ distclean
+	Delete -c -i config.h
+	Delete -c -i configure.mac
+	Delete -c -i Makefile
+	Delete -c -i Makefile.cw
+
+###########################################################################
+# Test application FIXME: Not ready
+
+TestApp = test
+TestObj = test.o
+
+{TestApp} @dep@ {TestObj}
+	{Link} -o {TestApp} {TestObj} {Lib} {SysLibs}
+
+
+###########################################################################
+# FIXME: This does't work very well.....
+# FIXME: Find dependency somehow. With the Unix mkdep like
+#   mkdep -I. -Imacos -Impn -Impn/powerpc32 -Impz \
+#     `find . -name "*.c" | grep -v Apple | grep -v tests | grep -v macos`
+# or some MPW tool.
+
+.exe @dep@ .o
+	{Link} {ToolOptions} -o {TargDir}{default}.exe {DepDir}{default}.o  @c@
+	{Lib} {SysLibs}
+
+
+check @dep@ check-mpz check-mpq check-mpf
+
+check-mpz @dep@ z-mul z-tdiv z-tdiv_ui z-fdiv z-fdiv_ui @c@
+		z-gcd z-dive z-sqrtrem z-convert z-logic z-bit @c@
+		z-powm z-powm_ui z-pow_ui z-2exp z-reuse z-root @c@
+		z-jac z-bin z-misc
+
+# FIXME: Left out z-io, can't compile it.
+
+z-mul @dep@ {MpzBinDir}t-mul.exe
+	{MpzBinDir}t-mul.exe
+
+z-tdiv @dep@ {MpzBinDir}t-tdiv.exe
+	{MpzBinDir}t-tdiv.exe
+
+z-tdiv_ui @dep@ {MpzBinDir}t-tdiv_ui.exe
+	{MpzBinDir}t-tdiv_ui.exe
+
+z-fdiv @dep@ {MpzBinDir}t-fdiv.exe
+	{MpzBinDir}t-fdiv.exe
+
+z-fdiv_ui @dep@ {MpzBinDir}t-fdiv_ui.exe
+	{MpzBinDir}t-fdiv_ui.exe
+
+z-gcd @dep@ {MpzBinDir}t-gcd.exe
+	{MpzBinDir}t-gcd.exe
+
+z-dive @dep@ {MpzBinDir}dive.exe
+	{MpzBinDir}dive.exe
+
+z-sqrtrem @dep@ {MpzBinDir}t-sqrtrem.exe
+	{MpzBinDir}t-sqrtrem.exe
+
+z-convert @dep@ {MpzBinDir}convert.exe
+	{MpzBinDir}convert.exe
+
+z-io @dep@ {MpzBinDir}io.exe
+	{MpzBinDir}io.exe
+
+z-logic @dep@ {MpzBinDir}logic.exe
+	{MpzBinDir}logic.exe
+
+z-bit @dep@ {MpzBinDir}bit.exe
+	{MpzBinDir}bit.exe
+
+z-powm @dep@ {MpzBinDir}t-powm.exe
+	{MpzBinDir}t-powm.exe
+
+z-powm_ui @dep@ {MpzBinDir}t-powm_ui.exe
+	{MpzBinDir}t-powm_ui.exe
+
+z-pow_ui @dep@ {MpzBinDir}t-pow_ui.exe
+	{MpzBinDir}t-pow_ui.exe
+
+z-2exp @dep@ {MpzBinDir}t-2exp.exe
+	{MpzBinDir}t-2exp.exe
+
+z-reuse @dep@ {MpzBinDir}reuse.exe
+	{MpzBinDir}reuse.exe
+
+z-root @dep@ {MpzBinDir}t-root.exe
+	{MpzBinDir}t-root.exe
+
+z-jac @dep@ {MpzBinDir}t-jac.exe
+	{MpzBinDir}t-jac.exe
+
+z-bin @dep@ {MpzBinDir}t-bin.exe
+	{MpzBinDir}t-bin.exe
+
+z-misc @dep@ {MpzBinDir}t-misc.exe
+	{MpzBinDir}t-misc.exe
+
+
+check-mpq @dep@ q-cmp q-cmp_ui q-get_d
+
+q-cmp @dep@ {MpqBinDir}t-cmp.exe
+	{MpqBinDir}t-cmp.exe
+
+q-cmp_ui @dep@ {MpqBinDir}t-cmp_ui.exe
+	{MpqBinDir}t-cmp_ui.exe
+
+q-get_d @dep@ {MpqBinDir}t-get_d.exe
+	{MpqBinDir}t-get_d.exe
+
+
+check-mpf @dep@ f-add f-sub f-conv f-sqrt f-muldiv f-dm2exp f-reuse @c@
+		f-get_d f-misc
+
+{MpfBinDir}t-add.exe @dep@ ::mpf:tests:t-add.o ::mpf:tests:ref.o
+	{Link} {ToolOptions} -o {Targ} {Deps} {Lib} {SysLibs}
+
+{MpfBinDir}t-sub.exe @dep@ ::mpf:tests:t-sub.o ::mpf:tests:ref.o
+	{Link} {ToolOptions} -o {Targ} {Deps} {Lib} {SysLibs}
+
+f-add @dep@ {MpfBinDir}t-add.exe
+	{MpfBinDir}t-add.exe
+
+f-sub @dep@ {MpfBinDir}t-sub.exe
+	{MpfBinDir}t-sub.exe
+
+f-conv @dep@ {MpfBinDir}t-conv.exe
+	{MpfBinDir}t-conv.exe
+
+f-sqrt @dep@ {MpfBinDir}t-sqrt.exe
+	{MpfBinDir}t-sqrt.exe
+
+f-muldiv @dep@ {MpfBinDir}t-muldiv.exe
+	{MpfBinDir}t-muldiv.exe
+
+f-dm2exp @dep@ {MpfBinDir}t-dm2exp.exe
+	{MpfBinDir}t-dm2exp.exe
+
+f-reuse @dep@ {MpfBinDir}reuse.exe
+	{MpfBinDir}reuse.exe
+
+f-get_d @dep@ {MpfBinDir}t-get_d.exe
+	{MpfBinDir}t-get_d.exe
+
+f-misc @dep@ {MpfBinDir}t-misc.exe
+	{MpfBinDir}t-misc.exe
diff --git a/src/gmp/macos/README b/src/gmp/macos/README
new file mode 100644
index 000000000..d52b35665
--- /dev/null
+++ b/src/gmp/macos/README
@@ -0,0 +1,233 @@
+===========================================================================
+
+                  GMP port to Power Macintosh and MacOS
+
+                       Kent Boortz <kent@swox.se>
+
+===========================================================================
+
+
+
+This is an unsupported port of GMP to Power Macintosh and MacOS. It
+will use the optimized 'mpn' assembler routines written for 32 bit
+PowerPC to gain speed. The BSD MP compatible library is not built.
+
+The output is a library
+
+        $GMP_SOURCE_DIR/macos/libgmp.$GMP_VERSION
+
+Not all tests pass
+
+        We never run the 'io' test the source don't compile
+
+        If using Apple's compilers we never run the mpz t-mul, mpf t-add
+        and mpf t-sub because they don't compile with MrC 4.1
+
+
+
+REQUIREMENTS
+============
+
+To compile into the library you need
+
+        Apple MPW (free) or CodeWarrior MPW
+	MacPerl 5 for MPW
+
+GMP build was tested with CodeWarrior Pro 5 and MPW Shell 3.5.
+
+For compiling with the free Apple MPW development system you need a
+68K Macintosh with a 68020 or higher microprocessor, or any Power
+Macintosh with at least 8 Mb of memory and MacOS 7.5 or later.
+
+See the CodeWarrior documentation for the CodeWarrior MPW requirements.
+
+MacPerl is free, download and install the MPW tool version from
+
+    http://www.macperl.com
+
+You need the "Appl" and "Tool" archive, for example
+
+    http://www.perl.com/CPAN-local/ports/mac/Mac_Perl_520r4_appl.bin
+    http://www.perl.com/CPAN-local/ports/mac/Mac_Perl_520r4_tool.bin
+
+See the file "Install.MPW_Perl" for MPW Perl installation instructions.
+
+
+
+APPLE MPW INSTALLATION
+======================
+
+The MPW development system can be found on February 2000 Apple developer
+"tool chest" CD or be downloaded from
+
+    http://developer.apple.com/tools/mpw-tools/
+
+You need "StuffIt Expander" to unpack the source. You can download
+"StuffIt Expander" for free from
+
+    http://www.aladdinsys.com/expander/expander_mac_login.html
+
+Unpack the installation instructions
+
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./About_MPW_etc.sit.hqx
+
+This result is a PDF file that can be read with the free Acrobat Reader
+
+    http://www.adobe.com/products/acrobat/readstep.html
+
+From the MPW development environment you need at least
+
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/MPW/MPW_Shell.sit.hqx
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/MPW/Scripts.sit.hqx
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/MPW/Tools/GetFileName.sit.hqx
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/MPW/Tools/Make.sit.hqx
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/MPW/Tools/MrC.sit.hqx
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/MPW/Tools/PPCAsm.sit.hqx
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/MPW/Tools/PPCLink.sit.hqx
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/Interfaces&Libraries/Libraries.sit.hqx
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/Interfaces&Libraries/RuntimeLibraries.sit.hqx
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./MPW-GM/Interfaces&Libraries/Interfaces/CIncludes.sit.hqx
+
+Put these into a folder and drag the whole folder to the "StuffIt
+Expander" icon to unpack them.
+
+Move "Scripts" folder down into the "MPW_Shell Folder".
+
+Create a folder "Tools" inside the "MPW_Shell Folder" and move "Make",
+"PPCAsm", "MrC", "PPCLink" and "GetFileName" down into the "Tools"
+folder.
+
+Create a folder "Interfaces&Libraries" at the same level as the
+"MPW_Shell Folder". Put Put "RuntimeLibraries", "Libraries" into
+the "Interfaces&Libraries" folder. Inside the "Interfaces&Libraries" folder 
+create a new folder "Interfaces" and put "CInlcudes" into it.
+
+In summary, the manually moved files/folders should be located at
+
+	:MPW_Shell Folder:Tools:Make
+	:MPW_Shell Folder:Tools:PPCAsm
+	:MPW_Shell Folder:Tools:MrC
+	:MPW_Shell Folder:Tools:PPCLink
+	:MPW_Shell Folder:Tools:GetFileName
+	:Interfaces&Libraries:RuntimeLibraries:
+	:Interfaces&Libraries:Libraries:
+	:Interfaces&Libraries:Interfaces:CInlcudes:
+
+You can see the expected file structure in
+
+    ftp://ftp.apple.com/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./FileList.txt
+
+Follow the rest of the installation instructions in "About MPW etc.".
+
+
+
+CODEWARRIOR MPW INSTALLATION
+============================
+
+The CodeWarrior installer should install everything for you.
+
+The CodeWarrior compiler search for headers in the directory
+"MWCInclude" (located inside the "Interfaces" folder, inside the
+"Interfaces&Libraries" folder inside the "CodeWarrior MPW" folder, if
+it doesn't exist you have to create it)
+
+Copy the content of the following folders inside the "MWCInclude" folder:
+
+ - "CIncludes" (path: Metrowerks CodeWarrior: MacOS Support:
+   Universal: Interfaces: CIncludes)
+
+ - "Include" (path: Metrowerks CodeWarrior: MSL: MSL_C:
+   MSL_Common: Include)
+
+Copy the file "ansi_prefix.mac.h" inside the "MWCInclude" folder
+(path: Metrowerks CodeWarrior: MSL: MSL_C: MSL_MacOS: Include:
+ansi_prefix.mac.h)
+
+
+
+BUILD PROCESS
+=============
+
+The "macos" folder/directory should be inside the top directory in the
+GMP source tree and should contain four files
+
+        README          This file.
+        configure       Create files and directories needed.
+        unix2mac        Used to convert "configure" end-of-line chars.
+        Makefile.in     Source for the final "Makefile".
+
+Double click on the "MPW Shell" icon and set the directory using the
+"Directory" menu to the "$GMP_SOURCE_DIR:macos:" folder/directory.
+
+You run "configure" in a two step process
+
+        % perl unix2mac configure > configure.mac
+        % perl configure.mac
+  or    % perl configure.mac cw
+
+If you use CodeWarrior MPW you need to add the argument "cw" to the
+configure script. 
+
+Then run "Make"
+
+        % make
+     or % make -f Makefile.cw
+
+This will not execute the commands. It is like "make -n" on Unix, it
+will display the commands to execute. You select the commands and
+hit "enter" to actually execute the commands.
+
+To test the code you execute the output from
+
+        % Make check
+     or % make check -f Makefile.cw
+
+If there is an error the test program will complain. Note that the
+test programs can contain errors so a test failure doesn't always
+mean that the library is broken.
+
+To cleanup to the state before configure you execute the output from
+
+        % Make clean
+
+To remove the the resulting library as well you do
+
+        % Make distclean
+
+
+
+PROBLEMS
+========
+
+Bug reports should be sent directly to Kent Boortz <kent@swox.se> and
+*not* to "bug-gmp@gnu.org".
+
+There may be problems if the program you use for unpacking the source
+use automatic conversion of end-of-line characters.
+
+This port may be out of sync with minor GMP releases or patches.
+The MacOS build is very different from the Unix build process and
+for some changes in the Unix build the build process for MacOS has
+to be changed manually. Swox has no build or test machine for this
+port.
+
+The library uses stream I/O operations for some of the GMP functions
+and maybe for some error messages. This means that to link this
+library to form a normal Mac application you may get link problems,
+i.e. a Mac normally has no console/shell to write to.
+
+If you are unfamiliar with MPW note that the "return" key and the
+"enter" key mean different things to MPW.  The first just add a line
+break, the second send the line your pointer is at or the selection
+you have to the MPW command interpreter.
+
+If you mount the GMP source from a Unix netatalk server don't move or
+remove files from the Unix side while MPW is running. MPW cache
+information about what the file system looks like and gets very
+confused or crash.
+
+If you really need a MacOS m68k version of GMP let me know and we may
+take the time to do the port.
+
+
+Kent Boortz <kent@swox.se>
diff --git a/src/gmp/macos/configure b/src/gmp/macos/configure
new file mode 100755
index 000000000..b5c361259
--- /dev/null
+++ b/src/gmp/macos/configure
@@ -0,0 +1,454 @@
+# This is a simple configure script for MacOS and MPW.
+# Note that this script can't be run directly from MPW perl
+# because it has the wrong end-of-line characters. See README.
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+# ***************************** NOTE **************************************
+# This script try to figure out things about this release but has a hard
+# time doing it. It reads some lines in "configure", "Makefile.am" and
+# "mp*/Makefile.am" and try to guess things. With every new release
+# this script has to be tested.
+# ***************************** NOTE **************************************
+
+use strict;
+
+###########################################################################
+#
+#  Platform dependent
+#
+###########################################################################
+
+$/ = "\012"			# Input files use Unix end-of-line chars
+  if $^O eq 'MacOS';
+
+###########################################################################
+#
+#  Constants
+#
+###########################################################################
+
+# Directories to create
+
+my @dirs =
+  (
+   'MpfObj',
+   'MpnObj',
+   'MpqObj',
+   'MpzObj',
+   'CmnObj',
+   'AsmObj',
+   'Asm',
+   'MpfBin',
+   'MpqBin',
+   'MpzBin',
+  );
+
+my $cfg;			# Will point to %cfg_apple or %cfg_cw
+
+my %cfg_apple =
+  (
+   'cc'          =>  'MrC',
+   'coptions'    => ['-ansi on -i : -i :: -i ::mpn:powerpc32 -i ::mpz',
+		     '-opt speed -inline on -d random=rand -d srandom=srand'],
+   'link'        => 'PPCLink',
+   'linkoptions' => '-sym on -xm library',
+   'tooloptions' => "-t 'MPST' -c 'MPS'",
+   'asm'         => 'PPCAsm',
+   'aoptions'    => '-sym on',
+   'syslibs'     => [
+		     '"{SharedLibraries}"StdCLib',
+		     '"{SharedLibraries}"InterfaceLib',
+		     '"{SharedLibraries}"MathLib',
+		     '"{PPCLibraries}"StdCRuntime.o',
+		     '"{PPCLibraries}"PPCCRuntime.o',
+		    ],
+  );
+
+my %cfg_cw =
+  (
+   'cc'          =>  'MWCPPC',
+   'coptions'    => [
+		     '-opt all -w nounusedvar,noextended',
+		     '-i :: -i ::mpn:powerpc32 -i ::mpz',
+		     '-sym full -d random=rand -d srandom=srand',
+		    ],
+   'link'        => 'MWLinkPPC',
+   'linkoptions' => '-sym fullpath -library',
+   'tooloptions' => '-mpwtool',
+   'asm'         => 'PPCAsm',
+   'aoptions'    => '-sym on',
+   'syslibs'     => [
+		     '"{SharedLibraries}"InterfaceLib',
+		     '"{MWPPCLibraries}MSL MPWCRuntime.Lib"',
+		     '"{MWPPCLibraries}MSL C.PPC MPW(NL).Lib"',
+		     '"{SharedLibraries}"MathLib',
+		    ],
+  );
+
+
+my $make_in      = 'Makefile.in';
+my $make         = 'Makefile';
+my $configure    = mf("../configure");
+my $configure_in = mf("../configure.in");
+my $config_in    = mf("../config.in");
+my $mpn_asm_dir  = "../mpn/powerpc32";
+my $mpn_gen_dir  = "../mpn/generic";
+my $config_h     = 'config.h';
+
+my $asm_start    = "\ttoc";	# No dot, like ".dot"?
+
+###########################################################################
+#
+#  Read command line
+#
+###########################################################################
+
+$cfg = \%cfg_apple;		# Default
+
+if (@ARGV and $ARGV[0] =~ /^cw|co/) {
+  $cfg = \%cfg_cw;
+  $make .= '.cw';
+}
+
+###########################################################################
+#
+#  Parse top configure file for mpn files
+#
+###########################################################################
+
+my ($files,$optional,$package,$version) = parse_top_configure($configure);
+my %mpn_objects = map {$_ => 1} (@$files,@$optional);
+my %mpn_optional = map {$_ => 1} @$optional;
+
+###########################################################################
+#
+#  Create config.h from ../config.in
+#
+###########################################################################
+
+my @asm_files;
+
+open(CONFIG_IN, $config_in)
+  or die "Can't open \"$config_in\"\n";
+open(CONFIG_H, ">$config_h")
+  or die "Can't create \"$config_h\"\n";
+
+while (<CONFIG_IN>) {
+  chomp;
+
+  if (/^\s*#\s*undef\s+HAVE_NATIVE_mpn_(\w+)/ and
+      -r mf("$mpn_asm_dir/$1.asm")) {
+
+    if (defined delete $mpn_objects{$1}) {
+      push(@asm_files, $1);
+      print CONFIG_H "\#define HAVE_NATIVE_mpn_$1 1\n";
+    } else {
+      print STDERR "Warning: Found asm file \"$1\" but no corresponding C file - ignoring\n";
+    }
+
+  } elsif (/^\s*#\s*undef\s+PACKAGE/) {
+    print CONFIG_H "\#define PACKAGE \"$package\"\n";
+  } elsif (/^\s*#\s*undef\s+VERSION/) {
+    print CONFIG_H "\#define VERSION \"$version\"\n";
+  } elsif (/^\s*#\s*undef\s+STDC_HEADERS/) {
+    print CONFIG_H "\#define STDC_HEADERS 1\n";
+  } else {			# Blank line, leave it
+    print CONFIG_H "$_\n";
+  }
+}
+
+close CONFIG_H;
+close CONFIG_IN;
+
+###########################################################################
+#
+#  Create directories
+#
+###########################################################################
+
+foreach (@dirs) {
+  -d $_ or mkdir $_, 0775
+    or die "Can't create directory \"$_\"\n";
+}
+
+###########################################################################
+#
+#  Parse the *.asm files found and convert them to MPW format
+#
+###########################################################################
+
+my $file;
+
+foreach $file (@asm_files) {
+  my $ifile = mf("$mpn_asm_dir/$file.asm");
+  my $ofile = mf("Asm/$file.s");
+
+  open(ASM, $ifile)
+    or die "Can't read file \"$ifile\"\n";
+  open(NEW, ">$ofile")
+    or die "Can't create file \"$ofile\"\n";
+
+  while (<ASM>) {
+    chomp;			# Remove whatever ending it was
+
+    s/\bdnl\b/;/ or s/\bC\b/;/;	# Use ; comments
+
+    s/include\s*\(.*?\)//;	# Don't use include macro
+
+    s/ASM_START\s*\(.*?\)/$asm_start/;
+
+    s/PROLOGUE\s*\(\s*(.*?)\s*\)/asm_prologue($1)/e;
+
+    s/EPILOGUE\s*\(\s*(.*?)\s*\)/asm_epilogue($1)/e;
+
+    s/\n/\x0D/g;
+    print NEW "$_\x0D";		# Use MacOS end-of-line character
+  }
+  
+  close ASM;
+  close NEW;
+}
+
+
+###########################################################################
+#
+#  Parse the Makefile.in and produce the Makefile
+#
+###########################################################################
+
+# Check if we have optional left in C directory
+
+foreach (keys %mpn_objects) {
+  delete $mpn_objects{$_}
+    if $mpn_optional{$_} and !-r mf("$mpn_gen_dir/$_.c");
+}
+
+my $mpn_objects = join(' ', map {"{MpnObjDir}$_.o"}  sort keys %mpn_objects);
+$mpn_objects =~ s/(.{1,66})\s/$1 \xB6\x0D\t/g;
+
+my @asm_objects = @asm_files;
+my @asm_sources = @asm_files;
+
+# Adjust configuration
+
+foreach (keys %{$cfg}) {
+  $$cfg{$_} = join(" \xB6\x0D\t\t", @{$$cfg{$_}})
+    if ref $$cfg{$_};
+}
+
+my %config =
+  (
+   'version' => $version,
+   'package' => $package,
+   'c'       => "\xB6",
+   'dep'     => "\xC4",
+   'wildcard'=> "\xC5",
+   'asm_objects' =>
+   	join(" \xB6\x0D\t",map {$_ = "{AsmObjDir}$_.o"} sort @asm_objects),
+   'asm_sources' =>
+   	join(" \xB6\x0D\t",map {$_ = "{AsmSrcDir}$_.s"} sort @asm_sources),
+   'mpn_objects' => $mpn_objects,
+   'mpz_objects' => what_objects("mpz","../mpz","{MpzObjDir}"),
+   'mpf_objects' => what_objects("mpf","../mpf","{MpfObjDir}"),
+   'mpq_objects' => what_objects("mpq","../mpq","{MpqObjDir}"),
+   'gmp_objects' => what_objects("gmp","..",    "{CmnObjDir}"),
+   %{$cfg},
+  );
+
+
+open(IN, $make_in)
+  or die "Can't read file \"$make_in\"\n";
+open(OUT, ">$make")
+  or die "Can't create file \"$make\"\n";
+
+while (<IN>) {
+  chomp;			# Remove whatever ending it was
+
+  # Do the variable substitution
+
+  s/\@([^\@]+)\@/exists $config{$1} ? $config{$1} : ''/ge;
+
+  print OUT "$_\x0D";		# Use MacOS end-of-line character
+}
+  
+close IN;
+close OUT;
+
+###########################################################################
+#
+#  Parse the configure.in file to find the mpn files to compile and link
+#  Find package name and version
+#
+###########################################################################
+
+sub parse_top_configure {
+  my $cfg = shift;
+
+  open(CONFIGURE, $cfg)
+    or die "Can't open \"$cfg\"\n";
+  my $old_eol = $/;
+  undef $/;
+  my $text = <CONFIGURE>;
+  $/ = $old_eol;
+  close CONFIGURE;
+
+  my ($package) = $text =~ /(?:\n|\r)PACKAGE\s*=\s*(\S+)/;
+  my ($version) = $text =~ /(?:\n|\r)VERSION\s*=\s*(\S+)/;
+
+  my $files = join(' ',$text =~ /(?:\n|\r)gmp_mpn_functions\s*=\s*\"([^\"]+)/);
+  $files =~ s/\\/ /g;
+  $files =~ s/\$\{?\w*\}?//g;
+  my @files = sort split(' ',$files);
+
+  $files = join(' ',$text =~ /(?:\n|\r)gmp_mpn_functions_optional\s*=\s*\"([^\"]+)/);
+  $files =~ s/\\/ /g;
+  $files =~ s/\$\{?\w*\}?//g;
+  my @optional = sort split(' ',$files);
+
+  @files > 30 or die "Can't find mpn files in \"$cfg\"\n";
+  defined $package or die "Can't find package name in \"$cfg\"\n";
+  defined $version or die "Can't find version name in \"$cfg\"\n";
+  return (\@files,\@optional,$package,$version);
+}
+
+###########################################################################
+#
+#  Find the C files for mpz, mpf .....
+#
+###########################################################################
+
+sub what_objects {
+  my $part   = shift;
+  my $srcdir = shift;
+  my $dstdir = shift;
+
+  my $makefile_am = mf("$srcdir/Makefile.am");
+
+  # We look in the Makefile.am file
+  open(MAKEFILE_AM, $makefile_am)
+    or die "Can't open file \"$makefile_am\"\n";
+
+  # I had as short version of this using more advanced
+  # regular expressions on the whole file content but
+  # MacPerl freezes my Mac every time..... :-(
+
+  my $line;
+  my $text = '';
+
+  while (defined($line = <MAKEFILE_AM>) ) {
+    chomp $line;
+
+    if ($line =~ s/^lib${part}_la_SOURCES\s*=//) {
+      do {
+	chomp $line;
+	if ($line =~ s/\\\s*$//) {
+	  $text .= " $line";
+	} else {
+	  $text .= " $line";
+	  next;
+	}
+      } while (defined($line = <MAKEFILE_AM>));
+    }
+
+    if ($line =~ s/^nodist_lib${part}_la_SOURCES\s*=//) {
+      do {
+	chomp $line;
+	if ($line =~ s/\\\s*$//) {
+	  $text .= " $line";
+	} else {
+	  $text .= " $line";
+	  last;
+	}
+      } while (defined($line = <MAKEFILE_AM>));
+    }
+  }
+  close MAKEFILE_AM;
+
+  my @ofiles = split(' ',$text);
+  @ofiles > 10 or die "Can't find $part files in \"$makefile_am\"\n";
+  my $ofiles = join(' ', map {/^(.+)\.c$/ and $_ = "$dstdir$1.o"} @ofiles);
+  $ofiles =~ s/(.{1,66})\s/$1 \xB6\x0D\t/g;
+
+  return $ofiles;
+}
+
+###########################################################################
+#
+#  Assembler
+#
+###########################################################################
+
+sub asm_epilogue {
+    my $func = shift;
+    return "\tcsect .__g$func\[pr]";
+}
+
+sub asm_prologue {
+    my $func = shift;
+
+    my $asm = <<HERE;
+	EXPORT __g$func\[DS]
+	EXPORT .__g$func\[PR]
+
+	TC __g$func\[TC], __g$func\[DS]
+			
+	CSECT __g$func\[DS]
+	DC.L .__g$func\[PR]
+	DC.L TOC[tc0]
+		
+	CSECT .__g$func\[PR]
+	FUNCTION .__g$func\[PR]	
+HERE
+    return $asm;
+}
+
+
+###########################################################################
+#
+#  Platform dependent filename conversion
+#
+###########################################################################
+
+sub mf {
+  my $path = shift;
+
+  return $path unless $^O eq 'MacOS';
+
+  $path =~ /:/ and die "File name already converted to mac format: $path\n";
+
+  if ($path =~ s&^/&&) {
+    # Absolute path
+    unless ($path =~ s&/&:&g) {
+      # This is a drive name
+      $path .= ':';
+    }
+  } else {
+    # Relative path
+    if ($path =~ s&/&:&g) {
+      # Contains slash
+      $path = ":$path";
+      $path =~ s&\.\.:&:&g;
+    } else {
+      # Plain file name, no directory part
+    }
+  }
+  return $path;
+}
diff --git a/src/gmp/macos/unix2mac b/src/gmp/macos/unix2mac
new file mode 100644
index 000000000..672f619ab
--- /dev/null
+++ b/src/gmp/macos/unix2mac
@@ -0,0 +1 @@
+$/="\r"; while(<>) {chomp; print "$_\n";};
\ No newline at end of file
diff --git a/src/gmp/mdate-sh b/src/gmp/mdate-sh
new file mode 100755
index 000000000..37171f21f
--- /dev/null
+++ b/src/gmp/mdate-sh
@@ -0,0 +1,92 @@
+#!/bin/sh
+# Get modification time of a file or directory and pretty-print it.
+# Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+# written by Ulrich Drepper <drepper@gnu.ai.mit.edu>, June 1995
+#
+# 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.
+
+# Prevent date giving response in another language.
+LANG=C
+export LANG
+LC_ALL=C
+export LC_ALL
+LC_TIME=C
+export LC_TIME
+
+# Get the extended ls output of the file or directory.
+# On HPUX /bin/sh, "set" interprets "-rw-r--r--" as options, so the "x" below.
+if ls -L /dev/null 1>/dev/null 2>&1; then
+  set - x`ls -L -l -d $1`
+else
+  set - x`ls -l -d $1`
+fi
+# The month is at least the fourth argument
+# (3 shifts here, the next inside the loop).
+shift
+shift
+shift
+
+# Find the month.  Next argument is day, followed by the year or time.
+month=
+until test $month
+do
+  shift
+  case $1 in
+    Jan) month=January; nummonth=1;;
+    Feb) month=February; nummonth=2;;
+    Mar) month=March; nummonth=3;;
+    Apr) month=April; nummonth=4;;
+    May) month=May; nummonth=5;;
+    Jun) month=June; nummonth=6;;
+    Jul) month=July; nummonth=7;;
+    Aug) month=August; nummonth=8;;
+    Sep) month=September; nummonth=9;;
+    Oct) month=October; nummonth=10;;
+    Nov) month=November; nummonth=11;;
+    Dec) month=December; nummonth=12;;
+  esac
+done
+
+day=$2
+
+# Here we have to deal with the problem that the ls output gives either
+# the time of day or the year.
+case $3 in
+  *:*) set `date`; eval year=\$$#
+       case $2 in
+	 Jan) nummonthtod=1;;
+	 Feb) nummonthtod=2;;
+	 Mar) nummonthtod=3;;
+	 Apr) nummonthtod=4;;
+	 May) nummonthtod=5;;
+	 Jun) nummonthtod=6;;
+	 Jul) nummonthtod=7;;
+	 Aug) nummonthtod=8;;
+	 Sep) nummonthtod=9;;
+	 Oct) nummonthtod=10;;
+	 Nov) nummonthtod=11;;
+	 Dec) nummonthtod=12;;
+       esac
+       # For the first six month of the year the time notation can also
+       # be used for files modified in the last year.
+       if (expr $nummonth \> $nummonthtod) > /dev/null;
+       then
+	 year=`expr $year - 1`
+       fi;;
+  *) year=$3;;
+esac
+
+# The result.
+echo $day $month $year
diff --git a/src/gmp/memory.c b/src/gmp/memory.c
new file mode 100644
index 000000000..9df440ce2
--- /dev/null
+++ b/src/gmp/memory.c
@@ -0,0 +1,160 @@
+/* Memory allocation routines.
+
+Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h> /* for malloc, realloc, free */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#ifdef __NeXT__
+#define static
+#endif
+
+
+void *	(*_mp_allocate_func) _PROTO ((size_t)) = _mp_default_allocate;
+void *	(*_mp_reallocate_func) _PROTO ((void *, size_t, size_t))
+     = _mp_default_reallocate;
+void	(*_mp_free_func) _PROTO ((void *, size_t)) = _mp_default_free;
+
+
+/* Default allocation functions.  In case of failure to allocate/reallocate
+   an error message is written to stderr and the program aborts.  */
+
+void *
+#if __STDC__
+_mp_default_allocate (size_t size)
+#else
+_mp_default_allocate (size)
+     size_t size;
+#endif
+{
+  void *ret;
+#ifdef DEBUG
+  size_t req_size = size;
+  size += 2 * BYTES_PER_MP_LIMB;
+#endif
+  ret = malloc (size);
+  if (ret == 0)
+    {
+      perror ("cannot allocate in gmp");
+      abort ();
+    }
+  
+#ifdef DEBUG
+  {
+    mp_ptr p = ret;
+    p++;
+    p[-1] = (0xdeadbeef << 31) + 0xdeafdeed;
+    if (req_size % BYTES_PER_MP_LIMB == 0)
+      p[req_size / BYTES_PER_MP_LIMB] = ~((0xdeadbeef << 31) + 0xdeafdeed);
+    ret = p;
+  }
+#endif
+  return ret;
+}
+
+void *
+#if __STDC__
+_mp_default_reallocate (void *oldptr, size_t old_size, size_t new_size)
+#else
+_mp_default_reallocate (oldptr, old_size, new_size)
+     void *oldptr;
+     size_t old_size;
+     size_t new_size;
+#endif
+{
+  void *ret;
+
+#ifdef DEBUG
+  size_t req_size = new_size;
+
+  if (old_size != 0)
+    {
+      mp_ptr p = oldptr;
+      if (p[-1] != (0xdeadbeef << 31) + 0xdeafdeed)
+	{
+	  fprintf (stderr, "gmp: (realloc) data clobbered before allocation block\n");
+	  abort ();
+	}
+      if (old_size % BYTES_PER_MP_LIMB == 0)
+	if (p[old_size / BYTES_PER_MP_LIMB] != ~((0xdeadbeef << 31) + 0xdeafdeed))
+	  {
+	    fprintf (stderr, "gmp: (realloc) data clobbered after allocation block\n");
+	    abort ();
+	  }
+      oldptr = p - 1;
+    }
+
+  new_size += 2 * BYTES_PER_MP_LIMB;
+#endif
+
+  ret = realloc (oldptr, new_size);
+  if (ret == 0)
+    {
+      perror ("cannot allocate in gmp");
+      abort ();
+    }
+
+#ifdef DEBUG
+  {
+    mp_ptr p = ret;
+    p++;
+    p[-1] = (0xdeadbeef << 31) + 0xdeafdeed;
+    if (req_size % BYTES_PER_MP_LIMB == 0)
+      p[req_size / BYTES_PER_MP_LIMB] = ~((0xdeadbeef << 31) + 0xdeafdeed);
+    ret = p;
+  }
+#endif
+  return ret;
+}
+
+void
+#if __STDC__
+_mp_default_free (void *blk_ptr, size_t blk_size)
+#else
+_mp_default_free (blk_ptr, blk_size)
+     void *blk_ptr;
+     size_t blk_size;
+#endif
+{
+#ifdef DEBUG
+  {
+    mp_ptr p = blk_ptr;
+    if (blk_size != 0)
+      {
+	if (p[-1] != (0xdeadbeef << 31) + 0xdeafdeed)
+	  {
+	    fprintf (stderr, "gmp: (free) data clobbered before allocation block\n");
+	    abort ();
+	  }
+	if (blk_size % BYTES_PER_MP_LIMB == 0)
+	  if (p[blk_size / BYTES_PER_MP_LIMB] != ~((0xdeadbeef << 31) + 0xdeafdeed))
+	    {
+	      fprintf (stderr, "gmp: (free) data clobbered after allocation block\n");
+	      abort ();
+	    }
+      }
+    blk_ptr = p - 1;
+  }
+#endif
+  free (blk_ptr);
+}
diff --git a/src/gmp/missing b/src/gmp/missing
new file mode 100755
index 000000000..c60e9d772
--- /dev/null
+++ b/src/gmp/missing
@@ -0,0 +1,244 @@
+#! /bin/sh
+# Common stub for a few missing GNU programs while installing.
+# Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc.
+# Originally by Fran,cois 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
+
+run=:
+
+case "$1" in
+--run)
+  # Try to run requested program, and just exit if it succeeds.
+  run=
+  shift
+  "$@" && exit 0
+  ;;
+esac
+
+# If it does not exist, or fails to run (possibly an outdated version),
+# try to emulate it.
+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
+  --run           try to run the given command, and emulate it if it fails
+
+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
+  tar          try tar, gnutar, gtar, then tar without non-portable flags
+  yacc         create \`y.tab.[ch]', if possible, from existing .[ch]"
+    ;;
+
+  -v|--v|--ve|--ver|--vers|--versi|--versio|--version)
+    echo "missing 0.2 - GNU automake"
+    ;;
+
+  -*)
+    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`
+    test -z "$files" && files="config.h"
+    touch_files=
+    for f in $files; do
+      case "$f" in
+      *:*) touch_files="$touch_files "`echo "$f" |
+				       sed -e 's/^[^:]*://' -e 's/:.*//'`;;
+      *) touch_files="$touch_files $f.in";;
+      esac
+    done
+    touch $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$/.in/' |
+	   while read f; do touch "$f"; done
+    ;;
+
+  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
+    ;;
+
+  tar)
+    shift
+    if test -n "$run"; then
+      echo 1>&2 "ERROR: \`tar' requires --run"
+      exit 1
+    fi
+
+    # We have already tried tar in the generic part.
+    # Look for gnutar/gtar before invocation to avoid ugly error
+    # messages.
+    if (gnutar --version > /dev/null 2>&1); then
+       gnutar ${1+"$@"} && exit 0
+    fi
+    if (gtar --version > /dev/null 2>&1); then
+       gtar ${1+"$@"} && exit 0
+    fi
+    firstarg="$1"
+    if shift; then
+	case "$firstarg" in
+	*o*)
+	    firstarg=`echo "$firstarg" | sed s/o//`
+	    tar "$firstarg" ${1+"$@"} && exit 0
+	    ;;
+	esac
+	case "$firstarg" in
+	*h*)
+	    firstarg=`echo "$firstarg" | sed s/h//`
+	    tar "$firstarg" ${1+"$@"} && exit 0
+	    ;;
+	esac
+    fi
+
+    echo 1>&2 "\
+WARNING: I can't seem to be able to run \`tar' with the given arguments.
+         You may want to install GNU tar or Free paxutils, or check the
+         command line arguments."
+    exit 1
+    ;;
+
+  *)
+    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/src/gmp/mkinstalldirs b/src/gmp/mkinstalldirs
new file mode 100755
index 000000000..6b3b5fc5d
--- /dev/null
+++ b/src/gmp/mkinstalldirs
@@ -0,0 +1,40 @@
+#! /bin/sh
+# mkinstalldirs --- make directory hierarchy
+# Author: Noah Friedman <friedman@prep.ai.mit.edu>
+# Created: 1993-05-16
+# Public domain
+
+# $Id$
+
+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"
+
+        mkdir "$pathcomp" || lasterr=$?
+
+        if test ! -d "$pathcomp"; then
+  	  errstatus=$lasterr
+        fi
+     fi
+
+     pathcomp="$pathcomp/"
+   done
+done
+
+exit $errstatus
+
+# mkinstalldirs ends here
diff --git a/src/gmp/mp.h b/src/gmp/mp.h
new file mode 100644
index 000000000..774e6e567
--- /dev/null
+++ b/src/gmp/mp.h
@@ -0,0 +1,123 @@
+/* mp.h -- Definitions for Berkeley compatible multiple precision functions.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#ifndef __MP_H__
+
+#ifndef __GNU_MP__		/* to allow inclusion of both gmp.h and mp.h */
+#define __GNU_MP__ 3
+#define __need_size_t
+#include <stddef.h>
+#undef __need_size_t
+
+#if defined (__STDC__) || defined (__cplusplus)
+#define __gmp_const const
+#else
+#define __gmp_const
+#endif
+
+#if defined (__GNUC__)
+#define __gmp_inline __inline__
+#else
+#define __gmp_inline
+#endif
+
+#ifndef _EXTERN_INLINE
+#ifdef __GNUC__
+#define _EXTERN_INLINE extern __inline__
+#else
+#define _EXTERN_INLINE static
+#endif
+#endif
+
+#ifdef _SHORT_LIMB
+typedef unsigned int		mp_limb_t;
+typedef int			mp_limb_signed_t;
+#else
+#ifdef _LONG_LONG_LIMB
+typedef unsigned long long int	mp_limb_t;
+typedef long long int		mp_limb_signed_t;
+#else
+typedef unsigned long int	mp_limb_t;
+typedef long int		mp_limb_signed_t;
+#endif
+#endif
+
+typedef mp_limb_t *		mp_ptr;
+typedef __gmp_const mp_limb_t *	mp_srcptr;
+typedef int			mp_size_t;
+typedef long int		mp_exp_t;
+
+typedef struct
+{
+  int _mp_alloc;		/* Number of *limbs* allocated and pointed
+				   to by the D field.  */
+  int _mp_size;			/* abs(SIZE) is the number of limbs
+				   the last field points to.  If SIZE
+				   is negative this is a negative
+				   number.  */
+  mp_limb_t *_mp_d;		/* Pointer to the limbs.  */
+} __mpz_struct;
+#endif /* __GNU_MP__ */
+
+/* User-visible types.  */
+typedef __mpz_struct MINT;
+
+
+#ifndef _PROTO
+#if (__STDC__-0) || defined (__cplusplus)
+#define _PROTO(x) x
+#else
+#define _PROTO(x) ()
+#endif
+#endif
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+
+void mp_set_memory_functions _PROTO ((void *(*) (size_t),
+                                      void *(*) (void *, size_t, size_t),
+                                      void (*) (void *, size_t)));
+MINT *itom _PROTO ((signed short int));
+MINT *xtom _PROTO ((const char *));
+void move _PROTO ((const MINT *, MINT *));
+void madd _PROTO ((const MINT *, const MINT *, MINT *));
+void msub _PROTO ((const MINT *, const MINT *, MINT *));
+void mult _PROTO ((const MINT *, const MINT *, MINT *));
+void mdiv _PROTO ((const MINT *, const MINT *, MINT *, MINT *));
+void sdiv _PROTO ((const MINT *, signed short int, MINT *, signed short int *));
+void msqrt _PROTO ((const MINT *, MINT *, MINT *));
+void pow _PROTO ((const MINT *, const MINT *, const MINT *, MINT *));
+void rpow _PROTO ((const MINT *, signed short int, MINT *));
+void gcd _PROTO ((const MINT *, const MINT *, MINT *));
+int mcmp _PROTO ((const MINT *, const MINT *));
+void min _PROTO ((MINT *));
+void mout _PROTO ((const MINT *));
+char *mtox _PROTO ((const MINT *));
+void mfree _PROTO ((MINT *));
+
+#if defined (__cplusplus)
+}
+#endif
+
+#define __MP_H__
+#endif /* __MP_H__ */
diff --git a/src/gmp/mp_bpl.c b/src/gmp/mp_bpl.c
new file mode 100644
index 000000000..df8b03e5a
--- /dev/null
+++ b/src/gmp/mp_bpl.c
@@ -0,0 +1,27 @@
+/*
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+const int mp_bits_per_limb = BITS_PER_MP_LIMB;
+const int __gmp_0 = 0;
+int __gmp_junk;
diff --git a/src/gmp/mp_clz_tab.c b/src/gmp/mp_clz_tab.c
new file mode 100644
index 000000000..1bbd1d6a6
--- /dev/null
+++ b/src/gmp/mp_clz_tab.c
@@ -0,0 +1,36 @@
+/* __clz_tab -- support for longlong.h
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+const
+unsigned char __clz_tab[] =
+{
+  0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
+  6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
+  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
+  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
+  8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+  8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+  8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+  8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
+};
diff --git a/src/gmp/mp_minv_tab.c b/src/gmp/mp_minv_tab.c
new file mode 100644
index 000000000..4afff85cf
--- /dev/null
+++ b/src/gmp/mp_minv_tab.c
@@ -0,0 +1,50 @@
+/* A table of data supporting modlimb_invert().
+
+   THE CONTENTS OF THIS FILE ARE FOR INTERNAL USE AND MAY CHANGE
+   INCOMPATIBLY OR DISAPPEAR IN A FUTURE GNU MP RELEASE.  */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.  */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+/* modlimb_invert_table[i] is the multiplicative inverse of 2*i+1 mod 256,
+   ie. (modlimb_invert_table[i] * (2*i+1)) % 256 == 1 */
+
+const unsigned char  modlimb_invert_table[128] = {
+  0x01, 0xAB, 0xCD, 0xB7, 0x39, 0xA3, 0xC5, 0xEF,
+  0xF1, 0x1B, 0x3D, 0xA7, 0x29, 0x13, 0x35, 0xDF,
+  0xE1, 0x8B, 0xAD, 0x97, 0x19, 0x83, 0xA5, 0xCF,
+  0xD1, 0xFB, 0x1D, 0x87, 0x09, 0xF3, 0x15, 0xBF,
+  0xC1, 0x6B, 0x8D, 0x77, 0xF9, 0x63, 0x85, 0xAF,
+  0xB1, 0xDB, 0xFD, 0x67, 0xE9, 0xD3, 0xF5, 0x9F,
+  0xA1, 0x4B, 0x6D, 0x57, 0xD9, 0x43, 0x65, 0x8F,
+  0x91, 0xBB, 0xDD, 0x47, 0xC9, 0xB3, 0xD5, 0x7F,
+  0x81, 0x2B, 0x4D, 0x37, 0xB9, 0x23, 0x45, 0x6F,
+  0x71, 0x9B, 0xBD, 0x27, 0xA9, 0x93, 0xB5, 0x5F,
+  0x61, 0x0B, 0x2D, 0x17, 0x99, 0x03, 0x25, 0x4F,
+  0x51, 0x7B, 0x9D, 0x07, 0x89, 0x73, 0x95, 0x3F,
+  0x41, 0xEB, 0x0D, 0xF7, 0x79, 0xE3, 0x05, 0x2F,
+  0x31, 0x5B, 0x7D, 0xE7, 0x69, 0x53, 0x75, 0x1F,
+  0x21, 0xCB, 0xED, 0xD7, 0x59, 0xC3, 0xE5, 0x0F,
+  0x11, 0x3B, 0x5D, 0xC7, 0x49, 0x33, 0x55, 0xFF
+};
diff --git a/src/gmp/mp_set_fns.c b/src/gmp/mp_set_fns.c
new file mode 100644
index 000000000..55d4d9d6e
--- /dev/null
+++ b/src/gmp/mp_set_fns.c
@@ -0,0 +1,48 @@
+/* mp_set_memory_functions -- Set the allocate, reallocate, and free functions
+   for use by the mp package.
+
+Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mp_set_memory_functions (void *(*alloc_func) (size_t),
+			 void *(*realloc_func) (void *, size_t, size_t),
+			 void (*free_func) (void *, size_t))
+#else
+mp_set_memory_functions (alloc_func, realloc_func, free_func)
+     void *(*alloc_func) ();
+     void *(*realloc_func) ();
+     void (*free_func) ();
+#endif
+{
+  if (alloc_func == 0)
+    alloc_func = _mp_default_allocate;
+  if (realloc_func == 0)
+    realloc_func = _mp_default_reallocate;
+  if (free_func == 0)
+    free_func = _mp_default_free;
+
+  _mp_allocate_func = alloc_func;
+  _mp_reallocate_func = realloc_func;
+  _mp_free_func = free_func;
+}
diff --git a/src/gmp/mpbsd/Makefile.am b/src/gmp/mpbsd/Makefile.am
new file mode 100644
index 000000000..afedfbf12
--- /dev/null
+++ b/src/gmp/mpbsd/Makefile.am
@@ -0,0 +1,71 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+
+INCLUDES = -DBERKELEY_MP -D__gmpz_realloc=_mp_realloc -I$(top_srcdir)
+
+nodist_libmpbsd_la_SOURCES = \
+	add.c cmp.c gcd.c mul.c pow_ui.c powm.c realloc.c sqrtrem.c sub.c \
+	tdiv_qr.c
+libmpbsd_la_SOURCES = \
+	itom.c mfree.c min.c mout.c move.c mtox.c sdiv.c xtom.c
+
+if WANT_MPBSD
+noinst_LTLIBRARIES = libmpbsd.la
+endif
+
+CLEANFILES = $(nodist_libmpbsd_la_SOURCES)
+
+
+add.c: $(top_srcdir)/mpz/add.c
+	cp $(top_srcdir)/mpz/add.c add.c
+
+cmp.c: $(top_srcdir)/mpz/cmp.c
+	cp $(top_srcdir)/mpz/cmp.c cmp.c
+
+gcd.c: $(top_srcdir)/mpz/gcd.c
+	cp $(top_srcdir)/mpz/gcd.c gcd.c
+
+mul.c: $(top_srcdir)/mpz/mul.c
+	cp $(top_srcdir)/mpz/mul.c mul.c
+
+pow_ui.c: $(top_srcdir)/mpz/pow_ui.c
+	cp $(top_srcdir)/mpz/pow_ui.c pow_ui.c
+
+powm.c: $(top_srcdir)/mpz/powm.c
+	cp $(top_srcdir)/mpz/powm.c powm.c
+
+realloc.c: $(top_srcdir)/mpz/realloc.c
+	cp $(top_srcdir)/mpz/realloc.c realloc.c
+
+sqrtrem.c: $(top_srcdir)/mpz/sqrtrem.c
+	cp $(top_srcdir)/mpz/sqrtrem.c sqrtrem.c
+
+sub.c: $(top_srcdir)/mpz/sub.c
+	cp $(top_srcdir)/mpz/sub.c sub.c
+
+tdiv_qr.c: $(top_srcdir)/mpz/tdiv_qr.c
+	cp $(top_srcdir)/mpz/tdiv_qr.c tdiv_qr.c
diff --git a/src/gmp/mpbsd/Makefile.in b/src/gmp/mpbsd/Makefile.in
new file mode 100644
index 000000000..b7a6af59f
--- /dev/null
+++ b/src/gmp/mpbsd/Makefile.in
@@ -0,0 +1,451 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+INCLUDES = -DBERKELEY_MP -D__gmpz_realloc=_mp_realloc -I$(top_srcdir)
+
+nodist_libmpbsd_la_SOURCES = \
+	add.c cmp.c gcd.c mul.c pow_ui.c powm.c realloc.c sqrtrem.c sub.c \
+	tdiv_qr.c
+
+libmpbsd_la_SOURCES = \
+	itom.c mfree.c min.c mout.c move.c mtox.c sdiv.c xtom.c
+
+
+@WANT_MPBSD_TRUE@noinst_LTLIBRARIES = @WANT_MPBSD_TRUE@libmpbsd.la
+
+CLEANFILES = $(nodist_libmpbsd_la_SOURCES)
+subdir = mpbsd
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES = 
+LTLIBRARIES =  $(noinst_LTLIBRARIES)
+
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+libmpbsd_la_LDFLAGS = 
+libmpbsd_la_LIBADD = 
+am_libmpbsd_la_OBJECTS =  itom.lo mfree.lo min.lo mout.lo move.lo \
+mtox.lo sdiv.lo xtom.lo
+nodist_libmpbsd_la_OBJECTS =  add.lo cmp.lo gcd.lo mul.lo pow_ui.lo \
+powm.lo realloc.lo sqrtrem.lo sub.lo tdiv_qr.lo
+libmpbsd_la_OBJECTS =  $(am_libmpbsd_la_OBJECTS) \
+$(nodist_libmpbsd_la_OBJECTS)
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(libmpbsd_la_SOURCES)
+DIST_COMMON =  Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(libmpbsd_la_SOURCES) $(nodist_libmpbsd_la_SOURCES)
+OBJECTS = $(am_libmpbsd_la_OBJECTS) $(nodist_libmpbsd_la_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpbsd/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-noinstLTLIBRARIES:
+
+clean-noinstLTLIBRARIES:
+	-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
+
+distclean-noinstLTLIBRARIES:
+
+maintainer-clean-noinstLTLIBRARIES:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+
+libmpbsd.la: $(libmpbsd_la_OBJECTS) $(libmpbsd_la_DEPENDENCIES)
+	$(LINK)  $(libmpbsd_la_LDFLAGS) $(libmpbsd_la_OBJECTS) $(libmpbsd_la_LIBADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+
+# 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.
+
+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; \
+	dot_seen=no; \
+	target=`echo $@ | sed s/-recursive//`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    dot_seen=yes; \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+	done; \
+	if test "$$dot_seen" = "no"; then \
+	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+	fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+	@set fnord $(MAKEFLAGS); amf=$$2; \
+	dot_seen=no; \
+	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
+	  rev="$$subdir $$rev"; \
+	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
+	done; \
+	test "$$dot_seen" = "no" && rev=". $$rev"; \
+	target=`echo $@ | sed s/-recursive//`; \
+	for subdir in $$rev; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_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 \
+	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+	done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+   if test "$$subdir" = .; then :; else \
+	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+   fi; \
+	done; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+	for subdir in $(SUBDIRS); do \
+	  if test "$$subdir" = .; then :; else \
+	    test -d $(distdir)/$$subdir \
+	    || mkdir $(distdir)/$$subdir \
+	    || exit 1; \
+	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \
+	      || exit 1; \
+	  fi; \
+	done
+info-am:
+info: info-recursive
+dvi-am:
+dvi: dvi-recursive
+check-am: all-am
+check: check-recursive
+installcheck-am:
+installcheck: installcheck-recursive
+install-exec-am:
+install-exec: install-exec-recursive
+
+install-data-am:
+install-data: install-data-recursive
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-recursive
+uninstall-am:
+uninstall: uninstall-recursive
+all-am: Makefile $(LTLIBRARIES)
+all-redirect: all-recursive
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs: installdirs-recursive
+installdirs-am:
+
+
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-noinstLTLIBRARIES mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-recursive
+
+clean-am:  clean-noinstLTLIBRARIES clean-compile clean-libtool \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-recursive
+
+distclean-am:  distclean-noinstLTLIBRARIES distclean-compile \
+		distclean-libtool distclean-tags distclean-generic \
+		clean-am
+	-rm -f libtool
+
+distclean: distclean-recursive
+
+maintainer-clean-am:  maintainer-clean-noinstLTLIBRARIES \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-recursive
+
+.PHONY: mostlyclean-noinstLTLIBRARIES distclean-noinstLTLIBRARIES \
+clean-noinstLTLIBRARIES maintainer-clean-noinstLTLIBRARIES \
+mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool install-recursive \
+uninstall-recursive 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-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+installdirs-am installdirs mostlyclean-generic distclean-generic \
+clean-generic maintainer-clean-generic clean mostlyclean distclean \
+maintainer-clean
+
+
+add.c: $(top_srcdir)/mpz/add.c
+	cp $(top_srcdir)/mpz/add.c add.c
+
+cmp.c: $(top_srcdir)/mpz/cmp.c
+	cp $(top_srcdir)/mpz/cmp.c cmp.c
+
+gcd.c: $(top_srcdir)/mpz/gcd.c
+	cp $(top_srcdir)/mpz/gcd.c gcd.c
+
+mul.c: $(top_srcdir)/mpz/mul.c
+	cp $(top_srcdir)/mpz/mul.c mul.c
+
+pow_ui.c: $(top_srcdir)/mpz/pow_ui.c
+	cp $(top_srcdir)/mpz/pow_ui.c pow_ui.c
+
+powm.c: $(top_srcdir)/mpz/powm.c
+	cp $(top_srcdir)/mpz/powm.c powm.c
+
+realloc.c: $(top_srcdir)/mpz/realloc.c
+	cp $(top_srcdir)/mpz/realloc.c realloc.c
+
+sqrtrem.c: $(top_srcdir)/mpz/sqrtrem.c
+	cp $(top_srcdir)/mpz/sqrtrem.c sqrtrem.c
+
+sub.c: $(top_srcdir)/mpz/sub.c
+	cp $(top_srcdir)/mpz/sub.c sub.c
+
+tdiv_qr.c: $(top_srcdir)/mpz/tdiv_qr.c
+	cp $(top_srcdir)/mpz/tdiv_qr.c tdiv_qr.c
+
+# 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/src/gmp/mpbsd/itom.c b/src/gmp/mpbsd/itom.c
new file mode 100644
index 000000000..40ccf007a
--- /dev/null
+++ b/src/gmp/mpbsd/itom.c
@@ -0,0 +1,54 @@
+/* itom -- BSD compatible allocate and initiate a MINT.
+
+Copyright (C) 1991, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "mp.h"
+#include "gmp.h"
+#include "gmp-impl.h"
+
+MINT *
+#if __STDC__
+itom (signed short int n)
+#else
+itom (n)
+     short int n;
+#endif
+{
+  MINT *x;
+  mp_ptr xp;
+
+  x = (MINT *) (*_mp_allocate_func) (sizeof (MINT));
+  x->_mp_alloc = 1;
+  x->_mp_d = xp = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
+  if (n > 0)
+    {
+      x->_mp_size = 1;
+      xp[0] = n;
+    }
+  else if (n < 0)
+    {
+      x->_mp_size = -1;
+      xp[0] = (unsigned short) -n;
+    }
+  else
+    x->_mp_size = 0;
+
+  return x;
+}
diff --git a/src/gmp/mpbsd/mfree.c b/src/gmp/mpbsd/mfree.c
new file mode 100644
index 000000000..6a93c85e0
--- /dev/null
+++ b/src/gmp/mpbsd/mfree.c
@@ -0,0 +1,36 @@
+/* mfree -- BSD compatible mfree.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "mp.h"
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mfree (MINT *m)
+#else
+mfree (m)
+     MINT *m;
+#endif
+{
+  (*_mp_free_func) (m->_mp_d, m->_mp_alloc * BYTES_PER_MP_LIMB);
+  (*_mp_free_func) (m, sizeof (MINT));
+}
diff --git a/src/gmp/mpbsd/min.c b/src/gmp/mpbsd/min.c
new file mode 100644
index 000000000..88078e85c
--- /dev/null
+++ b/src/gmp/mpbsd/min.c
@@ -0,0 +1,114 @@
+/* min(MINT) -- Do decimal input from standard input and store result in
+   MINT.
+
+Copyright (C) 1991, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <ctype.h>
+#include "mp.h"
+#include "gmp.h"
+#include "gmp-impl.h"
+
+static int
+#if __STDC__
+digit_value_in_base (int c, int base)
+#else
+digit_value_in_base (c, base)
+     int c;
+     int base;
+#endif
+{
+  int digit;
+
+  if (isdigit (c))
+    digit = c - '0';
+  else if (islower (c))
+    digit = c - 'a' + 10;
+  else if (isupper (c))
+    digit = c - 'A' + 10;
+  else
+    return -1;
+
+  if (digit < base)
+    return digit;
+  return -1;
+}
+
+void
+#if __STDC__
+min (MINT *dest)
+#else
+min (dest)
+     MINT *dest;
+#endif
+{
+  char *str;
+  size_t alloc_size, str_size;
+  int c;
+  int negative;
+  mp_size_t dest_size;
+
+  alloc_size = 100;
+  str = (char *) (*_mp_allocate_func) (alloc_size);
+  str_size = 0;
+
+  /* Skip whitespace.  */
+  do
+    c = getc (stdin);
+  while (isspace (c));
+
+  negative = 0;
+  if (c == '-')
+    {
+      negative = 1;
+      c = getc (stdin);
+    }
+
+  if (digit_value_in_base (c, 10) < 0)
+    return;			/* error if no digits */
+
+  for (;;)
+    {
+      int dig;
+      if (str_size >= alloc_size)
+	{
+	  size_t old_alloc_size = alloc_size;
+	  alloc_size = alloc_size * 3 / 2;
+	  str = (char *) (*_mp_reallocate_func) (str, old_alloc_size, alloc_size);
+	}
+      dig = digit_value_in_base (c, 10);
+      if (dig < 0)
+	break;
+      str[str_size++] = dig;
+      c = getc (stdin);
+    }
+
+  ungetc (c, stdin);
+
+  dest_size = str_size / __mp_bases[10].chars_per_limb + 1;
+  if (dest->_mp_alloc < dest_size)
+    _mp_realloc (dest, dest_size);
+
+  dest_size = mpn_set_str (dest->_mp_d, (unsigned char *) str, str_size, 10);
+  dest->_mp_size = negative ? -dest_size : dest_size;
+
+  (*_mp_free_func) (str, alloc_size);
+  return;
+}
diff --git a/src/gmp/mpbsd/mout.c b/src/gmp/mpbsd/mout.c
new file mode 100644
index 000000000..96b7022b9
--- /dev/null
+++ b/src/gmp/mpbsd/mout.c
@@ -0,0 +1,97 @@
+/* mout(MINT) -- Do decimal output of MINT to standard output.
+
+Copyright (C) 1991, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <string.h>
+#include "mp.h"
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mout (const MINT *x)
+#else
+mout (x)
+     const MINT *x;
+#endif
+{
+  mp_ptr xp;
+  mp_size_t x_size = x->_mp_size;
+  unsigned char *str;
+  size_t str_size;
+  char *num_to_text;
+  int i;
+  TMP_DECL (marker);
+
+  if (x_size == 0)
+    {
+      fputc ('0', stdout);
+      return;
+    }
+  if (x_size < 0)
+    {
+      fputc ('-', stdout);
+      x_size = -x_size;
+    }
+
+  TMP_MARK (marker);
+  str_size = ((size_t) (x_size * BITS_PER_MP_LIMB
+			* __mp_bases[10].chars_per_bit_exactly)) + 3;
+  str = (unsigned char *) TMP_ALLOC (str_size);
+
+  /* Move the number to convert into temporary space, since mpn_get_str
+     clobbers its argument + needs one extra high limb....  */
+  xp = (mp_ptr) TMP_ALLOC ((x_size + 1) * BYTES_PER_MP_LIMB);
+  MPN_COPY (xp, x->_mp_d, x_size);
+
+  str_size = mpn_get_str (str, 10, xp, x_size);
+
+  /* mpn_get_str might make some leading zeros.  Skip them.  */
+  while (*str == 0)
+    {
+      str_size--;
+      str++;
+    }
+
+  /* Translate to printable chars.  */
+  for (i = 0; i < str_size; i++)
+    str[i] = "0123456789"[str[i]];
+  str[str_size] = 0;
+
+  str_size = strlen ((char *) str);
+  if (str_size % 10 != 0)
+    {
+      fwrite (str, 1, str_size % 10, stdout);
+      str += str_size % 10;
+      str_size -= str_size % 10;
+      if (str_size != 0)
+	fputc (' ', stdout);
+    }
+  for (i = 0; i < str_size; i += 10)
+    {
+      fwrite (str, 1, 10, stdout);
+      str += 10;
+      if (i + 10 < str_size)
+	fputc (' ', stdout);
+    }
+  fputc ('\n', stdout);
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpbsd/move.c b/src/gmp/mpbsd/move.c
new file mode 100644
index 000000000..d48605706
--- /dev/null
+++ b/src/gmp/mpbsd/move.c
@@ -0,0 +1,46 @@
+/* move -- BSD compatible assignment.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "mp.h"
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+move (const MINT *u, MINT *w)
+#else
+move (u, w)
+     const MINT *u;
+     MINT *w;
+#endif
+{
+  mp_size_t usize;
+  mp_size_t abs_usize;
+
+  usize = u->_mp_size;
+  abs_usize = ABS (usize);
+
+  if (w->_mp_alloc < abs_usize)
+    _mp_realloc (w, abs_usize);
+
+  w->_mp_size = usize;
+  MPN_COPY (w->_mp_d, u->_mp_d, abs_usize);
+}
diff --git a/src/gmp/mpbsd/mtox.c b/src/gmp/mpbsd/mtox.c
new file mode 100644
index 000000000..5d5a82c6f
--- /dev/null
+++ b/src/gmp/mpbsd/mtox.c
@@ -0,0 +1,81 @@
+/* mtox -- Convert OPERAND to hexadecimal and return a malloc'ed string
+   with the result of the conversion.
+
+Copyright (C) 1991, 1994, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "mp.h"
+#include "gmp.h"
+#include "gmp-impl.h"
+
+char *
+#if __STDC__
+mtox (const MINT *x)
+#else
+mtox (x)
+     const MINT *x;
+#endif
+{
+  mp_ptr xp;
+  mp_size_t xsize = x->_mp_size;
+  mp_size_t xsign;
+  unsigned char *str, *s;
+  size_t str_size, i;
+  int zeros;
+  char *num_to_text;
+  TMP_DECL (marker);
+
+  if (xsize == 0)
+    {
+      str = (unsigned char *) (*_mp_allocate_func) (2);
+      str[0] = '0';
+      str[1] = 0;
+      return (char *) str;
+    }
+  xsign = xsize;
+  if (xsize < 0)
+    xsize = -xsize;
+
+  TMP_MARK (marker);
+  str_size = ((size_t) (xsize * BITS_PER_MP_LIMB
+			* __mp_bases[16].chars_per_bit_exactly)) + 3;
+  str = (unsigned char *) (*_mp_allocate_func) (str_size);
+  s = str;
+
+  if (xsign < 0)
+    *s++ = '-';
+
+  /* Move the number to convert into temporary space, since mpn_get_str
+     clobbers its argument + needs one extra high limb....  */
+  xp = (mp_ptr) TMP_ALLOC ((xsize + 1) * BYTES_PER_MP_LIMB);
+  MPN_COPY (xp, x->_mp_d, xsize);
+
+  str_size = mpn_get_str (s, 16, xp, xsize);
+
+  /* mpn_get_str might make some leading zeros.  Skip them.  */
+  for (zeros = 0; s[zeros] == 0; zeros++)
+    str_size--;
+
+  /* Translate to printable chars and move string down.  */
+  for (i = 0; i < str_size; i++)
+    s[i] = "0123456789abcdef"[s[zeros + i]];
+  s[str_size] = 0;
+
+  return (char *) str;
+}
diff --git a/src/gmp/mpbsd/sdiv.c b/src/gmp/mpbsd/sdiv.c
new file mode 100644
index 000000000..9e95cc9a8
--- /dev/null
+++ b/src/gmp/mpbsd/sdiv.c
@@ -0,0 +1,77 @@
+/* sdiv -- Divide a MINT by a short integer.  Produce a MINT quotient
+   and a short remainder.
+
+Copyright (C) 1991, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "mp.h"
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+sdiv (const MINT *dividend, signed short int divisor_short, MINT *quot, short *rem_ptr)
+#else
+sdiv (dividend, divisor_short, quot, rem_ptr)
+     const MINT *dividend;
+     short int divisor_short;
+     MINT *quot;
+     short *rem_ptr;
+#endif
+{
+  mp_size_t sign_dividend;
+  signed long int sign_divisor;
+  mp_size_t dividend_size, quot_size;
+  mp_ptr dividend_ptr, quot_ptr;
+  mp_limb_t divisor_limb;
+  mp_limb_t remainder_limb;
+
+  sign_dividend = dividend->_mp_size;
+  dividend_size = ABS (dividend->_mp_size);
+
+  if (dividend_size == 0)
+    {
+      quot->_mp_size = 0;
+      *rem_ptr = 0;
+      return;
+    }
+
+  sign_divisor = divisor_short;
+  divisor_limb = (unsigned short) ABS (divisor_short);
+
+  /* No need for temporary allocation and copying even if QUOT == DIVIDEND
+     as the divisor is just one limb, and thus no intermediate remainders
+     need to be stored.  */
+
+  if (quot->_mp_alloc < dividend_size)
+    _mp_realloc (quot, dividend_size);
+
+  quot_ptr = quot->_mp_d;
+  dividend_ptr = dividend->_mp_d;
+
+  remainder_limb = mpn_divmod_1 (quot_ptr,
+				 dividend_ptr, dividend_size, divisor_limb);
+
+  *rem_ptr = sign_dividend >= 0 ? remainder_limb : -remainder_limb;
+  /* The quotient is DIVIDEND_SIZE limbs, but the most significant
+     might be zero.  Set QUOT_SIZE properly. */
+  quot_size = dividend_size - (quot_ptr[dividend_size - 1] == 0);
+  quot->_mp_size = (sign_divisor ^ sign_dividend) >= 0 ? quot_size : -quot_size;
+}
diff --git a/src/gmp/mpbsd/tests/Makefile.am b/src/gmp/mpbsd/tests/Makefile.am
new file mode 100644
index 000000000..34fcefe42
--- /dev/null
+++ b/src/gmp/mpbsd/tests/Makefile.am
@@ -0,0 +1,34 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libmp.la
+dummy_LDADD =
+
+if WANT_MPBSD
+MPBSD_check_OPTION = allfuns t-misc
+endif
+
+check_PROGRAMS = dummy $(MPBSD_check_OPTION)
+TESTS = $(check_PROGRAMS)
diff --git a/src/gmp/mpbsd/tests/Makefile.in b/src/gmp/mpbsd/tests/Makefile.in
new file mode 100644
index 000000000..6f4162adc
--- /dev/null
+++ b/src/gmp/mpbsd/tests/Makefile.in
@@ -0,0 +1,432 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libmp.la
+dummy_LDADD = 
+
+@WANT_MPBSD_TRUE@MPBSD_check_OPTION = @WANT_MPBSD_TRUE@allfuns t-misc
+
+check_PROGRAMS = dummy $(MPBSD_check_OPTION)
+TESTS = $(check_PROGRAMS)
+subdir = mpbsd/tests
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../../config.h
+CONFIG_CLEAN_FILES = 
+@WANT_MPBSD_FALSE@check_PROGRAMS =  dummy$(EXEEXT)
+@WANT_MPBSD_TRUE@check_PROGRAMS =  dummy$(EXEEXT) allfuns$(EXEEXT) \
+@WANT_MPBSD_TRUE@t-misc$(EXEEXT)
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I../..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+ANSI2KNR = $(top_builddir)/ansi2knr
+allfuns_SOURCES = allfuns.c
+allfuns_OBJECTS =  allfuns$U.$(OBJEXT)
+allfuns_LDADD = $(LDADD)
+allfuns_DEPENDENCIES =  $(top_builddir)/libmp.la
+allfuns_LDFLAGS = 
+dummy_SOURCES = dummy.c
+dummy_OBJECTS =  dummy$U.$(OBJEXT)
+dummy_DEPENDENCIES = 
+dummy_LDFLAGS = 
+t_misc_SOURCES = t-misc.c
+t_misc_OBJECTS =  t-misc$U.$(OBJEXT)
+t_misc_LDADD = $(LDADD)
+t_misc_DEPENDENCIES =  $(top_builddir)/libmp.la
+t_misc_LDFLAGS = 
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  allfuns.c dummy.c t-misc.c
+DIST_COMMON =  Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = allfuns.c dummy.c t-misc.c
+OBJECTS = allfuns$U.$(OBJEXT) dummy$U.$(OBJEXT) t-misc$U.$(OBJEXT)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpbsd/tests/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-checkPROGRAMS:
+
+clean-checkPROGRAMS:
+	-test -z "$(check_PROGRAMS)" || rm -f $(check_PROGRAMS)
+
+distclean-checkPROGRAMS:
+
+maintainer-clean-checkPROGRAMS:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+$(top_builddir)/ansi2knr: $(top_builddir)/ansi2knr.$(OBJEXT)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr
+
+$(top_builddir)/ansi2knr.$(OBJEXT):
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr.$(OBJEXT)
+
+
+mostlyclean-kr:
+	-rm -f *_.c
+
+clean-kr:
+
+distclean-kr:
+
+maintainer-clean-kr:
+
+allfuns$(EXEEXT): $(allfuns_OBJECTS) $(allfuns_DEPENDENCIES)
+	@rm -f allfuns$(EXEEXT)
+	$(LINK) $(allfuns_LDFLAGS) $(allfuns_OBJECTS) $(allfuns_LDADD) $(LIBS)
+
+dummy$(EXEEXT): $(dummy_OBJECTS) $(dummy_DEPENDENCIES)
+	@rm -f dummy$(EXEEXT)
+	$(LINK) $(dummy_LDFLAGS) $(dummy_OBJECTS) $(dummy_LDADD) $(LIBS)
+
+t-misc$(EXEEXT): $(t_misc_OBJECTS) $(t_misc_DEPENDENCIES)
+	@rm -f t-misc$(EXEEXT)
+	$(LINK) $(t_misc_LDFLAGS) $(t_misc_OBJECTS) $(t_misc_LDADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+allfuns_.c: allfuns.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/allfuns.c; then echo $(srcdir)/allfuns.c; else echo allfuns.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > allfuns_.c
+dummy_.c: dummy.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/dummy.c; then echo $(srcdir)/dummy.c; else echo dummy.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > dummy_.c
+t-misc_.c: t-misc.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-misc.c; then echo $(srcdir)/t-misc.c; else echo t-misc.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-misc_.c
+allfuns_.$(OBJEXT) allfuns_.lo dummy_.$(OBJEXT) dummy_.lo \
+t-misc_.$(OBJEXT) t-misc_.lo : $(ANSI2KNR)
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+check-TESTS: $(TESTS)
+	@failed=0; all=0; xfail=0; xpass=0; \
+	srcdir=$(srcdir); export srcdir; \
+	for tst in $(TESTS); do \
+	  if test -f ./$$tst; then dir=./; \
+	  elif test -f $$tst; then dir=; \
+	  else dir="$(srcdir)/"; fi; \
+	  if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xpass=`expr $$xpass + 1`; \
+	      failed=`expr $$failed + 1`; \
+	      echo "XPASS: $$tst"; \
+	    ;; \
+	    *) \
+	      echo "PASS: $$tst"; \
+	    ;; \
+	    esac; \
+	  elif test $$? -ne 77; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xfail=`expr $$xfail + 1`; \
+	      echo "XFAIL: $$tst"; \
+	    ;; \
+	    *) \
+	      failed=`expr $$failed + 1`; \
+	      echo "FAIL: $$tst"; \
+	    ;; \
+	    esac; \
+	  fi; \
+	done; \
+	if test "$$failed" -eq 0; then \
+	  if test "$$xfail" -eq 0; then \
+	    banner="All $$all tests passed"; \
+	  else \
+	    banner="All $$all tests behaved as expected ($$xfail expected failures)"; \
+	  fi; \
+	else \
+	  if test "$$xpass" -eq 0; then \
+	    banner="$$failed of $$all tests failed"; \
+	  else \
+	    banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \
+	  fi; \
+	fi; \
+	dashes=`echo "$$banner" | sed s/./=/g`; \
+	echo "$$dashes"; \
+	echo "$$banner"; \
+	echo "$$dashes"; \
+	test "$$failed" -eq 0
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am: all-am
+	$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
+	$(MAKE) $(AM_MAKEFLAGS) check-TESTS
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am:
+install-data: install-data-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am:
+uninstall: uninstall-am
+all-am: Makefile
+all-redirect: all-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs:
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-checkPROGRAMS mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-kr mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am:  clean-checkPROGRAMS clean-compile clean-libtool clean-kr \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-am
+
+distclean-am:  distclean-checkPROGRAMS distclean-compile \
+		distclean-libtool distclean-kr distclean-tags \
+		distclean-generic clean-am
+	-rm -f libtool
+
+distclean: distclean-am
+
+maintainer-clean-am:  maintainer-clean-checkPROGRAMS \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-kr maintainer-clean-tags \
+		maintainer-clean-generic distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-checkPROGRAMS distclean-checkPROGRAMS \
+clean-checkPROGRAMS maintainer-clean-checkPROGRAMS mostlyclean-compile \
+distclean-compile clean-compile maintainer-clean-compile \
+mostlyclean-libtool distclean-libtool clean-libtool \
+maintainer-clean-libtool mostlyclean-kr distclean-kr clean-kr \
+maintainer-clean-kr tags mostlyclean-tags distclean-tags clean-tags \
+maintainer-clean-tags distdir check-TESTS info-am info dvi-am dvi check \
+check-am installcheck-am installcheck install-exec-am install-exec \
+install-data-am install-data install-am install uninstall-am uninstall \
+all-redirect all-am all install-strip 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/src/gmp/mpbsd/tests/allfuns.c b/src/gmp/mpbsd/tests/allfuns.c
new file mode 100644
index 000000000..ce40c7d8d
--- /dev/null
+++ b/src/gmp/mpbsd/tests/allfuns.c
@@ -0,0 +1,58 @@
+/* A test program doing nothing really, just linking to all the BSD MP
+   functions that're supposed to exist. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "mp.h"
+
+int
+main (int argc, char *argv[])
+{
+  MINT *a, *b, *c, *d;
+  short  h;
+
+  a = itom (123);
+  b = xtom ("DEADBEEF");
+  c = itom (0);
+  d = itom (0);
+  move (a, b);
+  madd (a, b, c);
+  msub (a, b, c);
+  mult (a, b, c);
+  mdiv (b, a, c, d);
+  sdiv (b, 2, c, &h);
+  msqrt (a, c, d);
+  pow (b, a, a, c);
+  rpow (a, 3, c);
+  gcd (a, b, c);
+  mcmp (a, b);
+  if (argc > 1)
+    {
+      min (c);
+      mout (a);
+    }
+  mtox (b);
+
+  mfree(a);
+
+  exit (0);
+}
diff --git a/src/gmp/mpbsd/tests/dummy.c b/src/gmp/mpbsd/tests/dummy.c
new file mode 100644
index 000000000..280c500f3
--- /dev/null
+++ b/src/gmp/mpbsd/tests/dummy.c
@@ -0,0 +1,28 @@
+/* A dummy do-nothing test program, which always passes. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+int
+main ()
+{
+  exit (0);
+}
diff --git a/src/gmp/mpbsd/tests/t-misc.c b/src/gmp/mpbsd/tests/t-misc.c
new file mode 100644
index 000000000..69d5810d2
--- /dev/null
+++ b/src/gmp/mpbsd/tests/t-misc.c
@@ -0,0 +1,74 @@
+/* Exercise various mpbsd functions. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mp.h"
+
+#define SGN(x)       ((x) < 0 ? -1 : (x) == 0 ? 0 : 1)
+
+
+void
+check_itom (void)
+{
+  static const struct {
+    short      m;
+    mp_size_t  want_size;
+    mp_limb_t  want_limb;
+  } data[] = {
+
+    {  0L,  0 },
+    {  1L,  1, 1 },
+    { -1L, -1, 1 },
+
+    {  SHORT_MAX,  1, SHORT_MAX },
+    { -SHORT_MAX, -1, SHORT_MAX },
+
+    { SHORT_HIGHBIT, -1, USHORT_HIGHBIT },
+  };
+
+  MINT  *m;
+  int   i;
+
+  for (i = 0; i < numberof (data); i++)
+    {
+      m = itom (data[i].m);
+      if (m->_mp_size != data[i].want_size
+          || (m->_mp_size != 0 && m->_mp_d[0] != data[i].want_limb))
+        {
+          printf ("itom wrong on data[%d]\n", i); 
+          abort();                                    
+        }
+      mfree (m);
+    }
+}
+
+
+int
+main (void)
+{
+  check_itom ();
+
+  exit (0);
+}
diff --git a/src/gmp/mpbsd/xtom.c b/src/gmp/mpbsd/xtom.c
new file mode 100644
index 000000000..dd5ec1999
--- /dev/null
+++ b/src/gmp/mpbsd/xtom.c
@@ -0,0 +1,116 @@
+/* xtom -- convert a hexadecimal string to a MINT, and return a pointer to
+   the MINT.
+
+Copyright (C) 1991, 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <string.h>
+#include <ctype.h>
+#include "mp.h"
+#include "gmp.h"
+#include "gmp-impl.h"
+
+static int
+#if __STDC__
+digit_value_in_base (int c, int base)
+#else
+digit_value_in_base (c, base)
+     int c;
+     int base;
+#endif
+{
+  int digit;
+
+  if (isdigit (c))
+    digit = c - '0';
+  else if (islower (c))
+    digit = c - 'a' + 10;
+  else if (isupper (c))
+    digit = c - 'A' + 10;
+  else
+    return -1;
+
+  if (digit < base)
+    return digit;
+  return -1;
+}
+
+MINT *
+#if __STDC__
+xtom (const char *str)
+#else
+xtom (str)
+     const char *str;
+#endif
+{
+  size_t str_size;
+  char *s, *begs;
+  size_t i;
+  mp_size_t xsize;
+  int c;
+  int negative;
+  MINT *x = (MINT *) (*_mp_allocate_func) (sizeof (MINT));
+  TMP_DECL (marker);
+
+  /* Skip whitespace.  */
+  do
+    c = *str++;
+  while (isspace (c));
+
+  negative = 0;
+  if (c == '-')
+    {
+      negative = 1;
+      c = *str++;
+    }
+
+  if (digit_value_in_base (c, 16) < 0)
+    return 0;			/* error if no digits */
+
+  TMP_MARK (marker);
+  str_size = strlen (str - 1);
+  s = begs = (char *) TMP_ALLOC (str_size + 1);
+
+  for (i = 0; i < str_size; i++)
+    {
+      if (!isspace (c))
+	{
+	  int dig = digit_value_in_base (c, 16);
+	  if (dig < 0)
+	    {
+	      TMP_FREE (marker);
+	      return 0;
+	    }
+	  *s++ = dig;
+	}
+      c = *str++;
+    }
+
+  str_size = s - begs;
+
+  xsize = str_size / __mp_bases[16].chars_per_limb + 1;
+  x->_mp_alloc = xsize;
+  x->_mp_d = (mp_ptr) (*_mp_allocate_func) (xsize * BYTES_PER_MP_LIMB);
+
+  xsize = mpn_set_str (x->_mp_d, (unsigned char *) begs, str_size, 16);
+  x->_mp_size = negative ? -xsize : xsize;
+
+  TMP_FREE (marker);
+  return x;
+}
diff --git a/src/gmp/mpf/Makefile.am b/src/gmp/mpf/Makefile.am
new file mode 100644
index 000000000..20146e4cd
--- /dev/null
+++ b/src/gmp/mpf/Makefile.am
@@ -0,0 +1,49 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+INCLUDES = -I$(top_srcdir) -DOPERATION_$*
+
+noinst_LTLIBRARIES = libmpf.la
+libmpf_la_SOURCES = \
+  init.c init2.c set.c set_ui.c set_si.c set_str.c set_d.c set_z.c \
+  set_q.c iset.c iset_ui.c iset_si.c iset_str.c iset_d.c clear.c get_str.c \
+  dump.c size.c eq.c reldiff.c sqrt.c random2.c inp_str.c out_str.c \
+  add.c add_ui.c sub.c sub_ui.c ui_sub.c mul.c mul_ui.c div.c div_ui.c \
+  cmp.c cmp_ui.c cmp_si.c mul_2exp.c div_2exp.c abs.c neg.c get_d.c \
+  set_dfl_prec.c set_prc.c set_prc_raw.c get_prc.c ui_div.c sqrt_ui.c \
+  pow_ui.c urandomb.c swap.c
+
+nodist_libmpf_la_SOURCES = floor.c ceil.c trunc.c
+
+EXTRA_DIST = integer.c
+CLEANFILES = $(nodist_libmpf_la_SOURCES)
+
+floor.c: $(srcdir)/integer.c
+	cp $(srcdir)/integer.c floor.c
+ceil.c: $(srcdir)/integer.c
+	cp $(srcdir)/integer.c ceil.c
+trunc.c: $(srcdir)/integer.c
+	cp $(srcdir)/integer.c trunc.c
diff --git a/src/gmp/mpf/Makefile.in b/src/gmp/mpf/Makefile.in
new file mode 100644
index 000000000..5983f8d02
--- /dev/null
+++ b/src/gmp/mpf/Makefile.in
@@ -0,0 +1,436 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+INCLUDES = -I$(top_srcdir) -DOPERATION_$*
+
+noinst_LTLIBRARIES = libmpf.la
+libmpf_la_SOURCES = \
+  init.c init2.c set.c set_ui.c set_si.c set_str.c set_d.c set_z.c \
+  set_q.c iset.c iset_ui.c iset_si.c iset_str.c iset_d.c clear.c get_str.c \
+  dump.c size.c eq.c reldiff.c sqrt.c random2.c inp_str.c out_str.c \
+  add.c add_ui.c sub.c sub_ui.c ui_sub.c mul.c mul_ui.c div.c div_ui.c \
+  cmp.c cmp_ui.c cmp_si.c mul_2exp.c div_2exp.c abs.c neg.c get_d.c \
+  set_dfl_prec.c set_prc.c set_prc_raw.c get_prc.c ui_div.c sqrt_ui.c \
+  pow_ui.c urandomb.c swap.c
+
+
+nodist_libmpf_la_SOURCES = floor.c ceil.c trunc.c
+
+EXTRA_DIST = integer.c
+CLEANFILES = $(nodist_libmpf_la_SOURCES)
+subdir = mpf
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES = 
+LTLIBRARIES =  $(noinst_LTLIBRARIES)
+
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+libmpf_la_LDFLAGS = 
+libmpf_la_LIBADD = 
+am_libmpf_la_OBJECTS =  init.lo init2.lo set.lo set_ui.lo set_si.lo \
+set_str.lo set_d.lo set_z.lo set_q.lo iset.lo iset_ui.lo iset_si.lo \
+iset_str.lo iset_d.lo clear.lo get_str.lo dump.lo size.lo eq.lo \
+reldiff.lo sqrt.lo random2.lo inp_str.lo out_str.lo add.lo add_ui.lo \
+sub.lo sub_ui.lo ui_sub.lo mul.lo mul_ui.lo div.lo div_ui.lo cmp.lo \
+cmp_ui.lo cmp_si.lo mul_2exp.lo div_2exp.lo abs.lo neg.lo get_d.lo \
+set_dfl_prec.lo set_prc.lo set_prc_raw.lo get_prc.lo ui_div.lo \
+sqrt_ui.lo pow_ui.lo urandomb.lo swap.lo
+nodist_libmpf_la_OBJECTS =  floor.lo ceil.lo trunc.lo
+libmpf_la_OBJECTS =  $(am_libmpf_la_OBJECTS) $(nodist_libmpf_la_OBJECTS)
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(libmpf_la_SOURCES)
+DIST_COMMON =  README Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(libmpf_la_SOURCES) $(nodist_libmpf_la_SOURCES)
+OBJECTS = $(am_libmpf_la_OBJECTS) $(nodist_libmpf_la_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpf/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-noinstLTLIBRARIES:
+
+clean-noinstLTLIBRARIES:
+	-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
+
+distclean-noinstLTLIBRARIES:
+
+maintainer-clean-noinstLTLIBRARIES:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+
+libmpf.la: $(libmpf_la_OBJECTS) $(libmpf_la_DEPENDENCIES)
+	$(LINK)  $(libmpf_la_LDFLAGS) $(libmpf_la_OBJECTS) $(libmpf_la_LIBADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+
+# 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.
+
+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; \
+	dot_seen=no; \
+	target=`echo $@ | sed s/-recursive//`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    dot_seen=yes; \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+	done; \
+	if test "$$dot_seen" = "no"; then \
+	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+	fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+	@set fnord $(MAKEFLAGS); amf=$$2; \
+	dot_seen=no; \
+	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
+	  rev="$$subdir $$rev"; \
+	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
+	done; \
+	test "$$dot_seen" = "no" && rev=". $$rev"; \
+	target=`echo $@ | sed s/-recursive//`; \
+	for subdir in $$rev; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_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 \
+	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+	done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+   if test "$$subdir" = .; then :; else \
+	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+   fi; \
+	done; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+	for subdir in $(SUBDIRS); do \
+	  if test "$$subdir" = .; then :; else \
+	    test -d $(distdir)/$$subdir \
+	    || mkdir $(distdir)/$$subdir \
+	    || exit 1; \
+	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \
+	      || exit 1; \
+	  fi; \
+	done
+info-am:
+info: info-recursive
+dvi-am:
+dvi: dvi-recursive
+check-am: all-am
+check: check-recursive
+installcheck-am:
+installcheck: installcheck-recursive
+install-exec-am:
+install-exec: install-exec-recursive
+
+install-data-am:
+install-data: install-data-recursive
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-recursive
+uninstall-am:
+uninstall: uninstall-recursive
+all-am: Makefile $(LTLIBRARIES)
+all-redirect: all-recursive
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs: installdirs-recursive
+installdirs-am:
+
+
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-noinstLTLIBRARIES mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-recursive
+
+clean-am:  clean-noinstLTLIBRARIES clean-compile clean-libtool \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-recursive
+
+distclean-am:  distclean-noinstLTLIBRARIES distclean-compile \
+		distclean-libtool distclean-tags distclean-generic \
+		clean-am
+	-rm -f libtool
+
+distclean: distclean-recursive
+
+maintainer-clean-am:  maintainer-clean-noinstLTLIBRARIES \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-recursive
+
+.PHONY: mostlyclean-noinstLTLIBRARIES distclean-noinstLTLIBRARIES \
+clean-noinstLTLIBRARIES maintainer-clean-noinstLTLIBRARIES \
+mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool install-recursive \
+uninstall-recursive 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-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+installdirs-am installdirs mostlyclean-generic distclean-generic \
+clean-generic maintainer-clean-generic clean mostlyclean distclean \
+maintainer-clean
+
+
+floor.c: $(srcdir)/integer.c
+	cp $(srcdir)/integer.c floor.c
+ceil.c: $(srcdir)/integer.c
+	cp $(srcdir)/integer.c ceil.c
+trunc.c: $(srcdir)/integer.c
+	cp $(srcdir)/integer.c trunc.c
+
+# 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/src/gmp/mpf/README b/src/gmp/mpf/README
new file mode 100644
index 000000000..c76499ecf
--- /dev/null
+++ b/src/gmp/mpf/README
@@ -0,0 +1,27 @@
+This directory contains functions for GMP's floating-point function layer.
+
+In this version of GMP, floating-point numbers are represented like in the
+figure below.  (Please note that the format might change between every
+version, and that depending on the internal format in any way is a bad idea.)
+
+   most				least
+significant		     significant
+   limb				limb
+
+				 _mp_d
+				  /
+				 /
+				\/
+	<-- _mp_exp -->
+	 ____ ____ ____ ____ ____
+	|____|____|____|____|____|
+		       . <------------- radix point
+
+	<------- _mp_size ------->
+
+
+The most significant limb will be non-zero.  The _mp_exp field is the distance
+in number of limbs from the radix point to the most significant limb; it will
+be positive iff the absolute value of the number is >= 1.  The _mp_size
+field's sign reflects the sign of the number.  Its absolute value is the count
+of limbs in the number.
diff --git a/src/gmp/mpf/abs.c b/src/gmp/mpf/abs.c
new file mode 100644
index 000000000..b069f84a1
--- /dev/null
+++ b/src/gmp/mpf/abs.c
@@ -0,0 +1,56 @@
+/* mpf_abs -- Compute the absolute value of a float.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_abs (mpf_ptr r, mpf_srcptr u)
+#else
+mpf_abs (r, u)
+     mpf_ptr r;
+     mpf_srcptr u;
+#endif
+{
+  mp_size_t size;
+
+  size = ABS (u->_mp_size);
+  if (r != u)
+    {
+      mp_size_t prec;
+      mp_ptr rp, up;
+
+      prec = r->_mp_prec + 1;	/* lie not to lose precision in assignment */
+      rp = r->_mp_d;
+      up = u->_mp_d;
+
+      if (size > prec)
+	{
+	  up += size - prec;
+	  size = prec;
+	}
+
+      MPN_COPY (rp, up, size);
+      r->_mp_exp = u->_mp_exp;
+    }
+  r->_mp_size = size;
+}
diff --git a/src/gmp/mpf/add.c b/src/gmp/mpf/add.c
new file mode 100644
index 000000000..2d9cad60c
--- /dev/null
+++ b/src/gmp/mpf/add.c
@@ -0,0 +1,180 @@
+/* mpf_add -- Add two floats.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_add (mpf_ptr r, mpf_srcptr u, mpf_srcptr v)
+#else
+mpf_add (r, u, v)
+     mpf_ptr r;
+     mpf_srcptr u;
+     mpf_srcptr v;
+#endif
+{
+  mp_srcptr up, vp;
+  mp_ptr rp, tp;
+  mp_size_t usize, vsize, rsize;
+  mp_size_t prec;
+  mp_exp_t uexp;
+  mp_size_t ediff;
+  mp_limb_t cy;
+  int negate;
+  TMP_DECL (marker);
+
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+
+  /* Handle special cases that don't work in generic code below.  */
+  if (usize == 0)
+    {
+      mpf_set (r, v);
+      return;
+    }
+  if (vsize == 0)
+    {
+      mpf_set (r, u);
+      return;
+    }
+
+  /* If signs of U and V are different, perform subtraction.  */
+  if ((usize ^ vsize) < 0)
+    {
+      __mpf_struct v_negated;
+      v_negated._mp_size = -vsize;
+      v_negated._mp_exp = v->_mp_exp;
+      v_negated._mp_d = v->_mp_d;
+      mpf_sub (r, u, &v_negated);
+      return;
+    }
+
+  TMP_MARK (marker);
+
+  /* Signs are now known to be the same.  */
+  negate = usize < 0;
+
+  /* Make U be the operand with the largest exponent.  */
+  if (u->_mp_exp < v->_mp_exp)
+    {
+      mpf_srcptr t;
+      t = u; u = v; v = t;
+      usize = u->_mp_size;
+      vsize = v->_mp_size;
+    }
+
+  usize = ABS (usize);
+  vsize = ABS (vsize);
+  up = u->_mp_d;
+  vp = v->_mp_d;
+  rp = r->_mp_d;
+  prec = r->_mp_prec;
+  uexp = u->_mp_exp;
+  ediff = u->_mp_exp - v->_mp_exp;
+
+  /* If U extends beyond PREC, ignore the part that does.  */
+  if (usize > prec)
+    {
+      up += usize - prec;
+      usize = prec;
+    }
+
+  /* If V extends beyond PREC, ignore the part that does.
+     Note that this may make vsize negative.  */
+  if (vsize + ediff > prec)
+    {
+      vp += vsize + ediff - prec;
+      vsize = prec - ediff;
+    }
+
+#if 0
+  /* Locate the least significant non-zero limb in (the needed parts
+     of) U and V, to simplify the code below.  */
+  while (up[0] == 0)
+    up++, usize--;
+  while (vp[0] == 0)
+    vp++, vsize--;
+#endif
+
+  /* Allocate temp space for the result.  Allocate
+     just vsize + ediff later???  */
+  tp = (mp_ptr) TMP_ALLOC (prec * BYTES_PER_MP_LIMB);
+
+  if (ediff >= prec)
+    {
+      /* V completely cancelled.  */
+      if (tp != up)
+	MPN_COPY (rp, up, usize);
+      rsize = usize;
+    }
+  else
+    {
+      /* uuuu     |  uuuu     |  uuuu     |  uuuu     |  uuuu    */
+      /* vvvvvvv  |  vv       |    vvvvv  |    v      |       vv */
+
+      if (usize > ediff)
+	{
+	  /* U and V partially overlaps.  */
+	  if (vsize + ediff <= usize)
+	    {
+	      /* uuuu     */
+	      /*   v      */
+	      mp_size_t size;
+	      size = usize - ediff - vsize;
+	      MPN_COPY (tp, up, size);
+	      cy = mpn_add (tp + size, up + size, usize - size, vp, vsize);
+	      rsize = usize;
+	    }
+	  else
+	    {
+	      /* uuuu     */
+	      /*   vvvvv  */
+	      mp_size_t size;
+	      size = vsize + ediff - usize;
+	      MPN_COPY (tp, vp, size);
+	      cy = mpn_add (tp + size, up, usize, vp + size, usize - ediff);
+	      rsize = vsize + ediff;
+	    }
+	}
+      else
+	{
+	  /* uuuu     */
+	  /*      vv  */
+	  mp_size_t size;
+	  size = vsize + ediff - usize;
+	  MPN_COPY (tp, vp, vsize);
+	  MPN_ZERO (tp + vsize, ediff - usize);
+	  MPN_COPY (tp + size, up, usize);
+	  cy = 0;
+	  rsize = size + usize;
+	}
+
+      MPN_COPY (rp, tp, rsize);
+      rp[rsize] = cy;
+      rsize += cy;
+      uexp += cy;
+    }
+
+  r->_mp_size = negate ? -rsize : rsize;
+  r->_mp_exp = uexp;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/add_ui.c b/src/gmp/mpf/add_ui.c
new file mode 100644
index 000000000..aa485e6f4
--- /dev/null
+++ b/src/gmp/mpf/add_ui.c
@@ -0,0 +1,151 @@
+/* mpf_add_ui -- Add a float and an unsigned integer.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_add_ui (mpf_ptr sum, mpf_srcptr u, unsigned long int v)
+#else
+mpf_add_ui (sum, u, v)
+     mpf_ptr sum;
+     mpf_srcptr u;
+     unsigned long int v;
+#endif
+{
+  mp_srcptr up = u->_mp_d;
+  mp_ptr sump = sum->_mp_d;
+  mp_size_t usize, sumsize;
+  mp_size_t prec = sum->_mp_prec;
+  mp_exp_t uexp = u->_mp_exp;
+
+  usize = u->_mp_size;
+  if (usize <= 0)
+    {
+      if (usize == 0)
+	{
+	  mpf_set_ui (sum, v);
+	  return;
+	}
+      else
+	{
+	  __mpf_struct u_negated;
+	  u_negated._mp_size = -usize;
+	  u_negated._mp_exp = u->_mp_exp;
+	  u_negated._mp_d = u->_mp_d;
+	  mpf_sub_ui (sum, &u_negated, v);
+	  sum->_mp_size = -(sum->_mp_size);
+	  return;
+	}
+    }
+
+  if (v == 0)
+    {
+    sum_is_u:
+      if (u != sum)
+	{
+	  sumsize = MIN (usize, prec + 1);
+	  MPN_COPY (sum->_mp_d, up + usize - sumsize, sumsize);
+	  sum->_mp_size = sumsize;
+	  sum->_mp_exp = u->_mp_exp;
+	}
+      return;
+    }
+
+  if (uexp > 0)
+    {
+      /* U >= 1.  */
+      if (uexp > prec)
+	{
+	  /* U >> V, V is not part of final result.  */
+	  goto sum_is_u;
+	}
+      else
+	{
+	  /* U's "limb point" is somewhere between the first limb
+	     and the PREC:th limb.
+	     Both U and V are part of the final result.  */
+	  if (uexp > usize)
+	    {
+	      /*   uuuuuu0000. */
+	      /* +          v. */
+	      /* We begin with moving U to the top of SUM, to handle
+		 samevar(U,SUM).  */
+	      MPN_COPY_DECR (sump + uexp - usize, up, usize);
+	      sump[0] = v;
+	      MPN_ZERO (sump + 1, uexp - usize - 1);
+#if 0 /* What is this??? */
+	      if (sum == u)
+		MPN_COPY (sum->_mp_d, sump, uexp);
+#endif
+	      sum->_mp_size = uexp;
+	      sum->_mp_exp = uexp;
+	    }
+	  else
+	    {
+	      /*   uuuuuu.uuuu */
+	      /* +      v.     */
+	      mp_limb_t cy_limb;
+	      if (usize > prec)
+		{
+		  /* Ignore excess limbs in U.  */
+		  up += usize - prec;
+		  usize -= usize - prec; /* Eq. usize = prec */
+		}
+	      if (sump != up)
+		MPN_COPY (sump, up, usize - uexp);
+	      cy_limb = mpn_add_1 (sump + usize - uexp, up + usize - uexp,
+				   uexp, (mp_limb_t) v);
+	      sump[usize] = cy_limb;
+	      sum->_mp_size = usize + cy_limb;
+	      sum->_mp_exp = uexp + cy_limb;
+	    }
+	}
+    }
+  else
+    {
+      /* U < 1, so V > U for sure.  */
+      /* v.         */
+      /*  .0000uuuu */
+      if ((-uexp) >= prec)
+	{
+	  sump[0] = v;
+	  sum->_mp_size = 1;
+	  sum->_mp_exp = 1;
+	}
+      else
+	{
+	  if (usize + (-uexp) + 1 > prec)
+	    {
+	      /* Ignore excess limbs in U.  */
+	      up += usize + (-uexp) + 1 - prec;
+	      usize -= usize + (-uexp) + 1 - prec;
+	    }
+	  if (sump != up)
+	    MPN_COPY (sump, up, usize);
+	  MPN_ZERO (sump + usize, -uexp);
+	  sump[usize + (-uexp)] = v;
+	  sum->_mp_size = usize + (-uexp) + 1;
+	  sum->_mp_exp = 1;
+	}
+    }
+}
diff --git a/src/gmp/mpf/clear.c b/src/gmp/mpf/clear.c
new file mode 100644
index 000000000..3370e2cfa
--- /dev/null
+++ b/src/gmp/mpf/clear.c
@@ -0,0 +1,35 @@
+/* mpf_clear -- de-allocate the space occupied by the dynamic digit space of
+   an integer.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_clear (mpf_ptr m)
+#else
+mpf_clear (m)
+     mpf_ptr m;
+#endif
+{
+  (*_mp_free_func) (m->_mp_d, (m->_mp_prec + 1) * BYTES_PER_MP_LIMB);
+}
diff --git a/src/gmp/mpf/cmp.c b/src/gmp/mpf/cmp.c
new file mode 100644
index 000000000..750614ee8
--- /dev/null
+++ b/src/gmp/mpf/cmp.c
@@ -0,0 +1,114 @@
+/* mpf_cmp -- Compare two floats.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpf_cmp (mpf_srcptr u, mpf_srcptr v)
+#else
+mpf_cmp (u, v)
+     mpf_srcptr u;
+     mpf_srcptr v;
+#endif
+{
+  mp_srcptr up, vp;
+  mp_size_t usize, vsize;
+  mp_exp_t uexp, vexp;
+  int cmp;
+  int usign;
+
+  uexp = u->_mp_exp;
+  vexp = v->_mp_exp;
+
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+
+  /* 1. Are the signs different?  */
+  if ((usize ^ vsize) >= 0)
+    {
+      /* U and V are both non-negative or both negative.  */
+      if (usize == 0)
+	/* vsize >= 0 */
+	return -(vsize != 0);
+      if (vsize == 0)
+	/* usize >= 0 */
+	return usize != 0;
+      /* Fall out.  */
+    }
+  else
+    {
+      /* Either U or V is negative, but not both.  */
+      return usize >= 0 ? 1 : -1;
+    }
+
+  /* U and V have the same sign and are both non-zero.  */
+
+  usign = usize >= 0 ? 1 : -1;
+
+  /* 2. Are the exponents different?  */
+  if (uexp > vexp)
+    return usign;
+  if (uexp < vexp)
+    return -usign;
+
+  usize = ABS (usize);
+  vsize = ABS (vsize);
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+
+#define STRICT_MPF_NORMALIZATION 0
+#if ! STRICT_MPF_NORMALIZATION
+  /* Ignore zeroes at the low end of U and V.  */
+  while (up[0] == 0)
+    {
+      up++;
+      usize--;
+    }
+  while (vp[0] == 0)
+    {
+      vp++;
+      vsize--;
+    }
+#endif
+
+  if (usize > vsize)
+    {
+      cmp = mpn_cmp (up + usize - vsize, vp, vsize);
+      if (cmp == 0)
+	return usign;
+    }
+  else if (vsize > usize)
+    {
+      cmp = mpn_cmp (up, vp + vsize - usize, usize);
+      if (cmp == 0)
+	return -usign;
+    }
+  else
+    {
+      cmp = mpn_cmp (up, vp, usize);
+      if (cmp == 0)
+	return 0;
+    }
+  return cmp > 0 ? usign : -usign;
+}
diff --git a/src/gmp/mpf/cmp_si.c b/src/gmp/mpf/cmp_si.c
new file mode 100644
index 000000000..8d5d2d18f
--- /dev/null
+++ b/src/gmp/mpf/cmp_si.c
@@ -0,0 +1,98 @@
+/* mpf_cmp_si -- Compare a float with a signed integer.
+
+Copyright (C) 1993, 1994, 1995, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpf_cmp_si (mpf_srcptr u, long int vslimb)
+#else
+mpf_cmp_si (u, vslimb)
+     mpf_srcptr u;
+     long int vslimb;
+#endif
+{
+  mp_srcptr up;
+  mp_size_t usize;
+  mp_exp_t uexp;
+  int usign;
+
+  uexp = u->_mp_exp;
+  usize = u->_mp_size;
+
+  /* 1. Are the signs different?  */
+  if ((usize < 0) == (vslimb < 0)) /* don't use xor, type size may differ */
+    {
+      /* U and V are both non-negative or both negative.  */
+      if (usize == 0)
+	/* vslimb >= 0 */
+	return -(vslimb != 0);
+      if (vslimb == 0)
+	/* usize >= 0 */
+	return usize != 0;
+      /* Fall out.  */
+    }
+  else
+    {
+      /* Either U or V is negative, but not both.  */
+      return usize >= 0 ? 1 : -1;
+    }
+
+  /* U and V have the same sign and are both non-zero.  */
+
+  usign = usize >= 0 ? 1 : -1;
+
+  /* 2. Are the exponents different (V's exponent == 1)?  */
+  if (uexp > 1)
+    return usign;
+  if (uexp < 1)
+    return -usign;
+
+  usize = ABS (usize);
+  vslimb = ABS (vslimb);
+
+  up = u->_mp_d;
+
+  /* 3. Compare the most significant mantissa limb with V.  */
+  if (up[usize - 1] > (unsigned long) vslimb)
+    return usign;
+  else if (up[usize - 1] < (unsigned long) vslimb)
+    return -usign;
+
+#define STRICT_MPF_NORMALIZATION 0
+#if ! STRICT_MPF_NORMALIZATION
+  /* Ignore zeroes at the low end of U.  */
+  while (*up == 0)
+    {
+      up++;
+      usize--;
+    }
+#endif
+
+  /* 4. Now, if the number of limbs are different, we have a difference
+     since we have made sure the trailing limbs are not zero.  */
+  if (usize > 1)
+    return usign;
+
+  /* Wow, we got zero even if we tried hard to avoid it.  */
+  return 0;
+}
diff --git a/src/gmp/mpf/cmp_ui.c b/src/gmp/mpf/cmp_ui.c
new file mode 100644
index 000000000..5d9746014
--- /dev/null
+++ b/src/gmp/mpf/cmp_ui.c
@@ -0,0 +1,80 @@
+/* mpf_cmp_ui -- Compare a float with an unsigned integer.
+
+Copyright (C) 1993, 1994, 1995, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpf_cmp_ui (mpf_srcptr u, unsigned long int vlimb)
+#else
+mpf_cmp_ui (u, vlimb)
+     mpf_srcptr u;
+     unsigned long int vlimb;
+#endif
+{
+  mp_srcptr up;
+  mp_size_t usize;
+  mp_exp_t uexp;
+
+  uexp = u->_mp_exp;
+  usize = u->_mp_size;
+
+  /* 1. Is U negative?  */
+  if (usize < 0)
+    return -1;
+  /* We rely on usize being non-negative in the code that follows.  */
+
+  if (vlimb == 0)
+    return usize != 0;
+
+  /* 2. Are the exponents different (V's exponent == 1)?  */
+  if (uexp > 1)
+    return 1;
+  if (uexp < 1)
+    return -1;
+
+  up = u->_mp_d;
+
+  /* 3. Compare the most significant mantissa limb with V.  */
+  if (up[usize - 1] > vlimb)
+    return 1;
+  else if (up[usize - 1] < vlimb)
+    return -1;
+
+#define STRICT_MPF_NORMALIZATION 0
+#if ! STRICT_MPF_NORMALIZATION
+  /* Ignore zeroes at the low end of U.  */
+  while (*up == 0)
+    {
+      up++;
+      usize--;
+    }
+#endif
+
+  /* 4. Now, if the number of limbs are different, we have a difference
+     since we have made sure the trailing limbs are not zero.  */
+  if (usize > 1)
+    return 1;
+
+  /* Wow, we got zero even if we tried hard to avoid it.  */
+  return 0;
+}
diff --git a/src/gmp/mpf/div.c b/src/gmp/mpf/div.c
new file mode 100644
index 000000000..00c5e5105
--- /dev/null
+++ b/src/gmp/mpf/div.c
@@ -0,0 +1,145 @@
+/* mpf_div -- Divide two floats.
+
+Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpf_div (mpf_ptr r, mpf_srcptr u, mpf_srcptr v)
+#else
+mpf_div (r, u, v)
+     mpf_ptr r;
+     mpf_srcptr u;
+     mpf_srcptr v;
+#endif
+{
+  mp_srcptr up, vp;
+  mp_ptr rp, tp, rtp;
+  mp_size_t usize, vsize;
+  mp_size_t rsize, tsize;
+  mp_size_t sign_quotient;
+  mp_size_t prec;
+  unsigned normalization_steps;
+  mp_limb_t q_limb;
+  mp_exp_t rexp;
+  TMP_DECL (marker);
+
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+  sign_quotient = usize ^ vsize;
+  usize = ABS (usize);
+  vsize = ABS (vsize);
+  prec = r->_mp_prec;
+
+  if (vsize == 0)
+    DIVIDE_BY_ZERO;
+
+  if (usize == 0)
+    {
+      r->_mp_size = 0;
+      r->_mp_exp = 0;
+      return;
+    }
+
+  TMP_MARK (marker);
+  rexp = u->_mp_exp - v->_mp_exp;
+
+  rp = r->_mp_d;
+  up = u->_mp_d;
+  vp = v->_mp_d;
+
+  if (vsize > prec)
+    {
+      vp += vsize - prec;
+      vsize = prec;
+    }
+
+  tsize = vsize + prec;
+  tp = (mp_ptr) TMP_ALLOC ((tsize + 1) * BYTES_PER_MP_LIMB);
+
+  if (usize > tsize)
+    {
+      up += usize - tsize;
+      usize = tsize;
+      rtp = tp;
+    }
+  else
+    {
+      MPN_ZERO (tp, tsize - usize);
+      rtp = tp + (tsize - usize);
+    }
+
+  count_leading_zeros (normalization_steps, vp[vsize - 1]);
+
+  /* Normalize the divisor and the dividend.  */
+  if (normalization_steps != 0)
+    {
+      mp_ptr tmp;
+      mp_limb_t nlimb;
+
+      /* Shift up the divisor setting the most significant bit of
+	 the most significant limb.  Use temporary storage not to clobber
+	 the original contents of the divisor.  */
+      tmp = (mp_ptr) TMP_ALLOC (vsize * BYTES_PER_MP_LIMB);
+      mpn_lshift (tmp, vp, vsize, normalization_steps);
+      vp = tmp;
+
+      /* Shift up the dividend, possibly introducing a new most
+	 significant word.  Move the shifted dividend in the remainder
+	 at the same time.  */
+      nlimb = mpn_lshift (rtp, up, usize, normalization_steps);
+      if (nlimb != 0)
+	{
+	  rtp[usize] = nlimb;
+	  tsize++;
+	  rexp++;
+	}
+    }
+  else
+    {
+      /* The divisor is already normalized, as required.
+	 Copy it to temporary space if it overlaps with the quotient.  */
+      if (vp - rp <= tsize - vsize)
+	{
+	  mp_ptr tmp = (mp_ptr) TMP_ALLOC (vsize * BYTES_PER_MP_LIMB);
+	  MPN_COPY (tmp, vp, vsize);
+	  vp = (mp_srcptr) tmp;
+	}
+
+      /* Move the dividend to the remainder.  */
+      MPN_COPY (rtp, up, usize);
+    }
+
+  q_limb = mpn_divmod (rp, tp, tsize, vp, vsize);
+  rsize = tsize - vsize;
+  if (q_limb)
+    {
+      rp[rsize] = q_limb;
+      rsize++;
+      rexp++;
+    }
+
+  r->_mp_size = sign_quotient >= 0 ? rsize : -rsize;
+  r->_mp_exp = rexp;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/div_2exp.c b/src/gmp/mpf/div_2exp.c
new file mode 100644
index 000000000..2f20755e0
--- /dev/null
+++ b/src/gmp/mpf/div_2exp.c
@@ -0,0 +1,93 @@
+/* mpf_div_2exp -- Divide a float by 2^n.
+
+Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_div_2exp (mpf_ptr r, mpf_srcptr u, unsigned long int exp)
+#else
+mpf_div_2exp (r, u, exp)
+     mpf_ptr r;
+     mpf_srcptr u;
+     unsigned long int exp;
+#endif
+{
+  mp_srcptr up;
+  mp_ptr rp = r->_mp_d;
+  mp_size_t usize;
+  mp_size_t abs_usize;
+  mp_size_t prec = r->_mp_prec;
+  mp_exp_t uexp = u->_mp_exp;
+
+  usize = u->_mp_size;
+
+  if (usize == 0)
+    {
+      r->_mp_size = 0;
+      r->_mp_exp = 0;
+      return;
+    }
+
+  abs_usize = ABS (usize);
+  up = u->_mp_d;
+
+  if (exp % BITS_PER_MP_LIMB == 0)
+    {
+      prec++;			/* retain more precision here as we don't need
+				   to account for carry-out here */
+      if (abs_usize > prec)
+	{
+	  up += abs_usize - prec;
+	  abs_usize = prec;
+	}
+      if (rp != up)
+	MPN_COPY_INCR (rp, up, abs_usize);
+      r->_mp_exp = uexp - exp / BITS_PER_MP_LIMB;
+    }
+  else
+    {
+      mp_limb_t cy_limb;
+      mp_size_t adj;
+      if (abs_usize > prec)
+	{
+	  up += abs_usize - prec;
+	  abs_usize = prec;
+	  /* Use mpn_rshift since mpn_lshift operates downwards, and we
+	     therefore would clobber part of U before using that part, in case
+	     R is the same variable as U.  */
+	  cy_limb = mpn_rshift (rp + 1, up, abs_usize, exp % BITS_PER_MP_LIMB);
+	  rp[0] = cy_limb;
+	  adj = rp[abs_usize] != 0;
+	}
+      else
+	{
+	  cy_limb = mpn_lshift (rp, up, abs_usize, (-exp) % BITS_PER_MP_LIMB);
+	  rp[abs_usize] = cy_limb;
+	  adj = cy_limb != 0;
+	}
+
+      abs_usize += adj;
+      r->_mp_exp = uexp - exp / BITS_PER_MP_LIMB - 1 + adj;
+    }
+  r->_mp_size = usize >= 0 ? abs_usize : -abs_usize;
+}
diff --git a/src/gmp/mpf/div_ui.c b/src/gmp/mpf/div_ui.c
new file mode 100644
index 000000000..515c14f5c
--- /dev/null
+++ b/src/gmp/mpf/div_ui.c
@@ -0,0 +1,92 @@
+/* mpf_div_ui -- Divide a float with an unsigned integer.
+
+Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpf_div_ui (mpf_ptr r, mpf_srcptr u, unsigned long int v)
+#else
+mpf_div_ui (r, u, v)
+     mpf_ptr r;
+     mpf_srcptr u;
+     unsigned long int v;
+#endif
+{
+  mp_srcptr up;
+  mp_ptr rp, tp, rtp;
+  mp_size_t usize;
+  mp_size_t rsize, tsize;
+  mp_size_t sign_quotient;
+  mp_size_t prec;
+  mp_limb_t q_limb;
+  mp_exp_t rexp;
+  TMP_DECL (marker);
+
+  usize = u->_mp_size;
+  sign_quotient = usize;
+  usize = ABS (usize);
+  prec = r->_mp_prec;
+
+  if (v == 0)
+    DIVIDE_BY_ZERO;
+
+  if (usize == 0)
+    {
+      r->_mp_size = 0;
+      r->_mp_exp = 0;
+      return;
+    }
+
+  TMP_MARK (marker);
+
+  rp = r->_mp_d;
+  up = u->_mp_d;
+
+  tsize = 1 + prec;
+  tp = (mp_ptr) TMP_ALLOC ((tsize + 1) * BYTES_PER_MP_LIMB);
+
+  if (usize > tsize)
+    {
+      up += usize - tsize;
+      usize = tsize;
+      rtp = tp;
+    }
+  else
+    {
+      MPN_ZERO (tp, tsize - usize);
+      rtp = tp + (tsize - usize);
+    }
+
+  /* Move the dividend to the remainder.  */
+  MPN_COPY (rtp, up, usize);
+
+  mpn_divmod_1 (rp, tp, tsize, (mp_limb_t) v);
+  q_limb = rp[tsize - 1];
+
+  rsize = tsize - (q_limb == 0);
+  rexp = u->_mp_exp - (q_limb == 0);
+  r->_mp_size = sign_quotient >= 0 ? rsize : -rsize;
+  r->_mp_exp = rexp;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/dump.c b/src/gmp/mpf/dump.c
new file mode 100644
index 000000000..bebef7c81
--- /dev/null
+++ b/src/gmp/mpf/dump.c
@@ -0,0 +1,48 @@
+/* mpf_dump -- Dump a float to stdout.
+
+   THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS NOT SAFE TO
+   CALL THIS FUNCTION DIRECTLY.  IN FACT, IT IS ALMOST GUARANTEED THAT THIS
+   FUNCTION WILL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE.
+
+
+Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_dump (mpf_srcptr u)
+#else
+mpf_dump (u)
+     mpf_srcptr u;
+#endif
+{
+  mp_exp_t exp;
+  char *str;
+
+  str = mpf_get_str (0, &exp, 10, 0, u);
+  if (str[0] == '-')
+    printf ("-0.%se%ld\n", str + 1, exp);
+  else
+    printf ("0.%se%ld\n", str, exp);
+  (*_mp_free_func) (str, 0);/* ??? broken alloc interface, pass what size ??? */
+}
diff --git a/src/gmp/mpf/eq.c b/src/gmp/mpf/eq.c
new file mode 100644
index 000000000..e12be7bb4
--- /dev/null
+++ b/src/gmp/mpf/eq.c
@@ -0,0 +1,121 @@
+/* mpf_eq -- Compare two floats up to a specified bit #.
+
+Copyright (C) 1993, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpf_eq (mpf_srcptr u, mpf_srcptr v, unsigned long int n_bits)
+#else
+mpf_eq (u, v, n_bits)
+     mpf_srcptr u;
+     mpf_srcptr v;
+     unsigned long int n_bits;
+#endif
+{
+  mp_srcptr up, vp;
+  mp_size_t usize, vsize, size, i;
+  mp_exp_t uexp, vexp;
+  int usign;
+
+  uexp = u->_mp_exp;
+  vexp = v->_mp_exp;
+
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+
+  /* 1. Are the signs different?  */
+  if ((usize ^ vsize) >= 0)
+    {
+      /* U and V are both non-negative or both negative.  */
+      if (usize == 0)
+	return vsize == 0;
+      if (vsize == 0)
+	return 0;
+
+      /* Fall out.  */
+    }
+  else
+    {
+      /* Either U or V is negative, but not both.  */
+      return 0;
+    }
+
+  /* U and V have the same sign and are both non-zero.  */
+
+  usign = usize >= 0 ? 1 : -1;
+
+  /* 2. Are the exponents different?  */
+  if (uexp > vexp)
+    return 0;			/* ??? handle (uexp = vexp + 1)   */
+  if (vexp > uexp)
+    return 0;			/* ??? handle (vexp = uexp + 1)   */
+
+  usize = ABS (usize);
+  vsize = ABS (vsize);
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+
+  /* Ignore zeroes at the low end of U and V.  */
+  while (up[0] == 0)
+    {
+      up++;
+      usize--;
+    }
+  while (vp[0] == 0)
+    {
+      vp++;
+      vsize--;
+    }
+
+  if (usize > vsize)
+    {
+      if (vsize * BITS_PER_MP_LIMB < n_bits)
+	return 0;		/* surely too different */
+      size = vsize;
+    }
+  else if (vsize > usize)
+    {
+      if (usize * BITS_PER_MP_LIMB < n_bits)
+	return 0;		/* surely too different */
+      size = usize;
+    }
+  else
+    {
+      size = usize;
+    }
+
+  if (size > (n_bits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB)
+    size = (n_bits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+
+  up += usize - size;
+  vp += vsize - size;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+      if (up[i] != vp[i])
+	return 0;
+    }
+
+  return 1;
+}
diff --git a/src/gmp/mpf/get_d.c b/src/gmp/mpf/get_d.c
new file mode 100644
index 000000000..4352803ef
--- /dev/null
+++ b/src/gmp/mpf/get_d.c
@@ -0,0 +1,54 @@
+/* double mpf_get_d (mpf_t src) -- Return the double approximation to SRC.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+double
+#if __STDC__
+mpf_get_d (mpf_srcptr src)
+#else
+mpf_get_d (src)
+     mpf_srcptr src;
+#endif
+{
+  double res;
+  mp_size_t size, i, n_limbs_to_use;
+  int negative;
+  mp_ptr qp;
+
+  size = SIZ(src);
+  if (size == 0)
+    return 0.0;
+
+  negative = size < 0;
+  size = ABS (size);
+  qp = PTR(src);
+
+  res = qp[size - 1];
+  n_limbs_to_use = MIN (LIMBS_PER_DOUBLE, size);
+  for (i = 2; i <= n_limbs_to_use; i++)
+    res = res * MP_BASE_AS_DOUBLE + qp[size - i];
+
+  res = __gmp_scale2 (res, (EXP(src) - n_limbs_to_use) * BITS_PER_MP_LIMB);
+
+  return negative ? -res : res;
+}
diff --git a/src/gmp/mpf/get_prc.c b/src/gmp/mpf/get_prc.c
new file mode 100644
index 000000000..9e7d5f9e7
--- /dev/null
+++ b/src/gmp/mpf/get_prc.c
@@ -0,0 +1,34 @@
+/* mpf_get_prec(x) -- Return the precision in bits of x.
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpf_get_prec (mpf_srcptr x)
+#else
+mpf_get_prec (x)
+     mpf_srcptr x;
+#endif
+{
+  return (unsigned long int) x->_mp_prec * BITS_PER_MP_LIMB - BITS_PER_MP_LIMB;
+}
diff --git a/src/gmp/mpf/get_str.c b/src/gmp/mpf/get_str.c
new file mode 100644
index 000000000..a9c6551ce
--- /dev/null
+++ b/src/gmp/mpf/get_str.c
@@ -0,0 +1,431 @@
+/* mpf_get_str (digit_ptr, exp, base, n_digits, a) -- Convert the floating
+  point number A to a base BASE number and store N_DIGITS raw digits at
+  DIGIT_PTR, and the base BASE exponent in the word pointed to by EXP.  For
+  example, the number 3.1416 would be returned as "31416" in DIGIT_PTR and
+  1 in EXP.
+
+Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/*
+  The conversion routine works like this:
+
+  1. If U >= 1, compute U' = U / base**n, where n is chosen such that U' is
+     the largest number smaller than 1.
+  2. Else, if U < 1, compute U' = U * base**n, where n is chosen such that U'
+     is the largest number smaller than 1.
+  3. Convert U' (by repeatedly multiplying it by base).  This process can
+     easily be interrupted when the needed number of digits are generated.
+*/
+
+char *
+#if __STDC__
+mpf_get_str (char *digit_ptr, mp_exp_t *exp, int base, size_t n_digits, mpf_srcptr u)
+#else
+mpf_get_str (digit_ptr, exp, base, n_digits, u)
+     char *digit_ptr;
+     mp_exp_t *exp;
+     int base;
+     size_t n_digits;
+     mpf_srcptr u;
+#endif
+{
+  mp_ptr up;
+  mp_size_t usize;
+  mp_exp_t uexp;
+  mp_size_t prec;
+  unsigned char *str;
+  char *num_to_text;
+  mp_ptr rp;
+  mp_size_t rsize;
+  mp_limb_t big_base;
+  size_t digits_computed_so_far;
+  int dig_per_u;
+  unsigned char *tstr;
+  mp_exp_t exp_in_base;
+  int cnt;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  usize = u->_mp_size;
+  uexp = u->_mp_exp;
+  prec = u->_mp_prec + 1;
+
+  if (base >= 0)
+    {
+      if (base == 0)
+	base = 10;
+      num_to_text = "0123456789abcdefghijklmnopqrstuvwxyz";
+    }
+  else
+    {
+      base = -base;
+      num_to_text = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+    }
+
+  /* Don't compute more digits than U can accurately represent.
+     Also, if 0 digits were requested, give *exactly* as many digits
+     as can be accurately represented.  */
+  {
+    size_t max_digits = 2 + (size_t) (((prec - 2) * BITS_PER_MP_LIMB)
+				      * __mp_bases[base].chars_per_bit_exactly);
+    if (n_digits == 0 || n_digits > max_digits)
+      n_digits = max_digits;
+#if 0
+/* This seems to work, but check it better before enabling it.  */
+    else
+      /* Limit the computation precision if only a limited digits are
+	 desired.  We could probably decrease both this, and avoid the +1
+	 for setting prec above.  */
+      prec = 2 + (mp_size_t)
+	(n_digits / (BITS_PER_MP_LIMB * __mp_bases[base].chars_per_bit_exactly));
+#endif
+  }
+
+  if (digit_ptr == 0)
+    {
+      /* We didn't get a string from the user.  Allocate one (and return
+	 a pointer to it) with space for `-' and terminating null.  */
+      digit_ptr = (char *) (*_mp_allocate_func) (n_digits + 2);
+    }
+
+  if (usize == 0)
+    {
+      *exp = 0;
+      *digit_ptr = 0;
+      return digit_ptr;
+    }
+
+  str = (unsigned char *) digit_ptr;
+
+  if (usize < 0)
+    {
+      *digit_ptr = '-';
+      str++;
+      usize = -usize;
+    }
+
+  up = PTR (u);
+
+  if (uexp > 0)
+    {
+      /* U >= 1.  Compute U' = U / base**n, where n is chosen such that U' < 1.  */
+      mp_size_t ralloc;
+      mp_ptr tp;
+      int i;
+
+      /* Limit the number of digits to develop for small integers.  */
+#if 0
+      if (exp_in_base < n_digits)
+	n_digits = exp_in_base;
+#endif
+
+      count_leading_zeros (cnt, up[usize - 1]);
+      exp_in_base = (((double) uexp * BITS_PER_MP_LIMB - cnt)
+		     * __mp_bases[base].chars_per_bit_exactly);
+      exp_in_base += 1;
+
+      ralloc = (prec + 1) * 2;
+      rp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+      tp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+
+      rp[0] = base;
+      rsize = 1;
+      count_leading_zeros (cnt, exp_in_base);
+      for (i = BITS_PER_MP_LIMB - cnt - 2; i >= 0; i--)
+	{
+	  mpn_mul_n (tp, rp, rp, rsize);
+	  rsize = 2 * rsize;
+	  rsize -= tp[rsize - 1] == 0;
+
+	  if (rsize > prec)
+	    {
+	      MPN_COPY (rp, tp + rsize - prec, prec + 1);
+	      rsize = prec;
+	    }
+	  else
+	    MP_PTR_SWAP (rp, tp);
+
+	  if (((exp_in_base >> i) & 1) != 0)
+	    {
+	      mp_limb_t cy;
+	      cy = mpn_mul_1 (rp, rp, rsize, (mp_limb_t) base);
+	      rp[rsize] = cy;
+	      rsize += cy != 0;
+	    }
+	}
+
+      count_leading_zeros (cnt, rp[rsize - 1]);
+      if (cnt != 0)
+	{
+	  mpn_lshift (rp, rp, rsize, cnt);
+
+	  if (usize < rsize)
+	    {
+	      /* Pad out U to the size of R while shifting it.
+		 (Reuse temporary space at tp.)  */
+	      mp_limb_t cy;
+
+	      MPN_ZERO (tp, rsize - usize);
+	      cy = mpn_lshift (tp + rsize - usize, up, usize, cnt);
+	      up = tp;
+	      usize = rsize;
+	      if (cy)
+		up[usize++] = cy;
+	      ASSERT_ALWAYS (usize <= ralloc);	/* sufficient space? */
+	    }
+	  else
+	    {
+	      /* Copy U to temporary space.  */
+	      /* FIXME: Allocate more space for tp above, and reuse it here.  */
+	      mp_limb_t cy;
+	      mp_ptr tup = (mp_ptr) TMP_ALLOC ((usize + 1) * BYTES_PER_MP_LIMB);
+
+	      cy = mpn_lshift (tup, up, usize, cnt);
+	      up = tup;
+	      if (cy)
+		up[usize++] = cy;
+	    }
+	}
+      else
+	{
+	  if (usize < rsize)
+	    {
+	      /* Pad out U to the size of R.  (Reuse temporary space at tp.)  */
+	      MPN_ZERO (tp, rsize - usize);
+	      MPN_COPY (tp + rsize - usize, up, usize);
+	      up = tp;
+	      usize = rsize;
+	    }
+	  else
+	    {
+	      /* Copy U to temporary space.  */
+	      mp_ptr tmp = (mp_ptr) TMP_ALLOC (usize * BYTES_PER_MP_LIMB);
+	      MPN_COPY (tmp, up, usize);
+	      up = tmp;
+	    }
+	}
+
+      {
+	mp_ptr qp;
+	qp = (mp_ptr) TMP_ALLOC (prec * BYTES_PER_MP_LIMB);
+	mpn_divrem (qp, prec - (usize - rsize), up, usize, rp, rsize);
+	rsize = prec;
+	rp = qp;
+      }
+    }
+  else
+    {
+      /* U < 1.  Compute U' = U * base**n, where n is chosen such that U' is
+	 the greatest number that still satisfies U' < 1.  */
+      mp_size_t ralloc;
+      mp_ptr tp;
+      int i;
+
+      uexp = -uexp;
+      count_leading_zeros (cnt, up[usize - 1]);
+      exp_in_base = (((double) uexp * BITS_PER_MP_LIMB + cnt - 1)
+		     * __mp_bases[base].chars_per_bit_exactly);
+      if (exp_in_base < 0)
+	exp_in_base = 0;
+
+      if (exp_in_base != 0)
+	{
+	  ralloc = (prec + 1) * 2;
+	  rp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+	  tp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+
+	  rp[0] = base;
+	  rsize = 1;
+	  count_leading_zeros (cnt, exp_in_base);
+	  for (i = BITS_PER_MP_LIMB - cnt - 2; i >= 0; i--)
+	    {
+	      mpn_mul_n (tp, rp, rp, rsize);
+	      rsize = 2 * rsize;
+	      rsize -= tp[rsize - 1] == 0;
+	      if (rsize > prec)
+		{
+		  MPN_COPY (rp, tp + rsize - prec, prec + 1);
+		  rsize = prec;
+		}
+	      else
+		MP_PTR_SWAP (rp, tp);
+
+	      if (((exp_in_base >> i) & 1) != 0)
+		{
+		  mp_limb_t cy;
+		  cy = mpn_mul_1 (rp, rp, rsize, (mp_limb_t) base);
+		  rp[rsize] = cy;
+		  rsize += cy != 0;
+		}
+	    }
+
+	  {
+	    mp_limb_t cy;
+	    tp = (mp_ptr) TMP_ALLOC ((rsize + usize) * BYTES_PER_MP_LIMB);
+	    if (rsize > usize)
+	      cy = mpn_mul (tp, rp, rsize, up, usize);
+	    else
+	      cy = mpn_mul (tp, up, usize, rp, rsize);
+	    rsize += usize;
+	    rsize -= cy == 0;
+	    rp = tp;
+	  }
+	  exp_in_base = -exp_in_base;
+	}
+      else
+	{
+	  rp = (mp_ptr) TMP_ALLOC (usize * BYTES_PER_MP_LIMB);
+	  MPN_COPY (rp, up, usize);
+	  rsize = usize;
+	}
+    }
+
+  big_base = __mp_bases[base].big_base;
+  dig_per_u = __mp_bases[base].chars_per_limb;
+
+  /* Hack for correctly (although not optimally) converting to bases that are
+     powers of 2.  If we deem it important, we could handle powers of 2 by
+     shifting and masking (just like mpn_get_str).  */
+  if (big_base < 10)		/* logarithm of base when power of two */
+    {
+      int logbase = big_base;
+      if (dig_per_u * logbase == BITS_PER_MP_LIMB)
+	dig_per_u--;
+      big_base = (mp_limb_t) 1 << (dig_per_u * logbase);
+      /* fall out to general code... */
+    }
+
+  /* Now that we have normalized the number, develop the digits, essentially by
+     multiplying it by BASE.  We initially develop at least 3 extra digits,
+     since the two leading digits might become zero, and we need one extra for
+     rounding the output properly.  */
+
+  /* Allocate temporary digit space.  We can't put digits directly in the user
+     area, since we generate more digits than requested.  (We allocate
+     BITS_PER_MP_LIMB extra bytes because of the digit block nature of the
+     conversion.)  */
+  tstr = (unsigned char *) TMP_ALLOC (n_digits + BITS_PER_MP_LIMB + 3);
+
+  for (digits_computed_so_far = 0; digits_computed_so_far < n_digits + 3;
+       digits_computed_so_far += dig_per_u)
+    {
+      mp_limb_t cy;
+      /* For speed: skip trailing zeroes.  */
+      if (rp[0] == 0)
+	{
+	  rp++;
+	  rsize--;
+	  if (rsize == 0)
+	    {
+	      n_digits = digits_computed_so_far;
+	      break;
+	    }
+	}
+
+      cy = mpn_mul_1 (rp, rp, rsize, big_base);
+
+      ASSERT_ALWAYS (! (digits_computed_so_far == 0 && cy == 0));
+
+      /* Convert N1 from BIG_BASE to a string of digits in BASE
+	 using single precision operations.  */
+      {
+	int i;
+	unsigned char *s = tstr + digits_computed_so_far + dig_per_u;
+	for (i = dig_per_u - 1; i >= 0; i--)
+	  {
+	    *--s = cy % base;
+	    cy /= base;
+	  }
+      }
+    }
+
+  /* We can have at most two leading 0.  Remove them.  */
+  if (tstr[0] == 0)
+    {
+      tstr++;
+      digits_computed_so_far--;
+      exp_in_base--;
+
+      if (tstr[0] == 0)
+	{
+	  tstr++;
+	  digits_computed_so_far--;
+	  exp_in_base--;
+
+	  if (tstr[0] == 0)
+	    abort ();
+	}
+    }
+
+  {
+    size_t i;
+
+    /* We should normally have computed too many digits.  Round the result
+       at the point indicated by n_digits.  */
+    if (digits_computed_so_far > n_digits)
+      {
+	/* Round the result.  */
+	if (tstr[n_digits] * 2 >= base)
+	  {
+	    digits_computed_so_far = n_digits;
+	    for (i = n_digits - 1;; i--)
+	      {
+		unsigned int x;
+		x = ++(tstr[i]);
+		if (x != base)
+		  break;
+		digits_computed_so_far--;
+		if (i == 0)
+		  {
+		    /* We had something like `9999999...9d', where 2*d >= base.
+		       This rounds up to `1', increasing the exponent.  */
+		    tstr[0] = 1;
+		    digits_computed_so_far = 1;
+		    exp_in_base++;
+		    break;
+		  }
+	      }
+	  }
+      }
+
+    /* We might have fewer digits than requested as a result of rounding above,
+       (i.e. 0.999999 => 1.0) or because we have a number that simply doesn't
+       need many digits in this base (i.e., 0.125 in base 10).  */
+    if (n_digits > digits_computed_so_far)
+      n_digits = digits_computed_so_far;
+
+    /* Remove trailing 0.  There can be many zeros.  */
+    while (n_digits != 0 && tstr[n_digits - 1] == 0)
+      n_digits--;
+
+    /* Translate to ascii and null-terminate.  */
+    for (i = 0; i < n_digits; i++)
+      *str++ = num_to_text[tstr[i]];
+  }
+  *str = 0;
+  *exp = exp_in_base;
+  TMP_FREE (marker);
+  return digit_ptr;
+}
diff --git a/src/gmp/mpf/init.c b/src/gmp/mpf/init.c
new file mode 100644
index 000000000..d558a432e
--- /dev/null
+++ b/src/gmp/mpf/init.c
@@ -0,0 +1,38 @@
+/* mpf_init() -- Make a new multiple precision number with value 0.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_init (mpf_ptr r)
+#else
+mpf_init (r)
+     mpf_ptr r;
+#endif
+{
+  mp_size_t prec = __gmp_default_fp_limb_precision;
+  r->_mp_d = (mp_ptr) (*_mp_allocate_func) ((prec + 1) * BYTES_PER_MP_LIMB);
+  r->_mp_prec = prec;
+  r->_mp_size = 0;
+  r->_mp_exp = 0;
+}
diff --git a/src/gmp/mpf/init2.c b/src/gmp/mpf/init2.c
new file mode 100644
index 000000000..16e609031
--- /dev/null
+++ b/src/gmp/mpf/init2.c
@@ -0,0 +1,41 @@
+/* mpf_init2() -- Make a new multiple precision number with value 0.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_init2 (mpf_ptr r, unsigned long int prec_in_bits)
+#else
+mpf_init2 (r, prec_in_bits)
+     mpf_ptr r;
+     unsigned long int prec_in_bits;
+#endif
+{
+  mp_size_t prec;
+
+  prec = (MAX (53, prec_in_bits) + 2 * BITS_PER_MP_LIMB - 1)/BITS_PER_MP_LIMB;
+  r->_mp_d = (mp_ptr) (*_mp_allocate_func) ((prec + 1) * BYTES_PER_MP_LIMB);
+  r->_mp_prec = prec;
+  r->_mp_size = 0;
+  r->_mp_exp = 0;
+}
diff --git a/src/gmp/mpf/inp_str.c b/src/gmp/mpf/inp_str.c
new file mode 100644
index 000000000..4d1816232
--- /dev/null
+++ b/src/gmp/mpf/inp_str.c
@@ -0,0 +1,89 @@
+/* mpf_inp_str(dest_float, stream, base) -- Input a number in base
+   BASE from stdio stream STREAM and store the result in DEST_FLOAT.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <ctype.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+size_t
+#if __STDC__
+mpf_inp_str (mpf_ptr rop, FILE *stream, int base)
+#else
+mpf_inp_str (rop, stream, base)
+     mpf_ptr rop;
+     FILE *stream;
+     int base;
+#endif
+{
+  char *str;
+  size_t alloc_size, str_size;
+  int c;
+  size_t retval;
+  size_t nread;
+
+  if (stream == 0)
+    stream = stdin;
+
+  alloc_size = 100;
+  str = (char *) (*_mp_allocate_func) (alloc_size);
+  str_size = 0;
+  nread = 0;
+
+  /* Skip whitespace.  */
+  do
+    {
+      c = getc (stream);
+      nread++;
+    }
+  while (isspace (c));
+
+  for (;;)
+    {
+      if (str_size >= alloc_size)
+	{
+	  size_t old_alloc_size = alloc_size;
+	  alloc_size = alloc_size * 3 / 2;
+	  str = (char *) (*_mp_reallocate_func) (str, old_alloc_size, alloc_size);
+	}
+      if (c == EOF || isspace (c))
+	break;
+      str[str_size++] = c;
+      c = getc (stream);
+    }
+  ungetc (c, stream);
+
+  if (str_size >= alloc_size)
+    {
+      size_t old_alloc_size = alloc_size;
+      alloc_size = alloc_size * 3 / 2;
+      str = (char *) (*_mp_reallocate_func) (str, old_alloc_size, alloc_size);
+    }
+  str[str_size] = 0;
+
+  retval = mpf_set_str (rop, str, base);
+  if (retval == -1)
+    return 0;			/* error */
+
+  (*_mp_free_func) (str, alloc_size);
+  return str_size + nread;
+}
diff --git a/src/gmp/mpf/integer.c b/src/gmp/mpf/integer.c
new file mode 100644
index 000000000..b4cb21963
--- /dev/null
+++ b/src/gmp/mpf/integer.c
@@ -0,0 +1,149 @@
+/* mpf_trunc, mpf_floor, mpf_ceil -- Assign a float from another float while
+   rounding it to an integer.
+
+Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+#if defined (OPERATION_floor)
+#define _MPF_FLOOR_OR_CEIL
+#define FUNC_NAME mpf_floor
+#define MPF_FLOOR 1
+#define MPF_CEIL 0
+
+#elif defined (OPERATION_ceil)
+#define _MPF_FLOOR_OR_CEIL
+#define FUNC_NAME mpf_ceil
+#define MPF_CEIL 1
+#define MPF_FLOOR 0
+
+#elif defined (OPERATION_trunc)
+#define FUNC_NAME mpf_trunc
+
+#else
+Error, error, unrecognised OPERATION
+#endif
+
+
+#ifdef _MPF_FLOOR_OR_CEIL
+static int
+#if __STDC__
+mpn_zero_p (mp_ptr p, mp_size_t n)
+#else
+mpn_zero_p (p, n)
+     mp_ptr p;
+     mp_size_t n;
+#endif
+{
+  mp_size_t i;
+
+  for (i = 0; i < n; i++)
+    {
+      if (p[i] != 0)
+	return 0;
+    }
+
+  return 1;
+}
+#endif
+
+void
+#if __STDC__
+FUNC_NAME (mpf_ptr r, mpf_srcptr u)
+#else
+FUNC_NAME (r, u)
+     mpf_ptr r;
+     mpf_srcptr u;
+#endif
+{
+  mp_ptr rp, up;
+  mp_size_t size, asize;
+  mp_size_t prec;
+  mp_size_t ignored_n;
+  mp_exp_t exp;
+
+  size = u->_mp_size;
+  rp = r->_mp_d;
+  exp = u->_mp_exp;
+
+  /* Single out the case where |u| < 1.  */
+  if (exp <= 0)
+    {
+#ifdef _MPF_FLOOR_OR_CEIL
+      if ((MPF_FLOOR && size < 0) || (MPF_CEIL && size >= 0))
+	{
+	  rp[0] = 1;
+	  r->_mp_size = MPF_FLOOR ? -1 : 1;
+	  r->_mp_exp = 1;
+	  return;
+	}
+#endif
+      r->_mp_size = 0;
+      return;
+    }
+
+  prec = r->_mp_prec /* + 1 */;
+  asize = ABS (size);
+
+#ifdef _MPF_FLOOR_OR_CEIL
+  ignored_n = 0;
+#endif
+  up = u->_mp_d;
+
+  if (asize > prec)
+    {
+#ifdef _MPF_FLOOR_OR_CEIL
+      ignored_n = asize - prec;
+#endif
+      up += asize - prec;
+      asize = prec;
+    }
+
+  if (asize > exp)
+    {
+      long diff = asize - exp;
+#ifdef _MPF_FLOOR_OR_CEIL
+      ignored_n += diff;
+#endif
+      up += diff;
+      asize = exp;
+    }
+
+#ifdef _MPF_FLOOR_OR_CEIL
+  if (((MPF_FLOOR && size < 0) || (MPF_CEIL && size >= 0))
+      && ! mpn_zero_p (up - ignored_n, ignored_n))
+    {
+      mp_limb_t cy;
+      cy = mpn_add_1 (rp, up, asize, (mp_limb_t) 1);
+      if (cy != 0)
+	{
+	  rp[asize++] = cy;
+	  exp++;
+	}
+    }
+  else
+#endif
+  MPN_COPY_INCR (rp, up, asize);
+
+  r->_mp_exp = exp;
+  r->_mp_size = size >= 0 ? asize : -asize;
+}
diff --git a/src/gmp/mpf/iset.c b/src/gmp/mpf/iset.c
new file mode 100644
index 000000000..9a91b5d22
--- /dev/null
+++ b/src/gmp/mpf/iset.c
@@ -0,0 +1,59 @@
+/* mpf_init_set -- Initialize a float and assign it from another float.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_init_set (mpf_ptr r, mpf_srcptr s)
+#else
+mpf_init_set (r, s)
+     mpf_ptr r;
+     mpf_srcptr s;
+#endif
+{
+  mp_ptr rp, sp;
+  mp_size_t ssize, size;
+  mp_size_t prec;
+
+  prec = __gmp_default_fp_limb_precision;
+  r->_mp_d = (mp_ptr) (*_mp_allocate_func) ((prec + 1) * BYTES_PER_MP_LIMB);
+  r->_mp_prec = prec;
+
+  prec++;		/* lie not to lose precision in assignment */
+  ssize = s->_mp_size;
+  size = ABS (ssize);
+
+  rp = r->_mp_d;
+  sp = s->_mp_d;
+
+  if (size > prec)
+    {
+      sp += size - prec;
+      size = prec;
+    }
+
+  MPN_COPY (rp, sp, size);
+
+  r->_mp_exp = s->_mp_exp;
+  r->_mp_size = ssize >= 0 ? size : -size;
+}
diff --git a/src/gmp/mpf/iset_d.c b/src/gmp/mpf/iset_d.c
new file mode 100644
index 000000000..fec390e60
--- /dev/null
+++ b/src/gmp/mpf/iset_d.c
@@ -0,0 +1,39 @@
+/* mpf_init_set_d -- Initialize a float and assign it from a double.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_init_set_d (mpf_ptr r, double val)
+#else
+mpf_init_set_d (r, val)
+     mpf_ptr r;
+     double val;
+#endif
+{
+  mp_size_t prec = __gmp_default_fp_limb_precision;
+  r->_mp_d = (mp_ptr) (*_mp_allocate_func) ((prec + 1) * BYTES_PER_MP_LIMB);
+  r->_mp_prec = prec;
+
+  mpf_set_d (r, val);
+}
diff --git a/src/gmp/mpf/iset_si.c b/src/gmp/mpf/iset_si.c
new file mode 100644
index 000000000..3c18e9db4
--- /dev/null
+++ b/src/gmp/mpf/iset_si.c
@@ -0,0 +1,55 @@
+/* mpf_init_set_si() -- Initialize a float and assign it from a signed int.
+
+Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_init_set_si (mpf_ptr r, long int val)
+#else
+mpf_init_set_si (r, val)
+     mpf_ptr r;
+     long int val;
+#endif
+{
+  mp_size_t prec = __gmp_default_fp_limb_precision;
+  r->_mp_d = (mp_ptr) (*_mp_allocate_func) ((prec + 1) * BYTES_PER_MP_LIMB);
+  r->_mp_prec = prec;
+
+  if (val > 0)
+    {
+      r->_mp_d[0] = val;
+      r->_mp_size = 1;
+      r->_mp_exp = 1;
+    }
+  else if (val < 0)
+    {
+      r->_mp_d[0] = (unsigned long) -val;
+      r->_mp_size = -1;
+      r->_mp_exp = 1;
+    }
+  else
+    {
+      r->_mp_size = 0;
+      r->_mp_exp = 0;
+    }
+}
diff --git a/src/gmp/mpf/iset_str.c b/src/gmp/mpf/iset_str.c
new file mode 100644
index 000000000..7aefc5704
--- /dev/null
+++ b/src/gmp/mpf/iset_str.c
@@ -0,0 +1,42 @@
+/* mpf_init_set_str -- Initialize a float and assign it from a string.
+
+Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpf_init_set_str (mpf_ptr r, const char *s, int base)
+#else
+mpf_init_set_str (r, s, base)
+     mpf_ptr r;
+     const char *s;
+     int base;
+#endif
+{
+  mp_size_t prec = __gmp_default_fp_limb_precision;
+  r->_mp_d = (mp_ptr) (*_mp_allocate_func) ((prec + 1) * BYTES_PER_MP_LIMB);
+  r->_mp_prec = prec;
+  r->_mp_size = 0;
+  r->_mp_exp = 0;
+
+  return mpf_set_str (r, s, base);
+}
diff --git a/src/gmp/mpf/iset_ui.c b/src/gmp/mpf/iset_ui.c
new file mode 100644
index 000000000..5817d40d4
--- /dev/null
+++ b/src/gmp/mpf/iset_ui.c
@@ -0,0 +1,40 @@
+/* mpf_init_set_ui() -- Initialize a float and assign it from an unsigned int.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_init_set_ui (mpf_ptr r, unsigned long int val)
+#else
+mpf_init_set_ui (r, val)
+     mpf_ptr r;
+     unsigned long int val;
+#endif
+{
+  mp_size_t prec = __gmp_default_fp_limb_precision;
+  r->_mp_d = (mp_ptr) (*_mp_allocate_func) ((prec + 1) * BYTES_PER_MP_LIMB);
+  r->_mp_prec = prec;
+  r->_mp_d[0] = val;
+  r->_mp_size = val != 0;
+  r->_mp_exp = val != 0;
+}
diff --git a/src/gmp/mpf/mul.c b/src/gmp/mpf/mul.c
new file mode 100644
index 000000000..1e5218749
--- /dev/null
+++ b/src/gmp/mpf/mul.c
@@ -0,0 +1,94 @@
+/* mpf_mul -- Multiply two floats.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_mul (mpf_ptr r, mpf_srcptr u, mpf_srcptr v)
+#else
+mpf_mul (r, u, v)
+     mpf_ptr r;
+     mpf_srcptr u;
+     mpf_srcptr v;
+#endif
+{
+  mp_srcptr up, vp;
+  mp_size_t usize, vsize;
+  mp_size_t sign_product;
+  mp_size_t prec = r->_mp_prec;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+  sign_product = usize ^ vsize;
+
+  usize = ABS (usize);
+  vsize = ABS (vsize);
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+  if (usize > prec)
+    {
+      up += usize - prec;
+      usize = prec;
+    }
+  if (vsize > prec)
+    {
+      vp += vsize - prec;
+      vsize = prec;
+    }
+
+  if (usize == 0 || vsize == 0)
+    {
+      r->_mp_size = 0;
+      r->_mp_exp = 0;		/* ??? */
+    }
+  else
+    {
+      mp_size_t rsize;
+      mp_limb_t cy_limb;
+      mp_ptr rp, tp;
+      mp_size_t adj;
+
+      rsize = usize + vsize;
+      tp = (mp_ptr) TMP_ALLOC (rsize * BYTES_PER_MP_LIMB);
+      cy_limb = (usize >= vsize
+		 ? mpn_mul (tp, up, usize, vp, vsize)
+		 : mpn_mul (tp, vp, vsize, up, usize));
+
+      adj = cy_limb == 0;
+      rsize -= adj;
+      prec++;
+      if (rsize > prec)
+	{
+	  tp += rsize - prec;
+	  rsize = prec;
+	}
+      rp = r->_mp_d;
+      MPN_COPY (rp, tp, rsize);
+      r->_mp_exp = u->_mp_exp + v->_mp_exp - adj;
+      r->_mp_size = sign_product >= 0 ? rsize : -rsize;
+    }
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/mul_2exp.c b/src/gmp/mpf/mul_2exp.c
new file mode 100644
index 000000000..5ec2af71e
--- /dev/null
+++ b/src/gmp/mpf/mul_2exp.c
@@ -0,0 +1,93 @@
+/* mpf_mul_2exp -- Multiply a float by 2^n.
+
+Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_mul_2exp (mpf_ptr r, mpf_srcptr u, unsigned long int exp)
+#else
+mpf_mul_2exp (r, u, exp)
+     mpf_ptr r;
+     mpf_srcptr u;
+     unsigned long int exp;
+#endif
+{
+  mp_srcptr up;
+  mp_ptr rp = r->_mp_d;
+  mp_size_t usize;
+  mp_size_t abs_usize;
+  mp_size_t prec = r->_mp_prec;
+  mp_exp_t uexp = u->_mp_exp;
+
+  usize = u->_mp_size;
+
+  if (usize == 0)
+    {
+      r->_mp_size = 0;
+      r->_mp_exp = 0;
+      return;
+    }
+
+  abs_usize = ABS (usize);
+  up = u->_mp_d;
+
+  if (exp % BITS_PER_MP_LIMB == 0)
+    {
+      prec++;			/* retain more precision here as we don't need
+				   to account for carry-out here */
+      if (abs_usize > prec)
+	{
+	  up += abs_usize - prec;
+	  abs_usize = prec;
+	}
+      if (rp != up)
+	MPN_COPY_INCR (rp, up, abs_usize);
+      r->_mp_exp = uexp + exp / BITS_PER_MP_LIMB;
+    }
+  else
+    {
+      mp_limb_t cy_limb;
+      mp_size_t adj;
+      if (abs_usize > prec)
+	{
+	  up += abs_usize - prec;
+	  abs_usize = prec;
+	  /* Use mpn_rshift since mpn_lshift operates downwards, and we
+	     therefore would clobber part of U before using that part, in case
+	     R is the same variable as U.  */
+	  cy_limb = mpn_rshift (rp + 1, up, abs_usize, (-exp) % BITS_PER_MP_LIMB);
+	  rp[0] = cy_limb;
+	  adj = rp[abs_usize] != 0;
+	}
+      else
+	{
+	  cy_limb = mpn_lshift (rp, up, abs_usize, exp % BITS_PER_MP_LIMB);
+	  rp[abs_usize] = cy_limb;
+	  adj = cy_limb != 0;
+	}
+
+      abs_usize += adj;
+      r->_mp_exp = uexp + exp / BITS_PER_MP_LIMB + adj;
+    }
+  r->_mp_size = usize >= 0 ? abs_usize : -abs_usize;
+}
diff --git a/src/gmp/mpf/mul_ui.c b/src/gmp/mpf/mul_ui.c
new file mode 100644
index 000000000..ba909c9bd
--- /dev/null
+++ b/src/gmp/mpf/mul_ui.c
@@ -0,0 +1,74 @@
+/* mpf_mul_ui -- Multiply a float and an unsigned integer.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_mul_ui (mpf_ptr r, mpf_srcptr u, unsigned long int v)
+#else
+mpf_mul_ui (r, u, v)
+     mpf_ptr r;
+     mpf_srcptr u;
+     unsigned long int v;
+#endif
+{
+  mp_srcptr up;
+  mp_size_t usize;
+  mp_size_t size;
+  mp_size_t prec = r->_mp_prec;
+  mp_limb_t cy_limb;
+  mp_ptr rp;
+
+  usize = u->_mp_size;
+  size = ABS (usize);
+
+  rp = r->_mp_d;
+  up = u->_mp_d;
+  if (size > prec)
+    {
+      up += size - prec;
+      size = prec;
+    }
+
+#if 0
+  /* Since we can do it at almost no cost, remove zero limbs at low end of
+     result. */
+  if (up[0] == 0)
+    up++, size--;
+#endif
+
+  if (size == 0 || v == 0)
+    {
+      r->_mp_size = 0;
+      r->_mp_exp = 0;		/* ??? */
+    }
+  else
+    {
+      cy_limb = mpn_mul_1 (rp, up, size, (mp_limb_t) v);
+      rp[size] = cy_limb;
+      cy_limb = cy_limb != 0;
+      r->_mp_exp = u->_mp_exp + cy_limb;
+      size += cy_limb;
+      r->_mp_size = usize >= 0 ? size : -size;
+    }
+}
diff --git a/src/gmp/mpf/neg.c b/src/gmp/mpf/neg.c
new file mode 100644
index 000000000..b5e7de100
--- /dev/null
+++ b/src/gmp/mpf/neg.c
@@ -0,0 +1,59 @@
+/* mpf_neg -- Negate a float.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_neg (mpf_ptr r, mpf_srcptr u)
+#else
+mpf_neg (r, u)
+     mpf_ptr r;
+     mpf_srcptr u;
+#endif
+{
+  mp_size_t size;
+
+  size = -u->_mp_size;
+  if (r != u)
+    {
+      mp_size_t prec;
+      mp_size_t asize;
+      mp_ptr rp, up;
+
+      prec = r->_mp_prec + 1;	/* lie not to lose precision in assignment */
+      asize = ABS (size);
+      rp = r->_mp_d;
+      up = u->_mp_d;
+
+      if (asize > prec)
+	{
+	  up += asize - prec;
+	  asize = prec;
+	}
+
+      MPN_COPY (rp, up, asize);
+      r->_mp_exp = u->_mp_exp;
+      size = size >= 0 ? asize : -asize;
+    }
+  r->_mp_size = size;
+}
diff --git a/src/gmp/mpf/out_str.c b/src/gmp/mpf/out_str.c
new file mode 100644
index 000000000..96424e2db
--- /dev/null
+++ b/src/gmp/mpf/out_str.c
@@ -0,0 +1,91 @@
+/* mpf_out_str (stream, base, n_digits, op) -- Print N_DIGITS digits from
+   the float OP to STREAM in base BASE.  Return the number of characters
+   written, or 0 if an error occurred.
+
+Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <string.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+size_t
+#if __STDC__
+mpf_out_str (FILE *stream, int base, size_t n_digits, mpf_srcptr op)
+#else
+mpf_out_str (stream, base, n_digits, op)
+     FILE *stream;
+     int base;
+     size_t n_digits;
+     mpf_srcptr op;
+#endif
+{
+  char *str;
+  mp_exp_t exp;
+  size_t written;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  if (base == 0)
+    base = 10;
+  if (n_digits == 0)
+    n_digits = (((op->_mp_prec - 1) * BITS_PER_MP_LIMB)
+		* __mp_bases[base].chars_per_bit_exactly);
+
+  if (stream == 0)
+    stream = stdout;
+
+  str = (char *) TMP_ALLOC (n_digits + 2); /* extra for minus sign and \0 */
+
+  mpf_get_str (str, &exp, base, n_digits, op);
+  n_digits = strlen (str);
+
+  written = 0;
+
+  /* Write sign */
+  if (str[0] == '-')
+    {
+      str++;
+      fputc ('-', stream);
+      written = 1;
+      n_digits--;
+    }
+
+  fwrite ("0.", 1, 2, stream);
+  written += 2;
+
+  /* Write mantissa */
+  {
+    size_t fwret;
+    fwret = fwrite (str, 1, n_digits, stream);
+    written += fwret;
+  }
+
+  /* Write exponent */
+  {
+    int fpret;
+    fpret = fprintf (stream, (base <= 10 ? "e%ld" : "@%ld"), exp);
+    written += fpret;
+  }
+
+  TMP_FREE (marker);
+  return ferror (stream) ? 0 : written;
+}
diff --git a/src/gmp/mpf/pow_ui.c b/src/gmp/mpf/pow_ui.c
new file mode 100644
index 000000000..20433e2c6
--- /dev/null
+++ b/src/gmp/mpf/pow_ui.c
@@ -0,0 +1,52 @@
+/* mpf_pow_ui -- Compute b^e.
+
+Copyright (C) 1998, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_pow_ui (mpf_ptr r, mpf_srcptr b, unsigned long int e)
+#else
+mpf_pow_ui (r, b, e)
+     mpf_ptr r;
+     mpf_srcptr b;
+     unsigned long int e;
+#endif
+{
+  mpf_t b2;
+  unsigned long int e2;
+
+  mpf_init2 (b2, mpf_get_prec (r));
+  mpf_set (b2, b);
+  mpf_set_ui (r, 1);
+
+  if ((e & 1) != 0)
+    mpf_set (r, b2);
+  for (e2 = e >> 1; e2 != 0; e2 >>= 1)
+    {
+      mpf_mul (b2, b2, b2);
+      if ((e2 & 1) != 0)
+	mpf_mul (r, r, b2);
+    }
+
+  mpf_clear (b2);
+}
diff --git a/src/gmp/mpf/random2.c b/src/gmp/mpf/random2.c
new file mode 100644
index 000000000..22269cecd
--- /dev/null
+++ b/src/gmp/mpf/random2.c
@@ -0,0 +1,65 @@
+/* mpf_random2 -- Generate a positive random mpf_t of specified size, with
+   long runs of consecutive ones and zeros in the binary representation.
+   Intended for testing of other MP routines.
+
+Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined (__hpux) || defined (__alpha)  || defined (__svr4__) || defined (__SVR4)
+/* HPUX lacks random().  DEC OSF/1 1.2 random() returns a double.  */
+long mrand48 ();
+static inline long
+random ()
+{
+  return mrand48 ();
+}
+#else
+long random ();
+#endif
+
+void
+#if __STDC__
+mpf_random2 (mpf_ptr x, mp_size_t size, mp_exp_t exp)
+#else
+mpf_random2 (x, size, exp)
+     mpf_ptr x;
+     mp_size_t size;
+     mp_exp_t exp;
+#endif
+{
+  mp_size_t asize;
+  mp_size_t prec = x->_mp_prec;
+
+  asize = ABS (size);
+  if (asize != 0)
+    {
+      if (asize > prec + 1)
+	asize = prec + 1;
+
+      mpn_random2 (x->_mp_d, asize);
+    }
+
+  if (exp != 0)
+    exp = random () % (2 * exp) - exp;
+  x->_mp_exp = asize == 0 ? 0 : exp;
+  x->_mp_size = size < 0 ? -asize : asize;
+}
diff --git a/src/gmp/mpf/reldiff.c b/src/gmp/mpf/reldiff.c
new file mode 100644
index 000000000..a3c6f2e0b
--- /dev/null
+++ b/src/gmp/mpf/reldiff.c
@@ -0,0 +1,52 @@
+/* mpf_reldiff -- Generate the relative difference of two floats.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_reldiff (mpf_t rdiff, mpf_srcptr x, mpf_srcptr y)
+#else
+mpf_reldiff (rdiff, x, y)
+     mpf_t rdiff;
+     mpf_srcptr x;
+     mpf_srcptr y;
+#endif
+{
+  if (mpf_cmp_ui (x, 0) == 0)
+    {
+      mpf_set_ui (rdiff, (unsigned long int) (mpf_sgn (y) != 0));
+    }
+  else
+    {
+      mpf_t d;
+      mp_limb_t tmp_limb[2];
+
+      d->_mp_prec = 1;
+      d->_mp_d = tmp_limb;
+
+      mpf_sub (d, x, y);
+      mpf_abs (d, d);
+      mpf_div (rdiff, d, x);
+    }
+}
+
diff --git a/src/gmp/mpf/set.c b/src/gmp/mpf/set.c
new file mode 100644
index 000000000..681fd2330
--- /dev/null
+++ b/src/gmp/mpf/set.c
@@ -0,0 +1,53 @@
+/* mpf_set -- Assign a float from another float.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_set (mpf_ptr r, mpf_srcptr u)
+#else
+mpf_set (r, u)
+     mpf_ptr r;
+     mpf_srcptr u;
+#endif
+{
+  mp_ptr rp, up;
+  mp_size_t size, asize;
+  mp_size_t prec;
+
+  prec = r->_mp_prec + 1;		/* lie not to lose precision in assignment */
+  size = u->_mp_size;
+  asize = ABS (size);
+  rp = r->_mp_d;
+  up = u->_mp_d;
+
+  if (asize > prec)
+    {
+      up += asize - prec;
+      asize = prec;
+    }
+
+  MPN_COPY (rp, up, asize);
+  r->_mp_exp = u->_mp_exp;
+  r->_mp_size = size >= 0 ? asize : -asize;
+}
diff --git a/src/gmp/mpf/set_d.c b/src/gmp/mpf/set_d.c
new file mode 100644
index 000000000..41b8a9cba
--- /dev/null
+++ b/src/gmp/mpf/set_d.c
@@ -0,0 +1,47 @@
+/* mpf_set_d -- Assign a float from a IEEE double.
+
+Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_set_d (mpf_ptr r, double d)
+#else
+mpf_set_d (r, d)
+     mpf_ptr r;
+     double d;
+#endif
+{
+  int negative;
+
+  if (d == 0)
+    {
+      SIZ(r) = 0;
+      EXP(r) = 0;
+      return;
+    }
+  negative = d < 0;
+  d = ABS (d);
+
+  EXP(r) = __gmp_extract_double (PTR(r), d);
+  SIZ(r) = negative ? -LIMBS_PER_DOUBLE : LIMBS_PER_DOUBLE;
+}
diff --git a/src/gmp/mpf/set_dfl_prec.c b/src/gmp/mpf/set_dfl_prec.c
new file mode 100644
index 000000000..60069c028
--- /dev/null
+++ b/src/gmp/mpf/set_dfl_prec.c
@@ -0,0 +1,40 @@
+/* mpf_set_default_prec --
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_size_t __gmp_default_fp_limb_precision
+  = (53 + 2 * BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+
+void
+#if __STDC__
+mpf_set_default_prec (unsigned long int prec_in_bits)
+#else
+mpf_set_default_prec (prec_in_bits)
+     unsigned long int prec_in_bits;
+#endif
+{
+  mp_size_t prec;
+
+  prec = (MAX (53, prec_in_bits) + 2 * BITS_PER_MP_LIMB - 1)/BITS_PER_MP_LIMB;
+  __gmp_default_fp_limb_precision = prec;
+}
diff --git a/src/gmp/mpf/set_prc.c b/src/gmp/mpf/set_prc.c
new file mode 100644
index 000000000..08e920151
--- /dev/null
+++ b/src/gmp/mpf/set_prc.c
@@ -0,0 +1,57 @@
+/* mpf_set_prec(x) -- Change the precision of x.
+
+Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_set_prec (mpf_ptr x, unsigned long int prec_in_bits)
+#else
+mpf_set_prec (x, prec_in_bits)
+     mpf_ptr x;
+     unsigned long int prec_in_bits;
+#endif
+{
+  mp_size_t prec;
+  mp_size_t size = ABS (x->_mp_size);
+
+  prec = (MAX (53, prec_in_bits) + 2 * BITS_PER_MP_LIMB - 1)/BITS_PER_MP_LIMB;
+
+  /* We want the most significant limbs, so move the limbs down if we are
+     about to truncate the value.  */
+  if (size > prec + 1)
+    {
+      mp_size_t offset = size - (prec + 1);
+      mp_ptr xp = x->_mp_d;
+
+      MPN_COPY_INCR (xp, xp + offset, prec + 1);
+    }
+
+  x->_mp_d = (mp_ptr) (*_mp_reallocate_func)
+    (x->_mp_d,
+     (x->_mp_prec + 1) * BYTES_PER_MP_LIMB, (prec + 1) * BYTES_PER_MP_LIMB);
+  x->_mp_prec = prec;
+
+  /* If the precision decreased, truncate the number.  */
+  if (size > prec + 1)
+    x->_mp_size = x->_mp_size >= 0 ? (prec + 1) : -(prec + 1);
+}
diff --git a/src/gmp/mpf/set_prc_raw.c b/src/gmp/mpf/set_prc_raw.c
new file mode 100644
index 000000000..4b63a4fde
--- /dev/null
+++ b/src/gmp/mpf/set_prc_raw.c
@@ -0,0 +1,39 @@
+/* mpf_set_prec_raw(x,bits) -- Change the precision of x without changing
+   allocation.  For proper operation, the original precision need to be reset
+   sooner or later.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_set_prec_raw (mpf_ptr x, unsigned long int prec_in_bits)
+#else
+mpf_set_prec_raw (x, prec_in_bits)
+     mpf_ptr x;
+     unsigned long int prec_in_bits;
+#endif
+{
+  mp_size_t prec;
+  prec = (MAX (53, prec_in_bits) + 2 * BITS_PER_MP_LIMB - 1)/BITS_PER_MP_LIMB;
+  x->_mp_prec = prec;
+}
diff --git a/src/gmp/mpf/set_q.c b/src/gmp/mpf/set_q.c
new file mode 100644
index 000000000..fa7f57285
--- /dev/null
+++ b/src/gmp/mpf/set_q.c
@@ -0,0 +1,149 @@
+/* mpf_set_q (mpf_t rop, mpq_t op) -- Convert the rational op to the float rop.
+
+Copyright (C) 1996, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpf_set_q (mpf_t r, mpq_srcptr q)
+#else
+mpf_set_q (r, q)
+     mpf_t r;
+     mpq_srcptr q;
+#endif
+{
+  mp_ptr np, dp;
+  mp_ptr rp;
+  mp_size_t nsize, dsize;
+  mp_size_t qsize, rsize;
+  mp_size_t sign_quotient;
+  unsigned normalization_steps;
+  mp_limb_t qlimb;
+  mp_ptr qp;
+  mp_size_t prec;
+  mp_exp_t exp;
+  TMP_DECL (marker);
+
+  nsize = SIZ (&q->_mp_num);
+  dsize = SIZ (&q->_mp_den);
+
+  if (nsize == 0)
+    {
+      SIZ (r) = 0;
+      EXP (r) = 0;
+      return;
+    }
+
+  prec = PREC (r) + 1;
+
+  TMP_MARK (marker);
+
+  qp = PTR (r);
+
+  sign_quotient = nsize ^ dsize;
+  nsize = ABS (nsize);
+  dsize = ABS (dsize);
+  np = PTR (&q->_mp_num);
+  dp = PTR (&q->_mp_den);
+
+  exp = nsize - dsize;
+
+  if (nsize > prec)
+    {
+      np += nsize - prec;
+      nsize = prec;
+    }
+  if (dsize > prec)
+    {
+      dp += dsize - prec;
+      dsize = prec;
+    }
+
+  rsize = MAX (nsize, dsize);
+  rp = (mp_ptr) TMP_ALLOC ((rsize + 1) * BYTES_PER_MP_LIMB);
+
+  count_leading_zeros (normalization_steps, dp[dsize - 1]);
+
+  /* Normalize the denominator, i.e. make its most significant bit set by
+     shifting it NORMALIZATION_STEPS bits to the left.  Also shift the
+     numerator the same number of steps (to keep the quotient the same!).  */
+  if (normalization_steps != 0)
+    {
+      mp_ptr tp;
+      mp_limb_t nlimb;
+
+      /* Shift up the denominator setting the most significant bit of
+	 the most significant limb.  Use temporary storage not to clobber
+	 the original contents of the denominator.  */
+      tp = (mp_ptr) TMP_ALLOC (dsize * BYTES_PER_MP_LIMB);
+      mpn_lshift (tp, dp, dsize, normalization_steps);
+      dp = tp;
+
+      if (rsize != nsize)
+	{
+	  MPN_ZERO (rp, rsize - nsize);
+	  nlimb = mpn_lshift (rp + (rsize - nsize),
+			      np, nsize, normalization_steps);
+	}
+      else
+	{
+	  nlimb = mpn_lshift (rp, np, rsize, normalization_steps);
+	}
+      if (nlimb != 0)
+	{
+	  rp[rsize] = nlimb;
+	  exp++;
+	  /* Don't just increase rsize, chop off rp at the low end instead.  */
+	  if (rsize == prec)
+	    rp++;
+	  else
+	    rsize++;
+	}
+    }
+  else
+    {
+      if (rsize != nsize)
+	{
+	  MPN_ZERO (rp, rsize - nsize);
+	  MPN_COPY (rp + (rsize - nsize), np, nsize);
+	}
+      else
+	{
+	  MPN_COPY (rp, np, rsize);
+	}
+    }
+
+  qlimb = mpn_divrem (qp, prec - 1 - (rsize - dsize), rp, rsize, dp, dsize);
+  qsize = prec - 1;
+  if (qlimb)
+    {
+      qp[qsize] = qlimb;
+      qsize++;
+      exp++;
+    }
+
+  EXP (r) = exp;
+  SIZ (r) = sign_quotient >= 0 ? qsize : -qsize;
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/set_si.c b/src/gmp/mpf/set_si.c
new file mode 100644
index 000000000..9aa70ba3b
--- /dev/null
+++ b/src/gmp/mpf/set_si.c
@@ -0,0 +1,51 @@
+/* mpf_set_si() -- Assign a float from a signed int.
+
+Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_set_si (mpf_ptr x, long int val)
+#else
+mpf_set_si (x, val)
+     mpf_ptr x;
+     long int val;
+#endif
+{
+  if (val > 0)
+    {
+      x->_mp_d[0] = val;
+      x->_mp_size = 1;
+      x->_mp_exp = 1;
+    }
+  else if (val < 0)
+    {
+      x->_mp_d[0] = (unsigned long) -val;
+      x->_mp_size = -1;
+      x->_mp_exp = 1;
+    }
+  else
+    {
+      x->_mp_size = 0;
+      x->_mp_exp = 0;
+    }
+}
diff --git a/src/gmp/mpf/set_str.c b/src/gmp/mpf/set_str.c
new file mode 100644
index 000000000..e6f2fdcc5
--- /dev/null
+++ b/src/gmp/mpf/set_str.c
@@ -0,0 +1,322 @@
+/* mpf_set_str (dest, string, base) -- Convert the string STRING
+   in base BASE to a float in dest.  If BASE is zero, the leading characters
+   of STRING is used to figure out the base.
+
+Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <string.h>
+#include <ctype.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+long int strtol _PROTO ((const char *, char **ptr, int));
+
+static int
+#if __STDC__
+digit_value_in_base (int c, int base)
+#else
+digit_value_in_base (c, base)
+     int c;
+     int base;
+#endif
+{
+  int digit;
+
+  if (isdigit (c))
+    digit = c - '0';
+  else if (islower (c))
+    digit = c - 'a' + 10;
+  else if (isupper (c))
+    digit = c - 'A' + 10;
+  else
+    return -1;
+
+  if (digit < base)
+    return digit;
+  return -1;
+}
+
+int
+#if __STDC__
+mpf_set_str (mpf_ptr x, const char *str, int base)
+#else
+mpf_set_str (x, str, base)
+     mpf_ptr x;
+     char *str;
+     int base;
+#endif
+{
+  size_t str_size;
+  char *s, *begs;
+  size_t i;
+  mp_size_t xsize;
+  int c;
+  int negative;
+  char *dotpos = 0;
+  int expflag;
+  int decimal_exponent_flag;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  c = *str;
+
+  /* Skip whitespace.  */
+  while (isspace (c))
+    c = *++str;
+
+  negative = 0;
+  if (c == '-')
+    {
+      negative = 1;
+      c = *++str;
+    }
+
+  decimal_exponent_flag = base < 0;
+  base = ABS (base);
+
+  if (digit_value_in_base (c, base == 0 ? 10 : base) < 0
+      && (c != '.' || digit_value_in_base (str[1], base == 0 ? 10 : base) < 0))
+    return -1;			/* error if no digits */
+
+  /* If BASE is 0, try to find out the base by looking at the initial
+     characters.  */
+  if (base == 0)
+    {
+      base = 10;
+#if 0
+      if (c == '0')
+	{
+	  base = 8;
+	  if (str[1] == 'x' || str[1] == 'X')
+	    {
+	      base = 16;
+	      str += 2;
+	      c = *str;
+	    }
+	}
+#endif
+    }
+
+  expflag = 0;
+  str_size = strlen (str);
+  for (i = 0; i < str_size; i++)
+    {
+      c = str[i];
+      if (c == '@' || (base <= 10 && (c == 'e' || c == 'E')))
+	{
+	  expflag = 1;
+	  str_size = i;
+	  break;
+	}
+
+    }
+
+  s = begs = (char *) TMP_ALLOC (str_size + 1);
+
+  for (i = 0; i < str_size; i++)
+    {
+      c = *str;
+      if (!isspace (c))
+	{
+	  int dig;
+
+	  if (c == '.')
+	    {
+	      if (dotpos != 0)
+		{
+		  TMP_FREE (marker);
+		  return -1;
+		}
+	      dotpos = s;
+	    }
+	  else
+	    {
+	      dig = digit_value_in_base (c, base);
+	      if (dig < 0)
+		{
+		  TMP_FREE (marker);
+		  return -1;
+		}
+	      *s++ = dig;
+	    }
+	}
+      c = *++str;
+    }
+
+  str_size = s - begs;
+
+  xsize = str_size / __mp_bases[base].chars_per_limb + 2;
+  {
+    long exp_in_base;
+    mp_size_t ralloc, rsize, msize;
+    int cnt, i;
+    mp_ptr mp, tp, rp;
+    mp_exp_t exp_in_limbs;
+    mp_size_t prec = x->_mp_prec + 1;
+    int divflag;
+    mp_size_t madj, radj;
+
+    mp = (mp_ptr) TMP_ALLOC (xsize * BYTES_PER_MP_LIMB);
+    msize = mpn_set_str (mp, (unsigned char *) begs, str_size, base);
+
+    if (msize == 0)
+      {
+	x->_mp_size = 0;
+	x->_mp_exp = 0;
+	TMP_FREE (marker);
+	return 0;
+      }
+
+    madj = 0;
+    /* Ignore excess limbs in MP,MSIZE.  */
+    if (msize > prec)
+      {
+	madj = msize - prec;
+	mp += msize - prec;
+	msize = prec;
+      }
+
+    if (expflag != 0)
+      exp_in_base = strtol (str + 1, (char **) 0,
+			    decimal_exponent_flag ? 10 : base);
+    else
+      exp_in_base = 0;
+    if (dotpos != 0)
+      exp_in_base -= s - dotpos;
+    divflag = exp_in_base < 0;
+    exp_in_base = ABS (exp_in_base);
+
+    if (exp_in_base == 0)
+      {
+	MPN_COPY (x->_mp_d, mp, msize);
+	x->_mp_size = negative ? -msize : msize;
+	x->_mp_exp = msize + madj;
+	TMP_FREE (marker);
+	return 0;
+      }
+
+    radj = 0;			/* counts number of ignored low limbs in r */
+
+    ralloc = 2 * (prec + 1);
+    rp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+    tp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+
+    rp[0] = base;
+    rsize = 1;
+    count_leading_zeros (cnt, exp_in_base);
+    for (i = BITS_PER_MP_LIMB - cnt - 2; i >= 0; i--)
+      {
+	mpn_mul_n (tp, rp, rp, rsize);
+	rsize = 2 * rsize;
+	rsize -= tp[rsize - 1] == 0;
+	radj <<= 1;
+
+	if (rsize > prec)
+	  {
+	    radj += rsize - prec;
+	    MPN_COPY_INCR (rp, tp + rsize - prec, prec);
+	    rsize = prec;
+	  }
+	else
+	  MP_PTR_SWAP (rp, tp);
+
+	if (((exp_in_base >> i) & 1) != 0)
+	  {
+	    mp_limb_t cy;
+	    cy = mpn_mul_1 (rp, rp, rsize, (mp_limb_t) base);
+	    rp[rsize] = cy;
+	    rsize += cy != 0;
+	  }
+      }
+
+    if (rsize > prec)
+      {
+	radj += rsize - prec;
+	rp += rsize - prec;
+	rsize = prec;
+      }
+
+    if (divflag)
+      {
+	mp_ptr qp;
+	mp_limb_t qlimb;
+	if (msize < rsize)
+	  {
+	    /* Pad out MP,MSIZE for current divrem semantics.  */
+	    mp_ptr tmp = (mp_ptr) TMP_ALLOC ((rsize + 1) * BYTES_PER_MP_LIMB);
+	    MPN_ZERO (tmp, rsize - msize);
+	    MPN_COPY (tmp + rsize - msize, mp, msize);
+	    mp = tmp;
+	    madj -= rsize - msize;
+	    msize = rsize;
+	  }
+	count_leading_zeros (cnt, rp[rsize - 1]);
+	if (cnt != 0)
+	  {
+	    mp_limb_t cy;
+	    mpn_lshift (rp, rp, rsize, cnt);
+	    cy = mpn_lshift (mp, mp, msize, cnt);
+	    if (cy)
+	      mp[msize++] = cy;
+	  }
+
+	qp = (mp_ptr) TMP_ALLOC ((prec + 1) * BYTES_PER_MP_LIMB);
+	qlimb = mpn_divrem (qp, prec - (msize - rsize), mp, msize, rp, rsize);
+	tp = qp;
+	exp_in_limbs = qlimb + (msize - rsize) + (madj - radj);
+	rsize = prec;
+	if (qlimb != 0)
+	  {
+	    tp[prec] = qlimb;
+	    /* Skip the least significant limb not to overrun the destination
+	       variable.  */
+	    tp++;
+	  }
+      }
+    else
+      {
+	tp = (mp_ptr) TMP_ALLOC ((rsize + msize) * BYTES_PER_MP_LIMB);
+	if (rsize > msize)
+	  mpn_mul (tp, rp, rsize, mp, msize);
+	else
+	  mpn_mul (tp, mp, msize, rp, rsize);
+	rsize += msize;
+	rsize -= tp[rsize - 1] == 0;
+	exp_in_limbs = rsize + madj + radj;
+
+	if (rsize > prec)
+	  {
+	    tp += rsize - prec;
+	    rsize = prec;
+	    exp_in_limbs += 0;
+	  }
+      }
+
+    MPN_COPY (x->_mp_d, tp, rsize);
+    x->_mp_size = negative ? -rsize : rsize;
+    x->_mp_exp = exp_in_limbs;
+    TMP_FREE (marker);
+    return 0;
+  }
+}
diff --git a/src/gmp/mpf/set_ui.c b/src/gmp/mpf/set_ui.c
new file mode 100644
index 000000000..5d492faf4
--- /dev/null
+++ b/src/gmp/mpf/set_ui.c
@@ -0,0 +1,45 @@
+/* mpf_set_ui() -- Assign a float from an unsigned int.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_set_ui (mpf_ptr x, unsigned long int val)
+#else
+mpf_set_ui (x, val)
+     mpf_ptr x;
+     unsigned long int val;
+#endif
+{
+  if (val != 0)
+    {
+      x->_mp_d[0] = val;
+      x->_mp_size = 1;
+      x->_mp_exp = 1;
+    }
+  else
+    {
+      x->_mp_size = 0;
+      x->_mp_exp = 0;
+    }
+}
diff --git a/src/gmp/mpf/set_z.c b/src/gmp/mpf/set_z.c
new file mode 100644
index 000000000..f417b2ef2
--- /dev/null
+++ b/src/gmp/mpf/set_z.c
@@ -0,0 +1,54 @@
+/* mpf_set_z -- Assign a float from an integer.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_set_z (mpf_ptr r, mpz_srcptr u)
+#else
+mpf_set_z (r, u)
+     mpf_ptr r;
+     mpz_srcptr u;
+#endif
+{
+  mp_ptr rp, up;
+  mp_size_t size, asize;
+  mp_size_t prec;
+
+  prec = PREC (r) + 1;
+  size = SIZ (u);
+  asize = ABS (size);
+  rp = PTR (r);
+  up = PTR (u);
+
+  EXP (r) = asize;
+
+  if (asize > prec)
+    {
+      up += asize - prec;
+      asize = prec;
+    }
+
+  MPN_COPY (rp, up, asize);
+  SIZ (r) = size >= 0 ? asize : -asize;
+}
diff --git a/src/gmp/mpf/size.c b/src/gmp/mpf/size.c
new file mode 100644
index 000000000..7d7adc6ef
--- /dev/null
+++ b/src/gmp/mpf/size.c
@@ -0,0 +1,35 @@
+/* mpf_size(x) -- return the number of limbs currently used by the
+   value of the float X.
+
+Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+size_t
+#if __STDC__
+mpf_size (mpf_srcptr x)
+#else
+mpf_size (x)
+     mpf_srcptr x;
+#endif
+{
+  return ABS (x->_mp_size);
+}
diff --git a/src/gmp/mpf/sqrt.c b/src/gmp/mpf/sqrt.c
new file mode 100644
index 000000000..efdd154b3
--- /dev/null
+++ b/src/gmp/mpf/sqrt.c
@@ -0,0 +1,77 @@
+/* mpf_sqrt -- Compute the square root of a float.
+
+Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_sqrt (mpf_ptr r, mpf_srcptr u)
+#else
+mpf_sqrt (r, u)
+     mpf_ptr r;
+     mpf_srcptr u;
+#endif
+{
+  mp_size_t usize;
+  mp_ptr up, tp;
+  mp_size_t prec;
+  mp_exp_t tsize, rexp;
+  TMP_DECL (marker);
+
+  usize = u->_mp_size;
+  if (usize <= 0)
+    {
+      if (usize < 0)
+        SQRT_OF_NEGATIVE;
+      r->_mp_size = 0;
+      r->_mp_exp = 0;
+      return;
+    }
+
+  TMP_MARK (marker);
+
+  prec = r->_mp_prec;
+  rexp = (u->_mp_exp + 1) >> 1;	/* round towards -inf */
+  tsize = 2 * prec + (u->_mp_exp & 1);
+
+  up = u->_mp_d;
+  tp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
+
+  if (usize > tsize)
+    {
+      up += usize - tsize;
+      usize = tsize;
+      MPN_COPY (tp, up, tsize);
+    }
+  else
+    {
+      MPN_ZERO (tp, tsize - usize);
+      MPN_COPY (tp + (tsize - usize), up, usize);
+    }
+
+  mpn_sqrtrem (r->_mp_d, NULL, tp, tsize);
+
+  r->_mp_size = (tsize + 1) / 2;
+  r->_mp_exp = rexp;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/sqrt_ui.c b/src/gmp/mpf/sqrt_ui.c
new file mode 100644
index 000000000..2c69193b7
--- /dev/null
+++ b/src/gmp/mpf/sqrt_ui.c
@@ -0,0 +1,62 @@
+/* mpf_sqrt_ui -- Compute the square root of an unsigned integer.
+
+Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_sqrt_ui (mpf_ptr r, unsigned long int u)
+#else
+mpf_sqrt_ui (r, u)
+     mpf_ptr r;
+     unsigned long int u;
+#endif
+{
+  mp_size_t rsize;
+  mp_ptr tp;
+  mp_size_t prec;
+  TMP_DECL (marker);
+
+  if (u == 0)
+    {
+      r->_mp_size = 0;
+      r->_mp_exp = 0;
+      return;
+    }
+
+  TMP_MARK (marker);
+
+  prec = r->_mp_prec;
+  rsize = 2 * prec + 1;
+
+  tp = (mp_ptr) TMP_ALLOC (rsize * BYTES_PER_MP_LIMB);
+
+  MPN_ZERO (tp, rsize - 1);
+  tp[rsize - 1] = u;
+
+  mpn_sqrtrem (r->_mp_d, NULL, tp, rsize);
+
+  r->_mp_size = prec + 1;
+  r->_mp_exp = 1;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/sub.c b/src/gmp/mpf/sub.c
new file mode 100644
index 000000000..2cd7edfa6
--- /dev/null
+++ b/src/gmp/mpf/sub.c
@@ -0,0 +1,412 @@
+/* mpf_sub -- Subtract two floats.
+
+Copyright (C) 1993, 1994, 1995, 1996, 1999, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_sub (mpf_ptr r, mpf_srcptr u, mpf_srcptr v)
+#else
+mpf_sub (r, u, v)
+     mpf_ptr r;
+     mpf_srcptr u;
+     mpf_srcptr v;
+#endif
+{
+  mp_srcptr up, vp;
+  mp_ptr rp, tp;
+  mp_size_t usize, vsize, rsize;
+  mp_size_t prec;
+  mp_exp_t exp;
+  mp_size_t ediff;
+  int negate;
+  TMP_DECL (marker);
+
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+
+  /* Handle special cases that don't work in generic code below.  */
+  if (usize == 0)
+    {
+      mpf_neg (r, v);
+      return;
+    }
+  if (vsize == 0)
+    {
+      mpf_set (r, u);
+      return;
+    }
+
+  /* If signs of U and V are different, perform addition.  */
+  if ((usize ^ vsize) < 0)
+    {
+      __mpf_struct v_negated;
+      v_negated._mp_size = -vsize;
+      v_negated._mp_exp = v->_mp_exp;
+      v_negated._mp_d = v->_mp_d;
+      mpf_add (r, u, &v_negated);
+      return;
+    }
+
+  TMP_MARK (marker);
+
+  /* Signs are now known to be the same.  */
+  negate = usize < 0;
+
+  /* Make U be the operand with the largest exponent.  */
+  if (u->_mp_exp < v->_mp_exp)
+    {
+      mpf_srcptr t;
+      t = u; u = v; v = t;
+      negate ^= 1;
+      usize = u->_mp_size;
+      vsize = v->_mp_size;
+    }
+
+  usize = ABS (usize);
+  vsize = ABS (vsize);
+  up = u->_mp_d;
+  vp = v->_mp_d;
+  rp = r->_mp_d;
+  prec = r->_mp_prec + 1;
+  exp = u->_mp_exp;
+  ediff = u->_mp_exp - v->_mp_exp;
+
+  /* If ediff is 0 or 1, we might have a situation where the operands are
+     extremely close.  We need to scan the operands from the most significant
+     end ignore the initial parts that are equal.  */
+  if (ediff <= 1)
+    {
+      if (ediff == 0)
+	{
+	  /* Skip leading limbs in U and V that are equal.  */
+	  if (up[usize - 1] == vp[vsize - 1])
+	    {
+	      /* This loop normally exits immediately.  Optimize for that.  */
+	      do
+		{
+		  usize--;
+		  vsize--;
+		  exp--;
+
+		  if (usize == 0)
+		    {
+		      if (vsize > prec)
+			{
+			  vp += vsize - prec;
+			  vsize = prec;
+			}
+		      rsize = vsize;
+		      tp = (mp_ptr) vp;
+		      negate ^= 1;
+		      goto normalize;
+		    }
+		  if (vsize == 0)
+		    {
+		      if (usize > prec)
+			{
+			  up += usize - prec;
+			  usize = prec;
+			}
+		      rsize = usize;
+		      tp = (mp_ptr) up;
+		      goto normalize;
+		    }
+		}
+	      while (up[usize - 1] == vp[vsize - 1]);
+	    }
+
+	  if (up[usize - 1] < vp[vsize - 1])
+	    {
+	      /* For simplicity, swap U and V.  Note that since the loop above
+		 wouldn't have exited unless up[usize - 1] and vp[vsize - 1]
+		 were non-equal, this if-statement catches all cases where U
+		 is smaller than V.  */
+	      MPN_SRCPTR_SWAP (up,usize, vp,vsize);
+	      negate ^= 1;
+	      /* negating ediff not necessary since it is 0.  */
+	    }
+
+	  /* Check for
+	     x+1 00000000 ...
+	      x  ffffffff ... */
+	  if (up[usize - 1] != vp[vsize - 1] + 1)
+	    goto general_case;
+	  usize--;
+	  vsize--;
+	  exp--;
+	}
+      else /* ediff == 1 */
+	{
+	  /* Check for
+	     1 00000000 ...
+	     0 ffffffff ... */
+
+	  if (up[usize - 1] != 1 || vp[vsize - 1] != ~(mp_limb_t) 0
+	      || (usize >= 2 && up[usize - 2] != 0))
+	    goto general_case;
+
+	  usize--;
+	  exp--;
+	}
+
+      /* Skip sequences of 00000000/ffffffff */
+      while (vsize != 0 && usize != 0 && up[usize - 1] == 0
+	     && vp[vsize - 1] == ~(mp_limb_t) 0)
+	{
+	  usize--;
+	  vsize--;
+	  exp--;
+	}
+
+      if (usize == 0)
+	{
+	  while (vsize != 0 && vp[vsize - 1] == ~(mp_limb_t) 0)
+	    {
+	      vsize--;
+	      exp--;
+	    }
+	}
+
+      if (usize > prec - 1)
+	{
+	  up += usize - (prec - 1);
+	  usize = prec - 1;
+	}
+      if (vsize > prec - 1)
+	{
+	  vp += vsize - (prec - 1);
+	  vsize = prec - 1;
+	}
+
+      tp = (mp_ptr) TMP_ALLOC (prec * BYTES_PER_MP_LIMB);
+      {
+	mp_limb_t cy_limb;
+	if (vsize == 0)
+	  {
+	    mp_size_t size, i;
+	    size = usize;
+	    for (i = 0; i < size; i++)
+	      tp[i] = up[i];
+	    tp[size] = 1;
+	    rsize = size + 1;
+	    exp++;
+	    goto normalize;
+	  }
+	if (usize == 0)
+	  {
+	    mp_size_t size, i;
+	    size = vsize;
+	    for (i = 0; i < size; i++)
+	      tp[i] = ~vp[i];
+	    cy_limb = 1 - mpn_add_1 (tp, tp, vsize, (mp_limb_t) 1);
+	    rsize = vsize;
+	    if (cy_limb == 0)
+	      {
+		tp[rsize] = 1;
+		rsize++;
+		exp++;
+	      }
+	    goto normalize;
+	  }
+	if (usize >= vsize)
+	  {
+	    /* uuuu     */
+	    /* vv       */
+	    mp_size_t size;
+	    size = usize - vsize;
+	    MPN_COPY (tp, up, size);
+	    cy_limb = mpn_sub_n (tp + size, up + size, vp, vsize);
+	    rsize = usize;
+	  }
+	else /* (usize < vsize) */
+	  {
+	    /* uuuu     */
+	    /* vvvvvvv  */
+	    mp_size_t size, i;
+	    size = vsize - usize;
+	    for (i = 0; i < size; i++)
+	      tp[i] = ~vp[i];
+	    cy_limb = mpn_sub_n (tp + size, up, vp + size, usize);
+	    cy_limb+= mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1);
+	    cy_limb-= mpn_add_1 (tp, tp, vsize, (mp_limb_t) 1);
+	    rsize = vsize;
+	  }
+	if (cy_limb == 0)
+	  {
+	    tp[rsize] = 1;
+	    rsize++;
+	    exp++;
+	  }
+	goto normalize;
+      }
+    }
+
+general_case:
+  /* If U extends beyond PREC, ignore the part that does.  */
+  if (usize > prec)
+    {
+      up += usize - prec;
+      usize = prec;
+    }
+
+  /* If V extends beyond PREC, ignore the part that does.
+     Note that this may make vsize negative.  */
+  if (vsize + ediff > prec)
+    {
+      vp += vsize + ediff - prec;
+      vsize = prec - ediff;
+    }
+
+  /* Allocate temp space for the result.  Allocate
+     just vsize + ediff later???  */
+  tp = (mp_ptr) TMP_ALLOC (prec * BYTES_PER_MP_LIMB);
+
+  if (ediff >= prec)
+    {
+      /* V completely cancelled.  */
+      if (tp != up)
+	MPN_COPY (rp, up, usize);
+      rsize = usize;
+    }
+  else
+    {
+      /* Locate the least significant non-zero limb in (the needed
+	 parts of) U and V, to simplify the code below.  */
+      for (;;)
+	{
+	  if (vsize == 0)
+	    {
+	      MPN_COPY (rp, up, usize);
+	      rsize = usize;
+	      goto done;
+	    }
+	  if (vp[0] != 0)
+	    break;
+	  vp++, vsize--;
+	}
+      for (;;)
+	{
+	  if (usize == 0)
+	    {
+	      MPN_COPY (rp, vp, vsize);
+	      rsize = vsize;
+	      negate ^= 1;
+	      goto done;
+	    }
+	  if (up[0] != 0)
+	    break;
+	  up++, usize--;
+	}
+
+      /* uuuu     |  uuuu     |  uuuu     |  uuuu     |  uuuu    */
+      /* vvvvvvv  |  vv       |    vvvvv  |    v      |       vv */
+
+      if (usize > ediff)
+	{
+	  /* U and V partially overlaps.  */
+	  if (ediff == 0)
+	    {
+	      /* Have to compare the leading limbs of u and v
+		 to determine whether to compute u - v or v - u.  */
+	      if (usize >= vsize)
+		{
+		  /* uuuu     */
+		  /* vv       */
+		  mp_size_t size;
+		  size = usize - vsize;
+		  MPN_COPY (tp, up, size);
+		  mpn_sub_n (tp + size, up + size, vp, vsize);
+		  rsize = usize;
+		}
+	      else /* (usize < vsize) */
+		{
+		  /* uuuu     */
+		  /* vvvvvvv  */
+		  mp_size_t size, i;
+		  size = vsize - usize;
+		  tp[0] = -vp[0];
+		  for (i = 1; i < size; i++)
+		    tp[i] = ~vp[i];
+		  mpn_sub_n (tp + size, up, vp + size, usize);
+		  mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1);
+		  rsize = vsize;
+		}
+	    }
+	  else
+	    {
+	      if (vsize + ediff <= usize)
+		{
+		  /* uuuu     */
+		  /*   v      */
+		  mp_size_t size;
+		  size = usize - ediff - vsize;
+		  MPN_COPY (tp, up, size);
+		  mpn_sub (tp + size, up + size, usize - size, vp, vsize);
+		  rsize = usize;
+		}
+	      else
+		{
+		  /* uuuu     */
+		  /*   vvvvv  */
+		  mp_size_t size, i;
+		  size = vsize + ediff - usize;
+		  tp[0] = -vp[0];
+		  for (i = 1; i < size; i++)
+		    tp[i] = ~vp[i];
+		  mpn_sub (tp + size, up, usize, vp + size, usize - ediff);
+		  mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1);
+		  rsize = vsize + ediff;
+		}
+	    }
+	}
+      else
+	{
+	  /* uuuu     */
+	  /*      vv  */
+	  mp_size_t size, i;
+	  size = vsize + ediff - usize;
+	  tp[0] = -vp[0];
+	  for (i = 1; i < vsize; i++)
+	    tp[i] = ~vp[i];
+	  for (i = vsize; i < size; i++)
+	    tp[i] = ~(mp_limb_t) 0;
+	  mpn_sub_1 (tp + size, up, usize, (mp_limb_t) 1);
+	  rsize = size + usize;
+	}
+
+    normalize:
+      /* Full normalize.  Optimize later.  */
+      while (rsize != 0 && tp[rsize - 1] == 0)
+	{
+	  rsize--;
+	  exp--;
+	}
+      MPN_COPY (rp, tp, rsize);
+    }
+
+ done:
+  r->_mp_size = negate ? -rsize : rsize;
+  r->_mp_exp = exp;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/sub_ui.c b/src/gmp/mpf/sub_ui.c
new file mode 100644
index 000000000..769231e65
--- /dev/null
+++ b/src/gmp/mpf/sub_ui.c
@@ -0,0 +1,49 @@
+/* mpf_sub_ui -- Subtract an unsigned integer from a float.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_sub_ui (mpf_ptr sum, mpf_srcptr u, unsigned long int v)
+#else
+mpf_sub_ui (sum, u, v)
+     mpf_ptr sum;
+     mpf_srcptr u;
+     unsigned long int v;
+#endif
+{
+  __mpf_struct vv;
+  mp_limb_t vl;
+
+  if (v == 0)
+    {
+      mpf_set (sum, u);
+      return;
+    }
+
+  vl = v;
+  vv._mp_size = 1;
+  vv._mp_d = &vl;
+  vv._mp_exp = 1;
+  mpf_sub (sum, u, &vv);
+}
diff --git a/src/gmp/mpf/swap.c b/src/gmp/mpf/swap.c
new file mode 100644
index 000000000..bc20c3948
--- /dev/null
+++ b/src/gmp/mpf/swap.c
@@ -0,0 +1,58 @@
+/* mpf_swap (U, V) -- Swap U and V.
+
+Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_swap (mpf_ptr u, mpf_ptr v)
+#else
+mpf_swap (u, v)
+     mpf_ptr u;
+     mpf_ptr v;
+#endif
+{
+  mp_ptr up, vp;
+  mp_size_t usize, vsize;
+  mp_size_t uprec, vprec;
+  mp_exp_t  uexp, vexp;
+
+  uprec = u->_mp_prec;
+  vprec = v->_mp_prec;
+  v->_mp_prec = uprec;
+  u->_mp_prec = vprec;
+
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+  v->_mp_size = usize;
+  u->_mp_size = vsize;
+
+  uexp = u->_mp_exp;
+  vexp = v->_mp_exp;
+  v->_mp_exp = uexp;
+  u->_mp_exp = vexp;
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+  v->_mp_d = up;
+  u->_mp_d = vp;
+}
diff --git a/src/gmp/mpf/tests/Makefile.am b/src/gmp/mpf/tests/Makefile.am
new file mode 100644
index 000000000..42b2f0d32
--- /dev/null
+++ b/src/gmp/mpf/tests/Makefile.am
@@ -0,0 +1,33 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+check_PROGRAMS = t-add t-sub t-conv t-sqrt t-muldiv t-dm2exp reuse t-get_d \
+  t-misc
+TESTS = $(check_PROGRAMS)
+
+t_add_SOURCES = t-add.c ref.c
+t_sub_SOURCES = t-sub.c ref.c
diff --git a/src/gmp/mpf/tests/Makefile.in b/src/gmp/mpf/tests/Makefile.in
new file mode 100644
index 000000000..40f4eb7d9
--- /dev/null
+++ b/src/gmp/mpf/tests/Makefile.in
@@ -0,0 +1,507 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+check_PROGRAMS = t-add t-sub t-conv t-sqrt t-muldiv t-dm2exp reuse t-get_d \
+  t-misc
+
+TESTS = $(check_PROGRAMS)
+
+t_add_SOURCES = t-add.c ref.c
+t_sub_SOURCES = t-sub.c ref.c
+subdir = mpf/tests
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../../config.h
+CONFIG_CLEAN_FILES = 
+check_PROGRAMS =  t-add$(EXEEXT) t-sub$(EXEEXT) t-conv$(EXEEXT) \
+t-sqrt$(EXEEXT) t-muldiv$(EXEEXT) t-dm2exp$(EXEEXT) reuse$(EXEEXT) \
+t-get_d$(EXEEXT) t-misc$(EXEEXT)
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I../..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+ANSI2KNR = $(top_builddir)/ansi2knr
+reuse_SOURCES = reuse.c
+reuse_OBJECTS =  reuse$U.$(OBJEXT)
+reuse_LDADD = $(LDADD)
+reuse_DEPENDENCIES =  $(top_builddir)/libgmp.la
+reuse_LDFLAGS = 
+am_t_add_OBJECTS =  t-add$U.$(OBJEXT) ref$U.$(OBJEXT)
+t_add_OBJECTS =  $(am_t_add_OBJECTS)
+t_add_LDADD = $(LDADD)
+t_add_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_add_LDFLAGS = 
+t_conv_SOURCES = t-conv.c
+t_conv_OBJECTS =  t-conv$U.$(OBJEXT)
+t_conv_LDADD = $(LDADD)
+t_conv_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_conv_LDFLAGS = 
+t_dm2exp_SOURCES = t-dm2exp.c
+t_dm2exp_OBJECTS =  t-dm2exp$U.$(OBJEXT)
+t_dm2exp_LDADD = $(LDADD)
+t_dm2exp_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_dm2exp_LDFLAGS = 
+t_get_d_SOURCES = t-get_d.c
+t_get_d_OBJECTS =  t-get_d$U.$(OBJEXT)
+t_get_d_LDADD = $(LDADD)
+t_get_d_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_get_d_LDFLAGS = 
+t_misc_SOURCES = t-misc.c
+t_misc_OBJECTS =  t-misc$U.$(OBJEXT)
+t_misc_LDADD = $(LDADD)
+t_misc_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_misc_LDFLAGS = 
+t_muldiv_SOURCES = t-muldiv.c
+t_muldiv_OBJECTS =  t-muldiv$U.$(OBJEXT)
+t_muldiv_LDADD = $(LDADD)
+t_muldiv_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_muldiv_LDFLAGS = 
+t_sqrt_SOURCES = t-sqrt.c
+t_sqrt_OBJECTS =  t-sqrt$U.$(OBJEXT)
+t_sqrt_LDADD = $(LDADD)
+t_sqrt_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_sqrt_LDFLAGS = 
+am_t_sub_OBJECTS =  t-sub$U.$(OBJEXT) ref$U.$(OBJEXT)
+t_sub_OBJECTS =  $(am_t_sub_OBJECTS)
+t_sub_LDADD = $(LDADD)
+t_sub_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_sub_LDFLAGS = 
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  reuse.c $(t_add_SOURCES) t-conv.c t-dm2exp.c t-get_d.c \
+t-misc.c t-muldiv.c t-sqrt.c $(t_sub_SOURCES)
+DIST_COMMON =  Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = reuse.c $(t_add_SOURCES) t-conv.c t-dm2exp.c t-get_d.c t-misc.c t-muldiv.c t-sqrt.c $(t_sub_SOURCES)
+OBJECTS = reuse$U.$(OBJEXT) $(am_t_add_OBJECTS) t-conv$U.$(OBJEXT) t-dm2exp$U.$(OBJEXT) t-get_d$U.$(OBJEXT) t-misc$U.$(OBJEXT) t-muldiv$U.$(OBJEXT) t-sqrt$U.$(OBJEXT) $(am_t_sub_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpf/tests/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-checkPROGRAMS:
+
+clean-checkPROGRAMS:
+	-test -z "$(check_PROGRAMS)" || rm -f $(check_PROGRAMS)
+
+distclean-checkPROGRAMS:
+
+maintainer-clean-checkPROGRAMS:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+$(top_builddir)/ansi2knr: $(top_builddir)/ansi2knr.$(OBJEXT)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr
+
+$(top_builddir)/ansi2knr.$(OBJEXT):
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr.$(OBJEXT)
+
+
+mostlyclean-kr:
+	-rm -f *_.c
+
+clean-kr:
+
+distclean-kr:
+
+maintainer-clean-kr:
+
+reuse$(EXEEXT): $(reuse_OBJECTS) $(reuse_DEPENDENCIES)
+	@rm -f reuse$(EXEEXT)
+	$(LINK) $(reuse_LDFLAGS) $(reuse_OBJECTS) $(reuse_LDADD) $(LIBS)
+
+t-add$(EXEEXT): $(t_add_OBJECTS) $(t_add_DEPENDENCIES)
+	@rm -f t-add$(EXEEXT)
+	$(LINK) $(t_add_LDFLAGS) $(t_add_OBJECTS) $(t_add_LDADD) $(LIBS)
+
+t-conv$(EXEEXT): $(t_conv_OBJECTS) $(t_conv_DEPENDENCIES)
+	@rm -f t-conv$(EXEEXT)
+	$(LINK) $(t_conv_LDFLAGS) $(t_conv_OBJECTS) $(t_conv_LDADD) $(LIBS)
+
+t-dm2exp$(EXEEXT): $(t_dm2exp_OBJECTS) $(t_dm2exp_DEPENDENCIES)
+	@rm -f t-dm2exp$(EXEEXT)
+	$(LINK) $(t_dm2exp_LDFLAGS) $(t_dm2exp_OBJECTS) $(t_dm2exp_LDADD) $(LIBS)
+
+t-get_d$(EXEEXT): $(t_get_d_OBJECTS) $(t_get_d_DEPENDENCIES)
+	@rm -f t-get_d$(EXEEXT)
+	$(LINK) $(t_get_d_LDFLAGS) $(t_get_d_OBJECTS) $(t_get_d_LDADD) $(LIBS)
+
+t-misc$(EXEEXT): $(t_misc_OBJECTS) $(t_misc_DEPENDENCIES)
+	@rm -f t-misc$(EXEEXT)
+	$(LINK) $(t_misc_LDFLAGS) $(t_misc_OBJECTS) $(t_misc_LDADD) $(LIBS)
+
+t-muldiv$(EXEEXT): $(t_muldiv_OBJECTS) $(t_muldiv_DEPENDENCIES)
+	@rm -f t-muldiv$(EXEEXT)
+	$(LINK) $(t_muldiv_LDFLAGS) $(t_muldiv_OBJECTS) $(t_muldiv_LDADD) $(LIBS)
+
+t-sqrt$(EXEEXT): $(t_sqrt_OBJECTS) $(t_sqrt_DEPENDENCIES)
+	@rm -f t-sqrt$(EXEEXT)
+	$(LINK) $(t_sqrt_LDFLAGS) $(t_sqrt_OBJECTS) $(t_sqrt_LDADD) $(LIBS)
+
+t-sub$(EXEEXT): $(t_sub_OBJECTS) $(t_sub_DEPENDENCIES)
+	@rm -f t-sub$(EXEEXT)
+	$(LINK) $(t_sub_LDFLAGS) $(t_sub_OBJECTS) $(t_sub_LDADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+ref_.c: ref.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/ref.c; then echo $(srcdir)/ref.c; else echo ref.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > ref_.c
+reuse_.c: reuse.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/reuse.c; then echo $(srcdir)/reuse.c; else echo reuse.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > reuse_.c
+t-add_.c: t-add.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-add.c; then echo $(srcdir)/t-add.c; else echo t-add.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-add_.c
+t-conv_.c: t-conv.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-conv.c; then echo $(srcdir)/t-conv.c; else echo t-conv.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-conv_.c
+t-dm2exp_.c: t-dm2exp.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-dm2exp.c; then echo $(srcdir)/t-dm2exp.c; else echo t-dm2exp.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-dm2exp_.c
+t-get_d_.c: t-get_d.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-get_d.c; then echo $(srcdir)/t-get_d.c; else echo t-get_d.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-get_d_.c
+t-misc_.c: t-misc.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-misc.c; then echo $(srcdir)/t-misc.c; else echo t-misc.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-misc_.c
+t-muldiv_.c: t-muldiv.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-muldiv.c; then echo $(srcdir)/t-muldiv.c; else echo t-muldiv.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-muldiv_.c
+t-sqrt_.c: t-sqrt.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-sqrt.c; then echo $(srcdir)/t-sqrt.c; else echo t-sqrt.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-sqrt_.c
+t-sub_.c: t-sub.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-sub.c; then echo $(srcdir)/t-sub.c; else echo t-sub.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-sub_.c
+ref_.$(OBJEXT) ref_.lo reuse_.$(OBJEXT) reuse_.lo t-add_.$(OBJEXT) \
+t-add_.lo t-conv_.$(OBJEXT) t-conv_.lo t-dm2exp_.$(OBJEXT) t-dm2exp_.lo \
+t-get_d_.$(OBJEXT) t-get_d_.lo t-misc_.$(OBJEXT) t-misc_.lo \
+t-muldiv_.$(OBJEXT) t-muldiv_.lo t-sqrt_.$(OBJEXT) t-sqrt_.lo \
+t-sub_.$(OBJEXT) t-sub_.lo : $(ANSI2KNR)
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+check-TESTS: $(TESTS)
+	@failed=0; all=0; xfail=0; xpass=0; \
+	srcdir=$(srcdir); export srcdir; \
+	for tst in $(TESTS); do \
+	  if test -f ./$$tst; then dir=./; \
+	  elif test -f $$tst; then dir=; \
+	  else dir="$(srcdir)/"; fi; \
+	  if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xpass=`expr $$xpass + 1`; \
+	      failed=`expr $$failed + 1`; \
+	      echo "XPASS: $$tst"; \
+	    ;; \
+	    *) \
+	      echo "PASS: $$tst"; \
+	    ;; \
+	    esac; \
+	  elif test $$? -ne 77; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xfail=`expr $$xfail + 1`; \
+	      echo "XFAIL: $$tst"; \
+	    ;; \
+	    *) \
+	      failed=`expr $$failed + 1`; \
+	      echo "FAIL: $$tst"; \
+	    ;; \
+	    esac; \
+	  fi; \
+	done; \
+	if test "$$failed" -eq 0; then \
+	  if test "$$xfail" -eq 0; then \
+	    banner="All $$all tests passed"; \
+	  else \
+	    banner="All $$all tests behaved as expected ($$xfail expected failures)"; \
+	  fi; \
+	else \
+	  if test "$$xpass" -eq 0; then \
+	    banner="$$failed of $$all tests failed"; \
+	  else \
+	    banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \
+	  fi; \
+	fi; \
+	dashes=`echo "$$banner" | sed s/./=/g`; \
+	echo "$$dashes"; \
+	echo "$$banner"; \
+	echo "$$dashes"; \
+	test "$$failed" -eq 0
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am: all-am
+	$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
+	$(MAKE) $(AM_MAKEFLAGS) check-TESTS
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am:
+install-data: install-data-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am:
+uninstall: uninstall-am
+all-am: Makefile
+all-redirect: all-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs:
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-checkPROGRAMS mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-kr mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am:  clean-checkPROGRAMS clean-compile clean-libtool clean-kr \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-am
+
+distclean-am:  distclean-checkPROGRAMS distclean-compile \
+		distclean-libtool distclean-kr distclean-tags \
+		distclean-generic clean-am
+	-rm -f libtool
+
+distclean: distclean-am
+
+maintainer-clean-am:  maintainer-clean-checkPROGRAMS \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-kr maintainer-clean-tags \
+		maintainer-clean-generic distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-checkPROGRAMS distclean-checkPROGRAMS \
+clean-checkPROGRAMS maintainer-clean-checkPROGRAMS mostlyclean-compile \
+distclean-compile clean-compile maintainer-clean-compile \
+mostlyclean-libtool distclean-libtool clean-libtool \
+maintainer-clean-libtool mostlyclean-kr distclean-kr clean-kr \
+maintainer-clean-kr tags mostlyclean-tags distclean-tags clean-tags \
+maintainer-clean-tags distdir check-TESTS info-am info dvi-am dvi check \
+check-am installcheck-am installcheck install-exec-am install-exec \
+install-data-am install-data install-am install uninstall-am uninstall \
+all-redirect all-am all install-strip 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/src/gmp/mpf/tests/ref.c b/src/gmp/mpf/tests/ref.c
new file mode 100644
index 000000000..c1f712ff4
--- /dev/null
+++ b/src/gmp/mpf/tests/ref.c
@@ -0,0 +1,203 @@
+/* Reference floating point routines.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if __STDC__
+void ref_mpf_add (mpf_t, const mpf_t, const mpf_t);
+void ref_mpf_sub (mpf_t, const mpf_t, const mpf_t);
+#else
+void ref_mpf_add ();
+void ref_mpf_sub ();
+#endif
+
+void
+#if __STDC__
+ref_mpf_add (mpf_t w, const mpf_t u, const mpf_t v)
+#else
+ref_mpf_add (w, u, v)
+     mpf_t w;
+     const mpf_t u;
+     const mpf_t v;
+#endif
+{
+  mp_size_t hi, lo, size;
+  mp_ptr ut, vt, wt;
+  int neg;
+  mp_exp_t exp;
+  mp_limb_t cy;
+  TMP_DECL (mark);
+
+  TMP_MARK (mark);
+
+  if (SIZ (u) == 0)
+    {
+      size = ABSIZ (v);
+      wt = (mp_ptr) TMP_ALLOC (size * BYTES_PER_MP_LIMB);
+      MPN_COPY (wt, PTR (v), size);
+      exp = EXP (v);
+      neg = SIZ (v) < 0;
+      goto done;
+    }
+  if (SIZ (v) == 0)
+    {
+      size = ABSIZ (u);
+      wt = (mp_ptr) TMP_ALLOC (size * BYTES_PER_MP_LIMB);
+      MPN_COPY (wt, PTR (u), size);
+      exp = EXP (u);
+      neg = SIZ (u) < 0;
+      goto done;
+    }
+  if ((SIZ (u) ^ SIZ (v)) < 0)
+    {
+      mpf_t tmp;
+      SIZ (tmp) = -SIZ (v);
+      EXP (tmp) = EXP (v);
+      PTR (tmp) = PTR (v);
+      ref_mpf_sub (w, u, tmp);
+      return;
+    }
+  neg = SIZ (u) < 0;
+
+  /* Compute the significance of the hi and lo end of the result.  */
+  hi = MAX (EXP (u), EXP (v));
+  lo = MIN (EXP (u) - ABSIZ (u), EXP (v) - ABSIZ (v));
+  size = hi - lo;
+  ut = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
+  vt = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
+  wt = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
+  MPN_ZERO (ut, size);
+  MPN_ZERO (vt, size);
+  {int off;
+  off = size + (EXP (u) - hi) - ABSIZ (u);
+  MPN_COPY (ut + off, PTR (u), ABSIZ (u));
+  off = size + (EXP (v) - hi) - ABSIZ (v);
+  MPN_COPY (vt + off, PTR (v), ABSIZ (v));
+  }
+
+  cy = mpn_add_n (wt, ut, vt, size);
+  wt[size] = cy;
+  size += cy;
+  exp = hi + cy;
+
+done:
+  if (size > PREC (w))
+    {
+      wt += size - PREC (w);
+      size = PREC (w);
+    }
+  MPN_COPY (PTR (w), wt, size);
+  SIZ (w) = neg == 0 ? size : -size;
+  EXP (w) = exp;
+  TMP_FREE (mark);
+}
+
+void
+#if __STDC__
+ref_mpf_sub (mpf_t w, const mpf_t u, const mpf_t v)
+#else
+ref_mpf_sub (w, u, v)
+     mpf_t w;
+     const mpf_t u;
+     const mpf_t v;
+#endif
+{
+  mp_size_t hi, lo, size;
+  mp_ptr ut, vt, wt;
+  int neg;
+  mp_exp_t exp;
+  TMP_DECL (mark);
+
+  TMP_MARK (mark);
+
+  if (SIZ (u) == 0)
+    {
+      size = ABSIZ (v);
+      wt = (mp_ptr) TMP_ALLOC (size * BYTES_PER_MP_LIMB);
+      MPN_COPY (wt, PTR (v), size);
+      exp = EXP (v);
+      neg = SIZ (v) > 0;
+      goto done;
+    }
+  if (SIZ (v) == 0)
+    {
+      size = ABSIZ (u);
+      wt = (mp_ptr) TMP_ALLOC (size * BYTES_PER_MP_LIMB);
+      MPN_COPY (wt, PTR (u), size);
+      exp = EXP (u);
+      neg = SIZ (u) < 0;
+      goto done;
+    }
+  if ((SIZ (u) ^ SIZ (v)) < 0)
+    {
+      mpf_t tmp;
+      SIZ (tmp) = -SIZ (v);
+      EXP (tmp) = EXP (v);
+      PTR (tmp) = PTR (v);
+      ref_mpf_add (w, u, tmp);
+      if (SIZ (u) < 0)
+	mpf_neg (w, w);
+      return;
+    }
+  neg = SIZ (u) < 0;
+
+  /* Compute the significance of the hi and lo end of the result.  */
+  hi = MAX (EXP (u), EXP (v));
+  lo = MIN (EXP (u) - ABSIZ (u), EXP (v) - ABSIZ (v));
+  size = hi - lo;
+  ut = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
+  vt = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
+  wt = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
+  MPN_ZERO (ut, size);
+  MPN_ZERO (vt, size);
+  {int off;
+  off = size + (EXP (u) - hi) - ABSIZ (u);
+  MPN_COPY (ut + off, PTR (u), ABSIZ (u));
+  off = size + (EXP (v) - hi) - ABSIZ (v);
+  MPN_COPY (vt + off, PTR (v), ABSIZ (v));
+  }
+
+  if (mpn_cmp (ut, vt, size) >= 0)
+    mpn_sub_n (wt, ut, vt, size);
+  else
+    {
+      mpn_sub_n (wt, vt, ut, size);
+      neg ^= 1;
+    }
+  exp = hi;
+  while (size != 0 && wt[size - 1] == 0)
+    {
+      size--;
+      exp--;
+    }
+
+done:
+  if (size > PREC (w))
+    {
+      wt += size - PREC (w);
+      size = PREC (w);
+    }
+  MPN_COPY (PTR (w), wt, size);
+  SIZ (w) = neg == 0 ? size : -size;
+  EXP (w) = exp;
+  TMP_FREE (mark);
+}
diff --git a/src/gmp/mpf/tests/reuse.c b/src/gmp/mpf/tests/reuse.c
new file mode 100644
index 000000000..fa8d89e81
--- /dev/null
+++ b/src/gmp/mpf/tests/reuse.c
@@ -0,0 +1,205 @@
+/* Test that routines allow reusing a source variable as destination.
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+#ifndef EXPO
+#define EXPO 32
+#endif
+
+#if __STDC__
+typedef void (*dss_func) (mpf_ptr, mpf_srcptr, mpf_srcptr);
+#else
+typedef void (*dss_func) ();
+#endif
+
+dss_func dss_funcs[] =
+{
+  mpf_div, mpf_add, mpf_mul, mpf_sub,
+};
+
+char *dss_func_names[] =
+{
+  "mpf_div", "mpf_add", "mpf_mul", "mpf_sub",
+};
+
+#if __STDC__
+typedef void (*dsi_func) (mpf_ptr, mpf_srcptr, unsigned long int);
+#else
+typedef void (*dsi_func) ();
+#endif
+
+dsi_func dsi_funcs[] =
+{
+  mpf_div_ui, mpf_add_ui, mpf_mul_ui, mpf_sub_ui,
+  mpf_mul_2exp, mpf_div_2exp
+};
+
+char *dsi_func_names[] =
+{
+  "mpf_div_ui", "mpf_add_ui", "mpf_mul_ui", "mpf_sub_ui",
+  "mpf_mul_2exp", "mpf_div_2exp"
+};
+
+#if __STDC__
+typedef void (*dis_func) (mpf_ptr, unsigned long int, mpf_srcptr);
+#else
+typedef void (*dis_func) ();
+#endif
+
+dis_func dis_funcs[] =
+{
+  mpf_ui_div, mpf_ui_sub,
+};
+
+char *dis_func_names[] =
+{
+  "mpf_ui_div", "mpf_ui_sub",
+};
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  int i;
+  int pass, reps = 100000;
+  mpf_t in1, in2, out1;
+  unsigned long int in1i, in2i;
+  mpf_t res1, res2, res3;
+  mp_size_t bprec = 100;
+
+  if (argc > 1)
+    {
+      reps = strtol (argv[1], 0, 0);
+      if (argc > 2)
+	bprec = strtol (argv[2], 0, 0);
+    }
+
+  mpf_set_default_prec (bprec);
+
+  mpf_init (in1);
+  mpf_init (in2);
+  mpf_init (out1);
+  mpf_init (res1);
+  mpf_init (res2);
+  mpf_init (res3);
+
+  for (pass = 1; pass <= reps; pass++)
+    {
+      mpf_random2 (in1, urandom () % SIZE - SIZE/2, urandom () % EXPO);
+      mpf_random2 (in2, urandom () % SIZE - SIZE/2, urandom () % EXPO);
+
+      for (i = 0; i < sizeof (dss_funcs) / sizeof (dss_func); i++)
+	{
+	  /* Don't divide by 0.  */
+	  if (i == 0 && mpf_cmp_ui (in2, 0) == 0)
+	    continue;
+
+	  (dss_funcs[i]) (res1, in1, in2);
+
+	  mpf_set (out1, in1);
+	  (dss_funcs[i]) (out1, out1, in2);
+	  mpf_set (res2, out1);
+
+	  mpf_set (out1, in2);
+	  (dss_funcs[i]) (out1, in1, out1);
+	  mpf_set (res3, out1);
+
+	  if (mpf_cmp (res1, res2) != 0)
+	    dump_abort (dss_func_names[i], res1, res2);
+	  if (mpf_cmp (res1, res3) != 0)
+	    dump_abort (dss_func_names[i], res1, res3);
+	}
+
+      in2i = urandom ();
+      for (i = 0; i < sizeof (dsi_funcs) / sizeof (dsi_func); i++)
+	{
+	  /* Don't divide by 0.  */
+	  if (strcmp (dsi_func_names[i], "mpf_div_ui") == 0 && in2i == 0)
+	    continue;
+
+	  (dsi_funcs[i]) (res1, in1, in2i);
+
+	  mpf_set (out1, in1);
+	  (dsi_funcs[i]) (out1, out1, in2i);
+	  mpf_set (res2, out1);
+
+	  if (mpf_cmp (res1, res2) != 0)
+	    dump_abort (dsi_func_names[i], res1, res2);
+	}
+
+      in1i = urandom ();
+      for (i = 0; i < sizeof (dis_funcs) / sizeof (dis_func); i++)
+	{
+	  /* Don't divide by 0.  */
+	  if (strcmp (dis_func_names[i], "mpf_ui_div") == 0
+	      && mpf_cmp_ui (in2, 0) == 0)
+	    continue;
+
+	  (dis_funcs[i]) (res1, in1i, in2);
+
+	  mpf_set (out1, in2);
+	  (dis_funcs[i]) (out1, in1i, out1);
+	  mpf_set (res2, out1);
+
+	  if (mpf_cmp (res1, res2) != 0)
+	    dump_abort (dis_func_names[i], res1, res2);
+	}
+
+    }
+
+  exit (0);
+}
+
+dump_abort (name, res1, res2)
+     char *name;
+     mpf_t res1, res2;
+{
+  printf ("failure in %s:\n", name);
+  oo (res1);
+  oo (res2);
+  abort ();
+}
+
+oo (x)
+     mpf_t x;
+{
+  mp_size_t i;
+  printf (" exp = %ld\n", x->_mp_exp);
+  printf ("size = %d\n", x->_mp_size);
+  for (i = ABS (x->_mp_size) - 1; i >= 0; i--)
+    printf ("%08lX ", x->_mp_d[i]);
+  printf ("\n");
+  mpf_dump (x);
+}
+
+#if 0
+void mpf_abs		_PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_sqrt		_PROTO ((mpf_ptr, mpf_srcptr));
+void mpf_neg		_PROTO ((mpf_ptr, mpf_srcptr));
+#endif
diff --git a/src/gmp/mpf/tests/t-add.c b/src/gmp/mpf/tests/t-add.c
new file mode 100644
index 000000000..3c309fc50
--- /dev/null
+++ b/src/gmp/mpf/tests/t-add.c
@@ -0,0 +1,117 @@
+/* Test mpf_add.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+#if __STDC__
+void ref_mpf_add (mpf_t, const mpf_t, const mpf_t);
+void ref_mpf_sub (mpf_t, const mpf_t, const mpf_t);
+#else
+void ref_mpf_add ();
+void ref_mpf_sub ();
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_size_t size;
+  mp_exp_t exp;
+  int reps = 100000;
+  int i;
+  mpf_t u, v, w, wref;
+  mp_size_t bprec = 100;
+  mpf_t rerr, max_rerr, limit_rerr;
+
+  if (argc > 1)
+    {
+      reps = strtol (argv[1], 0, 0);
+      if (argc > 2)
+	bprec = strtol (argv[2], 0, 0);
+    }
+
+  mpf_set_default_prec (bprec);
+
+  mpf_init_set_ui (limit_rerr, 1);
+  mpf_div_2exp (limit_rerr, limit_rerr, bprec);
+#if VERBOSE
+  mpf_dump (limit_rerr);
+#endif
+  mpf_init (rerr);
+  mpf_init_set_ui (max_rerr, 0);
+
+  mpf_init (u);
+  mpf_init (v);
+  mpf_init (w);
+  mpf_init (wref);
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % (2 * SIZE) - SIZE;
+      exp = urandom () % SIZE;
+      mpf_random2 (u, size, exp);
+
+      size = urandom () % (2 * SIZE) - SIZE;
+      exp = urandom () % SIZE;
+      mpf_random2 (v, size, exp);
+
+      mpf_add (w, u, v);
+      ref_mpf_add (wref, u, v);
+
+      mpf_reldiff (rerr, w, wref);
+      if (mpf_cmp (rerr, max_rerr) > 0)
+	{
+	  mpf_set (max_rerr, rerr);
+#if VERBOSE
+	  mpf_dump (max_rerr);
+#endif
+	  if (mpf_cmp (rerr, limit_rerr) > 0)
+	    {
+	      printf ("ERROR after %d tests\n", i);
+	      printf ("   u = "); mpf_dump (u);
+	      printf ("   v = "); mpf_dump (v);
+	      printf ("wref = "); mpf_dump (wref);
+	      printf ("   w = "); mpf_dump (w);
+	      abort ();
+	    }
+	}
+    }
+
+  exit (0);
+}
+
+oo (x)
+     mpf_t x;
+{
+  mp_size_t i;
+  printf (" exp = %ld\n", x->_mp_exp);
+  printf ("size = %d\n", x->_mp_size);
+  for (i = ABS (x->_mp_size) - 1; i >= 0; i--)
+    printf ("%08lX ", x->_mp_d[i]);
+  printf ("\n");
+  mpf_dump (x);
+}
diff --git a/src/gmp/mpf/tests/t-conv.c b/src/gmp/mpf/tests/t-conv.c
new file mode 100644
index 000000000..52d7e517a
--- /dev/null
+++ b/src/gmp/mpf/tests/t-conv.c
@@ -0,0 +1,120 @@
+/* Test mpf_get_str and mpf_set_str.
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 10
+#endif
+
+#ifndef EXPO
+#define EXPO 20
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpf_t x, y;
+  int reps = 20000;
+  int i;
+  mp_size_t bprec = 100;
+  mpf_t d, rerr, max_rerr, limit_rerr;
+  char *str;
+  mp_exp_t bexp;
+  long size, exp;
+  int base;
+  char buf[SIZE * BITS_PER_MP_LIMB + 5];
+
+  if (argc > 1)
+    {
+      reps = strtol (argv[1], 0, 0);
+      if (argc > 2)
+	bprec = strtol (argv[2], 0, 0);
+    }
+
+  mpf_set_default_prec (bprec);
+
+  mpf_init_set_ui (limit_rerr, 1);
+  mpf_div_2exp (limit_rerr, limit_rerr, bprec);
+#if VERBOSE
+  mpf_dump (limit_rerr);
+#endif
+  mpf_init (rerr);
+  mpf_init_set_ui (max_rerr, 0);
+
+  mpf_init (x);
+  mpf_init (y);
+  mpf_init (d);
+
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % (2 * SIZE) - SIZE;
+      exp = urandom () % EXPO;
+      mpf_random2 (x, size, exp);
+
+      base = urandom () % 35 + 2;
+
+      str = mpf_get_str (0, &bexp, base, 0, x);
+
+      if (str[0] == '-')
+	sprintf (buf, "-0.%s@%ld", str + 1, bexp);
+      else
+	sprintf (buf, "0.%s@%ld", str, bexp);
+
+      mpf_set_str (y, buf, -base);
+      (*_mp_free_func) (str, 0);
+
+      mpf_reldiff (rerr, x, y);
+      if (mpf_cmp (rerr, max_rerr) > 0)
+	{
+	  mpf_set (max_rerr, rerr);
+#if VERBOSE
+	  mpf_dump (max_rerr);
+#endif
+	  if (mpf_cmp (rerr, limit_rerr) > 0)
+	    {
+	      printf ("ERROR after %d tests\n", i);
+	      printf ("base = %d\n", base);
+	      printf ("   x = "); mpf_dump (x);
+	      printf ("   y = "); mpf_dump (y);
+	      abort ();
+	    }
+	}
+    }
+
+  exit (0);
+}
+
+oo (x)
+     mpf_t x;
+{
+  int i;
+  printf (" exp = %ld\n", x->_mp_exp);
+  printf ("size = %d\n", x->_mp_size);
+  for (i = ABS (x->_mp_size) - 1; i >= 0; i--)
+    printf ("%08lX ", x->_mp_d[i]);
+  printf ("\n");
+  mpf_dump (x);
+}
diff --git a/src/gmp/mpf/tests/t-dm2exp.c b/src/gmp/mpf/tests/t-dm2exp.c
new file mode 100644
index 000000000..5e609bccb
--- /dev/null
+++ b/src/gmp/mpf/tests/t-dm2exp.c
@@ -0,0 +1,120 @@
+/* Test mpf_div, mpf_div_2exp, mpf_mul_2exp.
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  int reps = 500000;
+  int i;
+  mpf_t u, v, w1, w2, w3;
+  mp_size_t bprec = 100;
+  mpf_t rerr, limit_rerr;
+  mp_size_t un;
+  mp_exp_t ue;
+
+  if (argc > 1)
+    {
+      reps = strtol (argv[1], 0, 0);
+      if (argc > 2)
+	bprec = strtol (argv[2], 0, 0);
+    }
+
+  mpf_set_default_prec (bprec);
+
+  mpf_init (rerr);
+  mpf_init (limit_rerr);
+
+  mpf_init (u);
+  mpf_init (v);
+  mpf_init (w1);
+  mpf_init (w2);
+  mpf_init (w3);
+
+  for (i = 0; i < reps; i++)
+    {
+      unsigned long int res_prec;
+      unsigned long int pow2;
+
+      res_prec = urandom () % (bprec + 100);
+      mpf_set_prec (w1, res_prec);
+      mpf_set_prec (w2, res_prec);
+      mpf_set_prec (w3, res_prec);
+
+      mpf_set_ui (limit_rerr, 1);
+      mpf_div_2exp (limit_rerr, limit_rerr, res_prec);
+
+      pow2 = urandom () % 0x10000;
+      mpf_set_ui (v, 1);
+      mpf_mul_2exp (v, v, pow2);
+
+      un = urandom () % (2 * SIZE) - SIZE;
+      ue = urandom () % SIZE;
+      mpf_random2 (u, un, ue);
+
+      mpf_div_2exp (w1, u, pow2);
+      mpf_div (w2, u, v);
+      mpf_reldiff (rerr, w1, w2);
+      if (mpf_cmp (rerr, limit_rerr) > 0)
+	{
+	  printf ("ERROR in mpf_div or mpf_div_2exp after %d tests\n", i);
+	  printf ("   u = "); mpf_dump (u);
+	  printf ("   v = "); mpf_dump (v);
+	  printf ("  w1 = "); mpf_dump (w1);
+	  printf ("  w2 = "); mpf_dump (w2);
+	  abort ();
+	}
+      mpf_mul_2exp (w3, w1, pow2);
+      mpf_reldiff (rerr, u, w3);
+      if (mpf_cmp (rerr, limit_rerr) > 0)
+	{
+	  printf ("ERROR in mpf_mul_2exp after %d tests\n", i);
+	  printf ("   u = "); mpf_dump (u);
+	  printf ("   v = "); mpf_dump (v);
+	  printf ("  w1 = "); mpf_dump (w1);
+	  printf ("  w3 = "); mpf_dump (w3);
+	  abort ();
+	}
+    }
+
+  exit (0);
+}
+
+oo (x)
+     mpf_t x;
+{
+  mp_size_t i;
+  printf (" exp = %ld\n", x->_mp_exp);
+  printf ("size = %d\n", x->_mp_size);
+  for (i = ABS (x->_mp_size) - 1; i >= 0; i--)
+    printf ("%08lX ", x->_mp_d[i]);
+  printf ("\n");
+  mpf_dump (x);
+}
diff --git a/src/gmp/mpf/tests/t-get_d.c b/src/gmp/mpf/tests/t-get_d.c
new file mode 100644
index 000000000..91d5a65b5
--- /dev/null
+++ b/src/gmp/mpf/tests/t-get_d.c
@@ -0,0 +1,61 @@
+/* Test mpf_get_d and mpf_set_d.
+
+   Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+
+   This file is part of the GNU MP Library.
+
+   The GNU MP Library is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2.1 of the License, or (at your
+   option) any later version.
+
+   The GNU MP Library is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+   the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+   MA 02111-1307, USA. */
+
+#include "gmp.h"
+
+#ifdef __vax__
+#define LOW_BOUND 1e-38
+#define HIGH_BOUND 8e37
+#else
+#define LOW_BOUND 1e-300
+#define HIGH_BOUND 1e300
+#endif
+
+int
+#if __STDC__
+main (int argc, char **argv)
+#else
+main (argc, argv)
+     int  argc;
+     char **argv;
+#endif
+{
+  double d, e, r;
+  mpf_t u, v;
+
+  mpf_init (u);
+  mpf_init (v);
+
+  mpf_set_d (u, LOW_BOUND);
+  for (d = 2.0 * LOW_BOUND; d < HIGH_BOUND; d *= 1.01)
+    {
+      mpf_set_d (v, d);
+      if (mpf_cmp (u, v) >= 0)
+	abort ();
+      e = mpf_get_d (v);
+      r = e/d;
+      if (r < 0.99999999999999 | r > 1.00000000000001)
+	abort ();
+      mpf_set (u, v);
+    }
+
+  exit (0);
+}
diff --git a/src/gmp/mpf/tests/t-misc.c b/src/gmp/mpf/tests/t-misc.c
new file mode 100644
index 000000000..8d79cb74e
--- /dev/null
+++ b/src/gmp/mpf/tests/t-misc.c
@@ -0,0 +1,155 @@
+/* Exercise various mpf functions. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#define SGN(x)       ((x) < 0 ? -1 : (x) == 0 ? 0 : 1)
+
+
+void
+check_mpf_set_si (void)
+{
+  static const struct {
+    long       x;
+    mp_size_t  want_size;
+    mp_limb_t  want_limb;
+  } data[] = {
+
+    {  0L,  0 },
+    {  1L,  1, 1 },
+    { -1L, -1, 1 },
+
+    {  LONG_MAX,  1, LONG_MAX },
+    { -LONG_MAX, -1, LONG_MAX },
+
+    { LONG_HIGHBIT, -1, ULONG_HIGHBIT },
+  };
+
+  mpf_t  x;
+  int    i;
+
+  mpf_init (x);
+  for (i = 0; i < numberof (data); i++)
+    {
+      mpf_init (x);
+      mpf_set_si (x, data[i].x);
+      if (x->_mp_size != data[i].want_size
+          || (x->_mp_size != 0 && x->_mp_d[0] != data[i].want_limb)
+          || (x->_mp_exp != (data[i].x != 0)))
+        {
+          printf ("mpf_set_si wrong on data[%d]\n", i); 
+          abort();                                    
+        }
+      mpf_clear (x);
+
+      mpf_init_set_si (x, data[i].x);
+      if (x->_mp_size != data[i].want_size
+          || (x->_mp_size != 0 && x->_mp_d[0] != data[i].want_limb)
+          || (x->_mp_exp != (data[i].x != 0)))
+        {
+          printf ("mpf_init_set_si wrong on data[%d]\n", i); 
+          abort();                                    
+        }
+      mpf_clear (x);
+    }
+}
+
+
+void
+check_mpf_cmp_si (void)
+{
+  static const struct {
+    int         a_base;
+    const char  *a;
+    const char  *b;
+    int         want;
+  } data[] = {
+    { 10, "0",  "1", -1 },
+    { 10, "0",  "0",  0 },
+    { 10, "0", "-1",  1 },
+
+    { 10, "1",  "1", 0 },
+    { 10, "1",  "0", 1 },
+    { 10, "1", "-1", 1 },
+
+    { 10, "-1",  "1", -1 },
+    { 10, "-1",  "0", -1 },
+    { 10, "-1", "-1", 0 },
+
+    { 16,         "0", "-0x80000000",  1 },
+    { 16,  "80000000", "-0x80000000",  1 },
+    { 16,  "80000001", "-0x80000000",  1 },
+    { 16, "-80000000", "-0x80000000",  0 },
+    { 16, "-80000001", "-0x80000000", -1 },
+
+    { 16,                 "0", "-0x8000000000000000",  1 },
+    { 16,  "8000000000000000", "-0x8000000000000000",  1 },
+    { 16,  "8000000000000001", "-0x8000000000000000",  1 },
+    { 16, "-8000000000000000", "-0x8000000000000000",  0 },
+    { 16, "-8000000000000001", "-0x8000000000000000", -1 },
+  };
+
+  mpf_t  a;
+  mpz_t  bz;
+  long   b;
+  int    got;
+  int    i;
+
+  mpf_init (a);
+  mpz_init (bz);
+  for (i = 0; i < numberof (data); i++)
+    {
+      mpf_set_str (a, data[i].a, data[i].a_base);
+      mpz_set_str (bz, data[i].b, 0);
+
+      if (mpz_fits_slong_p (bz))
+        {
+          b = mpz_get_si (bz);
+          got = mpf_cmp_si (a, b);
+          if (SGN (got) != data[i].want)
+            {
+              printf ("mpf_cmp_si wrong on data[%d]\n", i);
+              printf ("  a="); mpf_out_str (stdout, 10, 0, a);
+              printf (" (%s)\n", data[i].a);
+              printf ("  b=%ld (%s)\n", b, data[i].b);
+              printf ("  got=%d\n", got);
+              printf ("  want=%d\n", data[i].want);
+              abort();                                    
+            }
+        }
+    }
+
+  mpf_clear (a);
+  mpz_clear (bz);
+}
+
+
+int
+main (void)
+{
+  check_mpf_set_si ();
+  check_mpf_cmp_si ();
+  exit (0);
+}
diff --git a/src/gmp/mpf/tests/t-muldiv.c b/src/gmp/mpf/tests/t-muldiv.c
new file mode 100644
index 000000000..7665d9953
--- /dev/null
+++ b/src/gmp/mpf/tests/t-muldiv.c
@@ -0,0 +1,161 @@
+/* Test mpf_mul, mpf_div, mpf_ui_div, and mpf_div_ui.
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_size_t size;
+  mp_exp_t exp;
+  int reps = 100000;
+  int i;
+  mpf_t u, v, w, x;
+  mp_size_t bprec = SIZE * BITS_PER_MP_LIMB;
+  mpf_t rerr, limit_rerr;
+  mp_limb_t ulimb, vlimb;
+  int single_flag;
+
+  if (argc > 1)
+    {
+      reps = strtol (argv[1], 0, 0);
+      if (argc > 2)
+	bprec = strtol (argv[2], 0, 0);
+    }
+
+  mpf_set_default_prec (bprec);
+
+  mpf_init (rerr);
+  mpf_init (limit_rerr);
+
+  mpf_init (u);
+  mpf_init (v);
+  mpf_init (w);
+  mpf_init (x);
+
+  for (i = 0; i < reps; i++)
+    {
+      mp_size_t res_prec;
+
+      res_prec = urandom () % bprec + 1;
+      mpf_set_prec (w, res_prec);
+      mpf_set_prec (x, res_prec);
+
+      mpf_set_ui (limit_rerr, 1);
+      mpf_div_2exp (limit_rerr, limit_rerr, res_prec - 1);
+
+      single_flag = 0;
+
+      if ((urandom () & 1) != 0)
+	{
+	  size = urandom () % (2 * SIZE) - SIZE;
+	  exp = urandom () % SIZE;
+	  mpf_random2 (u, size, exp);
+	}
+      else
+	{
+	  ulimb = urandom ();
+	  mpf_set_ui (u, ulimb);
+	  single_flag = 1;
+	}
+
+      if ((urandom () & 1) != 0)
+	{
+	  size = urandom () % (2 * SIZE) - SIZE;
+	  exp = urandom () % SIZE;
+	  mpf_random2 (v, size, exp);
+	}
+      else
+	{
+	  vlimb = urandom ();
+	  mpf_set_ui (v, vlimb);
+	  single_flag = 2;
+	}
+
+      if (mpf_sgn (v) == 0)
+	continue;
+
+      mpf_div (w, u, v);
+      mpf_mul (x, w, v);
+      mpf_reldiff (rerr, u, x);
+      if (mpf_cmp (rerr, limit_rerr) > 0)
+	{
+	  printf ("ERROR in mpf_mul or mpf_div after %d tests\n", i);
+	  printf ("   u = "); mpf_dump (u);
+	  printf ("   v = "); mpf_dump (v);
+	  printf ("   x = "); mpf_dump (x);
+	  printf ("   w = "); mpf_dump (w);
+	  abort ();
+	}
+
+      if (single_flag == 2)
+	{
+	  mpf_div_ui (x, u, vlimb);
+	  mpf_reldiff (rerr, w, x);
+	  if (mpf_cmp (rerr, limit_rerr) > 0)
+	    {
+	      printf ("ERROR in mpf_div or mpf_div_ui after %d tests\n", i);
+	      printf ("   u = "); mpf_dump (u);
+	      printf ("   v = "); mpf_dump (v);
+	      printf ("   x = "); mpf_dump (x);
+	      printf ("   w = "); mpf_dump (w);
+	      abort ();
+	    }
+	}
+
+      if (single_flag == 1)
+	{
+	  mpf_ui_div (x, ulimb, v);
+	  mpf_reldiff (rerr, w, x);
+	  if (mpf_cmp (rerr, limit_rerr) > 0)
+	    {
+	      printf ("ERROR in mpf_div or mpf_ui_div after %d tests\n", i);
+	      printf ("   u = "); mpf_dump (u);
+	      printf ("   v = "); mpf_dump (v);
+	      printf ("   x = "); mpf_dump (x);
+	      printf ("   w = "); mpf_dump (w);
+	      abort ();
+	    }
+	}
+    }
+
+  exit (0);
+}
+
+oo (x)
+     mpf_t x;
+{
+  mp_size_t i;
+  printf (" exp = %ld\n", x->_mp_exp);
+  printf ("size = %d\n", x->_mp_size);
+  for (i = ABS (x->_mp_size) - 1; i >= 0; i--)
+    printf ("%08lX ", x->_mp_d[i]);
+  printf ("\n");
+  mpf_dump (x);
+}
diff --git a/src/gmp/mpf/tests/t-sqrt.c b/src/gmp/mpf/tests/t-sqrt.c
new file mode 100644
index 000000000..756715129
--- /dev/null
+++ b/src/gmp/mpf/tests/t-sqrt.c
@@ -0,0 +1,103 @@
+/* Test mpf_sqrt, mpf_mul.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_size_t size;
+  mp_exp_t exp;
+  int reps = 100000;
+  int i;
+  mpf_t x, y, y2;
+  mp_size_t bprec = 100;
+  mpf_t rerr, max_rerr, limit_rerr;
+
+  if (argc > 1)
+    {
+      reps = strtol (argv[1], 0, 0);
+      if (argc > 2)
+	bprec = strtol (argv[2], 0, 0);
+    }
+
+  mpf_set_default_prec (bprec);
+
+  mpf_init_set_ui (limit_rerr, 1);
+  mpf_div_2exp (limit_rerr, limit_rerr, bprec);
+#if VERBOSE
+  mpf_dump (limit_rerr);
+#endif
+  mpf_init (rerr);
+  mpf_init_set_ui (max_rerr, 0);
+
+  mpf_init (x);
+  mpf_init (y);
+  mpf_init (y2);
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % SIZE;
+      exp = urandom () % SIZE;
+      mpf_random2 (x, size, exp);
+
+      mpf_sqrt (y, x);
+      mpf_mul (y2, y, y);
+
+      mpf_reldiff (rerr, x, y2);
+      if (mpf_cmp (rerr, max_rerr) > 0)
+	{
+	  mpf_set (max_rerr, rerr);
+#if VERBOSE
+	  mpf_dump (max_rerr);
+#endif
+	  if (mpf_cmp (rerr, limit_rerr) > 0)
+	    {
+	      printf ("ERROR after %d tests\n", i);
+	      printf ("   x = "); mpf_dump (x);
+	      printf ("   y = "); mpf_dump (y);
+	      printf ("  y2 = "); mpf_dump (y2);
+	      abort ();
+	    }
+	}
+    }
+
+  exit (0);
+}
+
+oo (x)
+     mpf_t x;
+{
+  mp_size_t i;
+  printf (" exp = %ld\n", x->_mp_exp);
+  printf ("size = %d\n", x->_mp_size);
+  for (i = ABS (x->_mp_size) - 1; i >= 0; i--)
+    printf ("%08lX ", x->_mp_d[i]);
+  printf ("\n");
+  mpf_dump (x);
+}
diff --git a/src/gmp/mpf/tests/t-sub.c b/src/gmp/mpf/tests/t-sub.c
new file mode 100644
index 000000000..ff9945858
--- /dev/null
+++ b/src/gmp/mpf/tests/t-sub.c
@@ -0,0 +1,122 @@
+/* Test mpf_sub.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+#if __STDC__
+void ref_mpf_add (mpf_t, const mpf_t, const mpf_t);
+void ref_mpf_sub (mpf_t, const mpf_t, const mpf_t);
+#else
+void ref_mpf_add ();
+void ref_mpf_sub ();
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_size_t size;
+  mp_exp_t exp;
+  int reps = 500000;
+  int i;
+  mpf_t u, v, w, wref;
+  mp_size_t bprec = 100;
+  mpf_t rerr, max_rerr, limit_rerr;
+
+  if (argc > 1)
+    {
+      reps = strtol (argv[1], 0, 0);
+      if (argc > 2)
+	bprec = strtol (argv[2], 0, 0);
+    }
+
+  mpf_set_default_prec (bprec);
+
+  mpf_init_set_ui (limit_rerr, 1);
+  mpf_div_2exp (limit_rerr, limit_rerr, bprec);
+#if VERBOSE
+  mpf_dump (limit_rerr);
+#endif
+  mpf_init (rerr);
+  mpf_init_set_ui (max_rerr, 0);
+
+  mpf_init (u);
+  mpf_init (v);
+  mpf_init (w);
+  mpf_init (wref);
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % (2 * SIZE) - SIZE;
+      exp = urandom () % SIZE;
+      mpf_random2 (u, size, exp);
+
+      size = urandom () % (2 * SIZE) - SIZE;
+      exp = urandom () % SIZE;
+      mpf_random2 (v, size, exp);
+
+      if ((urandom () & 1) != 0)
+	mpf_add_ui (u, v, 1);
+      else if ((urandom () & 1) != 0)
+	mpf_sub_ui (u, v, 1);
+
+      mpf_sub (w, u, v);
+      ref_mpf_sub (wref, u, v);
+
+      mpf_reldiff (rerr, w, wref);
+      if (mpf_cmp (rerr, max_rerr) > 0)
+	{
+	  mpf_set (max_rerr, rerr);
+#if VERBOSE
+	  mpf_dump (max_rerr);
+#endif
+	  if (mpf_cmp (rerr, limit_rerr) > 0)
+	    {
+	      printf ("ERROR after %d tests\n", i);
+	      printf ("   u = "); mpf_dump (u);
+	      printf ("   v = "); mpf_dump (v);
+	      printf ("wref = "); mpf_dump (wref);
+	      printf ("   w = "); mpf_dump (w);
+	      abort ();
+	    }
+	}
+    }
+
+  exit (0);
+}
+
+oo (x)
+     mpf_t x;
+{
+  mp_size_t i;
+  printf (" exp = %ld\n", x->_mp_exp);
+  printf ("size = %d\n", x->_mp_size);
+  for (i = ABS (x->_mp_size) - 1; i >= 0; i--)
+    printf ("%08lX ", x->_mp_d[i]);
+  printf ("\n");
+  mpf_dump (x);
+}
diff --git a/src/gmp/mpf/ui_div.c b/src/gmp/mpf/ui_div.c
new file mode 100644
index 000000000..11dc801b3
--- /dev/null
+++ b/src/gmp/mpf/ui_div.c
@@ -0,0 +1,132 @@
+/* mpf_ui_div -- Divide an unsigned integer with a float.
+
+Copyright (C) 1993, 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpf_ui_div (mpf_ptr r, unsigned long int u, mpf_srcptr v)
+#else
+mpf_ui_div (r, u, v)
+     mpf_ptr r;
+     unsigned long int u;
+     mpf_srcptr v;
+#endif
+{
+  mp_srcptr vp;
+  mp_ptr rp, tp;
+  mp_size_t vsize;
+  mp_size_t rsize, tsize;
+  mp_size_t sign_quotient;
+  mp_size_t prec;
+  unsigned normalization_steps;
+  mp_limb_t q_limb;
+  mp_exp_t rexp;
+  TMP_DECL (marker);
+
+  vsize = v->_mp_size;
+  sign_quotient = vsize;
+  vsize = ABS (vsize);
+  prec = r->_mp_prec;
+
+  if (vsize == 0)
+    DIVIDE_BY_ZERO;
+
+  if (u == 0)
+    {
+      r->_mp_size = 0;
+      r->_mp_exp = 0;
+      return;
+    }
+
+  TMP_MARK (marker);
+  rexp = 1 - v->_mp_exp;
+
+  rp = r->_mp_d;
+  vp = v->_mp_d;
+
+  if (vsize > prec)
+    {
+      vp += vsize - prec;
+      vsize = prec;
+    }
+
+  tsize = vsize + prec;
+  tp = (mp_ptr) TMP_ALLOC ((tsize + 1) * BYTES_PER_MP_LIMB);
+  MPN_ZERO (tp, tsize);
+
+  count_leading_zeros (normalization_steps, vp[vsize - 1]);
+
+  /* Normalize the divisor and the dividend.  */
+  if (normalization_steps != 0)
+    {
+      mp_ptr tmp;
+      mp_limb_t dividend_high, dividend_low;
+
+      /* Shift up the divisor setting the most significant bit of
+	 the most significant limb.  Use temporary storage not to clobber
+	 the original contents of the divisor.  */
+      tmp = (mp_ptr) TMP_ALLOC (vsize * BYTES_PER_MP_LIMB);
+      mpn_lshift (tmp, vp, vsize, normalization_steps);
+      vp = tmp;
+
+      /* Shift up the dividend, possibly introducing a new most
+	 significant word.  */
+      dividend_high = (mp_limb_t) u >> (BITS_PER_MP_LIMB - normalization_steps);
+      dividend_low = (mp_limb_t) u << normalization_steps;
+
+      tp[tsize - 1] = dividend_low;
+      if (dividend_high != 0)
+	{
+	  tp[tsize] = dividend_high;
+	  tsize++;
+	  rexp++;
+	}
+    }
+  else
+    {
+      /* The divisor is already normalized, as required.
+	 Copy it to temporary space if it overlaps with the quotient.  */
+      if (vp - rp <= tsize - vsize)
+	{
+	  mp_ptr tmp = (mp_ptr) TMP_ALLOC (vsize * BYTES_PER_MP_LIMB);
+	  MPN_COPY (tmp, vp, vsize);
+	  vp = (mp_srcptr) tmp;
+	}
+
+      tp[tsize - 1] = u;
+    }
+
+  q_limb = mpn_divmod (rp, tp, tsize, vp, vsize);
+  rsize = tsize - vsize;
+  if (q_limb)
+    {
+      rp[rsize] = q_limb;
+      rsize++;
+      rexp++;
+    }
+
+  r->_mp_size = sign_quotient >= 0 ? rsize : -rsize;
+  r->_mp_exp = rexp;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/ui_sub.c b/src/gmp/mpf/ui_sub.c
new file mode 100644
index 000000000..3219faba1
--- /dev/null
+++ b/src/gmp/mpf/ui_sub.c
@@ -0,0 +1,334 @@
+/* mpf_ui_sub -- Subtract a float from an unsigned long int.
+
+Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_ui_sub (mpf_ptr r, unsigned long int u, mpf_srcptr v)
+#else
+mpf_ui_sub (r, u, v)
+     mpf_ptr r;
+     unsigned long int u;
+     mpf_srcptr v;
+#endif
+{
+  mp_srcptr up, vp;
+  mp_ptr rp, tp;
+  mp_size_t usize, vsize, rsize;
+  mp_size_t prec;
+  mp_exp_t uexp;
+  mp_size_t ediff;
+  int negate;
+  mp_limb_t ulimb;
+  TMP_DECL (marker);
+
+  vsize = v->_mp_size;
+
+  /* Handle special cases that don't work in generic code below.  */
+  if (u == 0)
+    {
+      mpf_neg (r, v);
+      return;
+    }
+  if (vsize == 0)
+    {
+      mpf_set_ui (r, u);
+      return;
+    }
+
+  /* If signs of U and V are different, perform addition.  */
+  if (vsize < 0)
+    {
+      __mpf_struct v_negated;
+      v_negated._mp_size = -vsize;
+      v_negated._mp_exp = v->_mp_exp;
+      v_negated._mp_d = v->_mp_d;
+      mpf_add_ui (r, &v_negated, u);
+      return;
+    }
+
+  TMP_MARK (marker);
+
+  /* Signs are now known to be the same.  */
+
+  ulimb = u;
+  /* Make U be the operand with the largest exponent.  */
+  if (1 < v->_mp_exp)
+    {
+      negate = 1;
+      usize = ABS (vsize);
+      vsize = 1;
+      up = v->_mp_d;
+      vp = &ulimb;
+      rp = r->_mp_d;
+      prec = r->_mp_prec + 1;
+      uexp = v->_mp_exp;
+      ediff = uexp - 1;
+    }
+  else
+    {
+      negate = 0;
+      usize = 1;
+      vsize = ABS (vsize);
+      up = &ulimb;
+      vp = v->_mp_d;
+      rp = r->_mp_d;
+      prec = r->_mp_prec;
+      uexp = 1;
+      ediff = 1 - v->_mp_exp;
+    }
+
+  /* Ignore leading limbs in U and V that are equal.  Doing
+     this helps increase the precision of the result.  */
+  if (ediff == 0)
+    {
+      /* This loop normally exits immediately.  Optimize for that.  */
+      for (;;)
+	{
+	  usize--;
+	  vsize--;
+	  if (up[usize] != vp[vsize])
+	    break;
+	  uexp--;
+	  if (usize == 0)
+	    goto Lu0;
+	  if (vsize == 0)
+	    goto Lv0;
+	}
+      usize++;
+      vsize++;
+      /* Note that either operand (but not both operands) might now have
+	 leading zero limbs.  It matters only that U is unnormalized if
+	 vsize is now zero, and vice versa.  And it is only in that case
+	 that we have to adjust uexp.  */
+      if (vsize == 0)
+      Lv0:
+	while (usize != 0 && up[usize - 1] == 0)
+	  usize--, uexp--;
+      if (usize == 0)
+      Lu0:
+	while (vsize != 0 && vp[vsize - 1] == 0)
+	  vsize--, uexp--;
+    }
+
+  /* If U extends beyond PREC, ignore the part that does.  */
+  if (usize > prec)
+    {
+      up += usize - prec;
+      usize = prec;
+    }
+
+  /* If V extends beyond PREC, ignore the part that does.
+     Note that this may make vsize negative.  */
+  if (vsize + ediff > prec)
+    {
+      vp += vsize + ediff - prec;
+      vsize = prec - ediff;
+    }
+
+  /* Allocate temp space for the result.  Allocate
+     just vsize + ediff later???  */
+  tp = (mp_ptr) TMP_ALLOC (prec * BYTES_PER_MP_LIMB);
+
+  if (ediff >= prec)
+    {
+      /* V completely cancelled.  */
+      if (tp != up)
+	MPN_COPY (rp, up, usize);
+      rsize = usize;
+    }
+  else
+    {
+      /* Locate the least significant non-zero limb in (the needed
+	 parts of) U and V, to simplify the code below.  */
+      for (;;)
+	{
+	  if (vsize == 0)
+	    {
+	      MPN_COPY (rp, up, usize);
+	      rsize = usize;
+	      goto done;
+	    }
+	  if (vp[0] != 0)
+	    break;
+	  vp++, vsize--;
+	}
+      for (;;)
+	{
+	  if (usize == 0)
+	    {
+	      MPN_COPY (rp, vp, vsize);
+	      rsize = vsize;
+	      negate ^= 1;
+	      goto done;
+	    }
+	  if (up[0] != 0)
+	    break;
+	  up++, usize--;
+	}
+
+      /* uuuu     |  uuuu     |  uuuu     |  uuuu     |  uuuu    */
+      /* vvvvvvv  |  vv       |    vvvvv  |    v      |       vv */
+
+      if (usize > ediff)
+	{
+	  /* U and V partially overlaps.  */
+	  if (ediff == 0)
+	    {
+	      /* Have to compare the leading limbs of u and v
+		 to determine whether to compute u - v or v - u.  */
+	      if (usize > vsize)
+		{
+		  /* uuuu     */
+		  /* vv       */
+		  int cmp;
+		  cmp = mpn_cmp (up + usize - vsize, vp, vsize);
+		  if (cmp >= 0)
+		    {
+		      mp_size_t size;
+		      size = usize - vsize;
+		      MPN_COPY (tp, up, size);
+		      mpn_sub_n (tp + size, up + size, vp, vsize);
+		      rsize = usize;
+		    }
+		  else
+		    {
+		      /* vv       */  /* Swap U and V. */
+		      /* uuuu     */
+		      mp_size_t size, i;
+		      size = usize - vsize;
+		      tp[0] = -up[0];
+		      for (i = 1; i < size; i++)
+			tp[i] = ~up[i];
+		      mpn_sub_n (tp + size, vp, up + size, vsize);
+		      mpn_sub_1 (tp + size, tp + size, vsize, (mp_limb_t) 1);
+		      negate ^= 1;
+		      rsize = usize;
+		    }
+		}
+	      else if (usize < vsize)
+		{
+		  /* uuuu     */
+		  /* vvvvvvv  */
+		  int cmp;
+		  cmp = mpn_cmp (up, vp + vsize - usize, usize);
+		  if (cmp > 0)
+		    {
+		      mp_size_t size, i;
+		      size = vsize - usize;
+		      tp[0] = -vp[0];
+		      for (i = 1; i < size; i++)
+			tp[i] = ~vp[i];
+		      mpn_sub_n (tp + size, up, vp + size, usize);
+		      mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1);
+		      rsize = vsize;
+		    }
+		  else
+		    {
+		      /* vvvvvvv  */  /* Swap U and V. */
+		      /* uuuu     */
+		      /* This is the only place we can get 0.0.  */
+		      mp_size_t size;
+		      size = vsize - usize;
+		      MPN_COPY (tp, vp, size);
+		      mpn_sub_n (tp + size, vp + size, up, usize);
+		      negate ^= 1;
+		      rsize = vsize;
+		    }
+		}
+	      else
+		{
+		  /* uuuu     */
+		  /* vvvv     */
+		  int cmp;
+		  cmp = mpn_cmp (up, vp + vsize - usize, usize);
+		  if (cmp > 0)
+		    {
+		      mpn_sub_n (tp, up, vp, usize);
+		      rsize = usize;
+		    }
+		  else
+		    {
+		      mpn_sub_n (tp, vp, up, usize);
+		      negate ^= 1;
+		      rsize = usize;
+		      /* can give zero */
+		    }
+		}
+	    }
+	  else
+	    {
+	      if (vsize + ediff <= usize)
+		{
+		  /* uuuu     */
+		  /*   v      */
+		  mp_size_t size;
+		  size = usize - ediff - vsize;
+		  MPN_COPY (tp, up, size);
+		  mpn_sub (tp + size, up + size, usize - size, vp, vsize);
+		  rsize = usize;
+		}
+	      else
+		{
+		  /* uuuu     */
+		  /*   vvvvv  */
+		  mp_size_t size, i;
+		  size = vsize + ediff - usize;
+		  tp[0] = -vp[0];
+		  for (i = 1; i < size; i++)
+		    tp[i] = ~vp[i];
+		  mpn_sub (tp + size, up, usize, vp + size, usize - ediff);
+		  mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1);
+		  rsize = vsize + ediff;
+		}
+	    }
+	}
+      else
+	{
+	  /* uuuu     */
+	  /*      vv  */
+	  mp_size_t size, i;
+	  size = vsize + ediff - usize;
+	  tp[0] = -vp[0];
+	  for (i = 1; i < vsize; i++)
+	    tp[i] = ~vp[i];
+	  for (i = vsize; i < size; i++)
+	    tp[i] = ~(mp_limb_t) 0;
+	  mpn_sub_1 (tp + size, up, usize, (mp_limb_t) 1);
+	  rsize = size + usize;
+	}
+
+      /* Full normalize.  Optimize later.  */
+      while (rsize != 0 && tp[rsize - 1] == 0)
+	{
+	  rsize--;
+	  uexp--;
+	}
+      MPN_COPY (rp, tp, rsize);
+    }
+
+ done:
+  r->_mp_size = negate ? -rsize : rsize;
+  r->_mp_exp = uexp;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpf/urandomb.c b/src/gmp/mpf/urandomb.c
new file mode 100644
index 000000000..db4c0f914
--- /dev/null
+++ b/src/gmp/mpf/urandomb.c
@@ -0,0 +1,64 @@
+/* mpf_urandomb (rop, state, nbits) -- Generate a uniform pseudorandom
+   real number between 0 (inclusive) and 1 (exclusive) of size NBITS,
+   using STATE as the random state previously initialized by a call to
+   gmp_randinit().
+
+Copyright (C) 1999, 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpf_urandomb (mpf_t rop, gmp_randstate_t rstate, unsigned long int nbits)
+#else
+mpf_urandomb (rop, rstate, nbits)
+     mpf_t rop;
+     gmp_randstate_t rstate;
+     unsigned long int nbits;
+#endif
+{
+  mp_ptr rp;
+  mp_size_t nlimbs;
+  mp_exp_t exp;
+
+  rp = PTR (rop);
+  nlimbs = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+
+  _gmp_rand (rp, rstate, nbits);
+
+  /* If nbits isn't a multiple of BITS_PER_MP_LIMB, shift up.  */
+  if (nlimbs != 0)
+    {
+      if (nbits % BITS_PER_MP_LIMB != 0)
+	mpn_lshift (rp, rp, nlimbs,
+		    BITS_PER_MP_LIMB - nbits % BITS_PER_MP_LIMB);
+    }
+
+  exp = 0;
+  while (nlimbs != 0 && rp[nlimbs - 1] == 0)
+    {
+      nlimbs--;
+      exp--;
+    }
+  EXP (rop) = exp;
+  SIZ (rop) = nlimbs;
+
+}
diff --git a/src/gmp/mpfr/Makefile.am b/src/gmp/mpfr/Makefile.am
new file mode 100644
index 000000000..c8d7a13ec
--- /dev/null
+++ b/src/gmp/mpfr/Makefile.am
@@ -0,0 +1,42 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Library General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Library General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+
+INCLUDES = -I$(top_srcdir)
+
+if WANT_MPFR
+noinst_LTLIBRARIES = libmpfr.la
+endif
+
+# FIXME: Add rnd_mode.c when it's clean.
+libmpfr_la_SOURCES = \
+	add.c div_2exp.c neg.c set_dfl_prec.c set_str_raw.c agm.c get_str.c \
+	print_raw.c set_dfl_rnd.c sqrt.c clear.c init.c set_f.c \
+	sub.c cmp.c mul.c round.c set_prec.c cmp_ui.c mul_2exp.c set.c \
+	set_si.c div.c mul_ui.c set_d.c pow.c out_str.c pi.c set_z.c \
+	add_ulp.c log2.c random.c log.c exp.c div_ui.c zeta.c karadiv.c \
+	karasqrt.c print_rnd_mode.c
+
+EXTRA_DIST = mpfr.h mpfr-impl.h
diff --git a/src/gmp/mpfr/Makefile.in b/src/gmp/mpfr/Makefile.in
new file mode 100644
index 000000000..b6cf9b35e
--- /dev/null
+++ b/src/gmp/mpfr/Makefile.in
@@ -0,0 +1,423 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Library General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Library General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+INCLUDES = -I$(top_srcdir)
+
+@WANT_MPFR_TRUE@noinst_LTLIBRARIES = @WANT_MPFR_TRUE@libmpfr.la
+
+# FIXME: Add rnd_mode.c when it's clean.
+libmpfr_la_SOURCES = \
+	add.c div_2exp.c neg.c set_dfl_prec.c set_str_raw.c agm.c get_str.c \
+	print_raw.c set_dfl_rnd.c sqrt.c clear.c init.c set_f.c \
+	sub.c cmp.c mul.c round.c set_prec.c cmp_ui.c mul_2exp.c set.c \
+	set_si.c div.c mul_ui.c set_d.c pow.c out_str.c pi.c set_z.c \
+	add_ulp.c log2.c random.c log.c exp.c div_ui.c zeta.c karadiv.c \
+	karasqrt.c print_rnd_mode.c
+
+
+EXTRA_DIST = mpfr.h mpfr-impl.h
+subdir = mpfr
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES = 
+LTLIBRARIES =  $(noinst_LTLIBRARIES)
+
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+libmpfr_la_LDFLAGS = 
+libmpfr_la_LIBADD = 
+am_libmpfr_la_OBJECTS =  add.lo div_2exp.lo neg.lo set_dfl_prec.lo \
+set_str_raw.lo agm.lo get_str.lo print_raw.lo set_dfl_rnd.lo sqrt.lo \
+clear.lo init.lo set_f.lo sub.lo cmp.lo mul.lo round.lo set_prec.lo \
+cmp_ui.lo mul_2exp.lo set.lo set_si.lo div.lo mul_ui.lo set_d.lo pow.lo \
+out_str.lo pi.lo set_z.lo add_ulp.lo log2.lo random.lo log.lo exp.lo \
+div_ui.lo zeta.lo karadiv.lo karasqrt.lo print_rnd_mode.lo
+libmpfr_la_OBJECTS =  $(am_libmpfr_la_OBJECTS)
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(libmpfr_la_SOURCES)
+DIST_COMMON =  README Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(libmpfr_la_SOURCES)
+OBJECTS = $(am_libmpfr_la_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpfr/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-noinstLTLIBRARIES:
+
+clean-noinstLTLIBRARIES:
+	-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
+
+distclean-noinstLTLIBRARIES:
+
+maintainer-clean-noinstLTLIBRARIES:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+
+libmpfr.la: $(libmpfr_la_OBJECTS) $(libmpfr_la_DEPENDENCIES)
+	$(LINK)  $(libmpfr_la_LDFLAGS) $(libmpfr_la_OBJECTS) $(libmpfr_la_LIBADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+
+# 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.
+
+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; \
+	dot_seen=no; \
+	target=`echo $@ | sed s/-recursive//`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    dot_seen=yes; \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+	done; \
+	if test "$$dot_seen" = "no"; then \
+	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+	fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+	@set fnord $(MAKEFLAGS); amf=$$2; \
+	dot_seen=no; \
+	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
+	  rev="$$subdir $$rev"; \
+	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
+	done; \
+	test "$$dot_seen" = "no" && rev=". $$rev"; \
+	target=`echo $@ | sed s/-recursive//`; \
+	for subdir in $$rev; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_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 \
+	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+	done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+   if test "$$subdir" = .; then :; else \
+	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+   fi; \
+	done; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+	for subdir in $(SUBDIRS); do \
+	  if test "$$subdir" = .; then :; else \
+	    test -d $(distdir)/$$subdir \
+	    || mkdir $(distdir)/$$subdir \
+	    || exit 1; \
+	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \
+	      || exit 1; \
+	  fi; \
+	done
+info-am:
+info: info-recursive
+dvi-am:
+dvi: dvi-recursive
+check-am: all-am
+check: check-recursive
+installcheck-am:
+installcheck: installcheck-recursive
+install-exec-am:
+install-exec: install-exec-recursive
+
+install-data-am:
+install-data: install-data-recursive
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-recursive
+uninstall-am:
+uninstall: uninstall-recursive
+all-am: Makefile $(LTLIBRARIES)
+all-redirect: all-recursive
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs: installdirs-recursive
+installdirs-am:
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-noinstLTLIBRARIES mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-recursive
+
+clean-am:  clean-noinstLTLIBRARIES clean-compile clean-libtool \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-recursive
+
+distclean-am:  distclean-noinstLTLIBRARIES distclean-compile \
+		distclean-libtool distclean-tags distclean-generic \
+		clean-am
+	-rm -f libtool
+
+distclean: distclean-recursive
+
+maintainer-clean-am:  maintainer-clean-noinstLTLIBRARIES \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-recursive
+
+.PHONY: mostlyclean-noinstLTLIBRARIES distclean-noinstLTLIBRARIES \
+clean-noinstLTLIBRARIES maintainer-clean-noinstLTLIBRARIES \
+mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool install-recursive \
+uninstall-recursive 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-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+installdirs-am 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/src/gmp/mpfr/README b/src/gmp/mpfr/README
new file mode 100644
index 000000000..2915af66e
--- /dev/null
+++ b/src/gmp/mpfr/README
@@ -0,0 +1,81 @@
+
+                        THE MPFR LIBRARY
+
+     ***** EXPERIMENTAL EXPERIMENTAL EXPERIMENTAL EXPERIMENTAL *****
+     ***** EXPERIMENTAL EXPERIMENTAL EXPERIMENTAL EXPERIMENTAL *****
+     ***** EXPERIMENTAL EXPERIMENTAL EXPERIMENTAL EXPERIMENTAL *****
+
+This is a new function class, 'mpfr', for accurate floating-point arithmetic
+with rounding control. Unlike the 'mpf' function class, 'mpfr' is a smooth
+extension to the IEEE P754 arithmetic. In fact, setting the precision to 53,
+'mpfr' functions should work exactly like IEEE doubles.
+
+This code is *experimental* and it is not fully integrated into GMP. It is
+also not as well tested as the other parts of GMP. The original 'mpfr' library
+integrated into GMP was version 0.4.
+
+This code might at some point replace the 'mpf' library.
+
+
+
+                        MORE INFORMATION
+
+This code was contributed by the French FIABLE project. Please see the 'mpfr'
+project page for more info, http://www.loria.fr/projets/mpfr/
+
+
+
+                          INSTALLATION
+
+To install this package to the libgmp library you add the "--enable-mpfr" to
+configure. This has the unfortune side effect that all programs using GMP
+will also depend on 'libm'.
+
+Two test cases were disabled, 'tcmp' 'tset_d'.
+
+
+
+	                 REPORTING BUGS
+
+Report bugs to bug-gmp@gnu.org and mpfr@loria.fr.  What information is
+needed in a good bug report is described in the manual.  The same address
+can be used for suggesting modifications and enhancements.
+
+
+
+                NOTES FROM THE ORIGINAL INSTALL DOCUMENT
+
+We tested the installation with GMP 2.0.2 on the following architectures:
+
+    Pentium II and III/Linux 2.2.10
+    Alpha 21264/OSF1 V4.0
+    SGI R10000/IRIX 6.5 (both using 32- and 64-bit limbs)
+    Sun UltraSparc/Solaris 2.6
+    HP 9000/HP-UX A.09.05
+    Pentium/Windows with Cygnus compiler
+
+Known problems.
+===============
+
+1) On some architectures (for example Alpha/OSF), the default 'make' command 
+   crashes in step 3. GNU make is preferred.
+
+2) Under HP-UX and Pentium/Linux, don't use the -pedantic option, otherwise
+   gcc complains with the longlong.h file from GMP.
+
+3) On the Alpha, the test file for the square root (tsqrt) may produce
+   errors as follows:
+
+     libm.a differs from mpfr_sqrt for a=9.89438396044940260000e-134, rnd_mode=2
+     libm.a gives 3.14553397063986620000e-67, mpfr_sqrt gives 3.14553397063986680000e-67 (1 ulp)
+     libm.a differs from mpfr_sqrt for a=7.86528588050363750000e+31, rnd_mode=1
+     libm.a gives 8.86864469944739500000e+15, mpfr_sqrt gives 8.86864469944739400000e+15 (-1 ulp)
+
+   Also, Linux on Alpha is known to have problems with IEEE conformance. See
+   http://www.linux.org.uk/VERSION/relnotes.2211.html.
+
+   In most cases, as above, the error comes from the libm.a. On Alpha/Linux,
+   which is known to have a bad libm.a, you may even find errors in the
+   addition or multiplication.
+
+
diff --git a/src/gmp/mpfr/add.c b/src/gmp/mpfr/add.c
new file mode 100644
index 000000000..c9bebe443
--- /dev/null
+++ b/src/gmp/mpfr/add.c
@@ -0,0 +1,404 @@
+/* mpfr_add -- add two floating-point numbers
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+extern void mpfr_sub1 _PROTO((mpfr_ptr, mpfr_srcptr, mpfr_srcptr, 
+			      unsigned char, int));
+
+#define ONE ((mp_limb_t) 1)
+
+/* signs of b and c are supposed equal,
+   diff_exp is the difference between the exponents of b and c,
+   which is supposed >= 0 */
+
+void 
+#if __STDC__
+mpfr_add1(mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, 
+	  unsigned char rnd_mode, int diff_exp) 
+#else
+mpfr_add1(a, b, c, rnd_mode, diff_exp) 
+     mpfr_ptr a; 
+     mpfr_srcptr b; 
+     mpfr_srcptr c; 
+     unsigned char rnd_mode; 
+     int diff_exp;
+#endif
+{
+  mp_limb_t *ap, *bp, *cp, cc, c2, c3=0; unsigned int an,bn,cn; int sh,dif,k;
+  TMP_DECL(marker); 
+
+  TMP_MARK(marker); 
+  ap = MANT(a);
+  bp = MANT(b);
+  cp = MANT(c); 
+  if (ap == bp) {
+    bp = (mp_ptr) TMP_ALLOC(ABSSIZE(b) * BYTES_PER_MP_LIMB); 
+    MPN_COPY (bp, ap, ABSSIZE(b));
+    if (ap == cp) { cp = bp; }
+  }
+  else if (ap == cp)
+    {
+      cp = (mp_ptr) TMP_ALLOC (ABSSIZE(c) * BYTES_PER_MP_LIMB);
+      MPN_COPY(cp, ap, ABSSIZE(c)); 
+    }
+
+  an = (PREC(a)-1)/mp_bits_per_limb+1; /* number of significant limbs of a */
+
+  sh = an*mp_bits_per_limb-PREC(a); /* non-significant bits in low limb */
+  bn = (PREC(b)-1)/mp_bits_per_limb+1; /* number of significant limbs of b */
+  EXP(a) = EXP(b);
+
+  if (SIGN(a)!=SIGN(b)) CHANGE_SIGN(a);
+
+  /* case 1: diff_exp>=prec(a), i.e. c only affects the last bit
+     through rounding */
+  dif = PREC(a)-diff_exp;
+
+  if (dif<=0) { 
+    
+    /* diff_exp>=PREC(a): c does not overlap with a */
+    /* either PREC(b)<=PREC(a), and we can copy the mantissa of b directly 
+       into that of a, or PREC(b)>PREC(a) and we have to round b+c */
+
+    if (PREC(b)<=PREC(a)) {
+
+      MPN_COPY(ap+(an-bn), bp, bn);
+      /* fill low significant limbs with zero */
+
+      for (bp=ap;bn<an;bn++) *bp++=0;
+
+      /* now take c into account */
+      if (rnd_mode==GMP_RNDN) { 
+	
+	/* to nearest */
+	/* if diff_exp > PREC(a), no change */
+
+	if (diff_exp==PREC(a)) {
+
+	  /* if c is not zero, then as it is normalized, we have to add
+	     one to the lsb of a if c>1/2, or c=1/2 and lsb(a)=1 (round to
+	     even) */
+	  
+	  if (NOTZERO(c)) { 
+
+	    /* c is not zero */
+	    /* check whether mant(c)=1/2 or not */
+
+	    cc = *cp - (ONE<<(mp_bits_per_limb-1));
+	    if (cc==0) {
+	      bp = cp+(PREC(c)-1)/mp_bits_per_limb;
+	      while (cp<bp && cc==0) cc = *++cp;
+	    }
+
+	    if (cc || (ap[an-1] & (ONE<<sh))) goto add_one_ulp;
+	    /* mant(c) != 1/2 or mant(c) = 1/2: add 1 iff lsb(a)=1 */
+	  }
+	}
+      }
+      else if ((ISNONNEG(b) && rnd_mode==GMP_RNDU) || 
+	       (ISNEG(b) && rnd_mode==GMP_RNDD)) {
+	
+	/* round up */
+	if (NOTZERO(c)) goto add_one_ulp;
+      }
+      /* in the other cases (round to zero, or up/down with sign -/+),
+         nothing to do */
+    }
+    else { 
+
+      /* PREC(b)>PREC(a) : we have to round b+c */      
+      k=bn-an;
+
+      /* first copy the 'an' most significant limbs of b to a */
+      MPN_COPY(ap, bp+k, an);
+      if (rnd_mode==GMP_RNDN) { 
+	
+	/* to nearest */
+	/* first check whether the truncated bits from b are 1/2*lsb(a) */
+	
+	if (sh) {
+	  cc = *ap & ((ONE<<sh)-1);
+	  *ap &= ~cc; /* truncate last bits */
+	  cc -= ONE<<(sh-1);
+	}
+	else /* no bit to truncate */
+	  cc = bp[--k] - (ONE<<(mp_bits_per_limb-1));
+
+	if ((long)cc>0) goto add_one_ulp; /* trunc(b)>1/2*lsb(a) -> round up */
+	else if (cc==0) {
+
+	  while (k>1 && cc==0) cc=bp[--k];
+
+	  /* now if the truncated part of b = 1/2*lsb(a), check whether c=0 */
+	  if (NOTZERO(c) || (*ap & (ONE<<sh))) goto add_one_ulp;
+	  /* if trunc(b)+c is exactly 1/2*lsb(a) : round to even lsb */
+	}
+
+	/* if cc<0 : trunc(b) < 1/2*lsb(a) -> round down, i.e. do nothing */
+      }
+      else if ((ISNONNEG(b) && rnd_mode==GMP_RNDU) || 
+	       (ISNEG(b) && rnd_mode==GMP_RNDD)) {
+
+	/* first check whether trunc(b)+c is zero or not */
+	if (sh) {
+	  cc = *ap & ((ONE<<sh)-1); *ap &= ~cc; /* truncate last bits */
+	}
+	else cc = bp[--k] - (ONE<<(mp_bits_per_limb-1));
+	while (cc==0 && k>1) cc=bp[--k];
+	if (cc || NOTZERO(c)) goto add_one_ulp;
+      }
+
+      /* in the other cases (round to zero, or up/down with sign -/+),
+         nothing to do, since b and c don't overlap, there can't be any
+	 carry */
+
+    }
+  }
+  else { 
+    /* diff_exp < PREC(a) : c overlaps with a by dif bits */
+    /* first copy upper part of c into a (after shift) */
+    unsigned char overlap;
+    
+    k = (dif-1)/mp_bits_per_limb + 1; /* only the highest k limbs from c
+					 have to be considered */
+    cn = (PREC(c)-1)/mp_bits_per_limb + 1;
+    MPN_ZERO(ap+k, an-k); /* do it now otherwise ap[k] may be destroyed
+			     in case dif<0 */
+
+    if (dif<=PREC(c)) { 
+      /* c has to be truncated */
+      dif = dif % mp_bits_per_limb;
+      dif = (dif) ? mp_bits_per_limb-dif-sh : -sh;
+
+      /* we have to shift by dif bits to the right */
+
+      if (dif>0) mpn_rshift(ap, cp+(cn-k), k, dif);
+      else if (dif<0) {
+	ap[k] = mpn_lshift(ap, cp+(cn-k), k, -dif);
+
+	/* put the non-significant bits in low limb for further rounding */
+
+	if (cn >= k+1)
+	  ap[0] += cp[cn-k-1]>>(mp_bits_per_limb+dif);
+      }
+      else MPN_COPY(ap, cp+(cn-k), k);
+      overlap=1;
+    }
+    else { 
+
+      /* c is not truncated, but we have to fill low limbs with 0 */
+
+      k = diff_exp/mp_bits_per_limb;
+      overlap = diff_exp%mp_bits_per_limb;
+
+      /* warning: a shift of zero bit is not allowed */
+      MPN_ZERO(ap, an-k-cn); 
+      if (overlap) { 
+	cc=mpn_rshift(ap+(an-k-cn), cp, cn, overlap); 
+	if (an-k-cn>0) ap[an-k-cn-1]=cc;
+      }
+      else MPN_COPY(ap+(an-k-cn), cp, cn);
+      overlap=0;
+    }
+
+    /* here overlap=1 iff ulp(c)<ulp(a) */
+    /* then put high limbs to zero */
+    /* now add 'an' upper limbs of b in place */
+
+    if (PREC(b)<=PREC(a)) {
+      overlap += 2;
+      cc = mpn_add_n(ap+(an-bn), ap+(an-bn), bp, bn);
+    }
+    else
+      /* PREC(b) > PREC(a): we have to truncate b */
+      cc = mpn_add_n(ap, ap, bp+(bn-an), an); 
+
+    if (cc) { 
+
+      /* shift one bit to the right */
+
+      c3 = (ap[0]&1) && (PREC(a)%mp_bits_per_limb==0);
+      mpn_rshift(ap, ap, an, 1);
+      ap[an-1] += ONE<<(mp_bits_per_limb-1);
+      EXP(a)++;
+    }
+    
+    /* remains to do the rounding */
+
+    if (rnd_mode==GMP_RNDN) { 
+
+      /* to nearest */
+
+      int kc;
+      
+      /* four cases: overlap =
+         (0) PREC(b) > PREC(a) and diff_exp+PREC(c) <= PREC(a)
+         (1) PREC(b) > PREC(a) and diff_exp+PREC(c) > PREC(a)
+         (2) PREC(b) <= PREC(a) and diff_exp+PREC(c) <= PREC(a)
+         (3)  PREC(b) <= PREC(a) and diff_exp+PREC(c) > PREC(a) */
+      
+      switch (overlap)
+	{
+        case 1: /* both b and c to round */
+	  kc = cn-k; /* remains kc limbs from c */
+	  k = bn-an; /* remains k limbs from b */
+	
+	  /* truncate last bits and store the difference with 1/2*ulp in cc */
+
+	  cc = *ap & ((ONE<<sh)-1);
+	  *ap &= ~cc; /* truncate last bits */
+	  cc -= ONE<<(sh-1);
+	  while ((cc==0 || cc==-1) && k!=0 && kc!=0) {
+	    kc--;
+	    cc += mpn_add_1(&c2, bp+(--k), 1,(cp[kc+1]<<(mp_bits_per_limb-dif))
+			    +(cp[kc]>>dif));
+	    if (cc==0 || cc==-1) cc=c2;
+	  }
+	  if ((long)cc>0) goto add_one_ulp;
+	  else if ((long)cc<-1) 
+	    { TMP_FREE(marker); return; /* the carry can be at most 1 */ }
+	  else if (kc==0) goto round_b;
+
+	  /* else round c: go through */
+
+	case 3: /* only c to round */
+	  bp=cp; k=cn-k; goto to_nearest;
+
+	case 0: /* only b to round */
+        round_b:
+	  k=bn-an; dif=0; goto to_nearest;
+        
+	  /* otherwise the result is exact: nothing to do */
+	}
+    }
+    else if ((ISNONNEG(b) && rnd_mode==GMP_RNDU) || 
+	     (ISNEG(b) && rnd_mode==GMP_RNDD)) {
+      cc = *ap & ((ONE<<sh)-1);
+      *ap &= ~cc; /* truncate last bits */
+      if (cc || c3) goto add_one_ulp; /* will happen most of the time */
+      else { 
+	
+	/* same four cases too */
+	
+	int kc = cn-k; /* remains kc limbs from c */
+	switch (overlap)
+	{
+        case 1: /* both b and c to round */
+	  k = bn-an; /* remains k limbs from b */
+	  while (cc==0 && k!=0 && kc!=0) {
+	    kc--;
+	    cc = mpn_add_1(&c2, bp+(--k), 1,(cp[kc+1]<<(mp_bits_per_limb-dif))
+			   + (cp[kc]>>dif));
+	  }
+	  if (cc) goto add_one_ulp;
+	  else if (kc==0) goto round_b2;
+	  /* else round c: go through */
+	case 3: /* only c to round */
+	  while (kc) if (cp[--kc]) goto add_one_ulp;
+	  /* if dif>0 : remains to check last dif bits from c */
+	  if (dif>0 && (cp[0]<<(mp_bits_per_limb-dif))) goto add_one_ulp;
+	  break;
+	case 0: /* only b to round */
+        round_b2:
+	  k=bn-an;
+	  while (k) if (bp[--k]) goto add_one_ulp;
+        /* otherwise the result is exact: nothing to do */
+	}
+      }
+    }
+    /* else nothing to do: round towards zero, i.e. truncate last sh bits */
+    else 
+      *ap &= ~((ONE<<sh)-1);
+  }
+  goto end_of_add;
+    
+  to_nearest: /* 0 <= sh < mp_bits_per_limb : number of bits of a to truncate
+                 bp[k] : last significant limb from b */
+        if (sh) {
+	  cc = *ap & ((ONE<<sh)-1);
+	  *ap &= ~cc; /* truncate last bits */
+	  c2 = ONE<<(sh-1);
+	}
+	else /* no bit to truncate */
+	  { if (k) cc = bp[--k]; else cc = 0; c2 = ONE<<(mp_bits_per_limb-1); }
+	if (cc>c2) goto add_one_ulp; /* trunc(b)>1/2*lsb(a) -> round up */
+	else if (cc==c2) {
+	  cc=0; while (k && cc==0) cc=bp[--k];
+	  /* special case of rouding c shifted to the right */
+	  if (cc==0 && dif>0) cc=cp[0]<<(mp_bits_per_limb-dif);
+	  /* now if the truncated part of b = 1/2*lsb(a), check whether c=0 */
+	  if (cc || (*ap & (ONE<<sh))) goto add_one_ulp;
+	}
+        goto end_of_add;
+
+  add_one_ulp: /* add one unit in last place to a */
+    cc = mpn_add_1(ap, ap, an, ONE<<sh);
+    if (cc) { fprintf(stderr, "carry(3) in mpfr_add\n"); exit(1); }
+
+ end_of_add:
+  TMP_FREE(marker); 
+  return;
+}
+
+void
+#if __STDC__
+mpfr_add(mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, 
+	      unsigned char rnd_mode) 
+#else
+mpfr_add(a, b, c, rnd_mode)
+     mpfr_ptr a; 
+     mpfr_srcptr b; 
+     mpfr_srcptr c; 
+     unsigned char rnd_mode; 
+#endif
+{
+  int diff_exp;
+
+  if (FLAG_NAN(b) || FLAG_NAN(c)) {
+    SET_NAN(a); return;
+  }
+
+  if (!NOTZERO(b)) { mpfr_set(a, c, rnd_mode); return; }
+  if (!NOTZERO(c)) { mpfr_set(a, b, rnd_mode); return; }
+
+  diff_exp = EXP(b)-EXP(c);
+  if (SIGN(b) != SIGN(c)) { /* signs differ, it's a subtraction */
+    if (diff_exp<0) {
+      mpfr_sub1(a, c, b, rnd_mode, -diff_exp);
+    }
+    else if (diff_exp>0) mpfr_sub1(a, b, c, rnd_mode, diff_exp);
+    else { /* diff_exp=0 */
+      diff_exp = mpfr_cmp3(b,c,-1);
+      /* if b>0 and diff_exp>0 or b<0 and diff_exp<0: abs(b) > abs(c) */
+      if (diff_exp==0) SET_ZERO(a);
+      else if (diff_exp*SIGN(b)>0) mpfr_sub1(a, b, c, rnd_mode, 0);
+      else mpfr_sub1(a, c, b, rnd_mode, 0);
+    }
+  }
+  else /* signs are equal, it's an addition */
+    if (diff_exp<0) mpfr_add1(a, c, b, rnd_mode, -diff_exp);
+    else mpfr_add1(a, b, c, rnd_mode, diff_exp);
+}
+
diff --git a/src/gmp/mpfr/add_ulp.c b/src/gmp/mpfr/add_ulp.c
new file mode 100644
index 000000000..7a8fa6150
--- /dev/null
+++ b/src/gmp/mpfr/add_ulp.c
@@ -0,0 +1,64 @@
+/* mpfr_add_one_ulp, mpfr_sub_one_ulp -- add/subtract one unit in last place
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+/* sets x to x+sign(x)*2^(EXP(x)-PREC(x)) */
+int 
+#if __STDC__
+mpfr_add_one_ulp(mpfr_ptr x)
+#else
+mpfr_add_one_ulp(x)
+     mpfr_ptr x; 
+#endif
+{
+  int xn, sh; mp_limb_t *xp;
+
+  xn = 1 + (PREC(x)-1)/BITS_PER_MP_LIMB;
+  sh = xn*BITS_PER_MP_LIMB - PREC(x);
+  xp = MANT(x);
+  if (mpn_add_1(xp, xp, xn, (mp_limb_t)1<<sh)) {
+    EXP(x)++;
+    mpn_rshift(xp, xp, xn, 1);
+    xp[xn-1] += (mp_limb_t)1<<(BITS_PER_MP_LIMB-1);
+  }
+  return 0;
+}
+
+/* sets x to x-sign(x)*ulp(x) */
+int mpfr_sub_one_ulp(mpfr_ptr x)
+{
+  int xn, sh; mp_limb_t *xp;
+
+  xn = 1 + (PREC(x)-1)/BITS_PER_MP_LIMB;
+  sh = xn*BITS_PER_MP_LIMB-PREC(x);
+  xp = MANT(x);
+  mpn_sub_1(xp, xp, xn, (mp_limb_t)1<<sh);
+  if (xp[xn-1] >> (BITS_PER_MP_LIMB-1) == 0) {
+    /* was an exact power of two: not normalized any more */
+    EXP(x)--;
+    mpn_lshift(xp, xp, xn, 1);
+    *xp |= ((mp_limb_t)1 << sh);
+  }
+  return 0;
+}
diff --git a/src/gmp/mpfr/agm.c b/src/gmp/mpfr/agm.c
new file mode 100644
index 000000000..e4c700961
--- /dev/null
+++ b/src/gmp/mpfr/agm.c
@@ -0,0 +1,172 @@
+/* mpfr_agm -- arithmetic-geometric mean of two floating-point numbers
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+
+/*Memory gestion */
+#define MON_INIT(xp, x, p, s) xp = (mp_ptr) TMP_ALLOC(s*BYTES_PER_MP_LIMB);    x -> _mp_prec = p; x -> _mp_d = xp; x -> _mp_size = s; x -> _mp_exp = 0; 
+
+
+
+
+void 
+#ifdef __STDC__
+mpfr_agm(mpfr_ptr r, mpfr_srcptr op2, mpfr_srcptr op1, unsigned char rnd_mode)
+#else
+mpfr_agm(r, a, b, rnd_mode)
+     mpfr_ptr r; 
+     mpfr_srcptr a; 
+     mpfr_srcptr b; 
+     unsigned char rnd_mode; 
+#endif
+{
+  int s, p, q, go_on;
+  double uo, vo;
+  mp_limb_t *up, *vp, *tmpp, *tmpup, *tmpvp, *ap, *bp;
+  mpfr_t u, v, tmp, tmpu, tmpv, a, b;
+  TMP_DECL(marker1);
+  TMP_DECL(marker2);
+
+
+  /* If a or b is NaN, the result is NaN */
+  if (FLAG_NAN(op1) || FLAG_NAN(op2)) 
+    { SET_NAN(r); return; }
+
+
+  /* If a or b is negative, the result is NaN */
+  if ((SIGN(op1)<0)||(SIGN(op2)<0))
+    { SET_NAN(r); return; }
+
+
+  
+  /* If a or b is 0, the result is 0 */
+  if ((SIGN(op1)==0)||(SIGN(op2)==0)) 
+    { SET_ZERO(r);
+    return;
+    }
+
+ /* precision of the following calculus */
+  q = PREC(r);
+  p = q + 15;
+
+
+  /* Initialisations */
+  go_on=1;
+ 
+  TMP_MARK(marker1);
+  s=(p-1)/BITS_PER_MP_LIMB+1;
+  MON_INIT(ap, a, p, s);  
+  MON_INIT(bp, b, p, s);
+  TMP_MARK(marker2);
+  MON_INIT(up, u, p, s);
+  MON_INIT(vp, v, p, s);   
+  MON_INIT(tmpup, tmpu, p, s);  
+  MON_INIT(tmpvp, tmpv, p, s);  
+  MON_INIT(tmpp, tmp, p, s);  
+
+
+
+  /* b and a will be the 2 operands but I want b>= a */
+  if (mpfr_cmp(op1,op2) > 0) {
+    mpfr_set(b,op1,GMP_RNDN); mpfr_set(a,op2,GMP_RNDN);  
+  }
+  else {
+    mpfr_set(b,op2,GMP_RNDN); mpfr_set(a,op1,GMP_RNDN);  
+  }
+    
+  vo=mpfr_get_d(b);
+  uo=mpfr_get_d(a);
+
+  mpfr_set(u,a,GMP_RNDN);
+  mpfr_set(v,b,GMP_RNDN);
+ 
+
+  /* Main loop */
+
+  while (go_on) {
+    int err,  eq, can_round;
+    
+    eq=0;
+    
+    err=ceil((3.0/2.0*log((double)p)/log(2.0)+1.0)*exp(-(double)p*log(2.0))+3.0*exp(-2.0*(double)p*uo*log(2.0)/(vo-uo)));
+    if(p-err-3<=q) {
+      p=q+err+4;
+      err=ceil((3.0/2.0*log((double)p)/log(2.0)+1.0)*exp(-(double)p*log(2.0))+3.0*exp(-2.0*(double)p*uo*log(2.0)/(vo-uo)));
+    }
+
+    /* Calculus of un and vn */
+    while (eq<=p-2) {
+      mpfr_mul(tmp,u,v,GMP_RNDN);
+      mpfr_sqrt(tmpu,tmp,GMP_RNDN); 
+      mpfr_add(tmp,u,v,GMP_RNDN);
+      mpfr_div_2exp(tmpv,tmp,1,GMP_RNDN);
+      mpfr_set(u,tmpu,GMP_RNDN);
+      mpfr_set(v,tmpv,GMP_RNDN);
+      if (mpfr_cmp(v,u)>=0)
+	eq=mpfr_cmp2(v,u);
+      else
+	eq=mpfr_cmp2(u,v);
+    }
+
+    /*  printf("avant can_round %i bits faux\n v : ",err+3);  
+	mpfr_print_raw(v); printf("\n u : ");
+	mpfr_print_raw(u);printf("\n");*/ 
+    
+
+    /* Roundability of the result */
+      can_round=mpfr_can_round(v,p-err-3,GMP_RNDN,rnd_mode,q);
+    
+      if (can_round)
+	go_on=0;
+
+      else {
+	  go_on=1;
+	  p+=5;
+	  TMP_FREE(marker2); 
+	  TMP_MARK(marker2);
+	  s=(p-1)/BITS_PER_MP_LIMB+1;
+	  MON_INIT(up, u, p, s);
+	  MON_INIT(vp, v, p, s);   
+	  MON_INIT(tmpup, tmpu, p, s);  
+	  MON_INIT(tmpvp, tmpv, p, s);  
+	  MON_INIT(tmpp, tmp, p, s);
+	  mpfr_set(u,a,GMP_RNDN);
+	  mpfr_set(v,b,GMP_RNDN);
+      }
+  }
+  /* End of while */
+
+  /* Setting of the result */
+
+    mpfr_set(r,v,rnd_mode);
+
+
+  /* Let's clean */
+    TMP_FREE(marker1); 
+  
+  return ;
+}
+
diff --git a/src/gmp/mpfr/clear.c b/src/gmp/mpfr/clear.c
new file mode 100644
index 000000000..371c1a766
--- /dev/null
+++ b/src/gmp/mpfr/clear.c
@@ -0,0 +1,36 @@
+/* mpfr_clear -- free the memory space allocated for a floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+void
+#if __STDC__
+mpfr_clear (mpfr_ptr m)
+#else
+mpfr_clear (m)
+     mpfr_ptr m;
+#endif
+{
+  (*_mp_free_func) (m->_mp_d, ((m->_mp_prec>>3) + 1));
+}
diff --git a/src/gmp/mpfr/cmp.c b/src/gmp/mpfr/cmp.c
new file mode 100644
index 000000000..b64506b03
--- /dev/null
+++ b/src/gmp/mpfr/cmp.c
@@ -0,0 +1,219 @@
+/* mpfr_cmp -- compare two floating-point numbers
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+/* returns 0 iff b = c
+            a positive value iff b > c
+            a negative value iff b < c
+
+More precisely, in case b and c are of same sign, the absolute value 
+of the result is one plus the absolute difference between the exponents 
+of b and c, i.e. one plus the number of bits shifts to align b and c
+(this value is useful in mpfr_sub).
+
+*/
+
+/* #define DEBUG */
+
+/* compares b and sign(s)*c */
+int 
+#if __STDC__
+mpfr_cmp3 ( mpfr_srcptr b, mpfr_srcptr c, long int s)
+#else
+mpfr_cmp3(b, c, s)
+     mpfr_srcptr b;
+     mpfr_srcptr c; 
+     long int s;
+#endif
+{
+   long int diff_exp;
+   unsigned long bn, cn;
+   mp_limb_t *bp, *cp;
+
+   if (!NOTZERO(b) && !NOTZERO(c)) { return 0; }
+   s = s*SIGN(b)*SIGN(c);
+   if (s<0) return(SIGN(b));
+
+   /* now signs are equal */
+
+   diff_exp = EXP(b)-EXP(c);
+   s = (SIGN(b)>0) ? 1 : -1;
+
+   if (diff_exp>0) return(s*(1+diff_exp));
+   else if (diff_exp<0) return(s*(-1+diff_exp));
+   /* both signs and exponents are equal */
+
+   bn = (PREC(b)-1)/mp_bits_per_limb+1;
+   cn = (PREC(c)-1)/mp_bits_per_limb+1;
+   bp = MANT(b); cp = MANT(c);
+
+   while (bn && cn) {
+     if (bp[--bn] != cp[--cn])
+       return((bp[bn]>cp[cn]) ? s : -s);
+   }
+
+   if (bn) { while (bn) if (bp[--bn]) return(s); }
+   else if (cn) while (cn) if (cp[--cn]) return(-s);
+
+   return 0;
+}
+
+/* returns the number of cancelled bits when one subtracts abs(c) from abs(b). 
+   Assumes b>=c, which implies EXP(b)>=EXP(c).
+   if b=c, returns prec(b).
+*/
+int 
+#if __STDC__
+mpfr_cmp2 ( mpfr_srcptr b, mpfr_srcptr c )
+#else
+mpfr_cmp2(b, c)
+     mpfr_srcptr b; 
+     mpfr_srcptr c; 
+#endif
+{
+  long int d, bn, cn, k, z;
+  mp_limb_t *bp, *cp, t, u=0, cc=0;
+
+#ifdef DEBUG
+  printf("b="); mpfr_print_raw(b); putchar('\n');
+  printf("c="); mpfr_print_raw(c); putchar('\n');
+#endif  
+  if (NOTZERO(c)==0) return (NOTZERO(b)) ? 0 : PREC(b);
+  d = EXP(b)-EXP(c);
+  k = 0; /* result can be d or d+1 if d>1, or >= d otherwise */
+  /* k is the number of identical bits in the high part,
+     then z is the number of possibly cancelled bits */
+#ifdef DEBUG
+  if (d<0) { printf("assumption EXP(b)<EXP(c) violated\n"); exit(1); }
+#endif
+  bn = (PREC(b)-1)/mp_bits_per_limb;
+  cn = (PREC(c)-1)/mp_bits_per_limb;
+  bp = MANT(b); cp = MANT(c);
+  /* subtract c from b from most significant to less significant limbs,
+     and first determines first non zero limb difference */
+  if (d)
+    {
+      cc = bp[bn--];
+      if (d<mp_bits_per_limb)
+	cc -= cp[cn]>>d; 
+    }
+  else { /* d=0 */
+    while (bn>=0 && cn>=0 && (cc=(bp[bn--]-cp[cn--]))==0) {
+      k+=mp_bits_per_limb;
+    }
+
+    if (cc==0) { /* either bn<0 or cn<0 */
+      while (bn>=0 && (cc=bp[bn--])==0) k+=mp_bits_per_limb;
+    }
+    /* now bn<0 or cc<>0 */
+    if (cc==0 && bn<0) return(PREC(b));
+  }
+
+  /* the first non-zero limb difference is cc, and the number
+     of cancelled bits in the upper limbs is k */
+
+  count_leading_zeros(u, cc);
+  k += u; 
+
+  if (cc != (1<<(mp_bits_per_limb-u-1))) return k;
+
+  /* now cc is an exact power of two */
+  if (cc != 1) 
+    /* We just need to compare the following limbs */
+    /* until two of them differ. The result is either k or k+1. */
+    {
+      /* First flush all the unmatched limbs of b ; they all have to
+	 be 0 in order for the process to go on */
+      while (bn >= 0)
+	{
+	  if (cn < 0) { return k; }
+	  t = bp[bn--]; 
+	  if (d < mp_bits_per_limb)
+	    {
+	      if (d) 
+		{ 
+		  u = cp[cn--] << (mp_bits_per_limb - d); 
+		  if (cn >= 0) u+=(cp[cn]>>d); 
+		}
+	      else u = cp[cn--]; 
+	      
+	      if (t > u || (t == u && cn < 0)) return k; 
+	      if (t < u) return k+1; 
+	    }
+	  else
+	    if (t) return k; else d -= mp_bits_per_limb; 
+	}
+	  
+      /* bn < 0; if some limb of c is nonzero, return k+1, otherwise return k*/
+
+      if (cn>=0 && (cp[cn--] << (mp_bits_per_limb - d))) { return k+1; }
+
+      while (cn >= 0) 
+	if (cp[cn--]) return k+1; 
+      return k; 
+    }
+
+  /* cc = 1. Too bad. */
+  z = 0; /* number of possibly cancelled bits - 1 */
+  /* thus result is either k if low(b) >= low(c)
+                        or k+z+1 if low(b) < low(c) */
+  if (d > mp_bits_per_limb) { return k; }
+
+  while (bn >= 0)
+    { 
+      if (cn < 0) { return k; }
+
+      if (d) 
+	 { 
+	   u = cp[cn--] << (mp_bits_per_limb - d); 
+	   if (cn >= 0) u+=(cp[cn]>>d);
+	 }
+       else u = cp[cn--]; 
+
+      /* bp[bn--] > cp[cn--] : no borrow possible, k unchanged
+	 bp[bn--] = cp[cn--] : need to consider next limbs
+         bp[bn--] < cp[cn--] : borrow
+      */
+       if ((cc = bp[bn--]) != u) {
+	 if (cc>u) return k;
+	 else { count_leading_zeros(u, cc-u); return k + 1 + z + u; }
+       }
+       else z += mp_bits_per_limb; 
+    }
+
+  if (cn >= 0)
+    count_leading_zeros(cc, ~(cp[cn--] << (mp_bits_per_limb - d))); 
+  else { cc = 0; }
+
+  k += cc; 
+  if (cc < d) return k;
+  
+  while (cn >= 0 && !~cp[cn--]) { z += mp_bits_per_limb; } 
+  if (cn >= 0) { count_leading_zeros(cc, ~cp[cn--]); return (k + z + cc); }
+
+  return k; /* We **need** that the nonsignificant limbs of c are set
+	       to zero there */	       
+}
diff --git a/src/gmp/mpfr/cmp_ui.c b/src/gmp/mpfr/cmp_ui.c
new file mode 100644
index 000000000..48217a520
--- /dev/null
+++ b/src/gmp/mpfr/cmp_ui.c
@@ -0,0 +1,116 @@
+/* mpfr_cmp_ui -- compare a floating-point number with a machine integer
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+/* returns a positive value if b>i*2^f,
+           a negative value if b<i*2^f,
+           zero if b=i*2^f
+*/
+
+int 
+#if __STDC__
+mpfr_cmp_ui_2exp ( mpfr_srcptr b, unsigned long int i, int f )
+#else
+mpfr_cmp_ui_2exp (b, i, f)
+     mpfr_srcptr b; 
+     unsigned long int i; 
+     int f; 
+#endif
+{
+  int e, k, bn; mp_limb_t c, *bp;
+
+  if (SIGN(b)<0) return -1;
+  else if (!NOTZERO(b)) return((i) ? -1 : 0);
+  else { /* b>0 */
+    e = EXP(b); /* 2^(e-1) <= b < 2^e */
+    if (e>f+mp_bits_per_limb) return 1;
+
+    c = (mp_limb_t) i;
+    count_leading_zeros(k, c);
+    k = f+mp_bits_per_limb - k; /* 2^(k-1) <= i*2^f < 2^k */
+    if (k!=e) return (e-k);
+
+    /* now k=e */
+    c <<= (f+mp_bits_per_limb-k);
+    bn = (PREC(b)-1)/mp_bits_per_limb;
+    bp = MANT(b) + bn;
+    if (*bp>c) return 1;
+    else if (*bp<c) return -1;
+
+    /* most significant limbs agree, check remaining limbs from b */
+    while (--bn>=0)
+      if (*--bp) return 1;
+    return 0;
+  }
+}
+
+/* returns a positive value if b>i*2^f,
+           a negative value if b<i*2^f,
+           zero if b=i*2^f 
+*/
+
+int 
+#if __STDC__
+mpfr_cmp_si_2exp ( mpfr_srcptr b, long int i, int f )
+#else
+mpfr_cmp_si_2exp(b, i, f)
+     mpfr_srcptr b; 
+     long int i; 
+     int f; 
+#endif
+{
+  int e, k, bn, si; mp_limb_t c, *bp;
+
+  si = (i<0) ? -1 : 1; /* sign of i */
+  if (SIGN(b)*i<0) return SIGN(b); /* both signs differ */
+  else if (!NOTZERO(b) || (i==0)) { /* one is zero */
+    if (i==0) return ((NOTZERO(b)) ? SIGN(b) : 0);
+    else return si; /* b is zero */
+      
+  }
+  else { /* b and i are of same sign */
+    e = EXP(b); /* 2^(e-1) <= b < 2^e */
+    if (e>f+mp_bits_per_limb) return si;
+
+    c = (mp_limb_t) ((i<0) ? -i : i);
+    count_leading_zeros(k, c);
+    k = f+mp_bits_per_limb - k; /* 2^(k-1) <= i*2^f < 2^k */
+    if (k!=e) return (si*(e-k));
+
+    /* now k=e */
+    c <<= (f+mp_bits_per_limb-k);
+    bn = (PREC(b)-1)/mp_bits_per_limb;
+    bp = MANT(b) + bn;
+    if (*bp>c) return si;
+    else if (*bp<c) return -si;
+
+    /* most significant limbs agree, check remaining limbs from b */
+    while (--bn>=0)
+      if (*--bp) return si;
+    return 0;
+  }
+}
+
diff --git a/src/gmp/mpfr/div.c b/src/gmp/mpfr/div.c
new file mode 100644
index 000000000..ee1475694
--- /dev/null
+++ b/src/gmp/mpfr/div.c
@@ -0,0 +1,247 @@
+/* mpfr_div -- divide two floating-point numbers
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+#include "longlong.h"
+
+/* #define DEBUG */
+
+void
+mpfr_div (mpfr_ptr r, mpfr_srcptr u, mpfr_srcptr v, unsigned char rnd_mode)
+{
+  mp_srcptr up, vp;
+  mp_ptr rp, tp, tp0, tmp;
+  mp_size_t usize, vsize, rrsize;
+  mp_size_t rsize;
+  mp_size_t sign_quotient;
+  mp_size_t prec, err;
+  mp_limb_t q_limb;
+  mp_exp_t rexp;
+  long k, mult, vn; 
+  unsigned long cc = 0, rw, nw; 
+  char can_round = 0; 
+  TMP_DECL (marker);
+
+  if (FLAG_NAN(u) || FLAG_NAN(v)) { SET_NAN(r); return; }
+  
+  usize = (PREC(u) - 1)/BITS_PER_MP_LIMB + 1; 
+  vsize = (PREC(v) - 1)/BITS_PER_MP_LIMB + 1; 
+  sign_quotient = (SIGN(u) == SIGN(v) ? 1 : -1); 
+  prec = PREC(r);
+
+  if (!NOTZERO(u)) { SET_ZERO(r); return; }
+
+  if (!NOTZERO(v))
+    vsize = 1 / v->_mp_d[vsize - 1];    /* Gestion des infinis ? */
+  
+  if (!NOTZERO(v))
+    {
+      r->_mp_exp = 0;
+      MPN_ZERO(r->_mp_d, r->_mp_size); 
+      return;
+    }
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+
+#ifdef DEBUG
+      printf("Entering division : "); 
+      for(k = usize - 1; k >= 0; k--) { printf("%lu ", up[k]); }
+      printf(" by "); 
+      for(k = vsize - 1; k >= 0; k--) { printf("%lu ", vp[k]); }
+      printf(".\n"); 
+#endif
+
+  /* Compare the mantissas */
+  mult = mpn_cmp(up, vp, (usize > vsize ? vsize : usize)); 
+  if (mult == 0 && vsize > usize)
+    {
+      vn = vsize - usize; 
+      while (vn >= 0) if (vp[vn--]) { mult = 1; break; }
+      /* On peut diagnostiquer ici pour pas cher le cas u = v */
+    }
+  else { mult = (mult < 0 ? 1 : 0); }
+
+  rsize = (PREC(r) + 3)/BITS_PER_MP_LIMB + 1; 
+  rrsize = PREC(r)/BITS_PER_MP_LIMB + 1;
+  /* Three extra bits are needed in order to get the quotient with enough
+     precision ; take one extra bit for rrsize in order to solve more 
+     easily the problem of rounding to nearest. */
+
+  /* ATTENTION, USIZE DOIT RESTER > A VSIZE !!!!!!!! */
+
+  do
+    {
+      TMP_MARK (marker);
+
+      rexp = u->_mp_exp - v->_mp_exp;
+      
+      err = rsize*BITS_PER_MP_LIMB; 
+      if (rsize < vsize) { err-=2; } 
+      if (rsize < usize) { err--; }
+      if (err > rrsize * BITS_PER_MP_LIMB) 
+	{ err = rrsize * BITS_PER_MP_LIMB; }
+      
+      tp0 = (mp_ptr) TMP_ALLOC ((rsize+rrsize) * BYTES_PER_MP_LIMB);
+      /* fill by zero rrsize low limbs of t */
+      MPN_ZERO(tp0, rrsize); tp = tp0 + rrsize; 
+      tmp = (mp_ptr) TMP_ALLOC (rsize * BYTES_PER_MP_LIMB);
+      rp = (mp_ptr) TMP_ALLOC (rrsize * BYTES_PER_MP_LIMB); 
+
+      if (vsize >= rsize) { 
+	MPN_COPY (tmp, vp + vsize - rsize, rsize);
+      }
+      else { 
+	MPN_COPY (tmp + rsize - vsize, vp, vsize);
+	MPN_ZERO (tmp, rsize - vsize); 
+      }
+
+      if (usize >= rsize) { 
+	MPN_COPY (tp, up + usize - rsize, rsize);
+      }
+      else {
+	MPN_COPY (tp + rsize - usize, up, usize); 
+	MPN_ZERO (tp, rsize - usize); 
+      }
+
+      /* Do the real job */
+ 
+#ifdef DEBUG
+      printf("Dividing : "); 
+      for(k = rsize - 1; k >= 0; k--) { printf("%lu ", tp[k]); }
+      printf(" by "); 
+      for(k = rsize - 1; k >= 0; k--) { printf("%lu ", tmp[k]); }
+      printf(".\n"); 
+#endif
+
+      q_limb = (rsize==rrsize) /* use Burnikel-Ziegler algorithm */
+	? mpn_divrem_n (rp, tp0, tmp, rsize)
+	: mpn_divrem (rp, 0, tp0, rsize+rrsize, tmp, rsize);
+      tp = tp0; /* location of remainder */
+
+#ifdef DEBUG
+      printf("The result is : \n"); 
+      printf("Quotient : "); 
+      for(k = rrsize - 1; k >= 0; k--) { printf("%lu ", rp[k]); }
+      printf("Remainder : "); 
+      for(k = rsize - 1; k >= 0; k--) { printf("%lu ", tp[k]); }
+      printf("(q_limb = %lu)\n", q_limb); 
+#endif
+      
+      /* msb-normalize the result */
+      
+      if (q_limb)
+	{
+	  count_leading_zeros(k, q_limb); 
+	  mpn_rshift(rp, rp, rrsize, BITS_PER_MP_LIMB - k); 
+	  rp[rrsize - 1] |= (q_limb << k);  
+	  rexp += BITS_PER_MP_LIMB - k; 
+	}
+      else
+	{ 
+	  count_leading_zeros(k, rp[rrsize - 1]); 
+	  if (k) { mpn_lshift(rp, rp, rrsize, k); }
+	  rexp -= k; 
+	}
+
+      can_round = (mpfr_can_round_raw(rp, rrsize, sign_quotient, err, 
+				     GMP_RNDN, rnd_mode, PREC(r))
+	|| (usize == rsize && vsize == rsize && 
+	    mpfr_can_round_raw(rp, rrsize, sign_quotient, err, 
+			       GMP_RNDZ, rnd_mode, PREC(r)))); 
+
+      /* If we used all the limbs of both the dividend and the divisor, 
+	 then we have the correct RNDZ rounding */
+
+      if (!can_round && (rsize < usize || rsize < vsize)) 
+	{ 
+#ifdef DEBUG
+	  printf("Increasing the precision.\n"); 
+#endif
+	  printf("#"); 
+	  TMP_FREE(marker); 
+	}
+    }
+  while (!can_round && (rsize < usize || rsize < vsize) 
+	 && (rsize++) && (rrsize++)); 
+
+  /* ON PEUT PROBABLEMENT SE DEBROUILLER DES QUE rsize >= vsize */
+  /* MAIS IL FAUT AJOUTER LE BOUT QUI MANQUE DE usize A rsize */
+    
+  if (can_round) 
+    {
+      cc = mpfr_round_raw(rp, rp, err, (sign_quotient == -1 ? 1 : 0),
+			  PREC(r), rnd_mode);  
+      rrsize = (PREC(r) - 1)/BITS_PER_MP_LIMB + 1; 
+    }
+  else
+    /* Use the remainder to find out the correct rounding */
+    /* Note that at this point the division has been done */
+    /* EXACTLY. */
+    if ((rnd_mode == GMP_RNDD && sign_quotient == -1) 
+	|| (rnd_mode == GMP_RNDU && sign_quotient == 1)
+	|| (rnd_mode == GMP_RNDN))
+      {	  
+	/* We cannot round, so that the last bits of the quotient
+	   have to be zero; just look if the remainder is nonzero */
+	k = rsize - 1; 
+	while (k >= 0) { if (tp[k]) break; k--; }
+	if (k >= 0) 
+	  cc = mpn_add_1(rp, rp, rrsize, (mp_limb_t)1 << (BITS_PER_MP_LIMB - 
+					       (PREC(r) & 
+						(BITS_PER_MP_LIMB - 1))));
+	else
+	  if (rnd_mode == GMP_RNDN) /* even rounding */
+	    {
+	      rw = (PREC(r) + 1) & (BITS_PER_MP_LIMB - 1);
+	      if (rw) { rw = BITS_PER_MP_LIMB - rw; nw = 0; } else nw = 1; 
+	      if ((rw ? (rp[nw] >> (rw + 1)) & 1 : 
+		   (rp[nw] >> (BITS_PER_MP_LIMB - 1)) & 1))
+		{
+		  cc = mpn_add_1(rp + nw, rp + nw, rrsize, 
+				 ((mp_limb_t)1) << rw); 
+		}
+	    }
+	/* cas 0111111 */
+      }
+
+  if (sign_quotient != SIGN(r)) { CHANGE_SIGN(r); } 
+  r->_mp_exp = rexp;
+  
+  if (cc) {
+    mpn_rshift(rp, rp, rrsize, 1);
+    rp[rrsize-1] |= (mp_limb_t) 1 << (BITS_PER_MP_LIMB-1);
+    r->_mp_exp++; 
+  }
+    
+  rsize = rrsize; 
+  rrsize = (PREC(r) - 1)/BITS_PER_MP_LIMB + 1;  
+  MPN_COPY(r->_mp_d, rp + rsize - rrsize, rrsize); 
+  MANT(r) [0] &= ~(((mp_limb_t)1 << (BITS_PER_MP_LIMB - 
+		    (PREC(r) & (BITS_PER_MP_LIMB - 1)))) - 1) ; 
+  
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpfr/div_2exp.c b/src/gmp/mpfr/div_2exp.c
new file mode 100644
index 000000000..e7602db44
--- /dev/null
+++ b/src/gmp/mpfr/div_2exp.c
@@ -0,0 +1,43 @@
+/* mpfr_div_2exp -- divide a floating-point number by a power of two
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+void
+#if __STDC__
+mpfr_div_2exp(mpfr_ptr y, mpfr_srcptr x, unsigned long int n, unsigned char rnd_mode)
+#else
+mpfr_div_2exp(y, x, n, rnd_mode)
+     mpfr_ptr y;
+     mpfr_srcptr x;  
+     unsigned long int n; 
+     unsigned char rnd_mode; 
+#endif
+{
+  /* Important particular case */ 
+  if (y != x) mpfr_set(y, x, rnd_mode);
+  EXP(y) -= n; 
+  return; 
+}
+
diff --git a/src/gmp/mpfr/div_ui.c b/src/gmp/mpfr/div_ui.c
new file mode 100644
index 000000000..7cd124142
--- /dev/null
+++ b/src/gmp/mpfr/div_ui.c
@@ -0,0 +1,135 @@
+/* mpfr_div_ui -- divide a floating-point number by a machine integer
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h" 
+#include "mpfr.h"
+
+/* #define DEBUG */
+
+/* returns 0 if result exact, non-zero otherwise */
+int
+#ifdef __STDC__
+mpfr_div_ui(mpfr_ptr y, mpfr_srcptr x, unsigned long u, unsigned char rnd_mode)
+#else
+mpfr_div_ui(y, x, u, rnd_mode)
+     mpfr_ptr y;  
+     mpfr_srcptr x;
+     unsigned long u;
+     unsigned char rnd_mode; 
+#endif
+{
+  int xn, yn, dif, sh, i; mp_limb_t *xp, *yp, *tmp, c, d;
+  TMP_DECL(marker);
+
+  if (FLAG_NAN(x)) { SET_NAN(y); return 1; }
+  if (u==0) { printf("infinity\n"); return 1; }
+
+  TMP_MARK(marker);
+  xn = (PREC(x)-1)/BITS_PER_MP_LIMB + 1;
+  yn = (PREC(y)-1)/BITS_PER_MP_LIMB + 1;
+
+  xp = MANT(x);
+  yp = MANT(y);
+  EXP(y) = EXP(x);
+  if (SIGN(x)!=SIGN(y)) CHANGE_SIGN(y);
+
+  dif = yn+1-xn;
+#ifdef DEBUG
+  printf("dif=%d u=%lu xn=%d\n",dif,u,xn);
+  printf("x="); mpfr_print_raw(x); putchar('\n');
+#endif
+
+  /* we need to store yn+1 = xn + dif limbs of the quotient */
+  if (ABSSIZE(y)>=yn+1) tmp=yp;
+  else tmp=TMP_ALLOC((yn+1)*BYTES_PER_MP_LIMB);
+
+  c = (mp_limb_t) u;
+  if (dif>=0) {
+    /* patch for bug in mpn_divrem_1 */
+#if (UDIV_NEEDS_NORMALIZATION==1)
+    count_leading_zeros(sh, c);
+    c <<= sh;
+    EXP(y) += sh;
+#endif
+    c = mpn_divrem_1(tmp, dif, xp, xn, c);
+  }
+  else /* dif < 0 i.e. xn > yn */
+    c = mpn_divrem_1(tmp, 0, xp-dif, yn, c);
+
+  if (tmp[yn]==0) { tmp--; sh=0; EXP(y) -= mp_bits_per_limb; }
+  /* shift left to normalize */
+  count_leading_zeros(sh, tmp[yn]);
+  if (sh) {
+    mpn_lshift(yp, tmp+1, yn, sh);
+    yp[0] += tmp[0] >> (BITS_PER_MP_LIMB-sh);
+    EXP(y) -= sh; 
+  }
+  else MPN_COPY(yp, tmp+1, yn);
+#ifdef DEBUG
+printf("y="); mpfr_print_raw(y); putchar('\n');
+#endif
+
+  sh = yn*BITS_PER_MP_LIMB - PREC(y);
+  /* it remains sh bits in less significant limb of y */
+
+  d = *yp & (((mp_limb_t)1 << sh) - 1);
+  *yp ^= d; /* set to zero lowest sh bits */
+
+  TMP_FREE(marker);
+  if ((c | d)==0) {
+    for (i=0; i<-dif && xp[i]==0; i++);
+    if (i>=-dif) return 0; /* result is exact */
+  }
+
+  switch (rnd_mode) {
+  case GMP_RNDZ:
+    return 1; /* result is inexact */
+  case GMP_RNDU:
+    if (SIGN(y)>0) mpfr_add_one_ulp(y);
+    return 1; /* result is inexact */
+  case GMP_RNDD:
+    if (SIGN(y)<0) mpfr_add_one_ulp(y);
+    return 1; /* result is inexact */
+  case GMP_RNDN:
+    if (d < ((mp_limb_t)1 << (sh-1))) return 1;
+    else if (d > ((mp_limb_t)1 << (sh-1))) {
+      mpfr_add_one_ulp(y);
+    }
+    else { /* d = (mp_limb_t)1 << (sh-1) */
+      if (c) mpfr_add_one_ulp(y);
+      else {
+	for (i=0; i<-dif && xp[i]==0; i++);
+	if (i<-dif) mpfr_add_one_ulp(y);
+	else { /* exactly in the middle */
+	  if (*yp & ((mp_limb_t)1 << sh)) mpfr_add_one_ulp(y);
+	}
+      }
+    }
+    return 1;
+  }
+  return 0; /* to prevent warning from gcc */
+}
+
+
+
diff --git a/src/gmp/mpfr/exp.c b/src/gmp/mpfr/exp.c
new file mode 100644
index 000000000..c3ec218a0
--- /dev/null
+++ b/src/gmp/mpfr/exp.c
@@ -0,0 +1,176 @@
+/* mpfr_exp -- exponential of a floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+/* #define DEBUG */
+
+#define LOG2 0.69314718055994528622 /* log(2) rounded to zero on 53 bits */
+
+/* use Brent's formula exp(x) = (1+r+r^2/2!+r^3/3!+...)^(2^K)*2^n
+   where x = n*log(2)+(2^K)*r
+   number of operations = O(K+prec(r)/K)
+*/
+int 
+#if __STDC__
+mpfr_exp(mpfr_ptr y, mpfr_srcptr x, unsigned char rnd_mode) 
+#else
+mpfr_exp(y, x, rnd_mode)
+     mpfr_ptr y; 
+     mpfr_srcptr x; 
+     unsigned char rnd_mode; 
+#endif
+{
+  int n, expx, K, precy, q, k, l, expr, err; 
+  mpfr_t r, s, t;
+
+  if (FLAG_NAN(x)) { SET_NAN(y); return 1; }
+  if (!NOTZERO(x)) { mpfr_set_ui(y, 1, GMP_RNDN); return 0; }
+
+  expx = EXP(x);
+  precy = PREC(y);
+#ifdef DEBUG
+  printf("EXP(x)=%d\n",expx);
+#endif
+
+  /* if x > (2^31-1)*ln(2), then exp(x) > 2^(2^31-1) i.e. gives +infinity */
+  if (expx > 30) {
+    if (SIGN(x)>0) { printf("+infinity"); return 1; }
+    else { SET_ZERO(y); return 1; }
+  }
+
+  /* if x < 2^(-precy), then exp(x) i.e. gives 1 +/- 1 ulp(1) */
+  if (expx < -precy) { int signx = SIGN(x);
+    mpfr_set_ui(y, 1, rnd_mode);
+    if (signx>0 && rnd_mode==GMP_RNDU) mpfr_add_one_ulp(y);
+    else if (signx<0 && (rnd_mode==GMP_RNDD || rnd_mode==GMP_RNDZ)) 
+      mpfr_sub_one_ulp(y);
+    return 1; }
+
+  n = (int) floor(mpfr_get_d(x)/LOG2);
+
+  K = (int) sqrt( (double) precy );
+  l = (precy-1)/K + 1;
+  err = K + (int) ceil(log(2.0*(double)l+18.0)/LOG2);
+  /* add K extra bits, i.e. failure probability <= 1/2^K = O(1/precy) */
+  q = precy + err + K + 3;
+  mpfr_init2(r, q); mpfr_init2(s, q); mpfr_init2(t, q);
+  /* the algorithm consists in computing an upper bound of exp(x) using
+     a precision of q bits, and see if we can round to PREC(y) taking
+     into account the maximal error. Otherwise we increase q. */
+  do {
+#ifdef DEBUG
+  printf("n=%d K=%d l=%d q=%d\n",n,K,l,q);
+#endif
+
+  /* if n<0, we have to get an upper bound of log(2)
+     in order to get an upper bound of r = x-n*log(2) */
+  mpfr_log2(s, (n>=0) ? GMP_RNDZ : GMP_RNDU);
+#ifdef DEBUG
+  printf("n=%d log(2)=",n); mpfr_print_raw(s); putchar('\n');
+#endif
+  mpfr_mul_ui(r, s, (n<0) ? -n : n, (n>=0) ? GMP_RNDZ : GMP_RNDU); 
+  if (n<0) mpfr_neg(r, r, GMP_RNDD);
+  /* r = floor(n*log(2)) */
+
+#ifdef DEBUG
+  printf("x=%1.20e\n",mpfr_get_d(x));
+  printf(" ="); mpfr_print_raw(x); putchar('\n');
+  printf("r=%1.20e\n",mpfr_get_d(r));
+  printf(" ="); mpfr_print_raw(r); putchar('\n');
+#endif
+  mpfr_sub(r, x, r, GMP_RNDU);
+  if (SIGN(r)<0) { /* initial approximation n was too large */
+    n--;
+    mpfr_mul_ui(r, s, (n<0) ? -n : n, GMP_RNDZ);
+    if (n<0) mpfr_neg(r, r, GMP_RNDD);
+    mpfr_sub(r, x, r, GMP_RNDU);
+  }
+#ifdef DEBUG
+  printf("x-r=%1.20e\n",mpfr_get_d(r));
+  printf(" ="); mpfr_print_raw(r); putchar('\n');
+  if (SIGN(r)<0) { fprintf(stderr,"Error in mpfr_exp: r<0\n"); exit(1); }
+#endif
+  mpfr_div_2exp(r, r, K, GMP_RNDU); /* r = (x-n*log(2))/2^K */
+  mpfr_set_ui(s, 1, GMP_RNDU);
+  mpfr_set_ui(t, 1, GMP_RNDU);
+
+  l = 1; expr = EXP(r);
+  do {
+    mpfr_mul(t, t, r, GMP_RNDU);
+    mpfr_div_ui(t, t, l, GMP_RNDU);
+    mpfr_add(s, s, t, GMP_RNDU);
+#ifdef DEBUG
+    printf("l=%d t=%1.20e\n",l,mpfr_get_d(t)); 
+    printf("s=%1.20e\n",mpfr_get_d(s)); 
+#endif
+    l++;
+  } while (EXP(t)+expr > -q);
+#ifdef DEBUG
+  printf("l=%d q=%d (K+l)*q^2=%1.3e\n", l, q, (K+l)*(double)q*q);
+#endif
+
+  /* add 2 ulp to take into account rest of summation */
+  mpfr_add_one_ulp(s);
+  mpfr_add_one_ulp(s);
+  
+  for (k=0;k<K;k++) {
+    mpfr_mul(s, s, s, GMP_RNDU);
+#ifdef DEBUG
+    printf("k=%d s=%1.20e\n",k,mpfr_get_d(s)); 
+#endif
+  }
+
+  if (n>0) mpfr_mul_2exp(s, s, n, GMP_RNDU);
+  else mpfr_div_2exp(s, s, -n, GMP_RNDU);
+
+  /* error is at most 2^K*(2l+18) ulp */
+  l = 2*l+17; k=0; while (l) { k++; l >>= 1; }
+  /* now k = ceil(log(2l+18)/log(2)) */
+  K += k;
+#ifdef DEBUG
+    printf("after mult. by 2^n:\n");
+    if (EXP(s)>-1024) printf("s=%1.20e\n",mpfr_get_d(s)); 
+    printf(" ="); mpfr_print_raw(s); putchar('\n');
+    printf("err=%d bits\n", K);
+#endif
+
+  l = mpfr_can_round(s, q-K, GMP_RNDU, rnd_mode, precy);
+  if (l==0) {
+#ifdef DEBUG
+     printf("not enough precision, use %d\n", q+BITS_PER_MP_LIMB);
+     printf("q=%d q-K=%d precy=%d\n",q,q-K,precy);
+#endif
+     q += BITS_PER_MP_LIMB;
+     mpfr_set_prec(r, q); mpfr_set_prec(s, q); mpfr_set_prec(t, q);
+  }
+  } while (l==0);
+
+  mpfr_set(y, s, rnd_mode);
+
+  mpfr_clear(r); mpfr_clear(s); mpfr_clear(t);
+  return 1;
+}
+
diff --git a/src/gmp/mpfr/get_str.c b/src/gmp/mpfr/get_str.c
new file mode 100644
index 000000000..e100b300e
--- /dev/null
+++ b/src/gmp/mpfr/get_str.c
@@ -0,0 +1,207 @@
+/* mpfr_get_str -- output a floating-point number to a string
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+/*
+  Convert op to a string in base 'base' with 'n' digits and writes the 
+  mantissa in 'str', the exponent in 'expptr'.
+  The result is rounded wrt 'rnd_mode'.
+
+  For op = 3.1416 we get str = "31416" and expptr=1.
+ */
+#if __STDC__
+char *mpfr_get_str(char *str, mp_exp_t *expptr, int base, size_t n,
+		  mpfr_srcptr op, unsigned char rnd_mode)
+#else
+char *mpfr_get_str(str, expptr, base, n, op, rnd_mode)
+     char *str;  
+     mp_exp_t *expptr;
+     int base;
+     size_t n;
+     mpfr_srcptr op; 
+     unsigned char rnd_mode; 
+#endif
+{
+  double d; long e, q, div, p, err, prec, sh; mpfr_t a, b; mpz_t bz;
+  char *str0; unsigned char rnd1; int f, pow2, ok=0, neg;
+
+  if (base<2 || 36<base) {
+    fprintf(stderr, "Error: too small or too large base in mpfr_get_str: %d\n",
+	    base);
+    exit(1);
+  }
+
+  neg = (SIGN(op)<0) ? 1 : 0;
+
+  if (!NOTZERO(op)) {
+    if (str==NULL) str0=str=(*_mp_allocate_func)(neg + n + 2);
+    if (SIGN(op)<0) *str++ = '-';
+    for (f=0;f<n;f++) *str++ = '0';
+    *expptr = 1;
+    return str0;
+  }
+
+  count_leading_zeros(pow2, (mp_limb_t)base); 
+  pow2 = BITS_PER_MP_LIMB - pow2 - 1;
+  if (base != (1<<pow2)) pow2=0; 
+  /* if pow2 <> 0, then base = 2^pow2 */
+
+  /* first determines the exponent */
+  e = EXP(op); 
+  d = fabs(mpfr_get_d2(op, 0));
+  /* the absolute value of op is between 1/2*2^e and 2^e */
+  /* the output exponent f is such that base^(f-1) <= |op| < base^f
+     i.e. f = 1 + floor(log(|op|)/log(base))
+     = 1 + floor((log(|m|)+e*log(2))/log(base)) */
+  f = 1 + (int) floor((log(d)+(double)e*log(2.0))/log((double)base));
+  if (n==0) {
+    /* performs exact rounding, i.e. returns y such that for rnd_mode=RNDN
+       for example, we have:
+       y*base^(f-n) <= x*2^(e-p) < (x+1)*2^(e-p) <= (y+1)*base^(f-n)
+       which implies 2^(EXP(op)-PREC(op)) <= base^(f-n)
+     */
+    n = f + (int) ceil(((double)PREC(op)-e)*log(2.0)/log((double)base));
+  }
+  /* now the first n digits of the mantissa are obtained from
+     rnd(op*base^(n-f)) */
+  prec = (long) ceil((double)n*log((double)base)/log(2.0));
+  err = 5;
+  q = prec+err;
+  /* one has to use at least q bits */
+  q = (((q-1)/BITS_PER_MP_LIMB)+1)*BITS_PER_MP_LIMB;
+  mpfr_init2(a,q); mpfr_init2(b,q);
+
+  do {
+    p = n-f; if ((div=(p<0))) p=-p;
+    rnd1 = rnd_mode;
+    if (div) {
+      /* if div we divide by base^p so we have to invert the rounding mode */
+      switch (rnd1) {
+      case GMP_RNDN: rnd1=GMP_RNDN; break;
+      case GMP_RNDZ: rnd1=GMP_RNDU; break;
+      case GMP_RNDU: rnd1=GMP_RNDZ; break;
+      case GMP_RNDD: rnd1=GMP_RNDZ; break;
+      }
+    }
+
+    if (pow2) {
+      if (div) mpfr_div_2exp(b, op, pow2*p, rnd_mode);
+      else mpfr_mul_2exp(b, op, pow2*p, rnd_mode);
+    } 
+    else {
+       /* compute base^p with q bits and rounding towards zero */
+       mpfr_set_prec(b, q);
+       if (p==0) { mpfr_set(b, op, rnd_mode); mpfr_set_ui(a, 1, rnd_mode); }
+       else {
+	 mpfr_set_prec(a, q);
+	 mpfr_ui_pow_ui(a, base, p, rnd1);
+	 if (div) {
+	   mpfr_set_ui(b, 1, rnd_mode);
+	   mpfr_div(a, b, a, rnd_mode);
+	 }
+	 /* now a is an approximation by default of 1/base^(f-n) */
+	 mpfr_mul(b, op, a, rnd_mode);
+       }
+    }
+    if (neg) CHANGE_SIGN(b); /* put b positive */
+
+    if (q>2*prec+BITS_PER_MP_LIMB) {
+      /* happens when just in the middle between two digits */
+      n--; q-=BITS_PER_MP_LIMB;
+      if (n==0) {
+          fprintf(stderr, "cannot determine leading digit\n"); exit(1);
+        }
+    }
+    ok = pow2 || mpfr_can_round(b, q-err, rnd_mode, rnd_mode, prec);
+
+    if (ok) { 
+      if (pow2) {
+	sh = e-PREC(op) + pow2*(n-f); /* error at most 2^e */
+	ok = mpfr_can_round(b, EXP(b)-sh-1, rnd_mode, rnd_mode, n*pow2);
+      }
+      else {
+	 /* check that value is the same at distance 2^(e-PREC(op))/base^(f-n)
+	  in opposite from rounding direction */
+	 if (e>=PREC(op)) mpfr_mul_2exp(a, a, e-PREC(op), rnd_mode);
+	 else mpfr_div_2exp(a, a, PREC(op)-e, rnd_mode);
+	 if (rnd_mode==GMP_RNDN) {
+	   mpfr_div_2exp(a, a, 2, rnd_mode);
+	   mpfr_sub(b, b, a, rnd_mode); /* b - a/2 */
+	   mpfr_mul_2exp(a, a, 2, rnd_mode);
+	   mpfr_add(a, b, a, rnd_mode); /* b + a/2 */
+	 }
+	 else if ((rnd_mode==GMP_RNDU && neg==0) || (rnd_mode==GMP_RNDD && neg))
+	   mpfr_sub(a, b, a, rnd_mode);
+	 else mpfr_add(a, b, a, rnd_mode);
+	 /* check that a and b are rounded similarly */
+	 prec=EXP(b);
+	 if (EXP(a) != prec) ok=0;
+	 else {
+	   mpfr_round(b, rnd_mode, prec);
+	   mpfr_round(a, rnd_mode, prec);
+	   if (mpfr_cmp(a, b)) ok=0;
+	 }
+       }
+      if (ok==0) { /* n is too large */
+	n--;
+	if (n==0) {
+	  fprintf(stderr, "cannot determine leading digit\n"); exit(1);
+	}
+	q -= BITS_PER_MP_LIMB;
+      }
+    }
+  } while (ok==0 && (q+=BITS_PER_MP_LIMB) );
+  if (neg)
+    switch (rnd_mode) {
+    case GMP_RNDU: rnd_mode=GMP_RNDZ; break;
+    case GMP_RNDD: rnd_mode=GMP_RNDU; break;
+  }
+
+  prec=EXP(b); /* may have changed due to rounding */
+
+  /* now the mantissa is the integer part of b */
+  mpz_init(bz); q=1+(prec-1)/BITS_PER_MP_LIMB;
+  _mpz_realloc(bz, q);
+  sh = prec%BITS_PER_MP_LIMB;
+  e = 1 + (PREC(b)-1)/BITS_PER_MP_LIMB-q;
+  if (sh) mpn_rshift(PTR(bz), MANT(b)+e, q, BITS_PER_MP_LIMB-sh);
+  else MPN_COPY(PTR(bz), MANT(b)+e, q);
+  bz->_mp_size=q;
+
+  /* computes the number of characters needed */
+  q = neg + n + 2; /* n+1 may not be enough for 100000... */
+  if (str==NULL) str0=str=(*_mp_allocate_func)(q);
+  if (neg) *str++='-';
+  mpz_get_str(str, base, bz); /* n digits of mantissa */
+  if (strlen(str)==n+1) f++; /* possible due to rounding */
+  *expptr = f;
+  mpfr_clear(a); mpfr_clear(b); mpz_clear(bz);
+  return str0;
+}
+
diff --git a/src/gmp/mpfr/init.c b/src/gmp/mpfr/init.c
new file mode 100644
index 000000000..e416511c7
--- /dev/null
+++ b/src/gmp/mpfr/init.c
@@ -0,0 +1,49 @@
+/* mpfr_init -- initialize a floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+void
+#if __STDC__
+mpfr_init2 (mpfr_t x, unsigned long int p)
+#else
+mpfr_init2 (x, p)
+     mpfr_t x;
+     unsigned long int p;
+#endif
+{
+  unsigned long xsize; 
+
+  if (p==0) {
+    printf("*** cannot initialize mpfr with precision 0\n"); exit(1);
+  }
+
+  xsize = (p - 1)/BITS_PER_MP_LIMB + 1; 
+
+  x -> _mp_prec = p;
+  x -> _mp_d = (mp_ptr) (*_mp_allocate_func) 
+    (xsize * BYTES_PER_MP_LIMB);
+  x -> _mp_size = xsize;
+  x -> _mp_exp = 0; /* avoids uninitialized memory reads for zero */
+}
diff --git a/src/gmp/mpfr/karadiv.c b/src/gmp/mpfr/karadiv.c
new file mode 100644
index 000000000..94db05353
--- /dev/null
+++ b/src/gmp/mpfr/karadiv.c
@@ -0,0 +1,137 @@
+/*  mpn_divrem_n -- Karatsuba division in 2*K(n) limb operations
+
+Copyright (C) 1999-2000 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/*
+[1] Fast Recursive Division, by Christoph Burnikel and Joachim Ziegler,
+    Technical report MPI-I-98-1-022, october 1998,
+    cf http://www.mpi-sb.mpg.de/~ziegler/TechRep.ps.gz.
+    Implemented by Paul Zimmermann, 1999.
+*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+extern void mpn_divrem_n2 (mp_limb_t *, mp_limb_t *, mp_limb_t *, mp_size_t, mp_limb_t *);
+extern void mpn_divrem_3by2 (mp_limb_t *, mp_limb_t *, mp_limb_t *, mp_size_t, mp_limb_t *);
+
+/* mpn_divrem_n(n) calls 2*mul(n/2)+2*div(n/2), thus to be faster then
+   div(n)=4*div(n/2), we need mul(n/2) to be faster than the classic way,
+   i.e. n/2 >= KARATSUBA_MUL_THRESHOLD */
+
+#define DIV_LIMIT (7*KARATSUBA_MUL_THRESHOLD)
+
+static void mpn_decr(mp_limb_t *Q)
+{
+  while ((*Q++)-- == 0);
+}
+
+/* implements algorithm of page 8 in [1]: divides (A,2n) by (B,n) and puts the
+   quotient in (Q,n), the remainder in (A,n).
+   Returns most significant limb of the quotient, which is 0 or 1.
+*/
+mp_limb_t
+mpn_divrem_n(mp_limb_t *Q, mp_limb_t *A, mp_limb_t *B, mp_size_t n)
+{
+  if (n<DIV_LIMIT) return mpn_divrem(Q, 0, A, 2*n, B, n);
+  else {
+    mp_limb_t cc=0;
+    if (mpn_cmp(A+n, B, n)>=0) {
+      cc=1;
+      mpn_sub_n(A+n, A+n, B, n);
+    }
+    if (n%2) {
+       /* divide (2n-2) most significant limbs from A by those (n-1) from B */
+       mpn_divrem_n(Q+1, A+2, B+1, n-1);
+       /* now (Q+1, n-1) contains the quotient of (A+2,2n-2) by (B+1,n-1)
+	  and (A+2, n-1) contains the remainder */
+       if (mpn_sub_1(A+n, A+n, 1, mpn_submul_1(A+1, Q+1, n-1, B[0]))) { 
+	 /* quotient two large */
+	 mpn_decr(Q+1);
+	 if (mpn_add_n(A+1, A+1, B, n)==0) {
+	   mpn_decr(Q+1); mpn_add_n(A+1, A+1, B, n);
+	 }
+       }
+       /* now divide (A,n+1) by (B,n) */
+       mpn_divrem(Q, 0, A, n+1, B, n);
+    }
+    else { 
+       mp_limb_t *tmp; int n2=n/2;
+       TMP_DECL (marker); 
+
+       TMP_MARK (marker);
+       tmp = (mp_limb_t*) TMP_ALLOC(n*sizeof(mp_limb_t));
+       mpn_divrem_3by2(Q+n2, A+n2, B, n2, tmp);
+       mpn_divrem_3by2(Q, A, B, n2, tmp);
+       TMP_FREE (marker);
+    }
+    return cc;
+  }
+}
+
+/* inner procedure, with no memory allocation 
+   assumes mpn_cmp(A+n, B, n) < 0
+*/
+void mpn_divrem_n2(mp_limb_t *Q, mp_limb_t *A, mp_limb_t *B, mp_size_t n,
+			mp_limb_t *tmp)
+{
+  if (n%2) {
+    /* divide (2n-2) most significant limbs from A by those (n-1) from B */
+    mpn_divrem_n2(Q+1, A+2, B+1, n-1, tmp);
+    /* now (Q+1, n-1) contains the quotient of (A+2,2n-2) by (B+1,n-1)
+       and (A+2, n-1) contains the remainder */
+    if (mpn_sub_1(A+n, A+n, 1, mpn_submul_1(A+1, Q+1, n-1, B[0]))) { 
+      /* quotient two large */
+      mpn_decr(Q+1);
+      if (mpn_add_n(A+1, A+1, B, n)==0) { /* still too large */
+	mpn_decr(Q+1); mpn_add_n(A+1, A+1, B, n);
+      }
+    }
+    /* now divide (A,n+1) by (B,n) */
+    mpn_divrem(Q, 0, A, n+1, B, n);
+  }
+  else {
+    int n2=n/2;
+    mpn_divrem_3by2(Q+n2, A+n2, B, n2, tmp);
+    mpn_divrem_3by2(Q, A, B, n2, tmp);
+  }
+}
+
+/* divides (A,3n) by (B,2n) and puts the quotient in (Q,n), 
+   the remainder in (A,2n) */
+void
+mpn_divrem_3by2(mp_limb_t *Q, mp_limb_t *A, mp_limb_t *B, 
+			     mp_size_t n, mp_limb_t *tmp)
+{
+  int twon = n+n;
+
+  if (n<DIV_LIMIT) mpn_divrem(Q, 0, A+n, twon, B+n, n);
+  else mpn_divrem_n2(Q, A+n, B+n, n, tmp);
+  /* q=(Q,n), c=(A+n,n) with the notations of [1] */
+  mpn_mul_n(tmp, Q, B, n);
+  if (mpn_sub_n(A, A, tmp, twon)) /* R=(A,2n) */ {
+    mpn_decr(Q);
+    if (mpn_add_n(A, A, B, twon)==0) { /* Q still too large */
+      mpn_decr(Q); mpn_add_n(A, A, B, twon);
+    }
+  }
+  return;
+}
diff --git a/src/gmp/mpfr/karasqrt.c b/src/gmp/mpfr/karasqrt.c
new file mode 100644
index 000000000..74a4bf805
--- /dev/null
+++ b/src/gmp/mpfr/karasqrt.c
@@ -0,0 +1,102 @@
+/*  kara_sqrtrem -- Karatsuba square root
+
+Copyright (C) 1999-2000 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/* Reference: Karatsuba Square Root, Paul Zimmermann, Research Report 3805,
+   INRIA, November 1999. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+#define SQRT_LIMIT KARATSUBA_MUL_THRESHOLD /* must be at least 3, should be
+					      near from optimal */
+
+/* n must be even */
+mp_size_t kara_sqrtrem(mp_limb_t *s, mp_limb_t *r, mp_limb_t *op, mp_size_t n)
+{
+  if (n<SQRT_LIMIT) return mpn_sqrtrem(s, r, op, n);
+  else {
+    mp_size_t nn, rn, rrn, sn, qn; mp_limb_t *q, tmp;
+    TMP_DECL (marker);
+
+    TMP_MARK (marker);
+    nn = n/4; /* block size 'b' corresponds to nn limbs */
+    rn = kara_sqrtrem(s+nn, r+nn, op+2*nn, n-2*nn);
+    /* rn <= ceil(n-2*nn, 2) + 1 <= ceil(2*nn+3, 2) + 1 <= nn+3 */
+    /* to divide by 2*s', first divide by 2, to ensure the dividend is
+       less than b^2 */
+    sn=(n-2*nn+1)/2; /* sn >= nn */
+    MPN_COPY(r, op+nn, nn); /* copy a_1 */
+    tmp = mpn_rshift(r, r, nn+rn, 1);
+    if (r[nn+rn-1]==0) rn--;
+    q = (mp_limb_t*) TMP_ALLOC(2*(sn+1)*sizeof(mp_limb_t));
+    if (nn+rn < 2*sn) MPN_ZERO(r+nn+rn, 2*sn-nn-rn);
+    qn = sn; if (mpn_cmp(r+sn, s+nn, sn)>=0) { 
+      q[qn++]=1; mpn_sub_n(r+sn, r+sn, s+nn, sn);
+    }
+#if 0
+    mpn_divrem(q, 0, r, 2*sn, s+nn, sn);
+#else
+    mpn_divrem_n(q, r, s+nn, sn);
+#endif
+    while (qn>nn && q[qn-1]==0) qn--;
+    MPN_COPY(s, q, nn);
+    if (nn+rn > 2*sn) {
+      tmp=mpn_add_n(s+sn, s+sn, q+sn, nn+rn-2*sn);
+      if (tmp) mpn_add_1(s+nn+rn-sn, s+nn+rn-sn, (n+1)/2-nn-rn+sn, tmp);
+    }
+    /* multiply remainder by two and add low bit of a_1 */
+    rrn = nn+sn; /* size of output remainder */
+    rrn += mpn_lshift(r+nn, r, sn, 1);
+    r[nn] |= (op[nn] & 1);
+    sn += nn;
+    if (qn>nn) {
+      MPN_COPY(r, s+nn, qn-nn); /* save the qn-nn limbs from s */
+      MPN_COPY(s+nn, q+nn, qn-nn); /* replace by those of q */
+    }
+    mpn_mul_n(q, s, s, qn);
+    if (qn>nn) { /* restore the limbs from s, adding them to those of q */
+      mp_limb_t cy;
+
+      cy = mpn_add_n(s+nn, s+nn, r, qn-nn);
+      if (qn<sn) cy = mpn_add_1(s+qn, s+qn, sn-qn, cy);
+      if (cy) s[sn++]=1; 
+    }
+    MPN_COPY(r, op, nn); /* copy a_0 */
+    qn = 2*qn; 
+    if (qn<sn) MPN_ZERO(q+qn, sn-qn);
+    if (rrn<sn) MPN_ZERO(r+rrn, sn-rrn);
+    if (mpn_sub_n(r, r, q, sn) || (qn>sn)) {
+      if (rrn>sn) rrn=sn;
+      else {
+	/* one shift and one add is faster than two add's */
+	r[sn] = mpn_lshift(q, s, sn, 1) + mpn_add_n(r, r, q, sn)
+	  - mpn_sub_1(r, r, sn, 1) - 1;
+	rrn = sn + r[sn];
+	mpn_sub_1(s, s, sn, 1);
+      }
+    }
+    else if (rrn>sn) r[sn]=1;
+    TMP_FREE (marker);
+    MPN_NORMALIZE(r, rrn);
+    return rrn;
+  }
+}
diff --git a/src/gmp/mpfr/log.c b/src/gmp/mpfr/log.c
new file mode 100644
index 000000000..06f5dad03
--- /dev/null
+++ b/src/gmp/mpfr/log.c
@@ -0,0 +1,150 @@
+/* mpfr_log -- natural logarithm of a floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+
+  /* The computation of log(a) is done using the formula :
+     if we want p bits of the result,
+                       pi
+	  log(a) ~ ------------  -   m log 2
+		    2 AG(1,4/s)
+
+     where s = x 2^m > 2^(p/2)
+
+     More precisely, if F(x) = int(1/sqrt(1-(1-x^2)*sin(t)^2), t=0..PI/2),
+     then for s>=1.26 we have log(s) < F(4/s) < log(s)*(1+4/s^2)
+     from which we deduce pi/2/AG(1,4/s)*(1-4/s^2) < log(s) < pi/2/AG(1,4/s)
+     so the relative error 4/s^2 is < 4/2^p i.e. 4 ulps.
+  */
+
+
+#define MON_INIT(xp, x, p, s) xp = (mp_ptr) TMP_ALLOC(s*BYTES_PER_MP_LIMB);    x -> _mp_prec = p; x -> _mp_d = xp; x -> _mp_size = s; x -> _mp_exp = 0; 
+
+/* #define DEBUG */
+
+int
+#if __STDC__
+mpfr_log(mpfr_ptr r, mpfr_srcptr a, unsigned char rnd_mode) 
+#else
+mpfr_log(r, a, rnd_mode)
+     mpfr_ptr r;
+     mpfr_srcptr a;
+     unsigned char rnd_mode; 
+#endif
+{
+  int p, m, q, bool, size, cancel;
+  mpfr_t cst, rapport, agm, tmp1, tmp2, s, mm;
+  mp_limb_t *cstp, *rapportp, *agmp, *tmp1p, *tmp2p, *sp, *mmp;
+  double ref;
+  TMP_DECL(marker);
+
+  /* If a is NaN or a is negative or null, the result is NaN */
+  if (FLAG_NAN(a) || (SIGN(a)<=0))
+    { SET_NAN(r); return 1; }
+
+  /* If a is 1, the result is 0 */
+  if (mpfr_cmp_ui_2exp(a,1,0)==0){
+    SET_ZERO(r);
+    return 0; /* only case where the result is exact */
+  }
+
+  q=PREC(r);
+  
+  ref=mpfr_get_d(a)-1.0;
+  if (ref<0)
+    ref=-ref;
+
+  p=q+4;
+  /* adjust to entire limb */
+  if (p%BITS_PER_MP_LIMB) p += BITS_PER_MP_LIMB - (p%BITS_PER_MP_LIMB);
+
+  bool=1;
+
+  while (bool==1) {
+#ifdef DEBUG
+    printf("a="); mpfr_print_raw(a); putchar('\n');
+    printf("p=%d\n", p);
+#endif
+    /* Calculus of m (depends on p) */
+    m=(int) ceil(((double) p)/2.0) -EXP(a)+1;
+
+    /* All the mpfr_t needed have a precision of p */
+    TMP_MARK(marker);
+    size=(p-1)/BITS_PER_MP_LIMB+1;
+    MON_INIT(cstp, cst, p, size);  
+    MON_INIT(rapportp, rapport, p, size);
+    MON_INIT(agmp, agm, p, size);
+    MON_INIT(tmp1p, tmp1, p, size);  
+    MON_INIT(tmp2p, tmp2, p, size);  
+    MON_INIT(sp, s, p, size);
+    MON_INIT(mmp, mm, p, size);
+
+    mpfr_set_si(mm,m,GMP_RNDN);           /* I have m, supposed exact */
+    mpfr_set_si(tmp1,1,GMP_RNDN);         /* I have 1, exact */
+    mpfr_set_si(tmp2,4,GMP_RNDN);         /* I have 4, exact */
+    mpfr_mul_2exp(s,a,m,GMP_RNDN);        /* I compute s=a*2^m, err <= 1 ulp */
+    mpfr_div(rapport,tmp2,s,GMP_RNDN);    /* I compute 4/s, err <= 2 ulps */
+    mpfr_agm(agm,tmp1,rapport,GMP_RNDN);  /* AG(1,4/s), err<=3 ulps */
+    mpfr_mul_2exp(tmp1,agm,1,GMP_RNDN);   /* 2*AG(1,4/s), still err<=3 ulps */
+    mpfr_pi(cst, GMP_RNDN);               /* I compute pi, err<=1ulp */
+    mpfr_div(tmp2,cst,tmp1,GMP_RNDN);     /* pi/2*AG(1,4/s), err<=5ulps */
+    mpfr_log2(cst,GMP_RNDN);              /* I compute log(2), err<=1ulp */
+    mpfr_mul(tmp1,cst,mm,GMP_RNDN);       /* I compute m*log(2), err<=2ulps */
+    cancel = EXP(tmp2); 
+    mpfr_sub(cst,tmp2,tmp1,GMP_RNDN);     /* log(a), err<=7ulps+cancel */ 
+    cancel -= EXP(cst);
+#ifdef DEBUG
+    printf("cancelled bits=%d\n", cancel);
+    printf("approx="); mpfr_print_raw(cst); putchar('\n');
+#endif
+    if (cancel<0) cancel=0;
+
+    /* If we can round the result, we set it and go out of the loop */
+
+    /* we have 7 ulps of error from the above roundings,
+       4 ulps from the 4/s^2 second order term,
+       plus the cancelled bits */
+    if (mpfr_can_round(cst,p-cancel-4,GMP_RNDN,rnd_mode,q)==1) {
+      mpfr_set(r,cst,rnd_mode);
+#ifdef DEBUG
+      printf("result="); mpfr_print_raw(r); putchar('\n');
+#endif
+      bool=0;
+    }
+    /* else we increase the precision */
+    else {
+      p += BITS_PER_MP_LIMB+cancel;
+      TMP_FREE(marker);
+    }
+
+    /* We clean */
+    TMP_FREE(marker);
+    
+  }
+  return 1; /* result is inexact */
+}
+
+
diff --git a/src/gmp/mpfr/log2.c b/src/gmp/mpfr/log2.c
new file mode 100644
index 000000000..151e0e8cb
--- /dev/null
+++ b/src/gmp/mpfr/log2.c
@@ -0,0 +1,102 @@
+/* mpfr_log2 -- compute natural logarithm of 2
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+mpfr_t __mpfr_log2; /* stored value of log(2) with rnd_mode=GMP_RNDZ */
+int __mpfr_log2_prec=0; /* precision of stored value */
+
+/* set x to log(2) rounded to precision PREC(x) with direction rnd_mode 
+
+   use formula log(2) = sum(1/k/2^k, k=1..infinity)
+
+   whence 2^N*log(2) = S(N) + R(N)
+
+   where S(N) = sum(2^(N-k)/k, k=1..N-1)
+   and   R(N) = sum(1/k/2^(k-N), k=N..infinity) < 2/N
+
+   Let S'(N) = sum(floor(2^(N-k)/k), k=1..N-1)
+
+   Then 2^N*log(2)-S'(N) <= N-1+2/N <= N for N>=2.
+*/
+void 
+#if __STDC__
+mpfr_log2(mpfr_ptr x, unsigned char rnd_mode)
+#else
+mpfr_log2(x, rnd_mode) mpfr_ptr x; unsigned char rnd_mode;
+#endif
+{
+  int N, oldN, k, precx; mpz_t s, t, u;
+
+  precx = PREC(x);
+
+  /* has stored value enough precision ? */
+  if (precx <= __mpfr_log2_prec) {
+    if (rnd_mode==GMP_RNDZ || rnd_mode==GMP_RNDD ||
+	mpfr_can_round(__mpfr_log2, __mpfr_log2_prec, GMP_RNDZ, rnd_mode, precx))
+      {
+	mpfr_set(x, __mpfr_log2, rnd_mode); return; 
+      }
+  }
+
+  /* need to recompute */
+  N=2;
+  do {
+    oldN = N;
+    N = precx + (int)ceil(log((double)N)/log(2.0));
+  } while (N != oldN);
+  mpz_init_set_ui(s,0);
+  mpz_init(u);
+  mpz_init_set_ui(t,1); 
+#if 0
+  /* use log(2) = sum(1/k/2^k, k=1..infinity) */
+  mpz_mul_2exp(t, t, N);
+  for (k=1;k<N;k++) {
+    mpz_div_2exp(t, t, 1);
+    mpz_fdiv_q_ui(u, t, k);
+    mpz_add(s, s, u);
+  }
+#else
+  /* use log(2) = sum((6*k-1)/(2*k^2-k)/2^(2*k+1), k=1..infinity) */
+  mpz_mul_2exp(t, t, N-1);
+  for (k=1;k<N/2;k++) {
+    mpz_div_2exp(t, t, 2);
+    mpz_mul_ui(u, t, 6*k-1);
+    mpz_fdiv_q_ui(u, u, k*(2*k-1));
+    mpz_add(s, s, u);
+  }
+#endif
+  mpfr_set_z(x, s, rnd_mode);
+  EXP(x) -= N;
+
+  /* stored computed value */
+  if (__mpfr_log2_prec==0) mpfr_init2(__mpfr_log2, precx);
+  else mpfr_set_prec(__mpfr_log2, precx);
+  mpfr_set(__mpfr_log2, x, GMP_RNDZ);
+  __mpfr_log2_prec=precx;
+
+  mpz_clear(s); mpz_clear(t); mpz_clear(u);
+}
diff --git a/src/gmp/mpfr/mpfr-impl.h b/src/gmp/mpfr/mpfr-impl.h
new file mode 100644
index 000000000..3464febb1
--- /dev/null
+++ b/src/gmp/mpfr/mpfr-impl.h
@@ -0,0 +1,58 @@
+/* Utilities for MPFR developers, not exported.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <math.h>
+
+/* generate a random double using the whole range of possible values,
+   including denormalized numbers, NaN, infinities, ... */
+double drand()
+{
+  volatile double d; int *i;
+
+  i = (int*) &d;
+  i[0] = mrand48();
+  i[1] = mrand48();
+  return d;
+}
+
+/* returns the number of ulp's between a and b */
+int ulp(a,b) double a,b;
+{
+  double eps=1.1102230246251565404e-16; /* 2^(-53) */
+  if (a==0.0) {
+    if (b==0.0) return 0;
+    else if (b<0.0) return 2147483647;
+    else return -2147483647;
+  }
+  b = (a-b)/a;
+  if (b>0)
+    return (int) floor(b/eps);
+  else
+    return (int) ceil(b/eps);
+}
+
+/* return double m*2^e */
+double dbl(m,e) double m; int e;
+{
+  if (e>=0) while (e-->0) m *= 2.0;
+  else while (e++<0) m /= 2.0;
+  return m;
+}
diff --git a/src/gmp/mpfr/mpfr.h b/src/gmp/mpfr/mpfr.h
new file mode 100644
index 000000000..9f25eba2f
--- /dev/null
+++ b/src/gmp/mpfr/mpfr.h
@@ -0,0 +1,204 @@
+/* mpfr.h -- Include file for mpfr.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+
+/* Cygnus does not know about *rand48 functions */
+#ifdef __CYGWIN32__
+#define mrand48 rand
+#define drand48 rand
+#define lrand48 rand
+#define srand48 srand
+#endif
+
+/* Definition of rounding modes */
+
+#define GMP_RNDN 0
+#define GMP_RNDZ 1
+#define GMP_RNDU 2
+#define GMP_RNDD 3
+
+/* Definitions of types and their semantics */
+
+typedef struct {  
+  unsigned long int _mp_prec; /* WARNING : for the mpfr type, the precision */
+                              /* should be understood as the number of BITS,*/
+			      /* not the number of mp_limb_t's. This means  */
+			      /* that the corresponding number of allocated
+				 limbs is >= ceil(_mp_prec/BITS_PER_MP_LIMB) */
+  mp_size_t _mp_size;         /* abs(_mp_size) is the number of allocated 
+				 limbs the field _mp_d points to.
+				 The sign is that of _mp_size.
+				 The number 0 is such that _mp_d[k-1]=0
+				 where k = ceil(_mp_prec/BITS_PER_MP_LIMB) */
+  mp_exp_t _mp_exp; 
+  mp_limb_t *_mp_d;
+}
+__mpfr_struct; 
+
+/*
+   The number represented is
+
+    sign(_mp_size)*(_mp_d[k-1]/B+_mp_d[k-2]/B^2+...+_mp_d[0]/B^k)*2^_mp_exp
+
+   where k=ceil(_mp_prec/BITS_PER_MP_LIMB) and B=2^BITS_PER_MP_LIMB.
+
+   For the msb (most significant bit) normalized representation, we must have
+   _mp_d[k-1]>=B/2, unless the number is zero (in that case its sign is still
+   given by sign(_mp_size)).
+
+   We must also have the last k*BITS_PER_MP_LIMB-_mp_prec bits set to zero.
+*/
+
+typedef __mpfr_struct mpfr_t[1]; 
+typedef __mpfr_struct *mpfr_ptr; 
+typedef __gmp_const __mpfr_struct *mpfr_srcptr;
+
+
+/* Prototypes */
+
+#ifndef _PROTO
+#if defined (__STDC__) || defined (__cplusplus)
+#define _PROTO(x) x
+#else
+#define _PROTO(x) ()
+#endif
+#endif
+
+/* bit 31 of _mp_size is used for sign,
+   bit 30 of _mp_size is used for Nan flag,
+   remaining bits are used to store the number of allocated limbs */
+#define FLAG_NAN(x) (((x)->_mp_size >> 30)&1)
+#define SET_NAN(x) ((x)->_mp_size |= (1<<30))
+#define ABSSIZE(x) ((x)->_mp_size & ((1<<30)-1))
+#define SIZE(x) ((x)->_mp_size)
+#define EXP(x) ((x)->_mp_exp)
+#define MANT(x) ((x)->_mp_d)
+#define SIGN(x) (((x)->_mp_size >> 31) ? -1 : 1)
+#define ISNONNEG(x) (SIGN(x)>=0)
+#define ISNEG(x) (SIGN(x)==-1)
+#define CHANGE_SIGN(x) (SIZE(x) = SIZE(x) ^ (1<<31))
+#define PREC(x) ((x)->_mp_prec)
+#define NOTZERO(x) (MANT(x)[(PREC(x)-1)/BITS_PER_MP_LIMB])
+#define SET_ZERO(x) (MANT(x)[(PREC(x)-1)/BITS_PER_MP_LIMB] = 0)
+
+/* reallocates the mantissa of x to q bits and sets the precision to q */
+#define _mpfr_realloc(x, q) { \
+    (x)->_mp_d = (mp_ptr) (*_mp_reallocate_func) \
+       ((x)->_mp_d, (x)->_mp_prec>>3 + 1, (q)>>3 + 1); \
+    (x)->_mp_prec = q; }
+
+void mpfr_init2 _PROTO ((mpfr_ptr, unsigned long int));
+int mpfr_round_raw _PROTO ((mp_limb_t *, mp_limb_t *, unsigned long, char,
+			     unsigned long, char));
+int mpfr_round_raw2 _PROTO ((mp_limb_t *, unsigned long, char, char,
+			     unsigned long));
+void mpfr_round _PROTO ((mpfr_ptr, char, unsigned long)); 
+int mpfr_can_round _PROTO ((mpfr_ptr, unsigned long, unsigned char, 
+			    unsigned char, unsigned long));
+int mpfr_can_round_raw _PROTO ((mp_limb_t *, unsigned long, int, 
+				unsigned long, 
+				unsigned char, unsigned char, unsigned long));
+void mpfr_set_d _PROTO ((mpfr_ptr, double, unsigned char)); 
+int mpfr_set_z _PROTO ((mpfr_ptr, mpz_srcptr, unsigned char)); 
+double mpfr_get_d _PROTO ((mpfr_srcptr)); 
+double mpfr_get_d2 _PROTO ((mpfr_srcptr, long)); 
+void mpfr_set_f _PROTO ((mpfr_ptr, mpf_srcptr, char)); 
+void mpfr_set_si _PROTO ((mpfr_ptr, long, unsigned char)); 
+void mpfr_set_ui _PROTO ((mpfr_ptr, unsigned long, unsigned char)); 
+void mpfr_print_raw _PROTO ((mpfr_srcptr)); 
+void mpfr_random _PROTO ((mpfr_ptr)); 
+void mpfr_clear _PROTO ((mpfr_ptr)); 
+void mpfr_set_str_raw _PROTO ((mpfr_ptr, char *)); 
+void mpfr_get_str_raw _PROTO ((char *, mpfr_srcptr));
+char* mpfr_get_str _PROTO ((char *, mp_exp_t *, int, size_t, mpfr_srcptr, unsigned char));
+size_t mpfr_out_str _PROTO ((FILE *, int, size_t, mpfr_srcptr, unsigned char));
+void mpfr_mul _PROTO ((mpfr_ptr, mpfr_srcptr, mpfr_srcptr, unsigned char));
+void mpfr_pow_ui _PROTO ((mpfr_ptr, mpfr_srcptr, unsigned int, unsigned char));
+void mpfr_ui_pow_ui _PROTO ((mpfr_ptr, unsigned int, unsigned int, unsigned char));
+mp_limb_t mpn_divrem_n _PROTO ((mp_limb_t *, mp_limb_t *, mp_limb_t *, mp_size_t));
+mp_size_t kara_sqrtrem _PROTO ((mp_limb_t *, mp_limb_t *, mp_limb_t *, mp_size_t));
+void mpfr_div _PROTO ((mpfr_ptr, mpfr_srcptr, mpfr_srcptr, unsigned char));
+void mpfr_agm _PROTO ((mpfr_ptr, mpfr_srcptr, mpfr_srcptr, unsigned char));
+int mpfr_sqrt _PROTO ((mpfr_ptr, mpfr_srcptr, unsigned char)); 
+void mpfr_add _PROTO ((mpfr_ptr, mpfr_srcptr, mpfr_srcptr, unsigned char));
+int mpfr_add_one_ulp _PROTO ((mpfr_ptr));
+void mpfr_sub _PROTO ((mpfr_ptr, mpfr_srcptr, mpfr_srcptr, unsigned char));
+void mpfr_set4 _PROTO ((mpfr_ptr, mpfr_srcptr, unsigned char, int));
+void mpfr_pi _PROTO ((mpfr_ptr, unsigned char));
+void mpfr_log2 _PROTO ((mpfr_ptr, unsigned char));
+int mpfr_log _PROTO ((mpfr_ptr, mpfr_srcptr, unsigned char));
+int mpfr_exp _PROTO ((mpfr_ptr, mpfr_srcptr, unsigned char));
+int mpfr_zeta _PROTO ((mpfr_ptr, mpfr_srcptr, unsigned char));
+void mpfr_mul_ui _PROTO((mpfr_ptr, mpfr_srcptr, unsigned long, unsigned char));
+void mpfr_set_machine_rnd_mode _PROTO ((unsigned char));
+int mpfr_cmp3 _PROTO ((mpfr_srcptr, mpfr_srcptr, long int));
+int mpfr_cmp_ui_2exp _PROTO ((mpfr_srcptr, unsigned long int, int));
+int mpfr_cmp_si_2exp _PROTO ((mpfr_srcptr, long int, int));
+int mpfr_cmp2 _PROTO ((mpfr_srcptr, mpfr_srcptr));
+void mpfr_mul_2exp _PROTO((mpfr_ptr, mpfr_srcptr, unsigned long int,unsigned char));
+void mpfr_div_2exp _PROTO((mpfr_ptr, mpfr_srcptr, unsigned long int,unsigned char));
+void mpfr_set_prec _PROTO((mpfr_ptr, unsigned long int));
+void mpfr_set_default_prec _PROTO((unsigned long int));
+extern mp_size_t __gmp_default_fp_bit_precision;
+extern char __gmp_default_rounding_mode;
+char * mpfr_print_rnd_mode _PROTO((unsigned char)); 
+void mpfr_neg _PROTO((mpfr_ptr, mpfr_srcptr, unsigned char)); 
+int mpfr_sub_one_ulp _PROTO((mpfr_ptr x)); 
+int mpfr_div_ui _PROTO((mpfr_ptr y, mpfr_srcptr x, unsigned long u, unsigned char rnd_mode)); 
+unsigned long int mpfr_get_prec _PROTO((mpfr_t x)); 
+
+#define mpfr_init(x) mpfr_init2(x, __gmp_default_fp_bit_precision)
+#define mpfr_cmp_ui(b,i) mpfr_cmp_ui_2exp(b,i,0)
+#define mpfr_cmp_si(b,i) mpfr_cmp_si_2exp(b,i,0)
+#define mpfr_set(a,b,r) mpfr_set4(a,b,r,SIGN(b))
+#define mpfr_cmp(b,c) mpfr_cmp3(b,c,1)
+
+#if (BITS_PER_MP_LIMB==32)
+#define MPFR_LIMBS_PER_DOUBLE 2
+#elif (BITS_PER_MP_LIMB==64)
+#define MPFR_LIMBS_PER_DOUBLE 1
+#endif
+
+/* gmp-2.0.2 had only one threshold for both multiplication and squaring */
+#ifndef KARATSUBA_MUL_THRESHOLD 
+#ifdef KARATSUBA_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD KARATSUBA_THRESHOLD
+#else
+#define KARATSUBA_MUL_THRESHOLD 16
+#endif
+#endif
+
+#define mpfr_init_set_si(x, i, p, rnd) \
+ mpfr_init2((x), (p)); mpfr_set_si((x), (i), (rnd)); 
+#define mpfr_init_set_ui(x, i, p, rnd) \
+ mpfr_init2((x), (p)); mpfr_set_ui((x), (i), (rnd));
+#define mpfr_init_set_d(x, d, p, rnd) \
+ mpfr_init2((x), (p)); mpfr_set_d((x), (d), (rnd));
+#define mpfr_init_set(x, y, p, rnd) \
+ mpfr_init2((x), (p)); mpfr_set((x), (y), (rnd)); 
+#define mpfr_init_set_f(x, y, p, rnd) \
+ mpfr_init2((x), (p)); mpfr_set_f((x), (y), (rnd));
+#define mpfr_init_set_str(x, y, p, rnd) \
+ mpfr_init2((x), (p)); mpfr_set_str((x), (y), (rnd)); 
+#define mpfr_init_set_str_raw(x, y, p, rnd) \
+ mpfr_init2((x), (p)); mpfr_set_str_raw((x), (y), (rnd)); 
+
diff --git a/src/gmp/mpfr/mul.c b/src/gmp/mpfr/mul.c
new file mode 100644
index 000000000..c7c3cd3f5
--- /dev/null
+++ b/src/gmp/mpfr/mul.c
@@ -0,0 +1,78 @@
+/* mpfr_mul -- multiply two floating-point numbers
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+/* Remains to do:
+- do not use all bits of b and c when PREC(b)>PREC(a) or PREC(c)>PREC(a)
+  [current complexity is O(PREC(b)*PREC(c))]
+*/
+
+void 
+#if __STDC__
+mpfr_mul(mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, unsigned char rnd_mode) 
+#else
+mpfr_mul(a, b, c, rnd_mode) 
+     mpfr_ptr a; 
+     mpfr_srcptr b; 
+     mpfr_srcptr c; 
+     unsigned char rnd_mode;
+#endif
+{
+  unsigned int bn, cn, an, tn, k; int cc;
+  mp_limb_t *ap=MANT(a), *bp=MANT(b), *cp=MANT(c), *tmp, b1;
+  long int sign_product;
+  TMP_DECL(marker); 
+
+  /* deal with NaN and zero */
+  if (FLAG_NAN(b) || FLAG_NAN(c)) { SET_NAN(a); return; }
+  if (!NOTZERO(b) || !NOTZERO(c)) { SET_ZERO(a); return; }
+
+  sign_product = SIGN(b) * SIGN(c);
+  bn = (PREC(b)-1)/mp_bits_per_limb+1; /* number of significant limbs of b */
+  cn = (PREC(c)-1)/mp_bits_per_limb+1; /* number of significant limbs of c */
+  tn = (PREC(c)+PREC(b)-1)/mp_bits_per_limb+1; 
+  k = bn+cn; /* effective nb of limbs used by b*c */
+  TMP_MARK(marker); 
+  tmp = (mp_limb_t*) TMP_ALLOC(k*BYTES_PER_MP_LIMB);
+
+  /* multiplies two mantissa in temporary allocated space */
+  b1 = (bn>=cn) ? mpn_mul(tmp, bp, bn, cp, cn) : mpn_mul(tmp, cp, cn, bp, bn);
+
+  /* now tmp[0]..tmp[k-1] contains the product of both mantissa,
+     with tmp[k-1]>=2^(mp_bits_per_limb-2) */
+  an = (PREC(a)-1)/mp_bits_per_limb+1; /* number of significant limbs of a */
+  b1 >>= mp_bits_per_limb-1; /* msb from the product */
+
+  if (b1==0) mpn_lshift(tmp, tmp, k, 1);
+  cc = mpfr_round_raw(ap, tmp+bn+cn-tn, 
+		      PREC(b)+PREC(c), (sign_product<0), PREC(a), rnd_mode);
+  if (cc) { /* cc = 1 ==> result is a power of two */
+    ap[an-1] = (mp_limb_t) 1 << (BITS_PER_MP_LIMB-1);
+  }
+  EXP(a) = EXP(b) + EXP(c) + b1 - 1 + cc;
+  if (sign_product * SIGN(a)<0) CHANGE_SIGN(a);
+  TMP_FREE(marker); 
+  return;
+}
diff --git a/src/gmp/mpfr/mul_2exp.c b/src/gmp/mpfr/mul_2exp.c
new file mode 100644
index 000000000..31dab2ac6
--- /dev/null
+++ b/src/gmp/mpfr/mul_2exp.c
@@ -0,0 +1,43 @@
+/* mpfr_mul_2exp -- multiply a floating-point number by a power of two
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+void
+#if __STDC__
+mpfr_mul_2exp(mpfr_ptr y, mpfr_srcptr x, unsigned long int n, unsigned char rnd_mode)
+#else
+mpfr_mul_2exp(y, x, n, rnd_mode)
+     mpfr_ptr y;
+     mpfr_srcptr x;
+     unsigned long int n; 
+     unsigned char rnd_mode; 
+#endif
+{
+  /* Important particular case */ 
+  if (y != x) mpfr_set(y, x, rnd_mode);
+  EXP(y) += n;
+  return;
+}
+
diff --git a/src/gmp/mpfr/mul_ui.c b/src/gmp/mpfr/mul_ui.c
new file mode 100644
index 000000000..83981a83c
--- /dev/null
+++ b/src/gmp/mpfr/mul_ui.c
@@ -0,0 +1,84 @@
+/* mpfr_mul_ui -- multiply a floating-point number by a machine integer
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+void
+#if __STDC__
+mpfr_mul_ui(mpfr_ptr y, mpfr_srcptr x, unsigned long u, unsigned char RND_MODE)
+#else
+mpfr_mul_ui(y, x, u, RND_MODE)
+     mpfr_ptr y; 
+     mpfr_srcptr x; 
+     unsigned long u; 
+     unsigned char RND_MODE; 
+#endif
+{
+  mp_limb_t carry, *my, *old_my; unsigned long c; 
+  unsigned long xsize, ysize, cnt, dif; 
+  TMP_DECL(marker);
+
+  TMP_MARK(marker);
+  my = MANT(y); 
+  ysize = (PREC(y)-1)/BITS_PER_MP_LIMB + 1;
+  xsize = (PREC(x)-1)/BITS_PER_MP_LIMB + 1;
+
+  if (ysize < xsize) {
+      old_my = my; 
+      my = (mp_ptr) TMP_ALLOC (xsize * BYTES_PER_MP_LIMB);
+      dif=0;
+    }
+  else dif=ysize-xsize;
+
+  carry = mpn_mul_1(my+dif, MANT(x), xsize, u);
+  MPN_ZERO(my, dif);
+
+  /* WARNING: count_leading_zeros is undefined for carry=0 */
+  if (carry) count_leading_zeros(cnt, carry);
+  else cnt=BITS_PER_MP_LIMB;
+      
+  c = mpfr_round_raw(my, my, PREC(x), (SIGN(x)<0), 
+		     PREC(y)-BITS_PER_MP_LIMB+cnt, RND_MODE);
+  
+  /* If cnt = 1111111111111 and c = 1 we shall get depressed */
+  if (c && (carry == (((mp_limb_t)1) << (BITS_PER_MP_LIMB - cnt)) - 1))
+    {
+      cnt--; 
+      mpn_rshift(my, my, ysize, BITS_PER_MP_LIMB - cnt); 
+      my[ysize - 1] |= ((mp_limb_t) 1) << (BITS_PER_MP_LIMB - 1);
+    }
+  else
+    {
+      /* Warning: mpn_rshift is undefined for shift=0 */
+      if (cnt!=BITS_PER_MP_LIMB)
+	mpn_rshift(my, my, ysize, BITS_PER_MP_LIMB - cnt); 
+      my[ysize - 1] |= (carry << cnt); 
+    }
+  EXP(y) = EXP(x) + BITS_PER_MP_LIMB - cnt; 
+  if (ysize < xsize) MPN_COPY(old_my, my, ysize);
+  /* set sign */
+  if (SIGN(y) != SIGN(x)) CHANGE_SIGN(y);
+  TMP_FREE(marker);
+}
diff --git a/src/gmp/mpfr/neg.c b/src/gmp/mpfr/neg.c
new file mode 100644
index 000000000..fff73a65a
--- /dev/null
+++ b/src/gmp/mpfr/neg.c
@@ -0,0 +1,40 @@
+/* mpfr_neg -- change the sign of a floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+void 
+#if __STDC__
+mpfr_neg(mpfr_ptr a, mpfr_srcptr b, unsigned char rnd_mode)
+#else
+mpfr_neg(a, b, rnd_mode)
+     mpfr_ptr a; 
+     mpfr_srcptr b; 
+     unsigned char rnd_mode; 
+#endif
+{
+  if (a != b) mpfr_set4(a, b, rnd_mode, -SIGN(b));
+  else CHANGE_SIGN(a);
+  return; 
+}
diff --git a/src/gmp/mpfr/out_str.c b/src/gmp/mpfr/out_str.c
new file mode 100644
index 000000000..aeaf64bd2
--- /dev/null
+++ b/src/gmp/mpfr/out_str.c
@@ -0,0 +1,65 @@
+/* mpfr_out_str -- output a floating-point number to a stream
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+size_t 
+#if __STDC__
+mpfr_out_str (FILE *stream, int base, size_t n_digits, mpfr_srcptr op,
+	      unsigned char rnd_mode)
+#else
+mpfr_out_str (stream, base, n_digits, op, rnd_mode)
+     FILE *stream; 
+     int base;
+     size_t n_digits; 
+     mpfr_srcptr op; 
+     unsigned char rnd_mode; 
+#endif
+{
+  char *s,*s0; size_t l; mp_exp_t e;
+
+  if (FLAG_NAN(op)) { fprintf(stream, "NaN"); return 3; }
+  if (!NOTZERO(op)) { fprintf(stream, "0"); return 1; }
+
+  s = mpfr_get_str(NULL, &e, base, n_digits, op, rnd_mode);
+  s0 = s;
+  /* for op=3.1416 we have s = "31416" and e = 1 */
+  
+  l = strlen(s)+1;
+  if (*s == '-') fputc(*s++, stream);
+
+  fputc(*s++, stream); e--; /* writes leading digit */
+  fputc('.', stream);       /* decimal point */
+  fputs(s, stream);         /* rest of mantissa */
+  if (e) {
+    fputc((base>10) ? '@' : 'e', stream); l++;
+    sprintf(s, "%ld", e);
+    l += strlen(s);
+    fprintf(stream, "%s", s);
+  }
+
+  (*_mp_free_func)(s0, l); 
+  return l;
+}
diff --git a/src/gmp/mpfr/pi.c b/src/gmp/mpfr/pi.c
new file mode 100644
index 000000000..322a2ab1c
--- /dev/null
+++ b/src/gmp/mpfr/pi.c
@@ -0,0 +1,131 @@
+/* mpfr_pi -- compute Pi
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+/*
+Set x to the value of Pi to precision PREC(x) rounded to direction rnd_mode.
+Use the formula giving the binary representation of Pi found by Simon Plouffe
+and the Borwein's brothers:
+
+                   infinity    4         2         1         1
+                    -----   ------- - ------- - ------- - -------
+                     \      8 n + 1   8 n + 4   8 n + 5   8 n + 6
+              Pi =    )     -------------------------------------
+                     /                         n
+                    -----                    16
+                    n = 0
+
+i.e. Pi*16^N = S(N) + R(N) where
+S(N) = sum(16^(N-n)*(4/(8*n+1)-2/(8*n+4)-1/(8*n+5)-1/(8*n+6)), n=0..N-1)
+R(N) = sum((4/(8*n+1)-2/(8*n+4)-1/(8*n+5)-1/(8*n+6))/16^(n-N), n=N..infinity)
+
+Let f(n) = 4/(8*n+1)-2/(8*n+4)-1/(8*n+5)-1/(8*n+6), we can show easily that
+f(n) < 15/(64*n^2), so R(N) < sum(15/(64*n^2)/16^(n-N), n=N..infinity)
+                            < 15/64/N^2*sum(1/16^(n-N), n=N..infinity)
+			    = 1/4/N^2
+
+Now let S'(N) = sum(floor(16^(N-n)*(120*n^2+151*n+47),
+  (512*n^4+1024*n^3+712*n^2+194*n+15)), n=0..N-1)
+
+S(N)-S'(N) <= sum(1, n=0..N-1) = N
+
+so Pi*16^N-S'(N) <= N+1 (as 1/4/N^2 < 1)
+*/
+
+mpfr_t __mpfr_pi; /* stored value of Pi */
+int __mpfr_pi_prec=0; /* precision of stored value */
+char __mpfr_pi_rnd; /* rounding mode of stored value */
+
+void 
+#if __STDC__
+mpfr_pi(mpfr_ptr x, unsigned char rnd_mode) 
+#else
+mpfr_pi(x, rnd_mode) 
+     mpfr_ptr x; 
+     unsigned char rnd_mode;
+#endif
+{
+  int N, oldN, n, prec; mpz_t pi, num, den, d3, d2, tmp; mpfr_t y;
+
+  prec=PREC(x);
+
+  /* has stored value enough precision ? */
+  if ((prec==__mpfr_pi_prec && rnd_mode==__mpfr_pi_rnd) ||
+      (prec<=__mpfr_pi_prec &&
+      mpfr_can_round(__mpfr_pi, __mpfr_pi_prec, __mpfr_pi_rnd, rnd_mode, prec)))
+    {
+      mpfr_set(x, __mpfr_pi, rnd_mode); return; 
+    }
+
+  /* need to recompute */
+  N=1; 
+  do {
+    oldN = N;
+    N = (prec+3)/4 + (int)ceil(log((double)N+1.0)/log(2.0));
+  } while (N != oldN);
+  mpz_init(pi); mpz_init(num); mpz_init(den); mpz_init(d3); mpz_init(d2);
+  mpz_init(tmp);
+  mpz_set_ui(pi, 0);
+  mpz_set_ui(num, 16); /* num(-1) */
+  mpz_set_ui(den, 21); /* den(-1) */
+  mpz_set_si(d3, -2454);
+  mpz_set_ui(d2, 14736);
+  /* invariants: num=120*n^2+151*n+47, den=512*n^4+1024*n^3+712*n^2+194*n+15
+                 d3 = 2048*n^3+400*n-6, d2 = 6144*n^2-6144*n+2448
+   */
+  for (n=0; n<N; n++) {
+    /* num(n)-num(n-1) = 240*n+31 */
+    mpz_add_ui(num, num, 240*n+31); /* no overflow up to PREC=71M */
+    /* d2(n) - d2(n-1) = 12288*(n-1) */
+    if (n>0) mpz_add_ui(d2, d2, 12288*(n-1));
+    else mpz_sub_ui(d2, d2, 12288);
+    /* d3(n) - d3(n-1) = d2 */
+    mpz_add(d3, d3, d2);
+    /* den(n)-den(n-1) = 2048*n^3 + 400n - 6 = d3 */
+    mpz_add(den, den, d3);
+    mpz_mul_2exp(tmp, num, 4*(N-n));
+    mpz_fdiv_q(tmp, tmp, den);
+    mpz_add(pi, pi, tmp);
+  }
+  mpfr_set_z(x, pi, rnd_mode);
+  mpfr_init2(y, mpfr_get_prec(x));
+  mpz_add_ui(pi, pi, N+1);
+  mpfr_set_z(y, pi, rnd_mode);
+  if (mpfr_cmp(x, y) != 0) {
+    fprintf(stderr, "does not converge\n"); exit(1);
+  }
+  EXP(x) -= 4*N;
+  mpz_clear(pi); mpz_clear(num); mpz_clear(den); mpz_clear(d3); mpz_clear(d2);
+  mpz_clear(tmp); mpfr_clear(y);
+
+  /* store computed value */
+  if (__mpfr_pi_prec==0) mpfr_init2(__mpfr_pi, prec);
+  else mpfr_set_prec(__mpfr_pi, prec);
+  mpfr_set(__mpfr_pi, x, rnd_mode);
+  __mpfr_pi_prec=prec;
+  __mpfr_pi_rnd=rnd_mode;
+}
diff --git a/src/gmp/mpfr/pow.c b/src/gmp/mpfr/pow.c
new file mode 100644
index 000000000..c53819ec2
--- /dev/null
+++ b/src/gmp/mpfr/pow.c
@@ -0,0 +1,67 @@
+/* mpfr_pow_ui, mpfr_ui_pow_ui -- compute the power of a floating-point
+                                  number or machine integer
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "mpfr.h"
+
+/* sets x to y^n */
+void 
+#if __STDC__
+mpfr_pow_ui (mpfr_ptr x, mpfr_srcptr y, unsigned int n, unsigned char rnd)
+#else
+mpfr_pow_ui (x, y, n, rnd)
+     mpfr_ptr x;
+     mpfr_srcptr y; 
+     unsigned int n; 
+     unsigned char rnd; 
+#endif
+{
+  int i;
+  
+  if (n==0) { mpfr_set_ui(x, 1, rnd); return; }
+  mpfr_set(x, y, rnd);
+  for (i=0;(1<<i)<=n;i++);
+  /* now 2^(i-1) <= n < 2^i */
+  for (i-=2; i>=0; i--) {
+    mpfr_mul(x, x, x, rnd);
+    if (n & (1<<i)) mpfr_mul(x, x, y, rnd);
+  }
+  return;
+}
+
+/* sets x to y^n */
+void mpfr_ui_pow_ui (mpfr_ptr x, unsigned int y, unsigned int n, 
+		     unsigned char rnd)
+{
+  int i;
+
+  if (n==0) { mpfr_set_ui(x, 1, rnd); return; }
+  mpfr_set_ui(x, y, rnd);
+  for (i=0;(1<<i)<=n;i++);
+  /* now 2^(i-1) <= n < 2^i */
+  for (i-=2; i>=0; i--) {
+    mpfr_mul(x, x, x, rnd);
+    if (n & (1<<i)) mpfr_mul_ui(x, x, y, rnd);
+  }
+  return;
+}
diff --git a/src/gmp/mpfr/print_raw.c b/src/gmp/mpfr/print_raw.c
new file mode 100644
index 000000000..4ff68bcaf
--- /dev/null
+++ b/src/gmp/mpfr/print_raw.c
@@ -0,0 +1,91 @@
+/* mpfr_print_raw -- print the internal binary representation of a 
+                     floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+void
+#if __STDC__
+mpfr_get_str_raw(char *digit_ptr, mpfr_srcptr x)
+#else
+mpfr_get_str_raw(digit_ptr, x)
+     char *digit_ptr; 
+     mpfr_srcptr x; 
+#endif
+{
+  mp_limb_t *mx, wd, t; long ex, sx, k, l, p;
+
+  mx = MANT(x); 
+  ex = EXP(x); 
+  p = PREC(x); 
+
+  if (SIGN(x) < 0) { *digit_ptr = '-'; digit_ptr++; }
+  sprintf(digit_ptr, "0."); digit_ptr += 2; 
+
+  sx = 1+(p-1)/mp_bits_per_limb; /* number of significant limbs */
+  for (k = sx - 1; k >= 0 ; k--)
+    { 
+      wd = mx[k]; 
+      t = ((mp_limb_t)1) << (BITS_PER_MP_LIMB - 1); 
+      for (l = BITS_PER_MP_LIMB - 1; l>=0; l--)
+	{
+	  if (wd & t) 
+	    { *digit_ptr = '1'; digit_ptr++; } 
+	  else 
+	    { *digit_ptr = '0'; digit_ptr++; }
+	  t >>= 1; 
+	  if (--p==0) { *digit_ptr = '['; digit_ptr++; }
+	}
+    }
+  sprintf(digit_ptr, "]E%ld", ex); 
+}
+ 
+void
+#if __STDC__
+mpfr_print_raw(mpfr_srcptr x)
+#else
+mpfr_print_raw(x)
+     mpfr_srcptr x; 
+#endif
+{
+  char *str; 
+
+  if (FLAG_NAN(x)) printf("NaN");
+  else if (!NOTZERO(x)) printf("0");
+  else {
+     /* 3 char for sign + 0 + binary point
+	+ ABSSIZE(x) * BITS_PER_MP_LIMB for mantissa
+	+ 2 for brackets in mantissa
+	+ 1 for 'E'
+	+ 11 for exponent (including sign)
+	= 17 + ABSSIZE(x) * BITS_PER_MP_LIMB
+      */
+     str = (char *) malloc((17 + ABSSIZE(x) * BITS_PER_MP_LIMB)*sizeof(char));
+     mpfr_get_str_raw(str, x);
+
+     printf("%s", str); 
+     free(str); 
+  }
+}
+
diff --git a/src/gmp/mpfr/print_rnd_mode.c b/src/gmp/mpfr/print_rnd_mode.c
new file mode 100644
index 000000000..a7bc1d06d
--- /dev/null
+++ b/src/gmp/mpfr/print_rnd_mode.c
@@ -0,0 +1,43 @@
+/* mpfr_print_rnd_mode -- convert a given rounding mode to a string
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+char *
+#if __STDC__
+mpfr_print_rnd_mode(unsigned char rnd_mode)
+#else
+mpfr_print_rnd_mode(rnd_mode)
+     unsigned char rnd_mode; 
+#endif
+{
+  switch (rnd_mode)
+    {
+    case GMP_RNDD: return("GMP_RNDD"); 
+    case GMP_RNDU: return("GMP_RNDU"); 
+    case GMP_RNDN: return("GMP_RNDN"); 
+    case GMP_RNDZ: return("GMP_RNDZ"); 
+    default: return("unknown rounding mode"); 
+    }
+}
diff --git a/src/gmp/mpfr/random.c b/src/gmp/mpfr/random.c
new file mode 100644
index 000000000..e61ddc0b7
--- /dev/null
+++ b/src/gmp/mpfr/random.c
@@ -0,0 +1,74 @@
+/* mpfr_random -- generate a random floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+/* Computes a random mpfr in [0, 1[ with precision PREC */
+
+extern long random _PROTO((void)); 
+extern int srandom _PROTO((unsigned int)); 
+
+/* extracted from GNU mpf */
+#if defined (__hpux) || defined (__alpha)
+/* HPUX lacks random().  DEC OSF/1 1.2 random() returns a double.  */
+#define random mrand48
+#define srandom srand48
+#endif
+
+void
+#if __STDC__
+mpfr_random(mpfr_ptr x)
+#else
+mpfr_random(x)
+     mpfr_ptr x; 
+#endif    
+{
+  mp_limb_t *xp; unsigned long xn, i, cnt, prec=PREC(x); 
+
+  xp = MANT(x);
+  xn = (prec-1)/BITS_PER_MP_LIMB + 1;
+
+  for (i = 0; i < xn; i++)
+    {
+      /* random() c/sh/ould be replaced by a homemade random number generator.
+	 Indeed, if on Linux random is a good RNG, this is definitely not
+	 the case in most Un*xes. */
+      xp[i] = random();
+    }
+  
+  count_leading_zeros(cnt, xp[xn - 1]); 
+  if (cnt) mpn_lshift(xp, xp, xn, cnt); 
+  EXP(x) = -cnt; 
+
+  cnt = xn*BITS_PER_MP_LIMB - prec; 
+  /* cnt is the number of non significant bits in the low limb */
+  xp[0] &= ~((((mp_limb_t)1)<<cnt) - 1);
+}
+
+void
+mpfr_srandom(unsigned long seed)
+{
+  srandom(seed); 
+}
diff --git a/src/gmp/mpfr/round.c b/src/gmp/mpfr/round.c
new file mode 100644
index 000000000..99e0e699b
--- /dev/null
+++ b/src/gmp/mpfr/round.c
@@ -0,0 +1,338 @@
+/* mpfr_round_raw2, mpfr_round_raw, mpfr_round, mpfr_can_round, 
+   mpfr_can_round_raw -- various rounding functions
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+#ifdef Exp
+#include "longlong.h"
+#endif
+
+/* returns 0 if round(sign*xp[0..xn-1], prec, rnd) = 
+   round(sign*xp[0..xn-1], prec, GMP_RNDZ), 1 otherwise,
+   where sign=1 if neg=0, sign=-1 otherwise.
+
+   Does *not* modify anything.
+*/
+int 
+#if __STDC__
+mpfr_round_raw2(mp_limb_t *xp, unsigned long xn, 
+		char neg, char rnd, unsigned long prec)
+#else
+mpfr_round_raw2(xp, xn, neg, rnd, prec)
+     mp_limb_t *xp; 
+     unsigned long xn; 
+     char neg; 
+     char rnd; 
+     unsigned long prec; 
+#endif
+{
+  unsigned long nw; long wd; char rw; short l; mp_limb_t mask;
+
+  nw = prec / BITS_PER_MP_LIMB; rw = prec & (BITS_PER_MP_LIMB - 1); 
+  if (rw) nw++; 
+  if (rnd==GMP_RNDZ || xn<nw || (rnd==GMP_RNDU && neg)
+      || (rnd==GMP_RNDD && neg==0)) return 0;
+
+  mask = ~((((mp_limb_t)1)<<(BITS_PER_MP_LIMB - rw)) - 1);
+  switch (rnd)
+    {
+    case GMP_RNDU:
+    case GMP_RNDD:
+      if (xp[xn - nw] & ~mask) return 1;
+      for (l = nw + 1;l <= xn; l++)
+	if (xp[xn - l]) break;
+      return (l <= xn);
+
+    case GMP_RNDN:
+    /* First check if we are just halfway between two representable numbers */
+      wd = xn - nw;
+      if (!rw)
+	{
+	  if (!wd) /* all bits are significative */ return 0; 
+	  wd--;
+	  if (xp[wd] == ((mp_limb_t)1 << (BITS_PER_MP_LIMB - 1)))
+	    {
+	      do wd--; while (wd > 0 && !xp[wd]);
+	      if (!wd) { return 1; } else return xp[xn - nw] & 1;
+	    }
+
+	  return xp[wd]>>(BITS_PER_MP_LIMB - 1);
+	}
+      else
+      if (rw + 1 < BITS_PER_MP_LIMB)
+	{
+	  if ((xp[wd] & (~mask)) == (((mp_limb_t)1) << (BITS_PER_MP_LIMB - rw - 1)))
+	      do { wd--; } while (wd >= 0 && !xp[wd]);
+	  else return ((xp[wd]>>(BITS_PER_MP_LIMB - rw - 1)) & 1);
+	  
+	  /* first limb was in the middle, and others down to wd+1 were 0 */
+	  if (wd>=0) return 1;
+	  else
+	      return ((xp[xn - nw] & mask) >> (BITS_PER_MP_LIMB - rw)) & 1;
+	}
+      else
+	/* Modified PZ, 27 May 1999:
+	   rw, i.e. the number of bits stored in xp[xn-nw], is 
+	   BITS_PER_MP_LIMB-1, i.e. there is exactly one non significant bit. 
+	   We are just halfway iff xp[wd] has its low significant bit 
+	   set and all limbs xp[0]...xp[wd-1] are zero */
+	{
+	  if (xp[wd] & 1)
+	      do wd--; while (wd >= 0 && !xp[wd]);
+	  return ((wd<0) ? xp[xn-nw]>>1 : xp[xn-nw]) & 1;
+	}
+    default: return 0;
+    }
+}
+
+/* puts in y the value of xp (with precision xprec and sign 1 if negative=0,
+   -1 otherwise) rounded to precision yprec and direction RND_MODE 
+   Supposes x is not zero nor NaN nor +/- Infinity (i.e. *xp != 0).
+*/
+int
+#if __STDC__
+mpfr_round_raw(mp_limb_t *y, mp_limb_t *xp, unsigned long xprec, char negative,
+	       unsigned long yprec, char RND_MODE)
+#else
+mpfr_round_raw(y, xp, xprec, negative, yprec, RND_MODE)
+     mp_limb_t *y; 
+     mp_limb_t *xp; 
+     unsigned long xprec; 
+     char negative;
+     unsigned long yprec; 
+     char RND_MODE; 
+#endif
+{
+  unsigned long nw, xsize; mp_limb_t mask;
+  char rw, xrw, carry = 0;
+
+  xsize = (xprec-1)/BITS_PER_MP_LIMB + 1;
+  xrw = xprec % BITS_PER_MP_LIMB; if (xrw == 0) { xrw = BITS_PER_MP_LIMB; }
+
+#ifdef Exp
+  count_leading_zeros(flag, xp[xsize-1]); 
+  yprec += flag; 
+#endif
+
+  nw = yprec / BITS_PER_MP_LIMB; rw = yprec & (BITS_PER_MP_LIMB - 1); 
+  if (rw) nw++; 
+  /* number of words needed to represent x */
+
+  mask = ~((((mp_limb_t)1)<<(BITS_PER_MP_LIMB - rw)) - (mp_limb_t)1); 
+
+  /* precision is larger than the size of x. No rounding is necessary. 
+     Just add zeroes at the end */
+  if (xsize < nw) { 
+    MPN_COPY(y + nw - xsize, xp, xsize);
+    MPN_ZERO(y, nw - xsize); /* PZ 27 May 99 */
+    y[0] &= mask;
+    return 0; 
+  }
+
+  if (mpfr_round_raw2(xp, xsize, negative, RND_MODE, yprec))
+    carry = mpn_add_1(y, xp + xsize - nw, nw,
+                          ((mp_limb_t)1) << (BITS_PER_MP_LIMB - rw));
+  else MPN_COPY(y, xp + xsize - nw, nw);
+
+  y[0] &= mask;
+  return carry; 
+}
+
+void
+#if __STDC__
+mpfr_round(mpfr_t x, char RND_MODE, unsigned long prec)
+#else
+mpfr_round(x, RND_MODE, prec)
+     mpfr_t x; 
+     char RND_MODE; 
+     unsigned long prec; 
+#endif
+{
+  mp_limb_t *tmp; int carry; unsigned long nw; 
+  TMP_DECL(marker); 
+
+  nw = prec / BITS_PER_MP_LIMB; 
+  if (prec & (BITS_PER_MP_LIMB - 1)) nw++;
+  TMP_MARK(marker); 
+  tmp = TMP_ALLOC (nw * BYTES_PER_MP_LIMB);
+  carry = mpfr_round_raw(tmp, MANT(x), PREC(x), (SIGN(x)<0), prec, RND_MODE);
+
+  if (carry)
+    {      
+      mpn_rshift(tmp, tmp, nw, 1); 
+      tmp [nw-1] |= (((mp_limb_t)1) << (BITS_PER_MP_LIMB - 1)); 
+      EXP(x)++; 
+    }
+
+  if (SIGN(x)<0) { SIZE(x)=nw; CHANGE_SIGN(x); } else SIZE(x)=nw;
+  PREC(x) = prec; 
+  MPN_COPY(MANT(x), tmp, nw); 
+  TMP_FREE(marker); 
+}
+
+/* hypotheses : BITS_PER_MP_LIMB est une puissance de 2 
+                dans un test, la premiere partie du && est evaluee d'abord */
+
+
+/* assuming b is an approximation of x in direction rnd1 
+   with error at most 2^(EXP(b)-err), returns 1 if one is 
+   able to round exactly x to precision prec with direction rnd2,
+   and 0 otherwise.
+
+   Side effects: none.
+*/
+
+int 
+#if __STDC__
+mpfr_can_round(mpfr_t b, unsigned long err, unsigned char rnd1, 
+	       unsigned char rnd2, unsigned long prec)
+#else
+mpfr_can_round(b, err, rnd1, rnd2, prec) 
+     mpfr_t b; 
+     unsigned long err;
+     unsigned char rnd1;
+     unsigned char rnd2; 
+     unsigned long prec;
+#endif
+{
+  return mpfr_can_round_raw(MANT(b), (PREC(b) - 1)/BITS_PER_MP_LIMB + 1, 
+			    SIGN(b), err, rnd1, rnd2, prec); 
+}
+
+int
+#if __STDC__
+mpfr_can_round_raw(mp_limb_t *bp, unsigned long bn, int neg, 
+		   unsigned long err, unsigned char rnd1, unsigned char rnd2, 
+		   unsigned long prec)
+#else
+mpfr_can_round_raw(bp, bn, neg, err, rnd1, rnd2, prec)
+     mp_limb_t *bp;
+     unsigned long bn;
+     int neg; 
+     unsigned long err; 
+     unsigned char rnd1;
+     unsigned char rnd2; 
+     unsigned long prec; 
+#endif
+{
+  int k, k1, l, l1, tn; mp_limb_t cc, cc2, *tmp;
+  TMP_DECL(marker); 
+
+  if (err<=prec) return 0;
+  neg = (neg > 0 ? 0 : 1); 
+
+  /* warning: if k = m*BITS_PER_MP_LIMB, consider limb m-1 and not m */
+  k = (err-1)/BITS_PER_MP_LIMB;
+  l = err % BITS_PER_MP_LIMB; if (l) l = BITS_PER_MP_LIMB-l;
+  /* the error corresponds to bit l in limb k */
+  k1 = (prec-1)/BITS_PER_MP_LIMB;
+  l1 = prec%BITS_PER_MP_LIMB; if (l1) l1 = BITS_PER_MP_LIMB-l1;
+
+  /* the last significant bit is bit l1 in limb k1 */
+
+  /* don't need to consider the k1 most significant limbs */
+  k -= k1; bn -= k1; prec -= k1*BITS_PER_MP_LIMB; k1=0;
+
+  if (rnd1==GMP_RNDU) { if (neg) rnd1=GMP_RNDZ; }
+  if (rnd1==GMP_RNDD) { if (neg) rnd1=GMP_RNDU; else rnd1=GMP_RNDZ; }
+
+  /* in the sequel, RNDU = towards infinity, RNDZ = towards zero */
+
+  TMP_MARK(marker);
+  tn = bn;
+  k++; /* since we work with k+1 everywhere */
+
+  switch (rnd1) {
+    
+  case GMP_RNDZ: /* b <= x <= b+2^(EXP(b)-err) */
+    tmp = TMP_ALLOC(tn*BYTES_PER_MP_LIMB); 
+    cc = (bp[bn-1]>>l1) & 1;
+    cc ^= mpfr_round_raw2(bp, bn, neg, rnd2, prec);
+
+    /* now round b+2^(EXP(b)-err) */
+    cc2 = mpn_add_1(tmp+bn-k, bp+bn-k, k, (mp_limb_t)1<<l);
+    /* if carry, then all bits up to err were to 1, and we can round only
+       if cc==0 and mpfr_round_raw2 returns 0 below */
+    if (cc2 && cc) { TMP_FREE(marker); return 0; }
+    cc2 = (tmp[bn-1]>>l1) & 1; /* gives 0 when carry */
+    cc2 ^= mpfr_round_raw2(tmp, bn, neg, rnd2, prec);
+
+    TMP_FREE(marker); 
+    return (cc == cc2);
+
+  case GMP_RNDU: /* b-2^(EXP(b)-err) <= x <= b */
+    tmp = TMP_ALLOC(tn*BYTES_PER_MP_LIMB); 
+    /* first round b */
+    cc = (bp[bn-1]>>l1) & 1;
+    cc ^= mpfr_round_raw2(bp, bn, neg, rnd2, prec);
+
+    /* now round b-2^(EXP(b)-err) */
+    cc2 = mpn_sub_1(tmp+bn-k, bp+bn-k, k, (mp_limb_t)1<<l);
+    /* if borrow, then all bits up to err were to 0, and we can round only
+       if cc==0 and mpfr_round_raw2 returns 1 below */
+    if (cc2 && cc) { TMP_FREE(marker); return 0; }
+    cc2 = (tmp[bn-1]>>l1) & 1; /* gives 1 when carry */
+    cc2 ^= mpfr_round_raw2(tmp, bn, neg, rnd2, prec);
+
+    TMP_FREE(marker); 
+    return (cc == cc2);
+
+  case GMP_RNDN: /* b-2^(EXP(b)-err-1) <= x <= b+2^(EXP(b)-err-1) */
+    if (l==0) tn++; 
+    tmp = TMP_ALLOC(tn*BYTES_PER_MP_LIMB); 
+
+    /* this case is the same than GMP_RNDZ, except we first have to
+       subtract 2^(EXP(b)-err-1) from b */
+
+    if (l) { 
+      l--; /* tn=bn */
+      mpn_sub_1(tmp+tn-k, bp+bn-k, k, (mp_limb_t)1<<l);
+    } 
+    else { 
+      MPN_COPY(tmp+1, bp, bn); *tmp=0; /* extra limb to add or subtract 1 */
+      k++; l=BITS_PER_MP_LIMB-1; 
+      mpn_sub_1(tmp+tn-k, tmp+tn-k, k, (mp_limb_t)1<<l);
+    }
+
+    /* round b-2^(EXP(b)-err-1) */
+    /* we can disregard borrow, since we start from tmp in 2nd case too */
+    cc = (tmp[tn-1]>>l1) & 1;
+    cc ^= mpfr_round_raw2(tmp, tn, neg, rnd2, prec);
+
+    if (l==BITS_PER_MP_LIMB-1) { l=0; k--; } else l++;
+
+    /* round b+2^(EXP(b)-err-1) = b-2^(EXP(b)-err-1) + 2^(EXP(b)-err) */    
+    cc2 = mpn_add_1(tmp+tn-k, tmp+tn-k, k, (mp_limb_t)1<<l);
+    /* if carry, then all bits up to err were to 1, and we can round only
+       if cc==0 and mpfr_round_raw2 returns 0 below */
+    if (cc2 && cc) { TMP_FREE(marker); return 0; }
+    cc2 = (tmp[tn-1]>>l1) & 1; /* gives 0 when carry */
+    cc2 ^= mpfr_round_raw2(tmp, tn, neg, rnd2, prec);
+
+    TMP_FREE(marker); 
+    return (cc == cc2);
+  }
+  return 0;
+}
diff --git a/src/gmp/mpfr/set.c b/src/gmp/mpfr/set.c
new file mode 100644
index 000000000..7177925fa
--- /dev/null
+++ b/src/gmp/mpfr/set.c
@@ -0,0 +1,53 @@
+/* mpfr_set -- copy of a floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+void 
+#if __STDC__
+mpfr_set4(mpfr_ptr a, mpfr_srcptr b, unsigned char rnd_mode, int signb)
+#else
+mpfr_set4(a, b, rnd_mode, signb) 
+     mpfr_ptr a; 
+     mpfr_srcptr b; 
+     unsigned char rnd_mode;
+     int signb;
+#endif
+{
+  int carry, an, preca = PREC(a), sh; mp_limb_t *ap = MANT(a);
+
+  carry = mpfr_round_raw(ap, MANT(b), PREC(b), (signb<0), preca, rnd_mode);
+  EXP(a) = EXP(b);
+  if (carry) {
+    an = (preca-1)/BITS_PER_MP_LIMB + 1;
+    sh = an * BITS_PER_MP_LIMB - preca;
+    if ((*ap >> sh) & 1) {
+      fprintf(stderr, "unable to round in mpfr_set\n"); exit(1);
+    }
+    mpn_rshift(ap, ap, an, 1);
+    ap[an-1] |= (mp_limb_t) 1 << (BITS_PER_MP_LIMB-1);
+    EXP(a)++;
+  }
+  if (SIGN(a) != signb) CHANGE_SIGN(a);
+}
diff --git a/src/gmp/mpfr/set_d.c b/src/gmp/mpfr/set_d.c
new file mode 100644
index 000000000..35c3ba21f
--- /dev/null
+++ b/src/gmp/mpfr/set_d.c
@@ -0,0 +1,329 @@
+/* mpfr_set_d, mpfr_get_d -- convert a multiple precision floating-point number
+                             from/to a machine double precision float
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#if __GNUC__ /* gcc "patched" headers seem to omit isnan... */
+extern int isnan(double);
+#endif
+#include <math.h> /* for isnan and NaN */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+#define NaN sqrt(-1) /* ensures a machine-independent NaN */
+
+/* Included from gmp-2.0.2, patched to support denorms */
+
+#ifdef XDEBUG
+#undef _GMP_IEEE_FLOATS
+#endif
+
+#ifndef _GMP_IEEE_FLOATS
+#define _GMP_IEEE_FLOATS 0
+#endif
+
+int
+#if __STDC__
+__mpfr_extract_double (mp_ptr rp, double d, int e)
+#else
+__mpfr_extract_double (rp, d, e)
+     mp_ptr rp;
+     double d;
+     int e;
+#endif
+     /* e=0 iff BITS_PER_MP_LIMB=32 and rp has only one limb */
+{
+  long exp;
+  mp_limb_t manl;
+#if BITS_PER_MP_LIMB == 32
+  mp_limb_t manh;
+#endif
+
+  /* BUGS
+
+     1. Should handle Inf and NaN in IEEE specific code.
+     2. Handle Inf and NaN also in default code, to avoid hangs.
+     3. Generalize to handle all BITS_PER_MP_LIMB >= 32.
+     4. This lits is incomplete and misspelled.
+   */
+
+  if (d == 0.0)
+    {
+      rp[0] = 0;
+#if BITS_PER_MP_LIMB == 32
+      if (e) rp[1] = 0;
+#endif
+      return 0;
+    }
+
+#if _GMP_IEEE_FLOATS
+  {
+    union ieee_double_extract x;
+    x.d = d;
+
+    exp = x.s.exp;
+    if (exp) 
+      {
+#if BITS_PER_MP_LIMB == 64
+	manl = (((mp_limb_t) 1 << 63)
+		| ((mp_limb_t) x.s.manh << 43) | ((mp_limb_t) x.s.manl << 11));
+#else
+	manh = ((mp_limb_t) 1 << 31) | (x.s.manh << 11) | (x.s.manl >> 21);
+	manl = x.s.manl << 11;      
+#endif
+      }
+    else
+      {
+#if BITS_PER_MP_LIMB == 64
+	manl = ((mp_limb_t) x.s.manh << 43) | ((mp_limb_t) x.s.manl << 11);
+#else
+    manh = (x.s.manh << 11) | (x.s.manl >> 21);
+	manl = x.s.manl << 11;      
+#endif
+      }
+  }
+#else
+  {
+    /* Unknown (or known to be non-IEEE) double format.  */
+    exp = 0;
+    if (d >= 1.0)
+      {
+        if (d * 0.5 == d)
+          abort ();
+
+        while (d >= 32768.0)
+          {
+            d *= (1.0 / 65536.0);
+            exp += 16;
+          }
+        while (d >= 1.0)
+          {
+            d *= 0.5;
+            exp += 1;
+          }
+      }
+    else if (d < 0.5)
+      {
+        while (d < (1.0 / 65536.0))
+          {
+            d *=  65536.0;
+            exp -= 16;
+          }
+        while (d < 0.5)
+          {
+            d *= 2.0;
+            exp -= 1;
+          }
+      }
+
+    d *= MP_BASE_AS_DOUBLE;
+#if BITS_PER_MP_LIMB == 64
+    manl = d;
+#else
+    manh = d;
+    manl = (d - manh) * MP_BASE_AS_DOUBLE;
+#endif
+
+    exp += 1022;
+  }
+#endif
+
+  if (exp) exp = (unsigned) exp - 1022; else exp = -1021; 
+
+#if BITS_PER_MP_LIMB == 64
+      rp[0] = manl;
+#else
+      if (e) {
+	rp[1] = manh;
+	rp[0] = manl;
+      }
+      else {
+	rp[0] = manh;
+      }
+#endif
+
+  return exp;
+}
+
+/* End of part included from gmp-2.0.2 */
+/* Part included from gmp temporary releases */
+double
+#if __STDC__
+__mpfr_scale2 (double d, int exp)
+#else
+__mpfr_scale2 (d, exp)
+     double d;
+     int exp;
+#endif
+{
+#if _GMP_IEEE_FLOATS
+  {
+    union ieee_double_extract x;
+    x.d = d;
+    exp += x.s.exp;
+    x.s.exp = exp;
+    if (exp >= 2047)
+      {
+        /* Return +-infinity */
+        x.s.exp = 2047;
+        x.s.manl = x.s.manh = 0;
+      }
+    else if (exp < 1)
+      {
+        x.s.exp = 1;            /* smallest exponent (biased) */
+        /* Divide result by 2 until we have scaled it to the right IEEE
+           denormalized number, but stop if it becomes zero.  */
+        while (exp < 1 && x.d != 0)
+          {
+            x.d *= 0.5;
+            exp++;
+          }
+      }
+    return x.d;
+  }
+#else
+  {
+    double factor, r;
+
+    factor = 2.0;
+    if (exp < 0)
+      {
+        factor = 0.5;
+        exp = -exp;
+      }
+    r = d;
+    if (exp != 0)
+      {
+        if ((exp & 1) != 0)
+          r *= factor;
+        exp >>= 1;
+        while (exp != 0)
+          {
+            factor *= factor;
+            if ((exp & 1) != 0)
+              r *= factor;
+            exp >>= 1;
+          }
+      }
+    return r;
+  }
+#endif
+}
+
+
+/* End of part included from gmp */
+
+void
+#if __STDC__
+mpfr_set_d(mpfr_t r, double d, unsigned char rnd_mode)
+#else
+mpfr_set_d(r, d, rnd_mode)
+     mpfr_t r;
+     double d;
+     unsigned char rnd_mode;
+#endif
+{
+  int signd, sizer; unsigned int cnt;
+
+  if (d == 0) { SET_ZERO(r); return; }
+  else if (isnan(d)) { SET_NAN(r); return; }
+
+  signd = (d < 0) ? -1 : 1;
+  d = ABS (d);
+  sizer = (PREC(r)-1)/BITS_PER_MP_LIMB + 1;
+
+  /* warning: __mpfr_extract_double requires at least two limbs */
+  if (sizer < MPFR_LIMBS_PER_DOUBLE)
+    EXP(r) = __mpfr_extract_double (MANT(r), d, 0);
+  else
+    EXP(r) = __mpfr_extract_double (MANT(r) + sizer - MPFR_LIMBS_PER_DOUBLE, d, 1);
+  
+  if (sizer > MPFR_LIMBS_PER_DOUBLE)
+    MPN_ZERO(MANT(r), sizer - MPFR_LIMBS_PER_DOUBLE); 
+
+  count_leading_zeros(cnt, MANT(r)[sizer-1]);
+  if (cnt) mpn_lshift(MANT(r), MANT(r), sizer, cnt); 
+  
+  EXP(r) -= cnt; 
+  if (SIZE(r)*signd<0) CHANGE_SIGN(r);
+
+  mpfr_round(r, rnd_mode, PREC(r)); 
+  return; 
+}
+
+double
+#if __STDC__
+mpfr_get_d2(mpfr_srcptr src, long e)
+#else
+mpfr_get_d2(src, e)
+     mpfr_srcptr(src); 
+     long e; 
+#endif
+{
+  double res;
+  mp_size_t size, i, n_limbs_to_use;
+  mp_ptr qp;
+  int negative;
+
+  if (FLAG_NAN(src)) { 
+#ifdef DEBUG
+    printf("recognized NaN\n");
+#endif
+    return NaN; }
+  if (NOTZERO(src)==0) return 0.0;
+  size = 1+(PREC(src)-1)/BITS_PER_MP_LIMB;
+  qp = MANT(src);
+  negative = (SIGN(src)==-1);
+
+  /* Warning: don't compute the abs(res) and set the sign afterwards,
+     otherwise the current machine rounding mode will not be taken
+     correctly into account. */
+  /* res = (negative) ? -(double)qp[size - 1] : qp[size - 1]; */
+  res = 0.0;
+  /* Warning: an arbitrary number of limbs may be required for an exact 
+     rounding. The following code is correct but not optimal since one
+     may be able to decide without considering all limbs. */
+  /* n_limbs_to_use = MIN (MPFR_LIMBS_PER_DOUBLE, size); */
+  n_limbs_to_use = size;
+  /* Accumulate the limbs from less significant to most significant
+     otherwise due to rounding we may accumulate several ulps,
+     especially in rounding towards -/+infinity. */
+  for (i = n_limbs_to_use; i>=1; i--)
+    res = res / MP_BASE_AS_DOUBLE +
+      ((negative) ? -(double)qp[size - i] : qp[size - i]);
+  res = __mpfr_scale2 (res, e - BITS_PER_MP_LIMB); 
+
+  return res;
+}
+
+double 
+#if __STDC__
+mpfr_get_d(mpfr_srcptr src)
+#else
+mpfr_get_d(src)
+     mpfr_srcptr src; 
+#endif
+{
+  return mpfr_get_d2(src, EXP(src));
+}
+
diff --git a/src/gmp/mpfr/set_dfl_prec.c b/src/gmp/mpfr/set_dfl_prec.c
new file mode 100644
index 000000000..aa341be8a
--- /dev/null
+++ b/src/gmp/mpfr/set_dfl_prec.c
@@ -0,0 +1,37 @@
+/* mpfr_set_default_prec -- set the default precision
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* default is 53 bits */
+mp_size_t __gmp_default_fp_bit_precision = 53;
+
+void
+#if __STDC__
+mpfr_set_default_prec (unsigned long int prec_in_bits)
+#else
+mpfr_set_default_prec (prec_in_bits)
+     unsigned long int prec_in_bits;
+#endif
+{
+  __gmp_default_fp_bit_precision = prec_in_bits;
+}
diff --git a/src/gmp/mpfr/set_dfl_rnd.c b/src/gmp/mpfr/set_dfl_rnd.c
new file mode 100644
index 000000000..cf8fd0175
--- /dev/null
+++ b/src/gmp/mpfr/set_dfl_rnd.c
@@ -0,0 +1,37 @@
+/* mpfr_set_default_rounding_mode -- set the default rounding mode
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+char __gmp_default_rounding_mode = 0;
+
+void
+#if __STDC__
+mpfr_set_default_rounding_mode (char rnd_mode)
+#else
+mpfr_set_default_rounding_mode (rnd_mode)
+     char rnd_mode;
+#endif
+{
+  __gmp_default_rounding_mode = rnd_mode;
+}
+
diff --git a/src/gmp/mpfr/set_f.c b/src/gmp/mpfr/set_f.c
new file mode 100644
index 000000000..d3bb98dbf
--- /dev/null
+++ b/src/gmp/mpfr/set_f.c
@@ -0,0 +1,72 @@
+/* mpfr_set_f -- set a MPFR number from a GNU MPF number
+
+Copyright (C) 1999-2000 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+void 
+#if __STDC__
+mpfr_set_f(mpfr_ptr y, mpf_srcptr x, char rnd_mode)
+#else
+mpfr_set_f(y, x, rnd_mode)
+     mpfr_ptr y;
+     mpf_srcptr x;
+     char rnd_mode; 
+#endif
+{
+  mp_limb_t *my, *mx, *tmp; unsigned long cnt, sx, sy;
+  TMP_DECL(marker);
+
+  sx = ABS(SIZ(x)); sy = ABSSIZE(y);
+  my = MANT(y); mx = MANT(x);
+
+  if (sx==0) { /* x is zero */
+    SET_ZERO(y); return;
+  }
+
+  count_leading_zeros(cnt, mx[sx - 1]);  
+
+  if (SIZ(x)*SIGN(y)<0) CHANGE_SIGN(y);
+
+  if (sy < sx)
+    {
+      unsigned long xprec = sx * BITS_PER_MP_LIMB;
+
+      tmp = (mp_limb_t*) TMP_ALLOC(xprec);
+      if (cnt) mpn_lshift(tmp, mx, sx, cnt); 
+      else MPN_COPY(tmp, mx, sx); 
+      mpfr_round_raw(my, tmp, xprec, (SIZ(x)<0), PREC(y), rnd_mode);  
+    }
+  else
+    {
+      if (cnt) mpn_lshift(my + sy - sx, mx, sx, cnt); 
+      else MPN_COPY(my + sy - sx, mx, sy); 
+      MPN_ZERO(my, sy - sx);
+      /* no rounding necessary, since y has a larger mantissa */
+    }
+  
+  EXP(y) = EXP(x) * BITS_PER_MP_LIMB - cnt;
+
+  TMP_FREE(marker);
+}
diff --git a/src/gmp/mpfr/set_prec.c b/src/gmp/mpfr/set_prec.c
new file mode 100644
index 000000000..d85eac3c3
--- /dev/null
+++ b/src/gmp/mpfr/set_prec.c
@@ -0,0 +1,62 @@
+/* mpfr_set_prec -- reset the precision of a floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+void
+#if __STDC__
+mpfr_set_prec (mpfr_t x, unsigned long int p)
+#else
+mpfr_set_prec (x, p)
+     mpfr_t x;
+     unsigned long int p;
+#endif
+{
+  unsigned long xsize;
+
+  if (p==0) {
+    printf("*** cannot set precision to 0 bits\n"); exit(1);
+  }
+
+  xsize = (p - 1)/BITS_PER_MP_LIMB + 1; /* new limb size */
+
+  if (xsize > ABSSIZE(x)) {
+    x -> _mp_d = (mp_ptr) (*_mp_reallocate_func) 
+      (x -> _mp_d, ABSSIZE(x)*BYTES_PER_MP_LIMB, xsize * BYTES_PER_MP_LIMB);
+    SIZE(x) = xsize; /* new number of allocated limbs */
+  }
+
+  x -> _mp_prec = p;
+}
+
+unsigned long int
+#if __STDC__
+mpfr_get_prec (mpfr_t x)
+#else
+mpfr_get_prec (x)
+     mpfr_t x;
+#endif
+{
+  return x -> _mp_prec;
+}
diff --git a/src/gmp/mpfr/set_si.c b/src/gmp/mpfr/set_si.c
new file mode 100644
index 000000000..b2d916cd1
--- /dev/null
+++ b/src/gmp/mpfr/set_si.c
@@ -0,0 +1,81 @@
+/* mpfr_set_si, mpfr_set_ui -- set a MPFR number from a machine integer
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+void
+#if __STDC__
+mpfr_set_si(mpfr_ptr x, long i, unsigned char rnd_mode)
+#else
+mpfr_set_si(x, i, rnd_mode)
+     mpfr_ptr x;
+     long i;
+     unsigned char rnd_mode;
+#endif
+{
+  unsigned long xn, cnt; mp_limb_t ai;
+
+  if (i==0) { SET_ZERO(x); return; }
+  xn = (PREC(x)-1)/BITS_PER_MP_LIMB;
+  ai = ABS(i); 
+
+  count_leading_zeros(cnt, ai); 
+
+  x -> _mp_d[xn] = ai << cnt;
+  /* don't forget to put zero in lower limbs */
+  MPN_ZERO(MANT(x), xn);
+  x -> _mp_exp = BITS_PER_MP_LIMB - cnt;
+  /* warning: don't change the precision of x! */
+  if (i*SIGN(x) < 0) CHANGE_SIGN(x);
+
+  return; 
+}
+
+void
+#if __STDC__
+mpfr_set_ui(mpfr_ptr x, unsigned long i, unsigned char rnd_mode)
+#else
+mpfr_set_ui(x, i, rnd_mode)
+     mpfr_ptr x;
+     long i;
+     unsigned char rnd_mode;
+#endif  
+{
+  unsigned int xn, cnt;
+
+  if (i==0) { SET_ZERO(x); return; }
+  xn = (PREC(x)-1)/BITS_PER_MP_LIMB;
+  count_leading_zeros(cnt, (mp_limb_t) i); 
+
+  x -> _mp_d[xn] = ((mp_limb_t) i) << cnt; 
+  /* don't forget to put zero in lower limbs */
+  MPN_ZERO(MANT(x), xn);
+  x -> _mp_exp = BITS_PER_MP_LIMB - cnt;
+  /* warning: don't change the precision of x! */
+  if (SIGN(x) < 0) CHANGE_SIGN(x);
+
+  return; 
+}
+
diff --git a/src/gmp/mpfr/set_str_raw.c b/src/gmp/mpfr/set_str_raw.c
new file mode 100644
index 000000000..d0945c4bc
--- /dev/null
+++ b/src/gmp/mpfr/set_str_raw.c
@@ -0,0 +1,112 @@
+/* mpfr_set_str_raw -- set a floating-point number from a binary string
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#ifdef HAS_STRING_H
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+/* Currently the number should be of the form +/- xxxx.xxxxxxEyy, with 
+   decimal exponent. The mantissa of x is supposed to be large enough 
+   to hold all the bits of str. */
+
+void
+#if __STDC__
+mpfr_set_str_raw(mpfr_ptr x, char *str)
+#else
+mpfr_set_str_raw(x, str)
+     mpfr_ptr x; 
+     char *str; 
+#endif
+{
+  char *str2, *str0, negative = 0; 
+  unsigned long j, l, k = 0, xsize, cnt; mp_limb_t *xp; 
+  long expn = 0, e; char *endstr2;
+
+  xp = x -> _mp_d; 
+  xsize = 1 + (PREC(x)-1)/BITS_PER_MP_LIMB;
+  str0 = str2 = (char *) malloc((strlen(str)+1)*sizeof(char)); 
+
+  if (*str == '-') { negative = 1; str++; }
+  else if (*str == '+') str++;
+
+  while (*str == '0') { str++; } 
+
+  while (*str == '0' || *str == '1')
+    { *(str2++) = *(str++); k++; }
+
+  if (*str == '.') 
+    {
+      str++;
+      while (*str == '0' || *str == '1')
+	{ *(str2++) = *(str++); }
+
+      if (*str == '[') { while (*str != ']') str++; }
+    }
+    
+  if (*str == '[') { while (*str != ']') str++; }
+
+  if (*str == 'e' || *str == 'E') 
+    {
+      e = atol(++str); /* signed exponent after 'e' or 'E' */
+      expn = k + e; 
+      if (expn < e)
+	  fprintf(stderr, "Warning: overflow in exponent in Str -> mpfr\n"); 
+    }
+  else expn=k;
+
+  endstr2 = str2;
+  *str2 = (char) 0; /* end of string */
+  l = (strlen(str0) - 1) / BITS_PER_MP_LIMB + 1; str2 = str0; 
+
+  /* str2[0]..endstr2[-1] contains the mantissa */
+  for (k = 1; k <= l; k++)
+    {
+      j = 0; 
+      xp[xsize - k] = 0; 
+      while (str2<endstr2 && j < BITS_PER_MP_LIMB)
+	{
+	  xp[xsize - k] = (xp[xsize - k] << 1) + (*str2 - '0'); 
+	  str2++; j++; 
+	}
+      xp[xsize - k] <<= (BITS_PER_MP_LIMB - j); 
+    }
+
+  for (; k <= xsize; k++) { xp[xsize - k] = 0; }
+
+  count_leading_zeros(cnt, xp[xsize - 1]); 
+  if (cnt) mpn_lshift(xp, xp, xsize, cnt); 
+
+  x -> _mp_exp = expn - cnt; 
+  x -> _mp_size = xsize; if (negative) CHANGE_SIGN(x);
+
+  free(str0); 
+  
+  /* May change to take into account : syntax errors, overflow in exponent, 
+     string truncated because of size of x */
+}
diff --git a/src/gmp/mpfr/set_z.c b/src/gmp/mpfr/set_z.c
new file mode 100644
index 000000000..de9132033
--- /dev/null
+++ b/src/gmp/mpfr/set_z.c
@@ -0,0 +1,104 @@
+/* mpfr_set_z -- set a floating-point number from a multiple-precision integer
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+/* set f to the integer z */
+int 
+#if __STDC__
+mpfr_set_z (mpfr_ptr f, mpz_srcptr z, unsigned char rnd)
+#else
+mpfr_set_z (f, z, rnd) 
+     mpfr_ptr f; 
+     mpz_srcptr z; 
+     unsigned char rnd;
+#endif
+{
+  int fn, zn, k, dif, sign_z, sh; mp_limb_t *fp = MANT(f), *zp, cc, c2;
+
+  sign_z = mpz_cmp_ui(z,0);
+  if (sign_z==0) return (SIZE(f)=0);
+  fn = 1 + (PREC(f)-1)/BITS_PER_MP_LIMB;
+  zn = ABS(SIZ(z));
+  dif = zn-fn;
+  zp = PTR(z);
+  count_leading_zeros(k, zp[zn-1]);
+  EXP(f) = zn*BITS_PER_MP_LIMB-k;
+  if (SIGN(f)*sign_z<0) CHANGE_SIGN(f);
+  if (dif>=0) { /* number has to be truncated */
+    if (k) {
+      mpn_lshift(fp, zp + dif, fn, k);
+      if (dif) *fp += zp[dif-1] >> (BITS_PER_MP_LIMB-k);
+    }
+    else MPN_COPY(fp, zp + dif, fn);
+    sh = fn*BITS_PER_MP_LIMB-PREC(f);
+    cc = *fp & (((mp_limb_t)1 << sh) - 1);
+    *fp = *fp & ~cc;
+    if (rnd==GMP_RNDN) {
+      if (sh) c2 = (mp_limb_t)1 << (sh-1);
+      else { /* sh=0 */
+	c2 = ((mp_limb_t)1) << (BITS_PER_MP_LIMB-1);
+	dif--;
+	cc = (dif>=0) ? ((zp[dif])<<k) : 0;
+	if (dif>0 && k) cc += zp[dif-1] >> (BITS_PER_MP_LIMB-k);
+      }
+      /* now compares cc to c2 */
+      if (cc>c2) { mpfr_add_one_ulp(f); return cc; }
+      else if (cc<c2) goto towards_zero;
+      else {
+	cc=0;
+	while (dif>0 && (cc=zp[dif-1])==0) dif--;
+	if (cc) { mpfr_add_one_ulp(f); return cc; }
+	else /* exactly in middle: inexact in both cases */
+	  if (*fp & ((mp_limb_t)1<<sh)) { mpfr_add_one_ulp(f); return 1; }
+	  else return 1;
+      }
+    }
+    else if ((sign_z>0 && rnd==GMP_RNDU) || (sign_z<0 && rnd==GMP_RNDD)) {
+      /* round towards infinity */
+      /* result is exact iff all remaining bits are zero */
+      if (dif>0 && cc==0) cc=zp[--dif]<<k;
+      while (cc==0 && dif>0) cc=zp[--dif];
+      if (cc) { mpfr_add_one_ulp(f); return 1; }
+      else return 0;
+    }
+    else { /* round towards zero */
+      /* result is exact iff all remaining bits are zero */
+    towards_zero:
+      if (cc==0 && dif>0) cc=zp[--dif]<<k;
+      while (cc==0 && dif>0) cc=zp[--dif];
+      return cc;
+    }
+  }
+  else {
+    if (k) mpn_lshift(fp-dif, zp, zn, k);
+    else MPN_COPY(fp-dif, zp, zn);
+    /* fill with zeroes */
+    MPN_ZERO(fp, -dif);
+    return 0; /* result is exact */
+  }
+}
+
+
+
diff --git a/src/gmp/mpfr/sqrt.c b/src/gmp/mpfr/sqrt.c
new file mode 100644
index 000000000..a34ff6dae
--- /dev/null
+++ b/src/gmp/mpfr/sqrt.c
@@ -0,0 +1,220 @@
+/* mpfr_sqrt -- square root of a floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+#include "longlong.h"
+
+/* #define DEBUG */
+
+int
+mpfr_sqrt (mpfr_ptr r, mpfr_srcptr u, unsigned char rnd_mode)
+{
+  mp_ptr up, rp, tmp, remp;
+  mp_size_t usize, rrsize;
+  mp_size_t rsize;
+  mp_size_t prec, err;
+  mp_limb_t q_limb;
+  long rw, nw, k; 
+  int exact = 0; 
+  unsigned long cc = 0; 
+  char can_round = 0; 
+  TMP_DECL (marker); TMP_DECL(marker0); 
+
+  if (FLAG_NAN(u) || SIGN(u) == -1) { SET_NAN(r); return 0; }
+  
+  prec = PREC(r);
+
+  if (!NOTZERO(u))
+    {
+      EXP(r) = 0; 
+      MPN_ZERO(MANT(r), ABSSIZE(r)); 
+      return 1; 
+    }
+
+  up = MANT(u);
+
+#ifdef DEBUG
+      printf("Entering square root : "); 
+      for(k = usize - 1; k >= 0; k--) { printf("%lu ", up[k]); }
+      printf(".\n"); 
+#endif
+
+  /* Compare the mantissas */
+  
+  usize = (PREC(u) - 1)/BITS_PER_MP_LIMB + 1; 
+  rsize = ((PREC(r) + 2 + (EXP(u) & 1))/BITS_PER_MP_LIMB + 1) << 1; 
+  rrsize = (PREC(r) + 2 + (EXP(u) & 1))/BITS_PER_MP_LIMB + 1;
+  /* One extra bit is needed in order to get the square root with enough
+     precision ; take one extra bit for rrsize in order to solve more 
+     easily the problem of rounding to nearest.
+     Need to have 2*rrsize = rsize...
+     Take one extra bit if the exponent of u is odd since we shall have
+     to shift then.
+  */
+
+  TMP_MARK(marker0); 
+  if (EXP(u) & 1) /* Shift u one bit to the right */
+    {
+      if (PREC(u) & (BITS_PER_MP_LIMB - 1))
+	{
+	  up = TMP_ALLOC(usize*BYTES_PER_MP_LIMB);
+	  mpn_rshift(up, u->_mp_d, usize, 1); 
+	}
+      else
+	{
+	  up = TMP_ALLOC((usize + 1)*BYTES_PER_MP_LIMB);
+	  if (mpn_rshift(up + 1, u->_mp_d, ABSSIZE(u), 1))
+	    up [0] = ((mp_limb_t) 1) << (BITS_PER_MP_LIMB - 1); 
+	  else up[0] = 0; 
+	  usize++; 
+	}
+    }
+
+  EXP(r) = ((EXP(u) + (EXP(u) & 1)) / 2) ;  
+  
+  do
+    {
+      TMP_MARK (marker);
+
+      err = rsize*BITS_PER_MP_LIMB; 
+      if (rsize < usize) { err--; }
+      if (err > rrsize * BITS_PER_MP_LIMB) 
+	{ err = rrsize * BITS_PER_MP_LIMB; }
+      
+      tmp = (mp_ptr) TMP_ALLOC (rsize * BYTES_PER_MP_LIMB);  
+      rp = (mp_ptr) TMP_ALLOC (rrsize * BYTES_PER_MP_LIMB); 
+      remp = (mp_ptr) TMP_ALLOC (rsize * BYTES_PER_MP_LIMB); 
+
+      if (usize >= rsize) { 
+	MPN_COPY (tmp, up + usize - rsize, rsize);
+      }
+      else { 
+	MPN_COPY (tmp + rsize - usize, up, usize);
+	MPN_ZERO (tmp, rsize - usize); 
+      }
+
+      /* Do the real job */
+ 
+#ifdef DEBUG
+      printf("Taking the sqrt of : "); 
+      for(k = rsize - 1; k >= 0; k--) { 
+	printf("+%lu*2^%lu",tmp[k],k*mp_bits_per_limb); }
+      printf(".\n"); 
+#endif
+
+      q_limb = kara_sqrtrem (rp, remp, tmp, rsize);
+
+#ifdef DEBUG
+      printf("The result is : \n"); 
+      printf("sqrt : "); 
+      for(k = rrsize - 1; k >= 0; k--) { printf("%lu ", rp[k]); }
+      printf("(q_limb = %lu)\n", q_limb); 
+#endif
+      
+      can_round = (mpfr_can_round_raw(rp, rrsize, 1, err, 
+				      GMP_RNDZ, rnd_mode, PREC(r))); 
+
+      /* If we used all the limbs of both the dividend and the divisor, 
+	 then we have the correct RNDZ rounding */
+
+      if (!can_round && (rsize < 2*usize)) 
+	{ 
+#ifdef DEBUG
+	  printf("Increasing the precision.\n"); 
+#endif
+	  TMP_FREE(marker); 
+	}
+    }
+  while (!can_round && (rsize < 2*usize) 
+	 && (rsize += 2) && (rrsize ++)); 
+
+
+  /* This part may be deplaced upper to avoid a few mpfr_can_round_raw */
+  /* when the square root is exact. It is however very unprobable that */
+  /* it would improve the behaviour of the present code on average.    */
+
+  if (!q_limb) /* possibly exact */
+    {
+      /* if we have taken into account the whole of up */
+      for (k = usize - rsize - 1; k >= 0; k ++)
+	if (up[k]) break; 
+      
+      if (k < 0) { exact = 1; goto fin; }
+    }
+
+  if (can_round) 
+    {
+      cc = mpfr_round_raw(rp, rp, err, 0, PREC(r), rnd_mode);  
+      rrsize = (PREC(r) - 1)/BITS_PER_MP_LIMB + 1; 
+    }
+  else
+    /* Use the return value of sqrtrem to decide of the rounding         */
+    /* Note that at this point the sqrt has been computed                */
+    /* EXACTLY. If rounding = GMP_RNDZ, do nothing [comes from           */
+    /* the fact that the exact square root can end with a bunch of ones, */
+    /* and in that case we indeed cannot round if we do not know that    */
+    /* the computation was exact.                                        */
+    switch (rnd_mode)
+      {
+      case GMP_RNDZ : 
+      case GMP_RNDD : break; 
+
+      case GMP_RNDN : 
+	/* Not in the situation ...0 111111 */
+	rw = (PREC(r) + 1) & (BITS_PER_MP_LIMB - 1);
+	if (rw) { rw = BITS_PER_MP_LIMB - rw; nw = 0; } else nw = 1; 
+	if ((rp[nw] >> rw) & 1 &&                     /* Not 0111111111 */
+	    (q_limb ||                                /* Nonzero remainder */
+	    (rw ? (rp[nw] >> (rw + 1)) & 1 : 
+	     (rp[nw] >> (BITS_PER_MP_LIMB - 1)) & 1))) /* or even rounding */ 
+	  cc = mpn_add_1(rp + nw, rp + nw, rrsize, ((mp_limb_t)1) << rw); 
+	break;
+ 
+      case GMP_RNDU : 
+	if (q_limb)
+	  cc = mpn_add_1(rp, rp, rrsize, 1 << (BITS_PER_MP_LIMB - 
+					       (PREC(r) & 
+						(BITS_PER_MP_LIMB - 1))));
+      }
+
+  if (cc) {
+    mpn_rshift(rp, rp, rrsize, 1);
+    rp[rrsize-1] |= (mp_limb_t) 1 << (BITS_PER_MP_LIMB-1);
+    r->_mp_exp++; 
+  }
+
+ fin:
+  rsize = rrsize; 
+  rrsize = (PREC(r) - 1)/BITS_PER_MP_LIMB + 1;  
+  MPN_COPY(r->_mp_d, rp + rsize - rrsize, rrsize); 
+
+  if (PREC(r) & (BITS_PER_MP_LIMB - 1))
+    MANT(r) [0] &= ~(((mp_limb_t)1 << (BITS_PER_MP_LIMB - 
+				   (PREC(r) & (BITS_PER_MP_LIMB - 1)))) - 1) ; 
+  
+  TMP_FREE(marker0); TMP_FREE (marker);
+  return exact; 
+}
diff --git a/src/gmp/mpfr/sub.c b/src/gmp/mpfr/sub.c
new file mode 100644
index 000000000..dfe755b73
--- /dev/null
+++ b/src/gmp/mpfr/sub.c
@@ -0,0 +1,483 @@
+/* mpfr_sub -- subtract two floating-point numbers
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+
+/* #define DEBUG */
+
+extern void mpfr_add1 _PROTO((mpfr_ptr, mpfr_srcptr, mpfr_srcptr, 
+			      unsigned char, int));
+
+/* put in ap[0]..ap[an-1] the value of bp[0]..bp[n-1] shifted by sh bits
+   to the left minus ap[0]..ap[n-1], with 0 <= sh < mp_bits_per_limb, and
+   returns the borrow.
+*/
+mp_limb_t
+#if __STDC__ 
+mpn_sub_lshift_n (mp_limb_t *ap, mp_limb_t *bp, int n, int sh, int an)
+#else
+mpn_sub_lshift_n (ap, bp, n, sh, an) mp_limb_t *ap, *bp; int n,sh,an;
+#endif
+{
+  mp_limb_t c, bh;
+
+  /* shift b to the left */
+  if (sh) bh = mpn_lshift(bp, bp, n, sh);
+  c = (n<an) ? mpn_sub_n(ap, bp, ap, n) : mpn_sub_n(ap, bp+(n-an), ap, an);
+  /* shift back b to the right */
+  if (sh) {
+    mpn_rshift(bp, bp, n, sh);
+    bp[n-1] += bh<<(mp_bits_per_limb-sh);
+  }
+  return c;
+}
+
+/* signs of b and c differ, abs(b)>=abs(c), diff_exp>=0 */
+void 
+#if __STDC__
+mpfr_sub1(mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, unsigned char rnd_mode, int diff_exp) 
+#else
+mpfr_sub1(a, b, c, rnd_mode, diff_exp) 
+     mpfr_ptr a;
+     mpfr_srcptr b;
+     mpfr_srcptr c; 
+     unsigned char rnd_mode; 
+     int diff_exp;
+#endif
+{
+  mp_limb_t *ap, *bp, *cp, cc, c2; unsigned int an,bn,cn; 
+  int sh,dif,k,cancel,cancel1,cancel2;
+  TMP_DECL(marker);
+
+#ifdef DEBUG
+  printf("b=  "); if (SIGN(b)>=0) putchar(' ');
+  mpfr_print_raw(b); putchar('\n');
+  printf("c=  "); if (SIGN(c)>=0) putchar(' ');
+  for (k=0;k<diff_exp;k++) putchar(' '); mpfr_print_raw(c);
+  putchar('\n');
+  printf("b=%1.20e c=%1.20e\n",mpfr_get_d(b),mpfr_get_d(c));
+#endif
+  cancel = mpfr_cmp2(b, c);
+  /* we have to take into account the first (PREC(a)+cancel) bits from b */
+  cancel1 = cancel/mp_bits_per_limb; cancel2 = cancel%mp_bits_per_limb;
+  TMP_MARK(marker); 
+  ap = MANT(a);
+  bp = MANT(b);
+  cp = MANT(c);
+  if (ap == bp) {
+    bp = (mp_ptr) TMP_ALLOC(ABSSIZE(b) * BYTES_PER_MP_LIMB); 
+    MPN_COPY (bp, ap, ABSSIZE(b));
+    if (ap == cp) { cp = bp; }
+  }
+  else if (ap == cp)
+    {
+      cp = (mp_ptr) TMP_ALLOC (ABSSIZE(c) * BYTES_PER_MP_LIMB);
+      MPN_COPY(cp, ap, ABSSIZE(c)); 
+    }
+  an = (PREC(a)-1)/mp_bits_per_limb+1; /* number of significant limbs of a */
+  sh = an*mp_bits_per_limb-PREC(a); /* non-significant bits in low limb */
+  bn = (PREC(b)-1)/mp_bits_per_limb+1; /* number of significant limbs of b */
+  cn = (PREC(c)-1)/mp_bits_per_limb + 1;
+  EXP(a) = EXP(b)-cancel;
+  /* adjust sign to that of b */
+  if (SIGN(a)*SIGN(b)<0) CHANGE_SIGN(a);
+  /* case 1: diff_exp>=prec(a), i.e. c only affects the last bit
+     through rounding */
+  dif = PREC(a)-diff_exp;
+#ifdef DEBUG
+  printf("PREC(a)=%d an=%u PREC(b)=%d bn=%u PREC(c)=%d diff_exp=%u dif=%d cancel=%d\n",
+	 PREC(a),an,PREC(b),bn,PREC(c),diff_exp,dif,cancel);
+#endif
+  if (dif<=0) { /* diff_exp>=PREC(a): c does not overlap with a */
+    /* either PREC(b)<=PREC(a), and we can copy the mantissa of b directly 
+       into that of a, or PREC(b)>PREC(a) and we have to round b-c */
+    if (PREC(b)<=PREC(a)+cancel) {
+      if (cancel2) mpn_lshift(ap+(an-bn+cancel1), bp, bn-cancel1, cancel2);
+      else MPN_COPY(ap+(an-bn+cancel1), bp, bn-cancel1);
+      /* fill low significant limbs with zero */
+      MPN_ZERO(ap, an-bn+cancel1);
+      /* now take c into account */
+      if (rnd_mode==GMP_RNDN) { /* to nearest */
+	/* if diff_exp > PREC(a), no change */
+	if (diff_exp==PREC(a)) {
+	  /* if c is not zero, then as it is normalized, we have to subtract
+	     one to the lsb of a if c>1/2, or c=1/2 and lsb(a)=1 (round to
+	     even) */
+	  if (NOTZERO(c)) { /* c is not zero */
+	    /* check whether mant(c)=1/2 or not */
+	    cc = *cp - ((mp_limb_t)1<<(mp_bits_per_limb-1));
+	    if (cc==0) {
+	      bp = cp+(PREC(c)-1)/mp_bits_per_limb;
+	      while (cp<bp && cc==0) cc = *++cp;
+	    }
+	    if (cc || (ap[an-1] & (mp_limb_t)1<<sh)) goto sub_one_ulp;
+	      /* mant(c) > 1/2 or mant(c) = 1/2: subtract 1 iff lsb(a)=1 */
+	  }
+	}
+	else if (ap[an-1]==0) { /* case b=2^n */
+	  ap[an-1] = (mp_limb_t) 1 << (BITS_PER_MP_LIMB-1);
+	  EXP(a)++;
+	}
+      }
+      else if ((ISNONNEG(b) && rnd_mode==GMP_RNDU) || 
+	       (ISNEG(b) && rnd_mode==GMP_RNDD)) {
+	/* round up: nothing to do */
+	if (ap[an-1]==0) { /* case b=2^n */
+	  ap[an-1] = (mp_limb_t) 1 << (BITS_PER_MP_LIMB-1);
+	  EXP(a)++;
+	}
+      }
+      else {
+	/* round down: subtract 1 ulp iff c<>0 */
+	if (NOTZERO(c)) goto sub_one_ulp;
+      }
+    }
+    else { /* PREC(b)>PREC(a) : we have to round b-c */
+      k=bn-an;
+      /* first copy the 'an' most significant limbs of b to a */
+      MPN_COPY(ap, bp+k, an);
+      if (rnd_mode==GMP_RNDN) { /* to nearest */
+	/* first check whether the truncated bits from b are 1/2*lsb(a) */
+	if (sh) {
+	  cc = *ap & (((mp_limb_t)1<<sh)-1);
+	  *ap &= ~cc; /* truncate last bits */
+	  cc -= (mp_limb_t)1<<(sh-1);
+	}
+	else /* no bit to truncate */
+	  cc = bp[--k] - ((mp_limb_t)1<<(mp_bits_per_limb-1));
+	if ((long)cc>0) { /* suppose sizeof(long)=sizeof(mp_limb_t) */
+	  goto add_one_ulp; /* trunc(b)>1/2*lsb(a) -> round up */
+	}
+	else if (cc==0) {
+	  while (k>1 && cc==0) cc=bp[--k];
+	  /* now if the truncated part of b = 1/2*lsb(a), check whether c=0 */
+	  if (NOTZERO(c) || (*ap & ((mp_limb_t)1<<sh))) goto sub_one_ulp;
+	  /* if trunc(b)-c is exactly 1/2*lsb(a) : round to even lsb */
+	}
+	/* if cc<0 : trunc(b) < 1/2*lsb(a) -> round down, i.e. do nothing */
+      }
+      else { /* round towards infinity or zero */
+	if (sh) {
+	  cc = *ap & (((mp_limb_t)1<<sh)-1);
+	  *ap &= ~cc; /* truncate last bits */
+	}
+	else cc=0;
+	cn--;
+        c2 = (dif>-sh) ? cp[cn]>>(mp_bits_per_limb-dif-sh) : 0;
+	while (cc==c2 && (k || cn)) {
+	  if (k) cc = bp[--k];
+	  if (cn) {
+	    c2 = cp[cn]<<(dif+sh);
+	    if (--cn) c2 += cp[cn]>>(mp_bits_per_limb-dif-sh);
+	  }
+	}
+	dif = ((ISNONNEG(b) && rnd_mode==GMP_RNDU) || 
+	       (ISNEG(b) && rnd_mode==GMP_RNDD));
+	/* round towards infinity if dif=1, towards zero otherwise */
+	if (dif && cc>c2) goto add_one_ulp;
+	else if (dif==0 && cc<c2) goto sub_one_ulp;
+      }
+    }
+  }
+  else { /* case 2: diff_exp < PREC(a) : c overlaps with a by dif bits */
+    /* first copy upper part of c into a (after shift) */
+    int overlap;
+    dif += cancel;
+    k = (dif-1)/mp_bits_per_limb + 1; /* only the highest k limbs from c
+					 have to be considered */
+    if (k<an) {
+      MPN_ZERO(ap+k, an-k); /* do it now otherwise ap[k] may be 
+				       destroyed in case dif<0 */
+    }
+#ifdef DEBUG
+    printf("cancel=%d dif=%d k=%d cn=%d sh=%d\n",cancel,dif,k,cn,sh);
+#endif
+    if (dif<=PREC(c)) { /* c has to be truncated */
+      dif = dif % mp_bits_per_limb;
+      dif = (dif) ? mp_bits_per_limb-dif-sh : -sh;
+      /* we have to shift by dif bits to the right */
+      if (dif>0) {
+	mpn_rshift(ap, cp+(cn-k), (k<=an) ? k : an, dif);
+        if (k>an) ap[an-1] += cp[cn-k+an]<<(mp_bits_per_limb-dif);
+      }
+      else if (dif<0) {
+	cc = mpn_lshift(ap, cp+(cn-k), k, -dif);
+	if (k<an) ap[k]=cc;
+	/* put the non-significant bits in low limb for further rounding */
+	if (cn >= k+1)
+	  ap[0] += cp[cn-k-1]>>(mp_bits_per_limb+dif);
+      }
+      else MPN_COPY(ap, cp+(cn-k), k);
+      overlap=1;
+    }
+    else { /* c is not truncated, but we have to fill low limbs with 0 */
+      MPN_ZERO(ap, k-cn);
+      overlap = cancel-diff_exp;
+#ifdef DEBUG
+      printf("0:a="); mpfr_print_raw(a); putchar('\n');
+      printf("overlap=%d\n",overlap);
+#endif
+      if (overlap>=0) {
+	cn -= overlap/mp_bits_per_limb;
+	overlap %= mp_bits_per_limb;
+	/* warning: a shift of zero with mpn_lshift is not allowed */
+	if (overlap) {
+	  if (an<cn) {
+	    mpn_lshift(ap, cp+(cn-an), an, overlap);
+	    ap[0] += cp[cn-an-1]>>(mp_bits_per_limb-overlap);
+	  }
+	  else mpn_lshift(ap+(an-cn), cp, cn, overlap);
+	}
+	else MPN_COPY(ap+(an-cn), cp, cn);
+      }
+      else { /* shift to the right by -overlap bits */
+	overlap = -overlap;
+	k = overlap/mp_bits_per_limb;
+	overlap = overlap % mp_bits_per_limb;
+	if (overlap) cc = mpn_rshift(ap+(an-k-cn), cp, cn, overlap);
+	else {
+	  MPN_COPY(ap+(an-k-cn), cp, cn);
+	  cc = 0;
+	}
+	if (an>k+cn) ap[an-k-cn-1]=cc;
+      }
+      overlap=0;
+    }
+#ifdef DEBUG
+      printf("1:a="); mpfr_print_raw(a); putchar('\n');
+#endif
+    /* here overlap=1 iff ulp(c)<ulp(a) */
+    /* then put high limbs to zero */
+    /* now add 'an' upper limbs of b in place */
+    if (PREC(b)<=PREC(a)+cancel) { int i, imax;
+      overlap += 2;
+      /* invert low limbs */
+      imax = (int)an-(int)bn+cancel1;
+      for (i=0;i<imax;i++) ap[i] = ~ap[i];
+      cc = (i) ? mpn_add_1(ap, ap, i, 1) : 1;
+      mpn_sub_lshift_n(ap+i, bp, bn-cancel1, cancel2, an);
+      mpn_sub_1(ap+i, ap+i, an-i, (mp_limb_t)1-cc);
+    }
+    else /* PREC(b) > PREC(a): we have to truncate b */
+      mpn_sub_lshift_n(ap, bp+(bn-an-cancel1), an, cancel2, an);
+    /* remains to do the rounding */
+#ifdef DEBUG
+      printf("2:a="); mpfr_print_raw(a); putchar('\n');
+      printf("overlap=%d\n",overlap);
+#endif
+    if (rnd_mode==GMP_RNDN) { /* to nearest */
+      int kc;
+      /* four cases: overlap =
+         (0) PREC(b) > PREC(a) and diff_exp+PREC(c) <= PREC(a)
+         (1) PREC(b) > PREC(a) and diff_exp+PREC(c) > PREC(a)
+         (2) PREC(b) <= PREC(a) and diff_exp+PREC(c) <= PREC(a)
+         (3)  PREC(b) <= PREC(a) and diff_exp+PREC(c) > PREC(a) */
+      switch (overlap)
+	{
+        case 1: /* both b and c to round */
+	  kc = cn-k; /* remains kc limbs from c */
+	  k = bn-an; /* remains k limbs from b */
+	  /* truncate last bits and store the difference with 1/2*ulp in cc */
+	  cc = *ap & (((mp_limb_t)1<<sh)-1);
+	  *ap &= ~cc; /* truncate last bits */
+	  cc -= (mp_limb_t)1<<(sh-1);
+	  while ((cc==0 || cc==-1) && k!=0 && kc!=0) {
+	    kc--;
+	    cc -= mpn_sub_1(&c2, bp+(--k), 1, (cp[kc]>>dif) +
+			    (cp[kc+1]<<(mp_bits_per_limb-dif)));
+	    if (cc==0 || cc==-1) cc=c2;
+	  }
+	  if ((long)cc>0) goto add_one_ulp;
+	  else if ((long)cc<-1) goto end_of_sub; /* the carry can be at most 1 */
+	  else if (kc==0) goto round_b;
+	  /* else round c: go through */
+	case 3: /* only c to round */
+	  bp=cp; k=cn-k; goto to_nearest;
+	case 0: /* only b to round */
+        round_b:
+	  k=bn-an; dif=0; goto to_nearest;
+        /* otherwise the result is exact: nothing to do */
+	}
+    }
+    else if ((ISNONNEG(b) && rnd_mode==GMP_RNDU) || 
+	     (ISNEG(b) && rnd_mode==GMP_RNDD)) {
+      cc = *ap & (((mp_limb_t)1<<sh)-1);
+      *ap &= ~cc; /* truncate last bits */
+      if (cc) goto add_one_ulp; /* will happen most of the time */
+      else { /* same four cases too */
+	int kc = cn-k; /* remains kc limbs from c */
+	switch (overlap)
+	{
+        case 1: /* both b and c to round */
+	  k = bn-an; /* remains k limbs from b */
+          dif = diff_exp % mp_bits_per_limb;
+	  while (cc==0 && k!=0 && kc!=0) {
+	    kc--;
+	    cc = bp[--k] - (cp[kc]>>dif);
+	    if (dif) cc -= (cp[kc+1]<<(mp_bits_per_limb-dif));
+	  }
+	  if (cc) goto add_one_ulp;
+	  else if (kc==0) goto round_b2;
+	  /* else round c: go through */
+	case 3: /* only c to round: nothing to do */
+	  /* while (kc) if (cp[--kc]) goto add_one_ulp; */
+	  /* if dif>0 : remains to check last dif bits from c */
+	  /* if (dif>0 && (cp[0]<<(mp_bits_per_limb-dif))) goto add_one_ulp; */
+	  break;
+	case 0: /* only b to round */
+        round_b2:
+	  k=bn-an;
+	  while (k) if (bp[--k]) goto add_one_ulp;
+        /* otherwise the result is exact: nothing to do */
+	}
+      }
+    }
+    /* else round to zero: remove 1 ulp if neglected bits from b-c are < 0 */
+    else {
+      cc = *ap & (((mp_limb_t)1<<sh)-1); 
+      *ap &= ~cc;
+      if (cc==0) { /* otherwise neglected difference cannot be < 0 */
+	/* take into account bp[0]..bp[bn-cancel1-1] shifted by cancel2 to left
+	   and cp[0]..cp[cn-k-1] shifted by dif bits to right */
+	switch (overlap) {
+	case 0:
+	case 2:
+	  break; /* c is not truncated ==> no borrow */
+	case 1: /* both b and c are truncated */
+	  break;
+	case 3: /* only c is truncated */
+	  cn -= k; /* take into account cp[0]..cp[cn-1] shifted by dif bits
+		      to the right */
+	  cc = (dif>0) ? cp[cn]<<(mp_bits_per_limb-dif) : 0;
+	  while (cc==0 && cn>0) cc = cp[--cn];
+          if (cc) goto sub_one_ulp;
+	  break;
+	}
+      }
+    }
+  }
+  goto end_of_sub;
+    
+  to_nearest: /* 0 <= sh < mp_bits_per_limb : number of bits of a to truncate
+                 bp[k] : last significant limb from b */
+#ifdef DEBUG
+mpfr_print_raw(a); putchar('\n');
+#endif
+        if (sh) {
+	  cc = *ap & (((mp_limb_t)1<<sh)-1);
+	  *ap &= ~cc; /* truncate last bits */
+	  c2 = (mp_limb_t)1<<(sh-1);
+	}
+	else /* no bit to truncate */
+	  { if (k) cc = bp[--k]; else cc = 0; c2 = (mp_limb_t)1<<(mp_bits_per_limb-1); }
+#ifdef DEBUG
+	printf("cc=%lu c2=%lu k=%u\n",cc,c2,k);
+#endif
+	if (cc>c2) goto add_one_ulp; /* trunc(b)>1/2*lsb(a) -> round up */
+	else if (cc==c2) {
+	  cc=0; while (k && cc==0) cc=bp[--k];
+#ifdef DEBUG
+	  printf("cc=%lu\n",cc);
+#endif
+	  /* special case of rouding c shifted to the right */
+	  if (cc==0 && dif>0) cc=bp[0]<<(mp_bits_per_limb-dif);
+	  /* now if the truncated part of b = 1/2*lsb(a), check whether c=0 */
+          if (bp!=cp) { 
+	    if (cc || (*ap & ((mp_limb_t)1<<sh))) goto add_one_ulp;
+	  }
+	  else {
+	    /* subtract: if cc>0, do nothing */
+	    if (cc==0 && (*ap & ((mp_limb_t)1<<sh))) goto add_one_ulp;
+	  }
+	}
+        goto end_of_sub;
+
+ sub_one_ulp:
+    cc = mpn_sub_1(ap, ap, an, (mp_limb_t)1<<sh);
+  goto end_of_sub;
+
+  add_one_ulp: /* add one unit in last place to a */
+    cc = mpn_add_1(ap, ap, an, (mp_limb_t)1<<sh);
+
+ end_of_sub:
+#ifdef DEBUG
+printf("b-c="); if (SIGN(a)>0) putchar(' '); mpfr_print_raw(a); putchar('\n');
+#endif
+  TMP_FREE(marker);
+  return;
+}
+
+void 
+#if __STDC__
+mpfr_sub(mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, unsigned char rnd_mode)
+#else
+mpfr_sub(a, b, c, rnd_mode) 
+     mpfr_ptr a; 
+     mpfr_srcptr b;
+     mpfr_srcptr c; 
+     unsigned char rnd_mode;
+#endif
+{
+  int diff_exp;
+
+  if (FLAG_NAN(b) || FLAG_NAN(c)) { SET_NAN(a); return; }
+
+  if (!NOTZERO(b)) { mpfr_neg(a, c, rnd_mode); return; }
+  if (!NOTZERO(c)) { mpfr_set(a, b, rnd_mode); return; }
+
+  diff_exp = EXP(b)-EXP(c);
+  if (SIGN(b) == SIGN(c)) { /* signs are equal, it's a real subtraction */
+    if (diff_exp<0) {
+      /* exchange rounding modes towards +/- infinity */
+      if (rnd_mode==GMP_RNDU) rnd_mode=GMP_RNDD;
+      else if (rnd_mode==GMP_RNDD) rnd_mode=GMP_RNDU;
+      mpfr_sub1(a, c, b, rnd_mode, -diff_exp);
+      CHANGE_SIGN(a);
+    }
+    else if (diff_exp>0) mpfr_sub1(a, b, c, rnd_mode, diff_exp);
+    else { /* diff_exp=0 */
+      diff_exp = mpfr_cmp3(b,c,1);
+      /* if b>0 and diff_exp>0 or b<0 and diff_exp<0: abs(b) > abs(c) */
+      if (diff_exp==0) SET_ZERO(a);
+      else if (diff_exp*SIGN(b)>0) mpfr_sub1(a, b, c, rnd_mode, 0);
+      else { 
+	/* exchange rounding modes towards +/- infinity */
+	if (rnd_mode==GMP_RNDU) rnd_mode=GMP_RNDD;
+	else if (rnd_mode==GMP_RNDD) rnd_mode=GMP_RNDU;
+	mpfr_sub1(a, c, b, rnd_mode, 0); 
+	CHANGE_SIGN(a); 
+      }
+    }
+  }
+  else /* signs differ, it's an addition */
+    if (diff_exp<0) {
+      /* exchange rounding modes towards +/- infinity */
+      if (rnd_mode==GMP_RNDU) rnd_mode=GMP_RNDD;
+      else if (rnd_mode==GMP_RNDD) rnd_mode=GMP_RNDU;
+      mpfr_add1(a, c, b, rnd_mode, -diff_exp);
+      CHANGE_SIGN(a); 
+    }
+    else mpfr_add1(a, b, c, rnd_mode, diff_exp);
+}
+
diff --git a/src/gmp/mpfr/tests/Makefile.am b/src/gmp/mpfr/tests/Makefile.am
new file mode 100644
index 000000000..c86cbf314
--- /dev/null
+++ b/src/gmp/mpfr/tests/Makefile.am
@@ -0,0 +1,37 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Library General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Library General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+INCLUDES = -I$(top_srcdir) -I$(top_srcdir)/mpfr
+LDADD = $(top_builddir)/libgmp.la
+dummy_LDADD = 
+
+if WANT_MPFR
+# FIXME: The following tests need mpfr_set_machine_rnd_mode() which is not 
+# built right now:
+# tadd tget_str tset_f tsqrt tagm tmul tdiv tlog texp tdiv_ui tout_str
+MPBSD_check_OPTION = tcmp2 tmul_ui tcmp_ui tround tset_si tcmp tmul_2exp \
+  tset_d tset_str tpi tset_z tlog2 tcan_round tzeta
+endif
+
+check_PROGRAMS = dummy $(MPBSD_check_OPTION)
+TESTS = $(check_PROGRAMS)
diff --git a/src/gmp/mpfr/tests/Makefile.in b/src/gmp/mpfr/tests/Makefile.in
new file mode 100644
index 000000000..e1e655895
--- /dev/null
+++ b/src/gmp/mpfr/tests/Makefile.in
@@ -0,0 +1,525 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Library General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Library General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+INCLUDES = -I$(top_srcdir) -I$(top_srcdir)/mpfr
+LDADD = $(top_builddir)/libgmp.la
+dummy_LDADD = 
+
+# FIXME: The following tests need mpfr_set_machine_rnd_mode() which is not 
+# built right now:
+# tadd tget_str tset_f tsqrt tagm tmul tdiv tlog texp tdiv_ui tout_str
+@WANT_MPFR_TRUE@MPBSD_check_OPTION = @WANT_MPFR_TRUE@tcmp2 tmul_ui tcmp_ui tround tset_si tcmp tmul_2exp \
+@WANT_MPFR_TRUE@  tset_d tset_str tpi tset_z tlog2 tcan_round tzeta
+
+check_PROGRAMS = dummy $(MPBSD_check_OPTION)
+TESTS = $(check_PROGRAMS)
+subdir = mpfr/tests
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../../config.h
+CONFIG_CLEAN_FILES = 
+@WANT_MPFR_FALSE@check_PROGRAMS =  dummy$(EXEEXT)
+@WANT_MPFR_TRUE@check_PROGRAMS =  dummy$(EXEEXT) tcmp2$(EXEEXT) \
+@WANT_MPFR_TRUE@tmul_ui$(EXEEXT) tcmp_ui$(EXEEXT) tround$(EXEEXT) \
+@WANT_MPFR_TRUE@tset_si$(EXEEXT) tcmp$(EXEEXT) tmul_2exp$(EXEEXT) \
+@WANT_MPFR_TRUE@tset_d$(EXEEXT) tset_str$(EXEEXT) tpi$(EXEEXT) \
+@WANT_MPFR_TRUE@tset_z$(EXEEXT) tlog2$(EXEEXT) tcan_round$(EXEEXT) \
+@WANT_MPFR_TRUE@tzeta$(EXEEXT)
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I../..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+dummy_SOURCES = dummy.c
+dummy_OBJECTS =  dummy.$(OBJEXT)
+dummy_DEPENDENCIES = 
+dummy_LDFLAGS = 
+tcan_round_SOURCES = tcan_round.c
+tcan_round_OBJECTS =  tcan_round.$(OBJEXT)
+tcan_round_LDADD = $(LDADD)
+tcan_round_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tcan_round_LDFLAGS = 
+tcmp_SOURCES = tcmp.c
+tcmp_OBJECTS =  tcmp.$(OBJEXT)
+tcmp_LDADD = $(LDADD)
+tcmp_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tcmp_LDFLAGS = 
+tcmp2_SOURCES = tcmp2.c
+tcmp2_OBJECTS =  tcmp2.$(OBJEXT)
+tcmp2_LDADD = $(LDADD)
+tcmp2_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tcmp2_LDFLAGS = 
+tcmp_ui_SOURCES = tcmp_ui.c
+tcmp_ui_OBJECTS =  tcmp_ui.$(OBJEXT)
+tcmp_ui_LDADD = $(LDADD)
+tcmp_ui_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tcmp_ui_LDFLAGS = 
+tlog2_SOURCES = tlog2.c
+tlog2_OBJECTS =  tlog2.$(OBJEXT)
+tlog2_LDADD = $(LDADD)
+tlog2_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tlog2_LDFLAGS = 
+tmul_2exp_SOURCES = tmul_2exp.c
+tmul_2exp_OBJECTS =  tmul_2exp.$(OBJEXT)
+tmul_2exp_LDADD = $(LDADD)
+tmul_2exp_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tmul_2exp_LDFLAGS = 
+tmul_ui_SOURCES = tmul_ui.c
+tmul_ui_OBJECTS =  tmul_ui.$(OBJEXT)
+tmul_ui_LDADD = $(LDADD)
+tmul_ui_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tmul_ui_LDFLAGS = 
+tpi_SOURCES = tpi.c
+tpi_OBJECTS =  tpi.$(OBJEXT)
+tpi_LDADD = $(LDADD)
+tpi_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tpi_LDFLAGS = 
+tround_SOURCES = tround.c
+tround_OBJECTS =  tround.$(OBJEXT)
+tround_LDADD = $(LDADD)
+tround_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tround_LDFLAGS = 
+tset_d_SOURCES = tset_d.c
+tset_d_OBJECTS =  tset_d.$(OBJEXT)
+tset_d_LDADD = $(LDADD)
+tset_d_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tset_d_LDFLAGS = 
+tset_si_SOURCES = tset_si.c
+tset_si_OBJECTS =  tset_si.$(OBJEXT)
+tset_si_LDADD = $(LDADD)
+tset_si_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tset_si_LDFLAGS = 
+tset_str_SOURCES = tset_str.c
+tset_str_OBJECTS =  tset_str.$(OBJEXT)
+tset_str_LDADD = $(LDADD)
+tset_str_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tset_str_LDFLAGS = 
+tset_z_SOURCES = tset_z.c
+tset_z_OBJECTS =  tset_z.$(OBJEXT)
+tset_z_LDADD = $(LDADD)
+tset_z_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tset_z_LDFLAGS = 
+tzeta_SOURCES = tzeta.c
+tzeta_OBJECTS =  tzeta.$(OBJEXT)
+tzeta_LDADD = $(LDADD)
+tzeta_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tzeta_LDFLAGS = 
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  dummy.c tcan_round.c tcmp.c tcmp2.c tcmp_ui.c tlog2.c \
+tmul_2exp.c tmul_ui.c tpi.c tround.c tset_d.c tset_si.c tset_str.c \
+tset_z.c tzeta.c
+DIST_COMMON =  Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = dummy.c tcan_round.c tcmp.c tcmp2.c tcmp_ui.c tlog2.c tmul_2exp.c tmul_ui.c tpi.c tround.c tset_d.c tset_si.c tset_str.c tset_z.c tzeta.c
+OBJECTS = dummy.$(OBJEXT) tcan_round.$(OBJEXT) tcmp.$(OBJEXT) tcmp2.$(OBJEXT) tcmp_ui.$(OBJEXT) tlog2.$(OBJEXT) tmul_2exp.$(OBJEXT) tmul_ui.$(OBJEXT) tpi.$(OBJEXT) tround.$(OBJEXT) tset_d.$(OBJEXT) tset_si.$(OBJEXT) tset_str.$(OBJEXT) tset_z.$(OBJEXT) tzeta.$(OBJEXT)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpfr/tests/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-checkPROGRAMS:
+
+clean-checkPROGRAMS:
+	-test -z "$(check_PROGRAMS)" || rm -f $(check_PROGRAMS)
+
+distclean-checkPROGRAMS:
+
+maintainer-clean-checkPROGRAMS:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+
+dummy$(EXEEXT): $(dummy_OBJECTS) $(dummy_DEPENDENCIES)
+	@rm -f dummy$(EXEEXT)
+	$(LINK) $(dummy_LDFLAGS) $(dummy_OBJECTS) $(dummy_LDADD) $(LIBS)
+
+tcan_round$(EXEEXT): $(tcan_round_OBJECTS) $(tcan_round_DEPENDENCIES)
+	@rm -f tcan_round$(EXEEXT)
+	$(LINK) $(tcan_round_LDFLAGS) $(tcan_round_OBJECTS) $(tcan_round_LDADD) $(LIBS)
+
+tcmp$(EXEEXT): $(tcmp_OBJECTS) $(tcmp_DEPENDENCIES)
+	@rm -f tcmp$(EXEEXT)
+	$(LINK) $(tcmp_LDFLAGS) $(tcmp_OBJECTS) $(tcmp_LDADD) $(LIBS)
+
+tcmp2$(EXEEXT): $(tcmp2_OBJECTS) $(tcmp2_DEPENDENCIES)
+	@rm -f tcmp2$(EXEEXT)
+	$(LINK) $(tcmp2_LDFLAGS) $(tcmp2_OBJECTS) $(tcmp2_LDADD) $(LIBS)
+
+tcmp_ui$(EXEEXT): $(tcmp_ui_OBJECTS) $(tcmp_ui_DEPENDENCIES)
+	@rm -f tcmp_ui$(EXEEXT)
+	$(LINK) $(tcmp_ui_LDFLAGS) $(tcmp_ui_OBJECTS) $(tcmp_ui_LDADD) $(LIBS)
+
+tlog2$(EXEEXT): $(tlog2_OBJECTS) $(tlog2_DEPENDENCIES)
+	@rm -f tlog2$(EXEEXT)
+	$(LINK) $(tlog2_LDFLAGS) $(tlog2_OBJECTS) $(tlog2_LDADD) $(LIBS)
+
+tmul_2exp$(EXEEXT): $(tmul_2exp_OBJECTS) $(tmul_2exp_DEPENDENCIES)
+	@rm -f tmul_2exp$(EXEEXT)
+	$(LINK) $(tmul_2exp_LDFLAGS) $(tmul_2exp_OBJECTS) $(tmul_2exp_LDADD) $(LIBS)
+
+tmul_ui$(EXEEXT): $(tmul_ui_OBJECTS) $(tmul_ui_DEPENDENCIES)
+	@rm -f tmul_ui$(EXEEXT)
+	$(LINK) $(tmul_ui_LDFLAGS) $(tmul_ui_OBJECTS) $(tmul_ui_LDADD) $(LIBS)
+
+tpi$(EXEEXT): $(tpi_OBJECTS) $(tpi_DEPENDENCIES)
+	@rm -f tpi$(EXEEXT)
+	$(LINK) $(tpi_LDFLAGS) $(tpi_OBJECTS) $(tpi_LDADD) $(LIBS)
+
+tround$(EXEEXT): $(tround_OBJECTS) $(tround_DEPENDENCIES)
+	@rm -f tround$(EXEEXT)
+	$(LINK) $(tround_LDFLAGS) $(tround_OBJECTS) $(tround_LDADD) $(LIBS)
+
+tset_d$(EXEEXT): $(tset_d_OBJECTS) $(tset_d_DEPENDENCIES)
+	@rm -f tset_d$(EXEEXT)
+	$(LINK) $(tset_d_LDFLAGS) $(tset_d_OBJECTS) $(tset_d_LDADD) $(LIBS)
+
+tset_si$(EXEEXT): $(tset_si_OBJECTS) $(tset_si_DEPENDENCIES)
+	@rm -f tset_si$(EXEEXT)
+	$(LINK) $(tset_si_LDFLAGS) $(tset_si_OBJECTS) $(tset_si_LDADD) $(LIBS)
+
+tset_str$(EXEEXT): $(tset_str_OBJECTS) $(tset_str_DEPENDENCIES)
+	@rm -f tset_str$(EXEEXT)
+	$(LINK) $(tset_str_LDFLAGS) $(tset_str_OBJECTS) $(tset_str_LDADD) $(LIBS)
+
+tset_z$(EXEEXT): $(tset_z_OBJECTS) $(tset_z_DEPENDENCIES)
+	@rm -f tset_z$(EXEEXT)
+	$(LINK) $(tset_z_LDFLAGS) $(tset_z_OBJECTS) $(tset_z_LDADD) $(LIBS)
+
+tzeta$(EXEEXT): $(tzeta_OBJECTS) $(tzeta_DEPENDENCIES)
+	@rm -f tzeta$(EXEEXT)
+	$(LINK) $(tzeta_LDFLAGS) $(tzeta_OBJECTS) $(tzeta_LDADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+check-TESTS: $(TESTS)
+	@failed=0; all=0; xfail=0; xpass=0; \
+	srcdir=$(srcdir); export srcdir; \
+	for tst in $(TESTS); do \
+	  if test -f ./$$tst; then dir=./; \
+	  elif test -f $$tst; then dir=; \
+	  else dir="$(srcdir)/"; fi; \
+	  if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xpass=`expr $$xpass + 1`; \
+	      failed=`expr $$failed + 1`; \
+	      echo "XPASS: $$tst"; \
+	    ;; \
+	    *) \
+	      echo "PASS: $$tst"; \
+	    ;; \
+	    esac; \
+	  elif test $$? -ne 77; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xfail=`expr $$xfail + 1`; \
+	      echo "XFAIL: $$tst"; \
+	    ;; \
+	    *) \
+	      failed=`expr $$failed + 1`; \
+	      echo "FAIL: $$tst"; \
+	    ;; \
+	    esac; \
+	  fi; \
+	done; \
+	if test "$$failed" -eq 0; then \
+	  if test "$$xfail" -eq 0; then \
+	    banner="All $$all tests passed"; \
+	  else \
+	    banner="All $$all tests behaved as expected ($$xfail expected failures)"; \
+	  fi; \
+	else \
+	  if test "$$xpass" -eq 0; then \
+	    banner="$$failed of $$all tests failed"; \
+	  else \
+	    banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \
+	  fi; \
+	fi; \
+	dashes=`echo "$$banner" | sed s/./=/g`; \
+	echo "$$dashes"; \
+	echo "$$banner"; \
+	echo "$$dashes"; \
+	test "$$failed" -eq 0
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am: all-am
+	$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
+	$(MAKE) $(AM_MAKEFLAGS) check-TESTS
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am:
+install-data: install-data-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am:
+uninstall: uninstall-am
+all-am: Makefile
+all-redirect: all-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs:
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-checkPROGRAMS mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am:  clean-checkPROGRAMS clean-compile clean-libtool clean-tags \
+		clean-generic mostlyclean-am
+
+clean: clean-am
+
+distclean-am:  distclean-checkPROGRAMS distclean-compile \
+		distclean-libtool distclean-tags distclean-generic \
+		clean-am
+	-rm -f libtool
+
+distclean: distclean-am
+
+maintainer-clean-am:  maintainer-clean-checkPROGRAMS \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-checkPROGRAMS distclean-checkPROGRAMS \
+clean-checkPROGRAMS maintainer-clean-checkPROGRAMS mostlyclean-compile \
+distclean-compile clean-compile maintainer-clean-compile \
+mostlyclean-libtool distclean-libtool clean-libtool \
+maintainer-clean-libtool tags mostlyclean-tags distclean-tags \
+clean-tags maintainer-clean-tags distdir check-TESTS info-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+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/src/gmp/mpfr/tests/dummy.c b/src/gmp/mpfr/tests/dummy.c
new file mode 100644
index 000000000..fd8c4d3c5
--- /dev/null
+++ b/src/gmp/mpfr/tests/dummy.c
@@ -0,0 +1,28 @@
+/* A dummy do-nothing test program, which always passes. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+int
+main ()
+{
+  exit (0);
+}
diff --git a/src/gmp/mpfr/tests/tcan_round.c b/src/gmp/mpfr/tests/tcan_round.c
new file mode 100644
index 000000000..7e452ab80
--- /dev/null
+++ b/src/gmp/mpfr/tests/tcan_round.c
@@ -0,0 +1,40 @@
+/* Test file for mpfr_can_round.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "gmp.h"
+#include "mpfr.h"
+
+int main()
+{
+   mpfr_t x;
+
+   /* checks that rounds to nearest sets the last
+     bit to zero in case of equal distance */
+   mpfr_init2(x, 59);
+   mpfr_set_str_raw(x, "-0.10010001010111000011110010111010111110000000111101100111111E663"); 
+   if (mpfr_can_round(x, 54, GMP_RNDZ, GMP_RNDZ, 53) != 0) {
+     fprintf(stderr, "Error in mpfr_can_round\n"); exit(1);
+   }
+   mpfr_clear(x);
+   exit (0);
+}
diff --git a/src/gmp/mpfr/tests/tcmp.c b/src/gmp/mpfr/tests/tcmp.c
new file mode 100644
index 000000000..0f063c235
--- /dev/null
+++ b/src/gmp/mpfr/tests/tcmp.c
@@ -0,0 +1,73 @@
+/* Test file for mpfr_cmp.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "gmp.h"
+#include "longlong.h"
+#include "mpfr.h"
+#include "mpfr-impl.h"
+
+int
+main()
+{
+  double x,y; mpfr_t xx,yy; int i,c;
+
+  fprintf(stderr, "Test case 'tcmp' disabled\n"); 
+  exit(0);			/* THIS TEST CASE IS NOT WORKING */
+
+  mpfr_init2(xx, 65); mpfr_init2(yy, 65);
+  mpfr_set_str_raw(xx, "0.10011010101000110101010000000011001001001110001011101011111011101E623");
+  mpfr_set_str_raw(yy, "0.10011010101000110101010000000011001001001110001011101011111011100E623");
+  if (mpfr_cmp2(xx,yy)!=64) { printf("Error (1) in mpfr_cmp\n"); exit(1); }
+  mpfr_set_str_raw(xx, "0.10100010001110110111000010001000010011111101000100011101000011100");
+  mpfr_set_str_raw(yy, "0.10100010001110110111000010001000010011111101000100011101000011011");
+  if (mpfr_cmp2(xx,yy)!=64) { printf("Error (1) in mpfr_cmp\n"); exit(1); }
+  mpfr_set_prec(xx,53); mpfr_set_prec(yy,200);
+  mpfr_set_d(xx, 1.0, 0);
+  mpfr_set_d(yy, 1.0, 0);
+  if (mpfr_cmp(xx,yy)!=0) {
+    printf("Error in mpfr_cmp: 1.0 != 1.0\n"); exit(1);
+  }
+  mpfr_set_prec(yy, 31);
+  mpfr_set_d(xx, 1.0000000002, 0);
+  mpfr_set_d(yy, 1.0, 0);
+  if (!(mpfr_cmp(xx,yy)>0)) {
+    printf("Error in mpfr_cmp: not 1.0000000002 > 1.0\n"); exit(1);
+  }
+  mpfr_set_prec(yy, 53);
+  for (i=0;i<1000000;) {    
+    x=drand(); y=drand();
+    if (!isnan(x) && !isnan(y)) {
+      i++;
+      mpfr_set_d(xx, x, 0);
+      mpfr_set_d(yy, y, 0);
+      c = mpfr_cmp(xx,yy);
+      if ((c>0 && x<=y) || (c==0 && x!=y) || (c<0 && x>=y)) {
+	printf("Error in mpfr_cmp with x=%1.20e, y=%1.20e mpfr_cmp(x,y)=%d\n",
+	       x,y,c); exit(1);
+      }
+    }
+  }
+  mpfr_clear(xx); mpfr_clear(yy);
+  exit (0);
+}
diff --git a/src/gmp/mpfr/tests/tcmp2.c b/src/gmp/mpfr/tests/tcmp2.c
new file mode 100644
index 000000000..f7e3f3599
--- /dev/null
+++ b/src/gmp/mpfr/tests/tcmp2.c
@@ -0,0 +1,88 @@
+/* Test file for mpfr_cmp2.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "gmp.h"
+#include "longlong.h"
+#include "mpfr.h"
+#include "mpfr-impl.h"
+#ifdef IRIX64
+#include <sys/fpu.h>
+#endif
+
+extern int isnan();
+
+void tcmp2(x, y, i) double x, y; int i;
+{
+  mpfr_t xx,yy; int j;
+
+  if (i==-1) {
+    if (x==y) i=53;
+    else i = (int) floor(log(x)/log(2.0)) - (int) floor(log(x-y)/log(2.0));
+  }
+  mpfr_init2(xx, 53); mpfr_init2(yy, 53);
+  mpfr_set_d(xx, x, 0);
+  mpfr_set_d(yy, y, 0);
+  if ((j=mpfr_cmp2(xx, yy)) != i) {
+    printf("Error in mpfr_cmp2: x=%1.20e y=%1.20e mpfr_cmp2(x,y)=%d instead of %d\n",x,y,j,i); 
+    exit(1);
+  }
+  mpfr_set_prec(xx, 127); mpfr_set_prec(yy, 127);
+  mpfr_set_str_raw(xx, "0.1011010000110111111000000101011110110001000101101011011110010010011110010000101101000010011001100110010000000010110000101000101E6");
+  mpfr_set_str_raw(yy, "0.1011010000110111111000000101011011111100011101000011001111000010100010100110110100110010011001100110010000110010010110000010110E6");
+  if ((j=mpfr_cmp2(xx, yy)) != 32) {
+    printf("Error in mpfr_cmp2:\n");
+    printf("x="); mpfr_print_raw(xx); putchar('\n');
+    printf("y="); mpfr_print_raw(yy); putchar('\n');
+    printf("got %d, expected 32\n", j);
+    exit(1);
+  }
+  mpfr_clear(xx); mpfr_clear(yy);
+}
+
+int main()
+{
+  int i,j; double x=1.0, y, z;
+#ifdef IRIX64
+    /* to get denormalized numbers on IRIX64 */
+    union fpc_csr exp;
+    exp.fc_word = get_fpc_csr();
+    exp.fc_struct.flush = 0;
+    set_fpc_csr(exp.fc_word);
+#endif
+
+  tcmp2(1.06022698059744327881e+71, 1.05824655795525779205e+71, -1);
+  tcmp2(1.0, 1.0, 53);
+  for (i=0;i<54;i++) {
+    tcmp2(1.0, 1.0-x, i);
+    x /= 2.0;
+  }
+  for (j=0;j<1000000;j++) {
+    x = drand48();
+    y = drand48();
+    if (x<y) { z=x; x=y; y=z; }
+    if (y != 0.0 && y != -0.0) tcmp2(x, y, -1);
+  }
+  exit (0);
+}
+
diff --git a/src/gmp/mpfr/tests/tcmp_ui.c b/src/gmp/mpfr/tests/tcmp_ui.c
new file mode 100644
index 000000000..61410edd0
--- /dev/null
+++ b/src/gmp/mpfr/tests/tcmp_ui.c
@@ -0,0 +1,58 @@
+/* Test file for mpfr_cmp_ui.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "gmp.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+int
+main()
+{
+  mpfr_t x; unsigned long i; long s;
+  
+  mpfr_init(x);
+
+  mpfr_set_ui(x, 3, GMP_RNDZ);
+  if (mpfr_cmp_ui(x, i=3)!=0) {
+    printf("Error in mpfr_cmp_ui(%1.20f,%d)\n",mpfr_get_d(x), i); exit(1);
+  }
+  if (mpfr_cmp_ui(x, i=2)<=0) {
+    printf("Error in mpfr_cmp_ui(%1.20f,%d)\n",mpfr_get_d(x), i); exit(1);
+  }
+  if (mpfr_cmp_ui(x, i=4)>=0) {
+    printf("Error in mpfr_cmp_ui(%1.20f,%d)\n",mpfr_get_d(x), i); exit(1);
+  }
+
+  mpfr_set_si(x, -3, GMP_RNDZ);
+  if (mpfr_cmp_si(x, s=-3)!=0) {
+    printf("Error in mpfr_cmp_si(%1.20f,%d)\n",mpfr_get_d(x), s); exit(1);
+  }
+  if (mpfr_cmp_si(x, s=-4)<=0) {
+    printf("Error in mpfr_cmp_si(%1.20f,%d)\n",mpfr_get_d(x), s); exit(1);
+  }
+  if (mpfr_cmp_si(x, s=1)>=0) {
+    printf("Error in mpfr_cmp_si(%1.20f,%d)\n",mpfr_get_d(x), s); exit(1);
+  }
+  exit (0);
+}
diff --git a/src/gmp/mpfr/tests/tlog2.c b/src/gmp/mpfr/tests/tlog2.c
new file mode 100644
index 000000000..0ba296a83
--- /dev/null
+++ b/src/gmp/mpfr/tests/tlog2.c
@@ -0,0 +1,44 @@
+/* Test file for mpfr_log2.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdlib.h>
+#include "gmp.h"
+#include "mpfr.h"
+
+/* tlog2 [prec] [rnd] [0 = no print] */
+
+int main(argc, argv) int argc; char *argv[];
+{
+  mpfr_t x; int p; unsigned char rnd;
+
+  p = (argc>1) ? atoi(argv[1]) : 53;
+  rnd = (argc>2) ? atoi(argv[2]) : GMP_RNDZ;
+  mpfr_init2(x, p);
+  mpfr_log2(x, rnd);
+  if (argc>=2) {
+    printf("log(2)="); mpfr_out_str(stdout, 10, 0, x, rnd); putchar('\n');
+  }
+  else if (mpfr_get_d(x) != 6.9314718055994530941e-1)  {
+    fprintf(stderr, "mpfr_log2 failed for prec=53\n"); exit(1);
+  }
+  mpfr_clear(x);
+  exit (0);
+}
diff --git a/src/gmp/mpfr/tests/tmul_2exp.c b/src/gmp/mpfr/tests/tmul_2exp.c
new file mode 100644
index 000000000..c47031313
--- /dev/null
+++ b/src/gmp/mpfr/tests/tmul_2exp.c
@@ -0,0 +1,49 @@
+/* Test file for mpfr_mul_2exp.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+#include "gmp.h"
+#include "mpfr.h"
+
+/* checks that x*y gives the same results in double
+   and with mpfr with 53 bits of precision */
+
+int
+main(argc,argv) int argc; char *argv[];
+{
+  double x, z; mpfr_t w;
+
+  mpfr_init2(w, 53); 
+
+  srand48(time(NULL)); 
+  x = drand48(); 
+  mpfr_set_d(w, x, 0);
+  mpfr_mul_2exp(w, w, 10, GMP_RNDZ); 
+  if (x != (z = mpfr_get_d(w)/1024))
+    {
+      fprintf(stderr, "%f != %f\n", x, z); 
+      exit (1); 
+    }
+  exit (0); 
+}
+
diff --git a/src/gmp/mpfr/tests/tmul_ui.c b/src/gmp/mpfr/tests/tmul_ui.c
new file mode 100644
index 000000000..fab7d50fd
--- /dev/null
+++ b/src/gmp/mpfr/tests/tmul_ui.c
@@ -0,0 +1,66 @@
+/* Test file for mpfr_mul_ui.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "mpfr.h"
+#include "time.h"
+
+int
+main(int argc, char **argv)
+{
+  mpfr_t x, y;
+  
+  mpfr_init2(x, 53); mpfr_init2(y, 53);
+
+  /* checks that result is normalized */
+  mpfr_set_d(y, 6.93147180559945286227e-01, GMP_RNDZ);
+  mpfr_mul_ui(x, y, 1, GMP_RNDZ);
+  if (MANT(x)[PREC(x)/BITS_PER_MP_LIMB] >> (BITS_PER_MP_LIMB-1) == 0) {
+    fprintf(stderr, "Error in mpfr_mul_ui: result not normalized\n");
+    exit(1);
+  }
+  if (mpfr_cmp(x,y)) {
+    fprintf(stderr, "Error in mpfr_mul_ui: 1*y != y\n");
+    printf("y=  "); mpfr_print_raw(y); putchar('\n');
+    printf("1*y="); mpfr_print_raw(x); putchar('\n');
+    exit(1);
+  }
+
+  mpfr_set_d(x, 1.0/3.0, GMP_RNDZ); 
+  mpfr_mul_ui(x, x, 3, GMP_RNDU); 
+  if (mpfr_get_d(x) != 1.0) {
+    fprintf(stderr, "Error in mpfr_mul_ui: U(Z(1/3)*3) does not give 1\n"); exit(1);
+  }
+
+  /* checks sign is correct */
+  mpfr_set_d(x, -2.0, GMP_RNDZ);
+  mpfr_set_d(y, 3.0, GMP_RNDZ);
+  mpfr_mul_ui(x, y, 4, GMP_RNDZ);
+  if (SIGN(x) != 1) {
+    fprintf(stderr, "Error in mpfr_mul_ui: 4*3.0 does not give a positive result\n"); exit(1);
+  }
+
+  mpfr_clear(x); mpfr_clear(y);
+  exit (0);
+}
diff --git a/src/gmp/mpfr/tests/tpi.c b/src/gmp/mpfr/tests/tpi.c
new file mode 100644
index 000000000..487983c5f
--- /dev/null
+++ b/src/gmp/mpfr/tests/tpi.c
@@ -0,0 +1,44 @@
+/* Test file for mpfr_pi.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdlib.h>
+#include "gmp.h"
+#include "mpfr.h"
+
+/* tpi [prec] [rnd] [0 = no print] */
+
+int main(argc, argv) int argc; char *argv[];
+{
+  mpfr_t x; int p; unsigned char rnd;
+
+  p = (argc>1) ? atoi(argv[1]) : 53;
+  rnd = (argc>2) ? atoi(argv[2]) : GMP_RNDZ;
+  mpfr_init2(x, p);
+  mpfr_pi(x, rnd);
+  if (argc>=2) {
+    printf("Pi="); mpfr_out_str(stdout, 10, 0, x, rnd); putchar('\n');
+  }
+  else if (mpfr_get_d(x) != 3.141592653589793116) {
+    fprintf(stderr, "mpfr_pi failed for prec=53\n"); exit(1);
+  }
+  mpfr_clear(x);
+  exit (0);
+}
diff --git a/src/gmp/mpfr/tests/tround.c b/src/gmp/mpfr/tests/tround.c
new file mode 100644
index 000000000..3ccd6ff7f
--- /dev/null
+++ b/src/gmp/mpfr/tests/tround.c
@@ -0,0 +1,45 @@
+/* Test file for mpfr_round.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "gmp.h"
+#include "mpfr.h"
+
+int
+main()
+{
+   mpfr_t x;
+
+   /* checks that rounds to nearest sets the last
+     bit to zero in case of equal distance */
+   mpfr_init2(x, 2);
+   mpfr_set_d(x, 5.0, 0);
+   if (mpfr_get_d(x) != 4.0) { printf("Error in tround: got %1.1f instead of 4.0\n",mpfr_get_d(x)); }
+
+   mpfr_set_d(x, 0.00098539467465030839, 0);
+
+   mpfr_set_d(x, 9.84891017624509146344e-01, GMP_RNDU); 
+   if (mpfr_get_d(x) != 1.0) { printf("Error in tround: got %f instead of 1.0\n",mpfr_get_d(x)); exit(1); }
+
+   mpfr_clear(x);
+   exit (0);
+}
diff --git a/src/gmp/mpfr/tests/tset_d.c b/src/gmp/mpfr/tests/tset_d.c
new file mode 100644
index 000000000..c542dc1e2
--- /dev/null
+++ b/src/gmp/mpfr/tests/tset_d.c
@@ -0,0 +1,90 @@
+/* Test file for mpfr_set_d and mpfr_get_d.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+#ifdef IRIX64
+#include <sys/fpu.h>
+#endif
+#include "gmp.h"
+#include "mpfr.h"
+#include "mpfr-impl.h"
+
+extern int isnan();
+
+int
+main(int argc, char **argv)
+{
+  fprintf(stderr, "Test case tset_d disabled\n"); 
+  exit(0);			/* THIS TEST CASE IS NOT WORKING */
+
+#if 0
+  mpfr_t x,y,z; unsigned long k,n; double d, dd;
+#ifdef IRIX64
+    /* to get denormalized numbers on IRIX64 */
+    union fpc_csr exp;
+    exp.fc_word = get_fpc_csr();
+    exp.fc_struct.flush = 0;
+    set_fpc_csr(exp.fc_word);
+#endif
+
+  mpfr_init2(z, 32);
+  mpfr_set_d(z, 1.0, 0);
+  if (mpfr_get_d(z) != 1.0) {
+    mpfr_print_raw(z); putchar('\n');
+    printf("Error: 1.0 != 1.0\n"); exit(1);
+  }
+  mpfr_init2(x, 53); mpfr_init2(y, 53);
+  mpfr_set_d(x, d=-1.08007920352320089721e+150, 0);
+  if (mpfr_get_d(x) != d) {
+    mpfr_print_raw(x); putchar('\n');
+    printf("Error: get_d o set_d <> identity for d = %1.20e %1.20e\n",d,
+	   mpfr_get_d(x)); exit(1);
+  }
+  srand48(time(NULL)); 
+  mpfr_set_d(x, 8.06294740693074521573e-310, 0); 
+  d = -6.72658901114033715233e-165;
+  mpfr_set_d(x, d, 0);
+  if (d != mpfr_get_d(x)) {
+    mpfr_print_raw(x); putchar('\n');
+    printf("Error: get_d o set_d <> identity for d = %1.20e %1.20e\n",d,
+	   mpfr_get_d(x)); exit(1);
+  }
+  n = (argc==1) ? 1000000 : atoi(argv[1]);
+  for (k = 1; k <= n; k++)
+    {      
+      d = drand();
+      mpfr_set_d(x, d, 0); 
+      dd = mpfr_get_d(x);
+      if (d != dd && (!isnan(d) || !isnan(dd)))
+	{ 
+	  fprintf(stderr, 
+		  "Mismatch on : %1.18g != %1.18g\n", d, mpfr_get_d(x)); 
+	  mpfr_print_raw(x); putchar('\n');
+	} 
+    }
+
+  mpfr_clear(x); mpfr_clear(y); mpfr_clear(z);
+  exit (0); 
+#endif /* 0 */
+}
+
diff --git a/src/gmp/mpfr/tests/tset_si.c b/src/gmp/mpfr/tests/tset_si.c
new file mode 100644
index 000000000..db4e73ac7
--- /dev/null
+++ b/src/gmp/mpfr/tests/tset_si.c
@@ -0,0 +1,65 @@
+/* Test file for mpfr_set_si and mpfr_set_ui.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "gmp.h"
+#include "mpfr.h"
+#include "time.h"
+
+int
+main(int argc, char **argv)
+{
+  mpfr_t x; long k, z, d; unsigned long zl, dl, N; 
+  
+  mpfr_init2(x, 100);
+
+  srandom(time(NULL)); 
+
+  N = (argc==1) ? 1000000 : atoi(argv[1]);
+
+  for (k = 1; k <= N; k++)
+    {
+      z = random() - (1 << 30);      
+      mpfr_set_si(x, z, GMP_RNDZ); 
+      d = (int)mpfr_get_d(x);
+      if (d != z)
+	{
+	  fprintf(stderr, "Expected %ld got %ld\n", z, d);
+	  exit(1);
+	}
+    }
+
+  for (k = 1; k <= N; k++)
+    {
+      zl = random();
+      mpfr_set_ui(x, zl, GMP_RNDZ); 
+      dl = (unsigned int) mpfr_get_d(x);
+      if (dl != zl)
+	{
+	  fprintf(stderr, "Expected %lu got %lu\n", zl, dl);
+	  exit(1);
+	}
+    }
+
+  mpfr_clear(x); 
+  exit (0);
+}
diff --git a/src/gmp/mpfr/tests/tset_str.c b/src/gmp/mpfr/tests/tset_str.c
new file mode 100644
index 000000000..a1cd3000d
--- /dev/null
+++ b/src/gmp/mpfr/tests/tset_str.c
@@ -0,0 +1,87 @@
+/* Test file for mpfr_set_str.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "gmp.h"
+#include "mpfr.h"
+#include <time.h>
+
+#if defined (hpux)
+#define srandom srand48
+#define random mrand48
+#endif
+
+int
+main(int argc, char **argv)
+{
+  mpfr_t x; unsigned long k, bd, nc; char *str, *str2; 
+
+  if (argc==2) { /* tset_str <string> */
+    mpfr_init2(x, 53);
+    mpfr_set_str_raw(x, argv[1]);
+    printf("%1.20e\n", mpfr_get_d(x));
+    mpfr_clear(x);
+    exit (0);
+  }
+
+  srandom(time(NULL)); 
+  
+  if (argc > 1) { nc = atoi(argv[1]); } else { nc = 53; }
+  if (nc < 24) { nc = 24; }
+
+  bd = random()&8;
+  
+  str2 = str = (char *) malloc (nc*sizeof(char)); 
+
+  if (bd) 
+    {
+      for(k = 1; k <= bd; k++) 
+	{ *(str2++) = (random() & 1) + '0'; }
+    }
+  else { *(str2++) = '0'; }
+
+  *(str2++) = '.'; 
+
+  for(k = 1; k < nc - 17 - bd; k++)
+    {
+      *(str2++) = '0' + (random() & 1); 
+    }
+
+  *(str2++) = 'e'; 
+  sprintf(str2, "%d", random() - (1 << 30)); 
+
+  /* printf("%s\n", str); */
+  mpfr_init2(x, nc + 10); 
+  mpfr_set_str_raw(x, str); 
+  /* mpfr_print_raw(x); printf("\n");  */
+
+  mpfr_set_prec(x, 53);
+  mpfr_set_str_raw(x, "+110101100.01010000101101000000100111001000101011101110E00");
+
+  mpfr_set_str_raw(x, "1.0");
+  if (mpfr_get_d(x) != 1.0) {
+    fprintf(stderr, "Error in mpfr_set_str_raw for s=1.0\n"); exit(1);
+  }
+
+  mpfr_clear(x); free(str); 
+  exit (0); 
+}
diff --git a/src/gmp/mpfr/tests/tset_z.c b/src/gmp/mpfr/tests/tset_z.c
new file mode 100644
index 000000000..61fe654f3
--- /dev/null
+++ b/src/gmp/mpfr/tests/tset_z.c
@@ -0,0 +1,66 @@
+/* Test file for mpfr_set_z.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdlib.h>
+#include <unistd.h>
+#include "gmp.h"
+#include "mpfr.h"
+
+/* tset_z z rnd prec */
+
+void check(long i, unsigned char rnd) {
+  mpfr_t f; mpz_t z; 
+
+  mpfr_init2(f, 53); mpz_init(z);
+  mpz_set_ui(z, i);
+  mpfr_set_z(f, z, rnd);
+  if ((long)mpfr_get_d(f) != i) {
+    printf("Error in mpfr_set_z for i=%ld rnd_mode=%d\n",i,rnd);
+    exit(1);
+  }
+  mpfr_clear(f); mpz_clear(z);
+}
+
+void check_large()
+{
+  mpz_t z; mpfr_t x,y;
+
+  mpz_init(z); mpfr_init2(x, 160); mpfr_init2(y, 160);
+  mpz_set_str(z, "77031627725494291259359895954016675357279104942148788042", 10);
+  mpfr_set_z(x, z, GMP_RNDN);
+  mpfr_set_str_raw(y, "0.1100100100001111110110101010001000100001011010001100001000110100110001001100011001100010100010111000000011011100000111001101000100101001000000100100111000001001E186");
+  if (mpfr_cmp(x,y)) {
+    fprintf(stderr, "Error in mpfr_set_z on large input\n"); exit(1);
+  }
+  mpz_clear(z); mpfr_clear(x); mpfr_clear(y);
+}
+
+int main(argc,argv) int argc; char *argv[];
+{
+  long j; 
+
+  check_large();
+  srand(getpid());
+  for (j=0; j<1000000; j++)
+    check(lrand48(), rand()%4);
+  exit (0);
+}
+
diff --git a/src/gmp/mpfr/tests/tzeta.c b/src/gmp/mpfr/tests/tzeta.c
new file mode 100644
index 000000000..d9495e57b
--- /dev/null
+++ b/src/gmp/mpfr/tests/tzeta.c
@@ -0,0 +1,70 @@
+/* Test file for mpfr_zeta.
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+/* #define DEBUG */
+
+int main()
+{mpfr_t p,result,res_p; int succes; size_t t;
+mpfr_init2(result, 53);
+mpfr_init2(res_p, 53);
+mpfr_init2(p, 53); mpfr_set_d(p, 2.0, GMP_RNDN);
+
+mpfr_zeta(result,p,GMP_RNDN);
+/*printf("%d\n",succes);*/
+#ifdef DEBUG
+printf("Valeur de zeta(2) avec prec=53 et arrondi au plus pres:\n");
+mpfr_print_raw(result);printf("\n");
+t=mpfr_out_str(stdout,10,0,result,GMP_RNDN);printf("\n");
+#endif
+ if (mpfr_get_d(result) != 1.64493406684822640607e+00) {
+   fprintf(stderr, "mpfr_zeta fails for s=2 and rnd_mode=GMP_RNDN\n");
+   exit(1);
+ }
+
+/*Test de comparaison avec pi^2/6*/
+mpfr_set_prec(p, 67);
+mpfr_pi(p,GMP_RNDN);
+mpfr_mul(p,p,p,GMP_RNDN);
+mpfr_set_ui(res_p,6,GMP_RNDN);
+mpfr_div(p,p,res_p,GMP_RNDN);
+/*mpfr_print_raw(p);printf("\n");
+t=mpfr_out_str(stdout,10,0,p,GMP_RNDN);printf("\n");*/
+succes=mpfr_can_round(p,63,GMP_RNDN,GMP_RNDN,53);
+mpfr_set(res_p,p,GMP_RNDN);
+/*printf("%d\n",succes);*/
+#ifdef DEBUG
+printf("Valeur de pi^2/6 avec prec=53 et arrondi au plus pres:\n");
+mpfr_print_raw(res_p);printf("\n");
+t=mpfr_out_str(stdout,10,0,res_p,GMP_RNDN);printf("\n");
+#endif
+
+mpfr_clear(p);
+mpfr_clear(result);
+mpfr_clear(res_p);
+exit (0);
+}
diff --git a/src/gmp/mpfr/zeta.c b/src/gmp/mpfr/zeta.c
new file mode 100644
index 000000000..5250a9dd7
--- /dev/null
+++ b/src/gmp/mpfr/zeta.c
@@ -0,0 +1,116 @@
+/* mpfr_zeta -- Riemann Zeta function at a floating-point number
+
+Copyright (C) 1999 PolKA project, Inria Lorraine and Loria
+
+This file is part of the MPFR Library.
+
+The MPFR Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+The MPFR Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
+License for more details.
+
+You should have received a copy of the GNU Library General Public License
+along with the MPFR Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "mpfr.h"
+
+int
+#if __STDC__
+mpfr_zeta(mpfr_ptr result, mpfr_srcptr op, unsigned char rnd_mode) 
+#else
+mpfr_zeta(result, op, rnd_mode)
+     mpfr_ptr result; 
+     mpfr_srcptr op; 
+     unsigned char rnd_mode; 
+#endif
+{
+	mpfr_t s,s2,x,y,u,b,v,nn,z,z2; 
+	int i,n,succes; 
+
+	/* first version */
+	if (mpfr_get_d(op) != 2.0 || rnd_mode != GMP_RNDN 
+	|| PREC(result) != 53) {
+	   fprintf(stderr, "not yet implemented\n"); exit(1);
+	}
+
+mpfr_set_default_prec(67);
+mpfr_init(x);
+mpfr_init(y);
+mpfr_init(s);
+mpfr_init(s2);
+mpfr_init(u);
+mpfr_init(b);
+mpfr_init(v);
+mpfr_init(nn);
+mpfr_init(z);
+mpfr_init(z2);
+mpfr_set_ui(u,1,GMP_RNDN);
+mpfr_set_ui(s,0,GMP_RNDN);
+/*s=Somme des 1/i^2 (i=100...2)*/
+n=100;
+for (i=n; i>1; i--)
+{
+mpfr_set_ui(x,i*i,GMP_RNDN);
+mpfr_div(y,u,x,GMP_RNDN);
+mpfr_add(s,s,y,GMP_RNDN);
+};
+/*mpfr_print_raw(s);printf("\n");
+t=mpfr_out_str(stdout,10,0,s,GMP_RNDN);printf("\n");*/
+/*Application d'Euler-Maclaurin, jusqu'au terme 1/n^7 - n=100)*/
+mpfr_set_ui(nn,n,GMP_RNDN);
+mpfr_div(z,u,nn,GMP_RNDN);
+mpfr_set(s2,z,GMP_RNDN);
+mpfr_mul(z2,z,z,GMP_RNDN);
+mpfr_div_2exp(v,z2,1,GMP_RNDN);
+mpfr_sub(s2,s2,v,GMP_RNDN);
+mpfr_set_ui(b,6,GMP_RNDN);
+mpfr_mul(z,z,z2,GMP_RNDN);
+mpfr_div(v,z,b,GMP_RNDN);
+mpfr_add(s2,s2,v,GMP_RNDN);
+mpfr_set_si(b,-30,GMP_RNDN);
+mpfr_mul(z,z,z2,GMP_RNDN);
+mpfr_div(v,z,b,GMP_RNDN);
+mpfr_add(s2,s2,v,GMP_RNDN);
+mpfr_set_si(b,42,GMP_RNDN);
+mpfr_mul(z,z,z2,GMP_RNDN);
+mpfr_div(v,z,b,GMP_RNDN);
+mpfr_add(s2,s2,v,GMP_RNDN);
+/*mpfr_print_raw(s2);printf("\n");
+t=mpfr_out_str(stdout,10,0,s2,GMP_RNDN);printf("\n");*/
+mpfr_add(s,s,s2,GMP_RNDN);
+/*mpfr_print_raw(s);printf("\n");
+t=mpfr_out_str(stdout,10,0,s,GMP_RNDN);printf("\n");*/
+mpfr_add(s,s,u,GMP_RNDN);
+/*mpfr_print_raw(s);printf("\n");
+t=mpfr_out_str(stdout,10,0,s,GMP_RNDN);printf("\n");*/
+/*Peut-on arrondir ? La reponse est oui*/
+succes=mpfr_can_round(s,57,GMP_RNDN,GMP_RNDN,53);
+if (succes) mpfr_set(result,s,GMP_RNDN);
+else {
+  fprintf(stderr, "can't round in mpfr_zeta\n"); exit(1);
+}
+
+mpfr_clear(x);
+mpfr_clear(y);
+mpfr_clear(s);
+mpfr_clear(s2);
+mpfr_clear(u);
+mpfr_clear(b);
+mpfr_clear(v);
+mpfr_clear(nn);
+mpfr_clear(z);
+mpfr_clear(z2);
+return 1; /* result is inexact */
+}
diff --git a/src/gmp/mpn/Makefile.am b/src/gmp/mpn/Makefile.am
new file mode 100644
index 000000000..1c49ccda2
--- /dev/null
+++ b/src/gmp/mpn/Makefile.am
@@ -0,0 +1,94 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+SUBDIRS = tests
+
+CPP	= @CPP@
+
+# -DOPERATION_$* tells multi-function files which function to produce.
+INCLUDES = -I$(top_srcdir) -DOPERATION_$*
+
+GENERIC_SOURCES = mp_bases.c
+OFILES = @mpn_objects@
+
+noinst_LTLIBRARIES = libmpn.la
+libmpn_la_SOURCES = $(GENERIC_SOURCES)
+libmpn_la_LIBADD = $(OFILES)
+libmpn_la_DEPENDENCIES = $(OFILES)
+
+TARG_DIST = a29k alpha arm clipper cray generic hppa i960 lisp m68k m88k \
+  mips2 mips3 ns32k pa64 pa64w power powerpc32 powerpc64 pyr sh sparc32 \
+  sparc64 thumb vax x86 z8000 z8000x
+
+EXTRA_DIST = underscore.h asm-defs.m4 $(TARG_DIST)
+
+# COMPILE minus CC.  FIXME: Really pass *_CFLAGS to CPP?
+COMPILE_FLAGS =	\
+	$(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+
+SUFFIXES = .s .S .asm
+
+# *.s are not preprocessed at all.
+.s.o:
+	$(CCAS) $(COMPILE_FLAGS) $<
+.s.obj:
+	$(CCAS) $(COMPILE_FLAGS) `cygpath -w $<`
+.s.lo:
+	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) $<
+
+# *.S are preprocessed with CPP.
+.S.o:
+	$(CPP) $(COMPILE_FLAGS) $< | grep -v '^#' >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.S.obj:
+	$(CPP) $(COMPILE_FLAGS) `cygpath -w $<` | grep -v '^#' >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+
+# We have to rebuild the static object file without passing -DPIC to
+# preprocessor.  The overhead cost is one extra assemblation.  FIXME:
+# Teach libtool how to assemble with a preprocessor pass (CPP or m4).
+
+.S.lo:
+	$(CPP) $(COMPILE_FLAGS) -DPIC $< | grep -v '^#' >tmp-$*.s
+	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	$(CPP) $(COMPILE_FLAGS) $< | grep -v '^#' >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
+	rm -f tmp-$*.s
+
+# *.m4 are preprocessed with m4.
+.asm.o:
+	$(M4) -DOPERATION_$* $< >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.asm.obj:
+	$(M4) -DOPERATION_$* `cygpath -w $<` >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.asm.lo:
+	$(M4) -DPIC -DOPERATION_$* $< >tmp-$*.s
+	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	$(M4) -DOPERATION_$* $< >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
+	rm -f tmp-$*.s
diff --git a/src/gmp/mpn/Makefile.in b/src/gmp/mpn/Makefile.in
new file mode 100644
index 000000000..b252bad4e
--- /dev/null
+++ b/src/gmp/mpn/Makefile.in
@@ -0,0 +1,472 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+SUBDIRS = tests
+
+CPP = @CPP@
+
+# -DOPERATION_$* tells multi-function files which function to produce.
+INCLUDES = -I$(top_srcdir) -DOPERATION_$*
+
+GENERIC_SOURCES = mp_bases.c
+OFILES = @mpn_objects@
+
+noinst_LTLIBRARIES = libmpn.la
+libmpn_la_SOURCES = $(GENERIC_SOURCES)
+libmpn_la_LIBADD = $(OFILES)
+libmpn_la_DEPENDENCIES = $(OFILES)
+
+TARG_DIST = a29k alpha arm clipper cray generic hppa i960 lisp m68k m88k \
+  mips2 mips3 ns32k pa64 pa64w power powerpc32 powerpc64 pyr sh sparc32 \
+  sparc64 thumb vax x86 z8000 z8000x
+
+
+EXTRA_DIST = underscore.h asm-defs.m4 $(TARG_DIST)
+
+# COMPILE minus CC.  FIXME: Really pass *_CFLAGS to CPP?
+COMPILE_FLAGS = \
+	$(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+
+
+SUFFIXES = .s .S .asm
+subdir = mpn
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES = 
+LTLIBRARIES =  $(noinst_LTLIBRARIES)
+
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+libmpn_la_LDFLAGS = 
+am_libmpn_la_OBJECTS =  mp_bases.lo
+libmpn_la_OBJECTS =  $(am_libmpn_la_OBJECTS)
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(libmpn_la_SOURCES)
+DIST_COMMON =  README Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(libmpn_la_SOURCES)
+OBJECTS = $(am_libmpn_la_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .S .asm .c .lo .o .obj .s
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpn/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-noinstLTLIBRARIES:
+
+clean-noinstLTLIBRARIES:
+	-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
+
+distclean-noinstLTLIBRARIES:
+
+maintainer-clean-noinstLTLIBRARIES:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+
+libmpn.la: $(libmpn_la_OBJECTS) $(libmpn_la_DEPENDENCIES)
+	$(LINK)  $(libmpn_la_LDFLAGS) $(libmpn_la_OBJECTS) $(libmpn_la_LIBADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+
+# 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.
+
+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; \
+	dot_seen=no; \
+	target=`echo $@ | sed s/-recursive//`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    dot_seen=yes; \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+	done; \
+	if test "$$dot_seen" = "no"; then \
+	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+	fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+	@set fnord $(MAKEFLAGS); amf=$$2; \
+	dot_seen=no; \
+	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
+	  rev="$$subdir $$rev"; \
+	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
+	done; \
+	test "$$dot_seen" = "no" && rev=". $$rev"; \
+	target=`echo $@ | sed s/-recursive//`; \
+	for subdir in $$rev; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_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 \
+	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+	done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+   if test "$$subdir" = .; then :; else \
+	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+   fi; \
+	done; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+	for subdir in $(SUBDIRS); do \
+	  if test "$$subdir" = .; then :; else \
+	    test -d $(distdir)/$$subdir \
+	    || mkdir $(distdir)/$$subdir \
+	    || exit 1; \
+	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \
+	      || exit 1; \
+	  fi; \
+	done
+info-am:
+info: info-recursive
+dvi-am:
+dvi: dvi-recursive
+check-am: all-am
+check: check-recursive
+installcheck-am:
+installcheck: installcheck-recursive
+install-exec-am:
+install-exec: install-exec-recursive
+
+install-data-am:
+install-data: install-data-recursive
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-recursive
+uninstall-am:
+uninstall: uninstall-recursive
+all-am: Makefile $(LTLIBRARIES)
+all-redirect: all-recursive
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs: installdirs-recursive
+installdirs-am:
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-noinstLTLIBRARIES mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-recursive
+
+clean-am:  clean-noinstLTLIBRARIES clean-compile clean-libtool \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-recursive
+
+distclean-am:  distclean-noinstLTLIBRARIES distclean-compile \
+		distclean-libtool distclean-tags distclean-generic \
+		clean-am
+	-rm -f libtool
+
+distclean: distclean-recursive
+
+maintainer-clean-am:  maintainer-clean-noinstLTLIBRARIES \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-recursive
+
+.PHONY: mostlyclean-noinstLTLIBRARIES distclean-noinstLTLIBRARIES \
+clean-noinstLTLIBRARIES maintainer-clean-noinstLTLIBRARIES \
+mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool install-recursive \
+uninstall-recursive 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-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+installdirs-am installdirs mostlyclean-generic distclean-generic \
+clean-generic maintainer-clean-generic clean mostlyclean distclean \
+maintainer-clean
+
+
+# *.s are not preprocessed at all.
+.s.o:
+	$(CCAS) $(COMPILE_FLAGS) $<
+.s.obj:
+	$(CCAS) $(COMPILE_FLAGS) `cygpath -w $<`
+.s.lo:
+	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) $<
+
+# *.S are preprocessed with CPP.
+.S.o:
+	$(CPP) $(COMPILE_FLAGS) $< | grep -v '^#' >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.S.obj:
+	$(CPP) $(COMPILE_FLAGS) `cygpath -w $<` | grep -v '^#' >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+
+# We have to rebuild the static object file without passing -DPIC to
+# preprocessor.  The overhead cost is one extra assemblation.  FIXME:
+# Teach libtool how to assemble with a preprocessor pass (CPP or m4).
+
+.S.lo:
+	$(CPP) $(COMPILE_FLAGS) -DPIC $< | grep -v '^#' >tmp-$*.s
+	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	$(CPP) $(COMPILE_FLAGS) $< | grep -v '^#' >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
+	rm -f tmp-$*.s
+
+# *.m4 are preprocessed with m4.
+.asm.o:
+	$(M4) -DOPERATION_$* $< >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.asm.obj:
+	$(M4) -DOPERATION_$* `cygpath -w $<` >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.asm.lo:
+	$(M4) -DPIC -DOPERATION_$* $< >tmp-$*.s
+	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	$(M4) -DOPERATION_$* $< >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
+	rm -f tmp-$*.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/src/gmp/mpn/README b/src/gmp/mpn/README
new file mode 100644
index 000000000..7453c9d03
--- /dev/null
+++ b/src/gmp/mpn/README
@@ -0,0 +1,13 @@
+This directory contains all code for the mpn layer of GMP.
+
+Most subdirectories contain machine-dependent code, written in assembly or C.
+The `generic' subdirectory contains default code, used when there is no
+machine-dependent replacement for a particular machine.
+
+There is one subdirectory for each ISA family.  Note that e.g., 32-bit SPARC
+and 64-bit SPARC are very different ISA's, and thus cannot share any code.
+
+A particular compile will only use code from one subdirectory, and the
+`generic' subdirectory.  The ISA-specific subdirectories contain hierachies of
+directories for various architecture variants and implementations; the
+top-most level contains code that runs correctly on all variants.
diff --git a/src/gmp/mpn/a29k/add_n.s b/src/gmp/mpn/a29k/add_n.s
new file mode 100644
index 000000000..e3ee6dfa6
--- /dev/null
+++ b/src/gmp/mpn/a29k/add_n.s
@@ -0,0 +1,120 @@
+; 29000 __gmpn_add -- Add two limb vectors of the same length > 0 and store
+; sum in a third limb vector.
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	lr2
+; s1_ptr	lr3
+; s2_ptr	lr4
+; size		lr5
+
+; We use the loadm/storem instructions and operate on chunks of 8
+; limbs/per iteration, until less than 8 limbs remain.
+
+; The 29k has no addition or subtraction instructions that doesn't
+; affect carry, so we need to save and restore that as soon as we
+; adjust the pointers.  gr116 is used for this purpose.  Note that
+; gr116==0 means that carry should be set.
+
+	.sect .lit,lit
+	.text
+	.align	4
+	.global	___gmpn_add_n
+	.word	0x60000
+___gmpn_add_n:
+	srl	gr117,lr5,3
+	sub	gr118,gr117,1
+	jmpt	gr118,Ltail
+	 constn	gr116,-1		; init cy reg
+	sub	gr117,gr117,2		; count for jmpfdec
+
+; Main loop working 8 limbs/iteration.
+Loop:	mtsrim	cr,(8-1)
+	loadm	0,0,gr96,lr3
+	add	lr3,lr3,32
+	mtsrim	cr,(8-1)
+	loadm	0,0,gr104,lr4
+	add	lr4,lr4,32
+
+	subr	gr116,gr116,0		; restore carry
+	addc	gr96,gr96,gr104
+	addc	gr97,gr97,gr105
+	addc	gr98,gr98,gr106
+	addc	gr99,gr99,gr107
+	addc	gr100,gr100,gr108
+	addc	gr101,gr101,gr109
+	addc	gr102,gr102,gr110
+	addc	gr103,gr103,gr111
+	subc	gr116,gr116,gr116	; gr116 = not(cy)
+
+	mtsrim	cr,(8-1)
+	storem	0,0,gr96,lr2
+	jmpfdec	gr117,Loop
+	 add	lr2,lr2,32
+
+; Code for the last up-to-7 limbs.
+; This code might look very strange, but it's hard to write it
+; differently without major slowdown.
+
+	and	lr5,lr5,(8-1)
+Ltail:	sub	gr118,lr5,1		; count for CR
+	jmpt	gr118,Lend
+	 sub	gr117,lr5,2		; count for jmpfdec
+
+	mtsr	cr,gr118
+	loadm	0,0,gr96,lr3
+	mtsr	cr,gr118
+	loadm	0,0,gr104,lr4
+
+	subr	gr116,gr116,0		; restore carry
+
+	jmpfdec	gr117,L1
+	 addc	gr96,gr96,gr104
+	jmp	Lstore
+	 mtsr	cr,gr118
+L1:	jmpfdec	gr117,L2
+	 addc	gr97,gr97,gr105
+	jmp	Lstore
+	 mtsr	cr,gr118
+L2:	jmpfdec	gr117,L3
+	 addc	gr98,gr98,gr106
+	jmp	Lstore
+	 mtsr	cr,gr118
+L3:	jmpfdec	gr117,L4
+	 addc	gr99,gr99,gr107
+	jmp	Lstore
+	 mtsr	cr,gr118
+L4:	jmpfdec	gr117,L5
+	 addc	gr100,gr100,gr108
+	jmp	Lstore
+	 mtsr	cr,gr118
+L5:	jmpfdec	gr117,L6
+	 addc	gr101,gr101,gr109
+	jmp	Lstore
+	 mtsr	cr,gr118
+L6:	addc	gr102,gr102,gr110
+
+Lstore:	storem	0,0,gr96,lr2
+	subc	gr116,gr116,gr116	; gr116 = not(cy)
+
+Lend:	jmpi	lr0
+	 add	gr96,gr116,1
diff --git a/src/gmp/mpn/a29k/addmul_1.s b/src/gmp/mpn/a29k/addmul_1.s
new file mode 100644
index 000000000..f51b6d7af
--- /dev/null
+++ b/src/gmp/mpn/a29k/addmul_1.s
@@ -0,0 +1,113 @@
+; 29000 __gmpn_addmul_1 -- Multiply a limb vector with a single limb and
+; add the product to a second limb vector.
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	lr2
+; s1_ptr	lr3
+; size		lr4
+; s2_limb	lr5
+
+	.cputype 29050
+	.sect .lit,lit
+	.text
+	.align	4
+	.global	___gmpn_addmul_1
+	.word	0x60000
+___gmpn_addmul_1:
+	sub	lr4,lr4,8
+	jmpt	lr4,Ltail
+	 const	gr120,0			; init cylimb reg
+
+	srl	gr117,lr4,3		; divide by 8
+	sub	gr117,gr117,1		; count for jmpfdec
+
+Loop:	mtsrim	cr,(8-1)
+	loadm	0,0,gr96,lr3
+	add	lr3,lr3,32
+
+	multiplu gr104,gr96,lr5
+	multmu	 gr96,gr96,lr5
+	multiplu gr105,gr97,lr5
+	multmu	 gr97,gr97,lr5
+	multiplu gr106,gr98,lr5
+	multmu	 gr98,gr98,lr5
+	multiplu gr107,gr99,lr5
+	multmu	 gr99,gr99,lr5
+	multiplu gr108,gr100,lr5
+	multmu	 gr100,gr100,lr5
+	multiplu gr109,gr101,lr5
+	multmu	 gr101,gr101,lr5
+	multiplu gr110,gr102,lr5
+	multmu	 gr102,gr102,lr5
+	multiplu gr111,gr103,lr5
+	multmu	 gr103,gr103,lr5
+
+	add	gr104,gr104,gr120
+	addc	gr105,gr105,gr96
+	addc	gr106,gr106,gr97
+	addc	gr107,gr107,gr98
+	addc	gr108,gr108,gr99
+	addc	gr109,gr109,gr100
+	addc	gr110,gr110,gr101
+	addc	gr111,gr111,gr102
+	addc	gr120,gr103,0
+
+	mtsrim	cr,(8-1)
+	loadm	0,0,gr96,lr2
+
+	add	gr104,gr96,gr104
+	addc	gr105,gr97,gr105
+	addc	gr106,gr98,gr106
+	addc	gr107,gr99,gr107
+	addc	gr108,gr100,gr108
+	addc	gr109,gr101,gr109
+	addc	gr110,gr102,gr110
+	addc	gr111,gr103,gr111
+	addc	gr120,gr120,0
+
+	mtsrim	cr,(8-1)
+	storem	0,0,gr104,lr2
+	jmpfdec	gr117,Loop
+	 add	lr2,lr2,32
+
+Ltail:	and	lr4,lr4,(8-1)
+	sub	gr118,lr4,1		; count for CR
+	jmpt	gr118,Lend
+	 sub	lr4,lr4,2
+	sub	lr2,lr2,4		; offset res_ptr by one limb
+
+Loop2:	load	0,0,gr116,lr3
+	add	lr3,lr3,4
+	multiplu gr117,gr116,lr5
+	multmu	gr118,gr116,lr5
+	add	lr2,lr2,4
+	load	0,0,gr119,lr2
+	add	gr117,gr117,gr120
+	addc	gr118,gr118,0
+	add	gr117,gr117,gr119
+	store	0,0,gr117,lr2
+	jmpfdec	lr4,Loop2
+	 addc	gr120,gr118,0
+
+Lend:	jmpi	lr0
+	 or	gr96,gr120,0		; copy
diff --git a/src/gmp/mpn/a29k/lshift.s b/src/gmp/mpn/a29k/lshift.s
new file mode 100644
index 000000000..93e191712
--- /dev/null
+++ b/src/gmp/mpn/a29k/lshift.s
@@ -0,0 +1,93 @@
+; 29000 __gmpn_lshift --
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	lr2
+; s1_ptr	lr3
+; s2_ptr	lr4
+; size		lr5
+
+; We use the loadm/storem instructions and operate on chunks of 8
+; limbs/per iteration, until less than 8 limbs remain.
+
+	.sect .lit,lit
+	.text
+	.align	4
+	.global	___gmpn_lshift
+	.word	0x60000
+___gmpn_lshift:
+	sll	gr116,lr4,2
+	add	lr3,gr116,lr3
+	add	lr2,gr116,lr2
+	sub	lr3,lr3,4
+	load	0,0,gr119,lr3
+
+	subr	gr116,lr5,32
+	srl	gr96,gr119,gr116	; return value
+	sub	lr4,lr4,1		; actual loop count is SIZE - 1
+
+	srl	gr117,lr4,3		; chuck count = (actual count) / 8
+	cpeq	gr118,gr117,0
+	jmpt	gr118,Ltail
+	 mtsr	fc,lr5
+
+	sub	gr117,gr117,2		; count for jmpfdec
+
+; Main loop working 8 limbs/iteration.
+Loop:	sub	lr3,lr3,32
+	mtsrim	cr,(8-1)
+	loadm	0,0,gr100,lr3
+
+	extract	gr109,gr119,gr107
+	extract	gr108,gr107,gr106
+	extract	gr107,gr106,gr105
+	extract	gr106,gr105,gr104
+	extract	gr105,gr104,gr103
+	extract	gr104,gr103,gr102
+	extract	gr103,gr102,gr101
+	extract	gr102,gr101,gr100
+
+	sub	lr2,lr2,32
+	mtsrim	cr,(8-1)
+	storem	0,0,gr102,lr2
+	jmpfdec	gr117,Loop
+	 or	gr119,gr100,0
+
+; Code for the last up-to-7 limbs.
+
+	and	lr4,lr4,(8-1)
+Ltail:	cpeq	gr118,lr4,0
+	jmpt	gr118,Lend
+	 sub	lr4,lr4,2		; count for jmpfdec
+
+Loop2:	sub	lr3,lr3,4
+	load	0,0,gr116,lr3
+	extract	gr117,gr119,gr116
+	sub	lr2,lr2,4
+	store	0,0,gr117,lr2
+	jmpfdec	lr4,Loop2
+	 or	gr119,gr116,0
+
+Lend:	extract	gr117,gr119,0
+	sub	lr2,lr2,4
+	jmpi	lr0
+	 store	0,0,gr117,lr2
diff --git a/src/gmp/mpn/a29k/mul_1.s b/src/gmp/mpn/a29k/mul_1.s
new file mode 100644
index 000000000..6bcf7ce0c
--- /dev/null
+++ b/src/gmp/mpn/a29k/mul_1.s
@@ -0,0 +1,97 @@
+; 29000 __gmpn_mul_1 -- Multiply a limb vector with a single limb and
+; store the product in a second limb vector.
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	lr2
+; s1_ptr	lr3
+; size		lr4
+; s2_limb	lr5
+
+	.cputype 29050
+	.sect .lit,lit
+	.text
+	.align	4
+	.global	___gmpn_mul_1
+	.word	0x60000
+___gmpn_mul_1:
+	sub	lr4,lr4,8
+	jmpt	lr4,Ltail
+	 const	gr120,0			; init cylimb reg
+
+	srl	gr117,lr4,3		; divide by 8
+	sub	gr117,gr117,1		; count for jmpfdec
+
+Loop:	mtsrim	cr,(8-1)
+	loadm	0,0,gr96,lr3
+	add	lr3,lr3,32
+
+	multiplu gr104,gr96,lr5
+	multmu	 gr96,gr96,lr5
+	multiplu gr105,gr97,lr5
+	multmu	 gr97,gr97,lr5
+	multiplu gr106,gr98,lr5
+	multmu	 gr98,gr98,lr5
+	multiplu gr107,gr99,lr5
+	multmu	 gr99,gr99,lr5
+	multiplu gr108,gr100,lr5
+	multmu	 gr100,gr100,lr5
+	multiplu gr109,gr101,lr5
+	multmu	 gr101,gr101,lr5
+	multiplu gr110,gr102,lr5
+	multmu	 gr102,gr102,lr5
+	multiplu gr111,gr103,lr5
+	multmu	 gr103,gr103,lr5
+
+	add	gr104,gr104,gr120
+	addc	gr105,gr105,gr96
+	addc	gr106,gr106,gr97
+	addc	gr107,gr107,gr98
+	addc	gr108,gr108,gr99
+	addc	gr109,gr109,gr100
+	addc	gr110,gr110,gr101
+	addc	gr111,gr111,gr102
+	addc	gr120,gr103,0
+
+	mtsrim	cr,(8-1)
+	storem	0,0,gr104,lr2
+	jmpfdec	gr117,Loop
+	 add	lr2,lr2,32
+
+Ltail:	and	lr4,lr4,(8-1)
+	sub	gr118,lr4,1		; count for CR
+	jmpt	gr118,Lend
+	 sub	lr4,lr4,2
+	sub	lr2,lr2,4		; offset res_ptr by one limb
+
+Loop2:	load	0,0,gr116,lr3
+	add	lr3,lr3,4
+	multiplu gr117,gr116,lr5
+	multmu	gr118,gr116,lr5
+	add	lr2,lr2,4
+	add	gr117,gr117,gr120
+	store	0,0,gr117,lr2
+	jmpfdec	lr4,Loop2
+	 addc	gr120,gr118,0
+
+Lend:	jmpi	lr0
+	 or	gr96,gr120,0		; copy
diff --git a/src/gmp/mpn/a29k/rshift.s b/src/gmp/mpn/a29k/rshift.s
new file mode 100644
index 000000000..ea163bff2
--- /dev/null
+++ b/src/gmp/mpn/a29k/rshift.s
@@ -0,0 +1,89 @@
+; 29000 __gmpn_rshift --
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	lr2
+; s1_ptr	lr3
+; s2_ptr	lr4
+; size		lr5
+
+; We use the loadm/storem instructions and operate on chunks of 8
+; limbs/per iteration, until less than 8 limbs remain.
+
+	.sect .lit,lit
+	.text
+	.align	4
+	.global	___gmpn_rshift
+	.word	0x60000
+___gmpn_rshift:
+	load	0,0,gr119,lr3
+	add	lr3,lr3,4
+
+	subr	gr116,lr5,32
+	sll	gr96,gr119,gr116	; return value
+	sub	lr4,lr4,1		; actual loop count is SIZE - 1
+
+	srl	gr117,lr4,3		; chuck count = (actual count) / 8
+	cpeq	gr118,gr117,0
+	jmpt	gr118,Ltail
+	 mtsr	fc,gr116
+
+	sub	gr117,gr117,2		; count for jmpfdec
+
+; Main loop working 8 limbs/iteration.
+Loop:	mtsrim	cr,(8-1)
+	loadm	0,0,gr100,lr3
+	add	lr3,lr3,32
+
+	extract	gr98,gr100,gr119
+	extract	gr99,gr101,gr100
+	extract	gr100,gr102,gr101
+	extract	gr101,gr103,gr102
+	extract	gr102,gr104,gr103
+	extract	gr103,gr105,gr104
+	extract	gr104,gr106,gr105
+	extract	gr105,gr107,gr106
+
+	mtsrim	cr,(8-1)
+	storem	0,0,gr98,lr2
+	add	lr2,lr2,32
+	jmpfdec	gr117,Loop
+	 or	gr119,gr107,0
+
+; Code for the last up-to-7 limbs.
+
+	and	lr4,lr4,(8-1)
+Ltail:	cpeq	gr118,lr4,0
+	jmpt	gr118,Lend
+	 sub	lr4,lr4,2		; count for jmpfdec
+
+Loop2:	load	0,0,gr100,lr3
+	add	lr3,lr3,4
+	extract	gr117,gr100,gr119
+	store	0,0,gr117,lr2
+	add	lr2,lr2,4
+	jmpfdec	lr4,Loop2
+	 or	gr119,gr100,0
+
+Lend:	srl	gr117,gr119,lr5
+	jmpi	lr0
+	 store	0,0,gr117,lr2
diff --git a/src/gmp/mpn/a29k/sub_n.s b/src/gmp/mpn/a29k/sub_n.s
new file mode 100644
index 000000000..c6b64c5be
--- /dev/null
+++ b/src/gmp/mpn/a29k/sub_n.s
@@ -0,0 +1,120 @@
+; 29000 __gmpn_sub -- Subtract two limb vectors of the same length > 0 and
+; store difference in a third limb vector.
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	lr2
+; s1_ptr	lr3
+; s2_ptr	lr4
+; size		lr5
+
+; We use the loadm/storem instructions and operate on chunks of 8
+; limbs/per iteration, until less than 8 limbs remain.
+
+; The 29k has no addition or subtraction instructions that doesn't
+; affect carry, so we need to save and restore that as soon as we
+; adjust the pointers.  gr116 is used for this purpose.  Note that
+; gr116==0 means that carry should be set.
+
+	.sect .lit,lit
+	.text
+	.align	4
+	.global	___gmpn_sub_n
+	.word	0x60000
+___gmpn_sub_n:
+	srl	gr117,lr5,3
+	sub	gr118,gr117,1
+	jmpt	gr118,Ltail
+	 constn	gr116,-1		; init cy reg
+	sub	gr117,gr117,2		; count for jmpfdec
+
+; Main loop working 8 limbs/iteration.
+Loop:	mtsrim	cr,(8-1)
+	loadm	0,0,gr96,lr3
+	add	lr3,lr3,32
+	mtsrim	cr,(8-1)
+	loadm	0,0,gr104,lr4
+	add	lr4,lr4,32
+
+	subr	gr116,gr116,0		; restore carry
+	subc	gr96,gr96,gr104
+	subc	gr97,gr97,gr105
+	subc	gr98,gr98,gr106
+	subc	gr99,gr99,gr107
+	subc	gr100,gr100,gr108
+	subc	gr101,gr101,gr109
+	subc	gr102,gr102,gr110
+	subc	gr103,gr103,gr111
+	subc	gr116,gr116,gr116	; gr116 = not(cy)
+
+	mtsrim	cr,(8-1)
+	storem	0,0,gr96,lr2
+	jmpfdec	gr117,Loop
+	 add	lr2,lr2,32
+
+; Code for the last up-to-7 limbs.
+; This code might look very strange, but it's hard to write it
+; differently without major slowdown.
+
+	and	lr5,lr5,(8-1)
+Ltail:	sub	gr118,lr5,1		; count for CR
+	jmpt	gr118,Lend
+	 sub	gr117,lr5,2		; count for jmpfdec
+
+	mtsr	cr,gr118
+	loadm	0,0,gr96,lr3
+	mtsr	cr,gr118
+	loadm	0,0,gr104,lr4
+
+	subr	gr116,gr116,0		; restore carry
+
+	jmpfdec	gr117,L1
+	 subc	gr96,gr96,gr104
+	jmp	Lstore
+	 mtsr	cr,gr118
+L1:	jmpfdec	gr117,L2
+	 subc	gr97,gr97,gr105
+	jmp	Lstore
+	 mtsr	cr,gr118
+L2:	jmpfdec	gr117,L3
+	 subc	gr98,gr98,gr106
+	jmp	Lstore
+	 mtsr	cr,gr118
+L3:	jmpfdec	gr117,L4
+	 subc	gr99,gr99,gr107
+	jmp	Lstore
+	 mtsr	cr,gr118
+L4:	jmpfdec	gr117,L5
+	 subc	gr100,gr100,gr108
+	jmp	Lstore
+	 mtsr	cr,gr118
+L5:	jmpfdec	gr117,L6
+	 subc	gr101,gr101,gr109
+	jmp	Lstore
+	 mtsr	cr,gr118
+L6:	subc	gr102,gr102,gr110
+
+Lstore:	storem	0,0,gr96,lr2
+	subc	gr116,gr116,gr116	; gr116 = not(cy)
+
+Lend:	jmpi	lr0
+	 add	gr96,gr116,1
diff --git a/src/gmp/mpn/a29k/submul_1.s b/src/gmp/mpn/a29k/submul_1.s
new file mode 100644
index 000000000..ef97d8d4e
--- /dev/null
+++ b/src/gmp/mpn/a29k/submul_1.s
@@ -0,0 +1,116 @@
+; 29000 __gmpn_submul_1 -- Multiply a limb vector with a single limb and
+; subtract the product from a second limb vector.
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	lr2
+; s1_ptr	lr3
+; size		lr4
+; s2_limb	lr5
+
+	.cputype 29050
+	.sect .lit,lit
+	.text
+	.align	4
+	.global	___gmpn_submul_1
+	.word	0x60000
+___gmpn_submul_1:
+	sub	lr4,lr4,8
+	jmpt	lr4,Ltail
+	 const	gr120,0			; init cylimb reg
+
+	srl	gr117,lr4,3		; divide by 8
+	sub	gr117,gr117,1		; count for jmpfdec
+
+Loop:	mtsrim	cr,(8-1)
+	loadm	0,0,gr96,lr3
+	add	lr3,lr3,32
+
+	multiplu gr104,gr96,lr5
+	multmu	 gr96,gr96,lr5
+	multiplu gr105,gr97,lr5
+	multmu	 gr97,gr97,lr5
+	multiplu gr106,gr98,lr5
+	multmu	 gr98,gr98,lr5
+	multiplu gr107,gr99,lr5
+	multmu	 gr99,gr99,lr5
+	multiplu gr108,gr100,lr5
+	multmu	 gr100,gr100,lr5
+	multiplu gr109,gr101,lr5
+	multmu	 gr101,gr101,lr5
+	multiplu gr110,gr102,lr5
+	multmu	 gr102,gr102,lr5
+	multiplu gr111,gr103,lr5
+	multmu	 gr103,gr103,lr5
+
+	add	gr104,gr104,gr120
+	addc	gr105,gr105,gr96
+	addc	gr106,gr106,gr97
+	addc	gr107,gr107,gr98
+	addc	gr108,gr108,gr99
+	addc	gr109,gr109,gr100
+	addc	gr110,gr110,gr101
+	addc	gr111,gr111,gr102
+	addc	gr120,gr103,0
+
+	mtsrim	cr,(8-1)
+	loadm	0,0,gr96,lr2
+
+	sub	gr96,gr96,gr104
+	subc	gr97,gr97,gr105
+	subc	gr98,gr98,gr106
+	subc	gr99,gr99,gr107
+	subc	gr100,gr100,gr108
+	subc	gr101,gr101,gr109
+	subc	gr102,gr102,gr110
+	subc	gr103,gr103,gr111
+
+	add	gr104,gr103,gr111	; invert carry from previus sub
+	addc	gr120,gr120,0
+
+	mtsrim	cr,(8-1)
+	storem	0,0,gr96,lr2
+	jmpfdec	gr117,Loop
+	 add	lr2,lr2,32
+
+Ltail:	and	lr4,lr4,(8-1)
+	sub	gr118,lr4,1		; count for CR
+	jmpt	gr118,Lend
+	 sub	lr4,lr4,2
+	sub	lr2,lr2,4		; offset res_ptr by one limb
+
+Loop2:	load	0,0,gr116,lr3
+	add	lr3,lr3,4
+	multiplu gr117,gr116,lr5
+	multmu	gr118,gr116,lr5
+	add	lr2,lr2,4
+	load	0,0,gr119,lr2
+	add	gr117,gr117,gr120
+	addc	gr118,gr118,0
+	sub	gr119,gr119,gr117
+	add	gr104,gr119,gr117	; invert carry from previus sub
+	store	0,0,gr119,lr2
+	jmpfdec	lr4,Loop2
+	 addc	gr120,gr118,0
+
+Lend:	jmpi	lr0
+	 or	gr96,gr120,0		; copy
diff --git a/src/gmp/mpn/a29k/udiv.s b/src/gmp/mpn/a29k/udiv.s
new file mode 100644
index 000000000..fdd53a9a8
--- /dev/null
+++ b/src/gmp/mpn/a29k/udiv.s
@@ -0,0 +1,30 @@
+; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+	.sect .lit,lit
+	.text
+	.align 4
+	.global ___udiv_qrnnd
+	.word 0x60000
+___udiv_qrnnd:
+	mtsr q,lr3
+	dividu gr96,lr4,lr5
+	mfsr gr116,q
+	jmpi lr0
+	store 0,0,gr116,lr2
diff --git a/src/gmp/mpn/a29k/umul.s b/src/gmp/mpn/a29k/umul.s
new file mode 100644
index 000000000..774198116
--- /dev/null
+++ b/src/gmp/mpn/a29k/umul.s
@@ -0,0 +1,29 @@
+; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+	.sect .lit,lit
+	.text
+	.align 4
+	.global ___umul_ppmm
+	.word 0x50000
+___umul_ppmm:
+	multiplu gr116,lr3,lr4
+	multmu gr96,lr3,lr4
+	jmpi lr0
+	store 0,0,gr116,lr2
diff --git a/src/gmp/mpn/alpha/README b/src/gmp/mpn/alpha/README
new file mode 100644
index 000000000..744260c7c
--- /dev/null
+++ b/src/gmp/mpn/alpha/README
@@ -0,0 +1,224 @@
+This directory contains mpn functions optimized for DEC Alpha processors.
+
+ALPHA ASSEMBLY RULES AND REGULATIONS
+
+The `.prologue N' pseudo op marks the end of instruction that needs
+special handling by unwinding.  It also says whether $27 is really
+needed for computing the gp.  The `.mask M' pseudo op says which
+registers are saved on the stack, and at what offset in the frame.
+
+Cray code is very very different...
+
+
+RELEVANT OPTIMIZATION ISSUES
+
+EV4
+
+1. This chip has very limited store bandwidth.  The on-chip L1 cache is
+   write-through, and a cache line is transfered from the store buffer to
+   the off-chip L2 in as much 15 cycles on most systems.  This delay hurts
+   mpn_add_n, mpn_sub_n, mpn_lshift, and mpn_rshift.
+
+2. Pairing is possible between memory instructions and integer arithmetic
+   instructions.
+
+3. mulq and umulh are documented to have a latency of 23 cycles, but 2 of
+   these cycles are pipelined.  Thus, multiply instructions can be issued at
+   a rate of one each 21st cycle.
+
+EV5
+
+1. The memory bandwidth of this chip seems excellent, both for loads and
+   stores.  Even when the working set is larger than the on-chip L1 and L2
+   caches, the performance remain almost unaffected.
+
+2. mulq has a latency of 12 cycles and an issue rate of 1 each 8th cycle.
+   umulh has a measured latency of 14 cycles and an issue rate of 1 each
+   10th cycle.  But the exact timing is somewhat confusing.
+
+3. mpn_add_n.  With 4-fold unrolling, we need 37 instructions, whereof 12
+   are memory operations.  This will take at least
+	ceil(37/2) [dual issue] + 1 [taken branch] = 19 cycles
+   We have 12 memory cycles, plus 4 after-store conflict cycles, or 16 data
+   cache cycles, which should be completely hidden in the 19 issue cycles.
+   The computation is inherently serial, with these dependencies:
+
+	       ldq  ldq
+		 \  /\
+	  (or)   addq |
+	   |\   /   \ |
+	   | addq  cmpult
+	    \  |     |
+	     cmpult  |
+		 \  /
+		  or
+
+   I.e., 3 operations are needed between carry-in and carry-out, making 12
+   cycles the absolute minimum for the 4 limbs.  We could replace the `or'
+   with a cmoveq/cmovne, which could issue one cycle earlier that the `or',
+   but that might waste a cycle on EV4.  The total depth remain unaffected,
+   since cmov has a latency of 2 cycles.
+
+     addq
+     /   \
+   addq  cmpult
+     |      \
+   cmpult -> cmovne
+
+Montgomery has a slightly different way of computing carry that requires one
+less instruction, but has depth 4 (instead of the current 3).  Since the
+code is currently instruction issue bound, Montgomery's idea should save us
+1/2 cycle per limb, or bring us down to a total of 17 cycles or 4.25
+cycles/limb.  Unfortunately, this method will not be good for the EV6.
+
+EV6
+
+Here we have a really parallel pipeline, capable of issuing up to 4 integer
+instructions per cycle.  One integer multiply instruction can issue each
+cycle.  To get optimal speed, we need to pretend we are vectorizing the code,
+i.e., minimize the iterative dependencies.
+
+There are two dependencies to watch out for.  1) Address arithmetic
+dependencies, and 2) carry propagation dependencies.
+
+We can avoid serializing due to address arithmetic by unrolling the loop, so
+that addresses don't depend heavily on an index variable.  Avoiding
+serializing because of carry propagation is trickier; the ultimate performance
+of the code will be determined of the number of latency cycles it takes from
+accepting carry-in to a vector point until we can generate carry-out.
+
+Most integer instructions can execute in either the L0, U0, L1, or U1
+pipelines.  Shifts only execute in U0 and U1, and multiply only in U1.
+
+CMOV instructions split into two internal instructions, CMOV1 and CMOV2, but
+the execute efficiently.  But CMOV split the mapping process (see pg 2-26 in
+cmpwrgd.pdf), suggesting the CMOV should always be placed as the last
+instruction of an aligned 4 instruction block (?).
+
+Perhaps the most important issue is the latency between the L0/U0 and L1/U1
+clusters; a result obtained on either cluster has an extra cycle of latency
+for consumers in the opposite cluster.  Because of the dynamic nature of the
+implementation, it is hard to predict where an instruction will execute.
+
+The shift loops need (per limb):
+    1 load (Lx pipes)
+    1 store (Lx pipes)
+    2 shift (Ux pipes)
+    1 iaddlog (Lx pipes, Ux pipes)
+Obviously, since the pipes are very equally loaded, we should get 4 insn/cycle, or 1.25 cycles/limb.
+
+For mpn_add_n, we currently have
+    2 load (Lx pipes)
+    1 store (Lx pipes)
+    5 iaddlog (Lx pipes, Ux pipes)
+
+Again, we have a perfect balance and will be limited by carry propagation
+delays, currently three cycles.  The superoptimizer indicates that ther
+might be sequences that--using a final cmov--have a carry propagation delay
+of just two.  Montgomery's subtraction sequence could perhaps be used, by
+complementing some operands.  All in all, we should get down to 2 cycles
+without much problems.
+
+For mpn_mul_1, we could do, just like for mpn_add_n:
+    not		newlo,notnewlo
+    addq	cylimb,newlo,newlo  ||    cmpult	cylimb,notnewlo,cyout
+    addq	cyout,newhi,cylimb
+and get 2-cycle carry propagation.  The instructions needed will be
+    1 ld (Lx pipes)
+    1 st (Lx pipes)
+    2 mul (U1 pipe)
+    4 iaddlog (Lx pipes, Ux pipes)
+issue1: addq not mul ld
+issue2: cmpult addq mul st
+Conclusion: no cluster delays and 2-cycle carry delays will give us 2 cycles/limb!
+
+Last, we have mpn_addmul_1.  Almost certainly, we will get down to 3
+cycles/limb, which would be absolutely awesome.
+
+Old, perhaps obsolete addmul_1 dependency diagram (needs 175 columns wide screen):
+
+   i  
+   s
+   s  i
+   u  n
+   e  s
+   d  t
+      r
+   i  u
+l  n  c
+i  s  t
+v  t  i
+e  r  o
+   u  n
+v  c	
+a  t  t
+l  i  y
+u  o  p
+e  n  e
+s  s  s
+        issue
+         in
+        cycle
+         -1     ldq
+               /    \
+          0   |      \
+              |       \
+          1   |        |
+              |        |
+          2   |        |                   ldq
+              |        |                  /    \
+          3   |       mulq               |      \
+              |           \              |       \
+          4  umulh         \             |        |
+               |            |            |        |
+          5    |            |            |        |                   ldq
+               |            |            |        |                  /    \
+    4calm 6    |            |   ldq      |       mulq               |      \
+               |            |  /         |           \              |       \
+    4casm 7    |            | /         umulh         \             |        |
+6              |            ||            |            |            |        |
+    3aal  8    |            ||            |            |            |        |                   ldq
+7              |            ||            |            |            |        |                  /    \
+    4calm 9    |            ||            |            |   ldq      |       mulq               |      \
+9              |            ||            |            |  /         |           \              |       \
+    4casm 10   |            ||            |            | /         umulh         \             |        |
+9              |            ||            |            ||            |            |            |        |
+    3aal  11   |           addq           |            ||            |            |            |        |                   ldq
+9              |          //   \          |            ||            |            |            |        |                  /    \
+    4calm 12    \     cmpult    addq<-cy  |            ||            |            |   ldq      |       mulq               |      \
+13               \    /       //   \      |            ||            |            |  /         |           \              |       \
+    4casm 13      addq   cmpult     stq   |            ||            |            | /         umulh         \             |        |
+11                    \  /                |            ||            |            ||            |            |            |        |
+    3aal  14          addq                |           addq           |            ||            |            |            |        |                   ldq
+10                        \               |          //   \          |            ||            |            |            |        |                  /    \
+    4calm 15                cy ---->       \     cmpult    addq<-cy  |            ||            |            |   ldq      |       mulq               |      \
+13                                          \    /       //   \      |            ||            |            |  /         |           \              |       \
+    4casm 16                                 addq   cmpult     stq   |            ||            |            | /         umulh         \             |        |
+11                                               \  /                |            ||            |            ||            |            |            |        |
+    3aal  17                                     addq                |           addq           |            ||            |            |            |        |
+10                                                   \               |          //   \          |            ||            |            |            |        |
+    4calm 18                                           cy ---->       \     cmpult    addq<-cy  |            ||            |            |   ldq      |       mulq
+13                                                                     \    /       //   \      |            ||            |            |  /         |           \
+    4casm 19                                                            addq   cmpult     stq   |            ||            |            | /         umulh         \
+11                                                                          \  /                |            ||            |            ||            |            |
+    3aal  20                                                                addq                |           addq           |            ||            |            |
+10                                                                              \               |          //   \          |            ||            |            |
+    4calm 21                                                                      cy ---->       \     cmpult    addq<-cy  |            ||            |            |   ldq
+                                                                                                  \    /       //   \      |            ||            |            |  /
+          22                                                                                       addq   cmpult     stq   |            ||            |            | /
+                                                                                                       \  /                |            ||            |            ||
+          23                                                                                           addq                |           addq           |            ||
+                                                                                                           \               |          //   \          |            ||
+          24                                                                                                 cy ---->       \     cmpult    addq<-cy  |            ||
+                                                                                                                             \    /       //   \      |            ||
+          25                                                                                                                  addq   cmpult     stq   |            ||
+                                                                                                                                  \  /                |            ||
+          26                                                                                                                      addq                |           addq
+                                                                                                                                      \               |          //   \
+          27                                                                                                                            cy ---->       \     cmpult    addq<-cy
+                                                                                                                                                        \    /       //   \
+          28                                                                                                                                             addq   cmpult     stq
+                                                                                                                                                             \  /
+As many as 6 consecutive points will be under execution simultaneously, or if we                                                                             addq
+schedule loads even further away, maybe 7 or 8.  But the number of live quantities                                                                               \
+is reasonable, and can easily be satisfied.                                                                                                                        cy ---->    
diff --git a/src/gmp/mpn/alpha/add_n.asm b/src/gmp/mpn/alpha/add_n.asm
new file mode 100644
index 000000000..08d6a9f7b
--- /dev/null
+++ b/src/gmp/mpn/alpha/add_n.asm
@@ -0,0 +1,114 @@
+dnl  Alpha mpn_add_n -- Add two limb vectors of the same length > 0 and
+dnl  store sum in a third limb vector.
+
+dnl  Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  s2_ptr	r18
+dnl  size	r19
+
+ASM_START()
+PROLOGUE(mpn_add_n)
+	ldq	r3,0(r17)
+	ldq	r4,0(r18)
+
+	subq	r19,1,r19
+	and	r19,4-1,r2	C number of limbs in first loop
+	bis	r31,r31,r0
+	beq	r2,$L0		C if multiple of 4 limbs, skip first loop
+
+	subq	r19,r2,r19
+
+$Loop0:	subq	r2,1,r2
+	ldq	r5,8(r17)
+	addq	r4,r0,r4
+	ldq	r6,8(r18)
+	cmpult	r4,r0,r1
+	addq	r3,r4,r4
+	cmpult	r4,r3,r0
+	stq	r4,0(r16)
+	bis	r0,r1,r0
+
+	addq	r17,8,r17
+	addq	r18,8,r18
+	bis	r5,r5,r3
+	bis	r6,r6,r4
+	addq	r16,8,r16
+	bne	r2,$Loop0
+
+$L0:	beq	r19,$Lend
+
+	ALIGN(8)
+$Loop:	subq	r19,4,r19
+
+	ldq	r5,8(r17)
+	addq	r4,r0,r4
+	ldq	r6,8(r18)
+	cmpult	r4,r0,r1
+	addq	r3,r4,r4
+	cmpult	r4,r3,r0
+	stq	r4,0(r16)
+	bis	r0,r1,r0
+
+	ldq	r3,16(r17)
+	addq	r6,r0,r6
+	ldq	r4,16(r18)
+	cmpult	r6,r0,r1
+	addq	r5,r6,r6
+	cmpult	r6,r5,r0
+	stq	r6,8(r16)
+	bis	r0,r1,r0
+
+	ldq	r5,24(r17)
+	addq	r4,r0,r4
+	ldq	r6,24(r18)
+	cmpult	r4,r0,r1
+	addq	r3,r4,r4
+	cmpult	r4,r3,r0
+	stq	r4,16(r16)
+	bis	r0,r1,r0
+
+	ldq	r3,32(r17)
+	addq	r6,r0,r6
+	ldq	r4,32(r18)
+	cmpult	r6,r0,r1
+	addq	r5,r6,r6
+	cmpult	r6,r5,r0
+	stq	r6,24(r16)
+	bis	r0,r1,r0
+
+	addq	r17,32,r17
+	addq	r18,32,r18
+	addq	r16,32,r16
+	bne	r19,$Loop
+
+$Lend:	addq	r4,r0,r4
+	cmpult	r4,r0,r1
+	addq	r3,r4,r4
+	cmpult	r4,r3,r0
+	stq	r4,0(r16)
+	bis	r0,r1,r0
+	ret	r31,(r26),1
+EPILOGUE(mpn_add_n)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/addmul_1.asm b/src/gmp/mpn/alpha/addmul_1.asm
new file mode 100644
index 000000000..4ea900be6
--- /dev/null
+++ b/src/gmp/mpn/alpha/addmul_1.asm
@@ -0,0 +1,87 @@
+dnl Alpha __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
+dnl the result to a second limb vector.
+
+dnl  Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  size	r18
+dnl  s2_limb	r19
+
+dnl  This code runs at 42 cycles/limb on EV4, 18 cycles/limb on EV5, and 7
+dnl  cycles/limb on EV6.
+
+ASM_START()
+PROLOGUE(mpn_addmul_1)
+	ldq	r2,0(r17)	C r2 = s1_limb
+	addq	r17,8,r17	C s1_ptr++
+	subq	r18,1,r18	C size--
+	mulq	r2,r19,r3	C r3 = prod_low
+	ldq	r5,0(r16)	C r5 = *res_ptr
+	umulh	r2,r19,r0	C r0 = prod_high
+	beq	r18,$Lend1	C jump if size was == 1
+	ldq	r2,0(r17)	C r2 = s1_limb
+	addq	r17,8,r17	C s1_ptr++
+	subq	r18,1,r18	C size--
+	addq	r5,r3,r3
+	cmpult	r3,r5,r4
+	stq	r3,0(r16)
+	addq	r16,8,r16	C res_ptr++
+	beq	r18,$Lend2	C jump if size was == 2
+
+	ALIGN(8)
+$Loop:	mulq	r2,r19,r3	C r3 = prod_low
+	ldq	r5,0(r16)	C r5 = *res_ptr
+	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
+	subq	r18,1,r18	C size--
+	umulh	r2,r19,r4	C r4 = cy_limb
+	ldq	r2,0(r17)	C r2 = s1_limb
+	addq	r17,8,r17	C s1_ptr++
+	addq	r3,r0,r3	C r3 = cy_limb + prod_low
+	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
+	addq	r5,r3,r3
+	cmpult	r3,r5,r5
+	stq	r3,0(r16)
+	addq	r16,8,r16	C res_ptr++
+	addq	r5,r0,r0	C combine carries
+	bne	r18,$Loop
+
+$Lend2:	mulq	r2,r19,r3	C r3 = prod_low
+	ldq	r5,0(r16)	C r5 = *res_ptr
+	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
+	umulh	r2,r19,r4	C r4 = cy_limb
+	addq	r3,r0,r3	C r3 = cy_limb + prod_low
+	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
+	addq	r5,r3,r3
+	cmpult	r3,r5,r5
+	stq	r3,0(r16)
+	addq	r5,r0,r0	C combine carries
+	addq	r4,r0,r0	C cy_limb = prod_high + cy
+	ret	r31,(r26),1
+$Lend1:	addq	r5,r3,r3
+	cmpult	r3,r5,r5
+	stq	r3,0(r16)
+	addq	r0,r5,r0
+	ret	r31,(r26),1
+EPILOGUE(mpn_addmul_1)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/cntlz.asm b/src/gmp/mpn/alpha/cntlz.asm
new file mode 100644
index 000000000..febb3b70d
--- /dev/null
+++ b/src/gmp/mpn/alpha/cntlz.asm
@@ -0,0 +1,68 @@
+dnl  Alpha auxiliary for longlong.h's count_leading_zeros
+
+dnl  Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  DISCUSSION:
+
+dnl  Other methods have been tried, and using a 128-entry table actually trims
+dnl  about 10% of the execution time (on a 21164) when the table is in the L1
+dnl  cache.  But under non-benchmarking conditions, the table will hardly be in
+dnl  the L1 cache.  Tricky bit-fiddling methods with multiplies and magic tables
+dnl  are also possible, but they require many more instructions than the current
+dnl  code.  (But for count_trailing_zeros, such tricks are beneficial.)
+dnl  Finally, converting to floating-point and extracting the exponent is much
+dnl  slower.
+
+ASM_START()
+PROLOGUE(MPN(count_leading_zeros))
+	bis	r31,63,r0		C initialize partial result count
+
+	srl	r16,32,r1		C shift down 32 steps -> r1
+	cmovne	r1,r1,r16		C select r1 if non-zero
+	cmovne	r1,31,r0		C if r1 is nonzero choose smaller count
+
+	srl	r16,16,r1		C shift down 16 steps -> r1
+	subq	r0,16,r2		C generate new partial result count
+	cmovne	r1,r1,r16		C choose new r1 if non-zero
+	cmovne	r1,r2,r0		C choose new count if r1 was non-zero
+
+	srl	r16,8,r1
+	subq	r0,8,r2
+	cmovne	r1,r1,r16
+	cmovne	r1,r2,r0
+
+	srl	r16,4,r1
+	subq	r0,4,r2
+	cmovne	r1,r1,r16
+	cmovne	r1,r2,r0
+
+	srl	r16,2,r1
+	subq	r0,2,r2
+	cmovne	r1,r1,r16
+	cmovne	r1,r2,r0
+
+	srl	r16,1,r1		C extract bit 1
+	subq	r0,r1,r0		C subtract it from partial result
+
+	ret	r31,(r26),1
+EPILOGUE(MPN(count_leading_zeros))
+ASM_END()
diff --git a/src/gmp/mpn/alpha/default.m4 b/src/gmp/mpn/alpha/default.m4
new file mode 100644
index 000000000..5f4c48dc7
--- /dev/null
+++ b/src/gmp/mpn/alpha/default.m4
@@ -0,0 +1,77 @@
+divert(-1)
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+define(`ASM_START',
+	`
+	.set noreorder
+	.set noat')
+
+define(`X',`0x$1')
+define(`FLOAT64',
+	`
+	.align	3
+$1:	.t_floating $2')
+
+define(`PROLOGUE',
+	`
+	.text
+	.align	3
+	.globl	$1
+	.ent	$1
+$1:
+	.frame r30,0,r26
+	.prologue 0')
+
+define(`PROLOGUE_GP',
+	`
+	.text
+	.align	3
+	.globl	$1
+	.ent	$1
+$1:
+	ldgp	r29,0(r27)
+	.frame	r30,0,r26
+	.prologue 1')
+
+define(`EPILOGUE',
+	`
+	.end	$1')
+
+dnl Map register names r0, r1, etc, to `$0', `$1', etc.
+dnl This is needed on all systems but Unicos
+forloop(i,0,31,
+`define(`r'i,``$''i)'
+)
+forloop(i,0,31,
+`define(`f'i,``$f''i)'
+)
+
+define(`DATASTART',
+	`dnl
+	DATA
+$1:')
+define(`DATAEND',`dnl')
+
+define(`ASM_END',`dnl')
+
+divert
diff --git a/src/gmp/mpn/alpha/ev5/add_n.asm b/src/gmp/mpn/alpha/ev5/add_n.asm
new file mode 100644
index 000000000..716d6404a
--- /dev/null
+++ b/src/gmp/mpn/alpha/ev5/add_n.asm
@@ -0,0 +1,143 @@
+dnl  Alpha EV5 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
+dnl  store sum in a third limb vector.
+
+dnl  Copyright (C) 1995, 1999, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  s2_ptr	r18
+dnl  size	r19
+
+ASM_START()
+PROLOGUE(mpn_add_n)
+	bis	r31,r31,r25		C clear cy
+	subq	r19,4,r19		C decr loop cnt
+	blt	r19,$Lend2		C if less than 4 limbs, goto 2nd loop
+C Start software pipeline for 1st loop
+	ldq	r0,0(r18)
+	ldq	r4,0(r17)
+	ldq	r1,8(r18)
+	ldq	r5,8(r17)
+	addq	r17,32,r17		C update s1_ptr
+	ldq	r2,16(r18)
+	addq	r0,r4,r20		C 1st main add
+	ldq	r3,24(r18)
+	subq	r19,4,r19		C decr loop cnt
+	ldq	r6,-16(r17)
+	cmpult	r20,r0,r25		C compute cy from last add
+	ldq	r7,-8(r17)
+	addq	r1,r5,r28		C 2nd main add
+	addq	r18,32,r18		C update s2_ptr
+	addq	r28,r25,r21		C 2nd carry add
+	cmpult	r28,r5,r8		C compute cy from last add
+	blt	r19,$Lend1		C if less than 4 limbs remain, jump
+C 1st loop handles groups of 4 limbs in a software pipeline
+	ALIGN(16)
+$Loop:	cmpult	r21,r28,r25		C compute cy from last add
+	ldq	r0,0(r18)
+	bis	r8,r25,r25		C combine cy from the two adds
+	ldq	r1,8(r18)
+	addq	r2,r6,r28		C 3rd main add
+	ldq	r4,0(r17)
+	addq	r28,r25,r22		C 3rd carry add
+	ldq	r5,8(r17)
+	cmpult	r28,r6,r8		C compute cy from last add
+	cmpult	r22,r28,r25		C compute cy from last add
+	stq	r20,0(r16)
+	bis	r8,r25,r25		C combine cy from the two adds
+	stq	r21,8(r16)
+	addq	r3,r7,r28		C 4th main add
+	addq	r28,r25,r23		C 4th carry add
+	cmpult	r28,r7,r8		C compute cy from last add
+	cmpult	r23,r28,r25		C compute cy from last add
+		addq	r17,32,r17		C update s1_ptr
+	bis	r8,r25,r25		C combine cy from the two adds
+		addq	r16,32,r16		C update res_ptr
+	addq	r0,r4,r28		C 1st main add
+	ldq	r2,16(r18)
+	addq	r25,r28,r20		C 1st carry add
+	ldq	r3,24(r18)
+	cmpult	r28,r4,r8		C compute cy from last add
+	ldq	r6,-16(r17)
+	cmpult	r20,r28,r25		C compute cy from last add
+	ldq	r7,-8(r17)
+	bis	r8,r25,r25		C combine cy from the two adds
+	subq	r19,4,r19		C decr loop cnt
+	stq	r22,-16(r16)
+	addq	r1,r5,r28		C 2nd main add
+	stq	r23,-8(r16)
+	addq	r25,r28,r21		C 2nd carry add
+		addq	r18,32,r18		C update s2_ptr
+	cmpult	r28,r5,r8		C compute cy from last add
+	bge	r19,$Loop
+C Finish software pipeline for 1st loop
+$Lend1:	cmpult	r21,r28,r25		C compute cy from last add
+	bis	r8,r25,r25		C combine cy from the two adds
+	addq	r2,r6,r28		C 3rd main add
+	addq	r28,r25,r22		C 3rd carry add
+	cmpult	r28,r6,r8		C compute cy from last add
+	cmpult	r22,r28,r25		C compute cy from last add
+	stq	r20,0(r16)
+	bis	r8,r25,r25		C combine cy from the two adds
+	stq	r21,8(r16)
+	addq	r3,r7,r28		C 4th main add
+	addq	r28,r25,r23		C 4th carry add
+	cmpult	r28,r7,r8		C compute cy from last add
+	cmpult	r23,r28,r25		C compute cy from last add
+	bis	r8,r25,r25		C combine cy from the two adds
+	addq	r16,32,r16		C update res_ptr
+	stq	r22,-16(r16)
+	stq	r23,-8(r16)
+$Lend2:	addq	r19,4,r19		C restore loop cnt
+	beq	r19,$Lret
+C Start software pipeline for 2nd loop
+	ldq	r0,0(r18)
+	ldq	r4,0(r17)
+	subq	r19,1,r19
+	beq	r19,$Lend0
+C 2nd loop handles remaining 1-3 limbs
+	ALIGN(16)
+$Loop0:	addq	r0,r4,r28		C main add
+	ldq	r0,8(r18)
+	cmpult	r28,r4,r8		C compute cy from last add
+	ldq	r4,8(r17)
+	addq	r28,r25,r20		C carry add
+	addq	r18,8,r18
+	addq	r17,8,r17
+	stq	r20,0(r16)
+	cmpult	r20,r28,r25		C compute cy from last add
+	subq	r19,1,r19		C decr loop cnt
+	bis	r8,r25,r25		C combine cy from the two adds
+	addq	r16,8,r16
+	bne	r19,$Loop0
+$Lend0:	addq	r0,r4,r28		C main add
+	addq	r28,r25,r20		C carry add
+	cmpult	r28,r4,r8		C compute cy from last add
+	cmpult	r20,r28,r25		C compute cy from last add
+	stq	r20,0(r16)
+	bis	r8,r25,r25		C combine cy from the two adds
+
+$Lret:	bis	r25,r31,r0		C return cy
+	ret	r31,(r26),1
+EPILOGUE(mpn_add_n)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/ev5/lshift.asm b/src/gmp/mpn/alpha/ev5/lshift.asm
new file mode 100644
index 000000000..cb181dda6
--- /dev/null
+++ b/src/gmp/mpn/alpha/ev5/lshift.asm
@@ -0,0 +1,169 @@
+dnl  Alpha EV5 __gmpn_lshift -- Shift a number left.
+
+dnl  Copyright (C) 1994, 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  size	r18
+dnl  cnt	r19
+
+dnl  This code runs at 3.25 cycles/limb on the EV5.
+
+ASM_START()
+PROLOGUE(mpn_lshift)
+	s8addq	r18,r17,r17	C make r17 point at end of s1
+	ldq	r4,-8(r17)	C load first limb
+	subq	r31,r19,r20
+	s8addq	r18,r16,r16	C make r16 point at end of RES
+	subq	r18,1,r18
+	and	r18,4-1,r28	C number of limbs in first loop
+	srl	r4,r20,r0	C compute function result
+
+	beq	r28,$L0
+	subq	r18,r28,r18
+
+	ALIGN(8)
+$Loop0:	ldq	r3,-16(r17)
+	subq	r16,8,r16
+	sll	r4,r19,r5
+	subq	r17,8,r17
+	subq	r28,1,r28
+	srl	r3,r20,r6
+	bis	r3,r3,r4
+	bis	r5,r6,r8
+	stq	r8,0(r16)
+	bne	r28,$Loop0
+
+$L0:	sll	r4,r19,r24
+	beq	r18,$Lend
+C warm up phase 1
+	ldq	r1,-16(r17)
+	subq	r18,4,r18
+	ldq	r2,-24(r17)
+	ldq	r3,-32(r17)
+	ldq	r4,-40(r17)
+	beq	r18,$Lend1
+C warm up phase 2
+	srl	r1,r20,r7
+	sll	r1,r19,r21
+	srl	r2,r20,r8
+	ldq	r1,-48(r17)
+	sll	r2,r19,r22
+	ldq	r2,-56(r17)
+	srl	r3,r20,r5
+	bis	r7,r24,r7
+	sll	r3,r19,r23
+	bis	r8,r21,r8
+	srl	r4,r20,r6
+	ldq	r3,-64(r17)
+	sll	r4,r19,r24
+	ldq	r4,-72(r17)
+	subq	r18,4,r18
+	beq	r18,$Lend2
+	ALIGN(16)
+C main loop
+$Loop:	stq	r7,-8(r16)
+	bis	r5,r22,r5
+	stq	r8,-16(r16)
+	bis	r6,r23,r6
+
+	srl	r1,r20,r7
+	subq	r18,4,r18
+	sll	r1,r19,r21
+	unop	C ldq	r31,-96(r17)
+
+	srl	r2,r20,r8
+	ldq	r1,-80(r17)
+	sll	r2,r19,r22
+	ldq	r2,-88(r17)
+
+	stq	r5,-24(r16)
+	bis	r7,r24,r7
+	stq	r6,-32(r16)
+	bis	r8,r21,r8
+
+	srl	r3,r20,r5
+	unop	C ldq	r31,-96(r17)
+	sll	r3,r19,r23
+	subq	r16,32,r16
+
+	srl	r4,r20,r6
+	ldq	r3,-96(r17)
+	sll	r4,r19,r24
+	ldq	r4,-104(r17)
+
+	subq	r17,32,r17
+	bne	r18,$Loop
+C cool down phase 2/1
+$Lend2:	stq	r7,-8(r16)
+	bis	r5,r22,r5
+	stq	r8,-16(r16)
+	bis	r6,r23,r6
+	srl	r1,r20,r7
+	sll	r1,r19,r21
+	srl	r2,r20,r8
+	sll	r2,r19,r22
+	stq	r5,-24(r16)
+	bis	r7,r24,r7
+	stq	r6,-32(r16)
+	bis	r8,r21,r8
+	srl	r3,r20,r5
+	sll	r3,r19,r23
+	srl	r4,r20,r6
+	sll	r4,r19,r24
+C cool down phase 2/2
+	stq	r7,-40(r16)
+	bis	r5,r22,r5
+	stq	r8,-48(r16)
+	bis	r6,r23,r6
+	stq	r5,-56(r16)
+	stq	r6,-64(r16)
+C cool down phase 2/3
+	stq	r24,-72(r16)
+	ret	r31,(r26),1
+
+C cool down phase 1/1
+$Lend1:	srl	r1,r20,r7
+	sll	r1,r19,r21
+	srl	r2,r20,r8
+	sll	r2,r19,r22
+	srl	r3,r20,r5
+	bis	r7,r24,r7
+	sll	r3,r19,r23
+	bis	r8,r21,r8
+	srl	r4,r20,r6
+	sll	r4,r19,r24
+C cool down phase 1/2
+	stq	r7,-8(r16)
+	bis	r5,r22,r5
+	stq	r8,-16(r16)
+	bis	r6,r23,r6
+	stq	r5,-24(r16)
+	stq	r6,-32(r16)
+	stq	r24,-40(r16)
+	ret	r31,(r26),1
+
+$Lend:	stq	r24,-8(r16)
+	ret	r31,(r26),1
+EPILOGUE(mpn_lshift)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/ev5/rshift.asm b/src/gmp/mpn/alpha/ev5/rshift.asm
new file mode 100644
index 000000000..9940d83fa
--- /dev/null
+++ b/src/gmp/mpn/alpha/ev5/rshift.asm
@@ -0,0 +1,167 @@
+dnl  Alpha EV5 __gmpn_rshift -- Shift a number right.
+
+dnl  Copyright (C) 1994, 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  size	r18
+dnl  cnt	r19
+
+dnl  This code runs at 3.25 cycles/limb on the EV5.
+
+ASM_START()
+PROLOGUE(mpn_rshift)
+	ldq	r4,0(r17)	C load first limb
+	subq	r31,r19,r20
+	subq	r18,1,r18
+	and	r18,4-1,r28	C number of limbs in first loop
+	sll	r4,r20,r0	C compute function result
+
+	beq	r28,$L0
+	subq	r18,r28,r18
+
+	ALIGN(8)
+$Loop0:	ldq	r3,8(r17)
+	addq	r16,8,r16
+	srl	r4,r19,r5
+	addq	r17,8,r17
+	subq	r28,1,r28
+	sll	r3,r20,r6
+	bis	r3,r3,r4
+	bis	r5,r6,r8
+	stq	r8,-8(r16)
+	bne	r28,$Loop0
+
+$L0:	srl	r4,r19,r24
+	beq	r18,$Lend
+C warm up phase 1
+	ldq	r1,8(r17)
+	subq	r18,4,r18
+	ldq	r2,16(r17)
+	ldq	r3,24(r17)
+	ldq	r4,32(r17)
+	beq	r18,$Lend1
+C warm up phase 2
+	sll	r1,r20,r7
+	srl	r1,r19,r21
+	sll	r2,r20,r8
+	ldq	r1,40(r17)
+	srl	r2,r19,r22
+	ldq	r2,48(r17)
+	sll	r3,r20,r5
+	bis	r7,r24,r7
+	srl	r3,r19,r23
+	bis	r8,r21,r8
+	sll	r4,r20,r6
+	ldq	r3,56(r17)
+	srl	r4,r19,r24
+	ldq	r4,64(r17)
+	subq	r18,4,r18
+	beq	r18,$Lend2
+	ALIGN(16)
+C main loop
+$Loop:	stq	r7,0(r16)
+	bis	r5,r22,r5
+	stq	r8,8(r16)
+	bis	r6,r23,r6
+
+	sll	r1,r20,r7
+	subq	r18,4,r18
+	srl	r1,r19,r21
+	unop	C ldq	r31,-96(r17)
+
+	sll	r2,r20,r8
+	ldq	r1,72(r17)
+	srl	r2,r19,r22
+	ldq	r2,80(r17)
+
+	stq	r5,16(r16)
+	bis	r7,r24,r7
+	stq	r6,24(r16)
+	bis	r8,r21,r8
+
+	sll	r3,r20,r5
+	unop	C ldq	r31,-96(r17)
+	srl	r3,r19,r23
+	addq	r16,32,r16
+
+	sll	r4,r20,r6
+	ldq	r3,88(r17)
+	srl	r4,r19,r24
+	ldq	r4,96(r17)
+
+	addq	r17,32,r17
+	bne	r18,$Loop
+C cool down phase 2/1
+$Lend2:	stq	r7,0(r16)
+	bis	r5,r22,r5
+	stq	r8,8(r16)
+	bis	r6,r23,r6
+	sll	r1,r20,r7
+	srl	r1,r19,r21
+	sll	r2,r20,r8
+	srl	r2,r19,r22
+	stq	r5,16(r16)
+	bis	r7,r24,r7
+	stq	r6,24(r16)
+	bis	r8,r21,r8
+	sll	r3,r20,r5
+	srl	r3,r19,r23
+	sll	r4,r20,r6
+	srl	r4,r19,r24
+C cool down phase 2/2
+	stq	r7,32(r16)
+	bis	r5,r22,r5
+	stq	r8,40(r16)
+	bis	r6,r23,r6
+	stq	r5,48(r16)
+	stq	r6,56(r16)
+C cool down phase 2/3
+	stq	r24,64(r16)
+	ret	r31,(r26),1
+
+C cool down phase 1/1
+$Lend1:	sll	r1,r20,r7
+	srl	r1,r19,r21
+	sll	r2,r20,r8
+	srl	r2,r19,r22
+	sll	r3,r20,r5
+	bis	r7,r24,r7
+	srl	r3,r19,r23
+	bis	r8,r21,r8
+	sll	r4,r20,r6
+	srl	r4,r19,r24
+C cool down phase 1/2
+	stq	r7,0(r16)
+	bis	r5,r22,r5
+	stq	r8,8(r16)
+	bis	r6,r23,r6
+	stq	r5,16(r16)
+	stq	r6,24(r16)
+	stq	r24,32(r16)
+	ret	r31,(r26),1
+
+$Lend:	stq	r24,0(r16)
+	ret	r31,(r26),1
+EPILOGUE(mpn_rshift)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/ev5/sub_n.asm b/src/gmp/mpn/alpha/ev5/sub_n.asm
new file mode 100644
index 000000000..5248a2aa3
--- /dev/null
+++ b/src/gmp/mpn/alpha/ev5/sub_n.asm
@@ -0,0 +1,143 @@
+dnl  Alpha EV5 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0
+dnl  and store difference in a third limb vector.
+
+dnl  Copyright (C) 1995, 1999, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  s2_ptr	r18
+dnl  size	r19
+
+ASM_START()
+PROLOGUE(mpn_sub_n)
+	bis	r31,r31,r25		C clear cy
+	subq	r19,4,r19		C decr loop cnt
+	blt	r19,$Lend2		C if less than 4 limbs, goto 2nd loop
+C Start software pipeline for 1st loop
+	ldq	r0,0(r18)
+	ldq	r4,0(r17)
+	ldq	r1,8(r18)
+	ldq	r5,8(r17)
+	addq	r17,32,r17		C update s1_ptr
+	ldq	r2,16(r18)
+	subq	r4,r0,r20		C 1st main subtract
+	ldq	r3,24(r18)
+	subq	r19,4,r19		C decr loop cnt
+	ldq	r6,-16(r17)
+	cmpult	r4,r0,r25		C compute cy from last subtract
+	ldq	r7,-8(r17)
+	subq	r5,r1,r28		C 2nd main subtract
+	addq	r18,32,r18		C update s2_ptr
+	subq	r28,r25,r21		C 2nd carry subtract
+	cmpult	r5,r1,r8		C compute cy from last subtract
+	blt	r19,$Lend1		C if less than 4 limbs remain, jump
+C 1st loop handles groups of 4 limbs in a software pipeline
+	ALIGN(16)
+$Loop:	cmpult	r28,r25,r25		C compute cy from last subtract
+	ldq	r0,0(r18)
+	bis	r8,r25,r25		C combine cy from the two subtracts
+	ldq	r1,8(r18)
+	subq	r6,r2,r28		C 3rd main subtract
+	ldq	r4,0(r17)
+	subq	r28,r25,r22		C 3rd carry subtract
+	ldq	r5,8(r17)
+	cmpult	r6,r2,r8		C compute cy from last subtract
+	cmpult	r28,r25,r25		C compute cy from last subtract
+	stq	r20,0(r16)
+	bis	r8,r25,r25		C combine cy from the two subtracts
+	stq	r21,8(r16)
+	subq	r7,r3,r28		C 4th main subtract
+	subq	r28,r25,r23		C 4th carry subtract
+	cmpult	r7,r3,r8		C compute cy from last subtract
+	cmpult	r28,r25,r25		C compute cy from last subtract
+		addq	r17,32,r17		C update s1_ptr
+	bis	r8,r25,r25		C combine cy from the two subtracts
+		addq	r16,32,r16		C update res_ptr
+	subq	r4,r0,r28		C 1st main subtract
+	ldq	r2,16(r18)
+	subq	r28,r25,r20		C 1st carry subtract
+	ldq	r3,24(r18)
+	cmpult	r4,r0,r8		C compute cy from last subtract
+	ldq	r6,-16(r17)
+	cmpult	r28,r25,r25		C compute cy from last subtract
+	ldq	r7,-8(r17)
+	bis	r8,r25,r25		C combine cy from the two subtracts
+	subq	r19,4,r19		C decr loop cnt
+	stq	r22,-16(r16)
+	subq	r5,r1,r28		C 2nd main subtract
+	stq	r23,-8(r16)
+	subq	r28,r25,r21		C 2nd carry subtract
+		addq	r18,32,r18		C update s2_ptr
+	cmpult	r5,r1,r8		C compute cy from last subtract
+	bge	r19,$Loop
+C Finish software pipeline for 1st loop
+$Lend1:	cmpult	r28,r25,r25		C compute cy from last subtract
+	bis	r8,r25,r25		C combine cy from the two subtracts
+	subq	r6,r2,r28		C cy add
+	subq	r28,r25,r22		C 3rd main subtract
+	cmpult	r6,r2,r8		C compute cy from last subtract
+	cmpult	r28,r25,r25		C compute cy from last subtract
+	stq	r20,0(r16)
+	bis	r8,r25,r25		C combine cy from the two subtracts
+	stq	r21,8(r16)
+	subq	r7,r3,r28		C cy add
+	subq	r28,r25,r23		C 4th main subtract
+	cmpult	r7,r3,r8		C compute cy from last subtract
+	cmpult	r28,r25,r25		C compute cy from last subtract
+	bis	r8,r25,r25		C combine cy from the two subtracts
+	addq	r16,32,r16		C update res_ptr
+	stq	r22,-16(r16)
+	stq	r23,-8(r16)
+$Lend2:	addq	r19,4,r19		C restore loop cnt
+	beq	r19,$Lret
+C Start software pipeline for 2nd loop
+	ldq	r0,0(r18)
+	ldq	r4,0(r17)
+	subq	r19,1,r19
+	beq	r19,$Lend0
+C 2nd loop handles remaining 1-3 limbs
+	ALIGN(16)
+$Loop0:	subq	r4,r0,r28		C main subtract
+	cmpult	r4,r0,r8		C compute cy from last subtract
+	ldq	r0,8(r18)
+	ldq	r4,8(r17)
+	subq	r28,r25,r20		C carry subtract
+	addq	r18,8,r18
+	addq	r17,8,r17
+	stq	r20,0(r16)
+	cmpult	r28,r25,r25		C compute cy from last subtract
+	subq	r19,1,r19		C decr loop cnt
+	bis	r8,r25,r25		C combine cy from the two subtracts
+	addq	r16,8,r16
+	bne	r19,$Loop0
+$Lend0:	subq	r4,r0,r28		C main subtract
+	subq	r28,r25,r20		C carry subtract
+	cmpult	r4,r0,r8		C compute cy from last subtract
+	cmpult	r28,r25,r25		C compute cy from last subtract
+	stq	r20,0(r16)
+	bis	r8,r25,r25		C combine cy from the two subtracts
+
+$Lret:	bis	r25,r31,r0		C return cy
+	ret	r31,(r26),1
+EPILOGUE(mpn_sub_n)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/ev6/addmul_1.asm b/src/gmp/mpn/alpha/ev6/addmul_1.asm
new file mode 100644
index 000000000..dde187cc6
--- /dev/null
+++ b/src/gmp/mpn/alpha/ev6/addmul_1.asm
@@ -0,0 +1,474 @@
+dnl Alpha ev6 mpn_addmul_1 -- Multiply a limb vector with a limb and add
+dnl the result to a second limb vector.
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  size	r18
+dnl  s2_limb	r19
+
+dnl  This code runs at 42 cycles/limb on EV4, 18 cycles/limb on EV5, and
+dnl  exactly 3.625 cycles/limb on EV6...
+
+dnl This code was written in close cooperation with ev6 pipeline expert
+dnl Steve Root (root@toober.hlo.dec.com).  Any errors are tege's fault, though.
+dnl
+dnl   Register usages for unrolled loop:
+dnl	  0-3     mul's
+dnl	  4-7     acc's
+dnl	  8-15    mul results
+dnl	  20,21   carry's
+dnl	  22,23   save for stores
+
+dnl   Sustains 8 mul-adds in 29 cycles in the unrolled inner loop.
+
+dnl   The stores can issue a cycle late so we have paired no-op's to 'catch'
+dnl   them, so that further disturbance to the schedule is damped.
+
+dnl   We couldn't pair the loads, because the entangled schedule of the
+dnl   carry's has to happen on one side {0} of the machine. Note, the total
+dnl   use of U0, and the total use of L0 (after attending to the stores).
+dnl   which is part of the reason why....
+
+dnl   This is a great schedule for the d_cache, a poor schedule for the
+dnl   b_cache. The lockup on U0 means that any stall can't be recovered
+dnl   from. Consider a ldq in L1.  say that load gets stalled because it
+dnl   collides with a fill from the b_Cache. On the next cycle, this load
+dnl   gets priority. If first looks at L0, and goes there. The instruction
+dnl   we intended for L0 gets to look at L1, which is NOT where we want
+dnl   it. It either stalls 1, because it can't go in L0, or goes there, and
+dnl   causes a further instruction to stall.
+
+dnl   So for b_cache, we're likely going to want to put one or more cycles
+dnl   back into the code! And, of course, put in prefetches. For the
+dnl   accumulator, lds, intent to modify.  For the multiplier, you might
+dnl   want ldq, evict next, if you're not wanting to use it again soon. Use
+dnl   256 ahead of present pointer value. At a place where we have an mt
+dnl   followed by a bookkeeping, put the bookkeeping in upper, and the
+dnl   prefetch into lower.
+
+dnl   Note, the usage of physical registers per cycle is smoothed off, as
+dnl   much as possible.
+
+dnl   Note, the ldq's and stq's are at the end of the quadpacks.  note, we'd
+dnl   like not to have a ldq or stq to preceded a conditional branch in a
+dnl   quadpack. The conditional branch moves the retire pointer one cycle
+dnl   later.
+
+dnl   Optimization notes:
+dnl   Callee-saves regs: r9 r10 r11 r12 r13 r14 r15 r26 ?r27?
+dnl   Reserved regs:	 r29 r30 r31
+dnl   Free caller-saves regs in unrolled code: r24 r25 r28
+dnl   We should swap some of the callee-saves regs for some of the free
+dnl   caller-saves regs, saving some overhead cycles.
+dnl   Most importantly, we should write fast code for the 0-7 case.
+dnl   The code we use there are for the 21164, and runs at 7 cycles/limb
+dnl   on the 21264.  Should not be hard, if we write specialized code for
+dnl   1-7 limbs (the one for 0 limbs should be straightforward).  We then just
+dnl   need a jump table indexed by the low 3 bits of the count argument.
+
+
+ASM_START()
+PROLOGUE(mpn_addmul_1)
+	cmpult	r18,	8,	r1
+	beq	r1,	$Large
+
+	ldq	r2,	0(r17)		C r2 = s1_limb
+	addq	r17,	8,	r17	C s1_ptr++
+	subq	r18,	1,	r18	C size--
+	mulq	r2,	r19,	r3	C r3 = prod_low
+	ldq	r5,	0(r16)		C r5 = *res_ptr
+	umulh	r2,	r19,	r0	C r0 = prod_high
+	beq	r18,	$Lend0b		C jump if size was == 1
+	ldq	r2,	0(r17)		C r2 = s1_limb
+	addq	r17,	8,	r17	C s1_ptr++
+	subq	r18,	1,	r18	C size--
+	addq	r5,	r3,	r3
+	cmpult	r3,	r5,	r4
+	stq	r3,	0(r16)
+	addq	r16,	8,	r16	C res_ptr++
+	beq	r18,	$Lend0a		C jump if size was == 2
+
+	ALIGN(8)
+$Loop0:	mulq	r2,	r19,	r3	C r3 = prod_low
+	ldq	r5,	0(r16)		C r5 = *res_ptr
+	addq	r4,	r0,	r0	C cy_limb = cy_limb + 'cy'
+	subq	r18,	1,	r18	C size--
+	umulh	r2,	r19,	r4	C r4 = cy_limb
+	ldq	r2,	0(r17)		C r2 = s1_limb
+	addq	r17,	8,	r17	C s1_ptr++
+	addq	r3,	r0,	r3	C r3 = cy_limb + prod_low
+	cmpult	r3,	r0,	r0	C r0 = carry from (cy_limb + prod_low)
+	addq	r5,	r3,	r3
+	cmpult	r3,	r5,	r5
+	stq	r3,	0(r16)
+	addq	r16,	8,	r16	C res_ptr++
+	addq	r5,	r0,	r0	C combine carries
+	bne	r18,	$Loop0
+$Lend0a:
+	mulq	r2,	r19,	r3	C r3 = prod_low
+	ldq	r5,	0(r16)		C r5 = *res_ptr
+	addq	r4,	r0,	r0	C cy_limb = cy_limb + 'cy'
+	umulh	r2,	r19,	r4	C r4 = cy_limb
+	addq	r3,	r0,	r3	C r3 = cy_limb + prod_low
+	cmpult	r3,	r0,	r0	C r0 = carry from (cy_limb + prod_low)
+	addq	r5,	r3,	r3
+	cmpult	r3,	r5,	r5
+	stq	r3,	0(r16)
+	addq	r5,	r0,	r0	C combine carries
+	addq	r4,	r0,	r0	C cy_limb = prod_high + cy
+	ret	r31,	(r26),	1
+$Lend0b:
+	addq	r5,	r3,	r3
+	cmpult	r3,	r5,	r5
+	stq	r3,	0(r16)
+	addq	r0,	r5,	r0
+	ret	r31,	(r26),	1
+
+$Large:
+	lda	$30,	-240($30)
+	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)
+
+	and	r18,	7,	r20	C count for the first loop, 0-7
+	srl	r18,	3,	r18	C count for unrolled loop
+	bis	r31,	r31,	r0
+	beq	r20,	$Lunroll
+	ldq	r2,	0(r17)		C r2 = s1_limb
+	addq	r17,	8,	r17	C s1_ptr++
+	subq	r20,	1,	r20	C size--
+	mulq	r2,	r19,	r3	C r3 = prod_low
+	ldq	r5,	0(r16)		C r5 = *res_ptr
+	umulh	r2,	r19,	r0	C r0 = prod_high
+	beq	r20,	$Lend1b		C jump if size was == 1
+	ldq	r2,	0(r17)		C r2 = s1_limb
+	addq	r17,	8,	r17	C s1_ptr++
+	subq	r20,	1,	r20	C size--
+	addq	r5,	r3,	r3
+	cmpult	r3,	r5,	r4
+	stq	r3,	0(r16)
+	addq	r16,	8,	r16	C res_ptr++
+	beq	r20,	$Lend1a		C jump if size was == 2
+
+	ALIGN(8)
+$Loop1:	mulq	r2,	r19,	r3	C r3 = prod_low
+	ldq	r5,	0(r16)		C r5 = *res_ptr
+	addq	r4,	r0,	r0	C cy_limb = cy_limb + 'cy'
+	subq	r20,	1,	r20	C size--
+	umulh	r2,	r19,	r4	C r4 = cy_limb
+	ldq	r2,	0(r17)		C r2 = s1_limb
+	addq	r17,	8,	r17	C s1_ptr++
+	addq	r3,	r0,	r3	C r3 = cy_limb + prod_low
+	cmpult	r3,	r0,	r0	C r0 = carry from (cy_limb + prod_low)
+	addq	r5,	r3,	r3
+	cmpult	r3,	r5,	r5
+	stq	r3,	0(r16)
+	addq	r16,	8,	r16	C res_ptr++
+	addq	r5,	r0,	r0	C combine carries
+	bne	r20,	$Loop1
+
+$Lend1a:
+	mulq	r2,	r19,	r3	C r3 = prod_low
+	ldq	r5,	0(r16)		C r5 = *res_ptr
+	addq	r4,	r0,	r0	C cy_limb = cy_limb + 'cy'
+	umulh	r2,	r19,	r4	C r4 = cy_limb
+	addq	r3,	r0,	r3	C r3 = cy_limb + prod_low
+	cmpult	r3,	r0,	r0	C r0 = carry from (cy_limb + prod_low)
+	addq	r5,	r3,	r3
+	cmpult	r3,	r5,	r5
+	stq	r3,	0(r16)
+	addq	r16,	8,	r16	C res_ptr++
+	addq	r5,	r0,	r0	C combine carries
+	addq	r4,	r0,	r0	C cy_limb = prod_high + cy
+	br	r31,	$Lunroll
+$Lend1b:
+	addq	r5,	r3,	r3
+	cmpult	r3,	r5,	r5
+	stq	r3,	0(r16)
+	addq	r16,	8,	r16	C res_ptr++
+	addq	r0,	r5,	r0
+
+$Lunroll:
+	lda	r17,	-16(r17)	C L1 bookkeeping
+	lda	r16,	-16(r16)	C L1 bookkeeping
+	bis	r0,	r31,	r12
+
+C ____ UNROLLED LOOP SOFTWARE PIPELINE STARTUP ____
+
+	ldq	r2,	16(r17)		C L1
+	ldq	r3,	24(r17)		C L1
+	lda	r18,	-1(r18)		C L1 bookkeeping
+	ldq	r6,	16(r16)		C L1
+	ldq	r7,	24(r16)		C L1
+	ldq	r0,	32(r17)		C L1
+	mulq	r19,	r2,	r13	C U1
+	ldq	r1,	40(r17)		C L1
+	umulh	r19,	r2,	r14	C U1
+	mulq	r19,	r3,	r15	C U1
+	lda	r17,	64(r17)		C L1 bookkeeping
+	ldq	r4,	32(r16)		C L1
+	ldq	r5,	40(r16)		C L1
+	umulh	r19,	r3,	r8	C U1
+	ldq	r2,	-16(r17)	C L1
+	mulq	r19,	r0,	r9	C U1
+	ldq	r3,	-8(r17)		C L1
+	umulh	r19,	r0,	r10	C U1
+	addq	r6,	r13,	r6	C L0 lo + acc
+	mulq	r19,	r1,	r11	C U1
+	cmpult	r6,	r13,	r20	C L0 lo add => carry
+	lda	r16,	64(r16)		C L1 bookkeeping
+	addq	r6,	r12,	r22	C U0 hi add => answer
+	cmpult	r22,	r12,	r21	C L0 hi add => carry
+	addq	r14,	r20,	r14	C U0 hi mul + carry
+	ldq	r6,	-16(r16)	C L1
+	addq	r7,	r15,	r23	C L0 lo + acc
+	addq	r14,	r21,	r14	C U0 hi mul + carry
+	ldq	r7,	-8(r16)		C L1
+	umulh	r19,	r1,	r12	C U1
+	cmpult	r23,	r15,	r20	C L0 lo add => carry
+	addq	r23,	r14,	r23	C U0 hi add => answer
+	ldq	r0,	(r17)		C L1
+	mulq	r19,	r2,	r13	C U1
+	cmpult	r23,	r14,	r21	C L0 hi add => carry
+	addq	r8,	r20,	r8	C U0 hi mul + carry
+	ldq	r1,	8(r17)		C L1
+	umulh	r19,	r2,	r14	C U1
+	addq	r4,	r9,	r4	C L0 lo + acc
+	stq	r22,	-48(r16)	C L0
+	stq	r23,	-40(r16)	C L1
+	mulq	r19,	r3,	r15	C U1
+	addq	r8,	r21,	r8	C U0 hi mul + carry
+	cmpult	r4,	r9,	r20	C L0 lo add => carry
+	addq	r4,	r8,	r22	C U0 hi add => answer
+	ble	r18,	$Lend		C U1 bookkeeping
+
+C ____ MAIN UNROLLED LOOP ____
+	ALIGN(16)
+$Loop:
+	bis	r31,	r31,	r31	C U1 mt
+	cmpult	r22,	r8,	r21	C L0 hi add => carry
+	addq	r10,	r20,	r10	C U0 hi mul + carry
+	ldq	r4,	(r16)		C L1
+
+	bis	r31,	r31,	r31	C U1 mt
+	addq	r5,	r11,	r23	C L0 lo + acc
+	addq	r10,	r21,	r10	C L0 hi mul + carry
+	ldq	r5,	8(r16)		C L1
+
+	umulh	r19,	r3,	r8	C U1
+	cmpult	r23,	r11,	r20	C L0 lo add => carry
+	addq	r23,	r10,	r23	C U0 hi add => answer
+	ldq	r2,	16(r17)		C L1
+
+	mulq	r19,	r0,	r9	C U1
+	cmpult	r23,	r10,	r21	C L0 hi add => carry
+	addq	r12,	r20,	r12	C U0 hi mul + carry
+	ldq	r3,	24(r17)		C L1
+
+	umulh	r19,	r0,	r10	C U1
+	addq	r6,	r13,	r6	C L0 lo + acc
+	stq	r22,	-32(r16)	C L0
+	stq	r23,	-24(r16)	C L1
+
+	bis	r31,	r31,	r31	C L0 st slosh
+	mulq	r19,	r1,	r11	C U1
+	bis	r31,	r31,	r31	C L1 st slosh
+	addq	r12,	r21,	r12	C U0 hi mul + carry
+
+	cmpult	r6,	r13,	r20	C L0 lo add => carry
+	bis	r31,	r31,	r31	C U1 mt
+	lda	r18,	-1(r18)		C L1 bookkeeping
+	addq	r6,	r12,	r22	C U0 hi add => answer
+
+	bis	r31,	r31,	r31	C U1 mt
+	cmpult	r22,	r12,	r21	C L0 hi add => carry
+	addq	r14,	r20,	r14	C U0 hi mul + carry
+	ldq	r6,	16(r16)		C L1
+
+	bis	r31,	r31,	r31	C U1 mt
+	addq	r7,	r15,	r23	C L0 lo + acc
+	addq	r14,	r21,	r14	C U0 hi mul + carry
+	ldq	r7,	24(r16)		C L1
+
+	umulh	r19,	r1,	r12	C U1
+	cmpult	r23,	r15,	r20	C L0 lo add => carry
+	addq	r23,	r14,	r23	C U0 hi add => answer
+	ldq	r0,	32(r17)		C L1
+
+	mulq	r19,	r2,	r13	C U1
+	cmpult	r23,	r14,	r21	C L0 hi add => carry
+	addq	r8,	r20,	r8	C U0 hi mul + carry
+	ldq	r1,	40(r17)		C L1
+
+	umulh	r19,	r2,	r14	C U1
+	addq	r4,	r9,	r4	C U0 lo + acc
+	stq	r22,	-16(r16)	C L0
+	stq	r23,	-8(r16)		C L1
+
+	bis	r31,	r31,	r31	C L0 st slosh
+	mulq	r19,	r3,	r15	C U1
+	bis	r31,	r31,	r31	C L1 st slosh
+	addq	r8,	r21,	r8	C L0 hi mul + carry
+
+	cmpult	r4,	r9,	r20	C L0 lo add => carry
+	bis	r31,	r31,	r31	C U1 mt
+	lda	r17,	64(r17)		C L1 bookkeeping
+	addq	r4,	r8,	r22	C U0 hi add => answer
+
+	bis	r31,	r31,	r31	C U1 mt
+	cmpult	r22,	r8,	r21	C L0 hi add => carry
+	addq	r10,	r20,	r10	C U0 hi mul + carry
+	ldq	r4,	32(r16)		C L1
+
+	bis	r31,	r31,	r31	C U1 mt
+	addq	r5,	r11,	r23	C L0 lo + acc
+	addq	r10,	r21,	r10	C L0 hi mul + carry
+	ldq	r5,	40(r16)		C L1
+
+	umulh	r19,	r3,	r8	C U1
+	cmpult	r23,	r11,	r20	C L0 lo add => carry
+	addq	r23,	r10,	r23	C U0 hi add => answer
+	ldq	r2,	-16(r17)	C L1
+
+	mulq	r19,	r0,	r9	C U1
+	cmpult	r23,	r10,	r21	C L0 hi add => carry
+	addq	r12,	r20,	r12	C U0 hi mul + carry
+	ldq	r3,	-8(r17)		C L1
+
+	umulh	r19,	r0,	r10	C U1
+	addq	r6,	r13,	r6	C L0 lo + acc
+	stq	r22,	(r16)		C L0
+	stq	r23,	8(r16)		C L1
+
+	bis	r31,	r31,	r31	C L0 st slosh
+	mulq	r19,	r1,	r11	C U1
+	bis	r31,	r31,	r31	C L1 st slosh
+	addq	r12,	r21,	r12	C U0 hi mul + carry
+
+	cmpult	r6,	r13,	r20	C L0 lo add => carry
+	bis	r31,	r31,	r31	C U1 mt
+	lda	r16,	64(r16)		C L1 bookkeeping
+	addq	r6,	r12,	r22	C U0 hi add => answer
+
+	bis	r31,	r31,	r31	C U1 mt
+	cmpult	r22,	r12,	r21	C L0 hi add => carry
+	addq	r14,	r20,	r14	C U0 hi mul + carry
+	ldq	r6,	-16(r16)	C L1
+
+	bis	r31,	r31,	r31	C U1 mt
+	addq	r7,	r15,	r23	C L0 lo + acc
+	addq	r14,	r21,	r14	C U0 hi mul + carry
+	ldq	r7,	-8(r16)		C L1
+
+	umulh	r19,	r1,	r12	C U1
+	cmpult	r23,	r15,	r20	C L0 lo add => carry
+	addq	r23,	r14,	r23	C U0 hi add => answer
+	ldq	r0,	(r17)		C L1
+
+	mulq	r19,	r2,	r13	C U1
+	cmpult	r23,	r14,	r21	C L0 hi add => carry
+	addq	r8,	r20,	r8	C U0 hi mul + carry
+	ldq	r1,	8(r17)		C L1
+
+	umulh	r19,	r2,	r14	C U1
+	addq	r4,	r9,	r4	C L0 lo + acc
+	stq	r22,	-48(r16)	C L0
+	stq	r23,	-40(r16)	C L1
+
+	bis	r31,	r31,	r31	C L0 st slosh
+	mulq	r19,	r3,	r15	C U1
+	bis	r31,	r31,	r31	C L1 st slosh
+	addq	r8,	r21,	r8	C U0 hi mul + carry
+
+	cmpult	r4,	r9,	r20	C L0 lo add => carry
+	addq	r4,	r8,	r22	C U0 hi add => answer
+	bis	r31,	r31,	r31	C L1 mt
+	bgt	r18,	$Loop		C U1 bookkeeping
+
+C ____ UNROLLED LOOP SOFTWARE PIPELINE FINISH ____
+$Lend:
+	cmpult	r22,	r8,	r21	C L0 hi add => carry
+	addq	r10,	r20,	r10	C U0 hi mul + carry
+	ldq	r4,	(r16)		C L1
+	addq	r5,	r11,	r23	C L0 lo + acc
+	addq	r10,	r21,	r10	C L0 hi mul + carry
+	ldq	r5,	8(r16)		C L1
+	umulh	r19,	r3,	r8	C U1
+	cmpult	r23,	r11,	r20	C L0 lo add => carry
+	addq	r23,	r10,	r23	C U0 hi add => answer
+	mulq	r19,	r0,	r9	C U1
+	cmpult	r23,	r10,	r21	C L0 hi add => carry
+	addq	r12,	r20,	r12	C U0 hi mul + carry
+	umulh	r19,	r0,	r10	C U1
+	addq	r6,	r13,	r6	C L0 lo + acc
+	stq	r22,	-32(r16)	C L0
+	stq	r23,	-24(r16)	C L1
+	mulq	r19,	r1,	r11	C U1
+	addq	r12,	r21,	r12	C U0 hi mul + carry
+	cmpult	r6,	r13,	r20	C L0 lo add => carry
+	addq	r6,	r12,	r22	C U0 hi add => answer
+	cmpult	r22,	r12,	r21	C L0 hi add => carry
+	addq	r14,	r20,	r14	C U0 hi mul + carry
+	addq	r7,	r15,	r23	C L0 lo + acc
+	addq	r14,	r21,	r14	C U0 hi mul + carry
+	umulh	r19,	r1,	r12	C U1
+	cmpult	r23,	r15,	r20	C L0 lo add => carry
+	addq	r23,	r14,	r23	C U0 hi add => answer
+	cmpult	r23,	r14,	r21	C L0 hi add => carry
+	addq	r8,	r20,	r8	C U0 hi mul + carry
+	addq	r4,	r9,	r4	C U0 lo + acc
+	stq	r22,	-16(r16)	C L0
+	stq	r23,	-8(r16)		C L1
+	bis	r31,	r31,	r31	C L0 st slosh
+	addq	r8,	r21,	r8	C L0 hi mul + carry
+	cmpult	r4,	r9,	r20	C L0 lo add => carry
+	addq	r4,	r8,	r22	C U0 hi add => answer
+	cmpult	r22,	r8,	r21	C L0 hi add => carry
+	addq	r10,	r20,	r10	C U0 hi mul + carry
+	addq	r5,	r11,	r23	C L0 lo + acc
+	addq	r10,	r21,	r10	C L0 hi mul + carry
+	cmpult	r23,	r11,	r20	C L0 lo add => carry
+	addq	r23,	r10,	r23	C U0 hi add => answer
+	cmpult	r23,	r10,	r21	C L0 hi add => carry
+	addq	r12,	r20,	r12	C U0 hi mul + carry
+	stq	r22,	(r16)		C L0
+	stq	r23,	8(r16)		C L1
+	addq	r12,	r21,	r0	C U0 hi mul + carry
+
+	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)
+	lda	$30,	240($30)
+	ret	r31,	(r26),	1
+EPILOGUE(mpn_addmul_1)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/ev6/gmp-mparam.h b/src/gmp/mpn/alpha/ev6/gmp-mparam.h
new file mode 100644
index 000000000..7ea20577f
--- /dev/null
+++ b/src/gmp/mpn/alpha/ev6/gmp-mparam.h
@@ -0,0 +1,62 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 64
+#define BYTES_PER_MP_LIMB 8
+#define BITS_PER_LONGINT 64
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+/* Generated by tuneup.c, 2000-08-02. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD     47
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD         70
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD     94
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD        101
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD                33
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD               70
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD              29
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD         46
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD            33
+#endif
diff --git a/src/gmp/mpn/alpha/gmp-mparam.h b/src/gmp/mpn/alpha/gmp-mparam.h
new file mode 100644
index 000000000..054ff2fe5
--- /dev/null
+++ b/src/gmp/mpn/alpha/gmp-mparam.h
@@ -0,0 +1,64 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 64
+#define BYTES_PER_MP_LIMB 8
+#define BITS_PER_LONGINT 64
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+/* These values are for the 21164 family.  The 21264 will require
+   different values, since it has such quick multiplication.  */
+/* Generated by tuneup.c, 2000-07-19. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   22
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD       53
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   31
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD       47
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              64
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD             98
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            17
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        4
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD           4
+#endif
diff --git a/src/gmp/mpn/alpha/invert_limb.asm b/src/gmp/mpn/alpha/invert_limb.asm
new file mode 100644
index 000000000..a921b32b3
--- /dev/null
+++ b/src/gmp/mpn/alpha/invert_limb.asm
@@ -0,0 +1,345 @@
+dnl  Alpha mpn_invert_limb -- Invert a normalized limb.
+
+dnl  Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+dnl 
+dnl  This is based on sophie:/gmp-stuff/dbg-inv-limb.c.
+dnl  The ideas are due to Peter L. Montgomery
+dnl 
+dnl  The table below uses 4096 bytes.  The file mentioned above has an
+dnl  alternative function that doesn't require the table, but it runs 50%
+dnl  slower than this.
+
+include(`../config.m4')
+
+ASM_START()
+
+FLOAT64($C36,9223372036854775808.0)		C 2^63
+
+PROLOGUE_GP(mpn_invert_limb)
+	lda	r30,-16(r30)
+	addq	r16,r16,r1
+	bne	r1,$73
+	lda	r0,-1
+	br	r31,$Lend
+$73:
+	srl	r16,1,r1
+	stq	r1,0(r30)
+	ldt	f11,0(r30)
+	cvtqt	f11,f1
+	lda	r1,$C36
+	ldt	f10,0(r1)
+	divt	f10,f1,f10
+	lda	r2,$invtab-4096
+	srl	r16,52,r1
+	addq	r1,r1,r1
+	addq	r1,r2,r1
+	bic	r1,6,r2
+	ldq	r2,0(r2)
+	bic	r1,1,r1
+	extwl	r2,r1,r2
+	sll	r2,48,r0
+	umulh	r16,r0,r1
+	addq	r16,r1,r3
+	stq	r3,0(r30)
+	ldt	f11,0(r30)
+	cvtqt	f11,f1
+	mult	f1,f10,f1
+	cvttqc	f1,f1
+	stt	f1,0(r30)
+	ldq	r4,0(r30)
+	subq	r0,r4,r0
+	umulh	r16,r0,r1
+	mulq	r16,r0,r2
+	addq	r16,r1,r3
+	bge	r3,$Loop2
+$Loop1:	addq	r2,r16,r2
+	cmpult	r2,r16,r1
+	addq	r3,r1,r3
+	addq	r0,1,r0
+	blt	r3,$Loop1
+$Loop2:	cmpult	r2,r16,r1
+	subq	r0,1,r0
+	subq	r3,r1,r3
+	subq	r2,r16,r2
+	bge	r3,$Loop2
+$Lend:
+	lda	r30,16(r30)
+	ret	r31,(r26),1
+EPILOGUE(mpn_invert_limb)
+DATASTART(`$invtab',4)
+	.word 0xffff,0xffc0,0xff80,0xff40,0xff00,0xfec0,0xfe81,0xfe41
+	.word 0xfe01,0xfdc2,0xfd83,0xfd43,0xfd04,0xfcc5,0xfc86,0xfc46
+	.word 0xfc07,0xfbc8,0xfb8a,0xfb4b,0xfb0c,0xfacd,0xfa8e,0xfa50
+	.word 0xfa11,0xf9d3,0xf994,0xf956,0xf918,0xf8d9,0xf89b,0xf85d
+	.word 0xf81f,0xf7e1,0xf7a3,0xf765,0xf727,0xf6ea,0xf6ac,0xf66e
+	.word 0xf631,0xf5f3,0xf5b6,0xf578,0xf53b,0xf4fd,0xf4c0,0xf483
+	.word 0xf446,0xf409,0xf3cc,0xf38f,0xf352,0xf315,0xf2d8,0xf29c
+	.word 0xf25f,0xf222,0xf1e6,0xf1a9,0xf16d,0xf130,0xf0f4,0xf0b8
+	.word 0xf07c,0xf03f,0xf003,0xefc7,0xef8b,0xef4f,0xef14,0xeed8
+	.word 0xee9c,0xee60,0xee25,0xede9,0xedae,0xed72,0xed37,0xecfb
+	.word 0xecc0,0xec85,0xec4a,0xec0e,0xebd3,0xeb98,0xeb5d,0xeb22
+	.word 0xeae8,0xeaad,0xea72,0xea37,0xe9fd,0xe9c2,0xe988,0xe94d
+	.word 0xe913,0xe8d8,0xe89e,0xe864,0xe829,0xe7ef,0xe7b5,0xe77b
+	.word 0xe741,0xe707,0xe6cd,0xe694,0xe65a,0xe620,0xe5e6,0xe5ad
+	.word 0xe573,0xe53a,0xe500,0xe4c7,0xe48d,0xe454,0xe41b,0xe3e2
+	.word 0xe3a9,0xe370,0xe336,0xe2fd,0xe2c5,0xe28c,0xe253,0xe21a
+	.word 0xe1e1,0xe1a9,0xe170,0xe138,0xe0ff,0xe0c7,0xe08e,0xe056
+	.word 0xe01e,0xdfe5,0xdfad,0xdf75,0xdf3d,0xdf05,0xdecd,0xde95
+	.word 0xde5d,0xde25,0xdded,0xddb6,0xdd7e,0xdd46,0xdd0f,0xdcd7
+	.word 0xdca0,0xdc68,0xdc31,0xdbf9,0xdbc2,0xdb8b,0xdb54,0xdb1d
+	.word 0xdae6,0xdaae,0xda78,0xda41,0xda0a,0xd9d3,0xd99c,0xd965
+	.word 0xd92f,0xd8f8,0xd8c1,0xd88b,0xd854,0xd81e,0xd7e8,0xd7b1
+	.word 0xd77b,0xd745,0xd70e,0xd6d8,0xd6a2,0xd66c,0xd636,0xd600
+	.word 0xd5ca,0xd594,0xd55f,0xd529,0xd4f3,0xd4bd,0xd488,0xd452
+	.word 0xd41d,0xd3e7,0xd3b2,0xd37c,0xd347,0xd312,0xd2dd,0xd2a7
+	.word 0xd272,0xd23d,0xd208,0xd1d3,0xd19e,0xd169,0xd134,0xd100
+	.word 0xd0cb,0xd096,0xd061,0xd02d,0xcff8,0xcfc4,0xcf8f,0xcf5b
+	.word 0xcf26,0xcef2,0xcebe,0xce89,0xce55,0xce21,0xcded,0xcdb9
+	.word 0xcd85,0xcd51,0xcd1d,0xcce9,0xccb5,0xcc81,0xcc4e,0xcc1a
+	.word 0xcbe6,0xcbb3,0xcb7f,0xcb4c,0xcb18,0xcae5,0xcab1,0xca7e
+	.word 0xca4b,0xca17,0xc9e4,0xc9b1,0xc97e,0xc94b,0xc918,0xc8e5
+	.word 0xc8b2,0xc87f,0xc84c,0xc819,0xc7e7,0xc7b4,0xc781,0xc74f
+	.word 0xc71c,0xc6e9,0xc6b7,0xc684,0xc652,0xc620,0xc5ed,0xc5bb
+	.word 0xc589,0xc557,0xc524,0xc4f2,0xc4c0,0xc48e,0xc45c,0xc42a
+	.word 0xc3f8,0xc3c7,0xc395,0xc363,0xc331,0xc300,0xc2ce,0xc29c
+	.word 0xc26b,0xc239,0xc208,0xc1d6,0xc1a5,0xc174,0xc142,0xc111
+	.word 0xc0e0,0xc0af,0xc07e,0xc04d,0xc01c,0xbfeb,0xbfba,0xbf89
+	.word 0xbf58,0xbf27,0xbef6,0xbec5,0xbe95,0xbe64,0xbe33,0xbe03
+	.word 0xbdd2,0xbda2,0xbd71,0xbd41,0xbd10,0xbce0,0xbcb0,0xbc80
+	.word 0xbc4f,0xbc1f,0xbbef,0xbbbf,0xbb8f,0xbb5f,0xbb2f,0xbaff
+	.word 0xbacf,0xba9f,0xba6f,0xba40,0xba10,0xb9e0,0xb9b1,0xb981
+	.word 0xb951,0xb922,0xb8f2,0xb8c3,0xb894,0xb864,0xb835,0xb806
+	.word 0xb7d6,0xb7a7,0xb778,0xb749,0xb71a,0xb6eb,0xb6bc,0xb68d
+	.word 0xb65e,0xb62f,0xb600,0xb5d1,0xb5a2,0xb574,0xb545,0xb516
+	.word 0xb4e8,0xb4b9,0xb48a,0xb45c,0xb42e,0xb3ff,0xb3d1,0xb3a2
+	.word 0xb374,0xb346,0xb318,0xb2e9,0xb2bb,0xb28d,0xb25f,0xb231
+	.word 0xb203,0xb1d5,0xb1a7,0xb179,0xb14b,0xb11d,0xb0f0,0xb0c2
+	.word 0xb094,0xb067,0xb039,0xb00b,0xafde,0xafb0,0xaf83,0xaf55
+	.word 0xaf28,0xaefb,0xaecd,0xaea0,0xae73,0xae45,0xae18,0xadeb
+	.word 0xadbe,0xad91,0xad64,0xad37,0xad0a,0xacdd,0xacb0,0xac83
+	.word 0xac57,0xac2a,0xabfd,0xabd0,0xaba4,0xab77,0xab4a,0xab1e
+	.word 0xaaf1,0xaac5,0xaa98,0xaa6c,0xaa40,0xaa13,0xa9e7,0xa9bb
+	.word 0xa98e,0xa962,0xa936,0xa90a,0xa8de,0xa8b2,0xa886,0xa85a
+	.word 0xa82e,0xa802,0xa7d6,0xa7aa,0xa77e,0xa753,0xa727,0xa6fb
+	.word 0xa6d0,0xa6a4,0xa678,0xa64d,0xa621,0xa5f6,0xa5ca,0xa59f
+	.word 0xa574,0xa548,0xa51d,0xa4f2,0xa4c6,0xa49b,0xa470,0xa445
+	.word 0xa41a,0xa3ef,0xa3c4,0xa399,0xa36e,0xa343,0xa318,0xa2ed
+	.word 0xa2c2,0xa297,0xa26d,0xa242,0xa217,0xa1ed,0xa1c2,0xa197
+	.word 0xa16d,0xa142,0xa118,0xa0ed,0xa0c3,0xa098,0xa06e,0xa044
+	.word 0xa01a,0x9fef,0x9fc5,0x9f9b,0x9f71,0x9f47,0x9f1c,0x9ef2
+	.word 0x9ec8,0x9e9e,0x9e74,0x9e4b,0x9e21,0x9df7,0x9dcd,0x9da3
+	.word 0x9d79,0x9d50,0x9d26,0x9cfc,0x9cd3,0x9ca9,0x9c80,0x9c56
+	.word 0x9c2d,0x9c03,0x9bda,0x9bb0,0x9b87,0x9b5e,0x9b34,0x9b0b
+	.word 0x9ae2,0x9ab9,0x9a8f,0x9a66,0x9a3d,0x9a14,0x99eb,0x99c2
+	.word 0x9999,0x9970,0x9947,0x991e,0x98f6,0x98cd,0x98a4,0x987b
+	.word 0x9852,0x982a,0x9801,0x97d8,0x97b0,0x9787,0x975f,0x9736
+	.word 0x970e,0x96e5,0x96bd,0x9695,0x966c,0x9644,0x961c,0x95f3
+	.word 0x95cb,0x95a3,0x957b,0x9553,0x952b,0x9503,0x94db,0x94b3
+	.word 0x948b,0x9463,0x943b,0x9413,0x93eb,0x93c3,0x939b,0x9374
+	.word 0x934c,0x9324,0x92fd,0x92d5,0x92ad,0x9286,0x925e,0x9237
+	.word 0x920f,0x91e8,0x91c0,0x9199,0x9172,0x914a,0x9123,0x90fc
+	.word 0x90d4,0x90ad,0x9086,0x905f,0x9038,0x9011,0x8fea,0x8fc3
+	.word 0x8f9c,0x8f75,0x8f4e,0x8f27,0x8f00,0x8ed9,0x8eb2,0x8e8b
+	.word 0x8e65,0x8e3e,0x8e17,0x8df1,0x8dca,0x8da3,0x8d7d,0x8d56
+	.word 0x8d30,0x8d09,0x8ce3,0x8cbc,0x8c96,0x8c6f,0x8c49,0x8c23
+	.word 0x8bfc,0x8bd6,0x8bb0,0x8b8a,0x8b64,0x8b3d,0x8b17,0x8af1
+	.word 0x8acb,0x8aa5,0x8a7f,0x8a59,0x8a33,0x8a0d,0x89e7,0x89c1
+	.word 0x899c,0x8976,0x8950,0x892a,0x8904,0x88df,0x88b9,0x8893
+	.word 0x886e,0x8848,0x8823,0x87fd,0x87d8,0x87b2,0x878d,0x8767
+	.word 0x8742,0x871d,0x86f7,0x86d2,0x86ad,0x8687,0x8662,0x863d
+	.word 0x8618,0x85f3,0x85ce,0x85a9,0x8583,0x855e,0x8539,0x8514
+	.word 0x84f0,0x84cb,0x84a6,0x8481,0x845c,0x8437,0x8412,0x83ee
+	.word 0x83c9,0x83a4,0x8380,0x835b,0x8336,0x8312,0x82ed,0x82c9
+	.word 0x82a4,0x8280,0x825b,0x8237,0x8212,0x81ee,0x81ca,0x81a5
+	.word 0x8181,0x815d,0x8138,0x8114,0x80f0,0x80cc,0x80a8,0x8084
+	.word 0x8060,0x803c,0x8018,0x7ff4,0x7fd0,0x7fac,0x7f88,0x7f64
+	.word 0x7f40,0x7f1c,0x7ef8,0x7ed4,0x7eb1,0x7e8d,0x7e69,0x7e45
+	.word 0x7e22,0x7dfe,0x7ddb,0x7db7,0x7d93,0x7d70,0x7d4c,0x7d29
+	.word 0x7d05,0x7ce2,0x7cbf,0x7c9b,0x7c78,0x7c55,0x7c31,0x7c0e
+	.word 0x7beb,0x7bc7,0x7ba4,0x7b81,0x7b5e,0x7b3b,0x7b18,0x7af5
+	.word 0x7ad2,0x7aaf,0x7a8c,0x7a69,0x7a46,0x7a23,0x7a00,0x79dd
+	.word 0x79ba,0x7997,0x7975,0x7952,0x792f,0x790c,0x78ea,0x78c7
+	.word 0x78a4,0x7882,0x785f,0x783c,0x781a,0x77f7,0x77d5,0x77b2
+	.word 0x7790,0x776e,0x774b,0x7729,0x7706,0x76e4,0x76c2,0x76a0
+	.word 0x767d,0x765b,0x7639,0x7617,0x75f5,0x75d2,0x75b0,0x758e
+	.word 0x756c,0x754a,0x7528,0x7506,0x74e4,0x74c2,0x74a0,0x747e
+	.word 0x745d,0x743b,0x7419,0x73f7,0x73d5,0x73b4,0x7392,0x7370
+	.word 0x734f,0x732d,0x730b,0x72ea,0x72c8,0x72a7,0x7285,0x7264
+	.word 0x7242,0x7221,0x71ff,0x71de,0x71bc,0x719b,0x717a,0x7158
+	.word 0x7137,0x7116,0x70f5,0x70d3,0x70b2,0x7091,0x7070,0x704f
+	.word 0x702e,0x700c,0x6feb,0x6fca,0x6fa9,0x6f88,0x6f67,0x6f46
+	.word 0x6f26,0x6f05,0x6ee4,0x6ec3,0x6ea2,0x6e81,0x6e60,0x6e40
+	.word 0x6e1f,0x6dfe,0x6dde,0x6dbd,0x6d9c,0x6d7c,0x6d5b,0x6d3a
+	.word 0x6d1a,0x6cf9,0x6cd9,0x6cb8,0x6c98,0x6c77,0x6c57,0x6c37
+	.word 0x6c16,0x6bf6,0x6bd6,0x6bb5,0x6b95,0x6b75,0x6b54,0x6b34
+	.word 0x6b14,0x6af4,0x6ad4,0x6ab4,0x6a94,0x6a73,0x6a53,0x6a33
+	.word 0x6a13,0x69f3,0x69d3,0x69b3,0x6993,0x6974,0x6954,0x6934
+	.word 0x6914,0x68f4,0x68d4,0x68b5,0x6895,0x6875,0x6855,0x6836
+	.word 0x6816,0x67f6,0x67d7,0x67b7,0x6798,0x6778,0x6758,0x6739
+	.word 0x6719,0x66fa,0x66db,0x66bb,0x669c,0x667c,0x665d,0x663e
+	.word 0x661e,0x65ff,0x65e0,0x65c0,0x65a1,0x6582,0x6563,0x6544
+	.word 0x6524,0x6505,0x64e6,0x64c7,0x64a8,0x6489,0x646a,0x644b
+	.word 0x642c,0x640d,0x63ee,0x63cf,0x63b0,0x6391,0x6373,0x6354
+	.word 0x6335,0x6316,0x62f7,0x62d9,0x62ba,0x629b,0x627c,0x625e
+	.word 0x623f,0x6221,0x6202,0x61e3,0x61c5,0x61a6,0x6188,0x6169
+	.word 0x614b,0x612c,0x610e,0x60ef,0x60d1,0x60b3,0x6094,0x6076
+	.word 0x6058,0x6039,0x601b,0x5ffd,0x5fdf,0x5fc0,0x5fa2,0x5f84
+	.word 0x5f66,0x5f48,0x5f2a,0x5f0b,0x5eed,0x5ecf,0x5eb1,0x5e93
+	.word 0x5e75,0x5e57,0x5e39,0x5e1b,0x5dfd,0x5de0,0x5dc2,0x5da4
+	.word 0x5d86,0x5d68,0x5d4a,0x5d2d,0x5d0f,0x5cf1,0x5cd3,0x5cb6
+	.word 0x5c98,0x5c7a,0x5c5d,0x5c3f,0x5c21,0x5c04,0x5be6,0x5bc9
+	.word 0x5bab,0x5b8e,0x5b70,0x5b53,0x5b35,0x5b18,0x5afb,0x5add
+	.word 0x5ac0,0x5aa2,0x5a85,0x5a68,0x5a4b,0x5a2d,0x5a10,0x59f3
+	.word 0x59d6,0x59b8,0x599b,0x597e,0x5961,0x5944,0x5927,0x590a
+	.word 0x58ed,0x58d0,0x58b3,0x5896,0x5879,0x585c,0x583f,0x5822
+	.word 0x5805,0x57e8,0x57cb,0x57ae,0x5791,0x5775,0x5758,0x573b
+	.word 0x571e,0x5702,0x56e5,0x56c8,0x56ac,0x568f,0x5672,0x5656
+	.word 0x5639,0x561c,0x5600,0x55e3,0x55c7,0x55aa,0x558e,0x5571
+	.word 0x5555,0x5538,0x551c,0x5500,0x54e3,0x54c7,0x54aa,0x548e
+	.word 0x5472,0x5456,0x5439,0x541d,0x5401,0x53e5,0x53c8,0x53ac
+	.word 0x5390,0x5374,0x5358,0x533c,0x5320,0x5304,0x52e8,0x52cb
+	.word 0x52af,0x5293,0x5277,0x525c,0x5240,0x5224,0x5208,0x51ec
+	.word 0x51d0,0x51b4,0x5198,0x517c,0x5161,0x5145,0x5129,0x510d
+	.word 0x50f2,0x50d6,0x50ba,0x509f,0x5083,0x5067,0x504c,0x5030
+	.word 0x5015,0x4ff9,0x4fdd,0x4fc2,0x4fa6,0x4f8b,0x4f6f,0x4f54
+	.word 0x4f38,0x4f1d,0x4f02,0x4ee6,0x4ecb,0x4eb0,0x4e94,0x4e79
+	.word 0x4e5e,0x4e42,0x4e27,0x4e0c,0x4df0,0x4dd5,0x4dba,0x4d9f
+	.word 0x4d84,0x4d69,0x4d4d,0x4d32,0x4d17,0x4cfc,0x4ce1,0x4cc6
+	.word 0x4cab,0x4c90,0x4c75,0x4c5a,0x4c3f,0x4c24,0x4c09,0x4bee
+	.word 0x4bd3,0x4bb9,0x4b9e,0x4b83,0x4b68,0x4b4d,0x4b32,0x4b18
+	.word 0x4afd,0x4ae2,0x4ac7,0x4aad,0x4a92,0x4a77,0x4a5d,0x4a42
+	.word 0x4a27,0x4a0d,0x49f2,0x49d8,0x49bd,0x49a3,0x4988,0x496e
+	.word 0x4953,0x4939,0x491e,0x4904,0x48e9,0x48cf,0x48b5,0x489a
+	.word 0x4880,0x4865,0x484b,0x4831,0x4817,0x47fc,0x47e2,0x47c8
+	.word 0x47ae,0x4793,0x4779,0x475f,0x4745,0x472b,0x4711,0x46f6
+	.word 0x46dc,0x46c2,0x46a8,0x468e,0x4674,0x465a,0x4640,0x4626
+	.word 0x460c,0x45f2,0x45d8,0x45be,0x45a5,0x458b,0x4571,0x4557
+	.word 0x453d,0x4523,0x4509,0x44f0,0x44d6,0x44bc,0x44a2,0x4489
+	.word 0x446f,0x4455,0x443c,0x4422,0x4408,0x43ef,0x43d5,0x43bc
+	.word 0x43a2,0x4388,0x436f,0x4355,0x433c,0x4322,0x4309,0x42ef
+	.word 0x42d6,0x42bc,0x42a3,0x428a,0x4270,0x4257,0x423d,0x4224
+	.word 0x420b,0x41f2,0x41d8,0x41bf,0x41a6,0x418c,0x4173,0x415a
+	.word 0x4141,0x4128,0x410e,0x40f5,0x40dc,0x40c3,0x40aa,0x4091
+	.word 0x4078,0x405f,0x4046,0x402d,0x4014,0x3ffb,0x3fe2,0x3fc9
+	.word 0x3fb0,0x3f97,0x3f7e,0x3f65,0x3f4c,0x3f33,0x3f1a,0x3f01
+	.word 0x3ee8,0x3ed0,0x3eb7,0x3e9e,0x3e85,0x3e6c,0x3e54,0x3e3b
+	.word 0x3e22,0x3e0a,0x3df1,0x3dd8,0x3dc0,0x3da7,0x3d8e,0x3d76
+	.word 0x3d5d,0x3d45,0x3d2c,0x3d13,0x3cfb,0x3ce2,0x3cca,0x3cb1
+	.word 0x3c99,0x3c80,0x3c68,0x3c50,0x3c37,0x3c1f,0x3c06,0x3bee
+	.word 0x3bd6,0x3bbd,0x3ba5,0x3b8d,0x3b74,0x3b5c,0x3b44,0x3b2b
+	.word 0x3b13,0x3afb,0x3ae3,0x3acb,0x3ab2,0x3a9a,0x3a82,0x3a6a
+	.word 0x3a52,0x3a3a,0x3a22,0x3a09,0x39f1,0x39d9,0x39c1,0x39a9
+	.word 0x3991,0x3979,0x3961,0x3949,0x3931,0x3919,0x3901,0x38ea
+	.word 0x38d2,0x38ba,0x38a2,0x388a,0x3872,0x385a,0x3843,0x382b
+	.word 0x3813,0x37fb,0x37e3,0x37cc,0x37b4,0x379c,0x3785,0x376d
+	.word 0x3755,0x373e,0x3726,0x370e,0x36f7,0x36df,0x36c8,0x36b0
+	.word 0x3698,0x3681,0x3669,0x3652,0x363a,0x3623,0x360b,0x35f4
+	.word 0x35dc,0x35c5,0x35ae,0x3596,0x357f,0x3567,0x3550,0x3539
+	.word 0x3521,0x350a,0x34f3,0x34db,0x34c4,0x34ad,0x3496,0x347e
+	.word 0x3467,0x3450,0x3439,0x3422,0x340a,0x33f3,0x33dc,0x33c5
+	.word 0x33ae,0x3397,0x3380,0x3368,0x3351,0x333a,0x3323,0x330c
+	.word 0x32f5,0x32de,0x32c7,0x32b0,0x3299,0x3282,0x326c,0x3255
+	.word 0x323e,0x3227,0x3210,0x31f9,0x31e2,0x31cb,0x31b5,0x319e
+	.word 0x3187,0x3170,0x3159,0x3143,0x312c,0x3115,0x30fe,0x30e8
+	.word 0x30d1,0x30ba,0x30a4,0x308d,0x3076,0x3060,0x3049,0x3033
+	.word 0x301c,0x3005,0x2fef,0x2fd8,0x2fc2,0x2fab,0x2f95,0x2f7e
+	.word 0x2f68,0x2f51,0x2f3b,0x2f24,0x2f0e,0x2ef8,0x2ee1,0x2ecb
+	.word 0x2eb4,0x2e9e,0x2e88,0x2e71,0x2e5b,0x2e45,0x2e2e,0x2e18
+	.word 0x2e02,0x2dec,0x2dd5,0x2dbf,0x2da9,0x2d93,0x2d7c,0x2d66
+	.word 0x2d50,0x2d3a,0x2d24,0x2d0e,0x2cf8,0x2ce1,0x2ccb,0x2cb5
+	.word 0x2c9f,0x2c89,0x2c73,0x2c5d,0x2c47,0x2c31,0x2c1b,0x2c05
+	.word 0x2bef,0x2bd9,0x2bc3,0x2bad,0x2b97,0x2b81,0x2b6c,0x2b56
+	.word 0x2b40,0x2b2a,0x2b14,0x2afe,0x2ae8,0x2ad3,0x2abd,0x2aa7
+	.word 0x2a91,0x2a7c,0x2a66,0x2a50,0x2a3a,0x2a25,0x2a0f,0x29f9
+	.word 0x29e4,0x29ce,0x29b8,0x29a3,0x298d,0x2977,0x2962,0x294c
+	.word 0x2937,0x2921,0x290c,0x28f6,0x28e0,0x28cb,0x28b5,0x28a0
+	.word 0x288b,0x2875,0x2860,0x284a,0x2835,0x281f,0x280a,0x27f5
+	.word 0x27df,0x27ca,0x27b4,0x279f,0x278a,0x2774,0x275f,0x274a
+	.word 0x2735,0x271f,0x270a,0x26f5,0x26e0,0x26ca,0x26b5,0x26a0
+	.word 0x268b,0x2676,0x2660,0x264b,0x2636,0x2621,0x260c,0x25f7
+	.word 0x25e2,0x25cd,0x25b8,0x25a2,0x258d,0x2578,0x2563,0x254e
+	.word 0x2539,0x2524,0x250f,0x24fa,0x24e5,0x24d1,0x24bc,0x24a7
+	.word 0x2492,0x247d,0x2468,0x2453,0x243e,0x2429,0x2415,0x2400
+	.word 0x23eb,0x23d6,0x23c1,0x23ad,0x2398,0x2383,0x236e,0x235a
+	.word 0x2345,0x2330,0x231c,0x2307,0x22f2,0x22dd,0x22c9,0x22b4
+	.word 0x22a0,0x228b,0x2276,0x2262,0x224d,0x2239,0x2224,0x2210
+	.word 0x21fb,0x21e6,0x21d2,0x21bd,0x21a9,0x2194,0x2180,0x216c
+	.word 0x2157,0x2143,0x212e,0x211a,0x2105,0x20f1,0x20dd,0x20c8
+	.word 0x20b4,0x20a0,0x208b,0x2077,0x2063,0x204e,0x203a,0x2026
+	.word 0x2012,0x1ffd,0x1fe9,0x1fd5,0x1fc1,0x1fac,0x1f98,0x1f84
+	.word 0x1f70,0x1f5c,0x1f47,0x1f33,0x1f1f,0x1f0b,0x1ef7,0x1ee3
+	.word 0x1ecf,0x1ebb,0x1ea7,0x1e93,0x1e7f,0x1e6a,0x1e56,0x1e42
+	.word 0x1e2e,0x1e1a,0x1e06,0x1df3,0x1ddf,0x1dcb,0x1db7,0x1da3
+	.word 0x1d8f,0x1d7b,0x1d67,0x1d53,0x1d3f,0x1d2b,0x1d18,0x1d04
+	.word 0x1cf0,0x1cdc,0x1cc8,0x1cb5,0x1ca1,0x1c8d,0x1c79,0x1c65
+	.word 0x1c52,0x1c3e,0x1c2a,0x1c17,0x1c03,0x1bef,0x1bdb,0x1bc8
+	.word 0x1bb4,0x1ba0,0x1b8d,0x1b79,0x1b66,0x1b52,0x1b3e,0x1b2b
+	.word 0x1b17,0x1b04,0x1af0,0x1add,0x1ac9,0x1ab6,0x1aa2,0x1a8f
+	.word 0x1a7b,0x1a68,0x1a54,0x1a41,0x1a2d,0x1a1a,0x1a06,0x19f3
+	.word 0x19e0,0x19cc,0x19b9,0x19a5,0x1992,0x197f,0x196b,0x1958
+	.word 0x1945,0x1931,0x191e,0x190b,0x18f8,0x18e4,0x18d1,0x18be
+	.word 0x18ab,0x1897,0x1884,0x1871,0x185e,0x184b,0x1837,0x1824
+	.word 0x1811,0x17fe,0x17eb,0x17d8,0x17c4,0x17b1,0x179e,0x178b
+	.word 0x1778,0x1765,0x1752,0x173f,0x172c,0x1719,0x1706,0x16f3
+	.word 0x16e0,0x16cd,0x16ba,0x16a7,0x1694,0x1681,0x166e,0x165b
+	.word 0x1648,0x1635,0x1623,0x1610,0x15fd,0x15ea,0x15d7,0x15c4
+	.word 0x15b1,0x159f,0x158c,0x1579,0x1566,0x1553,0x1541,0x152e
+	.word 0x151b,0x1508,0x14f6,0x14e3,0x14d0,0x14bd,0x14ab,0x1498
+	.word 0x1485,0x1473,0x1460,0x144d,0x143b,0x1428,0x1416,0x1403
+	.word 0x13f0,0x13de,0x13cb,0x13b9,0x13a6,0x1394,0x1381,0x136f
+	.word 0x135c,0x1349,0x1337,0x1325,0x1312,0x1300,0x12ed,0x12db
+	.word 0x12c8,0x12b6,0x12a3,0x1291,0x127f,0x126c,0x125a,0x1247
+	.word 0x1235,0x1223,0x1210,0x11fe,0x11ec,0x11d9,0x11c7,0x11b5
+	.word 0x11a3,0x1190,0x117e,0x116c,0x1159,0x1147,0x1135,0x1123
+	.word 0x1111,0x10fe,0x10ec,0x10da,0x10c8,0x10b6,0x10a4,0x1091
+	.word 0x107f,0x106d,0x105b,0x1049,0x1037,0x1025,0x1013,0x1001
+	.word 0x0fef,0x0fdc,0x0fca,0x0fb8,0x0fa6,0x0f94,0x0f82,0x0f70
+	.word 0x0f5e,0x0f4c,0x0f3a,0x0f28,0x0f17,0x0f05,0x0ef3,0x0ee1
+	.word 0x0ecf,0x0ebd,0x0eab,0x0e99,0x0e87,0x0e75,0x0e64,0x0e52
+	.word 0x0e40,0x0e2e,0x0e1c,0x0e0a,0x0df9,0x0de7,0x0dd5,0x0dc3
+	.word 0x0db2,0x0da0,0x0d8e,0x0d7c,0x0d6b,0x0d59,0x0d47,0x0d35
+	.word 0x0d24,0x0d12,0x0d00,0x0cef,0x0cdd,0x0ccb,0x0cba,0x0ca8
+	.word 0x0c97,0x0c85,0x0c73,0x0c62,0x0c50,0x0c3f,0x0c2d,0x0c1c
+	.word 0x0c0a,0x0bf8,0x0be7,0x0bd5,0x0bc4,0x0bb2,0x0ba1,0x0b8f
+	.word 0x0b7e,0x0b6c,0x0b5b,0x0b4a,0x0b38,0x0b27,0x0b15,0x0b04
+	.word 0x0af2,0x0ae1,0x0ad0,0x0abe,0x0aad,0x0a9c,0x0a8a,0x0a79
+	.word 0x0a68,0x0a56,0x0a45,0x0a34,0x0a22,0x0a11,0x0a00,0x09ee
+	.word 0x09dd,0x09cc,0x09bb,0x09a9,0x0998,0x0987,0x0976,0x0965
+	.word 0x0953,0x0942,0x0931,0x0920,0x090f,0x08fe,0x08ec,0x08db
+	.word 0x08ca,0x08b9,0x08a8,0x0897,0x0886,0x0875,0x0864,0x0853
+	.word 0x0842,0x0831,0x081f,0x080e,0x07fd,0x07ec,0x07db,0x07ca
+	.word 0x07b9,0x07a8,0x0798,0x0787,0x0776,0x0765,0x0754,0x0743
+	.word 0x0732,0x0721,0x0710,0x06ff,0x06ee,0x06dd,0x06cd,0x06bc
+	.word 0x06ab,0x069a,0x0689,0x0678,0x0668,0x0657,0x0646,0x0635
+	.word 0x0624,0x0614,0x0603,0x05f2,0x05e1,0x05d1,0x05c0,0x05af
+	.word 0x059e,0x058e,0x057d,0x056c,0x055c,0x054b,0x053a,0x052a
+	.word 0x0519,0x0508,0x04f8,0x04e7,0x04d6,0x04c6,0x04b5,0x04a5
+	.word 0x0494,0x0484,0x0473,0x0462,0x0452,0x0441,0x0431,0x0420
+	.word 0x0410,0x03ff,0x03ef,0x03de,0x03ce,0x03bd,0x03ad,0x039c
+	.word 0x038c,0x037b,0x036b,0x035b,0x034a,0x033a,0x0329,0x0319
+	.word 0x0309,0x02f8,0x02e8,0x02d7,0x02c7,0x02b7,0x02a6,0x0296
+	.word 0x0286,0x0275,0x0265,0x0255,0x0245,0x0234,0x0224,0x0214
+	.word 0x0204,0x01f3,0x01e3,0x01d3,0x01c3,0x01b2,0x01a2,0x0192
+	.word 0x0182,0x0172,0x0161,0x0151,0x0141,0x0131,0x0121,0x0111
+	.word 0x0101,0x00f0,0x00e0,0x00d0,0x00c0,0x00b0,0x00a0,0x0090
+	.word 0x0080,0x0070,0x0060,0x0050,0x0040,0x0030,0x0020,0x0010
+DATAEND()
+ASM_END()
diff --git a/src/gmp/mpn/alpha/lshift.asm b/src/gmp/mpn/alpha/lshift.asm
new file mode 100644
index 000000000..87c46f6fe
--- /dev/null
+++ b/src/gmp/mpn/alpha/lshift.asm
@@ -0,0 +1,104 @@
+dnl  Alpha mpn_lshift -- Shift a number left.
+
+dnl  Copyright (C) 1994, 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  size	r18
+dnl  cnt	r19
+
+dnl  This code runs at 4.8 cycles/limb on the 21064.  With infinite unrolling,
+dnl  it would take 4 cycles/limb.  It should be possible to get down to 3
+dnl  cycles/limb since both ldq and stq can be paired with the other used
+dnl  instructions.  But there are many restrictions in the 21064 pipeline that
+dnl  makes it hard, if not impossible, to get down to 3 cycles/limb:
+
+dnl  1. ldq has a 3 cycle delay, srl and sll have a 2 cycle delay.
+dnl  2. Only aligned instruction pairs can be paired.
+dnl  3. The store buffer or silo might not be able to deal with the bandwidth.
+
+ASM_START()
+PROLOGUE(mpn_lshift)
+	s8addq	r18,r17,r17	C make r17 point at end of s1
+	ldq	r4,-8(r17)	C load first limb
+	subq	r17,8,r17
+	subq	r31,r19,r7
+	s8addq	r18,r16,r16	C make r16 point at end of RES
+	subq	r18,1,r18
+	and	r18,4-1,r20	C number of limbs in first loop
+	srl	r4,r7,r0	C compute function result
+
+	beq	r20,$L0
+	subq	r18,r20,r18
+
+	ALIGN(8)
+$Loop0:
+	ldq	r3,-8(r17)
+	subq	r16,8,r16
+	subq	r17,8,r17
+	subq	r20,1,r20
+	sll	r4,r19,r5
+	srl	r3,r7,r6
+	bis	r3,r3,r4
+	bis	r5,r6,r8
+	stq	r8,0(r16)
+	bne	r20,$Loop0
+
+$L0:	beq	r18,$Lend
+
+	ALIGN(8)
+$Loop:	ldq	r3,-8(r17)
+	subq	r16,32,r16
+	subq	r18,4,r18
+	sll	r4,r19,r5
+	srl	r3,r7,r6
+
+	ldq	r4,-16(r17)
+	sll	r3,r19,r1
+	bis	r5,r6,r8
+	stq	r8,24(r16)
+	srl	r4,r7,r2
+
+	ldq	r3,-24(r17)
+	sll	r4,r19,r5
+	bis	r1,r2,r8
+	stq	r8,16(r16)
+	srl	r3,r7,r6
+
+	ldq	r4,-32(r17)
+	sll	r3,r19,r1
+	bis	r5,r6,r8
+	stq	r8,8(r16)
+	srl	r4,r7,r2
+
+	subq	r17,32,r17
+	bis	r1,r2,r8
+	stq	r8,0(r16)
+
+	bgt	r18,$Loop
+
+$Lend:	sll	r4,r19,r8
+	stq	r8,-8(r16)
+	ret	r31,(r26),1
+EPILOGUE(mpn_lshift)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/mul_1.asm b/src/gmp/mpn/alpha/mul_1.asm
new file mode 100644
index 000000000..46b8df34f
--- /dev/null
+++ b/src/gmp/mpn/alpha/mul_1.asm
@@ -0,0 +1,71 @@
+dnl  Alpha __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+dnl  the result in a second limb vector.
+
+dnl  Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  size	r18
+dnl  s2_limb	r19
+
+dnl  This code runs at 42 cycles/limb on EV4, 18 cycles/limb on EV5, and 7
+dnl  cycles/limb on EV6.
+
+ASM_START()
+PROLOGUE(mpn_mul_1)
+	ldq	r2,0(r17)	C r2 = s1_limb
+	subq	r18,1,r18	C size--
+	mulq	r2,r19,r3	C r3 = prod_low
+	bic	r31,r31,r4	C clear cy_limb
+	umulh	r2,r19,r0	C r0 = prod_high
+	beq	r18,$Lend1	C jump if size was == 1
+	ldq	r2,8(r17)	C r2 = s1_limb
+	subq	r18,1,r18	C size--
+	stq	r3,0(r16)
+	beq	r18,$Lend2	C jump if size was == 2
+
+	ALIGN(8)
+$Loop:	mulq	r2,r19,r3	C r3 = prod_low
+	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
+	subq	r18,1,r18	C size--
+	umulh	r2,r19,r4	C r4 = cy_limb
+	ldq	r2,16(r17)	C r2 = s1_limb
+	addq	r17,8,r17	C s1_ptr++
+	addq	r3,r0,r3	C r3 = cy_limb + prod_low
+	stq	r3,8(r16)
+	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
+	addq	r16,8,r16	C res_ptr++
+	bne	r18,$Loop
+
+$Lend2:	mulq	r2,r19,r3	C r3 = prod_low
+	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
+	umulh	r2,r19,r4	C r4 = cy_limb
+	addq	r3,r0,r3	C r3 = cy_limb + prod_low
+	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
+	stq	r3,8(r16)
+	addq	r4,r0,r0	C cy_limb = prod_high + cy
+	ret	r31,(r26),1
+$Lend1:	stq	r3,0(r16)
+	ret	r31,(r26),1
+EPILOGUE(mpn_mul_1)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/rshift.asm b/src/gmp/mpn/alpha/rshift.asm
new file mode 100644
index 000000000..aa25eda54
--- /dev/null
+++ b/src/gmp/mpn/alpha/rshift.asm
@@ -0,0 +1,102 @@
+dnl  Alpha mpn_rshift -- Shift a number right.
+
+dnl  Copyright (C) 1994, 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  size	r18
+dnl  cnt	r19
+
+dnl  This code runs at 4.8 cycles/limb on the 21064.  With infinite unrolling,
+dnl  it would take 4 cycles/limb.  It should be possible to get down to 3
+dnl  cycles/limb since both ldq and stq can be paired with the other used
+dnl  instructions.  But there are many restrictions in the 21064 pipeline that
+dnl  makes it hard, if not impossible, to get down to 3 cycles/limb:
+
+dnl  1. ldq has a 3 cycle delay, srl and sll have a 2 cycle delay.
+dnl  2. Only aligned instruction pairs can be paired.
+dnl  3. The store buffer or silo might not be able to deal with the bandwidth.
+
+ASM_START()
+PROLOGUE(mpn_rshift)
+	ldq	r4,0(r17)	C load first limb
+	addq	r17,8,r17
+	subq	r31,r19,r7
+	subq	r18,1,r18
+	and	r18,4-1,r20	C number of limbs in first loop
+	sll	r4,r7,r0	C compute function result
+
+	beq	r20,$L0
+	subq	r18,r20,r18
+
+	ALIGN(8)
+$Loop0:
+	ldq	r3,0(r17)
+	addq	r16,8,r16
+	addq	r17,8,r17
+	subq	r20,1,r20
+	srl	r4,r19,r5
+	sll	r3,r7,r6
+	bis	r3,r3,r4
+	bis	r5,r6,r8
+	stq	r8,-8(r16)
+	bne	r20,$Loop0
+
+$L0:	beq	r18,$Lend
+
+	ALIGN(8)
+$Loop:	ldq	r3,0(r17)
+	addq	r16,32,r16
+	subq	r18,4,r18
+	srl	r4,r19,r5
+	sll	r3,r7,r6
+
+	ldq	r4,8(r17)
+	srl	r3,r19,r1
+	bis	r5,r6,r8
+	stq	r8,-32(r16)
+	sll	r4,r7,r2
+
+	ldq	r3,16(r17)
+	srl	r4,r19,r5
+	bis	r1,r2,r8
+	stq	r8,-24(r16)
+	sll	r3,r7,r6
+
+	ldq	r4,24(r17)
+	srl	r3,r19,r1
+	bis	r5,r6,r8
+	stq	r8,-16(r16)
+	sll	r4,r7,r2
+
+	addq	r17,32,r17
+	bis	r1,r2,r8
+	stq	r8,-8(r16)
+
+	bgt	r18,$Loop
+
+$Lend:	srl	r4,r19,r8
+	stq	r8,0(r16)
+	ret	r31,(r26),1
+EPILOGUE(mpn_rshift)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/sub_n.asm b/src/gmp/mpn/alpha/sub_n.asm
new file mode 100644
index 000000000..718f65714
--- /dev/null
+++ b/src/gmp/mpn/alpha/sub_n.asm
@@ -0,0 +1,114 @@
+dnl  Alpha mpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+dnl  store difference in a third limb vector.
+
+dnl  Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  s2_ptr	r18
+dnl  size	r19
+
+ASM_START()
+PROLOGUE(mpn_sub_n)
+	ldq	r3,0(r17)
+	ldq	r4,0(r18)
+
+	subq	r19,1,r19
+	and	r19,4-1,r2	C number of limbs in first loop
+	bis	r31,r31,r0
+	beq	r2,$L0		C if multiple of 4 limbs, skip first loop
+
+	subq	r19,r2,r19
+
+$Loop0:	subq	r2,1,r2
+	ldq	r5,8(r17)
+	addq	r4,r0,r4
+	ldq	r6,8(r18)
+	cmpult	r4,r0,r1
+	subq	r3,r4,r4
+	cmpult	r3,r4,r0
+	stq	r4,0(r16)
+	bis	r0,r1,r0
+
+	addq	r17,8,r17
+	addq	r18,8,r18
+	bis	r5,r5,r3
+	bis	r6,r6,r4
+	addq	r16,8,r16
+	bne	r2,$Loop0
+
+$L0:	beq	r19,$Lend
+
+	ALIGN(8)
+$Loop:	subq	r19,4,r19
+
+	ldq	r5,8(r17)
+	addq	r4,r0,r4
+	ldq	r6,8(r18)
+	cmpult	r4,r0,r1
+	subq	r3,r4,r4
+	cmpult	r3,r4,r0
+	stq	r4,0(r16)
+	bis	r0,r1,r0
+
+	ldq	r3,16(r17)
+	addq	r6,r0,r6
+	ldq	r4,16(r18)
+	cmpult	r6,r0,r1
+	subq	r5,r6,r6
+	cmpult	r5,r6,r0
+	stq	r6,8(r16)
+	bis	r0,r1,r0
+
+	ldq	r5,24(r17)
+	addq	r4,r0,r4
+	ldq	r6,24(r18)
+	cmpult	r4,r0,r1
+	subq	r3,r4,r4
+	cmpult	r3,r4,r0
+	stq	r4,16(r16)
+	bis	r0,r1,r0
+
+	ldq	r3,32(r17)
+	addq	r6,r0,r6
+	ldq	r4,32(r18)
+	cmpult	r6,r0,r1
+	subq	r5,r6,r6
+	cmpult	r5,r6,r0
+	stq	r6,24(r16)
+	bis	r0,r1,r0
+
+	addq	r17,32,r17
+	addq	r18,32,r18
+	addq	r16,32,r16
+	bne	r19,$Loop
+
+$Lend:	addq	r4,r0,r4
+	cmpult	r4,r0,r1
+	subq	r3,r4,r4
+	cmpult	r3,r4,r0
+	stq	r4,0(r16)
+	bis	r0,r1,r0
+	ret	r31,(r26),1
+EPILOGUE(mpn_sub_n)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/submul_1.asm b/src/gmp/mpn/alpha/submul_1.asm
new file mode 100644
index 000000000..caec1a720
--- /dev/null
+++ b/src/gmp/mpn/alpha/submul_1.asm
@@ -0,0 +1,87 @@
+dnl  Alpha __gmpn_submul_1 -- Multiply a limb vector with a limb and
+dnl  subtract the result from a second limb vector.
+
+dnl  Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+dnl  INPUT PARAMETERS
+dnl  res_ptr	r16
+dnl  s1_ptr	r17
+dnl  size	r18
+dnl  s2_limb	r19
+
+dnl  This code runs at 42 cycles/limb on EV4, 18 cycles/limb on EV5, and 7
+dnl  cycles/limb on EV6.
+
+ASM_START()
+PROLOGUE(mpn_submul_1)
+	ldq	r2,0(r17)	C r2 = s1_limb
+	addq	r17,8,r17	C s1_ptr++
+	subq	r18,1,r18	C size--
+	mulq	r2,r19,r3	C r3 = prod_low
+	ldq	r5,0(r16)	C r5 = *res_ptr
+	umulh	r2,r19,r0	C r0 = prod_high
+	beq	r18,$Lend1	C jump if size was == 1
+	ldq	r2,0(r17)	C r2 = s1_limb
+	addq	r17,8,r17	C s1_ptr++
+	subq	r18,1,r18	C size--
+	subq	r5,r3,r3
+	cmpult	r5,r3,r4
+	stq	r3,0(r16)
+	addq	r16,8,r16	C res_ptr++
+	beq	r18,$Lend2	C jump if size was == 2
+
+	ALIGN(8)
+$Loop:	mulq	r2,r19,r3	C r3 = prod_low
+	ldq	r5,0(r16)	C r5 = *res_ptr
+	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
+	subq	r18,1,r18	C size--
+	umulh	r2,r19,r4	C r4 = cy_limb
+	ldq	r2,0(r17)	C r2 = s1_limb
+	addq	r17,8,r17	C s1_ptr++
+	addq	r3,r0,r3	C r3 = cy_limb + prod_low
+	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
+	subq	r5,r3,r3
+	cmpult	r5,r3,r5
+	stq	r3,0(r16)
+	addq	r16,8,r16	C res_ptr++
+	addq	r5,r0,r0	C combine carries
+	bne	r18,$Loop
+
+$Lend2:	mulq	r2,r19,r3	C r3 = prod_low
+	ldq	r5,0(r16)	C r5 = *res_ptr
+	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
+	umulh	r2,r19,r4	C r4 = cy_limb
+	addq	r3,r0,r3	C r3 = cy_limb + prod_low
+	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
+	subq	r5,r3,r3
+	cmpult	r5,r3,r5
+	stq	r3,0(r16)
+	addq	r5,r0,r0	C combine carries
+	addq	r4,r0,r0	C cy_limb = prod_high + cy
+	ret	r31,(r26),1
+$Lend1:	subq	r5,r3,r3
+	cmpult	r5,r3,r5
+	stq	r3,0(r16)
+	addq	r0,r5,r0
+	ret	r31,(r26),1
+EPILOGUE(mpn_submul_1)
+ASM_END()
diff --git a/src/gmp/mpn/alpha/udiv_qrnnd.S b/src/gmp/mpn/alpha/udiv_qrnnd.S
new file mode 100644
index 000000000..53814bbcb
--- /dev/null
+++ b/src/gmp/mpn/alpha/udiv_qrnnd.S
@@ -0,0 +1,151 @@
+ # Alpha 21064 __udiv_qrnnd
+
+ # Copyright (C) 1992, 1994, 1995, 1997, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+	.set noreorder
+	.set noat
+.text
+	.align	3
+	.globl	__gmpn_udiv_qrnnd
+	.ent	__gmpn_udiv_qrnnd
+__gmpn_udiv_qrnnd:
+	.frame $30,0,$26,0
+	.prologue 0
+#define cnt	$2
+#define tmp	$3
+#define rem_ptr	$16
+#define n1	$17
+#define n0	$18
+#define d	$19
+#define qb	$20
+
+	ldiq	cnt,16
+	blt	d,.Largedivisor
+
+.Loop1:	cmplt	n0,0,tmp
+	addq	n1,n1,n1
+	bis	n1,tmp,n1
+	addq	n0,n0,n0
+	cmpule	d,n1,qb
+	subq	n1,d,tmp
+	cmovne	qb,tmp,n1
+	bis	n0,qb,n0
+	cmplt	n0,0,tmp
+	addq	n1,n1,n1
+	bis	n1,tmp,n1
+	addq	n0,n0,n0
+	cmpule	d,n1,qb
+	subq	n1,d,tmp
+	cmovne	qb,tmp,n1
+	bis	n0,qb,n0
+	cmplt	n0,0,tmp
+	addq	n1,n1,n1
+	bis	n1,tmp,n1
+	addq	n0,n0,n0
+	cmpule	d,n1,qb
+	subq	n1,d,tmp
+	cmovne	qb,tmp,n1
+	bis	n0,qb,n0
+	cmplt	n0,0,tmp
+	addq	n1,n1,n1
+	bis	n1,tmp,n1
+	addq	n0,n0,n0
+	cmpule	d,n1,qb
+	subq	n1,d,tmp
+	cmovne	qb,tmp,n1
+	bis	n0,qb,n0
+	subq	cnt,1,cnt
+	bgt	cnt,.Loop1
+	stq	n1,0(rem_ptr)
+	bis	$31,n0,$0
+	ret	$31,($26),1
+
+.Largedivisor:
+	and	n0,1,$4
+
+	srl	n0,1,n0
+	sll	n1,63,tmp
+	or	tmp,n0,n0
+	srl	n1,1,n1
+
+	and	d,1,$6
+	srl	d,1,$5
+	addq	$5,$6,$5
+
+.Loop2:	cmplt	n0,0,tmp
+	addq	n1,n1,n1
+	bis	n1,tmp,n1
+	addq	n0,n0,n0
+	cmpule	$5,n1,qb
+	subq	n1,$5,tmp
+	cmovne	qb,tmp,n1
+	bis	n0,qb,n0
+	cmplt	n0,0,tmp
+	addq	n1,n1,n1
+	bis	n1,tmp,n1
+	addq	n0,n0,n0
+	cmpule	$5,n1,qb
+	subq	n1,$5,tmp
+	cmovne	qb,tmp,n1
+	bis	n0,qb,n0
+	cmplt	n0,0,tmp
+	addq	n1,n1,n1
+	bis	n1,tmp,n1
+	addq	n0,n0,n0
+	cmpule	$5,n1,qb
+	subq	n1,$5,tmp
+	cmovne	qb,tmp,n1
+	bis	n0,qb,n0
+	cmplt	n0,0,tmp
+	addq	n1,n1,n1
+	bis	n1,tmp,n1
+	addq	n0,n0,n0
+	cmpule	$5,n1,qb
+	subq	n1,$5,tmp
+	cmovne	qb,tmp,n1
+	bis	n0,qb,n0
+	subq	cnt,1,cnt
+	bgt	cnt,.Loop2
+
+	addq	n1,n1,n1
+	addq	$4,n1,n1
+	bne	$6,.LOdd
+	stq	n1,0(rem_ptr)
+	bis	$31,n0,$0
+	ret	$31,($26),1
+
+.LOdd:
+	/* q' in n0. r' in n1 */
+	addq	n1,n0,n1
+	cmpult	n1,n0,tmp	# tmp := carry from addq
+	beq	tmp,.LLp6
+	addq	n0,1,n0
+	subq	n1,d,n1
+.LLp6:	cmpult	n1,d,tmp
+	bne	tmp,.LLp7
+	addq	n0,1,n0
+	subq	n1,d,n1
+.LLp7:
+	stq	n1,0(rem_ptr)
+	bis	$31,n0,$0
+	ret	$31,($26),1
+
+	.end	__gmpn_udiv_qrnnd
diff --git a/src/gmp/mpn/alpha/umul.asm b/src/gmp/mpn/alpha/umul.asm
new file mode 100644
index 000000000..44428ed5f
--- /dev/null
+++ b/src/gmp/mpn/alpha/umul.asm
@@ -0,0 +1,39 @@
+dnl  Currently unused.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published by
+dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl  option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+	.set noreorder
+	.set volatile
+	.set noat
+
+.text
+	.align 3
+	.globl __umul_ppmm
+	.ent __umul_ppmm
+__umul_ppmm:
+__umul_ppmm..ng:
+	.frame $30,0,$26,0
+	.prologue 0
+	mulq $17,$18,$1
+	umulh $17,$18,$0
+	stq $1,0($16)
+	ret $31,($26),1
+	.end __umul_ppmm
diff --git a/src/gmp/mpn/alpha/unicos.m4 b/src/gmp/mpn/alpha/unicos.m4
new file mode 100644
index 000000000..7ff26c090
--- /dev/null
+++ b/src/gmp/mpn/alpha/unicos.m4
@@ -0,0 +1,63 @@
+divert(-1)
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+define(`ASM_START',
+	`.ident	dummy')
+
+define(`X',`^X$1')
+define(`FLOAT64',
+	`dnl
+	.psect	$1@crud,data
+$1:	.t_floating $2
+	.endp')
+
+define(`PROLOGUE',
+	`dnl
+	.stack	192		; What does this mean?  Only Cray knows.
+	.psect	$1@code,code,cache
+$1::')
+define(`PROLOGUE_GP', `PROLOGUE($1)')
+
+define(`EPILOGUE',
+	`dnl
+	.endp')
+
+define(`DATASTART',
+	`dnl
+	.psect	$1@crud,data
+$1:')
+define(`DATAEND',
+	`dnl
+	.endp')
+
+define(`ASM_END',
+	`dnl
+	.end')
+
+define(`unop',`bis r31,r31,r31') ; Unicos assembler lacks unop
+define(`cvttqc',`cvttq/c')
+
+define(`ALIGN',`')		; Unicos assembler seems to align using garbage
+
+divert
+
diff --git a/src/gmp/mpn/arm/add_n.S b/src/gmp/mpn/arm/add_n.S
new file mode 100644
index 000000000..fb3f8f703
--- /dev/null
+++ b/src/gmp/mpn/arm/add_n.S
@@ -0,0 +1,77 @@
+@ ARM mpn_add -- Add two limb vectors of the same length > 0 and store sum in
+@ a third limb vector.
+@ Contributed by Robert Harley.
+
+@ Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+@ This file is part of the GNU MP Library.
+
+@ The GNU MP Library is free software; you can redistribute it and/or modify
+@ it under the terms of the GNU Lesser General Public License as published by
+@ the Free Software Foundation; either version 2.1 of the License, or (at your
+@ option) any later version.
+
+@ The GNU MP Library is distributed in the hope that it will be useful, but
+@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+@ License for more details.
+
+@ You should have received a copy of the GNU Lesser General Public License
+@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+@ MA 02111-1307, USA.
+
+#define s r0
+#define a r1
+#define b r2
+#define n r3
+
+#define sl r10
+#define fp r11
+#define ip r12
+#define sp r13
+#define lr r14
+#define pc r15
+
+.text
+	.align	0
+	.global __gmpn_add_n
+	.type	__gmpn_add_n,%function
+__gmpn_add_n:
+	stmfd	sp!, { r8, r9, lr }
+	movs	n, n, lsr #1
+	bcc	skip1
+	ldr	ip, [a], #4
+	ldr	lr, [b], #4
+	adds	ip, ip, lr
+	str	ip, [s], #4
+skip1:
+	tst	n, #1
+	beq	skip2
+	ldmia	a!, { r8, r9 }
+	ldmia	b!, { ip, lr }
+	adcs	r8, r8, ip
+	adcs	r9, r9, lr
+	stmia	s!, { r8, r9 }
+skip2:
+	bics	n, n, #1
+	beq	return
+	stmfd	sp!, { r4, r5, r6, r7 }
+add_n_loop:
+	ldmia	a!, { r4, r5, r6, r7 }
+	ldmia	b!, { r8, r9, ip, lr }
+	adcs	r4, r4, r8
+	ldr	r8, [s] /* Bring stuff into cache. */
+	adcs	r5, r5, r9
+	adcs	r6, r6, ip
+	adcs	r7, r7, lr
+	stmia	s!, { r4, r5, r6, r7 }
+	sub	n, n, #2
+	teq	n, #0
+	bne	add_n_loop
+	ldmfd	sp!, { r4, r5, r6, r7 }
+return:
+	adc	r0, n, #0
+	ldmfd	sp!, { r8, r9, pc }
+end:
+	.size	__gmpn_add_n, end - __gmpn_add_n
diff --git a/src/gmp/mpn/arm/addmul_1.S b/src/gmp/mpn/arm/addmul_1.S
new file mode 100644
index 000000000..396fff77a
--- /dev/null
+++ b/src/gmp/mpn/arm/addmul_1.S
@@ -0,0 +1,89 @@
+@ ARM mpn_mul_1 -- Multiply a limb vector with a limb and add the result to a
+@ second limb vector.
+@ Contributed by Robert Harley.
+
+@ Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+@ This file is part of the GNU MP Library.
+
+@ The GNU MP Library is free software; you can redistribute it and/or modify
+@ it under the terms of the GNU Lesser General Public License as published by
+@ the Free Software Foundation; either version 2.1 of the License, or (at your
+@ option) any later version.
+
+@ The GNU MP Library is distributed in the hope that it will be useful, but
+@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+@ License for more details.
+
+@ You should have received a copy of the GNU Lesser General Public License
+@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+@ MA 02111-1307, USA.
+
+#define p r0
+#define a r1
+#define n r2
+#define w r3
+
+#define z r11
+
+#define ip r12
+#define sp r13
+#define lr r14
+#define pc r15
+
+.text
+	.align	0
+	.global	__gmpn_addmul_1
+	.type	__gmpn_addmul_1,%function
+__gmpn_addmul_1:
+	stmfd	sp!, { r8-r11, lr }
+	mov	z, #0
+	mov	ip, #0
+	movs	n, n, lsr #1
+	bcc	skip1
+	ldr	lr, [a], #4
+	ldr	r9, [p]
+	umlal	r9, ip, w, lr
+	str	r9, [p], #4
+skip1:
+	movs	n, n, lsr #1
+	bcc	skip2
+	ldmia	p, { r9, r10 }
+	adds	r8, ip, r9
+	adc	r9, z, #0
+	ldmia	a!, { ip, lr }
+	umlal	r8, r9, w, ip
+	adds	r9, r9, r10
+	adc	ip, z, #0
+	umlal	r9, ip, w, lr
+	stmia	p!, { r8, r9 }
+skip2:
+	teq	n, #0
+	beq	return
+	stmfd	sp!, { r4-r7 }
+addmul_loop:
+	ldmia	p, { r5, r6, r7, r8 }
+	adds	r4, ip, r5
+	adc	r5, z, #0
+	ldmia	a!, { r9, r10, ip, lr }
+	umlal	r4, r5, w, r9
+	adds	r5, r5, r6
+	adc	r6, z, #0
+	umlal	r5, r6, w, r10
+	adds	r6, r6, r7
+	adc	r7, z, #0
+	umlal	r6, r7, w, ip
+	adds	r7, r7, r8
+	adc	ip, z, #0
+	umlal	r7, ip, w, lr
+	subs	n, n, #1
+	stmia	p!, { r4, r5, r6, r7 }
+	bne	addmul_loop
+	ldmfd	sp!, { r4-r7 }
+return:
+	mov	r0, ip
+	ldmfd	sp!, { r8-r11, pc }
+end:
+	.size	__gmpn_addmul_1, end - __gmpn_addmul_1
diff --git a/src/gmp/mpn/arm/gmp-mparam.h b/src/gmp/mpn/arm/gmp-mparam.h
new file mode 100644
index 000000000..a35b0c7b6
--- /dev/null
+++ b/src/gmp/mpn/arm/gmp-mparam.h
@@ -0,0 +1,34 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD 21
+#endif
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD 48
+#endif
diff --git a/src/gmp/mpn/arm/mul_1.S b/src/gmp/mpn/arm/mul_1.S
new file mode 100644
index 000000000..bae526a0f
--- /dev/null
+++ b/src/gmp/mpn/arm/mul_1.S
@@ -0,0 +1,81 @@
+@ ARM mpn_addmul_1 -- Multiply a limb vector with a limb and store the result
+@ in a second limb vector.
+@ Contributed by Robert Harley.
+
+@ Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+@ This file is part of the GNU MP Library.
+
+@ The GNU MP Library is free software; you can redistribute it and/or modify
+@ it under the terms of the GNU Lesser General Public License as published by
+@ the Free Software Foundation; either version 2.1 of the License, or (at your
+@ option) any later version.
+
+@ The GNU MP Library is distributed in the hope that it will be useful, but
+@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+@ License for more details.
+
+@ You should have received a copy of the GNU Lesser General Public License
+@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+@ MA 02111-1307, USA.
+
+#define p r0
+#define a r1
+#define n r2
+#define w r3
+
+#define sl r10
+#define fp r11
+#define ip r12
+#define sp r13
+#define lr r14
+#define pc r15
+
+.text
+	.align	0
+	.global	__gmpn_mul_1
+	.type	__gmpn_mul_1,%function
+__gmpn_mul_1:
+	stmfd	sp!, { r8, r9, lr }
+	ands	ip, n, #1
+	beq	skip1
+	ldr	lr, [a], #4
+	umull	r9, ip, w, lr
+	str	r9, [p], #4
+skip1:
+	tst	n, #2
+	beq	skip2
+	mov	r8, ip
+	ldmia	a!, { ip, lr }
+	mov	r9, #0
+	umlal	r8, r9, w, ip
+	mov	ip, #0
+	umlal	r9, ip, w, lr
+	stmia	p!, { r8, r9 }
+skip2:
+	bics	n, n, #3
+	beq	return
+	stmfd	sp!, { r6, r7 }
+mul_1_loop:
+	mov	r6, ip
+	ldmia	a!, { r8, r9, ip, lr }
+	ldr	r7, [p] /* Bring stuff into cache. */
+	mov	r7, #0
+	umlal	r6, r7, w, r8
+	mov	r8, #0
+	umlal	r7, r8, w, r9
+	mov	r9, #0
+	umlal	r8, r9, w, ip
+	mov	ip, #0
+	umlal	r9, ip, w, lr
+	subs	n, n, #4
+	stmia	p!, { r6, r7, r8, r9 }
+	bne	mul_1_loop
+	ldmfd	sp!, { r6, r7 }
+return:
+	mov	r0, ip
+	ldmfd	sp!, { r8, r9, pc }
+end:
+	.size	__gmpn_mul_1, end - __gmpn_mul_1
diff --git a/src/gmp/mpn/arm/sub_n.S b/src/gmp/mpn/arm/sub_n.S
new file mode 100644
index 000000000..856505fe2
--- /dev/null
+++ b/src/gmp/mpn/arm/sub_n.S
@@ -0,0 +1,79 @@
+@ ARM mpn_sub -- Subtract two limb vectors of the same length > 0 and store
+@ difference in a third limb vector.
+@ Contributed by Robert Harley.
+
+@ Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+@ This file is part of the GNU MP Library.
+
+@ The GNU MP Library is free software; you can redistribute it and/or modify
+@ it under the terms of the GNU Lesser General Public License as published by
+@ the Free Software Foundation; either version 2.1 of the License, or (at your
+@ option) any later version.
+
+@ The GNU MP Library is distributed in the hope that it will be useful, but
+@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+@ License for more details.
+
+@ You should have received a copy of the GNU Lesser General Public License
+@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+@ MA 02111-1307, USA.
+
+#define d r0
+#define a r1
+#define b r2
+#define n r3
+
+#define sl r10
+#define fp r11
+#define ip r12
+#define sp r13
+#define lr r14
+#define pc r15
+
+.text
+	.align	0
+	.global	__gmpn_sub_n
+	.type	__gmpn_sub_n,%function
+__gmpn_sub_n:
+	stmfd	sp!, { r8, r9, lr }
+	subs	ip, ip, ip
+	tst	n, #1
+	beq	skip1
+	ldr	ip, [a], #4
+	ldr	lr, [b], #4
+	subs	ip, ip, lr
+	str	ip, [d], #4
+skip1:
+	tst	n, #2
+	beq	skip2
+	ldmia	a!, { r8, r9 }
+	ldmia	b!, { ip, lr }
+	sbcs	r8, r8, ip
+	sbcs	r9, r9, lr
+	stmia	d!, { r8, r9 }
+skip2:
+	bics	n, n, #3
+	beq	return
+	stmfd	sp!, { r4, r5, r6, r7 }
+sub_n_loop:
+	ldmia	a!, { r4, r5, r6, r7 }
+	ldmia	b!, { r8, r9, ip, lr }
+	sbcs	r4, r4, r8
+	ldr	r8, [d] /* Bring stuff into cache. */
+	sbcs	r5, r5, r9
+	sbcs	r6, r6, ip
+	sbcs	r7, r7, lr
+	stmia	d!, { r4, r5, r6, r7 }
+	sub	n, n, #4
+	teq	n, #0
+	bne	sub_n_loop
+	ldmfd	sp!, { r4, r5, r6, r7 }
+return:
+	sbc	r0, r0, r0
+	and	r0, r0, #1
+	ldmfd	sp!, { r8, r9, pc }
+end:
+	.size	__gmpn_sub_n, end - __gmpn_sub_n
diff --git a/src/gmp/mpn/asm-defs.m4 b/src/gmp/mpn/asm-defs.m4
new file mode 100644
index 000000000..aa2024138
--- /dev/null
+++ b/src/gmp/mpn/asm-defs.m4
@@ -0,0 +1,1182 @@
+divert(-1)
+dnl
+dnl  m4 macros for gmp assembly code, shared by all CPUs.
+dnl
+dnl  These macros are designed for use with any m4 and have been used on
+dnl  GNU, FreeBSD, OpenBSD and SysV.
+dnl
+dnl  GNU m4 and OpenBSD 2.7 m4 will give filenames and line numbers in error
+dnl  messages.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+dnl  Macros:
+dnl
+dnl  Most new m4 specific macros have an "m4_" prefix to emphasise they're
+dnl  m4 expansions.  But new defining things like deflit() and defreg() are
+dnl  named like the builtin define(), and forloop() is named following the
+dnl  GNU m4 example on which it's based.
+dnl
+dnl  GNU m4 with the -P option uses "m4_" as a prefix for builtins, but that
+dnl  option isn't going to be used, so there's no conflict or confusion.
+dnl
+dnl
+dnl  Comments in output:
+dnl
+dnl  The m4 comment delimiters are left at # and \n, the normal assembler
+dnl  commenting for most CPUs.  m4 passes comment text through without
+dnl  expanding macros in it, which is generally a good thing since it stops
+dnl  unexpected expansions and possible resultant errors.
+dnl
+dnl  But note that when a quoted string is being read, a # isn't special, so
+dnl  apostrophes in comments in quoted strings must be avoided or they'll be
+dnl  interpreted as a closing quote mark.  But when the quoted text is
+dnl  re-read # will still act like a normal comment, supressing macro
+dnl  expansion.
+dnl
+dnl  For example,
+dnl
+dnl          # apostrophes in comments that're outside quotes are ok
+dnl          # and using macro names like PROLOGUE is ok too
+dnl          ...
+dnl          ifdef(`PIC',`
+dnl                  # but apostrophes aren't ok inside quotes
+dnl                  #                     ^--wrong
+dnl                  ...
+dnl                  # though macro names like PROLOGUE are still ok
+dnl                  ...
+dnl          ')
+dnl
+dnl  If macro expansion in a comment is wanted, use `#' in the .asm (ie. a
+dnl  quoted hash symbol), which will turn into # in the .s but get
+dnl  expansions done on that line.  This can make the .s more readable to
+dnl  humans, but it won't make a blind bit of difference to the assembler.
+dnl
+dnl  All the above applies, mutatis mutandis, when changecom() is used to
+dnl  select @ ! ; or whatever other commenting.
+dnl
+dnl
+dnl  Variations in m4 affecting gmp:
+dnl
+dnl  $# - When a macro is called as "foo" with no brackets, BSD m4 sets $#
+dnl       to 1, whereas GNU or SysV m4 set it to 0.  In all cases though
+dnl       "foo()" sets $# to 1.  This is worked around in various places.
+dnl
+dnl  len() - When "len()" is given an empty argument, BSD m4 evaluates to
+dnl       nothing, whereas GNU, SysV, and the new OpenBSD, evaluate to 0.
+dnl       See m4_length() below which works around this.
+dnl
+dnl  translit() - GNU m4 accepts character ranges like A-Z, and the new
+dnl       OpenBSD m4 does under option -g, but basic BSD and SysV don't.
+dnl
+dnl  popdef() - in BSD and SysV m4 popdef() takes multiple arguments and
+dnl       pops each, but GNU m4 only takes one argument.
+dnl
+dnl  push back - BSD m4 has some limits on the amount of text that can be
+dnl       pushed back.  The limit is reasonably big and so long as macros
+dnl       don't gratuitously duplicate big arguments it isn't a problem.
+dnl       Normally an error message is given, but sometimes it just hangs.
+dnl
+dnl  eval() &,|,^ - GNU and SysV m4 have bitwise operators &,|,^ available,
+dnl       but BSD m4 doesn't (contrary to what the man page suggests) and
+dnl       instead ^ is exponentiation.
+dnl
+dnl  eval() ?: - The C ternary operator "?:" is available in BSD m4, but not
+dnl       in SysV or GNU m4 (as of GNU m4 1.4 and betas of 1.5).
+dnl
+dnl  eval() -2^31 - BSD m4 has a bug where an eval() resulting in -2^31
+dnl       (ie. -2147483648) gives "-(".  Using -2147483648 within an
+dnl       expression is ok, it just can't be a final result.  "-(" will of
+dnl       course upset parsing, with all sorts of strange effects.
+dnl
+dnl  eval() <<,>> - SysV m4 doesn't support shift operators in eval() (on
+dnl       SunOS 5.7 /usr/xpg4/m4 has them but /usr/ccs/m4 doesn't).  See
+dnl       m4_lshift() and m4_rshift() below for workarounds.
+dnl
+dnl  m4wrap() - in BSD m4, m4wrap() replaces any previous m4wrap() string,
+dnl       in SysV m4 it appends to it, and in GNU m4 it prepends.  See
+dnl       m4wrap_prepend() below which brings uniformity to this.
+dnl
+dnl  __file__,__line__ - GNU m4 and OpenBSD 2.7 m4 provide these, and
+dnl       they're used here to make error messages more informative.  GNU m4
+dnl       gives an unhelpful "NONE 0" in an m4wrap(), but that's worked
+dnl       around.
+dnl
+dnl  __file__ quoting - OpenBSD m4, unlike GNU m4, doesn't quote the
+dnl       filename in __file__, so care should be taken that no macro has
+dnl       the same name as a file, or an unwanted expansion will occur when
+dnl       printing an error or warning.
+dnl
+dnl  OpenBSD 2.6 m4 - this m4 rejects decimal constants containing an 8 or 9
+dnl       in eval(), making it pretty much unusable.  This bug is confined
+dnl       to version 2.6 (it's not in 2.5, and has been fixed in 2.7).
+dnl
+dnl  SunOS /usr/bin/m4 - this m4 lacks a number of desired features,
+dnl       including $# and $@, defn(), m4exit(), m4wrap(), pushdef(),
+dnl       popdef().  /usr/5bin/m4 is a SysV style m4 which should always be
+dnl       available, and "configure" will reject /usr/bin/m4 in favour of
+dnl       /usr/5bin/m4 (if necessary).
+dnl
+dnl       The sparc code actually has modest m4 requirements currently and
+dnl       could manage with /usr/bin/m4, but there's no reason to put our
+dnl       macros through contortions when /usr/5bin/m4 is available or GNU
+dnl       m4 can be installed.
+
+
+ifdef(`__ASM_DEFS_M4_INCLUDED__',
+`m4_error(`asm-defs.m4 already included, dont include it twice
+')m4exit(1)')
+define(`__ASM_DEFS_M4_INCLUDED__')
+
+
+dnl  Detect and give a message about the unsuitable OpenBSD 2.6 m4.
+
+ifelse(eval(89),89,,
+`errprint(
+`This m4 doesnt accept 8 and/or 9 in constants in eval(), making it unusable.
+This is probably OpenBSD 2.6 m4 (September 1999).  Upgrade to OpenBSD 2.7,
+or get a bug fix from the CVS (expr.c rev 1.9), or get GNU m4.  Dont forget
+to configure with M4=/wherever/m4 if you install one of these in a directory
+not in $PATH.
+')m4exit(1)')
+
+
+dnl  Detect and give a message about the unsuitable SunOS /usr/bin/m4.
+dnl
+dnl  Unfortunately this test doesn't work when m4 is run in the normal way
+dnl  from mpn/Makefile with "m4 -DOPERATION_foo foo.asm", since the bad m4
+dnl  takes "-" in "-D..." to mean read stdin, so it will look like it just
+dnl  hangs.  But running "m4 asm-defs.m4" to try it out will work.
+dnl
+dnl  We'd like to abort immediately on finding a problem, but unfortunately
+dnl  the bad m4 doesn't have an m4exit(), nor does an invalid eval() kill
+dnl  it.  Unexpanded $#'s in some m4_assert_numargs() later on will comment
+dnl  out some closing parentheses and kill it with "m4: arg stack overflow".
+
+define(m4_dollarhash_works_test,``$#'')
+ifelse(m4_dollarhash_works_test(x),1,,
+`errprint(
+`This m4 doesnt support $# and cant be used for GMP asm processing.
+If this is on SunOS, ./configure should choose /usr/5bin/m4 if you have that
+or can get it, otherwise install GNU m4.  Dont forget to configure with
+M4=/wherever/m4 if you install in a directory not in $PATH.
+')')
+undefine(`m4_dollarhash_works_test')
+
+
+dnl  --------------------------------------------------------------------------
+dnl  Basic error handling things.
+
+
+dnl  Usage: m4_dollarhash_1_if_noparen_p
+dnl
+dnl  Expand to 1 if a call "foo" gives $# set to 1 (as opposed to 0 like GNU
+dnl  and SysV m4 give).
+
+define(m4_dollarhash_1_if_noparen_test,`$#')
+define(m4_dollarhash_1_if_noparen_p,
+eval(m4_dollarhash_1_if_noparen_test==1))
+undefine(`m4_dollarhash_1_if_noparen_test')
+
+
+dnl  Usage: m4wrap_prepend(string)
+dnl
+dnl  Prepend the given string to what will be exapanded under m4wrap at the
+dnl  end of input.
+dnl
+dnl  This macro exists to work around variations in m4wrap() behaviour in
+dnl  the various m4s (notes at the start of this file).  Don't use m4wrap()
+dnl  directly since it will interfere with this scheme.
+
+define(m4wrap_prepend,
+m4_assert_numargs(1)
+`define(`m4wrap_string',`$1'defn(`m4wrap_string'))')
+
+m4wrap(`m4wrap_string')
+define(m4wrap_string,`')
+
+
+dnl  Usage: m4_file_and_line
+dnl
+dnl  Expand to the current file and line number, if the GNU m4 extensions
+dnl  __file__ and __line__ are available.
+dnl
+dnl  In GNU m4 1.4 at the end of input when m4wrap text is expanded,
+dnl  __file__ is NONE and __line__ is 0, which is not a helpful thing to
+dnl  print.  If m4_file_seen() has been called to note the last file seen,
+dnl  then that file at a big line number is used, otherwise "end of input"
+dnl  is used (although "end of input" won't parse as an error message).
+
+define(m4_file_and_line,
+`ifdef(`__file__',
+`ifelse(__file__`'__line__,`NONE0',
+`ifdef(`m4_file_seen_last',`m4_file_seen_last: 999999: ',`end of input: ')',
+`__file__: __line__: ')')')
+
+
+dnl  Usage: m4_errprint_commas(arg,...)
+dnl
+dnl  The same as errprint(), but commas are printed between arguments
+dnl  instead of spaces.
+
+define(m4_errprint_commas,
+`errprint(`$1')dnl
+ifelse(eval($#>1),1,`errprint(`,')m4_errprint_commas(shift($@))')')
+
+
+dnl  Usage: m4_error(args...)
+dnl         m4_warning(args...)
+dnl
+dnl  Print an error message, using m4_errprint_commas, prefixed with the
+dnl  current filename and line number (if available).  m4_error sets up to
+dnl  give an error exit at the end of processing, m4_warning just prints.
+dnl  These macros are the recommended way to print errors.
+dnl
+dnl  The arguments here should be quoted in the usual way to prevent them
+dnl  being expanded when the macro call is read.  (m4_error takes care not
+dnl  to do any further expansion.)
+dnl
+dnl  For example,
+dnl
+dnl         m4_error(`some error message
+dnl         ')
+dnl
+dnl  which prints
+dnl
+dnl         foo.asm:123: some error message
+dnl
+dnl  or if __file__ and __line__ aren't available
+dnl
+dnl         some error message
+dnl
+dnl  The "file:line:" format is a basic style, used by gcc and GNU m4, so
+dnl  emacs and other editors will recognise it in their normal error message
+dnl  parsing.
+
+define(m4_warning,
+`m4_errprint_commas(m4_file_and_line`'$@)')
+
+define(m4_error,
+`define(`m4_error_occurred',1)m4_warning($@)')
+
+define(`m4_error_occurred',0)
+
+dnl  This m4wrap_prepend() is first, so it'll be executed last.
+m4wrap_prepend(
+`ifelse(m4_error_occurred,1,
+`m4_error(`Errors occurred during m4 processing
+')m4exit(1)')')
+
+
+dnl  Usage: m4_assert_numargs(num)
+dnl
+dnl  Put this unquoted on a line on its own at the start of a macro
+dnl  definition to add some code to check that num many arguments get passed
+dnl  to the macro.  For example,
+dnl
+dnl         define(foo,
+dnl         m4_assert_numargs(2)
+dnl         `something `$1' and `$2' blah blah')
+dnl
+dnl  Then a call like foo(one,two,three) will provoke an error like
+dnl
+dnl         file:10: foo expected 2 arguments, got 3 arguments
+dnl
+dnl  Here are some calls and how many arguments they're interpreted as passing.
+dnl
+dnl         foo(abc,def)  2
+dnl         foo(xyz)      1
+dnl         foo()         0
+dnl         foo          -1
+dnl
+dnl  The -1 for no parentheses at all means a macro that's meant to be used
+dnl  that way can be checked with m4_assert_numargs(-1).  For example,
+dnl
+dnl         define(SPECIAL_SUFFIX,
+dnl         m4_assert_numargs(-1)
+dnl         `ifdef(`FOO',`_foo',`_bar')')
+dnl
+dnl  But as an alternative see also deflit() below where parenthesized
+dnl  expressions following a macro are passed through to the output.
+dnl
+dnl  Note that in BSD m4 there's no way to differentiate calls "foo" and
+dnl  "foo()", so in BSD m4 the distinction between the two isn't enforced.
+dnl  (In GNU and SysV m4 it can be checked, and is.)
+
+
+dnl  m4_assert_numargs is able to check its own arguments by calling
+dnl  assert_numargs_internal directly.
+dnl
+dnl  m4_doublequote($`'0) expands to ``$0'', whereas ``$`'0'' would expand
+dnl  to `$`'0' and do the wrong thing, and likewise for $1.  The same is
+dnl  done in other assert macros.
+dnl
+dnl  $`#' leaves $# in the new macro being defined, and stops # being
+dnl  interpreted as a comment character.
+dnl
+dnl  `dnl ' means an explicit dnl isn't necessary when m4_assert_numargs is
+dnl  used.  The space means that if there is a dnl it'll still work.
+
+dnl  Usage: m4_doublequote(x) expands to ``x''
+define(m4_doublequote,
+`m4_assert_numargs_internal(`$0',1,$#,len(`$1'))``$1''')
+
+define(m4_assert_numargs,
+`m4_assert_numargs_internal(`$0',1,$#,len(`$1'))dnl
+`m4_assert_numargs_internal'(m4_doublequote($`'0),$1,$`#',`len'(m4_doublequote($`'1)))`dnl '')
+
+dnl  Called: m4_assert_numargs_internal(`macroname',wantargs,$#,len(`$1'))
+define(m4_assert_numargs_internal,
+`m4_assert_numargs_internal_check(`$1',`$2',m4_numargs_count(`$3',`$4'))')
+
+dnl  Called: m4_assert_numargs_internal_check(`macroname',wantargs,gotargs)
+dnl
+dnl  If m4_dollarhash_1_if_noparen_p (BSD m4) then gotargs can be 0 when it
+dnl  should be -1.  If wantargs is -1 but gotargs is 0 and the two can't be
+dnl  distinguished then it's allowed to pass.
+dnl
+define(m4_assert_numargs_internal_check,
+`ifelse(eval($2 == $3
+             || ($2==-1 && $3==0 && m4_dollarhash_1_if_noparen_p)),0,
+`m4_error(`$1 expected 'm4_Narguments(`$2')`, got 'm4_Narguments(`$3')
+)')')
+
+dnl  Called: m4_numargs_count($#,len(`$1'))
+dnl  If $#==0 then -1 args, if $#==1 but len(`$1')==0 then 0 args, otherwise
+dnl  $# args.
+define(m4_numargs_count,
+`ifelse($1,0, -1,
+`ifelse(eval($1==1 && $2-0==0),1, 0, $1)')')
+
+dnl  Usage: m4_Narguments(N)
+dnl  "$1 argument" or "$1 arguments" with the plural according to $1.
+define(m4_Narguments,
+`$1 argument`'ifelse(`$1',1,,s)')
+
+
+dnl  --------------------------------------------------------------------------
+dnl  Additional error checking things.
+
+
+dnl  Usage: m4_file_seen()
+dnl
+dnl  Record __file__ for the benefit of m4_file_and_line in m4wrap text.
+dnl  The basic __file__ macro comes out quoted, like `foo.asm', and
+dnl  m4_file_seen_last is defined like that too.
+dnl
+dnl  This only needs to be used with something that could generate an error
+dnl  message in m4wrap text.  The x86 PROLOGUE is the only such at the
+dnl  moment (at end of input its m4wrap checks for missing EPILOGUE).  A few
+dnl  include()s can easily trick this scheme, but you'd expect an EPILOGUE
+dnl  in the same file as the PROLOGUE.
+
+define(m4_file_seen,
+m4_assert_numargs(0)
+`ifelse(__file__,`NONE',,
+`define(`m4_file_seen_last',m4_doublequote(__file__))')')
+
+
+dnl  Usage: m4_assert_onearg()
+dnl
+dnl  Put this, unquoted, at the start of a macro definition to add some code
+dnl  to check that one argument is passed to the macro, but with that
+dnl  argument allowed to be empty.  For example,
+dnl
+dnl          define(foo,
+dnl          m4_assert_onearg()
+dnl          `blah blah $1 blah blah')
+dnl
+dnl  Calls "foo(xyz)" or "foo()" are accepted.  A call "foo(xyz,abc)" fails.
+dnl  A call "foo" fails too, but BSD m4 can't detect this case (GNU and SysV
+dnl  m4 can).
+
+define(m4_assert_onearg,
+m4_assert_numargs(0)
+`m4_assert_onearg_internal'(m4_doublequote($`'0),$`#')`dnl ')
+
+dnl  Called: m4_assert_onearg(`macroname',$#)
+define(m4_assert_onearg_internal,
+`ifelse($2,1,,
+`m4_error(`$1 expected 1 argument, got 'm4_Narguments(`$2')
+)')')
+
+
+dnl  Usage: m4_assert_numargs_range(low,high)
+dnl
+dnl  Put this, unquoted, at the start of a macro definition to add some code
+dnl  to check that between low and high many arguments get passed to the
+dnl  macro.  For example,
+dnl
+dnl         define(foo,
+dnl         m4_assert_numargs_range(3,5)
+dnl         `mandatory $1 $2 $3 optional $4 $5 end')
+dnl
+dnl  See m4_assert_numargs() for more info.
+
+define(m4_assert_numargs_range,
+m4_assert_numargs(2)
+``m4_assert_numargs_range_internal'(m4_doublequote($`'0),$1,$2,$`#',`len'(m4_doublequote($`'1)))`dnl '')
+
+dnl  Called: m4_assert_numargs_range_internal(`name',low,high,$#,len(`$1'))
+define(m4_assert_numargs_range_internal,
+m4_assert_numargs(5)
+`m4_assert_numargs_range_check(`$1',`$2',`$3',m4_numargs_count(`$4',`$5'))')
+
+dnl  Called: m4_assert_numargs_range_check(`name',low,high,gotargs)
+dnl
+dnl  If m4_dollarhash_1_if_noparen_p (BSD m4) then gotargs can be 0 when it
+dnl  should be -1.  To ensure a `high' of -1 works, a fudge is applied to
+dnl  gotargs if it's 0 and the 0 and -1 cases can't be distinguished.
+dnl
+define(m4_assert_numargs_range_check,
+m4_assert_numargs(4)
+`ifelse(eval($2 <= $4 &&
+             ($4 - ($4==0 && m4_dollarhash_1_if_noparen_p) <= $3)),0,
+`m4_error(`$1 expected $2 to $3 arguments, got 'm4_Narguments(`$4')
+)')')
+
+
+dnl  Usage: m4_assert_defined(symbol)
+dnl
+dnl  Put this unquoted on a line of its own at the start of a macro
+dnl  definition to add some code to check that the given symbol is defined
+dnl  when the macro is used.  For example,
+dnl
+dnl          define(foo,
+dnl          m4_assert_defined(`FOO_PREFIX')
+dnl          `FOO_PREFIX whatever')
+dnl
+dnl  This is a convenient way to check that the user or ./configure or
+dnl  whatever has defined the things needed by a macro, as opposed to
+dnl  silently generating garbage.
+
+define(m4_assert_defined,
+m4_assert_numargs(1)
+``m4_assert_defined_internal'(m4_doublequote($`'0),``$1'')`dnl '')
+
+dnl  Called: m4_assert_defined_internal(`macroname',`define_required')
+define(m4_assert_defined_internal,
+m4_assert_numargs(2)
+`ifdef(`$2',,
+`m4_error(`$1 needs $2 defined
+')')')
+
+
+dnl  Usage: m4_not_for_expansion(`SYMBOL')
+dnl         define_not_for_expansion(`SYMBOL')
+dnl
+dnl  m4_not_for_expansion turns SYMBOL, if defined, into something which
+dnl  will give an error if expanded.  For example,
+dnl
+dnl         m4_not_for_expansion(`PIC')
+dnl
+dnl  define_not_for_expansion is the same, but always makes a definition.
+dnl
+dnl  These are for symbols that should be tested with ifdef(`FOO',...)
+dnl  rather than be expanded as such.  They guard against accidentally
+dnl  omitting the quotes, as in ifdef(FOO,...).  Note though that they only
+dnl  catches this when FOO is defined, so be sure to test code both with and
+dnl  without each definition.
+
+define(m4_not_for_expansion,
+m4_assert_numargs(1)
+`ifdef(`$1',`define_not_for_expansion(`$1')')')
+
+define(define_not_for_expansion,
+m4_assert_numargs(1)
+`ifelse(defn(`$1'),,,
+`m4_error(``$1' has a non-empty value, maybe it shouldnt be munged with m4_not_for_expansion()
+')')dnl
+define(`$1',`m4_not_for_expansion_internal(`$1')')')
+
+define(m4_not_for_expansion_internal,
+`m4_error(``$1' is not meant to be expanded, perhaps you mean `ifdef(`$1',...)'
+')')
+
+
+dnl  --------------------------------------------------------------------------
+dnl  Various generic m4 things.
+
+
+dnl  Usage: m4_ifdef_anyof_p(`symbol',...)
+dnl
+dnl  Expand to 1 if any of the symbols in the argument list are defined, or
+dnl  to 0 if not.
+
+define(m4_ifdef_anyof_p,
+`ifelse(eval($#<=1 && m4_length(`$1')==0),1, 0,
+`ifdef(`$1', 1,
+`m4_ifdef_anyof_p(shift($@))')')')
+
+
+dnl  Usage: m4_length(string)
+dnl
+dnl  Determine the length of a string.  This is the same as len(), but
+dnl  always expands to a number, working around the BSD len() which
+dnl  evaluates to nothing given an empty argument.
+
+define(m4_length,
+m4_assert_onearg()
+`eval(len(`$1')-0)')
+
+
+dnl  Usage: m4_stringequal_p(x,y)
+dnl
+dnl  Expand to 1 or 0 according as strings x and y are equal or not.
+
+define(m4_stringequal_p,
+`ifelse(`$1',`$2',1,0)')
+
+
+dnl  Usage: m4_incr_or_decr(n,last)
+dnl
+dnl  Do an incr(n) or decr(n), whichever is in the direction of "last".
+dnl  Both n and last must be numbers of course.
+
+define(m4_incr_or_decr,
+m4_assert_numargs(2)
+`ifelse(eval($1<$2),1,incr($1),decr($1))')
+
+
+dnl  Usage: forloop(i, first, last, statement)
+dnl
+dnl  Based on GNU m4 examples/forloop.m4, but extended.
+dnl
+dnl  statement is expanded repeatedly, with i successively defined as
+dnl
+dnl         first, first+1, ..., last-1, last
+dnl
+dnl  Or if first > last, then it's
+dnl
+dnl         first, first-1, ..., last+1, last
+dnl
+dnl  If first == last, then one expansion is done.
+dnl
+dnl  A pushdef/popdef of i is done to preserve any previous definition (or
+dnl  lack of definition).  first and last are eval()ed and so can be
+dnl  expressions.
+dnl
+dnl  forloop_first is defined to 1 on the first iteration, 0 on the rest.
+dnl  forloop_last is defined to 1 on the last iteration, 0 on the others.
+dnl  Nested forloops are allowed, in which case forloop_first and
+dnl  forloop_last apply to the innermost loop that's open.
+dnl
+dnl  A simple example,
+dnl
+dnl         forloop(i, 1, 2*2+1, `dnl
+dnl         iteration number i ... ifelse(forloop_first,1,FIRST)
+dnl         ')
+
+
+dnl  "i" and "statement" are carefully quoted, but "first" and "last" are
+dnl  just plain numbers once eval()ed.
+
+define(`forloop',
+m4_assert_numargs(4)
+`pushdef(`$1',eval(`$2'))dnl
+pushdef(`forloop_first',1)dnl
+pushdef(`forloop_last',0)dnl
+forloop_internal(`$1',eval(`$3'),`$4')`'dnl
+popdef(`forloop_first')dnl
+popdef(`forloop_last')dnl
+popdef(`$1')')
+
+dnl  Called: forloop_internal(`var',last,statement)
+define(`forloop_internal',
+m4_assert_numargs(3)
+`ifelse($1,$2,
+`define(`forloop_last',1)$3',
+`$3`'dnl
+define(`forloop_first',0)dnl
+define(`$1',m4_incr_or_decr($1,$2))dnl
+forloop_internal(`$1',$2,`$3')')')
+
+
+dnl  Usage: m4_toupper(x)
+dnl         m4_tolower(x)
+dnl
+dnl  Convert the argument string to upper or lower case, respectively.
+dnl  Only one argument accepted.
+dnl
+dnl  BSD m4 doesn't take ranges like a-z in translit(), so the full alphabet
+dnl  is written out.
+
+define(m4_alphabet_lower, `abcdefghijklmnopqrstuvwxyz')
+define(m4_alphabet_upper, `ABCDEFGHIJKLMNOPQRSTUVWXYZ')
+
+define(m4_toupper,
+m4_assert_onearg()
+`translit(`$1', m4_alphabet_lower, m4_alphabet_upper)')
+
+define(m4_tolower,
+m4_assert_onearg()
+`translit(`$1', m4_alphabet_upper, m4_alphabet_lower)')
+
+
+dnl  Usage: m4_empty_if_zero(x)
+dnl
+dnl  Evaluate to x, or to nothing if x is 0.  x is eval()ed and so can be an
+dnl  expression.
+dnl
+dnl  This is useful for x86 addressing mode displacements since forms like
+dnl  (%ebx) are one byte shorter than 0(%ebx).  A macro `foo' for use as
+dnl  foo(%ebx) could be defined with the following so it'll be empty if the
+dnl  expression comes out zero.
+dnl
+dnl	   deflit(`foo', `m4_empty_if_zero(a+b*4-c)')
+dnl
+dnl  Naturally this shouldn't be done if, say, a computed jump depends on
+dnl  the code being a particular size.
+
+define(m4_empty_if_zero,
+m4_assert_onearg()
+`ifelse(eval($1),0,,eval($1))')
+
+
+dnl  Usage: m4_log2(x)
+dnl
+dnl  Calculate a logarithm to base 2.
+dnl  x must be an integral power of 2, between 2**0 and 2**30.
+dnl  x is eval()ed, so it can be an expression.
+dnl  An error results if x is invalid.
+dnl
+dnl  2**31 isn't supported, because an unsigned 2147483648 is out of range
+dnl  of a 32-bit signed int.  Also, the bug in BSD m4 where an eval()
+dnl  resulting in 2147483648 (or -2147483648 as the case may be) gives `-('
+dnl  means tests like eval(1<<31==(x)) would be necessary, but that then
+dnl  gives an unattractive explosion of eval() error messages if x isn't
+dnl  numeric.
+
+define(m4_log2,
+m4_assert_numargs(1)
+`m4_log2_internal(0,1,eval(`$1'))')
+
+dnl  Called: m4_log2_internal(n,2**n,target)
+define(m4_log2_internal,
+m4_assert_numargs(3)
+`ifelse($2,$3,$1,
+`ifelse($1,30,
+`m4_error(`m4_log2() argument too big or not a power of two: $3
+')',
+`m4_log2_internal(incr($1),eval(2*$2),$3)')')')
+
+
+dnl  Usage:  m4_div2_towards_zero
+dnl
+dnl  m4 division is probably whatever a C signed division is, and C doesn't
+dnl  specify what rounding gets used on negatives, so this expression forces
+dnl  a rounding towards zero.
+
+define(m4_div2_towards_zero,
+m4_assert_numargs(1)
+`eval((($1) + ((($1)<0) & ($1))) / 2)')
+
+
+dnl  Usage: m4_lshift(n,count)
+dnl         m4_rshift(n,count)
+dnl
+dnl  Calculate n shifted left or right by count many bits.  Both n and count
+dnl  are eval()ed and so can be expressions.
+dnl
+dnl  Negative counts are allowed and mean a shift in the opposite direction.
+dnl  Negative n is allowed and right shifts will be arithmetic (meaning
+dnl  divide by 2**count, rounding towards zero, also meaning the sign bit is
+dnl  duplicated).
+dnl
+dnl  Use these macros instead of << and >> in eval() since the basic ccs
+dnl  SysV m4 doesn't have those operators.
+
+define(m4_rshift,
+m4_assert_numargs(2)
+`m4_lshift(`$1',-(`$2'))')
+
+define(m4_lshift,
+m4_assert_numargs(2)
+`m4_lshift_internal(eval(`$1'),eval(`$2'))')
+
+define(m4_lshift_internal,
+m4_assert_numargs(2)
+`ifelse(eval($2-0==0),1,$1,
+`ifelse(eval($2>0),1,
+`m4_lshift_internal(eval($1*2),decr($2))',
+`m4_lshift_internal(m4_div2_towards_zero($1),incr($2))')')')
+
+
+dnl  Usage: deflit(name,value)
+dnl
+dnl  Like define(), but "name" expands like a literal, rather than taking
+dnl  arguments.  For example "name(%eax)" expands to "value(%eax)".
+dnl
+dnl  Limitations:
+dnl
+dnl  $ characters in the value part must have quotes to stop them looking
+dnl  like macro parameters.  For example, deflit(reg,`123+$`'4+567').  See
+dnl  defreg() below for handling simple register definitions like $7 etc.
+dnl
+dnl  "name()" is turned into "name", unfortunately.  In GNU and SysV m4 an
+dnl  error is generated when this happens, but in BSD m4 it will happen
+dnl  silently.  The problem is that in BSD m4 $# is 1 in both "name" or
+dnl  "name()", so there's no way to differentiate them.  Because we want
+dnl  plain "name" to turn into plain "value", we end up with "name()"
+dnl  turning into plain "value" too.
+dnl
+dnl  "name(foo)" will lose any whitespace after commas in "foo", for example
+dnl  "disp(%eax, %ecx)" would become "128(%eax,%ecx)".
+dnl
+dnl  These parentheses oddities shouldn't matter in assembler text, but if
+dnl  they do the suggested workaround is to write "name ()" or "name (foo)"
+dnl  to stop the parentheses looking like a macro argument list.  If a space
+dnl  isn't acceptable in the output, then write "name`'()" or "name`'(foo)".
+dnl  The `' is stripped when read, but again stops the parentheses looking
+dnl  like parameters.
+
+dnl  Quoting for deflit_emptyargcheck is similar to m4_assert_numargs.  The
+dnl  stuff in the ifelse gives a $#, $1 and $@ evaluated in the new macro
+dnl  created, not in deflit.
+define(deflit,
+m4_assert_numargs(2)
+`define(`$1',
+`deflit_emptyargcheck'(``$1'',$`#',m4_doublequote($`'1))`dnl
+$2`'dnl
+ifelse(eval($'`#>1 || m4_length('m4_doublequote($`'1)`)!=0),1,($'`@))')')
+
+dnl  Called: deflit_emptyargcheck(macroname,$#,`$1')
+define(deflit_emptyargcheck,
+`ifelse(eval($2==1 && !m4_dollarhash_1_if_noparen_p && m4_length(`$3')==0),1,
+`m4_error(`dont use a deflit as $1() because it loses the brackets (see deflit in asm-incl.m4 for more information)
+')')')
+
+
+dnl  Usage: m4_assert(`expr')
+dnl
+dnl  Test a compile-time requirement with an m4 expression.  The expression
+dnl  should be quoted, and will be eval()ed and expected to be non-zero.
+dnl  For example,
+dnl
+dnl         m4_assert(`FOO*2+6 < 14')
+
+define(m4_assert,
+m4_assert_numargs(1)
+`ifelse(eval($1),1,,
+`m4_error(`assertion failed: $1
+')')')
+
+
+dnl  --------------------------------------------------------------------------
+dnl  Various assembler things, not specific to any particular CPU.
+dnl
+
+
+dnl  Usage: include_mpn(`filename')
+dnl
+dnl  Like include(), but adds a path to the mpn source directory.  For
+dnl  example,
+dnl
+dnl         include_mpn(`sparc64/addmul_1h.asm')
+
+define(include_mpn,
+m4_assert_numargs(1)
+m4_assert_defined(`CONFIG_TOP_SRCDIR')
+`include(CONFIG_TOP_SRCDIR`/mpn/$1')')
+
+
+dnl  Usage: C comment ...
+dnl
+dnl  "C" works like a FORTRAN-style comment character.  This can be used for
+dnl  comments to the right of assembly instructions, where just dnl would
+dnl  remove the linefeed, and concatenate adjacent lines.
+dnl
+dnl  "C" and/or "dnl" are useful when an assembler doesn't support comments,
+dnl  or where different assemblers for a particular CPU have different
+dnl  comment styles.  The intermediate ".s" files will end up with no
+dnl  comments, just code.
+dnl
+dnl  Using "C" is not intended to cause offence to anyone who doesn't like
+dnl  FORTRAN; but if that happens it's an unexpected bonus.
+
+define(C, `
+dnl')
+
+
+dnl  Various possible defines passed from the Makefile that are to be tested
+dnl  with ifdef() rather than be expanded.
+
+m4_not_for_expansion(`PIC')
+
+dnl  aors_n
+m4_not_for_expansion(`OPERATION_add_n')
+m4_not_for_expansion(`OPERATION_sub_n')
+
+dnl  aorsmul_n
+m4_not_for_expansion(`OPERATION_addmul_1')
+m4_not_for_expansion(`OPERATION_submul_1')
+
+dnl  logops_n
+m4_not_for_expansion(`OPERATION_and_n')
+m4_not_for_expansion(`OPERATION_andn_n')
+m4_not_for_expansion(`OPERATION_nand_n')
+m4_not_for_expansion(`OPERATION_ior_n')
+m4_not_for_expansion(`OPERATION_iorn_n')
+m4_not_for_expansion(`OPERATION_nior_n')
+m4_not_for_expansion(`OPERATION_xor_n')
+m4_not_for_expansion(`OPERATION_xnor_n')
+
+dnl  popham
+m4_not_for_expansion(`OPERATION_popcount')
+m4_not_for_expansion(`OPERATION_hamdist')
+
+
+dnl  Usage: m4_config_gmp_mparam(`symbol')
+dnl
+dnl  Check that `symbol' is defined.  If it isn't, issue an error and
+dnl  terminate immediately.  The error message explains that the symbol
+dnl  should be in config.m4, copied from gmp-mparam.h.
+dnl
+dnl  Processing is terminated immediately since missing something like
+dnl  KARATSUBA_SQR_THRESHOLD can lead to infinite loops with endless error
+dnl  messages.
+
+define(m4_config_gmp_mparam,
+m4_assert_numargs(1)
+`ifdef(`$1',,
+`m4_error(`$1 is not defined.
+	"configure" should have extracted this from gmp-mparam.h and put it
+	in config.m4, but somehow this has failed.
+')m4exit(1)')')
+
+
+dnl  Usage: defreg(name,reg)
+dnl
+dnl  Give a name to a $ style register.  For example,
+dnl
+dnl         defreg(foo,$12)
+dnl
+dnl  defreg() inserts an extra pair of quotes after the $ so that it's not
+dnl  interpreted as an m4 macro parameter, ie. foo is actually $`'12.  m4
+dnl  strips those quotes when foo is expanded.
+dnl
+dnl  deflit() is used to make the new definition, so it will expand
+dnl  literally even if followed by parentheses ie. foo(99) will become
+dnl  $12(99).  (But there's nowhere that would be used is there?)
+dnl
+dnl  When making further definitions from existing defreg() macros, remember
+dnl  to use defreg() again to protect the $ in the new definitions too.  For
+dnl  example,
+dnl
+dnl         defreg(a0,$4)
+dnl         defreg(a1,$5)
+dnl         ...
+dnl
+dnl         defreg(PARAM_DST,a0)
+dnl
+dnl  This is only because a0 is expanding at the time the PARAM_DST
+dnl  definition is made, leaving a literal $4 that must be re-quoted.  On
+dnl  the other hand in something like the following ra is only expanded when
+dnl  ret is used and its $`'31 protection will have its desired effect at
+dnl  that time.
+dnl
+dnl         defreg(ra,$31)
+dnl         ...
+dnl         define(ret,`j ra')
+dnl
+dnl  Note that only $n forms are meant to be used here, and something like
+dnl  128($30) doesn't get protected and will come out wrong.
+
+define(defreg,
+m4_assert_numargs(2)
+`deflit(`$1',
+substr(`$2',0,1)``''substr(`$2',1))')
+
+
+dnl  Usage: m4_instruction_wrapper(num)
+dnl
+dnl  Put this, unquoted, on a line on its own, at the start of a macro
+dnl  that's a wrapper around an assembler instruction.  It adds code to give
+dnl  a descriptive error message if the macro is invoked without arguments.
+dnl
+dnl  For example, suppose jmp needs to be wrapped,
+dnl
+dnl         define(jmp,
+dnl         m4_instruction_wrapper()
+dnl         m4_assert_numargs(1)
+dnl                 `.byte 0x42
+dnl                 .long  $1
+dnl                 nop')
+dnl
+dnl  The point of m4_instruction_wrapper is to get a better error message
+dnl  than m4_assert_numargs would give if jmp is accidentally used as plain
+dnl  "jmp foo" instead of the intended "jmp( foo)".  "jmp()" with no
+dnl  argument also provokes the error message.
+dnl
+dnl  m4_instruction_wrapper should only be used with wrapped instructions
+dnl  that take arguments, since obviously something meant to be used as
+dnl  plain "ret", say, doesn't want to give an error when used that way.
+
+define(m4_instruction_wrapper,
+m4_assert_numargs(0)
+``m4_instruction_wrapper_internal'(m4_doublequote($`'0),dnl
+m4_doublequote(ifdef(`__file__',__file__,`the m4 sources')),dnl
+$`#',m4_doublequote($`'1))`dnl'')
+
+dnl  Called: m4_instruction_wrapper_internal($0,`filename',$#,$1)
+define(m4_instruction_wrapper_internal,
+`ifelse(eval($3<=1 && m4_length(`$4')==0),1,
+`m4_error(`$1 is a macro replacing that instruction and needs arguments, see $2 for details
+')')')
+
+
+dnl  Usage: UNROLL_LOG2, UNROLL_MASK, UNROLL_BYTES
+dnl         CHUNK_LOG2, CHUNK_MASK, CHUNK_BYTES
+dnl
+dnl  When code supports a variable amount of loop unrolling, the convention
+dnl  is to define UNROLL_COUNT to the number of limbs processed per loop.
+dnl  When testing code this can be varied to see how much the loop overhead
+dnl  is costing.  For example,
+dnl
+dnl         deflit(UNROLL_COUNT, 32)
+dnl
+dnl  If the forloop() generating the unrolled loop has a pattern processing
+dnl  more than one limb, the convention is to express this with CHUNK_COUNT.
+dnl  For example,
+dnl
+dnl         deflit(CHUNK_COUNT, 2)
+dnl
+dnl  The LOG2, MASK and BYTES definitions below are derived from these COUNT
+dnl  definitions.  If COUNT is redefined, the LOG2, MASK and BYTES follow
+dnl  the new definition automatically.
+dnl
+dnl  LOG2 is the log base 2 of COUNT.  MASK is COUNT-1, which can be used as
+dnl  a bit mask.  BYTES is BYTES_PER_MP_LIMB*COUNT, the number of bytes
+dnl  processed in each unrolled loop.
+dnl
+dnl  BYTES_PER_MP_LIMB is defined in a CPU specific m4 include file.  It
+dnl  exists only so the BYTES definitions here can be common to all CPUs.
+dnl  In the actual code for a given CPU, an explicit 4 or 8 may as well be
+dnl  used because the code is only for a particular CPU, it doesn't need to
+dnl  be general.
+dnl
+dnl  Note that none of these macros do anything except give conventional
+dnl  names to commonly used things.  You still have to write your own
+dnl  expressions for a forloop() and the resulting address displacements.
+dnl  Something like the following would be typical for 4 bytes per limb.
+dnl
+dnl         forloop(`i',0,UNROLL_COUNT-1,`
+dnl                 deflit(`disp',eval(i*4))
+dnl                 ...
+dnl         ')
+dnl
+dnl  Or when using CHUNK_COUNT,
+dnl
+dnl         forloop(`i',0,UNROLL_COUNT/CHUNK_COUNT-1,`
+dnl                 deflit(`disp0',eval(i*CHUNK_COUNT*4))
+dnl                 deflit(`disp1',eval(disp0+4))
+dnl                 ...
+dnl         ')
+dnl
+dnl  Clearly `i' can be run starting from 1, or from high to low or whatever
+dnl  best suits.
+
+deflit(UNROLL_LOG2,
+m4_assert_defined(`UNROLL_COUNT')
+`m4_log2(UNROLL_COUNT)')
+
+deflit(UNROLL_MASK,
+m4_assert_defined(`UNROLL_COUNT')
+`eval(UNROLL_COUNT-1)')
+
+deflit(UNROLL_BYTES,
+m4_assert_defined(`UNROLL_COUNT')
+m4_assert_defined(`BYTES_PER_MP_LIMB')
+`eval(UNROLL_COUNT * BYTES_PER_MP_LIMB)')
+ 
+deflit(CHUNK_LOG2,
+m4_assert_defined(`CHUNK_COUNT')
+`m4_log2(CHUNK_COUNT)')
+
+deflit(CHUNK_MASK,
+m4_assert_defined(`CHUNK_COUNT')
+`eval(CHUNK_COUNT-1)')
+
+deflit(CHUNK_BYTES,
+m4_assert_defined(`CHUNK_COUNT')
+m4_assert_defined(`BYTES_PER_MP_LIMB')
+`eval(CHUNK_COUNT * BYTES_PER_MP_LIMB)')
+
+
+dnl  Usage: MPN(name)
+dnl
+dnl  Add MPN_PREFIX to a name.
+dnl  MPN_PREFIX defaults to "__gmpn_" if not defined.
+
+ifdef(`MPN_PREFIX',,
+`define(`MPN_PREFIX',`__gmpn_')')
+
+define(MPN,
+m4_assert_numargs(1)
+`MPN_PREFIX`'$1')
+
+
+dnl  Usage: mpn_add_n, etc
+dnl
+dnl  Convenience definitions using MPN(), like the #defines in gmp.h.  Each
+dnl  function that might be implemented in assembler is here.
+
+define(define_mpn,
+m4_assert_numargs(1)
+`define(`mpn_$1',`MPN(`$1')')')
+
+define_mpn(add)
+define_mpn(add_1)
+define_mpn(add_n)
+define_mpn(add_nc)
+define_mpn(addmul_1)
+define_mpn(addmul_1c)
+define_mpn(addsub_n)
+define_mpn(addsub_nc)
+define_mpn(and_n)
+define_mpn(andn_n)
+define_mpn(bdivmod)
+define_mpn(cmp)
+define_mpn(com_n)
+define_mpn(copyd)
+define_mpn(copyi)
+define_mpn(divexact_by3c)
+define_mpn(divrem)
+define_mpn(divrem_1)
+define_mpn(divrem_1c)
+define_mpn(divrem_2)
+define_mpn(divrem_classic)
+define_mpn(divrem_newton)
+define_mpn(dump)
+define_mpn(gcd)
+define_mpn(gcd_1)
+define_mpn(gcdext)
+define_mpn(get_str)
+define_mpn(hamdist)
+define_mpn(invert_limb)
+define_mpn(ior_n)
+define_mpn(iorn_n)
+define_mpn(kara_mul_n)
+define_mpn(kara_sqr_n)
+define_mpn(lshift)
+define_mpn(lshiftc)
+define_mpn(mod_1)
+define_mpn(mod_1c)
+define_mpn(mul)
+define_mpn(mul_1)
+define_mpn(mul_1c)
+define_mpn(mul_basecase)
+define_mpn(mul_n)
+define_mpn(perfect_square_p)
+define_mpn(popcount)
+define_mpn(preinv_mod_1)
+define_mpn(nand_n)
+define_mpn(nior_n)
+define_mpn(random)
+define_mpn(random2)
+define_mpn(rshift)
+define_mpn(rshiftc)
+define_mpn(scan0)
+define_mpn(scan1)
+define_mpn(set_str)
+define_mpn(sqr_basecase)
+define_mpn(sub_n)
+define_mpn(sqrtrem)
+define_mpn(sub)
+define_mpn(sub_1)
+define_mpn(sub_n)
+define_mpn(sub_nc)
+define_mpn(submul_1)
+define_mpn(submul_1c)
+define_mpn(toom3_mul_n)
+define_mpn(toom3_sqr_n)
+define_mpn(umul_ppmm)
+define_mpn(udiv_qrnnd)
+define_mpn(xnor_n)
+define_mpn(xor_n)
+
+define(`ASM_START',
+	`')
+
+define(`PROLOGUE',
+	`
+	TEXT
+	ALIGN(4)
+	GLOBL	GSYM_PREFIX`$1'
+	TYPE(GSYM_PREFIX`$1',`function')
+GSYM_PREFIX`$1':')
+
+define(`EPILOGUE',
+	`
+	SIZE(GSYM_PREFIX`$1',.-GSYM_PREFIX`$1')')
+
+dnl  LSYM_PREFIX might be L$, so defn() must be used to quote it or the L
+dnl  will expand as the L macro, an infinite recursion.
+define(`L',`defn(`LSYM_PREFIX')$1')
+
+define(`INT32',
+	`
+	ALIGN(4)
+$1:
+	W32	$2
+	')
+
+define(`INT64',
+	`
+	ALIGN(8)
+$1:
+	W32	$2
+	W32	$3
+	')
+
+
+dnl  Usage: ALIGN(bytes)
+dnl
+dnl  Emit a ".align" directive.  The alignment is specified in bytes, and
+dnl  will normally need to be a power of 2.  The actual ".align" generated
+dnl  is either bytes or logarithmic according to what ./configure detects.
+dnl
+dnl  ALIGN_FILL_0x90, if defined and equal to "yes", means a ", 0x90" should
+dnl  be appended (this is for x86).
+
+define(ALIGN,
+m4_assert_numargs(1)
+m4_assert_defined(`ALIGN_LOGARITHMIC')
+`.align	ifelse(ALIGN_LOGARITHMIC,yes,`m4_log2($1)',`eval($1)')dnl
+ifelse(ALIGN_FILL_0x90,yes,`, 0x90')')
+
+
+dnl  Usage: MULFUNC_PROLOGUE(function function...)
+dnl
+dnl  A dummy macro which is grepped for by ./configure to know what
+dnl  functions a multi-function file is providing.  Use this if there aren't
+dnl  explicit PROLOGUE()s for each possible function.
+dnl
+dnl  Multiple MULFUNC_PROLOGUEs can be used, or just one with the function
+dnl  names separated by spaces.
+
+define(`MULFUNC_PROLOGUE',
+m4_assert_numargs(1)
+`')
+
+
+divert`'dnl
diff --git a/src/gmp/mpn/clipper/add_n.s b/src/gmp/mpn/clipper/add_n.s
new file mode 100644
index 000000000..538a1caed
--- /dev/null
+++ b/src/gmp/mpn/clipper/add_n.s
@@ -0,0 +1,48 @@
+; Clipper __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+; sum in a third limb vector.
+
+; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+.text
+	.align 16
+.globl ___gmpn_add_n
+___gmpn_add_n:
+	subq	$8,sp
+	storw	r6,(sp)
+	loadw	12(sp),r2
+	loadw	16(sp),r3
+	loadq	$0,r6		; clear carry-save register
+
+.Loop:	loadw	(r1),r4
+	loadw	(r2),r5
+	addwc	r6,r6		; restore carry from r6
+	addwc	r5,r4
+	storw	r4,(r0)
+	subwc	r6,r6		; save carry in r6
+	addq	$4,r0
+	addq	$4,r1
+	addq	$4,r2
+	subq	$1,r3
+	brne	.Loop
+
+	negw	r6,r0
+	loadw	(sp),r6
+	addq	$8,sp
+	ret	sp
diff --git a/src/gmp/mpn/clipper/mul_1.s b/src/gmp/mpn/clipper/mul_1.s
new file mode 100644
index 000000000..c0c756488
--- /dev/null
+++ b/src/gmp/mpn/clipper/mul_1.s
@@ -0,0 +1,47 @@
+; Clipper __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+; the result in a second limb vector.
+
+; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+.text
+	.align	16
+.globl	___gmpn_mul_1
+___gmpn_mul_1:
+	subq	$8,sp
+	storw	r6,(sp)
+	loadw	12(sp),r2
+	loadw	16(sp),r3
+	loadq	$0,r6		; clear carry limb
+
+.Loop:	loadw	(r1),r4
+	mulwux	r3,r4
+	addw	r6,r4		; add old carry limb into low product limb
+	loadq	$0,r6
+	addwc	r5,r6		; propagate cy into high product limb
+	storw	r4,(r0)
+	addq	$4,r0
+	addq	$4,r1
+	subq	$1,r2
+	brne	.Loop
+
+	movw	r6,r0
+	loadw	0(sp),r6
+	addq	$8,sp
+	ret	sp
diff --git a/src/gmp/mpn/clipper/sub_n.s b/src/gmp/mpn/clipper/sub_n.s
new file mode 100644
index 000000000..44d879728
--- /dev/null
+++ b/src/gmp/mpn/clipper/sub_n.s
@@ -0,0 +1,48 @@
+; Clipper __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+; store difference in a third limb vector.
+
+; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+.text
+	.align 16
+.globl ___gmpn_sub_n
+___gmpn_sub_n:
+	subq	$8,sp
+	storw	r6,(sp)
+	loadw	12(sp),r2
+	loadw	16(sp),r3
+	loadq	$0,r6		; clear carry-save register
+
+.Loop:	loadw	(r1),r4
+	loadw	(r2),r5
+	addwc	r6,r6		; restore carry from r6
+	subwc	r5,r4
+	storw	r4,(r0)
+	subwc	r6,r6		; save carry in r6
+	addq	$4,r0
+	addq	$4,r1
+	addq	$4,r2
+	subq	$1,r3
+	brne	.Loop
+
+	negw	r6,r0
+	loadw	(sp),r6
+	addq	$8,sp
+	ret	sp
diff --git a/src/gmp/mpn/cray/README b/src/gmp/mpn/cray/README
new file mode 100644
index 000000000..8195c67e2
--- /dev/null
+++ b/src/gmp/mpn/cray/README
@@ -0,0 +1,14 @@
+The (poorly optimized) code in this directory was originally written for a
+j90 system, but finished on a c90.  It should work on all Cray vector
+computers.  For the T3E and T3D systems, the `alpha' subdirectory at the
+same level as the directory containing this file, is much better.
+
+* `+' seems to be faster than `|' when combining carries.
+
+* It is possible that the best multiply performance would be achived by
+  storing only 24 bits per element, and using lazy carry propagation.  Before
+  calling i24mult, full carry propagation would be needed.
+
+* Supply tasking versions of the C loops.
+
+
diff --git a/src/gmp/mpn/cray/add_n.c b/src/gmp/mpn/cray/add_n.c
new file mode 100644
index 000000000..1fdb39499
--- /dev/null
+++ b/src/gmp/mpn/cray/add_n.c
@@ -0,0 +1,96 @@
+/* mpn_add_n -- Add two limb vectors of equal, non-zero length.
+   For Cray vector processors.
+
+   Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+   This file is part of the GNU MP Library.
+
+   The GNU MP Library is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2.1 of the License, or (at your
+   option) any later version.
+
+   The GNU MP Library is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+   the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+   MA 02111-1307, USA.  */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+mpn_add_n (c, a, b, n)
+     mp_ptr c;
+     mp_srcptr a, b;
+     mp_size_t n;
+{
+  mp_size_t i;
+  mp_size_t nm1 = n - 1;
+  int more_carries = 0;
+  int carry_out;
+
+  /* For small operands the non-vector code is faster.  */
+  if (n < 16)
+    goto sequential;
+
+  if (a == c || b == c)
+    {
+      TMP_DECL (marker);
+      TMP_MARK (marker);
+      if (c == a)
+	{
+	  /* allocate temp space for a */
+	  mp_ptr ax = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+	  MPN_COPY (ax, a, n);
+	  a = (mp_srcptr) ax;
+	}
+      if (c == b)
+	{
+	  /* allocate temp space for b */
+	  mp_ptr bx = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+	  MPN_COPY (bx, b, n);
+	  b = (mp_srcptr) bx;
+	}
+      carry_out = mpn_add_n (c, a, b, n);
+      TMP_FREE (marker);
+      return carry_out;
+    }
+
+  carry_out = a[nm1] + b[nm1] < a[nm1];
+
+#pragma _CRI ivdep			/* Cray PVP systems */
+  for (i = nm1; i > 0; i--)
+    {
+      int cy_in;
+      cy_in = a[i - 1] + b[i - 1] < a[i - 1];
+      c[i] = a[i] + b[i] + cy_in;
+      more_carries += c[i] < cy_in;
+    }
+  c[0] = a[0] + b[0];
+
+  if (more_carries)
+    {
+      /* This won't vectorize, but we should come here rarely.  */
+      int cy;
+    sequential:
+      cy = 0;
+      for (i = 0; i < n; i++)
+	{
+	  mp_limb_t ai, ci, t;
+	  ai = a[i];
+	  t = b[i] + cy;
+	  cy = t < cy;
+	  ci = ai + t;
+	  cy += ci < ai;
+	  c[i] = ci;
+	}
+      carry_out = cy;
+    }
+
+  return carry_out;
+}
diff --git a/src/gmp/mpn/cray/addmul_1.c b/src/gmp/mpn/cray/addmul_1.c
new file mode 100644
index 000000000..031b4e8e8
--- /dev/null
+++ b/src/gmp/mpn/cray/addmul_1.c
@@ -0,0 +1,46 @@
+/* mpn_addmul_1 for Cray PVP.
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.  */
+
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+mpn_addmul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t limb)
+{
+  mp_ptr p0, p1, tp;
+  mp_limb_t cy_limb;
+  TMP_DECL (marker);
+  TMP_MARK (marker);
+
+  p1 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+  p0 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+  tp = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+
+  GMPN_MULWW (p1, p0, up, &n, &limb);
+  cy_limb = mpn_add_n (tp, rp, p0, n);
+  rp[0] = tp[0];
+  cy_limb += mpn_add_n (rp + 1, tp + 1, p1, n - 1);
+  cy_limb += p1[n - 1];
+
+  TMP_FREE (marker);
+  return cy_limb;
+}
diff --git a/src/gmp/mpn/cray/gmp-mparam.h b/src/gmp/mpn/cray/gmp-mparam.h
new file mode 100644
index 000000000..14f7b8e05
--- /dev/null
+++ b/src/gmp/mpn/cray/gmp-mparam.h
@@ -0,0 +1,27 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 64
+#define BYTES_PER_MP_LIMB 8
+#define BITS_PER_LONGINT 64
+#define BITS_PER_INT 64
+#define BITS_PER_SHORTINT 32
+#define BITS_PER_CHAR 8
diff --git a/src/gmp/mpn/cray/mul_1.c b/src/gmp/mpn/cray/mul_1.c
new file mode 100644
index 000000000..0c8750b4a
--- /dev/null
+++ b/src/gmp/mpn/cray/mul_1.c
@@ -0,0 +1,44 @@
+/* mpn_mul_1 for Cray PVP.
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.  */
+
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+mpn_mul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t limb)
+{
+  mp_ptr p0, p1;
+  mp_limb_t cy_limb;
+  TMP_DECL (marker);
+  TMP_MARK (marker);
+
+  p1 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+  p0 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+
+  GMPN_MULWW (p1, p0, up, &n, &limb);
+  rp[0] = p0[0];
+  cy_limb = mpn_add_n (rp + 1, p0 + 1, p1, n - 1);
+  cy_limb += p1[n - 1];
+
+  TMP_FREE (marker);
+  return cy_limb;
+}
diff --git a/src/gmp/mpn/cray/mulww.f b/src/gmp/mpn/cray/mulww.f
new file mode 100644
index 000000000..99507c1e4
--- /dev/null
+++ b/src/gmp/mpn/cray/mulww.f
@@ -0,0 +1,54 @@
+c     Helper for mpn_mul_1, mpn_addmul_1, and mpn_submul_1 for Cray PVP.
+
+c     Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+c     This file is part of the GNU MP Library.
+
+c     The GNU MP Library is free software; you can redistribute it and/or
+c     modify it under the terms of the GNU Lesser General Public License as
+c     published by the Free Software Foundation; either version 2.1 of the
+c     License, or (at your option) any later version.
+
+c     The GNU MP Library is distributed in the hope that it will be useful,
+c     but WITHOUT ANY WARRANTY; without even the implied warranty of
+c     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+c     Lesser General Public License for more details.
+
+c     You should have received a copy of the GNU Lesser General Public
+c     License along with the GNU MP Library; see the file COPYING.LIB.  If
+c     not, write to the Free Software Foundation, Inc., 59 Temple Place -
+c     Suite 330, Boston, MA 02111-1307, USA.
+
+c     p1[] = hi(a[]*s); the upper limbs of each product
+c     p0[] = low(a[]*s); the corresponding lower limbs
+c     n is number of limbs in the vectors
+
+      subroutine gmpn_mulww(p1,p0,a,n,s)
+      integer*8 p1(0:*),p0(0:*),a(0:*),s
+      integer n
+
+      integer*8 a0,a1,a2,s0,s1,s2,c
+      integer*8 ai,t0,t1,t2,t3,t4
+
+      s0 = shiftl(and(s,4194303),24)
+      s1 = shiftl(and(shiftr(s,22),4194303),24)
+      s2 = shiftl(and(shiftr(s,44),4194303),24)
+
+      do i = 0,n-1
+         ai = a(i)
+         a0 = shiftl(and(ai,4194303),24)
+         a1 = shiftl(and(shiftr(ai,22),4194303),24)
+         a2 = shiftl(and(shiftr(ai,44),4194303),24)
+
+         t0 = i24mult(a0,s0)
+         t1 = i24mult(a0,s1)+i24mult(a1,s0)
+         t2 = i24mult(a0,s2)+i24mult(a1,s1)+i24mult(a2,s0)
+         t3 = i24mult(a1,s2)+i24mult(a2,s1)
+         t4 = i24mult(a2,s2)
+
+         p0(i)=shiftl(t2,44)+shiftl(t1,22)+t0
+         c=shiftr(shiftr(t0,22)+and(t1,4398046511103)+
+     $        shiftl(and(t2,1048575),22),42)
+         p1(i)=shiftl(t4,24)+shiftl(t3,2)+shiftr(t2,20)+shiftr(t1,42)+c
+      end do
+      end
diff --git a/src/gmp/mpn/cray/mulww.s b/src/gmp/mpn/cray/mulww.s
new file mode 100644
index 000000000..890cdcf94
--- /dev/null
+++ b/src/gmp/mpn/cray/mulww.s
@@ -0,0 +1,245 @@
+*     Helper for mpn_mul_1, mpn_addmul_1, and mpn_submul_1 for Cray PVP.
+
+*     Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+*     This file is generated from mulww.f in this same directory.
+
+*     This file is part of the GNU MP Library.
+
+*     The GNU MP Library is free software; you can redistribute it and/or
+*     modify it under the terms of the GNU Lesser General Public License as
+*     published by the Free Software Foundation; either version 2.1 of the
+*     License, or (at your option) any later version.
+
+*     The GNU MP Library is distributed in the hope that it will be useful,
+*     but WITHOUT ANY WARRANTY; without even the implied warranty of
+*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+*     Lesser General Public License for more details.
+
+*     You should have received a copy of the GNU Lesser General Public
+*     License along with the GNU MP Library; see the file COPYING.LIB.  If
+*     not, write to the Free Software Foundation, Inc., 59 Temple Place -
+*     Suite 330, Boston, MA 02111-1307, USA.
+
+            IDENT           GMPN_MULWW
+**********************************************
+*      Assemble with Cal Version 2.0         *
+*                                            *
+* Generated by CFT77   6.0.4.19              *
+*           on 06/27/00 at 04:34:13          *
+*                                            *
+**********************************************
+* ALLOW UNDERSCORES IN IDENTIFIERS
+            EDIT            OFF
+            FORMAT          NEW
+@DATA       SECTION         DATA,CM
+@DATA       =               W.*
+            CON             O'0000000000040000000000
+            CON             O'0435152404713723252514        ;GMPN_MUL       1
+            CON             O'0535270000000000000000        ;WW             1
+            CON             O'0000000000000001200012        ;trbk tbl       1
+            VWD             32/0,32/P.GMPN_MULWW            ;trbk tbl       1
+            CON             O'0014003000000000001416        ;trbk tbl       1
+            CON             O'0000000000000000000011        ;trbk tbl       1
+            CON             O'0000000000000000000215        ;trbk tbl       1
+            BSSZ            1                               ;trbk tbl       1
+@CODE       SECTION         CODE
+@CODE       =               P.*
+L3          =               P.*                             ;               1
+            A0              A6                              ;arg base       1
+            A5              6                               ;num Darg       1
+            B03,A5          0,A0                            ;load DAs       1
+            A0              A1+A2                           ;               1
+            A5              1                               ;num Ts         1
+            0,A0            T00,A5                          ;               1
+            B02             A2                              ;new base       1
+            B66             A3                              ;stk top        1
+            B01             A6                              ;arg base       1
+            A7              P.L4                            ;ofrn rtn       1
+            B00             A7                              ;return         1
+            A6              @DATA                           ;               1
+            J               $STKOFEN                        ;$STKOFEN       1
+GMPN_MULWW  =               P.*                             ;               1
+            A0              @DATA+3                         ;(trbk)         1
+            B77             A0                              ;(trbk)         1
+            A1              13                              ;num Bs         1
+            A0              B66                             ;stk top        1
+            A2              B66                             ;stk tmp        1
+            A4              B67                             ;stk limt       1
+            0,A0            B77,A1                          ;               1
+            A7              782                             ;stk size       1
+            A3              A2+A7                           ;               1
+            A0              A4-A3                           ;               1
+            JAM             L3                              ;overflow       1
+            A0              A6                              ;arg base       1
+            A5              6                               ;num Darg       1
+            B03,A5          0,A0                            ;load DAs       1
+            A0              A1+A2                           ;               1
+            A5              1                               ;num Ts         1
+            0,A0            T00,A5                          ;               1
+            B02             A2                              ;new base       1
+            B66             A3                              ;new top        1
+            B01             A6                              ;arg base       1
+L4          =               P.*                             ;ofrn rtn       1
+            A7              B07                             ;regs          14
+            S7              0,A7                            ;              14
+            A6              B10                             ;regs           9
+            S6              0,A6                            ;               9
+            S5              1                               ;              14
+            S4              <22                             ;               9
+            S7              S7-S5                           ;              14
+            S5              #S7                             ;              14
+            T00             S6                              ;regs          10
+            S6              S6>22                           ;              10
+            S7              T00                             ;regs          11
+            S7              S7>44                           ;              11
+            S3              T00                             ;regs           9
+            S3              S3&S4                           ;               9
+            S6              S6&S4                           ;              10
+            S7              S7&S4                           ;              11
+            S3              S3<24                           ;               9
+            S6              S6<24                           ;              10
+            S7              S7<24                           ;              11
+            S0              S5                              ;regs          14
+            S4              S5                              ;regs          14
+            S1              S6                              ;regs          14
+            S2              S3                              ;regs          14
+            S3              S7                              ;regs          14
+            JSP             L5                              ;              14
+L6          =               P.*                             ;              14
+            S7              -S4                             ;              14
+            A2              S7                              ;regs          14
+            VL              A2                              ;regs          14
+            A3              B06                             ;s_bt_sp       14
+            A5              B05                             ;s_bt_sp       14
+            A4              B04                             ;s_bt_sp       14
+            A1              VL                              ;              14
+            A2              S4                              ;regs          14
+L7          =               P.*                             ;              14
+            A0              A3                              ;regs          15
+            VL              A1                              ;regs          15
+            V7              ,A0,1                           ;              15
+            B11             A5                              ;s_bt_sp       15
+            A7              22                              ;              17
+            B12             A4                              ;s_bt_sp       17
+            V6              V7>A7                           ;              17
+            B13             A3                              ;s_bt_sp       17
+            S7              <22                             ;              17
+            A3              B02                             ;s_bt_sp       17
+            V5              S7&V6                           ;              17
+            A6              24                              ;              17
+            V4              V5<A6                           ;              17
+            V3              S1*FV4                          ;              22
+            V2              S7&V7                           ;              16
+            V1              V2<A6                           ;              16
+            V0              S3*FV1                          ;              22
+            V6              V0+V3                           ;              22
+            A5              44                              ;              18
+            V5              V7>A5                           ;              18
+            V2              S1*FV1                          ;              21
+            V3              S7&V5                           ;              18
+            A0              14                              ;              34
+            B77             A0                              ;regs          34
+            A4              B77                             ;regs          34
+            A0              A4+A3                           ;              34
+            ,A0,1           V2                              ;v_ld_str      34
+            V0              V3<A6                           ;              18
+            V7              S2*FV1                          ;              20
+            A4              142                             ;              34
+            A0              A4+A3                           ;              34
+            ,A0,1           V7                              ;v_ld_str      34
+            V5              V7>A7                           ;              28
+            V2              S2*FV0                          ;              22
+            V3              V6+V2                           ;              22
+            S7              <20                             ;              28
+            V1              S7&V3                           ;              28
+            A4              270                             ;              34
+            A0              A4+A3                           ;              34
+            ,A0,1           V0                              ;v_ld_str      34
+            A4              14                              ;              34
+            A0              A4+A3                           ;              34
+            V7              ,A0,1                           ;v_ld_str      34
+            V6              V1<A7                           ;              28
+            V2              S2*FV4                          ;              21
+            V0              V7+V2                           ;              21
+            S7              <42                             ;              28
+            V1              S7&V0                           ;              28
+            A4              398                             ;              34
+            A0              A4+A3                           ;              34
+            ,A0,1           V0                              ;v_ld_str      34
+            V7              S3*FV4                          ;              23
+            V2              V5+V1                           ;              28
+            V0              V3<A5                           ;              26
+            A5              526                             ;              34
+            A0              A5+A3                           ;              34
+            ,A0,1           V0                              ;v_ld_str      34
+            A5              270                             ;              34
+            A0              A5+A3                           ;              34
+            V4              ,A0,1                           ;v_ld_str      34
+            V5              V2+V6                           ;              28
+            A5              20                              ;              32
+            V1              V3>A5                           ;              32
+            V0              S1*FV4                          ;              23
+            A5              654                             ;              34
+            A0              A5+A3                           ;              34
+            ,A0,1           V1                              ;v_ld_str      34
+            V6              V7+V0                           ;              23
+            A5              2                               ;              32
+            V2              V6<A5                           ;              32
+            V3              S3*FV4                          ;              24
+            A5              142                             ;              34
+            A0              A5+A3                           ;              34
+            V1              ,A0,1                           ;v_ld_str      34
+            A5              526                             ;              34
+            A0              A5+A3                           ;              34
+            V7              ,A0,1                           ;v_ld_str      34
+            V0              V1+V7                           ;              26
+            V6              V3<A6                           ;              32
+            V4              V6+V2                           ;              32
+            A6              42                              ;              28
+            V7              V5>A6                           ;              28
+            A5              654                             ;              34
+            CPW                                             ;cmr_vrsp      34
+            A0              A5+A3                           ;              34
+            V1              ,A0,1                           ;v_ld_str      34
+            A5              398                             ;              34
+            A0              A5+A3                           ;              34
+            V3              ,A0,1                           ;v_ld_str      34
+            V6              V4+V1                           ;              32
+            V2              V3>A6                           ;              32
+            V5              V6+V2                           ;              32
+            A6              B12                             ;s_bt_sp       32
+            V4              V3<A7                           ;              26
+            A7              B13                             ;regs          34
+            A3              A7+A1                           ;              34
+            A7              B11                             ;regs          34
+            A5              A7+A1                           ;              34
+            A4              A6+A1                           ;              34
+            A7              A2+A1                           ;              34
+            A0              A2+A1                           ;              34
+            A2              128                             ;              34
+            B13             A0                              ;s_bt_sp       34
+            V1              V0+V4                           ;              26
+            A0              B11                             ;regs          31
+            ,A0,1           V1                              ;              31
+            V6              V5+V7                           ;              33
+            A0              A6                              ;regs          33
+            ,A0,1           V6                              ;              33
+            A0              B13                             ;regs          34
+            A1              A2                              ;regs          34
+            A2              A7                              ;regs          34
+            JAN             L7                              ;              34
+L8          =               P.*                             ;              34
+L5          =               P.*                             ;              34
+            S1              0                               ;              35
+            A0              B02                             ;              35
+            A2              B02                             ;              35
+            A1              13                              ;num Bs        35
+            B66             A0                              ;              35
+            B77,A1          0,A0                            ;              35
+            A0              A2+A1                           ;              35
+            A1              1                               ;num Ts        35
+            T00,A1          0,A0                            ;              35
+            J               B00                             ;              35
+            EXT             $STKOFEN:p
+            ENTRY           GMPN_MULWW
+            END
diff --git a/src/gmp/mpn/cray/sub_n.c b/src/gmp/mpn/cray/sub_n.c
new file mode 100644
index 000000000..902e07a72
--- /dev/null
+++ b/src/gmp/mpn/cray/sub_n.c
@@ -0,0 +1,97 @@
+/* mpn_sub_n -- Subtract two limb vectors of equal, non-zero length.
+   For Cray vector processors.
+
+   Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+   This file is part of the GNU MP Library.
+
+   The GNU MP Library is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2.1 of the License, or (at your
+   option) any later version.
+
+   The GNU MP Library is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+   the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+   MA 02111-1307, USA.  */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+mpn_sub_n (c, a, b, n)
+     mp_ptr c;
+     mp_srcptr a, b;
+     mp_size_t n;
+{
+  mp_size_t i;
+  mp_size_t nm1 = n - 1;
+  int more_carries = 0;
+  int carry_out;
+
+  /* For small operands the non-vector code is faster.  */
+  if (n < 16)
+    goto sequential;
+
+  if (a == c || b == c)
+    {
+      TMP_DECL (marker);
+      TMP_MARK (marker);
+      if (c == a)
+	{
+	  /* allocate temp space for a */
+	  mp_ptr ax = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+	  MPN_COPY (ax, a, n);
+	  a = (mp_srcptr) ax;
+	}
+      if (c == b)
+	{
+	  /* allocate temp space for b */
+	  mp_ptr bx = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+	  MPN_COPY (bx, b, n);
+	  b = (mp_srcptr) bx;
+	}
+      carry_out = mpn_sub_n (c, a, b, n);
+      TMP_FREE (marker);
+      return carry_out;
+    }
+
+  carry_out = a[nm1] < b[nm1];
+
+#pragma _CRI ivdep			/* Cray PVP systems */
+  for (i = nm1; i > 0; i--)
+    {
+      int cy_in; mp_limb_t t;
+      cy_in = a[i - 1] < b[i - 1];
+      t = a[i] - b[i];
+      more_carries += t < cy_in;
+      c[i] = t - cy_in;
+    }
+  c[0] = a[0] - b[0];
+
+  if (more_carries)
+    {
+      /* This won't vectorize, but we should come here rarely.  */
+      int cy;
+    sequential:
+      cy = 0;
+      for (i = 0; i < n; i++)
+	{
+	  mp_limb_t ai, ci, t;
+	  ai = a[i];
+	  t = b[i] + cy;
+	  cy = t < cy;
+	  ci = ai - t;
+	  cy += ci > ai;
+	  c[i] = ci;
+	}
+      carry_out = cy;
+    }
+
+  return carry_out;
+}
diff --git a/src/gmp/mpn/cray/submul_1.c b/src/gmp/mpn/cray/submul_1.c
new file mode 100644
index 000000000..4d2fb13c6
--- /dev/null
+++ b/src/gmp/mpn/cray/submul_1.c
@@ -0,0 +1,46 @@
+/* mpn_submul_1 for Cray PVP.
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.  */
+
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+mpn_submul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t limb)
+{
+  mp_ptr p0, p1, tp;
+  mp_limb_t cy_limb;
+  TMP_DECL (marker);
+  TMP_MARK (marker);
+
+  p1 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+  p0 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+  tp = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+
+  GMPN_MULWW (p1, p0, up, &n, &limb);
+  cy_limb = mpn_sub_n (tp, rp, p0, n);
+  rp[0] = tp[0];
+  cy_limb += mpn_sub_n (rp + 1, tp + 1, p1, n - 1);
+  cy_limb += p1[n - 1];
+
+  TMP_FREE (marker);
+  return cy_limb;
+}
diff --git a/src/gmp/mpn/generic/add_n.c b/src/gmp/mpn/generic/add_n.c
new file mode 100644
index 000000000..5fcb7e483
--- /dev/null
+++ b/src/gmp/mpn/generic/add_n.c
@@ -0,0 +1,62 @@
+/* mpn_add_n -- Add two limb vectors of equal, non-zero length.
+
+Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+#if __STDC__
+mpn_add_n (mp_ptr res_ptr, mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
+#else
+mpn_add_n (res_ptr, s1_ptr, s2_ptr, size)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_srcptr s2_ptr;
+     mp_size_t size;
+#endif
+{
+  register mp_limb_t x, y, cy;
+  register mp_size_t j;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  s1_ptr -= j;
+  s2_ptr -= j;
+  res_ptr -= j;
+
+  cy = 0;
+  do
+    {
+      y = s2_ptr[j];
+      x = s1_ptr[j];
+      y += cy;			/* add previous carry to one addend */
+      cy = (y < cy);		/* get out carry from that addition */
+      y = x + y;		/* add other addend */
+      cy = (y < x) + cy;	/* get out carry from that add, combine */
+      res_ptr[j] = y;
+    }
+  while (++j != 0);
+
+  return cy;
+}
diff --git a/src/gmp/mpn/generic/addmul_1.c b/src/gmp/mpn/generic/addmul_1.c
new file mode 100644
index 000000000..746ae3130
--- /dev/null
+++ b/src/gmp/mpn/generic/addmul_1.c
@@ -0,0 +1,65 @@
+/* mpn_addmul_1 -- multiply the S1_SIZE long limb vector pointed to by S1_PTR
+   by S2_LIMB, add the S1_SIZE least significant limbs of the product to the
+   limb vector pointed to by RES_PTR.  Return the most significant limb of
+   the product, adjusted for carry-out from the addition.
+
+Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+mp_limb_t
+mpn_addmul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     mp_size_t s1_size;
+     register mp_limb_t s2_limb;
+{
+  register mp_limb_t cy_limb;
+  register mp_size_t j;
+  register mp_limb_t prod_high, prod_low;
+  register mp_limb_t x;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -s1_size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  res_ptr -= j;
+  s1_ptr -= j;
+
+  cy_limb = 0;
+  do
+    {
+      umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
+
+      prod_low += cy_limb;
+      cy_limb = (prod_low < cy_limb) + prod_high;
+
+      x = res_ptr[j];
+      prod_low = x + prod_low;
+      cy_limb += (prod_low < x);
+      res_ptr[j] = prod_low;
+    }
+  while (++j != 0);
+
+  return cy_limb;
+}
diff --git a/src/gmp/mpn/generic/addsub_n.c b/src/gmp/mpn/generic/addsub_n.c
new file mode 100644
index 000000000..c9bab3ef6
--- /dev/null
+++ b/src/gmp/mpn/generic/addsub_n.c
@@ -0,0 +1,167 @@
+/* mpn_addsub_n -- Add and Subtract two limb vectors of equal, non-zero length.
+
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#ifndef L1_CACHE_SIZE
+#define L1_CACHE_SIZE 8192	/* only 68040 has less than this */
+#endif
+
+#define PART_SIZE (L1_CACHE_SIZE / BYTES_PER_MP_LIMB / 6)
+
+
+/* mpn_addsub_n.
+   r1[] = s1[] + s2[]
+   r2[] = s1[] - s2[]
+   All operands have n limbs.
+   In-place operations allowed.  */
+mp_limb_t
+#if __STDC__
+mpn_addsub_n (mp_ptr r1p, mp_ptr r2p, mp_srcptr s1p, mp_srcptr s2p, mp_size_t n)
+#else
+mpn_addsub_n (r1p, r2p, s1p, s2p, n)
+     mp_ptr r1p, r2p;
+     mp_srcptr s1p, s2p;
+     mp_size_t n;
+#endif
+{
+  mp_limb_t acyn, acyo;		/* carry for add */
+  mp_limb_t scyn, scyo;		/* carry for subtract */
+  mp_size_t off;		/* offset in operands */
+  mp_size_t this_n;		/* size of current chunk */
+
+  /* We alternatingly add and subtract in chunks that fit into the (L1)
+     cache.  Since the chunks are several hundred limbs, the function call
+     overhead is insignificant, but we get much better locality.  */
+
+  /* We have three variant of the inner loop, the proper loop is chosen
+     depending on whether r1 or r2 are the same operand as s1 or s2.  */
+
+  if (r1p != s1p && r1p != s2p)
+    {
+      /* r1 is not identical to either input operand.  We can therefore write
+	 to r1 directly, without using temporary storage.  */
+      acyo = 0;
+      scyo = 0;
+      for (off = 0; off < n; off += PART_SIZE)
+	{
+	  this_n = MIN (n - off, PART_SIZE);
+#if HAVE_NATIVE_mpn_add_nc || !HAVE_NATIVE_mpn_add_n
+	  acyo = mpn_add_nc (r1p + off, s1p + off, s2p + off, this_n, acyo);
+#else
+	  acyn = mpn_add_n (r1p + off, s1p + off, s2p + off, this_n);
+	  acyo = acyn + mpn_add_1 (r1p + off, r1p + off, this_n, acyo);
+#endif
+#if HAVE_NATIVE_mpn_sub_nc || !HAVE_NATIVE_mpn_sub_n
+	  scyo = mpn_sub_nc (r2p + off, s1p + off, s2p + off, this_n, scyo);
+#else
+	  scyn = mpn_sub_n (r2p + off, s1p + off, s2p + off, this_n);
+	  scyo = scyn + mpn_sub_1 (r2p + off, r2p + off, this_n, scyo);
+#endif
+	}
+    }
+  else if (r2p != s1p && r2p != s2p)
+    {
+      /* r2 is not identical to either input operand.  We can therefore write
+	 to r2 directly, without using temporary storage.  */
+      acyo = 0;
+      scyo = 0;
+      for (off = 0; off < n; off += PART_SIZE)
+	{
+	  this_n = MIN (n - off, PART_SIZE);
+#if HAVE_NATIVE_mpn_sub_nc || !HAVE_NATIVE_mpn_sub_n
+	  scyo = mpn_sub_nc (r2p + off, s1p + off, s2p + off, this_n, scyo);
+#else
+	  scyn = mpn_sub_n (r2p + off, s1p + off, s2p + off, this_n);
+	  scyo = scyn + mpn_sub_1 (r2p + off, r2p + off, this_n, scyo);
+#endif
+#if HAVE_NATIVE_mpn_add_nc || !HAVE_NATIVE_mpn_add_n
+	  acyo = mpn_add_nc (r1p + off, s1p + off, s2p + off, this_n, acyo);
+#else
+	  acyn = mpn_add_n (r1p + off, s1p + off, s2p + off, this_n);
+	  acyo = acyn + mpn_add_1 (r1p + off, r1p + off, this_n, acyo);
+#endif
+	}
+    }
+  else
+    {
+      /* r1 and r2 are identical to s1 and s2 (r1==s1 and r2=s2 or vice versa)
+	 Need temporary storage.  */
+      mp_limb_t tp[PART_SIZE];
+      acyo = 0;
+      scyo = 0;
+      for (off = 0; off < n; off += PART_SIZE)
+	{
+	  this_n = MIN (n - off, PART_SIZE);
+#if HAVE_NATIVE_mpn_add_nc || !HAVE_NATIVE_mpn_add_n
+	  acyo = mpn_add_nc (tp, s1p + off, s2p + off, this_n, acyo);
+#else
+	  acyn = mpn_add_n (tp, s1p + off, s2p + off, this_n);
+	  acyo = acyn + mpn_add_1 (tp, tp, this_n, acyo);
+#endif
+#if HAVE_NATIVE_mpn_sub_nc || !HAVE_NATIVE_mpn_sub_n
+	  scyo = mpn_sub_nc (r2p + off, s1p + off, s2p + off, this_n, scyo);
+#else
+	  scyn = mpn_sub_n (r2p + off, s1p + off, s2p + off, this_n);
+	  scyo = scyn + mpn_sub_1 (r2p + off, r2p + off, this_n, scyo);
+#endif
+	  MPN_COPY (r1p + off, tp, this_n);
+	}
+    }
+
+  return 2 * acyo + scyo;
+}
+
+#ifdef MAIN
+#include <stdlib.h>
+#include <stdio.h>
+#include "timing.h"
+
+long cputime ();
+
+int
+main (int argc, char **argv)
+{
+  mp_ptr r1p, r2p, s1p, s2p;
+  double t;
+  mp_size_t n;
+
+  n = strtol (argv[1], 0, 0);
+
+  r1p = malloc (n * BYTES_PER_MP_LIMB);
+  r2p = malloc (n * BYTES_PER_MP_LIMB);
+  s1p = malloc (n * BYTES_PER_MP_LIMB);
+  s2p = malloc (n * BYTES_PER_MP_LIMB);
+  TIME (t,(mpn_add_n(r1p,s1p,s2p,n),mpn_sub_n(r1p,s1p,s2p,n)));
+  printf ("              separate add and sub: %.3f\n", t);
+  TIME (t,mpn_addsub_n(r1p,r2p,s1p,s2p,n));
+  printf ("combined addsub separate variables: %.3f\n", t);
+  TIME (t,mpn_addsub_n(r1p,r2p,r1p,s2p,n));
+  printf ("        combined addsub r1 overlap: %.3f\n", t);
+  TIME (t,mpn_addsub_n(r1p,r2p,r1p,s2p,n));
+  printf ("        combined addsub r2 overlap: %.3f\n", t);
+  TIME (t,mpn_addsub_n(r1p,r2p,r1p,r2p,n));
+  printf ("          combined addsub in-place: %.3f\n", t);
+
+  return 0;
+}
+#endif
diff --git a/src/gmp/mpn/generic/bdivmod.c b/src/gmp/mpn/generic/bdivmod.c
new file mode 100644
index 000000000..c4bcb414e
--- /dev/null
+++ b/src/gmp/mpn/generic/bdivmod.c
@@ -0,0 +1,120 @@
+/* mpn/bdivmod.c: mpn_bdivmod for computing U/V mod 2^d.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996, 1999, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/* q_high = mpn_bdivmod (qp, up, usize, vp, vsize, d).
+
+   Puts the low d/BITS_PER_MP_LIMB limbs of Q = U / V mod 2^d at qp, and
+   returns the high d%BITS_PER_MP_LIMB bits of Q as the result.
+
+   Also, U - Q * V mod 2^(usize*BITS_PER_MP_LIMB) is placed at up.  Since the
+   low d/BITS_PER_MP_LIMB limbs of this difference are zero, the code allows
+   the limb vectors at qp to overwrite the low limbs at up, provided qp <= up.
+
+   Preconditions:
+   1.  V is odd.
+   2.  usize * BITS_PER_MP_LIMB >= d.
+   3.  If Q and U overlap, qp <= up.
+
+   Ken Weber (kweber@mat.ufrgs.br, kweber@mcs.kent.edu)
+
+   Funding for this work has been partially provided by Conselho Nacional
+   de Desenvolvimento Cienti'fico e Tecnolo'gico (CNPq) do Brazil, Grant
+   301314194-2, and was done while I was a visiting reseacher in the Instituto
+   de Matema'tica at Universidade Federal do Rio Grande do Sul (UFRGS).
+
+   References:
+       T. Jebelean, An algorithm for exact division, Journal of Symbolic
+       Computation, v. 15, 1993, pp. 169-180.
+
+       K. Weber, The accelerated integer GCD algorithm, ACM Transactions on
+       Mathematical Software, v. 21 (March), 1995, pp. 111-122.  */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+mp_limb_t
+#if __STDC__
+mpn_bdivmod (mp_ptr qp, mp_ptr up, mp_size_t usize,
+	     mp_srcptr vp, mp_size_t vsize, unsigned long int d)
+#else
+mpn_bdivmod (qp, up, usize, vp, vsize, d)
+     mp_ptr qp;
+     mp_ptr up;
+     mp_size_t usize;
+     mp_srcptr vp;
+     mp_size_t vsize;
+     unsigned long int d;
+#endif
+{
+  mp_limb_t v_inv;
+
+  /* 1/V mod 2^BITS_PER_MP_LIMB. */
+  modlimb_invert (v_inv, vp[0]);
+
+  /* Fast code for two cases previously used by the accel part of mpn_gcd.
+     (Could probably remove this now it's inlined there.) */
+  if (usize == 2 && vsize == 2 &&
+      (d == BITS_PER_MP_LIMB || d == 2*BITS_PER_MP_LIMB))
+    {
+      mp_limb_t hi, lo;
+      mp_limb_t q = up[0] * v_inv;
+      umul_ppmm (hi, lo, q, vp[0]);
+      up[0] = 0, up[1] -= hi + q*vp[1], qp[0] = q;
+      if (d == 2*BITS_PER_MP_LIMB)
+	q = up[1] * v_inv, up[1] = 0, qp[1] = q;
+      return 0;
+    }
+
+  /* Main loop.  */
+  while (d >= BITS_PER_MP_LIMB)
+    {
+      mp_limb_t q = up[0] * v_inv;
+      mp_limb_t b = mpn_submul_1 (up, vp, MIN (usize, vsize), q);
+      if (usize > vsize)
+	mpn_sub_1 (up + vsize, up + vsize, usize - vsize, b);
+      d -= BITS_PER_MP_LIMB;
+      up += 1, usize -= 1;
+      *qp++ = q;
+    }
+
+  if (d)
+    {
+      mp_limb_t b;
+      mp_limb_t q = (up[0] * v_inv) & (((mp_limb_t)1<<d) - 1);
+      if (q <= 1)
+	{
+	  if (q == 0)
+	    return 0;
+	  else
+	    b = mpn_sub_n (up, up, vp, MIN (usize, vsize));
+	}
+      else
+	b = mpn_submul_1 (up, vp, MIN (usize, vsize), q);
+
+      if (usize > vsize)
+	mpn_sub_1 (up + vsize, up + vsize, usize - vsize, b);
+      return q;
+    }
+
+  return 0;
+}
diff --git a/src/gmp/mpn/generic/bz_divrem_n.c b/src/gmp/mpn/generic/bz_divrem_n.c
new file mode 100644
index 000000000..9d2df1bf8
--- /dev/null
+++ b/src/gmp/mpn/generic/bz_divrem_n.c
@@ -0,0 +1,223 @@
+/* mpn_bz_divrem_n and auxilliary routines.
+
+   THE FUNCTIONS IN THIS FILE ARE INTERNAL FUNCTIONS WITH MUTABLE
+   INTERFACES.  IT IS ONLY SAFE TO REACH THEM THROUGH DOCUMENTED INTERFACES.
+   IN FACT, IT IS ALMOST GUARANTEED THAT THEY'LL CHANGE OR DISAPPEAR IN A
+   FUTURE GNU MP RELEASE.
+
+
+Copyright (C) 2000 Free Software Foundation, Inc.
+Contributed by Paul Zimmermann.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/*
+[1] Fast Recursive Division, by Christoph Burnikel and Joachim Ziegler,
+    Technical report MPI-I-98-1-022, october 1998.
+    http://www.mpi-sb.mpg.de/~ziegler/TechRep.ps.gz
+*/
+
+static mp_limb_t mpn_bz_div_3_halves_by_2 _PROTO ((mp_ptr, mp_ptr, mp_srcptr,
+                                                   mp_size_t, mp_ptr));
+
+static mp_limb_t mpn_bz_divrem_aux _PROTO ((mp_ptr, mp_ptr, mp_srcptr,
+                                            mp_size_t, mp_ptr));
+
+/* mpn_bz_divrem_n(n) calls 2*mul(n/2)+2*div(n/2), thus to be faster than
+   div(n) = 4*div(n/2), we need mul(n/2) to be faster than the classic way,
+   i.e. n/2 >= KARATSUBA_MUL_THRESHOLD */
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD (7 * KARATSUBA_MUL_THRESHOLD)
+#endif
+
+#if 0
+static
+unused_mpn_divrem (qp, qxn, np, nn, dp, dn)
+     mp_ptr qp;
+     mp_size_t qxn;
+     mp_ptr np;
+     mp_size_t nn;
+     mp_srcptr dp;
+     mp_size_t dn;
+{
+  /* This might be useful: */
+  if (qxn != 0)
+    {
+      mp_limb_t c;
+      mp_ptr tp = alloca ((nn + qxn) * BYTES_PER_MP_LIMB);
+      MPN_COPY (tp + qxn - nn, np, nn);
+      MPN_ZERO (tp, qxn);
+      c = mpn_divrem (qp, 0L, tp, nn + qxn, dp, dn);
+      /* Maybe copy proper part of tp to np?  Documentation is unclear about
+	 the returned np value when qxn != 0 */
+      return c;
+    }
+}
+#endif
+
+/* mpn_bz_divrem_n - Implements algorithm of page 8 in [1]: divides (np,2n)
+   by (dp,n) and puts the quotient in (qp,n), the remainder in (np,n).
+   Returns most significant limb of the quotient, which is 0 or 1.
+   Requires that the most significant bit of the divisor is set.  */
+
+mp_limb_t
+#if __STDC__
+mpn_bz_divrem_n (mp_ptr qp, mp_ptr np, mp_srcptr dp, mp_size_t n)
+#else
+mpn_bz_divrem_n (qp, np, dp, n)
+     mp_ptr qp;
+     mp_ptr np;
+     mp_srcptr dp;
+     mp_size_t n;
+#endif
+{
+  mp_limb_t qhl = 0;
+  if (mpn_cmp (np + n, dp, n) >= 0)
+    {
+      qhl = 1;
+      mpn_sub_n (np + n, np + n, dp, n);
+      abort ();
+    }
+  if (n % 2 != 0)
+    {
+      /* divide (2n - 2) most significant limbs from np by those (n - 1) from dp */
+      if (n < BZ_THRESHOLD)
+	qhl += mpn_sb_divrem_mn (qp + 1, np + 2, 2 * (n - 1), dp + 1, n - 1);
+      else
+	qhl += mpn_bz_divrem_n (qp + 1, np + 2, dp + 1, n - 1);
+      /* now (qp + 1, n - 1) contains the quotient of (np + 2, 2n - 2) by
+	 (dp + 1, n - 1) and (np + 2, n - 1) contains the remainder */
+      if (mpn_sub_1 (np + n, np + n, 1,
+		     mpn_submul_1 (np + 1, qp + 1, n - 1, dp[0])))
+	{
+	  /* quotient too large */
+	  qhl -= mpn_sub_1 (qp + 1, qp + 1, n - 1, 1L);
+	  if (mpn_add_n (np + 1, np + 1, dp, n) == 0)
+	    { /* still too large */
+	      qhl -= mpn_sub_1 (qp + 1, qp + 1, n - 1, 1L);
+	      mpn_add_n (np + 1, np + 1, dp, n); /* always carry here */
+	    }
+	}
+      /* now divide (np, n + 1) by (dp, n) */
+      qhl += mpn_add_1 (qp + 1, qp + 1, n - 1,
+			mpn_sb_divrem_mn (qp, np, n + 1, dp, n));
+    }
+  else
+    {
+      mp_ptr tmp;
+      mp_size_t n2 = n/2;
+      TMP_DECL (marker);
+      TMP_MARK (marker);
+      tmp = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+      qhl = mpn_bz_div_3_halves_by_2 (qp + n2, np + n2, dp, n2, tmp);
+      qhl += mpn_add_1 (qp + n2, qp + n2, n2,
+		       mpn_bz_div_3_halves_by_2 (qp, np, dp, n2, tmp));
+      TMP_FREE (marker);
+    }
+  return qhl;
+}
+
+/* Like mpn_bz_divrem_n, but without memory allocation.  Also
+   assumes mpn_cmp (np + n, dp, n) < 0 */
+
+static mp_limb_t
+#if __STDC__
+mpn_bz_divrem_aux (mp_ptr qp, mp_ptr np, mp_srcptr dp, mp_size_t n, mp_ptr tmp)
+#else
+mpn_bz_divrem_aux (qp, np, dp, n, tmp)
+     mp_ptr qp;
+     mp_ptr np;
+     mp_srcptr dp;
+     mp_size_t n;
+     mp_ptr tmp;
+#endif
+{
+  mp_limb_t qhl;
+
+  if (n % 2 != 0)
+    {
+      /* divide (2n - 2) most significant limbs from np by those (n - 1) from dp */
+      qhl = mpn_bz_divrem_aux (qp + 1, np + 2, dp + 1, n - 1, tmp);
+      /* now (qp + 1, n - 1) contains the quotient of (np + 2, 2n - 2) by
+	 (dp + 1, n - 1) and (np + 2, n - 1) contains the remainder */
+      if (mpn_sub_1 (np + n, np + n, 1,
+		     mpn_submul_1 (np + 1, qp + 1, n - 1, dp[0])))
+	{
+	  /* quotient too large */
+	  qhl -= mpn_sub_1 (qp + 1, qp + 1, n - 1, 1L);
+	  if (mpn_add_n (np + 1, np + 1, dp, n) == 0)
+	    { /* still too large */
+	      qhl -= mpn_sub_1 (qp + 1, qp + 1, n - 1, 1L);
+	      mpn_add_n (np + 1, np + 1, dp, n); /* always carry here */
+	    }
+	}
+      /* now divide (np, n + 1) by (dp, n) */
+      qhl += mpn_add_1 (qp + 1, qp + 1, n - 1,
+			mpn_sb_divrem_mn (qp, np, n + 1, dp, n));
+    }
+  else
+    {
+      mp_size_t n2 = n/2;
+      qhl = mpn_bz_div_3_halves_by_2 (qp + n2, np + n2, dp, n2, tmp);
+      qhl += mpn_add_1 (qp + n2, qp + n2, n2,
+		       mpn_bz_div_3_halves_by_2 (qp, np, dp, n2, tmp));
+    }
+  return qhl;
+}
+
+/* divides (np, 3n) by (dp, 2n) and puts the quotient in (qp, n),
+   the remainder in (np, 2n) */
+
+static mp_limb_t
+#if __STDC__
+mpn_bz_div_3_halves_by_2 (mp_ptr qp, mp_ptr np, mp_srcptr dp, mp_size_t n,
+                          mp_ptr tmp)
+#else
+mpn_bz_div_3_halves_by_2 (qp, np, dp, n, tmp)
+     mp_ptr qp;
+     mp_ptr np;
+     mp_srcptr dp;
+     mp_size_t n;
+     mp_ptr tmp;
+#endif
+{
+  mp_size_t twon = n + n;
+  mp_limb_t qhl;
+
+  if (n < BZ_THRESHOLD)
+    qhl = mpn_sb_divrem_mn (qp, np + n, twon, dp + n, n);
+  else
+    qhl = mpn_bz_divrem_aux (qp, np + n, dp + n, n, tmp);
+  /* q = (qp, n), c = (np + n, n) with the notations of [1] */
+  mpn_mul_n (tmp, qp, dp, n);
+  if (qhl != 0)
+    mpn_add_n (tmp + n, tmp + n, dp, n);
+  if (mpn_sub_n (np, np, tmp, twon))		/* R = (np, 2n) */
+    {
+      qhl -= mpn_sub_1 (qp, qp, n, 1L);
+      if (mpn_add_n (np, np, dp, twon) == 0)
+	{ /* qp still too large */
+	  qhl -= mpn_sub_1 (qp, qp, n, 1L);
+	  mpn_add_n (np, np, dp, twon);		/* always carry here */
+	}
+    }
+  return qhl;
+}
diff --git a/src/gmp/mpn/generic/cmp.c b/src/gmp/mpn/generic/cmp.c
new file mode 100644
index 000000000..8e9792f54
--- /dev/null
+++ b/src/gmp/mpn/generic/cmp.c
@@ -0,0 +1,56 @@
+/* mpn_cmp -- Compare two low-level natural-number integers.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Compare OP1_PTR/OP1_SIZE with OP2_PTR/OP2_SIZE.
+   There are no restrictions on the relative sizes of
+   the two arguments.
+   Return 1 if OP1 > OP2, 0 if they are equal, and -1 if OP1 < OP2.  */
+
+int
+#if __STDC__
+mpn_cmp (mp_srcptr op1_ptr, mp_srcptr op2_ptr, mp_size_t size)
+#else
+mpn_cmp (op1_ptr, op2_ptr, size)
+     mp_srcptr op1_ptr;
+     mp_srcptr op2_ptr;
+     mp_size_t size;
+#endif
+{
+  mp_size_t i;
+  mp_limb_t op1_word, op2_word;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+      op1_word = op1_ptr[i];
+      op2_word = op2_ptr[i];
+      if (op1_word != op2_word)
+	goto diff;
+    }
+  return 0;
+ diff:
+  /* This can *not* be simplified to
+	op2_word - op2_word
+     since that expression might give signed overflow.  */
+  return (op1_word > op2_word) ? 1 : -1;
+}
diff --git a/src/gmp/mpn/generic/diveby3.c b/src/gmp/mpn/generic/diveby3.c
new file mode 100644
index 000000000..a2fb552bf
--- /dev/null
+++ b/src/gmp/mpn/generic/diveby3.c
@@ -0,0 +1,77 @@
+/* mpn_divexact_by3 -- mpn division by 3, expecting no remainder. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+/* Multiplicative inverse of 3, modulo 2^BITS_PER_MP_LIMB.
+   0xAAAAAAAB for 32 bits, 0xAAAAAAAAAAAAAAAB for 64 bits. */
+#define INVERSE_3      ((MP_LIMB_T_MAX / 3) * 2 + 1)
+
+
+/* The "c += ..."s are adding the high limb of 3*l to c.  That high limb
+   will be 0, 1 or 2.  Doing two separate "+="s seems to turn out better
+   code on gcc (as of 2.95.2 at least).
+
+   When a subtraction of a 0,1,2 carry value causes a borrow, that leaves a
+   limb value of either 0xFF...FF or 0xFF...FE and the multiply by INVERSE_3
+   gives 0x55...55 or 0xAA...AA respectively, producing a further borrow of
+   only 0 or 1 respectively.  Hence the carry out of each stage and for the
+   return value is always only 0, 1 or 2.  */
+
+mp_limb_t
+#if __STDC__
+mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size, mp_limb_t c)
+#else
+mpn_divexact_by3c (dst, src, size, c)
+     mp_ptr    dst;
+     mp_srcptr src;
+     mp_size_t size;
+     mp_limb_t c;
+#endif
+{
+  mp_size_t  i;
+
+  ASSERT (size >= 1);
+
+  i = 0;
+  do
+    {
+      mp_limb_t  l, s;
+
+      s = src[i];
+      l = s - c;
+      c = (l > s);
+
+      l *= INVERSE_3;
+      dst[i] = l;
+
+      c += (l > MP_LIMB_T_MAX/3);
+      c += (l > (MP_LIMB_T_MAX/3)*2);
+    }
+  while (++i < size);
+
+  return c;
+}
diff --git a/src/gmp/mpn/generic/divrem.c b/src/gmp/mpn/generic/divrem.c
new file mode 100644
index 000000000..30673e76d
--- /dev/null
+++ b/src/gmp/mpn/generic/divrem.c
@@ -0,0 +1,101 @@
+/* mpn_divrem -- Divide natural numbers, producing both remainder and
+   quotient.  This is now just a middle layer for calling the new
+   internal mpn_tdiv_qr.
+
+Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+mp_limb_t
+#if __STDC__
+mpn_divrem (mp_ptr qp, mp_size_t qxn,
+	    mp_ptr np, mp_size_t nn,
+	    mp_srcptr dp, mp_size_t dn)
+#else
+mpn_divrem (qp, qxn, np, nn, dp, dn)
+     mp_ptr qp;
+     mp_size_t qxn;
+     mp_ptr np;
+     mp_size_t nn;
+     mp_srcptr dp;
+     mp_size_t dn;
+#endif
+{
+  if (dn == 1)
+    {
+      mp_limb_t ret;
+      mp_ptr q2p;
+      mp_size_t qn;
+      TMP_DECL (marker);
+
+      TMP_MARK (marker);
+      q2p = (mp_ptr) TMP_ALLOC ((nn + qxn) * BYTES_PER_MP_LIMB);
+
+      np[0] = mpn_divrem_1 (q2p, qxn, np, nn, dp[0]);
+      qn = nn + qxn - 1;
+      MPN_COPY (qp, q2p, qn);
+      ret = q2p[qn];
+
+      TMP_FREE (marker);
+      return ret;
+    }
+  else if (dn == 2)
+    {
+      return mpn_divrem_2 (qp, qxn, np, nn, dp);
+    }
+  else
+    {
+      mp_ptr rp, q2p;
+      mp_limb_t qhl;
+      mp_size_t qn;
+      TMP_DECL (marker);
+
+      TMP_MARK (marker);
+      if (qxn != 0)
+	{
+	  mp_ptr n2p;
+	  n2p = (mp_ptr) TMP_ALLOC ((nn + qxn) * BYTES_PER_MP_LIMB);
+	  MPN_ZERO (n2p, qxn);
+	  MPN_COPY (n2p + qxn, np, nn);
+	  q2p = (mp_ptr) TMP_ALLOC ((nn - dn + qxn + 1) * BYTES_PER_MP_LIMB);
+	  rp = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
+	  mpn_tdiv_qr (q2p, rp, 0L, n2p, nn + qxn, dp, dn);
+	  MPN_COPY (np, rp, dn);
+	  qn = nn - dn + qxn;
+	  MPN_COPY (qp, q2p, qn);
+	  qhl = q2p[qn];
+	}
+      else
+	{
+	  q2p = (mp_ptr) TMP_ALLOC ((nn - dn + 1) * BYTES_PER_MP_LIMB);
+	  rp = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
+	  mpn_tdiv_qr (q2p, rp, 0L, np, nn, dp, dn);
+	  MPN_COPY (np, rp, dn);	/* overwrite np area with remainder */
+	  qn = nn - dn;
+	  MPN_COPY (qp, q2p, qn);
+	  qhl = q2p[qn];
+	}
+      TMP_FREE (marker);
+      return qhl;
+    }
+}
diff --git a/src/gmp/mpn/generic/divrem_1.c b/src/gmp/mpn/generic/divrem_1.c
new file mode 100644
index 000000000..e93f241c9
--- /dev/null
+++ b/src/gmp/mpn/generic/divrem_1.c
@@ -0,0 +1,248 @@
+/* mpn_divrem_1(quot_ptr, qsize, dividend_ptr, dividend_size, divisor_limb) --
+   Divide (DIVIDEND_PTR,,DIVIDEND_SIZE) by DIVISOR_LIMB.
+   Write DIVIDEND_SIZE limbs of quotient at QUOT_PTR.
+   Return the single-limb remainder.
+   There are no constraints on the value of the divisor.
+
+   QUOT_PTR and DIVIDEND_PTR might point to the same limb.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1998, 1999, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+
+/* __gmpn_divmod_1_internal(quot_ptr,dividend_ptr,dividend_size,divisor_limb)
+   Divide (DIVIDEND_PTR,,DIVIDEND_SIZE) by DIVISOR_LIMB.
+   Write DIVIDEND_SIZE limbs of quotient at QUOT_PTR.
+   Return the single-limb remainder.
+   There are no constraints on the value of the divisor.
+
+   QUOT_PTR and DIVIDEND_PTR might point to the same limb. */
+
+#ifndef UMUL_TIME
+#define UMUL_TIME 1
+#endif
+
+#ifndef UDIV_TIME
+#define UDIV_TIME UMUL_TIME
+#endif
+
+static mp_limb_t
+#if __STDC__
+__gmpn_divmod_1_internal (mp_ptr quot_ptr,
+	      mp_srcptr dividend_ptr, mp_size_t dividend_size,
+	      mp_limb_t divisor_limb)
+#else
+__gmpn_divmod_1_internal (quot_ptr, dividend_ptr, dividend_size, divisor_limb)
+     mp_ptr quot_ptr;
+     mp_srcptr dividend_ptr;
+     mp_size_t dividend_size;
+     mp_limb_t divisor_limb;
+#endif
+{
+  mp_size_t i;
+  mp_limb_t n1, n0, r;
+  int dummy;
+
+  /* ??? Should this be handled at all?  Rely on callers?  */
+  if (dividend_size == 0)
+    return 0;
+
+  /* If multiplication is much faster than division, and the
+     dividend is large, pre-invert the divisor, and use
+     only multiplications in the inner loop.  */
+
+  /* This test should be read:
+       Does it ever help to use udiv_qrnnd_preinv?
+	 && Does what we save compensate for the inversion overhead?  */
+  if (UDIV_TIME > (2 * UMUL_TIME + 6)
+      && (UDIV_TIME - (2 * UMUL_TIME + 6)) * dividend_size > UDIV_TIME)
+    {
+      int normalization_steps;
+
+      count_leading_zeros (normalization_steps, divisor_limb);
+      if (normalization_steps != 0)
+	{
+	  mp_limb_t divisor_limb_inverted;
+
+	  divisor_limb <<= normalization_steps;
+	  invert_limb (divisor_limb_inverted, divisor_limb);
+
+	  n1 = dividend_ptr[dividend_size - 1];
+	  r = n1 >> (BITS_PER_MP_LIMB - normalization_steps);
+
+	  /* Possible optimization:
+	     if (r == 0
+	     && divisor_limb > ((n1 << normalization_steps)
+			     | (dividend_ptr[dividend_size - 2] >> ...)))
+	     ...one division less... */
+
+	  for (i = dividend_size - 2; i >= 0; i--)
+	    {
+	      n0 = dividend_ptr[i];
+	      udiv_qrnnd_preinv (quot_ptr[i + 1], r, r,
+				 ((n1 << normalization_steps)
+				  | (n0 >> (BITS_PER_MP_LIMB - normalization_steps))),
+				 divisor_limb, divisor_limb_inverted);
+	      n1 = n0;
+	    }
+	  udiv_qrnnd_preinv (quot_ptr[0], r, r,
+			     n1 << normalization_steps,
+			     divisor_limb, divisor_limb_inverted);
+	  return r >> normalization_steps;
+	}
+      else
+	{
+	  mp_limb_t divisor_limb_inverted;
+
+	  invert_limb (divisor_limb_inverted, divisor_limb);
+
+	  i = dividend_size - 1;
+	  r = dividend_ptr[i];
+
+	  if (r >= divisor_limb)
+	    r = 0;
+	  else
+	    {
+	      quot_ptr[i] = 0;
+	      i--;
+	    }
+
+	  for (; i >= 0; i--)
+	    {
+	      n0 = dividend_ptr[i];
+	      udiv_qrnnd_preinv (quot_ptr[i], r, r,
+				 n0, divisor_limb, divisor_limb_inverted);
+	    }
+	  return r;
+	}
+    }
+  else
+    {
+      if (UDIV_NEEDS_NORMALIZATION)
+	{
+	  int normalization_steps;
+
+	  count_leading_zeros (normalization_steps, divisor_limb);
+	  if (normalization_steps != 0)
+	    {
+	      divisor_limb <<= normalization_steps;
+
+	      n1 = dividend_ptr[dividend_size - 1];
+	      r = n1 >> (BITS_PER_MP_LIMB - normalization_steps);
+
+	      /* Possible optimization:
+		 if (r == 0
+		 && divisor_limb > ((n1 << normalization_steps)
+				 | (dividend_ptr[dividend_size - 2] >> ...)))
+		 ...one division less... */
+
+	      for (i = dividend_size - 2; i >= 0; i--)
+		{
+		  n0 = dividend_ptr[i];
+		  udiv_qrnnd (quot_ptr[i + 1], r, r,
+			      ((n1 << normalization_steps)
+			       | (n0 >> (BITS_PER_MP_LIMB - normalization_steps))),
+			      divisor_limb);
+		  n1 = n0;
+		}
+	      udiv_qrnnd (quot_ptr[0], r, r,
+			  n1 << normalization_steps,
+			  divisor_limb);
+	      return r >> normalization_steps;
+	    }
+	}
+      /* No normalization needed, either because udiv_qrnnd doesn't require
+	 it, or because DIVISOR_LIMB is already normalized.  */
+
+      i = dividend_size - 1;
+      r = dividend_ptr[i];
+
+      if (r >= divisor_limb)
+	r = 0;
+      else
+	{
+	  quot_ptr[i] = 0;
+	  i--;
+	}
+
+      for (; i >= 0; i--)
+	{
+	  n0 = dividend_ptr[i];
+	  udiv_qrnnd (quot_ptr[i], r, r, n0, divisor_limb);
+	}
+      return r;
+    }
+}
+
+
+
+mp_limb_t
+#if __STDC__
+mpn_divrem_1 (mp_ptr qp, mp_size_t qxn,
+	      mp_srcptr np, mp_size_t nn,
+	      mp_limb_t d)
+#else
+mpn_divrem_1 (qp, qxn, np, nn, d)
+     mp_ptr qp;
+     mp_size_t qxn;
+     mp_srcptr np;
+     mp_size_t nn;
+     mp_limb_t d;
+#endif
+{
+  mp_limb_t rlimb;
+  mp_size_t i;
+
+  /* Develop integer part of quotient.  */
+  rlimb = __gmpn_divmod_1_internal (qp + qxn, np, nn, d);
+
+  /* Develop fraction part of quotient.  This is not as fast as it should;
+     the preinvert stuff from __gmpn_divmod_1_internal ought to be used here
+     too.  */
+  if (UDIV_NEEDS_NORMALIZATION)
+    {
+      int normalization_steps;
+
+      count_leading_zeros (normalization_steps, d);
+      if (normalization_steps != 0)
+	{
+	  d <<= normalization_steps;
+	  rlimb <<= normalization_steps;
+
+	  for (i = qxn - 1; i >= 0; i--)
+	    udiv_qrnnd (qp[i], rlimb, rlimb, 0, d);
+
+	  return rlimb >> normalization_steps;
+	}
+      else
+	/* fall out */
+	;
+    }
+
+  for (i = qxn - 1; i >= 0; i--)
+    udiv_qrnnd (qp[i], rlimb, rlimb, 0, d);
+
+  return rlimb;
+}
diff --git a/src/gmp/mpn/generic/divrem_2.c b/src/gmp/mpn/generic/divrem_2.c
new file mode 100644
index 000000000..0bc31ae2e
--- /dev/null
+++ b/src/gmp/mpn/generic/divrem_2.c
@@ -0,0 +1,151 @@
+/* mpn_divrem_2 -- Divide natural numbers, producing both remainder and
+   quotient.  The divisor is two limbs.
+
+   THIS FILE CONTAINS INTERNAL FUNCTIONS WITH MUTABLE INTERFACES.  IT IS
+   ONLY SAFE TO REACH THEM THROUGH DOCUMENTED INTERFACES.  IN FACT, IT IS
+   ALMOST GUARANTEED THAT THEY'LL CHANGE OR DISAPPEAR IN A FUTURE GNU MP
+   RELEASE.
+
+
+Copyright (C) 1993, 1994, 1995, 1996, 1999, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Divide num (NP/NSIZE) by den (DP/2) and write
+   the NSIZE-2 least significant quotient limbs at QP
+   and the 2 long remainder at NP.  If QEXTRA_LIMBS is
+   non-zero, generate that many fraction bits and append them after the
+   other quotient limbs.
+   Return the most significant limb of the quotient, this is always 0 or 1.
+
+   Preconditions:
+   0. NSIZE >= 2.
+   1. The most significant bit of the divisor must be set.
+   2. QP must either not overlap with the input operands at all, or
+      QP + 2 >= NP must hold true.  (This means that it's
+      possible to put the quotient in the high part of NUM, right after the
+      remainder in NUM.
+   3. NSIZE >= 2, even if QEXTRA_LIMBS is non-zero.  */
+
+mp_limb_t
+#if __STDC__
+mpn_divrem_2 (mp_ptr qp, mp_size_t qxn,
+	      mp_ptr np, mp_size_t nsize,
+	      mp_srcptr dp)
+#else
+mpn_divrem_2 (qp, qxn, np, nsize, dp)
+     mp_ptr qp;
+     mp_size_t qxn;
+     mp_ptr np;
+     mp_size_t nsize;
+     mp_srcptr dp;
+#endif
+{
+  mp_limb_t most_significant_q_limb = 0;
+  mp_size_t i;
+  mp_limb_t n1, n0, n2;
+  mp_limb_t d1, d0;
+  mp_limb_t d1inv;
+  int have_preinv;
+
+  np += nsize - 2;
+  d1 = dp[1];
+  d0 = dp[0];
+  n1 = np[1];
+  n0 = np[0];
+
+  if (n1 >= d1 && (n1 > d1 || n0 >= d0))
+    {
+      sub_ddmmss (n1, n0, n1, n0, d1, d0);
+      most_significant_q_limb = 1;
+    }
+
+  /* If multiplication is much faster than division, preinvert the most 
+     significant divisor limb before entering the loop.  */
+  if (UDIV_TIME > 2 * UMUL_TIME + 6)
+    {
+      have_preinv = 0;
+      if ((UDIV_TIME - (2 * UMUL_TIME + 6)) * (nsize - 2) > UDIV_TIME)
+	{
+	  invert_limb (d1inv, d1);
+	  have_preinv = 1;
+	}
+    }
+
+  for (i = qxn + nsize - 2 - 1; i >= 0; i--)
+    {
+      mp_limb_t q;
+      mp_limb_t r;
+
+      if (i >= qxn)
+	np--;
+      else
+	np[0] = 0;
+
+      if (n1 == d1)
+	{
+	  /* Q should be either 111..111 or 111..110.  Need special treatment
+	     of this rare case as normal division would give overflow.  */
+	  q = ~(mp_limb_t) 0;
+
+	  r = n0 + d1;
+	  if (r < d1)	/* Carry in the addition? */
+	    {
+	      add_ssaaaa (n1, n0, r - d0, np[0], 0, d0);
+	      qp[i] = q;
+	      continue;
+	    }
+	  n1 = d0 - (d0 != 0);
+	  n0 = -d0;
+	}
+      else
+	{
+	  if (UDIV_TIME > 2 * UMUL_TIME + 6 && have_preinv)
+	    udiv_qrnnd_preinv (q, r, n1, n0, d1, d1inv);
+	  else
+	    udiv_qrnnd (q, r, n1, n0, d1);
+	  umul_ppmm (n1, n0, d0, q);
+	}
+
+      n2 = np[0];
+
+    q_test:
+      if (n1 > r || (n1 == r && n0 > n2))
+	{
+	  /* The estimated Q was too large.  */
+	  q--;
+
+	  sub_ddmmss (n1, n0, n1, n0, 0, d0);
+	  r += d1;
+	  if (r >= d1)	/* If not carry, test Q again.  */
+	    goto q_test;
+	}
+
+      qp[i] = q;
+      sub_ddmmss (n1, n0, r, n2, n1, n0);
+    }
+  np[1] = n1;
+  np[0] = n0;
+
+  return most_significant_q_limb;
+}
diff --git a/src/gmp/mpn/generic/dump.c b/src/gmp/mpn/generic/dump.c
new file mode 100644
index 000000000..66f375c74
--- /dev/null
+++ b/src/gmp/mpn/generic/dump.c
@@ -0,0 +1,76 @@
+/* THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS NOT SAFE TO
+   CALL THIS FUNCTION DIRECTLY.  IN FACT, IT IS ALMOST GUARANTEED THAT THIS
+   FUNCTION WILL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE.
+
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpn_dump (mp_srcptr ptr, mp_size_t size)
+#else
+mpn_dump (ptr, size)
+     mp_srcptr ptr;
+     mp_size_t size;
+#endif
+{
+  MPN_NORMALIZE (ptr, size);
+
+  if (size == 0)
+    printf ("0\n");
+  else
+    {
+      size--;
+      if (BYTES_PER_MP_LIMB > sizeof (long))
+	{
+	  if ((ptr[size] >> BITS_PER_MP_LIMB/2) != 0)
+	    {
+	      printf ("%lX",
+		      (unsigned long) (ptr[size] >> BITS_PER_MP_LIMB/2));
+	      printf ("%0*lX", (int) (BYTES_PER_MP_LIMB),
+		      (unsigned long) ptr[size]);
+	    }
+	  else
+	    printf ("%lX", (unsigned long) ptr[size]);
+	}
+      else
+	printf ("%lX", ptr[size]);
+
+      while (size)
+	{
+	  size--;
+	  if (BYTES_PER_MP_LIMB > sizeof (long))
+	    {
+	      printf ("%0*lX", (int) (BYTES_PER_MP_LIMB),
+		(unsigned long) (ptr[size] >> BITS_PER_MP_LIMB/2));
+	      printf ("%0*lX", (int) (BYTES_PER_MP_LIMB),
+		(unsigned long) ptr[size]);
+	    }
+	  else
+	    printf ("%0*lX", (int) (2 * BYTES_PER_MP_LIMB), ptr[size]);
+	}
+      printf ("\n");
+    }
+}
diff --git a/src/gmp/mpn/generic/gcd.c b/src/gmp/mpn/generic/gcd.c
new file mode 100644
index 000000000..059e219a0
--- /dev/null
+++ b/src/gmp/mpn/generic/gcd.c
@@ -0,0 +1,414 @@
+/* mpn/gcd.c: mpn_gcd for gcd of two odd integers.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 1998, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/* Integer greatest common divisor of two unsigned integers, using
+   the accelerated algorithm (see reference below).
+
+   mp_size_t mpn_gcd (up, usize, vp, vsize).
+
+   Preconditions [U = (up, usize) and V = (vp, vsize)]:
+
+   1.  V is odd.
+   2.  numbits(U) >= numbits(V).
+
+   Both U and V are destroyed by the operation.  The result is left at vp,
+   and its size is returned.
+
+   Ken Weber (kweber@mat.ufrgs.br, kweber@mcs.kent.edu)
+
+   Funding for this work has been partially provided by Conselho Nacional
+   de Desenvolvimento Cienti'fico e Tecnolo'gico (CNPq) do Brazil, Grant
+   301314194-2, and was done while I was a visiting reseacher in the Instituto
+   de Matema'tica at Universidade Federal do Rio Grande do Sul (UFRGS).
+
+   Refer to
+	K. Weber, The accelerated integer GCD algorithm, ACM Transactions on
+	Mathematical Software, v. 21 (March), 1995, pp. 111-122.  */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* If MIN (usize, vsize) >= GCD_ACCEL_THRESHOLD, then the accelerated
+   algorithm is used, otherwise the binary algorithm is used.  This may be
+   adjusted for different architectures.  */
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD 5
+#endif
+
+/* When U and V differ in size by more than BMOD_THRESHOLD, the accelerated
+   algorithm reduces using the bmod operation.  Otherwise, the k-ary reduction
+   is used.  0 <= BMOD_THRESHOLD < BITS_PER_MP_LIMB.  */
+enum
+  {
+    BMOD_THRESHOLD = BITS_PER_MP_LIMB/2
+  };
+
+
+/* Use binary algorithm to compute V <-- GCD (V, U) for usize, vsize == 2.
+   Both U and V must be odd.  */
+static __gmp_inline mp_size_t
+#if __STDC__
+gcd_2 (mp_ptr vp, mp_srcptr up)
+#else
+gcd_2 (vp, up)
+     mp_ptr vp;
+     mp_srcptr up;
+#endif
+{
+  mp_limb_t u0, u1, v0, v1;
+  mp_size_t vsize;
+
+  u0 = up[0], u1 = up[1], v0 = vp[0], v1 = vp[1];
+
+  while (u1 != v1 && u0 != v0)
+    {
+      unsigned long int r;
+      if (u1 > v1)
+	{
+	  u1 -= v1 + (u0 < v0), u0 -= v0;
+	  count_trailing_zeros (r, u0);
+	  u0 = u1 << (BITS_PER_MP_LIMB - r) | u0 >> r;
+	  u1 >>= r;
+	}
+      else  /* u1 < v1.  */
+	{
+	  v1 -= u1 + (v0 < u0), v0 -= u0;
+	  count_trailing_zeros (r, v0);
+	  v0 = v1 << (BITS_PER_MP_LIMB - r) | v0 >> r;
+	  v1 >>= r;
+	}
+    }
+
+  vp[0] = v0, vp[1] = v1, vsize = 1 + (v1 != 0);
+
+  /* If U == V == GCD, done.  Otherwise, compute GCD (V, |U - V|).  */
+  if (u1 == v1 && u0 == v0)
+    return vsize;
+
+  v0 = (u0 == v0) ? (u1 > v1) ? u1-v1 : v1-u1 : (u0 > v0) ? u0-v0 : v0-u0;
+  vp[0] = mpn_gcd_1 (vp, vsize, v0);
+
+  return 1;
+}
+
+/* The function find_a finds 0 < N < 2^BITS_PER_MP_LIMB such that there exists
+   0 < |D| < 2^BITS_PER_MP_LIMB, and N == D * C mod 2^(2*BITS_PER_MP_LIMB).
+   In the reference article, D was computed along with N, but it is better to
+   compute D separately as D <-- N / C mod 2^(BITS_PER_MP_LIMB + 1), treating
+   the result as a twos' complement signed integer.
+
+   Initialize N1 to C mod 2^(2*BITS_PER_MP_LIMB).  According to the reference
+   article, N2 should be initialized to 2^(2*BITS_PER_MP_LIMB), but we use
+   2^(2*BITS_PER_MP_LIMB) - N1 to start the calculations within double
+   precision.  If N2 > N1 initially, the first iteration of the while loop
+   will swap them.  In all other situations, N1 >= N2 is maintained.  */
+
+static
+#if ! defined (__i386__)
+__gmp_inline			/* don't inline this for the x86 */
+#endif
+mp_limb_t
+#if __STDC__
+find_a (mp_srcptr cp)
+#else
+find_a (cp)
+     mp_srcptr cp;
+#endif
+{
+  unsigned long int leading_zero_bits = 0;
+
+  mp_limb_t n1_l = cp[0];	/* N1 == n1_h * 2^BITS_PER_MP_LIMB + n1_l.  */
+  mp_limb_t n1_h = cp[1];
+
+  mp_limb_t n2_l = -n1_l;	/* N2 == n2_h * 2^BITS_PER_MP_LIMB + n2_l.  */
+  mp_limb_t n2_h = ~n1_h;
+
+  /* Main loop.  */
+  while (n2_h)			/* While N2 >= 2^BITS_PER_MP_LIMB.  */
+    {
+      /* N1 <-- N1 % N2.  */
+      if ((MP_LIMB_T_HIGHBIT >> leading_zero_bits & n2_h) == 0)
+	{
+	  unsigned long int i;
+	  count_leading_zeros (i, n2_h);
+	  i -= leading_zero_bits, leading_zero_bits += i;
+	  n2_h = n2_h<<i | n2_l>>(BITS_PER_MP_LIMB - i), n2_l <<= i;
+	  do
+	    {
+	      if (n1_h > n2_h || (n1_h == n2_h && n1_l >= n2_l))
+		n1_h -= n2_h + (n1_l < n2_l), n1_l -= n2_l;
+	      n2_l = n2_l>>1 | n2_h<<(BITS_PER_MP_LIMB - 1), n2_h >>= 1;
+	      i -= 1;
+	    }
+	  while (i);
+	}
+      if (n1_h > n2_h || (n1_h == n2_h && n1_l >= n2_l))
+	n1_h -= n2_h + (n1_l < n2_l), n1_l -= n2_l;
+
+      MP_LIMB_T_SWAP (n1_h, n2_h);
+      MP_LIMB_T_SWAP (n1_l, n2_l);
+    }
+
+  return n2_l;
+}
+
+mp_size_t
+#if __STDC__
+mpn_gcd (mp_ptr gp, mp_ptr up, mp_size_t usize, mp_ptr vp, mp_size_t vsize)
+#else
+mpn_gcd (gp, up, usize, vp, vsize)
+     mp_ptr gp;
+     mp_ptr up;
+     mp_size_t usize;
+     mp_ptr vp;
+     mp_size_t vsize;
+#endif
+{
+  mp_ptr orig_vp = vp;
+  mp_size_t orig_vsize = vsize;
+  int binary_gcd_ctr;		/* Number of times binary gcd will execute.  */
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  /* Use accelerated algorithm if vsize is over GCD_ACCEL_THRESHOLD.
+     Two EXTRA limbs for U and V are required for kary reduction.  */
+  if (vsize >= GCD_ACCEL_THRESHOLD)
+    {
+      unsigned long int vbitsize, d;
+      mp_ptr orig_up = up;
+      mp_size_t orig_usize = usize;
+      mp_ptr anchor_up = (mp_ptr) TMP_ALLOC ((usize + 2) * BYTES_PER_MP_LIMB);
+
+      MPN_COPY (anchor_up, orig_up, usize);
+      up = anchor_up;
+
+      count_leading_zeros (d, up[usize-1]);
+      d = usize * BITS_PER_MP_LIMB - d;
+      count_leading_zeros (vbitsize, vp[vsize-1]);
+      vbitsize = vsize * BITS_PER_MP_LIMB - vbitsize;
+      d = d - vbitsize + 1;
+
+      /* Use bmod reduction to quickly discover whether V divides U.  */
+      up[usize++] = 0;				/* Insert leading zero.  */
+      mpn_bdivmod (up, up, usize, vp, vsize, d);
+
+      /* Now skip U/V mod 2^d and any low zero limbs.  */
+      d /= BITS_PER_MP_LIMB, up += d, usize -= d;
+      while (usize != 0 && up[0] == 0)
+	up++, usize--;
+
+      if (usize == 0)				/* GCD == ORIG_V.  */
+	goto done;
+
+      vp = (mp_ptr) TMP_ALLOC ((vsize + 2) * BYTES_PER_MP_LIMB);
+      MPN_COPY (vp, orig_vp, vsize);
+
+      do					/* Main loop.  */
+	{
+          /* mpn_com_n can't be used here because anchor_up and up may
+             partially overlap */
+	  if (up[usize-1] & MP_LIMB_T_HIGHBIT)  /* U < 0; take twos' compl. */
+	    {
+	      mp_size_t i;
+	      anchor_up[0] = -up[0];
+	      for (i = 1; i < usize; i++)
+		anchor_up[i] = ~up[i];
+	      up = anchor_up;
+	    }
+
+	  MPN_NORMALIZE_NOT_ZERO (up, usize);
+
+	  if ((up[0] & 1) == 0)			/* Result even; remove twos. */
+	    {
+	      unsigned int r;
+	      count_trailing_zeros (r, up[0]);
+	      mpn_rshift (anchor_up, up, usize, r);
+	      usize -= (anchor_up[usize-1] == 0);
+	    }
+	  else if (anchor_up != up)
+	    MPN_COPY_INCR (anchor_up, up, usize);
+
+	  MPN_PTR_SWAP (anchor_up,usize, vp,vsize);
+	  up = anchor_up;
+
+	  if (vsize <= 2)		/* Kary can't handle < 2 limbs and  */
+	    break;			/* isn't efficient for == 2 limbs.  */
+
+	  d = vbitsize;
+	  count_leading_zeros (vbitsize, vp[vsize-1]);
+	  vbitsize = vsize * BITS_PER_MP_LIMB - vbitsize;
+	  d = d - vbitsize + 1;
+
+	  if (d > BMOD_THRESHOLD)	/* Bmod reduction.  */
+	    {
+	      up[usize++] = 0;
+	      mpn_bdivmod (up, up, usize, vp, vsize, d);
+	      d /= BITS_PER_MP_LIMB, up += d, usize -= d;
+	    }
+	  else				/* Kary reduction.  */
+	    {
+	      mp_limb_t bp[2], cp[2];
+
+	      /* C <-- V/U mod 2^(2*BITS_PER_MP_LIMB).  */
+              {
+                mp_limb_t u_inv, hi, lo;
+                modlimb_invert (u_inv, up[0]);
+                cp[0] = vp[0] * u_inv;
+                umul_ppmm (hi, lo, cp[0], up[0]);
+                cp[1] = (vp[1] - hi - cp[0] * up[1]) * u_inv;
+              }
+
+	      /* U <-- find_a (C)  *  U.  */
+	      up[usize] = mpn_mul_1 (up, up, usize, find_a (cp));
+	      usize++;
+
+	      /* B <-- A/C == U/V mod 2^(BITS_PER_MP_LIMB + 1).
+		  bp[0] <-- U/V mod 2^BITS_PER_MP_LIMB and
+		  bp[1] <-- ( (U - bp[0] * V)/2^BITS_PER_MP_LIMB ) / V mod 2
+
+                 Like V/U above, but simplified because only the low bit of
+                 bp[1] is wanted. */
+              {
+                mp_limb_t  v_inv, hi, lo;
+                modlimb_invert (v_inv, vp[0]);
+                bp[0] = up[0] * v_inv;
+                umul_ppmm (hi, lo, bp[0], vp[0]);
+                bp[1] = (up[1] + hi + (bp[0]&vp[1])) & 1;
+              }
+
+	      up[usize++] = 0;
+	      if (bp[1])	/* B < 0: U <-- U + (-B)  * V.  */
+		{
+		   mp_limb_t c = mpn_addmul_1 (up, vp, vsize, -bp[0]);
+		   mpn_add_1 (up + vsize, up + vsize, usize - vsize, c);
+		}
+	      else		/* B >= 0:  U <-- U - B * V.  */
+		{
+		  mp_limb_t b = mpn_submul_1 (up, vp, vsize, bp[0]);
+		  mpn_sub_1 (up + vsize, up + vsize, usize - vsize, b);
+		}
+
+	      up += 2, usize -= 2;  /* At least two low limbs are zero.  */
+	    }
+
+	  /* Must remove low zero limbs before complementing.  */
+	  while (usize != 0 && up[0] == 0)
+	    up++, usize--;
+	}
+      while (usize);
+
+      /* Compute GCD (ORIG_V, GCD (ORIG_U, V)).  Binary will execute twice.  */
+      up = orig_up, usize = orig_usize;
+      binary_gcd_ctr = 2;
+    }
+  else
+    binary_gcd_ctr = 1;
+
+  /* Finish up with the binary algorithm.  Executes once or twice.  */
+  for ( ; binary_gcd_ctr--; up = orig_vp, usize = orig_vsize)
+    {
+      if (usize > 2)		/* First make U close to V in size.  */
+	{
+	  unsigned long int vbitsize, d;
+	  count_leading_zeros (d, up[usize-1]);
+	  d = usize * BITS_PER_MP_LIMB - d;
+	  count_leading_zeros (vbitsize, vp[vsize-1]);
+	  vbitsize = vsize * BITS_PER_MP_LIMB - vbitsize;
+	  d = d - vbitsize - 1;
+	  if (d != -(unsigned long int)1 && d > 2)
+	    {
+	      mpn_bdivmod (up, up, usize, vp, vsize, d);  /* Result > 0.  */
+	      d /= (unsigned long int)BITS_PER_MP_LIMB, up += d, usize -= d;
+	    }
+	}
+
+      /* Start binary GCD.  */
+      do
+	{
+	  mp_size_t zeros;
+
+	  /* Make sure U is odd.  */
+	  MPN_NORMALIZE (up, usize);
+	  while (up[0] == 0)
+	    up += 1, usize -= 1;
+	  if ((up[0] & 1) == 0)
+	    {
+	      unsigned int r;
+	      count_trailing_zeros (r, up[0]);
+	      mpn_rshift (up, up, usize, r);
+	      usize -= (up[usize-1] == 0);
+	    }
+
+	  /* Keep usize >= vsize.  */
+	  if (usize < vsize)
+	    MPN_PTR_SWAP (up, usize, vp, vsize);
+
+	  if (usize <= 2)				/* Double precision. */
+	    {
+	      if (vsize == 1)
+		vp[0] = mpn_gcd_1 (up, usize, vp[0]);
+	      else
+		vsize = gcd_2 (vp, up);
+	      break;					/* Binary GCD done.  */
+	    }
+
+	  /* Count number of low zero limbs of U - V.  */
+	  for (zeros = 0; up[zeros] == vp[zeros] && ++zeros != vsize; )
+	    continue;
+
+	  /* If U < V, swap U and V; in any case, subtract V from U.  */
+	  if (zeros == vsize)				/* Subtract done.  */
+	    up += zeros, usize -= zeros;
+	  else if (usize == vsize)
+	    {
+	      mp_size_t size = vsize;
+	      do
+		size--;
+	      while (up[size] == vp[size]);
+	      if (up[size] < vp[size])			/* usize == vsize.  */
+		MP_PTR_SWAP (up, vp);
+	      up += zeros, usize = size + 1 - zeros;
+	      mpn_sub_n (up, up, vp + zeros, usize);
+	    }
+	  else
+	    {
+	      mp_size_t size = vsize - zeros;
+	      up += zeros, usize -= zeros;
+	      if (mpn_sub_n (up, up, vp + zeros, size))
+		{
+		  while (up[size] == 0)			/* Propagate borrow. */
+		    up[size++] = -(mp_limb_t)1;
+		  up[size] -= 1;
+		}
+	    }
+	}
+      while (usize);					/* End binary GCD.  */
+    }
+
+done:
+  if (vp != gp)
+    MPN_COPY (gp, vp, vsize);
+  TMP_FREE (marker);
+  return vsize;
+}
diff --git a/src/gmp/mpn/generic/gcd_1.c b/src/gmp/mpn/generic/gcd_1.c
new file mode 100644
index 000000000..183263663
--- /dev/null
+++ b/src/gmp/mpn/generic/gcd_1.c
@@ -0,0 +1,77 @@
+/* mpn_gcd_1 --
+
+Copyright (C) 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Does not work for U == 0 or V == 0.  It would be tough to make it work for
+   V == 0 since gcd(x,0) = x, and U does not generally fit in an mp_limb_t.  */
+
+mp_limb_t
+#if __STDC__
+mpn_gcd_1 (mp_srcptr up, mp_size_t size, mp_limb_t vlimb)
+#else
+mpn_gcd_1 (up, size, vlimb)
+     mp_srcptr up;
+     mp_size_t size;
+     mp_limb_t vlimb;
+#endif
+{
+  mp_limb_t ulimb;
+  unsigned long int u_low_zero_bits, v_low_zero_bits;
+
+  if (size > 1)
+    {
+      ulimb = mpn_mod_1 (up, size, vlimb);
+      if (ulimb == 0)
+	return vlimb;
+    }
+  else
+    ulimb = up[0];
+
+  /*  Need to eliminate low zero bits.  */
+  count_trailing_zeros (u_low_zero_bits, ulimb);
+  ulimb >>= u_low_zero_bits;
+
+  count_trailing_zeros (v_low_zero_bits, vlimb);
+  vlimb >>= v_low_zero_bits;
+
+  while (ulimb != vlimb)
+    {
+      if (ulimb > vlimb)
+	{
+	  ulimb -= vlimb;
+	  do
+	    ulimb >>= 1;
+	  while ((ulimb & 1) == 0);
+	}
+      else /*  vlimb > ulimb.  */
+	{
+	  vlimb -= ulimb;
+	  do
+	    vlimb >>= 1;
+	  while ((vlimb & 1) == 0);
+	}
+    }
+
+  return  ulimb << MIN (u_low_zero_bits, v_low_zero_bits);
+}
diff --git a/src/gmp/mpn/generic/gcdext.c b/src/gmp/mpn/generic/gcdext.c
new file mode 100644
index 000000000..fe22d779a
--- /dev/null
+++ b/src/gmp/mpn/generic/gcdext.c
@@ -0,0 +1,700 @@
+/* mpn_gcdext -- Extended Greatest Common Divisor.
+
+Copyright (C) 1996, 1998, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD 17
+#endif
+
+#ifndef EXTEND
+#define EXTEND 1
+#endif
+
+#if STAT
+int arr[BITS_PER_MP_LIMB];
+#endif
+
+
+/* mpn_gcdext (GP, SP, SSIZE, UP, USIZE, VP, VSIZE)
+
+   Compute the extended GCD of {UP,USIZE} and {VP,VSIZE} and store the
+   greatest common divisor at GP (unless it is 0), and the first cofactor at
+   SP.  Write the size of the cofactor through the pointer SSIZE.  Return the
+   size of the value at GP.  Note that SP might be a negative number; this is
+   denoted by storing the negative of the size through SSIZE.
+
+   {UP,USIZE} and {VP,VSIZE} are both clobbered.
+
+   The space allocation for all four areas needs to be USIZE+1.
+
+   Preconditions: 1) U >= V.
+		  2) V > 0.  */
+
+/* We use Lehmer's algorithm.  The idea is to extract the most significant
+   bits of the operands, and compute the continued fraction for them.  We then
+   apply the gathered cofactors to the full operands.
+
+   Idea 1: After we have performed a full division, don't shift operands back,
+	   but instead account for the extra factors-of-2 thus introduced.
+   Idea 2: Simple generalization to use divide-and-conquer would give us an
+	   algorithm that runs faster than O(n^2).
+   Idea 3: The input numbers need less space as the computation progresses,
+	   while the s0 and s1 variables need more space.  To save memory, we
+	   could make them share space, and have the latter variables grow
+	   into the former.
+   Idea 4: We should not do double-limb arithmetic from the start.  Instead,
+	   do things in single-limb arithmetic until the quotients differ,
+	   and then switch to double-limb arithmetic.  */
+
+
+/* Division optimized for small quotients.  If the quotient is more than one limb,
+   store 1 in *qh and return 0.  */
+static mp_limb_t
+#if __STDC__
+div2 (mp_limb_t *qh, mp_limb_t n1, mp_limb_t n0, mp_limb_t d1, mp_limb_t d0)
+#else
+div2 (qh, n1, n0, d1, d0)
+     mp_limb_t *qh;
+     mp_limb_t n1;
+     mp_limb_t n0;
+     mp_limb_t d1;
+     mp_limb_t d0;
+#endif
+{
+  if (d1 == 0)
+    {
+      *qh = 1;
+      return 0;
+    }
+
+  if ((mp_limb_signed_t) n1 < 0)
+    {
+      mp_limb_t q;
+      int cnt;
+      for (cnt = 1; (mp_limb_signed_t) d1 >= 0; cnt++)
+	{
+	  d1 = (d1 << 1) | (d0 >> (BITS_PER_MP_LIMB - 1));
+	  d0 = d0 << 1;
+	}
+
+      q = 0;
+      while (cnt)
+	{
+	  q <<= 1;
+	  if (n1 > d1 || (n1 == d1 && n0 >= d0))
+	    {
+	      sub_ddmmss (n1, n0, n1, n0, d1, d0);
+	      q |= 1;
+	    }
+	  d0 = (d1 << (BITS_PER_MP_LIMB - 1)) | (d0 >> 1);
+	  d1 = d1 >> 1;
+	  cnt--;
+	}
+
+      *qh = 0;
+      return q;
+    }
+  else
+    {
+      mp_limb_t q;
+      int cnt;
+      for (cnt = 0; n1 > d1 || (n1 == d1 && n0 >= d0); cnt++)
+	{
+	  d1 = (d1 << 1) | (d0 >> (BITS_PER_MP_LIMB - 1));
+	  d0 = d0 << 1;
+	}
+
+      q = 0;
+      while (cnt)
+	{
+	  d0 = (d1 << (BITS_PER_MP_LIMB - 1)) | (d0 >> 1);
+	  d1 = d1 >> 1;
+	  q <<= 1;
+	  if (n1 > d1 || (n1 == d1 && n0 >= d0))
+	    {
+	      sub_ddmmss (n1, n0, n1, n0, d1, d0);
+	      q |= 1;
+	    }
+	  cnt--;
+	}
+
+      *qh = 0;
+      return q;
+    }
+}
+
+mp_size_t
+#if EXTEND
+#if __STDC__
+mpn_gcdext (mp_ptr gp, mp_ptr s0p, mp_size_t *s0size,
+	    mp_ptr up, mp_size_t size, mp_ptr vp, mp_size_t vsize)
+#else
+mpn_gcdext (gp, s0p, s0size, up, size, vp, vsize)
+     mp_ptr gp;
+     mp_ptr s0p;
+     mp_size_t *s0size;
+     mp_ptr up;
+     mp_size_t size;
+     mp_ptr vp;
+     mp_size_t vsize;
+#endif
+#else
+#if __STDC__
+mpn_gcd (mp_ptr gp,
+	 mp_ptr up, mp_size_t size, mp_ptr vp, mp_size_t vsize)
+#else
+mpn_gcd (gp, up, size, vp, vsize)
+     mp_ptr gp;
+     mp_ptr up;
+     mp_size_t size;
+     mp_ptr vp;
+     mp_size_t vsize;
+#endif
+#endif
+{
+  mp_limb_t A, B, C, D;
+  int cnt;
+  mp_ptr tp, wp;
+#if RECORD
+  mp_limb_t max = 0;
+#endif
+#if EXTEND
+  mp_ptr s1p;
+  mp_ptr orig_s0p = s0p;
+  mp_size_t ssize;
+  int sign = 1;
+#endif
+  int use_double_flag;
+  TMP_DECL (mark);
+
+  TMP_MARK (mark);
+
+  use_double_flag = (size >= GCDEXT_THRESHOLD);
+
+  tp = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
+  wp = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
+#if EXTEND
+  s1p = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
+
+  MPN_ZERO (s0p, size);
+  MPN_ZERO (s1p, size);
+
+  s0p[0] = 1;
+  s1p[0] = 0;
+  ssize = 1;
+#endif
+
+  if (size > vsize)
+    {
+      /* Normalize V (and shift up U the same amount).  */
+      count_leading_zeros (cnt, vp[vsize - 1]);
+      if (cnt != 0)
+	{
+	  mp_limb_t cy;
+	  mpn_lshift (vp, vp, vsize, cnt);
+	  cy = mpn_lshift (up, up, size, cnt);
+	  up[size] = cy;
+	  size += cy != 0;
+	}
+
+      mpn_divmod (up + vsize, up, size, vp, vsize);
+#if EXTEND
+      /* This is really what it boils down to in this case... */
+      s0p[0] = 0;
+      s1p[0] = 1;
+      sign = -sign;
+#endif
+      size = vsize;
+      if (cnt != 0)
+	{
+	  mpn_rshift (up, up, size, cnt);
+	  mpn_rshift (vp, vp, size, cnt);
+	}
+      MP_PTR_SWAP (up, vp);
+    }
+
+  for (;;)
+    {
+      mp_limb_t asign;
+      /* Figure out exact size of V.  */
+      vsize = size;
+      MPN_NORMALIZE (vp, vsize);
+      if (vsize <= 1)
+	break;
+
+      if (use_double_flag)
+	{
+	  mp_limb_t uh, vh, ul, vl;
+	  /* Let UH,UL be the most significant limbs of U, and let VH,VL be
+	     the corresponding bits from V.  */
+	  uh = up[size - 1];
+	  vh = vp[size - 1];
+	  ul = up[size - 2];
+	  vl = vp[size - 2];
+	  count_leading_zeros (cnt, uh);
+	  if (cnt != 0)
+	    {
+	      uh = (uh << cnt) | (ul >> (BITS_PER_MP_LIMB - cnt));
+	      vh = (vh << cnt) | (vl >> (BITS_PER_MP_LIMB - cnt));
+	      vl <<= cnt;
+	      ul <<= cnt;
+	      if (size >= 3)
+		{
+		  ul |= (up[size - 3] >> (BITS_PER_MP_LIMB - cnt));
+		  vl |= (vp[size - 3] >> (BITS_PER_MP_LIMB - cnt));
+		}
+	    }
+
+	  A = 1;
+	  B = 0;
+	  C = 0;
+	  D = 1;
+
+	  asign = 0;
+	  for (;;)
+	    {
+	      mp_limb_t T;
+	      mp_limb_t qh, q1, q2;
+	      mp_limb_t nh, nl, dh, dl;
+	      mp_limb_t t1, t0;
+	      mp_limb_t Th, Tl;
+
+	      sub_ddmmss (dh, dl, vh, vl, 0, C);
+	      if ((dl | dh) == 0)
+		break;
+	      add_ssaaaa (nh, nl, uh, ul, 0, A);
+	      q1 = div2 (&qh, nh, nl, dh, dl);
+	      if (qh != 0)
+		break;		/* could handle this */
+
+	      add_ssaaaa (dh, dl, vh, vl, 0, D);
+	      if ((dl | dh) == 0)
+		break;
+	      sub_ddmmss (nh, nl, uh, ul, 0, B);
+	      q2 = div2 (&qh, nh, nl, dh, dl);
+	      if (qh != 0)
+		break;		/* could handle this */
+
+	      if (q1 != q2)
+		break;
+
+	      asign = ~asign;
+
+	      T = A + q1 * C;
+	      A = C;
+	      C = T;
+	      T = B + q1 * D;
+	      B = D;
+	      D = T;
+	      umul_ppmm (t1, t0, q1, vl);
+	      t1 += q1 * vh;
+	      sub_ddmmss (Th, Tl, uh, ul, t1, t0);
+	      uh = vh, ul = vl;
+	      vh = Th, vl = Tl;
+
+	      add_ssaaaa (dh, dl, vh, vl, 0, C);
+	      sub_ddmmss (nh, nl, uh, ul, 0, A);
+	      q1 = div2 (&qh, nh, nl, dh, dl);
+	      if (qh != 0)
+		break;		/* could handle this */
+
+	      sub_ddmmss (dh, dl, vh, vl, 0, D);
+	      if ((dl | dh) == 0)
+		break;
+	      add_ssaaaa (nh, nl, uh, ul, 0, B);
+	      q2 = div2 (&qh, nh, nl, dh, dl);
+	      if (qh != 0)
+		break;		/* could handle this */
+
+	      if (q1 != q2)
+		break;
+
+	      asign = ~asign;
+
+	      T = A + q1 * C;
+	      A = C;
+	      C = T;
+	      T = B + q1 * D;
+	      B = D;
+	      D = T;
+	      umul_ppmm (t1, t0, q1, vl);
+	      t1 += q1 * vh;
+	      sub_ddmmss (Th, Tl, uh, ul, t1, t0);
+	      uh = vh, ul = vl;
+	      vh = Th, vl = Tl;
+	    }
+#if EXTEND
+	  if (asign)
+	    sign = -sign;
+#endif
+	}
+      else /* Same, but using single-limb calculations.  */
+	{
+	  mp_limb_t uh, vh;
+	  /* Make UH be the most significant limb of U, and make VH be
+	     corresponding bits from V.  */
+	  uh = up[size - 1];
+	  vh = vp[size - 1];
+	  count_leading_zeros (cnt, uh);
+	  if (cnt != 0)
+	    {
+	      uh = (uh << cnt) | (up[size - 2] >> (BITS_PER_MP_LIMB - cnt));
+	      vh = (vh << cnt) | (vp[size - 2] >> (BITS_PER_MP_LIMB - cnt));
+	    }
+
+	  A = 1;
+	  B = 0;
+	  C = 0;
+	  D = 1;
+
+	  asign = 0;
+	  for (;;)
+	    {
+	      mp_limb_t q, T;
+	      if (vh - C == 0 || vh + D == 0)
+		break;
+
+	      q = (uh + A) / (vh - C);
+	      if (q != (uh - B) / (vh + D))
+		break;
+
+	      asign = ~asign;
+
+	      T = A + q * C;
+	      A = C;
+	      C = T;
+	      T = B + q * D;
+	      B = D;
+	      D = T;
+	      T = uh - q * vh;
+	      uh = vh;
+	      vh = T;
+
+	      if (vh - D == 0)
+		break;
+
+	      q = (uh - A) / (vh + C);
+	      if (q != (uh + B) / (vh - D))
+		break;
+
+	      asign = ~asign;
+
+	      T = A + q * C;
+	      A = C;
+	      C = T;
+	      T = B + q * D;
+	      B = D;
+	      D = T;
+	      T = uh - q * vh;
+	      uh = vh;
+	      vh = T;
+	    }
+#if EXTEND
+	  if (asign)
+	    sign = -sign;
+#endif
+	}
+
+#if RECORD
+      max = MAX (A, max);  max = MAX (B, max);
+      max = MAX (C, max);  max = MAX (D, max);
+#endif
+
+      if (B == 0)
+	{
+	  mp_limb_t qh;
+	  mp_size_t i;
+	  /* This is quite rare.  I.e., optimize something else!  */
+
+	  /* Normalize V (and shift up U the same amount).  */
+	  count_leading_zeros (cnt, vp[vsize - 1]);
+	  if (cnt != 0)
+	    {
+	      mp_limb_t cy;
+	      mpn_lshift (vp, vp, vsize, cnt);
+	      cy = mpn_lshift (up, up, size, cnt);
+	      up[size] = cy;
+	      size += cy != 0;
+	    }
+
+	  qh = mpn_divmod (up + vsize, up, size, vp, vsize);
+#if EXTEND
+	  MPN_COPY (tp, s0p, ssize);
+	  {
+	    mp_size_t qsize;
+
+	    qsize = size - vsize; /* size of stored quotient from division */
+	    if (ssize < qsize)
+	      {
+		MPN_ZERO (tp + ssize, qsize - ssize);
+		MPN_ZERO (s1p + ssize, qsize); /* zero s1 too */
+		for (i = 0; i < ssize; i++)
+		  {
+		    mp_limb_t cy;
+		    cy = mpn_addmul_1 (tp + i, up + vsize, qsize, s1p[i]);
+		    tp[qsize + i] = cy;
+		  }
+		if (qh != 0)
+		  {
+		    mp_limb_t cy;
+		    cy = mpn_add_n (tp + qsize, tp + qsize, s1p, ssize);
+		    if (cy != 0)
+		      abort ();
+		  }
+	      }
+	    else
+	      {
+		MPN_ZERO (s1p + ssize, qsize); /* zero s1 too */
+		for (i = 0; i < qsize; i++)
+		  {
+		    mp_limb_t cy;
+		    cy = mpn_addmul_1 (tp + i, s1p, ssize, up[vsize + i]);
+		    tp[ssize + i] = cy;
+		  }
+		if (qh != 0)
+		  {
+		    mp_limb_t cy;
+		    cy = mpn_add_n (tp + qsize, tp + qsize, s1p, ssize);
+		    if (cy != 0)
+		      {
+			tp[qsize + ssize] = cy;
+			s1p[qsize + ssize] = 0;
+			ssize++;
+		      }
+		  }
+	      }
+	    ssize += qsize;
+	    ssize -= tp[ssize - 1] == 0;
+	  }
+
+	  sign = -sign;
+	  MP_PTR_SWAP (s0p, s1p);
+	  MP_PTR_SWAP (s1p, tp);
+#endif
+	  size = vsize;
+	  if (cnt != 0)
+	    {
+	      mpn_rshift (up, up, size, cnt);
+	      mpn_rshift (vp, vp, size, cnt);
+	    }
+	  MP_PTR_SWAP (up, vp);
+	}
+      else
+	{
+#if EXTEND
+	  mp_size_t tsize, wsize;
+#endif
+	  /* T = U*A + V*B
+	     W = U*C + V*D
+	     U = T
+	     V = W	   */
+
+#if STAT
+	  { mp_limb_t x; x = A | B | C | D; count_leading_zeros (cnt, x);
+	  arr[BITS_PER_MP_LIMB - cnt]++; }
+#endif
+	  if (A == 0)
+	    {
+	      /* B == 1 and C == 1 (D is arbitrary) */
+	      mp_limb_t cy;
+	      MPN_COPY (tp, vp, size);
+	      MPN_COPY (wp, up, size);
+	      mpn_submul_1 (wp, vp, size, D);
+	      MP_PTR_SWAP (tp, up);
+	      MP_PTR_SWAP (wp, vp);
+#if EXTEND
+	      MPN_COPY (tp, s1p, ssize);
+	      tsize = ssize;
+	      tp[ssize] = 0;	/* must zero since wp might spill below */
+	      MPN_COPY (wp, s0p, ssize);
+	      cy = mpn_addmul_1 (wp, s1p, ssize, D);
+	      wp[ssize] = cy;
+	      wsize = ssize + (cy != 0);
+	      MP_PTR_SWAP (tp, s0p);
+	      MP_PTR_SWAP (wp, s1p);
+	      ssize = MAX (wsize, tsize);
+#endif
+	    }
+	  else
+	    {
+	      if (asign)
+		{
+		  mp_limb_t cy;
+		  mpn_mul_1 (tp, vp, size, B);
+		  mpn_submul_1 (tp, up, size, A);
+		  mpn_mul_1 (wp, up, size, C);
+		  mpn_submul_1 (wp, vp, size, D);
+		  MP_PTR_SWAP (tp, up);
+		  MP_PTR_SWAP (wp, vp);
+#if EXTEND
+		  cy = mpn_mul_1 (tp, s1p, ssize, B);
+		  cy += mpn_addmul_1 (tp, s0p, ssize, A);
+		  tp[ssize] = cy;
+		  tsize = ssize + (cy != 0);
+		  cy = mpn_mul_1 (wp, s0p, ssize, C);
+		  cy += mpn_addmul_1 (wp, s1p, ssize, D);
+		  wp[ssize] = cy;
+		  wsize = ssize + (cy != 0);
+		  MP_PTR_SWAP (tp, s0p);
+		  MP_PTR_SWAP (wp, s1p);
+		  ssize = MAX (wsize, tsize);
+#endif
+		}
+	      else
+		{
+		  mp_limb_t cy;
+		  mpn_mul_1 (tp, up, size, A);
+		  mpn_submul_1 (tp, vp, size, B);
+		  mpn_mul_1 (wp, vp, size, D);
+		  mpn_submul_1 (wp, up, size, C);
+		  MP_PTR_SWAP (tp, up);
+		  MP_PTR_SWAP (wp, vp);
+#if EXTEND
+		  cy = mpn_mul_1 (tp, s0p, ssize, A);
+		  cy += mpn_addmul_1 (tp, s1p, ssize, B);
+		  tp[ssize] = cy;
+		  tsize = ssize + (cy != 0);
+		  cy = mpn_mul_1 (wp, s1p, ssize, D);
+		  cy += mpn_addmul_1 (wp, s0p, ssize, C);
+		  wp[ssize] = cy;
+		  wsize = ssize + (cy != 0);
+		  MP_PTR_SWAP (tp, s0p);
+		  MP_PTR_SWAP (wp, s1p);
+		  ssize = MAX (wsize, tsize);
+#endif
+		}
+	    }
+
+	  size -= up[size - 1] == 0;
+	}
+    }
+
+#if RECORD
+  printf ("max: %lx\n", max);
+#endif
+
+#if STAT
+ {int i; for (i = 0; i < BITS_PER_MP_LIMB; i++) printf ("%d:%d\n", i, arr[i]);}
+#endif
+
+  if (vsize == 0)
+    {
+      if (gp != up && gp != 0)
+	MPN_COPY (gp, up, size);
+#if EXTEND
+      MPN_NORMALIZE (s0p, ssize);
+      if (orig_s0p != s0p)
+	MPN_COPY (orig_s0p, s0p, ssize);
+      *s0size = sign >= 0 ? ssize : -ssize;
+#endif
+      TMP_FREE (mark);
+      return size;
+    }
+  else
+    {
+      mp_limb_t vl, ul, t;
+#if EXTEND
+      mp_size_t qsize, i;
+#endif
+      vl = vp[0];
+#if EXTEND
+      t = mpn_divmod_1 (wp, up, size, vl);
+
+      MPN_COPY (tp, s0p, ssize);
+
+      qsize = size - (wp[size - 1] == 0); /* size of quotient from division */
+      if (ssize < qsize)
+	{
+	  MPN_ZERO (tp + ssize, qsize - ssize);
+	  MPN_ZERO (s1p + ssize, qsize); /* zero s1 too */
+	  for (i = 0; i < ssize; i++)
+	    {
+	      mp_limb_t cy;
+	      cy = mpn_addmul_1 (tp + i, wp, qsize, s1p[i]);
+	      tp[qsize + i] = cy;
+	    }
+	}
+      else
+	{
+	  MPN_ZERO (s1p + ssize, qsize); /* zero s1 too */
+	  for (i = 0; i < qsize; i++)
+	    {
+	      mp_limb_t cy;
+	      cy = mpn_addmul_1 (tp + i, s1p, ssize, wp[i]);
+	      tp[ssize + i] = cy;
+	    }
+	}
+      ssize += qsize;
+      ssize -= tp[ssize - 1] == 0;
+
+      sign = -sign;
+      MP_PTR_SWAP (s0p, s1p);
+      MP_PTR_SWAP (s1p, tp);
+#else
+      t = mpn_mod_1 (up, size, vl);
+#endif
+      ul = vl;
+      vl = t;
+      while (vl != 0)
+	{
+	  mp_limb_t t;
+#if EXTEND
+	  mp_limb_t q;
+	  q = ul / vl;
+	  t = ul - q * vl;
+
+	  MPN_COPY (tp, s0p, ssize);
+
+	  MPN_ZERO (s1p + ssize, 1); /* zero s1 too */
+
+	  {
+	    mp_limb_t cy;
+	    cy = mpn_addmul_1 (tp, s1p, ssize, q);
+	    tp[ssize] = cy;
+	  }
+
+	  ssize += 1;
+	  ssize -= tp[ssize - 1] == 0;
+
+	  sign = -sign;
+	  MP_PTR_SWAP (s0p, s1p);
+	  MP_PTR_SWAP (s1p, tp);
+#else
+	  t = ul % vl;
+#endif
+	  ul = vl;
+	  vl = t;
+	}
+      if (gp != 0)
+	gp[0] = ul;
+#if EXTEND
+      MPN_NORMALIZE (s0p, ssize);
+      if (orig_s0p != s0p)
+	MPN_COPY (orig_s0p, s0p, ssize);
+      *s0size = sign >= 0 ? ssize : -ssize;
+#endif
+      TMP_FREE (mark);
+      return 1;
+    }
+}
diff --git a/src/gmp/mpn/generic/get_str.c b/src/gmp/mpn/generic/get_str.c
new file mode 100644
index 000000000..a713b6182
--- /dev/null
+++ b/src/gmp/mpn/generic/get_str.c
@@ -0,0 +1,216 @@
+/* mpn_get_str -- Convert a MSIZE long limb vector pointed to by MPTR
+   to a printable string in STR in base BASE.
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Convert the limb vector pointed to by MPTR and MSIZE long to a
+   char array, using base BASE for the result array.  Store the
+   result in the character array STR.  STR must point to an array with
+   space for the largest possible number represented by a MSIZE long
+   limb vector + 1 extra character.
+
+   The result is NOT in Ascii, to convert it to printable format, add
+   '0' or 'A' depending on the base and range.
+
+   Return the number of digits in the result string.
+   This may include some leading zeros.
+
+   The limb vector pointed to by MPTR is clobbered.  */
+
+size_t
+#if __STDC__
+mpn_get_str (unsigned char *str, int base, mp_ptr mptr, mp_size_t msize)
+#else
+mpn_get_str (str, base, mptr, msize)
+     unsigned char *str;
+     int base;
+     mp_ptr mptr;
+     mp_size_t msize;
+#endif
+{
+  mp_limb_t big_base;
+#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
+  int normalization_steps;
+#endif
+#if UDIV_TIME > 2 * UMUL_TIME
+  mp_limb_t big_base_inverted;
+#endif
+  unsigned int dig_per_u;
+  mp_size_t out_len;
+  register unsigned char *s;
+
+  big_base = __mp_bases[base].big_base;
+
+  s = str;
+
+  /* Special case zero, as the code below doesn't handle it.  */
+  if (msize == 0)
+    {
+      s[0] = 0;
+      return 1;
+    }
+
+  if ((base & (base - 1)) == 0)
+    {
+      /* The base is a power of 2.  Make conversion from most
+	 significant side.  */
+      mp_limb_t n1, n0;
+      register int bits_per_digit = big_base;
+      register int x;
+      register int bit_pos;
+      register int i;
+
+      n1 = mptr[msize - 1];
+      count_leading_zeros (x, n1);
+
+	/* BIT_POS should be R when input ends in least sign. nibble,
+	   R + bits_per_digit * n when input ends in n:th least significant
+	   nibble. */
+
+      {
+	int bits;
+
+	bits = BITS_PER_MP_LIMB * msize - x;
+	x = bits % bits_per_digit;
+	if (x != 0)
+	  bits += bits_per_digit - x;
+	bit_pos = bits - (msize - 1) * BITS_PER_MP_LIMB;
+      }
+
+      /* Fast loop for bit output.  */
+      i = msize - 1;
+      for (;;)
+	{
+	  bit_pos -= bits_per_digit;
+	  while (bit_pos >= 0)
+	    {
+	      *s++ = (n1 >> bit_pos) & ((1 << bits_per_digit) - 1);
+	      bit_pos -= bits_per_digit;
+	    }
+	  i--;
+	  if (i < 0)
+	    break;
+	  n0 = (n1 << -bit_pos) & ((1 << bits_per_digit) - 1);
+	  n1 = mptr[i];
+	  bit_pos += BITS_PER_MP_LIMB;
+	  *s++ = n0 | (n1 >> bit_pos);
+	}
+
+      *s = 0;
+
+      return s - str;
+    }
+  else
+    {
+      /* General case.  The base is not a power of 2.  Make conversion
+	 from least significant end.  */
+
+      /* If udiv_qrnnd only handles divisors with the most significant bit
+	 set, prepare BIG_BASE for being a divisor by shifting it to the
+	 left exactly enough to set the most significant bit.  */
+#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
+      count_leading_zeros (normalization_steps, big_base);
+      big_base <<= normalization_steps;
+#if UDIV_TIME > 2 * UMUL_TIME
+      /* Get the fixed-point approximation to 1/(BIG_BASE << NORMALIZATION_STEPS).  */
+      big_base_inverted = __mp_bases[base].big_base_inverted;
+#endif
+#endif
+
+      dig_per_u = __mp_bases[base].chars_per_limb;
+      out_len = ((size_t) msize * BITS_PER_MP_LIMB
+		 * __mp_bases[base].chars_per_bit_exactly) + 1;
+      s += out_len;
+
+      while (msize != 0)
+	{
+	  int i;
+	  mp_limb_t n0, n1;
+
+#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
+	  /* If we shifted BIG_BASE above, shift the dividend too, to get
+	     the right quotient.  We need to do this every loop,
+	     since the intermediate quotients are OK, but the quotient from
+	     one turn in the loop is going to be the dividend in the
+	     next turn, and the dividend needs to be up-shifted.  */
+	  if (normalization_steps != 0)
+	    {
+	      n0 = mpn_lshift (mptr, mptr, msize, normalization_steps);
+
+	      /* If the shifting gave a carry out limb, store it and
+		 increase the length.  */
+	      if (n0 != 0)
+		{
+		  mptr[msize] = n0;
+		  msize++;
+		}
+	    }
+#endif
+
+	  /* Divide the number at TP with BIG_BASE to get a quotient and a
+	     remainder.  The remainder is our new digit in base BIG_BASE.  */
+	  i = msize - 1;
+	  n1 = mptr[i];
+
+	  if (n1 >= big_base)
+	    n1 = 0;
+	  else
+	    {
+	      msize--;
+	      i--;
+	    }
+
+	  for (; i >= 0; i--)
+	    {
+	      n0 = mptr[i];
+#if UDIV_TIME > 2 * UMUL_TIME
+	      udiv_qrnnd_preinv (mptr[i], n1, n1, n0, big_base, big_base_inverted);
+#else
+	      udiv_qrnnd (mptr[i], n1, n1, n0, big_base);
+#endif
+	    }
+
+#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
+	  /* If we shifted above (at previous UDIV_NEEDS_NORMALIZATION tests)
+	     the remainder will be up-shifted here.  Compensate.  */
+	  n1 >>= normalization_steps;
+#endif
+
+	  /* Convert N1 from BIG_BASE to a string of digits in BASE
+	     using single precision operations.  */
+	  for (i = dig_per_u - 1; i >= 0; i--)
+	    {
+	      *--s = n1 % base;
+	      n1 /= base;
+	      if (n1 == 0 && msize == 0)
+		break;
+	    }
+	}
+
+      while (s != str)
+	*--s = 0;
+      return out_len;
+    }
+}
diff --git a/src/gmp/mpn/generic/gmp-mparam.h b/src/gmp/mpn/generic/gmp-mparam.h
new file mode 100644
index 000000000..14bcaece8
--- /dev/null
+++ b/src/gmp/mpn/generic/gmp-mparam.h
@@ -0,0 +1,27 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
diff --git a/src/gmp/mpn/generic/hamdist.c b/src/gmp/mpn/generic/hamdist.c
new file mode 100644
index 000000000..35c10e845
--- /dev/null
+++ b/src/gmp/mpn/generic/hamdist.c
@@ -0,0 +1,94 @@
+/* mpn_hamdist --
+
+Copyright (C) 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined __GNUC__
+/* No processor claiming to be SPARC v9 compliant seem to
+   implement the POPC instruction.  Disable pattern for now.  */
+#if 0 && defined __sparc_v9__ && BITS_PER_MP_LIMB == 64
+#define popc_limb(a) \
+  ({									\
+    DItype __res;							\
+    asm ("popc %1,%0" : "=r" (__res) : "rI" (a));			\
+    __res;								\
+  })
+#endif
+#endif
+
+#ifndef popc_limb
+
+/* Cool population count of a mp_limb_t.
+   You have to figure out how this works, I won't tell you!  */
+
+static inline unsigned int
+#if __STDC__
+popc_limb (mp_limb_t x)
+#else
+popc_limb (x)
+     mp_limb_t x;
+#endif
+{
+#if BITS_PER_MP_LIMB == 64
+  /* We have to go into some trouble to define these constants.
+     (For mp_limb_t being `long long'.)  */
+  mp_limb_t cnst;
+  cnst = 0xaaaaaaaaL | ((mp_limb_t) 0xaaaaaaaaL << BITS_PER_MP_LIMB/2);
+  x -= (x & cnst) >> 1;
+  cnst = 0x33333333L | ((mp_limb_t) 0x33333333L << BITS_PER_MP_LIMB/2);
+  x = ((x & ~cnst) >> 2) + (x & cnst);
+  cnst = 0x0f0f0f0fL | ((mp_limb_t) 0x0f0f0f0fL << BITS_PER_MP_LIMB/2);
+  x = ((x >> 4) + x) & cnst;
+  x = ((x >> 8) + x);
+  x = ((x >> 16) + x);
+  x = ((x >> 32) + x) & 0xff;
+#endif
+#if BITS_PER_MP_LIMB == 32
+  x -= (x & 0xaaaaaaaa) >> 1;
+  x = ((x >> 2) & 0x33333333L) + (x & 0x33333333L);
+  x = ((x >> 4) + x) & 0x0f0f0f0fL;
+  x = ((x >> 8) + x);
+  x = ((x >> 16) + x) & 0xff;
+#endif
+  return x;
+}
+#endif
+
+unsigned long int
+#if __STDC__
+mpn_hamdist (mp_srcptr up, mp_srcptr vp, mp_size_t size)
+#else
+mpn_hamdist (up, vp, size)
+     register mp_srcptr up;
+     register mp_srcptr vp;
+     register mp_size_t size;
+#endif
+{
+  unsigned long int hamdist;
+  mp_size_t i;
+
+  hamdist = 0;
+  for (i = 0; i < size; i++)
+    hamdist += popc_limb (up[i] ^ vp[i]);
+
+  return hamdist;
+}
diff --git a/src/gmp/mpn/generic/inlines.c b/src/gmp/mpn/generic/inlines.c
new file mode 100644
index 000000000..9487e58cf
--- /dev/null
+++ b/src/gmp/mpn/generic/inlines.c
@@ -0,0 +1,24 @@
+/*
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#define _FORCE_INLINES
+#define _EXTERN_INLINE /* empty */
+#include "gmp.h"
diff --git a/src/gmp/mpn/generic/jacbase.c b/src/gmp/mpn/generic/jacbase.c
new file mode 100644
index 000000000..dd437f1ac
--- /dev/null
+++ b/src/gmp/mpn/generic/jacbase.c
@@ -0,0 +1,136 @@
+/* mpn_jacobi_base -- limb/limb Jacobi symbol with restricted arguments.
+
+   THIS INTERFACE IS PRELIMINARY AND MIGHT DISAPPEAR OR BE SUBJECT TO
+   INCOMPATIBLE CHANGES IN A FUTURE RELEASE OF GMP. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.  */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+#if COUNT_TRAILING_ZEROS_TIME <= 7
+/* If count_trailing_zeros is fast, use it.
+   K7 at 7 cycles and P6 at 2 are good here.  K6 at 12-27 and P5 at 18-42
+   are not.  The default 15 in longlong.h is meant to mean not good here.  */
+
+#define PROCESS_TWOS_ANY                                \
+  {                                                     \
+    mp_limb_t  twos;                                    \
+    count_trailing_zeros (twos, a);                     \
+    result_bit1 ^= JACOBI_TWOS_U_BIT1 (twos, b);        \
+    a >>= twos;                                         \
+  }
+
+#define PROCESS_TWOS_EVEN  PROCESS_TWOS_ANY
+
+#else
+/* Use a loop instead.  With "a" uniformly distributed there will usually be
+   only a few trailing zeros.
+
+   Unfortunately the branch for the while loop here will be on a 50/50
+   chance of a 1 or 0, which is bad for branch prediction.  */
+
+#define PROCESS_TWOS_EVEN               \
+  {                                     \
+    int  two;                           \
+    two = JACOBI_TWO_U_BIT1 (b);        \
+    do                                  \
+      {                                 \
+        a >>= 1;                        \
+        result_bit1 ^= two;             \
+        ASSERT (a != 0);                \
+      }                                 \
+    while ((a & 1) == 0);               \
+  }
+
+#define PROCESS_TWOS_ANY        \
+  if ((a & 1) == 0)             \
+    PROCESS_TWOS_EVEN;
+
+#endif
+
+
+/* Calculate the value of the Jacobi symbol (a/b) of two mp_limb_t's, but
+   with a restricted range of inputs accepted, namely b>1, b odd, and a<=b.
+
+   The initial result_bit1 is taken as a parameter for the convenience of
+   mpz_kronecker_zi_ui() et al.  The sign changes both here and in those
+   routines accumulate nicely in bit 1, see the JACOBI macros.
+
+   The return value here is the normal +1, 0, or -1.  Note that +1 and -1
+   have bit 1 in the "BIT1" sense, which could be useful if the caller is
+   accumulating it into some extended calculation.
+
+   Duplicating the loop body to avoid the MP_LIMB_T_SWAP(a,b) would be
+   possible, but a couple of tests suggest it's not a significant speedup,
+   and may even be a slowdown, so what's here is good enough for now.
+
+   Future: The code doesn't demand a<=b actually, so maybe this could be
+   relaxed.  All the places this is used currently call with a<=b though.  */
+
+int
+#if __STDC__
+mpn_jacobi_base (mp_limb_t a, mp_limb_t b, int result_bit1)
+#else
+mpn_jacobi_base (a, b, result_bit1)
+     mp_limb_t a;
+     mp_limb_t b;
+     int       result_bit1;
+#endif
+{
+  ASSERT (b & 1);  /* b odd */
+  ASSERT (b != 1);
+  ASSERT (a <= b);
+
+  if (a == 0)
+    return 0;
+
+  PROCESS_TWOS_ANY;
+  if (a == 1)
+    goto done;
+
+  for (;;)
+    {
+      result_bit1 ^= JACOBI_RECIP_UU_BIT1 (a, b);
+      MP_LIMB_T_SWAP (a, b);
+
+      do
+	{
+          /* working on (a/b), a,b odd, a>=b */
+          ASSERT (a & 1);
+          ASSERT (b & 1);
+          ASSERT (a >= b);
+
+	  if ((a -= b) == 0)
+	    return 0;
+
+          PROCESS_TWOS_EVEN;
+	  if (a == 1)
+	    goto done;
+	}
+      while (a >= b);
+    }
+
+ done:
+  return JACOBI_BIT1_TO_PN (result_bit1);
+}
diff --git a/src/gmp/mpn/generic/lshift.c b/src/gmp/mpn/generic/lshift.c
new file mode 100644
index 000000000..0b5838965
--- /dev/null
+++ b/src/gmp/mpn/generic/lshift.c
@@ -0,0 +1,87 @@
+/* mpn_lshift -- Shift left low level.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Shift U (pointed to by UP and USIZE digits long) CNT bits to the left
+   and store the USIZE least significant digits of the result at WP.
+   Return the bits shifted out from the most significant digit.
+
+   Argument constraints:
+   1. 0 < CNT < BITS_PER_MP_LIMB
+   2. If the result is to be written over the input, WP must be >= UP.
+*/
+
+mp_limb_t
+#if __STDC__
+mpn_lshift (register mp_ptr wp,
+	    register mp_srcptr up, mp_size_t usize,
+	    register unsigned int cnt)
+#else
+mpn_lshift (wp, up, usize, cnt)
+     register mp_ptr wp;
+     register mp_srcptr up;
+     mp_size_t usize;
+     register unsigned int cnt;
+#endif
+{
+  register mp_limb_t high_limb, low_limb;
+  register unsigned sh_1, sh_2;
+  register mp_size_t i;
+  mp_limb_t retval;
+
+#ifdef DEBUG
+  if (usize == 0 || cnt == 0)
+    abort ();
+#endif
+
+  sh_1 = cnt;
+#if 0
+  if (sh_1 == 0)
+    {
+      if (wp != up)
+	{
+	  /* Copy from high end to low end, to allow specified input/output
+	     overlapping.  */
+	  for (i = usize - 1; i >= 0; i--)
+	    wp[i] = up[i];
+	}
+      return 0;
+    }
+#endif
+
+  wp += 1;
+  sh_2 = BITS_PER_MP_LIMB - sh_1;
+  i = usize - 1;
+  low_limb = up[i];
+  retval = low_limb >> sh_2;
+  high_limb = low_limb;
+  while (--i >= 0)
+    {
+      low_limb = up[i];
+      wp[i] = (high_limb << sh_1) | (low_limb >> sh_2);
+      high_limb = low_limb;
+    }
+  wp[i] = high_limb << sh_1;
+
+  return retval;
+}
diff --git a/src/gmp/mpn/generic/mod_1.c b/src/gmp/mpn/generic/mod_1.c
new file mode 100644
index 000000000..168ec9df4
--- /dev/null
+++ b/src/gmp/mpn/generic/mod_1.c
@@ -0,0 +1,175 @@
+/* mpn_mod_1(dividend_ptr, dividend_size, divisor_limb) --
+   Divide (DIVIDEND_PTR,,DIVIDEND_SIZE) by DIVISOR_LIMB.
+   Return the single-limb remainder.
+   There are no constraints on the value of the divisor.
+
+Copyright (C) 1991, 1993, 1994, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#ifndef UMUL_TIME
+#define UMUL_TIME 1
+#endif
+
+#ifndef UDIV_TIME
+#define UDIV_TIME UMUL_TIME
+#endif
+
+mp_limb_t
+#if __STDC__
+mpn_mod_1 (mp_srcptr dividend_ptr, mp_size_t dividend_size,
+	   mp_limb_t divisor_limb)
+#else
+mpn_mod_1 (dividend_ptr, dividend_size, divisor_limb)
+     mp_srcptr dividend_ptr;
+     mp_size_t dividend_size;
+     mp_limb_t divisor_limb;
+#endif
+{
+  mp_size_t i;
+  mp_limb_t n1, n0, r;
+  int dummy;
+
+  /* Botch: Should this be handled at all?  Rely on callers?  */
+  if (dividend_size == 0)
+    return 0;
+
+  /* If multiplication is much faster than division, and the
+     dividend is large, pre-invert the divisor, and use
+     only multiplications in the inner loop.  */
+
+  /* This test should be read:
+       Does it ever help to use udiv_qrnnd_preinv?
+	 && Does what we save compensate for the inversion overhead?  */
+  if (UDIV_TIME > (2 * UMUL_TIME + 6)
+      && (UDIV_TIME - (2 * UMUL_TIME + 6)) * dividend_size > UDIV_TIME)
+    {
+      int normalization_steps;
+
+      count_leading_zeros (normalization_steps, divisor_limb);
+      if (normalization_steps != 0)
+	{
+	  mp_limb_t divisor_limb_inverted;
+
+	  divisor_limb <<= normalization_steps;
+	  invert_limb (divisor_limb_inverted, divisor_limb);
+
+	  n1 = dividend_ptr[dividend_size - 1];
+	  r = n1 >> (BITS_PER_MP_LIMB - normalization_steps);
+
+	  /* Possible optimization:
+	     if (r == 0
+	     && divisor_limb > ((n1 << normalization_steps)
+			     | (dividend_ptr[dividend_size - 2] >> ...)))
+	     ...one division less... */
+
+	  for (i = dividend_size - 2; i >= 0; i--)
+	    {
+	      n0 = dividend_ptr[i];
+	      udiv_qrnnd_preinv (dummy, r, r,
+				 ((n1 << normalization_steps)
+				  | (n0 >> (BITS_PER_MP_LIMB - normalization_steps))),
+				 divisor_limb, divisor_limb_inverted);
+	      n1 = n0;
+	    }
+	  udiv_qrnnd_preinv (dummy, r, r,
+			     n1 << normalization_steps,
+			     divisor_limb, divisor_limb_inverted);
+	  return r >> normalization_steps;
+	}
+      else
+	{
+	  mp_limb_t divisor_limb_inverted;
+
+	  invert_limb (divisor_limb_inverted, divisor_limb);
+
+	  i = dividend_size - 1;
+	  r = dividend_ptr[i];
+
+	  if (r >= divisor_limb)
+	    r = 0;
+	  else
+	    i--;
+
+	  for (; i >= 0; i--)
+	    {
+	      n0 = dividend_ptr[i];
+	      udiv_qrnnd_preinv (dummy, r, r,
+				 n0, divisor_limb, divisor_limb_inverted);
+	    }
+	  return r;
+	}
+    }
+  else
+    {
+      if (UDIV_NEEDS_NORMALIZATION)
+	{
+	  int normalization_steps;
+
+	  count_leading_zeros (normalization_steps, divisor_limb);
+	  if (normalization_steps != 0)
+	    {
+	      divisor_limb <<= normalization_steps;
+
+	      n1 = dividend_ptr[dividend_size - 1];
+	      r = n1 >> (BITS_PER_MP_LIMB - normalization_steps);
+
+	      /* Possible optimization:
+		 if (r == 0
+		 && divisor_limb > ((n1 << normalization_steps)
+				 | (dividend_ptr[dividend_size - 2] >> ...)))
+		 ...one division less... */
+
+	      for (i = dividend_size - 2; i >= 0; i--)
+		{
+		  n0 = dividend_ptr[i];
+		  udiv_qrnnd (dummy, r, r,
+			      ((n1 << normalization_steps)
+			       | (n0 >> (BITS_PER_MP_LIMB - normalization_steps))),
+			      divisor_limb);
+		  n1 = n0;
+		}
+	      udiv_qrnnd (dummy, r, r,
+			  n1 << normalization_steps,
+			  divisor_limb);
+	      return r >> normalization_steps;
+	    }
+	}
+      /* No normalization needed, either because udiv_qrnnd doesn't require
+	 it, or because DIVISOR_LIMB is already normalized.  */
+
+      i = dividend_size - 1;
+      r = dividend_ptr[i];
+
+      if (r >= divisor_limb)
+	r = 0;
+      else
+	i--;
+
+      for (; i >= 0; i--)
+	{
+	  n0 = dividend_ptr[i];
+	  udiv_qrnnd (dummy, r, r, n0, divisor_limb);
+	}
+      return r;
+    }
+}
diff --git a/src/gmp/mpn/generic/mod_1_rs.c b/src/gmp/mpn/generic/mod_1_rs.c
new file mode 100644
index 000000000..62aaa94b9
--- /dev/null
+++ b/src/gmp/mpn/generic/mod_1_rs.c
@@ -0,0 +1,111 @@
+/* mpn_mod_1_rshift -- mpn remainder under hypothetical right shift.
+
+   THE FUNCTION IN THIS FILE IS FOR INTERNAL USE AND HAS A MUTABLE
+   INTERFACE.  IT IS ONLY SAFE TO REACH IT THROUGH DOCUMENTED INTERFACES.
+   IT'S ALMOST GUARANTEED THAT IT'LL CHANGE OR DISAPPEAR IN A FUTURE GNU MP
+   RELEASE. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.  */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+/* When testing on a CPU with UDIV_NEEDS_NORMALIZATION equal to 0, it can be
+   changed to 1 temporarily to test the code under that case too. */
+#if 0
+#undef UDIV_NEEDS_NORMALIZATION
+#define UDIV_NEEDS_NORMALIZATION 1
+#endif
+
+
+/* Calculate the remainder "(ptr,size >> shift) % divisor".  Note ptr,size
+   is unchanged, the shift is only for its effect on the remainder.
+   The shift doesn't even need to be considered until the last limb.
+
+   This function has the normal size!=0 restriction, unlike the basic
+   mpn_mod_1. */
+
+mp_limb_t
+#if __STDC__
+mpn_mod_1_rshift (mp_srcptr ptr, mp_size_t size, unsigned shift,
+                  mp_limb_t divisor)
+#else
+mpn_mod_1_rshift (ptr, size, shift, divisor)
+     mp_srcptr ptr;
+     mp_size_t size;
+     unsigned  shift;
+     mp_limb_t divisor;
+#endif
+{
+  mp_limb_t  quot, rem;
+
+  ASSERT (shift >= 1);
+  ASSERT (shift < BITS_PER_MP_LIMB);
+  ASSERT (size >= 1);
+
+  if (size == 1)
+    return (ptr[0] >> shift) % divisor;
+
+#if UDIV_NEEDS_NORMALIZATION 
+  {
+    int  norm;
+    int  delta;
+
+    count_leading_zeros (norm, divisor);
+    divisor <<= norm;
+
+    delta = shift - norm;
+    if (delta == 0)
+      return mpn_mod_1 (ptr, size, divisor) >> norm;
+
+    if (delta > 0)
+      {
+        rem = mpn_mod_1 (ptr+1, size-1, divisor);
+        udiv_qrnnd (quot, rem,
+                    rem >> delta,
+                    (rem << (BITS_PER_MP_LIMB-delta)) | (ptr[0] >> delta),
+                    divisor);
+        return rem >> norm;
+      }
+    else
+      {
+        rem = mpn_mod_1 (ptr, size, divisor);
+        udiv_qrnnd (quot, rem,
+                    rem >> (BITS_PER_MP_LIMB+delta),
+                    rem << -delta,
+                    divisor);
+        return rem >> norm;
+      }
+  }
+
+#else /* !UDIV_NEEDS_NORMALIZATION */
+
+  rem = mpn_mod_1 (ptr+1, size-1, divisor);
+  udiv_qrnnd (quot, rem,
+              rem >> shift,
+              (rem << (BITS_PER_MP_LIMB-shift)) | (ptr[0] >> shift),
+              divisor);
+  return rem;
+
+#endif
+}
diff --git a/src/gmp/mpn/generic/mul.c b/src/gmp/mpn/generic/mul.c
new file mode 100644
index 000000000..cecfa19ca
--- /dev/null
+++ b/src/gmp/mpn/generic/mul.c
@@ -0,0 +1,190 @@
+/* mpn_mul -- Multiply two natural numbers.
+
+   THE HELPER FUNCTIONS IN THIS FILE (meaning everything except mpn_mul)
+   ARE INTERNAL FUNCTIONS WITH MUTABLE INTERFACES.  IT IS ONLY SAFE TO REACH
+   THEM THROUGH DOCUMENTED INTERFACES.  IN FACT, IT IS ALMOST GUARANTEED
+   THAT THEY'LL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE.
+
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 1999, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Multiply the natural numbers u (pointed to by UP, with UN limbs) and v
+   (pointed to by VP, with VN limbs), and store the result at PRODP.  The
+   result is UN + VN limbs.  Return the most significant limb of the result.
+
+   NOTE: The space pointed to by PRODP is overwritten before finished with U
+   and V, so overlap is an error.
+
+   Argument constraints:
+   1. UN >= VN.
+   2. PRODP != UP and PRODP != VP, i.e. the destination must be distinct from
+      the multiplier and the multiplicand.  */
+
+void
+#if __STDC__
+mpn_sqr_n (mp_ptr prodp,
+         mp_srcptr up, mp_size_t un)
+#else
+mpn_sqr_n (prodp, up, un)
+     mp_ptr prodp;
+     mp_srcptr up;
+     mp_size_t un;
+#endif
+{
+  if (un < KARATSUBA_SQR_THRESHOLD)
+    { /* plain schoolbook multiplication */
+      if (un == 0)
+	return;
+      mpn_sqr_basecase (prodp, up, un);
+    }
+  else if (un < TOOM3_SQR_THRESHOLD)
+    { /* karatsuba multiplication */
+      mp_ptr tspace;
+      TMP_DECL (marker);
+      TMP_MARK (marker);
+      tspace = (mp_ptr) TMP_ALLOC (2 * (un + BITS_PER_MP_LIMB) * BYTES_PER_MP_LIMB);
+      mpn_kara_sqr_n (prodp, up, un, tspace);
+      TMP_FREE (marker);
+    }
+#if WANT_FFT || TUNE_PROGRAM_BUILD
+  else if (un < FFT_SQR_THRESHOLD)
+#else
+  else
+#endif
+    { /* toom3 multiplication */
+      mp_ptr tspace;
+      TMP_DECL (marker);
+      TMP_MARK (marker);
+      tspace = (mp_ptr) TMP_ALLOC (2 * (un + BITS_PER_MP_LIMB) * BYTES_PER_MP_LIMB);
+      mpn_toom3_sqr_n (prodp, up, un, tspace);
+      TMP_FREE (marker);
+    }
+#if WANT_FFT || TUNE_PROGRAM_BUILD
+  else
+    {
+      /* schoenhage multiplication */
+      mpn_mul_fft_full (prodp, up, un, up, un);
+    }
+#endif
+}
+
+mp_limb_t
+#if __STDC__
+mpn_mul (mp_ptr prodp,
+	 mp_srcptr up, mp_size_t un,
+	 mp_srcptr vp, mp_size_t vn)
+#else
+mpn_mul (prodp, up, un, vp, vn)
+     mp_ptr prodp;
+     mp_srcptr up;
+     mp_size_t un;
+     mp_srcptr vp;
+     mp_size_t vn;
+#endif
+{
+  mp_size_t l;
+  mp_limb_t c;
+
+  if (up == vp && un == vn)
+    {
+      mpn_sqr_n (prodp, up, un);
+      return prodp[2 * un - 1];
+    }
+
+  if (vn < KARATSUBA_MUL_THRESHOLD)
+    { /* long multiplication */
+      mpn_mul_basecase (prodp, up, un, vp, vn);
+      return prodp[un + vn - 1];
+    }
+
+  mpn_mul_n (prodp, up, vp, vn);
+  if (un != vn)
+    { mp_limb_t t;
+      mp_ptr ws;
+      TMP_DECL (marker);
+      TMP_MARK (marker);
+
+      prodp += vn;
+      l = vn;
+      up += vn;
+      un -= vn;
+
+      if (un < vn) 
+	{
+	  /* Swap u's and v's. */
+          MPN_SRCPTR_SWAP (up,un, vp,vn);
+	}
+
+      ws = (mp_ptr) TMP_ALLOC (((vn >= KARATSUBA_MUL_THRESHOLD ? vn : un) + vn)
+			       * BYTES_PER_MP_LIMB);
+
+      t = 0;
+      while (vn >= KARATSUBA_MUL_THRESHOLD)
+	{
+	  mpn_mul_n (ws, up, vp, vn);
+	  if (l <= 2*vn) 
+	    {
+	      t += mpn_add_n (prodp, prodp, ws, l);
+	      if (l != 2*vn)
+		{
+		  t = mpn_add_1 (prodp + l, ws + l, 2*vn - l, t);
+		  l = 2*vn;
+		}
+	    }
+	  else
+	    {
+	      c = mpn_add_n (prodp, prodp, ws, 2*vn);
+	      t += mpn_add_1 (prodp + 2*vn, prodp + 2*vn, l - 2*vn, c);
+	    }
+	  prodp += vn;
+	  l -= vn;
+	  up += vn;
+	  un -= vn;
+	  if (un < vn) 
+	    {
+	      /* Swap u's and v's. */
+              MPN_SRCPTR_SWAP (up,un, vp,vn);
+	    }
+	}
+
+      if (vn)
+	{
+	  mpn_mul_basecase (ws, up, un, vp, vn);
+	  if (l <= un + vn) 
+	    {
+	      t += mpn_add_n (prodp, prodp, ws, l);
+	      if (l != un + vn)
+		t = mpn_add_1 (prodp + l, ws + l, un + vn - l, t);
+	    } 
+	  else
+	    {
+	      c = mpn_add_n (prodp, prodp, ws, un + vn);
+	      t += mpn_add_1 (prodp + un + vn, prodp + un + vn, l - un - vn, c);
+	    }
+	}
+
+    TMP_FREE (marker);
+  }
+  return prodp[un + vn - 1];
+}
diff --git a/src/gmp/mpn/generic/mul_1.c b/src/gmp/mpn/generic/mul_1.c
new file mode 100644
index 000000000..1c36b5fb1
--- /dev/null
+++ b/src/gmp/mpn/generic/mul_1.c
@@ -0,0 +1,59 @@
+/* mpn_mul_1 -- Multiply a limb vector with a single limb and
+   store the product in a second limb vector.
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+mp_limb_t
+mpn_mul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     mp_size_t s1_size;
+     register mp_limb_t s2_limb;
+{
+  register mp_limb_t cy_limb;
+  register mp_size_t j;
+  register mp_limb_t prod_high, prod_low;
+
+  /* The loop counter and index J goes from -S1_SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -s1_size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  s1_ptr -= j;
+  res_ptr -= j;
+
+  cy_limb = 0;
+  do
+    {
+      umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
+
+      prod_low += cy_limb;
+      cy_limb = (prod_low < cy_limb) + prod_high;
+
+      res_ptr[j] = prod_low;
+    }
+  while (++j != 0);
+
+  return cy_limb;
+}
diff --git a/src/gmp/mpn/generic/mul_basecase.c b/src/gmp/mpn/generic/mul_basecase.c
new file mode 100644
index 000000000..00c06aa5c
--- /dev/null
+++ b/src/gmp/mpn/generic/mul_basecase.c
@@ -0,0 +1,87 @@
+/* mpn_mul_basecase -- Internal routine to multiply two natural numbers
+   of length m and n.
+
+   THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS ONLY
+   SAFE TO REACH THIS FUNCTION THROUGH DOCUMENTED INTERFACES.
+
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996, 1997, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Handle simple cases with traditional multiplication.
+
+   This is the most critical code of multiplication.  All multiplies rely on
+   this, both small and huge.  Small ones arrive here immediately, huge ones
+   arrive here as this is the base case for Karatsuba's recursive algorithm. */
+
+void
+#if __STDC__
+mpn_mul_basecase (mp_ptr prodp,
+		     mp_srcptr up, mp_size_t usize,
+		     mp_srcptr vp, mp_size_t vsize)
+#else
+mpn_mul_basecase (prodp, up, usize, vp, vsize)
+     mp_ptr prodp;
+     mp_srcptr up;
+     mp_size_t usize;
+     mp_srcptr vp;
+     mp_size_t vsize;
+#endif
+{
+  /* We first multiply by the low order one or two limbs, as the result can
+     be stored, not added, to PROD.  We also avoid a loop for zeroing this
+     way.  */
+#if HAVE_NATIVE_mpn_mul_2
+  if (vsize >= 2)
+    {
+      prodp[usize + 1] = mpn_mul_2 (prodp, up, usize, vp[0], vp[1]);
+      prodp += 2, vp += 2, vsize -= 2;
+    }
+  else
+    {
+      prodp[usize] = mpn_mul_1 (prodp, up, usize, vp[0]);
+      return;
+    }
+#else
+  prodp[usize] = mpn_mul_1 (prodp, up, usize, vp[0]);
+  prodp += 1, vp += 1, vsize -= 1;
+#endif
+
+#if HAVE_NATIVE_mpn_addmul_2
+  while (vsize >= 2)
+    {
+      prodp[usize + 1] = mpn_addmul_2 (prodp, up, usize, vp[0], vp[1]);
+      prodp += 2, vp += 2, vsize -= 2;
+    }
+  if (vsize != 0)
+    prodp[usize] = mpn_addmul_1 (prodp, up, usize, vp[0]);
+#else
+  /* For each iteration in the loop, multiply U with one limb from V, and
+     add the result to PROD.  */
+  while (vsize != 0)
+    {
+      prodp[usize] = mpn_addmul_1 (prodp, up, usize, vp[0]);
+      prodp += 1, vp += 1, vsize -= 1;
+    }
+#endif
+}
diff --git a/src/gmp/mpn/generic/mul_fft.c b/src/gmp/mpn/generic/mul_fft.c
new file mode 100644
index 000000000..00fd6d72d
--- /dev/null
+++ b/src/gmp/mpn/generic/mul_fft.c
@@ -0,0 +1,772 @@
+/* An implementation in GMP of Scho"nhage's fast multiplication algorithm
+   modulo 2^N+1, by Paul Zimmermann, INRIA Lorraine, February 1998.
+
+   THE CONTENTS OF THIS FILE ARE FOR INTERNAL USE AND THE FUNCTIONS HAVE
+   MUTABLE INTERFACES.  IT IS ONLY SAFE TO REACH THEM THROUGH DOCUMENTED
+   INTERFACES.  IT IS ALMOST GUARANTEED THAT THEY'LL CHANGE OR DISAPPEAR IN
+   A FUTURE GNU MP RELEASE.
+
+Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+
+/* References:
+
+   Schnelle Multiplikation grosser Zahlen, by Arnold Scho"nhage and Volker
+   Strassen, Computing 7, p. 281-292, 1971.
+
+   Asymptotically fast algorithms for the numerical multiplication
+   and division of polynomials with complex coefficients, by Arnold Scho"nhage,
+   Computer Algebra, EUROCAM'82, LNCS 144, p. 3-15, 1982.
+
+   Tapes versus Pointers, a study in implementing fast algorithms,
+   by Arnold Scho"nhage, Bulletin of the EATCS, 30, p. 23-32, 1986.
+
+   See also http://www.loria.fr/~zimmerma/bignum
+
+
+   Future:
+
+   K==2 isn't needed in the current uses of this code and the bits specific
+   for that could be dropped.
+
+   It might be possible to avoid a small number of MPN_COPYs by using a
+   rotating temporary or two.
+
+   Multiplications of unequal sized operands can be done with this code, but
+   it needs a tighter test for identifying squaring (same sizes as well as
+   same pointers).  */
+
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+/* Change this to "#define TRACE(x) x" for some traces. */
+#define TRACE(x)
+
+
+
+FFT_TABLE_ATTRS mp_size_t mpn_fft_table[2][MPN_FFT_TABLE_SIZE] = {
+  FFT_MUL_TABLE,
+  FFT_SQR_TABLE
+};
+
+
+static void mpn_mul_fft_internal
+_PROTO ((mp_limb_t *op, mp_srcptr n, mp_srcptr m, mp_size_t pl,
+         int k, int K,
+         mp_limb_t **Ap, mp_limb_t **Bp,
+         mp_limb_t *A, mp_limb_t *B,
+         mp_size_t nprime, mp_size_t l, mp_size_t Mp, int **_fft_l,
+         mp_limb_t *T, int rec));
+
+
+/* Find the best k to use for a mod 2^(n*BITS_PER_MP_LIMB)+1 FFT.
+   sqr==0 if for a multiply, sqr==1 for a square */
+int
+#if __STDC__
+mpn_fft_best_k (mp_size_t n, int sqr)
+#else
+mpn_fft_best_k (n, sqr)
+     mp_size_t n;
+     int       sqr;
+#endif
+{
+  mp_size_t  t;
+  int        i;
+
+  for (i = 0; mpn_fft_table[sqr][i] != 0; i++)
+    if (n < mpn_fft_table[sqr][i])
+      return i + FFT_FIRST_K;
+
+  /* treat 4*last as one further entry */
+  if (i == 0 || n < 4*mpn_fft_table[sqr][i-1])
+    return i + FFT_FIRST_K;
+  else
+    return i + FFT_FIRST_K + 1;
+}
+
+
+/* Returns smallest possible number of limbs >= pl for a fft of size 2^k.
+   FIXME: Is this simply pl rounded up to the next multiple of 2^k ?  */
+
+mp_size_t
+#if __STDC__
+mpn_fft_next_size (mp_size_t pl, int k)
+#else
+mpn_fft_next_size (pl, k)
+     mp_size_t pl;
+     int       k;
+#endif
+{
+  mp_size_t N, M;
+  int       K;
+
+  /*  if (k==0) k = mpn_fft_best_k (pl, sqr); */
+  N = pl*BITS_PER_MP_LIMB;
+  K = 1<<k;
+  if (N%K) N=(N/K+1)*K;
+  M = N/K;
+  if (M%BITS_PER_MP_LIMB) N=((M/BITS_PER_MP_LIMB)+1)*BITS_PER_MP_LIMB*K;
+  return (N/BITS_PER_MP_LIMB);
+}
+
+
+static void
+#if __STDC__
+mpn_fft_initl(int **l, int k)
+#else
+mpn_fft_initl(l, k)
+     int  **l;
+     int  k;
+#endif
+{
+    int i,j,K;
+
+    l[0][0] = 0;
+    for (i=1,K=2;i<=k;i++,K*=2) {
+	for (j=0;j<K/2;j++) {
+	    l[i][j] = 2*l[i-1][j];
+	    l[i][K/2+j] = 1+l[i][j];
+	}
+    }
+}
+
+
+/* a <- -a mod 2^(n*BITS_PER_MP_LIMB)+1 */
+static void
+#if __STDC__
+mpn_fft_neg_modF(mp_limb_t *ap, mp_size_t n)
+#else
+mpn_fft_neg_modF(ap, n)
+     mp_limb_t *ap;
+     mp_size_t n;
+#endif
+{
+  mp_limb_t c;
+
+  c = ap[n]+2;
+  mpn_com_n (ap, ap, n);
+  ap[n]=0; mpn_incr_u(ap, c);
+}
+
+
+/* a <- a*2^e mod 2^(n*BITS_PER_MP_LIMB)+1 */
+static void
+#if __STDC__
+mpn_fft_mul_2exp_modF(mp_limb_t *ap, int e, mp_size_t n, mp_limb_t *tp)
+#else
+mpn_fft_mul_2exp_modF(ap, e, n, tp)
+     mp_limb_t *ap;
+     int e;
+     mp_size_t n;
+     mp_limb_t *tp;
+#endif
+{
+  int d, sh, i; mp_limb_t cc;
+
+  d = e%(n*BITS_PER_MP_LIMB); /* 2^e = (+/-) 2^d */
+  sh = d % BITS_PER_MP_LIMB;
+  if (sh) mpn_lshift(tp, ap, n+1, sh); /* no carry here */
+  else MPN_COPY(tp, ap, n+1);
+  d /= BITS_PER_MP_LIMB; /* now shift of d limbs to the left */
+ if (d) { 
+   /* ap[d..n-1] = tp[0..n-d-1], ap[0..d-1] = -tp[n-d..n-1] */
+   /* mpn_xor would be more efficient here */
+   for (i=d-1;i>=0;i--) ap[i] = ~tp[n-d+i];
+   cc = 1-mpn_add_1(ap, ap, d, 1);
+   if (cc) cc=mpn_sub_1(ap+d, tp, n-d, 1);
+   else MPN_COPY(ap+d, tp, n-d);
+   if (cc+=mpn_sub_1(ap+d, ap+d, n-d, tp[n]))
+     ap[n]=mpn_add_1(ap, ap, n, cc);
+   else ap[n]=0;
+  }
+  else if ((ap[n]=mpn_sub_1(ap, tp, n, tp[n]))) {
+    ap[n]=mpn_add_1(ap, ap, n, 1);
+  }
+  if ((e/(n*BITS_PER_MP_LIMB))%2) mpn_fft_neg_modF(ap, n);
+}
+
+
+/* a <- a+b mod 2^(n*BITS_PER_MP_LIMB)+1 */
+static void
+#if __STDC__
+mpn_fft_add_modF (mp_limb_t *ap, mp_limb_t *bp, int n)
+#else
+mpn_fft_add_modF (ap, bp, n)
+     mp_limb_t *ap,*bp;
+     int n;
+#endif
+{
+  mp_limb_t c;
+
+  c = ap[n] + bp[n] + mpn_add_n(ap, ap, bp, n);
+  if (c>1) c -= 1+mpn_sub_1(ap,ap,n,1);
+  ap[n]=c;
+}
+
+
+/* input: A[0] ... A[inc*(K-1)] are residues mod 2^N+1 where
+          N=n*BITS_PER_MP_LIMB 
+          2^omega is a primitive root mod 2^N+1
+   output: A[inc*l[k][i]] <- \sum (2^omega)^(ij) A[inc*j] mod 2^N+1 */
+
+static void
+#if __STDC__
+mpn_fft_fft_sqr (mp_limb_t **Ap, mp_size_t K, int **ll,
+                 mp_size_t omega, mp_size_t n, mp_size_t inc, mp_limb_t *tp)
+#else
+mpn_fft_fft_sqr(Ap,K,ll,omega,n,inc,tp)
+mp_limb_t **Ap,*tp;
+mp_size_t K,omega,n,inc;
+int       **ll;
+#endif
+{
+  if (K==2) {
+#ifdef ADDSUB
+      if (mpn_addsub_n(Ap[0], Ap[inc], Ap[0], Ap[inc], n+1) & 1)
+#else
+      MPN_COPY(tp, Ap[0], n+1);
+      mpn_add_n(Ap[0], Ap[0], Ap[inc],n+1);
+      if (mpn_sub_n(Ap[inc], tp, Ap[inc],n+1))
+#endif
+      	Ap[inc][n] = mpn_add_1(Ap[inc], Ap[inc], n, 1);
+    }
+    else {
+      int       j, inc2=2*inc;
+      int       *lk = *ll;
+      mp_limb_t *tmp;
+      TMP_DECL(marker);
+
+      TMP_MARK(marker);
+      tmp = TMP_ALLOC_LIMBS (n+1);
+	mpn_fft_fft_sqr(Ap, K/2,ll-1,2*omega,n,inc2, tp);
+	mpn_fft_fft_sqr(Ap+inc, K/2,ll-1,2*omega,n,inc2, tp);
+	/* A[2*j*inc]   <- A[2*j*inc] + omega^l[k][2*j*inc] A[(2j+1)inc]
+	   A[(2j+1)inc] <- A[2*j*inc] + omega^l[k][(2j+1)inc] A[(2j+1)inc] */
+	for (j=0;j<K/2;j++,lk+=2,Ap+=2*inc) {
+	  MPN_COPY(tp, Ap[inc], n+1);
+	  mpn_fft_mul_2exp_modF(Ap[inc], lk[1]*omega, n, tmp);
+	  mpn_fft_add_modF(Ap[inc], Ap[0], n);
+	  mpn_fft_mul_2exp_modF(tp,lk[0]*omega, n, tmp);
+	  mpn_fft_add_modF(Ap[0], tp, n);
+	}
+        TMP_FREE(marker);
+    }
+}
+
+
+/* input: A[0] ... A[inc*(K-1)] are residues mod 2^N+1 where
+          N=n*BITS_PER_MP_LIMB 
+         2^omega is a primitive root mod 2^N+1 
+   output: A[inc*l[k][i]] <- \sum (2^omega)^(ij) A[inc*j] mod 2^N+1 */
+
+static void
+#if __STDC__
+mpn_fft_fft (mp_limb_t **Ap, mp_limb_t **Bp, mp_size_t K, int **ll,
+             mp_size_t omega, mp_size_t n, mp_size_t inc, mp_limb_t *tp)
+#else
+mpn_fft_fft(Ap,Bp,K,ll,omega,n,inc,tp)
+     mp_limb_t **Ap,**Bp,*tp;
+     mp_size_t K,omega,n,inc;
+     int       **ll;
+#endif
+{
+  if (K==2) {
+#ifdef ADDSUB
+      if (mpn_addsub_n(Ap[0], Ap[inc], Ap[0], Ap[inc], n+1) & 1)
+#else
+      MPN_COPY(tp, Ap[0], n+1);
+      mpn_add_n(Ap[0], Ap[0], Ap[inc],n+1);
+      if (mpn_sub_n(Ap[inc], tp, Ap[inc],n+1))
+#endif
+      	Ap[inc][n] = mpn_add_1(Ap[inc], Ap[inc], n, 1);
+#ifdef ADDSUB
+      if (mpn_addsub_n(Bp[0], Bp[inc], Bp[0], Bp[inc], n+1) & 1)
+#else
+      MPN_COPY(tp, Bp[0], n+1);
+      mpn_add_n(Bp[0], Bp[0], Bp[inc],n+1);
+      if (mpn_sub_n(Bp[inc], tp, Bp[inc],n+1))
+#endif
+      	Bp[inc][n] = mpn_add_1(Bp[inc], Bp[inc], n, 1);
+    }
+    else {
+	int       j, inc2=2*inc;
+        int       *lk=*ll;
+        mp_limb_t *tmp;
+	TMP_DECL(marker);
+
+	TMP_MARK(marker);
+	tmp = TMP_ALLOC_LIMBS (n+1);
+	mpn_fft_fft(Ap, Bp, K/2,ll-1,2*omega,n,inc2, tp);
+	mpn_fft_fft(Ap+inc, Bp+inc, K/2,ll-1,2*omega,n,inc2, tp);
+	/* A[2*j*inc]   <- A[2*j*inc] + omega^l[k][2*j*inc] A[(2j+1)inc]
+	   A[(2j+1)inc] <- A[2*j*inc] + omega^l[k][(2j+1)inc] A[(2j+1)inc] */
+	for (j=0;j<K/2;j++,lk+=2,Ap+=2*inc,Bp+=2*inc) {
+	  MPN_COPY(tp, Ap[inc], n+1);
+	  mpn_fft_mul_2exp_modF(Ap[inc], lk[1]*omega, n, tmp);
+	  mpn_fft_add_modF(Ap[inc], Ap[0], n);
+	  mpn_fft_mul_2exp_modF(tp,lk[0]*omega, n, tmp);
+	  mpn_fft_add_modF(Ap[0], tp, n);
+	  MPN_COPY(tp, Bp[inc], n+1);
+	  mpn_fft_mul_2exp_modF(Bp[inc], lk[1]*omega, n, tmp);
+	  mpn_fft_add_modF(Bp[inc], Bp[0], n);
+	  mpn_fft_mul_2exp_modF(tp,lk[0]*omega, n, tmp);
+	  mpn_fft_add_modF(Bp[0], tp, n);
+	}
+	TMP_FREE(marker);
+    }
+}
+
+
+/* a[i] <- a[i]*b[i] mod 2^(n*BITS_PER_MP_LIMB)+1 for 0 <= i < K */
+static void
+#if __STDC__
+mpn_fft_mul_modF_K (mp_limb_t **ap, mp_limb_t **bp, mp_size_t n, int K) 
+#else
+mpn_fft_mul_modF_K(ap, bp, n, K) 
+     mp_limb_t **ap, **bp;
+     mp_size_t n;
+     int       K;
+#endif
+{
+  int  i;
+  int  sqr = (ap == bp);
+  TMP_DECL(marker);
+  
+  TMP_MARK(marker); 
+
+  if (n >= (sqr ? FFT_MODF_SQR_THRESHOLD : FFT_MODF_MUL_THRESHOLD)) {
+    int k, K2,nprime2,Nprime2,M2,maxLK,l,Mp2;
+    int       **_fft_l;
+    mp_limb_t **Ap,**Bp,*A,*B,*T;
+
+    k = mpn_fft_best_k (n, sqr);
+    K2 = 1<<k;
+    maxLK = (K2>BITS_PER_MP_LIMB) ? K2 : BITS_PER_MP_LIMB;
+    M2 = n*BITS_PER_MP_LIMB/K2;
+    l = n/K2;
+    Nprime2 = ((2*M2+k+2+maxLK)/maxLK)*maxLK; /* ceil((2*M2+k+3)/maxLK)*maxLK*/
+    nprime2 = Nprime2/BITS_PER_MP_LIMB;
+    Mp2 = Nprime2/K2;
+
+    Ap = TMP_ALLOC_MP_PTRS (K2);
+    Bp = TMP_ALLOC_MP_PTRS (K2);
+    A = TMP_ALLOC_LIMBS (2*K2*(nprime2+1));
+    T = TMP_ALLOC_LIMBS (nprime2+1);
+    B = A + K2*(nprime2+1);
+    _fft_l = TMP_ALLOC_TYPE (k+1, int*);
+    for (i=0;i<=k;i++)
+      _fft_l[i] = TMP_ALLOC_TYPE (1<<i, int);
+    mpn_fft_initl(_fft_l, k);
+
+    TRACE (printf("recurse: %dx%d limbs -> %d times %dx%d (%1.2f)\n", n,
+                  n, K2, nprime2, nprime2, 2.0*(double)n/nprime2/K2));
+
+    for (i=0;i<K;i++,ap++,bp++)
+      mpn_mul_fft_internal(*ap, *ap, *bp, n, k, K2, Ap, Bp, A, B, nprime2,
+	 l, Mp2, _fft_l, T, 1);
+  }
+  else {
+     mp_limb_t *a, *b, cc, *tp, *tpn; int n2=2*n;
+     tp = TMP_ALLOC_LIMBS (n2);
+     tpn = tp+n;
+     TRACE (printf ("  mpn_mul_n %d of %d limbs\n", K, n));
+     for (i=0;i<K;i++) {
+        a = *ap++; b=*bp++;
+        if (sqr)
+          mpn_sqr_n(tp, a, n);
+        else
+          mpn_mul_n(tp, b, a, n);
+	if (a[n]) cc=mpn_add_n(tpn, tpn, b, n); else cc=0;
+	if (b[n]) cc += mpn_add_n(tpn, tpn, a, n) + a[n];
+	if (cc) {
+          cc = mpn_add_1(tp, tp, n2, cc);
+          ASSERT_NOCARRY (mpn_add_1(tp, tp, n2, cc));
+        }
+	a[n] = mpn_sub_n(a, tp, tpn, n) && mpn_add_1(a, a, n, 1); 
+     }
+  }
+  TMP_FREE(marker); 
+}
+
+
+/* input: A^[l[k][0]] A^[l[k][1]] ... A^[l[k][K-1]]
+   output: K*A[0] K*A[K-1] ... K*A[1] */
+
+static void
+#if __STDC__
+mpn_fft_fftinv (mp_limb_t **Ap, int K, mp_size_t omega, mp_size_t n,
+                mp_limb_t *tp)
+#else
+mpn_fft_fftinv(Ap,K,omega,n,tp)
+     mp_limb_t **Ap, *tp;
+     int       K;
+     mp_size_t omega, n;
+#endif
+{
+    if (K==2) {
+#ifdef ADDSUB
+      if (mpn_addsub_n(Ap[0], Ap[1], Ap[0], Ap[1], n+1) & 1)
+#else
+      MPN_COPY(tp, Ap[0], n+1);
+      mpn_add_n(Ap[0], Ap[0], Ap[1], n+1);
+      if (mpn_sub_n(Ap[1], tp, Ap[1], n+1))
+#endif
+        Ap[1][n] = mpn_add_1(Ap[1], Ap[1], n, 1);
+    }
+    else {
+	int j, K2=K/2; mp_limb_t **Bp=Ap+K2, *tmp; 
+	TMP_DECL(marker);
+
+	TMP_MARK(marker);
+	tmp = TMP_ALLOC_LIMBS (n+1);
+	mpn_fft_fftinv(Ap, K2, 2*omega, n, tp);
+	mpn_fft_fftinv(Bp, K2, 2*omega, n, tp);
+	/* A[j]     <- A[j] + omega^j A[j+K/2]
+	   A[j+K/2] <- A[j] + omega^(j+K/2) A[j+K/2] */
+        for (j=0;j<K2;j++,Ap++,Bp++) {
+	  MPN_COPY(tp, Bp[0], n+1);
+	  mpn_fft_mul_2exp_modF(Bp[0], (j+K2)*omega, n, tmp);
+	  mpn_fft_add_modF(Bp[0], Ap[0], n);
+	  mpn_fft_mul_2exp_modF(tp, j*omega, n, tmp);
+	  mpn_fft_add_modF(Ap[0], tp, n);
+	}
+	TMP_FREE(marker);
+    }
+}
+
+
+/* A <- A/2^k mod 2^(n*BITS_PER_MP_LIMB)+1 */
+static void
+#if __STDC__
+mpn_fft_div_2exp_modF (mp_limb_t *ap, int k, mp_size_t n, mp_limb_t *tp)
+#else
+mpn_fft_div_2exp_modF(ap,k,n,tp)
+     mp_limb_t *ap,*tp;
+     int       k;
+     mp_size_t n;
+#endif
+{
+    int i;
+    
+    i = 2*n*BITS_PER_MP_LIMB;
+    i = (i-k) % i;
+    mpn_fft_mul_2exp_modF(ap,i,n,tp); 
+    /* 1/2^k = 2^(2nL-k) mod 2^(n*BITS_PER_MP_LIMB)+1 */
+    /* normalize so that A < 2^(n*BITS_PER_MP_LIMB)+1 */
+    if (ap[n]==1) {
+      for (i=0;i<n && ap[i]==0;i++);
+      if (i<n) {
+	ap[n]=0;
+	mpn_sub_1(ap, ap, n, 1);
+      }
+    }
+}
+
+
+/* R <- A mod 2^(n*BITS_PER_MP_LIMB)+1, n<=an<=3*n */
+static void
+#if __STDC__
+mpn_fft_norm_modF(mp_limb_t *rp, mp_limb_t *ap, mp_size_t n, mp_size_t an) 
+#else
+mpn_fft_norm_modF(rp, ap, n, an)
+     mp_limb_t *rp;
+     mp_limb_t *ap;
+     mp_size_t n;
+     mp_size_t an;
+#endif
+{
+  mp_size_t l;
+
+   if (an>2*n) {
+     l = n;
+     rp[n] = mpn_add_1(rp+an-2*n, ap+an-2*n, 3*n-an, 
+		       mpn_add_n(rp,ap,ap+2*n,an-2*n));
+   }
+   else {
+     l = an-n;
+     MPN_COPY(rp, ap, n);
+     rp[n]=0;
+   }
+   if (mpn_sub_n(rp,rp,ap+n,l)) {
+     if (mpn_sub_1(rp+l,rp+l,n+1-l,1))
+       rp[n]=mpn_add_1(rp,rp,n,1); 
+   }
+}
+
+
+static void
+#if __STDC__
+mpn_mul_fft_internal(mp_limb_t *op, mp_srcptr n, mp_srcptr m, mp_size_t pl,
+                     int k, int K,
+                     mp_limb_t **Ap, mp_limb_t **Bp,
+                     mp_limb_t *A, mp_limb_t *B,
+                     mp_size_t nprime, mp_size_t l, mp_size_t Mp,
+                     int **_fft_l,
+                     mp_limb_t *T, int rec)
+#else
+mpn_mul_fft_internal(op,n,m,pl,k,K,Ap,Bp,A,B,nprime,l,Mp,_fft_l,T,rec)
+     mp_limb_t *op;
+     mp_srcptr n, m;
+     mp_limb_t **Ap,**Bp,*A,*B,*T;
+     mp_size_t pl,nprime;
+     int       **_fft_l;
+     int       k,K,l,Mp,rec;
+#endif
+{
+  int       i, sqr, pla, lo, sh, j;
+  mp_limb_t *p;
+
+    sqr = (n==m);
+
+    TRACE (printf ("pl=%d k=%d K=%d np=%d l=%d Mp=%d rec=%d sqr=%d\n",
+                   pl,k,K,nprime,l,Mp,rec,sqr));
+
+    /* decomposition of inputs into arrays Ap[i] and Bp[i] */
+    if (rec) for (i=0;i<K;i++) {
+      Ap[i] = A+i*(nprime+1); Bp[i] = B+i*(nprime+1);
+      /* store the next M bits of n into A[i] */
+      /* supposes that M is a multiple of BITS_PER_MP_LIMB */
+      MPN_COPY(Ap[i], n, l); n+=l; MPN_ZERO(Ap[i]+l, nprime+1-l);
+      /* set most significant bits of n and m (important in recursive calls) */
+      if (i==K-1) Ap[i][l]=n[0];
+      mpn_fft_mul_2exp_modF(Ap[i], i*Mp, nprime, T);
+      if (!sqr) {
+	MPN_COPY(Bp[i], m, l); m+=l; MPN_ZERO(Bp[i]+l, nprime+1-l);
+	if (i==K-1) Bp[i][l]=m[0];
+	mpn_fft_mul_2exp_modF(Bp[i], i*Mp, nprime, T);
+      }
+    }
+
+    /* direct fft's */
+    if (sqr) mpn_fft_fft_sqr(Ap,K,_fft_l+k,2*Mp,nprime,1, T);
+    else mpn_fft_fft(Ap,Bp,K,_fft_l+k,2*Mp,nprime,1, T);
+
+    /* term to term multiplications */
+    mpn_fft_mul_modF_K(Ap, (sqr) ? Ap : Bp, nprime, K);
+
+    /* inverse fft's */
+    mpn_fft_fftinv(Ap, K, 2*Mp, nprime, T);
+
+    /* division of terms after inverse fft */
+    for (i=0;i<K;i++) mpn_fft_div_2exp_modF(Ap[i],k+((K-i)%K)*Mp,nprime, T);
+
+    /* addition of terms in result p */
+    MPN_ZERO(T,nprime+1); 
+    pla = l*(K-1)+nprime+1; /* number of required limbs for p */
+    p = B; /* B has K*(n'+1) limbs, which is >= pla, i.e. enough */
+    MPN_ZERO(p, pla);
+    sqr=0; /* will accumulate the (signed) carry at p[pla] */
+    for (i=K-1,lo=l*i+nprime,sh=l*i;i>=0;i--,lo-=l,sh-=l) {
+        mp_ptr n = p+sh;
+	j = (K-i)%K;
+	if (mpn_add_n(n,n,Ap[j],nprime+1))
+	  sqr += mpn_add_1(n+nprime+1,n+nprime+1,pla-sh-nprime-1,1);
+	T[2*l]=i+1; /* T = (i+1)*2^(2*M) */
+	if (mpn_cmp(Ap[j],T,nprime+1)>0) { /* subtract 2^N'+1 */
+	  sqr -= mpn_sub_1(n,n,pla-sh,1);
+	  sqr -= mpn_sub_1(p+lo,p+lo,pla-lo,1);
+	}
+    }
+    if (sqr==-1) {
+      if ((sqr=mpn_add_1(p+pla-pl,p+pla-pl,pl,1))) {
+	/* p[pla-pl]...p[pla-1] are all zero */
+        mpn_sub_1(p+pla-pl-1,p+pla-pl-1,pl+1,1);
+	mpn_sub_1(p+pla-1,p+pla-1,1,1);
+      }
+    }
+    else if (sqr==1) {
+	    if (pla>=2*pl)
+	      while ((sqr=mpn_add_1(p+pla-2*pl,p+pla-2*pl,2*pl,sqr)));
+	    else {
+	      sqr = mpn_sub_1(p+pla-pl,p+pla-pl,pl,sqr);
+              ASSERT (sqr == 0);
+	    }
+    }
+    else
+      ASSERT (sqr == 0);
+
+    /* here p < 2^(2M) [K 2^(M(K-1)) + (K-1) 2^(M(K-2)) + ... ]
+              < K 2^(2M) [2^(M(K-1)) + 2^(M(K-2)) + ... ]
+	      < K 2^(2M) 2^(M(K-1))*2 = 2^(M*K+M+k+1) */
+    mpn_fft_norm_modF(op,p,pl,pla);
+}
+
+
+/* op <- n*m mod 2^N+1 with fft of size 2^k where N=pl*BITS_PER_MP_LIMB
+   n and m have respectively nl and ml limbs
+   op must have space for pl+1 limbs
+   One must have pl = mpn_fft_next_size(pl, k).
+*/
+
+void
+#if __STDC__
+mpn_mul_fft (mp_ptr op, mp_size_t pl,
+             mp_srcptr n, mp_size_t nl,
+             mp_srcptr m, mp_size_t ml,
+             int k)
+#else
+mpn_mul_fft (op, pl, n, nl, m, ml, k)
+     mp_ptr    op;
+     mp_size_t pl;
+     mp_srcptr n;
+     mp_size_t nl;
+     mp_srcptr m;
+     mp_size_t ml;
+     int k;
+#endif
+{
+    int        K,maxLK,i,j;
+    mp_size_t  N,Nprime,nprime,M,Mp,l;
+    mp_limb_t  **Ap,**Bp,*A,*T,*B;
+    int        **_fft_l;
+    int        sqr = (n==m && nl==ml);
+    TMP_DECL(marker);
+
+    TRACE (printf ("\nmpn_mul_fft pl=%ld nl=%ld ml=%ld k=%d\n",
+                   pl, nl, ml, k));
+    ASSERT_ALWAYS (mpn_fft_next_size(pl, k) == pl);
+
+    TMP_MARK(marker);
+    N = pl*BITS_PER_MP_LIMB;
+    _fft_l = TMP_ALLOC_TYPE (k+1, int*);
+    for (i=0;i<=k;i++)
+      _fft_l[i] = TMP_ALLOC_TYPE (1<<i, int);
+    mpn_fft_initl(_fft_l, k);
+    K = 1<<k;
+    M = N/K;	/* N = 2^k M */
+    l = M/BITS_PER_MP_LIMB;
+    maxLK = (K>BITS_PER_MP_LIMB) ? K : BITS_PER_MP_LIMB;
+
+    Nprime = ((2*M+k+2+maxLK)/maxLK)*maxLK; /* ceil((2*M+k+3)/maxLK)*maxLK; */
+    nprime = Nprime/BITS_PER_MP_LIMB; 
+    TRACE (printf ("N=%d K=%d, M=%d, l=%d, maxLK=%d, Np=%d, np=%d\n",
+                   N, K, M, l, maxLK, Nprime, nprime));
+    if (nprime >= (sqr ? FFT_MODF_SQR_THRESHOLD : FFT_MODF_MUL_THRESHOLD)) {
+      maxLK = (1<<mpn_fft_best_k(nprime,n==m))*BITS_PER_MP_LIMB;
+      if (Nprime % maxLK) {
+	Nprime=((Nprime/maxLK)+1)*maxLK;
+	nprime = Nprime/BITS_PER_MP_LIMB;
+      }
+      TRACE (printf ("new maxLK=%d, Np=%d, np=%d\n", maxLK, Nprime, nprime));
+    }
+
+    T = TMP_ALLOC_LIMBS (nprime+1);
+    Mp = Nprime/K;
+
+    TRACE (printf("%dx%d limbs -> %d times %dx%d limbs (%1.2f)\n",
+                  pl,pl,K,nprime,nprime,2.0*(double)N/Nprime/K);
+           printf("   temp space %ld\n", 2*K*(nprime+1)));
+
+    A = _MP_ALLOCATE_FUNC_LIMBS (2*K*(nprime+1));
+    B = A+K*(nprime+1);
+    Ap = TMP_ALLOC_MP_PTRS (K); 
+    Bp = TMP_ALLOC_MP_PTRS (K); 
+    /* special decomposition for main call */
+    for (i=0;i<K;i++) {
+      Ap[i] = A+i*(nprime+1); Bp[i] = B+i*(nprime+1);
+      /* store the next M bits of n into A[i] */
+      /* supposes that M is a multiple of BITS_PER_MP_LIMB */
+      if (nl>0) {
+	j = (nl>=l) ? l : nl; /* limbs to store in Ap[i] */
+	MPN_COPY(Ap[i], n, j); n+=l; MPN_ZERO(Ap[i]+j, nprime+1-j);
+	mpn_fft_mul_2exp_modF(Ap[i], i*Mp, nprime, T);
+      }
+      else MPN_ZERO(Ap[i], nprime+1);
+      nl -= l;
+      if (n!=m) {
+	if (ml>0) {
+	  j = (ml>=l) ? l : ml; /* limbs to store in Bp[i] */
+	  MPN_COPY(Bp[i], m, j); m+=l; MPN_ZERO(Bp[i]+j, nprime+1-j);
+	  mpn_fft_mul_2exp_modF(Bp[i], i*Mp, nprime, T);
+	}
+	else MPN_ZERO(Bp[i], nprime+1);
+      }
+      ml -= l;
+    }
+    mpn_mul_fft_internal(op,n,m,pl,k,K,Ap,Bp,A,B,nprime,l,Mp,_fft_l,T,0);
+    TMP_FREE(marker);
+    _MP_FREE_FUNC_LIMBS (A, 2*K*(nprime+1));
+}
+
+
+#if WANT_ASSERT
+static int
+#if __STDC__
+mpn_zero_p (mp_ptr p, mp_size_t n)
+#else
+     mpn_zero_p (p, n)
+     mp_ptr p;
+     mp_size_t n;
+#endif
+{
+  mp_size_t i;
+
+  for (i = 0; i < n; i++)
+    {
+      if (p[i] != 0)
+        return 0;
+    }
+
+  return 1;
+}
+#endif
+
+
+/* Multiply {n,nl}*{m,ml} and write the result to {op,nl+ml}.
+
+   FIXME: Duplicating the result like this is wasteful, do something better
+   perhaps at the norm_modF stage above. */
+
+void
+#if __STDC__
+mpn_mul_fft_full (mp_ptr op,
+                  mp_srcptr n, mp_size_t nl,
+                  mp_srcptr m, mp_size_t ml)
+#else
+mpn_mul_fft_full (op, n, nl, m, ml)
+     mp_ptr    op;
+     mp_srcptr n;
+     mp_size_t nl;
+     mp_srcptr m;
+     mp_size_t ml;
+#endif
+{
+  mp_ptr     pad_op;
+  mp_size_t  pl;
+  int        k;
+  int        sqr = (n==m && nl==ml);
+
+  k = mpn_fft_best_k (nl+ml, sqr);
+  pl = mpn_fft_next_size (nl+ml, k);
+
+  TRACE (printf ("mpn_mul_fft_full nl=%ld ml=%ld -> pl=%ld k=%d\n",
+                 nl, ml, pl, k));
+
+  pad_op = _MP_ALLOCATE_FUNC_LIMBS (pl+1);
+  mpn_mul_fft (pad_op, pl, n, nl, m, ml, k);
+
+  ASSERT (mpn_zero_p (pad_op+nl+ml, pl+1-(nl+ml)));
+  MPN_COPY (op, pad_op, nl+ml);
+
+  _MP_FREE_FUNC_LIMBS (pad_op, pl+1);
+}
diff --git a/src/gmp/mpn/generic/mul_n.c b/src/gmp/mpn/generic/mul_n.c
new file mode 100644
index 000000000..b7563be2d
--- /dev/null
+++ b/src/gmp/mpn/generic/mul_n.c
@@ -0,0 +1,1343 @@
+/* mpn_mul_n and helper function -- Multiply/square natural numbers.
+
+   THE HELPER FUNCTIONS IN THIS FILE (meaning everything except mpn_mul_n)
+   ARE INTERNAL FUNCTIONS WITH MUTABLE INTERFACES.  IT IS ONLY SAFE TO REACH
+   THEM THROUGH DOCUMENTED INTERFACES.  IN FACT, IT IS ALMOST GUARANTEED
+   THAT THEY'LL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE.
+
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 1998, 1999, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+/* Multiplicative inverse of 3, modulo 2^BITS_PER_MP_LIMB.
+   0xAAAAAAAB for 32 bits, 0xAAAAAAAAAAAAAAAB for 64 bits. */
+#define INVERSE_3      ((MP_LIMB_T_MAX / 3) * 2 + 1)
+
+#if !defined (__alpha) && !defined (__mips)
+/* For all other machines, we want to call mpn functions for the compund
+   operations instead of open-coding them.  */
+#define USE_MORE_MPN
+#endif
+
+/*== Function declarations =================================================*/
+
+static void evaluate3 _PROTO ((mp_ptr, mp_ptr, mp_ptr,
+                               mp_ptr, mp_ptr, mp_ptr,
+                               mp_srcptr, mp_srcptr, mp_srcptr,
+                               mp_size_t, mp_size_t));
+static void interpolate3 _PROTO ((mp_srcptr,
+                                  mp_ptr, mp_ptr, mp_ptr,
+                                  mp_srcptr,
+                                  mp_ptr, mp_ptr, mp_ptr,
+                                  mp_size_t, mp_size_t));
+static mp_limb_t add2Times _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
+
+
+/*-- mpn_kara_mul_n ---------------------------------------------------------------*/
+
+/* Multiplies using 3 half-sized mults and so on recursively.
+ * p[0..2*n-1] := product of a[0..n-1] and b[0..n-1].
+ * No overlap of p[...] with a[...] or b[...].
+ * ws is workspace.
+ */
+
+void
+#if __STDC__
+mpn_kara_mul_n (mp_ptr p, mp_srcptr a, mp_srcptr b, mp_size_t n, mp_ptr ws)
+#else
+mpn_kara_mul_n(p, a, b, n, ws)
+     mp_ptr    p;
+     mp_srcptr a;
+     mp_srcptr b;
+     mp_size_t n;
+     mp_ptr    ws;
+#endif
+{
+  mp_limb_t i, sign, w, w0, w1;
+  mp_size_t n2;
+  mp_srcptr x, y;
+
+  n2 = n >> 1;
+  ASSERT (n2 > 0);
+
+  if (n & 1)
+    {
+      /* Odd length. */
+      mp_size_t n1, n3, nm1;
+
+      n3 = n - n2;
+
+      sign = 0;
+      w = a[n2];
+      if (w != 0)
+	w -= mpn_sub_n (p, a, a + n3, n2);
+      else
+	{
+	  i = n2;
+	  do
+	    {
+	      --i;
+	      w0 = a[i];
+	      w1 = a[n3+i];
+	    }
+	  while (w0 == w1 && i != 0);
+	  if (w0 < w1)
+	    {
+	      x = a + n3;
+	      y = a;
+	      sign = 1;
+	    }
+	  else
+	    {
+	      x = a;
+	      y = a + n3;
+	    }
+	  mpn_sub_n (p, x, y, n2);
+	}
+      p[n2] = w;
+
+      w = b[n2];
+      if (w != 0)
+	w -= mpn_sub_n (p + n3, b, b + n3, n2);
+      else
+	{
+	  i = n2;
+	  do 
+	    {
+	      --i;
+	      w0 = b[i]; 
+	      w1 = b[n3+i];
+	    }
+	  while (w0 == w1 && i != 0);
+	  if (w0 < w1)
+	    {
+	      x = b + n3;
+	      y = b;
+	      sign ^= 1;
+	    }
+	  else
+	    {
+	      x = b;
+	      y = b + n3;
+	    }
+	  mpn_sub_n (p + n3, x, y, n2);
+	}
+      p[n] = w;
+
+      n1 = n + 1;
+      if (n2 < KARATSUBA_MUL_THRESHOLD)
+	{
+	  if (n3 < KARATSUBA_MUL_THRESHOLD)
+	    {
+	      mpn_mul_basecase (ws, p, n3, p + n3, n3);
+	      mpn_mul_basecase (p, a, n3, b, n3);
+	    }
+	  else
+	    {
+	      mpn_kara_mul_n (ws, p, p + n3, n3, ws + n1);
+	      mpn_kara_mul_n (p, a, b, n3, ws + n1);
+	    }
+	  mpn_mul_basecase (p + n1, a + n3, n2, b + n3, n2);
+	}
+      else
+	{
+	  mpn_kara_mul_n (ws, p, p + n3, n3, ws + n1);
+	  mpn_kara_mul_n (p, a, b, n3, ws + n1);
+	  mpn_kara_mul_n (p + n1, a + n3, b + n3, n2, ws + n1);
+	}
+
+      if (sign)
+	mpn_add_n (ws, p, ws, n1);
+      else
+	mpn_sub_n (ws, p, ws, n1);
+
+      nm1 = n - 1;
+      if (mpn_add_n (ws, p + n1, ws, nm1))
+	{
+	  mp_limb_t x = ws[nm1] + 1;
+	  ws[nm1] = x;
+	  if (x == 0)
+	    ++ws[n];
+	}
+      if (mpn_add_n (p + n3, p + n3, ws, n1))
+	{
+	  mp_limb_t x;
+	  i = n1 + n3;
+	  do
+	    {
+	      x = p[i] + 1;
+	      p[i] = x;
+	      ++i;
+	    } while (x == 0);
+	}
+    }
+  else
+    {
+      /* Even length. */
+      mp_limb_t t;
+
+      i = n2;
+      do
+	{
+	  --i;
+	  w0 = a[i];
+	  w1 = a[n2+i];
+	}
+      while (w0 == w1 && i != 0);
+      sign = 0;
+      if (w0 < w1)
+	{
+	  x = a + n2;
+	  y = a;
+	  sign = 1;
+	}
+      else
+	{
+	  x = a;
+	  y = a + n2;
+	}
+      mpn_sub_n (p, x, y, n2);
+
+      i = n2;
+      do 
+	{
+	  --i;
+	  w0 = b[i];
+	  w1 = b[n2+i];
+	}
+      while (w0 == w1 && i != 0);
+      if (w0 < w1)
+	{
+	  x = b + n2;
+	  y = b;
+	  sign ^= 1;
+	}
+      else
+	{
+	  x = b;
+	  y = b + n2;
+	}
+      mpn_sub_n (p + n2, x, y, n2);
+
+      /* Pointwise products. */
+      if (n2 < KARATSUBA_MUL_THRESHOLD)
+	{
+	  mpn_mul_basecase (ws, p, n2, p + n2, n2);
+	  mpn_mul_basecase (p, a, n2, b, n2);
+	  mpn_mul_basecase (p + n, a + n2, n2, b + n2, n2);
+	}
+      else
+	{
+	  mpn_kara_mul_n (ws, p, p + n2, n2, ws + n);
+	  mpn_kara_mul_n (p, a, b, n2, ws + n);
+	  mpn_kara_mul_n (p + n, a + n2, b + n2, n2, ws + n);
+	}
+
+      /* Interpolate. */
+      if (sign)
+	w = mpn_add_n (ws, p, ws, n);
+      else
+	w = -mpn_sub_n (ws, p, ws, n);
+      w += mpn_add_n (ws, p + n, ws, n);
+      w += mpn_add_n (p + n2, p + n2, ws, n);
+      /* TO DO: could put "if (w) { ... }" here.
+       * Less work but badly predicted branch.
+       * No measurable difference in speed on Alpha.
+       */
+      i = n + n2;
+      t = p[i] + w;
+      p[i] = t;
+      if (t < w)
+	{
+	  do
+	    {
+	      ++i;
+	      w = p[i] + 1;
+	      p[i] = w;
+	    }
+	  while (w == 0);
+	}
+    }
+}
+
+void
+#if __STDC__
+mpn_kara_sqr_n (mp_ptr p, mp_srcptr a, mp_size_t n, mp_ptr ws)
+#else
+mpn_kara_sqr_n (p, a, n, ws)
+     mp_ptr    p;
+     mp_srcptr a;
+     mp_size_t n;
+     mp_ptr    ws;
+#endif
+{
+  mp_limb_t i, sign, w, w0, w1;
+  mp_size_t n2;
+  mp_srcptr x, y;
+
+  n2 = n >> 1;
+  ASSERT (n2 > 0);
+
+  if (n & 1)
+    {
+      /* Odd length. */
+      mp_size_t n1, n3, nm1;
+
+      n3 = n - n2;
+
+      sign = 0;
+      w = a[n2];
+      if (w != 0)
+	w -= mpn_sub_n (p, a, a + n3, n2);
+      else
+	{
+	  i = n2;
+	  do
+	    {
+	      --i;
+	      w0 = a[i];
+	      w1 = a[n3+i];
+	    }
+	  while (w0 == w1 && i != 0);
+	  if (w0 < w1)
+	    {
+	      x = a + n3;
+	      y = a;
+	      sign = 1;
+	    }
+	  else
+	    {
+	      x = a;
+	      y = a + n3;
+	    }
+	  mpn_sub_n (p, x, y, n2);
+	}
+      p[n2] = w;
+
+      w = a[n2];
+      if (w != 0)
+	w -= mpn_sub_n (p + n3, a, a + n3, n2);
+      else
+	{
+	  i = n2;
+	  do 
+	    {
+	      --i;
+	      w0 = a[i]; 
+	      w1 = a[n3+i];
+	    }
+	  while (w0 == w1 && i != 0);
+	  if (w0 < w1)
+	    {
+	      x = a + n3;
+	      y = a;
+	      sign ^= 1;
+	    }
+	  else
+	    {
+	      x = a;
+	      y = a + n3;
+	    }
+	  mpn_sub_n (p + n3, x, y, n2);
+	}
+      p[n] = w;
+
+      n1 = n + 1;
+      if (n2 < KARATSUBA_SQR_THRESHOLD)
+	{
+	  if (n3 < KARATSUBA_SQR_THRESHOLD)
+	    {
+	      mpn_sqr_basecase (ws, p, n3);
+	      mpn_sqr_basecase (p, a, n3);
+	    }
+	  else
+	    {
+	      mpn_kara_sqr_n (ws, p, n3, ws + n1);
+	      mpn_kara_sqr_n (p, a, n3, ws + n1);
+	    }
+	  mpn_sqr_basecase (p + n1, a + n3, n2);
+	}
+      else
+	{
+	  mpn_kara_sqr_n (ws, p, n3, ws + n1);
+	  mpn_kara_sqr_n (p, a, n3, ws + n1);
+	  mpn_kara_sqr_n (p + n1, a + n3, n2, ws + n1);
+	}
+
+      if (sign)
+	mpn_add_n (ws, p, ws, n1);
+      else
+	mpn_sub_n (ws, p, ws, n1);
+
+      nm1 = n - 1;
+      if (mpn_add_n (ws, p + n1, ws, nm1))
+	{
+	  mp_limb_t x = ws[nm1] + 1;
+	  ws[nm1] = x;
+	  if (x == 0)
+	    ++ws[n];
+	}
+      if (mpn_add_n (p + n3, p + n3, ws, n1))
+	{
+	  mp_limb_t x;
+	  i = n1 + n3;
+	  do
+	    {
+	      x = p[i] + 1;
+	      p[i] = x;
+	      ++i;
+	    } while (x == 0);
+	}
+    }
+  else
+    {
+      /* Even length. */
+      mp_limb_t t;
+
+      i = n2;
+      do
+	{
+	  --i;
+	  w0 = a[i];
+	  w1 = a[n2+i];
+	}
+      while (w0 == w1 && i != 0);
+      sign = 0;
+      if (w0 < w1)
+	{
+	  x = a + n2;
+	  y = a;
+	  sign = 1;
+	}
+      else
+	{
+	  x = a;
+	  y = a + n2;
+	}
+      mpn_sub_n (p, x, y, n2);
+
+      i = n2;
+      do 
+	{
+	  --i;
+	  w0 = a[i];
+	  w1 = a[n2+i];
+	}
+      while (w0 == w1 && i != 0);
+      if (w0 < w1)
+	{
+	  x = a + n2;
+	  y = a;
+	  sign ^= 1;
+	}
+      else
+	{
+	  x = a;
+	  y = a + n2;
+	}
+      mpn_sub_n (p + n2, x, y, n2);
+
+      /* Pointwise products. */
+      if (n2 < KARATSUBA_SQR_THRESHOLD)
+	{
+	  mpn_sqr_basecase (ws, p, n2);
+	  mpn_sqr_basecase (p, a, n2);
+	  mpn_sqr_basecase (p + n, a + n2, n2);
+	}
+      else
+	{
+	  mpn_kara_sqr_n (ws, p, n2, ws + n);
+	  mpn_kara_sqr_n (p, a, n2, ws + n);
+	  mpn_kara_sqr_n (p + n, a + n2, n2, ws + n);
+	}
+
+      /* Interpolate. */
+      if (sign)
+	w = mpn_add_n (ws, p, ws, n);
+      else
+	w = -mpn_sub_n (ws, p, ws, n);
+      w += mpn_add_n (ws, p + n, ws, n);
+      w += mpn_add_n (p + n2, p + n2, ws, n);
+      /* TO DO: could put "if (w) { ... }" here.
+       * Less work but badly predicted branch.
+       * No measurable difference in speed on Alpha.
+       */
+      i = n + n2;
+      t = p[i] + w;
+      p[i] = t;
+      if (t < w)
+	{
+	  do
+	    {
+	      ++i;
+	      w = p[i] + 1;
+	      p[i] = w;
+	    }
+	  while (w == 0);
+	}
+    }
+}
+
+/*-- add2Times -------------------------------------------------------------*/
+
+/* z[] = x[] + 2 * y[]
+   Note that z and x might point to the same vectors. */
+#ifdef USE_MORE_MPN
+static inline mp_limb_t
+#if __STDC__
+add2Times (mp_ptr z, mp_srcptr x, mp_srcptr y, mp_size_t n)
+#else
+add2Times (z, x, y, n)
+     mp_ptr    z;
+     mp_srcptr x;
+     mp_srcptr y;
+     mp_size_t n;
+#endif
+{
+  mp_ptr t;
+  mp_limb_t c;
+  TMP_DECL (marker);
+  TMP_MARK (marker);
+  t = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
+  c = mpn_lshift (t, y, n, 1);
+  c += mpn_add_n (z, x, t, n);
+  TMP_FREE (marker);
+  return c;
+}
+#else
+
+static mp_limb_t
+#if __STDC__
+add2Times (mp_ptr z, mp_srcptr x, mp_srcptr y, mp_size_t n)
+#else
+add2Times (z, x, y, n)
+     mp_ptr    z;
+     mp_srcptr x;
+     mp_srcptr y;
+     mp_size_t n;
+#endif
+{
+  mp_limb_t c, v, w;
+
+  ASSERT (n > 0);
+  v = *x; w = *y;
+  c = w >> (BITS_PER_MP_LIMB - 1);
+  w <<= 1;
+  v += w;
+  c += v < w;
+  *z = v;
+  ++x; ++y; ++z;
+  while (--n)
+    {
+      v = *x;
+      w = *y;
+      v += c;
+      c = v < c;
+      c += w >> (BITS_PER_MP_LIMB - 1);
+      w <<= 1;
+      v += w;
+      c += v < w;
+      *z = v;
+      ++x; ++y; ++z;
+    }
+
+  return c;
+}
+#endif
+
+/*-- evaluate3 -------------------------------------------------------------*/
+
+/* Evaluates:
+ *   ph := 4*A+2*B+C
+ *   p1 := A+B+C
+ *   p2 := A+2*B+4*C
+ * where:
+ *   ph[], p1[], p2[], A[] and B[] all have length len,
+ *   C[] has length len2 with len-len2 = 0, 1 or 2.
+ * Returns top words (overflow) at pth, pt1 and pt2 respectively.
+ */
+#ifdef USE_MORE_MPN
+static void
+#if __STDC__
+evaluate3 (mp_ptr ph, mp_ptr p1, mp_ptr p2, mp_ptr pth, mp_ptr pt1, mp_ptr pt2,
+	   mp_srcptr A, mp_srcptr B, mp_srcptr C, mp_size_t len, mp_size_t len2)
+#else
+evaluate3 (ph, p1, p2, pth, pt1, pt2,
+           A, B, C, len, len2)
+     mp_ptr    ph;
+     mp_ptr    p1;
+     mp_ptr    p2;
+     mp_ptr    pth;
+     mp_ptr    pt1;
+     mp_ptr    pt2;
+     mp_srcptr A;
+     mp_srcptr B;
+     mp_srcptr C;
+     mp_size_t len;
+     mp_size_t len2;
+#endif
+{
+  mp_limb_t c, d, e;
+  
+  ASSERT (len - len2 <= 2);
+
+  e = mpn_lshift (p1, B, len, 1);
+
+  c = mpn_lshift (ph, A, len, 2);
+  c += e + mpn_add_n (ph, ph, p1, len);
+  d = mpn_add_n (ph, ph, C, len2);
+  if (len2 == len) c += d; else c += mpn_add_1 (ph + len2, ph + len2, len-len2, d);
+  ASSERT (c < 7);
+  *pth = c;
+
+  c = mpn_lshift (p2, C, len2, 2);
+#if 1
+  if (len2 != len) { p2[len-1] = 0; p2[len2] = c; c = 0; }
+  c += e + mpn_add_n (p2, p2, p1, len);
+#else
+  d = mpn_add_n (p2, p2, p1, len2);
+  c += d;
+  if (len2 != len) c = mpn_add_1 (p2+len2, p1+len2, len-len2, c);
+  c += e;
+#endif
+  c += mpn_add_n (p2, p2, A, len);
+  ASSERT (c < 7);
+  *pt2 = c;
+
+  c = mpn_add_n (p1, A, B, len);
+  d = mpn_add_n (p1, p1, C, len2);
+  if (len2 == len) c += d;
+  else c += mpn_add_1 (p1+len2, p1+len2, len-len2, d);
+  ASSERT (c < 3);
+  *pt1 = c;
+
+}
+
+#else
+
+static void
+#if __STDC__
+evaluate3 (mp_ptr ph, mp_ptr p1, mp_ptr p2, mp_ptr pth, mp_ptr pt1, mp_ptr pt2,
+	   mp_srcptr A, mp_srcptr B, mp_srcptr C, mp_size_t l, mp_size_t ls)
+#else
+evaluate3 (ph, p1, p2, pth, pt1, pt2,
+           A, B, C, l, ls)
+     mp_ptr    ph;
+     mp_ptr    p1;
+     mp_ptr    p2;
+     mp_ptr    pth;
+     mp_ptr    pt1;
+     mp_ptr    pt2;
+     mp_srcptr A;
+     mp_srcptr B;
+     mp_srcptr C;
+     mp_size_t l;
+     mp_size_t ls;
+#endif
+{
+  mp_limb_t a,b,c, i, t, th,t1,t2, vh,v1,v2;
+
+  ASSERT (l - ls <= 2);
+
+  th = t1 = t2 = 0;
+  for (i = 0; i < l; ++i)
+    {
+      a = *A;
+      b = *B;
+      c = i < ls ? *C : 0;
+
+      /* TO DO: choose one of the following alternatives. */
+#if 0
+      t = a << 2;
+      vh = th + t;
+      th = vh < t;
+      th += a >> (BITS_PER_MP_LIMB - 2);
+      t = b << 1;
+      vh += t;
+      th += vh < t;
+      th += b >> (BITS_PER_MP_LIMB - 1);
+      vh += c;
+      th += vh < c;
+#else
+      vh = th + c;
+      th = vh < c;
+      t = b << 1;
+      vh += t;
+      th += vh < t;
+      th += b >> (BITS_PER_MP_LIMB - 1);
+      t = a << 2;
+      vh += t;
+      th += vh < t;
+      th += a >> (BITS_PER_MP_LIMB - 2);
+#endif
+
+      v1 = t1 + a;
+      t1 = v1 < a;
+      v1 += b;
+      t1 += v1 < b;
+      v1 += c;
+      t1 += v1 < c;
+
+      v2 = t2 + a;
+      t2 = v2 < a;
+      t = b << 1;
+      v2 += t;
+      t2 += v2 < t;
+      t2 += b >> (BITS_PER_MP_LIMB - 1);
+      t = c << 2;
+      v2 += t;
+      t2 += v2 < t;
+      t2 += c >> (BITS_PER_MP_LIMB - 2);
+
+      *ph = vh;
+      *p1 = v1;
+      *p2 = v2;
+
+      ++A; ++B; ++C;
+      ++ph; ++p1; ++p2;
+    }
+
+  ASSERT (th < 7);
+  ASSERT (t1 < 3);
+  ASSERT (t2 < 7);
+
+  *pth = th;
+  *pt1 = t1;
+  *pt2 = t2;
+}
+#endif
+
+
+/*-- interpolate3 ----------------------------------------------------------*/
+
+/* Interpolates B, C, D (in-place) from:
+ *   16*A+8*B+4*C+2*D+E
+ *   A+B+C+D+E
+ *   A+2*B+4*C+8*D+16*E
+ * where:
+ *   A[], B[], C[] and D[] all have length l,
+ *   E[] has length ls with l-ls = 0, 2 or 4.
+ *
+ * Reads top words (from earlier overflow) from ptb, ptc and ptd,
+ * and returns new top words there.
+ */
+
+#ifdef USE_MORE_MPN
+static void
+#if __STDC__
+interpolate3 (mp_srcptr A, mp_ptr B, mp_ptr C, mp_ptr D, mp_srcptr E,
+              mp_ptr ptb, mp_ptr ptc, mp_ptr ptd, mp_size_t len, mp_size_t len2)
+#else
+interpolate3 (A, B, C, D, E,
+              ptb, ptc, ptd, len, len2)
+     mp_srcptr A;
+     mp_ptr    B;
+     mp_ptr    C;
+     mp_ptr    D;
+     mp_srcptr E;
+     mp_ptr    ptb;
+     mp_ptr    ptc;
+     mp_ptr    ptd;
+     mp_size_t len;
+     mp_size_t len2;
+#endif
+{
+  mp_ptr ws;
+  mp_limb_t t, tb,tc,td;
+  TMP_DECL (marker);
+  TMP_MARK (marker);
+
+  ASSERT (len - len2 == 0 || len - len2 == 2 || len - len2 == 4);
+
+  /* Let x1, x2, x3 be the values to interpolate.  We have:
+   *         b = 16*a + 8*x1 + 4*x2 + 2*x3 +    e
+   *         c =    a +   x1 +   x2 +   x3 +    e
+   *         d =    a + 2*x1 + 4*x2 + 8*x3 + 16*e
+   */
+
+  ws = (mp_ptr) TMP_ALLOC (len * BYTES_PER_MP_LIMB);
+
+  tb = *ptb; tc = *ptc; td = *ptd;
+
+
+  /* b := b - 16*a -    e
+   * c := c -    a -    e
+   * d := d -    a - 16*e
+   */
+
+  t = mpn_lshift (ws, A, len, 4);
+  tb -= t + mpn_sub_n (B, B, ws, len);
+  t = mpn_sub_n (B, B, E, len2);
+  if (len2 == len) tb -= t;
+  else tb -= mpn_sub_1 (B+len2, B+len2, len-len2, t);
+
+  tc -= mpn_sub_n (C, C, A, len);
+  t = mpn_sub_n (C, C, E, len2);
+  if (len2 == len) tc -= t;
+  else tc -= mpn_sub_1 (C+len2, C+len2, len-len2, t);
+
+  t = mpn_lshift (ws, E, len2, 4);
+  t += mpn_add_n (ws, ws, A, len2);
+#if 1
+  if (len2 != len) t = mpn_add_1 (ws+len2, A+len2, len-len2, t);
+  td -= t + mpn_sub_n (D, D, ws, len);
+#else
+  t += mpn_sub_n (D, D, ws, len2);
+  if (len2 != len) {
+    t = mpn_sub_1 (D+len2, D+len2, len-len2, t);
+    t += mpn_sub_n (D+len2, D+len2, A+len2, len-len2);
+  } /* end if/else */
+  td -= t;
+#endif
+
+
+  /* b, d := b + d, b - d */
+
+#ifdef HAVE_MPN_ADD_SUB_N
+  /* #error TO DO ... */
+#else
+  t = tb + td + mpn_add_n (ws, B, D, len);  
+  td = tb - td - mpn_sub_n (D, B, D, len);
+  tb = t;
+  MPN_COPY (B, ws, len);
+#endif
+  
+  /* b := b-8*c */
+  t = 8 * tc + mpn_lshift (ws, C, len, 3);
+  tb -= t + mpn_sub_n (B, B, ws, len);
+
+  /* c := 2*c - b */
+  tc = 2 * tc + mpn_lshift (C, C, len, 1);
+  tc -= tb + mpn_sub_n (C, C, B, len);
+
+  /* d := d/3 */
+  td = (td - mpn_divexact_by3 (D, D, len)) * INVERSE_3;
+
+  /* b, d := b + d, b - d */
+#ifdef HAVE_MPN_ADD_SUB_N
+  /* #error TO DO ... */
+#else
+  t = tb + td + mpn_add_n (ws, B, D, len);  
+  td = tb - td - mpn_sub_n (D, B, D, len);
+  tb = t;
+  MPN_COPY (B, ws, len);
+#endif
+
+      /* Now:
+       *	 b = 4*x1
+       *	 c = 2*x2
+       *	 d = 4*x3
+       */
+
+  ASSERT(!(*B & 3));
+  mpn_rshift (B, B, len, 2);
+  B[len-1] |= tb<<(BITS_PER_MP_LIMB-2);
+  ASSERT((long)tb >= 0);
+  tb >>= 2;
+
+  ASSERT(!(*C & 1));
+  mpn_rshift (C, C, len, 1);
+  C[len-1] |= tc<<(BITS_PER_MP_LIMB-1);
+  ASSERT((long)tc >= 0);
+  tc >>= 1;
+
+  ASSERT(!(*D & 3));
+  mpn_rshift (D, D, len, 2);
+  D[len-1] |= td<<(BITS_PER_MP_LIMB-2);
+  ASSERT((long)td >= 0);
+  td >>= 2;
+
+#if WANT_ASSERT
+  ASSERT (tb < 2);
+  if (len == len2)
+    {
+      ASSERT (tc < 3);
+      ASSERT (td < 2);
+    }
+  else
+    {
+      ASSERT (tc < 2);
+      ASSERT (!td);
+    }
+#endif
+
+  *ptb = tb;
+  *ptc = tc;
+  *ptd = td;
+
+  TMP_FREE (marker);
+}
+
+#else
+
+static void
+#if __STDC__
+interpolate3 (mp_srcptr A, mp_ptr B, mp_ptr C, mp_ptr D, mp_srcptr E,
+	      mp_ptr ptb, mp_ptr ptc, mp_ptr ptd, mp_size_t l, mp_size_t ls)
+#else
+interpolate3 (A, B, C, D, E,
+              ptb, ptc, ptd, l, ls)
+     mp_srcptr A;
+     mp_ptr    B;
+     mp_ptr    C;
+     mp_ptr    D;
+     mp_srcptr E;
+     mp_ptr    ptb;
+     mp_ptr    ptc;
+     mp_ptr    ptd;
+     mp_size_t l;
+     mp_size_t ls;
+#endif
+{
+  mp_limb_t a,b,c,d,e,t, i, sb,sc,sd, ob,oc,od;
+  const mp_limb_t maskOffHalf = (~(mp_limb_t) 0) << (BITS_PER_MP_LIMB >> 1);
+
+#if WANT_ASSERT
+  t = l - ls;
+  ASSERT (t == 0 || t == 2 || t == 4);
+#endif
+
+  sb = sc = sd = 0;
+  for (i = 0; i < l; ++i)
+    {
+      mp_limb_t tb, tc, td, tt;
+
+      a = *A;
+      b = *B;
+      c = *C;
+      d = *D;
+      e = i < ls ? *E : 0;
+
+      /* Let x1, x2, x3 be the values to interpolate.  We have:
+       *	 b = 16*a + 8*x1 + 4*x2 + 2*x3 +    e
+       *	 c =	a +   x1 +   x2 +   x3 +    e
+       *	 d =	a + 2*x1 + 4*x2 + 8*x3 + 16*e
+       */
+
+      /* b := b - 16*a -    e
+       * c := c -    a -    e
+       * d := d -    a - 16*e
+       */
+      t = a << 4;
+      tb = -(a >> (BITS_PER_MP_LIMB - 4)) - (b < t);
+      b -= t;
+      tb -= b < e;
+      b -= e;
+      tc = -(c < a);
+      c -= a;
+      tc -= c < e;
+      c -= e;
+      td = -(d < a);
+      d -= a;
+      t = e << 4;
+      td = td - (e >> (BITS_PER_MP_LIMB - 4)) - (d < t);
+      d -= t;
+
+      /* b, d := b + d, b - d */
+      t = b + d;
+      tt = tb + td + (t < b);
+      td = tb - td - (b < d);
+      d = b - d;
+      b = t;
+      tb = tt;
+
+      /* b := b-8*c */
+      t = c << 3;
+      tb = tb - (tc << 3) - (c >> (BITS_PER_MP_LIMB - 3)) - (b < t);
+      b -= t;
+
+      /* c := 2*c - b */
+      t = c << 1;
+      tc = (tc << 1) + (c >> (BITS_PER_MP_LIMB - 1)) - tb - (t < b);
+      c = t - b;
+
+      /* d := d/3 */
+      d *= INVERSE_3;
+      td = td - (d >> (BITS_PER_MP_LIMB - 1)) - (d*3 < d);
+      td *= INVERSE_3;
+
+      /* b, d := b + d, b - d */
+      t = b + d;
+      tt = tb + td + (t < b);
+      td = tb - td - (b < d);
+      d = b - d;
+      b = t;
+      tb = tt;
+
+      /* Now:
+       *	 b = 4*x1
+       *	 c = 2*x2
+       *	 d = 4*x3
+       */
+
+      /* sb has period 2. */
+      b += sb;
+      tb += b < sb;
+      sb &= maskOffHalf;
+      sb |= sb >> (BITS_PER_MP_LIMB >> 1);
+      sb += tb;
+
+      /* sc has period 1. */
+      c += sc;
+      tc += c < sc;
+      /* TO DO: choose one of the following alternatives. */
+#if 1
+      sc = (mp_limb_t)((long)sc >> (BITS_PER_MP_LIMB - 1));
+      sc += tc;
+#else
+      sc = tc - ((long)sc < 0L);
+#endif
+
+      /* sd has period 2. */
+      d += sd;
+      td += d < sd;
+      sd &= maskOffHalf;
+      sd |= sd >> (BITS_PER_MP_LIMB >> 1);
+      sd += td;
+
+      if (i != 0)
+	{
+	  B[-1] = ob | b << (BITS_PER_MP_LIMB - 2);
+	  C[-1] = oc | c << (BITS_PER_MP_LIMB - 1);
+	  D[-1] = od | d << (BITS_PER_MP_LIMB - 2);
+	}
+      ob = b >> 2;
+      oc = c >> 1;
+      od = d >> 2;
+
+      ++A; ++B; ++C; ++D; ++E;
+    }
+
+  /* Handle top words. */
+  b = *ptb;
+  c = *ptc;
+  d = *ptd;
+
+  t = b + d;
+  d = b - d;
+  b = t;
+  b -= c << 3;
+  c = (c << 1) - b;
+  d *= INVERSE_3;
+  t = b + d;
+  d = b - d;
+  b = t;
+
+  b += sb;
+  c += sc;
+  d += sd;
+
+  B[-1] = ob | b << (BITS_PER_MP_LIMB - 2);
+  C[-1] = oc | c << (BITS_PER_MP_LIMB - 1);
+  D[-1] = od | d << (BITS_PER_MP_LIMB - 2);
+
+  b >>= 2;
+  c >>= 1;
+  d >>= 2;
+
+#if WANT_ASSERT
+  ASSERT (b < 2);
+  if (l == ls)
+    {
+      ASSERT (c < 3);
+      ASSERT (d < 2);
+    }
+  else
+    {
+      ASSERT (c < 2);
+      ASSERT (!d);
+    }
+#endif
+
+  *ptb = b;
+  *ptc = c;
+  *ptd = d;
+}
+#endif
+
+
+/*-- mpn_toom3_mul_n --------------------------------------------------------------*/
+
+/* Multiplies using 5 mults of one third size and so on recursively.
+ * p[0..2*n-1] := product of a[0..n-1] and b[0..n-1].
+ * No overlap of p[...] with a[...] or b[...].
+ * ws is workspace.
+ */
+
+/* TO DO: If TOOM3_MUL_THRESHOLD is much bigger than KARATSUBA_MUL_THRESHOLD then the
+ *        recursion in mpn_toom3_mul_n() will always bottom out with mpn_kara_mul_n()
+ *        because the "n < KARATSUBA_MUL_THRESHOLD" test here will always be false.
+ */
+
+#define TOOM3_MUL_REC(p, a, b, n, ws) \
+  do {								\
+    if (n < KARATSUBA_MUL_THRESHOLD)				\
+      mpn_mul_basecase (p, a, n, b, n);				\
+    else if (n < TOOM3_MUL_THRESHOLD)				\
+      mpn_kara_mul_n (p, a, b, n, ws);				\
+    else							\
+      mpn_toom3_mul_n (p, a, b, n, ws);				\
+  } while (0)
+
+void
+#if __STDC__
+mpn_toom3_mul_n (mp_ptr p, mp_srcptr a, mp_srcptr b, mp_size_t n, mp_ptr ws)
+#else
+mpn_toom3_mul_n (p, a, b, n, ws)
+     mp_ptr    p;
+     mp_srcptr a;
+     mp_srcptr b;
+     mp_size_t n;
+     mp_ptr    ws;
+#endif
+{
+  mp_limb_t cB,cC,cD, dB,dC,dD, tB,tC,tD;
+  mp_limb_t *A,*B,*C,*D,*E, *W;
+  mp_size_t l,l2,l3,l4,l5,ls;
+
+  /* Break n words into chunks of size l, l and ls.
+   * n = 3*k   => l = k,   ls = k
+   * n = 3*k+1 => l = k+1, ls = k-1
+   * n = 3*k+2 => l = k+1, ls = k
+   */
+  {
+    mp_limb_t m;
+
+    ASSERT (n >= TOOM3_MUL_THRESHOLD);
+    l = ls = n / 3;
+    m = n - l * 3;
+    if (m != 0)
+      ++l;
+    if (m == 1)
+      --ls;
+
+    l2 = l * 2;
+    l3 = l * 3;
+    l4 = l * 4;
+    l5 = l * 5;
+    A = p;
+    B = ws;
+    C = p + l2;
+    D = ws + l2;
+    E = p + l4;
+    W = ws + l4;
+  }
+
+  /** First stage: evaluation at points 0, 1/2, 1, 2, oo. **/
+  evaluate3 (A, B, C, &cB, &cC, &cD, a, a + l, a + l2, l, ls);
+  evaluate3 (A + l, B + l, C + l, &dB, &dC, &dD, b, b + l, b + l2, l, ls);
+
+  /** Second stage: pointwise multiplies. **/
+  TOOM3_MUL_REC(D, C, C + l, l, W);
+  tD = cD*dD;
+  if (cD) tD += mpn_addmul_1 (D + l, C + l, l, cD);
+  if (dD) tD += mpn_addmul_1 (D + l, C, l, dD);
+  ASSERT (tD < 49);
+  TOOM3_MUL_REC(C, B, B + l, l, W);
+  tC = cC*dC;
+  /* TO DO: choose one of the following alternatives. */
+#if 0
+  if (cC) tC += mpn_addmul_1 (C + l, B + l, l, cC);
+  if (dC) tC += mpn_addmul_1 (C + l, B, l, dC);
+#else
+  if (cC)
+    {
+      if (cC == 1) tC += mpn_add_n (C + l, C + l, B + l, l);
+      else tC += add2Times (C + l, C + l, B + l, l);
+    }
+  if (dC)
+    {
+      if (dC == 1) tC += mpn_add_n (C + l, C + l, B, l);
+      else tC += add2Times (C + l, C + l, B, l);
+    }
+#endif
+  ASSERT (tC < 9);
+  TOOM3_MUL_REC(B, A, A + l, l, W);
+  tB = cB*dB;
+  if (cB) tB += mpn_addmul_1 (B + l, A + l, l, cB);
+  if (dB) tB += mpn_addmul_1 (B + l, A, l, dB);
+  ASSERT (tB < 49);
+  TOOM3_MUL_REC(A, a, b, l, W);
+  TOOM3_MUL_REC(E, a + l2, b + l2, ls, W);
+
+  /** Third stage: interpolation. **/
+  interpolate3 (A, B, C, D, E, &tB, &tC, &tD, l2, ls << 1);
+
+  /** Final stage: add up the coefficients. **/
+  {
+    mp_limb_t i, x, y;
+    tB += mpn_add_n (p + l, p + l, B, l2);
+    tD += mpn_add_n (p + l3, p + l3, D, l2);
+    mpn_incr_u (p + l3, tB);
+    mpn_incr_u (p + l4, tC);
+    mpn_incr_u (p + l5, tD);
+  }
+}
+
+/*-- mpn_toom3_sqr_n --------------------------------------------------------------*/
+
+/* Like previous function but for squaring */
+
+#define TOOM3_SQR_REC(p, a, n, ws) \
+  do {								\
+    if (n < KARATSUBA_SQR_THRESHOLD)				\
+      mpn_sqr_basecase (p, a, n);				\
+    else if (n < TOOM3_SQR_THRESHOLD)				\
+      mpn_kara_sqr_n (p, a, n, ws);				\
+    else							\
+      mpn_toom3_sqr_n (p, a, n, ws);				\
+  } while (0)
+
+void
+#if __STDC__
+mpn_toom3_sqr_n (mp_ptr p, mp_srcptr a, mp_size_t n, mp_ptr ws)
+#else
+mpn_toom3_sqr_n (p, a, n, ws)
+     mp_ptr    p;
+     mp_srcptr a;
+     mp_size_t n;
+     mp_ptr    ws;
+#endif
+{
+  mp_limb_t cB,cC,cD, tB,tC,tD;
+  mp_limb_t *A,*B,*C,*D,*E, *W;
+  mp_size_t l,l2,l3,l4,l5,ls;
+
+  /* Break n words into chunks of size l, l and ls.
+   * n = 3*k   => l = k,   ls = k
+   * n = 3*k+1 => l = k+1, ls = k-1
+   * n = 3*k+2 => l = k+1, ls = k
+   */
+  {
+    mp_limb_t m;
+
+    ASSERT (n >= TOOM3_MUL_THRESHOLD);
+    l = ls = n / 3;
+    m = n - l * 3;
+    if (m != 0)
+      ++l;
+    if (m == 1)
+      --ls;
+
+    l2 = l * 2;
+    l3 = l * 3;
+    l4 = l * 4;
+    l5 = l * 5;
+    A = p;
+    B = ws;
+    C = p + l2;
+    D = ws + l2;
+    E = p + l4;
+    W = ws + l4;
+  }
+
+  /** First stage: evaluation at points 0, 1/2, 1, 2, oo. **/
+  evaluate3 (A, B, C, &cB, &cC, &cD, a, a + l, a + l2, l, ls);
+
+  /** Second stage: pointwise multiplies. **/
+  TOOM3_SQR_REC(D, C, l, W);
+  tD = cD*cD;
+  if (cD) tD += mpn_addmul_1 (D + l, C, l, 2*cD);
+  ASSERT (tD < 49);
+  TOOM3_SQR_REC(C, B, l, W);
+  tC = cC*cC;
+  /* TO DO: choose one of the following alternatives. */
+#if 0
+  if (cC) tC += mpn_addmul_1 (C + l, B, l, 2*cC);
+#else
+  if (cC >= 1)
+    {
+      tC += add2Times (C + l, C + l, B, l);
+      if (cC == 2)
+        tC += add2Times (C + l, C + l, B, l);
+    }
+#endif
+  ASSERT (tC < 9);
+  TOOM3_SQR_REC(B, A, l, W);
+  tB = cB*cB;
+  if (cB) tB += mpn_addmul_1 (B + l, A, l, 2*cB);
+  ASSERT (tB < 49);
+  TOOM3_SQR_REC(A, a, l, W);
+  TOOM3_SQR_REC(E, a + l2, ls, W);
+
+  /** Third stage: interpolation. **/
+  interpolate3 (A, B, C, D, E, &tB, &tC, &tD, l2, ls << 1);
+
+  /** Final stage: add up the coefficients. **/
+  {
+    mp_limb_t i, x, y;
+    tB += mpn_add_n (p + l, p + l, B, l2);
+    tD += mpn_add_n (p + l3, p + l3, D, l2);
+    mpn_incr_u (p + l3, tB);
+    mpn_incr_u (p + l4, tC);
+    mpn_incr_u (p + l5, tD);
+  }
+}
+
+void
+#if __STDC__
+mpn_mul_n (mp_ptr p, mp_srcptr a, mp_srcptr b, mp_size_t n)
+#else
+mpn_mul_n (p, a, b, n)
+     mp_ptr    p;
+     mp_srcptr a;
+     mp_srcptr b;
+     mp_size_t n;
+#endif
+{
+  if (n < KARATSUBA_MUL_THRESHOLD)
+    mpn_mul_basecase (p, a, n, b, n);
+  else if (n < TOOM3_MUL_THRESHOLD)
+    {
+      /* Allocate workspace of fixed size on stack: fast! */
+#if TUNE_PROGRAM_BUILD
+      mp_limb_t ws[2 * (TOOM3_MUL_THRESHOLD_LIMIT-1) + 2 * BITS_PER_MP_LIMB];
+#else
+      mp_limb_t ws[2 * (TOOM3_MUL_THRESHOLD-1) + 2 * BITS_PER_MP_LIMB];
+#endif
+      mpn_kara_mul_n (p, a, b, n, ws);
+    }
+#if WANT_FFT || TUNE_PROGRAM_BUILD
+  else if (n < FFT_MUL_THRESHOLD)
+#else
+  else
+#endif
+    {
+      /* Use workspace of unknown size in heap, as stack space may
+       * be limited.  Since n is at least TOOM3_MUL_THRESHOLD, the
+       * multiplication will take much longer than malloc()/free().  */
+      mp_limb_t wsLen, *ws;
+      wsLen = 2 * n + 3 * BITS_PER_MP_LIMB;
+      ws = (mp_ptr) (*_mp_allocate_func) ((size_t) wsLen * sizeof (mp_limb_t));
+      mpn_toom3_mul_n (p, a, b, n, ws);
+      (*_mp_free_func) (ws, (size_t) wsLen * sizeof (mp_limb_t));
+    }
+#if WANT_FFT || TUNE_PROGRAM_BUILD
+  else
+    {
+      mpn_mul_fft_full (p, a, n, b, n);      
+    }
+#endif
+}
diff --git a/src/gmp/mpn/generic/perfsqr.c b/src/gmp/mpn/generic/perfsqr.c
new file mode 100644
index 000000000..42ee3405d
--- /dev/null
+++ b/src/gmp/mpn/generic/perfsqr.c
@@ -0,0 +1,123 @@
+/* mpn_perfect_square_p(u,usize) -- Return non-zero if U is a perfect square,
+   zero otherwise.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+/* sq_res_0x100[x mod 0x100] == 1 iff x mod 0x100 is a quadratic residue
+   modulo 0x100.  */
+static unsigned char const sq_res_0x100[0x100] =
+{
+  1,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
+  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
+  1,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
+  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
+  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
+  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
+  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
+  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
+};
+
+int
+#if __STDC__
+mpn_perfect_square_p (mp_srcptr up, mp_size_t usize)
+#else
+mpn_perfect_square_p (up, usize)
+     mp_srcptr up;
+     mp_size_t usize;
+#endif
+{
+  mp_limb_t rem;
+  mp_ptr root_ptr;
+  int res;
+  TMP_DECL (marker);
+
+  /* The first test excludes 55/64 (85.9%) of the perfect square candidates
+     in O(1) time.  */
+  if ((sq_res_0x100[(unsigned int) up[0] % 0x100] & 1) == 0)
+    return 0;
+
+#if defined (PP)
+  /* The second test excludes 30652543/30808063 (99.5%) of the remaining
+     perfect square candidates in O(n) time.  */
+
+  /* Firstly, compute REM = A mod PP.  */
+  if (UDIV_TIME > (2 * UMUL_TIME + 6))
+    rem = mpn_preinv_mod_1 (up, usize, (mp_limb_t) PP, (mp_limb_t) PP_INVERTED);
+  else
+    rem = mpn_mod_1 (up, usize, (mp_limb_t) PP);
+
+  /* Now decide if REM is a quadratic residue modulo the factors in PP.  */
+
+  /* If A is just a few limbs, computing the square root does not take long
+     time, so things might run faster if we limit this loop according to the
+     size of A.  */
+
+#if BITS_PER_MP_LIMB == 64
+  if (((CNST_LIMB(0x12DD703303AED3) >> rem % 53) & 1) == 0)
+    return 0;
+  if (((CNST_LIMB(0x4351B2753DF) >> rem % 47) & 1) == 0)
+    return 0;
+  if (((CNST_LIMB(0x35883A3EE53) >> rem % 43) & 1) == 0)
+    return 0;
+  if (((CNST_LIMB(0x1B382B50737) >> rem % 41) & 1) == 0)
+    return 0;
+  if (((CNST_LIMB(0x165E211E9B) >> rem % 37) & 1) == 0)
+    return 0;
+  if (((CNST_LIMB(0x121D47B7) >> rem % 31) & 1) == 0)
+    return 0;
+#endif
+  if (((0x13D122F3L >> rem % 29) & 1) == 0)
+    return 0;
+  if (((0x5335FL >> rem % 23) & 1) == 0)
+    return 0;
+  if (((0x30AF3L >> rem % 19) & 1) == 0)
+    return 0;
+  if (((0x1A317L >> rem % 17) & 1) == 0)
+    return 0;
+  if (((0x161BL >> rem % 13) & 1) == 0)
+    return 0;
+  if (((0x23BL >> rem % 11) & 1) == 0)
+    return 0;
+  if (((0x017L >> rem % 7) & 1) == 0)
+    return 0;
+  if (((0x13L >> rem % 5) & 1) == 0)
+    return 0;
+  if (((0x3L >> rem % 3) & 1) == 0)
+    return 0;
+#endif
+
+  TMP_MARK (marker);
+
+  /* For the third and last test, we finally compute the square root,
+     to make sure we've really got a perfect square.  */
+  root_ptr = (mp_ptr) TMP_ALLOC ((usize + 1) / 2 * BYTES_PER_MP_LIMB);
+
+  /* Iff mpn_sqrtrem returns zero, the square is perfect.  */
+  res = ! mpn_sqrtrem (root_ptr, NULL, up, usize);
+  TMP_FREE (marker);
+  return res;
+}
diff --git a/src/gmp/mpn/generic/popcount.c b/src/gmp/mpn/generic/popcount.c
new file mode 100644
index 000000000..387be9536
--- /dev/null
+++ b/src/gmp/mpn/generic/popcount.c
@@ -0,0 +1,93 @@
+/* popcount.c
+
+Copyright (C) 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined __GNUC__
+/* No processor claiming to be SPARC v9 compliant seem to
+   implement the POPC instruction.  Disable pattern for now.  */
+#if 0 && defined __sparc_v9__ && BITS_PER_MP_LIMB == 64
+#define popc_limb(a) \
+  ({									\
+    DItype __res;							\
+    asm ("popc %1,%0" : "=r" (__res) : "rI" (a));			\
+    __res;								\
+  })
+#endif
+#endif
+
+#ifndef popc_limb
+
+/* Cool population count of a mp_limb_t.
+   You have to figure out how this works, I won't tell you!  */
+
+static inline unsigned int
+#if __STDC__
+popc_limb (mp_limb_t x)
+#else
+popc_limb (x)
+     mp_limb_t x;
+#endif
+{
+#if BITS_PER_MP_LIMB == 64
+  /* We have to go into some trouble to define these constants.
+     (For mp_limb_t being `long long'.)  */
+  mp_limb_t cnst;
+  cnst = 0xaaaaaaaaL | ((mp_limb_t) 0xaaaaaaaaL << BITS_PER_MP_LIMB/2);
+  x -= (x & cnst) >> 1;
+  cnst = 0x33333333L | ((mp_limb_t) 0x33333333L << BITS_PER_MP_LIMB/2);
+  x = ((x & ~cnst) >> 2) + (x & cnst);
+  cnst = 0x0f0f0f0fL | ((mp_limb_t) 0x0f0f0f0fL << BITS_PER_MP_LIMB/2);
+  x = ((x >> 4) + x) & cnst;
+  x = ((x >> 8) + x);
+  x = ((x >> 16) + x);
+  x = ((x >> 32) + x) & 0xff;
+#endif
+#if BITS_PER_MP_LIMB == 32
+  x -= (x & 0xaaaaaaaa) >> 1;
+  x = ((x >> 2) & 0x33333333L) + (x & 0x33333333L);
+  x = ((x >> 4) + x) & 0x0f0f0f0fL;
+  x = ((x >> 8) + x);
+  x = ((x >> 16) + x) & 0xff;
+#endif
+  return x;
+}
+#endif
+
+unsigned long int
+#if __STDC__
+mpn_popcount (register mp_srcptr p, register mp_size_t size)
+#else
+mpn_popcount (p, size)
+     register mp_srcptr p;
+     register mp_size_t size;
+#endif
+{
+  unsigned long int popcnt;
+  mp_size_t i;
+
+  popcnt = 0;
+  for (i = 0; i < size; i++)
+    popcnt += popc_limb (p[i]);
+
+  return popcnt;
+}
diff --git a/src/gmp/mpn/generic/pre_mod_1.c b/src/gmp/mpn/generic/pre_mod_1.c
new file mode 100644
index 000000000..27179683b
--- /dev/null
+++ b/src/gmp/mpn/generic/pre_mod_1.c
@@ -0,0 +1,69 @@
+/* mpn_preinv_mod_1 (dividend_ptr, dividend_size, divisor_limb,
+		       divisor_limb_inverted) --
+   Divide (DIVIDEND_PTR,,DIVIDEND_SIZE) by the normalized DIVISOR_LIMB.
+   DIVISOR_LIMB_INVERTED should be 2^(2*BITS_PER_MP_LIMB) / DIVISOR_LIMB +
+   - 2^BITS_PER_MP_LIMB.
+   Return the single-limb remainder.
+
+Copyright (C) 1991, 1993, 1994, Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#ifndef UMUL_TIME
+#define UMUL_TIME 1
+#endif
+
+#ifndef UDIV_TIME
+#define UDIV_TIME UMUL_TIME
+#endif
+
+mp_limb_t
+#if __STDC__
+mpn_preinv_mod_1 (mp_srcptr dividend_ptr, mp_size_t dividend_size,
+		  mp_limb_t divisor_limb, mp_limb_t divisor_limb_inverted)
+#else
+mpn_preinv_mod_1 (dividend_ptr, dividend_size, divisor_limb, divisor_limb_inverted)
+     mp_srcptr dividend_ptr;
+     mp_size_t dividend_size;
+     mp_limb_t divisor_limb;
+     mp_limb_t divisor_limb_inverted;
+#endif
+{
+  mp_size_t i;
+  mp_limb_t n0, r;
+  int dummy;
+
+  i = dividend_size - 1;
+  r = dividend_ptr[i];
+
+  if (r >= divisor_limb)
+    r = 0;
+  else
+    i--;
+
+  for (; i >= 0; i--)
+    {
+      n0 = dividend_ptr[i];
+      udiv_qrnnd_preinv (dummy, r, r, n0, divisor_limb, divisor_limb_inverted);
+    }
+  return r;
+}
diff --git a/src/gmp/mpn/generic/random.c b/src/gmp/mpn/generic/random.c
new file mode 100644
index 000000000..dea4e20e5
--- /dev/null
+++ b/src/gmp/mpn/generic/random.c
@@ -0,0 +1,43 @@
+/* mpn_random -- Generate random numbers.
+
+Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void
+#if __STDC__
+mpn_random (mp_ptr res_ptr, mp_size_t size)
+#else
+mpn_random (res_ptr, size)
+     mp_ptr res_ptr;
+     mp_size_t size;
+#endif
+{
+  mp_size_t i;
+
+  for (i = 0; i < size; i++)
+    res_ptr[i] = urandom ();
+
+  /* Make sure the most significant limb is non-zero.  */
+  while (res_ptr[size - 1] == 0)
+    res_ptr[size - 1] = urandom ();
+}
diff --git a/src/gmp/mpn/generic/random2.c b/src/gmp/mpn/generic/random2.c
new file mode 100644
index 000000000..7a507df11
--- /dev/null
+++ b/src/gmp/mpn/generic/random2.c
@@ -0,0 +1,97 @@
+/* mpn_random2 -- Generate random numbers with relatively long strings
+   of ones and zeroes.  Suitable for border testing.
+
+Copyright (C) 1992, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined (__hpux) || defined (__alpha)  || defined (__svr4__) || defined (__SVR4)
+/* HPUX lacks random().  DEC OSF/1 1.2 random() returns a double.  */
+long mrand48 ();
+static inline long
+random ()
+{
+  return mrand48 ();
+}
+#else
+long random ();
+#endif
+
+/* It's a bit tricky to get this right, so please test the code well
+   if you hack with it.  Some early versions of the function produced
+   random numbers with the leading limb == 0, and some versions never
+   made the most significant bit set.  */
+
+void
+#if __STDC__
+mpn_random2 (mp_ptr res_ptr, mp_size_t size)
+#else
+mpn_random2 (res_ptr, size)
+     mp_ptr res_ptr;
+     mp_size_t size;
+#endif
+{
+  int n_bits;
+  int bit_pos;
+  mp_size_t limb_pos;
+  unsigned int ran;
+  mp_limb_t limb;
+
+  limb = 0;
+
+  /* Start off in a random bit position in the most significant limb.  */
+  bit_pos = random () & (BITS_PER_MP_LIMB - 1);
+
+  /* Least significant bit of RAN chooses string of ones/string of zeroes.
+     Make most significant limb be non-zero by setting bit 0 of RAN.  */
+  ran = random () | 1;
+
+  for (limb_pos = size - 1; limb_pos >= 0; )
+    {
+      n_bits = (ran >> 1) % BITS_PER_MP_LIMB + 1;
+      if ((ran & 1) != 0)
+	{
+	  /* Generate a string of ones.  */
+	  if (n_bits >= bit_pos)
+	    {
+	      res_ptr[limb_pos--] = limb | ((((mp_limb_t) 2) << bit_pos) - 1);
+	      bit_pos += BITS_PER_MP_LIMB;
+	      limb = (~(mp_limb_t) 0) << (bit_pos - n_bits);
+	    }
+	  else
+	    {
+	      limb |= ((((mp_limb_t) 1) << n_bits) - 1) << (bit_pos - n_bits + 1);
+	    }
+	}
+      else
+	{
+	  /* Generate a string of zeroes.  */
+	  if (n_bits >= bit_pos)
+	    {
+	      res_ptr[limb_pos--] = limb;
+	      limb = 0;
+	      bit_pos += BITS_PER_MP_LIMB;
+	    }
+	}
+      bit_pos -= n_bits;
+      ran = random ();
+    }
+}
diff --git a/src/gmp/mpn/generic/rshift.c b/src/gmp/mpn/generic/rshift.c
new file mode 100644
index 000000000..59caf7352
--- /dev/null
+++ b/src/gmp/mpn/generic/rshift.c
@@ -0,0 +1,88 @@
+/* mpn_rshift -- Shift right a low-level natural-number integer.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Shift U (pointed to by UP and USIZE limbs long) CNT bits to the right
+   and store the USIZE least significant limbs of the result at WP.
+   The bits shifted out to the right are returned.
+
+   Argument constraints:
+   1. 0 < CNT < BITS_PER_MP_LIMB
+   2. If the result is to be written over the input, WP must be <= UP.
+*/
+
+mp_limb_t
+#if __STDC__
+mpn_rshift (register mp_ptr wp,
+	    register mp_srcptr up, mp_size_t usize,
+	    register unsigned int cnt)
+#else
+mpn_rshift (wp, up, usize, cnt)
+     register mp_ptr wp;
+     register mp_srcptr up;
+     mp_size_t usize;
+     register unsigned int cnt;
+#endif
+{
+  register mp_limb_t high_limb, low_limb;
+  register unsigned sh_1, sh_2;
+  register mp_size_t i;
+  mp_limb_t retval;
+
+#ifdef DEBUG
+  if (usize == 0 || cnt == 0)
+    abort ();
+#endif
+
+  sh_1 = cnt;
+
+#if 0
+  if (sh_1 == 0)
+    {
+      if (wp != up)
+	{
+	  /* Copy from low end to high end, to allow specified input/output
+	     overlapping.  */
+	  for (i = 0; i < usize; i++)
+	    wp[i] = up[i];
+	}
+      return usize;
+    }
+#endif
+
+  wp -= 1;
+  sh_2 = BITS_PER_MP_LIMB - sh_1;
+  high_limb = up[0];
+  retval = high_limb << sh_2;
+  low_limb = high_limb;
+
+  for (i = 1; i < usize; i++)
+    {
+      high_limb = up[i];
+      wp[i] = (low_limb >> sh_1) | (high_limb << sh_2);
+      low_limb = high_limb;
+    }
+  wp[i] = low_limb >> sh_1;
+
+  return retval;
+}
diff --git a/src/gmp/mpn/generic/sb_divrem_mn.c b/src/gmp/mpn/generic/sb_divrem_mn.c
new file mode 100644
index 000000000..a269e34f5
--- /dev/null
+++ b/src/gmp/mpn/generic/sb_divrem_mn.c
@@ -0,0 +1,201 @@
+/* mpn_sb_divrem_mn -- Divide natural numbers, producing both remainder and
+   quotient.
+
+   THE FUNCTIONS IN THIS FILE ARE INTERNAL FUNCTIONS WITH MUTABLE
+   INTERFACES.  IT IS ONLY SAFE TO REACH THEM THROUGH DOCUMENTED INTERFACES.
+   IN FACT, IT IS ALMOST GUARANTEED THAT THEY'LL CHANGE OR DISAPPEAR IN A
+   FUTURE GNU MP RELEASE.
+
+
+Copyright (C) 1993, 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Divide num (NP/NSIZE) by den (DP/DSIZE) and write
+   the NSIZE-DSIZE least significant quotient limbs at QP
+   and the DSIZE long remainder at NP.  If QEXTRA_LIMBS is
+   non-zero, generate that many fraction bits and append them after the
+   other quotient limbs.
+   Return the most significant limb of the quotient, this is always 0 or 1.
+
+   Preconditions:
+   0. NSIZE >= DSIZE.
+   1. The most significant bit of the divisor must be set.
+   2. QP must either not overlap with the input operands at all, or
+      QP + DSIZE >= NP must hold true.  (This means that it's
+      possible to put the quotient in the high part of NUM, right after the
+      remainder in NUM.
+   3. NSIZE >= DSIZE, even if QEXTRA_LIMBS is non-zero.
+   4. DSIZE >= 2.  */
+
+
+#define PREINVERT_VIABLE \
+  (UDIV_TIME > 2 * UMUL_TIME + 6 /* && ! TARGET_REGISTER_STARVED */)
+
+mp_limb_t
+#if __STDC__
+mpn_sb_divrem_mn (mp_ptr qp,
+	       mp_ptr np, mp_size_t nsize,
+	       mp_srcptr dp, mp_size_t dsize)
+#else
+mpn_sb_divrem_mn (qp, np, nsize, dp, dsize)
+     mp_ptr qp;
+     mp_ptr np;
+     mp_size_t nsize;
+     mp_srcptr dp;
+     mp_size_t dsize;
+#endif
+{
+  mp_limb_t most_significant_q_limb = 0;
+  mp_size_t i;
+  mp_limb_t dx, d1, n0;
+  mp_limb_t dxinv;
+  int have_preinv;
+
+  ASSERT_ALWAYS (dsize > 2);
+
+  np += nsize - dsize;
+  dx = dp[dsize - 1];
+  d1 = dp[dsize - 2];
+  n0 = np[dsize - 1];
+
+  if (n0 >= dx)
+    {
+      if (n0 > dx || mpn_cmp (np, dp, dsize - 1) >= 0)
+	{
+	  mpn_sub_n (np, np, dp, dsize);
+	  most_significant_q_limb = 1;
+	}
+    }
+
+  /* If multiplication is much faster than division, preinvert the
+     most significant divisor limb before entering the loop.  */
+  if (PREINVERT_VIABLE)
+    {
+      have_preinv = 0;
+      if ((UDIV_TIME - (2 * UMUL_TIME + 6)) * (nsize - dsize) > UDIV_TIME)
+	{
+	  invert_limb (dxinv, dx);
+	  have_preinv = 1;
+	}
+    }
+
+  for (i = nsize - dsize - 1; i >= 0; i--)
+    {
+      mp_limb_t q;
+      mp_limb_t nx;
+      mp_limb_t cy_limb;
+
+      nx = np[dsize - 1];
+      np--;
+
+      if (nx == dx)
+	{
+	  /* This might over-estimate q, but it's probably not worth
+	     the extra code here to find out.  */
+	  q = ~(mp_limb_t) 0;
+
+#if 1
+	  cy_limb = mpn_submul_1 (np, dp, dsize, q);
+#else
+	  /* This should be faster on many machines */
+	  cy_limb = mpn_sub_n (np + 1, np + 1, dp, dsize);
+	  cy = mpn_add_n (np, np, dp, dsize);
+	  np[dsize] += cy;
+#endif
+
+	  if (nx != cy_limb)
+	    {
+	      mpn_add_n (np, np, dp, dsize);
+	      q--;
+	    }
+
+	  qp[i] = q;
+	}
+      else
+	{
+	  mp_limb_t rx, r1, r0, p1, p0;
+
+          /* "workaround" avoids a problem with gcc 2.7.2.3 i386 register
+             usage when np[dsize-1] is used in an asm statement like
+             umul_ppmm in udiv_qrnnd_preinv.  The symptom is seg faults due
+             to registers being clobbered.  gcc 2.95 i386 doesn't have the
+             problem. */
+          {
+            mp_limb_t  workaround = np[dsize - 1];
+            if (PREINVERT_VIABLE && have_preinv)
+              udiv_qrnnd_preinv (q, r1, nx, workaround, dx, dxinv);
+            else
+              udiv_qrnnd (q, r1, nx, workaround, dx);
+          }
+	  umul_ppmm (p1, p0, d1, q);
+
+	  r0 = np[dsize - 2];
+	  rx = 0;
+	  if (r1 < p1 || (r1 == p1 && r0 < p0))
+	    {
+	      p1 -= p0 < d1;
+	      p0 -= d1;
+	      q--;
+	      r1 += dx;
+	      rx = r1 < dx;
+	    }
+
+	  p1 += r0 < p0;	/* cannot carry! */
+	  rx -= r1 < p1;	/* may become 11..1 if q is still too large */
+	  r1 -= p1;
+	  r0 -= p0;
+
+	  cy_limb = mpn_submul_1 (np, dp, dsize - 2, q);
+
+	  {
+	    mp_limb_t cy1, cy2;
+	    cy1 = r0 < cy_limb;
+	    r0 -= cy_limb;
+	    cy2 = r1 < cy1;
+	    r1 -= cy1;
+	    np[dsize - 1] = r1;
+	    np[dsize - 2] = r0;
+	    if (cy2 != rx)
+	      {
+		mpn_add_n (np, np, dp, dsize);
+		q--;
+	      }
+	  }
+	  qp[i] = q;
+	}
+    }
+
+  /* ______ ______ ______
+    |__rx__|__r1__|__r0__|		partial remainder
+	    ______ ______
+	 - |__p1__|__p0__|		partial product to subtract
+	    ______ ______
+	 - |______|cylimb|		
+
+     rx is -1, 0 or 1.  If rx=1, then q is correct (it should match
+     carry out).  If rx=-1 then q is too large.  If rx=0, then q might
+     be too large, but it is most likely correct.
+  */
+
+  return most_significant_q_limb;
+}
diff --git a/src/gmp/mpn/generic/scan0.c b/src/gmp/mpn/generic/scan0.c
new file mode 100644
index 000000000..96f05ce85
--- /dev/null
+++ b/src/gmp/mpn/generic/scan0.c
@@ -0,0 +1,62 @@
+/* mpn_scan0 -- Scan from a given bit position for the next clear bit.
+
+Copyright (C) 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Design issues:
+   1. What if starting_bit is not within U?  Caller's problem?
+   2. Bit index should be 'unsigned'?
+
+   Argument constraints:
+   1. U must sooner ot later have a limb with a clear bit.
+ */
+
+unsigned long int
+#if __STDC__
+mpn_scan0 (register mp_srcptr up,
+	   register unsigned long int starting_bit)
+#else
+mpn_scan0 (up, starting_bit)
+     register mp_srcptr up;
+     register unsigned long int starting_bit;
+#endif
+{
+  mp_size_t starting_word;
+  mp_limb_t alimb;
+  int cnt;
+  mp_srcptr p;
+
+  /* Start at the word implied by STARTING_BIT.  */
+  starting_word = starting_bit / BITS_PER_MP_LIMB;
+  p = up + starting_word;
+  alimb = ~*p++;
+
+  /* Mask off any bits before STARTING_BIT in the first limb.  */
+  alimb &= - (mp_limb_t) 1 << (starting_bit % BITS_PER_MP_LIMB);
+
+  while (alimb == 0)
+    alimb = ~*p++;
+
+  count_leading_zeros (cnt, alimb & -alimb);
+  return (p - up) * BITS_PER_MP_LIMB - 1 - cnt;
+}
diff --git a/src/gmp/mpn/generic/scan1.c b/src/gmp/mpn/generic/scan1.c
new file mode 100644
index 000000000..98e2e0dcc
--- /dev/null
+++ b/src/gmp/mpn/generic/scan1.c
@@ -0,0 +1,62 @@
+/* mpn_scan1 -- Scan from a given bit position for the next set bit.
+
+Copyright (C) 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Design issues:
+   1. What if starting_bit is not within U?  Caller's problem?
+   2. Bit index should be 'unsigned'?
+
+   Argument constraints:
+   1. U must sooner ot later have a limb != 0.
+ */
+
+unsigned long int
+#if __STDC__
+mpn_scan1 (register mp_srcptr up,
+	   register unsigned long int starting_bit)
+#else
+mpn_scan1 (up, starting_bit)
+     register mp_srcptr up;
+     register unsigned long int starting_bit;
+#endif
+{
+  mp_size_t starting_word;
+  mp_limb_t alimb;
+  int cnt;
+  mp_srcptr p;
+
+  /* Start at the word implied by STARTING_BIT.  */
+  starting_word = starting_bit / BITS_PER_MP_LIMB;
+  p = up + starting_word;
+  alimb = *p++;
+
+  /* Mask off any bits before STARTING_BIT in the first limb.  */
+  alimb &= - (mp_limb_t) 1 << (starting_bit % BITS_PER_MP_LIMB);
+
+  while (alimb == 0)
+    alimb = *p++;
+
+  count_leading_zeros (cnt, alimb & -alimb);
+  return (p - up) * BITS_PER_MP_LIMB - 1 - cnt;
+}
diff --git a/src/gmp/mpn/generic/set_str.c b/src/gmp/mpn/generic/set_str.c
new file mode 100644
index 000000000..e6ccc9215
--- /dev/null
+++ b/src/gmp/mpn/generic/set_str.c
@@ -0,0 +1,159 @@
+/* mpn_set_str (mp_ptr res_ptr, const char *str, size_t str_len, int base)
+   -- Convert a STR_LEN long base BASE byte string pointed to by STR to a
+   limb vector pointed to by RES_PTR.  Return the number of limbs in
+   RES_PTR.
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_size_t
+#if __STDC__
+mpn_set_str (mp_ptr xp, const unsigned char *str, size_t str_len, int base)
+#else
+mpn_set_str (xp, str, str_len, base)
+     mp_ptr xp;
+     const unsigned char *str;
+     size_t str_len;
+     int base;
+#endif
+{
+  mp_size_t size;
+  mp_limb_t big_base;
+  int indigits_per_limb;
+  mp_limb_t res_digit;
+
+  big_base = __mp_bases[base].big_base;
+  indigits_per_limb = __mp_bases[base].chars_per_limb;
+
+/*   size = str_len / indigits_per_limb + 1;  */
+
+  size = 0;
+
+  if ((base & (base - 1)) == 0)
+    {
+      /* The base is a power of 2.  Read the input string from
+	 least to most significant character/digit.  */
+
+      const unsigned char *s;
+      int next_bitpos;
+      int bits_per_indigit = big_base;
+
+      res_digit = 0;
+      next_bitpos = 0;
+
+      for (s = str + str_len - 1; s >= str; s--)
+	{
+	  int inp_digit = *s;
+
+	  res_digit |= (mp_limb_t) inp_digit << next_bitpos;
+	  next_bitpos += bits_per_indigit;
+	  if (next_bitpos >= BITS_PER_MP_LIMB)
+	    {
+	      xp[size++] = res_digit;
+	      next_bitpos -= BITS_PER_MP_LIMB;
+	      res_digit = inp_digit >> (bits_per_indigit - next_bitpos);
+	    }
+	}
+
+      if (res_digit != 0)
+	xp[size++] = res_digit;
+    }
+  else
+    {
+      /* General case.  The base is not a power of 2.  */
+
+      size_t i;
+      int j;
+      mp_limb_t cy_limb;
+
+      for (i = indigits_per_limb; i < str_len; i += indigits_per_limb)
+	{
+	  res_digit = *str++;
+	  if (base == 10)
+	    { /* This is a common case.
+		 Help the compiler to avoid multiplication.  */
+	      for (j = 1; j < indigits_per_limb; j++)
+		res_digit = res_digit * 10 + *str++;
+	    }
+	  else
+	    {
+	      for (j = 1; j < indigits_per_limb; j++)
+		res_digit = res_digit * base + *str++;
+	    }
+
+	  if (size == 0)
+	    {
+	      if (res_digit != 0)
+		{
+		  xp[0] = res_digit;
+		  size = 1;
+		}
+	    }
+	  else
+	    {
+	      cy_limb = mpn_mul_1 (xp, xp, size, big_base);
+	      cy_limb += mpn_add_1 (xp, xp, size, res_digit);
+	      if (cy_limb != 0)
+		xp[size++] = cy_limb;
+	    }
+	}
+
+      big_base = base;
+      res_digit = *str++;
+      if (base == 10)
+	{ /* This is a common case.
+	     Help the compiler to avoid multiplication.  */
+	  for (j = 1; j < str_len - (i - indigits_per_limb); j++)
+	    {
+	      res_digit = res_digit * 10 + *str++;
+	      big_base *= 10;
+	    }
+	}
+      else
+	{
+	  for (j = 1; j < str_len - (i - indigits_per_limb); j++)
+	    {
+	      res_digit = res_digit * base + *str++;
+	      big_base *= base;
+	    }
+	}
+
+      if (size == 0)
+	{
+	  if (res_digit != 0)
+	    {
+	      xp[0] = res_digit;
+	      size = 1;
+	    }
+	}
+      else
+	{
+	  cy_limb = mpn_mul_1 (xp, xp, size, big_base);
+	  cy_limb += mpn_add_1 (xp, xp, size, res_digit);
+	  if (cy_limb != 0)
+	    xp[size++] = cy_limb;
+	}
+    }
+
+  return size;
+}
diff --git a/src/gmp/mpn/generic/sqr_basecase.c b/src/gmp/mpn/generic/sqr_basecase.c
new file mode 100644
index 000000000..760258a3e
--- /dev/null
+++ b/src/gmp/mpn/generic/sqr_basecase.c
@@ -0,0 +1,83 @@
+/* mpn_sqr_basecase -- Internal routine to square two natural numbers
+   of length m and n.
+
+   THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS ONLY
+   SAFE TO REACH THIS FUNCTION THROUGH DOCUMENTED INTERFACES.
+
+
+Copyright (C) 1991, 1992, 1993, 1994, 1996, 1997, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpn_sqr_basecase (mp_ptr prodp, mp_srcptr up, mp_size_t n)
+#else
+mpn_sqr_basecase (prodp, up, n)
+     mp_ptr prodp;
+     mp_srcptr up;
+     mp_size_t n;
+#endif
+{
+  mp_size_t i;
+
+  {
+    /* N.B.!  We need the superfluous indirection through argh to work around
+       a reloader bug in GCC 2.7.*.  */
+    mp_limb_t x;
+    mp_limb_t argh;
+    x = up[0];
+    umul_ppmm (argh, prodp[0], x, x);
+    prodp[1] = argh;
+  }
+  if (n > 1)
+    {
+      mp_limb_t tarr[2 * KARATSUBA_SQR_THRESHOLD];
+      mp_ptr tp = tarr;
+      mp_limb_t cy;
+
+      /* must fit 2*n limbs in tarr */
+      ASSERT (n <= KARATSUBA_SQR_THRESHOLD);
+
+      cy = mpn_mul_1 (tp, up + 1, n - 1, up[0]);
+      tp[n - 1] = cy;
+      for (i = 2; i < n; i++)
+	{
+	  mp_limb_t cy;
+	  cy = mpn_addmul_1 (tp + 2 * i - 2, up + i, n - i, up[i - 1]);
+	  tp[n + i - 2] = cy;
+	}
+      for (i = 1; i < n; i++)
+	{
+	  mp_limb_t x;
+	  x = up[i];
+	  umul_ppmm (prodp[2 * i + 1], prodp[2 * i], x, x);
+	}
+      {
+	mp_limb_t cy;
+	cy = mpn_lshift (tp, tp, 2 * n - 2, 1);
+	cy += mpn_add_n (prodp + 1, prodp + 1, tp, 2 * n - 2);
+	prodp[2 * n - 1] += cy;
+      }
+    }
+}
diff --git a/src/gmp/mpn/generic/sqrtrem.c b/src/gmp/mpn/generic/sqrtrem.c
new file mode 100644
index 000000000..ee3b5144d
--- /dev/null
+++ b/src/gmp/mpn/generic/sqrtrem.c
@@ -0,0 +1,509 @@
+/* mpn_sqrtrem (root_ptr, rem_ptr, op_ptr, op_size)
+
+   Write the square root of {OP_PTR, OP_SIZE} at ROOT_PTR.
+   Write the remainder at REM_PTR, if REM_PTR != NULL.
+   Return the size of the remainder.
+   (The size of the root is always half of the size of the operand.)
+
+   OP_PTR and ROOT_PTR may not point to the same object.
+   OP_PTR and REM_PTR may point to the same object.
+
+   If REM_PTR is NULL, only the root is computed and the return value of
+   the function is 0 if OP is a perfect square, and *any* non-zero number
+   otherwise.
+
+Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/* This code is just correct if "unsigned char" has at least 8 bits.  It
+   doesn't help to use CHAR_BIT from limits.h, as the real problem is
+   the static arrays.  */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Square root algorithm:
+
+   1. Shift OP (the input) to the left an even number of bits s.t. there
+      are an even number of words and either (or both) of the most
+      significant bits are set.  This way, sqrt(OP) has exactly half as
+      many words as OP, and has its most significant bit set.
+
+   2. Get a 9-bit approximation to sqrt(OP) using the pre-computed tables.
+      This approximation is used for the first single-precision
+      iterations of Newton's method, yielding a full-word approximation
+      to sqrt(OP).
+
+   3. Perform multiple-precision Newton iteration until we have the
+      exact result.  Only about half of the input operand is used in
+      this calculation, as the square root is perfectly determinable
+      from just the higher half of a number.  */
+
+/* Define this macro for IEEE P854 machines with a fast sqrt instruction.  */
+#if defined __GNUC__ && ! defined __SOFT_FLOAT
+
+#if defined (__sparc__) && BITS_PER_MP_LIMB == 32
+#define SQRT(a) \
+  ({									\
+    double __sqrt_res;							\
+    asm ("fsqrtd %1,%0" : "=f" (__sqrt_res) : "f" (a));			\
+    __sqrt_res;								\
+  })
+#endif
+
+#if defined (__HAVE_68881__)
+#define SQRT(a) \
+  ({									\
+    double __sqrt_res;							\
+    asm ("fsqrtx %1,%0" : "=f" (__sqrt_res) : "f" (a));			\
+    __sqrt_res;								\
+  })
+#endif
+
+#if defined (__hppa) && BITS_PER_MP_LIMB == 32
+#define SQRT(a) \
+  ({									\
+    double __sqrt_res;							\
+    asm ("fsqrt,dbl %1,%0" : "=fx" (__sqrt_res) : "fx" (a));		\
+    __sqrt_res;								\
+  })
+#endif
+
+#if defined (_ARCH_PWR2) && BITS_PER_MP_LIMB == 32
+#define SQRT(a) \
+  ({									\
+    double __sqrt_res;							\
+    asm ("fsqrt %0,%1" : "=f" (__sqrt_res) : "f" (a));			\
+    __sqrt_res;								\
+  })
+#endif
+
+#if 0
+#if defined (__i386__) || defined (__i486__)
+#define SQRT(a) \
+  ({									\
+    double __sqrt_res;							\
+    asm ("fsqrt" : "=t" (__sqrt_res) : "0" (a));			\
+    __sqrt_res;								\
+  })
+#endif
+#endif
+
+#endif
+
+#ifndef SQRT
+
+/* Tables for initial approximation of the square root.  These are
+   indexed with bits 1-8 of the operand for which the square root is
+   calculated, where bit 0 is the most significant non-zero bit.  I.e.
+   the most significant one-bit is not used, since that per definition
+   is one.  Likewise, the tables don't return the highest bit of the
+   result.  That bit must be inserted by or:ing the returned value with
+   0x100.  This way, we get a 9-bit approximation from 8-bit tables!  */
+
+/* Table to be used for operands with an even total number of bits.
+   (Exactly as in the decimal system there are similarities between the
+   square root of numbers with the same initial digits and an even
+   difference in the total number of digits.  Consider the square root
+   of 1, 10, 100, 1000, ...)  */
+static const unsigned char even_approx_tab[256] =
+{
+  0x6a, 0x6a, 0x6b, 0x6c, 0x6c, 0x6d, 0x6e, 0x6e,
+  0x6f, 0x70, 0x71, 0x71, 0x72, 0x73, 0x73, 0x74,
+  0x75, 0x75, 0x76, 0x77, 0x77, 0x78, 0x79, 0x79,
+  0x7a, 0x7b, 0x7b, 0x7c, 0x7d, 0x7d, 0x7e, 0x7f,
+  0x80, 0x80, 0x81, 0x81, 0x82, 0x83, 0x83, 0x84,
+  0x85, 0x85, 0x86, 0x87, 0x87, 0x88, 0x89, 0x89,
+  0x8a, 0x8b, 0x8b, 0x8c, 0x8d, 0x8d, 0x8e, 0x8f,
+  0x8f, 0x90, 0x90, 0x91, 0x92, 0x92, 0x93, 0x94,
+  0x94, 0x95, 0x96, 0x96, 0x97, 0x97, 0x98, 0x99,
+  0x99, 0x9a, 0x9b, 0x9b, 0x9c, 0x9c, 0x9d, 0x9e,
+  0x9e, 0x9f, 0xa0, 0xa0, 0xa1, 0xa1, 0xa2, 0xa3,
+  0xa3, 0xa4, 0xa4, 0xa5, 0xa6, 0xa6, 0xa7, 0xa7,
+  0xa8, 0xa9, 0xa9, 0xaa, 0xaa, 0xab, 0xac, 0xac,
+  0xad, 0xad, 0xae, 0xaf, 0xaf, 0xb0, 0xb0, 0xb1,
+  0xb2, 0xb2, 0xb3, 0xb3, 0xb4, 0xb5, 0xb5, 0xb6,
+  0xb6, 0xb7, 0xb7, 0xb8, 0xb9, 0xb9, 0xba, 0xba,
+  0xbb, 0xbb, 0xbc, 0xbd, 0xbd, 0xbe, 0xbe, 0xbf,
+  0xc0, 0xc0, 0xc1, 0xc1, 0xc2, 0xc2, 0xc3, 0xc3,
+  0xc4, 0xc5, 0xc5, 0xc6, 0xc6, 0xc7, 0xc7, 0xc8,
+  0xc9, 0xc9, 0xca, 0xca, 0xcb, 0xcb, 0xcc, 0xcc,
+  0xcd, 0xce, 0xce, 0xcf, 0xcf, 0xd0, 0xd0, 0xd1,
+  0xd1, 0xd2, 0xd3, 0xd3, 0xd4, 0xd4, 0xd5, 0xd5,
+  0xd6, 0xd6, 0xd7, 0xd7, 0xd8, 0xd9, 0xd9, 0xda,
+  0xda, 0xdb, 0xdb, 0xdc, 0xdc, 0xdd, 0xdd, 0xde,
+  0xde, 0xdf, 0xe0, 0xe0, 0xe1, 0xe1, 0xe2, 0xe2,
+  0xe3, 0xe3, 0xe4, 0xe4, 0xe5, 0xe5, 0xe6, 0xe6,
+  0xe7, 0xe7, 0xe8, 0xe8, 0xe9, 0xea, 0xea, 0xeb,
+  0xeb, 0xec, 0xec, 0xed, 0xed, 0xee, 0xee, 0xef,
+  0xef, 0xf0, 0xf0, 0xf1, 0xf1, 0xf2, 0xf2, 0xf3,
+  0xf3, 0xf4, 0xf4, 0xf5, 0xf5, 0xf6, 0xf6, 0xf7,
+  0xf7, 0xf8, 0xf8, 0xf9, 0xf9, 0xfa, 0xfa, 0xfb,
+  0xfb, 0xfc, 0xfc, 0xfd, 0xfd, 0xfe, 0xfe, 0xff,
+};
+
+/* Table to be used for operands with an odd total number of bits.
+   (Further comments before previous table.)  */
+static const unsigned char odd_approx_tab[256] =
+{
+  0x00, 0x00, 0x00, 0x01, 0x01, 0x02, 0x02, 0x03,
+  0x03, 0x04, 0x04, 0x05, 0x05, 0x06, 0x06, 0x07,
+  0x07, 0x08, 0x08, 0x09, 0x09, 0x0a, 0x0a, 0x0b,
+  0x0b, 0x0c, 0x0c, 0x0d, 0x0d, 0x0e, 0x0e, 0x0f,
+  0x0f, 0x10, 0x10, 0x10, 0x11, 0x11, 0x12, 0x12,
+  0x13, 0x13, 0x14, 0x14, 0x15, 0x15, 0x16, 0x16,
+  0x16, 0x17, 0x17, 0x18, 0x18, 0x19, 0x19, 0x1a,
+  0x1a, 0x1b, 0x1b, 0x1b, 0x1c, 0x1c, 0x1d, 0x1d,
+  0x1e, 0x1e, 0x1f, 0x1f, 0x20, 0x20, 0x20, 0x21,
+  0x21, 0x22, 0x22, 0x23, 0x23, 0x23, 0x24, 0x24,
+  0x25, 0x25, 0x26, 0x26, 0x27, 0x27, 0x27, 0x28,
+  0x28, 0x29, 0x29, 0x2a, 0x2a, 0x2a, 0x2b, 0x2b,
+  0x2c, 0x2c, 0x2d, 0x2d, 0x2d, 0x2e, 0x2e, 0x2f,
+  0x2f, 0x30, 0x30, 0x30, 0x31, 0x31, 0x32, 0x32,
+  0x32, 0x33, 0x33, 0x34, 0x34, 0x35, 0x35, 0x35,
+  0x36, 0x36, 0x37, 0x37, 0x37, 0x38, 0x38, 0x39,
+  0x39, 0x39, 0x3a, 0x3a, 0x3b, 0x3b, 0x3b, 0x3c,
+  0x3c, 0x3d, 0x3d, 0x3d, 0x3e, 0x3e, 0x3f, 0x3f,
+  0x40, 0x40, 0x40, 0x41, 0x41, 0x41, 0x42, 0x42,
+  0x43, 0x43, 0x43, 0x44, 0x44, 0x45, 0x45, 0x45,
+  0x46, 0x46, 0x47, 0x47, 0x47, 0x48, 0x48, 0x49,
+  0x49, 0x49, 0x4a, 0x4a, 0x4b, 0x4b, 0x4b, 0x4c,
+  0x4c, 0x4c, 0x4d, 0x4d, 0x4e, 0x4e, 0x4e, 0x4f,
+  0x4f, 0x50, 0x50, 0x50, 0x51, 0x51, 0x51, 0x52,
+  0x52, 0x53, 0x53, 0x53, 0x54, 0x54, 0x54, 0x55,
+  0x55, 0x56, 0x56, 0x56, 0x57, 0x57, 0x57, 0x58,
+  0x58, 0x59, 0x59, 0x59, 0x5a, 0x5a, 0x5a, 0x5b,
+  0x5b, 0x5b, 0x5c, 0x5c, 0x5d, 0x5d, 0x5d, 0x5e,
+  0x5e, 0x5e, 0x5f, 0x5f, 0x60, 0x60, 0x60, 0x61,
+  0x61, 0x61, 0x62, 0x62, 0x62, 0x63, 0x63, 0x63,
+  0x64, 0x64, 0x65, 0x65, 0x65, 0x66, 0x66, 0x66,
+  0x67, 0x67, 0x67, 0x68, 0x68, 0x68, 0x69, 0x69,
+};
+#endif
+
+
+mp_size_t
+#if __STDC__
+mpn_sqrtrem (mp_ptr root_ptr, mp_ptr rem_ptr, mp_srcptr op_ptr, mp_size_t op_size)
+#else
+mpn_sqrtrem (root_ptr, rem_ptr, op_ptr, op_size)
+     mp_ptr root_ptr;
+     mp_ptr rem_ptr;
+     mp_srcptr op_ptr;
+     mp_size_t op_size;
+#endif
+{
+  /* R (root result) */
+  mp_ptr rp;			/* Pointer to least significant word */
+  mp_size_t rsize;		/* The size in words */
+
+  /* T (OP shifted to the left a.k.a. normalized) */
+  mp_ptr tp;			/* Pointer to least significant word */
+  mp_size_t tsize;		/* The size in words */
+  mp_ptr t_end_ptr;		/* Pointer right beyond most sign. word */
+  mp_limb_t t_high0, t_high1;	/* The two most significant words */
+
+  /* TT (temporary for numerator/remainder) */
+  mp_ptr ttp;			/* Pointer to least significant word */
+
+  /* X (temporary for quotient in main loop) */
+  mp_ptr xp;			/* Pointer to least significant word */
+  mp_size_t xsize;		/* The size in words */
+
+  unsigned cnt;
+  mp_limb_t initial_approx;	/* Initially made approximation */
+  mp_size_t tsizes[BITS_PER_MP_LIMB];	/* Successive calculation precisions */
+  mp_size_t tmp;
+  mp_size_t i;
+
+  mp_limb_t cy_limb;
+  TMP_DECL (marker);
+
+  /* If OP is zero, both results are zero.  */
+  if (op_size == 0)
+    return 0;
+
+  count_leading_zeros (cnt, op_ptr[op_size - 1]);
+  tsize = op_size;
+  if ((tsize & 1) != 0)
+    {
+      cnt += BITS_PER_MP_LIMB;
+      tsize++;
+    }
+
+  rsize = tsize / 2;
+  rp = root_ptr;
+
+  TMP_MARK (marker);
+
+  /* Shift OP an even number of bits into T, such that either the most or
+     the second most significant bit is set, and such that the number of
+     words in T becomes even.  This way, the number of words in R=sqrt(OP)
+     is exactly half as many as in OP, and the most significant bit of R
+     is set.
+
+     Also, the initial approximation is simplified by this up-shifted OP.
+
+     Finally, the Newtonian iteration which is the main part of this
+     program performs division by R.  The fast division routine expects
+     the divisor to be "normalized" in exactly the sense of having the
+     most significant bit set.  */
+
+  tp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
+
+  if ((cnt & ~1) % BITS_PER_MP_LIMB != 0)
+    t_high0 = mpn_lshift (tp + cnt / BITS_PER_MP_LIMB, op_ptr, op_size,
+			  (cnt & ~1) % BITS_PER_MP_LIMB);
+  else
+    MPN_COPY (tp + cnt / BITS_PER_MP_LIMB, op_ptr, op_size);
+
+  if (cnt >= BITS_PER_MP_LIMB)
+    tp[0] = 0;
+
+  t_high0 = tp[tsize - 1];
+  t_high1 = tp[tsize - 2];	/* Never stray.  TSIZE is >= 2.  */
+
+/* Is there a fast sqrt instruction defined for this machine?  */
+#ifdef SQRT
+  {
+    initial_approx = SQRT (t_high0 * MP_BASE_AS_DOUBLE + t_high1);
+    /* If t_high0,,t_high1 is big, the result in INITIAL_APPROX might have
+       become incorrect due to overflow in the conversion from double to
+       mp_limb_t above.  It will typically be zero in that case, but might be
+       a small number on some machines.  The most significant bit of
+       INITIAL_APPROX should be set, so that bit is a good overflow
+       indication.  */
+    if ((mp_limb_signed_t) initial_approx >= 0)
+      initial_approx = ~(mp_limb_t)0;
+  }
+#else
+  /* Get a 9 bit approximation from the tables.  The tables expect to
+     be indexed with the 8 high bits right below the highest bit.
+     Also, the highest result bit is not returned by the tables, and
+     must be or:ed into the result.  The scheme gives 9 bits of start
+     approximation with just 256-entry 8 bit tables.  */
+
+  if ((cnt & 1) == 0)
+    {
+      /* The most significant bit of t_high0 is set.  */
+      initial_approx = t_high0 >> (BITS_PER_MP_LIMB - 8 - 1);
+      initial_approx &= 0xff;
+      initial_approx = even_approx_tab[initial_approx];
+    }
+  else
+    {
+      /* The most significant bit of t_high0 is unset,
+	 the second most significant is set.  */
+      initial_approx = t_high0 >> (BITS_PER_MP_LIMB - 8 - 2);
+      initial_approx &= 0xff;
+      initial_approx = odd_approx_tab[initial_approx];
+    }
+  initial_approx |= 0x100;
+  initial_approx <<= BITS_PER_MP_LIMB - 8 - 1;
+
+  /* Perform small precision Newtonian iterations to get a full word
+     approximation.  For small operands, these iterations will do the
+     entire job.  */
+  if (t_high0 == ~(mp_limb_t)0)
+    initial_approx = t_high0;
+  else
+    {
+      mp_limb_t quot;
+
+      if (t_high0 >= initial_approx)
+	initial_approx = t_high0 + 1;
+
+      /* First get about 18 bits with pure C arithmetics.  */
+      quot = t_high0 / (initial_approx >> BITS_PER_MP_LIMB/2) << BITS_PER_MP_LIMB/2;
+      initial_approx = (initial_approx + quot) / 2;
+      initial_approx |= (mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1);
+
+      /* Now get a full word by one (or for > 36 bit machines) several
+	 iterations.  */
+      for (i = 18; i < BITS_PER_MP_LIMB; i <<= 1)
+	{
+	  mp_limb_t ignored_remainder;
+
+	  udiv_qrnnd (quot, ignored_remainder,
+		      t_high0, t_high1, initial_approx);
+	  initial_approx = (initial_approx + quot) / 2;
+	  initial_approx |= (mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1);
+	}
+    }
+#endif
+
+  rp[0] = initial_approx;
+  rsize = 1;
+
+#ifdef SQRT_DEBUG
+	  printf ("\n\nT = ");
+	  mpn_dump (tp, tsize);
+#endif
+
+  if (tsize > 2)
+    {
+      /* Determine the successive precisions to use in the iteration.  We
+	 minimize the precisions, beginning with the highest (i.e. last
+	 iteration) to the lowest (i.e. first iteration).  */
+
+      xp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
+      ttp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
+
+      t_end_ptr = tp + tsize;
+
+      tmp = tsize / 2;
+      for (i = 0;; i++)
+	{
+	  tsize = (tmp + 1) / 2;
+	  if (tmp == tsize)
+	    break;
+	  tsizes[i] = tsize + tmp;
+	  tmp = tsize;
+	}
+
+      /* Main Newton iteration loop.  For big arguments, most of the
+	 time is spent here.  */
+
+      /* It is possible to do a great optimization here.  The successive
+	 divisors in the mpn_divmod call below have more and more leading
+	 words equal to its predecessor.  Therefore the beginning of
+	 each division will repeat the same work as did the last
+	 division.  If we could guarantee that the leading words of two
+	 consecutive divisors are the same (i.e. in this case, a later
+	 divisor has just more digits at the end) it would be a simple
+	 matter of just using the old remainder of the last division in
+	 a subsequent division, to take care of this optimization.  This
+	 idea would surely make a difference even for small arguments.  */
+
+      /* Loop invariants:
+
+	 R <= shiftdown_to_same_size(floor(sqrt(OP))) < R + 1.
+	 X - 1 < shiftdown_to_same_size(floor(sqrt(OP))) <= X.
+	 R <= shiftdown_to_same_size(X).  */
+
+      while (--i >= 0)
+	{
+	  mp_limb_t cy;
+#ifdef SQRT_DEBUG
+	  mp_limb_t old_least_sign_r = rp[0];
+	  mp_size_t old_rsize = rsize;
+
+	  printf ("R = ");
+	  mpn_dump (rp, rsize);
+#endif
+	  tsize = tsizes[i];
+
+	  /* Need to copy the numerator into temporary space, as
+	     mpn_divmod overwrites its numerator argument with the
+	     remainder (which we currently ignore).  */
+	  MPN_COPY (ttp, t_end_ptr - tsize, tsize);
+	  cy = mpn_divmod (xp, ttp, tsize, rp, rsize);
+	  xsize = tsize - rsize;
+
+#ifdef SQRT_DEBUG
+	  printf ("X =%d ", cy);
+	  mpn_dump (xp, xsize);
+#endif
+
+	  /* Add X and R with the most significant limbs aligned,
+	     temporarily ignoring at least one limb at the low end of X.  */
+	  tmp = xsize - rsize;
+	  cy += mpn_add_n (xp + tmp, rp, xp + tmp, rsize);
+
+	  /* If T begins with more than 2 x BITS_PER_MP_LIMB of ones, we get
+	     intermediate roots that'd need an extra bit.  We don't want to
+	     handle that since it would make the subsequent divisor
+	     non-normalized, so round such roots down to be only ones in the
+	     current precision.  */
+	  if (cy == 2)
+	    {
+	      mp_size_t j;
+	      for (j = xsize; j >= 0; j--)
+		xp[j] = ~(mp_limb_t)0;
+	    }
+
+	  /* Divide X by 2 and put the result in R.  This is the new
+	     approximation.  Shift in the carry from the addition.  */
+	  mpn_rshift (rp, xp, xsize, 1);
+	  rp[xsize - 1] |= ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1));
+	  rsize = xsize;
+#ifdef SQRT_DEBUG
+	  if (old_least_sign_r != rp[rsize - old_rsize])
+	    printf (">>>>>>>> %d: %0*lX, %0*lX <<<<<<<<\n",
+		    i, 2 * BYTES_PER_MP_LIMB, old_least_sign_r,
+		    2 * BYTES_PER_MP_LIMB, rp[rsize - old_rsize]);
+#endif
+	}
+    }
+
+#ifdef SQRT_DEBUG
+  printf ("(final) R = ");
+  mpn_dump (rp, rsize);
+#endif
+
+  /* We computed the square root of OP * 2**(2*floor(cnt/2)).
+     This has resulted in R being 2**floor(cnt/2) to large.
+     Shift it down here to fix that.  */
+  if (cnt / 2 != 0)
+    {
+      mpn_rshift (rp, rp, rsize, cnt/2);
+      rsize -= rp[rsize - 1] == 0;
+    }
+
+  /* Calculate the remainder.  */
+  mpn_mul_n (tp, rp, rp, rsize);
+  tsize = rsize + rsize;
+  tsize -= tp[tsize - 1] == 0;
+  if (op_size < tsize
+      || (op_size == tsize && mpn_cmp (op_ptr, tp, op_size) < 0))
+    {
+      /* R is too large.  Decrement it.  */
+
+      /* These operations can't overflow.  */
+      cy_limb  = mpn_sub_n (tp, tp, rp, rsize);
+      cy_limb += mpn_sub_n (tp, tp, rp, rsize);
+      mpn_decr_u (tp + rsize, cy_limb);
+      mpn_incr_u (tp, (mp_limb_t) 1);
+
+      mpn_decr_u (rp, (mp_limb_t) 1);
+
+#ifdef SQRT_DEBUG
+      printf ("(adjusted) R = ");
+      mpn_dump (rp, rsize);
+#endif
+    }
+
+  if (rem_ptr != NULL)
+    {
+      cy_limb = mpn_sub (rem_ptr, op_ptr, op_size, tp, tsize);
+      MPN_NORMALIZE (rem_ptr, op_size);
+      TMP_FREE (marker);
+      return op_size;
+    }
+  else
+    {
+      int res;
+      res = op_size != tsize || mpn_cmp (op_ptr, tp, op_size);
+      TMP_FREE (marker);
+      return res;
+    }
+}
diff --git a/src/gmp/mpn/generic/sub_n.c b/src/gmp/mpn/generic/sub_n.c
new file mode 100644
index 000000000..4f2f06099
--- /dev/null
+++ b/src/gmp/mpn/generic/sub_n.c
@@ -0,0 +1,62 @@
+/* mpn_sub_n -- Subtract two limb vectors of equal, non-zero length.
+
+Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+#if __STDC__
+mpn_sub_n (mp_ptr res_ptr, mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
+#else
+mpn_sub_n (res_ptr, s1_ptr, s2_ptr, size)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_srcptr s2_ptr;
+     mp_size_t size;
+#endif
+{
+  register mp_limb_t x, y, cy;
+  register mp_size_t j;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  s1_ptr -= j;
+  s2_ptr -= j;
+  res_ptr -= j;
+
+  cy = 0;
+  do
+    {
+      y = s2_ptr[j];
+      x = s1_ptr[j];
+      y += cy;			/* add previous carry to subtrahend */
+      cy = (y < cy);		/* get out carry from that addition */
+      y = x - y;		/* main subtract */
+      cy = (y > x) + cy;	/* get out carry from the subtract, combine */
+      res_ptr[j] = y;
+    }
+  while (++j != 0);
+
+  return cy;
+}
diff --git a/src/gmp/mpn/generic/submul_1.c b/src/gmp/mpn/generic/submul_1.c
new file mode 100644
index 000000000..c7c08ee4a
--- /dev/null
+++ b/src/gmp/mpn/generic/submul_1.c
@@ -0,0 +1,65 @@
+/* mpn_submul_1 -- multiply the S1_SIZE long limb vector pointed to by S1_PTR
+   by S2_LIMB, subtract the S1_SIZE least significant limbs of the product
+   from the limb vector pointed to by RES_PTR.  Return the most significant
+   limb of the product, adjusted for carry-out from the subtraction.
+
+Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+mp_limb_t
+mpn_submul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     mp_size_t s1_size;
+     register mp_limb_t s2_limb;
+{
+  register mp_limb_t cy_limb;
+  register mp_size_t j;
+  register mp_limb_t prod_high, prod_low;
+  register mp_limb_t x;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -s1_size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  res_ptr -= j;
+  s1_ptr -= j;
+
+  cy_limb = 0;
+  do
+    {
+      umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
+
+      prod_low += cy_limb;
+      cy_limb = (prod_low < cy_limb) + prod_high;
+
+      x = res_ptr[j];
+      prod_low = x - prod_low;
+      cy_limb += (prod_low > x);
+      res_ptr[j] = prod_low;
+    }
+  while (++j != 0);
+
+  return cy_limb;
+}
diff --git a/src/gmp/mpn/generic/tdiv_qr.c b/src/gmp/mpn/generic/tdiv_qr.c
new file mode 100644
index 000000000..b748b5d81
--- /dev/null
+++ b/src/gmp/mpn/generic/tdiv_qr.c
@@ -0,0 +1,401 @@
+/* mpn_tdiv_qr -- Divide the numerator (np,nn) by the denominator (dp,dn) and
+   write the nn-dn+1 quotient limbs at qp and the dn remainder limbs at rp.  If
+   qxn is non-zero, generate that many fraction limbs and append them after the
+   other quotient limbs, and update the remainder accordningly.  The input
+   operands are unaffected.
+
+   Preconditions:
+   1. The most significant limb of of the divisor must be non-zero.
+   2. No argument overlap is permitted.  (??? relax this ???)
+   3. nn >= dn, even if qxn is non-zero.  (??? relax this ???)
+
+   The time complexity of this is O(qn*qn+M(dn,qn)), where M(m,n) is the time
+   complexity of multiplication.
+
+Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD (7 * KARATSUBA_MUL_THRESHOLD)
+#endif
+
+/* Extract the middle limb from ((h,,l) << cnt) */
+#define SHL(h,l,cnt) \
+  ((h << cnt) | ((l >> 1) >> ((~cnt) & (BITS_PER_MP_LIMB - 1))))
+
+void
+#if __STDC__
+mpn_tdiv_qr (mp_ptr qp, mp_ptr rp, mp_size_t qxn,
+	     mp_srcptr np, mp_size_t nn, mp_srcptr dp, mp_size_t dn)
+#else
+mpn_tdiv_qr (qp, rp, qxn, np, nn, dp, dn)
+     mp_ptr qp;
+     mp_ptr rp;
+     mp_size_t qxn;
+     mp_srcptr np;
+     mp_size_t nn;
+     mp_srcptr dp;
+     mp_size_t dn;
+#endif
+{
+  /* FIXME:
+     1. qxn
+     2. pass allocated storage in additional parameter?
+  */
+  if (qxn != 0)
+    abort ();
+
+  switch (dn)
+    {
+    case 0:
+      DIVIDE_BY_ZERO;
+
+    case 1:
+      {
+	rp[0] = mpn_divmod_1 (qp, np, nn, dp[0]);
+	return;
+      }
+
+    case 2:
+      {
+	int cnt;
+	mp_ptr n2p, d2p;
+	mp_limb_t qhl, cy;
+	TMP_DECL (marker);
+	TMP_MARK (marker);
+	count_leading_zeros (cnt, dp[dn - 1]);
+	if (cnt != 0)
+	  {
+	    d2p = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
+	    mpn_lshift (d2p, dp, dn, cnt);
+	    n2p = (mp_ptr) TMP_ALLOC ((nn + 1) * BYTES_PER_MP_LIMB);
+	    cy = mpn_lshift (n2p, np, nn, cnt);
+	    n2p[nn] = cy;
+	    qhl = mpn_divrem_2 (qp, 0L, n2p, nn + (cy != 0), d2p);
+	    if (cy == 0)
+	      qp[nn - 2] = qhl;	/* always store nn-dn+1 quotient limbs */
+	  }
+	else
+	  {
+	    d2p = (mp_ptr) dp;
+	    n2p = (mp_ptr) TMP_ALLOC (nn * BYTES_PER_MP_LIMB);
+	    MPN_COPY (n2p, np, nn);
+	    qhl = mpn_divrem_2 (qp, 0L, n2p, nn, d2p);
+	    qp[nn - 2] = qhl;	/* always store nn-dn+1 quotient limbs */
+	  }
+
+	if (cnt != 0)
+	  mpn_rshift (rp, n2p, dn, cnt);
+	else
+	  MPN_COPY (rp, n2p, dn);
+	TMP_FREE (marker);
+	return;
+      }
+
+    default:
+      {
+	int adjust;
+	TMP_DECL (marker);
+	TMP_MARK (marker);
+	adjust = np[nn - 1] >= dp[dn - 1];	/* conservative tests for quotient size */
+	if (nn + adjust >= 2 * dn)
+	  {
+	    mp_ptr n2p, d2p;
+	    mp_limb_t cy;
+	    int cnt;
+	    count_leading_zeros (cnt, dp[dn - 1]);
+
+	    qp[nn - dn] = 0;			/* zero high quotient limb */
+	    if (cnt != 0)			/* normalize divisor if needed */
+	      {
+		d2p = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
+		mpn_lshift (d2p, dp, dn, cnt);
+		n2p = (mp_ptr) TMP_ALLOC ((nn + 1) * BYTES_PER_MP_LIMB);
+		cy = mpn_lshift (n2p, np, nn, cnt);
+		n2p[nn] = cy;
+		nn += adjust;
+	      }
+	    else
+	      {
+		d2p = (mp_ptr) dp;
+		n2p = (mp_ptr) TMP_ALLOC ((nn + 1) * BYTES_PER_MP_LIMB);
+		MPN_COPY (n2p, np, nn);
+		n2p[nn] = 0;
+		nn += adjust;
+	      }
+
+	    if (dn == 2)
+	      mpn_divrem_2 (qp, 0L, n2p, nn, d2p);
+	    else if (dn < BZ_THRESHOLD)
+	      mpn_sb_divrem_mn (qp, n2p, nn, d2p, dn);
+	    else
+	      {
+		/* Perform 2*dn / dn limb divisions as long as the limbs
+		   in np last.  */
+		mp_ptr q2p = qp + nn - 2 * dn;
+		n2p += nn - 2 * dn;
+		mpn_bz_divrem_n (q2p, n2p, d2p, dn);
+		nn -= dn;
+		while (nn >= 2 * dn)
+		  {
+		    mp_limb_t c;
+		    q2p -= dn;  n2p -= dn;
+		    c = mpn_bz_divrem_n (q2p, n2p, d2p, dn);
+		    ASSERT_ALWAYS (c == 0);
+		    nn -= dn;
+		  }
+
+		if (nn != dn)
+		  {
+		    n2p -= nn - dn;
+		    /* In theory, we could fall out to the cute code below
+		       since we now have exactly the situation that code
+		       is designed to handle.  We botch this badly and call
+		       the basic mpn_sb_divrem_mn!  */
+		    if (dn == 2)
+		      mpn_divrem_2 (qp, 0L, n2p, nn, d2p);
+		    else
+		      mpn_sb_divrem_mn (qp, n2p, nn, d2p, dn);
+		  }
+	      }
+
+
+	    if (cnt != 0)
+	      mpn_rshift (rp, n2p, dn, cnt);
+	    else
+	      MPN_COPY (rp, n2p, dn);
+	    TMP_FREE (marker);
+	    return;
+	  }
+
+	/* When we come here, the numerator/partial remainder is less
+	   than twice the size of the denominator.  */
+
+	  {
+	    /* Problem:
+
+	       Divide a numerator N with nn limbs by a denominator D with dn
+	       limbs forming a quotient of nn-dn+1 limbs.  When qn is small
+	       compared to dn, conventional division algorithms perform poorly.
+	       We want an algorithm that has an expected running time that is
+	       dependent only on qn.  It is assumed that the most significant
+	       limb of the numerator is smaller than the most significant limb
+	       of the denominator.
+
+	       Algorithm (very informally stated):
+
+	       1) Divide the 2 x qn most significant limbs from the numerator
+		  by the qn most significant limbs from the denominator.  Call
+		  the result qest.  This is either the correct quotient, but
+		  might be 1 or 2 too large.  Compute the remainder from the
+		  division.  (This step is implemented by a mpn_divrem call.)
+
+	       2) Is the most significant limb from the remainder < p, where p
+		  is the product of the most significant limb from the quotient
+		  and the next(d).  (Next(d) denotes the next ignored limb from
+		  the denominator.)  If it is, decrement qest, and adjust the
+		  remainder accordingly.
+
+	       3) Is the remainder >= qest?  If it is, qest is the desired
+		  quotient.  The algorithm terminates.
+
+	       4) Subtract qest x next(d) from the remainder.  If there is
+		  borrow out, decrement qest, and adjust the remainder
+		  accordingly.
+
+	       5) Skip one word from the denominator (i.e., let next(d) denote
+		  the next less significant limb.  */
+
+	    mp_size_t qn;
+	    mp_ptr n2p, d2p;
+	    mp_ptr tp;
+	    mp_limb_t cy;
+	    mp_size_t in, rn;
+	    mp_limb_t quotient_too_large;
+	    int cnt;
+
+	    qn = nn - dn;
+	    qp[qn] = 0;				/* zero high quotient limb */
+	    qn += adjust;			/* qn cannot become bigger */
+
+	    if (qn == 0)
+	      {
+		MPN_COPY (rp, np, dn);
+		TMP_FREE (marker);
+		return;
+	      }
+
+	    in = dn - qn;		/* (at least partially) ignored # of limbs in ops */
+	    /* Normalize denominator by shifting it to the left such that its
+	       most significant bit is set.  Then shift the numerator the same
+	       amount, to mathematically preserve quotient.  */
+	    count_leading_zeros (cnt, dp[dn - 1]);
+	    if (cnt != 0)
+	      {
+		d2p = (mp_ptr) TMP_ALLOC (qn * BYTES_PER_MP_LIMB);
+
+		mpn_lshift (d2p, dp + in, qn, cnt);
+		d2p[0] |= dp[in - 1] >> (BITS_PER_MP_LIMB - cnt);
+
+		n2p = (mp_ptr) TMP_ALLOC ((2 * qn + 1) * BYTES_PER_MP_LIMB);
+		cy = mpn_lshift (n2p, np + nn - 2 * qn, 2 * qn, cnt);
+		if (adjust)
+		  {
+		    n2p[2 * qn] = cy;
+		    n2p++;
+		  }
+		else
+		  {
+		    n2p[0] |= np[nn - 2 * qn - 1] >> (BITS_PER_MP_LIMB - cnt);
+		  }
+	      }
+	    else
+	      {
+		d2p = (mp_ptr) dp + in;
+
+		n2p = (mp_ptr) TMP_ALLOC ((2 * qn + 1) * BYTES_PER_MP_LIMB);
+		MPN_COPY (n2p, np + nn - 2 * qn, 2 * qn);
+		if (adjust)
+		  {
+		    n2p[2 * qn] = 0;
+		    n2p++;
+		  }
+	      }
+
+	    /* Get an approximate quotient using the extracted operands.  */
+	    if (qn == 1)
+	      {
+		mp_limb_t q0, r0;
+		mp_limb_t gcc272bug_n1, gcc272bug_n0, gcc272bug_d0;
+		/* Due to a gcc 2.7.2.3 reload pass bug, we have to use some
+		   temps here.  This doesn't hurt code quality on any machines
+		   so we do it unconditionally.  */
+		gcc272bug_n1 = n2p[1];
+		gcc272bug_n0 = n2p[0];
+		gcc272bug_d0 = d2p[0];
+		udiv_qrnnd (q0, r0, gcc272bug_n1, gcc272bug_n0, gcc272bug_d0);
+		n2p[0] = r0;
+		qp[0] = q0;
+	      }
+	    else if (qn == 2)
+	      mpn_divrem_2 (qp, 0L, n2p, 4L, d2p);
+	    else if (qn < BZ_THRESHOLD)
+	      mpn_sb_divrem_mn (qp, n2p, qn * 2, d2p, qn);
+	    else
+	      mpn_bz_divrem_n (qp, n2p, d2p, qn);
+
+	    rn = qn;
+	    /* Multiply the first ignored divisor limb by the most significant
+	       quotient limb.  If that product is > the partial remainder's
+	       most significant limb, we know the quotient is too large.  This
+	       test quickly catches most cases where the quotient is too large;
+	       it catches all cases where the quotient is 2 too large.  */
+	    {
+	      mp_limb_t dl, x;
+	      mp_limb_t h, l;
+
+	      if (in - 2 < 0)
+		dl = 0;
+	      else
+		dl = dp[in - 2];
+
+	      x = SHL (dp[in - 1], dl, cnt);
+	      umul_ppmm (h, l, x, qp[qn - 1]);
+
+	      if (n2p[qn - 1] < h)
+		{
+		  mp_limb_t cy;
+
+		  mpn_decr_u (qp, (mp_limb_t) 1);
+		  cy = mpn_add_n (n2p, n2p, d2p, qn);
+		  if (cy)
+		    {
+		      /* The partial remainder is safely large.  */
+		      n2p[qn] = cy;
+		      ++rn;
+		    }
+		}
+	    }
+
+	    quotient_too_large = 0;
+	    if (cnt != 0)
+	      {
+		mp_limb_t cy1, cy2;
+
+		/* Append partially used numerator limb to partial remainder.  */
+		cy1 = mpn_lshift (n2p, n2p, rn, BITS_PER_MP_LIMB - cnt);
+		n2p[0] |= np[in - 1] & (~(mp_limb_t) 0 >> cnt);
+
+		/* Update partial remainder with partially used divisor limb.  */
+		cy2 = mpn_submul_1 (n2p, qp, qn, dp[in - 1] & (~(mp_limb_t) 0 >> cnt));
+		if (qn != rn)
+		  {
+		    if (n2p[qn] < cy2)
+		      abort ();
+		    n2p[qn] -= cy2;
+		  }
+		else
+		  {
+		    n2p[qn] = cy1 - cy2;
+
+		    quotient_too_large = (cy1 < cy2);
+		    ++rn;
+		  }
+		--in;
+	      }
+	    /* True: partial remainder now is neutral, i.e., it is not shifted up.  */
+
+	    tp = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
+
+	    if (in < qn)
+	      {
+		if (in == 0)
+		  {
+		    MPN_COPY (rp, n2p, rn);
+		    if (rn != dn)
+		      abort ();
+		    goto foo;
+		  }
+		mpn_mul (tp, qp, qn, dp, in);
+	      }
+	    else
+	      mpn_mul (tp, dp, in, qp, qn);
+
+	    cy = mpn_sub (n2p, n2p, rn, tp + in, qn);
+	    MPN_COPY (rp + in, n2p, dn - in);
+	    quotient_too_large |= cy;
+	    cy = mpn_sub_n (rp, np, tp, in);
+	    cy = mpn_sub_1 (rp + in, rp + in, rn, cy);
+	    quotient_too_large |= cy;
+	  foo:
+	    if (quotient_too_large)
+	      {
+		mpn_decr_u (qp, (mp_limb_t) 1);
+		mpn_add_n (rp, rp, dp, dn);
+	      }
+	  }
+	TMP_FREE (marker);
+	return;
+      }
+    }
+}
diff --git a/src/gmp/mpn/generic/udiv_w_sdiv.c b/src/gmp/mpn/generic/udiv_w_sdiv.c
new file mode 100644
index 000000000..061cce86e
--- /dev/null
+++ b/src/gmp/mpn/generic/udiv_w_sdiv.c
@@ -0,0 +1,131 @@
+/* mpn_udiv_w_sdiv -- implement udiv_qrnnd on machines with only signed
+   division.
+
+   Contributed by Peter L. Montgomery.
+
+   THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS ONLY SAFE
+   TO REACH THIS FUNCTION THROUGH DOCUMENTED INTERFACES.  IN FACT, IT IS
+   ALMOST GUARANTEED THAT THIS FUNCTION WILL CHANGE OR DISAPPEAR IN A FUTURE
+   GNU MP RELEASE.
+
+
+Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+mp_limb_t
+mpn_udiv_w_sdiv (rp, a1, a0, d)
+     mp_limb_t *rp, a1, a0, d;
+{
+  mp_limb_t q, r;
+  mp_limb_t c0, c1, b1;
+
+  if ((mp_limb_signed_t) d >= 0)
+    {
+      if (a1 < d - a1 - (a0 >> (BITS_PER_MP_LIMB - 1)))
+	{
+	  /* dividend, divisor, and quotient are nonnegative */
+	  sdiv_qrnnd (q, r, a1, a0, d);
+	}
+      else
+	{
+	  /* Compute c1*2^32 + c0 = a1*2^32 + a0 - 2^31*d */
+	  sub_ddmmss (c1, c0, a1, a0, d >> 1, d << (BITS_PER_MP_LIMB - 1));
+	  /* Divide (c1*2^32 + c0) by d */
+	  sdiv_qrnnd (q, r, c1, c0, d);
+	  /* Add 2^31 to quotient */
+	  q += (mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1);
+	}
+    }
+  else
+    {
+      b1 = d >> 1;			/* d/2, between 2^30 and 2^31 - 1 */
+      c1 = a1 >> 1;			/* A/2 */
+      c0 = (a1 << (BITS_PER_MP_LIMB - 1)) + (a0 >> 1);
+
+      if (a1 < b1)			/* A < 2^32*b1, so A/2 < 2^31*b1 */
+	{
+	  sdiv_qrnnd (q, r, c1, c0, b1); /* (A/2) / (d/2) */
+
+	  r = 2*r + (a0 & 1);		/* Remainder from A/(2*b1) */
+	  if ((d & 1) != 0)
+	    {
+	      if (r >= q)
+		r = r - q;
+	      else if (q - r <= d)
+		{
+		  r = r - q + d;
+		  q--;
+		}
+	      else
+		{
+		  r = r - q + 2*d;
+		  q -= 2;
+		}
+	    }
+	}
+      else if (c1 < b1)			/* So 2^31 <= (A/2)/b1 < 2^32 */
+	{
+	  c1 = (b1 - 1) - c1;
+	  c0 = ~c0;			/* logical NOT */
+
+	  sdiv_qrnnd (q, r, c1, c0, b1); /* (A/2) / (d/2) */
+
+	  q = ~q;			/* (A/2)/b1 */
+	  r = (b1 - 1) - r;
+
+	  r = 2*r + (a0 & 1);		/* A/(2*b1) */
+
+	  if ((d & 1) != 0)
+	    {
+	      if (r >= q)
+		r = r - q;
+	      else if (q - r <= d)
+		{
+		  r = r - q + d;
+		  q--;
+		}
+	      else
+		{
+		  r = r - q + 2*d;
+		  q -= 2;
+		}
+	    }
+	}
+      else				/* Implies c1 = b1 */
+	{				/* Hence a1 = d - 1 = 2*b1 - 1 */
+	  if (a0 >= -d)
+	    {
+	      q = -1;
+	      r = a0 + d;
+	    }
+	  else
+	    {
+	      q = -2;
+	      r = a0 + 2*d;
+	    }
+	}
+    }
+
+  *rp = r;
+  return q;
+}
diff --git a/src/gmp/mpn/hppa/README b/src/gmp/mpn/hppa/README
new file mode 100644
index 000000000..97e7abe01
--- /dev/null
+++ b/src/gmp/mpn/hppa/README
@@ -0,0 +1,91 @@
+This directory contains mpn functions for various HP PA-RISC chips.  Code
+that runs faster on the PA7100 and later implementations, is in the pa7100
+directory.
+
+RELEVANT OPTIMIZATION ISSUES
+
+  Load and Store timing
+
+On the PA7000 no memory instructions can issue the two cycles after a store.
+For the PA7100, this is reduced to one cycle.
+
+The PA7100 has a lookup-free cache, so it helps to schedule loads and the
+dependent instruction really far from each other.
+
+STATUS
+
+1. mpn_mul_1 could be improved to 6.5 cycles/limb on the PA7100, using the
+   instructions below (but some sw pipelining is needed to avoid the
+   xmpyu-fstds delay):
+
+	fldds	s1_ptr
+
+	xmpyu
+	fstds	N(%r30)
+	xmpyu
+	fstds	N(%r30)
+
+	ldws	N(%r30)
+	ldws	N(%r30)
+	ldws	N(%r30)
+	ldws	N(%r30)
+
+	addc
+	stws	res_ptr
+	addc
+	stws	res_ptr
+
+	addib	Loop
+
+2. mpn_addmul_1 could be improved from the current 10 to 7.5 cycles/limb
+   (asymptotically) on the PA7100, using the instructions below.  With proper
+   sw pipelining and the unrolling level below, the speed becomes 8
+   cycles/limb.
+
+	fldds	s1_ptr
+	fldds	s1_ptr
+
+	xmpyu
+	fstds	N(%r30)
+	xmpyu
+	fstds	N(%r30)
+	xmpyu
+	fstds	N(%r30)
+	xmpyu
+	fstds	N(%r30)
+
+	ldws	N(%r30)
+	ldws	N(%r30)
+	ldws	N(%r30)
+	ldws	N(%r30)
+	ldws	N(%r30)
+	ldws	N(%r30)
+	ldws	N(%r30)
+	ldws	N(%r30)
+	addc
+	addc
+	addc
+	addc
+	addc	%r0,%r0,cy-limb
+
+	ldws	res_ptr
+	ldws	res_ptr
+	ldws	res_ptr
+	ldws	res_ptr
+	add
+	stws	res_ptr
+	addc
+	stws	res_ptr
+	addc
+	stws	res_ptr
+	addc
+	stws	res_ptr
+
+	addib
+
+3. For the PA8000 we have to stick to using 32-bit limbs before compiler
+   support emerges.  But we want to use 64-bit operations whenever possible,
+   in particular for loads and stores.  It is possible to handle mpn_add_n
+   efficiently by rotating (when s1/s2 are aligned), masking+bit field
+   inserting when (they are not).  The speed should double compared to the
+   code used today.
diff --git a/src/gmp/mpn/hppa/add_n.s b/src/gmp/mpn/hppa/add_n.s
new file mode 100644
index 000000000..c53b2f71b
--- /dev/null
+++ b/src/gmp/mpn/hppa/add_n.s
@@ -0,0 +1,58 @@
+; HP-PA  __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+; sum in a third limb vector.
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+; One might want to unroll this as for other processors, but it turns
+; out that the data cache contention after a store makes such
+; unrolling useless.  We can't come under 5 cycles/limb anyway.
+
+	.code
+	.export		__gmpn_add_n
+__gmpn_add_n
+	.proc
+	.callinfo	frame=0,no_calls
+	.entry
+
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+
+	addib,=		-1,%r23,L$end	; check for (SIZE == 1)
+	 add		%r20,%r19,%r28	; add first limbs ignoring cy
+
+L$loop	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	addib,<>	-1,%r23,L$loop
+	 addc		%r20,%r19,%r28
+
+L$end	stws		%r28,0(0,%r26)
+	bv		0(%r2)
+	 addc		%r0,%r0,%r28
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/gmp-mparam.h b/src/gmp/mpn/hppa/gmp-mparam.h
new file mode 100644
index 000000000..98b6d9ce3
--- /dev/null
+++ b/src/gmp/mpn/hppa/gmp-mparam.h
@@ -0,0 +1,63 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+/* These values are for the PA7100 using GCC.  */
+/* Generated by tuneup.c, 2000-07-25. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   30
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD      172
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   59
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD      185
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              96
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD            122
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            18
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD       46
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD          33
+#endif
diff --git a/src/gmp/mpn/hppa/hppa1_1/addmul_1.s b/src/gmp/mpn/hppa/hppa1_1/addmul_1.s
new file mode 100644
index 000000000..c7d218f92
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/addmul_1.s
@@ -0,0 +1,102 @@
+; HP-PA-1.1 __gmpn_addmul_1 -- Multiply a limb vector with a limb and
+; add the result to a second limb vector.
+
+; Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	r26
+; s1_ptr	r25
+; size		r24
+; s2_limb	r23
+
+; This runs at 11 cycles/limb on a PA7000.  With the used instructions, it
+; can not become faster due to data cache contention after a store.  On the
+; PA7100 it runs at 10 cycles/limb, and that can not be improved either,
+; since only the xmpyu does not need the integer pipeline, so the only
+; dual-issue we will get are addc+xmpyu.  Unrolling could gain a cycle/limb
+; on the PA7100.
+
+; There are some ideas described in mul_1.s that applies to this code too.
+
+	.code
+	.export		__gmpn_addmul_1
+__gmpn_addmul_1
+	.proc
+	.callinfo	frame=64,no_calls
+	.entry
+
+	ldo		64(%r30),%r30
+	fldws,ma	4(%r25),%fr5
+	stw		%r23,-16(%r30)		; move s2_limb ...
+	addib,=		-1,%r24,L$just_one_limb
+	 fldws		-16(%r30),%fr4		; ... into fr4
+	add		%r0,%r0,%r0		; clear carry
+	xmpyu		%fr4,%fr5,%fr6
+	fldws,ma	4(%r25),%fr7
+	fstds		%fr6,-16(%r30)
+	xmpyu		%fr4,%fr7,%fr8
+	ldw		-12(%r30),%r19		; least significant limb in product
+	ldw		-16(%r30),%r28
+
+	fstds		%fr8,-16(%r30)
+	addib,=		-1,%r24,L$end
+	 ldw		-12(%r30),%r1
+
+; Main loop
+L$loop	ldws		0(%r26),%r29
+	fldws,ma	4(%r25),%fr5
+	add		%r29,%r19,%r19
+	stws,ma		%r19,4(%r26)
+	addc		%r28,%r1,%r19
+	xmpyu		%fr4,%fr5,%fr6
+	ldw		-16(%r30),%r28
+	fstds		%fr6,-16(%r30)
+	addc		%r0,%r28,%r28
+	addib,<>	-1,%r24,L$loop
+	 ldw		-12(%r30),%r1
+
+L$end	ldw		0(%r26),%r29
+	add		%r29,%r19,%r19
+	stws,ma		%r19,4(%r26)
+	addc		%r28,%r1,%r19
+	ldw		-16(%r30),%r28
+	ldws		0(%r26),%r29
+	addc		%r0,%r28,%r28
+	add		%r29,%r19,%r19
+	stws,ma		%r19,4(%r26)
+	addc		%r0,%r28,%r28
+	bv		0(%r2)
+	 ldo		-64(%r30),%r30
+
+L$just_one_limb
+	xmpyu		%fr4,%fr5,%fr6
+	ldw		0(%r26),%r29
+	fstds		%fr6,-16(%r30)
+	ldw		-12(%r30),%r1
+	ldw		-16(%r30),%r28
+	add		%r29,%r1,%r19
+	stw		%r19,0(%r26)
+	addc		%r0,%r28,%r28
+	bv		0(%r2)
+	 ldo		-64(%r30),%r30
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/mul_1.s b/src/gmp/mpn/hppa/hppa1_1/mul_1.s
new file mode 100644
index 000000000..4512fddec
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/mul_1.s
@@ -0,0 +1,98 @@
+; HP-PA-1.1 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+; the result in a second limb vector.
+
+; Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	r26
+; s1_ptr	r25
+; size		r24
+; s2_limb	r23
+
+; This runs at 9 cycles/limb on a PA7000.  With the used instructions, it can
+; not become faster due to data cache contention after a store.  On the
+; PA7100 it runs at 7 cycles/limb, and that can not be improved either, since
+; only the xmpyu does not need the integer pipeline, so the only dual-issue
+; we will get are addc+xmpyu.  Unrolling would not help either CPU.
+
+; We could use fldds to read two limbs at a time from the S1 array, and that
+; could bring down the times to 8.5 and 6.5 cycles/limb for the PA7000 and
+; PA7100, respectively.  We don't do that since it does not seem worth the
+; (alignment) troubles...
+
+; At least the PA7100 is rumored to be able to deal with cache-misses
+; without stalling instruction issue.  If this is true, and the cache is
+; actually also lockup-free, we should use a deeper software pipeline, and
+; load from S1 very early!  (The loads and stores to -12(sp) will surely be
+; in the cache.)
+
+	.code
+	.export		__gmpn_mul_1
+__gmpn_mul_1
+	.proc
+	.callinfo	frame=64,no_calls
+	.entry
+
+	ldo		64(%r30),%r30
+	fldws,ma	4(%r25),%fr5
+	stw		%r23,-16(%r30)		; move s2_limb ...
+	addib,=		-1,%r24,L$just_one_limb
+	 fldws		-16(%r30),%fr4		; ... into fr4
+	add		%r0,%r0,%r0		; clear carry
+	xmpyu		%fr4,%fr5,%fr6
+	fldws,ma	4(%r25),%fr7
+	fstds	 	%fr6,-16(%r30)
+	xmpyu		%fr4,%fr7,%fr8
+	ldw		-12(%r30),%r19		; least significant limb in product
+	ldw		-16(%r30),%r28
+
+	fstds		%fr8,-16(%r30)
+	addib,=		-1,%r24,L$end
+	 ldw		-12(%r30),%r1
+
+; Main loop
+L$loop	fldws,ma	4(%r25),%fr5
+	stws,ma		%r19,4(%r26)
+	addc		%r28,%r1,%r19
+	xmpyu		%fr4,%fr5,%fr6
+	ldw		-16(%r30),%r28
+	fstds		%fr6,-16(%r30)
+	addib,<>	-1,%r24,L$loop
+	 ldw		-12(%r30),%r1
+
+L$end	stws,ma		%r19,4(%r26)
+	addc		%r28,%r1,%r19
+	ldw		-16(%r30),%r28
+	stws,ma		%r19,4(%r26)
+	addc		%r0,%r28,%r28
+	bv		0(%r2)
+	 ldo		-64(%r30),%r30
+
+L$just_one_limb
+	xmpyu		%fr4,%fr5,%fr6
+	fstds		%fr6,-16(%r30)
+	ldw		-16(%r30),%r28
+	ldo		-64(%r30),%r30
+	bv		0(%r2)
+	 fstws		%fr6R,0(%r26)
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/pa7100/add_n.s b/src/gmp/mpn/hppa/hppa1_1/pa7100/add_n.s
new file mode 100644
index 000000000..4f4be08b3
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/pa7100/add_n.s
@@ -0,0 +1,75 @@
+; HP-PA  __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+; sum in a third limb vector.
+; This is optimized for the PA7100, where is runs at 4.25 cycles/limb
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+	.code
+	.export		__gmpn_add_n
+__gmpn_add_n
+	.proc
+	.callinfo	frame=0,no_calls
+	.entry
+
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+
+	addib,<=	-5,%r23,L$rest
+	 add		%r20,%r19,%r28	; add first limbs ignoring cy
+
+L$loop	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	addc		%r20,%r19,%r28
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	addc		%r20,%r19,%r28
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	addc		%r20,%r19,%r28
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	addib,>		-4,%r23,L$loop
+	addc		%r20,%r19,%r28
+
+L$rest	addib,=		4,%r23,L$end
+	nop
+L$eloop	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	addib,>		-1,%r23,L$eloop
+	addc		%r20,%r19,%r28
+
+L$end	stws		%r28,0(0,%r26)
+	bv		0(%r2)
+	 addc		%r0,%r0,%r28
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/pa7100/addmul_1.S b/src/gmp/mpn/hppa/hppa1_1/pa7100/addmul_1.S
new file mode 100644
index 000000000..04db06822
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/pa7100/addmul_1.S
@@ -0,0 +1,189 @@
+; HP-PA 7100/7200 __gmpn_addmul_1 -- Multiply a limb vector with a limb and
+; add the result to a second limb vector.
+
+; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+; INPUT PARAMETERS
+#define res_ptr	%r26
+#define s1_ptr	%r25
+#define size	%r24
+#define s2_limb	%r23
+
+#define cylimb	%r28
+#define s0	%r19
+#define s1	%r20
+#define s2	%r3
+#define s3	%r4
+#define lo0	%r21
+#define lo1	%r5
+#define lo2	%r6
+#define lo3	%r7
+#define hi0	%r22
+#define hi1	%r23				/* safe to reuse */
+#define hi2	%r29
+#define hi3	%r1
+
+	.code
+	.export		__gmpn_addmul_1
+__gmpn_addmul_1
+	.proc
+	.callinfo	frame=128,no_calls
+	.entry
+
+	ldo	128(%r30),%r30
+	stws	s2_limb,-16(%r30)
+	add	 %r0,%r0,cylimb			; clear cy and cylimb
+	addib,<	-4,size,L$few_limbs
+	fldws	-16(%r30),%fr31R
+
+	ldo	-112(%r30),%r31
+	stw	%r3,-96(%r30)
+	stw	%r4,-92(%r30)
+	stw	%r5,-88(%r30)
+	stw	%r6,-84(%r30)
+	stw	%r7,-80(%r30)
+
+	bb,>=,n	 s1_ptr,29,L$0
+
+	fldws,ma 4(s1_ptr),%fr4
+	ldws	 0(res_ptr),s0
+	xmpyu	 %fr4,%fr31R,%fr5
+	fstds	 %fr5,-16(%r31)
+	ldws	-16(%r31),cylimb
+	ldws	-12(%r31),lo0
+	add	 s0,lo0,s0
+	addib,< -1,size,L$few_limbs
+	stws,ma	 s0,4(res_ptr)
+
+; start software pipeline ----------------------------------------------------
+L$0	fldds,ma 8(s1_ptr),%fr4
+	fldds,ma 8(s1_ptr),%fr8
+
+	xmpyu	 %fr4L,%fr31R,%fr5
+	xmpyu	 %fr4R,%fr31R,%fr6
+	xmpyu	 %fr8L,%fr31R,%fr9
+	xmpyu	 %fr8R,%fr31R,%fr10
+
+	fstds	 %fr5,-16(%r31)
+	fstds	 %fr6,-8(%r31)
+	fstds	 %fr9,0(%r31)
+	fstds	 %fr10,8(%r31)
+
+	ldws   -16(%r31),hi0
+	ldws   -12(%r31),lo0
+	ldws	-8(%r31),hi1
+	ldws	-4(%r31),lo1
+	ldws	 0(%r31),hi2
+	ldws	 4(%r31),lo2
+	ldws	 8(%r31),hi3
+	ldws	12(%r31),lo3
+
+	addc	 lo0,cylimb,lo0
+	addc	 lo1,hi0,lo1
+	addc	 lo2,hi1,lo2
+	addc	 lo3,hi2,lo3
+
+	addib,<	 -4,size,L$end
+	addc	 %r0,hi3,cylimb			; propagate carry into cylimb
+; main loop ------------------------------------------------------------------
+L$loop	fldds,ma 8(s1_ptr),%fr4
+	fldds,ma 8(s1_ptr),%fr8
+
+	ldws	 0(res_ptr),s0
+	xmpyu	 %fr4L,%fr31R,%fr5
+	ldws	 4(res_ptr),s1
+	xmpyu	 %fr4R,%fr31R,%fr6
+	ldws	 8(res_ptr),s2
+	xmpyu	 %fr8L,%fr31R,%fr9
+	ldws	12(res_ptr),s3
+	xmpyu	 %fr8R,%fr31R,%fr10
+
+	fstds	 %fr5,-16(%r31)
+	add	 s0,lo0,s0
+	fstds	 %fr6,-8(%r31)
+	addc	 s1,lo1,s1
+	fstds	 %fr9,0(%r31)
+	addc	 s2,lo2,s2
+	fstds	 %fr10,8(%r31)
+	addc	 s3,lo3,s3
+
+	ldws   -16(%r31),hi0
+	ldws   -12(%r31),lo0
+	ldws	-8(%r31),hi1
+	ldws	-4(%r31),lo1
+	ldws	 0(%r31),hi2
+	ldws	 4(%r31),lo2
+	ldws	 8(%r31),hi3
+	ldws	12(%r31),lo3
+
+	addc	 lo0,cylimb,lo0
+	stws,ma	 s0,4(res_ptr)
+	addc	 lo1,hi0,lo1
+	stws,ma	 s1,4(res_ptr)
+	addc	 lo2,hi1,lo2
+	stws,ma	 s2,4(res_ptr)
+	addc	 lo3,hi2,lo3
+	stws,ma	 s3,4(res_ptr)
+
+	addib,>= -4,size,L$loop
+	addc	 %r0,hi3,cylimb			; propagate carry into cylimb
+; finish software pipeline ---------------------------------------------------
+L$end	ldws	 0(res_ptr),s0
+	ldws	 4(res_ptr),s1
+	ldws	 8(res_ptr),s2
+	ldws	12(res_ptr),s3
+
+	add	 s0,lo0,s0
+	stws,ma	 s0,4(res_ptr)
+	addc	 s1,lo1,s1
+	stws,ma	 s1,4(res_ptr)
+	addc	 s2,lo2,s2
+	stws,ma	 s2,4(res_ptr)
+	addc	 s3,lo3,s3
+	stws,ma	 s3,4(res_ptr)
+
+; restore callee-saves registers ---------------------------------------------
+	ldw	-96(%r30),%r3
+	ldw	-92(%r30),%r4
+	ldw	-88(%r30),%r5
+	ldw	-84(%r30),%r6
+	ldw	-80(%r30),%r7
+
+L$few_limbs
+	addib,=,n 4,size,L$ret
+L$loop2	fldws,ma 4(s1_ptr),%fr4
+	ldws	 0(res_ptr),s0
+	xmpyu	 %fr4,%fr31R,%fr5
+	fstds	 %fr5,-16(%r30)
+	ldws	-16(%r30),hi0
+	ldws	-12(%r30),lo0
+	addc	 lo0,cylimb,lo0
+	addc	 %r0,hi0,cylimb
+	add	 s0,lo0,s0
+	stws,ma	 s0,4(res_ptr)
+	addib,<> -1,size,L$loop2
+	nop
+
+L$ret	addc	 %r0,cylimb,cylimb
+	bv	 0(%r2)
+	ldo	 -128(%r30),%r30
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/pa7100/lshift.s b/src/gmp/mpn/hppa/hppa1_1/pa7100/lshift.s
new file mode 100644
index 000000000..31669b1a5
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/pa7100/lshift.s
@@ -0,0 +1,83 @@
+; HP-PA  __gmpn_lshift --
+; This is optimized for the PA7100, where is runs at 3.25 cycles/limb
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s_ptr		gr25
+; size		gr24
+; cnt		gr23
+
+	.code
+	.export		__gmpn_lshift
+__gmpn_lshift
+	.proc
+	.callinfo	frame=64,no_calls
+	.entry
+
+	sh2add		%r24,%r25,%r25
+	sh2add		%r24,%r26,%r26
+	ldws,mb		-4(0,%r25),%r22
+	subi		32,%r23,%r1
+	mtsar		%r1
+	addib,=		-1,%r24,L$0004
+	vshd		%r0,%r22,%r28		; compute carry out limb
+	ldws,mb		-4(0,%r25),%r29
+	addib,<=	-5,%r24,L$rest
+	vshd		%r22,%r29,%r20
+
+L$loop	ldws,mb		-4(0,%r25),%r22
+	stws,mb		%r20,-4(0,%r26)
+	vshd		%r29,%r22,%r20
+	ldws,mb		-4(0,%r25),%r29
+	stws,mb		%r20,-4(0,%r26)
+	vshd		%r22,%r29,%r20
+	ldws,mb		-4(0,%r25),%r22
+	stws,mb		%r20,-4(0,%r26)
+	vshd		%r29,%r22,%r20
+	ldws,mb		-4(0,%r25),%r29
+	stws,mb		%r20,-4(0,%r26)
+	addib,>		-4,%r24,L$loop
+	vshd		%r22,%r29,%r20
+
+L$rest	addib,=		4,%r24,L$end1
+	nop
+L$eloop	ldws,mb		-4(0,%r25),%r22
+	stws,mb		%r20,-4(0,%r26)
+	addib,<=	-1,%r24,L$end2
+	vshd		%r29,%r22,%r20
+	ldws,mb		-4(0,%r25),%r29
+	stws,mb		%r20,-4(0,%r26)
+	addib,>		-1,%r24,L$eloop
+	vshd		%r22,%r29,%r20
+
+L$end1	stws,mb		%r20,-4(0,%r26)
+	vshd		%r29,%r0,%r20
+	bv		0(%r2)
+	stw		%r20,-4(0,%r26)
+L$end2	stws,mb		%r20,-4(0,%r26)
+L$0004	vshd		%r22,%r0,%r20
+	bv		0(%r2)
+	stw		%r20,-4(0,%r26)
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/pa7100/rshift.s b/src/gmp/mpn/hppa/hppa1_1/pa7100/rshift.s
new file mode 100644
index 000000000..d32b10b4b
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/pa7100/rshift.s
@@ -0,0 +1,80 @@
+; HP-PA  __gmpn_rshift --
+; This is optimized for the PA7100, where is runs at 3.25 cycles/limb
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s_ptr		gr25
+; size		gr24
+; cnt		gr23
+
+	.code
+	.export		__gmpn_rshift
+__gmpn_rshift
+	.proc
+	.callinfo	frame=64,no_calls
+	.entry
+
+	ldws,ma		4(0,%r25),%r22
+	mtsar		%r23
+	addib,=		-1,%r24,L$0004
+	vshd		%r22,%r0,%r28		; compute carry out limb
+	ldws,ma		4(0,%r25),%r29
+	addib,<=	-5,%r24,L$rest
+	vshd		%r29,%r22,%r20
+
+L$loop	ldws,ma		4(0,%r25),%r22
+	stws,ma		%r20,4(0,%r26)
+	vshd		%r22,%r29,%r20
+	ldws,ma		4(0,%r25),%r29
+	stws,ma		%r20,4(0,%r26)
+	vshd		%r29,%r22,%r20
+	ldws,ma		4(0,%r25),%r22
+	stws,ma		%r20,4(0,%r26)
+	vshd		%r22,%r29,%r20
+	ldws,ma		4(0,%r25),%r29
+	stws,ma		%r20,4(0,%r26)
+	addib,>		-4,%r24,L$loop
+	vshd		%r29,%r22,%r20
+
+L$rest	addib,=		4,%r24,L$end1
+	nop
+L$eloop	ldws,ma		4(0,%r25),%r22
+	stws,ma		%r20,4(0,%r26)
+	addib,<=	-1,%r24,L$end2
+	vshd		%r22,%r29,%r20
+	ldws,ma		4(0,%r25),%r29
+	stws,ma		%r20,4(0,%r26)
+	addib,>		-1,%r24,L$eloop
+	vshd		%r29,%r22,%r20
+
+L$end1	stws,ma		%r20,4(0,%r26)
+	vshd		%r0,%r29,%r20
+	bv		0(%r2)
+	stw		%r20,0(0,%r26)
+L$end2	stws,ma		%r20,4(0,%r26)
+L$0004	vshd		%r0,%r22,%r20
+	bv		0(%r2)
+	stw		%r20,0(0,%r26)
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/pa7100/sub_n.s b/src/gmp/mpn/hppa/hppa1_1/pa7100/sub_n.s
new file mode 100644
index 000000000..0eec41c4b
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/pa7100/sub_n.s
@@ -0,0 +1,76 @@
+; HP-PA  __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+; store difference in a third limb vector.
+; This is optimized for the PA7100, where is runs at 4.25 cycles/limb
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+	.code
+	.export		__gmpn_sub_n
+__gmpn_sub_n
+	.proc
+	.callinfo	frame=0,no_calls
+	.entry
+
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+
+	addib,<=	-5,%r23,L$rest
+	 sub		%r20,%r19,%r28	; subtract first limbs ignoring cy
+
+L$loop	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	subb		%r20,%r19,%r28
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	subb		%r20,%r19,%r28
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	subb		%r20,%r19,%r28
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	addib,>		-4,%r23,L$loop
+	subb		%r20,%r19,%r28
+
+L$rest	addib,=		4,%r23,L$end
+	nop
+L$eloop	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	addib,>		-1,%r23,L$eloop
+	subb		%r20,%r19,%r28
+
+L$end	stws		%r28,0(0,%r26)
+	addc		%r0,%r0,%r28
+	bv		0(%r2)
+	 subi		1,%r28,%r28
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/pa7100/submul_1.S b/src/gmp/mpn/hppa/hppa1_1/pa7100/submul_1.S
new file mode 100644
index 000000000..0fba21dce
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/pa7100/submul_1.S
@@ -0,0 +1,195 @@
+; HP-PA 7100/7200 __gmpn_submul_1 -- Multiply a limb vector with a limb and
+; subtract the result from a second limb vector.
+
+; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+; INPUT PARAMETERS
+#define res_ptr	%r26
+#define s1_ptr	%r25
+#define size	%r24
+#define s2_limb	%r23
+
+#define cylimb	%r28
+#define s0	%r19
+#define s1	%r20
+#define s2	%r3
+#define s3	%r4
+#define lo0	%r21
+#define lo1	%r5
+#define lo2	%r6
+#define lo3	%r7
+#define hi0	%r22
+#define hi1	%r23				/* safe to reuse */
+#define hi2	%r29
+#define hi3	%r1
+
+	.code
+	.export		__gmpn_submul_1
+__gmpn_submul_1
+	.proc
+	.callinfo	frame=128,no_calls
+	.entry
+
+	ldo	128(%r30),%r30
+	stws	s2_limb,-16(%r30)
+	add	 %r0,%r0,cylimb			; clear cy and cylimb
+	addib,<	-4,size,L$few_limbs
+	fldws	-16(%r30),%fr31R
+
+	ldo	-112(%r30),%r31
+	stw	%r3,-96(%r30)
+	stw	%r4,-92(%r30)
+	stw	%r5,-88(%r30)
+	stw	%r6,-84(%r30)
+	stw	%r7,-80(%r30)
+
+	bb,>=,n	 s1_ptr,29,L$0
+
+	fldws,ma 4(s1_ptr),%fr4
+	ldws	 0(res_ptr),s0
+	xmpyu	 %fr4,%fr31R,%fr5
+	fstds	 %fr5,-16(%r31)
+	ldws	-16(%r31),cylimb
+	ldws	-12(%r31),lo0
+	sub	 s0,lo0,s0
+	add	 s0,lo0,%r0			; invert cy
+	addib,< -1,size,L$few_limbs
+	stws,ma	 s0,4(res_ptr)
+
+; start software pipeline ----------------------------------------------------
+L$0	fldds,ma 8(s1_ptr),%fr4
+	fldds,ma 8(s1_ptr),%fr8
+
+	xmpyu	 %fr4L,%fr31R,%fr5
+	xmpyu	 %fr4R,%fr31R,%fr6
+	xmpyu	 %fr8L,%fr31R,%fr9
+	xmpyu	 %fr8R,%fr31R,%fr10
+
+	fstds	 %fr5,-16(%r31)
+	fstds	 %fr6,-8(%r31)
+	fstds	 %fr9,0(%r31)
+	fstds	 %fr10,8(%r31)
+
+	ldws   -16(%r31),hi0
+	ldws   -12(%r31),lo0
+	ldws	-8(%r31),hi1
+	ldws	-4(%r31),lo1
+	ldws	 0(%r31),hi2
+	ldws	 4(%r31),lo2
+	ldws	 8(%r31),hi3
+	ldws	12(%r31),lo3
+
+	addc	 lo0,cylimb,lo0
+	addc	 lo1,hi0,lo1
+	addc	 lo2,hi1,lo2
+	addc	 lo3,hi2,lo3
+
+	addib,<	 -4,size,L$end
+	addc	 %r0,hi3,cylimb			; propagate carry into cylimb
+; main loop ------------------------------------------------------------------
+L$loop	fldds,ma 8(s1_ptr),%fr4
+	fldds,ma 8(s1_ptr),%fr8
+
+	ldws	 0(res_ptr),s0
+	xmpyu	 %fr4L,%fr31R,%fr5
+	ldws	 4(res_ptr),s1
+	xmpyu	 %fr4R,%fr31R,%fr6
+	ldws	 8(res_ptr),s2
+	xmpyu	 %fr8L,%fr31R,%fr9
+	ldws	12(res_ptr),s3
+	xmpyu	 %fr8R,%fr31R,%fr10
+
+	fstds	 %fr5,-16(%r31)
+	sub	 s0,lo0,s0
+	fstds	 %fr6,-8(%r31)
+	subb	 s1,lo1,s1
+	fstds	 %fr9,0(%r31)
+	subb	 s2,lo2,s2
+	fstds	 %fr10,8(%r31)
+	subb	 s3,lo3,s3
+	subb	 %r0,%r0,lo0			; these two insns ...
+	add	 lo0,lo0,%r0			; ... just invert cy
+
+	ldws   -16(%r31),hi0
+	ldws   -12(%r31),lo0
+	ldws	-8(%r31),hi1
+	ldws	-4(%r31),lo1
+	ldws	 0(%r31),hi2
+	ldws	 4(%r31),lo2
+	ldws	 8(%r31),hi3
+	ldws	12(%r31),lo3
+
+	addc	 lo0,cylimb,lo0
+	stws,ma	 s0,4(res_ptr)
+	addc	 lo1,hi0,lo1
+	stws,ma	 s1,4(res_ptr)
+	addc	 lo2,hi1,lo2
+	stws,ma	 s2,4(res_ptr)
+	addc	 lo3,hi2,lo3
+	stws,ma	 s3,4(res_ptr)
+
+	addib,>= -4,size,L$loop
+	addc	 %r0,hi3,cylimb			; propagate carry into cylimb
+; finish software pipeline ---------------------------------------------------
+L$end	ldws	 0(res_ptr),s0
+	ldws	 4(res_ptr),s1
+	ldws	 8(res_ptr),s2
+	ldws	12(res_ptr),s3
+
+	sub	 s0,lo0,s0
+	stws,ma	 s0,4(res_ptr)
+	subb	 s1,lo1,s1
+	stws,ma	 s1,4(res_ptr)
+	subb	 s2,lo2,s2
+	stws,ma	 s2,4(res_ptr)
+	subb	 s3,lo3,s3
+	stws,ma	 s3,4(res_ptr)
+	subb	 %r0,%r0,lo0			; these two insns ...
+	add	 lo0,lo0,%r0			; ... invert cy
+
+; restore callee-saves registers ---------------------------------------------
+	ldw	-96(%r30),%r3
+	ldw	-92(%r30),%r4
+	ldw	-88(%r30),%r5
+	ldw	-84(%r30),%r6
+	ldw	-80(%r30),%r7
+
+L$few_limbs
+	addib,=,n 4,size,L$ret
+L$loop2	fldws,ma 4(s1_ptr),%fr4
+	ldws	 0(res_ptr),s0
+	xmpyu	 %fr4,%fr31R,%fr5
+	fstds	 %fr5,-16(%r30)
+	ldws	-16(%r30),hi0
+	ldws	-12(%r30),lo0
+	addc	 lo0,cylimb,lo0
+	addc	 %r0,hi0,cylimb
+	sub	 s0,lo0,s0
+	add	 s0,lo0,%r0			; invert cy
+	stws,ma	 s0,4(res_ptr)
+	addib,<> -1,size,L$loop2
+	nop
+
+L$ret	addc	 %r0,cylimb,cylimb
+	bv	 0(%r2)
+	ldo	 -128(%r30),%r30
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/submul_1.s b/src/gmp/mpn/hppa/hppa1_1/submul_1.s
new file mode 100644
index 000000000..20a5b5ce0
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/submul_1.s
@@ -0,0 +1,111 @@
+; HP-PA-1.1 __gmpn_submul_1 -- Multiply a limb vector with a limb and
+; subtract the result from a second limb vector.
+
+; Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	r26
+; s1_ptr	r25
+; size		r24
+; s2_limb	r23
+
+; This runs at 12 cycles/limb on a PA7000.  With the used instructions, it
+; can not become faster due to data cache contention after a store.  On the
+; PA7100 it runs at 11 cycles/limb, and that can not be improved either,
+; since only the xmpyu does not need the integer pipeline, so the only
+; dual-issue we will get are addc+xmpyu.  Unrolling could gain a cycle/limb
+; on the PA7100.
+
+; There are some ideas described in mul_1.s that applies to this code too.
+
+; It seems possible to make this run as fast as __gmpn_addmul_1, if we use
+; 	sub,>>=	%r29,%r19,%r22
+;	addi	1,%r28,%r28
+; but that requires reworking the hairy software pipeline...
+
+	.code
+	.export		__gmpn_submul_1
+__gmpn_submul_1
+	.proc
+	.callinfo	frame=64,no_calls
+	.entry
+
+	ldo		64(%r30),%r30
+	fldws,ma	4(%r25),%fr5
+	stw		%r23,-16(%r30)		; move s2_limb ...
+	addib,=		-1,%r24,L$just_one_limb
+	 fldws		-16(%r30),%fr4		; ... into fr4
+	add		%r0,%r0,%r0		; clear carry
+	xmpyu		%fr4,%fr5,%fr6
+	fldws,ma	4(%r25),%fr7
+	fstds		%fr6,-16(%r30)
+	xmpyu		%fr4,%fr7,%fr8
+	ldw		-12(%r30),%r19		; least significant limb in product
+	ldw		-16(%r30),%r28
+
+	fstds		%fr8,-16(%r30)
+	addib,=		-1,%r24,L$end
+	 ldw		-12(%r30),%r1
+
+; Main loop
+L$loop	ldws		0(%r26),%r29
+	fldws,ma	4(%r25),%fr5
+	sub		%r29,%r19,%r22
+	add		%r22,%r19,%r0
+	stws,ma		%r22,4(%r26)
+	addc		%r28,%r1,%r19
+	xmpyu		%fr4,%fr5,%fr6
+	ldw		-16(%r30),%r28
+	fstds		%fr6,-16(%r30)
+	addc		%r0,%r28,%r28
+	addib,<>	-1,%r24,L$loop
+	 ldw		-12(%r30),%r1
+
+L$end	ldw		0(%r26),%r29
+	sub		%r29,%r19,%r22
+	add		%r22,%r19,%r0
+	stws,ma		%r22,4(%r26)
+	addc		%r28,%r1,%r19
+	ldw		-16(%r30),%r28
+	ldws		0(%r26),%r29
+	addc		%r0,%r28,%r28
+	sub		%r29,%r19,%r22
+	add		%r22,%r19,%r0
+	stws,ma		%r22,4(%r26)
+	addc		%r0,%r28,%r28
+	bv		0(%r2)
+	 ldo		-64(%r30),%r30
+
+L$just_one_limb
+	xmpyu		%fr4,%fr5,%fr6
+	ldw		0(%r26),%r29
+	fstds		%fr6,-16(%r30)
+	ldw		-12(%r30),%r1
+	ldw		-16(%r30),%r28
+	sub		%r29,%r1,%r22
+	add		%r22,%r1,%r0
+	stw		%r22,0(%r26)
+	addc		%r0,%r28,%r28
+	bv		0(%r2)
+	 ldo		-64(%r30),%r30
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/udiv_qrnnd.S b/src/gmp/mpn/hppa/hppa1_1/udiv_qrnnd.S
new file mode 100644
index 000000000..b83d6f4dd
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/udiv_qrnnd.S
@@ -0,0 +1,80 @@
+; HP-PA  __udiv_qrnnd division support, used from longlong.h.
+; This version runs fast on PA 7000 and later.
+
+; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; rem_ptr	gr26
+; n1		gr25
+; n0		gr24
+; d		gr23
+
+	.code
+L$0000	.word		0x43f00000		; 2^64
+	.word		0x0
+	.export		__gmpn_udiv_qrnnd
+__gmpn_udiv_qrnnd
+	.proc
+	.callinfo	frame=64,no_calls
+	.entry
+	ldo		64(%r30),%r30
+
+	stws		%r25,-16(0,%r30)	; n_hi
+	stws		%r24,-12(0,%r30)	; n_lo
+#ifdef PIC
+	addil		LT%L$0000,%r19
+	ldo		RT%L$0000(%r1),%r19
+#else
+	ldil		L%L$0000,%r19
+	ldo		R%L$0000(%r19),%r19
+#endif	
+	fldds		-16(0,%r30),%fr5
+	stws		%r23,-12(0,%r30)
+	comib,<=	0,%r25,L$1
+	fcnvxf,dbl,dbl	%fr5,%fr5
+	fldds		0(0,%r19),%fr4
+	fadd,dbl	%fr4,%fr5,%fr5
+L$1
+	fcpy,sgl	%fr0,%fr6L
+	fldws		-12(0,%r30),%fr6R
+	fcnvxf,dbl,dbl	%fr6,%fr4
+
+	fdiv,dbl	%fr5,%fr4,%fr5
+
+	fcnvfx,dbl,dbl	%fr5,%fr4
+	fstws		%fr4R,-16(%r30)
+	xmpyu		%fr4R,%fr6R,%fr6
+	ldws		-16(%r30),%r28
+	fstds		%fr6,-16(0,%r30)
+	ldws		-12(0,%r30),%r21
+	ldws		-16(0,%r30),%r20
+	sub		%r24,%r21,%r22
+	subb		%r25,%r20,%r19
+	comib,=		0,%r19,L$2
+	ldo		-64(%r30),%r30
+
+	add		%r22,%r23,%r22
+	ldo		-1(%r28),%r28
+L$2	bv		0(%r2)
+	stws		%r22,0(0,%r26)
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa1_1/umul.s b/src/gmp/mpn/hppa/hppa1_1/umul.s
new file mode 100644
index 000000000..1f1300ac9
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa1_1/umul.s
@@ -0,0 +1,42 @@
+; Copyright (C) 1999 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+	.code
+	.export		__umul_ppmm
+	.align 4
+__umul_ppmm
+	.proc
+	.callinfo frame=64,no_calls
+	.entry
+
+	ldo 64(%r30),%r30
+	stw %r25,-16(0,%r30)
+	fldws -16(0,%r30),%fr22R
+	stw %r24,-16(0,%r30)
+	fldws -16(0,%r30),%fr22L
+	xmpyu %fr22R,%fr22L,%fr22
+	fstds %fr22,-16(0,%r30)
+	ldw -16(0,%r30),%r28
+	ldw -12(0,%r30),%r29
+	stw %r29,0(0,%r26)
+	bv 0(%r2)
+	ldo -64(%r30),%r30
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa2_0/add_n.s b/src/gmp/mpn/hppa/hppa2_0/add_n.s
new file mode 100644
index 000000000..6e97278a3
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa2_0/add_n.s
@@ -0,0 +1,88 @@
+; HP-PA 2.0 32-bit __gmpn_add_n -- Add two limb vectors of the same length > 0
+; and store sum in a third limb vector.
+
+; Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+; This runs at 2 cycles/limb on PA8000.
+
+	.code
+	.export	__gmpn_add_n
+__gmpn_add_n
+	.proc
+	.callinfo frame=0,no_calls
+	.entry
+
+	sub		%r0,%r23,%r22
+	zdep		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
+	zdep		%r22,29,3,%r22		; r22 = 4 * (-n & 7)
+	sub		%r25,%r22,%r25		; offset s1_ptr
+	sub		%r24,%r22,%r24		; offset s2_ptr
+	sub		%r26,%r22,%r26		; offset res_ptr
+	blr		%r28,%r0		; branch into loop
+	add		%r0,%r0,%r0		; reset carry
+
+L$loop	ldw		0(%r25),%r20
+	ldw		0(%r24),%r31
+	addc		%r20,%r31,%r20
+	stw		%r20,0(%r26)
+L$7	ldw		4(%r25),%r21
+	ldw		4(%r24),%r19
+	addc		%r21,%r19,%r21
+	stw		%r21,4(%r26)
+L$6	ldw		8(%r25),%r20
+	ldw		8(%r24),%r31
+	addc		%r20,%r31,%r20
+	stw		%r20,8(%r26)
+L$5	ldw		12(%r25),%r21
+	ldw		12(%r24),%r19
+	addc		%r21,%r19,%r21
+	stw		%r21,12(%r26)
+L$4	ldw		16(%r25),%r20
+	ldw		16(%r24),%r31
+	addc		%r20,%r31,%r20
+	stw		%r20,16(%r26)
+L$3	ldw		20(%r25),%r21
+	ldw		20(%r24),%r19
+	addc		%r21,%r19,%r21
+	stw		%r21,20(%r26)
+L$2	ldw		24(%r25),%r20
+	ldw		24(%r24),%r31
+	addc		%r20,%r31,%r20
+	stw		%r20,24(%r26)
+L$1	ldw		28(%r25),%r21
+	ldo		32(%r25),%r25
+	ldw		28(%r24),%r19
+	addc		%r21,%r19,%r21
+	stw		%r21,28(%r26)
+	ldo		32(%r24),%r24
+	addib,>		-8,%r23,L$loop
+	ldo		32(%r26),%r26
+
+	bv		(%r2)
+	.exit
+	addc		%r0,%r0,%r28
+	.procend
diff --git a/src/gmp/mpn/hppa/hppa2_0/sub_n.s b/src/gmp/mpn/hppa/hppa2_0/sub_n.s
new file mode 100644
index 000000000..7d9b50fc2
--- /dev/null
+++ b/src/gmp/mpn/hppa/hppa2_0/sub_n.s
@@ -0,0 +1,88 @@
+; HP-PA 2.0 32-bit __gmpn_sub_n -- Subtract two limb vectors of the same
+; length > 0 and store difference in a third limb vector.
+
+; Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+; This runs at 2 cycles/limb on PA8000.
+
+	.code
+	.export	__gmpn_sub_n
+__gmpn_sub_n
+	.proc
+	.callinfo frame=0,no_calls
+	.entry
+
+	sub		%r0,%r23,%r22
+	zdep		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
+	zdep		%r22,29,3,%r22		; r22 = 4 * (-n & 7)
+	sub		%r25,%r22,%r25		; offset s1_ptr
+	sub		%r24,%r22,%r24		; offset s2_ptr
+	blr		%r28,%r0		; branch into loop
+	sub		%r26,%r22,%r26		; offset res_ptr and set carry
+
+L$loop	ldw		0(%r25),%r20
+	ldw		0(%r24),%r31
+	subb		%r20,%r31,%r20
+	stw		%r20,0(%r26)
+L$7	ldw		4(%r25),%r21
+	ldw		4(%r24),%r19
+	subb		%r21,%r19,%r21
+	stw		%r21,4(%r26)
+L$6	ldw		8(%r25),%r20
+	ldw		8(%r24),%r31
+	subb		%r20,%r31,%r20
+	stw		%r20,8(%r26)
+L$5	ldw		12(%r25),%r21
+	ldw		12(%r24),%r19
+	subb		%r21,%r19,%r21
+	stw		%r21,12(%r26)
+L$4	ldw		16(%r25),%r20
+	ldw		16(%r24),%r31
+	subb		%r20,%r31,%r20
+	stw		%r20,16(%r26)
+L$3	ldw		20(%r25),%r21
+	ldw		20(%r24),%r19
+	subb		%r21,%r19,%r21
+	stw		%r21,20(%r26)
+L$2	ldw		24(%r25),%r20
+	ldw		24(%r24),%r31
+	subb		%r20,%r31,%r20
+	stw		%r20,24(%r26)
+L$1	ldw		28(%r25),%r21
+	ldo		32(%r25),%r25
+	ldw		28(%r24),%r19
+	subb		%r21,%r19,%r21
+	stw		%r21,28(%r26)
+	ldo		32(%r24),%r24
+	addib,>		-8,%r23,L$loop
+	ldo		32(%r26),%r26
+
+	addc		%r0,%r0,%r28
+	bv		(%r2)
+	.exit
+	subi		1,%r28,%r28
+	.procend
diff --git a/src/gmp/mpn/hppa/lshift.s b/src/gmp/mpn/hppa/lshift.s
new file mode 100644
index 000000000..f5a2daad6
--- /dev/null
+++ b/src/gmp/mpn/hppa/lshift.s
@@ -0,0 +1,66 @@
+; HP-PA  __gmpn_lshift --
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s_ptr		gr25
+; size		gr24
+; cnt		gr23
+
+	.code
+	.export		__gmpn_lshift
+__gmpn_lshift
+	.proc
+	.callinfo	frame=64,no_calls
+	.entry
+
+	sh2add		%r24,%r25,%r25
+	sh2add		%r24,%r26,%r26
+	ldws,mb		-4(0,%r25),%r22
+	subi		32,%r23,%r1
+	mtsar		%r1
+	addib,=		-1,%r24,L$0004
+	vshd		%r0,%r22,%r28		; compute carry out limb
+	ldws,mb		-4(0,%r25),%r29
+	addib,=		-1,%r24,L$0002
+	vshd		%r22,%r29,%r20
+
+L$loop	ldws,mb		-4(0,%r25),%r22
+	stws,mb		%r20,-4(0,%r26)
+	addib,=		-1,%r24,L$0003
+	vshd		%r29,%r22,%r20
+	ldws,mb		-4(0,%r25),%r29
+	stws,mb		%r20,-4(0,%r26)
+	addib,<>	-1,%r24,L$loop
+	vshd		%r22,%r29,%r20
+
+L$0002	stws,mb		%r20,-4(0,%r26)
+	vshd		%r29,%r0,%r20
+	bv		0(%r2)
+	stw		%r20,-4(0,%r26)
+L$0003	stws,mb		%r20,-4(0,%r26)
+L$0004	vshd		%r22,%r0,%r20
+	bv		0(%r2)
+	stw		%r20,-4(0,%r26)
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/rshift.s b/src/gmp/mpn/hppa/rshift.s
new file mode 100644
index 000000000..e05e2f10b
--- /dev/null
+++ b/src/gmp/mpn/hppa/rshift.s
@@ -0,0 +1,63 @@
+; HP-PA  __gmpn_rshift -- 
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s_ptr		gr25
+; size		gr24
+; cnt		gr23
+
+	.code
+	.export		__gmpn_rshift
+__gmpn_rshift
+	.proc
+	.callinfo	frame=64,no_calls
+	.entry
+
+	ldws,ma		4(0,%r25),%r22
+	mtsar		%r23
+	addib,=		-1,%r24,L$0004
+	vshd		%r22,%r0,%r28		; compute carry out limb
+	ldws,ma		4(0,%r25),%r29
+	addib,=		-1,%r24,L$0002
+	vshd		%r29,%r22,%r20
+
+L$loop	ldws,ma		4(0,%r25),%r22
+	stws,ma		%r20,4(0,%r26)
+	addib,=		-1,%r24,L$0003
+	vshd		%r22,%r29,%r20
+	ldws,ma		4(0,%r25),%r29
+	stws,ma		%r20,4(0,%r26)
+	addib,<>	-1,%r24,L$loop
+	vshd		%r29,%r22,%r20
+
+L$0002	stws,ma		%r20,4(0,%r26)
+	vshd		%r0,%r29,%r20
+	bv		0(%r2)
+	stw		%r20,0(0,%r26)
+L$0003	stws,ma		%r20,4(0,%r26)
+L$0004	vshd		%r0,%r22,%r20
+	bv		0(%r2)
+	stw		%r20,0(0,%r26)
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/sub_n.s b/src/gmp/mpn/hppa/sub_n.s
new file mode 100644
index 000000000..8f770ad1a
--- /dev/null
+++ b/src/gmp/mpn/hppa/sub_n.s
@@ -0,0 +1,59 @@
+; HP-PA  __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+; store difference in a third limb vector.
+
+; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+; One might want to unroll this as for other processors, but it turns
+; out that the data cache contention after a store makes such
+; unrolling useless.  We can't come under 5 cycles/limb anyway.
+
+	.code
+	.export		__gmpn_sub_n
+__gmpn_sub_n
+	.proc
+	.callinfo	frame=0,no_calls
+	.entry
+
+	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+
+	addib,=		-1,%r23,L$end	; check for (SIZE == 1)
+	 sub		%r20,%r19,%r28	; subtract first limbs ignoring cy
+
+L$loop	ldws,ma		4(0,%r25),%r20
+	ldws,ma		4(0,%r24),%r19
+	stws,ma		%r28,4(0,%r26)
+	addib,<>	-1,%r23,L$loop
+	 subb		%r20,%r19,%r28
+
+L$end	stws		%r28,0(0,%r26)
+	addc		%r0,%r0,%r28
+	bv		0(%r2)
+	 subi		1,%r28,%r28
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/hppa/udiv_qrnnd.s b/src/gmp/mpn/hppa/udiv_qrnnd.s
new file mode 100644
index 000000000..9aa3b8a83
--- /dev/null
+++ b/src/gmp/mpn/hppa/udiv_qrnnd.s
@@ -0,0 +1,286 @@
+; HP-PA  __udiv_qrnnd division support, used from longlong.h.
+; This version runs fast on pre-PA7000 CPUs.
+
+; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; rem_ptr	gr26
+; n1		gr25
+; n0		gr24
+; d		gr23
+
+; The code size is a bit excessive.  We could merge the last two ds;addc
+; sequences by simply moving the "bb,< Odd" instruction down.  The only
+; trouble is the FFFFFFFF code that would need some hacking.
+
+	.code
+	.export		__gmpn_udiv_qrnnd
+__gmpn_udiv_qrnnd
+	.proc
+	.callinfo	frame=0,no_calls
+	.entry
+
+	comb,<		%r23,0,L$largedivisor
+	 sub		%r0,%r23,%r1		; clear cy as side-effect
+	ds		%r0,%r1,%r0
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r23,%r25
+	addc		%r24,%r24,%r28
+	ds		%r25,%r23,%r25
+	comclr,>=	%r25,%r0,%r0
+	addl		%r25,%r23,%r25
+	stws		%r25,0(0,%r26)
+	bv		0(%r2)
+	 addc		%r28,%r28,%r28
+
+L$largedivisor
+	extru		%r24,31,1,%r19		; r19 = n0 & 1
+	bb,<		%r23,31,L$odd
+	 extru		%r23,30,31,%r22		; r22 = d >> 1
+	shd		%r25,%r24,1,%r24	; r24 = new n0
+	extru		%r25,30,31,%r25		; r25 = new n1
+	sub		%r0,%r22,%r21
+	ds		%r0,%r21,%r0
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	comclr,>=	%r25,%r0,%r0
+	addl		%r25,%r22,%r25
+	sh1addl		%r25,%r19,%r25
+	stws		%r25,0(0,%r26)
+	bv		0(%r2)
+	 addc		%r24,%r24,%r28
+
+L$odd	addib,sv,n	1,%r22,L$FF..		; r22 = (d / 2 + 1)
+	shd		%r25,%r24,1,%r24	; r24 = new n0
+	extru		%r25,30,31,%r25		; r25 = new n1
+	sub		%r0,%r22,%r21
+	ds		%r0,%r21,%r0
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r24
+	ds		%r25,%r22,%r25
+	addc		%r24,%r24,%r28
+	comclr,>=	%r25,%r0,%r0
+	addl		%r25,%r22,%r25
+	sh1addl		%r25,%r19,%r25
+; We have computed (n1,,n0) / (d + 1), q' = r28, r' = r25
+	add,nuv		%r28,%r25,%r25
+	addl		%r25,%r1,%r25
+	addc		%r0,%r28,%r28
+	sub,<<		%r25,%r23,%r0
+	addl		%r25,%r1,%r25
+	stws		%r25,0(0,%r26)
+	bv		0(%r2)
+	 addc		%r0,%r28,%r28
+
+; This is just a special case of the code above.
+; We come here when d == 0xFFFFFFFF
+L$FF..	add,uv		%r25,%r24,%r24
+	sub,<<		%r24,%r23,%r0
+	ldo		1(%r24),%r24
+	stws		%r24,0(0,%r26)
+	bv		0(%r2)
+	 addc		%r0,%r25,%r28
+
+	.exit
+	.procend
diff --git a/src/gmp/mpn/i960/README b/src/gmp/mpn/i960/README
new file mode 100644
index 000000000..d68a0a83e
--- /dev/null
+++ b/src/gmp/mpn/i960/README
@@ -0,0 +1,9 @@
+This directory contains mpn functions for Intel i960 processors.
+
+RELEVANT OPTIMIZATION ISSUES
+
+The code in this directory is not well optimized.
+
+STATUS
+
+The code in this directory has not been tested.
diff --git a/src/gmp/mpn/i960/add_n.s b/src/gmp/mpn/i960/add_n.s
new file mode 100644
index 000000000..387317a39
--- /dev/null
+++ b/src/gmp/mpn/i960/add_n.s
@@ -0,0 +1,43 @@
+# I960 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+# sum in a third limb vector.
+
+# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+.text
+	.align 4
+	.globl ___gmpn_add_n
+___gmpn_add_n:
+	mov	0,g6		# clear carry-save register
+	cmpo	1,0		# clear cy
+
+Loop:	subo	1,g3,g3		# update loop counter
+	ld	(g1),g5		# load from s1_ptr
+	addo	4,g1,g1		# s1_ptr++
+	ld	(g2),g4		# load from s2_ptr
+	addo	4,g2,g2		# s2_ptr++
+	cmpo	g6,1		# restore cy from g6, relies on cy being 0
+	addc	g4,g5,g4	# main add
+	subc	0,0,g6		# save cy in g6
+	st	g4,(g0)		# store result to res_ptr
+	addo	4,g0,g0		# res_ptr++
+	cmpobne	0,g3,Loop	# when branch is taken, clears C bit
+
+	mov	g6,g0
+	ret
diff --git a/src/gmp/mpn/i960/addmul_1.s b/src/gmp/mpn/i960/addmul_1.s
new file mode 100644
index 000000000..7df141835
--- /dev/null
+++ b/src/gmp/mpn/i960/addmul_1.s
@@ -0,0 +1,48 @@
+# I960 __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
+# the result to a second limb vector.
+
+# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+.text
+	.align	4
+	.globl	___gmpn_mul_1
+___gmpn_mul_1:
+	subo	g2,0,g2
+	shlo	2,g2,g4
+	subo	g4,g1,g1
+	subo	g4,g0,g13
+	mov	0,g0
+
+	cmpo	1,0		# clear C bit on AC.cc
+
+Loop:	ld	(g1)[g2*4],g5
+	emul	g3,g5,g6
+	ld	(g13)[g2*4],g5
+
+	addc	g0,g6,g6	# relies on that C bit is clear
+	addc	0,g7,g7
+	addc	g5,g6,g6	# relies on that C bit is clear
+	st	g6,(g13)[g2*4]
+	addc	0,g7,g0
+
+	addo	g2,1,g2
+	cmpobne	0,g2,Loop	# when branch is taken, clears C bit
+
+	ret
diff --git a/src/gmp/mpn/i960/mul_1.s b/src/gmp/mpn/i960/mul_1.s
new file mode 100644
index 000000000..5c0c985aa
--- /dev/null
+++ b/src/gmp/mpn/i960/mul_1.s
@@ -0,0 +1,45 @@
+# I960 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+# the result in a second limb vector.
+
+# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+.text
+	.align	4
+	.globl	___gmpn_mul_1
+___gmpn_mul_1:
+	subo	g2,0,g2
+	shlo	2,g2,g4
+	subo	g4,g1,g1
+	subo	g4,g0,g13
+	mov	0,g0
+
+	cmpo	1,0		# clear C bit on AC.cc
+
+Loop:	ld	(g1)[g2*4],g5
+	emul	g3,g5,g6
+
+	addc	g0,g6,g6	# relies on that C bit is clear
+	st	g6,(g13)[g2*4]
+	addc	0,g7,g0
+
+	addo	g2,1,g2
+	cmpobne	0,g2,Loop	# when branch is taken, clears C bit
+
+	ret
diff --git a/src/gmp/mpn/i960/sub_n.s b/src/gmp/mpn/i960/sub_n.s
new file mode 100644
index 000000000..2db2d46aa
--- /dev/null
+++ b/src/gmp/mpn/i960/sub_n.s
@@ -0,0 +1,43 @@
+# I960 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+# store difference in a third limb vector.
+
+# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+.text
+	.align 4
+	.globl ___gmpn_sub_n
+___gmpn_sub_n:
+	mov	1,g6		# set carry-save register
+	cmpo	1,0		# clear cy
+
+Loop:	subo	1,g3,g3		# update loop counter
+	ld	(g1),g5		# load from s1_ptr
+	addo	4,g1,g1		# s1_ptr++
+	ld	(g2),g4		# load from s2_ptr
+	addo	4,g2,g2		# s2_ptr++
+	cmpo	g6,1		# restore cy from g6, relies on cy being 0
+	subc	g4,g5,g4	# main subtract
+	subc	0,0,g6		# save cy in g6
+	st	g4,(g0)		# store result to res_ptr
+	addo	4,g0,g0		# res_ptr++
+	cmpobne	0,g3,Loop	# when branch is taken, cy will be 0
+
+	mov	g6,g0
+	ret
diff --git a/src/gmp/mpn/lisp/gmpasm-mode.el b/src/gmp/mpn/lisp/gmpasm-mode.el
new file mode 100644
index 000000000..5d9da7fa1
--- /dev/null
+++ b/src/gmp/mpn/lisp/gmpasm-mode.el
@@ -0,0 +1,351 @@
+;;; gmpasm-mode.el -- GNU MP asm and m4 editing mode.
+
+
+;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;;
+;; This file is part of the GNU MP Library.
+;;
+;; The GNU MP Library is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU Lesser General Public License as published by
+;; the Free Software Foundation; either version 2.1 of the License, or (at your
+;; option) any later version.
+;;
+;; The GNU MP Library is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public License
+;; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+;;; Commentary:
+;;
+;; gmpasm-mode is an editing mode for m4 processed assembler code and m4
+;; macro files in GMP.  It's similar to m4-mode, but has a number of
+;; settings better suited to GMP.
+;;
+;;
+;; Install
+;; -------
+;;
+;; To make M-x gmpasm-mode available, put gmpasm-mode.el somewhere in the
+;; load-path and the following in .emacs
+;;
+;;	(autoload 'gmpasm-mode "gmpasm-mode" nil t)
+;;
+;; To use gmpasm-mode automatically on all .asm and .m4 files, put the
+;; following in .emacs
+;;
+;;	(add-to-list 'auto-mode-alist '("\\.asm\\'" . gmpasm-mode))
+;;	(add-to-list 'auto-mode-alist '("\\.m4\\'" . gmpasm-mode))
+;;
+;; To have gmpasm-mode only on gmp files, try instead something like the
+;; following, which uses it only in a directory starting with "gmp", or a
+;; sub-directory of such.
+;;
+;;	(add-to-list 'auto-mode-alist
+;;	             '("/gmp.*/.*\\.\\(asm\\|m4\\)\\'" . gmpasm-mode))
+;;
+;; Byte compiling will slightly speed up loading.  If you want a docstring
+;; in the autoload you can use M-x update-file-autoloads if you set it up
+;; right.
+;;
+;;
+;; Emacsen
+;; -------
+;;
+;; FSF Emacs 20.x - gmpasm-mode is designed for this.
+;; XEmacs 20.x - seems to work.
+;;
+;; FSF Emacs 19.x - should work if replacements for some 20.x-isms are
+;;    available.  comment-region with "C" won't really do the right thing
+;;    though.
+
+
+;;; Code:
+
+(defgroup gmpasm nil
+  "GNU MP m4 and asm editing."
+  :prefix "gmpasm-"
+  :group 'languages)
+
+(defcustom gmpasm-mode-hook nil
+  "*Hook called by `gmpasm-mode'."
+  :type 'hook
+  :group 'gmpasm)
+
+(defcustom gmpasm-comment-start-regexp "[#;!@C]"
+  "*Regexp matching possible comment styles.
+See `gmpasm-mode' docstring for how this is used."
+  :type 'regexp
+  :group 'gmpasm)
+
+
+(defun gmpasm-add-to-list-second (list-var element)
+  "(gmpasm-add-to-list-second LIST-VAR ELEMENT)
+
+Add ELEMENT to LIST-VAR as the second element in the list, if it isn't
+already in the list.  If LIST-VAR is nil, then ELEMENT is just added as the
+sole element in the list.
+
+This is like `add-to-list', but it puts the new value second in the list.
+
+The first cons cell is copied rather than changed in-place, so references to
+the list elsewhere won't be affected."
+
+  (if (member element (symbol-value list-var))
+      (symbol-value list-var)
+    (set list-var
+	 (if (symbol-value list-var)
+	     (cons (car (symbol-value list-var))
+		   (cons element
+			 (cdr (symbol-value list-var))))
+	   (list element)))))
+
+
+(defun gmpasm-delete-from-list (list-var element)
+  "(gmpasm-delete-from-list LIST-VAR ELEMENT)
+
+Delete ELEMENT from LIST-VAR, using `delete'.
+This is like `add-to-list', but the element is deleted from the list.
+The list is copied rather than changed in-place, so references to it elsewhere
+won't be affected."
+
+  (set list-var (delete element (copy-sequence (symbol-value list-var)))))
+
+
+(defvar gmpasm-mode-map
+  (let ((map (make-sparse-keymap)))
+    
+    ;; assembler and dnl commenting
+    (define-key map "\C-c\C-c" 'comment-region)
+    (define-key map "\C-c\C-d" 'gmpasm-comment-region-dnl)
+    
+    ;; kill an M-x compile, since it's not hard to put m4 into an infinite
+    ;; loop
+    (define-key map "\C-c\C-k" 'kill-compilation)
+    
+    map)
+  "Keymap for `gmpasm-mode'.")
+
+
+(defvar gmpasm-mode-syntax-table
+  (let ((table (make-syntax-table)))
+    ;; underscore left as a symbol char, like C mode
+    
+    ;; m4 quotes
+    (modify-syntax-entry ?`  "('"  table)
+    (modify-syntax-entry ?'  ")`"  table)
+
+    table)
+  "Syntax table used in `gmpasm-mode'.
+
+m4 ignores quote marks in # comments at the top level, but inside quotes #
+isn't special and all quotes are active.  There seems no easy way to express
+this in the syntax table, so nothing is done for comments.  Usually this is
+best, since it picks up invalid apostrophes in comments inside quotes.")
+
+
+(defvar gmpasm-font-lock-keywords
+  (eval-when-compile
+    (list
+     (cons
+      (concat
+       "\\b"
+       (regexp-opt
+	'("deflit" "defreg" "defframe" "defframe_pushl"
+	  "define_not_for_expansion"
+	  "ASM_START" "ASM_END" "PROLOGUE" "EPILOGUE"
+	  "forloop"
+	  "TEXT" "DATA" "ALIGN" "W32"
+	  "builtin" "changecom" "changequote" "changeword" "debugfile"
+	  "debugmode" "decr" "define" "defn" "divert" "divnum" "dumpdef"
+	  "errprint" "esyscmd" "eval" "__file__" "format" "gnu" "ifdef"
+	  "ifelse" "include" "incr" "index" "indir" "len" "__line__"
+	  "m4exit" "m4wrap" "maketemp" "patsubst" "popdef" "pushdef"
+	  "regexp" "shift" "sinclude" "substr" "syscmd" "sysval"
+	  "traceoff" "traceon" "translit" "undefine" "undivert" "unix")
+	t)
+       "\\b") 'font-lock-keyword-face)))
+
+  "`font-lock-keywords' for `gmpasm-mode'.
+
+The keywords are m4 builtins and some of the GMP macros used in asm files.
+L and LF don't look good fontified, so they're omitted.
+
+The right assembler comment regexp is added dynamically buffer-local (with
+dnl too).")
+
+
+;; Initialized if gmpasm-mode finds filladapt loaded.
+(defvar gmpasm-filladapt-token-table nil
+  "Filladapt token table used in `gmpasm-mode'.")
+(defvar gmpasm-filladapt-token-match-table nil
+  "Filladapt token match table used in `gmpasm-mode'.")
+(defvar gmpasm-filladapt-token-conversion-table nil
+  "Filladapt token conversion table used in `gmpasm-mode'.")
+
+
+;;;###autoload
+(defun gmpasm-mode ()
+  "A major mode for editing GNU MP asm and m4 files.
+
+\\{gmpasm-mode-map}
+`comment-start' and `comment-end' are set buffer-local to assembler
+commenting appropriate for the CPU by looking for something matching
+`gmpasm-comment-start-regexp' at the start of a line, or \"#\" is used if
+there's no match (if \"#\" isn't what you want, type in a desired comment
+and do \\[gmpasm-mode] to reinitialize).
+
+`adaptive-fill-regexp' is set buffer-local to the standard regexp with
+`comment-start' and dnl added.  If filladapt.el has been loaded it similarly
+gets `comment-start' and dnl added as buffer-local fill prefixes.
+
+Font locking has the m4 builtins, some of the GMP macros, m4 dnl commenting,
+and assembler commenting (based on the `comment-start' determined).
+
+Note that `gmpasm-comment-start-regexp' is only matched as a whole word, so
+the `C' in it is only matched as a whole word, not on something that happens
+to start with `C'.  Also it's only the particular `comment-start' determined
+that's added for filling etc, not the whole `gmpasm-comment-start-regexp'.
+
+`gmpasm-mode-hook' is run after initializations are complete.
+"
+
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'gmpasm-mode
+        mode-name  "gmpasm")
+  (use-local-map gmpasm-mode-map)
+  (set-syntax-table gmpasm-mode-syntax-table)
+  (setq fill-column 76)
+
+  ;; Short instructions might fit with 32, but anything with labels or
+  ;; expressions soon needs the comments pushed out to column 40.
+  (setq comment-column 40)
+
+  ;; Don't want to find out the hard way which dumb assemblers don't like a
+  ;; missing final newline.
+  (set (make-local-variable 'require-final-newline) t)
+
+  ;; The first match of gmpasm-comment-start-regexp at the start of a line
+  ;; determines comment-start, or "#" if no match.
+  (set (make-local-variable 'comment-start)
+       (save-excursion
+	 (goto-char (point-min))
+	 (if (re-search-forward
+	      (concat "^\\(" gmpasm-comment-start-regexp "\\)\\(\\s-\\|$\\)")
+	      nil t)
+	     (match-string 1)
+	   "#")))
+  (set (make-local-variable 'comment-end) "")
+
+  ;; If comment-start ends in an alphanumeric then \b is used to match it
+  ;; only as a separate word.  The test is for an alphanumeric rather than
+  ;; \w since we might try # or ! as \w characters but without wanting \b.
+  (let ((comment-regexp
+	 (concat (regexp-quote comment-start)
+		 (if (string-match "[a-zA-Z0-9]\\'" comment-start) "\\b"))))
+    
+    ;; Whitespace is required before a comment-start so m4 $# doesn't match
+    ;; when comment-start is "#".
+    ;; Only spaces or tabs match after, so newline isn't included in the
+    ;; font lock below.
+    (set (make-local-variable 'comment-start-skip)
+	 (concat "\\(^\\|\\s-\\)" comment-regexp "[ \t]*"))
+
+    ;; Comment fontification based on comment-start, matching through to the
+    ;; end of the line.
+    (add-to-list (make-local-variable 'gmpasm-font-lock-keywords)
+		 (cons (concat
+			"\\(\\bdnl\\b\\|" comment-start-skip "\\).*$")
+		       'font-lock-comment-face))
+
+    (set (make-local-variable 'font-lock-defaults)
+	 '(gmpasm-font-lock-keywords
+	   t	         ; no syntactic fontification (of strings etc)
+	   nil           ; no case-fold
+	   ((?_ . "w"))  ; _ part of a word while fontifying
+	   ))
+
+    ;; Paragraphs are separated by blank lines, or lines with only dnl or
+    ;; comment-start.
+    (set (make-local-variable 'paragraph-separate)
+	 (concat "[ \t\f]*\\(\\(" comment-regexp "\\|dnl\\)[ \t]*\\)*$"))
+    (set (make-local-variable 'paragraph-start)
+	 (concat "\f\\|" paragraph-separate))
+ 
+    ;; Adaptive fill gets dnl and comment-start as comment style prefixes on
+    ;; top of the standard regexp (which has # and ; already actually).
+    (set (make-local-variable 'adaptive-fill-regexp)
+	 (concat "[ \t]*\\(\\("
+		 comment-regexp
+		 "\\|dnl\\|[-|#;>*]+\\|(?[0-9]+[.)]\\)[ \t]*\\)*"))
+    (set (make-local-variable 'adaptive-fill-first-line-regexp)
+	 "\\`\\([ \t]*dnl\\)?[ \t]*\\'")
+
+    (when (fboundp 'filladapt-mode)
+      (when (not gmpasm-filladapt-token-table)
+	(setq gmpasm-filladapt-token-table
+	      filladapt-token-table)
+	(setq gmpasm-filladapt-token-match-table
+	      filladapt-token-match-table)
+	(setq gmpasm-filladapt-token-conversion-table
+	      filladapt-token-conversion-table)
+	
+	;; Numbered bullet points like "2.1" get matched at the start of a
+	;; line when it's really something like "2.1 cycles/limb", so delete
+	;; this from the list.  The regexp for "1.", "2." etc is left
+	;; though.
+	(gmpasm-delete-from-list 'gmpasm-filladapt-token-table
+				 '("[0-9]+\\(\\.[0-9]+\\)+[ \t]"
+				   bullet))
+	  
+	;; "%" as a comment prefix interferes with x86 register names
+	;; like %eax, so delete this.
+	(gmpasm-delete-from-list 'gmpasm-filladapt-token-table
+				 '("%+" postscript-comment))
+	
+	(add-to-list 'gmpasm-filladapt-token-match-table
+		     '(gmpasm-comment gmpasm-comment))
+	(add-to-list 'gmpasm-filladapt-token-conversion-table
+		     '(gmpasm-comment . exact))
+	)
+      
+      (set (make-local-variable 'filladapt-token-table)
+	   gmpasm-filladapt-token-table)
+      (set (make-local-variable 'filladapt-token-match-table)
+	   gmpasm-filladapt-token-match-table)
+      (set (make-local-variable 'filladapt-token-conversion-table)
+	   gmpasm-filladapt-token-conversion-table)
+    
+      ;; Add dnl and comment-start as fill prefixes.
+      ;; Comments in filladapt.el say filladapt-token-table must begin
+      ;; with ("^" beginning-of-line), so put our addition second.
+      (gmpasm-add-to-list-second 'filladapt-token-table
+				 (list (concat "dnl[ \t]\\|" comment-regexp)
+				       'gmpasm-comment))
+      ))
+  
+  (run-hooks 'gmpasm-mode-hook))
+
+
+(defun gmpasm-comment-region-dnl (beg end &optional arg)
+  "(gmpasm-comment-region BEG END &option ARG)
+
+Comment or uncomment each line in the region using `dnl'.
+With \\[universal-argument] prefix arg, uncomment each line in region.
+This is `comment-region', but using \"dnl\"."
+
+  (interactive "r\nP")
+  (let ((comment-start "dnl")
+	(comment-end ""))
+    (comment-region beg end arg)))
+
+
+(provide 'gmpasm-mode)
+
+;;; gmpasm-mode.el ends here
diff --git a/src/gmp/mpn/m68k/add_n.S b/src/gmp/mpn/m68k/add_n.S
new file mode 100644
index 000000000..9e1d89d64
--- /dev/null
+++ b/src/gmp/mpn/m68k/add_n.S
@@ -0,0 +1,79 @@
+/* mc68020 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+   sum in a third limb vector.
+
+Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/*
+  INPUT PARAMETERS
+  res_ptr	(sp + 4)
+  s1_ptr	(sp + 8)
+  s2_ptr	(sp + 16)
+  size		(sp + 12)
+*/
+
+#include "asm-syntax.h"
+
+	TEXT
+	ALIGN
+	GLOBL	C_SYMBOL_NAME(__gmpn_add_n)
+
+C_SYMBOL_NAME(__gmpn_add_n:)
+PROLOG(__gmpn_add_n)
+/* Save used registers on the stack.  */
+	movel	R(d2),MEM_PREDEC(sp)
+	movel	R(a2),MEM_PREDEC(sp)
+
+/* Copy the arguments to registers.  Better use movem?  */
+	movel	MEM_DISP(sp,12),R(a2)
+	movel	MEM_DISP(sp,16),R(a0)
+	movel	MEM_DISP(sp,20),R(a1)
+	movel	MEM_DISP(sp,24),R(d2)
+
+	eorw	#1,R(d2)
+	lsrl	#1,R(d2)
+	bcc	L(L1)
+	subql	#1,R(d2)	/* clears cy as side effect */
+
+L(Loop:)
+	movel	MEM_POSTINC(a0),R(d0)
+	movel	MEM_POSTINC(a1),R(d1)
+	addxl	R(d1),R(d0)
+	movel	R(d0),MEM_POSTINC(a2)
+L(L1:)	movel	MEM_POSTINC(a0),R(d0)
+	movel	MEM_POSTINC(a1),R(d1)
+	addxl	R(d1),R(d0)
+	movel	R(d0),MEM_POSTINC(a2)
+
+	dbf	R(d2),L(Loop)		/* loop until 16 lsb of %4 == -1 */
+	subxl	R(d0),R(d0)	/* d0 <= -cy; save cy as 0 or -1 in d0 */
+	subl	#0x10000,R(d2)
+	bcs	L(L2)
+	addl	R(d0),R(d0)	/* restore cy */
+	bra	L(Loop)
+
+L(L2:)
+	negl	R(d0)
+
+/* Restore used registers from stack frame.  */
+	movel	MEM_POSTINC(sp),R(a2)
+	movel	MEM_POSTINC(sp),R(d2)
+
+	rts
+EPILOG(__gmpn_add_n)
diff --git a/src/gmp/mpn/m68k/lshift.S b/src/gmp/mpn/m68k/lshift.S
new file mode 100644
index 000000000..a539d5d42
--- /dev/null
+++ b/src/gmp/mpn/m68k/lshift.S
@@ -0,0 +1,150 @@
+/* mc68020 __gmpn_lshift -- Shift left a low-level natural-number integer.
+
+Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/*
+  INPUT PARAMETERS
+  res_ptr	(sp + 4)
+  s_ptr		(sp + 8)
+  s_size	(sp + 16)
+  cnt		(sp + 12)
+*/
+
+#include "asm-syntax.h"
+
+#define res_ptr a1
+#define s_ptr a0
+#define s_size d6
+#define cnt d4
+
+	TEXT
+	ALIGN
+	GLOBL	C_SYMBOL_NAME(__gmpn_lshift)
+
+C_SYMBOL_NAME(__gmpn_lshift:)
+PROLOG(__gmpn_lshift)
+
+/* Save used registers on the stack.  */
+	moveml	R(d2)-R(d6)/R(a2),MEM_PREDEC(sp)
+
+/* Copy the arguments to registers.  */
+	movel	MEM_DISP(sp,28),R(res_ptr)
+	movel	MEM_DISP(sp,32),R(s_ptr)
+	movel	MEM_DISP(sp,36),R(s_size)
+	movel	MEM_DISP(sp,40),R(cnt)
+
+	moveql	#1,R(d5)
+	cmpl	R(d5),R(cnt)
+	bne	L(Lnormal)
+	cmpl	R(s_ptr),R(res_ptr)
+	bls	L(Lspecial)		/* jump if s_ptr >= res_ptr */
+#if (defined (__mc68020__) || defined (__NeXT__) || defined(mc68020))
+	lea	MEM_INDX1(s_ptr,s_size,l,4),R(a2)
+#else /* not mc68020 */
+	movel	R(s_size),R(d0)
+	asll	#2,R(d0)
+	lea	MEM_INDX(s_ptr,d0,l),R(a2)
+#endif
+	cmpl	R(res_ptr),R(a2)
+	bls	L(Lspecial)		/* jump if res_ptr >= s_ptr + s_size */
+
+L(Lnormal:)
+	moveql	#32,R(d5)
+	subl	R(cnt),R(d5)
+
+#if (defined (__mc68020__) || defined (__NeXT__) || defined(mc68020))
+	lea	MEM_INDX1(s_ptr,s_size,l,4),R(s_ptr)
+	lea	MEM_INDX1(res_ptr,s_size,l,4),R(res_ptr)
+#else /* not mc68000 */
+	movel	R(s_size),R(d0)
+	asll	#2,R(d0)
+	addl	R(s_size),R(s_ptr)
+	addl	R(s_size),R(res_ptr)
+#endif
+	movel	MEM_PREDEC(s_ptr),R(d2)
+	movel	R(d2),R(d0)
+	lsrl	R(d5),R(d0)		/* compute carry limb */
+
+	lsll	R(cnt),R(d2)
+	movel	R(d2),R(d1)
+	subql	#1,R(s_size)
+	beq	L(Lend)
+	lsrl	#1,R(s_size)
+	bcs	L(L1)
+	subql	#1,R(s_size)
+
+L(Loop:)
+	movel	MEM_PREDEC(s_ptr),R(d2)
+	movel	R(d2),R(d3)
+	lsrl	R(d5),R(d3)
+	orl	R(d3),R(d1)
+	movel	R(d1),MEM_PREDEC(res_ptr)
+	lsll	R(cnt),R(d2)
+L(L1:)
+	movel	MEM_PREDEC(s_ptr),R(d1)
+	movel	R(d1),R(d3)
+	lsrl	R(d5),R(d3)
+	orl	R(d3),R(d2)
+	movel	R(d2),MEM_PREDEC(res_ptr)
+	lsll	R(cnt),R(d1)
+
+	dbf	R(s_size),L(Loop)
+	subl	#0x10000,R(s_size)
+	bcc	L(Loop)
+
+L(Lend:)
+	movel	R(d1),MEM_PREDEC(res_ptr) /* store least significant limb */
+
+/* Restore used registers from stack frame.  */
+	moveml	MEM_POSTINC(sp),R(d2)-R(d6)/R(a2)
+	rts
+
+/* We loop from least significant end of the arrays, which is only
+   permissable if the source and destination don't overlap, since the
+   function is documented to work for overlapping source and destination.  */
+
+L(Lspecial:)
+	clrl	R(d0)			/* initialize carry */
+	eorw	#1,R(s_size)
+	lsrl	#1,R(s_size)
+	bcc	L(LL1)
+	subql	#1,R(s_size)
+
+L(LLoop:)
+	movel	MEM_POSTINC(s_ptr),R(d2)
+	addxl	R(d2),R(d2)
+	movel	R(d2),MEM_POSTINC(res_ptr)
+L(LL1:)
+	movel	MEM_POSTINC(s_ptr),R(d2)
+	addxl	R(d2),R(d2)
+	movel	R(d2),MEM_POSTINC(res_ptr)
+
+	dbf	R(s_size),L(LLoop)
+	addxl	R(d0),R(d0)		/* save cy in lsb */
+	subl	#0x10000,R(s_size)
+	bcs	L(LLend)
+	lsrl	#1,R(d0)		/* restore cy */
+	bra	L(LLoop)
+
+L(LLend:)
+/* Restore used registers from stack frame.  */
+	moveml	MEM_POSTINC(sp),R(d2)-R(d6)/R(a2)
+	rts
+EPILOG(__gmpn_lshift)
diff --git a/src/gmp/mpn/m68k/mc68020/addmul_1.S b/src/gmp/mpn/m68k/mc68020/addmul_1.S
new file mode 100644
index 000000000..6638115d7
--- /dev/null
+++ b/src/gmp/mpn/m68k/mc68020/addmul_1.S
@@ -0,0 +1,83 @@
+/* mc68020 __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
+   the result to a second limb vector.
+
+Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/*
+  INPUT PARAMETERS
+  res_ptr	(sp + 4)
+  s1_ptr	(sp + 8)
+  s1_size	(sp + 12)
+  s2_limb	(sp + 16)
+*/
+
+#include "asm-syntax.h"
+
+	TEXT
+	ALIGN
+	GLOBL	C_SYMBOL_NAME(__gmpn_addmul_1)
+
+C_SYMBOL_NAME(__gmpn_addmul_1:)
+PROLOG(__gmpn_addmul_1)
+
+#define res_ptr a0
+#define s1_ptr a1
+#define s1_size d2
+#define s2_limb d4
+
+/* Save used registers on the stack.  */
+	moveml	R(d2)-R(d5),MEM_PREDEC(sp)
+
+/* Copy the arguments to registers.  Better use movem?  */
+	movel	MEM_DISP(sp,20),R(res_ptr)
+	movel	MEM_DISP(sp,24),R(s1_ptr)
+	movel	MEM_DISP(sp,28),R(s1_size)
+	movel	MEM_DISP(sp,32),R(s2_limb)
+
+	eorw	#1,R(s1_size)
+	clrl	R(d1)
+	clrl	R(d5)
+	lsrl	#1,R(s1_size)
+	bcc	L(L1)
+	subql	#1,R(s1_size)
+	subl	R(d0),R(d0)		/* (d0,cy) <= (0,0) */
+
+L(Loop:)
+	movel	MEM_POSTINC(s1_ptr),R(d3)
+	mulul	R(s2_limb),R(d1):R(d3)
+	addxl	R(d0),R(d3)
+	addxl	R(d5),R(d1)
+	addl	R(d3),MEM_POSTINC(res_ptr)
+L(L1:)	movel	MEM_POSTINC(s1_ptr),R(d3)
+	mulul	R(s2_limb),R(d0):R(d3)
+	addxl	R(d1),R(d3)
+	addxl	R(d5),R(d0)
+	addl	R(d3),MEM_POSTINC(res_ptr)
+
+	dbf	R(s1_size),L(Loop)
+	addxl	R(d5),R(d0)
+	subl	#0x10000,R(s1_size)
+	bcc	L(Loop)
+
+/* Restore used registers from stack frame.  */
+	moveml	MEM_POSTINC(sp),R(d2)-R(d5)
+
+	rts
+EPILOG(__gmpn_addmul_1)
diff --git a/src/gmp/mpn/m68k/mc68020/mul_1.S b/src/gmp/mpn/m68k/mc68020/mul_1.S
new file mode 100644
index 000000000..fdd4c39d7
--- /dev/null
+++ b/src/gmp/mpn/m68k/mc68020/mul_1.S
@@ -0,0 +1,90 @@
+/* mc68020 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+   the result in a second limb vector.
+
+Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/*
+  INPUT PARAMETERS
+  res_ptr	(sp + 4)
+  s1_ptr	(sp + 8)
+  s1_size	(sp + 12)
+  s2_limb	(sp + 16)
+*/
+
+#include "asm-syntax.h"
+
+	TEXT
+	ALIGN
+	GLOBL	C_SYMBOL_NAME(__gmpn_mul_1)
+
+C_SYMBOL_NAME(__gmpn_mul_1:)
+PROLOG(__gmpn_mul_1)
+
+#define res_ptr a0
+#define s1_ptr a1
+#define s1_size d2
+#define s2_limb d4
+
+/* Save used registers on the stack.  */
+	moveml	R(d2)-R(d4),MEM_PREDEC(sp)
+#if 0
+	movel	R(d2),MEM_PREDEC(sp)
+	movel	R(d3),MEM_PREDEC(sp)
+	movel	R(d4),MEM_PREDEC(sp)
+#endif
+
+/* Copy the arguments to registers.  Better use movem?  */
+	movel	MEM_DISP(sp,16),R(res_ptr)
+	movel	MEM_DISP(sp,20),R(s1_ptr)
+	movel	MEM_DISP(sp,24),R(s1_size)
+	movel	MEM_DISP(sp,28),R(s2_limb)
+
+	eorw	#1,R(s1_size)
+	clrl	R(d1)
+	lsrl	#1,R(s1_size)
+	bcc	L(L1)
+	subql	#1,R(s1_size)
+	subl	R(d0),R(d0)	/* (d0,cy) <= (0,0) */
+
+L(Loop:)
+	movel	MEM_POSTINC(s1_ptr),R(d3)
+	mulul	R(s2_limb),R(d1):R(d3)
+	addxl	R(d0),R(d3)
+	movel	R(d3),MEM_POSTINC(res_ptr)
+L(L1:)	movel	MEM_POSTINC(s1_ptr),R(d3)
+	mulul	R(s2_limb),R(d0):R(d3)
+	addxl	R(d1),R(d3)
+	movel	R(d3),MEM_POSTINC(res_ptr)
+
+	dbf	R(s1_size),L(Loop)
+	clrl	R(d3)
+	addxl	R(d3),R(d0)
+	subl	#0x10000,R(s1_size)
+	bcc	L(Loop)
+
+/* Restore used registers from stack frame.  */
+	moveml	MEM_POSTINC(sp),R(d2)-R(d4)
+#if 0
+	movel	MEM_POSTINC(sp),R(d4)
+	movel	MEM_POSTINC(sp),R(d3)
+	movel	MEM_POSTINC(sp),R(d2)
+#endif
+	rts
+EPILOG(__gmpn_mul_1)
diff --git a/src/gmp/mpn/m68k/mc68020/submul_1.S b/src/gmp/mpn/m68k/mc68020/submul_1.S
new file mode 100644
index 000000000..3c36b7016
--- /dev/null
+++ b/src/gmp/mpn/m68k/mc68020/submul_1.S
@@ -0,0 +1,83 @@
+/* mc68020 __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
+   the result from a second limb vector.
+
+Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/*
+  INPUT PARAMETERS
+  res_ptr	(sp + 4)
+  s1_ptr	(sp + 8)
+  s1_size	(sp + 12)
+  s2_limb	(sp + 16)
+*/
+
+#include "asm-syntax.h"
+
+	TEXT
+	ALIGN
+	GLOBL	C_SYMBOL_NAME(__gmpn_submul_1)
+
+C_SYMBOL_NAME(__gmpn_submul_1:)
+PROLOG(__gmpn_submul_1)
+
+#define res_ptr a0
+#define s1_ptr a1
+#define s1_size d2
+#define s2_limb d4
+
+/* Save used registers on the stack.  */
+	moveml	R(d2)-R(d5),MEM_PREDEC(sp)
+
+/* Copy the arguments to registers.  Better use movem?  */
+	movel	MEM_DISP(sp,20),R(res_ptr)
+	movel	MEM_DISP(sp,24),R(s1_ptr)
+	movel	MEM_DISP(sp,28),R(s1_size)
+	movel	MEM_DISP(sp,32),R(s2_limb)
+
+	eorw	#1,R(s1_size)
+	clrl	R(d1)
+	clrl	R(d5)
+	lsrl	#1,R(s1_size)
+	bcc	L(L1)
+	subql	#1,R(s1_size)
+	subl	R(d0),R(d0)	/* (d0,cy) <= (0,0) */
+
+L(Loop:)
+	movel	MEM_POSTINC(s1_ptr),R(d3)
+	mulul	R(s2_limb),R(d1):R(d3)
+	addxl	R(d0),R(d3)
+	addxl	R(d5),R(d1)
+	subl	R(d3),MEM_POSTINC(res_ptr)
+L(L1:)	movel	MEM_POSTINC(s1_ptr),R(d3)
+	mulul	R(s2_limb),R(d0):R(d3)
+	addxl	R(d1),R(d3)
+	addxl	R(d5),R(d0)
+	subl	R(d3),MEM_POSTINC(res_ptr)
+
+	dbf	R(s1_size),L(Loop)
+	addxl	R(d5),R(d0)
+	subl	#0x10000,R(s1_size)
+	bcc	L(Loop)
+
+/* Restore used registers from stack frame.  */
+	moveml	MEM_POSTINC(sp),R(d2)-R(d5)
+
+	rts
+EPILOG(__gmpn_submul_1)
diff --git a/src/gmp/mpn/m68k/mc68020/udiv.S b/src/gmp/mpn/m68k/mc68020/udiv.S
new file mode 100644
index 000000000..d00cf1355
--- /dev/null
+++ b/src/gmp/mpn/m68k/mc68020/udiv.S
@@ -0,0 +1,31 @@
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+.text
+	.even
+.globl ___udiv_qrnnd
+___udiv_qrnnd:
+	movel sp@(4),a0
+	movel sp@(8),d1
+	movel sp@(12),d0
+	divul sp@(16),d1:d0
+	movel d1,a0@
+	rts
diff --git a/src/gmp/mpn/m68k/mc68020/umul.S b/src/gmp/mpn/m68k/mc68020/umul.S
new file mode 100644
index 000000000..a34ae6c54
--- /dev/null
+++ b/src/gmp/mpn/m68k/mc68020/umul.S
@@ -0,0 +1,31 @@
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+.text
+	.even
+.globl ___umul_ppmm
+___umul_ppmm:
+	movel sp@(4),a0
+	movel sp@(8),d1
+	movel sp@(12),d0
+	mulul d0,d0:d1
+	movel d1,a0@
+	rts
diff --git a/src/gmp/mpn/m68k/rshift.S b/src/gmp/mpn/m68k/rshift.S
new file mode 100644
index 000000000..b47a48e52
--- /dev/null
+++ b/src/gmp/mpn/m68k/rshift.S
@@ -0,0 +1,149 @@
+/* mc68020 __gmpn_rshift -- Shift right a low-level natural-number integer.
+
+Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/*
+  INPUT PARAMETERS
+  res_ptr	(sp + 4)
+  s_ptr		(sp + 8)
+  s_size	(sp + 16)
+  cnt		(sp + 12)
+*/
+
+#include "asm-syntax.h"
+
+#define res_ptr a1
+#define s_ptr a0
+#define s_size d6
+#define cnt d4
+
+	TEXT
+	ALIGN
+	GLOBL	C_SYMBOL_NAME(__gmpn_rshift)
+
+C_SYMBOL_NAME(__gmpn_rshift:)
+PROLOG(__gmpn_rshift)
+/* Save used registers on the stack.  */
+	moveml	R(d2)-R(d6)/R(a2),MEM_PREDEC(sp)
+
+/* Copy the arguments to registers.  */
+	movel	MEM_DISP(sp,28),R(res_ptr)
+	movel	MEM_DISP(sp,32),R(s_ptr)
+	movel	MEM_DISP(sp,36),R(s_size)
+	movel	MEM_DISP(sp,40),R(cnt)
+
+	moveql	#1,R(d5)
+	cmpl	R(d5),R(cnt)
+	bne	L(Lnormal)
+	cmpl	R(res_ptr),R(s_ptr)
+	bls	L(Lspecial)		/* jump if res_ptr >= s_ptr */
+#if (defined (__mc68020__) || defined (__NeXT__) || defined(mc68020))
+	lea	MEM_INDX1(res_ptr,s_size,l,4),R(a2)
+#else /* not mc68020 */
+	movel	R(s_size),R(d0)
+	asll	#2,R(d0)
+	lea	MEM_INDX(res_ptr,d0,l),R(a2)
+#endif
+	cmpl	R(s_ptr),R(a2)
+	bls	L(Lspecial)		/* jump if s_ptr >= res_ptr + s_size */
+
+L(Lnormal:)
+	moveql	#32,R(d5)
+	subl	R(cnt),R(d5)
+	movel	MEM_POSTINC(s_ptr),R(d2)
+	movel	R(d2),R(d0)
+	lsll	R(d5),R(d0)		/* compute carry limb */
+
+	lsrl	R(cnt),R(d2)
+	movel	R(d2),R(d1)
+	subql	#1,R(s_size)
+	beq	L(Lend)
+	lsrl	#1,R(s_size)
+	bcs	L(L1)
+	subql	#1,R(s_size)
+
+L(Loop:)
+	movel	MEM_POSTINC(s_ptr),R(d2)
+	movel	R(d2),R(d3)
+	lsll	R(d5),R(d3)
+	orl	R(d3),R(d1)
+	movel	R(d1),MEM_POSTINC(res_ptr)
+	lsrl	R(cnt),R(d2)
+L(L1:)
+	movel	MEM_POSTINC(s_ptr),R(d1)
+	movel	R(d1),R(d3)
+	lsll	R(d5),R(d3)
+	orl	R(d3),R(d2)
+	movel	R(d2),MEM_POSTINC(res_ptr)
+	lsrl	R(cnt),R(d1)
+
+	dbf	R(s_size),L(Loop)
+	subl	#0x10000,R(s_size)
+	bcc	L(Loop)
+
+L(Lend:)
+	movel	R(d1),MEM(res_ptr) /* store most significant limb */
+
+/* Restore used registers from stack frame.  */
+	moveml	MEM_POSTINC(sp),R(d2)-R(d6)/R(a2)
+	rts
+
+/* We loop from most significant end of the arrays, which is only
+   permissable if the source and destination don't overlap, since the
+   function is documented to work for overlapping source and destination.  */
+
+L(Lspecial:)
+#if (defined (__mc68020__) || defined (__NeXT__) || defined(mc68020))
+	lea	MEM_INDX1(s_ptr,s_size,l,4),R(s_ptr)
+	lea	MEM_INDX1(res_ptr,s_size,l,4),R(res_ptr)
+#else /* not mc68000 */
+	movel	R(s_size),R(d0)
+	asll	#2,R(d0)
+	addl	R(s_size),R(s_ptr)
+	addl	R(s_size),R(res_ptr)
+#endif
+
+	clrl	R(d0)			/* initialize carry */
+	eorw	#1,R(s_size)
+	lsrl	#1,R(s_size)
+	bcc	L(LL1)
+	subql	#1,R(s_size)
+
+L(LLoop:)
+	movel	MEM_PREDEC(s_ptr),R(d2)
+	roxrl	#1,R(d2)
+	movel	R(d2),MEM_PREDEC(res_ptr)
+L(LL1:)
+	movel	MEM_PREDEC(s_ptr),R(d2)
+	roxrl	#1,R(d2)
+	movel	R(d2),MEM_PREDEC(res_ptr)
+
+	dbf	R(s_size),L(LLoop)
+	roxrl	#1,R(d0)		/* save cy in msb */
+	subl	#0x10000,R(s_size)
+	bcs	L(LLend)
+	addl	R(d0),R(d0)		/* restore cy */
+	bra	L(LLoop)
+
+L(LLend:)
+/* Restore used registers from stack frame.  */
+	moveml	MEM_POSTINC(sp),R(d2)-R(d6)/R(a2)
+	rts
+EPILOG(__gmpn_rshift)
diff --git a/src/gmp/mpn/m68k/sub_n.S b/src/gmp/mpn/m68k/sub_n.S
new file mode 100644
index 000000000..ce45b24db
--- /dev/null
+++ b/src/gmp/mpn/m68k/sub_n.S
@@ -0,0 +1,79 @@
+/* mc68020 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+   store difference in a third limb vector.
+
+Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/*
+  INPUT PARAMETERS
+  res_ptr	(sp + 4)
+  s1_ptr	(sp + 8)
+  s2_ptr	(sp + 16)
+  size		(sp + 12)
+*/
+
+#include "asm-syntax.h"
+
+	TEXT
+	ALIGN
+	GLOBL	C_SYMBOL_NAME(__gmpn_sub_n)
+
+C_SYMBOL_NAME(__gmpn_sub_n:)
+PROLOG(__gmpn_sub_n)
+/* Save used registers on the stack.  */
+	movel	R(d2),MEM_PREDEC(sp)
+	movel	R(a2),MEM_PREDEC(sp)
+
+/* Copy the arguments to registers.  Better use movem?  */
+	movel	MEM_DISP(sp,12),R(a2)
+	movel	MEM_DISP(sp,16),R(a0)
+	movel	MEM_DISP(sp,20),R(a1)
+	movel	MEM_DISP(sp,24),R(d2)
+
+	eorw	#1,R(d2)
+	lsrl	#1,R(d2)
+	bcc	L(L1)
+	subql	#1,R(d2)	/* clears cy as side effect */
+
+L(Loop:)
+	movel	MEM_POSTINC(a0),R(d0)
+	movel	MEM_POSTINC(a1),R(d1)
+	subxl	R(d1),R(d0)
+	movel	R(d0),MEM_POSTINC(a2)
+L(L1:)	movel	MEM_POSTINC(a0),R(d0)
+	movel	MEM_POSTINC(a1),R(d1)
+	subxl	R(d1),R(d0)
+	movel	R(d0),MEM_POSTINC(a2)
+
+	dbf	R(d2),L(Loop)		/* loop until 16 lsb of %4 == -1 */
+	subxl	R(d0),R(d0)	/* d0 <= -cy; save cy as 0 or -1 in d0 */
+	subl	#0x10000,R(d2)
+	bcs	L(L2)
+	addl	R(d0),R(d0)	/* restore cy */
+	bra	L(Loop)
+
+L(L2:)
+	negl	R(d0)
+
+/* Restore used registers from stack frame.  */
+	movel	MEM_POSTINC(sp),R(a2)
+	movel	MEM_POSTINC(sp),R(d2)
+
+	rts
+EPILOG(__gmpn_sub_n)
diff --git a/src/gmp/mpn/m68k/syntax.h b/src/gmp/mpn/m68k/syntax.h
new file mode 100644
index 000000000..9eec279c0
--- /dev/null
+++ b/src/gmp/mpn/m68k/syntax.h
@@ -0,0 +1,177 @@
+/* asm.h -- Definitions for 68k syntax variations.
+
+Copyright (C) 1992, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.  */
+
+#undef ALIGN
+
+#ifdef MIT_SYNTAX
+#define PROLOG(name)
+#define EPILOG(name)
+#define R(r)r
+#define MEM(base)base@
+#define MEM_DISP(base,displacement)base@(displacement)
+#define MEM_INDX(base,idx,size_suffix)base@(idx:size_suffix)
+#define MEM_INDX1(base,idx,size_suffix,scale)base@(idx:size_suffix:scale)
+#define MEM_PREDEC(memory_base)memory_base@-
+#define MEM_POSTINC(memory_base)memory_base@+
+#define L(label) label
+#define TEXT .text
+#define ALIGN .even
+#define GLOBL .globl
+#define moveql moveq
+/* Use variable sized opcodes.  */
+#define bcc jcc
+#define bcs jcs
+#define bls jls
+#define beq jeq
+#define bne jne
+#define bra jra
+#endif
+
+#ifdef SONY_SYNTAX
+#define PROLOG(name)
+#define EPILOG(name)
+#define R(r)r
+#define MEM(base)(base)
+#define MEM_DISP(base,displacement)(displacement,base)
+#define MEM_INDX(base,idx,size_suffix)(base,idx.size_suffix)
+#define MEM_INDX1(base,idx,size_suffix,scale)(base,idx.size_suffix*scale)
+#define MEM_PREDEC(memory_base)-(memory_base)
+#define MEM_POSTINC(memory_base)(memory_base)+
+#define L(label) label
+#define TEXT .text
+#define ALIGN .even
+#define GLOBL .globl
+#endif
+
+#ifdef MOTOROLA_SYNTAX
+#define PROLOG(name)
+#define EPILOG(name)
+#define R(r)r
+#define MEM(base)(base)
+#define MEM_DISP(base,displacement)(displacement,base)
+#define MEM_INDX(base,idx,size_suffix)(base,idx.size_suffix)
+#define MEM_INDX1(base,idx,size_suffix,scale)(base,idx.size_suffix*scale)
+#define MEM_PREDEC(memory_base)-(memory_base)
+#define MEM_POSTINC(memory_base)(memory_base)+
+#define L(label) label
+#define TEXT
+#define ALIGN
+#define GLOBL XDEF
+#define lea LEA
+#define movel MOVE.L
+#define moveml MOVEM.L
+#define moveql MOVEQ.L
+#define cmpl CMP.L
+#define orl OR.L
+#define clrl CLR.L
+#define eorw EOR.W
+#define lsrl LSR.L
+#define lsll LSL.L
+#define roxrl ROXR.L
+#define roxll ROXL.L
+#define addl ADD.L
+#define addxl ADDX.L
+#define addql ADDQ.L
+#define subl SUB.L
+#define subxl SUBX.L
+#define subql SUBQ.L
+#define negl NEG.L
+#define mulul MULU.L
+#define bcc BCC
+#define bcs BCS
+#define bls BLS
+#define beq BEQ
+#define bne BNE
+#define bra BRA
+#define dbf DBF
+#define rts RTS
+#define d0 D0
+#define d1 D1
+#define d2 D2
+#define d3 D3
+#define d4 D4
+#define d5 D5
+#define d6 D6
+#define d7 D7
+#define a0 A0
+#define a1 A1
+#define a2 A2
+#define a3 A3
+#define a4 A4
+#define a5 A5
+#define a6 A6
+#define a7 A7
+#define sp SP
+#endif
+
+#ifdef ELF_SYNTAX
+#define PROLOG(name) .type name,@function
+#define EPILOG(name) .size name,.-name
+#define MEM(base)(R(base))
+#define MEM_DISP(base,displacement)(displacement,R(base))
+#define MEM_PREDEC(memory_base)-(R(memory_base))
+#define MEM_POSTINC(memory_base)(R(memory_base))+
+#ifdef __STDC__
+#define R_(r)%##r
+#define R(r)R_(r)
+#define MEM_INDX_(base,idx,size_suffix)(R(base),R(idx##.##size_suffix))
+#define MEM_INDX(base,idx,size_suffix)MEM_INDX_(base,idx,size_suffix)
+#define MEM_INDX1_(base,idx,size_suffix,scale)(R(base),R(idx##.##size_suffix*scale))
+#define MEM_INDX1(base,idx,size_suffix,scale)MEM_INDX1_(base,idx,size_suffix,scale)
+#define L(label) .##label
+#else
+#define R(r)%/**/r
+#define MEM_INDX(base,idx,size_suffix)(R(base),R(idx).size_suffix)
+#define MEM_INDX1(base,idx,size_suffix,scale)(R(base),R(idx).size_suffix*scale)
+#define L(label) ./**/label
+#endif
+#define TEXT .text
+#define ALIGN .align 2
+#define GLOBL .globl
+#define bcc jbcc
+#define bcs jbcs
+#define bls jbls
+#define beq jbeq
+#define bne jbne
+#define bra jbra
+#endif
+
+#if defined (SONY_SYNTAX) || defined (ELF_SYNTAX)
+#define movel move.l
+#define moveml movem.l
+#define moveql moveq.l
+#define cmpl cmp.l
+#define orl or.l
+#define clrl clr.l
+#define eorw eor.w
+#define lsrl lsr.l
+#define lsll lsl.l
+#define roxrl roxr.l
+#define roxll roxl.l
+#define addl add.l
+#define addxl addx.l
+#define addql addq.l
+#define subl sub.l
+#define subxl subx.l
+#define subql subq.l
+#define negl neg.l
+#define mulul mulu.l
+#endif
diff --git a/src/gmp/mpn/m88k/add_n.s b/src/gmp/mpn/m88k/add_n.s
new file mode 100644
index 000000000..0b776c618
--- /dev/null
+++ b/src/gmp/mpn/m88k/add_n.s
@@ -0,0 +1,104 @@
+; mc88100 __gmpn_add -- Add two limb vectors of the same length > 0 and store
+; sum in a third limb vector.
+
+; Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	r2
+; s1_ptr	r3
+; s2_ptr	r4
+; size		r5
+
+; This code has been optimized to run one instruction per clock, avoiding
+; load stalls and writeback contention.  As a result, the instruction
+; order is not always natural.
+
+; The speed is about 4.6 clocks/limb + 18 clocks/limb-vector on an 88100,
+; but on the 88110, it seems to run much slower, 6.6 clocks/limb.
+
+	text
+	align	 16
+	global	 ___gmpn_add_n
+___gmpn_add_n:
+	ld	r6,r3,0			; read first limb from s1_ptr
+	extu	r10,r5,3
+	ld	r7,r4,0			; read first limb from s2_ptr
+
+	subu.co	r5,r0,r5		; (clear carry as side effect)
+	mak	r5,r5,3<4>
+	bcnd	eq0,r5,Lzero
+
+	or	r12,r0,lo16(Lbase)
+	or.u	r12,r12,hi16(Lbase)
+	addu	r12,r12,r5		; r12 is address for entering in loop
+
+	extu	r5,r5,2			; divide by 4
+	subu	r2,r2,r5		; adjust res_ptr
+	subu	r3,r3,r5		; adjust s1_ptr
+	subu	r4,r4,r5		; adjust s2_ptr
+
+	or	r8,r6,r0
+
+	jmp.n	r12
+	 or	r9,r7,r0
+
+Loop:	addu	r3,r3,32
+	st	r8,r2,28
+	addu	r4,r4,32
+	ld	r6,r3,0
+	addu	r2,r2,32
+	ld	r7,r4,0
+Lzero:	subu	r10,r10,1		; add 0 + 8r limbs (adj loop cnt)
+Lbase:	ld	r8,r3,4
+	addu.cio r6,r6,r7
+	ld	r9,r4,4
+	st	r6,r2,0
+	ld	r6,r3,8			; add 7 + 8r limbs
+	addu.cio r8,r8,r9
+	ld	r7,r4,8
+	st	r8,r2,4
+	ld	r8,r3,12		; add 6 + 8r limbs
+	addu.cio r6,r6,r7
+	ld	r9,r4,12
+	st	r6,r2,8
+	ld	r6,r3,16		; add 5 + 8r limbs
+	addu.cio r8,r8,r9
+	ld	r7,r4,16
+	st	r8,r2,12
+	ld	r8,r3,20		; add 4 + 8r limbs
+	addu.cio r6,r6,r7
+	ld	r9,r4,20
+	st	r6,r2,16
+	ld	r6,r3,24		; add 3 + 8r limbs
+	addu.cio r8,r8,r9
+	ld	r7,r4,24
+	st	r8,r2,20
+	ld	r8,r3,28		; add 2 + 8r limbs
+	addu.cio r6,r6,r7
+	ld	r9,r4,28
+	st	r6,r2,24
+	bcnd.n	ne0,r10,Loop		; add 1 + 8r limbs
+	 addu.cio r8,r8,r9
+
+	st	r8,r2,28		; store most significant limb
+
+	jmp.n	 r1
+	 addu.ci r2,r0,r0		; return carry-out from most sign. limb
diff --git a/src/gmp/mpn/m88k/mc88110/add_n.S b/src/gmp/mpn/m88k/mc88110/add_n.S
new file mode 100644
index 000000000..843a50dde
--- /dev/null
+++ b/src/gmp/mpn/m88k/mc88110/add_n.S
@@ -0,0 +1,200 @@
+; mc88110 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+; sum in a third limb vector.
+
+; Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+#define res_ptr	r2
+#define s1_ptr	r3
+#define s2_ptr	r4
+#define size	r5
+
+#include "sysdep.h"
+
+	text
+	align	16
+	global	C_SYMBOL_NAME(__gmpn_add_n)
+C_SYMBOL_NAME(__gmpn_add_n):
+	addu.co	 r0,r0,r0		; clear cy flag
+	xor	 r12,s2_ptr,res_ptr
+	bb1	 2,r12,L1
+; **  V1a  **
+L0:	bb0	 2,res_ptr,L_v1		; branch if res_ptr is aligned?
+/* Add least significant limb separately to align res_ptr and s2_ptr */
+	ld	 r10,s1_ptr,0
+	addu	 s1_ptr,s1_ptr,4
+	ld	 r8,s2_ptr,0
+	addu	 s2_ptr,s2_ptr,4
+	subu	 size,size,1
+	addu.co	 r6,r10,r8
+	st	 r6,res_ptr,0
+	addu	 res_ptr,res_ptr,4
+L_v1:	cmp	 r12,size,2
+	bb1	 lt,r12,Lend2
+
+	ld	 r10,s1_ptr,0
+	ld	 r12,s1_ptr,4
+	ld.d	 r8,s2_ptr,0
+	subu	 size,size,10
+	bcnd	 lt0,size,Lfin1
+/* Add blocks of 8 limbs until less than 8 limbs remain */
+	align	 8
+Loop1:	subu	 size,size,8
+	addu.cio r6,r10,r8
+	ld	 r10,s1_ptr,8
+	addu.cio r7,r12,r9
+	ld	 r12,s1_ptr,12
+	ld.d	 r8,s2_ptr,8
+	st.d	 r6,res_ptr,0
+	addu.cio r6,r10,r8
+	ld	 r10,s1_ptr,16
+	addu.cio r7,r12,r9
+	ld	 r12,s1_ptr,20
+	ld.d	 r8,s2_ptr,16
+	st.d	 r6,res_ptr,8
+	addu.cio r6,r10,r8
+	ld	 r10,s1_ptr,24
+	addu.cio r7,r12,r9
+	ld	 r12,s1_ptr,28
+	ld.d	 r8,s2_ptr,24
+	st.d	 r6,res_ptr,16
+	addu.cio r6,r10,r8
+	ld	 r10,s1_ptr,32
+	addu.cio r7,r12,r9
+	ld	 r12,s1_ptr,36
+	addu	 s1_ptr,s1_ptr,32
+	ld.d	 r8,s2_ptr,32
+	addu	 s2_ptr,s2_ptr,32
+	st.d	 r6,res_ptr,24
+	addu	 res_ptr,res_ptr,32
+	bcnd	 ge0,size,Loop1
+
+Lfin1:	addu	 size,size,8-2
+	bcnd	 lt0,size,Lend1
+/* Add blocks of 2 limbs until less than 2 limbs remain */
+Loope1:	addu.cio r6,r10,r8
+	ld	 r10,s1_ptr,8
+	addu.cio r7,r12,r9
+	ld	 r12,s1_ptr,12
+	ld.d	 r8,s2_ptr,8
+	st.d	 r6,res_ptr,0
+	subu	 size,size,2
+	addu	 s1_ptr,s1_ptr,8
+	addu	 s2_ptr,s2_ptr,8
+	addu	 res_ptr,res_ptr,8
+	bcnd	 ge0,size,Loope1
+Lend1:	addu.cio r6,r10,r8
+	addu.cio r7,r12,r9
+	st.d	 r6,res_ptr,0
+
+	bb0	 0,size,Lret1
+/* Add last limb */
+	ld	 r10,s1_ptr,8
+	ld	 r8,s2_ptr,8
+	addu.cio r6,r10,r8
+	st	 r6,res_ptr,8
+
+Lret1:	jmp.n	 r1
+	addu.ci	 r2,r0,r0		; return carry-out from most sign. limb
+
+L1:	xor	 r12,s1_ptr,res_ptr
+	bb1	 2,r12,L2
+; **  V1b  **
+	or	 r12,r0,s2_ptr
+	or	 s2_ptr,r0,s1_ptr
+	or	 s1_ptr,r0,r12
+	br	 L0
+
+; **  V2  **
+/* If we come here, the alignment of s1_ptr and res_ptr as well as the
+   alignment of s2_ptr and res_ptr differ.  Since there are only two ways
+   things can be aligned (that we care about) we now know that the alignment
+   of s1_ptr and s2_ptr are the same.  */
+
+L2:	cmp	 r12,size,1
+	bb1	 eq,r12,Ljone
+	bb0	 2,s1_ptr,L_v2		; branch if s1_ptr is aligned
+/* Add least significant limb separately to align res_ptr and s2_ptr */
+	ld	 r10,s1_ptr,0
+	addu	 s1_ptr,s1_ptr,4
+	ld	 r8,s2_ptr,0
+	addu	 s2_ptr,s2_ptr,4
+	subu	 size,size,1
+	addu.co	 r6,r10,r8
+	st	 r6,res_ptr,0
+	addu	 res_ptr,res_ptr,4
+
+L_v2:	subu	 size,size,8
+	bcnd	 lt0,size,Lfin2
+/* Add blocks of 8 limbs until less than 8 limbs remain */
+	align	 8
+Loop2:	subu	 size,size,8
+	ld.d	 r8,s1_ptr,0
+	ld.d	 r6,s2_ptr,0
+	addu.cio r8,r8,r6
+	st	 r8,res_ptr,0
+	addu.cio r9,r9,r7
+	st	 r9,res_ptr,4
+	ld.d	 r8,s1_ptr,8
+	ld.d	 r6,s2_ptr,8
+	addu.cio r8,r8,r6
+	st	 r8,res_ptr,8
+	addu.cio r9,r9,r7
+	st	 r9,res_ptr,12
+	ld.d	 r8,s1_ptr,16
+	ld.d	 r6,s2_ptr,16
+	addu.cio r8,r8,r6
+	st	 r8,res_ptr,16
+	addu.cio r9,r9,r7
+	st	 r9,res_ptr,20
+	ld.d	 r8,s1_ptr,24
+	ld.d	 r6,s2_ptr,24
+	addu.cio r8,r8,r6
+	st	 r8,res_ptr,24
+	addu.cio r9,r9,r7
+	st	 r9,res_ptr,28
+	addu	 s1_ptr,s1_ptr,32
+	addu	 s2_ptr,s2_ptr,32
+	addu	 res_ptr,res_ptr,32
+	bcnd	 ge0,size,Loop2
+
+Lfin2:	addu	 size,size,8-2
+	bcnd	 lt0,size,Lend2
+Loope2:	ld.d	 r8,s1_ptr,0
+	ld.d	 r6,s2_ptr,0
+	addu.cio r8,r8,r6
+	st	 r8,res_ptr,0
+	addu.cio r9,r9,r7
+	st	 r9,res_ptr,4
+	subu	 size,size,2
+	addu	 s1_ptr,s1_ptr,8
+	addu	 s2_ptr,s2_ptr,8
+	addu	 res_ptr,res_ptr,8
+	bcnd	 ge0,size,Loope2
+Lend2:	bb0	 0,size,Lret2
+/* Add last limb */
+Ljone:	ld	 r10,s1_ptr,0
+	ld	 r8,s2_ptr,0
+	addu.cio r6,r10,r8
+	st	 r6,res_ptr,0
+
+Lret2:	jmp.n	 r1
+	addu.ci	 r2,r0,r0		; return carry-out from most sign. limb
diff --git a/src/gmp/mpn/m88k/mc88110/addmul_1.s b/src/gmp/mpn/m88k/mc88110/addmul_1.s
new file mode 100644
index 000000000..7d97c87c7
--- /dev/null
+++ b/src/gmp/mpn/m88k/mc88110/addmul_1.s
@@ -0,0 +1,61 @@
+; mc88110 __gmpn_addmul_1 -- Multiply a limb vector with a single limb and
+; store the product in a second limb vector.
+
+; Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	r2
+; s1_ptr	r3
+; size		r4
+; s2_limb	r5
+
+	text
+	align	16
+	global	___gmpn_addmul_1
+___gmpn_addmul_1:
+	lda	 r3,r3[r4]
+	lda	 r8,r2[r4]		; RES_PTR in r8 since r2 is retval
+	subu	 r4,r0,r4
+	addu.co	 r2,r0,r0		; r2 = cy = 0
+
+	ld	 r6,r3[r4]
+	addu	 r4,r4,1
+	subu	 r8,r8,4
+	bcnd.n	 eq0,r4,Lend
+	 mulu.d	 r10,r6,r5
+
+Loop:	ld	 r7,r8[r4]
+	ld	 r6,r3[r4]
+	addu.cio r9,r11,r2
+	addu.ci	 r2,r10,r0
+	addu.co	 r9,r9,r7
+	st	 r9,r8[r4]
+	addu	 r4,r4,1
+	mulu.d	 r10,r6,r5
+	bcnd	 ne0,r4,Loop
+
+Lend:	ld	 r7,r8,0
+	addu.cio r9,r11,r2
+	addu.ci	 r2,r10,r0
+	addu.co	 r9,r9,r7
+	st	 r9,r8,0
+	jmp.n	 r1
+	 addu.ci r2,r2,r0
diff --git a/src/gmp/mpn/m88k/mc88110/mul_1.s b/src/gmp/mpn/m88k/mc88110/mul_1.s
new file mode 100644
index 000000000..b8483afa9
--- /dev/null
+++ b/src/gmp/mpn/m88k/mc88110/mul_1.s
@@ -0,0 +1,59 @@
+; mc88110 __gmpn_mul_1 -- Multiply a limb vector with a single limb and
+; store the product in a second limb vector.
+
+; Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	r2
+; s1_ptr	r3
+; size		r4
+; s2_limb	r5
+
+	text
+	align	16
+	global	___gmpn_mul_1
+___gmpn_mul_1:
+	; Make S1_PTR and RES_PTR point at the end of their blocks
+	; and negate SIZE.
+	lda	 r3,r3[r4]
+	lda	 r8,r2[r4]		; RES_PTR in r8 since r2 is retval
+	subu	 r4,r0,r4
+
+	addu.co	 r2,r0,r0		; r2 = cy = 0
+
+	ld	 r6,r3[r4]
+	addu	 r4,r4,1
+	mulu.d	 r10,r6,r5
+	bcnd.n	 eq0,r4,Lend
+	 subu	 r8,r8,8
+
+Loop:	ld	 r6,r3[r4]
+	addu.cio r9,r11,r2
+	or	 r2,r10,r0		; could be avoided if unrolled
+	addu	 r4,r4,1
+	mulu.d	 r10,r6,r5
+	bcnd.n	 ne0,r4,Loop
+	 st	 r9,r8[r4]
+
+Lend:	addu.cio r9,r11,r2
+	st	 r9,r8,4
+	jmp.n	 r1
+	 addu.ci r2,r10,r0
diff --git a/src/gmp/mpn/m88k/mc88110/sub_n.S b/src/gmp/mpn/m88k/mc88110/sub_n.S
new file mode 100644
index 000000000..715a3faf2
--- /dev/null
+++ b/src/gmp/mpn/m88k/mc88110/sub_n.S
@@ -0,0 +1,276 @@
+; mc88110 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+; store difference in a third limb vector.
+
+; Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+#define res_ptr	r2
+#define s1_ptr	r3
+#define s2_ptr	r4
+#define size	r5
+
+#include "sysdep.h"
+
+	text
+	align	16
+	global	C_SYMBOL_NAME(__gmpn_sub_n)
+C_SYMBOL_NAME(__gmpn_sub_n):
+	subu.co	 r0,r0,r0		; set cy flag
+	xor	 r12,s2_ptr,res_ptr
+	bb1	 2,r12,L1
+; **  V1a  **
+L0:	bb0	 2,res_ptr,L_v1		; branch if res_ptr is aligned
+/* Add least significant limb separately to align res_ptr and s2_ptr */
+	ld	 r10,s1_ptr,0
+	addu	 s1_ptr,s1_ptr,4
+	ld	 r8,s2_ptr,0
+	addu	 s2_ptr,s2_ptr,4
+	subu	 size,size,1
+	subu.co	 r6,r10,r8
+	st	 r6,res_ptr,0
+	addu	 res_ptr,res_ptr,4
+L_v1:	cmp	 r12,size,2
+	bb1	 lt,r12,Lend2
+
+	ld	 r10,s1_ptr,0
+	ld	 r12,s1_ptr,4
+	ld.d	 r8,s2_ptr,0
+	subu	 size,size,10
+	bcnd	 lt0,size,Lfin1
+/* Add blocks of 8 limbs until less than 8 limbs remain */
+	align	 8
+Loop1:	subu	 size,size,8
+	subu.cio r6,r10,r8
+	ld	 r10,s1_ptr,8
+	subu.cio r7,r12,r9
+	ld	 r12,s1_ptr,12
+	ld.d	 r8,s2_ptr,8
+	st.d	 r6,res_ptr,0
+	subu.cio r6,r10,r8
+	ld	 r10,s1_ptr,16
+	subu.cio r7,r12,r9
+	ld	 r12,s1_ptr,20
+	ld.d	 r8,s2_ptr,16
+	st.d	 r6,res_ptr,8
+	subu.cio r6,r10,r8
+	ld	 r10,s1_ptr,24
+	subu.cio r7,r12,r9
+	ld	 r12,s1_ptr,28
+	ld.d	 r8,s2_ptr,24
+	st.d	 r6,res_ptr,16
+	subu.cio r6,r10,r8
+	ld	 r10,s1_ptr,32
+	subu.cio r7,r12,r9
+	ld	 r12,s1_ptr,36
+	addu	 s1_ptr,s1_ptr,32
+	ld.d	 r8,s2_ptr,32
+	addu	 s2_ptr,s2_ptr,32
+	st.d	 r6,res_ptr,24
+	addu	 res_ptr,res_ptr,32
+	bcnd	 ge0,size,Loop1
+
+Lfin1:	addu	 size,size,8-2
+	bcnd	 lt0,size,Lend1
+/* Add blocks of 2 limbs until less than 2 limbs remain */
+Loope1:	subu.cio r6,r10,r8
+	ld	 r10,s1_ptr,8
+	subu.cio r7,r12,r9
+	ld	 r12,s1_ptr,12
+	ld.d	 r8,s2_ptr,8
+	st.d	 r6,res_ptr,0
+	subu	 size,size,2
+	addu	 s1_ptr,s1_ptr,8
+	addu	 s2_ptr,s2_ptr,8
+	addu	 res_ptr,res_ptr,8
+	bcnd	 ge0,size,Loope1
+Lend1:	subu.cio r6,r10,r8
+	subu.cio r7,r12,r9
+	st.d	 r6,res_ptr,0
+
+	bb0	 0,size,Lret1
+/* Add last limb */
+	ld	 r10,s1_ptr,8
+	ld	 r8,s2_ptr,8
+	subu.cio r6,r10,r8
+	st	 r6,res_ptr,8
+
+Lret1:	addu.ci r2,r0,r0		; return carry-out from most sign. limb
+	jmp.n	 r1
+	 xor	r2,r2,1
+
+L1:	xor	 r12,s1_ptr,res_ptr
+	bb1	 2,r12,L2
+; **  V1b  **
+	bb0	 2,res_ptr,L_v1b	; branch if res_ptr is aligned
+/* Add least significant limb separately to align res_ptr and s1_ptr */
+	ld	 r10,s2_ptr,0
+	addu	 s2_ptr,s2_ptr,4
+	ld	 r8,s1_ptr,0
+	addu	 s1_ptr,s1_ptr,4
+	subu	 size,size,1
+	subu.co	 r6,r8,r10
+	st	 r6,res_ptr,0
+	addu	 res_ptr,res_ptr,4
+L_v1b:	cmp	 r12,size,2
+	bb1	 lt,r12,Lend2
+
+	ld	 r10,s2_ptr,0
+	ld	 r12,s2_ptr,4
+	ld.d	 r8,s1_ptr,0
+	subu	 size,size,10
+	bcnd	 lt0,size,Lfin1b
+/* Add blocks of 8 limbs until less than 8 limbs remain */
+	align	 8
+Loop1b:	subu	 size,size,8
+	subu.cio r6,r8,r10
+	ld	 r10,s2_ptr,8
+	subu.cio r7,r9,r12
+	ld	 r12,s2_ptr,12
+	ld.d	 r8,s1_ptr,8
+	st.d	 r6,res_ptr,0
+	subu.cio r6,r8,r10
+	ld	 r10,s2_ptr,16
+	subu.cio r7,r9,r12
+	ld	 r12,s2_ptr,20
+	ld.d	 r8,s1_ptr,16
+	st.d	 r6,res_ptr,8
+	subu.cio r6,r8,r10
+	ld	 r10,s2_ptr,24
+	subu.cio r7,r9,r12
+	ld	 r12,s2_ptr,28
+	ld.d	 r8,s1_ptr,24
+	st.d	 r6,res_ptr,16
+	subu.cio r6,r8,r10
+	ld	 r10,s2_ptr,32
+	subu.cio r7,r9,r12
+	ld	 r12,s2_ptr,36
+	addu	 s2_ptr,s2_ptr,32
+	ld.d	 r8,s1_ptr,32
+	addu	 s1_ptr,s1_ptr,32
+	st.d	 r6,res_ptr,24
+	addu	 res_ptr,res_ptr,32
+	bcnd	 ge0,size,Loop1b
+
+Lfin1b:	addu	 size,size,8-2
+	bcnd	 lt0,size,Lend1b
+/* Add blocks of 2 limbs until less than 2 limbs remain */
+Loope1b:subu.cio r6,r8,r10
+	ld	 r10,s2_ptr,8
+	subu.cio r7,r9,r12
+	ld	 r12,s2_ptr,12
+	ld.d	 r8,s1_ptr,8
+	st.d	 r6,res_ptr,0
+	subu	 size,size,2
+	addu	 s1_ptr,s1_ptr,8
+	addu	 s2_ptr,s2_ptr,8
+	addu	 res_ptr,res_ptr,8
+	bcnd	 ge0,size,Loope1b
+Lend1b:	subu.cio r6,r8,r10
+	subu.cio r7,r9,r12
+	st.d	 r6,res_ptr,0
+
+	bb0	 0,size,Lret1b
+/* Add last limb */
+	ld	 r10,s2_ptr,8
+	ld	 r8,s1_ptr,8
+	subu.cio r6,r8,r10
+	st	 r6,res_ptr,8
+
+Lret1b:	addu.ci r2,r0,r0		; return carry-out from most sign. limb
+	jmp.n	 r1
+	 xor	r2,r2,1
+
+; **  V2  **
+/* If we come here, the alignment of s1_ptr and res_ptr as well as the
+   alignment of s2_ptr and res_ptr differ.  Since there are only two ways
+   things can be aligned (that we care about) we now know that the alignment
+   of s1_ptr and s2_ptr are the same.  */
+
+L2:	cmp	 r12,size,1
+	bb1	 eq,r12,Ljone
+	bb0	 2,s1_ptr,L_v2		; branch if s1_ptr is aligned
+/* Add least significant limb separately to align res_ptr and s2_ptr */
+	ld	 r10,s1_ptr,0
+	addu	 s1_ptr,s1_ptr,4
+	ld	 r8,s2_ptr,0
+	addu	 s2_ptr,s2_ptr,4
+	subu	 size,size,1
+	subu.co	 r6,r10,r8
+	st	 r6,res_ptr,0
+	addu	 res_ptr,res_ptr,4
+
+L_v2:	subu	 size,size,8
+	bcnd	 lt0,size,Lfin2
+/* Add blocks of 8 limbs until less than 8 limbs remain */
+	align	 8
+Loop2:	subu	 size,size,8
+	ld.d	 r8,s1_ptr,0
+	ld.d	 r6,s2_ptr,0
+	subu.cio r8,r8,r6
+	st	 r8,res_ptr,0
+	subu.cio r9,r9,r7
+	st	 r9,res_ptr,4
+	ld.d	 r8,s1_ptr,8
+	ld.d	 r6,s2_ptr,8
+	subu.cio r8,r8,r6
+	st	 r8,res_ptr,8
+	subu.cio r9,r9,r7
+	st	 r9,res_ptr,12
+	ld.d	 r8,s1_ptr,16
+	ld.d	 r6,s2_ptr,16
+	subu.cio r8,r8,r6
+	st	 r8,res_ptr,16
+	subu.cio r9,r9,r7
+	st	 r9,res_ptr,20
+	ld.d	 r8,s1_ptr,24
+	ld.d	 r6,s2_ptr,24
+	subu.cio r8,r8,r6
+	st	 r8,res_ptr,24
+	subu.cio r9,r9,r7
+	st	 r9,res_ptr,28
+	addu	 s1_ptr,s1_ptr,32
+	addu	 s2_ptr,s2_ptr,32
+	addu	 res_ptr,res_ptr,32
+	bcnd	 ge0,size,Loop2
+
+Lfin2:	addu	 size,size,8-2
+	bcnd	 lt0,size,Lend2
+Loope2:	ld.d	 r8,s1_ptr,0
+	ld.d	 r6,s2_ptr,0
+	subu.cio r8,r8,r6
+	st	 r8,res_ptr,0
+	subu.cio r9,r9,r7
+	st	 r9,res_ptr,4
+	subu	 size,size,2
+	addu	 s1_ptr,s1_ptr,8
+	addu	 s2_ptr,s2_ptr,8
+	addu	 res_ptr,res_ptr,8
+	bcnd	 ge0,size,Loope2
+Lend2:	bb0	 0,size,Lret2
+/* Add last limb */
+Ljone:	ld	 r10,s1_ptr,0
+	ld	 r8,s2_ptr,0
+	subu.cio r6,r10,r8
+	st	 r6,res_ptr,0
+
+Lret2:	addu.ci r2,r0,r0		; return carry-out from most sign. limb
+	jmp.n	 r1
+	 xor	r2,r2,1
diff --git a/src/gmp/mpn/m88k/mul_1.s b/src/gmp/mpn/m88k/mul_1.s
new file mode 100644
index 000000000..06370837e
--- /dev/null
+++ b/src/gmp/mpn/m88k/mul_1.s
@@ -0,0 +1,127 @@
+; mc88100 __gmpn_mul_1 -- Multiply a limb vector with a single limb and
+; store the product in a second limb vector.
+
+; Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	r2
+; s1_ptr	r3
+; size		r4
+; s2_limb	r5
+
+; Common overhead is about 11 cycles/invocation.
+
+; The speed for S2_LIMB >= 0x10000 is approximately 21 cycles/limb.  (The
+; pipeline stalls 2 cycles due to WB contention.)
+
+; The speed for S2_LIMB < 0x10000 is approximately 16 cycles/limb.  (The
+; pipeline stalls 2 cycles due to WB contention and 1 cycle due to latency.)
+
+; To enhance speed:
+; 1. Unroll main loop 4-8 times.
+; 2. Schedule code to avoid WB contention.  It might be tempting to move the
+;    ld instruction in the loops down to save 2 cycles (less WB contention),
+;    but that looses because the ultimate value will be read from outside
+;    the allocated space.  But if we handle the ultimate multiplication in
+;    the tail, we can do this.
+; 3. Make the multiplication with less instructions.  I think the code for
+;    (S2_LIMB >= 0x10000) is not minimal.
+; With these techniques the (S2_LIMB >= 0x10000) case would run in 17 or
+; less cycles/limb; the (S2_LIMB < 0x10000) case would run in 11
+; cycles/limb.  (Assuming infinite unrolling.)
+
+	text
+	align	 16
+	global	 ___gmpn_mul_1
+___gmpn_mul_1:
+
+	; Make S1_PTR and RES_PTR point at the end of their blocks
+	; and negate SIZE.
+	lda	 r3,r3[r4]
+	lda	 r6,r2[r4]	; RES_PTR in r6 since r2 is retval
+	subu	 r4,r0,r4
+
+	addu.co	 r2,r0,r0	; r2 = cy = 0
+	ld	 r9,r3[r4]
+	mask	 r7,r5,0xffff	; r7 = lo(S2_LIMB)
+	extu	 r8,r5,16	; r8 = hi(S2_LIMB)
+	bcnd.n	 eq0,r8,Lsmall	; jump if (hi(S2_LIMB) == 0)
+	 subu	 r6,r6,4
+
+; General code for any value of S2_LIMB.
+
+	; Make a stack frame and save r25 and r26
+	subu	 r31,r31,16
+	st.d	 r25,r31,8
+
+	; Enter the loop in the middle
+	br.n	L1
+	addu	 r4,r4,1
+
+Loop:	ld	 r9,r3[r4]
+	st	 r26,r6[r4]
+; bcnd	ne0,r0,0		; bubble
+	addu	 r4,r4,1
+L1:	mul	 r26,r9,r5	; low word of product	mul_1	WB ld
+	mask	 r12,r9,0xffff	; r12 = lo(s1_limb)	mask_1
+	mul	 r11,r12,r7	; r11 =  prod_0		mul_2	WB mask_1
+	mul	 r10,r12,r8	; r10 = prod_1a		mul_3
+	extu	 r13,r9,16	; r13 = hi(s1_limb)	extu_1	WB mul_1
+	mul	 r12,r13,r7	; r12 = prod_1b		mul_4	WB extu_1
+	mul	 r25,r13,r8	; r25  = prod_2		mul_5	WB mul_2
+	extu	 r11,r11,16	; r11 = hi(prod_0)	extu_2	WB mul_3
+	addu	 r10,r10,r11	;			addu_1	WB extu_2
+; bcnd	ne0,r0,0		; bubble			WB addu_1
+	addu.co	 r10,r10,r12	;				WB mul_4
+	mask.u	 r10,r10,0xffff	; move the 16 most significant bits...
+	addu.ci	 r10,r10,r0	; ...to the low half of the word...
+	rot	 r10,r10,16	; ...and put carry in pos 16.
+	addu.co	 r26,r26,r2	; add old carry limb
+	bcnd.n	 ne0,r4,Loop
+	 addu.ci r2,r25,r10	; compute new carry limb
+
+	st	 r26,r6[r4]
+	ld.d	 r25,r31,8
+	jmp.n	 r1
+	 addu	 r31,r31,16
+
+; Fast code for S2_LIMB < 0x10000
+Lsmall:
+	; Enter the loop in the middle
+	br.n	SL1
+	addu	 r4,r4,1
+
+SLoop:	ld	 r9,r3[r4]	;
+	st	 r8,r6[r4]	;
+	addu	 r4,r4,1	;
+SL1:	mul	 r8,r9,r5	; low word of product
+	mask	 r12,r9,0xffff	; r12 = lo(s1_limb)
+	extu	 r13,r9,16	; r13 = hi(s1_limb)
+	mul	 r11,r12,r7	; r11 =  prod_0
+	mul	 r12,r13,r7	; r12 = prod_1b
+	addu.cio r8,r8,r2	; add old carry limb
+	extu	 r10,r11,16	; r11 = hi(prod_0)
+	addu	 r10,r10,r12	;
+	bcnd.n	 ne0,r4,SLoop
+	extu	 r2,r10,16	; r2 = new carry limb
+
+	jmp.n	 r1
+	st	 r8,r6[r4]
diff --git a/src/gmp/mpn/m88k/sub_n.s b/src/gmp/mpn/m88k/sub_n.s
new file mode 100644
index 000000000..2fd345a13
--- /dev/null
+++ b/src/gmp/mpn/m88k/sub_n.s
@@ -0,0 +1,106 @@
+; mc88100 __gmpn_sub -- Subtract two limb vectors of the same length > 0 and
+; store difference in a third limb vector.
+
+; Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	r2
+; s1_ptr	r3
+; s2_ptr	r4
+; size		r5
+
+; This code has been optimized to run one instruction per clock, avoiding
+; load stalls and writeback contention.  As a result, the instruction
+; order is not always natural.
+
+; The speed is about 4.6 clocks/limb + 18 clocks/limb-vector on an 88100,
+; but on the 88110, it seems to run much slower, 6.6 clocks/limb.
+
+	text
+	align	 16
+	global	 ___gmpn_sub_n
+___gmpn_sub_n:
+	ld	r6,r3,0			; read first limb from s1_ptr
+	extu	r10,r5,3
+	ld	r7,r4,0			; read first limb from s2_ptr
+
+	subu	r5,r0,r5
+	mak	r5,r5,3<4>
+	bcnd.n	eq0,r5,Lzero
+	subu.co	r0,r0,r0		; initialize carry
+
+	or	r12,r0,lo16(Lbase)
+	or.u	r12,r12,hi16(Lbase)
+	addu	r12,r12,r5		; r12 is address for entering in loop
+
+	extu	r5,r5,2			; divide by 4
+	subu	r2,r2,r5		; adjust res_ptr
+	subu	r3,r3,r5		; adjust s1_ptr
+	subu	r4,r4,r5		; adjust s2_ptr
+
+	or	r8,r6,r0
+
+	jmp.n	r12
+	 or	r9,r7,r0
+
+Loop:	addu	r3,r3,32
+	st	r8,r2,28
+	addu	r4,r4,32
+	ld	r6,r3,0
+	addu	r2,r2,32
+	ld	r7,r4,0
+Lzero:	subu	r10,r10,1		; subtract 0 + 8r limbs (adj loop cnt)
+Lbase:	ld	r8,r3,4
+	subu.cio r6,r6,r7
+	ld	r9,r4,4
+	st	r6,r2,0
+	ld	r6,r3,8			; subtract 7 + 8r limbs
+	subu.cio r8,r8,r9
+	ld	r7,r4,8
+	st	r8,r2,4
+	ld	r8,r3,12		; subtract 6 + 8r limbs
+	subu.cio r6,r6,r7
+	ld	r9,r4,12
+	st	r6,r2,8
+	ld	r6,r3,16		; subtract 5 + 8r limbs
+	subu.cio r8,r8,r9
+	ld	r7,r4,16
+	st	r8,r2,12
+	ld	r8,r3,20		; subtract 4 + 8r limbs
+	subu.cio r6,r6,r7
+	ld	r9,r4,20
+	st	r6,r2,16
+	ld	r6,r3,24		; subtract 3 + 8r limbs
+	subu.cio r8,r8,r9
+	ld	r7,r4,24
+	st	r8,r2,20
+	ld	r8,r3,28		; subtract 2 + 8r limbs
+	subu.cio r6,r6,r7
+	ld	r9,r4,28
+	st	r6,r2,24
+	bcnd.n	ne0,r10,Loop		; subtract 1 + 8r limbs
+	 subu.cio r8,r8,r9
+
+	st	r8,r2,28		; store most significant limb
+
+	addu.ci r2,r0,r0		; return carry-out from most sign. limb
+	jmp.n	 r1
+	 xor	r2,r2,1
diff --git a/src/gmp/mpn/mips2/add_n.s b/src/gmp/mpn/mips2/add_n.s
new file mode 100644
index 000000000..5c3c7fc8a
--- /dev/null
+++ b/src/gmp/mpn/mips2/add_n.s
@@ -0,0 +1,120 @@
+ # MIPS2 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
+ # store sum in a third limb vector.
+
+ # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # s2_ptr	$6
+ # size		$7
+
+	.text
+	.align	2
+	.globl	__gmpn_add_n
+	.ent	__gmpn_add_n
+__gmpn_add_n:
+	.set	noreorder
+	.set	nomacro
+
+	lw	$10,0($5)
+	lw	$11,0($6)
+
+	addiu	$7,$7,-1
+	and	$9,$7,4-1	# number of limbs in first loop
+	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
+	 move	$2,$0
+
+	subu	$7,$7,$9
+
+.Loop0:	addiu	$9,$9,-1
+	lw	$12,4($5)
+	addu	$11,$11,$2
+	lw	$13,4($6)
+	sltu	$8,$11,$2
+	addu	$11,$10,$11
+	sltu	$2,$11,$10
+	sw	$11,0($4)
+	or	$2,$2,$8
+
+	addiu	$5,$5,4
+	addiu	$6,$6,4
+	move	$10,$12
+	move	$11,$13
+	bne	$9,$0,.Loop0
+	 addiu	$4,$4,4
+
+.L0:	beq	$7,$0,.Lend
+	 nop
+
+.Loop:	addiu	$7,$7,-4
+
+	lw	$12,4($5)
+	addu	$11,$11,$2
+	lw	$13,4($6)
+	sltu	$8,$11,$2
+	addu	$11,$10,$11
+	sltu	$2,$11,$10
+	sw	$11,0($4)
+	or	$2,$2,$8
+
+	lw	$10,8($5)
+	addu	$13,$13,$2
+	lw	$11,8($6)
+	sltu	$8,$13,$2
+	addu	$13,$12,$13
+	sltu	$2,$13,$12
+	sw	$13,4($4)
+	or	$2,$2,$8
+
+	lw	$12,12($5)
+	addu	$11,$11,$2
+	lw	$13,12($6)
+	sltu	$8,$11,$2
+	addu	$11,$10,$11
+	sltu	$2,$11,$10
+	sw	$11,8($4)
+	or	$2,$2,$8
+
+	lw	$10,16($5)
+	addu	$13,$13,$2
+	lw	$11,16($6)
+	sltu	$8,$13,$2
+	addu	$13,$12,$13
+	sltu	$2,$13,$12
+	sw	$13,12($4)
+	or	$2,$2,$8
+
+	addiu	$5,$5,16
+	addiu	$6,$6,16
+
+	bne	$7,$0,.Loop
+	 addiu	$4,$4,16
+
+.Lend:	addu	$11,$11,$2
+	sltu	$8,$11,$2
+	addu	$11,$10,$11
+	sltu	$2,$11,$10
+	sw	$11,0($4)
+	j	$31
+	or	$2,$2,$8
+
+	.end	__gmpn_add_n
diff --git a/src/gmp/mpn/mips2/addmul_1.s b/src/gmp/mpn/mips2/addmul_1.s
new file mode 100644
index 000000000..1e5037751
--- /dev/null
+++ b/src/gmp/mpn/mips2/addmul_1.s
@@ -0,0 +1,97 @@
+ # MIPS __gmpn_addmul_1 -- Multiply a limb vector with a single limb and
+ # add the product to a second limb vector.
+
+ # Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # size		$6
+ # s2_limb	$7
+
+	.text
+	.align	 4
+	.globl	 __gmpn_addmul_1
+	.ent	__gmpn_addmul_1
+__gmpn_addmul_1:
+	.set    noreorder
+	.set    nomacro
+
+ # warm up phase 0
+	lw	$8,0($5)
+
+ # warm up phase 1
+	addiu	$5,$5,4
+	multu	$8,$7
+
+	addiu	$6,$6,-1
+	beq	$6,$0,$LC0
+	 move	$2,$0		# zero cy2
+
+	addiu	$6,$6,-1
+	beq	$6,$0,$LC1
+	lw	$8,0($5)	# load new s1 limb as early as possible
+
+Loop:	lw	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	addiu	$5,$5,4
+	addu	$3,$3,$2	# add old carry limb to low product limb
+	multu	$8,$7
+	lw	$8,0($5)	# load new s1 limb as early as possible
+	addiu	$6,$6,-1	# decrement loop counter
+	sltu	$2,$3,$2	# carry from previous addition -> $2
+	addu	$3,$10,$3
+	sltu	$10,$3,$10
+	addu	$2,$2,$10
+	sw	$3,0($4)
+	addiu	$4,$4,4
+	bne	$6,$0,Loop
+	 addu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 1
+$LC1:	lw	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	addu	$3,$3,$2
+	sltu	$2,$3,$2
+	multu	$8,$7
+	addu	$3,$10,$3
+	sltu	$10,$3,$10
+	addu	$2,$2,$10
+	sw	$3,0($4)
+	addiu	$4,$4,4
+	addu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 0
+$LC0:	lw	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	addu	$3,$3,$2
+	sltu	$2,$3,$2
+	addu	$3,$10,$3
+	sltu	$10,$3,$10
+	addu	$2,$2,$10
+	sw	$3,0($4)
+	j	$31
+	addu	$2,$9,$2	# add high product limb and carry from addition
+
+	.end	__gmpn_addmul_1
diff --git a/src/gmp/mpn/mips2/lshift.s b/src/gmp/mpn/mips2/lshift.s
new file mode 100644
index 000000000..2ca3a3c80
--- /dev/null
+++ b/src/gmp/mpn/mips2/lshift.s
@@ -0,0 +1,95 @@
+ # MIPS2 __gmpn_lshift --
+
+ # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # src_ptr	$5
+ # size		$6
+ # cnt		$7
+
+	.text
+	.align	2
+	.globl	__gmpn_lshift
+	.ent	__gmpn_lshift
+__gmpn_lshift:
+	.set	noreorder
+	.set	nomacro
+
+	sll	$2,$6,2
+	addu	$5,$5,$2	# make r5 point at end of src
+	lw	$10,-4($5)	# load first limb
+	subu	$13,$0,$7
+	addu	$4,$4,$2	# make r4 point at end of res
+	addiu	$6,$6,-1
+	and	$9,$6,4-1	# number of limbs in first loop
+	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
+	 srl	$2,$10,$13	# compute function result
+
+	subu	$6,$6,$9
+
+.Loop0:	lw	$3,-8($5)
+	addiu	$4,$4,-4
+	addiu	$5,$5,-4
+	addiu	$9,$9,-1
+	sll	$11,$10,$7
+	srl	$12,$3,$13
+	move	$10,$3
+	or	$8,$11,$12
+	bne	$9,$0,.Loop0
+	 sw	$8,0($4)
+
+.L0:	beq	$6,$0,.Lend
+	 nop
+
+.Loop:	lw	$3,-8($5)
+	addiu	$4,$4,-16
+	addiu	$6,$6,-4
+	sll	$11,$10,$7
+	srl	$12,$3,$13
+
+	lw	$10,-12($5)
+	sll	$14,$3,$7
+	or	$8,$11,$12
+	sw	$8,12($4)
+	srl	$9,$10,$13
+
+	lw	$3,-16($5)
+	sll	$11,$10,$7
+	or	$8,$14,$9
+	sw	$8,8($4)
+	srl	$12,$3,$13
+
+	lw	$10,-20($5)
+	sll	$14,$3,$7
+	or	$8,$11,$12
+	sw	$8,4($4)
+	srl	$9,$10,$13
+
+	addiu	$5,$5,-16
+	or	$8,$14,$9
+	bgtz	$6,.Loop
+	 sw	$8,0($4)
+
+.Lend:	sll	$8,$10,$7
+	j	$31
+	sw	$8,-4($4)
+	.end	__gmpn_lshift
diff --git a/src/gmp/mpn/mips2/mul_1.s b/src/gmp/mpn/mips2/mul_1.s
new file mode 100644
index 000000000..ea8aa2680
--- /dev/null
+++ b/src/gmp/mpn/mips2/mul_1.s
@@ -0,0 +1,85 @@
+ # MIPS __gmpn_mul_1 -- Multiply a limb vector with a single limb and
+ # store the product in a second limb vector.
+
+ # Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # size		$6
+ # s2_limb	$7
+
+	.text
+	.align	 4
+	.globl	 __gmpn_mul_1
+	.ent	__gmpn_mul_1
+__gmpn_mul_1:
+	.set    noreorder
+	.set    nomacro
+
+ # warm up phase 0
+	lw	$8,0($5)
+
+ # warm up phase 1
+	addiu	$5,$5,4
+	multu	$8,$7
+
+	addiu	$6,$6,-1
+	beq	$6,$0,$LC0
+	 move	$2,$0		# zero cy2
+
+	addiu	$6,$6,-1
+	beq	$6,$0,$LC1
+	lw	$8,0($5)	# load new s1 limb as early as possible
+
+Loop:	mflo	$10
+	mfhi	$9
+	addiu	$5,$5,4
+	addu	$10,$10,$2	# add old carry limb to low product limb
+	multu	$8,$7
+	lw	$8,0($5)	# load new s1 limb as early as possible
+	addiu	$6,$6,-1	# decrement loop counter
+	sltu	$2,$10,$2	# carry from previous addition -> $2
+	sw	$10,0($4)
+	addiu	$4,$4,4
+	bne	$6,$0,Loop
+	 addu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 1
+$LC1:	mflo	$10
+	mfhi	$9
+	addu	$10,$10,$2
+	sltu	$2,$10,$2
+	multu	$8,$7
+	sw	$10,0($4)
+	addiu	$4,$4,4
+	addu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 0
+$LC0:	mflo	$10
+	mfhi	$9
+	addu	$10,$10,$2
+	sltu	$2,$10,$2
+	sw	$10,0($4)
+	j	$31
+	addu	$2,$9,$2	# add high product limb and carry from addition
+
+	.end	__gmpn_mul_1
diff --git a/src/gmp/mpn/mips2/rshift.s b/src/gmp/mpn/mips2/rshift.s
new file mode 100644
index 000000000..37c8f39cb
--- /dev/null
+++ b/src/gmp/mpn/mips2/rshift.s
@@ -0,0 +1,92 @@
+ # MIPS2 __gmpn_rshift --
+
+ # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # src_ptr	$5
+ # size		$6
+ # cnt		$7
+
+	.text
+	.align	2
+	.globl	__gmpn_rshift
+	.ent	__gmpn_rshift
+__gmpn_rshift:
+	.set	noreorder
+	.set	nomacro
+
+	lw	$10,0($5)	# load first limb
+	subu	$13,$0,$7
+	addiu	$6,$6,-1
+	and	$9,$6,4-1	# number of limbs in first loop
+	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
+	 sll	$2,$10,$13	# compute function result
+
+	subu	$6,$6,$9
+
+.Loop0:	lw	$3,4($5)
+	addiu	$4,$4,4
+	addiu	$5,$5,4
+	addiu	$9,$9,-1
+	srl	$11,$10,$7
+	sll	$12,$3,$13
+	move	$10,$3
+	or	$8,$11,$12
+	bne	$9,$0,.Loop0
+	 sw	$8,-4($4)
+
+.L0:	beq	$6,$0,.Lend
+	 nop
+
+.Loop:	lw	$3,4($5)
+	addiu	$4,$4,16
+	addiu	$6,$6,-4
+	srl	$11,$10,$7
+	sll	$12,$3,$13
+
+	lw	$10,8($5)
+	srl	$14,$3,$7
+	or	$8,$11,$12
+	sw	$8,-16($4)
+	sll	$9,$10,$13
+
+	lw	$3,12($5)
+	srl	$11,$10,$7
+	or	$8,$14,$9
+	sw	$8,-12($4)
+	sll	$12,$3,$13
+
+	lw	$10,16($5)
+	srl	$14,$3,$7
+	or	$8,$11,$12
+	sw	$8,-8($4)
+	sll	$9,$10,$13
+
+	addiu	$5,$5,16
+	or	$8,$14,$9
+	bgtz	$6,.Loop
+	 sw	$8,-4($4)
+
+.Lend:	srl	$8,$10,$7
+	j	$31
+	sw	$8,0($4)
+	.end	__gmpn_rshift
diff --git a/src/gmp/mpn/mips2/sub_n.s b/src/gmp/mpn/mips2/sub_n.s
new file mode 100644
index 000000000..51d34f3ac
--- /dev/null
+++ b/src/gmp/mpn/mips2/sub_n.s
@@ -0,0 +1,120 @@
+ # MIPS2 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+ # store difference in a third limb vector.
+
+ # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # s2_ptr	$6
+ # size		$7
+
+	.text
+	.align	2
+	.globl	__gmpn_sub_n
+	.ent	__gmpn_sub_n
+__gmpn_sub_n:
+	.set	noreorder
+	.set	nomacro
+
+	lw	$10,0($5)
+	lw	$11,0($6)
+
+	addiu	$7,$7,-1
+	and	$9,$7,4-1	# number of limbs in first loop
+	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
+	 move	$2,$0
+
+	subu	$7,$7,$9
+
+.Loop0:	addiu	$9,$9,-1
+	lw	$12,4($5)
+	addu	$11,$11,$2
+	lw	$13,4($6)
+	sltu	$8,$11,$2
+	subu	$11,$10,$11
+	sltu	$2,$10,$11
+	sw	$11,0($4)
+	or	$2,$2,$8
+
+	addiu	$5,$5,4
+	addiu	$6,$6,4
+	move	$10,$12
+	move	$11,$13
+	bne	$9,$0,.Loop0
+	 addiu	$4,$4,4
+
+.L0:	beq	$7,$0,.Lend
+	 nop
+
+.Loop:	addiu	$7,$7,-4
+
+	lw	$12,4($5)
+	addu	$11,$11,$2
+	lw	$13,4($6)
+	sltu	$8,$11,$2
+	subu	$11,$10,$11
+	sltu	$2,$10,$11
+	sw	$11,0($4)
+	or	$2,$2,$8
+
+	lw	$10,8($5)
+	addu	$13,$13,$2
+	lw	$11,8($6)
+	sltu	$8,$13,$2
+	subu	$13,$12,$13
+	sltu	$2,$12,$13
+	sw	$13,4($4)
+	or	$2,$2,$8
+
+	lw	$12,12($5)
+	addu	$11,$11,$2
+	lw	$13,12($6)
+	sltu	$8,$11,$2
+	subu	$11,$10,$11
+	sltu	$2,$10,$11
+	sw	$11,8($4)
+	or	$2,$2,$8
+
+	lw	$10,16($5)
+	addu	$13,$13,$2
+	lw	$11,16($6)
+	sltu	$8,$13,$2
+	subu	$13,$12,$13
+	sltu	$2,$12,$13
+	sw	$13,12($4)
+	or	$2,$2,$8
+
+	addiu	$5,$5,16
+	addiu	$6,$6,16
+
+	bne	$7,$0,.Loop
+	 addiu	$4,$4,16
+
+.Lend:	addu	$11,$11,$2
+	sltu	$8,$11,$2
+	subu	$11,$10,$11
+	sltu	$2,$10,$11
+	sw	$11,0($4)
+	j	$31
+	or	$2,$2,$8
+
+	.end	__gmpn_sub_n
diff --git a/src/gmp/mpn/mips2/submul_1.s b/src/gmp/mpn/mips2/submul_1.s
new file mode 100644
index 000000000..495dea3ba
--- /dev/null
+++ b/src/gmp/mpn/mips2/submul_1.s
@@ -0,0 +1,97 @@
+ # MIPS __gmpn_submul_1 -- Multiply a limb vector with a single limb and
+ # subtract the product from a second limb vector.
+
+ # Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # size		$6
+ # s2_limb	$7
+
+	.text
+	.align	 4
+	.globl	 __gmpn_submul_1
+	.ent	__gmpn_submul_1
+__gmpn_submul_1:
+	.set    noreorder
+	.set    nomacro
+
+ # warm up phase 0
+	lw	$8,0($5)
+
+ # warm up phase 1
+	addiu	$5,$5,4
+	multu	$8,$7
+
+	addiu	$6,$6,-1
+	beq	$6,$0,$LC0
+	 move	$2,$0		# zero cy2
+
+	addiu	$6,$6,-1
+	beq	$6,$0,$LC1
+	lw	$8,0($5)	# load new s1 limb as early as possible
+
+Loop:	lw	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	addiu	$5,$5,4
+	addu	$3,$3,$2	# add old carry limb to low product limb
+	multu	$8,$7
+	lw	$8,0($5)	# load new s1 limb as early as possible
+	addiu	$6,$6,-1	# decrement loop counter
+	sltu	$2,$3,$2	# carry from previous addition -> $2
+	subu	$3,$10,$3
+	sgtu	$10,$3,$10
+	addu	$2,$2,$10
+	sw	$3,0($4)
+	addiu	$4,$4,4
+	bne	$6,$0,Loop
+	 addu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 1
+$LC1:	lw	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	addu	$3,$3,$2
+	sltu	$2,$3,$2
+	multu	$8,$7
+	subu	$3,$10,$3
+	sgtu	$10,$3,$10
+	addu	$2,$2,$10
+	sw	$3,0($4)
+	addiu	$4,$4,4
+	addu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 0
+$LC0:	lw	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	addu	$3,$3,$2
+	sltu	$2,$3,$2
+	subu	$3,$10,$3
+	sgtu	$10,$3,$10
+	addu	$2,$2,$10
+	sw	$3,0($4)
+	j	$31
+	addu	$2,$9,$2	# add high product limb and carry from addition
+
+	.end	__gmpn_submul_1
diff --git a/src/gmp/mpn/mips2/umul.s b/src/gmp/mpn/mips2/umul.s
new file mode 100644
index 000000000..40e847614
--- /dev/null
+++ b/src/gmp/mpn/mips2/umul.s
@@ -0,0 +1,30 @@
+ # Copyright (C) 1999 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+	.text
+	.align	2
+	.globl	__umul_ppmm
+	.ent	__umul_ppmm
+__umul_ppmm:
+	multu $5,$6
+	mflo	$3
+	mfhi	$2
+	sw	$3,0($4)
+	j	$31
+	.end	__umul_ppmm
diff --git a/src/gmp/mpn/mips3/README b/src/gmp/mpn/mips3/README
new file mode 100644
index 000000000..e94b2c746
--- /dev/null
+++ b/src/gmp/mpn/mips3/README
@@ -0,0 +1,23 @@
+This directory contains mpn functions optimized for MIPS3.  Example of
+processors that implement MIPS3 are R4000, R4400, R4600, R4700, and R8000.
+
+RELEVANT OPTIMIZATION ISSUES
+
+1. On the R4000 and R4400, branches, both the plain and the "likely" ones,
+   take 3 cycles to execute.  (The fastest possible loop will take 4 cycles,
+   because of the delay insn.)
+
+   On the R4600, branches takes a single cycle
+
+   On the R8000, branches often take no noticable cycles, as they are
+   executed in a separate function unit..
+
+2. The R4000 and R4400 have a load latency of 4 cycles.
+
+3. On the R4000 and R4400, multiplies take a data-dependent number of
+   cycles, contrary to the SGI documentation.  There seem to be 3 or 4
+   possible latencies.
+
+STATUS
+
+Good...
diff --git a/src/gmp/mpn/mips3/add_n.s b/src/gmp/mpn/mips3/add_n.s
new file mode 100644
index 000000000..adad0beae
--- /dev/null
+++ b/src/gmp/mpn/mips3/add_n.s
@@ -0,0 +1,120 @@
+ # MIPS3 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
+ # store sum in a third limb vector.
+
+ # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # s2_ptr	$6
+ # size		$7
+
+	.text
+	.align	2
+	.globl	__gmpn_add_n
+	.ent	__gmpn_add_n
+__gmpn_add_n:
+	.set	noreorder
+	.set	nomacro
+
+	ld	$10,0($5)
+	ld	$11,0($6)
+
+	daddiu	$7,$7,-1
+	and	$9,$7,4-1	# number of limbs in first loop
+	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
+	 move	$2,$0
+
+	dsubu	$7,$7,$9
+
+.Loop0:	daddiu	$9,$9,-1
+	ld	$12,8($5)
+	daddu	$11,$11,$2
+	ld	$13,8($6)
+	sltu	$8,$11,$2
+	daddu	$11,$10,$11
+	sltu	$2,$11,$10
+	sd	$11,0($4)
+	or	$2,$2,$8
+
+	daddiu	$5,$5,8
+	daddiu	$6,$6,8
+	move	$10,$12
+	move	$11,$13
+	bne	$9,$0,.Loop0
+	 daddiu	$4,$4,8
+
+.L0:	beq	$7,$0,.Lend
+	 nop
+
+.Loop:	daddiu	$7,$7,-4
+
+	ld	$12,8($5)
+	daddu	$11,$11,$2
+	ld	$13,8($6)
+	sltu	$8,$11,$2
+	daddu	$11,$10,$11
+	sltu	$2,$11,$10
+	sd	$11,0($4)
+	or	$2,$2,$8
+
+	ld	$10,16($5)
+	daddu	$13,$13,$2
+	ld	$11,16($6)
+	sltu	$8,$13,$2
+	daddu	$13,$12,$13
+	sltu	$2,$13,$12
+	sd	$13,8($4)
+	or	$2,$2,$8
+
+	ld	$12,24($5)
+	daddu	$11,$11,$2
+	ld	$13,24($6)
+	sltu	$8,$11,$2
+	daddu	$11,$10,$11
+	sltu	$2,$11,$10
+	sd	$11,16($4)
+	or	$2,$2,$8
+
+	ld	$10,32($5)
+	daddu	$13,$13,$2
+	ld	$11,32($6)
+	sltu	$8,$13,$2
+	daddu	$13,$12,$13
+	sltu	$2,$13,$12
+	sd	$13,24($4)
+	or	$2,$2,$8
+
+	daddiu	$5,$5,32
+	daddiu	$6,$6,32
+
+	bne	$7,$0,.Loop
+	 daddiu	$4,$4,32
+
+.Lend:	daddu	$11,$11,$2
+	sltu	$8,$11,$2
+	daddu	$11,$10,$11
+	sltu	$2,$11,$10
+	sd	$11,0($4)
+	j	$31
+	or	$2,$2,$8
+
+	.end	__gmpn_add_n
diff --git a/src/gmp/mpn/mips3/addmul_1.s b/src/gmp/mpn/mips3/addmul_1.s
new file mode 100644
index 000000000..d390e2298
--- /dev/null
+++ b/src/gmp/mpn/mips3/addmul_1.s
@@ -0,0 +1,97 @@
+ # MIPS3 __gmpn_addmul_1 -- Multiply a limb vector with a single limb and
+ # add the product to a second limb vector.
+
+ # Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # size		$6
+ # s2_limb	$7
+
+	.text
+	.align	4
+	.globl	__gmpn_addmul_1
+	.ent	__gmpn_addmul_1
+__gmpn_addmul_1:
+	.set    noreorder
+	.set    nomacro
+
+ # warm up phase 0
+	ld	$8,0($5)
+
+ # warm up phase 1
+	daddiu	$5,$5,8
+	dmultu	$8,$7
+
+	daddiu	$6,$6,-1
+	beq	$6,$0,$LC0
+	 move	$2,$0		# zero cy2
+
+	daddiu	$6,$6,-1
+	beq	$6,$0,$LC1
+	ld	$8,0($5)	# load new s1 limb as early as possible
+
+Loop:	ld	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	daddiu	$5,$5,8
+	daddu	$3,$3,$2	# add old carry limb to low product limb
+	dmultu	$8,$7
+	ld	$8,0($5)	# load new s1 limb as early as possible
+	daddiu	$6,$6,-1	# decrement loop counter
+	sltu	$2,$3,$2	# carry from previous addition -> $2
+	daddu	$3,$10,$3
+	sltu	$10,$3,$10
+	daddu	$2,$2,$10
+	sd	$3,0($4)
+	daddiu	$4,$4,8
+	bne	$6,$0,Loop
+	 daddu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 1
+$LC1:	ld	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	daddu	$3,$3,$2
+	sltu	$2,$3,$2
+	dmultu	$8,$7
+	daddu	$3,$10,$3
+	sltu	$10,$3,$10
+	daddu	$2,$2,$10
+	sd	$3,0($4)
+	daddiu	$4,$4,8
+	daddu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 0
+$LC0:	ld	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	daddu	$3,$3,$2
+	sltu	$2,$3,$2
+	daddu	$3,$10,$3
+	sltu	$10,$3,$10
+	daddu	$2,$2,$10
+	sd	$3,0($4)
+	j	$31
+	daddu	$2,$9,$2	# add high product limb and carry from addition
+
+	.end	__gmpn_addmul_1
diff --git a/src/gmp/mpn/mips3/gmp-mparam.h b/src/gmp/mpn/mips3/gmp-mparam.h
new file mode 100644
index 000000000..656e90c7b
--- /dev/null
+++ b/src/gmp/mpn/mips3/gmp-mparam.h
@@ -0,0 +1,58 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 64
+#define BYTES_PER_MP_LIMB 8
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+/* These values are for the R10000 usign the system cc.  */
+/* Generated by tuneup.c, 2000-07-25. */
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD 16
+#endif
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD 32
+#endif
+
+/* Supressed the TOOM3 values as they looked absolutely crazy
+   (698 and 21 respectively) */
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              58
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD             54
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            82
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        4
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD         159
+#endif
diff --git a/src/gmp/mpn/mips3/lshift.s b/src/gmp/mpn/mips3/lshift.s
new file mode 100644
index 000000000..372606fdd
--- /dev/null
+++ b/src/gmp/mpn/mips3/lshift.s
@@ -0,0 +1,95 @@
+ # MIPS3 __gmpn_lshift --
+
+ # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # src_ptr	$5
+ # size		$6
+ # cnt		$7
+
+	.text
+	.align	2
+	.globl	__gmpn_lshift
+	.ent	__gmpn_lshift
+__gmpn_lshift:
+	.set	noreorder
+	.set	nomacro
+
+	dsll	$2,$6,3
+	daddu	$5,$5,$2	# make r5 point at end of src
+	ld	$10,-8($5)	# load first limb
+	dsubu	$13,$0,$7
+	daddu	$4,$4,$2	# make r4 point at end of res
+	daddiu	$6,$6,-1
+	and	$9,$6,4-1	# number of limbs in first loop
+	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
+	 dsrl	$2,$10,$13	# compute function result
+
+	dsubu	$6,$6,$9
+
+.Loop0:	ld	$3,-16($5)
+	daddiu	$4,$4,-8
+	daddiu	$5,$5,-8
+	daddiu	$9,$9,-1
+	dsll	$11,$10,$7
+	dsrl	$12,$3,$13
+	move	$10,$3
+	or	$8,$11,$12
+	bne	$9,$0,.Loop0
+	 sd	$8,0($4)
+
+.L0:	beq	$6,$0,.Lend
+	 nop
+
+.Loop:	ld	$3,-16($5)
+	daddiu	$4,$4,-32
+	daddiu	$6,$6,-4
+	dsll	$11,$10,$7
+	dsrl	$12,$3,$13
+
+	ld	$10,-24($5)
+	dsll	$14,$3,$7
+	or	$8,$11,$12
+	sd	$8,24($4)
+	dsrl	$9,$10,$13
+
+	ld	$3,-32($5)
+	dsll	$11,$10,$7
+	or	$8,$14,$9
+	sd	$8,16($4)
+	dsrl	$12,$3,$13
+
+	ld	$10,-40($5)
+	dsll	$14,$3,$7
+	or	$8,$11,$12
+	sd	$8,8($4)
+	dsrl	$9,$10,$13
+
+	daddiu	$5,$5,-32
+	or	$8,$14,$9
+	bgtz	$6,.Loop
+	 sd	$8,0($4)
+
+.Lend:	dsll	$8,$10,$7
+	j	$31
+	sd	$8,-8($4)
+	.end	__gmpn_lshift
diff --git a/src/gmp/mpn/mips3/mul_1.s b/src/gmp/mpn/mips3/mul_1.s
new file mode 100644
index 000000000..6659e2b4e
--- /dev/null
+++ b/src/gmp/mpn/mips3/mul_1.s
@@ -0,0 +1,85 @@
+ # MIPS3 __gmpn_mul_1 -- Multiply a limb vector with a single limb and
+ # store the product in a second limb vector.
+
+ # Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # size		$6
+ # s2_limb	$7
+
+	.text
+	.align	4
+	.globl	__gmpn_mul_1
+	.ent	__gmpn_mul_1
+__gmpn_mul_1:
+	.set    noreorder
+	.set    nomacro
+
+ # warm up phase 0
+	ld	$8,0($5)
+
+ # warm up phase 1
+	daddiu	$5,$5,8
+	dmultu	$8,$7
+
+	daddiu	$6,$6,-1
+	beq	$6,$0,$LC0
+	 move	$2,$0		# zero cy2
+
+	daddiu	$6,$6,-1
+	beq	$6,$0,$LC1
+	ld	$8,0($5)	# load new s1 limb as early as possible
+
+Loop:	mflo	$10
+	mfhi	$9
+	daddiu	$5,$5,8
+	daddu	$10,$10,$2	# add old carry limb to low product limb
+	dmultu	$8,$7
+	ld	$8,0($5)	# load new s1 limb as early as possible
+	daddiu	$6,$6,-1	# decrement loop counter
+	sltu	$2,$10,$2	# carry from previous addition -> $2
+	sd	$10,0($4)
+	daddiu	$4,$4,8
+	bne	$6,$0,Loop
+	 daddu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 1
+$LC1:	mflo	$10
+	mfhi	$9
+	daddu	$10,$10,$2
+	sltu	$2,$10,$2
+	dmultu	$8,$7
+	sd	$10,0($4)
+	daddiu	$4,$4,8
+	daddu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 0
+$LC0:	mflo	$10
+	mfhi	$9
+	daddu	$10,$10,$2
+	sltu	$2,$10,$2
+	sd	$10,0($4)
+	j	$31
+	daddu	$2,$9,$2	# add high product limb and carry from addition
+
+	.end	__gmpn_mul_1
diff --git a/src/gmp/mpn/mips3/rshift.s b/src/gmp/mpn/mips3/rshift.s
new file mode 100644
index 000000000..59c7fd349
--- /dev/null
+++ b/src/gmp/mpn/mips3/rshift.s
@@ -0,0 +1,92 @@
+ # MIPS3 __gmpn_rshift --
+
+ # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # src_ptr	$5
+ # size		$6
+ # cnt		$7
+
+	.text
+	.align	2
+	.globl	__gmpn_rshift
+	.ent	__gmpn_rshift
+__gmpn_rshift:
+	.set	noreorder
+	.set	nomacro
+
+	ld	$10,0($5)	# load first limb
+	dsubu	$13,$0,$7
+	daddiu	$6,$6,-1
+	and	$9,$6,4-1	# number of limbs in first loop
+	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
+	 dsll	$2,$10,$13	# compute function result
+
+	dsubu	$6,$6,$9
+
+.Loop0:	ld	$3,8($5)
+	daddiu	$4,$4,8
+	daddiu	$5,$5,8
+	daddiu	$9,$9,-1
+	dsrl	$11,$10,$7
+	dsll	$12,$3,$13
+	move	$10,$3
+	or	$8,$11,$12
+	bne	$9,$0,.Loop0
+	 sd	$8,-8($4)
+
+.L0:	beq	$6,$0,.Lend
+	 nop
+
+.Loop:	ld	$3,8($5)
+	daddiu	$4,$4,32
+	daddiu	$6,$6,-4
+	dsrl	$11,$10,$7
+	dsll	$12,$3,$13
+
+	ld	$10,16($5)
+	dsrl	$14,$3,$7
+	or	$8,$11,$12
+	sd	$8,-32($4)
+	dsll	$9,$10,$13
+
+	ld	$3,24($5)
+	dsrl	$11,$10,$7
+	or	$8,$14,$9
+	sd	$8,-24($4)
+	dsll	$12,$3,$13
+
+	ld	$10,32($5)
+	dsrl	$14,$3,$7
+	or	$8,$11,$12
+	sd	$8,-16($4)
+	dsll	$9,$10,$13
+
+	daddiu	$5,$5,32
+	or	$8,$14,$9
+	bgtz	$6,.Loop
+	 sd	$8,-8($4)
+
+.Lend:	dsrl	$8,$10,$7
+	j	$31
+	sd	$8,0($4)
+	.end	__gmpn_rshift
diff --git a/src/gmp/mpn/mips3/sub_n.s b/src/gmp/mpn/mips3/sub_n.s
new file mode 100644
index 000000000..c57c824b0
--- /dev/null
+++ b/src/gmp/mpn/mips3/sub_n.s
@@ -0,0 +1,120 @@
+ # MIPS3 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+ # store difference in a third limb vector.
+
+ # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # s2_ptr	$6
+ # size		$7
+
+	.text
+	.align	2
+	.globl	__gmpn_sub_n
+	.ent	__gmpn_sub_n
+__gmpn_sub_n:
+	.set	noreorder
+	.set	nomacro
+
+	ld	$10,0($5)
+	ld	$11,0($6)
+
+	daddiu	$7,$7,-1
+	and	$9,$7,4-1	# number of limbs in first loop
+	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
+	 move	$2,$0
+
+	dsubu	$7,$7,$9
+
+.Loop0:	daddiu	$9,$9,-1
+	ld	$12,8($5)
+	daddu	$11,$11,$2
+	ld	$13,8($6)
+	sltu	$8,$11,$2
+	dsubu	$11,$10,$11
+	sltu	$2,$10,$11
+	sd	$11,0($4)
+	or	$2,$2,$8
+
+	daddiu	$5,$5,8
+	daddiu	$6,$6,8
+	move	$10,$12
+	move	$11,$13
+	bne	$9,$0,.Loop0
+	 daddiu	$4,$4,8
+
+.L0:	beq	$7,$0,.Lend
+	 nop
+
+.Loop:	daddiu	$7,$7,-4
+
+	ld	$12,8($5)
+	daddu	$11,$11,$2
+	ld	$13,8($6)
+	sltu	$8,$11,$2
+	dsubu	$11,$10,$11
+	sltu	$2,$10,$11
+	sd	$11,0($4)
+	or	$2,$2,$8
+
+	ld	$10,16($5)
+	daddu	$13,$13,$2
+	ld	$11,16($6)
+	sltu	$8,$13,$2
+	dsubu	$13,$12,$13
+	sltu	$2,$12,$13
+	sd	$13,8($4)
+	or	$2,$2,$8
+
+	ld	$12,24($5)
+	daddu	$11,$11,$2
+	ld	$13,24($6)
+	sltu	$8,$11,$2
+	dsubu	$11,$10,$11
+	sltu	$2,$10,$11
+	sd	$11,16($4)
+	or	$2,$2,$8
+
+	ld	$10,32($5)
+	daddu	$13,$13,$2
+	ld	$11,32($6)
+	sltu	$8,$13,$2
+	dsubu	$13,$12,$13
+	sltu	$2,$12,$13
+	sd	$13,24($4)
+	or	$2,$2,$8
+
+	daddiu	$5,$5,32
+	daddiu	$6,$6,32
+
+	bne	$7,$0,.Loop
+	 daddiu	$4,$4,32
+
+.Lend:	daddu	$11,$11,$2
+	sltu	$8,$11,$2
+	dsubu	$11,$10,$11
+	sltu	$2,$10,$11
+	sd	$11,0($4)
+	j	$31
+	or	$2,$2,$8
+
+	.end	__gmpn_sub_n
diff --git a/src/gmp/mpn/mips3/submul_1.s b/src/gmp/mpn/mips3/submul_1.s
new file mode 100644
index 000000000..531f9705a
--- /dev/null
+++ b/src/gmp/mpn/mips3/submul_1.s
@@ -0,0 +1,97 @@
+ # MIPS3 __gmpn_submul_1 -- Multiply a limb vector with a single limb and
+ # subtract the product from a second limb vector.
+
+ # Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+ # This file is part of the GNU MP Library.
+
+ # The GNU MP Library is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU Lesser General Public License as published by
+ # the Free Software Foundation; either version 2.1 of the License, or (at your
+ # option) any later version.
+
+ # The GNU MP Library is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ # License for more details.
+
+ # You should have received a copy of the GNU Lesser General Public License
+ # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ # MA 02111-1307, USA.
+
+
+ # INPUT PARAMETERS
+ # res_ptr	$4
+ # s1_ptr	$5
+ # size		$6
+ # s2_limb	$7
+
+	.text
+	.align	4
+	.globl	__gmpn_submul_1
+	.ent	__gmpn_submul_1
+__gmpn_submul_1:
+	.set    noreorder
+	.set    nomacro
+
+ # warm up phase 0
+	ld	$8,0($5)
+
+ # warm up phase 1
+	daddiu	$5,$5,8
+	dmultu	$8,$7
+
+	daddiu	$6,$6,-1
+	beq	$6,$0,$LC0
+	 move	$2,$0		# zero cy2
+
+	daddiu	$6,$6,-1
+	beq	$6,$0,$LC1
+	ld	$8,0($5)	# load new s1 limb as early as possible
+
+Loop:	ld	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	daddiu	$5,$5,8
+	daddu	$3,$3,$2	# add old carry limb to low product limb
+	dmultu	$8,$7
+	ld	$8,0($5)	# load new s1 limb as early as possible
+	daddiu	$6,$6,-1	# decrement loop counter
+	sltu	$2,$3,$2	# carry from previous addition -> $2
+	dsubu	$3,$10,$3
+	sgtu	$10,$3,$10
+	daddu	$2,$2,$10
+	sd	$3,0($4)
+	daddiu	$4,$4,8
+	bne	$6,$0,Loop
+	 daddu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 1
+$LC1:	ld	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	daddu	$3,$3,$2
+	sltu	$2,$3,$2
+	dmultu	$8,$7
+	dsubu	$3,$10,$3
+	sgtu	$10,$3,$10
+	daddu	$2,$2,$10
+	sd	$3,0($4)
+	daddiu	$4,$4,8
+	daddu	$2,$9,$2	# add high product limb and carry from addition
+
+ # cool down phase 0
+$LC0:	ld	$10,0($4)
+	mflo	$3
+	mfhi	$9
+	daddu	$3,$3,$2
+	sltu	$2,$3,$2
+	dsubu	$3,$10,$3
+	sgtu	$10,$3,$10
+	daddu	$2,$2,$10
+	sd	$3,0($4)
+	j	$31
+	daddu	$2,$9,$2	# add high product limb and carry from addition
+
+	.end	__gmpn_submul_1
diff --git a/src/gmp/mpn/mp_bases.c b/src/gmp/mpn/mp_bases.c
new file mode 100644
index 000000000..011c328c8
--- /dev/null
+++ b/src/gmp/mpn/mp_bases.c
@@ -0,0 +1,550 @@
+/* __mp_bases -- Structure for conversion between internal binary
+   format and strings in base 2..255.  The fields are explained in
+   gmp-impl.h.
+
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+#if BITS_PER_MP_LIMB == 32
+const struct bases __mp_bases[256] =
+{
+  /*  0 */ {0, 0.0, 0, 0},
+  /*  1 */ {0, 1e38, 0, 0},
+  /*  2 */ {32, 1.0000000000000000, 0x1, 0x0},
+  /*  3 */ {20, 0.6309297535714575, 0xcfd41b91, 0x3b563c24},
+  /*  4 */ {16, 0.5000000000000000, 0x2, 0x0},
+  /*  5 */ {13, 0.4306765580733931, 0x48c27395, 0xc25c2684},
+  /*  6 */ {12, 0.3868528072345416, 0x81bf1000, 0xf91bd1b6},
+  /*  7 */ {11, 0.3562071871080222, 0x75db9c97, 0x1607a2cb},
+  /*  8 */ {10, 0.3333333333333334, 0x3, 0x0},
+  /*  9 */ {10, 0.3154648767857287, 0xcfd41b91, 0x3b563c24},
+  /* 10 */ {9, 0.3010299956639811, 0x3b9aca00, 0x12e0be82},
+  /* 11 */ {9, 0.2890648263178878, 0x8c8b6d2b, 0xd24cde04},
+  /* 12 */ {8, 0.2789429456511298, 0x19a10000, 0x3fa39ab5},
+  /* 13 */ {8, 0.2702381544273197, 0x309f1021, 0x50f8ac5f},
+  /* 14 */ {8, 0.2626495350371936, 0x57f6c100, 0x74843b1e},
+  /* 15 */ {8, 0.2559580248098155, 0x98c29b81, 0xad0326c2},
+  /* 16 */ {8, 0.2500000000000000, 0x4, 0x0},
+  /* 17 */ {7, 0.2446505421182260, 0x18754571, 0x4ef0b6bd},
+  /* 18 */ {7, 0.2398124665681315, 0x247dbc80, 0xc0fc48a1},
+  /* 19 */ {7, 0.2354089133666382, 0x3547667b, 0x33838942},
+  /* 20 */ {7, 0.2313782131597592, 0x4c4b4000, 0xad7f29ab},
+  /* 21 */ {7, 0.2276702486969530, 0x6b5a6e1d, 0x313c3d15},
+  /* 22 */ {7, 0.2242438242175754, 0x94ace180, 0xb8cca9e0},
+  /* 23 */ {7, 0.2210647294575037, 0xcaf18367, 0x42ed6de9},
+  /* 24 */ {6, 0.2181042919855316, 0xb640000, 0x67980e0b},
+  /* 25 */ {6, 0.2153382790366965, 0xe8d4a51, 0x19799812},
+  /* 26 */ {6, 0.2127460535533632, 0x1269ae40, 0xbce85396},
+  /* 27 */ {6, 0.2103099178571525, 0x17179149, 0x62c103a9},
+  /* 28 */ {6, 0.2080145976765095, 0x1cb91000, 0x1d353d43},
+  /* 29 */ {6, 0.2058468324604344, 0x23744899, 0xce1decea},
+  /* 30 */ {6, 0.2037950470905062, 0x2b73a840, 0x790fc511},
+  /* 31 */ {6, 0.2018490865820999, 0x34e63b41, 0x35b865a0},
+  /* 32 */ {6, 0.2000000000000000, 0x5, 0x0},
+  /* 33 */ {6, 0.1982398631705605, 0x4cfa3cc1, 0xa9aed1b3},
+  /* 34 */ {6, 0.1965616322328226, 0x5c13d840, 0x63dfc229},
+  /* 35 */ {6, 0.1949590218937863, 0x6d91b519, 0x2b0fee30},
+  /* 36 */ {6, 0.1934264036172708, 0x81bf1000, 0xf91bd1b6},
+  /* 37 */ {6, 0.1919587200065601, 0x98ede0c9, 0xac89c3a9},
+  /* 38 */ {6, 0.1905514124267734, 0xb3773e40, 0x6d2c32fe},
+  /* 39 */ {6, 0.1892003595168700, 0xd1bbc4d1, 0x387907c9},
+  /* 40 */ {6, 0.1879018247091076, 0xf4240000, 0xc6f7a0b},
+  /* 41 */ {5, 0.1866524112389434, 0x6e7d349, 0x28928154},
+  /* 42 */ {5, 0.1854490234153689, 0x7ca30a0, 0x6e8629d},
+  /* 43 */ {5, 0.1842888331487062, 0x8c32bbb, 0xd373dca0},
+  /* 44 */ {5, 0.1831692509136336, 0x9d46c00, 0xa0b17895},
+  /* 45 */ {5, 0.1820879004699383, 0xaffacfd, 0x746811a5},
+  /* 46 */ {5, 0.1810425967800402, 0xc46bee0, 0x4da6500f},
+  /* 47 */ {5, 0.1800313266566926, 0xdab86ef, 0x2ba23582},
+  /* 48 */ {5, 0.1790522317510414, 0xf300000, 0xdb20a88},
+  /* 49 */ {5, 0.1781035935540111, 0x10d63af1, 0xe68d5ce4},
+  /* 50 */ {5, 0.1771838201355579, 0x12a05f20, 0xb7cdfd9d},
+  /* 51 */ {5, 0.1762914343888821, 0x1490aae3, 0x8e583933},
+  /* 52 */ {5, 0.1754250635819545, 0x16a97400, 0x697cc3ea},
+  /* 53 */ {5, 0.1745834300480449, 0x18ed2825, 0x48a5ca6c},
+  /* 54 */ {5, 0.1737653428714400, 0x1b5e4d60, 0x2b52db16},
+  /* 55 */ {5, 0.1729696904450771, 0x1dff8297, 0x111586a6},
+  /* 56 */ {5, 0.1721954337940981, 0x20d38000, 0xf31d2b36},
+  /* 57 */ {5, 0.1714416005739134, 0x23dd1799, 0xc8d76d19},
+  /* 58 */ {5, 0.1707072796637201, 0x271f35a0, 0xa2cb1eb4},
+  /* 59 */ {5, 0.1699916162869140, 0x2a9ce10b, 0x807c3ec3},
+  /* 60 */ {5, 0.1692938075987814, 0x2e593c00, 0x617ec8bf},
+  /* 61 */ {5, 0.1686130986895011, 0x3257844d, 0x45746cbe},
+  /* 62 */ {5, 0.1679487789570419, 0x369b13e0, 0x2c0aa273},
+  /* 63 */ {5, 0.1673001788101741, 0x3b27613f, 0x14f90805},
+  /* 64 */ {5, 0.1666666666666667, 0x6, 0x0},
+  /* 65 */ {5, 0.1660476462159378, 0x4528a141, 0xd9cf0829},
+  /* 66 */ {5, 0.1654425539190583, 0x4aa51420, 0xb6fc4841},
+  /* 67 */ {5, 0.1648508567221604, 0x50794633, 0x973054cb},
+  /* 68 */ {5, 0.1642720499620502, 0x56a94400, 0x7a1dbe4b},
+  /* 69 */ {5, 0.1637056554452156, 0x5d393975, 0x5f7fcd7f},
+  /* 70 */ {5, 0.1631512196835108, 0x642d7260, 0x47196c84},
+  /* 71 */ {5, 0.1626083122716341, 0x6b8a5ae7, 0x30b43635},
+  /* 72 */ {5, 0.1620765243931223, 0x73548000, 0x1c1fa5f6},
+  /* 73 */ {5, 0.1615554674429964, 0x7b908fe9, 0x930634a},
+  /* 74 */ {5, 0.1610447717564445, 0x84435aa0, 0xef7f4a3c},
+  /* 75 */ {5, 0.1605440854340214, 0x8d71d25b, 0xcf5552d2},
+  /* 76 */ {5, 0.1600530732548213, 0x97210c00, 0xb1a47c8e},
+  /* 77 */ {5, 0.1595714156699382, 0xa1563f9d, 0x9634b43e},
+  /* 78 */ {5, 0.1590988078692941, 0xac16c8e0, 0x7cd3817d},
+  /* 79 */ {5, 0.1586349589155960, 0xb768278f, 0x65536761},
+  /* 80 */ {5, 0.1581795909397823, 0xc3500000, 0x4f8b588e},
+  /* 81 */ {5, 0.1577324383928644, 0xcfd41b91, 0x3b563c24},
+  /* 82 */ {5, 0.1572932473495469, 0xdcfa6920, 0x28928154},
+  /* 83 */ {5, 0.1568617748594410, 0xeac8fd83, 0x1721bfb0},
+  /* 84 */ {5, 0.1564377883420716, 0xf9461400, 0x6e8629d},
+  /* 85 */ {4, 0.1560210650222250, 0x31c84b1, 0x491cc17c},
+  /* 86 */ {4, 0.1556113914024940, 0x342ab10, 0x3a11d83b},
+  /* 87 */ {4, 0.1552085627701551, 0x36a2c21, 0x2be074cd},
+  /* 88 */ {4, 0.1548123827357682, 0x3931000, 0x1e7a02e7},
+  /* 89 */ {4, 0.1544226628011101, 0x3bd5ee1, 0x11d10edd},
+  /* 90 */ {4, 0.1540392219542636, 0x3e92110, 0x5d92c68},
+  /* 91 */ {4, 0.1536618862898642, 0x4165ef1, 0xf50dbfb2},
+  /* 92 */ {4, 0.1532904886526781, 0x4452100, 0xdf9f1316},
+  /* 93 */ {4, 0.1529248683028321, 0x4756fd1, 0xcb52a684},
+  /* 94 */ {4, 0.1525648706011593, 0x4a75410, 0xb8163e97},
+  /* 95 */ {4, 0.1522103467132434, 0x4dad681, 0xa5d8f269},
+  /* 96 */ {4, 0.1518611533308632, 0x5100000, 0x948b0fcd},
+  /* 97 */ {4, 0.1515171524096389, 0x546d981, 0x841e0215},
+  /* 98 */ {4, 0.1511782109217764, 0x57f6c10, 0x74843b1e},
+  /* 99 */ {4, 0.1508442006228941, 0x5b9c0d1, 0x65b11e6e},
+  /* 100 */ {4, 0.1505149978319906, 0x5f5e100, 0x5798ee23},
+  /* 101 */ {4, 0.1501904832236879, 0x633d5f1, 0x4a30b99b},
+  /* 102 */ {4, 0.1498705416319474, 0x673a910, 0x3d6e4d94},
+  /* 103 */ {4, 0.1495550618645152, 0x6b563e1, 0x314825b0},
+  /* 104 */ {4, 0.1492439365274121, 0x6f91000, 0x25b55f2e},
+  /* 105 */ {4, 0.1489370618588283, 0x73eb721, 0x1aadaccb},
+  /* 106 */ {4, 0.1486343375718350, 0x7866310, 0x10294ba2},
+  /* 107 */ {4, 0.1483356667053617, 0x7d01db1, 0x620f8f6},
+  /* 108 */ {4, 0.1480409554829326, 0x81bf100, 0xf91bd1b6},
+  /* 109 */ {4, 0.1477501131786861, 0x869e711, 0xe6d37b2a},
+  /* 110 */ {4, 0.1474630519902391, 0x8ba0a10, 0xd55cff6e},
+  /* 111 */ {4, 0.1471796869179852, 0x90c6441, 0xc4ad2db2},
+  /* 112 */ {4, 0.1468999356504447, 0x9610000, 0xb4b985cf},
+  /* 113 */ {4, 0.1466237184553111, 0x9b7e7c1, 0xa5782bef},
+  /* 114 */ {4, 0.1463509580758620, 0xa112610, 0x96dfdd2a},
+  /* 115 */ {4, 0.1460815796324244, 0xa6cc591, 0x88e7e509},
+  /* 116 */ {4, 0.1458155105286054, 0xacad100, 0x7b8813d3},
+  /* 117 */ {4, 0.1455526803620167, 0xb2b5331, 0x6eb8b595},
+  /* 118 */ {4, 0.1452930208392428, 0xb8e5710, 0x627289db},
+  /* 119 */ {4, 0.1450364656948130, 0xbf3e7a1, 0x56aebc07},
+  /* 120 */ {4, 0.1447829506139581, 0xc5c1000, 0x4b66dc33},
+  /* 121 */ {4, 0.1445324131589439, 0xcc6db61, 0x4094d8a3},
+  /* 122 */ {4, 0.1442847926987864, 0xd345510, 0x3632f7a5},
+  /* 123 */ {4, 0.1440400303421672, 0xda48871, 0x2c3bd1f0},
+  /* 124 */ {4, 0.1437980688733775, 0xe178100, 0x22aa4d5f},
+  /* 125 */ {4, 0.1435588526911310, 0xe8d4a51, 0x19799812},
+  /* 126 */ {4, 0.1433223277500932, 0xf05f010, 0x10a523e5},
+  /* 127 */ {4, 0.1430884415049874, 0xf817e01, 0x828a237},
+  /* 128 */ {4, 0.1428571428571428, 0x7, 0x0},
+  /* 129 */ {4, 0.1426283821033600, 0x10818201, 0xf04ec452},
+  /* 130 */ {4, 0.1424021108869747, 0x11061010, 0xe136444a},
+  /* 131 */ {4, 0.1421782821510107, 0x118db651, 0xd2af9589},
+  /* 132 */ {4, 0.1419568500933153, 0x12188100, 0xc4b42a83},
+  /* 133 */ {4, 0.1417377701235801, 0x12a67c71, 0xb73dccf5},
+  /* 134 */ {4, 0.1415209988221527, 0x1337b510, 0xaa4698c5},
+  /* 135 */ {4, 0.1413064939005528, 0x13cc3761, 0x9dc8f729},
+  /* 136 */ {4, 0.1410942141636095, 0x14641000, 0x91bf9a30},
+  /* 137 */ {4, 0.1408841194731412, 0x14ff4ba1, 0x86257887},
+  /* 138 */ {4, 0.1406761707131039, 0x159df710, 0x7af5c98c},
+  /* 139 */ {4, 0.1404703297561400, 0x16401f31, 0x702c01a0},
+  /* 140 */ {4, 0.1402665594314587, 0x16e5d100, 0x65c3ceb1},
+  /* 141 */ {4, 0.1400648234939879, 0x178f1991, 0x5bb91502},
+  /* 142 */ {4, 0.1398650865947379, 0x183c0610, 0x5207ec23},
+  /* 143 */ {4, 0.1396673142523192, 0x18eca3c1, 0x48ac9c19},
+  /* 144 */ {4, 0.1394714728255649, 0x19a10000, 0x3fa39ab5},
+  /* 145 */ {4, 0.1392775294872041, 0x1a592841, 0x36e98912},
+  /* 146 */ {4, 0.1390854521985406, 0x1b152a10, 0x2e7b3140},
+  /* 147 */ {4, 0.1388952096850913, 0x1bd51311, 0x2655840b},
+  /* 148 */ {4, 0.1387067714131417, 0x1c98f100, 0x1e7596ea},
+  /* 149 */ {4, 0.1385201075671774, 0x1d60d1b1, 0x16d8a20d},
+  /* 150 */ {4, 0.1383351890281539, 0x1e2cc310, 0xf7bfe87},
+  /* 151 */ {4, 0.1381519873525671, 0x1efcd321, 0x85d2492},
+  /* 152 */ {4, 0.1379704747522905, 0x1fd11000, 0x179a9f4},
+  /* 153 */ {4, 0.1377906240751463, 0x20a987e1, 0xf59e80eb},
+  /* 154 */ {4, 0.1376124087861776, 0x21864910, 0xe8b768db},
+  /* 155 */ {4, 0.1374358029495937, 0x226761f1, 0xdc39d6d5},
+  /* 156 */ {4, 0.1372607812113589, 0x234ce100, 0xd021c5d1},
+  /* 157 */ {4, 0.1370873187823978, 0x2436d4d1, 0xc46b5e37},
+  /* 158 */ {4, 0.1369153914223921, 0x25254c10, 0xb912f39c},
+  /* 159 */ {4, 0.1367449754241439, 0x26185581, 0xae150294},
+  /* 160 */ {4, 0.1365760475984821, 0x27100000, 0xa36e2eb1},
+  /* 161 */ {4, 0.1364085852596902, 0x280c5a81, 0x991b4094},
+  /* 162 */ {4, 0.1362425662114337, 0x290d7410, 0x8f19241e},
+  /* 163 */ {4, 0.1360779687331669, 0x2a135bd1, 0x8564e6b7},
+  /* 164 */ {4, 0.1359147715670014, 0x2b1e2100, 0x7bfbb5b4},
+  /* 165 */ {4, 0.1357529539050150, 0x2c2dd2f1, 0x72dadcc8},
+  /* 166 */ {4, 0.1355924953769863, 0x2d428110, 0x69ffc498},
+  /* 167 */ {4, 0.1354333760385373, 0x2e5c3ae1, 0x6167f154},
+  /* 168 */ {4, 0.1352755763596663, 0x2f7b1000, 0x5911016e},
+  /* 169 */ {4, 0.1351190772136599, 0x309f1021, 0x50f8ac5f},
+  /* 170 */ {4, 0.1349638598663645, 0x31c84b10, 0x491cc17c},
+  /* 171 */ {4, 0.1348099059658079, 0x32f6d0b1, 0x417b26d8},
+  /* 172 */ {4, 0.1346571975321549, 0x342ab100, 0x3a11d83b},
+  /* 173 */ {4, 0.1345057169479844, 0x3563fc11, 0x32dee622},
+  /* 174 */ {4, 0.1343554469488779, 0x36a2c210, 0x2be074cd},
+  /* 175 */ {4, 0.1342063706143054, 0x37e71341, 0x2514bb58},
+  /* 176 */ {4, 0.1340584713587980, 0x39310000, 0x1e7a02e7},
+  /* 177 */ {4, 0.1339117329233981, 0x3a8098c1, 0x180ea5d0},
+  /* 178 */ {4, 0.1337661393673756, 0x3bd5ee10, 0x11d10edd},
+  /* 179 */ {4, 0.1336216750601996, 0x3d311091, 0xbbfb88e},
+  /* 180 */ {4, 0.1334783246737591, 0x3e921100, 0x5d92c68},
+  /* 181 */ {4, 0.1333360731748201, 0x3ff90031, 0x1c024c},
+  /* 182 */ {4, 0.1331949058177136, 0x4165ef10, 0xf50dbfb2},
+  /* 183 */ {4, 0.1330548081372441, 0x42d8eea1, 0xea30efa3},
+  /* 184 */ {4, 0.1329157659418126, 0x44521000, 0xdf9f1316},
+  /* 185 */ {4, 0.1327777653067443, 0x45d16461, 0xd555c0c9},
+  /* 186 */ {4, 0.1326407925678156, 0x4756fd10, 0xcb52a684},
+  /* 187 */ {4, 0.1325048343149731, 0x48e2eb71, 0xc193881f},
+  /* 188 */ {4, 0.1323698773862368, 0x4a754100, 0xb8163e97},
+  /* 189 */ {4, 0.1322359088617821, 0x4c0e0f51, 0xaed8b724},
+  /* 190 */ {4, 0.1321029160581950, 0x4dad6810, 0xa5d8f269},
+  /* 191 */ {4, 0.1319708865228925, 0x4f535d01, 0x9d15039d},
+  /* 192 */ {4, 0.1318398080287045, 0x51000000, 0x948b0fcd},
+  /* 193 */ {4, 0.1317096685686114, 0x52b36301, 0x8c394d1d},
+  /* 194 */ {4, 0.1315804563506306, 0x546d9810, 0x841e0215},
+  /* 195 */ {4, 0.1314521597928493, 0x562eb151, 0x7c3784f8},
+  /* 196 */ {4, 0.1313247675185968, 0x57f6c100, 0x74843b1e},
+  /* 197 */ {4, 0.1311982683517524, 0x59c5d971, 0x6d02985d},
+  /* 198 */ {4, 0.1310726513121843, 0x5b9c0d10, 0x65b11e6e},
+  /* 199 */ {4, 0.1309479056113158, 0x5d796e61, 0x5e8e5c64},
+  /* 200 */ {4, 0.1308240206478128, 0x5f5e1000, 0x5798ee23},
+  /* 201 */ {4, 0.1307009860033912, 0x614a04a1, 0x50cf7bde},
+  /* 202 */ {4, 0.1305787914387386, 0x633d5f10, 0x4a30b99b},
+  /* 203 */ {4, 0.1304574268895465, 0x65383231, 0x43bb66bd},
+  /* 204 */ {4, 0.1303368824626505, 0x673a9100, 0x3d6e4d94},
+  /* 205 */ {4, 0.1302171484322746, 0x69448e91, 0x374842ee},
+  /* 206 */ {4, 0.1300982152363760, 0x6b563e10, 0x314825b0},
+  /* 207 */ {4, 0.1299800734730872, 0x6d6fb2c1, 0x2b6cde75},
+  /* 208 */ {4, 0.1298627138972530, 0x6f910000, 0x25b55f2e},
+  /* 209 */ {4, 0.1297461274170591, 0x71ba3941, 0x2020a2c5},
+  /* 210 */ {4, 0.1296303050907487, 0x73eb7210, 0x1aadaccb},
+  /* 211 */ {4, 0.1295152381234257, 0x7624be11, 0x155b891f},
+  /* 212 */ {4, 0.1294009178639407, 0x78663100, 0x10294ba2},
+  /* 213 */ {4, 0.1292873358018581, 0x7aafdeb1, 0xb160fe9},
+  /* 214 */ {4, 0.1291744835645007, 0x7d01db10, 0x620f8f6},
+  /* 215 */ {4, 0.1290623529140715, 0x7f5c3a21, 0x14930ef},
+  /* 216 */ {4, 0.1289509357448472, 0x81bf1000, 0xf91bd1b6},
+  /* 217 */ {4, 0.1288402240804449, 0x842a70e1, 0xefdcb0c7},
+  /* 218 */ {4, 0.1287302100711567, 0x869e7110, 0xe6d37b2a},
+  /* 219 */ {4, 0.1286208859913518, 0x891b24f1, 0xddfeb94a},
+  /* 220 */ {4, 0.1285122442369443, 0x8ba0a100, 0xd55cff6e},
+  /* 221 */ {4, 0.1284042773229231, 0x8e2ef9d1, 0xcceced50},
+  /* 222 */ {4, 0.1282969778809442, 0x90c64410, 0xc4ad2db2},
+  /* 223 */ {4, 0.1281903386569819, 0x93669481, 0xbc9c75f9},
+  /* 224 */ {4, 0.1280843525090381, 0x96100000, 0xb4b985cf},
+  /* 225 */ {4, 0.1279790124049077, 0x98c29b81, 0xad0326c2},
+  /* 226 */ {4, 0.1278743114199984, 0x9b7e7c10, 0xa5782bef},
+  /* 227 */ {4, 0.1277702427352035, 0x9e43b6d1, 0x9e1771a9},
+  /* 228 */ {4, 0.1276667996348261, 0xa1126100, 0x96dfdd2a},
+  /* 229 */ {4, 0.1275639755045533, 0xa3ea8ff1, 0x8fd05c41},
+  /* 230 */ {4, 0.1274617638294791, 0xa6cc5910, 0x88e7e509},
+  /* 231 */ {4, 0.1273601581921741, 0xa9b7d1e1, 0x8225759d},
+  /* 232 */ {4, 0.1272591522708010, 0xacad1000, 0x7b8813d3},
+  /* 233 */ {4, 0.1271587398372755, 0xafac2921, 0x750eccf9},
+  /* 234 */ {4, 0.1270589147554692, 0xb2b53310, 0x6eb8b595},
+  /* 235 */ {4, 0.1269596709794558, 0xb5c843b1, 0x6884e923},
+  /* 236 */ {4, 0.1268610025517973, 0xb8e57100, 0x627289db},
+  /* 237 */ {4, 0.1267629036018709, 0xbc0cd111, 0x5c80c07b},
+  /* 238 */ {4, 0.1266653683442337, 0xbf3e7a10, 0x56aebc07},
+  /* 239 */ {4, 0.1265683910770258, 0xc27a8241, 0x50fbb19b},
+  /* 240 */ {4, 0.1264719661804097, 0xc5c10000, 0x4b66dc33},
+  /* 241 */ {4, 0.1263760881150453, 0xc91209c1, 0x45ef7c7c},
+  /* 242 */ {4, 0.1262807514205999, 0xcc6db610, 0x4094d8a3},
+  /* 243 */ {4, 0.1261859507142915, 0xcfd41b91, 0x3b563c24},
+  /* 244 */ {4, 0.1260916806894653, 0xd3455100, 0x3632f7a5},
+  /* 245 */ {4, 0.1259979361142023, 0xd6c16d31, 0x312a60c3},
+  /* 246 */ {4, 0.1259047118299582, 0xda488710, 0x2c3bd1f0},
+  /* 247 */ {4, 0.1258120027502338, 0xdddab5a1, 0x2766aa45},
+  /* 248 */ {4, 0.1257198038592741, 0xe1781000, 0x22aa4d5f},
+  /* 249 */ {4, 0.1256281102107963, 0xe520ad61, 0x1e06233c},
+  /* 250 */ {4, 0.1255369169267456, 0xe8d4a510, 0x19799812},
+  /* 251 */ {4, 0.1254462191960791, 0xec940e71, 0x15041c33},
+  /* 252 */ {4, 0.1253560122735751, 0xf05f0100, 0x10a523e5},
+  /* 253 */ {4, 0.1252662914786691, 0xf4359451, 0xc5c2749},
+  /* 254 */ {4, 0.1251770521943144, 0xf817e010, 0x828a237},
+  /* 255 */ {4, 0.1250882898658681, 0xfc05fc01, 0x40a1423},
+};
+#endif
+#if BITS_PER_MP_LIMB == 64
+const struct bases __mp_bases[256] =
+{
+  /*  0 */ {0, 0.0, 0, 0},
+  /*  1 */ {0, 1e38, 0, 0},
+  /*  2 */ {64, 1.0000000000000000, CNST_LIMB(0x1), CNST_LIMB(0x0)},
+  /*  3 */ {40, 0.6309297535714574, CNST_LIMB(0xa8b8b452291fe821), CNST_LIMB(0x846d550e37b5063d)},
+  /*  4 */ {32, 0.5000000000000000, CNST_LIMB(0x2), CNST_LIMB(0x0)},
+  /*  5 */ {27, 0.4306765580733931, CNST_LIMB(0x6765c793fa10079d), CNST_LIMB(0x3ce9a36f23c0fc90)},
+  /*  6 */ {24, 0.3868528072345416, CNST_LIMB(0x41c21cb8e1000000), CNST_LIMB(0xf24f62335024a295)},
+  /*  7 */ {22, 0.3562071871080222, CNST_LIMB(0x3642798750226111), CNST_LIMB(0x2df495ccaa57147b)},
+  /*  8 */ {21, 0.3333333333333334, CNST_LIMB(0x3), CNST_LIMB(0x0)},
+  /*  9 */ {20, 0.3154648767857287, CNST_LIMB(0xa8b8b452291fe821), CNST_LIMB(0x846d550e37b5063d)},
+  /* 10 */ {19, 0.3010299956639811, CNST_LIMB(0x8ac7230489e80000), CNST_LIMB(0xd83c94fb6d2ac34a)},
+  /* 11 */ {18, 0.2890648263178878, CNST_LIMB(0x4d28cb56c33fa539), CNST_LIMB(0xa8adf7ae45e7577b)},
+  /* 12 */ {17, 0.2789429456511298, CNST_LIMB(0x1eca170c00000000), CNST_LIMB(0xa10c2bec5da8f8f)},
+  /* 13 */ {17, 0.2702381544273197, CNST_LIMB(0x780c7372621bd74d), CNST_LIMB(0x10f4becafe412ec3)},
+  /* 14 */ {16, 0.2626495350371936, CNST_LIMB(0x1e39a5057d810000), CNST_LIMB(0xf08480f672b4e86)},
+  /* 15 */ {16, 0.2559580248098155, CNST_LIMB(0x5b27ac993df97701), CNST_LIMB(0x6779c7f90dc42f48)},
+  /* 16 */ {16, 0.2500000000000000, CNST_LIMB(0x4), CNST_LIMB(0x0)},
+  /* 17 */ {15, 0.2446505421182260, CNST_LIMB(0x27b95e997e21d9f1), CNST_LIMB(0x9c71e11bab279323)},
+  /* 18 */ {15, 0.2398124665681315, CNST_LIMB(0x5da0e1e53c5c8000), CNST_LIMB(0x5dfaa697ec6f6a1c)},
+  /* 19 */ {15, 0.2354089133666382, CNST_LIMB(0xd2ae3299c1c4aedb), CNST_LIMB(0x3711783f6be7e9ec)},
+  /* 20 */ {14, 0.2313782131597592, CNST_LIMB(0x16bcc41e90000000), CNST_LIMB(0x6849b86a12b9b01e)},
+  /* 21 */ {14, 0.2276702486969530, CNST_LIMB(0x2d04b7fdd9c0ef49), CNST_LIMB(0x6bf097ba5ca5e239)},
+  /* 22 */ {14, 0.2242438242175754, CNST_LIMB(0x5658597bcaa24000), CNST_LIMB(0x7b8015c8d7af8f08)},
+  /* 23 */ {14, 0.2210647294575037, CNST_LIMB(0xa0e2073737609371), CNST_LIMB(0x975a24b3a3151b38)},
+  /* 24 */ {13, 0.2181042919855316, CNST_LIMB(0xc29e98000000000), CNST_LIMB(0x50bd367972689db1)},
+  /* 25 */ {13, 0.2153382790366965, CNST_LIMB(0x14adf4b7320334b9), CNST_LIMB(0x8c240c4aecb13bb5)},
+  /* 26 */ {13, 0.2127460535533632, CNST_LIMB(0x226ed36478bfa000), CNST_LIMB(0xdbd2e56854e118c9)},
+  /* 27 */ {13, 0.2103099178571525, CNST_LIMB(0x383d9170b85ff80b), CNST_LIMB(0x2351ffcaa9c7c4ae)},
+  /* 28 */ {13, 0.2080145976765095, CNST_LIMB(0x5a3c23e39c000000), CNST_LIMB(0x6b24188ca33b0636)},
+  /* 29 */ {13, 0.2058468324604344, CNST_LIMB(0x8e65137388122bcd), CNST_LIMB(0xcc3dceaf2b8ba99d)},
+  /* 30 */ {13, 0.2037950470905062, CNST_LIMB(0xdd41bb36d259e000), CNST_LIMB(0x2832e835c6c7d6b6)},
+  /* 31 */ {12, 0.2018490865820999, CNST_LIMB(0xaee5720ee830681), CNST_LIMB(0x76b6aa272e1873c5)},
+  /* 32 */ {12, 0.2000000000000000, CNST_LIMB(0x5), CNST_LIMB(0x0)},
+  /* 33 */ {12, 0.1982398631705605, CNST_LIMB(0x172588ad4f5f0981), CNST_LIMB(0x61eaf5d402c7bf4f)},
+  /* 34 */ {12, 0.1965616322328226, CNST_LIMB(0x211e44f7d02c1000), CNST_LIMB(0xeeb658123ffb27ec)},
+  /* 35 */ {12, 0.1949590218937863, CNST_LIMB(0x2ee56725f06e5c71), CNST_LIMB(0x5d5e3762e6fdf509)},
+  /* 36 */ {12, 0.1934264036172708, CNST_LIMB(0x41c21cb8e1000000), CNST_LIMB(0xf24f62335024a295)},
+  /* 37 */ {12, 0.1919587200065601, CNST_LIMB(0x5b5b57f8a98a5dd1), CNST_LIMB(0x66ae7831762efb6f)},
+  /* 38 */ {12, 0.1905514124267734, CNST_LIMB(0x7dcff8986ea31000), CNST_LIMB(0x47388865a00f544)},
+  /* 39 */ {12, 0.1892003595168700, CNST_LIMB(0xabd4211662a6b2a1), CNST_LIMB(0x7d673c33a123b54c)},
+  /* 40 */ {12, 0.1879018247091076, CNST_LIMB(0xe8d4a51000000000), CNST_LIMB(0x19799812dea11197)},
+  /* 41 */ {11, 0.1866524112389434, CNST_LIMB(0x7a32956ad081b79), CNST_LIMB(0xc27e62e0686feae)},
+  /* 42 */ {11, 0.1854490234153689, CNST_LIMB(0x9f49aaff0e86800), CNST_LIMB(0x9b6e7507064ce7c7)},
+  /* 43 */ {11, 0.1842888331487062, CNST_LIMB(0xce583bb812d37b3), CNST_LIMB(0x3d9ac2bf66cfed94)},
+  /* 44 */ {11, 0.1831692509136336, CNST_LIMB(0x109b79a654c00000), CNST_LIMB(0xed46bc50ce59712a)},
+  /* 45 */ {11, 0.1820879004699383, CNST_LIMB(0x1543beff214c8b95), CNST_LIMB(0x813d97e2c89b8d46)},
+  /* 46 */ {11, 0.1810425967800402, CNST_LIMB(0x1b149a79459a3800), CNST_LIMB(0x2e81751956af8083)},
+  /* 47 */ {11, 0.1800313266566926, CNST_LIMB(0x224edfb5434a830f), CNST_LIMB(0xdd8e0a95e30c0988)},
+  /* 48 */ {11, 0.1790522317510413, CNST_LIMB(0x2b3fb00000000000), CNST_LIMB(0x7ad4dd48a0b5b167)},
+  /* 49 */ {11, 0.1781035935540111, CNST_LIMB(0x3642798750226111), CNST_LIMB(0x2df495ccaa57147b)},
+  /* 50 */ {11, 0.1771838201355579, CNST_LIMB(0x43c33c1937564800), CNST_LIMB(0xe392010175ee5962)},
+  /* 51 */ {11, 0.1762914343888821, CNST_LIMB(0x54411b2441c3cd8b), CNST_LIMB(0x84eaf11b2fe7738e)},
+  /* 52 */ {11, 0.1754250635819545, CNST_LIMB(0x6851455acd400000), CNST_LIMB(0x3a1e3971e008995d)},
+  /* 53 */ {11, 0.1745834300480449, CNST_LIMB(0x80a23b117c8feb6d), CNST_LIMB(0xfd7a462344ffce25)},
+  /* 54 */ {11, 0.1737653428714400, CNST_LIMB(0x9dff7d32d5dc1800), CNST_LIMB(0x9eca40b40ebcef8a)},
+  /* 55 */ {11, 0.1729696904450771, CNST_LIMB(0xc155af6faeffe6a7), CNST_LIMB(0x52fa161a4a48e43d)},
+  /* 56 */ {11, 0.1721954337940981, CNST_LIMB(0xebb7392e00000000), CNST_LIMB(0x1607a2cbacf930c1)},
+  /* 57 */ {10, 0.1714416005739134, CNST_LIMB(0x50633659656d971), CNST_LIMB(0x97a014f8e3be55f1)},
+  /* 58 */ {10, 0.1707072796637201, CNST_LIMB(0x5fa8624c7fba400), CNST_LIMB(0x568df8b76cbf212c)},
+  /* 59 */ {10, 0.1699916162869140, CNST_LIMB(0x717d9faa73c5679), CNST_LIMB(0x20ba7c4b4e6ef492)},
+  /* 60 */ {10, 0.1692938075987814, CNST_LIMB(0x86430aac6100000), CNST_LIMB(0xe81ee46b9ef492f5)},
+  /* 61 */ {10, 0.1686130986895011, CNST_LIMB(0x9e64d9944b57f29), CNST_LIMB(0x9dc0d10d51940416)},
+  /* 62 */ {10, 0.1679487789570419, CNST_LIMB(0xba5ca5392cb0400), CNST_LIMB(0x5fa8ed2f450272a5)},
+  /* 63 */ {10, 0.1673001788101741, CNST_LIMB(0xdab2ce1d022cd81), CNST_LIMB(0x2ba9eb8c5e04e641)},
+  /* 64 */ {10, 0.1666666666666667, CNST_LIMB(0x6), CNST_LIMB(0x0)},
+  /* 65 */ {10, 0.1660476462159378, CNST_LIMB(0x12aeed5fd3e2d281), CNST_LIMB(0xb67759cc00287bf1)},
+  /* 66 */ {10, 0.1654425539190583, CNST_LIMB(0x15c3da1572d50400), CNST_LIMB(0x78621feeb7f4ed33)},
+  /* 67 */ {10, 0.1648508567221604, CNST_LIMB(0x194c05534f75ee29), CNST_LIMB(0x43d55b5f72943bc0)},
+  /* 68 */ {10, 0.1642720499620502, CNST_LIMB(0x1d56299ada100000), CNST_LIMB(0x173decb64d1d4409)},
+  /* 69 */ {10, 0.1637056554452156, CNST_LIMB(0x21f2a089a4ff4f79), CNST_LIMB(0xe29fb54fd6b6074f)},
+  /* 70 */ {10, 0.1631512196835108, CNST_LIMB(0x2733896c68d9a400), CNST_LIMB(0xa1f1f5c210d54e62)},
+  /* 71 */ {10, 0.1626083122716341, CNST_LIMB(0x2d2cf2c33b533c71), CNST_LIMB(0x6aac7f9bfafd57b2)},
+  /* 72 */ {10, 0.1620765243931223, CNST_LIMB(0x33f506e440000000), CNST_LIMB(0x3b563c2478b72ee2)},
+  /* 73 */ {10, 0.1615554674429964, CNST_LIMB(0x3ba43bec1d062211), CNST_LIMB(0x12b536b574e92d1b)},
+  /* 74 */ {10, 0.1610447717564444, CNST_LIMB(0x4455872d8fd4e400), CNST_LIMB(0xdf86c03020404fa5)},
+  /* 75 */ {10, 0.1605440854340214, CNST_LIMB(0x4e2694539f2f6c59), CNST_LIMB(0xa34adf02234eea8e)},
+  /* 76 */ {10, 0.1600530732548213, CNST_LIMB(0x5938006c18900000), CNST_LIMB(0x6f46eb8574eb59dd)},
+  /* 77 */ {10, 0.1595714156699382, CNST_LIMB(0x65ad9912474aa649), CNST_LIMB(0x42459b481df47cec)},
+  /* 78 */ {10, 0.1590988078692941, CNST_LIMB(0x73ae9ff4241ec400), CNST_LIMB(0x1b424b95d80ca505)},
+  /* 79 */ {10, 0.1586349589155960, CNST_LIMB(0x836612ee9c4ce1e1), CNST_LIMB(0xf2c1b982203a0dac)},
+  /* 80 */ {10, 0.1581795909397823, CNST_LIMB(0x9502f90000000000), CNST_LIMB(0xb7cdfd9d7bdbab7d)},
+  /* 81 */ {10, 0.1577324383928644, CNST_LIMB(0xa8b8b452291fe821), CNST_LIMB(0x846d550e37b5063d)},
+  /* 82 */ {10, 0.1572932473495469, CNST_LIMB(0xbebf59a07dab4400), CNST_LIMB(0x57931eeaf85cf64f)},
+  /* 83 */ {10, 0.1568617748594410, CNST_LIMB(0xd7540d4093bc3109), CNST_LIMB(0x305a944507c82f47)},
+  /* 84 */ {10, 0.1564377883420716, CNST_LIMB(0xf2b96616f1900000), CNST_LIMB(0xe007ccc9c22781a)},
+  /* 85 */ {9, 0.1560210650222250, CNST_LIMB(0x336de62af2bca35), CNST_LIMB(0x3e92c42e000eeed4)},
+  /* 86 */ {9, 0.1556113914024940, CNST_LIMB(0x39235ec33d49600), CNST_LIMB(0x1ebe59130db2795e)},
+  /* 87 */ {9, 0.1552085627701551, CNST_LIMB(0x3f674e539585a17), CNST_LIMB(0x268859e90f51b89)},
+  /* 88 */ {9, 0.1548123827357682, CNST_LIMB(0x4645b6958000000), CNST_LIMB(0xd24cde0463108cfa)},
+  /* 89 */ {9, 0.1544226628011101, CNST_LIMB(0x4dcb74afbc49c19), CNST_LIMB(0xa536009f37adc383)},
+  /* 90 */ {9, 0.1540392219542636, CNST_LIMB(0x56064e1d18d9a00), CNST_LIMB(0x7cea06ce1c9ace10)},
+  /* 91 */ {9, 0.1536618862898642, CNST_LIMB(0x5f04fe2cd8a39fb), CNST_LIMB(0x58db032e72e8ba43)},
+  /* 92 */ {9, 0.1532904886526781, CNST_LIMB(0x68d74421f5c0000), CNST_LIMB(0x388cc17cae105447)},
+  /* 93 */ {9, 0.1529248683028321, CNST_LIMB(0x738df1f6ab4827d), CNST_LIMB(0x1b92672857620ce0)},
+  /* 94 */ {9, 0.1525648706011593, CNST_LIMB(0x7f3afbc9cfb5e00), CNST_LIMB(0x18c6a9575c2ade4)},
+  /* 95 */ {9, 0.1522103467132434, CNST_LIMB(0x8bf187fba88f35f), CNST_LIMB(0xd44da7da8e44b24f)},
+  /* 96 */ {9, 0.1518611533308632, CNST_LIMB(0x99c600000000000), CNST_LIMB(0xaa2f78f1b4cc6794)},
+  /* 97 */ {9, 0.1515171524096389, CNST_LIMB(0xa8ce21eb6531361), CNST_LIMB(0x843c067d091ee4cc)},
+  /* 98 */ {9, 0.1511782109217764, CNST_LIMB(0xb92112c1a0b6200), CNST_LIMB(0x62005e1e913356e3)},
+  /* 99 */ {9, 0.1508442006228941, CNST_LIMB(0xcad7718b8747c43), CNST_LIMB(0x4316eed01dedd518)},
+  /* 100 */ {9, 0.1505149978319906, CNST_LIMB(0xde0b6b3a7640000), CNST_LIMB(0x2725dd1d243aba0e)},
+  /* 101 */ {9, 0.1501904832236879, CNST_LIMB(0xf2d8cf5fe6d74c5), CNST_LIMB(0xddd9057c24cb54f)},
+  /* 102 */ {9, 0.1498705416319474, CNST_LIMB(0x1095d25bfa712600), CNST_LIMB(0xedeee175a736d2a1)},
+  /* 103 */ {9, 0.1495550618645152, CNST_LIMB(0x121b7c4c3698faa7), CNST_LIMB(0xc4699f3df8b6b328)},
+  /* 104 */ {9, 0.1492439365274121, CNST_LIMB(0x13c09e8d68000000), CNST_LIMB(0x9ebbe7d859cb5a7c)},
+  /* 105 */ {9, 0.1489370618588283, CNST_LIMB(0x15876ccb0b709ca9), CNST_LIMB(0x7c828b9887eb2179)},
+  /* 106 */ {9, 0.1486343375718350, CNST_LIMB(0x17723c2976da2a00), CNST_LIMB(0x5d652ab99001adcf)},
+  /* 107 */ {9, 0.1483356667053617, CNST_LIMB(0x198384e9c259048b), CNST_LIMB(0x4114f1754e5d7b32)},
+  /* 108 */ {9, 0.1480409554829326, CNST_LIMB(0x1bbde41dfeec0000), CNST_LIMB(0x274b7c902f7e0188)},
+  /* 109 */ {9, 0.1477501131786861, CNST_LIMB(0x1e241d6e3337910d), CNST_LIMB(0xfc9e0fbb32e210c)},
+  /* 110 */ {9, 0.1474630519902391, CNST_LIMB(0x20b91cee9901ee00), CNST_LIMB(0xf4afa3e594f8ea1f)},
+  /* 111 */ {9, 0.1471796869179852, CNST_LIMB(0x237ff9079863dfef), CNST_LIMB(0xcd85c32e9e4437b0)},
+  /* 112 */ {9, 0.1468999356504447, CNST_LIMB(0x267bf47000000000), CNST_LIMB(0xa9bbb147e0dd92a8)},
+  /* 113 */ {9, 0.1466237184553111, CNST_LIMB(0x29b08039fbeda7f1), CNST_LIMB(0x8900447b70e8eb82)},
+  /* 114 */ {9, 0.1463509580758620, CNST_LIMB(0x2d213df34f65f200), CNST_LIMB(0x6b0a92adaad5848a)},
+  /* 115 */ {9, 0.1460815796324244, CNST_LIMB(0x30d201d957a7c2d3), CNST_LIMB(0x4f990ad8740f0ee5)},
+  /* 116 */ {9, 0.1458155105286054, CNST_LIMB(0x34c6d52160f40000), CNST_LIMB(0x3670a9663a8d3610)},
+  /* 117 */ {9, 0.1455526803620167, CNST_LIMB(0x3903f855d8f4c755), CNST_LIMB(0x1f5c44188057be3c)},
+  /* 118 */ {9, 0.1452930208392428, CNST_LIMB(0x3d8de5c8ec59b600), CNST_LIMB(0xa2bea956c4e4977)},
+  /* 119 */ {9, 0.1450364656948130, CNST_LIMB(0x4269541d1ff01337), CNST_LIMB(0xed68b23033c3637e)},
+  /* 120 */ {9, 0.1447829506139581, CNST_LIMB(0x479b38e478000000), CNST_LIMB(0xc99cf624e50549c5)},
+  /* 121 */ {9, 0.1445324131589439, CNST_LIMB(0x4d28cb56c33fa539), CNST_LIMB(0xa8adf7ae45e7577b)},
+  /* 122 */ {9, 0.1442847926987864, CNST_LIMB(0x5317871fa13aba00), CNST_LIMB(0x8a5bc740b1c113e5)},
+  /* 123 */ {9, 0.1440400303421672, CNST_LIMB(0x596d2f44de9fa71b), CNST_LIMB(0x6e6c7efb81cfbb9b)},
+  /* 124 */ {9, 0.1437980688733775, CNST_LIMB(0x602fd125c47c0000), CNST_LIMB(0x54aba5c5cada5f10)},
+  /* 125 */ {9, 0.1435588526911310, CNST_LIMB(0x6765c793fa10079d), CNST_LIMB(0x3ce9a36f23c0fc90)},
+  /* 126 */ {9, 0.1433223277500932, CNST_LIMB(0x6f15be069b847e00), CNST_LIMB(0x26fb43de2c8cd2a8)},
+  /* 127 */ {9, 0.1430884415049874, CNST_LIMB(0x7746b3e82a77047f), CNST_LIMB(0x12b94793db8486a1)},
+  /* 128 */ {9, 0.1428571428571428, CNST_LIMB(0x7), CNST_LIMB(0x0)},
+  /* 129 */ {9, 0.1426283821033600, CNST_LIMB(0x894953f7ea890481), CNST_LIMB(0xdd5deca404c0156d)},
+  /* 130 */ {9, 0.1424021108869747, CNST_LIMB(0x932abffea4848200), CNST_LIMB(0xbd51373330291de0)},
+  /* 131 */ {9, 0.1421782821510107, CNST_LIMB(0x9dacb687d3d6a163), CNST_LIMB(0x9fa4025d66f23085)},
+  /* 132 */ {9, 0.1419568500933153, CNST_LIMB(0xa8d8102a44840000), CNST_LIMB(0x842530ee2db4949d)},
+  /* 133 */ {9, 0.1417377701235801, CNST_LIMB(0xb4b60f9d140541e5), CNST_LIMB(0x6aa7f2766b03dc25)},
+  /* 134 */ {9, 0.1415209988221527, CNST_LIMB(0xc15065d4856e4600), CNST_LIMB(0x53035ba7ebf32e8d)},
+  /* 135 */ {9, 0.1413064939005528, CNST_LIMB(0xceb1363f396d23c7), CNST_LIMB(0x3d12091fc9fb4914)},
+  /* 136 */ {9, 0.1410942141636095, CNST_LIMB(0xdce31b2488000000), CNST_LIMB(0x28b1cb81b1ef1849)},
+  /* 137 */ {9, 0.1408841194731412, CNST_LIMB(0xebf12a24bca135c9), CNST_LIMB(0x15c35be67ae3e2c9)},
+  /* 138 */ {9, 0.1406761707131039, CNST_LIMB(0xfbe6f8dbf88f4a00), CNST_LIMB(0x42a17bd09be1ff0)},
+  /* 139 */ {8, 0.1404703297561400, CNST_LIMB(0x1ef156c084ce761), CNST_LIMB(0x8bf461f03cf0bbf)},
+  /* 140 */ {8, 0.1402665594314587, CNST_LIMB(0x20c4e3b94a10000), CNST_LIMB(0xf3fbb43f68a32d05)},
+  /* 141 */ {8, 0.1400648234939879, CNST_LIMB(0x22b0695a08ba421), CNST_LIMB(0xd84f44c48564dc19)},
+  /* 142 */ {8, 0.1398650865947379, CNST_LIMB(0x24b4f35d7a4c100), CNST_LIMB(0xbe58ebcce7956abe)},
+  /* 143 */ {8, 0.1396673142523192, CNST_LIMB(0x26d397284975781), CNST_LIMB(0xa5fac463c7c134b7)},
+  /* 144 */ {8, 0.1394714728255649, CNST_LIMB(0x290d74100000000), CNST_LIMB(0x8f19241e28c7d757)},
+  /* 145 */ {8, 0.1392775294872041, CNST_LIMB(0x2b63b3a37866081), CNST_LIMB(0x799a6d046c0ae1ae)},
+  /* 146 */ {8, 0.1390854521985406, CNST_LIMB(0x2dd789f4d894100), CNST_LIMB(0x6566e37d746a9e40)},
+  /* 147 */ {8, 0.1388952096850913, CNST_LIMB(0x306a35e51b58721), CNST_LIMB(0x526887dbfb5f788f)},
+  /* 148 */ {8, 0.1387067714131417, CNST_LIMB(0x331d01712e10000), CNST_LIMB(0x408af3382b8efd3d)},
+  /* 149 */ {8, 0.1385201075671774, CNST_LIMB(0x35f14200a827c61), CNST_LIMB(0x2fbb374806ec05f1)},
+  /* 150 */ {8, 0.1383351890281539, CNST_LIMB(0x38e858b62216100), CNST_LIMB(0x1fe7c0f0afce87fe)},
+  /* 151 */ {8, 0.1381519873525671, CNST_LIMB(0x3c03b2c13176a41), CNST_LIMB(0x11003d517540d32e)},
+  /* 152 */ {8, 0.1379704747522905, CNST_LIMB(0x3f44c9b21000000), CNST_LIMB(0x2f5810f98eff0dc)},
+  /* 153 */ {8, 0.1377906240751463, CNST_LIMB(0x42ad23cef3113c1), CNST_LIMB(0xeb72e35e7840d910)},
+  /* 154 */ {8, 0.1376124087861776, CNST_LIMB(0x463e546b19a2100), CNST_LIMB(0xd27de19593dc3614)},
+  /* 155 */ {8, 0.1374358029495937, CNST_LIMB(0x49f9fc3f96684e1), CNST_LIMB(0xbaf391fd3e5e6fc2)},
+  /* 156 */ {8, 0.1372607812113589, CNST_LIMB(0x4de1c9c5dc10000), CNST_LIMB(0xa4bd38c55228c81d)},
+  /* 157 */ {8, 0.1370873187823978, CNST_LIMB(0x51f77994116d2a1), CNST_LIMB(0x8fc5a8de8e1de782)},
+  /* 158 */ {8, 0.1369153914223921, CNST_LIMB(0x563cd6bb3398100), CNST_LIMB(0x7bf9265bea9d3a3b)},
+  /* 159 */ {8, 0.1367449754241439, CNST_LIMB(0x5ab3bb270beeb01), CNST_LIMB(0x69454b325983dccd)},
+  /* 160 */ {8, 0.1365760475984821, CNST_LIMB(0x5f5e10000000000), CNST_LIMB(0x5798ee2308c39df9)},
+  /* 161 */ {8, 0.1364085852596902, CNST_LIMB(0x643dce0ec16f501), CNST_LIMB(0x46e40ba0fa66a753)},
+  /* 162 */ {8, 0.1362425662114337, CNST_LIMB(0x6954fe21e3e8100), CNST_LIMB(0x3717b0870b0db3a7)},
+  /* 163 */ {8, 0.1360779687331669, CNST_LIMB(0x6ea5b9755f440a1), CNST_LIMB(0x2825e6775d11cdeb)},
+  /* 164 */ {8, 0.1359147715670014, CNST_LIMB(0x74322a1c0410000), CNST_LIMB(0x1a01a1c09d1b4dac)},
+  /* 165 */ {8, 0.1357529539050150, CNST_LIMB(0x79fc8b6ae8a46e1), CNST_LIMB(0xc9eb0a8bebc8f3e)},
+  /* 166 */ {8, 0.1355924953769863, CNST_LIMB(0x80072a66d512100), CNST_LIMB(0xffe357ff59e6a004)},
+  /* 167 */ {8, 0.1354333760385373, CNST_LIMB(0x86546633b42b9c1), CNST_LIMB(0xe7dfd1be05fa61a8)},
+  /* 168 */ {8, 0.1352755763596663, CNST_LIMB(0x8ce6b0861000000), CNST_LIMB(0xd11ed6fc78f760e5)},
+  /* 169 */ {8, 0.1351190772136599, CNST_LIMB(0x93c08e16a022441), CNST_LIMB(0xbb8db609dd29ebfe)},
+  /* 170 */ {8, 0.1349638598663645, CNST_LIMB(0x9ae49717f026100), CNST_LIMB(0xa71aec8d1813d532)},
+  /* 171 */ {8, 0.1348099059658079, CNST_LIMB(0xa25577ae24c1a61), CNST_LIMB(0x93b612a9f20fbc02)},
+  /* 172 */ {8, 0.1346571975321549, CNST_LIMB(0xaa15f068e610000), CNST_LIMB(0x814fc7b19a67d317)},
+  /* 173 */ {8, 0.1345057169479844, CNST_LIMB(0xb228d6bf7577921), CNST_LIMB(0x6fd9a03f2e0a4b7c)},
+  /* 174 */ {8, 0.1343554469488779, CNST_LIMB(0xba91158ef5c4100), CNST_LIMB(0x5f4615a38d0d316e)},
+  /* 175 */ {8, 0.1342063706143054, CNST_LIMB(0xc351ad9aec0b681), CNST_LIMB(0x4f8876863479a286)},
+  /* 176 */ {8, 0.1340584713587980, CNST_LIMB(0xcc6db6100000000), CNST_LIMB(0x4094d8a3041b60eb)},
+  /* 177 */ {8, 0.1339117329233981, CNST_LIMB(0xd5e85d09025c181), CNST_LIMB(0x32600b8ed883a09b)},
+  /* 178 */ {8, 0.1337661393673756, CNST_LIMB(0xdfc4e816401c100), CNST_LIMB(0x24df8c6eb4b6d1f1)},
+  /* 179 */ {8, 0.1336216750601996, CNST_LIMB(0xea06b4c72947221), CNST_LIMB(0x18097a8ee151acef)},
+  /* 180 */ {8, 0.1334783246737591, CNST_LIMB(0xf4b139365210000), CNST_LIMB(0xbd48cc8ec1cd8e3)},
+  /* 181 */ {8, 0.1333360731748201, CNST_LIMB(0xffc80497d520961), CNST_LIMB(0x3807a8d67485fb)},
+  /* 182 */ {8, 0.1331949058177136, CNST_LIMB(0x10b4ebfca1dee100), CNST_LIMB(0xea5768860b62e8d8)},
+  /* 183 */ {8, 0.1330548081372441, CNST_LIMB(0x117492de921fc141), CNST_LIMB(0xd54faf5b635c5005)},
+  /* 184 */ {8, 0.1329157659418126, CNST_LIMB(0x123bb2ce41000000), CNST_LIMB(0xc14a56233a377926)},
+  /* 185 */ {8, 0.1327777653067443, CNST_LIMB(0x130a8b6157bdecc1), CNST_LIMB(0xae39a88db7cd329f)},
+  /* 186 */ {8, 0.1326407925678156, CNST_LIMB(0x13e15dede0e8a100), CNST_LIMB(0x9c10bde69efa7ab6)},
+  /* 187 */ {8, 0.1325048343149731, CNST_LIMB(0x14c06d941c0ca7e1), CNST_LIMB(0x8ac36c42a2836497)},
+  /* 188 */ {8, 0.1323698773862368, CNST_LIMB(0x15a7ff487a810000), CNST_LIMB(0x7a463c8b84f5ef67)},
+  /* 189 */ {8, 0.1322359088617821, CNST_LIMB(0x169859ddc5c697a1), CNST_LIMB(0x6a8e5f5ad090fd4b)},
+  /* 190 */ {8, 0.1321029160581950, CNST_LIMB(0x1791c60f6fed0100), CNST_LIMB(0x5b91a2943596fc56)},
+  /* 191 */ {8, 0.1319708865228925, CNST_LIMB(0x18948e8c0e6fba01), CNST_LIMB(0x4d4667b1c468e8f0)},
+  /* 192 */ {8, 0.1318398080287045, CNST_LIMB(0x19a1000000000000), CNST_LIMB(0x3fa39ab547994daf)},
+  /* 193 */ {8, 0.1317096685686114, CNST_LIMB(0x1ab769203dafc601), CNST_LIMB(0x32a0a9b2faee1e2a)},
+  /* 194 */ {8, 0.1315804563506306, CNST_LIMB(0x1bd81ab557f30100), CNST_LIMB(0x26357ceac0e96962)},
+  /* 195 */ {8, 0.1314521597928493, CNST_LIMB(0x1d0367a69fed1ba1), CNST_LIMB(0x1a5a6f65caa5859e)},
+  /* 196 */ {8, 0.1313247675185968, CNST_LIMB(0x1e39a5057d810000), CNST_LIMB(0xf08480f672b4e86)},
+  /* 197 */ {8, 0.1311982683517524, CNST_LIMB(0x1f7b2a18f29ac3e1), CNST_LIMB(0x4383340615612ca)},
+  /* 198 */ {8, 0.1310726513121843, CNST_LIMB(0x20c850694c2aa100), CNST_LIMB(0xf3c77969ee4be5a2)},
+  /* 199 */ {8, 0.1309479056113158, CNST_LIMB(0x222173cc014980c1), CNST_LIMB(0xe00993cc187c5ec9)},
+  /* 200 */ {8, 0.1308240206478128, CNST_LIMB(0x2386f26fc1000000), CNST_LIMB(0xcd2b297d889bc2b6)},
+  /* 201 */ {8, 0.1307009860033912, CNST_LIMB(0x24f92ce8af296d41), CNST_LIMB(0xbb214d5064862b22)},
+  /* 202 */ {8, 0.1305787914387386, CNST_LIMB(0x2678863cd0ece100), CNST_LIMB(0xa9e1a7ca7ea10e20)},
+  /* 203 */ {8, 0.1304574268895465, CNST_LIMB(0x280563f0a9472d61), CNST_LIMB(0x99626e72b39ea0cf)},
+  /* 204 */ {8, 0.1303368824626505, CNST_LIMB(0x29a02e1406210000), CNST_LIMB(0x899a5ba9c13fafd9)},
+  /* 205 */ {8, 0.1302171484322746, CNST_LIMB(0x2b494f4efe6d2e21), CNST_LIMB(0x7a80a705391e96ff)},
+  /* 206 */ {8, 0.1300982152363760, CNST_LIMB(0x2d0134ef21cbc100), CNST_LIMB(0x6c0cfe23de23042a)},
+  /* 207 */ {8, 0.1299800734730872, CNST_LIMB(0x2ec84ef4da2ef581), CNST_LIMB(0x5e377df359c944dd)},
+  /* 208 */ {8, 0.1298627138972530, CNST_LIMB(0x309f102100000000), CNST_LIMB(0x50f8ac5fc8f53985)},
+  /* 209 */ {8, 0.1297461274170591, CNST_LIMB(0x3285ee02a1420281), CNST_LIMB(0x44497266278e35b7)},
+  /* 210 */ {8, 0.1296303050907487, CNST_LIMB(0x347d6104fc324100), CNST_LIMB(0x382316831f7ee175)},
+  /* 211 */ {8, 0.1295152381234257, CNST_LIMB(0x3685e47dade53d21), CNST_LIMB(0x2c7f377833b8946e)},
+  /* 212 */ {8, 0.1294009178639407, CNST_LIMB(0x389ff6bb15610000), CNST_LIMB(0x2157c761ab4163ef)},
+  /* 213 */ {8, 0.1292873358018581, CNST_LIMB(0x3acc1912ebb57661), CNST_LIMB(0x16a7071803cc49a9)},
+  /* 214 */ {8, 0.1291744835645007, CNST_LIMB(0x3d0acff111946100), CNST_LIMB(0xc6781d80f8224fc)},
+  /* 215 */ {8, 0.1290623529140715, CNST_LIMB(0x3f5ca2e692eaf841), CNST_LIMB(0x294092d370a900b)},
+  /* 216 */ {8, 0.1289509357448472, CNST_LIMB(0x41c21cb8e1000000), CNST_LIMB(0xf24f62335024a295)},
+  /* 217 */ {8, 0.1288402240804449, CNST_LIMB(0x443bcb714399a5c1), CNST_LIMB(0xe03b98f103fad6d2)},
+  /* 218 */ {8, 0.1287302100711567, CNST_LIMB(0x46ca406c81af2100), CNST_LIMB(0xcee3d32cad2a9049)},
+  /* 219 */ {8, 0.1286208859913518, CNST_LIMB(0x496e106ac22aaae1), CNST_LIMB(0xbe3f9df9277fdada)},
+  /* 220 */ {8, 0.1285122442369443, CNST_LIMB(0x4c27d39fa5410000), CNST_LIMB(0xae46f0d94c05e933)},
+  /* 221 */ {8, 0.1284042773229231, CNST_LIMB(0x4ef825c296e43ca1), CNST_LIMB(0x9ef2280fb437a33d)},
+  /* 222 */ {8, 0.1282969778809442, CNST_LIMB(0x51dfa61f5ad88100), CNST_LIMB(0x9039ff426d3f284b)},
+  /* 223 */ {8, 0.1281903386569819, CNST_LIMB(0x54def7a6d2f16901), CNST_LIMB(0x82178c6d6b51f8f4)},
+  /* 224 */ {8, 0.1280843525090381, CNST_LIMB(0x57f6c10000000000), CNST_LIMB(0x74843b1ee4c1e053)},
+  /* 225 */ {8, 0.1279790124049077, CNST_LIMB(0x5b27ac993df97701), CNST_LIMB(0x6779c7f90dc42f48)},
+  /* 226 */ {8, 0.1278743114199984, CNST_LIMB(0x5e7268b9bbdf8100), CNST_LIMB(0x5af23c74f9ad9fe9)},
+  /* 227 */ {8, 0.1277702427352035, CNST_LIMB(0x61d7a7932ff3d6a1), CNST_LIMB(0x4ee7eae2acdc617e)},
+  /* 228 */ {8, 0.1276667996348261, CNST_LIMB(0x65581f53c8c10000), CNST_LIMB(0x43556aa2ac262a0b)},
+  /* 229 */ {8, 0.1275639755045533, CNST_LIMB(0x68f48a385b8320e1), CNST_LIMB(0x3835949593b8ddd1)},
+  /* 230 */ {8, 0.1274617638294791, CNST_LIMB(0x6cada69ed07c2100), CNST_LIMB(0x2d837fbe78458762)},
+  /* 231 */ {8, 0.1273601581921741, CNST_LIMB(0x70843718cdbf27c1), CNST_LIMB(0x233a7e150a54a555)},
+  /* 232 */ {8, 0.1272591522708010, CNST_LIMB(0x7479027ea1000000), CNST_LIMB(0x19561984a50ff8fe)},
+  /* 233 */ {8, 0.1271587398372755, CNST_LIMB(0x788cd40268f39641), CNST_LIMB(0xfd211159fe3490f)},
+  /* 234 */ {8, 0.1270589147554692, CNST_LIMB(0x7cc07b437ecf6100), CNST_LIMB(0x6aa563e655033e3)},
+  /* 235 */ {8, 0.1269596709794558, CNST_LIMB(0x8114cc6220762061), CNST_LIMB(0xfbb614b3f2d3b14c)},
+  /* 236 */ {8, 0.1268610025517973, CNST_LIMB(0x858aa0135be10000), CNST_LIMB(0xeac0f8837fb05773)},
+  /* 237 */ {8, 0.1267629036018709, CNST_LIMB(0x8a22d3b53c54c321), CNST_LIMB(0xda6e4c10e8615ca5)},
+  /* 238 */ {8, 0.1266653683442337, CNST_LIMB(0x8ede496339f34100), CNST_LIMB(0xcab755a8d01fa67f)},
+  /* 239 */ {8, 0.1265683910770258, CNST_LIMB(0x93bde80aec3a1481), CNST_LIMB(0xbb95a9ae71aa3e0c)},
+  /* 240 */ {8, 0.1264719661804097, CNST_LIMB(0x98c29b8100000000), CNST_LIMB(0xad0326c296b4f529)},
+  /* 241 */ {8, 0.1263760881150453, CNST_LIMB(0x9ded549671832381), CNST_LIMB(0x9ef9f21eed31b7c1)},
+  /* 242 */ {8, 0.1262807514205999, CNST_LIMB(0xa33f092e0b1ac100), CNST_LIMB(0x91747422be14b0b2)},
+  /* 243 */ {8, 0.1261859507142915, CNST_LIMB(0xa8b8b452291fe821), CNST_LIMB(0x846d550e37b5063d)},
+  /* 244 */ {8, 0.1260916806894653, CNST_LIMB(0xae5b564ac3a10000), CNST_LIMB(0x77df79e9a96c06f6)},
+  /* 245 */ {8, 0.1259979361142023, CNST_LIMB(0xb427f4b3be74c361), CNST_LIMB(0x6bc6019636c7d0c2)},
+  /* 246 */ {8, 0.1259047118299582, CNST_LIMB(0xba1f9a938041e100), CNST_LIMB(0x601c4205aebd9e47)},
+  /* 247 */ {8, 0.1258120027502338, CNST_LIMB(0xc0435871d1110f41), CNST_LIMB(0x54ddc59756f05016)},
+  /* 248 */ {8, 0.1257198038592741, CNST_LIMB(0xc694446f01000000), CNST_LIMB(0x4a0648979c838c18)},
+  /* 249 */ {8, 0.1256281102107963, CNST_LIMB(0xcd137a5b57ac3ec1), CNST_LIMB(0x3f91b6e0bb3a053d)},
+  /* 250 */ {8, 0.1255369169267456, CNST_LIMB(0xd3c21bcecceda100), CNST_LIMB(0x357c299a88ea76a5)},
+  /* 251 */ {8, 0.1254462191960791, CNST_LIMB(0xdaa150410b788de1), CNST_LIMB(0x2bc1e517aecc56e3)},
+  /* 252 */ {8, 0.1253560122735751, CNST_LIMB(0xe1b24521be010000), CNST_LIMB(0x225f56ceb3da9f5d)},
+  /* 253 */ {8, 0.1252662914786691, CNST_LIMB(0xe8f62df12777c1a1), CNST_LIMB(0x1951136d53ad63ac)},
+  /* 254 */ {8, 0.1251770521943144, CNST_LIMB(0xf06e445906fc0100), CNST_LIMB(0x1093d504b3cd7d93)},
+  /* 255 */ {8, 0.1250882898658681, CNST_LIMB(0xf81bc845c81bf801), CNST_LIMB(0x824794d1ec1814f)},
+};
+#endif
diff --git a/src/gmp/mpn/ns32k/add_n.s b/src/gmp/mpn/ns32k/add_n.s
new file mode 100644
index 000000000..bd063d07d
--- /dev/null
+++ b/src/gmp/mpn/ns32k/add_n.s
@@ -0,0 +1,46 @@
+# ns32000 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+# sum in a third limb vector.
+
+# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+	.align 1
+.globl ___gmpn_add_n
+___gmpn_add_n:
+	save	[r3,r4,r5]
+	negd	28(sp),r3
+	movd	r3,r0
+	lshd	2,r0
+	movd	24(sp),r4
+	subd	r0,r4			# r4 -> to end of S2
+	movd	20(sp),r5
+	subd	r0,r5			# r5 -> to end of S1
+	movd	16(sp),r2
+	subd	r0,r2			# r2 -> to end of RES
+	subd	r0,r0			# cy = 0
+
+Loop:	movd	r5[r3:d],r0
+	addcd	r4[r3:d],r0
+	movd	r0,r2[r3:d]
+	acbd	1,r3,Loop
+
+	scsd	r0			# r0 = cy.
+	restore	[r5,r4,r3]
+	ret	0
diff --git a/src/gmp/mpn/ns32k/addmul_1.s b/src/gmp/mpn/ns32k/addmul_1.s
new file mode 100644
index 000000000..df0dcdd4a
--- /dev/null
+++ b/src/gmp/mpn/ns32k/addmul_1.s
@@ -0,0 +1,48 @@
+# ns32000 __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
+# the result to a second limb vector.
+
+# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+	.align 1
+.globl ___gmpn_addmul_1
+___gmpn_addmul_1:
+	save	[r3,r4,r5,r6,r7]
+	negd	24(sp),r4
+	movd	r4,r0
+	lshd	2,r0
+	movd	20(sp),r5
+	subd	r0,r5			# r5 -> to end of S1
+	movd	16(sp),r6
+	subd	r0,r6			# r6 -> to end of RES
+	subd	r0,r0			# r0 = 0, cy = 0
+	movd	28(sp),r7		# r7 = s2_limb
+
+Loop:	movd	r5[r4:d],r2
+	meid	r7,r2			# r2 = low_prod, r3 = high_prod
+	addcd	r0,r2			# r2 = low_prod + cy_limb
+	movd	r3,r0			# r0 = new cy_limb
+	addcd	0,r0
+	addd	r2,r6[r4:d]
+	acbd	1,r4,Loop
+
+	addcd	0,r0
+	restore	[r7,r6,r5,r4,r3]
+	ret	0
diff --git a/src/gmp/mpn/ns32k/mul_1.s b/src/gmp/mpn/ns32k/mul_1.s
new file mode 100644
index 000000000..0a77efba2
--- /dev/null
+++ b/src/gmp/mpn/ns32k/mul_1.s
@@ -0,0 +1,47 @@
+# ns32000 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+# the result in a second limb vector.
+
+# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+	.align 1
+.globl ___gmpn_mul_1
+___gmpn_mul_1:
+	save	[r3,r4,r5,r6,r7]
+	negd	24(sp),r4
+	movd	r4,r0
+	lshd	2,r0
+	movd	20(sp),r5
+	subd	r0,r5			# r5 -> to end of S1
+	movd	16(sp),r6
+	subd	r0,r6			# r6 -> to end of RES
+	subd	r0,r0			# r0 = 0, cy = 0
+	movd	28(sp),r7		# r7 = s2_limb
+
+Loop:	movd	r5[r4:d],r2
+	meid	r7,r2			# r2 = low_prod, r3 = high_prod
+	addcd	r0,r2			# r2 = low_prod + cy_limb
+	movd	r3,r0			# r0 = new cy_limb
+	movd	r2,r6[r4:d]
+	acbd	1,r4,Loop
+
+	addcd	0,r0
+	restore	[r7,r6,r5,r4,r3]
+	ret	0
diff --git a/src/gmp/mpn/ns32k/sub_n.s b/src/gmp/mpn/ns32k/sub_n.s
new file mode 100644
index 000000000..cd89f4fd3
--- /dev/null
+++ b/src/gmp/mpn/ns32k/sub_n.s
@@ -0,0 +1,46 @@
+# ns32000 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+# store difference in a third limb vector.
+
+# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+	.align 1
+.globl ___gmpn_sub_n
+___gmpn_sub_n:
+	save	[r3,r4,r5]
+	negd	28(sp),r3
+	movd	r3,r0
+	lshd	2,r0
+	movd	24(sp),r4
+	subd	r0,r4			# r4 -> to end of S2
+	movd	20(sp),r5
+	subd	r0,r5			# r5 -> to end of S1
+	movd	16(sp),r2
+	subd	r0,r2			# r2 -> to end of RES
+	subd	r0,r0			# cy = 0
+
+Loop:	movd	r5[r3:d],r0
+	subcd	r4[r3:d],r0
+	movd	r0,r2[r3:d]
+	acbd	1,r3,Loop
+
+	scsd	r0			# r0 = cy.
+	restore	[r5,r4,r3]
+	ret	0
diff --git a/src/gmp/mpn/ns32k/submul_1.s b/src/gmp/mpn/ns32k/submul_1.s
new file mode 100644
index 000000000..f811aedcf
--- /dev/null
+++ b/src/gmp/mpn/ns32k/submul_1.s
@@ -0,0 +1,48 @@
+# ns32000 __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
+# the result from a second limb vector.
+
+# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+	.align 1
+.globl ___gmpn_submul_1
+___gmpn_submul_1:
+	save	[r3,r4,r5,r6,r7]
+	negd	24(sp),r4
+	movd	r4,r0
+	lshd	2,r0
+	movd	20(sp),r5
+	subd	r0,r5			# r5 -> to end of S1
+	movd	16(sp),r6
+	subd	r0,r6			# r6 -> to end of RES
+	subd	r0,r0			# r0 = 0, cy = 0
+	movd	28(sp),r7		# r7 = s2_limb
+
+Loop:	movd	r5[r4:d],r2
+	meid	r7,r2			# r2 = low_prod, r3 = high_prod
+	addcd	r0,r2			# r2 = low_prod + cy_limb
+	movd	r3,r0			# r0 = new cy_limb
+	addcd	0,r0
+	subd	r2,r6[r4:d]
+	acbd	1,r4,Loop
+
+	addcd	0,r0
+	restore	[r7,r6,r5,r4,r3]
+	ret	0
diff --git a/src/gmp/mpn/pa64/README b/src/gmp/mpn/pa64/README
new file mode 100644
index 000000000..8d2976dab
--- /dev/null
+++ b/src/gmp/mpn/pa64/README
@@ -0,0 +1,38 @@
+This directory contains mpn functions for 64-bit PA-RISC 2.0.
+
+RELEVANT OPTIMIZATION ISSUES
+
+The PA8000 has a multi-issue pipeline with large buffers for instructions
+awaiting pending results.  Therefore, no latency scheduling is necessary
+(and might actually be harmful).
+
+Two 64-bit loads can be completed per cycle.  One 64-bit store can be
+completed per cycle.  A store cannot complete in the same cycle as a load.
+
+STATUS
+
+* mpn_lshift, mpn_rshift, mpn_add_n, mpn_sub_n are all well-tuned and run at
+  the peak cache bandwidth; 1.5 cycles/limb for shifting and 2.0 cycles/limb
+  for add/subtract.
+
+* The multiplication functions run at 11 cycles/limb.  The cache bandwidth
+  allows 7.5 cycles/limb.  Perhaps it would be possible, using unrolling or
+  better scheduling, to get closer to the cache bandwidth limit.
+
+* xaddmul_1.S contains a quicker method for forming the 128 bit product.  It
+  uses some fewer operations, and keep the carry flag live across the loop
+  boundary.  But it seems hard to make it run more than 1/4 cycle faster
+  than the old code.  Perhaps we really ought to unroll this loop be 2x?
+  2x should suffice since register latency schedling is never needed,
+  but the unrolling would hide the store-load latency.  Here is a sketch:
+
+	1. A multiply and store 64-bit products
+	2. B sum 64-bit products 128-bit product
+	3. B load  64-bit products to integer registers
+	4. B multiply and store 64-bit products
+	5. A sum 64-bit products 128-bit product
+	6. A load  64-bit products to integer registers
+	7. goto 1
+
+  In practice, adjacent groups (1 and 2, 2 and 3, etc) will be interleaved
+  for better instruction mix.
diff --git a/src/gmp/mpn/pa64/add_n.s b/src/gmp/mpn/pa64/add_n.s
new file mode 100644
index 000000000..22ff19c18
--- /dev/null
+++ b/src/gmp/mpn/pa64/add_n.s
@@ -0,0 +1,90 @@
+; HP-PA 2.0 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
+; store sum in a third limb vector.
+
+; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+; This runs at 2 cycles/limb on PA8000.
+
+	.level	2.0n
+	.code
+	.export	__gmpn_add_n,entry
+__gmpn_add_n
+	.proc
+	.callinfo frame=0,args_saved
+	.entry
+
+	sub		%r0,%r23,%r22
+	depw,z		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
+	depw,z		%r22,28,3,%r22		; r22 = 8 * (-n & 7)
+	sub		%r25,%r22,%r25		; offset s1_ptr
+	sub		%r24,%r22,%r24		; offset s2_ptr
+	sub		%r26,%r22,%r26		; offset res_ptr
+	blr		%r28,%r0		; branch into loop
+	add		%r0,%r0,%r0		; reset carry
+
+L$loop	ldd		0(%r25),%r20
+	ldd		0(%r24),%r31
+	add,dc		%r20,%r31,%r20
+	std		%r20,0(%r26)
+L$7	ldd		8(%r25),%r21
+	ldd		8(%r24),%r19
+	add,dc		%r21,%r19,%r21
+	std		%r21,8(%r26)
+L$6	ldd		16(%r25),%r20
+	ldd		16(%r24),%r31
+	add,dc		%r20,%r31,%r20
+	std		%r20,16(%r26)
+L$5	ldd		24(%r25),%r21
+	ldd		24(%r24),%r19
+	add,dc		%r21,%r19,%r21
+	std		%r21,24(%r26)
+L$4	ldd		32(%r25),%r20
+	ldd		32(%r24),%r31
+	add,dc		%r20,%r31,%r20
+	std		%r20,32(%r26)
+L$3	ldd		40(%r25),%r21
+	ldd		40(%r24),%r19
+	add,dc		%r21,%r19,%r21
+	std		%r21,40(%r26)
+L$2	ldd		48(%r25),%r20
+	ldd		48(%r24),%r31
+	add,dc		%r20,%r31,%r20
+	std		%r20,48(%r26)
+L$1	ldd		56(%r25),%r21
+	ldo		64(%r25),%r25
+	ldd		56(%r24),%r19
+	add,dc		%r21,%r19,%r21
+	std		%r21,56(%r26)
+	ldo		64(%r24),%r24
+	addib,>		-8,%r23,L$loop
+	ldo		64(%r26),%r26
+
+	add,dc		%r0,%r0,%r29
+	bve		(%r2)
+	.exit
+	ldi		0,%r28
+	.procend
diff --git a/src/gmp/mpn/pa64/addmul_1.S b/src/gmp/mpn/pa64/addmul_1.S
new file mode 100644
index 000000000..b1885b432
--- /dev/null
+++ b/src/gmp/mpn/pa64/addmul_1.S
@@ -0,0 +1,167 @@
+; HP-PA 2.0 64-bit __gmpn_addmul_1 -- Multiply a limb vector with a limb and
+; add the result to a second limb vector.
+
+; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+; INPUT PARAMETERS
+#define rptr		%r26
+#define sptr		%r25
+#define size		%r24
+#define s2limb		-56(%r30)
+
+; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
+; it faster, but the PA8000 pipeline is not publically documented and it
+; is very complex to reverse engineer
+
+#define t1 %r19
+#define rlimb %r20
+#define hi %r21
+#define lo %r22
+#define m0 %r28
+#define m1 %r3
+#define cylimb %r29
+#define t3 %r4
+#define t2 %r6
+#define t5 %r23
+#define t4 %r31
+	.level  2.0n
+	.code
+	.export __gmpn_addmul_1,entry
+__gmpn_addmul_1
+	.proc
+	.callinfo frame=128,no_calls
+	.entry
+        fldd		-56(%r30),%fr5		; s2limb passed on stack
+	ldo		128(%r30),%r30
+	add		%r0,%r0,cylimb		; clear cy and cylimb
+
+	std		%r3,-96(%r30)
+	std		%r4,-88(%r30)
+	std		%r5,-80(%r30)
+	std		%r6,-72(%r30)
+	depdi,z		1,31,1,%r5
+
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	addib,=		-1,%r24,L$end1
+	nop
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	addib,=		-1,%r24,L$end2
+	nop
+L$loop
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m1
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,rlimb,rlimb
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	add		t4,rlimb,t3
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	add,dc		%r0,cylimb,cylimb
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	std		t3,0(rptr)
+	addib,<>	-1,%r24,L$loop
+	ldo		8(rptr),rptr
+L$end2
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,rlimb,rlimb
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	add		t4,rlimb,t3
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	add,dc		%r0,cylimb,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+L$end1
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	add		cylimb,rlimb,rlimb
+	add,dc		t2,hi,cylimb
+	add		t4,rlimb,t3
+	add,dc		%r0,cylimb,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+
+	ldd		-96(%r30),%r3
+	ldd		-88(%r30),%r4
+	ldd		-80(%r30),%r5
+	ldd		-72(%r30),%r6
+
+	extrd,u		cylimb,31,32,%r28
+	bve		(%r2)
+	.exit
+	ldo		-128(%r30),%r30
+	.procend
diff --git a/src/gmp/mpn/pa64/gmp-mparam.h b/src/gmp/mpn/pa64/gmp-mparam.h
new file mode 100644
index 000000000..847735b98
--- /dev/null
+++ b/src/gmp/mpn/pa64/gmp-mparam.h
@@ -0,0 +1,65 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 64
+#define BYTES_PER_MP_LIMB 8
+#define BITS_PER_LONGINT 64
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+/* These values were measured in a PA8000 using the system compiler version
+   A.10.32.30.  Presumably the PA8200 and PA8500 have the same timing
+   characteristic, but GCC might give somewhat different results.  */
+/* Generated by tuneup.c, 2000-07-25. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   16
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD      105
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   40
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD      116
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              72
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD             94
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            50
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD       46
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD           1
+#endif
diff --git a/src/gmp/mpn/pa64/lshift.s b/src/gmp/mpn/pa64/lshift.s
new file mode 100644
index 000000000..994bc1c4d
--- /dev/null
+++ b/src/gmp/mpn/pa64/lshift.s
@@ -0,0 +1,103 @@
+; HP-PA 2.0 __gmpn_lshift --
+
+; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; size		gr24
+; cnt		gr23
+
+; This runs at 1.5 cycles/limb on PA8000.
+
+	.level	2.0n
+	.code
+	.export	__gmpn_lshift,entry
+__gmpn_lshift
+	.proc
+	.callinfo frame=0,args_saved
+	.entry
+
+	shladd		%r24,3,%r25,%r25
+	shladd		%r24,3,%r26,%r26
+	subi		64,%r23,%r23
+	mtsar		%r23
+	ldd		-8(%r25),%r21
+	addib,=		-1,%r24,L$end
+	shrpd		%r0,%r21,%sar,%r29	; compute carry out limb
+	depw,z		%r24,31,3,%r28		; r28 = (size & 7)
+	sub		%r0,%r24,%r22
+	depw,z		%r22,28,3,%r22		; r22 = 8 * (-size & 7)
+	add		%r25,%r22,%r25		; offset s1_ptr
+	blr		%r28,%r0		; branch into jump table
+	add		%r26,%r22,%r26		; offset res_ptr
+	b		L$0
+	nop
+	b		L$1
+	copy		%r21,%r20
+	b		L$2
+	nop
+	b		L$3
+	copy		%r21,%r20
+	b		L$4
+	nop
+	b		L$5
+	copy		%r21,%r20
+	b		L$6
+	nop
+	b		L$7
+	copy		%r21,%r20
+
+L$loop
+L$0	ldd		-16(%r25),%r20
+	shrpd		%r21,%r20,%sar,%r21
+	std		%r21,-8(%r26)
+L$7	ldd		-24(%r25),%r21
+	shrpd		%r20,%r21,%sar,%r20
+	std		%r20,-16(%r26)
+L$6	ldd		-32(%r25),%r20
+	shrpd		%r21,%r20,%sar,%r21
+	std		%r21,-24(%r26)
+L$5	ldd		-40(%r25),%r21
+	shrpd		%r20,%r21,%sar,%r20
+	std		%r20,-32(%r26)
+L$4	ldd		-48(%r25),%r20
+	shrpd		%r21,%r20,%sar,%r21
+	std		%r21,-40(%r26)
+L$3	ldd		-56(%r25),%r21
+	shrpd		%r20,%r21,%sar,%r20
+	std		%r20,-48(%r26)
+L$2	ldd		-64(%r25),%r20
+	shrpd		%r21,%r20,%sar,%r21
+	std		%r21,-56(%r26)
+L$1	ldd		-72(%r25),%r21
+	ldo		-64(%r25),%r25
+	shrpd		%r20,%r21,%sar,%r20
+	std		%r20,-64(%r26)
+	addib,>		-8,%r24,L$loop
+	ldo		-64(%r26),%r26
+
+L$end	shrpd		%r21,%r0,%sar,%r21
+	std		%r21,-8(%r26)
+	bve		(%r2)
+	.exit
+	extrd,u		%r29,31,32,%r28
+	.procend
diff --git a/src/gmp/mpn/pa64/mul_1.S b/src/gmp/mpn/pa64/mul_1.S
new file mode 100644
index 000000000..ab310c126
--- /dev/null
+++ b/src/gmp/mpn/pa64/mul_1.S
@@ -0,0 +1,158 @@
+; HP-PA 2.0 64-bit __gmpn_mul_1 -- Multiply a limb vector with a limb and
+; store the result in a second limb vector.
+
+; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+; INPUT PARAMETERS
+#define rptr		%r26
+#define sptr		%r25
+#define size		%r24
+#define s2limb		-56(%r30)
+
+; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
+; it faster, but the PA8000 pipeline is not publically documented and it
+; is very complex to reverse engineer
+
+#define t1 %r19
+#define rlimb %r20
+#define hi %r21
+#define lo %r22
+#define m0 %r28
+#define m1 %r3
+#define cylimb %r29
+#define t3 %r4
+#define t2 %r6
+#define t5 %r23
+#define t4 %r31
+	.level  2.0n
+	.code
+	.export __gmpn_mul_1,entry
+__gmpn_mul_1
+	.proc
+	.callinfo frame=128,no_calls
+	.entry
+        fldd		-56(%r30),%fr5		; s2limb passed on stack
+	ldo		128(%r30),%r30
+	add		%r0,%r0,cylimb		; clear cy and cylimb
+
+	std		%r3,-96(%r30)
+	std		%r4,-88(%r30)
+	std		%r5,-80(%r30)
+	std		%r6,-72(%r30)
+	depdi,z		1,31,1,%r5
+
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	addib,=		-1,%r24,L$end1
+	nop
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	addib,=		-1,%r24,L$end2
+	nop
+L$loop
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m1
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,t4,t3
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	std		t3,0(rptr)
+	addib,<>	-1,%r24,L$loop
+	ldo		8(rptr),rptr
+L$end2
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,t4,t3
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+L$end1
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t2 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	add		cylimb,t4,t3
+	add,dc		t2,hi,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+
+	ldd		-96(%r30),%r3
+	ldd		-88(%r30),%r4
+	ldd		-80(%r30),%r5
+	ldd		-72(%r30),%r6
+
+	extrd,u		cylimb,31,32,%r28
+	bve		(%r2)
+	.exit
+	ldo		-128(%r30),%r30
+	.procend
diff --git a/src/gmp/mpn/pa64/rshift.s b/src/gmp/mpn/pa64/rshift.s
new file mode 100644
index 000000000..f0730e2a9
--- /dev/null
+++ b/src/gmp/mpn/pa64/rshift.s
@@ -0,0 +1,100 @@
+; HP-PA 2.0 __gmpn_rshift --
+
+; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; size		gr24
+; cnt		gr23
+
+; This runs at 1.5 cycles/limb on PA8000.
+
+	.level	2.0n
+	.code
+	.export	__gmpn_rshift,entry
+__gmpn_rshift
+	.proc
+	.callinfo frame=0,args_saved
+	.entry
+
+	mtsar		%r23
+	ldd		0(%r25),%r21
+	addib,=		-1,%r24,L$end
+	shrpd		%r21,%r0,%sar,%r29	; compute carry out limb
+	depw,z		%r24,31,3,%r28		; r28 = (size & 7)
+	sub		%r0,%r24,%r22
+	depw,z		%r22,28,3,%r22		; r22 = 8 * (-size & 7)
+	sub		%r25,%r22,%r25		; offset s1_ptr
+	blr		%r28,%r0		; branch into jump table
+	sub		%r26,%r22,%r26		; offset res_ptr
+	b		L$0
+	nop
+	b		L$1
+	copy		%r21,%r20
+	b		L$2
+	nop
+	b		L$3
+	copy		%r21,%r20
+	b		L$4
+	nop
+	b		L$5
+	copy		%r21,%r20
+	b		L$6
+	nop
+	b		L$7
+	copy		%r21,%r20
+
+L$loop
+L$0	ldd		8(%r25),%r20
+	shrpd		%r20,%r21,%sar,%r21
+	std		%r21,0(%r26)
+L$7	ldd		16(%r25),%r21
+	shrpd		%r21,%r20,%sar,%r20
+	std		%r20,8(%r26)
+L$6	ldd		24(%r25),%r20
+	shrpd		%r20,%r21,%sar,%r21
+	std		%r21,16(%r26)
+L$5	ldd		32(%r25),%r21
+	shrpd		%r21,%r20,%sar,%r20
+	std		%r20,24(%r26)
+L$4	ldd		40(%r25),%r20
+	shrpd		%r20,%r21,%sar,%r21
+	std		%r21,32(%r26)
+L$3	ldd		48(%r25),%r21
+	shrpd		%r21,%r20,%sar,%r20
+	std		%r20,40(%r26)
+L$2	ldd		56(%r25),%r20
+	shrpd		%r20,%r21,%sar,%r21
+	std		%r21,48(%r26)
+L$1	ldd		64(%r25),%r21
+	ldo		64(%r25),%r25
+	shrpd		%r21,%r20,%sar,%r20
+	std		%r20,56(%r26)
+	addib,>		-8,%r24,L$loop
+	ldo		64(%r26),%r26
+
+L$end	shrpd		%r0,%r21,%sar,%r21
+	std		%r21,0(%r26)
+	bve		(%r2)
+	.exit
+	extrd,u		%r29,31,32,%r28
+	.procend
diff --git a/src/gmp/mpn/pa64/sub_n.s b/src/gmp/mpn/pa64/sub_n.s
new file mode 100644
index 000000000..dda1f54b3
--- /dev/null
+++ b/src/gmp/mpn/pa64/sub_n.s
@@ -0,0 +1,90 @@
+; HP-PA 2.0 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0
+; and store difference in a third limb vector.
+
+; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+; This runs at 2 cycles/limb on PA8000.
+
+	.level	2.0n
+	.code
+	.export	__gmpn_sub_n,entry
+__gmpn_sub_n
+	.proc
+	.callinfo frame=0,args_saved
+	.entry
+
+	sub		%r0,%r23,%r22
+	depw,z		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
+	depw,z		%r22,28,3,%r22		; r22 = 8 * (-n & 7)
+	sub		%r25,%r22,%r25		; offset s1_ptr
+	sub		%r24,%r22,%r24		; offset s2_ptr
+	blr		%r28,%r0		; branch into loop
+	sub		%r26,%r22,%r26		; offset res_ptr and set carry
+
+L$loop	ldd		0(%r25),%r20
+	ldd		0(%r24),%r31
+	sub,db		%r20,%r31,%r20
+	std		%r20,0(%r26)
+L$7	ldd		8(%r25),%r21
+	ldd		8(%r24),%r19
+	sub,db		%r21,%r19,%r21
+	std		%r21,8(%r26)
+L$6	ldd		16(%r25),%r20
+	ldd		16(%r24),%r31
+	sub,db		%r20,%r31,%r20
+	std		%r20,16(%r26)
+L$5	ldd		24(%r25),%r21
+	ldd		24(%r24),%r19
+	sub,db		%r21,%r19,%r21
+	std		%r21,24(%r26)
+L$4	ldd		32(%r25),%r20
+	ldd		32(%r24),%r31
+	sub,db		%r20,%r31,%r20
+	std		%r20,32(%r26)
+L$3	ldd		40(%r25),%r21
+	ldd		40(%r24),%r19
+	sub,db		%r21,%r19,%r21
+	std		%r21,40(%r26)
+L$2	ldd		48(%r25),%r20
+	ldd		48(%r24),%r31
+	sub,db		%r20,%r31,%r20
+	std		%r20,48(%r26)
+L$1	ldd		56(%r25),%r21
+	ldo		64(%r25),%r25
+	ldd		56(%r24),%r19
+	sub,db		%r21,%r19,%r21
+	std		%r21,56(%r26)
+	ldo		64(%r24),%r24
+	addib,>		-8,%r23,L$loop
+	ldo		64(%r26),%r26
+
+	add,dc		%r0,%r0,%r29
+	subi		1,%r29,%r29
+	bve		(%r2)
+	.exit
+	ldi		0,%r28
+	.procend
diff --git a/src/gmp/mpn/pa64/submul_1.S b/src/gmp/mpn/pa64/submul_1.S
new file mode 100644
index 000000000..27666b99d
--- /dev/null
+++ b/src/gmp/mpn/pa64/submul_1.S
@@ -0,0 +1,170 @@
+; HP-PA 2.0 64-bit __gmpn_submul_1 -- Multiply a limb vector with a limb and
+; subtract the result from a second limb vector.
+
+; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+; INPUT PARAMETERS
+#define rptr		%r26
+#define sptr		%r25
+#define size		%r24
+#define s2limb		-56(%r30)
+
+; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
+; it faster, but the PA8000 pipeline is not publically documented and it
+; is very complex to reverse engineer
+
+#define t1 %r19
+#define rlimb %r20
+#define hi %r21
+#define lo %r22
+#define m0 %r28
+#define m1 %r3
+#define cylimb %r29
+#define t3 %r4
+#define t2 %r6
+#define t5 %r23
+#define t4 %r31
+	.level  2.0n
+	.code
+	.export __gmpn_submul_1,entry
+__gmpn_submul_1
+	.proc
+	.callinfo frame=128,no_calls
+	.entry
+        fldd		-56(%r30),%fr5		; s2limb passed on stack
+	ldo		128(%r30),%r30
+	add		%r0,%r0,cylimb		; clear cy and cylimb
+
+	std		%r3,-96(%r30)
+	std		%r4,-88(%r30)
+	std		%r5,-80(%r30)
+	std		%r6,-72(%r30)
+	depdi,z		1,31,1,%r5
+
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	addib,=		-1,%r24,L$end1
+	nop
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	addib,=		-1,%r24,L$end2
+	nop
+L$loop
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m1
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,t4,t4
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	sub		rlimb,t4,t3
+	add		t4,t3,%r0
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	add,dc		%r0,cylimb,cylimb
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	std		t3,0(rptr)
+	addib,<>	-1,%r24,L$loop
+	ldo		8(rptr),rptr
+L$end2
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,t4,t4
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	sub		rlimb,t4,t3
+	add		t4,t3,%r0
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	add,dc		%r0,cylimb,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+L$end1
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	add		cylimb,t4,t4
+	add,dc		t2,hi,cylimb
+	sub		rlimb,t4,t3
+	add		t4,t3,%r0
+	add,dc		%r0,cylimb,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+
+	ldd		-96(%r30),%r3
+	ldd		-88(%r30),%r4
+	ldd		-80(%r30),%r5
+	ldd		-72(%r30),%r6
+
+	extrd,u		cylimb,31,32,%r28
+	bve		(%r2)
+	.exit
+	ldo		-128(%r30),%r30
+	.procend
diff --git a/src/gmp/mpn/pa64/udiv_qrnnd.c b/src/gmp/mpn/pa64/udiv_qrnnd.c
new file mode 100644
index 000000000..1c9fe084d
--- /dev/null
+++ b/src/gmp/mpn/pa64/udiv_qrnnd.c
@@ -0,0 +1,111 @@
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#define TWO64 18446744073709551616.0
+
+mp_limb_t
+#if __STDC__
+__MPN(udiv_qrnnd) (mp_limb_t n1, mp_limb_t n0, mp_limb_t d, mp_limb_t *r)
+#else
+__MPN(udiv_qrnnd) (n1, n0, d, r)
+     mp_limb_t n1;
+     mp_limb_t n0;
+     mp_limb_t d;
+     mp_limb_t *r;
+#endif
+{
+  mp_limb_t q1, q2, q;
+  mp_limb_t p1, p0;
+  double di, dq;
+
+  di = 1.0 / d;
+
+  /* Generate upper 53 bits of quotient.  Be careful here; the `double'
+     quotient may be rounded to 2^64 which we cannot safely convert back
+     to a 64-bit integer.  */
+  dq = (TWO64 * (double) n1 + (double) n0) * di;
+  if (dq >= TWO64)
+    q1 = 0xfffffffffffff800LL;
+  else
+    q1 = (mp_limb_t) dq;
+
+  /* Multiply back in order to compare the product to the dividend.  */
+  umul_ppmm (p1, p0, q1, d);
+
+  /* Was the 53-bit quotient greater that our sought quotient?  Test the
+     sign of the partial remainder to find out.  */
+  if (n1 < p1 || (n1 == p1 && n0 < p0))
+    {
+      /* 53-bit quotient too large.  Partial remainder is negative.
+	 Compute the absolute value of the remainder in n1,,n0.  */
+      n1 = p1 - (n1 + (p0 < n0));
+      n0 = p0 - n0;
+
+      /* Now use the partial remainder as new dividend to compute more bits of
+	 quotient.  This is an adjustment for the one we got previously.  */
+      q2 = (mp_limb_t) ((TWO64 * (double) n1 + (double) n0) * di);
+      umul_ppmm (p1, p0, q2, d);
+
+      q = q1 - q2;
+      if (n1 < p1 || (n1 == p1 && n0 <= p0))
+	{
+	  n0 = p0 - n0;
+	}
+      else
+	{
+	  n0 = p0 - n0;
+	  n0 += d;
+	  q--;
+	}
+    }
+  else
+    {
+      n1 = n1 - (p1 + (n0 < p0));
+      n0 = n0 - p0;
+
+      q2 = (mp_limb_t) ((TWO64 * (double) n1 + (double) n0) * di);
+      umul_ppmm (p1, p0, q2, d);
+
+      q = q1 + q2;
+      if (n1 < p1 || (n1 == p1 && n0 < p0))
+	{
+	  n0 = n0 - p0;
+	  n0 += d;
+	  q--;
+	}
+      else
+	{
+	  n0 = n0 - p0;
+	  if (n0 >= d)
+	    {
+	      n0 -= d;
+	      q++;
+	    }
+	}
+    }
+
+  *r = n0;
+  return q;
+}
diff --git a/src/gmp/mpn/pa64/umul_ppmm.S b/src/gmp/mpn/pa64/umul_ppmm.S
new file mode 100644
index 000000000..ceff2d752
--- /dev/null
+++ b/src/gmp/mpn/pa64/umul_ppmm.S
@@ -0,0 +1,74 @@
+; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+#define p0	%r28
+#define p1	%r29
+#define t32	%r19
+#define t0	%r20
+#define t1	%r21
+#define x	%r22
+#define m0	%r23
+#define m1	%r24
+	.level  2.0n
+	.code
+	.export __gmpn_umul_ppmm,entry
+__gmpn_umul_ppmm
+	.proc
+	.callinfo frame=128,no_calls
+	.entry
+	ldo		128(%r30),%r30
+	depd		%r25,31,32,%r26
+	std		%r26,-64(%r30)
+	depd		%r23,31,32,%r24
+	std		%r24,-56(%r30)
+
+	ldw		-180(%r30),%r31
+
+        fldd		-64(%r30),%fr4
+        fldd		-56(%r30),%fr5
+
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+
+	depdi,z		1,31,1,t32		; t32 = 2^32
+
+	ldd		-128(%r30),p0		; lo = low 64 bit of product
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),p1		; hi = high 64 bit of product
+
+	add,l,*nuv	m0,m1,x			; x = m1+m0
+	 add,l		t32,p1,p1		; propagate carry to mid of p1
+	depd,z		x,31,32,t0		; lo32(m1+m0)
+	add		t0,p0,p0
+	extrd,u		x,31,32,t1		; hi32(m1+m0)
+	add,dc		t1,p1,p1
+
+	std		p0,0(%r31)		; store low half of product
+	extrd,u		p1,31,32,%r28		; return high half of product
+	bve		(%r2)
+	.exit
+	ldo		-128(%r30),%r30
+	.procend
diff --git a/src/gmp/mpn/pa64w/README b/src/gmp/mpn/pa64w/README
new file mode 100644
index 000000000..cf590a7b9
--- /dev/null
+++ b/src/gmp/mpn/pa64w/README
@@ -0,0 +1,2 @@
+This directory contains mpn functions for 64-bit PA-RISC 2.0
+using 64-bit pointers (2.0W).
diff --git a/src/gmp/mpn/pa64w/add_n.s b/src/gmp/mpn/pa64w/add_n.s
new file mode 100644
index 000000000..1bb9e8fbc
--- /dev/null
+++ b/src/gmp/mpn/pa64w/add_n.s
@@ -0,0 +1,90 @@
+; HP-PA 2.0 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
+; store sum in a third limb vector.
+
+; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+; This runs at 2 cycles/limb on PA8000.
+
+	.level	2.0w
+	.code
+	.export	__gmpn_add_n,entry
+__gmpn_add_n
+	.proc
+	.callinfo frame=0,args_saved
+	.entry
+
+	sub		%r0,%r23,%r22
+	depw,z		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
+	depw,z		%r22,28,3,%r22		; r22 = 8 * (-n & 7)
+	sub		%r25,%r22,%r25		; offset s1_ptr
+	sub		%r24,%r22,%r24		; offset s2_ptr
+	sub		%r26,%r22,%r26		; offset res_ptr
+	blr		%r28,%r0		; branch into loop
+	add		%r0,%r0,%r0		; reset carry
+
+L$loop	ldd		0(%r25),%r20
+	ldd		0(%r24),%r31
+	add,dc		%r20,%r31,%r20
+	std		%r20,0(%r26)
+L$7	ldd		8(%r25),%r21
+	ldd		8(%r24),%r19
+	add,dc		%r21,%r19,%r21
+	std		%r21,8(%r26)
+L$6	ldd		16(%r25),%r20
+	ldd		16(%r24),%r31
+	add,dc		%r20,%r31,%r20
+	std		%r20,16(%r26)
+L$5	ldd		24(%r25),%r21
+	ldd		24(%r24),%r19
+	add,dc		%r21,%r19,%r21
+	std		%r21,24(%r26)
+L$4	ldd		32(%r25),%r20
+	ldd		32(%r24),%r31
+	add,dc		%r20,%r31,%r20
+	std		%r20,32(%r26)
+L$3	ldd		40(%r25),%r21
+	ldd		40(%r24),%r19
+	add,dc		%r21,%r19,%r21
+	std		%r21,40(%r26)
+L$2	ldd		48(%r25),%r20
+	ldd		48(%r24),%r31
+	add,dc		%r20,%r31,%r20
+	std		%r20,48(%r26)
+L$1	ldd		56(%r25),%r21
+	ldo		64(%r25),%r25
+	ldd		56(%r24),%r19
+	add,dc		%r21,%r19,%r21
+	std		%r21,56(%r26)
+	ldo		64(%r24),%r24
+	addib,>		-8,%r23,L$loop
+	ldo		64(%r26),%r26
+
+	add,dc		%r0,%r0,%r29
+	bve		(%r2)
+	.exit
+	copy		%r29,%r28
+	.procend
diff --git a/src/gmp/mpn/pa64w/addmul_1.S b/src/gmp/mpn/pa64w/addmul_1.S
new file mode 100644
index 000000000..4799f90fc
--- /dev/null
+++ b/src/gmp/mpn/pa64w/addmul_1.S
@@ -0,0 +1,168 @@
+; HP-PA 2.0 64-bit __gmpn_addmul_1 -- Multiply a limb vector with a limb and
+; add the result to a second limb vector.
+
+; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+; INPUT PARAMETERS
+#define rptr		%r26
+#define sptr		%r25
+#define size		%r24
+#define s2limb		%r23
+
+; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
+; it faster, but the PA8000 pipeline is not publically documented and it
+; is very complex to reverse engineer
+
+#define t1 %r19
+#define rlimb %r20
+#define hi %r21
+#define lo %r22
+#define m0 %r28
+#define m1 %r3
+#define cylimb %r29
+#define t3 %r4
+#define t2 %r6
+#define t5 %r23
+#define t4 %r31
+	.level  2.0w
+	.code
+	.export __gmpn_addmul_1,entry
+__gmpn_addmul_1
+	.proc
+	.callinfo frame=128,no_calls
+	.entry
+	std		s2limb,-56(%r30)
+        fldd		-56(%r30),%fr5
+	ldo		128(%r30),%r30
+	add		%r0,%r0,cylimb		; clear cy and cylimb
+
+	std		%r3,-96(%r30)
+	std		%r4,-88(%r30)
+	std		%r5,-80(%r30)
+	std		%r6,-72(%r30)
+	depdi,z		1,31,1,%r5
+
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	addib,=		-1,%r24,L$end1
+	nop
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	addib,=		-1,%r24,L$end2
+	nop
+L$loop
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m1
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,rlimb,rlimb
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	add		t4,rlimb,t3
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	add,dc		%r0,cylimb,cylimb
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	std		t3,0(rptr)
+	addib,<>	-1,%r24,L$loop
+	ldo		8(rptr),rptr
+L$end2
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,rlimb,rlimb
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	add		t4,rlimb,t3
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	add,dc		%r0,cylimb,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+L$end1
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	add		cylimb,rlimb,rlimb
+	add,dc		t2,hi,cylimb
+	add		t4,rlimb,t3
+	add,dc		%r0,cylimb,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+
+	ldd		-96(%r30),%r3
+	ldd		-88(%r30),%r4
+	ldd		-80(%r30),%r5
+	ldd		-72(%r30),%r6
+
+	copy		cylimb,%r28
+	bve		(%r2)
+	.exit
+	ldo		-128(%r30),%r30
+	.procend
diff --git a/src/gmp/mpn/pa64w/gmp-mparam.h b/src/gmp/mpn/pa64w/gmp-mparam.h
new file mode 100644
index 000000000..ee5a0a3ab
--- /dev/null
+++ b/src/gmp/mpn/pa64w/gmp-mparam.h
@@ -0,0 +1,65 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 64
+#define BYTES_PER_MP_LIMB 8
+#define BITS_PER_LONGINT 64
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+/* These values were measured on a PA8500 using the system compiler version
+   A.11.01.02.  Presumably the PA8000 and PA8200 have the same timing
+   characteristic, but GCC might give somewhat different results..  */
+/* Generated by tuneup.c, 2000-07-25. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   18
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD      105
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   46
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD       83
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              58
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD            134
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            56
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD       26
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD           1
+#endif
diff --git a/src/gmp/mpn/pa64w/lshift.s b/src/gmp/mpn/pa64w/lshift.s
new file mode 100644
index 000000000..84f925a10
--- /dev/null
+++ b/src/gmp/mpn/pa64w/lshift.s
@@ -0,0 +1,103 @@
+; HP-PA 2.0 __gmpn_lshift --
+
+; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; size		gr24
+; cnt		gr23
+
+; This runs at 1.5 cycles/limb on PA8000.
+
+	.level	2.0w
+	.code
+	.export	__gmpn_lshift,entry
+__gmpn_lshift
+	.proc
+	.callinfo frame=0,args_saved
+	.entry
+
+	shladd		%r24,3,%r25,%r25
+	shladd		%r24,3,%r26,%r26
+	subi		64,%r23,%r23
+	mtsar		%r23
+	ldd		-8(%r25),%r21
+	addib,=		-1,%r24,L$end
+	shrpd		%r0,%r21,%sar,%r29	; compute carry out limb
+	depw,z		%r24,31,3,%r28		; r28 = (size & 7)
+	sub		%r0,%r24,%r22
+	depw,z		%r22,28,3,%r22		; r22 = 8 * (-size & 7)
+	add		%r25,%r22,%r25		; offset s1_ptr
+	blr		%r28,%r0		; branch into jump table
+	add		%r26,%r22,%r26		; offset res_ptr
+	b		L$0
+	nop
+	b		L$1
+	copy		%r21,%r20
+	b		L$2
+	nop
+	b		L$3
+	copy		%r21,%r20
+	b		L$4
+	nop
+	b		L$5
+	copy		%r21,%r20
+	b		L$6
+	nop
+	b		L$7
+	copy		%r21,%r20
+
+L$loop
+L$0	ldd		-16(%r25),%r20
+	shrpd		%r21,%r20,%sar,%r21
+	std		%r21,-8(%r26)
+L$7	ldd		-24(%r25),%r21
+	shrpd		%r20,%r21,%sar,%r20
+	std		%r20,-16(%r26)
+L$6	ldd		-32(%r25),%r20
+	shrpd		%r21,%r20,%sar,%r21
+	std		%r21,-24(%r26)
+L$5	ldd		-40(%r25),%r21
+	shrpd		%r20,%r21,%sar,%r20
+	std		%r20,-32(%r26)
+L$4	ldd		-48(%r25),%r20
+	shrpd		%r21,%r20,%sar,%r21
+	std		%r21,-40(%r26)
+L$3	ldd		-56(%r25),%r21
+	shrpd		%r20,%r21,%sar,%r20
+	std		%r20,-48(%r26)
+L$2	ldd		-64(%r25),%r20
+	shrpd		%r21,%r20,%sar,%r21
+	std		%r21,-56(%r26)
+L$1	ldd		-72(%r25),%r21
+	ldo		-64(%r25),%r25
+	shrpd		%r20,%r21,%sar,%r20
+	std		%r20,-64(%r26)
+	addib,>		-8,%r24,L$loop
+	ldo		-64(%r26),%r26
+
+L$end	shrpd		%r21,%r0,%sar,%r21
+	std		%r21,-8(%r26)
+	bve		(%r2)
+	.exit
+	copy		%r29,%r28
+	.procend
diff --git a/src/gmp/mpn/pa64w/mul_1.S b/src/gmp/mpn/pa64w/mul_1.S
new file mode 100644
index 000000000..48f13fbd1
--- /dev/null
+++ b/src/gmp/mpn/pa64w/mul_1.S
@@ -0,0 +1,159 @@
+; HP-PA 2.0 64-bit __gmpn_mul_1 -- Multiply a limb vector with a limb and
+; store the result in a second limb vector.
+
+; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+; INPUT PARAMETERS
+#define rptr		%r26
+#define sptr		%r25
+#define size		%r24
+#define s2limb		%r23
+
+; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
+; it faster, but the PA8000 pipeline is not publically documented and it
+; is very complex to reverse engineer
+
+#define t1 %r19
+#define rlimb %r20
+#define hi %r21
+#define lo %r22
+#define m0 %r28
+#define m1 %r3
+#define cylimb %r29
+#define t3 %r4
+#define t2 %r6
+#define t5 %r23
+#define t4 %r31
+	.level  2.0w
+	.code
+	.export __gmpn_mul_1,entry
+__gmpn_mul_1
+	.proc
+	.callinfo frame=128,no_calls
+	.entry
+	std		s2limb,-56(%r30)
+        fldd		-56(%r30),%fr5
+	ldo		128(%r30),%r30
+	add		%r0,%r0,cylimb		; clear cy and cylimb
+
+	std		%r3,-96(%r30)
+	std		%r4,-88(%r30)
+	std		%r5,-80(%r30)
+	std		%r6,-72(%r30)
+	depdi,z		1,31,1,%r5
+
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	addib,=		-1,%r24,L$end1
+	nop
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	addib,=		-1,%r24,L$end2
+	nop
+L$loop
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m1
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,t4,t3
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	std		t3,0(rptr)
+	addib,<>	-1,%r24,L$loop
+	ldo		8(rptr),rptr
+L$end2
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,t4,t3
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+L$end1
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t2 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	add		cylimb,t4,t3
+	add,dc		t2,hi,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+
+	ldd		-96(%r30),%r3
+	ldd		-88(%r30),%r4
+	ldd		-80(%r30),%r5
+	ldd		-72(%r30),%r6
+
+	copy		cylimb,%r28
+	bve		(%r2)
+	.exit
+	ldo		-128(%r30),%r30
+	.procend
diff --git a/src/gmp/mpn/pa64w/rshift.s b/src/gmp/mpn/pa64w/rshift.s
new file mode 100644
index 000000000..2517cb1f8
--- /dev/null
+++ b/src/gmp/mpn/pa64w/rshift.s
@@ -0,0 +1,100 @@
+; HP-PA 2.0 __gmpn_rshift --
+
+; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; size		gr24
+; cnt		gr23
+
+; This runs at 1.5 cycles/limb on PA8000.
+
+	.level	2.0w
+	.code
+	.export	__gmpn_rshift,entry
+__gmpn_rshift
+	.proc
+	.callinfo frame=0,args_saved
+	.entry
+
+	mtsar		%r23
+	ldd		0(%r25),%r21
+	addib,=		-1,%r24,L$end
+	shrpd		%r21,%r0,%sar,%r29	; compute carry out limb
+	depw,z		%r24,31,3,%r28		; r28 = (size & 7)
+	sub		%r0,%r24,%r22
+	depw,z		%r22,28,3,%r22		; r22 = 8 * (-size & 7)
+	sub		%r25,%r22,%r25		; offset s1_ptr
+	blr		%r28,%r0		; branch into jump table
+	sub		%r26,%r22,%r26		; offset res_ptr
+	b		L$0
+	nop
+	b		L$1
+	copy		%r21,%r20
+	b		L$2
+	nop
+	b		L$3
+	copy		%r21,%r20
+	b		L$4
+	nop
+	b		L$5
+	copy		%r21,%r20
+	b		L$6
+	nop
+	b		L$7
+	copy		%r21,%r20
+
+L$loop
+L$0	ldd		8(%r25),%r20
+	shrpd		%r20,%r21,%sar,%r21
+	std		%r21,0(%r26)
+L$7	ldd		16(%r25),%r21
+	shrpd		%r21,%r20,%sar,%r20
+	std		%r20,8(%r26)
+L$6	ldd		24(%r25),%r20
+	shrpd		%r20,%r21,%sar,%r21
+	std		%r21,16(%r26)
+L$5	ldd		32(%r25),%r21
+	shrpd		%r21,%r20,%sar,%r20
+	std		%r20,24(%r26)
+L$4	ldd		40(%r25),%r20
+	shrpd		%r20,%r21,%sar,%r21
+	std		%r21,32(%r26)
+L$3	ldd		48(%r25),%r21
+	shrpd		%r21,%r20,%sar,%r20
+	std		%r20,40(%r26)
+L$2	ldd		56(%r25),%r20
+	shrpd		%r20,%r21,%sar,%r21
+	std		%r21,48(%r26)
+L$1	ldd		64(%r25),%r21
+	ldo		64(%r25),%r25
+	shrpd		%r21,%r20,%sar,%r20
+	std		%r20,56(%r26)
+	addib,>		-8,%r24,L$loop
+	ldo		64(%r26),%r26
+
+L$end	shrpd		%r0,%r21,%sar,%r21
+	std		%r21,0(%r26)
+	bve		(%r2)
+	.exit
+	copy		%r29,%r28
+	.procend
diff --git a/src/gmp/mpn/pa64w/sub_n.s b/src/gmp/mpn/pa64w/sub_n.s
new file mode 100644
index 000000000..ad01e24aa
--- /dev/null
+++ b/src/gmp/mpn/pa64w/sub_n.s
@@ -0,0 +1,90 @@
+; HP-PA 2.0 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0
+; and store difference in a third limb vector.
+
+; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+
+; INPUT PARAMETERS
+; res_ptr	gr26
+; s1_ptr	gr25
+; s2_ptr	gr24
+; size		gr23
+
+; This runs at 2 cycles/limb on PA8000.
+
+	.level	2.0w
+	.code
+	.export	__gmpn_sub_n,entry
+__gmpn_sub_n
+	.proc
+	.callinfo frame=0,args_saved
+	.entry
+
+	sub		%r0,%r23,%r22
+	depw,z		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
+	depw,z		%r22,28,3,%r22		; r22 = 8 * (-n & 7)
+	sub		%r25,%r22,%r25		; offset s1_ptr
+	sub		%r24,%r22,%r24		; offset s2_ptr
+	blr		%r28,%r0		; branch into loop
+	sub		%r26,%r22,%r26		; offset res_ptr and set carry
+
+L$loop	ldd		0(%r25),%r20
+	ldd		0(%r24),%r31
+	sub,db		%r20,%r31,%r20
+	std		%r20,0(%r26)
+L$7	ldd		8(%r25),%r21
+	ldd		8(%r24),%r19
+	sub,db		%r21,%r19,%r21
+	std		%r21,8(%r26)
+L$6	ldd		16(%r25),%r20
+	ldd		16(%r24),%r31
+	sub,db		%r20,%r31,%r20
+	std		%r20,16(%r26)
+L$5	ldd		24(%r25),%r21
+	ldd		24(%r24),%r19
+	sub,db		%r21,%r19,%r21
+	std		%r21,24(%r26)
+L$4	ldd		32(%r25),%r20
+	ldd		32(%r24),%r31
+	sub,db		%r20,%r31,%r20
+	std		%r20,32(%r26)
+L$3	ldd		40(%r25),%r21
+	ldd		40(%r24),%r19
+	sub,db		%r21,%r19,%r21
+	std		%r21,40(%r26)
+L$2	ldd		48(%r25),%r20
+	ldd		48(%r24),%r31
+	sub,db		%r20,%r31,%r20
+	std		%r20,48(%r26)
+L$1	ldd		56(%r25),%r21
+	ldo		64(%r25),%r25
+	ldd		56(%r24),%r19
+	sub,db		%r21,%r19,%r21
+	std		%r21,56(%r26)
+	ldo		64(%r24),%r24
+	addib,>		-8,%r23,L$loop
+	ldo		64(%r26),%r26
+
+	add,dc		%r0,%r0,%r29
+	subi		1,%r29,%r29
+	bve		(%r2)
+	.exit
+	copy		%r29,%r28
+	.procend
diff --git a/src/gmp/mpn/pa64w/submul_1.S b/src/gmp/mpn/pa64w/submul_1.S
new file mode 100644
index 000000000..294f6239b
--- /dev/null
+++ b/src/gmp/mpn/pa64w/submul_1.S
@@ -0,0 +1,171 @@
+; HP-PA 2.0 64-bit __gmpn_submul_1 -- Multiply a limb vector with a limb and
+; subtract the result from a second limb vector.
+
+; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+; INPUT PARAMETERS
+#define rptr		%r26
+#define sptr		%r25
+#define size		%r24
+#define s2limb		%r23
+
+; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
+; it faster, but the PA8000 pipeline is not publically documented and it
+; is very complex to reverse engineer
+
+#define t1 %r19
+#define rlimb %r20
+#define hi %r21
+#define lo %r22
+#define m0 %r28
+#define m1 %r3
+#define cylimb %r29
+#define t3 %r4
+#define t2 %r6
+#define t5 %r23
+#define t4 %r31
+	.level  2.0w
+	.code
+	.export __gmpn_submul_1,entry
+__gmpn_submul_1
+	.proc
+	.callinfo frame=128,no_calls
+	.entry
+	std		s2limb,-56(%r30)
+        fldd		-56(%r30),%fr5
+	ldo		128(%r30),%r30
+	add		%r0,%r0,cylimb		; clear cy and cylimb
+
+	std		%r3,-96(%r30)
+	std		%r4,-88(%r30)
+	std		%r5,-80(%r30)
+	std		%r6,-72(%r30)
+	depdi,z		1,31,1,%r5
+
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	addib,=		-1,%r24,L$end1
+	nop
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	addib,=		-1,%r24,L$end2
+	nop
+L$loop
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m1
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,t4,t4
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	sub		rlimb,t4,t3
+	add		t4,t3,%r0
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	add,dc		%r0,cylimb,cylimb
+	fldd		0(sptr),%fr4
+	ldo		8(sptr),sptr
+	std		t3,0(rptr)
+	addib,<>	-1,%r24,L$loop
+	ldo		8(rptr),rptr
+L$end2
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	ldd		-128(%r30),lo		; lo = low 64 bit of product
+	add		cylimb,t4,t4
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	add,dc		t2,hi,cylimb
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	sub		rlimb,t4,t3
+	add		t4,t3,%r0
+	ldd		-104(%r30),hi		; hi = high 64 bit of product
+	add,dc		%r0,cylimb,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+L$end1
+	ldd		0(rptr),rlimb
+	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
+	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
+	add,l		m0,t1,t1		; t1 += m0
+	add,l,*nuv	m1,t1,t1		; t1 += m0
+	 add,l		%r5,hi,hi		; propagate carry
+	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
+	depd,z		t1,31,32,t5		; t5 = lo32(t1)
+	add,l		t5,t4,t4		; t4 += lo32(t1)
+	add		cylimb,t4,t4
+	add,dc		t2,hi,cylimb
+	sub		rlimb,t4,t3
+	add		t4,t3,%r0
+	add,dc		%r0,cylimb,cylimb
+	std		t3,0(rptr)
+	ldo		8(rptr),rptr
+
+	ldd		-96(%r30),%r3
+	ldd		-88(%r30),%r4
+	ldd		-80(%r30),%r5
+	ldd		-72(%r30),%r6
+
+	copy		cylimb,%r28
+	bve		(%r2)
+	.exit
+	ldo		-128(%r30),%r30
+	.procend
diff --git a/src/gmp/mpn/pa64w/udiv_qrnnd.c b/src/gmp/mpn/pa64w/udiv_qrnnd.c
new file mode 100644
index 000000000..185291300
--- /dev/null
+++ b/src/gmp/mpn/pa64w/udiv_qrnnd.c
@@ -0,0 +1,117 @@
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#define TWO64 18446744073709551616.0
+#define TWO63 9223372036854775808.0
+
+mp_limb_t
+#if __STDC__
+__MPN(udiv_qrnnd) (mp_limb_t n1, mp_limb_t n0, mp_limb_t d, mp_limb_t *r)
+#else
+__MPN(udiv_qrnnd) (n1, n0, d, r)
+     mp_limb_t n1;
+     mp_limb_t n0;
+     mp_limb_t d;
+     mp_limb_t *r;
+#endif
+{
+  mp_limb_t q1, q2, q;
+  mp_limb_t p1, p0;
+  double di, dq;
+
+  di = 1.0 / d;
+
+  /* Generate upper 53 bits of quotient.  Be careful here; the `double'
+     quotient may be rounded to 2^64 which we cannot safely convert back
+     to a 64-bit integer.  */
+  dq = (TWO64 * (double) n1 + (double) n0) * di;
+  if (dq >= TWO64)
+    q1 = 0xfffffffffffff800L;
+#ifndef __GNUC__
+  /* Work around HP compiler bug.  */
+  else if (dq > TWO63)
+    q1 = (mp_limb_t) (dq - TWO63) + 0x8000000000000000L;
+#endif
+  else
+    q1 = (mp_limb_t) dq;
+
+  /* Multiply back in order to compare the product to the dividend.  */
+  umul_ppmm (p1, p0, q1, d);
+
+  /* Was the 53-bit quotient greater that our sought quotient?  Test the
+     sign of the partial remainder to find out.  */
+  if (n1 < p1 || (n1 == p1 && n0 < p0))
+    {
+      /* 53-bit quotient too large.  Partial remainder is negative.
+	 Compute the absolute value of the remainder in n1,,n0.  */
+      n1 = p1 - (n1 + (p0 < n0));
+      n0 = p0 - n0;
+
+      /* Now use the partial remainder as new dividend to compute more bits of
+	 quotient.  This is an adjustment for the one we got previously.  */
+      q2 = (mp_limb_t) ((TWO64 * (double) n1 + (double) n0) * di);
+      umul_ppmm (p1, p0, q2, d);
+
+      q = q1 - q2;
+      if (n1 < p1 || (n1 == p1 && n0 <= p0))
+	{
+	  n0 = p0 - n0;
+	}
+      else
+	{
+	  n0 = p0 - n0;
+	  n0 += d;
+	  q--;
+	}
+    }
+  else
+    {
+      n1 = n1 - (p1 + (n0 < p0));
+      n0 = n0 - p0;
+
+      q2 = (mp_limb_t) ((TWO64 * (double) n1 + (double) n0) * di);
+      umul_ppmm (p1, p0, q2, d);
+
+      q = q1 + q2;
+      if (n1 < p1 || (n1 == p1 && n0 < p0))
+	{
+	  n0 = n0 - p0;
+	  n0 += d;
+	  q--;
+	}
+      else
+	{
+	  n0 = n0 - p0;
+	  if (n0 >= d)
+	    {
+	      n0 -= d;
+	      q++;
+	    }
+	}
+    }
+
+  *r = n0;
+  return q;
+}
diff --git a/src/gmp/mpn/pa64w/umul_ppmm.S b/src/gmp/mpn/pa64w/umul_ppmm.S
new file mode 100644
index 000000000..d9fb92be8
--- /dev/null
+++ b/src/gmp/mpn/pa64w/umul_ppmm.S
@@ -0,0 +1,72 @@
+; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+; This file is part of the GNU MP Library.
+
+; The GNU MP Library is free software; you can redistribute it and/or modify
+; it under the terms of the GNU Lesser General Public License as published by
+; the Free Software Foundation; either version 2.1 of the License, or (at your
+; option) any later version.
+
+; The GNU MP Library is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+; License for more details.
+
+; You should have received a copy of the GNU Lesser General Public License
+; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+; MA 02111-1307, USA.
+
+#define p0	%r28
+#define p1	%r29
+#define t32	%r19
+#define t0	%r20
+#define t1	%r21
+#define x	%r22
+#define m0	%r23
+#define m1	%r24
+	.level  2.0w
+	.code
+	.export __gmpn_umul_ppmm,entry
+__gmpn_umul_ppmm
+	.proc
+	.callinfo frame=128,no_calls
+	.entry
+	ldo		128(%r30),%r30
+	std		%r26,-64(%r30)
+	std		%r25,-56(%r30)
+
+	copy		%r24,%r31
+
+        fldd		-64(%r30),%fr4
+        fldd		-56(%r30),%fr5
+
+	xmpyu		%fr5R,%fr4R,%fr6
+	fstd		%fr6,-128(%r30)
+	xmpyu		%fr5R,%fr4L,%fr7
+	fstd		%fr7,-120(%r30)
+	xmpyu		%fr5L,%fr4R,%fr8
+	fstd		%fr8,-112(%r30)
+	xmpyu		%fr5L,%fr4L,%fr9
+	fstd		%fr9,-104(%r30)
+
+	depdi,z		1,31,1,t32		; t32 = 2^32
+
+	ldd		-128(%r30),p0		; lo = low 64 bit of product
+	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
+	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
+	ldd		-104(%r30),p1		; hi = high 64 bit of product
+
+	add,l,*nuv	m0,m1,x			; x = m1+m0
+	 add,l		t32,p1,p1		; propagate carry to mid of p1
+	depd,z		x,31,32,t0		; lo32(m1+m0)
+	add		t0,p0,p0
+	extrd,u		x,31,32,t1		; hi32(m1+m0)
+	add,dc		t1,p1,p1
+
+	std		p0,0(%r31)		; store low half of product
+	copy		p1,%r28			; return high half of product
+	bve		(%r2)
+	.exit
+	ldo		-128(%r30),%r30
+	.procend
diff --git a/src/gmp/mpn/power/add_n.s b/src/gmp/mpn/power/add_n.s
new file mode 100644
index 000000000..0f9f48f1c
--- /dev/null
+++ b/src/gmp/mpn/power/add_n.s
@@ -0,0 +1,79 @@
+# IBM POWER __gmpn_add_n -- Add two limb vectors of equal, non-zero length.
+
+# Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software Foundation,
+# Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# s2_ptr	r5
+# size		r6
+
+	.toc
+	.globl	__gmpn_add_n
+	.globl	.__gmpn_add_n
+	.csect	__gmpn_add_n[DS]
+__gmpn_add_n:
+	.long	.__gmpn_add_n, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.__gmpn_add_n:
+	andil.	10,6,1		# odd or even number of limbs?
+	l	8,0(4)		# load least significant s1 limb
+	l	0,0(5)		# load least significant s2 limb
+	cal	3,-4(3)		# offset res_ptr, it's updated before it's used
+	sri	10,6,1		# count for unrolled loop
+	a	7,0,8		# add least significant limbs, set cy
+	mtctr	10		# copy count into CTR
+	beq	0,Leven		# branch if even # of limbs (# of limbs >= 2)
+
+# We have an odd # of limbs.  Add the first limbs separately.
+	cmpi	1,10,0		# is count for unrolled loop zero?
+	bc	4,6,L1		# bne cr1,L1 (misassembled by gas)
+	st	7,4(3)
+	aze	3,10		# use the fact that r10 is zero...
+	br			# return
+
+# We added least significant limbs.  Now reload the next limbs to enter loop.
+L1:	lu	8,4(4)		# load s1 limb and update s1_ptr
+	lu	0,4(5)		# load s2 limb and update s2_ptr
+	stu	7,4(3)
+	ae	7,0,8		# add limbs, set cy
+Leven:	lu	9,4(4)		# load s1 limb and update s1_ptr
+	lu	10,4(5)		# load s2 limb and update s2_ptr
+	bdz	Lend		# If done, skip loop
+
+Loop:	lu	8,4(4)		# load s1 limb and update s1_ptr
+	lu	0,4(5)		# load s2 limb and update s2_ptr
+	ae	11,9,10		# add previous limbs with cy, set cy
+	stu	7,4(3)		# 
+	lu	9,4(4)		# load s1 limb and update s1_ptr
+	lu	10,4(5)		# load s2 limb and update s2_ptr
+	ae	7,0,8		# add previous limbs with cy, set cy
+	stu	11,4(3)		# 
+	bdn	Loop		# decrement CTR and loop back
+
+Lend:	ae	11,9,10		# add limbs with cy, set cy
+	st	7,4(3)		# 
+	st	11,8(3)		# 
+	lil	3,0		# load cy into ...
+	aze	3,3		# ... return value register
+	br
diff --git a/src/gmp/mpn/power/addmul_1.s b/src/gmp/mpn/power/addmul_1.s
new file mode 100644
index 000000000..8ecc65157
--- /dev/null
+++ b/src/gmp/mpn/power/addmul_1.s
@@ -0,0 +1,122 @@
+# IBM POWER __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
+# the result to a second limb vector.
+
+# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# size		r5
+# s2_limb	r6
+
+# The POWER architecture has no unsigned 32x32->64 bit multiplication
+# instruction.  To obtain that operation, we have to use the 32x32->64 signed
+# multiplication instruction, and add the appropriate compensation to the high
+# limb of the result.  We add the multiplicand if the multiplier has its most
+# significant bit set, and we add the multiplier if the multiplicand has its
+# most significant bit set.  We need to preserve the carry flag between each
+# iteration, so we have to compute the compensation carefully (the natural,
+# srai+and doesn't work).  Since the POWER architecture has a branch unit we
+# can branch in zero cycles, so that's how we perform the additions.
+
+	.toc
+	.globl	__gmpn_addmul_1
+	.globl	.__gmpn_addmul_1
+	.csect	__gmpn_addmul_1[DS]
+__gmpn_addmul_1:
+	.long	.__gmpn_addmul_1, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.__gmpn_addmul_1:
+
+	cal	3,-4(3)
+	l	0,0(4)
+	cmpi	0,6,0
+	mtctr	5
+	mul	9,0,6
+	srai	7,0,31
+	and	7,7,6
+	mfmq	8
+	cax	9,9,7
+	l	7,4(3)
+	a	8,8,7		# add res_limb
+	blt	Lneg
+Lpos:	bdz	Lend
+
+Lploop:	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	10,0,6
+	mfmq	0
+	ae	8,0,9		# low limb + old_cy_limb + old cy
+	l	7,4(3)
+	aze	10,10		# propagate cy to new cy_limb
+	a	8,8,7		# add res_limb
+	bge	Lp0
+	cax	10,10,6		# adjust high limb for negative limb from s1
+Lp0:	bdz	Lend0
+	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	9,0,6
+	mfmq	0
+	ae	8,0,10
+	l	7,4(3)
+	aze	9,9
+	a	8,8,7
+	bge	Lp1
+	cax	9,9,6		# adjust high limb for negative limb from s1
+Lp1:	bdn	Lploop
+
+	b	Lend
+
+Lneg:	cax	9,9,0
+	bdz	Lend
+Lnloop:	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	10,0,6
+	mfmq	7
+	ae	8,7,9
+	l	7,4(3)
+	ae	10,10,0		# propagate cy to new cy_limb
+	a	8,8,7		# add res_limb
+	bge	Ln0
+	cax	10,10,6		# adjust high limb for negative limb from s1
+Ln0:	bdz	Lend0
+	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	9,0,6
+	mfmq	7
+	ae	8,7,10
+	l	7,4(3)
+	ae	9,9,0		# propagate cy to new cy_limb
+	a	8,8,7		# add res_limb
+	bge	Ln1
+	cax	9,9,6		# adjust high limb for negative limb from s1
+Ln1:	bdn	Lnloop
+	b	Lend
+
+Lend0:	cal	9,0(10)
+Lend:	st	8,4(3)
+	aze	3,9
+	br
diff --git a/src/gmp/mpn/power/lshift.s b/src/gmp/mpn/power/lshift.s
new file mode 100644
index 000000000..ab71fb772
--- /dev/null
+++ b/src/gmp/mpn/power/lshift.s
@@ -0,0 +1,56 @@
+# IBM POWER __gmpn_lshift -- 
+
+# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s_ptr		r4
+# size		r5
+# cnt		r6
+
+	.toc
+	.globl	__gmpn_lshift
+	.globl	.__gmpn_lshift
+	.csect	__gmpn_lshift[DS]
+__gmpn_lshift:
+	.long	.__gmpn_lshift, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.__gmpn_lshift:
+	sli	0,5,2
+	cax	9,3,0
+	cax	4,4,0
+	sfi	8,6,32
+	mtctr	5		# put limb count in CTR loop register
+	lu	0,-4(4)		# read most significant limb
+	sre	3,0,8		# compute carry out limb, and init MQ register
+	bdz	Lend2		# if just one limb, skip loop
+	lu	0,-4(4)		# read 2:nd most significant limb
+	sreq	7,0,8		# compute most significant limb of result
+	bdz	Lend		# if just two limb, skip loop
+Loop:	lu	0,-4(4)		# load next lower limb
+	stu	7,-4(9)		# store previous result during read latency
+	sreq	7,0,8		# compute result limb
+	bdn	Loop		# loop back until CTR is zero
+Lend:	stu	7,-4(9)		# store 2:nd least significant limb
+Lend2:	sle	7,0,6		# compute least significant limb
+	st      7,-4(9)		# store it"				\
+	br
diff --git a/src/gmp/mpn/power/mul_1.s b/src/gmp/mpn/power/mul_1.s
new file mode 100644
index 000000000..4e08ade58
--- /dev/null
+++ b/src/gmp/mpn/power/mul_1.s
@@ -0,0 +1,109 @@
+# IBM POWER __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+# the result in a second limb vector.
+
+# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# size		r5
+# s2_limb	r6
+
+# The POWER architecture has no unsigned 32x32->64 bit multiplication
+# instruction.  To obtain that operation, we have to use the 32x32->64 signed
+# multiplication instruction, and add the appropriate compensation to the high
+# limb of the result.  We add the multiplicand if the multiplier has its most
+# significant bit set, and we add the multiplier if the multiplicand has its
+# most significant bit set.  We need to preserve the carry flag between each
+# iteration, so we have to compute the compensation carefully (the natural,
+# srai+and doesn't work).  Since the POWER architecture has a branch unit we
+# can branch in zero cycles, so that's how we perform the additions.
+
+	.toc
+	.globl	__gmpn_mul_1
+	.globl	.__gmpn_mul_1
+	.csect	__gmpn_mul_1[DS]
+__gmpn_mul_1:
+	.long	.__gmpn_mul_1, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.__gmpn_mul_1:
+
+	cal	3,-4(3)
+	l	0,0(4)
+	cmpi	0,6,0
+	mtctr	5
+	mul	9,0,6
+	srai	7,0,31
+	and	7,7,6
+	mfmq	8
+	ai	0,0,0		# reset carry
+	cax	9,9,7
+	blt	Lneg
+Lpos:	bdz	Lend
+Lploop:	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	10,0,6
+	mfmq	0
+	ae	8,0,9
+	bge	Lp0
+	cax	10,10,6		# adjust high limb for negative limb from s1
+Lp0:	bdz	Lend0
+	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	9,0,6
+	mfmq	0
+	ae	8,0,10
+	bge	Lp1
+	cax	9,9,6		# adjust high limb for negative limb from s1
+Lp1:	bdn	Lploop
+	b	Lend
+
+Lneg:	cax	9,9,0
+	bdz	Lend
+Lnloop:	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	10,0,6
+	cax	10,10,0		# adjust high limb for negative s2_limb
+	mfmq	0
+	ae	8,0,9
+	bge	Ln0
+	cax	10,10,6		# adjust high limb for negative limb from s1
+Ln0:	bdz	Lend0
+	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	9,0,6
+	cax	9,9,0		# adjust high limb for negative s2_limb
+	mfmq	0
+	ae	8,0,10
+	bge	Ln1
+	cax	9,9,6		# adjust high limb for negative limb from s1
+Ln1:	bdn	Lnloop
+	b	Lend
+
+Lend0:	cal	9,0(10)
+Lend:	st	8,4(3)
+	aze	3,9
+	br
diff --git a/src/gmp/mpn/power/rshift.s b/src/gmp/mpn/power/rshift.s
new file mode 100644
index 000000000..65b3945f8
--- /dev/null
+++ b/src/gmp/mpn/power/rshift.s
@@ -0,0 +1,54 @@
+# IBM POWER __gmpn_rshift -- 
+
+# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s_ptr		r4
+# size		r5
+# cnt		r6
+
+	.toc
+	.globl	__gmpn_rshift
+	.globl	.__gmpn_rshift
+	.csect	__gmpn_rshift[DS]
+__gmpn_rshift:
+	.long	.__gmpn_rshift, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.__gmpn_rshift:
+	sfi	8,6,32
+	mtctr	5		# put limb count in CTR loop register
+	l	0,0(4)		# read least significant limb
+	ai	9,3,-4		# adjust res_ptr since it's offset in the stu:s
+	sle	3,0,8		# compute carry limb, and init MQ register
+	bdz	Lend2		# if just one limb, skip loop
+	lu	0,4(4)		# read 2:nd least significant limb
+	sleq	7,0,8		# compute least significant limb of result
+	bdz	Lend		# if just two limb, skip loop
+Loop:	lu	0,4(4)		# load next higher limb
+	stu	7,4(9)		# store previous result during read latency
+	sleq	7,0,8		# compute result limb
+	bdn	Loop		# loop back until CTR is zero
+Lend:	stu	7,4(9)		# store 2:nd most significant limb
+Lend2:	sre	7,0,6		# compute most significant limb
+	st      7,4(9)		# store it"				\
+	br
diff --git a/src/gmp/mpn/power/sdiv.s b/src/gmp/mpn/power/sdiv.s
new file mode 100644
index 000000000..81da622fb
--- /dev/null
+++ b/src/gmp/mpn/power/sdiv.s
@@ -0,0 +1,34 @@
+# Copyright (C) 1999 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+	.toc
+	.globl	__sdiv_qrnnd
+	.globl	.__sdiv_qrnnd
+	.csect	__sdiv_qrnnd[DS]
+__sdiv_qrnnd:
+	.long	.__sdiv_qrnnd, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.__sdiv_qrnnd:
+	mtmq	5
+	div	0,4,6
+	mfmq	9
+	st	9,0(3)
+	mr	3,0
+	br
diff --git a/src/gmp/mpn/power/sub_n.s b/src/gmp/mpn/power/sub_n.s
new file mode 100644
index 000000000..aa09cf5bc
--- /dev/null
+++ b/src/gmp/mpn/power/sub_n.s
@@ -0,0 +1,80 @@
+# IBM POWER __gmpn_sub_n -- Subtract two limb vectors of equal, non-zero length.
+
+# Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software Foundation,
+# Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# s2_ptr	r5
+# size		r6
+
+	.toc
+	.globl	__gmpn_sub_n
+	.globl	.__gmpn_sub_n
+	.csect	__gmpn_sub_n[DS]
+__gmpn_sub_n:
+	.long	.__gmpn_sub_n, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.__gmpn_sub_n:
+	andil.	10,6,1		# odd or even number of limbs?
+	l	8,0(4)		# load least significant s1 limb
+	l	0,0(5)		# load least significant s2 limb
+	cal	3,-4(3)		# offset res_ptr, it's updated before it's used
+	sri	10,6,1		# count for unrolled loop
+	sf	7,0,8		# subtract least significant limbs, set cy
+	mtctr	10		# copy count into CTR
+	beq	0,Leven		# branch if even # of limbs (# of limbs >= 2)
+
+# We have an odd # of limbs.  Add the first limbs separately.
+	cmpi	1,10,0		# is count for unrolled loop zero?
+	bc	4,6,L1		# bne cr1,L1 (misassembled by gas)
+	st	7,4(3)
+	sfe	3,0,0		# load !cy into ...
+	sfi	3,3,0		# ... return value register
+	br			# return
+
+# We added least significant limbs.  Now reload the next limbs to enter loop.
+L1:	lu	8,4(4)		# load s1 limb and update s1_ptr
+	lu	0,4(5)		# load s2 limb and update s2_ptr
+	stu	7,4(3)
+	sfe	7,0,8		# subtract limbs, set cy
+Leven:	lu	9,4(4)		# load s1 limb and update s1_ptr
+	lu	10,4(5)		# load s2 limb and update s2_ptr
+	bdz	Lend		# If done, skip loop
+
+Loop:	lu	8,4(4)		# load s1 limb and update s1_ptr
+	lu	0,4(5)		# load s2 limb and update s2_ptr
+	sfe	11,10,9		# subtract previous limbs with cy, set cy
+	stu	7,4(3)		# 
+	lu	9,4(4)		# load s1 limb and update s1_ptr
+	lu	10,4(5)		# load s2 limb and update s2_ptr
+	sfe	7,0,8		# subtract previous limbs with cy, set cy
+	stu	11,4(3)		# 
+	bdn	Loop		# decrement CTR and loop back
+
+Lend:	sfe	11,10,9		# subtract limbs with cy, set cy
+	st	7,4(3)		# 
+	st	11,8(3)		# 
+	sfe	3,0,0		# load !cy into ...
+	sfi	3,3,0		# ... return value register
+	br
diff --git a/src/gmp/mpn/power/submul_1.s b/src/gmp/mpn/power/submul_1.s
new file mode 100644
index 000000000..bc01b7c95
--- /dev/null
+++ b/src/gmp/mpn/power/submul_1.s
@@ -0,0 +1,127 @@
+# IBM POWER __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
+# the result from a second limb vector.
+
+# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# size		r5
+# s2_limb	r6
+
+# The POWER architecture has no unsigned 32x32->64 bit multiplication
+# instruction.  To obtain that operation, we have to use the 32x32->64 signed
+# multiplication instruction, and add the appropriate compensation to the high
+# limb of the result.  We add the multiplicand if the multiplier has its most
+# significant bit set, and we add the multiplier if the multiplicand has its
+# most significant bit set.  We need to preserve the carry flag between each
+# iteration, so we have to compute the compensation carefully (the natural,
+# srai+and doesn't work).  Since the POWER architecture has a branch unit we
+# can branch in zero cycles, so that's how we perform the additions.
+
+	.toc
+	.globl	__gmpn_submul_1
+	.globl	.__gmpn_submul_1
+	.csect	__gmpn_submul_1[DS]
+__gmpn_submul_1:
+	.long	.__gmpn_submul_1, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.__gmpn_submul_1:
+
+	cal	3,-4(3)
+	l	0,0(4)
+	cmpi	0,6,0
+	mtctr	5
+	mul	9,0,6
+	srai	7,0,31
+	and	7,7,6
+	mfmq	11
+	cax	9,9,7
+	l	7,4(3)
+	sf	8,11,7		# add res_limb
+	a	11,8,11		# invert cy (r11 is junk)
+	blt	Lneg
+Lpos:	bdz	Lend
+
+Lploop:	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	10,0,6
+	mfmq	0
+	ae	11,0,9		# low limb + old_cy_limb + old cy
+	l	7,4(3)
+	aze	10,10		# propagate cy to new cy_limb
+	sf	8,11,7		# add res_limb
+	a	11,8,11		# invert cy (r11 is junk)
+	bge	Lp0
+	cax	10,10,6		# adjust high limb for negative limb from s1
+Lp0:	bdz	Lend0
+	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	9,0,6
+	mfmq	0
+	ae	11,0,10
+	l	7,4(3)
+	aze	9,9
+	sf	8,11,7
+	a	11,8,11		# invert cy (r11 is junk)
+	bge	Lp1
+	cax	9,9,6		# adjust high limb for negative limb from s1
+Lp1:	bdn	Lploop
+
+	b	Lend
+
+Lneg:	cax	9,9,0
+	bdz	Lend
+Lnloop:	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	10,0,6
+	mfmq	7
+	ae	11,7,9
+	l	7,4(3)
+	ae	10,10,0		# propagate cy to new cy_limb
+	sf	8,11,7		# add res_limb
+	a	11,8,11		# invert cy (r11 is junk)
+	bge	Ln0
+	cax	10,10,6		# adjust high limb for negative limb from s1
+Ln0:	bdz	Lend0
+	lu	0,4(4)
+	stu	8,4(3)
+	cmpi	0,0,0
+	mul	9,0,6
+	mfmq	7
+	ae	11,7,10
+	l	7,4(3)
+	ae	9,9,0		# propagate cy to new cy_limb
+	sf	8,11,7		# add res_limb
+	a	11,8,11		# invert cy (r11 is junk)
+	bge	Ln1
+	cax	9,9,6		# adjust high limb for negative limb from s1
+Ln1:	bdn	Lnloop
+	b	Lend
+
+Lend0:	cal	9,0(10)
+Lend:	st	8,4(3)
+	aze	3,9
+	br
diff --git a/src/gmp/mpn/power/umul.s b/src/gmp/mpn/power/umul.s
new file mode 100644
index 000000000..8c7749638
--- /dev/null
+++ b/src/gmp/mpn/power/umul.s
@@ -0,0 +1,38 @@
+# Copyright (C) 1999 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+	.toc
+	.globl	__umul_ppmm
+	.globl	.__umul_ppmm
+	.csect	__umul_ppmm[DS]
+__umul_ppmm:
+	.long	.__umul_ppmm, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.__umul_ppmm:
+	mul	9,4,5
+	srai	0,4,31
+	and	0,0,5
+	srai	5,5,31
+	and	5,5,4
+	cax	0,0,5
+	mfmq	11
+	st	11,0(3)
+	cax	3,9,0
+	br
diff --git a/src/gmp/mpn/powerpc32/add_n.asm b/src/gmp/mpn/powerpc32/add_n.asm
new file mode 100644
index 000000000..81ed04b16
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/add_n.asm
@@ -0,0 +1,61 @@
+dnl PowerPC-32 mpn_add_n -- Add two limb vectors of the same length > 0 and
+dnl store sum in a third limb vector.
+
+dnl Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
+
+dnl This file is part of the GNU MP Library.
+
+dnl The GNU MP Library is free software; you can redistribute it and/or modify
+dnl it under the terms of the GNU Lesser General Public License as published by
+dnl the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl option) any later version.
+
+dnl The GNU MP Library is distributed in the hope that it will be useful, but
+dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl License for more details.
+
+dnl You should have received a copy of the GNU Lesser General Public License
+dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl MA 02111-1307, USA.
+
+
+dnl INPUT PARAMETERS
+dnl res_ptr	r3
+dnl s1_ptr	r4
+dnl s2_ptr	r5
+dnl size	r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_add_n)
+	mtctr	r6		C copy size into CTR
+	addic	r0,r0,0		C clear cy
+	lwz	r8,0(r4)	C load least significant s1 limb
+	lwz	r0,0(r5)	C load least significant s2 limb
+	addi	r3,r3,-4	C offset res_ptr, it's updated before it's used
+	bdz	.Lend		C If done, skip loop
+.Loop:	lwz	r9,4(r4)	C load s1 limb
+	lwz	r10,4(r5)	C load s2 limb
+	adde	r7,r0,r8	C add limbs with cy, set cy
+	stw	r7,4(r3)	C store result limb
+	bdz	.Lexit		C decrement CTR and exit if done
+	lwzu	r8,8(r4)	C load s1 limb and update s1_ptr
+	lwzu	r0,8(r5)	C load s2 limb and update s2_ptr
+	adde	r7,r10,r9	C add limbs with cy, set cy
+	stwu	r7,8(r3)	C store result limb and update res_ptr
+	bdnz	.Loop		C decrement CTR and loop back
+
+.Lend:	adde	r7,r0,r8
+	stw	r7,4(r3)	C store ultimate result limb
+	li	r3,0		C load cy into ...
+	addze	r3,r3		C ... return value register
+	blr
+.Lexit:	adde	r7,r10,r9
+	stw	r7,8(r3)
+	li	r3,0		C load cy into ...
+	addze	r3,r3		C ... return value register
+	blr
+EPILOGUE(mpn_add_n)
diff --git a/src/gmp/mpn/powerpc32/addmul_1.asm b/src/gmp/mpn/powerpc32/addmul_1.asm
new file mode 100644
index 000000000..3ef75b153
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/addmul_1.asm
@@ -0,0 +1,124 @@
+dnl PowerPC-32 mpn_addmul_1 -- Multiply a limb vector with a limb and add
+dnl the result to a second limb vector.
+
+dnl Copyright (C) 1995, 1997, 1998, 2000 Free Software Foundation, Inc.
+
+dnl This file is part of the GNU MP Library.
+
+dnl The GNU MP Library is free software; you can redistribute it and/or modify
+dnl it under the terms of the GNU Lesser General Public License as published by
+dnl the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl option) any later version.
+
+dnl The GNU MP Library is distributed in the hope that it will be useful, but
+dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl License for more details.
+
+dnl You should have received a copy of the GNU Lesser General Public License
+dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl MA 02111-1307, USA.
+
+
+dnl INPUT PARAMETERS
+dnl res_ptr	r3
+dnl s1_ptr	r4
+dnl size	r5
+dnl s2_limb	r6
+
+dnl This is optimized for the PPC604.  It has not been tested on PPC601, PPC603
+dnl or PPC750 since I don't have access to any such machines.
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_addmul_1)
+	cmpi	cr0,r5,9	C more than 9 limbs?
+	bgt	cr0,.Lbig	C branch if more than 9 limbs
+
+	mtctr	r5
+	lwz	r0,0(r4)
+	mullw	r7,r0,r6
+	mulhwu	r10,r0,r6
+	lwz	r9,0(r3)
+	addc	r8,r7,r9
+	addi	r3,r3,-4
+	bdz	.Lend
+.Lloop:
+	lwzu	r0,4(r4)
+	stwu	r8,4(r3)
+	mullw	r8,r0,r6
+	adde	r7,r8,r10
+	mulhwu	r10,r0,r6
+	lwz	r9,4(r3)
+	addze	r10,r10
+	addc	r8,r7,r9
+	bdnz	.Lloop
+.Lend:	stw	r8,4(r3)
+	addze	r3,r10
+	blr
+
+.Lbig:	stmw	r30,-32(r1)
+	addi	r5,r5,-1
+	srwi	r0,r5,2
+	mtctr	r0
+
+	lwz	r7,0(r4)
+	mullw	r8,r7,r6
+	mulhwu	r0,r7,r6
+	lwz	r7,0(r3)
+	addc	r8,r8,r7
+	stw	r8,0(r3)
+
+.LloopU:
+	lwz	r7,4(r4)
+	lwz	r12,8(r4)
+	lwz	r30,12(r4)
+	lwzu	r31,16(r4)
+	mullw	r8,r7,r6
+	mullw	r9,r12,r6
+	mullw	r10,r30,r6
+	mullw	r11,r31,r6
+	adde	r8,r8,r0	C add cy_limb
+	mulhwu	r0,r7,r6
+	lwz	r7,4(r3)
+	adde	r9,r9,r0
+	mulhwu	r0,r12,r6
+	lwz	r12,8(r3)
+	adde	r10,r10,r0
+	mulhwu	r0,r30,r6
+	lwz	r30,12(r3)
+	adde	r11,r11,r0
+	mulhwu	r0,r31,r6
+	lwz	r31,16(r3)
+	addze	r0,r0		C new cy_limb
+	addc	r8,r8,r7
+	stw	r8,4(r3)
+	adde	r9,r9,r12
+	stw	r9,8(r3)
+	adde	r10,r10,r30
+	stw	r10,12(r3)
+	adde	r11,r11,r31
+	stwu	r11,16(r3)
+	bdnz	.LloopU
+
+	andi.	r31,r5,3
+	mtctr	r31
+	beq	cr0,.Lendx
+
+.LloopE:
+	lwzu	r7,4(r4)
+	mullw	r8,r7,r6
+	adde	r8,r8,r0	C add cy_limb
+	mulhwu	r0,r7,r6
+	lwz	r7,4(r3)
+	addze	r0,r0		C new cy_limb
+	addc	r8,r8,r7
+	stwu	r8,4(r3)
+	bdnz	.LloopE
+.Lendx:
+	addze	r3,r0
+	lmw	r30,-32(r1)
+	blr
+EPILOGUE(mpn_addmul_1)
diff --git a/src/gmp/mpn/powerpc32/aix.m4 b/src/gmp/mpn/powerpc32/aix.m4
new file mode 100644
index 000000000..2bd842581
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/aix.m4
@@ -0,0 +1,39 @@
+divert(-1)
+dnl  m4 macros for AIX 32-bit assembly.
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+define(`ASM_START',
+	`.toc')
+	
+define(`PROLOGUE',
+	`
+	.globl	$1
+	.globl	.$1
+	.csect	$1[DS],2
+$1:
+	.long	.$1, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.$1:')
+
+define(`EPILOGUE', `')
+
+divert
diff --git a/src/gmp/mpn/powerpc32/gmp-mparam.h b/src/gmp/mpn/powerpc32/gmp-mparam.h
new file mode 100644
index 000000000..b28318578
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/gmp-mparam.h
@@ -0,0 +1,66 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+/* These values are for the 604.  Presumably, these should be considerably
+   different for the 603 and 750 that have much slower multiply
+   instructions.  */
+
+/* Generated by tuneup.c, 2000-05-26. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   26	/* tuneup says 20 */
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD      228
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   46	/* tuneup says 44 */
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD      262
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              52
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD             86
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            23
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        7
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD          53
+#endif
diff --git a/src/gmp/mpn/powerpc32/lshift.asm b/src/gmp/mpn/powerpc32/lshift.asm
new file mode 100644
index 000000000..73a85430a
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/lshift.asm
@@ -0,0 +1,145 @@
+dnl  PowerPC-32 mpn_lshift -- Shift a number left.
+
+dnl Copyright (C) 1995, 1998, 2000 Free Software Foundation, Inc.
+
+dnl This file is part of the GNU MP Library.
+
+dnl The GNU MP Library is free software; you can redistribute it and/or modify
+dnl it under the terms of the GNU Lesser General Public License as published by
+dnl the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl option) any later version.
+
+dnl The GNU MP Library is distributed in the hope that it will be useful, but
+dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl License for more details.
+
+dnl You should have received a copy of the GNU Lesser General Public License
+dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl MA 02111-1307, USA.
+
+
+dnl INPUT PARAMETERS
+dnl res_ptr	r3
+dnl s1_ptr	r4
+dnl size	r5
+dnl cnt		r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_lshift)
+	cmpi	cr0,r5,12	C more than 12 limbs?
+	slwi	r0,r5,2
+	add	r4,r4,r0	C make r4 point at end of s1
+	add	r7,r3,r0	C make r7 point at end of res
+	bgt	.LBIG		C branch if more than 12 limbs
+
+	mtctr	r5		C copy size into CTR
+	subfic	r8,r6,32
+	lwzu	r11,-4(r4)	C load first s1 limb
+	srw	r3,r11,r8	C compute function return value
+	bdz	.Lend1
+
+.Loop:	lwzu	r10,-4(r4)
+	slw	r9,r11,r6
+	srw	r12,r10,r8
+	or	r9,r9,r12
+	stwu	r9,-4(r7)
+	bdz	.Lend2
+	lwzu	r11,-4(r4)
+	slw	r9,r10,r6
+	srw	r12,r11,r8
+	or	r9,r9,r12
+	stwu	r9,-4(r7)
+	bdnz	.Loop
+
+.Lend1:	slw	r0,r11,r6
+	stw	r0,-4(r7)
+	blr
+.Lend2:	slw	r0,r10,r6
+	stw	r0,-4(r7)
+	blr
+
+.LBIG:
+	stmw	r24,-32(r1)	C save registers we are supposed to preserve
+	lwzu	r9,-4(r4)
+	subfic	r8,r6,32
+	srw	r3,r9,r8	C compute function return value
+	slw	r0,r9,r6
+	addi	r5,r5,-1
+
+	andi.	r10,r5,3	C count for spill loop
+	beq	.Le
+	mtctr	r10
+	lwzu	r28,-4(r4)
+	bdz	.Lxe0
+
+.Loop0:	slw	r12,r28,r6
+	srw	r24,r28,r8
+	lwzu	r28,-4(r4)
+	or	r24,r0,r24
+	stwu	r24,-4(r7)
+	mr	r0,r12
+	bdnz	.Loop0		C taken at most once!
+
+.Lxe0:	slw	r12,r28,r6
+	srw	r24,r28,r8
+	or	r24,r0,r24
+	stwu	r24,-4(r7)
+	mr	r0,r12
+
+.Le:	srwi	r5,r5,2		C count for unrolled loop
+	addi	r5,r5,-1
+	mtctr	r5
+	lwz	r28,-4(r4)
+	lwz	r29,-8(r4)
+	lwz	r30,-12(r4)
+	lwzu	r31,-16(r4)
+
+.LoopU:	slw	r9,r28,r6
+	srw	r24,r28,r8
+	lwz	r28,-4(r4)
+	slw	r10,r29,r6
+	srw	r25,r29,r8
+	lwz	r29,-8(r4)
+	slw	r11,r30,r6
+	srw	r26,r30,r8
+	lwz	r30,-12(r4)
+	slw	r12,r31,r6
+	srw	r27,r31,r8
+	lwzu	r31,-16(r4)
+	or	r24,r0,r24
+	stw	r24,-4(r7)
+	or	r25,r9,r25
+	stw	r25,-8(r7)
+	or	r26,r10,r26
+	stw	r26,-12(r7)
+	or	r27,r11,r27
+	stwu	r27,-16(r7)
+	mr	r0,r12
+	bdnz	.LoopU
+
+	slw	r9,r28,r6
+	srw	r24,r28,r8
+	slw	r10,r29,r6
+	srw	r25,r29,r8
+	slw	r11,r30,r6
+	srw	r26,r30,r8
+	slw	r12,r31,r6
+	srw	r27,r31,r8
+	or	r24,r0,r24
+	stw	r24,-4(r7)
+	or	r25,r9,r25
+	stw	r25,-8(r7)
+	or	r26,r10,r26
+	stw	r26,-12(r7)
+	or	r27,r11,r27
+	stwu	r27,-16(r7)
+	mr	r0,r12
+
+	stw	r0,-4(r7)
+	lmw	r24,-32(r1)	C restore registers
+	blr
+EPILOGUE(mpn_lshift)
diff --git a/src/gmp/mpn/powerpc32/mul_1.asm b/src/gmp/mpn/powerpc32/mul_1.asm
new file mode 100644
index 000000000..ec878b54d
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/mul_1.asm
@@ -0,0 +1,86 @@
+dnl PowerPC-32 mpn_mul_1 -- Multiply a limb vector with a limb and store
+dnl the result in a second limb vector.
+
+dnl Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
+
+dnl This file is part of the GNU MP Library.
+
+dnl The GNU MP Library is free software; you can redistribute it and/or modify
+dnl it under the terms of the GNU Lesser General Public License as published by
+dnl the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl option) any later version.
+
+dnl The GNU MP Library is distributed in the hope that it will be useful, but
+dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl License for more details.
+
+dnl You should have received a copy of the GNU Lesser General Public License
+dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl MA 02111-1307, USA.
+
+
+dnl INPUT PARAMETERS
+dnl res_ptr	r3
+dnl s1_ptr	r4
+dnl size	r5
+dnl s2_limb	r6
+
+dnl This is optimized for the PPC604 but it runs decently even on PPC601.  It
+dnl has not been tested on a PPC603 since I don't have access to any such
+dnl machines.
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_mul_1)
+	mtctr	r5
+	addi	r3,r3,-4	C adjust res_ptr, it's offset before it's used
+	li	r12,0		C clear upper product reg
+	addic	r0,r0,0		C clear cy
+C Start software pipeline
+	lwz	r8,0(r4)
+	bdz	.Lend3
+	stmw	r30,-8(r1)	C save registers we are supposed to preserve
+	lwzu	r9,4(r4)
+	mullw	r11,r8,r6
+	mulhwu	r0,r8,r6
+	bdz	.Lend1
+C Software pipelined main loop
+.Loop:	lwz	r8,4(r4)
+	mullw	r10,r9,r6
+	adde	r30,r11,r12
+	mulhwu	r12,r9,r6
+	stw	r30,4(r3)
+	bdz	.Lend2
+	lwzu	r9,8(r4)
+	mullw	r11,r8,r6
+	adde	r31,r10,r0
+	mulhwu	r0,r8,r6
+	stwu	r31,8(r3)
+	bdnz	.Loop
+C Finish software pipeline
+.Lend1:	mullw	r10,r9,r6
+	adde	r30,r11,r12
+	mulhwu	r12,r9,r6
+	stw	r30,4(r3)
+	adde	r31,r10,r0
+	stwu	r31,8(r3)
+	addze	r3,r12
+	lmw	r30,-8(r1)	C restore registers from stack
+	blr
+.Lend2:	mullw	r11,r8,r6
+	adde	r31,r10,r0
+	mulhwu	r0,r8,r6
+	stwu	r31,8(r3)
+	adde	r30,r11,r12
+	stw	r30,4(r3)
+	addze	r3,r0
+	lmw	r30,-8(r1)	C restore registers from stack
+	blr
+.Lend3:	mullw	r11,r8,r6
+	stw	r11,4(r3)
+	mulhwu	r3,r8,r6
+	blr
+EPILOGUE(mpn_mul_1)
diff --git a/src/gmp/mpn/powerpc32/regmap.m4 b/src/gmp/mpn/powerpc32/regmap.m4
new file mode 100644
index 000000000..978f18902
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/regmap.m4
@@ -0,0 +1,34 @@
+divert(-1)
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+dnl Map register names r0, r1, etc, to just `0', `1', etc.
+dnl This is needed on all systems but NeXT, Rhapsody, and MacOS-X
+forloop(i,0,31,
+`define(`r'i,i)'
+)
+
+dnl Likewise for cr0, cr1, etc.
+forloop(i,0,7,
+`define(`cr'i,i)'
+)
+
+divert
diff --git a/src/gmp/mpn/powerpc32/rshift.asm b/src/gmp/mpn/powerpc32/rshift.asm
new file mode 100644
index 000000000..a09ba0493
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/rshift.asm
@@ -0,0 +1,60 @@
+dnl PowerPC-32 mpn_rshift -- Shift a number right.
+
+dnl Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+dnl This file is part of the GNU MP Library.
+
+dnl The GNU MP Library is free software; you can redistribute it and/or modify
+dnl it under the terms of the GNU Lesser General Public License as published by
+dnl the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl option) any later version.
+
+dnl The GNU MP Library is distributed in the hope that it will be useful, but
+dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl License for more details.
+
+dnl You should have received a copy of the GNU Lesser General Public License
+dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl MA 02111-1307, USA.
+
+
+dnl INPUT PARAMETERS
+dnl res_ptr	r3
+dnl s1_ptr	r4
+dnl size	r5
+dnl cnt		r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_rshift)
+	mtctr	r5		C copy size into CTR
+	addi	r7,r3,-4	C move adjusted res_ptr to free return reg
+	subfic	r8,r6,32
+	lwz	r11,0(r4)	C load first s1 limb
+	slw	r3,r11,r8	C compute function return value
+	bdz	.Lend1
+
+.Loop:	lwzu	r10,4(r4)
+	srw	r9,r11,r6
+	slw	r12,r10,r8
+	or	r9,r9,r12
+	stwu	r9,4(r7)
+	bdz	.Lend2
+	lwzu	r11,4(r4)
+	srw	r9,r10,r6
+	slw	r12,r11,r8
+	or	r9,r9,r12
+	stwu	r9,4(r7)
+	bdnz	.Loop
+
+.Lend1:	srw	r0,r11,r6
+	stw	r0,4(r7)
+	blr
+
+.Lend2:	srw	r0,r10,r6
+	stw	r0,4(r7)
+	blr
+EPILOGUE(mpn_rshift)
diff --git a/src/gmp/mpn/powerpc32/sub_n.asm b/src/gmp/mpn/powerpc32/sub_n.asm
new file mode 100644
index 000000000..b04b4192e
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/sub_n.asm
@@ -0,0 +1,61 @@
+dnl PowerPC-32 mpn_sub_n -- Subtract two limb vectors of the same length > 0
+dnl and store difference in a third limb vector.
+
+dnl Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
+
+dnl This file is part of the GNU MP Library.
+
+dnl The GNU MP Library is free software; you can redistribute it and/or modify
+dnl it under the terms of the GNU Lesser General Public License as published by
+dnl the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl option) any later version.
+
+dnl The GNU MP Library is distributed in the hope that it will be useful, but
+dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl License for more details.
+
+dnl You should have received a copy of the GNU Lesser General Public License
+dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl MA 02111-1307, USA.
+
+
+dnl INPUT PARAMETERS
+dnl res_ptr	r3
+dnl s1_ptr	r4
+dnl s2_ptr	r5
+dnl size	r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_sub_n)
+	mtctr	r6		C copy size into CTR
+	addic	r0,r6,-1	C set cy
+	lwz	r8,0(r4)	C load least significant s1 limb
+	lwz	r0,0(r5)	C load least significant s2 limb
+	addi	r3,r3,-4	C offset res_ptr, it's updated before it's used
+	bdz	.Lend		C If done, skip loop
+.Loop:	lwz	r9,4(r4)	C load s1 limb
+	lwz	r10,4(r5)	C load s2 limb
+	subfe	r7,r0,r8	C subtract limbs with cy, set cy
+	stw	r7,4(r3)	C store result limb
+	bdz	.Lexit		C decrement CTR and exit if done
+	lwzu	r8,8(r4)	C load s1 limb and update s1_ptr
+	lwzu	r0,8(r5)	C load s2 limb and update s2_ptr
+	subfe	r7,r10,r9	C subtract limbs with cy, set cy
+	stwu	r7,8(r3)	C store result limb and update res_ptr
+	bdnz	.Loop		C decrement CTR and loop back
+
+.Lend:	subfe	r7,r0,r8
+	stw	r7,4(r3)	C store ultimate result limb
+	subfe	r3,r0,r0	C load !cy into ...
+	subfic	r3,r3,0		C ... return value register
+	blr
+.Lexit:	subfe	r7,r10,r9
+	stw	r7,8(r3)
+	subfe	r3,r0,r0	C load !cy into ...
+	subfic	r3,r3,0		C ... return value register
+	blr
+EPILOGUE(mpn_sub_n)
diff --git a/src/gmp/mpn/powerpc32/submul_1.asm b/src/gmp/mpn/powerpc32/submul_1.asm
new file mode 100644
index 000000000..a129e9f9e
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/submul_1.asm
@@ -0,0 +1,130 @@
+dnl PowerPC-32 mpn_submul_1 -- Multiply a limb vector with a limb and subtract
+dnl the result from a second limb vector.
+
+dnl Copyright (C) 1995, 1997, 1998, 2000 Free Software Foundation, Inc.
+
+dnl This file is part of the GNU MP Library.
+
+dnl The GNU MP Library is free software; you can redistribute it and/or modify
+dnl it under the terms of the GNU Lesser General Public License as published by
+dnl the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl option) any later version.
+
+dnl The GNU MP Library is distributed in the hope that it will be useful, but
+dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl License for more details.
+
+dnl You should have received a copy of the GNU Lesser General Public License
+dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl MA 02111-1307, USA.
+
+
+dnl INPUT PARAMETERS
+dnl res_ptr	r3
+dnl s1_ptr	r4
+dnl size	r5
+dnl s2_limb	r6
+
+dnl This is optimized for the PPC604.  It has not been tested on PPC601, PPC603
+dnl or PPC750 since I don't have access to any such machines.
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_submul_1)
+	cmpi	cr0,r5,9	C more than 9 limbs?
+	bgt	cr0,.Lbig	C branch if more than 9 limbs
+
+	mtctr	r5
+	lwz	r0,0(r4)
+	mullw	r7,r0,r6
+	mulhwu	r10,r0,r6
+	lwz	r9,0(r3)
+	subfc	r8,r7,r9
+	addc	r7,r7,r8	C invert cy (r7 is junk)
+	addi	r3,r3,-4
+	bdz	.Lend
+.Lloop:
+	lwzu	r0,4(r4)
+	stwu	r8,4(r3)
+	mullw	r8,r0,r6
+	adde	r7,r8,r10
+	mulhwu	r10,r0,r6
+	lwz	r9,4(r3)
+	addze	r10,r10
+	subfc	r8,r7,r9
+	addc	r7,r7,r8	C invert cy (r7 is junk)
+	bdnz	.Lloop
+.Lend:	stw	r8,4(r3)
+	addze	r3,r10
+	blr
+
+.Lbig:	stmw	r30,-32(r1)
+	addi	r5,r5,-1
+	srwi	r0,r5,2
+	mtctr	r0
+
+	lwz	r7,0(r4)
+	mullw	r8,r7,r6
+	mulhwu	r0,r7,r6
+	lwz	r7,0(r3)
+	subfc	r7,r8,r7
+	addc	r8,r8,r7
+	stw	r7,0(r3)
+
+.LloopU:
+	lwz	r7,4(r4)
+	lwz	r12,8(r4)
+	lwz	r30,12(r4)
+	lwzu	r31,16(r4)
+	mullw	r8,r7,r6
+	mullw	r9,r12,r6
+	mullw	r10,r30,r6
+	mullw	r11,r31,r6
+	adde	r8,r8,r0	C add cy_limb
+	mulhwu	r0,r7,r6
+	lwz	r7,4(r3)
+	adde	r9,r9,r0
+	mulhwu	r0,r12,r6
+	lwz	r12,8(r3)
+	adde	r10,r10,r0
+	mulhwu	r0,r30,r6
+	lwz	r30,12(r3)
+	adde	r11,r11,r0
+	mulhwu	r0,r31,r6
+	lwz	r31,16(r3)
+	addze	r0,r0		C new cy_limb
+	subfc	r7,r8,r7
+	stw	r7,4(r3)
+	subfe	r12,r9,r12
+	stw	r12,8(r3)
+	subfe	r30,r10,r30
+	stw	r30,12(r3)
+	subfe	r31,r11,r31
+	stwu	r31,16(r3)
+	subfe	r11,r11,r11	C invert ...
+	addic	r11,r11,1	C ... carry
+	bdnz	.LloopU
+
+	andi.	r31,r5,3
+	mtctr	r31
+	beq	cr0,.Lendx
+
+.LloopE:
+	lwzu	r7,4(r4)
+	mullw	r8,r7,r6
+	adde	r8,r8,r0	C add cy_limb
+	mulhwu	r0,r7,r6
+	lwz	r7,4(r3)
+	addze	r0,r0		C new cy_limb
+	subfc	r7,r8,r7
+	addc	r8,r8,r7
+	stwu	r7,4(r3)
+	bdnz	.LloopE
+.Lendx:
+	addze	r3,r0
+	lmw	r30,-32(r1)
+	blr
+EPILOGUE(mpn_submul_1)
diff --git a/src/gmp/mpn/powerpc32/umul.asm b/src/gmp/mpn/powerpc32/umul.asm
new file mode 100644
index 000000000..eeaa0a4dc
--- /dev/null
+++ b/src/gmp/mpn/powerpc32/umul.asm
@@ -0,0 +1,32 @@
+dnl PowerPC-32 umul_ppmm -- support for longlong.h
+
+dnl Copyright (C) 2000 Free Software Foundation, Inc.
+
+dnl This file is part of the GNU MP Library.
+
+dnl The GNU MP Library is free software; you can redistribute it and/or modify
+dnl it under the terms of the GNU Lesser General Public License as published by
+dnl the Free Software Foundation; either version 2.1 of the License, or (at your
+dnl option) any later version.
+
+dnl The GNU MP Library is distributed in the hope that it will be useful, but
+dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl License for more details.
+
+dnl You should have received a copy of the GNU Lesser General Public License
+dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_umul_ppmm)
+	mullw	0,4,5
+	mulhwu	9,4,5
+	stw	0,0(3)
+	mr	3,9
+	blr
+EPILOGUE(mpn_umul_ppmm)
diff --git a/src/gmp/mpn/powerpc64/README b/src/gmp/mpn/powerpc64/README
new file mode 100644
index 000000000..c77927691
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/README
@@ -0,0 +1,36 @@
+PPC630 (aka Power3) pipeline information:
+
+Decoding is 4-way and issue is 8-way with some out-of-order capability.
+LS1  - ld/st unit 1
+LS2  - ld/st unit 2
+FXU1 - integer unit 1, handles any simple integer instructions
+FXU2 - integer unit 2, handles any simple integer instructions
+FXU3 - integer unit 3, handles integer multiply and divide
+FPU1 - floating-point unit 1
+FPU2 - floating-point unit 2
+
+Memory:		  Any two memory operations can issue, but memory subsystem
+		  can sustain just one store per cycle.
+Simple integer:	  2 operations (such as add, rl*)
+Integer multiply: 1 operation every 9th cycle worst case; exact timing depends
+		  on 2nd operand most significant bit position (10 bits per
+		  cycle).  Multiply unit is not pipelined, only one multiply
+		  operation in progress is allowed.
+Integer divide:	  ?
+Floating-point:	  Any plain 2 arithmetic instructions (such as fmul, fadd, fmadd)
+		  Latency = 4.
+Floating-point divide:
+		  ?
+Floating-point square root:
+		  ?
+
+Best possible times for the main loops:
+shift:	      1.5 cycles limited by integer unit contention.
+	      With 63 special loops, one for each shift count, we could
+	      reduce the needed integer instructions to 2, which would
+	      reduce the best possible time to 1 cycle.
+add/sub:      1.5 cycles, limited by ld/st unit contention.
+mul:	      18 cycles (average) unless floating-point operations are used,
+	      but that would only help for multiplies of perhaps 10 and more
+	      limbs.
+addmul/submul:Same situation as for mul.
diff --git a/src/gmp/mpn/powerpc64/add_n.asm b/src/gmp/mpn/powerpc64/add_n.asm
new file mode 100644
index 000000000..c3325376d
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/add_n.asm
@@ -0,0 +1,61 @@
+# PowerPC-64 mpn_add_n -- Add two limb vectors of the same length > 0 and
+# store sum in a third limb vector.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# s2_ptr	r5
+# size		r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_add_n)
+	mtctr	r6		# copy size into CTR
+	addic	r0,r0,0		# clear cy
+	ld	r8,0(r4)	# load least significant s1 limb
+	ld	r0,0(r5)	# load least significant s2 limb
+	addi	r3,r3,-8	# offset res_ptr, it's updated before it's used
+	bdz	.Lend		# If done, skip loop
+.Loop:	ld	r9,8(r4)	# load s1 limb
+	ld	r10,8(r5)	# load s2 limb
+	adde	r7,r0,r8	# add limbs with cy, set cy
+	std	r7,8(r3)	# store result limb
+	bdz	.Lexit		# decrement CTR and exit if done
+	ldu	r8,16(r4)	# load s1 limb and update s1_ptr
+	ldu	r0,16(r5)	# load s2 limb and update s2_ptr
+	adde	r7,r10,r9	# add limbs with cy, set cy
+	stdu	r7,16(r3)	# store result limb and update res_ptr
+	bdnz	.Loop		# decrement CTR and loop back
+
+.Lend:	adde	r7,r0,r8
+	std	r7,8(r3)	# store ultimate result limb
+	li	r3,0		# load cy into ...
+	addze	r3,r3		# ... return value register
+	blr
+.Lexit:	adde	r7,r10,r9
+	std	r7,16(r3)
+	li	r3,0		# load cy into ...
+	addze	r3,r3		# ... return value register
+	blr
+EPILOGUE(mpn_add_n)
diff --git a/src/gmp/mpn/powerpc64/addmul_1.asm b/src/gmp/mpn/powerpc64/addmul_1.asm
new file mode 100644
index 000000000..81774482f
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/addmul_1.asm
@@ -0,0 +1,52 @@
+# PowerPC-64 mpn_addmul_1 -- Multiply a limb vector with a limb and add
+# the result to a second limb vector.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# size		r5
+# s2_limb	r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_addmul_1)
+	mtctr	5
+	li	9,0		# cy_limb = 0
+	addic	0,0,0
+	cal	3,-8(3)
+	cal	4,-8(4)
+.Loop:
+	ldu	0,8(4)
+	ld	10,8(3)
+	mulld	7,0,6
+	adde	7,7,9
+	mulhdu	9,0,6
+	addze	9,9
+	addc	7,7,10
+	stdu	7,8(3)
+	bdnz	.Loop
+
+	addze	3,9
+	blr
+EPILOGUE(mpn_addmul_1)
diff --git a/src/gmp/mpn/powerpc64/addsub_n.asm b/src/gmp/mpn/powerpc64/addsub_n.asm
new file mode 100644
index 000000000..4ed40d71a
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/addsub_n.asm
@@ -0,0 +1,107 @@
+# PowerPC-64 mpn_addsub_n -- Simultaneous add and sub.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# s2_ptr	r5
+# size		r6
+
+include(`asm-syntax.m4')
+
+define(SAVE_BORROW_RESTORE_CARRY,
+	`sldi $1,$1,63
+	adde $1,$1,$1')
+define(SAVE_CARRY_RESTORE_BORROW,
+	`sldi $1,$1,63
+	adde $1,$1,$1')
+
+# 19991117
+
+# This is just crafted for testing some ideas, and verifying that we can make
+# it run fast.  It runs at 2.55 cycles/limb on the 630, which is very good.
+# We should play a little with the schedule.  No time has been spent on that.
+
+# To finish this, the loop warm up and cool down code needs to be written,
+# and the result need to be tested.  Also, the proper calling sequence should
+# be used.
+
+#             r1p r2p s1p s2p n
+# Use reg r0, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12
+
+ASM_START()
+PROLOGUE(mpn_addsub_n)
+	std	r14,-64(1)
+	std	r15,-56(1)
+	std	r16,-48(1)
+	std	r17,-40(1)
+	std	r18,-32(1)
+	std	r19,-24(1)
+
+	srdi	r7,r7,2
+	mtctr	r7		# copy size into CTR
+	addic	r0,r0,0		# clear cy
+	addi	r3,r3,-8	# offset res_ptr, it's updated before it's used
+	addi	r4,r4,-8	# offset res_ptr, it's updated before it's used
+
+.Loop:
+	adde	r12,r8,r9
+	std	r12,8(r3)
+	adde	r12,r10,r11
+	std	r12,16(r3)
+
+	SAVE_CARRY_RESTORE_BORROW(r0)
+
+	subfe	r12,r8,r9
+	std	r12,8(r4)
+	ld	r8,8(r5)	# s1 L 1
+	ld	r9,8(r6)	# s2 L 1
+	subfe	r12,r10,r11
+	std	r12,16(r4)
+	ld	r10,16(r5)	# s1 L 2
+	ld	r11,16(r6)	# s2 L 2
+# pair -------------------------
+	subfe	r12,r14,r15
+	std	r12,24(r4)
+	subfe	r12,r16,r17
+	stdu	r12,32(r4)
+
+	SAVE_BORROW_RESTORE_CARRY(r0)
+
+	adde	r12,r14,r15
+	std	r12,24(r3)
+	ld	r14,24(r5)	# s1 L 3
+	ld	r15,24(r6)	# s2 L 3
+	adde	r12,r16,r17
+	stdu	r12,32(r3)
+	ldu	r16,32(r5)	# s1 L 4
+	ldu	r17,32(r6)	# s2 L 4
+	bdnz	.Loop
+
+	ld	r14,-64(1)
+	ld	r15,-56(1)
+	ld	r16,-48(1)
+	ld	r17,-40(1)
+	ld	r18,-32(1)
+	ld	r19,-24(1)
+	blr
+EPILOGUE(mpn_addsub_n)
diff --git a/src/gmp/mpn/powerpc64/aix.m4 b/src/gmp/mpn/powerpc64/aix.m4
new file mode 100644
index 000000000..aee9f1f97
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/aix.m4
@@ -0,0 +1,40 @@
+divert(-1)
+dnl  m4 macros for AIX 64-bit assembly.
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+define(`ASM_START',
+	`.machine	"ppc64"
+	.toc')
+	
+define(`PROLOGUE',
+	`
+	.globl	$1
+	.globl	.$1
+	.csect	$1[DS],3
+$1:
+	.llong	.$1, TOC[tc0], 0
+	.csect	.text[PR]
+	.align	2
+.$1:')
+
+define(`EPILOGUE', `')
+
+divert
diff --git a/src/gmp/mpn/powerpc64/copyd.asm b/src/gmp/mpn/powerpc64/copyd.asm
new file mode 100644
index 000000000..d06e8c25f
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/copyd.asm
@@ -0,0 +1,45 @@
+# PowerPC-64 mpn_copyd -- Copy a limb vector.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# rptr	r3
+# sptr	r4
+# n	r5
+
+include(`../config.m4')
+
+# Unrolling this analogous to sparc64/copyi.s doesn't help for any
+# operand sizes.
+
+ASM_START()
+PROLOGUE(mpn_copyd)
+	cmpdi	cr0,r5,0
+	mtctr	r5
+	sldi	r5,r5,3
+	add	r4,r4,r5
+	add	r3,r3,r5
+	beq	cr0,.Lend
+.Loop:	ldu	r0,-8(r4)
+	stdu	r0,-8(r3)
+	bdnz	.Loop
+.Lend:	blr
+EPILOGUE(mpn_copyd)
diff --git a/src/gmp/mpn/powerpc64/copyi.asm b/src/gmp/mpn/powerpc64/copyi.asm
new file mode 100644
index 000000000..a1bedc4c5
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/copyi.asm
@@ -0,0 +1,44 @@
+# PowerPC-64 mpn_copyi -- Copy a limb vector.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# rptr	r3
+# sptr	r4
+# n	r5
+
+include(`../config.m4')
+
+# Unrolling this analogous to sparc64/copyi.s doesn't help for any
+# operand sizes.
+
+ASM_START()
+PROLOGUE(mpn_copyi)
+	cmpdi	cr0,r5,0
+	mtctr	r5
+	addi	r4,r4,-8
+	addi	r3,r3,-8
+	beq	cr0,.Lend
+.Loop:	ldu	r0,8(r4)
+	stdu	r0,8(r3)
+	bdnz	.Loop
+.Lend:	blr
+EPILOGUE(mpn_copyi)
diff --git a/src/gmp/mpn/powerpc64/gmp-mparam.h b/src/gmp/mpn/powerpc64/gmp-mparam.h
new file mode 100644
index 000000000..6fefb960c
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/gmp-mparam.h
@@ -0,0 +1,62 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 64
+#define BYTES_PER_MP_LIMB 8
+#define BITS_PER_LONGINT 64
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+/* Generated by tuneup.c, 2000-07-16. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   10
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD       57
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   16
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD       89
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              28
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD            216
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            14
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        6
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD         163
+#endif
diff --git a/src/gmp/mpn/powerpc64/lshift.asm b/src/gmp/mpn/powerpc64/lshift.asm
new file mode 100644
index 000000000..cef3a81fd
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/lshift.asm
@@ -0,0 +1,159 @@
+#  PowerPC-64 mpn_lshift -- Shift a number left.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# size		r5
+# cnt		r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_lshift)
+	cmpdi	cr0,r5,20	# more than 20 limbs?
+	sldi	r0,r5,3
+	add	r4,r4,r0	# make r4 point at end of s1
+	add	r7,r3,r0	# make r7 point at end of res
+	bgt	.LBIG		# branch if more than 12 limbs
+
+	mtctr	r5		# copy size into CTR
+	subfic	r8,r6,64
+	ldu	r11,-8(r4)	# load first s1 limb
+	srd	r3,r11,r8	# compute function return value
+	bdz	.Lend1
+
+.Loop:	ldu	r10,-8(r4)
+	sld	r9,r11,r6
+	srd	r12,r10,r8
+	or	r9,r9,r12
+	stdu	r9,-8(r7)
+	bdz	.Lend2
+	ldu	r11,-8(r4)
+	sld	r9,r10,r6
+	srd	r12,r11,r8
+	or	r9,r9,r12
+	stdu	r9,-8(r7)
+	bdnz	.Loop
+
+.Lend1:	sld	r0,r11,r6
+	std	r0,-8(r7)
+	blr
+.Lend2:	sld	r0,r10,r6
+	std	r0,-8(r7)
+	blr
+
+.LBIG:
+	std	r24,-64(1)
+	std	r25,-56(1)
+	std	r26,-48(1)
+	std	r27,-40(1)
+	std	r28,-32(1)
+	std	r29,-24(1)
+	std	r30,-16(1)
+	std	r31,-8(1)
+	ldu	r9,-8(r4)
+	subfic	r8,r6,64
+	srd	r3,r9,r8	# compute function return value
+	sld	r0,r9,r6
+	addi	r5,r5,-1
+
+	andi.	r10,r5,3	# count for spill loop
+	beq	.Le
+	mtctr	r10
+	ldu	r28,-8(r4)
+	bdz	.Lxe0
+
+.Loop0:	sld	r12,r28,r6
+	srd	r24,r28,r8
+	ldu	r28,-8(r4)
+	or	r24,r0,r24
+	stdu	r24,-8(r7)
+	mr	r0,r12
+	bdnz	.Loop0		# taken at most once!
+
+.Lxe0:	sld	r12,r28,r6
+	srd	r24,r28,r8
+	or	r24,r0,r24
+	stdu	r24,-8(r7)
+	mr	r0,r12
+
+.Le:	srdi	r5,r5,2		# count for unrolled loop
+	addi	r5,r5,-1
+	mtctr	r5
+	ld	r28,-8(r4)
+	ld	r29,-16(r4)
+	ld	r30,-24(r4)
+	ldu	r31,-32(r4)
+
+.LoopU:	sld	r9,r28,r6
+	srd	r24,r28,r8
+	ld	r28,-8(r4)
+	sld	r10,r29,r6
+	srd	r25,r29,r8
+	ld	r29,-16(r4)
+	sld	r11,r30,r6
+	srd	r26,r30,r8
+	ld	r30,-24(r4)
+	sld	r12,r31,r6
+	srd	r27,r31,r8
+	ldu	r31,-32(r4)
+	or	r24,r0,r24
+	std	r24,-8(r7)
+	or	r25,r9,r25
+	std	r25,-16(r7)
+	or	r26,r10,r26
+	std	r26,-24(r7)
+	or	r27,r11,r27
+	stdu	r27,-32(r7)
+	mr	r0,r12
+	bdnz	.LoopU
+
+	sld	r9,r28,r6
+	srd	r24,r28,r8
+	sld	r10,r29,r6
+	srd	r25,r29,r8
+	sld	r11,r30,r6
+	srd	r26,r30,r8
+	sld	r12,r31,r6
+	srd	r27,r31,r8
+	or	r24,r0,r24
+	std	r24,-8(r7)
+	or	r25,r9,r25
+	std	r25,-16(r7)
+	or	r26,r10,r26
+	std	r26,-24(r7)
+	or	r27,r11,r27
+	stdu	r27,-32(r7)
+	mr	r0,r12
+
+	std	r0,-8(r7)
+	ld	r24,-64(1)
+	ld	r25,-56(1)
+	ld	r26,-48(1)
+	ld	r27,-40(1)
+	ld	r28,-32(1)
+	ld	r29,-24(1)
+	ld	r30,-16(1)
+	ld	r31,-8(1)
+	blr
+EPILOGUE(mpn_lshift)
diff --git a/src/gmp/mpn/powerpc64/mul_1.asm b/src/gmp/mpn/powerpc64/mul_1.asm
new file mode 100644
index 000000000..47597283f
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/mul_1.asm
@@ -0,0 +1,49 @@
+# PowerPC-64 mpn_mul_1 -- Multiply a limb vector with a limb and store
+# the result in a second limb vector.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# size		r5
+# s2_limb	r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_mul_1)
+	mtctr	5
+	li	9,0		# cy_limb = 0
+	addic	0,0,0
+	cal	3,-8(3)
+	cal	4,-8(4)
+.Loop:
+	ldu	0,8(4)
+	mulld	7,0,6
+	adde	7,7,9
+	mulhdu	9,0,6
+	stdu	7,8(3)
+	bdnz	.Loop
+
+	addze	3,9
+	blr
+EPILOGUE(mpn_mul_1)
diff --git a/src/gmp/mpn/powerpc64/rshift.asm b/src/gmp/mpn/powerpc64/rshift.asm
new file mode 100644
index 000000000..88272c7fa
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/rshift.asm
@@ -0,0 +1,60 @@
+# PowerPC-64 mpn_rshift -- Shift a number right.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# size		r5
+# cnt		r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_rshift)
+	mtctr	r5		# copy size into CTR
+	addi	r7,r3,-8	# move adjusted res_ptr to free return reg
+	subfic	r8,r6,64
+	ld	r11,0(r4)	# load first s1 limb
+	sld	r3,r11,r8	# compute function return value
+	bdz	.Lend1
+
+.Loop:	ldu	r10,8(r4)
+	srd	r9,r11,r6
+	sld	r12,r10,r8
+	or	r9,r9,r12
+	stdu	r9,8(r7)
+	bdz	.Lend2
+	ldu	r11,8(r4)
+	srd	r9,r10,r6
+	sld	r12,r11,r8
+	or	r9,r9,r12
+	stdu	r9,8(r7)
+	bdnz	.Loop
+
+.Lend1:	srd	r0,r11,r6
+	std	r0,8(r7)
+	blr
+
+.Lend2:	srd	r0,r10,r6
+	std	r0,8(r7)
+	blr
+EPILOGUE(mpn_rshift)
diff --git a/src/gmp/mpn/powerpc64/sub_n.asm b/src/gmp/mpn/powerpc64/sub_n.asm
new file mode 100644
index 000000000..4de3de69c
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/sub_n.asm
@@ -0,0 +1,61 @@
+# PowerPC-64 mpn_sub_n -- Subtract two limb vectors of the same length > 0
+# and store difference in a third limb vector.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.b
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# s2_ptr	r5
+# size		r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_sub_n)
+	mtctr	r6		# copy size into CTR
+	addic	r0,r6,-1	# set cy
+	ld	r8,0(r4)	# load least significant s1 limb
+	ld	r0,0(r5)	# load least significant s2 limb
+	addi	r3,r3,-8	# offset res_ptr, it's updated before it's used
+	bdz	.Lend		# If done, skip loop
+.Loop:	ld	r9,8(r4)	# load s1 limb
+	ld	r10,8(r5)	# load s2 limb
+	subfe	r7,r0,r8	# subtract limbs with cy, set cy
+	std	r7,8(r3)	# store result limb
+	bdz	.Lexit		# decrement CTR and exit if done
+	ldu	r8,16(r4)	# load s1 limb and update s1_ptr
+	ldu	r0,16(r5)	# load s2 limb and update s2_ptr
+	subfe	r7,r10,r9	# subtract limbs with cy, set cy
+	stdu	r7,16(r3)	# store result limb and update res_ptr
+	bdnz	.Loop		# decrement CTR and loop back
+
+.Lend:	subfe	r7,r0,r8
+	std	r7,8(r3)	# store ultimate result limb
+	subfe	r3,r0,r0	# load !cy into ...
+	subfic	r3,r3,0		# ... return value register
+	blr
+.Lexit:	subfe	r7,r10,r9
+	std	r7,16(r3)
+	subfe	r3,r0,r0	# load !cy into ...
+	subfic	r3,r3,0		# ... return value register
+	blr
+EPILOGUE(mpn_sub_n)
diff --git a/src/gmp/mpn/powerpc64/submul_1.asm b/src/gmp/mpn/powerpc64/submul_1.asm
new file mode 100644
index 000000000..17f6369a3
--- /dev/null
+++ b/src/gmp/mpn/powerpc64/submul_1.asm
@@ -0,0 +1,54 @@
+# PowerPC-64 mpn_submul_1 -- Multiply a limb vector with a limb and subtract
+# the result from a second limb vector.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	r3
+# s1_ptr	r4
+# size		r5
+# s2_limb	r6
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_submul_1)
+	mtctr	5
+	li	9,0		# cy_limb = 0
+	addic	0,0,0
+	cal	3,-8(3)
+	cal	4,-8(4)
+.Loop:
+	ldu	0,8(4)
+	ld	10,8(3)
+	mulld	7,0,6
+	adde	7,7,9
+	mulhdu	9,0,6
+	addze	9,9
+	subfc	7,7,10
+	stdu	7,8(3)
+	subfe	11,11,11	# invert ...
+	addic	11,11,1		# ... carry
+	bdnz	.Loop
+
+	addze	3,9
+	blr
+EPILOGUE(mpn_submul_1)
diff --git a/src/gmp/mpn/pyr/add_n.s b/src/gmp/mpn/pyr/add_n.s
new file mode 100644
index 000000000..e1fc53584
--- /dev/null
+++ b/src/gmp/mpn/pyr/add_n.s
@@ -0,0 +1,76 @@
+# Pyramid __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+# sum in a third limb vector.
+
+# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+.text
+	.align	2
+.globl	___gmpn_add_n
+___gmpn_add_n:
+	movw	$-1,tr0		# representation for carry clear
+
+	movw	pr3,tr2
+	andw	$3,tr2
+	beq	Lend0
+	subw	tr2,pr3
+
+Loop0:	rsubw	$0,tr0		# restore carry bit from carry-save register
+
+	movw	(pr1),tr1
+	addwc	(pr2),tr1
+	movw	tr1,(pr0)
+
+	subwb	tr0,tr0
+	addw	$4,pr0
+	addw	$4,pr1
+	addw	$4,pr2
+	addw	$-1,tr2
+	bne	Loop0
+
+	mtstw	pr3,pr3
+	beq	Lend
+Lend0:
+Loop:	rsubw	$0,tr0		# restore carry bit from carry-save register
+
+	movw	(pr1),tr1
+	addwc	(pr2),tr1
+	movw	tr1,(pr0)
+
+	movw	4(pr1),tr1
+	addwc	4(pr2),tr1
+	movw	tr1,4(pr0)
+
+	movw	8(pr1),tr1
+	addwc	8(pr2),tr1
+	movw	tr1,8(pr0)
+
+	movw	12(pr1),tr1
+	addwc	12(pr2),tr1
+	movw	tr1,12(pr0)
+
+	subwb	tr0,tr0
+	addw	$16,pr0
+	addw	$16,pr1
+	addw	$16,pr2
+	addw	$-4,pr3
+	bne	Loop
+Lend:
+	mnegw	tr0,pr0
+	ret
diff --git a/src/gmp/mpn/pyr/addmul_1.s b/src/gmp/mpn/pyr/addmul_1.s
new file mode 100644
index 000000000..65c3f8f00
--- /dev/null
+++ b/src/gmp/mpn/pyr/addmul_1.s
@@ -0,0 +1,45 @@
+# Pyramid __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
+# the result to a second limb vector.
+
+# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+.text
+	.align	2
+.globl	___gmpn_addmul_1
+___gmpn_addmul_1:
+	mova	(pr0)[pr2*4],pr0
+	mova	(pr1)[pr2*4],pr1
+	mnegw	pr2,pr2
+	movw	$0,tr3
+
+Loop:	movw	(pr1)[pr2*4],tr1
+	uemul	pr3,tr0
+	addw	tr3,tr1
+	movw	$0,tr3
+	addwc	tr0,tr3
+	movw	(pr0)[pr2*0x4],tr0
+	addw	tr0,tr1
+	addwc	$0,tr3
+	movw	tr1,(pr0)[pr2*4]
+	addw	$1,pr2
+	bne	Loop
+
+	movw	tr3,pr0
+	ret
diff --git a/src/gmp/mpn/pyr/mul_1.s b/src/gmp/mpn/pyr/mul_1.s
new file mode 100644
index 000000000..1272297c4
--- /dev/null
+++ b/src/gmp/mpn/pyr/mul_1.s
@@ -0,0 +1,42 @@
+# Pyramid __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+# the result in a second limb vector.
+
+# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+.text
+	.align	2
+.globl	___gmpn_mul_1
+___gmpn_mul_1:
+	mova	(pr0)[pr2*4],pr0
+	mova	(pr1)[pr2*4],pr1
+	mnegw	pr2,pr2
+	movw	$0,tr3
+
+Loop:	movw	(pr1)[pr2*4],tr1
+	uemul	pr3,tr0
+	addw	tr3,tr1
+	movw	$0,tr3
+	addwc	tr0,tr3
+	movw	tr1,(pr0)[pr2*4]
+	addw	$1,pr2
+	bne	Loop
+
+	movw	tr3,pr0
+	ret
diff --git a/src/gmp/mpn/pyr/sub_n.s b/src/gmp/mpn/pyr/sub_n.s
new file mode 100644
index 000000000..1fd2eb0f1
--- /dev/null
+++ b/src/gmp/mpn/pyr/sub_n.s
@@ -0,0 +1,76 @@
+# Pyramid __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+# store difference in a third limb vector.
+
+# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+.text
+	.align	2
+.globl	___gmpn_sub_n
+___gmpn_sub_n:
+	movw	$-1,tr0		# representation for carry clear
+
+	movw	pr3,tr2
+	andw	$3,tr2
+	beq	Lend0
+	subw	tr2,pr3
+
+Loop0:	rsubw	$0,tr0		# restore carry bit from carry-save register
+
+	movw	(pr1),tr1
+	subwb	(pr2),tr1
+	movw	tr1,(pr0)
+
+	subwb	tr0,tr0
+	addw	$4,pr0
+	addw	$4,pr1
+	addw	$4,pr2
+	addw	$-1,tr2
+	bne	Loop0
+
+	mtstw	pr3,pr3
+	beq	Lend
+Lend0:
+Loop:	rsubw	$0,tr0		# restore carry bit from carry-save register
+
+	movw	(pr1),tr1
+	subwb	(pr2),tr1
+	movw	tr1,(pr0)
+
+	movw	4(pr1),tr1
+	subwb	4(pr2),tr1
+	movw	tr1,4(pr0)
+
+	movw	8(pr1),tr1
+	subwb	8(pr2),tr1
+	movw	tr1,8(pr0)
+
+	movw	12(pr1),tr1
+	subwb	12(pr2),tr1
+	movw	tr1,12(pr0)
+
+	subwb	tr0,tr0
+	addw	$16,pr0
+	addw	$16,pr1
+	addw	$16,pr2
+	addw	$-4,pr3
+	bne	Loop
+Lend:
+	mnegw	tr0,pr0
+	ret
diff --git a/src/gmp/mpn/sh/add_n.s b/src/gmp/mpn/sh/add_n.s
new file mode 100644
index 000000000..df388b31a
--- /dev/null
+++ b/src/gmp/mpn/sh/add_n.s
@@ -0,0 +1,47 @@
+! SH __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+! sum in a third limb vector.
+
+! Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r4
+! s1_ptr	r5
+! s2_ptr	r6
+! size		r7
+
+	.text
+	.align 2
+	.global	___gmpn_add_n
+___gmpn_add_n:
+	mov	#0,r3		! clear cy save reg
+
+Loop:	mov.l	@r5+,r1
+	mov.l	@r6+,r2
+	shlr	r3		! restore cy
+	addc	r2,r1
+	movt	r3		! save cy
+	mov.l	r1,@r4
+	dt	r7
+	bf.s	Loop
+	 add	#4,r4
+
+	rts
+	mov	r3,r0		! return carry-out from most sign. limb
diff --git a/src/gmp/mpn/sh/sh2/addmul_1.s b/src/gmp/mpn/sh/sh2/addmul_1.s
new file mode 100644
index 000000000..f34a7f050
--- /dev/null
+++ b/src/gmp/mpn/sh/sh2/addmul_1.s
@@ -0,0 +1,53 @@
+! SH2 __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
+! the result to a second limb vector.
+
+! Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r4
+! s1_ptr	r5
+! size		r6
+! s2_limb	r7
+
+	.text
+	.align 1
+	.global	___gmpn_addmul_1
+___gmpn_addmul_1:
+	mov	#0,r2		! cy_limb = 0
+	mov	#0,r0		! Keep r0 = 0 for entire loop
+	clrt
+
+Loop:	mov.l	@r5+,r3
+	dmulu.l	r3,r7
+	sts	macl,r1
+	addc	r2,r1		! lo_prod += old cy_limb
+	sts	mach,r2		! new cy_limb = hi_prod
+	mov.l	@r4,r3
+	addc	r0,r2		! cy_limb += T, T = 0
+	addc	r3,r1
+	addc	r0,r2		! cy_limb += T, T = 0
+	dt	r6
+	mov.l	r1,@r4
+	bf.s	Loop
+	add	#4,r4
+
+	rts
+	mov	r2,r0
diff --git a/src/gmp/mpn/sh/sh2/mul_1.s b/src/gmp/mpn/sh/sh2/mul_1.s
new file mode 100644
index 000000000..2a117a317
--- /dev/null
+++ b/src/gmp/mpn/sh/sh2/mul_1.s
@@ -0,0 +1,50 @@
+! SH2 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+! the result in a second limb vector.
+
+! Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r4
+! s1_ptr	r5
+! size		r6
+! s2_limb	r7
+
+	.text
+	.align 1
+	.global	___gmpn_mul_1
+___gmpn_mul_1:
+	mov	#0,r2		! cy_limb = 0
+	mov	#0,r0		! Keep r0 = 0 for entire loop
+	clrt
+
+Loop:	mov.l	@r5+,r3
+	dmulu.l	r3,r7
+	sts	macl,r1
+	addc	r2,r1
+	sts	mach,r2
+	addc	r0,r2		! propagate carry to cy_limb (dt clobbers T)
+	dt	r6
+	mov.l	r1,@r4
+	bf.s	Loop
+	add	#4,r4
+
+	rts
+	mov	r2,r0
diff --git a/src/gmp/mpn/sh/sh2/submul_1.s b/src/gmp/mpn/sh/sh2/submul_1.s
new file mode 100644
index 000000000..eb9a27dde
--- /dev/null
+++ b/src/gmp/mpn/sh/sh2/submul_1.s
@@ -0,0 +1,53 @@
+! SH2 __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
+! the result from a second limb vector.
+
+! Copyright (C) 1995, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r4
+! s1_ptr	r5
+! size		r6
+! s2_limb	r7
+
+	.text
+	.align 1
+	.global	___gmpn_submul_1
+___gmpn_submul_1:
+	mov	#0,r2		! cy_limb = 0
+	mov	#0,r0		! Keep r0 = 0 for entire loop
+	clrt
+
+Loop:	mov.l	@r5+,r3
+	dmulu.l	r3,r7
+	sts	macl,r1
+	addc	r2,r1		! lo_prod += old cy_limb
+	sts	mach,r2		! new cy_limb = hi_prod
+	mov.l	@r4,r3
+	addc	r0,r2		! cy_limb += T, T = 0
+	subc	r3,r1
+	addc	r0,r2		! cy_limb += T, T = 0
+	dt	r6
+	mov.l	r1,@r4
+	bf.s	Loop
+	add	#4,r4
+
+	rts
+	mov	r2,r0
diff --git a/src/gmp/mpn/sh/sub_n.s b/src/gmp/mpn/sh/sub_n.s
new file mode 100644
index 000000000..5f818c95a
--- /dev/null
+++ b/src/gmp/mpn/sh/sub_n.s
@@ -0,0 +1,47 @@
+! SH __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and store
+! difference in a third limb vector.
+
+! Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r4
+! s1_ptr	r5
+! s2_ptr	r6
+! size		r7
+
+	.text
+	.align 2
+	.global	___gmpn_sub_n
+___gmpn_sub_n:
+	mov	#0,r3		! clear cy save reg
+
+Loop:	mov.l	@r5+,r1
+	mov.l	@r6+,r2
+	shlr	r3		! restore cy
+	subc	r2,r1
+	movt	r3		! save cy
+	mov.l	r1,@r4
+	dt	r7
+	bf.s	Loop
+	 add	#4,r4
+
+	rts
+	mov	r3,r0		! return carry-out from most sign. limb
diff --git a/src/gmp/mpn/sparc32/README b/src/gmp/mpn/sparc32/README
new file mode 100644
index 000000000..7c19df7bc
--- /dev/null
+++ b/src/gmp/mpn/sparc32/README
@@ -0,0 +1,36 @@
+This directory contains mpn functions for various SPARC chips.  Code that
+runs only on version 8 SPARC implementations, is in the v8 subdirectory.
+
+RELEVANT OPTIMIZATION ISSUES
+
+  Load and Store timing
+
+On most early SPARC implementations, the ST instructions takes multiple
+cycles, while a STD takes just a single cycle more than an ST.  For the CPUs
+in SPARCstation I and II, the times are 3 and 4 cycles, respectively.
+Therefore, combining two ST instrucitons into a STD when possible is a
+significant optimiation.
+
+Later SPARC implementations have single cycle ST.
+
+For SuperSPARC, we can perform just one memory instruction per cycle, even
+if up to two integer instructions can be executed in its pipeline.  For
+programs that perform so many memory operations that there are not enough
+non-memory operations to issue in parallel with all memory operations, using
+LDD and STD when possible helps.
+
+STATUS
+
+1. On a SuperSPARC, mpn_lshift and mpn_rshift run at 3 cycles/limb, or 2.5
+   cycles/limb asymptotically.  We could optimize speed for special counts
+   by using ADDXCC.
+
+2. On a SuperSPARC, mpn_add_n and mpn_sub_n runs at 2.5 cycles/limb, or 2
+   cycles/limb asymptotically.
+
+3. mpn_mul_1 runs at what is believed to be optimal speed.
+
+4. On SuperSPARC, mpn_addmul_1 and mpn_submul_1 could both be improved by a
+   cycle by avoiding one of the add instrucitons.  See a29k/addmul_1.
+
+The speed of the code for other SPARC implementations is uncertain.
diff --git a/src/gmp/mpn/sparc32/add_n.asm b/src/gmp/mpn/sparc32/add_n.asm
new file mode 100644
index 000000000..5f1d00c0e
--- /dev/null
+++ b/src/gmp/mpn/sparc32/add_n.asm
@@ -0,0 +1,236 @@
+dnl  SPARC mpn_add_n -- Add two limb vectors of the same length > 0 and store
+dnl  sum in a third limb vector.
+
+dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+define(res_ptr,%o0)
+define(s1_ptr,%o1)
+define(s2_ptr,%o2)
+define(n,%o3)
+
+ASM_START()
+PROLOGUE(mpn_add_n)
+	xor	s2_ptr,res_ptr,%g1
+	andcc	%g1,4,%g0
+	bne	L(1)			C branch if alignment differs
+	nop
+C **  V1a  **
+L(0):	andcc	res_ptr,4,%g0		C res_ptr unaligned? Side effect: cy=0
+	be	L(v1)			C if no, branch
+	nop
+C Add least significant limb separately to align res_ptr and s2_ptr
+	ld	[s1_ptr],%g4
+	add	s1_ptr,4,s1_ptr
+	ld	[s2_ptr],%g2
+	add	s2_ptr,4,s2_ptr
+	add	n,-1,n
+	addcc	%g4,%g2,%o4
+	st	%o4,[res_ptr]
+	add	res_ptr,4,res_ptr
+L(v1):	addx	%g0,%g0,%o4		C save cy in register
+	cmp	n,2			C if n < 2 ...
+	bl	L(end2)			C ... branch to tail code
+	subcc	%g0,%o4,%g0		C restore cy
+
+	ld	[s1_ptr+0],%g4
+	addcc	n,-10,n
+	ld	[s1_ptr+4],%g1
+	ldd	[s2_ptr+0],%g2
+	blt	L(fin1)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add blocks of 8 limbs until less than 8 limbs remain
+L(loop1):
+	addxcc	%g4,%g2,%o4
+	ld	[s1_ptr+8],%g4
+	addxcc	%g1,%g3,%o5
+	ld	[s1_ptr+12],%g1
+	ldd	[s2_ptr+8],%g2
+	std	%o4,[res_ptr+0]
+	addxcc	%g4,%g2,%o4
+	ld	[s1_ptr+16],%g4
+	addxcc	%g1,%g3,%o5
+	ld	[s1_ptr+20],%g1
+	ldd	[s2_ptr+16],%g2
+	std	%o4,[res_ptr+8]
+	addxcc	%g4,%g2,%o4
+	ld	[s1_ptr+24],%g4
+	addxcc	%g1,%g3,%o5
+	ld	[s1_ptr+28],%g1
+	ldd	[s2_ptr+24],%g2
+	std	%o4,[res_ptr+16]
+	addxcc	%g4,%g2,%o4
+	ld	[s1_ptr+32],%g4
+	addxcc	%g1,%g3,%o5
+	ld	[s1_ptr+36],%g1
+	ldd	[s2_ptr+32],%g2
+	std	%o4,[res_ptr+24]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-8,n
+	add	s1_ptr,32,s1_ptr
+	add	s2_ptr,32,s2_ptr
+	add	res_ptr,32,res_ptr
+	bge	L(loop1)
+	subcc	%g0,%o4,%g0		C restore cy
+
+L(fin1):
+	addcc	n,8-2,n
+	blt	L(end1)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add blocks of 2 limbs until less than 2 limbs remain
+L(loope1):
+	addxcc	%g4,%g2,%o4
+	ld	[s1_ptr+8],%g4
+	addxcc	%g1,%g3,%o5
+	ld	[s1_ptr+12],%g1
+	ldd	[s2_ptr+8],%g2
+	std	%o4,[res_ptr+0]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-2,n
+	add	s1_ptr,8,s1_ptr
+	add	s2_ptr,8,s2_ptr
+	add	res_ptr,8,res_ptr
+	bge	L(loope1)
+	subcc	%g0,%o4,%g0		C restore cy
+L(end1):
+	addxcc	%g4,%g2,%o4
+	addxcc	%g1,%g3,%o5
+	std	%o4,[res_ptr+0]
+	addx	%g0,%g0,%o4		C save cy in register
+
+	andcc	n,1,%g0
+	be	L(ret1)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add last limb
+	ld	[s1_ptr+8],%g4
+	ld	[s2_ptr+8],%g2
+	addxcc	%g4,%g2,%o4
+	st	%o4,[res_ptr+8]
+
+L(ret1):
+	retl
+	addx	%g0,%g0,%o0	C return carry-out from most sign. limb
+
+L(1):	xor	s1_ptr,res_ptr,%g1
+	andcc	%g1,4,%g0
+	bne	L(2)
+	nop
+C **  V1b  **
+	mov	s2_ptr,%g1
+	mov	s1_ptr,s2_ptr
+	b	L(0)
+	mov	%g1,s1_ptr
+
+C **  V2  **
+C If we come here, the alignment of s1_ptr and res_ptr as well as the
+C alignment of s2_ptr and res_ptr differ.  Since there are only two ways
+C things can be aligned (that we care about) we now know that the alignment
+C of s1_ptr and s2_ptr are the same.
+
+L(2):	cmp	n,1
+	be	L(jone)
+	nop
+	andcc	s1_ptr,4,%g0		C s1_ptr unaligned? Side effect: cy=0
+	be	L(v2)			C if no, branch
+	nop
+C Add least significant limb separately to align s1_ptr and s2_ptr
+	ld	[s1_ptr],%g4
+	add	s1_ptr,4,s1_ptr
+	ld	[s2_ptr],%g2
+	add	s2_ptr,4,s2_ptr
+	add	n,-1,n
+	addcc	%g4,%g2,%o4
+	st	%o4,[res_ptr]
+	add	res_ptr,4,res_ptr
+
+L(v2):	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-8,n
+	blt	L(fin2)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add blocks of 8 limbs until less than 8 limbs remain
+L(loop2):
+	ldd	[s1_ptr+0],%g2
+	ldd	[s2_ptr+0],%o4
+	addxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+0]
+	addxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+4]
+	ldd	[s1_ptr+8],%g2
+	ldd	[s2_ptr+8],%o4
+	addxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+8]
+	addxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+12]
+	ldd	[s1_ptr+16],%g2
+	ldd	[s2_ptr+16],%o4
+	addxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+16]
+	addxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+20]
+	ldd	[s1_ptr+24],%g2
+	ldd	[s2_ptr+24],%o4
+	addxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+24]
+	addxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+28]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-8,n
+	add	s1_ptr,32,s1_ptr
+	add	s2_ptr,32,s2_ptr
+	add	res_ptr,32,res_ptr
+	bge	L(loop2)
+	subcc	%g0,%o4,%g0		C restore cy
+
+L(fin2):
+	addcc	n,8-2,n
+	blt	L(end2)
+	subcc	%g0,%o4,%g0		C restore cy
+L(loope2):
+	ldd	[s1_ptr+0],%g2
+	ldd	[s2_ptr+0],%o4
+	addxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+0]
+	addxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+4]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-2,n
+	add	s1_ptr,8,s1_ptr
+	add	s2_ptr,8,s2_ptr
+	add	res_ptr,8,res_ptr
+	bge	L(loope2)
+	subcc	%g0,%o4,%g0		C restore cy
+L(end2):
+	andcc	n,1,%g0
+	be	L(ret2)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add last limb
+L(jone):
+	ld	[s1_ptr],%g4
+	ld	[s2_ptr],%g2
+	addxcc	%g4,%g2,%o4
+	st	%o4,[res_ptr]
+
+L(ret2):
+	retl
+	addx	%g0,%g0,%o0	C return carry-out from most sign. limb
+EPILOGUE(mpn_add_n)
diff --git a/src/gmp/mpn/sparc32/addmul_1.asm b/src/gmp/mpn/sparc32/addmul_1.asm
new file mode 100644
index 000000000..80c94e425
--- /dev/null
+++ b/src/gmp/mpn/sparc32/addmul_1.asm
@@ -0,0 +1,146 @@
+dnl  SPARC mpn_addmul_1 -- Multiply a limb vector with a limb and add the
+dnl  result to a second limb vector.
+
+dnl  Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	o0
+C s1_ptr	o1
+C size		o2
+C s2_limb	o3
+
+ASM_START()
+PROLOGUE(mpn_addmul_1)
+	C Make S1_PTR and RES_PTR point at the end of their blocks
+	C and put (- 4 x SIZE) in index/loop counter.
+	sll	%o2,2,%o2
+	add	%o0,%o2,%o4	C RES_PTR in o4 since o0 is retval
+	add	%o1,%o2,%o1
+	sub	%g0,%o2,%o2
+
+	cmp	%o3,0xfff
+	bgu	L(large)
+	nop
+
+	ld	[%o1+%o2],%o5
+	mov	0,%o0
+	b	L(0)
+	 add	%o4,-4,%o4
+L(loop0):
+	addcc	%o5,%g1,%g1
+	ld	[%o1+%o2],%o5
+	addx	%o0,%g0,%o0
+	st	%g1,[%o4+%o2]
+L(0):	wr	%g0,%o3,%y
+	sra	%o5,31,%g2
+	and	%o3,%g2,%g2
+	andcc	%g1,0,%g1
+	mulscc	%g1,%o5,%g1
+ 	mulscc	%g1,%o5,%g1
+ 	mulscc	%g1,%o5,%g1
+ 	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,0,%g1
+	sra	%g1,20,%g4
+	sll	%g1,12,%g1
+ 	rd	%y,%g3
+	srl	%g3,20,%g3
+	or	%g1,%g3,%g1
+
+	addcc	%g1,%o0,%g1
+	addx	%g2,%g4,%o0	C add sign-compensation and cy to hi limb
+	addcc	%o2,4,%o2	C loop counter
+	bne	L(loop0)
+	 ld	[%o4+%o2],%o5
+
+	addcc	%o5,%g1,%g1
+	addx	%o0,%g0,%o0
+	retl
+	st	%g1,[%o4+%o2]
+
+L(large):
+	ld	[%o1+%o2],%o5
+	mov	0,%o0
+	sra	%o3,31,%g4	C g4 = mask of ones iff S2_LIMB < 0
+	b	L(1)
+	 add	%o4,-4,%o4
+L(loop):
+	addcc	%o5,%g3,%g3
+	ld	[%o1+%o2],%o5
+	addx	%o0,%g0,%o0
+	st	%g3,[%o4+%o2]
+L(1):	wr	%g0,%o5,%y
+	and	%o5,%g4,%g2
+	andcc	%g0,%g0,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%g0,%g1
+	rd	%y,%g3
+	addcc	%g3,%o0,%g3
+	addx	%g2,%g1,%o0
+	addcc	%o2,4,%o2
+	bne	L(loop)
+	 ld	[%o4+%o2],%o5
+
+	addcc	%o5,%g3,%g3
+	addx	%o0,%g0,%o0
+	retl
+	st	%g3,[%o4+%o2]
+EPILOGUE(mpn_addmul_1)
diff --git a/src/gmp/mpn/sparc32/lshift.asm b/src/gmp/mpn/sparc32/lshift.asm
new file mode 100644
index 000000000..529733ac2
--- /dev/null
+++ b/src/gmp/mpn/sparc32/lshift.asm
@@ -0,0 +1,97 @@
+dnl  SPARC mpn_lshift -- Shift a number left.
+dnl  
+
+dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	%o0
+C src_ptr	%o1
+C size		%o2
+C cnt		%o3
+
+ASM_START()
+PROLOGUE(mpn_lshift)
+	sll	%o2,2,%g1
+	add	%o1,%g1,%o1	C make %o1 point at end of src
+	ld	[%o1-4],%g2	C load first limb
+	sub	%g0,%o3,%o5	C negate shift count
+	add	%o0,%g1,%o0	C make %o0 point at end of res
+	add	%o2,-1,%o2
+	andcc	%o2,4-1,%g4	C number of limbs in first loop
+	srl	%g2,%o5,%g1	C compute function result
+	be	L(0)		C if multiple of 4 limbs, skip first loop
+	st	%g1,[%sp+80]
+
+	sub	%o2,%g4,%o2	C adjust count for main loop
+
+L(loop0):
+	ld	[%o1-8],%g3
+	add	%o0,-4,%o0
+	add	%o1,-4,%o1
+	addcc	%g4,-1,%g4
+	sll	%g2,%o3,%o4
+	srl	%g3,%o5,%g1
+	mov	%g3,%g2
+	or	%o4,%g1,%o4
+	bne	L(loop0)
+	 st	%o4,[%o0+0]
+
+L(0):	tst	%o2
+	be	L(end)
+	 nop
+
+L(loop):
+	ld	[%o1-8],%g3
+	add	%o0,-16,%o0
+	addcc	%o2,-4,%o2
+	sll	%g2,%o3,%o4
+	srl	%g3,%o5,%g1
+
+	ld	[%o1-12],%g2
+	sll	%g3,%o3,%g4
+	or	%o4,%g1,%o4
+	st	%o4,[%o0+12]
+	srl	%g2,%o5,%g1
+
+	ld	[%o1-16],%g3
+	sll	%g2,%o3,%o4
+	or	%g4,%g1,%g4
+	st	%g4,[%o0+8]
+	srl	%g3,%o5,%g1
+
+	ld	[%o1-20],%g2
+	sll	%g3,%o3,%g4
+	or	%o4,%g1,%o4
+	st	%o4,[%o0+4]
+	srl	%g2,%o5,%g1
+
+	add	%o1,-16,%o1
+	or	%g4,%g1,%g4
+	bne	L(loop)
+	 st	%g4,[%o0+0]
+
+L(end):	sll	%g2,%o3,%g2
+	st	%g2,[%o0-4]
+	retl
+	ld	[%sp+80],%o0
+EPILOGUE(mpn_lshift)
diff --git a/src/gmp/mpn/sparc32/mul_1.asm b/src/gmp/mpn/sparc32/mul_1.asm
new file mode 100644
index 000000000..e5fedeaba
--- /dev/null
+++ b/src/gmp/mpn/sparc32/mul_1.asm
@@ -0,0 +1,137 @@
+dnl  SPARC mpn_mul_1 -- Multiply a limb vector with a limb and store
+dnl  the result in a second limb vector.
+
+dnl  Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	o0
+C s1_ptr	o1
+C size		o2
+C s2_limb	o3
+
+ASM_START()
+PROLOGUE(mpn_mul_1)
+	C Make S1_PTR and RES_PTR point at the end of their blocks
+	C and put (- 4 x SIZE) in index/loop counter.
+	sll	%o2,2,%o2
+	add	%o0,%o2,%o4	C RES_PTR in o4 since o0 is retval
+	add	%o1,%o2,%o1
+	sub	%g0,%o2,%o2
+
+	cmp	%o3,0xfff
+	bgu	L(large)
+	nop
+
+	ld	[%o1+%o2],%o5
+	mov	0,%o0
+	b	L(0)
+	 add	%o4,-4,%o4
+L(loop0):
+	st	%g1,[%o4+%o2]
+L(0):	wr	%g0,%o3,%y
+	sra	%o5,31,%g2
+	and	%o3,%g2,%g2
+	andcc	%g1,0,%g1
+	mulscc	%g1,%o5,%g1
+ 	mulscc	%g1,%o5,%g1
+ 	mulscc	%g1,%o5,%g1
+ 	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,0,%g1
+	sra	%g1,20,%g4
+	sll	%g1,12,%g1
+ 	rd	%y,%g3
+	srl	%g3,20,%g3
+	or	%g1,%g3,%g1
+
+	addcc	%g1,%o0,%g1
+	addx	%g2,%g4,%o0	C add sign-compensation and cy to hi limb
+	addcc	%o2,4,%o2	C loop counter
+	bne,a	L(loop0)
+	 ld	[%o1+%o2],%o5
+
+	retl
+	st	%g1,[%o4+%o2]
+
+
+L(large):
+	ld	[%o1+%o2],%o5
+	mov	0,%o0
+	sra	%o3,31,%g4	C g4 = mask of ones iff S2_LIMB < 0
+	b	L(1)
+	 add	%o4,-4,%o4
+L(loop):
+	st	%g3,[%o4+%o2]
+L(1):	wr	%g0,%o5,%y
+	and	%o5,%g4,%g2	C g2 = S1_LIMB iff S2_LIMB < 0, else 0
+	andcc	%g0,%g0,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%g0,%g1
+	rd	%y,%g3
+	addcc	%g3,%o0,%g3
+	addx	%g2,%g1,%o0	C add sign-compensation and cy to hi limb
+	addcc	%o2,4,%o2	C loop counter
+	bne,a	L(loop)
+	 ld	[%o1+%o2],%o5
+
+	retl
+	st	%g3,[%o4+%o2]
+EPILOGUE(mpn_mul_1)
diff --git a/src/gmp/mpn/sparc32/rshift.asm b/src/gmp/mpn/sparc32/rshift.asm
new file mode 100644
index 000000000..9187dbaa6
--- /dev/null
+++ b/src/gmp/mpn/sparc32/rshift.asm
@@ -0,0 +1,93 @@
+dnl  SPARC mpn_rshift -- Shift a number right.
+
+dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	%o0
+C src_ptr	%o1
+C size		%o2
+C cnt		%o3
+
+ASM_START()
+PROLOGUE(mpn_rshift)
+	ld	[%o1],%g2	C load first limb
+	sub	%g0,%o3,%o5	C negate shift count
+	add	%o2,-1,%o2
+	andcc	%o2,4-1,%g4	C number of limbs in first loop
+	sll	%g2,%o5,%g1	C compute function result
+	be	L(0)		C if multiple of 4 limbs, skip first loop
+	st	%g1,[%sp+80]
+
+	sub	%o2,%g4,%o2	C adjust count for main loop
+
+L(loop0):
+	ld	[%o1+4],%g3
+	add	%o0,4,%o0
+	add	%o1,4,%o1
+	addcc	%g4,-1,%g4
+	srl	%g2,%o3,%o4
+	sll	%g3,%o5,%g1
+	mov	%g3,%g2
+	or	%o4,%g1,%o4
+	bne	L(loop0)
+	 st	%o4,[%o0-4]
+
+L(0):	tst	%o2
+	be	L(end)
+	 nop
+
+L(loop):
+	ld	[%o1+4],%g3
+	add	%o0,16,%o0
+	addcc	%o2,-4,%o2
+	srl	%g2,%o3,%o4
+	sll	%g3,%o5,%g1
+
+	ld	[%o1+8],%g2
+	srl	%g3,%o3,%g4
+	or	%o4,%g1,%o4
+	st	%o4,[%o0-16]
+	sll	%g2,%o5,%g1
+
+	ld	[%o1+12],%g3
+	srl	%g2,%o3,%o4
+	or	%g4,%g1,%g4
+	st	%g4,[%o0-12]
+	sll	%g3,%o5,%g1
+
+	ld	[%o1+16],%g2
+	srl	%g3,%o3,%g4
+	or	%o4,%g1,%o4
+	st	%o4,[%o0-8]
+	sll	%g2,%o5,%g1
+
+	add	%o1,16,%o1
+	or	%g4,%g1,%g4
+	bne	L(loop)
+	 st	%g4,[%o0-4]
+
+L(end):	srl	%g2,%o3,%g2
+	st	%g2,[%o0-0]
+	retl
+	ld	[%sp+80],%o0
+EPILOGUE(mpn_rshift)
diff --git a/src/gmp/mpn/sparc32/sub_n.asm b/src/gmp/mpn/sparc32/sub_n.asm
new file mode 100644
index 000000000..071909a1b
--- /dev/null
+++ b/src/gmp/mpn/sparc32/sub_n.asm
@@ -0,0 +1,326 @@
+dnl  SPARC mpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+dnl  store difference in a third limb vector.
+
+dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+define(res_ptr,%o0)
+define(s1_ptr,%o1)
+define(s2_ptr,%o2)
+define(n,%o3)
+
+ASM_START()
+PROLOGUE(mpn_sub_n)
+	xor	s2_ptr,res_ptr,%g1
+	andcc	%g1,4,%g0
+	bne	L(1)			C branch if alignment differs
+	nop
+C **  V1a  **
+	andcc	res_ptr,4,%g0		C res_ptr unaligned? Side effect: cy=0
+	be	L(v1)			C if no, branch
+	nop
+C Add least significant limb separately to align res_ptr and s2_ptr
+	ld	[s1_ptr],%g4
+	add	s1_ptr,4,s1_ptr
+	ld	[s2_ptr],%g2
+	add	s2_ptr,4,s2_ptr
+	add	n,-1,n
+	subcc	%g4,%g2,%o4
+	st	%o4,[res_ptr]
+	add	res_ptr,4,res_ptr
+L(v1):	addx	%g0,%g0,%o4		C save cy in register
+	cmp	n,2			C if n < 2 ...
+	bl	L(end2)			C ... branch to tail code
+	subcc	%g0,%o4,%g0		C restore cy
+
+	ld	[s1_ptr+0],%g4
+	addcc	n,-10,n
+	ld	[s1_ptr+4],%g1
+	ldd	[s2_ptr+0],%g2
+	blt	L(fin1)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add blocks of 8 limbs until less than 8 limbs remain
+L(loop1):
+	subxcc	%g4,%g2,%o4
+	ld	[s1_ptr+8],%g4
+	subxcc	%g1,%g3,%o5
+	ld	[s1_ptr+12],%g1
+	ldd	[s2_ptr+8],%g2
+	std	%o4,[res_ptr+0]
+	subxcc	%g4,%g2,%o4
+	ld	[s1_ptr+16],%g4
+	subxcc	%g1,%g3,%o5
+	ld	[s1_ptr+20],%g1
+	ldd	[s2_ptr+16],%g2
+	std	%o4,[res_ptr+8]
+	subxcc	%g4,%g2,%o4
+	ld	[s1_ptr+24],%g4
+	subxcc	%g1,%g3,%o5
+	ld	[s1_ptr+28],%g1
+	ldd	[s2_ptr+24],%g2
+	std	%o4,[res_ptr+16]
+	subxcc	%g4,%g2,%o4
+	ld	[s1_ptr+32],%g4
+	subxcc	%g1,%g3,%o5
+	ld	[s1_ptr+36],%g1
+	ldd	[s2_ptr+32],%g2
+	std	%o4,[res_ptr+24]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-8,n
+	add	s1_ptr,32,s1_ptr
+	add	s2_ptr,32,s2_ptr
+	add	res_ptr,32,res_ptr
+	bge	L(loop1)
+	subcc	%g0,%o4,%g0		C restore cy
+
+L(fin1):
+	addcc	n,8-2,n
+	blt	L(end1)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add blocks of 2 limbs until less than 2 limbs remain
+L(loope1):
+	subxcc	%g4,%g2,%o4
+	ld	[s1_ptr+8],%g4
+	subxcc	%g1,%g3,%o5
+	ld	[s1_ptr+12],%g1
+	ldd	[s2_ptr+8],%g2
+	std	%o4,[res_ptr+0]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-2,n
+	add	s1_ptr,8,s1_ptr
+	add	s2_ptr,8,s2_ptr
+	add	res_ptr,8,res_ptr
+	bge	L(loope1)
+	subcc	%g0,%o4,%g0		C restore cy
+L(end1):
+	subxcc	%g4,%g2,%o4
+	subxcc	%g1,%g3,%o5
+	std	%o4,[res_ptr+0]
+	addx	%g0,%g0,%o4		C save cy in register
+
+	andcc	n,1,%g0
+	be	L(ret1)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add last limb
+	ld	[s1_ptr+8],%g4
+	ld	[s2_ptr+8],%g2
+	subxcc	%g4,%g2,%o4
+	st	%o4,[res_ptr+8]
+
+L(ret1):
+	retl
+	addx	%g0,%g0,%o0	C return carry-out from most sign. limb
+
+L(1):	xor	s1_ptr,res_ptr,%g1
+	andcc	%g1,4,%g0
+	bne	L(2)
+	nop
+C **  V1b  **
+	andcc	res_ptr,4,%g0		C res_ptr unaligned? Side effect: cy=0
+	be	L(v1b)			C if no, branch
+	nop
+C Add least significant limb separately to align res_ptr and s1_ptr
+	ld	[s2_ptr],%g4
+	add	s2_ptr,4,s2_ptr
+	ld	[s1_ptr],%g2
+	add	s1_ptr,4,s1_ptr
+	add	n,-1,n
+	subcc	%g2,%g4,%o4
+	st	%o4,[res_ptr]
+	add	res_ptr,4,res_ptr
+L(v1b):	addx	%g0,%g0,%o4		C save cy in register
+	cmp	n,2			C if n < 2 ...
+	bl	L(end2)			C ... branch to tail code
+	subcc	%g0,%o4,%g0		C restore cy
+
+	ld	[s2_ptr+0],%g4
+	addcc	n,-10,n
+	ld	[s2_ptr+4],%g1
+	ldd	[s1_ptr+0],%g2
+	blt	L(fin1b)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add blocks of 8 limbs until less than 8 limbs remain
+L(loop1b):
+	subxcc	%g2,%g4,%o4
+	ld	[s2_ptr+8],%g4
+	subxcc	%g3,%g1,%o5
+	ld	[s2_ptr+12],%g1
+	ldd	[s1_ptr+8],%g2
+	std	%o4,[res_ptr+0]
+	subxcc	%g2,%g4,%o4
+	ld	[s2_ptr+16],%g4
+	subxcc	%g3,%g1,%o5
+	ld	[s2_ptr+20],%g1
+	ldd	[s1_ptr+16],%g2
+	std	%o4,[res_ptr+8]
+	subxcc	%g2,%g4,%o4
+	ld	[s2_ptr+24],%g4
+	subxcc	%g3,%g1,%o5
+	ld	[s2_ptr+28],%g1
+	ldd	[s1_ptr+24],%g2
+	std	%o4,[res_ptr+16]
+	subxcc	%g2,%g4,%o4
+	ld	[s2_ptr+32],%g4
+	subxcc	%g3,%g1,%o5
+	ld	[s2_ptr+36],%g1
+	ldd	[s1_ptr+32],%g2
+	std	%o4,[res_ptr+24]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-8,n
+	add	s1_ptr,32,s1_ptr
+	add	s2_ptr,32,s2_ptr
+	add	res_ptr,32,res_ptr
+	bge	L(loop1b)
+	subcc	%g0,%o4,%g0		C restore cy
+
+L(fin1b):
+	addcc	n,8-2,n
+	blt	L(end1b)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add blocks of 2 limbs until less than 2 limbs remain
+L(loope1b):
+	subxcc	%g2,%g4,%o4
+	ld	[s2_ptr+8],%g4
+	subxcc	%g3,%g1,%o5
+	ld	[s2_ptr+12],%g1
+	ldd	[s1_ptr+8],%g2
+	std	%o4,[res_ptr+0]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-2,n
+	add	s1_ptr,8,s1_ptr
+	add	s2_ptr,8,s2_ptr
+	add	res_ptr,8,res_ptr
+	bge	L(loope1b)
+	subcc	%g0,%o4,%g0		C restore cy
+L(end1b):
+	subxcc	%g2,%g4,%o4
+	subxcc	%g3,%g1,%o5
+	std	%o4,[res_ptr+0]
+	addx	%g0,%g0,%o4		C save cy in register
+
+	andcc	n,1,%g0
+	be	L(ret1b)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add last limb
+	ld	[s2_ptr+8],%g4
+	ld	[s1_ptr+8],%g2
+	subxcc	%g2,%g4,%o4
+	st	%o4,[res_ptr+8]
+
+L(ret1b):
+	retl
+	addx	%g0,%g0,%o0		C return carry-out from most sign. limb
+
+C **  V2  **
+C If we come here, the alignment of s1_ptr and res_ptr as well as the
+C alignment of s2_ptr and res_ptr differ.  Since there are only two ways
+C things can be aligned (that we care about) we now know that the alignment
+C of s1_ptr and s2_ptr are the same.
+
+L(2):	cmp	n,1
+	be	L(jone)
+	nop
+	andcc	s1_ptr,4,%g0		C s1_ptr unaligned? Side effect: cy=0
+	be	L(v2)			C if no, branch
+	nop
+C Add least significant limb separately to align s1_ptr and s2_ptr
+	ld	[s1_ptr],%g4
+	add	s1_ptr,4,s1_ptr
+	ld	[s2_ptr],%g2
+	add	s2_ptr,4,s2_ptr
+	add	n,-1,n
+	subcc	%g4,%g2,%o4
+	st	%o4,[res_ptr]
+	add	res_ptr,4,res_ptr
+
+L(v2):	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-8,n
+	blt	L(fin2)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add blocks of 8 limbs until less than 8 limbs remain
+L(loop2):
+	ldd	[s1_ptr+0],%g2
+	ldd	[s2_ptr+0],%o4
+	subxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+0]
+	subxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+4]
+	ldd	[s1_ptr+8],%g2
+	ldd	[s2_ptr+8],%o4
+	subxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+8]
+	subxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+12]
+	ldd	[s1_ptr+16],%g2
+	ldd	[s2_ptr+16],%o4
+	subxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+16]
+	subxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+20]
+	ldd	[s1_ptr+24],%g2
+	ldd	[s2_ptr+24],%o4
+	subxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+24]
+	subxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+28]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-8,n
+	add	s1_ptr,32,s1_ptr
+	add	s2_ptr,32,s2_ptr
+	add	res_ptr,32,res_ptr
+	bge	L(loop2)
+	subcc	%g0,%o4,%g0		C restore cy
+
+L(fin2):
+	addcc	n,8-2,n
+	blt	L(end2)
+	subcc	%g0,%o4,%g0		C restore cy
+L(loope2):
+	ldd	[s1_ptr+0],%g2
+	ldd	[s2_ptr+0],%o4
+	subxcc	%g2,%o4,%g2
+	st	%g2,[res_ptr+0]
+	subxcc	%g3,%o5,%g3
+	st	%g3,[res_ptr+4]
+	addx	%g0,%g0,%o4		C save cy in register
+	addcc	n,-2,n
+	add	s1_ptr,8,s1_ptr
+	add	s2_ptr,8,s2_ptr
+	add	res_ptr,8,res_ptr
+	bge	L(loope2)
+	subcc	%g0,%o4,%g0		C restore cy
+L(end2):
+	andcc	n,1,%g0
+	be	L(ret2)
+	subcc	%g0,%o4,%g0		C restore cy
+C Add last limb
+L(jone):
+	ld	[s1_ptr],%g4
+	ld	[s2_ptr],%g2
+	subxcc	%g4,%g2,%o4
+	st	%o4,[res_ptr]
+
+L(ret2):
+	retl
+	addx	%g0,%g0,%o0		C return carry-out from most sign. limb
+EPILOGUE(mpn_sub_n)
diff --git a/src/gmp/mpn/sparc32/submul_1.asm b/src/gmp/mpn/sparc32/submul_1.asm
new file mode 100644
index 000000000..12abd844c
--- /dev/null
+++ b/src/gmp/mpn/sparc32/submul_1.asm
@@ -0,0 +1,146 @@
+dnl  SPARC mpn_submul_1 -- Multiply a limb vector with a limb and subtract
+dnl  the result from a second limb vector.
+
+dnl  Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	o0
+C s1_ptr	o1
+C size		o2
+C s2_limb	o3
+
+ASM_START()
+PROLOGUE(mpn_submul_1)
+	C Make S1_PTR and RES_PTR point at the end of their blocks
+	C and put (- 4 x SIZE) in index/loop counter.
+	sll	%o2,2,%o2
+	add	%o0,%o2,%o4	C RES_PTR in o4 since o0 is retval
+	add	%o1,%o2,%o1
+	sub	%g0,%o2,%o2
+
+	cmp	%o3,0xfff
+	bgu	L(large)
+	nop
+
+	ld	[%o1+%o2],%o5
+	mov	0,%o0
+	b	L(0)
+	 add	%o4,-4,%o4
+L(loop0):
+	subcc	%o5,%g1,%g1
+	ld	[%o1+%o2],%o5
+	addx	%o0,%g0,%o0
+	st	%g1,[%o4+%o2]
+L(0):	wr	%g0,%o3,%y
+	sra	%o5,31,%g2
+	and	%o3,%g2,%g2
+	andcc	%g1,0,%g1
+	mulscc	%g1,%o5,%g1
+ 	mulscc	%g1,%o5,%g1
+ 	mulscc	%g1,%o5,%g1
+ 	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,%o5,%g1
+	mulscc	%g1,0,%g1
+	sra	%g1,20,%g4
+	sll	%g1,12,%g1
+ 	rd	%y,%g3
+	srl	%g3,20,%g3
+	or	%g1,%g3,%g1
+
+	addcc	%g1,%o0,%g1
+	addx	%g2,%g4,%o0	C add sign-compensation and cy to hi limb
+	addcc	%o2,4,%o2	C loop counter
+	bne	L(loop0)
+	 ld	[%o4+%o2],%o5
+
+	subcc	%o5,%g1,%g1
+	addx	%o0,%g0,%o0
+	retl
+	st	%g1,[%o4+%o2]
+
+L(large):
+	ld	[%o1+%o2],%o5
+	mov	0,%o0
+	sra	%o3,31,%g4	C g4 = mask of ones iff S2_LIMB < 0
+	b	L(1)
+	 add	%o4,-4,%o4
+L(loop):
+	subcc	%o5,%g3,%g3
+	ld	[%o1+%o2],%o5
+	addx	%o0,%g0,%o0
+	st	%g3,[%o4+%o2]
+L(1):	wr	%g0,%o5,%y
+	and	%o5,%g4,%g2
+	andcc	%g0,%g0,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%o3,%g1
+	mulscc	%g1,%g0,%g1
+	rd	%y,%g3
+	addcc	%g3,%o0,%g3
+	addx	%g2,%g1,%o0
+	addcc	%o2,4,%o2
+	bne	L(loop)
+	 ld	[%o4+%o2],%o5
+
+	subcc	%o5,%g3,%g3
+	addx	%o0,%g0,%o0
+	retl
+	st	%g3,[%o4+%o2]
+EPILOGUE(mpn_submul_1)
diff --git a/src/gmp/mpn/sparc32/udiv_fp.asm b/src/gmp/mpn/sparc32/udiv_fp.asm
new file mode 100644
index 000000000..e340e147d
--- /dev/null
+++ b/src/gmp/mpn/sparc32/udiv_fp.asm
@@ -0,0 +1,158 @@
+dnl  SPARC v7 __udiv_qrnnd division support, used from longlong.h.
+dnl  This is for v7 CPUs with a floating-point unit.
+
+dnl  Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C rem_ptr	i0
+C n1		i1
+C n0		i2
+C d		i3
+
+ASM_START()
+
+ifdef(`PIC',
+`	TEXT
+L(getpc):
+	retl
+	nop')
+
+	TEXT
+	ALIGN(8)
+L(C0):	.double	0r4294967296
+L(C1):	.double	0r2147483648
+
+PROLOGUE(mpn_udiv_qrnnd)
+	save	%sp,-104,%sp
+	st	%i1,[%fp-8]
+	ld	[%fp-8],%f10
+
+ifdef(`PIC',
+`L(pc):	call	L(getpc)		C put address of this insn in %o7
+	ldd	[%o7+L(C0)-L(pc)],%f8',
+`	sethi	%hi(L(C0)),%o7
+	ldd	[%o7+%lo(L(C0))],%f8')
+
+	fitod	%f10,%f4
+	cmp	%i1,0
+	bge	L(248)
+	mov	%i0,%i5
+	faddd	%f4,%f8,%f4
+L(248):
+	st	%i2,[%fp-8]
+	ld	[%fp-8],%f10
+	fmuld	%f4,%f8,%f6
+	cmp	%i2,0
+	bge	L(249)
+	fitod	%f10,%f2
+	faddd	%f2,%f8,%f2
+L(249):
+	st	%i3,[%fp-8]
+	faddd	%f6,%f2,%f2
+	ld	[%fp-8],%f10
+	cmp	%i3,0
+	bge	L(250)
+	fitod	%f10,%f4
+	faddd	%f4,%f8,%f4
+L(250):
+	fdivd	%f2,%f4,%f2
+
+ifdef(`PIC',
+`	ldd	[%o7+L(C1)-L(pc)],%f4',
+`	sethi	%hi(L(C1)),%o7
+	ldd	[%o7+%lo(L(C1))],%f4')
+
+	fcmped	%f2,%f4
+	nop
+	fbge,a	L(251)
+	fsubd	%f2,%f4,%f2
+	fdtoi	%f2,%f2
+	st	%f2,[%fp-8]
+	b	L(252)
+	ld	[%fp-8],%i4
+L(251):
+	fdtoi	%f2,%f2
+	st	%f2,[%fp-8]
+	ld	[%fp-8],%i4
+	sethi	%hi(-2147483648),%g2
+	xor	%i4,%g2,%i4
+L(252):
+	wr	%g0,%i4,%y
+	sra	%i3,31,%g2
+	and	%i4,%g2,%g2
+	andcc	%g0,0,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,%i3,%g1
+	mulscc	%g1,0,%g1
+	add	%g1,%g2,%i0
+	rd	%y,%g3
+	subcc	%i2,%g3,%o7
+	subxcc	%i1,%i0,%g0
+	be	L(253)
+	cmp	%o7,%i3
+
+	add	%i4,-1,%i0
+	add	%o7,%i3,%o7
+	st	%o7,[%i5]
+	ret
+	restore
+L(253):
+	blu	L(246)
+	mov	%i4,%i0
+	add	%i4,1,%i0
+	sub	%o7,%i3,%o7
+L(246):
+	st	%o7,[%i5]
+	ret
+	restore
+EPILOGUE(mpn_udiv_qrnnd)
diff --git a/src/gmp/mpn/sparc32/udiv_nfp.asm b/src/gmp/mpn/sparc32/udiv_nfp.asm
new file mode 100644
index 000000000..ae19f4c6e
--- /dev/null
+++ b/src/gmp/mpn/sparc32/udiv_nfp.asm
@@ -0,0 +1,193 @@
+dnl  SPARC v7 __udiv_qrnnd division support, used from longlong.h.
+dnl  This is for v7 CPUs without a floating-point unit.
+
+dnl  Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+ 
+C INPUT PARAMETERS
+C rem_ptr	o0
+C n1		o1
+C n0		o2
+C d		o3
+
+ASM_START()
+PROLOGUE(mpn_udiv_qrnnd)
+	tst	%o3
+	bneg	L(largedivisor)
+	mov	8,%g1
+
+	b	L(p1)
+	addxcc	%o2,%o2,%o2
+
+L(plop):
+	bcc	L(n1)
+	addxcc	%o2,%o2,%o2
+L(p1):	addx	%o1,%o1,%o1
+	subcc	%o1,%o3,%o4
+	bcc	L(n2)
+	addxcc	%o2,%o2,%o2
+L(p2):	addx	%o1,%o1,%o1
+	subcc	%o1,%o3,%o4
+	bcc	L(n3)
+	addxcc	%o2,%o2,%o2
+L(p3):	addx	%o1,%o1,%o1
+	subcc	%o1,%o3,%o4
+	bcc	L(n4)
+	addxcc	%o2,%o2,%o2
+L(p4):	addx	%o1,%o1,%o1
+	addcc	%g1,-1,%g1
+	bne	L(plop)
+	subcc	%o1,%o3,%o4
+	bcc	L(n5)
+	addxcc	%o2,%o2,%o2
+L(p5):	st	%o1,[%o0]
+	retl
+	xnor	%g0,%o2,%o0
+
+L(nlop):
+	bcc	L(p1)
+	addxcc	%o2,%o2,%o2
+L(n1):	addx	%o4,%o4,%o4
+	subcc	%o4,%o3,%o1
+	bcc	L(p2)
+	addxcc	%o2,%o2,%o2
+L(n2):	addx	%o4,%o4,%o4
+	subcc	%o4,%o3,%o1
+	bcc	L(p3)
+	addxcc	%o2,%o2,%o2
+L(n3):	addx	%o4,%o4,%o4
+	subcc	%o4,%o3,%o1
+	bcc	L(p4)
+	addxcc	%o2,%o2,%o2
+L(n4):	addx	%o4,%o4,%o4
+	addcc	%g1,-1,%g1
+	bne	L(nlop)
+	subcc	%o4,%o3,%o1
+	bcc	L(p5)
+	addxcc	%o2,%o2,%o2
+L(n5):	st	%o4,[%o0]
+	retl
+	xnor	%g0,%o2,%o0
+
+L(largedivisor):
+	and	%o2,1,%o5	C %o5 = n0 & 1
+
+	srl	%o2,1,%o2
+	sll	%o1,31,%g2
+	or	%g2,%o2,%o2	C %o2 = lo(n1n0 >> 1)
+	srl	%o1,1,%o1	C %o1 = hi(n1n0 >> 1)
+
+	and	%o3,1,%g2
+	srl	%o3,1,%g3	C %g3 = floor(d / 2)
+	add	%g3,%g2,%g3	C %g3 = ceil(d / 2)
+
+	b	L(Lp1)
+	addxcc	%o2,%o2,%o2
+
+L(Lplop):
+	bcc	L(Ln1)
+	addxcc	%o2,%o2,%o2
+L(Lp1):	addx	%o1,%o1,%o1
+	subcc	%o1,%g3,%o4
+	bcc	L(Ln2)
+	addxcc	%o2,%o2,%o2
+L(Lp2):	addx	%o1,%o1,%o1
+	subcc	%o1,%g3,%o4
+	bcc	L(Ln3)
+	addxcc	%o2,%o2,%o2
+L(Lp3):	addx	%o1,%o1,%o1
+	subcc	%o1,%g3,%o4
+	bcc	L(Ln4)
+	addxcc	%o2,%o2,%o2
+L(Lp4):	addx	%o1,%o1,%o1
+	addcc	%g1,-1,%g1
+	bne	L(Lplop)
+	subcc	%o1,%g3,%o4
+	bcc	L(Ln5)
+	addxcc	%o2,%o2,%o2
+L(Lp5):	add	%o1,%o1,%o1	C << 1
+	tst	%g2
+	bne	L(oddp)
+	add	%o5,%o1,%o1
+	st	%o1,[%o0]
+	retl
+	xnor	%g0,%o2,%o0
+
+L(Lnlop):
+	bcc	L(Lp1)
+	addxcc	%o2,%o2,%o2
+L(Ln1):	addx	%o4,%o4,%o4
+	subcc	%o4,%g3,%o1
+	bcc	L(Lp2)
+	addxcc	%o2,%o2,%o2
+L(Ln2):	addx	%o4,%o4,%o4
+	subcc	%o4,%g3,%o1
+	bcc	L(Lp3)
+	addxcc	%o2,%o2,%o2
+L(Ln3):	addx	%o4,%o4,%o4
+	subcc	%o4,%g3,%o1
+	bcc	L(Lp4)
+	addxcc	%o2,%o2,%o2
+L(Ln4):	addx	%o4,%o4,%o4
+	addcc	%g1,-1,%g1
+	bne	L(Lnlop)
+	subcc	%o4,%g3,%o1
+	bcc	L(Lp5)
+	addxcc	%o2,%o2,%o2
+L(Ln5):	add	%o4,%o4,%o4	C << 1
+	tst	%g2
+	bne	L(oddn)
+	add	%o5,%o4,%o4
+	st	%o4,[%o0]
+	retl
+	xnor	%g0,%o2,%o0
+
+L(oddp):
+	xnor	%g0,%o2,%o2
+	C q' in %o2. r' in %o1
+	addcc	%o1,%o2,%o1
+	bcc	L(Lp6)
+	addx	%o2,0,%o2
+	sub	%o1,%o3,%o1
+L(Lp6):	subcc	%o1,%o3,%g0
+	bcs	L(Lp7)
+	subx	%o2,-1,%o2
+	sub	%o1,%o3,%o1
+L(Lp7):	st	%o1,[%o0]
+	retl
+	mov	%o2,%o0
+
+L(oddn):
+	xnor	%g0,%o2,%o2
+	C q' in %o2. r' in %o4
+	addcc	%o4,%o2,%o4
+	bcc	L(Ln6)
+	addx	%o2,0,%o2
+	sub	%o4,%o3,%o4
+L(Ln6):	subcc	%o4,%o3,%g0
+	bcs	L(Ln7)
+	subx	%o2,-1,%o2
+	sub	%o4,%o3,%o4
+L(Ln7):	st	%o4,[%o0]
+	retl
+	mov	%o2,%o0
+EPILOGUE(mpn_udiv_qrnnd)
diff --git a/src/gmp/mpn/sparc32/umul.asm b/src/gmp/mpn/sparc32/umul.asm
new file mode 100644
index 000000000..efa56851d
--- /dev/null
+++ b/src/gmp/mpn/sparc32/umul.asm
@@ -0,0 +1,68 @@
+dnl  SPARC mpn_umul_ppmm -- support for longlong.h for non-gcc.
+
+dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_umul_ppmm)
+	wr	%g0,%o1,%y
+	sra	%o2,31,%g2	C Don't move this insn
+	and	%o1,%g2,%g2	C Don't move this insn
+	andcc	%g0,0,%g1	C Don't move this insn
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,%o2,%g1
+	mulscc	%g1,0,%g1
+	rd	%y,%g3
+	st	%g3,[%o0]
+	retl
+	add	%g1,%g2,%o0
+EPILOGUE(mpn_umul_ppmm)
diff --git a/src/gmp/mpn/sparc32/v8/addmul_1.asm b/src/gmp/mpn/sparc32/v8/addmul_1.asm
new file mode 100644
index 000000000..da44644b5
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v8/addmul_1.asm
@@ -0,0 +1,122 @@
+dnl  SPARC v8 mpn_addmul_1 -- Multiply a limb vector with a limb and
+dnl  add the result to a second limb vector.
+
+dnl  Copyright (C) 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	o0
+C s1_ptr	o1
+C size		o2
+C s2_limb	o3
+
+ASM_START()
+PROLOGUE(mpn_addmul_1)
+	orcc	%g0,%g0,%g2
+	ld	[%o1+0],%o4	C 1
+
+	sll	%o2,4,%g1
+	and	%g1,(4-1)<<4,%g1
+ifdef(`PIC',
+`	mov	%o7,%g4		C Save return address register
+0:	call	1f
+	add	%o7,L(1)-0b,%g3
+1:	mov	%g4,%o7		C Restore return address register
+',
+`	sethi	%hi(L(1)),%g3
+	or	%g3,%lo(L(1)),%g3
+')
+	jmp	%g3+%g1
+	nop
+L(1):
+L(L00):	add	%o0,-4,%o0
+	b	L(loop00)	C 4, 8, 12, ...
+	add	%o1,-4,%o1
+	nop
+L(L01):	b	L(loop01)	C 1, 5, 9, ...
+	nop
+	nop
+	nop
+L(L10):	add	%o0,-12,%o0	C 2, 6, 10, ...
+	b	L(loop10)
+	add	%o1,4,%o1
+	nop
+L(L11):	add	%o0,-8,%o0	C 3, 7, 11, ...
+	b	L(loop11)
+	add	%o1,-8,%o1
+	nop
+
+L(loop):
+	addcc	%g3,%g2,%g3	C 1
+	ld	[%o1+4],%o4	C 2
+	rd	%y,%g2		C 1
+	addx	%g0,%g2,%g2
+	ld	[%o0+0],%g1	C 2
+	addcc	%g1,%g3,%g3
+	st	%g3,[%o0+0]	C 1
+L(loop00):
+	umul	%o4,%o3,%g3	C 2
+	ld	[%o0+4],%g1	C 2
+	addxcc	%g3,%g2,%g3	C 2
+	ld	[%o1+8],%o4	C 3
+	rd	%y,%g2		C 2
+	addx	%g0,%g2,%g2
+	nop
+	addcc	%g1,%g3,%g3
+	st	%g3,[%o0+4]	C 2
+L(loop11):
+	umul	%o4,%o3,%g3	C 3
+	addxcc	%g3,%g2,%g3	C 3
+	ld	[%o1+12],%o4	C 4
+	rd	%y,%g2		C 3
+	add	%o1,16,%o1
+	addx	%g0,%g2,%g2
+	ld	[%o0+8],%g1	C 2
+	addcc	%g1,%g3,%g3
+	st	%g3,[%o0+8]	C 3
+L(loop10):
+	umul	%o4,%o3,%g3	C 4
+	addxcc	%g3,%g2,%g3	C 4
+	ld	[%o1+0],%o4	C 1
+	rd	%y,%g2		C 4
+	addx	%g0,%g2,%g2
+	ld	[%o0+12],%g1	C 2
+	addcc	%g1,%g3,%g3
+	st	%g3,[%o0+12]	C 4
+	add	%o0,16,%o0
+	addx	%g0,%g2,%g2
+L(loop01):
+	addcc	%o2,-4,%o2
+	bg	L(loop)
+	umul	%o4,%o3,%g3	C 1
+
+	addcc	%g3,%g2,%g3	C 4
+	rd	%y,%g2		C 4
+	addx	%g0,%g2,%g2
+	ld	[%o0+0],%g1	C 2
+	addcc	%g1,%g3,%g3
+	st	%g3,[%o0+0]	C 4
+	addx	%g0,%g2,%o0
+
+	retl
+	 nop
+EPILOGUE(mpn_addmul_1)
diff --git a/src/gmp/mpn/sparc32/v8/mul_1.asm b/src/gmp/mpn/sparc32/v8/mul_1.asm
new file mode 100644
index 000000000..801247553
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v8/mul_1.asm
@@ -0,0 +1,103 @@
+dnl  SPARC v8 mpn_mul_1 -- Multiply a limb vector with a single limb and
+dnl  store the product in a second limb vector.
+
+dnl  Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	o0
+C s1_ptr	o1
+C size		o2
+C s2_limb	o3
+
+ASM_START()
+PROLOGUE(mpn_mul_1)
+	sll	%o2,4,%g1
+	and	%g1,(4-1)<<4,%g1
+ifdef(`PIC',
+`	mov	%o7,%g4		C Save return address register
+0:	call	1f
+	add	%o7,L(1)-0b,%g3
+1:	mov	%g4,%o7		C Restore return address register
+',
+`	sethi	%hi(L(1)),%g3
+	or	%g3,%lo(L(1)),%g3
+')
+	jmp	%g3+%g1
+	ld	[%o1+0],%o4	C 1
+L(1):
+L(L00):	add	%o0,-4,%o0
+	add	%o1,-4,%o1
+	b	L(loop00)	C 4, 8, 12, ...
+	orcc	%g0,%g0,%g2
+L(L01):	b	L(loop01)	C 1, 5, 9, ...
+	orcc	%g0,%g0,%g2
+	nop
+	nop
+L(L10):	add	%o0,-12,%o0	C 2, 6, 10, ...
+	add	%o1,4,%o1
+	b	L(loop10)
+	orcc	%g0,%g0,%g2
+	nop
+L(L11):	add	%o0,-8,%o0	C 3, 7, 11, ...
+	add	%o1,-8,%o1
+	b	L(loop11)
+	orcc	%g0,%g0,%g2
+
+L(loop):
+	addcc	%g3,%g2,%g3	C 1
+	ld	[%o1+4],%o4	C 2
+	st	%g3,[%o0+0]	C 1
+	rd	%y,%g2		C 1
+L(loop00):
+	umul	%o4,%o3,%g3	C 2
+	addxcc	%g3,%g2,%g3	C 2
+	ld	[%o1+8],%o4	C 3
+	st	%g3,[%o0+4]	C 2
+	rd	%y,%g2		C 2
+L(loop11):
+	umul	%o4,%o3,%g3	C 3
+	addxcc	%g3,%g2,%g3	C 3
+	ld	[%o1+12],%o4	C 4
+	add	%o1,16,%o1
+	st	%g3,[%o0+8]	C 3
+	rd	%y,%g2		C 3
+L(loop10):
+	umul	%o4,%o3,%g3	C 4
+	addxcc	%g3,%g2,%g3	C 4
+	ld	[%o1+0],%o4	C 1
+	st	%g3,[%o0+12]	C 4
+	add	%o0,16,%o0
+	rd	%y,%g2		C 4
+	addx	%g0,%g2,%g2
+L(loop01):
+	addcc	%o2,-4,%o2
+	bg	L(loop)
+	umul	%o4,%o3,%g3	C 1
+
+	addcc	%g3,%g2,%g3	C 4
+	st	%g3,[%o0+0]	C 4
+	rd	%y,%g2		C 4
+
+	retl
+	addx	%g0,%g2,%o0
+EPILOGUE(mpn_mul_1)
diff --git a/src/gmp/mpn/sparc32/v8/submul_1.asm b/src/gmp/mpn/sparc32/v8/submul_1.asm
new file mode 100644
index 000000000..9ed132f4c
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v8/submul_1.asm
@@ -0,0 +1,58 @@
+dnl  SPARC v8 mpn_submul_1 -- Multiply a limb vector with a limb and
+dnl  subtract the result from a second limb vector.
+
+dnl  Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	o0
+C s1_ptr	o1
+C size		o2
+C s2_limb	o3
+
+ASM_START()
+PROLOGUE(mpn_submul_1)
+	sub	%g0,%o2,%o2		C negate ...
+	sll	%o2,2,%o2		C ... and scale size
+	sub	%o1,%o2,%o1		C o1 is offset s1_ptr
+	sub	%o0,%o2,%g1		C g1 is offset res_ptr
+
+	mov	0,%o0			C clear cy_limb
+
+L(loop):
+	ld	[%o1+%o2],%o4
+	ld	[%g1+%o2],%g2
+	umul	%o4,%o3,%o5
+	rd	%y,%g3
+	addcc	%o5,%o0,%o5
+	addx	%g3,0,%o0
+	subcc	%g2,%o5,%g2
+	addx	%o0,0,%o0
+	st	%g2,[%g1+%o2]
+
+	addcc	%o2,4,%o2
+	bne	L(loop)
+	 nop
+
+	retl
+	 nop
+EPILOGUE(mpn_submul_1)
diff --git a/src/gmp/mpn/sparc32/v8/supersparc/udiv.asm b/src/gmp/mpn/sparc32/v8/supersparc/udiv.asm
new file mode 100644
index 000000000..0d5e8d415
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v8/supersparc/udiv.asm
@@ -0,0 +1,122 @@
+dnl  SuperSPARC mpn_udiv_qrnnd division support, used from longlong.h.
+dnl  This is for SuperSPARC only, to compensate for its semi-functional
+dnl  udiv instruction.
+
+dnl  Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C rem_ptr	i0
+C n1		i1
+C n0		i2
+C d		i3
+
+ASM_START()
+
+ifdef(`PIC',
+`	TEXT
+L(getpc):
+	retl
+	nop')
+
+	TEXT
+	ALIGN(8)
+L(C0):	.double	0r4294967296
+L(C1):	.double	0r2147483648
+
+PROLOGUE(mpn_udiv_qrnnd)
+	save	%sp,-104,%sp
+	st	%i1,[%fp-8]
+	ld	[%fp-8],%f10
+
+ifdef(`PIC',
+`L(pc):	call	L(getpc)		C put address of this insn in %o7
+	ldd	[%o7+L(C0)-L(pc)],%f8',
+`	sethi	%hi(L(C0)),%o7
+	ldd	[%o7+%lo(L(C0))],%f8')
+
+	fitod	%f10,%f4
+	cmp	%i1,0
+	bge	L(248)
+	mov	%i0,%i5
+	faddd	%f4,%f8,%f4
+L(248):
+	st	%i2,[%fp-8]
+	ld	[%fp-8],%f10
+	fmuld	%f4,%f8,%f6
+	cmp	%i2,0
+	bge	L(249)
+	fitod	%f10,%f2
+	faddd	%f2,%f8,%f2
+L(249):
+	st	%i3,[%fp-8]
+	faddd	%f6,%f2,%f2
+	ld	[%fp-8],%f10
+	cmp	%i3,0
+	bge	L(250)
+	fitod	%f10,%f4
+	faddd	%f4,%f8,%f4
+L(250):
+	fdivd	%f2,%f4,%f2
+
+ifdef(`PIC',
+`	ldd	[%o7+L(C1)-L(pc)],%f4',
+`	sethi	%hi(L(C1)),%o7
+	ldd	[%o7+%lo(L(C1))],%f4')
+
+	fcmped	%f2,%f4
+	nop
+	fbge,a	L(251)
+	fsubd	%f2,%f4,%f2
+	fdtoi	%f2,%f2
+	st	%f2,[%fp-8]
+	b	L(252)
+	ld	[%fp-8],%i4
+L(251):
+	fdtoi	%f2,%f2
+	st	%f2,[%fp-8]
+	ld	[%fp-8],%i4
+	sethi	%hi(-2147483648),%g2
+	xor	%i4,%g2,%i4
+L(252):
+	umul	%i3,%i4,%g3
+	rd	%y,%i0
+	subcc	%i2,%g3,%o7
+	subxcc	%i1,%i0,%g0
+	be	L(253)
+	cmp	%o7,%i3
+
+	add	%i4,-1,%i0
+	add	%o7,%i3,%o7
+	st	%o7,[%i5]
+	ret
+	restore
+L(253):
+	blu	L(246)
+	mov	%i4,%i0
+	add	%i4,1,%i0
+	sub	%o7,%i3,%o7
+L(246):
+	st	%o7,[%i5]
+	ret
+	restore
+EPILOGUE(mpn_udiv_qrnnd)
diff --git a/src/gmp/mpn/sparc32/v8/umul.asm b/src/gmp/mpn/sparc32/v8/umul.asm
new file mode 100644
index 000000000..ae8f692a0
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v8/umul.asm
@@ -0,0 +1,31 @@
+dnl  SPARC v8 mpn_umul_ppmm -- support for longlong.h for non-gcc.
+
+dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+ASM_START()
+PROLOGUE(mpn_umul_ppmm)
+	umul %o1,%o2,%g2
+	st %g2,[%o0]
+	retl
+	rd %y,%o0
+EPILOGUE(mpn_umul_ppmm)
diff --git a/src/gmp/mpn/sparc32/v9/README b/src/gmp/mpn/sparc32/v9/README
new file mode 100644
index 000000000..9b3971327
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v9/README
@@ -0,0 +1,4 @@
+Code for SPARC processors implementing version 9 of the SPARC architecture.
+This code is for systems that doesn't preserve the full 64-bit contents of
+integer register at context switch.  For other systems (such as Solaris 7 or
+later) use the code in ../../sparc64.
diff --git a/src/gmp/mpn/sparc32/v9/addmul_1.asm b/src/gmp/mpn/sparc32/v9/addmul_1.asm
new file mode 100644
index 000000000..c1762cc41
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v9/addmul_1.asm
@@ -0,0 +1,288 @@
+dnl  SPARC v9 32-bit mpn_addmul_1 -- Multiply a limb vector with a limb and
+dnl  add the result to a second limb vector.
+
+dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	i0
+C s1_ptr	i1
+C size		i2
+C s2_limb	i3
+
+ASM_START()
+
+	TEXT
+	ALIGN(4)
+L(noll):
+	.word	0
+
+PROLOGUE(mpn_addmul_1)
+	save %sp,-256,%sp
+
+ifdef(`PIC',
+`L(pc):	rd	%pc,%o7
+	ld	[%o7+L(noll)-L(pc)],%f10',
+`	sethi	%hi(L(noll)),%g1
+	ld	[%g1+%lo(L(noll))],%f10')
+
+	sethi	%hi(0xffff0000),%o0
+	andn	%i3,%o0,%o0
+	st	%o0,[%fp-16]
+	ld	[%fp-16],%f11
+	fxtod	%f10,%f6
+
+	srl	%i3,16,%o0
+	st	%o0,[%fp-16]
+	ld	[%fp-16],%f11
+	fxtod	%f10,%f8
+
+	mov	0,%g3			C cy = 0
+
+	ld	[%i1],%f11
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end1)
+	add	%i1,4,%i1		C s1_ptr++
+
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end2)
+	std	%f12,[%fp-16]
+
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end3)
+	std	%f12,[%fp-32]
+
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	ld	[%i0],%g5
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	add	%i0,4,%i0		C res_ptr++
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end4)
+	std	%f12,[%fp-16]
+
+	b,a	L(loopm)
+
+	.align 16
+C BEGIN LOOP
+L(loop):
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-16]
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(loope)
+	add	%i0,4,%i0		C res_ptr++
+L(loopm):
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-32],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-32]
+	subcc	%i2,1,%i2
+	bne,pt	%icc,L(loop)
+	add	%i0,4,%i0		C res_ptr++
+C END LOOP
+
+	fxtod	%f10,%f2
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	b,a	L(xxx)
+L(loope):
+L(end4):
+	fxtod	%f10,%f2
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-32],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-32]
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	b,a	L(yyy)
+
+L(end3):
+	fxtod	%f10,%f2
+	ld	[%i0],%g5
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+L(xxx):	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-16]
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	ldx	[%fp-32],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+	b,a	L(ret)
+
+L(end2):
+	fxtod	%f10,%f2
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-32]
+	ld	[%i0],%g5
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+L(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	ldx	[%fp-32],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+	b,a	L(ret)
+
+L(end1):
+	fxtod	%f10,%f2
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-16]
+
+	ld	[%i0],%g5
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+L(ret):	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	st	%g4,[%i0-4]
+
+	ret
+	restore %g0,%g3,%o0		C sideeffect: put cy in retreg
+EPILOGUE(mpn_addmul_1)
diff --git a/src/gmp/mpn/sparc32/v9/gmp-mparam.h b/src/gmp/mpn/sparc32/v9/gmp-mparam.h
new file mode 100644
index 000000000..f946b900f
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v9/gmp-mparam.h
@@ -0,0 +1,69 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+
+/* These values are for UltraSPARC I, II, and IIi.  It is bogus that
+   this file lives in v9, but that will do for now.  */
+
+/* Variations in addmul_1 speed make the multiply and square thresholds
+   doubtful.  TOOM3_SQR_THRESHOLD had to be estimated here.  */
+
+/* Generated by tuneup.c, 2000-07-06. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   30
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD      200
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   59
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD      500
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD             107
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD            146
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            29
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        4
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD           3
+#endif
diff --git a/src/gmp/mpn/sparc32/v9/mul_1.asm b/src/gmp/mpn/sparc32/v9/mul_1.asm
new file mode 100644
index 000000000..f8f0fdd8c
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v9/mul_1.asm
@@ -0,0 +1,267 @@
+dnl  SPARC v9 32-bit mpn_mul_1 -- Multiply a limb vector with a limb and
+dnl  store the result in a second limb vector.
+
+dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	i0
+C s1_ptr	i1
+C size		i2
+C s2_limb	i3
+
+ASM_START()
+
+	TEXT
+	ALIGN(4)
+L(noll):
+	.word	0
+
+PROLOGUE(mpn_mul_1)
+	save %sp,-256,%sp
+
+ifdef(`PIC',
+`L(pc):	rd	%pc,%o7
+	ld	[%o7+L(noll)-L(pc)],%f10',
+`	sethi	%hi(L(noll)),%g1
+	ld	[%g1+%lo(L(noll))],%f10')
+
+	sethi	%hi(0xffff0000),%o0
+	andn	%i3,%o0,%o0
+	st	%o0,[%fp-16]
+	ld	[%fp-16],%f11
+	fxtod	%f10,%f6
+
+	srl	%i3,16,%o0
+	st	%o0,[%fp-16]
+	ld	[%fp-16],%f11
+	fxtod	%f10,%f8
+
+	mov	0,%g3			C cy = 0
+
+	ld	[%i1],%f11
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end1)
+	add	%i1,4,%i1		C s1_ptr++
+
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end2)
+	std	%f12,[%fp-16]
+
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end3)
+	std	%f12,[%fp-32]
+
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	add	%i0,4,%i0		C res_ptr++
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end4)
+	std	%f12,[%fp-16]
+
+	b,a	L(loopm)
+
+	.align 16
+C BEGIN LOOP
+L(loop):
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-16]
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(loope)
+	add	%i0,4,%i0		C res_ptr++
+L(loopm):
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-32],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-32]
+	subcc	%i2,1,%i2
+	bne,pt	%icc,L(loop)
+	add	%i0,4,%i0		C res_ptr++
+C END LOOP
+
+	fxtod	%f10,%f2
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	b,a	L(xxx)
+L(loope):
+L(end4):
+	fxtod	%f10,%f2
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-32],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-32]
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	b,a	L(yyy)
+
+L(end3):
+	fxtod	%f10,%f2
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+L(xxx):	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-16]
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	ldx	[%fp-32],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+	b,a	L(ret)
+
+L(end2):
+	fxtod	%f10,%f2
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-32]
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+L(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	ldx	[%fp-32],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+	b,a	L(ret)
+
+L(end1):
+	fxtod	%f10,%f2
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-16]
+
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+L(ret):	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	st	%g4,[%i0-4]
+
+	ret
+	restore %g0,%g3,%o0		C sideeffect: put cy in retreg
+EPILOGUE(mpn_mul_1)
diff --git a/src/gmp/mpn/sparc32/v9/submul_1.asm b/src/gmp/mpn/sparc32/v9/submul_1.asm
new file mode 100644
index 000000000..6195ea88e
--- /dev/null
+++ b/src/gmp/mpn/sparc32/v9/submul_1.asm
@@ -0,0 +1,291 @@
+dnl  SPARC v9 32-bit mpn_submul_1 -- Multiply a limb vector with a limb and
+dnl  subtract the result from a second limb vector.
+
+dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	i0
+C s1_ptr	i1
+C size		i2
+C s2_limb	i3
+
+ASM_START()
+
+	TEXT
+	ALIGN(4)
+L(noll):
+	.word	0
+
+PROLOGUE(mpn_submul_1)
+	save %sp,-256,%sp
+
+ifdef(`PIC',
+`L(pc):	rd	%pc,%o7
+	ld	[%o7+L(noll)-L(pc)],%f10',
+`	sethi	%hi(L(noll)),%g1
+	ld	[%g1+%lo(L(noll))],%f10')
+
+	sethi	%hi(0xffff0000),%o0
+	andn	%i3,%o0,%o0
+	st	%o0,[%fp-16]
+	ld	[%fp-16],%f11
+	fxtod	%f10,%f6
+
+	srl	%i3,16,%o0
+	st	%o0,[%fp-16]
+	ld	[%fp-16],%f11
+	fxtod	%f10,%f8
+
+	mov	0,%g3			C cy = 0
+
+	ld	[%i1],%f11
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end1)
+	add	%i1,4,%i1		C s1_ptr++
+
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end2)
+	std	%f12,[%fp-16]
+
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end3)
+	std	%f12,[%fp-32]
+
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	ld	[%i0],%g5
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	add	%i0,4,%i0		C res_ptr++
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(end4)
+	std	%f12,[%fp-16]
+
+	b,a	L(loopm)
+
+	.align 16
+C BEGIN LOOP
+L(loop):
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g3,%g1,%g4		C p += cy
+	subcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4]
+	addx	%g3,0,%g3
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-16]
+	subcc	%i2,1,%i2
+	be,pn	%icc,L(loope)
+	add	%i0,4,%i0		C res_ptr++
+L(loopm):
+	fxtod	%f10,%f2
+	ld	[%i1],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g3,%g1,%g4		C p += cy
+	subcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-32],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4]
+	addx	%g3,0,%g3
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-32]
+	subcc	%i2,1,%i2
+	bne,pt	%icc,L(loop)
+	add	%i0,4,%i0		C res_ptr++
+C END LOOP
+
+	fxtod	%f10,%f2
+	add	%g3,%g1,%g4		C p += cy
+	subcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4]
+	b,a	L(xxx)
+L(loope):
+L(end4):
+	fxtod	%f10,%f2
+	add	%g3,%g1,%g4		C p += cy
+	subcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-32],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-32]
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4]
+	b,a	L(yyy)
+
+L(end3):
+	fxtod	%f10,%f2
+	ld	[%i0],%g5
+	ldx	[%fp-24],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-16],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+L(xxx):	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-16]
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	ldx	[%fp-32],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+	b,a	L(ret)
+
+L(end2):
+	fxtod	%f10,%f2
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-40]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-32]
+	ld	[%i0],%g5
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+L(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-40],%g2		C p16
+	ldx	[%fp-32],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+	b,a	L(ret)
+
+L(end1):
+	fxtod	%f10,%f2
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-24]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-16]
+
+	ld	[%i0],%g5
+	ldx	[%fp-24],%g2		C p16
+	ldx	[%fp-16],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+L(ret):	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	srlx	%g4,32,%g3
+	st	%l2,[%i0-4]
+
+	addx	%g3,%g0,%g3
+	ret
+	restore %g0,%g3,%o0		C sideeffect: put cy in retreg
+EPILOGUE(mpn_submul_1)
diff --git a/src/gmp/mpn/sparc64/README b/src/gmp/mpn/sparc64/README
new file mode 100644
index 000000000..6923a133f
--- /dev/null
+++ b/src/gmp/mpn/sparc64/README
@@ -0,0 +1,48 @@
+This directory contains mpn functions for 64-bit V9 SPARC
+
+RELEVANT OPTIMIZATION ISSUES
+
+The Ultra I/II pipeline executes up to two simple integer arithmetic operations
+per cycle.  The 64-bit integer multiply instruction mulx takes from 5 cycles to
+35 cycles, depending on the position of the most significant bit of the 1st
+source operand.  It cannot overlap with other instructions.  For our use of
+mulx, it will take from 5 to 20 cycles.
+
+Integer conditional move instructions cannot dual-issue with other integer
+instructions.  No conditional move can issue 1-5 cycles after a load.  (Or
+something such bizzare.)
+
+Integer branches can issue with two integer arithmetic instructions.  Likewise
+for integer loads.  Four instructions may issue (arith, arith, ld/st, branch)
+but only if the branch is last.
+
+(The V9 architecture manual recommends that the 2nd operand of a multiply
+instruction be the smaller one.  For UltraSPARC, they got things backwards and
+optimize for the wrong operand!  Really helpful in the light of that multiply
+is incredibly slow on these CPUs!)
+
+STATUS
+
+There is new code in ~/prec/gmp-remote/sparc64.  Not tested or completed, but
+the pipelines are worked out.  Here are the timings:
+
+* lshift, rshift: The code is well-optimized and runs at 2.0 cycles/limb.
+
+* add_n, sub_n: add3.s currently runs at 6 cycles/limb.  We use a bizarre
+  scheme of compares and branches (with some nops and fnops to align things)
+  and carefully stay away from the instructions intended for this application
+  (i.e., movcs and movcc).
+
+  Using movcc/movcs, even with deep unrolling, seems to get down to 7
+  cycles/limb.
+
+  The most promising approach is to split operands in 32-bit pieces using
+  srlx, then use two addccc, and finally compile the results with sllx+or.
+  The result could run at 5 cycles/limb, I think.  It might be possible to
+  do without unrolling, or with minimal unrolling.
+
+* addmul_1/submul_1: Should optimize for when scalar operand < 2^32.
+* addmul_1/submul_1: Since mulx is horrendously slow on UltraSPARC I/II,
+  Karatsuba's method should save up to 16 cycles (i.e. > 20%).
+* mul_1 (and possibly the other multiply functions): Handle carry in the
+  same tricky way as add_n,sub_n.
diff --git a/src/gmp/mpn/sparc64/add_n.asm b/src/gmp/mpn/sparc64/add_n.asm
new file mode 100644
index 000000000..72b3895a5
--- /dev/null
+++ b/src/gmp/mpn/sparc64/add_n.asm
@@ -0,0 +1,172 @@
+! SPARC v9 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+! sum in a third limb vector.
+
+! Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	%o0
+! s1_ptr	%o1
+! s2_ptr	%o2
+! size		%o3
+
+include(`../config.m4')
+
+ASM_START()
+	.register	%g2,#scratch
+	.register	%g3,#scratch
+PROLOGUE(mpn_add_n)
+
+! 12 mem ops >= 12 cycles
+! 8 shift insn >= 8 cycles
+! 8 addccc, executing alone, +8 cycles
+! Unrolling not mandatory...perhaps 2-way is best?
+! Put one ldx/stx and one s?lx per issue tuple, fill with pointer arith and loop ctl
+! All in all, it runs at 5 cycles/limb
+
+	save	%sp,-160,%sp
+
+	addcc	%g0,%g0,%g0
+
+	add	%i3,-4,%i3
+	brlz,pn	%i3,L(there)
+	nop
+
+	ldx	[%i1+0],%l0
+	ldx	[%i2+0],%l4
+	ldx	[%i1+8],%l1
+	ldx	[%i2+8],%l5
+	ldx	[%i1+16],%l2
+	ldx	[%i2+16],%l6
+	ldx	[%i1+24],%l3
+	ldx	[%i2+24],%l7
+	add	%i1,32,%i1
+	add	%i2,32,%i2
+
+	add	%i3,-4,%i3
+	brlz,pn	%i3,L(skip)
+	nop
+	b	L(loop1)	! jump instead of executing many NOPs
+	nop
+	ALIGN(32)
+!---------  Start main loop ---------
+L(loop1):
+	addccc	%l0,%l4,%g1
+!-
+	srlx	%l0,32,%o0
+	ldx	[%i1+0],%l0
+!-
+	srlx	%l4,32,%o4
+	ldx	[%i2+0],%l4
+!-
+	addccc	%o0,%o4,%g0
+!-
+	addccc	%l1,%l5,%g2
+!-
+	srlx	%l1,32,%o1
+	ldx	[%i1+8],%l1
+!-
+	srlx	%l5,32,%o5
+	ldx	[%i2+8],%l5
+!-
+	addccc	%o1,%o5,%g0
+!-
+	addccc	%l2,%l6,%g3
+!-
+	srlx	%l2,32,%o2
+	ldx	[%i1+16],%l2
+!-
+	srlx	%l6,32,%g5	! asymmetry
+	ldx	[%i2+16],%l6
+!-
+	addccc	%o2,%g5,%g0
+!-
+	addccc	%l3,%l7,%g4
+!-
+	srlx	%l3,32,%o3
+	ldx	[%i1+24],%l3
+	add	%i1,32,%i1
+!-
+	srlx	%l7,32,%o7
+	ldx	[%i2+24],%l7
+	add	%i2,32,%i2
+!-
+	addccc	%o3,%o7,%g0
+!-
+	stx	%g1,[%i0+0]
+!-
+	stx	%g2,[%i0+8]
+!-
+	stx	%g3,[%i0+16]
+	add	%i3,-4,%i3
+!-
+	stx	%g4,[%i0+24]
+	add	%i0,32,%i0
+
+	brgez,pt	%i3,L(loop1)
+	nop
+!---------  End main loop ---------
+L(skip):
+	addccc	%l0,%l4,%g1
+	srlx	%l0,32,%o0
+	srlx	%l4,32,%o4
+	addccc	%o0,%o4,%g0
+	addccc	%l1,%l5,%g2
+	srlx	%l1,32,%o1
+	srlx	%l5,32,%o5
+	addccc	%o1,%o5,%g0
+	addccc	%l2,%l6,%g3
+	srlx	%l2,32,%o2
+	srlx	%l6,32,%g5	! asymmetry
+	addccc	%o2,%g5,%g0
+	addccc	%l3,%l7,%g4
+	srlx	%l3,32,%o3
+	srlx	%l7,32,%o7
+	addccc	%o3,%o7,%g0
+	stx	%g1,[%i0+0]
+	stx	%g2,[%i0+8]
+	stx	%g3,[%i0+16]
+	stx	%g4,[%i0+24]
+	add	%i0,32,%i0
+
+L(there):
+	add	%i3,4,%i3
+	brz,pt	%i3,L(end)
+	nop
+
+L(loop2):
+	ldx	[%i1+0],%l0
+	add	%i1,8,%i1
+	ldx	[%i2+0],%l4
+	add	%i2,8,%i2
+	srlx	%l0,32,%g2
+	srlx	%l4,32,%g3
+	addccc	%l0,%l4,%g1
+	addccc	%g2,%g3,%g0
+	stx	%g1,[%i0+0]
+	add	%i0,8,%i0
+	add	%i3,-1,%i3
+	brgz,pt	%i3,L(loop2)
+	nop
+
+L(end):	addc	%g0,%g0,%i0
+	ret
+	restore
+EPILOGUE(mpn_add_n)
diff --git a/src/gmp/mpn/sparc64/addmul1h.asm b/src/gmp/mpn/sparc64/addmul1h.asm
new file mode 100644
index 000000000..96cb5f736
--- /dev/null
+++ b/src/gmp/mpn/sparc64/addmul1h.asm
@@ -0,0 +1,203 @@
+dnl  SPARC 64-bit addmull/addmulu -- Helper for mpn_addmul_1 and mpn_mul_1.
+
+dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+ifdef(`LOWPART',
+`addmull:',
+`addmulu:')
+	save %sp,-256,%sp
+
+	sethi	%hi(0xffff0000),%o0
+	andn	%i3,%o0,%o0
+	st	%o0,[%fp-17]
+	ld	[%fp-17],%f11
+	fxtod	%f10,%f6
+
+	srl	%i3,16,%o0
+	st	%o0,[%fp-17]
+	ld	[%fp-17],%f11
+	fxtod	%f10,%f8
+
+	mov	0,%g3			C cy = 0
+
+	ld	[%i1+4],%f11
+	subcc	%i2,1,%i2
+dnl	be,pn	%icc,E(end1)
+	add	%i1,4,%i1		C s1_ptr++
+
+	fxtod	%f10,%f2
+	ld	[%i1-4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-25]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+	be,pn	%icc,E(end2)
+	std	%f12,[%fp-17]
+
+	fxtod	%f10,%f2
+	ld	[%i1+4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+dnl	be,pn	%icc,E(end3)
+	std	%f12,[%fp-33]
+
+	fxtod	%f10,%f2
+	ld	[%i1-4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	ld	[%i0+DLO],%g5
+	ldx	[%fp-25],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-17],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-25]
+	fdtox	%f4,%f12
+	add	%i0,4,%i0		C res_ptr++
+	subcc	%i2,1,%i2
+	be,pn	%icc,E(end4)
+	std	%f12,[%fp-17]
+
+	b,a	E(loop)
+	nop				C nop is cheap to nullify
+
+	ALIGN(16)
+C BEGIN LOOP
+E(loop):
+	fxtod	%f10,%f2
+	ld	[%i1+4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0+DHI],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-41],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-33],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DLO]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-33]
+	sub	%i2,2,%i2
+	add	%i0,4,%i0		C res_ptr++
+
+	fxtod	%f10,%f2
+	ld	[%i1-4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0+DLO],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-25],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-17],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DHI]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-25]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-17]
+	brnz,pt	%i2,E(loop)
+	add	%i0,4,%i0		C res_ptr++
+C END LOOP
+E(loope):
+E(end4):
+	fxtod	%f10,%f2
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0+DHI],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-41],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-33],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DLO]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-33]
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+	ld	[%i0+DLO],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-25],%g2		C p16
+	ldx	[%fp-17],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DHI]
+	b,a	E(yyy)
+
+E(end2):
+	fxtod	%f10,%f2
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-33]
+	ld	[%i0+DLO],%g5
+	ldx	[%fp-25],%g2		C p16
+	ldx	[%fp-17],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+E(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+ifdef(`LOWPART',
+`	ld	[%i0+DHI],%g5')
+	srlx	%g4,32,%g3
+	ldx	[%fp-41],%g2		C p16
+	ldx	[%fp-33],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DLO]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+ifdef(`LOWPART',
+`	add	%g5,%g1,%g1')		C add *res_ptr to p0 (ADD2)
+	add	%g3,%g1,%g4		C p += cy
+ifdef(`LOWPART',
+`	st	%g4,[%i0-4+DHI]
+	srlx	%g4,32,%g4')
+
+	ret
+	restore %g0,%g4,%o0		C sideeffect: put cy in retreg
+ifdef(`LOWPART',
+`EPILOGUE(addmull)',
+`EPILOGUE(addmulu)')
diff --git a/src/gmp/mpn/sparc64/addmul_1.asm b/src/gmp/mpn/sparc64/addmul_1.asm
new file mode 100644
index 000000000..c3f04cea6
--- /dev/null
+++ b/src/gmp/mpn/sparc64/addmul_1.asm
@@ -0,0 +1,114 @@
+dnl  SPARC 64-bit mpn_addmul_1 -- Multiply a limb vector with a limb and
+dnl  add the result to a second limb vector.
+
+dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	i0
+C s1_ptr	i1
+C size		i2
+C s2_limb	i3
+
+ASM_START()
+	.register	%g2,#scratch
+	.register	%g3,#scratch
+
+PROLOGUE(mpn_addmul_1)
+	save	%sp,-256,%sp
+
+C We store 0.0 in f10 and keep it invariant accross thw two
+C function calls below.  Note that this is not ABI conformant,
+C but since the functions are local, that's acceptable.
+ifdef(`PIC',
+`L(pc):	rd	%pc,%o7
+	ld	[%o7+L(noll)-L(pc)],%f10',
+`	sethi	%hh(L(noll)),%g2
+	sethi	%lm(L(noll)),%g1
+	or	%g2,%hm(L(noll)),%g2
+	or	%g1,%lo(L(noll)),%g1
+	sllx	%g2,32,%g2
+	ld	[%g1+%g2],%f10')
+
+	sub	%i1,%i0,%g1
+	srlx	%g1,3,%g1
+	cmp	%g1,%i2
+	bcc,pt	%xcc,L(nooverlap)
+	nop
+
+	sllx	%i2,3,%g2		C compute stack allocation byte count
+	add	%g2,15,%o0
+	and	%o0,-16,%o0
+	sub	%sp,%o0,%sp
+	add	%sp,2223,%o0
+
+	mov	%i1,%o1			C copy s1_ptr to mpn_copyi's srcp
+	call	mpn_copyi
+	mov	%i2,%o2			C copy n to mpn_copyi's count parameter
+
+	add	%sp,2223,%i1
+
+L(nooverlap):
+C First multiply-add with low 32 bits of s2_limb
+	mov	%i0,%o0
+	mov	%i1,%o1
+	add	%i2,%i2,%o2
+	call	addmull
+	srl	%i3,0,%o3
+
+	mov	%o0,%l0			C keep carry-out from accmull
+
+C Now multiply-add with high 32 bits of s2_limb, unless it is zero.
+	srlx	%i3,32,%o3
+	brz,a,pn	%o3,L(small)
+	 mov	%o0,%i0
+	mov	%i1,%o1
+	add	%i2,%i2,%o2
+	call	addmulu
+	add	%i0,4,%o0
+
+	add	%l0,%o0,%i0
+L(small):
+	ret
+	restore	%g0,%g0,%g0
+EPILOGUE(mpn_addmul_1)
+
+C Put a zero in the text segment to allow us to t the address
+C quickly when compiling for PIC
+	TEXT
+	ALIGN(4)
+L(noll):
+	.word	0
+
+define(`LO',`(+4)')
+define(`HI',`(-4)')
+
+define(`DLO',`(+4)')
+define(`DHI',`(-4)')
+define(`LOWPART')
+define(`E',`L(l.$1)')
+include_mpn(`sparc64/addmul1h.asm')
+
+define(`DLO',`(-4)')
+define(`DHI',`(+4)')
+undefine(`LOWPART')
+define(`E',`L(u.$1)')
+include_mpn(`sparc64/addmul1h.asm')
diff --git a/src/gmp/mpn/sparc64/copyi.asm b/src/gmp/mpn/sparc64/copyi.asm
new file mode 100644
index 000000000..d9957e3c9
--- /dev/null
+++ b/src/gmp/mpn/sparc64/copyi.asm
@@ -0,0 +1,79 @@
+! SPARC v9 __gmpn_copy -- Copy a limb vector.
+
+! Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! rptr	%o0
+! sptr	%o1
+! n	%o2
+
+include(`../config.m4')
+
+ASM_START()
+	.register	%g2,#scratch
+	.register	%g3,#scratch
+PROLOGUE(mpn_copyi)
+	add	%o2,-8,%o2
+	brlz,pn	%o2,L(skip)
+	nop
+	b,a	L(loop1)
+	nop
+
+	ALIGN(16)
+L(loop1):
+	ldx	[%o1+0],%g1
+	ldx	[%o1+8],%g2
+	ldx	[%o1+16],%g3
+	ldx	[%o1+24],%g4
+	ldx	[%o1+32],%g5
+	ldx	[%o1+40],%o3
+	ldx	[%o1+48],%o4
+	ldx	[%o1+56],%o5
+	add	%o1,64,%o1
+	stx	%g1,[%o0+0]
+	stx	%g2,[%o0+8]
+	stx	%g3,[%o0+16]
+	stx	%g4,[%o0+24]
+	stx	%g5,[%o0+32]
+	stx	%o3,[%o0+40]
+	stx	%o4,[%o0+48]
+	stx	%o5,[%o0+56]
+	add	%o2,-8,%o2
+	brgez,pt	%o2,L(loop1)
+	add	%o0,64,%o0
+
+L(skip):
+	add	%o2,8,%o2
+	brz,pt	%o2,L(end)
+	nop
+
+L(loop2):
+	ldx	[%o1],%g1
+	add	%o1,8,%o1
+	add	%o2,-1,%o2
+	stx	%g1,[%o0]
+	add	%o0,8,%o0
+	brgz,pt	%o2,L(loop2)
+	nop
+
+L(end):	retl
+	nop
+EPILOGUE(mpn_copyi)
diff --git a/src/gmp/mpn/sparc64/gmp-mparam.h b/src/gmp/mpn/sparc64/gmp-mparam.h
new file mode 100644
index 000000000..74f61661c
--- /dev/null
+++ b/src/gmp/mpn/sparc64/gmp-mparam.h
@@ -0,0 +1,88 @@
+/* Sparc64 gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 64
+#define BYTES_PER_MP_LIMB 8
+#define BITS_PER_LONGINT 64
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+/* Tell the toom3 multiply implementation to call low-level mpn
+   functions instead of open-coding operations in C.  */
+#define USE_MORE_MPN 1
+
+
+/* Run on sun workshop cc. */
+/* Generated by tuneup.c, 2000-07-30. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD     12
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD         95
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD     33
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD        125
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD                27
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD              107
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD              12
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD          4
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD           199
+#endif
+
+#ifndef FFT_MUL_TABLE
+#define FFT_MUL_TABLE  { 304, 608, 1344, 2304, 7168, 20480, 49152, 0 }
+#endif
+#ifndef FFT_MODF_MUL_THRESHOLD
+#define FFT_MODF_MUL_THRESHOLD     320
+#endif
+#ifndef FFT_MUL_THRESHOLD
+#define FFT_MUL_THRESHOLD         1664
+#endif
+
+#ifndef FFT_SQR_TABLE
+#define FFT_SQR_TABLE  { 304, 608, 1344, 2816, 7168, 20480, 49152, 0 }
+#endif
+#ifndef FFT_MODF_SQR_THRESHOLD
+#define FFT_MODF_SQR_THRESHOLD     320
+#endif
+#ifndef FFT_SQR_THRESHOLD
+#define FFT_SQR_THRESHOLD         1664
+#endif
diff --git a/src/gmp/mpn/sparc64/lshift.asm b/src/gmp/mpn/sparc64/lshift.asm
new file mode 100644
index 000000000..2d2edc50a
--- /dev/null
+++ b/src/gmp/mpn/sparc64/lshift.asm
@@ -0,0 +1,97 @@
+! SPARC v9 __gmpn_lshift --
+
+! Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	%o0
+! src_ptr	%o1
+! size		%o2
+! cnt		%o3
+
+include(`../config.m4')
+
+ASM_START()
+	.register	%g2,#scratch
+	.register	%g3,#scratch
+PROLOGUE(mpn_lshift)
+	sllx	%o2,3,%g1
+	add	%o1,%g1,%o1	! make %o1 point at end of src
+	ldx	[%o1-8],%g2	! load first limb
+	sub	%g0,%o3,%o5	! negate shift count
+	add	%o0,%g1,%o0	! make %o0 point at end of res
+	add	%o2,-1,%o2
+	and	%o2,4-1,%g4	! number of limbs in first loop
+	srlx	%g2,%o5,%g1	! compute function result
+	brz,pn	%g4,L(0)		! if multiple of 4 limbs, skip first loop
+	mov	%g1,%g5
+
+	sub	%o2,%g4,%o2	! adjust count for main loop
+
+L(loop0):
+	ldx	[%o1-16],%g3
+	add	%o0,-8,%o0
+	add	%o1,-8,%o1
+	add	%g4,-1,%g4
+	sllx	%g2,%o3,%o4
+	srlx	%g3,%o5,%g1
+	mov	%g3,%g2
+	or	%o4,%g1,%o4
+	brnz,pt	%g4,L(loop0)
+	 stx	%o4,[%o0+0]
+
+L(0):	brz,pn	%o2,L(end)
+	 nop
+
+L(loop1):
+	ldx	[%o1-16],%g3
+	add	%o0,-32,%o0
+	add	%o2,-4,%o2
+	sllx	%g2,%o3,%o4
+	srlx	%g3,%o5,%g1
+
+	ldx	[%o1-24],%g2
+	sllx	%g3,%o3,%g4
+	or	%o4,%g1,%o4
+	stx	%o4,[%o0+24]
+	srlx	%g2,%o5,%g1
+
+	ldx	[%o1-32],%g3
+	sllx	%g2,%o3,%o4
+	or	%g4,%g1,%g4
+	stx	%g4,[%o0+16]
+	srlx	%g3,%o5,%g1
+
+	ldx	[%o1-40],%g2
+	sllx	%g3,%o3,%g4
+	or	%o4,%g1,%o4
+	stx	%o4,[%o0+8]
+	srlx	%g2,%o5,%g1
+
+	add	%o1,-32,%o1
+	or	%g4,%g1,%g4
+	brnz,pt	%o2,L(loop1)
+	 stx	%g4,[%o0+0]
+
+L(end):	sllx	%g2,%o3,%g2
+	stx	%g2,[%o0-8]
+	retl
+	mov	%g5,%o0
+EPILOGUE(mpn_lshift)
diff --git a/src/gmp/mpn/sparc64/mul_1.asm b/src/gmp/mpn/sparc64/mul_1.asm
new file mode 100644
index 000000000..f2f2821d5
--- /dev/null
+++ b/src/gmp/mpn/sparc64/mul_1.asm
@@ -0,0 +1,113 @@
+dnl  SPARC 64-bit mpn_mul_1 -- Multiply a limb vector with a limb and
+dnl  store the result to a second limb vector.
+
+dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	i0
+C s1_ptr	i1
+C size		i2
+C s2_limb	i3
+
+ASM_START()
+	.register	%g2,#scratch
+	.register	%g3,#scratch
+
+PROLOGUE(mpn_mul_1)
+	save	%sp,-256,%sp
+
+C We store 0.0 in f10 and keep it invariant accross thw two
+C function calls below.  Note that this is not ABI conformant,
+C but since the functions are local, that's acceptable.
+ifdef(`PIC',
+`L(pc):	rd	%pc,%o7
+	ld	[%o7+L(noll)-L(pc)],%f10',
+`	sethi	%hh(L(noll)),%g2
+	sethi	%lm(L(noll)),%g1
+	or	%g2,%hm(L(noll)),%g2
+	or	%g1,%lo(L(noll)),%g1
+	sllx	%g2,32,%g2
+	ld	[%g1+%g2],%f10')
+
+	sub	%i1,%i0,%g1
+	srlx	%g1,3,%g1
+	cmp	%g1,%i2
+	bcc,pt	%xcc,L(nooverlap)
+	nop
+
+	sllx	%i2,3,%g2		C compute stack allocation byte count
+	add	%g2,15,%o0
+	and	%o0,-16,%o0
+	sub	%sp,%o0,%sp
+	add	%sp,2223,%o0
+
+	mov	%i1,%o1			C copy s1_ptr to mpn_copyi's srcp
+	call	mpn_copyi
+	mov	%i2,%o2			C copy n to mpn_copyi's count parameter
+
+	add	%sp,2223,%i1
+
+L(nooverlap):
+C First multiply-add with low 32 bits of s2_limb
+	mov	%i0,%o0
+	mov	%i1,%o1
+	add	%i2,%i2,%o2
+	call	mull
+	srl	%i3,0,%o3
+
+	mov	%o0,%l0			C keep carry-out from accmull
+
+C Now multiply-add with high 32 bits of s2_limb, unless it is zero.
+	srlx	%i3,32,%o3
+	brz,a,pn	%o3,L(small)
+	 mov	%o0,%i0
+	mov	%i1,%o1
+	add	%i2,%i2,%o2
+	call	addmulu
+	add	%i0,4,%o0
+
+	add	%l0,%o0,%i0
+L(small):
+	ret
+	restore	%g0,%g0,%g0
+EPILOGUE(mpn_mul_1)
+
+C Put a zero in the text segment to allow us to t the address
+C quickly when compiling for PIC
+	TEXT
+	ALIGN(4)
+L(noll):
+	.word	0
+
+define(`LO',`(+4)')
+define(`HI',`(-4)')
+
+define(`DLO',`(+4)')
+define(`DHI',`(-4)')
+define(`E',`L($1)')
+include_mpn(`sparc64/mul_1h.asm')
+
+define(`DLO',`(-4)')
+define(`DHI',`(+4)')
+undefine(`LOWPART')
+define(`E',`L(u.$1)')
+include_mpn(`sparc64/addmul1h.asm')
diff --git a/src/gmp/mpn/sparc64/mul_1h.asm b/src/gmp/mpn/sparc64/mul_1h.asm
new file mode 100644
index 000000000..5078c01c3
--- /dev/null
+++ b/src/gmp/mpn/sparc64/mul_1h.asm
@@ -0,0 +1,183 @@
+dnl  SPARC 64-bit mull -- Helper for mpn_mul_1.
+
+dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+mull:
+	save %sp,-256,%sp
+
+	sethi	%hi(0xffff0000),%o0
+	andn	%i3,%o0,%o0
+	st	%o0,[%fp-17]
+	ld	[%fp-17],%f11
+	fxtod	%f10,%f6
+
+	srl	%i3,16,%o0
+	st	%o0,[%fp-17]
+	ld	[%fp-17],%f11
+	fxtod	%f10,%f8
+
+	mov	0,%g3			C cy = 0
+
+	ld	[%i1+4],%f11
+	subcc	%i2,1,%i2
+dnl	be,pn	%icc,E(end1)
+	add	%i1,4,%i1		C s1_ptr++
+
+	fxtod	%f10,%f2
+	ld	[%i1-4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-25]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+	be,pn	%icc,E(end2)
+	std	%f12,[%fp-17]
+
+	fxtod	%f10,%f2
+	ld	[%i1+4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+dnl	be,pn	%icc,E(end3)
+	std	%f12,[%fp-33]
+
+	fxtod	%f10,%f2
+	ld	[%i1-4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	ldx	[%fp-25],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-17],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-25]
+	fdtox	%f4,%f12
+	add	%i0,4,%i0		C res_ptr++
+	subcc	%i2,1,%i2
+	be,pn	%icc,E(end4)
+	std	%f12,[%fp-17]
+
+	b,a	E(loop)
+	nop				C nop is cheap to nullify
+
+	ALIGN(16)
+C BEGIN LOOP
+E(loop):
+	fxtod	%f10,%f2
+	ld	[%i1+4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-41],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-33],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DLO]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-33]
+	sub	%i2,2,%i2
+	add	%i0,4,%i0		C res_ptr++
+
+	fxtod	%f10,%f2
+	ld	[%i1-4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-25],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-17],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DHI]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-25]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-17]
+	brnz,pt	%i2,E(loop)
+	add	%i0,4,%i0		C res_ptr++
+C END LOOP
+E(loope):
+E(end4):
+	fxtod	%f10,%f2
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-41],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-33],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DLO]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-33]
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-25],%g2		C p16
+	ldx	[%fp-17],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DHI]
+	b,a	E(yyy)
+
+E(end2):
+	fxtod	%f10,%f2
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-33]
+	ldx	[%fp-25],%g2		C p16
+	ldx	[%fp-17],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+E(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	srlx	%g4,32,%g3
+	ldx	[%fp-41],%g2		C p16
+	ldx	[%fp-33],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%g4,[%i0-4+DLO]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	st	%g4,[%i0-4+DHI]
+	srlx	%g4,32,%g4
+
+	ret
+	restore %g0,%g4,%o0		C sideeffect: put cy in retreg
+EPILOGUE(mull)
diff --git a/src/gmp/mpn/sparc64/rshift.asm b/src/gmp/mpn/sparc64/rshift.asm
new file mode 100644
index 000000000..baf7920ef
--- /dev/null
+++ b/src/gmp/mpn/sparc64/rshift.asm
@@ -0,0 +1,94 @@
+! SPARC v9 __gmpn_rshift --
+
+! Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	%o0
+! src_ptr	%o1
+! size		%o2
+! cnt		%o3
+
+include(`../config.m4')
+
+ASM_START()
+	.register	%g2,#scratch
+	.register	%g3,#scratch
+PROLOGUE(mpn_rshift)
+	ldx	[%o1],%g2	! load first limb
+	sub	%g0,%o3,%o5	! negate shift count
+	add	%o2,-1,%o2
+	and	%o2,4-1,%g4	! number of limbs in first loop
+	sllx	%g2,%o5,%g1	! compute function result
+	brz,pn	%g4,L(0)	! if multiple of 4 limbs, skip first loop
+	mov	%g1,%g5
+
+	sub	%o2,%g4,%o2	! adjust count for main loop
+
+L(loop0):
+	ldx	[%o1+8],%g3
+	add	%o0,8,%o0
+	add	%o1,8,%o1
+	add	%g4,-1,%g4
+	srlx	%g2,%o3,%o4
+	sllx	%g3,%o5,%g1
+	mov	%g3,%g2
+	or	%o4,%g1,%o4
+	brnz,pt	%g4,L(loop0)
+	 stx	%o4,[%o0-8]
+
+L(0):	brz,pn	%o2,L(end)
+	 nop
+
+L(loop1):
+	ldx	[%o1+8],%g3
+	add	%o0,32,%o0
+	add	%o2,-4,%o2
+	srlx	%g2,%o3,%o4
+	sllx	%g3,%o5,%g1
+
+	ldx	[%o1+16],%g2
+	srlx	%g3,%o3,%g4
+	or	%o4,%g1,%o4
+	stx	%o4,[%o0-32]
+	sllx	%g2,%o5,%g1
+
+	ldx	[%o1+24],%g3
+	srlx	%g2,%o3,%o4
+	or	%g4,%g1,%g4
+	stx	%g4,[%o0-24]
+	sllx	%g3,%o5,%g1
+
+	ldx	[%o1+32],%g2
+	srlx	%g3,%o3,%g4
+	or	%o4,%g1,%o4
+	stx	%o4,[%o0-16]
+	sllx	%g2,%o5,%g1
+
+	add	%o1,32,%o1
+	or	%g4,%g1,%g4
+	brnz	%o2,L(loop1)
+	 stx	%g4,[%o0-8]
+
+L(end):	srlx	%g2,%o3,%g2
+	stx	%g2,[%o0-0]
+	retl
+	mov	%g5,%o0
+EPILOGUE(mpn_rshift)
diff --git a/src/gmp/mpn/sparc64/sub_n.asm b/src/gmp/mpn/sparc64/sub_n.asm
new file mode 100644
index 000000000..61547138e
--- /dev/null
+++ b/src/gmp/mpn/sparc64/sub_n.asm
@@ -0,0 +1,172 @@
+! SPARC v9 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+! store difference in a third limb vector.
+
+! Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	%o0
+! s1_ptr	%o1
+! s2_ptr	%o2
+! size		%o3
+
+include(`../config.m4')
+
+ASM_START()
+	.register	%g2,#scratch
+	.register	%g3,#scratch
+PROLOGUE(mpn_sub_n)
+
+! 12 mem ops >= 12 cycles
+! 8 shift insn >= 8 cycles
+! 8 addccc, executing alone, +8 cycles
+! Unrolling not mandatory...perhaps 2-way is best?
+! Put one ldx/stx and one s?lx per issue tuple, fill with pointer arith and loop ctl
+! All in all, it runs at 5 cycles/limb
+
+	save	%sp,-160,%sp
+
+	addcc	%g0,%g0,%g0
+
+	add	%i3,-4,%i3
+	brlz,pn	%i3,L(there)
+	nop
+
+	ldx	[%i1+0],%l0
+	ldx	[%i2+0],%l4
+	ldx	[%i1+8],%l1
+	ldx	[%i2+8],%l5
+	ldx	[%i1+16],%l2
+	ldx	[%i2+16],%l6
+	ldx	[%i1+24],%l3
+	ldx	[%i2+24],%l7
+	add	%i1,32,%i1
+	add	%i2,32,%i2
+
+	add	%i3,-4,%i3
+	brlz,pn	%i3,L(skip)
+	nop
+	b	L(loop1)	! jump instead of executing many NOPs
+	nop
+	ALIGN(32)
+!---------  Start main loop ---------
+L(loop1):
+	subccc	%l0,%l4,%g1
+!-
+	srlx	%l0,32,%o0
+	ldx	[%i1+0],%l0
+!-
+	srlx	%l4,32,%o4
+	ldx	[%i2+0],%l4
+!-
+	subccc	%o0,%o4,%g0
+!-
+	subccc	%l1,%l5,%g2
+!-
+	srlx	%l1,32,%o1
+	ldx	[%i1+8],%l1
+!-
+	srlx	%l5,32,%o5
+	ldx	[%i2+8],%l5
+!-
+	subccc	%o1,%o5,%g0
+!-
+	subccc	%l2,%l6,%g3
+!-
+	srlx	%l2,32,%o2
+	ldx	[%i1+16],%l2
+!-
+	srlx	%l6,32,%g5	! asymmetry
+	ldx	[%i2+16],%l6
+!-
+	subccc	%o2,%g5,%g0
+!-
+	subccc	%l3,%l7,%g4
+!-
+	srlx	%l3,32,%o3
+	ldx	[%i1+24],%l3
+	add	%i1,32,%i1
+!-
+	srlx	%l7,32,%o7
+	ldx	[%i2+24],%l7
+	add	%i2,32,%i2
+!-
+	subccc	%o3,%o7,%g0
+!-
+	stx	%g1,[%i0+0]
+!-
+	stx	%g2,[%i0+8]
+!-
+	stx	%g3,[%i0+16]
+	add	%i3,-4,%i3
+!-
+	stx	%g4,[%i0+24]
+	add	%i0,32,%i0
+
+	brgez,pt	%i3,L(loop1)
+	nop
+!---------  End main loop ---------
+L(skip):
+	subccc	%l0,%l4,%g1
+	srlx	%l0,32,%o0
+	srlx	%l4,32,%o4
+	subccc	%o0,%o4,%g0
+	subccc	%l1,%l5,%g2
+	srlx	%l1,32,%o1
+	srlx	%l5,32,%o5
+	subccc	%o1,%o5,%g0
+	subccc	%l2,%l6,%g3
+	srlx	%l2,32,%o2
+	srlx	%l6,32,%g5	! asymmetry
+	subccc	%o2,%g5,%g0
+	subccc	%l3,%l7,%g4
+	srlx	%l3,32,%o3
+	srlx	%l7,32,%o7
+	subccc	%o3,%o7,%g0
+	stx	%g1,[%i0+0]
+	stx	%g2,[%i0+8]
+	stx	%g3,[%i0+16]
+	stx	%g4,[%i0+24]
+	add	%i0,32,%i0
+
+L(there):
+	add	%i3,4,%i3
+	brz,pt	%i3,L(end)
+	nop
+
+L(loop2):
+	ldx	[%i1+0],%l0
+	add	%i1,8,%i1
+	ldx	[%i2+0],%l4
+	add	%i2,8,%i2
+	srlx	%l0,32,%g2
+	srlx	%l4,32,%g3
+	subccc	%l0,%l4,%g1
+	subccc	%g2,%g3,%g0
+	stx	%g1,[%i0+0]
+	add	%i0,8,%i0
+	add	%i3,-1,%i3
+	brgz,pt	%i3,L(loop2)
+	nop
+
+L(end):	addc	%g0,%g0,%i0
+	ret
+	restore
+EPILOGUE(mpn_sub_n)
diff --git a/src/gmp/mpn/sparc64/submul1h.asm b/src/gmp/mpn/sparc64/submul1h.asm
new file mode 100644
index 000000000..7f51ba59c
--- /dev/null
+++ b/src/gmp/mpn/sparc64/submul1h.asm
@@ -0,0 +1,204 @@
+dnl  SPARC 64-bit submull/submulu -- Helper for mpn_submul_1 and mpn_mul_1.
+
+dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+ifdef(`LOWPART',
+`submull:',
+`submulu:')
+	save %sp,-256,%sp
+
+	sethi	%hi(0xffff0000),%o0
+	andn	%i3,%o0,%o0
+	st	%o0,[%fp-17]
+	ld	[%fp-17],%f11
+	fxtod	%f10,%f6
+
+	srl	%i3,16,%o0
+	st	%o0,[%fp-17]
+	ld	[%fp-17],%f11
+	fxtod	%f10,%f8
+
+	mov	0,%g3			C cy = 0
+
+	ld	[%i1+4],%f11
+	subcc	%i2,1,%i2
+dnl	be,pn	%icc,E(end1)
+	add	%i1,4,%i1		C s1_ptr++
+
+	fxtod	%f10,%f2
+	ld	[%i1-4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-25]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+	be,pn	%icc,E(end2)
+	std	%f12,[%fp-17]
+
+	fxtod	%f10,%f2
+	ld	[%i1+4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	subcc	%i2,1,%i2
+dnl	be,pn	%icc,E(end3)
+	std	%f12,[%fp-33]
+
+	fxtod	%f10,%f2
+	ld	[%i1-4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	ld	[%i0+DLO],%g5
+	ldx	[%fp-25],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-17],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-25]
+	fdtox	%f4,%f12
+	add	%i0,4,%i0		C res_ptr++
+	subcc	%i2,1,%i2
+	be,pn	%icc,E(end4)
+	std	%f12,[%fp-17]
+
+	b,a	E(loop)
+	nop				C nop is cheap to nullify
+
+	ALIGN(16)
+C BEGIN LOOP
+E(loop):
+	fxtod	%f10,%f2
+	ld	[%i1+4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0+DHI],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-41],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-33],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4+DLO]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-33]
+	sub	%i2,2,%i2
+	add	%i0,4,%i0		C res_ptr++
+
+	fxtod	%f10,%f2
+	ld	[%i1-4],%f11
+	add	%i1,4,%i1		C s1_ptr++
+	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0+DLO],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-25],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-17],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4+DHI]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-25]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-17]
+	brnz,pt	%i2,E(loop)
+	add	%i0,4,%i0		C res_ptr++
+C END LOOP
+E(loope):
+E(end4):
+	fxtod	%f10,%f2
+	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0+DHI],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-41],%g2		C p16
+	fmuld	%f2,%f8,%f16
+	ldx	[%fp-33],%g1		C p0
+	fmuld	%f2,%f6,%f4
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4+DLO]
+	fdtox	%f16,%f14
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-33]
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+	ld	[%i0+DLO],%g5
+	srlx	%g4,32,%g3
+	ldx	[%fp-25],%g2		C p16
+	ldx	[%fp-17],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4+DHI]
+	b,a	E(yyy)
+
+E(end2):
+	fxtod	%f10,%f2
+	fmuld	%f2,%f8,%f16
+	fmuld	%f2,%f6,%f4
+	fdtox	%f16,%f14
+	std	%f14,[%fp-41]
+	fdtox	%f4,%f12
+	std	%f12,[%fp-33]
+	ld	[%i0+DLO],%g5
+	ldx	[%fp-25],%g2		C p16
+	ldx	[%fp-17],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+E(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
+ifdef(`LOWPART',
+`	ld	[%i0+DHI],%g5')
+	srlx	%g4,32,%g3
+	ldx	[%fp-41],%g2		C p16
+	ldx	[%fp-33],%g1		C p0
+	sllx	%g2,16,%g2		C align p16
+	st	%l2,[%i0-4+DLO]
+	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
+	add	%i0,4,%i0		C res_ptr++
+
+	add	%g3,%g1,%g4		C p += cy
+ifdef(`LOWPART',
+`	subxcc	%g5,%g4,%l2')		C add *res_ptr to p0 (ADD2)
+ifdef(`LOWPART',
+`	st	%l2,[%i0-4+DHI]
+	srlx	%g4,32,%g4')
+
+	addx	%g4,0,%g4
+	ret
+	restore %g0,%g4,%o0		C sideeffect: put cy in retreg
+ifdef(`LOWPART',
+`EPILOGUE(submull)',
+`EPILOGUE(submulu)')
diff --git a/src/gmp/mpn/sparc64/submul_1.asm b/src/gmp/mpn/sparc64/submul_1.asm
new file mode 100644
index 000000000..7c6af0a98
--- /dev/null
+++ b/src/gmp/mpn/sparc64/submul_1.asm
@@ -0,0 +1,114 @@
+dnl  SPARC 64-bit mpn_submul_1 -- Multiply a limb vector with a limb and
+dnl  subtract the result from a second limb vector.
+
+dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+dnl  This file is part of the GNU MP Library.
+
+dnl  The GNU MP Library is free software; you can redistribute it and/or modify
+dnl  it under the terms of the GNU Lesser General Public License as published
+dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
+dnl  your option) any later version.
+
+dnl  The GNU MP Library is distributed in the hope that it will be useful, but
+dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+dnl  License for more details.
+
+dnl  You should have received a copy of the GNU Lesser General Public License
+dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+dnl  MA 02111-1307, USA.
+
+include(`../config.m4')
+
+C INPUT PARAMETERS
+C res_ptr	i0
+C s1_ptr	i1
+C size		i2
+C s2_limb	i3
+
+ASM_START()
+	.register	%g2,#scratch
+	.register	%g3,#scratch
+
+PROLOGUE(mpn_submul_1)
+	save	%sp,-256,%sp
+
+C We store 0.0 in f10 and keep it invariant accross thw two
+C function calls below.  Note that this is not ABI conformant,
+C but since the functions are local, that's acceptable.
+ifdef(`PIC',
+`L(pc):	rd	%pc,%o7
+	ld	[%o7+L(noll)-L(pc)],%f10',
+`	sethi	%hh(L(noll)),%g2
+	sethi	%lm(L(noll)),%g1
+	or	%g2,%hm(L(noll)),%g2
+	or	%g1,%lo(L(noll)),%g1
+	sllx	%g2,32,%g2
+	ld	[%g1+%g2],%f10')
+
+	sub	%i1,%i0,%g1
+	srlx	%g1,3,%g1
+	cmp	%g1,%i2
+	bcc,pt	%xcc,L(nooverlap)
+	nop
+
+	sllx	%i2,3,%g2		C compute stack allocation byte count
+	add	%g2,15,%o0
+	and	%o0,-16,%o0
+	sub	%sp,%o0,%sp
+	add	%sp,2223,%o0
+
+	mov	%i1,%o1			C copy s1_ptr to mpn_copyi's srcp
+	call	mpn_copyi
+	mov	%i2,%o2			C copy n to mpn_copyi's count parameter
+
+	add	%sp,2223,%i1
+
+L(nooverlap):
+C First multiply-add with low 32 bits of s2_limb
+	mov	%i0,%o0
+	mov	%i1,%o1
+	add	%i2,%i2,%o2
+	call	submull
+	srl	%i3,0,%o3
+
+	mov	%o0,%l0			C keep carry-out from accmull
+
+C Now multiply-add with high 32 bits of s2_limb, unless it is zero.
+	srlx	%i3,32,%o3
+	brz,a,pn	%o3,L(small)
+	 mov	%o0,%i0
+	mov	%i1,%o1
+	add	%i2,%i2,%o2
+	call	submulu
+	add	%i0,4,%o0
+
+	add	%l0,%o0,%i0
+L(small):
+	ret
+	restore	%g0,%g0,%g0
+EPILOGUE(mpn_submul_1)
+
+C Put a zero in the text segment to allow us to t the address
+C quickly when compiling for PIC
+	TEXT
+	ALIGN(4)
+L(noll):
+	.word	0
+
+define(`LO',`(+4)')
+define(`HI',`(-4)')
+
+define(`DLO',`(+4)')
+define(`DHI',`(-4)')
+define(`LOWPART')
+define(`E',`L(l.$1)')
+include_mpn(`sparc64/submul1h.asm')
+
+define(`DLO',`(-4)')
+define(`DHI',`(+4)')
+undefine(`LOWPART')
+define(`E',`L(u.$1)')
+include_mpn(`sparc64/submul1h.asm')
diff --git a/src/gmp/mpn/tests/Makefile.am b/src/gmp/mpn/tests/Makefile.am
new file mode 100644
index 000000000..bddbc05e9
--- /dev/null
+++ b/src/gmp/mpn/tests/Makefile.am
@@ -0,0 +1,55 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu $(top_builddir)/ansi2knr no-dependencies
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+EXTRA_PROGRAMS = \
+  add_n addmul_1 copy divmod_1 divrem lshift mul_1 rshift \
+  sub_n submul_1 tst-addsub try
+
+# addsub_n addsub_n_2 not yet built since mpn_addsub_n doesn't yet exist
+
+EXTRA_HEADERS = ref.h try.h
+EXTRA_DIST = x86call.asm x86check.c
+
+try_SOURCES = try.c ref.c trace.c spinner.c
+try_LDADD = @CALLING_CONVENTIONS_OBJS@ $(top_builddir)/libgmp.la
+try_DEPENDENCIES = $(try_LDADD)
+
+allprogs: $(EXTRA_PROGRAMS)
+
+CLEANFILES = $(EXTRA_PROGRAMS)
+
+
+SUFFIXES = .asm
+
+# Relative paths don't work out right when running m4 from a second level
+# subdirectory, so copy the necessary files up to build them.
+.asm.o:
+	cp $< ..; cd ..; $(MAKE) $(AM_MAKEFLAGS) $@; rm $*.asm; mv $*.* tests;
+.asm.obj:
+	cp $< ..; cd ..; $(MAKE) $(AM_MAKEFLAGS) $@; rm $*.asm; mv $*.* tests;
+.asm.lo:
+	cp $< ..; cd ..; $(MAKE) $(AM_MAKEFLAGS) $@; rm $*.asm; mv $*.* tests;
diff --git a/src/gmp/mpn/tests/Makefile.in b/src/gmp/mpn/tests/Makefile.in
new file mode 100644
index 000000000..004ae8f4f
--- /dev/null
+++ b/src/gmp/mpn/tests/Makefile.in
@@ -0,0 +1,502 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu $(top_builddir)/ansi2knr no-dependencies
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+EXTRA_PROGRAMS = \
+  add_n addmul_1 copy divmod_1 divrem lshift mul_1 rshift \
+  sub_n submul_1 tst-addsub try
+
+
+# addsub_n addsub_n_2 not yet built since mpn_addsub_n doesn't yet exist
+
+EXTRA_HEADERS = ref.h try.h
+EXTRA_DIST = x86call.asm x86check.c
+
+try_SOURCES = try.c ref.c trace.c spinner.c
+try_LDADD = @CALLING_CONVENTIONS_OBJS@ $(top_builddir)/libgmp.la
+try_DEPENDENCIES = $(try_LDADD)
+
+CLEANFILES = $(EXTRA_PROGRAMS)
+
+SUFFIXES = .asm
+subdir = mpn/tests
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../../config.h
+CONFIG_CLEAN_FILES = 
+EXTRA_PROGRAMS =  add_n$(EXEEXT) addmul_1$(EXEEXT) copy$(EXEEXT) \
+divmod_1$(EXEEXT) divrem$(EXEEXT) lshift$(EXEEXT) mul_1$(EXEEXT) \
+rshift$(EXEEXT) sub_n$(EXEEXT) submul_1$(EXEEXT) tst-addsub$(EXEEXT) \
+try$(EXEEXT)
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I../..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+ANSI2KNR = $(top_builddir)/ansi2knr
+add_n_SOURCES = add_n.c
+add_n_OBJECTS =  add_n$U.$(OBJEXT)
+add_n_LDADD = $(LDADD)
+add_n_DEPENDENCIES =  $(top_builddir)/libgmp.la
+add_n_LDFLAGS = 
+addmul_1_SOURCES = addmul_1.c
+addmul_1_OBJECTS =  addmul_1$U.$(OBJEXT)
+addmul_1_LDADD = $(LDADD)
+addmul_1_DEPENDENCIES =  $(top_builddir)/libgmp.la
+addmul_1_LDFLAGS = 
+copy_SOURCES = copy.c
+copy_OBJECTS =  copy$U.$(OBJEXT)
+copy_LDADD = $(LDADD)
+copy_DEPENDENCIES =  $(top_builddir)/libgmp.la
+copy_LDFLAGS = 
+divmod_1_SOURCES = divmod_1.c
+divmod_1_OBJECTS =  divmod_1$U.$(OBJEXT)
+divmod_1_LDADD = $(LDADD)
+divmod_1_DEPENDENCIES =  $(top_builddir)/libgmp.la
+divmod_1_LDFLAGS = 
+divrem_SOURCES = divrem.c
+divrem_OBJECTS =  divrem$U.$(OBJEXT)
+divrem_LDADD = $(LDADD)
+divrem_DEPENDENCIES =  $(top_builddir)/libgmp.la
+divrem_LDFLAGS = 
+lshift_SOURCES = lshift.c
+lshift_OBJECTS =  lshift$U.$(OBJEXT)
+lshift_LDADD = $(LDADD)
+lshift_DEPENDENCIES =  $(top_builddir)/libgmp.la
+lshift_LDFLAGS = 
+mul_1_SOURCES = mul_1.c
+mul_1_OBJECTS =  mul_1$U.$(OBJEXT)
+mul_1_LDADD = $(LDADD)
+mul_1_DEPENDENCIES =  $(top_builddir)/libgmp.la
+mul_1_LDFLAGS = 
+rshift_SOURCES = rshift.c
+rshift_OBJECTS =  rshift$U.$(OBJEXT)
+rshift_LDADD = $(LDADD)
+rshift_DEPENDENCIES =  $(top_builddir)/libgmp.la
+rshift_LDFLAGS = 
+sub_n_SOURCES = sub_n.c
+sub_n_OBJECTS =  sub_n$U.$(OBJEXT)
+sub_n_LDADD = $(LDADD)
+sub_n_DEPENDENCIES =  $(top_builddir)/libgmp.la
+sub_n_LDFLAGS = 
+submul_1_SOURCES = submul_1.c
+submul_1_OBJECTS =  submul_1$U.$(OBJEXT)
+submul_1_LDADD = $(LDADD)
+submul_1_DEPENDENCIES =  $(top_builddir)/libgmp.la
+submul_1_LDFLAGS = 
+am_try_OBJECTS =  try$U.$(OBJEXT) ref$U.$(OBJEXT) trace$U.$(OBJEXT) \
+spinner$U.$(OBJEXT)
+try_OBJECTS =  $(am_try_OBJECTS)
+try_LDFLAGS = 
+tst_addsub_SOURCES = tst-addsub.c
+tst_addsub_OBJECTS =  tst-addsub$U.$(OBJEXT)
+tst_addsub_LDADD = $(LDADD)
+tst_addsub_DEPENDENCIES =  $(top_builddir)/libgmp.la
+tst_addsub_LDFLAGS = 
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  add_n.c addmul_1.c copy.c divmod_1.c divrem.c lshift.c \
+mul_1.c rshift.c sub_n.c submul_1.c $(try_SOURCES) tst-addsub.c
+DIST_COMMON =  README $(EXTRA_HEADERS) Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = add_n.c addmul_1.c copy.c divmod_1.c divrem.c lshift.c mul_1.c rshift.c sub_n.c submul_1.c $(try_SOURCES) tst-addsub.c
+OBJECTS = add_n$U.$(OBJEXT) addmul_1$U.$(OBJEXT) copy$U.$(OBJEXT) divmod_1$U.$(OBJEXT) divrem$U.$(OBJEXT) lshift$U.$(OBJEXT) mul_1$U.$(OBJEXT) rshift$U.$(OBJEXT) sub_n$U.$(OBJEXT) submul_1$U.$(OBJEXT) $(am_try_OBJECTS) tst-addsub$U.$(OBJEXT)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .asm .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpn/tests/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+$(top_builddir)/ansi2knr: $(top_builddir)/ansi2knr.$(OBJEXT)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr
+
+$(top_builddir)/ansi2knr.$(OBJEXT):
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr.$(OBJEXT)
+
+
+mostlyclean-kr:
+	-rm -f *_.c
+
+clean-kr:
+
+distclean-kr:
+
+maintainer-clean-kr:
+
+add_n$(EXEEXT): $(add_n_OBJECTS) $(add_n_DEPENDENCIES)
+	@rm -f add_n$(EXEEXT)
+	$(LINK) $(add_n_LDFLAGS) $(add_n_OBJECTS) $(add_n_LDADD) $(LIBS)
+
+addmul_1$(EXEEXT): $(addmul_1_OBJECTS) $(addmul_1_DEPENDENCIES)
+	@rm -f addmul_1$(EXEEXT)
+	$(LINK) $(addmul_1_LDFLAGS) $(addmul_1_OBJECTS) $(addmul_1_LDADD) $(LIBS)
+
+copy$(EXEEXT): $(copy_OBJECTS) $(copy_DEPENDENCIES)
+	@rm -f copy$(EXEEXT)
+	$(LINK) $(copy_LDFLAGS) $(copy_OBJECTS) $(copy_LDADD) $(LIBS)
+
+divmod_1$(EXEEXT): $(divmod_1_OBJECTS) $(divmod_1_DEPENDENCIES)
+	@rm -f divmod_1$(EXEEXT)
+	$(LINK) $(divmod_1_LDFLAGS) $(divmod_1_OBJECTS) $(divmod_1_LDADD) $(LIBS)
+
+divrem$(EXEEXT): $(divrem_OBJECTS) $(divrem_DEPENDENCIES)
+	@rm -f divrem$(EXEEXT)
+	$(LINK) $(divrem_LDFLAGS) $(divrem_OBJECTS) $(divrem_LDADD) $(LIBS)
+
+lshift$(EXEEXT): $(lshift_OBJECTS) $(lshift_DEPENDENCIES)
+	@rm -f lshift$(EXEEXT)
+	$(LINK) $(lshift_LDFLAGS) $(lshift_OBJECTS) $(lshift_LDADD) $(LIBS)
+
+mul_1$(EXEEXT): $(mul_1_OBJECTS) $(mul_1_DEPENDENCIES)
+	@rm -f mul_1$(EXEEXT)
+	$(LINK) $(mul_1_LDFLAGS) $(mul_1_OBJECTS) $(mul_1_LDADD) $(LIBS)
+
+rshift$(EXEEXT): $(rshift_OBJECTS) $(rshift_DEPENDENCIES)
+	@rm -f rshift$(EXEEXT)
+	$(LINK) $(rshift_LDFLAGS) $(rshift_OBJECTS) $(rshift_LDADD) $(LIBS)
+
+sub_n$(EXEEXT): $(sub_n_OBJECTS) $(sub_n_DEPENDENCIES)
+	@rm -f sub_n$(EXEEXT)
+	$(LINK) $(sub_n_LDFLAGS) $(sub_n_OBJECTS) $(sub_n_LDADD) $(LIBS)
+
+submul_1$(EXEEXT): $(submul_1_OBJECTS) $(submul_1_DEPENDENCIES)
+	@rm -f submul_1$(EXEEXT)
+	$(LINK) $(submul_1_LDFLAGS) $(submul_1_OBJECTS) $(submul_1_LDADD) $(LIBS)
+
+try$(EXEEXT): $(try_OBJECTS) $(try_DEPENDENCIES)
+	@rm -f try$(EXEEXT)
+	$(LINK) $(try_LDFLAGS) $(try_OBJECTS) $(try_LDADD) $(LIBS)
+
+tst-addsub$(EXEEXT): $(tst_addsub_OBJECTS) $(tst_addsub_DEPENDENCIES)
+	@rm -f tst-addsub$(EXEEXT)
+	$(LINK) $(tst_addsub_LDFLAGS) $(tst_addsub_OBJECTS) $(tst_addsub_LDADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+add_n_.c: add_n.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/add_n.c; then echo $(srcdir)/add_n.c; else echo add_n.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > add_n_.c
+addmul_1_.c: addmul_1.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/addmul_1.c; then echo $(srcdir)/addmul_1.c; else echo addmul_1.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > addmul_1_.c
+copy_.c: copy.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/copy.c; then echo $(srcdir)/copy.c; else echo copy.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > copy_.c
+divmod_1_.c: divmod_1.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/divmod_1.c; then echo $(srcdir)/divmod_1.c; else echo divmod_1.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > divmod_1_.c
+divrem_.c: divrem.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/divrem.c; then echo $(srcdir)/divrem.c; else echo divrem.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > divrem_.c
+lshift_.c: lshift.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/lshift.c; then echo $(srcdir)/lshift.c; else echo lshift.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > lshift_.c
+mul_1_.c: mul_1.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/mul_1.c; then echo $(srcdir)/mul_1.c; else echo mul_1.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > mul_1_.c
+ref_.c: ref.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/ref.c; then echo $(srcdir)/ref.c; else echo ref.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > ref_.c
+rshift_.c: rshift.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/rshift.c; then echo $(srcdir)/rshift.c; else echo rshift.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > rshift_.c
+spinner_.c: spinner.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/spinner.c; then echo $(srcdir)/spinner.c; else echo spinner.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > spinner_.c
+sub_n_.c: sub_n.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/sub_n.c; then echo $(srcdir)/sub_n.c; else echo sub_n.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > sub_n_.c
+submul_1_.c: submul_1.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/submul_1.c; then echo $(srcdir)/submul_1.c; else echo submul_1.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > submul_1_.c
+trace_.c: trace.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/trace.c; then echo $(srcdir)/trace.c; else echo trace.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > trace_.c
+try_.c: try.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/try.c; then echo $(srcdir)/try.c; else echo try.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > try_.c
+tst-addsub_.c: tst-addsub.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/tst-addsub.c; then echo $(srcdir)/tst-addsub.c; else echo tst-addsub.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > tst-addsub_.c
+add_n_.$(OBJEXT) add_n_.lo addmul_1_.$(OBJEXT) addmul_1_.lo \
+copy_.$(OBJEXT) copy_.lo divmod_1_.$(OBJEXT) divmod_1_.lo \
+divrem_.$(OBJEXT) divrem_.lo lshift_.$(OBJEXT) lshift_.lo \
+mul_1_.$(OBJEXT) mul_1_.lo ref_.$(OBJEXT) ref_.lo rshift_.$(OBJEXT) \
+rshift_.lo spinner_.$(OBJEXT) spinner_.lo sub_n_.$(OBJEXT) sub_n_.lo \
+submul_1_.$(OBJEXT) submul_1_.lo trace_.$(OBJEXT) trace_.lo \
+try_.$(OBJEXT) try_.lo tst-addsub_.$(OBJEXT) tst-addsub_.lo : \
+$(ANSI2KNR)
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am: all-am
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am:
+install-data: install-data-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am:
+uninstall: uninstall-am
+all-am: Makefile
+all-redirect: all-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs:
+
+
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-compile mostlyclean-libtool mostlyclean-kr \
+		mostlyclean-tags mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am:  clean-compile clean-libtool clean-kr clean-tags clean-generic \
+		mostlyclean-am
+
+clean: clean-am
+
+distclean-am:  distclean-compile distclean-libtool distclean-kr \
+		distclean-tags distclean-generic clean-am
+	-rm -f libtool
+
+distclean: distclean-am
+
+maintainer-clean-am:  maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-kr maintainer-clean-tags \
+		maintainer-clean-generic distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool mostlyclean-kr distclean-kr \
+clean-kr maintainer-clean-kr tags mostlyclean-tags distclean-tags \
+clean-tags maintainer-clean-tags distdir info-am info dvi-am dvi check \
+check-am installcheck-am installcheck install-exec-am install-exec \
+install-data-am install-data install-am install uninstall-am uninstall \
+all-redirect all-am all install-strip installdirs mostlyclean-generic \
+distclean-generic clean-generic maintainer-clean-generic clean \
+mostlyclean distclean maintainer-clean
+
+
+allprogs: $(EXTRA_PROGRAMS)
+
+# Relative paths don't work out right when running m4 from a second level
+# subdirectory, so copy the necessary files up to build them.
+.asm.o:
+	cp $< ..; cd ..; $(MAKE) $(AM_MAKEFLAGS) $@; rm $*.asm; mv $*.* tests;
+.asm.obj:
+	cp $< ..; cd ..; $(MAKE) $(AM_MAKEFLAGS) $@; rm $*.asm; mv $*.* tests;
+.asm.lo:
+	cp $< ..; cd ..; $(MAKE) $(AM_MAKEFLAGS) $@; rm $*.asm; mv $*.* tests;
+
+# 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/src/gmp/mpn/tests/README b/src/gmp/mpn/tests/README
new file mode 100644
index 000000000..ff0e64096
--- /dev/null
+++ b/src/gmp/mpn/tests/README
@@ -0,0 +1,19 @@
+
+                         MPN TEST PROGRAMS
+
+
+This directory contains programs designed to exercise various mpn
+subroutines.  Nothing here is built or installed, nor even run in a "make
+check", but there's Makefile rules to build each program, or "allprogs" to
+build everything.
+
+All the programs here are meant only for use during development and casual
+GMP users are unlikely to find anything of interest.
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 76
+End:
diff --git a/src/gmp/mpn/tests/add_n.c b/src/gmp/mpn/tests/add_n.c
new file mode 100644
index 000000000..ff3f965f4
--- /dev/null
+++ b/src/gmp/mpn/tests/add_n.c
@@ -0,0 +1,242 @@
+/*
+Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS (CLOCK/5)
+#endif
+#ifndef SIZE
+#define SIZE 328
+#endif
+#ifndef TIMES
+#define TIMES OPS/SIZE
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+
+mp_limb_t
+#if __STDC__
+refmpn_add_n (mp_ptr res_ptr,
+	       mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
+#else
+refmpn_add_n (res_ptr, s1_ptr, s2_ptr, size)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_srcptr s2_ptr;
+     mp_size_t size;
+#endif
+{
+  register mp_limb_t x, y, cy;
+  register mp_size_t j;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  s1_ptr -= j;
+  s2_ptr -= j;
+  res_ptr -= j;
+
+  cy = 0;
+  do
+    {
+      y = s2_ptr[j];
+      x = s1_ptr[j];
+      y += cy;			/* add previous carry to one addend */
+      cy = (y < cy);		/* get out carry from that addition */
+      y = x + y;		/* add other addend */
+      cy = (y < x) + cy;	/* get out carry from that add, combine */
+      res_ptr[j] = y;
+    }
+  while (++j != 0);
+
+  return cy;
+}
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_limb_t s1[SIZE];
+  mp_limb_t s2[SIZE];
+  mp_limb_t dx[SIZE+2];
+  mp_limb_t dy[SIZE+2];
+  int cyx, cyy;
+  int i;
+  long t0, t;
+  int test;
+  mp_size_t size;
+
+  for (test = 0; ; test++)
+    {
+#if TIMES == 1 && ! defined (PRINT)
+      if (test % (SIZE > 10000 ? 1 : 10000 / SIZE) == 0)
+	{
+	  printf ("\r%d", test);
+	  fflush (stdout);
+	}
+#endif
+
+#ifdef RANDOM
+      size = random () % SIZE + 1;
+#else
+      size = SIZE;
+#endif
+
+      dx[0] = 0x87654321;
+      dy[0] = 0x87654321;
+      dx[size+1] = 0x12345678;
+      dy[size+1] = 0x12345678;
+
+#if TIMES != 1
+      mpn_random (s1, size);
+      mpn_random (s2, size);
+
+#ifndef NOCHECK
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	refmpn_add_n (dx+1, s1, s2, size);
+      t = cputime() - t0;
+      printf ("refmpn_add_n: %5ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	mpn_add_n (dx+1, s1, s2, size);
+      t = cputime() - t0;
+      printf ("mpn_add_n:    %5ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+#ifndef NOCHECK
+      mpn_random2 (s1, size);
+      mpn_random2 (s2, size);
+
+#ifdef PRINT
+      mpn_print (s1, size);
+      mpn_print (s2, size);
+#endif
+
+      /* Put garbage in the destination.  */
+      for (i = 0; i < size; i++)
+	{
+	  dx[i+1] = 0xdead;
+	  dy[i+1] = 0xbeef;
+	}
+
+      cyx = refmpn_add_n (dx+1, s1, s2, size);
+      cyy = mpn_add_n (dy+1, s1, s2, size);
+#ifdef PRINT
+      printf ("%d ", cyx); mpn_print (dx+1, size);
+      printf ("%d ", cyy); mpn_print (dy+1, size);
+#endif
+      if (cyx != cyy || mpn_cmp (dx, dy, size+2) != 0
+	  || dx[0] != 0x87654321 || dx[size+1] != 0x12345678)
+	{
+#ifndef PRINT
+	  printf ("%d ", cyx); mpn_print (dx+1, size);
+	  printf ("%d ", cyy); mpn_print (dy+1, size);
+#endif
+	  printf ("TEST NUMBER %d\n", test);
+	  abort();
+	}
+#endif
+    }
+}
+
+mpn_print (mp_ptr p, mp_size_t size)
+{
+  mp_size_t i;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+#ifdef _LONG_LONG_LIMB
+      printf ("%0*lX%0*lX", (int) (sizeof(mp_limb_t)),
+	      (unsigned long) (p[i] >> (BITS_PER_MP_LIMB/2)),
+              (int) (sizeof(mp_limb_t)), (unsigned long) (p[i]));
+#else
+      printf ("%0*lX", (int) (2 * sizeof(mp_limb_t)), p[i]);
+#endif
+#ifdef SPACE
+      if (i != 0)
+	printf (" ");
+#endif
+    }
+  puts ("");
+}
diff --git a/src/gmp/mpn/tests/addmul_1.c b/src/gmp/mpn/tests/addmul_1.c
new file mode 100644
index 000000000..a0daa2ccf
--- /dev/null
+++ b/src/gmp/mpn/tests/addmul_1.c
@@ -0,0 +1,250 @@
+/*
+Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS (CLOCK/5)
+#endif
+#ifndef SIZE
+#define SIZE 496
+#endif
+#ifndef TIMES
+#define TIMES OPS/SIZE
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+mp_limb_t
+refmpn_addmul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     mp_size_t s1_size;
+     register mp_limb_t s2_limb;
+{
+  register mp_limb_t cy_limb;
+  register mp_size_t j;
+  register mp_limb_t prod_high, prod_low;
+  register mp_limb_t x;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -s1_size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  res_ptr -= j;
+  s1_ptr -= j;
+
+  cy_limb = 0;
+  do
+    {
+      umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
+
+      prod_low += cy_limb;
+      cy_limb = (prod_low < cy_limb) + prod_high;
+
+      x = res_ptr[j];
+      prod_low = x + prod_low;
+      cy_limb += (prod_low < x);
+      res_ptr[j] = prod_low;
+    }
+  while (++j != 0);
+
+  return cy_limb;
+}
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_limb_t s1[SIZE];
+  mp_limb_t dx[SIZE+2];
+  mp_limb_t dy[SIZE+2];
+  mp_limb_t cyx, cyy;
+  int i;
+  long t0, t;
+  int test;
+  mp_limb_t xlimb;
+  mp_size_t size;
+  double cyc;
+
+  for (test = 0; ; test++)
+    {
+#if TIMES == 1 && ! defined (PRINT)
+      if (test % (SIZE > 10000 ? 1 : 10000 / SIZE) == 0)
+	{
+	  printf ("\r%d", test);
+	  fflush (stdout);
+	}
+#endif
+
+#ifdef RANDOM
+      size = random () % SIZE + 1;
+#else
+      size = SIZE;
+#endif
+
+      dy[size+1] = 0x12345678;
+      dy[0] = 0x87654321;
+
+      mpn_random2 (&xlimb, 1);
+
+#if TIMES != 1
+      mpn_random (s1, size);
+      mpn_random (dy+1, size);
+
+#ifndef NOCHECK
+      MPN_COPY (dx, dy, size+2);
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	refmpn_addmul_1 (dx+1, s1, size, xlimb);
+      t = cputime() - t0;
+      cyc = ((double) t * CLOCK) / (OPS * 1000.0);
+      printf ("refmpn_addmul_1: %5ldms (%.2f cycles/limb) [%.2f Gb/s]\n",
+	      t, cyc,
+	      CLOCK/cyc*BITS_PER_MP_LIMB*BITS_PER_MP_LIMB/1e9);
+#endif
+
+      MPN_COPY (dx, dy, size+2);
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	mpn_addmul_1 (dx+1, s1, size, xlimb);
+      t = cputime() - t0;
+      cyc = ((double) t * CLOCK) / (OPS * 1000.0);
+      printf ("mpn_addmul_1:    %5ldms (%.2f cycles/limb) [%.2f Gb/s]\n",
+	      t, cyc,
+	      CLOCK/cyc*BITS_PER_MP_LIMB*BITS_PER_MP_LIMB/1e9);
+#endif
+
+      mpn_random2 (s1, size);
+      mpn_random2 (dy+1, size);
+#if defined (PRINT) || defined (XPRINT)
+      printf ("xlimb=");
+      mpn_print (&xlimb, 1);
+#endif
+#ifdef PRINT
+      mpn_print (dy+1, size);
+      mpn_print (s1, size);
+#endif
+
+      MPN_COPY (dx, dy, size+2);
+      cyx = refmpn_addmul_1 (dx+1, s1, size, xlimb);
+      cyy = mpn_addmul_1 (dy+1, s1, size, xlimb);
+
+#ifdef PRINT
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+      mpn_print (dx+1, size);
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+      mpn_print (dy+1, size);
+#endif
+
+#ifndef NOCHECK
+      if (cyx != cyy || mpn_cmp (dx, dy, size+2) != 0
+	  || dx[size+1] != 0x12345678 || dx[0] != 0x87654321)
+	{
+#ifndef PRINT
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+	  mpn_print (dx+1, size);
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+	  mpn_print (dy+1, size);
+#endif
+	  printf ("TEST NUMBER %d\n", test);
+	  abort();
+	}
+#endif
+    }
+}
+
+mpn_print (mp_ptr p, mp_size_t size)
+{
+  mp_size_t i;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+#ifdef _LONG_LONG_LIMB
+      printf ("%0*lX%0*lX", (int) (sizeof(mp_limb_t)),
+	      (unsigned long) (p[i] >> (BITS_PER_MP_LIMB/2)),
+              (int) (sizeof(mp_limb_t)), (unsigned long) (p[i]));
+#else
+      printf ("%0*lX", (int) (2 * sizeof(mp_limb_t)), p[i]);
+#endif
+#ifdef SPACE
+      if (i != 0)
+	printf (" ");
+#endif
+    }
+  puts ("");
+}
diff --git a/src/gmp/mpn/tests/copy.c b/src/gmp/mpn/tests/copy.c
new file mode 100644
index 000000000..0b022fb45
--- /dev/null
+++ b/src/gmp/mpn/tests/copy.c
@@ -0,0 +1,213 @@
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS (CLOCK/2)
+#endif
+#ifndef SIZE
+#define SIZE 328
+#endif
+#ifndef TIMES
+#define TIMES (OPS/SIZE)
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+
+void
+#if __STDC__
+refmpn_copyi (mp_ptr rptr, mp_srcptr sptr, mp_size_t n)
+#else
+refmpn_copyi (rptr, sptr, n)
+     register mp_ptr rptr;
+     register mp_srcptr sptr;
+     mp_size_t n;
+#endif
+{
+  mp_size_t i;
+
+  for (i = 0; i < n; i++)
+    rptr[i] = sptr[i];
+}
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_limb_t s1[SIZE];
+  mp_limb_t dx[SIZE+2];
+  mp_limb_t dy[SIZE+2];
+  int i;
+  long t0, t;
+  int test;
+  mp_size_t size;
+
+  for (test = 0; ; test++)
+    {
+#if TIMES == 1 && ! defined (PRINT)
+      if (test % (SIZE > 10000 ? 1 : 10000 / SIZE) == 0)
+	{
+	  printf ("\r%d", test);
+	  fflush (stdout);
+	}
+#endif
+
+#ifdef RANDOM
+      size = (random () % SIZE + 1);
+#else
+      size = SIZE;
+#endif
+
+      dx[0] = 0x87654321;
+      dy[0] = 0x87654321;
+      dx[size+1] = 0x12345678;
+      dy[size+1] = 0x12345678;
+
+#if TIMES != 1
+      mpn_random (s1, size);
+
+#ifndef NOCHECK
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	refmpn_copyi (dx+1, s1, size);
+      t = cputime() - t0;
+      printf ("refmpn_copyi:   %ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	MPN_COPY_INCR (dx+1, s1, size);
+      t = cputime() - t0;
+      printf ("MPN_COPY_INCR:   %ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+#ifndef NOCHECK
+      mpn_random2 (s1, size);
+
+#ifdef PRINT
+      mpn_print (s1, size);
+#endif
+
+      /* Put garbage in the destination.  */
+      for (i = 0; i < size; i++)
+	{
+	  dx[i+1] = 0xdead;
+	  dy[i+1] = 0xbeef;
+	}
+
+      refmpn_copyi (dx+1, s1, size);
+      MPN_COPY_INCR (dy+1, s1, size);
+#ifdef PRINT
+      mpn_print (dx+1, size);
+      mpn_print (dy+1, size);
+#endif
+      if (mpn_cmp (dx, dy, size+2) != 0
+	  || dx[0] != 0x87654321 || dx[size+1] != 0x12345678)
+	{
+#ifndef PRINT
+	  mpn_print (dx+1, size);
+	  mpn_print (dy+1, size);
+#endif
+	  printf ("TEST NUMBER %d\n", test);
+	  abort();
+	}
+#endif
+    }
+}
+
+mpn_print (mp_ptr p, mp_size_t size)
+{
+  mp_size_t i;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+#ifdef _LONG_LONG_LIMB
+      printf ("%0*lX%0*lX", (int) (sizeof(mp_limb_t)),
+	      (unsigned long) (p[i] >> (BITS_PER_MP_LIMB/2)),
+              (int) (sizeof(mp_limb_t)), (unsigned long) (p[i]));
+#else
+      printf ("%0*lX", (int) (2 * sizeof(mp_limb_t)), p[i]);
+#endif
+#ifdef SPACE
+      if (i != 0)
+	printf (" ");
+#endif
+    }
+  puts ("");
+}
diff --git a/src/gmp/mpn/tests/divmod_1.c b/src/gmp/mpn/tests/divmod_1.c
new file mode 100644
index 000000000..8ced99799
--- /dev/null
+++ b/src/gmp/mpn/tests/divmod_1.c
@@ -0,0 +1,133 @@
+/*
+Copyright (C) 1996, 1998, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS 20000000
+#endif
+#ifndef SIZE
+#define SIZE 1000
+#endif
+#ifndef TIMES
+#define TIMES OPS/SIZE
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+main ()
+{
+  mp_limb_t nptr[SIZE];
+  mp_limb_t qptr[SIZE];
+  mp_limb_t pptr[SIZE];
+  mp_limb_t dlimb, rlimb, plimb;
+  mp_size_t nsize, qsize, psize;
+  int test;
+
+  for (test = 0; ; test++)
+    {
+#ifdef RANDOM
+      nsize = random () % SIZE + 1;
+#else
+      nsize = SIZE;
+#endif
+
+      mpn_random2 (nptr, nsize);
+
+      mpn_random2 (&dlimb, 1);
+      if (dlimb == 0)
+	abort ();
+
+      rlimb = mpn_divmod_1 (qptr, nptr, nsize, dlimb);
+      qsize = nsize - (qptr[nsize - 1] == 0);
+      if (qsize == 0)
+	{
+	  plimb = rlimb;
+	  psize = qsize;
+	}
+      else
+	{
+	  plimb = mpn_mul_1 (pptr, qptr, qsize, dlimb);
+	  psize = qsize;
+	  plimb += mpn_add_1 (pptr, pptr, psize, rlimb);
+	}
+      if (plimb != 0)
+	pptr[psize++] = plimb;
+
+
+      if (nsize != psize || mpn_cmp (nptr, pptr, nsize) != 0)
+	abort ();
+    }
+}
diff --git a/src/gmp/mpn/tests/divrem.c b/src/gmp/mpn/tests/divrem.c
new file mode 100644
index 000000000..97098294b
--- /dev/null
+++ b/src/gmp/mpn/tests/divrem.c
@@ -0,0 +1,143 @@
+/*
+Copyright (C) 1996, 1997, 1998, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS 20000000
+#endif
+#ifndef SIZE
+#define SIZE 100
+#endif
+#ifndef TIMES
+#define TIMES OPS/SIZE
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+main ()
+{
+  mp_limb_t nptr[2 * SIZE];
+  mp_limb_t dptr[2 * SIZE];
+  mp_limb_t qptr[2 * SIZE];
+  mp_limb_t pptr[2 * SIZE + 1];
+  mp_limb_t rptr[2 * SIZE];
+  mp_size_t nsize, dsize, qsize, rsize, psize;
+  int test;
+  mp_limb_t qlimb;
+
+  for (test = 0; ; test++)
+    {
+      printf ("%d\n", test);
+#ifdef RANDOM
+      nsize = random () % (2 * SIZE) + 1;
+      dsize = random () % nsize + 1;
+#else
+      nsize = 2 * SIZE;
+      dsize = SIZE;
+#endif
+
+      mpn_random2 (nptr, nsize);
+      mpn_random2 (dptr, dsize);
+      dptr[dsize - 1] |= (mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1);
+
+      MPN_COPY (rptr, nptr, nsize);
+      qlimb = mpn_divrem (qptr, (mp_size_t) 0, rptr, nsize, dptr, dsize);
+      rsize = dsize;
+      qsize = nsize - dsize;
+      qptr[qsize] = qlimb;
+      qsize += qlimb;
+      if (qsize == 0 || qsize > 2 * SIZE)
+	{
+	  continue;		/* bogus */
+	}
+      else
+	{
+	  mp_limb_t cy;
+	  if (qsize > dsize)
+	    mpn_mul (pptr, qptr, qsize, dptr, dsize);
+	  else
+	    mpn_mul (pptr, dptr, dsize, qptr, qsize);
+	  psize = qsize + dsize;
+	  psize -= pptr[psize - 1] == 0;
+	  cy = mpn_add (pptr, pptr, psize, rptr, rsize);
+	  pptr[psize] = cy;
+	  psize += cy;
+	}
+
+      if (nsize != psize || mpn_cmp (nptr, pptr, nsize) != 0)
+	abort ();
+    }
+}
diff --git a/src/gmp/mpn/tests/lshift.c b/src/gmp/mpn/tests/lshift.c
new file mode 100644
index 000000000..1e10f8f0b
--- /dev/null
+++ b/src/gmp/mpn/tests/lshift.c
@@ -0,0 +1,264 @@
+/*
+Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS (CLOCK/5)
+#endif
+#ifndef SIZE
+#define SIZE 496
+#endif
+#ifndef TIMES
+#define TIMES OPS/SIZE
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+mp_limb_t
+refmpn_lshift (wp, up, usize, cnt)
+     register mp_ptr wp;
+     register mp_srcptr up;
+     mp_size_t usize;
+     register unsigned int cnt;
+{
+  register mp_limb_t high_limb, low_limb;
+  register unsigned sh_1, sh_2;
+  register mp_size_t i;
+  mp_limb_t retval;
+
+#ifdef DEBUG
+  if (usize == 0 || cnt == 0)
+    abort ();
+#endif
+
+  sh_1 = cnt;
+#if 0
+  if (sh_1 == 0)
+    {
+      if (wp != up)
+	{
+	  /* Copy from high end to low end, to allow specified input/output
+	     overlapping.  */
+	  for (i = usize - 1; i >= 0; i--)
+	    wp[i] = up[i];
+	}
+      return 0;
+    }
+#endif
+
+  wp += 1;
+  sh_2 = BITS_PER_MP_LIMB - sh_1;
+  i = usize - 1;
+  low_limb = up[i];
+  retval = low_limb >> sh_2;
+  high_limb = low_limb;
+  while (--i >= 0)
+    {
+      low_limb = up[i];
+      wp[i] = (high_limb << sh_1) | (low_limb >> sh_2);
+      high_limb = low_limb;
+    }
+  wp[i] = high_limb << sh_1;
+
+  return retval;
+}
+
+#ifndef CNT
+#define CNT 4
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_limb_t s1[SIZE];
+  mp_limb_t dx[SIZE+2];
+  mp_limb_t dy[SIZE+2];
+  mp_limb_t cyx, cyy;
+  int i;
+  long t0, t;
+  int test;
+  int cnt = CNT;
+  mp_size_t size;
+
+  for (test = 0; ; test++)
+    {
+#if TIMES == 1 && ! defined (PRINT)
+      if (test % (SIZE > 10000 ? 1 : 10000 / SIZE) == 0)
+	{
+	  printf ("\r%d", test);
+	  fflush (stdout);
+	}
+#endif
+
+#if TIMES == 1
+      cnt = random () % (BITS_PER_MP_LIMB - 1) + 1;
+#endif
+
+#ifdef RANDOM
+      size = random () % SIZE + 1;
+#else
+      size = SIZE;
+#endif
+      mpn_random2 (s1, size);
+
+      dx[size+1] = 0x12345678;
+      dy[size+1] = 0x12345678;
+      dx[0] = 0x87654321;
+      dy[0] = 0x87654321;
+
+#if TIMES != 1
+      mpn_random (s1, size);
+
+#ifndef NOCHECK
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	refmpn_lshift (dx+1, s1, size, cnt);
+      t = cputime() - t0;
+      printf ("refmpn_lshift: %5ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	mpn_lshift (dx+1, s1, size, cnt);
+      t = cputime() - t0;
+      printf ("mpn_lshift:    %5ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+#ifndef NOCHECK
+      mpn_random2 (s1, size);
+
+#ifdef PRINT
+      printf ("%-*d ", (int) (2 * sizeof(mp_limb_t)), cnt); mpn_print (s1, size);
+#endif
+
+      /* Put garbage in the destination.  */
+      for (i = 0; i < size; i++)
+	{
+	  dx[i+1] = 0xdead;
+	  dy[i+1] = 0xbeef;
+	}
+
+      cyx = refmpn_lshift (dx+1, s1, size, cnt);
+      cyy = mpn_lshift (dy+1, s1, size, cnt);
+#ifdef PRINT
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+      mpn_print (dx+1, size);
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+      mpn_print (dy+1, size);
+#endif
+      if (cyx != cyy || mpn_cmp (dx, dy, size+2) != 0
+	  || dx[0] != 0x87654321 || dx[size+1] != 0x12345678)
+	{
+#ifndef PRINT
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+	  mpn_print (dx+1, size);
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+	  mpn_print (dy+1, size);
+#endif
+	  printf ("TEST NUMBER %d\n", test);
+	  if (dy[size+1] != 0x12345678)
+	    printf ("clobbered at high end\n");
+	  if (dy[0] != 0x87654321)
+	    printf ("clobbered at low end\n");
+	  abort();
+	}
+#endif
+    }
+}
+
+mpn_print (mp_ptr p, mp_size_t size)
+{
+  mp_size_t i;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+#ifdef _LONG_LONG_LIMB
+      printf ("%0*lX%0*lX", (int) (sizeof(mp_limb_t)),
+	      (unsigned long) (p[i] >> (BITS_PER_MP_LIMB/2)),
+              (int) (sizeof(mp_limb_t)), (unsigned long) (p[i]));
+#else
+      printf ("%0*lX", (int) (2 * sizeof(mp_limb_t)), p[i]);
+#endif
+#ifdef SPACE
+      if (i != 0)
+	printf (" ");
+#endif
+    }
+  puts ("");
+}
diff --git a/src/gmp/mpn/tests/mul_1.c b/src/gmp/mpn/tests/mul_1.c
new file mode 100644
index 000000000..12cdbf358
--- /dev/null
+++ b/src/gmp/mpn/tests/mul_1.c
@@ -0,0 +1,248 @@
+/*
+Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS (CLOCK/5)
+#endif
+#ifndef SIZE
+#define SIZE 496
+#endif
+#ifndef TIMES
+#define TIMES OPS/SIZE
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+mp_limb_t
+refmpn_mul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     mp_size_t s1_size;
+     register mp_limb_t s2_limb;
+{
+  register mp_limb_t cy_limb;
+  register mp_size_t j;
+  register mp_limb_t prod_high, prod_low;
+
+  /* The loop counter and index J goes from -S1_SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -s1_size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  s1_ptr -= j;
+  res_ptr -= j;
+
+  cy_limb = 0;
+  do
+    {
+      umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
+
+      prod_low += cy_limb;
+      cy_limb = (prod_low < cy_limb) + prod_high;
+
+      res_ptr[j] = prod_low;
+    }
+  while (++j != 0);
+
+  return cy_limb;
+}
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_limb_t s1[SIZE];
+  mp_limb_t dx[SIZE+2];
+  mp_limb_t dy[SIZE+2];
+  mp_limb_t cyx, cyy;
+  int i;
+  long t0, t;
+  int test;
+  mp_limb_t xlimb;
+  mp_size_t size;
+  double cyc;
+
+  for (test = 0; ; test++)
+    {
+#if TIMES == 1 && ! defined (PRINT)
+      if (test % (SIZE > 10000 ? 1 : 10000 / SIZE) == 0)
+	{
+	  printf ("\r%d", test);
+	  fflush (stdout);
+	}
+#endif
+
+#ifdef RANDOM
+      size = random () % SIZE + 1;
+#else
+      size = SIZE;
+#endif
+
+      dy[size+1] = 0x12345678;
+      dy[0] = 0x87654321;
+
+      mpn_random2 (&xlimb, 1);
+
+#if TIMES != 1
+      mpn_random (s1, size);
+      mpn_random (dy+1, size);
+
+#ifndef NOCHECK
+      MPN_COPY (dx, dy, size+2);
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	refmpn_mul_1 (dx+1, s1, size, xlimb);
+      t = cputime() - t0;
+      cyc = ((double) t * CLOCK) / (OPS * 1000.0);
+      printf ("refmpn_mul_1: %5ldms (%.2f cycles/limb) [%.2f Gb/s]\n",
+	      t, cyc,
+	      CLOCK/cyc*BITS_PER_MP_LIMB*BITS_PER_MP_LIMB/1e9);
+#endif
+
+      MPN_COPY (dx, dy, size+2);
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	mpn_mul_1 (dx+1, s1, size, xlimb);
+      t = cputime() - t0;
+      cyc = ((double) t * CLOCK) / (OPS * 1000.0);
+      printf ("mpn_mul_1:    %5ldms (%.2f cycles/limb) [%.2f Gb/s]\n",
+	      t, cyc,
+	      CLOCK/cyc*BITS_PER_MP_LIMB*BITS_PER_MP_LIMB/1e9);
+#endif
+
+      mpn_random2 (s1, size);
+      mpn_random2 (dy+1, size);
+#if defined (PRINT) || defined (XPRINT)
+      printf ("xlimb=");
+      mpn_print (&xlimb, 1);
+#endif
+#ifdef PRINT
+      mpn_print (s1, size);
+#endif
+
+      MPN_COPY (dx, dy, size+2);
+      cyx = refmpn_mul_1 (dx+1, s1, size, xlimb);
+      cyy = mpn_mul_1 (dy+1, s1, size, xlimb);
+
+#ifdef PRINT
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+      mpn_print (dx+1, size);
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+      mpn_print (dy+1, size);
+#endif
+
+#ifndef NOCHECK
+      if (cyx != cyy || mpn_cmp (dx, dy, size+2) != 0
+	  || dx[size+1] != 0x12345678 || dx[0] != 0x87654321)
+	{
+#if ! (defined (PRINT) || defined (XPRINT))
+	  printf ("xlimb=%*lX\n", (int) (2 * sizeof(mp_limb_t)), xlimb);
+#endif
+#ifndef PRINT
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+	  mpn_print (dx+1, size);
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+	  mpn_print (dy+1, size);
+#endif
+	  printf ("TEST NUMBER %d\n", test);
+	  abort();
+	}
+#endif
+    }
+}
+
+mpn_print (mp_ptr p, mp_size_t size)
+{
+  mp_size_t i;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+#ifdef _LONG_LONG_LIMB
+      printf ("%0*lX%0*lX", (int) (sizeof(mp_limb_t)),
+	      (unsigned long) (p[i] >> (BITS_PER_MP_LIMB/2)),
+              (int) (sizeof(mp_limb_t)), (unsigned long) (p[i]));
+#else
+      printf ("%0*lX", (int) (2 * sizeof(mp_limb_t)), p[i]);
+#endif
+#ifdef SPACE
+      if (i != 0)
+	printf (" ");
+#endif
+    }
+  puts ("");
+}
diff --git a/src/gmp/mpn/tests/ref.c b/src/gmp/mpn/tests/ref.c
new file mode 100644
index 000000000..5bf9609ba
--- /dev/null
+++ b/src/gmp/mpn/tests/ref.c
@@ -0,0 +1,942 @@
+/* Reference mpn functions, designed to be simple, portable and independent
+   of the normal gmp code.  Speed isn't a consideration.  */
+
+/*
+Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+
+/* Most routines have assertions representing what the mpn routines are
+   supposed to accept.  Many of these reference routines do sensible things
+   outside these ranges (eg. for size==0), but the assertions are present to
+   pick up bad parameters passed here that are about to be passed the same
+   to a real mpn routine being compared.  */
+
+/* always do assertion checking */
+#define WANT_ASSERT  1
+
+#include <stdio.h>  /* for NULL */
+#include <stdlib.h> /* for malloc */
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#include "ref.h"
+
+
+/* Check overlap for a routine defined to work low to high. */
+int
+refmpn_overlap_low_to_high_p (mp_srcptr dst, mp_srcptr src, mp_size_t size)
+{
+  return (!MPN_OVERLAP_P (dst, size, src, size) || dst <= src);
+}
+
+/* Check overlap for a routine defined to work high to low. */
+int
+refmpn_overlap_high_to_low_p (mp_srcptr dst, mp_srcptr src, mp_size_t size)
+{
+  return (!MPN_OVERLAP_P (dst, size, src, size) || dst >= src);
+}
+
+/* Check overlap for a standard routine requiring equal or separate. */
+int
+refmpn_overlap_fullonly_p (mp_srcptr dst, mp_srcptr src, mp_size_t size)
+{
+  return (dst == src || !MPN_OVERLAP_P (dst, size, src, size));
+}
+int
+refmpn_overlap_fullonly_two_p (mp_srcptr dst, mp_srcptr src1, mp_srcptr src2,
+                               mp_size_t size)
+{
+  return (refmpn_overlap_fullonly_p (dst, src1, size)
+          && refmpn_overlap_fullonly_p (dst, src2, size));
+}
+
+
+mp_ptr
+refmpn_malloc_limbs (mp_size_t size)
+{
+  mp_ptr  p;
+  ASSERT (size >= 0);
+  if (size == 0)
+    size = 1;
+  p = (mp_ptr) malloc (size * BYTES_PER_MP_LIMB);
+  ASSERT (p != NULL);
+  return p;
+}
+
+mp_ptr
+refmpn_memdup_limbs (mp_srcptr ptr, mp_size_t size)
+{
+  mp_ptr  p;
+  p = refmpn_malloc_limbs (size);
+  refmpn_copyi (p, ptr, size);
+  return p;
+}
+
+void
+refmpn_fill (mp_ptr ptr, mp_size_t size, mp_limb_t value)
+{
+  mp_size_t  i;
+  ASSERT (size >= 0);
+  for (i = 0; i < size; i++)
+    ptr[i] = value;
+}
+
+int
+refmpn_zero_p (mp_srcptr ptr, mp_size_t size)
+{
+  mp_size_t  i;
+  for (i = 0; i < size; i++)
+    if (ptr[i] != 0)
+      return 0;
+  return 1;
+}
+
+mp_limb_t
+refmpn_msbone (mp_limb_t x)
+{
+  mp_limb_t  n = (mp_limb_t) 1 << (BITS_PER_MP_LIMB-1);
+
+  while (n != 0)
+    {
+      if (x & n)
+        break;
+      n >>= 1;
+    }
+  return n;
+}
+
+/* a mask of the MSB one bit and all bits below */
+mp_limb_t
+refmpn_msbone_mask (mp_limb_t x)
+{
+  if (x == 0)
+    return 0;
+
+  return (refmpn_msbone (x) << 1) - 1;
+}
+
+void
+refmpn_copyi (mp_ptr rp, mp_srcptr sp, mp_size_t size)
+{
+  mp_size_t i;
+
+  ASSERT (refmpn_overlap_low_to_high_p (rp, sp, size));
+  ASSERT (size >= 0);
+
+  for (i = 0; i < size; i++)
+    rp[i] = sp[i];
+}
+
+void
+refmpn_copyd (mp_ptr rp, mp_srcptr sp, mp_size_t size)
+{
+  mp_size_t i;
+
+  ASSERT (refmpn_overlap_high_to_low_p (rp, sp, size));
+  ASSERT (size >= 0);
+
+  for (i = size-1; i >= 0; i--)
+    rp[i] = sp[i];
+}
+
+void
+refmpn_com_n (mp_ptr rp, mp_srcptr sp, mp_size_t size)
+{
+  mp_size_t i;
+
+  ASSERT (refmpn_overlap_fullonly_p (rp, sp, size));
+  ASSERT (size >= 1);
+
+  for (i = 0; i < size; i++)
+    rp[i] = ~sp[i];
+}
+
+
+int
+refmpn_cmp (mp_srcptr xp, mp_srcptr yp, mp_size_t size)
+{
+  mp_size_t  i;
+
+  ASSERT (size >= 1);
+
+  for (i = size-1; i >= 0; i--)
+    {
+      if (xp[i] > yp[i])  return 1;
+      if (xp[i] < yp[i])  return -1;
+    }
+  return 0;
+}
+
+int
+refmpn_cmp_twosizes (mp_srcptr xp, mp_size_t xsize,
+                     mp_srcptr yp, mp_size_t ysize)
+{
+  int  opp, cmp;
+
+  opp = (xsize < ysize);
+  if (opp)
+    MPN_SRCPTR_SWAP (xp,xsize, yp,ysize);
+  
+  if (! refmpn_zero_p (xp+ysize, xsize-ysize))
+    cmp = 1;
+  else
+    cmp = refmpn_cmp (xp, yp, ysize);
+
+  return (opp ? -cmp : cmp);
+}
+
+
+#define LOGOPS(operation)                                               \
+  {                                                                     \
+    mp_size_t  i;                                                       \
+                                                                        \
+    ASSERT (refmpn_overlap_fullonly_two_p (rp, s1p, s2p, size));        \
+    ASSERT (size >= 1);                                                 \
+                                                                        \
+    for (i = 0; i < size; i++)                                          \
+      rp[i] = operation;                                                \
+  }
+
+void
+refmpn_and_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  LOGOPS (s1p[i] &  s2p[i]);
+}
+void
+refmpn_andn_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  LOGOPS (s1p[i] & ~s2p[i]);
+}
+void
+refmpn_nand_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  LOGOPS (~(s1p[i] &  s2p[i]));
+}
+void
+refmpn_ior_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  LOGOPS (s1p[i] |  s2p[i]);
+}
+void
+refmpn_iorn_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  LOGOPS (s1p[i] | ~s2p[i]);
+}
+void
+refmpn_nior_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  LOGOPS (~(s1p[i] |  s2p[i]));
+}
+void
+refmpn_xor_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  LOGOPS (s1p[i] ^  s2p[i]);
+}
+void
+refmpn_xnor_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  LOGOPS (~(s1p[i] ^  s2p[i]));
+}
+
+/* set *w to x+y, return 0 or 1 carry */
+mp_limb_t
+add (mp_limb_t *w, mp_limb_t x, mp_limb_t y)
+{
+  *w = x + y;
+  return *w < x;
+}
+
+/* set *w to x-y, return 0 or 1 borrow */
+mp_limb_t
+sub (mp_limb_t *w, mp_limb_t x, mp_limb_t y)
+{
+  *w = x - y;
+  return *w > x;
+}
+
+/* set *w to x+y+c (where c is 0 or 1), return 0 or 1 carry */
+mp_limb_t
+adc (mp_limb_t *w, mp_limb_t x, mp_limb_t y, mp_limb_t c)
+{
+  mp_limb_t  r;
+  ASSERT (c == 0 || c == 1);
+  r = add (w, x, y);
+  return r + add (w, *w, c);
+}
+
+/* set *w to x-y-c (where c is 0 or 1), return 0 or 1 borrow */
+mp_limb_t
+sbb (mp_limb_t *w, mp_limb_t x, mp_limb_t y, mp_limb_t c)
+{
+  mp_limb_t  r;
+  ASSERT (c == 0 || c == 1);
+  r = sub (w, x, y);
+  return r + sub (w, *w, c);
+}
+
+
+#define AORS_1(operation)                               \
+  {                                                     \
+    mp_limb_t  i;                                       \
+                                                        \
+    ASSERT (refmpn_overlap_fullonly_p (rp, sp, size));  \
+    ASSERT (size >= 1);                                 \
+                                                        \
+    for (i = 0; i < size; i++)                          \
+      n = operation (&rp[i], sp[i], n);                 \
+    return n;                                           \
+  }
+
+mp_limb_t
+refmpn_add_1 (mp_ptr rp, mp_srcptr sp, mp_size_t size, mp_limb_t n)
+{
+  AORS_1 (add);
+}
+mp_limb_t
+refmpn_sub_1 (mp_ptr rp, mp_srcptr sp, mp_size_t size, mp_limb_t n)
+{
+  AORS_1 (sub);
+}
+
+#define AORS_NC(operation)                                              \
+  {                                                                     \
+    mp_size_t  i;                                                       \
+                                                                        \
+    ASSERT (refmpn_overlap_fullonly_two_p (rp, s1p, s2p, size));        \
+    ASSERT (carry == 0 || carry == 1);                                  \
+    ASSERT (size >= 1);                                                 \
+                                                                        \
+    for (i = 0; i < size; i++)                                          \
+      carry = operation (&rp[i], s1p[i], s2p[i], carry);                \
+    return carry;                                                       \
+  }
+
+mp_limb_t
+refmpn_add_nc (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size,
+               mp_limb_t carry)
+{
+  AORS_NC (adc);
+}
+mp_limb_t
+refmpn_sub_nc (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size,
+               mp_limb_t carry)
+{
+  AORS_NC (sbb);
+}
+
+
+mp_limb_t
+refmpn_add_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  return refmpn_add_nc (rp, s1p, s2p, size, 0);
+}
+mp_limb_t
+refmpn_sub_n (mp_ptr rp, mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  return refmpn_sub_nc (rp, s1p, s2p, size, 0);
+}
+
+
+#define AORS(aors_n, aors_1)                                    \
+  {                                                             \
+    mp_limb_t  c;                                               \
+    ASSERT (s1size >= s2size);                                  \
+    ASSERT (s2size >= 1);                                       \
+    c = aors_n (rp, s1p, s2p, s2size);                          \
+    if (s1size-s2size != 0)                                     \
+      c = aors_1 (rp+s2size, s1p+s2size, s1size-s2size, c);     \
+    return c;                                                   \
+  }
+mp_limb_t
+refmpn_add (mp_ptr rp,
+            mp_srcptr s1p, mp_size_t s1size,
+            mp_srcptr s2p, mp_size_t s2size)
+{
+  AORS (refmpn_add_n, refmpn_add_1);
+}
+mp_limb_t
+refmpn_sub (mp_ptr rp,
+            mp_srcptr s1p, mp_size_t s1size,
+            mp_srcptr s2p, mp_size_t s2size)
+{
+  AORS (refmpn_sub_n, refmpn_sub_1);
+}
+
+
+#define SHIFTHIGH(x) ((x) << BITS_PER_MP_LIMB/2)
+#define SHIFTLOW(x)  ((x) >> BITS_PER_MP_LIMB/2)
+
+#define LOWMASK   (((mp_limb_t) 1 << BITS_PER_MP_LIMB/2)-1)
+#define HIGHMASK  SHIFTHIGH(LOWMASK)
+
+#define LOWPART(x)   ((x) & LOWMASK)
+#define HIGHPART(x)  SHIFTLOW((x) & HIGHMASK)
+
+/* set *hi,*lo to x*y */
+void
+mul (mp_limb_t *hi, mp_limb_t *lo, mp_limb_t x, mp_limb_t y)
+{
+  mp_limb_t s;
+  
+  *lo = LOWPART(x) * LOWPART(y);
+  *hi = HIGHPART(x) * HIGHPART(y);
+
+  s = LOWPART(x) * HIGHPART(y);
+  ASSERT_NOCARRY (add (hi, *hi, add (lo, *lo, SHIFTHIGH(LOWPART(s)))));
+  ASSERT_NOCARRY (add (hi, *hi, HIGHPART(s)));
+
+  s = HIGHPART(x) * LOWPART(y);
+  ASSERT_NOCARRY (add (hi, *hi, add (lo, *lo, SHIFTHIGH(LOWPART(s)))));
+  ASSERT_NOCARRY (add (hi, *hi, HIGHPART(s)));
+}
+
+mp_limb_t
+refmpn_mul_1c (mp_ptr rp, mp_srcptr sp, mp_size_t size, mp_limb_t multiplier,
+               mp_limb_t carry)
+{
+  mp_size_t  i;
+  mp_limb_t  hi, lo;
+  
+  ASSERT (refmpn_overlap_fullonly_p (rp, sp, size));
+  ASSERT (size >= 1);
+                                                                          
+  for (i = 0; i < size; i++)
+    {
+      mul (&hi, &lo, sp[i], multiplier);
+      ASSERT_NOCARRY (add (&hi, hi, add (&lo, lo, carry)));
+      rp[i] = lo;
+      carry = hi;
+    }
+  
+  return carry;
+}
+
+mp_limb_t
+refmpn_mul_1 (mp_ptr rp, mp_srcptr sp, mp_size_t size, mp_limb_t multiplier)
+{
+  return refmpn_mul_1c (rp, sp, size, multiplier, 0);
+}
+
+
+#define AORSMUL_1C(operation_n)                                 \
+  {                                                             \
+    mp_ptr     p = refmpn_malloc_limbs (size);                  \
+    mp_limb_t  ret;                                             \
+                                                                \
+    ASSERT (refmpn_overlap_fullonly_p (rp, sp, size));          \
+    ASSERT (size >= 1);                                         \
+                                                                \
+    ret = refmpn_mul_1c (p, sp, size, multiplier, carry);       \
+    ret += operation_n (rp, rp, p, size);                       \
+                                                                \
+    free (p);                                                   \
+    return ret;                                                 \
+  }
+
+mp_limb_t
+refmpn_addmul_1c (mp_ptr rp, mp_srcptr sp, mp_size_t size,
+                  mp_limb_t multiplier, mp_limb_t carry)
+{
+  AORSMUL_1C (refmpn_add_n);
+}
+mp_limb_t
+refmpn_submul_1c (mp_ptr rp, mp_srcptr sp, mp_size_t size,
+                  mp_limb_t multiplier, mp_limb_t carry)
+{
+  AORSMUL_1C (refmpn_sub_n);
+}
+
+
+mp_limb_t
+refmpn_addmul_1 (mp_ptr rp, mp_srcptr sp, mp_size_t size, mp_limb_t multiplier)
+{
+  return refmpn_addmul_1c (rp, sp, size, multiplier, 0);
+}
+mp_limb_t
+refmpn_submul_1 (mp_ptr rp, mp_srcptr sp, mp_size_t size, mp_limb_t multiplier)
+{
+  return refmpn_submul_1c (rp, sp, size, multiplier, 0);
+}
+
+
+mp_limb_t
+refmpn_addsub_nc (mp_ptr r1p, mp_ptr r2p,
+                  mp_srcptr s1p, mp_srcptr s2p, mp_size_t size,
+                  mp_limb_t carry)
+{
+  mp_ptr p;
+  mp_limb_t acy, scy;
+
+  /* Destinations can't overlap. */
+  ASSERT (! MPN_OVERLAP_P (r1p, size, r2p, size));
+  ASSERT (refmpn_overlap_fullonly_two_p (r1p, s1p, s2p, size));
+  ASSERT (refmpn_overlap_fullonly_two_p (r2p, s1p, s2p, size));
+  ASSERT (size >= 1);
+
+  p = refmpn_malloc_limbs (size);
+  acy = refmpn_add_nc (p, s1p, s2p, size, carry >> 1);
+  scy = refmpn_sub_nc (r2p, s1p, s2p, size, carry & 1);
+  refmpn_copyi (r1p, p, size);
+  free (p);
+  return 2 * acy + scy;
+}
+
+mp_limb_t
+refmpn_addsub_n (mp_ptr r1p, mp_ptr r2p,
+		 mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  return refmpn_addsub_nc (r1p, r2p, s1p, s2p, size, 0);
+}
+
+
+/* Right shift hi,lo and return the low limb of the result.
+   Note a shift by BITS_PER_MP_LIMB isn't assumed to work (doesn't on x86). */
+mp_limb_t
+rshift_make (mp_limb_t hi, mp_limb_t lo, unsigned shift)
+{
+  ASSERT (shift >= 0 && shift < BITS_PER_MP_LIMB);
+  if (shift == 0)
+    return lo;
+  else
+    return (hi << (BITS_PER_MP_LIMB-shift)) | (lo >> shift);
+}
+
+/* Left shift hi,lo and return the high limb of the result.
+   Note a shift by BITS_PER_MP_LIMB isn't assumed to work (doesn't on x86). */
+mp_limb_t
+lshift_make (mp_limb_t hi, mp_limb_t lo, unsigned shift)
+{
+  ASSERT (shift >= 0 && shift < BITS_PER_MP_LIMB);
+  if (shift == 0)
+    return hi;
+  else
+    return (hi << shift) | (lo >> (BITS_PER_MP_LIMB-shift));
+}
+
+
+mp_limb_t
+refmpn_rshift (mp_ptr rp, mp_srcptr sp, mp_size_t size, unsigned shift)
+{
+  mp_limb_t  ret;
+  mp_size_t  i;
+
+  ASSERT (refmpn_overlap_low_to_high_p (rp, sp, size));
+  ASSERT (size >= 1);
+  ASSERT (shift >= 1 && shift < BITS_PER_MP_LIMB);
+
+  ret = rshift_make (sp[0], 0, shift);
+
+  for (i = 0; i < size-1; i++)
+    rp[i] = rshift_make (sp[i+1], sp[i], shift);
+
+  rp[i] = rshift_make (0, sp[i], shift);
+  return ret;
+}
+
+mp_limb_t
+refmpn_lshift (mp_ptr rp, mp_srcptr sp, mp_size_t size, unsigned shift)
+{
+  mp_limb_t  ret;
+  mp_size_t  i;
+
+  ASSERT (refmpn_overlap_high_to_low_p (rp, sp, size));
+  ASSERT (size >= 1);
+  ASSERT (shift >= 1 && shift < BITS_PER_MP_LIMB);
+
+  ret = lshift_make (0, sp[size-1], shift);
+
+  for (i = size-2; i >= 0; i--)
+    rp[i+1] = lshift_make (sp[i+1], sp[i], shift);
+
+  rp[i+1] = lshift_make (sp[i+1], 0, shift);
+  return ret;
+}
+
+
+/* Divide h,l by d, producing a quotient *q and remainder *r.
+   Must have h < d.
+   __udiv_qrnnd_c isn't simple, and it's a bit slow, but it works. */
+void
+div1 (mp_limb_t *q, mp_limb_t *r, mp_limb_t h, mp_limb_t l, mp_limb_t d)
+{
+  int  n;
+
+  ASSERT (d != 0);
+  ASSERT (h < d);
+
+#if 0
+  udiv_qrnnd (*q, *r, h, l, d);
+  return;
+#endif
+
+  for (n = 0; !(d & MP_LIMB_T_HIGHBIT); n++)
+    d <<= 1;
+
+  h = lshift_make (h, l, n);
+  l <<= n;
+
+  __udiv_qrnnd_c (*q, *r, h, l, d);
+  *r >>= n;
+}
+
+mp_limb_t
+refmpn_divmod_1c (mp_ptr rp, mp_srcptr sp, mp_size_t size, mp_limb_t divisor,
+                 mp_limb_t carry)
+{
+  mp_ptr     sp_orig;
+  mp_ptr     prod;
+  mp_limb_t  carry_orig;
+  mp_size_t  i;
+
+  ASSERT (refmpn_overlap_fullonly_p (rp, sp, size));
+  ASSERT (size >= 0);
+  ASSERT (carry < divisor);
+
+  if (size == 0)
+    return carry;
+
+  sp_orig = refmpn_memdup_limbs (sp, size);
+  prod = refmpn_malloc_limbs (size);
+  carry_orig = carry;
+
+  for (i = size-1; i >= 0; i--)
+    div1 (&rp[i], &carry, carry, sp[i], divisor);
+
+  /* check by multiplying back */
+#if 0
+  printf ("size=%ld divisor=0x%lX carry=0x%lX remainder=0x%lX\n",
+          size, divisor, carry_orig, carry);
+  mpn_trace("s",sp_copy,size);
+  mpn_trace("r",rp,size);
+  printf ("mul_1c %lX\n", refmpn_mul_1c (prod, rp, size, divisor, carry));
+  mpn_trace("p",prod,size);
+#endif
+  ASSERT (refmpn_mul_1c (prod, rp, size, divisor, carry) == carry_orig);
+  ASSERT (refmpn_cmp (prod, sp_orig, size) == 0);
+  free (sp_orig);
+  free (prod);
+
+  return carry;
+}
+
+mp_limb_t
+refmpn_divmod_1 (mp_ptr rp, mp_srcptr sp, mp_size_t size, mp_limb_t divisor)
+{
+  return refmpn_divmod_1c (rp, sp, size, divisor, 0);
+}
+
+
+mp_limb_t
+refmpn_mod_1c (mp_srcptr sp, mp_size_t size, mp_limb_t divisor,
+               mp_limb_t carry)
+{
+  mp_ptr  p = refmpn_malloc_limbs (size);
+  carry = refmpn_divmod_1c (p, sp, size, divisor, carry);
+  free (p);
+  return carry;
+}  
+
+mp_limb_t
+refmpn_mod_1 (mp_srcptr sp, mp_size_t size, mp_limb_t divisor)
+{
+  return refmpn_mod_1c (sp, size, divisor, 0);
+}
+
+mp_limb_t
+refmpn_mod_1_rshift (mp_srcptr sp, mp_size_t size,
+                     unsigned shift, mp_limb_t divisor)
+{
+  mp_limb_t  r;
+  mp_ptr     p = refmpn_malloc_limbs (size);
+  refmpn_rshift (p, sp, size, shift);
+  r = refmpn_mod_1 (p, size, divisor);
+  free (p);
+  return r;
+}
+
+
+mp_limb_t
+refmpn_divrem_1c (mp_ptr rp, mp_size_t xsize,
+                  mp_srcptr sp, mp_size_t size, mp_limb_t divisor,
+                  mp_limb_t carry)
+{
+  mp_ptr  z;
+
+  z = refmpn_malloc_limbs (xsize);
+  refmpn_fill (z, xsize, 0);
+  
+  carry = refmpn_divmod_1c (rp+xsize, sp, size, divisor, carry);
+  carry = refmpn_divmod_1c (rp, z, xsize, divisor, carry);
+  
+  free (z);
+  return carry;
+}  
+
+mp_limb_t
+refmpn_divrem_1 (mp_ptr rp, mp_size_t xsize,
+                 mp_srcptr sp, mp_size_t size, mp_limb_t divisor)
+{
+  return refmpn_divrem_1c (rp, xsize, sp, size, divisor, 0);
+}
+
+
+/* As given in the manual, the divexact method gives quotient q and return
+   value c satisfying
+
+           c*b^n + a-i == 3*q
+
+   where a=dividend, i=initial carry, b=2^BITS_PER_MP_LIMB, and n=size.
+
+   If a-i is divisible by 3 then c==0 and a plain divmod gives the quotient.
+   If (a-i)%3==r then c is a high limb tacked on that will turn r into 0.
+   Because 2^BITS_PER_MP_LIMB==1mod3 (so long as BITS_PER_MP_LIMB is even)
+   it's enough to set c=3-r, ie. if r=1 then c=2, or if r=2 then c=1.
+
+   If a-i produces a borrow then refmpn_sub_1 leaves a twos complement
+   negative, ie. b^n+a-i, and the calculation produces c1 satisfying
+  
+           c1*b^n + b^n+a-i == 3*q
+
+   From which clearly c=c1+1, so it's enough to just add any borrow to the
+   return value otherwise calculated.
+
+   A borrow only occurs when a==0 or a==1, and, by the same reasoning as in
+   mpn/generic/diveby3.c, the c1 that results in those cases will only be 0
+   or 1 respectively, so with 1 added the final return value is still in the
+   prescribed range 0 to 2. */
+
+mp_limb_t
+refmpn_divexact_by3c (mp_ptr rp, mp_srcptr sp, mp_size_t size, mp_limb_t carry)
+{
+  mp_ptr     spcopy;
+  mp_limb_t  c, cs;
+
+  ASSERT (refmpn_overlap_fullonly_p (rp, sp, size));
+  ASSERT (size >= 1);
+  ASSERT (carry <= 2);
+
+  spcopy = refmpn_memdup_limbs (sp, size);
+  cs = refmpn_sub_1 (spcopy, spcopy, size, carry);
+
+  c = refmpn_divmod_1 (rp, spcopy, size, 3);
+  if (c != 0)
+    {
+      ASSERT ((BITS_PER_MP_LIMB % 2) == 0);
+      c = 3-c;
+      ASSERT_NOCARRY (refmpn_divmod_1c (rp, spcopy, size, 3, c));
+    }
+
+  c += cs;
+  ASSERT (c <= 2);
+
+  free (spcopy);
+  return c;
+}
+
+mp_limb_t
+refmpn_divexact_by3 (mp_ptr rp, mp_srcptr sp, mp_size_t size)
+{
+  return refmpn_divexact_by3c (rp, sp, size, 0);
+}
+
+
+/* The same as mpn/generic/mul_basecase.c, but using refmpn functions. */
+void
+refmpn_mul_basecase (mp_ptr prodp,
+                     mp_srcptr up, mp_size_t usize,
+                     mp_srcptr vp, mp_size_t vsize)
+{
+  mp_size_t i;
+
+  ASSERT (! MPN_OVERLAP_P (prodp, usize+vsize, up, usize));
+  ASSERT (! MPN_OVERLAP_P (prodp, usize+vsize, vp, vsize));
+  ASSERT (usize >= vsize);
+  ASSERT (vsize >= 1);
+
+  prodp[usize] = refmpn_mul_1 (prodp, up, usize, vp[0]);
+  for (i = 1; i < vsize; i++)
+    prodp[usize+i] = refmpn_addmul_1 (prodp+i, up, usize, vp[i]);
+}
+
+void
+refmpn_mul_n (mp_ptr prodp, mp_srcptr up, mp_srcptr vp, mp_size_t size)
+{
+  refmpn_mul_basecase (prodp, up, size, vp, size);
+}
+
+void
+refmpn_sqr (mp_ptr dst, mp_srcptr src, mp_size_t size)
+{
+  refmpn_mul_basecase (dst, src, size, src, size);
+}
+
+
+mp_limb_t
+refmpn_gcd_1 (mp_srcptr xp, mp_size_t xsize, mp_limb_t y)
+{
+  mp_limb_t  x;
+  int  twos;
+
+  ASSERT (y != 0);
+  ASSERT (! refmpn_zero_p (xp, xsize));
+
+  x = mpn_mod_1 (xp, xsize, y);
+  if (x == 0)
+    return y;
+
+  twos = 0;
+  while ((x & 1) == 0 && (y & 1) == 0)
+    {
+      x >>= 1;
+      y >>= 1;
+      twos++;
+    }
+
+  for (;;)
+    {
+      while ((x & 1) == 0)  x >>= 1;
+      while ((y & 1) == 0)  y >>= 1;
+
+      if (x < y)
+        MP_LIMB_T_SWAP (x, y);
+
+      x -= y;
+      if (x == 0)
+        break;
+    }
+
+  return y << twos;
+}
+
+
+unsigned
+refmpn_count_trailing_zeros (mp_limb_t x)
+{
+  unsigned  n = 0;
+
+  ASSERT (x != 0);
+  while ((x & 1) == 0)
+    {
+      x >>= 1;
+      n++;
+    }
+  return n;
+}
+
+mp_size_t
+refmpn_strip_twos (mp_ptr p, mp_size_t size)
+{
+  mp_size_t  limbs;
+  unsigned   shift;
+
+  ASSERT (size >= 1);
+  ASSERT (! refmpn_zero_p (p, size));
+
+  for (limbs = 0; p[0] == 0; limbs++)
+    {
+      MPN_COPY_INCR (p, p+1, size-1);
+      p[size-1] = 0;
+    }
+
+  shift = refmpn_count_trailing_zeros (p[0]);
+  if (shift)
+    refmpn_rshift (p, p, size, shift);
+
+  return limbs*BITS_PER_MP_LIMB + shift;
+}
+
+mp_limb_t
+refmpn_gcd (mp_ptr gp, mp_ptr xp, mp_size_t xsize, mp_ptr yp, mp_size_t ysize)
+{
+  int       cmp;
+
+  ASSERT (ysize >= 1);
+  ASSERT (xsize >= ysize);
+  ASSERT ((xp[0] & 1) != 0);
+  ASSERT ((yp[0] & 1) != 0);
+  ASSERT (xp[xsize-1] != 0);
+  ASSERT (yp[ysize-1] != 0);
+  ASSERT (refmpn_overlap_fullonly_p (gp, xp, xsize));
+  ASSERT (refmpn_overlap_fullonly_p (gp, yp, ysize));
+  ASSERT (! MPN_OVERLAP_P (xp, xsize, yp, ysize));
+  if (xsize == ysize)
+    ASSERT (refmpn_msbone (xp[xsize-1]) >= refmpn_msbone (yp[ysize-1]));
+
+  refmpn_strip_twos (xp, xsize);
+  MPN_NORMALIZE (xp, xsize);
+  MPN_NORMALIZE (yp, ysize);
+
+  for (;;)
+    {
+      cmp = refmpn_cmp_twosizes (xp, xsize, yp, ysize);
+      if (cmp == 0)
+        break;
+      if (cmp < 0)
+        MPN_PTR_SWAP (xp,xsize, yp,ysize);
+
+      ASSERT_NOCARRY (refmpn_sub (xp, xp, xsize, yp, ysize));
+
+      refmpn_strip_twos (xp, xsize);
+      MPN_NORMALIZE (xp, xsize);
+    }
+
+  refmpn_copyi (gp, xp, xsize);
+  return xsize;
+}
+
+
+unsigned long
+refmpn_popcount (mp_srcptr sp, mp_size_t size)
+{
+  unsigned long  count = 0;
+  mp_size_t  i;
+  int        j;
+  mp_limb_t  l;
+
+  ASSERT (size >= 0);
+  for (i = 0; i < size; i++)
+    {
+      l = sp[i];
+      for (j = 0; j < BITS_PER_MP_LIMB; j++)
+        {
+          count += (l & 1);
+          l >>= 1;
+        }
+    }
+  return count;
+}
+
+unsigned long
+refmpn_hamdist (mp_srcptr s1p, mp_srcptr s2p, mp_size_t size)
+{
+  mp_ptr  d;
+  unsigned long  count;
+
+  if (size == 0)
+    return 0;
+
+  d = refmpn_malloc_limbs (size);
+  refmpn_xor_n (d, s1p, s2p, size);
+  count = refmpn_popcount (d, size);
+  free (d);
+  return count;
+}
diff --git a/src/gmp/mpn/tests/ref.h b/src/gmp/mpn/tests/ref.h
new file mode 100644
index 000000000..7f4eb6556
--- /dev/null
+++ b/src/gmp/mpn/tests/ref.h
@@ -0,0 +1,141 @@
+/* Prototypes for refmpn functions. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+
+mp_limb_t refmpn_add_n _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                                mp_size_t size));
+mp_limb_t refmpn_add_nc _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                                 mp_size_t size, mp_limb_t carry));
+mp_limb_t refmpn_addmul_1 _PROTO ((mp_ptr wp, mp_srcptr xp, mp_size_t size,
+                                   mp_limb_t multiplier));
+mp_limb_t refmpn_addmul_1c _PROTO ((mp_ptr wp, mp_srcptr xp, mp_size_t size,
+                                    mp_limb_t multiplier, mp_limb_t carry));
+mp_limb_t refmpn_addsub_n _PROTO ((mp_ptr r1p, mp_ptr r2p,
+                                   mp_srcptr s1p, mp_srcptr s2p,
+                                   mp_size_t size));
+mp_limb_t refmpn_addsub_nc _PROTO ((mp_ptr r1p, mp_ptr r2p,
+                                    mp_srcptr s1p, mp_srcptr s2p,
+                                    mp_size_t size, mp_limb_t carry));
+
+void refmpn_and_n  _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                            mp_size_t size));
+void refmpn_andn_n _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                            mp_size_t size));
+
+int refmpn_cmp _PROTO ((mp_srcptr s1p, mp_srcptr s2p, mp_size_t size));
+
+void refmpn_com_n _PROTO ((mp_ptr rp, mp_srcptr sp, mp_size_t size));
+void refmpn_copyi _PROTO ((mp_ptr rp, mp_srcptr sp, mp_size_t size));
+void refmpn_copyd _PROTO ((mp_ptr rp, mp_srcptr sp, mp_size_t size));
+
+mp_limb_t refmpn_divexact_by3 _PROTO ((mp_ptr rp, mp_srcptr sp,
+                                       mp_size_t size));
+mp_limb_t refmpn_divexact_by3c _PROTO ((mp_ptr rp, mp_srcptr sp,
+                                       mp_size_t size, mp_limb_t carry));
+
+mp_limb_t refmpn_divmod_1 _PROTO ((mp_ptr rp, mp_srcptr sp, mp_size_t size,
+                                   mp_limb_t divisor));
+mp_limb_t refmpn_divmod_1c _PROTO ((mp_ptr rp, mp_srcptr sp, mp_size_t size,
+                                    mp_limb_t divisor, mp_limb_t carry));
+mp_limb_t refmpn_divrem_1 _PROTO ((mp_ptr rp, mp_size_t xsize,
+                                   mp_srcptr sp, mp_size_t size,
+                                   mp_limb_t divisor));
+mp_limb_t refmpn_divrem_1c _PROTO ((mp_ptr rp, mp_size_t xsize,
+                                    mp_srcptr sp, mp_size_t size,
+                                    mp_limb_t divisor, mp_limb_t carry));
+
+void refmpn_fill _PROTO ((mp_ptr p, mp_size_t s, mp_limb_t v));
+
+mp_limb_t refmpn_gcd_1 _PROTO ((mp_srcptr xp, mp_size_t xsize, mp_limb_t y));
+mp_limb_t refmpn_gcd _PROTO ((mp_ptr gp, mp_ptr xp, mp_size_t xsize,
+                              mp_ptr yp, mp_size_t ysize));
+
+unsigned long refmpn_hamdist _PROTO ((mp_srcptr s1p, mp_srcptr s2p,
+                                      mp_size_t size));
+
+void refmpn_ior_n  _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                            mp_size_t size));
+void refmpn_iorn_n _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                            mp_size_t size));
+
+mp_limb_t refmpn_lshift _PROTO ((mp_ptr wp, mp_srcptr xp, mp_size_t size,
+                                 unsigned shift));
+
+mp_ptr refmpn_malloc_limbs _PROTO ((mp_size_t size));
+mp_limb_t refmpn_msbone _PROTO ((mp_limb_t x));
+mp_limb_t refmpn_msbone_mask _PROTO ((mp_limb_t x));
+mp_ptr refmpn_memdup_limbs _PROTO ((mp_srcptr ptr, mp_size_t size));
+
+mp_limb_t refmpn_mod_1 _PROTO ((mp_srcptr sp, mp_size_t size,
+                                mp_limb_t divisor));
+mp_limb_t refmpn_mod_1c _PROTO ((mp_srcptr sp, mp_size_t size,
+                                 mp_limb_t divisor, mp_limb_t carry));
+mp_limb_t refmpn_mod_1_rshift _PROTO ((mp_srcptr sp, mp_size_t size,
+                                       unsigned shift, mp_limb_t divisor));
+
+mp_limb_t refmpn_mul_1 _PROTO ((mp_ptr wp, mp_srcptr xp, mp_size_t size,
+                                mp_limb_t multiplier));
+mp_limb_t refmpn_mul_1c _PROTO ((mp_ptr wp, mp_srcptr xp, mp_size_t size,
+                                 mp_limb_t multiplier, mp_limb_t carry));
+
+void refmpn_mul_basecase _PROTO ((mp_ptr prodp,
+                                  mp_srcptr up, mp_size_t usize,
+                                  mp_srcptr vp, mp_size_t vsize));
+void refmpn_mul_n _PROTO ((mp_ptr prodp, mp_srcptr up, mp_srcptr vp,
+                           mp_size_t size));
+
+void refmpn_nand_n _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                            mp_size_t size));
+void refmpn_nior_n _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                            mp_size_t size));
+
+unsigned long refmpn_popcount _PROTO ((mp_srcptr sp, mp_size_t size));
+
+mp_limb_t refmpn_rshift _PROTO ((mp_ptr wp, mp_srcptr xp, mp_size_t size,
+                                 unsigned shift));
+
+void refmpn_sqr _PROTO ((mp_ptr dst, mp_srcptr src, mp_size_t size));
+
+mp_limb_t refmpn_sub_n _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                                mp_size_t size));
+mp_limb_t refmpn_sub_nc _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                                 mp_size_t size, mp_limb_t carry));
+mp_limb_t refmpn_submul_1 _PROTO ((mp_ptr wp, mp_srcptr xp, mp_size_t size,
+                                   mp_limb_t multiplier));
+mp_limb_t refmpn_submul_1c _PROTO ((mp_ptr wp, mp_srcptr xp, mp_size_t size,
+                                    mp_limb_t multiplier, mp_limb_t carry));
+
+void refmpn_xnor_n _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                            mp_size_t size));
+void refmpn_xor_n  _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                            mp_size_t size));
+
+int refmpn_zero_p _PROTO ((mp_srcptr ptr, mp_size_t size));
+
+#if defined (__cplusplus)
+}
+#endif
diff --git a/src/gmp/mpn/tests/rshift.c b/src/gmp/mpn/tests/rshift.c
new file mode 100644
index 000000000..a231828ae
--- /dev/null
+++ b/src/gmp/mpn/tests/rshift.c
@@ -0,0 +1,265 @@
+/*
+Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS (CLOCK/5)
+#endif
+#ifndef SIZE
+#define SIZE 496
+#endif
+#ifndef TIMES
+#define TIMES OPS/SIZE
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+mp_limb_t
+refmpn_rshift (wp, up, usize, cnt)
+     register mp_ptr wp;
+     register mp_srcptr up;
+     mp_size_t usize;
+     register unsigned int cnt;
+{
+  register mp_limb_t high_limb, low_limb;
+  register unsigned sh_1, sh_2;
+  register mp_size_t i;
+  mp_limb_t retval;
+
+#ifdef DEBUG
+  if (usize == 0 || cnt == 0)
+    abort ();
+#endif
+
+  sh_1 = cnt;
+#if 0
+  if (sh_1 == 0)
+    {
+      if (wp != up)
+	{
+	  /* Copy from low end to high end, to allow specified input/output
+	     overlapping.  */
+	  for (i = 0; i < usize; i++)
+	    wp[i] = up[i];
+	}
+      return 0;
+    }
+#endif
+
+  wp -= 1;
+  sh_2 = BITS_PER_MP_LIMB - sh_1;
+  high_limb = up[0];
+  retval = high_limb << sh_2;
+  low_limb = high_limb;
+
+  for (i = 1; i < usize; i++)
+    {
+      high_limb = up[i];
+      wp[i] = (low_limb >> sh_1) | (high_limb << sh_2);
+      low_limb = high_limb;
+    }
+  low_limb >>= sh_1;
+  wp[i] = low_limb;
+
+  return retval;
+}
+
+#ifndef CNT
+#define CNT 4
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_limb_t s1[SIZE];
+  mp_limb_t dx[SIZE+2];
+  mp_limb_t dy[SIZE+2];
+  mp_limb_t cyx, cyy;
+  int i;
+  long t0, t;
+  int test;
+  int cnt = CNT;
+  mp_size_t size;
+
+  for (test = 0; ; test++)
+    {
+#if TIMES == 1 && ! defined (PRINT)
+      if (test % (SIZE > 10000 ? 1 : 10000 / SIZE) == 0)
+	{
+	  printf ("\r%d", test);
+	  fflush (stdout);
+	}
+#endif
+
+#if TIMES == 1
+      cnt = random () % (BITS_PER_MP_LIMB - 1) + 1;
+#endif
+
+#ifdef RANDOM
+      size = random () % SIZE + 1;
+#else
+      size = SIZE;
+#endif
+      mpn_random2 (s1, size);
+
+      dx[size+1] = 0x12345678;
+      dy[size+1] = 0x12345678;
+      dx[0] = 0x87654321;
+      dy[0] = 0x87654321;
+
+#if TIMES != 1
+      mpn_random (s1, size);
+
+#ifndef NOCHECK
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	refmpn_rshift (dx+1, s1, size, cnt);
+      t = cputime() - t0;
+      printf ("refmpn_rshift: %5ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	mpn_rshift (dx+1, s1, size, cnt);
+      t = cputime() - t0;
+      printf ("mpn_rshift:    %5ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+#ifndef NOCHECK
+      mpn_random2 (s1, size);
+
+#ifdef PRINT
+      printf ("%-*d ", (int) (2 * sizeof(mp_limb_t)), cnt); mpn_print (s1, size);
+#endif
+
+      /* Put garbage in the destination.  */
+      for (i = 0; i < size; i++)
+	{
+	  dx[i+1] = 0xdead;
+	  dy[i+1] = 0xbeef;
+	}
+
+      cyx = refmpn_rshift (dx+1, s1, size, cnt);
+      cyy = mpn_rshift (dy+1, s1, size, cnt);
+#ifdef PRINT
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+      mpn_print (dx+1, size);
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+      mpn_print (dy+1, size);
+#endif
+      if (cyx != cyy || mpn_cmp (dx, dy, size+2) != 0
+	  || dx[0] != 0x87654321 || dx[size+1] != 0x12345678)
+	{
+#ifndef PRINT
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+	  mpn_print (dx+1, size);
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+	  mpn_print (dy+1, size);
+#endif
+	  printf ("TEST NUMBER %d\n", test);
+	  if (dy[size+1] != 0x12345678)
+	    printf ("clobbered at high end\n");
+	  if (dy[0] != 0x87654321)
+	    printf ("clobbered at low end\n");
+	  abort();
+	}
+#endif
+    }
+}
+
+mpn_print (mp_ptr p, mp_size_t size)
+{
+  mp_size_t i;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+#ifdef _LONG_LONG_LIMB
+      printf ("%0*lX%0*lX", (int) (sizeof(mp_limb_t)),
+	      (unsigned long) (p[i] >> (BITS_PER_MP_LIMB/2)),
+              (int) (sizeof(mp_limb_t)), (unsigned long) (p[i]));
+#else
+      printf ("%0*lX", (int) (2 * sizeof(mp_limb_t)), p[i]);
+#endif
+#ifdef SPACE
+      if (i != 0)
+	printf (" ");
+#endif
+    }
+  puts ("");
+}
diff --git a/src/gmp/mpn/tests/spinner.c b/src/gmp/mpn/tests/spinner.c
new file mode 100644
index 000000000..1fb051a92
--- /dev/null
+++ b/src/gmp/mpn/tests/spinner.c
@@ -0,0 +1,112 @@
+/* A stupid little spinning wheel designed to make it look like useful work
+   is being done.  */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "config.h"
+
+#include <signal.h>
+#include <stdio.h>
+#if HAVE_UNISTD_H
+#include <unistd.h>     /* for isatty */
+#endif
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#include "try.h"
+
+
+/* An application can update this to get a count printed with the spinner.
+   If left at 0, no count is printed. */
+
+unsigned long  spinner_count = 0;
+
+
+static int  spinner_wanted = -1;  /* -1 uninitialized, 1 wanted, 0 not */
+static int  spinner_tick = 1;     /* 1 ready to print, 0 not */
+
+
+/*ARGSUSED*/
+void
+spinner_signal (int signum)
+{
+  spinner_tick = 1;
+
+  if (signal (SIGALRM, spinner_signal) == SIG_ERR)  abort ();
+  alarm (1);
+}
+
+
+/* Initialize the spinner.
+
+   This is done the first time spinner() is called, so an application
+   doesn't need to call this directly.
+  
+   The spinner is only wanted if the output is a tty.  */
+
+#define SPINNER_WANTED_INIT() \
+  if (spinner_wanted < 0) spinner_init ()
+
+void
+spinner_init (void)
+{
+  spinner_wanted = isatty (fileno (stdout));  
+  if (spinner_wanted == -1)                   
+    abort ();                                  
+
+  if (!spinner_wanted)
+    return;
+
+  if (signal (SIGALRM, spinner_signal) == SIG_ERR)  abort ();
+  alarm (1);
+}
+
+
+void
+spinner (void)
+{
+  static const char  data[] = { '|', '/', '-', '\\' };
+  static int         pos = 0;
+
+  char  buf[128];
+
+  SPINNER_WANTED_INIT ();
+
+  if (spinner_tick)
+    {
+      buf[0] = data[pos];
+      pos = (pos + 1) % numberof (data);
+      spinner_tick = 0;
+
+      if (spinner_count != 0)
+        {
+          sprintf (buf+1, " %lu\r", spinner_count);
+        }
+      else
+        {
+          buf[1] = '\r';
+          buf[2] = '\0';
+        }
+      fputs (buf, stdout);
+    }
+}
diff --git a/src/gmp/mpn/tests/sub_n.c b/src/gmp/mpn/tests/sub_n.c
new file mode 100644
index 000000000..251d136bc
--- /dev/null
+++ b/src/gmp/mpn/tests/sub_n.c
@@ -0,0 +1,242 @@
+/*
+Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS (CLOCK/5)
+#endif
+#ifndef SIZE
+#define SIZE 328
+#endif
+#ifndef TIMES
+#define TIMES OPS/SIZE
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+
+mp_limb_t
+#if __STDC__
+refmpn_sub_n (mp_ptr res_ptr,
+	       mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
+#else
+refmpn_sub_n (res_ptr, s1_ptr, s2_ptr, size)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_srcptr s2_ptr;
+     mp_size_t size;
+#endif
+{
+  register mp_limb_t x, y, cy;
+  register mp_size_t j;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  s1_ptr -= j;
+  s2_ptr -= j;
+  res_ptr -= j;
+
+  cy = 0;
+  do
+    {
+      y = s2_ptr[j];
+      x = s1_ptr[j];
+      y += cy;			/* add previous carry to subtrahend */
+      cy = (y < cy);		/* get out carry from that addition */
+      y = x - y;		/* main subtract */
+      cy = (y > x) + cy;	/* get out carry from the subtract, combine */
+      res_ptr[j] = y;
+    }
+  while (++j != 0);
+
+  return cy;
+}
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_limb_t s1[SIZE];
+  mp_limb_t s2[SIZE];
+  mp_limb_t dx[SIZE+2];
+  mp_limb_t dy[SIZE+2];
+  int cyx, cyy;
+  int i;
+  long t0, t;
+  int test;
+  mp_size_t size;
+
+  for (test = 0; ; test++)
+    {
+#if TIMES == 1 && ! defined (PRINT)
+      if (test % (SIZE > 10000 ? 1 : 10000 / SIZE) == 0)
+	{
+	  printf ("\r%d", test);
+	  fflush (stdout);
+	}
+#endif
+
+#ifdef RANDOM
+      size = random () % SIZE + 1;
+#else
+      size = SIZE;
+#endif
+
+      dx[0] = 0x87654321;
+      dy[0] = 0x87654321;
+      dx[size+1] = 0x12345678;
+      dy[size+1] = 0x12345678;
+
+#if TIMES != 1
+      mpn_random (s1, size);
+      mpn_random (s2, size);
+
+#ifndef NOCHECK
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	refmpn_sub_n (dx+1, s1, s2, size);
+      t = cputime() - t0;
+      printf ("refmpn_sub_n: %5ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	mpn_sub_n (dx+1, s1, s2, size);
+      t = cputime() - t0;
+      printf ("mpn_sub_n:    %5ldms (%.2f cycles/limb)\n",
+	      t, ((double) t * CLOCK) / (OPS * 1000.0));
+#endif
+
+#ifndef NOCHECK
+      mpn_random2 (s1, size);
+      mpn_random2 (s2, size);
+
+#ifdef PRINT
+      mpn_print (s1, size);
+      mpn_print (s2, size);
+#endif
+
+      /* Put garbage in the destination.  */
+      for (i = 0; i < size; i++)
+	{
+	  dx[i+1] = 0xdead;
+	  dy[i+1] = 0xbeef;
+	}
+
+      cyx = refmpn_sub_n (dx+1, s1, s2, size);
+      cyy = mpn_sub_n (dy+1, s1, s2, size);
+#ifdef PRINT
+      printf ("%d ", cyx); mpn_print (dx+1, size);
+      printf ("%d ", cyy); mpn_print (dy+1, size);
+#endif
+      if (cyx != cyy || mpn_cmp (dx, dy, size+2) != 0
+	  || dx[0] != 0x87654321 || dx[size+1] != 0x12345678)
+	{
+#ifndef PRINT
+	  printf ("%d ", cyx); mpn_print (dx+1, size);
+	  printf ("%d ", cyy); mpn_print (dy+1, size);
+#endif
+	  printf ("TEST NUMBER %d\n", test);
+	  abort();
+	}
+#endif
+    }
+}
+
+mpn_print (mp_ptr p, mp_size_t size)
+{
+  mp_size_t i;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+#ifdef _LONG_LONG_LIMB
+      printf ("%0*lX%0*lX", (int) (sizeof(mp_limb_t)),
+	      (unsigned long) (p[i] >> (BITS_PER_MP_LIMB/2)),
+              (int) (sizeof(mp_limb_t)), (unsigned long) (p[i]));
+#else
+      printf ("%0*lX", (int) (2 * sizeof(mp_limb_t)), p[i]);
+#endif
+#ifdef SPACE
+      if (i != 0)
+	printf (" ");
+#endif
+    }
+  puts ("");
+}
diff --git a/src/gmp/mpn/tests/submul_1.c b/src/gmp/mpn/tests/submul_1.c
new file mode 100644
index 000000000..8ec9f41e0
--- /dev/null
+++ b/src/gmp/mpn/tests/submul_1.c
@@ -0,0 +1,250 @@
+/*
+Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#if defined (USG) || defined (__SVR4) || defined (_UNICOS) || defined (__hpux)
+#include <time.h>
+
+int
+cputime ()
+{
+  if (CLOCKS_PER_SEC < 100000)
+    return clock () * 1000 / CLOCKS_PER_SEC;
+  return clock () / (CLOCKS_PER_SEC / 1000);
+}
+#else
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+int
+cputime ()
+{
+  struct rusage rus;
+
+  getrusage (0, &rus);
+  return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
+}
+#endif
+
+#define M * 1000000
+
+#ifndef CLOCK
+#if defined (__m88k__)
+#define CLOCK 20 M
+#elif defined (__i386__)
+#define CLOCK (16666667)
+#elif defined (__m68k__)
+#define CLOCK (20 M)
+#elif defined (_IBMR2)
+#define CLOCK (25 M)
+#elif defined (__sparc__)
+#define CLOCK (20 M)
+#elif defined (__sun__)
+#define CLOCK (20 M)
+#elif defined (__mips)
+#define CLOCK (40 M)
+#elif defined (__hppa__)
+#define CLOCK (50 M)
+#elif defined (__alpha)
+#define CLOCK (133 M)
+#else
+#error "Don't know CLOCK of your machine"
+#endif
+#endif
+
+#ifndef OPS
+#define OPS (CLOCK/5)
+#endif
+#ifndef SIZE
+#define SIZE 496
+#endif
+#ifndef TIMES
+#define TIMES OPS/SIZE
+#else
+#undef OPS
+#define OPS (SIZE*TIMES)
+#endif
+
+mp_limb_t
+refmpn_submul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     mp_size_t s1_size;
+     register mp_limb_t s2_limb;
+{
+  register mp_limb_t cy_limb;
+  register mp_size_t j;
+  register mp_limb_t prod_high, prod_low;
+  register mp_limb_t x;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -s1_size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  res_ptr -= j;
+  s1_ptr -= j;
+
+  cy_limb = 0;
+  do
+    {
+      umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
+
+      prod_low += cy_limb;
+      cy_limb = (prod_low < cy_limb) + prod_high;
+
+      x = res_ptr[j];
+      prod_low = x - prod_low;
+      cy_limb += (prod_low > x);
+      res_ptr[j] = prod_low;
+    }
+  while (++j != 0);
+
+  return cy_limb;
+}
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_limb_t s1[SIZE];
+  mp_limb_t dx[SIZE+2];
+  mp_limb_t dy[SIZE+2];
+  mp_limb_t cyx, cyy;
+  int i;
+  long t0, t;
+  int test;
+  mp_limb_t xlimb;
+  mp_size_t size;
+  double cyc;
+
+  for (test = 0; ; test++)
+    {
+#if TIMES == 1 && ! defined (PRINT)
+      if (test % (SIZE > 10000 ? 1 : 10000 / SIZE) == 0)
+	{
+	  printf ("\r%d", test);
+	  fflush (stdout);
+	}
+#endif
+
+#ifdef RANDOM
+      size = random () % SIZE + 1;
+#else
+      size = SIZE;
+#endif
+
+      dy[size+1] = 0x12345678;
+      dy[0] = 0x87654321;
+
+      mpn_random2 (&xlimb, 1);
+
+#if TIMES != 1
+      mpn_random (s1, size);
+      mpn_random (dy+1, size);
+
+#ifndef NOCHECK
+      MPN_COPY (dx, dy, size+2);
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	refmpn_submul_1 (dx+1, s1, size, xlimb);
+      t = cputime() - t0;
+      cyc = ((double) t * CLOCK) / (OPS * 1000.0);
+      printf ("refmpn_submul_1: %5ldms (%.2f cycles/limb) [%.2f Gb/s]\n",
+	      t, cyc,
+	      CLOCK/cyc*BITS_PER_MP_LIMB*BITS_PER_MP_LIMB/1e9);
+#endif
+
+      MPN_COPY (dx, dy, size+2);
+      t0 = cputime();
+      for (i = 0; i < TIMES; i++)
+	mpn_submul_1 (dx+1, s1, size, xlimb);
+      t = cputime() - t0;
+      cyc = ((double) t * CLOCK) / (OPS * 1000.0);
+      printf ("mpn_submul_1:    %5ldms (%.2f cycles/limb) [%.2f Gb/s]\n",
+	      t, cyc,
+	      CLOCK/cyc*BITS_PER_MP_LIMB*BITS_PER_MP_LIMB/1e9);
+#endif
+
+      mpn_random2 (s1, size);
+      mpn_random2 (dy+1, size);
+#if defined (PRINT) || defined (XPRINT)
+      printf ("xlimb=");
+      mpn_print (&xlimb, 1);
+#endif
+#ifdef PRINT
+      mpn_print (dy+1, size);
+      mpn_print (s1, size);
+#endif
+
+      MPN_COPY (dx, dy, size+2);
+      cyx = refmpn_submul_1 (dx+1, s1, size, xlimb);
+      cyy = mpn_submul_1 (dy+1, s1, size, xlimb);
+
+#ifdef PRINT
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+      mpn_print (dx+1, size);
+      printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+      mpn_print (dy+1, size);
+#endif
+
+#ifndef NOCHECK
+      if (cyx != cyy || mpn_cmp (dx, dy, size+2) != 0
+	  || dx[size+1] != 0x12345678 || dx[0] != 0x87654321)
+	{
+#ifndef PRINT
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyx);
+	  mpn_print (dx+1, size);
+	  printf ("%*lX ", (int) (2 * sizeof(mp_limb_t)), cyy);
+	  mpn_print (dy+1, size);
+#endif
+	  printf ("TEST NUMBER %d\n", test);
+	  abort();
+	}
+#endif
+    }
+}
+
+mpn_print (mp_ptr p, mp_size_t size)
+{
+  mp_size_t i;
+
+  for (i = size - 1; i >= 0; i--)
+    {
+#ifdef _LONG_LONG_LIMB
+      printf ("%0*lX%0*lX", (int) (sizeof(mp_limb_t)),
+	      (unsigned long) (p[i] >> (BITS_PER_MP_LIMB/2)),
+              (int) (sizeof(mp_limb_t)), (unsigned long) (p[i]));
+#else
+      printf ("%0*lX", (int) (2 * sizeof(mp_limb_t)), p[i]);
+#endif
+#ifdef SPACE
+      if (i != 0)
+	printf (" ");
+#endif
+    }
+  puts ("");
+}
diff --git a/src/gmp/mpn/tests/trace.c b/src/gmp/mpn/tests/trace.c
new file mode 100644
index 000000000..a70183349
--- /dev/null
+++ b/src/gmp/mpn/tests/trace.c
@@ -0,0 +1,206 @@
+/* trace.c -- Support for diagnostic traces. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "try.h"
+
+
+/* Number base for the various trace printing routines.
+   Set this in main() or with the debugger.
+   If hexadecimal is going to be fed into GNU bc, remember to use -16
+   because bc requires upper case.  */
+
+int  mp_trace_base = 10;
+
+
+/* Print "name=value\n" to stdout for an mpq_t value.  */
+void
+mpq_trace (const char *name, mpq_srcptr q)
+{
+  if (name != NULL && name[0] != '\0')
+    printf ("%s=", name);
+
+  switch (ABS (mp_trace_base)) {
+  case  8: printf ("oct");                          break;
+  case 10:                                          break;
+  case 16: printf ("0x");                           break;
+  default: printf ("base%d:", ABS (mp_trace_base)); break;
+  }
+
+  mpq_out_str (stdout, mp_trace_base, q);
+
+  /* It's not very interesting to know when numbers are unnormalized.
+     mpz's should always be and ought to be checked with ASSERT() if in doubt.
+     mpn's can often be unnormalized without affecting anything.  */
+  /* if (!mpq_normalized_p (z))  printf (" (unnorm)"); */
+
+  printf ("\n");
+}
+
+
+/* Print "name=value\n" to stdout for an mpz_t value.  */
+void
+mpz_trace (const char *name, mpz_srcptr z)
+{
+  mpq_t      q;
+  mpz_t      one;
+  mp_limb_t  one_limb;
+
+  PTR(one) = &one_limb;
+  SIZ(one) = 1;
+  one_limb = 1;
+
+  q->_mp_num = *z;
+  q->_mp_den = *one;
+
+  mpq_trace(name, q);
+}
+
+
+/* Print "namenum=value\n" to stdout for an mpz_t value.
+   "name" should have a "%d" to get the number. */
+void
+mpz_tracen (const char *name, int num, mpz_srcptr z)
+{
+  if (name != NULL && name[0] != '\0')
+    {
+      printf (name, num);
+      putchar ('=');
+    }
+  mpz_trace (NULL, z);
+}
+
+
+/* Print "name=value\n" to stdout for an mpn style ptr,size. */
+void
+mpn_trace (const char *name, mp_srcptr ptr, mp_size_t size)
+{
+  mpz_t  z;
+  MPN_NORMALIZE (ptr, size);
+  PTR(z) = (mp_ptr) ptr;
+  SIZ(z) = (int) size;
+  mpz_trace (name, z);
+}
+
+
+/* Print "namenum=value\n" to stdout for an mpn style ptr,size.
+   "name" should have a "%d" to get the number.  */
+void
+mpn_tracen (const char *name, int num, mp_srcptr ptr, mp_size_t size)
+{
+  if (name != NULL && name[0] != '\0')
+    {
+      printf (name, num);
+      putchar ('=');
+    }
+  mpn_trace (NULL, ptr, size);
+}
+
+
+/* Print "namenum=value\n" to stdout for an array of mpn style ptr,size.
+
+   "a" is an array of pointers, each a[i] is a pointer to "size" many limbs.
+   The formal parameter isn't mp_srcptr because that causes compiler
+   warnings, but the values aren't modified.
+
+   "name" should have a printf style "%d" to get the array index.  */
+
+void
+mpn_tracea (const char *name, const mp_ptr *a, int count, mp_size_t size)
+{
+  int i;
+  for (i = 0; i < count; i++)
+    mpn_tracen (name, i, a[i], size);
+}
+
+
+/* Print "value\n" to a file for an mpz_t value.  Any previous contents of
+   the file are overwritten, so you need different file names each time this
+   is called.
+
+   Overwriting the file is a feature, it means you get old data replaced
+   when you run a test program repeatedly.  */
+
+void
+mpn_trace_file (const char *filename, mp_srcptr ptr, mp_size_t size)
+{
+  FILE   *fp;
+  mpz_t  z;
+
+  fp = fopen (filename, "w");
+  if (fp == NULL)
+    {
+      perror ("fopen");
+      abort();
+    }
+
+  MPN_NORMALIZE (ptr, size);
+  PTR(z) = (mp_ptr) ptr;
+  SIZ(z) = (int) size;
+
+  mpz_out_str (fp, mp_trace_base, z);
+  fprintf (fp, "\n");
+
+  if (ferror (fp) || fclose (fp) != 0)
+    {
+      printf ("error writing %s\n", filename);
+      abort();
+    }
+}
+
+
+/* Print "value\n" to a set of files, one file for each element of the given
+   array of mpn style ptr,size.  Any previous contents of the files are
+   overwritten, so you need different file names each time this is called.
+   Each file is "filenameN" where N is 0 to count-1.
+
+   "a" is an array of pointers, each a[i] is a pointer to "size" many limbs.
+   The formal parameter isn't mp_srcptr because that causes compiler
+   warnings, but the values aren't modified.
+
+   Overwriting the files is a feature, it means you get old data replaced
+   when you run a test program repeatedly.  The output style isn't
+   particularly pretty, but at least it gets something out, and you can cat
+   the files into bc, or whatever. */
+
+void
+mpn_tracea_file (const char *filename,
+  const mp_ptr *a, int count, mp_size_t size)
+{
+  char  *s;
+  int   i;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  s = (char *) TMP_ALLOC (strlen (filename) + 50);
+
+  for (i = 0; i < count; i++)
+    {
+      sprintf (s, "%s%d", filename, i);
+      mpn_trace_file (s, a[i], size);
+    }
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpn/tests/try.c b/src/gmp/mpn/tests/try.c
new file mode 100644
index 000000000..586f5b07b
--- /dev/null
+++ b/src/gmp/mpn/tests/try.c
@@ -0,0 +1,1517 @@
+/* Run some tests on various mpn routines.
+
+   THIS IS A TEST PROGRAM USED ONLY FOR DEVELOPMENT.  IT'S ALMOST CERTAIN TO
+   BE SUBJECT TO INCOMPATIBLE CHANGES IN FUTURE VERSIONS OF GMP.  */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+
+/* Usage: try [options] <function>...
+
+   For example, "./try mpn_add_n" to run tests of that function.
+
+   Combinations of alignments and overlaps are tested, with redzones above
+   or below the destinations, and with the sources write-protected.
+  
+   The number of tests performed becomes ridiculously large with all the
+   combinations, and for that reason this can't be a part of a "make check",
+   it's meant only for development.  The code isn't very pretty either.
+
+   During development it can help to disable the redzones, since seeing the
+   rest of the destination written can show where the wrong part is, or if
+   the dst pointers are off by 1 or whatever.  The magic DEADVAL initial
+   fill (see below) will show locations never written.
+
+   The -s option can be used to test only certain size operands, which is
+   useful if some new code doesn't yet support say sizes less than the
+   unrolling, or whatever.
+
+   When a problem occurs it'll of course be necessary to run the program
+   under gdb to find out quite where, how and why it's going wrong.  Disable
+   the spinner with the -W option when doing this, or single stepping won't
+   work.  Using -1 to run with simple data can be useful.
+
+   New functions to test can be added by defining a TRY_TYPE_, adding an
+   entry to try_array[] and adding a call to the call() function (if the
+   type isn't already supported).  Extra TRY_TYPE_ bits can be easily added
+   if necessary.
+
+
+   Future:
+
+   Automatically detect gdb and disable the spinner timer (use -W for now).
+
+   Make a way to re-run a failing case in the debugger.  Have an option to
+   snapshot each test case before it's run so the data is available if a
+   segv occurs.  (This should be more reliable than the current print_all()
+   in the signal handler.)
+
+   When alignment means a dst isn't hard against the redzone, check the
+   space in between remains unchanged.
+
+   See if the 80x86 debug registers can do redzones on byte boundaries.
+
+   When a source overlaps a destination, don't run both s[i].high 0 and 1,
+   as s[i].high has no effect.  Maybe encode s[i].high into overlap->s[i].
+
+   When partial overlaps aren't done, don't loop over source alignments
+   during overlaps.
+
+*/
+
+
+/* always do assertion checking */
+#define WANT_ASSERT 1
+
+#include "config.h"
+
+#if HAVE_GETOPT_H
+#include <getopt.h>  /* for getopt_long() */
+#endif
+#include <limits.h>
+#include <signal.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+#include <unistd.h>
+#include <sys/mman.h>
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#include "ref.h"
+#include "try.h"
+
+#if HAVE_SPA_EXTRAS
+#include "spa-out.asm.h"
+#endif
+
+#if !HAVE_DECL_OPTARG
+extern char *optarg;
+extern int optind, opterr;
+#endif
+
+
+#define DEFAULT_REPETITIONS  10
+
+int  option_repetitions = DEFAULT_REPETITIONS;
+int  option_spinner = 1;
+int  option_redzones = 1;
+int  option_firstsize = 0;
+int  option_lastsize = 500;
+int  option_firstsize2 = 0;
+
+#define ALIGNMENTS          4
+#define OVERLAPS            4
+#define CARRY_RANDOMS       5
+#define MULTIPLIER_RANDOMS  5
+#define DIVISOR_RANDOMS     5
+#define XSIZE_COUNT         4
+
+int  option_print = 0;
+
+#define DATA_TRAND  0
+#define DATA_ZEROS  1
+#define DATA_SEQ    2
+#define DATA_FFS    3
+#define DATA_2FD    4
+int  option_data = DATA_TRAND;
+
+
+mp_size_t  pagesize;
+#define PAGESIZE_LIMBS  (pagesize / BYTES_PER_MP_LIMB)
+
+/* must be a multiple of the page size */
+#define REDZONE_BYTES   (pagesize * 16)
+#define REDZONE_LIMBS   (REDZONE_BYTES / BYTES_PER_MP_LIMB)
+
+
+#define MAX3(x,y,z)   (MAX (x, MAX (y, z)))
+
+#if BITS_PER_MP_LIMB == 32
+#define DEADVAL  CNST_LIMB(0xDEADBEEF)
+#else
+#define DEADVAL  CNST_LIMB(0xDEADBEEFBADDCAFE)
+#endif
+
+
+#define TRY_RETVAL           (1<<0)
+#define TRY_SIZE2            (1<<1)
+#define TRY_SHIFT            (1<<2)
+#define TRY_CARRYBIT         (1<<3)
+#define TRY_CARRY3           (1<<4)
+#define TRY_CARRY4           (1<<4)
+#define TRY_CARRYLIMB        (1<<5)
+#define TRY_MULTIPLIER       (1<<6)
+#define TRY_DIVISOR          (1<<7)
+#define TRY_DOUBLE_DST       (1<<8)
+#define TRY_DST0_INIT        (1<<9)
+#define TRY_XSIZE            (1<<10)
+#define TRY_SIZE_ZERO        (1<<11)
+#define TRY_DST_SIZE_RETVAL  (1<<12)
+#define TRY_SRC1_GCDDATA     (1<<13)
+
+#define TRY_OVERLAP_LOW_TO_HIGH  (1<<15) /* Default is allow full overlap. */
+#define TRY_OVERLAP_HIGH_TO_LOW  (1<<16)
+#define TRY_OVERLAP_NONE         (1<<17)
+#define TRY_OVERLAP_NOTSRCS      (1<<18)
+
+#define TRY_SRC0        (1<<20)
+#define TRY_SRC1        (TRY_SRC0 << 1)
+
+#define TRY_DST0        (1<<24)
+#define TRY_DST1        (TRY_DST0 << 1)
+
+
+#define TRY_SRC(n)      (TRY_SRC0 << (n))
+#define TRY_DST(n)      (TRY_DST0 << (n))
+
+#define TRY_CARRYANY  (TRY_CARRYBIT | TRY_CARRY3 | TRY_CARRY4 | TRY_CARRYLIMB)
+
+
+#define TRY_TYPE_AORS_N      (TRY_RETVAL | TRY_DST0 | TRY_SRC0 | TRY_SRC1)
+#define TRY_TYPE_AORS_NC     (TRY_TYPE_AORS_N | TRY_CARRYBIT)
+
+#define TRY_TYPE_AORSMUL_1   (TRY_TYPE_MUL_1  | TRY_DST0_INIT)
+#define TRY_TYPE_AORSMUL_1C  (TRY_TYPE_MUL_1C | TRY_DST0_INIT)
+
+#define TRY_TYPE_LOGOPS_N    (TRY_DST0 | TRY_SRC0 | TRY_SRC1)
+
+#define TRY_TYPE_ADDSUB_N \
+  (TRY_RETVAL | TRY_DST0 | TRY_DST1 | TRY_SRC0 | TRY_SRC1)
+#define TRY_TYPE_ADDSUB_NC \
+  (TRY_TYPE_ADDSUB_N | TRY_CARRY4)
+
+#define TRY_TYPE_COPYI \
+  (TRY_DST0 | TRY_SRC0 | TRY_OVERLAP_LOW_TO_HIGH | TRY_SIZE_ZERO)
+#define TRY_TYPE_COPYD \
+  (TRY_DST0 | TRY_SRC0 | TRY_OVERLAP_HIGH_TO_LOW | TRY_SIZE_ZERO)
+#define TRY_TYPE_COM_N   (TRY_DST0 | TRY_SRC0)
+
+#define TRY_TYPE_MOD_1   (TRY_RETVAL | TRY_SRC0 | TRY_DIVISOR | TRY_SIZE_ZERO)
+#define TRY_TYPE_MOD_1C       (TRY_TYPE_MOD_1 | TRY_CARRYLIMB)
+#define TRY_TYPE_DIVMOD_1     (TRY_TYPE_MOD_1  | TRY_DST0)
+#define TRY_TYPE_DIVMOD_1C    (TRY_TYPE_MOD_1C | TRY_DST0)
+#define TRY_TYPE_DIVREM_1     (TRY_TYPE_DIVMOD_1  | TRY_XSIZE)
+#define TRY_TYPE_DIVREM_1C    (TRY_TYPE_DIVMOD_1C | TRY_XSIZE)
+#define TRY_TYPE_MOD_1_RSHIFT (TRY_RETVAL | TRY_SRC0 | TRY_SHIFT | TRY_DIVISOR)
+
+#define TRY_TYPE_DIVEXACT_BY3   (TRY_RETVAL | TRY_DST0 | TRY_SRC0)
+#define TRY_TYPE_DIVEXACT_BY3C  (TRY_TYPE_DIVEXACT_BY3 | TRY_CARRY3)
+
+#define TRY_TYPE_GCD_1   (TRY_RETVAL | TRY_SRC0 | TRY_DIVISOR)
+#define TRY_TYPE_GCD                                            \
+  (TRY_RETVAL | TRY_DST0 | TRY_SRC0 | TRY_SRC1 | TRY_SIZE2      \
+   | TRY_DST_SIZE_RETVAL | TRY_OVERLAP_NOTSRCS | TRY_SRC1_GCDDATA)
+
+#define TRY_TYPE_MUL_1   (TRY_RETVAL | TRY_DST0 | TRY_SRC0 | TRY_MULTIPLIER)
+#define TRY_TYPE_MUL_1C  (TRY_TYPE_MUL_1 | TRY_CARRYLIMB)
+
+#define TRY_TYPE_MUL_BASECASE \
+  (TRY_DST0 | TRY_SRC0 | TRY_SRC1 | TRY_SIZE2 | TRY_OVERLAP_NONE)
+#define TRY_TYPE_MUL_N \
+  (TRY_DST0 | TRY_SRC0 | TRY_SRC1 | TRY_DOUBLE_DST | TRY_OVERLAP_NONE)
+#define TRY_TYPE_SQR \
+  (TRY_DST0 | TRY_SRC0 | TRY_DOUBLE_DST | TRY_OVERLAP_NONE)
+
+#define TRY_TYPE_RSHIFT \
+  (TRY_RETVAL | TRY_DST0 | TRY_SRC0 | TRY_SHIFT | TRY_OVERLAP_LOW_TO_HIGH)
+#define TRY_TYPE_LSHIFT \
+  (TRY_RETVAL | TRY_DST0 | TRY_SRC0 | TRY_SHIFT | TRY_OVERLAP_HIGH_TO_LOW)
+
+#define TRY_TYPE_POPCOUNT   (TRY_RETVAL | TRY_SRC0 | TRY_SIZE_ZERO)
+#define TRY_TYPE_HAMDIST    (TRY_TYPE_POPCOUNT | TRY_SRC1)
+
+
+/* The following are macros if there's no native versions, so wrap them in
+   functions that can be in try_array[]. */
+
+void
+MPN_COPY_INCR_fun (mp_ptr rp, mp_srcptr sp, mp_size_t size)
+{ MPN_COPY_INCR (rp, sp, size); }
+
+void
+MPN_COPY_DECR_fun (mp_ptr rp, mp_srcptr sp, mp_size_t size)
+{ MPN_COPY_DECR (rp, sp, size); }
+
+void
+mpn_com_n_fun (mp_ptr rp, mp_srcptr sp, mp_size_t size)
+{ mpn_com_n (rp, sp, size); }
+
+void
+mpn_and_n_fun (mp_ptr rp, mp_srcptr s1, mp_srcptr s2, mp_size_t size)
+{ mpn_and_n (rp, s1, s2, size); }
+
+void
+mpn_andn_n_fun (mp_ptr rp, mp_srcptr s1, mp_srcptr s2, mp_size_t size)
+{ mpn_andn_n (rp, s1, s2, size); }
+
+void
+mpn_nand_n_fun (mp_ptr rp, mp_srcptr s1, mp_srcptr s2, mp_size_t size)
+{ mpn_nand_n (rp, s1, s2, size); }
+
+void
+mpn_ior_n_fun (mp_ptr rp, mp_srcptr s1, mp_srcptr s2, mp_size_t size)
+{ mpn_ior_n (rp, s1, s2, size); }
+
+void
+mpn_iorn_n_fun (mp_ptr rp, mp_srcptr s1, mp_srcptr s2, mp_size_t size)
+{ mpn_iorn_n (rp, s1, s2, size); }
+
+void
+mpn_nior_n_fun (mp_ptr rp, mp_srcptr s1, mp_srcptr s2, mp_size_t size)
+{ mpn_nior_n (rp, s1, s2, size); }
+
+void
+mpn_xor_n_fun (mp_ptr rp, mp_srcptr s1, mp_srcptr s2, mp_size_t size)
+{ mpn_xor_n (rp, s1, s2, size); }
+
+void
+mpn_xnor_n_fun (mp_ptr rp, mp_srcptr s1, mp_srcptr s2, mp_size_t size)
+{ mpn_xnor_n (rp, s1, s2, size); }
+
+void
+mpn_divexact_by3_fun (mp_ptr rp, mp_srcptr sp, mp_size_t size)
+{ mpn_divexact_by3 (rp, sp, size); }
+
+
+struct try_t {
+  struct try_one_t {
+    tryfun_t    function;
+    const char  *name;
+  } ref, fun;
+  int         flag;
+  mp_size_t   minsize;
+};
+
+#if HAVE_STRINGIZE
+#define TRY(fun)        { (tryfun_t) fun,       #fun }
+#define TRY_FUNFUN(fun) { (tryfun_t) fun##_fun, #fun }
+#else
+#define TRY(fun)        { (tryfun_t) fun,         "fun" }
+#define TRY_FUNFUN(fun) { (tryfun_t) fun/**/_fun, "fun" }
+#endif
+
+struct try_t try_array[] = {
+  { TRY(refmpn_add_n),     TRY(mpn_add_n),     TRY_TYPE_AORS_N  },
+  { TRY(refmpn_sub_n),     TRY(mpn_sub_n),     TRY_TYPE_AORS_N  },
+#if HAVE_NATIVE_mpn_add_nc
+  { TRY(refmpn_add_nc),    TRY(mpn_add_nc),    TRY_TYPE_AORS_NC },
+#endif
+#if HAVE_NATIVE_mpn_sub_nc
+  { TRY(refmpn_sub_nc),    TRY(mpn_sub_nc),    TRY_TYPE_AORS_NC },
+#endif
+
+  { TRY(refmpn_addmul_1),  TRY(mpn_addmul_1),  TRY_TYPE_AORSMUL_1  },
+  { TRY(refmpn_submul_1),  TRY(mpn_submul_1),  TRY_TYPE_AORSMUL_1  },
+#if HAVE_NATIVE_mpn_addmul_1c
+  { TRY(refmpn_addmul_1c), TRY(mpn_addmul_1c), TRY_TYPE_AORSMUL_1C },
+#endif
+#if HAVE_NATIVE_mpn_submul_1c
+  { TRY(refmpn_submul_1c), TRY(mpn_submul_1c), TRY_TYPE_AORSMUL_1C },
+#endif
+
+  { TRY(refmpn_com_n),    TRY_FUNFUN(mpn_com_n),  TRY_TYPE_COM_N },
+
+  { TRY(refmpn_copyi),    TRY_FUNFUN(MPN_COPY_INCR), TRY_TYPE_COPYI },
+  { TRY(refmpn_copyd),    TRY_FUNFUN(MPN_COPY_DECR), TRY_TYPE_COPYD },
+
+  { TRY(refmpn_and_n),    TRY_FUNFUN(mpn_and_n),  TRY_TYPE_LOGOPS_N },
+  { TRY(refmpn_andn_n),   TRY_FUNFUN(mpn_andn_n), TRY_TYPE_LOGOPS_N },
+  { TRY(refmpn_nand_n),   TRY_FUNFUN(mpn_nand_n), TRY_TYPE_LOGOPS_N },
+  { TRY(refmpn_ior_n),    TRY_FUNFUN(mpn_ior_n),  TRY_TYPE_LOGOPS_N },
+  { TRY(refmpn_iorn_n),   TRY_FUNFUN(mpn_iorn_n), TRY_TYPE_LOGOPS_N },
+  { TRY(refmpn_nior_n),   TRY_FUNFUN(mpn_nior_n), TRY_TYPE_LOGOPS_N },
+  { TRY(refmpn_xor_n),    TRY_FUNFUN(mpn_xor_n),  TRY_TYPE_LOGOPS_N },
+  { TRY(refmpn_xnor_n),   TRY_FUNFUN(mpn_xnor_n), TRY_TYPE_LOGOPS_N },
+
+  { TRY(refmpn_divrem_1),     TRY(mpn_divrem_1),     TRY_TYPE_DIVREM_1 },
+  { TRY(refmpn_mod_1),        TRY(mpn_mod_1),        TRY_TYPE_MOD_1 },
+  { TRY(refmpn_mod_1_rshift), TRY(mpn_mod_1_rshift), TRY_TYPE_MOD_1_RSHIFT },
+#if HAVE_NATIVE_mpn_divrem_1c
+  { TRY(refmpn_divrem_1c),    TRY(mpn_divrem_1c),    TRY_TYPE_DIVREM_1C },
+#endif
+#if HAVE_NATIVE_mpn_mod_1c
+  { TRY(refmpn_mod_1c),       TRY(mpn_mod_1c),       TRY_TYPE_MOD_1C },
+#endif
+  { TRY(refmpn_divexact_by3), TRY_FUNFUN(mpn_divexact_by3),
+                                                     TRY_TYPE_DIVEXACT_BY3 },
+  { TRY(refmpn_divexact_by3c),TRY(mpn_divexact_by3c),TRY_TYPE_DIVEXACT_BY3C },
+
+  { TRY(refmpn_mul_1),    TRY(mpn_mul_1),      TRY_TYPE_MUL_1 },
+#if HAVE_NATIVE_mpn_mul_1c
+  { TRY(refmpn_mul_1c),   TRY(mpn_mul_1c),     TRY_TYPE_MUL_1C },
+#endif
+
+  { TRY(refmpn_rshift),   TRY(mpn_rshift),     TRY_TYPE_RSHIFT },
+  { TRY(refmpn_lshift),   TRY(mpn_lshift),     TRY_TYPE_LSHIFT },
+
+
+  { TRY(refmpn_mul_basecase), TRY(mpn_mul_basecase), TRY_TYPE_MUL_BASECASE },
+  { TRY(refmpn_sqr),          TRY(mpn_sqr_basecase), TRY_TYPE_SQR },
+
+  { TRY(refmpn_mul_basecase), TRY(mpn_mul),    TRY_TYPE_MUL_BASECASE },
+  { TRY(refmpn_mul_n),        TRY(mpn_mul_n),  TRY_TYPE_MUL_N },
+  { TRY(refmpn_sqr),          TRY(mpn_sqr_n),  TRY_TYPE_SQR },
+
+  { TRY(refmpn_gcd_1),    TRY(mpn_gcd_1),      TRY_TYPE_GCD_1 },
+  { TRY(refmpn_gcd),      TRY(mpn_gcd),        TRY_TYPE_GCD   },
+
+  { TRY(refmpn_popcount), TRY(mpn_popcount),   TRY_TYPE_POPCOUNT },
+  { TRY(refmpn_hamdist),  TRY(mpn_hamdist),    TRY_TYPE_HAMDIST },
+
+#if 0
+  /* need wrapper functions since they take workspace arguments */
+  { TRY(refmpn_mul_n), TRY_FUNFUN(mpn_kara_mul_n),  TRY_TYPE_MUL_N,
+                                                      MPN_KARA_MINSIZE},
+  { TRY(refmpn_sqr),   TRY_FUNFUN(mpn_kara_sqr_n),  TRY_TYPE_SQR,
+                                                      MPN_KARA_MINSIZE},
+  { TRY(refmpn_mul_n), TRY_FUNFUN(mpn_toom3_mul_n), TRY_TYPE_MUL_N,
+                                                      MPN_TOOM3_MINSIZE},
+  { TRY(refmpn_sqr),   TRY_FUNFUN(mpn_toom3_sqr_n), TRY_TYPE_SQR,
+                                                      MPN_TOOM3_MINSIZE },
+#endif
+
+#if HAVE_SPA_EXTRAS
+#include "spa-out.t-table.i"
+#endif
+};
+
+struct try_t *tr = &try_array[0];
+
+
+struct region_t {
+  mp_ptr     ptr;
+  mp_size_t  size;
+};
+
+
+#define TRAP_NOWHERE 0
+#define TRAP_REF     1
+#define TRAP_FUN     2
+#define TRAP_SETUPS  3
+int trap_location = TRAP_NOWHERE;
+
+
+/* Find least significant limb position where p1,size and p2,size differ.  */
+mp_size_t
+mpn_diff_lowest (mp_srcptr p1, mp_srcptr p2, mp_size_t size)
+{
+  mp_size_t  i;
+
+  for (i = 0; i < size; i++)
+    if (p1[i] != p2[i])
+      return i;
+
+  /* no differences */
+  return -1;
+}
+
+
+/* Find most significant limb position where p1,size and p2,size differ.  */
+mp_size_t
+mpn_diff_highest (mp_srcptr p1, mp_srcptr p2, mp_size_t size)
+{
+  mp_size_t  i;
+
+  for (i = size-1; i >= 0; i--)
+    if (p1[i] != p2[i])
+      return i;
+
+  /* no differences */
+  return -1;
+}
+
+
+/* Return p advanced to the next multiple of "align" bytes.  "align" must be
+   a power of 2.  Care is taken not to assume sizeof(int)==sizeof(pointer).  */
+void *
+align_pointer (void *p, size_t align)
+{
+  unsigned  d;
+  d = ((unsigned) p) & (align-1);
+  d = (d != 0 ? align-d : 0);
+  return (void *) (((char *) p) + d);
+}
+
+/* malloc n limbs on a multiple of m bytes boundary */
+mp_ptr
+malloc_limbs_aligned (size_t n, size_t m)
+{
+  return (mp_ptr) align_pointer (refmpn_malloc_limbs (n + m-1), m);
+}
+
+void
+mprotect_maybe (void *addr, size_t len, int prot)
+{
+  if (!option_redzones)
+    return;
+
+  if (mprotect (addr, len, prot) != 0)
+    {
+      fprintf (stderr, "Cannot mprotect %p 0x%X 0x%X\n", addr, len, prot);
+      exit (1);
+    }
+}
+
+/* round "a" up to a multiple of "m" */
+size_t
+round_up_multiple (size_t a, size_t m)
+{
+  unsigned long  r;
+
+  r = a % m;
+  if (r == 0)
+    return a;
+  else
+    return a + (m - r);
+}
+
+void
+malloc_region (struct region_t *r, mp_size_t n)
+{
+  mp_ptr  p;
+
+  ASSERT ((pagesize % BYTES_PER_MP_LIMB) == 0);
+
+  r->size = round_up_multiple (n, PAGESIZE_LIMBS);
+  p = malloc_limbs_aligned (r->size + REDZONE_LIMBS*2, pagesize);
+  mprotect_maybe (p, REDZONE_BYTES, PROT_NONE);
+
+  r->ptr = p + REDZONE_LIMBS;
+  mprotect_maybe (r->ptr + r->size, REDZONE_BYTES, PROT_NONE);
+}
+
+void
+mprotect_region (const struct region_t *r, int prot)
+{
+  mprotect_maybe (r->ptr, r->size, prot);
+}
+
+
+#define NUM_SOURCES  2
+#define NUM_DESTS    2
+
+struct source_t {
+  struct region_t  region;
+  int        high;
+  mp_size_t  align;
+  mp_ptr     p;
+};
+
+struct source_t  s[NUM_SOURCES];
+
+struct dest_t {
+  int        high;
+  mp_size_t  align;
+};
+
+struct dest_t  d[NUM_SOURCES];
+
+struct source_each_t {
+  mp_ptr     p;
+};
+
+struct dest_each_t {
+  struct region_t  region;
+  mp_ptr     p;
+};
+
+mp_size_t  size;
+mp_size_t  size2;
+mp_size_t  dsize;
+unsigned long   shift;
+
+struct each_t {
+  const char  *name;
+  struct dest_each_t    d[numberof(d)];
+  struct source_each_t  s[numberof(s)];
+  mp_limb_t  retval;
+};
+
+struct each_t  ref = { "Ref" };
+struct each_t  fun = { "Fun" };
+
+#define SRC_SIZE(n) \
+  ((n) == 1 && (tr->flag & (TRY_SIZE2|TRY_XSIZE)) ? size2 : size)
+
+
+/* First four entries must be 0,1,2,3 for TRY_CARRYBIT, TRY_CARRY3, and
+   TRY_CARRY4 */
+mp_limb_t  carry_array[] = {
+  0, 1, 2, 3,
+  4,
+  (mp_limb_t) 1 << 8,
+  (mp_limb_t) 1 << 16,
+  (mp_limb_t) -1
+};
+mp_limb_t  carry;
+int        carry_index;
+
+#define CARRY_COUNT                                                     \
+  ((tr->flag & TRY_CARRYBIT) ? 2                                        \
+   : (tr->flag & TRY_CARRY3) ? 3                                        \
+   : (tr->flag & TRY_CARRY4) ? 4                                        \
+   : (tr->flag & TRY_CARRYLIMB) ? numberof(carry_array) + CARRY_RANDOMS \
+   : 1)
+
+#define MPN_RANDOM_ALT(index,dst,size) \
+  (((index) & 1) ? mpn_random (dst, size) : mpn_random2 (dst, size))
+
+/* The dummy value after MPN_RANDOM_ALT ensures both sides of the ":" have
+   the same type */
+#define CARRY_ITERATION                                                 \
+  for (carry_index = 0;                                                 \
+       (carry_index < numberof (carry_array)                            \
+        ? (carry = carry_array[carry_index])                            \
+        : (MPN_RANDOM_ALT (carry_index, &carry, 1), (mp_limb_t) 0)),    \
+       carry_index < CARRY_COUNT;                                       \
+       carry_index++)
+
+
+mp_limb_t  multiplier_array[] = {
+  0, 1, 2, 3,
+  (mp_limb_t) 1 << 8,
+  (mp_limb_t) 1 << 16,
+  (mp_limb_t) -3,
+  (mp_limb_t) -2,
+  (mp_limb_t) -1,
+};
+mp_limb_t  multiplier;
+int        multiplier_index;
+
+mp_limb_t  divisor_array[] = {
+  1, 2, 3,
+  (mp_limb_t) 1 << 8,
+  (mp_limb_t) 1 << 16,
+  (mp_limb_t) -3,
+  (mp_limb_t) -2,
+  (mp_limb_t) -1,
+};
+
+mp_limb_t  divisor;
+int        divisor_index;
+
+/* The dummy value after MPN_RANDOM_ALT ensures both sides of the ":" have
+   the same type */
+#define ARRAY_ITERATION(var, index, limit, array, randoms, cond)        \
+  for (index = 0;                                                       \
+       (index < numberof (array)                                        \
+        ? CAST_TO_VOID (var = array[index])                             \
+        : (MPN_RANDOM_ALT (index, &var, 1), (mp_limb_t) 0)),            \
+       index < limit;                                                   \
+       index++)
+
+#define MULTIPLIER_COUNT                                \
+  ((tr->flag & TRY_MULTIPLIER)                          \
+    ? numberof (multiplier_array) + MULTIPLIER_RANDOMS  \
+    : 1)
+
+#define MULTIPLIER_ITERATION                                            \
+  ARRAY_ITERATION(multiplier, multiplier_index, MULTIPLIER_COUNT,       \
+                  multiplier_array, MULTIPLIER_RANDOMS, TRY_MULTIPLIER)
+
+#define DIVISOR_COUNT                           \
+  ((tr->flag & TRY_DIVISOR)                    \
+   ? numberof (divisor_array) + DIVISOR_RANDOMS \
+   : 1)
+
+#define DIVISOR_ITERATION                                               \
+  ARRAY_ITERATION(divisor, divisor_index, DIVISOR_COUNT, divisor_array, \
+                  DIVISOR_RANDOMS, TRY_DIVISOR)
+
+
+/* overlap_array[].s[i] is where s[i] should be, 0 or 1 means overlapping
+   d[0] or d[1] respectively, -1 means a separate (write-protected)
+   location. */
+
+struct overlap_t {
+  int  s[NUM_SOURCES];
+} overlap_array[] = {
+  { { -1, -1 } },
+  { {  0, -1 } },
+  { { -1,  0 } },
+  { {  0,  0 } },
+  { {  1, -1 } },
+  { { -1,  1 } },
+  { {  1,  1 } },
+  { {  0,  1 } },
+  { {  1,  0 } },
+};
+
+struct overlap_t  *overlap, *overlap_limit;
+
+#define OVERLAP_COUNT                   \
+  (tr->flag & TRY_OVERLAP_NONE ? 1      \
+   : tr->flag & TRY_OVERLAP_NOTSRCS ? 3 \
+   : tr->flag & TRY_DST1 ? 9            \
+   : tr->flag & TRY_SRC1 ? 4            \
+   : tr->flag & TRY_DST0 ? 2            \
+   : 1)
+
+#define OVERLAP_ITERATION                               \
+  for (overlap = &overlap_array[0],                     \
+    overlap_limit = &overlap_array[OVERLAP_COUNT];      \
+    overlap < overlap_limit;                            \
+    overlap++)
+
+
+#define T_RAND_COUNT  2
+int  t_rand;
+
+void
+t_random (mp_ptr ptr, mp_size_t n)
+{
+  if (size == 0)
+    return;
+
+  switch (option_data) {
+  case DATA_TRAND:
+    switch (t_rand) {
+    case 0: mpn_random (ptr, n); break;
+    case 1: mpn_random2 (ptr, n); break;
+    default: abort();
+    }
+    break;
+  case DATA_SEQ:
+    {
+      static mp_limb_t  counter = 0;
+      mp_size_t  i;
+      for (i = 0; i < n; i++)
+        ptr[i] = ++counter;
+    }
+    break;
+  case DATA_ZEROS:
+    refmpn_fill (ptr, n, (mp_limb_t) 0);
+    break;
+  case DATA_FFS:
+    refmpn_fill (ptr, n, (mp_limb_t) -1);
+    break;
+  case DATA_2FD:
+    /* Special value 0x2FFF...FFFD, which divided by 3 gives 0xFFF...FFF,
+       inducing the q1_ff special case in the mul-by-inverse part of some
+       versions of divrem_1 and mod_1. */
+    refmpn_fill (ptr, n, (mp_limb_t) -1);
+    ptr[n-1] = 2;
+    ptr[0] -= 2;
+    break;
+
+  default:
+    abort();
+  }
+}
+#define T_RAND_ITERATION \
+  for (t_rand = 0; t_rand < T_RAND_COUNT; t_rand++)
+
+
+void 
+print_each (const struct each_t *e)
+{
+  int  i;
+
+  printf ("%s %s\n", e->name, e == &ref ? tr->ref.name : tr->fun.name);
+  if (tr->flag & TRY_RETVAL)
+    printf ("   retval %08lX\n", e->retval);
+
+  for (i = 0; i < numberof (e->d); i++)
+    { 
+      if (tr->flag & TRY_DST(i))
+        {
+          mpn_tracen ("   d[%d]", i, e->d[i].p, dsize);
+          printf ("        located %p\n", e->d[i].p);
+        }
+    }
+
+  for (i = 0; i < numberof (e->s); i++)
+    if (tr->flag & TRY_SRC(i))
+      printf ("   s[%d] located %p\n", i, e->s[i].p);
+}
+
+void
+print_all (void)
+{
+  int  i;
+
+  printf ("\n");
+  printf ("size  %ld\n", size);
+  if (tr->flag & (TRY_SIZE2|TRY_XSIZE))
+    printf ("size2 %ld\n", size2);
+  if (dsize != size)
+    printf ("dsize %ld\n", dsize);
+  if (tr->flag & TRY_MULTIPLIER)
+    printf ("   multiplier 0x%lX\n", multiplier);
+  if (tr->flag & TRY_DIVISOR)
+    printf ("   divisor 0x%lX\n", divisor);
+  if (tr->flag & TRY_SHIFT)
+    printf ("   shift %lu\n", shift);
+  if (tr->flag & TRY_CARRYANY)
+    printf ("   carry %lX\n", carry);
+
+  for (i = 0; i < numberof (d); i++)
+    if (tr->flag & TRY_DST(i))
+      printf ("   d[%d] %s, align %ld\n",
+              i, d[i].high ? "high" : "low", d[i].align);
+
+  for (i = 0; i < numberof (s); i++)
+    {
+      if (tr->flag & TRY_SRC(i))
+        {
+          printf ("   s[%d] %s, align %ld, ",
+                  i, s[i].high ? "high" : "low", s[i].align);
+          switch (overlap->s[i]) {
+          case -1:
+            printf ("no overlap\n");
+            break;
+          default:
+            printf ("==d[%d]%s\n",
+                    overlap->s[i],
+                    tr->flag & TRY_OVERLAP_LOW_TO_HIGH ? "+a"
+                    : tr->flag & TRY_OVERLAP_HIGH_TO_LOW ? "-a"
+                    : "");
+            break;
+          }
+          mpn_tracen ("   s[%d]", i, s[i].p, SRC_SIZE(i));
+        }
+    }
+
+  if (tr->flag & TRY_DST0_INIT)
+    mpn_trace ("   d[0]", s[1].region.ptr, size);
+
+  print_each (&ref);
+  print_each (&fun);
+}
+
+void
+compare (void)
+{ 
+  int  error = 0;
+  int  i;
+
+  if ((tr->flag & TRY_RETVAL) && ref.retval != fun.retval)
+    {
+      printf ("Different return values\n");
+      error = 1;
+    }
+
+  if (! CALLING_CONVENTIONS_CHECK ())
+    error = 1;
+
+  if (tr->flag & TRY_DST_SIZE_RETVAL)
+    dsize = ref.retval;
+
+  for (i = 0; i < numberof (ref.d); i++)
+    {
+      if (!(tr->flag & TRY_DST(i)))
+        continue;
+
+      if (dsize != 0 && refmpn_cmp (ref.d[i].p, fun.d[i].p, dsize) != 0)
+        {
+          printf ("Different d[%d] data results, low diff at %ld, high diff at %ld\n",
+                  i,
+                  mpn_diff_lowest (ref.d[i].p, fun.d[i].p, dsize),
+                  mpn_diff_highest (ref.d[i].p, fun.d[i].p, dsize));
+          error = 1;
+        }
+    }
+
+  if (error)
+    {
+      print_all();
+      abort();
+    }
+}
+
+void
+call (struct each_t *e, tryfun_t function)
+{
+  switch (tr->flag) {
+  case TRY_TYPE_AORS_N:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->s[0].p, e->s[1].p, size);
+    break;
+  case TRY_TYPE_AORS_NC:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->s[0].p, e->s[1].p, size, carry);
+    break;
+
+  case TRY_TYPE_LOGOPS_N:
+    CALLING_CONVENTIONS (function) (e->d[0].p, e->s[0].p, e->s[1].p, size);
+    break;
+
+  case TRY_TYPE_ADDSUB_N:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->d[1].p, e->s[0].p, e->s[1].p, size);
+    break;
+  case TRY_TYPE_ADDSUB_NC:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->d[1].p, e->s[0].p, e->s[1].p, size, carry);
+    break;
+
+  case TRY_TYPE_COPYI:
+  case TRY_TYPE_COPYD:
+  case TRY_TYPE_COM_N:
+    CALLING_CONVENTIONS (function) (e->d[0].p, e->s[0].p, size);
+    break;
+
+  case TRY_TYPE_DIVEXACT_BY3:
+    e->retval = CALLING_CONVENTIONS (function) (e->d[0].p, e->s[0].p, size);
+    break;
+  case TRY_TYPE_DIVEXACT_BY3C:
+    e->retval = CALLING_CONVENTIONS (function) (e->d[0].p, e->s[0].p, size,
+                                                carry);
+    break;
+
+  case TRY_TYPE_DIVMOD_1:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->s[0].p, size, divisor);
+    break;
+  case TRY_TYPE_DIVMOD_1C:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->s[0].p, size, divisor, carry);
+    break;
+  case TRY_TYPE_DIVREM_1:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, size2, e->s[0].p, size, divisor);
+    break;
+  case TRY_TYPE_DIVREM_1C:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, size2, e->s[0].p, size, divisor, carry);
+    break;
+  case TRY_TYPE_MOD_1:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->s[0].p, size, divisor);
+    break;
+  case TRY_TYPE_MOD_1C:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->s[0].p, size, divisor, carry);
+    break;
+  case TRY_TYPE_MOD_1_RSHIFT:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->s[0].p, size, shift, divisor);
+    break;
+
+  case TRY_TYPE_GCD_1:
+    /* Must have a non-zero src, but this probably isn't the best way to do
+       it. */
+    if (refmpn_zero_p (e->s[0].p, size))
+      e->retval = 0;
+    else
+      e->retval = CALLING_CONVENTIONS (function) (e->s[0].p, size, divisor);
+    break;
+
+  case TRY_TYPE_GCD:
+    /* Sources are destroyed, so they're saved and replaced, but a general
+       approach to this might be better.  Note that it's still e->s[0].p and
+       e->s[1].p that are passed, to get the desired alignments. */
+    {
+      mp_ptr  s0 = refmpn_malloc_limbs (size);
+      mp_ptr  s1 = refmpn_malloc_limbs (size2);
+      refmpn_copyi (s0, e->s[0].p, size);
+      refmpn_copyi (s1, e->s[1].p, size2);
+
+      mprotect_region (&s[0].region, PROT_READ|PROT_WRITE);
+      mprotect_region (&s[1].region, PROT_READ|PROT_WRITE);
+      e->retval = CALLING_CONVENTIONS (function) (e->d[0].p,
+                                                  e->s[0].p, size,
+                                                  e->s[1].p, size2);
+      refmpn_copyi (e->s[0].p, s0, size);
+      refmpn_copyi (e->s[1].p, s1, size2);
+      free (s0);
+      free (s1);
+    }
+    break;
+
+  case TRY_TYPE_MUL_1:
+  case TRY_TYPE_AORSMUL_1:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->s[0].p, size, multiplier);
+    break;
+  case TRY_TYPE_MUL_1C:
+  case TRY_TYPE_AORSMUL_1C:
+    /* TRY_TYPE_AORSMUL_1C same */
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->s[0].p, size, multiplier, carry);
+    break;
+
+  case TRY_TYPE_MUL_BASECASE:
+    CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->s[0].p, size, e->s[1].p, size2);
+    break;
+  case TRY_TYPE_MUL_N:
+    CALLING_CONVENTIONS (function) (e->d[0].p, e->s[0].p, e->s[1].p, size);
+    break;
+  case TRY_TYPE_SQR:
+    CALLING_CONVENTIONS (function) (e->d[0].p, e->s[0].p, size);
+    break;
+
+  case TRY_TYPE_LSHIFT:
+  case TRY_TYPE_RSHIFT:
+    e->retval = CALLING_CONVENTIONS (function)
+      (e->d[0].p, e->s[0].p, size, shift);
+    break;
+
+  case TRY_TYPE_POPCOUNT:
+    e->retval = CALLING_CONVENTIONS (function) (e->s[0].p, size);
+    break;
+  case TRY_TYPE_HAMDIST:
+    e->retval = CALLING_CONVENTIONS (function) (e->s[0].p, e->s[1].p, size);
+    break;
+
+  default:
+    printf ("Unknown routine type 0x%X\n", tr->flag);
+    abort ();
+    break;
+  }
+}
+
+
+void
+pointer_setup (struct each_t *e)
+{
+  int  i, j;
+
+  if (tr->flag & TRY_DOUBLE_DST)
+    dsize = 2*size;
+  else if (tr->flag & (TRY_SIZE2|TRY_XSIZE))
+    dsize = size+size2;
+  else
+    dsize = size;
+
+  /* establish e->d[].p destinations */
+  for (i = 0; i < numberof (e->d); i++)
+    {
+      mp_size_t  offset = 0;
+
+      /* possible room for overlapping sources */
+      for (j = 0; j < numberof (overlap->s); j++)
+        if (overlap->s[j] == i)
+          offset = MAX (offset, s[j].align);
+
+      if (d[i].high)
+        {
+          e->d[i].p = e->d[i].region.ptr + e->d[i].region.size
+            - dsize - d[i].align;
+          if (tr->flag & TRY_OVERLAP_LOW_TO_HIGH)
+            e->d[i].p -= offset;
+        }
+      else
+        {
+          e->d[i].p = e->d[i].region.ptr + d[i].align;
+          if (tr->flag & TRY_OVERLAP_HIGH_TO_LOW)
+            e->d[i].p += offset;
+        }
+    }
+
+  /* establish e->s[].p sources */
+  for (i = 0; i < numberof (s); i++)
+    {
+      int  o = overlap->s[i];
+      switch (o) {
+      case -1:
+        /* no overlap */
+        e->s[i].p = s[i].p;
+        break;
+      case 0:
+      case 1:
+        /* overlap with d[o] */
+        if (tr->flag & TRY_OVERLAP_HIGH_TO_LOW)
+          e->s[i].p = e->d[o].p - s[i].align;
+        else if (tr->flag & TRY_OVERLAP_LOW_TO_HIGH)
+          e->s[i].p = e->d[o].p + s[i].align;
+        else if (tr->flag & TRY_XSIZE)
+          e->s[i].p = e->d[o].p + size2;
+        else
+          e->s[i].p = e->d[o].p;
+        break;
+      default:
+        abort();
+        break;
+      }
+    }
+}
+
+
+void
+try_one (void)
+{
+  int  i;
+
+  if (option_spinner)
+    spinner();
+  spinner_count++;
+
+  trap_location = TRAP_SETUPS;
+
+  for (i = 0; i < numberof (s); i++)
+    {
+      if (s[i].high)
+        s[i].p = s[i].region.ptr + s[i].region.size - SRC_SIZE(i) - s[i].align;
+      else
+        s[i].p = s[i].region.ptr + s[i].align;
+    }
+
+  pointer_setup (&ref);
+  pointer_setup (&fun);
+
+  if (tr->flag & TRY_DST0_INIT)
+    {
+      t_random (s[1].region.ptr, dsize);
+      MPN_COPY (fun.d[0].p, s[1].region.ptr, dsize);
+      MPN_COPY (ref.d[0].p, s[1].region.ptr, dsize);
+    }
+  else if (tr->flag & TRY_DST0)
+    {
+      refmpn_fill (ref.d[0].p, dsize, DEADVAL);
+      refmpn_fill (fun.d[0].p, dsize, DEADVAL);
+    }
+  for (i = 1; i < numberof (d); i++)
+    {
+      if (!(tr->flag & TRY_DST(i)))
+        continue;
+
+      refmpn_fill (ref.d[i].p, dsize, DEADVAL);
+      refmpn_fill (fun.d[i].p, dsize, DEADVAL);
+    }
+
+  ref.retval = 0x04152637;
+  fun.retval = 0x8C9DAEBF;
+
+  for (i = 0; i < numberof (s); i++)
+    {
+      if (!(tr->flag & TRY_SRC(i)))
+        continue;
+
+      mprotect_region (&s[i].region, PROT_READ|PROT_WRITE);
+      t_random (s[i].p, SRC_SIZE(i));
+
+      if (tr->flag & TRY_SRC1_GCDDATA)
+        {
+          /* s[1] no more bits than s[0] */
+          if (i == 1 && size2 == size)
+            s[1].p[size-1] &= refmpn_msbone_mask (s[0].p[size-1]);
+
+          /* normalized */
+          s[i].p[SRC_SIZE(i)-1] += (s[i].p[SRC_SIZE(i)-1] == 0);
+
+          /* odd */
+          s[i].p[0] |= 1;
+        }
+
+      mprotect_region (&s[i].region, PROT_READ);
+
+      if (ref.s[i].p != s[i].p)
+        {
+          MPN_COPY (ref.s[i].p, s[i].p, SRC_SIZE(i));
+          MPN_COPY (fun.s[i].p, s[i].p, SRC_SIZE(i));
+        }
+    }
+  
+  /* special requirement of divmod_1c,divrem_1c,mod_1c */
+  if (tr->flag == TRY_TYPE_DIVMOD_1C
+      || tr->flag == TRY_TYPE_DIVREM_1C
+      || tr->flag == TRY_TYPE_MOD_1C)
+    carry %= divisor;
+
+  if (option_print)
+    print_all();
+
+  trap_location = TRAP_REF;
+  call (&ref, tr->ref.function);
+  trap_location = TRAP_FUN;
+  call (&fun, tr->fun.function);
+  trap_location = TRAP_NOWHERE;
+
+  compare ();
+}
+
+
+#define SIZE_ITERATION                                          \
+  for (size = MAX3 (option_firstsize,                           \
+                    tr->minsize,                                \
+                    (tr->flag & TRY_SIZE_ZERO) ? 0 : 1);        \
+       size <= option_lastsize;                                 \
+       size++)
+
+#define SIZE2_FIRST                             \
+  (option_firstsize2 != 0 ? option_firstsize2   \
+   : tr->flag & TRY_SIZE2 ? 1                   \
+   : tr->flag & TRY_XSIZE ? 0                   \
+   : 0)
+#define SIZE2_LAST                              \
+  (tr->flag & TRY_SIZE2 ? size                  \
+   : tr->flag & TRY_XSIZE ? XSIZE_COUNT-1       \
+   : 0)
+
+#define SIZE2_ITERATION \
+  for (size2 = SIZE2_FIRST; size2 <= SIZE2_LAST; size2++)
+
+#define ALIGN_COUNT(cond)  ((cond) ? ALIGNMENTS : 1)
+#define ALIGN_ITERATION(w,n,cond) \
+  for (w[n].align = 0; w[n].align < ALIGN_COUNT(cond); w[n].align++)
+
+#define HIGH_LIMIT(cond)  ((cond) != 0)
+#define HIGH_COUNT(cond)  (HIGH_LIMIT (cond) + 1)
+#define HIGH_ITERATION(w,n,cond) \
+  for (w[n].high = 0; w[n].high <= HIGH_LIMIT(cond); w[n].high++)
+
+#define SHIFT_LIMIT \
+  ((unsigned long) ((tr->flag & TRY_SHIFT) ? BITS_PER_MP_LIMB-1 : 1))
+
+#define SHIFT_ITERATION \
+  for (shift = 1; shift <= SHIFT_LIMIT; shift++)
+
+
+void
+try_many (void)
+{
+  int   i;
+
+  {
+    unsigned long  total = 1;
+
+    total *= option_repetitions;
+    total *= option_lastsize;
+    if (tr->flag & TRY_SIZE2) total *= (option_lastsize+1)/2;
+    if (tr->flag & TRY_XSIZE) total *= XSIZE_COUNT;
+
+    total *= SHIFT_LIMIT;
+    total *= MULTIPLIER_COUNT;
+    total *= DIVISOR_COUNT;
+    total *= CARRY_COUNT;
+    total *= T_RAND_COUNT;
+
+    total *= HIGH_COUNT (tr->flag & TRY_DST0);
+    total *= HIGH_COUNT (tr->flag & TRY_DST1);
+    total *= HIGH_COUNT (tr->flag & TRY_SRC0);
+    total *= HIGH_COUNT (tr->flag & TRY_SRC1);
+
+    total *= ALIGN_COUNT (tr->flag & TRY_DST0);
+    total *= ALIGN_COUNT (tr->flag & TRY_DST1);
+    total *= ALIGN_COUNT (tr->flag & TRY_SRC0);
+    total *= ALIGN_COUNT (tr->flag & TRY_SRC1);
+
+    total *= OVERLAP_COUNT;
+
+    printf ("%s %lu\n", tr->fun.name, total);
+  }
+
+  spinner_count = 0;
+
+  for (i = 0; i < option_repetitions; i++)
+    SIZE_ITERATION
+      SIZE2_ITERATION
+
+      SHIFT_ITERATION
+      MULTIPLIER_ITERATION
+      DIVISOR_ITERATION
+      CARRY_ITERATION /* must be after divisor */
+      T_RAND_ITERATION
+
+      HIGH_ITERATION(d,0, tr->flag & TRY_DST0)
+      HIGH_ITERATION(d,1, tr->flag & TRY_DST1)
+      HIGH_ITERATION(s,0, tr->flag & TRY_SRC0)
+      HIGH_ITERATION(s,1, tr->flag & TRY_SRC1)
+
+      ALIGN_ITERATION(d,0, tr->flag & TRY_DST0)
+      ALIGN_ITERATION(d,1, tr->flag & TRY_DST1)
+      ALIGN_ITERATION(s,0, tr->flag & TRY_SRC0)
+      ALIGN_ITERATION(s,1, tr->flag & TRY_SRC1)
+
+      OVERLAP_ITERATION
+      try_one();
+
+  printf("\n");
+}
+
+
+/* Usually print_all() doesn't show much, but it might give a hint as to
+   where the function was up to when it died. */
+void
+trap (int sig)
+{
+  const char *name = "noname";
+
+  switch (sig) {
+  case SIGILL:  name = "SIGILL";  break;
+#ifdef SIGBUS
+  case SIGBUS:  name = "SIGBUS";  break;
+#endif
+  case SIGSEGV: name = "SIGSEGV"; break;
+  case SIGFPE:  name = "SIGFPE";  break;
+  }
+
+  printf ("\n\nSIGNAL TRAP: %s\n", name);
+
+  switch (trap_location) {
+  case TRAP_REF:
+    printf ("  in reference function: %s\n", tr->ref.name);
+    break;
+  case TRAP_FUN:
+    printf ("  in test function: %s\n", tr->fun.name);
+    print_all ();
+    break;
+  case TRAP_SETUPS:
+    printf ("  in parameter setups\n");
+    print_all ();
+    break;
+  default:
+    printf ("  somewhere unknown\n");
+    break;
+  }
+  exit (1);
+}
+
+
+void
+try_init (void)
+{
+#if HAVE_GETPAGESIZE
+  /* Prefer getpagesize() over sysconf(), since on SunOS 4 sysconf() doesn't
+     know _SC_PAGESIZE. */
+  pagesize = getpagesize ();
+#else
+#if HAVE_SYSCONF
+  if ((pagesize = sysconf (_SC_PAGESIZE)) == -1)
+    {
+      /* According to the linux man page, sysconf doesn't set errno */
+      fprintf (stderr, "Cannot get sysconf _SC_PAGESIZE\n");
+      exit (1);
+    }
+#else
+Error, error, cannot get page size
+#endif
+#endif
+
+  printf ("pagesize is 0x%lX bytes\n", pagesize);
+
+  signal (SIGILL,  trap);
+#ifdef SIGBUS
+  signal (SIGBUS,  trap);
+#endif
+  signal (SIGSEGV, trap);
+  signal (SIGFPE,  trap);
+
+  {
+    int  i;
+
+    for (i = 0; i < numberof (s); i++)
+      {
+        malloc_region (&s[i].region, 2*option_lastsize+ALIGNMENTS-1);
+        printf ("s[%d] %p to %p (0x%lX bytes)\n",
+                i, s[i].region.ptr,
+                s[i].region.ptr + s[i].region.size,
+                s[i].region.size * BYTES_PER_MP_LIMB);
+      }
+
+#define INIT_EACH(e,es)                                                 \
+    for (i = 0; i < numberof (e.d); i++)                                \
+      {                                                                 \
+        malloc_region (&e.d[i].region, 2*option_lastsize+ALIGNMENTS-1); \
+        printf ("%s d[%d] %p to %p (0x%lX bytes)\n",                    \
+                es, i, e.d[i].region.ptr,                               \
+                e.d[i].region.ptr + e.d[i].region.size,                 \
+                e.d[i].region.size * BYTES_PER_MP_LIMB);                \
+      }
+
+    INIT_EACH(ref, "ref");
+    INIT_EACH(fun, "fun");
+  }
+}
+
+int
+strmatch_wild (const char *pattern, const char *str)
+{
+  size_t  plen, slen;
+
+  /* wildcard at start */
+  if (pattern[0] == '*')
+    {
+      pattern++;
+      plen = strlen (pattern);
+      slen = strlen (str);
+      return (plen == 0
+              || (slen >= plen && memcmp (pattern, str+slen-plen, plen) == 0));
+    }
+
+  /* wildcard at end */
+  plen = strlen (pattern);
+  if (plen >= 1 && pattern[plen-1] == '*')
+    return (memcmp (pattern, str, plen-1) == 0);
+
+  /* no wildcards */
+  return (strcmp (pattern, str) == 0);
+}
+
+void
+try_name (const char *name)
+{
+  int  found = 0;
+  int  i;
+
+  for (i = 0; i < numberof (try_array); i++)
+    {
+      if (strmatch_wild (name, try_array[i].fun.name))
+        {
+          tr = &try_array[i];
+          try_many ();
+          found = 1;
+        }
+    }
+
+  if (!found)
+    {
+      printf ("%s unknown\n", name);
+      /* exit (1); */
+    }
+}
+
+
+void
+usage (const char *prog)
+{
+  int  col = 0;
+  int  i;
+
+  printf ("Usage: %s [options] function...\n\
+    -1        use limb data 1,2,3,etc\n\
+    -9        use limb data all 0xFF..FFs\n\
+    -a zeros  use limb data all zeros\n\
+    -a ffs    use limb data all 0xFF..FFs (same as -9)\n\
+    -a 2fd    use data 0x2FFF...FFFD\n\
+    -p        print each case tried (try this if seg faulting)\n\
+    -R        seed random numbers from time()\n\
+    -r reps   set repetitions (default %d)\n\
+    -S seed   randomize from given seed\n\
+    -s size   starting size to test\n\
+    -s s1-s2  range of sizes to test\n\
+    -W        don't show the spinner (use this in gdb)\n\
+    -z        disable mprotect() redzones\n\
+Default data is mpn_random() and mpn_random2().\n\
+\n\
+Functions that can be tested:\n\
+", prog, DEFAULT_REPETITIONS);
+
+  for (i = 0; i < numberof (try_array); i++)
+    {
+      if (col + 1 + strlen (try_array[i].fun.name) > 79)
+        {
+          printf ("\n");
+          col = 0;
+        }
+      printf (" %s", try_array[i].fun.name);
+      col += 1 + strlen (try_array[i].fun.name);
+    }
+  printf ("\n");
+
+  exit(1);
+}
+
+
+int
+main (int argc, char *argv[])
+{
+  int  i;
+
+  /* unbuffered output */
+  setbuf (stdout, NULL);
+  setbuf (stderr, NULL);
+
+  /* always trace in hex, upper-case so can paste into bc */
+  mp_trace_base = -16;
+
+  {
+    unsigned  seed = 123;
+    int   opt;
+
+    while ((opt = getopt(argc, argv, "19a:pRr:S:s:Wz")) != EOF)
+      {
+        switch (opt) {
+        case '1':
+          /* use limb data values 1, 2, 3, ... etc */
+          option_data = DATA_SEQ;
+          break;
+        case '9':
+          /* use limb data values 0xFFF...FFF always */
+          option_data = DATA_FFS;
+          break;
+        case 'a':
+          if (strcmp (optarg, "zeros") == 0)     option_data = DATA_ZEROS;
+          else if (strcmp (optarg, "seq") == 0)  option_data = DATA_SEQ;
+          else if (strcmp (optarg, "ffs") == 0)  option_data = DATA_FFS;
+          else if (strcmp (optarg, "2fd") == 0)  option_data = DATA_2FD;
+          else
+            {
+              fprintf (stderr, "unrecognised data option: %s\n", optarg);
+              exit (1);
+            }
+          break;
+        case 'p':
+          option_print = 1;
+          break;
+        case 'R':
+          /* randomize */
+	  seed = time (NULL);
+          break;
+        case 'r':
+	  option_repetitions = atoi (optarg);
+          break;
+        case 's':
+          {
+            char  *p;
+            option_firstsize = atoi (optarg);
+            if ((p = strchr (optarg, '-')) != NULL)
+              option_lastsize = atoi (p+1);
+          }
+          break;
+        case 'S':
+          /* -S <size> sets the starting size for the second of a two size
+             routine (like mpn_mul_basecase) */
+	  option_firstsize2 = atoi (optarg);
+          break;
+        case 'W':
+          /* use this when running in the debugger */
+          option_spinner = 0;
+          break;
+        case 'z':
+          /* disable redzones */
+          option_redzones = 0;
+          break;
+        case '?':
+          usage (argv[0]);
+          break;
+        }
+      }
+
+    srandom (seed);
+  }
+
+  try_init();
+
+  if (argc <= optind)
+    usage (argv[0]);
+
+  for (i = optind; i < argc; i++)
+    try_name (argv[i]);
+
+  return 0;
+} 
diff --git a/src/gmp/mpn/tests/try.h b/src/gmp/mpn/tests/try.h
new file mode 100644
index 000000000..027e844e5
--- /dev/null
+++ b/src/gmp/mpn/tests/try.h
@@ -0,0 +1,73 @@
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#ifndef __TRY_H__
+#define __TRY_H__
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+
+
+#ifdef __cplusplus
+#define ANYARGS  ...
+#else
+#define ANYARGS
+#endif
+
+typedef mp_limb_t (*tryfun_t) _PROTO ((ANYARGS));
+
+#if HAVE_CALLING_CONVENTIONS
+extern tryfun_t calling_conventions_function;
+mp_limb_t calling_conventions _PROTO ((ANYARGS));
+int calling_conventions_check _PROTO ((void));
+#define CALLING_CONVENTIONS(function) \
+  (calling_conventions_function = (function), calling_conventions)
+#define CALLING_CONVENTIONS_CHECK()    (calling_conventions_check())
+#else
+#define CALLING_CONVENTIONS(function)  (function)
+#define CALLING_CONVENTIONS_CHECK()    1 /* always ok */
+#endif
+
+
+extern int mp_trace_base;
+void mpn_trace _PROTO ((const char *name, mp_srcptr ptr, mp_size_t size));
+void mpn_tracea _PROTO ((const char *name, const mp_ptr *a, int count,
+                 mp_size_t size));
+void mpn_tracen _PROTO ((const char *name, int num, mp_srcptr ptr,
+                 mp_size_t size));
+void mpn_trace_file _PROTO ((const char *filename,
+                             mp_srcptr ptr, mp_size_t size));
+void mpn_tracea_file _PROTO ((const char *filename,
+                              const mp_ptr *a, int count, mp_size_t size));
+void mpq_trace _PROTO ((const char *name, mpq_srcptr q));
+void mpz_trace _PROTO ((const char *name, mpz_srcptr z));
+void mpz_tracen _PROTO ((const char *name, int num, mpz_srcptr z));
+
+void spinner _PROTO ((void));
+extern unsigned long  spinner_count;
+
+
+#if defined (__cplusplus)
+}
+#endif
+
+#endif
diff --git a/src/gmp/mpn/tests/tst-addsub.c b/src/gmp/mpn/tests/tst-addsub.c
new file mode 100644
index 000000000..23dbba03e
--- /dev/null
+++ b/src/gmp/mpn/tests/tst-addsub.c
@@ -0,0 +1,185 @@
+/*
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#define ADD 1
+#define SUB 2
+
+#ifndef METHOD
+#define METHOD ADD
+#endif
+
+#if METHOD == ADD
+#define REFCALL refmpn_add_n
+#define TESTCALL mpn_add_n
+#endif
+
+#if METHOD == SUB
+#define REFCALL refmpn_sub_n
+#define TESTCALL mpn_sub_n
+#endif
+
+mp_limb_t refmpn_add_n ();
+mp_limb_t refmpn_sub_n ();
+
+#define SIZE 100
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mp_size_t alloc_size, max_size, size, i, cumul_size;
+  mp_ptr s1, s2, dx, dy;
+  int s1_align, s2_align, d_align;
+  long pass, n_passes;
+  mp_limb_t cx, cy;
+
+  max_size = SIZE;
+  n_passes = 1000000;
+
+  argc--; argv++;
+  if (argc)
+    {
+      max_size = atol (*argv);
+      argc--; argv++;
+    }
+
+  alloc_size = max_size + 32;
+  s1 = malloc (alloc_size * BYTES_PER_MP_LIMB);
+  s2 = malloc (alloc_size * BYTES_PER_MP_LIMB);
+  dx = malloc (alloc_size * BYTES_PER_MP_LIMB);
+  dy = malloc (alloc_size * BYTES_PER_MP_LIMB);
+
+  cumul_size = 0;
+  for (pass = 0; pass < n_passes; pass++)
+    {
+      cumul_size += size;
+      if (cumul_size >= 1000000)
+	{
+	  cumul_size -= 1000000;
+	  printf ("%d ", pass); fflush (stdout);
+	}
+      s1_align = random () % 32;
+      s2_align = random () % 32;
+      d_align = random () % 32;
+
+      size = random () % max_size + 1;
+
+      mpn_random2 (s1 + s1_align, size);
+      mpn_random2 (s2 + s2_align, size);
+
+      for (i = 0; i < alloc_size; i++)
+	dx[i] = dy[i] = i + 0x9876500;
+
+      cx = TESTCALL (dx + d_align, s1 + s1_align, s2 + s2_align, size);
+      cy = REFCALL (dy + d_align, s1 + s1_align, s2 + s2_align, size);
+
+      if (cx != cy || mpn_cmp (dx, dy, alloc_size) != 0)
+	abort ();
+    }
+
+  printf ("%d passes OK\n", n_passes);
+  exit (0);
+}
+
+mp_limb_t
+#if __STDC__
+refmpn_add_n (mp_ptr res_ptr,
+	      mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
+#else
+refmpn_add_n (res_ptr, s1_ptr, s2_ptr, size)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_srcptr s2_ptr;
+     mp_size_t size;
+#endif
+{
+  register mp_limb_t x, y, cy;
+  register mp_size_t j;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  s1_ptr -= j;
+  s2_ptr -= j;
+  res_ptr -= j;
+
+  cy = 0;
+  do
+    {
+      y = s2_ptr[j];
+      x = s1_ptr[j];
+      y += cy;			/* add previous carry to one addend */
+      cy = (y < cy);		/* get out carry from that addition */
+      y = x + y;		/* add other addend */
+      cy = (y < x) + cy;	/* get out carry from that add, combine */
+      res_ptr[j] = y;
+    }
+  while (++j != 0);
+
+  return cy;
+}
+
+mp_limb_t
+#if __STDC__
+refmpn_sub_n (mp_ptr res_ptr,
+	       mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
+#else
+refmpn_sub_n (res_ptr, s1_ptr, s2_ptr, size)
+     register mp_ptr res_ptr;
+     register mp_srcptr s1_ptr;
+     register mp_srcptr s2_ptr;
+     mp_size_t size;
+#endif
+{
+  register mp_limb_t x, y, cy;
+  register mp_size_t j;
+
+  /* The loop counter and index J goes from -SIZE to -1.  This way
+     the loop becomes faster.  */
+  j = -size;
+
+  /* Offset the base pointers to compensate for the negative indices.  */
+  s1_ptr -= j;
+  s2_ptr -= j;
+  res_ptr -= j;
+
+  cy = 0;
+  do
+    {
+      y = s2_ptr[j];
+      x = s1_ptr[j];
+      y += cy;			/* add previous carry to subtrahend */
+      cy = (y < cy);		/* get out carry from that addition */
+      y = x - y;		/* main subtract */
+      cy = (y > x) + cy;	/* get out carry from the subtract, combine */
+      res_ptr[j] = y;
+    }
+  while (++j != 0);
+
+  return cy;
+}
diff --git a/src/gmp/mpn/tests/x86call.asm b/src/gmp/mpn/tests/x86call.asm
new file mode 100644
index 000000000..37c1e6a87
--- /dev/null
+++ b/src/gmp/mpn/tests/x86call.asm
@@ -0,0 +1,85 @@
+dnl  x86 calling conventions checking.
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C int calling_conventions (...);
+C
+C The global variable "calling_conventions_function" is the function to
+C call, with the arguments as passed here.
+C
+C Perhaps the finit should be done only if the tags word isn't clear, but
+C nothing uses the rounding mode or anything at the moment.
+
+define(G,
+m4_assert_numargs(1)
+`GSYM_PREFIX`'$1')
+
+	.text
+	ALIGN(8)
+PROLOGUE(calling_conventions)
+	movl	(%esp), %eax
+	movl	%eax, G(calling_conventions_retaddr)
+
+	movl	$L(return), (%esp)
+
+	movl	%ebx, G(calling_conventions_save_ebx)
+	movl	%esi, G(calling_conventions_save_esi)
+	movl	%edi, G(calling_conventions_save_edi)
+	movl	%ebp, G(calling_conventions_save_ebp)
+
+	movl	$0x01234567, %ebx
+	movl	$0x89ABCDEF, %esi
+	movl	$0xFEDCBA98, %edi
+	movl	$0x76543210, %ebp
+
+	C try to provoke a problem by starting with junk in the registers,
+	C especially in %eax and %edx which will be return values
+	movl	$0x70246135, %eax
+	movl	$0x8ACE9BDF, %ecx
+	movl	$0xFDB97531, %edx
+
+	jmp	*G(calling_conventions_function)
+
+L(return):
+	movl	%ebx, G(calling_conventions_ebx)
+	movl	%esi, G(calling_conventions_esi)
+	movl	%edi, G(calling_conventions_edi)
+	movl	%ebp, G(calling_conventions_ebp)
+
+	pushf
+	popl	%ebx
+	movl	%ebx, G(calling_conventions_eflags)
+
+	fstenv	G(calling_conventions_fenv)
+	finit
+
+	movl	G(calling_conventions_save_ebx), %ebx
+	movl	G(calling_conventions_save_esi), %esi
+	movl	G(calling_conventions_save_edi), %edi
+	movl	G(calling_conventions_save_ebp), %ebp
+
+	jmp	*G(calling_conventions_retaddr)
+
+EPILOGUE()
+
diff --git a/src/gmp/mpn/tests/x86check.c b/src/gmp/mpn/tests/x86check.c
new file mode 100644
index 000000000..ae151442f
--- /dev/null
+++ b/src/gmp/mpn/tests/x86check.c
@@ -0,0 +1,102 @@
+/* x86 calling conventions checking. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "try.h"
+
+
+/* function to call */
+tryfun_t calling_conventions_function;
+
+/* temporaries */
+int  calling_conventions_save_ebx;
+int  calling_conventions_save_esi;
+int  calling_conventions_save_edi;
+int  calling_conventions_save_ebp;
+int  calling_conventions_retaddr;
+int  calling_conventions_retval;
+
+/* values to check */
+struct {
+  unsigned  control;
+  unsigned  status;
+  unsigned  tag;
+  unsigned  other[4];
+} calling_conventions_fenv;
+int  calling_conventions_ebx;
+int  calling_conventions_esi;
+int  calling_conventions_edi;
+int  calling_conventions_ebp;
+int  calling_conventions_eflags;
+
+/* expected values, as per x86call.asm */
+#define VALUE_EBX   0x01234567
+#define VALUE_ESI   0x89ABCDEF
+#define VALUE_EDI   0xFEDCBA98
+#define VALUE_EBP   0x76543210
+
+#define DIR_BIT(eflags)   (((eflags) & (1<<10)) != 0)
+
+
+/* Return 1 if ok, 0 if not */
+
+int
+calling_conventions_check (void)
+{
+  const char  *header = "Violated calling conventions:\n";
+  int  ret = 1;
+
+#define CHECK(callreg, regstr, value)                   \
+  if (callreg != value)                                 \
+    {                                                   \
+      printf ("%s   %s  got 0x%08X want 0x%08X\n",      \
+              header, regstr, callreg, value);          \
+      header = "";                                      \
+      ret = 0;                                          \
+    }
+
+  CHECK (calling_conventions_ebx, "ebx", VALUE_EBX);
+  CHECK (calling_conventions_esi, "esi", VALUE_ESI);
+  CHECK (calling_conventions_edi, "edi", VALUE_EDI);
+  CHECK (calling_conventions_ebp, "ebp", VALUE_EBP);
+
+  if (DIR_BIT (calling_conventions_eflags) != 0)
+    {
+      printf ("%s   eflags dir bit  got %d want 0\n",
+              header, DIR_BIT (calling_conventions_eflags));
+      header = "";
+      ret = 0;
+    }
+
+  if ((calling_conventions_fenv.tag & 0xFFFF) != 0xFFFF)
+    {
+      printf ("%s   fpu tags  got 0x%X want 0xFFFF\n",
+              header, calling_conventions_fenv.tag & 0xFFFF);
+      header = "";
+      ret = 0;
+    }
+
+  return ret;
+}
diff --git a/src/gmp/mpn/thumb/add_n.s b/src/gmp/mpn/thumb/add_n.s
new file mode 100644
index 000000000..c1eeb6ca8
--- /dev/null
+++ b/src/gmp/mpn/thumb/add_n.s
@@ -0,0 +1,50 @@
+@ ARM/Thumb __gmpn_add -- Add two limb vectors of the same length > 0 and store
+@ sum in a third limb vector.
+
+@ Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+@ This file is part of the GNU MP Library.
+
+@ The GNU MP Library is free software; you can redistribute it and/or modify
+@ it under the terms of the GNU Lesser General Public License as published by
+@ the Free Software Foundation; either version 2.1 of the License, or (at your
+@ option) any later version.
+
+@ The GNU MP Library is distributed in the hope that it will be useful, but
+@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+@ License for more details.
+
+@ You should have received a copy of the GNU Lesser General Public License
+@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+@ MA 02111-1307, USA.
+
+
+@ INPUT PARAMETERS
+@ RES_ptr	r0
+@ S1_ptr	r1
+@ S2_ptr	r2
+@ SIZE		r3
+
+@ NOT TESTED CODE
+
+	.text
+	.thumb
+	.align	0
+	.global	___gmpn_add_n
+___gmpn_add_n:
+	push	{r4, r5, r6, lr}
+	mov	r6, #1			@ init carry save register
+
+Loop:	sub	r6, #1			@ restore carry (set iff r6 was 0)
+	ldmia	r1!, {r4}		@ load next limb from S1
+	ldmia	r2!, {r5}		@ load next limb from S2
+	adc	r4, r5
+	stmia	r0!, {r4}		@ store result limb to RES
+	sbc	r6, r6			@ save negated carry
+	sub	r3, #1
+	bge	Loop			@ loop back while remaining count >= 4
+
+	mov	r0, r6
+	pop	{r4, r5, r6, pc}
diff --git a/src/gmp/mpn/thumb/sub_n.s b/src/gmp/mpn/thumb/sub_n.s
new file mode 100644
index 000000000..53c292375
--- /dev/null
+++ b/src/gmp/mpn/thumb/sub_n.s
@@ -0,0 +1,50 @@
+@ ARM/Thumb __gmpn_sub -- Subtract two limb vectors of the same length > 0 and
+@ store difference in a third limb vector.
+
+@ Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+@ This file is part of the GNU MP Library.
+
+@ The GNU MP Library is free software; you can redistribute it and/or modify
+@ it under the terms of the GNU Lesser General Public License as published by
+@ the Free Software Foundation; either version 2.1 of the License, or (at your
+@ option) any later version.
+
+@ The GNU MP Library is distributed in the hope that it will be useful, but
+@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+@ License for more details.
+
+@ You should have received a copy of the GNU Lesser General Public License
+@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+@ MA 02111-1307, USA.
+
+
+@ INPUT PARAMETERS
+@ RES_ptr	r0
+@ S1_ptr	r1
+@ S2_ptr	r2
+@ SIZE		r3
+
+@ NOT TESTED CODE
+
+	.text
+	.thumb
+	.align	0
+	.global	___gmpn_sub_n
+___gmpn_sub_n:
+	push	{r4, r5, r6, lr}
+	mov	r6, #1			@ init carry save register
+
+Loop:	sub	r6, #1			@ restore carry (set iff r6 was 0)
+	ldmia	r1!, {r4}		@ load next limb from S1
+	ldmia	r2!, {r5}		@ load next limb from S2
+	sbc	r4, r5
+	stmia	r0!, {r4}		@ store result limb to RES
+	sbc	r6, r6			@ save negated carry
+	sub	r3, #1
+	bge	Loop			@ loop back while remaining count >= 4
+
+	mov	r0, r6
+	pop	{r4, r5, r6, pc}
diff --git a/src/gmp/mpn/underscore.h b/src/gmp/mpn/underscore.h
new file mode 100644
index 000000000..240dae0f6
--- /dev/null
+++ b/src/gmp/mpn/underscore.h
@@ -0,0 +1,26 @@
+/*
+Copyright (C) 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#if __STDC__
+#define C_SYMBOL_NAME(name) _##name
+#else
+#define C_SYMBOL_NAME(name) _/**/name
+#endif
diff --git a/src/gmp/mpn/vax/add_n.s b/src/gmp/mpn/vax/add_n.s
new file mode 100644
index 000000000..cf4060f52
--- /dev/null
+++ b/src/gmp/mpn/vax/add_n.s
@@ -0,0 +1,61 @@
+# VAX __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
+# sum in a third limb vector.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	(sp + 4)
+# s1_ptr	(sp + 8)
+# s2_ptr	(sp + 12)
+# size		(sp + 16)
+
+.text
+	.align 1
+.globl ___gmpn_add_n
+___gmpn_add_n:
+	.word	0x0
+	movl	16(ap),r0
+	movl	12(ap),r1
+	movl	8(ap),r2
+	movl	4(ap),r3
+	mnegl	r0,r5
+	addl2	$3,r0
+	ashl	$-2,r0,r0	# unroll loop count
+	bicl2	$-4,r5		# mask out low 2 bits
+	movaq	(r5)[r5],r5	# 9x
+	jmp	Loop(r5)
+
+Loop:	movl	(r2)+,r4
+	adwc	(r1)+,r4
+	movl	r4,(r3)+
+	movl	(r2)+,r4
+	adwc	(r1)+,r4
+	movl	r4,(r3)+
+	movl	(r2)+,r4
+	adwc	(r1)+,r4
+	movl	r4,(r3)+
+	movl	(r2)+,r4
+	adwc	(r1)+,r4
+	movl	r4,(r3)+
+	sobgtr	r0,Loop
+
+	adwc	r0,r0
+	ret
diff --git a/src/gmp/mpn/vax/addmul_1.s b/src/gmp/mpn/vax/addmul_1.s
new file mode 100644
index 000000000..379061dcb
--- /dev/null
+++ b/src/gmp/mpn/vax/addmul_1.s
@@ -0,0 +1,126 @@
+# VAX __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
+# the result to a second limb vector.
+
+# Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	(sp + 4)
+# s1_ptr	(sp + 8)
+# size		(sp + 12)
+# s2_limb	(sp + 16)
+
+.text
+	.align 1
+.globl ___gmpn_addmul_1
+___gmpn_addmul_1:
+	.word	0xfc0
+	movl	12(ap),r4
+	movl	8(ap),r8
+	movl	4(ap),r9
+	movl	16(ap),r6
+	jlss	s2_big
+
+	clrl	r3
+	incl	r4
+	ashl	$-1,r4,r7
+	jlbc	r4,L1
+	clrl	r11
+
+# Loop for S2_LIMB < 0x80000000
+Loop1:	movl	(r8)+,r1
+	jlss	L1n0
+	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	$0,r3
+	addl2	r2,(r9)+
+	adwc	$0,r3
+L1:	movl	(r8)+,r1
+	jlss	L1n1
+L1p1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	$0,r11
+	addl2	r10,(r9)+
+	adwc	$0,r11
+
+	sobgtr	r7,Loop1
+	movl	r11,r0
+	ret
+
+L1n0:	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	r6,r3
+	addl2	r2,(r9)+
+	adwc	$0,r3
+	movl	(r8)+,r1
+	jgeq	L1p1
+L1n1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	r6,r11
+	addl2	r10,(r9)+
+	adwc	$0,r11
+
+	sobgtr	r7,Loop1
+	movl	r11,r0
+	ret
+
+
+s2_big:	clrl	r3
+	incl	r4
+	ashl	$-1,r4,r7
+	jlbc	r4,L2
+	clrl	r11
+
+# Loop for S2_LIMB >= 0x80000000
+Loop2:	movl	(r8)+,r1
+	jlss	L2n0
+	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	r1,r3
+	addl2	r2,(r9)+
+	adwc	$0,r3
+L2:	movl	(r8)+,r1
+	jlss	L2n1
+L2p1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	r1,r11
+	addl2	r10,(r9)+
+	adwc	$0,r11
+
+	sobgtr	r7,Loop2
+	movl	r11,r0
+	ret
+
+L2n0:	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	r6,r3
+	addl2	r2,(r9)+
+	adwc	r1,r3
+	movl	(r8)+,r1
+	jgeq	L2p1
+L2n1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	r6,r11
+	addl2	r10,(r9)+
+	adwc	r1,r11
+
+	sobgtr	r7,Loop2
+	movl	r11,r0
+	ret
diff --git a/src/gmp/mpn/vax/lshift.s b/src/gmp/mpn/vax/lshift.s
new file mode 100644
index 000000000..fd311a978
--- /dev/null
+++ b/src/gmp/mpn/vax/lshift.s
@@ -0,0 +1,58 @@
+# VAX __gmpn_lshift -- left shift.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# rptr		(sp + 4)
+# sptr		(sp + 8)
+# size		(sp + 12)
+# cnt		(sp + 16)
+# r0=retval r1=size r2,r3=itmp r4,r5=otmp	call-used registers
+# r6=sptr r7=rptr r8=cnt r9 r10 r11		call-saved registers
+
+.text
+	.align 1
+.globl ___gmpn_lshift
+___gmpn_lshift:
+	.word	0x1c0
+	movl	4(ap),r7
+	movl	8(ap),r6
+	movl	12(ap),r1
+	movl	16(ap),r8
+
+	moval	(r6)[r1],r6
+	moval	(r7)[r1],r7
+	clrl	r3
+	movl	-(r6),r2
+	ashq	r8,r2,r4
+	movl	r5,r0
+	movl	r2,r3
+	decl	r1
+	jeql	Lend
+
+Loop:	movl	-(r6),r2
+	ashq	r8,r2,r4
+	movl	r5,-(r7)
+	movl	r2,r3
+	jsobgtr	r1,Loop
+
+Lend:	movl	r4,-4(r7)
+	ret
diff --git a/src/gmp/mpn/vax/mul_1.s b/src/gmp/mpn/vax/mul_1.s
new file mode 100644
index 000000000..708e8ca6c
--- /dev/null
+++ b/src/gmp/mpn/vax/mul_1.s
@@ -0,0 +1,123 @@
+# VAX __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+# the result in a second limb vector.
+
+# Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	(sp + 4)
+# s1_ptr	(sp + 8)
+# size		(sp + 12)
+# s2_limb	(sp + 16)
+
+.text
+	.align 1
+.globl ___gmpn_mul_1
+___gmpn_mul_1:
+	.word	0xfc0
+	movl	12(ap),r4
+	movl	8(ap),r8
+	movl	4(ap),r9
+	movl	16(ap),r6
+	jlss	s2_big
+
+# One might want to combine the addl2 and the store below, but that
+# is actually just slower according to my timing tests.  (VAX 3600)
+
+	clrl	r3
+	incl	r4
+	ashl	$-1,r4,r7
+	jlbc	r4,L1
+	clrl	r11
+
+# Loop for S2_LIMB < 0x80000000
+Loop1:	movl	(r8)+,r1
+	jlss	L1n0
+	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	$0,r3
+	movl	r2,(r9)+
+L1:	movl	(r8)+,r1
+	jlss	L1n1
+L1p1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	$0,r11
+	movl	r10,(r9)+
+
+	sobgtr	r7,Loop1
+	movl	r11,r0
+	ret
+
+L1n0:	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	r6,r3
+	movl	r2,(r9)+
+	movl	(r8)+,r1
+	jgeq	L1p1
+L1n1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	r6,r11
+	movl	r10,(r9)+
+
+	sobgtr	r7,Loop1
+	movl	r11,r0
+	ret
+
+
+s2_big:	clrl	r3
+	incl	r4
+	ashl	$-1,r4,r7
+	jlbc	r4,L2
+	clrl	r11
+
+# Loop for S2_LIMB >= 0x80000000
+Loop2:	movl	(r8)+,r1
+	jlss	L2n0
+	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	r1,r3
+	movl	r2,(r9)+
+L2:	movl	(r8)+,r1
+	jlss	L2n1
+L2p1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	r1,r11
+	movl	r10,(r9)+
+
+	sobgtr	r7,Loop2
+	movl	r11,r0
+	ret
+
+L2n0:	emul	r1,r6,$0,r2
+	addl2	r1,r3
+	addl2	r11,r2
+	adwc	r6,r3
+	movl	r2,(r9)+
+	movl	(r8)+,r1
+	jgeq	L2p1
+L2n1:	emul	r1,r6,$0,r10
+	addl2	r1,r11
+	addl2	r3,r10
+	adwc	r6,r11
+	movl	r10,(r9)+
+
+	sobgtr	r7,Loop2
+	movl	r11,r0
+	ret
diff --git a/src/gmp/mpn/vax/rshift.s b/src/gmp/mpn/vax/rshift.s
new file mode 100644
index 000000000..515813208
--- /dev/null
+++ b/src/gmp/mpn/vax/rshift.s
@@ -0,0 +1,56 @@
+# VAX __gmpn_rshift -- right shift.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# rptr		(sp + 4)
+# sptr		(sp + 8)
+# size		(sp + 12)
+# cnt		(sp + 16)
+# r0=retval r1=size r2,r3=itmp r4,r5=otmp	call-used registers
+# r6=sptr r7=rptr r8=cnt r9 r10 r11		call-saved registers
+
+.text
+	.align 1
+.globl ___gmpn_rshift
+___gmpn_rshift:
+	.word	0x1c0
+	movl	4(ap),r7
+	movl	8(ap),r6
+	movl	12(ap),r1
+	movl	16(ap),r8
+
+	movl	(r6)+,r2
+	subl3	r8,$32,r8
+	ashl	r8,r2,r0
+	decl	r1
+	jeql	Lend
+
+Loop:	movl	(r6)+,r3
+	ashq	r8,r2,r4
+	movl	r5,(r7)+
+	movl	r3,r2
+	jsobgtr	r1,Loop
+
+Lend:	clrl	r3
+	ashq	r8,r2,r4
+	movl	r5,(r7)
+	ret
diff --git a/src/gmp/mpn/vax/sub_n.s b/src/gmp/mpn/vax/sub_n.s
new file mode 100644
index 000000000..eff4b1c04
--- /dev/null
+++ b/src/gmp/mpn/vax/sub_n.s
@@ -0,0 +1,61 @@
+# VAX __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and store
+# difference in a third limb vector.
+
+# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	(sp + 4)
+# s1_ptr	(sp + 8)
+# s2_ptr	(sp + 12)
+# size		(sp + 16)
+
+.text
+	.align 1
+.globl ___gmpn_sub_n
+___gmpn_sub_n:
+	.word	0x0
+	movl	16(ap),r0
+	movl	12(ap),r1
+	movl	8(ap),r2
+	movl	4(ap),r3
+	mnegl	r0,r5
+	addl2	$3,r0
+	ashl	$-2,r0,r0	# unroll loop count
+	bicl2	$-4,r5		# mask out low 2 bits
+	movaq	(r5)[r5],r5	# 9x
+	jmp	Loop(r5)
+
+Loop:	movl	(r2)+,r4
+	sbwc	(r1)+,r4
+	movl	r4,(r3)+
+	movl	(r2)+,r4
+	sbwc	(r1)+,r4
+	movl	r4,(r3)+
+	movl	(r2)+,r4
+	sbwc	(r1)+,r4
+	movl	r4,(r3)+
+	movl	(r2)+,r4
+	sbwc	(r1)+,r4
+	movl	r4,(r3)+
+	sobgtr	r0,Loop
+
+	adwc	r0,r0
+	ret
diff --git a/src/gmp/mpn/vax/submul_1.s b/src/gmp/mpn/vax/submul_1.s
new file mode 100644
index 000000000..be4228693
--- /dev/null
+++ b/src/gmp/mpn/vax/submul_1.s
@@ -0,0 +1,126 @@
+# VAX __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
+# the result from a second limb vector.
+
+# Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+# This file is part of the GNU MP Library.
+
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# INPUT PARAMETERS
+# res_ptr	(sp + 4)
+# s1_ptr	(sp + 8)
+# size		(sp + 12)
+# s2_limb	(sp + 16)
+
+.text
+	.align 1
+.globl ___gmpn_submul_1
+___gmpn_submul_1:
+	.word	0xfc0
+	movl	12(ap),r4
+	movl	8(ap),r8
+	movl	4(ap),r9
+	movl	16(ap),r6
+	jlss	s2_big
+
+	clrl	r3
+	incl	r4
+	ashl	$-1,r4,r7
+	jlbc	r4,L1
+	clrl	r11
+
+# Loop for S2_LIMB < 0x80000000
+Loop1:	movl	(r8)+,r1
+	jlss	L1n0
+	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	$0,r3
+	subl2	r2,(r9)+
+	adwc	$0,r3
+L1:	movl	(r8)+,r1
+	jlss	L1n1
+L1p1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	$0,r11
+	subl2	r10,(r9)+
+	adwc	$0,r11
+
+	sobgtr	r7,Loop1
+	movl	r11,r0
+	ret
+
+L1n0:	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	r6,r3
+	subl2	r2,(r9)+
+	adwc	$0,r3
+	movl	(r8)+,r1
+	jgeq	L1p1
+L1n1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	r6,r11
+	subl2	r10,(r9)+
+	adwc	$0,r11
+
+	sobgtr	r7,Loop1
+	movl	r11,r0
+	ret
+
+
+s2_big:	clrl	r3
+	incl	r4
+	ashl	$-1,r4,r7
+	jlbc	r4,L2
+	clrl	r11
+
+# Loop for S2_LIMB >= 0x80000000
+Loop2:	movl	(r8)+,r1
+	jlss	L2n0
+	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	r1,r3
+	subl2	r2,(r9)+
+	adwc	$0,r3
+L2:	movl	(r8)+,r1
+	jlss	L2n1
+L2p1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	r1,r11
+	subl2	r10,(r9)+
+	adwc	$0,r11
+
+	sobgtr	r7,Loop2
+	movl	r11,r0
+	ret
+
+L2n0:	emul	r1,r6,$0,r2
+	addl2	r11,r2
+	adwc	r6,r3
+	subl2	r2,(r9)+
+	adwc	r1,r3
+	movl	(r8)+,r1
+	jgeq	L2p1
+L2n1:	emul	r1,r6,$0,r10
+	addl2	r3,r10
+	adwc	r6,r11
+	subl2	r10,(r9)+
+	adwc	r1,r11
+
+	sobgtr	r7,Loop2
+	movl	r11,r0
+	ret
diff --git a/src/gmp/mpn/x86/README b/src/gmp/mpn/x86/README
new file mode 100644
index 000000000..3507548b8
--- /dev/null
+++ b/src/gmp/mpn/x86/README
@@ -0,0 +1,40 @@
+
+                      X86 MPN SUBROUTINES
+
+
+This directory contains mpn functions for various 80x86 chips.
+
+
+CODE ORGANIZATION
+
+	x86              i386, i486, generic
+	x86/pentium      Intel Pentium (P5, P54)
+	x86/pentium/mmx  Intel Pentium with MMX (P55)
+	x86/p6           Intel Pentium Pro
+	x86/p6/mmx       Intel Pentium II, III
+	x86/p6/p3mmx     Intel Pentium III
+	x86/k6           AMD K6, K6-2, K6-3
+	x86/k6/mmx
+	x86/k6/k62mmx    AMD K6-2
+	x86/k7           AMD Athlon
+	x86/k7/mmx
+
+
+The x86 directory is also the main support for P6 at the moment, and
+is something of a blended style, meant to be reasonable on all x86s.
+
+	
+
+STATUS
+
+The code is well-optimized for AMD and Intel chips, but not so well
+optimized for Cyrix chips.
+
+
+
+RELEVANT OPTIMIZATION ISSUES
+
+For implementations with slow double shift instructions (SHLD and
+SHRD), it might be better to mimic their operation with SHL+SHR+OR.
+(M2 is likely to benefit from that, but not Pentium due to its slow
+plain SHL and SHR.)
diff --git a/src/gmp/mpn/x86/README.family b/src/gmp/mpn/x86/README.family
new file mode 100644
index 000000000..3bc73f58b
--- /dev/null
+++ b/src/gmp/mpn/x86/README.family
@@ -0,0 +1,333 @@
+
+                    X86 CPU FAMILY MPN SUBROUTINES
+
+
+This file has some notes on things common to all the x86 family code.
+
+
+
+ASM FILES
+
+The x86 .asm files are BSD style x86 assembler code, first put through m4
+for macro processing.  The generic mpn/asm-defs.m4 is used, together with
+mpn/x86/x86-defs.m4.  Detailed notes are in those files.
+
+The code is meant for use with GNU "gas" or a system "as".  There's no
+support for assemblers that demand Intel style, and with gas freely
+available and easy to use that shouldn't be a problem.
+
+
+
+STACK FRAME
+
+m4 macros are used to define the parameters passed on the stack, and these
+act like comments on what the stack frame looks like too.  For example,
+mpn_mul_1() has the following.
+
+        defframe(PARAM_MULTIPLIER, 16)
+        defframe(PARAM_SIZE,       12)
+        defframe(PARAM_SRC,         8)
+        defframe(PARAM_DST,         4)
+
+Here PARAM_MULTIPLIER gets defined as `FRAME+16(%esp)', and the others
+similarly.  The return address is at offset 0, but there's not normally any
+need to access that.
+
+FRAME is redefined as necessary through the code so it's the number of bytes
+pushed on the stack, and hence the offsets in the parameter macros stay
+correct.  At the start of a routine FRAME should be zero.
+
+        deflit(`FRAME',0)
+	...
+	deflit(`FRAME',4)
+	...
+	deflit(`FRAME',8)
+	...
+
+Helper macros FRAME_pushl(), FRAME_popl(), FRAME_addl_esp() and
+FRAME_subl_esp() exist to adjust FRAME for the effect of those instructions,
+and can be used instead of explicit definitions if preferred.
+defframe_pushl() is a combination FRAME_pushl() and defframe().
+
+There's generally some slackness in redefining FRAME.  If new values aren't
+going to get used, then the redefinitions are omitted to keep from
+cluttering up the code.  This happens for instance at the end of a routine,
+where there might be just four register pops and then a ret, so FRAME isn't
+getting used.
+
+Local variables and saved registers can be similarly defined, with negative
+offsets representing stack space below the initial stack pointer.  For
+example,
+
+	defframe(SAVE_ESI,   -4)
+	defframe(SAVE_EDI,   -8)
+	defframe(VAR_COUNTER,-12)
+
+	deflit(STACK_SPACE, 12)
+
+Here STACK_SPACE gets used in a "subl $STACK_SPACE, %esp" to allocate the
+space, and that instruction must be followed by a redefinition of FRAME
+(setting it equal to STACK_SPACE) to reflect the change in %esp.
+
+Definitions for pushed registers are only put in when they're going to be
+used.  If registers are just saved and restored with pushes and pops then
+definitions aren't made.
+
+
+
+ASSEMBLER EXPRESSIONS
+
+Only addition and subtraction seem to be universally available, certainly
+that's all the Solaris 8 "as" seems to accept.  If expressions are wanted
+then m4 eval() should be used.
+
+In particular note that a "/" anywhere in a line starts a comment in Solaris
+"as", and in some configurations of gas too.
+
+	addl	$32/2, %eax           <-- wrong
+
+	addl	$eval(32/2), %eax     <-- right
+
+Binutils gas/config/tc-i386.c has a choice between "/" being a comment
+anywhere in a line, or only at the start.  FreeBSD patches 2.9.1 to select
+the latter, and as of 2.9.5 it's the default for GNU/Linux too.
+
+
+
+ASSEMBLER COMMENTS
+
+Solaris "as" doesn't support "#" commenting, using /* */ instead,
+unfortunately.  For that reason "C" commenting is used (see asm-defs.m4) and
+the intermediate ".s" files have no comments.
+
+
+
+ZERO DISPLACEMENTS
+
+In a couple of places addressing modes like 0(%ebx) with a byte-sized zero
+displacement are wanted, rather than (%ebx) with no displacement.  These are
+either for computed jumps or to get desirable code alignment.  Explicit
+.byte sequences are used to ensure the assembler doesn't turn 0(%ebx) into
+(%ebx).  The Zdisp() macro in x86-defs.m4 is used for this.
+
+Current gas 2.9.5 or recent 2.9.1 leave 0(%ebx) as written, but old gas
+1.92.3 changes it.  In general changing would be the sort of "optimization"
+an assembler might perform, hence explicit ".byte"s are used where
+necessary.
+
+
+
+SHLD/SHRD INSTRUCTIONS
+
+The %cl count forms of double shift instructions like "shldl %cl,%eax,%ebx"
+must be written "shldl %eax,%ebx" for some assemblers.  gas takes either,
+Solaris "as" doesn't allow %cl, gcc generates %cl for gas and NeXT (which is
+gas), and omits %cl elsewhere.
+
+For GMP an autoconf test is used to determine whether %cl should be used and
+the macros shldl, shrdl, shldw and shrdw in mpn/x86/x86-defs.m4 then pass
+through or omit %cl as necessary.  See comments with those macros for usage.
+
+
+
+DIRECTION FLAG
+
+The x86 calling conventions say that the direction flag should be clear at
+function entry and exit.  (See iBCS2 and SVR4 ABI books, references below.)
+
+Although this has been so since the year dot, it's not absolutely clear
+whether it's universally respected.  Since it's better to be safe than
+sorry, gmp follows glibc and does a "cld" if it depends on the direction
+flag being clear.  This happens only in a few places.
+
+
+
+POSITION INDEPENDENT CODE
+
+Defining the symbol PIC in m4 processing selects position independent code.
+This mainly affects computed jumps, and these are implemented in a
+self-contained fashion (without using the global offset table).  The few
+calls from assembly code to global functions use the normal procedure
+linkage table.
+
+PIC is necessary for ELF shared libraries because they can be mapped into
+different processes at different virtual addresses.  Text relocations in
+shared libraries are allowed, but that presumably means a page with such a
+relocation isn't shared.  The use of the PLT for PIC adds a fixed cost to
+every function call, which is small but might be noticeable when working with
+small operands.
+
+Calls from one library function to another don't need to go through the PLT,
+since of course the call instruction uses a displacement, not an absolute
+address, and the relative locations of object files are known when libgmp.so
+is created.  "ld -Bsymbolic" (or "gcc -Wl,-Bsymbolic") will resolve calls
+this way, so that there's no jump through the PLT, but of course leaving
+setups of the GOT address in %ebx that may be unnecessary.
+
+The %ebx setup could be avoided in assembly if a separate option controlled
+PIC for calls as opposed to computed jumps etc.  But there's only ever
+likely to be a handful of calls out of assembler, and getting the same
+optimization for C intra-library calls would be more important.  There seems
+no easy way to tell gcc that certain functions can be called non-PIC, and
+unfortunately many gmp functions use the global memory allocation variables,
+so they need the GOT anyway.  Object files with no global data references
+and only intra-library calls could go into the library as non-PIC under
+-Bsymbolic.  Integrating this into libtool and automake is left as an
+exercise for the reader.
+
+
+
+SIMPLE LOOPS
+
+The overheads in setting up for an unrolled loop can mean that at small
+sizes a simple loop is faster.  Making small sizes go fast is important,
+even if it adds a cycle or two to bigger sizes.  To this end various
+routines choose between a simple loop and an unrolled loop according to
+operand size.  The path to the simple loop, or to special case code for
+small sizes, is always as fast as possible.
+
+Adding a simple loop requires a conditional jump to choose between the
+simple and unrolled code.  The size of a branch misprediction penalty
+affects whether a simple loop is worthwhile.
+
+The convention is for an m4 definition UNROLL_THRESHOLD to set the crossover
+point, with sizes < UNROLL_THRESHOLD using the simple loop, sizes >=
+UNROLL_THRESHOLD using the unrolled loop.  If position independent code adds
+a couple of cycles to an unrolled loop setup, the threshold will vary with
+PIC or non-PIC.  Something like the following is typical.
+
+	ifdef(`PIC',`
+	deflit(UNROLL_THRESHOLD, 10)
+	',`
+	deflit(UNROLL_THRESHOLD, 8)
+	')
+
+There's no automated way to determine the threshold.  Setting it to a small
+value and then to a big value makes it possible to measure the simple and
+unrolled loops each over a range of sizes, from which the crossover point
+can be determined.  Alternately, just adjust the threshold up or down until
+there's no more speedups.
+
+
+
+UNROLLED LOOP CODING
+
+The x86 addressing modes allow a byte displacement of -128 to +127, making
+it possible to access 256 bytes, which is 64 limbs, without adjusting
+pointer registers within the loop.  Dword sized displacements can be used
+too, but they increase code size, and unrolling to 64 ought to be enough.
+
+When unrolling to the full 64 limbs/loop, the limb at the top of the loop
+will have a displacement of -128, so pointers have to have a corresponding
++128 added before entering the loop.  When unrolling to 32 limbs/loop
+displacements 0 to 127 can be used with 0 at the top of the loop and no
+adjustment needed to the pointers.
+
+Where 64 limbs/loop is supported, the +128 adjustment is done only when 64
+limbs/loop is selected.  Usually the gain in speed using 64 instead of 32 or
+16 is small, so support for 64 limbs/loop is generally only for comparison.
+
+
+
+COMPUTED JUMPS
+
+When working from least significant limb to most significant limb (most
+routines) the computed jump and pointer calculations in preparation for an
+unrolled loop are as follows.
+
+	S = operand size in limbs
+	N = number of limbs per loop (UNROLL_COUNT)
+	L = log2 of unrolling (UNROLL_LOG2)
+	M = mask for unrolling (UNROLL_MASK)
+	C = code bytes per limb in the loop
+	B = bytes per limb (4 for x86)
+	
+	computed jump            (-S & M) * C + entrypoint
+	subtract from pointers   (-S & M) * B
+	initial loop counter     (S-1) >> L
+	displacements            0 to B*(N-1)
+
+The loop counter is decremented at the end of each loop, and the looping
+stops when the decrement takes the counter to -1.  The displacements are for
+the addressing accessing each limb, eg. a load with "movl disp(%ebx), %eax".
+
+Usually the multiply by "C" can be handled without an imul, using instead an
+leal, or a shift and subtract.
+
+When working from most significant to least significant limb (eg. mpn_lshift
+and mpn_copyd), the calculations change as follows.
+
+	add to pointers          (-S & M) * B
+	displacements            0 to -B*(N-1)
+
+
+
+OLD GAS 1.92.3
+
+This version comes with FreeBSD 2.2.8 and has a couple of gremlins that
+affect gmp code.
+
+Firstly, an expression involving two forward references to labels comes out
+as zero.  For example,
+
+		addl	$bar-foo, %eax
+	foo:
+		nop
+	bar:
+
+This should lead to "addl $1, %eax", but it comes out as "addl $0, %eax".
+When only one forward reference is involved, it works correctly, as for
+example,
+
+	foo:
+		addl	$bar-foo, %eax
+		nop
+	bar:
+
+Secondly, an expression involving two labels can't be used as the
+displacement for an leal.  For example,
+
+	foo:
+		nop
+	bar:
+		leal	bar-foo(%eax,%ebx,8), %ecx
+
+A slightly cryptic error is given, "Unimplemented segment type 0 in
+parse_operand".  When only one label is used it's ok, and the label can be a
+forward reference too, as for example,
+
+		leal	foo(%eax,%ebx,8), %ecx
+		nop
+	foo:
+
+These problems only affect PIC computed jump calculations.  The workarounds
+are just to do an leal without a displacement and then an addl, and to make
+sure the code is placed so that there's at most one forward reference in the
+addl.
+
+
+
+REFERENCES
+
+"Intel Architecture Software Developer's Manual", volumes 1 to 3, 1999,
+order numbers 243190, 243191 and 243192.  Available on-line,
+
+	ftp://download.intel.com/design/PentiumII/manuals/243190.htm
+	ftp://download.intel.com/design/PentiumII/manuals/243191.htm
+	ftp://download.intel.com/design/PentiumII/manuals/243192.htm
+
+"Intel386 Family Binary Compatibility Specification 2", Intel Corporation,
+published by McGraw-Hill, 1991, ISBN 0-07-031219-2.
+
+"System V Application Binary Interface", Unix System Laboratories Inc, 1992,
+published by Prentice Hall, ISBN 0-13-880410-9.  And the "Intel386 Processor
+Supplement", AT&T, 1991, ISBN 0-13-877689-X.  (These have details of ELF
+shared library PIC coding.)
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 76
+End:
diff --git a/src/gmp/mpn/x86/addsub_n.S b/src/gmp/mpn/x86/addsub_n.S
new file mode 100644
index 000000000..fe6f648f5
--- /dev/null
+++ b/src/gmp/mpn/x86/addsub_n.S
@@ -0,0 +1,174 @@
+/* Currently not working and not used. */
+
+/*
+Copyright (C) 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+
+#define SAVE_BORROW_RESTORE_CARRY(r)	adcl r,r; shll $31,r
+#define SAVE_CARRY_RESTORE_BORROW(r)	adcl r,r
+
+	.globl	mpn_addsub_n_0
+	.globl	mpn_addsub_n_1
+
+/* Cute i386/i486/p6 addsub loop for the "full overlap" case r1==s2,r2==s1.
+   We let subtraction and addition alternate in being two limbs
+   ahead of the other, thereby avoiding some SAVE_RESTORE. */
+// r1 = r2 + r1    edi = esi + edi
+// r2 = r2 - r1    esi = esi - edi
+//			s1  s2
+//	                r2  r1
+//	eax,ebx,ecx,edx,esi,edi,ebp
+mpn_addsub_n_0:
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+
+	movl	20(%esp),%edi		/* res_ptr */
+	movl	24(%esp),%esi		/* s1_ptr */
+	movl	36(%esp),%ebp		/* size */
+
+	shrl	$2,%ebp
+	xorl	%edx,%edx
+	.align	4
+Loop0:				// L=load E=execute S=store
+	movl	(%esi),%ebx	// sub 0 L
+	movl	4(%esi),%ecx	// sub 1 L
+	sbbl	(%edi),%ebx	// sub 0 LE
+	sbbl	4(%edi),%ecx	// sub 1 LE
+//	SAVE_BORROW_RESTORE_CARRY(%edx)
+	movl	(%esi),%eax	// add 0 L
+	adcl	%eax,(%edi)	// add 0 LES
+	movl	4(%esi),%eax	// add 1 L
+	adcl	%eax,4(%edi)	// add 1 LES
+	movl	%ebx,(%esi)	// sub 0 S
+	movl	%ecx,4(%esi)	// sub 1 S
+	movl	8(%esi),%ebx	// add 2 L
+	adcl	8(%edi),%ebx	// add 2 LE
+	movl	12(%esi),%ecx	// add 3 L
+	adcl	12(%edi),%ecx	// add 3 LE
+//	SAVE_CARRY_RESTORE_BORROW(%edx)
+	movl	8(%edi),%eax	// sub 2 L
+	sbbl	%eax,8(%esi)	// sub 2 LES
+	movl	12(%edi),%eax	// sub 3 L
+	sbbl	%eax,12(%esi)	// sub 3 LES
+	movl	%ebx,8(%edi)	// add 2 S
+	movl	%ecx,12(%edi)	// add 3 S
+	leal	16(%esi),%esi
+	leal	16(%edi),%edi
+	decl	%ebp
+	jnz	Loop0
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+/* Cute i386/i486/p6 addsub loop for the "full overlap" case r1==s1,r2==s2.
+   We let subtraction and addition alternate in being two limbs
+   ahead of the other, thereby avoiding some SAVE_RESTORE. */
+// r1 = r1 + r2    edi = edi + esi
+// r2 = r1 - r2    esi = edi - esi
+//			s2  s1
+//	                r2  r1
+//	eax,ebx,ecx,edx,esi,edi,ebp
+mpn_addsub_n_1:
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+
+	movl	20(%esp),%edi		/* res_ptr */
+	movl	24(%esp),%esi		/* s1_ptr */
+	movl	36(%esp),%ebp		/* size */
+
+	shrl	$2,%ebp
+	xorl	%edx,%edx
+	.align	4
+Loop1:				// L=load E=execute S=store
+	movl	(%edi),%ebx	// sub 0 L
+	sbbl	(%esi),%ebx	// sub 0 LE
+	movl	4(%edi),%ecx	// sub 1 L
+	sbbl	4(%esi),%ecx	// sub 1 LE
+//	SAVE_BORROW_RESTORE_CARRY(%edx)
+	movl	(%esi),%eax	// add 0 L
+	adcl	%eax,(%edi)	// add 0 LES
+	movl	4(%esi),%eax	// add 1 L
+	adcl	%eax,4(%edi)	// add 1 LES
+	movl	%ebx,(%esi)	// sub 0 S
+	movl	%ecx,4(%esi)	// sub 1 S
+	movl	8(%esi),%ebx	// add 2 L
+	adcl	8(%edi),%ebx	// add 2 LE
+	movl	12(%esi),%ecx	// add 3 L
+	adcl	12(%edi),%ecx	// add 3 LE
+//	SAVE_CARRY_RESTORE_BORROW(%edx)
+	movl	8(%edi),%eax	// sub 2 L
+	sbbl	8(%esi),%eax	// sub 2 LES
+	movl	%eax,8(%esi)	// sub 2 S
+	movl	12(%edi),%eax	// sub 3 L
+	sbbl	12(%esi),%eax	// sub 3 LE
+	movl	%eax,12(%esi)	// sub 3 S
+	movl	%ebx,8(%edi)	// add 2 S
+	movl	%ecx,12(%edi)	// add 3 S
+	leal	16(%esi),%esi
+	leal	16(%edi),%edi
+	decl	%ebp
+	jnz	Loop1
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+	.globl	mpn_copy
+mpn_copy:
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+
+	movl	20(%esp),%edi		/* res_ptr */
+	movl	24(%esp),%esi		/* s1_ptr */
+	movl	28(%esp),%ebp		/* size */
+
+	shrl	$2,%ebp
+	.align	4
+Loop2:
+	movl	(%esi),%eax
+	movl	4(%esi),%ebx
+	movl	%eax,(%edi)
+	movl	%ebx,4(%edi)
+	movl	8(%esi),%eax
+	movl	12(%esi),%ebx
+	movl	%eax,8(%edi)
+	movl	%ebx,12(%edi)
+	leal	16(%esi),%esi
+	leal	16(%edi),%edi
+	decl	%ebp
+	jnz	Loop2
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
diff --git a/src/gmp/mpn/x86/aors_n.asm b/src/gmp/mpn/x86/aors_n.asm
new file mode 100644
index 000000000..18ef816b4
--- /dev/null
+++ b/src/gmp/mpn/x86/aors_n.asm
@@ -0,0 +1,187 @@
+dnl  x86 mpn_add_n/mpn_sub_n -- mpn addition and subtraction.
+
+dnl  Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software
+dnl  Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+ifdef(`OPERATION_add_n',`
+	define(M4_inst,        adcl)
+	define(M4_function_n,  mpn_add_n)
+	define(M4_function_nc, mpn_add_nc)
+
+',`ifdef(`OPERATION_sub_n',`
+	define(M4_inst,        sbbl)
+	define(M4_function_n,  mpn_sub_n)
+	define(M4_function_nc, mpn_sub_nc)
+
+',`m4_error(`Need OPERATION_add_n or OPERATION_sub_n
+')')')
+
+MULFUNC_PROLOGUE(mpn_add_n mpn_add_nc mpn_sub_n mpn_sub_nc)
+
+
+C mp_limb_t M4_function_n (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
+C                          mp_size_t size);
+C mp_limb_t M4_function_nc (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
+C	                    mp_size_t size, mp_limb_t carry);
+
+defframe(PARAM_CARRY,20)
+defframe(PARAM_SIZE, 16)
+defframe(PARAM_SRC2, 12)
+defframe(PARAM_SRC1, 8)
+defframe(PARAM_DST,  4)
+
+	.text
+	ALIGN(8)
+
+PROLOGUE(M4_function_nc)
+deflit(`FRAME',0)
+
+	pushl	%edi		FRAME_pushl()
+	pushl	%esi		FRAME_pushl()
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC1,%esi
+	movl	PARAM_SRC2,%edx
+	movl	PARAM_SIZE,%ecx
+
+	movl	%ecx,%eax
+	shrl	$3,%ecx			C compute count for unrolled loop
+	negl	%eax
+	andl	$7,%eax			C get index where to start loop
+	jz	LF(M4_function_n,oopgo)	C necessary special case for 0
+	incl	%ecx			C adjust loop count
+	shll	$2,%eax			C adjustment for pointers...
+	subl	%eax,%edi		C ... since they are offset ...
+	subl	%eax,%esi		C ... by a constant when we ...
+	subl	%eax,%edx		C ... enter the loop
+	shrl	$2,%eax			C restore previous value
+
+ifdef(`PIC',`
+	C Calculate start address in loop for PIC.  Due to limitations in
+	C old gas, LF(M4_function_n,oop)-L(0a)-3 cannot be put into the leal
+	call	L(0a)
+L(0a):	leal	(%eax,%eax,8),%eax
+	addl	(%esp),%eax
+	addl	$LF(M4_function_n,oop)-L(0a)-3,%eax
+	addl	$4,%esp
+',`
+	C Calculate start address in loop for non-PIC.
+ 	leal	LF(M4_function_n,oop)-3(%eax,%eax,8),%eax
+')
+
+	C These lines initialize carry from the 5th parameter.  Should be
+	C possible to simplify.
+	pushl	%ebp		FRAME_pushl()
+	movl	PARAM_CARRY,%ebp
+	shrl	$1,%ebp			C shift bit 0 into carry
+	popl	%ebp		FRAME_popl()
+
+	jmp	*%eax			C jump into loop
+
+EPILOGUE()
+
+
+	ALIGN(8)
+PROLOGUE(M4_function_n)
+deflit(`FRAME',0)
+
+	pushl	%edi		FRAME_pushl()
+	pushl	%esi		FRAME_pushl()
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC1,%esi
+	movl	PARAM_SRC2,%edx
+	movl	PARAM_SIZE,%ecx
+
+	movl	%ecx,%eax
+	shrl	$3,%ecx			C compute count for unrolled loop
+	negl	%eax
+	andl	$7,%eax			C get index where to start loop
+	jz	L(oop)			C necessary special case for 0
+	incl	%ecx			C adjust loop count
+	shll	$2,%eax			C adjustment for pointers...
+	subl	%eax,%edi		C ... since they are offset ...
+	subl	%eax,%esi		C ... by a constant when we ...
+	subl	%eax,%edx		C ... enter the loop
+	shrl	$2,%eax			C restore previous value
+
+ifdef(`PIC',`
+	C Calculate start address in loop for PIC.  Due to limitations in
+	C some assemblers, L(oop)-L(0b)-3 cannot be put into the leal
+	call	L(0b)
+L(0b):	leal	(%eax,%eax,8),%eax
+	addl	(%esp),%eax
+	addl	$L(oop)-L(0b)-3,%eax
+	addl	$4,%esp
+',`
+	C Calculate start address in loop for non-PIC.
+ 	leal	L(oop)-3(%eax,%eax,8),%eax
+')
+	jmp	*%eax			C jump into loop
+
+L(oopgo):
+	pushl	%ebp		FRAME_pushl()
+	movl	PARAM_CARRY,%ebp
+	shrl	$1,%ebp			C shift bit 0 into carry
+	popl	%ebp		FRAME_popl()
+
+	ALIGN(8)
+L(oop):	movl	(%esi),%eax
+	M4_inst	(%edx),%eax
+	movl	%eax,(%edi)
+	movl	4(%esi),%eax
+	M4_inst	4(%edx),%eax
+	movl	%eax,4(%edi)
+	movl	8(%esi),%eax
+	M4_inst	8(%edx),%eax
+	movl	%eax,8(%edi)
+	movl	12(%esi),%eax
+	M4_inst	12(%edx),%eax
+	movl	%eax,12(%edi)
+	movl	16(%esi),%eax
+	M4_inst	16(%edx),%eax
+	movl	%eax,16(%edi)
+	movl	20(%esi),%eax
+	M4_inst	20(%edx),%eax
+	movl	%eax,20(%edi)
+	movl	24(%esi),%eax
+	M4_inst	24(%edx),%eax
+	movl	%eax,24(%edi)
+	movl	28(%esi),%eax
+	M4_inst	28(%edx),%eax
+	movl	%eax,28(%edi)
+	leal	32(%edi),%edi
+	leal	32(%esi),%esi
+	leal	32(%edx),%edx
+	decl	%ecx
+	jnz	L(oop)
+
+	sbbl	%eax,%eax
+	negl	%eax
+
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/aorsmul_1.asm b/src/gmp/mpn/x86/aorsmul_1.asm
new file mode 100644
index 000000000..f32ad8398
--- /dev/null
+++ b/src/gmp/mpn/x86/aorsmul_1.asm
@@ -0,0 +1,134 @@
+dnl  x86 __gmpn_addmul_1 (for 386 and 486) -- Multiply a limb vector with a
+dnl  limb and add the result to a second limb vector.
+
+
+dnl  Copyright (C) 1992, 1994, 1997, 1999, 2000 Free Software Foundation,
+dnl  Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+ifdef(`OPERATION_addmul_1',`
+      define(M4_inst,        addl)
+      define(M4_function_1,  mpn_addmul_1)
+
+',`ifdef(`OPERATION_submul_1',`
+      define(M4_inst,        subl)
+      define(M4_function_1,  mpn_submul_1)
+
+',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
+')')')
+
+MULFUNC_PROLOGUE(mpn_addmul_1 mpn_submul_1)
+
+
+C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                          mp_limb_t mult);
+
+define(PARAM_MULTIPLIER, `FRAME+16(%esp)')
+define(PARAM_SIZE,       `FRAME+12(%esp)')
+define(PARAM_SRC,        `FRAME+8(%esp)')
+define(PARAM_DST,        `FRAME+4(%esp)')
+
+	TEXT
+	ALIGN(8)
+
+PROLOGUE(M4_function_1)
+deflit(`FRAME',0)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+deflit(`FRAME',16)
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC,%esi
+	movl	PARAM_SIZE,%ecx
+
+	xorl	%ebx,%ebx
+	andl	$3,%ecx
+	jz	L(end0)
+
+L(oop0):
+	movl	(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	leal	4(%esi),%esi
+	addl	%ebx,%eax
+	movl	$0,%ebx
+	adcl	%ebx,%edx
+	M4_inst	%eax,(%edi)
+	adcl	%edx,%ebx	C propagate carry into cylimb
+
+	leal	4(%edi),%edi
+	decl	%ecx
+	jnz	L(oop0)
+
+L(end0):
+	movl	PARAM_SIZE,%ecx
+	shrl	$2,%ecx
+	jz	L(end)
+
+	ALIGN(8)
+L(oop):	movl	(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	addl	%eax,%ebx
+	movl	$0,%ebp
+	adcl	%edx,%ebp
+
+	movl	4(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	M4_inst	%ebx,(%edi)
+	adcl	%eax,%ebp	C new lo + cylimb
+	movl	$0,%ebx
+	adcl	%edx,%ebx
+
+	movl	8(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	M4_inst	%ebp,4(%edi)
+	adcl	%eax,%ebx	C new lo + cylimb
+	movl	$0,%ebp
+	adcl	%edx,%ebp
+
+	movl	12(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	M4_inst	%ebx,8(%edi)
+	adcl	%eax,%ebp	C new lo + cylimb
+	movl	$0,%ebx
+	adcl	%edx,%ebx
+
+	M4_inst	%ebp,12(%edi)
+	adcl	$0,%ebx		C propagate carry into cylimb
+
+	leal	16(%esi),%esi
+	leal	16(%edi),%edi
+	decl	%ecx
+	jnz	L(oop)
+
+L(end):	movl	%ebx,%eax
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/copyd.asm b/src/gmp/mpn/x86/copyd.asm
new file mode 100644
index 000000000..439640e83
--- /dev/null
+++ b/src/gmp/mpn/x86/copyd.asm
@@ -0,0 +1,80 @@
+dnl  x86 mpn_copyd -- copy limb vector, decrementing.
+dnl 
+dnl  Future: On P6 an MMX loop should be able to go faster than this code.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C void mpn_copyd (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C Copy src,size to dst,size, working from high to low addresses.
+C
+C The code here is very generic and can be expected to be reasonable on all
+C the x86 family.
+C
+C P5 - 1.0 cycles/limb.
+C
+C P6 - 2.4 cycles/limb, approx 40 cycles startup.
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+deflit(`FRAME',0)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_copyd)
+	C eax	saved esi
+	C ebx
+	C ecx	counter
+	C edx	saved edi
+	C esi	src
+	C edi	dst
+	C ebp
+
+	movl	PARAM_SIZE, %ecx
+	movl	%esi, %eax
+
+	movl	PARAM_SRC, %esi
+	movl	%edi, %edx
+
+	movl	PARAM_DST, %edi
+	leal	-4(%esi,%ecx,4), %esi
+
+	leal	-4(%edi,%ecx,4), %edi
+	
+	std
+
+	rep
+	movsl
+
+	cld
+
+	movl	%eax, %esi
+	movl	%edx, %edi
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/copyi.asm b/src/gmp/mpn/x86/copyi.asm
new file mode 100644
index 000000000..5bc4e3668
--- /dev/null
+++ b/src/gmp/mpn/x86/copyi.asm
@@ -0,0 +1,79 @@
+dnl  x86 mpn_copyi -- copy limb vector, incrementing.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C void mpn_copyi (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C Copy src,size to dst,size, working from low to high addresses.
+C
+C The code here is very generic and can be expected to be reasonable on all
+C the x86 family.
+C
+C P5 - 1.0 cycles/limb.
+C
+C P6 - 0.75 cycles/limb.  An MMX based copy was tried, but was found to be
+C      slower than a rep movs in all cases.  The fastest MMX found was 0.8
+C      cycles/limb (when fully aligned).  A rep movs seems to have a startup
+C      time of about 15 cycles, but doing something special for small sizes
+C      could lead to a branch misprediction that would destroy any saving.
+C      For now a plain rep movs seems ok for P6.
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+deflit(`FRAME',0)
+
+	.text
+	ALIGN(32)
+
+	C eax	saved esi
+	C ebx
+	C ecx	counter
+	C edx	saved edi
+	C esi	src
+	C edi	dst
+	C ebp
+
+PROLOGUE(mpn_copyi)
+
+	movl	PARAM_SIZE, %ecx
+	movl	%esi, %eax
+
+	movl	PARAM_SRC, %esi
+	movl	%edi, %edx
+
+	movl	PARAM_DST, %edi
+
+	cld	C better safe than sorry, see mpn/x86/README.family
+
+	rep
+	movsl
+
+	movl	%eax, %esi
+	movl	%edx, %edi
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/diveby3.asm b/src/gmp/mpn/x86/diveby3.asm
new file mode 100644
index 000000000..df879da9e
--- /dev/null
+++ b/src/gmp/mpn/x86/diveby3.asm
@@ -0,0 +1,115 @@
+dnl  x86 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+dnl  The following all have their own optimized versions of this routine,
+dnl  but for reference the code here runs as follows.
+dnl
+dnl       cycles/limb
+dnl  P54     18.0
+dnl  P55     17.0
+dnl  P6      14.5
+dnl  K6      14.0
+dnl  K7      10.0
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                              mp_limb_t carry);
+
+defframe(PARAM_CARRY,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,   8)
+defframe(PARAM_DST,   4)
+
+dnl  multiplicative inverse of 3, modulo 2^32
+deflit(INVERSE_3,       0xAAAAAAAB)
+
+dnl  ceil(b/3) and ceil(b*2/3) where b=2^32
+deflit(ONE_THIRD_CEIL,  0x55555556)
+deflit(TWO_THIRDS_CEIL, 0xAAAAAAAB)
+
+	.text
+	ALIGN(8)
+
+PROLOGUE(mpn_divexact_by3c)
+deflit(`FRAME',0)
+
+	movl	PARAM_SRC, %ecx
+	pushl	%ebp		FRAME_pushl()
+
+	movl	PARAM_SIZE, %ebp
+	pushl	%edi		FRAME_pushl()
+
+	movl	PARAM_DST, %edi
+	pushl	%esi		FRAME_pushl()
+
+	movl	$INVERSE_3, %esi
+	pushl	%ebx		FRAME_pushl()
+
+	leal	(%ecx,%ebp,4), %ecx
+	movl	PARAM_CARRY, %ebx
+
+	leal	(%edi,%ebp,4), %edi
+	negl	%ebp
+
+
+	ALIGN(8)
+L(top):
+	C eax	scratch, low product
+	C ebx	carry limb (0 to 3)
+	C ecx	&src[size]
+	C edx	scratch, high product
+	C esi	multiplier
+	C edi	&dst[size]
+	C ebp	counter, limbs, negative
+
+	movl	(%ecx,%ebp,4), %eax
+
+	subl	%ebx, %eax
+
+	setc	%bl
+
+	imull	%esi
+
+	cmpl	$ONE_THIRD_CEIL, %eax
+	movl	%eax, (%edi,%ebp,4)
+
+	sbbl	$-1, %ebx	C +1 if eax>=ceil(b/3)
+	cmpl	$TWO_THIRDS_CEIL, %eax
+
+	sbbl	$-1, %ebx	C +1 if eax>=ceil(b*2/3)
+	incl	%ebp
+
+	jnz	L(top)
+
+
+	movl	%ebx, %eax
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	popl	%ebp
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/divrem_1.asm b/src/gmp/mpn/x86/divrem_1.asm
new file mode 100644
index 000000000..12f14676d
--- /dev/null
+++ b/src/gmp/mpn/x86/divrem_1.asm
@@ -0,0 +1,232 @@
+dnl  x86 mpn_divrem_1 -- mpn by limb division extending to fractional quotient.
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+dnl        cycles/limb
+dnl  K6        20
+dnl  P5        44
+dnl  P6        39
+dnl  486   approx 43 maybe
+dnl
+dnl
+dnl  The following have their own optimized divrem_1 implementations, but
+dnl  for reference the code here runs as follows.
+dnl
+dnl        cycles/limb
+dnl  P6MMX     39
+dnl  K7        42
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_divrem_1 (mp_ptr dst, mp_size_t xsize,
+C                         mp_srcptr src, mp_size_t size, mp_limb_t divisor);
+C mp_limb_t mpn_divrem_1c (mp_ptr dst, mp_size_t xsize,
+C                          mp_srcptr src, mp_size_t size, mp_limb_t divisor);
+C
+C Divide src,size by divisor and store the quotient in dst+xsize,size.
+C Extend the division to fractional quotient limbs in dst,xsize.  Return the
+C remainder.  Either or both xsize and size can be 0.
+C
+C mpn_divrem_1c takes a carry parameter which is an initial high limb,
+C effectively one extra limb at the top of src,size.  Must have
+C carry<divisor.
+C
+C
+C Essentially the code is the same as the division based part of
+C mpn/generic/divrem_1.c, but has the following advantages.
+C
+C - If gcc isn't being used then divrem_1.c will get the generic C
+C   udiv_qrnnd() and be rather slow.
+C
+C - On K6, using the loop instruction is a 10% speedup, but gcc doesn't
+C   generate that instruction (as of gcc 2.95.2 at least).
+C
+C A test is done to see if the high limb is less the the divisor, and if so
+C one less div is done.  A div is between 20 and 40 cycles on the various
+C x86s, so assuming high<divisor about half the time, then this test saves
+C half that amount.  The branch misprediction penalty on each chip is less
+C than half a div.
+C  	
+C
+C K6: Back-to-back div instructions run at 20 cycles, the same as the loop
+C     here, so it seems there's nothing to gain by rearranging the loop.
+C     Pairing the mov and loop instructions was found to gain nothing.  (The
+C     same is true of the mpn/x86/mod_1.asm loop.)
+C
+C     With a "decl/jnz" rather than a "loop" this code runs at 22 cycles.
+C     The loop_or_decljnz macro is an easy way to get a 10% speedup.
+C
+C     The fast K6 multiply might be thought to suit a multiply-by-inverse,
+C     but that algorithm has been found to suffer from the releatively poor
+C     carry handling on K6 and too many auxiliary instructions.  The
+C     fractional part however could be done at about 13 c/l.
+C
+C P5: Moving the load down to pair with the store might save 1 cycle, but
+C     that doesn't seem worth bothering with, since it'd be only a 2.2%
+C     saving.
+C
+C     Again here the auxiliary instructions hinder a multiply-by-inverse,
+C     though there might be a 10-15% speedup available
+
+
+defframe(PARAM_CARRY,  24)
+defframe(PARAM_DIVISOR,20)
+defframe(PARAM_SIZE,   16)
+defframe(PARAM_SRC,    12)
+defframe(PARAM_XSIZE,  8)
+defframe(PARAM_DST,    4)
+
+	.text
+	ALIGN(16)
+
+PROLOGUE(mpn_divrem_1c)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	pushl	%edi		FRAME_pushl()
+	
+	movl	PARAM_SRC, %edi
+	pushl	%esi		FRAME_pushl()
+
+	movl	PARAM_DIVISOR, %esi
+	pushl	%ebx		FRAME_pushl()
+
+	movl	PARAM_DST, %ebx
+	pushl	%ebp		FRAME_pushl()
+
+	movl	PARAM_XSIZE, %ebp
+	orl	%ecx, %ecx
+
+	movl	PARAM_CARRY, %edx
+	jz	LF(mpn_divrem_1,fraction)
+
+	leal	-4(%ebx,%ebp,4), %ebx	C dst one limb below integer part
+	jmp	LF(mpn_divrem_1,integer_top)
+
+EPILOGUE()
+
+
+PROLOGUE(mpn_divrem_1)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	pushl	%edi		FRAME_pushl()
+	
+	movl	PARAM_SRC, %edi
+	pushl	%esi		FRAME_pushl()
+
+	movl	PARAM_DIVISOR, %esi
+	orl	%ecx,%ecx
+
+	jz	L(size_zero)
+	pushl	%ebx		FRAME_pushl()
+
+	movl	-4(%edi,%ecx,4), %eax	C src high limb
+	xorl	%edx, %edx
+
+	movl	PARAM_DST, %ebx
+	pushl	%ebp		FRAME_pushl()
+
+	movl	PARAM_XSIZE, %ebp
+	cmpl	%esi, %eax
+
+	leal	-4(%ebx,%ebp,4), %ebx	C dst one limb below integer part
+	jae	L(integer_entry)
+
+
+	C high<divisor, so high of dst is zero, and avoid one div
+
+	movl	%edx, (%ebx,%ecx,4)
+	decl	%ecx
+
+	movl	%eax, %edx
+	jz	L(fraction)
+
+
+L(integer_top):
+	C eax	scratch (quotient)
+	C ebx	dst+4*xsize-4
+	C ecx	counter
+	C edx	scratch (remainder)
+	C esi	divisor
+	C edi	src
+	C ebp	xsize
+
+	movl	-4(%edi,%ecx,4), %eax
+L(integer_entry):
+
+	divl	%esi
+
+	movl	%eax, (%ebx,%ecx,4)
+	loop_or_decljnz	L(integer_top)
+
+
+L(fraction):
+	orl	%ebp, %ecx
+	jz	L(done)
+
+	movl	PARAM_DST, %ebx
+
+
+L(fraction_top):
+	C eax	scratch (quotient)
+	C ebx	dst
+	C ecx	counter
+	C edx	scratch (remainder)
+	C esi	divisor
+	C edi
+	C ebp
+
+	xorl	%eax, %eax
+
+	divl	%esi
+
+	movl	%eax, -4(%ebx,%ecx,4)
+	loop_or_decljnz	L(fraction_top)
+
+
+L(done):
+	popl	%ebp
+	movl	%edx, %eax
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+
+L(size_zero):
+deflit(`FRAME',8)
+	movl	PARAM_XSIZE, %ecx
+	xorl	%eax, %eax
+
+	movl	PARAM_DST, %edi
+
+	cld	C better safe than sorry, see mpn/x86/README.family
+
+	rep
+	stosl
+
+	popl	%esi
+	popl	%edi
+	ret
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/README b/src/gmp/mpn/x86/k6/README
new file mode 100644
index 000000000..3ad96c8b8
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/README
@@ -0,0 +1,237 @@
+
+			AMD K6 MPN SUBROUTINES
+
+
+
+This directory contains code optimized for AMD K6 CPUs, meaning K6, K6-2 and
+K6-3.
+
+The mmx and k62mmx subdirectories have routines using MMX instructions.  All
+K6s have MMX, the separate directories are just so that ./configure can omit
+them if the assembler doesn't support MMX.
+
+
+
+
+STATUS
+
+Times for the loops, with all code and data in L1 cache, are as follows.
+
+                                 cycles/limb
+
+	mpn_add_n/sub_n            3.25 normal, 2.75 in-place
+
+	mpn_mul_1                  6.25
+	mpn_add/submul_1           7.65-8.4  (varying with data values)
+
+	mpn_mul_basecase           9.25 cycles/crossproduct (approx)
+	mpn_sqr_basecase           4.7  cycles/crossproduct (approx)
+                                   or 9.2 cycles/triangleproduct (approx)
+
+	mpn_divrem_1              20.0
+	mpn_mod_1                 20.0
+	mpn_divexact_by3          11.0
+
+	mpn_l/rshift               3.0
+
+	mpn_copyi/copyd            1.0
+
+	mpn_com_n                  1.5-1.85  \
+	mpn_and/andn/ior/xor_n     1.5-1.75  | varying with
+	mpn_iorn/xnor_n            2.0-2.25  | data alignment
+	mpn_nand/nior_n            2.0-2.25  /
+
+	mpn_popcount		  12.5
+	mpn_hamdist		  13.0
+
+
+K6-2 and K6-3 have dual-issue MMX and get the following improvements.
+
+	mpn_l/rshift               1.75
+
+	mpn_copyi/copyd            0.56 or 1.0  \
+                                                |
+	mpn_com_n                  1.0-1.2      | varying with
+	mpn_and/andn/ior/xor_n     1.2-1.5      | data alignment
+	mpn_iorn/xnor_n            1.5-2.0      |
+	mpn_nand/nior_n            1.75-2.0     /
+
+	mpn_popcount		   9.0
+	mpn_hamdist		  11.5
+
+
+Prefetching of sources hasn't yet given any joy.  With the 3DNow "prefetch"
+instruction, code seems to run slower, and with just "mov" loads it doesn't
+seem faster.  Results so far are inconsistent.  The K6 does a hardware
+prefetch of the second cache line in a sector, so the penalty for not
+prefetching in software is reduced.
+
+
+
+
+NOTES
+
+All K6 family chips have MMX, but only K6-2 and K6-3 have 3DNow.
+
+Plain K6 executes MMX instructions only in the X pipe, but K6-2 and K6-3 can
+execute them in both X and Y (and together).
+
+Branch misprediction penalty is 1 to 4 cycles (Optimization Manual
+chapter 6 table 12).
+
+Write-allocate L1 data cache means prefetching of destinations is unnecessary.
+Store queue is 7 entries of 64 bits each.
+
+Floating point multiplications can be done in parallel with integer
+multiplications, but there doesn't seem to be any way to make use of this.
+
+
+
+OPTIMIZATIONS
+
+Unrolled loops are used to reduce looping overhead.  The unrolling is
+configurable up to 32 limbs/loop for most routines, up to 64 for some.
+
+Sometimes computed jumps into the unrolling are used to handle sizes not a
+multiple of the unrolling.  An attractive feature of this is that times
+smoothly increase with operand size, but an indirect jump is about 6 cycles
+and the setups about another 6, so it depends on how much the unrolled code
+is faster than a simple loop as to whether a computed jump ought to be used.
+
+Position independent code is implemented using a call to get eip for
+computed jumps and a ret is always done, rather than an addl $4,%esp or a
+popl, so the CPU return address branch prediction stack stays synchronised
+with the actual stack in memory.  Such a call however still costs 4 to 7
+cycles.
+
+Branch prediction, in absence of any history, will guess forward jumps are
+not taken and backward jumps are taken.  Where possible it's arranged that
+the less likely or less important case is under a taken forward jump.
+
+
+
+MMX
+
+Putting emms or femms as late as possible in a routine seems to be fastest.
+Perhaps an emms or femms stalls until all outstanding MMX instructions have
+completed, so putting it later gives them a chance to complete on their own,
+in parallel with other operations (like register popping).
+
+The Optimization Manual chapter 5 recommends using a femms on K6-2 and K6-3
+at the start of a routine, in case it's been preceded by x87 floating point
+operations.  This isn't done because in gmp programs it's expected that x87
+floating point won't be much used and that chances are an mpn routine won't
+have been preceded by any x87 code.
+
+
+
+CODING
+
+Instructions in general code are shown paired if they can decode and execute
+together, meaning two short decode instructions with the second not
+depending on the first, only the first using the shifter, no more than one
+load, and no more than one store.
+
+K6 does some out of order execution so the pairings aren't essential, they
+just show what slots might be available.  When decoding is the limiting
+factor things can be scheduled that might not execute until later.
+
+
+
+NOTES
+
+Code alignment
+
+- if an opcode/modrm or 0Fh/opcode/modrm crosses a cache line boundary,
+  short decode is inhibited.  The cross.pl script detects this.
+
+- loops and branch targets should be aligned to 16 bytes, or ensure at least
+  2 instructions before a 32 byte boundary.  This makes use of the 16 byte
+  cache in the BTB.
+
+Addressing modes
+
+- (%esi) degrades decoding from short to vector.  0(%esi) doesn't have this
+  problem, and can be used as an equivalent, or easier is just to use a
+  different register, like %ebx.
+
+- K6 and pre-CXT core K6-2 have the following problem.  (K6-2 CXT and K6-3
+  have it fixed, these being cpuid function 1 signatures 0x588 to 0x58F).
+
+  If more than 3 bytes are needed to determine instruction length then
+  decoding degrades from direct to long, or from long to vector.  This
+  happens with forms like "0F opcode mod/rm" with mod/rm=00-xxx-100 since
+  with mod=00 the sib determines whether there's a displacement.
+
+  This affects all MMX and 3DNow instructions, and others with an 0F prefix
+  like movzbl.  The modes affected are anything with an index and no
+  displacement, or an index but no base, and this includes (%esp) which is
+  really (,%esp,1).
+
+  The cross.pl script detects problem cases.  The workaround is to always
+  use a displacement, and to do this with Zdisp if it's zero so the
+  assembler doesn't discard it.
+
+  See Optimization Manual rev D page 67 and 3DNow Porting Guide rev B pages
+  13-14 and 36-37.
+
+Calls
+
+- indirect jumps and calls are not branch predicted, they measure about 6
+  cycles.
+
+Various
+
+- adcl      2 cycles of decode, maybe 2 cycles executing in the X pipe
+- bsf       12-27 cycles
+- emms      5 cycles
+- femms     3 cycles
+- jecxz     2 cycles taken, 13 not taken (optimization manual says 7 not taken)
+- divl      20 cycles back-to-back
+- imull     2 decode, 2 execute
+- mull      2 decode, 3 execute (optimization manual decoding sample)
+- prefetch  2 cycles
+- rcll/rcrl implicit by one bit: 2 cycles
+            immediate or %cl count: 11 + 2 per bit for dword
+                                    13 + 4 per bit for byte
+- setCC	    2 cycles
+- xchgl	%eax,reg  1.5 cycles, back-to-back (strange)
+        reg,reg   2 cycles, back-to-back
+
+
+
+
+REFERENCES
+
+"AMD-K6 Processor Code Optimization Application Note", AMD publication
+number 21924, revision D amendment 0, January 2000.  This describes K6-2 and
+K6-3.  Available on-line,
+
+	http://www.amd.com/K6/k6docs/pdf/21924.pdf
+
+"AMD-K6 MMX Enhanced Processor x86 Code Optimization Application Note", AMD
+publication number 21828, revision A amendment 0, August 1997.  This is an
+older edition of the above document, describing plain K6.  Available
+on-line,
+
+	http://www.amd.com/K6/k6docs/pdf/21828.pdf
+
+"3DNow Technology Manual", AMD publication number 21928F/0-August 1999.
+This describes the femms and prefetch instructions, but nothing else from
+3DNow has been used.  Available on-line,
+
+	http://www.amd.com/K6/k6docs/pdf/21928.pdf
+
+"3DNow Instruction Porting Guide", AMD publication number 22621, revision B,
+August 1999.  This has some notes on general K6 optimizations as well as
+3DNow.  Available on-line,
+
+	http://www.amd.com/products/cpg/athlon/techdocs/pdf/22621.pdf
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 76
+End:
diff --git a/src/gmp/mpn/x86/k6/aors_n.asm b/src/gmp/mpn/x86/k6/aors_n.asm
new file mode 100644
index 000000000..31b05ada5
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/aors_n.asm
@@ -0,0 +1,329 @@
+dnl  AMD K6 mpn_add/sub_n -- mpn addition or subtraction.
+dnl 
+dnl  K6: normal 3.25 cycles/limb, in-place 2.75 cycles/limb.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+ifdef(`OPERATION_add_n', `
+	define(M4_inst,        adcl)
+	define(M4_function_n,  mpn_add_n)
+	define(M4_function_nc, mpn_add_nc)
+	define(M4_description, add)
+',`ifdef(`OPERATION_sub_n', `
+	define(M4_inst,        sbbl)
+	define(M4_function_n,  mpn_sub_n)
+	define(M4_function_nc, mpn_sub_nc)
+	define(M4_description, subtract)
+',`m4_error(`Need OPERATION_add_n or OPERATION_sub_n
+')')')
+
+MULFUNC_PROLOGUE(mpn_add_n mpn_add_nc mpn_sub_n mpn_sub_nc)
+
+
+C mp_limb_t M4_function_n (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
+C                          mp_size_t size);
+C mp_limb_t M4_function_nc (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
+C	                      mp_size_t size, mp_limb_t carry);
+C
+C Calculate src1,size M4_description src2,size, and store the result in
+C dst,size.  The return value is the carry bit from the top of the result
+C (1 or 0).
+C
+C The _nc version accepts 1 or 0 for an initial carry into the low limb of
+C the calculation.  Note values other than 1 or 0 here will lead to garbage
+C results.
+C
+C Instruction decoding limits a normal dst=src1+src2 operation to 3 c/l, and
+C an in-place dst+=src to 2.5 c/l.  The unrolled loops have 1 cycle/loop of
+C loop control, which with 4 limbs/loop means an extra 0.25 c/l.
+
+define(PARAM_CARRY, `FRAME+20(%esp)')
+define(PARAM_SIZE,  `FRAME+16(%esp)')
+define(PARAM_SRC2,  `FRAME+12(%esp)')
+define(PARAM_SRC1,  `FRAME+8(%esp)')
+define(PARAM_DST,   `FRAME+4(%esp)')
+deflit(`FRAME',0)
+
+dnl  minimum 5 because the unrolled code can't handle less
+deflit(UNROLL_THRESHOLD, 5)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(M4_function_nc)
+	movl	PARAM_CARRY, %eax
+	jmp	LF(M4_function_n,start)
+EPILOGUE()
+
+
+PROLOGUE(M4_function_n)
+	xorl	%eax, %eax
+L(start):
+	movl	PARAM_SIZE, %ecx
+	pushl	%ebx
+FRAME_pushl()
+
+	movl	PARAM_SRC1, %ebx
+	pushl	%edi
+FRAME_pushl()
+
+	movl	PARAM_SRC2, %edx
+	cmpl	$UNROLL_THRESHOLD, %ecx
+
+	movl	PARAM_DST, %edi
+	jae	L(unroll)
+
+
+	shrl	%eax		C initial carry flag
+
+	C offset 0x21 here, close enough to aligned
+L(simple):
+	C eax	scratch
+	C ebx	src1
+	C ecx	counter
+	C edx	src2
+	C esi
+	C edi	dst
+	C ebp
+	C
+	C The store to (%edi) could be done with a stosl; it'd be smaller
+	C code, but there's no speed gain and a cld would have to be added
+	C (per mpn/x86/README.family).
+
+	movl	(%ebx), %eax
+	leal	4(%ebx), %ebx
+	
+	M4_inst	(%edx), %eax
+
+	movl	%eax, (%edi)
+	leal	4(%edi), %edi
+
+	leal	4(%edx), %edx
+	loop	L(simple)
+
+	
+	movl	$0, %eax
+	popl	%edi
+
+	setc	%al
+
+	popl	%ebx
+	ret
+
+
+C -----------------------------------------------------------------------------
+L(unroll):
+	C eax	carry
+	C ebx	src1
+	C ecx	counter
+	C edx	src2
+	C esi
+	C edi	dst
+	C ebp
+
+	cmpl	%edi, %ebx
+	pushl	%esi
+
+	je	L(inplace)
+
+ifdef(`OPERATION_add_n',`
+	cmpl	%edi, %edx
+
+	je	L(inplace_reverse)
+')
+
+	movl	%ecx, %esi
+
+	andl	$-4, %ecx
+	andl	$3, %esi
+
+	leal	(%ebx,%ecx,4), %ebx
+	leal	(%edx,%ecx,4), %edx
+	leal	(%edi,%ecx,4), %edi
+
+	negl	%ecx
+	shrl	%eax
+
+	ALIGN(32)
+L(normal_top):
+	C eax	counter, qwords, negative
+	C ebx	src1
+	C ecx	scratch
+	C edx	src2
+	C esi
+	C edi	dst
+	C ebp
+
+ 	movl	(%ebx,%ecx,4), %eax
+	leal	5(%ecx), %ecx
+ 	M4_inst	-20(%edx,%ecx,4), %eax
+ 	movl	%eax, -20(%edi,%ecx,4)
+
+ 	movl	4-20(%ebx,%ecx,4), %eax
+ 	M4_inst	4-20(%edx,%ecx,4), %eax
+ 	movl	%eax, 4-20(%edi,%ecx,4)
+
+ 	movl	8-20(%ebx,%ecx,4), %eax
+ 	M4_inst	8-20(%edx,%ecx,4), %eax
+ 	movl	%eax, 8-20(%edi,%ecx,4)
+
+ 	movl	12-20(%ebx,%ecx,4), %eax
+ 	M4_inst	12-20(%edx,%ecx,4), %eax
+ 	movl	%eax, 12-20(%edi,%ecx,4)
+
+	loop	L(normal_top)
+
+
+	decl	%esi
+	jz	L(normal_finish_one)
+	js	L(normal_done)
+
+	C two or three more limbs
+
+ 	movl	(%ebx), %eax
+ 	M4_inst	(%edx), %eax
+ 	movl	%eax, (%edi)
+
+ 	movl	4(%ebx), %eax
+ 	M4_inst	4(%edx), %eax
+	decl	%esi
+ 	movl	%eax, 4(%edi)
+
+	jz	L(normal_done)
+	movl	$2, %ecx
+
+L(normal_finish_one):
+ 	movl	(%ebx,%ecx,4), %eax
+ 	M4_inst	(%edx,%ecx,4), %eax
+ 	movl	%eax, (%edi,%ecx,4)
+
+L(normal_done):	
+	popl	%esi
+	popl	%edi
+
+	movl	$0, %eax
+	popl	%ebx
+
+	setc	%al
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+
+ifdef(`OPERATION_add_n',`
+L(inplace_reverse):
+	C dst==src2
+
+	movl	%ebx, %edx
+')
+
+L(inplace):
+	C eax	initial carry
+	C ebx
+	C ecx	size
+	C edx	src
+	C esi
+	C edi	dst
+	C ebp
+
+	leal	-1(%ecx), %esi
+	decl	%ecx
+
+	andl	$-4, %ecx
+	andl	$3, %esi
+
+ 	movl	(%edx), %ebx		C src low limb
+	leal	(%edx,%ecx,4), %edx
+
+	leal	(%edi,%ecx,4), %edi
+	negl	%ecx
+
+	shrl	%eax
+
+
+	ALIGN(32)
+L(inplace_top):
+	C eax
+	C ebx	next src limb
+	C ecx	size
+	C edx	src
+	C esi
+	C edi	dst
+	C ebp
+
+ 	M4_inst	%ebx, (%edi,%ecx,4)
+
+ 	movl	4(%edx,%ecx,4), %eax
+	leal	5(%ecx), %ecx
+
+ 	M4_inst	%eax, 4-20(%edi,%ecx,4)
+
+ 	movl	8-20(%edx,%ecx,4), %eax
+ 	movl	12-20(%edx,%ecx,4), %ebx
+
+ 	M4_inst	%eax, 8-20(%edi,%ecx,4)
+ 	M4_inst	%ebx, 12-20(%edi,%ecx,4)
+
+ 	movl	16-20(%edx,%ecx,4), %ebx
+	loop	L(inplace_top)
+
+
+	C now %esi is 0 to 3 representing respectively 1 to 4 limbs more
+
+ 	M4_inst	%ebx, (%edi)
+
+	decl	%esi
+	jz	L(inplace_finish_one)
+	js	L(inplace_done)
+
+	C two or three more limbs
+
+ 	movl	4(%edx), %eax
+ 	movl	8(%edx), %ebx
+ 	M4_inst	%eax, 4(%edi)
+ 	M4_inst	%ebx, 8(%edi)
+
+	decl	%esi
+	movl	$2, %ecx
+
+	jz	L(normal_done)
+
+L(inplace_finish_one):
+ 	movl	4(%edx,%ecx,4), %eax
+ 	M4_inst	%eax, 4(%edi,%ecx,4)
+
+L(inplace_done):	
+	popl	%esi
+	popl	%edi
+
+	movl	$0, %eax
+	popl	%ebx
+
+	setc	%al
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/aorsmul_1.asm b/src/gmp/mpn/x86/k6/aorsmul_1.asm
new file mode 100644
index 000000000..da4120fe2
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/aorsmul_1.asm
@@ -0,0 +1,372 @@
+dnl  AMD K6 mpn_addmul_1/mpn_submul_1 -- add or subtract mpn multiple.
+dnl 
+dnl  K6: 7.65 to 8.5 cycles/limb (at 16 limbs/loop and depending on the data),
+dnl  PIC adds about 6 cycles at the start.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K6:           large multpliers  small multpliers
+dnl  UNROLL_COUNT    cycles/limb       cycles/limb
+dnl        4             9.5              7.78
+dnl        8             9.0              7.78
+dnl       16             8.4              7.65
+dnl       32             8.4              8.2
+dnl
+dnl  Maximum possible unrolling with the current code is 32.
+dnl
+dnl  Unrolling to 16 limbs/loop makes the unrolled loop fit exactly in a 256
+dnl  byte block, which might explain the good speed at that unrolling.
+
+deflit(UNROLL_COUNT, 16)
+
+
+ifdef(`OPERATION_addmul_1', `
+	define(M4_inst,        addl)
+	define(M4_function_1,  mpn_addmul_1)
+	define(M4_function_1c, mpn_addmul_1c)
+	define(M4_description, add it to)
+	define(M4_desc_retval, carry)
+',`ifdef(`OPERATION_submul_1', `
+	define(M4_inst,        subl)
+	define(M4_function_1,  mpn_submul_1)
+	define(M4_function_1c, mpn_submul_1c)
+	define(M4_description, subtract it from)
+	define(M4_desc_retval, borrow)
+',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
+')')')
+
+MULFUNC_PROLOGUE(mpn_addmul_1 mpn_addmul_1c mpn_submul_1 mpn_submul_1c)
+
+
+C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                          mp_limb_t mult);
+C mp_limb_t M4_function_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                           mp_limb_t mult, mp_limb_t carry);
+C
+C Calculate src,size multiplied by mult and M4_description dst,size.
+C Return the M4_desc_retval limb from the top of the result.
+C
+C The jadcl0()s in the unrolled loop makes the speed data dependent.  Small
+C multipliers (most significant few bits clear) result in few carry bits and
+C speeds up to 7.65 cycles/limb are attained.  Large multipliers (most
+C significant few bits set) make the carry bits 50/50 and lead to something
+C more like 8.4 c/l.  (With adcl's both of these would be 9.3 c/l.)
+C
+C It's important that the gains for jadcl0 on small multipliers don't come
+C at the cost of slowing down other data.  Tests on uniformly distributed
+C random data, designed to confound branch prediction, show about a 7%
+C speed-up using jadcl0 over adcl (8.93 versus 9.57 cycles/limb, with all
+C overheads included).
+C
+C In the simple loop, jadcl0() measures slower than adcl (11.9-14.7 versus
+C 11.0 cycles/limb), and hence isn't used.
+C
+C In the simple loop, note that running ecx from negative to zero and using
+C it as an index in the two movs wouldn't help.  It would save one
+C instruction (2*addl+loop becoming incl+jnz), but there's nothing unpaired
+C that would be collapsed by this.
+C
+C
+C jadcl0
+C ------
+C
+C jadcl0() being faster than adcl $0 seems to be an artifact of two things,
+C firstly the instruction decoding and secondly the fact that there's a
+C carry bit for the jadcl0 only on average about 1/4 of the time.
+C
+C The code in the unrolled loop decodes something like the following.
+C
+C                                         decode cycles
+C		mull	%ebp                    2
+C		M4_inst	%esi, disp(%edi)        1
+C		adcl	%eax, %ecx              2
+C		movl	%edx, %esi            \ 1
+C		jnc	1f                    /
+C		incl	%esi                  \ 1
+C	1:	movl	disp(%ebx), %eax      /
+C                                              ---
+C                                               7
+C
+C In a back-to-back style test this measures 7 with the jnc not taken, or 8
+C with it taken (both when correctly predicted).  This is opposite to the
+C measurements showing small multipliers running faster than large ones.
+C Watch this space for more info ...
+C
+C It's not clear how much branch misprediction might be costing.  The K6
+C doco says it will be 1 to 4 cycles, but presumably it's near the low end
+C of that range to get the measured results.
+C
+C
+C In the code the two carries are more or less the preceding mul product and
+C the calculation is roughly
+C
+C	x*y + u*b+v
+C
+C where b=2^32 is the size of a limb, x*y is the two carry limbs, and u and
+C v are the two limbs it's added to (being the low of the next mul, and a
+C limb from the destination).
+C
+C To get a carry requires x*y+u*b+v >= b^2, which is u*b+v >= b^2-x*y, and
+C there are b^2-(b^2-x*y) = x*y many such values, giving a probability of
+C x*y/b^2.  If x, y, u and v are random and uniformly distributed between 0
+C and b-1, then the total probability can be summed over x and y,
+C
+C	 1    b-1 b-1 x*y    1    b*(b-1)   b*(b-1)
+C	--- * sum sum --- = --- * ------- * ------- = 1/4
+C       b^2   x=0 y=1 b^2   b^4      2         2
+C
+C Actually it's a very tiny bit less than 1/4 of course.  If y is fixed,
+C then the probability is 1/2*y/b thus varying linearly between 0 and 1/2.
+
+
+ifdef(`PIC',`
+deflit(UNROLL_THRESHOLD, 9)
+',`
+deflit(UNROLL_THRESHOLD, 6)
+')
+
+defframe(PARAM_CARRY,     20)
+defframe(PARAM_MULTIPLIER,16)
+defframe(PARAM_SIZE,      12)
+defframe(PARAM_SRC,       8)
+defframe(PARAM_DST,       4)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(M4_function_1c)
+	pushl	%esi
+deflit(`FRAME',4)
+	movl	PARAM_CARRY, %esi
+	jmp	LF(M4_function_1,start_nc)
+EPILOGUE()
+
+PROLOGUE(M4_function_1)
+	push	%esi
+deflit(`FRAME',4)
+	xorl	%esi, %esi	C initial carry
+
+L(start_nc):
+	movl	PARAM_SIZE, %ecx
+	pushl	%ebx
+deflit(`FRAME',8)
+
+	movl	PARAM_SRC, %ebx
+	pushl	%edi
+deflit(`FRAME',12)
+
+	cmpl	$UNROLL_THRESHOLD, %ecx
+	movl	PARAM_DST, %edi
+
+	pushl	%ebp
+deflit(`FRAME',16)
+	jae	L(unroll)
+
+	
+	C simple loop
+
+	movl	PARAM_MULTIPLIER, %ebp
+
+L(simple):
+	C eax	scratch
+	C ebx	src
+	C ecx	counter
+	C edx	scratch
+	C esi	carry
+	C edi	dst
+	C ebp	multiplier
+
+	movl	(%ebx), %eax
+	addl	$4, %ebx
+
+	mull	%ebp
+
+	addl	$4, %edi
+	addl	%esi, %eax
+
+	adcl	$0, %edx
+
+	M4_inst	%eax, -4(%edi)
+
+	adcl	$0, %edx
+
+	movl	%edx, %esi
+	loop	L(simple)
+
+
+	popl	%ebp
+	popl	%edi
+
+	popl	%ebx
+	movl	%esi, %eax
+
+	popl	%esi
+	ret
+
+
+
+C -----------------------------------------------------------------------------
+C The unrolled loop uses a "two carry limbs" scheme.  At the top of the loop
+C the carries are ecx=lo, esi=hi, then they swap for each limb processed.
+C For the computed jump an odd size means they start one way around, an even
+C size the other.
+C
+C VAR_JUMP holds the computed jump temporarily because there's not enough
+C registers at the point of doing the mul for the initial two carry limbs.
+C
+C The add/adc for the initial carry in %esi is necessary only for the
+C mpn_addmul/submul_1c entry points.  Duplicating the startup code to
+C eliminiate this for the plain mpn_add/submul_1 doesn't seem like a good
+C idea.
+
+dnl  overlapping with parameters already fetched
+define(VAR_COUNTER, `PARAM_SIZE')
+define(VAR_JUMP,    `PARAM_DST')
+
+L(unroll):
+	C eax
+	C ebx	src
+	C ecx	size
+	C edx
+	C esi	initial carry
+	C edi	dst
+	C ebp
+
+	movl	%ecx, %edx
+	decl	%ecx
+
+	subl	$2, %edx
+	negl	%ecx
+
+	shrl	$UNROLL_LOG2, %edx
+	andl	$UNROLL_MASK, %ecx
+
+	movl	%edx, VAR_COUNTER
+	movl	%ecx, %edx
+
+	shll	$4, %edx
+	negl	%ecx
+
+	C 15 code bytes per limb
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(here):
+',`
+	leal	L(entry) (%edx,%ecx,1), %edx
+')
+	movl	(%ebx), %eax		C src low limb
+
+	movl	PARAM_MULTIPLIER, %ebp
+	movl	%edx, VAR_JUMP
+
+	mull	%ebp
+
+	addl	%esi, %eax	C initial carry (from _1c)
+	jadcl0(	%edx)
+
+
+	leal	4(%ebx,%ecx,4), %ebx
+	movl	%edx, %esi	C high carry
+
+	movl	VAR_JUMP, %edx
+	leal	(%edi,%ecx,4), %edi
+
+	testl	$1, %ecx
+	movl	%eax, %ecx	C low carry
+
+	jz	L(noswap)
+	movl	%esi, %ecx	C high,low carry other way around
+
+	movl	%eax, %esi
+L(noswap):
+
+	jmp	*%edx
+
+
+ifdef(`PIC',`
+L(pic_calc):
+	C See README.family about old gas bugs
+	leal	(%edx,%ecx,1), %edx
+	addl	$L(entry)-L(here), %edx
+	addl	(%esp), %edx
+	ret
+')
+
+
+C -----------------------------------------------------------
+	ALIGN(32)
+L(top):
+deflit(`FRAME',16)
+	C eax	scratch
+	C ebx	src
+	C ecx	carry lo
+	C edx	scratch
+	C esi	carry hi
+	C edi	dst
+	C ebp	multiplier
+	C
+	C 15 code bytes per limb
+
+	leal	UNROLL_BYTES(%edi), %edi
+
+L(entry):
+forloop(`i', 0, UNROLL_COUNT/2-1, `
+	deflit(`disp0', eval(2*i*4))
+	deflit(`disp1', eval(disp0 + 4))
+
+Zdisp(	movl,	disp0,(%ebx), %eax)
+	mull	%ebp
+Zdisp(	M4_inst,%ecx, disp0,(%edi))
+	adcl	%eax, %esi
+	movl	%edx, %ecx
+	jadcl0(	%ecx)
+
+	movl	disp1(%ebx), %eax
+	mull	%ebp
+	M4_inst	%esi, disp1(%edi)
+	adcl	%eax, %ecx
+	movl	%edx, %esi
+	jadcl0(	%esi)
+')
+
+	decl	VAR_COUNTER
+	leal	UNROLL_BYTES(%ebx), %ebx
+
+	jns	L(top)
+
+
+	popl	%ebp
+	M4_inst	%ecx, UNROLL_BYTES(%edi)
+
+	popl	%edi
+	movl	%esi, %eax
+
+	popl	%ebx
+	jadcl0(	%eax)
+
+	popl	%esi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/cross.pl b/src/gmp/mpn/x86/k6/cross.pl
new file mode 100755
index 000000000..21734f3e5
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/cross.pl
@@ -0,0 +1,141 @@
+#! /usr/bin/perl
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published
+# by the Free Software Foundation; either version 2.1 of the License, or (at
+# your option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+# Usage: cross.pl [filename.o]...
+#
+# Produce an annotated disassembly of the given object files, indicating
+# certain code alignment and addressing mode problems afflicting K6 chips.
+# "ZZ" is used on all annotations, so this can be searched for.
+#
+# With no arguments, all .o files corresponding to .asm files are processed.
+# This is good in the mpn object directory of a k6*-*-* build.
+#
+# As far as fixing problems goes, any cache line crossing problems in loops
+# get attention, but as a rule it's too tedious to rearrange code or slip in
+# nops to fix every problem in setup or finishup code.
+#
+# Bugs:
+#
+# Instructions without mod/rm bytes or which are already vector decoded are
+# unaffected by cache line boundary crossing, but not all of these have yet
+# been put in as exceptions.  All that occur in practice in GMP are present
+# though.
+#
+# There's no messages for using the vector decoded addressing mode (%esi),
+# but that mode is easy to avoid when coding.
+
+use strict;
+
+sub disassemble {
+    my ($file) = @_;
+    my ($addr,$b1,$b2,$b3, $prefix,$opcode,$modrm);
+
+    open (IN, "objdump -Srfh $file |")
+	|| die "Cannot open pipe from objdump\n";
+    while (<IN>) {
+	print;
+
+	if (/^[ \t]*[0-9]+[ \t]+\.text[ \t]/ && /2\*\*([0-9]+)$/) {
+	    if ($1 < 5) {
+		print "ZZ need at least 2**5 for predictable cache line crossing\n";
+	    }
+	}
+	
+	if (/^[ \t]*([0-9a-f]*):[ \t]*([0-9a-f]+)[ \t]+([0-9a-f]+)[ \t]+([0-9a-f]+)/) {
+	    ($addr,$b1,$b2,$b3) = ($1,$2,$3,$4);
+
+	} elsif (/^[ \t]*([0-9a-f]*):[ \t]*([0-9a-f]+)[ \t]+([0-9a-f]+)/) {
+	    ($addr,$b1,$b2,$b3) = ($1,$2,$3,'');
+
+	} elsif (/^[ \t]*([0-9a-f]*):[ \t]*([0-9a-f]+)/) {
+	    ($addr,$b1,$b2,$b3) = ($1,$2,'','');
+
+	} else {
+	    next;
+	}
+
+	if ($b1 =~ /0f/) {
+	    $prefix = $b1;
+	    $opcode = $b2;
+	    $modrm = $b3;
+	} else {
+	    $prefix = '';
+	    $opcode = $b1;
+	    $modrm = $b2;
+	}
+
+	# modrm of the form 00-xxx-100 with an 0F prefix is the problem case
+	# for K6 and pre-CXT K6-2
+	if ($prefix =~ /0f/
+	    && $opcode !~ /^8/         # jcond disp32
+	    && $modrm =~ /^[0-3][4c]/) {
+	    print "ZZ ($file) >3 bytes to determine instruction length\n";
+	}
+
+	# with just an opcode, starting 1f mod 20h
+	if ($addr =~ /[13579bdf]f$/
+	    && $prefix !~ /0f/
+	    && $opcode !~ /1[012345]/ # adc
+	    && $opcode !~ /1[89abcd]/ # sbb
+	    && $opcode !~ /68/        # push $imm32
+	    && $opcode !~ /^7/        # jcond disp8
+	    && $opcode !~ /a[89]/     # test+imm
+	    && $opcode !~ /a[a-f]/    # stos/lods/scas
+	    && $opcode !~ /b8/        # movl $imm32,%eax
+	    && $opcode !~ /e[0123]/   # loop/loopz/loopnz/jcxz
+	    && $opcode !~ /e[b9]/     # jmp disp8/disp32
+	    && $opcode !~ /f[89abcd]/ # clc,stc,cli,sti,cld,std
+	    && !($opcode =~ /f[67]/          # grp 1
+		 && $modrm =~ /^[2367abef]/) # mul, imul, div, idiv
+	    && $modrm !~ /^$/) {
+	    print "ZZ ($file) opcode/modrm cross 32-byte boundary\n";
+	}
+
+	# with an 0F prefix, anything starting at 1f mod 20h
+	if ($addr =~ /[13579bdf][f]$/
+	    && $prefix =~ /0f/) {
+	    print "ZZ ($file) prefix/opcode cross 32-byte boundary\n";
+	}
+
+	# with an 0F prefix, anything with mod/rm starting at 1e mod 20h
+	if ($addr =~ /[13579bdf][e]$/
+	    && $prefix =~ /0f/
+	     && $opcode !~ /^8/        # jcond disp32
+	    && $modrm !~ /^$/) {
+	    print "ZZ ($file) prefix/opcode/modrm cross 32-byte boundary\n";
+	}
+    }
+    close IN || die "Error from objdump (or objdump not available)\n";
+}
+
+
+my @files;
+if ($#ARGV >= 0) {
+    @files = @ARGV;
+} else {
+    @files = glob "*.asm";
+    map {s/.asm/.o/} @files;
+}
+
+foreach (@files)  {
+    disassemble($_);
+}
diff --git a/src/gmp/mpn/x86/k6/diveby3.asm b/src/gmp/mpn/x86/k6/diveby3.asm
new file mode 100644
index 000000000..ffb97bc38
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/diveby3.asm
@@ -0,0 +1,110 @@
+dnl  AMD K6 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
+dnl 
+dnl  K6: 11.0 cycles/limb
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                              mp_limb_t carry);
+C
+C Using %esi in (%esi,%ecx,4) or 0(%esi,%ecx,4) addressing modes doesn't
+C lead to vector decoding, unlike plain (%esi) does.
+
+defframe(PARAM_CARRY,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,   8)
+defframe(PARAM_DST,   4)
+
+dnl  multiplicative inverse of 3, modulo 2^32
+deflit(INVERSE_3, 0xAAAAAAAB)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_divexact_by3c)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	pushl	%esi		defframe_pushl(SAVE_ESI)
+
+	movl	PARAM_SRC, %esi
+	pushl	%edi		defframe_pushl(SAVE_EDI)
+
+	movl	PARAM_DST, %edi
+	pushl	%ebx		defframe_pushl(SAVE_EBX)
+
+	movl	PARAM_CARRY, %ebx
+	leal	(%esi,%ecx,4), %esi
+
+	pushl	$3		defframe_pushl(VAR_THREE)
+	leal	(%edi,%ecx,4), %edi
+
+	negl	%ecx
+
+
+	C Need 32 alignment for claimed speed, to avoid the movl store
+	C opcode/modrm crossing a cache line boundary
+
+	ALIGN(32)
+L(top):
+	C eax	scratch, low product
+	C ebx	carry limb (0 to 3)
+	C ecx	counter, limbs, negative
+	C edx	scratch, high product
+	C esi	&src[size]
+	C edi	&dst[size]
+	C ebp
+	C
+	C The 0(%esi,%ecx,4) form pads so the finishup "movl %ebx, %eax"
+	C doesn't cross a 32 byte boundary, saving a couple of cycles
+	C (that's a fixed couple, not per loop).
+
+Zdisp(	movl,	0,(%esi,%ecx,4), %eax)
+	subl	%ebx, %eax
+
+	setc	%bl
+
+	imull	$INVERSE_3, %eax
+
+	movl	%eax, (%edi,%ecx,4)
+	addl	$2, %ecx
+
+	mull	VAR_THREE
+
+	addl	%edx, %ebx
+	loop	L(top)
+
+
+	movl	SAVE_ESI, %esi
+	movl	%ebx, %eax
+
+	movl	SAVE_EBX, %ebx
+
+	movl	SAVE_EDI, %edi
+	addl	$FRAME, %esp
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/gmp-mparam.h b/src/gmp/mpn/x86/k6/gmp-mparam.h
new file mode 100644
index 000000000..77f3948d7
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/gmp-mparam.h
@@ -0,0 +1,97 @@
+/* AMD K6 gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+
+#ifndef UMUL_TIME
+#define UMUL_TIME   3   /* cycles */
+#endif
+
+#ifndef UDIV_TIME
+#define UDIV_TIME   20  /* cycles */
+#endif
+
+/* bsfl takes 12-27 cycles, put an average for uniform random numbers */
+#ifndef COUNT_TRAILING_ZEROS_TIME
+#define COUNT_TRAILING_ZEROS_TIME   14  /* cycles */
+#endif
+
+
+/* Generated by tuneup.c, 2000-07-04. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   18
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD      130
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   34
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD      116
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              68
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD             98
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            13
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        4
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD          67
+#endif
+
+#ifndef FFT_MUL_TABLE
+#define FFT_MUL_TABLE  { 528, 1184, 2176, 5632, 14336, 40960, 0 }
+#endif
+#ifndef FFT_MODF_MUL_THRESHOLD
+#define FFT_MODF_MUL_THRESHOLD     472
+#endif
+#ifndef FFT_MUL_THRESHOLD
+#define FFT_MUL_THRESHOLD         4352
+#endif
+
+#ifndef FFT_SQR_TABLE
+#define FFT_SQR_TABLE  { 528, 1184, 2176, 5632, 14336, 40960, 0 }
+#endif
+#ifndef FFT_MODF_SQR_THRESHOLD
+#define FFT_MODF_SQR_THRESHOLD     544
+#endif
+#ifndef FFT_SQR_THRESHOLD
+#define FFT_SQR_THRESHOLD         4352
+#endif
diff --git a/src/gmp/mpn/x86/k6/k62mmx/copyd.asm b/src/gmp/mpn/x86/k6/k62mmx/copyd.asm
new file mode 100644
index 000000000..20a33e6cc
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/k62mmx/copyd.asm
@@ -0,0 +1,179 @@
+dnl  AMD K6-2 mpn_copyd -- copy limb vector, decrementing.
+dnl 
+dnl  K6-2: 0.56 or 1.0 cycles/limb (at 32 limbs/loop), depending on data
+dnl  alignment.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K6-2 aligned:
+dnl  UNROLL_COUNT cycles/limb
+dnl        8          0.75
+dnl       16          0.625
+dnl       32          0.5625
+dnl       64          0.53
+dnl  Maximum possible with the current code is 64, the minimum is 2.
+
+deflit(UNROLL_COUNT, 32)
+
+
+C void mpn_copyd (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C Copy src,size to dst,size, processing limbs from high to low addresses.
+C
+C The comments in copyi.asm apply here too.
+
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+deflit(`FRAME',0)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_copyd)
+	movl	PARAM_SIZE, %ecx
+	movl	%esi, %eax
+
+	movl	PARAM_SRC, %esi
+	movl	%edi, %edx
+
+	std
+
+	movl	PARAM_DST, %edi
+	cmpl	$UNROLL_COUNT, %ecx
+
+	leal	-4(%esi,%ecx,4), %esi
+
+	leal	-4(%edi,%ecx,4), %edi
+	ja	L(unroll)
+
+L(simple):
+	rep
+	movsl
+
+	cld
+
+	movl	%eax, %esi
+	movl	%edx, %edi
+
+	ret
+
+
+L(unroll):
+	C if src and dst are different alignments mod8, then use rep movs
+	C if src and dst are both 4mod8 then process one limb to get 0mod8
+
+	pushl	%ebx
+	leal	(%esi,%edi), %ebx
+
+	testb	$4, %bl
+	popl	%ebx
+	
+	jnz	L(simple)
+	testl	$4, %esi
+
+	leal	-UNROLL_COUNT(%ecx), %ecx
+	jnz	L(already_aligned)
+
+	movsl
+
+	decl	%ecx
+L(already_aligned):
+
+
+ifelse(UNROLL_BYTES,256,`
+	subl	$128, %esi
+	subl	$128, %edi
+')
+
+	C offset 0x3D here, but gets full speed without further alignment
+L(top):
+	C eax	saved esi
+	C ebx
+	C ecx	counter, limbs
+	C edx	saved edi
+	C esi	src, incrementing
+	C edi	dst, incrementing
+	C ebp
+	C
+	C `disp' is never 0, so don't need to force 0(%esi).
+
+deflit(CHUNK_COUNT, 2)
+forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
+	deflit(`disp', eval(-4-i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,+128)))
+	movq	disp(%esi), %mm0
+	movq	%mm0, disp(%edi)
+')
+
+	leal	-UNROLL_BYTES(%esi), %esi
+	subl	$UNROLL_COUNT, %ecx
+
+	leal	-UNROLL_BYTES(%edi), %edi
+	jns	L(top)
+
+
+	C now %ecx is -UNROLL_COUNT to -1 representing repectively 0 to
+	C UNROLL_COUNT-1 limbs remaining
+
+	testb	$eval(UNROLL_COUNT/2), %cl
+
+	leal	UNROLL_COUNT(%ecx), %ecx
+	jz	L(not_half)
+
+
+	C at an unroll count of 32 this block of code is 16 cycles faster than
+	C the rep movs, less 3 or 4 to test whether to do it
+
+forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT/2-1, `
+	deflit(`disp', eval(-4-i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,+128)))
+	movq	disp(%esi), %mm0
+	movq	%mm0, disp(%edi)
+')
+
+	subl	$eval(UNROLL_BYTES/2), %esi
+	subl	$eval(UNROLL_BYTES/2), %edi
+
+	subl	$eval(UNROLL_COUNT/2), %ecx
+L(not_half):
+
+
+ifelse(UNROLL_BYTES,256,`
+	addl	$128, %esi
+	addl	$128, %edi
+')
+
+	rep
+	movsl
+
+	cld
+
+	movl	%eax, %esi
+	movl	%edx, %edi
+
+	femms
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/k62mmx/copyi.asm b/src/gmp/mpn/x86/k6/k62mmx/copyi.asm
new file mode 100644
index 000000000..215d805f2
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/k62mmx/copyi.asm
@@ -0,0 +1,196 @@
+dnl  AMD K6-2 mpn_copyi -- copy limb vector, incrementing.
+dnl 
+dnl  K6-2: 0.56 or 1.0 cycles/limb (at 32 limbs/loop), depending on data
+dnl  alignment.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K6-2 aligned:
+dnl  UNROLL_COUNT cycles/limb
+dnl        8          0.75
+dnl       16          0.625
+dnl       32          0.5625
+dnl       64          0.53
+dnl  Maximum possible with the current code is 64, the minimum is 2.
+
+deflit(UNROLL_COUNT, 32)
+
+
+C void mpn_copyi (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C The MMX loop is faster than a rep movs when src and dst are both 0mod8.
+C With one 0mod8 and one 4mod8 it's 1.056 c/l and the rep movs at 1.0 c/l is
+C used instead.
+C
+C         mod8
+C	src  dst
+C	 0    0	   both aligned, use mmx
+C	 0    4    unaligned, use rep movs
+C	 4    0    unaligned, use rep movs
+C	 4    4    do one movs, then both aligned, use mmx
+C
+C The MMX code on aligned data is 0.5 c/l, plus loop overhead of 2
+C cycles/loop, which is 0.0625 c/l at 32 limbs/loop.
+C
+C A pattern of two movq loads and two movq stores (or four and four) was
+C tried, but found to be the same speed as just one of each.
+C
+C Note that this code only suits K6-2 and K6-3.  Plain K6 does only one mmx
+C instruction per cycle, so "movq"s are no faster than the simple 1 c/l rep
+C movs.
+C
+C Enhancement:
+C
+C Addressing modes like disp(%esi,%ecx,4) aren't currently used.  They'd
+C make it possible to avoid incrementing %esi and %edi in the loop and hence
+C get loop overhead down to 1 cycle.  Care would be needed to avoid bad
+C cache line crossings since the "movq"s would then be 5 code bytes rather
+C than 4.
+
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+deflit(`FRAME',0)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_copyi)
+	movl	PARAM_SIZE, %ecx
+	movl	%esi, %eax
+
+	movl	PARAM_SRC, %esi
+	movl	%edi, %edx
+
+	cld
+
+	movl	PARAM_DST, %edi
+	cmpl	$UNROLL_COUNT, %ecx
+
+	ja	L(unroll)
+
+L(simple):
+	rep
+	movsl
+
+	movl	%eax, %esi
+	movl	%edx, %edi
+
+	ret
+
+
+L(unroll):
+	C if src and dst are different alignments mod8, then use rep movs
+	C if src and dst are both 4mod8 then process one limb to get 0mod8
+
+	pushl	%ebx
+	leal	(%esi,%edi), %ebx
+
+	testb	$4, %bl
+	popl	%ebx
+	
+	jnz	L(simple)
+	testl	$4, %esi
+
+	leal	-UNROLL_COUNT(%ecx), %ecx
+	jz	L(already_aligned)
+
+	decl	%ecx
+
+	movsl
+L(already_aligned):
+
+
+ifelse(UNROLL_BYTES,256,`
+	addl	$128, %esi
+	addl	$128, %edi
+')
+
+	C this is offset 0x34, no alignment needed
+L(top):
+	C eax	saved esi
+	C ebx
+	C ecx	counter, limbs
+	C edx	saved edi
+	C esi	src, incrementing
+	C edi	dst, incrementing
+	C ebp
+	C
+	C Zdisp gets 0(%esi) left that way to avoid vector decode, and with
+	C 0(%edi) keeps code aligned to 16 byte boundaries.
+
+deflit(CHUNK_COUNT, 2)
+forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
+	deflit(`disp', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
+Zdisp(	movq,	disp,(%esi), %mm0)
+Zdisp(	movq,	%mm0, disp,(%edi))
+')
+
+	addl	$UNROLL_BYTES, %esi
+	subl	$UNROLL_COUNT, %ecx
+
+	leal	UNROLL_BYTES(%edi), %edi
+	jns	L(top)
+
+
+	C now %ecx is -UNROLL_COUNT to -1 representing repectively 0 to
+	C UNROLL_COUNT-1 limbs remaining
+
+	testb	$eval(UNROLL_COUNT/2), %cl
+
+	leal	UNROLL_COUNT(%ecx), %ecx
+	jz	L(not_half)
+
+	C at an unroll count of 32 this block of code is 16 cycles faster than
+	C the rep movs, less 3 or 4 to test whether to do it
+
+forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT/2-1, `
+	deflit(`disp', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
+	movq	disp(%esi), %mm0
+	movq	%mm0, disp(%edi)
+')
+	addl	$eval(UNROLL_BYTES/2), %esi
+	addl	$eval(UNROLL_BYTES/2), %edi
+
+	subl	$eval(UNROLL_COUNT/2), %ecx
+L(not_half):
+
+
+ifelse(UNROLL_BYTES,256,`
+	subl	$128, %esi
+	subl	$128, %edi
+')
+
+	rep
+	movsl
+
+	movl	%eax, %esi
+	movl	%edx, %edi
+
+	femms
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/k62mmx/lshift.asm b/src/gmp/mpn/x86/k6/k62mmx/lshift.asm
new file mode 100644
index 000000000..f6d54f97a
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/k62mmx/lshift.asm
@@ -0,0 +1,286 @@
+dnl  AMD K6-2 mpn_lshift -- mpn left shift.
+dnl 
+dnl  K6-2: 1.75 cycles/limb
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+deflit(`FRAME',0)
+
+dnl  used after src has been fetched
+define(VAR_RETVAL,`PARAM_SRC')
+
+dnl  minimum 9, because unrolled loop can't handle less
+deflit(UNROLL_THRESHOLD, 9)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_lshift)
+deflit(`FRAME',0)
+
+	C The 1 limb case can be done without the push %ebx, but it's then
+	C still the same speed.  The push is left as a free helping hand for
+	C the two_or_more code.
+
+	movl	PARAM_SIZE, %eax
+	pushl	%ebx			FRAME_pushl()
+
+	movl	PARAM_SRC, %ebx
+	decl	%eax
+
+	movl	PARAM_SHIFT, %ecx
+	jnz	L(two_or_more)
+
+	movl	(%ebx), %edx		C src limb
+	movl	PARAM_DST, %ebx
+
+	shldl(	%cl, %edx, %eax)	C return value
+
+ 	shll	%cl, %edx
+
+	movl	%edx, (%ebx)		C dst limb
+	popl	%ebx
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)	C avoid offset 0x1f
+L(two_or_more):
+	C eax	size-1
+	C ebx	src
+	C ecx	shift
+	C edx
+
+	movl	(%ebx,%eax,4), %edx	C src high limb
+	negl	%ecx
+
+	movd	PARAM_SHIFT, %mm6
+	addl	$32, %ecx		C 32-shift
+
+	shrl	%cl, %edx
+	cmpl	$UNROLL_THRESHOLD-1, %eax
+
+	movl	%edx, VAR_RETVAL
+	jae	L(unroll)
+
+
+	movd	%ecx, %mm7
+	movl	%eax, %ecx
+
+	movl	PARAM_DST, %eax
+
+L(simple):
+	C eax	dst
+	C ebx	src
+	C ecx	counter, size-1 to 1
+	C edx	retval
+	C
+	C mm0	scratch
+	C mm6	shift
+	C mm7	32-shift
+
+	movq	-4(%ebx,%ecx,4), %mm0
+
+ 	psrlq	%mm7, %mm0
+
+Zdisp(	movd,	%mm0, 0,(%eax,%ecx,4))
+	loop	L(simple)
+
+
+	movd	(%ebx), %mm0
+	popl	%ebx
+
+ 	psllq	%mm6, %mm0
+
+	movd	%mm0, (%eax)
+	movl	%edx, %eax
+
+	femms
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(unroll):
+	C eax	size-1
+	C ebx	src
+	C ecx	32-shift
+	C edx	retval (but instead VAR_RETVAL is used)
+	C
+	C mm6	shift
+
+	addl	$32, %ecx
+	movl	PARAM_DST, %edx
+
+	movd	%ecx, %mm7
+	subl	$7, %eax			C size-8
+
+	leal	(%edx,%eax,4), %ecx		C alignment of dst
+
+	movq	32-8(%ebx,%eax,4), %mm2		C src high qword
+	testb	$4, %cl
+
+	jz	L(dst_aligned)
+	psllq	%mm6, %mm2
+
+	psrlq	$32, %mm2
+	decl	%eax
+
+	movd	%mm2, 32(%edx,%eax,4)		C dst high limb
+	movq	32-8(%ebx,%eax,4), %mm2		C new src high qword
+L(dst_aligned):
+
+	movq	32-16(%ebx,%eax,4), %mm0	C src second highest qword
+
+
+	C This loop is the important bit, the rest is just support for it.
+	C Four src limbs are held at the start, and four more will be read.
+	C Four dst limbs will be written.  This schedule seems necessary for
+	C full speed.
+	C
+	C The use of size-8 lets the loop stop when %eax goes negative and
+	C leaves -4 to -1 which can be tested with test $1 and $2.
+
+L(top):
+	C eax	counter, size-8 step by -4 until <0
+	C ebx	src
+	C ecx
+	C edx	dst
+	C
+	C mm0	src next qword
+	C mm1	scratch
+	C mm2	src prev qword
+	C mm6	shift
+	C mm7	64-shift
+
+	psllq	%mm6, %mm2
+	subl	$4, %eax
+
+	movq	%mm0, %mm1
+	psrlq	%mm7, %mm0
+
+	por	%mm0, %mm2
+	movq	24(%ebx,%eax,4), %mm0
+
+	psllq	%mm6, %mm1
+	movq	%mm2, 40(%edx,%eax,4)
+
+	movq	%mm0, %mm2
+	psrlq	%mm7, %mm0
+
+	por	%mm0, %mm1
+	movq	16(%ebx,%eax,4), %mm0
+
+	movq	%mm1, 32(%edx,%eax,4)
+	jnc	L(top)
+
+
+	C Now have four limbs in mm2 (prev) and mm0 (next), plus eax mod 4.
+	C
+	C 8(%ebx) is the next source, and 24(%edx) is the next destination.
+	C %eax is between -4 and -1, representing respectively 0 to 3 extra
+	C limbs that must be read.
+
+
+	testl	$2, %eax	C testl to avoid bad cache line crossing
+	jz	L(finish_nottwo)
+
+	C Two more limbs: lshift mm2, OR it with rshifted mm0, mm0 becomes
+	C new mm2 and a new mm0 is loaded.
+
+	psllq	%mm6, %mm2
+	movq	%mm0, %mm1
+
+	psrlq	%mm7, %mm0
+	subl	$2, %eax
+
+	por	%mm0, %mm2
+	movq	16(%ebx,%eax,4), %mm0
+
+	movq	%mm2, 32(%edx,%eax,4)
+	movq	%mm1, %mm2
+L(finish_nottwo):
+
+
+	C lshift mm2, OR with rshifted mm0, mm1 becomes lshifted mm0
+
+	testb	$1, %al
+	psllq	%mm6, %mm2
+
+	movq	%mm0, %mm1
+	psrlq	%mm7, %mm0
+
+	por	%mm0, %mm2
+	psllq	%mm6, %mm1
+
+	movq	%mm2, 24(%edx,%eax,4)
+	jz	L(finish_even)
+
+
+	C Size is odd, so mm1 and one extra limb to process.
+
+	movd	(%ebx), %mm0		C src[0]
+	popl	%ebx
+deflit(`FRAME',0)
+
+	movq	%mm0, %mm2
+	psllq	$32, %mm0
+
+	psrlq	%mm7, %mm0
+
+	psllq	%mm6, %mm2
+	por	%mm0, %mm1
+
+	movq	%mm1, 4(%edx)		C dst[1,2]
+	movd	%mm2, (%edx)		C dst[0]
+
+	movl	VAR_RETVAL, %eax
+
+	femms
+	ret
+
+
+	nop	C avoid bad cache line crossing
+L(finish_even):
+deflit(`FRAME',4)
+	C Size is even, so only mm1 left to process.
+
+	movq	%mm1, (%edx)		C dst[0,1]
+	movl	VAR_RETVAL, %eax
+
+	popl	%ebx
+	femms
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/k62mmx/rshift.asm b/src/gmp/mpn/x86/k6/k62mmx/rshift.asm
new file mode 100644
index 000000000..8a8c14424
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/k62mmx/rshift.asm
@@ -0,0 +1,285 @@
+dnl  AMD K6-2 mpn_rshift -- mpn right shift.
+dnl 
+dnl  K6-2: 1.75 cycles/limb
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+deflit(`FRAME',0)
+
+dnl  Minimum 9, because the unrolled loop can't handle less.
+dnl
+deflit(UNROLL_THRESHOLD, 9)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_rshift)
+deflit(`FRAME',0)
+
+	C The 1 limb case can be done without the push %ebx, but it's then
+	C still the same speed.  The push is left as a free helping hand for
+	C the two_or_more code.
+
+	movl	PARAM_SIZE, %eax
+	pushl	%ebx			FRAME_pushl()
+
+	movl	PARAM_SRC, %ebx
+	decl	%eax
+
+	movl	PARAM_SHIFT, %ecx
+	jnz	L(two_or_more)
+
+	movl	(%ebx), %edx		C src limb
+	movl	PARAM_DST, %ebx
+
+	shrdl(	%cl, %edx, %eax)	C return value
+
+ 	shrl	%cl, %edx
+
+	movl	%edx, (%ebx)		C dst limb
+	popl	%ebx
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)	C avoid offset 0x1f
+L(two_or_more):
+	C eax	size-1
+	C ebx	src
+	C ecx	shift
+	C edx
+
+	movl	(%ebx), %edx	C src low limb
+	negl	%ecx
+
+	addl	$32, %ecx
+	movd	PARAM_SHIFT, %mm6
+
+	shll	%cl, %edx
+	cmpl	$UNROLL_THRESHOLD-1, %eax
+
+	jae	L(unroll)
+
+
+	C eax	size-1
+	C ebx	src
+	C ecx	32-shift
+	C edx	retval
+	C
+	C mm6	shift
+
+	movl	PARAM_DST, %ecx
+	leal	(%ebx,%eax,4), %ebx
+
+	leal	-4(%ecx,%eax,4), %ecx
+	negl	%eax
+
+	C This loop runs at about 3 cycles/limb, which is the amount of
+	C decoding, and this is despite every second access being unaligned.
+
+L(simple):
+	C eax	counter, -(size-1) to -1
+	C ebx	&src[size-1]
+	C ecx	&dst[size-1]
+	C edx	retval
+	C
+	C mm0	scratch
+	C mm6	shift
+
+Zdisp(	movq,	0,(%ebx,%eax,4), %mm0)
+	incl	%eax
+
+ 	psrlq	%mm6, %mm0
+
+Zdisp(	movd,	%mm0, 0,(%ecx,%eax,4))
+	jnz	L(simple)
+
+
+	movq	%mm0, (%ecx)
+	movl	%edx, %eax
+
+	popl	%ebx
+
+	femms
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)	
+L(unroll):
+	C eax	size-1
+	C ebx	src
+	C ecx	32-shift
+	C edx	retval
+	C
+	C mm6	shift
+
+	addl	$32, %ecx
+	subl	$7, %eax		C size-8
+
+	movd	%ecx, %mm7
+	movl	PARAM_DST, %ecx
+
+	movq	(%ebx), %mm2		C src low qword
+	leal	(%ebx,%eax,4), %ebx	C src end - 32
+
+	testb	$4, %cl
+	leal	(%ecx,%eax,4), %ecx	C dst end - 32
+
+	notl	%eax			C -(size-7)
+	jz	L(dst_aligned)
+
+	psrlq	%mm6, %mm2
+	incl	%eax
+
+Zdisp(	movd,	%mm2, 0,(%ecx,%eax,4))	C dst low limb
+	movq	4(%ebx,%eax,4), %mm2	C new src low qword
+L(dst_aligned):
+
+	movq	12(%ebx,%eax,4), %mm0	C src second lowest qword
+	nop 	C avoid bad cache line crossing
+
+
+	C This loop is the important bit, the rest is just support for it.
+	C Four src limbs are held at the start, and four more will be read.
+	C Four dst limbs will be written.  This schedule seems necessary for
+	C full speed.
+	C
+	C The use of -(size-7) lets the loop stop when %eax becomes >= 0 and
+	C and leaves 0 to 3 which can be tested with test $1 and $2.
+
+L(top):
+	C eax	counter, -(size-7) step by +4 until >=0
+	C ebx	src end - 32
+	C ecx	dst end - 32
+	C edx	retval
+	C
+	C mm0	src next qword
+	C mm1	scratch
+	C mm2	src prev qword
+	C mm6	shift
+	C mm7	64-shift
+
+	psrlq	%mm6, %mm2
+	addl	$4, %eax
+
+	movq	%mm0, %mm1
+	psllq	%mm7, %mm0
+
+	por	%mm0, %mm2
+	movq	4(%ebx,%eax,4), %mm0
+
+	psrlq	%mm6, %mm1
+	movq	%mm2, -12(%ecx,%eax,4)
+
+	movq	%mm0, %mm2
+	psllq	%mm7, %mm0
+
+	por	%mm0, %mm1
+	movq	12(%ebx,%eax,4), %mm0
+
+	movq	%mm1, -4(%ecx,%eax,4)
+	ja	L(top)		C jump if no carry and not zero
+
+
+
+	C Now have the four limbs in mm2 (low) and mm0 (high), and %eax is 0
+	C to 3 representing respectively 3 to 0 further limbs.
+
+	testl	$2, %eax	C testl to avoid bad cache line crossings
+	jnz	L(finish_nottwo)
+
+	C Two or three extra limbs: rshift mm2, OR it with lshifted mm0, mm0
+	C becomes new mm2 and a new mm0 is loaded.
+
+	psrlq	%mm6, %mm2
+	movq	%mm0, %mm1
+
+	psllq	%mm7, %mm0
+	addl	$2, %eax
+
+	por	%mm0, %mm2
+	movq	12(%ebx,%eax,4), %mm0
+
+	movq	%mm2, -4(%ecx,%eax,4)
+	movq	%mm1, %mm2
+L(finish_nottwo):
+
+
+	testb	$1, %al
+	psrlq	%mm6, %mm2
+
+	movq	%mm0, %mm1
+	psllq	%mm7, %mm0
+
+	por	%mm0, %mm2
+	psrlq	%mm6, %mm1
+
+	movq	%mm2, 4(%ecx,%eax,4)
+	jnz	L(finish_even)
+
+
+	C one further extra limb to process
+
+	movd	32-4(%ebx), %mm0	C src[size-1], most significant limb
+	popl	%ebx
+
+	movq	%mm0, %mm2
+	psllq	%mm7, %mm0
+
+	por	%mm0, %mm1
+	psrlq	%mm6, %mm2
+
+	movq	%mm1, 32-12(%ecx)	C dst[size-3,size-2]
+	movd	%mm2, 32-4(%ecx)	C dst[size-1]
+
+	movl	%edx, %eax		C retval
+
+	femms
+	ret
+
+
+	nop	C avoid bad cache line crossing
+L(finish_even):
+	C no further extra limbs
+
+	movq	%mm1, 32-8(%ecx)	C dst[size-2,size-1]
+	movl	%edx, %eax		C retval
+
+	popl	%ebx
+
+	femms
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/mmx/com_n.asm b/src/gmp/mpn/x86/k6/mmx/com_n.asm
new file mode 100644
index 000000000..8915080f0
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/mmx/com_n.asm
@@ -0,0 +1,91 @@
+dnl  AMD K6-2 mpn_com_n -- mpn bitwise one's complement.
+dnl   
+dnl     alignment dst/src, A=0mod8 N=4mod8
+dnl        A/A   A/N   N/A   N/N
+dnl  K6-2  1.0   1.18  1.18  1.18  cycles/limb
+dnl  K6    1.5   1.85  1.75  1.85
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C void mpn_com_n (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C Take the bitwise ones-complement of src,size and write it to dst,size.
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+
+	.text
+	ALIGN(32)
+PROLOGUE(mpn_com_n)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	movl	PARAM_SRC, %eax
+	movl	PARAM_DST, %edx
+	shrl	%ecx
+	jnz	L(two_or_more)
+
+	movl	(%eax), %eax
+	notl	%eax
+	movl	%eax, (%edx)
+	ret
+
+
+L(two_or_more):
+	pushl	%ebx
+FRAME_pushl()
+	movl	%ecx, %ebx
+
+	pcmpeqd	%mm7, %mm7	C all ones
+
+
+	ALIGN(16)
+L(top):
+	C eax	src
+	C ebx	floor(size/2)
+	C ecx	counter
+	C edx	dst
+	C esi
+	C edi
+	C ebp
+
+	movq	-8(%eax,%ecx,8), %mm0
+	pxor	%mm7, %mm0
+	movq	%mm0, -8(%edx,%ecx,8)
+	loop	L(top)
+
+
+	jnc	L(no_extra)
+	movl	(%eax,%ebx,8), %eax
+	notl	%eax
+	movl	%eax, (%edx,%ebx,8)
+L(no_extra):
+
+	popl	%ebx
+	emms_or_femms
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/mmx/logops_n.asm b/src/gmp/mpn/x86/k6/mmx/logops_n.asm
new file mode 100644
index 000000000..46cb3b7ea
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/mmx/logops_n.asm
@@ -0,0 +1,212 @@
+dnl  AMD K6-2 mpn_and_n, mpn_andn_n, mpn_nand_n, mpn_ior_n, mpn_iorn_n,
+dnl  mpn_nior_n, mpn_xor_n, mpn_xnor_n -- mpn bitwise logical operations.
+dnl   
+dnl          alignment dst/src1/src2, A=0mod8, N=4mod8
+dnl       A/A/A A/A/N A/N/A A/N/N N/A/A N/A/N N/N/A N/N/N
+dnl 
+dnl  K6-2  1.2   1.5   1.5   1.2   1.2   1.5   1.5   1.2   and,andn,ior,xor
+dnl  K6-2  1.5   1.75  2.0   1.75  1.75  2.0   1.75  1.5   iorn,xnor
+dnl  K6-2  1.75  2.0   2.0   2.0   2.0   2.0   2.0   1.75  nand,nior
+dnl
+dnl  K6    1.5   1.68  1.75  1.2   1.75  1.75  1.68  1.5   and,andn,ior,xor
+dnl  K6    2.0   2.0   2.25  2.25  2.25  2.25  2.0   2.0   iorn,xnor
+dnl  K6    2.0   2.25  2.25  2.25  2.25  2.25  2.25  2.0   nand,nior
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  M4_p and M4_i are the MMX and integer instructions
+dnl  M4_*_neg_dst means whether to negate the final result before writing
+dnl  M4_*_neg_src2 means whether to negate the src2 values before using them
+
+define(M4_choose_op,
+m4_assert_numargs(7)
+`ifdef(`OPERATION_$1',`
+define(`M4_function',  `mpn_$1')
+define(`M4_operation', `$1')
+define(`M4_p',         `$2')
+define(`M4_p_neg_dst', `$3')
+define(`M4_p_neg_src2',`$4')
+define(`M4_i',         `$5')
+define(`M4_i_neg_dst', `$6')
+define(`M4_i_neg_src2',`$7')
+')')
+
+dnl  xnor is done in "iorn" style because it's a touch faster than "nior"
+dnl  style (the two are equivalent for xor).
+
+M4_choose_op( and_n,  pand,0,0,  andl,0,0)
+M4_choose_op( andn_n, pandn,0,0, andl,0,1)
+M4_choose_op( nand_n, pand,1,0,  andl,1,0)
+M4_choose_op( ior_n,  por,0,0,   orl,0,0)
+M4_choose_op( iorn_n, por,0,1,   orl,0,1)
+M4_choose_op( nior_n, por,1,0,   orl,1,0)
+M4_choose_op( xor_n,  pxor,0,0,  xorl,0,0)
+M4_choose_op( xnor_n, pxor,0,1,  xorl,0,1)
+
+ifdef(`M4_function',,
+`m4_error(`Unrecognised or undefined OPERATION symbol
+')')
+
+MULFUNC_PROLOGUE(mpn_and_n mpn_andn_n mpn_nand_n mpn_ior_n mpn_iorn_n mpn_nior_n mpn_xor_n mpn_xnor_n)
+
+
+C void M4_function (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
+C                   mp_size_t size);
+C
+C Do src1,size M4_operation src2,size, storing the result in dst,size.
+C
+C Unaligned movq loads and stores are a bit slower than aligned ones.  The
+C test at the start of the routine checks the alignment of src1 and if
+C necessary processes one limb separately at the low end to make it aligned.
+C
+C The raw speeds without this alignment switch are as follows.
+C
+C           alignment dst/src1/src2, A=0mod8, N=4mod8
+C     A/A/A  A/A/N  A/N/A  A/N/N  N/A/A  N/A/N  N/N/A  N/N/N
+C
+C K6                 1.5    2.0                 1.5    2.0    and,andn,ior,xor
+C K6                 1.75   2.2                 2.0    2.28   iorn,xnor
+C K6                 2.0    2.25                2.35   2.28   nand,nior
+C
+C
+C Future:
+C
+C K6 can do one 64-bit load per cycle so each of these routines should be
+C able to approach 1.0 c/l, if aligned.  The basic and/andn/ior/xor might be
+C able to get 1.0 with just a 4 limb loop, being 3 instructions per 2 limbs.
+C The others are 4 instructions per 2 limbs, and so can only approach 1.0
+C because there's nowhere to hide some loop control.
+
+defframe(PARAM_SIZE,16)
+defframe(PARAM_SRC2,12)
+defframe(PARAM_SRC1,8)
+defframe(PARAM_DST, 4)
+deflit(`FRAME',0)
+
+	.text
+	ALIGN(32)
+PROLOGUE(M4_function)
+			movl	PARAM_SIZE, %ecx
+			pushl	%ebx
+		FRAME_pushl()
+			movl	PARAM_SRC1, %eax
+			movl	PARAM_SRC2, %ebx
+			cmpl	$1, %ecx
+			movl	PARAM_DST, %edx
+			ja	L(two_or_more)
+
+
+			movl	(%ebx), %ecx
+			popl	%ebx
+ifelse(M4_i_neg_src2,1,`notl	%ecx')
+			M4_i	(%eax), %ecx
+ifelse(M4_i_neg_dst,1,`	notl	%ecx')
+			movl	%ecx, (%edx)
+
+			ret
+
+
+L(two_or_more):
+			C eax	src1
+			C ebx	src2
+			C ecx	size
+			C edx	dst
+			C esi
+			C edi
+			C ebp
+			C
+			C carry bit is low of size
+
+			pushl	%esi
+		FRAME_pushl()
+			testl	$4, %eax
+			jz	L(alignment_ok)
+
+			movl	(%ebx), %esi
+			addl	$4, %ebx
+ifelse(M4_i_neg_src2,1,`notl	%esi')
+			M4_i	(%eax), %esi
+			addl	$4, %eax
+ifelse(M4_i_neg_dst,1,`	notl	%esi')
+			movl	%esi, (%edx)
+			addl	$4, %edx
+			decl	%ecx
+
+L(alignment_ok):
+			movl	%ecx, %esi
+			shrl	%ecx
+			jnz	L(still_two_or_more)
+
+			movl	(%ebx), %ecx
+			popl	%esi
+ifelse(M4_i_neg_src2,1,`notl	%ecx')
+			M4_i	(%eax), %ecx
+ifelse(M4_i_neg_dst,1,`	notl	%ecx')
+			popl	%ebx
+			movl	%ecx, (%edx)
+			ret
+
+
+L(still_two_or_more):
+ifelse(eval(M4_p_neg_src2 || M4_p_neg_dst),1,`
+			pcmpeqd	%mm7, %mm7	C all ones
+')
+
+			ALIGN(16)
+L(top):
+			C eax	src1
+			C ebx	src2
+			C ecx	counter
+			C edx	dst
+			C esi
+			C edi
+			C ebp
+			C
+			C carry bit is low of size
+
+			movq	-8(%ebx,%ecx,8), %mm0
+ifelse(M4_p_neg_src2,1,`pxor	%mm7, %mm0')
+			M4_p	-8(%eax,%ecx,8), %mm0
+ifelse(M4_p_neg_dst,1,`	pxor	%mm7, %mm0')
+			movq	%mm0, -8(%edx,%ecx,8)
+
+			loop	L(top)
+
+
+			jnc	L(no_extra)
+
+			movl	-4(%ebx,%esi,4), %ebx
+ifelse(M4_i_neg_src2,1,`notl	%ebx')
+			M4_i	-4(%eax,%esi,4), %ebx
+ifelse(M4_i_neg_dst,1,`	notl	%ebx')
+			movl	%ebx, -4(%edx,%esi,4)
+L(no_extra):
+
+			popl	%esi
+			popl	%ebx
+			emms_or_femms
+			ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/mmx/lshift.asm b/src/gmp/mpn/x86/k6/mmx/lshift.asm
new file mode 100644
index 000000000..f1dc83db4
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/mmx/lshift.asm
@@ -0,0 +1,122 @@
+dnl  AMD K6 mpn_lshift -- mpn left shift.
+dnl 
+dnl  K6: 3.0 cycles/limb
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+C The loop runs at 3 cycles/limb, limited by decoding and by having 3 mmx
+C instructions.  This is despite every second fetch being unaligned.
+
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_lshift)
+deflit(`FRAME',0)
+
+	C The 1 limb case can be done without the push %ebx, but it's then
+	C still the same speed.  The push is left as a free helping hand for
+	C the two_or_more code.
+
+	movl	PARAM_SIZE, %eax
+	pushl	%ebx			FRAME_pushl()
+
+	movl	PARAM_SRC, %ebx
+	decl	%eax
+
+	movl	PARAM_SHIFT, %ecx
+	jnz	L(two_or_more)
+
+	movl	(%ebx), %edx		C src limb
+	movl	PARAM_DST, %ebx
+
+	shldl(	%cl, %edx, %eax)	C return value
+
+ 	shll	%cl, %edx
+
+	movl	%edx, (%ebx)		C dst limb
+	popl	%ebx
+
+	ret
+
+
+	ALIGN(16)	C avoid offset 0x1f
+	nop		C avoid bad cache line crossing
+L(two_or_more):
+	C eax	size-1
+	C ebx	src
+	C ecx	shift
+	C edx
+
+	movl	(%ebx,%eax,4), %edx	C src high limb
+	negl	%ecx
+
+	movd	PARAM_SHIFT, %mm6
+	addl	$32, %ecx		C 32-shift
+
+	shrl	%cl, %edx
+
+	movd	%ecx, %mm7
+	movl	PARAM_DST, %ecx
+
+L(top):
+	C eax	counter, size-1 to 1
+	C ebx	src
+	C ecx	dst
+	C edx	retval
+	C
+	C mm0	scratch
+	C mm6	shift
+	C mm7	32-shift
+
+	movq	-4(%ebx,%eax,4), %mm0
+	decl	%eax
+
+ 	psrlq	%mm7, %mm0
+
+	movd	%mm0, 4(%ecx,%eax,4)
+	jnz	L(top)
+
+
+	movd	(%ebx), %mm0
+	popl	%ebx
+
+ 	psllq	%mm6, %mm0
+	movl	%edx, %eax
+
+	movd	%mm0, (%ecx)
+
+	emms
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/mmx/popham.asm b/src/gmp/mpn/x86/k6/mmx/popham.asm
new file mode 100644
index 000000000..70efb806f
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/mmx/popham.asm
@@ -0,0 +1,238 @@
+dnl  AMD K6-2 mpn_popcount, mpn_hamdist -- mpn bit population count and
+dnl  hamming distance.
+dnl
+dnl         popcount  hamdist
+dnl  K6-2:    9.0       11.5   cycles/limb
+dnl  K6:      12.5      13.0
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C unsigned long mpn_popcount (mp_srcptr src, mp_size_t size);
+C unsigned long mpn_hamdist (mp_srcptr src, mp_srcptr src2, mp_size_t size);
+C
+C The code here isn't optimal, but it's already a 2x speedup over the plain
+C integer mpn/generic/popcount.c,hamdist.c.
+
+
+ifdef(`OPERATION_popcount',,
+`ifdef(`OPERATION_hamdist',,
+`m4_error(`Need OPERATION_popcount or OPERATION_hamdist
+')m4exit(1)')')
+
+define(HAM,
+m4_assert_numargs(1)
+`ifdef(`OPERATION_hamdist',`$1')')
+
+define(POP,
+m4_assert_numargs(1)
+`ifdef(`OPERATION_popcount',`$1')')
+
+HAM(`
+defframe(PARAM_SIZE,   12)
+defframe(PARAM_SRC2,   8)
+defframe(PARAM_SRC,    4)
+define(M4_function,mpn_hamdist)
+')
+POP(`
+defframe(PARAM_SIZE,   8)
+defframe(PARAM_SRC,    4)
+define(M4_function,mpn_popcount)
+')
+
+MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
+
+
+ifdef(`PIC',,`
+	dnl  non-PIC
+
+	.section .rodata
+	ALIGN(8)
+
+define(LS,
+m4_assert_numargs(1)
+`LF(M4_function,`$1')')
+
+LS(rodata_AAAAAAAAAAAAAAAA):
+	.long	0xAAAAAAAA
+	.long	0xAAAAAAAA
+
+LS(rodata_3333333333333333):
+	.long	0x33333333
+	.long	0x33333333
+
+LS(rodata_0F0F0F0F0F0F0F0F):
+	.long	0x0F0F0F0F
+	.long	0x0F0F0F0F
+
+LS(rodata_000000FF000000FF):
+	.long	0x000000FF
+	.long	0x000000FF
+')
+
+	.text
+	ALIGN(32)
+
+POP(`ifdef(`PIC', `
+	C avoid shrl crossing a 32-byte boundary
+	nop')')
+
+PROLOGUE(M4_function)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	orl	%ecx, %ecx
+	jz	L(zero)
+
+ifdef(`PIC',`
+	movl	$0xAAAAAAAA, %eax
+	movl	$0x33333333, %edx
+
+	movd	%eax, %mm7
+	movd	%edx, %mm6
+
+	movl	$0x0F0F0F0F, %eax
+	movl	$0x000000FF, %edx
+
+	punpckldq %mm7, %mm7
+	punpckldq %mm6, %mm6
+
+	movd	%eax, %mm5
+	movd	%edx, %mm4
+
+	punpckldq %mm5, %mm5
+	punpckldq %mm4, %mm4
+',`
+
+	movq	LS(rodata_AAAAAAAAAAAAAAAA), %mm7
+	movq	LS(rodata_3333333333333333), %mm6
+	movq	LS(rodata_0F0F0F0F0F0F0F0F), %mm5
+	movq	LS(rodata_000000FF000000FF), %mm4
+')
+
+define(REG_AAAAAAAAAAAAAAAA, %mm7)
+define(REG_3333333333333333, %mm6)
+define(REG_0F0F0F0F0F0F0F0F, %mm5)
+define(REG_000000FF000000FF, %mm4)
+
+
+	movl	PARAM_SRC, %eax
+HAM(`	movl	PARAM_SRC2, %edx')
+
+	pxor	%mm2, %mm2	C total
+
+	shrl	%ecx
+	jnc	L(top)
+
+Zdisp(	movd,	0,(%eax,%ecx,8), %mm1)
+
+HAM(`
+Zdisp(	movd,	0,(%edx,%ecx,8), %mm0)
+	pxor	%mm0, %mm1
+')
+
+	incl	%ecx
+	jmp	L(loaded)
+
+
+	ALIGN(16)
+POP(`	nop	C alignment to avoid crossing 32-byte boundaries')
+
+L(top):
+	C eax	src
+	C ebx
+	C ecx	counter, qwords, decrementing
+	C edx	[hamdist] src2
+	C
+	C mm0	(scratch)
+	C mm1	(scratch)
+	C mm2	total (low dword)
+	C mm3
+	C mm4	\
+	C mm5	| special constants
+	C mm6	|
+	C mm7	/
+
+	movq	-8(%eax,%ecx,8), %mm1
+HAM(`	pxor	-8(%edx,%ecx,8), %mm1')
+
+L(loaded):
+	movq	%mm1, %mm0
+	pand	REG_AAAAAAAAAAAAAAAA, %mm1
+
+	psrlq	$1, %mm1
+HAM(`	nop			C code alignment')
+
+	psubd	%mm1, %mm0	C bit pairs
+HAM(`	nop			C code alignment')
+
+
+	movq	%mm0, %mm1
+	psrlq	$2, %mm0
+
+	pand	REG_3333333333333333, %mm0
+	pand	REG_3333333333333333, %mm1
+
+	paddd	%mm1, %mm0	C nibbles
+
+
+	movq	%mm0, %mm1
+	psrlq	$4, %mm0
+
+	pand	REG_0F0F0F0F0F0F0F0F, %mm0
+	pand	REG_0F0F0F0F0F0F0F0F, %mm1
+
+	paddd	%mm1, %mm0	C bytes
+
+	movq	%mm0, %mm1
+	psrlq	$8, %mm0
+
+
+	paddb	%mm1, %mm0	C words
+
+
+	movq	%mm0, %mm1
+	psrlq	$16, %mm0
+
+	paddd	%mm1, %mm0	C dwords
+
+	pand	REG_000000FF000000FF, %mm0
+
+	paddd	%mm0, %mm2	C low to total
+	psrlq	$32, %mm0
+
+	paddd	%mm0, %mm2	C high to total
+	loop	L(top)
+
+
+
+	movd	%mm2, %eax
+	emms_or_femms
+	ret
+
+L(zero):
+	movl	$0, %eax
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/mmx/rshift.asm b/src/gmp/mpn/x86/k6/mmx/rshift.asm
new file mode 100644
index 000000000..cc5948f26
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/mmx/rshift.asm
@@ -0,0 +1,122 @@
+dnl  AMD K6 mpn_rshift -- mpn right shift.
+dnl 
+dnl  K6: 3.0 cycles/limb
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+C The loop runs at 3 cycles/limb, limited by decoding and by having 3 mmx
+C instructions.  This is despite every second fetch being unaligned.
+
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+deflit(`FRAME',0)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_rshift)
+deflit(`FRAME',0)
+
+	C The 1 limb case can be done without the push %ebx, but it's then
+	C still the same speed.  The push is left as a free helping hand for
+	C the two_or_more code.
+
+	movl	PARAM_SIZE, %eax
+	pushl	%ebx			FRAME_pushl()
+
+	movl	PARAM_SRC, %ebx
+	decl	%eax
+
+	movl	PARAM_SHIFT, %ecx
+	jnz	L(two_or_more)
+
+	movl	(%ebx), %edx		C src limb
+	movl	PARAM_DST, %ebx
+
+	shrdl(	%cl, %edx, %eax)	C return value
+
+ 	shrl	%cl, %edx
+
+	movl	%edx, (%ebx)		C dst limb
+	popl	%ebx
+
+	ret
+
+
+	ALIGN(16)	C avoid offset 0x1f
+L(two_or_more):
+	C eax	size-1
+	C ebx	src
+	C ecx	shift
+	C edx
+
+	movl	(%ebx), %edx	C src low limb
+	negl	%ecx
+
+	addl	$32, %ecx	C 32-shift
+	movd	PARAM_SHIFT, %mm6
+
+	shll	%cl, %edx	C retval
+	movl	PARAM_DST, %ecx
+
+	leal	(%ebx,%eax,4), %ebx
+
+	leal	-4(%ecx,%eax,4), %ecx
+	negl	%eax
+
+
+L(simple):
+	C eax	counter (negative)
+	C ebx	&src[size-1]
+	C ecx	&dst[size-1]
+	C edx	retval
+	C
+	C mm0	scratch
+	C mm6	shift
+
+Zdisp(	movq,	0,(%ebx,%eax,4), %mm0)
+	incl	%eax
+
+ 	psrlq	%mm6, %mm0
+
+Zdisp(	movd,	%mm0, 0,(%ecx,%eax,4))
+	jnz	L(simple)
+
+
+	movq	%mm0, (%ecx)
+	movl	%edx, %eax
+
+	popl	%ebx
+
+	emms
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/mul_1.asm b/src/gmp/mpn/x86/k6/mul_1.asm
new file mode 100644
index 000000000..c2220fe4c
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/mul_1.asm
@@ -0,0 +1,272 @@
+dnl  AMD K6 mpn_mul_1 -- mpn by limb multiply.
+dnl 
+dnl  K6: 6.25 cycles/limb.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_mul_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                      mp_limb_t multiplier);
+C mp_limb_t mpn_mul_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       mp_limb_t multiplier, mp_limb_t carry);
+C
+C Multiply src,size by mult and store the result in dst,size.
+C Return the carry limb from the top of the result.
+C
+C mpn_mul_1c() accepts an initial carry for the calculation, it's added into
+C the low limb of the result.
+
+defframe(PARAM_CARRY,     20)
+defframe(PARAM_MULTIPLIER,16)
+defframe(PARAM_SIZE,      12)
+defframe(PARAM_SRC,       8)
+defframe(PARAM_DST,       4)
+
+dnl  minimum 5 because the unrolled code can't handle less
+deflit(UNROLL_THRESHOLD, 5)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_mul_1c)
+	pushl	%esi
+deflit(`FRAME',4)
+	movl	PARAM_CARRY, %esi
+	jmp	LF(mpn_mul_1,start_nc)
+EPILOGUE()
+
+
+PROLOGUE(mpn_mul_1)
+	push	%esi
+deflit(`FRAME',4)
+	xorl	%esi, %esi	C initial carry
+
+L(start_nc):
+	mov	PARAM_SIZE, %ecx
+	push	%ebx
+FRAME_pushl()
+
+	movl	PARAM_SRC, %ebx
+	push	%edi
+FRAME_pushl()
+
+	movl	PARAM_DST, %edi
+	pushl	%ebp
+FRAME_pushl()
+
+	cmpl	$UNROLL_THRESHOLD, %ecx
+	movl	PARAM_MULTIPLIER, %ebp
+
+	jae	L(unroll)
+
+
+	C code offset 0x22 here, close enough to aligned
+L(simple):
+	C eax	scratch
+	C ebx	src
+	C ecx	counter
+	C edx	scratch
+	C esi	carry
+	C edi	dst
+	C ebp	multiplier
+	C
+	C this loop 8 cycles/limb
+
+	movl	(%ebx), %eax
+	addl	$4, %ebx
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, (%edi)
+	addl	$4, %edi
+
+	loop	L(simple)
+
+
+	popl	%ebp
+
+	popl	%edi
+	popl	%ebx
+
+	movl	%esi, %eax
+	popl	%esi
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+C The code for each limb is 6 cycles, with instruction decoding being the
+C limiting factor.  At 4 limbs/loop and 1 cycle/loop of overhead it's 6.25
+C cycles/limb in total.
+C
+C The secret ingredient to get 6.25 is to start the loop with the mul and
+C have the load/store pair at the end.  Rotating the load/store to the top
+C is an 0.5 c/l slowdown.  (Some address generation effect probably.)
+C
+C The whole unrolled loop fits nicely in exactly 80 bytes.
+
+
+	ALIGN(16)	C already aligned to 16 here actually
+L(unroll):
+	movl	(%ebx), %eax
+	leal	-16(%ebx,%ecx,4), %ebx
+
+	leal	-16(%edi,%ecx,4), %edi
+	subl	$4, %ecx
+
+	negl	%ecx
+
+
+	ALIGN(16)	C one byte nop for this alignment
+L(top):
+	C eax	scratch
+	C ebx	&src[size-4]
+	C ecx	counter
+	C edx	scratch
+	C esi	carry
+	C edi	&dst[size-4]
+	C ebp	multiplier
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, (%edi,%ecx,4)
+	movl	4(%ebx,%ecx,4), %eax
+
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, 4(%edi,%ecx,4)
+	movl	8(%ebx,%ecx,4), %eax
+
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, 8(%edi,%ecx,4)
+	movl	12(%ebx,%ecx,4), %eax
+
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, 12(%edi,%ecx,4)
+	movl	16(%ebx,%ecx,4), %eax
+
+
+	addl	$4, %ecx
+	js	L(top)
+
+
+
+	C eax	next src limb
+	C ebx	&src[size-4]
+	C ecx	0 to 3 representing respectively 4 to 1 further limbs
+	C edx
+	C esi	carry
+	C edi	&dst[size-4]
+
+	testb	$2, %cl
+	jnz	L(finish_not_two)
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, (%edi,%ecx,4)
+	movl	4(%ebx,%ecx,4), %eax
+
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, 4(%edi,%ecx,4)
+	movl	8(%ebx,%ecx,4), %eax
+
+	addl	$2, %ecx
+L(finish_not_two):
+
+
+	testb	$1, %cl
+	jnz	L(finish_not_one)
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, 8(%edi)
+	movl	12(%ebx), %eax
+L(finish_not_one):
+
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	popl	%ebp
+
+	adcl	$0, %edx
+
+	movl	%eax, 12(%edi)
+	popl	%edi
+
+	popl	%ebx
+	movl	%edx, %eax
+
+	popl	%esi
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/mul_basecase.asm b/src/gmp/mpn/x86/k6/mul_basecase.asm
new file mode 100644
index 000000000..1f5a3a4b4
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/mul_basecase.asm
@@ -0,0 +1,600 @@
+dnl  AMD K6 mpn_mul_basecase -- multiply two mpn numbers.
+dnl 
+dnl  K6: approx 9.0 cycles per cross product on 30x30 limbs (with 16 limbs/loop
+dnl      unrolling).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K6: UNROLL_COUNT cycles/product (approx)
+dnl           8           9.75
+dnl          16           9.3
+dnl          32           9.3
+dnl  Maximum possible with the current code is 32.
+dnl
+dnl  With 16 the inner unrolled loop fits exactly in a 256 byte block, which
+dnl  might explain it's good performance.
+
+deflit(UNROLL_COUNT, 16)
+
+
+C void mpn_mul_basecase (mp_ptr wp,
+C                        mp_srcptr xp, mp_size_t xsize,
+C                        mp_srcptr yp, mp_size_t ysize);
+C
+C Calculate xp,xsize multiplied by yp,ysize, storing the result in
+C wp,xsize+ysize.
+C
+C This routine is essentially the same as mpn/generic/mul_basecase.c, but
+C it's faster because it does most of the mpn_addmul_1() entry code only
+C once.  The saving is about 10-20% on typical sizes coming from the
+C Karatsuba multiply code.
+C
+C Future:
+C
+C The unrolled loop could be shared by mpn_addmul_1, with some extra stack
+C setups and maybe 2 or 3 wasted cycles at the end.  Code saving would be
+C 256 bytes.
+
+ifdef(`PIC',`
+deflit(UNROLL_THRESHOLD, 8)
+',`
+deflit(UNROLL_THRESHOLD, 8)
+')
+
+defframe(PARAM_YSIZE,20)
+defframe(PARAM_YP,   16)
+defframe(PARAM_XSIZE,12)
+defframe(PARAM_XP,   8)
+defframe(PARAM_WP,   4)
+
+	.text
+	ALIGN(32)
+PROLOGUE(mpn_mul_basecase)
+deflit(`FRAME',0)
+
+	movl	PARAM_XSIZE, %ecx
+	movl	PARAM_YP, %eax
+
+	movl	PARAM_XP, %edx
+	movl	(%eax), %eax	C yp low limb
+
+	cmpl	$2, %ecx
+	ja	L(xsize_more_than_two_limbs)
+	je	L(two_by_something)
+
+
+	C one limb by one limb
+
+	movl	(%edx), %edx	C xp low limb
+	movl	PARAM_WP, %ecx
+	
+	mull	%edx
+
+	movl	%eax, (%ecx)
+	movl	%edx, 4(%ecx)
+	ret
+
+
+C -----------------------------------------------------------------------------
+L(two_by_something):
+	decl	PARAM_YSIZE
+	pushl	%ebx
+deflit(`FRAME',4)
+
+	movl	PARAM_WP, %ebx
+	pushl	%esi
+deflit(`FRAME',8)
+
+	movl	%eax, %ecx	C yp low limb
+	movl	(%edx), %eax	C xp low limb	
+
+	movl	%edx, %esi	C xp
+	jnz	L(two_by_two)
+
+
+	C two limbs by one limb
+
+	mull	%ecx	
+
+	movl	%eax, (%ebx)
+	movl	4(%esi), %eax
+
+	movl	%edx, %esi	C carry
+
+	mull	%ecx
+
+	addl	%eax, %esi
+	movl	%esi, 4(%ebx)
+
+	adcl	$0, %edx
+
+	movl	%edx, 8(%ebx)
+	popl	%esi
+
+	popl	%ebx
+	ret
+	
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(two_by_two):
+	C eax	xp low limb
+	C ebx	wp
+	C ecx	yp low limb
+	C edx
+	C esi	xp
+	C edi
+	C ebp
+deflit(`FRAME',8)
+
+	mull	%ecx		C xp[0] * yp[0]
+
+	push	%edi
+deflit(`FRAME',12)
+	movl	%eax, (%ebx)
+
+	movl	4(%esi), %eax
+	movl	%edx, %edi	C carry, for wp[1]
+
+	mull	%ecx		C xp[1] * yp[0]
+
+	addl	%eax, %edi
+	movl	PARAM_YP, %ecx
+
+	adcl	$0, %edx
+
+	movl	%edi, 4(%ebx)
+	movl	4(%ecx), %ecx	C yp[1]
+
+	movl	4(%esi), %eax	C xp[1]
+	movl	%edx, %edi	C carry, for wp[2]
+
+	mull	%ecx		C xp[1] * yp[1]
+
+	addl	%eax, %edi
+
+	adcl	$0, %edx
+
+	movl	(%esi), %eax	C xp[0]
+	movl	%edx, %esi	C carry, for wp[3]
+
+	mull	%ecx		C xp[0] * yp[1]
+
+	addl	%eax, 4(%ebx)
+	adcl	%edx, %edi
+	adcl	$0, %esi
+
+	movl	%edi, 8(%ebx)
+	popl	%edi
+
+	movl	%esi, 12(%ebx)
+	popl	%esi
+
+	popl	%ebx
+	ret
+
+	
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(xsize_more_than_two_limbs):
+
+C The first limb of yp is processed with a simple mpn_mul_1 style loop
+C inline.  Unrolling this doesn't seem worthwhile since it's only run once
+C (whereas the addmul below is run ysize-1 many times).  A call to the
+C actual mpn_mul_1 will be slowed down by the call and parameter pushing and
+C popping, and doesn't seem likely to be worthwhile on the typical 10-20
+C limb operations the Karatsuba code calls here with.
+
+	C eax	yp[0]
+	C ebx
+	C ecx	xsize
+	C edx	xp
+	C esi
+	C edi
+	C ebp
+deflit(`FRAME',0)
+
+	pushl	%edi		defframe_pushl(SAVE_EDI)
+	pushl	%ebp		defframe_pushl(SAVE_EBP)
+
+	movl	PARAM_WP, %edi
+	pushl	%esi		defframe_pushl(SAVE_ESI)
+
+	movl	%eax, %ebp
+	pushl	%ebx		defframe_pushl(SAVE_EBX)
+
+	leal	(%edx,%ecx,4), %ebx	C xp end
+	xorl	%esi, %esi
+
+	leal	(%edi,%ecx,4), %edi	C wp end of mul1
+	negl	%ecx
+
+
+L(mul1):
+	C eax	scratch
+	C ebx	xp end
+	C ecx	counter, negative
+	C edx	scratch
+	C esi	carry
+	C edi	wp end of mul1
+	C ebp	multiplier
+
+	movl	(%ebx,%ecx,4), %eax
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, (%edi,%ecx,4)
+	incl	%ecx
+
+	jnz	L(mul1)
+
+
+	movl	PARAM_YSIZE, %edx
+	movl	%esi, (%edi)		C final carry
+
+	movl	PARAM_XSIZE, %ecx
+	decl	%edx
+
+	jnz	L(ysize_more_than_one_limb)
+
+	popl	%ebx
+	popl	%esi
+	popl	%ebp
+	popl	%edi
+	ret
+
+
+L(ysize_more_than_one_limb):
+	cmpl	$UNROLL_THRESHOLD, %ecx
+	movl	PARAM_YP, %eax
+
+	jae	L(unroll)
+
+
+C -----------------------------------------------------------------------------
+C Simple addmul loop.
+C
+C Using ebx and edi pointing at the ends of their respective locations saves
+C a couple of instructions in the outer loop.  The inner loop is still 11
+C cycles, the same as the simple loop in aorsmul_1.asm.
+
+	C eax	yp
+	C ebx	xp end
+	C ecx	xsize
+	C edx	ysize-1
+	C esi
+	C edi	wp end of mul1
+	C ebp
+
+	movl	4(%eax), %ebp		C multiplier
+	negl	%ecx
+
+	movl	%ecx, PARAM_XSIZE	C -xsize
+	xorl	%esi, %esi		C initial carry
+
+	leal	4(%eax,%edx,4), %eax	C yp end
+	negl	%edx
+
+	movl	%eax, PARAM_YP
+	movl	%edx, PARAM_YSIZE
+
+	jmp	L(simple_outer_entry)
+
+
+	C aligning here saves a couple of cycles
+	ALIGN(16)
+L(simple_outer_top):	
+	C edx	ysize counter, negative
+
+	movl	PARAM_YP, %eax		C yp end
+	xorl	%esi, %esi		C carry
+
+	movl	PARAM_XSIZE, %ecx	C -xsize
+	movl	%edx, PARAM_YSIZE
+
+	movl	(%eax,%edx,4), %ebp	C yp limb multiplier
+L(simple_outer_entry):
+	addl	$4, %edi
+
+
+L(simple_inner):
+	C eax	scratch
+	C ebx	xp end
+	C ecx	counter, negative
+	C edx	scratch
+	C esi	carry
+	C edi	wp end of this addmul
+	C ebp	multiplier
+
+	movl	(%ebx,%ecx,4), %eax
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	$0, %edx
+	addl	%eax, (%edi,%ecx,4)
+	adcl	%edx, %esi
+
+	incl	%ecx
+	jnz	L(simple_inner)
+
+
+	movl	PARAM_YSIZE, %edx
+	movl	%esi, (%edi)
+
+	incl	%edx
+	jnz	L(simple_outer_top)
+
+
+	popl	%ebx
+	popl	%esi
+	popl	%ebp
+	popl	%edi
+	ret
+
+
+C -----------------------------------------------------------------------------
+C Unrolled loop.
+C
+C The unrolled inner loop is the same as in aorsmul_1.asm, see that code for
+C some comments.
+C
+C VAR_COUNTER is for the inner loop, running from VAR_COUNTER_INIT down to
+C 0, inclusive.
+C
+C VAR_JMP is the computed jump into the unrolled loop.
+C
+C PARAM_XP and PARAM_WP get offset appropriately for where the unrolled loop
+C is entered.
+C
+C VAR_XP_LOW is the least significant limb of xp, which is needed at the
+C start of the unrolled loop.  This can't just be fetched through the xp
+C pointer because of the offset applied to it.
+C
+C PARAM_YSIZE is the outer loop counter, going from -(ysize-1) up to -1,
+C inclusive.
+C
+C PARAM_YP is offset appropriately so that the PARAM_YSIZE counter can be
+C added to give the location of the next limb of yp, which is the multiplier
+C in the unrolled loop.
+C
+C PARAM_WP is similarly offset so that the PARAM_YSIZE counter can be added
+C to give the starting point in the destination for each unrolled loop (this
+C point is one limb upwards for each limb of yp processed).
+C
+C Having PARAM_YSIZE count negative to zero means it's not necessary to
+C store new values of PARAM_YP and PARAM_WP on each loop.  Those values on
+C the stack remain constant and on each loop an leal adjusts them with the
+C PARAM_YSIZE counter value.
+
+
+defframe(VAR_COUNTER,      -20)
+defframe(VAR_COUNTER_INIT, -24)
+defframe(VAR_JMP,          -28)
+defframe(VAR_XP_LOW,       -32)
+deflit(VAR_STACK_SPACE, 16)
+
+dnl  For some strange reason using (%esp) instead of 0(%esp) is a touch
+dnl  slower in this code, hence the defframe empty-if-zero feature is
+dnl  disabled.
+dnl
+dnl  If VAR_COUNTER is at (%esp), the effect is worse.  In this case the
+dnl  unrolled loop is 255 instead of 256 bytes, but quite how this affects
+dnl  anything isn't clear.
+dnl
+define(`defframe_empty_if_zero_disabled',1)
+
+L(unroll):
+	C eax	yp (not used)
+	C ebx	xp end (not used)
+	C ecx	xsize
+	C edx	ysize-1
+	C esi
+	C edi	wp end of mul1 (not used)
+	C ebp
+deflit(`FRAME', 16)
+
+	leal	-2(%ecx), %ebp	C one limb processed at start,
+	decl	%ecx		C and ebp is one less
+
+	shrl	$UNROLL_LOG2, %ebp
+	negl	%ecx
+
+	subl	$VAR_STACK_SPACE, %esp
+deflit(`FRAME', 16+VAR_STACK_SPACE)
+	andl	$UNROLL_MASK, %ecx
+
+	movl	%ecx, %esi
+	shll	$4, %ecx
+
+	movl	%ebp, VAR_COUNTER_INIT
+	negl	%esi
+
+	C 15 code bytes per limb
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(unroll_here):
+',`
+	leal	L(unroll_entry) (%ecx,%esi,1), %ecx
+')
+
+	movl	PARAM_XP, %ebx
+	movl	%ebp, VAR_COUNTER
+
+	movl	PARAM_WP, %edi
+	movl	%ecx, VAR_JMP
+
+	movl	(%ebx), %eax
+	leal	4(%edi,%esi,4), %edi	C wp adjust for unrolling and mul1
+
+	leal	(%ebx,%esi,4), %ebx	C xp adjust for unrolling
+
+	movl	%eax, VAR_XP_LOW
+
+	movl	%ebx, PARAM_XP
+	movl	PARAM_YP, %ebx
+
+	leal	(%edi,%edx,4), %ecx	C wp adjust for ysize indexing
+	movl	4(%ebx), %ebp		C multiplier (yp second limb)
+
+	leal	4(%ebx,%edx,4), %ebx	C yp adjust for ysize indexing
+
+	movl	%ecx, PARAM_WP
+
+	leal	1(%esi), %ecx	C adjust parity for decl %ecx above
+
+	movl	%ebx, PARAM_YP
+	negl	%edx
+
+	movl	%edx, PARAM_YSIZE
+	jmp	L(unroll_outer_entry)
+
+
+ifdef(`PIC',`
+L(pic_calc):
+	C See README.family about old gas bugs
+	leal	(%ecx,%esi,1), %ecx
+	addl	$L(unroll_entry)-L(unroll_here), %ecx
+	addl	(%esp), %ecx
+	ret
+')
+
+
+C -----------------------------------------------------------------------------
+	C Aligning here saves a couple of cycles per loop.  Using 32 doesn't
+	C cost any extra space, since the inner unrolled loop below is
+	C aligned to 32.
+	ALIGN(32)
+L(unroll_outer_top):
+	C edx	ysize
+
+	movl	PARAM_YP, %eax
+	movl	%edx, PARAM_YSIZE	C incremented ysize counter
+
+	movl	PARAM_WP, %edi
+
+	movl	VAR_COUNTER_INIT, %ebx
+	movl	(%eax,%edx,4), %ebp	C next multiplier
+
+	movl	PARAM_XSIZE, %ecx
+	leal	(%edi,%edx,4), %edi	C adjust wp for where we are in yp
+
+	movl	VAR_XP_LOW, %eax
+	movl	%ebx, VAR_COUNTER
+
+L(unroll_outer_entry):
+	mull	%ebp
+
+	C using testb is a tiny bit faster than testl
+	testb	$1, %cl
+
+	movl	%eax, %ecx	C low carry
+	movl	VAR_JMP, %eax
+
+	movl	%edx, %esi	C high carry
+	movl	PARAM_XP, %ebx
+
+	jnz	L(unroll_noswap)
+	movl	%ecx, %esi	C high,low carry other way around
+
+	movl	%edx, %ecx
+L(unroll_noswap):
+
+	jmp	*%eax
+
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(32)
+L(unroll_top):
+	C eax	scratch
+	C ebx	xp
+	C ecx	carry low
+	C edx	scratch
+	C esi	carry high
+	C edi	wp
+	C ebp	multiplier
+	C VAR_COUNTER  loop counter
+	C
+	C 15 code bytes each limb
+
+	leal	UNROLL_BYTES(%edi), %edi
+
+L(unroll_entry):
+deflit(CHUNK_COUNT,2)
+forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
+	deflit(`disp0', eval(i*CHUNK_COUNT*4))
+	deflit(`disp1', eval(disp0 + 4))
+	deflit(`disp2', eval(disp1 + 4))
+
+	movl	disp1(%ebx), %eax
+	mull	%ebp
+Zdisp(	addl,	%ecx, disp0,(%edi))
+	adcl	%eax, %esi
+	movl	%edx, %ecx
+	jadcl0( %ecx)
+
+	movl	disp2(%ebx), %eax
+	mull	%ebp
+	addl	%esi, disp1(%edi)
+	adcl	%eax, %ecx
+	movl	%edx, %esi
+	jadcl0( %esi)
+')
+
+	decl	VAR_COUNTER
+	leal	UNROLL_BYTES(%ebx), %ebx
+
+	jns	L(unroll_top)
+
+
+	movl	PARAM_YSIZE, %edx
+	addl	%ecx, UNROLL_BYTES(%edi)
+
+	adcl	$0, %esi
+
+	incl	%edx
+	movl	%esi, UNROLL_BYTES+4(%edi)
+
+	jnz	L(unroll_outer_top)
+
+
+	movl	SAVE_ESI, %esi
+	movl	SAVE_EBP, %ebp
+	movl	SAVE_EDI, %edi
+	movl	SAVE_EBX, %ebx
+
+	addl	$FRAME, %esp
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k6/sqr_basecase.asm b/src/gmp/mpn/x86/k6/sqr_basecase.asm
new file mode 100644
index 000000000..70d49b3e5
--- /dev/null
+++ b/src/gmp/mpn/x86/k6/sqr_basecase.asm
@@ -0,0 +1,672 @@
+dnl  AMD K6 mpn_sqr_basecase -- square an mpn number.
+dnl 
+dnl  K6: approx 4.7 cycles per cross product, or 9.2 cycles per triangular
+dnl  product (measured on the speed difference between 17 and 33 limbs,
+dnl  which is roughly the Karatsuba recursing range).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  KARATSUBA_SQR_THRESHOLD_MAX is the maximum KARATSUBA_SQR_THRESHOLD this
+dnl  code supports.  This value is used only by the tune program to know
+dnl  what it can go up to.  (An attempt to compile with a bigger value will
+dnl  trigger some m4_assert()s in the code, making the build fail.)
+dnl
+dnl  The value is determined by requiring the displacements in the unrolled
+dnl  addmul to fit in single bytes.  This means a maximum UNROLL_COUNT of
+dnl  63, giving a maximum KARATSUBA_SQR_THRESHOLD of 66.
+
+deflit(KARATSUBA_SQR_THRESHOLD_MAX, 66)
+
+
+dnl  Allow a value from the tune program to override config.m4.
+
+ifdef(`KARATSUBA_SQR_THRESHOLD_OVERRIDE',
+`define(`KARATSUBA_SQR_THRESHOLD',KARATSUBA_SQR_THRESHOLD_OVERRIDE)')
+
+
+dnl  UNROLL_COUNT is the number of code chunks in the unrolled addmul.  The
+dnl  number required is determined by KARATSUBA_SQR_THRESHOLD, since
+dnl  mpn_sqr_basecase only needs to handle sizes < KARATSUBA_SQR_THRESHOLD.
+dnl
+dnl  The first addmul is the biggest, and this takes the second least
+dnl  significant limb and multiplies it by the third least significant and
+dnl  up.  Hence for a maximum operand size of KARATSUBA_SQR_THRESHOLD-1
+dnl  limbs, UNROLL_COUNT needs to be KARATSUBA_SQR_THRESHOLD-3.
+
+m4_config_gmp_mparam(`KARATSUBA_SQR_THRESHOLD')
+deflit(UNROLL_COUNT, eval(KARATSUBA_SQR_THRESHOLD-3))
+
+
+C void mpn_sqr_basecase (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C The algorithm is essentially the same as mpn/generic/sqr_basecase.c, but a
+C lot of function call overheads are avoided, especially when the given size
+C is small.
+C
+C The code size might look a bit excessive, but not all of it is executed
+C and so won't fill up the code cache.  The 1x1, 2x2 and 3x3 special cases
+C clearly apply only to those sizes; mid sizes like 10x10 only need part of
+C the unrolled addmul; and big sizes like 35x35 that do need all of it will
+C at least be getting value for money, because 35x35 spends something like
+C 5780 cycles here.
+C
+C Different values of UNROLL_COUNT give slightly different speeds, between
+C 9.0 and 9.2 c/tri-prod measured on the difference between 17 and 33 limbs.
+C This isn't a big difference, but it's presumably some alignment effect
+C which if understood could give a simple speedup.
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+
+	.text
+	ALIGN(32)
+PROLOGUE(mpn_sqr_basecase)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	movl	PARAM_SRC, %eax
+
+	cmpl	$2, %ecx
+	je	L(two_limbs)
+
+	movl	PARAM_DST, %edx
+	ja	L(three_or_more)
+
+
+C -----------------------------------------------------------------------------
+C one limb only
+	C eax	src
+	C ebx
+	C ecx	size
+	C edx	dst
+
+	movl	(%eax), %eax
+	movl	%edx, %ecx
+
+	mull	%eax
+
+	movl	%eax, (%ecx)
+	movl	%edx, 4(%ecx)
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(two_limbs):
+	C eax	src
+	C ebx
+	C ecx	size
+	C edx	dst
+
+	pushl	%ebx
+	movl	%eax, %ebx	C src
+deflit(`FRAME',4)
+
+	movl	(%ebx), %eax
+	movl	PARAM_DST, %ecx
+
+	mull	%eax		C src[0]^2
+
+	movl	%eax, (%ecx)
+	movl	4(%ebx), %eax
+
+	movl	%edx, 4(%ecx)
+
+	mull	%eax		C src[1]^2
+
+	movl	%eax, 8(%ecx)
+	movl	(%ebx), %eax
+
+	movl	%edx, 12(%ecx)
+	movl	4(%ebx), %edx
+
+	mull	%edx		C src[0]*src[1]
+
+	addl	%eax, 4(%ecx)
+
+	adcl	%edx, 8(%ecx)
+	adcl	$0, 12(%ecx)
+
+	popl	%ebx
+	addl	%eax, 4(%ecx)
+
+	adcl	%edx, 8(%ecx)
+	adcl	$0, 12(%ecx)
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+L(three_or_more):
+deflit(`FRAME',0)
+	cmpl	$4, %ecx
+	jae	L(four_or_more)
+
+
+C -----------------------------------------------------------------------------
+C three limbs
+	C eax	src
+	C ecx	size
+	C edx	dst
+
+	pushl	%ebx
+	movl	%eax, %ebx	C src
+
+	movl	(%ebx), %eax
+	movl	%edx, %ecx	C dst
+
+	mull	%eax		C src[0] ^ 2
+
+	movl	%eax, (%ecx)
+	movl	4(%ebx), %eax
+
+	movl	%edx, 4(%ecx)
+	pushl	%esi
+
+	mull	%eax		C src[1] ^ 2
+
+	movl	%eax, 8(%ecx)
+	movl	8(%ebx), %eax
+
+	movl	%edx, 12(%ecx)
+	pushl	%edi
+
+	mull	%eax		C src[2] ^ 2
+
+	movl	%eax, 16(%ecx)
+	movl	(%ebx), %eax
+
+	movl	%edx, 20(%ecx)
+	movl	4(%ebx), %edx
+
+	mull	%edx		C src[0] * src[1]
+
+	movl	%eax, %esi
+	movl	(%ebx), %eax
+
+	movl	%edx, %edi
+	movl	8(%ebx), %edx
+
+	pushl	%ebp
+	xorl	%ebp, %ebp
+
+	mull	%edx		C src[0] * src[2]
+
+	addl	%eax, %edi
+	movl	4(%ebx), %eax
+
+	adcl	%edx, %ebp
+
+	movl	8(%ebx), %edx
+
+	mull	%edx		C src[1] * src[2]
+
+	addl	%eax, %ebp
+
+	adcl	$0, %edx
+
+
+	C eax	will be dst[5]
+	C ebx
+	C ecx	dst
+	C edx	dst[4]
+	C esi	dst[1]
+	C edi	dst[2]
+	C ebp	dst[3]
+
+	xorl	%eax, %eax
+	addl	%esi, %esi
+	adcl	%edi, %edi
+	adcl	%ebp, %ebp
+	adcl	%edx, %edx
+	adcl	$0, %eax
+
+	addl	%esi, 4(%ecx)
+	adcl	%edi, 8(%ecx)
+	adcl	%ebp, 12(%ecx)
+
+	popl	%ebp
+	popl	%edi
+
+	adcl	%edx, 16(%ecx)
+
+	popl	%esi
+	popl	%ebx
+
+	adcl	%eax, 20(%ecx)
+	ASSERT(nc)
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+
+defframe(SAVE_EBX,   -4)
+defframe(SAVE_ESI,   -8)
+defframe(SAVE_EDI,   -12)
+defframe(SAVE_EBP,   -16)
+defframe(VAR_COUNTER,-20)
+defframe(VAR_JMP,    -24)
+deflit(STACK_SPACE, 24)
+
+	ALIGN(16)
+L(four_or_more):
+
+	C eax	src
+	C ebx
+	C ecx	size
+	C edx	dst
+	C esi
+	C edi
+	C ebp
+
+C First multiply src[0]*src[1..size-1] and store at dst[1..size].
+C
+C A test was done calling mpn_mul_1 here to get the benefit of its unrolled
+C loop, but this was only a tiny speedup; at 35 limbs it took 24 cycles off
+C a 5780 cycle operation, which is not surprising since the loop here is 8
+C c/l and mpn_mul_1 is 6.25 c/l.
+
+	subl	$STACK_SPACE, %esp	deflit(`FRAME',STACK_SPACE)
+	
+	movl	%edi, SAVE_EDI
+	leal	4(%edx), %edi
+
+	movl	%ebx, SAVE_EBX
+	leal	4(%eax), %ebx
+
+	movl	%esi, SAVE_ESI
+	xorl	%esi, %esi
+
+	movl	%ebp, SAVE_EBP
+
+	C eax
+	C ebx	src+4
+	C ecx	size
+	C edx
+	C esi
+	C edi	dst+4
+	C ebp
+
+	movl	(%eax), %ebp	C multiplier
+	leal	-1(%ecx), %ecx	C size-1, and pad to a 16 byte boundary
+
+
+	ALIGN(16)
+L(mul_1):
+	C eax	scratch
+	C ebx	src ptr
+	C ecx	counter
+	C edx	scratch
+	C esi	carry
+	C edi	dst ptr
+	C ebp	multiplier
+
+	movl	(%ebx), %eax
+	addl	$4, %ebx
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	movl	$0, %esi
+
+	adcl	%edx, %esi
+
+	movl	%eax, (%edi)
+	addl	$4, %edi
+
+	loop	L(mul_1)
+
+
+C Addmul src[n]*src[n+1..size-1] at dst[2*n-1...], for each n=1..size-2.
+C
+C The last two addmuls, which are the bottom right corner of the product
+C triangle, are left to the end.  These are src[size-3]*src[size-2,size-1]
+C and src[size-2]*src[size-1].  If size is 4 then it's only these corner
+C cases that need to be done.
+C
+C The unrolled code is the same as mpn_addmul_1(), see that routine for some
+C comments.
+C
+C VAR_COUNTER is the outer loop, running from -(size-4) to -1, inclusive.
+C
+C VAR_JMP is the computed jump into the unrolled code, stepped by one code
+C chunk each outer loop.
+C
+C K6 doesn't do any branch prediction on indirect jumps, which is good
+C actually because it's a different target each time.  The unrolled addmul
+C is about 3 cycles/limb faster than a simple loop, so the 6 cycle cost of
+C the indirect jump is quickly recovered.
+
+
+dnl  This value is also implicitly encoded in a shift and add.
+dnl
+deflit(CODE_BYTES_PER_LIMB, 15)
+
+dnl  With the unmodified &src[size] and &dst[size] pointers, the
+dnl  displacements in the unrolled code fit in a byte for UNROLL_COUNT
+dnl  values up to 31.  Above that an offset must be added to them.
+dnl
+deflit(OFFSET,
+ifelse(eval(UNROLL_COUNT>31),1,
+eval((UNROLL_COUNT-31)*4),
+0))
+
+	C eax
+	C ebx	&src[size]
+	C ecx
+	C edx
+	C esi	carry
+	C edi	&dst[size]
+	C ebp
+
+	movl	PARAM_SIZE, %ecx
+	movl	%esi, (%edi)
+
+	subl	$4, %ecx
+	jz	L(corner)
+
+	movl	%ecx, %edx
+ifelse(OFFSET,0,,
+`	subl	$OFFSET, %ebx')
+
+	shll	$4, %ecx
+ifelse(OFFSET,0,,
+`	subl	$OFFSET, %edi')
+
+	negl	%ecx
+
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(here):
+',`
+	leal	L(unroll_inner_end)-eval(2*CODE_BYTES_PER_LIMB)(%ecx,%edx), %ecx
+')
+	negl	%edx
+
+
+	C The calculated jump mustn't be before the start of the available
+	C code.  This is the limitation UNROLL_COUNT puts on the src operand
+	C size, but checked here using the jump address directly.
+	C
+	ASSERT(ae,`
+	movl_text_address( L(unroll_inner_start), %eax)
+	cmpl	%eax, %ecx
+	')
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(unroll_outer_top):
+	C eax
+	C ebx	&src[size], constant
+	C ecx	VAR_JMP
+	C edx	VAR_COUNTER, limbs, negative
+	C esi	high limb to store
+	C edi	dst ptr, high of last addmul
+	C ebp
+
+	movl	-12+OFFSET(%ebx,%edx,4), %ebp	C multiplier
+	movl	%edx, VAR_COUNTER
+
+	movl	-8+OFFSET(%ebx,%edx,4), %eax	C first limb of multiplicand
+
+	mull	%ebp
+
+	testb	$1, %cl
+
+	movl	%edx, %esi	C high carry
+	movl	%ecx, %edx	C jump
+
+	movl	%eax, %ecx	C low carry
+	leal	CODE_BYTES_PER_LIMB(%edx), %edx
+
+	movl	%edx, VAR_JMP
+	leal	4(%edi), %edi
+
+	C A branch-free version of this using some xors was found to be a
+	C touch slower than just a conditional jump, despite the jump
+	C switching between taken and not taken on every loop.
+
+ifelse(eval(UNROLL_COUNT%2),0,
+	jz,jnz)	L(unroll_noswap)
+	movl	%esi, %eax	C high,low carry other way around
+
+	movl	%ecx, %esi
+	movl	%eax, %ecx
+L(unroll_noswap):
+
+	jmp	*%edx
+
+
+	C Must be on an even address here so the low bit of the jump address
+	C will indicate which way around ecx/esi should start.
+	C
+	C An attempt was made at padding here to get the end of the unrolled
+	C code to come out on a good alignment, to save padding before
+	C L(corner).  This worked, but turned out to run slower than just an
+	C ALIGN(2).  The reason for this is not clear, it might be related
+	C to the different speeds on different UNROLL_COUNTs noted above.
+
+	ALIGN(2)
+
+L(unroll_inner_start):
+	C eax	scratch
+	C ebx	src
+	C ecx	carry low
+	C edx	scratch
+	C esi	carry high
+	C edi	dst
+	C ebp	multiplier
+	C
+	C 15 code bytes each limb
+	C ecx/esi swapped on each chunk
+
+forloop(`i', UNROLL_COUNT, 1, `
+	deflit(`disp_src', eval(-i*4 + OFFSET))
+	deflit(`disp_dst', eval(disp_src - 4))
+
+	m4_assert(`disp_src>=-128 && disp_src<128')
+	m4_assert(`disp_dst>=-128 && disp_dst<128')
+
+ifelse(eval(i%2),0,`
+Zdisp(	movl,	disp_src,(%ebx), %eax)
+	mull	%ebp
+Zdisp(	addl,	%esi, disp_dst,(%edi))
+	adcl	%eax, %ecx
+	movl	%edx, %esi
+	jadcl0( %esi)
+',`
+	dnl  this one comes out last
+Zdisp(	movl,	disp_src,(%ebx), %eax)
+	mull	%ebp
+Zdisp(	addl,	%ecx, disp_dst,(%edi))
+	adcl	%eax, %esi
+	movl	%edx, %ecx
+	jadcl0( %ecx)
+')
+')
+L(unroll_inner_end):
+
+	addl	%esi, -4+OFFSET(%edi)
+
+	movl	VAR_COUNTER, %edx
+	jadcl0(	%ecx)
+
+	movl	%ecx, m4_empty_if_zero(OFFSET)(%edi)
+	movl	VAR_JMP, %ecx
+
+	incl	%edx
+	jnz	L(unroll_outer_top)
+	
+
+ifelse(OFFSET,0,,`
+	addl	$OFFSET, %ebx
+	addl	$OFFSET, %edi
+')
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(corner):
+	C ebx	&src[size]
+	C edi	&dst[2*size-5]
+
+	movl	-12(%ebx), %ebp
+
+	movl	-8(%ebx), %eax
+	movl	%eax, %ecx
+
+	mull	%ebp
+
+	addl	%eax, -4(%edi)
+	adcl	$0, %edx
+
+	movl	-4(%ebx), %eax
+	movl	%edx, %esi
+	movl	%eax, %ebx
+
+	mull	%ebp
+
+	addl	%esi, %eax
+	adcl	$0, %edx
+
+	addl	%eax, (%edi)
+	adcl	$0, %edx
+
+	movl	%edx, %esi
+	movl	%ebx, %eax
+
+	mull	%ecx
+
+	addl	%esi, %eax
+	movl	%eax, 4(%edi)
+
+	adcl	$0, %edx
+
+	movl	%edx, 8(%edi)
+	
+
+C -----------------------------------------------------------------------------
+C Left shift of dst[1..2*size-2], the bit shifted out becomes dst[2*size-1].
+C The loop measures about 6 cycles/iteration, though it looks like it should
+C decode in 5.
+
+L(lshift_start):
+	movl	PARAM_SIZE, %ecx
+
+	movl	PARAM_DST, %edi
+	subl	$1, %ecx		C size-1 and clear carry
+
+	movl	PARAM_SRC, %ebx
+	movl	%ecx, %edx
+
+	xorl	%eax, %eax		C ready for adcl
+
+
+	ALIGN(16)
+L(lshift):
+	C eax
+	C ebx	src (for later use)
+	C ecx	counter, decrementing
+	C edx	size-1 (for later use)
+	C esi
+	C edi	dst, incrementing
+	C ebp
+
+	rcll	4(%edi)
+	rcll	8(%edi)
+	leal	8(%edi), %edi
+	loop	L(lshift)
+
+
+	adcl	%eax, %eax
+
+	movl	%eax, 4(%edi)		C dst most significant limb
+	movl	(%ebx), %eax		C src[0]
+
+	leal	4(%ebx,%edx,4), %ebx	C &src[size]
+	subl	%edx, %ecx		C -(size-1)
+
+
+C -----------------------------------------------------------------------------
+C Now add in the squares on the diagonal, src[0]^2, src[1]^2, ...,
+C src[size-1]^2.  dst[0] hasn't yet been set at all yet, and just gets the
+C low limb of src[0]^2.
+
+
+	mull	%eax
+
+	movl	%eax, (%edi,%ecx,8)	C dst[0]
+
+
+	ALIGN(16)
+L(diag):
+	C eax	scratch
+	C ebx	&src[size]
+	C ecx	counter, negative
+	C edx	carry
+	C esi	scratch
+	C edi	dst[2*size-2]
+	C ebp
+
+	movl	(%ebx,%ecx,4), %eax
+	movl	%edx, %esi
+
+	mull	%eax
+
+	addl	%esi, 4(%edi,%ecx,8)
+	adcl	%eax, 8(%edi,%ecx,8)
+	adcl	$0, %edx
+
+	incl	%ecx
+	jnz	L(diag)
+
+
+	movl	SAVE_EBX, %ebx
+	movl	SAVE_ESI, %esi
+
+	addl	%edx, 4(%edi)		C dst most significant limb
+
+	movl	SAVE_EDI, %edi
+	movl	SAVE_EBP, %ebp
+	addl	$FRAME, %esp
+	ret
+
+
+
+C -----------------------------------------------------------------------------
+ifdef(`PIC',`
+L(pic_calc):
+        C See README.family about old gas bugs
+	addl	(%esp), %ecx
+	addl	$L(unroll_inner_end)-L(here)-eval(2*CODE_BYTES_PER_LIMB), %ecx
+	addl	%edx, %ecx
+	ret
+')
+
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/README b/src/gmp/mpn/x86/k7/README
new file mode 100644
index 000000000..c34315c40
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/README
@@ -0,0 +1,145 @@
+
+                      AMD K7 MPN SUBROUTINES
+
+
+This directory contains code optimized for the AMD Athlon CPU.
+
+The mmx subdirectory has routines using MMX instructions.  All Athlons have
+MMX, the separate directory is just so that configure can omit it if the
+assembler doesn't support MMX.
+
+
+
+STATUS
+
+Times for the loops, with all code and data in L1 cache.
+
+                               cycles/limb
+	mpn_add/sub_n             1.6
+
+	mpn_copyi                 0.75 or 1.0   \ varying with data alignment
+	mpn_copyd                 0.75 or 1.0   /
+
+	mpn_divrem_1             17.0 integer part, 15.0 fractional part
+	mpn_mod_1                17.0
+	mpn_divexact_by3          8.0
+
+	mpn_l/rshift              1.2
+
+	mpn_mul_1                 3.4
+	mpn_addmul/submul_1       3.9
+
+	mpn_mul_basecase          4.42 cycles/crossproduct (approx)
+
+	mpn_popcount		   5.0
+	mpn_hamdist		   6.0
+
+Prefetching of sources hasn't yet been tried.
+
+
+
+NOTES
+
+cmov, MMX, 3DNow and some extensions to MMX and 3DNow are available.
+
+Write-allocate L1 data cache means prefetching of destinations is unnecessary.
+
+Floating point multiplications can be done in parallel with integer
+multiplications, but there doesn't seem to be any way to make use of this.
+
+Unsigned "mul"s can be issued every 3 cycles.  This suggests 3 is a limit on
+the speed of the multiplication routines.  The documentation shows mul
+executing in IEU0 (or maybe in IEU0 and IEU1 together), so it might be that,
+to get near 3 cycles code has to be arranged so that nothing else is issued
+to IEU0.  A busy IEU0 could explain why some code takes 4 cycles and other
+apparently equivalent code takes 5.
+
+
+
+OPTIMIZATIONS
+
+Unrolled loops are used to reduce looping overhead.  The unrolling is
+configurable up to 32 limbs/loop for most routines and up to 64 for some.
+The K7 has 64k L1 code cache so quite big unrolling is allowable.
+
+Computed jumps into the unrolling are used to handle sizes not a multiple of
+the unrolling.  An attractive feature of this is that times increase
+smoothly with operand size, but it may be that some routines should just
+have simple loops to finish up, especially when PIC adds between 2 and 16
+cycles to get %eip.
+
+Position independent code is implemented using a call to get %eip for the
+computed jumps and a ret is always done, rather than an addl $4,%esp or a
+popl, so the CPU return address branch prediction stack stays synchronised
+with the actual stack in memory.
+
+Branch prediction, in absence of any history, will guess forward jumps are
+not taken and backward jumps are taken.  Where possible it's arranged that
+the less likely or less important case is under a taken forward jump.
+
+
+
+CODING
+
+Instructions in general code have been shown grouped if they can execute
+together, which means up to three direct-path instructions which have no
+successive dependencies.  K7 always decodes three and has out-of-order
+execution, but the groupings show what slots might be available and what
+dependency chains exist.
+
+When there's vector-path instructions an effort is made to get triplets of
+direct-path instructions in between them, even if there's dependencies,
+since this maximizes decoding throughput and might save a cycle or two if
+decoding is the limiting factor.
+
+
+
+INSTRUCTIONS
+
+adcl       direct
+divl       39 cycles back-to-back
+lodsl,etc  vector
+loop       1 cycle vector (decl/jnz opens up one decode slot)
+movd reg   vector
+movd mem   direct
+mull       issue every 3 cycles, latency 4 cycles low word, 6 cycles high word
+popl	   vector (use movl for more than one pop)
+pushl	   direct, will pair with a load
+shrdl %cl  vector, 3 cycles, seems to be 3 decode too
+xorl r,r   false read dependency recognised
+
+
+
+REFERENCES
+
+"AMD Athlon Processor X86 Code Optimization Guide", AMD publication number
+22007, revision E, November 1999.  Available on-line,
+
+	http://www.amd.com/products/cpg/athlon/techdocs/pdf/22007.pdf
+
+"3DNow Technology Manual", AMD publication number 21928F/0-August 1999.
+This describes the femms and prefetch instructions.  Available on-line,
+
+	http://www.amd.com/K6/k6docs/pdf/21928.pdf
+
+"AMD Extensions to the 3DNow and MMX Instruction Sets Manual", AMD
+publication number 22466, revision B, August 1999.  This describes
+instructions added in the Athlon processor, such as pswapd and the extra
+prefetch forms.  Available on-line,
+
+	http://www.amd.com/products/cpg/athlon/techdocs/pdf/22466.pdf
+
+"3DNow Instruction Porting Guide", AMD publication number 22621, revision B,
+August 1999.  This has some notes on general Athlon optimizations as well as
+3DNow.  Available on-line,
+
+	http://www.amd.com/products/cpg/athlon/techdocs/pdf/22621.pdf
+
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 76
+End:
diff --git a/src/gmp/mpn/x86/k7/aors_n.asm b/src/gmp/mpn/x86/k7/aors_n.asm
new file mode 100644
index 000000000..85fa9d303
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/aors_n.asm
@@ -0,0 +1,250 @@
+dnl  AMD K7 mpn_add_n/mpn_sub_n -- mpn add or subtract.
+dnl 
+dnl  K7: 1.64 cycles/limb (at 16 limb/loop).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K7: UNROLL_COUNT cycles/limb
+dnl           8           1.9
+dnl          16           1.64
+dnl          32           1.7
+dnl          64           2.0
+dnl  Maximum possible with the current code is 64.
+
+deflit(UNROLL_COUNT, 16)
+
+
+ifdef(`OPERATION_add_n', `
+	define(M4_inst,        adcl)
+	define(M4_function_n,  mpn_add_n)
+	define(M4_function_nc, mpn_add_nc)
+	define(M4_description, add)
+',`ifdef(`OPERATION_sub_n', `
+	define(M4_inst,        sbbl)
+	define(M4_function_n,  mpn_sub_n)
+	define(M4_function_nc, mpn_sub_nc)
+	define(M4_description, subtract)
+',`m4_error(`Need OPERATION_add_n or OPERATION_sub_n
+')')')
+
+MULFUNC_PROLOGUE(mpn_add_n mpn_add_nc mpn_sub_n mpn_sub_nc)
+
+
+C mp_limb_t M4_function_n (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
+C                         mp_size_t size);
+C mp_limb_t M4_function_nc (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
+C	                   mp_size_t size, mp_limb_t carry);
+C
+C Calculate src1,size M4_description src2,size, and store the result in
+C dst,size.  The return value is the carry bit from the top of the result (1
+C or 0).
+C
+C The _nc version accepts 1 or 0 for an initial carry into the low limb of
+C the calculation.  Note values other than 1 or 0 here will lead to garbage
+C results.
+C
+C This code runs at 1.64 cycles/limb, which is probably the best possible
+C with plain integer operations.  Each limb is 2 loads and 1 store, and in
+C one cycle the K7 can do two loads, or a load and a store, leading to 1.5
+C c/l.
+
+dnl  Must have UNROLL_THRESHOLD >= 2, since the unrolled loop can't handle 1.
+ifdef(`PIC',`
+deflit(UNROLL_THRESHOLD, 8)
+',`
+deflit(UNROLL_THRESHOLD, 8)
+')
+
+defframe(PARAM_CARRY,20)
+defframe(PARAM_SIZE, 16)
+defframe(PARAM_SRC2, 12)
+defframe(PARAM_SRC1, 8)
+defframe(PARAM_DST,  4)
+
+defframe(SAVE_EBP, -4)
+defframe(SAVE_ESI, -8)
+defframe(SAVE_EBX, -12)
+defframe(SAVE_EDI, -16)
+deflit(STACK_SPACE, 16)
+
+	.text
+	ALIGN(32)
+deflit(`FRAME',0)
+
+PROLOGUE(M4_function_nc)
+	movl	PARAM_CARRY, %eax
+	jmp	LF(M4_function_n,start)
+EPILOGUE()
+
+PROLOGUE(M4_function_n)
+
+	xorl	%eax, %eax	C carry
+L(start):
+	movl	PARAM_SIZE, %ecx
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%edi, SAVE_EDI
+	movl	%ebx, SAVE_EBX
+	cmpl	$UNROLL_THRESHOLD, %ecx
+
+	movl	PARAM_SRC2, %edx
+	movl	PARAM_SRC1, %ebx
+	jae	L(unroll)
+
+	movl	PARAM_DST, %edi
+	leal	(%ebx,%ecx,4), %ebx
+	leal	(%edx,%ecx,4), %edx
+
+	leal	(%edi,%ecx,4), %edi
+	negl	%ecx
+	shrl	%eax
+
+	C This loop in in a single 16 byte code block already, so no
+	C alignment necessary.
+L(simple):
+	C eax	scratch
+	C ebx	src1
+	C ecx	counter
+	C edx	src2
+	C esi
+	C edi	dst
+	C ebp
+
+	movl	(%ebx,%ecx,4), %eax
+	M4_inst	(%edx,%ecx,4), %eax
+	movl	%eax, (%edi,%ecx,4)
+	incl	%ecx
+	jnz	L(simple)
+
+	movl	$0, %eax
+	movl	SAVE_EDI, %edi
+
+	movl	SAVE_EBX, %ebx
+	setc	%al
+	addl	$STACK_SPACE, %esp
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	C This is at 0x55, close enough to aligned.
+L(unroll):
+deflit(`FRAME',STACK_SPACE)
+	movl	%ebp, SAVE_EBP
+	andl	$-2, %ecx		C size low bit masked out
+	andl	$1, PARAM_SIZE		C size low bit kept
+
+	movl	%ecx, %edi
+	decl	%ecx
+	movl	PARAM_DST, %ebp
+
+	shrl	$UNROLL_LOG2, %ecx
+	negl	%edi
+	movl	%esi, SAVE_ESI
+
+	andl	$UNROLL_MASK, %edi
+
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(here):
+',`
+	leal	L(entry) (%edi,%edi,8), %esi	C 9 bytes per
+')
+	negl	%edi
+	shrl	%eax
+
+	leal	ifelse(UNROLL_BYTES,256,128) (%ebx,%edi,4), %ebx
+	leal	ifelse(UNROLL_BYTES,256,128) (%edx,%edi,4), %edx
+	leal	ifelse(UNROLL_BYTES,256,128) (%ebp,%edi,4), %edi
+
+	jmp	*%esi
+
+
+ifdef(`PIC',`
+L(pic_calc):
+	C See README.family about old gas bugs
+	leal	(%edi,%edi,8), %esi
+	addl	$L(entry)-L(here), %esi
+	addl	(%esp), %esi
+	ret
+')
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(32)
+L(top):
+	C eax	zero
+	C ebx	src1
+	C ecx	counter
+	C edx	src2
+	C esi	scratch (was computed jump)
+	C edi	dst
+	C ebp	scratch
+
+	leal	UNROLL_BYTES(%edx), %edx
+
+L(entry):
+deflit(CHUNK_COUNT, 2)
+forloop(i, 0, UNROLL_COUNT/CHUNK_COUNT-1, `
+	deflit(`disp0', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
+	deflit(`disp1', eval(disp0 + 4))
+
+Zdisp(	movl,	disp0,(%ebx), %esi)
+	movl	disp1(%ebx), %ebp
+Zdisp(	M4_inst,disp0,(%edx), %esi)
+Zdisp(	movl,	%esi, disp0,(%edi))
+	M4_inst	disp1(%edx), %ebp
+	movl	%ebp, disp1(%edi)
+')
+
+	decl	%ecx
+	leal	UNROLL_BYTES(%ebx), %ebx
+	leal	UNROLL_BYTES(%edi), %edi
+	jns	L(top)
+
+
+	mov	PARAM_SIZE, %esi
+	movl	SAVE_EBP, %ebp
+	movl	$0, %eax
+
+	decl	%esi
+	js	L(even)
+
+	movl	(%ebx), %ecx
+	M4_inst	UNROLL_BYTES(%edx), %ecx
+	movl	%ecx, (%edi)
+L(even):
+
+	movl	SAVE_EDI, %edi
+	movl	SAVE_EBX, %ebx
+	setc	%al
+
+	movl	SAVE_ESI, %esi
+	addl	$STACK_SPACE, %esp
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/aorsmul_1.asm b/src/gmp/mpn/x86/k7/aorsmul_1.asm
new file mode 100644
index 000000000..9f9c3daaf
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/aorsmul_1.asm
@@ -0,0 +1,364 @@
+dnl  AMD K7 mpn_addmul_1/mpn_submul_1 -- add or subtract mpn multiple.
+dnl 
+dnl  K7: 3.9 cycles/limb.
+dnl 
+dnl  Future: It should be possible to avoid the separate mul after the
+dnl  unrolled loop by moving the movl/adcl to the top.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K7: UNROLL_COUNT  cycles/limb
+dnl           4            4.42
+dnl           8            4.16
+dnl          16            3.9
+dnl          32            3.9
+dnl          64            3.87
+dnl  Maximum possible with the current code is 64.
+
+deflit(UNROLL_COUNT, 16)
+
+
+ifdef(`OPERATION_addmul_1',`
+	define(M4_inst,        addl)
+	define(M4_function_1,  mpn_addmul_1)
+	define(M4_function_1c, mpn_addmul_1c)
+	define(M4_description, add it to)
+	define(M4_desc_retval, carry)
+',`ifdef(`OPERATION_submul_1',`
+	define(M4_inst,        subl)
+	define(M4_function_1,  mpn_submul_1)
+	define(M4_function_1c, mpn_submul_1c)
+	define(M4_description, subtract it from)
+	define(M4_desc_retval, borrow)
+',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
+')')')
+
+MULFUNC_PROLOGUE(mpn_addmul_1 mpn_addmul_1c mpn_submul_1 mpn_submul_1c)
+
+
+C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                            mp_limb_t mult);
+C mp_limb_t M4_function_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                             mp_limb_t mult, mp_limb_t carry);
+C
+C Calculate src,size multiplied by mult and M4_description dst,size.
+C Return the M4_desc_retval limb from the top of the result.
+
+ifdef(`PIC',`
+deflit(UNROLL_THRESHOLD, 9)
+',`
+deflit(UNROLL_THRESHOLD, 6)
+')
+
+defframe(PARAM_CARRY,     20)
+defframe(PARAM_MULTIPLIER,16)
+defframe(PARAM_SIZE,      12)
+defframe(PARAM_SRC,       8)
+defframe(PARAM_DST,       4)
+deflit(`FRAME',0)
+
+defframe(SAVE_EBX, -4)
+defframe(SAVE_ESI, -8)
+defframe(SAVE_EDI, -12)
+defframe(SAVE_EBP, -16)
+deflit(SAVE_SIZE, 16)
+
+	.text
+	ALIGN(32)
+PROLOGUE(M4_function_1)
+	movl	PARAM_SIZE, %edx
+	movl	PARAM_SRC, %eax
+	xorl	%ecx, %ecx
+
+	decl	%edx
+	jnz	LF(M4_function_1c,start_1)
+
+	movl	(%eax), %eax
+	movl	PARAM_DST, %ecx
+
+	mull	PARAM_MULTIPLIER
+
+	M4_inst	%eax, (%ecx)
+	adcl	$0, %edx
+	movl	%edx, %eax
+
+	ret
+EPILOGUE()
+
+	ALIGN(16)
+PROLOGUE(M4_function_1c)
+	movl	PARAM_SIZE, %edx
+	movl	PARAM_SRC, %eax
+
+	decl	%edx
+	jnz	L(more_than_one_limb)
+
+	movl	(%eax), %eax
+	movl	PARAM_DST, %ecx
+
+	mull	PARAM_MULTIPLIER
+
+	addl	PARAM_CARRY, %eax
+
+	adcl	$0, %edx
+	M4_inst	%eax, (%ecx)
+
+	adcl	$0, %edx
+	movl	%edx, %eax
+
+	ret
+
+
+	C offset 0x44 so close enough to aligned
+L(more_than_one_limb):
+	movl	PARAM_CARRY, %ecx
+L(start_1):
+	C eax	src
+	C ecx	initial carry
+	C edx	size-1
+	subl	$SAVE_SIZE, %esp
+deflit(`FRAME',16)
+
+	movl	%ebx, SAVE_EBX
+	movl	%esi, SAVE_ESI
+	movl	%edx, %ebx	C size-1
+
+	movl	PARAM_SRC, %esi
+	movl	%ebp, SAVE_EBP
+	cmpl	$UNROLL_THRESHOLD, %edx
+
+	movl	PARAM_MULTIPLIER, %ebp
+	movl	%edi, SAVE_EDI
+
+	movl	(%esi), %eax	C src low limb
+	movl	PARAM_DST, %edi
+	ja	L(unroll)
+
+
+	C simple loop
+
+	leal	4(%esi,%ebx,4), %esi	C point one limb past last
+	leal	(%edi,%ebx,4), %edi	C point at last limb
+	negl	%ebx
+
+	C The movl to load the next source limb is done well ahead of the
+	C mul.  This is necessary for full speed, and leads to one limb
+	C handled separately at the end.
+
+L(simple):
+	C eax	src limb
+	C ebx	loop counter
+	C ecx	carry limb
+	C edx	scratch
+	C esi	src
+	C edi	dst
+	C ebp	multiplier
+
+	mull	%ebp
+
+	addl	%eax, %ecx
+	adcl	$0, %edx
+
+	M4_inst	%ecx, (%edi,%ebx,4)
+	movl	(%esi,%ebx,4), %eax
+	adcl	$0, %edx
+
+	incl	%ebx
+	movl	%edx, %ecx
+	jnz	L(simple)
+
+
+	mull	%ebp
+
+	movl	SAVE_EBX, %ebx
+	movl	SAVE_ESI, %esi
+	movl	SAVE_EBP, %ebp
+
+	addl	%eax, %ecx
+	adcl	$0, %edx
+
+	M4_inst	%ecx, (%edi)
+	adcl	$0, %edx
+	movl	SAVE_EDI, %edi
+
+	addl	$SAVE_SIZE, %esp
+	movl	%edx, %eax
+	ret
+
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(unroll):
+	C eax	src low limb
+	C ebx	size-1
+	C ecx	carry
+	C edx	size-1
+	C esi	src
+	C edi	dst
+	C ebp	multiplier
+	
+dnl  overlapping with parameters no longer needed
+define(VAR_COUNTER,`PARAM_SIZE')
+define(VAR_JUMP,   `PARAM_MULTIPLIER')
+
+	subl	$2, %ebx	C (size-2)-1
+	decl	%edx		C size-2
+	
+	shrl	$UNROLL_LOG2, %ebx
+	negl	%edx
+
+	movl	%ebx, VAR_COUNTER
+	andl	$UNROLL_MASK, %edx
+
+	movl	%edx, %ebx
+	shll	$4, %edx
+
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(here):
+',`
+	leal	L(entry) (%edx,%ebx,1), %edx
+')
+	negl	%ebx
+	movl	%edx, VAR_JUMP
+
+	mull	%ebp
+
+	addl	%eax, %ecx	C initial carry, becomes low carry
+	adcl	$0, %edx
+	testb	$1, %bl
+
+	movl	4(%esi), %eax	C src second limb
+	leal	ifelse(UNROLL_BYTES,256,128+) 8(%esi,%ebx,4), %esi
+	leal	ifelse(UNROLL_BYTES,256,128)   (%edi,%ebx,4), %edi
+
+	movl	%edx, %ebx	C high carry
+	cmovnz(	%ecx, %ebx)	C high,low carry other way around
+	cmovnz(	%edx, %ecx)
+
+	jmp	*VAR_JUMP
+
+
+ifdef(`PIC',`
+L(pic_calc):
+	C See README.family about old gas bugs
+	leal	(%edx,%ebx,1), %edx
+	addl	$L(entry)-L(here), %edx
+	addl	(%esp), %edx
+	ret
+')
+
+
+C -----------------------------------------------------------------------------
+C This code uses a "two carry limbs" scheme.  At the top of the loop the
+C carries are ebx=lo, ecx=hi, then they swap for each limb processed.  For
+C the computed jump an odd size means they start one way around, an even
+C size the other.  Either way one limb is handled separately at the start of
+C the loop.
+C
+C The positioning of the movl to load the next source limb is important.
+C Moving it after the adcl with a view to avoiding a separate mul at the end
+C of the loop slows the code down.
+
+	ALIGN(32)
+L(top):
+	C eax	src limb
+	C ebx	carry high
+	C ecx	carry low
+	C edx	scratch
+	C esi	src+8
+	C edi	dst
+	C ebp	multiplier
+	C
+	C VAR_COUNTER  loop counter
+	C
+	C 17 bytes each limb
+
+L(entry):
+deflit(CHUNK_COUNT,2)
+forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
+	deflit(`disp0', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
+	deflit(`disp1', eval(disp0 + 4))
+
+	mull	%ebp
+
+Zdisp(	M4_inst,%ecx, disp0,(%edi))
+	movl	$0, %ecx
+
+	adcl	%eax, %ebx
+
+Zdisp(	movl,	disp0,(%esi), %eax)
+	adcl	%edx, %ecx	
+
+
+	mull	%ebp
+
+	M4_inst	%ebx, disp1(%edi)
+	movl	$0, %ebx
+
+	adcl	%eax, %ecx
+
+	movl	disp1(%esi), %eax
+	adcl	%edx, %ebx
+')
+
+	decl	VAR_COUNTER
+	leal	UNROLL_BYTES(%esi), %esi
+	leal	UNROLL_BYTES(%edi), %edi
+
+	jns	L(top)
+
+
+	C eax	src limb
+	C ebx	carry high
+	C ecx	carry low
+	C edx
+	C esi
+	C edi	dst (points at second last limb)
+	C ebp	multiplier
+deflit(`disp0', ifelse(UNROLL_BYTES,256,-128))
+deflit(`disp1', eval(disp0-0 + 4))
+
+	mull	%ebp
+
+	M4_inst	%ecx, disp0(%edi)
+	movl	SAVE_EBP, %ebp
+
+	adcl	%ebx, %eax
+	movl	SAVE_EBX, %ebx
+	movl	SAVE_ESI, %esi
+
+	adcl	$0, %edx
+	M4_inst	%eax, disp1(%edi)
+	movl	SAVE_EDI, %edi
+
+	adcl	$0, %edx
+	addl	$SAVE_SIZE, %esp
+
+	movl	%edx, %eax
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/diveby3.asm b/src/gmp/mpn/x86/k7/diveby3.asm
new file mode 100644
index 000000000..57684958a
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/diveby3.asm
@@ -0,0 +1,131 @@
+dnl  AMD K7 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
+dnl 
+dnl  K7: 8.0 cycles/limb
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                              mp_limb_t carry);
+
+defframe(PARAM_CARRY,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,   8)
+defframe(PARAM_DST,   4)
+
+dnl  multiplicative inverse of 3, modulo 2^32
+deflit(INVERSE_3,        0xAAAAAAAB)
+
+dnl  ceil(b/3) and floor(b*2/3) where b=2^32
+deflit(ONE_THIRD_CEIL,   0x55555556)
+deflit(TWO_THIRDS_FLOOR, 0xAAAAAAAA)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_divexact_by3c)
+deflit(`FRAME',0)
+
+	movl	PARAM_SRC, %ecx
+	pushl	%ebx			defframe_pushl(SAVE_EBX)
+
+	movl	PARAM_CARRY, %ebx
+	pushl	%ebp			defframe_pushl(SAVE_EBP)
+
+	movl	PARAM_SIZE, %ebp
+	pushl	%edi			defframe_pushl(SAVE_EDI)
+
+	movl	(%ecx), %eax		C src low limb
+	pushl	%esi			defframe_pushl(SAVE_ESI)
+
+	movl	PARAM_DST, %edi
+	movl	$TWO_THIRDS_FLOOR, %esi
+	leal	-4(%ecx,%ebp,4), %ecx	C &src[size-1]
+
+	subl	%ebx, %eax
+
+	setc	%bl
+	decl	%ebp
+	jz	L(last)
+
+	leal	(%edi,%ebp,4), %edi	C &dst[size-1]
+	negl	%ebp
+
+
+	ALIGN(16)
+L(top):
+	C eax	src limb, carry subtracted
+	C ebx	carry limb (0 or 1)
+	C ecx	&src[size-1]
+	C edx	scratch
+	C esi	TWO_THIRDS_FLOOR
+	C edi	&dst[size-1]
+	C ebp	counter, limbs, negative
+
+	imull	$INVERSE_3, %eax, %edx
+
+	movl	4(%ecx,%ebp,4), %eax	C next src limb
+	cmpl	$ONE_THIRD_CEIL, %edx
+
+	sbbl	$-1, %ebx		C +1 if result>=ceil(b/3)
+	cmpl	%edx, %esi
+
+	sbbl	%ebx, %eax		C and further 1 if result>=ceil(b*2/3)
+	movl	%edx, (%edi,%ebp,4)
+	incl	%ebp
+
+	setc	%bl			C new carry
+	jnz	L(top)
+
+
+
+L(last):
+	C eax	src limb, carry subtracted
+	C ebx	carry limb (0 or 1)
+	C ecx	&src[size-1]
+	C edx	scratch
+	C esi	multiplier
+	C edi	&dst[size-1]
+	C ebp
+
+	imull	$INVERSE_3, %eax
+
+	cmpl	$ONE_THIRD_CEIL, %eax
+	movl	%eax, (%edi)
+	movl	SAVE_EBP, %ebp
+
+	sbbl	$-1, %ebx		C +1 if eax>=ceil(b/3)
+	cmpl	%eax, %esi
+	movl	$0, %eax
+
+	adcl	%ebx, %eax		C further +1 if eax>=ceil(b*2/3)
+	movl	SAVE_EDI, %edi
+	movl	SAVE_ESI, %esi
+
+	movl	SAVE_EBX, %ebx
+	addl	$FRAME, %esp
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/gmp-mparam.h b/src/gmp/mpn/x86/k7/gmp-mparam.h
new file mode 100644
index 000000000..c3bba0afc
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/gmp-mparam.h
@@ -0,0 +1,100 @@
+/* AMD K7 gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+
+/* the low limb is ready after 4 cycles, but normally it's the high limb
+   which is of interest, and that comes out after 6 cycles */
+#ifndef UMUL_TIME
+#define UMUL_TIME   6  /* cycles */
+#endif
+
+/* AMD doco says 40, but it measures 39 back-to-back */
+#ifndef UDIV_TIME
+#define UDIV_TIME   39  /* cycles */
+#endif
+
+/* using bsf */
+#ifndef COUNT_TRAILING_ZEROS_TIME
+#define COUNT_TRAILING_ZEROS_TIME   7  /* cycles */
+#endif
+
+
+/* Generated by tuneup.c, 2000-07-06. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   26
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD      177
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   52
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD      173
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              76
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD            114
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            34
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        5
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD          54
+#endif
+
+#ifndef FFT_MUL_TABLE
+#define FFT_MUL_TABLE  { 720, 1440, 2944, 7680, 18432, 57344, 0 }
+#endif
+#ifndef FFT_MODF_MUL_THRESHOLD
+#define FFT_MODF_MUL_THRESHOLD     736
+#endif
+#ifndef FFT_MUL_THRESHOLD
+#define FFT_MUL_THRESHOLD         6912
+#endif
+
+#ifndef FFT_SQR_TABLE
+#define FFT_SQR_TABLE  { 784, 1696, 3200, 7680, 18432, 57344, 0 }
+#endif
+#ifndef FFT_MODF_SQR_THRESHOLD
+#define FFT_MODF_SQR_THRESHOLD     800
+#endif
+#ifndef FFT_SQR_THRESHOLD
+#define FFT_SQR_THRESHOLD         8448
+#endif
diff --git a/src/gmp/mpn/x86/k7/mmx/copyd.asm b/src/gmp/mpn/x86/k7/mmx/copyd.asm
new file mode 100644
index 000000000..33214daa1
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/mmx/copyd.asm
@@ -0,0 +1,136 @@
+dnl  AMD K7 mpn_copyd -- copy limb vector, decrementing.
+dnl 
+dnl     alignment dst/src, A=0mod8 N=4mod8
+dnl        A/A   A/N   N/A   N/N
+dnl  K7    0.75  1.0   1.0   0.75
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C void mpn_copyd (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C The various comments in mpn/x86/k7/copyi.asm apply here too.
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+deflit(`FRAME',0)
+
+dnl  parameter space reused
+define(SAVE_EBX,`PARAM_SIZE')
+define(SAVE_ESI,`PARAM_SRC')
+
+dnl  minimum 5 since the unrolled code can't handle less than 5
+deflit(UNROLL_THRESHOLD, 5)
+
+	.text
+	ALIGN(32)
+PROLOGUE(mpn_copyd)
+
+	movl	PARAM_SIZE, %ecx
+	movl	%ebx, SAVE_EBX
+
+	movl	PARAM_SRC, %eax
+	movl	PARAM_DST, %edx
+
+	cmpl	$UNROLL_THRESHOLD, %ecx
+	jae	L(unroll)
+
+	orl	%ecx, %ecx
+	jz	L(simple_done)
+
+L(simple):
+	C eax	src
+	C ebx	scratch
+	C ecx	counter
+	C edx	dst
+	C
+	C this loop is 2 cycles/limb
+
+	movl	-4(%eax,%ecx,4), %ebx
+	movl	%ebx, -4(%edx,%ecx,4)
+	decl	%ecx
+	jnz	L(simple)
+
+L(simple_done):
+	movl	SAVE_EBX, %ebx
+	ret
+
+
+L(unroll):
+	movl	%esi, SAVE_ESI
+	leal	(%eax,%ecx,4), %ebx
+	leal	(%edx,%ecx,4), %esi
+
+	andl	%esi, %ebx
+	movl	SAVE_ESI, %esi
+	subl	$4, %ecx		C size-4
+
+	testl	$4, %ebx   C testl to pad code closer to 16 bytes for L(top)
+	jz	L(aligned)
+
+	C both src and dst unaligned, process one limb to align them
+	movl	12(%eax,%ecx,4), %ebx
+	movl	%ebx, 12(%edx,%ecx,4)
+	decl	%ecx
+L(aligned):
+
+
+	ALIGN(16)
+L(top):
+	C eax	src
+	C ebx
+	C ecx	counter, limbs
+	C edx	dst
+
+	movq	8(%eax,%ecx,4), %mm0
+	movq	(%eax,%ecx,4), %mm1
+	subl	$4, %ecx
+	movq	%mm0, 16+8(%edx,%ecx,4)
+	movq	%mm1, 16(%edx,%ecx,4)
+	jns	L(top)
+
+
+	C now %ecx is -4 to -1 representing respectively 0 to 3 limbs remaining
+
+	testb	$2, %cl
+	jz	L(finish_not_two)
+
+	movq	8(%eax,%ecx,4), %mm0
+	movq	%mm0, 8(%edx,%ecx,4)
+L(finish_not_two):
+
+	testb	$1, %cl
+	jz	L(done)
+
+	movl	(%eax), %ebx
+	movl	%ebx, (%edx)
+
+L(done):
+	movl	SAVE_EBX, %ebx
+	emms
+	ret
+
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/mmx/copyi.asm b/src/gmp/mpn/x86/k7/mmx/copyi.asm
new file mode 100644
index 000000000..b234a1628
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/mmx/copyi.asm
@@ -0,0 +1,147 @@
+dnl  AMD K7 mpn_copyi -- copy limb vector, incrementing.
+dnl 
+dnl     alignment dst/src, A=0mod8 N=4mod8
+dnl        A/A   A/N   N/A   N/N
+dnl  K7    0.75  1.0   1.0   0.75
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C void mpn_copyi (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C Copy src,size to dst,size.
+C
+C This code at 0.75 or 1.0 c/l is always faster than a plain rep movsl at
+C 1.33 c/l.
+C
+C The K7 can do two loads, or two stores, or a load and a store, in one
+C cycle, so if those are 64-bit operations then 0.5 c/l should be possible,
+C however nothing under 0.7 c/l is known.
+C
+C If both source and destination are unaligned then one limb is processed at
+C the start to make them aligned and so get 0.75 c/l, whereas if they'd been
+C used unaligned it would be 1.5 c/l.
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+
+dnl  parameter space reused
+define(SAVE_EBX,`PARAM_SIZE')
+
+dnl  minimum 5 since the unrolled code can't handle less than 5
+deflit(UNROLL_THRESHOLD, 5)
+
+	.text
+	ALIGN(32)
+PROLOGUE(mpn_copyi)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	movl	%ebx, SAVE_EBX
+
+	movl	PARAM_SRC, %eax
+	movl	PARAM_DST, %edx
+
+	cmpl	$UNROLL_THRESHOLD, %ecx
+	jae	L(unroll)
+
+	orl	%ecx, %ecx
+	jz	L(simple_done)
+
+L(simple):
+	C eax	src, incrementing
+	C ebx	scratch
+	C ecx	counter
+	C edx	dst, incrementing
+	C
+	C this loop is 2 cycles/limb
+
+	movl	(%eax), %ebx
+	movl	%ebx, (%edx)
+	decl	%ecx
+	leal	4(%eax), %eax
+	leal	4(%edx), %edx
+	jnz	L(simple)
+
+L(simple_done):
+	movl	SAVE_EBX, %ebx
+	ret
+
+
+L(unroll):
+	movl	%eax, %ebx
+	leal	-12(%eax,%ecx,4), %eax	C src end - 12
+	subl	$3, %ecx		C size-3
+
+	andl	%edx, %ebx
+	leal	(%edx,%ecx,4), %edx	C dst end - 12
+	negl	%ecx
+
+	testl	$4, %ebx   C testl to pad code closer to 16 bytes for L(top)
+	jz	L(aligned)
+
+	C both src and dst unaligned, process one limb to align them
+	movl	(%eax,%ecx,4), %ebx
+	movl	%ebx, (%edx,%ecx,4)
+	incl	%ecx
+L(aligned):
+
+
+	ALIGN(16)
+L(top):
+	C eax	src end - 12
+	C ebx
+	C ecx	counter, negative, limbs
+	C edx	dst end - 12
+
+	movq	(%eax,%ecx,4), %mm0
+	movq	8(%eax,%ecx,4), %mm1
+	addl	$4, %ecx
+	movq	%mm0, -16(%edx,%ecx,4)
+	movq	%mm1, -16+8(%edx,%ecx,4)
+	ja	L(top)		C jump no carry and not zero
+
+
+	C now %ecx is 0 to 3 representing respectively 3 to 0 limbs remaining
+
+	testb	$2, %cl
+	jnz	L(finish_not_two)
+
+	movq	(%eax,%ecx,4), %mm0
+	movq	%mm0, (%edx,%ecx,4)
+L(finish_not_two):
+
+	testb	$1, %cl
+	jnz	L(done)
+
+	movl	8(%eax), %ebx
+	movl	%ebx, 8(%edx)
+
+L(done):
+	movl	SAVE_EBX, %ebx
+	emms
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/mmx/divrem_1.asm b/src/gmp/mpn/x86/k7/mmx/divrem_1.asm
new file mode 100644
index 000000000..483ad6a9a
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/mmx/divrem_1.asm
@@ -0,0 +1,718 @@
+dnl  AMD K7 mpn_divrem_1 -- mpn by limb division.
+dnl 
+dnl  K7: 17.0 cycles/limb integer part, 15.0 cycles/limb fraction part.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_divrem_1 (mp_ptr dst, mp_size_t xsize,
+C                         mp_srcptr src, mp_size_t size,
+C                         mp_limb_t divisor);
+C mp_limb_t mpn_divrem_1c (mp_ptr dst, mp_size_t xsize,
+C                          mp_srcptr src, mp_size_t size,
+C                          mp_limb_t divisor, mp_limb_t carry);
+C
+C The method and nomenclature follow part 8 of "Division by Invariant
+C Integers using Multiplication" by Granlund and Montgomery, reference in
+C gmp.texi.
+C
+C The "and"s shown in the paper are done here with "cmov"s.  "m" is written
+C for m', and "d" for d_norm, which won't cause any confusion since it's
+C only the normalized divisor that's of any use in the code.  "b" is written
+C for 2^N, the size of a limb, N being 32 here.
+C
+C mpn_divrem_1 avoids one division if the src high limb is less than the
+C divisor.  mpn_divrem_1c doesn't check for a zero carry, since in normal
+C circumstances that will be a very rare event.
+C
+C There's a small bias towards expecting xsize==0, by having code for
+C xsize==0 in a straight line and xsize!=0 under forward jumps.
+
+
+dnl  MUL_THRESHOLD is the value of xsize+size at which the multiply by
+dnl  inverse method is used, rather than plain "divl"s.  Minimum value 1.
+dnl
+dnl  The inverse takes about 50 cycles to calculate, but after that the
+dnl  multiply is 17 c/l versus division at 42 c/l.
+dnl
+dnl  At 3 limbs the mul is a touch faster than div on the integer part, and
+dnl  even more so on the fractional part.
+
+deflit(MUL_THRESHOLD, 3)
+
+
+defframe(PARAM_CARRY,  24)
+defframe(PARAM_DIVISOR,20)
+defframe(PARAM_SIZE,   16)
+defframe(PARAM_SRC,    12)
+defframe(PARAM_XSIZE,  8)
+defframe(PARAM_DST,    4)
+
+defframe(SAVE_EBX,    -4)
+defframe(SAVE_ESI,    -8)
+defframe(SAVE_EDI,    -12)
+defframe(SAVE_EBP,    -16)
+
+defframe(VAR_NORM,    -20)
+defframe(VAR_INVERSE, -24)
+defframe(VAR_SRC,     -28)
+defframe(VAR_DST,     -32)
+defframe(VAR_DST_STOP,-36)
+
+deflit(STACK_SPACE, 36)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_divrem_1c)
+deflit(`FRAME',0)
+	movl	PARAM_CARRY, %edx
+	movl	PARAM_SIZE, %ecx
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%ebx, SAVE_EBX
+	movl	PARAM_XSIZE, %ebx
+
+	movl	%edi, SAVE_EDI
+	movl	PARAM_DST, %edi
+
+	movl	%ebp, SAVE_EBP
+	movl	PARAM_DIVISOR, %ebp
+
+	movl	%esi, SAVE_ESI
+	movl	PARAM_SRC, %esi
+
+	leal	-4(%edi,%ebx,4), %edi
+	jmp	LF(mpn_divrem_1,start_1c)
+
+EPILOGUE()
+
+
+	C offset 0x31, close enough to aligned
+PROLOGUE(mpn_divrem_1)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	movl	$0, %edx		C initial carry (if can't skip a div)
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%ebp, SAVE_EBP
+	movl	PARAM_DIVISOR, %ebp
+
+	movl	%ebx, SAVE_EBX
+	movl	PARAM_XSIZE, %ebx
+
+	movl	%esi, SAVE_ESI
+	movl	PARAM_SRC, %esi
+	orl	%ecx, %ecx
+
+	movl	%edi, SAVE_EDI
+	movl	PARAM_DST, %edi
+	leal	-4(%edi,%ebx,4), %edi	C &dst[xsize-1]
+
+	jz	L(no_skip_div)
+	movl	-4(%esi,%ecx,4), %eax	C src high limb
+
+	cmpl	%ebp, %eax		C one less div if high<divisor
+	jnb	L(no_skip_div)
+
+	movl	$0, (%edi,%ecx,4)	C dst high limb
+	decl	%ecx			C size-1
+	movl	%eax, %edx		C src high limb as initial carry
+L(no_skip_div):
+
+
+L(start_1c):
+	C eax	
+	C ebx	xsize
+	C ecx	size
+	C edx	carry
+	C esi	src
+	C edi	&dst[xsize-1]
+	C ebp	divisor
+
+	leal	(%ebx,%ecx), %eax	C size+xsize
+	cmpl	$MUL_THRESHOLD, %eax
+	jae	L(mul_by_inverse)
+
+
+C With MUL_THRESHOLD set to 3, the simple loops here only do 0 to 2 limbs.
+C It'd be possible to write them out without the looping, but no speedup
+C would be expected.
+C
+C Using PARAM_DIVISOR instead of %ebp measures 1 cycle/loop faster on the
+C integer part, but curiously not on the fractional part, where %ebp is a
+C (fixed) couple of cycles faster.
+
+	orl	%ecx, %ecx
+	jz	L(divide_no_integer)
+
+L(divide_integer):
+	C eax	scratch (quotient)
+	C ebx	xsize
+	C ecx	counter
+	C edx	scratch (remainder)
+	C esi	src
+	C edi	&dst[xsize-1]
+	C ebp	divisor
+
+	movl	-4(%esi,%ecx,4), %eax
+
+	divl	PARAM_DIVISOR
+
+	movl	%eax, (%edi,%ecx,4)
+	decl	%ecx
+	jnz	L(divide_integer)
+
+
+L(divide_no_integer):
+	movl	PARAM_DST, %edi
+	orl	%ebx, %ebx
+	jnz	L(divide_fraction)
+
+L(divide_done):
+	movl	SAVE_ESI, %esi
+	movl	SAVE_EDI, %edi
+	movl	%edx, %eax
+
+	movl	SAVE_EBX, %ebx
+	movl	SAVE_EBP, %ebp
+	addl	$STACK_SPACE, %esp
+
+	ret
+
+
+L(divide_fraction):
+	C eax	scratch (quotient)
+	C ebx	counter
+	C ecx
+	C edx	scratch (remainder)
+	C esi
+	C edi	dst
+	C ebp	divisor
+
+	movl	$0, %eax
+
+	divl	%ebp
+
+	movl	%eax, -4(%edi,%ebx,4)
+	decl	%ebx
+	jnz	L(divide_fraction)
+
+	jmp	L(divide_done)
+
+
+
+C -----------------------------------------------------------------------------
+
+L(mul_by_inverse):
+	C eax
+	C ebx	xsize
+	C ecx	size
+	C edx	carry
+	C esi	src
+	C edi	&dst[xsize-1]
+	C ebp	divisor
+
+	bsrl	%ebp, %eax		C 31-l
+
+	leal	12(%edi), %ebx
+	leal	4(%edi,%ecx,4), %edi	C &dst[xsize+size]
+
+	movl	%edi, VAR_DST
+	movl	%ebx, VAR_DST_STOP
+
+	movl	%ecx, %ebx		C size
+	movl	$31, %ecx
+
+	movl	%edx, %edi		C carry
+	movl	$-1, %edx
+
+	C
+
+	xorl	%eax, %ecx		C l
+	incl	%eax			C 32-l
+
+	shll	%cl, %ebp		C d normalized
+	movl	%ecx, VAR_NORM
+
+	movd	%eax, %mm7
+
+	movl	$-1, %eax
+	subl	%ebp, %edx		C (b-d)-1 giving edx:eax = b*(b-d)-1
+
+	divl	%ebp			C floor (b*(b-d)-1) / d
+
+	orl	%ebx, %ebx		C size
+	movl	%eax, VAR_INVERSE
+	leal	-12(%esi,%ebx,4), %eax	C &src[size-3]
+
+	jz	L(start_zero)
+	movl	%eax, VAR_SRC
+	cmpl	$1, %ebx
+
+	movl	8(%eax), %esi		C src high limb
+	jz	L(start_one)
+
+L(start_two_or_more):
+	movl	4(%eax), %edx		C src second highest limb
+
+	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
+
+	shldl(	%cl, %edx, %esi)	C n10 = high,second << l
+
+	cmpl	$2, %ebx
+	je	L(integer_two_left)
+	jmp	L(integer_top)
+
+
+L(start_one):
+	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
+
+	shll	%cl, %esi		C n10 = high << l
+	movl	%eax, VAR_SRC
+	jmp	L(integer_one_left)
+
+
+L(start_zero):
+	shll	%cl, %edi		C n2 = carry << l
+	movl	$0, %esi		C n10 = 0
+
+	C we're here because xsize+size>=MUL_THRESHOLD, so with size==0 then
+	C must have xsize!=0
+	jmp	L(fraction_some)
+
+
+
+C -----------------------------------------------------------------------------
+C
+C The multiply by inverse loop is 17 cycles, and relies on some out-of-order
+C execution.  The instruction scheduling is important, with various
+C apparently equivalent forms running 1 to 5 cycles slower.
+C
+C A lower bound for the time would seem to be 16 cycles, based on the
+C following successive dependencies.
+C
+C		      cycles
+C		n2+n1	1
+C		mul	6
+C		q1+1	1
+C		mul	6
+C		sub	1
+C		addback	1
+C		       ---
+C		       16
+C
+C This chain is what the loop has already, but 16 cycles isn't achieved.
+C K7 has enough decode, and probably enough execute (depending maybe on what
+C a mul actually consumes), but nothing running under 17 has been found.
+C
+C In theory n2+n1 could be done in the sub and addback stages (by
+C calculating both n2 and n2+n1 there), but lack of registers makes this an
+C unlikely proposition.
+C
+C The jz in the loop keeps the q1+1 stage to 1 cycle.  Handling an overflow
+C from q1+1 with an "sbbl $0, %ebx" would add a cycle to the dependent
+C chain, and nothing better than 18 cycles has been found when using it.
+C The jump is taken only when q1 is 0xFFFFFFFF, and on random data this will
+C be an extremely rare event.
+C
+C Branch mispredictions will hit random occurrances of q1==0xFFFFFFFF, but
+C if some special data is coming out with this always, the q1_ff special
+C case actually runs at 15 c/l.  0x2FFF...FFFD divided by 3 is a good way to
+C induce the q1_ff case, for speed measurements or testing.  Note that
+C 0xFFF...FFF divided by 1 or 2 doesn't induce it.
+C
+C The instruction groupings and empty comments show the cycles for a naive
+C in-order view of the code (conveniently ignoring the load latency on
+C VAR_INVERSE).  This shows some of where the time is going, but is nonsense
+C to the extent that out-of-order execution rearranges it.  In this case
+C there's 19 cycles shown, but it executes at 17.
+
+	ALIGN(16)
+L(integer_top):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	scratch (src, dst)
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	scratch (src qword)
+	C mm7	rshift for normalization
+
+	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
+	movl	%edi, %eax         C n2
+	movl	VAR_SRC, %ecx
+
+	leal	(%ebp,%esi), %ebx
+	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
+	sbbl	$-1, %eax          C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	movq	(%ecx), %mm0       C next limb and the one below it
+	subl	$4, %ecx
+
+	movl	%ecx, VAR_SRC
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+	movl	%ebp, %eax	   C d
+
+	C
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+	jz	L(q1_ff)
+	movl	VAR_DST, %ecx
+
+	mull	%ebx		   C (q1+1)*d
+
+	psrlq	%mm7, %mm0
+
+	leal	-4(%ecx), %ecx
+
+	C
+
+	subl	%eax, %esi
+	movl	VAR_DST_STOP, %eax
+
+	C
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	movd	%mm0, %esi
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+	sbbl	$0, %ebx	   C q
+	cmpl	%eax, %ecx
+
+	movl	%ebx, (%ecx)
+	movl	%ecx, VAR_DST
+	jne	L(integer_top)
+
+
+L(integer_loop_done):
+
+
+C -----------------------------------------------------------------------------
+C
+C Here, and in integer_one_left below, an sbbl $0 is used rather than a jz
+C q1_ff special case.  This make the code a bit smaller and simpler, and
+C costs only 1 cycle (each).
+
+L(integer_two_left):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	scratch (src, dst)
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	src limb, shifted
+	C mm7	rshift
+
+	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
+	movl	%edi, %eax         C n2
+	movl	PARAM_SRC, %ecx
+
+	leal	(%ebp,%esi), %ebx
+	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
+	sbbl	$-1, %eax          C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	movd	(%ecx), %mm0	   C src low limb
+
+	movl	VAR_DST_STOP, %ecx
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+	movl	%ebp, %eax	   C d
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+
+	sbbl	$0, %ebx
+
+	mull	%ebx		   C (q1+1)*d
+
+	psllq	$32, %mm0
+
+	psrlq	%mm7, %mm0
+
+	C
+
+	subl	%eax, %esi
+
+	C
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	movd	%mm0, %esi
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+	sbbl	$0, %ebx	   C q
+
+	movl	%ebx, -4(%ecx)
+
+
+C -----------------------------------------------------------------------------
+L(integer_one_left):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	dst
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	src limb, shifted
+	C mm7	rshift
+
+	movl	VAR_DST_STOP, %ecx
+	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
+	movl	%edi, %eax         C n2
+
+	leal	(%ebp,%esi), %ebx
+	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
+	sbbl	$-1, %eax          C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	C
+
+	C
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+	movl	%ebp, %eax	   C d
+
+	C
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+
+	sbbl	$0, %ebx           C q1 if q1+1 overflowed
+
+	mull	%ebx
+
+	C
+
+	C
+
+	C
+
+	subl	%eax, %esi
+
+	C
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+	sbbl	$0, %ebx	   C q
+
+	movl	%ebx, -8(%ecx)
+	subl	$8, %ecx
+
+
+
+L(integer_none):
+	cmpl	$0, PARAM_XSIZE
+	jne	L(fraction_some)
+
+	movl	%edi, %eax
+L(fraction_done):
+	movl	VAR_NORM, %ecx
+	movl	SAVE_EBP, %ebp
+
+	movl	SAVE_EDI, %edi
+	movl	SAVE_ESI, %esi
+
+	movl	SAVE_EBX, %ebx
+	addl	$STACK_SPACE, %esp
+
+	shrl	%cl, %eax
+	emms
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+C
+C Special case for q1=0xFFFFFFFF, giving q=0xFFFFFFFF meaning the low dword
+C of q*d is simply -d and the remainder n-q*d = n10+d
+
+L(q1_ff):
+	C eax	(divisor)
+	C ebx	(q1+1 == 0)
+	C ecx
+	C edx
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+
+	movl	VAR_DST, %ecx
+	movl	VAR_DST_STOP, %edx
+	subl	$4, %ecx
+
+	psrlq	%mm7, %mm0
+	leal	(%ebp,%esi), %edi	C n-q*d remainder -> next n2
+	movl	%ecx, VAR_DST
+
+	movd	%mm0, %esi		C next n10
+
+	movl	$-1, (%ecx)
+	cmpl	%ecx, %edx
+	jne	L(integer_top)
+
+	jmp	L(integer_loop_done)
+
+
+
+C -----------------------------------------------------------------------------
+C
+C Being the fractional part, the "source" limbs are all zero, meaning
+C n10=0, n1=0, and hence nadj=0, leading to many instructions eliminated.
+C
+C The loop runs at 15 cycles.  The dependent chain is the same as the
+C general case above, but without the n2+n1 stage (due to n1==0), so 15
+C would seem to be the lower bound.
+C
+C A not entirely obvious simplification is that q1+1 never overflows a limb,
+C and so there's no need for the sbbl $0 or jz q1_ff from the general case.
+C q1 is the high word of m*n2+b*n2 and the following shows q1<=b-2 always.
+C rnd() means rounding down to a multiple of d.
+C
+C	m*n2 + b*n2 <= m*(d-1) + b*(d-1)
+C	             = m*d + b*d - m - b
+C	             = floor((b(b-d)-1)/d)*d + b*d - m - b
+C	             = rnd(b(b-d)-1) + b*d - m - b
+C	             = rnd(b(b-d)-1 + b*d) - m - b
+C	             = rnd(b*b-1) - m - b
+C	             <= (b-2)*b
+C
+C Unchanged from the general case is that the final quotient limb q can be
+C either q1 or q1+1, and the q1+1 case occurs often.  This can be seen from
+C equation 8.4 of the paper which simplifies as follows when n1==0 and
+C n0==0.
+C
+C	n-q1*d = (n2*k+q0*d)/b <= d + (d*d-2d)/b
+C
+C As before, the instruction groupings and empty comments show a naive
+C in-order view of the code, which is made a nonsense by out of order
+C execution.  There's 17 cycles shown, but it executes at 15.
+C
+C Rotating the store q and remainder->n2 instructions up to the top of the
+C loop gets the run time down from 16 to 15.
+
+	ALIGN(16)
+L(fraction_some):
+	C eax
+	C ebx
+	C ecx
+	C edx
+	C esi
+	C edi	carry
+	C ebp	divisor
+
+	movl	PARAM_DST, %esi
+	movl	VAR_DST_STOP, %ecx
+	movl	%edi, %eax
+
+	subl	$8, %ecx
+
+	jmp	L(fraction_entry)
+
+
+	ALIGN(16)
+L(fraction_top):
+	C eax	n2 carry, then scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	dst, decrementing
+	C edx	scratch
+	C esi	dst stop point
+	C edi	(will be n2)
+	C ebp	divisor
+
+	movl	%ebx, (%ecx)	C previous q
+	movl	%eax, %edi	C remainder->n2
+
+L(fraction_entry):
+	mull	VAR_INVERSE	C m*n2
+
+	movl	%ebp, %eax	C d
+	subl	$4, %ecx	C dst
+	leal	1(%edi), %ebx
+
+	C
+
+	C
+
+	C
+
+	C
+
+	addl	%edx, %ebx	C 1 + high(n2<<32 + m*n2) = q1+1
+
+	mull	%ebx		C (q1+1)*d
+
+	C
+
+	C
+
+	C
+
+	negl	%eax		C low of n - (q1+1)*d
+
+	C
+
+ 	sbbl	%edx, %edi	C high of n - (q1+1)*d, caring only about carry
+ 	leal	(%ebp,%eax), %edx
+
+ 	cmovc(	%edx, %eax)	C n - q1*d if underflow from using q1+1
+ 	sbbl	$0, %ebx	C q
+ 	cmpl	%esi, %ecx
+
+	jne	L(fraction_top)
+
+
+	movl	%ebx, (%ecx)
+	jmp	L(fraction_done)
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/mmx/lshift.asm b/src/gmp/mpn/x86/k7/mmx/lshift.asm
new file mode 100644
index 000000000..4d17c881e
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/mmx/lshift.asm
@@ -0,0 +1,472 @@
+dnl  AMD K7 mpn_lshift -- mpn left shift.
+dnl 
+dnl  K7: 1.21 cycles/limb (at 16 limbs/loop).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K7: UNROLL_COUNT cycles/limb
+dnl           4           1.51
+dnl           8           1.26
+dnl          16           1.21
+dnl          32           1.2
+dnl  Maximum possible with the current code is 64.
+
+deflit(UNROLL_COUNT, 16)
+
+
+C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+C Shift src,size left by shift many bits and store the result in dst,size.
+C Zeros are shifted in at the right.  The bits shifted out at the left are
+C the return value.
+C
+C The comments in mpn_rshift apply here too.
+
+ifdef(`PIC',`
+deflit(UNROLL_THRESHOLD, 10)
+',`
+deflit(UNROLL_THRESHOLD, 10)
+')
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+
+defframe(SAVE_EDI, -4)
+defframe(SAVE_ESI, -8)
+defframe(SAVE_EBX, -12)
+deflit(SAVE_SIZE, 12)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_lshift)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %eax
+	movl	PARAM_SRC, %edx
+	subl	$SAVE_SIZE, %esp
+deflit(`FRAME',SAVE_SIZE)
+
+	movl	PARAM_SHIFT, %ecx
+	movl	%edi, SAVE_EDI
+
+	movl	PARAM_DST, %edi
+	decl	%eax
+	jnz	L(more_than_one_limb)
+
+	movl	(%edx), %edx
+
+	shldl(	%cl, %edx, %eax)	C eax was decremented to zero
+
+ 	shll	%cl, %edx
+
+	movl	%edx, (%edi)
+	movl	SAVE_EDI, %edi
+	addl	$SAVE_SIZE, %esp
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+L(more_than_one_limb):
+	C eax	size-1
+	C ebx
+	C ecx	shift
+	C edx	src
+	C esi
+	C edi	dst
+	C ebp
+
+	movd	PARAM_SHIFT, %mm6
+	movd	(%edx,%eax,4), %mm5	C src high limb
+	cmp	$UNROLL_THRESHOLD-1, %eax
+
+	jae	L(unroll)
+	negl	%ecx
+	movd	(%edx), %mm4		C src low limb
+
+	addl	$32, %ecx
+
+	movd	%ecx, %mm7
+
+L(simple_top):
+	C eax	loop counter, limbs
+	C ebx
+	C ecx
+	C edx	src
+	C esi
+	C edi	dst
+	C ebp
+	C
+	C mm0	scratch
+	C mm4	src low limb
+	C mm5	src high limb
+	C mm6	shift
+	C mm7	32-shift
+
+	movq	-4(%edx,%eax,4), %mm0
+	decl	%eax
+
+ 	psrlq	%mm7, %mm0
+
+	movd	%mm0, 4(%edi,%eax,4)
+	jnz	L(simple_top)
+
+
+	psllq	%mm6, %mm5
+ 	psllq	%mm6, %mm4
+
+	psrlq	$32, %mm5
+	movd	%mm4, (%edi)		C dst low limb
+
+	movd	%mm5, %eax		C return value
+
+	movl	SAVE_EDI, %edi
+	addl	$SAVE_SIZE, %esp
+	emms
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(unroll):
+	C eax	size-1
+	C ebx	(saved)
+	C ecx	shift
+	C edx	src
+	C esi
+	C edi	dst
+	C ebp
+	C
+	C mm5	src high limb, for return value
+	C mm6	lshift
+
+	movl	%esi, SAVE_ESI
+	movl	%ebx, SAVE_EBX
+	leal	-4(%edx,%eax,4), %edx   C &src[size-2]
+
+	testb	$4, %dl
+	movq	(%edx), %mm1		C src high qword
+
+	jz	L(start_src_aligned)
+
+
+	C src isn't aligned, process high limb (marked xxx) separately to
+	C make it so
+	C
+	C  source    -4(edx,%eax,4)
+	C                  |
+	C  +-------+-------+-------+--
+	C  |  xxx          |
+	C  +-------+-------+-------+--
+	C        0mod8   4mod8   0mod8
+	C
+	C  dest      -4(edi,%eax,4)
+	C                  |
+	C  +-------+-------+--
+	C  |  xxx  |       |  
+	C  +-------+-------+--
+
+	psllq	%mm6, %mm1
+	subl	$4, %edx
+	movl	%eax, PARAM_SIZE	C size-1
+
+	psrlq	$32, %mm1
+	decl	%eax			C size-2 is new size-1
+
+	movd	%mm1, 4(%edi,%eax,4)
+	movq	(%edx), %mm1		C new src high qword
+L(start_src_aligned):
+
+
+        leal    -4(%edi,%eax,4), %edi   C &dst[size-2]
+	psllq	%mm6, %mm5
+
+	testl	$4, %edi
+	psrlq	$32, %mm5		C return value
+
+	jz	L(start_dst_aligned)
+
+
+	C dst isn't aligned, subtract 4 bytes to make it so, and pretend the
+	C shift is 32 bits extra.  High limb of dst (marked xxx) handled
+	C here separately.
+	C
+	C  source       %edx
+	C  +-------+-------+--
+	C  |      mm1      |  
+	C  +-------+-------+--
+	C                0mod8   4mod8
+	C
+	C  dest         %edi
+	C  +-------+-------+-------+--
+	C  |  xxx  |          
+	C  +-------+-------+-------+--
+	C        0mod8   4mod8   0mod8
+
+	movq	%mm1, %mm0
+	psllq	%mm6, %mm1
+	addl	$32, %ecx		C shift+32
+
+	psrlq	$32, %mm1
+
+	movd	%mm1, 4(%edi)
+	movq	%mm0, %mm1
+	subl	$4, %edi
+
+	movd	%ecx, %mm6		C new lshift
+L(start_dst_aligned):
+
+	decl	%eax			C size-2, two last limbs handled at end
+	movq	%mm1, %mm2		C copy of src high qword
+	negl	%ecx
+
+	andl	$-2, %eax		C round size down to even
+	addl	$64, %ecx
+
+	movl	%eax, %ebx
+	negl	%eax
+
+	andl	$UNROLL_MASK, %eax
+	decl	%ebx
+
+	shll	%eax
+
+	movd	%ecx, %mm7		C rshift = 64-lshift
+
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(here):
+',`
+	leal	L(entry) (%eax,%eax,4), %esi
+')
+	shrl	$UNROLL_LOG2, %ebx	C loop counter
+
+	leal	ifelse(UNROLL_BYTES,256,128) -8(%edx,%eax,2), %edx
+	leal	ifelse(UNROLL_BYTES,256,128) (%edi,%eax,2), %edi
+	movl	PARAM_SIZE, %eax	C for use at end
+	jmp	*%esi
+
+
+ifdef(`PIC',`
+L(pic_calc):
+	C See README.family about old gas bugs
+	leal	(%eax,%eax,4), %esi
+	addl	$L(entry)-L(here), %esi
+	addl	(%esp), %esi
+
+	ret
+')
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(32)
+L(top):
+	C eax	size (for use at end)
+	C ebx	loop counter
+	C ecx	rshift
+	C edx	src
+	C esi	computed jump
+	C edi	dst
+	C ebp
+	C
+	C mm0	scratch
+	C mm1	\ carry (alternating, mm2 first)
+	C mm2	/
+	C mm6	lshift
+	C mm7	rshift
+	C
+	C 10 code bytes/limb
+	C
+	C The two chunks differ in whether mm1 or mm2 hold the carry.
+	C The computed jump puts the initial carry in both mm1 and mm2.
+	
+L(entry):
+deflit(CHUNK_COUNT, 4)
+forloop(i, 0, UNROLL_COUNT/CHUNK_COUNT-1, `
+	deflit(`disp0', eval(-i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
+	deflit(`disp1', eval(disp0 - 8))
+
+ 	movq	disp0(%edx), %mm0
+ 	psllq	%mm6, %mm2
+
+ 	movq	%mm0, %mm1
+ 	psrlq	%mm7, %mm0
+
+ 	por	%mm2, %mm0
+ 	movq	%mm0, disp0(%edi)
+
+
+ 	movq	disp1(%edx), %mm0
+ 	psllq	%mm6, %mm1
+
+ 	movq	%mm0, %mm2
+ 	psrlq	%mm7, %mm0
+
+ 	por	%mm1, %mm0
+ 	movq	%mm0, disp1(%edi)
+')
+
+	subl	$UNROLL_BYTES, %edx
+	subl	$UNROLL_BYTES, %edi
+	decl	%ebx
+
+	jns	L(top)
+
+
+
+define(`disp', `m4_empty_if_zero(eval($1 ifelse(UNROLL_BYTES,256,-128)))')
+
+L(end):
+	testb	$1, %al
+	movl	SAVE_EBX, %ebx
+	psllq	%mm6, %mm2	C wanted left shifted in all cases below
+
+	movd	%mm5, %eax
+
+	movl	SAVE_ESI, %esi
+	jz	L(end_even)
+
+
+L(end_odd):
+
+	C Size odd, destination was aligned.
+	C
+	C                 source        edx+8   edx+4
+	C                 --+---------------+-------+
+	C                   |      mm2      |       |
+	C                 --+---------------+-------+
+	C
+	C dest                            edi
+	C --+---------------+---------------+-------+
+	C   |   written     |               |       |
+	C --+---------------+---------------+-------+
+	C
+	C mm6 = shift
+	C mm7 = ecx = 64-shift
+
+
+	C Size odd, destination was unaligned.
+	C
+	C                 source        edx+8   edx+4
+	C                 --+---------------+-------+
+	C                   |      mm2      |       |
+	C                 --+---------------+-------+
+	C
+	C         dest                            edi
+	C         --+---------------+---------------+
+	C           |   written     |               |
+	C         --+---------------+---------------+
+	C
+	C mm6 = shift+32
+	C mm7 = ecx = 64-(shift+32)
+
+
+	C In both cases there's one extra limb of src to fetch and combine
+	C with mm2 to make a qword at (%edi), and in the aligned case
+	C there's an extra limb of dst to be formed from that extra src limb
+	C left shifted.
+
+	movd	disp(4) (%edx), %mm0
+	testb	$32, %cl
+
+	movq	%mm0, %mm1
+	psllq	$32, %mm0
+
+	psrlq	%mm7, %mm0
+	psllq	%mm6, %mm1
+
+	por	%mm2, %mm0
+
+	movq	%mm0, disp(0) (%edi)
+	jz	L(end_odd_unaligned)
+	movd	%mm1, disp(-4) (%edi)
+L(end_odd_unaligned):
+
+	movl	SAVE_EDI, %edi
+	addl	$SAVE_SIZE, %esp
+	emms
+
+	ret
+
+
+L(end_even):
+
+	C Size even, destination was aligned.
+	C
+	C                 source        edx+8
+	C                 --+---------------+
+	C                   |      mm2      |
+	C                 --+---------------+
+	C
+	C dest                            edi
+	C --+---------------+---------------+
+	C   |   written     |               |
+	C --+---------------+---------------+
+	C
+	C mm6 = shift
+	C mm7 = ecx = 64-shift
+
+
+	C Size even, destination was unaligned.
+	C
+	C               source          edx+8
+	C                 --+---------------+
+	C                   |      mm2      |
+	C                 --+---------------+
+	C
+	C         dest                  edi+4
+	C         --+---------------+-------+
+	C           |    written    |       |
+	C         --+---------------+-------+
+	C
+	C mm6 = shift+32
+	C mm7 = ecx = 64-(shift+32)
+
+
+	C The movq for the aligned case overwrites the movd for the
+	C unaligned case.
+
+	movq	%mm2, %mm0
+	psrlq	$32, %mm2
+
+	testb	$32, %cl
+	movd	%mm2, disp(4) (%edi)
+
+	jz	L(end_even_unaligned)
+	movq	%mm0, disp(0) (%edi)
+L(end_even_unaligned):
+
+	movl	SAVE_EDI, %edi
+	addl	$SAVE_SIZE, %esp
+	emms
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/mmx/mod_1.asm b/src/gmp/mpn/x86/k7/mmx/mod_1.asm
new file mode 100644
index 000000000..545ca56dd
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/mmx/mod_1.asm
@@ -0,0 +1,457 @@
+dnl  AMD K7 mpn_mod_1 -- mpn by limb remainder.
+dnl 
+dnl  K7: 17.0 cycles/limb.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_mod_1 (mp_srcptr src, mp_size_t size, mp_limb_t divisor);
+C mp_limb_t mpn_mod_1c (mp_srcptr src, mp_size_t size, mp_limb_t divisor,
+C                       mp_limb_t carry);
+C
+C The code here is the same as mpn_divrem_1, but with the quotient
+C discarded.  See mpn/x86/k7/mmx/divrem_1.c for some comments.
+
+
+dnl  MUL_THRESHOLD is the size at which the multiply by inverse method is
+dnl  used, rather than plain "divl"s.  Minimum value 2.
+dnl
+dnl  The inverse takes about 50 cycles to calculate, but after that the
+dnl  multiply is 17 c/l versus division at 41 c/l.
+dnl
+dnl  Using mul or div is about the same speed at 3 limbs, so the threshold
+dnl  is set to 4 to get the smaller div code used at 3.
+
+deflit(MUL_THRESHOLD, 4)
+
+
+defframe(PARAM_CARRY,  16)
+defframe(PARAM_DIVISOR,12)
+defframe(PARAM_SIZE,    8)
+defframe(PARAM_SRC,     4)
+
+defframe(SAVE_EBX,    -4)
+defframe(SAVE_ESI,    -8)
+defframe(SAVE_EDI,    -12)
+defframe(SAVE_EBP,    -16)
+
+defframe(VAR_NORM,    -20)
+defframe(VAR_INVERSE, -24)
+defframe(VAR_SRC_STOP,-28)
+
+deflit(STACK_SPACE, 28)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_mod_1c)
+deflit(`FRAME',0)
+	movl	PARAM_CARRY, %edx
+	movl	PARAM_SIZE, %ecx
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%ebp, SAVE_EBP
+	movl	PARAM_DIVISOR, %ebp
+
+	movl	%esi, SAVE_ESI
+	movl	PARAM_SRC, %esi
+	jmp	LF(mpn_mod_1,start_1c)
+
+EPILOGUE()
+
+
+	ALIGN(32)
+PROLOGUE(mpn_mod_1)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	movl	$0, %edx		C initial carry (if can't skip a div)
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%esi, SAVE_ESI
+	movl	PARAM_SRC, %esi
+
+	movl	%ebp, SAVE_EBP
+	movl	PARAM_DIVISOR, %ebp
+
+	orl	%ecx, %ecx
+	jz	L(divide_done)
+
+	movl	-4(%esi,%ecx,4), %eax	C src high limb
+
+	cmpl	%ebp, %eax		C carry flag if high<divisor
+					
+	cmovc(	%eax, %edx)		C src high limb as initial carry
+	sbbl	$0, %ecx		C size-1 to skip one div
+	jz	L(divide_done)
+
+
+	ALIGN(16)
+L(start_1c):
+	C eax	
+	C ebx
+	C ecx	size
+	C edx	carry
+	C esi	src
+	C edi
+	C ebp	divisor
+
+	cmpl	$MUL_THRESHOLD, %ecx
+	jae	L(mul_by_inverse)
+
+
+
+C With a MUL_THRESHOLD of 4, this "loop" only ever does 1 to 3 iterations,
+C but it's already fast and compact, and there's nothing to gain by
+C expanding it out.
+C
+C Using PARAM_DIVISOR in the divl is a couple of cycles faster than %ebp.
+
+	orl	%ecx, %ecx
+	jz	L(divide_done)
+
+
+L(divide_top):
+	C eax	scratch (quotient)
+	C ebx
+	C ecx	counter, limbs, decrementing
+	C edx	scratch (remainder)
+	C esi	src
+	C edi
+	C ebp
+
+	movl	-4(%esi,%ecx,4), %eax
+
+	divl	PARAM_DIVISOR
+
+	decl	%ecx
+	jnz	L(divide_top)
+
+
+L(divide_done):
+	movl	SAVE_ESI, %esi
+	movl	SAVE_EBP, %ebp
+	addl	$STACK_SPACE, %esp
+
+	movl	%edx, %eax
+
+	ret
+
+
+
+C -----------------------------------------------------------------------------
+
+L(mul_by_inverse):
+	C eax
+	C ebx
+	C ecx	size
+	C edx	carry
+	C esi	src
+	C edi
+	C ebp	divisor
+
+	bsrl	%ebp, %eax		C 31-l
+
+	movl	%ebx, SAVE_EBX
+	leal	-4(%esi), %ebx
+
+	movl	%ebx, VAR_SRC_STOP
+	movl	%edi, SAVE_EDI
+
+	movl	%ecx, %ebx		C size
+	movl	$31, %ecx
+
+	movl	%edx, %edi		C carry
+	movl	$-1, %edx
+
+	C
+
+	xorl	%eax, %ecx		C l
+	incl	%eax			C 32-l
+
+	shll	%cl, %ebp		C d normalized
+	movl	%ecx, VAR_NORM
+
+	movd	%eax, %mm7
+
+	movl	$-1, %eax
+	subl	%ebp, %edx		C (b-d)-1 so  edx:eax = b*(b-d)-1
+
+	divl	%ebp			C floor (b*(b-d)-1) / d
+
+	C
+
+	movl	%eax, VAR_INVERSE
+	leal	-12(%esi,%ebx,4), %eax	C &src[size-3]
+
+	movl	8(%eax), %esi		C src high limb
+	movl	4(%eax), %edx		C src second highest limb
+
+	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
+
+	shldl(	%cl, %edx, %esi)	C n10 = high,second << l
+
+	movl	%eax, %ecx		C &src[size-3]
+
+
+ifelse(MUL_THRESHOLD,2,`
+	cmpl	$2, %ebx
+	je	L(inverse_two_left)
+')
+
+
+C The dependent chain here is the same as in mpn_divrem_1, but a few
+C instructions are saved by not needing to store the quotient limbs.
+C Unfortunately this doesn't get the code down to the theoretical 16 c/l.
+C
+C There's four dummy instructions in the loop, all of which are necessary
+C for the claimed 17 c/l.  It's a 1 to 3 cycle slowdown if any are removed,
+C or changed from load to store or vice versa.  They're not completely
+C random, since they correspond to what mpn_divrem_1 has, but there's no
+C obvious reason why they're necessary.  Presumably they induce something
+C good in the out of order execution, perhaps through some load/store
+C ordering and/or decoding effects.
+C
+C The q1==0xFFFFFFFF case is handled here the same as in mpn_divrem_1.  On
+C on special data that comes out as q1==0xFFFFFFFF always, the loop runs at
+C about 13.5 c/l.
+
+	ALIGN(32)
+L(inverse_top):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	src pointer, decrementing
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	scratch (src qword)
+	C mm7	rshift for normalization
+
+	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
+	movl	%edi, %eax         C n2
+	movl	PARAM_SIZE, %ebx   C dummy
+
+	leal	(%ebp,%esi), %ebx
+	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
+	sbbl	$-1, %eax          C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	movq	(%ecx), %mm0       C next src limb and the one below it
+	subl	$4, %ecx
+
+	movl	%ecx, PARAM_SIZE   C dummy
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+	movl	%ebp, %eax	   C d
+
+	C
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+	jz	L(q1_ff)
+	nop                        C dummy
+
+	mull	%ebx		   C (q1+1)*d
+
+	psrlq	%mm7, %mm0
+	leal	0(%ecx), %ecx      C dummy
+
+	C
+
+	C
+
+	subl	%eax, %esi
+	movl	VAR_SRC_STOP, %eax
+
+	C
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	movd	%mm0, %esi
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+	cmpl	%eax, %ecx
+	jne	L(inverse_top)
+
+
+L(inverse_loop_done):
+
+
+C -----------------------------------------------------------------------------
+
+L(inverse_two_left):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	&src[-1]
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	scratch (src dword)
+	C mm7	rshift
+
+	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
+	movl	%edi, %eax         C n2
+
+	leal	(%ebp,%esi), %ebx
+	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
+	sbbl	$-1, %eax          C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	movd	4(%ecx), %mm0	   C src low limb
+
+	C
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+	movl	%ebp, %eax	   C d
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+
+	sbbl	$0, %ebx
+
+	mull	%ebx		   C (q1+1)*d
+
+	psllq	$32, %mm0
+
+	psrlq	%mm7, %mm0
+
+	C
+
+	subl	%eax, %esi
+
+	C
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	movd	%mm0, %esi
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+
+
+C One limb left
+
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	src limb, shifted
+	C mm7	rshift
+
+	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
+	movl	%edi, %eax         C n2
+
+	leal	(%ebp,%esi), %ebx
+	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
+	sbbl	$-1, %eax          C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	movl	VAR_NORM, %ecx     C for final denorm
+
+	C
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+	movl	%ebp, %eax	   C d
+
+	C
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+
+	sbbl	$0, %ebx
+
+	mull	%ebx		   C (q1+1)*d
+
+	movl	SAVE_EBX, %ebx
+
+	C
+
+	C
+
+	subl	%eax, %esi
+
+	movl	%esi, %eax	   C remainder
+	movl	SAVE_ESI, %esi
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	leal	(%ebp,%eax), %edx
+	movl	SAVE_EBP, %ebp
+
+	cmovc(	%edx, %eax)	   C n - q1*d if underflow from using q1+1
+	movl	SAVE_EDI, %edi
+
+	shrl	%cl, %eax	   C denorm remainder
+	addl	$STACK_SPACE, %esp
+	emms
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+C
+C Special case for q1=0xFFFFFFFF, giving q=0xFFFFFFFF meaning the low dword
+C of q*d is simply -d and the remainder n-q*d = n10+d
+
+L(q1_ff):
+	C eax	(divisor)
+	C ebx	(q1+1 == 0)
+	C ecx	src pointer
+	C edx
+	C esi	n10
+	C edi	(n2)
+	C ebp	divisor
+
+	movl	VAR_SRC_STOP, %edx
+	leal	(%ebp,%esi), %edi	C n-q*d remainder -> next n2
+	psrlq	%mm7, %mm0
+
+	movd	%mm0, %esi		C next n10
+
+	cmpl	%ecx, %edx
+	jne	L(inverse_top)
+	jmp	L(inverse_loop_done)
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/mmx/popham.asm b/src/gmp/mpn/x86/k7/mmx/popham.asm
new file mode 100644
index 000000000..68e049a4e
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/mmx/popham.asm
@@ -0,0 +1,239 @@
+dnl  AMD K7 mpn_popcount, mpn_hamdist -- population count and hamming
+dnl  distance.
+dnl 
+dnl  K7: popcount 5.0 cycles/limb, hamdist 6.0 cycles/limb
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  Only recent versions of gas know psadbw, in particular gas 2.9.1 on
+dnl  FreeBSD 3.3 and 3.4 doesn't recognise it.
+
+define(psadbw_mm4_mm0,
+`ifelse(m4_ifdef_anyof_p(`HAVE_TARGET_CPU_athlon',
+                         `HAVE_TARGET_CPU_pentium3'),1,
+	`.byte 0x0f,0xf6,0xc4	C psadbw %mm4, %mm0',
+
+`m4_warning(`warning, using simulated and only partly functional psadbw, use for testing only
+')	C this works enough for the sum of bytes done below, making it
+	C possible to test on an older cpu
+	leal	-8(%esp), %esp
+	movq	%mm4, (%esp)
+	movq	%mm0, %mm4
+forloop(i,1,7,
+`	psrlq	$ 8, %mm4
+	paddb	%mm4, %mm0
+')
+	pushl	$ 0
+	pushl	$ 0xFF
+	pand	(%esp), %mm0
+	movq	8(%esp), %mm4
+	leal	16(%esp), %esp
+')')
+
+
+C unsigned long mpn_popcount (mp_srcptr src, mp_size_t size);
+C unsigned long mpn_hamdist (mp_srcptr src, mp_srcptr src2, mp_size_t size);
+C
+C The code here is almost certainly not optimal, but is already a 3x speedup
+C over the generic C code.  The main improvement would be to interleave
+C processing of two qwords in the loop so as to fully exploit the available
+C execution units, possibly leading to 3.25 c/l (13 cycles for 4 limbs).
+C
+C The loop is based on the example "Efficient 64-bit population count using
+C MMX instructions" in the Athlon Optimization Guide, AMD document 22007,
+C page 158 of rev E (reference in mpn/x86/k7/README).
+
+ifdef(`OPERATION_popcount',,
+`ifdef(`OPERATION_hamdist',,
+`m4_error(`Need OPERATION_popcount or OPERATION_hamdist defined
+')')')
+
+define(HAM,
+m4_assert_numargs(1)
+`ifdef(`OPERATION_hamdist',`$1')')
+
+define(POP,
+m4_assert_numargs(1)
+`ifdef(`OPERATION_popcount',`$1')')
+
+HAM(`
+defframe(PARAM_SIZE,   12)
+defframe(PARAM_SRC2,   8)
+defframe(PARAM_SRC,    4)
+define(M4_function,mpn_hamdist)
+')
+POP(`
+defframe(PARAM_SIZE,   8)
+defframe(PARAM_SRC,    4)
+define(M4_function,mpn_popcount)
+')
+
+MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
+
+
+ifdef(`PIC',,`
+	dnl  non-PIC
+
+	.section .rodata
+	ALIGN(8)
+
+define(LS,
+m4_assert_numargs(1)
+`LF(M4_function,`$1')')
+
+LS(rodata_AAAAAAAAAAAAAAAA):
+	.long	0xAAAAAAAA
+	.long	0xAAAAAAAA
+
+LS(rodata_3333333333333333):
+	.long	0x33333333
+	.long	0x33333333
+
+LS(rodata_0F0F0F0F0F0F0F0F):
+	.long	0x0F0F0F0F
+	.long	0x0F0F0F0F
+')
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(M4_function)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	orl	%ecx, %ecx
+	jz	L(zero)
+
+ifdef(`PIC',`
+	movl	$0xAAAAAAAA, %eax
+	movl	$0x33333333, %edx
+
+	movd	%eax, %mm7
+	movd	%edx, %mm6
+
+	movl	$0x0F0F0F0F, %eax
+
+	punpckldq %mm7, %mm7
+	punpckldq %mm6, %mm6
+
+	movd	%eax, %mm5
+	movd	%edx, %mm4
+
+	punpckldq %mm5, %mm5
+
+',`
+	movq	LS(rodata_AAAAAAAAAAAAAAAA), %mm7
+	movq	LS(rodata_3333333333333333), %mm6
+	movq	LS(rodata_0F0F0F0F0F0F0F0F), %mm5
+')
+	pxor	%mm4, %mm4
+
+define(REG_AAAAAAAAAAAAAAAA,%mm7)
+define(REG_3333333333333333,%mm6)
+define(REG_0F0F0F0F0F0F0F0F,%mm5)
+define(REG_0000000000000000,%mm4)
+
+
+	movl	PARAM_SRC, %eax
+HAM(`	movl	PARAM_SRC2, %edx')
+
+	pxor	%mm2, %mm2	C total
+
+	shrl	%ecx
+	jnc	L(top)
+
+	movd	(%eax,%ecx,8), %mm1
+
+HAM(`	movd	0(%edx,%ecx,8), %mm0
+	pxor	%mm0, %mm1
+')
+	orl	%ecx, %ecx
+	jmp	L(loaded)
+
+
+	ALIGN(16)
+L(top):
+	C eax	src
+	C ebx
+	C ecx	counter, qwords, decrementing
+	C edx	[hamdist] src2
+	C
+	C mm0	(scratch)
+	C mm1	(scratch)
+	C mm2	total (low dword)
+	C mm3
+	C mm4	\
+	C mm5	| special constants
+	C mm6	|
+	C mm7	/
+
+	movq	-8(%eax,%ecx,8), %mm1
+
+HAM(`	pxor	-8(%edx,%ecx,8), %mm1')
+	decl	%ecx
+
+L(loaded):
+	movq	%mm1, %mm0
+	pand	REG_AAAAAAAAAAAAAAAA, %mm1
+
+	psrlq	$1, %mm1
+
+	psubd	%mm1, %mm0	C bit pairs
+
+
+	movq	%mm0, %mm1
+	psrlq	$2, %mm0
+
+	pand	REG_3333333333333333, %mm0
+	pand	REG_3333333333333333, %mm1
+
+	paddd	%mm1, %mm0	C nibbles
+
+
+	movq	%mm0, %mm1
+	psrlq	$4, %mm0
+
+	pand	REG_0F0F0F0F0F0F0F0F, %mm0
+	pand	REG_0F0F0F0F0F0F0F0F, %mm1
+
+	paddd	%mm1, %mm0	C bytes
+
+
+	psadbw_mm4_mm0
+
+	paddd	%mm0, %mm2	C add to total
+	jnz	L(top)
+
+
+	movd	%mm2, %eax
+	emms
+	ret
+
+
+L(zero):
+	movl	$0, %eax
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/mmx/rshift.asm b/src/gmp/mpn/x86/k7/mmx/rshift.asm
new file mode 100644
index 000000000..abb546cd5
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/mmx/rshift.asm
@@ -0,0 +1,471 @@
+dnl  AMD K7 mpn_rshift -- mpn right shift.
+dnl 
+dnl  K7: 1.21 cycles/limb (at 16 limbs/loop).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K7: UNROLL_COUNT cycles/limb
+dnl           4           1.51
+dnl           8           1.26
+dnl          16           1.21
+dnl          32           1.2
+dnl  Maximum possible with the current code is 64.
+
+deflit(UNROLL_COUNT, 16)
+
+
+C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+C Shift src,size right by shift many bits and store the result in dst,size.
+C Zeros are shifted in at the left.  The bits shifted out at the right are
+C the return value.
+C
+C This code uses 64-bit MMX operations, which makes it possible to handle
+C two limbs at a time, for a theoretical 1.0 cycles/limb.  Plain integer
+C code, on the other hand, suffers from shrd being a vector path decode and
+C running at 3 cycles back-to-back.
+C
+C Full speed depends on source and destination being aligned, and some hairy
+C setups and finish-ups are done to arrange this for the loop.
+
+ifdef(`PIC',`
+deflit(UNROLL_THRESHOLD, 10)
+',`
+deflit(UNROLL_THRESHOLD, 10)
+')
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+
+defframe(SAVE_EDI, -4)
+defframe(SAVE_ESI, -8)
+defframe(SAVE_EBX, -12)
+deflit(SAVE_SIZE, 12)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(mpn_rshift)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %eax
+	movl	PARAM_SRC, %edx
+	subl	$SAVE_SIZE, %esp
+deflit(`FRAME',SAVE_SIZE)
+
+	movl	PARAM_SHIFT, %ecx
+	movl	%edi, SAVE_EDI
+
+	movl	PARAM_DST, %edi
+	decl	%eax
+	jnz	L(more_than_one_limb)
+
+	movl	(%edx), %edx		C src limb
+
+	shrdl(	%cl, %edx, %eax)	C eax was decremented to zero
+
+ 	shrl	%cl, %edx
+
+	movl	%edx, (%edi)		C dst limb
+	movl	SAVE_EDI, %edi
+	addl	$SAVE_SIZE, %esp
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+L(more_than_one_limb):
+	C eax	size-1
+	C ebx
+	C ecx	shift
+	C edx	src
+	C esi
+	C edi	dst
+	C ebp
+
+	movd	PARAM_SHIFT, %mm6	C rshift
+	movd	(%edx), %mm5		C src low limb
+	cmp	$UNROLL_THRESHOLD-1, %eax
+
+	jae	L(unroll)
+	leal	(%edx,%eax,4), %edx	C &src[size-1]
+	leal	-4(%edi,%eax,4), %edi	C &dst[size-2]
+
+	movd	(%edx), %mm4		C src high limb
+	negl	%eax
+
+
+L(simple_top):
+	C eax	loop counter, limbs, negative
+	C ebx
+	C ecx	shift
+	C edx	carry
+	C edx	&src[size-1]
+	C edi	&dst[size-2]
+	C ebp
+	C
+	C mm0	scratch
+	C mm4	src high limb
+	C mm5	src low limb
+	C mm6	shift
+
+	movq	(%edx,%eax,4), %mm0
+	incl	%eax
+
+ 	psrlq	%mm6, %mm0
+
+	movd	%mm0, (%edi,%eax,4)
+	jnz	L(simple_top)
+
+
+	psllq	$32, %mm5
+ 	psrlq	%mm6, %mm4
+
+	psrlq	%mm6, %mm5
+	movd	%mm4, 4(%edi)		C dst high limb
+
+	movd	%mm5, %eax		C return value
+
+	movl	SAVE_EDI, %edi
+	addl	$SAVE_SIZE, %esp
+	emms
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(unroll):
+	C eax	size-1
+	C ebx
+	C ecx	shift
+	C edx	src
+	C esi
+	C edi	dst
+	C ebp
+	C
+	C mm5	src low limb
+	C mm6	rshift
+
+	testb	$4, %dl
+	movl	%esi, SAVE_ESI
+	movl	%ebx, SAVE_EBX
+
+	psllq	$32, %mm5
+	jz	L(start_src_aligned)
+
+
+	C src isn't aligned, process low limb separately (marked xxx) and
+	C step src and dst by one limb, making src aligned.
+	C
+	C source                  edx
+	C --+-------+-------+-------+
+	C           |          xxx  |
+	C --+-------+-------+-------+
+	C         4mod8   0mod8   4mod8
+	C
+	C         dest            edi
+	C         --+-------+-------+
+	C           |       |  xxx  |  
+	C         --+-------+-------+
+
+	movq	(%edx), %mm0		C src low two limbs
+	addl	$4, %edx
+	movl	%eax, PARAM_SIZE	C size-1
+
+	addl	$4, %edi
+	decl	%eax			C size-2 is new size-1
+
+	psrlq	%mm6, %mm0
+	movl	%edi, PARAM_DST		C new dst
+
+	movd	%mm0, -4(%edi)
+L(start_src_aligned):
+
+
+	movq	(%edx), %mm1		C src low two limbs
+	decl	%eax			C size-2, two last limbs handled at end
+	testl	$4, %edi
+
+	psrlq	%mm6, %mm5
+	jz	L(start_dst_aligned)
+
+
+	C dst isn't aligned, add 4 to make it so, and pretend the shift is
+	C 32 bits extra.  Low limb of dst (marked xxx) handled here separately.
+	C
+	C          source          edx
+	C          --+-------+-------+
+	C            |      mm1      |
+	C          --+-------+-------+
+	C                  4mod8   0mod8
+	C
+	C  dest                    edi
+	C  --+-------+-------+-------+
+	C                    |  xxx  |        
+	C  --+-------+-------+-------+
+	C          4mod8   0mod8   4mod8
+
+	movq	%mm1, %mm0
+	psrlq	%mm6, %mm1
+	addl	$32, %ecx		C shift+32
+
+	movd	%mm1, (%edi)
+	movq	%mm0, %mm1
+	addl	$4, %edi		C new dst
+
+	movd	%ecx, %mm6
+L(start_dst_aligned):
+
+
+	movq	%mm1, %mm2		C copy of src low two limbs
+	negl	%ecx
+	andl	$-2, %eax		C round size down to even
+
+	movl	%eax, %ebx
+	negl	%eax
+	addl	$64, %ecx
+
+	andl	$UNROLL_MASK, %eax
+	decl	%ebx
+
+	shll	%eax
+
+	movd	%ecx, %mm7		C lshift = 64-rshift
+
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(here):
+',`
+	leal	L(entry) (%eax,%eax,4), %esi
+	negl	%eax
+')
+	shrl	$UNROLL_LOG2, %ebx	C loop counter
+
+	leal	ifelse(UNROLL_BYTES,256,128+) 8(%edx,%eax,2), %edx
+	leal	ifelse(UNROLL_BYTES,256,128) (%edi,%eax,2), %edi
+	movl	PARAM_SIZE, %eax	C for use at end
+
+	jmp	*%esi
+
+
+ifdef(`PIC',`
+L(pic_calc):
+	C See README.family about old gas bugs
+	leal	(%eax,%eax,4), %esi
+	addl	$L(entry)-L(here), %esi
+	addl	(%esp), %esi
+	negl	%eax
+
+	ret
+')
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(64)
+L(top):
+	C eax	size, for use at end
+	C ebx	loop counter
+	C ecx	lshift
+	C edx	src
+	C esi	was computed jump
+	C edi	dst
+	C ebp
+	C
+	C mm0	scratch
+	C mm1	\ carry (alternating)
+	C mm2	/
+	C mm6	rshift
+	C mm7	lshift
+	C
+	C 10 code bytes/limb
+	C
+	C The two chunks differ in whether mm1 or mm2 hold the carry.
+	C The computed jump puts the initial carry in both mm1 and mm2.
+	
+L(entry):
+deflit(CHUNK_COUNT, 4)
+forloop(i, 0, UNROLL_COUNT/CHUNK_COUNT-1, `
+	deflit(`disp0', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
+	deflit(`disp1', eval(disp0 + 8))
+
+ 	movq	disp0(%edx), %mm0
+ 	psrlq	%mm6, %mm2
+
+ 	movq	%mm0, %mm1
+ 	psllq	%mm7, %mm0
+
+ 	por	%mm2, %mm0
+ 	movq	%mm0, disp0(%edi)
+
+
+ 	movq	disp1(%edx), %mm0
+ 	psrlq	%mm6, %mm1
+
+ 	movq	%mm0, %mm2
+ 	psllq	%mm7, %mm0
+
+ 	por	%mm1, %mm0
+ 	movq	%mm0, disp1(%edi)
+')
+
+	addl	$UNROLL_BYTES, %edx
+	addl	$UNROLL_BYTES, %edi
+	decl	%ebx
+
+	jns	L(top)
+
+
+deflit(`disp0', ifelse(UNROLL_BYTES,256,-128))
+deflit(`disp1', eval(disp0-0 + 8))
+
+	testb	$1, %al
+	psrlq	%mm6, %mm2	C wanted rshifted in all cases below
+	movl	SAVE_ESI, %esi
+
+	movd	%mm5, %eax		C return value
+
+	movl	SAVE_EBX, %ebx
+	jz	L(end_even)
+
+	
+	C Size odd, destination was aligned.
+	C
+	C source
+	C       edx
+	C +-------+---------------+--
+	C |       |      mm2      |
+	C +-------+---------------+--
+	C
+	C dest                  edi
+	C +-------+---------------+---------------+--
+	C |       |               |    written    |
+	C +-------+---------------+---------------+--
+	C
+	C mm6 = shift
+	C mm7 = ecx = 64-shift
+
+
+	C Size odd, destination was unaligned.
+	C
+	C source
+	C       edx
+	C +-------+---------------+--
+	C |       |      mm2      |
+	C +-------+---------------+--
+	C
+	C dest          edi
+	C +---------------+---------------+--
+	C |               |    written    |
+	C +---------------+---------------+--
+	C
+	C mm6 = shift+32
+	C mm7 = ecx = 64-(shift+32)
+
+
+	C In both cases there's one extra limb of src to fetch and combine
+	C with mm2 to make a qword to store, and in the aligned case there's
+	C a further extra limb of dst to be formed.
+
+
+	movd	disp0(%edx), %mm0
+	movq	%mm0, %mm1
+
+	psllq	%mm7, %mm0
+	testb	$32, %cl
+
+ 	por	%mm2, %mm0
+	psrlq	%mm6, %mm1
+
+	movq	%mm0, disp0(%edi)
+	jz	L(finish_odd_unaligned)
+
+	movd	%mm1, disp1(%edi)
+L(finish_odd_unaligned):
+
+	movl	SAVE_EDI, %edi
+	addl	$SAVE_SIZE, %esp
+	emms
+
+	ret
+
+
+L(end_even):
+
+	C Size even, destination was aligned.
+	C
+	C source
+	C +---------------+--
+	C |      mm2      |
+	C +---------------+--
+	C
+	C dest          edi
+	C +---------------+---------------+--
+	C |               |      mm3      |
+	C +---------------+---------------+--
+	C
+	C mm6 = shift
+	C mm7 = ecx = 64-shift
+
+
+	C Size even, destination was unaligned.
+	C
+	C source
+	C +---------------+--
+	C |      mm2      |
+	C +---------------+--
+	C
+	C dest  edi
+	C +-------+---------------+--
+	C |       |      mm3      |
+	C +-------+---------------+--
+	C
+	C mm6 = shift+32
+	C mm7 = 64-(shift+32)
+
+
+	C The movd for the unaligned case is the same data as the movq for
+	C the aligned case, it's just a choice between whether one or two
+	C limbs should be written.
+
+
+	testb	$32, %cl
+	movd	%mm2, disp0(%edi)
+
+	jz	L(end_even_unaligned)
+
+	movq	%mm2, disp0(%edi)
+L(end_even_unaligned):
+
+	movl	SAVE_EDI, %edi
+	addl	$SAVE_SIZE, %esp
+	emms
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/mul_1.asm b/src/gmp/mpn/x86/k7/mul_1.asm
new file mode 100644
index 000000000..07f7085b1
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/mul_1.asm
@@ -0,0 +1,265 @@
+dnl  AMD K7 mpn_mul_1 -- mpn by limb multiply.
+dnl 
+dnl  K7: 3.4 cycles/limb (at 16 limbs/loop).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K7: UNROLL_COUNT cycles/limb
+dnl           8           3.9
+dnl          16           3.4
+dnl          32           3.4
+dnl          64           3.35
+dnl  Maximum possible with the current code is 64.
+
+deflit(UNROLL_COUNT, 16)
+
+
+C mp_limb_t mpn_mul_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                      mp_limb_t multiplier);
+C mp_limb_t mpn_mul_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       mp_limb_t multiplier, mp_limb_t carry);
+C
+C Multiply src,size by mult and store the result in dst,size.
+C Return the carry limb from the top of the result.
+C
+C mpn_mul_1c() accepts an initial carry for the calculation, it's added into
+C the low limb of the destination.
+C
+C Variations on the unrolled loop have been tried, with the current
+C registers or with the counter on the stack to free up ecx.  The current
+C code is the fastest found.
+C
+C An interesting effect is that removing the stores "movl %ebx, disp0(%edi)"
+C from the unrolled loop actually slows it down to 5.0 cycles/limb.  Code
+C with this change can be tested on sizes of the form UNROLL_COUNT*n+1
+C without having to change the computed jump.  There's obviously something
+C fishy going on, perhaps with what execution units the mul needs.
+
+defframe(PARAM_CARRY,     20)
+defframe(PARAM_MULTIPLIER,16)
+defframe(PARAM_SIZE,      12)
+defframe(PARAM_SRC,       8)
+defframe(PARAM_DST,       4)
+
+defframe(SAVE_EBP, -4)
+defframe(SAVE_EDI, -8)
+defframe(SAVE_ESI, -12)
+defframe(SAVE_EBX, -16)
+deflit(STACK_SPACE, 16)
+
+dnl  Must have UNROLL_THRESHOLD >= 2, since the unrolled loop can't handle 1.
+ifdef(`PIC',`
+deflit(UNROLL_THRESHOLD, 7)
+',`
+deflit(UNROLL_THRESHOLD, 5)
+')
+
+	.text
+	ALIGN(32)
+PROLOGUE(mpn_mul_1c)
+deflit(`FRAME',0)
+	movl	PARAM_CARRY, %edx
+	jmp	LF(mpn_mul_1,start_nc)
+EPILOGUE()
+
+
+PROLOGUE(mpn_mul_1)
+deflit(`FRAME',0)
+	xorl	%edx, %edx	C initial carry
+L(start_nc):
+	movl	PARAM_SIZE, %ecx
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME', STACK_SPACE)
+
+	movl	%edi, SAVE_EDI
+	movl	%ebx, SAVE_EBX
+	movl	%edx, %ebx
+
+	movl	%esi, SAVE_ESI
+	movl	PARAM_SRC, %esi
+	cmpl	$UNROLL_THRESHOLD, %ecx
+
+	movl	PARAM_DST, %edi
+	movl	%ebp, SAVE_EBP
+	jae	L(unroll)
+
+	leal	(%esi,%ecx,4), %esi
+	leal	(%edi,%ecx,4), %edi
+	negl	%ecx
+
+	movl	PARAM_MULTIPLIER, %ebp
+
+L(simple):
+	C eax	scratch
+	C ebx	carry
+	C ecx	counter (negative)
+	C edx	scratch
+	C esi	src
+	C edi	dst
+	C ebp	multiplier
+
+	movl	(%esi,%ecx,4), %eax
+
+	mull	%ebp
+
+	addl	%ebx, %eax
+	movl	%eax, (%edi,%ecx,4)
+	movl	$0, %ebx
+
+	adcl	%edx, %ebx
+	incl	%ecx
+	jnz	L(simple)
+
+	movl	%ebx, %eax
+	movl	SAVE_EBX, %ebx
+	movl	SAVE_ESI, %esi
+
+	movl	SAVE_EDI, %edi
+	movl	SAVE_EBP, %ebp
+	addl	$STACK_SPACE, %esp
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+C The mov to load the next source limb is done well ahead of the mul, this
+C is necessary for full speed.  It leads to one limb handled separately
+C after the loop.
+C
+C When unrolling to 32 or more, an offset of +4 is used on the src pointer,
+C to avoid having an 0x80 displacement in the code for the last limb in the
+C unrolled loop.  This is for a fair comparison between 16 and 32 unrolling.
+
+ifelse(eval(UNROLL_COUNT >= 32),1,`
+deflit(SRC_OFFSET,4)
+',`
+deflit(SRC_OFFSET,)
+')
+
+	C this is offset 0x62, so close enough to aligned
+L(unroll):
+	C eax
+	C ebx	initial carry
+	C ecx	size
+	C edx
+	C esi	src
+	C edi	dst
+	C ebp
+deflit(`FRAME', STACK_SPACE)
+
+	leal	-1(%ecx), %edx	C one limb handled at end
+	leal	-2(%ecx), %ecx	C and ecx is one less than edx
+	movl	%ebp, SAVE_EBP
+
+	negl	%edx
+	shrl	$UNROLL_LOG2, %ecx	C unrolled loop counter
+	movl	(%esi), %eax		C src low limb
+
+	andl	$UNROLL_MASK, %edx
+	movl	PARAM_DST, %edi
+
+	movl	%edx, %ebp
+	shll	$4, %edx
+
+	C 17 code bytes per limb
+ifdef(`PIC',`
+	call	L(add_eip_to_edx)
+L(here):
+',`
+	leal	L(entry) (%edx,%ebp), %edx
+')
+	negl	%ebp
+
+	leal	ifelse(UNROLL_BYTES,256,128+) SRC_OFFSET(%esi,%ebp,4), %esi
+	leal	ifelse(UNROLL_BYTES,256,128) (%edi,%ebp,4), %edi
+	movl	PARAM_MULTIPLIER, %ebp
+
+	jmp	*%edx
+
+
+ifdef(`PIC',`
+L(add_eip_to_edx):
+	C See README.family about old gas bugs
+	leal	(%edx,%ebp), %edx
+	addl	$L(entry)-L(here), %edx
+	addl	(%esp), %edx
+	ret
+')
+
+
+C ----------------------------------------------------------------------------
+	ALIGN(32)
+L(top):
+	C eax	next src limb
+	C ebx	carry
+	C ecx	counter
+	C edx	scratch
+	C esi	src+4
+	C edi	dst
+	C ebp	multiplier
+	C
+	C 17 code bytes per limb processed
+
+L(entry):
+forloop(i, 0, UNROLL_COUNT-1, `
+	deflit(`disp_dst', eval(i*4 ifelse(UNROLL_BYTES,256,-128)))
+	deflit(`disp_src', eval(disp_dst + 4-(SRC_OFFSET-0)))
+ 
+	mull	%ebp
+	
+	addl	%eax, %ebx
+Zdisp(	movl,	disp_src,(%esi), %eax)
+Zdisp(	movl,	%ebx, disp_dst,(%edi))
+
+	movl	$0, %ebx
+	adcl	%edx, %ebx
+')
+
+	decl	%ecx
+
+	leal	UNROLL_BYTES(%esi), %esi
+	leal	UNROLL_BYTES(%edi), %edi
+	jns	L(top)
+
+
+deflit(`disp0', ifelse(UNROLL_BYTES,256,-128))
+
+	mull	%ebp
+	
+	addl	%eax, %ebx
+	movl	$0, %eax
+	movl	SAVE_ESI, %esi
+
+	movl	%ebx, disp0(%edi)
+	movl	SAVE_EBX, %ebx
+	movl	SAVE_EDI, %edi
+
+	adcl	%edx, %eax
+	movl	SAVE_EBP, %ebp
+	addl	$STACK_SPACE, %esp
+
+	ret
+	
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/mul_basecase.asm b/src/gmp/mpn/x86/k7/mul_basecase.asm
new file mode 100644
index 000000000..c4be62e63
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/mul_basecase.asm
@@ -0,0 +1,593 @@
+dnl  AMD K7 mpn_mul_basecase -- multiply two mpn numbers.
+dnl 
+dnl  K7: approx 4.42 cycles per cross product at around 20x20 limbs (16
+dnl      limbs/loop unrolling).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  K7 UNROLL_COUNT cycles/product (at around 20x20)
+dnl           8           4.67    
+dnl          16           4.59
+dnl          32           4.42
+dnl  Maximum possible with the current code is 32.
+dnl
+dnl  At 32 the typical 13-26 limb sizes from the karatsuba code will get
+dnl  done with a straight run through a block of code, no inner loop.  Using
+dnl  32 gives 1k of code, but the k7 has a 64k L1 code cache.
+
+deflit(UNROLL_COUNT, 32)
+
+
+C void mpn_mul_basecase (mp_ptr wp,
+C                        mp_srcptr xp, mp_size_t xsize,
+C                        mp_srcptr yp, mp_size_t ysize);
+C
+C Calculate xp,xsize multiplied by yp,ysize, storing the result in
+C wp,xsize+ysize.
+C
+C This routine is essentially the same as mpn/generic/mul_basecase.c, but
+C it's faster because it does most of the mpn_addmul_1() startup
+C calculations only once.  The saving is 15-25% on typical sizes coming from
+C the Karatsuba multiply code.
+
+ifdef(`PIC',`
+deflit(UNROLL_THRESHOLD, 5)
+',`
+deflit(UNROLL_THRESHOLD, 5)
+')
+
+defframe(PARAM_YSIZE,20)
+defframe(PARAM_YP,   16)
+defframe(PARAM_XSIZE,12)
+defframe(PARAM_XP,   8)
+defframe(PARAM_WP,   4)
+
+	.text
+	ALIGN(32)
+PROLOGUE(mpn_mul_basecase)
+deflit(`FRAME',0)
+
+	movl	PARAM_XSIZE, %ecx
+	movl	PARAM_YP, %eax
+
+	movl	PARAM_XP, %edx
+	movl	(%eax), %eax	C yp low limb
+
+	cmpl	$2, %ecx
+	ja	L(xsize_more_than_two)
+	je	L(two_by_something)
+
+
+	C one limb by one limb
+
+	mull	(%edx)
+
+	movl	PARAM_WP, %ecx
+	movl	%eax, (%ecx)
+	movl	%edx, 4(%ecx)
+	ret
+
+
+C -----------------------------------------------------------------------------
+L(two_by_something):
+deflit(`FRAME',0)
+	decl	PARAM_YSIZE
+	pushl	%ebx		defframe_pushl(`SAVE_EBX')
+	movl	%eax, %ecx	C yp low limb
+
+	movl	PARAM_WP, %ebx
+	pushl	%esi		defframe_pushl(`SAVE_ESI')
+	movl	%edx, %esi	C xp
+
+	movl	(%edx), %eax	C xp low limb	
+	jnz	L(two_by_two)
+
+
+	C two limbs by one limb
+
+	mull	%ecx	
+
+	movl	%eax, (%ebx)
+	movl	4(%esi), %eax
+	movl	%edx, %esi	C carry
+
+	mull	%ecx
+
+	addl	%eax, %esi
+
+	movl	%esi, 4(%ebx)
+	movl	SAVE_ESI, %esi
+
+	adcl	$0, %edx
+
+	movl	%edx, 8(%ebx)
+	movl	SAVE_EBX, %ebx
+	addl	$FRAME, %esp
+
+	ret
+	
+
+
+C -----------------------------------------------------------------------------
+C Could load yp earlier into another register.
+
+	ALIGN(16)
+L(two_by_two):
+	C eax	xp low limb
+	C ebx	wp
+	C ecx	yp low limb
+	C edx
+	C esi	xp
+	C edi
+	C ebp
+
+dnl  FRAME carries on from previous
+
+	mull	%ecx		C xp[0] * yp[0]
+
+	push	%edi		defframe_pushl(`SAVE_EDI')
+	movl	%edx, %edi	C carry, for wp[1]
+
+	movl	%eax, (%ebx)
+	movl	4(%esi), %eax
+
+	mull	%ecx		C xp[1] * yp[0]
+
+	addl	%eax, %edi
+	movl	PARAM_YP, %ecx
+
+	adcl	$0, %edx
+	movl	4(%ecx), %ecx	C yp[1]
+	movl	%edi, 4(%ebx)
+
+	movl	4(%esi), %eax	C xp[1]
+	movl	%edx, %edi	C carry, for wp[2]
+
+	mull	%ecx		C xp[1] * yp[1]
+
+	addl	%eax, %edi
+
+	adcl	$0, %edx
+	movl	(%esi), %eax	C xp[0]
+
+	movl	%edx, %esi	C carry, for wp[3]
+
+	mull	%ecx		C xp[0] * yp[1]
+
+	addl	%eax, 4(%ebx)
+	adcl	%edx, %edi
+	movl	%edi, 8(%ebx)
+
+	adcl	$0, %esi
+	movl	SAVE_EDI, %edi
+	movl	%esi, 12(%ebx)
+
+	movl	SAVE_ESI, %esi
+	movl	SAVE_EBX, %ebx
+	addl	$FRAME, %esp
+
+	ret
+
+	
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(xsize_more_than_two):
+
+C The first limb of yp is processed with a simple mpn_mul_1 style loop
+C inline.  Unrolling this doesn't seem worthwhile since it's only run once
+C (whereas the addmul below is run ysize-1 many times).  A call to the
+C actual mpn_mul_1 will be slowed down by the call and parameter pushing and
+C popping, and doesn't seem likely to be worthwhile on the typical 13-26
+C limb operations the Karatsuba code calls here with.
+
+	C eax	yp[0]
+	C ebx
+	C ecx	xsize
+	C edx	xp
+	C esi
+	C edi
+	C ebp
+
+dnl  FRAME doesn't carry on from previous, no pushes yet here
+defframe(`SAVE_EBX',-4)
+defframe(`SAVE_ESI',-8)
+defframe(`SAVE_EDI',-12)
+defframe(`SAVE_EBP',-16)
+deflit(`FRAME',0)
+
+	subl	$16, %esp
+deflit(`FRAME',16)
+
+	movl	%edi, SAVE_EDI
+	movl	PARAM_WP, %edi
+
+	movl	%ebx, SAVE_EBX
+	movl	%ebp, SAVE_EBP
+	movl	%eax, %ebp
+
+	movl	%esi, SAVE_ESI
+	xorl	%ebx, %ebx
+	leal	(%edx,%ecx,4), %esi	C xp end
+
+	leal	(%edi,%ecx,4), %edi	C wp end of mul1
+	negl	%ecx
+
+
+L(mul1):
+	C eax	scratch
+	C ebx	carry
+	C ecx	counter, negative
+	C edx	scratch
+	C esi	xp end
+	C edi	wp end of mul1
+	C ebp	multiplier
+
+	movl	(%esi,%ecx,4), %eax
+
+	mull	%ebp
+
+	addl	%ebx, %eax
+	movl	%eax, (%edi,%ecx,4)
+	movl	$0, %ebx
+
+	adcl	%edx, %ebx
+	incl	%ecx
+	jnz	L(mul1)
+
+
+	movl	PARAM_YSIZE, %edx
+	movl	PARAM_XSIZE, %ecx
+
+	movl	%ebx, (%edi)		C final carry
+	decl	%edx
+
+	jnz	L(ysize_more_than_one)
+
+
+	movl	SAVE_EDI, %edi
+	movl	SAVE_EBX, %ebx
+
+	movl	SAVE_EBP, %ebp
+	movl	SAVE_ESI, %esi
+	addl	$FRAME, %esp
+
+	ret
+
+
+L(ysize_more_than_one):
+	cmpl	$UNROLL_THRESHOLD, %ecx
+	movl	PARAM_YP, %eax
+
+	jae	L(unroll)
+
+
+C -----------------------------------------------------------------------------
+	C simple addmul looping
+	C
+	C eax	yp
+	C ebx
+	C ecx	xsize
+	C edx	ysize-1
+	C esi	xp end
+	C edi	wp end of mul1
+	C ebp
+
+	leal	4(%eax,%edx,4), %ebp	C yp end
+	negl	%ecx
+	negl	%edx
+
+	movl	(%esi,%ecx,4), %eax	C xp low limb
+	movl	%edx, PARAM_YSIZE	C -(ysize-1)
+	incl	%ecx
+
+	xorl	%ebx, %ebx		C initial carry
+	movl	%ecx, PARAM_XSIZE	C -(xsize-1)
+	movl	%ebp, PARAM_YP
+
+	movl	(%ebp,%edx,4), %ebp	C yp second lowest limb - multiplier
+	jmp	L(simple_outer_entry)
+
+
+	C this is offset 0x121 so close enough to aligned
+L(simple_outer_top):	
+	C ebp	ysize counter, negative
+
+	movl	PARAM_YP, %edx
+	movl	PARAM_XSIZE, %ecx	C -(xsize-1)
+	xorl	%ebx, %ebx		C carry
+
+	movl	%ebp, PARAM_YSIZE
+	addl	$4, %edi		C next position in wp
+
+	movl	(%edx,%ebp,4), %ebp	C yp limb - multiplier
+	movl	-4(%esi,%ecx,4), %eax	C xp low limb
+
+
+L(simple_outer_entry):
+
+L(simple_inner):
+	C eax	xp limb
+	C ebx	carry limb
+	C ecx	loop counter (negative)
+	C edx	scratch
+	C esi	xp end
+	C edi	wp end
+	C ebp	multiplier
+
+	mull	%ebp
+
+	addl	%eax, %ebx
+	adcl	$0, %edx
+
+	addl	%ebx, (%edi,%ecx,4)
+	movl	(%esi,%ecx,4), %eax
+	adcl	$0, %edx
+
+	incl	%ecx
+	movl	%edx, %ebx
+	jnz	L(simple_inner)
+
+
+	mull	%ebp
+
+	movl	PARAM_YSIZE, %ebp
+	addl	%eax, %ebx
+
+	adcl	$0, %edx
+	addl	%ebx, (%edi)
+
+	adcl	$0, %edx
+	incl	%ebp
+
+	movl	%edx, 4(%edi)
+	jnz	L(simple_outer_top)
+
+
+	movl	SAVE_EBX, %ebx
+	movl	SAVE_ESI, %esi
+
+	movl	SAVE_EDI, %edi
+	movl	SAVE_EBP, %ebp
+	addl	$FRAME, %esp
+
+	ret
+
+
+
+C -----------------------------------------------------------------------------
+C
+C The unrolled loop is the same as in mpn_addmul_1(), see that code for some
+C comments.
+C
+C VAR_ADJUST is the negative of how many limbs the leals in the inner loop
+C increment xp and wp.  This is used to adjust back xp and wp, and rshifted
+C to given an initial VAR_COUNTER at the top of the outer loop.
+C
+C VAR_COUNTER is for the unrolled loop, running from VAR_ADJUST/UNROLL_COUNT
+C up to -1, inclusive.
+C
+C VAR_JMP is the computed jump into the unrolled loop.
+C
+C VAR_XP_LOW is the least significant limb of xp, which is needed at the
+C start of the unrolled loop.
+C
+C PARAM_YSIZE is the outer loop counter, going from -(ysize-1) up to -1,
+C inclusive.
+C
+C PARAM_YP is offset appropriately so that the PARAM_YSIZE counter can be
+C added to give the location of the next limb of yp, which is the multiplier
+C in the unrolled loop.
+C
+C The trick with VAR_ADJUST means it's only necessary to do one fetch in the
+C outer loop to take care of xp, wp and the inner loop counter.
+
+defframe(VAR_COUNTER,  -20)
+defframe(VAR_ADJUST,   -24)
+defframe(VAR_JMP,      -28)
+defframe(VAR_XP_LOW,   -32)
+deflit(VAR_EXTRA_SPACE, 16)
+
+
+L(unroll):
+	C eax	yp
+	C ebx
+	C ecx	xsize
+	C edx	ysize-1
+	C esi	xp end
+	C edi	wp end of mul1
+	C ebp
+
+	movl	PARAM_XP, %esi
+	movl	4(%eax), %ebp		C multiplier (yp second limb)
+	leal	4(%eax,%edx,4), %eax	C yp adjust for ysize indexing
+
+	movl	PARAM_WP, %edi
+	movl	%eax, PARAM_YP
+	negl	%edx
+
+	movl	%edx, PARAM_YSIZE
+	leal	UNROLL_COUNT-2(%ecx), %ebx	C (xsize-1)+UNROLL_COUNT-1
+	decl	%ecx				C xsize-1
+
+	movl	(%esi), %eax		C xp low limb
+	andl	$-UNROLL_MASK-1, %ebx
+	negl	%ecx
+
+	subl	$VAR_EXTRA_SPACE, %esp
+deflit(`FRAME',16+VAR_EXTRA_SPACE)
+	negl	%ebx
+	andl	$UNROLL_MASK, %ecx
+
+	movl	%ebx, VAR_ADJUST
+	movl	%ecx, %edx
+	shll	$4, %ecx
+
+	sarl	$UNROLL_LOG2, %ebx
+
+	C 17 code bytes per limb
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(unroll_here):
+',`
+	leal	L(unroll_entry) (%ecx,%edx,1), %ecx
+')
+	negl	%edx
+
+	movl	%eax, VAR_XP_LOW
+	movl	%ecx, VAR_JMP
+	leal	4(%edi,%edx,4), %edi	C wp and xp, adjust for unrolling,
+	leal	4(%esi,%edx,4), %esi	C  and start at second limb
+	jmp	L(unroll_outer_entry)
+
+
+ifdef(`PIC',`
+L(pic_calc):
+	C See README.family about old gas bugs
+	leal	(%ecx,%edx,1), %ecx
+	addl	$L(unroll_entry)-L(unroll_here), %ecx
+	addl	(%esp), %ecx
+	ret
+')
+
+
+C --------------------------------------------------------------------------
+	ALIGN(32)
+L(unroll_outer_top):
+	C ebp	ysize counter, negative
+
+	movl	VAR_ADJUST, %ebx
+	movl	PARAM_YP, %edx
+
+	movl	VAR_XP_LOW, %eax
+	movl	%ebp, PARAM_YSIZE	C store incremented ysize counter
+
+	leal	4(%edi,%ebx,4), %edi
+	leal	(%esi,%ebx,4), %esi
+	sarl	$UNROLL_LOG2, %ebx
+
+	movl	(%edx,%ebp,4), %ebp	C yp next multiplier
+	movl	VAR_JMP, %ecx
+
+L(unroll_outer_entry):
+	mull	%ebp
+
+	testb	$1, %cl		C and clear carry bit
+	movl	%ebx, VAR_COUNTER
+	movl	$0, %ebx
+
+	movl	$0, %ecx
+	cmovz(	%eax, %ecx)	C eax into low carry, zero into high carry limb
+	cmovnz(	%eax, %ebx)
+
+	C Extra fetch of VAR_JMP is bad, but registers are tight
+	jmp	*VAR_JMP
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(32)
+L(unroll_top):
+	C eax	xp limb
+	C ebx	carry high
+	C ecx	carry low
+	C edx	scratch
+	C esi	xp+8
+	C edi	wp
+	C ebp	yp multiplier limb
+	C
+	C VAR_COUNTER  loop counter, negative
+	C
+	C 17 bytes each limb
+
+L(unroll_entry):
+
+deflit(CHUNK_COUNT,2)
+forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
+	deflit(`disp0', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
+	deflit(`disp1', eval(disp0 + 4))
+
+Zdisp(	movl,	disp0,(%esi), %eax)
+	adcl	%edx, %ebx
+
+	mull	%ebp
+
+Zdisp(	addl,	%ecx, disp0,(%edi))
+	movl	$0, %ecx
+
+	adcl	%eax, %ebx
+
+
+	movl	disp1(%esi), %eax
+	adcl	%edx, %ecx	
+
+	mull	%ebp
+
+	addl	%ebx, disp1(%edi)
+	movl	$0, %ebx
+
+	adcl	%eax, %ecx
+')
+
+
+	incl	VAR_COUNTER
+	leal	UNROLL_BYTES(%esi), %esi
+	leal	UNROLL_BYTES(%edi), %edi
+
+	jnz	L(unroll_top)
+
+
+	C eax
+	C ebx	zero
+	C ecx	low
+	C edx	high
+	C esi
+	C edi	wp, pointing at second last limb)
+	C ebp
+	C
+	C carry flag to be added to high
+
+deflit(`disp0', ifelse(UNROLL_BYTES,256,-128))
+deflit(`disp1', eval(disp0-0 + 4))
+
+	movl	PARAM_YSIZE, %ebp
+	adcl	$0, %edx
+	addl	%ecx, disp0(%edi)
+
+	adcl	$0, %edx
+	incl	%ebp
+
+	movl	%edx, disp1(%edi)
+	jnz	L(unroll_outer_top)
+
+
+	movl	SAVE_ESI, %esi
+	movl	SAVE_EBP, %ebp
+
+	movl	SAVE_EDI, %edi
+	movl	SAVE_EBX, %ebx
+	addl	$FRAME, %esp
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/k7/sqr_basecase.asm b/src/gmp/mpn/x86/k7/sqr_basecase.asm
new file mode 100644
index 000000000..84861ea66
--- /dev/null
+++ b/src/gmp/mpn/x86/k7/sqr_basecase.asm
@@ -0,0 +1,627 @@
+dnl  AMD K7 mpn_sqr_basecase -- square an mpn number.
+dnl 
+dnl  K7: approx 2.3 cycles/crossproduct, or 4.55 cycles/triangular product
+dnl  (measured on the speed difference between 25 and 50 limbs, which is
+dnl  roughly the Karatsuba recursing range).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  These are the same as mpn/x86/k6/sqr_basecase.asm, see that code for
+dnl  some comments.
+
+deflit(KARATSUBA_SQR_THRESHOLD_MAX, 66)
+
+ifdef(`KARATSUBA_SQR_THRESHOLD_OVERRIDE',
+`define(`KARATSUBA_SQR_THRESHOLD',KARATSUBA_SQR_THRESHOLD_OVERRIDE)')
+
+m4_config_gmp_mparam(`KARATSUBA_SQR_THRESHOLD')
+deflit(UNROLL_COUNT, eval(KARATSUBA_SQR_THRESHOLD-3))
+
+
+C void mpn_sqr_basecase (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C With a KARATSUBA_SQR_THRESHOLD around 50 this code is about 1500 bytes,
+C which is quite a bit, but is considered good value since squares big
+C enough to use most of the code will be spending quite a few cycles in it.
+
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+
+	.text
+	ALIGN(32)
+PROLOGUE(mpn_sqr_basecase)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	movl	PARAM_SRC, %eax
+	cmpl	$2, %ecx
+
+	movl	PARAM_DST, %edx
+	je	L(two_limbs)
+	ja	L(three_or_more)
+
+
+C------------------------------------------------------------------------------
+C one limb only
+	C eax	src
+	C ecx	size
+	C edx	dst
+
+	movl	(%eax), %eax
+	movl	%edx, %ecx
+
+	mull	%eax
+
+	movl	%edx, 4(%ecx)
+	movl	%eax, (%ecx)
+	ret
+
+
+C------------------------------------------------------------------------------
+C
+C Using the read/modify/write "add"s seems to be faster than saving and
+C restoring registers.  Perhaps the loads for the first set hide under the
+C mul latency and the second gets store to load forwarding.
+
+	ALIGN(16)
+L(two_limbs):
+	C eax	src
+	C ebx
+	C ecx	size
+	C edx	dst
+deflit(`FRAME',0)
+
+	pushl	%ebx		FRAME_pushl()
+	movl	%eax, %ebx	C src
+	movl	(%eax), %eax
+
+	movl	%edx, %ecx	C dst
+
+	mull	%eax		C src[0]^2
+
+	movl	%eax, (%ecx)	C dst[0]
+	movl	4(%ebx), %eax
+
+	movl	%edx, 4(%ecx)	C dst[1]
+
+	mull	%eax		C src[1]^2
+
+	movl	%eax, 8(%ecx)	C dst[2]
+	movl	(%ebx), %eax
+
+	movl	%edx, 12(%ecx)	C dst[3]
+
+	mull	4(%ebx)		C src[0]*src[1]
+
+	popl	%ebx
+
+ 	addl	%eax, 4(%ecx)
+	adcl	%edx, 8(%ecx)
+	adcl	$0, 12(%ecx)
+	ASSERT(nc)
+
+	addl	%eax, 4(%ecx)
+	adcl	%edx, 8(%ecx)
+	adcl	$0, 12(%ecx)
+	ASSERT(nc)
+
+	ret
+
+
+C------------------------------------------------------------------------------
+defframe(SAVE_EBX,  -4)
+defframe(SAVE_ESI,  -8)
+defframe(SAVE_EDI, -12)
+defframe(SAVE_EBP, -16)
+deflit(STACK_SPACE, 16)
+
+L(three_or_more):
+	subl	$STACK_SPACE, %esp
+	cmpl	$4, %ecx
+	jae	L(four_or_more)
+deflit(`FRAME',STACK_SPACE)
+
+
+C------------------------------------------------------------------------------
+C Three limbs
+C
+C Writing out the loads and stores separately at the end of this code comes
+C out about 10 cycles faster than using adcls to memory.
+
+	C eax	src
+	C ecx	size
+	C edx	dst
+
+	movl	%ebx, SAVE_EBX
+	movl	%eax, %ebx	C src
+	movl	(%eax), %eax
+
+	movl	%edx, %ecx	C dst
+	movl	%esi, SAVE_ESI
+	movl	%edi, SAVE_EDI
+
+	mull	%eax		C src[0] ^ 2
+
+	movl	%eax, (%ecx)
+	movl	4(%ebx), %eax
+	movl	%edx, 4(%ecx)
+
+	mull	%eax		C src[1] ^ 2
+
+	movl	%eax, 8(%ecx)
+	movl	8(%ebx), %eax
+	movl	%edx, 12(%ecx)
+
+	mull	%eax		C src[2] ^ 2
+
+	movl	%eax, 16(%ecx)
+	movl	(%ebx), %eax
+	movl	%edx, 20(%ecx)
+
+	mull	4(%ebx)		C src[0] * src[1]
+
+	movl	%eax, %esi
+	movl	(%ebx), %eax
+	movl	%edx, %edi
+
+	mull	8(%ebx)		C src[0] * src[2]
+
+	addl	%eax, %edi
+	movl	%ebp, SAVE_EBP
+	movl	$0, %ebp
+
+	movl	4(%ebx), %eax
+	adcl	%edx, %ebp
+
+	mull	8(%ebx)		C src[1] * src[2]
+
+	xorl	%ebx, %ebx
+	addl	%eax, %ebp
+
+	adcl	$0, %edx
+
+	C eax
+	C ebx	zero, will be dst[5]
+	C ecx	dst
+	C edx	dst[4]
+	C esi	dst[1]
+	C edi	dst[2]
+	C ebp	dst[3]
+
+	adcl	$0, %edx
+	addl	%esi, %esi
+
+	adcl	%edi, %edi
+	movl	4(%ecx), %eax
+
+	adcl	%ebp, %ebp
+
+	adcl	%edx, %edx
+
+	adcl	$0, %ebx
+	addl	%eax, %esi
+	movl	8(%ecx), %eax
+
+	adcl	%eax, %edi
+	movl	12(%ecx), %eax
+	movl	%esi, 4(%ecx)
+
+	adcl	%eax, %ebp
+	movl	16(%ecx), %eax
+	movl	%edi, 8(%ecx)
+
+	movl	SAVE_ESI, %esi
+	movl	SAVE_EDI, %edi
+
+	adcl	%eax, %edx
+	movl	20(%ecx), %eax
+	movl	%ebp, 12(%ecx)
+
+	adcl	%ebx, %eax
+	ASSERT(nc)
+	movl	SAVE_EBX, %ebx
+	movl	SAVE_EBP, %ebp
+
+	movl	%edx, 16(%ecx)
+	movl	%eax, 20(%ecx)
+	addl	$FRAME, %esp
+
+	ret
+
+
+C------------------------------------------------------------------------------
+L(four_or_more):
+
+C First multiply src[0]*src[1..size-1] and store at dst[1..size].
+C Further products are added in rather than stored.
+ 
+	C eax	src
+	C ebx
+	C ecx	size
+	C edx	dst
+	C esi
+	C edi
+	C ebp
+
+defframe(`VAR_COUNTER',-20)
+defframe(`VAR_JMP',    -24)
+deflit(EXTRA_STACK_SPACE, 8)
+
+	movl	%ebx, SAVE_EBX
+	movl	%edi, SAVE_EDI
+	leal	(%edx,%ecx,4), %edi	C &dst[size]
+
+	movl	%esi, SAVE_ESI
+	movl	%ebp, SAVE_EBP
+	leal	(%eax,%ecx,4), %esi	C &src[size]
+
+	movl	(%eax), %ebp		C multiplier
+	movl	$0, %ebx
+	decl	%ecx
+
+	negl	%ecx
+	subl	$EXTRA_STACK_SPACE, %esp
+FRAME_subl_esp(EXTRA_STACK_SPACE)
+
+L(mul_1):
+	C eax	scratch
+	C ebx	carry
+	C ecx	counter
+	C edx	scratch
+	C esi	&src[size]
+	C edi	&dst[size]
+	C ebp	multiplier
+
+        movl    (%esi,%ecx,4), %eax
+
+        mull    %ebp
+
+        addl    %ebx, %eax
+        movl    %eax, (%edi,%ecx,4)
+        movl    $0, %ebx
+
+        adcl    %edx, %ebx
+        incl    %ecx
+        jnz     L(mul_1)
+
+
+C Add products src[n]*src[n+1..size-1] at dst[2*n-1...], for each n=1..size-2.
+C
+C The last two products, which are the bottom right corner of the product
+C triangle, are left to the end.  These are src[size-3]*src[size-2,size-1]
+C and src[size-2]*src[size-1].  If size is 4 then it's only these corner
+C cases that need to be done.
+C
+C The unrolled code is the same as in mpn_addmul_1, see that routine for
+C some comments.
+C
+C VAR_COUNTER is the outer loop, running from -size+4 to -1, inclusive.
+C
+C VAR_JMP is the computed jump into the unrolled code, stepped by one code
+C chunk each outer loop.
+C
+C K7 does branch prediction on indirect jumps, which is bad since it's a
+C different target each time.  There seems no way to avoid this.
+
+dnl  This value also hard coded in some shifts and adds
+deflit(CODE_BYTES_PER_LIMB, 17)
+
+dnl  With the unmodified &src[size] and &dst[size] pointers, the
+dnl  displacements in the unrolled code fit in a byte for UNROLL_COUNT
+dnl  values up to 31, but above that an offset must be added to them.
+
+deflit(OFFSET,
+ifelse(eval(UNROLL_COUNT>31),1,
+eval((UNROLL_COUNT-31)*4),
+0))
+
+dnl  Because the last chunk of code is generated differently, a label placed
+dnl  at the end doesn't work.  Instead calculate the implied end using the
+dnl  start and how many chunks of code there are.
+
+deflit(UNROLL_INNER_END,
+`L(unroll_inner_start)+eval(UNROLL_COUNT*CODE_BYTES_PER_LIMB)')
+
+	C eax
+	C ebx	carry
+	C ecx
+	C edx
+	C esi	&src[size]
+	C edi	&dst[size]
+	C ebp
+
+	movl	PARAM_SIZE, %ecx
+	movl	%ebx, (%edi)
+
+	subl	$4, %ecx
+	jz	L(corner)
+
+	negl	%ecx
+ifelse(OFFSET,0,,`subl	$OFFSET, %edi')
+ifelse(OFFSET,0,,`subl	$OFFSET, %esi')
+
+	movl	%ecx, %edx
+	shll	$4, %ecx
+
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(here):
+',`
+	leal	UNROLL_INNER_END-eval(2*CODE_BYTES_PER_LIMB)(%ecx,%edx), %ecx
+')
+
+
+	C The calculated jump mustn't come out to before the start of the
+	C code available.  This is the limit UNROLL_COUNT puts on the src
+	C operand size, but checked here directly using the jump address.
+	ASSERT(ae,
+	`movl_text_address(L(unroll_inner_start), %eax)
+	cmpl	%eax, %ecx')
+
+
+C------------------------------------------------------------------------------
+	ALIGN(16)
+L(unroll_outer_top):
+	C eax
+	C ebx	high limb to store
+	C ecx	VAR_JMP
+	C edx	VAR_COUNTER, limbs, negative
+	C esi	&src[size], constant
+	C edi	dst ptr, high of last addmul
+	C ebp
+
+	movl	-12+OFFSET(%esi,%edx,4), %ebp	C next multiplier
+	movl	-8+OFFSET(%esi,%edx,4), %eax	C first of multiplicand
+
+	movl	%edx, VAR_COUNTER
+
+	mull	%ebp
+
+define(cmovX,`ifelse(eval(UNROLL_COUNT%2),0,`cmovz($@)',`cmovnz($@)')')
+
+	testb	$1, %cl
+	movl	%edx, %ebx	C high carry
+	movl	%ecx, %edx	C jump
+
+	movl	%eax, %ecx	C low carry
+	cmovX(	%ebx, %ecx)	C high carry reverse
+	cmovX(	%eax, %ebx)	C low carry reverse
+
+	leal	CODE_BYTES_PER_LIMB(%edx), %eax
+	xorl	%edx, %edx
+	leal	4(%edi), %edi
+
+	movl	%eax, VAR_JMP
+
+	jmp	*%eax
+
+
+ifdef(`PIC',`
+L(pic_calc):
+	addl	(%esp), %ecx
+	addl	$UNROLL_INNER_END-eval(2*CODE_BYTES_PER_LIMB)-L(here), %ecx
+	addl	%edx, %ecx
+	ret
+')
+
+
+	C Must be an even address to preserve the significance of the low
+	C bit of the jump address indicating which way around ecx/ebx should
+	C start.
+	ALIGN(2)
+
+L(unroll_inner_start):
+	C eax	next limb
+	C ebx	carry high
+	C ecx	carry low
+	C edx	scratch
+	C esi	src
+	C edi	dst
+	C ebp	multiplier
+
+forloop(`i', UNROLL_COUNT, 1, `
+	deflit(`disp_src', eval(-i*4 + OFFSET))
+	deflit(`disp_dst', eval(disp_src - 4))
+
+	m4_assert(`disp_src>=-128 && disp_src<128')
+	m4_assert(`disp_dst>=-128 && disp_dst<128')
+
+ifelse(eval(i%2),0,`
+Zdisp(	movl,	disp_src,(%esi), %eax)
+        adcl    %edx, %ebx
+
+        mull	%ebp
+
+Zdisp(  addl,	%ecx, disp_dst,(%edi))
+	movl	$0, %ecx
+
+	adcl	%eax, %ebx
+
+',`
+	dnl  this bit comes out last
+Zdisp(  movl,	disp_src,(%esi), %eax)
+	adcl	%edx, %ecx
+
+	mull    %ebp
+
+dnl Zdisp(	addl	%ebx, disp_src,(%edi))
+	addl	%ebx, disp_dst(%edi)
+ifelse(forloop_last,0,
+`	movl	$0, %ebx')
+
+	adcl    %eax, %ecx
+')
+')
+
+	C eax	next limb
+	C ebx	carry high
+	C ecx	carry low
+	C edx	scratch
+	C esi	src
+	C edi	dst
+	C ebp	multiplier
+
+        adcl    $0, %edx
+	addl	%ecx, -4+OFFSET(%edi)
+	movl	VAR_JMP, %ecx
+
+        adcl    $0, %edx
+	
+	movl	%edx, m4_empty_if_zero(OFFSET) (%edi)
+	movl	VAR_COUNTER, %edx
+
+	incl	%edx
+	jnz	L(unroll_outer_top)
+	
+
+ifelse(OFFSET,0,,`
+	addl	$OFFSET, %esi
+	addl	$OFFSET, %edi
+')
+
+
+C------------------------------------------------------------------------------
+L(corner):
+	C esi	&src[size]
+	C edi	&dst[2*size-5]
+
+	movl	-12(%esi), %ebp
+	movl	-8(%esi), %eax
+	movl	%eax, %ecx
+
+	mull	%ebp
+
+	addl	%eax, -4(%edi)
+	movl	-4(%esi), %eax
+
+	adcl	$0, %edx
+	movl	%edx, %ebx
+	movl	%eax, %esi
+
+	mull	%ebp
+
+	addl	%ebx, %eax
+
+	adcl	$0, %edx
+	addl	%eax, (%edi)
+	movl	%esi, %eax
+
+	adcl	$0, %edx
+	movl	%edx, %ebx
+
+	mull	%ecx
+
+	addl	%ebx, %eax
+	movl	%eax, 4(%edi)
+
+	adcl	$0, %edx
+	movl	%edx, 8(%edi)
+	
+
+
+C Left shift of dst[1..2*size-2], high bit shifted out becomes dst[2*size-1].
+
+L(lshift_start):
+	movl	PARAM_SIZE, %eax
+	movl	PARAM_DST, %edi
+	xorl	%ecx, %ecx		C clear carry
+
+	leal	(%edi,%eax,8), %edi
+	notl	%eax			C -size-1, preserve carry
+
+	leal	2(%eax), %eax		C -(size-1)
+
+L(lshift):
+	C eax	counter, negative
+	C ebx
+	C ecx
+	C edx
+	C esi
+	C edi	dst, pointing just after last limb
+	C ebp
+
+	rcll	-4(%edi,%eax,8)
+	rcll	(%edi,%eax,8)
+	incl	%eax
+	jnz	L(lshift)
+
+	setc	%al
+
+	movl	PARAM_SRC, %esi
+	movl	%eax, -4(%edi)		C dst most significant limb
+
+	movl	PARAM_SIZE, %ecx
+
+
+C Now add in the squares on the diagonal, src[0]^2, src[1]^2, ...,
+C src[size-1]^2.  dst[0] hasn't yet been set at all yet, and just gets the
+C low limb of src[0]^2.
+
+	movl	(%esi), %eax		C src[0]
+
+	mull	%eax
+
+	leal	(%esi,%ecx,4), %esi	C src point just after last limb
+	negl	%ecx
+
+	movl	%eax, (%edi,%ecx,8)	C dst[0]
+	incl	%ecx
+
+L(diag):
+	C eax	scratch
+	C ebx	scratch
+	C ecx	counter, negative
+	C edx	carry
+	C esi	src just after last limb
+	C edi	dst just after last limb
+	C ebp
+
+	movl	(%esi,%ecx,4), %eax
+	movl	%edx, %ebx
+
+	mull	%eax
+
+	addl	%ebx, -4(%edi,%ecx,8)
+	adcl	%eax, (%edi,%ecx,8)
+	adcl	$0, %edx
+
+	incl	%ecx
+	jnz	L(diag)
+
+
+	movl	SAVE_ESI, %esi
+	movl	SAVE_EBX, %ebx
+
+	addl	%edx, -4(%edi)		C dst most significant limb
+	movl	SAVE_EDI, %edi
+
+	movl	SAVE_EBP, %ebp
+	addl	$FRAME, %esp
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/lshift.asm b/src/gmp/mpn/x86/lshift.asm
new file mode 100644
index 000000000..4735335cb
--- /dev/null
+++ b/src/gmp/mpn/x86/lshift.asm
@@ -0,0 +1,90 @@
+dnl  x86 mpn_lshift -- mpn left shift.
+
+dnl  Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation,
+dnl  Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+
+	.text
+	ALIGN(8)
+PROLOGUE(mpn_lshift)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+deflit(`FRAME',12)
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC,%esi
+	movl	PARAM_SIZE,%edx
+	movl	PARAM_SHIFT,%ecx
+
+	subl	$4,%esi			C adjust src
+
+	movl	(%esi,%edx,4),%ebx	C read most significant limb
+	xorl	%eax,%eax
+	shldl(	%cl, %ebx, %eax)	C compute carry limb
+	decl	%edx
+	jz	L(end)
+	pushl	%eax			C push carry limb onto stack
+	testb	$1,%dl
+	jnz	L(1)			C enter loop in the middle
+	movl	%ebx,%eax
+
+	ALIGN(8)
+L(oop):	movl	(%esi,%edx,4),%ebx	C load next lower limb
+	shldl(	%cl, %ebx, %eax)	C compute result limb
+	movl	%eax,(%edi,%edx,4)	C store it
+	decl	%edx
+L(1):	movl	(%esi,%edx,4),%eax
+	shldl(	%cl, %eax, %ebx)
+	movl	%ebx,(%edi,%edx,4)
+	decl	%edx
+	jnz	L(oop)
+
+	shll	%cl,%eax		C compute least significant limb
+	movl	%eax,(%edi)		C store it
+
+	popl	%eax			C pop carry limb
+
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+L(end):	shll	%cl,%ebx		C compute least significant limb
+	movl	%ebx,(%edi)		C store it
+
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/mod_1.asm b/src/gmp/mpn/x86/mod_1.asm
new file mode 100644
index 000000000..3908161b3
--- /dev/null
+++ b/src/gmp/mpn/x86/mod_1.asm
@@ -0,0 +1,141 @@
+dnl  x86 mpn_mod_1 -- mpn by limb remainder.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+dnl        cycles/limb
+dnl  K6        20
+dnl  P5        44
+dnl  P6        39
+dnl  486   approx 42 maybe
+dnl
+dnl  The following have their own optimized mod_1 implementations, but for
+dnl  reference the code here runs as follows.
+dnl
+dnl  P6MMX     39
+dnl  K7        41
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_mod_1 (mp_srcptr src, mp_size_t size, mp_limb_t divisor);
+C mp_limb_t mpn_mod_1c (mp_srcptr src, mp_size_t size, mp_limb_t divisor,
+C                       mp_limb_t carry);
+C
+C Divide src,size by divisor and return the remainder.  The quotient is
+C discarded.
+C
+C See mpn/x86/divrem_1.asm for some comments.
+
+defframe(PARAM_CARRY,  16)
+defframe(PARAM_DIVISOR,12)
+defframe(PARAM_SIZE,   8)
+defframe(PARAM_SRC,    4)
+
+	.text
+	ALIGN(16)
+
+PROLOGUE(mpn_mod_1c)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	pushl	%ebx		FRAME_pushl()
+
+	movl	PARAM_SRC, %ebx
+	pushl	%esi		FRAME_pushl()
+
+	movl	PARAM_DIVISOR, %esi
+	orl	%ecx, %ecx
+
+	movl	PARAM_CARRY, %edx
+	jnz	LF(mpn_mod_1,top)
+
+	popl	%esi
+	movl	%edx, %eax
+
+	popl	%ebx
+	
+	ret
+
+EPILOGUE()
+
+
+PROLOGUE(mpn_mod_1)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	pushl	%ebx		FRAME_pushl()
+
+	movl	PARAM_SRC, %ebx
+	pushl	%esi		FRAME_pushl()
+
+	orl	%ecx, %ecx
+	jz	L(done_zero)
+
+	movl	PARAM_DIVISOR, %esi
+	movl	-4(%ebx,%ecx,4), %eax	C src high limb
+
+	cmpl	%esi, %eax
+
+	sbbl	%edx, %edx		C -1 if high<divisor
+
+	addl	%edx, %ecx		C skip one division if high<divisor
+	jz	L(done_eax)
+
+	andl	%eax, %edx		C carry if high<divisor
+
+
+L(top):
+	C eax	scratch (quotient)
+	C ebx	src
+	C ecx	counter
+	C edx	carry (remainder)
+	C esi	divisor
+	C edi
+	C ebp
+
+	movl	-4(%ebx,%ecx,4), %eax
+
+	divl	%esi
+
+	loop_or_decljnz	L(top)
+
+
+	movl	%edx, %eax
+L(done_eax):
+	popl	%esi
+
+	popl	%ebx
+
+	ret
+
+
+L(done_zero):
+	popl	%esi
+	xorl	%eax, %eax
+
+	popl	%ebx
+
+	ret
+	
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/mul_1.asm b/src/gmp/mpn/x86/mul_1.asm
new file mode 100644
index 000000000..8817f291b
--- /dev/null
+++ b/src/gmp/mpn/x86/mul_1.asm
@@ -0,0 +1,130 @@
+dnl  x86 mpn_mul_1 (for 386, 486, and Pentium Pro) -- Multiply a limb vector
+dnl  with a limb and store the result in a second limb vector.
+dnl 
+dnl      cycles/limb
+dnl  P6:     5.5
+dnl
+dnl  The following CPUs have their own optimized code, but for reference the
+dnl  code here runs as follows.
+dnl
+dnl      cycles/limb
+dnl  P5:    12.5
+dnl  K6:    10.5
+dnl  K7:     4.5
+
+
+dnl  Copyright (C) 1992, 1994, 1997, 1998, 1999, 2000 Free Software
+dnl  Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_mul_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                      mp_limb_t multiplier);
+
+defframe(PARAM_MULTIPLIER,16)
+defframe(PARAM_SIZE,      12)
+defframe(PARAM_SRC,       8)
+defframe(PARAM_DST,       4)
+
+	TEXT
+	ALIGN(8)
+PROLOGUE(mpn_mul_1)
+deflit(`FRAME',0)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+deflit(`FRAME',16)
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC,%esi
+	movl	PARAM_SIZE,%ecx
+
+	xorl	%ebx,%ebx
+	andl	$3,%ecx
+	jz	L(end0)
+
+L(oop0):
+	movl	(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	leal	4(%esi),%esi
+	addl	%ebx,%eax
+	movl	$0,%ebx
+	adcl	%ebx,%edx
+	movl	%eax,(%edi)
+	movl	%edx,%ebx	C propagate carry into cylimb
+
+	leal	4(%edi),%edi
+	decl	%ecx
+	jnz	L(oop0)
+
+L(end0):
+	movl	PARAM_SIZE,%ecx
+	shrl	$2,%ecx
+	jz	L(end)
+
+
+	ALIGN(8)
+L(oop):	movl	(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	addl	%eax,%ebx
+	movl	$0,%ebp
+	adcl	%edx,%ebp
+
+	movl	4(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	movl	%ebx,(%edi)
+	addl	%eax,%ebp	C new lo + cylimb
+	movl	$0,%ebx
+	adcl	%edx,%ebx
+
+	movl	8(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	movl	%ebp,4(%edi)
+	addl	%eax,%ebx	C new lo + cylimb
+	movl	$0,%ebp
+	adcl	%edx,%ebp
+
+	movl	12(%esi),%eax
+	mull	PARAM_MULTIPLIER
+	movl	%ebx,8(%edi)
+	addl	%eax,%ebp	C new lo + cylimb
+	movl	$0,%ebx
+	adcl	%edx,%ebx
+
+	movl	%ebp,12(%edi)
+
+	leal	16(%esi),%esi
+	leal	16(%edi),%edi
+	decl	%ecx
+	jnz	L(oop)
+
+L(end):	movl	%ebx,%eax
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/mul_basecase.asm b/src/gmp/mpn/x86/mul_basecase.asm
new file mode 100644
index 000000000..3a9b73895
--- /dev/null
+++ b/src/gmp/mpn/x86/mul_basecase.asm
@@ -0,0 +1,209 @@
+dnl  x86 mpn_mul_basecase -- Multiply two limb vectors and store the result
+dnl  in a third limb vector.
+
+
+dnl  Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation,
+dnl  Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C void mpn_mul_basecase (mp_ptr wp,
+C                        mp_srcptr xp, mp_size_t xsize,
+C                        mp_srcptr yp, mp_size_t ysize);
+C
+C This was written in a haste since the Pentium optimized code that was used
+C for all x86 machines was slow for the Pentium II.  This code would benefit
+C from some cleanup.
+C
+C To shave off some percentage of the run-time, one should make 4 variants
+C of the Louter loop, for the four different outcomes of un mod 4.  That
+C would avoid Loop0 altogether.  Code expansion would be > 4-fold for that
+C part of the function, but since it is not very large, that would be
+C acceptable.
+C
+C The mul loop (at L(oopM)) might need some tweaking.  It's current speed is
+C unknown.
+
+defframe(PARAM_YSIZE,20)
+defframe(PARAM_YP,   16)
+defframe(PARAM_XSIZE,12)
+defframe(PARAM_XP,   8)
+defframe(PARAM_WP,   4)
+
+defframe(VAR_MULTIPLIER, -4)
+defframe(VAR_COUNTER,    -8)
+deflit(VAR_STACK_SPACE,  8)
+
+	.text
+	ALIGN(8)
+
+PROLOGUE(mpn_mul_basecase)
+deflit(`FRAME',0)
+
+	subl	$VAR_STACK_SPACE,%esp
+	pushl	%esi
+	pushl	%ebp
+	pushl	%edi
+deflit(`FRAME',eval(VAR_STACK_SPACE+12))
+
+	movl	PARAM_XP,%esi
+	movl	PARAM_WP,%edi
+	movl	PARAM_YP,%ebp
+
+	movl	(%esi),%eax		C load xp[0]
+	mull	(%ebp)			C multiply by yp[0]
+	movl	%eax,(%edi)		C store to wp[0]
+	movl	PARAM_XSIZE,%ecx	C xsize
+	decl	%ecx			C If xsize = 1, ysize = 1 too
+	jz	L(done)
+
+	pushl	%ebx
+FRAME_pushl()
+	movl	%edx,%ebx
+
+	leal	4(%esi),%esi
+	leal	4(%edi),%edi
+
+L(oopM):
+	movl	(%esi),%eax		C load next limb at xp[j]
+	leal	4(%esi),%esi
+	mull	(%ebp)
+	addl	%ebx,%eax
+	movl	%edx,%ebx
+	adcl	$0,%ebx
+	movl	%eax,(%edi)
+	leal	4(%edi),%edi
+	decl	%ecx
+	jnz	L(oopM)
+
+	movl	%ebx,(%edi)		C most significant limb of product
+	addl	$4,%edi			C increment wp
+	movl	PARAM_XSIZE,%eax
+	shll	$2,%eax
+	subl	%eax,%edi
+	subl	%eax,%esi
+
+	movl	PARAM_YSIZE,%eax	C ysize
+	decl	%eax
+	jz	L(skip)
+	movl	%eax,VAR_COUNTER	C set index i to ysize
+
+L(outer):
+	movl	PARAM_YP,%ebp		C yp
+	addl	$4,%ebp			C make ebp point to next v limb
+	movl	%ebp,PARAM_YP
+	movl	(%ebp),%eax		C copy y limb ...
+	movl	%eax,VAR_MULTIPLIER	C ... to stack slot
+	movl	PARAM_XSIZE,%ecx
+
+	xorl	%ebx,%ebx
+	andl	$3,%ecx
+	jz	L(end0)
+
+L(oop0):
+	movl	(%esi),%eax
+	mull	VAR_MULTIPLIER
+	leal	4(%esi),%esi
+	addl	%ebx,%eax
+	movl	$0,%ebx
+	adcl	%ebx,%edx
+	addl	%eax,(%edi)
+	adcl	%edx,%ebx		C propagate carry into cylimb
+
+	leal	4(%edi),%edi
+	decl	%ecx
+	jnz	L(oop0)
+
+L(end0):
+	movl	PARAM_XSIZE,%ecx
+	shrl	$2,%ecx
+	jz	L(endX)
+
+	ALIGN(8)
+L(oopX):
+	movl	(%esi),%eax
+	mull	VAR_MULTIPLIER
+	addl	%eax,%ebx
+	movl	$0,%ebp
+	adcl	%edx,%ebp
+
+	movl	4(%esi),%eax
+	mull	VAR_MULTIPLIER
+	addl	%ebx,(%edi)
+	adcl	%eax,%ebp	C new lo + cylimb
+	movl	$0,%ebx
+	adcl	%edx,%ebx
+
+	movl	8(%esi),%eax
+	mull	VAR_MULTIPLIER
+	addl	%ebp,4(%edi)
+	adcl	%eax,%ebx	C new lo + cylimb
+	movl	$0,%ebp
+	adcl	%edx,%ebp
+
+	movl	12(%esi),%eax
+	mull	VAR_MULTIPLIER
+	addl	%ebx,8(%edi)
+	adcl	%eax,%ebp	C new lo + cylimb
+	movl	$0,%ebx
+	adcl	%edx,%ebx
+
+	addl	%ebp,12(%edi)
+	adcl	$0,%ebx		C propagate carry into cylimb
+
+	leal	16(%esi),%esi
+	leal	16(%edi),%edi
+	decl	%ecx
+	jnz	L(oopX)
+
+L(endX):
+	movl	%ebx,(%edi)
+	addl	$4,%edi
+
+	C we incremented wp and xp in the loop above; compensate
+	movl	PARAM_XSIZE,%eax
+	shll	$2,%eax
+	subl	%eax,%edi
+	subl	%eax,%esi
+
+	movl	VAR_COUNTER,%eax
+	decl	%eax
+	movl	%eax,VAR_COUNTER
+	jnz	L(outer)
+
+L(skip):
+	popl	%ebx
+	popl	%edi
+	popl	%ebp
+	popl	%esi
+	addl	$8,%esp
+	ret
+
+L(done):
+	movl	%edx,4(%edi)	   C store to wp[1]
+	popl	%edi
+	popl	%ebp
+	popl	%esi
+	addl	$8,%esp
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/p6/README b/src/gmp/mpn/x86/p6/README
new file mode 100644
index 000000000..7dbc905a0
--- /dev/null
+++ b/src/gmp/mpn/x86/p6/README
@@ -0,0 +1,95 @@
+
+                      INTEL P6 MPN SUBROUTINES
+
+
+
+This directory contains code optimized for Intel P6 class CPUs, meaning
+PentiumPro, Pentium II and Pentium III.  The mmx and p3mmx subdirectories
+have routines using MMX instructions.
+
+
+
+STATUS
+
+Times for the loops, with all code and data in L1 cache, are as follows.
+Some of these might be able to be improved.
+
+                               cycles/limb
+
+	mpn_add_n/sub_n           3.7
+
+	mpn_copyi                 0.75
+	mpn_copyd                 2.4
+
+	mpn_divrem_1             39.0
+	mpn_mod_1                39.0
+	mpn_divexact_by3          8.5
+
+	mpn_mul_1                 5.5
+	mpn_addmul/submul_1       6.35
+
+	mpn_l/rshift              2.5
+
+	mpn_mul_basecase          8.2 cycles/crossproduct (approx)
+	mpn_sqr_basecase          4.0 cycles/crossproduct (approx)
+	                          or 7.75 cycles/triangleproduct (approx)
+
+Pentium II and III have MMX and get the following improvements.
+
+	mpn_divrem_1             25.0 integer part, 17.5 fractional part
+	mpn_mod_1                24.0
+
+	mpn_l/rshift              1.75
+
+
+
+
+NOTES
+
+Write-allocate L1 data cache means prefetching of destinations is unnecessary.
+
+Mispredicted branches have a penalty of between 9 and 15 cycles, and even up
+to 26 cycles depending how far speculative execution has gone.  The 9 cycle
+minimum penalty comes from the issue pipeline being 9 stages.
+
+A copy with rep movs seems to copy 16 bytes at a time, since speeds for 4,
+5, 6 or 7 limb operations are all the same.  The 0.75 cycles/limb would be 3
+cycles per 16 byte block.
+
+
+
+
+CODING
+
+Instructions in general code have been shown grouped if they can execute
+together, which means up to three instructions with no successive
+dependencies, and with only the first being a multiple micro-op.
+
+P6 has out-of-order execution, so the groupings are really only showing
+dependent paths where some shuffling might allow some latencies to be
+hidden.
+
+
+
+
+REFERENCES
+
+"Intel Architecture Optimization Reference Manual", 1999, revision 001 dated
+02/99, order number 245127 (order number 730795-001 is in the document too).
+Available on-line:
+
+	http://download.intel.com/design/PentiumII/manuals/245127.htm
+
+"Intel Architecture Optimization Manual", 1997, order number 242816.  This
+is an older document mostly about P5 and not as good as the above.
+Available on-line:
+
+	http://download.intel.com/design/PentiumII/manuals/242816.htm
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 76
+End:
diff --git a/src/gmp/mpn/x86/p6/aorsmul_1.asm b/src/gmp/mpn/x86/p6/aorsmul_1.asm
new file mode 100644
index 000000000..feb364ec0
--- /dev/null
+++ b/src/gmp/mpn/x86/p6/aorsmul_1.asm
@@ -0,0 +1,300 @@
+dnl  Intel P6 mpn_addmul_1/mpn_submul_1 -- add or subtract mpn multiple.
+dnl 
+dnl  P6: 6.35 cycles/limb (at 16 limbs/loop).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  P6 UNROLL_COUNT cycles/limb
+dnl          8           6.7
+dnl         16           6.35
+dnl         32           6.3
+dnl         64           6.3
+dnl  Maximum possible with the current code is 64.
+
+deflit(UNROLL_COUNT, 16)
+
+
+ifdef(`OPERATION_addmul_1', `
+	define(M4_inst,        addl)
+	define(M4_function_1,  mpn_addmul_1)
+	define(M4_function_1c, mpn_addmul_1c)
+	define(M4_description, add it to)
+	define(M4_desc_retval, carry)
+',`ifdef(`OPERATION_submul_1', `
+	define(M4_inst,        subl)
+	define(M4_function_1,  mpn_submul_1)
+	define(M4_function_1c, mpn_submul_1c)
+	define(M4_description, subtract it from)
+	define(M4_desc_retval, borrow)
+',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
+')')')
+
+MULFUNC_PROLOGUE(mpn_addmul_1 mpn_addmul_1c mpn_submul_1 mpn_submul_1c)
+
+
+C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                            mp_limb_t mult);
+C mp_limb_t M4_function_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                             mp_limb_t mult, mp_limb_t carry);
+C
+C Calculate src,size multiplied by mult and M4_description dst,size.
+C Return the M4_desc_retval limb from the top of the result.
+C
+C This code is pretty much the same as the K6 code.  The unrolled loop is
+C the same, but there's just a few scheduling tweaks in the setups and the
+C simple loop.
+C
+C A number of variations have been tried for the unrolled loop, with one or
+C two carries, and with loads scheduled earlier, but nothing faster than 6
+C cycles/limb has been found.
+
+ifdef(`PIC',`
+deflit(UNROLL_THRESHOLD, 5)
+',`
+deflit(UNROLL_THRESHOLD, 5)
+')
+
+defframe(PARAM_CARRY,     20)
+defframe(PARAM_MULTIPLIER,16)
+defframe(PARAM_SIZE,      12)
+defframe(PARAM_SRC,       8)
+defframe(PARAM_DST,       4)
+
+	.text
+	ALIGN(32)
+
+PROLOGUE(M4_function_1c)
+	pushl	%ebx
+deflit(`FRAME',4)
+	movl	PARAM_CARRY, %ebx
+	jmp	LF(M4_function_1,start_nc)
+EPILOGUE()
+
+PROLOGUE(M4_function_1)
+	push	%ebx
+deflit(`FRAME',4)
+	xorl	%ebx, %ebx	C initial carry
+
+L(start_nc):
+	movl	PARAM_SIZE, %ecx
+	pushl	%esi
+deflit(`FRAME',8)
+
+	movl	PARAM_SRC, %esi
+	pushl	%edi
+deflit(`FRAME',12)
+
+	movl	PARAM_DST, %edi
+	pushl	%ebp
+deflit(`FRAME',16)
+	cmpl	$UNROLL_THRESHOLD, %ecx
+
+	movl	PARAM_MULTIPLIER, %ebp
+	jae	L(unroll)
+
+	
+	C simple loop
+	C this is offset 0x22, so close enough to aligned
+L(simple):
+	C eax	scratch
+	C ebx	carry
+	C ecx	counter
+	C edx	scratch
+	C esi	src
+	C edi	dst
+	C ebp	multiplier
+
+	movl	(%esi), %eax
+	addl	$4, %edi
+
+	mull	%ebp
+
+	addl	%ebx, %eax
+	adcl	$0, %edx
+
+	M4_inst	%eax, -4(%edi)
+	movl	%edx, %ebx
+
+	adcl	$0, %ebx
+	decl	%ecx
+
+	leal	4(%esi), %esi
+	jnz	L(simple)
+
+
+	popl	%ebp
+	popl	%edi
+
+	popl	%esi
+	movl	%ebx, %eax
+
+	popl	%ebx
+	ret
+
+
+
+C------------------------------------------------------------------------------
+C VAR_JUMP holds the computed jump temporarily because there's not enough
+C registers when doing the mul for the initial two carry limbs.
+C
+C The add/adc for the initial carry in %ebx is necessary only for the
+C mpn_add/submul_1c entry points.  Duplicating the startup code to
+C eliminiate this for the plain mpn_add/submul_1 doesn't seem like a good
+C idea.
+
+dnl  overlapping with parameters already fetched
+define(VAR_COUNTER,`PARAM_SIZE')
+define(VAR_JUMP,   `PARAM_DST')
+
+	C this is offset 0x43, so close enough to aligned
+L(unroll):
+	C eax
+	C ebx	initial carry
+	C ecx	size
+	C edx
+	C esi	src
+	C edi	dst
+	C ebp
+
+	movl	%ecx, %edx
+	decl	%ecx
+
+	subl	$2, %edx
+	negl	%ecx
+
+	shrl	$UNROLL_LOG2, %edx
+	andl	$UNROLL_MASK, %ecx
+
+	movl	%edx, VAR_COUNTER
+	movl	%ecx, %edx
+
+	C 15 code bytes per limb
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(here):
+',`
+	shll	$4, %edx
+	negl	%ecx
+
+	leal	L(entry) (%edx,%ecx,1), %edx
+')
+	movl	(%esi), %eax		C src low limb
+
+	movl	%edx, VAR_JUMP
+	leal	ifelse(UNROLL_BYTES,256,128+) 4(%esi,%ecx,4), %esi
+
+	mull	%ebp
+
+	addl	%ebx, %eax	C initial carry (from _1c)
+	adcl	$0, %edx
+
+	movl	%edx, %ebx	C high carry
+	leal	ifelse(UNROLL_BYTES,256,128) (%edi,%ecx,4), %edi
+
+	movl	VAR_JUMP, %edx
+	testl	$1, %ecx
+	movl	%eax, %ecx	C low carry
+
+	cmovnz(	%ebx, %ecx)	C high,low carry other way around
+	cmovnz(	%eax, %ebx)
+
+	jmp	*%edx
+
+
+ifdef(`PIC',`
+L(pic_calc):
+	shll	$4, %edx
+	negl	%ecx
+
+	C See README.family about old gas bugs
+	leal	(%edx,%ecx,1), %edx
+	addl	$L(entry)-L(here), %edx
+
+	addl	(%esp), %edx
+
+	ret
+')
+
+
+C -----------------------------------------------------------
+	ALIGN(32)
+L(top):
+deflit(`FRAME',16)
+	C eax	scratch
+	C ebx	carry hi
+	C ecx	carry lo
+	C edx	scratch
+	C esi	src
+	C edi	dst
+	C ebp	multiplier
+	C
+	C VAR_COUNTER	loop counter
+	C
+	C 15 code bytes per limb
+
+	addl	$UNROLL_BYTES, %edi
+
+L(entry):
+deflit(CHUNK_COUNT,2)
+forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
+	deflit(`disp0', eval(i*4*CHUNK_COUNT ifelse(UNROLL_BYTES,256,-128)))
+	deflit(`disp1', eval(disp0 + 4))
+
+Zdisp(	movl,	disp0,(%esi), %eax)
+	mull	%ebp
+Zdisp(	M4_inst,%ecx, disp0,(%edi))
+	adcl	%eax, %ebx
+	movl	%edx, %ecx
+	adcl	$0, %ecx
+
+	movl	disp1(%esi), %eax
+	mull	%ebp
+	M4_inst	%ebx, disp1(%edi)
+	adcl	%eax, %ecx
+	movl	%edx, %ebx
+	adcl	$0, %ebx
+')
+
+	decl	VAR_COUNTER
+	leal	UNROLL_BYTES(%esi), %esi
+
+	jns	L(top)
+
+
+deflit(`disp0',	eval(UNROLL_BYTES ifelse(UNROLL_BYTES,256,-128)))
+
+	M4_inst	%ecx, disp0(%edi)
+	movl	%ebx, %eax
+
+	popl	%ebp
+	popl	%edi
+
+	popl	%esi
+	popl	%ebx
+	adcl	$0, %eax
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/p6/diveby3.asm b/src/gmp/mpn/x86/p6/diveby3.asm
new file mode 100644
index 000000000..a77703ea8
--- /dev/null
+++ b/src/gmp/mpn/x86/p6/diveby3.asm
@@ -0,0 +1,37 @@
+dnl  Intel P6 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
+dnl       
+dnl  P6: 8.5 cycles/limb
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+dnl  The P5 code runs well on P6, in fact better than anything else found so
+dnl  far.  An imul is 4 cycles, meaning the two cmp/sbbl pairs on the
+dnl  dependent path are taking 4.5 cycles.
+dnl
+dnl  The destination cache line prefetching is unnecessary on P6, but
+dnl  removing it is a 2 cycle slowdown (approx), so it must be inducing
+dnl  something good in the out of order execution.
+
+include(`../config.m4')
+
+MULFUNC_PROLOGUE(mpn_divexact_by3c)
+include_mpn(`x86/pentium/diveby3.asm')
diff --git a/src/gmp/mpn/x86/p6/gmp-mparam.h b/src/gmp/mpn/x86/p6/gmp-mparam.h
new file mode 100644
index 000000000..d7bfb6d60
--- /dev/null
+++ b/src/gmp/mpn/x86/p6/gmp-mparam.h
@@ -0,0 +1,96 @@
+/* Intel P6 gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+
+#ifndef UMUL_TIME
+#define UMUL_TIME   5   /* cycles */
+#endif
+#ifndef UDIV_TIME
+#define UDIV_TIME   39  /* cycles */
+#endif
+
+#ifndef COUNT_TRAILING_ZEROS_TIME
+#define COUNT_TRAILING_ZEROS_TIME   2  /* cycles */
+#endif
+
+
+/* Generated by tuneup.c, 2000-07-06. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   23
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD      139
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   52
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD      166
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD             116
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD             66
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            20
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        4
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD          54
+#endif
+
+#ifndef FFT_MUL_TABLE
+#define FFT_MUL_TABLE  { 592, 1440, 2688, 5632, 14336, 40960, 0 }
+#endif
+#ifndef FFT_MODF_MUL_THRESHOLD
+#define FFT_MODF_MUL_THRESHOLD     608
+#endif
+#ifndef FFT_MUL_THRESHOLD
+#define FFT_MUL_THRESHOLD         5888
+#endif
+
+#ifndef FFT_SQR_TABLE
+#define FFT_SQR_TABLE  { 656, 1504, 2944, 6656, 18432, 57344, 0 }
+#endif
+#ifndef FFT_MODF_SQR_THRESHOLD
+#define FFT_MODF_SQR_THRESHOLD     672
+#endif
+#ifndef FFT_SQR_THRESHOLD
+#define FFT_SQR_THRESHOLD         5888
+#endif
diff --git a/src/gmp/mpn/x86/p6/mmx/divrem_1.asm b/src/gmp/mpn/x86/p6/mmx/divrem_1.asm
new file mode 100644
index 000000000..f1b011b62
--- /dev/null
+++ b/src/gmp/mpn/x86/p6/mmx/divrem_1.asm
@@ -0,0 +1,677 @@
+dnl  Intel Pentium-II mpn_divrem_1 -- mpn by limb division.
+dnl 
+dnl  P6MMX: 25.0 cycles/limb integer part, 17.5 cycles/limb fraction part.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_divrem_1 (mp_ptr dst, mp_size_t xsize,
+C                         mp_srcptr src, mp_size_t size,
+C                         mp_limb_t divisor);
+C mp_limb_t mpn_divrem_1c (mp_ptr dst, mp_size_t xsize,
+C                          mp_srcptr src, mp_size_t size,
+C                          mp_limb_t divisor, mp_limb_t carry);
+C
+C This code is a lightly reworked version of mpn/x86/k7/mmx/divrem_1.asm,
+C see that file for some comments.  It's likely what's here can be improved.
+
+
+dnl  MUL_THRESHOLD is the value of xsize+size at which the multiply by
+dnl  inverse method is used, rather than plain "divl"s.  Minimum value 1.
+dnl
+dnl  The different speeds of the integer and fraction parts means that using
+dnl  xsize+size isn't quite right.  The threshold wants to be a bit higher
+dnl  for the integer part and a bit lower for the fraction part.  (Or what's
+dnl  really wanted is to speed up the integer part!)
+dnl
+dnl  The threshold is set to make the integer part right.  At 4 limbs the
+dnl  div and mul are about the same there, but on the fractional part the
+dnl  mul is much faster.
+
+deflit(MUL_THRESHOLD, 4)
+
+
+defframe(PARAM_CARRY,  24)
+defframe(PARAM_DIVISOR,20)
+defframe(PARAM_SIZE,   16)
+defframe(PARAM_SRC,    12)
+defframe(PARAM_XSIZE,  8)
+defframe(PARAM_DST,    4)
+
+defframe(SAVE_EBX,    -4)
+defframe(SAVE_ESI,    -8)
+defframe(SAVE_EDI,    -12)
+defframe(SAVE_EBP,    -16)
+
+defframe(VAR_NORM,    -20)
+defframe(VAR_INVERSE, -24)
+defframe(VAR_SRC,     -28)
+defframe(VAR_DST,     -32)
+defframe(VAR_DST_STOP,-36)
+
+deflit(STACK_SPACE, 36)
+
+	.text
+	ALIGN(16)
+
+PROLOGUE(mpn_divrem_1c)
+deflit(`FRAME',0)
+	movl	PARAM_CARRY, %edx
+
+	movl	PARAM_SIZE, %ecx
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%ebx, SAVE_EBX
+	movl	PARAM_XSIZE, %ebx
+
+	movl	%edi, SAVE_EDI
+	movl	PARAM_DST, %edi
+
+	movl	%ebp, SAVE_EBP
+	movl	PARAM_DIVISOR, %ebp
+
+	movl	%esi, SAVE_ESI
+	movl	PARAM_SRC, %esi
+
+	leal	-4(%edi,%ebx,4), %edi
+	jmp	LF(mpn_divrem_1,start_1c)
+
+EPILOGUE()
+
+
+	C offset 0x31, close enough to aligned
+PROLOGUE(mpn_divrem_1)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %ecx
+	movl	$0, %edx		C initial carry (if can't skip a div)
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%ebp, SAVE_EBP
+	movl	PARAM_DIVISOR, %ebp
+
+	movl	%ebx, SAVE_EBX
+	movl	PARAM_XSIZE, %ebx
+
+	movl	%esi, SAVE_ESI
+	movl	PARAM_SRC, %esi
+	orl	%ecx, %ecx
+
+	movl	%edi, SAVE_EDI
+	movl	PARAM_DST, %edi
+
+	leal	-4(%edi,%ebx,4), %edi	C &dst[xsize-1]
+	jz	L(no_skip_div)
+
+	movl	-4(%esi,%ecx,4), %eax	C src high limb
+	cmpl	%ebp, %eax		C one less div if high<divisor
+	jnb	L(no_skip_div)
+
+	movl	$0, (%edi,%ecx,4)	C dst high limb
+	decl	%ecx			C size-1
+	movl	%eax, %edx		C src high limb as initial carry
+L(no_skip_div):
+
+
+L(start_1c):
+	C eax	
+	C ebx	xsize
+	C ecx	size
+	C edx	carry
+	C esi	src
+	C edi	&dst[xsize-1]
+	C ebp	divisor
+
+	leal	(%ebx,%ecx), %eax	C size+xsize
+	cmpl	$MUL_THRESHOLD, %eax
+	jae	L(mul_by_inverse)
+
+	orl	%ecx, %ecx
+	jz	L(divide_no_integer)
+
+L(divide_integer):
+	C eax	scratch (quotient)
+	C ebx	xsize
+	C ecx	counter
+	C edx	scratch (remainder)
+	C esi	src
+	C edi	&dst[xsize-1]
+	C ebp	divisor
+
+	movl	-4(%esi,%ecx,4), %eax
+
+	divl	%ebp
+
+	movl	%eax, (%edi,%ecx,4)
+	decl	%ecx
+	jnz	L(divide_integer)
+
+
+L(divide_no_integer):
+	movl	PARAM_DST, %edi
+	orl	%ebx, %ebx
+	jnz	L(divide_fraction)
+
+L(divide_done):
+	movl	SAVE_ESI, %esi
+
+	movl	SAVE_EDI, %edi
+
+	movl	SAVE_EBX, %ebx
+	movl	%edx, %eax
+
+	movl	SAVE_EBP, %ebp
+	addl	$STACK_SPACE, %esp
+
+	ret
+
+
+L(divide_fraction):
+	C eax	scratch (quotient)
+	C ebx	counter
+	C ecx
+	C edx	scratch (remainder)
+	C esi
+	C edi	dst
+	C ebp	divisor
+
+	movl	$0, %eax
+
+	divl	%ebp
+
+	movl	%eax, -4(%edi,%ebx,4)
+	decl	%ebx
+	jnz	L(divide_fraction)
+
+	jmp	L(divide_done)
+
+
+
+C -----------------------------------------------------------------------------
+
+L(mul_by_inverse):
+	C eax
+	C ebx	xsize
+	C ecx	size
+	C edx	carry
+	C esi	src
+	C edi	&dst[xsize-1]
+	C ebp	divisor
+
+	leal	12(%edi), %ebx
+
+	movl	%ebx, VAR_DST_STOP
+	leal	4(%edi,%ecx,4), %edi	C &dst[xsize+size]
+
+	movl	%edi, VAR_DST
+	movl	%ecx, %ebx		C size
+
+	bsrl	%ebp, %ecx		C 31-l
+	movl	%edx, %edi		C carry
+
+	leal	1(%ecx), %eax		C 32-l
+	xorl	$31, %ecx		C l
+
+	movl	%ecx, VAR_NORM
+	movl	$-1, %edx
+
+	shll	%cl, %ebp		C d normalized
+	movd	%eax, %mm7
+
+	movl	$-1, %eax
+	subl	%ebp, %edx		C (b-d)-1 giving edx:eax = b*(b-d)-1
+
+	divl	%ebp			C floor (b*(b-d)-1) / d
+
+	movl	%eax, VAR_INVERSE
+	orl	%ebx, %ebx		C size
+	leal	-12(%esi,%ebx,4), %eax	C &src[size-3]
+
+	movl	%eax, VAR_SRC
+	jz	L(start_zero)
+
+	movl	8(%eax), %esi		C src high limb
+	cmpl	$1, %ebx
+	jz	L(start_one)
+
+L(start_two_or_more):
+	movl	4(%eax), %edx		C src second highest limb
+
+	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
+
+	shldl(	%cl, %edx, %esi)	C n10 = high,second << l
+
+	cmpl	$2, %ebx
+	je	L(integer_two_left)
+	jmp	L(integer_top)
+
+
+L(start_one):
+	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
+
+	shll	%cl, %esi		C n10 = high << l
+	jmp	L(integer_one_left)
+
+
+L(start_zero):
+	shll	%cl, %edi		C n2 = carry << l
+	movl	$0, %esi		C n10 = 0
+
+	C we're here because xsize+size>=MUL_THRESHOLD, so with size==0 then
+	C must have xsize!=0
+	jmp	L(fraction_some)
+
+
+
+C -----------------------------------------------------------------------------
+C
+C This loop runs at about 25 cycles, which is probably sub-optimal, and
+C certainly more than the dependent chain would suggest.  A better loop, or
+C a better rough analysis of what's possible, would be welcomed.
+C
+C In the current implementation, the following successively dependent
+C micro-ops seem to exist.
+C
+C		       uops
+C		n2+n1	1   (addl)
+C		mul	5
+C		q1+1	3   (addl/adcl)
+C		mul	5
+C		sub	3   (subl/sbbl)
+C		addback	2   (cmov)
+C		       ---
+C		       19
+C
+C Lack of registers hinders explicit scheduling and it might be that the
+C normal out of order execution isn't able to hide enough under the mul
+C latencies.
+C
+C Using sarl/negl to pick out n1 for the n2+n1 stage is a touch faster than
+C cmov (and takes one uop off the dependent chain).  A sarl/andl/addl
+C combination was tried for the addback (despite the fact it would lengthen
+C the dependent chain) but found to be no faster.
+
+
+	ALIGN(16)
+L(integer_top):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	scratch (src, dst)
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	d
+	C
+	C mm0	scratch (src qword)
+	C mm7	rshift for normalization
+
+	movl	%esi, %eax
+	movl	%ebp, %ebx
+
+	sarl	$31, %eax          C -n1
+	movl	VAR_SRC, %ecx
+
+	andl	%eax, %ebx         C -n1 & d
+	negl	%eax               C n1
+
+	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
+	addl	%edi, %eax         C n2+n1
+	movq	(%ecx), %mm0       C next src limb and the one below it
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	subl	$4, %ecx
+
+	movl	%ecx, VAR_SRC
+
+	C
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	movl	%ebp, %eax	   C d
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+	jz	L(q1_ff)
+
+	mull	%ebx		   C (q1+1)*d
+
+	movl	VAR_DST, %ecx
+	psrlq	%mm7, %mm0
+
+	C
+
+	C
+
+	C
+
+	subl	%eax, %esi
+	movl	VAR_DST_STOP, %eax
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+	movd	%mm0, %esi
+
+	sbbl	$0, %ebx	   C q
+	subl	$4, %ecx
+
+	movl	%ebx, (%ecx)
+	cmpl	%eax, %ecx
+
+	movl	%ecx, VAR_DST
+	jne	L(integer_top)
+
+
+L(integer_loop_done):
+
+
+C -----------------------------------------------------------------------------
+C
+C Here, and in integer_one_left below, an sbbl $0 is used rather than a jz
+C q1_ff special case.  This make the code a bit smaller and simpler, and
+C costs only 2 cycles (each).
+
+L(integer_two_left):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	scratch (src, dst)
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	src limb, shifted
+	C mm7	rshift
+
+
+ 	movl	%esi, %eax
+ 	movl	%ebp, %ebx
+
+ 	sarl	$31, %eax          C -n1
+ 	movl	PARAM_SRC, %ecx
+
+ 	andl	%eax, %ebx         C -n1 & d
+ 	negl	%eax               C n1
+
+ 	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
+ 	addl	%edi, %eax         C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	movd	(%ecx), %mm0	   C src low limb
+
+	movl	VAR_DST_STOP, %ecx
+
+	C
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+	movl	%ebp, %eax	   C d
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+
+	sbbl	$0, %ebx
+
+	mull	%ebx		   C (q1+1)*d
+
+	psllq	$32, %mm0
+
+	psrlq	%mm7, %mm0
+
+	C
+
+	C
+
+	subl	%eax, %esi
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+	movd	%mm0, %esi
+
+	sbbl	$0, %ebx	   C q
+
+	movl	%ebx, -4(%ecx)
+
+
+C -----------------------------------------------------------------------------
+L(integer_one_left):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	scratch (dst)
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	src limb, shifted
+	C mm7	rshift
+
+
+ 	movl	%esi, %eax
+ 	movl	%ebp, %ebx
+
+ 	sarl	$31, %eax          C -n1
+ 	movl	VAR_DST_STOP, %ecx
+
+ 	andl	%eax, %ebx         C -n1 & d
+ 	negl	%eax               C n1
+
+ 	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
+ 	addl	%edi, %eax         C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	C
+
+	C
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+	movl	%ebp, %eax	   C d
+
+	C
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+
+	sbbl	$0, %ebx           C q1 if q1+1 overflowed
+
+	mull	%ebx
+
+	C
+
+	C
+
+	C
+
+	C
+
+	subl	%eax, %esi
+	movl	PARAM_XSIZE, %eax
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+
+	sbbl	$0, %ebx	   C q
+
+	movl	%ebx, -8(%ecx)
+	subl	$8, %ecx
+
+
+
+	orl	%eax, %eax         C xsize
+	jnz	L(fraction_some)
+
+	movl	%edi, %eax
+L(fraction_done):
+	movl	VAR_NORM, %ecx
+	movl	SAVE_EBP, %ebp
+
+	movl	SAVE_EDI, %edi
+
+	movl	SAVE_ESI, %esi
+
+	movl	SAVE_EBX, %ebx
+	addl	$STACK_SPACE, %esp
+
+	shrl	%cl, %eax
+	emms
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+C
+C Special case for q1=0xFFFFFFFF, giving q=0xFFFFFFFF meaning the low dword
+C of q*d is simply -d and the remainder n-q*d = n10+d
+
+L(q1_ff):
+	C eax	(divisor)
+	C ebx	(q1+1 == 0)
+	C ecx
+	C edx
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+
+	movl	VAR_DST, %ecx
+	movl	VAR_DST_STOP, %edx
+	subl	$4, %ecx
+
+	movl	%ecx, VAR_DST
+	psrlq	%mm7, %mm0
+	leal	(%ebp,%esi), %edi	C n-q*d remainder -> next n2
+
+	movl	$-1, (%ecx)
+	movd	%mm0, %esi		C next n10
+
+	cmpl	%ecx, %edx
+	jne	L(integer_top)
+
+	jmp	L(integer_loop_done)
+
+
+
+C -----------------------------------------------------------------------------
+C
+C In the current implementation, the following successively dependent
+C micro-ops seem to exist.
+C
+C		       uops
+C		mul	5
+C		q1+1	1   (addl)
+C		mul	5
+C		sub	3   (negl/sbbl)
+C		addback	2   (cmov)
+C		       ---
+C		       16
+C
+C The loop in fact runs at about 17.5 cycles.  Using a sarl/andl/addl for
+C the addback was found to be a touch slower.
+
+
+	ALIGN(16)
+L(fraction_some):
+	C eax
+	C ebx
+	C ecx
+	C edx
+	C esi
+	C edi	carry
+	C ebp	divisor
+
+	movl	PARAM_DST, %esi
+	movl	VAR_DST_STOP, %ecx
+	movl	%edi, %eax
+
+	subl	$8, %ecx
+
+
+	ALIGN(16)
+L(fraction_top):
+	C eax	n2, then scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	dst, decrementing
+	C edx	scratch
+	C esi	dst stop point
+	C edi	n2
+	C ebp	divisor
+
+	mull	VAR_INVERSE	C m*n2
+
+	movl	%ebp, %eax	C d
+	subl	$4, %ecx	C dst
+	leal	1(%edi), %ebx
+
+	C
+
+	C
+
+	C
+
+	addl	%edx, %ebx	C 1 + high(n2<<32 + m*n2) = q1+1
+
+	mull	%ebx		C (q1+1)*d
+
+	C
+
+	C
+
+	C
+
+	C
+
+	negl	%eax		C low of n - (q1+1)*d
+
+ 	sbbl	%edx, %edi	C high of n - (q1+1)*d, caring only about carry
+	leal    (%ebp,%eax), %edx
+
+ 	cmovc(	%edx, %eax)	C n - q1*d if underflow from using q1+1
+
+ 	sbbl	$0, %ebx	C q
+	movl	%eax, %edi	C remainder->n2
+ 	cmpl	%esi, %ecx
+
+	movl	%ebx, (%ecx)	C previous q
+	jne	L(fraction_top)
+
+
+	jmp	L(fraction_done)
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/p6/mmx/mod_1.asm b/src/gmp/mpn/x86/p6/mmx/mod_1.asm
new file mode 100644
index 000000000..e7d8d94d3
--- /dev/null
+++ b/src/gmp/mpn/x86/p6/mmx/mod_1.asm
@@ -0,0 +1,444 @@
+dnl  Intel Pentium-II mpn_mod_1 -- mpn by limb remainder.
+dnl 
+dnl  P6MMX: 24.0 cycles/limb.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_mod_1 (mp_srcptr src, mp_size_t size, mp_limb_t divisor);
+C mp_limb_t mpn_mod_1c (mp_srcptr src, mp_size_t size, mp_limb_t divisor,
+C                       mp_limb_t carry);
+C
+C The code here very similar to mpn_divrem_1, but with the quotient
+C discarded.  What's here probably isn't optimal.
+C
+C See mpn/x86/p6/mmx/divrem_1.c and mpn/x86/k7/mmx/mod_1.asm for some
+C comments.
+
+
+dnl  MUL_THRESHOLD is the size at which the multiply by inverse method is
+dnl  used, rather than plain "divl"s.  Minimum value 2.
+
+deflit(MUL_THRESHOLD, 4)
+
+
+defframe(PARAM_CARRY,  16)
+defframe(PARAM_DIVISOR,12)
+defframe(PARAM_SIZE,    8)
+defframe(PARAM_SRC,     4)
+
+defframe(SAVE_EBX,    -4)
+defframe(SAVE_ESI,    -8)
+defframe(SAVE_EDI,    -12)
+defframe(SAVE_EBP,    -16)
+
+defframe(VAR_NORM,    -20)
+defframe(VAR_INVERSE, -24)
+defframe(VAR_SRC_STOP,-28)
+
+deflit(STACK_SPACE, 28)
+
+	.text
+	ALIGN(16)
+
+PROLOGUE(mpn_mod_1c)
+deflit(`FRAME',0)
+	movl	PARAM_CARRY, %edx
+	movl	PARAM_SIZE, %ecx
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%ebp, SAVE_EBP
+	movl	PARAM_DIVISOR, %ebp
+
+	movl	%esi, SAVE_ESI
+	movl	PARAM_SRC, %esi
+	jmp	LF(mpn_mod_1,start_1c)
+
+EPILOGUE()
+
+
+	ALIGN(16)
+PROLOGUE(mpn_mod_1)
+deflit(`FRAME',0)
+
+	movl	$0, %edx		C initial carry (if can't skip a div)
+	movl	PARAM_SIZE, %ecx
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%esi, SAVE_ESI
+	movl	PARAM_SRC, %esi
+
+	movl	%ebp, SAVE_EBP
+	movl	PARAM_DIVISOR, %ebp
+
+	orl	%ecx, %ecx
+	jz	L(divide_done)
+
+	movl	-4(%esi,%ecx,4), %eax	C src high limb
+
+	cmpl	%ebp, %eax		C carry flag if high<divisor
+					
+	cmovc(	%eax, %edx)		C src high limb as initial carry
+	sbbl	$0, %ecx		C size-1 to skip one div
+	jz	L(divide_done)
+
+
+	ALIGN(16)
+L(start_1c):
+	C eax	
+	C ebx
+	C ecx	size
+	C edx	carry
+	C esi	src
+	C edi
+	C ebp	divisor
+
+	cmpl	$MUL_THRESHOLD, %ecx
+	jae	L(mul_by_inverse)
+
+
+	orl	%ecx, %ecx
+	jz	L(divide_done)
+
+
+L(divide_top):
+	C eax	scratch (quotient)
+	C ebx
+	C ecx	counter, limbs, decrementing
+	C edx	scratch (remainder)
+	C esi	src
+	C edi
+	C ebp
+
+	movl	-4(%esi,%ecx,4), %eax
+
+	divl	%ebp
+
+	decl	%ecx
+	jnz	L(divide_top)
+
+
+L(divide_done):
+	movl	SAVE_ESI, %esi
+	movl	%edx, %eax
+
+	movl	SAVE_EBP, %ebp
+	addl	$STACK_SPACE, %esp
+
+	ret
+
+
+
+C -----------------------------------------------------------------------------
+
+L(mul_by_inverse):
+	C eax
+	C ebx
+	C ecx	size
+	C edx	carry
+	C esi	src
+	C edi
+	C ebp	divisor
+
+	movl	%ebx, SAVE_EBX
+	leal	-4(%esi), %ebx
+
+	movl	%ebx, VAR_SRC_STOP
+	movl	%ecx, %ebx		C size
+
+	movl	%edi, SAVE_EDI
+	movl	%edx, %edi		C carry
+
+	bsrl	%ebp, %ecx		C 31-l
+	movl	$-1, %edx
+
+	leal	1(%ecx), %eax		C 32-l
+	xorl	$31, %ecx		C l
+
+	movl	%ecx, VAR_NORM
+	shll	%cl, %ebp		C d normalized
+
+	movd	%eax, %mm7
+	movl	$-1, %eax
+	subl	%ebp, %edx		C (b-d)-1 so  edx:eax = b*(b-d)-1
+
+	divl	%ebp			C floor (b*(b-d)-1) / d
+
+	C
+
+	movl	%eax, VAR_INVERSE
+	leal	-12(%esi,%ebx,4), %eax	C &src[size-3]
+
+	movl	8(%eax), %esi		C src high limb
+	movl	4(%eax), %edx		C src second highest limb
+
+	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
+
+	shldl(	%cl, %edx, %esi)	C n10 = high,second << l
+
+	movl	%eax, %ecx		C &src[size-3]
+
+
+ifelse(MUL_THRESHOLD,2,`
+	cmpl	$2, %ebx
+	je	L(inverse_two_left)
+')
+
+
+C The dependent chain here is the same as in mpn_divrem_1, but a few
+C instructions are saved by not needing to store the quotient limbs.  This
+C gets it down to 24 c/l, which is still a bit away from a theoretical 19
+C c/l.
+
+	ALIGN(16)
+L(inverse_top):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	src pointer, decrementing
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	scratch (src qword)
+	C mm7	rshift for normalization
+
+
+	movl	%esi, %eax
+	movl	%ebp, %ebx
+
+	sarl	$31, %eax          C -n1
+
+	andl	%eax, %ebx         C -n1 & d
+	negl	%eax               C n1
+
+	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
+	addl	%edi, %eax         C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	movq	(%ecx), %mm0       C next src limb and the one below it
+	subl	$4, %ecx
+
+	C
+
+	C
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+	movl	%ebp, %eax	   C d
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+	jz	L(q1_ff)
+
+	mull	%ebx		   C (q1+1)*d
+
+	psrlq	%mm7, %mm0
+	movl	VAR_SRC_STOP, %ebx
+
+	C
+
+	C
+
+	C
+
+	subl	%eax, %esi
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+	movd	%mm0, %esi
+	cmpl	%ebx, %ecx
+
+	jne	L(inverse_top)
+
+
+L(inverse_loop_done):
+
+
+C -----------------------------------------------------------------------------
+
+L(inverse_two_left):
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx	&src[-1]
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	scratch (src dword)
+	C mm7	rshift
+
+	movl	%esi, %eax
+	movl	%ebp, %ebx
+
+	sarl	$31, %eax          C -n1
+
+	andl	%eax, %ebx         C -n1 & d
+	negl	%eax               C n1
+
+	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
+	addl	%edi, %eax         C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	movd	4(%ecx), %mm0	   C src low limb
+
+	C
+
+	C
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+
+	sbbl	$0, %ebx
+	movl	%ebp, %eax	   C d
+
+	mull	%ebx		   C (q1+1)*d
+
+	psllq	$32, %mm0
+
+	psrlq	%mm7, %mm0
+
+	C
+
+	C
+
+	subl	%eax, %esi
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	movl	%esi, %edi	   C remainder -> n2
+	leal	(%ebp,%esi), %edx
+
+	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
+	movd	%mm0, %esi
+
+
+C One limb left
+
+	C eax	scratch
+	C ebx	scratch (nadj, q1)
+	C ecx
+	C edx	scratch
+	C esi	n10
+	C edi	n2
+	C ebp	divisor
+	C
+	C mm0	src limb, shifted
+	C mm7	rshift
+
+	movl	%esi, %eax
+	movl	%ebp, %ebx
+
+	sarl	$31, %eax          C -n1
+
+	andl	%eax, %ebx         C -n1 & d
+	negl	%eax               C n1
+
+	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
+	addl	%edi, %eax         C n2+n1
+
+	mull	VAR_INVERSE        C m*(n2+n1)
+
+	movl	VAR_NORM, %ecx     C for final denorm
+
+	C
+
+	C
+
+	C
+
+	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
+	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
+
+	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
+
+	sbbl	$0, %ebx
+	movl	%ebp, %eax	   C d
+
+	mull	%ebx		   C (q1+1)*d
+
+	movl	SAVE_EBX, %ebx
+
+	C
+
+	C
+
+	C
+
+	subl	%eax, %esi
+
+	sbbl	%edx, %edi	   C n - (q1+1)*d
+	leal	(%ebp,%esi), %edx
+	movl	SAVE_EBP, %ebp
+
+	movl	%esi, %eax	   C remainder
+	movl	SAVE_ESI, %esi
+
+	cmovc(	%edx, %eax)	   C n - q1*d if underflow from using q1+1
+	movl	SAVE_EDI, %edi
+
+	shrl	%cl, %eax	   C denorm remainder
+	addl	$STACK_SPACE, %esp
+	emms
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+C
+C Special case for q1=0xFFFFFFFF, giving q=0xFFFFFFFF meaning the low dword
+C of q*d is simply -d and the remainder n-q*d = n10+d
+
+L(q1_ff):
+	C eax	(divisor)
+	C ebx	(q1+1 == 0)
+	C ecx	src pointer
+	C edx
+	C esi	n10
+	C edi	(n2)
+	C ebp	divisor
+
+	leal	(%ebp,%esi), %edi	C n-q*d remainder -> next n2
+	movl	VAR_SRC_STOP, %edx
+	psrlq	%mm7, %mm0
+
+	movd	%mm0, %esi		C next n10
+	cmpl	%ecx, %edx
+	jne	L(inverse_top)
+
+	jmp	L(inverse_loop_done)
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/p6/mmx/popham.asm b/src/gmp/mpn/x86/p6/mmx/popham.asm
new file mode 100644
index 000000000..50f9a1121
--- /dev/null
+++ b/src/gmp/mpn/x86/p6/mmx/popham.asm
@@ -0,0 +1,31 @@
+dnl  Intel Pentium-II mpn_popcount, mpn_hamdist -- population count and
+dnl  hamming distance.
+dnl 
+dnl  P6MMX: popcount 11 cycles/limb (approx), hamdist 11.5 cycles/limb
+dnl  (approx)
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
+include_mpn(`x86/k6/mmx/popham.asm')
diff --git a/src/gmp/mpn/x86/p6/p3mmx/popham.asm b/src/gmp/mpn/x86/p6/p3mmx/popham.asm
new file mode 100644
index 000000000..e63fbf334
--- /dev/null
+++ b/src/gmp/mpn/x86/p6/p3mmx/popham.asm
@@ -0,0 +1,30 @@
+dnl  Intel Pentium-III mpn_popcount, mpn_hamdist -- population count and
+dnl  hamming distance.
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+dnl  Haven't actually measured it, but the K7 code with the psadbw should be
+dnl  good on P-III.
+
+include(`../config.m4')
+
+MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
+include_mpn(`x86/k7/mmx/popham.asm')
diff --git a/src/gmp/mpn/x86/p6/sqr_basecase.asm b/src/gmp/mpn/x86/p6/sqr_basecase.asm
new file mode 100644
index 000000000..174c78406
--- /dev/null
+++ b/src/gmp/mpn/x86/p6/sqr_basecase.asm
@@ -0,0 +1,641 @@
+dnl  Intel P6 mpn_sqr_basecase -- square an mpn number.
+dnl 
+dnl  P6: approx 4.0 cycles per cross product, or 7.75 cycles per triangular
+dnl  product (measured on the speed difference between 20 and 40 limbs,
+dnl  which is the Karatsuba recursing range).
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+dnl  These are the same as in mpn/x86/k6/sqr_basecase.asm, see that file for
+dnl  a description.  The only difference here is that UNROLL_COUNT can go up
+dnl  to 64 (not 63) making KARATSUBA_SQR_THRESHOLD_MAX 67.
+
+deflit(KARATSUBA_SQR_THRESHOLD_MAX, 67)
+
+ifdef(`KARATSUBA_SQR_THRESHOLD_OVERRIDE',
+`define(`KARATSUBA_SQR_THRESHOLD',KARATSUBA_SQR_THRESHOLD_OVERRIDE)')
+
+m4_config_gmp_mparam(`KARATSUBA_SQR_THRESHOLD')
+deflit(UNROLL_COUNT, eval(KARATSUBA_SQR_THRESHOLD-3))
+
+
+C void mpn_sqr_basecase (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C The algorithm is basically the same as mpn/generic/sqr_basecase.c, but a
+C lot of function call overheads are avoided, especially when the given size
+C is small.
+C
+C The code size might look a bit excessive, but not all of it is executed so
+C it won't all get into the code cache.  The 1x1, 2x2 and 3x3 special cases
+C clearly apply only to those sizes; mid sizes like 10x10 only need part of
+C the unrolled addmul; and big sizes like 40x40 that do use the full
+C unrolling will least be making good use of it, because 40x40 will take
+C something like 7000 cycles.
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+
+	.text
+	ALIGN(32)
+PROLOGUE(mpn_sqr_basecase)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %edx
+
+	movl	PARAM_SRC, %eax
+
+	cmpl	$2, %edx
+	movl	PARAM_DST, %ecx
+	je	L(two_limbs)
+
+	movl	(%eax), %eax
+	ja	L(three_or_more)
+
+
+C -----------------------------------------------------------------------------
+C one limb only
+	C eax	src limb
+	C ebx
+	C ecx	dst
+	C edx
+
+	mull	%eax
+
+	movl	%eax, (%ecx)
+	movl	%edx, 4(%ecx)
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+L(two_limbs):
+	C eax	src
+	C ebx
+	C ecx	dst
+	C edx
+
+defframe(SAVE_ESI, -4)
+defframe(SAVE_EBX, -8)
+defframe(SAVE_EDI, -12)
+defframe(SAVE_EBP, -16)
+deflit(`STACK_SPACE',16)
+
+	subl	$STACK_SPACE, %esp
+deflit(`FRAME',STACK_SPACE)
+
+	movl	%esi, SAVE_ESI
+	movl	%eax, %esi
+	movl	(%eax), %eax
+
+	mull	%eax		C src[0]^2
+
+	movl	%eax, (%ecx)	C dst[0]
+	movl	4(%esi), %eax
+
+	movl	%ebx, SAVE_EBX
+	movl	%edx, %ebx	C dst[1]
+
+	mull	%eax		C src[1]^2
+
+	movl	%edi, SAVE_EDI
+	movl	%eax, %edi	C dst[2]
+	movl	(%esi), %eax
+
+	movl	%ebp, SAVE_EBP
+	movl	%edx, %ebp	C dst[3]
+
+	mull	4(%esi)		C src[0]*src[1]
+
+	addl	%eax, %ebx
+	movl	SAVE_ESI, %esi
+
+	adcl	%edx, %edi
+
+	adcl	$0, %ebp
+	addl	%ebx, %eax
+	movl	SAVE_EBX, %ebx
+
+	adcl	%edi, %edx
+	movl	SAVE_EDI, %edi
+
+	adcl	$0, %ebp
+
+	movl	%eax, 4(%ecx)
+
+	movl	%ebp, 12(%ecx)
+	movl	SAVE_EBP, %ebp
+
+	movl	%edx, 8(%ecx)
+	addl	$FRAME, %esp
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+L(three_or_more):
+	C eax	src low limb
+	C ebx
+	C ecx	dst
+	C edx	size
+deflit(`FRAME',0)
+
+	pushl	%esi	defframe_pushl(`SAVE_ESI')
+	cmpl	$4, %edx
+
+	movl	PARAM_SRC, %esi
+	jae	L(four_or_more)
+
+
+C -----------------------------------------------------------------------------
+C three limbs
+
+	C eax	src low limb
+	C ebx
+	C ecx	dst
+	C edx
+	C esi	src
+	C edi
+	C ebp
+
+	pushl	%ebp	defframe_pushl(`SAVE_EBP')
+	pushl	%edi	defframe_pushl(`SAVE_EDI')
+
+	mull	%eax		C src[0] ^ 2
+
+	movl	%eax, (%ecx)
+	movl	%edx, 4(%ecx)
+
+	movl	4(%esi), %eax
+	xorl	%ebp, %ebp
+
+	mull	%eax		C src[1] ^ 2
+
+	movl	%eax, 8(%ecx)
+	movl	%edx, 12(%ecx)
+	movl	8(%esi), %eax
+
+	pushl	%ebx	defframe_pushl(`SAVE_EBX')
+
+	mull	%eax		C src[2] ^ 2
+
+	movl	%eax, 16(%ecx)
+	movl	%edx, 20(%ecx)
+
+	movl	(%esi), %eax
+
+	mull	4(%esi)		C src[0] * src[1]
+
+	movl	%eax, %ebx
+	movl	%edx, %edi
+
+	movl	(%esi), %eax
+
+	mull	8(%esi)		C src[0] * src[2]
+
+	addl	%eax, %edi
+	movl	%edx, %ebp
+
+	adcl	$0, %ebp
+	movl	4(%esi), %eax
+
+	mull	8(%esi)		C src[1] * src[2]
+
+	xorl	%esi, %esi
+	addl	%eax, %ebp
+
+	C eax
+	C ebx	dst[1]
+	C ecx	dst
+	C edx	dst[4]
+	C esi	zero, will be dst[5]
+	C edi	dst[2]
+	C ebp	dst[3]
+
+	adcl	$0, %edx
+	addl	%ebx, %ebx
+
+	adcl	%edi, %edi
+
+	adcl	%ebp, %ebp
+
+	adcl	%edx, %edx
+	movl	4(%ecx), %eax
+
+	adcl	$0, %esi
+	addl	%ebx, %eax
+
+	movl	%eax, 4(%ecx)
+	movl	8(%ecx), %eax
+
+	adcl	%edi, %eax
+	movl	12(%ecx), %ebx
+
+	adcl	%ebp, %ebx
+	movl	16(%ecx), %edi
+
+	movl	%eax, 8(%ecx)
+	movl	SAVE_EBP, %ebp
+
+	movl	%ebx, 12(%ecx)
+	movl	SAVE_EBX, %ebx
+
+	adcl	%edx, %edi
+	movl	20(%ecx), %eax
+
+	movl	%edi, 16(%ecx)
+	movl	SAVE_EDI, %edi
+
+	adcl	%esi, %eax	C no carry out of this
+	movl	SAVE_ESI, %esi
+
+	movl	%eax, 20(%ecx)
+	addl	$FRAME, %esp
+
+	ret
+
+
+
+C -----------------------------------------------------------------------------
+defframe(VAR_COUNTER,-20)
+defframe(VAR_JMP,    -24)
+deflit(`STACK_SPACE',24)
+
+L(four_or_more):
+	C eax	src low limb
+	C ebx
+	C ecx
+	C edx	size
+	C esi	src
+	C edi
+	C ebp
+deflit(`FRAME',4)  dnl  %esi already pushed
+
+C First multiply src[0]*src[1..size-1] and store at dst[1..size].
+ 
+	subl	$STACK_SPACE-FRAME, %esp
+deflit(`FRAME',STACK_SPACE)
+	movl	$1, %ecx
+
+	movl	%edi, SAVE_EDI
+	movl	PARAM_DST, %edi
+
+	movl	%ebx, SAVE_EBX
+	subl	%edx, %ecx		C -(size-1)
+
+	movl	%ebp, SAVE_EBP
+	movl	$0, %ebx		C initial carry
+
+	leal	(%esi,%edx,4), %esi	C &src[size]
+	movl	%eax, %ebp		C multiplier
+
+	leal	-4(%edi,%edx,4), %edi	C &dst[size-1]
+
+
+C This loop runs at just over 6 c/l.
+
+L(mul_1):
+	C eax	scratch
+	C ebx	carry
+	C ecx	counter, limbs, negative, -(size-1) to -1
+	C edx	scratch
+	C esi	&src[size]
+	C edi	&dst[size-1]
+	C ebp	multiplier
+
+	movl	%ebp, %eax
+
+	mull	(%esi,%ecx,4)
+
+	addl	%ebx, %eax
+	movl	$0, %ebx
+
+	adcl	%edx, %ebx
+	movl	%eax, 4(%edi,%ecx,4)
+
+	incl	%ecx
+	jnz	L(mul_1)
+
+
+	movl	%ebx, 4(%edi)
+
+
+C Addmul src[n]*src[n+1..size-1] at dst[2*n-1...], for each n=1..size-2.
+C
+C The last two addmuls, which are the bottom right corner of the product
+C triangle, are left to the end.  These are src[size-3]*src[size-2,size-1]
+C and src[size-2]*src[size-1].  If size is 4 then it's only these corner
+C cases that need to be done.
+C
+C The unrolled code is the same as mpn_addmul_1(), see that routine for some
+C comments.
+C
+C VAR_COUNTER is the outer loop, running from -(size-4) to -1, inclusive.
+C
+C VAR_JMP is the computed jump into the unrolled code, stepped by one code
+C chunk each outer loop.
+
+dnl  This is also hard-coded in the address calculation below.
+deflit(CODE_BYTES_PER_LIMB, 15)
+
+dnl  With &src[size] and &dst[size-1] pointers, the displacements in the
+dnl  unrolled code fit in a byte for UNROLL_COUNT values up to 32, but above
+dnl  that an offset must be added to them.
+deflit(OFFSET,
+ifelse(eval(UNROLL_COUNT>32),1,
+eval((UNROLL_COUNT-32)*4),
+0))
+
+	C eax
+	C ebx	carry
+	C ecx
+	C edx
+	C esi	&src[size]
+	C edi	&dst[size-1]
+	C ebp
+
+	movl	PARAM_SIZE, %ecx
+
+	subl	$4, %ecx
+	jz	L(corner)
+
+	movl	%ecx, %edx
+	negl	%ecx
+
+	shll	$4, %ecx
+ifelse(OFFSET,0,,`subl	$OFFSET, %esi')
+
+ifdef(`PIC',`
+	call	L(pic_calc)
+L(here):
+',`
+	leal	L(unroll_inner_end)-eval(2*CODE_BYTES_PER_LIMB)(%ecx,%edx), %ecx
+')
+	negl	%edx
+
+ifelse(OFFSET,0,,`subl	$OFFSET, %edi')
+
+	C The calculated jump mustn't be before the start of the available
+	C code.  This is the limit that UNROLL_COUNT puts on the src operand
+	C size, but checked here using the jump address directly.
+
+	ASSERT(ae,
+	`movl_text_address( L(unroll_inner_start), %eax)
+	cmpl	%eax, %ecx')
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(unroll_outer_top):
+	C eax
+	C ebx	high limb to store
+	C ecx	VAR_JMP
+	C edx	VAR_COUNTER, limbs, negative
+	C esi	&src[size], constant
+	C edi	dst ptr, second highest limb of last addmul
+	C ebp
+
+	movl	-12+OFFSET(%esi,%edx,4), %ebp	C multiplier
+	movl	%edx, VAR_COUNTER
+
+	movl	-8+OFFSET(%esi,%edx,4), %eax	C first limb of multiplicand
+
+	mull	%ebp
+
+define(cmovX,`ifelse(eval(UNROLL_COUNT%2),1,`cmovz($@)',`cmovnz($@)')')
+
+	testb	$1, %cl
+
+	movl	%edx, %ebx	C high carry
+	leal	4(%edi), %edi
+
+	movl	%ecx, %edx	C jump
+
+	movl	%eax, %ecx	C low carry
+	leal	CODE_BYTES_PER_LIMB(%edx), %edx
+
+	cmovX(	%ebx, %ecx)	C high carry reverse
+	cmovX(	%eax, %ebx)	C low carry reverse
+	movl	%edx, VAR_JMP
+	jmp	*%edx
+
+
+	C Must be on an even address here so the low bit of the jump address
+	C will indicate which way around ecx/ebx should start.
+
+	ALIGN(2)
+
+L(unroll_inner_start):
+	C eax	scratch
+	C ebx	carry high
+	C ecx	carry low
+	C edx	scratch
+	C esi	src pointer
+	C edi	dst pointer
+	C ebp	multiplier
+	C
+	C 15 code bytes each limb
+	C ecx/ebx reversed on each chunk
+
+forloop(`i', UNROLL_COUNT, 1, `
+	deflit(`disp_src', eval(-i*4 + OFFSET))
+	deflit(`disp_dst', eval(disp_src))
+
+	m4_assert(`disp_src>=-128 && disp_src<128')
+	m4_assert(`disp_dst>=-128 && disp_dst<128')
+
+ifelse(eval(i%2),0,`
+Zdisp(	movl,	disp_src,(%esi), %eax)
+	mull	%ebp
+Zdisp(	addl,	%ebx, disp_dst,(%edi))
+	adcl	%eax, %ecx
+	movl	%edx, %ebx
+	adcl	$0, %ebx
+',`
+	dnl  this one comes out last
+Zdisp(	movl,	disp_src,(%esi), %eax)
+	mull	%ebp
+Zdisp(	addl,	%ecx, disp_dst,(%edi))
+	adcl	%eax, %ebx
+	movl	%edx, %ecx
+	adcl	$0, %ecx
+')
+')
+L(unroll_inner_end):
+
+	addl	%ebx, m4_empty_if_zero(OFFSET)(%edi)
+
+	movl	VAR_COUNTER, %edx
+	adcl	$0, %ecx
+
+	movl	%ecx, m4_empty_if_zero(OFFSET+4)(%edi)
+	movl	VAR_JMP, %ecx
+
+	incl	%edx
+	jnz	L(unroll_outer_top)
+	
+
+ifelse(OFFSET,0,,`
+	addl	$OFFSET, %esi
+	addl	$OFFSET, %edi
+')
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(16)
+L(corner):
+	C eax
+	C ebx
+	C ecx
+	C edx
+	C esi	&src[size]
+	C edi	&dst[2*size-5]
+	C ebp
+
+	movl	-12(%esi), %eax
+
+	mull	-8(%esi)
+
+	addl	%eax, (%edi)
+	movl	-12(%esi), %eax
+	movl	$0, %ebx
+
+	adcl	%edx, %ebx
+
+	mull	-4(%esi)
+
+	addl	%eax, %ebx
+	movl	-8(%esi), %eax
+
+	adcl	$0, %edx
+
+	addl	%ebx, 4(%edi)
+	movl	$0, %ebx
+
+	adcl	%edx, %ebx
+
+	mull	-4(%esi)
+
+	movl	PARAM_SIZE, %ecx
+	addl	%ebx, %eax
+
+	adcl	$0, %edx
+
+	movl	%eax, 8(%edi)
+
+	movl	%edx, 12(%edi)
+	movl	PARAM_DST, %edi
+
+
+C Left shift of dst[1..2*size-2], the bit shifted out becomes dst[2*size-1].
+
+	subl	$1, %ecx		C size-1
+	xorl	%eax, %eax		C ready for final adcl, and clear carry
+
+	movl	%ecx, %edx
+	movl	PARAM_SRC, %esi
+
+
+L(lshift):
+	C eax
+	C ebx
+	C ecx	counter, size-1 to 1
+	C edx	size-1 (for later use)
+	C esi	src (for later use)
+	C edi	dst, incrementing
+	C ebp
+
+	rcll	4(%edi)
+	rcll	8(%edi)
+
+	leal	8(%edi), %edi
+	decl	%ecx
+	jnz	L(lshift)
+
+
+	adcl	%eax, %eax
+
+	movl	%eax, 4(%edi)		C dst most significant limb
+	movl	(%esi), %eax		C src[0]
+
+	leal	4(%esi,%edx,4), %esi	C &src[size]
+	subl	%edx, %ecx		C -(size-1)
+
+
+C Now add in the squares on the diagonal, src[0]^2, src[1]^2, ...,
+C src[size-1]^2.  dst[0] hasn't yet been set at all yet, and just gets the
+C low limb of src[0]^2.
+
+
+	mull	%eax
+
+	movl	%eax, (%edi,%ecx,8)	C dst[0]
+
+
+L(diag):
+	C eax	scratch
+	C ebx	scratch
+	C ecx	counter, negative
+	C edx	carry
+	C esi	&src[size]
+	C edi	dst[2*size-2]
+	C ebp
+
+	movl	(%esi,%ecx,4), %eax
+	movl	%edx, %ebx
+
+	mull	%eax
+
+	addl	%ebx, 4(%edi,%ecx,8)
+	adcl	%eax, 8(%edi,%ecx,8)
+	adcl	$0, %edx
+
+	incl	%ecx
+	jnz	L(diag)
+
+
+	movl	SAVE_ESI, %esi
+	movl	SAVE_EBX, %ebx
+
+	addl	%edx, 4(%edi)		C dst most significant limb
+
+	movl	SAVE_EDI, %edi
+	movl	SAVE_EBP, %ebp
+	addl	$FRAME, %esp
+	ret
+
+
+
+C -----------------------------------------------------------------------------
+ifdef(`PIC',`
+L(pic_calc):
+	addl	(%esp), %ecx
+	addl	$L(unroll_inner_end)-L(here)-eval(2*CODE_BYTES_PER_LIMB), %ecx
+	addl	%edx, %ecx
+	ret
+')
+
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/pentium/README b/src/gmp/mpn/x86/pentium/README
new file mode 100644
index 000000000..3b9ec8ac6
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/README
@@ -0,0 +1,77 @@
+
+                   INTEL PENTIUM P5 MPN SUBROUTINES
+
+
+This directory contains mpn functions optimized for Intel Pentium (P5,P54)
+processors.  The mmx subdirectory has code for Pentium with MMX (P55).
+
+
+STATUS
+
+                                cycles/limb
+
+	mpn_add_n/sub_n            2.375
+
+	mpn_copyi/copyd            1.0
+
+	mpn_divrem_1              44.0
+	mpn_mod_1                 44.0
+	mpn_divexact_by3          15.0
+
+	mpn_l/rshift               5.375 normal (6.0 on P54)
+				   1.875 special shift by 1 bit
+
+	mpn_mul_1                 13.0
+	mpn_add/submul_1          14.0
+
+	mpn_mul_basecase          14.2 cycles/crossproduct (approx)
+
+	mpn_sqr_basecase           8 cycles/crossproduct (approx)
+                                   or 15.5 cycles/triangleproduct (approx)
+
+Pentium MMX gets the following improvements
+
+	mpn_l/rshift               1.75
+
+
+1. mpn_lshift and mpn_rshift run at about 6 cycles/limb on P5 and P54, but the
+documentation indicates that they should take only 43/8 = 5.375 cycles/limb,
+or 5 cycles/limb asymptotically.  The P55 runs them at the expected speed.
+
+2. mpn_add_n and mpn_sub_n run at asymptotically 2 cycles/limb.  Due to loop
+overhead and other delays (cache refill?), they run at or near 2.5 cycles/limb.
+
+3. mpn_mul_1, mpn_addmul_1, mpn_submul_1 all run 1 cycle faster than they
+should.  Intel documentation says a mul instruction is 10 cycles, but it
+measures 9 and the routines using it run with it as 9.
+
+
+
+RELEVANT OPTIMIZATION ISSUES
+
+1. Pentium doesn't allocate cache lines on writes, unlike most other modern
+processors.  Since the functions in the mpn class do array writes, we have to
+handle allocating the destination cache lines by reading a word from it in the
+loops, to achieve the best performance.
+
+2. Pairing of memory operations requires that the two issued operations refer
+to different cache banks.  The simplest way to insure this is to read/write
+two words from the same object.  If we make operations on different objects,
+they might or might not be to the same cache bank.
+
+
+
+REFERENCES
+
+"Intel Architecture Optimization Manual", 1997, order number 242816.  This
+is mostly about P5, the parts about P6 aren't relevant.  Available on-line:
+
+        http://download.intel.com/design/PentiumII/manuals/242816.htm
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 76
+End:
diff --git a/src/gmp/mpn/x86/pentium/aors_n.asm b/src/gmp/mpn/x86/pentium/aors_n.asm
new file mode 100644
index 000000000..a61082a45
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/aors_n.asm
@@ -0,0 +1,196 @@
+dnl  Intel Pentium mpn_add_n/mpn_sub_n -- mpn addition and subtraction.
+dnl
+dnl  P5: 2.375 cycles/limb
+
+
+dnl  Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software
+dnl  Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+ifdef(`OPERATION_add_n',`
+	define(M4_inst,        adcl)
+	define(M4_function_n,  mpn_add_n)
+	define(M4_function_nc, mpn_add_nc)
+
+',`ifdef(`OPERATION_sub_n',`
+	define(M4_inst,        sbbl)
+	define(M4_function_n,  mpn_sub_n)
+	define(M4_function_nc, mpn_sub_nc)
+
+',`m4_error(`Need OPERATION_add_n or OPERATION_sub_n
+')')')
+
+MULFUNC_PROLOGUE(mpn_add_n mpn_add_nc mpn_sub_n mpn_sub_nc)
+
+
+C mp_limb_t M4_function_n (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
+C                          mp_size_t size);
+C mp_limb_t M4_function_nc (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
+C                           mp_size_t size, mp_limb_t carry);
+
+defframe(PARAM_CARRY,20)
+defframe(PARAM_SIZE, 16)
+defframe(PARAM_SRC2, 12)
+defframe(PARAM_SRC1, 8)
+defframe(PARAM_DST,  4)
+
+	.text
+	ALIGN(8)
+PROLOGUE(M4_function_nc)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+deflit(`FRAME',16)
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC1,%esi
+	movl	PARAM_SRC2,%ebp
+	movl	PARAM_SIZE,%ecx
+
+	movl	(%ebp),%ebx
+
+	decl	%ecx
+	movl	%ecx,%edx
+	shrl	$3,%ecx
+	andl	$7,%edx
+	testl	%ecx,%ecx		C zero carry flag
+	jz	L(endgo)
+
+	pushl	%edx
+FRAME_pushl()
+	movl	PARAM_CARRY,%eax
+	shrl	$1,%eax			C shift bit 0 into carry
+	jmp	LF(M4_function_n,oop)
+
+L(endgo):
+deflit(`FRAME',16)
+	movl	PARAM_CARRY,%eax
+	shrl	$1,%eax			C shift bit 0 into carry
+	jmp	LF(M4_function_n,end)
+
+EPILOGUE()
+
+
+	ALIGN(8)
+PROLOGUE(M4_function_n)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+deflit(`FRAME',16)
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC1,%esi
+	movl	PARAM_SRC2,%ebp
+	movl	PARAM_SIZE,%ecx
+
+	movl	(%ebp),%ebx
+
+	decl	%ecx
+	movl	%ecx,%edx
+	shrl	$3,%ecx
+	andl	$7,%edx
+	testl	%ecx,%ecx		C zero carry flag
+	jz	L(end)
+	pushl	%edx
+FRAME_pushl()
+
+	ALIGN(8)
+L(oop):	movl	28(%edi),%eax		C fetch destination cache line
+	leal	32(%edi),%edi
+
+L(1):	movl	(%esi),%eax
+	movl	4(%esi),%edx
+	M4_inst	%ebx,%eax
+	movl	4(%ebp),%ebx
+	M4_inst	%ebx,%edx
+	movl	8(%ebp),%ebx
+	movl	%eax,-32(%edi)
+	movl	%edx,-28(%edi)
+
+L(2):	movl	8(%esi),%eax
+	movl	12(%esi),%edx
+	M4_inst	%ebx,%eax
+	movl	12(%ebp),%ebx
+	M4_inst	%ebx,%edx
+	movl	16(%ebp),%ebx
+	movl	%eax,-24(%edi)
+	movl	%edx,-20(%edi)
+
+L(3):	movl	16(%esi),%eax
+	movl	20(%esi),%edx
+	M4_inst	%ebx,%eax
+	movl	20(%ebp),%ebx
+	M4_inst	%ebx,%edx
+	movl	24(%ebp),%ebx
+	movl	%eax,-16(%edi)
+	movl	%edx,-12(%edi)
+
+L(4):	movl	24(%esi),%eax
+	movl	28(%esi),%edx
+	M4_inst	%ebx,%eax
+	movl	28(%ebp),%ebx
+	M4_inst	%ebx,%edx
+	movl	32(%ebp),%ebx
+	movl	%eax,-8(%edi)
+	movl	%edx,-4(%edi)
+
+	leal	32(%esi),%esi
+	leal	32(%ebp),%ebp
+	decl	%ecx
+	jnz	L(oop)
+
+	popl	%edx
+FRAME_popl()
+L(end):
+	decl	%edx			C test %edx w/o clobbering carry
+	js	L(end2)
+	incl	%edx
+L(oop2):
+	leal	4(%edi),%edi
+	movl	(%esi),%eax
+	M4_inst	%ebx,%eax
+	movl	4(%ebp),%ebx
+	movl	%eax,-4(%edi)
+	leal	4(%esi),%esi
+	leal	4(%ebp),%ebp
+	decl	%edx
+	jnz	L(oop2)
+L(end2):
+	movl	(%esi),%eax
+	M4_inst	%ebx,%eax
+	movl	%eax,(%edi)
+
+	sbbl	%eax,%eax
+	negl	%eax
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/pentium/aorsmul_1.asm b/src/gmp/mpn/x86/pentium/aorsmul_1.asm
new file mode 100644
index 000000000..147b55610
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/aorsmul_1.asm
@@ -0,0 +1,99 @@
+dnl  Intel Pentium mpn_addmul_1 -- mpn by limb multiplication.
+dnl 
+dnl  P5: 14.0 cycles/limb
+
+
+dnl  Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation,
+dnl  Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA. */
+
+
+include(`../config.m4')
+
+
+ifdef(`OPERATION_addmul_1', `
+      define(M4_inst,        addl)
+      define(M4_function_1,  mpn_addmul_1)
+
+',`ifdef(`OPERATION_submul_1', `
+      define(M4_inst,        subl)
+      define(M4_function_1,  mpn_submul_1)
+
+',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
+')')')
+
+MULFUNC_PROLOGUE(mpn_addmul_1 mpn_submul_1)
+
+
+C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                          mp_limb_t mult);
+
+defframe(PARAM_MULTIPLIER,16)
+defframe(PARAM_SIZE,      12)
+defframe(PARAM_SRC,       8)
+defframe(PARAM_DST,       4)
+
+	.text
+	ALIGN(8)
+
+PROLOGUE(M4_function_1)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+deflit(`FRAME',16)
+
+	movl	PARAM_DST, %edi
+	movl	PARAM_SRC, %esi
+	movl	PARAM_SIZE, %ecx
+	movl	PARAM_MULTIPLIER, %ebp
+
+	leal	(%edi,%ecx,4), %edi
+	leal	(%esi,%ecx,4), %esi
+	negl	%ecx
+	xorl	%ebx, %ebx
+	ALIGN(8)
+
+L(oop):	adcl	$0, %ebx
+	movl	(%esi,%ecx,4), %eax
+
+	mull	%ebp
+
+	addl	%ebx, %eax
+	movl	(%edi,%ecx,4), %ebx
+
+	adcl	$0, %edx
+	M4_inst	%eax, %ebx
+
+	movl	%ebx, (%edi,%ecx,4)
+	incl	%ecx
+
+	movl	%edx, %ebx
+	jnz	L(oop)
+
+	adcl	$0, %ebx
+	movl	%ebx, %eax
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/pentium/diveby3.asm b/src/gmp/mpn/x86/pentium/diveby3.asm
new file mode 100644
index 000000000..dbac81642
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/diveby3.asm
@@ -0,0 +1,183 @@
+dnl  Intel P5 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
+dnl       
+dnl  P5: 15.0 cycles/limb
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                              mp_limb_t carry);
+
+defframe(PARAM_CARRY,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,   8)
+defframe(PARAM_DST,   4)
+
+dnl  multiplicative inverse of 3, modulo 2^32
+deflit(INVERSE_3,        0xAAAAAAAB)
+
+dnl  ceil(b/3), ceil(b*2/3) and floor(b*2/3) where b=2^32
+deflit(ONE_THIRD_CEIL,   0x55555556)
+deflit(TWO_THIRDS_CEIL,  0xAAAAAAAB)
+deflit(TWO_THIRDS_FLOOR, 0xAAAAAAAA)
+
+	.text
+	ALIGN(8)
+
+PROLOGUE(mpn_divexact_by3c)
+deflit(`FRAME',0)
+
+	movl	PARAM_SRC, %ecx
+	movl	PARAM_SIZE, %edx
+
+	decl	%edx
+	jnz	L(two_or_more)
+
+	movl	(%ecx), %edx
+	movl	PARAM_CARRY, %eax	C risk of cache bank clash here
+
+	movl	PARAM_DST, %ecx
+	subl	%eax, %edx
+
+	sbbl	%eax, %eax		C 0 or -1
+
+	imull	$INVERSE_3, %edx, %edx
+
+	negl	%eax			C 0 or 1
+	cmpl	$ONE_THIRD_CEIL, %edx
+
+	sbbl	$-1, %eax		C +1 if edx>=ceil(b/3)
+	cmpl	$TWO_THIRDS_CEIL, %edx
+
+	sbbl	$-1, %eax		C +1 if edx>=ceil(b*2/3)
+	movl	%edx, (%ecx)
+
+	ret
+
+
+L(two_or_more):
+	C eax
+	C ebx
+	C ecx	src
+	C edx	size-1
+	C esi
+	C edi
+	C ebp
+
+	pushl	%ebx	FRAME_pushl()
+	pushl	%esi	FRAME_pushl()
+
+	pushl	%edi	FRAME_pushl()
+	pushl	%ebp	FRAME_pushl()
+
+	movl	PARAM_DST, %edi
+	movl	PARAM_CARRY, %esi
+
+	movl	(%ecx), %eax		C src low limb
+	xorl	%ebx, %ebx
+
+	sub	%esi, %eax
+	movl	$TWO_THIRDS_FLOOR, %esi
+
+	leal	(%ecx,%edx,4), %ecx	C &src[size-1]
+	leal	(%edi,%edx,4), %edi	C &dst[size-1]
+
+	adcl	$0, %ebx		C carry, 0 or 1
+	negl	%edx			C -(size-1)
+
+
+C The loop needs a source limb ready at the top, which leads to one limb
+C handled separately at the end, and the special case above for size==1.
+C There doesn't seem to be any scheduling that would keep the speed but move
+C the source load and carry subtract up to the top.
+C
+C The destination cache line prefetching adds 1 cycle to the loop but is
+C considered worthwhile.  The slowdown is a factor of 1.07, but will prevent
+C repeated write-throughs if the destination isn't in L1.  A version using
+C an outer loop to prefetch only every 8 limbs (a cache line) proved to be
+C no faster, due to unavoidable branch mispreditions in the inner loop.
+C
+C setc is 2 cycles on P54, so an adcl is used instead.  If the movl $0,%ebx
+C could be avoided then the src limb fetch could pair up and save a cycle.
+C This would probably mean going to a two limb loop with the carry limb
+C alternately positive or negative, since an sbbl %ebx,%ebx will leave a
+C value which is in the opposite sense to the preceding sbbl/adcl %ebx,%eax.
+C
+C A register is used for TWO_THIRDS_FLOOR because a cmp can't be done as
+C "cmpl %edx, $n" with the immediate as the second operand.
+C
+C The "4" source displacement is in the loop rather than the setup because
+C this gets L(top) aligned to 8 bytes at no cost.
+
+	ALIGN(8)
+L(top):
+	C eax	source limb, carry subtracted
+	C ebx	carry (0 or 1)
+	C ecx	&src[size-1]
+	C edx	counter, limbs, negative
+	C esi	TWO_THIRDS_FLOOR
+	C edi	&dst[size-1]
+	C ebp	scratch (result limb)
+
+	imull	$INVERSE_3, %eax, %ebp
+
+	cmpl	$ONE_THIRD_CEIL, %ebp
+	movl	(%edi,%edx,4), %eax	C dst cache line prefetch
+
+	sbbl	$-1, %ebx		C +1 if ebp>=ceil(b/3)
+	cmpl	%ebp, %esi
+
+	movl	4(%ecx,%edx,4), %eax	C next src limb
+
+	sbbl	%ebx, %eax		C and further -1 if ebp>=ceil(b*2/3)
+	movl	$0, %ebx
+
+	adcl	$0, %ebx		C new carry
+	movl	%ebp, (%edi,%edx,4)
+
+	incl	%edx
+	jnz	L(top)
+
+
+
+	imull	$INVERSE_3, %eax, %edx
+
+	cmpl	$ONE_THIRD_CEIL, %edx
+	movl	%edx, (%edi)
+
+	sbbl	$-1, %ebx	C +1 if edx>=ceil(b/3)
+	cmpl	$TWO_THIRDS_CEIL, %edx
+
+	sbbl	$-1, %ebx	C +1 if edx>=ceil(b*2/3)
+	popl	%ebp
+
+	movl	%ebx, %eax
+	popl	%edi
+
+	popl	%esi
+	popl	%ebx
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/pentium/gmp-mparam.h b/src/gmp/mpn/x86/pentium/gmp-mparam.h
new file mode 100644
index 000000000..d3ed3d73c
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/gmp-mparam.h
@@ -0,0 +1,97 @@
+/* Intel P54 gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+
+#ifndef UMUL_TIME
+#define UMUL_TIME   9 /* cycles */
+#endif
+#ifndef UDIV_TIME
+#define UDIV_TIME   41 /* cycles */
+#endif
+
+/* bsf takes 18-42 cycles, put an average for uniform random numbers */
+#ifndef COUNT_TRAILING_ZEROS_TIME
+#define COUNT_TRAILING_ZEROS_TIME   20  /* cycles */
+#endif
+
+
+/* Generated by tuneup.c, 2000-07-06. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   14
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD      179
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   22
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD      153
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              46
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD            110
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            13
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        4
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD          25
+#endif
+
+#ifndef FFT_MUL_TABLE
+#define FFT_MUL_TABLE  { 496, 928, 1920, 4608, 14336, 40960, 0 }
+#endif
+#ifndef FFT_MODF_MUL_THRESHOLD
+#define FFT_MODF_MUL_THRESHOLD     512
+#endif
+#ifndef FFT_MUL_THRESHOLD
+#define FFT_MUL_THRESHOLD         3840
+#endif
+
+#ifndef FFT_SQR_TABLE
+#define FFT_SQR_TABLE  { 496, 1184, 1920, 5632, 14336, 40960, 0 }
+#endif
+#ifndef FFT_MODF_SQR_THRESHOLD
+#define FFT_MODF_SQR_THRESHOLD     512
+#endif
+#ifndef FFT_SQR_THRESHOLD
+#define FFT_SQR_THRESHOLD         3840
+#endif
diff --git a/src/gmp/mpn/x86/pentium/lshift.asm b/src/gmp/mpn/x86/pentium/lshift.asm
new file mode 100644
index 000000000..e1e35d4c5
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/lshift.asm
@@ -0,0 +1,236 @@
+dnl  Intel Pentium mpn_lshift -- mpn left shift.
+dnl
+dnl          cycles/limb
+dnl  P5,P54:    6.0
+dnl  P55:       5.375
+
+
+dnl  Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software
+dnl  Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+C The main shift-by-N loop should run at 5.375 c/l and that's what P55 does,
+C but P5 and P54 run only at 6.0 c/l, which is 4 cycles lost somewhere.
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+
+	.text
+	ALIGN(8)
+PROLOGUE(mpn_lshift)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+deflit(`FRAME',16)
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC,%esi
+	movl	PARAM_SIZE,%ebp
+	movl	PARAM_SHIFT,%ecx
+
+C We can use faster code for shift-by-1 under certain conditions. 
+	cmp	$1,%ecx
+	jne	L(normal)
+	leal	4(%esi),%eax
+	cmpl	%edi,%eax
+	jnc	L(special)		C jump if s_ptr + 1 >= res_ptr
+	leal	(%esi,%ebp,4),%eax
+	cmpl	%eax,%edi
+	jnc	L(special)		C jump if res_ptr >= s_ptr + size
+
+L(normal):
+	leal	-4(%edi,%ebp,4),%edi
+	leal	-4(%esi,%ebp,4),%esi
+
+	movl	(%esi),%edx
+	subl	$4,%esi
+	xorl	%eax,%eax
+	shldl(	%cl, %edx, %eax)	C compute carry limb
+	pushl	%eax			C push carry limb onto stack
+
+	decl	%ebp
+	pushl	%ebp
+	shrl	$3,%ebp
+	jz	L(end)
+
+	movl	(%edi),%eax		C fetch destination cache line
+
+	ALIGN(4)
+L(oop):	movl	-28(%edi),%eax		C fetch destination cache line
+	movl	%edx,%ebx
+
+	movl	(%esi),%eax
+	movl	-4(%esi),%edx
+	shldl(	%cl, %eax, %ebx)
+	shldl(	%cl, %edx, %eax)
+	movl	%ebx,(%edi)
+	movl	%eax,-4(%edi)
+
+	movl	-8(%esi),%ebx
+	movl	-12(%esi),%eax
+	shldl(	%cl, %ebx, %edx)
+	shldl(	%cl, %eax, %ebx)
+	movl	%edx,-8(%edi)
+	movl	%ebx,-12(%edi)
+
+	movl	-16(%esi),%edx
+	movl	-20(%esi),%ebx
+	shldl(	%cl, %edx, %eax)
+	shldl(	%cl, %ebx, %edx)
+	movl	%eax,-16(%edi)
+	movl	%edx,-20(%edi)
+
+	movl	-24(%esi),%eax
+	movl	-28(%esi),%edx
+	shldl(	%cl, %eax, %ebx)
+	shldl(	%cl, %edx, %eax)
+	movl	%ebx,-24(%edi)
+	movl	%eax,-28(%edi)
+
+	subl	$32,%esi
+	subl	$32,%edi
+	decl	%ebp
+	jnz	L(oop)
+
+L(end):	popl	%ebp
+	andl	$7,%ebp
+	jz	L(end2)
+L(oop2):
+	movl	(%esi),%eax
+	shldl(	%cl,%eax,%edx)
+	movl	%edx,(%edi)
+	movl	%eax,%edx
+	subl	$4,%esi
+	subl	$4,%edi
+	decl	%ebp
+	jnz	L(oop2)
+
+L(end2):
+	shll	%cl,%edx		C compute least significant limb
+	movl	%edx,(%edi)		C store it
+
+	popl	%eax			C pop carry limb
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+
+C We loop from least significant end of the arrays, which is only
+C permissable if the source and destination don't overlap, since the
+C function is documented to work for overlapping source and destination.
+
+L(special):
+	movl	(%esi),%edx
+	addl	$4,%esi
+
+	decl	%ebp
+	pushl	%ebp
+	shrl	$3,%ebp
+
+	addl	%edx,%edx
+	incl	%ebp
+	decl	%ebp
+	jz	L(Lend)
+
+	movl	(%edi),%eax		C fetch destination cache line
+
+	ALIGN(4)
+L(Loop):
+	movl	28(%edi),%eax		C fetch destination cache line
+	movl	%edx,%ebx
+
+	movl	(%esi),%eax
+	movl	4(%esi),%edx
+	adcl	%eax,%eax
+	movl	%ebx,(%edi)
+	adcl	%edx,%edx
+	movl	%eax,4(%edi)
+
+	movl	8(%esi),%ebx
+	movl	12(%esi),%eax
+	adcl	%ebx,%ebx
+	movl	%edx,8(%edi)
+	adcl	%eax,%eax
+	movl	%ebx,12(%edi)
+
+	movl	16(%esi),%edx
+	movl	20(%esi),%ebx
+	adcl	%edx,%edx
+	movl	%eax,16(%edi)
+	adcl	%ebx,%ebx
+	movl	%edx,20(%edi)
+
+	movl	24(%esi),%eax
+	movl	28(%esi),%edx
+	adcl	%eax,%eax
+	movl	%ebx,24(%edi)
+	adcl	%edx,%edx
+	movl	%eax,28(%edi)
+
+	leal	32(%esi),%esi		C use leal not to clobber carry
+	leal	32(%edi),%edi
+	decl	%ebp
+	jnz	L(Loop)
+
+L(Lend):
+	popl	%ebp
+	sbbl	%eax,%eax		C save carry in %eax
+	andl	$7,%ebp
+	jz	L(Lend2)
+	addl	%eax,%eax		C restore carry from eax
+L(Loop2):
+	movl	%edx,%ebx
+	movl	(%esi),%edx
+	adcl	%edx,%edx
+	movl	%ebx,(%edi)
+
+	leal	4(%esi),%esi		C use leal not to clobber carry
+	leal	4(%edi),%edi
+	decl	%ebp
+	jnz	L(Loop2)
+
+	jmp	L(L1)
+L(Lend2):
+	addl	%eax,%eax		C restore carry from eax
+L(L1):	movl	%edx,(%edi)		C store last limb
+
+	sbbl	%eax,%eax
+	negl	%eax
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/pentium/mmx/gmp-mparam.h b/src/gmp/mpn/x86/pentium/mmx/gmp-mparam.h
new file mode 100644
index 000000000..2379077d0
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/mmx/gmp-mparam.h
@@ -0,0 +1,97 @@
+/* Intel P55 gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+
+#define BITS_PER_MP_LIMB 32
+#define BYTES_PER_MP_LIMB 4
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 32
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
+
+
+#ifndef UMUL_TIME
+#define UMUL_TIME   9 /* cycles */
+#endif
+#ifndef UDIV_TIME
+#define UDIV_TIME   41 /* cycles */
+#endif
+
+/* bsf takes 18-42 cycles, put an average for uniform random numbers */
+#ifndef COUNT_TRAILING_ZEROS_TIME
+#define COUNT_TRAILING_ZEROS_TIME   20  /* cycles */
+#endif
+
+
+/* Generated by tuneup.c, 2000-07-06. */
+
+#ifndef KARATSUBA_MUL_THRESHOLD
+#define KARATSUBA_MUL_THRESHOLD   14
+#endif
+#ifndef TOOM3_MUL_THRESHOLD
+#define TOOM3_MUL_THRESHOLD       99
+#endif
+
+#ifndef KARATSUBA_SQR_THRESHOLD
+#define KARATSUBA_SQR_THRESHOLD   22
+#endif
+#ifndef TOOM3_SQR_THRESHOLD
+#define TOOM3_SQR_THRESHOLD       89
+#endif
+
+#ifndef BZ_THRESHOLD
+#define BZ_THRESHOLD              40
+#endif
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD             98
+#endif
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD            13
+#endif
+
+#ifndef GCD_ACCEL_THRESHOLD
+#define GCD_ACCEL_THRESHOLD        5
+#endif
+#ifndef GCDEXT_THRESHOLD
+#define GCDEXT_THRESHOLD          25
+#endif
+
+#ifndef FFT_MUL_TABLE
+#define FFT_MUL_TABLE  { 496, 1056, 1920, 4608, 14336, 40960, 0 }
+#endif
+#ifndef FFT_MODF_MUL_THRESHOLD
+#define FFT_MODF_MUL_THRESHOLD     512
+#endif
+#ifndef FFT_MUL_THRESHOLD
+#define FFT_MUL_THRESHOLD         3840
+#endif
+
+#ifndef FFT_SQR_TABLE
+#define FFT_SQR_TABLE  { 496, 1184, 2176, 5632, 14336, 40960, 0 }
+#endif
+#ifndef FFT_MODF_SQR_THRESHOLD
+#define FFT_MODF_SQR_THRESHOLD     512
+#endif
+#ifndef FFT_SQR_THRESHOLD
+#define FFT_SQR_THRESHOLD         4352
+#endif
diff --git a/src/gmp/mpn/x86/pentium/mmx/lshift.asm b/src/gmp/mpn/x86/pentium/mmx/lshift.asm
new file mode 100644
index 000000000..222543865
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/mmx/lshift.asm
@@ -0,0 +1,455 @@
+dnl  Intel P5 mpn_lshift -- mpn left shift.
+dnl 
+dnl  P5: 1.75 cycles/limb.
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+C Shift src,size left by shift many bits and store the result in dst,size.
+C Zeros are shifted in at the right.  Return the bits shifted out at the
+C left.
+C
+C The comments in mpn_rshift apply here too.
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+deflit(`FRAME',0)
+
+dnl  minimum 5, because the unrolled loop can't handle less
+deflit(UNROLL_THRESHOLD, 5)
+
+	.text
+	ALIGN(8)
+
+PROLOGUE(mpn_lshift)
+
+	pushl	%ebx
+	pushl	%edi
+deflit(`FRAME',8)
+
+	movl	PARAM_SIZE, %eax
+	movl	PARAM_DST, %edx
+
+	movl	PARAM_SRC, %ebx
+	movl	PARAM_SHIFT, %ecx
+
+	cmp	$UNROLL_THRESHOLD, %eax
+	jae	L(unroll)
+
+	movl	-4(%ebx,%eax,4), %edi	C src high limb
+	decl	%eax
+
+	jnz	L(simple)
+
+	shldl(	%cl, %edi, %eax)	C eax was decremented to zero
+
+ 	shll	%cl, %edi
+
+	movl	%edi, (%edx)		C dst low limb
+	popl	%edi			C risk of data cache bank clash
+
+	popl	%ebx
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+L(simple):
+	C eax	size-1
+	C ebx	src
+	C ecx	shift
+	C edx	dst
+	C esi
+	C edi
+	C ebp
+deflit(`FRAME',8)
+
+	movd	(%ebx,%eax,4), %mm5	C src high limb
+
+ 	movd	%ecx, %mm6		C lshift
+	negl	%ecx
+
+	psllq	%mm6, %mm5
+	addl	$32, %ecx
+
+	movd	%ecx, %mm7
+	psrlq	$32, %mm5		C retval
+
+
+L(simple_top):
+	C eax	counter, limbs, negative
+	C ebx	src
+	C ecx
+	C edx	dst
+	C esi
+	C edi
+	C
+	C mm0	scratch
+	C mm5	return value
+	C mm6	shift
+	C mm7	32-shift
+
+	movq	-4(%ebx,%eax,4), %mm0
+	decl	%eax
+
+ 	psrlq	%mm7, %mm0
+
+	C
+
+	movd	%mm0, 4(%edx,%eax,4)
+	jnz	L(simple_top)
+
+
+	movd	(%ebx), %mm0
+
+	movd	%mm5, %eax
+ 	psllq	%mm6, %mm0
+
+	popl	%edi
+	popl	%ebx
+
+	movd	%mm0, (%edx)
+
+	emms
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(8)
+L(unroll):
+	C eax	size
+	C ebx	src
+	C ecx	shift
+	C edx	dst
+	C esi
+	C edi
+	C ebp
+deflit(`FRAME',8)
+
+	movd	-4(%ebx,%eax,4), %mm5	C src high limb
+	leal	(%ebx,%eax,4), %edi
+
+ 	movd	%ecx, %mm6		C lshift
+	andl	$4, %edi
+
+	psllq	%mm6, %mm5
+	jz	L(start_src_aligned)
+
+
+	C src isn't aligned, process high limb separately (marked xxx) to
+	C make it so.
+	C
+	C  source     -8(ebx,%eax,4)
+	C                  |
+	C  +-------+-------+-------+--
+	C  |               |          
+	C  +-------+-------+-------+--
+	C        0mod8   4mod8   0mod8
+	C
+	C  dest
+	C     -4(edx,%eax,4)
+	C          |
+	C  +-------+-------+--
+	C  |  xxx  |       |  
+	C  +-------+-------+--
+
+	movq	-8(%ebx,%eax,4), %mm0	C unaligned load
+
+	psllq	%mm6, %mm0
+	decl	%eax
+
+	psrlq	$32, %mm0
+
+	C
+
+	movd	%mm0, (%edx,%eax,4)
+L(start_src_aligned):
+
+	movq	-8(%ebx,%eax,4), %mm1	C src high qword
+	leal	(%edx,%eax,4), %edi
+
+	andl	$4, %edi
+	psrlq	$32, %mm5		C return value
+
+	movq	-16(%ebx,%eax,4), %mm3	C src second highest qword
+	jz	L(start_dst_aligned)
+
+	C dst isn't aligned, subtract 4 to make it so, and pretend the shift
+	C is 32 bits extra.  High limb of dst (marked xxx) handled here
+	C separately.
+	C
+	C  source     -8(ebx,%eax,4)
+	C                  |
+	C  +-------+-------+--
+	C  |      mm1      |  
+	C  +-------+-------+--
+	C                0mod8   4mod8
+	C
+	C  dest
+	C     -4(edx,%eax,4)
+	C          |
+	C  +-------+-------+-------+--
+	C  |  xxx  |               |
+	C  +-------+-------+-------+--
+	C        0mod8   4mod8   0mod8
+
+	movq	%mm1, %mm0
+	addl	$32, %ecx		C new shift
+
+	psllq	%mm6, %mm0
+
+	movd	%ecx, %mm6
+	psrlq	$32, %mm0
+
+	C wasted cycle here waiting for %mm0
+
+	movd	%mm0, -4(%edx,%eax,4)
+	subl	$4, %edx
+L(start_dst_aligned):
+
+
+ 	psllq	%mm6, %mm1
+	negl	%ecx			C -shift
+
+        addl    $64, %ecx		C 64-shift
+ 	movq	%mm3, %mm2
+
+        movd    %ecx, %mm7
+	subl	$8, %eax		C size-8
+
+ 	psrlq	%mm7, %mm3
+
+ 	por	%mm1, %mm3		C mm3 ready to store
+	jc	L(finish)
+
+
+	C The comments in mpn_rshift apply here too.
+
+	ALIGN(8)
+L(unroll_loop):
+	C eax	counter, limbs
+	C ebx	src
+	C ecx
+	C edx	dst
+	C esi
+	C edi
+	C
+	C mm0
+	C mm1
+	C mm2	src qword from 48(%ebx,%eax,4)
+	C mm3	dst qword ready to store to 56(%edx,%eax,4)
+	C
+	C mm5	return value
+	C mm6	lshift
+	C mm7	rshift
+
+ 	movq	8(%ebx,%eax,4), %mm0
+ 	psllq	%mm6, %mm2
+
+ 	movq	%mm0, %mm1
+ 	psrlq	%mm7, %mm0
+
+ 	movq	%mm3, 24(%edx,%eax,4)	C prev
+ 	por	%mm2, %mm0
+
+ 	movq	(%ebx,%eax,4), %mm3	C
+ 	psllq	%mm6, %mm1		C
+
+ 	movq	%mm0, 16(%edx,%eax,4)
+ 	movq	%mm3, %mm2		C
+
+ 	psrlq	%mm7, %mm3		C
+	subl	$4, %eax
+
+ 	por	%mm1, %mm3		C
+	jnc	L(unroll_loop)
+
+
+
+L(finish):
+	C eax	-4 to -1 representing respectively 0 to 3 limbs remaining
+
+	testb	$2, %al
+
+	jz	L(finish_no_two)
+
+ 	movq	8(%ebx,%eax,4), %mm0
+ 	psllq	%mm6, %mm2
+
+ 	movq	%mm0, %mm1
+ 	psrlq	%mm7, %mm0
+
+ 	movq	%mm3, 24(%edx,%eax,4)	C prev
+ 	por	%mm2, %mm0
+
+	movq	%mm1, %mm2
+	movq	%mm0, %mm3
+
+	subl	$2, %eax
+L(finish_no_two):
+
+
+	C eax	-4 or -3 representing respectively 0 or 1 limbs remaining
+	C
+	C mm2	src prev qword, from 48(%ebx,%eax,4)
+	C mm3	dst qword, for 56(%edx,%eax,4)
+
+	testb	$1, %al
+	movd	%mm5, %eax	C retval
+
+	popl	%edi
+	jz	L(finish_zero)
+
+
+	C One extra src limb, destination was aligned.
+	C
+	C                 source                  ebx
+	C                 --+---------------+-------+
+	C                   |      mm2      |       |
+	C                 --+---------------+-------+
+	C
+	C dest         edx+12           edx+4     edx
+	C --+---------------+---------------+-------+
+	C   |      mm3      |               |       |
+	C --+---------------+---------------+-------+
+	C
+	C mm6 = shift
+	C mm7 = ecx = 64-shift
+
+
+	C One extra src limb, destination was unaligned.
+	C
+	C                 source                  ebx
+	C                 --+---------------+-------+
+	C                   |      mm2      |       |
+	C                 --+---------------+-------+
+	C
+	C         dest         edx+12           edx+4
+	C         --+---------------+---------------+
+	C           |      mm3      |               |
+	C         --+---------------+---------------+
+	C
+	C mm6 = shift+32
+	C mm7 = ecx = 64-(shift+32)
+
+
+	C In both cases there's one extra limb of src to fetch and combine
+	C with mm2 to make a qword at 4(%edx), and in the aligned case
+	C there's an extra limb of dst to be formed from that extra src limb
+	C left shifted.
+
+
+        movd    (%ebx), %mm0
+ 	psllq	%mm6, %mm2
+
+	movq	%mm3, 12(%edx)
+	psllq	$32, %mm0
+
+        movq    %mm0, %mm1
+        psrlq   %mm7, %mm0
+
+        por     %mm2, %mm0
+        psllq   %mm6, %mm1
+
+	movq    %mm0, 4(%edx)
+	psrlq	$32, %mm1
+
+        andl	$32, %ecx
+	popl	%ebx
+
+	jz	L(finish_one_unaligned)
+
+	movd	%mm1, (%edx)
+L(finish_one_unaligned):
+
+	emms
+
+        ret
+
+
+L(finish_zero):
+
+	C No extra src limbs, destination was aligned.
+	C
+	C                 source          ebx
+	C                 --+---------------+
+	C                   |      mm2      |
+	C                 --+---------------+
+	C
+	C dest          edx+8             edx
+	C --+---------------+---------------+
+	C   |      mm3      |               |
+	C --+---------------+---------------+
+	C
+	C mm6 = shift
+	C mm7 = ecx = 64-shift
+
+
+	C No extra src limbs, destination was unaligned.
+	C
+	C               source            ebx
+	C                 --+---------------+
+	C                   |      mm2      |
+	C                 --+---------------+
+	C
+	C         dest          edx+8   edx+4
+	C         --+---------------+-------+
+	C           |      mm3      |       |
+	C         --+---------------+-------+
+	C
+	C mm6 = shift+32
+	C mm7 = ecx = 64-(shift+32)
+
+
+	C The movd for the unaligned case writes the same data to 4(%edx)
+	C that the movq does for the aligned case.
+
+
+ 	movq	%mm3, 8(%edx)
+	andl	$32, %ecx
+
+ 	psllq	%mm6, %mm2
+	jz	L(finish_zero_unaligned)
+
+ 	movq	%mm2, (%edx)
+L(finish_zero_unaligned):
+
+	psrlq	$32, %mm2
+	popl	%ebx
+
+	movd	%mm5, %eax	C retval
+
+	movd	%mm2, 4(%edx)
+
+	emms
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/pentium/mmx/popham.asm b/src/gmp/mpn/x86/pentium/mmx/popham.asm
new file mode 100644
index 000000000..587a07ab3
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/mmx/popham.asm
@@ -0,0 +1,30 @@
+dnl  Intel P55 mpn_popcount, mpn_hamdist -- population count and hamming
+dnl  distance.
+dnl 
+dnl  P55: popcount 11.5 cycles/limb, hamdist 12.0 cycles/limb
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
+include_mpn(`x86/k6/mmx/popham.asm')
diff --git a/src/gmp/mpn/x86/pentium/mmx/rshift.asm b/src/gmp/mpn/x86/pentium/mmx/rshift.asm
new file mode 100644
index 000000000..7672630d5
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/mmx/rshift.asm
@@ -0,0 +1,460 @@
+dnl  Intel P5 mpn_rshift -- mpn right shift.
+dnl 
+dnl  P5: 1.75 cycles/limb.
+
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+C Shift src,size right by shift many bits and store the result in dst,size.
+C Zeros are shifted in at the left.  Return the bits shifted out at the
+C right.
+C
+C It takes 6 mmx instructions to process 2 limbs, making 1.5 cycles/limb,
+C and with a 4 limb loop and 1 cycle of loop overhead the total is 1.75 c/l.
+C
+C Full speed depends on source and destination being aligned.  Unaligned mmx
+C loads and stores on P5 don't pair and have a 2 cycle penalty.  Some hairy
+C setups and finish-ups are done to ensure alignment for the loop.
+C
+C MMX shifts work out a bit faster even for the simple loop.
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+deflit(`FRAME',0)
+
+dnl  Minimum 5, because the unrolled loop can't handle less.
+deflit(UNROLL_THRESHOLD, 5)
+
+	.text
+	ALIGN(8)
+
+PROLOGUE(mpn_rshift)
+
+	pushl	%ebx
+	pushl	%edi
+deflit(`FRAME',8)
+
+	movl	PARAM_SIZE, %eax
+	movl	PARAM_DST, %edx
+
+	movl	PARAM_SRC, %ebx
+	movl	PARAM_SHIFT, %ecx
+
+	cmp	$UNROLL_THRESHOLD, %eax
+	jae	L(unroll)
+
+	decl	%eax
+	movl	(%ebx), %edi		C src low limb
+
+	jnz	L(simple)
+
+	shrdl(	%cl, %edi, %eax)	C eax was decremented to zero
+
+ 	shrl	%cl, %edi
+
+	movl	%edi, (%edx)		C dst low limb
+	popl	%edi			C risk of data cache bank clash
+
+	popl	%ebx
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(8)
+L(simple):
+	C eax	size-1
+	C ebx	src
+	C ecx	shift
+	C edx	dst
+	C esi
+	C edi
+	C ebp
+deflit(`FRAME',8)
+
+	movd	(%ebx), %mm5		C src[0]
+	leal	(%ebx,%eax,4), %ebx	C &src[size-1]
+
+ 	movd	%ecx, %mm6		C rshift
+	leal	-4(%edx,%eax,4), %edx	C &dst[size-2]
+
+	psllq	$32, %mm5
+	negl	%eax
+
+
+C This loop is 5 or 8 cycles, with every second load unaligned and a wasted
+C cycle waiting for the mm0 result to be ready.  For comparison a shrdl is 4
+C cycles and would be 8 in a simple loop.  Using mmx helps the return value
+C and last limb calculations too.
+
+L(simple_top):
+	C eax	counter, limbs, negative
+	C ebx	&src[size-1]
+	C ecx	return value
+	C edx	&dst[size-2]
+	C
+	C mm0	scratch
+	C mm5	return value
+	C mm6	shift
+
+	movq	(%ebx,%eax,4), %mm0
+	incl	%eax
+
+ 	psrlq	%mm6, %mm0
+
+	movd	%mm0, (%edx,%eax,4)
+	jnz	L(simple_top)
+
+
+	movd	(%ebx), %mm0
+	psrlq	%mm6, %mm5		C return value
+
+ 	psrlq	%mm6, %mm0
+	popl	%edi
+
+	movd	%mm5, %eax
+	popl	%ebx
+
+	movd	%mm0, 4(%edx)
+
+	emms
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(8)
+L(unroll):
+	C eax	size
+	C ebx	src
+	C ecx	shift
+	C edx	dst
+	C esi
+	C edi
+	C ebp
+deflit(`FRAME',8)
+
+	movd	(%ebx), %mm5		C src[0]
+	movl	$4, %edi
+
+ 	movd	%ecx, %mm6		C rshift
+	testl	%edi, %ebx
+
+	psllq	$32, %mm5
+	jz	L(start_src_aligned)
+
+
+	C src isn't aligned, process low limb separately (marked xxx) and
+	C step src and dst by one limb, making src aligned.
+	C
+	C source                  ebx
+	C --+-------+-------+-------+
+	C           |          xxx  |
+	C --+-------+-------+-------+
+	C         4mod8   0mod8   4mod8
+	C
+	C         dest            edx
+	C         --+-------+-------+
+	C           |       |  xxx  |  
+	C         --+-------+-------+
+
+	movq	(%ebx), %mm0		C unaligned load
+
+	psrlq	%mm6, %mm0
+	addl	$4, %ebx
+
+	decl	%eax
+
+	movd	%mm0, (%edx)
+	addl	$4, %edx
+L(start_src_aligned):
+
+
+	movq	(%ebx), %mm1
+	testl	%edi, %edx
+
+	psrlq	%mm6, %mm5		C retval
+	jz	L(start_dst_aligned)
+
+	C dst isn't aligned, add 4 to make it so, and pretend the shift is
+	C 32 bits extra.  Low limb of dst (marked xxx) handled here
+	C separately.
+	C
+	C          source          ebx
+	C          --+-------+-------+
+	C            |      mm1      |
+	C          --+-------+-------+
+	C                  4mod8   0mod8
+	C
+	C  dest                    edx
+	C  --+-------+-------+-------+
+	C                    |  xxx  |        
+	C  --+-------+-------+-------+
+	C          4mod8   0mod8   4mod8
+
+	movq	%mm1, %mm0
+	addl	$32, %ecx		C new shift
+
+	psrlq	%mm6, %mm0
+
+	movd	%ecx, %mm6
+
+	movd	%mm0, (%edx)
+	addl	$4, %edx
+L(start_dst_aligned):
+
+
+	movq	8(%ebx), %mm3
+	negl	%ecx
+
+ 	movq	%mm3, %mm2		C mm2 src qword
+        addl    $64, %ecx
+
+        movd    %ecx, %mm7
+ 	psrlq	%mm6, %mm1
+
+	leal	-12(%ebx,%eax,4), %ebx
+	leal	-20(%edx,%eax,4), %edx
+
+ 	psllq	%mm7, %mm3
+	subl	$7, %eax		C size-7
+
+ 	por	%mm1, %mm3		C mm3 ready to store
+	negl	%eax			C -(size-7)
+
+	jns	L(finish)
+
+
+	C This loop is the important bit, the rest is just support.  Careful
+	C instruction scheduling achieves the claimed 1.75 c/l.  The
+	C relevant parts of the pairing rules are:
+	C
+	C - mmx loads and stores execute only in the U pipe
+	C - only one mmx shift in a pair
+	C - wait one cycle before storing an mmx register result
+	C - the usual address generation interlock
+	C
+	C Two qword calculations are slightly interleaved.  The instructions
+	C marked "C" belong to the second qword, and the "C prev" one is for
+	C the second qword from the previous iteration.
+
+	ALIGN(8)
+L(unroll_loop):
+	C eax	counter, limbs, negative
+	C ebx	&src[size-12]
+	C ecx
+	C edx	&dst[size-12]
+	C esi
+	C edi
+	C
+	C mm0
+	C mm1
+	C mm2	src qword from -8(%ebx,%eax,4)
+	C mm3	dst qword ready to store to -8(%edx,%eax,4)
+	C
+	C mm5	return value
+	C mm6	rshift
+	C mm7	lshift
+
+ 	movq	(%ebx,%eax,4), %mm0
+ 	psrlq	%mm6, %mm2
+
+ 	movq	%mm0, %mm1
+ 	psllq	%mm7, %mm0
+
+ 	movq	%mm3, -8(%edx,%eax,4)	C prev
+ 	por	%mm2, %mm0
+
+ 	movq	8(%ebx,%eax,4), %mm3	C
+ 	psrlq	%mm6, %mm1		C
+
+ 	movq	%mm0, (%edx,%eax,4)
+ 	movq	%mm3, %mm2		C
+
+ 	psllq	%mm7, %mm3		C
+	addl	$4, %eax
+
+ 	por	%mm1, %mm3		C
+	js	L(unroll_loop)
+
+
+L(finish):
+	C eax	0 to 3 representing respectively 3 to 0 limbs remaining
+
+	testb	$2, %al
+
+	jnz	L(finish_no_two)
+
+ 	movq	(%ebx,%eax,4), %mm0
+ 	psrlq	%mm6, %mm2
+
+ 	movq	%mm0, %mm1
+ 	psllq	%mm7, %mm0
+
+ 	movq	%mm3, -8(%edx,%eax,4)	C prev
+ 	por	%mm2, %mm0
+
+	movq	%mm1, %mm2
+	movq	%mm0, %mm3
+
+	addl	$2, %eax
+L(finish_no_two):
+
+
+	C eax	2 or 3 representing respectively 1 or 0 limbs remaining
+	C
+	C mm2	src prev qword, from -8(%ebx,%eax,4)
+	C mm3	dst qword, for -8(%edx,%eax,4)
+
+	testb	$1, %al
+	popl	%edi
+
+	movd	%mm5, %eax	C retval
+	jnz	L(finish_zero)
+
+
+	C One extra limb, destination was aligned.
+	C
+	C source                ebx
+	C +-------+---------------+--
+	C |       |      mm2      |
+	C +-------+---------------+--
+	C
+	C dest                                  edx
+	C +-------+---------------+---------------+--
+	C |       |               |      mm3      |
+	C +-------+---------------+---------------+--
+	C
+	C mm6 = shift
+	C mm7 = ecx = 64-shift
+
+
+	C One extra limb, destination was unaligned.
+	C
+	C source                ebx
+	C +-------+---------------+--
+	C |       |      mm2      |
+	C +-------+---------------+--
+	C
+	C dest                          edx
+	C +---------------+---------------+--
+	C |               |      mm3      |
+	C +---------------+---------------+--
+	C
+	C mm6 = shift+32
+	C mm7 = ecx = 64-(shift+32)
+
+
+	C In both cases there's one extra limb of src to fetch and combine
+	C with mm2 to make a qword at 8(%edx), and in the aligned case
+	C there's a further extra limb of dst to be formed.
+
+
+        movd    8(%ebx), %mm0
+ 	psrlq	%mm6, %mm2
+
+        movq    %mm0, %mm1
+        psllq   %mm7, %mm0
+
+	movq	%mm3, (%edx)
+        por     %mm2, %mm0
+
+        psrlq   %mm6, %mm1
+        andl	$32, %ecx
+
+	popl	%ebx
+	jz	L(finish_one_unaligned)
+
+        C dst was aligned, must store one extra limb
+	movd	%mm1, 16(%edx)
+L(finish_one_unaligned):
+
+	movq    %mm0, 8(%edx)
+
+	emms
+
+        ret
+
+
+L(finish_zero):
+
+	C No extra limbs, destination was aligned.
+	C
+	C source        ebx
+	C +---------------+--
+	C |      mm2      |
+	C +---------------+--
+	C
+	C dest                        edx+4
+	C +---------------+---------------+--
+	C |               |      mm3      |
+	C +---------------+---------------+--
+	C
+	C mm6 = shift
+	C mm7 = ecx = 64-shift
+
+
+	C No extra limbs, destination was unaligned.
+	C
+	C source        ebx
+	C +---------------+--
+	C |      mm2      |
+	C +---------------+--
+	C
+	C dest                edx+4
+	C +-------+---------------+--
+	C |       |      mm3      |
+	C +-------+---------------+--
+	C
+	C mm6 = shift+32
+	C mm7 = 64-(shift+32)
+
+
+	C The movd for the unaligned case is clearly the same data as the
+	C movq for the aligned case, it's just a choice between whether one
+	C or two limbs should be written.
+
+
+ 	movq	%mm3, 4(%edx)
+ 	psrlq	%mm6, %mm2
+
+ 	movd	%mm2, 12(%edx)
+	andl	$32, %ecx
+
+	popl	%ebx
+	jz	L(finish_zero_unaligned)
+
+ 	movq	%mm2, 12(%edx)
+L(finish_zero_unaligned):
+
+	emms
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/pentium/mul_1.asm b/src/gmp/mpn/x86/pentium/mul_1.asm
new file mode 100644
index 000000000..08639eca0
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/mul_1.asm
@@ -0,0 +1,79 @@
+dnl  Intel Pentium mpn_mul_1 -- mpn by limb multiplication.
+dnl
+dnl  P5: 13.0 cycles/limb
+
+dnl  Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation,
+dnl  Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA. */
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_mul_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                      mp_limb_t multiplier);
+
+defframe(PARAM_MULTIPLIER,16)
+defframe(PARAM_SIZE,      12)
+defframe(PARAM_SRC,       8)
+defframe(PARAM_DST,       4)
+
+	.text
+	ALIGN(8)
+PROLOGUE(mpn_mul_1)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+deflit(`FRAME',16)
+
+	movl	PARAM_DST, %edi
+	movl	PARAM_SRC, %esi
+	movl	PARAM_SIZE, %ecx
+	movl	PARAM_MULTIPLIER, %ebp
+
+	leal	(%edi,%ecx,4), %edi
+	leal	(%esi,%ecx,4), %esi
+	negl	%ecx
+	xorl	%ebx, %ebx
+	ALIGN(8)
+
+L(oop):	adcl	$0, %ebx
+	movl	(%esi,%ecx,4), %eax
+
+	mull	%ebp
+
+	addl	%eax, %ebx
+
+	movl	%ebx, (%edi,%ecx,4)
+	incl	%ecx
+
+	movl	%edx, %ebx
+	jnz	L(oop)
+
+	adcl	$0, %ebx
+	movl	%ebx, %eax
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/pentium/mul_basecase.asm b/src/gmp/mpn/x86/pentium/mul_basecase.asm
new file mode 100644
index 000000000..d9f79a083
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/mul_basecase.asm
@@ -0,0 +1,135 @@
+dnl  Intel Pentium mpn_mul_basecase -- mpn by mpn multiplication.
+dnl 
+dnl  P5: 14.2 cycles/crossproduct (approx)
+
+
+dnl  Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C void mpn_mul_basecase (mp_ptr wp,
+C                        mp_srcptr xp, mp_size_t xsize,
+C                        mp_srcptr yp, mp_size_t ysize);
+
+defframe(PARAM_YSIZE, 20)
+defframe(PARAM_YP,    16)
+defframe(PARAM_XSIZE, 12)
+defframe(PARAM_XP,    8)
+defframe(PARAM_WP,    4)
+
+defframe(VAR_COUNTER, -4)
+
+	.text
+	ALIGN(8)
+PROLOGUE(mpn_mul_basecase)
+
+	pushl	%eax			C dummy push for allocating stack slot
+	pushl	%esi
+	pushl	%ebp
+	pushl	%edi
+deflit(`FRAME',16)
+
+	movl	PARAM_XP,%esi
+	movl	PARAM_WP,%edi
+	movl	PARAM_YP,%ebp
+
+	movl	(%esi),%eax		C load xp[0]
+	mull	(%ebp)			C multiply by yp[0]
+	movl	%eax,(%edi)		C store to wp[0]
+	movl	PARAM_XSIZE,%ecx	C xsize
+	decl	%ecx			C If xsize = 1, ysize = 1 too
+	jz	L(done)
+
+	movl	PARAM_XSIZE,%eax
+	pushl	%ebx
+FRAME_pushl()
+	movl	%edx,%ebx
+	leal	(%esi,%eax,4),%esi	C make xp point at end
+	leal	(%edi,%eax,4),%edi	C offset wp by xsize
+	negl	%ecx			C negate j size/index for inner loop
+	xorl	%eax,%eax		C clear carry
+
+	ALIGN(8)
+L(oop1):	adcl	$0,%ebx
+	movl	(%esi,%ecx,4),%eax	C load next limb at xp[j]
+	mull	(%ebp)
+	addl	%ebx,%eax
+	movl	%eax,(%edi,%ecx,4)
+	incl	%ecx
+	movl	%edx,%ebx
+	jnz	L(oop1)
+
+	adcl	$0,%ebx
+	movl	PARAM_YSIZE,%eax
+	movl	%ebx,(%edi)		C most significant limb of product
+	addl	$4,%edi			C increment wp
+	decl	%eax
+	jz	L(skip)
+	movl	%eax,VAR_COUNTER	C set index i to ysize
+
+L(outer):
+	addl	$4,%ebp			C make ebp point to next y limb
+	movl	PARAM_XSIZE,%ecx
+	negl	%ecx
+	xorl	%ebx,%ebx
+
+	C code at 0x61 here, close enough to aligned
+L(oop2):
+	adcl	$0,%ebx
+	movl	(%esi,%ecx,4),%eax
+	mull	(%ebp)
+	addl	%ebx,%eax
+	movl	(%edi,%ecx,4),%ebx
+	adcl	$0,%edx
+	addl	%eax,%ebx
+	movl	%ebx,(%edi,%ecx,4)
+	incl	%ecx
+	movl	%edx,%ebx
+	jnz	L(oop2)
+
+	adcl	$0,%ebx
+
+	movl	%ebx,(%edi)
+	addl	$4,%edi
+	movl	VAR_COUNTER,%eax
+	decl	%eax
+	movl	%eax,VAR_COUNTER
+	jnz	L(outer)
+
+L(skip):
+	popl	%ebx
+	popl	%edi
+	popl	%ebp
+	popl	%esi
+	addl	$4,%esp
+	ret
+
+L(done):
+	movl	%edx,4(%edi)	C store to wp[1]
+	popl	%edi
+	popl	%ebp
+	popl	%esi
+	popl	%eax		C dummy pop for deallocating stack slot
+	ret
+
+EPILOGUE()
+
diff --git a/src/gmp/mpn/x86/pentium/rshift.asm b/src/gmp/mpn/x86/pentium/rshift.asm
new file mode 100644
index 000000000..e8f5ae8ec
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/rshift.asm
@@ -0,0 +1,236 @@
+dnl  Intel Pentium mpn_rshift -- mpn right shift.
+dnl
+dnl          cycles/limb
+dnl  P5,P54:    6.0
+dnl  P55:       5.375
+
+
+dnl  Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software
+dnl  Foundation, Inc.
+dnl
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+C
+C The main shift-by-N loop should run at 5.375 c/l and that's what P55 does,
+C but P5 and P54 run only at 6.0 c/l, which is 4 cycles lost somewhere.
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+
+	.text
+	ALIGN(8)
+PROLOGUE(mpn_rshift)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+	pushl	%ebp
+deflit(`FRAME',16)
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC,%esi
+	movl	PARAM_SIZE,%ebp
+	movl	PARAM_SHIFT,%ecx
+
+C We can use faster code for shift-by-1 under certain conditions. 
+	cmp	$1,%ecx
+	jne	L(normal)
+	leal	4(%edi),%eax
+	cmpl	%esi,%eax
+	jnc	L(special)		C jump if res_ptr + 1 >= s_ptr
+	leal	(%edi,%ebp,4),%eax
+	cmpl	%eax,%esi
+	jnc	L(special)		C jump if s_ptr >= res_ptr + size
+
+L(normal):
+	movl	(%esi),%edx
+	addl	$4,%esi
+	xorl	%eax,%eax
+	shrdl(	%cl, %edx, %eax)	C compute carry limb
+	pushl	%eax			C push carry limb onto stack
+
+	decl	%ebp
+	pushl	%ebp
+	shrl	$3,%ebp
+	jz	L(end)
+
+	movl	(%edi),%eax		C fetch destination cache line
+
+	ALIGN(4)
+L(oop):	movl	28(%edi),%eax		C fetch destination cache line
+	movl	%edx,%ebx
+
+	movl	(%esi),%eax
+	movl	4(%esi),%edx
+	shrdl(	%cl, %eax, %ebx)
+	shrdl(	%cl, %edx, %eax)
+	movl	%ebx,(%edi)
+	movl	%eax,4(%edi)
+
+	movl	8(%esi),%ebx
+	movl	12(%esi),%eax
+	shrdl(	%cl, %ebx, %edx)
+	shrdl(	%cl, %eax, %ebx)
+	movl	%edx,8(%edi)
+	movl	%ebx,12(%edi)
+
+	movl	16(%esi),%edx
+	movl	20(%esi),%ebx
+	shrdl(	%cl, %edx, %eax)
+	shrdl(	%cl, %ebx, %edx)
+	movl	%eax,16(%edi)
+	movl	%edx,20(%edi)
+
+	movl	24(%esi),%eax
+	movl	28(%esi),%edx
+	shrdl(	%cl, %eax, %ebx)
+	shrdl(	%cl, %edx, %eax)
+	movl	%ebx,24(%edi)
+	movl	%eax,28(%edi)
+
+	addl	$32,%esi
+	addl	$32,%edi
+	decl	%ebp
+	jnz	L(oop)
+
+L(end):	popl	%ebp
+	andl	$7,%ebp
+	jz	L(end2)
+L(oop2):
+	movl	(%esi),%eax
+	shrdl(	%cl,%eax,%edx)		C compute result limb
+	movl	%edx,(%edi)
+	movl	%eax,%edx
+	addl	$4,%esi
+	addl	$4,%edi
+	decl	%ebp
+	jnz	L(oop2)
+
+L(end2):
+	shrl	%cl,%edx		C compute most significant limb
+	movl	%edx,(%edi)		C store it
+
+	popl	%eax			C pop carry limb
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+
+C We loop from least significant end of the arrays, which is only
+C permissable if the source and destination don't overlap, since the
+C function is documented to work for overlapping source and destination.
+
+L(special):
+	leal	-4(%edi,%ebp,4),%edi
+	leal	-4(%esi,%ebp,4),%esi
+
+	movl	(%esi),%edx
+	subl	$4,%esi
+
+	decl	%ebp
+	pushl	%ebp
+	shrl	$3,%ebp
+
+	shrl	%edx
+	incl	%ebp
+	decl	%ebp
+	jz	L(Lend)
+
+	movl	(%edi),%eax		C fetch destination cache line
+
+	ALIGN(4)
+L(Loop):
+	movl	-28(%edi),%eax		C fetch destination cache line
+	movl	%edx,%ebx
+
+	movl	(%esi),%eax
+	movl	-4(%esi),%edx
+	rcrl	%eax
+	movl	%ebx,(%edi)
+	rcrl	%edx
+	movl	%eax,-4(%edi)
+
+	movl	-8(%esi),%ebx
+	movl	-12(%esi),%eax
+	rcrl	%ebx
+	movl	%edx,-8(%edi)
+	rcrl	%eax
+	movl	%ebx,-12(%edi)
+
+	movl	-16(%esi),%edx
+	movl	-20(%esi),%ebx
+	rcrl	%edx
+	movl	%eax,-16(%edi)
+	rcrl	%ebx
+	movl	%edx,-20(%edi)
+
+	movl	-24(%esi),%eax
+	movl	-28(%esi),%edx
+	rcrl	%eax
+	movl	%ebx,-24(%edi)
+	rcrl	%edx
+	movl	%eax,-28(%edi)
+
+	leal	-32(%esi),%esi		C use leal not to clobber carry
+	leal	-32(%edi),%edi
+	decl	%ebp
+	jnz	L(Loop)
+
+L(Lend):
+	popl	%ebp
+	sbbl	%eax,%eax		C save carry in %eax
+	andl	$7,%ebp
+	jz	L(Lend2)
+	addl	%eax,%eax		C restore carry from eax
+L(Loop2):
+	movl	%edx,%ebx
+	movl	(%esi),%edx
+	rcrl	%edx
+	movl	%ebx,(%edi)
+
+	leal	-4(%esi),%esi		C use leal not to clobber carry
+	leal	-4(%edi),%edi
+	decl	%ebp
+	jnz	L(Loop2)
+
+	jmp	L(L1)
+L(Lend2):
+	addl	%eax,%eax		C restore carry from eax
+L(L1):	movl	%edx,(%edi)		C store last limb
+
+	movl	$0,%eax
+	rcrl	%eax
+
+	popl	%ebp
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/pentium/sqr_basecase.asm b/src/gmp/mpn/x86/pentium/sqr_basecase.asm
new file mode 100644
index 000000000..c8584df13
--- /dev/null
+++ b/src/gmp/mpn/x86/pentium/sqr_basecase.asm
@@ -0,0 +1,520 @@
+dnl  Intel P5 mpn_sqr_basecase -- square an mpn number.
+dnl 
+dnl  P5: approx 8 cycles per crossproduct, or 15.5 cycles per triangular
+dnl  product at around 20x20 limbs.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C void mpn_sqr_basecase (mp_ptr dst, mp_srcptr src, mp_size_t size);
+C
+C Calculate src,size squared, storing the result in dst,2*size.
+C
+C The algorithm is basically the same as mpn/generic/sqr_basecase.c, but a
+C lot of function call overheads are avoided, especially when the size is
+C small.
+
+defframe(PARAM_SIZE,12)
+defframe(PARAM_SRC, 8)
+defframe(PARAM_DST, 4)
+
+	.text
+	ALIGN(8)
+PROLOGUE(mpn_sqr_basecase)
+deflit(`FRAME',0)
+
+	movl	PARAM_SIZE, %edx
+	movl	PARAM_SRC, %eax
+
+	cmpl	$2, %edx
+	movl	PARAM_DST, %ecx
+
+	je	L(two_limbs)
+
+	movl	(%eax), %eax
+	ja	L(three_or_more)
+
+C -----------------------------------------------------------------------------
+C one limb only
+	C eax	src
+	C ebx
+	C ecx	dst
+	C edx
+
+	mull	%eax
+
+	movl	%eax, (%ecx)
+	movl	%edx, 4(%ecx)
+
+	ret
+
+C -----------------------------------------------------------------------------
+	ALIGN(8)
+L(two_limbs):
+	C eax	src
+	C ebx
+	C ecx	dst
+	C edx	size
+
+	pushl	%ebp
+	pushl	%edi
+
+	pushl	%esi
+	pushl	%ebx
+
+	movl	%eax, %ebx
+	movl	(%eax), %eax
+
+	mull	%eax		C src[0]^2
+
+	movl	%eax, (%ecx)	C dst[0]
+	movl	%edx, %esi	C dst[1]
+
+	movl	4(%ebx), %eax
+
+	mull	%eax		C src[1]^2
+
+	movl	%eax, %edi	C dst[2]
+	movl	%edx, %ebp	C dst[3]
+
+	movl	(%ebx), %eax
+
+	mull	4(%ebx)		C src[0]*src[1]
+
+	addl	%eax, %esi
+	popl	%ebx
+
+	adcl	%edx, %edi
+
+	adcl	$0, %ebp
+	addl	%esi, %eax
+
+	adcl	%edi, %edx
+	movl	%eax, 4(%ecx)
+
+	adcl	$0, %ebp
+	popl	%esi
+
+	movl	%edx, 8(%ecx)
+	movl	%ebp, 12(%ecx)
+
+	popl	%edi
+	popl	%ebp
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(8)
+L(three_or_more):
+	C eax	src low limb
+	C ebx
+	C ecx	dst
+	C edx	size
+
+	cmpl	$4, %edx
+	pushl	%ebx
+deflit(`FRAME',4)
+
+	movl	PARAM_SRC, %ebx
+	jae	L(four_or_more)
+
+
+C -----------------------------------------------------------------------------
+C three limbs
+	C eax	src low limb
+	C ebx	src
+	C ecx	dst
+	C edx	size
+
+	pushl	%ebp
+	pushl	%edi
+
+	mull	%eax		C src[0] ^ 2
+
+	movl	%eax, (%ecx)
+	movl	%edx, 4(%ecx)
+
+	movl	4(%ebx), %eax
+	xorl	%ebp, %ebp
+
+	mull	%eax		C src[1] ^ 2
+
+	movl	%eax, 8(%ecx)
+	movl	%edx, 12(%ecx)
+
+	movl	8(%ebx), %eax
+	pushl	%esi		C risk of cache bank clash
+
+	mull	%eax		C src[2] ^ 2
+
+	movl	%eax, 16(%ecx)
+	movl	%edx, 20(%ecx)
+
+	movl	(%ebx), %eax
+
+	mull	4(%ebx)		C src[0] * src[1]
+
+	movl	%eax, %esi
+	movl	%edx, %edi
+
+	movl	(%ebx), %eax
+
+	mull	8(%ebx)		C src[0] * src[2]
+
+	addl	%eax, %edi
+	movl	%edx, %ebp
+
+	adcl	$0, %ebp
+	movl	4(%ebx), %eax
+
+	mull	8(%ebx)		C src[1] * src[2]
+
+	xorl	%ebx, %ebx
+	addl	%eax, %ebp
+
+	C eax
+	C ebx	zero, will be dst[5]
+	C ecx	dst
+	C edx	dst[4]
+	C esi	dst[1]
+	C edi	dst[2]
+	C ebp	dst[3]
+
+	adcl	$0, %edx
+	addl	%esi, %esi
+
+	adcl	%edi, %edi
+
+	adcl	%ebp, %ebp
+
+	adcl	%edx, %edx
+	movl	4(%ecx), %eax
+
+	adcl	$0, %ebx
+	addl	%esi, %eax
+
+	movl	%eax, 4(%ecx)
+	movl	8(%ecx), %eax
+
+	adcl	%edi, %eax
+	movl	12(%ecx), %esi
+
+	adcl	%ebp, %esi
+	movl	16(%ecx), %edi
+
+	movl	%eax, 8(%ecx)
+	movl	%esi, 12(%ecx)
+
+	adcl	%edx, %edi
+	popl	%esi
+
+	movl	20(%ecx), %eax
+	movl	%edi, 16(%ecx)
+
+	popl	%edi
+	popl	%ebp
+
+	adcl	%ebx, %eax	C no carry out of this
+	popl	%ebx
+
+	movl	%eax, 20(%ecx)
+
+	ret
+
+
+C -----------------------------------------------------------------------------
+	ALIGN(8)
+L(four_or_more):
+	C eax	src low limb
+	C ebx	src
+	C ecx	dst
+	C edx	size
+	C esi
+	C edi
+	C ebp
+	C
+	C First multiply src[0]*src[1..size-1] and store at dst[1..size].
+
+deflit(`FRAME',4)
+
+	pushl	%edi
+FRAME_pushl()
+	pushl	%esi
+FRAME_pushl()
+
+	pushl	%ebp
+FRAME_pushl()
+	leal	(%ecx,%edx,4), %edi	C dst end of this mul1
+
+	leal	(%ebx,%edx,4), %esi	C src end
+	movl	%ebx, %ebp		C src
+
+	negl	%edx			C -size
+	xorl	%ebx, %ebx		C clear carry limb and carry flag
+
+	leal	1(%edx), %ecx		C -(size-1)
+
+L(mul1):
+	C eax	scratch
+	C ebx	carry
+	C ecx	counter, negative
+	C edx	scratch
+	C esi	&src[size]
+	C edi	&dst[size]
+	C ebp	src
+
+	adcl	$0, %ebx
+	movl	(%esi,%ecx,4), %eax
+
+	mull	(%ebp)
+
+	addl	%eax, %ebx
+
+	movl	%ebx, (%edi,%ecx,4)
+	incl	%ecx
+
+	movl	%edx, %ebx
+	jnz	L(mul1)
+
+
+	C Add products src[n]*src[n+1..size-1] at dst[2*n-1...], for
+	C n=1..size-2.
+	C
+	C The last two products, which are the end corner of the product
+	C triangle, are handled separately to save looping overhead.  These
+	C are src[size-3]*src[size-2,size-1] and src[size-2]*src[size-1].
+	C If size is 4 then it's only these that need to be done.
+	C
+	C In the outer loop %esi is a constant, and %edi just advances by 1
+	C limb each time.  The size of the operation decreases by 1 limb
+	C each time.
+
+	C eax
+	C ebx	carry (needing carry flag added)
+	C ecx
+	C edx
+	C esi	&src[size]
+	C edi	&dst[size]
+	C ebp
+
+	adcl	$0, %ebx
+	movl	PARAM_SIZE, %edx
+
+	movl	%ebx, (%edi)
+	subl	$4, %edx
+
+	negl	%edx
+	jz	L(corner)
+
+
+L(outer):
+	C ebx	previous carry limb to store
+	C edx	outer loop counter (negative)
+	C esi	&src[size]
+	C edi	dst, pointing at stored carry limb of previous loop
+
+	pushl	%edx			C new outer loop counter
+	leal	-2(%edx), %ecx
+
+	movl	%ebx, (%edi)
+	addl	$4, %edi
+
+	addl	$4, %ebp
+	xorl	%ebx, %ebx		C initial carry limb, clear carry flag
+
+L(inner):
+	C eax	scratch
+	C ebx	carry (needing carry flag added)
+	C ecx	counter, negative
+	C edx	scratch
+	C esi	&src[size]
+	C edi	dst end of this addmul
+	C ebp	&src[j]
+
+	adcl	$0, %ebx
+	movl	(%esi,%ecx,4), %eax
+
+	mull	(%ebp)
+
+	addl	%ebx, %eax
+	movl	(%edi,%ecx,4), %ebx
+
+	adcl	$0, %edx
+	addl	%eax, %ebx
+
+	movl	%ebx, (%edi,%ecx,4)
+	incl	%ecx
+
+	movl	%edx, %ebx
+	jnz	L(inner)
+
+
+	adcl	$0, %ebx
+	popl	%edx		C outer loop counter
+
+	incl	%edx
+	jnz	L(outer)
+
+
+	movl	%ebx, (%edi)
+
+L(corner):
+	C esi	&src[size]
+	C edi	&dst[2*size-4]
+
+	movl	-8(%esi), %eax
+	movl	-4(%edi), %ebx		C risk of data cache bank clash here
+
+	mull	-12(%esi)		C src[size-2]*src[size-3]
+
+	addl	%eax, %ebx
+	movl	%edx, %ecx
+
+	adcl	$0, %ecx
+	movl	-4(%esi), %eax
+
+	mull	-12(%esi)		C src[size-1]*src[size-3]
+
+	addl	%ecx, %eax
+	movl	(%edi), %ecx
+
+	adcl	$0, %edx
+	movl	%ebx, -4(%edi)
+
+	addl	%eax, %ecx
+	movl	%edx, %ebx
+
+	adcl	$0, %ebx
+	movl	-4(%esi), %eax
+
+	mull	-8(%esi)		C src[size-1]*src[size-2]
+
+	movl	%ecx, 0(%edi)
+	addl	%eax, %ebx
+
+	adcl	$0, %edx
+	movl	PARAM_SIZE, %eax
+
+	negl	%eax
+	movl	%ebx, 4(%edi)
+
+	addl	$1, %eax		C -(size-1) and clear carry
+	movl	%edx, 8(%edi)
+
+
+C -----------------------------------------------------------------------------
+C Left shift of dst[1..2*size-2], high bit shifted out becomes dst[2*size-1].
+
+L(lshift):
+	C eax	counter, negative
+	C ebx	next limb
+	C ecx
+	C edx
+	C esi
+	C edi	&dst[2*size-4]
+	C ebp
+
+	movl	12(%edi,%eax,8), %ebx
+
+	rcll	%ebx
+	movl	16(%edi,%eax,8), %ecx
+	
+	rcll	%ecx
+	movl	%ebx, 12(%edi,%eax,8)
+
+	movl	%ecx, 16(%edi,%eax,8)
+	incl	%eax
+
+	jnz	L(lshift)
+
+
+	adcl	%eax, %eax		C high bit out
+	movl	PARAM_SRC, %esi
+
+	movl	PARAM_SIZE, %ecx	C risk of cache bank clash
+	movl	%eax, 12(%edi)		C dst most significant limb
+
+
+C -----------------------------------------------------------------------------
+C Now add in the squares on the diagonal, namely src[0]^2, src[1]^2, ...,
+C src[size-1]^2.  dst[0] hasn't yet been set at all yet, and just gets the
+C low limb of src[0]^2.
+
+	movl	(%esi), %eax		C src[0]
+	leal	(%esi,%ecx,4), %esi	C src end
+
+	negl	%ecx
+
+	mull	%eax
+
+	movl	%eax, 16(%edi,%ecx,8)	C dst[0]
+	movl	%edx, %ebx
+
+	addl	$1, %ecx		C size-1 and clear carry
+
+L(diag):
+	C eax	scratch (low product)
+	C ebx	carry limb
+	C ecx	counter, negative
+	C edx	scratch (high product)
+	C esi	&src[size]
+	C edi	&dst[2*size-4]
+	C ebp	scratch (fetched dst limbs)
+
+	movl	(%esi,%ecx,4), %eax
+	adcl	$0, %ebx
+
+	mull	%eax
+
+	movl	16-4(%edi,%ecx,8), %ebp
+
+	addl	%ebp, %ebx
+	movl	16(%edi,%ecx,8), %ebp
+
+	adcl	%eax, %ebp
+	movl	%ebx, 16-4(%edi,%ecx,8)
+
+	movl	%ebp, 16(%edi,%ecx,8)
+	incl	%ecx
+
+	movl	%edx, %ebx
+	jnz	L(diag)
+
+
+	adcl	$0, %edx
+	movl	16-4(%edi), %eax	C dst most significant limb
+
+	addl	%eax, %edx
+	popl	%ebp
+
+	movl	%edx, 16-4(%edi)
+	popl	%esi		C risk of cache bank clash
+
+	popl	%edi
+	popl	%ebx
+
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/rshift.asm b/src/gmp/mpn/x86/rshift.asm
new file mode 100644
index 000000000..c9881fd96
--- /dev/null
+++ b/src/gmp/mpn/x86/rshift.asm
@@ -0,0 +1,92 @@
+dnl  x86 mpn_rshift -- mpn right shift.
+
+dnl  Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation,
+dnl  Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
+C                       unsigned shift);
+
+defframe(PARAM_SHIFT,16)
+defframe(PARAM_SIZE, 12)
+defframe(PARAM_SRC,  8)
+defframe(PARAM_DST,  4)
+
+	.text
+	ALIGN(8)
+PROLOGUE(mpn_rshift)
+
+	pushl	%edi
+	pushl	%esi
+	pushl	%ebx
+deflit(`FRAME',12)
+
+	movl	PARAM_DST,%edi
+	movl	PARAM_SRC,%esi
+	movl	PARAM_SIZE,%edx
+	movl	PARAM_SHIFT,%ecx
+
+	leal	-4(%edi,%edx,4),%edi
+	leal	(%esi,%edx,4),%esi
+	negl	%edx
+
+	movl	(%esi,%edx,4),%ebx	C read least significant limb
+	xorl	%eax,%eax
+	shrdl(	%cl, %ebx, %eax)	C compute carry limb
+	incl	%edx
+	jz	L(end)
+	pushl	%eax			C push carry limb onto stack
+	testb	$1,%dl
+	jnz	L(1)			C enter loop in the middle
+	movl	%ebx,%eax
+
+	ALIGN(8)
+L(oop):	movl	(%esi,%edx,4),%ebx	C load next higher limb
+	shrdl(	%cl, %ebx, %eax)	C compute result limb
+	movl	%eax,(%edi,%edx,4)	C store it
+	incl	%edx
+L(1):	movl	(%esi,%edx,4),%eax
+	shrdl(	%cl, %eax, %ebx)
+	movl	%ebx,(%edi,%edx,4)
+	incl	%edx
+	jnz	L(oop)
+
+	shrl	%cl,%eax		C compute most significant limb
+	movl	%eax,(%edi)		C store it
+
+	popl	%eax			C pop carry limb
+
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+L(end):	shrl	%cl,%ebx		C compute most significant limb
+	movl	%ebx,(%edi)		C store it
+
+	popl	%ebx
+	popl	%esi
+	popl	%edi
+	ret
+
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/udiv.asm b/src/gmp/mpn/x86/udiv.asm
new file mode 100644
index 000000000..9fe022b10
--- /dev/null
+++ b/src/gmp/mpn/x86/udiv.asm
@@ -0,0 +1,44 @@
+dnl  x86 mpn_udiv_qrnnd -- 2 by 1 limb division
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_udiv_qrnnd (mp_limb_t *remptr, mp_limb_t high, mp_limb_t low,
+C                           mp_limb_t divisor);
+
+defframe(PARAM_DIVISOR, 16)
+defframe(PARAM_LOW,     12)
+defframe(PARAM_HIGH,    8)
+defframe(PARAM_REMPTR,  4)
+
+	TEXT
+	ALIGN(8)
+PROLOGUE(mpn_udiv_qrnnd)
+deflit(`FRAME',0)
+	movl	PARAM_LOW, %eax
+	movl	PARAM_HIGH, %edx
+	divl	PARAM_DIVISOR
+	movl	PARAM_REMPTR, %ecx
+	movl	%edx, (%ecx)
+	ret
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/umul.asm b/src/gmp/mpn/x86/umul.asm
new file mode 100644
index 000000000..3d289d178
--- /dev/null
+++ b/src/gmp/mpn/x86/umul.asm
@@ -0,0 +1,43 @@
+dnl  mpn_umul_ppmm -- 1x1->2 limb multiplication
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C mp_limb_t mpn_umul_ppmm (mp_limb_t *lowptr, mp_limb_t m1, mp_limb_t m2);
+C
+
+defframe(PARAM_M2,    12)
+defframe(PARAM_M1,     8)
+defframe(PARAM_LOWPTR, 4)
+
+	TEXT
+	ALIGN(8)
+PROLOGUE(mpn_umul_ppmm)
+deflit(`FRAME',0)
+	movl	PARAM_LOWPTR, %ecx
+	movl	PARAM_M1, %eax
+	mull	PARAM_M2
+	movl	%eax, (%ecx)
+	movl	%edx, %eax
+	ret
+EPILOGUE()
diff --git a/src/gmp/mpn/x86/x86-defs.m4 b/src/gmp/mpn/x86/x86-defs.m4
new file mode 100644
index 000000000..2dad69800
--- /dev/null
+++ b/src/gmp/mpn/x86/x86-defs.m4
@@ -0,0 +1,713 @@
+divert(-1)
+
+dnl  m4 macros for x86 assembler.
+
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+dnl  Notes:
+dnl
+dnl  m4 isn't perfect for processing BSD style x86 assembler code, the main
+dnl  problems are,
+dnl
+dnl  1. Doing define(foo,123) and then using foo in an addressing mode like
+dnl     foo(%ebx) expands as a macro rather than a constant.  This is worked
+dnl     around by using deflit() from asm-defs.m4, instead of define().
+dnl
+dnl  2. Immediates in macro definitions need a space or `' to stop the $
+dnl     looking like a macro parameter.  For example,
+dnl
+dnl  	        define(foo, `mov $ 123, %eax')
+dnl
+dnl     This is only a problem in macro definitions, not in ordinary text,
+dnl     nor in macro parameters like text passed to forloop() or ifdef().
+
+
+deflit(BYTES_PER_MP_LIMB, 4)
+
+
+dnl  --------------------------------------------------------------------------
+dnl  Replacement PROLOGUE/EPILOGUE with more sophisticated error checking.
+dnl  Nesting and overlapping not allowed.
+dnl
+
+
+dnl  Usage: PROLOGUE(functionname)
+dnl
+dnl  Generate a function prologue.  functionname gets GSYM_PREFIX added.
+dnl  Examples,
+dnl
+dnl         PROLOGUE(mpn_add_n)
+dnl         PROLOGUE(somefun)
+
+define(`PROLOGUE',
+m4_assert_numargs(1)
+m4_assert_defined(`PROLOGUE_cpu')
+`ifdef(`PROLOGUE_current_function',
+`m4_error(`PROLOGUE'(`PROLOGUE_current_function') needs an `EPILOGUE'() before `PROLOGUE'($1)
+)')dnl
+m4_file_seen()dnl
+define(`PROLOGUE_current_function',`$1')dnl
+PROLOGUE_cpu(GSYM_PREFIX`'$1)')
+
+
+dnl  Usage: EPILOGUE()
+dnl
+dnl  Notice the function name is passed to EPILOGUE_cpu(), letting it use $1
+dnl  instead of the long PROLOGUE_current_function symbol.
+
+define(`EPILOGUE',
+m4_assert_numargs(0)
+m4_assert_defined(`EPILOGUE_cpu')
+`ifdef(`PROLOGUE_current_function',,
+`m4_error(`EPILOGUE'() with no `PROLOGUE'()
+)')dnl
+EPILOGUE_cpu(GSYM_PREFIX`'PROLOGUE_current_function)`'dnl
+undefine(`PROLOGUE_current_function')')
+
+m4wrap_prepend(
+`ifdef(`PROLOGUE_current_function',
+`m4_error(`EPILOGUE() for PROLOGUE('PROLOGUE_current_function`) never seen
+')')')
+
+
+dnl  Usage: PROLOGUE_assert_inside()
+dnl
+dnl  Use this unquoted on a line on its own at the start of a macro
+dnl  definition to add some code to check the macro is only used inside a
+dnl  PROLOGUE/EPILOGUE pair, and that hence PROLOGUE_current_function is
+dnl  defined.
+
+define(PROLOGUE_assert_inside,
+m4_assert_numargs(0)
+``PROLOGUE_assert_inside_internal'(m4_doublequote($`'0))`dnl '')
+
+define(PROLOGUE_assert_inside_internal,
+m4_assert_numargs(1)
+`ifdef(`PROLOGUE_current_function',,
+`m4_error(`$1 used outside a PROLOGUE / EPILOGUE pair
+')')')
+
+
+dnl  Usage: L(labelname)
+dnl         LF(functionname,labelname)
+dnl
+dnl  Generate a local label in the current or given function.  For LF(),
+dnl  functionname gets GSYM_PREFIX added, the same as with PROLOGUE().
+dnl
+dnl  For example, in a function mpn_add_n (and with MPN_PREFIX __gmpn),
+dnl
+dnl         L(bar)          => L__gmpn_add_n__bar
+dnl         LF(somefun,bar) => Lsomefun__bar
+dnl
+dnl  The funtion name and label name get two underscores between them rather
+dnl  than one to guard against clashing with a separate external symbol that
+dnl  happened to be called functionname_labelname.  (Though this would only
+dnl  happen if the local label prefix is is empty.)  Underscores are used so
+dnl  the whole label will still be a valid C identifier and so can be easily
+dnl  used in gdb.
+
+dnl  LSYM_PREFIX can be L$, so defn() is used to prevent L expanding as the
+dnl  L macro and making an infinite recursion.
+define(LF,
+m4_assert_numargs(2)
+m4_assert_defined(`LSYM_PREFIX')
+`defn(`LSYM_PREFIX')GSYM_PREFIX`'$1`'__$2')
+
+define(`L',
+m4_assert_numargs(1)
+PROLOGUE_assert_inside()
+`LF(PROLOGUE_current_function,`$1')')
+
+
+dnl  Called: PROLOGUE_cpu(gsym)
+dnl          EPILOGUE_cpu(gsym)
+
+define(PROLOGUE_cpu,
+m4_assert_numargs(1)
+	`GLOBL	$1
+	TYPE($1,`function')
+$1:')
+
+define(EPILOGUE_cpu,
+m4_assert_numargs(1)
+`	SIZE($1,.-$1)')
+
+
+
+dnl  --------------------------------------------------------------------------
+dnl  Various x86 macros.
+dnl
+
+
+dnl  Usage: ALIGN_OFFSET(bytes,offset)
+dnl
+dnl  Align to `offset' away from a multiple of `bytes'.
+dnl
+dnl  This is useful for testing, for example align to something very strict
+dnl  and see what effect offsets from it have, "ALIGN_OFFSET(256,32)".
+dnl
+dnl  Generally you wouldn't execute across the padding, but it's done with
+dnl  nop's so it'll work.
+
+define(ALIGN_OFFSET,
+m4_assert_numargs(2)
+`ALIGN($1)
+forloop(`i',1,$2,`	nop
+')')
+
+
+dnl  Usage: defframe(name,offset)
+dnl
+dnl  Make a definition like the following with which to access a parameter
+dnl  or variable on the stack.
+dnl
+dnl         define(name,`FRAME+offset(%esp)')
+dnl
+dnl  Actually m4_empty_if_zero(FRAME+offset) is used, which will save one
+dnl  byte if FRAME+offset is zero, by putting (%esp) rather than 0(%esp).
+dnl  Use define(`defframe_empty_if_zero_disabled',1) if for some reason the
+dnl  zero offset is wanted.
+dnl
+dnl  The new macro also gets a check that when it's used FRAME is actually
+dnl  defined, and that the final %esp offset isn't negative, which would
+dnl  mean an attempt to access something below the current %esp.
+dnl
+dnl  deflit() is used rather than a plain define(), so the new macro won't
+dnl  delete any following parenthesized expression.  name(%edi) will come
+dnl  out say as 16(%esp)(%edi).  This isn't valid assembler and should
+dnl  provoke an error, which is better than silently giving just 16(%esp).
+dnl
+dnl  See README.family for more on the suggested way to access the stack
+dnl  frame.
+
+define(defframe,
+m4_assert_numargs(2)
+`deflit(`$1',
+m4_assert_defined(`FRAME')
+`defframe_check_notbelow(`$1',$2,FRAME)dnl
+defframe_empty_if_zero(FRAME+($2))(%esp)')')
+
+dnl  Called: defframe_empty_if_zero(expression)
+define(defframe_empty_if_zero,
+`ifelse(defframe_empty_if_zero_disabled,1,
+`eval($1)',
+`m4_empty_if_zero($1)')')
+
+dnl  Called: defframe_check_notbelow(`name',offset,FRAME)
+define(defframe_check_notbelow,
+m4_assert_numargs(3)
+`ifelse(eval(($3)+($2)<0),1,
+`m4_error(`$1 at frame offset $2 used when FRAME is only $3 bytes
+')')')
+
+
+dnl  Usage: FRAME_pushl()
+dnl         FRAME_popl()
+dnl         FRAME_addl_esp(n)
+dnl         FRAME_subl_esp(n)
+dnl
+dnl  Adjust FRAME appropriately for a pushl or popl, or for an addl or subl
+dnl  %esp of n bytes.
+dnl
+dnl  Using these macros is completely optional.  Sometimes it makes more
+dnl  sense to put explicit deflit(`FRAME',N) forms, especially when there's
+dnl  jumps and different sequences of FRAME values need to be used in
+dnl  different places.
+
+define(FRAME_pushl,
+m4_assert_numargs(0)
+m4_assert_defined(`FRAME')
+`deflit(`FRAME',eval(FRAME+4))')
+
+define(FRAME_popl,
+m4_assert_numargs(0)
+m4_assert_defined(`FRAME')
+`deflit(`FRAME',eval(FRAME-4))')
+
+define(FRAME_addl_esp,
+m4_assert_numargs(1)
+m4_assert_defined(`FRAME')
+`deflit(`FRAME',eval(FRAME-($1)))')
+
+define(FRAME_subl_esp,
+m4_assert_numargs(1)
+m4_assert_defined(`FRAME')
+`deflit(`FRAME',eval(FRAME+($1)))')
+
+
+dnl  Usage: defframe_pushl(name)
+dnl
+dnl  Do a combination of a FRAME_pushl() and a defframe() to name the stack
+dnl  location just pushed.  This should come after a pushl instruction.
+dnl  Putting it on the same line works and avoids lengthening the code.  For
+dnl  example,
+dnl
+dnl         pushl   %eax     defframe_pushl(VAR_COUNTER)
+dnl
+dnl  Notice the defframe() is done with an unquoted -FRAME thus giving its
+dnl  current value without tracking future changes.
+
+define(defframe_pushl,
+`FRAME_pushl()defframe(`$1',-FRAME)')
+
+
+dnl  --------------------------------------------------------------------------
+dnl  Assembler instruction macros.
+dnl
+
+
+dnl  Usage: emms_or_femms
+dnl         femms_available_p
+dnl
+dnl  femms_available_p expands to 1 or 0 according to whether the AMD 3DNow
+dnl  femms instruction is available.  emms_or_femms expands to femms if
+dnl  available, or emms if not.
+dnl
+dnl  emms_or_femms is meant for use in the K6 directory where plain K6
+dnl  (without femms) and K6-2 and K6-3 (with a slightly faster femms) are
+dnl  supported together.
+dnl
+dnl  On K7 femms is no longer faster and is just an alias for emms, so plain
+dnl  emms may as well be used.
+
+define(femms_available_p,
+m4_assert_numargs(-1)
+`m4_ifdef_anyof_p(
+	`HAVE_TARGET_CPU_k62',
+	`HAVE_TARGET_CPU_k63',
+	`HAVE_TARGET_CPU_athlon')')
+
+define(emms_or_femms,
+m4_assert_numargs(-1)
+`ifelse(femms_available_p,1,`femms',`emms')')
+
+
+dnl  Usage: femms
+dnl
+dnl  The gas 2.9.1 that comes with FreeBSD 3.4 doesn't support femms, so the
+dnl  following is a replacement using .byte.
+dnl
+dnl  If femms isn't available, an emms is generated instead, for convenience
+dnl  when testing on a machine without femms.
+
+define(femms,
+m4_assert_numargs(-1)
+`ifelse(femms_available_p,1,
+`.byte	15,14	C AMD 3DNow femms',
+`emms`'dnl
+m4_warning(`warning, using emms in place of femms, use for testing only
+')')')
+
+
+dnl  Usage: jadcl0(op)
+dnl
+dnl  Issue a jnc/incl as a substitute for adcl $0,op.  This isn't an exact
+dnl  replacement, since it doesn't set the flags like adcl does.
+dnl
+dnl  This finds a use in K6 mpn_addmul_1, mpn_submul_1, mpn_mul_basecase and
+dnl  mpn_sqr_basecase because on K6 an adcl is slow, the branch
+dnl  misprediction penalty is small, and the multiply algorithm used leads
+dnl  to a carry bit on average only 1/4 of the time.
+dnl
+dnl  jadcl0_disabled can be set to 1 to instead issue an ordinary adcl for
+dnl  comparison.  For example,
+dnl
+dnl		define(`jadcl0_disabled',1)
+dnl
+dnl  When using a register operand, eg. "jadcl0(%edx)", the jnc/incl code is
+dnl  the same size as an adcl.  This makes it possible to use the exact same
+dnl  computed jump code when testing the relative speed of jnc/incl and adcl
+dnl  with jadcl0_disabled.
+
+define(jadcl0,
+m4_assert_numargs(1)
+`ifelse(jadcl0_disabled,1,
+	`adcl	$`'0, $1',
+	`jnc	1f
+	incl	$1
+1:dnl')')
+
+
+dnl  Usage: cmov_available_p
+dnl
+dnl  Expand to 1 if cmov is available, 0 if not.
+
+define(cmov_available_p,
+`m4_ifdef_anyof_p(
+	`HAVE_TARGET_CPU_pentiumpro',
+	`HAVE_TARGET_CPU_pentium2',
+	`HAVE_TARGET_CPU_pentium3',
+	`HAVE_TARGET_CPU_athlon')')
+
+
+dnl  Usage: x86_lookup(target, key,value, key,value, ...)
+dnl         x86_lookup_p(target, key,value, key,value, ...)
+dnl
+dnl  Look for `target' among the `key' parameters.
+dnl
+dnl  x86_lookup expands to the corresponding `value', or generates an error
+dnl  if `target' isn't found.
+dnl
+dnl  x86_lookup_p expands to 1 if `target' is found, or 0 if not.
+
+define(x86_lookup,
+`ifelse(eval($#<3),1,
+`m4_error(`unrecognised part of x86 instruction: $1
+')',
+`ifelse(`$1',`$2', `$3',
+`x86_lookup(`$1',shift(shift(shift($@))))')')')
+
+define(x86_lookup_p,
+`ifelse(eval($#<3),1, `0',
+`ifelse(`$1',`$2',    `1',
+`x86_lookup_p(`$1',shift(shift(shift($@))))')')')
+
+
+dnl  Usage: x86_opcode_reg32(reg)
+dnl         x86_opcode_reg32_p(reg)
+dnl
+dnl  x86_opcode_reg32 expands to the standard 3 bit encoding for the given
+dnl  32-bit register, eg. `%ebp' turns into 5.
+dnl
+dnl  x86_opcode_reg32_p expands to 1 if reg is a valid 32-bit register, or 0
+dnl  if not.
+
+define(x86_opcode_reg32,
+m4_assert_numargs(1)
+`x86_lookup(`$1',x86_opcode_reg32_list)')
+
+define(x86_opcode_reg32_p,
+m4_assert_onearg()
+`x86_lookup_p(`$1',x86_opcode_reg32_list)')
+
+define(x86_opcode_reg32_list,
+``%eax',0,
+`%ecx',1,
+`%edx',2,
+`%ebx',3,
+`%esp',4,
+`%ebp',5,
+`%esi',6,
+`%edi',7')
+
+
+dnl  Usage: x86_opcode_tttn(cond)
+dnl
+dnl  Expand to the 4-bit "tttn" field value for the given x86 branch
+dnl  condition (like `c', `ae', etc).
+
+define(x86_opcode_tttn,
+m4_assert_numargs(1)
+`x86_lookup(`$1',x86_opcode_ttn_list)')
+
+define(x86_opcode_tttn_list,
+``o',  0,
+`no',  1,
+`b',   2, `c',  2, `nae',2,
+`nb',  3, `nc', 3, `ae', 3,
+`e',   4, `z',  4,
+`ne',  5, `nz', 5,
+`be',  6, `na', 6,
+`nbe', 7, `a',  7,
+`s',   8,
+`ns',  9,
+`p',  10, `pe', 10, `npo',10,
+`np', 11, `npe',11, `po', 11,
+`l',  12, `nge',12,
+`nl', 13, `ge', 13,
+`le', 14, `ng', 14,
+`nle',15, `g',  15')
+
+
+dnl  Usage: cmovCC(srcreg,dstreg)
+dnl
+dnl  Generate a cmov instruction if the target supports cmov, or simulate it
+dnl  with a conditional jump if not (the latter being meant only for
+dnl  testing).  For example,
+dnl
+dnl         cmovz(  %eax, %ebx)
+dnl
+dnl  cmov instructions are generated using .byte sequences, since only
+dnl  recent versions of gas know cmov.
+dnl
+dnl  The source operand can only be a plain register.  (m4 code implementing
+dnl  full memory addressing modes exists, believe it or not, but isn't
+dnl  currently needed and isn't included.)
+dnl
+dnl  All the standard conditions are defined.  Attempting to use one without
+dnl  the macro parentheses, such as just "cmovbe %eax, %ebx", will provoke
+dnl  an error.  This ensures the necessary .byte sequences aren't
+dnl  accidentally missed.
+
+dnl  Called: define_cmov_many(cond,tttn,cond,tttn,...)
+define(define_cmov_many,
+`ifelse(m4_length(`$1'),0,,
+`define_cmov(`$1',`$2')define_cmov_many(shift(shift($@)))')')
+
+dnl  Called: define_cmov(cond,tttn)
+define(define_cmov,
+m4_assert_numargs(2)
+`define(`cmov$1',
+m4_instruction_wrapper()
+m4_assert_numargs(2)
+`cmov_internal'(m4_doublequote($`'0),``$1',`$2'',dnl
+m4_doublequote($`'1),m4_doublequote($`'2)))')
+
+define_cmov_many(x86_opcode_tttn_list)
+
+
+dnl  Called: cmov_internal(name,cond,tttn,src,dst)
+define(cmov_internal,
+m4_assert_numargs(5)
+`ifelse(cmov_available_p,1,
+`cmov_bytes_tttn(`$1',`$3',`$4',`$5')',
+`m4_warning(`warning, simulating cmov with jump, use for testing only
+')cmov_simulate(`$2',`$4',`$5')')')
+
+dnl  Called: cmov_simulate(cond,src,dst)
+dnl  If this is going to be used with memory operands for the source it will
+dnl  need to be changed to do a fetch even if the condition is false, so as
+dnl  to trigger exceptions the same way a real cmov does.
+define(cmov_simulate,
+m4_assert_numargs(3)
+	`j$1	1f	C cmov$1 $2, $3
+	jmp	2f
+1:	movl	$2, $3
+2:')
+
+dnl  Called: cmov_bytes_tttn(name,tttn,src,dst)
+define(cmov_bytes_tttn,
+m4_assert_numargs(4)
+`.byte	dnl
+15, dnl
+eval(64+$2), dnl
+eval(192+8*x86_opcode_reg32(`$4')+x86_opcode_reg32(`$3')) dnl
+	C `$1 $3, $4'')
+
+
+dnl  Usage: loop_or_decljnz label
+dnl
+dnl  Generate either a "loop" instruction or a "decl %ecx / jnz", whichever
+dnl  is better.  "loop" is better on K6 and probably on 386, on other chips
+dnl  separate decl/jnz is better.
+dnl
+dnl  This macro is just for mpn/x86/divrem_1.asm and mpn/x86/mod_1.asm where
+dnl  this loop_or_decljnz variation is enough to let the code be shared by
+dnl  all chips.
+
+define(loop_or_decljnz,
+`ifelse(loop_is_better_p,1,
+	`loop',
+	`decl	%ecx
+	jnz')')
+
+define(loop_is_better_p,
+`m4_ifdef_anyof_p(`HAVE_TARGET_CPU_k6',
+                  `HAVE_TARGET_CPU_k62',
+                  `HAVE_TARGET_CPU_k63',
+                  `HAVE_TARGET_CPU_i386')')
+
+
+dnl  Usage: Zdisp(inst,op,op,op)
+dnl
+dnl  Generate explicit .byte sequences if necessary to force a byte-sized
+dnl  zero displacement on an instruction.  For example,
+dnl
+dnl         Zdisp(  movl,   0,(%esi), %eax)
+dnl
+dnl  expands to
+dnl
+dnl                 .byte   139,70,0  C movl 0(%esi), %eax
+dnl
+dnl  If the displacement given isn't 0, then normal assembler code is
+dnl  generated.  For example,
+dnl
+dnl         Zdisp(  movl,   4,(%esi), %eax)
+dnl
+dnl  expands to
+dnl
+dnl                 movl    4(%esi), %eax
+dnl
+dnl  This means a single Zdisp() form can be used with an expression for the
+dnl  displacement, and .byte will be used only if necessary.  The
+dnl  displacement argument is eval()ed.
+dnl
+dnl  Because there aren't many places a 0(reg) form is wanted, Zdisp is
+dnl  implemented with a table of instructions and encodings.  A new entry is
+dnl  needed for any different operation or registers.
+
+define(Zdisp,
+`define(`Zdisp_found',0)dnl
+Zdisp_match( movl, %eax, 0,(%edi), `137,71,0',    $@)`'dnl
+Zdisp_match( movl, %ebx, 0,(%edi), `137,95,0',    $@)`'dnl
+Zdisp_match( movl, %esi, 0,(%edi), `137,119,0',   $@)`'dnl
+Zdisp_match( movl, 0,(%ebx), %eax, `139,67,0',    $@)`'dnl
+Zdisp_match( movl, 0,(%ebx), %esi, `139,115,0',   $@)`'dnl
+Zdisp_match( movl, 0,(%esi), %eax, `139,70,0',    $@)`'dnl
+Zdisp_match( movl, 0,(%esi,%ecx,4), %eax, `0x8b,0x44,0x8e,0x00',      $@)`'dnl
+Zdisp_match( addl, %ebx, 0,(%edi), `1,95,0',      $@)`'dnl
+Zdisp_match( addl, %ecx, 0,(%edi), `1,79,0',      $@)`'dnl
+Zdisp_match( addl, %esi, 0,(%edi), `1,119,0',     $@)`'dnl
+Zdisp_match( subl, %ecx, 0,(%edi), `41,79,0',     $@)`'dnl
+Zdisp_match( adcl, 0,(%edx), %esi, `19,114,0',    $@)`'dnl
+Zdisp_match( sbbl, 0,(%edx), %esi, `27,114,0',    $@)`'dnl
+Zdisp_match( movq, 0,(%eax,%ecx,8), %mm0, `0x0f,0x6f,0x44,0xc8,0x00', $@)`'dnl
+Zdisp_match( movq, 0,(%ebx,%eax,4), %mm0, `0x0f,0x6f,0x44,0x83,0x00', $@)`'dnl
+Zdisp_match( movq, 0,(%ebx,%eax,4), %mm2, `0x0f,0x6f,0x54,0x83,0x00', $@)`'dnl
+Zdisp_match( movq, 0,(%esi),        %mm0, `15,111,70,0',     $@)`'dnl
+Zdisp_match( movq, %mm0,        0,(%edi), `15,127,71,0',     $@)`'dnl
+Zdisp_match( movq, %mm2, 0,(%ecx,%eax,4), `0x0f,0x7f,0x54,0x81,0x00', $@)`'dnl
+Zdisp_match( movq, %mm2, 0,(%edx,%eax,4), `0x0f,0x7f,0x54,0x82,0x00', $@)`'dnl
+Zdisp_match( movq, %mm0, 0,(%edx,%ecx,8), `0x0f,0x7f,0x44,0xca,0x00', $@)`'dnl
+Zdisp_match( movd, 0,(%eax,%ecx,8), %mm1, `0x0f,0x6e,0x4c,0xc8,0x00', $@)`'dnl
+Zdisp_match( movd, 0,(%edx,%ecx,8), %mm0, `0x0f,0x6e,0x44,0xca,0x00', $@)`'dnl
+Zdisp_match( movd, %mm0, 0,(%eax,%ecx,4), `0x0f,0x7e,0x44,0x88,0x00', $@)`'dnl
+Zdisp_match( movd, %mm0, 0,(%ecx,%eax,4), `0x0f,0x7e,0x44,0x81,0x00', $@)`'dnl
+Zdisp_match( movd, %mm2, 0,(%ecx,%eax,4), `0x0f,0x7e,0x54,0x81,0x00', $@)`'dnl
+ifelse(Zdisp_found,0,
+`m4_error(`unrecognised instruction in Zdisp: $1 $2 $3 $4
+')')')
+
+define(Zdisp_match,
+`ifelse(eval(m4_stringequal_p(`$1',`$6')
+	&& m4_stringequal_p(`$2',0)
+	&& m4_stringequal_p(`$3',`$8')
+	&& m4_stringequal_p(`$4',`$9')),1,
+`define(`Zdisp_found',1)dnl
+ifelse(eval(`$7'),0,
+`	.byte	$5  C `$1 0$3, $4'',
+`	$6	$7$8, $9')',
+
+`ifelse(eval(m4_stringequal_p(`$1',`$6')
+	&& m4_stringequal_p(`$2',`$7')
+	&& m4_stringequal_p(`$3',0)
+	&& m4_stringequal_p(`$4',`$9')),1,
+`define(`Zdisp_found',1)dnl
+ifelse(eval(`$8'),0,
+`	.byte	$5  C `$1 $2, 0$4'',
+`	$6	$7, $8$9')')')')
+
+
+dnl  Usage: shldl(count,src,dst)
+dnl         shrdl(count,src,dst)
+dnl         shldw(count,src,dst)
+dnl         shrdw(count,src,dst)
+dnl
+dnl  Generate a double-shift instruction, possibly omitting a %cl count
+dnl  parameter if that's what the assembler requires, as indicated by
+dnl  WANT_SHLDL_CL in config.m4.  For example,
+dnl
+dnl         shldl(  %cl, %eax, %ebx)
+dnl
+dnl  turns into either
+dnl
+dnl         shldl   %cl, %eax, %ebx
+dnl  or
+dnl         shldl   %eax, %ebx
+dnl
+dnl  Immediate counts are always passed through unchanged.  For example,
+dnl
+dnl         shrdl(  $2, %esi, %edi)
+dnl  becomes
+dnl         shrdl   $2, %esi, %edi
+dnl
+dnl
+dnl  If you forget to use the macro form "shldl( ...)" and instead write
+dnl  just a plain "shldl ...", an error results.  This ensures the necessary
+dnl  variant treatment of %cl isn't accidentally bypassed.
+
+define(define_shd_instruction,
+`define($1,
+m4_instruction_wrapper()
+m4_assert_numargs(3)
+`shd_instruction'(m4_doublequote($`'0),m4_doublequote($`'1),dnl
+m4_doublequote($`'2),m4_doublequote($`'3)))')
+
+dnl  Effectively: define(shldl,`shd_instruction(`$0',`$1',`$2',`$3')') etc
+define_shd_instruction(shldl)
+define_shd_instruction(shrdl)
+define_shd_instruction(shldw)
+define_shd_instruction(shrdw)
+
+dnl  Called: shd_instruction(op,count,src,dst)
+define(shd_instruction,
+m4_assert_numargs(4)
+m4_assert_defined(`WANT_SHLDL_CL')
+`ifelse(eval(m4_stringequal_p(`$2',`%cl') && !WANT_SHLDL_CL),1,
+``$1'	`$3', `$4'',
+``$1'	`$2', `$3', `$4'')')
+
+
+dnl  Usage: ASSERT(cond, instructions)
+dnl
+dnl  If WANT_ASSERT is 1, output the given instructions and expect the given
+dnl  flags condition to then be satisfied.  For example,
+dnl
+dnl         ASSERT(ne, `cmpl %eax, %ebx')
+dnl
+dnl  The instructions can be omitted to just assert a flags condition with
+dnl  no extra calculation.  For example,
+dnl
+dnl         ASSERT(nc)
+dnl
+dnl  When `instructions' is not empty, a pushf/popf is added to preserve the
+dnl  flags, but the instructions themselves must preserve any registers that
+dnl  matter.  FRAME is adjusted for the push and pop, so the instructions
+dnl  given can use defframe() stack variables.
+
+define(ASSERT,
+m4_assert_numargs_range(1,2)
+`ifelse(WANT_ASSERT,1,
+	`C ASSERT
+ifelse(`$2',,,`	pushf	ifdef(`FRAME',`FRAME_pushl()')')
+	$2
+	j`$1'	1f
+	ud2	C assertion failed
+1:
+ifelse(`$2',,,`	popf	ifdef(`FRAME',`FRAME_popl()')')
+')')
+
+
+dnl  Usage: movl_text_address(label,register)
+dnl
+dnl  Get the address of a text segment label, using either a plain movl or a
+dnl  position-independent calculation, as necessary.  For example,
+dnl
+dnl         movl_code_address(L(foo),%eax)
+dnl
+dnl  This macro is only meant for use in ASSERT()s or when testing, since
+dnl  the PIC sequence it generates will want to be done with a ret balancing
+dnl  the call on CPUs with return address branch predition.
+dnl
+dnl  The addl generated here has a backward reference to 1b, and so won't
+dnl  suffer from the two forwards references bug in old gas (described in
+dnl  mpn/x86/README.family).
+
+define(movl_text_address,
+`ifdef(`PIC',
+	`call	1f
+1:	popl	$2	C %eip
+	addl	`$'$1-1b, $2',
+	`movl	`$'$1, $2')')
+
+
+divert`'dnl
diff --git a/src/gmp/mpn/z8000/add_n.s b/src/gmp/mpn/z8000/add_n.s
new file mode 100644
index 000000000..3a136107f
--- /dev/null
+++ b/src/gmp/mpn/z8000/add_n.s
@@ -0,0 +1,53 @@
+! Z8000 __gmpn_add_n -- Add two limb vectors of equal, non-zero length.
+
+! Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r7
+! s1_ptr	r6
+! s2_ptr	r5
+! size		r4
+
+! If we are really crazy, we can use push to write a few result words
+! backwards, using push just because it is faster than reg+disp.  We'd
+! then add 2x the number of words written to r7...
+
+	unseg
+	.text
+	even
+	global ___gmpn_add_n
+___gmpn_add_n:
+	pop	r0,@r6
+	pop	r1,@r5
+	add	r0,r1
+	ld	@r7,r0
+	dec	r4
+	jr	eq,Lend
+Loop:	pop	r0,@r6
+	pop	r1,@r5
+	adc	r0,r1
+	inc	r7,#2
+	ld	@r7,r0
+	dec	r4
+	jr	ne,Loop
+Lend:	ld	r2,r4		! use 0 already in r4
+	adc	r2,r2
+	ret	t
diff --git a/src/gmp/mpn/z8000/gmp-mparam.h b/src/gmp/mpn/z8000/gmp-mparam.h
new file mode 100644
index 000000000..4216df673
--- /dev/null
+++ b/src/gmp/mpn/z8000/gmp-mparam.h
@@ -0,0 +1,27 @@
+/* gmp-mparam.h -- Compiler/machine parameter header file.
+
+Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#define BITS_PER_MP_LIMB 16
+#define BYTES_PER_MP_LIMB 2
+#define BITS_PER_LONGINT 32
+#define BITS_PER_INT 16
+#define BITS_PER_SHORTINT 16
+#define BITS_PER_CHAR 8
diff --git a/src/gmp/mpn/z8000/mul_1.s b/src/gmp/mpn/z8000/mul_1.s
new file mode 100644
index 000000000..20fadd340
--- /dev/null
+++ b/src/gmp/mpn/z8000/mul_1.s
@@ -0,0 +1,68 @@
+! Z8000 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
+! the result in a second limb vector.
+
+! Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r7
+! s1_ptr	r6
+! size		r5
+! s2_limb	r4
+
+	unseg
+	.text
+	even
+	global ___gmpn_mul_1
+___gmpn_mul_1:
+	sub	r2,r2		! zero carry limb
+	and	r4,r4
+	jr	mi,Lneg
+
+Lpos:	pop	r1,@r6
+	ld	r9,r1
+	mult	rr8,r4
+	and	r1,r1		! shift msb of loaded limb into cy
+	jr	mi,Lp		! branch if loaded limb's msb is set
+	add	r8,r4		! hi_limb += sign_comp2
+Lp:	add	r9,r2		! lo_limb += cy_limb
+	xor	r2,r2
+	adc	r2,r8
+	ld	@r7,r9
+	inc	r7,#2
+	dec	r5
+	jr	ne,Lpos
+	ret t
+
+Lneg:	pop	r1,@r6
+	ld	r9,r1
+	mult	rr8,r4
+	add	r8,r1		! hi_limb += sign_comp1
+	and	r1,r1
+	jr	mi,Ln
+	add	r8,r4		! hi_limb += sign_comp2
+Ln:	add	r9,r2		! lo_limb += cy_limb
+	xor	r2,r2
+	adc	r2,r8
+	ld	@r7,r9
+	inc	r7,#2
+	dec	r5
+	jr	ne,Lneg
+	ret t
diff --git a/src/gmp/mpn/z8000/sub_n.s b/src/gmp/mpn/z8000/sub_n.s
new file mode 100644
index 000000000..bd9a7ad40
--- /dev/null
+++ b/src/gmp/mpn/z8000/sub_n.s
@@ -0,0 +1,54 @@
+! Z8000 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
+! store difference in a third limb vector.
+
+! Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r7
+! s1_ptr	r6
+! s2_ptr	r5
+! size		r4
+
+! If we are really crazy, we can use push to write a few result words
+! backwards, using push just because it is faster than reg+disp.  We'd
+! then add 2x the number of words written to r7...
+
+	unseg
+	.text
+	even
+	global ___gmpn_sub_n
+___gmpn_sub_n:
+	pop	r0,@r6
+	pop	r1,@r5
+	sub	r0,r1
+	ld	@r7,r0
+	dec	r4
+	jr	eq,Lend
+Loop:	pop	r0,@r6
+	pop	r1,@r5
+	sbc	r0,r1
+	inc	r7,#2
+	ld	@r7,r0
+	dec	r4
+	jr	ne,Loop
+Lend:	ld	r2,r4		! use 0 already in r4
+	adc	r2,r2
+	ret	t
diff --git a/src/gmp/mpn/z8000x/add_n.s b/src/gmp/mpn/z8000x/add_n.s
new file mode 100644
index 000000000..7f130785c
--- /dev/null
+++ b/src/gmp/mpn/z8000x/add_n.s
@@ -0,0 +1,56 @@
+! Z8000 (32 bit limb version) __gmpn_add_n -- Add two limb vectors of equal,
+! non-zero length.
+
+! Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r7
+! s1_ptr	r6
+! s2_ptr	r5
+! size		r4
+
+! If we are really crazy, we can use push to write a few result words
+! backwards, using push just because it is faster than reg+disp.  We'd
+! then add 2x the number of words written to r7...
+
+	segm
+	.text
+	even
+	global ___gmpn_add_n
+___gmpn_add_n:
+	popl	rr0,@r6
+	popl	rr8,@r5
+	addl	rr0,rr8
+	ldl	@r7,rr0
+	dec	r4
+	jr	eq,Lend
+Loop:	popl	rr0,@r6
+	popl	rr8,@r5
+	adc	r1,r9
+	adc	r0,r8
+	inc	r7,#4
+	ldl	@r7,rr0
+	dec	r4
+	jr	ne,Loop
+Lend:	ld	r2,r4		! use 0 already in r4
+	ld	r3,r4
+	adc	r2,r2
+	ret	t
diff --git a/src/gmp/mpn/z8000x/sub_n.s b/src/gmp/mpn/z8000x/sub_n.s
new file mode 100644
index 000000000..f416d1d6e
--- /dev/null
+++ b/src/gmp/mpn/z8000x/sub_n.s
@@ -0,0 +1,56 @@
+! Z8000 (32 bit limb version) __gmpn_sub_n -- Subtract two limb vectors of the
+! same length > 0 and store difference in a third limb vector.
+
+! Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
+
+! This file is part of the GNU MP Library.
+
+! The GNU MP Library is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at your
+! option) any later version.
+
+! The GNU MP Library is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+! License for more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA.
+
+
+! INPUT PARAMETERS
+! res_ptr	r7
+! s1_ptr	r6
+! s2_ptr	r5
+! size		r4
+
+! If we are really crazy, we can use push to write a few result words
+! backwards, using push just because it is faster than reg+disp.  We'd
+! then add 2x the number of words written to r7...
+
+	segm
+	.text
+	even
+	global ___gmpn_sub_n
+___gmpn_sub_n:
+	popl	rr0,@r6
+	popl	rr8,@r5
+	subl	rr0,rr8
+	ldl	@r7,rr0
+	dec	r4
+	jr	eq,Lend
+Loop:	popl	rr0,@r6
+	popl	rr8,@r5
+	sbc	r1,r9
+	sbc	r0,r8
+	inc	r7,#4
+	ldl	@r7,rr0
+	dec	r4
+	jr	ne,Loop
+Lend:	ld	r2,r4		! use 0 already in r4
+	ld	r3,r4
+	adc	r2,r2
+	ret	t
diff --git a/src/gmp/mpq/Makefile.am b/src/gmp/mpq/Makefile.am
new file mode 100644
index 000000000..ffc238490
--- /dev/null
+++ b/src/gmp/mpq/Makefile.am
@@ -0,0 +1,33 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 1996, 1998, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+INCLUDES = -I$(top_srcdir)
+
+noinst_LTLIBRARIES = libmpq.la
+libmpq_la_SOURCES = \
+  add.c canonicalize.c clear.c cmp.c cmp_ui.c div.c get_d.c \
+  get_den.c get_num.c init.c inv.c mul.c neg.c out_str.c set.c set_den.c \
+  set_num.c set_si.c set_ui.c sub.c equal.c set_z.c set_d.c swap.c
diff --git a/src/gmp/mpq/Makefile.in b/src/gmp/mpq/Makefile.in
new file mode 100644
index 000000000..f2025b378
--- /dev/null
+++ b/src/gmp/mpq/Makefile.in
@@ -0,0 +1,414 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 1996, 1998, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+INCLUDES = -I$(top_srcdir)
+
+noinst_LTLIBRARIES = libmpq.la
+libmpq_la_SOURCES = \
+  add.c canonicalize.c clear.c cmp.c cmp_ui.c div.c get_d.c \
+  get_den.c get_num.c init.c inv.c mul.c neg.c out_str.c set.c set_den.c \
+  set_num.c set_si.c set_ui.c sub.c equal.c set_z.c set_d.c swap.c
+
+subdir = mpq
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES = 
+LTLIBRARIES =  $(noinst_LTLIBRARIES)
+
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+libmpq_la_LDFLAGS = 
+libmpq_la_LIBADD = 
+am_libmpq_la_OBJECTS =  add.lo canonicalize.lo clear.lo cmp.lo cmp_ui.lo \
+div.lo get_d.lo get_den.lo get_num.lo init.lo inv.lo mul.lo neg.lo \
+out_str.lo set.lo set_den.lo set_num.lo set_si.lo set_ui.lo sub.lo \
+equal.lo set_z.lo set_d.lo swap.lo
+libmpq_la_OBJECTS =  $(am_libmpq_la_OBJECTS)
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(libmpq_la_SOURCES)
+DIST_COMMON =  Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(libmpq_la_SOURCES)
+OBJECTS = $(am_libmpq_la_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpq/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-noinstLTLIBRARIES:
+
+clean-noinstLTLIBRARIES:
+	-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
+
+distclean-noinstLTLIBRARIES:
+
+maintainer-clean-noinstLTLIBRARIES:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+
+libmpq.la: $(libmpq_la_OBJECTS) $(libmpq_la_DEPENDENCIES)
+	$(LINK)  $(libmpq_la_LDFLAGS) $(libmpq_la_OBJECTS) $(libmpq_la_LIBADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+
+# 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.
+
+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; \
+	dot_seen=no; \
+	target=`echo $@ | sed s/-recursive//`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    dot_seen=yes; \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+	done; \
+	if test "$$dot_seen" = "no"; then \
+	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+	fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+	@set fnord $(MAKEFLAGS); amf=$$2; \
+	dot_seen=no; \
+	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
+	  rev="$$subdir $$rev"; \
+	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
+	done; \
+	test "$$dot_seen" = "no" && rev=". $$rev"; \
+	target=`echo $@ | sed s/-recursive//`; \
+	for subdir in $$rev; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_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 \
+	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+	done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+   if test "$$subdir" = .; then :; else \
+	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+   fi; \
+	done; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+	for subdir in $(SUBDIRS); do \
+	  if test "$$subdir" = .; then :; else \
+	    test -d $(distdir)/$$subdir \
+	    || mkdir $(distdir)/$$subdir \
+	    || exit 1; \
+	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \
+	      || exit 1; \
+	  fi; \
+	done
+info-am:
+info: info-recursive
+dvi-am:
+dvi: dvi-recursive
+check-am: all-am
+check: check-recursive
+installcheck-am:
+installcheck: installcheck-recursive
+install-exec-am:
+install-exec: install-exec-recursive
+
+install-data-am:
+install-data: install-data-recursive
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-recursive
+uninstall-am:
+uninstall: uninstall-recursive
+all-am: Makefile $(LTLIBRARIES)
+all-redirect: all-recursive
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs: installdirs-recursive
+installdirs-am:
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-noinstLTLIBRARIES mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-recursive
+
+clean-am:  clean-noinstLTLIBRARIES clean-compile clean-libtool \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-recursive
+
+distclean-am:  distclean-noinstLTLIBRARIES distclean-compile \
+		distclean-libtool distclean-tags distclean-generic \
+		clean-am
+	-rm -f libtool
+
+distclean: distclean-recursive
+
+maintainer-clean-am:  maintainer-clean-noinstLTLIBRARIES \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-recursive
+
+.PHONY: mostlyclean-noinstLTLIBRARIES distclean-noinstLTLIBRARIES \
+clean-noinstLTLIBRARIES maintainer-clean-noinstLTLIBRARIES \
+mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool install-recursive \
+uninstall-recursive 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-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+installdirs-am 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/src/gmp/mpq/add.c b/src/gmp/mpq/add.c
new file mode 100644
index 000000000..5b141f5cd
--- /dev/null
+++ b/src/gmp/mpq/add.c
@@ -0,0 +1,85 @@
+/* mpq_add -- add two rational numbers.
+
+Copyright (C) 1991, 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_add (mpq_ptr rop, mpq_srcptr op1, mpq_srcptr op2)
+#else
+mpq_add (rop, op1, op2)
+     mpq_ptr rop;
+     mpq_srcptr op1;
+     mpq_srcptr op2;
+#endif
+{
+  mpz_t gcd;
+  mpz_t tmp1, tmp2;
+  mp_size_t op1_num_size = ABS (op1->_mp_num._mp_size);
+  mp_size_t op1_den_size = ABS (op1->_mp_den._mp_size);
+  mp_size_t op2_num_size = ABS (op2->_mp_num._mp_size);
+  mp_size_t op2_den_size = ABS (op2->_mp_den._mp_size);
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  MPZ_TMP_INIT (gcd, MIN (op1_den_size, op2_den_size));
+  MPZ_TMP_INIT (tmp1, op1_num_size + op2_den_size);
+  MPZ_TMP_INIT (tmp2, op2_num_size + op1_den_size);
+
+  /* ROP might be identical to either operand, so don't store the
+     result there until we are finished with the input operands.  We
+     dare to overwrite the numerator of ROP when we are finished
+     with the numerators of OP1 and OP2.  */
+
+  mpz_gcd (gcd, &(op1->_mp_den), &(op2->_mp_den));
+  if (gcd->_mp_size > 1 || gcd->_mp_d[0] != 1)
+    {
+      mpz_t t;
+
+      mpz_divexact (tmp1, &(op2->_mp_den), gcd);
+      mpz_mul (tmp1, &(op1->_mp_num), tmp1);
+
+      mpz_divexact (tmp2, &(op1->_mp_den), gcd);
+      mpz_mul (tmp2, &(op2->_mp_num), tmp2);
+
+      MPZ_TMP_INIT (t, MAX (ABS (tmp1->_mp_size), ABS (tmp2->_mp_size)) + 1);
+
+      mpz_add (t, tmp1, tmp2);
+      mpz_divexact (tmp2, &(op1->_mp_den), gcd);
+      mpz_gcd (gcd, t, gcd);
+
+      mpz_divexact (&(rop->_mp_num), t, gcd);
+
+      mpz_divexact (tmp1, &(op2->_mp_den), gcd);
+      mpz_mul (&(rop->_mp_den), tmp1, tmp2);
+    }
+  else
+    {
+      /* The common divisor is 1.  This is the case (for random input) with
+	 probability 6/(pi**2).  */
+      mpz_mul (tmp1, &(op1->_mp_num), &(op2->_mp_den));
+      mpz_mul (tmp2, &(op2->_mp_num), &(op1->_mp_den));
+      mpz_add (&(rop->_mp_num), tmp1, tmp2);
+      mpz_mul (&(rop->_mp_den), &(op1->_mp_den), &(op2->_mp_den));
+    }
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpq/canonicalize.c b/src/gmp/mpq/canonicalize.c
new file mode 100644
index 000000000..933cb523b
--- /dev/null
+++ b/src/gmp/mpq/canonicalize.c
@@ -0,0 +1,53 @@
+/* mpq_canonicalize(op) -- Remove common factors of the denominator and
+   numerator in OP.
+
+Copyright (C) 1991, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_canonicalize (MP_RAT *op)
+#else
+mpq_canonicalize (op)
+     MP_RAT *op;
+#endif
+{
+  mpz_t gcd;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  /* ??? Dunno if the 1+ is needed.  */
+  MPZ_TMP_INIT (gcd, 1 + MAX (ABS (op->_mp_num._mp_size),
+			      ABS (op->_mp_den._mp_size)));
+
+  mpz_gcd (gcd, &(op->_mp_num), &(op->_mp_den));
+  mpz_divexact (&(op->_mp_num), &(op->_mp_num), gcd);
+  mpz_divexact (&(op->_mp_den), &(op->_mp_den), gcd);
+
+  if (op->_mp_den._mp_size < 0)
+    {
+      op->_mp_num._mp_size = -op->_mp_num._mp_size;
+      op->_mp_den._mp_size = -op->_mp_den._mp_size;
+    }
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpq/clear.c b/src/gmp/mpq/clear.c
new file mode 100644
index 000000000..e29bcfcc5
--- /dev/null
+++ b/src/gmp/mpq/clear.c
@@ -0,0 +1,37 @@
+/* mpq_clear -- free the space occupied by a MP_RAT.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_clear (MP_RAT *m)
+#else
+mpq_clear (m)
+     MP_RAT *m;
+#endif
+{
+  (*_mp_free_func) (m->_mp_num._mp_d,
+		    m->_mp_num._mp_alloc * BYTES_PER_MP_LIMB);
+  (*_mp_free_func) (m->_mp_den._mp_d,
+		    m->_mp_den._mp_alloc * BYTES_PER_MP_LIMB);
+}
diff --git a/src/gmp/mpq/cmp.c b/src/gmp/mpq/cmp.c
new file mode 100644
index 000000000..43daa03c2
--- /dev/null
+++ b/src/gmp/mpq/cmp.c
@@ -0,0 +1,120 @@
+/* mpq_cmp(u,v) -- Compare U, V.  Return postive, zero, or negative
+   based on if U > V, U == V, or U < V.
+
+Copyright (C) 1991, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+int
+#if __STDC__
+mpq_cmp (const MP_RAT *op1, const MP_RAT *op2)
+#else
+mpq_cmp (op1, op2)
+     const MP_RAT *op1;
+     const MP_RAT *op2;
+#endif
+{
+  mp_size_t num1_size = op1->_mp_num._mp_size;
+  mp_size_t den1_size = op1->_mp_den._mp_size;
+  mp_size_t num2_size = op2->_mp_num._mp_size;
+  mp_size_t den2_size = op2->_mp_den._mp_size;
+  mp_size_t tmp1_size, tmp2_size;
+  mp_ptr tmp1_ptr, tmp2_ptr;
+  mp_size_t num1_sign;
+  int cc;
+  TMP_DECL (marker);
+
+  if (num1_size == 0)
+    return -num2_size;
+  if (num2_size == 0)
+    return num1_size;
+  if ((num1_size ^ num2_size) < 0) /* I.e. are the signs different? */
+    return num1_size;
+
+  num1_sign = num1_size;
+  num1_size = ABS (num1_size);
+  num2_size = ABS (num2_size);
+
+  tmp1_size = num1_size + den2_size;
+  tmp2_size = num2_size + den1_size;
+
+  /* 1. Check to see if we can tell which operand is larger by just looking at
+     the number of limbs.  */
+
+  /* NUM1 x DEN2 is either TMP1_SIZE limbs or TMP1_SIZE-1 limbs.
+     Same for NUM1 x DEN1 with respect to TMP2_SIZE.  */
+  if (tmp1_size > tmp2_size + 1)
+    /* NUM1 x DEN2 is surely larger in magnitude than NUM2 x DEN1.  */
+    return num1_sign;
+  if (tmp2_size > tmp1_size + 1)
+    /* NUM1 x DEN2 is surely smaller in magnitude than NUM2 x DEN1.  */
+    return -num1_sign;
+
+  /* 2. Same, but compare the number of significant bits.  */
+  {
+    int cnt1, cnt2;
+    unsigned long int bits1, bits2;
+
+    count_leading_zeros (cnt1, op1->_mp_num._mp_d[num1_size - 1]);
+    count_leading_zeros (cnt2, op2->_mp_den._mp_d[den2_size - 1]);
+    bits1 = tmp1_size * BITS_PER_MP_LIMB - cnt1 - cnt2;
+
+    count_leading_zeros (cnt1, op2->_mp_num._mp_d[num2_size - 1]);
+    count_leading_zeros (cnt2, op1->_mp_den._mp_d[den1_size - 1]);
+    bits2 = tmp2_size * BITS_PER_MP_LIMB - cnt1 - cnt2;
+
+    if (bits1 > bits2 + 1)
+      return num1_sign;
+    if (bits2 > bits1 + 1)
+      return -num1_sign;
+  }
+
+  /* 3. Finally, cross multiply and compare.  */
+
+  TMP_MARK (marker);
+  tmp1_ptr = (mp_ptr) TMP_ALLOC (tmp1_size * BYTES_PER_MP_LIMB);
+  tmp2_ptr = (mp_ptr) TMP_ALLOC (tmp2_size * BYTES_PER_MP_LIMB);
+
+  if (num1_size >= den2_size)
+    tmp1_size -= 0 == mpn_mul (tmp1_ptr,
+			       op1->_mp_num._mp_d, num1_size,
+			       op2->_mp_den._mp_d, den2_size);
+  else
+    tmp1_size -= 0 == mpn_mul (tmp1_ptr,
+			       op2->_mp_den._mp_d, den2_size,
+			       op1->_mp_num._mp_d, num1_size);
+
+   if (num2_size >= den1_size)
+     tmp2_size -= 0 == mpn_mul (tmp2_ptr,
+				op2->_mp_num._mp_d, num2_size,
+				op1->_mp_den._mp_d, den1_size);
+   else
+     tmp2_size -= 0 == mpn_mul (tmp2_ptr,
+				op1->_mp_den._mp_d, den1_size,
+				op2->_mp_num._mp_d, num2_size);
+
+
+  cc = tmp1_size - tmp2_size != 0
+    ? tmp1_size - tmp2_size : mpn_cmp (tmp1_ptr, tmp2_ptr, tmp1_size);
+  TMP_FREE (marker);
+  return num1_sign < 0 ? -cc : cc;
+}
diff --git a/src/gmp/mpq/cmp_ui.c b/src/gmp/mpq/cmp_ui.c
new file mode 100644
index 000000000..75f54eda0
--- /dev/null
+++ b/src/gmp/mpq/cmp_ui.c
@@ -0,0 +1,81 @@
+/* mpq_cmp_ui(u,vn,vd) -- Compare U with Vn/Vd.  Return positive, zero, or
+   negative based on if U > V, U == V, or U < V.  Vn and Vd may have
+   common factors.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+_mpq_cmp_ui (const MP_RAT *op1, unsigned long int num2, unsigned long int den2)
+#else
+_mpq_cmp_ui (op1, num2, den2)
+     const MP_RAT *op1;
+     unsigned long int num2;
+     unsigned long int den2;
+#endif
+{
+  mp_size_t num1_size = op1->_mp_num._mp_size;
+  mp_size_t den1_size = op1->_mp_den._mp_size;
+  mp_size_t tmp1_size, tmp2_size;
+  mp_ptr tmp1_ptr, tmp2_ptr;
+  mp_size_t num1_sign;
+  mp_limb_t cy_limb;
+  int cc;
+  TMP_DECL (marker);
+
+  if (num1_size == 0)
+    return -(num2 != 0);
+  if (num1_size < 0)
+    return num1_size;
+  if (num2 == 0)
+    return num1_size;
+
+  num1_sign = num1_size;
+  num1_size = ABS (num1_size);
+
+  /* NUM1 x DEN2 is either TMP1_SIZE limbs or TMP1_SIZE-1 limbs.
+     Same for NUM1 x DEN1 with respect to TMP2_SIZE.  */
+  if (num1_size > den1_size + 1)
+    /* NUM1 x DEN2 is surely larger in magnitude than NUM2 x DEN1.  */
+    return num1_sign;
+  if (den1_size > num1_sign + 1)
+    /* NUM1 x DEN2 is surely smaller in magnitude than NUM2 x DEN1.  */
+    return -num1_sign;
+
+  TMP_MARK (marker);
+  tmp1_ptr = (mp_ptr) TMP_ALLOC ((num1_size + 1) * BYTES_PER_MP_LIMB);
+  tmp2_ptr = (mp_ptr) TMP_ALLOC ((den1_size + 1) * BYTES_PER_MP_LIMB);
+
+  cy_limb = mpn_mul_1 (tmp1_ptr, op1->_mp_num._mp_d, num1_size, den2);
+  tmp1_ptr[num1_size] = cy_limb;
+  tmp1_size = num1_size + (cy_limb != 0);
+
+  cy_limb = mpn_mul_1 (tmp2_ptr, op1->_mp_den._mp_d, den1_size, num2);
+  tmp2_ptr[den1_size] = cy_limb;
+  tmp2_size = den1_size + (cy_limb != 0);
+
+  cc = tmp1_size - tmp2_size != 0
+    ? tmp1_size - tmp2_size : mpn_cmp (tmp1_ptr, tmp2_ptr, tmp1_size);
+  TMP_FREE (marker);
+  return (num1_sign < 0) ? -cc : cc;
+}
diff --git a/src/gmp/mpq/div.c b/src/gmp/mpq/div.c
new file mode 100644
index 000000000..0440426f3
--- /dev/null
+++ b/src/gmp/mpq/div.c
@@ -0,0 +1,96 @@
+/* mpq_div -- divide two rational numbers.
+
+Copyright (C) 1991, 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_div (mpq_ptr quot, mpq_srcptr op1, mpq_srcptr op2)
+#else
+mpq_div (quot, op1, op2)
+     mpq_ptr quot;
+     mpq_srcptr op1;
+     mpq_srcptr op2;
+#endif
+{
+  mpz_t gcd1, gcd2;
+  mpz_t tmp1, tmp2;
+  mpz_t numtmp;
+
+  if (op2->_mp_num._mp_size == 0)
+    DIVIDE_BY_ZERO;
+
+  mpz_init (gcd1);
+  mpz_init (gcd2);
+  mpz_init (tmp1);
+  mpz_init (tmp2);
+  mpz_init (numtmp);
+
+  /* QUOT might be identical to either operand, so don't store the
+     result there until we are finished with the input operands.  We
+     dare to overwrite the numerator of QUOT when we are finished
+     with the numerators of OP1 and OP2.  */
+
+  mpz_gcd (gcd1, &(op1->_mp_num), &(op2->_mp_num));
+  mpz_gcd (gcd2, &(op2->_mp_den), &(op1->_mp_den));
+
+  if (gcd1->_mp_size > 1 || gcd1->_mp_d[0] != 1)
+    mpz_divexact (tmp1, &(op1->_mp_num), gcd1);
+  else
+    mpz_set (tmp1, &(op1->_mp_num));
+
+  if (gcd2->_mp_size > 1 || gcd2->_mp_d[0] != 1)
+    mpz_divexact (tmp2, &(op2->_mp_den), gcd2);
+  else
+    mpz_set (tmp2, &(op2->_mp_den));
+
+  mpz_mul (numtmp, tmp1, tmp2);
+
+  if (gcd1->_mp_size > 1 || gcd1->_mp_d[0] != 1)
+    mpz_divexact (tmp1, &(op2->_mp_num), gcd1);
+  else
+    mpz_set (tmp1, &(op2->_mp_num));
+
+  if (gcd2->_mp_size > 1 || gcd2->_mp_d[0] != 1)
+    mpz_divexact (tmp2, &(op1->_mp_den), gcd2);
+  else
+    mpz_set (tmp2, &(op1->_mp_den));
+
+  mpz_mul (&(quot->_mp_den), tmp1, tmp2);
+
+  /* We needed to go via NUMTMP to take care of QUOT being the same
+     as either input operands.  Now move NUMTMP to QUOT->_mp_num.  */
+  mpz_set (&(quot->_mp_num), numtmp);
+
+  /* Keep the denominator positive.  */
+  if (quot->_mp_den._mp_size < 0)
+    {
+      quot->_mp_den._mp_size = -quot->_mp_den._mp_size;
+      quot->_mp_num._mp_size = -quot->_mp_num._mp_size;
+    }
+
+  mpz_clear (numtmp);
+  mpz_clear (tmp2);
+  mpz_clear (tmp1);
+  mpz_clear (gcd2);
+  mpz_clear (gcd1);
+}
diff --git a/src/gmp/mpq/equal.c b/src/gmp/mpq/equal.c
new file mode 100644
index 000000000..c19134dfb
--- /dev/null
+++ b/src/gmp/mpq/equal.c
@@ -0,0 +1,43 @@
+/* mpq_equal(u,v) -- Compare U, V.  Return non-zero if they are equal, zero
+   if they are non-equal.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpq_equal (mpq_srcptr op1, mpq_srcptr op2)
+#else
+mpq_equal (op1, op2)
+     mpq_srcptr op1;
+     mpq_srcptr op2;
+#endif
+{
+  mp_size_t num1_size = op1->_mp_num._mp_size;
+  mp_size_t den1_size = op1->_mp_den._mp_size;
+  mp_size_t num2_size = op2->_mp_num._mp_size;
+  mp_size_t den2_size = op2->_mp_den._mp_size;
+
+  return (num1_size == num2_size && den1_size == den2_size
+	  && mpn_cmp (op1->_mp_num._mp_d, op2->_mp_num._mp_d, ABS (num1_size)) == 0
+	  && mpn_cmp (op1->_mp_den._mp_d, op2->_mp_den._mp_d, den1_size) == 0);
+}
diff --git a/src/gmp/mpq/get_d.c b/src/gmp/mpq/get_d.c
new file mode 100644
index 000000000..4497fd33f
--- /dev/null
+++ b/src/gmp/mpq/get_d.c
@@ -0,0 +1,165 @@
+/* double mpq_get_d (mpq_t src) -- Return the double approximation to SRC.
+
+Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* Algorithm:
+   1. Develop >= n bits of src.num / src.den, where n is the number of bits
+      in a double.  This (partial) division will use all bits from the
+      denominator.
+   2. Use the remainder to determine how to round the result.
+   3. Assign the integral result to a temporary double.
+   4. Scale the temporary double, and return the result.
+
+   An alternative algorithm, that would be faster:
+   0. Let n be somewhat larger than the number of significant bits in a double.
+   1. Extract the most significant n bits of the denominator, and an equal
+      number of bits from the numerator.
+   2. Interpret the extracted numbers as integers, call them a and b
+      respectively, and develop n bits of the fractions ((a + 1) / b) and
+      (a / (b + 1)) using mpn_divrem.
+   3. If the computed values are identical UP TO THE POSITION WE CARE ABOUT,
+      we are done.  If they are different, repeat the algorithm from step 1,
+      but first let n = n * 2.
+   4. If we end up using all bits from the numerator and denominator, fall
+      back to the first algorithm above.
+   5. Just to make life harder, The computation of a + 1 and b + 1 above
+      might give carry-out...  Needs special handling.  It might work to
+      subtract 1 in both cases instead.
+*/
+
+double
+#if __STDC__
+mpq_get_d (const MP_RAT *src)
+#else
+mpq_get_d (src)
+     const MP_RAT *src;
+#endif
+{
+  mp_ptr np, dp;
+  mp_ptr rp;
+  mp_size_t nsize = src->_mp_num._mp_size;
+  mp_size_t dsize = src->_mp_den._mp_size;
+  mp_size_t qsize, rsize;
+  mp_size_t sign_quotient = nsize ^ dsize;
+  unsigned normalization_steps;
+  mp_limb_t qlimb;
+#define N_QLIMBS (1 + (sizeof (double) + BYTES_PER_MP_LIMB-1) / BYTES_PER_MP_LIMB)
+  mp_limb_t qarr[N_QLIMBS + 1];
+  mp_ptr qp = qarr;
+  TMP_DECL (marker);
+
+  if (nsize == 0)
+    return 0.0;
+
+  TMP_MARK (marker);
+  nsize = ABS (nsize);
+  dsize = ABS (dsize);
+  np = src->_mp_num._mp_d;
+  dp = src->_mp_den._mp_d;
+
+  rsize = dsize + N_QLIMBS;
+  rp = (mp_ptr) TMP_ALLOC ((rsize + 1) * BYTES_PER_MP_LIMB);
+
+  count_leading_zeros (normalization_steps, dp[dsize - 1]);
+
+  /* Normalize the denominator, i.e. make its most significant bit set by
+     shifting it NORMALIZATION_STEPS bits to the left.  Also shift the
+     numerator the same number of steps (to keep the quotient the same!).  */
+  if (normalization_steps != 0)
+    {
+      mp_ptr tp;
+      mp_limb_t nlimb;
+
+      /* Shift up the denominator setting the most significant bit of
+	 the most significant limb.  Use temporary storage not to clobber
+	 the original contents of the denominator.  */
+      tp = (mp_ptr) TMP_ALLOC (dsize * BYTES_PER_MP_LIMB);
+      mpn_lshift (tp, dp, dsize, normalization_steps);
+      dp = tp;
+
+      if (rsize > nsize)
+	{
+	  MPN_ZERO (rp, rsize - nsize);
+	  nlimb = mpn_lshift (rp + (rsize - nsize),
+			      np, nsize, normalization_steps);
+	}
+      else
+	{
+	  nlimb = mpn_lshift (rp, np + (nsize - rsize),
+			      rsize, normalization_steps);
+	}
+      if (nlimb != 0)
+	{
+	  rp[rsize] = nlimb;
+	  rsize++;
+	}
+    }
+  else
+    {
+      if (rsize > nsize)
+	{
+	  MPN_ZERO (rp, rsize - nsize);
+	  MPN_COPY (rp + (rsize - nsize), np, nsize);
+	}
+      else
+	{
+	  MPN_COPY (rp, np + (nsize - rsize), rsize);
+	}
+    }
+
+  qlimb = mpn_divmod (qp, rp, rsize, dp, dsize);
+  qsize = rsize - dsize;
+  if (qlimb)
+    {
+      qp[qsize] = qlimb;
+      qsize++;
+    }
+
+  {
+    double res;
+    mp_size_t i;
+    int scale = nsize - dsize - N_QLIMBS;
+
+#if defined (__vax__)
+    /* Ignore excess quotient limbs.  This is necessary on a vax
+       with its small double exponent, since we'd otherwise get
+       exponent overflow while forming RES.  */
+    if (qsize > N_QLIMBS)
+      {
+	qp += qsize - N_QLIMBS;
+	scale += qsize - N_QLIMBS;
+	qsize = N_QLIMBS;
+      }
+#endif
+
+    res = qp[qsize - 1];
+    for (i = qsize - 2; i >= 0; i--)
+      res = res * MP_BASE_AS_DOUBLE + qp[i];
+
+    res = __gmp_scale2 (res, BITS_PER_MP_LIMB * scale);
+
+    TMP_FREE (marker);
+    return sign_quotient >= 0 ? res : -res;
+  }
+}
diff --git a/src/gmp/mpq/get_den.c b/src/gmp/mpq/get_den.c
new file mode 100644
index 000000000..7c33e6f7f
--- /dev/null
+++ b/src/gmp/mpq/get_den.c
@@ -0,0 +1,41 @@
+/* mpq_get_den(den,rat_src) -- Set DEN to the denominator of RAT_SRC.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_get_den (MP_INT *den, const MP_RAT *src)
+#else
+mpq_get_den (den, src)
+     MP_INT *den;
+     const MP_RAT *src;
+#endif
+{
+  mp_size_t size = src->_mp_den._mp_size;
+
+  if (den->_mp_alloc < size)
+    _mpz_realloc (den, size);
+
+  MPN_COPY (den->_mp_d, src->_mp_den._mp_d, size);
+  den->_mp_size = size;
+}
diff --git a/src/gmp/mpq/get_num.c b/src/gmp/mpq/get_num.c
new file mode 100644
index 000000000..3df0a4a46
--- /dev/null
+++ b/src/gmp/mpq/get_num.c
@@ -0,0 +1,42 @@
+ /* mpq_get_num(num,rat_src) -- Set NUM to the numerator of RAT_SRC.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_get_num (MP_INT *num, const MP_RAT *src)
+#else
+mpq_get_num (num, src)
+     MP_INT *num;
+     const MP_RAT *src;
+#endif
+{
+  mp_size_t size = src->_mp_num._mp_size;
+  mp_size_t abs_size = ABS (size);
+
+  if (num->_mp_alloc < abs_size)
+    _mpz_realloc (num, abs_size);
+
+  MPN_COPY (num->_mp_d, src->_mp_num._mp_d, abs_size);
+  num->_mp_size = size;
+}
diff --git a/src/gmp/mpq/init.c b/src/gmp/mpq/init.c
new file mode 100644
index 000000000..bd86bb303
--- /dev/null
+++ b/src/gmp/mpq/init.c
@@ -0,0 +1,40 @@
+/* mpq_init -- Make a new rational number with value 0/1.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_init (MP_RAT *x)
+#else
+mpq_init (x)
+     MP_RAT *x;
+#endif
+{
+  x->_mp_num._mp_alloc = 1;
+  x->_mp_num._mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
+  x->_mp_num._mp_size = 0;
+  x->_mp_den._mp_alloc = 1;
+  x->_mp_den._mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
+  x->_mp_den._mp_d[0] = 1;
+  x->_mp_den._mp_size = 1;
+}
diff --git a/src/gmp/mpq/inv.c b/src/gmp/mpq/inv.c
new file mode 100644
index 000000000..66bc33a67
--- /dev/null
+++ b/src/gmp/mpq/inv.c
@@ -0,0 +1,75 @@
+/* mpq_inv(dest,src) -- invert a rational number, i.e. set DEST to SRC
+   with the numerator and denominator swapped.
+
+Copyright (C) 1991, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_inv (MP_RAT *dest, const MP_RAT *src)
+#else
+mpq_inv (dest, src)
+     MP_RAT *dest;
+     const MP_RAT *src;
+#endif
+{
+  mp_size_t num_size = src->_mp_num._mp_size;
+  mp_size_t den_size = src->_mp_den._mp_size;
+
+  if (num_size == 0)
+    DIVIDE_BY_ZERO;
+
+  if (num_size < 0)
+    {
+      num_size = -num_size;
+      den_size = -den_size;
+    }
+  dest->_mp_den._mp_size = num_size;
+  dest->_mp_num._mp_size = den_size;
+
+  /* If dest == src we may just swap the numerator and denominator, but
+     we have to ensure the new denominator is positive.  */
+
+  if (dest == src)
+    {
+      mp_size_t alloc = dest->_mp_num._mp_alloc;
+      mp_ptr limb_ptr = dest->_mp_num._mp_d;
+
+      dest->_mp_num._mp_alloc = dest->_mp_den._mp_alloc;
+      dest->_mp_num._mp_d = dest->_mp_den._mp_d;
+
+      dest->_mp_den._mp_alloc = alloc;
+      dest->_mp_den._mp_d = limb_ptr;
+    }
+  else
+    {
+      den_size = ABS (den_size);
+      if (dest->_mp_num._mp_alloc < den_size)
+	_mpz_realloc (&(dest->_mp_num), den_size);
+
+      if (dest->_mp_den._mp_alloc < num_size)
+	_mpz_realloc (&(dest->_mp_den), num_size);
+
+      MPN_COPY (dest->_mp_num._mp_d, src->_mp_den._mp_d, den_size);
+      MPN_COPY (dest->_mp_den._mp_d, src->_mp_num._mp_d, num_size);
+    }
+}
diff --git a/src/gmp/mpq/mul.c b/src/gmp/mpq/mul.c
new file mode 100644
index 000000000..9b8abc243
--- /dev/null
+++ b/src/gmp/mpq/mul.c
@@ -0,0 +1,79 @@
+/* mpq_mul -- mutiply two rational numbers.
+
+Copyright (C) 1991, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_mul (mpq_ptr prod, mpq_srcptr op1, mpq_srcptr op2)
+#else
+mpq_mul (prod, op1, op2)
+     mpq_ptr prod;
+     mpq_srcptr op1;
+     mpq_srcptr op2;
+#endif
+{
+  mpz_t gcd1, gcd2;
+  mpz_t tmp1, tmp2;
+
+  mpz_init (gcd1);
+  mpz_init (gcd2);
+  mpz_init (tmp1);
+  mpz_init (tmp2);
+
+  /* PROD might be identical to either operand, so don't store the
+     result there until we are finished with the input operands.  We
+     dare to overwrite the numerator of PROD when we are finished
+     with the numerators of OP1 and OP2.  */
+
+  mpz_gcd (gcd1, &(op1->_mp_num), &(op2->_mp_den));
+  mpz_gcd (gcd2, &(op2->_mp_num), &(op1->_mp_den));
+
+  if (gcd1->_mp_size > 1 || gcd1->_mp_d[0] != 1)
+    mpz_divexact (tmp1, &(op1->_mp_num), gcd1);
+  else
+    mpz_set (tmp1, &(op1->_mp_num));
+
+  if (gcd2->_mp_size > 1 || gcd2->_mp_d[0] != 1)
+    mpz_divexact (tmp2, &(op2->_mp_num), gcd2);
+  else
+    mpz_set (tmp2, &(op2->_mp_num));
+
+  mpz_mul (&(prod->_mp_num), tmp1, tmp2);
+
+  if (gcd1->_mp_size > 1 || gcd1->_mp_d[0] != 1)
+    mpz_divexact (tmp1, &(op2->_mp_den), gcd1);
+  else
+    mpz_set (tmp1, &(op2->_mp_den));
+
+  if (gcd2->_mp_size > 1 || gcd2->_mp_d[0] != 1)
+    mpz_divexact (tmp2, &(op1->_mp_den), gcd2);
+  else
+    mpz_set (tmp2, &(op1->_mp_den));
+
+  mpz_mul (&(prod->_mp_den), tmp1, tmp2);
+
+  mpz_clear (tmp2);
+  mpz_clear (tmp1);
+  mpz_clear (gcd2);
+  mpz_clear (gcd1);
+}
diff --git a/src/gmp/mpq/neg.c b/src/gmp/mpq/neg.c
new file mode 100644
index 000000000..e7da1602c
--- /dev/null
+++ b/src/gmp/mpq/neg.c
@@ -0,0 +1,36 @@
+/* mpq_neg(dst, src) -- Assign the negated value of SRC to DST.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_neg (MP_RAT *dst, const MP_RAT *src)
+#else
+mpq_neg (dst, src)
+     MP_RAT *dst;
+     const MP_RAT *src;
+#endif
+{
+  mpz_neg (&dst->_mp_num, &src->_mp_num);
+  mpz_set (&dst->_mp_den, &src->_mp_den);
+}
diff --git a/src/gmp/mpq/out_str.c b/src/gmp/mpq/out_str.c
new file mode 100644
index 000000000..6898dfa07
--- /dev/null
+++ b/src/gmp/mpq/out_str.c
@@ -0,0 +1,53 @@
+/* mpq_out_str(stream,base,integer) */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+size_t
+#if __STDC__
+mpq_out_str (FILE *stream, int base, mpq_srcptr q)
+#else
+mpq_out_str (stream, base, q)
+     FILE       *stream;
+     int        base;
+     mpq_srcptr q;
+#endif
+{
+  size_t  written;
+
+  if (stream == NULL)
+    stream = stdout;
+
+  written = mpz_out_str (stream, base, mpq_numref (q));
+
+  if (mpz_cmp_ui (mpq_denref (q), 1) != 0)
+    {
+      putc ('/', stream);
+      written += 1 + mpz_out_str (stream, base, mpq_denref (q));
+    }
+
+  return ferror (stream) ? 0 : written;
+}
diff --git a/src/gmp/mpq/set.c b/src/gmp/mpq/set.c
new file mode 100644
index 000000000..bad0da2e2
--- /dev/null
+++ b/src/gmp/mpq/set.c
@@ -0,0 +1,49 @@
+/* mpq_set(dest,src) -- Set DEST to SRC.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_set (MP_RAT *dest, const MP_RAT *src)
+#else
+mpq_set (dest, src)
+     MP_RAT *dest;
+     const MP_RAT *src;
+#endif
+{
+  mp_size_t num_size, den_size;
+  mp_size_t abs_num_size;
+
+  num_size = src->_mp_num._mp_size;
+  abs_num_size = ABS (num_size);
+  if (dest->_mp_num._mp_alloc < abs_num_size)
+    _mpz_realloc (&(dest->_mp_num), abs_num_size);
+  MPN_COPY (dest->_mp_num._mp_d, src->_mp_num._mp_d, abs_num_size);
+  dest->_mp_num._mp_size = num_size;
+
+  den_size = src->_mp_den._mp_size;
+  if (dest->_mp_den._mp_alloc < den_size)
+    _mpz_realloc (&(dest->_mp_den), den_size);
+  MPN_COPY (dest->_mp_den._mp_d, src->_mp_den._mp_d, den_size);
+  dest->_mp_den._mp_size = den_size;
+}
diff --git a/src/gmp/mpq/set_d.c b/src/gmp/mpq/set_d.c
new file mode 100644
index 000000000..7ccc741ee
--- /dev/null
+++ b/src/gmp/mpq/set_d.c
@@ -0,0 +1,139 @@
+/* mpq_set_d(mpq_t q, double d) -- Set q to d without rounding.
+
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#if BITS_PER_MP_LIMB != 32 && BITS_PER_MP_LIMB != 64
+This file does not handle any the used BITS_PER_MP_LIMB.
+#endif
+
+void
+#if __STDC__
+mpq_set_d (mpq_ptr dest, double d)
+#else
+mpq_set_d (dest, d)
+     mpq_ptr dest;
+     double d;
+#endif
+{
+  int negative;
+  mp_exp_t exp;
+  mp_limb_t tp[3];
+  mp_ptr np, dp;
+  mp_size_t nn, dn;
+  int c;
+
+  negative = d < 0;
+  d = ABS (d);
+
+  exp = __gmp_extract_double (tp, d);
+
+  /* There are two main version of the conversion.  The `then' arm handles
+     things that have a fractional part, while the `else' part handles
+     only integers.  */
+#if BITS_PER_MP_LIMB == 32
+  if (exp <= 1 || (exp == 2 && tp[0] != 0))
+#else
+  if (exp <= 1)
+#endif
+    {
+      if (d == 0.0)
+	{
+	  SIZ(&(dest->_mp_num)) = 0;
+	  SIZ(&(dest->_mp_den)) = 1;
+	  PTR(&(dest->_mp_den))[0] = 1;
+	  return;
+	}
+
+      dn = -exp;
+      if (dest->_mp_num._mp_alloc < 3)
+	_mpz_realloc (&(dest->_mp_num), 3);
+      np = PTR(&(dest->_mp_num));
+#if BITS_PER_MP_LIMB == 32
+      if ((tp[0] | tp[1]) == 0)
+	np[0] = tp[2], nn = 1;
+      else if (tp[0] == 0)
+	np[1] = tp[2], np[0] = tp[1], nn = 2;
+      else
+	np[2] = tp[2], np[1] = tp[1], np[0] = tp[0], nn = 3;
+#else
+      if (tp[0] == 0)
+	np[0] = tp[1], nn = 1;
+      else
+	np[1] = tp[1], np[0] = tp[0], nn = 2;
+#endif
+      dn += nn + 1;
+      if (dest->_mp_den._mp_alloc < dn)
+	_mpz_realloc (&(dest->_mp_den), dn);
+      dp = PTR(&(dest->_mp_den));
+      MPN_ZERO (dp, dn - 1);
+      dp[dn - 1] = 1;
+      count_trailing_zeros (c, np[0] | dp[0]);
+      if (c != 0)
+	{
+	  mpn_rshift (np, np, nn, c);
+	  nn -= np[nn - 1] == 0;
+	  mpn_rshift (dp, dp, dn, c);
+	  dn -= dp[dn - 1] == 0;
+	}
+      SIZ(&(dest->_mp_den)) = dn;
+      SIZ(&(dest->_mp_num)) = negative ? -nn : nn;
+    }
+  else
+    {
+      nn = exp;
+      if (dest->_mp_num._mp_alloc < nn)
+	_mpz_realloc (&(dest->_mp_num), nn);
+      np = PTR(&(dest->_mp_num));
+#if BITS_PER_MP_LIMB == 32
+      switch (nn)
+        {
+	default:
+          MPN_ZERO (np, nn - 3);
+          np += nn - 3;
+	  /* fall through */
+	case 3:
+	  np[2] = tp[2], np[1] = tp[1], np[0] = tp[0];
+	  break;
+	case 2:
+	  np[1] = tp[2], np[0] = tp[1];
+	  break;
+	}
+#else
+      switch (nn)
+        {
+	default:
+	  MPN_ZERO (np, nn - 2);
+	  np += nn - 2;
+	  /* fall through */
+	case 2:
+	  np[1] = tp[1], np[0] = tp[0];
+	  break;
+	}
+#endif
+      dp = PTR(&(dest->_mp_den));
+      dp[0] = 1;
+      SIZ(&(dest->_mp_den)) = 1;
+      SIZ(&(dest->_mp_num)) = negative ? -nn : nn;
+    }
+}
diff --git a/src/gmp/mpq/set_den.c b/src/gmp/mpq/set_den.c
new file mode 100644
index 000000000..561f6262e
--- /dev/null
+++ b/src/gmp/mpq/set_den.c
@@ -0,0 +1,42 @@
+/* mpq_set_den(dest,den) -- Set the denominator of DEST from DEN.
+
+Copyright (C) 1991, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_set_den (MP_RAT *dest, const MP_INT *den)
+#else
+mpq_set_den (dest, den)
+     MP_RAT *dest;
+     const MP_INT *den;
+#endif
+{
+  mp_size_t size = den->_mp_size;
+  mp_size_t abs_size = ABS (size);
+
+  if (dest->_mp_den._mp_alloc < abs_size)
+    _mpz_realloc (&(dest->_mp_den), abs_size);
+
+  MPN_COPY (dest->_mp_den._mp_d, den->_mp_d, abs_size);
+  dest->_mp_den._mp_size = abs_size;
+}
diff --git a/src/gmp/mpq/set_num.c b/src/gmp/mpq/set_num.c
new file mode 100644
index 000000000..0fab0085c
--- /dev/null
+++ b/src/gmp/mpq/set_num.c
@@ -0,0 +1,42 @@
+/* mpq_set_num(dest,num) -- Set the numerator of DEST from NUM.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_set_num (MP_RAT *dest, const MP_INT *num)
+#else
+mpq_set_num (dest, num)
+     MP_RAT *dest;
+     const MP_INT *num;
+#endif
+{
+  mp_size_t size = num->_mp_size;
+  mp_size_t abs_size = ABS (size);
+
+  if (dest->_mp_num._mp_alloc < abs_size)
+    _mpz_realloc (&(dest->_mp_num), abs_size);
+
+  MPN_COPY (dest->_mp_num._mp_d, num->_mp_d, abs_size);
+  dest->_mp_num._mp_size = size;
+}
diff --git a/src/gmp/mpq/set_si.c b/src/gmp/mpq/set_si.c
new file mode 100644
index 000000000..8e5b08460
--- /dev/null
+++ b/src/gmp/mpq/set_si.c
@@ -0,0 +1,54 @@
+/* mpq_set_si(dest,ulong_num,ulong_den) -- Set DEST to the retional number
+   ULONG_NUM/ULONG_DEN.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_set_si (MP_RAT *dest, signed long int num, unsigned long int den)
+#else
+mpq_set_si (dest, num, den)
+     MP_RAT *dest;
+     signed long int num;
+     unsigned long int den;
+#endif
+{
+  unsigned long int abs_num;
+
+  abs_num = ABS (num);
+
+  if (num == 0)
+    {
+      /* Canonicalize 0/d to 0/1.  */
+      den = 1;
+      dest->_mp_num._mp_size = 0;
+    }
+  else
+    {
+      dest->_mp_num._mp_d[0] = abs_num;
+      dest->_mp_num._mp_size = num > 0 ? 1 : -1;
+    }
+
+  dest->_mp_den._mp_d[0] = den;
+  dest->_mp_den._mp_size = 1;
+}
diff --git a/src/gmp/mpq/set_ui.c b/src/gmp/mpq/set_ui.c
new file mode 100644
index 000000000..2c5f73fc2
--- /dev/null
+++ b/src/gmp/mpq/set_ui.c
@@ -0,0 +1,50 @@
+/* mpq_set_ui(dest,ulong_num,ulong_den) -- Set DEST to the retional number
+   ULONG_NUM/ULONG_DEN.
+
+Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_set_ui (MP_RAT *dest, unsigned long int num, unsigned long int den)
+#else
+mpq_set_ui (dest, num, den)
+     MP_RAT *dest;
+     unsigned long int num;
+     unsigned long int den;
+#endif
+{
+  if (num == 0)
+    {
+      /* Canonicalize 0/n to 0/1.  */
+      den = 1;
+      dest->_mp_num._mp_size = 0;
+    }
+  else
+    {
+      dest->_mp_num._mp_d[0] = num;
+      dest->_mp_num._mp_size = 1;
+    }
+
+  dest->_mp_den._mp_d[0] = den;
+  dest->_mp_den._mp_size = 1;
+}
diff --git a/src/gmp/mpq/set_z.c b/src/gmp/mpq/set_z.c
new file mode 100644
index 000000000..347c67d4b
--- /dev/null
+++ b/src/gmp/mpq/set_z.c
@@ -0,0 +1,46 @@
+/* mpq_set_z (dest,src) -- Set DEST to SRC.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_set_z (mpq_ptr dest, mpz_srcptr src)
+#else
+mpq_set_z (dest, src)
+     mpq_ptr dest;
+     mpz_srcptr src;
+#endif
+{
+  mp_size_t num_size;
+  mp_size_t abs_num_size;
+
+  num_size = src->_mp_size;
+  abs_num_size = ABS (num_size);
+  if (dest->_mp_num._mp_alloc < abs_num_size)
+    _mpz_realloc (&(dest->_mp_num), abs_num_size);
+  MPN_COPY (dest->_mp_num._mp_d, src->_mp_d, abs_num_size);
+  dest->_mp_num._mp_size = num_size;
+
+  dest->_mp_den._mp_d[0] = 1;
+  dest->_mp_den._mp_size = 1;
+}
diff --git a/src/gmp/mpq/sub.c b/src/gmp/mpq/sub.c
new file mode 100644
index 000000000..f6ef770b0
--- /dev/null
+++ b/src/gmp/mpq/sub.c
@@ -0,0 +1,85 @@
+/* mpq_sub -- subtract two rational numbers.
+
+Copyright (C) 1991, 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_sub (mpq_ptr rop, mpq_srcptr op1, mpq_srcptr op2)
+#else
+mpq_sub (rop, op1, op2)
+     mpq_ptr rop;
+     mpq_srcptr op1;
+     mpq_srcptr op2;
+#endif
+{
+  mpz_t gcd;
+  mpz_t tmp1, tmp2;
+  mp_size_t op1_num_size = ABS (op1->_mp_num._mp_size);
+  mp_size_t op1_den_size = ABS (op1->_mp_den._mp_size);
+  mp_size_t op2_num_size = ABS (op2->_mp_num._mp_size);
+  mp_size_t op2_den_size = ABS (op2->_mp_den._mp_size);
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  MPZ_TMP_INIT (gcd, MIN (op1_den_size, op2_den_size));
+  MPZ_TMP_INIT (tmp1, op1_num_size + op2_den_size);
+  MPZ_TMP_INIT (tmp2, op2_num_size + op1_den_size);
+
+  /* ROP might be identical to either operand, so don't store the
+     result there until we are finished with the input operands.  We
+     dare to overwrite the numerator of ROP when we are finished
+     with the numerators of OP1 and OP2.  */
+
+  mpz_gcd (gcd, &(op1->_mp_den), &(op2->_mp_den));
+  if (gcd->_mp_size > 1 || gcd->_mp_d[0] != 1)
+    {
+      mpz_t t;
+
+      mpz_divexact (tmp1, &(op2->_mp_den), gcd);
+      mpz_mul (tmp1, &(op1->_mp_num), tmp1);
+
+      mpz_divexact (tmp2, &(op1->_mp_den), gcd);
+      mpz_mul (tmp2, &(op2->_mp_num), tmp2);
+
+      MPZ_TMP_INIT (t, MAX (ABS (tmp1->_mp_size), ABS (tmp2->_mp_size)) + 1);
+
+      mpz_sub (t, tmp1, tmp2);
+      mpz_divexact (tmp2, &(op1->_mp_den), gcd);
+      mpz_gcd (gcd, t, gcd);
+
+      mpz_divexact (&(rop->_mp_num), t, gcd);
+
+      mpz_divexact (tmp1, &(op2->_mp_den), gcd);
+      mpz_mul (&(rop->_mp_den), tmp1, tmp2);
+    }
+  else
+    {
+      /* The common divisor is 1.  This is the case (for random input) with
+	 probability 6/(pi**2).  */
+      mpz_mul (tmp1, &(op1->_mp_num), &(op2->_mp_den));
+      mpz_mul (tmp2, &(op2->_mp_num), &(op1->_mp_den));
+      mpz_sub (&(rop->_mp_num), tmp1, tmp2);
+      mpz_mul (&(rop->_mp_den), &(op1->_mp_den), &(op2->_mp_den));
+    }
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpq/swap.c b/src/gmp/mpq/swap.c
new file mode 100644
index 000000000..431a6371a
--- /dev/null
+++ b/src/gmp/mpq/swap.c
@@ -0,0 +1,68 @@
+/* mpq_swap (U, V) -- Swap U and V.
+
+Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpq_swap (mpq_ptr u, mpq_ptr v)
+#else
+mpq_swap (u, v)
+     mpq_ptr u;
+     mpq_ptr v;
+#endif
+{
+  mp_ptr up, vp;
+  mp_size_t usize, vsize;
+  mp_size_t ualloc, valloc;
+
+  ualloc = u->_mp_num._mp_alloc;
+  valloc = v->_mp_num._mp_alloc;
+  v->_mp_num._mp_alloc = ualloc;
+  u->_mp_num._mp_alloc = valloc;
+
+  usize = u->_mp_num._mp_size;
+  vsize = v->_mp_num._mp_size;
+  v->_mp_num._mp_size = usize;
+  u->_mp_num._mp_size = vsize;
+
+  up = u->_mp_num._mp_d;
+  vp = v->_mp_num._mp_d;
+  v->_mp_num._mp_d = up;
+  u->_mp_num._mp_d = vp;
+
+
+  ualloc = u->_mp_den._mp_alloc;
+  valloc = v->_mp_den._mp_alloc;
+  v->_mp_den._mp_alloc = ualloc;
+  u->_mp_den._mp_alloc = valloc;
+
+  usize = u->_mp_den._mp_size;
+  vsize = v->_mp_den._mp_size;
+  v->_mp_den._mp_size = usize;
+  u->_mp_den._mp_size = vsize;
+
+  up = u->_mp_den._mp_d;
+  vp = v->_mp_den._mp_d;
+  v->_mp_den._mp_d = up;
+  u->_mp_den._mp_d = vp;
+}
diff --git a/src/gmp/mpq/tests/Makefile.am b/src/gmp/mpq/tests/Makefile.am
new file mode 100644
index 000000000..4e99a3ed5
--- /dev/null
+++ b/src/gmp/mpq/tests/Makefile.am
@@ -0,0 +1,29 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+check_PROGRAMS = t-cmp t-cmp_ui t-get_d
+TESTS = $(check_PROGRAMS)
diff --git a/src/gmp/mpq/tests/Makefile.in b/src/gmp/mpq/tests/Makefile.in
new file mode 100644
index 000000000..c90bd6ab2
--- /dev/null
+++ b/src/gmp/mpq/tests/Makefile.in
@@ -0,0 +1,403 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+check_PROGRAMS = t-cmp t-cmp_ui t-get_d
+TESTS = $(check_PROGRAMS)
+subdir = mpq/tests
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../../config.h
+CONFIG_CLEAN_FILES = 
+check_PROGRAMS =  t-cmp$(EXEEXT) t-cmp_ui$(EXEEXT) t-get_d$(EXEEXT)
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I../..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+t_cmp_SOURCES = t-cmp.c
+t_cmp_OBJECTS =  t-cmp.$(OBJEXT)
+t_cmp_LDADD = $(LDADD)
+t_cmp_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_cmp_LDFLAGS = 
+t_cmp_ui_SOURCES = t-cmp_ui.c
+t_cmp_ui_OBJECTS =  t-cmp_ui.$(OBJEXT)
+t_cmp_ui_LDADD = $(LDADD)
+t_cmp_ui_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_cmp_ui_LDFLAGS = 
+t_get_d_SOURCES = t-get_d.c
+t_get_d_OBJECTS =  t-get_d.$(OBJEXT)
+t_get_d_LDADD = $(LDADD)
+t_get_d_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_get_d_LDFLAGS = 
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  t-cmp.c t-cmp_ui.c t-get_d.c
+DIST_COMMON =  Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = t-cmp.c t-cmp_ui.c t-get_d.c
+OBJECTS = t-cmp.$(OBJEXT) t-cmp_ui.$(OBJEXT) t-get_d.$(OBJEXT)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpq/tests/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-checkPROGRAMS:
+
+clean-checkPROGRAMS:
+	-test -z "$(check_PROGRAMS)" || rm -f $(check_PROGRAMS)
+
+distclean-checkPROGRAMS:
+
+maintainer-clean-checkPROGRAMS:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+
+t-cmp$(EXEEXT): $(t_cmp_OBJECTS) $(t_cmp_DEPENDENCIES)
+	@rm -f t-cmp$(EXEEXT)
+	$(LINK) $(t_cmp_LDFLAGS) $(t_cmp_OBJECTS) $(t_cmp_LDADD) $(LIBS)
+
+t-cmp_ui$(EXEEXT): $(t_cmp_ui_OBJECTS) $(t_cmp_ui_DEPENDENCIES)
+	@rm -f t-cmp_ui$(EXEEXT)
+	$(LINK) $(t_cmp_ui_LDFLAGS) $(t_cmp_ui_OBJECTS) $(t_cmp_ui_LDADD) $(LIBS)
+
+t-get_d$(EXEEXT): $(t_get_d_OBJECTS) $(t_get_d_DEPENDENCIES)
+	@rm -f t-get_d$(EXEEXT)
+	$(LINK) $(t_get_d_LDFLAGS) $(t_get_d_OBJECTS) $(t_get_d_LDADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+check-TESTS: $(TESTS)
+	@failed=0; all=0; xfail=0; xpass=0; \
+	srcdir=$(srcdir); export srcdir; \
+	for tst in $(TESTS); do \
+	  if test -f ./$$tst; then dir=./; \
+	  elif test -f $$tst; then dir=; \
+	  else dir="$(srcdir)/"; fi; \
+	  if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xpass=`expr $$xpass + 1`; \
+	      failed=`expr $$failed + 1`; \
+	      echo "XPASS: $$tst"; \
+	    ;; \
+	    *) \
+	      echo "PASS: $$tst"; \
+	    ;; \
+	    esac; \
+	  elif test $$? -ne 77; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xfail=`expr $$xfail + 1`; \
+	      echo "XFAIL: $$tst"; \
+	    ;; \
+	    *) \
+	      failed=`expr $$failed + 1`; \
+	      echo "FAIL: $$tst"; \
+	    ;; \
+	    esac; \
+	  fi; \
+	done; \
+	if test "$$failed" -eq 0; then \
+	  if test "$$xfail" -eq 0; then \
+	    banner="All $$all tests passed"; \
+	  else \
+	    banner="All $$all tests behaved as expected ($$xfail expected failures)"; \
+	  fi; \
+	else \
+	  if test "$$xpass" -eq 0; then \
+	    banner="$$failed of $$all tests failed"; \
+	  else \
+	    banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \
+	  fi; \
+	fi; \
+	dashes=`echo "$$banner" | sed s/./=/g`; \
+	echo "$$dashes"; \
+	echo "$$banner"; \
+	echo "$$dashes"; \
+	test "$$failed" -eq 0
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am: all-am
+	$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
+	$(MAKE) $(AM_MAKEFLAGS) check-TESTS
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am:
+install-data: install-data-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am:
+uninstall: uninstall-am
+all-am: Makefile
+all-redirect: all-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs:
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-checkPROGRAMS mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am:  clean-checkPROGRAMS clean-compile clean-libtool clean-tags \
+		clean-generic mostlyclean-am
+
+clean: clean-am
+
+distclean-am:  distclean-checkPROGRAMS distclean-compile \
+		distclean-libtool distclean-tags distclean-generic \
+		clean-am
+	-rm -f libtool
+
+distclean: distclean-am
+
+maintainer-clean-am:  maintainer-clean-checkPROGRAMS \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-checkPROGRAMS distclean-checkPROGRAMS \
+clean-checkPROGRAMS maintainer-clean-checkPROGRAMS mostlyclean-compile \
+distclean-compile clean-compile maintainer-clean-compile \
+mostlyclean-libtool distclean-libtool clean-libtool \
+maintainer-clean-libtool tags mostlyclean-tags distclean-tags \
+clean-tags maintainer-clean-tags distdir check-TESTS info-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+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/src/gmp/mpq/tests/t-cmp.c b/src/gmp/mpq/tests/t-cmp.c
new file mode 100644
index 000000000..3ecbf56a0
--- /dev/null
+++ b/src/gmp/mpq/tests/t-cmp.c
@@ -0,0 +1,109 @@
+/* Test mpq_cmp.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#define NUM(x) (&((x)->_mp_num))
+#define DEN(x) (&((x)->_mp_den))
+
+#define SGN(x) ((x) < 0 ? -1 : (x) > 0 ? 1 : 0)
+
+ref_mpq_cmp (a, b)
+     mpq_t a, b;
+{
+  mpz_t ai, bi;
+  int cc;
+
+  mpz_init (ai);
+  mpz_init (bi);
+
+  mpz_mul (ai, NUM (a), DEN (b));
+  mpz_mul (bi, NUM (b), DEN (a));
+  cc = mpz_cmp (ai, bi);
+  mpz_clear (ai);
+  mpz_clear (bi);
+  return cc;
+}
+
+#ifndef SIZE
+#define SIZE 8	/* increasing this lowers the probabilty of finding an error */
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpq_t a, b;
+  mp_size_t size;
+  int reps = 100000;
+  int i;
+  int cc, ccref;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpq_init (a);
+  mpq_init (b);
+
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (NUM (a), size);
+      do
+	{
+	  size = urandom () % SIZE - SIZE/2;
+	  mpz_random2 (DEN (a), size);
+	}
+      while (mpz_cmp_ui (DEN (a), 0) == 0);
+
+      size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (NUM (b), size);
+      do
+	{
+	  size = urandom () % SIZE - SIZE/2;
+	  mpz_random2 (DEN (b), size);
+	}
+      while (mpz_cmp_ui (DEN (b), 0) == 0);
+
+      mpq_canonicalize (a);
+      mpq_canonicalize (b);
+
+      ccref = ref_mpq_cmp (a, b);
+      cc = mpq_cmp (a, b);
+
+      if (SGN (ccref) != SGN (cc))
+	abort ();
+    }
+
+  exit (0);
+}
+
+dump (x)
+     mpq_t x;
+{
+  mpz_out_str (stdout, 10, NUM (x));
+  printf ("/");
+  mpz_out_str (stdout, 10, DEN (x));
+  printf ("\n");
+}
diff --git a/src/gmp/mpq/tests/t-cmp_ui.c b/src/gmp/mpq/tests/t-cmp_ui.c
new file mode 100644
index 000000000..4f26790ba
--- /dev/null
+++ b/src/gmp/mpq/tests/t-cmp_ui.c
@@ -0,0 +1,103 @@
+/* Test mpq_cmp_ui.
+
+Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#define NUM(x) (&((x)->_mp_num))
+#define DEN(x) (&((x)->_mp_den))
+
+#define SGN(x) ((x) < 0 ? -1 : (x) > 0 ? 1 : 0)
+
+ref_mpq_cmp_ui (a, bn, bd)
+     mpq_t a;
+     unsigned long int bn, bd;
+{
+  mpz_t ai, bi;
+  int cc;
+
+  mpz_init (ai);
+  mpz_init (bi);
+
+  mpz_mul_ui (ai, NUM (a), bd);
+  mpz_mul_ui (bi, DEN (a), bn);
+  cc = mpz_cmp (ai, bi);
+  mpz_clear (ai);
+  mpz_clear (bi);
+  return cc;
+}
+
+#ifndef SIZE
+#define SIZE 8	/* increasing this lowers the probabilty of finding an error */
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpq_t a, b;
+  mp_size_t size;
+  int reps = 100000;
+  int i;
+  int cc, ccref;
+  unsigned long int bn, bd;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpq_init (a);
+  mpq_init (b);
+
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (NUM (a), size);
+      do
+	{
+	  size = urandom () % SIZE - SIZE/2;
+	  mpz_random2 (DEN (a), size);
+	}
+      while (mpz_cmp_ui (DEN (a), 0) == 0);
+
+      mpz_random2 (NUM (b), 1);
+      mpz_mod_ui (NUM (b), NUM (b), ~(unsigned long int) 0);
+      mpz_add_ui (NUM (b), NUM (b), 1);
+
+      mpz_random2 (DEN (b), 1);
+      mpz_mod_ui (DEN (b), DEN (b), ~(unsigned long int) 0);
+      mpz_add_ui (DEN (b), DEN (b), 1);
+
+      mpq_canonicalize (a);
+      mpq_canonicalize (b);
+
+      bn = mpz_get_ui (NUM (b));
+      bd = mpz_get_ui (DEN (b));
+
+      ccref = ref_mpq_cmp_ui (a, bn, bd);
+      cc = mpq_cmp_ui (a, bn, bd);
+
+      if (SGN (ccref) != SGN (cc))
+	abort ();
+    }
+
+  exit (0);
+}
diff --git a/src/gmp/mpq/tests/t-get_d.c b/src/gmp/mpq/tests/t-get_d.c
new file mode 100644
index 000000000..97f4000ce
--- /dev/null
+++ b/src/gmp/mpq/tests/t-get_d.c
@@ -0,0 +1,132 @@
+/* Test mpq_get_d and mpq_set_d
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 8
+#endif
+
+#if defined (__vax__) && SIZE > 4
+#undef SIZE
+#define SIZE 4
+#endif
+
+void
+MPQ_CHECK_FORMAT (q)
+     mpq_t q;
+{
+  mp_size_t n;
+
+  n = ABSIZ (mpq_numref (q));
+  if (n != 0)
+    ASSERT_ALWAYS (PTR(mpq_numref(q))[n - 1] != 0);
+
+  n = ABSIZ (mpq_denref (q));
+  if (n != 0)
+    ASSERT_ALWAYS (PTR(mpq_denref(q))[n - 1] != 0);
+}
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpq_t a;
+  mp_size_t size;
+  int reps = 1000;
+  int i, j;
+  double last_d, new_d;
+  mpq_t qlast_d, qnew_d;
+  mpq_t eps;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  /* The idea here is to test the monotonousness of mpq_get_d by adding
+     numbers to the numerator and denominator.  */
+
+  mpq_init (a);
+  mpq_init (eps);
+  mpq_init (qlast_d);
+  mpq_init (qnew_d);
+
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (mpq_numref (a), size);
+      do
+	{
+	  size = urandom () % SIZE - SIZE/2;
+	  mpz_random2 (mpq_denref (a), size);
+	}
+      while (mpz_cmp_ui (mpq_denref (a), 0) == 0);
+
+      mpq_canonicalize (a);
+
+      last_d = mpq_get_d (a);
+      mpq_set_d (qlast_d, last_d);
+      for (j = 0; j < 10; j++)
+	{
+	  size = urandom () % SIZE + 1;
+	  mpz_random2 (mpq_numref (eps), size);
+	  size = urandom () % SIZE + 1;
+	  mpz_random2 (mpq_denref (eps), size);
+	  mpq_canonicalize (eps);
+
+	  mpq_add (a, a, eps);
+	  mpq_canonicalize (a);
+	  new_d = mpq_get_d (a);
+	  if (last_d > new_d)
+	    {
+	      fprintf (stderr, "ERROR (test %d/%d): bad mpq_get_d results\n", i, j);
+	      printf ("\nlast: %f\n      ", last_d);
+	      printf (" new: %f\n      ", new_d); dump (a);
+	      abort ();
+	    }
+	  mpq_set_d (qnew_d, new_d);
+	  MPQ_CHECK_FORMAT (qnew_d);
+	  if (mpq_cmp (qlast_d, qnew_d) > 0)
+	    {
+	      fprintf (stderr,
+		       "ERROR (test %d/%d): bad mpq_set_d results\n", i, j);
+	      printf ("\nlast: %f\n      ", last_d); dump (qlast_d);
+	      printf (" new: %f\n      ", new_d); dump (qnew_d);
+	      abort ();
+	    }
+	  last_d = new_d;
+	  mpq_set (qlast_d, qnew_d);
+	}
+    }
+
+  exit (0);
+}
+
+dump (x)
+     mpq_t x;
+{
+  mpz_out_str (stdout, 10, mpq_numref (x));
+  printf ("/");
+  mpz_out_str (stdout, 10, mpq_denref (x));
+  printf ("\n");
+}
diff --git a/src/gmp/mpz/Makefile.am b/src/gmp/mpz/Makefile.am
new file mode 100644
index 000000000..cd6fec4e2
--- /dev/null
+++ b/src/gmp/mpz/Makefile.am
@@ -0,0 +1,58 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+INCLUDES = -I$(top_srcdir) -DOPERATION_$*
+
+noinst_LTLIBRARIES = libmpz.la
+libmpz_la_SOURCES = \
+  abs.c add.c add_ui.c addmul_ui.c and.c array_init.c \
+  bin_ui.c bin_uiui.c cdiv_q.c \
+  cdiv_q_ui.c cdiv_qr.c cdiv_qr_ui.c cdiv_r.c cdiv_r_ui.c cdiv_ui.c \
+  clear.c clrbit.c cmp.c cmp_si.c cmp_ui.c cmpabs.c cmpabs_ui.c com.c \
+  divexact.c dump.c fac_ui.c fdiv_q.c fdiv_q_2exp.c fdiv_q_ui.c \
+  fdiv_qr.c fdiv_qr_ui.c fdiv_r.c fdiv_r_2exp.c fdiv_r_ui.c fdiv_ui.c \
+  fib_ui.c fits_sint_p.c fits_slong_p.c fits_sshort_p.c fits_uint_p.c \
+  fits_ulong_p.c fits_ushort_p.c gcd.c gcd_ui.c gcdext.c get_d.c get_si.c \
+  get_str.c get_ui.c getlimbn.c hamdist.c init.c inp_raw.c inp_str.c \
+  invert.c ior.c iset.c iset_d.c iset_si.c iset_str.c iset_ui.c \
+  jacobi.c kronsz.c kronuz.c kronzs.c kronzu.c \
+  lcm.c legendre.c mod.c mul.c mul_2exp.c neg.c nextprime.c \
+  out_raw.c out_str.c perfpow.c perfsqr.c popcount.c pow_ui.c powm.c \
+  powm_ui.c pprime_p.c random.c random2.c realloc.c remove.c root.c rrandomb.c \
+  scan0.c scan1.c set.c set_d.c set_f.c set_q.c set_si.c set_str.c \
+  set_ui.c setbit.c size.c sizeinbase.c sqrt.c sqrtrem.c sub.c \
+  sub_ui.c swap.c tdiv_ui.c tdiv_q.c tdiv_q_2exp.c tdiv_q_ui.c tdiv_qr.c \
+  tdiv_qr_ui.c tdiv_r.c tdiv_r_2exp.c tdiv_r_ui.c tstbit.c ui_pow_ui.c \
+  urandomb.c urandomm.c xor.c
+
+EXTRA_DIST = mul_siui.c
+nodist_libmpz_la_SOURCES = mul_si.c mul_ui.c
+CLEANFILES = $(nodist_libmpz_la_SOURCES)
+
+mul_si.c: $(srcdir)/mul_siui.c
+	cp $(srcdir)/mul_siui.c mul_si.c
+mul_ui.c: $(srcdir)/mul_siui.c
+	cp $(srcdir)/mul_siui.c mul_ui.c
diff --git a/src/gmp/mpz/Makefile.in b/src/gmp/mpz/Makefile.in
new file mode 100644
index 000000000..fec01c971
--- /dev/null
+++ b/src/gmp/mpz/Makefile.in
@@ -0,0 +1,457 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = tests
+
+INCLUDES = -I$(top_srcdir) -DOPERATION_$*
+
+noinst_LTLIBRARIES = libmpz.la
+libmpz_la_SOURCES = \
+  abs.c add.c add_ui.c addmul_ui.c and.c array_init.c \
+  bin_ui.c bin_uiui.c cdiv_q.c \
+  cdiv_q_ui.c cdiv_qr.c cdiv_qr_ui.c cdiv_r.c cdiv_r_ui.c cdiv_ui.c \
+  clear.c clrbit.c cmp.c cmp_si.c cmp_ui.c cmpabs.c cmpabs_ui.c com.c \
+  divexact.c dump.c fac_ui.c fdiv_q.c fdiv_q_2exp.c fdiv_q_ui.c \
+  fdiv_qr.c fdiv_qr_ui.c fdiv_r.c fdiv_r_2exp.c fdiv_r_ui.c fdiv_ui.c \
+  fib_ui.c fits_sint_p.c fits_slong_p.c fits_sshort_p.c fits_uint_p.c \
+  fits_ulong_p.c fits_ushort_p.c gcd.c gcd_ui.c gcdext.c get_d.c get_si.c \
+  get_str.c get_ui.c getlimbn.c hamdist.c init.c inp_raw.c inp_str.c \
+  invert.c ior.c iset.c iset_d.c iset_si.c iset_str.c iset_ui.c \
+  jacobi.c kronsz.c kronuz.c kronzs.c kronzu.c \
+  lcm.c legendre.c mod.c mul.c mul_2exp.c neg.c nextprime.c \
+  out_raw.c out_str.c perfpow.c perfsqr.c popcount.c pow_ui.c powm.c \
+  powm_ui.c pprime_p.c random.c random2.c realloc.c remove.c root.c rrandomb.c \
+  scan0.c scan1.c set.c set_d.c set_f.c set_q.c set_si.c set_str.c \
+  set_ui.c setbit.c size.c sizeinbase.c sqrt.c sqrtrem.c sub.c \
+  sub_ui.c swap.c tdiv_ui.c tdiv_q.c tdiv_q_2exp.c tdiv_q_ui.c tdiv_qr.c \
+  tdiv_qr_ui.c tdiv_r.c tdiv_r_2exp.c tdiv_r_ui.c tstbit.c ui_pow_ui.c \
+  urandomb.c urandomm.c xor.c
+
+
+EXTRA_DIST = mul_siui.c
+nodist_libmpz_la_SOURCES = mul_si.c mul_ui.c
+CLEANFILES = $(nodist_libmpz_la_SOURCES)
+subdir = mpz
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES = 
+LTLIBRARIES =  $(noinst_LTLIBRARIES)
+
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+libmpz_la_LDFLAGS = 
+libmpz_la_LIBADD = 
+am_libmpz_la_OBJECTS =  abs.lo add.lo add_ui.lo addmul_ui.lo and.lo \
+array_init.lo bin_ui.lo bin_uiui.lo cdiv_q.lo cdiv_q_ui.lo cdiv_qr.lo \
+cdiv_qr_ui.lo cdiv_r.lo cdiv_r_ui.lo cdiv_ui.lo clear.lo clrbit.lo \
+cmp.lo cmp_si.lo cmp_ui.lo cmpabs.lo cmpabs_ui.lo com.lo divexact.lo \
+dump.lo fac_ui.lo fdiv_q.lo fdiv_q_2exp.lo fdiv_q_ui.lo fdiv_qr.lo \
+fdiv_qr_ui.lo fdiv_r.lo fdiv_r_2exp.lo fdiv_r_ui.lo fdiv_ui.lo \
+fib_ui.lo fits_sint_p.lo fits_slong_p.lo fits_sshort_p.lo \
+fits_uint_p.lo fits_ulong_p.lo fits_ushort_p.lo gcd.lo gcd_ui.lo \
+gcdext.lo get_d.lo get_si.lo get_str.lo get_ui.lo getlimbn.lo \
+hamdist.lo init.lo inp_raw.lo inp_str.lo invert.lo ior.lo iset.lo \
+iset_d.lo iset_si.lo iset_str.lo iset_ui.lo jacobi.lo kronsz.lo \
+kronuz.lo kronzs.lo kronzu.lo lcm.lo legendre.lo mod.lo mul.lo \
+mul_2exp.lo neg.lo nextprime.lo out_raw.lo out_str.lo perfpow.lo \
+perfsqr.lo popcount.lo pow_ui.lo powm.lo powm_ui.lo pprime_p.lo \
+random.lo random2.lo realloc.lo remove.lo root.lo rrandomb.lo scan0.lo \
+scan1.lo set.lo set_d.lo set_f.lo set_q.lo set_si.lo set_str.lo \
+set_ui.lo setbit.lo size.lo sizeinbase.lo sqrt.lo sqrtrem.lo sub.lo \
+sub_ui.lo swap.lo tdiv_ui.lo tdiv_q.lo tdiv_q_2exp.lo tdiv_q_ui.lo \
+tdiv_qr.lo tdiv_qr_ui.lo tdiv_r.lo tdiv_r_2exp.lo tdiv_r_ui.lo \
+tstbit.lo ui_pow_ui.lo urandomb.lo urandomm.lo xor.lo
+nodist_libmpz_la_OBJECTS =  mul_si.lo mul_ui.lo
+libmpz_la_OBJECTS =  $(am_libmpz_la_OBJECTS) $(nodist_libmpz_la_OBJECTS)
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(libmpz_la_SOURCES)
+DIST_COMMON =  README Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(libmpz_la_SOURCES) $(nodist_libmpz_la_SOURCES)
+OBJECTS = $(am_libmpz_la_OBJECTS) $(nodist_libmpz_la_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpz/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-noinstLTLIBRARIES:
+
+clean-noinstLTLIBRARIES:
+	-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
+
+distclean-noinstLTLIBRARIES:
+
+maintainer-clean-noinstLTLIBRARIES:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+
+libmpz.la: $(libmpz_la_OBJECTS) $(libmpz_la_DEPENDENCIES)
+	$(LINK)  $(libmpz_la_LDFLAGS) $(libmpz_la_OBJECTS) $(libmpz_la_LIBADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+
+# 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.
+
+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; \
+	dot_seen=no; \
+	target=`echo $@ | sed s/-recursive//`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    dot_seen=yes; \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+	done; \
+	if test "$$dot_seen" = "no"; then \
+	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+	fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+	@set fnord $(MAKEFLAGS); amf=$$2; \
+	dot_seen=no; \
+	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
+	  rev="$$subdir $$rev"; \
+	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
+	done; \
+	test "$$dot_seen" = "no" && rev=". $$rev"; \
+	target=`echo $@ | sed s/-recursive//`; \
+	for subdir in $$rev; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_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 \
+	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+	done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+   if test "$$subdir" = .; then :; else \
+	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+   fi; \
+	done; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+	for subdir in $(SUBDIRS); do \
+	  if test "$$subdir" = .; then :; else \
+	    test -d $(distdir)/$$subdir \
+	    || mkdir $(distdir)/$$subdir \
+	    || exit 1; \
+	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \
+	      || exit 1; \
+	  fi; \
+	done
+info-am:
+info: info-recursive
+dvi-am:
+dvi: dvi-recursive
+check-am: all-am
+check: check-recursive
+installcheck-am:
+installcheck: installcheck-recursive
+install-exec-am:
+install-exec: install-exec-recursive
+
+install-data-am:
+install-data: install-data-recursive
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-recursive
+uninstall-am:
+uninstall: uninstall-recursive
+all-am: Makefile $(LTLIBRARIES)
+all-redirect: all-recursive
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs: installdirs-recursive
+installdirs-am:
+
+
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-noinstLTLIBRARIES mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-recursive
+
+clean-am:  clean-noinstLTLIBRARIES clean-compile clean-libtool \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-recursive
+
+distclean-am:  distclean-noinstLTLIBRARIES distclean-compile \
+		distclean-libtool distclean-tags distclean-generic \
+		clean-am
+	-rm -f libtool
+
+distclean: distclean-recursive
+
+maintainer-clean-am:  maintainer-clean-noinstLTLIBRARIES \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-recursive
+
+.PHONY: mostlyclean-noinstLTLIBRARIES distclean-noinstLTLIBRARIES \
+clean-noinstLTLIBRARIES maintainer-clean-noinstLTLIBRARIES \
+mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool install-recursive \
+uninstall-recursive 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-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+installdirs-am installdirs mostlyclean-generic distclean-generic \
+clean-generic maintainer-clean-generic clean mostlyclean distclean \
+maintainer-clean
+
+
+mul_si.c: $(srcdir)/mul_siui.c
+	cp $(srcdir)/mul_siui.c mul_si.c
+mul_ui.c: $(srcdir)/mul_siui.c
+	cp $(srcdir)/mul_siui.c mul_ui.c
+
+# 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/src/gmp/mpz/README b/src/gmp/mpz/README
new file mode 100644
index 000000000..06b481d77
--- /dev/null
+++ b/src/gmp/mpz/README
@@ -0,0 +1,23 @@
+This directory contains functions for GMP's integer function layer.
+
+In this version of GMP, integers are represented like in the figure below.
+(Please note that the format might change between every version, and that
+depending on the internal format in any way is a bad idea.)
+
+   most				least
+significant		     significant
+   limb				limb
+
+				 _mp_d
+				  /
+				 /
+				\/
+	 ____ ____ ____ ____ ____
+	|____|____|____|____|____|
+
+	<------- _mp_size ------->
+
+
+The most significant limb will be non-zero.  The _mp_size field's sign
+reflects the sign of the number.  Its absolute value is the count of limbs
+in the number.
diff --git a/src/gmp/mpz/abs.c b/src/gmp/mpz/abs.c
new file mode 100644
index 000000000..0b5eab1ce
--- /dev/null
+++ b/src/gmp/mpz/abs.c
@@ -0,0 +1,51 @@
+/* mpz_abs(dst, src) -- Assign the absolute value of SRC to DST.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_abs (mpz_ptr w, mpz_srcptr u)
+#else
+mpz_abs (w, u)
+     mpz_ptr w;
+     mpz_srcptr u;
+#endif
+{
+  mp_ptr wp, up;
+  mp_size_t size;
+
+  size = ABS (u->_mp_size);
+
+  if (u != w)
+    {
+      if (w->_mp_alloc < size)
+	_mpz_realloc (w, size);
+
+      wp = w->_mp_d;
+      up = u->_mp_d;
+
+      MPN_COPY (wp, up, size);
+    }
+
+  w->_mp_size = size;
+}
diff --git a/src/gmp/mpz/add.c b/src/gmp/mpz/add.c
new file mode 100644
index 000000000..a22c3778f
--- /dev/null
+++ b/src/gmp/mpz/add.c
@@ -0,0 +1,123 @@
+/* mpz_add -- Add two integers.
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#ifdef BERKELEY_MP
+#include "mp.h"
+#endif
+
+#ifndef BERKELEY_MP
+void
+#if __STDC__
+mpz_add (mpz_ptr w, mpz_srcptr u, mpz_srcptr v)
+#else
+mpz_add (w, u, v)
+     mpz_ptr w;
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+#else /* BERKELEY_MP */
+void
+#if __STDC__
+madd (mpz_srcptr u, mpz_srcptr v, mpz_ptr w)
+#else
+madd (u, v, w)
+     mpz_srcptr u;
+     mpz_srcptr v;
+     mpz_ptr w;
+#endif
+#endif /* BERKELEY_MP */
+{
+  mp_srcptr up, vp;
+  mp_ptr wp;
+  mp_size_t usize, vsize, wsize;
+  mp_size_t abs_usize;
+  mp_size_t abs_vsize;
+
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+  abs_usize = ABS (usize);
+  abs_vsize = ABS (vsize);
+
+  if (abs_usize < abs_vsize)
+    {
+      /* Swap U and V. */
+      MPZ_SRCPTR_SWAP (u, v);
+      MP_SIZE_T_SWAP (usize, vsize);
+      MP_SIZE_T_SWAP (abs_usize, abs_vsize);
+    }
+
+  /* True: ABS_USIZE >= ABS_VSIZE.  */
+
+  /* If not space for w (and possible carry), increase space.  */
+  wsize = abs_usize + 1;
+  if (w->_mp_alloc < wsize)
+    _mpz_realloc (w, wsize);
+
+  /* These must be after realloc (u or v may be the same as w).  */
+  up = u->_mp_d;
+  vp = v->_mp_d;
+  wp = w->_mp_d;
+
+  if ((usize ^ vsize) < 0)
+    {
+      /* U and V have different sign.  Need to compare them to determine
+	 which operand to subtract from which.  */
+
+      /* This test is right since ABS_USIZE >= ABS_VSIZE.  */
+      if (abs_usize != abs_vsize)
+	{
+	  mpn_sub (wp, up, abs_usize, vp, abs_vsize);
+	  wsize = abs_usize;
+	  MPN_NORMALIZE (wp, wsize);
+	  if (usize < 0)
+	    wsize = -wsize;
+	}
+      else if (mpn_cmp (up, vp, abs_usize) < 0)
+	{
+	  mpn_sub_n (wp, vp, up, abs_usize);
+	  wsize = abs_usize;
+	  MPN_NORMALIZE (wp, wsize);
+	  if (usize >= 0)
+	    wsize = -wsize;
+	}
+      else
+	{
+	  mpn_sub_n (wp, up, vp, abs_usize);
+	  wsize = abs_usize;
+	  MPN_NORMALIZE (wp, wsize);
+	  if (usize < 0)
+	    wsize = -wsize;
+	}
+    }
+  else
+    {
+      /* U and V have same sign.  Add them.  */
+      mp_limb_t cy_limb = mpn_add (wp, up, abs_usize, vp, abs_vsize);
+      wp[abs_usize] = cy_limb;
+      wsize = abs_usize + cy_limb;
+      if (usize < 0)
+	wsize = -wsize;
+    }
+
+  w->_mp_size = wsize;
+}
diff --git a/src/gmp/mpz/add_ui.c b/src/gmp/mpz/add_ui.c
new file mode 100644
index 000000000..28dbd71f4
--- /dev/null
+++ b/src/gmp/mpz/add_ui.c
@@ -0,0 +1,84 @@
+/* mpz_add_ui -- Add an mpz_t and an unsigned one-word integer.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_add_ui (mpz_ptr w, mpz_srcptr u, unsigned long int v)
+#else
+mpz_add_ui (w, u, v)
+     mpz_ptr w;
+     mpz_srcptr u;
+     unsigned long int v;
+#endif
+{
+  mp_srcptr up;
+  mp_ptr wp;
+  mp_size_t usize, wsize;
+  mp_size_t abs_usize;
+
+  usize = u->_mp_size;
+  abs_usize = ABS (usize);
+
+  /* If not space for W (and possible carry), increase space.  */
+  wsize = abs_usize + 1;
+  if (w->_mp_alloc < wsize)
+    _mpz_realloc (w, wsize);
+
+  /* These must be after realloc (U may be the same as W).  */
+  up = u->_mp_d;
+  wp = w->_mp_d;
+
+  if (abs_usize == 0)
+    {
+      wp[0] = v;
+      w->_mp_size = v != 0;
+      return;
+    }
+
+  if (usize >= 0)
+    {
+      mp_limb_t cy;
+      cy = mpn_add_1 (wp, up, abs_usize, (mp_limb_t) v);
+      wp[abs_usize] = cy;
+      wsize = abs_usize + cy;
+    }
+  else
+    {
+      /* The signs are different.  Need exact comparison to determine
+	 which operand to subtract from which.  */
+      if (abs_usize == 1 && up[0] < v)
+	{
+	  wp[0] = v - up[0];
+	  wsize = 1;
+	}
+      else
+	{
+	  mpn_sub_1 (wp, up, abs_usize, (mp_limb_t) v);
+	  /* Size can decrease with at most one limb.  */
+	  wsize = -(abs_usize - (wp[abs_usize - 1] == 0));
+	}
+    }
+
+  w->_mp_size = wsize;
+}
diff --git a/src/gmp/mpz/addmul_ui.c b/src/gmp/mpz/addmul_ui.c
new file mode 100644
index 000000000..7b38d3624
--- /dev/null
+++ b/src/gmp/mpz/addmul_ui.c
@@ -0,0 +1,214 @@
+/* mpz_addmul_ui(prodsum, multiplier, small_multiplicand) --
+   Add MULTIPLICATOR times SMALL_MULTIPLICAND to PRODSUM.
+
+Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+static mp_limb_t mpn_neg1 _PROTO ((mp_ptr, mp_size_t));
+
+#if 0
+#undef  MPN_NORMALIZE
+#define MPN_NORMALIZE(DST, NLIMBS) \
+  do {									\
+    while (--(NLIMBS) >= 0 && (DST)[NLIMBS] == 0)			\
+      ;									\
+    (NLIMBS)++;								\
+  } while (0)
+#undef  MPN_NORMALIZE_NOT_ZERO
+#define MPN_NORMALIZE_NOT_ZERO(DST, NLIMBS) \
+  do {									\
+    while ((DST)[--(NLIMBS)] == 0)					\
+      ;									\
+    (NLIMBS)++;								\
+  } while (0)
+#endif
+
+void
+#if __STDC__
+mpz_addmul_ui (mpz_ptr rz, mpz_srcptr az, unsigned long int bu)
+#else
+mpz_addmul_ui (rz, az, bu)
+     mpz_ptr rz;
+     mpz_srcptr az;
+     unsigned long int bu;
+#endif
+{
+  mp_size_t rn, an;
+  mp_ptr rp, ap;
+
+  an = SIZ (az);
+
+  /* If either multiplier is zero, result is unaffected.  */
+  if (bu == 0 || an == 0)
+    return;
+
+  rn = SIZ (rz);
+
+  if (rn == 0)
+    {
+      mp_limb_t cy;
+
+      an = ABS (an);
+      if (ALLOC (rz) <= an)
+	_mpz_realloc (rz, an + 1);
+      rp = PTR (rz);
+      ap = PTR (az);
+      cy = mpn_mul_1 (rp, ap, an, (mp_limb_t) bu);
+      rp[an] = cy;
+      an += cy != 0;
+      SIZ (rz) = SIZ (az) >= 0 ? an : -an;
+      return;
+    }
+
+  if ((an ^ rn) >= 0)
+    {
+      /* Sign of operands are the same--really add.  */
+      an = ABS (an);
+      rn = ABS (rn);
+      if (rn > an)
+	{
+	  mp_limb_t cy;
+	  if (ALLOC (rz) <= rn)
+	    _mpz_realloc (rz, rn + 1);
+	  rp = PTR (rz);
+	  ap = PTR (az);
+	  cy = mpn_addmul_1 (rp, ap, an, (mp_limb_t) bu);
+	  cy = mpn_add_1 (rp + an, rp + an, rn - an, cy);
+	  rp[rn] = cy;
+	  rn += cy != 0;
+	  SIZ (rz) = SIZ (rz) >= 0 ? rn : -rn;
+	  return;
+	}
+      else
+	{
+	  mp_limb_t cy;
+	  if (ALLOC (rz) <= an)
+	    _mpz_realloc (rz, an + 1);
+	  rp = PTR (rz);
+	  ap = PTR (az);
+	  cy = mpn_addmul_1 (rp, ap, rn, (mp_limb_t) bu);
+	  if (an != rn)
+	    {
+	      mp_limb_t cy2;
+	      cy2 = mpn_mul_1 (rp + rn, ap + rn, an - rn, (mp_limb_t) bu);
+	      cy = cy2 + mpn_add_1 (rp + rn, rp + rn, an - rn, cy);
+	    }
+	  rn = an;
+	  rp[rn] = cy;
+	  rn += cy != 0;
+	  SIZ (rz) = SIZ (rz) >= 0 ? rn : -rn;
+	  return;
+	}
+    }
+  else
+    {
+      /* Sign of operands are different--actually subtract.  */
+      an = ABS (an);
+      rn = ABS (rn);
+      if (rn > an)
+	{
+	  mp_limb_t cy;
+	  rp = PTR (rz);
+	  ap = PTR (az);
+	  cy = mpn_submul_1 (rp, ap, an, (mp_limb_t) bu);
+	  cy = mpn_sub_1 (rp + an, rp + an, rn - an, cy);
+	  if (cy != 0)
+	    {
+	      mpn_neg1 (rp, rn);
+	      MPN_NORMALIZE_NOT_ZERO (rp, rn);
+	    }
+	  else
+	    {
+	      MPN_NORMALIZE (rp, rn);
+	      rn = -rn;
+	    }
+
+	  SIZ (rz) = SIZ (rz) >= 0 ? -rn : rn;
+	  return;
+	}
+      else
+	{
+	  /* Tricky case.  We need to subtract an operand that might be larger
+	     than the minuend.  To avoid allocating temporary space, we compute
+	     a*b-r instead of r-a*b and then negate.  */
+	  mp_limb_t cy;
+	  if (ALLOC (rz) <= an)
+	    _mpz_realloc (rz, an + 1);
+	  rp = PTR (rz);
+	  ap = PTR (az);
+	  cy = mpn_submul_1 (rp, ap, rn, (mp_limb_t) bu);
+	  if (an != rn)
+	    {
+	      mp_limb_t cy2;
+	      cy -= mpn_neg1 (rp, rn);
+	      cy2 = mpn_mul_1 (rp + rn, ap + rn, an - rn, (mp_limb_t) bu);
+	      if (cy == ~(mp_limb_t) 0)
+		cy = cy2 - mpn_sub_1 (rp + rn, rp + rn, an - rn, (mp_limb_t) 1);
+	      else
+		cy = cy2 + mpn_add_1 (rp + rn, rp + rn, an - rn, cy);
+	      rp[an] = cy;
+	      rn = an + (cy != 0);
+	      rn -= rp[rn - 1] == 0;
+	    }
+	  else if (cy != 0)
+	    {
+	      cy -= mpn_neg1 (rp, rn);
+	      rp[an] = cy;
+	      rn = an + 1;
+	      MPN_NORMALIZE_NOT_ZERO (rp, rn);
+	    }
+	  else
+	    {
+	      rn = an;
+	      MPN_NORMALIZE (rp, rn);
+	      rn = -rn;
+	    }
+
+	  SIZ (rz) = SIZ (rz) >= 0 ? -rn : rn;
+	  return;
+	}
+    }
+}
+
+static mp_limb_t
+#if __STDC__
+mpn_neg1 (mp_ptr rp, mp_size_t rn)
+#else
+mpn_neg1 (rp, rn)
+     mp_ptr rp;
+     mp_size_t rn;
+#endif
+{
+  mp_size_t i;
+
+  while (rn != 0 && rp[0] == 0)
+    rp++, rn--;
+
+  if (rn != 0)
+    {
+      rp[0] = -rp[0];
+      for (i = 1; i < rn; i++)
+	rp[i] = ~rp[i];
+      return 1;
+    }
+  return 0;
+}
diff --git a/src/gmp/mpz/and.c b/src/gmp/mpz/and.c
new file mode 100644
index 000000000..354e9455b
--- /dev/null
+++ b/src/gmp/mpz/and.c
@@ -0,0 +1,278 @@
+/* mpz_and -- Logical and.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_and (mpz_ptr res, mpz_srcptr op1, mpz_srcptr op2)
+#else
+mpz_and (res, op1, op2)
+     mpz_ptr res;
+     mpz_srcptr op1;
+     mpz_srcptr op2;
+#endif
+{
+  mp_srcptr op1_ptr, op2_ptr;
+  mp_size_t op1_size, op2_size;
+  mp_ptr res_ptr;
+  mp_size_t res_size;
+  mp_size_t i;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  op1_size = op1->_mp_size;
+  op2_size = op2->_mp_size;
+
+  op1_ptr = op1->_mp_d;
+  op2_ptr = op2->_mp_d;
+  res_ptr = res->_mp_d;
+
+  if (op1_size >= 0)
+    {
+      if (op2_size >= 0)
+	{
+	  res_size = MIN (op1_size, op2_size);
+	  /* First loop finds the size of the result.  */
+	  for (i = res_size - 1; i >= 0; i--)
+	    if ((op1_ptr[i] & op2_ptr[i]) != 0)
+	      break;
+	  res_size = i + 1;
+
+	  /* Handle allocation, now then we know exactly how much space is
+	     needed for the result.  */
+	  if (res->_mp_alloc < res_size)
+	    {
+	      _mpz_realloc (res, res_size);
+	      op1_ptr = op1->_mp_d;
+	      op2_ptr = op2->_mp_d;
+	      res_ptr = res->_mp_d;
+	    }
+
+	  /* Second loop computes the real result.  */
+	  for (i = res_size - 1; i >= 0; i--)
+	    res_ptr[i] = op1_ptr[i] & op2_ptr[i];
+
+	  res->_mp_size = res_size;
+	  return;
+	}
+      else /* op2_size < 0 */
+	{
+	  /* Fall through to the code at the end of the function.  */
+	}
+    }
+  else
+    {
+      if (op2_size < 0)
+	{
+	  mp_ptr opx;
+	  mp_limb_t cy;
+	  mp_size_t res_alloc;
+
+	  /* Both operands are negative, so will be the result.
+	     -((-OP1) & (-OP2)) = -(~(OP1 - 1) & ~(OP2 - 1)) =
+	     = ~(~(OP1 - 1) & ~(OP2 - 1)) + 1 =
+	     = ((OP1 - 1) | (OP2 - 1)) + 1      */
+
+	  /* It might seem as we could end up with an (invalid) result with
+	     a leading zero-limb here when one of the operands is of the
+	     type 1,,0,,..,,.0.  But some analysis shows that we surely
+	     would get carry into the zero-limb in this situation...  */
+
+	  op1_size = -op1_size;
+	  op2_size = -op2_size;
+
+	  res_alloc = 1 + MAX (op1_size, op2_size);
+
+	  opx = (mp_ptr) TMP_ALLOC (op1_size * BYTES_PER_MP_LIMB);
+	  mpn_sub_1 (opx, op1_ptr, op1_size, (mp_limb_t) 1);
+	  op1_ptr = opx;
+
+	  opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
+	  mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
+	  op2_ptr = opx;
+
+	  if (res->_mp_alloc < res_alloc)
+	    {
+	      _mpz_realloc (res, res_alloc);
+	      res_ptr = res->_mp_d;
+	      /* Don't re-read OP1_PTR and OP2_PTR.  They point to
+		 temporary space--never to the space RES->_mp_d used
+		 to point to before reallocation.  */
+	    }
+
+	  if (op1_size >= op2_size)
+	    {
+	      MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
+			op1_size - op2_size);
+	      for (i = op2_size - 1; i >= 0; i--)
+		res_ptr[i] = op1_ptr[i] | op2_ptr[i];
+	      res_size = op1_size;
+	    }
+	  else
+	    {
+	      MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size,
+			op2_size - op1_size);
+	      for (i = op1_size - 1; i >= 0; i--)
+		res_ptr[i] = op1_ptr[i] | op2_ptr[i];
+	      res_size = op2_size;
+	    }
+
+	  cy = mpn_add_1 (res_ptr, res_ptr, res_size, (mp_limb_t) 1);
+	  if (cy)
+	    {
+	      res_ptr[res_size] = cy;
+	      res_size++;
+	    }
+
+	  res->_mp_size = -res_size;
+	  TMP_FREE (marker);
+	  return;
+	}
+      else
+	{
+	  /* We should compute -OP1 & OP2.  Swap OP1 and OP2 and fall
+	     through to the code that handles OP1 & -OP2.  */
+          MPZ_SRCPTR_SWAP (op1, op2);
+          MPN_SRCPTR_SWAP (op1_ptr,op1_size, op2_ptr,op2_size);
+	}
+
+    }
+
+  {
+#if ANDNEW
+    mp_size_t op2_lim;
+    mp_size_t count;
+
+    /* OP2 must be negated as with infinite precision.
+
+       Scan from the low end for a non-zero limb.  The first non-zero
+       limb is simply negated (two's complement).  Any subsequent
+       limbs are one's complemented.  Of course, we don't need to
+       handle more limbs than there are limbs in the other, positive
+       operand as the result for those limbs is going to become zero
+       anyway.  */
+
+    /* Scan for the least significant non-zero OP2 limb, and zero the
+       result meanwhile for those limb positions.  (We will surely
+       find a non-zero limb, so we can write the loop with one
+       termination condition only.)  */
+    for (i = 0; op2_ptr[i] == 0; i++)
+      res_ptr[i] = 0;
+    op2_lim = i;
+
+    op2_size = -op2_size;
+
+    if (op1_size <= op2_size)
+      {
+	/* The ones-extended OP2 is >= than the zero-extended OP1.
+	   RES_SIZE <= OP1_SIZE.  Find the exact size.  */
+	for (i = op1_size - 1; i > op2_lim; i--)
+	  if ((op1_ptr[i] & ~op2_ptr[i]) != 0)
+	    break;
+	res_size = i + 1;
+	for (i = res_size - 1; i > op2_lim; i--)
+	  res_ptr[i] = op1_ptr[i] & ~op2_ptr[i];
+	res_ptr[op2_lim] = op1_ptr[op2_lim] & -op2_ptr[op2_lim];
+	/* Yes, this *can* happen!  */
+	MPN_NORMALIZE (res_ptr, res_size);
+      }
+    else
+      {
+	/* The ones-extended OP2 is < than the zero-extended OP1.
+	   RES_SIZE == OP1_SIZE, since OP1 is normalized.  */
+	res_size = op1_size;
+	MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size, op1_size - op2_size);
+	for (i = op2_size - 1; i > op2_lim; i--)
+	  res_ptr[i] = op1_ptr[i] & ~op2_ptr[i];
+	res_ptr[op2_lim] = op1_ptr[op2_lim] & -op2_ptr[op2_lim];
+      }
+
+    res->_mp_size = res_size;
+#else
+
+    /* OP1 is positive and zero-extended,
+       OP2 is negative and ones-extended.
+       The result will be positive.
+       OP1 & -OP2 = OP1 & ~(OP2 - 1).  */
+
+    mp_ptr opx;
+
+    op2_size = -op2_size;
+    opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
+    mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
+    op2_ptr = opx;
+
+    if (op1_size > op2_size)
+      {
+	/* The result has the same size as OP1, since OP1 is normalized
+	   and longer than the ones-extended OP2.  */
+	res_size = op1_size;
+
+	/* Handle allocation, now then we know exactly how much space is
+	   needed for the result.  */
+	if (res->_mp_alloc < res_size)
+	  {
+	    _mpz_realloc (res, res_size);
+	    res_ptr = res->_mp_d;
+	    op1_ptr = op1->_mp_d;
+	    /* Don't re-read OP2_PTR.  It points to temporary space--never
+	       to the space RES->_mp_d used to point to before reallocation.  */
+	  }
+
+	MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
+		  res_size - op2_size);
+	for (i = op2_size - 1; i >= 0; i--)
+	  res_ptr[i] = op1_ptr[i] & ~op2_ptr[i];
+
+	res->_mp_size = res_size;
+      }
+    else
+      {
+	/* Find out the exact result size.  Ignore the high limbs of OP2,
+	   OP1 is zero-extended and would make the result zero.  */
+	for (i = op1_size - 1; i >= 0; i--)
+	  if ((op1_ptr[i] & ~op2_ptr[i]) != 0)
+	    break;
+	res_size = i + 1;
+
+	/* Handle allocation, now then we know exactly how much space is
+	   needed for the result.  */
+	if (res->_mp_alloc < res_size)
+	  {
+	    _mpz_realloc (res, res_size);
+	    res_ptr = res->_mp_d;
+	    op1_ptr = op1->_mp_d;
+	    /* Don't re-read OP2_PTR.  It points to temporary space--never
+	       to the space RES->_mp_d used to point to before reallocation.  */
+	  }
+
+	for (i = res_size - 1; i >= 0; i--)
+	  res_ptr[i] = op1_ptr[i] & ~op2_ptr[i];
+
+	res->_mp_size = res_size;
+      }
+#endif
+  }
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/array_init.c b/src/gmp/mpz/array_init.c
new file mode 100644
index 000000000..1c2204698
--- /dev/null
+++ b/src/gmp/mpz/array_init.c
@@ -0,0 +1,48 @@
+/* mpz_array_init (array, array_size, size_per_elem) --
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_array_init (mpz_ptr arr, mp_size_t arr_size, mp_size_t nbits)
+#else
+mpz_array_init (arr, arr_size, nbits)
+     mpz_ptr arr;
+     mp_size_t arr_size;
+     mp_size_t nbits;
+#endif
+{
+  register mp_ptr p;
+  register size_t i;
+  mp_size_t nlimbs;
+
+  nlimbs = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+  p = (mp_ptr) (*_mp_allocate_func) (arr_size * nlimbs * BYTES_PER_MP_LIMB);
+
+  for (i = 0; i < arr_size; i++)
+    {
+      arr[i]._mp_alloc = nlimbs + 1; /* Yes, lie a little... */
+      arr[i]._mp_size = 0;
+      arr[i]._mp_d = p + i * nlimbs;
+    }
+}
diff --git a/src/gmp/mpz/bin_ui.c b/src/gmp/mpz/bin_ui.c
new file mode 100644
index 000000000..a7a6c9821
--- /dev/null
+++ b/src/gmp/mpz/bin_ui.c
@@ -0,0 +1,141 @@
+/* mpz_bin_uiui - compute n over k.
+
+Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+/* This is a poor implementation.  Look at bin_uiui.c for improvement ideas.
+   In fact consider calling mpz_bin_uiui() when the arguments fit, leaving
+   the code here only for big n.
+
+   The identity bin(n,k) = (-1)^k * bin(-n+k-1,k) can be found in Knuth vol
+   1 section 1.2.6 part G. */
+
+
+/* Enhancement: use mpn_divexact_1 when it exists */
+#define DIVIDE()                                        \
+  ASSERT (SIZ(r) > 0);                                  \
+  ASSERT_NOCARRY (mpn_divrem_1 (PTR(r), (mp_size_t) 0,  \
+                                PTR(r), SIZ(r), kacc)); \
+  SIZ(r) -= (PTR(r)[SIZ(r)-1] == 0);
+
+void
+#if __STDC__
+mpz_bin_ui (mpz_ptr r, mpz_srcptr n, unsigned long int k)
+#else
+mpz_bin_ui (r, n, k)
+     mpz_ptr r;
+     mpz_srcptr n;
+     unsigned long int k;
+#endif
+{
+  mpz_t      ni;
+  mp_limb_t  i;
+  mpz_t      nacc;
+  mp_limb_t  kacc;
+  mp_size_t  negate;
+  
+  if (mpz_sgn (n) < 0)
+    {
+      /* bin(n,k) = (-1)^k * bin(-n+k-1,k), and set ni = -n+k-1 - k = -n-1 */
+      mpz_init (ni);
+      mpz_neg (ni, n);
+      mpz_sub_ui (ni, ni, 1L);
+      negate = (k & 1);   /* (-1)^k */
+    }
+  else
+    {
+      /* bin(n,k) == 0 if k>n
+         (no test for this under the n<0 case, since -n+k-1 >= k there) */
+      if (mpz_cmp_ui (n, k) < 0)
+        {
+          mpz_set_ui (r, 0L);
+          return;
+        }
+
+      /* set ni = n-k */
+      mpz_init (ni);
+      mpz_sub_ui (ni, n, k);
+      negate = 0;
+    }
+
+  /* Now wanting bin(ni+k,k), with ni positive, and "negate" is the sign (0
+     for positive, 1 for negative). */
+  mpz_set_ui (r, 1L);
+
+  /* Rewrite bin(n,k) as bin(n,n-k) if that is smaller.  In this case it's
+     whether ni+k-k < k meaning ni<k, and if so change to denominator ni+k-k
+     = ni, and new ni of ni+k-ni = k.  */
+  if (mpz_cmp_ui (ni, k) < 0)
+    {
+      unsigned long  tmp;
+      tmp = k;
+      k = mpz_get_ui (ni);
+      mpz_set_ui (ni, tmp);
+    }
+
+  kacc = 1;
+  mpz_init_set_ui (nacc, 1);
+
+  for (i = 1; i <= k; i++)
+    {
+      mp_limb_t k1, k0;
+
+#if 0
+      mp_limb_t nacclow;
+      int c;
+
+      nacclow = PTR(nacc)[0];
+      for (c = 0; (((kacc | nacclow) & 1) == 0); c++)
+	{
+	  kacc >>= 1;
+	  nacclow >>= 1;
+	}
+      mpz_div_2exp (nacc, nacc, c);
+#endif
+
+      mpz_add_ui (ni, ni, 1);
+      mpz_mul (nacc, nacc, ni);
+      umul_ppmm (k1, k0, kacc, i);
+      if (k1 != 0)
+	{
+	  /* Accumulator overflow.  Perform bignum step.  */
+	  mpz_mul (r, r, nacc);
+	  mpz_set_ui (nacc, 1);
+          DIVIDE ();
+	  kacc = i;
+	}
+      else
+	{
+	  /* Save new products in accumulators to keep accumulating.  */
+	  kacc = k0;
+	}
+    }
+
+  mpz_mul (r, r, nacc);
+  DIVIDE ();
+  SIZ(r) = (SIZ(r) ^ -negate) + negate;
+
+  mpz_clear (nacc);
+  mpz_clear (ni);
+}
diff --git a/src/gmp/mpz/bin_uiui.c b/src/gmp/mpz/bin_uiui.c
new file mode 100644
index 000000000..b37541ba5
--- /dev/null
+++ b/src/gmp/mpz/bin_uiui.c
@@ -0,0 +1,120 @@
+/* mpz_bin_uiui - compute n over k.
+
+Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+/* Avoid reallocs by rounding up any new size */
+#define ROUNDUP_MASK  15
+
+/* Enhancement: use mpn_divexact_1 when it exists */
+#define MULDIV()                                                \
+  MPZ_REALLOC (r, (SIZ(r)+1)|ROUNDUP_MASK);                     \
+  PTR(r)[SIZ(r)] = mpn_mul_1 (PTR(r), PTR(r), SIZ(r), nacc);    \
+  ASSERT_NOCARRY (mpn_divrem_1 (PTR(r), (mp_size_t) 0,          \
+                                PTR(r), SIZ(r)+1, kacc));       \
+  SIZ(r) += (PTR(r)[SIZ(r)] != 0);
+
+void
+#if __STDC__
+mpz_bin_uiui (mpz_ptr r, unsigned long int n, unsigned long int k)
+#else
+mpz_bin_uiui (r, n, k)
+     mpz_ptr r;
+     unsigned long int n;
+     unsigned long int k;
+#endif
+{
+  unsigned long int  i, j;
+  mp_limb_t          nacc, kacc;
+  unsigned long int  cnt;
+
+  /* bin(n,k) = 0 if k>n. */
+  if (n < k)
+    {
+      mpz_set_ui (r, 0);
+      return;
+    }
+
+  /* Rewrite bin(n,k) as bin(n,n-k) if that is smaller. */
+  k = MIN (k, n-k);
+
+  /* bin(n,0) = 1 */
+  if (k == 0)
+    {
+      mpz_set_ui (r, 1);
+      return;
+    }
+
+  j = n - k + 1;
+  mpz_set_ui (r, j);
+
+  /* Initialize accumulators.  */
+  nacc = 1;
+  kacc = 1;
+
+  cnt = 0;
+  for (i = 2; i <= k; i++)
+    {
+      mp_limb_t n1, n0, k1, k0;
+
+      j++;
+#if 0
+      /* Remove common multiples of 2.  This will allow us to accumulate
+         more in nacc and kacc before we need a bignum step.  It would make
+         sense to cancel factors of 3, 5, etc too, but this would be best
+         handled by sieving out factors.  Alternatively, we could perform a
+         gcd of the accumulators just as they have overflown, and keep
+         accumulating until the gcd doesn't remove a significant factor.  */
+      while (((nacc | kacc) & 1) == 0)
+        {
+          nacc >>= 1;
+          kacc >>= 1;
+        }
+#else
+      cnt = ((nacc | kacc) & 1) ^ 1;
+      nacc >>= cnt;
+      kacc >>= cnt;
+#endif
+      /* Accumulate next multiples.  */
+      umul_ppmm (n1, n0, nacc, j);
+      umul_ppmm (k1, k0, kacc, i);
+      if (n1 != 0)
+        {
+          /* Accumulator overflow.  Perform bignum step.  */
+          MULDIV ();
+          nacc = j;
+          kacc = i;
+        }
+      else
+        {
+          if (k1 != 0) abort ();
+          /* Save new products in accumulators to keep accumulating.  */
+          nacc = n0;
+          kacc = k0;
+        }
+    }
+
+  /* Take care of whatever is left in accumulators.  */
+  MULDIV ();
+}
diff --git a/src/gmp/mpz/cdiv_q.c b/src/gmp/mpz/cdiv_q.c
new file mode 100644
index 000000000..b15ba8aaa
--- /dev/null
+++ b/src/gmp/mpz/cdiv_q.c
@@ -0,0 +1,51 @@
+/* mpz_cdiv_q -- Division rounding the quotient towards +infinity.  The
+   remainder gets the opposite sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_cdiv_q (mpz_ptr quot, mpz_srcptr dividend, mpz_srcptr divisor)
+#else
+mpz_cdiv_q (quot, dividend, divisor)
+     mpz_ptr quot;
+     mpz_srcptr dividend;
+     mpz_srcptr divisor;
+#endif
+{
+  mp_size_t dividend_size = dividend->_mp_size;
+  mp_size_t divisor_size = divisor->_mp_size;
+  mpz_t rem;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  MPZ_TMP_INIT (rem, ABS (divisor_size));
+
+  mpz_tdiv_qr (quot, rem, dividend, divisor);
+
+  if ((divisor_size ^ dividend_size) >= 0 && rem->_mp_size != 0)
+    mpz_add_ui (quot, quot, 1L);
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/cdiv_q_ui.c b/src/gmp/mpz/cdiv_q_ui.c
new file mode 100644
index 000000000..74f3a90b8
--- /dev/null
+++ b/src/gmp/mpz/cdiv_q_ui.c
@@ -0,0 +1,67 @@
+/* mpz_cdiv_q_ui -- Division rounding the quotient towards +infinity.  The
+   remainder gets the opposite sign as the denominator.  In order to make it
+   always fit into the return type, the negative of the true remainder is
+   returned.
+
+Copyright (C) 1994, 1996, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_cdiv_q_ui (mpz_ptr quot, mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_cdiv_q_ui (quot, dividend, divisor)
+     mpz_ptr quot;
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_ptr quot_ptr;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  if (quot->_mp_alloc < size)
+    _mpz_realloc (quot, size);
+
+  quot_ptr = quot->_mp_d;
+
+  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
+				   (mp_limb_t) divisor);
+
+  if (remainder_limb != 0 && dividend_size >= 0)
+    {
+      mpn_incr_u (quot_ptr, (mp_limb_t) 1);
+      remainder_limb = divisor - remainder_limb;
+    }
+
+  size -= size != 0 && quot_ptr[size - 1] == 0;
+  quot->_mp_size = dividend_size >= 0 ? size : -size;
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/cdiv_qr.c b/src/gmp/mpz/cdiv_qr.c
new file mode 100644
index 000000000..29c7c41a4
--- /dev/null
+++ b/src/gmp/mpz/cdiv_qr.c
@@ -0,0 +1,64 @@
+/* mpz_cdiv_qr -- Division rounding the quotient towards +infinity.  The
+   remainder gets the opposite sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_cdiv_qr (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
+#else
+mpz_cdiv_qr (quot, rem, dividend, divisor)
+     mpz_ptr quot;
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     mpz_srcptr divisor;
+#endif
+{
+  mp_size_t divisor_size = divisor->_mp_size;
+  mp_size_t xsize;
+  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  /* We need the original value of the divisor after the quotient and
+     remainder have been preliminary calculated.  We have to copy it to
+     temporary space if it's the same variable as either QUOT or REM.  */
+  if (quot == divisor || rem == divisor)
+    {
+      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
+      mpz_set (temp_divisor, divisor);
+      divisor = temp_divisor;
+    }
+
+  xsize = dividend->_mp_size ^ divisor_size;;
+  mpz_tdiv_qr (quot, rem, dividend, divisor);
+
+  if (xsize >= 0 && rem->_mp_size != 0)
+    {
+      mpz_add_ui (quot, quot, 1L);
+      mpz_sub (rem, rem, divisor);
+    }
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/cdiv_qr_ui.c b/src/gmp/mpz/cdiv_qr_ui.c
new file mode 100644
index 000000000..a7873c6e2
--- /dev/null
+++ b/src/gmp/mpz/cdiv_qr_ui.c
@@ -0,0 +1,71 @@
+/* mpz_cdiv_qr_ui -- Division rounding the quotient towards +infinity.  The
+   remainder gets the opposite sign as the denominator.  In order to make it
+   always fit into the return type, the negative of the true remainder is
+   returned.
+
+Copyright (C) 1994, 1995, 1996, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_cdiv_qr_ui (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_cdiv_qr_ui (quot, rem, dividend, divisor)
+     mpz_ptr quot;
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_ptr quot_ptr;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  if (quot->_mp_alloc < size)
+    _mpz_realloc (quot, size);
+
+  quot_ptr = quot->_mp_d;
+
+  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
+				 (mp_limb_t) divisor);
+
+  if (remainder_limb != 0 && dividend_size >= 0)
+    {
+      mpn_incr_u (quot_ptr, (mp_limb_t) 1);
+      remainder_limb = divisor - remainder_limb;
+    }
+
+  size -= size != 0 && quot_ptr[size - 1] == 0;
+  quot->_mp_size = dividend_size >= 0 ? size : -size;
+
+  rem->_mp_d[0] = remainder_limb;
+  rem->_mp_size = -(remainder_limb != 0);
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/cdiv_r.c b/src/gmp/mpz/cdiv_r.c
new file mode 100644
index 000000000..e96ce7e67
--- /dev/null
+++ b/src/gmp/mpz/cdiv_r.c
@@ -0,0 +1,59 @@
+/* mpz_cdiv_r -- Division rounding the quotient towards +infinity.  The
+   remainder gets the opposite sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_cdiv_r (mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
+#else
+mpz_cdiv_r (rem, dividend, divisor)
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     mpz_srcptr divisor;
+#endif
+{
+  mp_size_t divisor_size = divisor->_mp_size;
+  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  /* We need the original value of the divisor after the remainder has been
+     preliminary calculated.  We have to copy it to temporary space if it's
+     the same variable as REM.  */
+  if (rem == divisor)
+    {
+
+      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
+      mpz_set (temp_divisor, divisor);
+      divisor = temp_divisor;
+    }
+
+  mpz_tdiv_r (rem, dividend, divisor);
+
+  if ((divisor_size ^ dividend->_mp_size) >= 0 && rem->_mp_size != 0)
+    mpz_sub (rem, rem, divisor);
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/cdiv_r_ui.c b/src/gmp/mpz/cdiv_r_ui.c
new file mode 100644
index 000000000..e17e2381c
--- /dev/null
+++ b/src/gmp/mpz/cdiv_r_ui.c
@@ -0,0 +1,57 @@
+/* mpz_cdiv_r_ui -- Division rounding the quotient towards +infinity.  The
+   remainder gets the opposite sign as the denominator.  In order to make it
+   always fit into the return type, the negative of the true remainder is
+   returned.
+
+Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_cdiv_r_ui (mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_cdiv_r_ui (rem, dividend, divisor)
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
+
+  if (remainder_limb != 0 && dividend_size >= 0)
+    remainder_limb = divisor - remainder_limb;
+
+  rem->_mp_d[0] = remainder_limb;
+  rem->_mp_size = -(remainder_limb != 0);
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/cdiv_ui.c b/src/gmp/mpz/cdiv_ui.c
new file mode 100644
index 000000000..63547a78c
--- /dev/null
+++ b/src/gmp/mpz/cdiv_ui.c
@@ -0,0 +1,50 @@
+/* mpz_cdiv_ui -- Division rounding the quotient towards +infinity.  The
+   remainder gets the opposite sign as the denominator.  In order to make it
+   always fit into the return type, the negative of the true remainder is
+   returned.
+
+Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_cdiv_ui (mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_cdiv_ui (dividend, divisor)
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_limb_t remainder_limb;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
+
+  if (remainder_limb != 0 && dividend_size >= 0)
+    remainder_limb = divisor - remainder_limb;
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/clear.c b/src/gmp/mpz/clear.c
new file mode 100644
index 000000000..5224553f9
--- /dev/null
+++ b/src/gmp/mpz/clear.c
@@ -0,0 +1,35 @@
+/* mpz_clear -- de-allocate the space occupied by the dynamic digit space of
+   an integer.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_clear (mpz_ptr m)
+#else
+mpz_clear (m)
+     mpz_ptr m;
+#endif
+{
+  (*_mp_free_func) (m->_mp_d, m->_mp_alloc * BYTES_PER_MP_LIMB);
+}
diff --git a/src/gmp/mpz/clrbit.c b/src/gmp/mpz/clrbit.c
new file mode 100644
index 000000000..865d84902
--- /dev/null
+++ b/src/gmp/mpz/clrbit.c
@@ -0,0 +1,114 @@
+/* mpz_clrbit -- clear a specified bit.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_clrbit (mpz_ptr d, unsigned long int bit_index)
+#else
+mpz_clrbit (d, bit_index)
+     mpz_ptr d;
+     unsigned long int bit_index;
+#endif
+{
+  mp_size_t dsize = d->_mp_size;
+  mp_ptr dp = d->_mp_d;
+  mp_size_t limb_index;
+
+  limb_index = bit_index / BITS_PER_MP_LIMB;
+  if (dsize >= 0)
+    {
+      if (limb_index < dsize)
+	{
+	  dp[limb_index] &= ~((mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB));
+	  MPN_NORMALIZE (dp, dsize);
+	  d->_mp_size = dsize;
+	}
+      else
+	;
+    }
+  else
+    {
+      mp_size_t zero_bound;
+
+      /* Simulate two's complement arithmetic, i.e. simulate
+	 1. Set OP = ~(OP - 1) [with infinitely many leading ones].
+	 2. clear the bit.
+	 3. Set OP = ~OP + 1.  */
+
+      dsize = -dsize;
+
+      /* No upper bound on this loop, we're sure there's a non-zero limb
+	 sooner ot later.  */
+      for (zero_bound = 0; ; zero_bound++)
+	if (dp[zero_bound] != 0)
+	  break;
+
+      if (limb_index > zero_bound)
+	{
+	  if (limb_index < dsize)
+	    dp[limb_index] |= (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB);
+	  else
+	    {
+	      /* Ugh.  The bit should be cleared outside of the end of the
+		 number.  We have to increase the size of the number.  */
+	      if (d->_mp_alloc < limb_index + 1)
+		{
+		  _mpz_realloc (d, limb_index + 1);
+		  dp = d->_mp_d;
+		}
+	      MPN_ZERO (dp + dsize, limb_index - dsize);
+	      dp[limb_index] = (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB);
+	      d->_mp_size = -(limb_index + 1);
+	    }
+	}
+      else if (limb_index == zero_bound)
+	{
+	  dp[limb_index] = ((dp[limb_index] - 1)
+			    | ((mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB))) + 1;
+	  if (dp[limb_index] == 0)
+	    {
+	      mp_size_t i;
+	      for (i = limb_index + 1; i < dsize; i++)
+		{
+		  dp[i] += 1;
+		  if (dp[i] != 0)
+		    goto fin;
+		}
+	      /* We got carry all way out beyond the end of D.  Increase
+		 its size (and allocation if necessary).  */
+	      dsize++;
+	      if (d->_mp_alloc < dsize)
+		{
+		  _mpz_realloc (d, dsize);
+		  dp = d->_mp_d;
+		}
+	      dp[i] = 1;
+	      d->_mp_size = -dsize;
+	    fin:;
+	    }
+	}
+      else
+	;
+    }
+}
diff --git a/src/gmp/mpz/cmp.c b/src/gmp/mpz/cmp.c
new file mode 100644
index 000000000..60628348e
--- /dev/null
+++ b/src/gmp/mpz/cmp.c
@@ -0,0 +1,75 @@
+/* mpz_cmp(u,v) -- Compare U, V.  Return postive, zero, or negative
+   based on if U > V, U == V, or U < V.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#ifdef BERKELEY_MP
+#include "mp.h"
+#endif
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#ifndef BERKELEY_MP
+int
+#if __STDC__
+mpz_cmp (mpz_srcptr u, mpz_srcptr v)
+#else
+mpz_cmp (u, v)
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+#else /* BERKELEY_MP */
+int
+#if __STDC__
+mcmp (mpz_srcptr u, mpz_srcptr v)
+#else
+mcmp (u, v)
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+#endif /* BERKELEY_MP */
+{
+  mp_size_t usize = u->_mp_size;
+  mp_size_t vsize = v->_mp_size;
+  mp_size_t size;
+  mp_srcptr up, vp;
+  int cmp;
+
+  if (usize != vsize)
+    return usize - vsize;
+
+  if (usize == 0)
+    return 0;
+
+  size = ABS (usize);
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+
+  cmp = mpn_cmp (up, vp, size);
+
+  if (cmp == 0)
+    return 0;
+
+  if ((cmp < 0) == (usize < 0))
+    return 1;
+  else
+    return -1;
+}
diff --git a/src/gmp/mpz/cmp_si.c b/src/gmp/mpz/cmp_si.c
new file mode 100644
index 000000000..0c2212fbe
--- /dev/null
+++ b/src/gmp/mpz/cmp_si.c
@@ -0,0 +1,64 @@
+/* mpz_cmp_si(u,v) -- Compare an integer U with a single-word int V.
+   Return positive, zero, or negative based on if U > V, U == V, or U < V.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+_mpz_cmp_si (mpz_srcptr u, signed long int v_digit)
+#else
+_mpz_cmp_si (u, v_digit)
+     mpz_srcptr u;
+     signed long int v_digit;
+#endif
+{
+  mp_size_t usize = u->_mp_size;
+  mp_size_t vsize;
+  mp_limb_t u_digit;
+
+  vsize = 0;
+  if (v_digit > 0)
+    vsize = 1;
+  else if (v_digit < 0)
+    {
+      vsize = -1;
+      v_digit = -v_digit;
+    }
+
+  if (usize != vsize)
+    return usize - vsize;
+
+  if (usize == 0)
+    return 0;
+
+  u_digit = u->_mp_d[0];
+
+  if (u_digit == (mp_limb_t) (unsigned long) v_digit)
+    return 0;
+
+  if (u_digit > (mp_limb_t) (unsigned long) v_digit)
+    return usize;
+  else
+    return -usize;
+}
diff --git a/src/gmp/mpz/cmp_ui.c b/src/gmp/mpz/cmp_ui.c
new file mode 100644
index 000000000..fd84f301c
--- /dev/null
+++ b/src/gmp/mpz/cmp_ui.c
@@ -0,0 +1,53 @@
+/* mpz_cmp_ui.c -- Compare a mpz_t a with an mp_limb_t b.  Return positive,
+  zero, or negative based on if a > b, a == b, or a < b.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+_mpz_cmp_ui (mpz_srcptr u, unsigned long int v_digit)
+#else
+_mpz_cmp_ui (u, v_digit)
+     mpz_srcptr u;
+     unsigned long int v_digit;
+#endif
+{
+  mp_size_t usize = u->_mp_size;
+
+  if (usize == 0)
+    return -(v_digit != 0);
+
+  if (usize == 1)
+    {
+      mp_limb_t u_digit;
+
+      u_digit = u->_mp_d[0];
+      if (u_digit > v_digit)
+	return 1;
+      if (u_digit < v_digit)
+	return -1;
+      return 0;
+    }
+
+  return (usize > 0) ? 1 : -1;
+}
diff --git a/src/gmp/mpz/cmpabs.c b/src/gmp/mpz/cmpabs.c
new file mode 100644
index 000000000..037d7a914
--- /dev/null
+++ b/src/gmp/mpz/cmpabs.c
@@ -0,0 +1,57 @@
+/* mpz_cmpabs(u,v) -- Compare U, V.  Return postive, zero, or negative
+   based on if U > V, U == V, or U < V.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_cmpabs (mpz_srcptr u, mpz_srcptr v)
+#else
+mpz_cmpabs (u, v)
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+{
+  mp_size_t usize = u->_mp_size;
+  mp_size_t vsize = v->_mp_size;
+  mp_size_t size;
+  mp_srcptr up, vp;
+  int cmp;
+
+  usize = ABS (usize);
+  vsize = ABS (vsize);
+
+  if (usize != vsize)
+    return usize - vsize;
+
+  if (usize == 0)
+    return 0;
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+
+  cmp = mpn_cmp (up, vp, usize);
+
+  return cmp;
+}
diff --git a/src/gmp/mpz/cmpabs_ui.c b/src/gmp/mpz/cmpabs_ui.c
new file mode 100644
index 000000000..db816b582
--- /dev/null
+++ b/src/gmp/mpz/cmpabs_ui.c
@@ -0,0 +1,56 @@
+/* mpz_cmpabs_ui.c -- Compare a mpz_t a with an mp_limb_t b.  Return positive,
+  zero, or negative based on if a > b, a == b, or a < b.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_cmpabs_ui (mpz_srcptr u, unsigned long int v_digit)
+#else
+mpz_cmpabs_ui (u, v_digit)
+     mpz_srcptr u;
+     unsigned long int v_digit;
+#endif
+{
+  mp_size_t usize = u->_mp_size;
+
+  if (usize == 0)
+    return -(v_digit != 0);
+
+  usize = ABS (usize);
+
+  if (usize == 1)
+    {
+      mp_limb_t u_digit;
+
+      u_digit = u->_mp_d[0];
+      if (u_digit > v_digit)
+	return 1;
+      if (u_digit < v_digit)
+	return -1;
+      return 0;
+    }
+
+  return 1;
+}
diff --git a/src/gmp/mpz/com.c b/src/gmp/mpz/com.c
new file mode 100644
index 000000000..18d642777
--- /dev/null
+++ b/src/gmp/mpz/com.c
@@ -0,0 +1,93 @@
+/* mpz_com(mpz_ptr dst, mpz_ptr src) -- Assign the bit-complemented value of
+   SRC to DST.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_com (mpz_ptr dst, mpz_srcptr src)
+#else
+mpz_com (dst, src)
+     mpz_ptr dst;
+     mpz_srcptr src;
+#endif
+{
+  mp_size_t size = src->_mp_size;
+  mp_srcptr src_ptr;
+  mp_ptr dst_ptr;
+
+  if (size >= 0)
+    {
+      /* As with infinite precision: one's complement, two's complement.
+	 But this can be simplified using the identity -x = ~x + 1.
+	 So we're going to compute (~~x) + 1 = x + 1!  */
+
+      if (dst->_mp_alloc < size + 1)
+	_mpz_realloc (dst, size + 1);
+
+      src_ptr = src->_mp_d;
+      dst_ptr = dst->_mp_d;
+
+      if (size == 0)
+	{
+	  /* Special case, as mpn_add wants the first arg's size >= the
+	     second arg's size.  */
+	  dst_ptr[0] = 1;
+	  dst->_mp_size = -1;
+	  return;
+	}
+
+      {
+	mp_limb_t cy;
+
+	cy = mpn_add_1 (dst_ptr, src_ptr, size, (mp_limb_t) 1);
+	if (cy)
+	  {
+	    dst_ptr[size] = cy;
+	    size++;
+	  }
+      }
+
+      /* Store a negative size, to indicate ones-extension.  */
+      dst->_mp_size = -size;
+    }
+  else
+    {
+      /* As with infinite precision: two's complement, then one's complement.
+	 But that can be simplified using the identity -x = ~(x - 1).
+	 So we're going to compute ~~(x - 1) = x - 1!  */
+      size = -size;
+
+      if (dst->_mp_alloc < size)
+	_mpz_realloc (dst, size);
+
+      src_ptr = src->_mp_d;
+      dst_ptr = dst->_mp_d;
+
+      mpn_sub_1 (dst_ptr, src_ptr, size, (mp_limb_t) 1);
+      size -= dst_ptr[size - 1] == 0;
+
+      /* Store a positive size, to indicate zero-extension.  */
+      dst->_mp_size = size;
+    }
+}
diff --git a/src/gmp/mpz/divexact.c b/src/gmp/mpz/divexact.c
new file mode 100644
index 000000000..c2970454f
--- /dev/null
+++ b/src/gmp/mpz/divexact.c
@@ -0,0 +1,125 @@
+/* mpz_divexact -- finds quotient when known that quot * den == num && den != 0.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 1998, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.  */
+
+/*  Ken Weber (kweber@mat.ufrgs.br, kweber@mcs.kent.edu)
+
+    Funding for this work has been partially provided by Conselho Nacional
+    de Desenvolvimento Cienti'fico e Tecnolo'gico (CNPq) do Brazil, Grant
+    301314194-2, and was done while I was a visiting reseacher in the Instituto
+    de Matema'tica at Universidade Federal do Rio Grande do Sul (UFRGS).
+
+    References:
+	T. Jebelean, An algorithm for exact division, Journal of Symbolic
+	Computation, v. 15, 1993, pp. 169-180.	*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpz_divexact (mpz_ptr quot, mpz_srcptr num, mpz_srcptr den)
+#else
+mpz_divexact (quot, num, den)
+     mpz_ptr quot;
+     mpz_srcptr num;
+     mpz_srcptr den;
+#endif
+{
+  mp_ptr qp, tp;
+  mp_size_t qsize, tsize;
+  mp_srcptr np, dp;
+  mp_size_t nsize, dsize;
+  TMP_DECL (marker);
+
+  nsize = ABS (num->_mp_size);
+  dsize = ABS (den->_mp_size);
+
+  qsize = nsize - dsize + 1;
+  if (quot->_mp_alloc < qsize)
+    _mpz_realloc (quot, qsize);
+
+  np = num->_mp_d;
+  dp = den->_mp_d;
+  qp = quot->_mp_d;
+
+  if (nsize == 0)
+    {
+      if (dsize == 0)
+	DIVIDE_BY_ZERO;
+      quot->_mp_size = 0;
+      return;
+    }
+
+  if (dsize <= 1)
+    {
+      if (dsize == 1)
+	{
+	  mpn_divmod_1 (qp, np, nsize, dp[0]);
+	  qsize -= qp[qsize - 1] == 0;
+	  quot->_mp_size = (num->_mp_size ^ den->_mp_size) >= 0 ? qsize : -qsize;
+	  return;
+	}
+
+      /*  Generate divide-by-zero error since dsize == 0.  */
+      DIVIDE_BY_ZERO;
+    }
+
+  TMP_MARK (marker);
+
+  /*  QUOT <-- NUM/2^r, T <-- DEN/2^r where = r number of twos in DEN.  */
+  while (dp[0] == 0)
+    np += 1, nsize -= 1, dp += 1, dsize -= 1;
+  tsize = MIN (qsize, dsize);
+  if ((dp[0] & 1) != 0)
+    {
+      if (quot == den)		/*  QUOT and DEN overlap.  */
+	{
+	  tp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
+	  MPN_COPY (tp, dp, tsize);
+	}
+      else
+	tp = (mp_ptr) dp;
+      if (qp != np)
+	MPN_COPY_INCR (qp, np, qsize);
+    }
+  else
+    {
+      unsigned int r;
+      tp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
+      count_trailing_zeros (r, dp[0]);
+      mpn_rshift (tp, dp, tsize, r);
+      if (dsize > tsize)
+	tp[tsize - 1] |= dp[tsize] << (BITS_PER_MP_LIMB - r);
+      mpn_rshift (qp, np, qsize, r);
+      if (nsize > qsize)
+	qp[qsize - 1] |= np[qsize] << (BITS_PER_MP_LIMB - r);
+    }
+
+  /*  Now QUOT <-- QUOT/T.  */
+  mpn_bdivmod (qp, qp, qsize, tp, tsize, qsize * BITS_PER_MP_LIMB);
+  MPN_NORMALIZE (qp, qsize);
+
+  quot->_mp_size = (num->_mp_size ^ den->_mp_size) >= 0 ? qsize : -qsize;
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/dump.c b/src/gmp/mpz/dump.c
new file mode 100644
index 000000000..dc318ac8c
--- /dev/null
+++ b/src/gmp/mpz/dump.c
@@ -0,0 +1,44 @@
+/* mpz_dump - Dump an integer to stdout.
+
+   THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS NOT SAFE TO
+   CALL THIS FUNCTION DIRECTLY.  IN FACT, IT IS ALMOST GUARANTEED THAT THIS
+   FUNCTION WILL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE.
+
+
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_dump (mpz_srcptr u)
+#else
+mpz_dump (u)
+     mpz_srcptr u;
+#endif
+{
+  char *str;
+
+  str = mpz_get_str (0, 10, u);
+  printf ("%s\n", str);
+  (*_mp_free_func) (str, 0);/* ??? broken alloc interface, pass what size ??? */
+}
diff --git a/src/gmp/mpz/fac_ui.c b/src/gmp/mpz/fac_ui.c
new file mode 100644
index 000000000..85f40f271
--- /dev/null
+++ b/src/gmp/mpz/fac_ui.c
@@ -0,0 +1,157 @@
+/* mpz_fac_ui(result, n) -- Set RESULT to N!.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#ifdef DBG
+#include <stdio.h>
+#endif
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpz_fac_ui (mpz_ptr result, unsigned long int n)
+#else
+mpz_fac_ui (result, n)
+     mpz_ptr result;
+     unsigned long int n;
+#endif
+{
+#if SIMPLE_FAC
+
+  /* Be silly.  Just multiply the numbers in ascending order.  O(n**2).  */
+
+  unsigned long int k;
+
+  mpz_set_ui (result, 1L);
+
+  for (k = 2; k <= n; k++)
+    mpz_mul_ui (result, result, k);
+#else
+
+  /* Be smarter.  Multiply groups of numbers in ascending order until the
+     product doesn't fit in a limb.  Multiply these partial product in a
+     balanced binary tree fashion, to make the operand have as equal sizes
+     as possible.  When the operands have about the same size, mpn_mul
+     becomes faster.  */
+
+  unsigned long int p, k;
+  mp_limb_t p1, p0;
+
+  /* Stack of partial products, used to make the computation balanced
+     (i.e. make the sizes of the multiplication operands equal).  The
+     topmost position of MP_STACK will contain a one-limb partial product,
+     the second topmost will contain a two-limb partial product, and so
+     on.  MP_STACK[0] will contain a partial product with 2**t limbs.
+     To compute n! MP_STACK needs to be less than
+     log(n)**2/log(BITS_PER_MP_LIMB), so 30 is surely enough.  */
+#define MP_STACK_SIZE 30
+  mpz_t mp_stack[MP_STACK_SIZE];
+
+  /* TOP is an index into MP_STACK, giving the topmost element.
+     TOP_LIMIT_SO_FAR is the largets value it has taken so far.  */
+  int top, top_limit_so_far;
+
+  /* Count of the total number of limbs put on MP_STACK so far.  This
+     variable plays an essential role in making the compututation balanced.
+     See below.  */
+  unsigned int tree_cnt;
+
+  top = top_limit_so_far = -1;
+  tree_cnt = 0;
+  p = 1;
+  for (k = 2; k <= n; k++)
+    {
+      /* Multiply the partial product in P with K.  */
+      umul_ppmm (p1, p0, (mp_limb_t) p, (mp_limb_t) k);
+
+      /* Did we get overflow into the high limb, i.e. is the partial
+	 product now more than one limb?  */
+      if (p1 != 0)
+	{
+	  tree_cnt++;
+
+	  if (tree_cnt % 2 == 0)
+	    {
+	      mp_size_t i;
+
+	      /* TREE_CNT is even (i.e. we have generated an even number of
+		 one-limb partial products), which means that we have a
+		 single-limb product on the top of MP_STACK.  */
+
+	      mpz_mul_ui (mp_stack[top], mp_stack[top], p);
+
+	      /* If TREE_CNT is divisable by 4, 8,..., we have two
+		 similar-sized partial products with 2, 4,... limbs at
+		 the topmost two positions of MP_STACK.  Multiply them
+		 to form a new partial product with 4, 8,... limbs.  */
+	      for (i = 4; (tree_cnt & (i - 1)) == 0; i <<= 1)
+		{
+		  mpz_mul (mp_stack[top - 1],
+			   mp_stack[top], mp_stack[top - 1]);
+		  top--;
+		}
+	    }
+	  else
+	    {
+	      /* Put the single-limb partial product in P on the stack.
+		 (The next time we get a single-limb product, we will
+		 multiply the two together.)  */
+	      top++;
+	      if (top > top_limit_so_far)
+		{
+		  if (top > MP_STACK_SIZE)
+		    abort();
+		  /* The stack is now bigger than ever, initialize the top
+		     element.  */
+		  mpz_init_set_ui (mp_stack[top], p);
+		  top_limit_so_far++;
+		}
+	      else
+		mpz_set_ui (mp_stack[top], p);
+	    }
+
+	  /* We ignored the last result from umul_ppmm.  Put K in P as the
+	     first component of the next single-limb partial product.  */
+	  p = k;
+	}
+      else
+	/* We didn't get overflow in umul_ppmm.  Put p0 in P and try
+	   with one more value of K.  */
+	p = p0;			/* bogus if long != mp_limb_t */
+    }
+
+  /* We have partial products in mp_stack[0..top], in descending order.
+     We also have a small partial product in p.
+     Their product is the final result.  */
+  if (top < 0)
+    mpz_set_ui (result, p);
+  else
+    mpz_mul_ui (result, mp_stack[top--], p);
+  while (top >= 0)
+    mpz_mul (result, result, mp_stack[top--]);
+
+  /* Free the storage allocated for MP_STACK.  */
+  for (top = top_limit_so_far; top >= 0; top--)
+    mpz_clear (mp_stack[top]);
+#endif
+}
diff --git a/src/gmp/mpz/fdiv_q.c b/src/gmp/mpz/fdiv_q.c
new file mode 100644
index 000000000..9d75ca33d
--- /dev/null
+++ b/src/gmp/mpz/fdiv_q.c
@@ -0,0 +1,51 @@
+/* mpz_fdiv_q -- Division rounding the quotient towards -infinity.
+   The remainder gets the same sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_fdiv_q (mpz_ptr quot, mpz_srcptr dividend, mpz_srcptr divisor)
+#else
+mpz_fdiv_q (quot, dividend, divisor)
+     mpz_ptr quot;
+     mpz_srcptr dividend;
+     mpz_srcptr divisor;
+#endif
+{
+  mp_size_t dividend_size = dividend->_mp_size;
+  mp_size_t divisor_size = divisor->_mp_size;
+  mpz_t rem;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  MPZ_TMP_INIT (rem, ABS (divisor_size));
+
+  mpz_tdiv_qr (quot, rem, dividend, divisor);
+
+  if ((divisor_size ^ dividend_size) < 0 && rem->_mp_size != 0)
+    mpz_sub_ui (quot, quot, 1L);
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/fdiv_q_2exp.c b/src/gmp/mpz/fdiv_q_2exp.c
new file mode 100644
index 000000000..8e02180ec
--- /dev/null
+++ b/src/gmp/mpz/fdiv_q_2exp.c
@@ -0,0 +1,104 @@
+/* mpz_fdiv_q_2exp -- Divide an integer by 2**CNT.  Round the quotient
+   towards -infinity.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1998, 1999 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_fdiv_q_2exp (mpz_ptr w, mpz_srcptr u, unsigned long int cnt)
+#else
+mpz_fdiv_q_2exp (w, u, cnt)
+     mpz_ptr w;
+     mpz_srcptr u;
+     unsigned long int cnt;
+#endif
+{
+  mp_size_t usize = u->_mp_size;
+  mp_size_t wsize;
+  mp_size_t abs_usize = ABS (usize);
+  mp_size_t limb_cnt;
+  mp_ptr wp;
+  mp_limb_t round = 0;
+
+  limb_cnt = cnt / BITS_PER_MP_LIMB;
+  wsize = abs_usize - limb_cnt;
+  if (wsize <= 0)
+    {
+      wp = w->_mp_d;
+      wsize = 0;
+      /* Set ROUND since we know we skip some non-zero words in this case.
+	 Well, if U is zero, we don't, but then this will be taken care of
+	 below, since rounding only really takes place for negative U.  */
+      round = 1;
+      wp[0] = 1;
+      w->_mp_size = -(usize < 0);
+      return;
+    }
+  else
+    {
+      mp_size_t i;
+      mp_ptr up;
+
+      /* Make sure there is enough space.  We make an extra limb
+	 here to account for possible rounding at the end.  */
+      if (w->_mp_alloc < wsize + 1)
+	_mpz_realloc (w, wsize + 1);
+
+      wp = w->_mp_d;
+      up = u->_mp_d;
+
+      /* Set ROUND if we are about skip some non-zero limbs.  */
+      for (i = 0; i < limb_cnt && round == 0; i++)
+	round = up[i];
+
+      cnt %= BITS_PER_MP_LIMB;
+      if (cnt != 0)
+	{
+	  round |= mpn_rshift (wp, up + limb_cnt, wsize, cnt);
+	  wsize -= wp[wsize - 1] == 0;
+	}
+      else
+	{
+	  MPN_COPY_INCR (wp, up + limb_cnt, wsize);
+	}
+    }
+
+  if (usize < 0 && round != 0)
+    {
+      mp_limb_t cy;
+      if (wsize != 0)
+	{
+	  cy = mpn_add_1 (wp, wp, wsize, (mp_limb_t) 1);
+	  wp[wsize] = cy;
+	  wsize += cy;
+	}
+      else
+	{
+	  /* We shifted something negative to zero.  The result is -1.  */
+	  wp[0] = 1;
+	  wsize = 1;
+	}
+    }
+  w->_mp_size = usize >= 0 ? wsize : -wsize;
+}
diff --git a/src/gmp/mpz/fdiv_q_ui.c b/src/gmp/mpz/fdiv_q_ui.c
new file mode 100644
index 000000000..55d249869
--- /dev/null
+++ b/src/gmp/mpz/fdiv_q_ui.c
@@ -0,0 +1,65 @@
+/* mpz_fdiv_q_ui -- Division rounding the quotient towards -infinity.
+   The remainder gets the same sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_fdiv_q_ui (mpz_ptr quot, mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_fdiv_q_ui (quot, dividend, divisor)
+     mpz_ptr quot;
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_ptr quot_ptr;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  if (quot->_mp_alloc < size)
+    _mpz_realloc (quot, size);
+
+  quot_ptr = quot->_mp_d;
+
+  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
+				   (mp_limb_t) divisor);
+
+  if (remainder_limb != 0 && dividend_size < 0)
+    {
+      mpn_incr_u (quot_ptr, (mp_limb_t) 1);
+      remainder_limb = divisor - remainder_limb;
+    }
+
+  size -= size != 0 && quot_ptr[size - 1] == 0;
+  quot->_mp_size = dividend_size >= 0 ? size : -size;
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/fdiv_qr.c b/src/gmp/mpz/fdiv_qr.c
new file mode 100644
index 000000000..06ce50607
--- /dev/null
+++ b/src/gmp/mpz/fdiv_qr.c
@@ -0,0 +1,64 @@
+/* mpz_fdiv_qr -- Division rounding the quotient towards -infinity.
+   The remainder gets the same sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_fdiv_qr (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
+#else
+mpz_fdiv_qr (quot, rem, dividend, divisor)
+     mpz_ptr quot;
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     mpz_srcptr divisor;
+#endif
+{
+  mp_size_t divisor_size = divisor->_mp_size;
+  mp_size_t xsize;
+  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  /* We need the original value of the divisor after the quotient and
+     remainder have been preliminary calculated.  We have to copy it to
+     temporary space if it's the same variable as either QUOT or REM.  */
+  if (quot == divisor || rem == divisor)
+    {
+      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
+      mpz_set (temp_divisor, divisor);
+      divisor = temp_divisor;
+    }
+
+  xsize = dividend->_mp_size ^ divisor_size;;
+  mpz_tdiv_qr (quot, rem, dividend, divisor);
+
+  if (xsize < 0 && rem->_mp_size != 0)
+    {
+      mpz_sub_ui (quot, quot, 1L);
+      mpz_add (rem, rem, divisor);
+    }
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/fdiv_qr_ui.c b/src/gmp/mpz/fdiv_qr_ui.c
new file mode 100644
index 000000000..600c0dacf
--- /dev/null
+++ b/src/gmp/mpz/fdiv_qr_ui.c
@@ -0,0 +1,69 @@
+/* mpz_fdiv_qr_ui -- Division rounding the quotient towards -infinity.
+   The remainder gets the same sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_fdiv_qr_ui (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_fdiv_qr_ui (quot, rem, dividend, divisor)
+     mpz_ptr quot;
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_ptr quot_ptr;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  if (quot->_mp_alloc < size)
+    _mpz_realloc (quot, size);
+
+  quot_ptr = quot->_mp_d;
+
+  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
+				 (mp_limb_t) divisor);
+
+  if (remainder_limb != 0 && dividend_size < 0)
+    {
+      mpn_incr_u (quot_ptr, (mp_limb_t) 1);
+      remainder_limb = divisor - remainder_limb;
+    }
+
+  size -= size != 0 && quot_ptr[size - 1] == 0;
+  quot->_mp_size = dividend_size >= 0 ? size : -size;
+
+  rem->_mp_d[0] = remainder_limb;
+  rem->_mp_size = remainder_limb != 0;
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/fdiv_r.c b/src/gmp/mpz/fdiv_r.c
new file mode 100644
index 000000000..a3652838d
--- /dev/null
+++ b/src/gmp/mpz/fdiv_r.c
@@ -0,0 +1,58 @@
+/* mpz_fdiv_r -- Division rounding the quotient towards -infinity.
+   The remainder gets the same sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_fdiv_r (mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
+#else
+mpz_fdiv_r (rem, dividend, divisor)
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     mpz_srcptr divisor;
+#endif
+{
+  mp_size_t divisor_size = divisor->_mp_size;
+  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  /* We need the original value of the divisor after the remainder has been
+     preliminary calculated.  We have to copy it to temporary space if it's
+     the same variable as REM.  */
+  if (rem == divisor)
+    {
+      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
+      mpz_set (temp_divisor, divisor);
+      divisor = temp_divisor;
+    }
+
+  mpz_tdiv_r (rem, dividend, divisor);
+
+  if ((divisor_size ^ dividend->_mp_size) < 0 && rem->_mp_size != 0)
+    mpz_add (rem, rem, divisor);
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/fdiv_r_2exp.c b/src/gmp/mpz/fdiv_r_2exp.c
new file mode 100644
index 000000000..d0cd03945
--- /dev/null
+++ b/src/gmp/mpz/fdiv_r_2exp.c
@@ -0,0 +1,153 @@
+/* mpz_fdiv_r_2exp -- Divide a integer by 2**CNT and produce a remainder.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1998, 1999 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_fdiv_r_2exp (mpz_ptr res, mpz_srcptr in, unsigned long int cnt)
+#else
+mpz_fdiv_r_2exp (res, in, cnt)
+     mpz_ptr res;
+     mpz_srcptr in;
+     unsigned long int cnt;
+#endif
+{
+  mp_size_t in_size = ABS (in->_mp_size);
+  mp_size_t res_size;
+  mp_size_t limb_cnt = cnt / BITS_PER_MP_LIMB;
+  mp_srcptr in_ptr = in->_mp_d;
+
+  if (in_size > limb_cnt)
+    {
+      /* The input operand is (probably) greater than 2**CNT.  */
+      mp_limb_t x;
+
+      x = in_ptr[limb_cnt] & (((mp_limb_t) 1 << cnt % BITS_PER_MP_LIMB) - 1);
+      if (x != 0)
+	{
+	  res_size = limb_cnt + 1;
+	  if (res->_mp_alloc < res_size)
+	    _mpz_realloc (res, res_size);
+
+	  res->_mp_d[limb_cnt] = x;
+	}
+      else
+	{
+	  res_size = limb_cnt;
+	  MPN_NORMALIZE (in_ptr, res_size);
+
+	  if (res->_mp_alloc < res_size)
+	    _mpz_realloc (res, res_size);
+
+	  limb_cnt = res_size;
+	}
+    }
+  else
+    {
+      /* The input operand is smaller than 2**CNT.  We perform a no-op,
+	 apart from that we might need to copy IN to RES, and may need
+	 to round the result.  */
+      res_size = in_size;
+      if (res->_mp_alloc < res_size)
+	_mpz_realloc (res, res_size);
+
+      limb_cnt = res_size;
+    }
+
+  if (res != in)
+    MPN_COPY (res->_mp_d, in->_mp_d, limb_cnt);
+  in_size = in->_mp_size;
+  res->_mp_size = res_size;
+  if (in_size < 0 && res_size != 0)
+    {
+      /* Result should be 2^CNT - RES */
+      mpz_t tmp;
+      MPZ_TMP_INIT (tmp, cnt/BITS_PER_MP_LIMB + 2);
+      mpz_set_ui (tmp, 1L);
+      mpz_mul_2exp (tmp, tmp, cnt);
+      mpz_sub (res, tmp, res);
+    }
+}
+
+/* This is an alternative ending of the above function using just low-level
+   functions.  Tested, but perhaps excessive?  */
+#if 0
+  if (in->_mp_size < 0 && res_size != 0)
+    {
+      /* Result should be 2^CNT - RES */
+
+      mp_ptr rp;
+
+      limb_cnt = cnt / BITS_PER_MP_LIMB;
+
+      if (res->_mp_alloc <= limb_cnt)
+	_mpz_realloc (res, limb_cnt + 1);
+      rp = PTR(res);
+      if (res_size > limb_cnt)
+	{
+	  mpn_nz_neg (rp, rp, res_size);
+	  rp[limb_cnt] &= ~(~(mp_limb_t) 0 << cnt % BITS_PER_MP_LIMB);
+	  MPN_NORMALIZE_NOT_ZERO (rp, res_size);
+	}
+      else
+	{
+	  mp_size_t i;
+	  mpn_nz_neg (rp, rp, res_size);
+	  for (i = res_size; i < limb_cnt; i++)
+	    rp[i] = ~ (mp_limb_t) 0;
+	  res_size = limb_cnt;
+	  if (cnt % BITS_PER_MP_LIMB != 0)
+	    {
+	      rp[res_size] = ((mp_limb_t) 1 << (cnt % BITS_PER_MP_LIMB)) - 1;
+	      res_size++;
+	    }
+	  else
+	    MPN_NORMALIZE_NOT_ZERO (rp, res_size);
+	}
+    }
+  SIZ(res) = res_size;
+}
+
+static void
+mpn_nz_neg (rp, sp, n)
+     mp_ptr rp, sp;
+     mp_size_t n;
+{
+  mp_size_t i;
+  mp_limb_t x;
+
+  x = sp[0];
+  rp[0] = -x;
+  for (i = 1; x == 0; i++)
+    {
+      x = sp[i];
+      rp[i] = -x;
+    }
+
+  for (; i < n; i++)
+    {
+      rp[i] = ~sp[i];
+    }
+}
+#endif
diff --git a/src/gmp/mpz/fdiv_r_ui.c b/src/gmp/mpz/fdiv_r_ui.c
new file mode 100644
index 000000000..dd5c743d2
--- /dev/null
+++ b/src/gmp/mpz/fdiv_r_ui.c
@@ -0,0 +1,55 @@
+/* mpz_fdiv_r_ui -- Division rounding the quotient towards -infinity.
+   The remainder gets the same sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_fdiv_r_ui (mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_fdiv_r_ui (rem, dividend, divisor)
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
+
+  if (remainder_limb != 0 && dividend_size < 0)
+    remainder_limb = divisor - remainder_limb;
+
+  rem->_mp_d[0] = remainder_limb;
+  rem->_mp_size = remainder_limb != 0;
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/fdiv_ui.c b/src/gmp/mpz/fdiv_ui.c
new file mode 100644
index 000000000..f937b5f6d
--- /dev/null
+++ b/src/gmp/mpz/fdiv_ui.c
@@ -0,0 +1,48 @@
+/* mpz_fdiv_ui -- Division rounding the quotient towards -infinity.
+   The remainder gets the same sign as the denominator.
+
+Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_fdiv_ui (mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_fdiv_ui (dividend, divisor)
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_limb_t remainder_limb;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
+
+  if (remainder_limb != 0 && dividend_size < 0)
+    remainder_limb = divisor - remainder_limb;
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/fib_ui.c b/src/gmp/mpz/fib_ui.c
new file mode 100644
index 000000000..4bebb80d9
--- /dev/null
+++ b/src/gmp/mpz/fib_ui.c
@@ -0,0 +1,165 @@
+/* mpz_fib_ui(result, n) -- Set RESULT to the Nth Fibonacci number.
+
+Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* This is fast, but could be made somewhat faster and neater.
+   The timing is somewhat fluctuating for even/odd sizes because
+   of the extra hair used to save variables and operations.  Here
+   are a few things one might want to address:
+     1. Avoid using 4 intermediate variables in mpz_fib_bigcase.
+     2. Call mpn functions directly.  Straightforward for these functions.
+     3. Merge the three functions into one.
+
+Said by Kevin:
+   Consider using the Lucas numbers L[n] as an auxiliary sequence, making
+   it possible to do the "doubling" operation in mpz_fib_bigcase with two
+   squares rather than two multiplies.  The formulas are a little more
+   complicated, something like the following (untested).
+
+       F[2n] = ((F[n]+L[n])^2 - 6*F[n]^2 - 4*(-1)^n) / 2
+       L[2n] = 5*F[n]^2 + 2*(-1)^n
+
+       F[2n+1] = (F[2n] + L[2n]) / 2
+       L[2n+1] = (5*F[2n] + L[2n]) / 2
+
+   The Lucas number that comes for free here could even be returned.
+
+   Maybe there's formulas with two squares using just F[n], but I don't
+   know of any.
+*/
+
+/* Determine the needed storage for Fib(n).  */
+#define FIB_SIZE(n) (((mp_size_t) ((n)*0.695)) / BITS_PER_MP_LIMB + 2)
+
+static void mpz_fib_bigcase _PROTO ((mpz_t, mpz_t, unsigned long int));
+static void mpz_fib_basecase _PROTO ((mpz_t, mpz_t, unsigned long int));
+
+
+#ifndef FIB_THRESHOLD
+#define FIB_THRESHOLD 60
+#endif
+
+void
+#if __STDC__
+mpz_fib_ui (mpz_t r, unsigned long int n)
+#else
+mpz_fib_ui (r, n)
+     mpz_t r;
+     unsigned long int n;
+#endif
+{
+  if (n == 0)
+    mpz_set_ui (r, 0);
+  else
+    {
+      mpz_t t1;
+      mpz_init (t1);
+      if (n < FIB_THRESHOLD)
+	mpz_fib_basecase (t1, r, n);
+      else
+	mpz_fib_bigcase (t1, r, n);
+      mpz_clear (t1);
+    }
+}
+
+static void
+#if __STDC__
+mpz_fib_basecase (mpz_t t1, mpz_t t2, unsigned long int n)
+#else
+mpz_fib_basecase (t1, t2, n)
+     mpz_t t1;
+     mpz_t t2;
+     unsigned long int n;
+#endif
+{
+  unsigned long int m, i;
+
+  mpz_set_ui (t1, 0);
+  mpz_set_ui (t2, 1);
+  m = n/2;
+  for (i = 0; i < m; i++)
+    {
+      mpz_add (t1, t1, t2);
+      mpz_add (t2, t1, t2);
+    }
+  if ((n & 1) == 0)
+    {
+      mpz_sub (t1, t2, t1);
+      mpz_sub (t2, t2, t1);	/* trick: recover t1 value just overwritten */
+    }
+}
+
+static void
+#if __STDC__
+mpz_fib_bigcase (mpz_t t1, mpz_t t2, unsigned long int n)
+#else
+mpz_fib_bigcase (t1, t2, n)
+     mpz_t t1;
+     mpz_t t2;
+     unsigned long int n;
+#endif
+{
+  unsigned long int n2;
+  int ni, i;
+  mpz_t x1, x2, u1, u2;
+
+  ni = 0;
+  for (n2 = n; n2 >= FIB_THRESHOLD; n2 /= 2)
+    ni++;
+
+  mpz_fib_basecase (t1, t2, n2);
+
+  mpz_init (x1);
+  mpz_init (x2);
+  mpz_init (u1);
+  mpz_init (u2);
+
+  for (i = ni - 1; i >= 0; i--)
+    {
+      mpz_mul_2exp (x1, t1, 1);
+      mpz_mul_2exp (x2, t2, 1);
+
+      mpz_add (x1, x1, t2);
+      mpz_sub (x2, x2, t1);
+
+      mpz_mul (u1, t2, x1);
+      mpz_mul (u2, t1, x2);
+
+      if (((n >> i) & 1) == 0)
+	{
+	  mpz_sub (t1, u1, u2);
+	  mpz_set (t2, u1);
+	}
+      else
+	{
+	  mpz_set (t1, u1);
+	  mpz_mul_2exp (t2, u1, 1);
+	  mpz_sub (t2, t2, u2);
+	}
+    }
+
+  mpz_clear (x1);
+  mpz_clear (x2);
+  mpz_clear (u1);
+  mpz_clear (u2);
+}
diff --git a/src/gmp/mpz/fits_sint_p.c b/src/gmp/mpz/fits_sint_p.c
new file mode 100644
index 000000000..82e32a24d
--- /dev/null
+++ b/src/gmp/mpz/fits_sint_p.c
@@ -0,0 +1,50 @@
+/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
+
+Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_fits_sint_p (mpz_srcptr src)
+#else
+mpz_fits_sint_p (src)
+     mpz_srcptr src;
+#endif
+{
+  mp_size_t size;
+  mp_limb_t mpl;
+
+  mpl = PTR(src)[0];
+  size = SIZ(src);
+  if (size > 0)
+    {
+      if (size > 1)
+	return 0;
+      return mpl < ~((~(unsigned int) 0) >> 1);
+    }
+  else
+    {
+      if (size < -1)
+	return 0;
+      return mpl <= ~((~(unsigned int) 0) >> 1);
+    }
+}
diff --git a/src/gmp/mpz/fits_slong_p.c b/src/gmp/mpz/fits_slong_p.c
new file mode 100644
index 000000000..e0669b5aa
--- /dev/null
+++ b/src/gmp/mpz/fits_slong_p.c
@@ -0,0 +1,50 @@
+/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
+
+Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_fits_slong_p (mpz_srcptr src)
+#else
+mpz_fits_slong_p (src)
+     mpz_srcptr src;
+#endif
+{
+  mp_size_t size;
+  mp_limb_t mpl;
+
+  mpl = PTR(src)[0];
+  size = SIZ(src);
+  if (size > 0)
+    {
+      if (size > 1)
+	return 0;
+      return mpl < ~((~(unsigned long int) 0) >> 1);
+    }
+  else
+    {
+      if (size < -1)
+	return 0;
+      return mpl <= ~((~(unsigned long int) 0) >> 1);
+    }
+}
diff --git a/src/gmp/mpz/fits_sshort_p.c b/src/gmp/mpz/fits_sshort_p.c
new file mode 100644
index 000000000..5b8e31afa
--- /dev/null
+++ b/src/gmp/mpz/fits_sshort_p.c
@@ -0,0 +1,50 @@
+/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
+
+Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_fits_sshort_p (mpz_srcptr src)
+#else
+mpz_fits_sshort_p (src)
+     mpz_srcptr src;
+#endif
+{
+  mp_size_t size;
+  mp_limb_t mpl;
+
+  mpl = PTR(src)[0];
+  size = SIZ(src);
+  if (size > 0)
+    {
+      if (size > 1)
+	return 0;
+      return mpl <= (((unsigned short int) ~(unsigned int) 0) >> 1);
+    }
+  else
+    {
+      if (size < -1)
+	return 0;
+      return mpl <= (((unsigned short int) ~(unsigned int) 0) >> 1) + 1;
+    }
+}
diff --git a/src/gmp/mpz/fits_uint_p.c b/src/gmp/mpz/fits_uint_p.c
new file mode 100644
index 000000000..72f62fa72
--- /dev/null
+++ b/src/gmp/mpz/fits_uint_p.c
@@ -0,0 +1,41 @@
+/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
+
+Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_fits_uint_p (mpz_srcptr src)
+#else
+mpz_fits_uint_p (src)
+     mpz_srcptr src;
+#endif
+{
+  mp_size_t size;
+  mp_limb_t mpl;
+
+  mpl = PTR(src)[0];
+  size = SIZ(src);
+  if (size < 0 || size > 1)
+    return 0;
+  return mpl <= (~(unsigned int) 0);
+}
diff --git a/src/gmp/mpz/fits_ulong_p.c b/src/gmp/mpz/fits_ulong_p.c
new file mode 100644
index 000000000..92eb42e86
--- /dev/null
+++ b/src/gmp/mpz/fits_ulong_p.c
@@ -0,0 +1,41 @@
+/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
+
+Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_fits_ulong_p (mpz_srcptr src)
+#else
+mpz_fits_ulong_p (src)
+     mpz_srcptr src;
+#endif
+{
+  mp_size_t size;
+  mp_limb_t mpl;
+
+  mpl = PTR(src)[0];
+  size = SIZ(src);
+  if (size < 0 || size > 1)
+    return 0;
+  return mpl <= (~(unsigned long int) 0);
+}
diff --git a/src/gmp/mpz/fits_ushort_p.c b/src/gmp/mpz/fits_ushort_p.c
new file mode 100644
index 000000000..bde0edae6
--- /dev/null
+++ b/src/gmp/mpz/fits_ushort_p.c
@@ -0,0 +1,41 @@
+/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
+
+Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_fits_ushort_p (mpz_srcptr src)
+#else
+mpz_fits_ushort_p (src)
+     mpz_srcptr src;
+#endif
+{
+  mp_size_t size;
+  mp_limb_t mpl;
+
+  mpl = PTR(src)[0];
+  size = SIZ(src);
+  if (size < 0 || size > 1)
+    return 0;
+  return mpl <= ((unsigned short int) ~(unsigned int) 0);
+}
diff --git a/src/gmp/mpz/gcd.c b/src/gmp/mpz/gcd.c
new file mode 100644
index 000000000..0d950dd60
--- /dev/null
+++ b/src/gmp/mpz/gcd.c
@@ -0,0 +1,180 @@
+/* mpz/gcd.c:   Calculate the greatest common divisor of two integers.
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#ifdef BERKELEY_MP
+#include "mp.h"
+#endif
+
+
+#ifndef BERKELEY_MP
+void
+#if __STDC__
+mpz_gcd (mpz_ptr g, mpz_srcptr u, mpz_srcptr v)
+#else
+mpz_gcd (g, u, v)
+     mpz_ptr g;
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+#else /* BERKELEY_MP */
+void
+#if __STDC__
+gcd (mpz_srcptr u, mpz_srcptr v, mpz_ptr g)
+#else
+gcd (u, v, g)
+     mpz_ptr g;
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+#endif /* BERKELEY_MP */
+
+{
+  unsigned long int g_zero_bits, u_zero_bits, v_zero_bits;
+  mp_size_t g_zero_limbs, u_zero_limbs, v_zero_limbs;
+  mp_ptr tp;
+  mp_ptr up = u->_mp_d;
+  mp_size_t usize = ABS (u->_mp_size);
+  mp_ptr vp = v->_mp_d;
+  mp_size_t vsize = ABS (v->_mp_size);
+  mp_size_t gsize;
+  TMP_DECL (marker);
+
+  /* GCD(0, V) == V.  */
+  if (usize == 0)
+    {
+      g->_mp_size = vsize;
+      if (g == v)
+	return;
+      if (g->_mp_alloc < vsize)
+	_mpz_realloc (g, vsize);
+      MPN_COPY (g->_mp_d, vp, vsize);
+      return;
+    }
+
+  /* GCD(U, 0) == U.  */
+  if (vsize == 0)
+    {
+      g->_mp_size = usize;
+      if (g == u)
+	return;
+      if (g->_mp_alloc < usize)
+	_mpz_realloc (g, usize);
+      MPN_COPY (g->_mp_d, up, usize);
+      return;
+    }
+
+  if (usize == 1)
+    {
+      g->_mp_size = 1;
+      g->_mp_d[0] = mpn_gcd_1 (vp, vsize, up[0]);
+      return;
+    }
+
+  if (vsize == 1)
+    {
+      g->_mp_size = 1;
+      g->_mp_d[0] = mpn_gcd_1 (up, usize, vp[0]);
+      return;
+    }
+
+  TMP_MARK (marker);
+
+  /*  Eliminate low zero bits from U and V and move to temporary storage.  */
+  while (*up == 0)
+    up++;
+  u_zero_limbs = up - u->_mp_d;
+  usize -= u_zero_limbs;
+  count_trailing_zeros (u_zero_bits, *up);
+  tp = up;
+  up = (mp_ptr) TMP_ALLOC (usize * BYTES_PER_MP_LIMB);
+  if (u_zero_bits != 0)
+    {
+      mpn_rshift (up, tp, usize, u_zero_bits);
+      usize -= up[usize - 1] == 0;
+    }
+  else
+    MPN_COPY (up, tp, usize);
+
+  while (*vp == 0)
+    vp++;
+  v_zero_limbs = vp - v->_mp_d;
+  vsize -= v_zero_limbs;
+  count_trailing_zeros (v_zero_bits, *vp);
+  tp = vp;
+  vp = (mp_ptr) TMP_ALLOC (vsize * BYTES_PER_MP_LIMB);
+  if (v_zero_bits != 0)
+    {
+      mpn_rshift (vp, tp, vsize, v_zero_bits);
+      vsize -= vp[vsize - 1] == 0;
+    }
+  else
+    MPN_COPY (vp, tp, vsize);
+
+  if (u_zero_limbs > v_zero_limbs)
+    {
+      g_zero_limbs = v_zero_limbs;
+      g_zero_bits = v_zero_bits;
+    }
+  else if (u_zero_limbs < v_zero_limbs)
+    {
+      g_zero_limbs = u_zero_limbs;
+      g_zero_bits = u_zero_bits;
+    }
+  else  /*  Equal.  */
+    {
+      g_zero_limbs = u_zero_limbs;
+      g_zero_bits = MIN (u_zero_bits, v_zero_bits);
+    }
+
+  /*  Call mpn_gcd.  The 2nd argument must not have more bits than the 1st.  */
+  vsize = (usize < vsize || (usize == vsize && up[usize-1] < vp[vsize-1]))
+    ? mpn_gcd (vp, vp, vsize, up, usize)
+    : mpn_gcd (vp, up, usize, vp, vsize);
+
+  /*  Here G <-- V << (g_zero_limbs*BITS_PER_MP_LIMB + g_zero_bits).  */
+  gsize = vsize + g_zero_limbs;
+  if (g_zero_bits != 0)
+    {
+      mp_limb_t cy_limb;
+      gsize += (vp[vsize - 1] >> (BITS_PER_MP_LIMB - g_zero_bits)) != 0;
+      if (g->_mp_alloc < gsize)
+	_mpz_realloc (g, gsize);
+      MPN_ZERO (g->_mp_d, g_zero_limbs);
+
+      tp = g->_mp_d + g_zero_limbs;
+      cy_limb = mpn_lshift (tp, vp, vsize, g_zero_bits);
+      if (cy_limb != 0)
+	tp[vsize] = cy_limb;
+    }
+  else
+    {
+      if (g->_mp_alloc < gsize)
+	_mpz_realloc (g, gsize);
+      MPN_ZERO (g->_mp_d, g_zero_limbs);
+      MPN_COPY (g->_mp_d + g_zero_limbs, vp, vsize);
+    }
+
+  g->_mp_size = gsize;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/gcd_ui.c b/src/gmp/mpz/gcd_ui.c
new file mode 100644
index 000000000..f3bec5882
--- /dev/null
+++ b/src/gmp/mpz/gcd_ui.c
@@ -0,0 +1,65 @@
+/* mpz_gcd_ui -- Calculate the greatest common divisior of two integers.
+
+Copyright (C) 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_gcd_ui (mpz_ptr w, mpz_srcptr u, unsigned long int v)
+#else
+mpz_gcd_ui (w, u, v)
+     mpz_ptr w;
+     mpz_srcptr u;
+     unsigned long int v;
+#endif
+{
+  mp_size_t size;
+  mp_limb_t res;
+
+  size = ABS (u->_mp_size);
+
+  if (size == 0)
+    res = v;
+  else if (v == 0)
+    {
+      if (w != NULL && u != w)
+	{
+	  if (w->_mp_alloc < size)
+	    _mpz_realloc (w, size);
+
+	  MPN_COPY (w->_mp_d, u->_mp_d, size);
+	}
+      w->_mp_size = size;
+      /* We can't return any useful result for gcd(big,0).  */
+      return size > 1 ? 0 : w->_mp_d[0];
+    }
+  else
+    res = mpn_gcd_1 (u->_mp_d, size, (mp_limb_t) v);
+
+  if (w != NULL)
+    {
+      w->_mp_d[0] = res;
+      w->_mp_size = 1;
+    }
+  return res;
+}
diff --git a/src/gmp/mpz/gcdext.c b/src/gmp/mpz/gcdext.c
new file mode 100644
index 000000000..3ba04c84f
--- /dev/null
+++ b/src/gmp/mpz/gcdext.c
@@ -0,0 +1,137 @@
+/* mpz_gcdext(g, s, t, a, b) -- Set G to gcd(a, b), and S and T such that
+   g = as + bt.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_gcdext (mpz_ptr g, mpz_ptr s, mpz_ptr t, mpz_srcptr a, mpz_srcptr b)
+#else
+mpz_gcdext (g, s, t, a, b)
+     mpz_ptr g;
+     mpz_ptr s;
+     mpz_ptr t;
+     mpz_srcptr a;
+     mpz_srcptr b;
+#endif
+{
+  mp_size_t asize, bsize, usize, vsize;
+  mp_srcptr ap, bp;
+  mp_ptr up, vp;
+  mp_size_t gsize, ssize, tmp_ssize;
+  mp_ptr gp, sp, tmp_gp, tmp_sp;
+  mpz_srcptr u, v;
+  mpz_ptr ss, tt;
+  __mpz_struct stmp, gtmp;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  /* mpn_gcdext requires that U >= V.  Therefore, we often have to swap U and
+     V.  This in turn leads to a lot of complications.  The computed cofactor
+     will be the wrong one, so we have to fix that up at the end.  */
+
+  asize = ABS (SIZ (a));
+  bsize = ABS (SIZ (b));
+  ap = PTR (a);
+  bp = PTR (b);
+  if (asize > bsize || (asize == bsize && mpn_cmp (ap, bp, asize) > 0))
+    {
+      usize = asize;
+      vsize = bsize;
+      up = (mp_ptr) TMP_ALLOC ((usize + 1) * BYTES_PER_MP_LIMB);
+      vp = (mp_ptr) TMP_ALLOC ((vsize + 1) * BYTES_PER_MP_LIMB);
+      MPN_COPY (up, ap, usize);
+      MPN_COPY (vp, bp, vsize);
+      u = a;
+      v = b;
+      ss = s;
+      tt = t;
+    }
+  else
+    {
+      usize = bsize;
+      vsize = asize;
+      up = (mp_ptr) TMP_ALLOC ((usize + 1) * BYTES_PER_MP_LIMB);
+      vp = (mp_ptr) TMP_ALLOC ((vsize + 1) * BYTES_PER_MP_LIMB);
+      MPN_COPY (up, bp, usize);
+      MPN_COPY (vp, ap, vsize);
+      u = b;
+      v = a;
+      ss = t;
+      tt = s;
+    }
+
+  tmp_gp = (mp_ptr) TMP_ALLOC ((usize + 1) * BYTES_PER_MP_LIMB);
+  tmp_sp = (mp_ptr) TMP_ALLOC ((usize + 1) * BYTES_PER_MP_LIMB);
+
+  if (vsize == 0)
+    {
+      tmp_sp[0] = 1;
+      tmp_ssize = 1;
+      MPN_COPY (tmp_gp, up, usize);
+      gsize = usize;
+    }
+  else
+    gsize = mpn_gcdext (tmp_gp, tmp_sp, &tmp_ssize, up, usize, vp, vsize);
+  ssize = ABS (tmp_ssize);
+
+  PTR (&gtmp) = tmp_gp;
+  SIZ (&gtmp) = gsize;
+
+  PTR (&stmp) = tmp_sp;
+  SIZ (&stmp) = (tmp_ssize ^ SIZ (u)) >= 0 ? ssize : -ssize;
+
+  if (tt != NULL)
+    {
+      if (SIZ (v) == 0)
+	SIZ (tt) = 0;
+      else
+	{
+	  mpz_t x;
+	  MPZ_TMP_INIT (x, ssize + usize + 1);
+	  mpz_mul (x, &stmp, u);
+	  mpz_sub (x, &gtmp, x);
+	  mpz_tdiv_q (tt, x, v);
+	}
+    }
+
+  if (ss != NULL)
+    {
+      if (ALLOC (ss) < ssize)
+	_mpz_realloc (ss, ssize);
+      sp = PTR (ss);
+      MPN_COPY (sp, tmp_sp, ssize);
+      SIZ (ss) = SIZ (&stmp);
+    }
+
+  if (ALLOC (g) < gsize)
+    _mpz_realloc (g, gsize);
+  gp = PTR (g);
+  MPN_COPY (gp, tmp_gp, gsize);
+  SIZ (g) = gsize;
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/get_d.c b/src/gmp/mpz/get_d.c
new file mode 100644
index 000000000..6a7c5856b
--- /dev/null
+++ b/src/gmp/mpz/get_d.c
@@ -0,0 +1,128 @@
+/* double mpz_get_d (mpz_t src) -- Return the double approximation to SRC.
+
+Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+static int
+#if __STDC__
+mpn_zero_p (mp_ptr p, mp_size_t n)
+#else
+mpn_zero_p (p, n)
+     mp_ptr p;
+     mp_size_t n;
+#endif
+{
+  mp_size_t i;
+
+  for (i = 0; i < n; i++)
+    {
+      if (p[i] != 0)
+	return 0;
+    }
+
+  return 1;
+}
+
+
+double
+#if __STDC__
+mpz_get_d (mpz_srcptr src)
+#else
+mpz_get_d (src)
+     mpz_srcptr src;
+#endif
+{
+  double res;
+  mp_size_t size;
+  int negative;
+  mp_ptr qp;
+  mp_limb_t hz, lz;
+  int cnt;
+
+  size = SIZ(src);
+  if (size == 0)
+    return 0.0;
+
+  negative = size < 0;
+  size = ABS (size);
+  qp = PTR(src);
+
+  if (size == 1)
+    {
+      res = qp[size - 1];
+    }
+  else if (size == 2)
+    {
+      res = MP_BASE_AS_DOUBLE * qp[size - 1] + qp[size - 2];
+    }
+  else
+    {
+      count_leading_zeros (cnt, qp[size - 1]);
+
+#if BITS_PER_MP_LIMB == 32
+      if (cnt == 0)
+	{
+	  hz = qp[size - 1];
+	  lz = qp[size - 2];
+	}
+      else
+	{
+	  hz = (qp[size - 1] << cnt) | (qp[size - 2] >> BITS_PER_MP_LIMB - cnt);
+	  lz = (qp[size - 2] << cnt) | (qp[size - 3] >> BITS_PER_MP_LIMB - cnt);
+	}
+#if _GMP_IEEE_FLOATS
+      /* Take bits from less significant limbs, but only if they may affect
+	 the result.  */
+      if ((lz & 0x7ff) == 0x400)
+	{
+	  if (cnt != 0)
+	    lz += ((qp[size - 3] << cnt) != 0 || ! mpn_zero_p (qp, size - 3));
+	  else
+	    lz += (! mpn_zero_p (qp, size - 2));
+	}
+#endif
+      res = MP_BASE_AS_DOUBLE * hz + lz;
+      res = __gmp_scale2 (res, (size - 2) * BITS_PER_MP_LIMB - cnt);
+#endif
+#if BITS_PER_MP_LIMB == 64
+      if (cnt == 0)
+	hz = qp[size - 1];
+      else
+	hz = (qp[size - 1] << cnt) | (qp[size - 2] >> BITS_PER_MP_LIMB - cnt);
+#if _GMP_IEEE_FLOATS
+      if ((hz & 0x7ff) == 0x400)
+	{
+	  if (cnt != 0)
+	    hz += ((qp[size - 2] << cnt) != 0 || ! mpn_zero_p (qp, size - 2));
+	  else
+	    hz += (! mpn_zero_p (qp, size - 1));
+	}
+#endif
+      res = hz;
+      res = __gmp_scale2 (res, (size - 1) * BITS_PER_MP_LIMB - cnt);
+#endif
+    }
+
+  return negative ? -res : res;
+}
diff --git a/src/gmp/mpz/get_si.c b/src/gmp/mpz/get_si.c
new file mode 100644
index 000000000..8a5d0e480
--- /dev/null
+++ b/src/gmp/mpz/get_si.c
@@ -0,0 +1,43 @@
+/* mpz_get_si(integer) -- Return the least significant digit from INTEGER.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+signed long int
+#if __STDC__
+mpz_get_si (mpz_srcptr op)
+#else
+mpz_get_si (op)
+     mpz_srcptr op;
+#endif
+{
+  mp_size_t size = op->_mp_size;
+  mp_limb_t low_limb = op->_mp_d[0];
+
+  if (size > 0)
+    return low_limb % ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1));
+  else if (size < 0)
+    /* This convoluted expression is necessary to properly handle 0x80000000 */
+    return ~((low_limb - 1) % ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1)));
+  else
+    return 0;
+}
diff --git a/src/gmp/mpz/get_str.c b/src/gmp/mpz/get_str.c
new file mode 100644
index 000000000..c7278afb5
--- /dev/null
+++ b/src/gmp/mpz/get_str.c
@@ -0,0 +1,118 @@
+/* mpz_get_str (string, base, mp_src) -- Convert the multiple precision
+   number MP_SRC to a string STRING of base BASE.  If STRING is NULL
+   allocate space for the result.  In any case, return a pointer to the
+   result.  If STRING is not NULL, the caller must ensure enough space is
+   available to store the result.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+char *
+#if __STDC__
+mpz_get_str (char *res_str, int base, mpz_srcptr x)
+#else
+mpz_get_str (res_str, base, x)
+     char *res_str;
+     int base;
+     mpz_srcptr x;
+#endif
+{
+  mp_ptr xp;
+  mp_size_t x_size = x->_mp_size;
+  unsigned char *str;
+  char *return_str;
+  size_t str_size;
+  char *num_to_text;
+  int i;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  if (base >= 0)
+    {
+      if (base == 0)
+	base = 10;
+      num_to_text = "0123456789abcdefghijklmnopqrstuvwxyz";
+    }
+  else
+    {
+      base = -base;
+      num_to_text = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+    }
+
+  /* We allways allocate space for the string.  If the caller passed a
+     NULL pointer for RES_STR, we allocate permanent space and return
+     a pointer to that to the caller.  */
+  str_size = ((size_t) (ABS (x_size) * BITS_PER_MP_LIMB
+			* __mp_bases[base].chars_per_bit_exactly)) + 3;
+  if (res_str == 0)
+    {
+      /* We didn't get a string from the user.  Allocate one (and return
+	 a pointer to it).  */
+      res_str = (char *) (*_mp_allocate_func) (str_size);
+      /* Make str, the variable used for raw result from mpn_get_str,
+	 point to the same string, but just after a possible minus sign.  */
+      str = (unsigned char *) res_str + 1;
+    }
+  else
+    {
+      /* Use TMP_ALLOC to get temporary space, since we need a few extra bytes
+	 that we can't expect to caller to supply us with.  */
+      str = (unsigned char *) TMP_ALLOC (str_size);
+    }
+
+  return_str = res_str;
+
+  if (x_size == 0)
+    {
+      res_str[0] = '0';
+      res_str[1] = 0;
+      TMP_FREE (marker);
+      return res_str;
+    }
+  if (x_size < 0)
+    {
+      *res_str++ = '-';
+      x_size = -x_size;
+    }
+
+  /* Move the number to convert into temporary space, since mpn_get_str
+     clobbers its argument + needs one extra high limb....  */
+  xp = (mp_ptr) TMP_ALLOC ((x_size + 1) * BYTES_PER_MP_LIMB);
+  MPN_COPY (xp, x->_mp_d, x_size);
+
+  str_size = mpn_get_str (str, base, xp, x_size);
+
+  /* mpn_get_str might make some leading zeros.  Skip them.  */
+  while (*str == 0)
+    {
+      str_size--;
+      str++;
+    }
+
+  /* Translate result to printable chars and move result to RES_STR.  */
+  for (i = 0; i < str_size; i++)
+    res_str[i] = num_to_text[str[i]];
+  res_str[str_size] = 0;
+
+  TMP_FREE (marker);
+  return return_str;
+}
diff --git a/src/gmp/mpz/get_ui.c b/src/gmp/mpz/get_ui.c
new file mode 100644
index 000000000..a8ec9e01a
--- /dev/null
+++ b/src/gmp/mpz/get_ui.c
@@ -0,0 +1,37 @@
+/* mpz_get_ui(integer) -- Return the least significant digit from INTEGER.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_get_ui (mpz_srcptr integer)
+#else
+mpz_get_ui (integer)
+     mpz_srcptr integer;
+#endif
+{
+  if (integer->_mp_size == 0)
+    return 0;
+  else
+    return integer->_mp_d[0];
+}
diff --git a/src/gmp/mpz/getlimbn.c b/src/gmp/mpz/getlimbn.c
new file mode 100644
index 000000000..b772ed05c
--- /dev/null
+++ b/src/gmp/mpz/getlimbn.c
@@ -0,0 +1,38 @@
+/* mpz_getlimbn(integer,n) -- Return the N:th limb from INTEGER.
+
+Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+mp_limb_t
+#if __STDC__
+mpz_getlimbn (mpz_srcptr integer, mp_size_t n)
+#else
+mpz_getlimbn (integer, n)
+     mpz_srcptr integer;
+     mp_size_t n;
+#endif
+{
+  if (ABS (integer->_mp_size) <= n || n < 0)
+    return 0;
+  else
+    return integer->_mp_d[n];
+}
diff --git a/src/gmp/mpz/hamdist.c b/src/gmp/mpz/hamdist.c
new file mode 100644
index 000000000..b039a653d
--- /dev/null
+++ b/src/gmp/mpz/hamdist.c
@@ -0,0 +1,62 @@
+/* mpz_hamdist(mpz_ptr op1, mpz_ptr op2) -- Compute the hamming distance
+   between OP1 and OP2.  If one of the operands is negative, return ~0.  (We
+   could make the function well-defined when both operands are negative, but
+   that would probably not be worth the trouble.
+
+Copyright (C) 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_hamdist (mpz_srcptr u, mpz_srcptr v)
+#else
+mpz_hamdist (u, v)
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+{
+  mp_srcptr up, vp;
+  mp_size_t usize, vsize, size;
+  unsigned long int count;
+
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+
+  if ((usize | vsize) < 0)
+    return ~ (unsigned long int) 0;
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+
+  if (usize > vsize)
+    {
+      count = mpn_popcount (up + vsize, usize - vsize);
+      size = vsize;
+    }
+  else
+    {
+      count = mpn_popcount (vp + usize, vsize - usize);
+      size = usize;
+    }
+
+  return count + mpn_hamdist (up, vp, size);
+}
diff --git a/src/gmp/mpz/init.c b/src/gmp/mpz/init.c
new file mode 100644
index 000000000..2e8e4d2cb
--- /dev/null
+++ b/src/gmp/mpz/init.c
@@ -0,0 +1,36 @@
+/* mpz_init() -- Make a new multiple precision number with value 0.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_init (mpz_ptr x)
+#else
+mpz_init (x)
+     mpz_ptr x;
+#endif
+{
+  x->_mp_alloc = 1;
+  x->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
+  x->_mp_size = 0;
+}
diff --git a/src/gmp/mpz/inp_raw.c b/src/gmp/mpz/inp_raw.c
new file mode 100644
index 000000000..15e601229
--- /dev/null
+++ b/src/gmp/mpz/inp_raw.c
@@ -0,0 +1,101 @@
+/* mpz_inp_raw -- Input a mpz_t in raw, but endianess, and wordsize
+   independent format (as output by mpz_out_raw).
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+size_t
+#if __STDC__
+mpz_inp_raw (mpz_ptr x, FILE *stream)
+#else
+mpz_inp_raw (x, stream)
+     mpz_ptr x;
+     FILE *stream;
+#endif
+{
+  int i;
+  mp_size_t s;
+  mp_size_t xsize;
+  mp_ptr xp;
+  unsigned int c;
+  mp_limb_t x_limb;
+  mp_size_t in_bytesize;
+  int neg_flag;
+
+  if (stream == 0)
+    stream = stdin;
+
+  /* Read 4-byte size */
+  in_bytesize = 0;
+  for (i = 4 - 1; i >= 0; i--)
+    {
+      c = fgetc (stream);
+      in_bytesize = (in_bytesize << BITS_PER_CHAR) | c;
+    }
+
+  /* Size is stored as a 32 bit word; sign extend in_bytesize for non-32 bit
+     machines.  */
+  if (sizeof (mp_size_t) > 4)
+    in_bytesize |= (-(in_bytesize < 0)) << 31;
+
+  neg_flag = in_bytesize < 0;
+  in_bytesize = ABS (in_bytesize);
+  xsize = (in_bytesize + BYTES_PER_MP_LIMB - 1) / BYTES_PER_MP_LIMB;
+
+  if (xsize == 0)
+    {
+      x->_mp_size = 0;
+      return 4;			/* we've read 4 bytes */
+    }
+
+  if (x->_mp_alloc < xsize)
+    _mpz_realloc (x, xsize);
+  xp = x->_mp_d;
+
+  x_limb = 0;
+  for (i = (in_bytesize - 1) % BYTES_PER_MP_LIMB; i >= 0; i--)
+    {
+      c = fgetc (stream);
+      x_limb = (x_limb << BITS_PER_CHAR) | c;
+    }
+  xp[xsize - 1] = x_limb;
+
+  for (s = xsize - 2; s >= 0; s--)
+    {
+      x_limb = 0;
+      for (i = BYTES_PER_MP_LIMB - 1; i >= 0; i--)
+	{
+	  c = fgetc (stream);
+	  x_limb = (x_limb << BITS_PER_CHAR) | c;
+	}
+      xp[s] = x_limb;
+    }
+
+  if (c == EOF)
+    return 0;			/* error */
+
+  MPN_NORMALIZE (xp, xsize);
+  x->_mp_size = neg_flag ? -xsize : xsize;
+  return in_bytesize + 4;
+}
diff --git a/src/gmp/mpz/inp_str.c b/src/gmp/mpz/inp_str.c
new file mode 100644
index 000000000..7aa5e1fc3
--- /dev/null
+++ b/src/gmp/mpz/inp_str.c
@@ -0,0 +1,167 @@
+/* mpz_inp_str(dest_integer, stream, base) -- Input a number in base
+   BASE from stdio stream STREAM and store the result in DEST_INTEGER.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1998, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include <ctype.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+static int
+#if __STDC__
+digit_value_in_base (int c, int base)
+#else
+digit_value_in_base (c, base)
+     int c;
+     int base;
+#endif
+{
+  int digit;
+
+  if (isdigit (c))
+    digit = c - '0';
+  else if (islower (c))
+    digit = c - 'a' + 10;
+  else if (isupper (c))
+    digit = c - 'A' + 10;
+  else
+    return -1;
+
+  if (digit < base)
+    return digit;
+  return -1;
+}
+
+size_t
+#if __STDC__
+mpz_inp_str (mpz_ptr x, FILE *stream, int base)
+#else
+mpz_inp_str (x, stream, base)
+     mpz_ptr x;
+     FILE *stream;
+     int base;
+#endif
+{
+  char *str;
+  size_t alloc_size, str_size;
+  int c;
+  int negative;
+  mp_size_t xsize;
+  size_t nread;
+
+  if (stream == 0)
+    stream = stdin;
+
+  nread = 0;
+
+  /* Skip whitespace.  */
+  do
+    {
+      c = getc (stream);
+      nread++;
+    }
+  while (isspace (c));
+
+  negative = 0;
+  if (c == '-')
+    {
+      negative = 1;
+      c = getc (stream);
+      nread++;
+    }
+
+  if (digit_value_in_base (c, base == 0 ? 10 : base) < 0)
+    return 0;			/* error if no digits */
+
+  /* If BASE is 0, try to find out the base by looking at the initial
+     characters.  */
+  if (base == 0)
+    {
+      base = 10;
+      if (c == '0')
+	{
+	  base = 8;
+	  c = getc (stream);
+	  nread++;
+	  if (c == 'x' || c == 'X')
+	    {
+	      base = 16;
+	      c = getc (stream);
+	      nread++;
+	    }
+	  else if (c == 'b' || c == 'B')
+	    {
+	      base = 2;
+	      c = getc (stream);
+	      nread++;
+	    }
+	}
+    }
+
+  /* Skip leading zeros.  */
+  while (c == '0')
+    {
+      c = getc (stream);
+      nread++;
+    }
+
+  alloc_size = 100;
+  str = (char *) (*_mp_allocate_func) (alloc_size);
+  str_size = 0;
+
+  for (;;)
+    {
+      int dig;
+      if (str_size >= alloc_size)
+	{
+	  size_t old_alloc_size = alloc_size;
+	  alloc_size = alloc_size * 3 / 2;
+	  str = (char *) (*_mp_reallocate_func) (str, old_alloc_size, alloc_size);
+	}
+      dig = digit_value_in_base (c, base);
+      if (dig < 0)
+	break;
+      str[str_size++] = dig;
+      c = getc (stream);
+    }
+
+  ungetc (c, stream);
+
+  /* Make sure the string is not empty, mpn_set_str would fail.  */
+  if (str_size == 0)
+    {
+      x->_mp_size = 0;
+      (*_mp_free_func) (str, alloc_size);
+      return nread;
+    }
+
+  xsize = (((mp_size_t) (str_size / __mp_bases[base].chars_per_bit_exactly))
+	   / BITS_PER_MP_LIMB + 2);
+  if (x->_mp_alloc < xsize)
+    _mpz_realloc (x, xsize);
+
+  /* Convert the byte array in base BASE to our bignum format.  */
+  xsize = mpn_set_str (x->_mp_d, (unsigned char *) str, str_size, base);
+  x->_mp_size = negative ? -xsize : xsize;
+
+  (*_mp_free_func) (str, alloc_size);
+  return str_size + nread;
+}
diff --git a/src/gmp/mpz/invert.c b/src/gmp/mpz/invert.c
new file mode 100644
index 000000000..749a0969f
--- /dev/null
+++ b/src/gmp/mpz/invert.c
@@ -0,0 +1,77 @@
+/* mpz_invert (inv, x, n).  Find multiplicative inverse of X in Z(N).
+   If X has an inverse, return non-zero and store inverse in INVERSE,
+   otherwise, return 0 and put garbage in INVERSE.
+
+Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_invert (mpz_ptr inverse, mpz_srcptr x, mpz_srcptr n)
+#else
+mpz_invert (inverse, x, n)
+     mpz_ptr inverse;
+     mpz_srcptr x, n;
+#endif
+{
+  mpz_t gcd, tmp;
+  mp_size_t xsize, nsize, size;
+  TMP_DECL (marker);
+
+  xsize = SIZ (x);
+  nsize = SIZ (n);
+  xsize = ABS (xsize);
+  nsize = ABS (nsize);
+  size = MAX (xsize, nsize) + 1;
+
+  /* No inverse exists if the leftside operand is 0.  Likewise, no
+     inverse exists if the mod operand is 1.  */
+  if (xsize == 0 || (nsize == 1 && (PTR (n))[0] == 1))
+    return 0;
+
+  TMP_MARK (marker);
+
+  MPZ_TMP_INIT (gcd, size);
+  MPZ_TMP_INIT (tmp, size);
+  mpz_gcdext (gcd, tmp, (mpz_ptr) 0, x, n);
+
+  /* If no inverse existed, return with an indication of that.  */
+  if (gcd->_mp_size != 1 || (gcd->_mp_d)[0] != 1)
+    {
+      TMP_FREE (marker);
+      return 0;
+    }
+
+  /* Make sure we return a positive inverse.  */
+  if (SIZ (tmp) < 0)
+    {
+      if (SIZ (n) < 0)
+	mpz_sub (inverse, tmp, n);
+      else
+	mpz_add (inverse, tmp, n);
+    }
+  else
+    mpz_set (inverse, tmp);
+
+  TMP_FREE (marker);
+  return 1;
+}
diff --git a/src/gmp/mpz/ior.c b/src/gmp/mpz/ior.c
new file mode 100644
index 000000000..0bb5a806d
--- /dev/null
+++ b/src/gmp/mpz/ior.c
@@ -0,0 +1,244 @@
+/* mpz_ior -- Logical inclusive or.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_ior (mpz_ptr res, mpz_srcptr op1, mpz_srcptr op2)
+#else
+mpz_ior (res, op1, op2)
+     mpz_ptr res;
+     mpz_srcptr op1;
+     mpz_srcptr op2;
+#endif
+{
+  mp_srcptr op1_ptr, op2_ptr;
+  mp_size_t op1_size, op2_size;
+  mp_ptr res_ptr;
+  mp_size_t res_size;
+  mp_size_t i;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  op1_size = op1->_mp_size;
+  op2_size = op2->_mp_size;
+
+  op1_ptr = op1->_mp_d;
+  op2_ptr = op2->_mp_d;
+  res_ptr = res->_mp_d;
+
+  if (op1_size >= 0)
+    {
+      if (op2_size >= 0)
+	{
+	  if (op1_size >= op2_size)
+	    {
+	      if (res->_mp_alloc < op1_size)
+		{
+		  _mpz_realloc (res, op1_size);
+		  op1_ptr = op1->_mp_d;
+		  op2_ptr = op2->_mp_d;
+		  res_ptr = res->_mp_d;
+		}
+
+	      if (res_ptr != op1_ptr)
+		MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
+			  op1_size - op2_size);
+	      for (i = op2_size - 1; i >= 0; i--)
+		res_ptr[i] = op1_ptr[i] | op2_ptr[i];
+	      res_size = op1_size;
+	    }
+	  else
+	    {
+	      if (res->_mp_alloc < op2_size)
+		{
+		  _mpz_realloc (res, op2_size);
+		  op1_ptr = op1->_mp_d;
+		  op2_ptr = op2->_mp_d;
+		  res_ptr = res->_mp_d;
+		}
+
+	      if (res_ptr != op2_ptr)
+		MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size,
+			  op2_size - op1_size);
+	      for (i = op1_size - 1; i >= 0; i--)
+		res_ptr[i] = op1_ptr[i] | op2_ptr[i];
+	      res_size = op2_size;
+	    }
+
+	  res->_mp_size = res_size;
+	  return;
+	}
+      else /* op2_size < 0 */
+	{
+	  /* Fall through to the code at the end of the function.  */
+	}
+    }
+  else
+    {
+      if (op2_size < 0)
+	{
+	  mp_ptr opx;
+	  mp_limb_t cy;
+
+	  /* Both operands are negative, so will be the result.
+	     -((-OP1) | (-OP2)) = -(~(OP1 - 1) | ~(OP2 - 1)) =
+	     = ~(~(OP1 - 1) | ~(OP2 - 1)) + 1 =
+	     = ((OP1 - 1) & (OP2 - 1)) + 1      */
+
+	  op1_size = -op1_size;
+	  op2_size = -op2_size;
+
+	  res_size = MIN (op1_size, op2_size);
+
+	  /* Possible optimization: Decrease mpn_sub precision,
+	     as we won't use the entire res of both.  */
+	  opx = (mp_ptr) TMP_ALLOC (res_size * BYTES_PER_MP_LIMB);
+	  mpn_sub_1 (opx, op1_ptr, res_size, (mp_limb_t) 1);
+	  op1_ptr = opx;
+
+	  opx = (mp_ptr) TMP_ALLOC (res_size * BYTES_PER_MP_LIMB);
+	  mpn_sub_1 (opx, op2_ptr, res_size, (mp_limb_t) 1);
+	  op2_ptr = opx;
+
+	  if (res->_mp_alloc < res_size)
+	    {
+	      _mpz_realloc (res, res_size);
+	      res_ptr = res->_mp_d;
+	      /* Don't re-read OP1_PTR and OP2_PTR.  They point to
+		 temporary space--never to the space RES->_mp_d used
+		 to point to before reallocation.  */
+	    }
+
+	  /* First loop finds the size of the result.  */
+	  for (i = res_size - 1; i >= 0; i--)
+	    if ((op1_ptr[i] & op2_ptr[i]) != 0)
+	      break;
+	  res_size = i + 1;
+
+	  if (res_size != 0)
+	    {
+	      /* Second loop computes the real result.  */
+	      for (i = res_size - 1; i >= 0; i--)
+		res_ptr[i] = op1_ptr[i] & op2_ptr[i];
+
+	      cy = mpn_add_1 (res_ptr, res_ptr, res_size, (mp_limb_t) 1);
+	      if (cy)
+		{
+		  res_ptr[res_size] = cy;
+		  res_size++;
+		}
+	    }
+	  else
+	    {
+	      res_ptr[0] = 1;
+	      res_size = 1;
+	    }
+
+	  res->_mp_size = -res_size;
+	  TMP_FREE (marker);
+	  return;
+	}
+      else
+	{
+	  /* We should compute -OP1 | OP2.  Swap OP1 and OP2 and fall
+	     through to the code that handles OP1 | -OP2.  */
+          MPZ_SRCPTR_SWAP (op1, op2);
+          MPN_SRCPTR_SWAP (op1_ptr,op1_size, op2_ptr,op2_size);
+	}
+    }
+
+  {
+    mp_ptr opx;
+    mp_limb_t cy;
+    mp_size_t res_alloc;
+    mp_size_t count;
+
+    /* Operand 2 negative, so will be the result.
+       -(OP1 | (-OP2)) = -(OP1 | ~(OP2 - 1)) =
+       = ~(OP1 | ~(OP2 - 1)) + 1 =
+       = (~OP1 & (OP2 - 1)) + 1      */
+
+    op2_size = -op2_size;
+
+    res_alloc = op2_size;
+
+    opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
+    mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
+    op2_ptr = opx;
+    op2_size -= op2_ptr[op2_size - 1] == 0;
+
+    if (res->_mp_alloc < res_alloc)
+      {
+	_mpz_realloc (res, res_alloc);
+	op1_ptr = op1->_mp_d;
+	res_ptr = res->_mp_d;
+	/* Don't re-read OP2_PTR.  It points to temporary space--never
+	   to the space RES->_mp_d used to point to before reallocation.  */
+      }
+
+    if (op1_size >= op2_size)
+      {
+	/* We can just ignore the part of OP1 that stretches above OP2,
+	   because the result limbs are zero there.  */
+
+	/* First loop finds the size of the result.  */
+	for (i = op2_size - 1; i >= 0; i--)
+	  if ((~op1_ptr[i] & op2_ptr[i]) != 0)
+	    break;
+	res_size = i + 1;
+	count = res_size;
+      }
+    else
+      {
+	res_size = op2_size;
+
+	/* Copy the part of OP2 that stretches above OP1, to RES.  */
+	MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size, op2_size - op1_size);
+	count = op1_size;
+      }
+
+    if (res_size != 0)
+      {
+	/* Second loop computes the real result.  */
+	for (i = count - 1; i >= 0; i--)
+	  res_ptr[i] = ~op1_ptr[i] & op2_ptr[i];
+
+	cy = mpn_add_1 (res_ptr, res_ptr, res_size, (mp_limb_t) 1);
+	if (cy)
+	  {
+	    res_ptr[res_size] = cy;
+	    res_size++;
+	  }
+      }
+    else
+      {
+	res_ptr[0] = 1;
+	res_size = 1;
+      }
+
+    res->_mp_size = -res_size;
+  }
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/iset.c b/src/gmp/mpz/iset.c
new file mode 100644
index 000000000..114bc2d54
--- /dev/null
+++ b/src/gmp/mpz/iset.c
@@ -0,0 +1,49 @@
+/* mpz_init_set (src_integer) -- Make a new multiple precision number with
+   a value copied from SRC_INTEGER.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_init_set (mpz_ptr w, mpz_srcptr u)
+#else
+mpz_init_set (w, u)
+     mpz_ptr w;
+     mpz_srcptr u;
+#endif
+{
+  mp_ptr wp, up;
+  mp_size_t usize, size;
+
+  usize = u->_mp_size;
+  size = ABS (usize);
+
+  w->_mp_alloc = MAX (size, 1);
+  w->_mp_d = (mp_ptr) (*_mp_allocate_func) (w->_mp_alloc * BYTES_PER_MP_LIMB);
+
+  wp = w->_mp_d;
+  up = u->_mp_d;
+
+  MPN_COPY (wp, up, size);
+  w->_mp_size = usize;
+}
diff --git a/src/gmp/mpz/iset_d.c b/src/gmp/mpz/iset_d.c
new file mode 100644
index 000000000..502a8933e
--- /dev/null
+++ b/src/gmp/mpz/iset_d.c
@@ -0,0 +1,39 @@
+/* mpz_init_set_d(integer, val) -- Initialize and assign INTEGER with a double
+   value VAL.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_init_set_d (mpz_ptr dest, double val)
+#else
+mpz_init_set_d (dest, val)
+     mpz_ptr dest;
+     double val;
+#endif
+{
+  dest->_mp_alloc = 1;
+  dest->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
+  dest->_mp_size = 0;
+  mpz_set_d (dest, val);
+}
diff --git a/src/gmp/mpz/iset_si.c b/src/gmp/mpz/iset_si.c
new file mode 100644
index 000000000..842db140e
--- /dev/null
+++ b/src/gmp/mpz/iset_si.c
@@ -0,0 +1,49 @@
+/* mpz_init_set_si(val) -- Make a new multiple precision number with
+   value val.
+
+Copyright (C) 1991, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_init_set_si (mpz_ptr x, signed long int val)
+#else
+mpz_init_set_si (x, val)
+     mpz_ptr x;
+     signed long int val;
+#endif
+{
+  x->_mp_alloc = 1;
+  x->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
+  if (val > 0)
+    {
+      x->_mp_d[0] = val;
+      x->_mp_size = 1;
+    }
+  else if (val < 0)
+    {
+      x->_mp_d[0] = (unsigned long) -val;
+      x->_mp_size = -1;
+    }
+  else
+    x->_mp_size = 0;
+}
diff --git a/src/gmp/mpz/iset_str.c b/src/gmp/mpz/iset_str.c
new file mode 100644
index 000000000..dfb8c6b23
--- /dev/null
+++ b/src/gmp/mpz/iset_str.c
@@ -0,0 +1,47 @@
+/* mpz_init_set_str(string, base) -- Convert the \0-terminated string
+   STRING in base BASE to a multiple precision integer.  Return a MP_INT
+   structure representing the integer.  Allow white space in the
+   string.  If BASE == 0 determine the base in the C standard way,
+   i.e.  0xhh...h means base 16, 0oo...o means base 8, otherwise
+   assume base 10.
+
+Copyright (C) 1991, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_init_set_str (mpz_ptr x, const char *str, int base)
+#else
+mpz_init_set_str (x, str, base)
+     mpz_ptr x;
+     const char *str;
+     int base;
+#endif
+{
+  x->_mp_alloc = 1;
+  x->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
+
+  /* if str has no digits mpz_set_str leaves x->_mp_size unset */
+  x->_mp_size = 0;
+
+  return mpz_set_str (x, str, base);
+}
diff --git a/src/gmp/mpz/iset_ui.c b/src/gmp/mpz/iset_ui.c
new file mode 100644
index 000000000..759182c55
--- /dev/null
+++ b/src/gmp/mpz/iset_ui.c
@@ -0,0 +1,39 @@
+/* mpz_init_set_ui(val) -- Make a new multiple precision number with
+   value val.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_init_set_ui (mpz_ptr x, unsigned long int val)
+#else
+mpz_init_set_ui (x, val)
+     mpz_ptr x;
+     unsigned long int val;
+#endif
+{
+  x->_mp_alloc = 1;
+  x->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
+  x->_mp_d[0] = val;
+  x->_mp_size = val != 0;
+}
diff --git a/src/gmp/mpz/jacobi.c b/src/gmp/mpz/jacobi.c
new file mode 100644
index 000000000..9d49e1d0c
--- /dev/null
+++ b/src/gmp/mpz/jacobi.c
@@ -0,0 +1,53 @@
+/* mpz_jacobi (op1, op2).
+   Contributed by Bennet Yee (bsy) at Carnegie-Mellon University
+
+Copyright (C) 1991, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+
+/* Precondition:  both p and q are positive */
+
+int
+#if	__STDC__
+mpz_jacobi (mpz_srcptr pi, mpz_srcptr qi)
+#else
+mpz_jacobi (pi, qi)
+     mpz_srcptr pi, qi;
+#endif
+{
+#if GCDCHECK
+  int retval;
+  mpz_t gcdval;
+
+  mpz_init (gcdval);
+  mpz_gcd (gcdval, pi, qi);
+  if (!mpz_cmp_ui (gcdval, 1L))
+    {
+      /* J(ab,cb) = J(ab,c)J(ab,b) = J(ab,c)J(0,b) = J(ab,c)*0 */
+      retval = 0;
+    }
+  else
+    retval = mpz_legendre (pi, qi);
+  mpz_clear (gcdval);
+  return retval;
+#else
+  return mpz_legendre (pi, qi);
+#endif
+}
diff --git a/src/gmp/mpz/kronsz.c b/src/gmp/mpz/kronsz.c
new file mode 100644
index 000000000..c8c675222
--- /dev/null
+++ b/src/gmp/mpz/kronsz.c
@@ -0,0 +1,126 @@
+/* mpz_si_kronecker -- Kronecker/Jacobi symbol. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+int
+#if __STDC__
+mpz_si_kronecker (long a, mpz_srcptr b)
+#else
+mpz_si_kronecker (a, b)
+     long       a;
+     mpz_srcptr b;
+#endif
+{
+  int        b_abs_size;
+  mp_srcptr  b_ptr;
+  mp_limb_t  b_low;
+  int        twos;
+  int        result_bit1;
+
+  b_abs_size = ABSIZ (b);
+  if (b_abs_size == 0)
+    return JACOBI_S0 (a);  /* (a/0) */
+
+  b_ptr = PTR(b);
+  b_low = b_ptr[0];
+
+  /* (0/b) = 1 if b=+/-1, 0 otherwise */
+  if (a == 0)
+    return (b_abs_size == 1) & (b_low == 1);
+
+  /* account for the effect of the sign of b, so can then ignore it */
+  result_bit1 = JACOBI_BSGN_SZ_BIT1 (a, b);
+
+  if ((b_low & 1) == 0)
+    {
+      /* b even */
+
+      if ((a & 1) == 0)
+        return 0;  /* (a/b)=0 if both a,b even */
+
+      /* Require MP_BITS_PER_LIMB even, so that (a/2)^MP_BITS_PER_LIMB = 1,
+         and so that therefore there's no need to account for how many zero
+         limbs are stripped.  */
+      ASSERT ((BITS_PER_MP_LIMB & 1) == 0);
+
+      MPN_STRIP_LOW_ZEROS_NOT_ZERO (b_ptr, b_abs_size);
+      b_low = b_ptr[0];
+
+      if ((b_low & 1) == 0)
+        {
+          /* odd a, even b */
+
+          mp_limb_t  b_shl_bit1;
+
+          count_trailing_zeros (twos, b_low);
+
+          /* b_shl_bit1 is b>>twos, but with only bit 1 guaranteed */
+          if (twos == BITS_PER_MP_LIMB-1)
+            b_shl_bit1 = (b_abs_size == 1) ? 0 : (b_ptr[1] << 1);
+          else
+            b_shl_bit1 = (b_low >> twos);
+
+          result_bit1 ^= JACOBI_ASGN_SU_BIT1 (a, b_shl_bit1);
+          a = ABS(a);
+
+          if (a == 1)
+            return JACOBI_BIT1_TO_PN (result_bit1);  /* (1/b)=1 */
+
+          /* twos (a/2), reciprocity to (b/a), and (b/a) = (b mod a / b) */
+          return mpn_jacobi_base (mpn_mod_1_rshift (b_ptr, b_abs_size,
+                                                    twos, a),
+                                  a,
+                                  result_bit1
+                                  ^ JACOBI_TWOS_U_BIT1 (twos, a)
+                                  ^ JACOBI_RECIP_UU_BIT1 (a, b_shl_bit1));
+        }
+    }
+
+  /* b odd */
+
+  result_bit1 ^= JACOBI_ASGN_SU_BIT1 (a, b_low);
+  a = ABS(a);
+
+  /* (a/1) = 1 for any a */
+  if (b_abs_size == 1 && b_low == 1)
+    return JACOBI_BIT1_TO_PN (result_bit1);
+
+  /* Note a is cast to unsigned because 0x80..00 doesn't fit in a signed. */
+  if ((a & 1) == 0)
+    {
+      count_trailing_zeros (twos, a);
+      a = ((unsigned long) a) >> twos;
+      result_bit1 ^= JACOBI_TWOS_U_BIT1 (twos, b_low);
+    }
+
+  if (a == 1)
+    return JACOBI_BIT1_TO_PN (result_bit1);  /* (1/b)=1 */
+
+  /* reciprocity to (b/a), and (b/a) == (b mod a / a) */
+  return mpn_jacobi_base (mpn_mod_1 (b_ptr, b_abs_size, a), a,
+                          result_bit1 ^ JACOBI_RECIP_UU_BIT1 (a, b_low));
+}
diff --git a/src/gmp/mpz/kronuz.c b/src/gmp/mpz/kronuz.c
new file mode 100644
index 000000000..b877e6f64
--- /dev/null
+++ b/src/gmp/mpz/kronuz.c
@@ -0,0 +1,115 @@
+/* mpz_ui_kronecker -- Kronecker/Jacobi symbol. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+int
+#if __STDC__
+mpz_ui_kronecker (unsigned long a, mpz_srcptr b)
+#else
+mpz_ui_kronecker (a, b)
+     unsigned long a;
+     mpz_srcptr    b;
+#endif
+{
+  int        b_abs_size;
+  mp_srcptr  b_ptr;
+  mp_limb_t  b_low;
+  int        twos;
+  int        result_bit1;
+
+  /* (a/0) */
+  b_abs_size = ABSIZ (b);
+  if (b_abs_size == 0)
+    return JACOBI_U0 (a);
+
+  /* (a/-1)=1 when a>=0, so the sign of b is ignored */
+  b_ptr = PTR(b);
+  b_low = b_ptr[0];
+
+  /* (0/1)=1; (0/-1)=1; (0/b)=0 for b!=+/-1
+     (1/b)=1, for any b */
+  if (a <= 1)
+    return (a == 1) | ((b_abs_size == 1) & (b_low == 1));
+
+  if (b_low & 1)
+    {
+      /* (a/1) = 1 for any a */
+      if (b_abs_size == 1 && b_low == 1)
+        return 1;
+
+      count_trailing_zeros (twos, a);
+      a >>= twos;
+      if (a == 1)
+        return JACOBI_TWOS_U (twos, b_low);  /* powers of (2/b) only */
+
+      /* powers of (2/b); reciprocity to (b/a); (b/a) == (b mod a / a) */
+      return mpn_jacobi_base (mpn_mod_1 (b_ptr, b_abs_size, a),
+                              a,
+                              JACOBI_TWOS_U_BIT1 (twos, b_low)
+                              ^ JACOBI_RECIP_UU_BIT1 (b_low, a));
+    }
+
+  /* b is even; (a/2)=0 if a is even */
+  if ((a & 1) == 0)
+    return 0;
+
+  /* Require MP_BITS_PER_LIMB even, so (a/2)^MP_BITS_PER_LIMB = 1, and so we
+     don't have to pay attention to how many trailing zero limbs are
+     stripped.  */
+  ASSERT ((BITS_PER_MP_LIMB & 1) == 0);
+
+  MPN_STRIP_LOW_ZEROS_NOT_ZERO (b_ptr, b_abs_size);
+  b_low = b_ptr[0];
+
+  if (b_low & 1)
+    /* reciprocity to (b/a); (b/a) == (b mod a / a) */
+    return mpn_jacobi_base (mpn_mod_1 (b_ptr, b_abs_size, a),
+                            a,
+                            JACOBI_RECIP_UU_BIT1 (b_low, a));
+
+  count_trailing_zeros (twos, b_low);
+
+  /* reciprocity to get (b/a) */
+  if (twos == BITS_PER_MP_LIMB-1)
+    {
+      if (b_abs_size == 1)
+        {
+          /* b==0x800...00, one limb high bit only, so (a/2)^(BPML-1) */
+          return JACOBI_TWOS_U (BITS_PER_MP_LIMB-1, a);
+        }
+
+      /* b_abs_size > 1 */
+      result_bit1 = JACOBI_RECIP_UU_BIT1 (a, b_ptr[1] << 1);
+    }
+  else
+    result_bit1 = JACOBI_RECIP_UU_BIT1 (a, b_low >> twos);
+
+  /* powers of (a/2); reciprocity to (b/a); (b/a) == (b mod a / a) */
+  return mpn_jacobi_base (mpn_mod_1_rshift (b_ptr, b_abs_size, twos, a),
+                          a,
+                          JACOBI_TWOS_U_BIT1 (twos, a) ^ result_bit1);
+}
diff --git a/src/gmp/mpz/kronzs.c b/src/gmp/mpz/kronzs.c
new file mode 100644
index 000000000..edfb46597
--- /dev/null
+++ b/src/gmp/mpz/kronzs.c
@@ -0,0 +1,74 @@
+/* mpz_kronecker_si -- Kronecker/Jacobi symbol. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+/* This function is expected to be often used with b odd, so there's a test
+   for this before invoking count_trailing_zeros().
+
+   After the absolute value of b is established it's treated as an unsigned
+   long, because 0x80..00 doesn't fit in a signed long. */
+
+int
+#if __STDC__
+mpz_kronecker_si (mpz_srcptr a, long b)
+#else
+mpz_kronecker_si (a, b)
+     mpz_srcptr a;
+     long       b;
+#endif
+{
+  int  result_bit1;
+  int  twos;
+
+  if (b == 0)
+    return JACOBI_Z0 (a);
+
+  result_bit1 = JACOBI_BSGN_ZS_BIT1(a, b);
+  b = ABS (b);
+
+  if (b == 1)
+    return JACOBI_BIT1_TO_PN (result_bit1);  /* (a/1) = 1 for any a */
+
+  if (b & 1) 
+    return mpn_jacobi_base (mpz_fdiv_ui (a, b), b, result_bit1);
+      
+  /* result 0 if both a,b even */
+  if (mpz_even_p (a))
+    return 0;
+
+  /* (a/2)=(2/a) when a odd */
+  count_trailing_zeros (twos, b);
+  result_bit1 ^= JACOBI_TWOS_U_BIT1 (twos, PTR(a)[0]);
+
+  b = ((unsigned long) b) >> twos;
+  if (b == 1)
+    return JACOBI_BIT1_TO_PN (result_bit1);
+  else
+    return mpn_jacobi_base (mpz_fdiv_ui (a, b), b, result_bit1);
+}
+
+
diff --git a/src/gmp/mpz/kronzu.c b/src/gmp/mpz/kronzu.c
new file mode 100644
index 000000000..749be5df0
--- /dev/null
+++ b/src/gmp/mpz/kronzu.c
@@ -0,0 +1,66 @@
+/* mpz_kronecker_ui -- Kronecker/Jacobi symbol. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+/* This function is expected to be often used with b an odd prime, so the
+   code for odd b is nice and short. */
+
+int
+#if __STDC__
+mpz_kronecker_ui (mpz_srcptr a, unsigned long b)
+#else
+mpz_kronecker_ui (a, b)
+     mpz_srcptr    a;
+     unsigned long b;
+#endif
+{
+  int  twos;
+
+  if (b & 1)
+    {
+      if (b != 1)
+        return mpn_jacobi_base (mpz_fdiv_ui (a, b), b, 0);
+      else
+        return 1;  /* (a/1)=1 for any a */
+    }
+
+  if (b == 0)
+    return JACOBI_Z0 (a);
+
+  /* (a/2)=0 if a even */
+  if (mpz_even_p (a))
+    return 0;
+
+  /* (a/2)=(2/a) when a odd */
+  count_trailing_zeros (twos, b);  
+  b >>= twos;
+  if (b == 1)
+    return JACOBI_TWOS_U (twos, PTR(a)[0]);
+
+  return mpn_jacobi_base (mpz_fdiv_ui (a, b), b,
+                          JACOBI_TWOS_U_BIT1(twos, PTR(a)[0]));
+}
diff --git a/src/gmp/mpz/lcm.c b/src/gmp/mpz/lcm.c
new file mode 100644
index 000000000..ca8c15cac
--- /dev/null
+++ b/src/gmp/mpz/lcm.c
@@ -0,0 +1,56 @@
+/* mpz/lcm.c:   Calculate the least common multiple of two integers.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void *_mpz_realloc ();
+
+void
+#if __STDC__
+mpz_lcm (mpz_ptr r, mpz_srcptr u, mpz_srcptr v)
+#else
+mpz_lcm (r, u, v)
+     mpz_ptr r;
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+{
+  mpz_t g;
+  mp_size_t usize, vsize, size;
+
+  usize = ABS (SIZ (u));
+  vsize = ABS (SIZ (v));
+
+  if (usize == 0 || vsize == 0)
+    {
+      SIZ (r) = 0;
+      return;
+    }
+
+  size = MAX (usize, vsize);
+  MPZ_TMP_INIT (g, size);
+
+  mpz_gcd (g, u, v);
+  mpz_divexact (g, u, g);
+  mpz_mul (r, g, v);
+}
diff --git a/src/gmp/mpz/legendre.c b/src/gmp/mpz/legendre.c
new file mode 100644
index 000000000..ab665f70d
--- /dev/null
+++ b/src/gmp/mpz/legendre.c
@@ -0,0 +1,184 @@
+/* mpz_legendre (op1, op2).
+   Contributed by Bennet Yee (bsy) at Carnegie-Mellon University
+
+Copyright (C) 1992, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+
+#if defined (DEBUG)
+#include <stdio.h>
+#endif
+
+/* Precondition:  both p and q are positive */
+
+int
+#if __STDC__
+mpz_legendre (mpz_srcptr pi, mpz_srcptr qi)
+#else
+mpz_legendre (pi, qi)
+mpz_srcptr pi, qi;
+#endif
+{
+  mpz_t p, q, qdiv2;
+#ifdef Q_MINUS_1
+  mpz_t q_minus_1;
+#endif
+  mpz_ptr mtmp;
+  register mpz_ptr pptr, qptr;
+  register int retval = 1;
+  register unsigned long int s;
+
+  pptr = p;
+  mpz_init_set (pptr, pi);
+  qptr = q;
+  mpz_init_set (qptr, qi);
+
+#ifdef Q_MINUS_1
+  mpz_init (q_minus_1);
+#endif
+  mpz_init (qdiv2);
+
+tail_recurse2:
+#ifdef DEBUG
+  printf ("tail_recurse2: p=");
+  mpz_out_str (stdout, 10, pptr);
+  printf ("\nq=");
+  mpz_out_str (stdout, 10, qptr);
+  putchar ('\n');
+#endif
+  s = mpz_scan1 (qptr, 0);
+  if (s) mpz_tdiv_q_2exp (qptr, qptr, s); /* J(a,2) = 1 */
+#ifdef DEBUG
+  printf ("2 factor decomposition: p=");
+  mpz_out_str (stdout, 10, pptr);
+  printf ("\nq=");
+  mpz_out_str (stdout, 10, qptr);
+  putchar ('\n');
+#endif
+  /* postcondition q odd */
+  if (!mpz_cmp_ui (qptr, 1L))  /* J(a,1) = 1 */
+    goto done;
+  mpz_mod (pptr, pptr, qptr); /* J(a,q) = J(b,q) when a == b mod q */
+#ifdef DEBUG
+  printf ("mod out by q: p=");
+  mpz_out_str (stdout, 10, pptr);
+  printf ("\nq=");
+  mpz_out_str (stdout, 10, qptr);
+  putchar ('\n');
+#endif
+  /* quick calculation to get approximate size first */
+  /* precondition: p < q */
+  if ((mpz_sizeinbase (pptr, 2) + 1 >= mpz_sizeinbase (qptr,2))
+      && (mpz_tdiv_q_2exp (qdiv2, qptr, 1L), mpz_cmp (pptr, qdiv2) > 0))
+    {
+      /* p > q/2 */
+      mpz_sub (pptr, qptr, pptr);
+      /* J(-1,q) = (-1)^((q-1)/2), q odd */
+      if (mpz_get_ui (qptr) & 2)
+	retval = -retval;
+    }
+  /* p < q/2 */
+#ifdef Q_MINUS_1
+  mpz_sub_ui (q_minus_q, qptr, 1L);
+#endif
+tail_recurse: /* we use tail_recurse only if q has not changed */
+#ifdef DEBUG
+  printf ("tail_recurse1: p=");
+  mpz_out_str (stdout, 10, pptr);
+  printf ("\nq=");
+  mpz_out_str (stdout, 10, qptr);
+  putchar ('\n');
+#endif
+  /*
+   * J(0,q) = 0
+   * this occurs only if gcd(p,q) != 1 which is never true for
+   * Legendre function.
+   */
+  if (!mpz_cmp_ui (pptr, 0L))
+    {
+      retval = 0;
+      goto done;
+    }
+
+  if (!mpz_cmp_ui (pptr, 1L))
+    {
+      /* J(1,q) = 1 */
+      /* retval *= 1; */
+      goto done;
+    }
+#ifdef Q_MINUS_1
+  if (!mpz_cmp (pptr, q_minus_1))
+    {
+      /* J(-1,q) = (-1)^((q-1)/2) */
+      if (mpz_get_ui (qptr) & 2)
+	retval = -retval;
+      /* else    retval *= 1; */
+      goto done;
+    }
+#endif
+  /*
+   * we do not handle J(xy,q) except for x==2
+   * since we do not want to factor
+   */
+  if ((s = mpz_scan1 (pptr, 0)) != 0)
+    {
+      /*
+       * J(2,q) = (-1)^((q^2-1)/8)
+       *
+       * Note that q odd guarantees that q^2-1 is divisible by 8:
+       * Let a: q=2a+1.  q^2 = 4a^2+4a+1, (q^2-1)/8 = a(a+1)/2, qed
+       *
+       * Now, note that this means that the low two bits of _a_
+       * (or the low bits of q shifted over by 1 determines
+       * the factor).
+       */
+      mpz_tdiv_q_2exp (pptr, pptr, s);
+
+      /* even powers of 2 gives J(2,q)^{2n} = 1 */
+      if (s & 1)
+	{
+	  s = mpz_get_ui (qptr) >> 1;
+	  s = s * (s + 1);
+	  if (s & 2)
+	    retval = -retval;
+	}
+      goto tail_recurse;
+    }
+  /*
+   * we know p is odd since we have cast out 2s
+   * precondition that q is odd guarantees both odd.
+   *
+   * quadratic reciprocity
+   * J(p,q) = (-1)^((p-1)(q-1)/4) * J(q,p)
+   */
+  if ((s = mpz_scan1 (pptr, 1)) <= 2 && (s + mpz_scan1 (qptr, 1)) <= 2)
+    retval = -retval;
+
+  mtmp = pptr; pptr = qptr; qptr = mtmp;
+  goto tail_recurse2;
+done:
+  mpz_clear (p);
+  mpz_clear (q);
+  mpz_clear (qdiv2);
+#ifdef Q_MINUS_1
+  mpz_clear (q_minus_1);
+#endif
+  return retval;
+}
diff --git a/src/gmp/mpz/mod.c b/src/gmp/mpz/mod.c
new file mode 100644
index 000000000..87033b333
--- /dev/null
+++ b/src/gmp/mpz/mod.c
@@ -0,0 +1,63 @@
+/* mpz_mod -- The mathematical mod function.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_mod (mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
+#else
+mpz_mod (rem, dividend, divisor)
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     mpz_srcptr divisor;
+#endif
+{
+  mp_size_t divisor_size = divisor->_mp_size;
+  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  /* We need the original value of the divisor after the remainder has been
+     preliminary calculated.  We have to copy it to temporary space if it's
+     the same variable as REM.  */
+  if (rem == divisor)
+    {
+      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
+      mpz_set (temp_divisor, divisor);
+      divisor = temp_divisor;
+    }
+
+  mpz_tdiv_r (rem, dividend, divisor);
+
+  if (rem->_mp_size != 0)
+    {
+      if (dividend->_mp_size < 0)
+	if (divisor->_mp_size < 0)
+	  mpz_sub (rem, rem, divisor);
+	else
+	  mpz_add (rem, rem, divisor);
+    }
+
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/mul.c b/src/gmp/mpz/mul.c
new file mode 100644
index 000000000..7854788e5
--- /dev/null
+++ b/src/gmp/mpz/mul.c
@@ -0,0 +1,131 @@
+/* mpz_mul -- Multiply two integers.
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+#ifdef BERKELEY_MP
+#include "mp.h"
+#endif
+
+#ifndef BERKELEY_MP
+void
+#if __STDC__
+mpz_mul (mpz_ptr w, mpz_srcptr u, mpz_srcptr v)
+#else
+mpz_mul (w, u, v)
+     mpz_ptr w;
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+#else /* BERKELEY_MP */
+void
+#if __STDC__
+mult (mpz_srcptr u, mpz_srcptr v, mpz_ptr w)
+#else
+mult (u, v, w)
+     mpz_srcptr u;
+     mpz_srcptr v;
+     mpz_ptr w;
+#endif
+#endif /* BERKELEY_MP */
+{
+  mp_size_t usize = u->_mp_size;
+  mp_size_t vsize = v->_mp_size;
+  mp_size_t wsize;
+  mp_size_t sign_product;
+  mp_ptr up, vp;
+  mp_ptr wp;
+  mp_ptr free_me = NULL;
+  size_t free_me_size;
+  mp_limb_t cy_limb;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  sign_product = usize ^ vsize;
+  usize = ABS (usize);
+  vsize = ABS (vsize);
+
+  if (usize < vsize)
+    {
+      /* Swap U and V.  */
+      {const __mpz_struct *t = u; u = v; v = t;}
+      {mp_size_t t = usize; usize = vsize; vsize = t;}
+    }
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+  wp = w->_mp_d;
+
+  /* Ensure W has space enough to store the result.  */
+  wsize = usize + vsize;
+  if (w->_mp_alloc < wsize)
+    {
+      if (wp == up || wp == vp)
+	{
+	  free_me = wp;
+	  free_me_size = w->_mp_alloc;
+	}
+      else
+	(*_mp_free_func) (wp, w->_mp_alloc * BYTES_PER_MP_LIMB);
+
+      w->_mp_alloc = wsize;
+      wp = (mp_ptr) (*_mp_allocate_func) (wsize * BYTES_PER_MP_LIMB);
+      w->_mp_d = wp;
+    }
+  else
+    {
+      /* Make U and V not overlap with W.  */
+      if (wp == up)
+	{
+	  /* W and U are identical.  Allocate temporary space for U.  */
+	  up = (mp_ptr) TMP_ALLOC (usize * BYTES_PER_MP_LIMB);
+	  /* Is V identical too?  Keep it identical with U.  */
+	  if (wp == vp)
+	    vp = up;
+	  /* Copy to the temporary space.  */
+	  MPN_COPY (up, wp, usize);
+	}
+      else if (wp == vp)
+	{
+	  /* W and V are identical.  Allocate temporary space for V.  */
+	  vp = (mp_ptr) TMP_ALLOC (vsize * BYTES_PER_MP_LIMB);
+	  /* Copy to the temporary space.  */
+	  MPN_COPY (vp, wp, vsize);
+	}
+    }
+
+  if (vsize == 0)
+    {
+      wsize = 0;
+    }
+  else
+    {
+      cy_limb = mpn_mul (wp, up, usize, vp, vsize);
+      wsize = usize + vsize;
+      wsize -= cy_limb == 0;
+    }
+
+  w->_mp_size = sign_product < 0 ? -wsize : wsize;
+  if (free_me != NULL)
+    (*_mp_free_func) (free_me, free_me_size * BYTES_PER_MP_LIMB);
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/mul_2exp.c b/src/gmp/mpz/mul_2exp.c
new file mode 100644
index 000000000..abea5fed2
--- /dev/null
+++ b/src/gmp/mpz/mul_2exp.c
@@ -0,0 +1,76 @@
+/* mpz_mul_2exp -- Multiply a bignum by 2**CNT
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_mul_2exp (mpz_ptr w, mpz_srcptr u, unsigned long int cnt)
+#else
+mpz_mul_2exp (w, u, cnt)
+     mpz_ptr w;
+     mpz_srcptr u;
+     unsigned long int cnt;
+#endif
+{
+  mp_size_t usize = u->_mp_size;
+  mp_size_t abs_usize = ABS (usize);
+  mp_size_t wsize;
+  mp_size_t limb_cnt;
+  mp_ptr wp;
+  mp_limb_t wlimb;
+
+  if (usize == 0)
+    {
+      w->_mp_size = 0;
+      return;
+    }
+
+  limb_cnt = cnt / BITS_PER_MP_LIMB;
+  wsize = abs_usize + limb_cnt + 1;
+  if (w->_mp_alloc < wsize)
+    _mpz_realloc (w, wsize);
+
+  wp = w->_mp_d;
+  wsize = abs_usize + limb_cnt;
+
+  cnt %= BITS_PER_MP_LIMB;
+  if (cnt != 0)
+    {
+      wlimb = mpn_lshift (wp + limb_cnt, u->_mp_d, abs_usize, cnt);
+      if (wlimb != 0)
+	{
+	  wp[wsize] = wlimb;
+	  wsize++;
+	}
+    }
+  else
+    {
+      MPN_COPY_DECR (wp + limb_cnt, u->_mp_d, abs_usize);
+    }
+
+  /* Zero all whole limbs at low end.  Do it here and not before calling
+     mpn_lshift, not to lose for U == W.  */
+  MPN_ZERO (wp, limb_cnt);
+
+  w->_mp_size = usize >= 0 ? wsize : -wsize;
+}
diff --git a/src/gmp/mpz/mul_siui.c b/src/gmp/mpz/mul_siui.c
new file mode 100644
index 000000000..9849cd41b
--- /dev/null
+++ b/src/gmp/mpz/mul_siui.c
@@ -0,0 +1,81 @@
+/* mpz_mul_ui/si (product, multiplier, small_multiplicand) -- Set PRODUCT to
+   MULTIPLICATOR times SMALL_MULTIPLICAND.
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+#ifdef OPERATION_mul_ui
+#define FUNCTION              mpz_mul_ui
+#define MULTIPLICAND_UNSIGNED unsigned
+#define MULTIPLICAND_ABS(x)   x
+#else
+#ifdef OPERATION_mul_si
+#define FUNCTION              mpz_mul_si
+#define MULTIPLICAND_UNSIGNED
+#define MULTIPLICAND_ABS(x)   ABS(x)
+#else
+Error, error, unrecognised OPERATION
+#endif
+#endif
+
+
+void
+#if __STDC__
+FUNCTION (mpz_ptr prod, mpz_srcptr mult,
+          MULTIPLICAND_UNSIGNED long int small_mult)
+#else
+FUNCTION (prod, mult, small_mult)
+     mpz_ptr prod;
+     mpz_srcptr mult;
+     MULTIPLICAND_UNSIGNED long int small_mult;
+#endif
+{
+  mp_size_t size = mult->_mp_size;
+  mp_size_t sign_product = size;
+  mp_limb_t cy;
+  mp_size_t prod_size;
+  mp_ptr prod_ptr;
+
+  if (size == 0 || small_mult == 0)
+    {
+      prod->_mp_size = 0;
+      return;
+    }
+  size = ABS (size);
+
+  prod_size = size + 1;
+  if (prod->_mp_alloc < prod_size)
+    _mpz_realloc (prod, prod_size);
+
+  prod_ptr = prod->_mp_d;
+
+  cy = mpn_mul_1 (prod_ptr, mult->_mp_d, size,
+                  (mp_limb_t) MULTIPLICAND_ABS (small_mult));
+  if (cy != 0)
+    {
+      prod_ptr[size] = cy;
+      size++;
+    }
+
+  prod->_mp_size = ((sign_product < 0) ^ (small_mult < 0)) ? -size : size;
+}
diff --git a/src/gmp/mpz/neg.c b/src/gmp/mpz/neg.c
new file mode 100644
index 000000000..566c3a95a
--- /dev/null
+++ b/src/gmp/mpz/neg.c
@@ -0,0 +1,53 @@
+/* mpz_neg(mpz_ptr dst, mpz_ptr src) -- Assign the negated value of SRC to DST.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_neg (mpz_ptr w, mpz_srcptr u)
+#else
+mpz_neg (w, u)
+     mpz_ptr w;
+     mpz_srcptr u;
+#endif
+{
+  mp_ptr wp, up;
+  mp_size_t usize, size;
+
+  usize = u->_mp_size;
+
+  if (u != w)
+    {
+      size = ABS (usize);
+
+      if (w->_mp_alloc < size)
+	_mpz_realloc (w, size);
+
+      wp = w->_mp_d;
+      up = u->_mp_d;
+
+      MPN_COPY (wp, up, size);
+    }
+
+  w->_mp_size = -usize;
+}
diff --git a/src/gmp/mpz/nextprime.c b/src/gmp/mpz/nextprime.c
new file mode 100644
index 000000000..f024dd120
--- /dev/null
+++ b/src/gmp/mpz/nextprime.c
@@ -0,0 +1,120 @@
+/* mpz_nextprime(p,t) - compute the next prime > t and store that in p.
+
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_nextprime (mpz_ptr p, mpz_srcptr t)
+#else
+mpz_nextprime (p, t)
+     mpz_ptr    p;
+     mpz_srcptr t;
+#endif
+{
+  mpz_add_ui (p, t, 1L);
+  while (! mpz_probab_prime_p (p, 5))
+    mpz_add_ui (p, p, 1L);
+}
+
+#if 0
+/* This code is not yet tested.  Will be enabled in 3.1. */
+
+status unsigned short primes[] =
+{
+3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,
+101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,
+191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,
+281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,
+389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,
+491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,
+607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,
+719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,
+829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,
+953,967,971,977,983,991,997
+};
+
+#define NUMBER_OF_PRIMES 167
+
+void
+#if __STDC__
+mpz_nextprime (mpz_ptr p, mpz_srcptr n)
+#else
+mpz_nextprime (p, n)
+     mpz_ptr p;
+     mpz_srcptr n;
+#endif
+{
+  mpz_t tmp;
+  unsigned short *moduli;
+  unsigned long difference;
+  int i;
+  int composite;
+
+  /* First handle tiny numbers */
+  if (mpz_cmp_ui (n, 2) < 0)
+    {
+      mpz_set_ui (p, 2);
+      return;
+    }
+  mpz_add_ui (p, n, 1);
+  mpz_setbit (p, 0);
+
+  if (mpz_cmp_ui (p, 7) <= 0)
+    return;
+
+  prime_limit = NUMBER_OF_PRIMES - 1;
+  if (mpz_cmp_ui (p, primes[prime_limit]) <= 0)
+    /* Just use first three entries (3,5,7) of table for small numbers */
+    prime_limit = 3;
+  if (prime_limit)
+    {
+      /* Compute residues modulo small odd primes */
+      moduli = (unsigned short *) TMP_ALLOC (prime_limit * sizeof moduli[0]);
+      for (i = 0; i < prime_limit; i++)
+	moduli[i] = mpz_fdiv_ui (p, primes[i]);
+    }
+  for (difference = 0; ; difference += 2)
+    {
+      composite = 0;
+
+      /* First check residues */
+      for (i = 0; i < prime_limit; i++)
+	{
+	  int acc, pr;
+	  composite |= (moduli[i] == 0);
+	  acc = moduli[i] + 2;
+	  pr = primes[i];
+	  moduli[i] = acc >= pr ? acc - pr : acc;
+	}
+      if (composite)
+	continue;
+
+      mpz_add_ui (p, p, difference);
+      difference = 0;
+
+      /* Miller-Rabin test */
+      if (mpz_millerrabin (p, 2))
+	break;
+    }
+}
+#endif
diff --git a/src/gmp/mpz/out_raw.c b/src/gmp/mpz/out_raw.c
new file mode 100644
index 000000000..62709479c
--- /dev/null
+++ b/src/gmp/mpz/out_raw.c
@@ -0,0 +1,89 @@
+/* mpz_out_raw -- Output a mpz_t in binary.  Use an endianess and word size
+   independent format.
+
+Copyright (C) 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+size_t
+#if __STDC__
+mpz_out_raw (FILE *stream, mpz_srcptr x)
+#else
+mpz_out_raw (stream, x)
+     FILE *stream;
+     mpz_srcptr x;
+#endif
+{
+  int i;
+  mp_size_t s;
+  mp_size_t xsize = ABS (x->_mp_size);
+  mp_srcptr xp = x->_mp_d;
+  mp_size_t out_bytesize;
+  mp_limb_t hi_limb;
+  int n_bytes_in_hi_limb;
+
+  if (stream == 0)
+    stream = stdout;
+
+  if (xsize == 0)
+    {
+      for (i = 4 - 1; i >= 0; i--)
+	fputc (0, stream);
+      return ferror (stream) ? 0 : 4;
+    }
+
+  hi_limb = xp[xsize - 1];
+  for (i = BYTES_PER_MP_LIMB - 1; i > 0; i--)
+    {
+      if ((hi_limb >> i * BITS_PER_CHAR) != 0)
+	break;
+    }
+  n_bytes_in_hi_limb = i + 1;
+  out_bytesize = BYTES_PER_MP_LIMB * (xsize - 1) + n_bytes_in_hi_limb;
+  if (x->_mp_size < 0)
+    out_bytesize = -out_bytesize;
+
+  /* Make the size 4 bytes on all machines, to make the format portable.  */
+  for (i = 4 - 1; i >= 0; i--)
+    fputc ((out_bytesize >> (i * BITS_PER_CHAR)) % (1 << BITS_PER_CHAR),
+	   stream);
+
+  /* Output from the most significant limb to the least significant limb,
+     with each limb also output in decreasing significance order.  */
+
+  /* Output the most significant limb separately, since we will only
+     output some of its bytes.  */
+  for (i = n_bytes_in_hi_limb - 1; i >= 0; i--)
+    fputc ((hi_limb >> (i * BITS_PER_CHAR)) % (1 << BITS_PER_CHAR), stream);
+
+  /* Output the remaining limbs.  */
+  for (s = xsize - 2; s >= 0; s--)
+    {
+      mp_limb_t x_limb;
+
+      x_limb = xp[s];
+      for (i = BYTES_PER_MP_LIMB - 1; i >= 0; i--)
+	fputc ((x_limb >> (i * BITS_PER_CHAR)) % (1 << BITS_PER_CHAR), stream);
+    }
+  return ferror (stream) ? 0 : ABS (out_bytesize) + 4;
+}
diff --git a/src/gmp/mpz/out_str.c b/src/gmp/mpz/out_str.c
new file mode 100644
index 000000000..bf971b005
--- /dev/null
+++ b/src/gmp/mpz/out_str.c
@@ -0,0 +1,108 @@
+/* mpz_out_str(stream, base, integer) -- Output to STREAM the multi prec.
+   integer INTEGER in base BASE.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+size_t
+#if __STDC__
+mpz_out_str (FILE *stream, int base, mpz_srcptr x)
+#else
+mpz_out_str (stream, base, x)
+     FILE *stream;
+     int base;
+     mpz_srcptr x;
+#endif
+{
+  mp_ptr xp;
+  mp_size_t x_size = x->_mp_size;
+  unsigned char *str;
+  size_t str_size;
+  size_t i;
+  size_t written;
+  char *num_to_text;
+  TMP_DECL (marker);
+
+  if (stream == 0)
+    stream = stdout;
+
+  if (base >= 0)
+    {
+      if (base == 0)
+	base = 10;
+      num_to_text = "0123456789abcdefghijklmnopqrstuvwxyz";
+    }
+  else
+    {
+      base = -base;
+      num_to_text = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+    }
+
+  if (x_size == 0)
+    {
+      fputc ('0', stream);
+      return ferror (stream) ? 0 : 1;
+    }
+
+  written = 0;
+
+  if (x_size < 0)
+    {
+      fputc ('-', stream);
+      x_size = -x_size;
+      written = 1;
+    }
+
+  TMP_MARK (marker);
+  str_size = ((size_t) (x_size * BITS_PER_MP_LIMB
+			* __mp_bases[base].chars_per_bit_exactly)) + 3;
+  str = (unsigned char *) TMP_ALLOC (str_size);
+
+  /* Move the number to convert into temporary space, since mpn_get_str
+     clobbers its argument + needs one extra high limb....  */
+  xp = (mp_ptr) TMP_ALLOC ((x_size + 1) * BYTES_PER_MP_LIMB);
+  MPN_COPY (xp, x->_mp_d, x_size);
+
+  str_size = mpn_get_str (str, base, xp, x_size);
+
+  /* mpn_get_str might make some leading zeros.  Skip them.  */
+  while (*str == 0)
+    {
+      str_size--;
+      str++;
+    }
+
+  /* Translate to printable chars.  */
+  for (i = 0; i < str_size; i++)
+    str[i] = num_to_text[str[i]];
+  str[str_size] = 0;
+
+  {
+    size_t fwret;
+    fwret = fwrite ((char *) str, 1, str_size, stream);
+    written += fwret;
+  }
+
+  TMP_FREE (marker);
+  return ferror (stream) ? 0 : written;
+}
diff --git a/src/gmp/mpz/perfpow.c b/src/gmp/mpz/perfpow.c
new file mode 100644
index 000000000..e71670a0b
--- /dev/null
+++ b/src/gmp/mpz/perfpow.c
@@ -0,0 +1,272 @@
+/* mpz_perfect_power_p(arg) -- Return non-zero if ARG is a perfect power,
+   zero otherwise.
+
+Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/*
+  We are to determine if c is a perfect power, c = a ^ b.
+  Assume c is divisible by 2^n and that codd = c/2^n is odd.
+  Assume a is divisible by 2^m and that aodd = a/2^m is odd.
+  It is always true that m divides n.
+
+  * If n is prime, either 1) a is 2*aodd and b = n
+		       or 2) a = c and b = 1.
+    So for n prime, we readily have a solution.
+  * If n is factorable into the non-trivial factors p1,p2,...
+    Since m divides n, m has a subset of n's factors and b = n / m.
+
+    BUG: Should handle negative numbers, since they can be odd perfect powers.
+*/
+
+/* This is a naive approach to recognizing perfect powers.
+   Many things can be improved.  In particular, we should use p-adic
+   arithmetic for computing possible roots.  */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+static unsigned long int gcd _PROTO ((unsigned long int a, unsigned long int b));
+static int isprime _PROTO ((unsigned long int t));
+
+static const unsigned short primes[] =
+{  2,  3,  5,  7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53,
+  59, 61, 67, 71, 73, 79, 83, 89, 97,101,103,107,109,113,127,131,
+ 137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,
+ 227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,
+ 313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,
+ 419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,
+ 509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,
+ 617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,
+ 727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,
+ 829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,
+ 947,953,967,971,977,983,991,997,0
+};
+#define SMALLEST_OMITTED_PRIME 1009
+
+
+int
+#if __STDC__
+mpz_perfect_power_p (mpz_srcptr u)
+#else
+mpz_perfect_power_p (u)
+     mpz_srcptr u;
+#endif
+{
+  unsigned long int prime;
+  unsigned long int n, n2;
+  int i;
+  unsigned long int rem;
+  mpz_t u2, q;
+  int exact;
+  mp_size_t uns;
+  TMP_DECL (marker);
+
+  if (mpz_cmp_ui (u, 1) <= 0)
+    return 0;
+
+  n2 = mpz_scan1 (u, 0);
+  if (n2 == 1)
+    return 0;
+
+  TMP_MARK (marker);
+
+  uns = ABSIZ (u) - n2 / BITS_PER_MP_LIMB;
+  MPZ_TMP_INIT (q, uns);
+  MPZ_TMP_INIT (u2, uns);
+
+  mpz_tdiv_q_2exp (u2, u, n2);
+
+  if (isprime (n2))
+    goto n2prime;
+
+  for (i = 1; primes[i] != 0; i++)
+    {
+      prime = primes[i];
+      rem = mpz_tdiv_ui (u2, prime);
+      if (rem == 0)		/* divisable? */
+	{
+	  rem = mpz_tdiv_q_ui (q, u2, prime * prime);
+	  if (rem != 0)
+	    {
+	      TMP_FREE (marker);
+	      return 0;
+	    }
+	  mpz_swap (q, u2);
+	  for (n = 2;;)
+	    {
+	      rem = mpz_tdiv_q_ui (q, u2, prime);
+	      if (rem != 0)
+		break;
+	      mpz_swap (q, u2);
+	      n++;
+	    }
+
+	  n2 = gcd (n2, n);
+	  if (n2 == 1)
+	    {
+	      TMP_FREE (marker);
+	      return 0;
+	    }
+
+	  /* As soon as n2 becomes a prime number, stop factoring.
+	     Either we have u=x^n2 or u is not a perfect power.  */
+	  if (isprime (n2))
+	    goto n2prime;
+	}
+    }
+
+  if (mpz_cmp_ui (u2, 1) == 0)
+    {
+      TMP_FREE (marker);
+      return 1;
+    }
+
+  if (n2 == 0)
+    {
+      unsigned long int nth;
+      /* We did not find any factors above.  We have to consider all values
+	 of n.  */
+      for (nth = 2;; nth++)
+	{
+	  if (! isprime (nth))
+	    continue;
+#if 0
+	  exact = mpz_padic_root (q, u2, nth, PTH);
+	  if (exact)
+#endif
+	    exact = mpz_root (q, u2, nth);
+	  if (exact)
+	    {
+	      TMP_FREE (marker);
+	      return 1;
+	    }
+	  if (mpz_cmp_ui (q, SMALLEST_OMITTED_PRIME) < 0)
+	    {
+	      TMP_FREE (marker);
+	      return 0;
+	    }
+	}
+    }
+  else
+    {
+      unsigned long int nth;
+      /* We found some factors above.  We just need to consider values of n
+	 that divides n2.  */
+      for (nth = 2; nth <= n2; nth++)
+	{
+	  if (! isprime (nth))
+	    continue;
+	  if (n2 % nth != 0)
+	    continue;
+#if 0
+	  exact = mpz_padic_root (q, u2, nth, PTH);
+	  if (exact)
+#endif
+	    exact = mpz_root (q, u2, nth);
+	  if (exact)
+	    {
+	      TMP_FREE (marker);
+	      return 1;
+	    }
+	  if (mpz_cmp_ui (q, SMALLEST_OMITTED_PRIME) < 0)
+	    {
+	      TMP_FREE (marker);
+	      return 0;
+	    }
+	}
+
+      TMP_FREE (marker);
+      return 0;
+    }
+
+n2prime:
+  exact = mpz_root (NULL, u2, n2);
+  TMP_FREE (marker);
+  return exact;
+}
+
+static unsigned long int
+#if __STDC__
+gcd (unsigned long int a, unsigned long int b)
+#else
+gcd (a, b)
+     unsigned long int a, b;
+#endif
+{
+  int an2, bn2, n2;
+
+  if (a == 0)
+    return b;
+  if (b == 0)
+    return a;
+
+  count_trailing_zeros (an2, a);
+  a >>= an2;
+
+  count_trailing_zeros (bn2, b);
+  b >>= bn2;
+
+  n2 = MIN (an2, bn2);
+
+  while (a != b)
+    {
+      if (a > b)
+	{
+	  a -= b;
+	  do
+	    a >>= 1;
+	  while ((a & 1) == 0);
+	}
+      else /*  b > a.  */
+	{
+	  b -= a;
+	  do
+	    b >>= 1;
+	  while ((b & 1) == 0);
+	}
+    }
+
+  return a << n2;
+}
+
+static int
+#if __STDC__
+isprime (unsigned long int t)
+#else
+isprime (t)
+     unsigned long int t;
+#endif
+{
+  unsigned long int q, r, d;
+
+  if (t < 3 || (t & 1) == 0)
+    return t == 2;
+
+  for (d = 3, r = 1; r != 0; d += 2)
+    {
+      q = t / d;
+      r = t - q * d;
+      if (q < d)
+	return 1;
+    }
+  return 0;
+}
diff --git a/src/gmp/mpz/perfsqr.c b/src/gmp/mpz/perfsqr.c
new file mode 100644
index 000000000..92e8d08ea
--- /dev/null
+++ b/src/gmp/mpz/perfsqr.c
@@ -0,0 +1,45 @@
+/* mpz_perfect_square_p(arg) -- Return non-zero if ARG is a perfect square,
+   zero otherwise.
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_perfect_square_p (mpz_srcptr a)
+#else
+mpz_perfect_square_p (a)
+     mpz_srcptr a;
+#endif
+{
+  mp_size_t asize = a->_mp_size;
+
+  /* No negative numbers are perfect squares.  */
+  if (asize < 0)
+    return 0;
+
+  /* Zero is a perfect square.  */
+  if (asize == 0)
+    return 1;
+
+  return mpn_perfect_square_p (a->_mp_d, asize);
+}
diff --git a/src/gmp/mpz/popcount.c b/src/gmp/mpz/popcount.c
new file mode 100644
index 000000000..3105258e2
--- /dev/null
+++ b/src/gmp/mpz/popcount.c
@@ -0,0 +1,42 @@
+/* mpz_popcount(mpz_ptr op) -- Population count of OP.  If the operand is
+   negative, return ~0 (a novel representation of infinity).
+
+Copyright (C) 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_popcount (mpz_srcptr u)
+#else
+mpz_popcount (u)
+     mpz_srcptr u;
+#endif
+{
+  mp_size_t usize;
+
+  usize = u->_mp_size;
+
+  if ((usize) < 0)
+    return ~ (unsigned long int) 0;
+
+  return mpn_popcount (u->_mp_d, usize);
+}
diff --git a/src/gmp/mpz/pow_ui.c b/src/gmp/mpz/pow_ui.c
new file mode 100644
index 000000000..96ca114e4
--- /dev/null
+++ b/src/gmp/mpz/pow_ui.c
@@ -0,0 +1,129 @@
+/* mpz_pow_ui(res, base, exp) -- Set RES to BASE**EXP.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#ifdef BERKELEY_MP
+#include "mp.h"
+#endif
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#ifndef BERKELEY_MP
+void
+#if __STDC__
+mpz_pow_ui (mpz_ptr r, mpz_srcptr b, unsigned long int e)
+#else
+mpz_pow_ui (r, b, e)
+     mpz_ptr r;
+     mpz_srcptr b;
+     unsigned long int e;
+#endif
+#else /* BERKELEY_MP */
+void
+#if __STDC__
+rpow (const MINT *b, signed short int e, MINT *r)
+#else
+rpow (b, e, r)
+     const MINT *b;
+     signed short int e;
+     MINT *r;
+#endif
+#endif /* BERKELEY_MP */
+{
+  mp_ptr rp, bp, tp, xp;
+  mp_size_t ralloc, rsize, bsize;
+  int cnt, i;
+  mp_limb_t blimb;
+  TMP_DECL (marker);
+
+  bsize = ABS (b->_mp_size);
+
+  /* Single out cases that give result == 0 or 1.  These tests are here
+     to simplify the general code below, not to optimize.  */
+  if (e == 0)
+    {
+      r->_mp_d[0] = 1;
+      r->_mp_size = 1;
+      return;
+    }
+  if (bsize == 0
+#ifdef BERKELEY_MP
+      || e < 0
+#endif
+      )
+    {
+      r->_mp_size = 0;
+      return;
+    }
+
+  bp = b->_mp_d;
+
+  blimb = bp[bsize - 1];
+  if (bsize == 1 && blimb < 0x100)
+    {
+      /* Estimate space requirements accurately.  Using the code from the
+	 `else' path would over-estimate space requirements wildly.   */
+      float lb = __mp_bases[blimb].chars_per_bit_exactly;
+      ralloc = 3 + ((mp_size_t) (e / lb) / BITS_PER_MP_LIMB);
+    }
+  else
+    {
+      /* Over-estimate space requirements somewhat.  */
+      count_leading_zeros (cnt, blimb);
+      ralloc = bsize * e - cnt * e / BITS_PER_MP_LIMB + 2;
+    }
+
+  TMP_MARK (marker);
+
+  /* The two areas are used to alternatingly hold the input and recieve the
+     product for mpn_mul.  (This scheme is used to fulfill the requirements
+     of mpn_mul; that the product space may not be the same as any of the
+     input operands.)  */
+  rp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+  tp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+
+  MPN_COPY (rp, bp, bsize);
+  rsize = bsize;
+  count_leading_zeros (cnt, e);
+
+  for (i = BITS_PER_MP_LIMB - cnt - 2; i >= 0; i--)
+    {
+      mpn_mul_n (tp, rp, rp, rsize);
+      rsize = 2 * rsize;
+      rsize -= tp[rsize - 1] == 0;
+      xp = tp; tp = rp; rp = xp;
+
+      if ((e & ((mp_limb_t) 1 << i)) != 0)
+	{
+	  rsize = rsize + bsize - (mpn_mul (tp, rp, rsize, bp, bsize) == 0);
+	  xp = tp; tp = rp; rp = xp;
+	}
+    }
+
+  /* Now then we know the exact space requirements, reallocate if
+     necessary.  */
+  if (r->_mp_alloc < rsize)
+    _mpz_realloc (r, rsize);
+
+  MPN_COPY (r->_mp_d, rp, rsize);
+  r->_mp_size = (e & 1) == 0 || b->_mp_size >= 0 ? rsize : -rsize;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/powm.c b/src/gmp/mpz/powm.c
new file mode 100644
index 000000000..e6af855a7
--- /dev/null
+++ b/src/gmp/mpz/powm.c
@@ -0,0 +1,364 @@
+/* mpz_powm(res,base,exp,mod) -- Set RES to (base**exp) mod MOD.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation, Inc.
+Contributed by Paul Zimmermann.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#ifdef BERKELEY_MP
+#include "mp.h"
+#endif
+
+
+/* set c <- (a*b)/R^n mod m c has to have at least (2n) allocated limbs */
+static void
+#if __STDC__
+mpz_redc (mpz_ptr c, mpz_srcptr a, mpz_srcptr b, mpz_srcptr m, mp_limb_t Nprim)
+#else
+mpz_redc (c, a, b, m, Nprim)
+     mpz_ptr c;
+     mpz_srcptr a;
+     mpz_srcptr b;
+     mpz_srcptr m;
+     mp_limb_t Nprim;
+#endif
+{
+  mp_ptr cp, mp = PTR (m);
+  mp_limb_t cy, cout = 0;
+  mp_limb_t q;
+  size_t j, n = ABSIZ (m);
+
+  ASSERT (ALLOC (c) >= 2 * n);
+
+  mpz_mul (c, a, b);
+  cp = PTR (c);
+  j = ABSIZ (c);
+  MPN_ZERO (cp + j, 2 * n - j);
+  for (j = 0; j < n; j++)
+    {
+      q = cp[0] * Nprim;
+      cy = mpn_addmul_1 (cp, mp, n, q);
+      cout += mpn_add_1 (cp + n, cp + n, n - j, cy);
+      cp++;
+    }
+  cp -= n;
+  if (cout)
+    {
+      cy = cout - mpn_sub_n (cp, cp + n, mp, n);
+      while (cy)
+	cy -= mpn_sub_n (cp, cp, mp, n);
+    }
+  else
+    MPN_COPY (cp, cp + n, n);
+  MPN_NORMALIZE (cp, n);
+  SIZ (c) = SIZ (c) < 0 ? -n : n;
+}
+
+/* average number of calls to redc for an exponent of n bits
+   with the sliding window algorithm of base 2^k: the optimal is
+   obtained for the value of k which minimizes 2^(k-1)+n/(k+1):
+
+   n\k    4     5     6     7     8
+   128    156*  159   171   200   261
+   256    309   307*  316   343   403
+   512    617   607*  610   632   688
+   1024   1231  1204  1195* 1207  1256
+   2048   2461  2399  2366  2360* 2396
+   4096   4918  4787  4707  4665* 4670
+*/
+
+#ifndef BERKELEY_MP
+void
+#if __STDC__
+mpz_powm (mpz_ptr res, mpz_srcptr base, mpz_srcptr e, mpz_srcptr mod)
+#else
+mpz_powm (res, base, e, mod)
+     mpz_ptr res;
+     mpz_srcptr base;
+     mpz_srcptr e;
+     mpz_srcptr mod;
+#endif
+#else /* BERKELEY_MP */
+void
+#if __STDC__
+pow (mpz_srcptr base, mpz_srcptr e, mpz_srcptr mod, mpz_ptr res)
+#else
+pow (base, e, mod, res)
+     mpz_srcptr base;
+     mpz_srcptr e;
+     mpz_srcptr mod;
+     mpz_ptr res;
+#endif
+#endif /* BERKELEY_MP */
+{
+  mp_limb_t invm, *ep, c, mask;
+  mpz_t xx, *g;
+  mp_size_t n, i, K, j, l, k;
+  int sh;
+  int use_redc;
+
+#ifdef POWM_DEBUG
+  mpz_t exp;
+  mpz_init (exp);
+#endif
+
+  n = ABSIZ (mod);
+
+  if (n == 0)
+    DIVIDE_BY_ZERO;
+
+  if (SIZ (e) == 0)
+    {
+      /* Exponent is zero, result is 1 mod MOD, i.e., 1 or 0
+         depending on if MOD equals 1.  */
+      SIZ(res) = (ABSIZ (mod) == 1 && (PTR(mod))[0] == 1) ? 0 : 1;
+      PTR(res)[0] = 1;
+      return;
+    }
+
+  /* Use REDC instead of usual reduction for sizes < POWM_THRESHOLD.
+     In REDC each modular multiplication costs about 2*n^2 limbs operations,
+     whereas using usual reduction it costs 3*K(n), where K(n) is the cost of a
+     multiplication using Karatsuba, and a division is assumed to cost 2*K(n),
+     for example using Burnikel-Ziegler's algorithm. This gives a theoretical
+     threshold of a*KARATSUBA_SQR_THRESHOLD, with a=(3/2)^(1/(2-ln(3)/ln(2))) ~
+     2.66.  */
+  /* For now, also disable REDC when MOD is even, as the inverse can't
+     handle that.  */
+
+#ifndef POWM_THRESHOLD
+#define POWM_THRESHOLD  ((8 * KARATSUBA_SQR_THRESHOLD) / 3)
+#endif
+
+  use_redc = (n < POWM_THRESHOLD && PTR(mod)[0] % 2 != 0);
+  if (use_redc)
+    {
+      /* invm = -1/m mod 2^BITS_PER_MP_LIMB, must have m odd */
+      modlimb_invert (invm, PTR(mod)[0]);
+      invm = -invm;
+    }
+
+  /* determines optimal value of k */
+  l = ABSIZ (e) * BITS_PER_MP_LIMB; /* number of bits of exponent */
+  k = 1;
+  K = 2;
+  while (2 * l > K * (2 + k * (3 + k)))
+    {
+      k++;
+      K *= 2;
+    }
+
+  g = (mpz_t *) (*_mp_allocate_func) (K / 2 * sizeof (mpz_t));
+  /* compute x*R^n where R=2^BITS_PER_MP_LIMB */
+  mpz_init (g[0]);
+  if (use_redc)
+    {
+      mpz_mul_2exp (g[0], base, n * BITS_PER_MP_LIMB);
+      mpz_mod (g[0], g[0], mod);
+    }
+  else
+    mpz_mod (g[0], base, mod);
+
+  /* compute xx^g for odd g < 2^k */
+  mpz_init (xx);
+  if (use_redc)
+    {
+      _mpz_realloc (xx, 2 * n);
+      mpz_redc (xx, g[0], g[0], mod, invm); /* xx = x^2*R^n */
+    }
+  else
+    {
+      mpz_mul (xx, g[0], g[0]);
+      mpz_mod (xx, xx, mod);
+    }
+  for (i = 1; i < K / 2; i++)
+    {
+      mpz_init (g[i]);
+      if (use_redc)
+	{
+	  _mpz_realloc (g[i], 2 * n);
+	  mpz_redc (g[i], g[i - 1], xx, mod, invm); /* g[i] = x^(2i+1)*R^n */
+	}
+      else
+	{
+	  mpz_mul (g[i], g[i - 1], xx);
+	  mpz_mod (g[i], g[i], mod);
+	}
+    }
+
+  /* now starts the real stuff */
+  mask = (mp_limb_t) ((1<<k) - 1);
+  ep = PTR (e);
+  i = ABSIZ (e) - 1;			/* current index */
+  c = ep[i];				/* current limb */
+  count_leading_zeros (sh, c);
+  sh = BITS_PER_MP_LIMB - sh;		/* significant bits in ep[i] */
+  sh -= k;				/* index of lower bit of ep[i] to take into account */
+  if (sh < 0)
+    {					/* k-sh extra bits are needed */
+      if (i > 0)
+	{
+	  i--;
+	  c = (c << (-sh)) | (ep[i] >> (BITS_PER_MP_LIMB + sh));
+	  sh += BITS_PER_MP_LIMB;
+	}
+    }
+  else
+    c = c >> sh;
+#ifdef POWM_DEBUG
+  printf ("-1/m mod 2^%u = %lu\n", BITS_PER_MP_LIMB, invm);
+  mpz_set_ui (exp, c);
+#endif
+  j=0;
+  while (c % 2 == 0)
+    {
+      j++;
+      c = (c >> 1);
+    }
+  mpz_set (xx, g[c >> 1]);
+  while (j--)
+    {
+      if (use_redc)
+	mpz_redc (xx, xx, xx, mod, invm);
+      else
+	{
+	  mpz_mul (xx, xx, xx);
+	  mpz_mod (xx, xx, mod);
+	}
+    }
+
+#ifdef POWM_DEBUG
+  printf ("x^"); mpz_out_str (0, 10, exp);
+  printf ("*2^%u mod m = ", n * BITS_PER_MP_LIMB); mpz_out_str (0, 10, xx);
+  putchar ('\n');
+#endif
+
+  while (i > 0 || sh > 0)
+    {
+      c = ep[i];
+      sh -= k;
+      l = k;				/* number of bits treated */
+      if (sh < 0)
+	{
+	  if (i > 0)
+	    {
+	      i--;
+	      c = (c << (-sh)) | (ep[i] >> (BITS_PER_MP_LIMB + sh));
+	      sh += BITS_PER_MP_LIMB;
+	    }
+	  else
+	    {
+	      l += sh;			/* may be less bits than k here */
+	      c = c & ((1<<l) - 1);
+	    }
+	}
+      else
+	c = c >> sh;
+      c = c & mask;
+
+      /* this while loop implements the sliding window improvement */
+      while ((c & (1 << (k - 1))) == 0 && (i > 0 || sh > 0))
+	{
+	  if (use_redc) mpz_redc (xx, xx, xx, mod, invm);
+	  else
+	    {
+	      mpz_mul (xx, xx, xx);
+	      mpz_mod (xx, xx, mod);
+	    }
+	  if (sh)
+	    {
+	      sh--;
+	      c = (c<<1) + ((ep[i]>>sh) & 1);
+	    }
+	  else
+	    {
+	      i--;
+	      sh = BITS_PER_MP_LIMB - 1;
+	      c = (c<<1) + (ep[i]>>sh);
+	    }
+	}
+
+#ifdef POWM_DEBUG
+      printf ("l=%u c=%lu\n", l, c);
+      mpz_mul_2exp (exp, exp, k);
+      mpz_add_ui (exp, exp, c);
+#endif
+
+      /* now replace xx by xx^(2^k)*x^c */
+      if (c != 0)
+	{
+	  j = 0;
+	  while (c % 2 == 0)
+	    {
+	      j++;
+	      c = c >> 1;
+	    }
+	  /* c0 = c * 2^j, i.e. xx^(2^k)*x^c = (A^(2^(k - j))*c)^(2^j) */
+	  l -= j;
+	  while (l--)
+	    if (use_redc) mpz_redc (xx, xx, xx, mod, invm);
+	    else
+	      {
+		mpz_mul (xx, xx, xx);
+		mpz_mod (xx, xx, mod);
+	      }
+	  if (use_redc)
+	    mpz_redc (xx, xx, g[c >> 1], mod, invm);
+	  else
+	    {
+	      mpz_mul (xx, xx, g[c >> 1]);
+	      mpz_mod (xx, xx, mod);
+	    }
+	}
+      else
+	j = l;				/* case c=0 */
+      while (j--)
+	{
+	  if (use_redc)
+	    mpz_redc (xx, xx, xx, mod, invm);
+	  else
+	    {
+	      mpz_mul (xx, xx, xx);
+	      mpz_mod (xx, xx, mod);
+	    }
+	}
+#ifdef POWM_DEBUG
+      printf ("x^"); mpz_out_str (0, 10, exp);
+      printf ("*2^%u mod m = ", n * BITS_PER_MP_LIMB); mpz_out_str (0, 10, xx);
+      putchar ('\n');
+#endif
+    }
+
+  /* now convert back xx to xx/R^n */
+  if (use_redc)
+    {
+      mpz_set_ui (g[0], 1);
+      mpz_redc (xx, xx, g[0], mod, invm);
+      if (mpz_cmp (xx, mod) >= 0)
+	mpz_sub (xx, xx, mod);
+    }
+  mpz_set (res, xx);
+
+  mpz_clear (xx);
+  for (i = 0; i < K / 2; i++)
+    mpz_clear (g[i]);
+  (*_mp_free_func) (g, K / 2 * sizeof (mpz_t));
+}
diff --git a/src/gmp/mpz/powm_ui.c b/src/gmp/mpz/powm_ui.c
new file mode 100644
index 000000000..00f70bd56
--- /dev/null
+++ b/src/gmp/mpz/powm_ui.c
@@ -0,0 +1,248 @@
+/* mpz_powm_ui(res,base,exp,mod) -- Set RES to (base**exp) mod MOD.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpz_powm_ui (mpz_ptr res, mpz_srcptr base, unsigned long int exp, mpz_srcptr mod)
+#else
+mpz_powm_ui (res, base, exp, mod)
+     mpz_ptr res;
+     mpz_srcptr base;
+     unsigned long int exp;
+     mpz_srcptr mod;
+#endif
+{
+  mp_ptr rp, mp, bp;
+  mp_size_t msize, bsize, rsize;
+  mp_size_t size;
+  int mod_shift_cnt;
+  int negative_result;
+  mp_limb_t *free_me = NULL;
+  size_t free_me_size;
+  TMP_DECL (marker);
+
+  msize = ABS (mod->_mp_size);
+  size = 2 * msize;
+
+  rp = res->_mp_d;
+
+  if (msize == 0)
+    DIVIDE_BY_ZERO;
+
+  if (exp == 0)
+    {
+      /* Exponent is zero, result is 1 mod MOD, i.e., 1 or 0
+	 depending on if MOD equals 1.  */
+      res->_mp_size = (msize == 1 && (mod->_mp_d)[0] == 1) ? 0 : 1;
+      rp[0] = 1;
+      return;
+    }
+
+  TMP_MARK (marker);
+
+  /* Normalize MOD (i.e. make its most significant bit set) as required by
+     mpn_divmod.  This will make the intermediate values in the calculation
+     slightly larger, but the correct result is obtained after a final
+     reduction using the original MOD value.  */
+
+  mp = (mp_ptr) TMP_ALLOC (msize * BYTES_PER_MP_LIMB);
+  count_leading_zeros (mod_shift_cnt, mod->_mp_d[msize - 1]);
+  if (mod_shift_cnt != 0)
+    mpn_lshift (mp, mod->_mp_d, msize, mod_shift_cnt);
+  else
+    MPN_COPY (mp, mod->_mp_d, msize);
+
+  bsize = ABS (base->_mp_size);
+  if (bsize > msize)
+    {
+      /* The base is larger than the module.  Reduce it.  */
+
+      /* Allocate (BSIZE + 1) with space for remainder and quotient.
+	 (The quotient is (bsize - msize + 1) limbs.)  */
+      bp = (mp_ptr) TMP_ALLOC ((bsize + 1) * BYTES_PER_MP_LIMB);
+      MPN_COPY (bp, base->_mp_d, bsize);
+      /* We don't care about the quotient, store it above the remainder,
+	 at BP + MSIZE.  */
+      mpn_divmod (bp + msize, bp, bsize, mp, msize);
+      bsize = msize;
+      /* Canonicalize the base, since we are going to multiply with it
+	 quite a few times.  */
+      MPN_NORMALIZE (bp, bsize);
+    }
+  else
+    bp = base->_mp_d;
+
+  if (bsize == 0)
+    {
+      res->_mp_size = 0;
+      TMP_FREE (marker);
+      return;
+    }
+
+  if (res->_mp_alloc < size)
+    {
+      /* We have to allocate more space for RES.  If any of the input
+	 parameters are identical to RES, defer deallocation of the old
+	 space.  */
+
+      if (rp == mp || rp == bp)
+	{
+	  free_me = rp;
+	  free_me_size = res->_mp_alloc;
+	}
+      else
+	(*_mp_free_func) (rp, res->_mp_alloc * BYTES_PER_MP_LIMB);
+
+      rp = (mp_ptr) (*_mp_allocate_func) (size * BYTES_PER_MP_LIMB);
+      res->_mp_alloc = size;
+      res->_mp_d = rp;
+    }
+  else
+    {
+      /* Make BASE, EXP and MOD not overlap with RES.  */
+      if (rp == bp)
+	{
+	  /* RES and BASE are identical.  Allocate temp. space for BASE.  */
+	  bp = (mp_ptr) TMP_ALLOC (bsize * BYTES_PER_MP_LIMB);
+	  MPN_COPY (bp, rp, bsize);
+	}
+      if (rp == mp)
+	{
+	  /* RES and MOD are identical.  Allocate temporary space for MOD.  */
+	  mp = (mp_ptr) TMP_ALLOC (msize * BYTES_PER_MP_LIMB);
+	  MPN_COPY (mp, rp, msize);
+	}
+    }
+
+  MPN_COPY (rp, bp, bsize);
+  rsize = bsize;
+
+  {
+    mp_ptr xp = (mp_ptr) TMP_ALLOC (2 * (msize + 1) * BYTES_PER_MP_LIMB);
+    int c;
+    mp_limb_t e;
+    mp_limb_t carry_limb;
+
+    negative_result = (exp & 1) && base->_mp_size < 0;
+
+    e = exp;
+    count_leading_zeros (c, e);
+    e = (e << c) << 1;		/* shift the exp bits to the left, lose msb */
+    c = BITS_PER_MP_LIMB - 1 - c;
+
+    /* Main loop.
+
+       Make the result be pointed to alternately by XP and RP.  This
+       helps us avoid block copying, which would otherwise be necessary
+       with the overlap restrictions of mpn_divmod.  With 50% probability
+       the result after this loop will be in the area originally pointed
+       by RP (==RES->_mp_d), and with 50% probability in the area originally
+       pointed to by XP.  */
+
+    while (c != 0)
+      {
+	mp_ptr tp;
+	mp_size_t xsize;
+
+	mpn_mul_n (xp, rp, rp, rsize);
+	xsize = 2 * rsize;
+	xsize -= xp[xsize - 1] == 0;
+	if (xsize > msize)
+	  {
+	    mpn_divmod (xp + msize, xp, xsize, mp, msize);
+	    xsize = msize;
+	  }
+
+	tp = rp; rp = xp; xp = tp;
+	rsize = xsize;
+
+	if ((mp_limb_signed_t) e < 0)
+	  {
+	    mpn_mul (xp, rp, rsize, bp, bsize);
+	    xsize = rsize + bsize;
+	    xsize -= xp[xsize - 1] == 0;
+	    if (xsize > msize)
+	      {
+		mpn_divmod (xp + msize, xp, xsize, mp, msize);
+		xsize = msize;
+	      }
+
+	    tp = rp; rp = xp; xp = tp;
+	    rsize = xsize;
+	  }
+	e <<= 1;
+	c--;
+      }
+
+    /* We shifted MOD, the modulo reduction argument, left MOD_SHIFT_CNT
+       steps.  Adjust the result by reducing it with the original MOD.
+
+       Also make sure the result is put in RES->_mp_d (where it already
+       might be, see above).  */
+
+    if (mod_shift_cnt != 0)
+      {
+	carry_limb = mpn_lshift (res->_mp_d, rp, rsize, mod_shift_cnt);
+	rp = res->_mp_d;
+	if (carry_limb != 0)
+	  {
+	    rp[rsize] = carry_limb;
+	    rsize++;
+	  }
+      }
+    else
+      {
+	MPN_COPY (res->_mp_d, rp, rsize);
+	rp = res->_mp_d;
+      }
+
+    if (rsize >= msize)
+      {
+	mpn_divmod (rp + msize, rp, rsize, mp, msize);
+	rsize = msize;
+      }
+
+    /* Remove any leading zero words from the result.  */
+    if (mod_shift_cnt != 0)
+      mpn_rshift (rp, rp, rsize, mod_shift_cnt);
+    MPN_NORMALIZE (rp, rsize);
+  }
+
+  if (negative_result && rsize != 0)
+    {
+      if (mod_shift_cnt != 0)
+	mpn_rshift (mp, mp, msize, mod_shift_cnt);
+      mpn_sub (rp, mp, msize, rp, rsize);
+      rsize = msize;
+      MPN_NORMALIZE (rp, rsize);
+    }
+  res->_mp_size = rsize;
+
+  if (free_me != NULL)
+    (*_mp_free_func) (free_me, free_me_size * BYTES_PER_MP_LIMB);
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/pprime_p.c b/src/gmp/mpz/pprime_p.c
new file mode 100644
index 000000000..0217d8f5f
--- /dev/null
+++ b/src/gmp/mpz/pprime_p.c
@@ -0,0 +1,242 @@
+/* mpz_probab_prime_p --
+   An implementation of the probabilistic primality test found in Knuth's
+   Seminumerical Algorithms book.  If the function mpz_probab_prime_p()
+   returns 0 then n is not prime.  If it returns 1, then n is 'probably'
+   prime.  If it returns 2, n is surely prime.  The probability of a false
+   positive is (1/4)**reps, where reps is the number of internal passes of the
+   probabilistic algorithm.  Knuth indicates that 25 passes are reasonable.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 1998, 1999, 2000 Free Software
+Foundation, Inc.  Miller-Rabin code contributed by John Amanatides.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+static int isprime _PROTO ((unsigned long int t));
+static int mpz_millerrabin _PROTO ((mpz_srcptr n, int reps));
+
+int
+#if __STDC__
+mpz_probab_prime_p (mpz_srcptr n, int reps)
+#else
+mpz_probab_prime_p (n, reps)
+     mpz_srcptr n;
+     int reps;
+#endif
+{
+  mp_limb_t r;
+
+  /* Handle small and negative n.  */
+  if (mpz_cmp_ui (n, 1000000L) <= 0)
+    {
+      int is_prime;
+      if (mpz_sgn (n) < 0)
+	{
+	  /* Negative number.  Negate and call ourselves.  */
+	  mpz_t n2;
+	  mpz_init (n2);
+	  mpz_neg (n2, n);
+	  is_prime = mpz_probab_prime_p (n2, reps);
+	  mpz_clear (n2);
+	  return is_prime;
+	}
+      is_prime = isprime (mpz_get_ui (n));
+      return is_prime ? 2 : 0;
+    }
+
+  /* If n is now even, it is not a prime.  */
+  if ((mpz_get_ui (n) & 1) == 0)
+    return 0;
+
+  /* Check if n has small factors.  */
+  if (UDIV_TIME > (2 * UMUL_TIME + 6))
+    r = mpn_preinv_mod_1 (PTR(n), SIZ(n), (mp_limb_t) PP, (mp_limb_t) PP_INVERTED);
+  else
+    r = mpn_mod_1 (PTR(n), SIZ(n), (mp_limb_t) PP);
+  if (r % 3 == 0 || r % 5 == 0 || r % 7 == 0 || r % 11 == 0 || r % 13 == 0
+      || r % 17 == 0 || r % 19 == 0 || r % 23 == 0 || r % 29 == 0
+#if BITS_PER_MP_LIMB == 64
+      || r % 31 == 0 || r % 37 == 0 || r % 41 == 0 || r % 43 == 0
+      || r % 47 == 0 || r % 53 == 0
+#endif
+      )
+    {
+      return 0;
+    }
+
+  /* Do more dividing.  We collect small primes, using umul_ppmm, until we
+     overflow a single limb.  We divide our number by the small primes product,
+     and look for factors in the remainder.  */
+  {
+    unsigned long int ln2;
+    unsigned long int q;
+    mp_limb_t p1, p0, p;
+    unsigned int primes[15];
+    int nprimes;
+
+    nprimes = 0;
+    p = 1;
+    ln2 = mpz_sizeinbase (n, 2) / 30; ln2 = ln2 * ln2;
+    for (q = BITS_PER_MP_LIMB == 64 ? 59 : 31; q < ln2; q += 2)
+      {
+	if (isprime (q))
+	  {
+	    umul_ppmm (p1, p0, p, q);
+	    if (p1 != 0)
+	      {
+		r = mpn_mod_1 (PTR(n), SIZ(n), p);
+		while (--nprimes >= 0)
+		  if (r % primes[nprimes] == 0)
+		    {
+		      if (mpn_mod_1 (PTR(n), SIZ(n), (mp_limb_t) primes[nprimes]) != 0)
+			abort ();
+		      return 0;
+		    }
+		p = q;
+		nprimes = 0;
+	      }
+	    else
+	      {
+		p = p0;
+	      }
+	    primes[nprimes++] = q;
+	  }
+      }
+  }
+
+  /* Perform a number of Miller-Rabin tests.  */
+  return mpz_millerrabin (n, reps);
+}
+
+static int
+#if __STDC__
+isprime (unsigned long int t)
+#else
+isprime (t)
+     unsigned long int t;
+#endif
+{
+  unsigned long int q, r, d;
+
+  if (t < 3 || (t & 1) == 0)
+    return t == 2;
+
+  for (d = 3, r = 1; r != 0; d += 2)
+    {
+      q = t / d;
+      r = t - q * d;
+      if (q < d)
+	return 1;
+    }
+  return 0;
+}
+
+static int millerrabin _PROTO ((mpz_srcptr n, mpz_srcptr nm1,
+                                mpz_ptr x, mpz_ptr y,
+                                mpz_srcptr q, unsigned long int k));
+
+static int
+#if __STDC__
+mpz_millerrabin (mpz_srcptr n, int reps)
+#else
+mpz_millerrabin (n, reps)
+     mpz_srcptr n;
+     int reps;
+#endif
+{
+  int r;
+  mpz_t nm1, x, y, q;
+  unsigned long int k;
+  gmp_randstate_t rstate;
+  int is_prime;
+  TMP_DECL (marker);
+  TMP_MARK (marker);
+
+  MPZ_TMP_INIT (nm1, SIZ (n) + 1);
+  mpz_sub_ui (nm1, n, 1L);
+
+  MPZ_TMP_INIT (x, SIZ (n));
+  MPZ_TMP_INIT (y, 2 * SIZ (n)); /* mpz_powm_ui needs excessive memory!!! */
+
+  /* Perform a Fermat test.  */
+  mpz_set_ui (x, 210L);
+  mpz_powm (y, x, nm1, n);
+  if (mpz_cmp_ui (y, 1L) != 0)
+    {
+      return 0;
+      TMP_FREE (marker);
+    }
+
+  MPZ_TMP_INIT (q, SIZ (n));
+
+  /* Find q and k, where q is odd and n = 1 + 2**k * q.  */
+  k = mpz_scan1 (nm1, 0L);
+  mpz_tdiv_q_2exp (q, nm1, k);
+
+  gmp_randinit (rstate, GMP_RAND_ALG_DEFAULT, 32L);
+
+  is_prime = 1;
+  for (r = 0; r < reps && is_prime; r++)
+    {
+      do
+	mpz_urandomb (x, rstate, mpz_sizeinbase (n, 2) - 1);
+      while (mpz_cmp_ui (x, 1L) <= 0);
+
+      is_prime = millerrabin (n, nm1, x, y, q, k);
+    }
+
+  gmp_randclear (rstate);
+
+  TMP_FREE (marker);
+  return is_prime;
+}
+
+static int
+#if __STDC__
+millerrabin (mpz_srcptr n, mpz_srcptr nm1, mpz_ptr x, mpz_ptr y,
+             mpz_srcptr q, unsigned long int k)
+#else
+millerrabin (n, nm1, x, y, q, k)
+     mpz_srcptr n;
+     mpz_srcptr nm1;
+     mpz_ptr x;
+     mpz_ptr y;
+     mpz_srcptr q;
+     unsigned long int k;
+#endif
+{
+  unsigned long int i;
+
+  mpz_powm (y, x, q, n);
+
+  if (mpz_cmp_ui (y, 1L) == 0 || mpz_cmp (y, nm1) == 0)
+    return 1;
+
+  for (i = 1; i < k; i++)
+    {
+      mpz_powm_ui (y, y, 2L, n);
+      if (mpz_cmp (y, nm1) == 0)
+	return 1;
+      if (mpz_cmp_ui (y, 1L) == 0)
+	return 0;
+    }
+  return 0;
+}
diff --git a/src/gmp/mpz/random.c b/src/gmp/mpz/random.c
new file mode 100644
index 000000000..60d911399
--- /dev/null
+++ b/src/gmp/mpz/random.c
@@ -0,0 +1,56 @@
+/* mpz_random -- Generate a random mpz_t of specified size.
+   This function is non-portable and generates poor random numbers.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void
+#if __STDC__
+mpz_random (mpz_ptr x, mp_size_t size)
+#else
+mpz_random (x, size)
+     mpz_ptr x;
+     mp_size_t size;
+#endif
+{
+  mp_size_t i;
+  mp_limb_t ran;
+  mp_ptr xp;
+  mp_size_t abs_size;
+
+  abs_size = ABS (size);
+
+  if (x->_mp_alloc < abs_size)
+    _mpz_realloc (x, abs_size);
+
+  xp = x->_mp_d;
+
+  for (i = 0; i < abs_size; i++)
+    {
+      ran = urandom ();
+      xp[i] = ran;
+    }
+
+  MPN_NORMALIZE (xp, abs_size);
+  x->_mp_size = size < 0 ? -abs_size : abs_size;
+}
diff --git a/src/gmp/mpz/random2.c b/src/gmp/mpz/random2.c
new file mode 100644
index 000000000..a90af115e
--- /dev/null
+++ b/src/gmp/mpz/random2.c
@@ -0,0 +1,48 @@
+/* mpz_random2 -- Generate a positive random mpz_t of specified size, with
+   long runs of consecutive ones and zeros in the binary representation.
+   Meant for testing of other MP routines.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_random2 (mpz_ptr x, mp_size_t size)
+#else
+mpz_random2 (x, size)
+     mpz_ptr x;
+     mp_size_t size;
+#endif
+{
+  mp_size_t abs_size;
+
+  abs_size = ABS (size);
+  if (abs_size != 0)
+    {
+      if (x->_mp_alloc < abs_size)
+	_mpz_realloc (x, abs_size);
+
+      mpn_random2 (x->_mp_d, abs_size);
+    }
+
+  x->_mp_size = size;
+}
diff --git a/src/gmp/mpz/realloc.c b/src/gmp/mpz/realloc.c
new file mode 100644
index 000000000..0b9e447ec
--- /dev/null
+++ b/src/gmp/mpz/realloc.c
@@ -0,0 +1,52 @@
+/* _mpz_realloc -- make the mpz_t have NEW_SIZE digits allocated.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void *
+#if __STDC__
+_mpz_realloc (mpz_ptr m, mp_size_t new_size)
+#else
+_mpz_realloc (m, new_size)
+     mpz_ptr m;
+     mp_size_t new_size;
+#endif
+{
+  /* Never allocate zero space. */
+  if (new_size == 0)
+    new_size = 1;
+
+  m->_mp_d = (mp_ptr) (*_mp_reallocate_func) (m->_mp_d,
+					      m->_mp_alloc * BYTES_PER_MP_LIMB,
+					      new_size * BYTES_PER_MP_LIMB);
+  m->_mp_alloc = new_size;
+
+#if 0
+  /* This might break some code that reads the size field after
+     reallocation, in the case the reallocated destination and a
+     source argument are identical.  */
+  if (ABS (m->_mp_size) > new_size)
+    m->_mp_size = 0;
+#endif
+
+  return (void *) m->_mp_d;
+}
diff --git a/src/gmp/mpz/remove.c b/src/gmp/mpz/remove.c
new file mode 100644
index 000000000..bc6675f97
--- /dev/null
+++ b/src/gmp/mpz/remove.c
@@ -0,0 +1,93 @@
+/* mpz_remove -- divide out a factor and return its multiplicity.
+
+Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_remove (mpz_ptr dest, mpz_srcptr src, mpz_srcptr f)
+#else
+mpz_remove (dest, src, f)
+     mpz_ptr dest;
+     mpz_srcptr src;
+     mpz_srcptr f;
+#endif
+{
+  mpz_t fpow[40];		/* inexhaustible...until year 2020 or so */
+  mpz_t x, rem;
+  unsigned long int pwr;
+  int p;
+
+  if (mpz_cmp_ui (f, 1) <= 0 || mpz_sgn (src) == 0)
+    DIVIDE_BY_ZERO;
+  if (mpz_cmp_ui (f, 2) == 0)
+    {
+      unsigned long int s0;
+      s0 = mpz_scan1 (src, 0);
+      mpz_div_2exp (dest, src, s0);
+      return s0;
+    }
+
+  /* We could perhaps compute mpz_scan1(src,0)/mpz_scan1(f,0).  It is an
+     upper bound of the result we're seeking.  We could also shift down the
+     operands so that they become odd, to make intermediate values smaller.  */
+
+  mpz_init (rem);
+  mpz_init (x);
+
+  pwr = 0;
+  mpz_init (fpow[0]);
+  mpz_set (fpow[0], f);
+  mpz_set (dest, src);
+
+  /* Divide by f, f^2, ..., f^(2^k) until we get a remainder for f^(2^k).  */
+  for (p = 0;; p++)
+    {
+      mpz_tdiv_qr (x, rem, dest, fpow[p]);
+      if (SIZ (rem) != 0)
+	break;
+      mpz_init (fpow[p + 1]);
+      mpz_mul (fpow[p + 1], fpow[p], fpow[p]);
+      mpz_set (dest, x);
+    }
+
+  pwr = (1 << p) - 1;
+
+  mpz_clear (fpow[p]);
+
+  /* Divide by f^(2^(k-1)), f^(2^(k-2)), ..., f for all divisors that give a
+     zero remainder.  */
+  while (--p >= 0)
+    {
+      mpz_tdiv_qr (x, rem, dest, fpow[p]);
+      if (SIZ (rem) == 0)
+	{
+	  pwr += 1 << p;
+	  mpz_set (dest, x);
+	}
+      mpz_clear (fpow[p]);
+    }
+
+  mpz_clear (x);
+  mpz_clear (rem);
+  return pwr;
+}
diff --git a/src/gmp/mpz/root.c b/src/gmp/mpz/root.c
new file mode 100644
index 000000000..0920bf22d
--- /dev/null
+++ b/src/gmp/mpz/root.c
@@ -0,0 +1,183 @@
+/* mpz_root(root, u, nth) --  Set ROOT to floor(U^(1/nth)).
+   Return an indication if the result is exact.
+
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+/* Naive implementation of nth root extraction.  It would probably be a
+   better idea to use a division-free Newton iteration.  It is insane
+   to use full precision from iteration 1.  The mpz_scan1 trick compensates
+   to some extent.  It would be natural to avoid representing the low zero
+   bits mpz_scan1 is counting, and at the same time call mpn directly.  */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+int
+#if __STDC__
+mpz_root (mpz_ptr r, mpz_srcptr c, unsigned long int nth)
+#else
+mpz_root (r, c, nth)
+     mpz_ptr r;
+     mpz_srcptr c;
+     unsigned long int nth;
+#endif
+{
+  mpz_t x, t0, t1, t2;
+  __mpz_struct ccs, *cc = &ccs;
+  unsigned long int nbits;
+  int bit;
+  int exact;
+  int i;
+  unsigned long int lowz;
+  unsigned long int rl;
+
+  /* even roots of negatives provoke an exception */
+  if (mpz_sgn (c) < 0 && (nth & 1) == 0)
+    SQRT_OF_NEGATIVE;
+
+  /* root extraction interpreted as c^(1/nth) means a zeroth root should
+     provoke a divide by zero, do this even if c==0 */
+  if (nth == 0)
+    DIVIDE_BY_ZERO;
+
+  if (mpz_sgn (c) == 0)
+    {
+      if (r != NULL)
+	mpz_set_ui (r, 0);
+      return 1;			/* exact result */
+    }
+
+  PTR(cc) = PTR(c);
+  SIZ(cc) = ABSIZ(c);
+
+  nbits = (mpz_sizeinbase (cc, 2) - 1) / nth;
+  if (nbits == 0)
+    {
+      if (r != NULL)
+	mpz_set_ui (r, 1);
+      if (mpz_sgn (c) < 0)
+	{
+	  if (r != NULL)
+	    SIZ(r) = -SIZ(r);
+	  return mpz_cmp_si (c, -1L) == 0;
+	}
+      return mpz_cmp_ui (c, 1L) == 0;
+    }
+
+  mpz_init (x);
+  mpz_init (t0);
+  mpz_init (t1);
+  mpz_init (t2);
+
+  /* Create a one-bit approximation.  */
+  mpz_set_ui (x, 0);
+  mpz_setbit (x, nbits);
+
+  /* Make the approximation better, one bit at a time.  This odd-looking
+     termination criteria makes large nth get better initial approximation,
+     which avoids slow convergence for such values.  */
+  bit = nbits - 1;
+  for (i = 1; (nth >> i) != 0; i++)
+    {
+      mpz_setbit (x, bit);
+      mpz_tdiv_q_2exp (t0, x, bit);
+      mpz_pow_ui (t1, t0, nth);
+      mpz_mul_2exp (t1, t1, bit * nth);
+      if (mpz_cmp (cc, t1) < 0)
+	mpz_clrbit (x, bit);
+
+      bit--;			/* check/set next bit */
+      if (bit < 0)
+	{
+	  /* We're done.  */
+	  mpz_pow_ui (t1, x, nth);
+	  goto done;
+	}
+    }
+  mpz_setbit (x, bit);
+  mpz_set_ui (t2, 0); mpz_setbit (t2, bit);  mpz_add (x, x, t2);
+
+#if DEBUG
+  /* Check that the starting approximation is >= than the root.  */
+  mpz_pow_ui (t1, x, nth);
+  if (mpz_cmp (cc, t1) >= 0)
+    abort ();
+#endif
+
+  mpz_add_ui (x, x, 1);
+
+  /* Main loop */
+  do
+    {
+      lowz = mpz_scan1 (x, 0);
+      mpz_tdiv_q_2exp (t0, x, lowz);
+      mpz_pow_ui (t1, t0, nth - 1);
+      mpz_mul_2exp (t1, t1, lowz * (nth - 1));
+      mpz_tdiv_q (t2, cc, t1);
+      mpz_sub (t2, x, t2);
+      rl = mpz_tdiv_q_ui (t2, t2, nth);
+      mpz_sub (x, x, t2);
+    }
+  while (mpz_sgn (t2) != 0);
+
+  /* If we got a non-zero remainder in the last division, we know our root
+     is too large.  */
+  mpz_sub_ui (x, x, (mp_limb_t) (rl != 0));
+
+  /* Adjustment loop.  If we spend more care on rounding in the loop above,
+     we could probably get rid of this, or greatly simplify it.  */
+  {
+    int bad = 0;
+    lowz = mpz_scan1 (x, 0);
+    mpz_tdiv_q_2exp (t0, x, lowz);
+    mpz_pow_ui (t1, t0, nth);
+    mpz_mul_2exp (t1, t1, lowz * nth);
+    while (mpz_cmp (cc, t1) < 0)
+      {
+	bad++;
+	if (bad > 2)
+	  abort ();			/* abort if our root is far off */
+	mpz_sub_ui (x, x, 1);
+	lowz = mpz_scan1 (x, 0);
+	mpz_tdiv_q_2exp (t0, x, lowz);
+	mpz_pow_ui (t1, t0, nth);
+	mpz_mul_2exp (t1, t1, lowz * nth);
+      }
+  }
+
+ done:
+  exact = mpz_cmp (t1, cc) == 0;
+
+  if (r != NULL)
+    {
+      mpz_set (r, x);
+      if (mpz_sgn (c) < 0)
+	SIZ(r) = -SIZ(r);
+    }
+
+  mpz_clear (t2);
+  mpz_clear (t1);
+  mpz_clear (t0);
+  mpz_clear (x);
+
+  return exact;
+}
diff --git a/src/gmp/mpz/rrandomb.c b/src/gmp/mpz/rrandomb.c
new file mode 100644
index 000000000..7d7824367
--- /dev/null
+++ b/src/gmp/mpz/rrandomb.c
@@ -0,0 +1,117 @@
+/* mpz_rrandomb -- Generate a positive random mpz_t of specified bit size, with
+   long runs of consecutive ones and zeros in the binary representation.
+   Meant for testing of other MP routines.
+
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+static void gmp_rrandomb _PROTO ((mp_ptr rp, gmp_randstate_t rstate, unsigned long int nbits));
+
+void
+#if __STDC__
+mpz_rrandomb (mpz_ptr x, gmp_randstate_t rstate, unsigned long int nbits)
+#else
+mpz_rrandomb (x, rstate, nbits)
+     mpz_ptr x;
+     gmp_randstate_t rstate;
+     unsigned long int nbits;
+#endif
+{
+  mp_size_t nl = 0;
+
+  if (nbits != 0)
+    {
+      mp_ptr xp;
+      nl = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+      if (x->_mp_alloc < nl)
+	_mpz_realloc (x, nl);
+
+      xp = PTR(x);
+      gmp_rrandomb (xp, rstate, nbits);
+      MPN_NORMALIZE (xp, nl);
+    }
+
+  SIZ(x) = nl;
+}
+
+#define BITS_PER_CHUNK 4
+
+static void
+#if __STDC__
+gmp_rrandomb (mp_ptr rp, gmp_randstate_t rstate, unsigned long int nbits)
+#else
+gmp_rrandomb (rp, rstate, nbits)
+     mp_ptr rp;
+     gmp_randstate_t rstate;
+     unsigned long int nbits;
+#endif
+{
+  int nb;
+  int bit_pos;
+  mp_size_t limb_pos;
+  mp_limb_t ran, ranm;
+  mp_limb_t acc;
+  mp_size_t n;
+
+  bit_pos = nbits % BITS_PER_MP_LIMB;
+  limb_pos = nbits / BITS_PER_MP_LIMB;
+  if (bit_pos == 0)
+    {
+      bit_pos = BITS_PER_MP_LIMB;
+      limb_pos--;
+    }
+
+  acc = 0;
+  while (limb_pos >= 0)
+    {
+      _gmp_rand (&ranm, rstate, BITS_PER_CHUNK + 1);
+      ran = ranm;
+      nb = (ran >> 1) + 1;
+      if ((ran & 1) != 0)
+	{
+	  /* Generate a string of ones.  */
+	  if (nb > bit_pos)
+	    {
+	      rp[limb_pos--] = acc | ((((mp_limb_t) 1) << bit_pos) - 1);
+	      bit_pos += BITS_PER_MP_LIMB;
+	      bit_pos -= nb;
+	      acc = (~(mp_limb_t) 0) << bit_pos;
+	    }
+	  else
+	    {
+	      bit_pos -= nb;
+	      acc |= ((((mp_limb_t) 1) << nb) - 1) << bit_pos;
+	    }
+	}
+      else
+	{
+	  /* Generate a string of zeroes.  */
+	  if (nb > bit_pos)
+	    {
+	      rp[limb_pos--] = acc;
+	      acc = 0;
+	      bit_pos += BITS_PER_MP_LIMB;
+	    }
+	  bit_pos -= nb;
+	}
+    }
+}
diff --git a/src/gmp/mpz/scan0.c b/src/gmp/mpz/scan0.c
new file mode 100644
index 000000000..6c59cf893
--- /dev/null
+++ b/src/gmp/mpz/scan0.c
@@ -0,0 +1,35 @@
+/* mpz_scan0(op, startbit) -- Scan for the next set bit, starting at startbit.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_scan0 (mpz_srcptr u, unsigned long int starting_bit)
+#else
+mpz_scan0 (u, starting_bit)
+     mpz_srcptr u;
+     unsigned long int starting_bit;
+#endif
+{
+  return mpn_scan0 (u->_mp_d, starting_bit);
+}
diff --git a/src/gmp/mpz/scan1.c b/src/gmp/mpz/scan1.c
new file mode 100644
index 000000000..3b84e3420
--- /dev/null
+++ b/src/gmp/mpz/scan1.c
@@ -0,0 +1,35 @@
+/* mpz_scan1(op, startbit) -- Scan for the next set bit, starting at startbit.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_scan1 (mpz_srcptr u, unsigned long int starting_bit)
+#else
+mpz_scan1 (u, starting_bit)
+     mpz_srcptr u;
+     unsigned long int starting_bit;
+#endif
+{
+  return mpn_scan1 (u->_mp_d, starting_bit);
+}
diff --git a/src/gmp/mpz/set.c b/src/gmp/mpz/set.c
new file mode 100644
index 000000000..06b2eef51
--- /dev/null
+++ b/src/gmp/mpz/set.c
@@ -0,0 +1,48 @@
+/* mpz_set (dest_integer, src_integer) -- Assign DEST_INTEGER from SRC_INTEGER.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_set (mpz_ptr w, mpz_srcptr u)
+#else
+mpz_set (w, u)
+     mpz_ptr w;
+     mpz_srcptr u;
+#endif
+{
+  mp_ptr wp, up;
+  mp_size_t usize, size;
+
+  usize = u->_mp_size;
+  size = ABS (usize);
+
+  if (w->_mp_alloc < size)
+    _mpz_realloc (w, size);
+
+  wp = w->_mp_d;
+  up = u->_mp_d;
+
+  MPN_COPY (wp, up, size);
+  w->_mp_size = usize;
+}
diff --git a/src/gmp/mpz/set_d.c b/src/gmp/mpz/set_d.c
new file mode 100644
index 000000000..e90ed9bc2
--- /dev/null
+++ b/src/gmp/mpz/set_d.c
@@ -0,0 +1,96 @@
+/* mpz_set_d(integer, val) -- Assign INTEGER with a double value VAL.
+
+Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_set_d (mpz_ptr r, double d)
+#else
+mpz_set_d (r, d)
+     mpz_ptr r;
+     double d;
+#endif
+{
+  int negative;
+  mp_limb_t tp[3];
+  mp_ptr rp;
+  mp_size_t rn;
+
+  negative = d < 0;
+  d = ABS (d);
+
+  /* Handle small arguments quickly.  */
+  if (d < MP_BASE_AS_DOUBLE)
+    {
+      mp_limb_t tmp;
+      tmp = d;
+      PTR(r)[0] = tmp;
+      SIZ(r) = negative ? -(tmp != 0) : (tmp != 0);
+      return;
+    }
+
+  rn = __gmp_extract_double (tp, d);
+
+  if (ALLOC(r) < rn)
+    _mpz_realloc (r, rn);
+
+  rp = PTR (r);
+
+#if BITS_PER_MP_LIMB == 32
+  switch (rn)
+    {
+    default:
+      MPN_ZERO (rp, rn - 3);
+      rp += rn - 3;
+      /* fall through */
+    case 3:
+      rp[2] = tp[2];
+      rp[1] = tp[1];
+      rp[0] = tp[0];
+      break;
+    case 2:
+      rp[1] = tp[2];
+      rp[0] = tp[1];
+      break;
+    case 1:
+      /* handled in "small aguments" case above */
+      abort ();
+    }
+#else
+  switch (rn)
+    {
+    default:
+      MPN_ZERO (rp, rn - 2);
+      rp += rn - 2;
+      /* fall through */
+    case 2:
+      rp[1] = tp[1], rp[0] = tp[0];
+      break;
+    case 1:
+      /* handled in "small aguments" case above */
+      abort ();
+    }
+#endif
+
+  SIZ(r) = negative ? -rn : rn;
+}
diff --git a/src/gmp/mpz/set_f.c b/src/gmp/mpz/set_f.c
new file mode 100644
index 000000000..2273953df
--- /dev/null
+++ b/src/gmp/mpz/set_f.c
@@ -0,0 +1,64 @@
+/* mpz_set_f (dest_integer, src_float) -- Assign DEST_INTEGER from SRC_FLOAT.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_set_f (mpz_ptr w, mpf_srcptr u)
+#else
+mpz_set_f (w, u)
+     mpz_ptr w;
+     mpf_srcptr u;
+#endif
+{
+  mp_ptr wp, up;
+  mp_size_t usize, size;
+  mp_exp_t exp;
+
+  usize = SIZ (u);
+  size = ABS (usize);
+  exp = EXP (u);
+
+  if (w->_mp_alloc < exp)
+    _mpz_realloc (w, exp);
+
+  wp = w->_mp_d;
+  up = u->_mp_d;
+
+  if (exp <= 0)
+    {
+      SIZ (w) = 0;
+      return;
+    }
+  if (exp < size)
+    {
+      MPN_COPY (wp, up + size - exp, exp);
+    }
+  else
+    {
+      MPN_ZERO (wp, exp - size);
+      MPN_COPY (wp + exp - size, up, size);
+    }
+
+  w->_mp_size = usize >= 0 ? exp : -exp;
+}
diff --git a/src/gmp/mpz/set_q.c b/src/gmp/mpz/set_q.c
new file mode 100644
index 000000000..72d3222a8
--- /dev/null
+++ b/src/gmp/mpz/set_q.c
@@ -0,0 +1,36 @@
+/* mpz_set_q (dest_integer, src_rational) -- Assign DEST_INTEGER from
+   SRC_rational.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_set_q (mpz_ptr w, mpq_srcptr u)
+#else
+mpz_set_q (w, u)
+     mpz_ptr w;
+     mpq_srcptr u;
+#endif
+{
+  mpz_tdiv_q (w, mpq_numref (u), mpq_denref (u));
+}
diff --git a/src/gmp/mpz/set_si.c b/src/gmp/mpz/set_si.c
new file mode 100644
index 000000000..9ba2fbaf3
--- /dev/null
+++ b/src/gmp/mpz/set_si.c
@@ -0,0 +1,48 @@
+/* mpz_set_si(integer, val) -- Assign INTEGER with a small value VAL.
+
+Copyright (C) 1991, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_set_si (mpz_ptr dest, signed long int val)
+#else
+mpz_set_si (dest, val)
+     mpz_ptr dest;
+     signed long int val;
+#endif
+{
+  /* We don't check if the allocation is enough, since the rest of the
+     package ensures it's at least 1, which is what we need here.  */
+  if (val > 0)
+    {
+      dest->_mp_d[0] = val;
+      dest->_mp_size = 1;
+    }
+  else if (val < 0)
+    {
+      dest->_mp_d[0] = (unsigned long) -val;
+      dest->_mp_size = -1;
+    }
+  else
+    dest->_mp_size = 0;
+}
diff --git a/src/gmp/mpz/set_str.c b/src/gmp/mpz/set_str.c
new file mode 100644
index 000000000..3ab79c0e8
--- /dev/null
+++ b/src/gmp/mpz/set_str.c
@@ -0,0 +1,157 @@
+/* mpz_set_str(mp_dest, string, base) -- Convert the \0-terminated
+   string STRING in base BASE to multiple precision integer in
+   MP_DEST.  Allow white space in the string.  If BASE == 0 determine
+   the base in the C standard way, i.e.  0xhh...h means base 16,
+   0oo...o means base 8, otherwise assume base 10.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 1998, 2000 Free Software
+Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <string.h>
+#include <ctype.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+static int
+#if __STDC__
+digit_value_in_base (int c, int base)
+#else
+digit_value_in_base (c, base)
+     int c;
+     int base;
+#endif
+{
+  int digit;
+
+  if (isdigit (c))
+    digit = c - '0';
+  else if (islower (c))
+    digit = c - 'a' + 10;
+  else if (isupper (c))
+    digit = c - 'A' + 10;
+  else
+    return -1;
+
+  if (digit < base)
+    return digit;
+  return -1;
+}
+
+int
+#if __STDC__
+mpz_set_str (mpz_ptr x, const char *str, int base)
+#else
+mpz_set_str (x, str, base)
+     mpz_ptr x;
+     const char *str;
+     int base;
+#endif
+{
+  size_t str_size;
+  char *s, *begs;
+  size_t i;
+  mp_size_t xsize;
+  int c;
+  int negative;
+  TMP_DECL (marker);
+
+  /* Skip whitespace.  */
+  do
+    c = *str++;
+  while (isspace (c));
+
+  negative = 0;
+  if (c == '-')
+    {
+      negative = 1;
+      c = *str++;
+    }
+
+  if (digit_value_in_base (c, base == 0 ? 10 : base) < 0)
+    return -1;			/* error if no digits */
+
+  /* If BASE is 0, try to find out the base by looking at the initial
+     characters.  */
+  if (base == 0)
+    {
+      base = 10;
+      if (c == '0')
+	{
+	  base = 8;
+	  c = *str++;
+	  if (c == 'x' || c == 'X')
+	    {
+	      base = 16;
+	      c = *str++;
+	    }
+	  else if (c == 'b' || c == 'B')
+	    {
+	      base = 2;
+	      c = *str++;
+	    }
+	}
+    }
+
+  /* Skip leading zeros.  */
+  while (c == '0')
+    c = *str++;
+  /* Make sure the string does not become empty, mpn_set_str would fail.  */
+  if (c == 0)
+    {
+      x->_mp_size = 0;
+      return 0;
+    }
+
+  TMP_MARK (marker);
+  str_size = strlen (str - 1);
+  s = begs = (char *) TMP_ALLOC (str_size + 1);
+
+  /* Remove spaces from the string and convert the result from ASCII to a
+     byte array.  */
+  for (i = 0; i < str_size; i++)
+    {
+      if (!isspace (c))
+	{
+	  int dig = digit_value_in_base (c, base);
+	  if (dig < 0)
+	    {
+	      TMP_FREE (marker);
+	      return -1;
+	    }
+	  *s++ = dig;
+	}
+      c = *str++;
+    }
+
+  str_size = s - begs;
+
+  xsize = (((mp_size_t) (str_size / __mp_bases[base].chars_per_bit_exactly))
+	   / BITS_PER_MP_LIMB + 2);
+  if (x->_mp_alloc < xsize)
+    _mpz_realloc (x, xsize);
+
+  /* Convert the byte array in base BASE to our bignum format.  */
+  xsize = mpn_set_str (x->_mp_d, (unsigned char *) begs, str_size, base);
+  x->_mp_size = negative ? -xsize : xsize;
+
+  TMP_FREE (marker);
+  return 0;
+}
diff --git a/src/gmp/mpz/set_ui.c b/src/gmp/mpz/set_ui.c
new file mode 100644
index 000000000..d6097c170
--- /dev/null
+++ b/src/gmp/mpz/set_ui.c
@@ -0,0 +1,43 @@
+/* mpz_set_ui(integer, val) -- Assign INTEGER with a small value VAL.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_set_ui (mpz_ptr dest, unsigned long int val)
+#else
+mpz_set_ui (dest, val)
+     mpz_ptr dest;
+     unsigned long int val;
+#endif
+{
+  /* We don't check if the allocation is enough, since the rest of the
+     package ensures it's at least 1, which is what we need here.  */
+  if (val > 0)
+    {
+      dest->_mp_d[0] = val;
+      dest->_mp_size = 1;
+    }
+  else
+    dest->_mp_size = 0;
+}
diff --git a/src/gmp/mpz/setbit.c b/src/gmp/mpz/setbit.c
new file mode 100644
index 000000000..d4249a434
--- /dev/null
+++ b/src/gmp/mpz/setbit.c
@@ -0,0 +1,119 @@
+/* mpz_setbit -- set a specified bit.
+
+Copyright (C) 1991, 1993, 1994, 1995, 1997, 1999 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_setbit (mpz_ptr d, unsigned long int bit_index)
+#else
+mpz_setbit (d, bit_index)
+     mpz_ptr d;
+     unsigned long int bit_index;
+#endif
+{
+  mp_size_t dsize = d->_mp_size;
+  mp_ptr dp = d->_mp_d;
+  mp_size_t limb_index;
+
+  limb_index = bit_index / BITS_PER_MP_LIMB;
+  if (dsize >= 0)
+    {
+      if (limb_index < dsize)
+	{
+	  dp[limb_index] |= (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB);
+	  d->_mp_size = dsize;
+	}
+      else
+	{
+	  /* Ugh.  The bit should be set outside of the end of the
+	     number.  We have to increase the size of the number.  */
+	  if (d->_mp_alloc < limb_index + 1)
+	    {
+	      _mpz_realloc (d, limb_index + 1);
+	      dp = d->_mp_d;
+	    }
+	  MPN_ZERO (dp + dsize, limb_index - dsize);
+	  dp[limb_index] = (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB);
+	  d->_mp_size = limb_index + 1;
+	}
+    }
+  else
+    {
+      mp_size_t zero_bound;
+
+      /* Simulate two's complement arithmetic, i.e. simulate
+	 1. Set OP = ~(OP - 1) [with infinitely many leading ones].
+	 2. Set the bit.
+	 3. Set OP = ~OP + 1.  */
+
+      dsize = -dsize;
+
+      /* No upper bound on this loop, we're sure there's a non-zero limb
+	 sooner ot later.  */
+      for (zero_bound = 0; ; zero_bound++)
+	if (dp[zero_bound] != 0)
+	  break;
+
+      if (limb_index > zero_bound)
+	{
+	  if (limb_index < dsize)
+	    dp[limb_index] &= ~((mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB));
+	  else
+	    ;
+	}
+      else if (limb_index == zero_bound)
+	{
+	  dp[limb_index] = ((dp[limb_index] - 1)
+			    & ~((mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB))) + 1;
+	  if (dp[limb_index] == 0)
+	    {
+	      mp_size_t i;
+	      for (i = limb_index + 1; i < dsize; i++)
+		{
+		  dp[i] += 1;
+		  if (dp[i] != 0)
+		    goto fin;
+		}
+	      /* We got carry all way out beyond the end of D.  Increase
+		 its size (and allocation if necessary).  */
+	      dsize++;
+	      if (d->_mp_alloc < dsize)
+		{
+		  _mpz_realloc (d, dsize);
+		  dp = d->_mp_d;
+		}
+	      dp[i] = 1;
+	      d->_mp_size = -dsize;
+	    fin:;
+	    }
+	}
+      else
+	{
+	  mpn_decr_u (dp + limb_index,
+		     (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB));
+	  dsize -= dp[dsize - 1] == 0;
+	  d->_mp_size = -dsize;
+	}
+    }
+}
diff --git a/src/gmp/mpz/size.c b/src/gmp/mpz/size.c
new file mode 100644
index 000000000..657475678
--- /dev/null
+++ b/src/gmp/mpz/size.c
@@ -0,0 +1,35 @@
+/* mpz_size(x) -- return the number of lims currently used by the
+   value of integer X.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+size_t
+#if __STDC__
+mpz_size (mpz_srcptr x)
+#else
+mpz_size (x)
+     mpz_srcptr x;
+#endif
+{
+  return ABS (x->_mp_size);
+}
diff --git a/src/gmp/mpz/sizeinbase.c b/src/gmp/mpz/sizeinbase.c
new file mode 100644
index 000000000..734f9c453
--- /dev/null
+++ b/src/gmp/mpz/sizeinbase.c
@@ -0,0 +1,60 @@
+/* mpz_sizeinbase(x, base) -- return an approximation to the number of
+   character the integer X would have printed in base BASE.  The
+   approximation is never too small.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+size_t
+#if __STDC__
+mpz_sizeinbase (mpz_srcptr x, int base)
+#else
+mpz_sizeinbase (x, base)
+     mpz_srcptr x;
+     int base;
+#endif
+{
+  mp_size_t size = ABS (x->_mp_size);
+  int lb_base, cnt;
+  size_t totbits;
+
+  /* Special case for X == 0.  */
+  if (size == 0)
+    return 1;
+
+  /* Calculate the total number of significant bits of X.  */
+  count_leading_zeros (cnt, x->_mp_d[size - 1]);
+  totbits = size * BITS_PER_MP_LIMB - cnt;
+
+  if ((base & (base - 1)) == 0)
+    {
+      /* Special case for powers of 2, giving exact result.  */
+
+      count_leading_zeros (lb_base, base);
+      lb_base = BITS_PER_MP_LIMB - lb_base - 1;
+
+      return (totbits + lb_base - 1) / lb_base;
+    }
+  else
+    return (size_t) (totbits * __mp_bases[base].chars_per_bit_exactly) + 1;
+}
diff --git a/src/gmp/mpz/sqrt.c b/src/gmp/mpz/sqrt.c
new file mode 100644
index 000000000..fe82fe407
--- /dev/null
+++ b/src/gmp/mpz/sqrt.c
@@ -0,0 +1,86 @@
+/* mpz_sqrt(root, u) --  Set ROOT to floor(sqrt(U)).
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_sqrt (mpz_ptr root, mpz_srcptr op)
+#else
+mpz_sqrt (root, op)
+     mpz_ptr root;
+     mpz_srcptr op;
+#endif
+{
+  mp_size_t op_size, root_size;
+  mp_ptr root_ptr, op_ptr;
+  mp_ptr free_me = NULL;
+  mp_size_t free_me_size;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  op_size = op->_mp_size;
+  if (op_size < 0)
+    SQRT_OF_NEGATIVE;
+
+  /* The size of the root is accurate after this simple calculation.  */
+  root_size = (op_size + 1) / 2;
+
+  root_ptr = root->_mp_d;
+  op_ptr = op->_mp_d;
+
+  if (root->_mp_alloc < root_size)
+    {
+      if (root_ptr == op_ptr)
+	{
+	  free_me = root_ptr;
+	  free_me_size = root->_mp_alloc;
+	}
+      else
+	(*_mp_free_func) (root_ptr, root->_mp_alloc * BYTES_PER_MP_LIMB);
+
+      root->_mp_alloc = root_size;
+      root_ptr = (mp_ptr) (*_mp_allocate_func) (root_size * BYTES_PER_MP_LIMB);
+      root->_mp_d = root_ptr;
+    }
+  else
+    {
+      /* Make OP not overlap with ROOT.  */
+      if (root_ptr == op_ptr)
+	{
+	  /* ROOT and OP are identical.  Allocate temporary space for OP.  */
+	  op_ptr = (mp_ptr) TMP_ALLOC (op_size * BYTES_PER_MP_LIMB);
+	  /* Copy to the temporary space.  Hack: Avoid temporary variable
+	     by using ROOT_PTR.  */
+	  MPN_COPY (op_ptr, root_ptr, op_size);
+	}
+    }
+
+  mpn_sqrtrem (root_ptr, NULL, op_ptr, op_size);
+
+  root->_mp_size = root_size;
+
+  if (free_me != NULL)
+    (*_mp_free_func) (free_me, free_me_size * BYTES_PER_MP_LIMB);
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/sqrtrem.c b/src/gmp/mpz/sqrtrem.c
new file mode 100644
index 000000000..99a645312
--- /dev/null
+++ b/src/gmp/mpz/sqrtrem.c
@@ -0,0 +1,111 @@
+/* mpz_sqrtrem(root,rem,x) -- Set ROOT to floor(sqrt(X)) and REM
+   to the remainder, i.e. X - ROOT**2.
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#include "gmp.h"
+#include "gmp-impl.h"
+#ifdef BERKELEY_MP
+#include "mp.h"
+#endif
+
+#ifndef BERKELEY_MP
+void
+#if __STDC__
+mpz_sqrtrem (mpz_ptr root, mpz_ptr rem, mpz_srcptr op)
+#else
+mpz_sqrtrem (root, rem, op)
+     mpz_ptr root;
+     mpz_ptr rem;
+     mpz_srcptr op;
+#endif
+#else /* BERKELEY_MP */
+void
+#if __STDC__
+msqrt (mpz_srcptr op, mpz_ptr root, mpz_ptr rem)
+#else
+msqrt (op, root, rem)
+     mpz_srcptr op;
+     mpz_ptr root;
+     mpz_ptr rem;
+#endif
+#endif /* BERKELEY_MP */
+{
+  mp_size_t op_size, root_size, rem_size;
+  mp_ptr root_ptr, op_ptr;
+  mp_ptr free_me = NULL;
+  mp_size_t free_me_size;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  op_size = op->_mp_size;
+  if (op_size < 0)
+    SQRT_OF_NEGATIVE;
+
+  if (rem->_mp_alloc < op_size)
+    _mpz_realloc (rem, op_size);
+
+  /* The size of the root is accurate after this simple calculation.  */
+  root_size = (op_size + 1) / 2;
+
+  root_ptr = root->_mp_d;
+  op_ptr = op->_mp_d;
+
+  if (root->_mp_alloc < root_size)
+    {
+      if (root_ptr == op_ptr)
+	{
+	  free_me = root_ptr;
+	  free_me_size = root->_mp_alloc;
+	}
+      else
+	(*_mp_free_func) (root_ptr, root->_mp_alloc * BYTES_PER_MP_LIMB);
+
+      root->_mp_alloc = root_size;
+      root_ptr = (mp_ptr) (*_mp_allocate_func) (root_size * BYTES_PER_MP_LIMB);
+      root->_mp_d = root_ptr;
+    }
+  else
+    {
+      /* Make OP not overlap with ROOT.  */
+      if (root_ptr == op_ptr)
+	{
+	  /* ROOT and OP are identical.  Allocate temporary space for OP.  */
+	  op_ptr = (mp_ptr) TMP_ALLOC (op_size * BYTES_PER_MP_LIMB);
+	  /* Copy to the temporary space.  Hack: Avoid temporary variable
+	     by using ROOT_PTR.  */
+	  MPN_COPY (op_ptr, root_ptr, op_size);
+	}
+    }
+
+  rem_size = mpn_sqrtrem (root_ptr, rem->_mp_d, op_ptr, op_size);
+
+  root->_mp_size = root_size;
+
+  /* Write remainder size last, to enable us to define this function to
+     give only the square root remainder, if the user calls if with
+     ROOT == REM.  */
+  rem->_mp_size = rem_size;
+
+  if (free_me != NULL)
+    (*_mp_free_func) (free_me, free_me_size * BYTES_PER_MP_LIMB);
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/sub.c b/src/gmp/mpz/sub.c
new file mode 100644
index 000000000..f3ae7c23a
--- /dev/null
+++ b/src/gmp/mpz/sub.c
@@ -0,0 +1,123 @@
+/* mpz_sub -- Subtract two integers.
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#ifdef BERKELEY_MP
+#include "mp.h"
+#endif
+
+#ifndef BERKELEY_MP
+void
+#if __STDC__
+mpz_sub (mpz_ptr w, mpz_srcptr u, mpz_srcptr v)
+#else
+mpz_sub (w, u, v)
+     mpz_ptr w;
+     mpz_srcptr u;
+     mpz_srcptr v;
+#endif
+#else /* BERKELEY_MP */
+void
+#if __STDC__
+msub (mpz_srcptr u, mpz_srcptr v, mpz_ptr w)
+#else
+msub (u, v, w)
+     mpz_srcptr u;
+     mpz_srcptr v;
+     mpz_ptr w;
+#endif
+#endif /* BERKELEY_MP */
+{
+  mp_srcptr up, vp;
+  mp_ptr wp;
+  mp_size_t usize, vsize, wsize;
+  mp_size_t abs_usize;
+  mp_size_t abs_vsize;
+
+  usize = u->_mp_size;
+  vsize = -v->_mp_size;		/* The "-" makes the difference from mpz_add */
+  abs_usize = ABS (usize);
+  abs_vsize = ABS (vsize);
+
+  if (abs_usize < abs_vsize)
+    {
+      /* Swap U and V. */
+      MPZ_SRCPTR_SWAP (u, v);
+      MP_SIZE_T_SWAP (usize, vsize);
+      MP_SIZE_T_SWAP (abs_usize, abs_vsize);
+    }
+
+  /* True: ABS_USIZE >= ABS_VSIZE.  */
+
+  /* If not space for w (and possible carry), increase space.  */
+  wsize = abs_usize + 1;
+  if (w->_mp_alloc < wsize)
+    _mpz_realloc (w, wsize);
+
+  /* These must be after realloc (u or v may be the same as w).  */
+  up = u->_mp_d;
+  vp = v->_mp_d;
+  wp = w->_mp_d;
+
+  if ((usize ^ vsize) < 0)
+    {
+      /* U and V have different sign.  Need to compare them to determine
+	 which operand to subtract from which.  */
+
+      /* This test is right since ABS_USIZE >= ABS_VSIZE.  */
+      if (abs_usize != abs_vsize)
+	{
+	  mpn_sub (wp, up, abs_usize, vp, abs_vsize);
+	  wsize = abs_usize;
+	  MPN_NORMALIZE (wp, wsize);
+	  if (usize < 0)
+	    wsize = -wsize;
+	}
+      else if (mpn_cmp (up, vp, abs_usize) < 0)
+	{
+	  mpn_sub_n (wp, vp, up, abs_usize);
+	  wsize = abs_usize;
+	  MPN_NORMALIZE (wp, wsize);
+	  if (usize >= 0)
+	    wsize = -wsize;
+	}
+      else
+	{
+	  mpn_sub_n (wp, up, vp, abs_usize);
+	  wsize = abs_usize;
+	  MPN_NORMALIZE (wp, wsize);
+	  if (usize < 0)
+	    wsize = -wsize;
+	}
+    }
+  else
+    {
+      /* U and V have same sign.  Add them.  */
+      mp_limb_t cy_limb = mpn_add (wp, up, abs_usize, vp, abs_vsize);
+      wp[abs_usize] = cy_limb;
+      wsize = abs_usize + cy_limb;
+      if (usize < 0)
+	wsize = -wsize;
+    }
+
+  w->_mp_size = wsize;
+}
diff --git a/src/gmp/mpz/sub_ui.c b/src/gmp/mpz/sub_ui.c
new file mode 100644
index 000000000..327add850
--- /dev/null
+++ b/src/gmp/mpz/sub_ui.c
@@ -0,0 +1,84 @@
+/* mpz_sub_ui -- Subtract an unsigned one-word integer from an MP_INT.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_sub_ui (mpz_ptr w, mpz_srcptr u, unsigned long int v)
+#else
+mpz_sub_ui (w, u, v)
+     mpz_ptr w;
+     mpz_srcptr u;
+     unsigned long int v;
+#endif
+{
+  mp_srcptr up;
+  mp_ptr wp;
+  mp_size_t usize, wsize;
+  mp_size_t abs_usize;
+
+  usize = u->_mp_size;
+  abs_usize = ABS (usize);
+
+  /* If not space for W (and possible carry), increase space.  */
+  wsize = abs_usize + 1;
+  if (w->_mp_alloc < wsize)
+    _mpz_realloc (w, wsize);
+
+  /* These must be after realloc (U may be the same as W).  */
+  up = u->_mp_d;
+  wp = w->_mp_d;
+
+  if (abs_usize == 0)
+    {
+      wp[0] = v;
+      w->_mp_size = -(v != 0);
+      return;
+    }
+
+  if (usize < 0)
+    {
+      mp_limb_t cy;
+      cy = mpn_add_1 (wp, up, abs_usize, (mp_limb_t) v);
+      wp[abs_usize] = cy;
+      wsize = -(abs_usize + cy);
+    }
+  else
+    {
+      /* The signs are different.  Need exact comparison to determine
+	 which operand to subtract from which.  */
+      if (abs_usize == 1 && up[0] < v)
+	{
+	  wp[0] = v - up[0];
+	  wsize = -1;
+	}
+      else
+	{
+	  mpn_sub_1 (wp, up, abs_usize, (mp_limb_t) v);
+	  /* Size can decrease with at most one limb.  */
+	  wsize = abs_usize - (wp[abs_usize - 1] == 0);
+	}
+    }
+
+  w->_mp_size = wsize;
+}
diff --git a/src/gmp/mpz/swap.c b/src/gmp/mpz/swap.c
new file mode 100644
index 000000000..0070d6ff2
--- /dev/null
+++ b/src/gmp/mpz/swap.c
@@ -0,0 +1,52 @@
+/* mpz_swap (dest_integer, src_integer) -- Swap U and V.
+
+Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_swap (mpz_ptr u, mpz_ptr v)
+#else
+mpz_swap (u, v)
+     mpz_ptr u;
+     mpz_ptr v;
+#endif
+{
+  mp_ptr up, vp;
+  mp_size_t usize, vsize;
+  mp_size_t ualloc, valloc;
+
+  ualloc = u->_mp_alloc;
+  valloc = v->_mp_alloc;
+  v->_mp_alloc = ualloc;
+  u->_mp_alloc = valloc;
+
+  usize = u->_mp_size;
+  vsize = v->_mp_size;
+  v->_mp_size = usize;
+  u->_mp_size = vsize;
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+  v->_mp_d = up;
+  u->_mp_d = vp;
+}
diff --git a/src/gmp/mpz/tdiv_q.c b/src/gmp/mpz/tdiv_q.c
new file mode 100644
index 000000000..21db4ab38
--- /dev/null
+++ b/src/gmp/mpz/tdiv_q.c
@@ -0,0 +1,91 @@
+/* mpz_tdiv_q -- divide two integers and produce a quotient.
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpz_tdiv_q (mpz_ptr quot, mpz_srcptr num, mpz_srcptr den)
+#else
+mpz_tdiv_q (quot, num, den)
+     mpz_ptr quot;
+     mpz_srcptr num;
+     mpz_srcptr den;
+#endif
+{
+  mp_size_t ql;
+  mp_size_t ns, ds, nl, dl;
+  mp_ptr np, dp, qp, rp;
+  TMP_DECL (marker);
+
+  ns = SIZ (num);
+  ds = SIZ (den);
+  nl = ABS (ns);
+  dl = ABS (ds);
+  ql = nl - dl + 1;
+
+  if (dl == 0)
+    DIVIDE_BY_ZERO;
+
+  if (ql <= 0)
+    {
+      SIZ (quot) = 0;
+      return;
+    }
+
+  MPZ_REALLOC (quot, ql);
+
+  TMP_MARK (marker);
+  qp = PTR (quot);
+  rp = (mp_ptr) TMP_ALLOC (dl * BYTES_PER_MP_LIMB);
+  np = PTR (num);
+  dp = PTR (den);
+
+  /* FIXME: We should think about how to handle the temporary allocation.
+     Perhaps mpn_tdiv_qr should handle it, since it anyway often needs to
+     allocate temp space.  */
+
+  /* Copy denominator to temporary space if it overlaps with the quotient.  */
+  if (dp == qp)
+    {
+      mp_ptr tp;
+      tp = (mp_ptr) TMP_ALLOC (dl * BYTES_PER_MP_LIMB);
+      MPN_COPY (tp, dp, dl);
+      dp = tp;
+    }
+  /* Copy numerator to temporary space if it overlaps with the quotient.  */
+  if (np == qp)
+    {
+      mp_ptr tp;
+      tp = (mp_ptr) TMP_ALLOC (nl * BYTES_PER_MP_LIMB);
+      MPN_COPY (tp, np, nl);
+      np = tp;
+    }
+
+  mpn_tdiv_qr (qp, rp, 0L, np, nl, dp, dl);
+
+  ql -=  qp[ql - 1] == 0;
+
+  SIZ (quot) = (ns ^ ds) >= 0 ? ql : -ql;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/tdiv_q_2exp.c b/src/gmp/mpz/tdiv_q_2exp.c
new file mode 100644
index 000000000..03d1e01f8
--- /dev/null
+++ b/src/gmp/mpz/tdiv_q_2exp.c
@@ -0,0 +1,68 @@
+/* mpz_tdiv_q_2exp -- Divide an integer by 2**CNT.  Round the quotient
+   towards -infinity.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_tdiv_q_2exp (mpz_ptr w, mpz_srcptr u, unsigned long int cnt)
+#else
+mpz_tdiv_q_2exp (w, u, cnt)
+     mpz_ptr w;
+     mpz_srcptr u;
+     unsigned long int cnt;
+#endif
+{
+  mp_size_t usize, wsize;
+  mp_size_t limb_cnt;
+
+  usize = u->_mp_size;
+  limb_cnt = cnt / BITS_PER_MP_LIMB;
+  wsize = ABS (usize) - limb_cnt;
+  if (wsize <= 0)
+    w->_mp_size = 0;
+  else
+    {
+      mp_ptr wp;
+      mp_srcptr up;
+
+      if (w->_mp_alloc < wsize)
+	_mpz_realloc (w, wsize);
+
+      wp = w->_mp_d;
+      up = u->_mp_d;
+
+      cnt %= BITS_PER_MP_LIMB;
+      if (cnt != 0)
+	{
+	  mpn_rshift (wp, up + limb_cnt, wsize, cnt);
+	  wsize -= wp[wsize - 1] == 0;
+	}
+      else
+	{
+	  MPN_COPY_INCR (wp, up + limb_cnt, wsize);
+	}
+
+      w->_mp_size = usize >= 0 ? wsize : -wsize;
+    }
+}
diff --git a/src/gmp/mpz/tdiv_q_ui.c b/src/gmp/mpz/tdiv_q_ui.c
new file mode 100644
index 000000000..a2e3462b7
--- /dev/null
+++ b/src/gmp/mpz/tdiv_q_ui.c
@@ -0,0 +1,64 @@
+/* mpz_tdiv_q_ui(quot, dividend, divisor_limb)
+   -- Divide DIVIDEND by DIVISOR_LIMB and store the result in QUOT.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1998 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_tdiv_q_ui (mpz_ptr quot, mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_tdiv_q_ui (quot, dividend, divisor)
+     mpz_ptr quot;
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_ptr quot_ptr;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  /* No need for temporary allocation and copying if QUOT == DIVIDEND as
+     the divisor is just one limb, and thus no intermediate remainders
+     need to be stored.  */
+
+  if (quot->_mp_alloc < size)
+    _mpz_realloc (quot, size);
+
+  quot_ptr = quot->_mp_d;
+
+  remainder_limb
+    = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size, (mp_limb_t) divisor);
+
+  /* The quotient is SIZE limbs, but the most significant might be zero. */
+  size -= size != 0 && quot_ptr[size - 1] == 0;
+  quot->_mp_size = dividend_size >= 0 ? size : -size;
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/tdiv_qr.c b/src/gmp/mpz/tdiv_qr.c
new file mode 100644
index 000000000..d66f57d9e
--- /dev/null
+++ b/src/gmp/mpz/tdiv_qr.c
@@ -0,0 +1,130 @@
+/* mpz_tdiv_qr(quot,rem,dividend,divisor) -- Set QUOT to DIVIDEND/DIVISOR,
+   and REM to DIVIDEND mod DIVISOR.
+
+Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#ifdef BERKELEY_MP
+#include "mp.h"
+#endif
+
+
+#ifndef BERKELEY_MP
+
+void
+#if __STDC__
+mpz_tdiv_qr (mpz_ptr quot, mpz_ptr rem, mpz_srcptr num, mpz_srcptr den)
+#else
+mpz_tdiv_qr (quot, rem, num, den)
+     mpz_ptr quot;
+     mpz_ptr rem;
+     mpz_srcptr num;
+     mpz_srcptr den;
+#endif
+
+#else /* BERKELEY_MP */
+
+void
+#if __STDC__
+mdiv (mpz_srcptr num, mpz_srcptr den, mpz_ptr quot, mpz_ptr rem)
+#else
+mdiv (num, den, quot, rem)
+     mpz_srcptr num;
+     mpz_srcptr den;
+     mpz_ptr    quot;
+     mpz_ptr    rem;
+#endif
+
+#endif /* BERKELEY_MP */
+{
+  mp_size_t ql;
+  mp_size_t ns, ds, nl, dl;
+  mp_ptr np, dp, qp, rp;
+  TMP_DECL (marker);
+
+  ns = SIZ (num);
+  ds = SIZ (den);
+  nl = ABS (ns);
+  dl = ABS (ds);
+  ql = nl - dl + 1;
+
+  if (dl == 0)
+    DIVIDE_BY_ZERO;
+
+  MPZ_REALLOC (rem, dl);
+
+  if (ql <= 0)
+    {
+      if (num != rem)
+	{
+	  mp_ptr np, rp;
+	  np = PTR (num);
+	  rp = PTR (rem);
+	  MPN_COPY (rp, np, nl);
+	  SIZ (rem) = SIZ (num);
+	}
+      /* This needs to follow the assignment to rem, in case the
+	 numerator and quotient are the same.  */
+      SIZ (quot) = 0;
+      return;
+    }
+
+  MPZ_REALLOC (quot, ql);
+
+  TMP_MARK (marker);
+  qp = PTR (quot);
+  rp = PTR (rem);
+  np = PTR (num);
+  dp = PTR (den);
+
+  /* FIXME: We should think about how to handle the temporary allocation.
+     Perhaps mpn_tdiv_qr should handle it, since it anyway often needs to
+     allocate temp space.  */
+
+  /* Copy denominator to temporary space if it overlaps with the quotient
+     or remainder.  */
+  if (dp == rp || dp == qp)
+    {
+      mp_ptr tp;
+      tp = (mp_ptr) TMP_ALLOC (dl * BYTES_PER_MP_LIMB);
+      MPN_COPY (tp, dp, dl);
+      dp = tp;
+    }
+  /* Copy numerator to temporary space if it overlaps with the quotient or
+     remainder.  */
+  if (np == rp || np == qp)
+    {
+      mp_ptr tp;
+      tp = (mp_ptr) TMP_ALLOC (nl * BYTES_PER_MP_LIMB);
+      MPN_COPY (tp, np, nl);
+      np = tp;
+    }
+
+  mpn_tdiv_qr (qp, rp, 0L, np, nl, dp, dl);
+
+  ql -=  qp[ql - 1] == 0;
+  MPN_NORMALIZE (rp, dl);
+
+  SIZ (quot) = (ns ^ ds) >= 0 ? ql : -ql;
+  SIZ (rem) = ns >= 0 ? dl : -dl;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/tdiv_qr_ui.c b/src/gmp/mpz/tdiv_qr_ui.c
new file mode 100644
index 000000000..10368cd34
--- /dev/null
+++ b/src/gmp/mpz/tdiv_qr_ui.c
@@ -0,0 +1,76 @@
+/* mpz_tdiv_qr_ui(quot,rem,dividend,short_divisor) --
+   Set QUOT to DIVIDEND / SHORT_DIVISOR
+   and REM to DIVIDEND mod SHORT_DIVISOR.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1998 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_tdiv_qr_ui (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_tdiv_qr_ui (quot, rem, dividend, divisor)
+     mpz_ptr quot;
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_ptr quot_ptr;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  /* No need for temporary allocation and copying if QUOT == DIVIDEND as
+     the divisor is just one limb, and thus no intermediate remainders
+     need to be stored.  */
+
+  if (quot->_mp_alloc < size)
+    _mpz_realloc (quot, size);
+
+  quot_ptr = quot->_mp_d;
+
+  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
+				 (mp_limb_t) divisor);
+
+  if (remainder_limb == 0)
+    rem->_mp_size = 0;
+  else
+    {
+      /* Store the single-limb remainder.  We don't check if there's space
+	 for just one limb, since no function ever makes zero space.  */
+      rem->_mp_size = dividend_size >= 0 ? 1 : -1;
+      rem->_mp_d[0] = remainder_limb;
+    }
+
+  /* The quotient is SIZE limbs, but the most significant might be zero. */
+  size -= size != 0 && quot_ptr[size - 1] == 0;
+  quot->_mp_size = dividend_size >= 0 ? size : -size;
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/tdiv_r.c b/src/gmp/mpz/tdiv_r.c
new file mode 100644
index 000000000..9eb87dfab
--- /dev/null
+++ b/src/gmp/mpz/tdiv_r.c
@@ -0,0 +1,98 @@
+/* mpz_tdiv_r(rem, dividend, divisor) -- Set REM to DIVIDEND mod DIVISOR.
+
+Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpz_tdiv_r (mpz_ptr rem, mpz_srcptr num, mpz_srcptr den)
+#else
+mpz_tdiv_r (rem, num, den)
+     mpz_ptr rem;
+     mpz_srcptr num;
+     mpz_srcptr den;
+#endif
+{
+  mp_size_t ql;
+  mp_size_t ns, ds, nl, dl;
+  mp_ptr np, dp, qp, rp;
+  TMP_DECL (marker);
+
+  ns = SIZ (num);
+  ds = SIZ (den);
+  nl = ABS (ns);
+  dl = ABS (ds);
+  ql = nl - dl + 1;
+
+  if (dl == 0)
+    DIVIDE_BY_ZERO;
+
+  MPZ_REALLOC (rem, dl);
+
+  if (ql <= 0)
+    {
+      if (num != rem)
+	{
+	  mp_ptr np, rp;
+	  np = PTR (num);
+	  rp = PTR (rem);
+	  MPN_COPY (rp, np, nl);
+	  SIZ (rem) = SIZ (num);
+	}
+      return;
+    }
+
+  TMP_MARK (marker);
+  qp = (mp_ptr) TMP_ALLOC (ql * BYTES_PER_MP_LIMB);
+  rp = PTR (rem);
+  np = PTR (num);
+  dp = PTR (den);
+
+  /* FIXME: We should think about how to handle the temporary allocation.
+     Perhaps mpn_tdiv_qr should handle it, since it anyway often needs to
+     allocate temp space.  */
+
+  /* Copy denominator to temporary space if it overlaps with the remainder.  */
+  if (dp == rp)
+    {
+      mp_ptr tp;
+      tp = (mp_ptr) TMP_ALLOC (dl * BYTES_PER_MP_LIMB);
+      MPN_COPY (tp, dp, dl);
+      dp = tp;
+    }
+  /* Copy numerator to temporary space if it overlaps with the remainder.  */
+  if (np == rp)
+    {
+      mp_ptr tp;
+      tp = (mp_ptr) TMP_ALLOC (nl * BYTES_PER_MP_LIMB);
+      MPN_COPY (tp, np, nl);
+      np = tp;
+    }
+
+  mpn_tdiv_qr (qp, rp, 0L, np, nl, dp, dl);
+
+  MPN_NORMALIZE (rp, dl);
+
+  SIZ (rem) = ns >= 0 ? dl : -dl;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/tdiv_r_2exp.c b/src/gmp/mpz/tdiv_r_2exp.c
new file mode 100644
index 000000000..91de170f5
--- /dev/null
+++ b/src/gmp/mpz/tdiv_r_2exp.c
@@ -0,0 +1,79 @@
+/* mpz_tdiv_r_2exp -- Divide a integer by 2**CNT and produce a remainder.
+
+Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_tdiv_r_2exp (mpz_ptr res, mpz_srcptr in, unsigned long int cnt)
+#else
+mpz_tdiv_r_2exp (res, in, cnt)
+     mpz_ptr res;
+     mpz_srcptr in;
+     unsigned long int cnt;
+#endif
+{
+  mp_size_t in_size = ABS (in->_mp_size);
+  mp_size_t res_size;
+  mp_size_t limb_cnt = cnt / BITS_PER_MP_LIMB;
+  mp_srcptr in_ptr = in->_mp_d;
+
+  if (in_size > limb_cnt)
+    {
+      /* The input operand is (probably) greater than 2**CNT.  */
+      mp_limb_t x;
+
+      x = in_ptr[limb_cnt] & (((mp_limb_t) 1 << cnt % BITS_PER_MP_LIMB) - 1);
+      if (x != 0)
+	{
+	  res_size = limb_cnt + 1;
+	  if (res->_mp_alloc < res_size)
+	    _mpz_realloc (res, res_size);
+
+	  res->_mp_d[limb_cnt] = x;
+	}
+      else
+	{
+	  res_size = limb_cnt;
+	  MPN_NORMALIZE (in_ptr, res_size);
+
+	  if (res->_mp_alloc < res_size)
+	    _mpz_realloc (res, res_size);
+
+	  limb_cnt = res_size;
+	}
+    }
+  else
+    {
+      /* The input operand is smaller than 2**CNT.  We perform a no-op,
+	 apart from that we might need to copy IN to RES.  */
+      res_size = in_size;
+      if (res->_mp_alloc < res_size)
+	_mpz_realloc (res, res_size);
+
+      limb_cnt = res_size;
+    }
+
+  if (res != in)
+    MPN_COPY (res->_mp_d, in->_mp_d, limb_cnt);
+  res->_mp_size = in->_mp_size >= 0 ? res_size : -res_size;
+}
diff --git a/src/gmp/mpz/tdiv_r_ui.c b/src/gmp/mpz/tdiv_r_ui.c
new file mode 100644
index 000000000..2ea411fda
--- /dev/null
+++ b/src/gmp/mpz/tdiv_r_ui.c
@@ -0,0 +1,63 @@
+/* mpz_tdiv_r_ui(rem, dividend, divisor_limb)
+   -- Set REM to DIVDEND mod DIVISOR_LIMB.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1998 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_tdiv_r_ui (mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_tdiv_r_ui (rem, dividend, divisor)
+     mpz_ptr rem;
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  /* No need for temporary allocation and copying if QUOT == DIVIDEND as
+     the divisor is just one limb, and thus no intermediate remainders
+     need to be stored.  */
+
+  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
+
+  if (remainder_limb == 0)
+    rem->_mp_size = 0;
+  else
+    {
+      /* Store the single-limb remainder.  We don't check if there's space
+	 for just one limb, since no function ever makes zero space.  */
+      rem->_mp_size = dividend_size >= 0 ? 1 : -1;
+      rem->_mp_d[0] = remainder_limb;
+    }
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/tdiv_ui.c b/src/gmp/mpz/tdiv_ui.c
new file mode 100644
index 000000000..7a40a6a7f
--- /dev/null
+++ b/src/gmp/mpz/tdiv_ui.c
@@ -0,0 +1,53 @@
+/* mpz_tdiv_ui(dividend, divisor_limb)
+   -- Return DIVDEND mod DIVISOR_LIMB.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 1998 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+unsigned long int
+#if __STDC__
+mpz_tdiv_ui (mpz_srcptr dividend, unsigned long int divisor)
+#else
+mpz_tdiv_ui (dividend, divisor)
+     mpz_srcptr dividend;
+     unsigned long int divisor;
+#endif
+{
+  mp_size_t dividend_size;
+  mp_size_t size;
+  mp_limb_t remainder_limb;
+
+  if (divisor == 0)
+    DIVIDE_BY_ZERO;
+
+  dividend_size = dividend->_mp_size;
+  size = ABS (dividend_size);
+
+  /* No need for temporary allocation and copying if QUOT == DIVIDEND as
+     the divisor is just one limb, and thus no intermediate remainders
+     need to be stored.  */
+
+  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
+
+  return remainder_limb;
+}
diff --git a/src/gmp/mpz/tests/Makefile.am b/src/gmp/mpz/tests/Makefile.am
new file mode 100644
index 000000000..b93502e92
--- /dev/null
+++ b/src/gmp/mpz/tests/Makefile.am
@@ -0,0 +1,35 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+check_PROGRAMS = t-mul t-tdiv t-tdiv_ui t-fdiv t-fdiv_ui t-gcd \
+  dive t-sqrtrem convert io logic bit t-powm t-powm_ui t-pow_ui t-2exp reuse \
+  t-root t-jac t-bin t-misc
+
+TESTS = $(check_PROGRAMS)
+
+# io.tmp is used by io.c, removed automatically if the tests pass
+CLEANFILES = io.tmp
diff --git a/src/gmp/mpz/tests/Makefile.in b/src/gmp/mpz/tests/Makefile.in
new file mode 100644
index 000000000..26d3ecf34
--- /dev/null
+++ b/src/gmp/mpz/tests/Makefile.in
@@ -0,0 +1,651 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+check_PROGRAMS = t-mul t-tdiv t-tdiv_ui t-fdiv t-fdiv_ui t-gcd \
+  dive t-sqrtrem convert io logic bit t-powm t-powm_ui t-pow_ui t-2exp reuse \
+  t-root t-jac t-bin t-misc
+
+
+TESTS = $(check_PROGRAMS)
+
+# io.tmp is used by io.c, removed automatically if the tests pass
+CLEANFILES = io.tmp
+subdir = mpz/tests
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../../config.h
+CONFIG_CLEAN_FILES = 
+check_PROGRAMS =  t-mul$(EXEEXT) t-tdiv$(EXEEXT) t-tdiv_ui$(EXEEXT) \
+t-fdiv$(EXEEXT) t-fdiv_ui$(EXEEXT) t-gcd$(EXEEXT) dive$(EXEEXT) \
+t-sqrtrem$(EXEEXT) convert$(EXEEXT) io$(EXEEXT) logic$(EXEEXT) \
+bit$(EXEEXT) t-powm$(EXEEXT) t-powm_ui$(EXEEXT) t-pow_ui$(EXEEXT) \
+t-2exp$(EXEEXT) reuse$(EXEEXT) t-root$(EXEEXT) t-jac$(EXEEXT) \
+t-bin$(EXEEXT) t-misc$(EXEEXT)
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I../..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+ANSI2KNR = $(top_builddir)/ansi2knr
+bit_SOURCES = bit.c
+bit_OBJECTS =  bit$U.$(OBJEXT)
+bit_LDADD = $(LDADD)
+bit_DEPENDENCIES =  $(top_builddir)/libgmp.la
+bit_LDFLAGS = 
+convert_SOURCES = convert.c
+convert_OBJECTS =  convert$U.$(OBJEXT)
+convert_LDADD = $(LDADD)
+convert_DEPENDENCIES =  $(top_builddir)/libgmp.la
+convert_LDFLAGS = 
+dive_SOURCES = dive.c
+dive_OBJECTS =  dive$U.$(OBJEXT)
+dive_LDADD = $(LDADD)
+dive_DEPENDENCIES =  $(top_builddir)/libgmp.la
+dive_LDFLAGS = 
+io_SOURCES = io.c
+io_OBJECTS =  io$U.$(OBJEXT)
+io_LDADD = $(LDADD)
+io_DEPENDENCIES =  $(top_builddir)/libgmp.la
+io_LDFLAGS = 
+logic_SOURCES = logic.c
+logic_OBJECTS =  logic$U.$(OBJEXT)
+logic_LDADD = $(LDADD)
+logic_DEPENDENCIES =  $(top_builddir)/libgmp.la
+logic_LDFLAGS = 
+reuse_SOURCES = reuse.c
+reuse_OBJECTS =  reuse$U.$(OBJEXT)
+reuse_LDADD = $(LDADD)
+reuse_DEPENDENCIES =  $(top_builddir)/libgmp.la
+reuse_LDFLAGS = 
+t_2exp_SOURCES = t-2exp.c
+t_2exp_OBJECTS =  t-2exp$U.$(OBJEXT)
+t_2exp_LDADD = $(LDADD)
+t_2exp_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_2exp_LDFLAGS = 
+t_bin_SOURCES = t-bin.c
+t_bin_OBJECTS =  t-bin$U.$(OBJEXT)
+t_bin_LDADD = $(LDADD)
+t_bin_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_bin_LDFLAGS = 
+t_fdiv_SOURCES = t-fdiv.c
+t_fdiv_OBJECTS =  t-fdiv$U.$(OBJEXT)
+t_fdiv_LDADD = $(LDADD)
+t_fdiv_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_fdiv_LDFLAGS = 
+t_fdiv_ui_SOURCES = t-fdiv_ui.c
+t_fdiv_ui_OBJECTS =  t-fdiv_ui$U.$(OBJEXT)
+t_fdiv_ui_LDADD = $(LDADD)
+t_fdiv_ui_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_fdiv_ui_LDFLAGS = 
+t_gcd_SOURCES = t-gcd.c
+t_gcd_OBJECTS =  t-gcd$U.$(OBJEXT)
+t_gcd_LDADD = $(LDADD)
+t_gcd_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_gcd_LDFLAGS = 
+t_jac_SOURCES = t-jac.c
+t_jac_OBJECTS =  t-jac$U.$(OBJEXT)
+t_jac_LDADD = $(LDADD)
+t_jac_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_jac_LDFLAGS = 
+t_misc_SOURCES = t-misc.c
+t_misc_OBJECTS =  t-misc$U.$(OBJEXT)
+t_misc_LDADD = $(LDADD)
+t_misc_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_misc_LDFLAGS = 
+t_mul_SOURCES = t-mul.c
+t_mul_OBJECTS =  t-mul$U.$(OBJEXT)
+t_mul_LDADD = $(LDADD)
+t_mul_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_mul_LDFLAGS = 
+t_pow_ui_SOURCES = t-pow_ui.c
+t_pow_ui_OBJECTS =  t-pow_ui$U.$(OBJEXT)
+t_pow_ui_LDADD = $(LDADD)
+t_pow_ui_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_pow_ui_LDFLAGS = 
+t_powm_SOURCES = t-powm.c
+t_powm_OBJECTS =  t-powm$U.$(OBJEXT)
+t_powm_LDADD = $(LDADD)
+t_powm_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_powm_LDFLAGS = 
+t_powm_ui_SOURCES = t-powm_ui.c
+t_powm_ui_OBJECTS =  t-powm_ui$U.$(OBJEXT)
+t_powm_ui_LDADD = $(LDADD)
+t_powm_ui_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_powm_ui_LDFLAGS = 
+t_root_SOURCES = t-root.c
+t_root_OBJECTS =  t-root$U.$(OBJEXT)
+t_root_LDADD = $(LDADD)
+t_root_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_root_LDFLAGS = 
+t_sqrtrem_SOURCES = t-sqrtrem.c
+t_sqrtrem_OBJECTS =  t-sqrtrem$U.$(OBJEXT)
+t_sqrtrem_LDADD = $(LDADD)
+t_sqrtrem_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_sqrtrem_LDFLAGS = 
+t_tdiv_SOURCES = t-tdiv.c
+t_tdiv_OBJECTS =  t-tdiv$U.$(OBJEXT)
+t_tdiv_LDADD = $(LDADD)
+t_tdiv_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_tdiv_LDFLAGS = 
+t_tdiv_ui_SOURCES = t-tdiv_ui.c
+t_tdiv_ui_OBJECTS =  t-tdiv_ui$U.$(OBJEXT)
+t_tdiv_ui_LDADD = $(LDADD)
+t_tdiv_ui_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_tdiv_ui_LDFLAGS = 
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  bit.c convert.c dive.c io.c logic.c reuse.c t-2exp.c \
+t-bin.c t-fdiv.c t-fdiv_ui.c t-gcd.c t-jac.c t-misc.c t-mul.c \
+t-pow_ui.c t-powm.c t-powm_ui.c t-root.c t-sqrtrem.c t-tdiv.c \
+t-tdiv_ui.c
+DIST_COMMON =  Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = bit.c convert.c dive.c io.c logic.c reuse.c t-2exp.c t-bin.c t-fdiv.c t-fdiv_ui.c t-gcd.c t-jac.c t-misc.c t-mul.c t-pow_ui.c t-powm.c t-powm_ui.c t-root.c t-sqrtrem.c t-tdiv.c t-tdiv_ui.c
+OBJECTS = bit$U.$(OBJEXT) convert$U.$(OBJEXT) dive$U.$(OBJEXT) io$U.$(OBJEXT) logic$U.$(OBJEXT) reuse$U.$(OBJEXT) t-2exp$U.$(OBJEXT) t-bin$U.$(OBJEXT) t-fdiv$U.$(OBJEXT) t-fdiv_ui$U.$(OBJEXT) t-gcd$U.$(OBJEXT) t-jac$U.$(OBJEXT) t-misc$U.$(OBJEXT) t-mul$U.$(OBJEXT) t-pow_ui$U.$(OBJEXT) t-powm$U.$(OBJEXT) t-powm_ui$U.$(OBJEXT) t-root$U.$(OBJEXT) t-sqrtrem$U.$(OBJEXT) t-tdiv$U.$(OBJEXT) t-tdiv_ui$U.$(OBJEXT)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpz/tests/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-checkPROGRAMS:
+
+clean-checkPROGRAMS:
+	-test -z "$(check_PROGRAMS)" || rm -f $(check_PROGRAMS)
+
+distclean-checkPROGRAMS:
+
+maintainer-clean-checkPROGRAMS:
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+$(top_builddir)/ansi2knr: $(top_builddir)/ansi2knr.$(OBJEXT)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr
+
+$(top_builddir)/ansi2knr.$(OBJEXT):
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr.$(OBJEXT)
+
+
+mostlyclean-kr:
+	-rm -f *_.c
+
+clean-kr:
+
+distclean-kr:
+
+maintainer-clean-kr:
+
+bit$(EXEEXT): $(bit_OBJECTS) $(bit_DEPENDENCIES)
+	@rm -f bit$(EXEEXT)
+	$(LINK) $(bit_LDFLAGS) $(bit_OBJECTS) $(bit_LDADD) $(LIBS)
+
+convert$(EXEEXT): $(convert_OBJECTS) $(convert_DEPENDENCIES)
+	@rm -f convert$(EXEEXT)
+	$(LINK) $(convert_LDFLAGS) $(convert_OBJECTS) $(convert_LDADD) $(LIBS)
+
+dive$(EXEEXT): $(dive_OBJECTS) $(dive_DEPENDENCIES)
+	@rm -f dive$(EXEEXT)
+	$(LINK) $(dive_LDFLAGS) $(dive_OBJECTS) $(dive_LDADD) $(LIBS)
+
+io$(EXEEXT): $(io_OBJECTS) $(io_DEPENDENCIES)
+	@rm -f io$(EXEEXT)
+	$(LINK) $(io_LDFLAGS) $(io_OBJECTS) $(io_LDADD) $(LIBS)
+
+logic$(EXEEXT): $(logic_OBJECTS) $(logic_DEPENDENCIES)
+	@rm -f logic$(EXEEXT)
+	$(LINK) $(logic_LDFLAGS) $(logic_OBJECTS) $(logic_LDADD) $(LIBS)
+
+reuse$(EXEEXT): $(reuse_OBJECTS) $(reuse_DEPENDENCIES)
+	@rm -f reuse$(EXEEXT)
+	$(LINK) $(reuse_LDFLAGS) $(reuse_OBJECTS) $(reuse_LDADD) $(LIBS)
+
+t-2exp$(EXEEXT): $(t_2exp_OBJECTS) $(t_2exp_DEPENDENCIES)
+	@rm -f t-2exp$(EXEEXT)
+	$(LINK) $(t_2exp_LDFLAGS) $(t_2exp_OBJECTS) $(t_2exp_LDADD) $(LIBS)
+
+t-bin$(EXEEXT): $(t_bin_OBJECTS) $(t_bin_DEPENDENCIES)
+	@rm -f t-bin$(EXEEXT)
+	$(LINK) $(t_bin_LDFLAGS) $(t_bin_OBJECTS) $(t_bin_LDADD) $(LIBS)
+
+t-fdiv$(EXEEXT): $(t_fdiv_OBJECTS) $(t_fdiv_DEPENDENCIES)
+	@rm -f t-fdiv$(EXEEXT)
+	$(LINK) $(t_fdiv_LDFLAGS) $(t_fdiv_OBJECTS) $(t_fdiv_LDADD) $(LIBS)
+
+t-fdiv_ui$(EXEEXT): $(t_fdiv_ui_OBJECTS) $(t_fdiv_ui_DEPENDENCIES)
+	@rm -f t-fdiv_ui$(EXEEXT)
+	$(LINK) $(t_fdiv_ui_LDFLAGS) $(t_fdiv_ui_OBJECTS) $(t_fdiv_ui_LDADD) $(LIBS)
+
+t-gcd$(EXEEXT): $(t_gcd_OBJECTS) $(t_gcd_DEPENDENCIES)
+	@rm -f t-gcd$(EXEEXT)
+	$(LINK) $(t_gcd_LDFLAGS) $(t_gcd_OBJECTS) $(t_gcd_LDADD) $(LIBS)
+
+t-jac$(EXEEXT): $(t_jac_OBJECTS) $(t_jac_DEPENDENCIES)
+	@rm -f t-jac$(EXEEXT)
+	$(LINK) $(t_jac_LDFLAGS) $(t_jac_OBJECTS) $(t_jac_LDADD) $(LIBS)
+
+t-misc$(EXEEXT): $(t_misc_OBJECTS) $(t_misc_DEPENDENCIES)
+	@rm -f t-misc$(EXEEXT)
+	$(LINK) $(t_misc_LDFLAGS) $(t_misc_OBJECTS) $(t_misc_LDADD) $(LIBS)
+
+t-mul$(EXEEXT): $(t_mul_OBJECTS) $(t_mul_DEPENDENCIES)
+	@rm -f t-mul$(EXEEXT)
+	$(LINK) $(t_mul_LDFLAGS) $(t_mul_OBJECTS) $(t_mul_LDADD) $(LIBS)
+
+t-pow_ui$(EXEEXT): $(t_pow_ui_OBJECTS) $(t_pow_ui_DEPENDENCIES)
+	@rm -f t-pow_ui$(EXEEXT)
+	$(LINK) $(t_pow_ui_LDFLAGS) $(t_pow_ui_OBJECTS) $(t_pow_ui_LDADD) $(LIBS)
+
+t-powm$(EXEEXT): $(t_powm_OBJECTS) $(t_powm_DEPENDENCIES)
+	@rm -f t-powm$(EXEEXT)
+	$(LINK) $(t_powm_LDFLAGS) $(t_powm_OBJECTS) $(t_powm_LDADD) $(LIBS)
+
+t-powm_ui$(EXEEXT): $(t_powm_ui_OBJECTS) $(t_powm_ui_DEPENDENCIES)
+	@rm -f t-powm_ui$(EXEEXT)
+	$(LINK) $(t_powm_ui_LDFLAGS) $(t_powm_ui_OBJECTS) $(t_powm_ui_LDADD) $(LIBS)
+
+t-root$(EXEEXT): $(t_root_OBJECTS) $(t_root_DEPENDENCIES)
+	@rm -f t-root$(EXEEXT)
+	$(LINK) $(t_root_LDFLAGS) $(t_root_OBJECTS) $(t_root_LDADD) $(LIBS)
+
+t-sqrtrem$(EXEEXT): $(t_sqrtrem_OBJECTS) $(t_sqrtrem_DEPENDENCIES)
+	@rm -f t-sqrtrem$(EXEEXT)
+	$(LINK) $(t_sqrtrem_LDFLAGS) $(t_sqrtrem_OBJECTS) $(t_sqrtrem_LDADD) $(LIBS)
+
+t-tdiv$(EXEEXT): $(t_tdiv_OBJECTS) $(t_tdiv_DEPENDENCIES)
+	@rm -f t-tdiv$(EXEEXT)
+	$(LINK) $(t_tdiv_LDFLAGS) $(t_tdiv_OBJECTS) $(t_tdiv_LDADD) $(LIBS)
+
+t-tdiv_ui$(EXEEXT): $(t_tdiv_ui_OBJECTS) $(t_tdiv_ui_DEPENDENCIES)
+	@rm -f t-tdiv_ui$(EXEEXT)
+	$(LINK) $(t_tdiv_ui_LDFLAGS) $(t_tdiv_ui_OBJECTS) $(t_tdiv_ui_LDADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+bit_.c: bit.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/bit.c; then echo $(srcdir)/bit.c; else echo bit.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > bit_.c
+convert_.c: convert.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/convert.c; then echo $(srcdir)/convert.c; else echo convert.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > convert_.c
+dive_.c: dive.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/dive.c; then echo $(srcdir)/dive.c; else echo dive.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > dive_.c
+io_.c: io.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/io.c; then echo $(srcdir)/io.c; else echo io.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > io_.c
+logic_.c: logic.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/logic.c; then echo $(srcdir)/logic.c; else echo logic.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > logic_.c
+reuse_.c: reuse.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/reuse.c; then echo $(srcdir)/reuse.c; else echo reuse.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > reuse_.c
+t-2exp_.c: t-2exp.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-2exp.c; then echo $(srcdir)/t-2exp.c; else echo t-2exp.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-2exp_.c
+t-bin_.c: t-bin.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-bin.c; then echo $(srcdir)/t-bin.c; else echo t-bin.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-bin_.c
+t-fdiv_.c: t-fdiv.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-fdiv.c; then echo $(srcdir)/t-fdiv.c; else echo t-fdiv.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-fdiv_.c
+t-fdiv_ui_.c: t-fdiv_ui.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-fdiv_ui.c; then echo $(srcdir)/t-fdiv_ui.c; else echo t-fdiv_ui.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-fdiv_ui_.c
+t-gcd_.c: t-gcd.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-gcd.c; then echo $(srcdir)/t-gcd.c; else echo t-gcd.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-gcd_.c
+t-jac_.c: t-jac.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-jac.c; then echo $(srcdir)/t-jac.c; else echo t-jac.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-jac_.c
+t-misc_.c: t-misc.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-misc.c; then echo $(srcdir)/t-misc.c; else echo t-misc.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-misc_.c
+t-mul_.c: t-mul.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-mul.c; then echo $(srcdir)/t-mul.c; else echo t-mul.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-mul_.c
+t-pow_ui_.c: t-pow_ui.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-pow_ui.c; then echo $(srcdir)/t-pow_ui.c; else echo t-pow_ui.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-pow_ui_.c
+t-powm_.c: t-powm.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-powm.c; then echo $(srcdir)/t-powm.c; else echo t-powm.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-powm_.c
+t-powm_ui_.c: t-powm_ui.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-powm_ui.c; then echo $(srcdir)/t-powm_ui.c; else echo t-powm_ui.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-powm_ui_.c
+t-root_.c: t-root.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-root.c; then echo $(srcdir)/t-root.c; else echo t-root.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-root_.c
+t-sqrtrem_.c: t-sqrtrem.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-sqrtrem.c; then echo $(srcdir)/t-sqrtrem.c; else echo t-sqrtrem.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-sqrtrem_.c
+t-tdiv_.c: t-tdiv.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-tdiv.c; then echo $(srcdir)/t-tdiv.c; else echo t-tdiv.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-tdiv_.c
+t-tdiv_ui_.c: t-tdiv_ui.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-tdiv_ui.c; then echo $(srcdir)/t-tdiv_ui.c; else echo t-tdiv_ui.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-tdiv_ui_.c
+bit_.$(OBJEXT) bit_.lo convert_.$(OBJEXT) convert_.lo dive_.$(OBJEXT) \
+dive_.lo io_.$(OBJEXT) io_.lo logic_.$(OBJEXT) logic_.lo \
+reuse_.$(OBJEXT) reuse_.lo t-2exp_.$(OBJEXT) t-2exp_.lo \
+t-bin_.$(OBJEXT) t-bin_.lo t-fdiv_.$(OBJEXT) t-fdiv_.lo \
+t-fdiv_ui_.$(OBJEXT) t-fdiv_ui_.lo t-gcd_.$(OBJEXT) t-gcd_.lo \
+t-jac_.$(OBJEXT) t-jac_.lo t-misc_.$(OBJEXT) t-misc_.lo \
+t-mul_.$(OBJEXT) t-mul_.lo t-pow_ui_.$(OBJEXT) t-pow_ui_.lo \
+t-powm_.$(OBJEXT) t-powm_.lo t-powm_ui_.$(OBJEXT) t-powm_ui_.lo \
+t-root_.$(OBJEXT) t-root_.lo t-sqrtrem_.$(OBJEXT) t-sqrtrem_.lo \
+t-tdiv_.$(OBJEXT) t-tdiv_.lo t-tdiv_ui_.$(OBJEXT) t-tdiv_ui_.lo : \
+$(ANSI2KNR)
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+check-TESTS: $(TESTS)
+	@failed=0; all=0; xfail=0; xpass=0; \
+	srcdir=$(srcdir); export srcdir; \
+	for tst in $(TESTS); do \
+	  if test -f ./$$tst; then dir=./; \
+	  elif test -f $$tst; then dir=; \
+	  else dir="$(srcdir)/"; fi; \
+	  if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xpass=`expr $$xpass + 1`; \
+	      failed=`expr $$failed + 1`; \
+	      echo "XPASS: $$tst"; \
+	    ;; \
+	    *) \
+	      echo "PASS: $$tst"; \
+	    ;; \
+	    esac; \
+	  elif test $$? -ne 77; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xfail=`expr $$xfail + 1`; \
+	      echo "XFAIL: $$tst"; \
+	    ;; \
+	    *) \
+	      failed=`expr $$failed + 1`; \
+	      echo "FAIL: $$tst"; \
+	    ;; \
+	    esac; \
+	  fi; \
+	done; \
+	if test "$$failed" -eq 0; then \
+	  if test "$$xfail" -eq 0; then \
+	    banner="All $$all tests passed"; \
+	  else \
+	    banner="All $$all tests behaved as expected ($$xfail expected failures)"; \
+	  fi; \
+	else \
+	  if test "$$xpass" -eq 0; then \
+	    banner="$$failed of $$all tests failed"; \
+	  else \
+	    banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \
+	  fi; \
+	fi; \
+	dashes=`echo "$$banner" | sed s/./=/g`; \
+	echo "$$dashes"; \
+	echo "$$banner"; \
+	echo "$$dashes"; \
+	test "$$failed" -eq 0
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am: all-am
+	$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
+	$(MAKE) $(AM_MAKEFLAGS) check-TESTS
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am:
+install-data: install-data-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am:
+uninstall: uninstall-am
+all-am: Makefile
+all-redirect: all-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs:
+
+
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-checkPROGRAMS mostlyclean-compile \
+		mostlyclean-libtool mostlyclean-kr mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am:  clean-checkPROGRAMS clean-compile clean-libtool clean-kr \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-am
+
+distclean-am:  distclean-checkPROGRAMS distclean-compile \
+		distclean-libtool distclean-kr distclean-tags \
+		distclean-generic clean-am
+	-rm -f libtool
+
+distclean: distclean-am
+
+maintainer-clean-am:  maintainer-clean-checkPROGRAMS \
+		maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-kr maintainer-clean-tags \
+		maintainer-clean-generic distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-checkPROGRAMS distclean-checkPROGRAMS \
+clean-checkPROGRAMS maintainer-clean-checkPROGRAMS mostlyclean-compile \
+distclean-compile clean-compile maintainer-clean-compile \
+mostlyclean-libtool distclean-libtool clean-libtool \
+maintainer-clean-libtool mostlyclean-kr distclean-kr clean-kr \
+maintainer-clean-kr tags mostlyclean-tags distclean-tags clean-tags \
+maintainer-clean-tags distdir check-TESTS info-am info dvi-am dvi check \
+check-am installcheck-am installcheck install-exec-am install-exec \
+install-data-am install-data install-am install uninstall-am uninstall \
+all-redirect all-am all install-strip 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/src/gmp/mpz/tests/bit.c b/src/gmp/mpz/tests/bit.c
new file mode 100644
index 000000000..606bec24e
--- /dev/null
+++ b/src/gmp/mpz/tests/bit.c
@@ -0,0 +1,120 @@
+/* Test mpz_setbit, mpz_clrbit, mpz_tstbit.
+
+Copyright (C) 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 4
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t x, s0, s1, s2, s3, m;
+  mp_size_t xsize;
+  int i;
+  int reps = 100000;
+  int bit0, bit1, bit2, bit3;
+  unsigned long int bitindex;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (x);
+  mpz_init (s0);
+  mpz_init (s1);
+  mpz_init (s2);
+  mpz_init (s3);
+  mpz_init (m);
+
+  for (i = 0; i < reps; i++)
+    {
+      xsize = urandom () % (2 * SIZE) - SIZE;
+      mpz_random2 (x, xsize);
+      bitindex = urandom () % SIZE;
+
+      mpz_set (s0, x);
+      bit0 = mpz_tstbit (x, bitindex);
+      mpz_setbit (x, bitindex);
+      MPZ_CHECK_FORMAT (x);
+
+      mpz_set (s1, x);
+      bit1 = mpz_tstbit (x, bitindex);
+      mpz_clrbit (x, bitindex);
+      MPZ_CHECK_FORMAT (x);
+
+      mpz_set (s2, x);
+      bit2 = mpz_tstbit (x, bitindex);
+      mpz_setbit (x, bitindex);
+      MPZ_CHECK_FORMAT (x);
+
+      mpz_set (s3, x);
+      bit3 = mpz_tstbit (x, bitindex);
+
+      if (bit1 != 1 || bit2 != 0 || bit3 != 1)
+	abort ();
+
+      if (bit0 == 0)
+	{
+	  if (mpz_cmp (s0, s1) == 0 || mpz_cmp (s0, s2) != 0 || mpz_cmp (s0, s3) == 0)
+	    abort ();
+	}
+      else
+	{
+	  if (mpz_cmp (s0, s1) != 0 || mpz_cmp (s0, s2) == 0 || mpz_cmp (s0, s3) != 0)
+	    abort ();
+	}
+
+      if (mpz_cmp (s1, s2) == 0 || mpz_cmp (s1, s3) != 0)
+	abort ();
+      if (mpz_cmp (s2, s3) == 0)
+	abort ();
+
+      mpz_ui_pow_ui (m, 2L, bitindex);
+      MPZ_CHECK_FORMAT (m);
+      mpz_ior (x, s2, m);
+      MPZ_CHECK_FORMAT (x);
+      if (mpz_cmp (x, s3) != 0)
+	abort ();
+
+      mpz_com (m, m);
+      MPZ_CHECK_FORMAT (m);
+      mpz_and (x, s1, m);
+      MPZ_CHECK_FORMAT (x);
+      if (mpz_cmp (x, s2) != 0)
+	abort ();
+    }
+
+  exit (0);
+}
+
+void
+debug_mp (x, base)
+     MP_INT *x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/convert.c b/src/gmp/mpz/tests/convert.c
new file mode 100644
index 000000000..7526092d2
--- /dev/null
+++ b/src/gmp/mpz/tests/convert.c
@@ -0,0 +1,80 @@
+/* Test conversion using mpz_get_str and mpz_set_str.
+
+Copyright (C) 1993, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 32
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t op1, op2;
+  mp_size_t size;
+  int i;
+  int reps = 100000;
+  char *str;
+  int base;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (op1);
+  mpz_init (op2);
+
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % SIZE - SIZE/2;
+
+      mpz_random2 (op1, size);
+      base = urandom () % 36 + 1;
+      if (base == 1)
+	base = 0;
+
+      str = mpz_get_str ((char *) 0, base, op1);
+      mpz_set_str (op2, str, base);
+      (*_mp_free_func) (str, 0);
+
+      if (mpz_cmp (op1, op2))
+	{
+	  fprintf (stderr, "ERROR\n");
+	  fprintf (stderr, "op1  = "); debug_mp (op1, -16);
+	  fprintf (stderr, "base = %d\n", base);
+	  abort ();
+	}
+    }
+
+  exit (0);
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/dive.c b/src/gmp/mpz/tests/dive.c
new file mode 100644
index 000000000..d62b6c12b
--- /dev/null
+++ b/src/gmp/mpz/tests/dive.c
@@ -0,0 +1,87 @@
+/* Test mpz_mul, mpz_divexact.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 32
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t op1, op2;
+  mpz_t prod, quot;
+  mp_size_t size;
+  int i;
+  int reps = 100000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (op1);
+  mpz_init (op2);
+  mpz_init (prod);
+  mpz_init (quot);
+
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (op1, size);
+
+      do
+	{
+	  size = urandom () % SIZE - SIZE/2;
+	  mpz_random2 (op2, size);
+	}
+      while (mpz_cmp_ui (op2, 0) == 0);
+
+      mpz_mul (prod, op1, op2);
+
+      mpz_divexact (quot, prod, op2);
+      if (mpz_cmp (quot, op1) != 0)
+	dump_abort (quot, op1);
+    }
+
+  exit (0);
+}
+
+dump_abort (op1, op2)
+     mpz_t op1, op2;
+{
+  fprintf (stderr, "ERROR\n");
+  fprintf (stderr, "ref = "); debug_mp (op1, -16);
+  fprintf (stderr, "wrong = "); debug_mp (op2, -16);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/io.c b/src/gmp/mpz/tests/io.c
new file mode 100644
index 000000000..e62610cdd
--- /dev/null
+++ b/src/gmp/mpz/tests/io.c
@@ -0,0 +1,97 @@
+/* Test conversion and I/O using mpz_out_str and mpz_inp_str.
+
+Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#define FILENAME  "io.tmp"
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+void
+debug_mp (mpz_t x, int base)
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
+
+int
+main (int argc, char **argv)
+{
+  mpz_t  op1, op2;
+  mp_size_t size;
+  int i;
+  int reps = 10000;
+  FILE *fp;
+  int base;
+
+  if (argc == 2)
+    reps = atoi (argv[1]);
+
+  mpz_init (op1);
+  mpz_init (op2);
+
+  fp = fopen (FILENAME, "w+"); 
+
+  for (i = 0; i < reps; i++)
+    {
+      size = urandom () % SIZE - SIZE/2;
+
+      mpz_random2 (op1, size);
+      base = urandom () % 36 + 1;
+      if (base == 1)
+	base = 0;
+
+      rewind (fp);  
+      if (mpz_out_str (fp, base, op1) == 0
+          || putc (' ', fp) == EOF
+          || fflush (fp) != 0)
+        {
+          fprintf (stderr, "mpz_out_str write error\n");
+          abort ();
+        }
+
+      rewind (fp);  
+      if (mpz_inp_str (op2, fp, base) == 0)
+        {
+	  fprintf (stderr, "mpz_inp_str read error\n");
+	  abort ();
+	}
+
+      if (mpz_cmp (op1, op2))
+	{
+	  fprintf (stderr, "ERROR\n");
+	  fprintf (stderr, "op1  = "); debug_mp (op1, -16);
+	  fprintf (stderr, "op2  = "); debug_mp (op2, -16);
+	  fprintf (stderr, "base = %d\n", base);
+	  abort ();
+	}
+    }
+
+  fclose (fp);
+
+  unlink (FILENAME);
+
+  exit (0);
+}
diff --git a/src/gmp/mpz/tests/logic.c b/src/gmp/mpz/tests/logic.c
new file mode 100644
index 000000000..ea0de6fab
--- /dev/null
+++ b/src/gmp/mpz/tests/logic.c
@@ -0,0 +1,130 @@
+/* Test mpz_com, mpz_and, mpz_ior, and mpz_xor.
+
+Copyright (C) 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t x, y, r1, r2;
+  mpz_t t1, t2, t3, t4;
+  mp_size_t xsize, ysize;
+  int i;
+  int reps = 100000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (x);
+  mpz_init (y);
+  mpz_init (r1);
+  mpz_init (r2);
+  mpz_init (t1);
+  mpz_init (t2);
+  mpz_init (t3);
+  mpz_init (t4);
+
+  for (i = 0; i < reps; i++)
+    {
+      xsize = urandom () % SIZE - SIZE/2;
+      mpz_random2 (x, xsize);
+
+      ysize = urandom () % SIZE - SIZE/2;
+      mpz_random2 (y, ysize);
+
+      mpz_com (r1, x);
+      MPZ_CHECK_FORMAT (r1);
+      mpz_com (r1, r1);
+      MPZ_CHECK_FORMAT (r1);
+      if (mpz_cmp (r1, x) != 0)
+	dump_abort ();
+
+      mpz_com (r1, y);
+      MPZ_CHECK_FORMAT (r1);
+      mpz_com (r2, r1);
+      MPZ_CHECK_FORMAT (r2);
+      if (mpz_cmp (r2, y) != 0)
+	dump_abort ();
+
+      mpz_com (t1, x);
+      MPZ_CHECK_FORMAT (t1);
+      mpz_com (t2, y);
+      MPZ_CHECK_FORMAT (t2);
+      mpz_and (t3, t1, t2);
+      MPZ_CHECK_FORMAT (t3);
+      mpz_com (r1, t3);
+      MPZ_CHECK_FORMAT (r1);
+      mpz_ior (r2, x, y);
+      MPZ_CHECK_FORMAT (r2);
+      if (mpz_cmp (r1, r2) != 0)
+	dump_abort ();
+
+      mpz_com (t1, x);
+      MPZ_CHECK_FORMAT (t1);
+      mpz_com (t2, y);
+      MPZ_CHECK_FORMAT (t2);
+      mpz_ior (t3, t1, t2);
+      MPZ_CHECK_FORMAT (t3);
+      mpz_com (r1, t3);
+      MPZ_CHECK_FORMAT (r1);
+      mpz_and (r2, x, y);
+      MPZ_CHECK_FORMAT (r2);
+      if (mpz_cmp (r1, r2) != 0)
+	dump_abort ();
+
+      mpz_ior (t1, x, y);
+      MPZ_CHECK_FORMAT (t1);
+      mpz_and (t2, x, y);
+      MPZ_CHECK_FORMAT (t2);
+      mpz_com (t3, t2);
+      MPZ_CHECK_FORMAT (t3);
+      mpz_and (r1, t1, t3);
+      MPZ_CHECK_FORMAT (r1);
+      mpz_xor (r2, x, y);
+      MPZ_CHECK_FORMAT (r2);
+      if (mpz_cmp (r1, r2) != 0)
+	dump_abort ();
+    }
+
+  exit (0);
+}
+
+dump_abort ()
+{
+  abort();
+}
+
+void
+debug_mp (x, base)
+     MP_INT *x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/reuse.c b/src/gmp/mpz/tests/reuse.c
new file mode 100644
index 000000000..f2417239a
--- /dev/null
+++ b/src/gmp/mpz/tests/reuse.c
@@ -0,0 +1,512 @@
+/* Test that routines allow reusing a source variable as destination.
+
+   Test all relevant functions except:
+	mpz_bin_ui
+	mpz_nextprime
+	mpz_mul_si
+	mpz_addmul_ui (should this really allow a+=a*c?)
+Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 50
+#endif
+
+typedef void (*dss_func) _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
+typedef void (*dsi_func) _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+typedef unsigned long int (*dsi_div_func) _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
+typedef unsigned long int (*ddsi_div_func) _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
+typedef void (*ddss_div_func) _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
+typedef void (*ds_func) _PROTO ((mpz_ptr, mpz_srcptr));
+
+
+void
+#if __STDC__
+mpz_xinvert (mpz_ptr r, mpz_srcptr a, mpz_srcptr b)
+#else
+mpz_xinvert (r, a, b)
+     mpz_ptr    r;
+     mpz_srcptr a;
+     mpz_srcptr b;
+#endif
+{
+  int res;
+  res = mpz_invert (r, a, b);
+  if (res == 0)
+    mpz_set_ui (r, 0);
+}
+
+dss_func dss_funcs[] =
+{
+  mpz_add, mpz_sub, mpz_mul,
+  mpz_cdiv_q, mpz_cdiv_r, mpz_fdiv_q, mpz_fdiv_r, mpz_tdiv_q, mpz_tdiv_r,
+  mpz_xinvert,
+  mpz_gcd, mpz_lcm, mpz_and, mpz_ior, mpz_xor
+};
+char *dss_func_names[] =
+{
+  "mpz_add", "mpz_sub", "mpz_mul",
+  "mpz_cdiv_q", "mpz_cdiv_r", "mpz_fdiv_q", "mpz_fdiv_r", "mpz_tdiv_q", "mpz_tdiv_r",
+  "mpz_xinvert",
+  "mpz_gcd", "mpz_lcm", "mpz_and", "mpz_ior", "mpz_xor"
+};
+char dss_func_division[] = {0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0};
+
+dsi_func dsi_funcs[] =
+{
+  /* Don't change order here without changing the code in main(). */
+  mpz_add_ui, mpz_mul_ui, mpz_sub_ui,
+  mpz_fdiv_q_2exp, mpz_fdiv_r_2exp,
+  mpz_tdiv_q_2exp, mpz_tdiv_r_2exp,
+  mpz_mul_2exp,
+  mpz_pow_ui
+};
+char *dsi_func_names[] =
+{
+  "mpz_add_ui", "mpz_mul_ui", "mpz_sub_ui",
+  "mpz_fdiv_q_2exp", "mpz_fdiv_r_2exp",
+  "mpz_tdiv_q_2exp", "mpz_tdiv_r_2exp",
+  "mpz_mul_2exp",
+  "mpz_pow_ui"
+};
+
+dsi_div_func dsi_div_funcs[] =
+{
+  mpz_cdiv_q_ui, mpz_cdiv_r_ui,
+  mpz_fdiv_q_ui, mpz_fdiv_r_ui,
+  mpz_tdiv_q_ui, mpz_tdiv_r_ui
+};
+char *dsi_div_func_names[] =
+{
+  "mpz_cdiv_q_ui", "mpz_cdiv_r_ui",
+  "mpz_fdiv_q_ui", "mpz_fdiv_r_ui",
+  "mpz_tdiv_q_ui", "mpz_tdiv_r_ui"
+};
+
+ddsi_div_func ddsi_div_funcs[] =
+{
+  mpz_cdiv_qr_ui,
+  mpz_fdiv_qr_ui,
+  mpz_tdiv_qr_ui
+};
+char *ddsi_div_func_names[] =
+{
+  "mpz_cdiv_qr_ui",
+  "mpz_fdiv_qr_ui",
+  "mpz_tdiv_qr_ui"
+};
+
+ddss_div_func ddss_div_funcs[] =
+{
+  mpz_cdiv_qr,
+  mpz_fdiv_qr,
+  mpz_tdiv_qr
+};
+char *ddss_div_func_names[] =
+{
+  "mpz_cdiv_qr",
+  "mpz_fdiv_qr",
+  "mpz_tdiv_qr"
+};
+
+ds_func ds_funcs[] =
+{
+  mpz_abs, mpz_com, mpz_neg, mpz_sqrt
+};
+char *ds_func_names[] =
+{
+  "mpz_abs", "mpz_com", "mpz_neg", "mpz_sqrt"
+};
+
+
+/* Really use `defined (__STDC__)' here; we want it to be true for Sun C */
+#if defined (__STDC__) || defined (__cplusplus)
+#define FAIL(class,indx,op1,op2,op3) \
+  do {									\
+  class##_funcs[indx] = 0;						\
+  dump_abort (class##_func_names[indx], op1, op2, op3);			\
+  failures++;								\
+  } while (0)
+#else
+#define FAIL(class,indx,op1,op2,op3) \
+  do {									\
+  class/**/_funcs[indx] = 0;						\
+  dump_abort (class/**/_func_names[indx], op1, op2, op3);		\
+  failures++;								\
+  } while (0)
+#endif
+
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  int i;
+  int pass, reps = 1000;
+  mpz_t in1, in2, in3;
+  unsigned long int in2i;
+  mpz_t res1, res2, res3;
+  mpz_t ref1, ref2, ref3;
+  mpz_t t;
+  unsigned long int r1, r2;
+  long failures = 0;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (in1);
+  mpz_init (in2);
+  mpz_init (in3);
+  mpz_init (ref1);
+  mpz_init (ref2);
+  mpz_init (ref3);
+  mpz_init (res1);
+  mpz_init (res2);
+  mpz_init (res3);
+  mpz_init (t);
+
+  for (pass = 1; pass <= reps; pass++)
+    {
+      mpz_random2 (in1, urandom () % (2 * SIZE) - SIZE);
+      mpz_random2 (in2, urandom () % (2 * SIZE) - SIZE);
+      mpz_random2 (in3, urandom () % (2 * SIZE) - SIZE);
+
+      for (i = 0; i < sizeof (dss_funcs) / sizeof (dss_func); i++)
+	{
+	  if (dss_funcs[i] == 0)
+	    continue;
+	  if (dss_func_division[i] && mpz_sgn (in2) == 0)
+	    continue;
+
+	  (dss_funcs[i]) (ref1, in1, in2);
+
+	  mpz_set (res1, in1);
+	  (dss_funcs[i]) (res1, res1, in2);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    FAIL (dss, i, in1, in2, NULL);
+
+	  mpz_set (res1, in2);
+	  (dss_funcs[i]) (res1, in1, res1);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    FAIL (dss, i, in1, in2, NULL);
+	}
+
+      for (i = 0; i < sizeof (ddss_div_funcs) / sizeof (ddss_div_func); i++)
+	{
+	  if (ddss_div_funcs[i] == 0)
+	    continue;
+	  if (mpz_sgn (in2) == 0)
+	    continue;
+
+	  (ddss_div_funcs[i]) (ref1, ref2, in1, in2);
+
+	  mpz_set (res1, in1);
+	  (ddss_div_funcs[i]) (res1, res2, res1, in2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0)
+	    FAIL (ddss_div, i, in1, in2, NULL);
+
+	  mpz_set (res2, in1);
+	  (ddss_div_funcs[i]) (res1, res2, res2, in2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0)
+	    FAIL (ddss_div, i, in1, in2, NULL);
+
+	  mpz_set (res1, in2);
+	  (ddss_div_funcs[i]) (res1, res2, in1, res1);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0)
+	    FAIL (ddss_div, i, in1, in2, NULL);
+
+	  mpz_set (res2, in2);
+	  (ddss_div_funcs[i]) (res1, res2, in1, res2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0)
+	    FAIL (ddss_div, i, in1, in2, NULL);
+	}
+
+      for (i = 0; i < sizeof (ds_funcs) / sizeof (ds_func); i++)
+	{
+	  if (ds_funcs[i] == 0)
+	    continue;
+	  if (strcmp (ds_func_names[i], "mpz_sqrt") == 0
+	      && mpz_sgn (in1) < 0)
+	    continue;
+
+	  (ds_funcs[i]) (ref1, in1);
+
+	  mpz_set (res1, in1);
+	  (ds_funcs[i]) (res1, res1);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    FAIL (ds, i, in1, in2, NULL);
+	}
+
+      in2i = mpz_get_ui (in2);
+
+      for (i = 0; i < sizeof (dsi_funcs) / sizeof (dsi_func); i++)
+	{
+	  if (dsi_funcs[i] == 0)
+	    continue;
+	  if (strcmp (dsi_func_names[i], "mpz_fdiv_q_2exp") == 0)
+	    /* Limit exponent to something reasonable for the division
+	       functions.  Without this, we'd  normally shift things off
+	       the end and just generate the trivial values 1, 0, -1.  */
+	    in2i %= 0x1000;
+	  if (strcmp (dsi_func_names[i], "mpz_mul_2exp") == 0)
+	    /* Limit exponent more for mpz_mul_2exp to save time.  */
+	    in2i %= 0x100;
+	  if (strcmp (dsi_func_names[i], "mpz_pow_ui") == 0)
+	    /* Limit exponent yet more for mpz_pow_ui to save time.  */
+	    in2i %= 0x10;
+
+	  (dsi_funcs[i]) (ref1, in1, in2i);
+
+	  mpz_set (res1, in1);
+	  (dsi_funcs[i]) (res1, res1, in2i);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    FAIL (dsi, i, in1, in2, NULL);
+	}
+
+      if (in2i != 0)	  /* Don't divide by 0.  */
+	{
+	  for (i = 0; i < sizeof (dsi_div_funcs) / sizeof (dsi_div_funcs); i++)
+	    {
+	      r1 = (dsi_div_funcs[i]) (ref1, in1, in2i);
+
+	      mpz_set (res1, in1);
+	      r2 = (dsi_div_funcs[i]) (res1, res1, in2i);
+	      if (mpz_cmp (ref1, res1) != 0 || r1 != r2)
+		FAIL (dsi_div, i, in1, in2, NULL);
+	    }
+
+	  for (i = 0; i < sizeof (ddsi_div_funcs) / sizeof (ddsi_div_funcs); i++)
+	    {
+	      r1 = (ddsi_div_funcs[i]) (ref1, ref2, in1, in2i);
+
+	      mpz_set (res1, in1);
+	      r2 = (ddsi_div_funcs[i]) (res1, res2, res1, in2i);
+	      if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0 || r1 != r2)
+		FAIL (ddsi_div, i, in1, in2, NULL);
+
+	      mpz_set (res2, in1);
+	      (ddsi_div_funcs[i]) (res1, res2, res2, in2i);
+	      if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0 || r1 != r2)
+		FAIL (ddsi_div, i, in1, in2, NULL);
+	    }
+	}
+
+      if (mpz_sgn (in1) >= 0)
+	{
+	  mpz_sqrtrem (ref1, ref2, in1);
+
+	  mpz_set (res1, in1);
+	  mpz_sqrtrem (res1, res2, res1);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0)
+	    dump_abort ("mpz_sqrtrem", in1, NULL, NULL);
+
+	  mpz_set (res2, in1);
+	  mpz_sqrtrem (res1, res2, res2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0)
+	    dump_abort ("mpz_sqrtrem", in1, NULL, NULL);
+	}
+
+      if (mpz_sgn (in1) >= 0)
+	{
+	  mpz_root (ref1, in1, in2i % 0x100 + 1);
+
+	  mpz_set (res1, in1);
+	  mpz_root (res1, res1, in2i % 0x100 + 1);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_root", in1, in2, NULL);
+	}
+
+      if (pass < reps / 2)	/* run fewer tests since gcdext lots of time */
+	{
+	  mpz_gcdext (ref1, ref2, ref3, in1, in2);
+
+	  mpz_set (res1, in1);
+	  mpz_gcdext (res1, res2, res3, res1, in2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+
+	  mpz_set (res2, in1);
+	  mpz_gcdext (res1, res2, res3, res2, in2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+
+	  mpz_set (res3, in1);
+	  mpz_gcdext (res1, res2, res3, res3, in2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+
+	  mpz_set (res1, in2);
+	  mpz_gcdext (res1, res2, res3, in1, res1);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+
+	  mpz_set (res2, in2);
+	  mpz_gcdext (res1, res2, res3, in1, res2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+
+	  mpz_set (res3, in2);
+	  mpz_gcdext (res1, res2, res3, in1, res3);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+
+	  mpz_set (res1, in1);
+	  mpz_gcdext (res1, res2, NULL, res1, in2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+
+	  mpz_set (res2, in1);
+	  mpz_gcdext (res1, res2, NULL, res2, in2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+
+	  mpz_set (res1, in2);
+	  mpz_gcdext (res1, res2, NULL, in1, res1);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+
+	  mpz_set (res2, in2);
+	  mpz_gcdext (res1, res2, NULL, in1, res2);
+	  if (mpz_cmp (ref1, res1) != 0 || mpz_cmp (ref2, res2) != 0
+	      || mpz_cmp (ref3, res3) != 0)
+	    dump_abort ("mpz_gcdext", in1, in2, NULL);
+	}
+
+      /* Don't run mpz_powm for huge exponents or when undefined.  */
+      if (mpz_sizeinbase (in2, 2) < 250 && mpz_sgn (in3) != 0)
+	{
+	  mpz_powm (ref1, in1, in2, in3);
+
+	  mpz_set (res1, in1);
+	  mpz_powm (res1, res1, in2, in3);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_powm", in1, in2, in3);
+
+	  mpz_set (res1, in2);
+	  mpz_powm (res1, in1, res1, in3);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_powm", in1, in2, in3);
+
+	  mpz_set (res1, in3);
+	  mpz_powm (res1, in1, in2, res1);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_powm", in1, in2, in3);
+	}
+
+      /* Don't run mpz_powm_ui when undefined.  */
+      if (mpz_sgn (in3) != 0)
+	{
+	  mpz_powm_ui (ref1, in1, in2i, in3);
+
+	  mpz_set (res1, in1);
+	  mpz_powm_ui (res1, res1, in2i, in3);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_powm_ui", in1, in2, in3);
+
+	  mpz_set (res1, in3);
+	  mpz_powm_ui (res1, in1, in2i, res1);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_powm_ui", in1, in2, in3);
+	}
+
+      {
+	r1 = mpz_gcd_ui (ref1, in1, in2i);
+
+	mpz_set (res1, in1);
+	r2 = mpz_gcd_ui (res1, res1, in2i);
+	if (mpz_cmp (ref1, res1) != 0)
+	  dump_abort ("mpz_gcd_ui", in1, in2, NULL);
+      }
+
+      if (mpz_cmp_ui (in2, 1L) > 0 && mpz_sgn (in1) != 0)
+	{
+	  /* Test mpz_remove */
+	  mpz_remove (ref1, in1, in2);
+
+	  mpz_set (res1, in1);
+	  mpz_remove (res1, res1, in2);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_remove", in1, in2, NULL);
+
+	  mpz_set (res1, in2);
+	  mpz_remove (res1, in1, res1);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_remove", in1, in2, NULL);
+	}
+
+      if (mpz_sgn (in2) != 0)
+	{
+	  /* Test mpz_divexact */
+	  mpz_mul (t, in1, in2);
+	  mpz_divexact (ref1, t, in2);
+
+	  mpz_set (res1, t);
+	  mpz_divexact (res1, res1, in2);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_divexact", t, in2, NULL);
+
+	  mpz_set (res1, in2);
+	  mpz_divexact (res1, t, res1);
+	  if (mpz_cmp (ref1, res1) != 0)
+	    dump_abort ("mpz_divexact", t, in2, NULL);
+	}
+    }
+
+  if (failures != 0)
+    {
+      fprintf (stderr, "mpz/reuse: %d error%s\n", failures, "s" + (failures == 1));
+      exit (1);
+    }
+
+  exit (0);
+}
+
+dump_abort (name, in1, in2, in3)
+     char *name;
+     mpz_t in1, in2, in3;
+{
+  printf ("failure in %s (", name);
+  mpz_out_str (stdout, -16, in1);
+  if (in2 != NULL)
+    {
+      printf (" ");
+      mpz_out_str (stdout, -16, in2);
+    }
+  if (in3 != NULL)
+    {
+      printf (" ");
+      mpz_out_str (stdout, -16, in3);
+    }
+  printf (")\n");
+}
diff --git a/src/gmp/mpz/tests/t-2exp.c b/src/gmp/mpz/tests/t-2exp.c
new file mode 100644
index 000000000..d18e3cb7a
--- /dev/null
+++ b/src/gmp/mpz/tests/t-2exp.c
@@ -0,0 +1,77 @@
+/* Test mpz_ui_pow_ui, mpz_fdiv_q, mpz_fdiv_q_2exp, mpz_fdiv_r,
+   mpz_fdiv_r_2exp, and mpz_mul_2exp.
+
+Copyright (C) 1997, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "urandom.h"
+
+#ifndef SIZE
+#define SIZE 8
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t x, r1, r2, q1, q2, d, t;
+  unsigned long int c;
+  int test;
+  int ntests = 100000;
+
+  if (argc == 2)
+     ntests = atoi (argv[1]);
+
+  mpz_init (x);
+  mpz_init (q1);
+  mpz_init (q2);
+  mpz_init (r1);
+  mpz_init (r2);
+  mpz_init (d);
+  mpz_init (t);
+
+  for (test = 1; test <= ntests; test++)
+    {
+      mpz_random2 (x, urandom () % (2 * SIZE) - SIZE);
+      c = urandom () % (3 * SIZE / 2 * BITS_PER_MP_LIMB);
+      mpz_ui_pow_ui (d, (unsigned long) 2, c);
+
+      mpz_fdiv_q (q1, x, d);
+      mpz_fdiv_q_2exp (q2, x, c);
+      mpz_fdiv_r (r1, x, d);
+      mpz_fdiv_r_2exp (r2, x, c);
+
+      if (mpz_cmp (q1, q2) != 0 || mpz_cmp (r1, r2) != 0)
+	abort ();
+
+      mpz_mul_2exp (t, q1, c);
+      mpz_add (t, t, r1);
+      if (mpz_cmp (t, x) != 0)
+	abort ();
+
+      if (mpz_cmp (r1, d) >= 0)
+	abort ();
+    }
+
+  exit (0);
+}
diff --git a/src/gmp/mpz/tests/t-bin.c b/src/gmp/mpz/tests/t-bin.c
new file mode 100644
index 000000000..62ef639fb
--- /dev/null
+++ b/src/gmp/mpz/tests/t-bin.c
@@ -0,0 +1,217 @@
+/* Exercise mpz_bin_ui and mpz_bin_uiui. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+void
+try_mpz_bin_ui (mpz_srcptr want, mpz_srcptr n, unsigned long k)
+{
+  mpz_t  got;
+
+  mpz_init (got);
+  mpz_bin_ui (got, n, k);
+  MPZ_CHECK_FORMAT (got);
+  if (mpz_cmp (got, want) != 0)
+    {
+      printf ("mpz_bin_ui wrong\n");
+      printf ("  n="); mpz_out_str (stdout, 10, n); printf ("\n");
+      printf ("  k=%lu\n", k);
+      printf ("  got="); mpz_out_str (stdout, 10, got); printf ("\n");
+      printf ("  want="); mpz_out_str (stdout, 10, want); printf ("\n");
+      abort();                                    
+    }
+  mpz_clear (got);
+}
+
+
+void
+try_mpz_bin_uiui (mpz_srcptr want, unsigned long n, unsigned long k)
+{
+  mpz_t  got;
+
+  mpz_init (got);
+  mpz_bin_uiui (got, n, k);
+  MPZ_CHECK_FORMAT (got);
+  if (mpz_cmp (got, want) != 0)
+    {
+      printf ("mpz_bin_uiui wrong\n");
+      printf ("  n=%lu\n", n);
+      printf ("  k=%lu\n", k);
+      printf ("  got="); mpz_out_str (stdout, 10, got); printf ("\n");
+      printf ("  want="); mpz_out_str (stdout, 10, want); printf ("\n");
+      abort();                                    
+    }
+  mpz_clear (got);
+}
+
+
+void
+samples (void)
+{
+  static const struct {
+    const char     *n;
+    unsigned long  k;
+    const char     *want;
+  } data[] = {
+
+    {   "0",  0, "1"   },
+    {   "0",  1, "0"   },
+    {   "0",  2, "0"   },
+    {   "0",  3, "0"   },
+    {   "0",  4, "0"   },
+    {   "0", 123456, "0" },
+
+    {   "1",  0, "1"   },
+    {   "1",  1, "1"   },
+    {   "1",  2, "0"   },
+    {   "1",  3, "0"   },
+    {   "1",  4, "0"   },
+    {   "1", 123456, "0" },
+
+    {   "2",  0, "1"   },
+    {   "2",  1, "2"   },
+    {   "2",  2, "1"   },
+    {   "2",  3, "0"   },
+    {   "2",  4, "0"   },
+    {   "2", 123456, "0" },
+
+    {   "3",  0, "1"   },
+    {   "3",  1, "3"   },
+    {   "3",  2, "3"   },
+    {   "3",  3, "1"   },
+    {   "3",  4, "0"   },
+    {   "3",  5, "0"   },
+    {   "3", 123456, "0" },
+
+    {   "4",  0, "1"   },
+    {   "4",  1, "4"   },
+    {   "4",  2, "6"   },
+    {   "4",  3, "4"   },
+    {   "4",  4, "1"   },
+    {   "4",  5, "0"   },
+    {   "4",  6, "0"   },
+    {   "4", 123456, "0" },
+
+    {   "10",  0, "1"   },
+    {   "10",  1, "10"  },
+    {   "10",  2, "45"  },
+    {   "10",  3, "120" },
+    {   "10",  4, "210" },
+    {   "10",  5, "252" },
+    {   "10",  6, "210" },
+    {   "10",  7, "120" },
+    {   "10",  8, "45"  },
+    {   "10",  9, "10"  },
+    {   "10", 10, "1"   },
+    {   "10", 11,     "0" },
+    {   "10", 12,     "0" },
+    {   "10", 123456, "0" },
+
+    /* negatives, using bin(-n,k)=bin(n+k-1,k) */
+    {   "-1",  0,  "1"  },
+    {   "-1",  1, "-1"  },
+    {   "-1",  2,  "1"  },
+    {   "-1",  3, "-1"  },
+    {   "-1",  4,  "1"  },
+
+    {   "-2",  0,  "1"  },
+    {   "-2",  1, "-2"  },
+    {   "-2",  2,  "3"  },
+    {   "-2",  3, "-4"  },
+    {   "-2",  4,  "5"  },
+    {   "-2",  5, "-6"  },
+    {   "-2",  6,  "7"  },
+
+    {   "-3",  0,   "1"  },
+    {   "-3",  1,  "-3"  },
+    {   "-3",  2,   "6"  },
+    {   "-3",  3, "-10"  },
+    {   "-3",  4,  "15"  },
+    {   "-3",  5, "-21"  },
+    {   "-3",  6,  "28"  },
+
+    {   "40", 20,  "137846528820" },
+    {   "60", 30,  "118264581564861424" },
+  };
+
+  mpz_t  n, want;
+  int    i;
+
+  mpz_init (n);
+  mpz_init (want);
+
+  for (i = 0; i < numberof (data); i++)
+    {
+      mpz_set_str (n, data[i].n, 0);
+      mpz_set_str (want, data[i].want, 0);
+
+      try_mpz_bin_ui (want, n, data[i].k);
+
+      if (mpz_fits_ulong_p (n))
+        try_mpz_bin_uiui (want, mpz_get_ui (n), data[i].k);
+    }
+
+  mpz_clear (n);
+  mpz_clear (want);
+}
+
+
+/* Test some bin(2k,k) cases.  This produces some biggish numbers to
+   exercise the limb accumulating code.  */
+void
+twos (void)
+{
+  mpz_t          n, want;
+  unsigned long  k;
+
+  mpz_init (n);
+  mpz_init (want);
+
+  mpz_set_ui (want, (unsigned long) 2);
+  for (k = 1; k < 200; k++)
+    {
+      mpz_set_ui (n, 2*k);
+      try_mpz_bin_ui (want, n, k);
+
+      try_mpz_bin_uiui (want, 2*k, k);
+
+      mpz_mul_ui (want, want, 2*(2*k+1));
+      mpz_fdiv_q_ui (want, want, k+1);
+    }
+
+  mpz_clear (n);
+  mpz_clear (want);
+}
+
+
+int
+main (void)
+{
+  samples ();
+  twos ();
+
+  exit (0);
+}
diff --git a/src/gmp/mpz/tests/t-fdiv.c b/src/gmp/mpz/tests/t-fdiv.c
new file mode 100644
index 000000000..fe041d186
--- /dev/null
+++ b/src/gmp/mpz/tests/t-fdiv.c
@@ -0,0 +1,118 @@
+/* Test mpz_abs, mpz_add, mpz_cmp, mpz_cmp_ui, mpz_fdiv_qr, mpz_fdiv_q,
+   mpz_fdiv_r, mpz_mul.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t dividend, divisor;
+  mpz_t quotient, remainder;
+  mpz_t quotient2, remainder2;
+  mpz_t temp;
+  mp_size_t dividend_size, divisor_size;
+  int i;
+  int reps = 100000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (dividend);
+  mpz_init (divisor);
+  mpz_init (quotient);
+  mpz_init (remainder);
+  mpz_init (quotient2);
+  mpz_init (remainder2);
+  mpz_init (temp);
+
+  for (i = 0; i < reps; i++)
+    {
+      dividend_size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (dividend, dividend_size);
+
+      divisor_size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (divisor, divisor_size);
+      if (mpz_cmp_ui (divisor, 0) == 0)
+	continue;
+
+      mpz_fdiv_qr (quotient, remainder, dividend, divisor);
+      mpz_fdiv_q (quotient2, dividend, divisor);
+      mpz_fdiv_r (remainder2, dividend, divisor);
+
+      /* First determine that the quotients and remainders computed
+	 with different functions are equal.  */
+      if (mpz_cmp (quotient, quotient2) != 0)
+	dump_abort (dividend, divisor);
+      if (mpz_cmp (remainder, remainder2) != 0)
+	dump_abort (dividend, divisor);
+
+      /* Check if the sign of the quotient is correct.  */
+      if (mpz_cmp_ui (quotient, 0) != 0)
+	if ((mpz_cmp_ui (quotient, 0) < 0)
+	    != ((mpz_cmp_ui (dividend, 0) ^ mpz_cmp_ui (divisor, 0)) < 0))
+	dump_abort (dividend, divisor);
+
+      /* Check if the remainder has the same sign as the divisor
+	 (quotient rounded towards minus infinity).  */
+      if (mpz_cmp_ui (remainder, 0) != 0)
+	if ((mpz_cmp_ui (remainder, 0) < 0) != (mpz_cmp_ui (divisor, 0) < 0))
+	  dump_abort (dividend, divisor);
+
+      mpz_mul (temp, quotient, divisor);
+      mpz_add (temp, temp, remainder);
+      if (mpz_cmp (temp, dividend) != 0)
+	dump_abort (dividend, divisor);
+
+      mpz_abs (temp, divisor);
+      mpz_abs (remainder, remainder);
+      if (mpz_cmp (remainder, temp) >= 0)
+	dump_abort (dividend, divisor);
+    }
+
+  exit (0);
+}
+
+dump_abort (dividend, divisor)
+     mpz_t dividend, divisor;
+{
+  fprintf (stderr, "ERROR\n");
+  fprintf (stderr, "dividend = "); debug_mp (dividend, -16);
+  fprintf (stderr, "divisor  = "); debug_mp (divisor, -16);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-fdiv_ui.c b/src/gmp/mpz/tests/t-fdiv_ui.c
new file mode 100644
index 000000000..2442cd8bc
--- /dev/null
+++ b/src/gmp/mpz/tests/t-fdiv_ui.c
@@ -0,0 +1,117 @@
+/* Test mpz_abs, mpz_add, mpz_cmp, mpz_cmp_ui, mpz_fdiv_qr_ui, mpz_fdiv_q_ui,
+   mpz_fdiv_r_ui, mpz_mul, mpz_mul_ui.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t dividend;
+  mpz_t quotient, remainder;
+  mpz_t quotient2, remainder2;
+  mpz_t temp;
+  mp_size_t dividend_size;
+  mp_limb_t divisor;
+  int i;
+  int reps = 100000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (dividend);
+  mpz_init (quotient);
+  mpz_init (remainder);
+  mpz_init (quotient2);
+  mpz_init (remainder2);
+  mpz_init (temp);
+
+  for (i = 0; i < reps; i++)
+    {
+      dividend_size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (dividend, dividend_size);
+
+      divisor = urandom ();
+      if (divisor == 0)
+	continue;
+
+      mpz_fdiv_qr_ui (quotient, remainder, dividend, divisor);
+      mpz_fdiv_q_ui (quotient2, dividend, divisor);
+      mpz_fdiv_r_ui (remainder2, dividend, divisor);
+
+      /* First determine that the quotients and remainders computed
+	 with different functions are equal.  */
+      if (mpz_cmp (quotient, quotient2) != 0)
+	dump_abort (dividend, divisor);
+      if (mpz_cmp (remainder, remainder2) != 0)
+	dump_abort (dividend, divisor);
+
+      /* Check if the sign of the quotient is correct.  */
+      if (mpz_cmp_ui (quotient, 0) != 0)
+	if ((mpz_cmp_ui (quotient, 0) < 0)
+	    != (mpz_cmp_ui (dividend, 0) < 0))
+	dump_abort (dividend, divisor);
+
+      /* Check if the remainder has the same sign as the divisor
+	 (quotient rounded towards minus infinity).  */
+      if (mpz_cmp_ui (remainder, 0) != 0)
+	if (mpz_cmp_ui (remainder, 0) < 0)
+	  dump_abort (dividend, divisor);
+
+      mpz_mul_ui (temp, quotient, divisor);
+      mpz_add (temp, temp, remainder);
+      if (mpz_cmp (temp, dividend) != 0)
+	dump_abort (dividend, divisor);
+
+      mpz_abs (remainder, remainder);
+      if (mpz_cmp_ui (remainder, divisor) >= 0)
+	dump_abort (dividend, divisor);
+    }
+
+  exit (0);
+}
+
+dump_abort (dividend, divisor)
+     mpz_t dividend;
+     mp_limb_t divisor;
+{
+  fprintf (stderr, "ERROR\n");
+  fprintf (stderr, "dividend = "); debug_mp (dividend, -16);
+  fprintf (stderr, "divisor  = %lX\n", divisor);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-gcd.c b/src/gmp/mpz/tests/t-gcd.c
new file mode 100644
index 000000000..0c0104e59
--- /dev/null
+++ b/src/gmp/mpz/tests/t-gcd.c
@@ -0,0 +1,107 @@
+/* Test mpz_gcd, mpz_gcdext, mpz_mul, mpz_tdiv_r, mpz_add, mpz_cmp,
+   mpz_cmp_ui, mpz_init_set, mpz_set, mpz_clear.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 128
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t op1, op2, x;
+  mpz_t gcd, gcd2, s, t;
+  mpz_t temp1, temp2;
+  mp_size_t op1_size, op2_size, x_size;
+  int i;
+  int reps = 2000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (op1);
+  mpz_init (op2);
+  mpz_init (x);
+  mpz_init (gcd);
+  mpz_init (gcd2);
+  mpz_init (temp1);
+  mpz_init (temp2);
+  mpz_init (s);
+  mpz_init (t);
+
+  for (i = 0; i < reps; i++)
+    {
+      op1_size = urandom () % SIZE - SIZE/2;
+      op2_size = urandom () % SIZE - SIZE/2;
+      x_size = urandom () % SIZE/2;
+
+      mpz_random2 (op1, op1_size);
+      mpz_random2 (op2, op2_size);
+      mpz_random2 (x, x_size);
+      mpz_mul (op1, op1, x);
+      mpz_mul (op2, op2, x);
+
+      mpz_gcd (gcd, op1, op2);
+      /* We know GCD will be at least X, since we multiplied in that factor.  */
+      if (mpz_cmp (gcd, x) < 0 && mpz_sgn (op1) != 0 && mpz_sgn (op2) != 0)
+	dump_abort (op1, op2);
+
+      mpz_gcdext (gcd2, s, t, op1, op2);
+      if (mpz_cmp (gcd, gcd2))
+	dump_abort (op1, op2);
+
+      mpz_gcdext (gcd2, s, NULL, op1, op2);
+      if (mpz_cmp (gcd, gcd2))
+	dump_abort (op1, op2);
+
+      mpz_mul (temp1, s, op1);
+      mpz_mul (temp2, t, op2);
+      mpz_add (gcd2, temp1, temp2);
+      if (mpz_cmp (gcd, gcd2))
+	dump_abort (op1, op2);
+    }
+
+  exit (0);
+}
+
+dump_abort (op1, op2)
+     mpz_t op1, op2;
+{
+  fprintf (stderr, "ERROR\n");
+  fprintf (stderr, "op1 = "); debug_mp (op1, -16);
+  fprintf (stderr, "op2 = "); debug_mp (op2, -16);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-jac.c b/src/gmp/mpz/tests/t-jac.c
new file mode 100644
index 000000000..9b9c2e211
--- /dev/null
+++ b/src/gmp/mpz/tests/t-jac.c
@@ -0,0 +1,652 @@
+/* Exercise mpz_*_kronecker_*() and mpz_jacobi() functions. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+
+/* With no arguments the various Kronecker/Jacobi symbol routines are
+   checked against some test data and a lot of derived data.
+
+   To check the test data against PARI-GP, run
+   
+           t-jac -p | gp -q
+
+   It takes a while because the output from "t-jac -p" is big.
+
+
+   Enhancements:
+
+   More big test cases than those given by check_squares_zi would be good.  */
+
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+
+int option_pari = 0;
+
+
+unsigned long
+mpz_mod4 (mpz_srcptr z)
+{
+  mpz_t          m;
+  unsigned long  ret;
+
+  mpz_init (m);
+  mpz_fdiv_r_2exp (m, z, 2);
+  ret = mpz_get_ui (m);
+  mpz_clear (m);
+  return ret;
+}
+
+int
+mpz_fits_ulimb_p (mpz_srcptr z)
+{
+  return (SIZ(z) == 1 || SIZ(z) == 0);
+}
+
+mp_limb_t
+mpz_get_ulimb (mpz_srcptr z)
+{
+  if (SIZ(z) == 0)
+    return 0;
+  else
+    return PTR(z)[0];
+}
+
+
+void
+try_base (mp_limb_t a, mp_limb_t b, int answer)
+{
+  int  got;
+
+  if ((b & 1) == 0 || b == 1 || a > b)
+    return;
+
+  got = mpn_jacobi_base (a, b, 0);
+  if (got != answer)
+    {
+      printf ("mpn_jacobi_base (%lu, %lu) is %d should be %d\n",
+              a, b, got, answer);
+      exit (1);
+    }
+}
+
+
+void
+try_zi_ui (mpz_srcptr a, unsigned long b, int answer)
+{
+  int  got;
+
+  got = mpz_kronecker_ui (a, b);
+  if (got != answer)
+    {
+      printf ("mpz_kronecker_ui (");
+      mpz_out_str (stdout, 10, a);
+      printf (", %lu) is %d should be %d\n", b, got, answer);
+      exit (1);
+    }
+}
+
+
+void
+try_zi_si (mpz_srcptr a, long b, int answer)
+{
+  int  got;
+
+  got = mpz_kronecker_si (a, b);
+  if (got != answer)
+    {
+      printf ("mpz_kronecker_si (");
+      mpz_out_str (stdout, 10, a);
+      printf (", %ld) is %d should be %d\n", b, got, answer);
+      exit (1);
+    }
+}
+
+
+void
+try_ui_zi (unsigned long a, mpz_srcptr b, int answer)
+{
+  int  got;
+
+  got = mpz_ui_kronecker (a, b);
+  if (got != answer)
+    {
+      printf ("mpz_ui_kronecker (%lu, ", a);
+      mpz_out_str (stdout, 10, b);
+      printf (") is %d should be %d\n", got, answer);
+      exit (1);
+    }
+}
+
+
+void
+try_si_zi (int a, mpz_srcptr b, int answer)
+{
+  int  got;
+
+  got = mpz_si_kronecker (a, b);
+  if (got != answer)
+    {
+      printf ("mpz_si_kronecker (%d, ", a);
+      mpz_out_str (stdout, 10, b);
+      printf (") is %d should be %d\n", got, answer);
+      exit (1);
+    }
+}
+
+
+void
+try_zi_zi (mpz_srcptr a, mpz_srcptr b, int answer)
+{
+  int  got;
+
+  /* gmp 2.0.2 mpz_jacobi() doesn't handle negative or even b */
+  if (mpz_sgn (b) <= 0 || mpz_even_p (b))
+    return;
+
+  got = mpz_jacobi (a, b);
+  if (got != answer)
+    {
+      printf ("mpz_jacobi (");
+      mpz_out_str (stdout, 10, a); 
+      printf (", ");
+      mpz_out_str (stdout, 10, b);
+      printf (") is %d should be %d\n", got, answer);
+      exit (1);
+    }
+}
+
+
+void
+try_pari (mpz_srcptr a, mpz_srcptr b, int answer)
+{
+  printf ("try(");
+  mpz_out_str (stdout, 10, a); 
+  printf (",");
+  mpz_out_str (stdout, 10, b); 
+  printf (",%d)\n", answer);
+}
+
+
+void
+try_each (mpz_srcptr a, mpz_srcptr b, int answer)
+{
+  if (option_pari)
+    {
+      try_pari (a, b, answer);
+      return;
+    }
+
+  if (mpz_fits_ulimb_p (a) && mpz_fits_ulimb_p (b))
+    try_base (mpz_get_ulimb (a), mpz_get_ulimb (b), answer);
+
+  if (mpz_fits_ulong_p (b))
+    try_zi_ui (a, mpz_get_ui (b), answer);
+
+  if (mpz_fits_slong_p (b))
+    try_zi_si (a, mpz_get_si (b), answer);
+
+  if (mpz_fits_ulong_p (a))
+    try_ui_zi (mpz_get_ui (a), b, answer);
+
+  if (mpz_fits_sint_p (a))
+    try_si_zi (mpz_get_si (a), b, answer);
+
+  try_zi_zi (a, b, answer);
+}        
+
+
+/* Try (a/b) and (a/-b). */
+void
+try_pn (mpz_srcptr a, mpz_srcptr b_orig, int answer)
+{
+  mpz_t  b;
+
+  mpz_init_set (b, b_orig);
+  try_each (a, b, answer);
+
+  mpz_neg (b, b);
+  if (mpz_sgn (a) < 0)
+    answer = -answer;
+
+  try_each (a, b, answer);
+
+  mpz_clear (b);
+}
+
+
+/* Try (a+k*p/b) for various k, using the fact (a/b) is periodic in a with
+   period p.  For b>0, p=b if b!=2mod4 or p=4*b if b==2mod4. */
+
+void
+try_periodic_num (mpz_srcptr a_orig, mpz_srcptr b, int answer)
+{
+  mpz_t  a, a_period;
+  int    i;
+
+  if (mpz_sgn (b) <= 0)
+    return;
+
+  mpz_init_set (a, a_orig);
+  mpz_init_set (a_period, b);
+  if (mpz_mod4 (b) == 2)
+    mpz_mul_ui (a_period, a_period, 4);
+
+  /* don't bother with these tests if they're only going to produce
+     even/even */
+  if (mpz_even_p (a) && mpz_even_p (b) && mpz_even_p (a_period))
+    goto done;
+
+  for (i = 0; i < 10; i++)
+    {
+      mpz_add (a, a, a_period);
+      try_pn (a, b, answer);
+    }
+
+  mpz_set (a, a_orig);
+  for (i = 0; i < 10; i++)
+    {
+      mpz_sub (a, a, a_period);
+      try_pn (a, b, answer);
+    }
+
+ done:
+  mpz_clear (a);
+  mpz_clear (a_period);
+}
+
+
+/* Try (a/b+k*p) for various k, using the fact (a/b) is periodic in b of
+   period p.
+
+                               period p
+           a==0,1mod4             a
+           a==2mod4              4*a
+           a==3mod4 and b odd    4*a
+           a==3mod4 and b even   8*a
+
+   In Henri Cohen's book the period is given as 4*a for all a==2,3mod4, but
+   a counterexample would seem to be (3/2)=-1 which with (3/14)=+1 doesn't
+   have period 4*a (but rather 8*a with (3/26)=-1).  Maybe the plain 4*a is
+   to be read as applying to a plain Jacobi symbol with b odd, rather than
+   the Kronecker extension to b even. */
+
+void
+try_periodic_den (mpz_srcptr a, mpz_srcptr b_orig, int answer)
+{
+  mpz_t  b, b_period;
+  int    i;
+
+  if (mpz_sgn (a) == 0 || mpz_sgn (b_orig) == 0)
+    return;
+
+  mpz_init_set (b, b_orig);
+
+  mpz_init_set (b_period, a);
+  if (mpz_mod4 (a) == 3 && mpz_even_p (b))
+    mpz_mul_ui (b_period, b_period, 8);
+  else if (mpz_mod4 (a) >= 2)
+    mpz_mul_ui (b_period, b_period, 4);
+
+  /* don't bother with these tests if they're only going to produce
+     even/even */
+  if (mpz_even_p (a) && mpz_even_p (b) && mpz_even_p (b_period))
+    goto done;
+
+  for (i = 0; i < 10; i++)
+    {
+      mpz_add (b, b, b_period);
+      try_pn (a, b, answer);
+    }
+
+  mpz_set (b, b_orig);
+  for (i = 0; i < 10; i++)
+    {
+      mpz_sub (b, b, b_period);
+      try_pn (a, b, answer);
+    }
+
+ done:
+  mpz_clear (b);
+  mpz_clear (b_period);
+}
+
+
+/* Try (a/b*2^k) for various k.  If it happens mpz_ui_kronecker() gets (a/2)
+   wrong it will show up as wrong answers demanded. */
+void
+try_2den (mpz_srcptr a, mpz_srcptr b_orig, int answer)
+{
+  mpz_t  b;
+  int    i;
+  int    answer_two;
+
+  /* don't bother when b==0 */
+  if (mpz_sgn (b_orig) == 0)
+    return;
+
+  mpz_init_set (b, b_orig);
+  answer_two = mpz_kronecker_ui (a, 2);
+
+  for (i = 0; i < 3 * BITS_PER_MP_LIMB; i++)
+    {
+      answer *= answer_two;
+      mpz_mul_2exp (b, b, 1);
+      try_pn (a, b, answer);
+    }
+
+  mpz_clear (b);
+}
+
+
+/* Try (a*2^k/b) for various k.  If it happens mpz_ui_kronecker() gets (2/b)
+   wrong it will show up as wrong answers demanded. */
+void
+try_2num (mpz_srcptr a_orig, mpz_srcptr b, int answer)
+{
+  mpz_t  a;
+  int    i;
+  int    answer_twos;
+
+  /* don't bother when a==0 */
+  if (mpz_sgn (a_orig) == 0)
+    return;
+
+  mpz_init_set (a, a_orig);
+  answer_twos = mpz_ui_kronecker (2, b);
+  
+  for (i = 0; i < 3 * BITS_PER_MP_LIMB; i++)
+    {
+      answer *= answer_twos;
+      mpz_mul_2exp (a, a, 1);
+      try_pn (a, b, answer);
+    }
+
+  mpz_clear (a);
+}
+
+
+/* The try_2num() and try_2den() routines don't in turn call
+   try_periodic_num() and try_periodic_den() because it hugely increases the
+   number of tests performed, without obviously increasing coverage.
+
+   Useful extra derived cases can be added here. */
+
+void
+try_all (mpz_t a, mpz_t b, int answer)
+{
+  try_pn (a, b, answer);
+  try_periodic_num (a, b, answer);
+  try_periodic_den (a, b, answer);
+  try_2num (a, b, answer);
+  try_2den (a, b, answer);
+}
+
+
+void
+check_data (void)
+{
+  static const struct {
+    const char  *a;
+    const char  *b;
+    int         answer;
+
+  } data[] = {
+
+    /* Note that the various derived checks in try_all() reduce the cases
+       that need to be given here.  */
+
+    /* some zeros */
+    {  "0",  "0", 0 },
+    {  "0",  "2", 0 },
+    {  "0",  "6", 0 },
+    {  "5",  "0", 0 },
+    { "24", "60", 0 },
+
+    /* (a/1) = 1, any a 
+       In particular note (0/1)=1 so that (a/b)=(a mod b/b). */
+    { "0", "1", 1 },
+    { "1", "1", 1 },
+    { "2", "1", 1 },
+    { "3", "1", 1 },
+    { "4", "1", 1 },
+    { "5", "1", 1 },
+
+    /* (0/b) = 0, b != 1 */
+    { "0",  "3", 0 },
+    { "0",  "5", 0 },
+    { "0",  "7", 0 },
+    { "0",  "9", 0 },
+    { "0", "11", 0 },
+    { "0", "13", 0 },
+    { "0", "15", 0 },
+
+    /* (1/b) = 1 */
+    { "1",  "1", 1 },
+    { "1",  "3", 1 },
+    { "1",  "5", 1 },
+    { "1",  "7", 1 },
+    { "1",  "9", 1 },
+    { "1", "11", 1 },
+
+    /* (-1/b) = (-1)^((b-1)/2) which is -1 for b==3 mod 4 */
+    { "-1",  "1",  1 },
+    { "-1",  "3", -1 },
+    { "-1",  "5",  1 },
+    { "-1",  "7", -1 },
+    { "-1",  "9",  1 },
+    { "-1", "11", -1 },
+    { "-1", "13",  1 },
+    { "-1", "15", -1 },
+    { "-1", "17",  1 },
+    { "-1", "19", -1 },
+
+    /* (2/b) = (-1)^((b^2-1)/8) which is -1 for b==3,5 mod 8.
+       try_2num() will exercise multiple powers of 2 in the numerator.  */
+    { "2",  "1",  1 },
+    { "2",  "3", -1 },
+    { "2",  "5", -1 },
+    { "2",  "7",  1 },
+    { "2",  "9",  1 },
+    { "2", "11", -1 },
+    { "2", "13", -1 },
+    { "2", "15",  1 },
+    { "2", "17",  1 },
+
+    /* (-2/b) = (-1)^((b^2-1)/8)*(-1)^((b-1)/2) which is -1 for b==5,7mod8.
+       try_2num() will exercise multiple powers of 2 in the numerator, which
+       will test that the shift in mpz_si_kronecker() uses unsigned not
+       signed.  */
+    { "-2",  "1",  1 },
+    { "-2",  "3",  1 },
+    { "-2",  "5", -1 },
+    { "-2",  "7", -1 },
+    { "-2",  "9",  1 },
+    { "-2", "11",  1 },
+    { "-2", "13", -1 },
+    { "-2", "15", -1 },
+    { "-2", "17",  1 },
+
+    /* (a/2)=(2/a).
+       try_2den() will exercise multiple powers of 2 in the denominator. */
+    {  "3",  "2", -1 },
+    {  "5",  "2", -1 },
+    {  "7",  "2",  1 },
+    {  "9",  "2",  1 },
+    {  "11", "2", -1 },
+
+    /* Harriet Griffin, "Elementary Theory of Numbers", page 155, various
+       examples.  */
+    {   "2", "135",  1 },
+    { "135",  "19", -1 },
+    {   "2",  "19", -1 },
+    {  "19", "135",  1 },
+    { "173", "135",  1 },
+    {  "38", "135",  1 },
+    { "135", "173",  1 },
+    { "173",   "5", -1 },
+    {   "3",   "5", -1 },
+    {   "5", "173", -1 },
+    { "173",   "3", -1 },
+    {   "2",   "3", -1 },
+    {   "3", "173", -1 },
+    { "253",  "21",  1 },
+    {   "1",  "21",  1 },
+    {  "21", "253",  1 },
+    {  "21",  "11", -1 },
+    {  "-1",  "11", -1 },
+
+    /* Griffin page 147 */
+    {  "-1",  "17",  1 },
+    {   "2",  "17",  1 },
+    {  "-2",  "17",  1 },
+    {  "-1",  "89",  1 },
+    {   "2",  "89",  1 },
+
+    /* Griffin page 148 */
+    {  "89",  "11",  1 },
+    {   "1",  "11",  1 },
+    {  "89",   "3", -1 },
+    {   "2",   "3", -1 },
+    {   "3",  "89", -1 },
+    {  "11",  "89",  1 },
+    {  "33",  "89", -1 },
+
+    /* H. Davenport, "The Higher Arithmetic", page 65, the quadratic
+       residues and non-residues mod 19.  */
+    {  "1", "19",  1 },
+    {  "4", "19",  1 },
+    {  "5", "19",  1 },
+    {  "6", "19",  1 },
+    {  "7", "19",  1 },
+    {  "9", "19",  1 },
+    { "11", "19",  1 },
+    { "16", "19",  1 },
+    { "17", "19",  1 },
+    {  "2", "19", -1 },
+    {  "3", "19", -1 },
+    {  "8", "19", -1 },
+    { "10", "19", -1 },
+    { "12", "19", -1 },
+    { "13", "19", -1 },
+    { "14", "19", -1 },
+    { "15", "19", -1 },
+    { "18", "19", -1 },
+
+    /* Residues and non-residues mod 13 */
+    {  "0",  "13",  0 },
+    {  "1",  "13",  1 },
+    {  "2",  "13", -1 },
+    {  "3",  "13",  1 },
+    {  "4",  "13",  1 },
+    {  "5",  "13", -1 },
+    {  "6",  "13", -1 },
+    {  "7",  "13", -1 },
+    {  "8",  "13", -1 },
+    {  "9",  "13",  1 },
+    { "10",  "13",  1 },
+    { "11",  "13", -1 },
+    { "12",  "13",  1 },
+
+    /* various */
+    {  "5",   "7", -1 },
+    { "15",  "17",  1 },
+    { "67",  "89",  1 },
+
+  };
+
+  int    i, answer;
+  mpz_t  a, b;
+
+  mpz_init (a);
+  mpz_init (b);
+
+  for (i = 0; i < numberof (data); i++)
+    {
+      mpz_set_str (a, data[i].a, 0);
+      mpz_set_str (b, data[i].b, 0);
+
+      answer = data[i].answer;
+      try_all (a, b, data[i].answer);
+    }
+
+  mpz_clear (a);
+  mpz_clear (b);
+}
+
+
+/* (a^2/b)=1 if gcd(a,b)=1, or (a^2/b)=0 if gcd(a,b)!=1. */
+void
+check_squares_zi (void)
+{
+  mpz_t  a, b, g;
+  int    i, answer;
+
+  mpz_init (a);
+  mpz_init (b);
+  mpz_init (g);
+
+  for (i = 0; i < 200; i++)
+    {
+      mpz_random2 (a, rand() % 50);
+      mpz_random2 (b, rand() % 50);
+      mpz_mul (a, a, b);
+
+      mpz_gcd (g, a, b);
+      if (mpz_cmp_ui (g, 1) == 0)
+	answer = 1;
+      else
+	answer = 0;
+
+      try_all (a, b, answer);
+    }
+
+  mpz_clear (a);
+  mpz_clear (b);
+  mpz_clear (g);
+}
+
+
+int
+main (int argc, char *argv[])
+{
+  if (argc >= 2 && strcmp (argv[1], "-p") == 0)
+    {
+      option_pari = 1;
+      
+      printf ("\
+try(a,b,answer) =\n\
+{\n\
+  if (kronecker(a,b) != answer,\n\
+    print(\"wrong at \", a, \",\", b,\n\
+      \" expected \", answer,\n\
+      \" pari says \", kronecker(a,b)))\n\
+}\n");
+    }
+
+  check_data ();
+  check_squares_zi ();
+
+  exit (0);
+}
diff --git a/src/gmp/mpz/tests/t-misc.c b/src/gmp/mpz/tests/t-misc.c
new file mode 100644
index 000000000..f67acc20f
--- /dev/null
+++ b/src/gmp/mpz/tests/t-misc.c
@@ -0,0 +1,205 @@
+/* Exercise various mpz functions. */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#define SGN(x)       ((x) < 0 ? -1 : (x) == 0 ? 0 : 1)
+
+
+void
+oddeven (void)
+{
+  static const struct {
+    const char  *n;
+    int          odd, even;
+  } data[] = {
+    {   "0", 0, 1 },
+    {   "1", 1, 0 },
+    {   "2", 0, 1 },
+    {   "3", 1, 0 },
+    {   "4", 0, 1 },
+
+    {  "-4", 0, 1 },
+    {  "-3", 1, 0 },
+    {  "-2", 0, 1 },
+    {  "-1", 1, 0 },
+
+    {  "0x1000000000000000000000000000000000000000000000000000", 0, 1 },
+    {  "0x1000000000000000000000000000000000000000000000000001", 1, 0 },
+    {  "0x1000000000000000000000000000000000000000000000000002", 0, 1 },
+    {  "0x1000000000000000000000000000000000000000000000000003", 1, 0 },
+
+    { "-0x1000000000000000000000000000000000000000000000000004", 0, 1 },
+    { "-0x1000000000000000000000000000000000000000000000000003", 1, 0 },
+    { "-0x1000000000000000000000000000000000000000000000000002", 0, 1 },
+    { "-0x1000000000000000000000000000000000000000000000000001", 1, 0 },
+  };
+
+  mpz_t  n;
+  int    i;
+
+  mpz_init (n);
+  for (i = 0; i < numberof (data); i++)
+    {
+      mpz_set_str (n, data[i].n, 0);
+
+      if ((mpz_odd_p (n) != 0) != data[i].odd)
+        {
+          printf ("mpz_odd_p wrong on data[%d]\n", i); 
+          abort();                                    
+        }
+
+      if ((mpz_even_p (n) != 0) != data[i].even)
+        {
+          printf ("mpz_even_p wrong on data[%d]\n", i); 
+          abort();                                    
+        }
+    }
+
+  mpz_clear (n);
+}
+
+
+void
+check_mpz_set_si (void)
+{
+  static const struct {
+    long       n;
+    mp_size_t  want_size;
+    mp_limb_t  want_limb;
+  } data[] = {
+
+    {  0L,  0 },
+    {  1L,  1, 1 },
+    { -1L, -1, 1 },
+
+    {  LONG_MAX,  1, LONG_MAX },
+    { -LONG_MAX, -1, LONG_MAX },
+
+    { LONG_HIGHBIT, -1, ULONG_HIGHBIT },
+  };
+
+  mpz_t  n;
+  int    i;
+
+  mpz_init (n);
+  for (i = 0; i < numberof (data); i++)
+    {
+      mpz_init (n);
+      mpz_set_si (n, data[i].n);
+      if (n->_mp_size != data[i].want_size
+          || (n->_mp_size != 0 && n->_mp_d[0] != data[i].want_limb))
+        {
+          printf ("mpz_set_si wrong on data[%d]\n", i); 
+          abort();                                    
+        }
+      mpz_clear (n);
+
+      mpz_init_set_si (n, data[i].n);
+      if (n->_mp_size != data[i].want_size
+          || (n->_mp_size != 0 && n->_mp_d[0] != data[i].want_limb))
+        {
+          printf ("mpz_init_set_si wrong on data[%d]\n", i); 
+          abort();                                    
+        }
+      mpz_clear (n);
+    }
+}
+
+
+void
+check_mpz_cmp_si (void)
+{
+  static const struct {
+    const char  *a, *b;
+    int         want;
+  } data[] = {
+    { "0",  "1", -1 },
+    { "0",  "0",  0 },
+    { "0", "-1",  1 },
+
+    { "1",  "1", 0 },
+    { "1",  "0", 1 },
+    { "1", "-1", 1 },
+
+    { "-1",  "1", -1 },
+    { "-1",  "0", -1 },
+    { "-1", "-1", 0 },
+
+    {           "0", "-0x80000000",  1 },
+    {  "0x80000000", "-0x80000000",  1 },
+    {  "0x80000001", "-0x80000000",  1 },
+    { "-0x80000000", "-0x80000000",  0 },
+    { "-0x80000001", "-0x80000000", -1 },
+
+    {                   "0", "-0x8000000000000000",  1 },
+    {  "0x8000000000000000", "-0x8000000000000000",  1 },
+    {  "0x8000000000000001", "-0x8000000000000000",  1 },
+    { "-0x8000000000000000", "-0x8000000000000000",  0 },
+    { "-0x8000000000000001", "-0x8000000000000000", -1 },
+  };
+
+  mpz_t  a, bz;
+  long   b;
+  int    got;
+  int    i;
+
+  mpz_init (a);
+  mpz_init (bz);
+  for (i = 0; i < numberof (data); i++)
+    {
+      mpz_set_str (a, data[i].a, 0);
+      mpz_set_str (bz, data[i].b, 0);
+
+      if (mpz_fits_slong_p (bz))
+        {
+          b = mpz_get_si (bz);
+          got = mpz_cmp_si (a, b);
+          if (SGN (got) != data[i].want)
+            {
+              printf ("mpz_cmp_si wrong on data[%d]\n", i);
+              printf ("  a="); mpz_out_str (stdout, 10, a); printf ("\n");
+              printf ("  b=%ld\n", b);
+              printf ("  got=%d\n", got);
+              printf ("  want=%d\n", data[i].want);
+              abort();                                    
+            }
+        }
+    }
+
+  mpz_clear (a);
+  mpz_clear (bz);
+}
+
+
+int
+main (void)
+{
+  oddeven ();
+  check_mpz_set_si ();
+  check_mpz_cmp_si ();
+
+  exit (0);
+}
diff --git a/src/gmp/mpz/tests/t-mul.c b/src/gmp/mpz/tests/t-mul.c
new file mode 100644
index 000000000..4cd1224e4
--- /dev/null
+++ b/src/gmp/mpz/tests/t-mul.c
@@ -0,0 +1,278 @@
+/* Test mpz_add, mpz_cmp, mpz_cmp_ui, mpz_divmod, mpz_mul.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+#include "urandom.h"
+
+void debug_mp ();
+mp_size_t _mpn_mul_classic ();
+void mpz_refmul ();
+
+#ifndef SIZE
+#define SIZE 2 * TOOM3_MUL_THRESHOLD
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t multiplier, multiplicand;
+  mpz_t product, ref_product;
+  mpz_t quotient, remainder;
+  mp_size_t multiplier_size, multiplicand_size;
+  int i;
+  int reps = 2000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (multiplier);
+  mpz_init (multiplicand);
+  mpz_init (product);
+  mpz_init (ref_product);
+  mpz_init (quotient);
+  mpz_init (remainder);
+
+  for (i = 0; i < reps; i++)
+    {
+      multiplier_size = urandom () % 2 * SIZE - SIZE;
+      multiplicand_size = urandom () % 2 * SIZE - SIZE;
+
+      mpz_random2 (multiplier, multiplier_size);
+      mpz_random2 (multiplicand, multiplicand_size);
+
+      mpz_mul (product, multiplier, multiplicand);
+      mpz_refmul (ref_product, multiplier, multiplicand);
+      if (mpz_cmp_ui (multiplicand, 0) != 0)
+	mpz_divmod (quotient, remainder, product, multiplicand);
+
+      if (mpz_cmp (product, ref_product))
+	dump_abort ("incorrect plain product",
+		    multiplier, multiplicand, product, ref_product);
+
+      if (mpz_cmp_ui (multiplicand, 0) != 0)
+      if (mpz_cmp_ui (remainder, 0) || mpz_cmp (quotient, multiplier))
+	{
+	  debug_mp (quotient, -16);
+	  debug_mp (remainder, -16);
+	  dump_abort ("incorrect quotient or remainder",
+		      multiplier, multiplicand, product, ref_product);
+	}
+
+      /* Test squaring.  */
+      mpz_mul (product, multiplier, multiplier);
+      mpz_refmul (ref_product, multiplier, multiplier);
+
+      if (mpz_cmp (product, ref_product))
+	dump_abort ("incorrect square product",
+		    multiplier, multiplier, product, ref_product);
+    }
+
+  exit (0);
+}
+
+void
+mpz_refmul (w, u, v)
+     mpz_t w;
+     const mpz_t u;
+     const mpz_t v;
+{
+  mp_size_t usize = u->_mp_size;
+  mp_size_t vsize = v->_mp_size;
+  mp_size_t wsize;
+  mp_size_t sign_product;
+  mp_ptr up, vp;
+  mp_ptr wp;
+  mp_ptr free_me = NULL;
+  size_t free_me_size;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  sign_product = usize ^ vsize;
+  usize = ABS (usize);
+  vsize = ABS (vsize);
+
+  if (usize < vsize)
+    {
+      /* Swap U and V.  */
+      {const __mpz_struct *t = u; u = v; v = t;}
+      {mp_size_t t = usize; usize = vsize; vsize = t;}
+    }
+
+  up = u->_mp_d;
+  vp = v->_mp_d;
+  wp = w->_mp_d;
+
+  /* Ensure W has space enough to store the result.  */
+  wsize = usize + vsize;
+  if (w->_mp_alloc < wsize)
+    {
+      if (wp == up || wp == vp)
+	{
+	  free_me = wp;
+	  free_me_size = w->_mp_alloc;
+	}
+      else
+	(*_mp_free_func) (wp, w->_mp_alloc * BYTES_PER_MP_LIMB);
+
+      w->_mp_alloc = wsize;
+      wp = (mp_ptr) (*_mp_allocate_func) (wsize * BYTES_PER_MP_LIMB);
+      w->_mp_d = wp;
+    }
+  else
+    {
+      /* Make U and V not overlap with W.  */
+      if (wp == up)
+	{
+	  /* W and U are identical.  Allocate temporary space for U.  */
+	  up = (mp_ptr) TMP_ALLOC (usize * BYTES_PER_MP_LIMB);
+	  /* Is V identical too?  Keep it identical with U.  */
+	  if (wp == vp)
+	    vp = up;
+	  /* Copy to the temporary space.  */
+	  MPN_COPY (up, wp, usize);
+	}
+      else if (wp == vp)
+	{
+	  /* W and V are identical.  Allocate temporary space for V.  */
+	  vp = (mp_ptr) TMP_ALLOC (vsize * BYTES_PER_MP_LIMB);
+	  /* Copy to the temporary space.  */
+	  MPN_COPY (vp, wp, vsize);
+	}
+    }
+
+  wsize = _mpn_mul_classic (wp, up, usize, vp, vsize);
+  w->_mp_size = sign_product < 0 ? -wsize : wsize;
+  if (free_me != NULL)
+    (*_mp_free_func) (free_me, free_me_size * BYTES_PER_MP_LIMB);
+
+  TMP_FREE (marker);
+}
+
+mp_size_t
+_mpn_mul_classic (prodp, up, usize, vp, vsize)
+     mp_ptr prodp;
+     mp_srcptr up;
+     mp_size_t usize;
+     mp_srcptr vp;
+     mp_size_t vsize;
+{
+  mp_size_t i, j;
+  mp_limb_t prod_low, prod_high;
+  mp_limb_t cy_dig;
+  mp_limb_t v_limb, c;
+
+  if (vsize == 0)
+    return 0;
+
+  /* Offset UP and PRODP so that the inner loop can be faster.  */
+  up += usize;
+  prodp += usize;
+
+  /* Multiply by the first limb in V separately, as the result can
+     be stored (not added) to PROD.  We also avoid a loop for zeroing.  */
+  v_limb = vp[0];
+  cy_dig = 0;
+  j = -usize;
+  do
+    {
+      umul_ppmm (prod_high, prod_low, up[j], v_limb);
+      add_ssaaaa (cy_dig, prodp[j], prod_high, prod_low, 0, cy_dig);
+      j++;
+    }
+  while (j < 0);
+
+  prodp[j] = cy_dig;
+  prodp++;
+
+  /* For each iteration in the outer loop, multiply one limb from
+     U with one limb from V, and add it to PROD.  */
+  for (i = 1; i < vsize; i++)
+    {
+      v_limb = vp[i];
+      cy_dig = 0;
+      j = -usize;
+
+      /* Inner loops.  Simulate the carry flag by jumping between
+	 these loops.  The first is used when there was no carry
+	 in the previois iteration; the second when there was carry.  */
+
+      do
+	{
+	  umul_ppmm (prod_high, prod_low, up[j], v_limb);
+	  add_ssaaaa (cy_dig, prod_low, prod_high, prod_low, 0, cy_dig);
+	  c = prodp[j];
+	  prod_low += c;
+	  prodp[j] = prod_low;
+	  if (prod_low < c)
+	    goto cy_loop;
+	ncy_loop:
+	  j++;
+	}
+      while (j < 0);
+
+      prodp[j] = cy_dig;
+      prodp++;
+      continue;
+
+      do
+	{
+	  umul_ppmm (prod_high, prod_low, up[j], v_limb);
+	  add_ssaaaa (cy_dig, prod_low, prod_high, prod_low, 0, cy_dig);
+	  c = prodp[j];
+	  prod_low += c + 1;
+	  prodp[j] = prod_low;
+	  if (prod_low > c)
+	    goto ncy_loop;
+	cy_loop:
+	  j++;
+	}
+      while (j < 0);
+
+      cy_dig += 1;
+      prodp[j] = cy_dig;
+      prodp++;
+    }
+
+  return usize + vsize - (cy_dig == 0);
+}
+
+dump_abort (s, multiplier, multiplicand, product, ref_product)
+     char *s;
+     mpz_t multiplier, multiplicand, product, ref_product;
+{
+  fprintf (stderr, "ERROR: %s\n", s);
+  fprintf (stderr, "multiplier = "); debug_mp (multiplier, -16);
+  fprintf (stderr, "multiplicand  = "); debug_mp (multiplicand, -16);
+  fprintf (stderr, "product  = "); debug_mp (product, -16);
+  fprintf (stderr, "ref_product  = "); debug_mp (ref_product, -16);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-pow_ui.c b/src/gmp/mpz/tests/t-pow_ui.c
new file mode 100644
index 000000000..4bfde0be3
--- /dev/null
+++ b/src/gmp/mpz/tests/t-pow_ui.c
@@ -0,0 +1,122 @@
+/* Test mpz_pow_ui and mpz_ui_pow_ui.
+
+Copyright (C) 1997, 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+void ref_mpz_pow_ui ();
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t base;
+  mpz_t result, ref_result;
+  mp_size_t base_size;
+  unsigned long int exp;
+  int i;
+  int reps = 50000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (base);
+  mpz_init (result);
+  mpz_init (ref_result);
+
+  for (i = 0; i < reps; i++)
+    {
+      base_size = urandom () % 8 - 4;
+      exp = urandom () % 16;
+
+      mpz_random2 (base, base_size);
+
+      ref_mpz_pow_ui (ref_result, base, exp);
+
+      mpz_pow_ui (result, base, exp);
+      if (mpz_cmp (result, ref_result))
+	{
+	  fprintf (stderr, "ERROR (mpz_pow_ui):\n");
+	  debug_mp ("      base = ", base, -16);
+	  fprintf (stderr, "       exp = %lu (0x%lX)\n", exp, exp);
+	  debug_mp ("    result = ", result, -16);
+	  debug_mp ("ref_result = ", ref_result, -16);
+	  abort ();
+	}
+
+      if (mpz_cmp_ui (base, 0L) >= 0
+	  && mpz_cmp_ui (base, ~(unsigned long int) 0) <= 0)
+	{
+	  mpz_ui_pow_ui (result, mpz_get_ui (base), exp);
+	  if (mpz_cmp (result, ref_result))
+	    {
+	      fprintf (stderr, "ERROR (mpz_ui_pow_ui):\n");
+	      debug_mp ("      base = ", base, -16);
+	      fprintf (stderr, "       exp = %lu (0x%lX)\n", exp, exp);
+	      debug_mp ("    result = ", result, -16);
+	      debug_mp ("ref_result = ", ref_result, -16);
+	      abort ();
+	    }
+	}
+    }
+
+  exit (0);
+}
+
+void
+ref_mpz_pow_ui (w, u, e)
+     mpz_t w;
+     const mpz_t u;
+     unsigned long int e;
+{
+  mpz_t s, t;
+  unsigned long int i;
+
+  mpz_init_set_ui (t, 1);
+  mpz_init_set (s, u);
+
+  if ((e & 1) != 0)
+    mpz_mul (t, t, s);
+      
+  for (i = 2; i <= e; i <<= 1)
+    {
+      mpz_mul (s, s, s);
+      if ((i & e) != 0)
+	mpz_mul (t, t, s);
+    }
+
+  mpz_set (w, t);
+  mpz_clear (s);
+  mpz_clear (t);
+}
+
+void
+debug_mp (str, x, base)
+     char *str;
+     mpz_t x;
+     int base;
+{
+  fprintf (stderr, "%s", str);
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-powm.c b/src/gmp/mpz/tests/t-powm.c
new file mode 100644
index 000000000..3b36c5fda
--- /dev/null
+++ b/src/gmp/mpz/tests/t-powm.c
@@ -0,0 +1,134 @@
+/* Test mpz_powm, mpz_mul. mpz_mod, mpz_mod_ui, mpz_div_ui.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1999, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 50
+#endif
+
+#ifndef EXP_SIZE
+#define EXP_SIZE 2
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t base, exp, mod;
+  mpz_t r1, r2, t1, exp2, base2;
+  mp_size_t base_size, exp_size, mod_size;
+  int i;
+  int reps = 2500;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (base);
+  mpz_init (exp);
+  mpz_init (mod);
+  mpz_init (r1);
+  mpz_init (r2);
+  mpz_init (t1);
+  mpz_init (exp2);
+  mpz_init (base2);
+
+  for (i = 0; i < reps; i++)
+    {
+      do
+	{
+	  base_size = urandom () % 2 * SIZE - SIZE;
+	  mpz_random2 (base, base_size);
+
+	  exp_size = urandom () % (EXP_SIZE + 1);
+	  mpz_random2 (exp, exp_size);
+
+      /* Loop until mathematically well-defined.  */
+	}
+      while (mpz_cmp_ui (base, 0) == 0 && mpz_cmp_ui (exp, 0) == 0);
+
+      do
+	{
+	  mod_size = urandom () % SIZE /* - SIZE/2 */;
+	  mpz_random2 (mod, mod_size);
+	}
+      while (mpz_cmp_ui (mod, 0) == 0);
+
+#if 0
+      putc ('\n', stderr);
+      debug_mp (base, -16);
+      debug_mp (exp, -16);
+      debug_mp (mod, -16);
+#endif
+
+      mpz_powm (r1, base, exp, mod);
+
+      mpz_set_ui (r2, 1);
+      mpz_set (base2, base);
+      mpz_set (exp2, exp);
+
+      mpz_mod (r2, r2, mod);	/* needed when exp==0 and mod==1 */
+      while (mpz_cmp_ui (exp2, 0) != 0)
+	{
+	  mpz_mod_ui (t1, exp2, 2);
+	  if (mpz_cmp_ui (t1, 0) != 0)
+	    {
+	      mpz_mul (r2, r2, base2);
+	      mpz_mod (r2, r2, mod);
+	    }
+	  mpz_mul (base2, base2, base2);
+	  mpz_mod (base2, base2, mod);
+	  mpz_div_ui (exp2, exp2, 2);
+	}
+
+#if 0
+      debug_mp (r1, -16);
+      debug_mp (r2, -16);
+#endif
+
+      if (mpz_cmp (r1, r2) != 0)
+	abort ();
+    }
+
+  exit (0);
+}
+
+dump_abort (dividend, divisor)
+     MP_INT *dividend, *divisor;
+{
+  fprintf (stderr, "ERROR\n");
+  fprintf (stderr, "dividend = "); debug_mp (dividend, -16);
+  fprintf (stderr, "divisor  = "); debug_mp (divisor, -16);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     MP_INT *x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-powm_ui.c b/src/gmp/mpz/tests/t-powm_ui.c
new file mode 100644
index 000000000..dd98828ad
--- /dev/null
+++ b/src/gmp/mpz/tests/t-powm_ui.c
@@ -0,0 +1,121 @@
+/* Test mpz_powm_ui, mpz_mul. mpz_mod, mpz_mod_ui, mpz_div_ui.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 8
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t base, mod;
+  mpz_t r1, r2, base2;
+  mp_size_t base_size, mod_size;
+  mp_limb_t exp;
+  unsigned long int exp2;
+  int i;
+  int reps = 10000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (base);
+  mpz_init (mod);
+  mpz_init (r1);
+  mpz_init (r2);
+  mpz_init (base2);
+
+  for (i = 0; i < reps; i++)
+    {
+      base_size = urandom () % SIZE /* - SIZE/2 */;
+      mpz_random2 (base, base_size);
+
+      mpn_random2 (&exp, 1);
+
+      mod_size = urandom () % SIZE /* - SIZE/2 */;
+      mpz_random2 (mod, mod_size);
+      if (mpz_cmp_ui (mod, 0) == 0)
+	continue;
+
+      /* This is mathematically undefined.  */
+      if (mpz_cmp_ui (base, 0) == 0 && exp == 0)
+	continue;
+
+#if 0
+      putc ('\n', stderr);
+      debug_mp (base, -16);
+      debug_mp (mod, -16);
+#endif
+
+      mpz_powm_ui (r1, base, (unsigned long int) exp, mod);
+
+      mpz_set_ui (r2, 1);
+      mpz_set (base2, base);
+      exp2 = exp;
+
+      mpz_mod (r2, r2, mod);	/* needed when exp==0 and mod==1 */
+      while (exp2 != 0)
+	{
+	  if (exp2 % 2 != 0)
+	    {
+	      mpz_mul (r2, r2, base2);
+	      mpz_mod (r2, r2, mod);
+	    }
+	  mpz_mul (base2, base2, base2);
+	  mpz_mod (base2, base2, mod);
+	  exp2 = exp2 / 2;
+	}
+
+#if 0
+      debug_mp (r1, -16);
+      debug_mp (r2, -16);
+#endif
+
+      if (mpz_cmp (r1, r2) != 0)
+	abort ();
+    }
+
+  exit (0);
+}
+
+dump_abort (dividend, divisor)
+     MP_INT *dividend, *divisor;
+{
+  fprintf (stderr, "ERROR\n");
+  fprintf (stderr, "dividend = "); debug_mp (dividend, -16);
+  fprintf (stderr, "divisor  = "); debug_mp (divisor, -16);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     MP_INT *x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-root.c b/src/gmp/mpz/tests/t-root.c
new file mode 100644
index 000000000..8ed42c9ff
--- /dev/null
+++ b/src/gmp/mpz/tests/t-root.c
@@ -0,0 +1,114 @@
+/* Test mpz_add, mpz_add_ui, mpz_cmp, mpz_cmp, mpz_mul, mpz_sqrtrem.
+
+Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 100
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t x2;
+  mpz_t x;
+  mpz_t temp, temp2;
+  mp_size_t x2_size;
+  int i;
+  int reps = 10000;
+  unsigned long nth;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (x2);
+  mpz_init (x);
+  mpz_init (temp);
+  mpz_init (temp2);
+
+  for (i = 0; i < reps; i++)
+    {
+      x2_size = urandom () % SIZE + 1;
+      mpz_random2 (x2, x2_size);
+      nth = urandom () % mpz_sizeinbase (x2, 2) + 1;
+      if ((urandom() & 1) == 0)
+	{
+	  /* With 50% probability, set x2 just below a perfect power.  */
+	  mpz_root (x, x2, nth);
+	  mpz_pow_ui (x2, x, nth);
+	  if (mpz_sgn (x2) != 0)
+	    mpz_sub_ui (x2, x2, 1L);
+	}
+
+      mpz_root (x, x2, nth);
+      mpz_pow_ui (temp, x, nth);
+
+      /* Is power of result > argument?  */
+      if (mpz_cmp (temp, x2) > 0)
+	{
+	  fprintf (stderr, "ERROR after test %d\n", i);
+	  debug_mp (x2, 10);
+	  debug_mp (x, 10);
+	  fprintf (stderr, "nth: %lu\n", nth);
+	  abort ();
+	}
+
+      if (nth > 1 && mpz_cmp_ui (temp, 1L) > 0 && ! mpz_perfect_power_p (temp))
+	{
+	  fprintf (stderr, "ERROR in mpz_perfect_power_p after test %d\n", i);
+	  debug_mp (temp, 10);
+	  debug_mp (x, 10);
+	  fprintf (stderr, "nth: %lu\n", nth);
+	  abort ();
+	}
+
+      if (nth > 10000)
+	continue;		/* skip too expensive test */
+
+      mpz_add_ui (temp2, x, 1L);
+      mpz_pow_ui (temp2, temp2, nth);
+
+      /* Is square of (result + 1) <= argument?  */
+      if (mpz_cmp (temp2, x2) <= 0)
+	{
+	  fprintf (stderr, "ERROR after test %d\n", i);
+	  debug_mp (x2, 10);
+	  debug_mp (x, 10);
+	  fprintf (stderr, "nth: %lu\n", nth);
+	  abort ();
+	}
+    }
+
+  exit (0);
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-sqrtrem.c b/src/gmp/mpz/tests/t-sqrtrem.c
new file mode 100644
index 000000000..71960d81b
--- /dev/null
+++ b/src/gmp/mpz/tests/t-sqrtrem.c
@@ -0,0 +1,98 @@
+/* Test mpz_add, mpz_add_ui, mpz_cmp, mpz_cmp, mpz_mul, mpz_sqrtrem.
+
+Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t x2;
+  mpz_t x, rem;
+  mpz_t temp, temp2;
+  mp_size_t x2_size;
+  int i;
+  int reps = 100000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (x2);
+  mpz_init (x);
+  mpz_init (rem);
+  mpz_init (temp);
+  mpz_init (temp2);
+
+  for (i = 0; i < reps; i++)
+    {
+      x2_size = urandom () % SIZE;
+
+      mpz_random2 (x2, x2_size);
+
+      mpz_sqrtrem (x, rem, x2);
+      mpz_mul (temp, x, x);
+
+      /* Is square of result > argument?  */
+      if (mpz_cmp (temp, x2) > 0)
+	dump_abort (x2, x, rem);
+
+      mpz_add_ui (temp2, x, 1);
+      mpz_mul (temp2, temp2, temp2);
+
+      /* Is square of (result + 1) <= argument?  */
+      if (mpz_cmp (temp2, x2) <= 0)
+	dump_abort (x2, x, rem);
+
+      mpz_add (temp2, temp, rem);
+
+      /* Is the remainder wrong?  */
+      if (mpz_cmp (x2, temp2) != 0)
+	dump_abort (x2, x, rem);
+    }
+
+  exit (0);
+}
+
+dump_abort (x2, x, rem)
+     mpz_t x2, x, rem;
+{
+  fprintf (stderr, "ERROR\n");
+  fprintf (stderr, "x2        = "); debug_mp (x2, -16);
+  fprintf (stderr, "x         = "); debug_mp (x, -16);
+  fprintf (stderr, "remainder = "); debug_mp (rem, -16);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-tdiv.c b/src/gmp/mpz/tests/t-tdiv.c
new file mode 100644
index 000000000..ce874df52
--- /dev/null
+++ b/src/gmp/mpz/tests/t-tdiv.c
@@ -0,0 +1,118 @@
+/* Test mpz_abs, mpz_add, mpz_cmp, mpz_cmp_ui, mpz_tdiv_qr, mpz_tdiv_q,
+   mpz_tdiv_r, mpz_mul.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 200
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t dividend, divisor;
+  mpz_t quotient, remainder;
+  mpz_t quotient2, remainder2;
+  mpz_t temp;
+  mp_size_t dividend_size, divisor_size;
+  int i;
+  int reps = 100000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (dividend);
+  mpz_init (divisor);
+  mpz_init (quotient);
+  mpz_init (remainder);
+  mpz_init (quotient2);
+  mpz_init (remainder2);
+  mpz_init (temp);
+
+  for (i = 0; i < reps; i++)
+    {
+      dividend_size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (dividend, dividend_size);
+
+      divisor_size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (divisor, divisor_size);
+      if (mpz_cmp_ui (divisor, 0) == 0)
+	continue;
+
+      mpz_tdiv_qr (quotient, remainder, dividend, divisor);
+      mpz_tdiv_q (quotient2, dividend, divisor);
+      mpz_tdiv_r (remainder2, dividend, divisor);
+
+      /* First determine that the quotients and remainders computed
+	 with different functions are equal.  */
+      if (mpz_cmp (quotient, quotient2) != 0)
+	dump_abort (dividend, divisor);
+      if (mpz_cmp (remainder, remainder2) != 0)
+	dump_abort (dividend, divisor);
+
+      /* Check if the sign of the quotient is correct.  */
+      if (mpz_cmp_ui (quotient, 0) != 0)
+	if ((mpz_cmp_ui (quotient, 0) < 0)
+	    != ((mpz_cmp_ui (dividend, 0) ^ mpz_cmp_ui (divisor, 0)) < 0))
+	dump_abort (dividend, divisor);
+
+      /* Check if the remainder has the same sign as the dividend
+	 (quotient rounded towards 0).  */
+      if (mpz_cmp_ui (remainder, 0) != 0)
+	if ((mpz_cmp_ui (remainder, 0) < 0) != (mpz_cmp_ui (dividend, 0) < 0))
+	  dump_abort (dividend, divisor);
+
+      mpz_mul (temp, quotient, divisor);
+      mpz_add (temp, temp, remainder);
+      if (mpz_cmp (temp, dividend) != 0)
+	dump_abort (dividend, divisor);
+
+      mpz_abs (temp, divisor);
+      mpz_abs (remainder, remainder);
+      if (mpz_cmp (remainder, temp) >= 0)
+	dump_abort (dividend, divisor);
+    }
+
+  exit (0);
+}
+
+dump_abort (dividend, divisor)
+     mpz_t dividend, divisor;
+{
+  fprintf (stderr, "ERROR\n");
+  fprintf (stderr, "dividend = "); debug_mp (dividend, -16);
+  fprintf (stderr, "divisor  = "); debug_mp (divisor, -16);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tests/t-tdiv_ui.c b/src/gmp/mpz/tests/t-tdiv_ui.c
new file mode 100644
index 000000000..960ebb87f
--- /dev/null
+++ b/src/gmp/mpz/tests/t-tdiv_ui.c
@@ -0,0 +1,117 @@
+/* Test mpz_abs, mpz_add, mpz_cmp, mpz_cmp_ui, mpz_tdiv_qr_ui, mpz_tdiv_q_ui,
+   mpz_tdiv_r_ui, mpz_mul_ui.
+
+Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "urandom.h"
+
+void debug_mp ();
+
+#ifndef SIZE
+#define SIZE 16
+#endif
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  mpz_t dividend;
+  mpz_t quotient, remainder;
+  mpz_t quotient2, remainder2;
+  mpz_t temp;
+  mp_size_t dividend_size;
+  mp_limb_t divisor;
+  int i;
+  int reps = 100000;
+
+  if (argc == 2)
+     reps = atoi (argv[1]);
+
+  mpz_init (dividend);
+  mpz_init (quotient);
+  mpz_init (remainder);
+  mpz_init (quotient2);
+  mpz_init (remainder2);
+  mpz_init (temp);
+
+  for (i = 0; i < reps; i++)
+    {
+      dividend_size = urandom () % SIZE - SIZE/2;
+      mpz_random2 (dividend, dividend_size);
+
+      divisor = urandom ();
+      if (divisor == 0)
+	continue;
+
+      mpz_tdiv_qr_ui (quotient, remainder, dividend, divisor);
+      mpz_tdiv_q_ui (quotient2, dividend, divisor);
+      mpz_tdiv_r_ui (remainder2, dividend, divisor);
+
+      /* First determine that the quotients and remainders computed
+	 with different functions are equal.  */
+      if (mpz_cmp (quotient, quotient2) != 0)
+	dump_abort (dividend, divisor);
+      if (mpz_cmp (remainder, remainder2) != 0)
+	dump_abort (dividend, divisor);
+
+      /* Check if the sign of the quotient is correct.  */
+      if (mpz_cmp_ui (quotient, 0) != 0)
+	if ((mpz_cmp_ui (quotient, 0) < 0)
+	    != (mpz_cmp_ui (dividend, 0) < 0))
+	dump_abort (dividend, divisor);
+
+      /* Check if the remainder has the same sign as the dividend
+	 (quotient rounded towards 0).  */
+      if (mpz_cmp_ui (remainder, 0) != 0)
+	if ((mpz_cmp_ui (remainder, 0) < 0) != (mpz_cmp_ui (dividend, 0) < 0))
+	  dump_abort (dividend, divisor);
+
+      mpz_mul_ui (temp, quotient, divisor);
+      mpz_add (temp, temp, remainder);
+      if (mpz_cmp (temp, dividend) != 0)
+	dump_abort (dividend, divisor);
+
+      mpz_abs (remainder, remainder);
+      if (mpz_cmp_ui (remainder, divisor) >= 0)
+	dump_abort (dividend, divisor);
+    }
+
+  exit (0);
+}
+
+dump_abort (dividend, divisor)
+     mpz_t dividend;
+     mp_limb_t divisor;
+{
+  fprintf (stderr, "ERROR\n");
+  fprintf (stderr, "dividend = "); debug_mp (dividend, -16);
+  fprintf (stderr, "divisor  = %lX\n", divisor);
+  abort();
+}
+
+void
+debug_mp (x, base)
+     mpz_t x;
+{
+  mpz_out_str (stderr, base, x); fputc ('\n', stderr);
+}
diff --git a/src/gmp/mpz/tstbit.c b/src/gmp/mpz/tstbit.c
new file mode 100644
index 000000000..b0a8b0b31
--- /dev/null
+++ b/src/gmp/mpz/tstbit.c
@@ -0,0 +1,70 @@
+/* mpz_tstbit -- test a specified bit.  Simulate 2's complement representation.
+
+Copyright (C) 1997 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int
+#if __STDC__
+mpz_tstbit (mpz_srcptr d, unsigned long int bit_index)
+#else
+mpz_tstbit (d, bit_index)
+     mpz_srcptr d;
+     unsigned long int bit_index;
+#endif
+{
+  mp_size_t dsize = d->_mp_size;
+  mp_ptr dp = d->_mp_d;
+  mp_size_t limb_index;
+
+  limb_index = bit_index / BITS_PER_MP_LIMB;
+  if (dsize >= 0)
+    {
+      if (limb_index < dsize)
+	return (dp[limb_index] >> (bit_index % BITS_PER_MP_LIMB)) & 1;
+      else
+	/* Testing a bit outside of a positive number.  */
+	return 0;
+    }
+  else
+    {
+      mp_size_t zero_bound;
+
+      dsize = -dsize;
+
+      /* Locate the least significant non-zero limb.  */
+      for (zero_bound = 0; dp[zero_bound] == 0; zero_bound++)
+	;
+
+      if (limb_index > zero_bound)
+	{
+	  if (limb_index < dsize)
+	    return (~dp[limb_index] >> (bit_index % BITS_PER_MP_LIMB)) & 1;
+	  else
+	    /* Testing a bit outside of a negative number.  */
+	    return 1;
+	}
+      else if (limb_index == zero_bound)
+	return (-dp[limb_index] >> (bit_index % BITS_PER_MP_LIMB)) & 1;
+      else
+	return 0;
+    }
+}
diff --git a/src/gmp/mpz/ui_pow_ui.c b/src/gmp/mpz/ui_pow_ui.c
new file mode 100644
index 000000000..edd2dee62
--- /dev/null
+++ b/src/gmp/mpz/ui_pow_ui.c
@@ -0,0 +1,139 @@
+/* mpz_ui_pow_ui(res, base, exp) -- Set RES to BASE**EXP.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+
+static void mpz_pow2 _PROTO ((mpz_ptr r, mp_limb_t blimb, unsigned long int e, mp_limb_t rl));
+
+void
+#if __STDC__
+mpz_ui_pow_ui (mpz_ptr r, unsigned long int b, unsigned long int e)
+#else
+mpz_ui_pow_ui (r, b, e)
+     mpz_ptr r;
+     unsigned long int b;
+     unsigned long int e;
+#endif
+{
+  mp_limb_t blimb = b;
+  mp_limb_t rl;
+
+  if (e == 0)
+    {
+      /* For x^0 we return 1, even if x is 0.  */
+      r->_mp_d[0] = 1;
+      r->_mp_size = 1;
+      return;
+    }
+
+  /* Compute b^e as (b^n)^(e div n) * b^(e mod n), where n is chosen such that
+     the latter factor is the largest number small enough to fit in a limb.  */
+
+  rl = 1;
+  while (e != 0 && blimb < ((mp_limb_t) 1 << BITS_PER_MP_LIMB/2))
+    {
+      if ((e & 1) != 0)
+	rl = rl * blimb;
+      blimb = blimb * blimb;
+      e = e >> 1;
+    }
+
+  /* rl is now b^(e mod n).  (I.e., the latter factor above.)  */
+
+  if (e == 0)
+    {
+      r->_mp_d[0] = rl;
+      r->_mp_size = rl != 0;
+      return;
+    }
+
+  mpz_pow2 (r, blimb, e, rl);
+}
+
+/* Multi-precision part of expontialization code.  */
+static void
+#if __STDC__
+mpz_pow2 (mpz_ptr r, mp_limb_t blimb, unsigned long int e, mp_limb_t rl)
+#else
+mpz_pow2 (r, blimb, e, rl)
+     mpz_ptr r;
+     mp_limb_t blimb;
+     unsigned long int e;
+     mp_limb_t rl;
+#endif
+{
+  mp_ptr rp, tp;
+  mp_size_t ralloc, rsize;
+  int cnt, i;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+
+  /* Over-estimate temporary space requirements somewhat.  */
+  count_leading_zeros (cnt, blimb);
+  ralloc = e - cnt * e / BITS_PER_MP_LIMB + 1;
+
+  /* The two areas are used to alternatingly hold the input and receive the
+     product for mpn_mul.  (Needed since mpn_mul_n requires that the product
+     is distinct from either input operand.)  */
+  rp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+  tp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
+
+  rp[0] = blimb;
+  rsize = 1;
+
+  count_leading_zeros (cnt, e);
+  for (i = BITS_PER_MP_LIMB - cnt - 2; i >= 0; i--)
+    {
+      mpn_mul_n (tp, rp, rp, rsize);
+      rsize = 2 * rsize;
+      rsize -= tp[rsize - 1] == 0;
+      MP_PTR_SWAP (rp, tp);
+
+      if ((e & ((mp_limb_t) 1 << i)) != 0)
+	{
+	  mp_limb_t cy;
+	  cy = mpn_mul_1 (rp, rp, rsize, blimb);
+	  rp[rsize] = cy;
+	  rsize += cy != 0;
+	}
+    }
+
+  /* We will need rsize or rsize+1 limbs for the result.  */
+  if (r->_mp_alloc <= rsize)
+    _mpz_realloc (r, rsize + 1);
+
+  /* Multiply the two factors (in rp,rsize and rl) and put the final result
+     in place.  */
+  {
+    mp_limb_t cy;
+    cy = mpn_mul_1 (r->_mp_d, rp, rsize, rl);
+    (r->_mp_d)[rsize] = cy;
+    rsize += cy != 0;
+  }
+
+  r->_mp_size = rsize;
+  TMP_FREE (marker);
+}
diff --git a/src/gmp/mpz/urandomb.c b/src/gmp/mpz/urandomb.c
new file mode 100644
index 000000000..caca086e0
--- /dev/null
+++ b/src/gmp/mpz/urandomb.c
@@ -0,0 +1,49 @@
+/* mpz_urandomb (rop, state, n) -- Generate a uniform pseudorandom
+   integer in the range 0 to 2^N - 1, inclusive, using STATE as the
+   random state previously initialized by a call to gmp_randinit().
+
+Copyright (C) 1999, 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_urandomb (mpz_t rop, gmp_randstate_t rstate, unsigned long int nbits)
+#else
+mpz_urandomb (rop, rstate, nbits)
+     mpz_t rop;
+     gmp_randstate_t rstate;
+     unsigned long int nbits;
+#endif
+{
+  mp_ptr rp;
+  mp_size_t size;
+
+  size = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+  if (ALLOC (rop) < size)
+    _mpz_realloc (rop, size);
+
+  rp = PTR (rop);
+
+  _gmp_rand (rp, rstate, nbits);
+  MPN_NORMALIZE (rp, size);
+  SIZ (rop) = size;
+}
diff --git a/src/gmp/mpz/urandomm.c b/src/gmp/mpz/urandomm.c
new file mode 100644
index 000000000..aa5778408
--- /dev/null
+++ b/src/gmp/mpz/urandomm.c
@@ -0,0 +1,73 @@
+/* mpz_urandomm (rop, state, n) -- Generate a uniform pseudorandom
+   integer in the range 0 to N-1, using STATE as the random state
+   previously initialized by a call to gmp_randinit().
+
+Copyright (C) 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+void
+#if __STDC__
+mpz_urandomm (mpz_t rop, gmp_randstate_t rstate, mpz_t n)
+#else
+mpz_urandomm (rop, rstate, n)
+     mpz_t rop;
+     gmp_randstate_t rstate;
+     mpz_t n;
+#endif
+{
+  mpz_t t, p, m;
+  mp_ptr tp;
+  mp_size_t nbits, size;
+  int count;
+
+  /* FIXME: Should check for n == 0 and report error */
+
+  size = SIZ (n);
+  count_leading_zeros (count, PTR (n)[size - 1]);
+  nbits = size * BITS_PER_MP_LIMB - count;
+
+  /* Allocate enough for any mpz function called since a realloc of
+     these will fail.  */
+  MPZ_TMP_INIT (t, size);
+  MPZ_TMP_INIT (m, size + 1);
+  MPZ_TMP_INIT (p, size + 1);
+
+  /* Let m = highest possible random number plus 1.  */
+  mpz_set_ui (m, 0);
+  mpz_setbit (m, nbits);
+
+  /* Let p = floor(m / n) * n.  */
+  mpz_fdiv_q (p, m, n);
+  mpz_mul (p, p, n);
+
+  tp = PTR (t);
+  do
+    {
+      _gmp_rand (tp, rstate, nbits);
+      MPN_NORMALIZE (tp, size);	/* FIXME: Really necessary?  */
+      SIZ (t) = size;
+    }
+  while (mpz_cmp (t, p) >= 0);
+
+  mpz_mod (rop, t, n);
+}
diff --git a/src/gmp/mpz/xor.c b/src/gmp/mpz/xor.c
new file mode 100644
index 000000000..69898d179
--- /dev/null
+++ b/src/gmp/mpz/xor.c
@@ -0,0 +1,217 @@
+/* mpz_xor -- Logical xor.
+
+Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
+Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+mpz_xor (mpz_ptr res, mpz_srcptr op1, mpz_srcptr op2)
+#else
+mpz_xor (res, op1, op2)
+     mpz_ptr res;
+     mpz_srcptr op1;
+     mpz_srcptr op2;
+#endif
+{
+  mp_srcptr op1_ptr, op2_ptr;
+  mp_size_t op1_size, op2_size;
+  mp_ptr res_ptr;
+  mp_size_t res_size, res_alloc;
+  mp_size_t i;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  op1_size = op1->_mp_size;
+  op2_size = op2->_mp_size;
+
+  op1_ptr = op1->_mp_d;
+  op2_ptr = op2->_mp_d;
+  res_ptr = res->_mp_d;
+
+  if (op1_size >= 0)
+    {
+      if (op2_size >= 0)
+	{
+	  if (op1_size >= op2_size)
+	    {
+	      if (res->_mp_alloc < op1_size)
+		{
+		  _mpz_realloc (res, op1_size);
+		  op1_ptr = op1->_mp_d;
+		  op2_ptr = op2->_mp_d;
+		  res_ptr = res->_mp_d;
+		}
+
+	      if (res_ptr != op1_ptr)
+		MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
+			  op1_size - op2_size);
+	      for (i = op2_size - 1; i >= 0; i--)
+		res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
+	      res_size = op1_size;
+	    }
+	  else
+	    {
+	      if (res->_mp_alloc < op2_size)
+		{
+		  _mpz_realloc (res, op2_size);
+		  op1_ptr = op1->_mp_d;
+		  op2_ptr = op2->_mp_d;
+		  res_ptr = res->_mp_d;
+		}
+
+	      if (res_ptr != op2_ptr)
+		MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size,
+			  op2_size - op1_size);
+	      for (i = op1_size - 1; i >= 0; i--)
+		res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
+	      res_size = op2_size;
+	    }
+
+	  MPN_NORMALIZE (res_ptr, res_size);
+	  res->_mp_size = res_size;
+	  return;
+	}
+      else /* op2_size < 0 */
+	{
+	  /* Fall through to the code at the end of the function.  */
+	}
+    }
+  else
+    {
+      if (op2_size < 0)
+	{
+	  mp_ptr opx;
+	  mp_limb_t cy;
+
+	  /* Both operands are negative, the result will be positive.
+	      (-OP1) ^ (-OP2) =
+	     = ~(OP1 - 1) ^ ~(OP2 - 1) =
+	     = (OP1 - 1) ^ (OP2 - 1)  */
+
+	  op1_size = -op1_size;
+	  op2_size = -op2_size;
+
+	  /* Possible optimization: Decrease mpn_sub precision,
+	     as we won't use the entire res of both.  */
+	  opx = (mp_ptr) TMP_ALLOC (op1_size * BYTES_PER_MP_LIMB);
+	  mpn_sub_1 (opx, op1_ptr, op1_size, (mp_limb_t) 1);
+	  op1_ptr = opx;
+
+	  opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
+	  mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
+	  op2_ptr = opx;
+
+	  res_alloc = MAX (op1_size, op2_size);
+	  if (res->_mp_alloc < res_alloc)
+	    {
+	      _mpz_realloc (res, res_alloc);
+	      res_ptr = res->_mp_d;
+	      /* Don't re-read OP1_PTR and OP2_PTR.  They point to
+		 temporary space--never to the space RES->_mp_d used
+		 to point to before reallocation.  */
+	    }
+
+	  if (op1_size > op2_size)
+	    {
+	      MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
+			op1_size - op2_size);
+	      for (i = op2_size - 1; i >= 0; i--)
+		res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
+	      res_size = op1_size;
+	    }
+	  else
+	    {
+	      MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size,
+			op2_size - op1_size);
+	      for (i = op1_size - 1; i >= 0; i--)
+		res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
+	      res_size = op2_size;
+	    }
+
+	  MPN_NORMALIZE (res_ptr, res_size);
+	  res->_mp_size = res_size;
+	  TMP_FREE (marker);
+	  return;
+	}
+      else
+	{
+	  /* We should compute -OP1 ^ OP2.  Swap OP1 and OP2 and fall
+	     through to the code that handles OP1 ^ -OP2.  */
+          MPZ_SRCPTR_SWAP (op1, op2);
+          MPN_SRCPTR_SWAP (op1_ptr,op1_size, op2_ptr,op2_size);
+	}
+    }
+
+  {
+    mp_ptr opx;
+    mp_limb_t cy;
+    mp_size_t count;
+
+    /* Operand 2 negative, so will be the result.
+       -(OP1 ^ (-OP2)) = -(OP1 ^ ~(OP2 - 1)) =
+       = ~(OP1 ^ ~(OP2 - 1)) + 1 =
+       = (OP1 ^ (OP2 - 1)) + 1      */
+
+    op2_size = -op2_size;
+
+    opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
+    mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
+    op2_ptr = opx;
+
+    res_alloc = MAX (op1_size, op2_size) + 1;
+    if (res->_mp_alloc < res_alloc)
+      {
+	_mpz_realloc (res, res_alloc);
+	op1_ptr = op1->_mp_d;
+	res_ptr = res->_mp_d;
+	/* Don't re-read OP2_PTR.  It points to temporary space--never
+	   to the space RES->_mp_d used to point to before reallocation.  */
+      }
+
+    if (op1_size > op2_size)
+      {
+	MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size, op1_size - op2_size);
+	for (i = op2_size - 1; i >= 0; i--)
+	  res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
+	res_size = op1_size;
+      }
+    else
+      {
+	MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size, op2_size - op1_size);
+	for (i = op1_size - 1; i >= 0; i--)
+	  res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
+	res_size = op2_size;
+      }
+
+    cy = mpn_add_1 (res_ptr, res_ptr, res_size, (mp_limb_t) 1);
+    if (cy)
+      {
+	res_ptr[res_size] = cy;
+	res_size++;
+      }
+
+    MPN_NORMALIZE (res_ptr, res_size);
+    res->_mp_size = -res_size;
+    TMP_FREE (marker);
+  }
+}
diff --git a/src/gmp/rand.c b/src/gmp/rand.c
new file mode 100644
index 000000000..d1f935451
--- /dev/null
+++ b/src/gmp/rand.c
@@ -0,0 +1,171 @@
+/* gmp_randinit (state, algorithm, ...) -- Initialize a random state.
+
+Copyright (C) 1999, 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include <stdio.h> /* for NULL */
+#if __STDC__
+# include <stdarg.h>
+#else
+# include <varargs.h>
+#endif
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+/* Array of CL-schemes, ordered in increasing order of the first
+   member (the 'm2exp' value).  The end of the array is indicated with
+   an entry containing all zeros.  */
+
+/* All multipliers are in the range 0.01*m and 0.99*m, and are
+congruent to 5 (mod 8).
+They all pass the spectral test with Vt >= 2^(30/t) and merit >= 1.
+(Up to and including 196 bits, merit is >= 3.)  */
+
+struct __gmp_rand_lc_scheme_struct
+{
+  unsigned long int m2exp;	/* Modulus is 2 ^ m2exp. */
+  char *astr;			/* Multiplier in string form. */
+  unsigned long int c;		/* Adder. */
+};
+
+struct __gmp_rand_lc_scheme_struct __gmp_rand_lc_scheme[] =
+{
+  {32, "43840821", 	     1},
+  {33, "85943917", 	     1},
+  {34, "171799469", 	     1},
+  {35, "343825285", 	     1},
+  {36, "687285701", 	     1},
+  {37, "1374564613", 	     1},
+  {38, "2749193437", 	     1},
+  {39, "5497652029", 	     1},
+  {40, "10995212661", 	     1},
+  {56, "47988680294711517",  1},
+  {64, "13469374875402548381", 1},
+  {100, "203786806069096950756900463357", 1},	
+  {128, "96573135900076068624591706046897650309", 1},
+  {156, "43051576988660538262511726153887323360449035333", 1},
+  {196, "1611627857640767981443524165616850972435303571524033586421", 1},
+  {200, "491824250216153841876046962368396460896019632211283945747141", 1},
+  {256, "79336254595106925775099152154558630917988041692672147726148065355845551082677", 1},
+  {0, NULL, 0}			/* End of array. */
+};
+
+void
+#if __STDC__
+gmp_randinit (gmp_randstate_t rstate,
+	      gmp_randalg_t alg,
+	      ...)
+#else
+gmp_randinit (va_alist)
+     va_dcl
+#endif
+{
+  va_list ap;
+#if __STDC__
+#else
+  __gmp_randstate_struct *rstate;
+  gmp_randalg_t alg;
+#endif
+
+#if __STDC__
+  va_start (ap, alg);
+#else
+  va_start (ap);
+
+  rstate = va_arg (ap, __gmp_randstate_struct *);
+  alg = va_arg (ap, gmp_randalg_t);
+#endif
+
+  switch (alg)
+    {
+    case GMP_RAND_ALG_LC:	/* Linear congruential.  */
+      {
+	unsigned long int size;
+	struct __gmp_rand_lc_scheme_struct *sp;
+	mpz_t a;
+
+	size = va_arg (ap, unsigned long int);
+
+	/* Pick a scheme.  */
+	for (sp = __gmp_rand_lc_scheme; sp->m2exp != 0; sp++)
+	  if (sp->m2exp / 2 >= size)
+	    break;
+
+	if (sp->m2exp == 0)	/* Nothing big enough found.  */
+	  {
+	    gmp_errno |= GMP_ERROR_INVALID_ARGUMENT;
+	    return;
+	  }
+
+	/* Install scheme.  */
+	mpz_init_set_str (a, sp->astr, 0);
+	gmp_randinit_lc_2exp (rstate, a, sp->c, sp->m2exp);
+	mpz_clear (a);
+	break;
+      }
+
+#if 0
+    case GMP_RAND_ALG_BBS:	/* Blum, Blum, and Shub. */
+      {				
+	mpz_t p, q;
+	mpz_t ztmp;
+
+	/* FIXME: Generate p and q.  They must be ``large'' primes,
+           congruent to 3 mod 4.  Should we ensure that they meet some
+           of the criterias for being ``hard primes''?*/
+
+	/* These are around 128 bits. */
+	mpz_init_set_str (p, "148028650191182616877187862194899201391", 10); 
+	mpz_init_set_str (q, "315270837425234199477225845240496832591", 10);
+	
+	/* Allocate algorithm specific data. */
+	rstate->data.bbs = (__gmp_rand_data_bbs *)
+	  (*_mp_allocate_func) (sizeof (__gmp_rand_data_bbs));
+
+	mpz_init (rstate->data.bbs->bi); /* The Blum integer. */
+	mpz_mul (rstate->data.bbs->bi, p, q);
+
+	/* Find a seed, x, with gcd (x, bi) == 1. */
+	mpz_init (ztmp);
+	while (1)
+	  {
+	    mpz_gcd (ztmp, seed, rstate->data.bbs->bi);
+	    if (!mpz_cmp_ui (ztmp, 1))
+	      break;
+	    mpz_add_ui (seed, seed, 1);
+	  }
+
+	rstate->alg = alg;
+	rstate->size = size;		/* FIXME: Remove. */
+	mpz_set (rstate->seed, seed);
+
+	mpz_clear (p);
+	mpz_clear (q);
+	mpz_clear (ztmp);
+	break;
+      }
+#endif /* 0 */
+
+    default:			/* Bad choice. */
+      gmp_errno |= GMP_ERROR_UNSUPPORTED_ARGUMENT;
+    }
+
+  va_end (ap);
+}
diff --git a/src/gmp/randclr.c b/src/gmp/randclr.c
new file mode 100644
index 000000000..5cb029116
--- /dev/null
+++ b/src/gmp/randclr.c
@@ -0,0 +1,54 @@
+/* gmp_randclear (state) -- Clear and deallocate random state STATE.
+
+Copyright (C) 1999, 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+gmp_randclear (gmp_randstate_t rstate)
+#else
+gmp_randclear (rstate)
+     gmp_randstate_t rstate;
+#endif
+{
+  mpz_clear (rstate->seed);
+
+  switch (rstate->alg)
+    {
+    case GMP_RAND_ALG_LC:
+      mpz_clear (rstate->algdata.lc->a);
+      if (rstate->algdata.lc->m2exp == 0)
+	mpz_clear (rstate->algdata.lc->m);
+      (*_mp_free_func) (rstate->algdata.lc, sizeof (*rstate->algdata.lc));
+      break;
+
+#if 0
+    case GMP_RAND_ALG_BBS:
+      mpz_clear (rstate->algdata.bbs->bi);
+      (*_mp_free_func) (rstate->algdata.bbs, sizeof (*rstate->algdata.bbs));
+      break;
+#endif /* 0 */
+
+    default:
+      gmp_errno |= GMP_ERROR_UNSUPPORTED_ARGUMENT;
+    }
+}
diff --git a/src/gmp/randlc.c b/src/gmp/randlc.c
new file mode 100644
index 000000000..7079db827
--- /dev/null
+++ b/src/gmp/randlc.c
@@ -0,0 +1,56 @@
+/* gmp_randinit_lc (state, a, c, m) -- Initialize a random state for a
+   linear congruential generator with multiplier A, adder C, and
+   modulus M.
+
+Copyright (C) 1999, 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+gmp_randinit_lc (gmp_randstate_t rstate,
+		 mpz_t a,
+		 unsigned long int c,
+		 mpz_t m)
+#else
+gmp_randinit_lc (rstate, a, c, m)
+     gmp_randstate_t rstate;
+     mpz_t a;
+     unsigned long int c;
+     mpz_t m;
+#endif
+{
+  /* FIXME: Not finished.  We don't handle this in _gmp_rand() yet. */
+  abort ();			
+
+  mpz_init_set_ui (rstate->seed, 1);
+  _mpz_realloc (rstate->seed, ABSIZ (m));
+
+  /* Allocate algorithm specific data. */
+  rstate->algdata.lc = (__gmp_randata_lc *)
+    (*_mp_allocate_func) (sizeof (__gmp_randata_lc));
+
+  mpz_init_set (rstate->algdata.lc->a, a);
+  rstate->algdata.lc->c = c;
+  mpz_init_set (rstate->algdata.lc->m, m);
+
+  rstate->alg = GMP_RAND_ALG_LC;
+}
diff --git a/src/gmp/randlc2x.c b/src/gmp/randlc2x.c
new file mode 100644
index 000000000..dbd5f041e
--- /dev/null
+++ b/src/gmp/randlc2x.c
@@ -0,0 +1,59 @@
+/* gmp_randinit_lc_2exp (state, a, c, m2exp) -- Initialize random
+   state STATE for a linear congruential generator with multiplier A,
+   adder C, and modulus 2 ^ M2EXP.
+
+Copyright (C) 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+gmp_randinit_lc_2exp (gmp_randstate_t rstate,
+		      mpz_t a,
+		      unsigned long int c,
+		      unsigned long int m2exp)
+#else
+gmp_randinit_lc_2exp (rstate, a, c, m2exp)
+     gmp_randstate_t rstate;
+     mpz_t a;
+     unsigned long int c;
+     unsigned long int m2exp;
+#endif
+{
+  mpz_init_set_ui (rstate->seed, 1);
+  _mpz_realloc (rstate->seed, m2exp / BITS_PER_MP_LIMB
+		+ (m2exp % BITS_PER_MP_LIMB != 0));
+
+  /* Allocate algorithm specific data. */
+  rstate->algdata.lc = (__gmp_randata_lc *)
+    (*_mp_allocate_func) (sizeof (__gmp_randata_lc));
+
+  mpz_init_set (rstate->algdata.lc->a, a);
+  rstate->algdata.lc->c = c;
+
+  /* Cover weird case where m2exp is 0, which means that m is used
+     instead of m2exp.  */
+  if (m2exp == 0)
+    mpz_init_set_ui (rstate->algdata.lc->m, 0);
+  rstate->algdata.lc->m2exp = m2exp;
+
+  rstate->alg = GMP_RAND_ALG_LC;
+}
diff --git a/src/gmp/randraw.c b/src/gmp/randraw.c
new file mode 100644
index 000000000..c0c3889d3
--- /dev/null
+++ b/src/gmp/randraw.c
@@ -0,0 +1,360 @@
+/* _gmp_rand (rp, state, nbits) -- Generate a random bitstream of
+   length NBITS in RP.  RP must have enough space allocated to hold
+   NBITS.
+
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+/* For linear congruential (LC), we use one of algorithms (1) or (2).
+   (gmp-3.0 uses algorithm (1) with 'm' as a power of 2.)
+
+LC algorithm (1).
+
+	X = (aX + c) mod m
+
+[D. Knuth, "The Art of Computer Programming: Volume 2, Seminumerical Algorithms",
+Third Edition, Addison Wesley, 1998, pp. 184-185.]
+
+	X is the seed and the result
+	a is chosen so that
+	    a mod 8 = 5 [3.2.1.2] and [3.2.1.3]
+	    .01m < a < .99m
+	    its binary or decimal digits is not a simple, regular pattern
+	    it has no large quotients when Euclid's algorithm is used to find
+	      gcd(a, m) [3.3.3]
+	    it passes the spectral test [3.3.4]
+	    it passes several tests of [3.3.2]
+	c has no factor in common with m (c=1 or c=a can be good)
+	m is large (2^30)
+	  is a power of 2 [3.2.1.1]
+
+The least significant digits of the generated number are not very
+random.  It should be regarded as a random fraction X/m.  To get a
+random integer between 0 and n-1, multiply X/m by n and truncate.
+(Don't use X/n [ex 3.4.1-3])
+
+The ``accuracy'' in t dimensions is one part in ``the t'th root of m'' [3.3.4].
+
+Don't generate more than about m/1000 numbers without changing a, c, or m.
+
+The sequence length depends on chosen a,c,m.
+
+
+LC algorithm (2).
+
+	X = a * (X mod q) - r * (long) (X/q)
+	if X<0 then X+=m
+
+[Knuth, pp. 185-186.]
+
+	X is the seed and the result
+	  as a seed is nonzero and less than m
+	a is a primitive root of m (which means that a^2 <= m)
+	q is (long) m / a
+	r is m mod a
+	m is a prime number near the largest easily computed integer
+
+which gives
+
+	X = a * (X % ((long) m / a)) -
+	    (M % a) * ((long) (X / ((long) m / a)))
+
+Since m is prime, the least-significant bits of X are just as random as
+the most-significant bits. */
+
+/* Blum, Blum, and Shub.
+
+   [Bruce Schneier, "Applied Cryptography", Second Edition, John Wiley
+   & Sons, Inc., 1996, pp. 417-418.]
+
+   "Find two large prime numbers, p and q, which are congruent to 3
+   modulo 4.  The product of those numbers, n, is a blum integer.
+   Choose another random integer, x, which is relatively prime to n.
+   Compute
+	x[0] = x^2 mod n
+   That's the seed for the generator."
+
+   To generate a random bit, compute
+	x[i] = x[i-1]^2 mod n
+   The least significant bit of x[i] is the one we want.
+
+   We can use more than one bit from x[i], namely the
+	log2(bitlength of x[i])
+   least significant bits of x[i].
+
+   So, for a 32-bit seed we get 5 bits per computation.
+
+   The non-predictability of this generator is based on the difficulty
+   of factoring n.
+ */
+
+/* -------------------------------------------------- */
+
+/* lc (rp, state) -- Generate next number in LC sequence.  Return the
+   number of valid bits in the result.  NOTE: If 'm' is a power of 2
+   (m2exp != 0), discard the lower half of the result.  */
+
+static
+unsigned long int
+#if __STDC__
+lc (mp_ptr rp, gmp_randstate_t rstate)
+#else
+lc (rp, rstate)
+     mp_ptr rp;
+     gmp_randstate_t rstate;
+#endif
+{
+  mp_ptr tp, seedp, ap;
+  mp_size_t ta;
+  mp_size_t tn, seedn, an;
+  mp_size_t retval;
+  int shiftcount = 0;
+  unsigned long int m2exp;
+  mp_limb_t c;
+  TMP_DECL (mark);
+
+  m2exp = rstate->algdata.lc->m2exp;
+  c = (mp_limb_t) rstate->algdata.lc->c;
+
+  seedp = PTR (rstate->seed);
+  seedn = SIZ (rstate->seed);
+
+  if (seedn == 0)
+    {
+      /* Seed is 0.  Result is C % M.  */
+      *rp = c;
+
+      if (m2exp != 0)
+	{
+	  /* M is a power of 2.  */
+	  if (m2exp < BITS_PER_MP_LIMB)
+	    {
+	      /* Only necessary when M may be smaller than C.  */
+	      *rp &= (((mp_limb_t) 1 << m2exp) - 1);
+	    }
+	}
+      else
+	{
+	  /* M is not a power of 2.  */
+	  abort ();		/* FIXME.  */
+	}
+
+      /* Save result as next seed.  */
+      *seedp = *rp;
+      SIZ (rstate->seed) = 1;
+      return BITS_PER_MP_LIMB;
+    }
+
+  ap = PTR (rstate->algdata.lc->a);
+  an = SIZ (rstate->algdata.lc->a);
+
+  /* Allocate temporary storage.  Let there be room for calculation of
+     (A * seed + C) % M, or M if bigger than that.  */
+
+  ASSERT_ALWAYS (m2exp != 0);	/* FIXME.  */
+
+  TMP_MARK (mark);
+  ta = an + seedn + 1;
+  tp = (mp_ptr) TMP_ALLOC (ta * BYTES_PER_MP_LIMB);
+  MPN_ZERO (tp, ta);
+
+  /* t = a * seed */
+  if (seedn >= an)
+    mpn_mul_basecase (tp, seedp, seedn, ap, an);
+  else
+    mpn_mul_basecase (tp, ap, an, seedp, seedn);
+  tn = an + seedn;
+
+  /* t = t + c */
+  mpn_incr_u (tp, c);
+
+  /* t = t % m */
+  if (m2exp != 0)
+    {
+      /* M is a power of 2.  The mod operation is trivial.  */
+
+      tp[m2exp / BITS_PER_MP_LIMB] &= ((mp_limb_t) 1 << m2exp % BITS_PER_MP_LIMB) - 1;
+      tn = (m2exp + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+    }
+  else
+    {
+      abort ();			/* FIXME.  */
+    }
+
+  /* Save result as next seed.  */
+  MPN_COPY (PTR (rstate->seed), tp, tn);
+  SIZ (rstate->seed) = tn;
+
+  if (m2exp != 0)
+    {
+      /* Discard the lower half of the result.  */
+      unsigned long int discardb = m2exp / 2;
+      mp_size_t discardl = discardb / BITS_PER_MP_LIMB;
+
+      tn -= discardl;
+      if (tn > 0)
+	{
+	  if (discardb % BITS_PER_MP_LIMB != 0)
+	    {
+	      mpn_rshift (tp, tp + discardl, tn, discardb % BITS_PER_MP_LIMB);
+	      MPN_COPY (rp, tp, (discardb + BITS_PER_MP_LIMB -1) / BITS_PER_MP_LIMB);
+	    }
+	  else			/* Even limb boundary.  */
+	    MPN_COPY_INCR (rp, tp + discardl, tn);
+	}
+    }
+  else
+    {
+      MPN_COPY (rp, tp, tn);
+    }
+
+  TMP_FREE (mark);
+
+  /* Return number of valid bits in the result.  */
+  if (m2exp != 0)
+    retval = (m2exp + 1) / 2;
+  else
+    retval = SIZ (rstate->algdata.lc->m) * BITS_PER_MP_LIMB - shiftcount;
+  return retval;
+}
+
+#ifdef RAWRANDEBUG
+/* Set even bits to EVENBITS and odd bits to ! EVENBITS in RP.
+   Number of bits is m2exp in state.  */
+/* FIXME: Remove.  */
+unsigned long int
+lc_test (mp_ptr rp, gmp_randstate_t s, const int evenbits)
+{
+  unsigned long int rn, nbits;
+  int f;
+
+  nbits = s->algdata.lc->m2exp / 2;
+  rn = nbits / BITS_PER_MP_LIMB + (nbits % BITS_PER_MP_LIMB != 0);
+  MPN_ZERO (rp, rn);
+
+  for (f = 0; f < nbits; f++)
+    {
+      mpn_lshift (rp, rp, rn, 1);
+      if (f % 2 == ! evenbits)
+	rp[0] += 1;
+    }
+
+  return nbits;
+}
+#endif /* RAWRANDEBUG */
+
+void
+#if __STDC__
+_gmp_rand (mp_ptr rp, gmp_randstate_t rstate, unsigned long int nbits)
+#else
+_gmp_rand (rp, rstate, nbits)
+     mp_ptr rp;
+     gmp_randstate_t rstate;
+     unsigned long int nbits;
+#endif
+{
+  mp_size_t rn;			/* Size of R.  */
+
+  rn = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+
+  switch (rstate->alg)
+    {
+    case GMP_RAND_ALG_LC:
+      {
+	unsigned long int rbitpos;
+	int chunk_nbits;
+	mp_ptr tp;
+	mp_size_t tn;
+	TMP_DECL (lcmark);
+
+	TMP_MARK (lcmark);
+
+	chunk_nbits = rstate->algdata.lc->m2exp / 2;
+	tn = (chunk_nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+
+	tp = (mp_ptr) TMP_ALLOC (tn * BYTES_PER_MP_LIMB);
+
+	rbitpos = 0;
+	while (rbitpos + chunk_nbits <= nbits)
+	  {
+	    mp_ptr r2p = rp + rbitpos / BITS_PER_MP_LIMB;
+
+	    if (rbitpos % BITS_PER_MP_LIMB != 0)
+	      {
+		mp_limb_t savelimb, rcy;
+		/* Target of of new chunk is not bit aligned.  Use temp space
+		   and align things by shifting it up.  */
+		lc (tp, rstate);
+		savelimb = r2p[0];
+		rcy = mpn_lshift (r2p, tp, tn, rbitpos % BITS_PER_MP_LIMB);
+		r2p[0] |= savelimb;
+/* bogus */	if ((chunk_nbits % BITS_PER_MP_LIMB + rbitpos % BITS_PER_MP_LIMB)
+		    > BITS_PER_MP_LIMB)
+		  r2p[tn] = rcy;
+	      }
+	    else
+	      {
+		/* Target of of new chunk is bit aligned.  Let `lc' put bits
+		   directly into our target variable.  */
+		lc (r2p, rstate);
+	      }
+	    rbitpos += chunk_nbits;
+	  }
+
+	/* Handle last [0..chunk_nbits) bits.  */
+	if (rbitpos != nbits)
+	  {
+	    mp_ptr r2p = rp + rbitpos / BITS_PER_MP_LIMB;
+	    int last_nbits = nbits - rbitpos;
+	    tn = (last_nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
+	    lc (tp, rstate);
+	    if (rbitpos % BITS_PER_MP_LIMB != 0)
+	      {
+		mp_limb_t savelimb, rcy;
+		/* Target of of new chunk is not bit aligned.  Use temp space
+		   and align things by shifting it up.  */
+		savelimb = r2p[0];
+		rcy = mpn_lshift (r2p, tp, tn, rbitpos % BITS_PER_MP_LIMB);
+		r2p[0] |= savelimb;
+		if (rbitpos + tn * BITS_PER_MP_LIMB - rbitpos % BITS_PER_MP_LIMB < nbits)
+		  r2p[tn] = rcy;
+	      }
+	    else
+	      {
+		MPN_COPY (r2p, tp, tn);
+	      }
+	    /* Mask off top bits if needed.  */
+	    if (nbits % BITS_PER_MP_LIMB != 0)
+	      rp[nbits / BITS_PER_MP_LIMB]
+		&= ~ ((~(mp_limb_t) 0) << nbits % BITS_PER_MP_LIMB);
+	  }
+
+	TMP_FREE (lcmark);
+	break;
+      }
+
+    default:
+      gmp_errno |= GMP_ERROR_UNSUPPORTED_ARGUMENT;
+      break;
+    }
+}
diff --git a/src/gmp/randsd.c b/src/gmp/randsd.c
new file mode 100644
index 000000000..3bed14b57
--- /dev/null
+++ b/src/gmp/randsd.c
@@ -0,0 +1,37 @@
+/* gmp_randseed (state, seed) -- Set initial seed SEED in random state
+   STATE.
+
+Copyright (C) 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+gmp_randseed (gmp_randstate_t rstate,
+	      mpz_t seed)
+#else
+gmp_randseed (rstate, seed)
+     gmp_randstate_t rstate;
+     mpz_t seed;
+#endif
+{
+  mpz_set (rstate->seed, seed);
+}
diff --git a/src/gmp/randsdui.c b/src/gmp/randsdui.c
new file mode 100644
index 000000000..92f412f3e
--- /dev/null
+++ b/src/gmp/randsdui.c
@@ -0,0 +1,37 @@
+/* gmp_randseed_ui (state, seed) -- Set initial seed SEED in random
+   state STATE.
+
+Copyright (C) 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+void
+#if __STDC__
+gmp_randseed_ui (gmp_randstate_t rstate,
+		  unsigned long int seed)
+#else
+gmp_randseed_ui (rstate, seed)
+     gmp_randstate_t rstate;
+     mpz_t seed;
+#endif
+{
+  mpz_set_ui (rstate->seed, seed);
+}
diff --git a/src/gmp/stack-alloc.c b/src/gmp/stack-alloc.c
new file mode 100644
index 000000000..9ab98fe5f
--- /dev/null
+++ b/src/gmp/stack-alloc.c
@@ -0,0 +1,136 @@
+/* Stack allocation routines.  This is intended for machines without support
+   for the `alloca' function.
+
+Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#include "stack-alloc.h"
+
+#define __need_size_t
+#include <stddef.h>
+#undef __need_size_t
+
+/* gmp-impl.h and stack-alloc.h conflict when not USE_STACK_ALLOC, so these
+   declarations are copied here */
+#if __STDC__
+extern void *	(*__gmp_allocate_func) (size_t);
+extern void	(*__gmp_free_func) (void *, size_t);
+#else
+extern void *	(*__gmp_allocate_func) ();
+extern void	(*__gmp_free_func) ();
+#endif
+
+typedef struct tmp_stack tmp_stack;
+
+static unsigned long max_total_allocation = 0;
+static unsigned long current_total_allocation = 0;
+
+static tmp_stack xxx = {&xxx, &xxx, 0};
+static tmp_stack *current = &xxx;
+
+/* The rounded size of the header of each allocation block.  */
+#define HSIZ ((sizeof (tmp_stack) + __TMP_ALIGN - 1) & -__TMP_ALIGN)
+
+/* Allocate a block of exactly <size> bytes.  This should only be called
+   through the TMP_ALLOC macro, which takes care of rounding/alignment.  */
+void *
+#if __STDC__
+__gmp_tmp_alloc (unsigned long size)
+#else
+__gmp_tmp_alloc (size)
+     unsigned long size;
+#endif
+{
+  void *that;
+
+  if (size > (char *) current->end - (char *) current->alloc_point)
+    {
+      void *chunk;
+      tmp_stack *header;
+      unsigned long chunk_size;
+      unsigned long now;
+
+      /* Allocate a chunk that makes the total current allocation somewhat
+	 larger than the maximum allocation ever.  If size is very large, we
+	 allocate that much.  */
+
+      now = current_total_allocation + size;
+      if (now > max_total_allocation)
+	{
+	  /* We need more temporary memory than ever before.  Increase
+	     for future needs.  */
+	  now = now * 3 / 2;
+	  chunk_size = now - current_total_allocation + HSIZ;
+	  current_total_allocation = now;
+	  max_total_allocation = current_total_allocation;
+	}
+      else
+	{
+	  chunk_size = max_total_allocation - current_total_allocation + HSIZ;
+	  current_total_allocation = max_total_allocation;
+	}
+
+      chunk = (*__gmp_allocate_func) (chunk_size);
+      header = (tmp_stack *) chunk;
+      header->end = (char *) chunk + chunk_size;
+      header->alloc_point = (char *) chunk + HSIZ;
+      header->prev = current;
+      current = header;
+    }
+
+  that = current->alloc_point;
+  current->alloc_point = (char *) that + size;
+  return that;
+}
+
+/* Typically called at function entry.  <mark> is assigned so that
+   __gmp_tmp_free can later be used to reclaim all subsequently allocated
+   storage.  */
+void
+#if __STDC__
+__gmp_tmp_mark (tmp_marker *mark)
+#else
+__gmp_tmp_mark (mark)
+     tmp_marker *mark;
+#endif
+{
+  mark->which_chunk = current;
+  mark->alloc_point = current->alloc_point;
+}
+
+/* Free everything allocated since <mark> was assigned by __gmp_tmp_mark */
+void
+#if __STDC__
+__gmp_tmp_free (tmp_marker *mark)
+#else
+__gmp_tmp_free (mark)
+     tmp_marker *mark;
+#endif
+{
+  while (mark->which_chunk != current)
+    {
+      tmp_stack *tmp;
+
+      tmp = current;
+      current = tmp->prev;
+      current_total_allocation -= (((char *) (tmp->end) - (char *) tmp) - HSIZ);
+      (*__gmp_free_func) (tmp, (char *) tmp->end - (char *) tmp);
+    }
+  current->alloc_point = mark->alloc_point;
+}
diff --git a/src/gmp/stack-alloc.h b/src/gmp/stack-alloc.h
new file mode 100644
index 000000000..f59beec26
--- /dev/null
+++ b/src/gmp/stack-alloc.h
@@ -0,0 +1,64 @@
+/* Stack allocation routines.  This is intended for machines without support
+   for the `alloca' function.
+
+Copyright (C) 1996, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+struct tmp_stack
+{
+  void *end;
+  void *alloc_point;
+  struct tmp_stack *prev;
+};
+
+struct tmp_marker
+{
+  struct tmp_stack *which_chunk;
+  void *alloc_point;
+};
+
+typedef struct tmp_marker tmp_marker;
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+
+#if __STDC__
+void *__gmp_tmp_alloc (unsigned long);
+void __gmp_tmp_mark (tmp_marker *);
+void __gmp_tmp_free (tmp_marker *);
+#else
+void *__gmp_tmp_alloc ();
+void __gmp_tmp_mark ();
+void __gmp_tmp_free ();
+#endif
+
+#if defined (__cplusplus)
+}
+#endif
+
+#ifndef __TMP_ALIGN
+#define __TMP_ALIGN 8
+#endif
+
+#define TMP_DECL(marker) tmp_marker marker
+#define TMP_ALLOC(size) \
+  __gmp_tmp_alloc (((unsigned long) (size) + __TMP_ALIGN - 1) & -__TMP_ALIGN)
+#define TMP_MARK(marker) __gmp_tmp_mark (&marker)
+#define TMP_FREE(marker) __gmp_tmp_free (&marker)
diff --git a/src/gmp/stamp-h.in b/src/gmp/stamp-h.in
new file mode 100644
index 000000000..9788f7023
--- /dev/null
+++ b/src/gmp/stamp-h.in
@@ -0,0 +1 @@
+timestamp
diff --git a/src/gmp/stamp-vti b/src/gmp/stamp-vti
new file mode 100644
index 000000000..5ac4cb8c2
--- /dev/null
+++ b/src/gmp/stamp-vti
@@ -0,0 +1,3 @@
+@set UPDATED 3 August 2000
+@set EDITION 3.1
+@set VERSION 3.1
diff --git a/src/gmp/tests/Makefile.am b/src/gmp/tests/Makefile.am
new file mode 100644
index 000000000..9a093f318
--- /dev/null
+++ b/src/gmp/tests/Makefile.am
@@ -0,0 +1,25 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = rand
diff --git a/src/gmp/tests/Makefile.in b/src/gmp/tests/Makefile.in
new file mode 100644
index 000000000..a9504eb6f
--- /dev/null
+++ b/src/gmp/tests/Makefile.in
@@ -0,0 +1,331 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies
+
+SUBDIRS = rand
+subdir = tests
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES = 
+DIST_SOURCES = 
+DIST_COMMON =  Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+all: all-redirect
+.SUFFIXES:
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu tests/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+# 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.
+
+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; \
+	dot_seen=no; \
+	target=`echo $@ | sed s/-recursive//`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    dot_seen=yes; \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+	done; \
+	if test "$$dot_seen" = "no"; then \
+	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+	fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+	@set fnord $(MAKEFLAGS); amf=$$2; \
+	dot_seen=no; \
+	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
+	  rev="$$subdir $$rev"; \
+	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
+	done; \
+	test "$$dot_seen" = "no" && rev=". $$rev"; \
+	target=`echo $@ | sed s/-recursive//`; \
+	for subdir in $$rev; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_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 \
+	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+	done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+   if test "$$subdir" = .; then :; else \
+	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+   fi; \
+	done; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+	for subdir in $(SUBDIRS); do \
+	  if test "$$subdir" = .; then :; else \
+	    test -d $(distdir)/$$subdir \
+	    || mkdir $(distdir)/$$subdir \
+	    || exit 1; \
+	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \
+	      || exit 1; \
+	  fi; \
+	done
+info-am:
+info: info-recursive
+dvi-am:
+dvi: dvi-recursive
+check-am: all-am
+check: check-recursive
+installcheck-am:
+installcheck: installcheck-recursive
+install-exec-am:
+install-exec: install-exec-recursive
+
+install-data-am:
+install-data: install-data-recursive
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-recursive
+uninstall-am:
+uninstall: uninstall-recursive
+all-am: Makefile
+all-redirect: all-recursive
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs: installdirs-recursive
+installdirs-am:
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-tags mostlyclean-generic
+
+mostlyclean: mostlyclean-recursive
+
+clean-am:  clean-tags clean-generic mostlyclean-am
+
+clean: clean-recursive
+
+distclean-am:  distclean-tags distclean-generic clean-am
+	-rm -f libtool
+
+distclean: distclean-recursive
+
+maintainer-clean-am:  maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-recursive
+
+.PHONY: install-recursive uninstall-recursive 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-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+installdirs-am 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/src/gmp/tests/rand/ChangeLog b/src/gmp/tests/rand/ChangeLog
new file mode 100644
index 000000000..b88a1d9da
--- /dev/null
+++ b/src/gmp/tests/rand/ChangeLog
@@ -0,0 +1,158 @@
+2000-07-14  Kevin Ryde  <kevin@swox.se>
+
+	* Makefile.am (allprogs): Pseudo-target to build everything.
+	(CLEANFILES): Add EXTRA_PROGRAMS and EXTRA_LTLIBRARIES.
+	(manual-test, manual-bigtest): Add $(EXEEXT) to	dependencies.
+
+	* */Makefile.in: Regenerate with patched automake that adds
+	$(EXEEXT) to EXTRA_PROGRAMS.
+
+2000-06-11  Kevin Ryde  <kevin@swox.se>
+
+	* t-rand.c (main): Change "usage" to work with K&R.
+
+2000-06-09  Kevin Ryde  <kevin@swox.se>
+
+	* Makefile.am (libstat_la_LIBADD): Add -lm, no longer on libgmp.la.
+	(findlc_LDADD): Use libstat.la.
+	(AUTOMAKE_OPTIONS): Use ansi2knr.
+
+2000-04-16  Linus Nordberg  <linus@swox.se>
+
+	* t-rand.c (main): Add non-ANSI function declaration.  Don't use
+	`const'.
+
+2000-04-15  Linus Nordberg  <linus@swox.se>
+
+	* Makefile.am: Don't do anything for target 'all'.
+	* Makefile.in: Regenerate.
+
+2000-04-13  Linus Nordberg  <linus@swox.se>
+
+	* t-rand.c: Add copyright notice.
+
+2000-04-12  Linus Nordberg  <linus@swox.se>
+
+	* gen.c (main): Include gmp.h.  Remove macros MIN, MAX.  Add
+	option '-q'.  Don't demand argument N.  Change parameters in call
+	to mpf_urandomb.
+
+	* t-rand.c: New file for testing random number generation.
+	
+	* Makefile.am: Run t-rand for 'make check'.
+	(test, bigtest): Rename to manual-test, manual-bigtest.
+	* Makefile.in: Regenerate.
+
+2000-04-11  Linus Nordberg  <linus@swox.se>
+
+	* stat.c (main): Initialize `l1runs' at declaration.
+
+2000-04-10  Linus Nordberg  <linus@swox.se>
+
+	* Makefile.am (test, bigtest): Quote argument to grep.
+	* Makefile.in: Regenerate.
+
+	* gen.c: Declare optarg, optind, opterr if not already declared.
+	(main): Use new names for the random stuff.
+	(main): Don't use strtoul() if we don't have it.  Use strtol()
+	instead, if we have it.  Otherwise, use atoi().
+	(main): Use srandom/srandomdev for __FreeBSD__ only.
+	(main): Use new parameter order to gmp_randinit().
+
+	* stat.c: Declare optarg, optind, opterr if not already declared.
+
+2000-04-10  Kevin Ryde  <kevin@swox.se>
+
+	* statlib.c: mpz_cmp_abs => mpz_cmpabs.
+
+	* Makefile.am (LDADD): Don't need -lm (now in libgmp.la).
+	(EXTRA_PROGRAMS): Not noinst_PROGRAMS.
+	(INCLUDES): Shorten to -I$(top_srcdir) now using AM_CONFIG_HEADER.
+
+2000-04-01  Linus Nordberg  <linus@swox.se>
+
+	* Makefile.am (noinst_PROGRAMS): Change findcl --> findlc.  Add
+	gen.static.
+	* Makefile.in: Regenerate.
+
+	* gen.c (main): Add mpz_urandomm.  Add command line options `-C',
+	`-m', extend `-a'.  Use *mp*_*rand*() with new parameters.  Call
+	gmp_rand_seed().
+
+1999-05-26  Linus Nordberg  <linus@swox.se>
+
+	* Makefile (test, bigtest): Add 33-bit tests.
+
+	* gen.c (main): Set precision of variable passed to
+	mpf_urandomb().  Add option `-p'.
+
+1999-05-21  Linus Nordberg  <linus@swox.se>
+
+	* gen.c (main): Pass `s' to rand-funcs instead of address of `s'.
+
+1999-04-29  Linus Nordberg  <linus@swox.se>
+
+	* findcl.c (main): Add option '-i' for interval factor.  Separate
+	v and merit lose figures.  Add '-v' for version.
+
+1999-04-28  Linus Nordberg  <linus@swox.se>
+
+	* statlib.c: Change debugging stuff.
+
+	* gmpstat.h: Add debug values definitions.
+
+	* findcl.c (main): Print low and high merit on startup.  Print
+	version string on startup.  Catch SEGV and HUP.  Add option -d for
+	debug.  Fix bug making test for v too hard.
+	(sh_status): New function.
+	(sh_status): Flush stdout.  Add RCSID.
+
+b1999-04-27  Linus Nordberg  <linus@swox.se>
+
+	* Makefile (clean): Add target.
+
+1999-04-27  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* stat.c: Include gmpstat.h.
+	Add global int g_debug.
+
+	* spect.c: Include <unistd.h>.
+
+	* findcl.c (main): Input is `m', not all factors of `m'.  Print
+	only the very first matching multiplier.  Include <unistd.h>.
+	Flush stdout.  Print "done." when done.
+
+	* spect.c: Move everything but main() to statlib.c.
+
+	* findcl.c: New file.
+
+	* gmpstat.h: New file.
+
+	* statlib.c (merit, merit_u, f_floor, vz_dot, spectral_test): New
+	functions.
+
+1999-03-29  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* stat.c (f_freq): Don't print 2nd level results if doing 1st
+	level.
+
+	* gen.c (main): Set default algorithm to mpz_urandomb.
+	(main): Add option -c.
+
+1999-03-24  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* Makefile (GMPINC): Rename to GMPH.
+	(GMPH):	Add gmp-mparam.h.
+	(CFLAGS): Add -I$(GMPLIBDIR)/mpn
+
+1999-03-16  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* statlib.c (ks_table): Use mpf_pow_ui() and exp().
+
+	* gen.c: Include unistd.h for getopt.
+
+1999-03-15  Linus Nordberg  <linus.nordberg@canit.se>
+
+	* gen.c, stat.c, statlib.c, statlib.h: New files.
+	* Makefile, ChangeLog: New files.
+
diff --git a/src/gmp/tests/rand/Makefile.am b/src/gmp/tests/rand/Makefile.am
new file mode 100644
index 000000000..449ae7464
--- /dev/null
+++ b/src/gmp/tests/rand/Makefile.am
@@ -0,0 +1,92 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+check_PROGRAMS = t-rand
+TESTS = $(check_PROGRAMS)
+
+EXTRA_PROGRAMS = findlc gen gen.static spect stat
+gen_static_SOURCES = gen.c
+gen_static_LDFLAGS = -static
+findlc_LDADD = libstat.la
+spect_LDADD = libstat.la
+stat_LDADD = libstat.la
+
+EXTRA_LTLIBRARIES = libstat.la
+libstat_la_SOURCES = statlib.c zdiv_round.c
+libstat_la_LIBADD = $(top_builddir)/libgmp.la -lm
+
+EXTRA_DIST = gmpstat.h
+
+CLEANFILES = $(EXTRA_PROGRAMS) $(EXTRA_LTLIBRARIES)
+
+allprogs: $(EXTRA_PROGRAMS)
+
+manual-test: gen$(EXEEXT) stat$(EXEEXT)
+	@(echo -n '16i: '; ./gen -f mpz_urandomb -z 16 1000 \
+		| ./stat -i 0xffff | grep '^[0-9]')
+	@(echo -n '32i: '; ./gen -f mpz_urandomb -z 32 1000 \
+		| ./stat -i 0xffffffff  | grep '^[0-9]')
+	@(echo -n '33i: '; ./gen -f mpz_urandomb -z 33 1000 \
+		| ./stat -i 0x1ffffffff  | grep '^[0-9]')
+	@(echo -n '64i: '; ./gen -f mpz_urandomb -z 64 1000 \
+		| ./stat -i 0xffffffffffffffff  | grep '^[0-9]')
+	@(echo -n '128i: '; ./gen -f mpz_urandomb -z 128 1000 \
+		| ./stat -i 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF | grep '^[0-9]')
+
+	@(echo -n '16f: '; ./gen -f mpf_urandomb -z 16 1000 \
+		| ./stat | grep '^[0-9]')
+	@(echo -n '32f: '; ./gen -f mpf_urandomb -z 32 1000 \
+		| ./stat | grep '^[0-9]')
+	@(echo -n '33f: '; ./gen -f mpf_urandomb -z 33 1000 \
+		| ./stat | grep '^[0-9]')
+	@(echo -n '64f: '; ./gen -f mpf_urandomb -z 64 1000 \
+		| ./stat | grep '^[0-9]')
+	@(echo -n '128f: '; ./gen -f mpf_urandomb -z 128 1000 \
+		| ./stat | grep '^[0-9]')
+
+manual-bigtest: gen$(EXEEXT) stat$(EXEEXT)
+	@(echo '16i: '; ./gen -f mpz_urandomb -z 16 50000 \
+		| ./stat -2 1000 -i 0xffff | grep '^K[mp]')
+	@(echo '32i: '; ./gen -f mpz_urandomb -z 32 50000 \
+		| ./stat -2 1000 -i 0xffffffff | grep '^K[mp]')
+	@(echo '33i: '; ./gen -f mpz_urandomb -z 33 50000 \
+		| ./stat -2 1000 -i 0x1ffffffff | grep '^K[mp]')
+	@(echo '64i: '; ./gen -f mpz_urandomb -z 64 50000 \
+		| ./stat -2 1000 -i 0xffffffffffffffff  | grep '^K[mp]')
+	@(echo '128i: '; ./gen -f mpz_urandomb -z 128 50000 \
+		| ./stat -2 1000 -i 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF | grep '^K[mp]')
+
+	@(echo '16f: '; ./gen -f mpf_urandomb -z 16 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
+	@(echo '32f: '; ./gen -f mpf_urandomb -z 32 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
+	@(echo '33f: '; ./gen -f mpf_urandomb -z 33 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
+	@(echo '64f: '; ./gen -f mpf_urandomb -z 64 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
+	@(echo '128f: '; ./gen -f mpf_urandomb -z 128 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
diff --git a/src/gmp/tests/rand/Makefile.in b/src/gmp/tests/rand/Makefile.in
new file mode 100644
index 000000000..00ab238b1
--- /dev/null
+++ b/src/gmp/tests/rand/Makefile.in
@@ -0,0 +1,535 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+LDADD = $(top_builddir)/libgmp.la
+
+check_PROGRAMS = t-rand
+TESTS = $(check_PROGRAMS)
+
+EXTRA_PROGRAMS = findlc gen gen.static spect stat
+gen_static_SOURCES = gen.c
+gen_static_LDFLAGS = -static
+findlc_LDADD = libstat.la
+spect_LDADD = libstat.la
+stat_LDADD = libstat.la
+
+EXTRA_LTLIBRARIES = libstat.la
+libstat_la_SOURCES = statlib.c zdiv_round.c
+libstat_la_LIBADD = $(top_builddir)/libgmp.la -lm
+
+EXTRA_DIST = gmpstat.h
+
+CLEANFILES = $(EXTRA_PROGRAMS) $(EXTRA_LTLIBRARIES)
+subdir = tests/rand
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../../config.h
+CONFIG_CLEAN_FILES = 
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I../..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+ANSI2KNR = $(top_builddir)/ansi2knr
+libstat_la_LDFLAGS = 
+libstat_la_DEPENDENCIES =  $(top_builddir)/libgmp.la
+am_libstat_la_OBJECTS =  statlib$U.lo zdiv_round$U.lo
+libstat_la_OBJECTS =  $(am_libstat_la_OBJECTS)
+EXTRA_PROGRAMS =  findlc$(EXEEXT) gen$(EXEEXT) gen.static spect$(EXEEXT) \
+stat$(EXEEXT)
+check_PROGRAMS =  t-rand$(EXEEXT)
+findlc_SOURCES = findlc.c
+findlc_OBJECTS =  findlc$U.$(OBJEXT)
+findlc_DEPENDENCIES =  libstat.la
+findlc_LDFLAGS = 
+gen_SOURCES = gen.c
+gen_OBJECTS =  gen$U.$(OBJEXT)
+gen_LDADD = $(LDADD)
+gen_DEPENDENCIES =  $(top_builddir)/libgmp.la
+gen_LDFLAGS = 
+am_gen_static_OBJECTS =  gen$U.$(OBJEXT)
+gen_static_OBJECTS =  $(am_gen_static_OBJECTS)
+gen_static_LDADD = $(LDADD)
+gen_static_DEPENDENCIES =  $(top_builddir)/libgmp.la
+spect_SOURCES = spect.c
+spect_OBJECTS =  spect$U.$(OBJEXT)
+spect_DEPENDENCIES =  libstat.la
+spect_LDFLAGS = 
+stat_SOURCES = stat.c
+stat_OBJECTS =  stat$U.$(OBJEXT)
+stat_DEPENDENCIES =  libstat.la
+stat_LDFLAGS = 
+t_rand_SOURCES = t-rand.c
+t_rand_OBJECTS =  t-rand$U.$(OBJEXT)
+t_rand_LDADD = $(LDADD)
+t_rand_DEPENDENCIES =  $(top_builddir)/libgmp.la
+t_rand_LDFLAGS = 
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(libstat_la_SOURCES) findlc.c gen.c \
+$(gen_static_SOURCES) spect.c stat.c t-rand.c
+DIST_COMMON =  ChangeLog Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(libstat_la_SOURCES) findlc.c gen.c $(gen_static_SOURCES) spect.c stat.c t-rand.c
+OBJECTS = $(am_libstat_la_OBJECTS) findlc$U.$(OBJEXT) gen$U.$(OBJEXT) $(am_gen_static_OBJECTS) spect$U.$(OBJEXT) stat$U.$(OBJEXT) t-rand$U.$(OBJEXT)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu tests/rand/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+$(top_builddir)/ansi2knr: $(top_builddir)/ansi2knr.$(OBJEXT)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr
+
+$(top_builddir)/ansi2knr.$(OBJEXT):
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr.$(OBJEXT)
+
+
+mostlyclean-kr:
+	-rm -f *_.c
+
+clean-kr:
+
+distclean-kr:
+
+maintainer-clean-kr:
+
+libstat.la: $(libstat_la_OBJECTS) $(libstat_la_DEPENDENCIES)
+	$(LINK)  $(libstat_la_LDFLAGS) $(libstat_la_OBJECTS) $(libstat_la_LIBADD) $(LIBS)
+
+mostlyclean-checkPROGRAMS:
+
+clean-checkPROGRAMS:
+	-test -z "$(check_PROGRAMS)" || rm -f $(check_PROGRAMS)
+
+distclean-checkPROGRAMS:
+
+maintainer-clean-checkPROGRAMS:
+
+findlc$(EXEEXT): $(findlc_OBJECTS) $(findlc_DEPENDENCIES)
+	@rm -f findlc$(EXEEXT)
+	$(LINK) $(findlc_LDFLAGS) $(findlc_OBJECTS) $(findlc_LDADD) $(LIBS)
+
+gen$(EXEEXT): $(gen_OBJECTS) $(gen_DEPENDENCIES)
+	@rm -f gen$(EXEEXT)
+	$(LINK) $(gen_LDFLAGS) $(gen_OBJECTS) $(gen_LDADD) $(LIBS)
+
+gen.static: $(gen_static_OBJECTS) $(gen_static_DEPENDENCIES)
+	@rm -f gen.static
+	$(LINK) $(gen_static_LDFLAGS) $(gen_static_OBJECTS) $(gen_static_LDADD) $(LIBS)
+
+spect$(EXEEXT): $(spect_OBJECTS) $(spect_DEPENDENCIES)
+	@rm -f spect$(EXEEXT)
+	$(LINK) $(spect_LDFLAGS) $(spect_OBJECTS) $(spect_LDADD) $(LIBS)
+
+stat$(EXEEXT): $(stat_OBJECTS) $(stat_DEPENDENCIES)
+	@rm -f stat$(EXEEXT)
+	$(LINK) $(stat_LDFLAGS) $(stat_OBJECTS) $(stat_LDADD) $(LIBS)
+
+t-rand$(EXEEXT): $(t_rand_OBJECTS) $(t_rand_DEPENDENCIES)
+	@rm -f t-rand$(EXEEXT)
+	$(LINK) $(t_rand_LDFLAGS) $(t_rand_OBJECTS) $(t_rand_LDADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+findlc_.c: findlc.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/findlc.c; then echo $(srcdir)/findlc.c; else echo findlc.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > findlc_.c
+gen_.c: gen.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/gen.c; then echo $(srcdir)/gen.c; else echo gen.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > gen_.c
+spect_.c: spect.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/spect.c; then echo $(srcdir)/spect.c; else echo spect.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > spect_.c
+stat_.c: stat.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/stat.c; then echo $(srcdir)/stat.c; else echo stat.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > stat_.c
+statlib_.c: statlib.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/statlib.c; then echo $(srcdir)/statlib.c; else echo statlib.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > statlib_.c
+t-rand_.c: t-rand.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/t-rand.c; then echo $(srcdir)/t-rand.c; else echo t-rand.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > t-rand_.c
+zdiv_round_.c: zdiv_round.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/zdiv_round.c; then echo $(srcdir)/zdiv_round.c; else echo zdiv_round.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > zdiv_round_.c
+findlc_.$(OBJEXT) findlc_.lo gen_.$(OBJEXT) gen_.lo spect_.$(OBJEXT) \
+spect_.lo stat_.$(OBJEXT) stat_.lo statlib_.$(OBJEXT) statlib_.lo \
+t-rand_.$(OBJEXT) t-rand_.lo zdiv_round_.$(OBJEXT) zdiv_round_.lo : \
+$(ANSI2KNR)
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+check-TESTS: $(TESTS)
+	@failed=0; all=0; xfail=0; xpass=0; \
+	srcdir=$(srcdir); export srcdir; \
+	for tst in $(TESTS); do \
+	  if test -f ./$$tst; then dir=./; \
+	  elif test -f $$tst; then dir=; \
+	  else dir="$(srcdir)/"; fi; \
+	  if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xpass=`expr $$xpass + 1`; \
+	      failed=`expr $$failed + 1`; \
+	      echo "XPASS: $$tst"; \
+	    ;; \
+	    *) \
+	      echo "PASS: $$tst"; \
+	    ;; \
+	    esac; \
+	  elif test $$? -ne 77; then \
+	    all=`expr $$all + 1`; \
+	    case " $(XFAIL_TESTS) " in \
+	    *" $$tst "*) \
+	      xfail=`expr $$xfail + 1`; \
+	      echo "XFAIL: $$tst"; \
+	    ;; \
+	    *) \
+	      failed=`expr $$failed + 1`; \
+	      echo "FAIL: $$tst"; \
+	    ;; \
+	    esac; \
+	  fi; \
+	done; \
+	if test "$$failed" -eq 0; then \
+	  if test "$$xfail" -eq 0; then \
+	    banner="All $$all tests passed"; \
+	  else \
+	    banner="All $$all tests behaved as expected ($$xfail expected failures)"; \
+	  fi; \
+	else \
+	  if test "$$xpass" -eq 0; then \
+	    banner="$$failed of $$all tests failed"; \
+	  else \
+	    banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \
+	  fi; \
+	fi; \
+	dashes=`echo "$$banner" | sed s/./=/g`; \
+	echo "$$dashes"; \
+	echo "$$banner"; \
+	echo "$$dashes"; \
+	test "$$failed" -eq 0
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am: all-am
+	$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
+	$(MAKE) $(AM_MAKEFLAGS) check-TESTS
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am:
+install-data: install-data-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am:
+uninstall: uninstall-am
+all-am: Makefile
+all-redirect: all-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs:
+
+
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-compile mostlyclean-libtool mostlyclean-kr \
+		mostlyclean-checkPROGRAMS mostlyclean-tags \
+		mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am:  clean-compile clean-libtool clean-kr clean-checkPROGRAMS \
+		clean-tags clean-generic mostlyclean-am
+
+clean: clean-am
+
+distclean-am:  distclean-compile distclean-libtool distclean-kr \
+		distclean-checkPROGRAMS distclean-tags \
+		distclean-generic clean-am
+	-rm -f libtool
+
+distclean: distclean-am
+
+maintainer-clean-am:  maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-kr maintainer-clean-checkPROGRAMS \
+		maintainer-clean-tags maintainer-clean-generic \
+		distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool mostlyclean-kr distclean-kr \
+clean-kr maintainer-clean-kr mostlyclean-checkPROGRAMS \
+distclean-checkPROGRAMS clean-checkPROGRAMS \
+maintainer-clean-checkPROGRAMS tags mostlyclean-tags distclean-tags \
+clean-tags maintainer-clean-tags distdir check-TESTS info-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
+install-exec install-data-am install-data install-am install \
+uninstall-am uninstall all-redirect all-am all install-strip \
+installdirs mostlyclean-generic distclean-generic clean-generic \
+maintainer-clean-generic clean mostlyclean distclean maintainer-clean
+
+
+allprogs: $(EXTRA_PROGRAMS)
+
+manual-test: gen$(EXEEXT) stat$(EXEEXT)
+	@(echo -n '16i: '; ./gen -f mpz_urandomb -z 16 1000 \
+		| ./stat -i 0xffff | grep '^[0-9]')
+	@(echo -n '32i: '; ./gen -f mpz_urandomb -z 32 1000 \
+		| ./stat -i 0xffffffff  | grep '^[0-9]')
+	@(echo -n '33i: '; ./gen -f mpz_urandomb -z 33 1000 \
+		| ./stat -i 0x1ffffffff  | grep '^[0-9]')
+	@(echo -n '64i: '; ./gen -f mpz_urandomb -z 64 1000 \
+		| ./stat -i 0xffffffffffffffff  | grep '^[0-9]')
+	@(echo -n '128i: '; ./gen -f mpz_urandomb -z 128 1000 \
+		| ./stat -i 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF | grep '^[0-9]')
+
+	@(echo -n '16f: '; ./gen -f mpf_urandomb -z 16 1000 \
+		| ./stat | grep '^[0-9]')
+	@(echo -n '32f: '; ./gen -f mpf_urandomb -z 32 1000 \
+		| ./stat | grep '^[0-9]')
+	@(echo -n '33f: '; ./gen -f mpf_urandomb -z 33 1000 \
+		| ./stat | grep '^[0-9]')
+	@(echo -n '64f: '; ./gen -f mpf_urandomb -z 64 1000 \
+		| ./stat | grep '^[0-9]')
+	@(echo -n '128f: '; ./gen -f mpf_urandomb -z 128 1000 \
+		| ./stat | grep '^[0-9]')
+
+manual-bigtest: gen$(EXEEXT) stat$(EXEEXT)
+	@(echo '16i: '; ./gen -f mpz_urandomb -z 16 50000 \
+		| ./stat -2 1000 -i 0xffff | grep '^K[mp]')
+	@(echo '32i: '; ./gen -f mpz_urandomb -z 32 50000 \
+		| ./stat -2 1000 -i 0xffffffff | grep '^K[mp]')
+	@(echo '33i: '; ./gen -f mpz_urandomb -z 33 50000 \
+		| ./stat -2 1000 -i 0x1ffffffff | grep '^K[mp]')
+	@(echo '64i: '; ./gen -f mpz_urandomb -z 64 50000 \
+		| ./stat -2 1000 -i 0xffffffffffffffff  | grep '^K[mp]')
+	@(echo '128i: '; ./gen -f mpz_urandomb -z 128 50000 \
+		| ./stat -2 1000 -i 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF | grep '^K[mp]')
+
+	@(echo '16f: '; ./gen -f mpf_urandomb -z 16 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
+	@(echo '32f: '; ./gen -f mpf_urandomb -z 32 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
+	@(echo '33f: '; ./gen -f mpf_urandomb -z 33 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
+	@(echo '64f: '; ./gen -f mpf_urandomb -z 64 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
+	@(echo '128f: '; ./gen -f mpf_urandomb -z 128 50000 \
+		| ./stat -2 1000 | grep '^K[mp]')
+
+# 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/src/gmp/tests/rand/findlc.c b/src/gmp/tests/rand/findlc.c
new file mode 100644
index 000000000..ace8f9fd0
--- /dev/null
+++ b/src/gmp/tests/rand/findlc.c
@@ -0,0 +1,255 @@
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <signal.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmpstat.h"
+
+#define RCSID(msg) \
+static /**/const char *const rcsid[] = { (char *)rcsid, "\100(#)" msg }
+
+RCSID("$Id$");
+
+int g_debug = 0;
+
+static mpz_t a;
+
+static void
+sh_status (int sig)
+{
+  printf ("sh_status: signal %d caught. dumping status.\n", sig);
+
+  printf ("  a = ");
+  mpz_out_str (stdout, 10, a);
+  printf ("\n");
+  fflush (stdout);
+
+  if (SIGSEGV == sig)		/* remove SEGV handler */
+    signal (SIGSEGV, SIG_DFL);
+}
+
+/* Input is a modulus (m).  We shall find multiplyer (a) and adder (c)
+   conforming to the rules found in the first comment block in file
+   mpz/urandom.c.
+
+   Then run a spectral test on the generator and discard any
+   multipliers not passing.  */
+
+/* TODO:
+
+   . find a better algorithm than a+=8; bigger jumps perhaps?
+
+*/
+
+void
+mpz_true_random (mpz_t s, unsigned long int nbits)
+{
+#if __FreeBSD__
+  FILE *fs;
+  char c[1];
+  int i;
+
+  mpz_set_ui (s, 0);
+  for (i = 0; i < nbits; i += 8)
+    {
+      for (;;)
+	{
+	  int nread;
+	  fs = fopen ("/dev/random", "r");
+	  nread = fread (c, 1, 1, fs);
+	  fclose (fs);
+	  if (nread != 0)
+	    break;
+	  sleep (1);
+	}
+      mpz_mul_2exp (s, s, 8);
+      mpz_add_ui (s, s, ((unsigned long int) c[0]) & 0xff);
+      printf ("%d random bits\n", i + 8);
+    }
+  if (nbits % 8 != 0)
+    mpz_mod_2exp (s, s, nbits);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  const char usage[] = "usage: findlc [-dv] m2exp [low_merit [high_merit]]\n";
+  int f;
+  int v_lose, m_lose, v_best, m_best;
+  int c;
+  int debug = 1;
+  int cnt_high_merit;
+  mpz_t m;
+  unsigned long int m2exp;
+#define DIMS 6			/* dimensions run in spectral test */
+  mpf_t v[DIMS-1];		/* spectral test result (there's no v
+                                   for 1st dimension */
+  mpf_t f_merit, low_merit, high_merit;
+  mpz_t acc, minus8;
+  mpz_t min, max;
+  mpz_t s;
+
+
+  mpz_init (m);
+  mpz_init (a);
+  for (f = 0; f < DIMS-1; f++)
+    mpf_init (v[f]);
+  mpf_init (f_merit);
+  mpf_init_set_d (low_merit, .1);
+  mpf_init_set_d (high_merit, .1);
+
+  while ((c = getopt (argc, argv, "a:di:hv")) != -1)
+    switch (c)
+      {
+      case 'd':			/* debug */
+	g_debug++;
+	break;
+
+      case 'v':			/* print version */
+	puts (rcsid[1]);
+	exit (0);
+
+      case 'h':
+      case '?':
+      default:
+	fputs (usage, stderr);
+	exit (1);
+      }
+
+  argc -= optind;
+  argv += optind;
+
+  if (argc < 1)
+    {
+      fputs (usage, stderr);
+      exit (1);
+    }
+
+  /* Install signal handler. */
+  if (SIG_ERR == signal (SIGSEGV, sh_status))
+    {
+      perror ("signal (SIGSEGV)");
+      exit (1);
+    }
+  if (SIG_ERR == signal (SIGHUP, sh_status))
+    {
+      perror ("signal (SIGHUP)");
+      exit (1);
+    }
+
+  printf ("findlc: version: %s\n", rcsid[1]);
+  m2exp = atol (argv[0]);
+  mpz_init_set_ui (m, 1);
+  mpz_mul_2exp (m, m, m2exp);
+  printf ("m = 0x");
+  mpz_out_str (stdout, 16, m);
+  puts ("");
+
+  if (argc > 1)			/* have low_merit */
+    mpf_set_str (low_merit, argv[1], 0);
+  if (argc > 2)			/* have high_merit */
+    mpf_set_str (high_merit, argv[2], 0);
+
+  if (debug)
+    {
+      fprintf (stderr, "low_merit = ");
+      mpf_out_str (stderr, 10, 2, low_merit);
+      fprintf (stderr, "; high_merit = ");
+      mpf_out_str (stderr, 10, 2, high_merit);
+      fputs ("\n", stderr);
+    }
+
+  mpz_init (minus8);
+  mpz_set_si (minus8, -8L);
+  mpz_init_set_ui (acc, 0);
+  mpz_init (s);
+  mpz_init_set_d (min, 0.01 * pow (2.0, (double) m2exp));
+  mpz_init_set_d (max, 0.99 * pow (2.0, (double) m2exp));
+
+  mpz_true_random (s, m2exp);	/* Start.  */
+  mpz_setbit (s, 0);		/* Make it odd.  */
+
+  v_best = m_best = 2*(DIMS-1);
+  for (;;) 
+    {
+      mpz_add (acc, acc, s);
+      mpz_mod_2exp (acc, acc, m2exp);
+#if later
+      mpz_and_si (a, acc, -8L);
+#else
+      mpz_and (a, acc, minus8);
+#endif
+      mpz_add_ui (a, a, 5);
+      if (mpz_cmp (a, min) <= 0 || mpz_cmp (a, max) >= 0)
+	continue;
+
+      spectral_test (v, DIMS, a, m);
+      for (f = 0, v_lose = m_lose = 0, cnt_high_merit = DIMS-1;
+	   f < DIMS-1; f++)
+	{
+	  merit (f_merit, f + 2, v[f], m);
+
+	  if (mpf_cmp_ui (v[f], 1 << (30 / (f + 2) + (f == 2))) < 0)
+	    v_lose++;
+	    
+	  if (mpf_cmp (f_merit, low_merit) < 0)
+	    m_lose++;
+
+	  if (mpf_cmp (f_merit, high_merit) >= 0)
+	    cnt_high_merit--;
+	}
+
+      if (0 == v_lose && 0 == m_lose)
+	{
+	  mpz_out_str (stdout, 10, a); puts (""); fflush (stdout);
+	  if (0 == cnt_high_merit)
+	    break;		/* leave loop */
+	}
+      if (v_lose < v_best)
+	{
+	  v_best = v_lose;
+	  printf ("best (v_lose=%d; m_lose=%d): ", v_lose, m_lose);
+	  mpz_out_str (stdout, 10, a); puts (""); fflush (stdout);
+	}
+      if (m_lose < m_best)
+	{
+	  m_best = m_lose;
+	  printf ("best (v_lose=%d; m_lose=%d): ", v_lose, m_lose);
+	  mpz_out_str (stdout, 10, a); puts (""); fflush (stdout);
+	}
+    }
+
+  mpz_clear (m);
+  mpz_clear (a);
+  for (f = 0; f < DIMS-1; f++)
+    mpf_clear (v[f]);
+  mpf_clear (f_merit);
+  mpf_clear (low_merit);
+  mpf_clear (high_merit);
+
+  printf ("done.\n");
+  return 0;
+}
diff --git a/src/gmp/tests/rand/gen.c b/src/gmp/tests/rand/gen.c
new file mode 100644
index 000000000..47b18b7e5
--- /dev/null
+++ b/src/gmp/tests/rand/gen.c
@@ -0,0 +1,485 @@
+/* gen.c -- Generate pseudorandom numbers. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+/* Examples:
+
+  $ gen 10 
+10 integers 0 <= X < 2^32 generated by mpz_urandomb()
+
+  $ gen -f mpf_urandomb 10
+10 real numbers 0 <= X < 1
+
+  $ gen -z 127 10
+10 integers 0 <= X < 2^127
+
+  $ gen -f mpf_urandomb -x .9,1 10
+10 real numbers 0 <= X < .9
+
+  $ gen -s 1 10
+10 integers, sequence seeded with 1
+  
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <limits.h>
+#include <errno.h>
+#include <time.h>
+#include <string.h>
+
+#if !HAVE_DECL_OPTARG
+extern char *optarg;
+extern int optind, opterr;
+#endif
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+int main (argc, argv)
+     int argc;
+     char *argv[];
+{
+  const char usage[] =
+    "usage: gen [-bhpq] [-a n] [-c a,c,m2exp] [-C a,c,m] [-f func] [-g alg] [-m n] [-s n] " \
+    "[-x f,t] [-z n] [n]\n" \
+    "  n        number of random numbers to generate\n" \
+    "  -a n     ASCII output in radix n (default, with n=10)\n" \
+    "  -b       binary output\n" \
+    "  -c a,c,m2exp use supplied LC scheme\n" \
+    "  -C a,c,m     use supplied LC scheme\n" \
+    "  -f func  random function, one of\n" \
+    "           mpz_urandomb (default), mpz_urandomm, mpf_urandomb, rand, random\n" \
+    "  -g alg   algorithm, one of lc (default), bbs\n" \
+    "  -h       print this text and exit\n" \
+    "  -m n     maximum size of generated number plus 1 (0<= X < n) for mpz_urandomm\n" \
+    "  -p       print used seed on stderr\n" \
+    "  -q	quiet, no output\n" \
+    "  -s n     initial seed (default: output from time(3))\n" \
+    "  -x f,t   exclude all numbers f <= x <= t\n" \
+    "  -z n     size in bits of generated numbers (0<= X <2^n) (default 32)\n" \
+    "";
+
+  unsigned long int f;
+  unsigned long int n = 0;
+  unsigned long int seed;
+  unsigned long int m2exp = 0;
+  unsigned int size = 32;
+  int seed_from_user = 0;
+  int ascout = 1, binout = 0, printseed = 0;
+  int output_radix = 10;
+  int lc_scheme_from_user = 0;
+  int quiet_flag = 0;
+  mpz_t z_seed;
+  mpz_t z1;
+  mpf_t f1;
+  gmp_randstate_t rstate;
+  int c, i;
+  double drand;
+  long lrand;
+  int do_exclude = 0;
+  mpf_t f_xf, f_xt;		/* numbers to exclude from sequence */
+  char *str_xf, *str_xt;	/* numbers to exclude from sequence */
+  char *str_a, *str_adder, *str_m;
+  mpz_t z_a, z_m, z_mmax;
+  unsigned long int ul_adder;
+  
+  enum 
+  {
+    RFUNC_mpz_urandomb = 0,
+    RFUNC_mpz_urandomm,
+    RFUNC_mpf_urandomb,
+    RFUNC_rand,
+    RFUNC_random,
+  } rfunc = RFUNC_mpz_urandomb;
+  char *rfunc_str[] =  { "mpz_urandomb", "mpz_urandomm", "mpf_urandomb",
+			 "rand", "random" };
+  gmp_randalg_t ralg = GMP_RAND_ALG_DEFAULT;
+  char *ralg_str[] = { "lc", "bbs" };
+
+  mpf_init (f_xf);
+  mpf_init (f_xt);
+  mpf_init (f1);
+  mpz_init (z1);
+  mpz_init (z_seed);
+  mpz_init_set_ui (z_mmax, 0);
+
+
+  while ((c = getopt (argc, argv, "a:bc:C:f:g:hm:n:pqs:z:x:")) != -1)
+    switch (c)
+      {
+      case 'a':
+	ascout = 1;
+	binout = 0;
+	output_radix = atoi (optarg);
+	break;
+
+      case 'b':
+	ascout = 0;
+	binout = 1;
+	break;
+
+      case 'c':			/* User supplied LC scheme: a,c,m2exp */
+      case 'C':			/* User supplied LC scheme: a,c,m */
+	if (NULL == (str_a = strtok (optarg, ","))
+	    || NULL == (str_adder = strtok (NULL, ","))
+	    || NULL == (str_m = strtok (NULL, ",")))
+	  {
+	    fprintf (stderr, "gen: bad LC scheme parameters: %s\n", optarg);
+	    exit (1);
+	  }
+#ifdef HAVE_STRTOUL
+	ul_adder = strtoul (str_adder, NULL, 0);
+#elif HAVE_STRTOL
+	ul_adder = (unsigned long int) strtol (str_adder, NULL, 0);
+#else
+	ul_adder = (unsigned long int) atoi (str_adder);
+#endif
+	
+	if (mpz_init_set_str (z_a, str_a, 0))
+	  {
+	    fprintf (stderr, "gen: bad LC scheme parameter `a': %s\n", str_a);
+	    exit (1);
+	  }
+	if (ULONG_MAX == ul_adder)
+	  {
+	    fprintf (stderr, "gen: bad LC scheme parameter `c': %s\n",
+		     str_adder);
+	    exit (1);
+	  }
+	if (c == 'c')
+	  m2exp = atol (str_m);
+	else
+	  mpz_init_set_str (z_m, str_m, 0);
+
+	lc_scheme_from_user = 1;
+	break;
+
+
+      case 'f':
+	rfunc = -1;
+	for (f = 0; f < sizeof (rfunc_str) / sizeof (*rfunc_str); f++)
+	    if (!strcmp (optarg, rfunc_str[f]))
+	      {
+		rfunc = f;
+		break;
+	      }
+	if (rfunc == -1)
+	  {
+	    fputs (usage, stderr);
+	    exit (1);
+	  }
+	break;
+
+      case 'g':			/* algorithm */
+	ralg = -1;
+	for (f = 0; f < sizeof (ralg_str) / sizeof (*ralg_str); f++)
+	    if (!strcmp (optarg, ralg_str[f]))
+	      {
+		ralg = f;
+		break;
+	      }
+	if (ralg == -1)
+	  {
+	    fputs (usage, stderr);
+	    exit (1);
+	  }
+	break;
+
+      case 'm':			/* max for mpz_urandomm() */
+	if (mpz_set_str (z_mmax, optarg, 0))
+	  {
+	    fprintf (stderr, "gen: bad max value: %s\n", optarg);
+	    exit (1);
+	  }
+	break;
+
+      case 'p':			/* print seed on stderr */
+	printseed = 1;
+	break;
+
+      case 'q':			/* quiet */
+	quiet_flag = 1;
+	break;
+
+      case 's':			/* user provided seed */
+	if (mpz_set_str (z_seed, optarg, 0))
+	  {
+	    fprintf (stderr, "gen: bad seed argument %s\n", optarg);
+	    exit (1);
+	  }
+	seed_from_user = 1;
+	break;
+
+      case 'z':
+	size = atoi (optarg);
+	if (size < 1)
+	  {
+	    fprintf (stderr, "gen: bad size argument (-z %u)\n", size);
+	    exit (1);
+	  }
+	break;
+
+      case 'x':			/* Exclude. from,to */
+	str_xf = optarg;
+	str_xt = strchr (optarg, ',');
+	if (NULL == str_xt)
+	  {
+	    fprintf (stderr, "gen: bad exclusion parameters: %s\n", optarg);
+	    exit (1);
+	  }
+	*str_xt++ = '\0';
+	do_exclude = 1;
+	break;
+
+      case 'h':
+      case '?':
+      default:
+	fputs (usage, stderr);
+	exit (1);
+      }
+  argc -= optind;
+  argv += optind;
+
+  if (! seed_from_user)
+    mpz_set_ui (z_seed, (unsigned long int) time (NULL));
+  seed = mpz_get_ui (z_seed);
+  if (printseed)
+    {
+      fprintf (stderr, "gen: seed used: ");
+      mpz_out_str (stderr, output_radix, z_seed);
+      fprintf (stderr, "\n");
+    }
+
+  mpf_set_prec (f1, size);
+  
+  /* init random state and plant seed */
+  switch (rfunc)
+    {
+    case RFUNC_mpf_urandomb:
+#if 0
+      /* Don't init a too small generator.  */
+      size = PREC (f1) * BITS_PER_MP_LIMB;
+      /* Fall through.  */
+#endif
+    case RFUNC_mpz_urandomb:
+    case RFUNC_mpz_urandomm:
+      if (! lc_scheme_from_user)
+	{
+	  gmp_randinit (rstate, ralg, MIN (128, size));
+	}
+      else
+	{
+	  if (m2exp != 0)
+	    gmp_randinit_lc_2exp (rstate, z_a, ul_adder, m2exp);
+	  else
+	    gmp_randinit_lc (rstate, z_a, ul_adder, z_m);
+	}
+      
+      if (gmp_errno != GMP_ERROR_NONE)
+	{
+	  if (gmp_errno & GMP_ERROR_INVALID_ARGUMENT)
+	    fprintf (stderr, "gen: asking for too big random state\n");
+	  if (gmp_errno & GMP_ERROR_UNSUPPORTED_ARGUMENT)
+	    fprintf (stderr, "gen: unsupported algorithm\n");
+	  exit (1);
+	}
+      gmp_randseed (rstate, z_seed);
+      break;
+
+    case RFUNC_rand:
+      srand (seed);
+      break;
+
+    case RFUNC_random:
+#ifdef __FreeBSD__		/* FIXME */
+      if (seed_from_user)
+	srandom (seed);
+      else
+	srandomdev ();
+#else
+      fprintf (stderr, "gen: unsupported algorithm\n");
+#endif      
+      break;
+
+    default:
+      fprintf (stderr, "gen: random function not implemented\n");
+      exit (1);
+    }
+
+  /* set up excludes */
+  if (do_exclude)
+    switch (rfunc)
+      {
+      case RFUNC_mpf_urandomb:
+      
+	if (mpf_set_str (f_xf, str_xf, 10) ||
+	    mpf_set_str (f_xt, str_xt, 10))
+	  {
+	    fprintf (stderr, "gen: bad exclusion-from (\"%s\") " \
+		     "or exclusion-to (\"%s\") string.  no exclusion done.\n",
+		     str_xf, str_xt);
+	    do_exclude = 0;
+	  }
+	break;
+
+      default:
+	fprintf (stderr, "gen: exclusion not implemented for chosen " \
+		 "randomization function.  all numbers included in sequence.\n");
+      }
+  
+  /* generate and print */
+  if (argc > 0)
+    {
+#if HAVE_STRTOUL
+      n = strtoul (argv[0], (char **) NULL, 10);
+#elif HAVE_STRTOL
+      n = (unsigned long int) strtol (argv[0], (char **) NULL, 10);
+#else
+      n = (unsigned long int) atoi (argv[0]);
+#endif
+    }
+
+  for (f = 0; n == 0 || f < n; f++)
+    {
+      switch (rfunc)
+	{
+	case RFUNC_mpz_urandomb:
+	  mpz_urandomb (z1, rstate, size);
+	  if (quiet_flag)
+	    break;
+	  if (binout)
+	    {
+	      /*fwrite ((unsigned int *) z1->_mp_d, 4, 1, stdout);*/
+	      fprintf (stderr, "gen: binary output for mpz_urandom* is broken\n");
+	      exit (1);
+	    }
+	  else
+	    {
+	      mpz_out_str (stdout, output_radix, z1);
+	      puts ("");
+	    }
+	  break;
+
+	case RFUNC_mpz_urandomm:
+	  mpz_urandomm (z1, rstate, z_mmax);
+	  if (quiet_flag)
+	    break;
+	  if (binout)
+	    {
+	      /*fwrite ((unsigned int *) z1->_mp_d, 4, 1, stdout);*/
+	      fprintf (stderr, "gen: binary output for mpz_urandom* is broken\n");
+	      exit (1);
+	    }
+	  else
+	    {
+	      mpz_out_str (stdout, output_radix, z1);
+	      puts ("");
+	    }
+	  break;
+
+	case RFUNC_mpf_urandomb:
+	  mpf_urandomb (f1, rstate, size);
+	  if (do_exclude)
+	    if (mpf_cmp (f1, f_xf) >= 0 && mpf_cmp (f1, f_xt) <= 0)
+		break;
+	  if (quiet_flag)
+	    break;
+	  if (binout)
+	    {
+	      fprintf (stderr, "gen: binary output for floating point numbers "\
+		       "not implemented\n");
+	      exit (1);
+	    }
+	  else
+	    {
+	      mpf_out_str (stdout, output_radix, 0, f1);
+	      puts ("");
+	    }
+	  break;
+
+	case RFUNC_rand:
+	  i = rand ();
+#ifdef FLOAT_OUTPUT
+	  if (i)
+	    drand = (double) i / (double) RAND_MAX;
+	  else
+	    drand = 0.0;
+	  if (quiet_flag)
+	    break;
+	  if (binout)
+	    fwrite (&drand, sizeof (drand), 1, stdout);
+	  else
+	    printf ("%e\n", drand);
+#else
+	  if (quiet_flag)
+	    break;
+	  if (binout)
+	    fwrite (&i, sizeof (i), 1, stdout);
+	  else
+	    printf ("%d\n", i);
+#endif
+	  break;
+
+	case RFUNC_random:
+	  lrand = random ();
+	  if (lrand)
+	    drand = (double) lrand / (double) 0x7fffffff;
+	  else
+	    drand = 0;
+	  if (quiet_flag)
+	    break;
+	  if (binout)
+	    fwrite (&drand, sizeof (drand), 1, stdout);
+	  else
+	    printf ("%e\n", drand);
+	  break;
+
+	default:
+	  fprintf (stderr, "gen: random function not implemented\n");
+	  exit (1);
+	}
+      
+    }
+
+  /* clean up */
+  switch (rfunc)
+    {
+    case RFUNC_mpz_urandomb:
+    case RFUNC_mpf_urandomb:
+      gmp_randclear (rstate);
+      break;
+    default:
+      break;
+    }
+  mpf_clear (f1);
+  mpf_clear (f_xf); 
+  mpf_clear (f_xt);
+  mpz_clear (z1);
+  mpz_clear (z_seed);
+
+  return 0;
+}
+
+static void *debug_dummyz = mpz_dump;
+static void *debug_dummyf = mpf_dump;
diff --git a/src/gmp/tests/rand/gmpstat.h b/src/gmp/tests/rand/gmpstat.h
new file mode 100644
index 000000000..ab0fd800a
--- /dev/null
+++ b/src/gmp/tests/rand/gmpstat.h
@@ -0,0 +1,78 @@
+/* gmpstat.h */
+
+/*
+Copyright (C) 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+/* This file requires the following header files: gmp.h */
+
+#ifndef	__GMPSTAT_H__
+#define	__GMPSTAT_H__
+
+/* Global debug flag.  FIXME: Remove. */
+extern int g_debug;
+#define DEBUG_1 0
+#define DEBUG_2 1
+
+/* Max number of dimensions in spectral test.  FIXME: Makw dynamic. */
+#define GMP_SPECT_MAXT 10
+
+void
+mpf_freqt (mpf_t Kp,
+	   mpf_t Km,
+	   mpf_t X[],
+	   const unsigned long int n);
+unsigned long int
+mpz_freqt (mpf_t V,
+	   mpz_t X[],
+	   unsigned int imax,
+	   const unsigned long int n);
+
+/* Low level functions. */
+void
+ks (mpf_t Kp,
+    mpf_t Km,
+    mpf_t X[],
+    void (P) (mpf_t, mpf_t),
+    const unsigned long int n);
+
+void
+ks_table (mpf_t p, mpf_t val, const unsigned int n);
+
+void
+x2_table (double t[],
+	  unsigned int v);
+
+void
+spectral_test (mpf_t rop[], unsigned int T, mpz_t a, mpz_t m);
+void
+vz_dot (mpz_t rop, mpz_t V1[], mpz_t V2[], unsigned int n);
+void
+f_floor (mpf_t rop, mpf_t op);
+
+void
+merit (mpf_t rop, unsigned int t, mpf_t v, mpz_t m);
+double
+merit_u (unsigned int t, mpf_t v, mpz_t m);
+
+/* From separate source files: */
+void zdiv_round (mpz_t rop, mpz_t n, mpz_t d);
+
+#endif /* !__GMPSTAT_H__ */
diff --git a/src/gmp/tests/rand/spect.c b/src/gmp/tests/rand/spect.c
new file mode 100644
index 000000000..6a6592abc
--- /dev/null
+++ b/src/gmp/tests/rand/spect.c
@@ -0,0 +1,140 @@
+/* spect.c -- the spectral test */
+
+/*
+Copyright (C) 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+/* T is upper dimension.  Z_A is the LC multiplier, which is
+   relatively prime to Z_M, the LC modulus.  The result is put in
+   rop[] with v[t] in rop[t-2]. */
+
+/* BUGS: Due to lazy allocation scheme, maximum T is hard coded to MAXT. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <math.h>
+#include "gmp.h"
+
+#include "gmpstat.h"
+
+int g_debug = 0;
+
+int
+main (int argc, char *argv[])
+{
+  const char usage[] = "usage: spect [-d] a m n\n";
+  int c;
+  unsigned int n;
+  mpz_t a, m;
+  mpf_t res[GMP_SPECT_MAXT], res_min[GMP_SPECT_MAXT], f_tmp;
+  register int f;
+
+
+  mpz_init (a);
+  mpz_init (m);
+  for (f = 0; f < GMP_SPECT_MAXT; f++)
+    {
+      mpf_init (res[f]);
+      mpf_init (res_min[f]);
+    }
+  mpf_init (f_tmp);
+  mpf_set_ui (res_min[0], 32768); /* 2^15 */
+  mpf_set_ui (res_min[1], 1024); /* 2^10 */
+  mpf_set_ui (res_min[2], 256); /* 2^8 */
+  mpf_set_ui (res_min[3], 64); /* 2^6 */
+  mpf_set_ui (res_min[4], 32); /* 2^5 */
+
+  while ((c = getopt (argc, argv, "dh")) != -1)
+    switch (c)
+      {
+      case 'd':			/* debug */
+	g_debug++;
+	break;
+      case 'h':
+      default:
+	fputs (usage, stderr);
+	exit (1);
+      }
+  argc -= optind;
+  argv += optind;
+
+  if (argc < 3)
+    {
+      fputs (usage, stderr);
+      exit (1);
+    }
+
+  mpz_set_str (a, argv[0], 0);
+  mpz_set_str (m, argv[1], 0);
+  n = (unsigned int) atoi (argv[2]);
+  if (n + 1 > GMP_SPECT_MAXT)
+    n = GMP_SPECT_MAXT + 1;
+
+  spectral_test (res, n, a, m);
+
+  for (f = 0; f < n - 1; f++)
+    {
+      /* print v */
+      printf ("%d: v = ", f + 2);
+      mpf_out_str (stdout, 10, 4, res[f]);
+
+#ifdef PRINT_RAISED_BY_TWO_AS_WELL
+      printf (" (^2 = ");
+      mpf_mul (f_tmp, res[f], res[f]);
+      mpf_out_str (stdout, 10, 4, f_tmp);
+      printf (")");
+#endif /* PRINT_RAISED_BY_TWO_AS_WELL */
+
+      /* print merit */
+      printf (" m = ");
+      merit (f_tmp, f + 2, res[f], m);
+      mpf_out_str (stdout, 10, 4, f_tmp);
+
+      if (mpf_cmp (res[f], res_min[f]) < 0)
+	printf ("\t*** v too low ***");
+      if (mpf_get_d (f_tmp) < .1)
+	printf ("\t*** merit too low ***");
+
+      puts ("");
+    }
+
+  mpz_clear (a);
+  mpz_clear (m);
+  for (f = 0; f < GMP_SPECT_MAXT; f++)
+    {
+      mpf_clear (res[f]);
+      mpf_clear (res_min[f]);
+    }
+  mpf_clear (f_tmp);
+
+  return 0;
+}
+
+
+void 
+debug_foo()
+{
+  if (0)
+    {
+      mpz_dump (0);
+      mpf_dump (0);
+    }
+}
diff --git a/src/gmp/tests/rand/stat.c b/src/gmp/tests/rand/stat.c
new file mode 100644
index 000000000..bda1a4431
--- /dev/null
+++ b/src/gmp/tests/rand/stat.c
@@ -0,0 +1,415 @@
+/* stat.c -- statistical tests of random number sequences. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+/* Examples:
+
+  $ gen 1000 | stat
+Test 1000 real numbers.
+
+  $ gen 30000 | stat -2 1000
+Test 1000 real numbers 30 times and then test the 30 results in a 
+``second level''.
+
+  $ gen -f mpz_urandomb 1000 | stat -i 0xffffffff
+Test 1000 integers 0 <= X <= 2^32-1.
+
+  $ gen -f mpz_urandomb -z 34 1000 | stat -i 0x3ffffffff
+Test 1000 integers 0 <= X <= 2^34-1.
+
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <math.h>
+#include "gmp.h"
+#include "gmpstat.h"
+
+#if !HAVE_DECL_OPTARG
+extern char *optarg;
+extern int optind, opterr;
+#endif
+
+#define FVECSIZ (100000L)
+
+int g_debug = 0;
+
+static void
+print_ks_results (mpf_t f_p, mpf_t f_p_prob,
+		  mpf_t f_m, mpf_t f_m_prob,
+		  FILE *fp)
+{
+  double p, pp, m, mp;
+
+  p = mpf_get_d (f_p);
+  m = mpf_get_d (f_m);
+  pp = mpf_get_d (f_p_prob);
+  mp = mpf_get_d (f_m_prob);
+  
+  fprintf (fp, "%.4f (%.0f%%)\t", p, pp * 100.0);
+  fprintf (fp, "%.4f (%.0f%%)\n", m, mp * 100.0);
+}
+
+static void
+print_x2_table (unsigned int v, FILE *fp)
+{
+  double t[7];
+  int f;
+
+
+  fprintf (fp, "Chi-square table for v=%u\n", v);
+  fprintf (fp, "1%%\t5%%\t25%%\t50%%\t75%%\t95%%\t99%%\n");
+  x2_table (t, v);
+  for (f = 0; f < 7; f++)
+    fprintf (fp, "%.2f\t", t[f]);
+  fputs ("\n", fp);
+}
+
+
+
+/* Pks () -- Distribution function for KS results with a big n (like 1000
+   or so):  F(x) = 1 - pow(e, -2*x^2) [Knuth, vol 2, p.51]. */
+/* gnuplot: plot [0:1] Pks(x), Pks(x) = 1-exp(-2*x**2)  */
+
+static void
+Pks (mpf_t p, mpf_t x)
+{
+  double dt;			/* temp double */
+
+  mpf_set (p, x);
+  mpf_mul (p, p, p);		/* p = x^2 */
+  mpf_mul_ui (p, p, 2);		/* p = 2*x^2 */
+  mpf_neg (p, p);		/* p = -2*x^2 */
+  /* No pow() in gmp.  Use doubles. */
+  /* FIXME: Use exp()? */
+  dt = pow (M_E, mpf_get_d (p));
+  mpf_set_d (p, dt);
+  mpf_ui_sub (p, 1, p);
+}
+
+/* f_freq() -- frequency test on real numbers 0<=f<1*/
+static void
+f_freq (const unsigned l1runs, const unsigned l2runs,
+	mpf_t fvec[], const unsigned long n)
+{
+  unsigned f;
+  mpf_t f_p, f_p_prob;
+  mpf_t f_m, f_m_prob;
+  mpf_t *l1res;			/* level 1 result array */
+
+  mpf_init (f_p);  mpf_init (f_m);
+  mpf_init (f_p_prob);  mpf_init (f_m_prob);
+
+  
+  /* Allocate space for 1st level results. */
+  l1res = (mpf_t *) malloc (l2runs * 2 * sizeof (mpf_t));
+  if (NULL == l1res)
+    {
+      fprintf (stderr, "stat: malloc failure\n");
+      exit (1);
+    }
+  
+  printf ("\nEquidistribution/Frequency test on real numbers (0<=X<1):\n");
+  printf ("\tKp\t\tKm\n");
+
+  for (f = 0; f < l2runs; f++)
+    {
+      /*  f_printvec (fvec, n); */
+      mpf_freqt (f_p, f_m, fvec + f * n, n);
+
+      /* what's the probability of getting these results? */
+      ks_table (f_p_prob, f_p, n);
+      ks_table (f_m_prob, f_m, n);
+
+      if (l1runs == 0)
+	{
+	  /*printf ("%u:\t", f + 1);*/
+	  print_ks_results (f_p, f_p_prob, f_m, f_m_prob, stdout);
+	}
+      else
+	{
+	  /* save result */
+	  mpf_init_set (l1res[f], f_p);
+	  mpf_init_set (l1res[f + l2runs], f_m);
+	}
+    }
+
+  /* Now, apply the KS test on the results from the 1st level rounds
+     with the distribution
+     F(x) = 1 - pow(e, -2*x^2)	[Knuth, vol 2, p.51] */
+
+  if (l1runs != 0)
+    {
+      /*printf ("-------------------------------------\n");*/
+
+      /* The Kp's. */
+      ks (f_p, f_m, l1res, Pks, l2runs);
+      ks_table (f_p_prob, f_p, l2runs);
+      ks_table (f_m_prob, f_m, l2runs);
+      printf ("Kp:\t");
+      print_ks_results (f_p, f_p_prob, f_m, f_m_prob, stdout);
+
+      /* The Km's. */
+      ks (f_p, f_m, l1res + l2runs, Pks, l2runs);
+      ks_table (f_p_prob, f_p, l2runs);
+      ks_table (f_m_prob, f_m, l2runs);
+      printf ("Km:\t");
+      print_ks_results (f_p, f_p_prob, f_m, f_m_prob, stdout);
+    }
+
+  mpf_clear (f_p);  mpf_clear (f_m);
+  mpf_clear (f_p_prob);  mpf_clear (f_m_prob);
+  free (l1res);
+}  
+
+/* z_freq(l1runs, l2runs, zvec, n, max) -- frequency test on integers
+   0<=z<=MAX */
+static void
+z_freq (const unsigned l1runs,
+	const unsigned l2runs,
+	mpz_t zvec[],
+	const unsigned long n,
+	unsigned int max)
+{
+  mpf_t V;			/* result */
+  double d_V;			/* result as a double */
+
+  mpf_init (V);
+
+
+  printf ("\nEquidistribution/Frequency test on integers (0<=X<=%u):\n", max);
+  print_x2_table (max, stdout);
+
+  mpz_freqt (V, zvec, max, n);
+
+  d_V = mpf_get_d (V);
+  printf ("V = %.2f (n = %lu)\n", d_V, n);
+  
+  mpf_clear (V);
+}
+
+unsigned int stat_debug = 0;
+
+int 
+main (argc, argv)
+     int argc;
+     char *argv[];
+{
+  const char usage[] =
+    "usage: stat [-d] [-2 runs] [-i max | -r max] [file]\n" \
+    "       file     filename\n" \
+    "       -2 runs  perform 2-level test with RUNS runs on 1st level\n" \
+    "       -d       increase debugging level\n" \
+    "       -i max   input is integers 0 <= Z <= MAX\n" \
+    "       -r max   input is real numbers 0 <= R < 1 and use MAX as\n" \
+    "                maximum value when converting real numbers to integers\n" \
+    "";
+  
+  mpf_t fvec[FVECSIZ];
+  mpz_t zvec[FVECSIZ];
+  unsigned long int f, n, vecentries;
+  char *filen;
+  FILE *fp;
+  int c;
+  int omitoutput = 0;
+  int realinput = -1;		/* 1: input is real numbers 0<=R<1;
+				   0: input is integers 0 <= Z <= MAX. */
+  long l1runs = 0,		/* 1st level runs */
+    l2runs = 1;			/* 2nd level runs */
+  mpf_t f_temp;
+  mpz_t z_imax;			/* max value when converting between
+                                   real number and integer. */
+  mpf_t f_imax_plus1;		/* f_imax + 1 stored in an mpf_t for
+                                   convenience */
+  mpf_t f_imax_minus1;		/* f_imax - 1 stored in an mpf_t for
+                                   convenience */
+
+
+  mpf_init (f_temp);
+  mpz_init_set_ui (z_imax, 0x7fffffff);
+  mpf_init (f_imax_plus1);
+  mpf_init (f_imax_minus1);
+
+  while ((c = getopt (argc, argv, "d2:i:r:")) != -1)
+    switch (c)
+      {
+      case '2':
+	l1runs = atol (optarg);
+	l2runs = -1;		/* set later on */
+	break;
+      case 'd':			/* increase debug level */
+	stat_debug++;
+	break;
+      case 'i':
+	if (1 == realinput)
+	  {
+	    fputs ("stat: options -i and -r are mutually exclusive\n", stderr);
+	    exit (1);
+	  }
+	if (mpz_set_str (z_imax, optarg, 0))
+	  {
+	    fprintf (stderr, "stat: bad max value %s\n", optarg);
+	    exit (1);
+	  }
+	realinput = 0;
+	break;
+      case 'r':
+	if (0 == realinput)
+	  {
+	    fputs ("stat: options -i and -r are mutually exclusive\n", stderr);
+	    exit (1);
+	  }
+	if (mpz_set_str (z_imax, optarg, 0))
+	  {
+	    fprintf (stderr, "stat: bad max value %s\n", optarg);
+	    exit (1);
+	  }
+	realinput = 1;
+	break;
+      case 'o':
+	omitoutput = atoi (optarg);
+	break;
+      case '?':
+      default:
+	fputs (usage, stderr);
+	exit (1);
+      }
+  argc -= optind;
+  argv += optind;
+
+  if (argc < 1)
+    fp = stdin;
+  else
+    filen = argv[0]; 
+
+  if (fp != stdin)
+    if (NULL == (fp = fopen (filen, "r")))
+      {
+	perror (filen);
+	exit (1);
+      }
+
+  if (-1 == realinput)
+    realinput = 1;		/* default is real numbers */
+
+  /* read file and fill appropriate vec */
+  if (1 == realinput)		/* real input */
+    {
+      for (f = 0; f < FVECSIZ ; f++)
+	{
+	  mpf_init (fvec[f]);
+	  if (!mpf_inp_str (fvec[f], fp, 10))
+	    break;
+	}
+    }
+  else				/* integer input */
+    {
+      for (f = 0; f < FVECSIZ ; f++)
+	{
+	  mpz_init (zvec[f]);
+	  if (!mpz_inp_str (zvec[f], fp, 10))
+	    break;
+	}
+    }    
+  vecentries = n = f;		/* number of entries read */
+  fclose (fp);
+
+  if (FVECSIZ == f)
+    fprintf (stderr, "stat: warning: discarding input due to lazy allocation "\
+	     "of only %ld entries.  sorry.\n", FVECSIZ);
+
+  printf ("Got %lu numbers.\n", n);
+
+  /* convert and fill the other vec */
+  /* since fvec[] contains 0<=f<1 and we want ivec[] to contain
+     0<=z<=imax and we are truncating all fractions when
+     converting float to int, we have to add 1 to imax.*/
+  mpf_set_z (f_imax_plus1, z_imax);
+  mpf_add_ui (f_imax_plus1, f_imax_plus1, 1);
+  if (1 == realinput)		/* fill zvec[] */
+    {
+      for (f = 0; f < n; f++)
+	{
+	  mpf_mul (f_temp, fvec[f], f_imax_plus1);
+	  mpz_init (zvec[f]);
+	  mpz_set_f (zvec[f], f_temp); /* truncating fraction */
+	  if (stat_debug > 1)
+	    {
+	      mpz_out_str (stderr, 10, zvec[f]);
+	      fputs ("\n", stderr);
+	    }
+	}
+    }
+  else				/* integer input; fill fvec[] */
+    {
+      /*    mpf_set_z (f_imax_minus1, z_imax); 
+	    mpf_sub_ui (f_imax_minus1, f_imax_minus1, 1);*/
+      for (f = 0; f < n; f++)
+	{
+	  mpf_init (fvec[f]);
+	  mpf_set_z (fvec[f], zvec[f]);
+	  mpf_div (fvec[f], fvec[f], f_imax_plus1);
+	  if (stat_debug > 1)
+	    {
+	      mpf_out_str (stderr, 10, 0, fvec[f]);
+	      fputs ("\n", stderr);
+	    }
+	}
+    }
+  
+  /* 2 levels? */
+  if (1 != l2runs)
+    {
+      l2runs = n / l1runs;
+      printf ("Doing %ld second level rounds "\
+	      "with %ld entries in each round", l2runs, l1runs);
+      if (n % l1runs)
+	printf (" (discarding %ld entr%s)", n % l1runs,
+		n % l1runs == 1 ? "y" : "ies");
+      puts (".");
+      n = l1runs;
+    }
+
+#ifndef DONT_FFREQ
+  f_freq (l1runs, l2runs, fvec, n);
+#endif
+#ifdef DO_ZFREQ
+  z_freq (l1runs, l2runs, zvec, n, mpz_get_ui (z_imax));
+#endif
+
+  mpf_clear (f_temp); mpz_clear (z_imax); 
+  mpf_clear (f_imax_plus1);
+  mpf_clear (f_imax_minus1);
+  for (f = 0; f < vecentries; f++)
+    {
+      mpf_clear (fvec[f]);
+      mpz_clear (zvec[f]);
+    }
+
+  return 0;
+}
+
+
+
+
+
diff --git a/src/gmp/tests/rand/statlib.c b/src/gmp/tests/rand/statlib.c
new file mode 100644
index 000000000..b1088c81b
--- /dev/null
+++ b/src/gmp/tests/rand/statlib.c
@@ -0,0 +1,841 @@
+/* statlib.c -- Statistical functions for testing the randomness of
+   number sequences. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+/* The theories for these functions are taken from D. Knuth's "The Art
+of Computer Programming: Volume 2, Seminumerical Algorithms", Third
+Edition, Addison Wesley, 1998. */
+
+/* Implementation notes.
+
+The Kolmogorov-Smirnov test.
+
+Eq. (13) in Knuth, p. 50, says that if X1, X2, ..., Xn are independent
+observations arranged into ascending order
+
+	Kp = sqr(n) * max(j/n - F(Xj))		for all 1<=j<=n
+	Km = sqr(n) * max(F(Xj) - (j-1)/n))	for all 1<=j<=n
+
+where F(x) = Pr(X <= x) = probability that (X <= x), which for a
+uniformly distributed random real number between zero and one is
+exactly the number itself (x).
+
+
+The answer to exercise 23 gives the following implementation, which
+doesn't need the observations to be sorted in ascending order:
+
+for (k = 0; k < m; k++)
+	a[k] = 1.0
+	b[k] = 0.0
+	c[k] = 0
+
+for (each observation Xj)
+	Y = F(Xj)
+	k = floor (m * Y)
+	a[k] = min (a[k], Y)
+	b[k] = max (b[k], Y)
+	c[k] += 1
+
+	j = 0
+	rp = rm = 0
+	for (k = 0; k < m; k++)
+		if (c[k] > 0)
+			rm = max (rm, a[k] - j/n)
+			j += c[k]
+			rp = max (rp, j/n - b[k])
+			
+Kp = sqr (n) * rp
+Km = sqr (n) * rm 
+
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+#include "gmp.h"
+#include "gmpstat.h"
+
+/* ks (Kp, Km, X, P, n) -- Perform a Kolmogorov-Smirnov test on the N
+   real numbers between zero and one in vector X.  P is the
+   distribution function, called for each entry in X, which should
+   calculate the probability of X being greater than or equal to any
+   number in the sequence.  (For a uniformly distributed sequence of
+   real numbers between zero and one, this is simply equal to X.)  The
+   result is put in Kp and Km.  */
+
+void
+ks (mpf_t Kp,
+    mpf_t Km,
+    mpf_t X[],
+    void (P) (mpf_t, mpf_t),
+    unsigned long int n)
+{
+  mpf_t Kt;			/* temp */
+  mpf_t f_x;
+  mpf_t f_j;			/* j */
+  mpf_t f_jnq;			/* j/n or (j-1)/n */
+  unsigned long int j;
+
+  /* Sort the vector in ascending order. */  
+  qsort (X, n, sizeof (__mpf_struct), mpf_cmp);
+
+  /* K-S test. */
+  /* 	Kp = sqr(n) * max(j/n - F(Xj))		for all 1<=j<=n
+	Km = sqr(n) * max(F(Xj) - (j-1)/n))	for all 1<=j<=n
+  */
+
+  mpf_init (Kt); mpf_init (f_x); mpf_init (f_j); mpf_init (f_jnq); 
+  mpf_set_ui (Kp, 0);  mpf_set_ui (Km, 0);
+  for (j = 1; j <= n; j++)
+    {
+      P (f_x, X[j-1]);
+      mpf_set_ui (f_j, j);
+
+      mpf_div_ui (f_jnq, f_j, n);
+      mpf_sub (Kt, f_jnq, f_x);
+      if (mpf_cmp (Kt, Kp) > 0)
+	mpf_set (Kp, Kt);
+      if (g_debug > DEBUG_2)
+	{
+	  printf ("j=%lu ", j);
+	  printf ("P()="); mpf_out_str (stdout, 10, 2, f_x); printf ("\t");
+
+	  printf ("jnq="); mpf_out_str (stdout, 10, 2, f_jnq); printf (" ");
+	  printf ("diff="); mpf_out_str (stdout, 10, 2, Kt); printf (" ");
+	  printf ("Kp="); mpf_out_str (stdout, 10, 2, Kp); printf ("\t");
+	}
+      mpf_sub_ui (f_j, f_j, 1);
+      mpf_div_ui (f_jnq, f_j, n);
+      mpf_sub (Kt, f_x, f_jnq);
+      if (mpf_cmp (Kt, Km) > 0)
+	mpf_set (Km, Kt);
+
+      if (g_debug > DEBUG_2)
+	{
+	  printf ("jnq="); mpf_out_str (stdout, 10, 2, f_jnq); printf (" ");
+	  printf ("diff="); mpf_out_str (stdout, 10, 2, Kt); printf (" ");
+	  printf ("Km="); mpf_out_str (stdout, 10, 2, Km); printf (" ");
+	  printf ("\n");
+	}
+    }
+  mpf_sqrt_ui (Kt, n);
+  mpf_mul (Kp, Kp, Kt);
+  mpf_mul (Km, Km, Kt);
+
+  mpf_clear (Kt); mpf_clear (f_x); mpf_clear (f_j); mpf_clear (f_jnq); 
+}
+
+/* ks_table(val, n) -- calculate probability for Kp/Km less than or
+   equal to VAL with N observations.  See [Knuth section 3.3.1] */
+
+void
+ks_table (mpf_t p, mpf_t val, const unsigned int n)
+{
+  /* We use Eq. (27), Knuth p.58, skipping O(1/n) for simplicity.
+     This shortcut will result in too high probabilities, especially
+     when n is small.
+
+     Pr(Kp(n) <= s) = 1 - pow(e, -2*s^2) * (1 - 2/3*s/sqrt(n) + O(1/n)) */
+
+  /* We have 's' in variable VAL and store the result in P. */
+
+  mpf_t t1, t2;
+
+  mpf_init (t1); mpf_init (t2);
+
+  /* t1 = 1 - 2/3 * s/sqrt(n) */
+  mpf_sqrt_ui (t1, n);
+  mpf_div (t1, val, t1);
+  mpf_mul_ui (t1, t1, 2);
+  mpf_div_ui (t1, t1, 3);
+  mpf_ui_sub (t1, 1, t1);
+
+  /* t2 = pow(e, -2*s^2) */
+#ifndef OLDGMP
+  mpf_pow_ui (t2, val, 2);	/* t2 = s^2 */
+  mpf_set_d (t2, exp (-(2.0 * mpf_get_d (t2))));
+#else
+  /* hmmm, gmp doesn't have pow() for floats.  use doubles. */
+  mpf_set_d (t2, pow (M_E, -(2 * pow (mpf_get_d (val), 2))));
+#endif  
+
+  /* p = 1 - t1 * t2 */
+  mpf_mul (t1, t1, t2);
+  mpf_ui_sub (p, 1, t1);
+
+  mpf_clear (t1); mpf_clear (t2);
+}
+
+static double x2_table_X[][7] = {
+  { -2.33, -1.64, -.674, 0.0, 0.674, 1.64, 2.33 }, /* x */
+  { 5.4289, 2.6896, .454276, 0.0, .454276, 2.6896, 5.4289} /* x^2 */
+};
+
+#define _2D3 ((double) .6666666666)
+
+/* x2_table (t, v, n) -- return chi-square table row for V in T[]. */
+void
+x2_table (double t[],
+	  unsigned int v)
+{
+  int f;
+
+
+  /* FIXME: Do a table lookup for v <= 30 since the following formula
+     [Knuth, vol 2, 3.3.1] is only good for v > 30. */
+
+  /* value = v + sqrt(2*v) * X[p] + (2/3) * X[p]^2 - 2/3 + O(1/sqrt(t) */
+  /* NOTE: The O() term is ignored for simplicity. */
+  
+  for (f = 0; f < 7; f++)
+      t[f] =
+	v +
+	sqrt (2 * v) * x2_table_X[0][f] +
+	_2D3 * x2_table_X[1][f] - _2D3;
+}
+
+
+/* P(p, x) -- Distribution function.  Calculate the probability of X
+being greater than or equal to any number in the sequence.  For a
+random real number between zero and one given by a uniformly
+distributed random number generator, this is simply equal to X. */
+
+static void 
+P (mpf_t p, mpf_t x)
+{
+  mpf_set (p, x);
+}
+
+/* mpf_freqt() -- Frequency test using KS on N real numbers between zero
+   and one.  See [Knuth vol 2, p.61]. */
+void
+mpf_freqt (mpf_t Kp,
+	   mpf_t Km,
+	   mpf_t X[],
+	   const unsigned long int n)
+{
+  ks (Kp, Km, X, P, n);
+}
+
+
+/* The Chi-square test.  Eq. (8) in Knuth vol. 2 says that if Y[]
+   holds the observations and p[] is the probability for.. (to be
+   continued!)
+
+   V = 1/n * sum((s=1 to k) Y[s]^2 / p[s]) - n */
+
+void
+x2 (mpf_t V,			/* result */
+    unsigned long int X[],	/* data */
+    unsigned int k,		/* #of categories */
+    void (P) (mpf_t, unsigned long int, void *), /* probability func */
+    void *x,			/* extra user data passed to P() */
+    unsigned long int n)	/* #of samples */
+{
+  unsigned int f;
+  mpf_t f_t, f_t2;		/* temp floats */
+
+  mpf_init (f_t); mpf_init (f_t2);
+
+
+  mpf_set_ui (V, 0);
+  for (f = 0; f < k; f++)
+    {
+      if (g_debug > DEBUG_2)
+	fprintf (stderr, "%u: P()=", f);
+      mpf_set_ui (f_t, X[f]);
+      mpf_mul (f_t, f_t, f_t);	/* f_t = X[f]^2 */
+      P (f_t2, f, x);		/* f_t2 = Pr(f) */
+      if (g_debug > DEBUG_2)
+	mpf_out_str (stderr, 10, 2, f_t2);
+      mpf_div (f_t, f_t, f_t2);
+      mpf_add (V, V, f_t);
+      if (g_debug > DEBUG_2)
+	{
+	  fprintf (stderr, "\tV=");
+	  mpf_out_str (stderr, 10, 2, V);
+	  fprintf (stderr, "\t");
+	}
+    }
+  if (g_debug > DEBUG_2)
+    fprintf (stderr, "\n");
+  mpf_div_ui (V, V, n);
+  mpf_sub_ui (V, V, n);
+  
+  mpf_clear (f_t); mpf_clear (f_t2);
+}
+
+/* Pzf(p, s, x) -- Probability for category S in mpz_freqt().  It's
+   1/d for all S.  X is a pointer to an unsigned int holding 'd'. */
+static void
+Pzf (mpf_t p, unsigned long int s, void *x)
+{
+  mpf_set_ui (p, 1);
+  mpf_div_ui (p, p, *((unsigned int *) x));
+}
+
+/* mpz_freqt(V, X, imax, n) -- Frequency test on integers.  [Knuth,
+   vol 2, 3.3.2].  Keep IMAX low on this one, since we loop from 0 to
+   IMAX.  128 or 256 could be nice.
+
+   X[] must not contain numbers outside the range 0 <= X <= IMAX.
+
+   Return value is number of observations actally used, after
+   discarding entries out of range.
+
+   Since X[] contains integers between zero and IMAX, inclusive, we
+   have IMAX+1 categories.
+
+   Note that N should be at least 5*IMAX.  Result is put in V and can
+   be compared to output from x2_table (v=IMAX). */
+
+unsigned long int
+mpz_freqt (mpf_t V,
+	   mpz_t X[],
+	   unsigned int imax,
+	   const unsigned long int n)
+{
+  unsigned long int *v;		/* result */
+  unsigned int f;
+  unsigned int d;		/* number of categories = imax+1 */
+  unsigned int uitemp;
+  unsigned long int usedn;
+
+
+  d = imax + 1;
+
+  v = (unsigned long int *) calloc (imax + 1, sizeof (unsigned long int));
+  if (NULL == v)
+    {
+      fprintf (stderr, "mpz_freqt(): out of memory\n");
+      exit (1);
+    }
+
+  /* count */
+  usedn = n;			/* actual number of observations */
+  for (f = 0; f < n; f++)
+    {
+      uitemp = mpz_get_ui(X[f]);
+      if (uitemp > imax)	/* sanity check */
+	{
+	  if (g_debug)
+	    fprintf (stderr, "mpz_freqt(): warning: input insanity: %u, "\
+		     "ignored.\n", uitemp);
+	  usedn--;
+	  continue;
+	}
+      v[uitemp]++;
+    }
+
+  if (g_debug > DEBUG_2)
+    {
+      fprintf (stderr, "counts:\n");
+      for (f = 0; f <= imax; f++)
+	fprintf (stderr, "%u:\t%lu\n", f, v[f]);
+    }
+
+  /* chi-square with k=imax+1 and P(x)=1/(imax+1) for all x.*/
+  x2 (V, v, d, Pzf, (void *) &d, usedn);
+
+  free (v);
+  return (usedn);
+}
+
+/* debug dummy to drag in dump funcs */
+void
+foo_debug () 
+{
+  if (0)
+    {
+      mpf_dump (0); 
+#ifndef OLDGMP
+      mpz_dump (0);
+#endif      
+    }
+}
+
+/* merit (rop, t, v, m) -- calculate merit for spectral test result in
+   dimension T, see Knuth p. 105.  BUGS: Only valid for 2 <= T <=
+   6. */
+void
+merit (mpf_t rop, unsigned int t, mpf_t v, mpz_t m)
+{
+  int f;
+  mpf_t f_m, f_const, f_pi;
+
+  mpf_init (f_m);
+  mpf_set_z (f_m, m);
+  mpf_init_set_d (f_const, M_PI);
+  mpf_init_set_d (f_pi, M_PI);
+  
+  switch (t)
+    {
+    case 2:			/* PI */
+      break;
+    case 3:			/* PI * 4/3 */
+      mpf_mul_ui (f_const, f_const, 4);
+      mpf_div_ui (f_const, f_const, 3);
+      break;
+    case 4:			/* PI^2 * 1/2 */
+      mpf_mul (f_const, f_const, f_pi);
+      mpf_div_ui (f_const, f_const, 2);
+      break;
+    case 5:			/* PI^2 * 8/15 */
+      mpf_mul (f_const, f_const, f_pi);
+      mpf_mul_ui (f_const, f_const, 8);
+      mpf_div_ui (f_const, f_const, 15);
+      break;
+    case 6:			/* PI^3 * 1/6 */
+      mpf_mul (f_const, f_const, f_pi);
+      mpf_mul (f_const, f_const, f_pi);
+      mpf_div_ui (f_const, f_const, 6);
+      break;
+    default:
+      fprintf (stderr,
+	       "spect (merit): can't calculate merit for dimensions > 6\n");
+      mpf_set_ui (f_const, 0);
+      break;
+    }
+
+  /* rop = v^t */
+  mpf_set (rop, v);
+  for (f = 1; f < t; f++)
+    mpf_mul (rop, rop, v);
+  mpf_mul (rop, rop, f_const);
+  mpf_div (rop, rop, f_m);
+
+  mpf_clear (f_m);
+  mpf_clear (f_const);
+  mpf_clear (f_pi);
+}
+
+double
+merit_u (unsigned int t, mpf_t v, mpz_t m)
+{
+  mpf_t rop;
+  double res;
+  
+  mpf_init (rop);
+  merit (rop, t, v, m);
+  res = mpf_get_d (rop);
+  mpf_clear (rop);
+  return res;
+}
+
+/* f_floor (rop, op) -- Set rop = floor (op). */
+void
+f_floor (mpf_t rop, mpf_t op)
+{
+  mpz_t z;
+
+  mpz_init (z);
+
+  /* No mpf_floor().  Convert to mpz and back. */
+  mpz_set_f (z, op);
+  mpf_set_z (rop, z);
+
+  mpz_clear (z);
+}
+
+
+/* vz_dot (rop, v1, v2, nelem) -- compute dot product of z-vectors V1,
+   V2.  N is number of elements in vectors V1 and V2. */
+
+void
+vz_dot (mpz_t rop, mpz_t V1[], mpz_t V2[], unsigned int n)
+{
+  mpz_t t;
+
+  mpz_init (t);
+  mpz_set_ui (rop, 0);
+  while (n--)
+    {
+      mpz_mul (t, V1[n], V2[n]);
+      mpz_add (rop, rop, t);
+    }
+
+  mpz_clear (t);
+}
+
+void
+spectral_test (mpf_t rop[], unsigned int T, mpz_t a, mpz_t m)
+{
+  /* Knuth "Seminumerical Algorithms, Third Edition", section 3.3.4
+     (pp. 101-103). */
+
+  /* v[t] = min { sqrt (x[1]^2 + ... + x[t]^2) |
+     x[1] + a*x[2] + ... + pow (a, t-1) * x[t] is congruent to 0 (mod m) } */
+
+
+  /* Variables. */
+  unsigned int ui_t;
+  unsigned int ui_i, ui_j, ui_k, ui_l;
+  mpf_t f_tmp1, f_tmp2;
+  mpz_t tmp1, tmp2, tmp3;
+  mpz_t U[GMP_SPECT_MAXT][GMP_SPECT_MAXT],
+    V[GMP_SPECT_MAXT][GMP_SPECT_MAXT],
+    X[GMP_SPECT_MAXT],
+    Y[GMP_SPECT_MAXT],
+    Z[GMP_SPECT_MAXT];
+  mpz_t h, hp, r, s, p, pp, q, u, v;
+
+  /* GMP inits. */
+  mpf_init (f_tmp1);
+  mpf_init (f_tmp2);
+  for (ui_i = 0; ui_i < GMP_SPECT_MAXT; ui_i++)
+    {
+      for (ui_j = 0; ui_j < GMP_SPECT_MAXT; ui_j++)
+	{
+	  mpz_init_set_ui (U[ui_i][ui_j], 0);
+	  mpz_init_set_ui (V[ui_i][ui_j], 0);
+	}
+      mpz_init_set_ui (X[ui_i], 0);
+      mpz_init_set_ui (Y[ui_i], 0);
+      mpz_init (Z[ui_i]);
+    }
+  mpz_init (tmp1);
+  mpz_init (tmp2);
+  mpz_init (tmp3);
+  mpz_init (h);
+  mpz_init (hp);
+  mpz_init (r);
+  mpz_init (s);
+  mpz_init (p);
+  mpz_init (pp);
+  mpz_init (q);
+  mpz_init (u);
+  mpz_init (v);
+
+  /* Implementation inits. */
+  if (T > GMP_SPECT_MAXT)
+    T = GMP_SPECT_MAXT;			/* FIXME: Lazy. */
+
+  /* S1 [Initialize.] */
+  ui_t = 2 - 1;			/* NOTE: `t' in description == ui_t + 1
+                                   for easy indexing */
+  mpz_set (h, a);
+  mpz_set (hp, m);
+  mpz_set_ui (p, 1);
+  mpz_set_ui (pp, 0);
+  mpz_set (r, a);
+  mpz_pow_ui (s, a, 2);		
+  mpz_add_ui (s, s, 1);		/* s = 1 + a^2 */
+
+  /* S2 [Euclidean step.] */
+  while (1)
+    {
+      if (g_debug > DEBUG_1)
+	{
+	  mpz_mul (tmp1, h, pp);
+	  mpz_mul (tmp2, hp, p);
+	  mpz_sub (tmp1, tmp1, tmp2);
+	  if (mpz_cmpabs (m, tmp1))
+	    {
+	      printf ("***BUG***: h*pp - hp*p = ");
+	      mpz_out_str (stdout, 10, tmp1);
+	      printf ("\n");
+	    }
+	}
+      if (g_debug > DEBUG_2)
+	{
+	  printf ("hp = ");
+	  mpz_out_str (stdout, 10, hp);
+	  printf ("\nh = ");
+	  mpz_out_str (stdout, 10, h);
+	  printf ("\n");
+	  fflush (stdout);
+	}
+
+      if (mpz_sgn (h))
+	mpz_tdiv_q (q, hp, h);	/* q = floor(hp/h) */
+      else
+	mpz_set_ui (q, 1);
+
+      if (g_debug > DEBUG_2)
+	{
+	  printf ("q = ");
+	  mpz_out_str (stdout, 10, q);
+	  printf ("\n");
+	  fflush (stdout);
+	}
+
+      mpz_mul (tmp1, q, h);
+      mpz_sub (u, hp, tmp1);	/* u = hp - q*h */
+
+      mpz_mul (tmp1, q, p);
+      mpz_sub (v, pp, tmp1);	/* v = pp - q*p */
+  
+      mpz_pow_ui (tmp1, u, 2);
+      mpz_pow_ui (tmp2, v, 2);
+      mpz_add (tmp1, tmp1, tmp2);
+      if (mpz_cmp (tmp1, s) < 0)
+	{
+	  mpz_set (s, tmp1);	/* s = u^2 + v^2 */
+	  mpz_set (hp, h);	/* hp = h */
+	  mpz_set (h, u);	/* h = u */
+	  mpz_set (pp, p);	/* pp = p */
+	  mpz_set (p, v);	/* p = v */
+	}
+      else
+	break;
+    }
+
+  /* S3 [Compute v2.] */
+  mpz_sub (u, u, h);
+  mpz_sub (v, v, p);
+
+  mpz_pow_ui (tmp1, u, 2);
+  mpz_pow_ui (tmp2, v, 2);
+  mpz_add (tmp1, tmp1, tmp2);
+  if (mpz_cmp (tmp1, s) < 0)
+    {
+      mpz_set (s, tmp1);	/* s = u^2 + v^2 */
+      mpz_set (hp, u);
+      mpz_set (pp, v);
+    }
+  mpf_set_z (f_tmp1, s);
+  mpf_sqrt (rop[ui_t - 1], f_tmp1);
+      
+  /* S4 [Advance t.] */
+  mpz_neg (U[0][0], h);
+  mpz_set (U[0][1], p);
+  mpz_neg (U[1][0], hp);
+  mpz_set (U[1][1], pp);
+  
+  mpz_set (V[0][0], pp);
+  mpz_set (V[0][1], hp);
+  mpz_neg (V[1][0], p);
+  mpz_neg (V[1][1], h);
+  if (mpz_cmp_ui (pp, 0) > 0)
+    {
+      mpz_neg (V[0][0], V[0][0]);
+      mpz_neg (V[0][1], V[0][1]);
+      mpz_neg (V[1][0], V[1][0]);
+      mpz_neg (V[1][1], V[1][1]);
+    }
+
+  while (ui_t + 1 != T)		/* S4 loop */
+    {
+      ui_t++;
+      mpz_mul (r, a, r);
+      mpz_mod (r, r, m);
+
+      /* Add new row and column to U and V.  They are initialized with
+	 all elements set to zero, so clearing is not necessary. */
+
+      mpz_neg (U[ui_t][0], r); /* U: First col in new row. */
+      mpz_set_ui (U[ui_t][ui_t], 1); /* U: Last col in new row. */
+
+      mpz_set (V[ui_t][ui_t], m); /* V: Last col in new row. */
+      
+      /* "Finally, for 1 <= i < t,
+	   set q = round (vi1 * r / m),
+	   vit = vi1*r - q*m,
+	   and Ut=Ut+q*Ui */
+
+      for (ui_i = 0; ui_i < ui_t; ui_i++)
+	{
+	  mpz_mul (tmp1, V[ui_i][0], r); /* tmp1=vi1*r */
+	  zdiv_round (q, tmp1, m); /* q=round(vi1*r/m) */
+	  mpz_mul (tmp2, q, m);	/* tmp2=q*m */
+	  mpz_sub (V[ui_i][ui_t], tmp1, tmp2);
+
+	  for (ui_j = 0; ui_j <= ui_t; ui_j++) /* U[t] = U[t] + q*U[i] */
+	    {
+	      mpz_mul (tmp1, q, U[ui_i][ui_j]);	/* tmp=q*uij */
+	      mpz_add (U[ui_t][ui_j], U[ui_t][ui_j], tmp1); /* utj = utj + q*uij */
+	    }
+	}
+
+      /* s = min (s, zdot (U[t], U[t]) */
+      vz_dot (tmp1, U[ui_t], U[ui_t], ui_t + 1);
+      if (mpz_cmp (tmp1, s) < 0)
+	mpz_set (s, tmp1);
+
+      ui_k = ui_t;
+      ui_j = 0;			/* WARNING: ui_j no longer a temp. */
+
+      /* S5 [Transform.] */
+      if (g_debug > DEBUG_2)
+	printf ("(t, k, j, q1, q2, ...)\n");
+      do 
+	{
+	  if (g_debug > DEBUG_2)
+	    printf ("(%u, %u, %u", ui_t + 1, ui_k + 1, ui_j + 1);
+
+	  for (ui_i = 0; ui_i <= ui_t; ui_i++)
+	    {
+	      if (ui_i != ui_j)
+		{
+		  vz_dot (tmp1, V[ui_i], V[ui_j], ui_t + 1); /* tmp1=dot(Vi,Vj). */
+		  mpz_abs (tmp2, tmp1);
+		  mpz_mul_ui (tmp2, tmp2, 2); /* tmp2 = 2*abs(dot(Vi,Vj) */
+		  vz_dot (tmp3, V[ui_j], V[ui_j], ui_t + 1); /* tmp3=dot(Vj,Vj). */
+
+		  if (mpz_cmp (tmp2, tmp3) > 0)
+		    {
+		      zdiv_round (q, tmp1, tmp3); /* q=round(Vi.Vj/Vj.Vj) */
+		      if (g_debug > DEBUG_2)
+			{
+			  printf (", ");
+			  mpz_out_str (stdout, 10, q);
+			}
+
+		      for (ui_l = 0; ui_l <= ui_t; ui_l++)
+			{
+			  mpz_mul (tmp1, q, V[ui_j][ui_l]);
+			  mpz_sub (V[ui_i][ui_l], V[ui_i][ui_l], tmp1); /* Vi=Vi-q*Vj */
+			  mpz_mul (tmp1, q, U[ui_i][ui_l]);
+			  mpz_add (U[ui_j][ui_l], U[ui_j][ui_l], tmp1); /* Uj=Uj+q*Ui */
+			}
+		      
+		      vz_dot (tmp1, U[ui_j], U[ui_j], ui_t + 1); /* tmp1=dot(Uj,Uj) */
+		      if (mpz_cmp (tmp1, s) < 0) /* s = min(s,dot(Uj,Uj)) */
+			mpz_set (s, tmp1);
+		      ui_k = ui_j;
+		    }
+		  else if (g_debug > DEBUG_2)
+		    printf (", #"); /* 2|Vi.Vj| <= Vj.Vj */
+		}
+	      else if (g_debug > DEBUG_2)
+		printf (", *");	/* i == j */
+	    }
+
+	  if (g_debug > DEBUG_2)
+	    printf (")\n");
+
+	  /* S6 [Advance j.] */
+	  if (ui_j == ui_t)
+	    ui_j = 0;
+	  else
+	    ui_j++;
+	}
+      while (ui_j != ui_k);	/* S5 */
+
+      /* From Knuth p. 104: "The exhaustive search in steps S8-S10
+	 reduces the value of s only rarely." */
+#ifdef DO_SEARCH	
+      /* S7 [Prepare for search.] */
+      /* Find minimum in (x[1], ..., x[t]) satisfying condition
+	 x[k]^2 <= f(y[1], ...,y[t]) * dot(V[k],V[k]) */
+
+      ui_k = ui_t;
+      if (g_debug > DEBUG_2)
+	{
+	  printf ("searching...");
+	  /*for (f = 0; f < ui_t*/
+	  fflush (stdout);
+	}
+
+      /* Z[i] = floor (sqrt (floor (dot(V[i],V[i]) * s / m^2))); */
+      mpz_pow_ui (tmp1, m, 2);
+      mpf_set_z (f_tmp1, tmp1);
+      mpf_set_z (f_tmp2, s);
+      mpf_div (f_tmp1, f_tmp2, f_tmp1);	/* f_tmp1 = s/m^2 */
+      for (ui_i = 0; ui_i <= ui_t; ui_i++)
+	{
+	  vz_dot (tmp1, V[ui_i], V[ui_i], ui_t + 1);
+	  mpf_set_z (f_tmp2, tmp1);
+	  mpf_mul (f_tmp2, f_tmp2, f_tmp1);
+	  f_floor (f_tmp2, f_tmp2);
+	  mpf_sqrt (f_tmp2, f_tmp2);
+	  mpz_set_f (Z[ui_i], f_tmp2);
+	}
+
+      /* S8 [Advance X[k].] */
+      do 
+	{
+	  if (g_debug > DEBUG_2)
+	    {
+	      printf ("X[%u] = ", ui_k);
+	      mpz_out_str (stdout, 10, X[ui_k]);
+	      printf ("\tZ[%u] = ", ui_k);
+	      mpz_out_str (stdout, 10, Z[ui_k]);
+	      printf ("\n");
+	      fflush (stdout);
+	    }
+	      
+	  if (mpz_cmp (X[ui_k], Z[ui_k]))
+	    {
+	      mpz_add_ui (X[ui_k], X[ui_k], 1);
+	      for (ui_i = 0; ui_i <= ui_t; ui_i++)
+		mpz_add (Y[ui_i], Y[ui_i], U[ui_k][ui_i]);
+
+	      /* S9 [Advance k.] */
+	      while (++ui_k <= ui_t)
+		{
+		  mpz_neg (X[ui_k], Z[ui_k]);
+		  mpz_mul_ui (tmp1, Z[ui_k], 2);
+		  for (ui_i = 0; ui_i <= ui_t; ui_i++)
+		    {
+		      mpz_mul (tmp2, tmp1, U[ui_k][ui_i]);
+		      mpz_sub (Y[ui_i], Y[ui_i], tmp2);
+		    }
+		}
+	      vz_dot (tmp1, Y, Y, ui_t + 1);
+	      if (mpz_cmp (tmp1, s) < 0)
+		mpz_set (s, tmp1);
+	    }
+	}
+      while (--ui_k);
+#endif /* DO_SEARCH */
+      mpf_set_z (f_tmp1, s);
+      mpf_sqrt (rop[ui_t - 1], f_tmp1);
+#ifdef DO_SEARCH	
+      if (g_debug > DEBUG_2)
+	printf ("done.\n");
+#endif /* DO_SEARCH */
+    } /* S4 loop */
+
+  /* Clear GMP variables. */
+
+  mpf_clear (f_tmp1);
+  mpf_clear (f_tmp2);
+  for (ui_i = 0; ui_i < GMP_SPECT_MAXT; ui_i++)
+    {
+      for (ui_j = 0; ui_j < GMP_SPECT_MAXT; ui_j++)
+	{
+	  mpz_clear (U[ui_i][ui_j]);
+	  mpz_clear (V[ui_i][ui_j]);
+	}
+      mpz_clear (X[ui_i]);
+      mpz_clear (Y[ui_i]);
+      mpz_clear (Z[ui_i]);
+    }
+  mpz_clear (tmp1);
+  mpz_clear (tmp2);
+  mpz_clear (tmp3);
+  mpz_clear (h);
+  mpz_clear (hp);
+  mpz_clear (r);
+  mpz_clear (s);
+  mpz_clear (p);
+  mpz_clear (pp);
+  mpz_clear (q);
+  mpz_clear (u);
+  mpz_clear (v);
+
+  return;
+}
+
diff --git a/src/gmp/tests/rand/t-rand.c b/src/gmp/tests/rand/t-rand.c
new file mode 100644
index 000000000..302e07aba
--- /dev/null
+++ b/src/gmp/tests/rand/t-rand.c
@@ -0,0 +1,299 @@
+/* t-rand -- Test random number generators.  */
+
+/*
+Copyright (C) 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <stdlib.h>
+#include <stdio.h>
+#include "gmp.h"
+
+#define SEED 1
+#define BASE 16
+#define ENTS 10			/* Number of entries in array when
+                                   printing.  */
+
+/* These were generated by this very program.  Do not edit!  */
+/* Integers.  */
+char *z1[ENTS] = {"0", "1", "1", "1", "1", "0", "1", "1", "1", "1"};
+char *z2[ENTS] = {"0", "3", "1", "3", "3", "0", "3", "3", "3", "1"};
+char *z3[ENTS] = {"4", "3", "1", "7", "3", "0", "3", "3", "3", "1"};
+char *z4[ENTS] = {"c", "3", "1", "f", "b", "8", "3", "3", "3", "1"};
+char *z5[ENTS] = {"1c", "13", "11", "1f", "b", "18", "3", "13", "3", "1"};
+
+char *z10[ENTS] = {"29c", "213", "f1", "17f", "12b", "178", "383", "d3", "3a3", "281"};
+
+char *z15[ENTS] = {"29c", "1a13", "74f1", "257f", "592b", "4978", "4783", "7cd3", "5ba3", "4681"};
+char *z16[ENTS] = {"29c", "9a13", "74f1", "a57f", "d92b", "4978", "c783", "fcd3", "5ba3", "c681"};
+char *z17[ENTS] = {"51e", "f17a", "54ff", "1a335", "cf65", "5d6f", "583f", "618f", "1bc6", "98ff"};
+
+char *z31[ENTS] = {"3aecd515", "13ae8ec6", "518c8090", "81ca077", "70b7134", "7ee78d71", "323a7636", "2122cb1a", "19811941", "41fd605"};
+char *z32[ENTS] = {"baecd515", "13ae8ec6", "518c8090", "881ca077", "870b7134", "7ee78d71", "323a7636", "a122cb1a", "99811941", "841fd605"};
+char *z33[ENTS] = {"1faf4cca", "15d6ef83b", "9095fe72", "1b6a3dff6", "b17cbddd", "16e5209d4", "6f65b12c", "493bbbc6", "abf2a5d5", "6d491a3c"};
+
+char *z63[ENTS] = {"48a74f367fa7b5c8", "3ba9e9dc1b263076", "1e0ac84e7678e0fb", "11416581728b3e35", "36ab610523f0f1f7", "3e540e8e95c0eb4b", "439ae16057dbc9d3", "734fb260db243950", "7d3a317effc289bf", "1d80301fb3d1a0d1"};
+char *z64[ENTS] = {"48a74f367fa7b5c8", "bba9e9dc1b263076", "9e0ac84e7678e0fb", "11416581728b3e35", "b6ab610523f0f1f7", "be540e8e95c0eb4b", "439ae16057dbc9d3", "f34fb260db243950", "fd3a317effc289bf", "1d80301fb3d1a0d1"};
+char *z65[ENTS] = {"1ff77710d846d49f0", "1b1411701d709ee10", "31ffa81a208b6af4", "446638d431d3c681", "df5c569d5baa8b55", "197d99ea9bf28e5a0", "191ade09edd94cfae", "194acefa6dde5e18d", "1afc1167c56272d92", "d092994da72f206f"};
+
+char *z127[ENTS] = {"2f66ba932aaf58a071fd8f0742a99a0c", "73cfa3c664c9c1753507ca60ec6b8425", "53ea074ca131dec12cd68b8aa8e20278", "3cf5ac8c343532f8a53cc0eb47581f73", "50c11d5869e208aa1b9aa317b8c2d0a9", "b23163c892876472b1ef19642eace09", "489f4c03d41f87509c8d6c90ce674f95", "2ab8748c96aa6762ea1932b44c9d7164", "98cb5591fc05ad31afbbc1d67b90edd", "77848bb991fd0be331adcf1457fbc672"};
+char *z128[ENTS] = {"af66ba932aaf58a071fd8f0742a99a0c", "73cfa3c664c9c1753507ca60ec6b8425", "53ea074ca131dec12cd68b8aa8e20278", "3cf5ac8c343532f8a53cc0eb47581f73", "50c11d5869e208aa1b9aa317b8c2d0a9", "8b23163c892876472b1ef19642eace09", "489f4c03d41f87509c8d6c90ce674f95", "aab8748c96aa6762ea1932b44c9d7164", "98cb5591fc05ad31afbbc1d67b90edd", "f7848bb991fd0be331adcf1457fbc672"};
+
+/* Floats.  */
+char *f1[ENTS] = {"0.@0", "0.8@0", "0.8@0", "0.8@0", "0.8@0", "0.@0", "0.8@0", "0.8@0", "0.8@0", "0.8@0"};
+char *f2[ENTS] = {"0.@0", "0.c@0", "0.4@0", "0.c@0", "0.c@0", "0.@0", "0.c@0", "0.c@0", "0.c@0", "0.4@0"};
+char *f3[ENTS] = {"0.8@0", "0.6@0", "0.2@0", "0.e@0", "0.6@0", "0.@0", "0.6@0", "0.6@0", "0.6@0", "0.2@0"};
+char *f4[ENTS] = {"0.c@0", "0.3@0", "0.1@0", "0.f@0", "0.b@0", "0.8@0", "0.3@0", "0.3@0", "0.3@0", "0.1@0"};
+char *f5[ENTS] = {"0.e@0", "0.98@0", "0.88@0", "0.f8@0", "0.58@0", "0.c@0", "0.18@0", "0.98@0", "0.18@0", "0.8@-1"};
+
+char *f10[ENTS] = {"0.a7@0", "0.84c@0", "0.3c4@0", "0.5fc@0", "0.4ac@0", "0.5e@0", "0.e0c@0", "0.34c@0", "0.e8c@0", "0.a04@0"};
+
+char *f15[ENTS] = {"0.538@-1", "0.3426@0", "0.e9e2@0", "0.4afe@0", "0.b256@0", "0.92f@0", "0.8f06@0", "0.f9a6@0", "0.b746@0", "0.8d02@0"};
+char *f16[ENTS] = {"0.29c@-1", "0.9a13@0", "0.74f1@0", "0.a57f@0", "0.d92b@0", "0.4978@0", "0.c783@0", "0.fcd3@0", "0.5ba3@0", "0.c681@0"};
+char *f17[ENTS] = {"0.28f@-1", "0.78bd@0", "0.2a7f8@0", "0.d19a8@0", "0.67b28@0", "0.2eb78@0", "0.2c1f8@0", "0.30c78@0", "0.de3@-1", "0.4c7f8@0"};
+
+char *f31[ENTS] = {"0.75d9aa2a@0", "0.275d1d8c@0", "0.a319012@0", "0.103940ee@0", "0.e16e268@-1", "0.fdcf1ae2@0", "0.6474ec6c@0", "0.42459634@0", "0.33023282@0", "0.83fac0a@-1"};
+char *f32[ENTS] = {"0.baecd515@0", "0.13ae8ec6@0", "0.518c809@0", "0.881ca077@0", "0.870b7134@0", "0.7ee78d71@0", "0.323a7636@0", "0.a122cb1a@0", "0.99811941@0", "0.841fd605@0"};
+char *f33[ENTS] = {"0.fd7a665@-1", "0.aeb77c1d8@0", "0.484aff39@0", "0.db51effb@0", "0.58be5eee8@0", "0.b72904ea@0", "0.37b2d896@0", "0.249ddde3@0", "0.55f952ea8@0", "0.36a48d1e@0"};
+
+char *f63[ENTS] = {"0.914e9e6cff4f6b9@0", "0.7753d3b8364c60ec@0", "0.3c15909cecf1c1f6@0", "0.2282cb02e5167c6a@0", "0.6d56c20a47e1e3ee@0", "0.7ca81d1d2b81d696@0", "0.8735c2c0afb793a6@0", "0.e69f64c1b64872a@0", "0.fa7462fdff85137e@0", "0.3b00603f67a341a2@0"};
+char *f64[ENTS] = {"0.48a74f367fa7b5c8@0", "0.bba9e9dc1b263076@0", "0.9e0ac84e7678e0fb@0", "0.11416581728b3e35@0", "0.b6ab610523f0f1f7@0", "0.be540e8e95c0eb4b@0", "0.439ae16057dbc9d3@0", "0.f34fb260db24395@0", "0.fd3a317effc289bf@0", "0.1d80301fb3d1a0d1@0"};
+char *f65[ENTS] = {"0.ffbbb886c236a4f8@0", "0.d8a08b80eb84f708@0", "0.18ffd40d1045b57a@0", "0.22331c6a18e9e3408@0", "0.6fae2b4eadd545aa8@0", "0.cbeccf54df9472d@0", "0.c8d6f04f6eca67d7@0", "0.ca5677d36ef2f0c68@0", "0.d7e08b3e2b1396c9@0", "0.68494ca6d39790378@0"};
+
+char *f127[ENTS] = {"0.5ecd7526555eb140e3fb1e0e85533418@0", "0.e79f478cc99382ea6a0f94c1d8d7084a@0", "0.a7d40e994263bd8259ad171551c404f@0", "0.79eb5918686a65f14a7981d68eb03ee6@0", "0.a1823ab0d3c411543735462f7185a152@0", "0.16462c791250ec8e563de32c85d59c12@0", "0.913e9807a83f0ea1391ad9219cce9f2a@0", "0.5570e9192d54cec5d4326568993ae2c8@0", "0.13196ab23f80b5a635f7783acf721dba@0", "0.ef09177323fa17c6635b9e28aff78ce4@0"};
+char *f128[ENTS] = {"0.af66ba932aaf58a071fd8f0742a99a0c@0", "0.73cfa3c664c9c1753507ca60ec6b8425@0", "0.53ea074ca131dec12cd68b8aa8e20278@0", "0.3cf5ac8c343532f8a53cc0eb47581f73@0", "0.50c11d5869e208aa1b9aa317b8c2d0a9@0", "0.8b23163c892876472b1ef19642eace09@0", "0.489f4c03d41f87509c8d6c90ce674f95@0", "0.aab8748c96aa6762ea1932b44c9d7164@0", "0.98cb5591fc05ad31afbbc1d67b90edd@-1", "0.f7848bb991fd0be331adcf1457fbc672@0"};
+
+
+struct rt
+{
+  char **s;
+  int nbits;
+};
+
+static struct rt zarr[] =
+{
+  {z1, 1},
+  {z2, 2},
+  {z3, 3},
+  {z4, 4},
+  {z5, 5},
+  {z10, 10},
+  {z15, 15},
+  {z16, 16},
+  {z17, 17},
+  {z31, 31},
+  {z32, 32},
+  {z33, 33},
+  {z63, 63},
+  {z64, 64},
+  {z65, 65},
+  {z127, 127},
+  {z128, 128},
+  {0, NULL}
+};
+
+static struct rt farr[] =
+{
+  {f1, 1},
+  {f2, 2},
+  {f3, 3},
+  {f4, 4},
+  {f5, 5},
+  {f10, 10},
+  {f15, 15},
+  {f16, 16},
+  {f17, 17},
+  {f31, 31},
+  {f32, 32},
+  {f33, 33},
+  {f63, 63},
+  {f64, 64},
+  {f65, 65},
+  {f127, 127},
+  {f128, 128},
+  {0, NULL}
+};
+  
+
+int 
+#if __STDC__
+main (int argc, char *argv[])
+#else
+main (argc, argv)
+     int argc;
+     char *argv[];
+#endif
+{
+  static char usage[] = "\
+usage: t-rand [function nbits]\n\
+  function is one of z, f\n\
+  nbits is number of bits\n\
+";
+  gmp_randstate_t rstate;
+  mpz_t z, rz;
+  mpf_t f, rf;
+  enum { Z, F } func = Z;
+  int nbits = 1;
+  int verify_mode_flag = 1;
+  register int i;
+  struct rt *a;
+
+
+  if (argc > 1)
+    {
+      if (argc < 3)
+	{
+	  fputs (usage, stderr);
+	  exit (1);
+	}
+      verify_mode_flag = 0;
+      if (*argv[1] == 'z')
+	func = Z;
+      if (*argv[1] == 'f')
+	func = F;
+      nbits = atoi (argv[2]);
+    }
+
+  mpz_init (rz);
+  
+  if (verify_mode_flag)
+    {
+#ifdef VERBOSE
+      printf ("%s: verifying random numbers: ", argv[0]);
+#endif
+
+      /* Test z.  */
+      mpz_init (z);
+      for (a = zarr; a->s != NULL; a++)
+	{
+	  gmp_randinit (rstate, GMP_RAND_ALG_LC, a->nbits);
+	  if (gmp_errno != GMP_ERROR_NONE)
+	    exit (1);
+	  gmp_randseed_ui (rstate, SEED);
+
+	  for (i = 0; i < ENTS; i++)
+	    {
+	      mpz_urandomb (rz, rstate, a->nbits);
+	      mpz_set_str (z, a->s[i], BASE);
+	      if (mpz_cmp (z, rz) != 0)
+		{
+		  printf ("z%d: ", a->nbits); 
+		  mpz_out_str (stdout, BASE, rz);
+		  printf (" should be ");
+		  mpz_out_str (stdout, BASE, z);
+		  puts ("");
+		  exit (1);
+		}
+	    }
+#ifdef VERBOSE
+	  printf ("z%d ", a->nbits);
+#endif
+	  gmp_randclear (rstate);
+	}
+      mpz_clear (z);
+
+
+      /* Test f.  */
+      for (a = farr; a->s != NULL; a++)
+	{
+	  gmp_randinit (rstate, GMP_RAND_ALG_LC, a->nbits);
+	  if (gmp_errno != GMP_ERROR_NONE)
+	    exit (1);
+	  gmp_randseed_ui (rstate, SEED);
+
+	  mpf_init2 (f, a->nbits);
+	  mpf_init2 (rf, a->nbits);
+	  for (i = 0; i < ENTS; i++)
+	    {
+	      mpf_urandomb (rf, rstate, a->nbits);
+	      mpf_set_str (f, a->s[i], BASE);
+	      if (mpf_cmp (f, rf) != 0)
+		{
+		  printf ("f%d: ", a->nbits); 
+		  mpf_out_str (stdout, BASE, a->nbits, rf);
+		  printf (" should be ");
+		  mpf_out_str (stdout, BASE, a->nbits, f);
+		  puts ("");
+		  exit (1);
+		}
+	    }
+#ifdef VERBOSE
+	  printf ("f%d ", a->nbits);
+#endif
+	  gmp_randclear (rstate);
+	  mpf_clear (f);
+	  mpf_clear (rf);
+	}
+
+#ifdef VERBOSE
+      puts ("");
+#endif
+    }
+  else				/* Print mode.  */
+    {
+      gmp_randinit (rstate, GMP_RAND_ALG_LC, nbits);
+      if (gmp_errno != GMP_ERROR_NONE)
+	exit (1);
+      gmp_randseed_ui (rstate, SEED);
+
+      switch (func)
+	{
+	case Z:
+	  printf ("char *z%d[ENTS] = {", nbits);
+	  for (i = 0; i < ENTS; i++)
+	    {
+	      mpz_urandomb (rz, rstate, nbits);
+	      printf ("\"");
+	      mpz_out_str (stdout, BASE, rz);
+	      printf ("\"");
+	      if (i != ENTS - 1)
+		printf (", ");
+	    }
+	  printf ("};\n");
+	  printf ("  {z%d, %d},\n", nbits, nbits);
+	  break;
+
+	case F:
+	  printf ("char *f%d[ENTS] = {", nbits);
+	  mpf_init2 (rf, nbits);
+	  for (i = 0; i < ENTS; i++)
+	    {
+	      mpf_urandomb (rf, rstate, nbits);
+	      printf ("\"");
+	      mpf_out_str (stdout, BASE, nbits, rf);
+	      printf ("\"");
+	      if (i != ENTS - 1)
+		printf (", ");
+	    }
+	  printf ("};\n");
+	  printf ("  {f%d, %d},\n", nbits, nbits);
+	  mpf_clear (rf);
+	  break;
+
+	default:
+	  exit (1);
+	}
+
+      gmp_randclear (rstate);
+    }
+  
+  mpz_clear (rz);
+
+  return 0;
+}
diff --git a/src/gmp/tests/rand/zdiv_round.c b/src/gmp/tests/rand/zdiv_round.c
new file mode 100644
index 000000000..8827e9a70
--- /dev/null
+++ b/src/gmp/tests/rand/zdiv_round.c
@@ -0,0 +1,47 @@
+/* zdiv_round() -- divide integers, round to nearest */
+
+/*
+Copyright (C) 1999 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "gmp.h"
+
+void
+zdiv_round (mpz_t rop, mpz_t n, mpz_t d)
+{
+  mpf_t f_n, f_d;
+
+  mpf_init (f_n);
+  mpf_init (f_d);
+
+  mpf_set_z (f_d, d);
+  mpf_set_z (f_n, n);
+
+  mpf_div (f_n, f_n, f_d);
+  mpf_set_d (f_d, .5);
+  if (mpf_sgn (f_n) < 0)
+    mpf_neg (f_d, f_d);
+  mpf_add (f_n, f_n, f_d);
+  mpz_set_f (rop, f_n);
+
+  mpf_clear (f_n);
+  mpf_clear (f_d);
+  return;
+}
diff --git a/src/gmp/texinfo.tex b/src/gmp/texinfo.tex
new file mode 100644
index 000000000..3e5019e1e
--- /dev/null
+++ b/src/gmp/texinfo.tex
@@ -0,0 +1,5689 @@
+% texinfo.tex -- TeX macros to handle Texinfo files.
+%
+% Load plain if necessary, i.e., if running under initex.
+\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
+%
+\def\texinfoversion{1999-03-31.13}%
+%
+% Copyright (C) 1985, 86, 88, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99
+% 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.gnu.org/pub/gnu/texinfo.tex
+%   (and all GNU mirrors, see http://www.gnu.org/order/ftp.html)
+%   ftp://tug.org/tex/texinfo.tex
+%   ftp://ctan.org/macros/texinfo/texinfo.tex
+%   (and all CTAN mirrors, finger ctan@ctan.org for a list).
+%   /home/gd/gnu/doc/texinfo.tex on the GNU machines.
+% The texinfo.tex in any given Texinfo distribution could well be out
+% of date, so if that's what you're using, please check.
+% There is a small home page for Texinfo at http://texinfo.org/.
+%
+% Send bug reports to bug-texinfo@gnu.org.  Please include including a
+% complete document in each bug report with which we can reproduce the
+% problem.  Patches are, of course, greatly appreciated.
+%
+% To process a Texinfo manual with TeX, it's most reliable to use the
+% texi2dvi shell script that comes with the distribution.  For a simple
+% manual foo.texi, however, you can get away with this:
+%   tex foo.texi
+%   texindex foo.??
+%   tex foo.texi
+%   tex foo.texi
+%   dvips foo.dvi -o # or whatever, to process the dvi file; this makes foo.ps.
+% The extra runs of TeX get the cross-reference information correct.
+% Sometimes one run after texindex suffices, and sometimes you need more
+% than two; texi2dvi does it as many times as necessary.
+%
+% It is possible to adapt texinfo.tex for other languages.  You can get
+% the existing language-specific files from ftp://ftp.gnu.org/gnu/texinfo/.
+
+\message{Loading texinfo [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]}%
+  \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
+
+% We never want plain's outer \+ definition in Texinfo.
+% For @tex, we can use \tabalign.
+\let\+ = \relax
+
+
+\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 if not already set.
+\ifx\putwordAppendix\undefined  \gdef\putwordAppendix{Appendix}\fi
+\ifx\putwordChapter\undefined   \gdef\putwordChapter{Chapter}\fi
+\ifx\putwordfile\undefined      \gdef\putwordfile{file}\fi
+\ifx\putwordin\undefined        \gdef\putwordin{in}\fi
+\ifx\putwordIndexIsEmpty\undefined     \gdef\putwordIndexIsEmpty{(Index is empty)}\fi
+\ifx\putwordIndexNonexistent\undefined \gdef\putwordIndexNonexistent{(Index is nonexistent)}\fi
+\ifx\putwordInfo\undefined      \gdef\putwordInfo{Info}\fi
+\ifx\putwordInstanceVariableof\undefined \gdef\putwordInstanceVariableof{Instance Variable of}\fi
+\ifx\putwordMethodon\undefined  \gdef\putwordMethodon{Method on}\fi
+\ifx\putwordNoTitle\undefined   \gdef\putwordNoTitle{No Title}\fi
+\ifx\putwordof\undefined        \gdef\putwordof{of}\fi
+\ifx\putwordon\undefined        \gdef\putwordon{on}\fi
+\ifx\putwordpage\undefined      \gdef\putwordpage{page}\fi
+\ifx\putwordsection\undefined   \gdef\putwordsection{section}\fi
+\ifx\putwordSection\undefined   \gdef\putwordSection{Section}\fi
+\ifx\putwordsee\undefined       \gdef\putwordsee{see}\fi
+\ifx\putwordSee\undefined       \gdef\putwordSee{See}\fi
+\ifx\putwordShortTOC\undefined  \gdef\putwordShortTOC{Short Contents}\fi
+\ifx\putwordTOC\undefined       \gdef\putwordTOC{Table of Contents}\fi
+%
+\ifx\putwordMJan\undefined \gdef\putwordMJan{January}\fi
+\ifx\putwordMFeb\undefined \gdef\putwordMFeb{February}\fi
+\ifx\putwordMMar\undefined \gdef\putwordMMar{March}\fi
+\ifx\putwordMApr\undefined \gdef\putwordMApr{April}\fi
+\ifx\putwordMMay\undefined \gdef\putwordMMay{May}\fi
+\ifx\putwordMJun\undefined \gdef\putwordMJun{June}\fi
+\ifx\putwordMJul\undefined \gdef\putwordMJul{July}\fi
+\ifx\putwordMAug\undefined \gdef\putwordMAug{August}\fi
+\ifx\putwordMSep\undefined \gdef\putwordMSep{September}\fi
+\ifx\putwordMOct\undefined \gdef\putwordMOct{October}\fi
+\ifx\putwordMNov\undefined \gdef\putwordMNov{November}\fi
+\ifx\putwordMDec\undefined \gdef\putwordMDec{December}\fi
+%
+\ifx\putwordDefmac\undefined    \gdef\putwordDefmac{Macro}\fi
+\ifx\putwordDefspec\undefined   \gdef\putwordDefspec{Special Form}\fi
+\ifx\putwordDefvar\undefined    \gdef\putwordDefvar{Variable}\fi
+\ifx\putwordDefopt\undefined    \gdef\putwordDefopt{User Option}\fi
+\ifx\putwordDeftypevar\undefined\gdef\putwordDeftypevar{Variable}\fi
+\ifx\putwordDeffunc\undefined   \gdef\putwordDeffunc{Function}\fi
+\ifx\putwordDeftypefun\undefined\gdef\putwordDeftypefun{Function}\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}%
+\ifx\eTeXversion\undefined
+\def\loggingall{\tracingcommands2 \tracingstats2
+   \tracingpages1 \tracingoutput1 \tracinglostchars1
+   \tracingmacros2 \tracingparagraphs1 \tracingrestores1
+   \showboxbreadth\maxdimen\showboxdepth\maxdimen
+}%
+\else
+\def\loggingall{\tracingcommands3 \tracingstats2
+   \tracingpages1 \tracingoutput1 \tracinglostchars1
+   \tracingmacros2 \tracingparagraphs1 \tracingrestores1
+   \tracingscantokens1 \tracingassigns1 \tracingifs1
+   \tracinggroups1 \tracingnesting2
+   \showboxbreadth\maxdimen\showboxdepth\maxdimen
+}%
+\fi
+
+% 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\outerhsize \newdimen\outervsize % set by the paper size routines
+\newdimen\cornerlong  \cornerlong=1pc
+\newdimen\cornerthick \cornerthick=.3pt
+\newdimen\topandbottommargin \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
+        \vskip-\topandbottommargin
+        \vtop to0pt{%
+          \line{\ewtop\hfil\ewtop}%
+          \nointerlineskip
+          \line{%
+            \vbox{\moveleft\cornerthick\nstop}%
+            \hfill
+            \vbox{\moveright\cornerthick\nstop}%
+          }%
+          \vss}%
+        \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
+        \vbox to0pt{\vss
+          \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; press 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{Press 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\char64}}
+
+% 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\char123}}
+\def\myrbrace {{\tt\char125}}
+\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
+}
+
+% 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\ }
+}
+
+% @: 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\nobreak
+%\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{%
+  \leavevmode
+  \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{%
+  \leavevmode
+  \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{\begingroup \catcode`\^^M=\other%
+\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other%
+\commentxxx}
+{\catcode`\^^M=\other \gdef\commentxxx#1^^M{\endgroup}}
+
+\let\c=\comment
+
+% @paragraphindent NCHARS
+% We'll use ems for NCHARS, close enough.
+% We cannot implement @paragraphindent asis, though.
+% 
+\def\asisword{asis} % no translation, these are keywords
+\def\noneword{none}
+%
+\def\paragraphindent{\parsearg\doparagraphindent}
+\def\doparagraphindent#1{%
+  \def\temp{#1}%
+  \ifx\temp\asisword
+  \else
+    \ifx\temp\noneword
+      \defaultparindent = 0pt
+    \else
+      \defaultparindent = #1em
+    \fi
+  \fi
+  \parindent = \defaultparindent
+}
+
+% @exampleindent NCHARS
+% We'll use ems for NCHARS like @paragraphindent.
+% It seems @exampleindent asis isn't necessary, but
+% I preserve it to make it similar to @paragraphindent.
+\def\exampleindent{\parsearg\doexampleindent}
+\def\doexampleindent#1{%
+  \def\temp{#1}%
+  \ifx\temp\asisword
+  \else
+    \ifx\temp\noneword
+      \lispnarrowing = 0pt
+    \else
+      \lispnarrowing = #1em
+    \fi
+  \fi
+}
+
+% @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}
+
+% @refill is a no-op.
+\let\refill=\relax
+
+% If working on a large document in chapters, it is convenient to
+% be able to disable indexing, cross-referencing, and contents, for test runs.
+% This is done with @novalidate (before @setfilename).
+%
+\newif\iflinks \linkstrue % by default we want the aux files.
+\let\novalidate = \linksfalse
+
+% @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{%
+   \iflinks
+     \readauxfile
+   \fi % \openindices needs to do some work in any case.
+   \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.
+}
+
+% Called from \setfilename.
+%
+\def\openindices{%
+  \newindex{cp}%
+  \newcodeindex{fn}%
+  \newcodeindex{vr}%
+  \newcodeindex{tp}%
+  \newcodeindex{ky}%
+  \newcodeindex{pg}%
+}
+
+% @bye.
+\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend}
+
+
+\message{fonts,}
+% Font-change commands.
+
+% Texinfo sort of 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\ninettsl\ttslshape{10}{900}
+\setfont\indrm\rmshape{9}{1000}
+\setfont\indit\itshape{9}{1000}
+\setfont\indsl\slshape{9}{1000}
+\let\indtt=\ninett
+\let\indttsl=\ninettsl
+\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\smartslanted#1{{\sl #1}\futurelet\next\smartitalicx}
+\def\smartitalic#1{{\it #1}\futurelet\next\smartitalicx}
+
+\let\i=\smartitalic
+\let\var=\smartslanted
+\let\dfn=\smartslanted
+\let\emph=\smartitalic
+\let\cite=\smartslanted
+
+\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}
+
+% @file, @option are the same as @samp.
+\let\file=\samp
+\let\option=\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
+  %
+  \global\def\code{\begingroup
+    \catcode`\-=\active \let-\codedash
+    \catcode`\_=\active \let_\codeunder
+    \codex
+  }
+  %
+  % If we end up with any active - characters when handling the index,
+  % just treat them as a normal -.
+  \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}
+
+% For @url, @env, @command quotes seem unnecessary, so use \code.
+\let\url=\code
+\let\env=\code
+\let\command=\code
+
+% @uref (abbreviation for `urlref') takes an optional (comma-separated)
+% second argument specifying the text to display and an optional third
+% arg as text to display instead of (rather than in addition to) the url
+% itself.  First (mandatory) arg is the url.  Perhaps eventually put in
+% a hypertex \special here.
+%
+\def\uref#1{\douref #1,,,\finish}
+\def\douref#1,#2,#3,#4\finish{%
+  \setbox0 = \hbox{\ignorespaces #3}%
+  \ifdim\wd0 > 0pt
+    \unhbox0 % third arg given, show only that
+  \else
+    \setbox0 = \hbox{\ignorespaces #2}%
+    \ifdim\wd0 > 0pt
+      \unhbox0\ (\code{#1})% second arg given, show both it and url
+    \else
+      \code{#1}% only url given, so show it
+    \fi
+  \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}
+
+% Explicit font changes: @r, @sc, undocumented @ii.
+\def\r#1{{\rm #1}}              % roman font
+\def\sc#1{{\smallcaps#1}}       % smallcaps font
+\def\ii#1{{\it #1}}             % italic font
+
+% @acronym downcases the argument and prints in smallcaps.
+\def\acronym#1{{\smallcaps \lowercase{#1}}}
+
+% @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
+
+% Do an implicit @contents or @shortcontents after @end titlepage if the
+% user says @setcontentsaftertitlepage or @setshortcontentsaftertitlepage.
+%
+\newif\ifsetcontentsaftertitlepage
+ \let\setcontentsaftertitlepage = \setcontentsaftertitlepagetrue
+\newif\ifsetshortcontentsaftertitlepage
+ \let\setshortcontentsaftertitlepage = \setshortcontentsaftertitlepagetrue
+
+\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
+   \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
+   %
+   % If they want short, they certainly want long too.
+   \ifsetshortcontentsaftertitlepage
+     \shortcontents
+     \contents
+     \global\let\shortcontents = \relax
+     \global\let\contents = \relax
+   \fi
+   %
+   \ifsetcontentsaftertitlepage
+     \contents
+     \global\let\contents = \relax
+     \global\let\shortcontents = \relax
+   \fi
+   %
+   \HEADINGSon
+}
+
+\def\finishtitlepage{%
+   \vskip4pt \hrule height 2pt width \hsize
+   \vskip\titlepagebottomglue
+   \finishedtitlepagetrue
+}
+
+%%% Set up page headings and footings.
+
+\let\thispage=\folio
+
+\newtoks\evenheadline    % headline on even pages
+\newtoks\oddheadline     % headline on odd pages
+\newtoks\evenfootline    % footline on even pages
+\newtoks\oddfootline     % footline on 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\putwordMJan\or\putwordMFeb\or\putwordMMar\or\putwordMApr
+  \or\putwordMMay\or\putwordMJun\or\putwordMJul\or\putwordMAug
+  \or\putwordMSep\or\putwordMOct\or\putwordMNov\or\putwordMDec
+  \fi
+  \space\number\year}
+
+% @settitle line...  specifies the title of the document, for headings.
+% It generates no output of its own.
+\def\thistitle{\putwordNoTitle}
+\def\settitle{\parsearg\settitlezzz}
+\def\settitlezzz #1{\gdef\thistitle{#1}}
+
+
+\message{tables,}
+% 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.
+  %
+  % 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.
+    \noindent
+    % Do this with kerns and \unhbox so that if there is a footnote in
+    % the item text, it can migrate to the main vertical list and
+    % eventually be printed.
+    \nobreak\kern-\tableindent
+    \dimen0 = \itemmax  \advance\dimen0 by \itemmargin \advance\dimen0 by -\wd0
+    \unhbox0
+    \nobreak\kern\dimen0
+    \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}{}{}{}{}}
+
+% @table, @ftable, @vtable.
+\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 itemize
+  \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
+
+% #1 is the part of the @columnfraction before the decimal point, which
+% is presumably either 0 or the empty string (but we don't check, we
+% just throw it away).  #2 is the decimal part, which we use as the
+% percent of \hsize for this column.
+\def\pickupwholefraction#1.#2 {%
+  \global\advance\colcount by 1
+  \expandafter\xdef\csname col\the\colcount\endcsname{.#2\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
+      \else
+         \global\advance\colcount by 1
+         \setbox0=\hbox{#1\unskip }% 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
+      % Put the argument back for the \pickupwholefraction call, so
+      % we'll always have a period there to be parsed.
+      \def\go{\pickupwholefraction#1}%
+    \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{conditionals,}
+% 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\deftypeivar = \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}}
+
+% @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'.
+  % This @ is a catcode 12 token (that is the normal catcode of @ in
+  % this texinfo.tex file).  We change the catcode of @ below to match.
+  \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
+  %
+  % We must not have @c interpreted as a control sequence.
+  \catcode`\@ = 12
+  %
+  % Make the letter c a comment character so that the rest of the line
+  % will be ignored. This way, the document can have (for example)
+  %   @c @end ifinfo
+  % and the @end ifinfo will be properly ignored.
+  % (We've just changed @ to catcode 12.)
+  \catcode`\c = 14
+  %
+  % 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.org/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}}%
+    % Do not execute macro definitions.
+    % `c' is a comment character, so the word `macro' will get cut off.
+    \def\macro{\doignore{ma}}%
+}
+
+% @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.
+{
+  \catcode`\_ = \active
+  %
+  % We might end up with active _ or - characters in the argument if
+  % we're called from @code, as @code{@value{foo-bar_}}.  So \let any
+  % such active characters to their normal equivalents.
+  \gdef\value{\begingroup
+    \catcode`\-=12 \catcode`\_=12
+    \indexbreaks \let_\normalunderscore
+    \valuexxx}
+}
+\def\valuexxx#1{\expandablevalue{#1}\endgroup}
+
+% We have this subroutine so that we can handle at least some @value's
+% properly in indexes (we \let\value to this in \indexdummies).  Ones
+% whose names contain - or _ still won't work, but we can't do anything
+% about that.  The command has to be fully expandable, since the result
+% winds up in the index file.  This means that if the variable's value
+% contains other Texinfo commands, it's almost certain it will fail
+% (although perhaps we could fix that with sufficient work to do a
+% one-level expansion on the result, instead of complete).
+%
+\def\expandablevalue#1{%
+  \expandafter\ifx\csname SET#1\endcsname\relax
+    {[No value for ``#1'']}%
+  \else
+    \csname SET#1\endcsname
+  \fi
+}
+
+% @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}
+
+% @defininfoenclose.
+\let\definfoenclose=\comment
+
+
+\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{%
+  \iflinks
+    \expandafter\newwrite \csname#1indfile\endcsname
+    \openout \csname#1indfile\endcsname \jobname.#1 % Open the file
+  \fi
+  \expandafter\xdef\csname#1index\endcsname{%     % Define @#1index
+    \noexpand\doindex{#1}}
+}
+
+% @defindex foo  ==  \newindex{foo}
+
+\def\defindex{\parsearg\newindex}
+
+% Define @defcodeindex, like @defindex except put all entries in @code.
+
+\def\newcodeindex#1{%
+  \iflinks
+    \expandafter\newwrite \csname#1indfile\endcsname
+    \openout \csname#1indfile\endcsname \jobname.#1
+  \fi
+  \expandafter\xdef\csname#1index\endcsname{%
+    \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.
+% The \closeout helps reduce unnecessary open files; the limit on the
+% Acorn RISC OS is a mere 16 files.
+\def\synindex#1 #2 {%
+  \expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname
+  \expandafter\closeout\csname#1indfile\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\closeout\csname#1indfile\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{%
+\def\ { }%
+% 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.
+% Need these in case \tex is in effect and \{ is a \delimiter again.
+% But can't use \lbracecmd and \rbracecmd because texindex assumes
+% braces and backslashes are used only as delimiters.
+\let\{ = \mylbrace
+\let\} = \myrbrace
+\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\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\uref##1{\realbackslash uref {##1}}%
+\def\url##1{\realbackslash url {##1}}%
+\def\env##1{\realbackslash env {##1}}%
+\def\command##1{\realbackslash command {##1}}%
+\def\option##1{\realbackslash option {##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\acronym##1{\realbackslash acronym {##1}}%
+%
+% Handle some cases of @value -- where the variable name does not
+% contain - or _, and the value does not contain any
+% (non-fully-expandable) commands.
+\let\value = \expandablevalue
+%
+\unsepspaces
+% Turn off macro expansion
+\turnoffmacros
+}
+
+% 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\url=\indexdummyfont
+\let\uref=\indexdummyfont
+\let\env=\indexdummyfont
+\let\command=\indexdummyfont
+\let\option=\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 % put index entries in margin (undocumented)?
+
+% For \ifx comparisons.
+\def\emptymacro{\empty}
+
+% Most index entries go through here, but \dosubind is the general case.
+%
+\def\doind#1#2{\dosubind{#1}{#2}\empty}
+
+% Workhorse for all \fooindexes.
+% #1 is name of index, #2 is stuff to put there, #3 is subentry --
+% \empty if called from \doind, as we usually are.  The main exception
+% is with defuns, which call us directly.
+%
+\def\dosubind#1#2#3{%
+  % 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.
+        %
+        \def\thirdarg{#3}%
+        %
+        % If third arg is present, precede it with space in sort key.
+        \ifx\thirdarg\emptymacro
+          \let\subentry = \empty
+        \else
+          \def\subentry{ #3}%
+        \fi
+        %
+        % First process the index entry with all font commands turned
+        % off to get the string to sort by.
+        {\indexnofonts \xdef\indexsorttmp{#2\subentry}}%
+        %
+        % Now the real index entry with the fonts.
+        \toks0 = {#2}%
+        %
+        % If third (subentry) arg is present, add it to the index
+        % string.  And include a space.
+        \ifx\thirdarg\emptymacro \else
+          \toks0 = \expandafter{\the\toks0 \space #3}%
+        \fi
+        %
+        % Set up the complete index entry, with both the sort key
+        % and the original text, including any font commands.  We write
+        % three arguments to \entry to the .?? file, texindex reduces to
+        % two when writing the .??s sorted result.
+        \edef\temp{%
+          \write\csname#1indfile\endcsname{%
+            \realbackslash entry{\indexsorttmp}{\folio}{\the\toks0}}%
+        }%
+        %
+        % If a skip is the last thing on the list now, preserve it
+        % by backing up by \lastskip, doing the \write, then inserting
+        % the skip again.  Otherwise, the whatsit generated by the
+        % \write will make \lastskip zero.  The result is that sequences
+        % like this:
+        % @end defun
+        % @tindex whatever
+        % @defun ...
+        % will have extra space inserted, because the \medbreak in the
+        % start of the @defun won't see the skip inserted by the @end of
+        % the previous defun.
+        %
+        % But don't do any of this if we're not in vertical mode.  We
+        % don't want to do a \vskip and prematurely end a paragraph.
+        %
+        % Avoid page breaks due to these extra skips, too.
+        %
+        \iflinks
+          \ifvmode
+            \skip0 = \lastskip
+            \ifdim\lastskip = 0pt \else \nobreak\vskip-\lastskip \fi
+          \fi
+          %
+          \temp % do the write
+          %
+          %
+          \ifvmode \ifdim\skip0 = 0pt \else \nobreak\vskip\skip0 \fi \fi
+        \fi
+      }%
+    }%
+    \penalty\count255
+  }%
+}
+
+% 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.
+    \putwordIndexNonexistent
+  \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
+      \putwordIndexIsEmpty
+    \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.
+
+\def\initial#1{{%
+  % Some minor font changes for the special characters.
+  \let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt
+  %
+  % Remove any glue we may have, we'll be inserting our own.
+  \removelastskip
+  %
+  % We like breaks before the index initials, so insert a bonus.
+  \penalty -300
+  %
+  % Typeset the initial.  Making this add up to a whole number of
+  % baselineskips increases the chance of the dots lining up from column
+  % to column.  It still won't often be perfect, because of the stretch
+  % we need before each entry, but it's better.
+  %
+  % No shrink because it confuses \balancecolumns.
+  \vskip 1.67\baselineskip plus .5\baselineskip
+  \leftline{\secbf #1}%
+  \vskip .33\baselineskip plus .1\baselineskip
+  %
+  % Do our best not to break after the initial.
+  \nobreak
+}}
+
+% 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
+  %
+  % A bit of stretch before each entry for the benefit of balancing columns.
+  \vskip 0pt plus1pt
+  %
+  % 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 = {%
+    %
+    % 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 just ship out what is in \partialpage with the normal
+    % output routine.  Generally, \partialpage will be empty when this
+    % runs and this will be a no-op.  See the indexspread.tex test case.
+    \ifvoid\partialpage \else
+      \onepageout{\pagecontents\partialpage}%
+    \fi
+    %
+    \global\setbox\partialpage = \vbox{%
+      % Unvbox the main output page.
+      \unvbox\PAGE
+      \kern-\topskip \kern\baselineskip
+    }%
+  }%
+  \eject % run that output routine to set \partialpage
+  %
+  % 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.)
+  \advance\vsize by -\ht\partialpage
+  \vsize = 2\vsize
+}
+
+% The double-column output routine for all double-column pages except
+% the last.
+%
+\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@ = \vsize
+  \divide\dimen@ by 2
+  %
+  % 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, in box0 and box2.
+  \unvbox\partialpage
+  %
+  \hsize = \doublecolumnhsize
+  \wd0=\hsize \wd2=\hsize
+  \hbox to\pagewidth{\box0\hfil\box2}%
+}
+\def\enddoublecolumns{%
+  \output = {%
+    % Split the last of the double-column material.  Leave it on the
+    % current page, no automatic page break.
+    \balancecolumns
+    %
+    % If we end up splitting too much material for the current page,
+    % though, there will be another page break right after this \output
+    % invocation ends.  Having called \balancecolumns once, we do not
+    % want to call it again.  Therefore, reset \output to its normal
+    % definition right away.  (We hope \balancecolumns will never be
+    % called on to balance too much material, but if it is, this makes
+    % the output somewhat more palatable.)
+    \global\output = {\onepageout{\pagecontents\PAGE}}%
+  }%
+  \eject
+  \endgroup % started in \begindoublecolumns
+  %
+  % \pagegoal was set to the doubled \vsize above, since we restarted
+  % the current page.  We're now back to normal single-column
+  % typesetting, so reset \pagegoal to the normal \vsize (after the
+  % \endgroup where \vsize got restored).
+  \pagegoal = \vsize
+}
+\def\balancecolumns{%
+  % Called at the end of the double column material.
+  \setbox0 = \vbox{\unvbox255}% like \box255 but more efficient, see p.120.
+  \dimen@ = \ht0
+  \advance\dimen@ by \topskip
+  \advance\dimen@ by-\baselineskip
+  \divide\dimen@ by 2 % target to split to
+  %debug\message{final 2-column material height=\the\ht0, target=\the\dimen@.}%
+  \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@ by 1pt
+    \repeat
+  }%
+  %debug\message{split to \the\dimen@, column heights: \the\ht1, \the\ht3.}%
+  \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\appendixno}
+
+% Each @chapter defines this as the name of the chapter.
+% page headings and footings can use it.  @section does likewise.
+\def\thischapter{}
+\def\thissection{}
+
+\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
+}
+
+% @chapter, @appendix, @unnumbered.
+\def\thischaptername{No Chapter Title}
+\outer\def\chapter{\parsearg\chapteryyy}
+\def\chapteryyy #1{\numhead0{#1}} % normally numhead0 calls chapterzzz
+\def\chapterzzz #1{%
+\secno=0 \subsecno=0 \subsubsecno=0
+\global\advance \chapno by 1 \message{\putwordChapter\space \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}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash chapentry{\the\toks0}%
+                                  {\the\chapno}}}%
+\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{%
+\secno=0 \subsecno=0 \subsubsecno=0
+\global\advance \appendixno by 1
+\message{\putwordAppendix\space \appendixletter}%
+\chapmacro {#1}{\putwordAppendix{} \appendixletter}%
+\gdef\thissection{#1}%
+\gdef\thischaptername{#1}%
+\xdef\thischapter{\putwordAppendix{} \appendixletter: \noexpand\thischaptername}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash chapentry{\the\toks0}%
+                       {\putwordAppendix{} \appendixletter}}}%
+\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}}}
+
+% @top is like @unnumbered.
+\outer\def\top{\parsearg\unnumberedyyy}
+
+\outer\def\unnumbered{\parsearg\unnumberedyyy}
+\def\unnumberedyyy #1{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz
+\def\unnumberedzzz #1{%
+\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 <toks register>.  (We also do this for
+% the toc entries.)
+\toks0 = {#1}\message{(\the\toks0)}%
+%
+\unnumbchapmacro {#1}%
+\gdef\thischapter{#1}\gdef\thissection{#1}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash unnumbchapentry{\the\toks0}}}%
+\temp
+\unnumbnoderef
+\global\let\section = \unnumberedsec
+\global\let\subsection = \unnumberedsubsec
+\global\let\subsubsection = \unnumberedsubsubsec
+}
+
+% Sections.
+\outer\def\numberedsec{\parsearg\secyyy}
+\def\secyyy #1{\numhead1{#1}} % normally calls seczzz
+\def\seczzz #1{%
+\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 %
+\gdef\thissection{#1}\secheading {#1}{\the\chapno}{\the\secno}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash secentry{\the\toks0}%
+                                  {\the\chapno}{\the\secno}}}%
+\temp
+\donoderef
+\nobreak
+}
+
+\outer\def\appendixsection{\parsearg\appendixsecyyy}
+\outer\def\appendixsec{\parsearg\appendixsecyyy}
+\def\appendixsecyyy #1{\apphead1{#1}} % normally calls appendixsectionzzz
+\def\appendixsectionzzz #1{%
+\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 %
+\gdef\thissection{#1}\secheading {#1}{\appendixletter}{\the\secno}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash secentry{\the\toks0}%
+                                  {\appendixletter}{\the\secno}}}%
+\temp
+\appendixnoderef
+\nobreak
+}
+
+\outer\def\unnumberedsec{\parsearg\unnumberedsecyyy}
+\def\unnumberedsecyyy #1{\unnmhead1{#1}} % normally calls unnumberedseczzz
+\def\unnumberedseczzz #1{%
+\plainsecheading {#1}\gdef\thissection{#1}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash unnumbsecentry{\the\toks0}}}%
+\temp
+\unnumbnoderef
+\nobreak
+}
+
+% Subsections.
+\outer\def\numberedsubsec{\parsearg\numberedsubsecyyy}
+\def\numberedsubsecyyy #1{\numhead2{#1}} % normally calls numberedsubseczzz
+\def\numberedsubseczzz #1{%
+\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 %
+\subsecheading {#1}{\the\chapno}{\the\secno}{\the\subsecno}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash subsecentry{\the\toks0}%
+                                    {\the\chapno}{\the\secno}{\the\subsecno}}}%
+\temp
+\donoderef
+\nobreak
+}
+
+\outer\def\appendixsubsec{\parsearg\appendixsubsecyyy}
+\def\appendixsubsecyyy #1{\apphead2{#1}} % normally calls appendixsubseczzz
+\def\appendixsubseczzz #1{%
+\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 %
+\subsecheading {#1}{\appendixletter}{\the\secno}{\the\subsecno}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash subsecentry{\the\toks0}%
+                                {\appendixletter}{\the\secno}{\the\subsecno}}}%
+\temp
+\appendixnoderef
+\nobreak
+}
+
+\outer\def\unnumberedsubsec{\parsearg\unnumberedsubsecyyy}
+\def\unnumberedsubsecyyy #1{\unnmhead2{#1}} %normally calls unnumberedsubseczzz
+\def\unnumberedsubseczzz #1{%
+\plainsubsecheading {#1}\gdef\thissection{#1}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash unnumbsubsecentry%
+                                    {\the\toks0}}}%
+\temp
+\unnumbnoderef
+\nobreak
+}
+
+% Subsubsections.
+\outer\def\numberedsubsubsec{\parsearg\numberedsubsubsecyyy}
+\def\numberedsubsubsecyyy #1{\numhead3{#1}} % normally numberedsubsubseczzz
+\def\numberedsubsubseczzz #1{%
+\gdef\thissection{#1}\global\advance \subsubsecno by 1 %
+\subsubsecheading {#1}
+  {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash subsubsecentry{\the\toks0}%
+  {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}}}%
+\temp
+\donoderef
+\nobreak
+}
+
+\outer\def\appendixsubsubsec{\parsearg\appendixsubsubsecyyy}
+\def\appendixsubsubsecyyy #1{\apphead3{#1}} % normally appendixsubsubseczzz
+\def\appendixsubsubseczzz #1{%
+\gdef\thissection{#1}\global\advance \subsubsecno by 1 %
+\subsubsecheading {#1}
+  {\appendixletter}{\the\secno}{\the\subsecno}{\the\subsubsecno}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash subsubsecentry{\the\toks0}%
+  {\appendixletter}{\the\secno}{\the\subsecno}{\the\subsubsecno}}}%
+\temp
+\appendixnoderef
+\nobreak
+}
+
+\outer\def\unnumberedsubsubsec{\parsearg\unnumberedsubsubsecyyy}
+\def\unnumberedsubsubsecyyy #1{\unnmhead3{#1}} %normally unnumberedsubsubseczzz
+\def\unnumberedsubsubseczzz #1{%
+\plainsubsubsecheading {#1}\gdef\thissection{#1}%
+\toks0 = {#1}%
+\edef\temp{\noexpand\writetocentry{\realbackslash unnumbsubsubsecentry%
+                                    {\the\toks0}}}%
+\temp
+\unnumbnoderef
+\nobreak
+}
+
+% 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\nobreak
+}
+
+\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\nobreak
+}
+
+\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,}
+\newwrite\tocfile
+
+% Write an entry to the toc file, opening it if necessary.
+% Called from @chapter, etc.  We supply {\folio} at the end of the
+% argument, which will end up as the last argument to the \...entry macro.
+%
+% We open the .toc file here instead of at @setfilename or any other
+% given time so that @contents can be put in the document anywhere.
+%
+\newif\iftocfileopened
+\def\writetocentry#1{%
+  \iftocfileopened\else
+    \immediate\openout\tocfile = \jobname.toc
+    \global\tocfileopenedtrue
+  \fi
+  \iflinks \write\tocfile{#1{\folio}}\fi
+}
+
+\newskip\contentsrightmargin \contentsrightmargin=1in
+\newcount\savepageno
+\newcount\lastnegativepageno \lastnegativepageno = -1
+
+% Finish up the main text and prepare to read what we've written
+% to \tocfile.
+%
+\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\tocfile
+   %
+   % Don't need to put `Contents' or `Short Contents' in the headline.
+   % It is abundantly clear what they are.
+   \unnumbchapmacro{#1}\def\thischapter{}%
+   \savepageno = \pageno
+   \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.
+      %
+      % Roman numerals for page numbers.
+      \ifnum \pageno>0 \pageno = \lastnegativepageno \fi
+}
+
+
+% Normal (long) toc.
+\def\contents{%
+   \startcontents{\putwordTOC}%
+     \openin 1 \jobname.toc
+     \ifeof 1 \else
+       \closein 1
+       \input \jobname.toc
+     \fi
+     \vfill \eject
+     \contentsalignmacro % in case @setchapternewpage odd is in effect
+   \endgroup
+   \lastnegativepageno = \pageno
+   \pageno = \savepageno
+}
+
+% And just the chapters.
+\def\summarycontents{%
+   \startcontents{\putwordShortTOC}%
+      %
+      \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{}
+      \openin 1 \jobname.toc
+      \ifeof 1 \else
+        \closein 1
+        \input \jobname.toc
+      \fi
+     \vfill \eject
+     \contentsalignmacro % in case @setchapternewpage odd is in effect
+   \endgroup
+   \lastnegativepageno = \pageno
+   \pageno = \savepageno
+}
+\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\+=\tabalign
+  \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 ... @end cartouche: draw rectangle w/rounded corners around
+% environment contents.
+\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 18.4pt % allow for 3pt kerns on either
+%                                    side, and for 6pt waste from
+%                                    each corner char, and rule thickness
+        \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
+}
+
+% Define the \E... control sequence only if we are inside the particular
+% environment, so the error checking in \end will work.
+%
+% To end 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}
+
+% @lisp: indented, narrowed, typewriter font.
+\def\lisp{\begingroup
+  \nonfillstart
+  \let\Elisp = \nonfillfinish
+  \tt
+  \let\kbdfont = \kbdexamplefont % Allow @kbd to do something special.
+  \gobble       % eat return
+}
+
+% @example: Same as @lisp.
+\def\example{\begingroup \def\Eexample{\nonfillfinish\endgroup}\lisp}
+
+% @small... is usually equivalent to the non-small (@smallbook
+% redefines).  We must call \example (or whatever) last in the
+% definition, since it reads the return following the @example (or
+% whatever) command.
+%
+% This actually allows (for example) @end display inside an
+% @smalldisplay.  Too bad, but makeinfo will catch the error anyway.
+%
+\def\smalldisplay{\begingroup\def\Esmalldisplay{\nonfillfinish\endgroup}\display}
+\def\smallexample{\begingroup\def\Esmallexample{\nonfillfinish\endgroup}\lisp}
+\def\smallformat{\begingroup\def\Esmallformat{\nonfillfinish\endgroup}\format}
+\def\smalllisp{\begingroup\def\Esmalllisp{\nonfillfinish\endgroup}\lisp}
+
+% Real @smallexample and @smalllisp (when @smallbook): use smaller fonts.
+% Originally contributed by Pavel@xerox.
+\def\smalllispx{\begingroup
+  \def\Esmalllisp{\nonfillfinish\endgroup}%
+  \def\Esmallexample{\nonfillfinish\endgroup}%
+  \indexfonts
+  \lisp
+}
+
+% @display: same as @lisp except keep current font.
+%
+\def\display{\begingroup
+  \nonfillstart
+  \let\Edisplay = \nonfillfinish
+  \gobble
+}
+
+% @smalldisplay (when @smallbook): @display plus smaller fonts.
+%
+\def\smalldisplayx{\begingroup
+  \def\Esmalldisplay{\nonfillfinish\endgroup}%
+  \indexfonts \rm
+  \display
+}
+
+% @format: same as @display except don't narrow margins.
+%
+\def\format{\begingroup
+  \let\nonarrowing = t
+  \nonfillstart
+  \let\Eformat = \nonfillfinish
+  \gobble
+}
+
+% @smallformat (when @smallbook): @format plus smaller fonts.
+%
+\def\smallformatx{\begingroup
+  \def\Esmallformat{\nonfillfinish\endgroup}%
+  \indexfonts \rm
+  \format
+}
+
+% @flushleft (same as @format).
+%
+\def\flushleft{\begingroup \def\Eflushleft{\nonfillfinish\endgroup}\format}
+
+% @flushright.
+%
+\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\&#1}\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 }
+\let\ampnr = \&
+\def\lbrb{{\bf\char`\[}}
+\def\rbrb{{\bf\char`\]}}
+
+% Active &'s sneak into the index arguments, so make sure it's defined.
+{
+  \catcode`& = 13
+  \global\let& = \ampnr
+}
+
+% 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
+\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
+\rlap{\rightline{{\rm #2}\hskip -1.25pc }}}%
+% 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
+\exdentamount=\defbodyindent
+\begingroup %
+\catcode 61=\active % 61 is `='
+\obeylines\activeparens\spacesplit#3}
+
+% #1 is the \E... control sequence to end the definition (which we define).
+% #2 is the \...x control sequence for consecutive fns (which we define).
+% #3 is the control sequence to call to resume processing.
+% #4, delimited by the space, is the class name.
+%
+\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
+\exdentamount=\defbodyindent
+\begingroup\obeylines\activeparens\spacesplit{#3{#4}}}
+
+% @deftypemethod has an extra argument that nothing else does.  Sigh.
+% #1 is the \E... control sequence to end the definition (which we define).
+% #2 is the \...x control sequence for consecutive fns (which we define).
+% #3 is the control sequence to call to resume processing.
+% #4, delimited by the space, is the class name.
+% #5 is the method's return type.
+%
+\def\deftypemethparsebody#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 {\begingroup\obeylines\activeparens\spacesplit{#3{##1}{##2}}}%
+\parindent=0in
+\advance\leftskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup\obeylines\activeparens\spacesplit{#3{#4}{#5}}}
+
+\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
+\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
+\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
+  \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
+\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\nobreak\vskip -\parskip\nobreak
+}
+
+\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\nobreak\vskip -\parskip\nobreak
+}
+
+% 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}{\putwordDeffunc}%
+\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}{\putwordDeftypefun}%
+\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}{\putwordDefmac}%
+\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}{\putwordDefspec}%
+\defunargs {#2}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @defop CATEGORY CLASS OPERATION ARG...
+%
+\def\defop #1 {\def\defoptype{#1}%
+\defopparsebody\Edefop\defopx\defopheader\defoptype}
+%
+\def\defopheader #1#2#3{%
+\dosubind {fn}{\code{#2}}{\putwordon\ #1}% Make entry in function index
+\begingroup\defname {#2}{\defoptype\ \putwordon\ #1}%
+\defunargs {#3}\endgroup %
+}
+
+% @deftypemethod CLASS RETURN-TYPE METHOD ARG...
+%
+\def\deftypemethod{%
+  \deftypemethparsebody\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{%
+  \dosubind{fn}{\code{#3}}{\putwordon\ \code{#1}}% entry in function index
+  \begingroup
+    \defname{\defheaderxcond#2\relax$$$#3}{\putwordMethodon\ \code{#1}}%
+    \deftypefunargs{#4}%
+  \endgroup
+}
+
+% @deftypeivar CLASS TYPE VARNAME
+%
+\def\deftypeivar{%
+  \deftypemethparsebody\Edeftypeivar\deftypeivarx\deftypeivarheader}
+%
+% #1 is the class name, #2 the data type, #3 the variable name.
+\def\deftypeivarheader#1#2#3{%
+  \dosubind{vr}{\code{#3}}{\putwordof\ \code{#1}}% entry in variable index
+  \begingroup
+    \defname{#3}{\putwordInstanceVariableof\ \code{#1}}%
+    \defvarargs{#3}%
+  \endgroup
+}
+
+% @defmethod == @defop Method
+%
+\def\defmethod{\defmethparsebody\Edefmethod\defmethodx\defmethodheader}
+%
+% #1 is the class name, #2 the method name, #3 the args.
+\def\defmethodheader#1#2#3{%
+  \dosubind{fn}{\code{#2}}{\putwordon\ \code{#1}}% entry in function index
+  \begingroup
+    \defname{#2}{\putwordMethodon\ \code{#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}}{\putwordof\ #1}% Make entry in var index
+\begingroup\defname {#2}{\defcvtype\ \putwordof\ #1}%
+\defvarargs {#3}\endgroup %
+}
+
+% @defivar CLASS VARNAME == @defcv {Instance Variable} CLASS VARNAME
+%
+\def\defivar{\defvrparsebody\Edefivar\defivarx\defivarheader}
+%
+\def\defivarheader#1#2#3{%
+  \dosubind {vr}{\code{#2}}{\putwordof\ #1}% entry in var index
+  \begingroup
+    \defname{#2}{\putwordInstanceVariableof\ #1}%
+    \defvarargs{#3}%
+  \endgroup
+}
+
+% @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\nobreak\vskip -\parskip\nobreak}
+
+% @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}{\putwordDefvar}%
+\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}{\putwordDefopt}%
+\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}{\putwordDeftypevar}%
+\interlinepenalty=10000
+\endgraf\nobreak\vskip -\parskip\nobreak
+\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\nobreak\vskip -\parskip\nobreak
+\endgroup}
+
+% 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}
+
+% These definitions are used if you use @defunx (etc.)
+% anywhere other than immediately after a @defun or @defunx.
+% 
+\def\defcvx#1 {\errmessage{@defcvx in invalid context}}
+\def\deffnx#1 {\errmessage{@deffnx in invalid context}}
+\def\defivarx#1 {\errmessage{@defivarx in invalid context}}
+\def\defmacx#1 {\errmessage{@defmacx in invalid context}}
+\def\defmethodx#1 {\errmessage{@defmethodx in invalid context}}
+\def\defoptx #1 {\errmessage{@defoptx in invalid context}}
+\def\defopx#1 {\errmessage{@defopx in invalid context}}
+\def\defspecx#1 {\errmessage{@defspecx in invalid context}}
+\def\deftpx#1 {\errmessage{@deftpx in invalid context}}
+\def\deftypefnx#1 {\errmessage{@deftypefnx in invalid context}}
+\def\deftypefunx#1 {\errmessage{@deftypefunx in invalid context}}
+\def\deftypeivarx#1 {\errmessage{@deftypeivarx in invalid context}}
+\def\deftypemethodx#1 {\errmessage{@deftypemethodx in invalid context}}
+\def\deftypevarx#1 {\errmessage{@deftypevarx in invalid context}}
+\def\deftypevrx#1 {\errmessage{@deftypevrx in invalid context}}
+\def\defunx#1 {\errmessage{@defunx in invalid context}}
+\def\defvarx#1 {\errmessage{@defvarx in invalid context}}
+\def\defvrx#1 {\errmessage{@defvrx in invalid context}}
+
+
+\message{macros,}
+% @macro.
+
+% To do this right we need a feature of e-TeX, \scantokens,
+% which we arrange to emulate with a temporary file in ordinary TeX.
+\ifx\eTeXversion\undefined
+ \newwrite\macscribble
+ \def\scanmacro#1{%
+   \begingroup \newlinechar`\^^M
+   % Undo catcode changes of \startcontents and \doprintindex
+   \catcode`\@=0 \catcode`\\=12 \escapechar=`\@
+   % Append \endinput to make sure that TeX does not see the ending newline.
+   \toks0={#1\endinput}%
+   \immediate\openout\macscribble=\jobname.tmp
+   \immediate\write\macscribble{\the\toks0}%
+   \immediate\closeout\macscribble
+   \let\xeatspaces\eatspaces
+   \input \jobname.tmp
+   \endgroup
+}
+\else
+\def\scanmacro#1{%
+\begingroup \newlinechar`\^^M
+% Undo catcode changes of \startcontents and \doprintindex
+\catcode`\@=0 \catcode`\\=12 \escapechar=`\@
+\let\xeatspaces\eatspaces\scantokens{#1\endinput}\endgroup}
+\fi
+
+\newcount\paramno   % Count of parameters
+\newtoks\macname    % Macro name
+\newif\ifrecursive  % Is it recursive?
+\def\macrolist{}    % List of all defined macros in the form
+                    % \do\macro1\do\macro2...
+
+% Utility routines.
+% Thisdoes \let #1 = #2, except with \csnames.
+\def\cslet#1#2{%
+\expandafter\expandafter
+\expandafter\let
+\expandafter\expandafter
+\csname#1\endcsname
+\csname#2\endcsname}
+
+% Trim leading and trailing spaces off a string.
+% Concepts from aro-bend problem 15 (see CTAN).
+{\catcode`\@=11
+\gdef\eatspaces #1{\expandafter\trim@\expandafter{#1 }}
+\gdef\trim@ #1{\trim@@ @#1 @ #1 @ @@}
+\gdef\trim@@ #1@ #2@ #3@@{\trim@@@\empty #2 @}
+\def\unbrace#1{#1}
+\unbrace{\gdef\trim@@@ #1 } #2@{#1}
+}
+
+% Trim a single trailing ^^M off a string.
+{\catcode`\^^M=12\catcode`\Q=3%
+\gdef\eatcr #1{\eatcra #1Q^^MQ}%
+\gdef\eatcra#1^^MQ{\eatcrb#1Q}%
+\gdef\eatcrb#1Q#2Q{#1}%
+}
+
+% Macro bodies are absorbed as an argument in a context where
+% all characters are catcode 10, 11 or 12, except \ which is active
+% (as in normal texinfo). It is necessary to change the definition of \.
+
+% It's necessary to have hard CRs when the macro is executed. This is
+% done by  making ^^M (\endlinechar) catcode 12 when reading the macro
+% body, and then making it the \newlinechar in \scanmacro.
+
+\def\macrobodyctxt{%
+  \catcode`\~=12
+  \catcode`\^=12
+  \catcode`\_=12
+  \catcode`\|=12
+  \catcode`\<=12
+  \catcode`\>=12
+  \catcode`\+=12
+  \catcode`\{=12
+  \catcode`\}=12
+  \catcode`\@=12
+  \catcode`\^^M=12
+  \usembodybackslash}
+
+\def\macroargctxt{%
+  \catcode`\~=12
+  \catcode`\^=12
+  \catcode`\_=12
+  \catcode`\|=12
+  \catcode`\<=12
+  \catcode`\>=12
+  \catcode`\+=12
+  \catcode`\@=12
+  \catcode`\\=12}
+
+% \mbodybackslash is the definition of \ in @macro bodies.
+% It maps \foo\ => \csname macarg.foo\endcsname => #N
+% where N is the macro parameter number.
+% We define \csname macarg.\endcsname to be \realbackslash, so
+% \\ in macro replacement text gets you a backslash.
+
+{\catcode`@=0 @catcode`@\=@active
+ @gdef@usembodybackslash{@let\=@mbodybackslash}
+ @gdef@mbodybackslash#1\{@csname macarg.#1@endcsname}
+}
+\expandafter\def\csname macarg.\endcsname{\realbackslash}
+
+\def\macro{\recursivefalse\parsearg\macroxxx}
+\def\rmacro{\recursivetrue\parsearg\macroxxx}
+
+\def\macroxxx#1{%
+  \getargs{#1}%           now \macname is the macname and \argl the arglist
+  \ifx\argl\empty       % no arguments
+     \paramno=0%
+  \else
+     \expandafter\parsemargdef \argl;%
+  \fi
+  \if1\csname ismacro.\the\macname\endcsname
+     \message{Warning: redefining \the\macname}%
+  \else
+     \expandafter\ifx\csname \the\macname\endcsname \relax
+     \else \errmessage{The name \the\macname\space is reserved}\fi
+     \global\cslet{macsave.\the\macname}{\the\macname}%
+     \global\expandafter\let\csname ismacro.\the\macname\endcsname=1%
+     % Add the macroname to \macrolist
+     \toks0 = \expandafter{\macrolist\do}%
+     \xdef\macrolist{\the\toks0
+       \expandafter\noexpand\csname\the\macname\endcsname}%
+  \fi
+  \begingroup \macrobodyctxt
+  \ifrecursive \expandafter\parsermacbody
+  \else \expandafter\parsemacbody
+  \fi}
+
+\def\unmacro{\parsearg\unmacroxxx}
+\def\unmacroxxx#1{%
+  \if1\csname ismacro.#1\endcsname
+    \global\cslet{#1}{macsave.#1}%
+    \global\expandafter\let \csname ismacro.#1\endcsname=0%
+    % Remove the macro name from \macrolist
+    \begingroup
+      \edef\tempa{\expandafter\noexpand\csname#1\endcsname}%
+      \def\do##1{%
+        \def\tempb{##1}%
+        \ifx\tempa\tempb
+          % remove this
+        \else
+          \toks0 = \expandafter{\newmacrolist\do}%
+          \edef\newmacrolist{\the\toks0\expandafter\noexpand\tempa}%
+        \fi}%
+      \def\newmacrolist{}%
+      % Execute macro list to define \newmacrolist
+      \macrolist
+      \global\let\macrolist\newmacrolist
+    \endgroup
+  \else
+    \errmessage{Macro #1 not defined}%
+  \fi
+}
+
+% This makes use of the obscure feature that if the last token of a
+% <parameter list> is #, then the preceding argument is delimited by
+% an opening brace, and that opening brace is not consumed.
+\def\getargs#1{\getargsxxx#1{}}
+\def\getargsxxx#1#{\getmacname #1 \relax\getmacargs}
+\def\getmacname #1 #2\relax{\macname={#1}}
+\def\getmacargs#1{\def\argl{#1}}
+
+% Parse the optional {params} list.  Set up \paramno and \paramlist
+% so \defmacro knows what to do.  Define \macarg.blah for each blah
+% in the params list, to be ##N where N is the position in that list.
+% That gets used by \mbodybackslash (above).
+
+% We need to get `macro parameter char #' into several definitions.
+% The technique used is stolen from LaTeX:  let \hash be something
+% unexpandable, insert that wherever you need a #, and then redefine
+% it to # just before using the token list produced.
+%
+% The same technique is used to protect \eatspaces till just before
+% the macro is used.
+
+\def\parsemargdef#1;{\paramno=0\def\paramlist{}%
+        \let\hash\relax\let\xeatspaces\relax\parsemargdefxxx#1,;,}
+\def\parsemargdefxxx#1,{%
+  \if#1;\let\next=\relax
+  \else \let\next=\parsemargdefxxx
+    \advance\paramno by 1%
+    \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname
+        {\xeatspaces{\hash\the\paramno}}%
+    \edef\paramlist{\paramlist\hash\the\paramno,}%
+  \fi\next}
+
+% These two commands read recursive and nonrecursive macro bodies.
+% (They're different since rec and nonrec macros end differently.)
+
+\long\def\parsemacbody#1@end macro%
+{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}%
+\long\def\parsermacbody#1@end rmacro%
+{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}%
+
+% This defines the macro itself. There are six cases: recursive and
+% nonrecursive macros of zero, one, and many arguments.
+% Much magic with \expandafter here.
+% \xdef is used so that macro definitions will survive the file
+% they're defined in; @include reads the file inside a group.
+\def\defmacro{%
+  \let\hash=##% convert placeholders to macro parameter chars
+  \ifrecursive
+    \ifcase\paramno
+    % 0
+      \expandafter\xdef\csname\the\macname\endcsname{%
+        \noexpand\scanmacro{\temp}}%
+    \or % 1
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \noexpand\braceorline
+         \expandafter\noexpand\csname\the\macname xxx\endcsname}%
+      \expandafter\xdef\csname\the\macname xxx\endcsname##1{%
+         \egroup\noexpand\scanmacro{\temp}}%
+    \else % many
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \noexpand\csname\the\macname xx\endcsname}%
+      \expandafter\xdef\csname\the\macname xx\endcsname##1{%
+          \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}%
+      \expandafter\expandafter
+      \expandafter\xdef
+      \expandafter\expandafter
+        \csname\the\macname xxx\endcsname
+          \paramlist{\egroup\noexpand\scanmacro{\temp}}%
+    \fi
+  \else
+    \ifcase\paramno
+    % 0
+      \expandafter\xdef\csname\the\macname\endcsname{%
+        \noexpand\norecurse{\the\macname}%
+        \noexpand\scanmacro{\temp}\egroup}%
+    \or % 1
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \noexpand\braceorline
+         \expandafter\noexpand\csname\the\macname xxx\endcsname}%
+      \expandafter\xdef\csname\the\macname xxx\endcsname##1{%
+        \egroup
+        \noexpand\norecurse{\the\macname}%
+        \noexpand\scanmacro{\temp}\egroup}%
+    \else % many
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \expandafter\noexpand\csname\the\macname xx\endcsname}%
+      \expandafter\xdef\csname\the\macname xx\endcsname##1{%
+          \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}%
+      \expandafter\expandafter
+      \expandafter\xdef
+      \expandafter\expandafter
+      \csname\the\macname xxx\endcsname
+      \paramlist{%
+          \egroup
+          \noexpand\norecurse{\the\macname}%
+          \noexpand\scanmacro{\temp}\egroup}%
+    \fi
+  \fi}
+
+\def\norecurse#1{\bgroup\cslet{#1}{macsave.#1}}
+
+% \braceorline decides whether the next nonwhitespace character is a
+% {.  If so it reads up to the closing }, if not, it reads the whole
+% line.  Whatever was read is then fed to the next control sequence
+% as an argument (by \parsebrace or \parsearg)
+\def\braceorline#1{\let\next=#1\futurelet\nchar\braceorlinexxx}
+\def\braceorlinexxx{%
+  \ifx\nchar\bgroup\else
+    \expandafter\parsearg
+  \fi \next}
+
+% We mant to disable all macros during \shipout so that they are not
+% expanded by \write.
+\def\turnoffmacros{\begingroup \def\do##1{\let\noexpand##1=\relax}%
+  \edef\next{\macrolist}\expandafter\endgroup\next}
+
+
+% @alias.
+\def\alias#1=#2{\gdef#1{#2}}
+
+
+\message{cross references,}
+\newwrite\auxfile
+
+\newif\ifhavexrefs    % True if xref values are known.
+\newif\ifwarnedxrefs  % True if we warned once that they aren't known.
+
+% @inforef is relatively simple.
+\def\inforef #1{\inforefzzz #1,,,,**}
+\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}},
+  node \samp{\ignorespaces#1{}}}
+
+% @node's job is to define \lastnode.
+\def\node{\ENVcheck\parsearg\nodezzz}
+\def\nodezzz#1{\nodexxx [#1,]}
+\def\nodexxx[#1,#2]{\gdef\lastnode{#1}}
+\let\nwnode=\node
+\let\lastnode=\relax
+
+% The sectioning commands (@chapter, etc.) call these.
+\def\donoderef{%
+  \ifx\lastnode\relax\else
+    \expandafter\expandafter\expandafter\setref{\lastnode}%
+      {Ysectionnumberandtype}%
+    \global\let\lastnode=\relax
+  \fi
+}
+\def\unnumbnoderef{%
+  \ifx\lastnode\relax\else
+    \expandafter\expandafter\expandafter\setref{\lastnode}{Ynothing}%
+    \global\let\lastnode=\relax
+  \fi
+}
+\def\appendixnoderef{%
+  \ifx\lastnode\relax\else
+    \expandafter\expandafter\expandafter\setref{\lastnode}%
+      {Yappendixletterandtype}%
+    \global\let\lastnode=\relax
+  \fi
+}
+
+
+% @anchor{NAME} -- define xref target at arbitrary point.
+%
+{ \catcode`\@ = 11
+% From latex.ltx, to make @anchor truely invisible.
+\newdimen\@savsk
+\newcount\@savsf
+\gdef\@bsphack{\relax
+  \ifhmode \@savsk\lastskip \@savsf\spacefactor \fi
+}
+\gdef\@esphack{\relax
+  \ifhmode \spacefactor\@savsf
+    \ifdim\@savsk>\z@ \ignorespaces \fi
+  \fi
+}
+\gdef\anchor#1{\@bsphack \setref{#1}{Ynothing}\@esphack}
+}
+
+% \setref{NAME}{SNT} defines a cross-reference point NAME, namely
+% NAME-title, NAME-pg, and NAME-SNT.  Called from \foonoderef.  We have
+% to set \indexdummies so commands such as @code in a section title
+% aren't expanded.  It would be nicer not to expand the titles in the
+% first place, but there's so many layers that that is hard to do.
+%
+\def\setref#1#2{{%
+  \indexdummies
+  \dosetq{#1-title}{Ytitle}%
+  \dosetq{#1-pg}{Ypagenumber}%
+  \dosetq{#1-snt}{#2}%
+}}
+
+% @xref, @pxref, and @ref generate cross-references.  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'' \putwordin{} \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.
+    {\normalturnoffactive
+     % Only output a following space if the -snt ref is nonempty; for
+     % @unnumbered and @anchor, it won't be.
+     \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}%
+     \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi
+    }%
+    % [mynode],
+    [\printednodename],\space
+    % page 3
+    \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
+  \fi
+\endgroup}
+
+% \dosetq is the interface for calls from other macros
+
+% Use \normalturnoffactive so that punctuation chars such as underscore
+% and backslash work in node names.  (\turnoffactive doesn't do \.)
+\def\dosetq#1#2{%
+  {\let\folio=0%
+   \normalturnoffactive
+   \edef\next{\write\auxfile{\internalsetq{#1}{#2}}}%
+   \iflinks
+     \next
+   \fi
+  }%
+}
+
+% \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
+    \iflinks
+      \ifhavexrefs
+        \message{\linenumber Undefined cross reference `#1'.}%
+      \else
+        \ifwarnedxrefs\else
+          \global\warnedxrefstrue
+          \message{Cross reference values unknown; you must run TeX again.}%
+        \fi
+      \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
+  \catcode`+=\other % avoid \+ for paranoia even though we've turned it off
+  % 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
+  % Do not bother showing banner with post-v2.7 epsf.tex (available in
+  % doc/epsf.tex until it shows up on ctan).
+  \def\epsfannounce{\toks0 = }%
+  \input epsf.tex
+\fi
+%
+% We will only complain once about lack of epsf.tex.
+\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://tug.org/tex/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{%
+  \ifx\pdfoutput\undefined
+    % \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
+    \begingroup
+      \catcode`\^^M = 5 % in case we're inside an example
+      % If the image is by itself, center it.
+      \ifvmode
+        \nobreak\bigskip
+        % Usually we'll have text after the image which will insert
+        % \parskip glue, so insert it here too to equalize the space
+        % above and below. 
+        \nobreak\vskip\parskip
+        \nobreak
+        \centerline{\epsfbox{#1.eps}}%
+        \bigbreak
+      \else
+        % In the middle of a paragraph, no extra space.
+        \epsfbox{#1.eps}%
+      \fi
+    \endgroup
+  \else
+    \centerline{\pdfimage #1.pdf}%
+  \fi
+}
+
+
+\message{localization,}
+
+% @documentlanguage is usually given very early, just after
+% @setfilename.  If done too late, it may not override everything
+% properly.  Single argument is the language abbreviation.
+% It would be nice if we could set up a hyphenation file here.
+%
+\def\documentlanguage{\parsearg\dodocumentlanguage}
+\def\dodocumentlanguage#1{%
+  \tex % read txi-??.tex file in plain TeX.
+  % Read the file if it exists.
+  \openin 1 txi-#1.tex
+  \ifeof1
+    \errhelp = \nolanghelp
+    \errmessage{Cannot read language file txi-#1.tex}%
+    \let\temp = \relax
+  \else
+    \def\temp{\input txi-#1.tex }%
+  \fi
+  \temp
+  \endgroup
+}
+\newhelp\nolanghelp{The given language definition file cannot be found or
+is empty.  Maybe you need to install it?  In the current directory
+should work if nowhere else does.}
+
+
+% @documentencoding should change something in TeX eventually, most
+% likely, but for now just recognize it.
+\let\documentencoding = \comment
+
+
+% Page size parameters.
+%
+\newdimen\defaultparindent \defaultparindent = 15pt
+
+\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
+
+% Don't be so finicky about underfull hboxes, either.
+\hbadness = 2000
+
+% 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.  We call this whenever the paper size is set.
+%
+\def\setemergencystretch{%
+  \ifx\emergencystretch\thisisundefined
+    % Allow us to assign to \emergencystretch anyway.
+    \def\emergencystretch{\dimen0}%
+  \else
+    \emergencystretch = \hsize
+    \divide\emergencystretch by 40
+  \fi
+}
+
+% Parameters in order: 1) textheight; 2) textwidth; 3) voffset;
+% 4) hoffset; 5) binding offset; 6) topskip.  Then whoever calls us can
+% set \parskip and call \setleading for \baselineskip.
+%
+\def\internalpagesizes#1#2#3#4#5#6{%
+  \voffset = #3\relax
+  \topskip = #6\relax
+  \splittopskip = \topskip
+  %
+  \vsize = #1\relax
+  \advance\vsize by \topskip
+  \outervsize = \vsize
+  \advance\outervsize by 2\topandbottommargin
+  \pageheight = \vsize
+  %
+  \hsize = #2\relax
+  \outerhsize = \hsize
+  \advance\outerhsize by 0.5in
+  \pagewidth = \hsize
+  %
+  \normaloffset = #4\relax
+  \bindingoffset = #5\relax
+  %
+  \parindent = \defaultparindent
+  \setemergencystretch
+}
+
+% @letterpaper (the default).
+\def\letterpaper{{\globaldefs = 1
+  \parskip = 3pt plus 2pt minus 1pt
+  \setleading{13.2pt}%
+  %
+  % If page is nothing but text, make it come out even.
+  \internalpagesizes{46\baselineskip}{6in}{\voffset}{.25in}{\bindingoffset}{36pt}%
+}}
+
+% Use @smallbook to reset parameters for 7x9.5 (or so) format.
+\def\smallbook{{\globaldefs = 1
+  \parskip = 2pt plus 1pt
+  \setleading{12pt}%
+  %
+  \internalpagesizes{7.5in}{5.in}{\voffset}{.25in}{\bindingoffset}{16pt}%
+  %
+  \lispnarrowing = 0.3in
+  \tolerance = 700
+  \hfuzz = 1pt
+  \contentsrightmargin = 0pt
+  \deftypemargin = 0pt
+  \defbodyindent = .5cm
+  %
+  \let\smalldisplay = \smalldisplayx
+  \let\smallexample = \smalllispx
+  \let\smallformat = \smallformatx
+  \let\smalllisp = \smalllispx
+}}
+
+% Use @afourpaper to print on European A4 paper.
+\def\afourpaper{{\globaldefs = 1
+  \setleading{12pt}%
+  \parskip = 3pt plus 2pt minus 1pt
+  %
+  \internalpagesizes{53\baselineskip}{160mm}{\voffset}{4mm}{\bindingoffset}{44pt}%
+  %
+  \tolerance = 700
+  \hfuzz = 1pt
+}}
+
+% A specific text layout, 24x15cm overall, intended for A4 paper.  Top margin
+% 29mm, hence bottom margin 28mm, nominal side margin 3cm.
+\def\afourlatex{{\globaldefs = 1
+  \setleading{13.6pt}%
+  %
+  \afourpaper
+  \internalpagesizes{237mm}{150mm}{3.6mm}{3.6mm}{3mm}{7mm}%
+  %
+  \globaldefs = 0
+}}
+
+% Use @afourwide to print on European A4 paper in wide format.
+\def\afourwide{%
+  \afourpaper
+  \internalpagesizes{9.5in}{6.5in}{\hoffset}{\normaloffset}{\bindingoffset}{7mm}%
+  %
+  \globaldefs = 0
+}
+
+% @pagesizes TEXTHEIGHT[,TEXTWIDTH]
+% Perhaps we should allow setting the margins, \topskip, \parskip,
+% and/or leading, also. Or perhaps we should compute them somehow.
+%
+\def\pagesizes{\parsearg\pagesizesxxx}
+\def\pagesizesxxx#1{\pagesizesyyy #1,,\finish}
+\def\pagesizesyyy#1,#2,#3\finish{{%
+  \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \hsize=#2\relax \fi
+  \globaldefs = 1
+  %
+  \parskip = 3pt plus 2pt minus 1pt
+  \setleading{13.2pt}%
+  %
+  \internalpagesizes{#1}{\hsize}{\voffset}{\normaloffset}{\bindingoffset}{44pt}%
+}}
+
+% Set default to letter.
+%
+\letterpaper
+
+\message{and turning on texinfo input format.}
+
+% 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
+\catcode`\$=\other
+\def\normaldoublequote{"}
+\def\normaltilde{~}
+\def\normalcaret{^}
+\def\normalunderscore{_}
+\def\normalverticalbar{|}
+\def\normalless{<}
+\def\normalgreater{>}
+\def\normalplus{+}
+\def\normaldollar{$}
+
+% 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\font=0pt #1\else #2\fi}
+
+% Same as above, but check for italic font.  Actually this also catches
+% non-italic slanted fonts since it is impossible to distinguish them from
+% italic fonts.  But since this is only used by $ and it uses \sl anyway
+% this is not a problem.
+\def\ifusingit#1#2{\ifdim \fontdimen1\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\char34}}
+\let"=\activedoublequote
+\catcode`\~=\active
+\def~{{\tt\char126}}
+\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\char124}}
+\chardef \less=`\<
+\catcode`\<=\active
+\def<{{\tt \less}}
+\chardef \gtr=`\>
+\catcode`\>=\active
+\def>{{\tt \gtr}}
+\catcode`\+=\active
+\def+{{\tt \char 43}}
+\catcode`\$=\active
+\def${\ifusingit{{\sl\$}}\normaldollar}
+%\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}}
+
+% \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
+@let$=@normaldollar}
+
+@def@normalturnoffactive{@let"=@normaldoublequote
+@let\=@normalbackslash
+@let~=@normaltilde
+@let^=@normalcaret
+@let_=@normalunderscore
+@let|=@normalverticalbar
+@let<=@normalless
+@let>=@normalgreater
+@let+=@normalplus
+@let$=@normaldollar}
+
+% 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
+}
+
+% Say @foo, not \foo, in error messages.
+@escapechar = `@@
+
+% These look ok in all fonts, so just make them not special.  
+@catcode`@& = @other
+@catcode`@# = @other
+@catcode`@% = @other
+
+@c Set initial fonts.
+@textfonts
+@rm
+
+
+@c Local variables:
+@c eval: (add-hook 'write-file-hooks 'time-stamp)
+@c page-delimiter: "^\\\\message"
+@c time-stamp-start: "def\\\\texinfoversion{"
+@c time-stamp-format: "%:y-%02m-%02d.%H"
+@c time-stamp-end: "}"
+@c End:
diff --git a/src/gmp/tune/Makefile.am b/src/gmp/tune/Makefile.am
new file mode 100644
index 000000000..69cef9d52
--- /dev/null
+++ b/src/gmp/tune/Makefile.am
@@ -0,0 +1,218 @@
+## Process this file with automake to generate Makefile.in
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+
+EXTRA_DIST = alpha.asm pentium.asm sparcv9.asm hppa.asm hppa2.asm
+noinst_HEADERS = speed.h
+
+# No dependency on libgmp, so can use libgmptune instead for tune program
+EXTRA_LTLIBRARIES = libspeed.la
+libspeed_la_SOURCES = common.c time.c noop.c
+libspeed_la_DEPENDENCIES = $(SPEED_CYCLECOUNTER_OBJS)
+libspeed_la_LIBADD = $(libspeed_la_DEPENDENCIES)
+
+# Both libspeed and the programs are built static-only since static is
+# fastest and will be preferred by users who care about maximizing speed.
+#
+# Actually libtool doesn't seem to pass -static through to gcc, it only
+# chooses the ".a" versions of libtool libraries.  Rerun the gcc link
+# invocation with -static if you want a static link of libc and libm.
+#
+LDFLAGS = -static
+LDADD = libspeed.la $(top_builddir)/libgmp.la -lm
+
+EXTRA_PROGRAMS = speed speed-ext tuneup
+
+tuneup_SOURCES = tuneup.c
+tuneup_DEPENDENCIES = libspeed.la libgmptune.a
+tuneup_LDADD = $(tuneup_DEPENDENCIES) -lm
+
+# Don't know how to get tuneup$U.lo to depend on sqr_basecase.h, so just do
+# an explicit make.  A plain "make tuneup" will fail if used directly.
+tune:
+	$(MAKE) $(AM_MAKEFLAGS) sqr_basecase.h tuneup$(EXEEXT)
+	./tuneup
+
+allprogs: sqr_basecase.h $(EXTRA_PROGRAMS)
+
+
+speed_SOURCES = speed.c
+
+SQR_CLEANFILES = sqr_basecase.c sqr_basecase.h sqr_basecase.asm
+
+CLEANFILES = $(EXTRA_PROGRAMS) $(EXTRA_LTLIBRARIES) \
+	$(SQR_CLEANFILES) libgmptune.a libgmptmp.a \
+	stg.gnuplot stg.data \
+	mtg.gnuplot mtg.data \
+	fibg.gnuplot fibg.data \
+	graph.gnuplot graph.data
+
+
+# This bit like mpn/Makefile.am
+
+# COMPILE minus CC.  FIXME: Really pass *_CFLAGS to CPP?
+COMPILE_FLAGS =	\
+	$(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+
+SUFFIXES = .asm
+.asm.o:
+	$(M4) $(M4FLAGS) -DOPERATION_$* $< >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.asm.obj:
+	$(M4) $(M4FLAGS) -DOPERATION_$* `cygpath -w $<` >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.asm.lo:
+	echo "$(COMPILE_FLAGS)"
+	$(M4) $(M4FLAGS) -DPIC -DOPERATION_$* $< >tmp-$*.s
+	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	$(M4) $(M4FLAGS) -DOPERATION_$* $< >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
+	rm -f tmp-$*.s
+
+
+# Recompiled versions of $(LIBGMPTUNE_OBJS) are always used.  sqr_basecase.o
+# is replaced if it's mpn/generic/sqr_basecase.c (due to the fixed size
+# temporary array), or sqr_basecase.asm with a KARATSUBA_SQR_THRESHOLD_MAX
+# (because that says it normally works only up to KARATSUBA_SQR_THRESHOLD).
+
+SQR_GENERIC_MAX = 200
+
+LIBGMPTUNE_OBJS = \
+  mul_n.o mul_fft.o mul.o \
+  bz_divrem_n.o tdiv_qr.o fib_ui.o powm.o gcd.o gcdext.o
+
+sqr_basecase.h: libgmptune.a
+
+
+# "cp -f" is not portable (eg. it fails on SunOS)
+# "ar r" is going to be a bit fragile because there's more than one mul.o in
+# libgmp.a.
+
+libgmptune.a: $(top_builddir)/libgmp.la $(LIBGMPTUNE_OBJS)
+	rm -f libgmptmp.a
+	eval `$(LIBTOOL) --config | grep '^objdir='` ; \
+		cp $(top_builddir)/$$objdir/libgmp.a libgmptmp.a
+	$(AR) r libgmptmp.a $(LIBGMPTUNE_OBJS)
+	rm -f $(SQR_CLEANFILES)
+	echo "" >sqr_basecase.h
+	if test -f $(top_builddir)/mpn/sqr_basecase.c; then		\
+	  $(MAKE) $(AM_MAKEFLAGS) sqr-basecase-generic;			\
+        else								\
+	  if grep KARATSUBA_SQR_THRESHOLD_MAX				\
+	      $(top_builddir)/mpn/sqr_basecase.asm >/dev/null; then	\
+	    $(MAKE) $(AM_MAKEFLAGS) sqr-basecase-asm;			\
+	  fi								\
+	fi
+	$(RANLIB) libgmptmp.a
+	rm -f libgmptune.a
+	mv libgmptmp.a libgmptune.a
+
+sqr-basecase-generic:
+	cp $(top_builddir)/mpn/sqr_basecase.c .
+	$(MAKE) $(AM_MAKEFLAGS) \
+		CFLAGS='$(CFLAGS) -DKARATSUBA_SQR_THRESHOLD=$(SQR_GENERIC_MAX)' \
+		sqr_basecase.o
+	$(AR) r libgmptmp.a sqr_basecase.o
+	echo '#define KARATSUBA_SQR_MAX  $(SQR_GENERIC_MAX)' >sqr_basecase.h
+
+sqr-basecase-asm:
+	cp $(top_builddir)/mpn/sqr_basecase.asm .
+	$(MAKE) $(AM_MAKEFLAGS) \
+		M4FLAGS='$(M4FLAGS) -DKARATSUBA_SQR_THRESHOLD_OVERRIDE=KARATSUBA_SQR_THRESHOLD_MAX' \
+		sqr_basecase.o
+	ar r libgmptmp.a sqr_basecase.o
+	echo "#define KARATSUBA_SQR_MAX  `sed -n 's/def...(KARATSUBA_SQR_THRESHOLD_MAX, *\([0-9]*\))/\1/p' sqr_basecase.asm`" >sqr_basecase.h
+
+
+mul_n.o: $(top_builddir)/mpn/mul_n.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/mul_n.c
+
+mul_fft.o: $(top_builddir)/mpn/mul_fft.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/mul_fft.c
+
+mul.o: $(top_builddir)/mpn/mul.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/mul.c
+
+bz_divrem_n.o: $(top_builddir)/mpn/bz_divrem_n.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/bz_divrem_n.c
+
+tdiv_qr.o: $(top_builddir)/mpn/tdiv_qr.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/tdiv_qr.c
+
+fib_ui.o: $(top_srcdir)/mpz/fib_ui.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_srcdir)/mpz/fib_ui.c
+
+powm.o: $(top_srcdir)/mpz/powm.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_srcdir)/mpz/powm.c
+
+gcd.o: $(top_builddir)/mpn/gcd.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/gcd.c
+
+gcdext.o: $(top_builddir)/mpn/gcdext.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/gcdext.c
+
+
+
+
+# "mk" is multiplication in the karatsuba range
+# "st" is squaring in the toom-cook range, etc
+# "g" forms produce graphs
+
+mk:
+	./speed -s 5-40 -c mpn_mul_basecase mpn_kara_mul_n
+
+MTS = -s 50-150 -c
+mt:
+	./speed $(MTS) mpn_kara_mul_n mpn_toom3_mul_n | less
+mtg:
+	./speed $(MTS) -P mtg mpn_kara_mul_n mpn_toom3_mul_n
+
+sk:
+	./speed -s 5-40 -c mpn_sqr_basecase mpn_kara_sqr_n
+
+STS = -s 50-150 -c
+st:
+	./speed $(STS) mpn_kara_sqr_n mpn_toom3_sqr_n | less
+stg:
+	./speed $(STS) -P stg mpn_kara_sqr_n mpn_toom3_sqr_n
+
+bz:
+	./speed -s 5-40 -c mpn_bz_divrem_sb mpn_bz_divrem_n mpn_bz_tdiv_qr
+
+fib:
+	./speed -s 80-120 -c mpz_fib_ui
+fibg:
+	./speed -s 10-300 -P fibg mpz_fib_ui
+
+
+gcd:
+	./speed -s 1-20 -c mpn_gcd
+
+
+graph:
+	./speed -s 1-5000 -f 1.02 -P graph mpn_mul_n mpn_sqr
+	gnuplot graph.gnuplot
diff --git a/src/gmp/tune/Makefile.in b/src/gmp/tune/Makefile.in
new file mode 100644
index 000000000..53958cef4
--- /dev/null
+++ b/src/gmp/tune/Makefile.in
@@ -0,0 +1,557 @@
+# Makefile.in generated automatically by automake 1.4a from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 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 = @SHELL@
+
+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
+
+DESTDIR =
+
+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@
+INSTALL_STRIP_FLAG =
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+
+@SET_MAKE@
+build_alias = @build_alias@
+build_triplet = @build@
+host_alias = @host_alias@
+host_triplet = @host@
+target_alias = @target_alias@
+target_triplet = @target@
+AMDEP = @AMDEP@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
+CC = @CC@
+CCAS = @CCAS@
+CPP = @CPP@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+EXEEXT = @EXEEXT@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
+STRIP = @STRIP@
+U = @U@
+VERSION = @VERSION@
+gmp_srclinks = @gmp_srclinks@
+install_sh = @install_sh@
+mpn_objects = @mpn_objects@
+mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
+
+# Copyright (C) 2000 Free Software Foundation, Inc.
+#
+# This file is part of the GNU MP Library.
+#
+# The GNU MP Library is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at your
+# option) any later version.
+#
+# The GNU MP Library is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+
+
+AUTOMAKE_OPTIONS = gnu no-dependencies $(top_builddir)/ansi2knr
+
+INCLUDES = -I$(top_srcdir)
+
+EXTRA_DIST = alpha.asm pentium.asm sparcv9.asm hppa.asm hppa2.asm
+noinst_HEADERS = speed.h
+
+# No dependency on libgmp, so can use libgmptune instead for tune program
+EXTRA_LTLIBRARIES = libspeed.la
+libspeed_la_SOURCES = common.c time.c noop.c
+libspeed_la_DEPENDENCIES = $(SPEED_CYCLECOUNTER_OBJS)
+libspeed_la_LIBADD = $(libspeed_la_DEPENDENCIES)
+
+# Both libspeed and the programs are built static-only since static is
+# fastest and will be preferred by users who care about maximizing speed.
+#
+# Actually libtool doesn't seem to pass -static through to gcc, it only
+# chooses the ".a" versions of libtool libraries.  Rerun the gcc link
+# invocation with -static if you want a static link of libc and libm.
+#
+LDFLAGS = -static
+LDADD = libspeed.la $(top_builddir)/libgmp.la -lm
+
+EXTRA_PROGRAMS = speed speed-ext tuneup
+
+tuneup_SOURCES = tuneup.c
+tuneup_DEPENDENCIES = libspeed.la libgmptune.a
+tuneup_LDADD = $(tuneup_DEPENDENCIES) -lm
+
+speed_SOURCES = speed.c
+
+SQR_CLEANFILES = sqr_basecase.c sqr_basecase.h sqr_basecase.asm
+
+CLEANFILES = $(EXTRA_PROGRAMS) $(EXTRA_LTLIBRARIES) \
+	$(SQR_CLEANFILES) libgmptune.a libgmptmp.a \
+	stg.gnuplot stg.data \
+	mtg.gnuplot mtg.data \
+	fibg.gnuplot fibg.data \
+	graph.gnuplot graph.data
+
+
+# This bit like mpn/Makefile.am
+
+# COMPILE minus CC.  FIXME: Really pass *_CFLAGS to CPP?
+COMPILE_FLAGS = \
+	$(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+
+
+SUFFIXES = .asm
+
+# Recompiled versions of $(LIBGMPTUNE_OBJS) are always used.  sqr_basecase.o
+# is replaced if it's mpn/generic/sqr_basecase.c (due to the fixed size
+# temporary array), or sqr_basecase.asm with a KARATSUBA_SQR_THRESHOLD_MAX
+# (because that says it normally works only up to KARATSUBA_SQR_THRESHOLD).
+
+SQR_GENERIC_MAX = 200
+
+LIBGMPTUNE_OBJS = \
+  mul_n.o mul_fft.o mul.o \
+  bz_divrem_n.o tdiv_qr.o fib_ui.o powm.o gcd.o gcdext.o
+
+
+MTS = -s 50-150 -c
+
+STS = -s 50-150 -c
+subdir = tune
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES = 
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I..
+CPPFLAGS = @CPPFLAGS@
+LIBS = @LIBS@
+ANSI2KNR = $(top_builddir)/ansi2knr
+libspeed_la_LDFLAGS = 
+am_libspeed_la_OBJECTS =  common$U.lo time$U.lo noop$U.lo
+libspeed_la_OBJECTS =  $(am_libspeed_la_OBJECTS)
+EXTRA_PROGRAMS =  speed$(EXEEXT) speed-ext$(EXEEXT) tuneup$(EXEEXT)
+am_speed_OBJECTS =  speed$U.$(OBJEXT)
+speed_OBJECTS =  $(am_speed_OBJECTS)
+speed_LDADD = $(LDADD)
+speed_DEPENDENCIES =  libspeed.la $(top_builddir)/libgmp.la
+speed_LDFLAGS = 
+speed_ext_SOURCES = speed-ext.c
+speed_ext_OBJECTS =  speed-ext$U.$(OBJEXT)
+speed_ext_LDADD = $(LDADD)
+speed_ext_DEPENDENCIES =  libspeed.la $(top_builddir)/libgmp.la
+speed_ext_LDFLAGS = 
+am_tuneup_OBJECTS =  tuneup$U.$(OBJEXT)
+tuneup_OBJECTS =  $(am_tuneup_OBJECTS)
+tuneup_LDFLAGS = 
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CFLAGS = @CFLAGS@
+CCLD = $(CC)
+LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES =  $(libspeed_la_SOURCES) $(speed_SOURCES) speed-ext.c \
+$(tuneup_SOURCES)
+HEADERS =  $(noinst_HEADERS)
+
+DIST_COMMON =  README $(noinst_HEADERS) Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+GZIP_ENV = --best
+depcomp = 
+SOURCES = $(libspeed_la_SOURCES) $(speed_SOURCES) speed-ext.c $(tuneup_SOURCES)
+OBJECTS = $(am_libspeed_la_OBJECTS) $(am_speed_OBJECTS) speed-ext$U.$(OBJEXT) $(am_tuneup_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .asm .c .lo .o .obj
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
+	cd $(top_srcdir) && $(AUTOMAKE) --gnu tune/Makefile
+
+Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
+	cd $(top_builddir) \
+	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-compile:
+	-rm -f *.o core *.core
+	-rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+	-rm -f *.tab.c
+
+maintainer-clean-compile:
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+
+maintainer-clean-libtool:
+$(top_builddir)/ansi2knr: $(top_builddir)/ansi2knr.$(OBJEXT)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr
+
+$(top_builddir)/ansi2knr.$(OBJEXT):
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) ansi2knr.$(OBJEXT)
+
+
+mostlyclean-kr:
+	-rm -f *_.c
+
+clean-kr:
+
+distclean-kr:
+
+maintainer-clean-kr:
+
+libspeed.la: $(libspeed_la_OBJECTS) $(libspeed_la_DEPENDENCIES)
+	$(LINK)  $(libspeed_la_LDFLAGS) $(libspeed_la_OBJECTS) $(libspeed_la_LIBADD) $(LIBS)
+
+speed$(EXEEXT): $(speed_OBJECTS) $(speed_DEPENDENCIES)
+	@rm -f speed$(EXEEXT)
+	$(LINK) $(speed_LDFLAGS) $(speed_OBJECTS) $(speed_LDADD) $(LIBS)
+
+speed-ext$(EXEEXT): $(speed_ext_OBJECTS) $(speed_ext_DEPENDENCIES)
+	@rm -f speed-ext$(EXEEXT)
+	$(LINK) $(speed_ext_LDFLAGS) $(speed_ext_OBJECTS) $(speed_ext_LDADD) $(LIBS)
+
+tuneup$(EXEEXT): $(tuneup_OBJECTS) $(tuneup_DEPENDENCIES)
+	@rm -f tuneup$(EXEEXT)
+	$(LINK) $(tuneup_LDFLAGS) $(tuneup_OBJECTS) $(tuneup_LDADD) $(LIBS)
+.c.o:
+	$(COMPILE) -c $<
+.c.obj:
+	$(COMPILE) -c `cygpath -w $<`
+.c.lo:
+	$(LTCOMPILE) -c -o $@ $<
+common_.c: common.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/common.c; then echo $(srcdir)/common.c; else echo common.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > common_.c
+noop_.c: noop.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/noop.c; then echo $(srcdir)/noop.c; else echo noop.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > noop_.c
+speed_.c: speed.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/speed.c; then echo $(srcdir)/speed.c; else echo speed.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > speed_.c
+speed-ext_.c: speed-ext.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/speed-ext.c; then echo $(srcdir)/speed-ext.c; else echo speed-ext.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > speed-ext_.c
+time_.c: time.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/time.c; then echo $(srcdir)/time.c; else echo time.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > time_.c
+tuneup_.c: tuneup.c $(ANSI2KNR)
+	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/tuneup.c; then echo $(srcdir)/tuneup.c; else echo tuneup.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > tuneup_.c
+common_.$(OBJEXT) common_.lo noop_.$(OBJEXT) noop_.lo speed_.$(OBJEXT) \
+speed_.lo speed-ext_.$(OBJEXT) speed-ext_.lo time_.$(OBJEXT) time_.lo \
+tuneup_.$(OBJEXT) tuneup_.lo : $(ANSI2KNR)
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -f$$here/ID $$unique $(LISP)
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+	-rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+distdir: $(DISTFILES)
+	@for file in $(DISTFILES); do \
+	  d=$(srcdir); \
+	  if test -d $$d/$$file; then \
+	    cp -pR $$d/$$file $(distdir); \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file || :; \
+	  fi; \
+	done
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am: all-am
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am:
+install-data: install-data-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am:
+uninstall: uninstall-am
+all-am: Makefile $(HEADERS)
+all-redirect: all-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
+installdirs:
+
+
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-rm -f Makefile $(CONFIG_CLEAN_FILES)
+	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+	-rm -f Makefile.in
+mostlyclean-am:  mostlyclean-compile mostlyclean-libtool mostlyclean-kr \
+		mostlyclean-tags mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am:  clean-compile clean-libtool clean-kr clean-tags clean-generic \
+		mostlyclean-am
+
+clean: clean-am
+
+distclean-am:  distclean-compile distclean-libtool distclean-kr \
+		distclean-tags distclean-generic clean-am
+	-rm -f libtool
+
+distclean: distclean-am
+
+maintainer-clean-am:  maintainer-clean-compile maintainer-clean-libtool \
+		maintainer-clean-kr maintainer-clean-tags \
+		maintainer-clean-generic distclean-am
+	@echo "This command is intended for maintainers to use;"
+	@echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile mostlyclean-libtool distclean-libtool \
+clean-libtool maintainer-clean-libtool mostlyclean-kr distclean-kr \
+clean-kr maintainer-clean-kr tags mostlyclean-tags distclean-tags \
+clean-tags maintainer-clean-tags distdir info-am info dvi-am dvi check \
+check-am installcheck-am installcheck install-exec-am install-exec \
+install-data-am install-data install-am install uninstall-am uninstall \
+all-redirect all-am all install-strip installdirs mostlyclean-generic \
+distclean-generic clean-generic maintainer-clean-generic clean \
+mostlyclean distclean maintainer-clean
+
+
+# Don't know how to get tuneup$U.lo to depend on sqr_basecase.h, so just do
+# an explicit make.  A plain "make tuneup" will fail if used directly.
+tune:
+	$(MAKE) $(AM_MAKEFLAGS) sqr_basecase.h tuneup$(EXEEXT)
+	./tuneup
+
+allprogs: sqr_basecase.h $(EXTRA_PROGRAMS)
+.asm.o:
+	$(M4) $(M4FLAGS) -DOPERATION_$* $< >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.asm.obj:
+	$(M4) $(M4FLAGS) -DOPERATION_$* `cygpath -w $<` >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	rm -f tmp-$*.s
+.asm.lo:
+	echo "$(COMPILE_FLAGS)"
+	$(M4) $(M4FLAGS) -DPIC -DOPERATION_$* $< >tmp-$*.s
+	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
+	$(M4) $(M4FLAGS) -DOPERATION_$* $< >tmp-$*.s
+	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
+	rm -f tmp-$*.s
+
+sqr_basecase.h: libgmptune.a
+
+# "cp -f" is not portable (eg. it fails on SunOS)
+# "ar r" is going to be a bit fragile because there's more than one mul.o in
+# libgmp.a.
+
+libgmptune.a: $(top_builddir)/libgmp.la $(LIBGMPTUNE_OBJS)
+	rm -f libgmptmp.a
+	eval `$(LIBTOOL) --config | grep '^objdir='` ; \
+		cp $(top_builddir)/$$objdir/libgmp.a libgmptmp.a
+	$(AR) r libgmptmp.a $(LIBGMPTUNE_OBJS)
+	rm -f $(SQR_CLEANFILES)
+	echo "" >sqr_basecase.h
+	if test -f $(top_builddir)/mpn/sqr_basecase.c; then		\
+	  $(MAKE) $(AM_MAKEFLAGS) sqr-basecase-generic;			\
+        else								\
+	  if grep KARATSUBA_SQR_THRESHOLD_MAX				\
+	      $(top_builddir)/mpn/sqr_basecase.asm >/dev/null; then	\
+	    $(MAKE) $(AM_MAKEFLAGS) sqr-basecase-asm;			\
+	  fi								\
+	fi
+	$(RANLIB) libgmptmp.a
+	rm -f libgmptune.a
+	mv libgmptmp.a libgmptune.a
+
+sqr-basecase-generic:
+	cp $(top_builddir)/mpn/sqr_basecase.c .
+	$(MAKE) $(AM_MAKEFLAGS) \
+		CFLAGS='$(CFLAGS) -DKARATSUBA_SQR_THRESHOLD=$(SQR_GENERIC_MAX)' \
+		sqr_basecase.o
+	$(AR) r libgmptmp.a sqr_basecase.o
+	echo '#define KARATSUBA_SQR_MAX  $(SQR_GENERIC_MAX)' >sqr_basecase.h
+
+sqr-basecase-asm:
+	cp $(top_builddir)/mpn/sqr_basecase.asm .
+	$(MAKE) $(AM_MAKEFLAGS) \
+		M4FLAGS='$(M4FLAGS) -DKARATSUBA_SQR_THRESHOLD_OVERRIDE=KARATSUBA_SQR_THRESHOLD_MAX' \
+		sqr_basecase.o
+	ar r libgmptmp.a sqr_basecase.o
+	echo "#define KARATSUBA_SQR_MAX  `sed -n 's/def...(KARATSUBA_SQR_THRESHOLD_MAX, *\([0-9]*\))/\1/p' sqr_basecase.asm`" >sqr_basecase.h
+
+mul_n.o: $(top_builddir)/mpn/mul_n.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/mul_n.c
+
+mul_fft.o: $(top_builddir)/mpn/mul_fft.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/mul_fft.c
+
+mul.o: $(top_builddir)/mpn/mul.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/mul.c
+
+bz_divrem_n.o: $(top_builddir)/mpn/bz_divrem_n.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/bz_divrem_n.c
+
+tdiv_qr.o: $(top_builddir)/mpn/tdiv_qr.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/tdiv_qr.c
+
+fib_ui.o: $(top_srcdir)/mpz/fib_ui.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_srcdir)/mpz/fib_ui.c
+
+powm.o: $(top_srcdir)/mpz/powm.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_srcdir)/mpz/powm.c
+
+gcd.o: $(top_builddir)/mpn/gcd.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/gcd.c
+
+gcdext.o: $(top_builddir)/mpn/gcdext.c
+	$(COMPILE) -DTUNE_PROGRAM_BUILD=1 -c $(top_builddir)/mpn/gcdext.c
+
+# "mk" is multiplication in the karatsuba range
+# "st" is squaring in the toom-cook range, etc
+# "g" forms produce graphs
+
+mk:
+	./speed -s 5-40 -c mpn_mul_basecase mpn_kara_mul_n
+mt:
+	./speed $(MTS) mpn_kara_mul_n mpn_toom3_mul_n | less
+mtg:
+	./speed $(MTS) -P mtg mpn_kara_mul_n mpn_toom3_mul_n
+
+sk:
+	./speed -s 5-40 -c mpn_sqr_basecase mpn_kara_sqr_n
+st:
+	./speed $(STS) mpn_kara_sqr_n mpn_toom3_sqr_n | less
+stg:
+	./speed $(STS) -P stg mpn_kara_sqr_n mpn_toom3_sqr_n
+
+bz:
+	./speed -s 5-40 -c mpn_bz_divrem_sb mpn_bz_divrem_n mpn_bz_tdiv_qr
+
+fib:
+	./speed -s 80-120 -c mpz_fib_ui
+fibg:
+	./speed -s 10-300 -P fibg mpz_fib_ui
+
+gcd:
+	./speed -s 1-20 -c mpn_gcd
+
+graph:
+	./speed -s 1-5000 -f 1.02 -P graph mpn_mul_n mpn_sqr
+	gnuplot graph.gnuplot
+
+# 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/src/gmp/tune/README b/src/gmp/tune/README
new file mode 100644
index 000000000..20b4b1ce1
--- /dev/null
+++ b/src/gmp/tune/README
@@ -0,0 +1,539 @@
+
+               GMP SPEED MEASURING AND PARAMETER TUNING
+
+
+The programs in this directory are for knowledgeable users who want to make
+measurements of the speed of GMP routines on their machine, and perhaps
+tweak some settings or identify things that can be improved.
+
+The programs here are tools, not ready to run solutions.  Nothing is built
+in a normal "make all", but various Makefile targets described below exist.
+
+Relatively few systems and CPUs have been tested, so be sure to verify that
+you're getting sensible results before relying on them.
+
+
+
+
+MISCELLANEOUS NOTES
+
+Don't configure with --enable-assert when using the things here, since the
+extra code added by assertion checking may influence measurements.
+
+Some effort has been made to accommodate CPUs with direct mapped caches, but
+it will depend on TMP_ALLOC using a proper alloca, and even then it may or
+may not be enough.
+
+The sparc32/v9 addmul_1 code runs at noticeably different speeds on
+successive sizes, and this has a bad effect on the tune program's
+determinations of the multiply and square thresholds.
+
+
+
+
+
+PARAMETER TUNING
+
+The "tuneup" program runs some tests designed to find the best settings for
+various thresholds, like KARATSUBA_MUL_THRESHOLD.  Its output can be put
+into gmp-mparam.h.  The program can be built and run with
+
+        make tune
+
+If the thresholds indicated are grossly different from the values in the
+selected gmp-mparam.h then you may get a performance boost in relevant size
+ranges by changing gmp-mparam.h accordingly.
+
+If your CPU has specific tuned parameters coming from a gmp-mparam.h in one
+of the mpn subdirectories then the values from "make tune" should be
+similar.  You can submit new values if it looks like the current ones are
+out of date or wildly wrong.  But check you're on the right CPU target and
+there aren't any machine-specific effects causing a difference.
+
+It's hoped the compiler and options used won't have too much effect on
+thresholds, since for most CPUs they ultimately come down to comparisons
+between assembler subroutines.  Missing out on the longlong.h macros by not
+using gcc will probably have an effect.
+
+Some thresholds produced by the tune program are merely single values chosen
+from what's actually a range of sizes where two algorithms are pretty much
+the same speed.  When this happens the program is likely to give slightly
+different values on successive runs.  This is noticeable on the toom3
+thresholds for instance.
+
+
+
+
+SPEED PROGRAM
+
+The "speed" program can be used for measuring and comparing various
+routines, and producing tables of data or gnuplot graphs.  Compile it with
+
+	make speed
+
+Here are some examples of how to use it.  Check the code for all the
+options.
+
+Draw a graph of mpn_mul_n, stepping through sizes by 10 or a factor of 1.05
+(whichever is greater).
+
+        ./speed -s 10-5000 -t 10 -f 1.05 -P foo mpn_mul_n
+	gnuplot foo.gnuplot
+
+Compare mpn_add_n and mpn_lshift by 1, showing times in cycles and showing
+under mpn_lshift the difference between it and mpn_add_n.
+
+	./speed -s 1-40 -c -d mpn_add_n mpn_lshift.1
+
+Using option -c for times in cycles is interesting but normally only
+necessary when looking carefully at assembler subroutines.  You might think
+it would always give an integer value, but this doesn't happen in practice,
+probably due to overheads in the time measurements.
+
+In the free-form output the "#" symbol against a measurement means the
+corresponding routine is fastest at that size.  This is a convenient visual
+cue when comparing different routines.  The graph data files <name>.data
+don't get this since it would upset gnuplot or other data viewers.
+
+
+
+
+TIME BASE
+
+The time measuring method is determined in time.c, based on what the
+configured target has available.  A microsecond accurate gettimeofday() will
+work well, but there's code to use better methods, such as the cycle
+counters on various CPUs.
+
+Currently, all methods except possibly the alpha cycle counter depend on the
+machine being otherwise idle, or rather on other jobs not stealing CPU time
+from the measuring program.  Short routines (that complete within a
+timeslice) should work even on a busy machine.  Some trouble is taken by
+speed_measure() in common.c to avoid the ill effects of sporadic interrupts,
+or other intermittent things (like cron waking up every minute).  But
+generally you'll want an idle machine to be sure of consistent results.
+
+The CPU frequency is needed if times in cycles are to be displayed, and it's
+always needed when using a cycle counter time base.  time.c knows how to get
+the frequency on some systems, but when that fails, or needs to be
+overridden, an environment variable GMP_CPU_FREQUENCY can be used (in
+Hertz).  For example in "bash" on a 650 MHz machine,
+
+	export GMP_CPU_FREQUENCY=650e6
+
+A high precision time base makes it possible to get accurate measurements in
+a shorter time.  Support for systems and CPUs not already covered is wanted.
+
+When setting up a method, be sure not to claim a higher accuracy than is
+really available.  For example the default gettimeofday() code is set for
+microsecond accuracy, but if only 10ms or 55ms is available then
+inconsistent results can be expected.
+
+
+
+
+
+EXAMPLE COMPARISONS
+
+Here are some ideas for things you can do with the speed program.
+
+There's always going to be a certain amount of overhead in the time
+measurements, due to reading the time base, and in the loop that runs a
+routine enough times to get a reading of the desired precision.  Noop
+functions taking various arguments are available to measure this.  The
+"overhead" printed by the speed program each time in its intro is the "noop"
+routine, but note that this is just for information, it isn't deducted from
+the times printed or anything.
+
+	./speed -s 1 noop noop_wxs noop_wxys
+
+If you want to know how many cycles per limb a routine is taking, look at
+the time increase when the size increments, using option -D.  This avoids
+fixed overheads in the measuring.  Also, remember many of the assembler
+routines have unrolled loops, so it might be necessary to compare times at,
+say, 16, 32, 48, 64 etc to see what the unrolled part is taking, as opposed
+to any finishing off.
+
+        ./speed -s 16-64 -t 16 -C -D mpn_add_n
+
+The -C option on its own gives cycles per limb, but is really only useful at
+big sizes where fixed overheads are small compared to the code doing the
+real work.  Remember of course memory caching and/or page swapping will
+affect results at large sizes.
+
+        ./speed -s 500000 -C mpn_add_n
+
+Once a calculation stops fitting in the CPU data cache, it's going to start
+taking longer.  Exactly where this happens depends on the cache priming in
+the measuring routines, and on what sort of "least recently used" the
+hardware does.  Here's an example for a CPU with a 16kbyte L1 data cache and
+32-bit limb, showing a suddenly steeper curve for mpn_add_n at about 2000
+limbs.
+
+        ./speed -s 1-4000 -t 5 -f 1.02 -P foo mpn_add_n
+	gnuplot foo.gnuplot
+
+When a routine has an unrolled loop for, say, multiples of 8 limbs and then
+an ordinary loop for the remainder, it can happen that it's actually faster
+to do an operation on, say, 8 limbs than it is on 7 limbs.  Here's an
+example drawing a graph of mpn_sub_n, which you can look at to see if times
+smoothly increase with size.
+
+        ./speed -s 1-100 -c -P foo mpn_sub_n
+	gnuplot foo.gnuplot
+
+If mpn_lshift and mpn_rshift for your CPU have special case code for shifts
+by 1, it ought to be faster (or at least not slower) than shifting by, say,
+2 bits.
+
+        ./speed -s 1-200 -c mpn_rshift.1 mpn_rshift.2
+
+An mpn_lshift by 1 can be done by mpn_add_n adding a number to itself, and
+if the lshift isn't faster there's an obvious improvement that's possible.
+
+        ./speed -s 1-200 -c mpn_lshift.1 mpn_add_n_self
+
+On some CPUs (AMD K6 for example) an "in-place" mpn_add_n where the
+destination is one of the sources is faster than a separate destination.
+Here's an example to see this.  (mpn_add_n_inplace is a special measuring
+routine, not available for other operations.)
+
+        ./speed -s 1-200 -c mpn_add_n mpn_add_n_inplace
+
+The gmp manual recommends divisions by powers of two should be done using a
+right shift because it'll be significantly faster.  Here's how you can see
+by what factor mpn_rshift is faster, using division by 32 as an example.
+
+        ./speed -s 10-20 -r mpn_rshift.5 mpn_divrem_1.32
+
+mul_basecase takes an "r" parameter that's the first (larger) size
+parameter.  For example to show speeds for 20x1 up to 20x15 in cycles,
+
+        ./speed -s 1-15 -c mpn_mul_basecase.20
+
+mul_basecase with no parameter does an NxN multiply, so for example to show
+speeds in cycles for 1x1, 2x2, 3x3, etc, up to 20x20, in cycles,
+
+        ./speed -s 1-20 -c mpn_mul_basecase
+
+sqr_basecase is implemented by a "triangular" method on most CPUs, making it
+up to twice as fast as mul_basecase.  In practice loop overheads and the
+products on the diagonal mean it falls short of this.  Here's an example
+running the two and showing by what factor an NxN mul_basecase is slower
+than an NxN sqr_basecase.  (Some versions of sqr_basecase only allow sizes
+below KARATSUBA_SQR_THRESHOLD, so if it crashes at that point don't worry.)
+
+        ./speed -s 1-20 -r mpn_sqr_basecase mpn_mul_basecase
+
+The technique described above with -CD for showing the time difference in
+cycles per limb between two size operations can be done on an NxN
+mul_basecase using -E to change the basis for the size increment to N*N.
+For instance a 20x20 operation is taken to be doing 400 limbs, and a 16x16
+doing 256 limbs.  The following therefore shows the per crossproduct speed
+of mul_basecase and sqr_basecase at around 20x20 limbs.
+
+        ./speed -s 16-20 -t 4 -CDE mpn_mul_basecase mpn_sqr_basecase
+
+Of course sqr_basecase isn't really doing NxN crossproducts, but it can be
+interesting to compare it to mul_basecase as if it was.  For sqr_basecase
+the -F option can be used to base the deltas on N*(N+1)/2 operations, which
+is the triangular products sqr_basecase does.  For example,
+
+        ./speed -s 16-20 -t 4 -CDF mpn_sqr_basecase
+
+Both -E and -F are preliminary and might change.  A consistent approach to
+using them when claiming certain per crossproduct or per triangularproduct
+speeds hasn't really been established, but the increment between speeds in
+the range karatsuba will call seems sensible, that being k to k/2.  For
+instance, if the karatsuba threshold was 20 for the multiply and 30 for the
+square,
+
+        ./speed -s 10-20 -t 10 -CDE mpn_mul_basecase
+        ./speed -s 15-30 -t 15 -CDF mpn_sqr_basecase
+
+The gmp manual recommends application programs avoid excessive initializing
+and clearing of mpz_t variables (and mpq_t and mpf_t too).  Every new
+variable will at a minimum go through an init, a realloc for its first
+store, and finally a clear.  Quite how long that takes depends on the C
+library.  The following compares an mpz_init/realloc/clear to a 10 limb
+mpz_add.
+
+        ./speed -s 10 -c mpz_init_realloc_clear mpz_add
+
+The normal libtool link of the speed program does a static link to libgmp.la
+and libspeed.la, but will end up dynamic linked to libc.  Depending on the
+system, a dynamic linked malloc may be noticeably slower than static linked,
+and you may want to re-run the libtool link invocation to static link libc
+for comparison.  The example below does a 10 limb malloc/free or
+malloc/realloc/free to test the C library.  Of course a real world program
+has big problems if it's doing so many mallocs and frees that it gets slowed
+down by a dynamic linked malloc.
+
+        ./speed -s 10 -c malloc_free malloc_realloc_free
+
+
+
+
+SPEED PROGRAM EXTENSIONS
+
+Potentially lots of things could be made available in the program, but it's
+been left at only the things that have actually been wanted and are likely
+to be reasonably useful in the future.
+
+Extensions should be fairly easy to make though.  speed-ext.c is an example,
+in a style that should suit one-off tests, or new code fragments under
+development.
+
+
+
+
+THRESHOLD EXAMINING
+
+The speed program can be used to examine the speeds of different algorithms
+to check the tune program has done the right thing.  For example to examine
+the karatsuba multiply threshold,
+
+	./speed -s 5-40 mpn_mul_basecase mpn_kara_mul_n
+
+When examining the toom3 threshold, remember it depends on the karatsuba
+threshold, so the right karatsuba threshold needs to be compiled into the
+library first.  The tune program uses special recompiled versions of
+mpn/mul_n.c etc for this reason, but the speed program simply uses the
+normal libgmp.la.
+
+Note further that the various routines may recurse into themselves on sizes
+far enough above applicable thresholds.  For example, mpn_kara_mul_n will
+recurse into itself on sizes greater than twice the compiled-in
+KARATSUBA_MUL_THRESHOLD.
+
+When doing the above comparison between mul_basecase and kara_mul_n what's
+probably of interest is mul_basecase versus a kara_mul_n that does one level
+of Karatsuba then calls to mul_basecase, but this only happens on sizes less
+than twice the compiled KARATSUBA_MUL_THRESHOLD.  A larger value for that
+setting can be compiled-in to avoid the problem if necessary.  The same
+applies to toom3 and BZ, though in a trickier fashion.
+
+There are some upper limits on some of the thresholds, arising from arrays
+dimensioned according to a threshold (mpn_mul_n), or asm code with certain
+sized displacements (some x86 versions of sqr_basecase).  So putting huge
+values for the thresholds, even just for testing, may fail.
+
+
+
+
+THINGS AFFECTING THRESHOLDS
+
+The following are some general notes on some things that can affect the
+various algorithm thresholds.
+
+   KARATSUBA_MUL_THRESHOLD
+
+      At size 2N, karatsuba does three NxN multiplies and some adds and
+      shifts, compared to a 2Nx2N basecase multiply which will be roughly
+      equivalent to four NxN multiplies.
+
+      Fast mul - increases threshold
+    
+         If the CPU has a fast multiply, the basecase multiplies are going
+         to stay faster than the karatsuba overheads for longer.  Conversely
+         if the CPU has a slow multiply the karatsuba method trading some
+         multiplies for adds will become worthwhile sooner.
+
+	 Remember it's "addmul" performance that's of interest here.  This
+	 may differ from a simple "mul" instruction in the CPU.  For example
+	 K6 has a 3 cycle mul but takes nearly 8 cycles/limb for an addmul,
+	 and K7 has a 6 cycle mul latency but has a 4 cycle/limb addmul due
+	 to pipelining.
+
+      Unrolled addmul - increases threshold
+
+         If the CPU addmul routine (or the addmul part of the mul_basecase
+         routine) is unrolled it can mean that a 2Nx2N multiply is a bit
+         faster than four NxN multiplies, due to proportionally less looping
+         overheads.  This can be thought of as the addmul warming to its
+         task on bigger sizes, and keeping the basecase better than
+         karatsuba for longer.
+
+      Karatsuba overheads - increases threshold
+
+         Fairly obviously anything gained or lost in the karatsuba extra
+         calculations will translate directly to the threshold.  But
+         remember the extra calculations are likely to always be a
+         relatively small fraction of the total multiply time and in that
+         sense the basecase code is the best place to be looking for
+         optimizations.
+
+   KARATSUBA_SQR_THRESHOLD
+
+      Squaring is essentially the same as multiplying, so the above applies
+      to squaring too.  Fixed overheads will, proportionally, be bigger when
+      squaring, leading to a higher threshold usually.
+
+      mpn/generic/sqr_basecase.c
+
+         This relies on a reasonable umul_ppmm, and if the generic C code is
+         being used it may badly affect the speed.  Don't bother paying
+         attention to the square thresholds until you have either a good
+         umul_ppmm or an assembler sqr_basecase.
+
+   TOOM3_MUL_THRESHOLD
+
+      At size N, toom3 does five (N/3)x(N/3) multiplies and some extra
+      calculations, compared to karatsuba doing three (N/2)x(N/2)
+      multiplies and some extra calculations (fewer).  Toom3 will become
+      better before long, being O(n^1.465) versus karatsuba at O(n^1.585),
+      but exactly where depends a great deal on the implementations of all
+      the relevant bits of extra calculation.
+
+      In practice the curves for time versus size on toom3 and karatsuba
+      have similar slopes near their crossover, leading to a range of sizes
+      where there's very little difference between the two.  Choosing a
+      single value from the range is a bit arbitrary and will lead to
+      slightly different values on successive runs of the tune program.
+
+      divexact_by3 - used by toom3
+
+         Toom3 does a divexact_by3 which at size N is roughly equivalent to
+         N successively dependent multiplies with a further couple of extra
+         instructions in between.  CPUs with a low latency multiply and good
+         divexact_by3 implementation should see the toom3 threshold lowered.
+         But note this is unlikely to have much effect on total multiply
+         times.
+
+      Asymptotic behaviour
+
+         At the fairly small sizes where the thresholds occur it's worth
+         remembering that the asymptotic behaviour for karatsuba and toom3
+         can't be expected to make accurate predictions, due of course to
+         the big influence of all sorts of overheads, and the fact that only
+         a few recursions of each are being performed.
+
+	 Even at large sizes there's a good chance machine dependent effects
+	 like cache architecture will mean actual performance deviates from
+	 what might be predicted.  This is why the rather positivist
+	 approach of just measuring things has been adopted, in general.
+
+   TOOM3_SQR_THRESHOLD
+
+      The same factors apply to squaring as to multiplying, though with
+      overheads being proportionally a bit bigger.
+
+   FFT_MUL_THRESHOLD, etc
+
+      When configured with --enable-fft, a Fermat style FFT is used for
+      multiplication above FFT_MUL_THRESHOLD, and a further threshold
+      FFT_MODF_MUL_THRESHOLD exists for where FFT is used for a modulo 2^N+1
+      multiply.  FFT_MUL_TABLE is the thresholds at which each split size
+      "k" is used in the FFT.
+
+      step effect - coarse grained thresholds
+
+         The FFT has size restrictions that mean it rounds up sizes to
+         certain multiples and therefore does the same amount of work for a
+         range of different sized operands.  For example at k=8 the size is
+         internally rounded to a multiple of 1024 limbs.  The current single
+         values for the various thresholds are set to give good average
+         performance, but in the future multiple values might be wanted to
+         take into account the different step sizes for different "k"s.
+
+   FFT_SQR_THRESHOLD, etc
+
+      The same considerations apply as for multiplications, plus the
+      following.
+
+      similarity to mul thresholds
+
+         On some CPUs the squaring thresholds are nearly the same as those
+         for multiplying.  It's not quite clear why this is, it might be
+         similar shaped size/time graphs for the mul and sqrs recursed into.
+
+   BZ_THRESHOLD
+
+      The B-Z division algorithm rearranges a traditional multi-precision
+      long division so that NxN multiplies can be done rather than repeated
+      Nx1 multiplies, thereby exploiting the algorithmic advantages of
+      karatsuba and toom3, and leading to significant speedups.
+
+      fast mul_basecase - decreases threshold
+
+         CPUs with an optimized mul_basecase can expect a lower B-Z
+         threshold due to the helping hand such a mul_basecase will give to
+         B-Z as compared to submul_1 used in the schoolbook method.
+
+   GCD_ACCEL_THRESHOLD
+
+      Below this threshold a simple binary subtract and shift is used, above
+      it Ken Weber's accelerated algorithm is used.  The accelerated GCD
+      performs far fewer steps than the binary GCD and will normally kick in
+      at quite small sizes.
+
+      modlimb_invert and find_a - affect threshold
+
+         At small sizes the performance of modlimb_invert and find_a will
+         affect the accelerated algorithm and CPUs where those routines are
+         not well optimized may see a higher threshold.  (At large sizes
+         mpn_addmul_1 and mpn_submul_1 come to dominate the accelerated
+         algorithm.)
+
+   GCDEXT_THRESHOLD
+
+      mpn/generic/gcdext.c is based on Lehmer's multi-step improvement of
+      Euclid's algorithm.  The multipliers are found using single limb
+      calculations below GCDEXT_THRESHOLD, or double limb calculations
+      above.  The single limb code is fast but doesn't produce full-limb
+      multipliers.
+
+      data-dependent multiplier - big threshold
+
+         If multiplications done by mpn_mul_1, addmul_1 and submul_1 run
+         slower when there's more bits in the multiplier, then producing
+         bigger multipliers with the double limb calculation doesn't save
+         much more than some looping and function call overheads.  A large
+         threshold can then be expected.
+
+      slow division - low threshold
+
+         The single limb calculation does some plain "/" divisions, whereas
+         the double limb calculation has a divide routine optimized for the
+         small quotients that often occur.  Until the single limb code does
+         something similar a slow hardware divide will count against it.
+
+
+
+
+
+FUTURE
+
+Make a program to check the time base is working properly, for small and
+large measurements.  Make it able to test each available method, including
+perhaps the apparent resolution of each.
+
+Add versions of the toom3 multiplication using either the mpn calls or the
+open-coded style, so the two can be compared.
+
+Add versions of the generic C mpn_divrem_1 using straight division versus a
+multiply by inverse, so the two can be compared.  Include the branch-free
+version of multiply by inverse too.
+
+Make an option in struct speed_parameters to specify operand overlap,
+perhaps 0 for none, 1 for dst=src1, 2 for dst=src2, 3 for dst1=src1
+dst2=src2, 4 for dst1=src2 dst2=src1.  This is done for addsub_n with the r
+parameter (though addsub_n isn't yet enabled), and could be done for add_n,
+xor_n, etc too.
+
+When speed_measure() divides the total time measured by repetitions
+performed, it divides the fixed overheads imposed by speed_starttime() and
+speed_endtime().  When different routines are run with different repetitions
+the overhead will then be differently counted.  It would improve precision
+to try to avoid this.  Currently the idea is just to set speed_precision big
+enough that the effect is insignificant compared to the routines being
+measured.
+
+
+
+
+----------------
+Local variables:
+mode: text
+fill-column: 76
+End:
diff --git a/src/gmp/tune/alpha.asm b/src/gmp/tune/alpha.asm
new file mode 100644
index 000000000..6be17499d
--- /dev/null
+++ b/src/gmp/tune/alpha.asm
@@ -0,0 +1,39 @@
+dnl  Alpha time stamp counter access routine.
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+include(`../config.m4')
+
+
+C void speed_cyclecounter (unsigned int p[2]);
+C
+C rpcc measures cycles elapsed in the user program and hence should be very
+C accurate even on a busy system.  Losing cache contents due to task
+C switching may have an effect though.
+
+ASM_START()
+PROLOGUE(speed_cyclecounter)
+	rpcc	r0
+	stl	r0,0(r16)
+	srl	r0,32,r0
+	stl	r0,4(r16)
+	ret	r31,(r26),1
+EPILOGUE(speed_cyclecounter)
+ASM_END()
diff --git a/src/gmp/tune/common.c b/src/gmp/tune/common.c
new file mode 100644
index 000000000..ca6964d61
--- /dev/null
+++ b/src/gmp/tune/common.c
@@ -0,0 +1,1319 @@
+/* Shared speed subroutines.  */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include <errno.h>
+#include <fcntl.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h> /* for qsort */
+#include <string.h>
+#include <unistd.h>
+#if 0
+#include <sys/ioctl.h>
+#endif
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#include "speed.h"
+
+/* Change this to "#define TRACE(x) x" to get traces. */
+#define TRACE(x)
+
+
+typedef int (*qsort_function_t) _PROTO ((const void *, const void *));
+
+
+int   speed_option_addrs = 0;
+
+
+void
+pentium_wbinvd(void)
+{
+#if 0
+  {
+    static int  fd = -2;
+
+    if (fd == -2)
+      {
+        fd = open ("/dev/wbinvd", O_RDWR);
+        if (fd == -1)
+          perror ("open /dev/wbinvd");
+      }
+
+    if (fd != -1)
+      ioctl (fd, 0, 0);
+  }
+#endif
+
+#if 0
+#define WBINVDSIZE  1024*1024*2
+  {
+    static char  *p = NULL;
+    int   i, sum;
+
+    if (p == NULL)
+      p = malloc (WBINVDSIZE);
+
+#if 0
+    for (i = 0; i < WBINVDSIZE; i++)
+      p[i] = i & 0xFF;
+#endif
+
+    sum = 0;
+    for (i = 0; i < WBINVDSIZE; i++)
+      sum += p[i];
+
+    mpn_cache_fill_dummy (sum);
+  }
+#endif
+}
+
+static int
+double_cmp_ptr (const double *p, const double *q)
+{
+  if (*p > *q)  return 1;
+  if (*p < *q)  return -1;
+  return 0;
+}
+
+
+/* Measure the speed of a given routine.
+
+   The routine is run with enough repetitions to make it take at least
+   speed_precision * speed_unittime.  This aims to minimize the effects of a
+   limited accuracy time base and the overhead of the measuring itself.
+
+   Measurements are made looking for 4 results within TOLERANCE of each
+   other (or 3 for routines taking longer than 2 seconds).  This aims to get
+   an accurate reading even if some runs are bloated by interrupts or task
+   switches or whatever.
+
+   The given (*fun)() is expected to run its function "s->reps" many times
+   and return the total elapsed time measured using speed_starttime() and
+   speed_endtime().  If the function doesn't support the given s->size or
+   s->r, -1.0 should be returned.  See the various base routines below.  */
+
+double
+speed_measure (double (*fun) _PROTO ((struct speed_params *s)),
+               struct speed_params *s)
+{
+#define TOLERANCE    1.005  /* 0.5% */
+
+  struct speed_params  s_dummy;
+  int     i, j, e;
+  double  t[30];
+  double  t_unsorted[30];
+
+  /* Use dummy parameters if caller doesn't provide any.  Only a few special
+     "fun"s will cope with this, speed_noop() is one.  */
+  if (s == NULL)
+    {
+      memset (&s_dummy, '\0', sizeof (s_dummy));
+      s = &s_dummy;
+    }
+  
+  s->reps = 1;
+  s->time_divisor = 1.0;
+  for (i = 0; i < numberof (t); i++)
+    {
+      for (;;)
+        {
+          s->src_num = 0;
+          s->dst_num = 0;
+
+          t[i] = (*fun) (s);
+          t_unsorted[i] = t[i];
+
+          TRACE (printf("size=%ld reps=%u r=%d attempt=%d  %.9f\n", 
+                        s->size, s->reps, s->r, i, t[i]));
+
+          if (t[i] == -1.0)
+            return -1.0;
+
+          if (t[i] >= speed_unittime * speed_precision)
+            break;
+
+          /* go to a value of reps to make t[i] >= precision */
+          s->reps = (unsigned) ceil (1.1 * s->reps
+                                     * speed_unittime * speed_precision
+                                     / MAX (t[i], speed_unittime));
+        }
+      t[i] /= s->reps;
+
+      if (speed_precision == 0)
+        return t[i];
+
+      /* require 3 values within TOLERANCE when >= 2 secs, 4 when below */
+      if (t[0] >= 2.0)
+        e = 3;
+      else
+        e = 4;
+
+      /* Look for e many t[]'s within TOLERANCE of each other to consider a
+         valid measurement.  Return smallest among them.  */
+      if (i >= e)
+        {
+          qsort (t, i+1, sizeof(t[0]), (qsort_function_t) double_cmp_ptr);
+          for (j = e-1; j < i; j++)
+            if (t[j] <= t[j-e+1] * TOLERANCE)
+              return t[j-e+1] / s->time_divisor;
+        }
+    } 
+
+  fprintf (stderr, "speed_measure() could not get %d results within %.1f%%\n",
+           e, (TOLERANCE-1.0)*100.0);
+  fprintf (stderr, "  %.12f is about 0.5%%\n", t[0]*(TOLERANCE-1.0));
+  for (i = 0; i < numberof (t); i++)
+    fprintf (stderr, "  %.09f\n", t_unsorted[i]);
+
+  return -1.0;
+}
+
+
+/* Read all of ptr,size to get it into the CPU memory cache.
+  
+   A call to mpn_cache_fill_dummy() is used to make sure the compiler
+   doesn't optimize away the whole loop.  Using "volatile mp_limb_t sum"
+   would work too, but the function call means we don't rely on every
+   compiler actually implementing volatile properly.
+
+   mpn_cache_fill_dummy() is in a separate source file to stop gcc thinking
+   it can inline it.  */
+
+void
+mpn_cache_fill (mp_srcptr ptr, mp_size_t size)
+{
+  mp_limb_t  sum = 0;
+  mp_size_t  i;
+
+  for (i = 0; i < size; i++)
+    sum += ptr[i];
+
+  mpn_cache_fill_dummy(sum);
+}
+
+
+void
+mpn_cache_fill_write (mp_ptr ptr, mp_size_t size)
+{
+  mpn_cache_fill (ptr, size);
+
+#if 0
+  mpn_random (ptr, size);
+#endif
+
+#if 0
+  mp_size_t  i;
+
+  for (i = 0; i < size; i++)
+    ptr[i] = i;
+#endif
+}
+
+
+void
+speed_operand_src (struct speed_params *s, mp_ptr ptr, mp_size_t size)
+{
+  if (s->src_num >= numberof (s->src))
+    {
+      fprintf (stderr, "speed_operand_src: no room left in s->src[]\n");
+      abort ();
+    }
+  s->src[s->src_num].ptr = ptr;
+  s->src[s->src_num].size = size;
+  s->src_num++;
+}
+
+
+void
+speed_operand_dst (struct speed_params *s, mp_ptr ptr, mp_size_t size)
+{
+  if (s->dst_num >= numberof (s->dst))
+    {
+      fprintf (stderr, "speed_operand_dst: no room left in s->dst[]\n");
+      abort ();
+    }
+  s->dst[s->dst_num].ptr = ptr;
+  s->dst[s->dst_num].size = size;
+  s->dst_num++;
+}
+
+
+void
+speed_cache_fill (struct speed_params *s)
+{
+  static struct speed_params  prev;
+  int  i;
+
+  /* FIXME: need a better way to get the format string for a pointer */
+
+  if (speed_option_addrs)
+    {
+      int  different;
+
+      different = (s->dst_num != prev.dst_num || s->src_num != prev.src_num);
+      for (i = 0; i < s->dst_num; i++)
+        different |= (s->dst[i].ptr != prev.dst[i].ptr);
+      for (i = 0; i < s->src_num; i++)
+        different |= (s->src[i].ptr != prev.src[i].ptr);
+
+      if (different) 
+        {
+          if (s->dst_num != 0)
+            {
+              printf ("dst");
+              for (i = 0; i < s->dst_num; i++)
+                printf (" %08lX", (unsigned long) s->dst[i].ptr);
+              printf (" ");
+            }
+
+          if (s->src_num != 0)
+            {
+              printf ("src");
+              for (i = 0; i < s->src_num; i++)
+                printf (" %08lX", (unsigned long) s->src[i].ptr);
+              printf (" ");
+            }
+          printf ("  (cf sp approx %08lX)\n", (unsigned long) &different);
+
+        }
+
+      memcpy (&prev, s, sizeof(prev));
+    }
+
+  switch (s->cache) {
+  case 0:
+    for (i = 0; i < s->dst_num; i++)
+      mpn_cache_fill_write (s->dst[i].ptr, s->dst[i].size);
+    for (i = 0; i < s->src_num; i++)
+      mpn_cache_fill (s->src[i].ptr, s->src[i].size);
+    break;
+  case 1:
+    pentium_wbinvd();
+    break;
+  }
+}
+
+
+/* Return p advanced to the next multiple of "align" bytes.  "align" must be
+   a power of 2.  Care is taken not to assume sizeof(int)==sizeof(pointer).
+   Using "unsigned long" avoids a warning on hpux.  */
+void *
+align_pointer (void *p, size_t align)
+{
+  unsigned long  d;
+  d = ((unsigned long) p) & (align-1);
+  d = (d != 0 ? align-d : 0);
+  return (void *) (((char *) p) + d);
+}
+
+/* Note that memory allocated with this function can never be freed, because
+   the start address of the block allocated is discarded. */
+void *
+_mp_allocate_func_aligned (size_t bytes, size_t align)
+{
+  return align_pointer ((*_mp_allocate_func) (bytes + align-1), align);
+}
+
+
+void *
+_mp_allocate_or_reallocate (void *ptr, size_t oldsize, size_t newsize)
+{
+  if (ptr == NULL)
+    return (*_mp_allocate_func) (newsize);
+  else
+    return (*_mp_reallocate_func) (ptr, oldsize, newsize);
+}
+
+
+/* Adjust ptr to align to CACHE_LINE_SIZE bytes plus "align" limbs.  ptr
+   needs to have room for up to CACHE_LINE_SIZE-4 extra bytes.  */
+
+mp_ptr
+speed_tmp_alloc_adjust (void *ptr, mp_size_t align)
+{
+  /*
+  printf("%p %ld -> %p %X %X\n", ptr, align,
+         (mp_ptr) ptr 
+         + ((align - ((mp_size_t) ptr >> 2)) &
+            SPEED_TMP_ALLOC_ADJUST_MASK),
+         ((mp_size_t) ptr >> 2) & SPEED_TMP_ALLOC_ADJUST_MASK,
+         SPEED_TMP_ALLOC_ADJUST_MASK);
+  */
+
+  return (mp_ptr) ptr 
+    + ((align - ((mp_size_t) ptr >> 2)) & SPEED_TMP_ALLOC_ADJUST_MASK);
+}
+
+
+void
+mpz_set_n (mpz_ptr z, mp_srcptr p, mp_size_t size)
+{
+  ASSERT (size >= 0);
+  MPN_NORMALIZE (p, size);
+  MPZ_REALLOC (z, size);
+  MPN_COPY (PTR(z), p, size);
+  SIZ(z) = size;
+}
+
+
+/* Miscellanous options accepted by tune and speed programs under -o. */
+
+void
+speed_option_set (const char *s)
+{
+  if (strcmp (s, "addrs") == 0)  speed_option_addrs = 1;
+  else 
+    {
+      printf ("Unrecognised -o option: %s\n", s);
+      exit (1);
+    }
+}
+
+
+/* The following are basic speed running routines for various gmp functions.
+   Many are very similar and use speed.h macros.
+
+   Each routine allocates it's own destination space for the result of the
+   function, because only it can know what the function needs.
+
+   speed_starttime() and speed_endtime() are put tight around the code to be
+   measured.  Any setups are done outside the timed portion.
+
+   Each routine is responsible for its own cache priming.
+   speed_cache_fill() is a good way to do this, see examples in speed.h.
+   One cache priming possibility, for CPUs with write-allocate cache, and
+   functions that don't take too long, is to do one dummy call before timing
+   so as to cache everything that gets used.  But speed_measure() runs a
+   routine at least twice and will take the smaller time, so this might not
+   be necessary.
+
+   Data alignment will be important, for source, destination and temporary
+   workspace.  A routine can align its destination and workspace.  Programs
+   using the routines will ensure s->xp and s->yp are aligned.  Aligning
+   onto a CACHE_LINE_SIZE boundary is suggested.  s->align_wp and
+   s->align_wp2 should be respected where it makes sense to do so.
+   SPEED_TMP_ALLOC_LIMBS is a good way to do this.
+
+   A loop of the following form can be expected to turn into good assembler
+   code on most CPUs, thereby minimizing overhead in the measurement.  It
+   can always be assumed s->reps >= 1.
+
+          i = s->reps
+          do
+            foo();
+          while (--i != 0);
+
+   Additional parameters might be added to "struct speed_params" in the
+   future.  Routines should ignore anything they don't use.
+
+   s->size can be used creatively, and s->xp and s->yp can be ignored.  For
+   example, speed_mpz_fac_ui() uses s->size as n for the factorial.  s->r is
+   just a user-supplied parameter.  speed_mpn_lshift() uses it as a shift,
+   speed_mpn_mul_1() uses it as a multiplier.  */
+
+
+/* MPN_COPY etc can be macros, so the _CALL forms are necessary */
+double
+speed_MPN_COPY (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_COPY_CALL (MPN_COPY (wp, s->xp, s->size));
+}
+double
+speed_MPN_COPY_INCR (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_COPY_CALL (MPN_COPY_INCR (wp, s->xp, s->size));
+}
+double
+speed_MPN_COPY_DECR (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_COPY_CALL (MPN_COPY_DECR (wp, s->xp, s->size));
+}
+double
+speed_memcpy (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_COPY_CALL
+    (memcpy (wp, s->xp, s->size * BYTES_PER_MP_LIMB));
+}
+
+
+double
+speed_mpn_addmul_1 (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_UNARY_1 (mpn_addmul_1);
+}
+double
+speed_mpn_submul_1 (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_UNARY_1 (mpn_submul_1);
+}
+
+
+double
+speed_mpn_mul_1 (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_UNARY_1 (mpn_mul_1);
+}
+
+
+double
+speed_mpn_lshift (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_UNARY_1 (mpn_lshift);
+}
+double
+speed_mpn_rshift (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_UNARY_1 (mpn_rshift);
+}
+
+
+/* The carry-in variants (if available) are good for measuring because they
+   won't skip a division if high<divisor.  Alternately, use -1 as a divisor
+   with the plain _1 forms. */
+double
+speed_mpn_divrem_1 (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_DIVREM_1 (mpn_divrem_1);
+}
+double
+speed_mpn_divrem_1f (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_DIVREM_1F (mpn_divrem_1);
+}
+#if HAVE_NATIVE_mpn_divrem_1c
+double
+speed_mpn_divrem_1c (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_DIVREM_1C (mpn_divrem_1c);
+}
+double
+speed_mpn_divrem_1cf (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_DIVREM_1CF (mpn_divrem_1c);
+}
+#endif
+
+double
+speed_mpn_divrem_2 (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_DIVREM_2 (mpn_divrem_2);
+}
+
+double
+speed_mpn_mod_1 (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_MOD_1 (mpn_mod_1);
+}
+#if HAVE_NATIVE_mpn_mod_1c
+double
+speed_mpn_mod_1c (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_MOD_1C (mpn_mod_1c);
+}
+#endif
+
+double
+speed_mpn_divexact_by3 (struct speed_params *s)
+{
+  /* mpn_divexact_by3 is a macro, so the _CALL form is necessary */
+  SPEED_ROUTINE_MPN_COPY_CALL(mpn_divexact_by3 (wp, s->xp, s->size));
+}
+
+
+double
+speed_mpn_bz_divrem_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BZ_DIVREM_N (mpn_bz_divrem_n);
+}
+double
+speed_mpn_bz_divrem_sb (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BZ_DIVREM_SB (mpn_sb_divrem_mn);
+}
+double
+speed_mpn_bz_tdiv_qr (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BZ_TDIV_QR (mpn_tdiv_qr);
+}
+
+
+double
+speed_mpn_popcount (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_POPCOUNT (mpn_popcount);
+}
+double
+speed_mpn_hamdist (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_HAMDIST (mpn_hamdist);
+}
+
+
+double
+speed_mpn_add_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BINARY_N (mpn_add_n);
+}
+double
+speed_mpn_sub_n (struct speed_params *s)
+{
+SPEED_ROUTINE_MPN_BINARY_N (mpn_sub_n);
+}
+double
+speed_mpn_add_n_self (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BINARY_N_SELF (mpn_add_n);
+}
+double
+speed_mpn_add_n_inplace (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BINARY_N_INPLACE (mpn_add_n);
+}
+
+
+/* mpn_and_n etc can be macros and so have to be handled with
+   SPEED_ROUTINE_MPN_BINARY_N_CALL forms */
+double
+speed_mpn_and_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BINARY_N_CALL (mpn_and_n (wp, s->xp, s->yp, s->size));
+}
+double
+speed_mpn_andn_n (struct speed_params *s)
+{
+SPEED_ROUTINE_MPN_BINARY_N_CALL (mpn_andn_n (wp, s->xp, s->yp, s->size));
+}
+double
+speed_mpn_nand_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BINARY_N_CALL (mpn_nand_n (wp, s->xp, s->yp, s->size));
+}
+double
+speed_mpn_ior_n (struct speed_params *s)
+{
+SPEED_ROUTINE_MPN_BINARY_N_CALL (mpn_ior_n (wp, s->xp, s->yp, s->size));
+}
+double
+speed_mpn_iorn_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BINARY_N_CALL (mpn_iorn_n (wp, s->xp, s->yp, s->size));
+}
+double
+speed_mpn_nior_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BINARY_N_CALL (mpn_nior_n (wp, s->xp, s->yp, s->size));
+}
+double
+speed_mpn_xor_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BINARY_N_CALL (mpn_xor_n (wp, s->xp, s->yp, s->size));
+}
+double
+speed_mpn_xnor_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_BINARY_N_CALL (mpn_xnor_n (wp, s->xp, s->yp, s->size));
+}
+
+
+double
+speed_mpn_mul_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_MUL_N (mpn_mul_n);
+}
+double
+speed_mpn_sqr_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_SQR (mpn_sqr_n);
+}
+double
+speed_mpn_mul_n_sqr (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_SQR_CALL (mpn_mul_n (wp, s->xp, s->xp, s->size));
+}
+
+double
+speed_mpn_mul_basecase (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_MUL_BASECASE(mpn_mul_basecase);
+}
+double
+speed_mpn_sqr_basecase (struct speed_params *s)
+{
+  /* FIXME: size restrictions on some versions of sqr_basecase */
+  SPEED_ROUTINE_MPN_SQR (mpn_sqr_basecase);
+}
+
+double
+speed_mpn_kara_mul_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_KARA_MUL_N (mpn_kara_mul_n);
+}
+double
+speed_mpn_kara_sqr_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_KARA_SQR_N (mpn_kara_sqr_n);
+}
+
+double
+speed_mpn_toom3_mul_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_TOOM3_MUL_N (mpn_toom3_mul_n);
+}
+double
+speed_mpn_toom3_sqr_n (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_TOOM3_SQR_N (mpn_toom3_sqr_n);
+}
+
+double
+speed_mpn_mul_fft_full (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_MUL_N_CALL
+    (mpn_mul_fft_full (wp, s->xp, s->size, s->yp, s->size));
+}
+double
+speed_mpn_mul_fft_full_sqr (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_SQR_CALL
+    (mpn_mul_fft_full (wp, s->xp, s->size, s->xp, s->size));
+}
+
+
+/* These are mod 2^N+1 multiplies and squares.  If s->r is supplied it's
+   used as k, otherwise the best k for the size is used.  If s->size isn't a
+   multiple of 2^k it's rounded up to make the effective operation size.  */
+
+#define SPEED_ROUTINE_MPN_MUL_FFT_CALL(call, sqr)       \
+  {                                                     \
+    mp_ptr     wp;                                      \
+    mp_size_t  pl;                                      \
+    int        k;                                       \
+    unsigned   i;                                       \
+    double     t;                                       \
+    TMP_DECL (marker);                                  \
+                                                        \
+    SPEED_RESTRICT_COND (s->size >= 1);                 \
+                                                        \
+    if (s->r != 0)                                      \
+      k = s->r;                                         \
+    else                                                \
+      k = mpn_fft_best_k (s->size, sqr);                \
+                                                        \
+    TMP_MARK (marker);                                  \
+    pl = mpn_fft_next_size (s->size, k);                \
+    wp = SPEED_TMP_ALLOC_LIMBS (pl+1, s->align_wp);     \
+                                                        \
+    speed_operand_src (s, s->xp, s->size);              \
+    if (!sqr)                                           \
+      speed_operand_src (s, s->yp, s->size);            \
+    speed_operand_dst (s, wp, pl+1);                    \
+    speed_cache_fill (s);                               \
+                                                        \
+    speed_starttime ();                                 \
+    i = s->reps;                                        \
+    do                                                  \
+      call;                                             \
+    while (--i != 0);                                   \
+    t = speed_endtime ();                               \
+                                                        \
+    TMP_FREE (marker);                                  \
+    return t;                                           \
+  }  
+
+double
+speed_mpn_mul_fft (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_MUL_FFT_CALL
+    (mpn_mul_fft (wp, pl, s->xp, s->size, s->yp, s->size, k), 0);
+}
+
+double
+speed_mpn_mul_fft_sqr (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_MUL_FFT_CALL
+    (mpn_mul_fft (wp, pl, s->xp, s->size, s->xp, s->size, k), 1);
+}
+
+
+double
+speed_mpn_gcd (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_GCD (mpn_gcd);
+}
+double
+speed_mpn_gcdext (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_GCDEXT (mpn_gcdext);
+}
+double
+speed_mpn_gcd_1 (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_GCD_1 (mpn_gcd_1);
+}
+
+
+double
+speed_mpn_jacobi_base (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPN_JACBASE (mpn_jacobi_base);
+}
+
+
+double
+speed_mpz_fac_ui (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPZ_UI (mpz_fac_ui);
+}
+double
+speed_mpz_fib_ui (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPZ_UI (mpz_fib_ui);
+}
+
+
+double
+speed_mpz_powm (struct speed_params *s)
+{
+  SPEED_ROUTINE_MPZ_POWM (mpz_powm);
+}
+
+
+double
+speed_modlimb_invert (struct speed_params *s)
+{
+  SPEED_ROUTINE_MODLIMB_INVERT (modlimb_invert);
+}
+
+
+double
+speed_noop (struct speed_params *s)
+{
+  unsigned  i;
+  
+  speed_starttime ();
+  i = s->reps;
+  do 
+    noop ();
+  while (--i != 0);
+  return speed_endtime ();
+}  
+
+double
+speed_noop_wxs (struct speed_params *s)
+{
+  mp_ptr   wp;
+  unsigned i;
+  double   t;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  wp = TMP_ALLOC_LIMBS (1);
+
+  speed_starttime ();
+  i = s->reps;
+  do
+    noop_wxs (wp, s->xp, s->size);
+  while (--i != 0);
+  t = speed_endtime ();
+
+  TMP_FREE (marker);
+  return t;
+}  
+
+double
+speed_noop_wxys (struct speed_params *s)
+{
+  mp_ptr   wp;
+  unsigned i;
+  double   t;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  wp = TMP_ALLOC_LIMBS (1);
+
+  speed_starttime ();
+  i = s->reps;
+  do
+    noop_wxys (wp, s->xp, s->yp, s->size);
+  while (--i != 0);
+  t = speed_endtime ();
+
+  TMP_FREE (marker);
+  return t;
+}  
+
+
+#define SPEED_ROUTINE_ALLOC_FREE(variables, calls)      \
+  {                                                     \
+    unsigned  i;                                        \
+    variables;                                          \
+                                                        \
+    speed_starttime ();                                 \
+    i = s->reps;                                        \
+    do                                                  \
+      {                                                 \
+        calls;                                          \
+      }                                                 \
+    while (--i != 0);                                   \
+    return speed_endtime ();                            \
+  }
+
+
+/* Compare these to see how much malloc/free costs and then how much
+   _mp_default_allocate/free and mpz_init/clear add.  mpz_init/clear or
+   mpq_init/clear will be doing a 1 limb allocate, so use that as the size
+   when including them in comparisons.  */
+
+double
+speed_malloc_free (struct speed_params *s)
+{
+  size_t  bytes = s->size * BYTES_PER_MP_LIMB;
+  SPEED_ROUTINE_ALLOC_FREE (void *p,
+                            p = malloc (bytes);
+                            free (p));
+}  
+
+double
+speed_malloc_realloc_free (struct speed_params *s)
+{
+  size_t  bytes = s->size * BYTES_PER_MP_LIMB;
+  SPEED_ROUTINE_ALLOC_FREE (void *p,
+                            p = malloc (BYTES_PER_MP_LIMB);
+                            p = realloc (p, bytes);
+                            free (p));
+}  
+
+double
+speed_mp_allocate_free (struct speed_params *s)
+{
+  size_t  bytes = s->size * BYTES_PER_MP_LIMB;
+  SPEED_ROUTINE_ALLOC_FREE (void *p,
+                            p = (*_mp_allocate_func) (bytes);
+                            (*_mp_free_func) (p, bytes));
+}  
+
+double
+speed_mp_allocate_reallocate_free (struct speed_params *s)
+{
+  size_t  bytes = s->size * BYTES_PER_MP_LIMB;
+  SPEED_ROUTINE_ALLOC_FREE
+    (void *p,
+     p = (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
+     p = (*_mp_reallocate_func) (p, bytes, BYTES_PER_MP_LIMB);
+     (*_mp_free_func) (p, bytes));
+}  
+
+double
+speed_mpz_init_clear (struct speed_params *s)
+{
+  SPEED_ROUTINE_ALLOC_FREE (mpz_t z,
+                            mpz_init (z);
+                            mpz_clear (z));
+}  
+
+double
+speed_mpz_init_realloc_clear (struct speed_params *s)
+{
+  SPEED_ROUTINE_ALLOC_FREE (mpz_t z,
+                            mpz_init (z);
+                            _mpz_realloc (z, s->size);
+                            mpz_clear (z));
+}  
+
+double
+speed_mpq_init_clear (struct speed_params *s)
+{
+  SPEED_ROUTINE_ALLOC_FREE (mpq_t q,
+                            mpq_init (q);
+                            mpq_clear (q));
+}  
+
+double
+speed_mpf_init_clear (struct speed_params *s)
+{
+  SPEED_ROUTINE_ALLOC_FREE (mpf_t f,
+                            mpf_init (f);
+                            mpf_clear (f));
+}  
+
+
+/* Compare this to mpn_add_n to see how much overhead mpz_add adds.  Note
+   that repeatedly calling mpz_add with the same data gives branch predition
+   in it an advantage.  */
+
+double
+speed_mpz_add (struct speed_params *s)
+{
+  mpz_t     w, x, y;
+  unsigned  i;
+  double    t;
+
+  mpz_init (w);
+  mpz_init (x);
+  mpz_init (y);
+
+  mpz_set_n (x, s->xp, s->size);
+  mpz_set_n (y, s->yp, s->size);
+  mpz_add (w, x, y);
+
+  speed_starttime ();
+  i = s->reps;
+  do 
+    {
+      mpz_add (w, x, y);
+    }
+  while (--i != 0);
+  t = speed_endtime ();
+
+  mpz_clear (w);
+  mpz_clear (x);
+  mpz_clear (y);
+  return t;
+}  
+
+
+/* If r==0, calculate (size,size/2),
+   otherwise calculate (size,r). */
+
+double
+speed_mpz_bin_uiui (struct speed_params *s)
+{
+  mpz_t          w;
+  unsigned long  k;
+  unsigned  i;
+  double    t;
+
+  mpz_init (w);
+  if (s->r != 0)
+    k = s->r;
+  else
+    k = s->size/2;
+
+  speed_starttime ();
+  i = s->reps;
+  do 
+    {
+      mpz_bin_uiui (w, s->size, k);
+    }
+  while (--i != 0);
+  t = speed_endtime ();
+
+  mpz_clear (w);
+  return t;
+}  
+
+
+/* The multiplies are successively dependent so the latency is measured, not
+   the issue rate.  There's only 10 per loop so the code doesn't get too big
+   since umul_ppmm is several instructions on some cpus.
+
+   Putting the arguments as "h,l,l,h" gets slightly better code from gcc
+   2.95.2 on x86, it puts only one mov between each mul, not two.  That mov
+   though will probably show up as a bogus extra cycle though.
+
+   The measuring function macros are into three parts to avoid overflowing
+   preprocessor expansion space if umul_ppmm is big.
+
+   Limitations:
+
+   Don't blindly use this to set UMUL_TIME in gmp-mparam.h, check the code
+   generated first, especially on CPUs with low latency multipliers.
+
+   The default umul_ppmm doing h*l will be getting increasing numbers of
+   high zero bits in the calculation.  CPUs with data-dependent multipliers
+   will want to use umul_ppmm.1 to get some randomization into the
+   calculation.  The extra xors and fetches will be a slowdown of course.  */
+
+#define SPEED_MACRO_UMUL_PPMM_A \
+  {                             \
+    mp_limb_t  h, l;            \
+    unsigned   i;               \
+    double     t;               \
+                                \
+    s->time_divisor = 10;       \
+                                \
+    h = s->xp[0];               \
+    l = s->yp[0];               \
+                                \
+    switch (s->r) {             \
+    case 1:                     \
+      speed_starttime ();       \
+      i = s->reps;              \
+      do                        \
+        {
+
+#define SPEED_MACRO_UMUL_PPMM_B \
+        }                       \
+      while (--i != 0);         \
+      t = speed_endtime ();     \
+      break;                    \
+                                \
+    default:                    \
+      speed_starttime ();       \
+      i = s->reps;              \
+      do                        \
+        {
+
+#define SPEED_MACRO_UMUL_PPMM_C                                         \
+        }                                                               \
+      while (--i != 0);                                                 \
+      t = speed_endtime ();                                             \
+      break;                                                            \
+    }                                                                   \
+                                                                        \
+    /* stop the compiler optimizing away the whole calculation! */      \
+    noop_1 (h);                                                         \
+    noop_1 (l);                                                         \
+                                                                        \
+    return t;                                                           \
+  }
+
+
+double
+speed_umul_ppmm (struct speed_params *s)
+{
+  SPEED_MACRO_UMUL_PPMM_A;
+  {
+    umul_ppmm (h, l, l, h);  h ^= s->xp_block[0]; l ^= s->yp_block[0];
+     umul_ppmm (h, l, l, h); h ^= s->xp_block[1]; l ^= s->yp_block[1];
+     umul_ppmm (h, l, l, h); h ^= s->xp_block[2]; l ^= s->yp_block[2];
+    umul_ppmm (h, l, l, h);  h ^= s->xp_block[3]; l ^= s->yp_block[3];
+     umul_ppmm (h, l, l, h); h ^= s->xp_block[4]; l ^= s->yp_block[4];
+     umul_ppmm (h, l, l, h); h ^= s->xp_block[5]; l ^= s->yp_block[5];
+    umul_ppmm (h, l, l, h);  h ^= s->xp_block[6]; l ^= s->yp_block[6];
+     umul_ppmm (h, l, l, h); h ^= s->xp_block[7]; l ^= s->yp_block[7];
+     umul_ppmm (h, l, l, h); h ^= s->xp_block[8]; l ^= s->yp_block[8];
+    umul_ppmm (h, l, l, h);  h ^= s->xp_block[9]; l ^= s->yp_block[9];
+  }
+  SPEED_MACRO_UMUL_PPMM_B;
+  {
+    umul_ppmm (h, l, l, h);
+     umul_ppmm (h, l, l, h);
+     umul_ppmm (h, l, l, h);
+    umul_ppmm (h, l, l, h);
+     umul_ppmm (h, l, l, h);
+     umul_ppmm (h, l, l, h);
+    umul_ppmm (h, l, l, h);
+     umul_ppmm (h, l, l, h);
+     umul_ppmm (h, l, l, h);
+    umul_ppmm (h, l, l, h);
+  }
+  SPEED_MACRO_UMUL_PPMM_C;
+}
+
+
+#if HAVE_NATIVE_mpn_umul_ppmm
+
+#if defined (__hppa) && W_TYPE_SIZE == 64
+#define CALL_MPN_UMUL_PPMM  (h = __MPN (umul_ppmm) (h, l, &l))
+#else
+#define CALL_MPN_UMUL_PPMM  (h = __MPN (umul_ppmm) (&l, h, l))
+#endif
+
+double
+speed_mpn_umul_ppmm (struct speed_params *s)
+{
+  SPEED_MACRO_UMUL_PPMM_A;
+  {
+    CALL_MPN_UMUL_PPMM;  h ^= s->xp_block[0]; l ^= s->yp_block[0];
+     CALL_MPN_UMUL_PPMM; h ^= s->xp_block[1]; l ^= s->yp_block[1];
+     CALL_MPN_UMUL_PPMM; h ^= s->xp_block[2]; l ^= s->yp_block[2];
+    CALL_MPN_UMUL_PPMM;  h ^= s->xp_block[3]; l ^= s->yp_block[3];
+     CALL_MPN_UMUL_PPMM; h ^= s->xp_block[4]; l ^= s->yp_block[4];
+     CALL_MPN_UMUL_PPMM; h ^= s->xp_block[5]; l ^= s->yp_block[5];
+    CALL_MPN_UMUL_PPMM;  h ^= s->xp_block[6]; l ^= s->yp_block[6];
+     CALL_MPN_UMUL_PPMM; h ^= s->xp_block[7]; l ^= s->yp_block[7];
+     CALL_MPN_UMUL_PPMM; h ^= s->xp_block[8]; l ^= s->yp_block[8];
+    CALL_MPN_UMUL_PPMM;  h ^= s->xp_block[9]; l ^= s->yp_block[9];
+  }
+  SPEED_MACRO_UMUL_PPMM_B;
+  {
+    CALL_MPN_UMUL_PPMM;
+     CALL_MPN_UMUL_PPMM;
+     CALL_MPN_UMUL_PPMM;
+    CALL_MPN_UMUL_PPMM;
+     CALL_MPN_UMUL_PPMM;
+     CALL_MPN_UMUL_PPMM;
+    CALL_MPN_UMUL_PPMM;
+     CALL_MPN_UMUL_PPMM;
+     CALL_MPN_UMUL_PPMM;
+    CALL_MPN_UMUL_PPMM;
+  }
+  SPEED_MACRO_UMUL_PPMM_C;
+}
+#endif
+
+
+/* The divisions are successively dependent so latency is measured, not
+   issue rate.  There's only 10 per loop so the code doesn't get too big,
+   especially for udiv_qrnnd_preinv and preinv2norm, which are several
+   instructions each.
+
+   Note that it's only the division which is measured here, there's no data
+   fetching and no shifting if the divisor gets normalized.
+
+   In speed_udiv_qrnnd with gcc 2.95.2 on x86 the parameters "q,r,r,q,d"
+   generate x86 div instructions with nothing in between.
+
+   The measuring function macros are in two parts to avoid overflowing
+   preprocessor expansion space if udiv_qrnnd etc are big.
+
+   Limitations:
+
+   Don't blindly use this to set UDIV_TIME in gmp-mparam.h, check the code
+   generated first.
+
+   CPUs with data-dependent divisions may want more attention paid to the
+   randomness of the data used.  Probably the measurement wanted is over
+   uniformly distributed numbers, but what's here might not be giving that.  */
+
+#define SPEED_ROUTINE_UDIV_QRNND_A(normalize)           \
+  {                                                     \
+    double     t;                                       \
+    unsigned   i;                                       \
+    mp_limb_t  q, r, d;                                 \
+    mp_limb_t  dinv;                                    \
+                                                        \
+    s->time_divisor = 10;                               \
+                                                        \
+    /* divisor from "r" parameter, or a default */      \
+    d = s->r;                                           \
+    if (d == 0)                                         \
+      d = 0x12345678;                                   \
+                                                        \
+    if (normalize)                                      \
+      {                                                 \
+        unsigned  norm;                                 \
+        count_leading_zeros (norm, d);                  \
+        d <<= norm;                                     \
+        invert_limb (dinv, d);                          \
+      }                                                 \
+                                                        \
+    q = s->xp[0];                                       \
+    r = s->yp[0] % d;                                   \
+                                                        \
+    speed_starttime ();                                 \
+    i = s->reps;                                        \
+    do                                                  \
+      {
+
+#define SPEED_ROUTINE_UDIV_QRNND_B                                      \
+      }                                                                 \
+    while (--i != 0);                                                   \
+    t = speed_endtime ();                                               \
+                                                                        \
+    /* stop the compiler optimizing away the whole calculation! */      \
+    noop_1 (q);                                                         \
+    noop_1 (r);                                                         \
+                                                                        \
+    return t;                                                           \
+  }
+
+double
+speed_udiv_qrnnd (struct speed_params *s)
+{
+  SPEED_ROUTINE_UDIV_QRNND_A (UDIV_NEEDS_NORMALIZATION);
+  {
+    udiv_qrnnd (q, r, r, q, d);
+     udiv_qrnnd (q, r, r, q, d);
+     udiv_qrnnd (q, r, r, q, d);
+    udiv_qrnnd (q, r, r, q, d);
+     udiv_qrnnd (q, r, r, q, d);
+     udiv_qrnnd (q, r, r, q, d);
+    udiv_qrnnd (q, r, r, q, d);
+     udiv_qrnnd (q, r, r, q, d);
+     udiv_qrnnd (q, r, r, q, d);
+    udiv_qrnnd (q, r, r, q, d);
+  }
+  SPEED_ROUTINE_UDIV_QRNND_B;
+}
+
+double
+speed_udiv_qrnnd_preinv (struct speed_params *s)
+{
+  SPEED_ROUTINE_UDIV_QRNND_A (1);
+  {
+    udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+    udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+    udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+    udiv_qrnnd_preinv (q, r, r, q, d, dinv);
+  }
+  SPEED_ROUTINE_UDIV_QRNND_B;
+}  
+
+double
+speed_udiv_qrnnd_preinv2norm (struct speed_params *s)
+{
+  SPEED_ROUTINE_UDIV_QRNND_A (1);
+  {
+    udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+    udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+    udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+     udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+    udiv_qrnnd_preinv2norm (q, r, r, q, d, dinv);
+  }
+  SPEED_ROUTINE_UDIV_QRNND_B;
+}
+
+#if HAVE_NATIVE_mpn_udiv_qrnnd
+
+#if defined (__hppa) && W_TYPE_SIZE == 64
+#define CALL_MPN_UDIV_QRNND  (q = __MPN (udiv_qrnnd) (r, q, d, &r))
+#else
+#define CALL_MPN_UDIV_QRNND  (q = __MPN (udiv_qrnnd) (&r, r, q, d))
+#endif
+
+double
+speed_mpn_udiv_qrnnd (struct speed_params *s)
+{
+
+  SPEED_ROUTINE_UDIV_QRNND_A (1);
+  {
+    CALL_MPN_UDIV_QRNND;
+     CALL_MPN_UDIV_QRNND;
+     CALL_MPN_UDIV_QRNND;
+    CALL_MPN_UDIV_QRNND;
+     CALL_MPN_UDIV_QRNND;
+     CALL_MPN_UDIV_QRNND;
+    CALL_MPN_UDIV_QRNND;
+     CALL_MPN_UDIV_QRNND;
+     CALL_MPN_UDIV_QRNND;
+    CALL_MPN_UDIV_QRNND;
+  }
+  SPEED_ROUTINE_UDIV_QRNND_B;
+}
+#endif
diff --git a/src/gmp/tune/hppa.asm b/src/gmp/tune/hppa.asm
new file mode 100644
index 000000000..e75709270
--- /dev/null
+++ b/src/gmp/tune/hppa.asm
@@ -0,0 +1,40 @@
+dnl  HPPA 32-bit time stamp counter access routine.
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+dnl Don't include this, it's not ready for hppa
+dnl include(`../config.m4')
+
+dnl void speed_cyclecounter (unsigned p[2]);
+dnl
+dnl Get the HPPA interval timer.
+
+	.code
+	.export speed_cyclecounter
+speed_cyclecounter
+	.proc
+	.callinfo	frame=0,no_calls
+	.entry
+	mfctl	%cr16,%r28
+	stw	%r28,0(0,%r26)
+	bv	0(%r2)
+	.exit
+	stw	%r0,4(0,%r26)
+	.procend
diff --git a/src/gmp/tune/hppa2.asm b/src/gmp/tune/hppa2.asm
new file mode 100644
index 000000000..19d87a367
--- /dev/null
+++ b/src/gmp/tune/hppa2.asm
@@ -0,0 +1,43 @@
+dnl  HPPA 64-bit time stamp counter access routine.
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+dnl Don't include this, it's not ready for hppa
+dnl include(`../config.m4')
+
+dnl void speed_cyclecounter (unsigned p[2]);
+dnl
+dnl Get the HPPA interval timer.
+
+	.level 2.0w
+	.code
+	.export speed_cyclecounter,entry
+speed_cyclecounter
+	.proc
+	.callinfo	frame=0,args_saved
+	.entry
+
+	mfctl	%cr16,%r28
+	stw	%r28,0(0,%r26)		; low word
+	extrd,u	%r28,31,32,%r28
+	bv	0(%r2)
+	.exit
+	stw	%r28,4(0,%r26)		; high word
+	.procend
diff --git a/src/gmp/tune/noop.c b/src/gmp/tune/noop.c
new file mode 100644
index 000000000..b585ab7bf
--- /dev/null
+++ b/src/gmp/tune/noop.c
@@ -0,0 +1,60 @@
+/* Noop routines.
+
+   These are in a separate file to stop gcc recognising do-nothing functions
+   and optimizing away calls to them.  */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#include "speed.h"
+
+
+void
+noop (void)
+{
+}
+
+/*ARGSUSED*/
+void
+noop_1 (mp_limb_t n)
+{
+}
+
+/*ARGSUSED*/
+void
+noop_wxs (mp_ptr wp, mp_srcptr xp, mp_size_t size)
+{
+}
+
+/*ARGSUSED*/
+void
+noop_wxys (mp_ptr wp, mp_srcptr xp, mp_srcptr yp, mp_size_t size)
+{
+}
+
+/*ARGSUSED*/
+void 
+mpn_cache_fill_dummy (mp_limb_t n)
+{
+}
diff --git a/src/gmp/tune/pentium.asm b/src/gmp/tune/pentium.asm
new file mode 100644
index 000000000..7d6b2b34e
--- /dev/null
+++ b/src/gmp/tune/pentium.asm
@@ -0,0 +1,51 @@
+dnl  x86 pentium time stamp counter access routine.
+
+dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+
+include(`../config.m4')
+
+
+C void speed_cyclecounter (unsigned p[2]);
+C
+C Get the pentium rdtsc cycle counter, storing the least significant word in
+C p[0] and the most significant in p[1].
+C
+C cpuid is used to serialize execution.  On big measurements this won't be
+C significant but it may help make small single measurements more accurate.
+
+	.text
+	ALIGN(8)
+
+defframe(PARAM_P,4)
+
+PROLOGUE(speed_cyclecounter)
+deflit(`FRAME',0)
+	pushl	%ebx
+FRAME_pushl()
+	xorl	%eax, %eax
+	cpuid
+	rdtsc
+	movl	PARAM_P, %ebx
+	movl	%eax, (%ebx)
+	movl	%edx, 4(%ebx)
+	popl	%ebx
+	ret
+EPILOGUE()
diff --git a/src/gmp/tune/sparcv9.asm b/src/gmp/tune/sparcv9.asm
new file mode 100644
index 000000000..60229ad4a
--- /dev/null
+++ b/src/gmp/tune/sparcv9.asm
@@ -0,0 +1,36 @@
+dnl  Sparc v9 32-bit time stamp counter access routine.
+
+dnl  Copyright (C) 2000 Free Software Foundation, Inc.
+dnl 
+dnl  This file is part of the GNU MP Library.
+dnl 
+dnl  The GNU MP Library is free software; you can redistribute it and/or
+dnl  modify it under the terms of the GNU Lesser General Public License as
+dnl  published by the Free Software Foundation; either version 2.1 of the
+dnl  License, or (at your option) any later version.
+dnl 
+dnl  The GNU MP Library is distributed in the hope that it will be useful,
+dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+dnl  Lesser General Public License for more details.
+dnl 
+dnl  You should have received a copy of the GNU Lesser General Public
+dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
+dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
+dnl  Suite 330, Boston, MA 02111-1307, USA.
+
+include(`../config.m4')
+
+
+C void speed_cyclecounter (unsigned p[2]);
+C
+C Get the sparc v9 tick counter.
+
+ASM_START()
+PROLOGUE(speed_cyclecounter)
+	rd	%tick,%g1
+	st	%g1,[%o0]		C low 32 bits
+	srlx	%g1,32,%g4
+	retl
+	st	%g4,[%o0+4]		C high 32 bits
+EPILOGUE(speed_cyclecounter)
diff --git a/src/gmp/tune/speed-ext.c b/src/gmp/tune/speed-ext.c
new file mode 100644
index 000000000..a846a1565
--- /dev/null
+++ b/src/gmp/tune/speed-ext.c
@@ -0,0 +1,226 @@
+/* An example of extending the speed program to measure routines not in GMP. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+
+/* The extension here is three versions of an mpn arithmetic mean.  These
+   aren't meant to be particularly useful, just examples.
+
+   You can run something like the following to compare their speeds.
+
+           ./speed-ext -s 1-20 -c mean_calls mean_open mean_open2
+
+   On RISC chips, mean_open() might be fastest if the compiler is doing a
+   good job.  On the register starved x86s, mean_calls will be fastest.
+
+
+   Notes:
+
+   SPEED_EXTRA_PROTOS and SPEED_EXTRA_ROUTINES are macros that get expanded
+   by speed.c in useful places.  SPEED_EXTRA_PROTOS goes after the header
+   files, and SPEED_EXTRA_ROUTINES goes in the array of available routines.
+
+   The advantage of this #include "speed.c" scheme is that there's no
+   editing of a copy of that file, and new features in new versions of it
+   will be immediately available.
+
+   In a real program the routines mean_calls() etc would probably be in
+   separate C or assembler source files, and just the measuring
+   speed_mean_calls() etc would be here.  Linking against other libraries
+   for things to measure is perfectly possible too.
+
+   When attempting to compare two versions of the same named routine, say
+   like the generic and assembler versions of mpn_add_n(), creative use of
+   cc -D or #define is suggested, so one or both can be renamed and linked
+   into the same program.  It'll be much easier to compare them side by side
+   than with separate programs for each.
+
+   common.c has notes on writing speed measuring routines.
+
+   Remember to link against tune/libspeed.la (or tune/.libs/libspeed.a if
+   not using libtool) to get common.o and other objects needed by speed.c.  */
+
+
+#define SPEED_EXTRA_PROTOS                              \
+  double speed_mean_calls (struct speed_params *s);     \
+  double speed_mean_open  (struct speed_params *s);     \
+  double speed_mean_open2 (struct speed_params *s);
+
+#define SPEED_EXTRA_ROUTINES            \
+  { "mean_calls",  speed_mean_calls  }, \
+  { "mean_open",   speed_mean_open   }, \
+  { "mean_open2",  speed_mean_open2  },
+
+#include "speed.c"
+
+
+/* A straightforward implementation calling mpn subroutines.
+
+   wp,size is set to (xp,size + yp,size) / 2.  The return value is the
+   remainder from the division.  The other versions are the same.  */
+
+mp_limb_t
+mean_calls (mp_ptr wp, mp_srcptr xp, mp_srcptr yp, mp_size_t size)
+{
+  mp_limb_t  c, ret;
+
+  ASSERT (size >= 1);
+
+  c = mpn_add_n (wp, xp, yp, size);
+  ret = mpn_rshift (wp, wp, size, 1) >> (BITS_PER_MP_LIMB-1);
+  wp[size-1] |= (c << (BITS_PER_MP_LIMB-1));
+  return ret;
+}
+
+
+/* An open-coded version, making one pass over the data.  The right shift is
+   done as the added limbs are produced.  The addition code follows
+   mpn/generic/add_n.c. */
+
+mp_limb_t
+mean_open (mp_ptr wp, mp_srcptr xp, mp_srcptr yp, mp_size_t size)
+{
+  mp_limb_t  w, wprev, x, y, c, ret;
+  mp_size_t  i;
+
+  ASSERT (size >= 1);
+
+  x = xp[0];
+  y = yp[0];
+
+  wprev = x + y;
+  c = (wprev < x);
+  ret = (wprev & 1);
+
+#define RSHIFT(hi,lo)   (((lo) >> 1) | ((hi) << (BITS_PER_MP_LIMB-1)))
+
+  for (i = 1; i < size; i++)
+    {
+      x = xp[i];
+      y = yp[i];
+
+      w = x + c;
+      c = (w < x);
+      w += y;
+      c += (w < y);
+
+      wp[i-1] = RSHIFT (w, wprev);
+      wprev = w;
+    }
+
+  wp[i-1] = RSHIFT (c, wprev);
+
+  return ret;
+}
+
+
+/* Another one-pass version, but right shifting the source limbs rather than
+   the result limbs.  There's not much chance of this being better than the
+   above, but it's an alternative at least. */
+
+mp_limb_t
+mean_open2 (mp_ptr wp, mp_srcptr xp, mp_srcptr yp, mp_size_t size)
+{
+  mp_limb_t  w, x, y, xnext, ynext, c, ret;
+  mp_size_t  i;
+
+  ASSERT (size >= 1);
+
+  x = xp[0];
+  y = yp[0];
+
+  /* ret is the low bit of x+y, c is the carry out of that low bit add */
+  ret = (x ^ y) & 1;
+  c   = (x & y) & 1;
+
+  for (i = 0; i < size-1; i++)
+    {
+      xnext = xp[i+1];
+      ynext = yp[i+1];
+      x = RSHIFT (xnext, x);
+      y = RSHIFT (ynext, y);
+
+      w = x + c;
+      c = (w < x);
+      w += y;
+      c += (w < y);
+      wp[i] = w;
+
+      x = xnext;
+      y = ynext;
+    }
+
+  wp[i] = (x >> 1) + (y >> 1) + c;
+
+  return ret;
+}
+
+
+/* The speed measuring routines are the same apart from which function they
+   run, so a macro is used.  Actually this macro is the same as
+   SPEED_ROUTINE_MPN_BINARY_N.  */
+
+#define SPEED_ROUTINE_MEAN(mean_fun)                    \
+  {                                                     \
+    unsigned  i;                                        \
+    mp_ptr    wp;                                       \
+    double    t;                                        \
+    TMP_DECL (marker);                                  \
+                                                        \
+    SPEED_RESTRICT_COND (s->size >= 1);                 \
+                                                        \
+    TMP_MARK (marker);                                  \
+    wp = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_wp);  \
+                                                        \
+    speed_operand_src (s, s->xp, s->size);              \
+    speed_operand_src (s, s->yp, s->size);              \
+    speed_operand_dst (s, wp, s->size);                 \
+    speed_cache_fill (s);                               \
+                                                        \
+    speed_starttime ();                                 \
+    i = s->reps;                                        \
+    do                                                  \
+      mean_fun (wp, s->xp, s->yp, s->size);             \
+    while (--i != 0);                                   \
+    t = speed_endtime ();                               \
+                                                        \
+    TMP_FREE (marker);                                  \
+    return t;                                           \
+  }
+
+double
+speed_mean_calls (struct speed_params *s)
+{
+  SPEED_ROUTINE_MEAN (mean_calls);
+}
+
+double
+speed_mean_open (struct speed_params *s)
+{
+  SPEED_ROUTINE_MEAN (mean_open);
+}
+
+double
+speed_mean_open2 (struct speed_params *s)
+{
+  SPEED_ROUTINE_MEAN (mean_open2);
+}
diff --git a/src/gmp/tune/speed.c b/src/gmp/tune/speed.c
new file mode 100644
index 000000000..a86f738d1
--- /dev/null
+++ b/src/gmp/tune/speed.c
@@ -0,0 +1,997 @@
+/* Speed measuring program. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+/* Usage message is in the code below, run with no arguments to print it.
+   See README for interesting applications.
+
+   To add a new routine foo(), create a speed_foo() function in the style of
+   the existing ones and add an entry in the routine[] array.  Put FLAG_R if
+   speed_foo() wants an "r" parameter.
+
+   The routines don't have help messages or descriptions, but most have
+   suggestive names.  See the source code for full details.
+
+*/
+
+#include "config.h"
+
+#if HAVE_GETOPT_H
+#include <getopt.h>  /* for getopt_long() */
+#endif
+#include <limits.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h> /* for getpid() */
+#include <sys/time.h>  /* for struct timeval for sys/resource.h */
+#include <sys/resource.h>  /* for getrusage() */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#include "speed.h"
+
+#if !HAVE_DECL_OPTARG
+extern char *optarg;
+extern int optind, opterr;
+#endif
+
+#if !HAVE_STRTOUL
+#define strtoul(p,e,b)  (unsigned long) strtol(p,e,b)
+#endif
+
+#ifdef SPEED_EXTRA_PROTOS
+SPEED_EXTRA_PROTOS
+#endif
+
+
+#define MPN_FILL(ptr, size, n)                  \
+  do {                                          \
+    mp_size_t  i;                               \
+    for (i = 0; i < size; i++)                  \
+      ptr[i] = n;                               \
+  } while (0)
+
+#define CMP_ABSOLUTE     1
+#define CMP_RATIO        2
+#define CMP_DIFFERENCE   3
+#define CMP_DIFFPREV     4
+int  option_cmp = CMP_ABSOLUTE;
+
+#define UNIT_SECONDS        1
+#define UNIT_CYCLES         2
+#define UNIT_CYCLESPERLIMB  3
+int  option_unit = UNIT_SECONDS;
+
+#define DATA_RANDOM   1
+#define DATA_RANDOM2  2
+#define DATA_ZEROS    3
+#define DATA_FFS      4
+#define DATA_2FD      5
+int  option_data = DATA_RANDOM;
+
+int        option_square = 0;
+double     option_factor = 0.0;
+mp_size_t  option_step = 1;
+int        option_gnuplot = 0;
+char      *option_gnuplot_basename;
+struct size_array_t {
+  mp_size_t start, end;
+} *size_array = NULL;
+mp_size_t  size_num = 0;
+mp_size_t  size_allocnum = 0;
+int        option_resource_usage = 0;
+long       option_seed = 123456789;
+
+struct speed_params  sp;
+
+#define COLUMN_WIDTH  13  /* for the free-form output */
+
+#define FLAG_R            (1<<0)
+#define FLAG_R_OPTIONAL   (1<<1)
+#define FLAG_RSIZE        (1<<2)
+
+const struct routine_t {
+  /* constants */
+  const char        *name;
+  speed_function_t  fun;
+  int               flag;
+  
+} routine[] = {
+
+  { "noop",              speed_noop                 },
+  { "noop_wxs",          speed_noop_wxs             },
+  { "noop_wxys",         speed_noop_wxys            },
+
+  { "mpn_add_n",         speed_mpn_add_n            },
+  { "mpn_sub_n",         speed_mpn_sub_n            },
+  { "mpn_add_n_self",    speed_mpn_add_n_self       },
+  { "mpn_add_n_inplace", speed_mpn_add_n_inplace    },
+
+  { "mpn_addmul_1",      speed_mpn_addmul_1,  FLAG_R },
+  { "mpn_submul_1",      speed_mpn_submul_1,  FLAG_R },
+  { "mpn_mul_1",         speed_mpn_mul_1,     FLAG_R },
+
+  { "mpn_divrem_1",      speed_mpn_divrem_1,  FLAG_R },
+  { "mpn_divrem_1f",     speed_mpn_divrem_1f, FLAG_R },
+#if HAVE_NATIVE_mpn_divrem_1c
+  { "mpn_divrem_1c",     speed_mpn_divrem_1c, FLAG_R },
+  { "mpn_divrem_1cf",    speed_mpn_divrem_1cf,FLAG_R },
+#endif
+  { "mpn_mod_1",         speed_mpn_mod_1,     FLAG_R },
+#if HAVE_NATIVE_mpn_mod_1c
+  { "mpn_mod_1c",        speed_mpn_mod_1c,    FLAG_R },
+#endif
+
+  { "mpn_divrem_2",      speed_mpn_divrem_2,        },
+  { "mpn_divexact_by3",  speed_mpn_divexact_by3     },
+
+  { "mpn_bz_divrem_n",   speed_mpn_bz_divrem_n      },
+  { "mpn_bz_divrem_sb",  speed_mpn_bz_divrem_sb     },
+  { "mpn_bz_tdiv_qr",    speed_mpn_bz_tdiv_qr       },
+
+  { "mpn_lshift",        speed_mpn_lshift, FLAG_R   },
+  { "mpn_rshift",        speed_mpn_rshift, FLAG_R   },
+
+  { "mpn_and_n",         speed_mpn_and_n            },
+  { "mpn_andn_n",        speed_mpn_andn_n           },
+  { "mpn_nand_n",        speed_mpn_nand_n           },
+  { "mpn_ior_n",         speed_mpn_ior_n            },
+  { "mpn_iorn_n",        speed_mpn_iorn_n           },
+  { "mpn_nior_n",        speed_mpn_nior_n           },
+  { "mpn_xor_n",         speed_mpn_xor_n            },
+  { "mpn_xnor_n",        speed_mpn_xnor_n           },
+
+  { "mpn_popcount",      speed_mpn_popcount         },
+  { "mpn_hamdist",       speed_mpn_hamdist          },
+
+  { "mpn_gcdext",        speed_mpn_gcdext           },
+  { "mpn_gcd",           speed_mpn_gcd              },
+  { "mpn_gcd_1",         speed_mpn_gcd_1, FLAG_R_OPTIONAL },
+
+  { "mpn_jacobi_base",   speed_mpn_jacobi_base      },
+
+  { "mpn_mul_basecase",  speed_mpn_mul_basecase, FLAG_R_OPTIONAL },
+  { "mpn_sqr_basecase",  speed_mpn_sqr_basecase     },
+
+  { "mpn_mul_n",         speed_mpn_mul_n            },
+  { "mpn_sqr_n",         speed_mpn_sqr_n            },
+
+  { "mpn_kara_mul_n",    speed_mpn_kara_mul_n       },
+  { "mpn_kara_sqr_n",    speed_mpn_kara_sqr_n       },
+  { "mpn_toom3_mul_n",   speed_mpn_toom3_mul_n      },
+  { "mpn_toom3_sqr_n",   speed_mpn_toom3_sqr_n      },
+  { "mpn_mul_fft_full",     speed_mpn_mul_fft_full     },
+  { "mpn_mul_fft_full_sqr", speed_mpn_mul_fft_full_sqr },
+
+  { "mpn_mul_fft",       speed_mpn_mul_fft,     FLAG_R_OPTIONAL },
+  { "mpn_mul_fft_sqr",   speed_mpn_mul_fft_sqr, FLAG_R_OPTIONAL },
+
+  { "mpz_add",           speed_mpz_add              },
+  { "mpz_bin_uiui",      speed_mpz_bin_uiui, FLAG_R_OPTIONAL },
+  { "mpz_fac_ui",        speed_mpz_fac_ui           },
+  { "mpz_fib_ui",        speed_mpz_fib_ui           },
+  { "mpz_powm",          speed_mpz_powm             },
+
+  { "MPN_COPY",          speed_MPN_COPY             },
+  { "MPN_COPY_INCR",     speed_MPN_COPY_INCR        },
+  { "MPN_COPY_DECR",     speed_MPN_COPY_DECR        },
+  { "memcpy",            speed_memcpy               },
+
+  { "modlimb_invert",    speed_modlimb_invert       },
+
+  { "malloc_free",                 speed_malloc_free                 },
+  { "malloc_realloc_free",         speed_malloc_realloc_free         },
+  { "mp_allocate_free",            speed_mp_allocate_free            },
+  { "mp_allocate_reallocate_free", speed_mp_allocate_reallocate_free },
+  { "mpz_init_clear",              speed_mpz_init_clear              },
+  { "mpq_init_clear",              speed_mpq_init_clear              },
+  { "mpf_init_clear",              speed_mpf_init_clear              },
+  { "mpz_init_realloc_clear",      speed_mpz_init_realloc_clear      },
+
+  { "umul_ppmm",         speed_umul_ppmm,     FLAG_R_OPTIONAL },
+#if HAVE_NATIVE_mpn_umul_ppmm
+  { "mpn_umul_ppmm",     speed_mpn_umul_ppmm, FLAG_R_OPTIONAL },
+#endif
+
+  { "udiv_qrnnd",             speed_udiv_qrnnd,             FLAG_R_OPTIONAL },
+  { "udiv_qrnnd_preinv",      speed_udiv_qrnnd_preinv,      FLAG_R_OPTIONAL },
+  { "udiv_qrnnd_preinv2norm", speed_udiv_qrnnd_preinv2norm, FLAG_R_OPTIONAL },
+#if HAVE_NATIVE_mpn_udiv_qrnnd
+  { "mpn_udiv_qrnnd",         speed_mpn_udiv_qrnnd,         FLAG_R_OPTIONAL },
+#endif
+
+#ifdef SPEED_EXTRA_ROUTINES
+  SPEED_EXTRA_ROUTINES
+#endif
+};
+
+
+struct choice_t {
+  const struct routine_t  *p;
+  int                     r;
+  double                  time;
+  int                     no_time;
+  double                  prev_time;
+  const char              *name;
+};
+struct choice_t  *choice;
+int  num_choices = 0;
+
+
+void
+data_fill (mp_ptr ptr, mp_size_t size)
+{
+  switch (option_data) {
+  case DATA_RANDOM:
+    mpn_random (ptr, size);
+    break;
+  case DATA_RANDOM2:
+    mpn_random2 (ptr, size);
+    break;
+  case DATA_ZEROS:
+    MPN_ZERO (ptr, size);
+    break;
+  case DATA_FFS:
+    MPN_FILL (ptr, size, MP_LIMB_T_MAX);
+    break;
+  case DATA_2FD:
+    MPN_FILL (ptr, size, MP_LIMB_T_MAX);
+    ptr[0] -= 2;
+    break;
+  default:
+    abort();
+    /*NOTREACHED*/
+  }
+}
+
+/* The code here handling the various combinations of output options isn't
+   too attractive, but it works and is fairly clean.  */
+
+#define SIZE_TO_DIVISOR(n)              \
+  (option_square == 1 ? (n)*(n)         \
+  : option_square == 2 ? (n)*((n)+1)/2  \
+  : (n))
+
+void
+run_one (FILE *fp, struct speed_params *s, mp_size_t prev_size)
+{
+  const char  *first_open_fastest, *first_open_notfastest, *first_close;
+  int         i, fastest;
+  double      fastest_time;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  sp.xp = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_xp);
+  sp.yp = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_yp);
+
+  data_fill (s->xp, s->size);
+  data_fill (s->yp, s->size);
+
+  if (prev_size == -1 && option_cmp == CMP_DIFFPREV)
+    {
+      first_open_fastest = "(#";
+      first_open_notfastest = " (";
+      first_close = ")";
+    }
+  else
+    {
+      first_open_fastest = "#";
+      first_open_notfastest = " ";
+      first_close = "";
+    }
+
+  fastest = -1;
+  fastest_time = -1.0;
+  for (i = 0; i < num_choices; i++)
+    {
+      s->r = choice[i].r;
+      choice[i].time = speed_measure (choice[i].p->fun, s);
+      choice[i].no_time = (choice[i].time == -1.0);
+
+
+      /* Apply the effect of CMP_DIFFPREV, but the new choice[i].prev_time
+         is before any differences.  */
+      {
+        double     t;
+        t = choice[i].time;
+        if (t != -1.0 && option_cmp == CMP_DIFFPREV && prev_size != -1)
+          {
+            if (choice[i].prev_time == -1.0)
+              choice[i].no_time = 1;
+            else
+              choice[i].time = choice[i].time - choice[i].prev_time;
+          }
+        choice[i].prev_time = t;
+      }
+
+      if (choice[i].no_time)
+        continue;
+
+      /* Look for the fastest after CMP_DIFFPREV has been applied, but
+         before CMP_RATIO or CMP_DIFFERENCE.  There's only a fastest shown
+         if there's more than one routine.  */
+      if (num_choices > 1 && (fastest == -1 || choice[i].time < fastest_time))
+        {
+          fastest = i;
+          fastest_time = choice[i].time;
+        }
+
+      if (option_cmp == CMP_DIFFPREV)
+        {
+          /* Conversion for UNIT_CYCLESPERLIMB differs in CMP_DIFFPREV. */
+          if (option_unit == UNIT_CYCLES)
+            choice[i].time /= speed_cycletime;
+          else if (option_unit == UNIT_CYCLESPERLIMB)
+            {
+              if (prev_size == -1)
+                choice[i].time /= speed_cycletime;
+              else
+                choice[i].time /=  (speed_cycletime
+                                    * (SIZE_TO_DIVISOR(s->size)
+                                       - SIZE_TO_DIVISOR(prev_size)));
+            }
+        }
+      else
+        {
+          if (option_unit == UNIT_CYCLES)
+            choice[i].time /= speed_cycletime;
+          else if (option_unit == UNIT_CYCLESPERLIMB)
+            choice[i].time /= (speed_cycletime * SIZE_TO_DIVISOR(s->size));
+          
+          if (option_cmp == CMP_RATIO && i > 0)
+            {
+              /* A ratio isn't affected by the units chosen. */
+              if (choice[0].no_time || choice[0].time == 0.0)
+                choice[i].no_time = 1;
+              else
+                choice[i].time /= choice[0].time;
+            }
+          else if (option_cmp == CMP_DIFFERENCE && i > 0)
+            {
+              if (choice[0].no_time)
+                {
+                  choice[i].no_time = 1;
+                  continue;
+                }
+              choice[i].time -= choice[0].time;
+            }
+        }
+    }
+
+  if (option_gnuplot)
+    {
+      /* In CMP_DIFFPREV, don't print anything for the first size, start
+         with the second where an actual difference is available.
+
+         In CMP_RATIO, print the first column as 1.0.
+
+         The 9 decimals printed is much more than the expected precision of
+         the measurements actually. */
+
+      if (! (option_cmp == CMP_DIFFPREV && prev_size == -1))
+        {     
+          fprintf (fp, "%-6ld ", s->size);
+          for (i = 0; i < num_choices; i++)
+            fprintf (fp, "  %.9e", 
+                     choice[i].no_time ? 0.0
+                     : (option_cmp == CMP_RATIO && i == 0) ? 1.0
+                     : choice[i].time);
+          fprintf (fp, "\n");
+        }
+    }
+  else
+    {
+      fprintf (fp, "%-6ld ", s->size);
+      for (i = 0; i < num_choices; i++)
+        {
+          char  buf[128];
+          int   decimals;
+
+          if (choice[i].no_time)
+            decimals = 0, choice[i].time = 0.0;
+          else if (option_unit == UNIT_CYCLESPERLIMB
+                   || (option_cmp == CMP_RATIO && i > 0))
+            decimals = 4;
+          else if (option_unit == UNIT_CYCLES)
+            decimals = 2;
+          else
+            decimals = 9;
+
+          sprintf (buf, "%s%.*f%s",
+                   i == fastest ? first_open_fastest : first_open_notfastest,
+                   decimals, choice[i].time, first_close);
+          fprintf (fp, " %*s", COLUMN_WIDTH, buf);
+        }
+      fprintf (fp, "\n");
+    }
+
+  TMP_FREE (marker);
+}
+
+void
+run_all (FILE *fp)
+{
+  mp_size_t  prev_size;
+  int        i;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  sp.xp_block = SPEED_TMP_ALLOC_LIMBS (SPEED_BLOCK_SIZE, sp.align_xp);
+  sp.yp_block = SPEED_TMP_ALLOC_LIMBS (SPEED_BLOCK_SIZE, sp.align_yp);
+
+  data_fill (sp.xp_block, SPEED_BLOCK_SIZE);
+  data_fill (sp.yp_block, SPEED_BLOCK_SIZE);
+
+  for (i = 0; i < size_num; i++)
+    {
+      sp.size = size_array[i].start;
+      prev_size = -1;
+      for (;;)
+        {
+          mp_size_t  step;
+
+          if (option_data == DATA_2FD && sp.size >= 2)
+            sp.xp[sp.size-1] = 2;
+
+          run_one (fp, &sp, prev_size);
+          prev_size = sp.size;
+
+          if (option_data == DATA_2FD && sp.size >= 2)
+            sp.xp[sp.size-1] = MP_LIMB_T_MAX;
+
+          if (option_factor != 0.0)
+            {
+              step = (mp_size_t) (sp.size * option_factor - sp.size);
+              if (step < 1)
+                step = 1;
+            }
+          else
+            step = 1;
+          if (step < option_step)
+            step = option_step;
+
+          sp.size += step;
+          if (sp.size > size_array[i].end)
+            break;
+        }
+    }
+
+  TMP_FREE (marker);
+}
+
+
+FILE *
+fopen_for_write (const char *filename)
+{
+  FILE  *fp;
+  if ((fp = fopen (filename, "w")) == NULL)
+    {
+      fprintf (stderr, "Cannot create %s\n", filename);
+      exit(1);
+    }
+  return fp;
+}
+      
+void
+fclose_written (FILE *fp, const char *filename)
+{
+  int  err;
+
+  err = ferror (fp);
+  err |= fclose (fp);
+
+  if (err)
+    {
+      fprintf (stderr, "Error writing %s\n", filename);
+      exit(1);
+    }
+}
+
+
+void
+run_gnuplot (void)
+{
+  char  *plot_filename;
+  char  *data_filename;
+  FILE  *fp;
+  int   i;
+     
+  plot_filename = (char *) (*_mp_allocate_func)
+    (strlen (option_gnuplot_basename) + 20);
+  data_filename = (char *) (*_mp_allocate_func)
+    (strlen (option_gnuplot_basename) + 20);
+      
+  sprintf (plot_filename, "%s.gnuplot", option_gnuplot_basename);
+  sprintf (data_filename, "%s.data",    option_gnuplot_basename);
+
+  fp = fopen_for_write (plot_filename);
+
+  /* Putting the key at the top left is usually good, and you can change it
+     interactively if it's not. */
+  fprintf (fp, "set key left\n");
+
+  /* designed to make it possible to see crossovers easily */
+  fprintf (fp, "set data style linespoints\n");
+
+  fprintf (fp, "plot ");
+  for (i = 0; i < num_choices; i++)
+    {
+      fprintf (fp, " \"%s\" using 1:%d", data_filename, i+2);
+      fprintf (fp, " title \"%s\"", choice[i].name);
+
+      if (i != num_choices-1)
+        fprintf (fp, ", \\");
+      fprintf (fp, "\n");
+    }
+
+  fprintf (fp, "load \"-\"\n");
+  fclose_written (fp, plot_filename);
+
+  fp = fopen_for_write (data_filename);
+
+  /* Unbuffered so you can see where the program was up to if it crashes or
+     you kill it. */
+  setbuf (fp, NULL);
+
+  run_all (fp);
+  fclose_written (fp, data_filename);
+}
+
+
+/* Return a long with n many one bits (starting from the least significant) */
+#define LONG_ONES(n) \
+  ((n) == BITS_PER_LONGINT ? -1L : (n) == 0 ? 0L : (1L << (n)) - 1)
+
+long
+r_string (const char *s)
+{
+  const char  *s_orig = s;
+  long  n;
+
+  if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X'))
+    n = strtoul (s+2, (char **) &s, 16);
+  else
+    n = strtol (s, (char **) &s, 10);
+
+  if (strcmp (s, "bits") == 0)
+    {
+      mp_limb_t  l;
+      if (n > BITS_PER_LONGINT)
+        {
+          fprintf (stderr, "%ld bit parameter invalid (max %d bits)\n", 
+                   n, BITS_PER_LONGINT);
+          exit (1);
+        }
+      mpn_random (&l, 1);
+      return (l | (1 << (n-1))) & LONG_ONES(n);
+    }
+  else  if (strcmp (s, "ones") == 0)
+    {
+      if (n > BITS_PER_LONGINT)
+        {
+          fprintf (stderr, "%ld bit parameter invalid (max %d bits)\n", 
+                   n, BITS_PER_LONGINT);
+          exit (1);
+        }
+      return LONG_ONES (n);
+    }
+  else if (*s != '\0')
+    {
+      fprintf (stderr, "invalid r parameter: %s\n", s_orig);
+      exit (1);
+    }
+
+  return n;
+}
+
+
+void
+routine_find (struct choice_t *c, const char *s)
+{
+  int     i;
+  size_t  nlen;
+
+  for (i = 0; i < numberof (routine); i++)
+    {
+      nlen = strlen (routine[i].name);
+      if (memcmp (s, routine[i].name, nlen) != 0)
+        continue;
+
+      if (s[nlen] == '.')
+        {
+          /* match, with a .r parameter */
+
+          if (! (routine[i].flag & (FLAG_R|FLAG_R_OPTIONAL)))
+            {
+              fprintf (stderr, "Choice %s bad: doesn't take a \".<r>\" paramater\n", s);
+              exit (1);
+            }
+
+          c->p = &routine[i];
+          c->r = r_string (s + nlen + 1);
+          c->name = s;
+          return;
+        }
+
+      if (s[nlen] == '\0')
+        {
+          /* match, with no parameter */
+
+          if (routine[i].flag & FLAG_R)
+            {
+              fprintf (stderr, "Choice %s bad: needs a \".<r>\" paramater\n", s);
+              exit (1);
+            }
+
+          c->p = &routine[i];
+          c->r = 0;
+          c->name = s;
+          return;
+        }
+    }
+
+  fprintf (stderr, "Choice %s unrecognised\n", s);
+  exit (1);
+}
+
+
+void
+usage (void)
+{
+  int  i;
+  
+  printf ("\
+Usage: speed [-options] -s size <routine>...\n\
+Measure the speed of some routines.\n\
+Times are in seconds, accuracy is shown.\n\
+\n\
+   -p num     set precision as number of time units each routine must run\n\
+   -s size[-end][,size[-end]]...   sizes to measure\n\
+              single sizes or ranges, sep with comma or use multiple -s\n\
+   -t step    step through sizes by given amount\n\
+   -f factor  step through sizes by given factor (eg. 1.05)\n\
+   -r         show times as ratios of the first routine\n\
+   -d         show times as difference from the first routine\n\
+   -D         show times as difference from previous size shown\n\
+   -c         show times in CPU cycles\n\
+   -C         show times in cycles per limb\n\
+   -u         print resource usage (memory) at end\n\
+   -P name    output plot files \"name.gnuplot\" and \"name.data\"\n\
+   -a <type>  use given data: random(default), random2, zeros, ffs\n\
+   -x, -y, -w, -W <align>  specify data alignments, sources and dests\n\
+   -o addrs   print addresses of data blocks\n\
+\n\
+If both -t and -f are used, it means step by the factor or the step, whichever\n\
+is greater.\n\
+If both -C and -D are used, it means cycles per however many limbs between a\n\
+size and the previous size.\n\
+\n\
+After running with -P, plots can be viewed with Gnuplot or Quickplot.\n\
+\"gnuplot name.gnuplot\" (use \"set logscale xy; replot\" at the prompt for\n\
+a log/log plot).\n\
+\"quickplot -s name.data\" (has interactive zooming, and note -s is important\n\
+when viewing more than one routine, it means same axis scales for all data).\n\
+\n\
+The available routines are as follows.\n\
+\n\
+");
+
+  for (i = 0; i < numberof (routine); i++)
+    {
+      if (routine[i].flag & FLAG_R) 
+        printf ("\t%s.r\n", routine[i].name); 
+      else if (routine[i].flag & FLAG_R_OPTIONAL) 
+        printf ("\t%s (optional .r)\n", routine[i].name); 
+      else
+        printf ("\t%s\n", routine[i].name); 
+    }
+      
+  printf ("\n\
+Routines with a \".r\" need an extra parameter, for example mpn_lshift.6\n\
+r should be in decimal, or use 0xN for hexadecimal.\n\
+Special forms for r are Nbits for a random N bit number, and Nones for N one\n\
+bits.\n\
+\n\
+Times for sizes out of the range accepted by a routine are shown as 0.\n\
+The fastest routine at each size is marked with a # (free form output only).\n\
+\n\
+%s\
+\n\
+Gnuplot home page http://www.cs.dartmouth.edu/gnuplot_info.html\n\
+Quickplot home page http://www.kachinatech.com/~quickplot\n\
+", speed_time_string);
+}
+
+int
+main (int argc, char *argv[])
+{
+#define OPTION_ALIGN     1000
+#if HAVE_GETOPT_LONG
+  static const struct option  longopts[] = {
+    { "align",           required_argument, NULL, OPTION_ALIGN    },
+    { "align-x",         required_argument, NULL, 'x' },
+    { "align-y",         required_argument, NULL, 'y' },
+    { "align-w",         required_argument, NULL, 'w' },
+    { "align-w2",        required_argument, NULL, 'W' },
+    { "data",            required_argument, NULL, 'a' },
+    { "cycles",          no_argument,       NULL, 'c' },
+    { "cycles-per-limb", no_argument,       NULL, 'C' },
+    { "diff",            no_argument,       NULL, 'd' },
+    { "diff-prev",       no_argument,       NULL, 'D' },
+    { "difference",      no_argument,       NULL, 'd' },
+    { "difference-prev", no_argument,       NULL, 'D' },
+    { "factor",          required_argument, NULL, 'f' },
+    { "plot",            no_argument,       NULL, 'P' },
+    { "precision",       required_argument, NULL, 'p' },
+    { "ratio",           no_argument,       NULL, 'r' },
+    { "randomize",       no_argument,       NULL, 'R' },
+    { "sizes",           required_argument, NULL, 's' },
+    { "step",            required_argument, NULL, 't' },
+    { "resources",       required_argument, NULL, 'u' },
+    { "uncached",        no_argument,       NULL, 'z' },
+    { NULL }
+  };
+#endif
+
+  int  i;
+  int  opt;
+
+  /* Unbuffered so output goes straight out when directed to a pipe or file
+     and isn't lost if you kill the program half way.  */
+  setbuf (stdout, NULL);
+
+#define OPTSTRING  "a:CcDdEFf:o:p:P:rRs:t:ux:y:w:W:z"
+#if HAVE_GETOPT_LONG
+  while ((opt = getopt_long(argc, argv, OPTSTRING, longopts, NULL))
+         != EOF)
+#else
+    while ((opt = getopt(argc, argv, OPTSTRING)) != EOF)
+#endif
+      {
+        switch (opt) {
+        case 'a':
+          if (strcmp (optarg, "random") == 0)       option_data = DATA_RANDOM;
+          else if (strcmp (optarg, "random2") == 0) option_data = DATA_RANDOM2;
+          else if (strcmp (optarg, "zeros") == 0)   option_data = DATA_ZEROS;
+          else if (strcmp (optarg, "ffs") == 0)     option_data = DATA_FFS;
+          else if (strcmp (optarg, "2fd") == 0)     option_data = DATA_2FD;
+          else
+            {
+              fprintf (stderr, "unrecognised data option: %s\n", optarg);
+              exit (1);
+            }
+          break;
+        case 'C':
+          if (option_unit  != UNIT_SECONDS) goto bad_unit;
+          option_unit = UNIT_CYCLESPERLIMB;
+          break;
+        case 'c':
+          if (option_unit != UNIT_SECONDS)
+            {
+            bad_unit:
+              fprintf (stderr, "cannot use more than one of -c, -C\n");
+              exit (1);
+            }
+          option_unit = UNIT_CYCLES;
+          break;
+        case 'D':
+          if (option_cmp != CMP_ABSOLUTE) goto bad_cmp;
+          option_cmp = CMP_DIFFPREV;
+          break;
+        case 'd':
+          if (option_cmp != CMP_ABSOLUTE)
+            {
+            bad_cmp:
+              fprintf (stderr, "cannot use more than one of -d, -D, -r\n");
+              exit (1);
+            }
+          option_cmp = CMP_DIFFERENCE;
+          break;
+        case 'E':
+          option_square = 1;
+          break;
+        case 'F':
+          option_square = 2;
+          break;
+        case 'f':
+          option_factor = atof (optarg);
+          if (option_factor <= 1.0)
+            {
+              fprintf (stderr, "-f factor must be > 1.0\n");
+              exit (1);
+            }
+          break;
+        case 'o':
+          speed_option_set (optarg);
+          break;
+        case 'P':
+          option_gnuplot = 1;
+          option_gnuplot_basename = optarg;
+          break;
+        case 'p':
+          speed_precision = atoi (optarg);
+          break;
+        case 'R':
+          option_seed = time (NULL);
+          break;
+        case 'r':
+          if (option_cmp != CMP_ABSOLUTE)
+            goto bad_cmp;
+          option_cmp = CMP_RATIO;
+          break;
+        case 's':
+          {
+            char  *s;
+            for (s = strtok (optarg, ","); s != NULL; s = strtok (NULL, ","))
+              {
+                if (size_num == size_allocnum)
+                  {
+                    size_array = (struct size_array_t *)
+                      _mp_allocate_or_reallocate
+                      (size_array,
+                       size_allocnum * sizeof(size_array[0]),
+                       (size_allocnum+10) * sizeof(size_array[0]));
+                    size_allocnum += 10;
+                  }
+                if (sscanf (s, "%ld-%ld",
+                            &size_array[size_num].start,
+                            &size_array[size_num].end) != 2)
+                  {
+                    size_array[size_num].start = size_array[size_num].end
+                      = atol (s);
+                  }
+
+                if (size_array[size_num].start < 1
+                    || size_array[size_num].end < 1
+                    || size_array[size_num].start > size_array[size_num].end)
+                  {
+                    fprintf (stderr, "invalid size parameter: %s\n", s);
+                    exit (1);
+                  }
+
+                size_num++;
+              }
+          }
+          break;
+        case 't':
+          option_step = atol (optarg);
+          if (option_step < 1)
+            {
+              fprintf (stderr, "-t step must be >= 1\n");
+              exit (1);
+            }
+          break;
+        case 'u':
+          option_resource_usage = 1;
+          break;
+        case 'z':
+          sp.cache = 1;
+          break;
+        case OPTION_ALIGN:
+          abort();
+        case 'x':
+          sp.align_xp = atol (optarg);
+          break;
+        case 'y':
+          sp.align_yp = atol (optarg);
+          break;
+        case 'w':
+          sp.align_wp = atol (optarg);
+          break;
+        case 'W':
+          sp.align_wp2 = atol (optarg);
+          break;
+        case '?':
+          exit(1);
+        }
+      }
+
+  if (optind >= argc)
+    {
+      usage ();
+      exit (1);
+    }
+
+  if (size_num == 0)
+    {
+      fprintf (stderr, "-s <size> must be specified\n");
+      exit (1);
+    }
+
+  srand (option_seed);
+  srandom (option_seed);
+  srand48 (option_seed);
+
+  choice = (struct choice_t *) (*_mp_allocate_func)
+    ((argc - optind) * sizeof(choice[0]));
+  for ( ; optind < argc; optind++)
+    {
+      struct choice_t  c;
+      routine_find (&c, argv[optind]);
+      choice[num_choices] = c;
+      num_choices++;
+    }
+  
+  if ((option_cmp == CMP_RATIO || option_cmp == CMP_DIFFERENCE) &&
+      num_choices < 2)
+    {
+      fprintf (stderr, "WARNING, -d or -r does nothing when only one routine requested\n");
+    }
+
+  speed_time_init ();
+
+  if ((option_unit == UNIT_CYCLES || option_unit == UNIT_CYCLESPERLIMB)
+      && speed_cycletime == 1.0)
+    {
+      fprintf (stderr, "Times in cycles requested, but CPU frequency unknown.\n");
+      fprintf (stderr, "Use environment variable GMP_CPU_FREQUENCY in Hertz, eg. 450e6\n");
+      exit (1);
+    }
+
+  if (option_gnuplot)
+    {
+      run_gnuplot ();
+    }
+  else
+    {
+      if (option_unit == UNIT_SECONDS)
+        printf ("overhead %.9f secs", speed_measure (speed_noop, NULL));
+      else
+        printf ("overhead %.2f cycles",
+                speed_measure (speed_noop, NULL) / speed_cycletime);
+      printf (", precision %d units of %.2e secs, cycle %.1e\n",
+              speed_precision, speed_unittime, speed_cycletime);
+
+      printf ("       ");
+      for (i = 0; i < num_choices; i++)
+        printf (" %*s", COLUMN_WIDTH, choice[i].name); 
+      printf ("\n");
+
+      run_all (stdout);
+    }
+
+  if (option_resource_usage)
+    {
+#if defined(linux)
+      /* This is Linux kernel specific. */
+      char  buf[128];
+      sprintf (buf, "cat /proc/%d/status", getpid());
+      system (buf);
+
+#else
+      /* This doesn't give data sizes on Linux 2.0.36, only utime. */
+      struct rusage  r;
+      if (getrusage (RUSAGE_SELF, &r) != 0)
+        perror ("getrusage");
+      else
+        printf ("utime %ld.%06ld data %ld stack %ld maxresident %ld\n",
+                r.ru_utime.tv_sec, r.ru_utime.tv_usec,
+                r.ru_idrss, r.ru_isrss, r.ru_ixrss); 
+#endif
+    }
+
+  return 0;
+}
+
+
diff --git a/src/gmp/tune/speed.h b/src/gmp/tune/speed.h
new file mode 100644
index 000000000..5fc50bb0e
--- /dev/null
+++ b/src/gmp/tune/speed.h
@@ -0,0 +1,1015 @@
+/* Header for speed and threshold things. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+#ifndef __SPEED_H__
+#define __SPEED_H__
+
+
+/* sizes of temporary space required */
+#define MPN_KARA_MUL_N_TSIZE(n)  (2*((n)+BITS_PER_MP_LIMB))
+#define MPN_KARA_SQR_N_TSIZE(n)  (2*((n)+BITS_PER_MP_LIMB))
+#define MPN_TOOM3_MUL_N_TSIZE(n) (2*(n) + 3*BITS_PER_MP_LIMB)
+#define MPN_TOOM3_SQR_N_TSIZE(n) (2*((n) + BITS_PER_MP_LIMB))
+
+
+/* Pad ptr,oldsize with zero limbs (at the most significant end) to make it
+   newsize long. */
+#define MPN_ZERO_EXTEND(ptr, oldsize, newsize)          \
+  do {                                                  \
+    ASSERT ((newsize) >= (oldsize));                    \
+    MPN_ZERO ((ptr)+(oldsize), (newsize)-(oldsize));    \
+  } while (0)
+
+/* A mask of the least significant n bits.  Note 1<<32 doesn't give zero on
+   x86 family CPUs, hence the separate case for BITS_PER_MP_LIMB. */
+#define MP_LIMB_T_LOWBITMASK(n) \
+  ((n) == BITS_PER_MP_LIMB ? MP_LIMB_T_MAX : ((mp_limb_t) 1 << (n)) - 1)
+
+
+/* align must be a power of 2 here, usually CACHE_LINE_SIZE is a good choice */
+
+#define TMP_ALLOC_ALIGNED(bytes, align) \
+  align_pointer (TMP_ALLOC ((bytes) + (align)-1), (align))
+#define TMP_ALLOC_LIMBS_ALIGNED(limbs, align) \
+  ((mp_ptr) TMP_ALLOC_ALIGNED ((limbs)*sizeof(mp_limb_t), align))
+
+/* 32 for pentium, 64 for athlon, might want to configure this for other
+   CPUs.  In truth though nothing has yet shown up that cares about cache
+   line boundaries.  The only practical effect of this is to restrict the
+   range that s->align_xp can take.  Perhaps this could be a variable
+   instead. */
+#define CACHE_LINE_SIZE    64 /* bytes */
+
+#define SPEED_TMP_ALLOC_ADJUST_MASK  (CACHE_LINE_SIZE/BYTES_PER_MP_LIMB - 1)
+
+#define SPEED_TMP_ALLOC_LIMBS(limbs, align) \
+  (speed_tmp_alloc_adjust             \
+    (TMP_ALLOC_LIMBS((limbs) + SPEED_TMP_ALLOC_ADJUST_MASK), (align)))
+
+
+/* This is the size for s->xp_block and s->yp_block, used in certain
+   routines that want to run across many different data values and use
+   s->size for a different purpose, eg. SPEED_ROUTINE_MPN_GCD_1.
+
+   512 means 2kbytes of data for each of xp_block and yp_block, making 4k
+   total, which should fit easily in any L1 data cache. */
+
+#define SPEED_BLOCK_SIZE   512 /* limbs */
+
+
+extern double  speed_unittime;
+extern double  speed_cycletime;
+extern int     speed_precision;
+extern const char *speed_time_string;
+void speed_time_init _PROTO ((void));
+void speed_starttime _PROTO ((void));
+double speed_endtime _PROTO ((void));
+
+struct speed_params {
+  unsigned   reps;      /* how many times to run the routine */
+  mp_ptr     xp;        /* first argument */
+  mp_ptr     yp;        /* second argument */
+  mp_size_t  size;      /* size of both arguments */
+  long       r;         /* user supplied parameter */
+  mp_size_t  align_xp;  /* alignment of xp */
+  mp_size_t  align_yp;  /* alignment of yp */
+  mp_size_t  align_wp;  /* intended alignment of wp */
+  mp_size_t  align_wp2; /* intended alignment of wp2 */
+  mp_ptr     xp_block;  /* first special SPEED_BLOCK_SIZE block */
+  mp_ptr     yp_block;  /* second special SPEED_BLOCK_SIZE block */
+
+  double     time_divisor; /* optionally set by the speed routine */
+  
+  /* used by the cache priming things */
+  int        cache;
+  unsigned   src_num, dst_num;
+  struct {
+    mp_ptr    ptr;
+    mp_size_t size;
+  } src[2], dst[3];
+};
+
+typedef double (*speed_function_t) _PROTO ((struct speed_params *s));
+
+double speed_measure _PROTO ((speed_function_t fun, struct speed_params *s));
+
+/* Prototypes for speed measuring routines */
+
+double speed_malloc_free _PROTO ((struct speed_params *s));
+double speed_malloc_realloc_free _PROTO ((struct speed_params *s));
+double speed_memcpy _PROTO ((struct speed_params *s));
+double speed_modlimb_invert _PROTO ((struct speed_params *s));
+double speed_mp_allocate_free _PROTO ((struct speed_params *s));
+double speed_mp_allocate_reallocate_free _PROTO ((struct speed_params *s));
+
+double speed_mpf_init_clear _PROTO ((struct speed_params *s));
+
+double speed_mpn_add_n _PROTO ((struct speed_params *s));
+double speed_mpn_add_n_self _PROTO ((struct speed_params *s));
+double speed_mpn_add_n_inplace _PROTO ((struct speed_params *s));
+double speed_mpn_and_n _PROTO ((struct speed_params *s));
+double speed_mpn_andn_n _PROTO ((struct speed_params *s));
+double speed_mpn_addmul_1 _PROTO ((struct speed_params *s));
+double speed_mpn_bz_divrem_n _PROTO ((struct speed_params *s));
+double speed_mpn_bz_divrem_sb _PROTO ((struct speed_params *s));
+double speed_mpn_bz_tdiv_qr _PROTO ((struct speed_params *s));
+double speed_MPN_COPY _PROTO ((struct speed_params *s));
+double speed_MPN_COPY_DECR _PROTO ((struct speed_params *s));
+double speed_MPN_COPY_INCR _PROTO ((struct speed_params *s));
+double speed_mpn_divexact_by3 _PROTO ((struct speed_params *s));
+double speed_mpn_divmod_1 _PROTO ((struct speed_params *s));
+double speed_mpn_divrem_1 _PROTO ((struct speed_params *s));
+double speed_mpn_divrem_1f _PROTO ((struct speed_params *s));
+double speed_mpn_divrem_1c _PROTO ((struct speed_params *s));
+double speed_mpn_divrem_1cf _PROTO ((struct speed_params *s));
+double speed_mpn_divrem_2 _PROTO ((struct speed_params *s));
+double speed_mpn_gcd _PROTO ((struct speed_params *s));
+double speed_mpn_gcd_1 _PROTO ((struct speed_params *s));
+double speed_mpn_gcdext _PROTO ((struct speed_params *s));
+double speed_mpn_hamdist _PROTO ((struct speed_params *s));
+double speed_mpn_ior_n _PROTO ((struct speed_params *s));
+double speed_mpn_iorn_n _PROTO ((struct speed_params *s));
+double speed_mpn_jacobi_base _PROTO ((struct speed_params *s));
+double speed_mpn_kara_mul_n _PROTO ((struct speed_params *s));
+double speed_mpn_kara_sqr_n _PROTO ((struct speed_params *s));
+double speed_mpn_lshift _PROTO ((struct speed_params *s));
+double speed_mpn_mod_1 _PROTO ((struct speed_params *s));
+double speed_mpn_mod_1c _PROTO ((struct speed_params *s));
+double speed_mpn_mul_1 _PROTO ((struct speed_params *s));
+double speed_mpn_mul_basecase _PROTO ((struct speed_params *s));
+double speed_mpn_mul_fft _PROTO ((struct speed_params *s));
+double speed_mpn_mul_fft_sqr _PROTO ((struct speed_params *s));
+double speed_mpn_mul_fft_full _PROTO ((struct speed_params *s));
+double speed_mpn_mul_fft_full_sqr _PROTO ((struct speed_params *s));
+double speed_mpn_mul_n _PROTO ((struct speed_params *s));
+double speed_mpn_mul_n_sqr _PROTO ((struct speed_params *s));
+double speed_mpn_mul_n_toom3 _PROTO ((struct speed_params *s));
+double speed_mpn_nand_n _PROTO ((struct speed_params *s));
+double speed_mpn_nior_n _PROTO ((struct speed_params *s));
+double speed_mpn_popcount _PROTO ((struct speed_params *s));
+double speed_mpn_rshift _PROTO ((struct speed_params *s));
+double speed_mpn_sqr_basecase _PROTO ((struct speed_params *s));
+double speed_mpn_sqr_n _PROTO ((struct speed_params *s));
+double speed_mpn_sqr_toom3 _PROTO ((struct speed_params *s));
+double speed_mpn_sub_n _PROTO ((struct speed_params *s));
+double speed_mpn_submul_1 _PROTO ((struct speed_params *s));
+double speed_mpn_toom3_mul_n _PROTO ((struct speed_params *s));
+double speed_mpn_toom3_sqr_n _PROTO ((struct speed_params *s));
+double speed_mpn_udiv_qrnnd _PROTO ((struct speed_params *s));
+double speed_mpn_umul_ppmm _PROTO ((struct speed_params *s));
+double speed_mpn_xnor_n _PROTO ((struct speed_params *s));
+double speed_mpn_xor_n _PROTO ((struct speed_params *s));
+
+double speed_mpq_init_clear _PROTO ((struct speed_params *s));
+
+double speed_mpz_add _PROTO ((struct speed_params *s));
+double speed_mpz_bin_uiui _PROTO ((struct speed_params *s));
+double speed_mpz_fac_ui _PROTO ((struct speed_params *s));
+double speed_mpz_fib_ui _PROTO ((struct speed_params *s));
+double speed_mpz_init_clear _PROTO ((struct speed_params *s));
+double speed_mpz_init_realloc_clear _PROTO ((struct speed_params *s));
+double speed_mpz_powm _PROTO ((struct speed_params *s));
+
+double speed_noop _PROTO ((struct speed_params *s));
+double speed_noop_wxs _PROTO ((struct speed_params *s));
+double speed_noop_wxys _PROTO ((struct speed_params *s));
+
+double speed_udiv_qrnnd _PROTO ((struct speed_params *s));
+double speed_udiv_qrnnd_preinv _PROTO ((struct speed_params *s));
+double speed_udiv_qrnnd_preinv2norm _PROTO ((struct speed_params *s));
+double speed_umul_ppmm _PROTO ((struct speed_params *s));
+
+
+/* Prototypes for other routines */
+
+/* low 32-bits in p[0], high 32-bits in p[1] */
+void speed_cyclecounter _PROTO ((unsigned p[2]));
+
+void pentium_wbinvd _PROTO ((void));
+
+void noop _PROTO ((void));
+void noop_1 _PROTO ((mp_limb_t n));
+void noop_wxs _PROTO ((mp_ptr wp, mp_srcptr xp, mp_size_t size));
+void noop_wxys _PROTO ((mp_ptr wp, mp_srcptr xp, mp_srcptr yp,
+                        mp_size_t size));
+void mpn_cache_fill _PROTO ((mp_srcptr ptr, mp_size_t size));
+void mpn_cache_fill_dummy _PROTO ((mp_limb_t n));
+mp_ptr speed_tmp_alloc_adjust _PROTO ((void *ptr, mp_size_t align));
+void *_mp_allocate_or_reallocate _PROTO ((void *ptr,
+                                          size_t oldsize, size_t newsize));
+void *align_pointer _PROTO ((void *p, size_t align));
+void *_mp_allocate_func_aligned _PROTO ((size_t bytes, size_t align));
+void speed_cache_fill _PROTO ((struct speed_params *s));
+void speed_operand_src _PROTO ((struct speed_params *s,
+                                mp_ptr ptr, mp_size_t size));
+void speed_operand_dst _PROTO ((struct speed_params *s,
+                                mp_ptr ptr, mp_size_t size));
+void mpz_set_n _PROTO ((mpz_ptr z, mp_srcptr p, mp_size_t size));
+
+extern int  speed_option_addrs;
+void speed_option_set _PROTO((const char *s));
+
+
+#define SPEED_RESTRICT_COND(cond)   if (!(cond)) return -1.0;
+
+/* For mpn_copy or similar. */
+#define SPEED_ROUTINE_MPN_COPY_CALL(call)               \
+  {                                                     \
+    mp_ptr    wp;                                       \
+    unsigned  i;                                        \
+    double    t;                                        \
+    TMP_DECL (marker);                                  \
+                                                        \
+    SPEED_RESTRICT_COND (s->size >= 0);                 \
+                                                        \
+    TMP_MARK (marker);                                  \
+    wp = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_wp);  \
+                                                        \
+    speed_operand_src (s, s->xp, s->size);              \
+    speed_operand_dst (s, wp, s->size);                 \
+    speed_cache_fill (s);                               \
+                                                        \
+    speed_starttime ();                                 \
+    i = s->reps;                                        \
+    do                                                  \
+      call;                                             \
+    while (--i != 0);                                   \
+    t = speed_endtime ();                               \
+                                                        \
+    TMP_FREE (marker);                                  \
+    return t;                                           \
+  }  
+
+#define SPEED_ROUTINE_MPN_COPY(function) \
+  SPEED_ROUTINE_MPN_COPY_CALL(function (wp, s->xp, s->size))
+#define SPEED_ROUTINE_MPN_COPYC(function) \
+  SPEED_ROUTINE_MPN_COPY_CALL(function (wp, s->xp, s->size, 0))
+
+
+/* For mpn_add_n, mpn_sub_n, or similar. */
+#define SPEED_ROUTINE_MPN_BINARY_N_CALL(call)           \
+  {                                                     \
+    mp_ptr    wp;                                       \
+    unsigned  i;                                        \
+    double    t;                                        \
+    TMP_DECL (marker);                                  \
+                                                        \
+    SPEED_RESTRICT_COND (s->size >= 1);                 \
+                                                        \
+    TMP_MARK (marker);                                  \
+    wp = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_wp);  \
+                                                        \
+    speed_operand_src (s, s->xp, s->size);              \
+    speed_operand_src (s, s->yp, s->size);              \
+    speed_operand_dst (s, wp, s->size);                 \
+    speed_cache_fill (s);                               \
+                                                        \
+    speed_starttime ();                                 \
+    i = s->reps;                                        \
+    do                                                  \
+      call;                                             \
+    while (--i != 0);                                   \
+    t = speed_endtime ();                               \
+                                                        \
+    TMP_FREE (marker);                                  \
+    return t;                                           \
+  }  
+
+#define SPEED_ROUTINE_MPN_BINARY_N(function) \
+   SPEED_ROUTINE_MPN_BINARY_N_CALL ((*function) (wp, s->xp, s->yp, s->size))
+
+#define SPEED_ROUTINE_MPN_BINARY_NC(function) \
+   SPEED_ROUTINE_MPN_BINARY_N_CALL ((*function) (wp, s->xp, s->yp, s->size, 0))
+
+#define SPEED_ROUTINE_MPN_BINARY_N_SELF(function) \
+   SPEED_ROUTINE_MPN_BINARY_N_CALL ((*function) (wp, s->xp, s->xp, s->size))
+
+#define SPEED_ROUTINE_MPN_BINARY_N_INPLACE(function) \
+   SPEED_ROUTINE_MPN_BINARY_N_CALL ((*function) (wp, wp, s->xp, s->size))
+
+
+/* For mpn_lshift, mpn_rshift, mpn_mul_1, with r, or similar. */
+#define SPEED_ROUTINE_MPN_UNARY_1_CALL(call)            \
+  {                                                     \
+    mp_ptr    wp;                                       \
+    unsigned  i;                                        \
+    double    t;                                        \
+    TMP_DECL (marker);                                  \
+                                                        \
+    SPEED_RESTRICT_COND (s->size >= 1);                 \
+                                                        \
+    TMP_MARK (marker);                                  \
+    wp = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_wp);  \
+                                                        \
+    speed_operand_src (s, s->xp, s->size);              \
+    speed_operand_dst (s, wp, s->size);                 \
+    speed_cache_fill (s);                               \
+                                                        \
+    speed_starttime ();                                 \
+    i = s->reps;                                        \
+    do                                                  \
+      call;                                             \
+    while (--i != 0);                                   \
+    t = speed_endtime ();                               \
+                                                        \
+    TMP_FREE (marker);                                  \
+    return t;                                           \
+  }  
+
+#define SPEED_ROUTINE_MPN_UNARY_1(function) \
+  SPEED_ROUTINE_MPN_UNARY_1_CALL ((*function) (wp, s->xp, s->size, s->r))
+
+#define SPEED_ROUTINE_MPN_UNARY_1C(function) \
+  SPEED_ROUTINE_MPN_UNARY_1_CALL ((*function) (wp, s->xp, s->size, s->r, 0))
+
+#define SPEED_ROUTINE_MPN_DIVREM_1(function) \
+  SPEED_ROUTINE_MPN_UNARY_1_CALL ((*function) (wp, 0, s->xp, s->size, s->r))
+
+#define SPEED_ROUTINE_MPN_DIVREM_1C(function) \
+  SPEED_ROUTINE_MPN_UNARY_1_CALL ((*function) (wp, 0, s->xp, s->size, s->r, 0))
+
+#define SPEED_ROUTINE_MPN_DIVREM_1F(function) \
+  SPEED_ROUTINE_MPN_UNARY_1_CALL ((*function) (wp, s->size, s->xp, 0, s->r))
+
+#define SPEED_ROUTINE_MPN_DIVREM_1CF(function) \
+  SPEED_ROUTINE_MPN_UNARY_1_CALL ((*function) (wp, s->size, s->xp, 0, s->r, 0))
+
+
+/* For mpn_mul_basecase, xsize=r, ysize=s->size. */
+#define SPEED_ROUTINE_MPN_MUL_BASECASE(function)                \
+  {                                                             \
+    mp_ptr    wp;                                               \
+    mp_size_t  size1;                                           \
+    unsigned  i;                                                \
+    double    t;                                                \
+    TMP_DECL (marker);                                          \
+                                                                \
+    size1 = (s->r == 0 ? s->size : s->r);                       \
+                                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);                         \
+    SPEED_RESTRICT_COND (size1 >= s->size);                     \
+                                                                \
+    TMP_MARK (marker);                                          \
+    wp = SPEED_TMP_ALLOC_LIMBS (size1 + s->size, s->align_wp);  \
+                                                                \
+    speed_operand_src (s, s->xp, size1);                        \
+    speed_operand_src (s, s->yp, s->size);                      \
+    speed_operand_dst (s, wp, size1 + s->size);                 \
+    speed_cache_fill (s);                                       \
+                                                                \
+    speed_starttime ();                                         \
+    i = s->reps;                                                \
+    do                                                          \
+      function (wp, s->xp, size1, s->yp, s->size);              \
+    while (--i != 0);                                           \
+    t = speed_endtime ();                                       \
+                                                                \
+    TMP_FREE (marker);                                          \
+    return t;                                                   \
+  }  
+
+
+#define SPEED_ROUTINE_MPN_MUL_N_CALL(call)                      \
+  {                                                             \
+    mp_ptr    wp;                                               \
+    unsigned  i;                                                \
+    double    t;                                                \
+    TMP_DECL (marker);                                          \
+                                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);                         \
+                                                                \
+    TMP_MARK (marker);                                          \
+    wp = SPEED_TMP_ALLOC_LIMBS (2*s->size, s->align_wp);        \
+                                                                \
+    speed_operand_src (s, s->xp, s->size);                      \
+    speed_operand_src (s, s->yp, s->size);                      \
+    speed_operand_dst (s, wp, 2*s->size);                       \
+    speed_cache_fill (s);                                       \
+                                                                \
+    speed_starttime ();                                         \
+    i = s->reps;                                                \
+    do                                                          \
+      call;                                                     \
+    while (--i != 0);                                           \
+    t = speed_endtime ();                                       \
+                                                                \
+    TMP_FREE (marker);                                          \
+    return t;                                                   \
+  }  
+
+#define SPEED_ROUTINE_MPN_MUL_N(function) \
+  SPEED_ROUTINE_MPN_MUL_N_CALL (function (wp, s->xp, s->yp, s->size));
+
+
+#define SPEED_ROUTINE_MPN_MUL_N_TSPACE(call, tsize)             \
+  {                                                             \
+    mp_ptr    wp, tspace;                                       \
+    unsigned  i;                                                \
+    double    t;                                                \
+    TMP_DECL (marker);                                          \
+                                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);                         \
+                                                                \
+    TMP_MARK (marker);                                          \
+    wp = SPEED_TMP_ALLOC_LIMBS (2*s->size, s->align_wp);        \
+    tspace = SPEED_TMP_ALLOC_LIMBS (tsize, s->align_wp2);       \
+                                                                \
+    speed_operand_src (s, s->xp, s->size);                      \
+    speed_operand_src (s, s->yp, s->size);                      \
+    speed_operand_dst (s, wp, 2*s->size);                       \
+    speed_operand_dst (s, tspace, tsize);                       \
+    speed_cache_fill (s);                                       \
+                                                                \
+    speed_starttime ();                                         \
+    i = s->reps;                                                \
+    do                                                          \
+      call;                                                     \
+    while (--i != 0);                                           \
+    t = speed_endtime ();                                       \
+                                                                \
+    TMP_FREE (marker);                                          \
+    return t;                                                   \
+  }  
+
+/* FIXME: size restrictions */
+#define SPEED_ROUTINE_MPN_KARA_MUL_N(function)          \
+  SPEED_ROUTINE_MPN_MUL_N_TSPACE                        \
+    (function (wp, s->xp, s->xp, s->size, tspace),      \
+     MPN_KARA_MUL_N_TSIZE (s->size))
+
+/* FIXME: size restrictions */
+#define SPEED_ROUTINE_MPN_TOOM3_MUL_N(function)         \
+  SPEED_ROUTINE_MPN_MUL_N_TSPACE                        \
+    (function (wp, s->xp, s->yp, s->size, tspace),      \
+     MPN_TOOM3_MUL_N_TSIZE (s->size))
+
+
+#define SPEED_ROUTINE_MPN_SQR_CALL(call)                        \
+  {                                                             \
+    mp_ptr    wp;                                               \
+    unsigned  i;                                                \
+    double    t;                                                \
+    TMP_DECL (marker);                                          \
+                                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);                         \
+                                                                \
+    TMP_MARK (marker);                                          \
+    wp = SPEED_TMP_ALLOC_LIMBS (2*s->size, s->align_wp);        \
+                                                                \
+    speed_operand_src (s, s->xp, s->size);                      \
+    speed_operand_dst (s, wp, 2*s->size);                       \
+    speed_cache_fill (s);                                       \
+                                                                \
+    speed_starttime ();                                         \
+    i = s->reps;                                                \
+    do                                                          \
+      call;                                                     \
+    while (--i != 0);                                           \
+    t = speed_endtime ();                                       \
+                                                                \
+    TMP_FREE (marker);                                          \
+    return t;                                                   \
+  }  
+
+#define SPEED_ROUTINE_MPN_SQR(function) \
+  SPEED_ROUTINE_MPN_SQR_CALL (function (wp, s->xp, s->size))
+
+
+#define SPEED_ROUTINE_MPN_SQR_TSPACE(call, tsize)               \
+  {                                                             \
+    mp_ptr    wp, tspace;                                       \
+    unsigned  i;                                                \
+    double    t;                                                \
+    TMP_DECL (marker);                                          \
+                                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);                         \
+                                                                \
+    TMP_MARK (marker);                                          \
+    wp = SPEED_TMP_ALLOC_LIMBS (2*s->size, s->align_wp);        \
+    tspace = SPEED_TMP_ALLOC_LIMBS (tsize, s->align_wp2);       \
+                                                                \
+    speed_operand_src (s, s->xp, s->size);                      \
+    speed_operand_dst (s, wp, 2*s->size);                       \
+    speed_operand_dst (s, tspace, tsize);                       \
+    speed_cache_fill (s);                                       \
+                                                                \
+    speed_starttime ();                                         \
+    i = s->reps;                                                \
+    do                                                          \
+      call;                                                     \
+    while (--i != 0);                                           \
+    t = speed_endtime ();                                       \
+                                                                \
+    TMP_FREE (marker);                                          \
+    return t;                                                   \
+  }  
+
+/* FIXME: size restrictions */
+#define SPEED_ROUTINE_MPN_KARA_SQR_N(function)                          \
+  SPEED_ROUTINE_MPN_SQR_TSPACE (function (wp, s->xp, s->size, tspace),  \
+                                MPN_KARA_SQR_N_TSIZE (s->size))
+
+/* FIXME: size restrictions */
+#define SPEED_ROUTINE_MPN_TOOM3_SQR_N(function)                         \
+  SPEED_ROUTINE_MPN_SQR_TSPACE (function (wp, s->xp, s->size, tspace),  \
+                                MPN_TOOM3_SQR_N_TSIZE (s->size))
+
+
+#define SPEED_ROUTINE_MPN_MOD_CALL(call)        \
+  {                                             \
+    unsigned  i;                                \
+                                                \
+    SPEED_RESTRICT_COND (s->size >= 0);         \
+                                                \
+    speed_operand_src (s, s->xp, s->size);      \
+    speed_cache_fill (s);                       \
+                                                \
+    speed_starttime ();                         \
+    i = s->reps;                                \
+    do                                          \
+      call;                                     \
+    while (--i != 0);                           \
+    return speed_endtime ();                    \
+  }  
+
+#define SPEED_ROUTINE_MPN_MOD_1(function)  \
+   SPEED_ROUTINE_MPN_MOD_CALL ((*function) (s->xp, s->size, s->r))
+
+#define SPEED_ROUTINE_MPN_MOD_1C(function) \
+   SPEED_ROUTINE_MPN_MOD_CALL ((*function) (s->xp, s->size, s->r, 0))
+
+
+/* A division of 2*s->size by s->size limbs */
+
+#define SPEED_ROUTINE_MPN_BZ_DIVREM_CALL(call)                  \
+  {                                                             \
+    unsigned   i;                                               \
+    mp_ptr     a, d, q, r;                                      \
+    double    t;                                                \
+    TMP_DECL (marker);                                          \
+                                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);                         \
+                                                                \
+    TMP_MARK (marker);                                          \
+    a = SPEED_TMP_ALLOC_LIMBS (2*s->size, s->align_xp);         \
+    d = SPEED_TMP_ALLOC_LIMBS (s->size,   s->align_yp);         \
+    q = SPEED_TMP_ALLOC_LIMBS (s->size+1, s->align_wp);         \
+    r = SPEED_TMP_ALLOC_LIMBS (s->size,   s->align_wp2);        \
+                                                                \
+    MPN_COPY (a, s->xp, s->size);                               \
+    MPN_COPY (a+s->size, s->xp, s->size);                       \
+                                                                \
+    MPN_COPY (d, s->yp, s->size);                               \
+                                                                \
+    /* normalize the data */                                    \
+    d[s->size-1] |= MP_LIMB_T_HIGHBIT;                          \
+    a[2*s->size-1] = d[s->size-1] - 1;                          \
+                                                                \
+    speed_operand_src (s, a, 2*s->size);                        \
+    speed_operand_src (s, d, s->size);                          \
+    speed_operand_dst (s, q, s->size+1);                        \
+    speed_operand_dst (s, r, s->size);                          \
+    speed_cache_fill (s);                                       \
+                                                                \
+    speed_starttime ();                                         \
+    i = s->reps;                                                \
+    do                                                          \
+      call;                                                     \
+    while (--i != 0);                                           \
+    t = speed_endtime ();                                       \
+                                                                \
+    TMP_FREE (marker);                                          \
+    return t;                                                   \
+  }  
+
+#define SPEED_ROUTINE_MPN_BZ_DIVREM_N(function) \
+  SPEED_ROUTINE_MPN_BZ_DIVREM_CALL((*function) (q, a, d, s->size))
+
+#define SPEED_ROUTINE_MPN_BZ_DIVREM_SB(function)        \
+  SPEED_ROUTINE_MPN_BZ_DIVREM_CALL                      \
+    ((*function) (q, a, 2*s->size, d, s->size))
+
+#define SPEED_ROUTINE_MPN_BZ_TDIV_QR(function)          \
+  SPEED_ROUTINE_MPN_BZ_DIVREM_CALL                      \
+    ((*function) (q, r, 0, a, 2*s->size, d, s->size))
+
+
+#define SPEED_ROUTINE_MPN_POPCOUNT(function)    \
+  {                                             \
+    unsigned  i;                                \
+                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);         \
+                                                \
+    speed_operand_src (s, s->xp, s->size);      \
+    speed_cache_fill (s);                       \
+                                                \
+    speed_starttime ();                         \
+    i = s->reps;                                \
+    do                                          \
+      function (s->xp, s->size);                \
+    while (--i != 0);                           \
+    return speed_endtime ();                    \
+  }  
+
+#define SPEED_ROUTINE_MPN_HAMDIST(function)     \
+  {                                             \
+    unsigned  i;                                \
+                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);         \
+                                                \
+    speed_operand_src (s, s->xp, s->size);      \
+    speed_operand_src (s, s->yp, s->size);      \
+    speed_cache_fill (s);                       \
+                                                \
+    speed_starttime ();                         \
+    i = s->reps;                                \
+    do                                          \
+      function (s->xp, s->yp, s->size);         \
+    while (--i != 0);                           \
+    return speed_endtime ();                    \
+  }  
+
+
+/* For mpz_fib_ui, mpz_fac_ui, etc */
+
+#define SPEED_ROUTINE_MPZ_UI(function)  \
+  {                                     \
+    mpz_t     z;                        \
+    unsigned  i;                        \
+    double    t;                        \
+                                        \
+    SPEED_RESTRICT_COND (s->size >= 0); \
+                                        \
+    mpz_init (z);                       \
+                                        \
+    speed_starttime ();                 \
+    i = s->reps;                        \
+    do                                  \
+      function (z, s->size);            \
+    while (--i != 0);                   \
+    t = speed_endtime ();               \
+                                        \
+    mpz_clear (z);                      \
+    return t;                           \
+  }  
+
+
+/* Calculate 2^(m-1) mod m for random odd m of s->size limbs.  Having m odd
+   allows redc to be used.  Actually the exponent (m-1) is cut down to at
+   most 6 limbs so the calculation doesn't take too long.  */
+#define SPEED_ROUTINE_MPZ_POWM(function)        \
+  {                                             \
+    mpz_t     r, b, e, m;                       \
+    unsigned  i;                                \
+    double    t;                                \
+                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);         \
+                                                \
+    mpz_init (r);                               \
+    mpz_init_set_ui (b, 2);                     \
+                                                \
+    /* force m to odd */                        \
+    mpz_init (m);                               \
+    mpz_set_n (m, s->xp, s->size);              \
+    PTR(m)[0] |= 1;                             \
+                                                \
+    mpz_init_set (e, m);                        \
+    mpz_sub_ui (e, e, 1);                       \
+    SIZ(e) = MIN (SIZ(e), 6);                   \
+                                                \
+    speed_starttime ();                         \
+    i = s->reps;                                \
+    do                                          \
+      function (r, b, e, m);                    \
+    while (--i != 0);                           \
+    t = speed_endtime ();                       \
+                                                \
+    mpz_clear (r);                              \
+    mpz_clear (b);                              \
+    mpz_clear (e);                              \
+    mpz_clear (m);                              \
+    return t;                                   \
+  }  
+
+
+#define SPEED_ROUTINE_MPN_ADDSUB_CALL(call)                               \
+  {                                                                       \
+    mp_ptr    wp, wp2, xp, yp;                                            \
+    unsigned  i;                                                          \
+    double    t;                                                          \
+    TMP_DECL (marker);                                                    \
+                                                                          \
+    SPEED_RESTRICT_COND (s->size >= 0);                                   \
+                                                                          \
+    TMP_MARK (marker);                                                    \
+    wp  = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_wp);                   \
+    wp2 = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_wp2);                  \
+    xp = s->xp;                                                           \
+    yp = s->yp;                                                           \
+                                                                          \
+    switch (s->r) {                                                       \
+    case 0:                           break;                              \
+    case 1: xp =    wp;               break;                              \
+    case 2:              yp =    wp2; break;                              \
+    case 3: xp =    wp;  yp =    wp2; break;                              \
+    case 4: xp =    wp2; yp =    wp;  break;                              \
+    default:                                                              \
+      fprintf (stderr, "Unrecognised r=%ld in addsub measuring\n", s->r); \
+      abort ();                                                           \
+    }                                                                     \
+    if (xp != s->xp) MPN_COPY (xp, s->xp, s->size);                       \
+    if (yp != s->yp) MPN_COPY (yp, s->yp, s->size);                       \
+                                                                          \
+    speed_operand_src (s, xp, s->size);                                   \
+    speed_operand_src (s, yp, s->size);                                   \
+    speed_operand_dst (s, wp, s->size);                                   \
+    speed_operand_dst (s, wp2, s->size);                                  \
+    speed_cache_fill (s);                                                 \
+                                                                          \
+    speed_starttime ();                                                   \
+    i = s->reps;                                                          \
+    do                                                                    \
+      call;                                                               \
+    while (--i != 0);                                                     \
+    t = speed_endtime ();                                                 \
+                                                                          \
+    TMP_FREE (marker);                                                    \
+    return t;                                                             \
+  }
+
+#define SPEED_ROUTINE_MPN_ADDSUB_N(function)    \
+  SPEED_ROUTINE_MPN_ADDSUB_CALL                 \
+    (function (wp, wp2, xp, yp, s->size));
+
+#define SPEED_ROUTINE_MPN_ADDSUB_NC(function)   \
+  SPEED_ROUTINE_MPN_ADDSUB_CALL                 \
+    (function (wp, wp2, xp, yp, s->size, 0));
+
+
+#define SPEED_ROUTINE_MPN_GCD_1xN(function)     \
+  {                                             \
+    unsigned  i;                                \
+    double    t;                                \
+    TMP_DECL (marker);                          \
+                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);         \
+    SPEED_RESTRICT_COND (s->r != 0);            \
+                                                \
+    TMP_MARK (marker);                          \
+                                                \
+    speed_operand_src (s, s->xp, s->size);      \
+    speed_cache_fill (s);                       \
+                                                \
+    speed_starttime ();                         \
+    i = s->reps;                                \
+    do                                          \
+      function (s->xp, s->size, s->r);          \
+    while (--i != 0);                           \
+    t = speed_endtime ();                       \
+                                                \
+    TMP_FREE (marker);                          \
+    return t;                                   \
+  }  
+
+
+/* SPEED_BLOCK_SIZE many one GCDs of s->size bits each. */
+
+#define SPEED_ROUTINE_MPN_GCD_1_CALL(setup, call)               \
+  {                                                             \
+    unsigned  i, j;                                             \
+    mp_ptr    px, py;                                           \
+    mp_limb_t x_mask, y_mask;                                   \
+    double    t;                                                \
+    TMP_DECL (marker);                                          \
+                                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);                         \
+    SPEED_RESTRICT_COND (s->size <= mp_bits_per_limb);          \
+                                                                \
+    TMP_MARK (marker);                                          \
+    px = SPEED_TMP_ALLOC_LIMBS (SPEED_BLOCK_SIZE, s->align_xp); \
+    py = SPEED_TMP_ALLOC_LIMBS (SPEED_BLOCK_SIZE, s->align_yp); \
+    MPN_COPY (px, s->xp_block, SPEED_BLOCK_SIZE);               \
+    MPN_COPY (py, s->yp_block, SPEED_BLOCK_SIZE);               \
+                                                                \
+    x_mask = MP_LIMB_T_LOWBITMASK (s->size);                    \
+    y_mask = MP_LIMB_T_LOWBITMASK (s->r != 0 ? s->r : s->size); \
+    for (i = 0; i < SPEED_BLOCK_SIZE; i++)                      \
+      {                                                         \
+        px[i] &= x_mask; px[i] += (px[i] == 0);                 \
+        py[i] &= y_mask; py[i] += (py[i] == 0);                 \
+        setup;                                                  \
+      }                                                         \
+                                                                \
+    speed_operand_src (s, px, SPEED_BLOCK_SIZE);                \
+    speed_operand_src (s, py, SPEED_BLOCK_SIZE);                \
+    speed_cache_fill (s);                                       \
+                                                                \
+    speed_starttime ();                                         \
+    i = s->reps;                                                \
+    do                                                          \
+      {                                                         \
+        j = SPEED_BLOCK_SIZE;                                   \
+        do                                                      \
+          {                                                     \
+            call;                                               \
+          }                                                     \
+        while (--j != 0);                                       \
+      }                                                         \
+    while (--i != 0);                                           \
+    t = speed_endtime ();                                       \
+                                                                \
+    TMP_FREE (marker);                                          \
+                                                                \
+    s->time_divisor = SPEED_BLOCK_SIZE;                         \
+    return t;                                                   \
+  }  
+
+#define SPEED_ROUTINE_MPN_GCD_1(function) \
+  SPEED_ROUTINE_MPN_GCD_1_CALL( , function (&px[j-1], 1, py[j-1]))
+
+#define SPEED_ROUTINE_MPN_JACBASE(function)     \
+  SPEED_ROUTINE_MPN_GCD_1_CALL                  \
+    ({                                          \
+       px[i] %= py[i];                          \
+       px[i] |= 1;                              \
+       py[i] |= 1;                              \
+       if (py[i]==1) py[i]=3;                   \
+     },                                         \
+     function (px[j-1], py[j-1], 0))
+
+
+/* Run some GCDs of s->size limbs each.  The number of different data values
+   is decreased as s->size**2, since GCD is a quadratic algorithm.
+   SPEED_ROUTINE_MPN_GCD runs more times than SPEED_ROUTINE_MPN_GCDEXT
+   though, because the plain gcd is about twice as fast as gcdext.  */
+
+#define SPEED_ROUTINE_MPN_GCD_CALL(datafactor, call)            \
+  {                                                             \
+    unsigned  i;                                                \
+    mp_size_t j, pieces, psize;                                 \
+    mp_ptr    wp, wp2, xtmp, ytmp, px, py;                      \
+    double    t;                                                \
+    TMP_DECL (marker);                                          \
+                                                                \
+    SPEED_RESTRICT_COND (s->size >= 1);                         \
+                                                                \
+    TMP_MARK (marker);                                          \
+    xtmp = SPEED_TMP_ALLOC_LIMBS (s->size+1, s->align_xp);      \
+    ytmp = SPEED_TMP_ALLOC_LIMBS (s->size+1, s->align_yp);      \
+    wp = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_wp);          \
+    wp2 = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_wp2);        \
+                                                                \
+    pieces = SPEED_BLOCK_SIZE * datafactor / s->size / s->size; \
+    pieces = MAX (pieces, 1);                                   \
+    pieces = MIN (pieces, SPEED_BLOCK_SIZE / s->size);          \
+                                                                \
+    psize = pieces * s->size;                                   \
+    px = TMP_ALLOC_LIMBS (psize);                               \
+    py = TMP_ALLOC_LIMBS (psize);                               \
+    MPN_COPY (px, pieces==1 ? s->xp : s->xp_block, psize);      \
+    MPN_COPY (py, pieces==1 ? s->yp : s->yp_block, psize);      \
+                                                                \
+    /* y must be odd, x must have at least as many bits as y */ \
+    for (j = 0; j < pieces; j++)                                \
+      {                                                         \
+        mp_ptr  x = px+j*s->size;                               \
+        mp_ptr  y = py+j*s->size;                               \
+        y[0] |= 1;                                              \
+        if (x[s->size-1] == 0) x[s->size-1] = 1;                \
+        if (y[s->size-1] == 0) y[s->size-1] = 1;                \
+        x[s->size-1] = MAX (x[s->size-1], y[s->size-1]);        \
+      }                                                         \
+                                                                \
+    speed_operand_src (s, px, psize);                           \
+    speed_operand_src (s, py, psize);                           \
+    speed_operand_dst (s, xtmp, s->size);                       \
+    speed_operand_dst (s, ytmp, s->size);                       \
+    speed_operand_dst (s, wp, s->size);                         \
+    speed_cache_fill (s);                                       \
+                                                                \
+    speed_starttime ();                                         \
+    i = s->reps;                                                \
+    do                                                          \
+      {                                                         \
+        j = pieces;                                             \
+        do                                                      \
+          {                                                     \
+            MPN_COPY (xtmp, px+(j-1)*s->size, s->size);         \
+            MPN_COPY (ytmp, py+(j-1)*s->size, s->size);         \
+            call;                                               \
+          }                                                     \
+        while (--j != 0);                                       \
+      }                                                         \
+    while (--i != 0);                                           \
+    t = speed_endtime ();                                       \
+                                                                \
+    TMP_FREE (marker);                                          \
+                                                                \
+    s->time_divisor = pieces;                                   \
+    return t;                                                   \
+  }  
+
+#define SPEED_ROUTINE_MPN_GCD(function) \
+  SPEED_ROUTINE_MPN_GCD_CALL (8, function (wp, xtmp, s->size, ytmp, s->size))
+
+#define SPEED_ROUTINE_MPN_GCDEXT(function)                               \
+  SPEED_ROUTINE_MPN_GCD_CALL                                             \
+    (4, { mp_size_t  wp2size;                                            \
+          function (wp, wp2, &wp2size, xtmp, s->size, ytmp, s->size); })
+
+
+#define SPEED_ROUTINE_MPN_DIVREM_2(function)            \
+  {                                                     \
+    mp_ptr    wp, xp;                                   \
+    mp_limb_t yp[2];                                    \
+    unsigned  i;                                        \
+    double    t;                                        \
+    TMP_DECL (marker);                                  \
+                                                        \
+    SPEED_RESTRICT_COND (s->size >= 1);                 \
+                                                        \
+    TMP_MARK (marker);                                  \
+    xp = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_xp);  \
+    wp = SPEED_TMP_ALLOC_LIMBS (s->size, s->align_wp);  \
+                                                        \
+    /* source is destroyed */                           \
+    MPN_COPY (xp, s->xp, s->size);                      \
+                                                        \
+    /* divisor must be normalized */                    \
+    MPN_COPY (yp, s->yp_block, 2);                      \
+    yp[1] |= MP_LIMB_T_HIGHBIT;                         \
+                                                        \
+    speed_operand_src (s, xp, s->size);                 \
+    speed_operand_src (s, yp, 2);                       \
+    speed_operand_dst (s, wp, s->size);                 \
+    speed_cache_fill (s);                               \
+                                                        \
+    speed_starttime ();                                 \
+    i = s->reps;                                        \
+    do                                                  \
+      function (wp, 0, xp, s->size, yp);                \
+    while (--i != 0);                                   \
+    t = speed_endtime ();                               \
+                                                        \
+    TMP_FREE (marker);                                  \
+    return t;                                           \
+  }  
+
+
+#define SPEED_ROUTINE_MODLIMB_INVERT(function)                  \
+  {                                                             \
+    unsigned   i, j;                                            \
+    mp_ptr     xp;                                              \
+    mp_limb_t  n = 1;                                           \
+    double     t;                                               \
+                                                                \
+    xp = s->xp_block-1;                                         \
+                                                                \
+    speed_operand_src (s, s->xp_block, SPEED_BLOCK_SIZE);       \
+    speed_cache_fill (s);                                       \
+                                                                \
+    speed_starttime ();                                         \
+    i = s->reps;                                                \
+    do                                                          \
+      {                                                         \
+        j = SPEED_BLOCK_SIZE;                                   \
+        do                                                      \
+          {                                                     \
+            /* randomized but successively dependent */         \
+            n += (xp[j] << 1);                                  \
+                                                                \
+            function (n, n);                                    \
+          }                                                     \
+        while (--j != 0);                                       \
+      }                                                         \
+    while (--i != 0);                                           \
+    t = speed_endtime ();                                       \
+                                                                \
+    /* make sure the compiler won't optimize away n */          \
+    noop_1 (n);                                                 \
+                                                                \
+    s->time_divisor = SPEED_BLOCK_SIZE;                         \
+    return t;                                                   \
+  }  
+
+#endif
diff --git a/src/gmp/tune/time.c b/src/gmp/tune/time.c
new file mode 100644
index 000000000..269910cc0
--- /dev/null
+++ b/src/gmp/tune/time.c
@@ -0,0 +1,552 @@
+/* Time routines for speed measurments. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+/* speed_time_init() - initialize timing things.  speed_starttime() calls
+   this if it hasn't been done yet, so you only need to call this explicitly
+   if you want to use the global variables before the first measurement.
+  
+   speed_starttime() - start a time measurment.
+
+   speed_endtime() - end a time measurment, return time taken, in seconds.
+
+   speed_unittime - global variable with the unit of time measurement
+   accuracy, in seconds.
+
+   speed_precision - global variable which is the intended accuracy of time
+   measurements.  speed_measure() for instance runs target routines with
+   enough repetitions so it takes at least speed_unittime*speed_precision
+   seconds.  A program can provide an option so the user can set this.
+
+   speed_cycletime - the time in seconds for each CPU cycle, for example on
+   a 100 MHz CPU this would be 1.0e-8.  If the CPU frequency is unknown,
+   speed_cycletime is 1.0.  See speed_cycletime_init().
+
+   speed_time_string - a string describing the time method in use.
+
+
+   Enhancements:
+
+   Add support for accurate timing on more CPUs, machines and systems.
+
+   Extend automatic CPU frequency determination to more kernels and systems.
+
+ */
+
+
+#include <stdio.h>
+#include <stdlib.h> /* for getenv */
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#include <sys/types.h>
+#if HAVE_SYS_SYSCTL_H
+#include <sys/sysctl.h>
+#endif
+
+#include "gmp.h"
+#include "gmp-impl.h"
+#include "longlong.h"
+
+#include "speed.h"
+
+
+#if HAVE_SPEED_CYCLECOUNTER
+#define SPEED_USE_CYCLECOUNTER               1
+#else
+#define SPEED_USE_MICROSECOND_GETRUSAGE      0
+#define SPEED_USE_MICROSECOND_GETTIMEOFDAY   1
+#define SPEED_USE_TMS_UTIME                  0
+#endif
+
+
+#define TIMEVAL_SECS(tp) \
+  ((double) (tp)->tv_sec + (double) (tp)->tv_usec * 1.0e-6)
+
+
+/* Look for an environment variable for CPU clock frequency.
+   GMP_CPU_FREQUENCY should be in Hertz, in floating point form,
+   eg. "450e6". */
+int
+speed_cpu_frequency_environment (void)
+{
+  char  *e;
+
+  e = getenv ("GMP_CPU_FREQUENCY");
+  if (e == NULL)
+    return 0;
+
+  speed_cycletime = 1.0 / atof (e);
+  return 1;
+}
+
+
+/* On FreeBSD 3.3 the headers have #defines like CPU_WALLCLOCK under
+   CTL_MACHDEP but don't seem to have anything for machdep.tsc_freq or
+   machdep.i586_freq.  Using the string forms with sysctlbyname() works
+   though, and lets libc worry about the defines and headers.
+
+   FreeBSD 3.3 has tsc_freq, FreeBSD 2.2.8 has i586_freq instead.
+   The "sysctl -a" command prints everything available. */
+
+#if HAVE_SYSCTLBYNAME
+int
+speed_cpu_frequency_sysctlbyname (void)
+{
+  unsigned  val;
+  size_t    valsize;
+
+  valsize = sizeof(val);
+  if (sysctlbyname ("machdep.tsc_freq", &val, &valsize, NULL, 0) != 0
+      || valsize != sizeof(val))
+    {
+      valsize = sizeof(val);
+      if (sysctlbyname ("machdep.i586_freq", &val, &valsize, NULL, 0) != 0
+          || valsize != sizeof(val))
+        return 0;
+    }
+
+  speed_cycletime = 1.0 / (double) val;
+  return 1;
+}
+#endif
+
+
+/* Linux doesn't seem to have any system call to get the CPU frequency, at
+   least not in 2.0.x or 2.2.x, so it's necessary to read /proc/cpuinfo.
+
+   i386 2.0.36 - "bogomips" is the CPU frequency.
+
+   i386 2.2.13 - has both "cpu MHz" and "bogomips", and it's "cpu MHz" which
+                 is the frequency.
+
+   alpha 2.2.5 - "cycle frequency [Hz]" seems to be right, "BogoMIPS" is
+                 very slightly different.  */
+
+int
+speed_cpu_frequency_proc_cpuinfo (void)
+{
+  FILE    *fp;
+  char    buf[128];
+  double  val;
+  int     ret = 0;
+
+  if ((fp = fopen ("/proc/cpuinfo", "r")) != NULL)
+    {
+      while (fgets (buf, sizeof (buf), fp) != NULL)
+        {
+          if (sscanf (buf, "cycle frequency [Hz]    : %lf est.\n", &val) == 1)
+            {
+              speed_cycletime = 1.0 / val;
+              ret = 1;
+              break;
+            }
+          if (sscanf (buf, "cpu MHz  : %lf\n", &val) == 1)
+            {
+              speed_cycletime = 1e-6 / val;
+              ret = 1;
+              break;
+            }
+          if (sscanf (buf, "bogomips : %lf\n", &val) == 1)
+            {
+              speed_cycletime = 1e-6 / val;
+              ret = 1;
+              break;
+            }
+        }
+      fclose (fp);
+    }
+  return ret;
+}
+
+
+/* SunOS /bin/sysinfo prints a line like:
+       cpu0 is a "75 MHz TI,TMS390Z55" CPU */
+
+#if HAVE_POPEN
+int
+speed_cpu_frequency_sunos_sysinfo (void)
+{
+  FILE    *fp;
+  char    buf[128];
+  double  val;
+  int     ret = 0;
+
+  /* Error messages are sent to /dev/null in case /bin/sysinfo doesn't
+     exist.  The brackets are necessary for some shells (eg. ash). */
+  if ((fp = popen ("(/bin/sysinfo) 2>/dev/null", "r")) != NULL)
+    {
+      while (fgets (buf, sizeof (buf), fp) != NULL)
+        {
+          if (sscanf (buf, " cpu0 is a \"%lf MHz", &val) == 1)
+            {
+              speed_cycletime = 1e-6 / val;
+              ret = 1;
+              break;
+            }
+        }
+      pclose (fp);
+    }
+  return ret;
+}
+#endif
+
+
+/* This is for Solaris.  "psrinfo" is the command-line interface to
+   processor_info().  "prtconf -vp" gives similar information.  */
+
+#if HAVE_PROCESSOR_INFO
+#include <sys/unistd.h>     /* for _SC_NPROCESSORS_CONF */
+#include <sys/processor.h>  /* for processor_info_t */
+int
+speed_cpu_frequency_processor_info (void)
+{
+  processor_info_t  p;
+  int  i, n, mhz = 0;
+
+  n = sysconf (_SC_NPROCESSORS_CONF);
+  for (i = 0; i < n; i++)
+    {
+      if (processor_info (i, &p) != 0)
+        continue;
+      if (p.pi_state != P_ONLINE)
+        continue;
+
+      if (mhz != 0 && p.pi_clock != mhz)
+        {
+          fprintf (stderr,
+                   "speed_cpu_frequency_processor_info(): There's more than one CPU and they have different clock speeds\n");
+          return 0;
+        }
+
+      mhz = p.pi_clock;
+    }
+
+  speed_cycletime = 1.0e-6 / (double) mhz;
+  return 1;
+}
+#endif
+
+
+/* Each function returns 1 if it succeeds in setting speed_cycletime, or 0
+   if not.  */
+
+static const struct {
+  int         (*fun) _PROTO ((void));
+  const char  *description;
+
+} speed_cpu_frequency_table[] = {
+
+  /* This should be first, so an environment variable can override anything
+     the system gives. */
+  { speed_cpu_frequency_environment,
+    "environment variable GMP_CPU_FREQUENCY (in Hertz)" },
+
+#if HAVE_SYSCTLBYNAME
+  { speed_cpu_frequency_sysctlbyname,
+    "sysctlbyname() machdep.tsc_freq or machdep.i586_freq" },
+#endif
+
+#if HAVE_PROCESSOR_INFO
+  { speed_cpu_frequency_processor_info,
+    "processor_info() pi_clock" },
+#endif
+
+  { speed_cpu_frequency_proc_cpuinfo,
+    "linux kernel /proc/cpuinfo file, cpu MHz or bogomips" },
+
+#if HAVE_POPEN
+  { speed_cpu_frequency_sunos_sysinfo,
+    "SunOS /bin/sysinfo program cpu0 output" },
+#endif
+};
+
+
+int
+speed_cycletime_init (void)
+{
+  int  i;
+
+  for (i = 0; i < numberof (speed_cpu_frequency_table); i++)
+    if ((*speed_cpu_frequency_table[i].fun)())
+      return 1;
+
+  fprintf (stderr,
+           "Cannot determine CPU frequency, need one of the following\n");
+  for (i = 0; i < numberof (speed_cpu_frequency_table); i++)
+    fprintf (stderr, "\t- %s\n", speed_cpu_frequency_table[i].description);
+
+  return 0;
+}
+
+
+/* ---------------------------------------------------------------------- */
+#if SPEED_USE_CYCLECOUNTER
+
+const char *speed_time_string 
+  = "Time measurements using CPU cycle counter.\n";
+
+/* bigish value because we have a fast timer */
+int speed_precision = 10000;
+
+double speed_unittime;
+double speed_cycletime;
+
+static int  speed_time_initialized = 0;
+static unsigned  speed_starttime_save[2];
+
+/* Knowing the CPU frequency is mandatory, so cycles can be converted to
+   seconds.  */
+void
+speed_time_init (void)
+{
+  if (speed_time_initialized)
+    return;
+  speed_time_initialized = 1;
+
+  if (!speed_cycletime_init ())
+    exit (1);
+
+  speed_unittime = speed_cycletime;
+}
+
+void
+speed_starttime (void)
+{
+  if (!speed_time_initialized)
+    speed_time_init ();
+  speed_cyclecounter (speed_starttime_save);
+}
+
+#define M_2POWU   ((double) (1L << (BITS_PER_INT-2)) * 4.0)
+#define M_2POW32  4294967296.0
+
+double
+speed_endtime (void)
+{
+  unsigned  endtime[2], e0;
+  double    t;
+
+  speed_cyclecounter (endtime);
+
+  /* This still works even if speed_cyclecounter() puts a value bigger than
+     32-bits in the low word.  The start and end values are allowed to
+     cancel in uints in case a uint is more than the 53 bits that will
+     normally fit in a double. */
+  e0 = endtime[0] - speed_starttime_save[0];
+  t = e0 - (e0 > endtime[0] ? M_2POWU : 0);
+  t += (endtime[1] - speed_starttime_save[1]) * M_2POW32;
+
+  return t * speed_unittime;
+}
+
+#endif
+
+
+/* ---------------------------------------------------------------------- */
+#if SPEED_USE_MICROSECOND_GETRUSAGE
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+const char *speed_time_string
+  = "Time measurements using microsecond accurate getrusage.\n";
+
+int speed_precision = 1000;
+
+double speed_unittime = 1.0e-6;
+double speed_cycletime = 1.0;
+
+static struct rusage  speed_starttime_save;
+static int  speed_time_initialized = 0;
+
+void
+speed_time_init (void)
+{
+  if (speed_time_initialized)
+    return;
+  speed_time_initialized = 1;
+
+  speed_cycletime_init ();
+}
+
+void
+speed_starttime (void)
+{
+  if (!speed_time_initialized)
+    speed_time_init ();
+
+  getrusage (0, &speed_starttime_save);
+}
+
+double
+speed_endtime (void)
+{
+  struct rusage r;
+
+  getrusage (0, &r);
+  return TIMEVAL_SECS (&r.ru_utime)
+    - TIMEVAL_SECS (&speed_starttime_save.ru_utime);
+}
+#endif
+
+
+/* ---------------------------------------------------------------------- */
+#if SPEED_USE_MICROSECOND_GETTIMEOFDAY
+/* This method is for systems with a microsecond accurate gettimeofday().
+
+   A dummy timezone parameter is always given to gettimeofday(), in case it
+   doesn't allow NULL.  */
+
+#include <sys/time.h>
+
+const char *speed_time_string 
+  = "Time measurements using microsecond accurate gettimeofday.\n";
+
+/* highish value because we have an accurate timer */
+int speed_precision = 1000;
+
+double speed_unittime = 1.0e-6;
+double speed_cycletime = 1.0;
+
+static struct timeval  speed_starttime_save;
+static int  speed_time_initialized = 0;
+
+void
+speed_time_init (void)
+{
+  if (speed_time_initialized)
+    return;
+  speed_time_initialized = 1;
+
+  speed_cycletime_init ();
+}
+
+void
+speed_starttime (void)
+{
+  struct timezone  tz;
+  if (!speed_time_initialized)
+    speed_time_init ();
+
+  gettimeofday (&speed_starttime_save, &tz);
+}
+
+double
+speed_endtime (void)
+{
+  struct timeval   t;
+  struct timezone  tz;
+
+  gettimeofday (&t, &tz);
+  return TIMEVAL_SECS (&t) - TIMEVAL_SECS (&speed_starttime_save);
+}
+
+#endif
+
+
+/* ---------------------------------------------------------------------- */
+#if SPEED_USE_TMS_UTIME
+/* You're in trouble if you have to use this method.  Speed measurments and
+   threshold tuning are going to take a long time. */
+
+#if STDC_HEADERS
+#include <errno.h>      /* for errno */
+#include <string.h>     /* for strerror */
+#endif
+#if HAVE_UNISTD_H
+#include <unistd.h>     /* for sysconf */
+#endif
+#include <sys/times.h>  /* for times */
+
+const char *speed_time_string 
+  = "Time measurements using tms_utime.\n";
+
+
+/* lowish default value so we don't take days and days to do tuning */
+int  speed_precision = 200;
+
+double  speed_unittime;
+double  speed_cycletime = 1.0;
+
+static struct tms  speed_starttime_save;
+static int  speed_time_initialized = 0;
+
+void
+speed_time_init (void)
+{
+  long  clk_tck;
+
+  if (speed_time_initialized)
+    return;
+  speed_time_initialized = 1;
+
+  speed_cycletime_init ();
+
+#if HAVE_SYSCONF
+  clk_tck = sysconf (_SC_CLK_TCK);
+  if (clk_tck == -1L)
+    {
+      fprintf (stderr, "sysconf(_SC_CLK_TCK) not available: %s\n",
+	       strerror(errno));
+      fprintf (stderr, "\tusing CLK_TCK instead\n");
+      clk_tck = CLK_TCK;
+    }
+#else
+  clk_tck = CLK_TCK;
+#endif
+
+  speed_unittime = 1.0 / (double) clk_tck;
+}
+
+/* Burn up CPU until a times() tms_utime tick boundary.
+   Doing so lets you know a measurement has started on a tick boundary,
+   effectively halving the uncertainty in the measurement.
+   *t1 gets the start times() values the caller should use. */
+void
+times_utime_boundary (struct tms *t1)
+{
+  struct tms  t2;
+  times (&t2);
+  do
+    times (t1);
+  while (t1->tms_utime == t2.tms_utime);
+}
+
+void
+speed_starttime (void)
+{
+  if (!speed_time_initialized)
+    speed_time_init ();
+  times_utime_boundary (&speed_starttime_save);
+}
+
+double
+speed_endtime (void)
+{
+  struct tms  t;
+  times (&t);
+  return (t.tms_utime - speed_starttime_save.tms_utime) * speed_unittime;
+}
+
+#endif
diff --git a/src/gmp/tune/tuneup.c b/src/gmp/tune/tuneup.c
new file mode 100644
index 000000000..ada92aa45
--- /dev/null
+++ b/src/gmp/tune/tuneup.c
@@ -0,0 +1,746 @@
+/* Create tuned thresholds for various algorithms. */
+
+/*
+Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+*/
+
+/* Usage: tune [-t] [-t] [-p precision]
+
+   -t turns on some diagnostic traces, a second -t turns on more traces.
+
+   The thresholds are determined as follows.  A crossover may not be a
+   single size but rather a range where it oscillates between method A or
+   method B faster.  If the threshold is set making B used where A is faster
+   (or vice versa) that's bad.  Badness is the percentage time lost and
+   total badness is the sum of this over all sizes measured.  The threshold
+   is set to minimize total badness.
+
+   Suppose, as sizes increase, method B becomes faster than method A.  The
+   effect of the rule is that, as you look at increasing sizes, isolated
+   points where B is faster are ignored, but when it's consistently faster,
+   or faster on balance, then the threshold is set there.  The same result
+   is obtained thinking in the other direction of A becoming faster at
+   smaller sizes.
+
+   In practice the thresholds tend to be chosen to bring on the next
+   algorithm fairly quickly.
+
+   This rule is attractive because it's got a basis in reason and is fairly
+   easy to implement, but no work has been done to actually compare it in
+   absolute terms to other possibilities.
+
+   Sometimes running the program twice produces slightly different results.
+   This is probably because there's so little separating algorithms near
+   their crossover, and on that basis it should make little or no difference
+   to the final speed of the relevant routines, but nothing has been done to
+   check that carefully.
+
+   Limitations:
+   
+   The FFTs aren't subject to the same badness rule as the other thresholds,
+   so each k is probably being brought on a touch early.  This isn't likely
+   to make a difference, and the simpler probing means fewer tests.
+
+*/
+
+#define TUNE_PROGRAM_BUILD  1
+
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+#include <unistd.h>
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+#include "speed.h"
+#include "sqr_basecase.h"
+
+#if !HAVE_DECL_OPTARG
+extern char *optarg;
+extern int optind, opterr;
+#endif
+
+
+#define MAX_SIZE        1000  /* limbs */
+#define STEP_FACTOR     0.01  /* how much to step sizes by (rounded down) */
+#define MAX_TABLE       2     /* threshold entries */
+
+
+#if WANT_FFT
+mp_size_t  option_fft_max_size = 50000;  /* limbs */
+#else
+mp_size_t  option_fft_max_size = 0;
+#endif
+int        option_trace = 0;
+int        option_fft_trace = 0;
+struct speed_params  s;
+
+struct dat_t {
+  mp_size_t  size;
+  double     d;
+} *dat = NULL;
+int  ndat = 0;
+int  allocdat = 0;
+
+
+/* Each "_threshold" array must be 1 bigger than the number of thresholds
+   being tuned in a set, because one() stores an value in the entry above
+   the one it's determining. */
+
+mp_size_t  mul_threshold[MAX_TABLE+1] = { MP_SIZE_T_MAX };
+mp_size_t  fft_modf_mul_threshold = MP_SIZE_T_MAX;
+mp_size_t  sqr_threshold[MAX_TABLE+1] = { MP_SIZE_T_MAX };
+mp_size_t  fft_modf_sqr_threshold = MP_SIZE_T_MAX;
+mp_size_t  bz_threshold[2] = { MP_SIZE_T_MAX };
+mp_size_t  fib_threshold[2] = { MP_SIZE_T_MAX };
+mp_size_t  powm_threshold[2] = { MP_SIZE_T_MAX };
+mp_size_t  gcd_accel_threshold[2] = { MP_SIZE_T_MAX };
+mp_size_t  gcdext_threshold[2] = { MP_SIZE_T_MAX };
+
+
+#ifndef KARATSUBA_SQR_MAX
+#define KARATSUBA_SQR_MAX  0 /* meaning no limit */
+#endif
+
+struct param_t {
+  const char  *name[MAX_TABLE];
+  int         stop_since_change;
+  mp_size_t   min_size;
+  mp_size_t   max_size[MAX_TABLE];
+};
+
+
+/* Add an entry to the end of the dat[] array, reallocing to make it bigger
+   if necessary.  */
+void
+add_dat (mp_size_t size, double d)
+{
+#define ALLOCDAT_STEP  500
+
+  ASSERT_ALWAYS (ndat <= allocdat);
+
+  if (ndat == allocdat)
+    {
+      dat = (struct dat_t *) _mp_allocate_or_reallocate
+        (dat, allocdat * sizeof(dat[0]),
+         (allocdat+ALLOCDAT_STEP) * sizeof(dat[0]));
+      allocdat += ALLOCDAT_STEP;
+    }
+
+  dat[ndat].size = size;
+  dat[ndat].d = d;
+  ndat++;
+}
+
+
+/* Return the threshold size based on the data accumulated. */
+mp_size_t
+analyze_dat (int i, int final)
+{
+  double  x, min_x;
+  int     j, min_j;
+
+  /* If the threshold is set at dat[0].size, any positive values are bad. */
+  x = 0.0;
+  for (j = 0; j < ndat; j++)
+    if (dat[j].d > 0.0)
+      x += dat[j].d;
+
+  if (option_trace >= 2 && final)
+    {
+      printf ("\n");
+      printf ("x is the sum of the badness from setting thresh at given size\n");
+      printf ("  (minimum x is sought)\n");
+      printf ("i=%d size=%ld  first x=%.4f\n", i, dat[j].size, x);
+    }
+
+  min_x = x;
+  min_j = 0;
+
+
+  /* When stepping to the next dat[j].size, positive values are no longer
+     bad (so subtracted), negative values become bad (so add the absolute
+     value, meaning subtract). */
+  for (j = 0; j < ndat; x -= dat[j].d, j++)
+    {
+      if (option_trace >= 2 && final)
+        printf ("i=%d size=%ld  x=%.4f\n", i, dat[j].size, x);
+
+      if (x < min_x)
+        {
+          min_x = x;
+          min_j = j;
+        }
+    }
+   
+  return min_j;
+}
+
+
+double
+tuneup_measure (speed_function_t fun, struct speed_params *s)
+{
+  static mp_ptr  xp, yp;
+  double   t;
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  s->xp = SPEED_TMP_ALLOC_LIMBS (s->size, 0);
+  s->yp = SPEED_TMP_ALLOC_LIMBS (s->size, 0);
+
+  mpn_random (s->xp, s->size);
+  mpn_random (s->yp, s->size);
+
+  t = speed_measure (fun, s);
+
+  TMP_FREE (marker);
+  return t;
+}  
+
+
+void
+print_define (const char *name, mp_size_t value)
+{
+  printf ("#ifndef %s\n", name);
+  printf ("#define %-23s  ", name);
+  if (value == MP_SIZE_T_MAX)
+    printf ("MP_SIZE_T_MAX\n");
+  else
+    printf ("%5ld\n", value);
+  printf ("#endif\n");
+}
+
+
+/* table[i+1] needs to be set to a sensible value when testing method i+1
+   because mpn_mul_n uses TOOM3_MUL_THRESHOLD to size the temporary
+   workspace for mpn_kara_mul_n. */
+
+void
+one (speed_function_t function, mp_size_t table[], size_t max_table,
+     struct param_t *param)
+{
+  static struct param_t  dummy;
+  int  i;
+
+  if (param == NULL)  param = &dummy;
+
+#define DEFAULT(x,n)  if (param->x == 0)  param->x = (n);
+
+  DEFAULT (stop_since_change, 80);
+  DEFAULT (min_size, 10);
+  for (i = 0; i < numberof (param->max_size); i++)
+    DEFAULT (max_size[i], MAX_SIZE);
+
+  s.size = param->min_size;
+
+  for (i = 0; i < max_table && s.size < MAX_SIZE; i++)
+    {
+      int  since_positive, since_thresh_change;
+      int  thresh_idx, new_thresh_idx;
+
+      ndat = 0;
+      since_positive = 0;
+      since_thresh_change = 0;
+      thresh_idx = 0;
+
+      if (option_trace >= 2)
+        {
+          printf ("             algorithm-A  algorithm-B   ratio  possible\n");
+          printf ("              (seconds)    (seconds)    diff    thresh\n");
+        }
+
+      for ( ; s.size < MAX_SIZE; 
+            s.size += MAX ((mp_size_t) floor (s.size * STEP_FACTOR), 1))
+        {
+          double   ti, tiplus1, d;
+
+          /* If there's a size limit and it's reached then it should still
+             be sensible to analyze the data since we want the threshold put
+             either at or near the limit.  */
+          if (s.size >= param->max_size[i])
+            {
+              if (option_trace)
+                printf ("Reached maximum size (%ld) without otherwise stopping\n",
+                        param->max_size[i]);
+              break;
+            }
+
+          /*
+            FIXME: check minimum size requirements are met, possibly by just
+            checking for the -1 returns from the speed functions.
+            if (s.size < MPN_TOOM_TABLE_TO_MINSIZE (i))
+            continue;
+          */
+
+          /* using method i at this size */
+          table[i] = s.size+1;
+          table[i+1] = MAX_SIZE;
+          ti = tuneup_measure (function, &s);
+          if (ti == -1.0)
+            abort ();
+
+          /* using method i+1 at this size */
+          table[i] = s.size;
+          table[i+1] = s.size+1;
+          tiplus1 = tuneup_measure (function, &s);
+          if (tiplus1 == -1.0)
+            abort ();
+
+          /* Calculate the fraction by which the one or the other routine is
+             slower.  */
+          if (tiplus1 >= ti)
+            d = (tiplus1 - ti) / tiplus1;  /* negative */
+          else
+            d = (tiplus1 - ti) / ti;       /* positive */
+
+          add_dat (s.size, d);
+
+          new_thresh_idx = analyze_dat (i, 0);
+
+
+          if (option_trace >= 2)
+            printf ("i=%d size=%ld  %.9f  %.9f  % .4f %c  %d\n",
+                    i, s.size, ti, tiplus1, d,
+                    ti > tiplus1 ? '#' : ' ',
+                    dat[new_thresh_idx].size);
+
+          /* Stop if the last time method i was faster was more than a
+             certain number of measurements ago.  */
+#define STOP_SINCE_POSITIVE  200
+          if (d >= 0)
+            since_positive = 0;            
+          else
+            if (++since_positive > STOP_SINCE_POSITIVE)
+              {
+                if (option_trace >= 1)
+                  printf ("i=%d stopped due to since_positive (%d)\n",
+                          i, STOP_SINCE_POSITIVE);
+                break;
+              }
+
+          /* Stop if method i has become slower by a certain factor. */
+#define STOP_FACTOR   1.2
+          if (ti >= tiplus1 * STOP_FACTOR)
+            {
+              if (option_trace >= 1)
+                printf ("i=%d stopped due to ti >= tiplus1 * factor (%.1f)\n",
+                        i, STOP_FACTOR);
+              break;
+            }
+
+          /* Stop if the threshold implied hasn't changed in a certain
+             number of measurements.  (It's this condition that ususally
+             stops the loop.) */
+          if (thresh_idx != new_thresh_idx)
+            since_thresh_change = 0, thresh_idx = new_thresh_idx;
+          else
+            if (++since_thresh_change > param->stop_since_change)
+              {
+                if (option_trace >= 1)
+                  printf ("i=%d stopped due to since_thresh_change (%d)\n",
+                          i, param->stop_since_change);
+                break;
+              }
+
+          /* Stop if the threshold implied is more than a certain number of
+             measurements ago.  */
+#define STOP_SINCE_AFTER   500
+          if (ndat - thresh_idx > STOP_SINCE_AFTER)
+            {
+              if (option_trace >= 1)
+                printf ("i=%d stopped due to ndat - thresh_idx > amount (%d)\n",
+                        i, STOP_SINCE_AFTER);
+              break;
+            }
+        }
+
+      /* Stop when the size limit is reached before the end of the
+         crossover, without a specified param->max_size[i]. */
+      if (s.size >= MAX_SIZE)
+        {
+          fprintf (stderr, "%s\n", param->name[i]);
+          fprintf (stderr, "i=%d sizes %ld to %ld total %d measurements\n",
+                   i, dat[0].size, dat[ndat-1].size, ndat);
+          fprintf (stderr, "    max size reached before end of crossover\n");
+          break;
+        }
+
+      if (option_trace >= 1)
+        printf ("i=%d sizes %ld to %ld total %d measurements\n",
+                i, dat[0].size, dat[ndat-1].size, ndat);
+
+      if (ndat == 0)
+        break;
+
+      table[i] = dat[analyze_dat (i, 1)].size;
+
+      print_define (param->name[i], table[i]);
+
+      /* Look for the next threshold starting from the current one, but back
+         a bit. */
+      s.size = table[i]+1;
+    }      
+}
+
+
+/* Special probing for the fft thresholds.  The size restrictions on the
+   FFTs mean the graph of time vs size has a step effect.  See this for
+   example using
+
+       ./speed -s 4096-16384 -t 128 -P foo mpn_mul_fft.8 mpn_mul_fft.9
+       gnuplot foo.gnuplot
+
+   The current approach is to compare routines at the midpoint of relevant
+   steps.  Arguably a more sophisticated system of threshold data is wanted
+   if this step effect remains. */
+
+struct fft_param_t {
+  const char        *table_name;
+  const char        *threshold_name;
+  const char        *modf_threshold_name;
+  mp_size_t         *p_threshold;
+  mp_size_t         *p_modf_threshold;
+  mp_size_t         first_size;
+  mp_size_t         max_size;
+  speed_function_t  function;
+  speed_function_t  mul_function;
+  mp_size_t         sqr;
+};
+
+/* mpn_mul_fft requires pl a multiple of 2^k limbs, but with
+   N=pl*BIT_PER_MP_LIMB it internally also pads out so N/2^k is a multiple
+   of 2^(k-1) bits. */
+
+mp_size_t
+fft_step_size (int k)
+{
+  if (2*k-1 > BITS_PER_INT)
+    {
+      printf ("Can't handle k=%d\n", k);
+      abort ();
+    }
+  return (1<<k) * (MAX (1<<(k-1), BITS_PER_MP_LIMB)) / BITS_PER_MP_LIMB;
+}
+
+mp_size_t
+fft_next_size (mp_size_t pl, int k)
+{
+  mp_size_t  m = fft_step_size (k);
+
+/*    printf ("[k=%d %ld] %ld ->", k, m, pl); */
+
+  if (pl == 0 || (pl & (m-1)) != 0)
+    pl = (pl | (m-1)) + 1;
+
+/*    printf (" %ld\n", pl); */
+  return pl;
+}
+
+void
+fft (struct fft_param_t *p)
+{
+  mp_size_t  size;
+  int        i, k;
+
+  for (i = 0; i < numberof (mpn_fft_table[p->sqr]); i++)
+    mpn_fft_table[p->sqr][i] = MP_SIZE_T_MAX;
+
+  *p->p_threshold = MP_SIZE_T_MAX;
+  *p->p_modf_threshold = MP_SIZE_T_MAX;
+
+  option_trace = MAX (option_trace, option_fft_trace);
+
+  printf ("#ifndef %s\n", p->table_name);
+  printf ("#define %s  {", p->table_name);
+  if (option_trace >= 2)
+    printf ("\n");
+
+  k = FFT_FIRST_K;
+  size = p->first_size;
+  for (;;)
+    {
+      double  tk, tk1;
+
+      size = fft_next_size (size+1, k+1);
+
+      if (size >= p->max_size)
+        break;
+      if (k >= FFT_FIRST_K + numberof (mpn_fft_table[p->sqr]))
+        break;
+
+      usleep(10000);
+
+      /* compare k to k+1 in the middle of the current k+1 step */
+      s.size = size + fft_step_size (k+1) / 2;
+      s.r = k;
+      tk = tuneup_measure (p->function, &s);
+      if (tk == -1.0)
+        abort ();
+
+      usleep(10000);
+
+      s.r = k+1;
+      tk1 = tuneup_measure (p->function, &s);
+      if (tk1 == -1.0)
+        abort ();
+
+      if (option_trace >= 2)
+        printf ("at %ld   size=%ld  k=%d  %.9lf   k=%d %.9lf\n",
+                size, s.size, k, tk, k+1, tk1);
+
+      /* declare the k+1 threshold as soon as it's faster at its midpoint */
+      if (tk1 < tk)
+        {
+          mpn_fft_table[p->sqr][k-FFT_FIRST_K] = s.size;
+          printf (" %ld,", s.size);
+          if (option_trace >= 2) printf ("\n");
+          k++;
+        }
+    }
+
+  mpn_fft_table[p->sqr][k-FFT_FIRST_K] = 0;
+  printf (" 0 }\n");
+  printf ("#endif\n");
+
+
+  size = p->first_size;
+  
+  /* Declare an FFT faster than a plain toom3 etc multiplication found as
+     soon as one faster measurement obtained.  A multiplication in the
+     middle of the FFT step is tested.  */
+  for (;;)
+    {
+      int     modf = (*p->p_modf_threshold == MP_SIZE_T_MAX);
+      double  tk, tm;
+
+      /* k=7 should be the first FFT which can beat toom3 on a full
+         multiply, so jump to that threshold and save some probing after the
+         modf threshold is found.  */
+      if (!modf && size < mpn_fft_table[p->sqr][2])
+        {
+          size = mpn_fft_table[p->sqr][2];
+          if (option_trace >= 2)
+            printf ("jump to size=%ld\n", size);
+        }
+
+      size = fft_next_size (size+1, mpn_fft_best_k (size, p->sqr));
+      k = mpn_fft_best_k (size, p->sqr);
+
+      if (size >= p->max_size)
+        break;
+
+      usleep(10000);
+
+      s.size = size + fft_step_size (k) / 2;
+      s.r = k;
+      tk = tuneup_measure (p->function, &s);
+      if (tk == -1.0)
+        abort ();
+
+      usleep(10000);
+
+      if (!modf)  s.size /= 2;
+      tm = tuneup_measure (p->mul_function, &s);
+      if (tm == -1.0)
+        abort ();
+
+      if (option_trace >= 2)
+        printf ("at %ld   size=%ld   k=%d  %.9lf   size=%ld %s mul %.9lf\n",
+                size,
+                size + fft_step_size (k) / 2, k, tk,
+                s.size, modf ? "modf" : "full", tm);
+
+      if (tk < tm)
+        {
+          if (modf)
+            {
+              *p->p_modf_threshold = s.size;
+              print_define (p->modf_threshold_name, *p->p_modf_threshold);
+            }
+          else
+            {
+              *p->p_threshold = s.size;
+              print_define (p->threshold_name,      *p->p_threshold);
+              break;
+            }
+        }
+    }
+
+}
+
+
+void
+all (void)
+{
+  TMP_DECL (marker);
+
+  TMP_MARK (marker);
+  s.xp_block = SPEED_TMP_ALLOC_LIMBS (SPEED_BLOCK_SIZE, 0);
+  s.yp_block = SPEED_TMP_ALLOC_LIMBS (SPEED_BLOCK_SIZE, 0);
+
+  speed_time_init ();
+  fprintf (stderr, "speed_precision %d, speed_unittime %.2e\n",
+           speed_precision, speed_unittime);
+  fprintf (stderr, "MAX_SIZE %ld, fft_max_size %ld, STEP_FACTOR %.3f\n",
+           MAX_SIZE, option_fft_max_size, STEP_FACTOR);
+  fprintf (stderr, "\n");
+
+  {
+    struct tm  *tp;
+    time_t     t;
+    time (&t);
+    tp = localtime (&t);
+    printf ("/* Generated by tuneup.c, %d-%02d-%02d. */\n\n",
+            tp->tm_year+1900, tp->tm_mon+1, tp->tm_mday);
+  }
+
+  {
+    static struct param_t  param;
+    param.name[0] = "KARATSUBA_MUL_THRESHOLD";
+    param.name[1] = "TOOM3_MUL_THRESHOLD";
+    param.max_size[1] = TOOM3_MUL_THRESHOLD_LIMIT;
+    one (speed_mpn_mul_n, mul_threshold, numberof(mul_threshold)-1, &param);
+  }
+  printf("\n");
+
+  {
+    static struct param_t  param;
+    param.name[0] = "KARATSUBA_SQR_THRESHOLD";
+    param.name[1] = "TOOM3_SQR_THRESHOLD";
+    param.max_size[0] = KARATSUBA_SQR_MAX;
+    one (speed_mpn_sqr_n, sqr_threshold, numberof(sqr_threshold)-1, &param);
+  }
+  printf("\n");
+
+  {
+    static struct param_t  param;
+    param.name[0] = "BZ_THRESHOLD";
+    one (speed_mpn_bz_tdiv_qr, bz_threshold, 1, &param);
+  }
+  printf("\n");
+
+  {
+    static struct param_t  param;
+    param.name[0] = "FIB_THRESHOLD";
+    one (speed_mpz_fib_ui, fib_threshold, 1, &param);
+  }
+  printf("\n");
+
+  /* mpz_powm becomes slow before long, so stop soon after the determined
+     threshold stops changing. */
+  {
+    static struct param_t  param;
+    param.name[0] = "POWM_THRESHOLD";
+    param.stop_since_change = 15;
+    one (speed_mpz_powm, powm_threshold, 1, &param);
+  }
+  printf("\n");
+
+  {
+    static struct param_t  param;
+    param.name[0] = "GCD_ACCEL_THRESHOLD";
+    param.min_size = 1;
+    one (speed_mpn_gcd, gcd_accel_threshold, 1, &param);
+  }
+  {
+    static struct param_t  param;
+    param.name[0] = "GCDEXT_THRESHOLD";
+    param.min_size = 1;
+    param.max_size[0] = 200;
+    one (speed_mpn_gcdext, gcdext_threshold, 1, &param);
+  }
+  printf("\n");
+
+  if (option_fft_max_size != 0)
+    {
+      {
+        static struct fft_param_t  param;
+        param.table_name          = "FFT_MUL_TABLE";
+        param.threshold_name      = "FFT_MUL_THRESHOLD";
+        param.p_threshold         = &FFT_MUL_THRESHOLD;
+        param.modf_threshold_name = "FFT_MODF_MUL_THRESHOLD";
+        param.p_modf_threshold    = &FFT_MODF_MUL_THRESHOLD;
+        param.first_size          = TOOM3_MUL_THRESHOLD / 2;
+        param.max_size            = option_fft_max_size;
+        param.function            = speed_mpn_mul_fft;
+        param.mul_function        = speed_mpn_mul_n;
+        param.sqr = 0;
+        fft (&param);
+      }
+      printf("\n");
+      {
+        static struct fft_param_t  param;
+        param.table_name          = "FFT_SQR_TABLE";
+        param.threshold_name      = "FFT_SQR_THRESHOLD";
+        param.p_threshold         = &FFT_SQR_THRESHOLD;
+        param.modf_threshold_name = "FFT_MODF_SQR_THRESHOLD";
+        param.p_modf_threshold    = &FFT_MODF_SQR_THRESHOLD;
+        param.first_size          = TOOM3_SQR_THRESHOLD / 2;
+        param.max_size            = option_fft_max_size;
+        param.function            = speed_mpn_mul_fft_sqr;
+        param.mul_function        = speed_mpn_sqr_n;
+        param.sqr = 0;
+        fft (&param);
+      }
+      printf ("\n");
+    }
+
+  TMP_FREE (marker);
+}
+
+
+int
+main (int argc, char *argv[])
+{
+  int  opt;
+
+  /* Unbuffered so if output is redirected to a file it isn't lost if the
+     program is killed part way through.  */
+  setbuf (stdout, NULL);
+  setbuf (stderr, NULL);
+
+  while ((opt = getopt(argc, argv, "f:o:p:t")) != EOF)
+    {
+      switch (opt) {
+      case 'f':
+        if (optarg[0] == 't')
+          option_fft_trace = 2;
+        else
+          option_fft_max_size = atol (optarg);
+        break;
+      case 'o':
+        speed_option_set (optarg);
+        break;
+      case 'p':
+        speed_precision = atoi (optarg);
+        break;
+      case 't':
+        option_trace++;
+        break;
+      case '?':
+        exit(1);
+      }
+    }
+		
+  all ();
+  return 0;
+}
diff --git a/src/gmp/urandom.h b/src/gmp/urandom.h
new file mode 100644
index 000000000..fa1583731
--- /dev/null
+++ b/src/gmp/urandom.h
@@ -0,0 +1,76 @@
+/* urandom.h -- define urandom returning a full unsigned long random value.
+
+Copyright (C) 1995, 1996, 1997, 2000 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA. */
+
+#if defined (__hpux) || defined (__svr4__) || defined (__SVR4)
+/* HPUX lacks random().  */
+static inline mp_limb_t
+urandom ()
+{
+  return mrand48 ();
+}
+#define __URANDOM
+#endif
+
+#if defined (__alpha) && !defined (__URANDOM)
+/* DEC OSF/1 1.2 random() returns a double.  */
+long mrand48 ();
+static inline mp_limb_t
+urandom ()
+{
+  return mrand48 () | (mrand48 () << 32);
+}
+#define __URANDOM
+#endif
+
+#if BITS_PER_MP_LIMB == 32 && !defined (__URANDOM)
+#if defined (__cplusplus)
+extern "C" {
+#endif
+long random ();
+#if defined (__cplusplus)
+}
+#endif
+static inline mp_limb_t
+urandom ()
+{
+  /* random() returns 31 bits, we want 32.  */
+  return random () ^ (random () << 1);
+}
+#define __URANDOM
+#endif
+
+#if BITS_PER_MP_LIMB == 64 && !defined (__URANDOM)
+#if defined (__cplusplus)
+extern "C" {
+#endif
+long random ();
+#if defined (__cplusplus)
+}
+#endif
+static inline mp_limb_t
+urandom ()
+{
+  /* random() returns 31 bits, we want 64.  */
+  return random () ^ ((mp_limb_t) random () << 31) ^ ((mp_limb_t) random () << 62);
+}
+#define __URANDOM
+#endif
+
diff --git a/src/gmp/version.c b/src/gmp/version.c
new file mode 100644
index 000000000..9d544ee1d
--- /dev/null
+++ b/src/gmp/version.c
@@ -0,0 +1,26 @@
+/* gmp_version -- version number compiled into the library */
+
+/*
+Copyright (C) 1996, 1999, 2000  Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2.1 of the License, or (at your
+option) any later version.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.  */
+
+#include "gmp.h"
+#include "gmp-impl.h"
+
+const char *gmp_version = VERSION;
diff --git a/src/gmp/version.texi b/src/gmp/version.texi
new file mode 100644
index 000000000..5ac4cb8c2
--- /dev/null
+++ b/src/gmp/version.texi
@@ -0,0 +1,3 @@
+@set UPDATED 3 August 2000
+@set EDITION 3.1
+@set VERSION 3.1
diff --git a/src/h/bytecodes.h b/src/h/bytecodes.h
new file mode 100644
index 000000000..4df904391
--- /dev/null
+++ b/src/h/bytecodes.h
@@ -0,0 +1,156 @@
+/*
+  OP_NOP
+	Sets VALUES(0) = NIL and NValues = 1
+
+  OP_BLOCK	block-name{obj}
+  ...
+  OP_EXIT
+	Executes the enclosed forms in a named block
+
+  OP_PUSH
+	Pushes the object in VALUES(0)
+
+  OP_PUSHQ	value{obj}
+	Pushes "value"
+
+  OP_PUSHV	var{symbol}
+	Pushes the value of the variable "var"
+
+  OP_PUSHVALUES
+	Pushes the values output by the last form
+
+  OP_MCALL
+  ...
+  OP_EXIT
+	Saves the stack pointer, executes several forms and
+	funcalls VALUES(0) using the content of the stack.
+
+  OP_CALL	narg{arg}, function{symbol}
+	Calls "function" using the last "narg" values in the stack.
+  OP_PCALL	narg{arg}, function{symbol}
+	Calls "function" using the last "narg" values in the stack.
+	The first result of the call is also pushed.
+
+  OP_FCALL	narg{arg}
+	Calls VALUES(0) using the last "narg" values in the stack.
+  OP_PCALL	narg{arg}, function{symbol}
+	Calls VALUES(0) using the last "narg" values in the stack.
+	The first result of the call is also pushed.
+
+  OP_CATCH	dest{label}
+  ...
+  OP_EXIT
+	Sets a catch point with the tag in VALUES(0). The end of
+	the block is marked by "dest".
+
+  OP_FLET	nfun{arg}
+  ...
+  OP_EXIT
+
+  OP_LABELS	nfun{arg}
+  ...
+  OP_EXIT
+
+  OP_FUNCTION	symbol{obj}
+
+  OP_CLOSE	interpreted-function{obj}
+
+  OP_GO		tag-name{obj}
+
+  OP_THROW	tag-name{obj}
+
+  OP_RETURN	tag-name{obj}
+
+  OP_JMP	dest{label}
+  OP_JNIL	dest{label}
+  OP_JT		dest{label}
+
+  OP_CASE	n{arg}
+  	object1{obj}	dest1{label}
+	object2{obj}	dest2{label}
+	...
+	objectn{obj}	destn{label}
+	destx{label}
+  dest1:
+	...
+	OP_EXIT
+  dest2:
+	...
+	OP_EXIT
+	...
+  destn:
+	...
+	OP_EXIT
+  destx:
+
+  OP_DO		exit{label}
+  	...
+  OP_EXIT
+
+  OP_PUSHENV
+	...
+  OP_EXIT
+
+  OP_DOLIST
+	OP_BIND	var{obj}
+	OP_EXIT
+
+ */
+
+enum {
+  OP_NOP,
+  OP_BLOCK,
+  OP_PUSH,
+  OP_PUSHQ,
+  OP_PUSHV,
+  OP_PUSHVALUES,
+  OP_MCALL,
+  OP_CALL,
+  OP_FCALL,
+  OP_PCALL,
+  OP_PFCALL,
+  OP_CATCH,
+  OP_EXIT,
+  OP_FLET,
+  OP_LABELS,
+  OP_FUNCTION,
+  OP_CLOSE,
+  OP_GO,
+  OP_THROW,
+  OP_JMP,
+  OP_JNIL,
+  OP_JT,
+  OP_JEQ,
+  OP_JNEQ,
+  OP_BIND,
+  OP_BINDS,
+  OP_SETQ,
+  OP_SETQS,
+  OP_PBIND,
+  OP_PBINDS,
+  OP_PSETQ,
+  OP_PSETQS,
+  OP_MBIND,
+  OP_MSETQ,
+  OP_PROGV,
+  OP_PUSHENV,
+  OP_VALUES,
+  OP_NTHVAL,
+  OP_MPROG1,
+  OP_RETURN,
+  OP_TAGBODY,
+  OP_UNWIND,
+  OP_QUOTE,
+  OP_DOLIST,
+  OP_DOTIMES,
+  OP_DO,
+  OP_HALT,
+  OP_MAXOPCODES = 128,
+  OP_OPCODE_SHIFT = 7
+};
+
+#define OPARG_SHIFT 16
+#define MAX_OPARG (1 << (31 - OPARG_SHIFT) - 1)
+#define SET_OPARG(o,n) ((cl_object)((cl_fixnum)(o) | ((n) << OPARG_SHIFT)))
+#define GET_OPARG(o) ((cl_fixnum)(o) >> OPARG_SHIFT)
+#define GET_OP(o) (((cl_fixnum)(o) & 0xFF) >> 2)
diff --git a/src/h/config.h.in b/src/h/config.h.in
new file mode 100644
index 000000000..392cf3eba
--- /dev/null
+++ b/src/h/config.h.in
@@ -0,0 +1,72 @@
+/*
+    config.h.in -- Template configuration file.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+/* -------------------------------------------------------------------- *
+ *	OPTIONS								*
+ * -------------------------------------------------------------------- */
+
+#undef CLOS
+#undef THREADS
+#undef TK
+
+#undef TCP			/* Network streams			*/
+#undef CLX			/* CLX					*/
+#undef LOCATIVE			/* Locatives				*/
+
+/* Define this if you want a runtime version only without compiler	*/
+#undef RUNTIME
+#undef PROFILE			/* Profile tool				*/
+#undef PDE			/* Program Development Environment	*/
+
+#undef GBC_BOEHM		/* Use Boehm's garbage collector	*/
+#undef HAVE_LOCAL_GMP		/* Use GMP >= 2.0 as provided by system */
+
+/* Undefine this if you do not want ECLS to check for circular lists    */
+#define ECLS_SAFE
+
+/* -------------------------------------------------------------------- *
+ *	PARAMETERS							*
+ * -------------------------------------------------------------------- */
+
+#define	LISP_PAGESIZE	2048	/* Page size in bytes			*/
+#define MAXPAGE	16384		/* Maximum Memory Size			*/
+#define BDSSIZE	2048		/* Size of Binding Stack		*/
+#define	BDSGETA	16		/* Safety zone of BDS			*/
+#define	IHSSIZE	1024		/* Size of Invocation History Stack	*/
+#define	IHSGETA	32		/* Safety zone of IHS			*/
+#define FRSSIZE	1024		/* Size of Frame Stack			*/
+#define	FRSGETA	16		/* Safety zone of FRS			*/
+#ifdef THREADS
+#define	CSSIZE	7500		/* Size of C Stack of each thread	*/
+#define	CSGETA	500
+#else
+#define	CSSIZE	20000		/* Size of C Stack			*/
+#define	CSGETA	4000
+#endif THREADS
+#define VSSIZE	128		/* Size of return values stack		*/
+
+#define BIGNUM_REGISTER_SIZE 16	/* Size in words of each register	*/
+
+/* -------------------------------------------------------------------- *
+ *	SYSTEM FEATURES							*
+ * -------------------------------------------------------------------- */
+
+#undef NO_ARG_ARRAY		/* arguments can be accessed as array	*/
+#undef WORDS_BIGENDIAN		/* most significant byte first		*/
+
+#undef HAVE_SYS_RESOURCE_H	/* has <sys/resource.h>			*/
+#undef HAVE_SYS_UTSNAME_H	/* has <sys/utsname.h> and uname()	*/
+
+#undef HAVE_NANOSLEEP		/* high precision timer			*/
diff --git a/src/h/critical.h b/src/h/critical.h
new file mode 100644
index 000000000..e07076c16
--- /dev/null
+++ b/src/h/critical.h
@@ -0,0 +1,43 @@
+/*
+    critical.h  -- Mutual exclusion.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+ * SCHEDULER STOPPING
+ */
+#ifdef THREADS
+#define BUSY 1
+#define CRITICAL 5
+#define ACTIVE 1
+#define INACTIVE 0
+#define SCHEDULER_INT 1
+#define ERROR_INT 2
+
+extern bool scheduler_interrupted;
+extern int critical_level;
+
+#define start_critical_section() {critical_level++;}
+
+#define end_critical_section() {  critical_level--; \
+				  if (scheduler_interrupted) \
+				    if (critical_level == 0) \
+				      interruption_handler(); }
+#endif /* THREADS */
+
+/*
+ * EMPTY MACROS FOR SINGLE-THREADED CODE
+ */
+#ifndef THREADS
+#define start_critical_section()
+#define end_critical_section()
+#endif /* !THREADS */
diff --git a/src/h/cs.h b/src/h/cs.h
new file mode 100644
index 000000000..c64253ea7
--- /dev/null
+++ b/src/h/cs.h
@@ -0,0 +1,199 @@
+/*
+    cs.h -- C stack manipulation.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+/*
+ *----------------------------------------------------------------------
+ *	Low level stack manipulation macros
+ *----------------------------------------------------------------------
+ */
+
+#define asm __asm__
+
+/*
+ *----------------------------------------------------------------------
+ *	Stack of predefined size
+ *----------------------------------------------------------------------
+ */
+
+#define CSTACK(size)     	register cl_object *_stack_top; \
+  				cl_object _stack_bot[size]; \
+  				_stack_top = _stack_bot /*  __GNUC__ */
+#define CPUSH(val)		*_stack_top++ = (val);
+
+#define CSTACK_BOT		_stack_bot
+#define CSTACK_TOP		_stack_top
+
+/*---------------------------------------------------------------------- */
+
+#if defined(__i386__) && 0
+/* Stack usage:
+
+   sp	|  lclm  |
+	|  ...   |
+   	|  lcl1  |
+   bp	|  obp   |
+        |  ret?  |
+        |  arg1  |
+        |  ...   |
+   osp	|  argn  |
+	|  ...   |
+   obp  |        |
+
+Caller pushes args and pops them after return. Result in ax.
+*/
+
+#ifdef __GO32__ /* DJGPP */
+typedef char *  caddr_t;
+#endif
+
+#define GET_CURRENT_FRAME(frame)	asm("movl (%%ebp),%0" : "=r" (frame))
+#define FRAME_CHAIN(frame)		((char **)frame)[0]
+#define FRAME_SAVED_PC(frame)		((char **)frame)[1]
+
+#define PC_INDEX 8
+
+#if 0
+#define TRANSFER_CALL(fun)	asm("leave"); goto *(fun) /* __GNUC__ */
+#endif
+
+#define CCALL(narg,fun)	  	({register cl_object eax asm("%eax"); \
+				    asm("push %0" :: "g" (narg)); \
+				    asm("call %0" :: "g" (fun) : "eax"); \
+ 				    asm("addl $4, %%esp" :: ); eax;})
+
+#if !defined(__linux__) && !defined(__FreeBSD__)
+#define ARGCALL CCALL
+#define ARGSTACK(size)	CSTACK(size)
+#endif
+
+#endif i386
+
+/*---------------------------------------------------------------------- */
+
+#ifdef __mips
+
+/* stack usage:
+
+   sp	|           |
+	|   ...     |
+        | save $31  | \ return pointer
+        | save regs |  > frame offset
+	|  locals   | /
+   fp   |   arg1    |  first arg of this function
+	|   ...     |
+   	|   argn    |
+	|   ...     |
+        |           |
+
+*/
+/* Unfortunately MIPS stacks do not have enough information to chain through
+   them.  FP is virtual, has no allocated register. We might reconstruct
+   framesize and frameoffset from first two instructions of procedure:
+
+     subu $sp, framesize
+     sw $ra, framesize+frameoffset($sp)
+
+   However we have no way to find the entry to a function given a PC.
+   GDB uses symbol information from the function to determine FP.
+*/
+
+#define ARGSTACK(size)     	register cl_object *_stack_top; \
+  				cl_object _stack_bot[size+1]; \
+  				_stack_top = _stack_bot /*  __GNUC__ */
+
+#endif __mips
+
+/*---------------------------------------------------------------------- */
+
+#ifdef sparc
+   
+/*
+#define JB_SP 1
+#define JB_PC 2
+#define JB_FP 3
+#define JB_NPC 4
+#define JB_PSR 5
+*/
+
+/*
+ * Got this info from gdb (config/sparc/tm-sparc.h and sparc-tdep.c)
+ */
+
+#define GET_CURRENT_FRAME(frame)	asm("mov %%fp,%0" : "=r" (frame))
+#define FRAME_CHAIN(frame)	((caddr_t *)frame)[14]
+#define FRAME_SAVED_PC(frame)	((caddr_t *)frame)[15]
+
+
+/* GCC reserves 6 words for saving registers o0-05, but never does that */
+
+#define ARGSTACK(size)     	register volatile cl_object *_stack_top; \
+  				cl_object _stack_bot[size+1]; \
+  				_stack_top = _stack_bot-6 /*  __GNUC__ */
+
+#define ARGCALL(narg, fun)  ({ register cl_object _res asm("%o0"); \
+			     asm("mov %0,%%o0" :: "r" (narg) : "%o0"); \
+			     asm("ld [%%sp+72],%%o1" ::: "%o1"); \
+			     asm("ld [%%sp+76],%%o2" ::: "%o2"); \
+			     asm("ld [%%sp+80],%%o3" ::: "%o3"); \
+			     asm("ld [%%sp+84],%%o4" ::: "%o4"); \
+			     asm("ld [%%sp+88],%%o5" ::: "%o5"); \
+			     asm("call %0,0" : : "r" (fun) ); \
+       			     asm("nop"); _res;})
+
+#endif sparc
+
+/*---------------------------------------------------------------------- */
+
+#ifdef vax
+#define PC_INDEX 0
+#define TRANSFER(buf, addr)	buf[PC_INDEX] = (int)addr+((((int *)addr)[0] >> 19) & 4)+4; \
+  				ecls_longjmp(buf)
+#define TRANSFER_CALL(fun)	REG = (cl_object)fun; \
+				asm("	ashl	$-19,(r11),r0"); \
+				asm("	bicl2	$-5,r0"); \
+				asm("	addl2	r11,r0"); \
+				asm("	addl2	$4,r0"); \
+				asm("	jmp	(r0)")
+#define CSTACK(size)		register cl_object REG
+#define CPUSH(val)		(REG = (cl_object)(val), \
+				asm("	pushl	r11"))
+#define CPOP			(asm("	movl	(sp)+,r11"), REG)
+
+/* Reverse arguments on the stack, push narg, and then call.
+   narg (r11), up (r9), dn (r8)
+  for (dn = sp, up = sp+narg-1; dn < up; ) {
+    tmp = *dn; *dn++ = *up; *up-- = tmp;
+  }
+*/
+#define CCALL(narg, fun)		(REG = (cl_object)(narg), \
+				 asm("	movl	sp,r8"), \
+				 asm("	ashl	$2,r11,r0"), \
+				 asm("	addl3	r0,sp,r9"), \
+				 asm("	subl2	$4,r9"), \
+				 asm("1:	cmpl	r8,r9"), \
+				 asm("	jgeq	2f"), \
+				 asm("	movl	(r8),r7"), \
+				 asm("	movl	(r9),(r8)+"), \
+				 asm("	movl	r7,(r9)"), \
+				 asm("	subl2	$4,r9"), \
+				 asm("	jbr 	1b"), \
+				 asm("2:	pushl	r11"), \
+				 asm("	addl3	$1,r11,r0"), \
+				 REG = (cl_object)(fun), \
+				 asm("	calls	r0,(r11)"), \
+				 asm("	movl	r0,r11"), (int)REG)
+#endif VAX
+
+/*---------------------------------------------------------------------- */
diff --git a/src/h/dos.h b/src/h/dos.h
new file mode 100644
index 000000000..cd199e808
--- /dev/null
+++ b/src/h/dos.h
@@ -0,0 +1 @@
+struct rlimit { int i; } ;
diff --git a/src/h/ecls-cmp.h b/src/h/ecls-cmp.h
new file mode 100644
index 000000000..f649f7371
--- /dev/null
+++ b/src/h/ecls-cmp.h
@@ -0,0 +1,70 @@
+/*
+    ecls-cmp.h  -- Include file for compiled code.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or modify it under
+    the terms of the GNU General Library Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include "config.h"
+#include "machines.h"
+#include <stddef.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <setjmp.h>
+#include <math.h>
+#include <inttypes.h>
+#include <limits.h>
+#include <sys/types.h>
+
+#ifdef __GNUC__
+#define VOID void
+#define VOL volatile
+#else
+#define VOID char
+#define VOL
+#endif
+
+#include "gmp.h"
+#include "object.h"
+#include "stacks.h"
+#ifdef THREADS
+#include "lwp.h"
+#include "critical.h"
+#endif THREADS
+#include "external.h"
+#include "lisp_external.h"
+#include "eval.h"
+#include "number.h"
+#ifdef LOCATIVE
+#include "unify.h"
+#endif LOCATIVE
+
+#define	cs_check \
+	if ((int *)(&narg) < cs_limit) \
+		cs_overflow()
+
+#define LINK_ARGS	&narg
+#ifdef CLOS
+#define TRAMPOLINK(vv, lk) \
+	static cl_object gfun = OBJNULL; \
+	va_list args; va_start(args, narg); \
+	if (gfun) return(gcall(narg, gfun, args)); \
+	else return(link_call(vv, lk , &gfun, &narg))
+#else
+#define TRAMPOLINK(vv, lk) \
+	va_list args; va_start(args, narg); \
+	return(link_call(vv, lk , &narg))
+#endif CLOS
+
+#define	cclosure_call	funcall
+
+#define Creturn(v)	return((VALUES(0)=(v),1))
+#define Cexit		return(0)
diff --git a/src/h/ecls-inl.h b/src/h/ecls-inl.h
new file mode 100644
index 000000000..3476d3a9f
--- /dev/null
+++ b/src/h/ecls-inl.h
@@ -0,0 +1,131 @@
+/*
+ * Loops over a proper list
+ */
+#ifdef ECLS_SAFE
+#define loop_for_in(list) { \
+  cl_object __slow; \
+  bool __flag = ~0; \
+  for (__slow = list; !ENDP(list); list = CDR(list)) { \
+    if ((__flag = ~__flag)) { \
+      if (__slow == list) FEcircular_list(list); \
+      __slow = CDR(__slow); \
+    }
+#else
+#define loop_for_in(list) { \
+  for (; !ENDP(list); list = CDR(list)) {
+#endif
+#define end_loop_for_in }}
+
+/*
+ * Loops over a dotted list
+ */
+#ifdef ECLS_SAFE
+#define loop_for_on(list) \
+  if (!CONSP(list)) { \
+    if (list != Cnil) FEtype_error_list(list); \
+  }else { \
+    cl_object __slow; \
+    bool __flag = ~0; \
+    for (__slow = list; CONSP(list); list = CDR(list)) { \
+      if ((__flag = ~__flag)) { \
+        if (__slow == list) FEcircular_list(list); \
+        __slow = CDR(__slow); \
+      }
+#else
+#define loop_for_on(list) \
+  if (!CONSP(list)) { \
+    if (list != Cnil) FEtype_error_list(list); \
+  else { \
+    for (; CONSP(list); list = CDR(list)) {
+#endif
+#define end_loop_for_on }}
+
+/* The following is unused */
+#if 0 && defined(GBC_BOEHM) && defined(__GNUC__)
+
+#define alloc_object fast_alloc_object
+#define make_cons fast_make_cons
+
+extern void *GC_malloc(size_t);
+extern void *GC_malloc_atomic(size_t);
+
+static inline cl_object
+fast_alloc_object(enum type t)
+{
+  cl_object x;
+  switch (t) {
+  case t_cons:
+    x = GC_malloc(sizeof(struct cons)); break;
+  case t_fixnum:
+    return MAKE_FIXNUM(0);
+  case t_character:
+    return code_char(' ');
+  case t_bignum:
+    x = GC_malloc(sizeof(struct bignum)); break;
+  case t_ratio:
+    x = GC_malloc(sizeof(struct ratio)); break;
+  case t_shortfloat:
+    x = GC_malloc_atomic(sizeof(struct shortfloat_struct)); break;
+  case t_longfloat:
+    x = GC_malloc_atomic(sizeof(struct longfloat_struct)); break;
+  case t_complex:
+    x = GC_malloc(sizeof(struct complex)); break;
+  case t_symbol:
+    x = GC_malloc(sizeof(struct symbol)); break;
+  case t_package:
+    x = GC_malloc(sizeof(struct package)); break;
+  case t_hashtable:
+    x = GC_malloc(sizeof(struct hashtable)); break;
+  case t_array:
+    x = GC_malloc(sizeof(struct array)); break;
+  case t_vector:
+    x = GC_malloc(sizeof(struct vector)); break;
+  case t_string:
+    x = GC_malloc(sizeof(struct string)); break;
+  case t_bitvector:
+    x = GC_malloc(sizeof(struct bitvector)); break;
+  case t_stream:
+    x = GC_malloc(sizeof(struct stream)); break;
+  case t_random:
+    x = GC_malloc_atomic(sizeof(struct random)); break;
+  case t_readtable:
+    x = GC_malloc(sizeof(struct readtable)); break;
+  case t_pathname:
+    x = GC_malloc(sizeof(struct pathname)); break;
+  case t_cfun:
+    x = GC_malloc(sizeof(struct cfun)); break;
+  case t_cclosure:
+    x = GC_malloc(sizeof(struct cclosure)); break;
+#ifdef CLOS
+  case t_instance:
+    x = GC_malloc(sizeof(struct instance)); break;
+  case t_gfun:
+    x = GC_malloc(sizeof(struct gfun)); break;
+#else
+  case t_structure:
+    x = GC_malloc(sizeof(struct structure)); break;
+#endif CLOS
+#ifdef THREADS
+  case t_cont:
+    x = GC_malloc(sizeof(struct cont)); break;
+  case t_thread:
+    x = GC_malloc(sizeof(struct thread)); break;
+#endif
+  default:
+    error("allocation botch!");
+  }
+  x->c.t = t;
+  return x;
+}
+
+static inline
+cl_object fast_make_cons(cl_object a, cl_object b)
+{
+  cl_object x = GC_malloc(sizeof(struct cons));
+  x->c.t = t_cons;
+  x->c.c_car = a;
+  x->c.c_cdr = b;
+  return x;
+}
+
+#endif
diff --git a/src/h/ecls.h b/src/h/ecls.h
new file mode 100644
index 000000000..4cae230d7
--- /dev/null
+++ b/src/h/ecls.h
@@ -0,0 +1,62 @@
+/*
+    ecls.h -- Main headers for development of ECLS
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#include <sys/param.h>		/* includes <sys/signal.h> and <sys/types.h> */
+#include <sys/types.h>		/* for EMX */
+#include "config.h"
+#include "machines.h"
+#include <stddef.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <setjmp.h>
+#include <inttypes.h>
+#include <limits.h>
+
+#ifdef __GNUC__
+#define VOID void
+#else
+#define VOID char
+#endif
+
+#ifdef BSD
+# include <sys/time.h>
+#endif BSD
+
+#ifdef SYSV
+# ifndef MAXPATHLEN
+#  define MAXPATHLEN	PATH_MAX
+# endif MAXPATHLEN
+#endif SYSV
+
+#include "gmp.h"
+#include "object.h"
+#include "stacks.h"
+#include "cs.h"
+#include "critical.h"
+#ifdef THREADS
+# include "lwp.h"
+#endif THREADS
+#include "external.h"
+#ifndef _ARGS
+#define _ARGS(x) x
+#endif
+/*#include "ecls-inl.h"*/
+#include "lisp_external.h"
+#include "eval.h"
+#include "number.h"
+#ifdef LOCATIVE
+#include "unify.h"
+#endif LOCATIVE
diff --git a/src/h/eval.h b/src/h/eval.h
new file mode 100644
index 000000000..883befd28
--- /dev/null
+++ b/src/h/eval.h
@@ -0,0 +1,55 @@
+/*
+    eval.h -- Macros and parameters..
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#define check_symbol(x) if (!SYMBOLP(x)) FEtype_error_symbol(x);
+
+#define	check_var(x) \
+	if (!SYMBOLP(x) || (enum stype)(x)->symbol.stype == stp_constant) \
+		not_a_variable(x)
+
+#define CONS(a,d)	make_cons((a),(d))
+#define ACONS(a,b,c)	make_cons(make_cons((a),(b)),(c))
+#define CAR(x)		(x)->cons.car
+#define CDR(x)		(x)->cons.cdr
+#define CAAR(x)		(x)->cons.car->cons.car
+#define CADR(x)		(x)->cons.cdr->cons.car
+#define CDAR(x)		(x)->cons.car->cons.cdr
+#define CDDR(x)		(x)->cons.cdr->cons.cdr
+#define CAAAR(x)	(x)->cons.car->cons.car->cons.car
+#define CAADR(x)	(x)->cons.cdr->cons.car->cons.car
+#define CADAR(x)	(x)->cons.car->cons.cdr->cons.car
+#define CADDR(x)	(x)->cons.cdr->cons.cdr->cons.car
+#define CDAAR(x)	(x)->cons.car->cons.car->cons.cdr
+#define CDADR(x)	(x)->cons.cdr->cons.car->cons.cdr
+#define CDDAR(x)	(x)->cons.car->cons.cdr->cons.cdr
+#define CDDDR(x)	(x)->cons.cdr->cons.cdr->cons.cdr
+#define CAAAAR(x)	(x)->cons.car->cons.car->cons.car->cons.car
+#define CAAADR(x)	(x)->cons.cdr->cons.car->cons.car->cons.car
+#define CAADAR(x)	(x)->cons.car->cons.cdr->cons.car->cons.car
+#define CAADDR(x)	(x)->cons.cdr->cons.cdr->cons.car->cons.car
+#define CADAAR(x)	(x)->cons.car->cons.car->cons.cdr->cons.car
+#define CADADR(x)	(x)->cons.cdr->cons.car->cons.cdr->cons.car
+#define CADDAR(x)	(x)->cons.car->cons.cdr->cons.cdr->cons.car
+#define CADDDR(x)	(x)->cons.cdr->cons.cdr->cons.cdr->cons.car
+#define CDAAAR(x)	(x)->cons.car->cons.car->cons.car->cons.car
+#define CDAADR(x)	(x)->cons.cdr->cons.car->cons.car->cons.cdr
+#define CDADAR(x)	(x)->cons.car->cons.cdr->cons.car->cons.cdr
+#define CDADDR(x)	(x)->cons.cdr->cons.cdr->cons.car->cons.cdr
+#define CDDAAR(x)	(x)->cons.car->cons.car->cons.cdr->cons.cdr
+#define CDDADR(x)	(x)->cons.cdr->cons.car->cons.cdr->cons.cdr
+#define CDDDAR(x)	(x)->cons.car->cons.cdr->cons.cdr->cons.cdr
+#define CDDDDR(x)	(x)->cons.cdr->cons.cdr->cons.cdr->cons.cdr
+
+#define Null(x)	((x)==Cnil)
diff --git a/src/h/external.h b/src/h/external.h
new file mode 100644
index 000000000..c39c5a788
--- /dev/null
+++ b/src/h/external.h
@@ -0,0 +1,975 @@
+struct let {
+        cl_object let_var;
+        cl_object let_spp;
+        cl_object let_init;
+};
+
+struct iterator {
+        cl_object iter_var;
+        cl_object iter_spp;
+        cl_object iter_init;
+        cl_object iter_incr;
+};
+
+/* alloc.c */
+
+#if !defined(GBC_BOEHM)
+extern void *alloc_page(size_t n);
+extern cl_object alloc_object(enum type t);
+extern cl_object alloc_instance(cl_index slots);
+extern cl_object make_cons(cl_object a, cl_object d);
+extern void *alloc(size_t n);
+extern void *alloc_align(size_t size, size_t align);
+#define alloc_atomic(x) alloc(x)
+#define alloc_atomic_align(x,s) alloc_align(x,s)
+extern void dealloc(void *p, size_t s);
+extern void init_alloc(void);
+extern void init_alloc_function(void);
+#endif /* !GBC_BOEHM */
+
+
+/* alloc_2.c */
+
+#if defined(GBC_BOEHM)
+extern cl_object alloc_object(enum type t);
+extern cl_object alloc_instance(cl_index slots);
+extern cl_object make_cons(cl_object a, cl_object d);
+extern void *alloc(size_t n);
+extern void *alloc_align(size_t size, size_t align);
+extern void *alloc_atomic(size_t size);
+extern void *alloc_atomic_align(size_t size, size_t align);
+extern void dealloc(void *p, size_t s);
+extern void init_alloc(void);
+#endif /* GBC_BOEHM */
+
+
+/* all_functions.c */
+
+extern void init_all_functions(void);
+
+
+/* all_keywords.c */
+extern void init_all_keywords(void);
+
+
+/* all_symbols */
+extern void init_all_symbols(void);
+
+
+/* apply.c */
+
+extern cl_object APPLY(int n, cl_object (*fn)(), cl_object *x);
+extern cl_object APPLY_closure(int n, cl_object (*fn)(), cl_object cl, cl_object *x);
+
+
+/* array.c */
+
+extern cl_index object_to_index(cl_object n);
+extern cl_object aref(cl_object x, cl_index index);
+extern cl_object aref1(cl_object v, cl_index index);
+extern cl_object aset(cl_object x, cl_index index, cl_object value);
+extern cl_object aset1(cl_object v, cl_index index, cl_object val);
+extern void array_allocself(cl_object x);
+extern void *array_address(cl_object x, cl_index inc);
+extern void adjust_displaced(cl_object x, ptrdiff_t diff);
+extern enum aelttype array_elttype(cl_object x);
+extern enum aelttype get_aelttype(cl_object x);
+extern void init_array(void);
+
+
+/* assignment.c */
+
+extern cl_object set(cl_object sym, cl_object val);
+extern cl_object setf_namep(cl_object fun_spec);
+extern void clear_compiler_properties(cl_object sym);
+extern void init_assignment(void);
+
+
+/* backq.c */
+
+#ifndef THREADS
+extern int backq_level;
+#endif
+extern int backq_cdr(cl_object *px);
+extern int backq_car(cl_object *px);
+extern cl_object backq(cl_object x);
+extern void init_backq(void);
+
+
+/* big.c */
+
+#ifdef THREADS
+#define bignum_register_limbs lwp->lwp_bignum_register_limbs
+#define bignum_register lwp->lwp_bignum_register
+#else
+extern cl_object bignum_register[3];
+extern mp_limb_t bignum_register_limbs[3][BIGNUM_REGISTER_SIZE];
+#endif THREADS
+extern cl_object big_register_copy(cl_object x);
+extern cl_object big_register_normalize(cl_object x);
+/*extern cl_object big_alloc(int size);*/
+extern cl_object bignum1(int val);
+extern cl_object bignum2(mp_limb_t hi, mp_limb_t lo);
+extern cl_object big_set_fixnum(cl_object x, cl_object fix);
+extern cl_object big_copy(cl_object x);
+extern cl_object big_minus(cl_object x);
+extern cl_object big_plus(cl_object x, cl_object y);
+extern cl_object big_normalize(cl_object x);
+extern double big_to_double(cl_object x);
+extern long big_to_long(cl_object x);
+extern void init_big(void);
+
+
+/* bind.c */
+
+extern cl_object let_bind(cl_object body, struct let *start, struct let *end, int size);
+extern cl_object letA_bind(cl_object body, struct let *start, struct let *end, int size);
+extern cl_object process_decl(cl_object body, struct let *start, struct let *end, int size);
+extern void parse_key(int narg, cl_object *args, int nkey, cl_object *keys, cl_object *vars, cl_object rest, bool allow_other_keys);
+extern void check_other_key(cl_object l, int n, ...);
+extern void init_bind(void);
+
+
+/* block.c */
+
+extern void init_block(void);
+
+
+/* catch.c */
+
+extern void init_catch(void);
+
+
+/* cfun.c */
+
+#ifndef RUNTIME
+#define FUN_TABLE_SIZE 256
+extern void **function_entry_table;
+extern int function_entries_max;
+extern int function_entries;
+#endif
+extern cl_object make_cfun(cl_object (*self)(), cl_object name, cl_object block);
+extern cl_object make_cclosure(cl_object (*self)(), cl_object env, cl_object block);
+extern void MF(cl_object sym, cl_object (*self)(), cl_object block);
+extern void MM(cl_object sym, cl_object (*self)(), cl_object block);
+extern cl_object make_function(char *s, cl_object (*f)());
+extern cl_object make_si_function(char *s, cl_object (*f)());
+extern cl_object get_function_entry(void *);
+extern void init_cfun(void);
+
+
+/* character.c */
+
+extern cl_fixnum char_code(cl_object c);
+extern int digitp(int i, int r);
+extern bool char_eq(cl_object x, cl_object y);
+extern int char_cmp(cl_object x, cl_object y);
+extern bool char_equal(cl_object x, cl_object y);
+extern int char_compare(cl_object x, cl_object y);
+extern cl_object coerce_to_character(cl_object x);
+extern short digit_weight(int w, int r);
+extern void init_character(void);
+extern void init_character_function(void);
+
+
+/* clos.c */
+
+#ifdef CLOS
+extern cl_object class_class;
+extern cl_object class_object;
+extern cl_object class_built_in;
+extern void init_clos(void);
+#endif
+
+/* cmpaux.c */
+
+extern cl_object make_list(int i);
+extern int ifloor(int x, int y);
+extern int imod(int x, int y);
+extern char object_to_char(cl_object x);
+extern int object_to_int(cl_object x);
+extern char *object_to_string(cl_object x);
+extern float object_to_float(cl_object x);
+extern double object_to_double(cl_object x);
+extern int aref_bv(cl_object x, cl_index index);
+extern int aset_bv(cl_object x, cl_index index, int value);
+extern void throw(cl_object tag) __attribute__((noreturn));
+extern void return_from(cl_object block_id, cl_object block_name) __attribute__((noreturn));
+extern void go(cl_object tag_id, cl_object label) __attribute__((noreturn));
+
+/* compiler.c */
+
+cl_object make_lambda(cl_object name, cl_object lambda);
+cl_object eval(cl_object form, cl_object *bytecodes);
+
+/* interpreter.c */
+
+cl_object stack;
+cl_object lambda_apply(int narg, cl_object fun, cl_object *args);
+cl_object *interpret(cl_object *memory);
+
+/* conditional.c */
+
+extern void init_conditional(void);
+
+
+/* earith.c */
+
+extern void extended_mul(int d, int q, int r, int *hp, int *lp);
+extern void extended_div(int d, int h, int l, int *qp, int *rp);
+
+
+/* error.c */
+
+extern cl_object null_string;
+extern void internal_error(const char *s) __attribute__((noreturn));
+extern void cs_overflow(void) __attribute__((noreturn));
+extern void error(const char *s) __attribute__((noreturn));
+extern void terminal_interrupt(bool correctable);
+extern void FEcondition(int narg, cl_object name, ...) __attribute__((noreturn));
+extern void FEprogram_error(const char *s, int narg, ...) __attribute__((noreturn));
+extern void FEerror(char *s, int narg, ...) __attribute__((noreturn));
+extern void FEcannot_open(cl_object fn) __attribute__((noreturn));
+extern void FEwrong_type_argument(cl_object type, cl_object value) __attribute__((noreturn));
+extern void FEtoo_few_arguments(int *nargp) __attribute__((noreturn));
+extern void FEtoo_many_arguments(int *nargp) __attribute__((noreturn));
+extern void FEunbound_variable(cl_object sym) __attribute__((noreturn));
+extern void FEinvalid_macro_call(cl_object obj) __attribute__((noreturn));
+extern void FEinvalid_variable(char *s, cl_object obj) __attribute__((noreturn));
+extern void FEassignment_to_constant(cl_object v) __attribute__((noreturn));
+extern void FEundefined_function(cl_object fname) __attribute__((noreturn));
+extern void FEinvalid_function(cl_object obj) __attribute__((noreturn));
+extern cl_object CEerror(char *err_str, int narg, ...);
+extern void check_arg_failed(int narg, int req) __attribute__((noreturn));
+extern void illegal_index(cl_object x, cl_object i);
+extern void FEtype_error_symbol(cl_object obj);
+extern void not_a_variable(cl_object obj);
+extern void init_error(void);
+
+extern void FEend_of_file(cl_object strm);
+
+/* eval.c */
+
+#define _eval	eval
+#define _apply	apply
+#define _funcall funcall
+extern cl_object lambda_apply(int narg, cl_object fun, cl_object *args);
+extern cl_object apply(int narg, cl_object fun, cl_object *args);
+extern cl_object funcall(int narg, ...);
+extern cl_object link_call(cl_object sym, cl_object (**pLK)(), cl_object *gfun, cl_object *args);
+extern void init_eval(void);
+
+
+/* file.c */
+
+extern bool input_stream_p(cl_object strm);
+extern bool output_stream_p(cl_object strm);
+extern cl_object stream_element_type(cl_object strm);
+extern void closed_stream(cl_object strm) __attribute__ ((noreturn));
+extern cl_object open_stream(cl_object fn, enum smmode smm, cl_object if_exists, cl_object if_does_not_exist);
+extern void close_stream(cl_object strm, bool abort_flag);
+extern cl_object make_two_way_stream(cl_object istrm, cl_object ostrm);
+extern cl_object make_echo_stream(cl_object istrm, cl_object ostrm);
+extern cl_object make_string_input_stream(cl_object strng, cl_index istart, cl_index iend);
+extern cl_object make_string_output_stream(cl_index line_length);
+extern cl_object get_output_stream_string(cl_object strm);
+extern int readc_stream(cl_object strm);
+extern void unreadc_stream(int c, cl_object strm);
+extern int writec_stream(int c, cl_object strm);
+extern void writestr_stream(const char *s, cl_object strm);
+extern void flush_stream(cl_object strm);
+extern void clear_input_stream(cl_object strm);
+extern void clear_output_stream(cl_object strm);
+extern bool stream_at_end(cl_object strm);
+extern bool listen_stream(cl_object strm);
+extern long file_position(cl_object strm);
+extern long file_position_set(cl_object strm, long disp);
+extern long file_length(cl_object strm);
+extern int file_column(cl_object strm);
+extern void init_file(void);
+extern void init_file_function(void);
+
+
+/* format.c */
+
+extern void init_format(void);
+
+
+/* gbc.c */
+
+#if !defined(GBC_BOEHM)
+#define GC_enabled() GC_enable
+#define GC_enable() GC_enable = TRUE;
+#define GC_disable() GC_enable = FALSE;
+extern bool GC_enable;
+extern int gc_time;
+extern cl_object (*GC_enter_hook)();
+extern cl_object (*GC_exit_hook)();
+extern void register_root(cl_object *p);
+extern void gc(enum type t);
+extern void init_GC(void);
+#endif
+
+
+/* gbc_2.c */
+
+#ifdef GBC_BOEHM
+#define GC_enabled() (!GC_dont_gc)
+#define GC_enable() GC_dont_gc = FALSE;
+#define GC_disable() GC_dont_gc = TRUE;
+extern int GC_dont_gc;
+extern void register_root(cl_object *p);
+extern void gc(enum type t);
+#endif GBC_BOEHM
+
+
+/* gfun.c */
+
+#ifdef CLOS
+extern cl_object gcall(int narg, cl_object fun, cl_object *args);
+extern void init_gfun(void);
+#endif CLOS
+
+
+/* hash.c */
+
+extern cl_hashkey update_crc32(cl_hashkey crc, const char *buffer, cl_index len);
+extern cl_hashkey hash_eq(cl_object x);
+extern cl_hashkey hash_eql(cl_object x);
+extern cl_hashkey hash_equal(cl_object x);
+extern void sethash(cl_object key, cl_object hashtable, cl_object value);
+extern void extend_hashtable(cl_object hashtable);
+extern void init_hash(void);
+extern cl_object gethash(cl_object key, cl_object hash);
+extern cl_object gethash_safe(cl_object key, cl_object hash, cl_object def);
+extern bool remhash(cl_object key, cl_object hash);
+
+
+/* init.c */
+
+extern void init_lisp(void);
+extern void init_libs(void);
+
+
+/* instance.c */
+
+#ifdef CLOS
+extern cl_object allocate_instance(cl_object class, int size);
+extern cl_object instance_ref(cl_object x, int i);
+extern cl_object instance_set(cl_object x, int i, cl_object v);
+extern void init_instance(void);
+#endif CLOS
+
+
+/* iteration.c */
+
+extern void do_bindings(cl_object var_list, struct iterator *bt);
+extern void init_iteration(void);
+
+
+/* let.c */
+
+extern void let_bindings(cl_object var_list, struct let *let);
+extern void init_let(void);
+
+
+/* lex.c */
+
+extern void lex_fun_bind(cl_object name, cl_object fun);
+extern void lex_macro_bind(cl_object name, cl_object exp_fun);
+extern void lex_tag_bind(cl_object tag, cl_object id);
+extern void lex_block_bind(cl_object name, cl_object id);
+extern cl_object lex_sch(cl_object lex_list, cl_object name, cl_object type);
+extern cl_object lex_symbol_macro_sch(cl_object name);
+extern void init_lex(void);
+
+
+/* list.c */
+
+extern cl_object list_length(cl_object x);
+extern cl_object identity(cl_object x);
+extern cl_object car(cl_object x);
+extern cl_object cdr(cl_object x);
+extern cl_object list(int narg, ...);
+extern cl_object listA(int narg, ...);
+extern cl_object append(cl_object x, cl_object y);
+extern cl_object caar(cl_object x);
+extern cl_object cadr(cl_object x);
+extern cl_object cdar(cl_object x);
+extern cl_object cddr(cl_object x);
+extern cl_object caaar(cl_object x);
+extern cl_object caadr(cl_object x);
+extern cl_object cadar(cl_object x);
+extern cl_object caddr(cl_object x);
+extern cl_object cdaar(cl_object x);
+extern cl_object cdadr(cl_object x);
+extern cl_object cddar(cl_object x);
+extern cl_object cdddr(cl_object x);
+extern cl_object caaaar(cl_object x);
+extern cl_object caaadr(cl_object x);
+extern cl_object caadar(cl_object x);
+extern cl_object caaddr(cl_object x);
+extern cl_object cadaar(cl_object x);
+extern cl_object cadadr(cl_object x);
+extern cl_object caddar(cl_object x);
+extern cl_object cadddr(cl_object x);
+extern cl_object cdaaar(cl_object x);
+extern cl_object cdaadr(cl_object x);
+extern cl_object cdadar(cl_object x);
+extern cl_object cdaddr(cl_object x);
+extern cl_object cddaar(cl_object x);
+extern cl_object cddadr(cl_object x);
+extern cl_object cdddar(cl_object x);
+extern cl_object cddddr(cl_object x);
+extern bool endp1(cl_object x);
+extern cl_object nth(cl_fixnum n, cl_object x);
+extern cl_object nthcdr(cl_fixnum n, cl_object x);
+extern cl_object copy_list(cl_object x);
+extern cl_object copy_alist(cl_object x);
+extern cl_object copy_tree(cl_object x);
+extern cl_object nconc(cl_object x, cl_object y);
+extern cl_object subst(cl_object new, cl_object tree);
+extern void nsubst(cl_object new, cl_object *treep);
+extern cl_object sublis(cl_object alist, cl_object tree);
+extern void nsublis(cl_object alist, cl_object *treep);
+extern bool member_eq(cl_object x, cl_object l);
+extern cl_object memq(cl_object x, cl_object l);
+extern cl_object memql(cl_object x, cl_object l);
+extern cl_object member(cl_object x, cl_object l);
+extern cl_object assq(cl_object x, cl_object l);
+extern cl_object assql(cl_object x, cl_object l);
+extern cl_object assoc(cl_object x, cl_object l);
+extern cl_object assqlp(cl_object x, cl_object l);
+extern void init_list(void);
+
+
+/* load.c */
+
+extern void init_load(void);
+extern void load_until_tag(cl_object stream, cl_object end_tag);
+extern void build_symbol_table();
+extern const char *system_directory();
+
+/* lwp.c */
+#ifdef THREADS
+extern int critical_level;
+extern int update_queue(void);
+extern int activate_thread(cl_object thread);
+extern int thread_next(void);
+extern int scheduler(int sig, int code, struct sigcontext *scp);
+extern int interruption_handler(void);
+extern int lwp_bds_wind(bds_ptr base, bds_ptr top);
+extern int lwp_bds_unwind(bds_ptr base, bds_ptr top);
+extern int enable_scheduler(void);
+extern int enable_lwp(void);
+extern int init_lwp(void);
+#endif
+
+/* macros.c */
+
+extern cl_object macro_expand1(cl_object form, cl_object env);
+extern cl_object macro_expand(cl_object form, cl_object env);
+extern void init_macros(void);
+
+
+/* main.c */
+
+extern int data_start;
+extern const char *ecl_self;
+extern void init_main(void);
+
+
+/* mapfun.c */
+
+extern void init_mapfun(void);
+
+
+/* multival.c */
+
+extern void init_multival(void);
+
+
+/* num_arith.c */
+
+extern cl_object cl_fixnumimes(int i, int j);
+extern cl_object number_times(cl_object x, cl_object y);
+extern cl_object number_to_complex(cl_object x);
+extern cl_object number_plus(cl_object x, cl_object y);
+extern cl_object number_minus(cl_object x, cl_object y);
+extern cl_object number_negate(cl_object x);
+extern cl_object number_divide(cl_object x, cl_object y);
+extern cl_object integer_divide(cl_object x, cl_object y);
+extern cl_object get_gcd(cl_object x, cl_object y);
+extern cl_object one_plus(cl_object x);
+extern cl_object one_minus(cl_object x);
+extern void init_num_arith(void);
+
+
+/* number.c */
+
+extern cl_object shortfloat_zero;
+extern cl_object longfloat_zero;
+extern int fixint(cl_object x);
+extern int fixnnint(cl_object x);
+extern cl_object make_ratio(cl_object num, cl_object den);
+extern cl_object make_shortfloat(float f);
+extern cl_object make_longfloat(double f);
+extern cl_object make_complex(cl_object r, cl_object i);
+extern double number_to_double(cl_object x);
+extern void init_number(void);
+
+
+/* num_co.c */
+
+extern cl_object double_to_integer(double d);
+extern cl_object floor1(cl_object x);
+extern cl_object ceiling1(cl_object x);
+extern cl_object truncate1(cl_object x);
+extern cl_object round1(cl_object x);
+extern cl_object floor2(cl_object x, cl_object y);
+extern cl_object ceiling2(cl_object x, cl_object y);
+extern cl_object truncate2(cl_object x, cl_object y);
+extern cl_object round2(cl_object x, cl_object y);
+extern void init_num_co(void);
+
+
+/* num_comp.c */
+
+extern int number_equalp(cl_object x, cl_object y);
+extern int number_compare(cl_object x, cl_object y);
+extern cl_object monotonic(int s, int t, int narg, cl_object *nums);
+extern void init_num_comp(void);
+
+
+/* num_log.c */
+
+extern cl_object integer_shift(cl_object x, int w);
+extern int int_bit_length(int i);
+extern void init_num_log(void);
+
+
+/* num_pred.c */
+
+extern int number_zerop(cl_object x);
+extern int number_plusp(cl_object x);
+extern int number_minusp(cl_object x);
+extern int number_oddp(cl_object x);
+extern int number_evenp(cl_object x);
+extern void init_num_pred(void);
+
+
+/* num_rand.c */
+
+extern cl_object make_random_state(cl_object rs);
+extern void init_num_rand(void);
+
+
+/* num_sfun.c */
+
+extern cl_object imag_unit;
+extern cl_object minus_imag_unit;
+extern cl_object imag_two;
+extern cl_fixnum fixnum_expt(cl_fixnum x, cl_fixnum y);
+extern cl_object number_exp(cl_object x);
+extern cl_object number_expt(cl_object x, cl_object y);
+extern cl_object number_nlog(cl_object x);
+extern cl_object number_log(cl_object x, cl_object y);
+extern cl_object number_sqrt(cl_object x);
+extern cl_object number_atan2(cl_object y, cl_object x);
+extern cl_object number_atan(cl_object y);
+extern cl_object number_sin(cl_object x);
+extern cl_object number_cos(cl_object x);
+extern cl_object number_tan(cl_object x);
+extern void init_num_sfun(void);
+
+
+/* package.c */
+
+extern bool lisp_package_locked;
+extern cl_object lisp_package;
+extern cl_object user_package;
+extern cl_object keyword_package;
+extern cl_object system_package;
+extern cl_object clos_package;
+extern int intern_flag;
+extern cl_object uninterned_list;
+extern cl_object make_package(cl_object n, cl_object ns, cl_object ul);
+extern cl_object rename_package(cl_object x, cl_object n, cl_object ns);
+extern cl_object find_package(cl_object n);
+extern cl_object coerce_to_package(cl_object p);
+extern cl_object current_package(void);
+extern cl_object intern(cl_object name, cl_object p);
+extern cl_object _intern(const char *s, cl_object p);
+extern cl_object find_symbol(cl_object name, cl_object p);
+extern bool unintern(cl_object s, cl_object p);
+extern void export(cl_object s, cl_object p);
+extern void unexport(cl_object s, cl_object p);
+extern void import(cl_object s, cl_object p);
+extern void shadowing_import(cl_object s, cl_object p);
+extern void shadow(cl_object s, cl_object p);
+extern void use_package(cl_object x0, cl_object p);
+extern void unuse_package(cl_object x0, cl_object p);
+extern void delete_package(cl_object p);
+extern void init_package(void);
+extern void init_package_function(void);
+
+
+/* pathname.c */
+
+extern cl_object make_pathname(cl_object host, cl_object device, cl_object directory, cl_object name, cl_object type, cl_object version);
+extern cl_object parse_namestring(const char *s, cl_index start, cl_index end, cl_index *ep, cl_object default_host);
+extern cl_object coerce_to_pathname(cl_object x);
+extern cl_object coerce_to_physical_pathname(cl_object x);
+extern cl_object coerce_to_file_pathname(cl_object pathname);
+extern cl_object coerce_to_filename(cl_object pathname);
+extern cl_object default_device(cl_object host);
+extern cl_object merge_pathnames(cl_object path, cl_object defaults, cl_object default_version);
+extern cl_object namestring(cl_object x);
+extern cl_object coerce_to_namestring(cl_object x);
+extern bool pathname_match_p(cl_object path, cl_object mask);
+extern bool logical_hostname_p(cl_object host);
+extern cl_object translate_pathname(cl_object path, cl_object from, cl_object to);
+extern void init_pathname(void);
+
+
+/* predicate.c */
+
+extern bool numberp(cl_object x);
+extern bool eql(cl_object x, cl_object y);
+extern bool equal(register cl_object x, cl_object y);
+extern bool equalp(cl_object x, cl_object y);
+extern bool contains_sharp_comma(cl_object x);
+extern void init_predicate(void);
+
+
+/* print.c */
+
+extern bool PRINTescape;
+extern bool PRINTpretty;
+extern bool PRINTcircle;
+extern int PRINTbase;
+extern bool PRINTradix;
+extern cl_object PRINTcase;
+extern bool PRINTgensym;
+extern int PRINTlevel;
+extern int PRINTlength;
+extern bool PRINTarray;
+extern void (*write_ch_fun)();
+extern void (*output_ch_fun)();
+extern cl_object PRINTpackage;
+extern bool PRINTstructure;
+extern jmp_buf CIRCLEjmp;
+extern cl_object *CIRCLEbase;
+extern cl_object *CIRCLEtop;
+extern cl_object *CIRCLElimit;
+extern cl_object PRINTstream;
+extern void interactive_writec_stream(int c, cl_object stream);
+extern void flush_interactive_stream(cl_object stream);
+extern void writec_PRINTstream(int c);
+extern void write_str(char *s);
+extern void write_decimal(int i);
+extern void write_addr(cl_object x);
+extern void edit_double(int n, double d, int *sp, char *s, int *ep);
+extern void write_double(double d, int e, bool shortp);
+extern void write_fixnum(cl_fixnum i);
+extern void write_bignum(cl_object x);
+extern void write_object(cl_object x, int level);
+extern void setupPRINT(cl_object x, cl_object strm);
+extern void cleanupPRINT(void);
+extern bool potential_number_p(cl_object strng, int base);
+extern cl_object princ(cl_object obj, cl_object strm);
+extern cl_object prin1(cl_object obj, cl_object strm);
+extern cl_object print(cl_object obj, cl_object strm);
+extern cl_object terpri(cl_object strm);
+extern void write_string(cl_object strng, cl_object strm);
+extern void princ_str(const char *s, cl_object sym);
+extern void princ_char(int c, cl_object sym);
+extern void init_print(void);
+extern void init_print_function(void);
+
+
+/* profile.c */
+#ifdef PROFILE
+extern int total_ticks(unsigned short *aar, unsigned int dim);
+extern int init_profile(void);
+#endif
+
+
+/* prog.c */
+
+extern void init_prog(void);
+
+
+/* read.c */
+
+extern cl_object standard_readtable;
+#ifndef THREADS
+extern cl_object READtable;
+extern int READdefault_float_format;
+extern int READbase;
+extern bool READsuppress;
+extern bool preserving_whitespace_flag;
+extern bool escape_flag;
+extern cl_object delimiting_char;
+extern bool detect_eos_flag;
+extern bool in_list_flag;
+extern bool dot_flag;
+extern cl_object default_dispatch_macro;
+extern cl_object (*read_ch_fun)();
+extern cl_object sharp_eq_context;
+#endif
+extern cl_object interactive_readc(cl_object stream);
+extern cl_object readc(cl_object in);
+extern void unread_char(cl_object c, cl_object in);
+extern cl_object peek_char(bool pt, cl_object in);
+extern cl_object read_object_non_recursive(cl_object in);
+extern cl_object read_object(cl_object in);
+extern cl_object parse_number(char *s, cl_index end, cl_index *ep, int radix);
+extern cl_object parse_integer(char *s, cl_index end, cl_index *ep, int radix);
+extern cl_object copy_readtable(cl_object from, cl_object to);
+extern cl_object current_readtable(void);
+extern cl_object string_to_object(cl_object x);
+extern void init_read(void);
+extern void init_read_function(void);
+extern void read_VV(cl_object, void *);
+
+
+/* reference.c */
+
+extern cl_object symbol_function(cl_object sym);
+extern cl_object make_lambda(cl_object name, cl_object lambda);
+extern void init_reference(void);
+
+
+/* sequence.c */
+
+extern cl_object alloc_simple_vector(int l, enum aelttype aet);
+extern cl_object alloc_simple_bitvector(int l);
+extern cl_object elt(cl_object seq, cl_fixnum index);
+extern cl_object elt_set(cl_object seq, cl_fixnum index, cl_object val);
+extern cl_fixnum length(cl_object x);
+extern cl_object reverse(cl_object seq);
+extern cl_object nreverse(cl_object seq);
+extern void init_sequence(void);
+
+
+/* stacks.c */
+
+extern void bds_overflow(void) __attribute__((noreturn));
+extern void bds_unwind(bds_ptr new_bds_top);
+extern void ihs_overflow(void) __attribute__((noreturn));
+extern cl_object ihs_function_name(cl_object x);
+extern cl_object ihs_top_function_name(void);
+extern int frs_overflow(void) __attribute__((noreturn));
+extern void unwind(frame_ptr fr, cl_object tag) __attribute__((noreturn));
+extern frame_ptr frs_sch(cl_object frame_id);
+extern frame_ptr frs_sch_catch(cl_object frame_id);
+extern cl_object new_frame_id(void);
+extern void alloc_stacks(int *);
+extern void init_stacks(void);
+
+/* string.c */
+
+extern cl_object alloc_simple_string(cl_index l);
+extern cl_object alloc_adjustable_string(cl_index l);
+extern cl_object make_simple_string(char *s);
+extern cl_object make_string_copy(char *s);
+extern cl_object copy_simple_string(cl_object x);
+extern cl_object coerce_to_string(cl_object x);
+extern cl_object coerce_to_string_designator(cl_object x);
+extern bool string_eq(cl_object x, cl_object y);
+extern bool string_equal(cl_object x, cl_object y);
+extern bool member_char(int c, cl_object char_bag);
+extern void get_string_start_end(cl_object string, cl_object start, cl_object end, cl_index *ps, cl_index *pe);
+extern void init_string(void);
+
+
+/* structure.c */
+
+extern bool structure_subtypep(cl_object x, cl_object y);
+extern cl_object structure_to_list(cl_object x);
+extern cl_object structure_ref(cl_object x, cl_object name, int n);
+extern cl_object structure_set(cl_object x, cl_object name, int n, cl_object v);
+extern void init_structure(void);
+
+
+/* symbol.c */
+
+extern cl_object gensym_prefix;
+extern cl_object gentemp_prefix;
+extern cl_object cl_token;
+extern cl_object make_symbol(cl_object st);
+extern cl_object make_ordinary(const char *s);
+extern cl_object make_special(const char *s, cl_object v);
+extern cl_object make_constant(const char *s, cl_object v);
+extern cl_object make_si_ordinary(const char *s);
+extern cl_object make_si_special(const char *s, cl_object v);
+extern cl_object make_si_constant(const char *s, cl_object v);
+extern cl_object make_keyword(const char *s);
+extern cl_object symbol_value(cl_object s);
+extern cl_object getf(cl_object place, cl_object indicator, cl_object deflt);
+extern cl_object get(cl_object s, cl_object p, cl_object d);
+extern cl_object putf(cl_object p, cl_object v, cl_object i);
+extern cl_object putprop(cl_object s, cl_object v, cl_object p);
+extern bool remf(cl_object *p, cl_object i);
+extern cl_object remprop(cl_object s, cl_object p);
+extern bool keywordp(cl_object s);
+extern cl_object symbol_name(cl_object x);
+extern void init_symbol(void);
+extern void init_symbol_function(void);
+
+
+/* tclBasic.c */
+
+#ifdef TK
+extern cl_object TkWidgetType;
+extern Tcl_Interp *ECL_interp;
+extern int Tcl_GlobalEval(Tcl_Interp *interp, char *s);
+extern int Tcl_Eval(Tcl_Interp *interp, char *s);
+extern int Tcl_VarEval(Tcl_Interp *interp, ...);
+extern char *Tcl_GetVar(Tcl_Interp *interp, char *var, int flags);
+extern char *Tcl_GetVar2(Tcl_Interp *interp, char *name1, char *name2, int flags);
+extern char *Tcl_SetVar(Tcl_Interp *interp, char *var, char *val, int flags);
+extern char *Tcl_SetVar2(Tcl_Interp *interp, char *name1, char *name2, char *val, int flags);
+extern int Tcl_DeleteCommand(Tcl_Interp *interp, char *cmdName);
+extern int tclMethodDispatch(int narg, cl_object env, ...);
+extern void Tcl_CreateCommand(Tcl_Interp *interp, char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc);
+extern int Tcl_GetCommandInfo(Tcl_Interp *interp, char *cmdName, Tcl_CmdInfo *infoPtr);
+extern Tcl_Interp *Tcl_CreateInterp(void);
+extern void Tcl_DeleteInterp(Tcl_Interp *interp);
+extern int init_tk(void);
+extern int Tcl_Init(Tcl_Interp *interp);
+extern void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData);
+extern void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData);
+extern int Tcl_SetCommandInfo(Tcl_Interp *interp, char *cmdName, Tcl_CmdInfo *infoPtr);
+extern Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData);
+extern void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
+extern void Tcl_AddErrorInfo(Tcl_Interp *interp, char *message);
+extern int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
+extern int Tcl_TraceVar(Tcl_Interp *interp, char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData);
+extern int Tcl_TraceVar2(Tcl_Interp *interp, char *part1, char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData);
+extern void Tcl_UntraceVar(Tcl_Interp *interp, char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData);
+extern void Tcl_UntraceVar2(Tcl_Interp *interp, char *part1, char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData);
+extern void Tcl_ChangeValue(char *var);
+#endif
+
+
+/* tcp.c */
+
+#ifdef TCP
+extern cl_object make_stream(cl_object host, int fd, enum smmode smm);
+extern int init_tcp(void);
+#endif
+
+
+/* time.c */
+
+extern int runtime(void);
+extern cl_object UTC_time_to_universal_time(int i);
+extern void init_unixtime(void);
+
+
+/* tkMain.c */
+
+#ifdef TK
+extern Tcl_Interp *ECL_interp;
+extern int Tk_initialized;
+extern cl_object Tk_root_window;
+extern void Tk_main(int synchronize, char *name, char *fileName, char *Xdisplay, char *geometry);
+#endif
+
+
+/* toplevel.c */
+
+extern void init_toplevel(void);
+
+
+/* typespec.c */
+
+extern void assert_type_integer(cl_object p);
+extern void assert_type_non_negative_integer(cl_object p);
+extern void assert_type_character(cl_object p);
+extern void assert_type_symbol(cl_object p);
+extern void assert_type_package(cl_object p);
+extern void assert_type_string(cl_object p);
+extern void assert_type_cons(cl_object p);
+extern void assert_type_stream(cl_object p);
+extern void assert_type_readtable(cl_object p);
+extern void assert_type_hash_table(cl_object p);
+extern void assert_type_array(cl_object p);
+extern void assert_type_vector(cl_object p);
+extern void assert_type_list(cl_object p);
+extern void assert_type_proper_list(cl_object p);
+extern cl_object TYPE_OF(cl_object x);
+extern void init_typespec(void);
+extern void init_typespec_function(void);
+
+extern void FEtype_error_character(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_cons(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_number(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_real(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_float(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_integer(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_list(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_proper_list(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_plist(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_alist(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_stream(cl_object x) __attribute__((noreturn));
+extern void FEcircular_list(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_index(cl_object x) __attribute__((noreturn));
+extern void FEtype_error_string(cl_object x) __attribute__((noreturn));
+
+/* unify.c */
+
+#ifdef LOCATIVE
+extern cl_object *slot;
+extern cl_object (*slotf)();
+extern cl_object *trail[];
+extern cl_object **trail_top;
+extern bool get_slot(cl_object x);
+extern bool set_slot(cl_object x);
+extern bool get_cons(cl_object x);
+extern bool get_instance(cl_object x, cl_object class, int arity);
+extern bool unify(cl_object x, cl_object y);
+extern int init_unify(void);
+#endif
+
+
+/* unixfsys.c */
+
+extern const char *expand_pathname(const char *name);
+extern cl_object string_to_pathname(char *s);
+extern cl_object truename(cl_object pathname);
+extern bool file_exists(cl_object file);
+extern FILE *backup_fopen(char *filename, char *option);
+extern int file_len(FILE *fp);
+extern cl_object homedir_pathname(cl_object user);
+extern void init_unixfsys(void);
+
+
+/* unixint.c */
+
+extern int interrupt_enable;
+extern int interrupt_flag;
+extern void sigalrm(void);
+extern void sigint(void);
+extern void sigfpe(void);
+extern void signal_catcher(int sig, int code, int scp);
+extern void enable_interrupt(void);
+extern void init_interrupt(void);
+
+
+/* unixsys.c */
+
+extern void init_unixsys(void);
+
+
+/* dld.c */
+
+extern dld(char *faslfile, void **block_start, int *block_size);
+
+/* unexec.c */
+
+extern int unexec(char *new_name, char *a_name, unsigned, unsigned, unsigned);
+
+
diff --git a/src/h/include.h b/src/h/include.h
new file mode 100644
index 000000000..d0b519872
--- /dev/null
+++ b/src/h/include.h
@@ -0,0 +1,67 @@
+/*
+    include.h -- List of included files.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#ifdef __GNUC__
+#define VOID void
+#else
+#define VOID char
+#endif
+
+#include <stdio.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <setjmp.h>
+#include <limits.h>
+#include <ctype.h>
+#include <signal.h>
+#include <string.h>		/* for FreeBSD */
+#include <sys/param.h>		/* includes <sys/signal.h> and <sys/types.h> */
+#include <sys/types.h>		/* for EMX */
+
+#include "machines.h"
+
+#ifdef BSD
+# include <sys/time.h>
+#endif BSD
+
+#ifdef SYSV
+
+# ifndef MAXPATHLEN
+#  define MAXPATHLEN	PATH_MAX
+# endif MAXPATHLEN
+
+#endif SYSV
+
+#include "../gmp/gmp.h"
+#include "object.h"
+
+#include "vs.h"
+#include "bds.h"
+#include "frame.h"
+
+#ifdef THREADS
+# include "critical.h"
+# include "lwp.h"
+#endif THREADS
+
+#include "external.h"
+#include "lisp_external.h"
+#include "lex.h"
+#include "eval.h"
+#include "cs.h"
+#include "number.h"
+
+/**********************************************************************/
diff --git a/src/h/lisp_external.h b/src/h/lisp_external.h
new file mode 100644
index 000000000..627f83d6f
--- /dev/null
+++ b/src/h/lisp_external.h
@@ -0,0 +1,1058 @@
+
+#ifndef _ARGS
+#define _ARGS(x) (int n, ...)
+#endif
+
+/* alloc.c */
+
+#if !defined(GBC_BOEHM)
+extern cl_object siLallocate _ARGS((int narg, cl_object type, cl_object qty, ...));
+extern cl_object siLmaxpage _ARGS((int narg, cl_object type));
+extern cl_object siLallocated_pages _ARGS((int narg, cl_object type));
+extern cl_object siLalloc_contpage _ARGS((int narg, cl_object qty, ...));
+extern cl_object siLncbpage _ARGS((int narg));
+extern cl_object siLmaxcbpage _ARGS((int narg));
+extern cl_object siLalloc_relpage _ARGS((int narg, cl_object qty, cl_object now));
+extern cl_object siLnrbpage _ARGS((int narg));
+extern cl_object siLget_hole_size _ARGS((int narg));
+extern cl_object siLset_hole_size _ARGS((int narg, cl_object size));
+extern cl_object siLignore_maximum_pages _ARGS((int narg, ...));
+#endif
+
+/* alloc_2.c */
+
+#ifdef GBC_BOEHM
+extern cl_object siVgc_verbose;
+extern cl_object siVgc_message;
+extern cl_object Lgc _ARGS((int narg, cl_object area));
+extern cl_object siLroom_report _ARGS((int narg));
+#endif /* GBC_BOEHM */
+
+/* array.c */
+
+extern cl_object Laref _ARGS((int narg, cl_object x, ...));
+extern cl_object siLaset _ARGS((int narg, cl_object v, cl_object x, ...));
+extern cl_object siLmake_pure_array _ARGS((int narg, cl_object etype, cl_object adj, cl_object displ, cl_object disploff, ...));
+extern cl_object siLmake_vector _ARGS((int narg, cl_object etype, cl_object dim, cl_object adj, cl_object fillp, cl_object displ, cl_object disploff));
+extern cl_object Larray_element_type _ARGS((int narg, cl_object a));
+extern cl_object Larray_rank _ARGS((int narg, cl_object a));
+extern cl_object Larray_dimension _ARGS((int narg, cl_object a, cl_object index));
+extern cl_object Larray_total_size _ARGS((int narg, cl_object a));
+extern cl_object Ladjustable_array_p _ARGS((int narg, cl_object a));
+extern cl_object siLdisplaced_array_p _ARGS((int narg, cl_object a));
+extern cl_object Lsvref _ARGS((int narg, cl_object x, cl_object index));
+extern cl_object siLsvset _ARGS((int narg, cl_object x, cl_object index, cl_object v));
+extern cl_object Larray_has_fill_pointer_p _ARGS((int narg, cl_object a));
+extern cl_object Lfill_pointer _ARGS((int narg, cl_object a));
+extern cl_object siLfill_pointer_set _ARGS((int narg, cl_object a, cl_object fp));
+extern cl_object siLreplace_array _ARGS((int narg, cl_object old, cl_object new));
+
+/* assignment.c */
+
+extern cl_object Ssetf, Spsetf, siSsetf_symbol;
+extern cl_object siSclear_compiler_properties;
+#ifdef PDE
+extern cl_object siVrecord_source_pathname_p;
+extern cl_object siSrecord_source_pathname;
+#endif
+extern cl_object Lset _ARGS((int narg, cl_object var, cl_object val));
+extern cl_object siLsetf_namep _ARGS((int narg, cl_object arg));
+extern cl_object siLfset _ARGS((int narg, cl_object fun, cl_object def, ...));
+extern cl_object Lmakunbound _ARGS((int narg, cl_object sym));
+extern cl_object Lfmakunbound _ARGS((int narg, cl_object sym));
+extern cl_object siLclear_compiler_properties _ARGS((int narg, cl_object sym));
+
+/* backq.c */
+
+extern cl_object siScomma;
+extern cl_object siScomma_at;
+extern cl_object siScomma_dot;
+extern cl_object SlistX;
+extern cl_object Sappend;
+extern cl_object Snconc;
+extern cl_object Lcomma_reader _ARGS((int narg, cl_object in, cl_object c));
+extern cl_object Lbackquote_reader _ARGS((int narg, cl_object in, cl_object c));
+
+/* cfun.c */
+
+extern cl_object siLcompiled_function_name _ARGS((int narg, cl_object fun));
+extern cl_object siLcompiled_function_block _ARGS((int narg, cl_object fun));
+
+/* character.c */
+
+extern cl_object STreturn;
+extern cl_object STspace;
+extern cl_object STrubout;
+extern cl_object STpage;
+extern cl_object STtab;
+extern cl_object STbackspace;
+extern cl_object STlinefeed;
+extern cl_object STnewline;
+extern cl_object STnull;
+extern cl_object Lstandard_char_p _ARGS((int narg, cl_object c));
+extern cl_object Lgraphic_char_p _ARGS((int narg, cl_object c));
+extern cl_object Lalpha_char_p _ARGS((int narg, cl_object c));
+extern cl_object Lupper_case_p _ARGS((int narg, cl_object c));
+extern cl_object Llower_case_p _ARGS((int narg, cl_object c));
+extern cl_object Lboth_case_p _ARGS((int narg, cl_object c));
+extern cl_object Ldigit_char_p _ARGS((int narg, cl_object c, ...));
+extern cl_object Lalphanumericp _ARGS((int narg, cl_object c));
+extern cl_object Lchar_eq _ARGS((int narg, cl_object c, ...));
+extern cl_object Lchar_neq _ARGS((int narg, ...));
+extern cl_object Lchar_l _ARGS((int narg, ...));
+extern cl_object Lchar_g _ARGS((int narg, ...));
+extern cl_object Lchar_le _ARGS((int narg, ...));
+extern cl_object Lchar_ge _ARGS((int narg, ...));
+extern cl_object Lchar_equal _ARGS((int narg, cl_object c, ...));
+extern cl_object Lchar_not_equal _ARGS((int narg, ...));
+extern cl_object Lchar_lessp _ARGS((int narg, ...));
+extern cl_object Lchar_greaterp _ARGS((int narg, ...));
+extern cl_object Lchar_not_greaterp _ARGS((int narg, ...));
+extern cl_object Lchar_not_lessp _ARGS((int narg, ...));
+extern cl_object Lcharacter _ARGS((int narg, cl_object x));
+extern cl_object Lchar_code _ARGS((int narg, cl_object c));
+extern cl_object Lcode_char _ARGS((int narg, cl_object c));
+extern cl_object Lchar_upcase _ARGS((int narg, cl_object c));
+extern cl_object Lchar_downcase _ARGS((int narg, cl_object c));
+extern cl_object Ldigit_char _ARGS((int narg, cl_object w, ...));
+extern cl_object Lchar_int _ARGS((int narg, cl_object c));
+extern cl_object Lint_char _ARGS((int narg, cl_object x));
+extern cl_object Lchar_name _ARGS((int narg, cl_object c));
+extern cl_object Lname_char _ARGS((int narg, cl_object s));
+
+/* clos.c */
+
+#ifdef CLOS
+extern cl_object siSXclass_name_hash_tableX;
+extern cl_object Sclass;
+extern cl_object Sbuilt_in;
+#endif
+
+/* cmpaux.c */
+
+extern cl_object SAoptional;
+extern cl_object SArest;
+extern cl_object SAkey;
+extern cl_object SAallow_other_keys;
+extern cl_object SAaux;
+extern cl_object Kallow_other_keys;
+extern cl_object siLspecialp _ARGS((int narg, cl_object sym));
+
+/* compiler.c */
+
+extern cl_object siSlambda_block;
+extern cl_object Sdeclare;
+extern cl_object Scompile;
+extern cl_object Sload;
+extern cl_object Seval;
+extern cl_object Sprogn;
+extern cl_object Swarn;
+extern cl_object Stypep;
+extern cl_object Kexecute;
+extern cl_object Kcompile_toplevel;
+extern cl_object Kload_toplevel;
+extern cl_object Sotherwise;
+extern cl_object siLprocess_declarations _ARGS((int narg, cl_object body, ...));
+extern cl_object siLprocess_lambda_list _ARGS((int narg, cl_object lambda));
+extern cl_object siLmake_lambda _ARGS((int narg, cl_object name, cl_object body));
+
+/* disassembler.c */
+
+extern cl_object siLbc_disassemble _ARGS((int narg, cl_object v));
+extern cl_object siLbc_split _ARGS((int narg, cl_object v));
+
+/* error.c */
+
+extern cl_object Sarithmetic_error, Scell_error, Scondition;
+extern cl_object Scontrol_error, Sdivision_by_zero, Send_of_file;
+extern cl_object Serror, Sfile_error, Sfloating_point_inexact;
+extern cl_object Sfloating_point_invalid_operation, Sfloating_point_overflow;
+extern cl_object Sfloating_point_underflow, Spackage_error, Sparse_error;
+extern cl_object Sprint_not_readable, Sprogram_error, Sreader_error;
+extern cl_object Sserious_condition, Ssimple_condition, Ssimple_error;
+extern cl_object Ssimple_type_error, Ssimple_warning, Sstorage_condition;
+extern cl_object Sstream_error, Sstyle_warning, Stype_error, Sunbound_slot;
+extern cl_object Sunbound_variable, Sundefined_function, Swarning;
+
+extern cl_object siSsimple_program_error, siSsimple_control_error;
+
+extern cl_object Kdatum, Kexpected_type;
+extern cl_object Kpathname;
+extern cl_object Kformat_control, Kformat_arguments;
+
+extern cl_object siSuniversal_error_handler;
+extern cl_object siSterminal_interrupt;
+extern cl_object siLuniversal_error_handler _ARGS((int narg, cl_object c, cl_object d, cl_object args));
+#if defined(FRAME_CHAIN) && !defined(RUNTIME)
+extern cl_object siLbacktrace _ARGS((int narg));
+#endif
+extern cl_object Lerror _ARGS((int narg, cl_object eformat, ...));
+extern cl_object Lcerror _ARGS((int narg, cl_object cformat, cl_object eformat, ...));
+
+/* eval.c */
+
+extern cl_object Sapply;
+extern cl_object Sfuncall;
+extern cl_object Vevalhook;
+extern cl_object Vapplyhook;
+extern cl_object siLunlink_symbol _ARGS((int narg, cl_object s));
+extern cl_object Lfuncall _ARGS((int narg, cl_object fun, ...));
+extern cl_object Lapply _ARGS((int narg, cl_object fun, cl_object arg, ...));
+extern cl_object Leval _ARGS((int narg, cl_object form));
+extern cl_object Levalhook _ARGS((int n, cl_object form, cl_object evalhookfn, cl_object applyhookfn, ...));
+extern cl_object Lapplyhook _ARGS((int narg, cl_object fun, cl_object args, cl_object evalhookfn, cl_object applyhookfn));
+extern cl_object Lconstantp _ARGS((int narg, cl_object arg));
+
+/* file.c */
+
+extern cl_object Kerror;
+extern cl_object Vstandard_input;
+extern cl_object Vstandard_output;
+extern cl_object Verror_output;
+extern cl_object Vquery_io;
+extern cl_object Vdebug_io;
+extern cl_object Vterminal_io;
+extern cl_object Vtrace_output;
+extern cl_object Kabort;
+extern cl_object Kdirection;
+extern cl_object Kinput;
+extern cl_object Koutput;
+extern cl_object Kio;
+extern cl_object Kprobe;
+extern cl_object Kelement_type;
+extern cl_object Kdefault;
+extern cl_object Kif_exists;
+extern cl_object Knew_version;
+extern cl_object Krename;
+extern cl_object Krename_and_delete;
+extern cl_object Koverwrite;
+extern cl_object Kappend;
+extern cl_object Ksupersede;
+extern cl_object Kcreate;
+extern cl_object Kprint;
+extern cl_object Kif_does_not_exist;
+extern cl_object Kset_default_pathname;
+extern cl_object siVignore_eof_on_terminal_io;
+extern cl_object Lmake_synonym_stream _ARGS((int narg, cl_object sym));
+extern cl_object Lmake_broadcast_stream _ARGS((int narg, ...));
+extern cl_object Lmake_concatenated_stream _ARGS((int narg, ...));
+extern cl_object Lmake_two_way_stream _ARGS((int narg, cl_object strm1, cl_object strm2));
+extern cl_object Lmake_echo_stream _ARGS((int narg, cl_object strm1, cl_object strm2));
+extern cl_object Lmake_string_input_stream _ARGS((int narg, cl_object strng, ...));
+extern cl_object Lmake_string_output_stream _ARGS((int narg));
+extern cl_object Lget_output_stream_string _ARGS((int narg, cl_object strm));
+extern cl_object siLoutput_stream_string _ARGS((int narg, cl_object strm));
+extern cl_object Lstreamp _ARGS((int narg, cl_object strm));
+extern cl_object Linput_stream_p _ARGS((int narg, cl_object strm));
+extern cl_object Loutput_stream_p _ARGS((int narg, cl_object strm));
+extern cl_object Lstream_element_type _ARGS((int narg, cl_object strm));
+extern cl_object Lclose _ARGS((int narg, cl_object strm, ...));
+extern cl_object Lopen _ARGS((int narg, cl_object filename, ...));
+extern cl_object Lfile_position _ARGS((int narg, cl_object file_stream, ...));
+extern cl_object Lfile_length _ARGS((int narg, cl_object strm));
+extern cl_object siLget_string_input_stream_index _ARGS((int narg, cl_object strm));
+extern cl_object siLmake_string_output_stream_from_string _ARGS((int narg, cl_object strng));
+extern cl_object siLcopy_stream _ARGS((int narg, cl_object in, cl_object out));
+extern cl_object Lopen_stream_p _ARGS((int narg, cl_object strm));
+
+/* format.c */
+
+extern cl_object siVindent_formatted_output;
+extern cl_object Lformat _ARGS((int narg, volatile cl_object strm, cl_object string, ...));
+
+/* gbc.c */
+
+#if !defined(GBC_BOEHM)
+extern cl_object siVgc_verbose;
+extern cl_object siVgc_message;
+extern cl_object Lgc _ARGS((int narg, cl_object area));
+extern cl_object siLroom_report _ARGS((int narg));
+extern cl_object siLreset_gc_count _ARGS((int narg));
+extern cl_object siLgc_time _ARGS((int narg));
+#endif /* !GBC_BOHEM */
+
+/* gfun.c */
+
+extern cl_object siScompute_applicable_methods;
+extern cl_object siScompute_effective_method;
+extern cl_object siSgeneric_function_method_combination;
+extern cl_object siSgeneric_function_method_combination_args;
+extern cl_object siLallocate_gfun _ARGS((int narg, cl_object name, cl_object arg_no, cl_object ht));
+extern cl_object siLgfun_name _ARGS((int narg, cl_object x));
+extern cl_object siLgfun_name_set _ARGS((int narg, cl_object x, cl_object name));
+extern cl_object siLgfun_method_ht _ARGS((int narg, cl_object x));
+extern cl_object siLgfun_method_ht_set _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object siLgfun_spec_how_ref _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object siLgfun_spec_how_set _ARGS((int narg, cl_object x, cl_object y, cl_object spec));
+extern cl_object siLgfun_instance _ARGS((int narg, cl_object x));
+extern cl_object siLgfun_instance_set _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object siLgfunp _ARGS((int narg, cl_object x));
+extern cl_object siLmethod_ht_get _ARGS((int narg, cl_object keylist, cl_object table));
+extern cl_object siLset_compiled_function_name _ARGS((int narg, cl_object keylist, cl_object table));
+
+/* hash.c */
+
+extern cl_object Seq;
+extern cl_object Seql;
+extern cl_object Sequal;
+extern cl_object Ksize;
+extern cl_object Krehash_size;
+extern cl_object Krehash_threshold;
+extern cl_object Lmake_hash_table _ARGS((int narg, ...));
+extern cl_object Lhash_table_p _ARGS((int narg, cl_object ht));
+extern cl_object Lgethash _ARGS((int narg, cl_object key, cl_object ht, ...));
+extern cl_object siLhash_set _ARGS((int narg, cl_object key, cl_object ht, cl_object val));
+extern cl_object Lremhash _ARGS((int narg, cl_object key, cl_object ht));
+extern cl_object Lclrhash _ARGS((int narg, cl_object ht));
+extern cl_object Lhash_table_count _ARGS((int narg, cl_object ht));
+extern cl_object Lsxhash _ARGS((int narg, cl_object key));
+extern cl_object Lmaphash _ARGS((int narg, cl_object fun, cl_object ht));
+extern cl_object Lhash_table_rehash_size _ARGS((int narg, cl_object ht));
+extern cl_object Lhash_table_rehash_threshold _ARGS((int narg, cl_object ht));
+
+/* instance.c */
+
+#ifdef CLOS
+extern cl_object Sprint_object;
+extern cl_object siLallocate_instance _ARGS((int narg, cl_object class, cl_object size));
+extern cl_object siLchange_instance _ARGS((int narg, cl_object x, cl_object class, cl_object size, cl_object corr));
+extern cl_object siLinstance_class _ARGS((int narg, cl_object x));
+extern cl_object siLinstance_class_set _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object siLinstance_ref _ARGS((int narg, cl_object x, cl_object index));
+extern cl_object siLinstance_ref_safe _ARGS((int narg, cl_object x, cl_object index));
+extern cl_object siLinstance_set _ARGS((int narg, cl_object x, cl_object index, cl_object value));
+extern cl_object siLinstancep _ARGS((int narg, cl_object x));
+extern cl_object siLsl_boundp _ARGS((int narg, cl_object x));
+extern cl_object siLsl_makunbound _ARGS((int narg, cl_object x, cl_object index));
+#endif
+
+/* interpreter.c */
+
+extern cl_object siLinterpreter_stack _ARGS((int narg));
+
+/* lex.c */
+
+extern cl_object Sblock;
+extern cl_object Smacro;
+extern cl_object siSsymbol_macro;
+extern cl_object Stag;
+extern cl_object siLlex_env _ARGS((int narg));
+
+/* list.c */
+
+extern cl_object Ktest;
+extern cl_object Ktest_not;
+extern cl_object Kkey;
+extern cl_object Kinitial_element;
+extern cl_object Lcar _ARGS((int narg, cl_object x));
+extern cl_object Lcdr _ARGS((int narg, cl_object x));
+extern cl_object Llist _ARGS((int narg, ...));
+extern cl_object LlistA _ARGS((int narg, ...));
+extern cl_object Lappend _ARGS((int narg, ...));
+extern cl_object Lcaar _ARGS((int narg, cl_object x));
+extern cl_object Lcadr _ARGS((int narg, cl_object x));
+extern cl_object Lcdar _ARGS((int narg, cl_object x));
+extern cl_object Lcddr _ARGS((int narg, cl_object x));
+extern cl_object Lcaaar _ARGS((int narg, cl_object x));
+extern cl_object Lcaadr _ARGS((int narg, cl_object x));
+extern cl_object Lcadar _ARGS((int narg, cl_object x));
+extern cl_object Lcaddr _ARGS((int narg, cl_object x));
+extern cl_object Lcdaar _ARGS((int narg, cl_object x));
+extern cl_object Lcdadr _ARGS((int narg, cl_object x));
+extern cl_object Lcddar _ARGS((int narg, cl_object x));
+extern cl_object Lcdddr _ARGS((int narg, cl_object x));
+extern cl_object Lcaaaar _ARGS((int narg, cl_object x));
+extern cl_object Lcaaadr _ARGS((int narg, cl_object x));
+extern cl_object Lcaadar _ARGS((int narg, cl_object x));
+extern cl_object Lcaaddr _ARGS((int narg, cl_object x));
+extern cl_object Lcadaar _ARGS((int narg, cl_object x));
+extern cl_object Lcadadr _ARGS((int narg, cl_object x));
+extern cl_object Lcaddar _ARGS((int narg, cl_object x));
+extern cl_object Lcadddr _ARGS((int narg, cl_object x));
+extern cl_object Lcdaaar _ARGS((int narg, cl_object x));
+extern cl_object Lcdaadr _ARGS((int narg, cl_object x));
+extern cl_object Lcdadar _ARGS((int narg, cl_object x));
+extern cl_object Lcdaddr _ARGS((int narg, cl_object x));
+extern cl_object Lcddaar _ARGS((int narg, cl_object x));
+extern cl_object Lcddadr _ARGS((int narg, cl_object x));
+extern cl_object Lcdddar _ARGS((int narg, cl_object x));
+extern cl_object Lcddddr _ARGS((int narg, cl_object x));
+extern cl_object Lfifth _ARGS((int narg, cl_object x));
+extern cl_object Lsixth _ARGS((int narg, cl_object x));
+extern cl_object Lseventh _ARGS((int narg, cl_object x));
+extern cl_object Leighth _ARGS((int narg, cl_object x));
+extern cl_object Lninth _ARGS((int narg, cl_object x));
+extern cl_object Ltenth _ARGS((int narg, cl_object x));
+extern cl_object Lcons _ARGS((int narg, cl_object car, cl_object cdr));
+extern cl_object Ltree_equal _ARGS((int narg, cl_object x, cl_object y, ...));
+extern cl_object Lendp _ARGS((int narg, cl_object x));
+extern cl_object Llist_length _ARGS((int narg, cl_object x));
+extern cl_object Lnth _ARGS((int narg, cl_object n, cl_object x));
+extern cl_object Lnthcdr _ARGS((int narg, cl_object n, cl_object x));
+extern cl_object Llast _ARGS((int narg, cl_object x, ...));
+extern cl_object Lmake_list _ARGS((int narg, cl_object size, ...));
+extern cl_object Lcopy_list _ARGS((int narg, cl_object x));
+extern cl_object Lcopy_alist _ARGS((int narg, cl_object x));
+extern cl_object Lcopy_tree _ARGS((int narg, cl_object x));
+extern cl_object Lrevappend _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Lnconc _ARGS((int narg, ...));
+extern cl_object Lreconc _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Lbutlast _ARGS((int narg, cl_object lis, ...));
+extern cl_object Lnbutlast _ARGS((int narg, cl_object lis, ...));
+extern cl_object Lldiff _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Lrplaca _ARGS((int narg, cl_object x, cl_object v));
+extern cl_object Lrplacd _ARGS((int narg, cl_object x, cl_object v));
+extern cl_object Lsubst _ARGS((int narg, cl_object new, cl_object old, cl_object tree, ...));
+extern cl_object Lsubst_if _ARGS((int narg, cl_object arg1, cl_object pred, cl_object arg3, cl_object key, cl_object val));
+extern cl_object Lsubst_if_not _ARGS((int narg, cl_object arg1, cl_object pred, cl_object arg3, cl_object key, cl_object val));
+extern cl_object Lnsubst _ARGS((int narg, cl_object new, cl_object old, cl_object tree, ...));
+extern cl_object Lnsubst_if _ARGS((int narg, cl_object arg1, cl_object pred, cl_object arg3, cl_object key, cl_object val));
+extern cl_object Lnsubst_if_not _ARGS((int narg, cl_object arg1, cl_object pred, cl_object arg3, cl_object key, cl_object val));
+extern cl_object Lsublis _ARGS((int narg, cl_object alist, cl_object tree, ...));
+extern cl_object Lnsublis _ARGS((int narg, cl_object alist, cl_object tree, ...));
+extern cl_object Lmember _ARGS((int narg, cl_object item, cl_object list, ...));
+extern cl_object siLmemq _ARGS((int narg, cl_object x, cl_object l));
+extern cl_object Lmember_if _ARGS((int narg, cl_object pred, cl_object arg, cl_object key, cl_object val));
+extern cl_object Lmember_if_not _ARGS((int narg, cl_object pred, cl_object arg, cl_object key, cl_object val));
+extern cl_object Lmember1 _ARGS((int narg, cl_object item, cl_object list, ...));
+extern cl_object Ltailp _ARGS((int narg, cl_object y, cl_object x));
+extern cl_object Ladjoin _ARGS((int narg, cl_object item, cl_object list, cl_object k1, cl_object v1, cl_object k2, cl_object v2, cl_object k3, cl_object v3));
+extern cl_object Lacons _ARGS((int narg, cl_object x, cl_object y, cl_object z));
+extern cl_object Lpairlis _ARGS((int narg, cl_object keys, cl_object data, ...));
+extern cl_object Lassoc_or_rassoc(int narg, cl_object (*car_or_cdr)(), cl_object item, cl_object a_list, ...);
+extern cl_object Lrassoc _ARGS((int narg, cl_object item, cl_object alist, cl_object k1, cl_object v1, cl_object k2, cl_object v2));
+extern cl_object Lassoc _ARGS((int narg, cl_object item, cl_object alist, cl_object k1, cl_object v1, cl_object k2, cl_object v2));
+extern cl_object Lassoc_if _ARGS((int narg, cl_object pred, cl_object arg, cl_object key, cl_object val));
+extern cl_object Lassoc_if_not _ARGS((int narg, cl_object pred, cl_object arg, cl_object key, cl_object val));
+extern cl_object Lrassoc_if _ARGS((int narg, cl_object pred, cl_object arg, cl_object key, cl_object val));
+extern cl_object Lrassoc_if_not _ARGS((int narg, cl_object pred, cl_object arg, cl_object key, cl_object val));
+
+/* load.c */
+
+extern cl_object Kverbose;
+extern cl_object Vload_verbose, Vload_print;
+extern cl_object siVsymbol_table;
+extern cl_object siVload_hooks;
+extern cl_object Lload _ARGS((int narg, cl_object pathname, ...));
+extern cl_object siLload_source _ARGS((int narg, cl_object file, cl_object verbose,
+				       cl_object print));
+extern cl_object siLload_binary _ARGS((int narg, cl_object file, cl_object verbose,
+				       cl_object print));
+extern cl_object siLfaslink _ARGS((int narg, cl_object file, cl_object lib));
+
+/* lwp.c */
+
+#ifdef THREADS
+extern cl_object Srunning;
+extern cl_object Ssuspended;
+extern cl_object Swaiting;
+extern cl_object Sstopped;
+extern cl_object Sdead;
+extern cl_object siSthread_top_level;
+extern cl_object siLthread_break_in _ARGS((int narg));
+extern cl_object siLthread_break_quit _ARGS((int narg));
+extern cl_object siLthread_break_resume _ARGS((int narg));
+extern cl_object Lthread_list _ARGS((int narg));
+extern cl_object Lmake_thread _ARGS((int narg, cl_object fun));
+extern cl_object Ldeactivate _ARGS((int narg, cl_object thread));
+extern cl_object Lreactivate _ARGS((int narg, cl_object thread));
+extern cl_object Lkill_thread _ARGS((int narg, cl_object thread));
+extern cl_object Lcurrent_thread _ARGS((int narg));
+extern cl_object Lthread_status _ARGS((int narg, cl_object thread));
+extern cl_object Lmake_continuation _ARGS((int narg, cl_object thread));
+extern cl_object Lthread_of _ARGS((int narg, cl_object cont));
+extern cl_object Lcontinuation_of _ARGS((int narg, cl_object thread));
+extern cl_object Lresume _ARGS((int narg, cl_object cont, ...));
+extern cl_object Ldisable_scheduler _ARGS((int narg));
+extern cl_object Lenable_scheduler _ARGS((int narg));
+extern cl_object Lsuspend _ARGS((int narg));
+extern cl_object Ldelay _ARGS((int narg, cl_object interval));
+extern cl_object Lthread_wait _ARGS((int narg, cl_object fun, ...));
+extern cl_object Lthread_wait_with_timeout _ARGS((int narg, cl_object timeout, cl_object fun, ...));
+#endif
+
+/* macros.c */
+
+extern cl_object Vmacroexpand_hook;
+extern cl_object siSexpand_defmacro;
+extern cl_object siVinhibit_macro_special;
+extern cl_object Lmacroexpand _ARGS((int narg, cl_object form, ...));
+extern cl_object Lmacroexpand_1 _ARGS((int narg, cl_object form, ...));
+
+/* main.c */
+
+extern cl_object Vfeatures;
+extern cl_object siVsystem_directory;
+extern cl_object Lquit _ARGS((int narg, ...));
+extern cl_object siLargc _ARGS((int narg));
+extern cl_object siLargv _ARGS((int narg, cl_object index));
+extern cl_object siLgetenv _ARGS((int narg, cl_object var));
+extern cl_object siLaddress _ARGS((int narg, cl_object x));
+extern cl_object siLnani _ARGS((int narg, cl_object x));
+extern cl_object Lidentity _ARGS((int narg, cl_object x));
+extern cl_object Lmachine_instance _ARGS((int narg));
+extern cl_object Lmachine_version _ARGS((int narg));
+extern cl_object Lsoftware_type _ARGS((int narg));
+extern cl_object Lsoftware_version _ARGS((int narg));
+
+/* mapfun.c */
+
+extern cl_object Lmapcar _ARGS((int narg, cl_object fun, cl_object onelist, ...));
+extern cl_object Lmaplist _ARGS((int narg, cl_object fun, cl_object onelist, ...));
+extern cl_object Lmapc _ARGS((int narg, cl_object fun, cl_object onelist, ...));
+extern cl_object Lmapl _ARGS((int narg, cl_object fun, cl_object onelist, ...));
+extern cl_object Lmapcan _ARGS((int narg, cl_object fun, cl_object onelist, ...));
+extern cl_object Lmapcon _ARGS((int narg, cl_object fun, cl_object onelist, ...));
+
+/* multival.c */
+
+extern cl_object Lvalues _ARGS((int narg, ...));
+extern cl_object Lvalues_list _ARGS((int narg, cl_object list));
+
+/* num_arith.c */
+
+extern cl_object Ltimes _ARGS((int narg, ...));
+extern cl_object Lplus _ARGS((int narg, ...));
+extern cl_object Lminus _ARGS((int narg, cl_object num, ...));
+extern cl_object Lconjugate _ARGS((int narg, cl_object c));
+extern cl_object Ldivide _ARGS((int narg, cl_object num, ...));
+extern cl_object Lgcd _ARGS((int narg, ...));
+extern cl_object Lone_plus _ARGS((int narg, cl_object x));
+extern cl_object Lone_minus _ARGS((int narg, cl_object x));
+extern cl_object Llcm _ARGS((int narg, cl_object lcm, ...));
+
+/* num_co.c */
+
+extern cl_object Lfloat _ARGS((int narg, cl_object x, ...));
+extern cl_object Lnumerator _ARGS((int narg, cl_object x));
+extern cl_object Ldenominator _ARGS((int narg, cl_object x));
+extern cl_object Lfloor _ARGS((int narg, cl_object x, ...));
+extern cl_object Lceiling _ARGS((int narg, cl_object x, ...));
+extern cl_object Ltruncate _ARGS((int narg, cl_object x, ...));
+extern cl_object Lround _ARGS((int narg, cl_object x, ...));
+extern cl_object Lmod _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Lrem _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Ldecode_float _ARGS((int narg, cl_object x));
+extern cl_object Lscale_float _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Lfloat_radix _ARGS((int narg, cl_object x));
+extern cl_object Lfloat_sign _ARGS((int narg, cl_object x, ...));
+extern cl_object Lfloat_digits _ARGS((int narg, cl_object x));
+extern cl_object Lfloat_precision _ARGS((int narg, cl_object x));
+extern cl_object Linteger_decode_float _ARGS((int narg, cl_object x));
+extern cl_object Lcomplex _ARGS((int narg, cl_object r, ...));
+extern cl_object Lrealpart _ARGS((int narg, cl_object x));
+extern cl_object Limagpart _ARGS((int narg, cl_object x));
+
+/* num_comp.c */
+
+extern cl_object Lall_the_same _ARGS((int narg, cl_object num, ...));
+extern cl_object Lall_different _ARGS((int narg, ...));
+extern cl_object Lmonotonically_nondecreasing _ARGS((int narg, ...));
+extern cl_object Lmonotonically_nonincreasing _ARGS((int narg, ...));
+extern cl_object Lmonotonically_increasing _ARGS((int narg, ...));
+extern cl_object Lmonotonically_decreasing _ARGS((int narg, ...));
+extern cl_object Lmax _ARGS((int narg, cl_object max, ...));
+extern cl_object Lmin _ARGS((int narg, cl_object min, ...));
+
+/* num_log.c */
+
+extern cl_object Llogior _ARGS((int narg, ...));
+extern cl_object Llogxor _ARGS((int narg, ...));
+extern cl_object Llogand _ARGS((int narg, ...));
+extern cl_object Llogeqv _ARGS((int narg, ...));
+extern cl_object Lboole _ARGS((int narg, cl_object o, ...));
+extern cl_object Llogbitp _ARGS((int narg, cl_object p, cl_object x));
+extern cl_object Lash _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Llogcount _ARGS((int narg, cl_object x));
+extern cl_object Linteger_length _ARGS((int narg, cl_object x));
+extern cl_object siLbit_array_op _ARGS((int narg, cl_object o, cl_object x, cl_object y, cl_object r));
+
+/* num_pred.c */
+
+extern cl_object Lzerop _ARGS((int narg, cl_object x));
+extern cl_object Lplusp _ARGS((int narg, cl_object x));
+extern cl_object Lminusp _ARGS((int narg, cl_object x));
+extern cl_object Loddp _ARGS((int narg, cl_object x));
+extern cl_object Levenp _ARGS((int narg, cl_object x));
+
+/* num_rand.c */
+
+extern cl_object Vrandom_state;
+extern cl_object Lrandom _ARGS((int narg, cl_object x, ...));
+extern cl_object Lmake_random_state _ARGS((int narg, ...));
+extern cl_object Lrandom_state_p _ARGS((int narg, cl_object x));
+
+/* num_sfun.c */
+
+extern cl_object Lexp _ARGS((int narg, cl_object x));
+extern cl_object Lexpt _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Llog _ARGS((int narg, cl_object x, ...));
+extern cl_object Lsqrt _ARGS((int narg, cl_object x));
+extern cl_object Lsin _ARGS((int narg, cl_object x));
+extern cl_object Lcos _ARGS((int narg, cl_object x));
+extern cl_object Ltan _ARGS((int narg, cl_object x));
+extern cl_object Latan _ARGS((int narg, cl_object x, ...));
+extern cl_object Lsinh _ARGS((int narg, cl_object x));
+extern cl_object Lcosh _ARGS((int narg, cl_object x));
+extern cl_object Ltanh _ARGS((int narg, cl_object x));
+
+/* package.c */
+
+extern cl_object Vpackage;
+extern cl_object Kinternal;
+extern cl_object Kexternal;
+extern cl_object Kinherited;
+extern cl_object Knicknames;
+extern cl_object Kuse;
+extern cl_object Lmake_package _ARGS((int narg, cl_object pack_name, ...));
+extern cl_object siLselect_package _ARGS((int narg, cl_object pack_name));
+extern cl_object Lfind_package _ARGS((int narg, cl_object p));
+extern cl_object Lpackage_name _ARGS((int narg, cl_object p));
+extern cl_object Lpackage_nicknames _ARGS((int narg, cl_object p));
+extern cl_object Lrename_package _ARGS((int narg, cl_object pack, cl_object new_name, ...));
+extern cl_object Lpackage_use_list _ARGS((int narg, cl_object p));
+extern cl_object Lpackage_used_by_list _ARGS((int narg, cl_object p));
+extern cl_object Lpackage_shadowing_symbols _ARGS((int narg, cl_object p));
+extern cl_object Llist_all_packages _ARGS((int narg));
+extern cl_object Lintern _ARGS((int narg, cl_object strng, ...));
+extern cl_object Lfind_symbol _ARGS((int narg, cl_object strng, ...));
+extern cl_object Lunintern _ARGS((int narg, cl_object symbl, ...));
+extern cl_object Lexport _ARGS((int narg, cl_object symbols, ...));
+extern cl_object Lunexport _ARGS((int narg, cl_object symbols, ...));
+extern cl_object Limport _ARGS((int narg, cl_object symbols, ...));
+extern cl_object Lshadowing_import _ARGS((int narg, cl_object symbols, ...));
+extern cl_object Lshadow _ARGS((int narg, cl_object symbols, ...));
+extern cl_object Luse_package _ARGS((int narg, cl_object pack, ...));
+extern cl_object Lunuse_package _ARGS((int narg, cl_object pack, ...));
+extern cl_object siLpackage_internal _ARGS((int narg, cl_object p, cl_object index));
+extern cl_object siLpackage_external _ARGS((int narg, cl_object p, cl_object index));
+extern cl_object siLpackage_size _ARGS((int narg, cl_object p));
+extern cl_object siLpackage_lock _ARGS((int narg, cl_object p, cl_object t));
+extern cl_object Ldelete_package _ARGS((int narg, cl_object p));
+
+/* pathname.c */
+
+extern cl_object Vdefault_pathname_defaults;
+extern cl_object Kwild;
+extern cl_object Kwild_inferiors;
+extern cl_object Knewest;
+extern cl_object Khost;
+extern cl_object Kdevice;
+extern cl_object Kdirectory;
+extern cl_object Kname;
+extern cl_object Ktype;
+extern cl_object Kversion;
+extern cl_object Kdefaults;
+extern cl_object Kabsolute;
+extern cl_object Krelative;
+extern cl_object Kup;
+extern cl_object Kper;
+extern cl_object Lpathname _ARGS((int narg, cl_object name));
+extern cl_object Lparse_namestring _ARGS((int narg, cl_object thing, ...));
+extern cl_object Lparse_logical_namestring _ARGS((int narg, cl_object thing, ...));
+extern cl_object Lmerge_pathnames _ARGS((int narg, cl_object path, ...));
+extern cl_object Lmake_pathname _ARGS((int narg, ...));
+extern cl_object Lpathnamep _ARGS((int narg, cl_object pname));
+extern cl_object Lpathname_host _ARGS((int narg, cl_object pname));
+extern cl_object Lpathname_device _ARGS((int narg, cl_object pname));
+extern cl_object Lpathname_directory _ARGS((int narg, cl_object pname));
+extern cl_object Lpathname_name _ARGS((int narg, cl_object pname));
+extern cl_object Lpathname_type _ARGS((int narg, cl_object pname));
+extern cl_object Lpathname_version _ARGS((int narg, cl_object pname));
+extern cl_object Lnamestring _ARGS((int narg, cl_object pname));
+extern cl_object Lfile_namestring _ARGS((int narg, cl_object pname));
+extern cl_object Ldirectory_namestring _ARGS((int narg, cl_object pname));
+extern cl_object Lhost_namestring _ARGS((int narg, cl_object pname));
+extern cl_object Lenough_namestring _ARGS((int narg, cl_object path, ...));
+extern cl_object siLlogical_pathname_p _ARGS((int narg, cl_object pname));
+extern cl_object Lpathname_match_p _ARGS((int narg, cl_object path, cl_object mask));
+extern cl_object siLpathname_translations _ARGS((int narg, cl_object host, ...));
+extern cl_object Ltranslate_pathname _ARGS((int narg, cl_object source, cl_object from, cl_object to));
+extern cl_object Ltranslate_logical_pathname _ARGS((int narg, cl_object source));
+
+/* predicate.c */
+
+extern cl_object Lnull _ARGS((int narg, cl_object x));
+extern cl_object Lsymbolp _ARGS((int narg, cl_object x));
+extern cl_object Latom _ARGS((int narg, cl_object x));
+extern cl_object Lconsp _ARGS((int narg, cl_object x));
+extern cl_object Llistp _ARGS((int narg, cl_object x));
+extern cl_object Lnumberp _ARGS((int narg, cl_object x));
+extern cl_object Lintegerp _ARGS((int narg, cl_object x));
+extern cl_object Lrationalp _ARGS((int narg, cl_object x));
+extern cl_object Lfloatp _ARGS((int narg, cl_object x));
+extern cl_object Lrealp _ARGS((int narg, cl_object x));
+extern cl_object Lcomplexp _ARGS((int narg, cl_object x));
+extern cl_object Lcharacterp _ARGS((int narg, cl_object x));
+extern cl_object Lstringp _ARGS((int narg, cl_object x));
+extern cl_object Lbit_vector_p _ARGS((int narg, cl_object x));
+extern cl_object Lvectorp _ARGS((int narg, cl_object x));
+extern cl_object Lsimple_string_p _ARGS((int narg, cl_object x));
+extern cl_object Lsimple_bit_vector_p _ARGS((int narg, cl_object x));
+extern cl_object Lsimple_vector_p _ARGS((int narg, cl_object x));
+extern cl_object Larrayp _ARGS((int narg, cl_object x));
+extern cl_object Lpackagep _ARGS((int narg, cl_object x));
+extern cl_object Lfunctionp _ARGS((int narg, cl_object x));
+extern cl_object Lcompiled_function_p _ARGS((int narg, cl_object x));
+extern cl_object Lcommonp _ARGS((int narg, cl_object x));
+extern cl_object Leq _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Leql _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Lequal _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object Lequalp _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object siLcontains_sharp_comma _ARGS((int narg, cl_object x));
+extern cl_object siLfixnump _ARGS((int narg, cl_object x));
+
+/* print.c */
+
+extern cl_object Kupcase;
+extern cl_object Kdowncase;
+extern cl_object Kcapitalize;
+extern cl_object Kstream;
+extern cl_object Kescape;
+extern cl_object Kpretty;
+extern cl_object Kcircle;
+extern cl_object Kbase;
+extern cl_object Kradix;
+extern cl_object Kcase;
+extern cl_object Kgensym;
+extern cl_object Klevel;
+extern cl_object Klength;
+extern cl_object Karray;
+extern cl_object Vprint_escape;
+extern cl_object Vprint_pretty;
+extern cl_object Vprint_circle;
+extern cl_object Vprint_base;
+extern cl_object Vprint_radix;
+extern cl_object Vprint_case;
+extern cl_object Vprint_gensym;
+extern cl_object Vprint_level;
+extern cl_object Vprint_length;
+extern cl_object Vprint_array;
+extern cl_object Sstream_write_char;
+extern cl_object Sstream_write_string;
+extern cl_object Sstream_fresh_line;
+extern cl_object Sstream_clear_output;
+extern cl_object Sstream_force_output;
+extern cl_object siSpretty_print_format;
+extern cl_object siSsharp_exclamation;
+extern cl_object siVprint_package;
+extern cl_object siVprint_structure;
+extern cl_object Lwrite _ARGS((int narg, cl_object x, ...));
+extern cl_object Lprin1 _ARGS((int narg, cl_object obj, ...));
+extern cl_object Lprint _ARGS((int narg, cl_object obj, ...));
+extern cl_object Lpprint _ARGS((int narg, cl_object obj, ...));
+extern cl_object Lprinc _ARGS((int narg, cl_object obj, ...));
+extern cl_object Lwrite_char _ARGS((int narg, cl_object c, ...));
+extern cl_object Lwrite_string _ARGS((int narg, cl_object strng, ...));
+extern cl_object Lwrite_line _ARGS((int narg, cl_object strng, ...));
+extern cl_object Lterpri _ARGS((int narg, ...));
+extern cl_object Lfresh_line _ARGS((int narg, ...));
+extern cl_object Lforce_output _ARGS((int narg, ...));
+extern cl_object Lclear_output _ARGS((int narg, ...));
+extern cl_object Lwrite_byte _ARGS((int narg, cl_object integer, cl_object binary_output_stream));
+extern cl_object Lwrite_bytes _ARGS((int narg, cl_object stream, cl_object string, cl_object start, cl_object end));
+
+/* profile.c */
+
+extern cl_object siLprofile _ARGS((int narg, cl_object scale, cl_object start_address));
+extern cl_object siLclear_profile _ARGS((int narg));
+extern cl_object siLdisplay_profile _ARGS((int narg));
+
+/* read.c */
+
+extern cl_object Vreadtable;
+extern cl_object Vread_default_float_format;
+extern cl_object Vread_base;
+extern cl_object Vread_suppress;
+extern cl_object Kjunk_allowed;
+extern cl_object siSsharp_comma;
+extern cl_object Sstream_read_line;
+extern cl_object Sstream_read_char;
+extern cl_object Sstream_unread_char;
+extern cl_object Sstream_peek_char;
+extern cl_object Sstream_listen;
+extern cl_object Sstream_clear_input;
+extern cl_object siLsharp_comma_reader_for_compiler _ARGS((int, cl_object, cl_object, cl_object));
+extern cl_object Lread _ARGS((int narg, ...));
+extern cl_object Lread_preserving_whitespace _ARGS((int narg, ...));
+extern cl_object Lread_delimited_list _ARGS((int narg, cl_object d, ...));
+extern cl_object Lread_line _ARGS((int narg, ...));
+extern cl_object Lread_char _ARGS((int narg, ...));
+extern cl_object Lunread_char _ARGS((int narg, cl_object c, ...));
+extern cl_object Lpeek_char _ARGS((int narg, ...));
+extern cl_object Llisten _ARGS((int narg, ...));
+extern cl_object Lread_char_no_hang _ARGS((int narg, ...));
+extern cl_object Lclear_input _ARGS((int narg, ...));
+extern cl_object Lparse_integer _ARGS((int narg, cl_object strng, ...));
+extern cl_object Lread_byte _ARGS((int narg, cl_object binary_input_stream, ...));
+extern cl_object Lread_bytes _ARGS((int narg, cl_object stream, cl_object string, cl_object start, cl_object end));
+extern cl_object Lcopy_readtable _ARGS((int narg, ...));
+extern cl_object Lreadtablep _ARGS((int narg, cl_object readtable));
+extern cl_object Lset_syntax_from_char _ARGS((int narg, cl_object tochr, cl_object fromchr, ...));
+extern cl_object Lset_macro_character _ARGS((int narg, cl_object chr, cl_object fnc, ...));
+extern cl_object Lget_macro_character _ARGS((int narg, cl_object chr, ...));
+extern cl_object Lmake_dispatch_macro_character _ARGS((int narg, cl_object chr, ...));
+extern cl_object Lset_dispatch_macro_character _ARGS((int narg, cl_object dspchr, cl_object subchr, cl_object fnc, ...));
+extern cl_object Lget_dispatch_macro_character _ARGS((int narg, cl_object dspchr, cl_object subchr, ...));
+extern cl_object siLstring_to_object _ARGS((int narg, cl_object str));
+extern cl_object siLstandard_readtable _ARGS((int narg));
+
+/* reference.c */
+
+extern cl_object Lfboundp _ARGS((int narg, cl_object sym));
+extern cl_object Lsymbol_function _ARGS((int narg, cl_object sym));
+extern cl_object siLcoerce_to_function _ARGS((int narg, cl_object form));
+extern cl_object Lsymbol_value _ARGS((int narg, cl_object sym));
+extern cl_object Lboundp _ARGS((int narg, cl_object sym));
+extern cl_object Lmacro_function _ARGS((int narg, cl_object sym, ...));
+extern cl_object Lspecial_form_p _ARGS((int narg, cl_object form));
+
+/* sequence.c */
+
+extern cl_object Lelt _ARGS((int narg, cl_object x, cl_object i));
+extern cl_object siLelt_set _ARGS((int narg, cl_object seq, cl_object index, cl_object val));
+extern cl_object Lsubseq _ARGS((int narg, cl_object sequence, cl_object start, ...));
+extern cl_object Lcopy_seq _ARGS((int narg, cl_object x));
+extern cl_object Llength _ARGS((int narg, cl_object x));
+extern cl_object Lreverse _ARGS((int narg, cl_object x));
+extern cl_object Lnreverse _ARGS((int narg, cl_object x));
+
+/* stacks.c */
+
+extern cl_object Kcatch, Kcatchall, Kprotect;
+extern cl_object siLihs_top _ARGS((int narg));
+extern cl_object siLihs_fun _ARGS((int narg, cl_object arg));
+extern cl_object siLihs_env _ARGS((int narg, cl_object arg));
+extern cl_object siLfrs_top _ARGS((int narg));
+extern cl_object siLfrs_bds _ARGS((int narg, cl_object arg));
+extern cl_object siLfrs_class _ARGS((int narg, cl_object arg));
+extern cl_object siLfrs_tag _ARGS((int narg, cl_object arg));
+extern cl_object siLfrs_ihs _ARGS((int narg, cl_object arg));
+extern cl_object siLbds_top _ARGS((int narg));
+extern cl_object siLbds_var _ARGS((int narg, cl_object arg));
+extern cl_object siLbds_val _ARGS((int narg, cl_object arg));
+extern cl_object siLsch_frs_base _ARGS((int narg, cl_object fr, cl_object ihs));
+extern cl_object siLreset_stack_limits _ARGS((int narg));
+
+
+/* string.c */
+
+extern cl_object Kstart1;
+extern cl_object Kend1;
+extern cl_object Kstart2;
+extern cl_object Kend2;
+extern cl_object Kstart;
+extern cl_object Kend;
+extern cl_object Lmake_string _ARGS((int narg, cl_object size, ...));
+extern cl_object Lchar _ARGS((int narg, cl_object s, cl_object i));
+extern cl_object siLchar_set _ARGS((int narg, cl_object str, cl_object index, cl_object c));
+extern cl_object Lstring_eq _ARGS((int narg, cl_object string1, cl_object string2, ...));
+extern cl_object Lstring_equal _ARGS((int narg, cl_object string1, cl_object string2, ...));
+extern cl_object Lstring_cmp _ARGS((int narg, int sign, int boundary, cl_object *ARGS));
+extern cl_object Lstring_l _ARGS((int narg, ...));
+extern cl_object Lstring_g _ARGS((int narg, ...));
+extern cl_object Lstring_le _ARGS((int narg, ...));
+extern cl_object Lstring_ge _ARGS((int narg, ...));
+extern cl_object Lstring_neq _ARGS((int narg, ...));
+extern cl_object Lstring_compare _ARGS((int narg, int sign, int boundary, cl_object *ARGS));
+extern cl_object Lstring_lessp _ARGS((int narg, ...));
+extern cl_object Lstring_greaterp _ARGS((int narg, ...));
+extern cl_object Lstring_not_greaterp _ARGS((int narg, ...));
+extern cl_object Lstring_not_lessp _ARGS((int narg, ...));
+extern cl_object Lstring_not_equal _ARGS((int narg, ...));
+extern cl_object Lstring_trim _ARGS((int narg, cl_object char_bag, cl_object strng));
+extern cl_object Lstring_left_trim _ARGS((int narg, cl_object char_bag, cl_object strng));
+extern cl_object Lstring_right_trim _ARGS((int narg, cl_object char_bag, cl_object strng));
+extern cl_object Lstring_trim0 _ARGS((int narg, bool left_trim, bool right_trim, cl_object char_bag, cl_object strng));
+extern cl_object Lstring_case(int narg, int (*casefun)(), cl_object *ARGS);
+extern cl_object Lstring_upcase _ARGS((int narg, ...));
+extern cl_object Lstring_downcase _ARGS((int narg, ...));
+extern cl_object Lstring_capitalize _ARGS((int narg, ...));
+extern cl_object Lnstring_case(int narg, int (*casefun)(), cl_object *ARGS);
+extern cl_object Lnstring_upcase _ARGS((int narg, ...));
+extern cl_object Lnstring_downcase _ARGS((int narg, ...));
+extern cl_object Lnstring_capitalize _ARGS((int narg, ...));
+extern cl_object Lstring _ARGS((int narg, cl_object x));
+extern cl_object siLstring_concatenate _ARGS((int narg, ...));
+
+/* structure.c */
+
+extern cl_object siSstructure_print_function;
+extern cl_object siSstructure_slot_descriptions;
+extern cl_object Sstructure_object;
+extern cl_object siLstructure_subtype_p _ARGS((int narg, cl_object x, cl_object y));
+extern cl_object siLmake_structure _ARGS((int narg, cl_object type, ...));
+extern cl_object siLcopy_structure _ARGS((int narg, cl_object x));
+extern cl_object siLstructure_name _ARGS((int narg, cl_object s));
+extern cl_object siLstructure_ref _ARGS((int narg, cl_object x, cl_object type, cl_object index));
+extern cl_object siLstructure_set _ARGS((int narg, cl_object x, cl_object type, cl_object index, cl_object val));
+extern cl_object siLstructurep _ARGS((int narg, cl_object s));
+extern cl_object siLrplaca_nthcdr _ARGS((int narg, cl_object x, cl_object idx, cl_object v));
+extern cl_object siLlist_nth _ARGS((int narg, cl_object idx, cl_object x));
+
+/* symbol.c */
+
+extern cl_object siSpname;
+extern cl_object Vgensym_counter;
+extern cl_object Lmake_symbol _ARGS((int narg, cl_object str));
+extern cl_object Lget _ARGS((int narg, cl_object sym, cl_object indicator, ...));
+extern cl_object Lremprop _ARGS((int narg, cl_object sym, cl_object prop));
+extern cl_object Lsymbol_plist _ARGS((int narg, cl_object sym));
+extern cl_object Lgetf _ARGS((int narg, cl_object place, cl_object indicator, ...));
+extern cl_object Lget_properties _ARGS((int narg, cl_object place, cl_object indicator_list));
+extern cl_object Lsymbol_name _ARGS((int narg, cl_object sym));
+extern cl_object Lcopy_symbol _ARGS((int narg, cl_object sym, ...));
+extern cl_object Lgensym _ARGS((int narg, ...));
+extern cl_object Lgentemp _ARGS((int narg, ...));
+extern cl_object Lsymbol_package _ARGS((int narg, cl_object sym));
+extern cl_object Lkeywordp _ARGS((int narg, cl_object sym));
+extern cl_object siLput_f _ARGS((int narg, cl_object plist, cl_object value, cl_object indicator));
+extern cl_object siLrem_f _ARGS((int narg, cl_object plist, cl_object indicator));
+extern cl_object siLset_symbol_plist _ARGS((int narg, cl_object sym, cl_object plist));
+extern cl_object siLputprop _ARGS((int narg, cl_object sym, cl_object value, cl_object indicator));
+extern cl_object siLput_properties _ARGS((int narg, cl_object sym, ...));
+extern cl_object siLAmake_special _ARGS((int narg, cl_object sym));
+extern cl_object siLAmake_constant _ARGS((int narg, cl_object sym, cl_object val));
+
+/* tcp.c */
+
+#ifdef TCP
+extern cl_object Lopen_client_stream _ARGS((int narg, cl_object host, cl_object port));
+extern cl_object Lopen_server_stream _ARGS((int narg, cl_object port));
+#endif
+
+/* time.c */
+
+extern cl_object Lget_universal_time _ARGS((int narg));
+extern cl_object Lsleep _ARGS((int narg, cl_object z));
+extern cl_object Lget_internal_run_time _ARGS((int narg));
+extern cl_object Lget_internal_real_time _ARGS((int narg));
+extern cl_object Lget_local_time_zone _ARGS((int narg));
+extern cl_object Ldaylight_saving_timep _ARGS((int narg, ...));
+
+/* typespec.c */
+
+extern cl_object Squote;
+extern cl_object Slambda;
+extern cl_object Sspecial;
+extern cl_object St;
+extern cl_object Snil;
+extern cl_object Scommon;
+extern cl_object Ssequence;
+extern cl_object Snull;
+extern cl_object Scons;
+extern cl_object Slist;
+extern cl_object Ssymbol;
+extern cl_object Sarray;
+extern cl_object Svector;
+extern cl_object Sbit_vector;
+extern cl_object Sstring;
+extern cl_object Ssimple_array;
+extern cl_object Ssimple_vector;
+extern cl_object Ssimple_string;
+extern cl_object Ssimple_bit_vector;
+extern cl_object Sfunction;
+extern cl_object Spathname;
+extern cl_object Slogical_pathname;
+extern cl_object Scharacter;
+extern cl_object Sbase_char;
+extern cl_object Sextended_char;
+extern cl_object Scompiled_function;
+extern cl_object Snumber;
+extern cl_object Sreal;
+extern cl_object Srational;
+extern cl_object Sfloat;
+extern cl_object Sinteger;
+extern cl_object Sratio;
+extern cl_object Sshort_float;
+extern cl_object Sstandard_char;
+extern cl_object Sfixnum;
+extern cl_object Scomplex;
+extern cl_object Ssingle_float;
+extern cl_object Spackage;
+extern cl_object Sbignum;
+extern cl_object Srandom_state;
+extern cl_object Sdouble_float;
+extern cl_object Sstream;
+extern cl_object Sbit;
+extern cl_object Sreadtable;
+extern cl_object Slong_float;
+extern cl_object Shash_table;
+extern cl_object Ssigned_char;
+extern cl_object Sunsigned_char;
+extern cl_object Ssigned_short;
+extern cl_object Sunsigned_short;
+extern cl_object Sinstance;
+extern cl_object Sdispatch_function;
+extern cl_object Sstructure;
+extern cl_object Ssatisfies;
+extern cl_object Smember;
+extern cl_object Snot;
+extern cl_object Sor;
+extern cl_object Sand;
+extern cl_object Svalues;
+extern cl_object Smod;
+extern cl_object Ssigned_byte;
+extern cl_object Sunsigned_byte;
+extern cl_object SX;
+extern cl_object Splusp;
+extern cl_object Skeyword;
+extern cl_object TSor_string_symbol;
+extern cl_object TSor_symbol_string_package;
+extern cl_object TSnon_negative_integer;
+extern cl_object TSpositive_number;
+extern cl_object TSor_integer_float;
+extern cl_object TSor_rational_float;
+extern cl_object TSor_pathname_string_symbol;
+extern cl_object TSor_pathname_string_symbol_stream;
+extern cl_object Ltype_of _ARGS((int narg, cl_object x));
+extern cl_object Ssubtypep;
+
+/* unify.c */
+
+#ifdef LOCATIVE
+extern cl_object Ltrail_mark _ARGS((int narg));
+extern cl_object Ltrail_restore _ARGS((int narg));
+extern cl_object Ltrail_unmark _ARGS((int narg));
+extern cl_object Lget_value _ARGS((int narg, cl_object v, cl_object x));
+extern cl_object Lget_constant _ARGS((int narg, cl_object c, cl_object x));
+extern cl_object Lget_nil _ARGS((int narg, cl_object arg));
+extern cl_object Lget_cons _ARGS((int narg, cl_object arg));
+extern cl_object Lget_instance _ARGS((int narg, cl_object x, cl_object class, cl_object arity));
+extern cl_object Lunify_slot _ARGS((int narg));
+extern cl_object Lunify_value _ARGS((int narg, cl_object loc));
+extern cl_object Lunify_constant _ARGS((int narg, cl_object c));
+extern cl_object Lunify_nil _ARGS((int narg));
+extern cl_object Lmake_locative _ARGS((int narg, ...));
+extern cl_object Llocativep _ARGS((int narg, cl_object obje));
+extern cl_object Lunboundp _ARGS((int narg, cl_object loc));
+extern cl_object Ldereference _ARGS((int narg, cl_object x));
+extern cl_object Lmake_variable _ARGS((int narg, cl_object name));
+extern cl_object Ssetq;
+extern cl_object Sunify_slot;
+extern cl_object Lunify_variable _ARGS((cl_object var));
+#endif
+
+/* unixfsys.c */
+
+extern cl_object Klist_all;
+extern cl_object Ltruename _ARGS((int narg, cl_object file));
+extern cl_object Lrename_file _ARGS((int narg, cl_object old, cl_object new));
+extern cl_object Ldelete_file _ARGS((int narg, cl_object file));
+extern cl_object Lprobe_file _ARGS((int narg, cl_object file));
+extern cl_object Lfile_write_date _ARGS((int narg, cl_object file));
+extern cl_object Lfile_author _ARGS((int narg, cl_object file));
+extern cl_object Luser_homedir_pathname _ARGS((int narg, ...));
+extern cl_object siLchdir _ARGS((int narg, cl_object directory));
+extern cl_object siLstring_match _ARGS((int narg, cl_object string, cl_object pattern));
+extern cl_object Ldirectory _ARGS((int narg, ...));
+
+/* unixint.c */
+
+extern cl_object siLcatch_bad_signals _ARGS((int narg));
+extern cl_object siLuncatch_bad_signals _ARGS((int narg));
+
+/* unixsys.c */
+
+extern cl_object siLsystem _ARGS((int narg, cl_object cmd));
+extern cl_object siLopen_pipe _ARGS((int narg, cl_object cmd));
diff --git a/src/h/lwp.h b/src/h/lwp.h
new file mode 100644
index 000000000..05aa99017
--- /dev/null
+++ b/src/h/lwp.h
@@ -0,0 +1,242 @@
+/*
+    lwp.h  -- Light weight processes.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+#include <sys/ioctl.h>
+
+typedef struct lpd {
+
+  /* stacks.h - The bind stack */
+  size_t lwp_bds_size;
+  bds_ptr lwp_bds_org;
+  bds_ptr lwp_bds_limit;
+  bds_ptr lwp_bds_top;
+
+  /* eval.h - The C stack */
+  size_t lwp_cssize;	/* see reset_stack_limits */
+  int *lwp_cs_org;
+  int *lwp_cs_limit;
+
+  /* stacks.h - The Invocation History stack */
+  size_t lwp_ihs_size;
+  ihs_ptr lwp_ihs_org;
+  ihs_ptr lwp_ihs_limit;
+  ihs_ptr lwp_ihs_top;
+
+  /* stacks.h - The Frame stack */
+  size_t lwp_frs_size;
+  frame_ptr lwp_frs_org;
+  frame_ptr lwp_frs_limit;
+  frame_ptr lwp_frs_top;
+
+    /* Non-local jumps */
+  frame_ptr lwp_nlj_fr;
+  cl_object lwp_nlj_tag;
+
+  /* lex.h - Lexical environment */
+  cl_object lwp_lex[3];
+  cl_object *lwp_lex_env;
+
+  /* vs.h - Multiple values */
+  cl_object lwp_Values[VSSIZE];
+  int	 lwp_nValues;		/* No. of values produced by Lresume */
+
+  /* used in alloc.c */
+  cl_object lwp_alloc_temporary;
+
+  /* backq.c */
+  int lwp_backq_level;		/* It should be initialized with 0 (zero) */
+
+  /* eval.c */
+  int lwp_eval1;                /* It should be initialized with 0 (zero) */
+
+  /* format.c */
+  int (*lwp_fmt_ch_fun)();
+  cl_object lwp_fmt_stream;
+  int lwp_ctl_origin;
+  int lwp_ctl_index;
+  int lwp_ctl_end;
+  cl_object *lwp_fmt_base;
+  int lwp_fmt_index;
+  int lwp_fmt_end;
+  int *lwp_fmt_jmp_buf;
+  int lwp_fmt_indents;
+  cl_object lwp_fmt_string;
+  cl_object lwp_fmt_temporary_stream;
+  cl_object lwp_fmt_temporary_string;
+  int lwp_fmt_nparam;
+  struct {
+    int fmt_param_type;
+    int fmt_param_value;
+  } lwp_fmt_param[100];
+  int lwp_fmt_spare_spaces;
+  int lwp_fmt_line_length;
+
+  /* lwp.c */
+  cl_object lwp_thread;
+
+  /* list.d */
+  cl_object lwp_test_function;
+  cl_object lwp_item_compared;
+  bool (*lwp_tf)();
+  cl_object lwp_key_function;
+  cl_object (*lwp_kf)();
+
+  /* package.d */
+  int lwp_intern_flag;
+
+  /* print.d */
+  jmp_buf lwp_CIRCLEjmp;
+  cl_object *lwp_CIRCLEbase;
+  cl_object *lwp_CIRCLEtop;
+  cl_object *lwp_CIRCLElimit;
+  cl_object lwp_PRINTstream;
+  bool lwp_PRINTescape;
+  bool lwp_PRINTpretty;
+  bool lwp_PRINTcircle;
+  int lwp_PRINTbase;
+  bool lwp_PRINTradix;
+  cl_object lwp_PRINTcase;
+  bool lwp_PRINTgensym;
+  int lwp_PRINTlevel;
+  int lwp_PRINTlength;
+  bool lwp_PRINTarray;
+/* LWP 2
+ */
+  bool lwp_PRINTpackage;
+  bool lwp_PRINTstructure;
+
+  int (*lwp_write_ch_fun)();
+  int (*lwp_output_ch_fun)();
+  short lwp_queue[Q_SIZE];
+  short lwp_indent_stack[IS_SIZE];
+  int lwp_qh;
+  int lwp_qt;
+  int lwp_qc;
+  int lwp_isp;
+  int lwp_iisp;
+
+  /* read.d */
+  cl_object lwp_READtable;
+  int lwp_READdefault_float_format;
+  int lwp_READbase;
+  bool lwp_READsuppress;
+  bool lwp_preserving_whitespace_flag;
+  bool lwp_escape_flag;
+  cl_object lwp_delimiting_char;
+  bool lwp_detect_eos_flag;
+  bool lwp_in_list_flag;
+  bool lwp_dot_flag;
+  cl_object lwp_default_dispatch_macro;
+  cl_object sharp_eq_context;
+  cl_object (*lwp_read_ch_fun)();
+
+  /* big.c */
+  mp_limb lwp_bignum_register_limbs[3][BIGNUM_REGISTER_SIZE];
+  cl_object lwp_bignum_registers[3];
+
+  /* symbol.d */
+  cl_object lwp_string_register;
+  cl_object lwp_gensym_prefix;
+  cl_object lwp_gentemp_prefix;
+  cl_object lwp_token;		/* They have to be initialized with
+			         * alloc_simple_string and */
+} lpd;
+
+
+#define RUNNING		0
+#define SUSPENDED	1
+#define STOPPED		2
+#define DEAD		3
+#define WAITING		4
+#define DELAYED		5
+
+typedef struct pd {
+  cl_object pd_thread;             /* point back to its thread	 */
+  int	 pd_status;		/* RUNNING or STOPPED or DEAD */
+  int	 *pd_base;		/* Stack Base */
+#ifdef VAX
+  int	 pd_env[16];		/* Stack Environment */ 
+#else
+  sigjmp_buf  pd_env;		/* Stack Environment */ 
+#endif VAX
+  int	 pd_slice;              /* time out			 */
+  FILE	 *pd_fp;		/* File pointer waiting input on */
+  lpd	 *pd_lpd;               /* lisp process descriptor */
+  struct pd *pd_next;
+
+} pd;
+
+
+
+#define PUSH(lpd)     { if ( running_head == NULL)               \
+			  { running_head = lpd;                  \
+			   running_tail = lpd;                   \
+			   lpd->pd_next = NULL;   }              \
+		         else { lpd->pd_next = running_head;     \
+			    running_head = lpd; } }
+
+#define ENQUEUE(lpd)  { if  ( running_head == NULL )              \
+			   {  running_head = lpd;                 \
+			      running_tail = lpd ;                \
+			      running_tail->pd_next = NULL; }      \
+			 else {  running_tail->pd_next = lpd;     \
+			         lpd->pd_next = NULL;             \
+			         running_tail = lpd;  } }
+
+
+#define ROTQUEUE()	 { running_tail->pd_next = running_head; \
+			    running_head = running_head->pd_next; \
+			    running_tail = running_tail->pd_next; \
+			    running_tail->pd_next = NULL; }
+
+
+/*
+#define PUSH(lpd)     ( running_head == NULL \
+			 ? (running_head = running_tail = lpd, \
+			    lpd->pd_next = NULL) \
+		         : (lpd->pd_next = running_head, \
+			    running_head = lpd ) )
+
+#define ENQUEUE(lpd) ( running_head == NULL \
+			 ? (running_head = running_tail = lpd, \
+			    running_tail->pd_next = NULL) \
+			 : (running_tail->pd_next = lpd, \
+			    lpd->pd_next = NULL, \
+			    running_tail = lpd) )
+
+
+#define DEQUEUE(lpd)    ( lpd = running_head, \
+			   running_head != NULL \
+			   ? running_head = lpd->pd_next \
+			   : NULL )
+
+#define ROTQUEUE()	( running_head != NULL \
+			 ? (running_tail->pd_next = running_head, \
+			    running_head = running_head->pd_next, \
+			    running_tail = running_tail->pd_next, \
+			    running_tail->pd_next = NULL ) \
+			 : NULL )
+
+*/
+
+#define FOREVER 1
+
+#define SPAWNSTART 0
+#define SPAWNEND 1
+#define SCHEDULE 2
+#define REMOVELWP 3
+
+#define QUANTUM 20000		/* Microseconds */
+#define REALQUANTUM 100000	/*      ""      */
+
+#define STACK_SIZE (CSSIZE+CSGETA)	/* Words */
diff --git a/src/h/machines.h b/src/h/machines.h
new file mode 100755
index 000000000..3d103c82c
--- /dev/null
+++ b/src/h/machines.h
@@ -0,0 +1,424 @@
+/*
+    machines.h -- Machine descriptions.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#if defined(sparc) || defined(i386) || defined(mips)
+#  define	stack_align(n)	(((n) + 0x7) & ~0x7)
+#else
+#  define	stack_align(n)	(((n) + 03) & ~03)
+#endif
+
+#if defined(linux) \
+ && !defined(__FreeBSD__) \
+ && !defined(__NetBSD__) \
+ && !(defined(sun) && !defined(sun4sol2))
+#  define ecls_setjmp	setjmp
+#  define ecls_longjmp	longjmp
+#else
+#  define ecls_setjmp	_setjmp
+#  define ecls_longjmp	_longjmp
+#endif
+
+#ifdef __linux__
+#  define FILE_CNT(fp)	((fp)->_IO_read_end - (fp)->_IO_read_ptr)
+#elif defined(__FreeBSD__) || defined(__NetBSD__)
+#  define FILE_CNT(fp)	((fp)->_r)
+#  define _IO_buf_base	_bf._base /* watch out */
+#elif defined(__EMX__)
+#  define FILE_CNT(fp)	((fp)->rcount)
+#  define _IO_buf_base	buffer
+#else
+#  define FILE_CNT(fp)	(fp)->_cnt
+#  define _IO_buf_base	_base
+#endif
+
+#ifdef	MSDOS
+#  define IS_DIR_SEPARATOR(x) ((x=='/')||(x=='\\'))
+#  define DIR_SEPARATOR	'\\'
+#  define PATH_SEPARATOR	';'
+#  define OPEN_R	"rb"
+#  define OPEN_W	"wb"
+#  define OPEN_RW	"w+b"
+#  define OPEN_A	"ab"
+#  define OPEN_RA	"a+b"
+#else
+#  define IS_DIR_SEPARATOR(x) (x=='/')
+#  define DIR_SEPARATOR	'/'
+#  define PATH_SEPARATOR	':'
+#  define OPEN_R	"r"
+#  define OPEN_W	"w"
+#  define OPEN_RW	"w+"
+#  define OPEN_A	"a"
+#  define OPEN_RA	"a+"
+#endif	MSDOS
+
+#ifdef	MSDOS
+#  define CRLF
+#endif	MSDOS
+
+#if defined(__EMX__) || defined(__NetBSD__)
+#  define unix
+#endif
+
+#ifdef MSDOS
+#  define RSYM rsym.exe
+#elif !defined(__NeXT) && !defined(NeXT) /* cpp (configure) only defines NeXT */
+#  define RSYM rsym
+#endif
+
+#if defined(unix) && !defined(__MACH__)
+#  define NEED_MALLOC
+#endif
+
+/***********************************************************************
+
+  Architectural features:
+
+ ***********************************************************************/
+#ifdef	vax
+#  define ARCHITECTURE	"VAX"
+#elif	defined(mc68000) || defined(__mc68000)
+#  define ARCHITECTURE	"MC68000"
+#elif	defined(mc68010) || defined(__mc68010)
+#  define ARCHITECTURE	"MC68010"
+#elif	defined(mc68020) || defined(__mc68020)
+#  define ARCHITECTURE	"MC68020"
+#elif	defined(mc68030) || defined(__mc68030)
+#  define ARCHITECTURE	"MC68030"
+#elif	defined(mc68040) || defined(__mc68040)
+#  define ARCHITECTURE	"MC68040"
+#elif	defined(sparc) || defined(__sparc)
+#  define ARCHITECTURE	"SPARC"
+#elif	defined(i386) || defined(__i386)
+#  define ARCHITECTURE	"I386"
+#elif	defined(ns32000) || defined(__ns32000)
+#  define ARCHITECTURE	"NS32000"
+#elif	__mips
+#  define ARCHITECTURE	"MIPS"
+#elif	defined(arm2) || defined(__arm2)
+#  define ARCHITECTURE	"ARM2"
+#elif	defined(arm) || defined(__arm)
+#  define ARCHITECTURE	"ARM"
+#endif
+
+#ifdef	MSDOS
+#  define SOFTWARE_TYPE	MSDOS
+#elif	defined(unix)
+#  define SOFTWARE_TYPE	UNIX
+#elif	defined(__WIN32__)
+#  define SOFTWARE_TYPE WIN32
+#else
+#  define SOFTWARE_TYPE	UNKNOWN
+#endif	MSDOS
+
+#ifdef  aix
+#  define SOFTWARE_VERSION	AIX
+#elif	defined(__FreeBSD__)
+#  define SOFTWARE_VERSION	FreeBSD
+#elif	defined(__NetBSD__)
+#  define SOFTWARE_VERSION	NetBSD
+#elif	defined(__linux__)
+#  define SOFTWARE_VERSION	Linux
+#elif	defined(__NeXT)
+#  define SOFTWARE_VERSION	MACH
+#elif	defined(ultrix)
+#  define SOFTWARE_VERSION	ULTRIX
+#elif	defined(hpux)
+#  define SOFTWARE_VERSION	HPUX
+#elif	defined(domain)
+#  define SOFTWARE_VERSION	DOMAIN
+#elif	defined(sgi)
+#  define SOFTWARE_VERSION	IRIX
+#elif	defined(bsd4_3)
+#  define SOFTWARE_VERSION	BSD4.3
+#elif	defined(bsd4_2)
+#  define SOFTWARE_VERSION	BSD4.2
+#elif	defined(BSD)
+#  define SOFTWARE_VERSION	BSD
+#elif	defined(sysv)
+#  define SOFTWARE_VERSION	SYSTEM-V
+#else
+#  define SOFTWARE_VERSION	UNKNOWN
+#endif
+
+/***********************************************************************/
+
+#ifdef	apollo
+#define	IEEEFLOAT
+#define	DATA_START 0
+#define	DOWN_STACK
+#define JB_SP 3
+#define	BSD
+#define COFF
+#define	BRAND "HP"
+#endif	apollo
+
+#ifdef	__FreeBSD__
+#define	IEEEFLOAT
+#define	DOWN_STACK
+#define	JB_SP 4
+#ifdef __ELF__
+# define ELF
+# define UNEXEC unexelf
+# define DATA_START 0x8000000
+# define LDFLAGS -static
+#else
+# define DATA_START 0
+# define AOUT <a.out.h>
+#endif
+#define	BRAND "IBM-PC"
+#define	CLIBS -lcompat
+#define	LDFLAGS -static
+#define HAVE_ISOC99
+#ifndef unix
+#define unix
+#endif
+#endif	__FreeBSD__
+
+#ifdef	__NetBSD__
+#define	IEEEFLOAT
+#define	DOWN_STACK
+#define	JB_SP 4
+#ifndef BSD
+# define BSD
+#endif
+#ifndef unix
+# define unix
+#endif
+#ifdef __ELF__
+# define ELF
+# define DATA_START 0x8000000
+#else
+#error "A.out not yet supported in NetBSD"
+# define AOUT <a.out.h>
+# define DATA_START 0
+#endif
+#define	BRAND "IBM-PC"
+#define	CLIBS -lcompat
+#define	LDFLAGS -static
+#endif	__NetBSD__
+
+#ifdef	hp9000s300
+#define	IEEEFLOAT
+#define	DATA_START 0
+#define	DOWN_STACK
+#define JB_SP 14
+#define	SYSV
+#define	AOUT <a.out.h>
+#define	BRAND "HP"
+#define CFLAGS +Ns2000 +Nd2000
+#endif	hp9000s300
+ 
+#ifdef	hp9000s800
+#define	IEEEFLOAT
+#define	DATA_START 0x40000000
+#undef	DOWN_STACK
+#define JB_SP 14
+#define	SYSV
+#define COFF
+#define UNEXEC unexhp9k800
+#define	BRAND "HP"
+#endif	hp9000s800
+
+#ifdef	IBMRT
+#define	IEEEFLOAT
+#define	DATA_START 0x20000000
+#define	DOWN_STACK
+#define JB_SP 0
+#define	BSD
+#define	AOUT <a.out.h>
+#define	BRAND "IBM"
+#endif	IBMRT
+
+#ifdef	__linux__
+#define	IEEEFLOAT
+#define	DOWN_STACK
+#define	BSD
+#ifdef __ELF__
+# define ELF
+# define UNEXEC unexelf
+# define DATA_START 0x8000000
+# define LDFLAGS -static
+#else
+# define DATA_START 0
+# define AOUT <a.out.h>
+#endif
+#define	BRAND "IBM-PC"
+#define HAVE_ISOC99
+#define HAVE_POSIX
+#ifndef unix
+#define unix
+#endif
+#endif	linux
+
+#ifdef	mips_dec
+#define	IEEEFLOAT
+#define	DATA_START 0xA00000	/* normally 0x10000000 */
+#define	DOWN_STACK
+/* #define JB_SP 32 */
+#define	BSD
+#define COFF
+#define ECOFF
+#define UNEXEC unexelf
+#define	BRAND "DEC"
+#define	LDFLAGS -Wl,-D -Wl,A00000
+#define ILDFLAGS -T 0 -d -N
+#define LSPCFLAGS -G 0
+#endif	mips_dec
+
+#ifdef	NEWS
+#define	IEEEFLOAT
+#define	DATA_START 0
+#define	DOWN_STACK
+#define	BSD
+#define	AOUT <a.out.h>
+#define	BRAND "SONY"
+#endif	NEWS
+
+#ifdef	__NeXT
+#define	IEEEFLOAT
+#define	DATA_START 0
+#define	DOWN_STACK
+/* #define JB_SP 2 in <setjmp.h> */
+/* #define	BSD is in <param.h>	*/
+#define UNEXEC unexnext
+#define DLD dldNeXT
+#define	BRAND "NeXT"
+#define LDFLAGS -seglinkedit -segprot __TEXT rwx rwx
+#define	CLIBS -lsys_s
+#undef	AOUT
+#endif
+
+#ifdef	MSDOS
+#include "dos.h"
+#define	IEEEFLOAT
+#define	DOWN_STACK
+#define JB_SP 3
+#define	BSD
+#ifdef  __GO32__
+# define DATA_START 0
+# define COFF
+#else	/* __EMX__ */
+# define DATA_START 0x20000	/* 2 * SEGMENT_SIZE */
+# define AOUT <a_out.h>
+# define LDFLAGS -Zbsd-signals
+#endif  __GO32__
+#define	BRAND "IBM-PC"
+#endif	MSDOS
+
+#ifdef	OMRON
+#define	IEEEFLOAT
+#define	DATA_START 0
+#define	DOWN_STACK
+#define	SYSV
+#define COFF
+#define	BRAND "OMRON"
+#endif	OMRON
+
+#ifdef	SEQ
+#define	IEEEFLOAT
+#define	DATA_START 0
+#define	DOWN_STACK
+#define	BSD
+#define	AOUT <a.out.h>
+#define	BRAND "SEQUENT"
+#endif	SEQ
+
+#ifdef	sgi
+#define	IEEEFLOAT
+#define	DATA_START 0xA00000	/* normally 0x10000000 */
+#define	DOWN_STACK
+/* #define JB_SP 32 */
+#define	BSD
+#define	BRAND "SGI"
+#define _BSD_SIGNALS
+#define	LDFLAGS -Wl,-D -Wl,A00000
+#define ILDFLAGS -T 0 -d -N
+#define LSPCFLAGS -G 0
+# ifdef SVR3			/* Irix Release 4 */
+#define COFF
+#define ECOFF
+#define UNEXEC unexmips
+# else
+#define ELF
+#define UNEXEC unexelfsgi
+# endif
+#endif	sgi
+
+#ifdef	sun
+#define	IEEEFLOAT
+#define	DATA_START 0
+#define	DOWN_STACK
+#define	BSD
+#define	BRAND "SUN"
+#define LDFLAGS -Wl,-Bstatic
+
+#ifdef	sun4sol2
+#  define ELF
+#  define UNEXEC unexelf
+#elif	defined(sun386)
+#  define COFF
+#else
+#  define AOUT <a.out.h>
+#endif
+
+#ifdef	mc68000
+#  define JB_SP 14
+#elif	defined(sparc)
+#  define JB_SP 1
+#  define JB_FP 3
+#elif	defined(i386)
+#  define JB_SP 2
+#endif
+
+#ifdef	sun4
+#  define SETJMP	setjmpsparc.s
+#  define sigsetjmp(x,y) _setjmp(x)
+#  define siglongjmp(x,y) _longjmp(x,y)
+#endif
+
+#if defined(TCP) && defined(sun4sol2)
+#  define CLIBS -lsocket -lnsl -lintl -Wl,-Bdynamic -ldl -Wl,-Bstatic
+#endif
+
+#endif	sun
+
+#ifdef	TAHOE
+#define	DATA_START 0
+#define	DOWN_STACK
+#define BSD
+#define	AOUT <a.out.h>
+#define	BRAND "TAHOE"
+#endif	TAHOE
+
+#ifdef	vax
+#define	DATA_START 0
+#define	DOWN_STACK
+#define JB_SP 13
+#define	BSD
+#define AOUT <a.out.h>
+#define	BRAND "DEC"
+#endif	vax
+
+#ifdef	__WIN32__
+#define	IEEEFLOAT
+#define	DATA_START 0
+#define	DOWN_STACK
+#define	BSD
+# define PFI
+# define UNEXEC unexec
+#define	BRAND "IBM-PC"
+#endif	__WIN32__
+
+/**********************************************************************/
diff --git a/src/h/macos.h b/src/h/macos.h
new file mode 100644
index 000000000..fe99c8dd7
--- /dev/null
+++ b/src/h/macos.h
@@ -0,0 +1,16 @@
+/*
+    macos.h -- For MacOS.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#define unix			/* compatible interface is available */
+#define MAXPATHLEN	128
diff --git a/src/h/number.h b/src/h/number.h
new file mode 100644
index 000000000..159e62896
--- /dev/null
+++ b/src/h/number.h
@@ -0,0 +1,29 @@
+/*
+    number.h  -- GMP interface.
+*/
+/*
+    Copyright (c) 1995, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+#define big_odd_p(x)		((mpz_get_ui(x->big.big_num) & 1) != 0)
+#define big_even_p(x)		((mpz_get_ui(x->big.big_num) & 1) == 0)
+#define big_zerop(x)		((x)->big.big_size == 0)
+#define big_sign(x)		((x)->big.big_size)
+#define big_compare(x, y)	mpz_cmp(x->big.big_num, y->big.big_num)
+#define big_complement(x)	mpz_neg(x->big.big_num, x->big.big_num)
+#define big_add_ui(x, i)	mpz_add_ui(x->big.big_num, x->big.big_num, i)
+#define	big_mul_ui(x, i) 	mpz_mul_ui(x->big.big_num, x->big.big_num, i)
+#define big_set_ui(x, i)	mpz_set_ui(x->big.big_num, (unsigned long int)i)
+#define big_set_si(x, i)	mpz_set_ui(x->big.big_num, (long int)i)
+#define big_to_double(x)	mpz_get_d(x->big.big_num)
+#define big_to_long(x)		mpz_get_si(x->big.big_num)
+#define big_register0_get()	(bignum_register[0]->big.big_size = 0, bignum_register[0])
+#define big_register1_get()	(bignum_register[1]->big.big_size = 0, bignum_register[1])
+#define big_register2_get()	(bignum_register[2]->big.big_size = 0, bignum_register[2])
diff --git a/src/h/object.h b/src/h/object.h
new file mode 100644
index 000000000..e2945ed20
--- /dev/null
+++ b/src/h/object.h
@@ -0,0 +1,599 @@
+/*
+    object.h  -- Data structure definitions.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+    Copyright (c) 2001, Juan Jose Garcia Ripoll.
+
+    ECLS is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+/*
+	Some system constants.
+*/
+
+/*
+  INV: CHCODELIM is a power of two
+  INV: PHTABSIZE is a power of two
+  INV: ARANKLIM is of type "index"
+  INV: fixnum, u_fixnum are large enough to hold a pointer
+
+  INV: symbol and cons share cons.car = symbol.dbind, cons.cdr = symbol.sfun.
+  INV: symbol and string share fillp and self.
+*/
+
+#define	TRUE		1	/*  boolean true value  */
+#define	FALSE		0	/*  boolean false value  */
+
+#define	CHCODELIM	256	/*  ASCII character code limit  */
+#define	CHCODEFLEN	1	/*  character code field length  */
+
+#define	PHTABSIZE	512	/*  number of entries in the package hash table  */
+
+#define	ARANKLIM	64		/*  array rank limit  */
+#define	ADIMLIM		16*1024*1024	/*  array dimension limit  */
+#define	ATOTLIM		16*1024*1024	/*  array total limit  */
+
+#define	RTABSIZE	CHCODELIM	/*  read table size  */
+
+#define Q_SIZE    	128	/*  output character queue size (for print) */
+#define IS_SIZE   	256	/*  indentation stack size (for print)	*/
+
+
+typedef int bool;
+typedef long cl_fixnum;
+typedef unsigned long cl_index;
+typedef unsigned long cl_hashkey;
+typedef unsigned char byte;
+
+/*
+	Definition of the type of LISP objects.
+*/
+typedef union lispunion *cl_object;
+typedef cl_object cl_return;
+
+/*
+	OBJect NULL value.
+	It should not coincide with any legal object value.
+*/
+#define	OBJNULL		((cl_object)NULL)
+
+/*
+	Definition of each implementation type.
+*/
+
+#define IMMEDIATE(obje)		((cl_fixnum)(obje) & 3)
+#define IMMEDIATE_TAG		3
+
+/* Immediate fixnums:		*/
+#define FIXNUM_TAG		1
+#define FIXNUM_BITS		((sizeof)(cl_fixnum)/sizeof(byte) - 2)
+#define MAKE_FIXNUM(n)		((cl_object)(((cl_fixnum)(n) << 2) | FIXNUM_TAG))
+#define FIXNUM_MINUSP(n)	((cl_fixnum)(n) < 0)
+#define FIXNUM_PLUSP(n)		((cl_fixnum)(n) >= (cl_fixnum)MAKE_FIXNUM(0))
+#define	fix(obje)		(((cl_fixnum)(obje)) >> 2)
+#ifdef LOCATIVE
+#define FIXNUMP(obje)		((((cl_fixnum)(obje)) & 3) == FIXNUM_TAG)
+#else
+#define FIXNUMP(obje)		(((cl_fixnum)(obje)) & FIXNUM_TAG)
+#endif
+#define MOST_POSITIVE_FIX	(LONG_MAX >> 2)
+#define MOST_NEGATIVE_FIX	(LONG_MIN >> 2)
+
+/* Immediate characters:	*/
+#ifdef LOCATIVE
+#define CHARACTERP(obje)	((((cl_fixnum)(obje)) & 3) == 2)
+#else
+#define CHARACTERP(obje)	(((cl_fixnum)(obje)) & 2)
+#endif
+#define	code_char(c)		((cl_object)(((cl_fixnum)(c) << 2) | 2))
+#define	CHAR_CODE(obje)		((((cl_fixnum)(obje)) >> 2) & 0xffff)
+#define char_int(obje)		char_code(obje)
+#define int_char(i)		code_char(i)
+/* Locatives:	*/
+#ifdef LOCATIVE
+#define LOCATIVEP(obje)	((((cl_fixnum)(obje)) & 3) == 3)
+#define MAKE_LOCATIVE(n)((cl_object)(((cl_fixnum)(n) << 2) | 3))
+#define DEREF(loc)	(*(cl_object *)((ufixnum_t)(loc) >> 2))
+#define UNBOUNDP(loc)	(DEREF(loc) == OBJNULL)
+#define MAKE_SPICE(n)	MAKE_LOCATIVE(n)
+#define SPICE(n)	fix(n)
+#endif
+
+#define NUMBER_TYPE(t)	(t == t_fixnum || (t >= t_bignum && t <= t_complex))
+#define REAL_TYPE(t)	(t == t_fixnum || (t >= t_bignum && t < t_complex))
+#define ARRAY_TYPE(t)	(t >= t_array && t <= t_bitvector)
+#define ARRAYP(x)	((IMMEDIATE(x) == 0) && (x)->d.t >= t_array && (x)->d.t <= t_bitvector)
+#define VECTORP(x)	((IMMEDIATE(x) == 0) && (x)->d.t >= t_vector && (x)->d.t <= t_bitvector)
+
+#define HEADER			byte t, m, padding[2]
+#define HEADER1(field)		byte t, m, field, padding
+#define HEADER2(field1,field2)	byte t, m, field1, field2
+#define HEADER3(field1,flag2,flag3) \
+	byte t, m, field1; unsigned flag2:4, flag3:4
+
+struct shortfloat_struct {
+	HEADER;
+	float SFVAL;	/*  shortfloat value  */
+};
+#define	sf(obje)	(obje)->SF.SFVAL
+
+struct longfloat_struct {
+	HEADER;
+	double LFVAL;	/*  longfloat value  */
+};
+#define	lf(obje)	(obje)->LF.LFVAL
+
+struct bignum {
+	HEADER;
+	mpz_t big_num;
+};
+#define big_dim		big_num->_mp_alloc
+#define big_size	big_num->_mp_size
+#define big_limbs	big_num->_mp_d
+
+struct ratio {
+	HEADER;
+	cl_object den;		/*  denominator, must be an integer  */
+	cl_object num;		/*  numerator, must be an integer  */
+};
+
+struct complex {
+	HEADER;
+	cl_object real;		/*  real part, must be a number  */
+	cl_object imag;		/*  imaginary part, must be a number  */
+};
+
+enum stype {			/*  symbol type  */
+	stp_ordinary,		/*  ordinary  */
+	stp_constant,		/*  constant  */
+        stp_special		/*  special  */
+};
+
+#define	Cnil			((cl_object)&Cnil_body)
+#define	Ct			((cl_object)&Ct_body)
+
+struct symbol {
+	HEADER3(stype, mflag, isform);
+				/*  symbol type and whether it names a macro */
+	cl_object dbind;	/*  dynamic binding  */
+	cl_object plist;	/*  property list  */
+				/*  This field coincides with cons.car  */
+
+#define	NOT_SPECIAL		((cl_object (*)())Cnil)
+#define SPECIAL(fun)		((fun)->symbol.sfdef != NOT_SPECIAL)
+
+	cl_object name;		/*  print name  */
+	cl_object gfdef;	/*  global function definition  */
+				/*  For a macro,  */
+				/*  its expansion function  */
+				/*  is to be stored.  */
+	cl_object hpack;	/*  home package  */
+				/*  Cnil for uninterned symbols  */
+};
+#define SYM_VAL(sym)	((sym)->symbol.dbind)
+#define SYM_FUN(sym)	((sym)->symbol.gfdef)
+
+extern struct symbol Cnil_body, Ct_body;
+
+struct package {
+	HEADER1(locked);
+	cl_object name;		/*  package name, a string  */
+	cl_object nicknames;	/*  nicknames, list of strings  */
+	cl_object shadowings;	/*  shadowing symbol list  */
+	cl_object uses;		/*  use-list of packages  */
+	cl_object usedby;	/*  used-by-list of packages  */
+	cl_object internal;	/*  hashtable for internal symbols  */
+	cl_object external;	/*  hashtable for external symbols  */
+};
+
+/*
+	The values returned by intern and find_symbol.
+	File_symbol may return 0.
+*/
+#define	INTERNAL	1
+#define	EXTERNAL	2
+#define	INHERITED	3
+
+#define LISTP(x)	(x == Cnil || CONSP(x))
+#define CONSP(x)	((IMMEDIATE(x) == 0) && ((x)->d.t == t_cons))
+#define ATOM(x)		((IMMEDIATE(x) != 0) || ((x)->d.t != t_cons))
+#define SYMBOLP(x)	((IMMEDIATE(x) == 0) && ((x)->d.t == t_symbol))
+struct cons {
+	HEADER;
+	cl_object cdr;		/*  cdr  */
+	cl_object car;		/*  car  */
+};
+
+enum httest {			/*  hash table key test function  */
+	htt_eq,			/*  eq  */
+	htt_eql,		/*  eql  */
+	htt_equal,		/*  equal  */
+	htt_pack		/*  symbol hash  */
+};
+
+struct hashtable_entry {	/*  hash table entry  */
+	cl_object key;		/*  key  */
+	cl_object value;	/*  value  */
+};
+
+struct hashtable {		/*  hash table header  */
+	HEADER1(test);
+	struct hashtable_entry *data; /*  pointer to the hash table  */
+	cl_object rehash_size;	/*  rehash size  */
+	cl_object threshold;	/*  rehash threshold  */
+	cl_index entries;	/*  number of entries  */
+	cl_index size;		/*  hash table size  */
+};
+
+enum aelttype {			/*  array element type  */
+	aet_object,		/*  t                */
+	aet_ch,			/*  string-char      */
+	aet_bit,		/*  bit              */
+	aet_fix,		/*  fixnum           */
+	aet_sf,			/*  short-float      */
+	aet_lf			/*  long-float       */
+#if 0
+	,aet_char,		/*  signed char      */
+	aet_uchar,		/*  unsigned char    */
+	aet_short,		/*  signed short     */
+	aet_ushort		/*  unsigned short   */
+#endif
+};
+
+union array_data {
+	cl_object *t;
+	unsigned char *ch;
+	signed char *sch;
+	float *sf;
+	double *lf;
+	cl_fixnum *fix;
+	byte *bit;
+};
+
+struct array {			/*  array header  */
+				/*  adjustable flag  */
+				/*  has-fill-pointer flag  */
+	HEADER2(adjustable,rank);
+	cl_object displaced;	/*  displaced  */
+	cl_index dim;		/*  dimension  */
+	cl_index *dims;		/*  table of dimensions  */
+	union array_data self;	/*  pointer to the array  */
+	byte	elttype;	/*  element type  */
+	byte	offset;		/*  bitvector offset  */
+};
+
+struct vector {			/*  vector header  */
+				/*  adjustable flag  */
+				/*  has-fill-pointer flag  */
+	HEADER2(adjustable,hasfillp);
+	cl_object displaced;	/*  displaced  */
+	cl_index dim;		/*  dimension  */
+	cl_index fillp;		/*  fill pointer  */
+				/*  For simple vectors,  */
+				/*  v_fillp is equal to v_dim.  */
+	union array_data self;	/*  pointer to the vector  */
+	byte	elttype;	/*  element type  */
+	byte	offset;
+};
+
+struct string {			/*  string header  */
+				/*  adjustable flag  */
+				/*  has-fill-pointer flag  */
+	HEADER2(adjustable,hasfillp);
+	cl_object displaced;	/*  displaced  */
+	cl_index dim;       	/*  dimension  */
+				/*  string length  */
+	cl_index fillp;		/*  fill pointer  */
+				/*  For simple strings,  */
+				/*  st_fillp is equal to st_dim-1.  */
+	unsigned char *self;	/*  pointer to the string  */
+};
+
+#ifdef CLOS
+#define T_STRUCTURE	t_instance
+#define STYPE(x)	CLASS_OF(x)
+#define SLOTS(x)	(x)->instance.slots
+#define SLENGTH(x)	(x)->instance.length
+#define SLOT(x,i)	(x)->instance.slots[i]
+#define SNAME(x)	CLASS_NAME(CLASS_OF(x))
+#define STRUCTUREP(x)	(type_of(x) == t_instance && \
+			 structure_subtypep(CLASS_OF(x), Sstructure_object))
+#else
+struct structure {		/*  structure header  */
+	HEADER;
+	int16_t	length;		/*  structure length  */
+	cl_object name;		/*  structure name  */
+	cl_object *self;	/*  structure self  */
+};
+
+#define T_STRUCTURE	t_structure
+#define STYPE(x)	x->str.name
+#define SLOTS(x)	(x)->str.self
+#define SLENGTH(x)	(x)->str.length
+#define SLOT(x,i)	(x)->str.self[i]
+#define SNAME(x)	x->str.name
+#define STRUCTUREP(x)	(type_of(x) == t_structure)
+#endif
+
+enum smmode {			/*  stream mode  */
+	smm_closed,		/*  closed  */
+	smm_input,		/*  input  */
+	smm_output,		/*  output  */
+	smm_io,			/*  input-output  */
+	smm_probe,		/*  probe  */
+	smm_synonym,		/*  synonym  */
+	smm_broadcast,		/*  broadcast  */
+	smm_concatenated,	/*  concatenated  */
+	smm_two_way,		/*  two way  */
+	smm_echo,		/*  echo  */
+	smm_string_input,	/*  string input  */
+	smm_string_output	/*  string output  */
+};
+
+struct stream {
+	HEADER1(mode);		/*  stream mode of enum smmode  */
+	FILE	*file;		/*  file pointer  */
+	cl_object object0;	/*  some object  */
+	cl_object object1;	/*  some object */
+	int	int0;		/*  some int  */
+	int	int1;		/*  some int  */
+#if !defined(GBC_BOEHM)
+	char	*buffer;	/*  file buffer  */
+#endif
+};
+
+
+#define	BASEFF		(unsigned char *)0xffffffff
+
+struct random {
+	HEADER;
+	unsigned value;	/*  random state value  */
+};
+
+enum chattrib {			/*  character attribute  */
+	cat_whitespace,		/*  whitespace  */
+	cat_terminating,	/*  terminating macro  */
+	cat_non_terminating,	/*  non-terminating macro  */
+	cat_single_escape,	/*  single-escape  */
+	cat_multiple_escape,	/*  multiple-escape  */
+	cat_constituent		/*  constituent  */
+};
+
+struct readtable_entry {		/*  read table entry  */
+	enum chattrib syntax_type;	/*  character attribute  */
+	cl_object macro;		/*  macro function  */
+	cl_object *dispatch_table;	/*  pointer to the  */
+					/*  dispatch table  */
+					/*  NULL for  */
+					/*  non-dispatching  */
+					/*  macro character, or  */
+					/*  non-macro character  */
+};
+
+struct readtable {			/*  read table  */
+	HEADER;
+	struct readtable_entry	*table;	/*  read table itself  */
+};
+
+struct pathname {
+	HEADER1(logical);	/*  logical pathname?  */
+	cl_object host;		/*  host  */
+	cl_object device;	/*  device  */
+	cl_object directory;	/*  directory  */
+	cl_object name;		/*  name  */
+	cl_object type;		/*  type  */
+	cl_object version;	/*  version  */
+};
+
+struct codeblock {
+	HEADER;
+	char	*start;		/*  start address of the code  */
+	size_t	size;		/*  code size  */
+ 	cl_object *data;	/*  data vector  */
+	int	data_size;
+	const char *data_text;
+	int	data_text_size;
+#ifdef PDE
+	int	source_pathname;
+#endif
+	cl_object name;
+};
+
+struct bytecodes {
+	HEADER;
+	cl_object lex;		/*  lexical environment  */
+	cl_index size;		/*  number of bytecodes  */
+	cl_object *data;	/*  the intermediate language  */
+};
+
+struct cfun {			/*  compiled function header  */
+	HEADER;
+	cl_object name;		/*  compiled function name  */
+	cl_object (*entry)();	/*  entry address  */
+	cl_object block;	/*  descriptor of C code block for GC  */
+};
+
+struct cclosure {		/*  compiled closure header  */
+	HEADER;
+	cl_object env;		/*  environment  */
+	cl_object (*entry)();	/*  entry address  */
+	cl_object block;	/*  descriptor of C code block for GC  */
+};
+/*
+	dummy type
+*/
+struct dummy {
+	HEADER;
+};
+
+#ifdef THREADS
+struct cont {
+				/* already resumed */
+				/* timed out */
+	HEADER(resumed, timed_out);
+	cl_object thread;	/* its thread */
+};
+
+struct thread {
+	HEADER;
+	struct pd *self;	/* the thread itself (really a *pd) */
+	cl_index size;		/* its size */
+	cl_object fun;		/* initial function */
+	cl_object cont;		/* its cont */
+};
+#endif THREADS
+
+
+#ifdef CLOS
+#define CLASS_OF(x)		x->instance.class
+#define CLASS_NAME(x)		x->instance.slots[0]
+#define CLASS_SUPERIORS(x)	x->instance.slots[1]
+#define CLASS_INFERIORS(x)	x->instance.slots[2]
+#define CLASS_SLOTS(x)		x->instance.slots[3]
+#define CLASS_CPL(x)		x->instance.slots[4]
+
+struct instance {		/*  instance header  */
+	HEADER;
+	cl_index length;	/*  instance length  */
+	cl_object class;	/*  instance class  */
+	cl_object *slots;	/*  instance slots  */
+};
+
+struct gfun {			/*  generic function header  */
+	HEADER1(arg_no);	/*  number of arguments */
+	cl_object name;		/*  generic function name  */
+	cl_object method_hash;	/*  hashtable for cashing methods */
+				/*  later on we might define a  */
+				/*  specialized version */
+	cl_object *specializers;/*  how methods specialize on each argument: */
+	                        /*  NIL  means no specialization, */
+				/*  T    means specialize on type, */
+				/*  list constains the list of objects used */
+				/* 	 in eql specializers */
+	cl_object instance;	/*  the generic function object */
+};
+#endif CLOS
+
+/*
+	Definition of lispunion.
+*/
+union lispunion {
+	struct bignum	big;	/*  bignum  */
+	struct ratio	ratio;	/*  ratio  */
+	struct shortfloat_struct SF; /*  short floating-point number  */
+	struct longfloat_struct LF; /*  long floating-point number  */
+	struct complex	complex;/*  complex number  */
+	struct symbol	symbol;	/*  symbol  */
+	struct package	pack;	/*  package  */
+	struct cons	cons;	/*  cons  */
+	struct hashtable hash;	/*  hash table  */
+	struct array	array;	/*  array  */
+	struct vector	vector;	/*  vector  */
+	struct string	string;	/*  string  */
+	struct stream	stream;	/*  stream  */
+	struct random	random;	/*  random-states  */
+	struct readtable readtable; /*  read table  */
+	struct pathname	pathname; /*  path name  */
+	struct bytecodes bytecodes; /*  bytecompiled closure */
+	struct cfun	cfun;	/*  compiled function  */
+	struct cclosure	cclosure; /*  compiled closure  */
+
+	struct dummy	d;	/*  dummy  */
+#ifdef CLOS
+	struct instance instance; /*  clos instance */
+	struct gfun	gfun;	/*  generic function */
+#else
+	struct structure str;	/*  structure  */
+#endif CLOS
+#ifdef THREADS
+	struct cont     cont;	/*  continuation  */
+	struct thread   thread;	/*  thread  */
+#endif THREADS
+	struct codeblock cblock; /*  codeblock  */
+};
+
+/* Used for initalizing array of keywords for compiled functions */
+typedef union { int i; cl_object o;} intUobject;
+
+/*
+	Implementation types.
+*/
+#define cl_type type
+enum type {
+	t_cons = 0,
+#ifdef APOLLO
+	t_start = 0,
+#else
+	t_start = t_cons,
+#endif APOLLO
+	t_fixnum,		/* 1 immediate fixnum */
+	t_character,		/* 2 immediate character */
+#ifdef LOCATIVE
+	t_locative,		/* 3 locative (also used as spice) */
+	t_spice = t_locative,
+#endif
+	t_bignum = 4,		/* 4 */
+	t_ratio,		/* 5 */
+	t_shortfloat,		/* 6 */
+	t_longfloat,		/* 7 */
+	t_complex,		/* 8 */
+	t_symbol,		/* 9 */
+	t_package,		/* a */
+	t_hashtable,		/* b */
+	t_array,		/* c */
+	t_vector,		/* d */
+	t_string,		/* e */
+	t_bitvector,		/* f */
+	t_stream,		/* 10 */
+	t_random,		/* 11 */
+	t_readtable,		/* 12 */
+	t_pathname,		/* 13 */
+	t_bytecodes,		/* 14 */
+	t_cfun,			/* 15 */
+	t_cclosure,		/* 16 */
+#ifdef CLOS
+	t_instance,		/* 17 */
+	t_gfun,			/* 18 */
+#else
+	t_structure,		/* 17 */
+#endif CLOS
+#ifdef THREADS
+	t_cont,			/* 19	18 */
+	t_thread,		/* 20	19 */
+#endif
+	t_codeblock,		/* 21   20 */
+	t_end,
+	t_other,
+	t_contiguous,		/*  contiguous block  */
+	FREE = 255		/*  free object  */
+};
+
+
+/*
+	Type_of.
+*/
+#define	type_of(obje)	((enum type)(IMMEDIATE(obje) ? IMMEDIATE(obje) : (((cl_object)(obje)) ->d.t)))
+
+#define	ENDP(x)	(type_of(x) == t_cons ? \
+		 FALSE : x == Cnil ? TRUE : \
+		 (FEtype_error_list(x), FALSE))
+
+#define	endp(obje)	endp1(obje)
+
+#define	TIME_ZONE	(-1)
+
+#ifdef WORDS_BIGENDIAN
+#define HIND 0
+#define LIND 1
+#else /* little endian */
+#define HIND 1  /* (int) of double where the exponent and most signif is */
+#define LIND 0  /* low part of a double */
+#endif WORDS_BIGENDIAN
diff --git a/src/h/page.h b/src/h/page.h
new file mode 100644
index 000000000..a8b131cc5
--- /dev/null
+++ b/src/h/page.h
@@ -0,0 +1,144 @@
+/*
+    page.h  -- Page macros.
+*/
+/*
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*****************************
+ * BOEHM's GARBAGE COLLECTOR *
+ *****************************/
+
+#ifdef GBC_BOEHM
+#include "gc.h"
+
+struct typemanager {
+	const char *tm_name;
+	size_t tm_size;
+} tm_table[(int)t_end];
+
+#define	tm_of(t)	(&tm_table[(int)(t)])
+#endif GBC_BOEHM
+
+
+/****************************************
+ * ECOLISP's ORIGINAL GARBAGE COLLECTOR *
+ ****************************************/
+
+#if !defined(GBC_BOEHM)
+/* THREADS: If you make it bigger, the bug is less frequent */
+#ifdef SYSV
+#define	HOLEPAGE	32
+#else
+#define	HOLEPAGE	128
+#endif SYSV
+#define	INIT_HOLEPAGE	150
+#define	CBMINSIZE	64	/*  contiguous block minimal size  */
+
+#define page(p)		(((intptr_t)(char *)(p) / LISP_PAGESIZE) - (DATA_START/LISP_PAGESIZE))
+#define	pagetochar(x)	((char *)(((x) * LISP_PAGESIZE) + DATA_START))
+#define round_to_page(x) (((intptr_t)(x) + LISP_PAGESIZE - 1) / LISP_PAGESIZE)
+#define	round_up(n)	(((n) + 03) & ~03)
+#define	available_pages() ((size_t)(real_maxpage-page(heap_end)-new_holepage-real_maxpage/32))
+
+extern size_t real_maxpage;
+extern size_t new_holepage;
+
+/*
+	The struct of free lists.
+*/
+struct freelist {
+	HEADER;
+	cl_object	f_link;
+};
+
+/*
+	Type map.
+
+	enum type type_map[MAXPAGE];
+*/
+extern char type_map[MAXPAGE];
+
+/*
+	Storage manager for each type.
+*/
+struct typemanager {
+	enum type tm_type;	/*  type  */
+	size_t	tm_size;	/*  element size in bytes  */
+	size_t	tm_nppage;	/*  number per page  */
+	cl_object tm_free;	/*  free list  */
+				/*  Note that it is of type object.  */
+	size_t	tm_nfree;	/*  number of free elements  */
+	size_t	tm_nused;	/*  number of elements used  */
+	size_t	tm_npage;	/*  number of pages  */
+	size_t	tm_maxpage;	/*  maximum number of pages  */
+	char	*tm_name;	/*  type name  */
+	size_t	tm_gccount;	/*  GC count  */
+};
+
+/*
+	The table of type managers.
+*/
+extern struct typemanager tm_table[(int)t_end];
+
+#define	tm_of(t)	(&(tm_table[(int)tm_table[(int)(t)].tm_type]))
+
+/*
+	Contiguous block header.
+*/
+struct contblock {			/*  contiguous block header  */
+	size_t cb_size;			/*  size in bytes  */
+	struct contblock *cb_link;	/*  contiguous block link  */
+};
+
+/*
+	The pointer to the contiguous blocks.
+*/
+extern struct contblock *cb_pointer;	/*  contblock pointer  */
+
+/*
+	Variables for memory management.
+*/
+extern size_t ncb;			/*  number of contblocks  */
+extern size_t ncbpage;			/*  number of contblock pages  */
+extern size_t maxcbpage;		/*  maximum number of contblock pages  */
+extern size_t cbgccount;		/*  contblock gc count  */
+extern size_t holepage;			/*  hole pages  */
+
+extern char *heap_start;		/*  heap start  */
+extern char *heap_end;			/*  heap end  */
+extern char *data_end;			/*  core end  */
+
+#endif /* !GBC_BOEHM */
+
+/*******************************
+ * SYMBOLS & KEYWORDS DATABASE *
+ *******************************/
+
+struct symbol_info {
+  cl_object * const loc;
+  const char *name;
+  enum {
+    CL_ORDINARY,
+    CL_SPECIAL,
+    SI_SPECIAL,
+    SI_ORDINARY
+  } type;
+};
+
+extern const struct symbol_info all_symbols[];
+
+struct keyword_info {
+  cl_object * const loc;
+  const char *name;
+};
+
+extern const struct keyword_info all_keywords[];
+
diff --git a/src/h/stacks.h b/src/h/stacks.h
new file mode 100644
index 000000000..f9a448046
--- /dev/null
+++ b/src/h/stacks.h
@@ -0,0 +1,273 @@
+/*
+    stacks.h -- Bind/Jump/Frame stacks.
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/********************
+ * INTERPRETER STACK
+ ********************/
+
+extern cl_object stack;
+
+/**************
+ * BIND STACK
+ **************/
+
+typedef struct bds_bd {
+	cl_object bds_sym;	/*  symbol  */
+	cl_object bds_val;	/*  previous value of the symbol  */
+} *bds_ptr;
+
+#ifdef THREADS
+#define bds_limit       clwp->lwp_bds_limit
+#define bds_top         clwp->lwp_bds_top
+#define bds_org		clwp->lwp_bds_org
+#define bds_size	clwp->lwp_bds_size
+#else
+extern size_t bds_size;
+extern bds_ptr bds_org;
+extern bds_ptr bds_limit;
+extern bds_ptr bds_top;	/*  bind stack top  */
+#endif
+#define bind_stack      bds_org
+
+#define	bds_check  \
+	if (bds_top >= bds_limit)  \
+		bds_overflow()
+
+#define	bds_bind(sym, val)  \
+	((++bds_top)->bds_sym = (sym),  \
+	bds_top->bds_val = SYM_VAL(sym),  \
+	SYM_VAL(sym) = (val))
+
+#define bds_push(sym) \
+	((++bds_top)->bds_sym = (sym), bds_top->bds_val = SYM_VAL(sym))
+
+#define	bds_unwind1  \
+	(SYM_VAL(bds_top->bds_sym) = bds_top->bds_val, --bds_top)
+
+/****************************
+ * INVOCATION HISTORY STACK
+ ****************************/
+
+typedef struct invocation_history {
+	cl_object ihs_function;
+	cl_object ihs_base;
+} *ihs_ptr;
+
+#ifdef THREADS
+#define ihs_size	clwp->lwp_ihs_size
+#define ihs_org		clwp->lwp_ihs_org
+#define ihs_limit       clwp->lwp_ihs_limit
+#define ihs_top         clwp->lwp_ihs_top
+#else
+extern size_t ihs_size;
+extern ihs_ptr ihs_org;
+extern ihs_ptr ihs_limit;
+extern ihs_ptr ihs_top;
+#endif
+#define ihs_stack       ihs_org
+
+#define	ihs_check  \
+	if (ihs_top >= ihs_limit)  \
+		ihs_overflow()
+
+#define ihs_push(function, args) { \
+	(++ihs_top)->ihs_function = (function);  \
+	ihs_top->ihs_base = args; \
+}
+
+#define ihs_push_funcall(function) { \
+	ihs_check; \
+	(++ihs_top)->ihs_function = (function);  \
+	ihs_top->ihs_base = Cnil; \
+}
+
+#define ihs_pop() 	(ihs_top--)
+
+#define make_nil_block(r) { \
+	cl_object x;  \
+	lex_copy();  \
+	x = new_frame_id();  \
+	lex_block_bind(Cnil, x);  \
+	r = frs_push(FRS_CATCH, x);  \
+}
+
+#define BLOCK(name,output) { \
+	cl_object *lex_old = lex_env; lex_dcl; \
+	cl_object _x; \
+	lex_copy(); \
+	_x = new_frame_id(); \
+	lex_block_bind(name,_x); \
+	if (frs_push(FRS_CATCH,_x) != 0) output = Values[0]; else
+#define END_BLOCK \
+	frs_pop(); \
+	lex_env = lex_old; }
+
+/***************
+ * FRAME STACK
+ ***************/
+/*
+frs_class |            frs_value                 |  frs_prev
+----------+--------------------------------------+--------------
+CATCH     | frame-id, i.e.                       |
+	  |    throw-tag,                        |
+	  |    block-id (uninterned symbol), or  | value of ihs_top
+	  |    tagbody-id (uninterned symbol)    | when the frame
+----------+--------------------------------------| was pushed
+CATCHALL  |               NIL                    |
+----------+--------------------------------------|
+PROTECT   |               NIL                    |
+----------------------------------------------------------------
+*/
+
+enum fr_class {
+	FRS_CATCH,		/* for catch,block,tabbody */
+	FRS_CATCHALL,		/* for catchall */
+	FRS_PROTECT		/* for protect-all */
+};
+
+typedef struct frame {
+	jmp_buf		frs_jmpbuf;
+	cl_object	frs_lex;
+	bds_ptr		frs_bds_top;
+	enum fr_class	frs_class;
+	cl_object	frs_val;
+	ihs_ptr		frs_ihs;
+	cl_index	frs_sp;
+} *frame_ptr;
+
+#ifdef THREADS
+#define frs_size	clwp->lwp_frs_size
+#define frs_org		clwp->lwp_frs_org
+#define frs_limit       clwp->lwp_frs_limit
+#define frs_top         clwp->lwp_frs_top
+#else
+extern size_t frs_size;
+extern frame_ptr frs_org;
+extern frame_ptr frs_limit;
+extern frame_ptr frs_top;
+#endif
+#define frame_stack	frs_org
+
+extern frame_ptr _frs_push(register enum fr_class class, register cl_object val);
+
+#define frs_push(class, val)  ecls_setjmp(_frs_push(class, val)->frs_jmpbuf)
+
+#define frs_pop() (frs_top--)
+
+/*  global variables used during non-local jump  */
+
+#ifdef THREADS
+#define nlj_fr           clwp->lwp_nlj_fr
+#define nlj_tag          clwp->lwp_nlj_tag
+#else
+extern frame_ptr nlj_fr;	/* frame to return  */
+extern cl_object nlj_tag;	/* throw-tag, block-id, or */
+				/* (tagbody-id . label).   */
+#endif
+
+/*******************
+ * C CONTROL STACK
+ *******************/
+
+#ifdef THREADS
+#define cs_limit       clwp->lwp_cs_limit
+#define cs_org         clwp->lwp_cs_org
+#define cssize         clwp->lwp_cssize
+#else
+extern int *cs_org;
+extern int *cs_limit;
+extern size_t cssize;
+#endif THREADS
+
+#ifdef DOWN_STACK
+#define	cs_check(something) \
+	if ((int *)(&something) < cs_limit) \
+		cs_overflow()
+#else
+#define	cs_check(something) \
+	if ((int *)(&something) > cs_limit) \
+		cs_overflow()
+#endif DOWN_STACK
+
+#define	check_arg(n)  \
+			if (narg != (n))  \
+				check_arg_failed(narg, n)
+
+#define cs_reserve(x)	if(&narg-(x) < cs_limit)  \
+				cs_overflow();
+
+/***********************
+ * RETURN VALUES STACK
+ ***********************/
+
+#define VALUES(n)	Values[n]
+#define return0()	return ((NValues = 0),Cnil)
+#define return1(x)	return ((NValues = 1),(x))
+#define return2(x,y)	return ((NValues = 2),(Values[1] = (y)),(x))
+#define returnn(x)	return x
+
+#ifdef THREADS
+#error " Thread-safe NValues not yet implemented"
+extern cl_object *Values;
+#else
+extern int NValues;
+extern cl_object Values[VSSIZE];
+#endif
+
+#define MV_SAVE(nr) \
+   { int nr = NValues; cl_object mv_values[nr]; /* __GNUC__ */ \
+       memcpy(mv_values, &VALUES(0), nr * sizeof(cl_object))
+#define MV_RESTORE(nr) \
+       memcpy(&VALUES(0), mv_values, (NValues = nr) * sizeof(cl_object));}
+#define MV_SHIFT(nr, d) \
+   { int i; for (i = (nr)-1; i >= 0; i--) VALUES(i+d) = VALUES(i);}
+#define MV_VALUES(i) mv_values[i]
+
+
+/*****************************
+ * LEXICAL ENVIRONMENT STACK
+ *****************************/
+/*
+		|---------------|
+lex_env ------> |    lex-var	|	: lex_env[0]
+		|---------------|
+		|    lex-fd	|       : lex_env[1]
+		|---------------|
+		|    lex-tag	|       : lex_env[2]
+		|---------------|
+	lex-var:        (symbol value)      	; for local binding
+	or		(symbol)                ; for special binding
+
+	lex-fd:         (fun-name 'FUNCTION'   function)
+	or		(macro-name 'MACRO' expansion-function)
+
+	lex-tag:  	(tag    'TAG'  	frame-id)
+	or		(block-name 'BLOCK' frame-id)
+
+where 'FUN' is the LISP symbol with pname FUN, etc.
+*/
+
+#ifdef THREADS
+#define lex_env       clwp->lwp_lex_env
+#else
+extern cl_object lex_env;
+#endif
+
+#define lex_copy()		lex_env = CONS(car(lex_env),cdr(lex_env))
+#define lex_new()		lex_env = CONS(Cnil,Cnil)
+#define lex_var_sch(name)	assq((name),CAR(lex_env))
+#define lex_fun_sch(name)	lex_sch(CDR(lex_env),(name),Sfunction)
+#define lex_tag_sch(name)	lex_sch(CDR(lex_env),(name),Stag)
+#define lex_block_sch(name)	lex_sch(CDR(lex_env),(name),Sblock)
diff --git a/src/h/tcl.h b/src/h/tcl.h
new file mode 100644
index 000000000..f27b103b1
--- /dev/null
+++ b/src/h/tcl.h
@@ -0,0 +1,629 @@
+/*
+ * tcl.h --
+ *
+ *	This header file describes the externally-visible facilities
+ *	of the Tcl interpreter.
+ *
+ * Copyright (c) 1987-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * @(#) tcl.h 1.144 94/12/17 16:14:49
+ */
+
+#ifndef _TCL
+#define _TCL
+
+#ifndef BUFSIZ
+#include <stdio.h>
+#endif
+
+#define TCL_VERSION "7.4"
+#define TCL_MAJOR_VERSION 7
+#define TCL_MINOR_VERSION 4
+
+/*
+ * Definitions that allow this header file to be used either with or
+ * without ANSI C features like function prototypes.
+ */
+
+#undef _ANSI_ARGS_
+#undef CONST
+#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus)
+#   define _USING_PROTOTYPES_ 1
+#   define _ANSI_ARGS_(x)	x
+#   define CONST const
+#   if defined(__cplusplus) || defined(__STDC__)
+#       define VARARGS (Tcl_Interp *, ...)
+#   else
+#       define VARARGS ()
+#   endif
+#else
+#   define _ANSI_ARGS_(x)	()
+#   define CONST
+#endif
+
+#ifdef __cplusplus
+#   define EXTERN extern "C"
+#else
+#   define EXTERN extern
+#endif
+
+/*
+ * Macro to use instead of "void" for arguments that must have
+ * type "void *" in ANSI C;  maps them to type "char *" in
+ * non-ANSI systems.
+ */
+
+#ifndef VOID
+#   ifdef __STDC__
+#       define VOID void
+#   else
+#       define VOID char
+#   endif
+#endif
+
+/*
+ * Miscellaneous declarations (to allow Tcl to be used stand-alone,
+ * without the rest of Sprite).
+ */
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+#ifndef _CLIENTDATA
+#   if defined(__STDC__) || defined(__cplusplus)
+    typedef void *ClientData;
+#   else
+    typedef int *ClientData;
+#   endif /* __STDC__ */
+#define _CLIENTDATA
+#endif
+
+/*
+ * Data structures defined opaquely in this module.  The definitions
+ * below just provide dummy types.  A few fields are made visible in
+ * Tcl_Interp structures, namely those for returning string values.
+ * Note:  any change to the Tcl_Interp definition below must be mirrored
+ * in the "real" definition in tclInt.h.
+ */
+
+typedef struct Tcl_Interp{
+    char *result;		/* Points to result string returned by last
+				 * command. */
+    void (*freeProc) _ANSI_ARGS_((char *blockPtr));
+				/* Zero means result is statically allocated.
+				 * If non-zero, gives address of procedure
+				 * to invoke to free the result.  Must be
+				 * freed by Tcl_Eval before executing next
+				 * command. */
+    int errorLine;		/* When TCL_ERROR is returned, this gives
+				 * the line number within the command where
+				 * the error occurred (1 means first line). */
+} Tcl_Interp;
+
+typedef int *Tcl_Trace;
+typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
+typedef struct Tcl_RegExp_ *Tcl_RegExp;
+
+/*
+ * When a TCL command returns, the string pointer interp->result points to
+ * a string containing return information from the command.  In addition,
+ * the command procedure returns an integer value, which is one of the
+ * following:
+ *
+ * TCL_OK		Command completed normally;  interp->result contains
+ *			the command's result.
+ * TCL_ERROR		The command couldn't be completed successfully;
+ *			interp->result describes what went wrong.
+ * TCL_RETURN		The command requests that the current procedure
+ *			return;  interp->result contains the procedure's
+ *			return value.
+ * TCL_BREAK		The command requests that the innermost loop
+ *			be exited;  interp->result is meaningless.
+ * TCL_CONTINUE		Go on to the next iteration of the current loop;
+ *			interp->result is meaningless.
+ */
+
+#define TCL_OK		0
+#define TCL_ERROR	1
+#define TCL_RETURN	2
+#define TCL_BREAK	3
+#define TCL_CONTINUE	4
+
+#define TCL_RESULT_SIZE 200
+
+/*
+ * Argument descriptors for math function callbacks in expressions:
+ */
+
+typedef enum {TCL_INT, TCL_DOUBLE, TCL_EITHER} Tcl_ValueType;
+typedef struct Tcl_Value {
+    Tcl_ValueType type;		/* Indicates intValue or doubleValue is
+				 * valid, or both. */
+    int intValue;		/* Integer value. */
+    double doubleValue;		/* Double-precision floating value. */
+} Tcl_Value;
+
+/*
+ * Procedure types defined by Tcl:
+ */
+
+typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int code));
+typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int argc, char *argv[]));
+typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
+	ClientData cmdClientData, int argc, char *argv[]));
+typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr));
+typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp));
+typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr));
+typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, char *part1, char *part2, int flags));
+
+/*
+ * The structure returned by Tcl_GetCmdInfo and passed into
+ * Tcl_SetCmdInfo:
+ */
+
+typedef struct Tcl_CmdInfo {
+    Tcl_CmdProc *proc;			/* Procedure that implements command. */
+    ClientData clientData;		/* ClientData passed to proc. */
+    Tcl_CmdDeleteProc *deleteProc;	/* Procedure to call when command
+					 * is deleted. */
+    ClientData deleteData;		/* Value to pass to deleteProc (usually
+					 * the same as clientData). */
+} Tcl_CmdInfo;
+
+/*
+ * The structure defined below is used to hold dynamic strings.  The only
+ * field that clients should use is the string field, and they should
+ * never modify it.
+ */
+
+#define TCL_DSTRING_STATIC_SIZE 200
+typedef struct Tcl_DString {
+    char *string;		/* Points to beginning of string:  either
+				 * staticSpace below or a malloc'ed array. */
+    int length;			/* Number of non-NULL characters in the
+				 * string. */
+    int spaceAvl;		/* Total number of bytes available for the
+				 * string and its terminating NULL char. */
+    char staticSpace[TCL_DSTRING_STATIC_SIZE];
+				/* Space to use in common case where string
+				 * is small. */
+} Tcl_DString;
+
+#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
+#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
+#define Tcl_DStringTrunc Tcl_DStringSetLength
+
+/*
+ * Definitions for the maximum number of digits of precision that may
+ * be specified in the "tcl_precision" variable, and the number of
+ * characters of buffer space required by Tcl_PrintDouble.
+ */
+
+#define TCL_MAX_PREC 17
+#define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
+
+/*
+ * Flag that may be passed to Tcl_ConvertElement to force it not to
+ * output braces (careful!  if you change this flag be sure to change
+ * the definitions at the front of tclUtil.c).
+ */
+
+#define TCL_DONT_USE_BRACES	1
+
+/*
+ * Flag value passed to Tcl_RecordAndEval to request no evaluation
+ * (record only).
+ */
+
+#define TCL_NO_EVAL		-1
+
+/*
+ * Special freeProc values that may be passed to Tcl_SetResult (see
+ * the man page for details):
+ */
+
+#define TCL_VOLATILE	Tcl_Volatile
+#define TCL_STATIC	((Tcl_FreeProc *) 0)
+#define TCL_DYNAMIC	((Tcl_FreeProc *) free)
+
+/*
+ * Flag values passed to variable-related procedures.
+ */
+
+#define TCL_GLOBAL_ONLY		1
+#define TCL_APPEND_VALUE	2
+#define TCL_LIST_ELEMENT	4
+#define TCL_TRACE_READS		0x10
+#define TCL_TRACE_WRITES	0x20
+#define TCL_TRACE_UNSETS	0x40
+#define TCL_TRACE_DESTROYED	0x80
+#define TCL_INTERP_DESTROYED	0x100
+#define TCL_LEAVE_ERR_MSG	0x200
+
+/*
+ * Types for linked variables:
+ */
+
+#define TCL_LINK_INT		1
+#define TCL_LINK_DOUBLE		2
+#define TCL_LINK_BOOLEAN	3
+#define TCL_LINK_STRING		4
+#define TCL_LINK_READ_ONLY	0x80
+
+/*
+ * Permission flags for files:
+ */
+
+#define TCL_FILE_READABLE	1
+#define TCL_FILE_WRITABLE	2
+
+/*
+ * The following declarations either map ckalloc and ckfree to
+ * malloc and free, or they map them to procedures with all sorts
+ * of debugging hooks defined in tclCkalloc.c.
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+EXTERN char *		Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
+			    char *file, int line));
+EXTERN int		Tcl_DbCkfree _ANSI_ARGS_((char *ptr,
+			    char *file, int line));
+EXTERN char *		Tcl_DbCkrealloc _ANSI_ARGS_((char *ptr,
+			    unsigned int size, char *file, int line));
+EXTERN int		Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
+EXTERN void		Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
+			    int line));
+#  define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
+#  define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
+#  define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
+
+#else
+
+#  define ckalloc(x) malloc(x)
+#  define ckfree(x)  free(x)
+#  define ckrealloc(x,y) realloc(x,y)
+#  define Tcl_DumpActiveMemory(x)
+#  define Tcl_ValidateAllMemory(x,y)
+
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ * Macro to free up result of interpreter.
+ */
+
+#define Tcl_FreeResult(interp)					\
+    if ((interp)->freeProc != 0) {				\
+	if ((interp)->freeProc == (Tcl_FreeProc *) free) {	\
+	    ckfree((interp)->result);				\
+	} else {						\
+	    (*(interp)->freeProc)((interp)->result);		\
+	}							\
+	(interp)->freeProc = 0;					\
+    }
+
+/*
+ * Forward declaration of Tcl_HashTable.  Needed by some C++ compilers
+ * to prevent errors when the forward reference to Tcl_HashTable is
+ * encountered in the Tcl_HashEntry structure.
+ */
+
+#ifdef __cplusplus
+struct Tcl_HashTable;
+#endif
+
+/*
+ * Structure definition for an entry in a hash table.  No-one outside
+ * Tcl should access any of these fields directly;  use the macros
+ * defined below.
+ */
+
+typedef struct Tcl_HashEntry {
+    struct Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this
+					 * hash bucket, or NULL for end of
+					 * chain. */
+    struct Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
+    struct Tcl_HashEntry **bucketPtr;	/* Pointer to bucket that points to
+					 * first entry in this entry's chain:
+					 * used for deleting the entry. */
+    ClientData clientData;		/* Application stores something here
+					 * with Tcl_SetHashValue. */
+    union {				/* Key has one of these forms: */
+	char *oneWordValue;		/* One-word value for key. */
+	int words[1];			/* Multiple integer words for key.
+					 * The actual size will be as large
+					 * as necessary for this table's
+					 * keys. */
+	char string[4];			/* String for key.  The actual size
+					 * will be as large as needed to hold
+					 * the key. */
+    } key;				/* MUST BE LAST FIELD IN RECORD!! */
+} Tcl_HashEntry;
+
+/*
+ * Structure definition for a hash table.  Must be in tcl.h so clients
+ * can allocate space for these structures, but clients should never
+ * access any fields in this structure.
+ */
+
+#define TCL_SMALL_HASH_TABLE 4
+typedef struct Tcl_HashTable {
+    Tcl_HashEntry **buckets;		/* Pointer to bucket array.  Each
+					 * element points to first entry in
+					 * bucket's hash chain, or NULL. */
+    Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
+					/* Bucket array used for small tables
+					 * (to avoid mallocs and frees). */
+    int numBuckets;			/* Total number of buckets allocated
+					 * at **bucketPtr. */
+    int numEntries;			/* Total number of entries present
+					 * in table. */
+    int rebuildSize;			/* Enlarge table when numEntries gets
+					 * to be this large. */
+    int downShift;			/* Shift count used in hashing
+					 * function.  Designed to use high-
+					 * order bits of randomized keys. */
+    int mask;				/* Mask value used in hashing
+					 * function. */
+    int keyType;			/* Type of keys used in this table. 
+					 * It's either TCL_STRING_KEYS,
+					 * TCL_ONE_WORD_KEYS, or an integer
+					 * giving the number of ints in a
+					 */
+    Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+	    char *key));
+    Tcl_HashEntry *(*createProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+	    char *key, int *newPtr));
+} Tcl_HashTable;
+
+/*
+ * Structure definition for information used to keep track of searches
+ * through hash tables:
+ */
+
+typedef struct Tcl_HashSearch {
+    Tcl_HashTable *tablePtr;		/* Table being searched. */
+    int nextIndex;			/* Index of next bucket to be
+					 * enumerated after present one. */
+    Tcl_HashEntry *nextEntryPtr;	/* Next entry to be enumerated in the
+					 * the current bucket. */
+} Tcl_HashSearch;
+
+/*
+ * Acceptable key types for hash tables:
+ */
+
+#define TCL_STRING_KEYS		0
+#define TCL_ONE_WORD_KEYS	1
+
+/*
+ * Macros for clients to use to access fields of hash entries:
+ */
+
+#define Tcl_GetHashValue(h) ((h)->clientData)
+#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
+#define Tcl_GetHashKey(tablePtr, h) \
+    ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) ? (h)->key.oneWordValue \
+						: (h)->key.string))
+
+/*
+ * Macros to use for clients to use to invoke find and create procedures
+ * for hash tables:
+ */
+
+#define Tcl_FindHashEntry(tablePtr, key) \
+	(*((tablePtr)->findProc))(tablePtr, key)
+#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
+	(*((tablePtr)->createProc))(tablePtr, key, newPtr)
+
+/*
+ * Exported Tcl variables:
+ */
+
+EXTERN int		tcl_AsyncReady;
+EXTERN void		(*tcl_FileCloseProc) _ANSI_ARGS_((FILE *f));
+EXTERN char *		tcl_RcFileName;
+
+/*
+ * Exported Tcl procedures:
+ */
+
+EXTERN void		Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *message));
+EXTERN void		Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
+EXTERN void		Tcl_AppendResult _ANSI_ARGS_(VARARGS);
+EXTERN int		Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
+EXTERN Tcl_AsyncHandler	Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc *proc,
+			    ClientData clientData));
+EXTERN void		Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async));
+EXTERN int		Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+			    int code));
+EXTERN char		Tcl_Backslash _ANSI_ARGS_((char *src,
+			    int *readPtr));
+EXTERN void		Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_InterpDeleteProc *proc,
+			    ClientData clientData));
+EXTERN int		Tcl_CommandComplete _ANSI_ARGS_((char *cmd));
+EXTERN char *		Tcl_Concat _ANSI_ARGS_((int argc, char **argv));
+EXTERN int		Tcl_ConvertElement _ANSI_ARGS_((char *src,
+			    char *dst, int flags));
+EXTERN void		Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName, Tcl_CmdProc *proc,
+			    ClientData clientData,
+			    Tcl_CmdDeleteProc *deleteProc));
+EXTERN Tcl_Interp *	Tcl_CreateInterp _ANSI_ARGS_((void));
+EXTERN void		Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, int numArgs, Tcl_ValueType *argTypes,
+			    Tcl_MathProc *proc, ClientData clientData));
+EXTERN int		Tcl_CreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv, int **pidArrayPtr,
+			    int *inPipePtr, int *outPipePtr,
+			    int *errFilePtr));
+EXTERN Tcl_Trace	Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp *interp,
+			    int level, Tcl_CmdTraceProc *proc,
+			    ClientData clientData));
+EXTERN int		Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName));
+EXTERN void		Tcl_DeleteHashEntry _ANSI_ARGS_((
+			    Tcl_HashEntry *entryPtr));
+EXTERN void		Tcl_DeleteHashTable _ANSI_ARGS_((
+			    Tcl_HashTable *tablePtr));
+EXTERN void		Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Trace trace));
+EXTERN void		Tcl_DetachPids _ANSI_ARGS_((int numPids, int *pidPtr));
+EXTERN void		Tcl_DontCallWhenDeleted _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
+			    ClientData clientData));
+EXTERN char *		Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString *dsPtr,
+			    char *string, int length));
+EXTERN char *		Tcl_DStringAppendElement _ANSI_ARGS_((
+			    Tcl_DString *dsPtr, char *string));
+EXTERN void		Tcl_DStringEndSublist _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringFree _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringGetResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringInit _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringSetLength _ANSI_ARGS_((Tcl_DString *dsPtr,
+			    int length));
+EXTERN void		Tcl_DStringStartSublist _ANSI_ARGS_((
+			    Tcl_DString *dsPtr));
+EXTERN void		Tcl_EnterFile _ANSI_ARGS_((Tcl_Interp *interp,
+			    FILE *file, int permissions));
+EXTERN char *		Tcl_ErrnoId _ANSI_ARGS_((void));
+EXTERN int		Tcl_Eval _ANSI_ARGS_((Tcl_Interp *interp, char *cmd));
+EXTERN int		Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *fileName));
+EXTERN int		Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *ptr));
+EXTERN int		Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, double *ptr));
+EXTERN int		Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, long *ptr));
+EXTERN int		Tcl_ExprString _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
+EXTERN int		Tcl_FilePermissions _ANSI_ARGS_((FILE *file));
+EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry _ANSI_ARGS_((
+			    Tcl_HashTable *tablePtr,
+			    Tcl_HashSearch *searchPtr));
+EXTERN int		Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *boolPtr));
+EXTERN int		Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName, Tcl_CmdInfo *infoPtr));
+EXTERN int		Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, double *doublePtr));
+EXTERN int		Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *intPtr));
+EXTERN int		Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int write, int checkUsage,
+			    FILE **filePtr));
+EXTERN char *		Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags));
+EXTERN char *		Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags));
+EXTERN int		Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *command));
+EXTERN char *		Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable *tablePtr));
+EXTERN int		Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_InitHashTable _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    int keyType));
+EXTERN void		Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, char *addr, int type));
+EXTERN void		Tcl_Main _ANSI_ARGS_((int argc, char **argv));
+EXTERN char *		Tcl_Merge _ANSI_ARGS_((int argc, char **argv));
+EXTERN Tcl_HashEntry *	Tcl_NextHashEntry _ANSI_ARGS_((
+			    Tcl_HashSearch *searchPtr));
+EXTERN char *		Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char **termPtr));
+EXTERN char *		Tcl_PosixError _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp *interp,
+			    double value, char *dst));
+EXTERN void		Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
+EXTERN int		Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmd, int flags));
+EXTERN Tcl_RegExp	Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
+EXTERN int		Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_RegExp regexp, char *string, char *start));
+EXTERN int		Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *pattern));
+EXTERN void		Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
+			    int index, char **startPtr, char **endPtr));
+EXTERN void		Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
+#define Tcl_Return Tcl_SetResult
+EXTERN int		Tcl_ScanElement _ANSI_ARGS_((char *string,
+			    int *flagPtr));
+EXTERN int		Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName, Tcl_CmdInfo *infoPtr));
+EXTERN void		Tcl_SetErrorCode _ANSI_ARGS_(VARARGS);
+EXTERN int		Tcl_SetRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
+			    int depth));
+EXTERN void		Tcl_SetResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, Tcl_FreeProc *freeProc));
+EXTERN char *		Tcl_SetVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, char *newValue, int flags));
+EXTERN char *		Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, char *newValue,
+			    int flags));
+EXTERN char *		Tcl_SignalId _ANSI_ARGS_((int sig));
+EXTERN char *		Tcl_SignalMsg _ANSI_ARGS_((int sig));
+EXTERN int		Tcl_SplitList _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *list, int *argcPtr, char ***argvPtr));
+EXTERN int		Tcl_StringMatch _ANSI_ARGS_((char *string,
+			    char *pattern));
+EXTERN char *		Tcl_TildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, Tcl_DString *bufferPtr));
+EXTERN int		Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags, Tcl_VarTraceProc *proc,
+			    ClientData clientData));
+EXTERN int		Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags,
+			    Tcl_VarTraceProc *proc, ClientData clientData));
+EXTERN void		Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName));
+EXTERN int		Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags));
+EXTERN int		Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags));
+EXTERN void		Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags, Tcl_VarTraceProc *proc,
+			    ClientData clientData));
+EXTERN void		Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags,
+			    Tcl_VarTraceProc *proc, ClientData clientData));
+EXTERN int		Tcl_UpVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *frameName, char *varName,
+			    char *localName, int flags));
+EXTERN int		Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *frameName, char *part1, char *part2,
+			    char *localName, int flags));
+EXTERN int		Tcl_VarEval _ANSI_ARGS_(VARARGS);
+EXTERN ClientData	Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags,
+			    Tcl_VarTraceProc *procPtr,
+			    ClientData prevClientData));
+EXTERN ClientData	Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags,
+			    Tcl_VarTraceProc *procPtr,
+			    ClientData prevClientData));
+EXTERN void		Tcl_Volatile _ANSI_ARGS_((char *blockPtr));
+
+#endif /* _TCL */
diff --git a/src/h/tclInt.h b/src/h/tclInt.h
new file mode 100644
index 000000000..ec3e5ce53
--- /dev/null
+++ b/src/h/tclInt.h
@@ -0,0 +1,920 @@
+/*
+ * tclInt.h --
+ *
+ *	Declarations of things used internally by the Tcl interpreter.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * @(#) tclInt.h 1.100 94/12/17 16:14:51
+ */
+
+#ifndef _TCLINT
+#define _TCLINT
+
+/*
+ * Common include files needed by most of the Tcl source files are
+ * included here, so that system-dependent personalizations for the
+ * include files only have to be made in once place.  This results
+ * in a few extra includes, but greater modularity.  The order of
+ * the three groups of #includes is important.  For example, stdio.h
+ * is needed by tcl.h, and the _ANSI_ARGS_ declaration in tcl.h is
+ * needed by stdlib.h in some configurations.
+ */
+
+#include <stdio.h>
+
+#ifndef _TCL
+#include "tcl.h"
+#endif
+#ifndef _REGEXP
+#include "tclRegexp.h"
+#endif
+
+#include <ctype.h>
+#ifdef NO_LIMITS_H
+#   include "compat/limits.h"
+#else
+#   include <limits.h>
+#endif
+#ifdef NO_STDLIB_H
+#   include "compat/stdlib.h"
+#else
+#   include <stdlib.h>
+#endif
+#ifdef NO_STRING_H
+#include "compat/string.h"
+#else
+#include <string.h>
+#endif
+/* #include <varargs.h>		Beppe */
+
+/*
+ * At present (12/91) not all stdlib.h implementations declare strtod.
+ * The declaration below is here to ensure that it's declared, so that
+ * the compiler won't take the default approach of assuming it returns
+ * an int.  There's no ANSI prototype for it because there would end
+ * up being too many conflicts with slightly-different prototypes.
+ */
+
+extern double strtod();
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to variables.   These are used primarily
+ * in tclVar.c
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The following structure defines a variable trace, which is used to
+ * invoke a specific C procedure whenever certain operations are performed
+ * on a variable.
+ */
+
+typedef struct VarTrace {
+    Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given
+				 * by flags are performed on variable. */
+    ClientData clientData;	/* Argument to pass to proc. */
+    int flags;			/* What events the trace procedure is
+				 * interested in:  OR-ed combination of
+				 * TCL_TRACE_READS, TCL_TRACE_WRITES, and
+				 * TCL_TRACE_UNSETS. */
+    struct VarTrace *nextPtr;	/* Next in list of traces associated with
+				 * a particular variable. */
+} VarTrace;
+
+/*
+ * When a variable trace is active (i.e. its associated procedure is
+ * executing), one of the following structures is linked into a list
+ * associated with the variable's interpreter.  The information in
+ * the structure is needed in order for Tcl to behave reasonably
+ * if traces are deleted while traces are active.
+ */
+
+typedef struct ActiveVarTrace {
+    struct Var *varPtr;		/* Variable that's being traced. */
+    struct ActiveVarTrace *nextPtr;
+				/* Next in list of all active variable
+				 * traces for the interpreter, or NULL
+				 * if no more. */
+    VarTrace *nextTracePtr;	/* Next trace to check after current
+				 * trace procedure returns;  if this
+				 * trace gets deleted, must update pointer
+				 * to avoid using free'd memory. */
+} ActiveVarTrace;
+
+/*
+ * The following structure describes an enumerative search in progress on
+ * an array variable;  this are invoked with options to the "array"
+ * command.
+ */
+
+typedef struct ArraySearch {
+    int id;			/* Integer id used to distinguish among
+				 * multiple concurrent searches for the
+				 * same array. */
+    struct Var *varPtr;		/* Pointer to array variable that's being
+				 * searched. */
+    Tcl_HashSearch search;	/* Info kept by the hash module about
+				 * progress through the array. */
+    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element
+				 * to be enumerated (it's leftover from
+				 * the Tcl_FirstHashEntry call or from
+				 * an "array anymore" command).  NULL
+				 * means must call Tcl_NextHashEntry
+				 * to get value to return. */
+    struct ArraySearch *nextPtr;/* Next in list of all active searches
+				 * for this variable, or NULL if this is
+				 * the last one. */
+} ArraySearch;
+
+/*
+ * The structure below defines a variable, which associates a string name
+ * with a string value.  Pointers to these structures are kept as the
+ * values of hash table entries, and the name of each variable is stored
+ * in the hash entry.
+ */
+
+typedef struct Var {
+    int valueLength;		/* Holds the number of non-null bytes
+				 * actually occupied by the variable's
+				 * current value in value.string (extra
+				 * space is sometimes left for expansion).
+				 * For array and global variables this is
+				 * meaningless. */
+    int valueSpace;		/* Total number of bytes of space allocated
+				 * at value.string.  0 means there is no
+				 * space allocated. */
+    union {
+	char *string;		/* String value of variable, used for scalar
+				 * variables and array elements.  Malloc-ed. */
+	Tcl_HashTable *tablePtr;/* For array variables, this points to
+				 * information about the hash table used
+				 * to implement the associative array. 
+				 * Points to malloc-ed data. */
+	struct Var *upvarPtr;	/* If this is a global variable being
+				 * referred to in a procedure, or a variable
+				 * created by "upvar", this field points to
+				 * the record for the higher-level variable. */
+    } value;
+    Tcl_HashEntry *hPtr;	/* Hash table entry that refers to this
+				 * variable, or NULL if the variable has
+				 * been detached from its hash table (e.g.
+				 * an array is deleted, but some of its
+				 * elements are still referred to in upvars). */
+    int refCount;		/* Counts number of active uses of this
+				 * variable, not including its main hash
+				 * table entry: 1 for each additional variable
+				 * whose upVarPtr points here, 1 for each
+				 * nested trace active on variable.  This
+				 * record can't be deleted until refCount
+				 * becomes 0. */
+    VarTrace *tracePtr;		/* First in list of all traces set for this
+				 * variable. */
+    ArraySearch *searchPtr;	/* First in list of all searches active
+				 * for this variable, or NULL if none. */
+    int flags;			/* Miscellaneous bits of information about
+				 * variable.  See below for definitions. */
+} Var;
+
+/*
+ * Flag bits for variables:
+ *
+ * VAR_ARRAY	-		1 means this is an array variable rather
+ *				than a scalar variable.
+ * VAR_UPVAR - 			1 means this variable just contains a
+ *				pointer to another variable that has the
+ *				real value.  Variables like this come
+ *				about through the "upvar" and "global"
+ *				commands.
+ * VAR_UNDEFINED -		1 means that the variable is currently
+ *				undefined.  Undefined variables usually
+ *				go away completely, but if an undefined
+ *				variable has a trace on it, or if it is
+ *				a global variable being used by a procedure,
+ *				then it stays around even when undefined.
+ * VAR_TRACE_ACTIVE -		1 means that trace processing is currently
+ *				underway for a read or write access, so
+ *				new read or write accesses should not cause
+ *				trace procedures to be called and the
+ *				variable can't be deleted.
+ */
+
+#define VAR_ARRAY		1
+#define VAR_UPVAR		2
+#define VAR_UNDEFINED		4
+#define VAR_TRACE_ACTIVE	0x10
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to procedures.   These are used primarily
+ * in tclProc.c
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The structure below defines an argument to a procedure, which
+ * consists of a name and an (optional) default value.
+ */
+
+typedef struct Arg {
+    struct Arg *nextPtr;	/* Next argument for this procedure,
+				 * or NULL if this is the last argument. */
+    char *defValue;		/* Pointer to arg's default value, or NULL
+				 * if no default value. */
+    char name[4];		/* Name of argument starts here.  The name
+				 * is followed by space for the default,
+				 * if there is one.  The actual size of this
+				 * field will be as large as necessary to
+				 * hold both name and default value.  THIS
+				 * MUST BE THE LAST FIELD IN THE STRUCTURE!! */
+} Arg;
+
+/*
+ * The structure below defines a command procedure, which consists of
+ * a collection of Tcl commands plus information about arguments and
+ * variables.
+ */
+
+typedef struct Proc {
+    struct Interp *iPtr;	/* Interpreter for which this command
+				 * is defined. */
+    int refCount;		/* Reference count:  1 if still present
+				 * in command table plus 1 for each call
+				 * to the procedure that is currently
+				 * active.  This structure can be freed
+				 * when refCount becomes zero. */
+    char *command;		/* Command that constitutes the body of
+				 * the procedure (dynamically allocated). */
+    Arg *argPtr;		/* Pointer to first of procedure's formal
+				 * arguments, or NULL if none. */
+} Proc;
+
+/*
+ * The structure below defines a command trace.  This is used to allow Tcl
+ * clients to find out whenever a command is about to be executed.
+ */
+
+typedef struct Trace {
+    int level;			/* Only trace commands at nesting level
+				 * less than or equal to this. */
+    Tcl_CmdTraceProc *proc;	/* Procedure to call to trace command. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+    struct Trace *nextPtr;	/* Next in list of traces for this interp. */
+} Trace;
+
+/*
+ * The stucture below defines a deletion callback, which is
+ * a procedure to invoke just before an interpreter is deleted.
+ */
+
+typedef struct DeleteCallback {
+    Tcl_InterpDeleteProc *proc;	/* Procedure to call. */
+    ClientData clientData;	/* Value to pass to procedure. */
+    struct DeleteCallback *nextPtr;
+				/* Next in list of callbacks for this
+				 * interpreter (or NULL for end of list). */
+} DeleteCallback;
+
+/*
+ * The structure below defines a frame, which is a procedure invocation.
+ * These structures exist only while procedures are being executed, and
+ * provide a sort of call stack.
+ */
+
+typedef struct CallFrame {
+    Tcl_HashTable varTable;	/* Hash table containing all of procedure's
+				 * local variables. */
+    int level;			/* Level of this procedure, for "uplevel"
+				 * purposes (i.e. corresponds to nesting of
+				 * callerVarPtr's, not callerPtr's).  1 means
+				 * outer-most procedure, 0 means top-level. */
+    int argc;			/* This and argv below describe name and
+				 * arguments for this procedure invocation. */
+    char **argv;		/* Array of arguments. */
+    struct CallFrame *callerPtr;
+				/* Value of interp->framePtr when this
+				 * procedure was invoked (i.e. next in
+				 * stack of all active procedures). */
+    struct CallFrame *callerVarPtr;
+				/* Value of interp->varFramePtr when this
+				 * procedure was invoked (i.e. determines
+				 * variable scoping within caller;  same
+				 * as callerPtr unless an "uplevel" command
+				 * or something equivalent was active in
+				 * the caller). */
+} CallFrame;
+
+/*
+ * The structure below defines one history event (a previously-executed
+ * command that can be re-executed in whole or in part).
+ */
+
+typedef struct {
+    char *command;		/* String containing previously-executed
+				 * command. */
+    int bytesAvl;		/* Total # of bytes available at *event (not
+				 * all are necessarily in use now). */
+} HistoryEvent;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to history.   These are used primarily
+ * in tclHistory.c
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The structure below defines a pending revision to the most recent
+ * history event.  Changes are linked together into a list and applied
+ * during the next call to Tcl_RecordHistory.  See the comments at the
+ * beginning of tclHistory.c for information on revisions.
+ */
+
+typedef struct HistoryRev {
+    int firstIndex;		/* Index of the first byte to replace in
+				 * current history event. */
+    int lastIndex;		/* Index of last byte to replace in
+				 * current history event. */
+    int newSize;		/* Number of bytes in newBytes. */
+    char *newBytes;		/* Replacement for the range given by
+				 * firstIndex and lastIndex. */
+    struct HistoryRev *nextPtr;	/* Next in chain of revisions to apply, or
+				 * NULL for end of list. */
+} HistoryRev;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to files.  These are used primarily in
+ * tclUnixUtil.c and tclUnixAZ.c.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The data structure below defines an open file (or connection to
+ * a process pipeline) as returned by the "open" command.
+ */
+
+typedef struct OpenFile {
+    FILE *f;			/* Stdio file to use for reading and/or
+				 * writing. */
+    FILE *f2;			/* Normally NULL.  In the special case of
+				 * a command pipeline with pipes for both
+				 * input and output, this is a stdio file
+				 * to use for writing to the pipeline. */
+    int permissions;		/* OR-ed combination of TCL_FILE_READABLE
+				 * and TCL_FILE_WRITABLE. */
+    int numPids;		/* If this is a connection to a process
+				 * pipeline, gives number of processes
+				 * in pidPtr array below;  otherwise it
+				 * is 0. */
+    int *pidPtr;		/* Pointer to malloc-ed array of child
+				 * process ids (numPids of them), or NULL
+				 * if this isn't a connection to a process
+				 * pipeline. */
+    int errorId;		/* File id of file that receives error
+				 * output from pipeline.  -1 means not
+				 * used (i.e. this is a normal file). */
+} OpenFile;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to expressions.  These are used only in
+ * tclExpr.c.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The data structure below defines a math function (e.g. sin or hypot)
+ * for use in Tcl expressions.
+ */
+
+#define MAX_MATH_ARGS 5
+typedef struct MathFunc {
+    int numArgs;		/* Number of arguments for function. */
+    Tcl_ValueType argTypes[MAX_MATH_ARGS];
+				/* Acceptable types for each argument. */
+    Tcl_MathProc *proc;		/* Procedure that implements this function. */
+    ClientData clientData;	/* Additional argument to pass to the function
+				 * when invoking it. */
+} MathFunc;
+
+/*
+ *----------------------------------------------------------------
+ * This structure defines an interpreter, which is a collection of
+ * commands plus other state information related to interpreting
+ * commands, such as variable storage.  Primary responsibility for
+ * this data structure is in tclBasic.c, but almost every Tcl
+ * source file uses something in here.
+ *----------------------------------------------------------------
+ */
+
+typedef struct Command {
+    Tcl_CmdProc *proc;		/* Procedure to process command. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+    Tcl_CmdDeleteProc *deleteProc;
+				/* Procedure to invoke when deleting
+				 * command. */
+    ClientData deleteData;	/* Arbitrary value to pass to deleteProc
+				 * (usually the same as clientData). */
+} Command;
+
+#define CMD_SIZE(nameLength) ((unsigned) sizeof(Command) + nameLength - 3)
+
+typedef struct Interp {
+
+    /*
+     * Note:  the first three fields must match exactly the fields in
+     * a Tcl_Interp struct (see tcl.h).  If you change one, be sure to
+     * change the other.
+     */
+
+    char *result;		/* Points to result returned by last
+				 * command. */
+    Tcl_FreeProc *freeProc;	/* Zero means result is statically allocated.
+				 * If non-zero, gives address of procedure
+				 * to invoke to free the result.  Must be
+				 * freed by Tcl_Eval before executing next
+				 * command. */
+    int errorLine;		/* When TCL_ERROR is returned, this gives
+				 * the line number within the command where
+				 * the error occurred (1 means first line). */
+    Tcl_HashTable commandTable;	/* Contains all of the commands currently
+				 * registered in this interpreter.  Indexed
+				 * by strings; values have type (Command *). */
+    Tcl_HashTable mathFuncTable;/* Contains all of the math functions currently
+				 * defined for the interpreter.  Indexed by
+				 * strings (function names);  values have
+				 * type (MathFunc *). */
+
+    /*
+     * Information related to procedures and variables.  See tclProc.c
+     * and tclvar.c for usage.
+     */
+
+    Tcl_HashTable globalTable;	/* Contains all global variables for
+				 * interpreter. */
+    int numLevels;		/* Keeps track of how many nested calls to
+				 * Tcl_Eval are in progress for this
+				 * interpreter.  It's used to delay deletion
+				 * of the table until all Tcl_Eval invocations
+				 * are completed. */
+    int maxNestingDepth;	/* If numLevels exceeds this value then Tcl
+				 * assumes that infinite recursion has
+				 * occurred and it generates an error. */
+    CallFrame *framePtr;	/* Points to top-most in stack of all nested
+				 * procedure invocations.  NULL means there
+				 * are no active procedures. */
+    CallFrame *varFramePtr;	/* Points to the call frame whose variables
+				 * are currently in use (same as framePtr
+				 * unless an "uplevel" command is being
+				 * executed).  NULL means no procedure is
+				 * active or "uplevel 0" is being exec'ed. */
+    ActiveVarTrace *activeTracePtr;
+				/* First in list of active traces for interp,
+				 * or NULL if no active traces. */
+    int returnCode;		/* Completion code to return if current
+				 * procedure exits with a TCL_RETURN code. */
+    char *errorInfo;		/* Value to store in errorInfo if returnCode
+				 * is TCL_ERROR.  Malloc'ed, may be NULL */
+    char *errorCode;		/* Value to store in errorCode if returnCode
+				 * is TCL_ERROR.  Malloc'ed, may be NULL */
+
+    /*
+     * Information related to history:
+     */
+
+    int numEvents;		/* Number of previously-executed commands
+				 * to retain. */
+    HistoryEvent *events;	/* Array containing numEvents entries
+				 * (dynamically allocated). */
+    int curEvent;		/* Index into events of place where current
+				 * (or most recent) command is recorded. */
+    int curEventNum;		/* Event number associated with the slot
+				 * given by curEvent. */
+    HistoryRev *revPtr;		/* First in list of pending revisions. */
+    char *historyFirst;		/* First char. of current command executed
+				 * from history module or NULL if none. */
+    int revDisables;		/* 0 means history revision OK;  > 0 gives
+				 * a count of number of times revision has
+				 * been disabled. */
+    char *evalFirst;		/* If TCL_RECORD_BOUNDS flag set, Tcl_Eval
+				 * sets this field to point to the first
+				 * char. of text from which the current
+				 * command came.  Otherwise Tcl_Eval sets
+				 * this to NULL. */
+    char *evalLast;		/* Similar to evalFirst, except points to
+				 * last character of current command. */
+
+    /*
+     * Information used by Tcl_AppendResult to keep track of partial
+     * results.  See Tcl_AppendResult code for details.
+     */
+
+    char *appendResult;		/* Storage space for results generated
+				 * by Tcl_AppendResult.  Malloc-ed.  NULL
+				 * means not yet allocated. */
+    int appendAvl;		/* Total amount of space available at
+				 * partialResult. */
+    int appendUsed;		/* Number of non-null bytes currently
+				 * stored at partialResult. */
+
+    /*
+     * A cache of compiled regular expressions.  See Tcl_RegExpCompile
+     * in tclUtil.c for details.
+     */
+
+#define NUM_REGEXPS 5
+    char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled
+				 * regular expression patterns.  NULL
+				 * means that this slot isn't used.
+				 * Malloc-ed. */
+    int patLengths[NUM_REGEXPS];/* Number of non-null characters in
+				 * corresponding entry in patterns.
+				 * -1 means entry isn't used. */
+    regexp *regexps[NUM_REGEXPS];
+				/* Compiled forms of above strings.  Also
+				 * malloc-ed, or NULL if not in use yet. */
+
+    /*
+     * Information used by Tcl_PrintDouble:
+     */
+
+    char pdFormat[10];		/* Format string used by Tcl_PrintDouble. */
+    int pdPrec;			/* Current precision (used to restore the
+				 * the tcl_precision variable after a bogus
+				 * value has been put into it). */
+
+    /*
+     * Miscellaneous information:
+     */
+
+    int cmdCount;		/* Total number of times a command procedure
+				 * has been called for this interpreter. */
+    int noEval;			/* Non-zero means no commands should actually
+				 * be executed:  just parse only.  Used in
+				 * expressions when the result is already
+				 * determined. */
+    int evalFlags;		/* Flags to control next call to Tcl_Eval.
+				 * Normally zero, but may be set before
+				 * calling Tcl_Eval.  See below for valid
+				 * values. */
+    char *termPtr;		/* Character just after the last one in
+				 * a command.  Set by Tcl_Eval before
+				 * returning. */
+    char *scriptFile;		/* NULL means there is no nested source
+				 * command active;  otherwise this points to
+				 * the name of the file being sourced (it's
+				 * not malloc-ed:  it points to an argument
+				 * to Tcl_EvalFile. */
+    int flags;			/* Various flag bits.  See below. */
+    Trace *tracePtr;		/* List of traces for this interpreter. */
+    DeleteCallback *deleteCallbackPtr;
+				/* First in list of callbacks to invoke when
+				 * interpreter is deleted. */
+    char resultSpace[TCL_RESULT_SIZE+1];
+				/* Static space for storing small results. */
+} Interp;
+
+/*
+ * EvalFlag bits for Interp structures:
+ *
+ * TCL_BRACKET_TERM	1 means that the current script is terminated by
+ *			a close bracket rather than the end of the string.
+ * TCL_RECORD_BOUNDS	Tells Tcl_Eval to record information in the
+ *			evalFirst and evalLast fields for each command
+ *			executed directly from the string (top-level
+ *			commands and those from command substitution).
+ * TCL_ALLOW_EXCEPTIONS	1 means it's OK for the script to terminate with
+ *			a code other than TCL_OK or TCL_ERROR;  0 means
+ *			codes other than these should be turned into errors.
+ */
+
+#define TCL_BRACKET_TERM	1
+#define TCL_RECORD_BOUNDS	2
+#define TCL_ALLOW_EXCEPTIONS	4
+
+/*
+ * Flag bits for Interp structures:
+ *
+ * DELETED:		Non-zero means the interpreter has been deleted:
+ *			don't process any more commands for it, and destroy
+ *			the structure as soon as all nested invocations of
+ *			Tcl_Eval are done.
+ * ERR_IN_PROGRESS:	Non-zero means an error unwind is already in progress.
+ *			Zero means a command proc has been invoked since last
+ *			error occured.
+ * ERR_ALREADY_LOGGED:	Non-zero means information has already been logged
+ *			in $errorInfo for the current Tcl_Eval instance,
+ *			so Tcl_Eval needn't log it (used to implement the
+ *			"error message log" command).
+ * ERROR_CODE_SET:	Non-zero means that Tcl_SetErrorCode has been
+ *			called to record information for the current
+ *			error.  Zero means Tcl_Eval must clear the
+ *			errorCode variable if an error is returned.
+ * EXPR_INITIALIZED:	1 means initialization specific to expressions has
+ *			been carried out.
+ */
+
+#define DELETED			1
+#define ERR_IN_PROGRESS		2
+#define ERR_ALREADY_LOGGED	4
+#define ERROR_CODE_SET		8
+#define EXPR_INITIALIZED	0x10
+
+/*
+ * Default value for the pdPrec and pdFormat fields of interpreters:
+ */
+
+#define DEFAULT_PD_PREC 6
+#define DEFAULT_PD_FORMAT "%g"
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to command parsing.   These are used in
+ * tclParse.c and its clients.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The following data structure is used by various parsing procedures
+ * to hold information about where to store the results of parsing
+ * (e.g. the substituted contents of a quoted argument, or the result
+ * of a nested command).  At any given time, the space available
+ * for output is fixed, but a procedure may be called to expand the
+ * space available if the current space runs out.
+ */
+
+typedef struct ParseValue {
+    char *buffer;		/* Address of first character in
+				 * output buffer. */
+    char *next;			/* Place to store next character in
+				 * output buffer. */
+    char *end;			/* Address of the last usable character
+				 * in the buffer. */
+    void (*expandProc) _ANSI_ARGS_((struct ParseValue *pvPtr, int needed));
+				/* Procedure to call when space runs out;
+				 * it will make more space. */
+    ClientData clientData;	/* Arbitrary information for use of
+				 * expandProc. */
+} ParseValue;
+
+/*
+ * A table used to classify input characters to assist in parsing
+ * Tcl commands.  The table should be indexed with a signed character
+ * using the CHAR_TYPE macro.  The character may have a negative
+ * value.
+ */
+
+extern char tclTypeTable[];
+#define CHAR_TYPE(c) (tclTypeTable+128)[c]
+
+/*
+ * Possible values returned by CHAR_TYPE:
+ *
+ * TCL_NORMAL -		All characters that don't have special significance
+ *			to the Tcl language.
+ * TCL_SPACE -		Character is space, tab, or return.
+ * TCL_COMMAND_END -	Character is newline or null or semicolon or
+ *			close-bracket.
+ * TCL_QUOTE -		Character is a double-quote.
+ * TCL_OPEN_BRACKET -	Character is a "[".
+ * TCL_OPEN_BRACE -	Character is a "{".
+ * TCL_CLOSE_BRACE -	Character is a "}".
+ * TCL_BACKSLASH -	Character is a "\".
+ * TCL_DOLLAR -		Character is a "$".
+ */
+
+#define TCL_NORMAL		0
+#define TCL_SPACE		1
+#define TCL_COMMAND_END		2
+#define TCL_QUOTE		3
+#define TCL_OPEN_BRACKET	4
+#define TCL_OPEN_BRACE		5
+#define TCL_CLOSE_BRACE		6
+#define TCL_BACKSLASH		7
+#define TCL_DOLLAR		8
+
+/*
+ * Maximum number of levels of nesting permitted in Tcl commands (used
+ * to catch infinite recursion).
+ */
+
+#define MAX_NESTING_DEPTH	1000
+
+/*
+ * The macro below is used to modify a "char" value (e.g. by casting
+ * it to an unsigned character) so that it can be used safely with
+ * macros such as isspace.
+ */
+
+#define UCHAR(c) ((unsigned char) (c))
+
+/*
+ * Given a size or address, the macro below "aligns" it to the machine's
+ * memory unit size (e.g. an 8-byte boundary) so that anything can be
+ * placed at the aligned address without fear of an alignment error.
+ */
+
+#define TCL_ALIGN(x) ((x + 7) & ~7)
+
+/*
+ * Variables shared among Tcl modules but not used by the outside
+ * world:
+ */
+
+extern int		tclNumFiles;
+extern OpenFile **	tclOpenFiles;
+extern char *		tclRegexpError;
+
+/*
+ *----------------------------------------------------------------
+ * Procedures shared among Tcl modules but not used by the outside
+ * world:
+ *----------------------------------------------------------------
+ */
+
+extern void		panic();
+extern void		TclCopyAndCollapse _ANSI_ARGS_((int count, char *src,
+			    char *dst));
+extern void		TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
+			    Tcl_HashTable *tablePtr));
+extern void		TclExpandParseValue _ANSI_ARGS_((ParseValue *pvPtr,
+			    int needed));
+extern int		TclFindElement _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *list, char **elementPtr, char **nextPtr,
+			    int *sizePtr, int *bracePtr));
+extern Proc *		TclFindProc _ANSI_ARGS_((Interp *iPtr,
+			    char *procName));
+extern int		TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, CallFrame **framePtrPtr));
+extern int		TclGetListIndex _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *indexPtr));
+extern Proc *		TclIsProc _ANSI_ARGS_((Command *cmdPtr));
+extern int		TclNeedSpace _ANSI_ARGS_((char *start, char *end));
+extern int		TclParseBraces _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char **termPtr, ParseValue *pvPtr));
+extern int		TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int flags, char **termPtr,
+			    ParseValue *pvPtr));
+extern int		TclParseQuotes _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int termChar, int flags,
+			    char **termPtr, ParseValue *pvPtr));
+extern int		TclParseWords _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int flags, int maxWords,
+			    char **termPtr, int *argcPtr, char **argv,
+			    ParseValue *pvPtr));
+extern char *		TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, char *name1, char *name2,
+			    int flags));
+extern void		TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
+extern char *		TclWordEnd _ANSI_ARGS_((char *start, int nested,
+			    int *semiPtr));
+
+/*
+ *----------------------------------------------------------------
+ * Command procedures in the generic core:
+ *----------------------------------------------------------------
+ */
+
+extern int	Tcl_AppendCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ArrayCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_BreakCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_CaseCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_CatchCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ConcatCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ContinueCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ErrorCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_EvalCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ExprCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ForCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ForeachCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_FormatCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_GlobalCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_HistoryCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_IfCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_IncrCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_InfoCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_JoinCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_LappendCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_LindexCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_LinsertCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_LlengthCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ListCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_LrangeCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_LreplaceCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_LsearchCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_LsortCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ProcCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_RegexpCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_RegsubCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_RenameCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ReturnCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ScanCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_SetCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_SplitCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_StringCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_SubstCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_SwitchCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_TraceCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_UnsetCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_UplevelCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_UpvarCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_WhileCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_Cmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_Cmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------
+ * Command procedures in the UNIX core:
+ *----------------------------------------------------------------
+ */
+
+extern int	Tcl_CdCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_CloseCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_EofCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ExecCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ExitCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_FileCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_FlushCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_GetsCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_GlobCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_OpenCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_PutsCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_PidCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_PwdCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_ReadCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_SeekCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_SourceCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_TellCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+extern int	Tcl_TimeCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+#endif /* _TCLINT */
diff --git a/src/h/tclRegexp.h b/src/h/tclRegexp.h
new file mode 100644
index 000000000..909d93e5a
--- /dev/null
+++ b/src/h/tclRegexp.h
@@ -0,0 +1,32 @@
+/*
+ * Definitions etc. for regexp(3) routines.
+ *
+ * Caveat:  this is V8 regexp(3) [actually, a reimplementation thereof],
+ * not the System V one.
+ *
+ * @(#) tclRegexp.h 1.2 94/08/09 11:45:53
+ */
+
+#ifndef _TCL
+#include "tcl.h"
+#endif
+#ifndef _REGEXP
+#define _REGEXP 1
+
+#define NSUBEXP  50
+typedef struct regexp {
+	char *startp[NSUBEXP];
+	char *endp[NSUBEXP];
+	char regstart;		/* Internal use only. */
+	char reganch;		/* Internal use only. */
+	char *regmust;		/* Internal use only. */
+	int regmlen;		/* Internal use only. */
+	char program[1];	/* Unwarranted chumminess with compiler. */
+} regexp;
+
+extern regexp *TclRegComp _ANSI_ARGS_((char *exp));
+extern int TclRegExec _ANSI_ARGS_((regexp *prog, char *string, char *start));
+extern void TclRegSub _ANSI_ARGS_((regexp *prog, char *source, char *dest));
+extern void TclRegError _ANSI_ARGS_((char *msg));
+
+#endif /* REGEXP */
diff --git a/src/h/tk.h b/src/h/tk.h
new file mode 100644
index 000000000..35ead8243
--- /dev/null
+++ b/src/h/tk.h
@@ -0,0 +1,765 @@
+/*
+ * tk.h --
+ *
+ *	Declarations for Tk-related things that are visible
+ *	outside of the Tk module itself.
+ *
+ * Copyright (c) 1989-1993 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Permission is hereby granted, without written agreement and without
+ * license or royalty fees, to use, copy, modify, and distribute this
+ * software and its documentation for any purpose, provided that the
+ * above copyright notice and the following two paragraphs appear in
+ * all copies of this software.
+ * 
+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
+ * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
+ * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
+ * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
+ * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+ *
+ * $Header$ SPRITE (Berkeley)
+ */
+
+#ifndef _TK
+#define _TK
+
+#define TK_VERSION "3.6"
+#define TK_MAJOR_VERSION 3
+#define TK_MINOR_VERSION 6
+
+#ifndef _TCL
+#include "tcl.h"		/* Beppe */
+#endif
+#ifndef _XLIB_H
+#include <X11/Xlib.h>
+#endif
+#ifdef __STDC__
+#include <stddef.h>
+#endif
+
+/*
+ * Dummy types that are used by clients:
+ */
+
+typedef struct Tk_ErrorHandler_ *Tk_ErrorHandler;
+typedef struct Tk_TimerToken_ *Tk_TimerToken;
+typedef struct Tk_Window_ *Tk_Window;
+typedef struct Tk_3DBorder_ *Tk_3DBorder;
+typedef struct Tk_BindingTable_ *Tk_BindingTable;
+
+/*
+ * Additional types exported to clients.
+ */
+
+typedef char *Tk_Uid;
+
+/*
+ * Structure used to specify how to handle argv options.
+ */
+
+typedef struct {
+    char *key;		/* The key string that flags the option in the
+			 * argv array. */
+    int type;		/* Indicates option type;  see below. */
+    char *src;		/* Value to be used in setting dst;  usage
+			 * depends on type. */
+    char *dst;		/* Address of value to be modified;  usage
+			 * depends on type. */
+    char *help;		/* Documentation message describing this option. */
+} Tk_ArgvInfo;
+
+/*
+ * Legal values for the type field of a Tk_ArgvInfo: see the user
+ * documentation for details.
+ */
+
+#define TK_ARGV_CONSTANT		15
+#define TK_ARGV_INT			16
+#define TK_ARGV_STRING			17
+#define TK_ARGV_UID			18
+#define TK_ARGV_REST			19
+#define TK_ARGV_FLOAT			20
+#define TK_ARGV_FUNC			21
+#define TK_ARGV_GENFUNC			22
+#define TK_ARGV_HELP			23
+#define TK_ARGV_CONST_OPTION		24
+#define TK_ARGV_OPTION_VALUE		25
+#define TK_ARGV_OPTION_NAME_VALUE	26
+#define TK_ARGV_END			27
+
+/*
+ * Flag bits for passing to Tk_ParseArgv:
+ */
+
+#define TK_ARGV_NO_DEFAULTS		0x1
+#define TK_ARGV_NO_LEFTOVERS		0x2
+#define TK_ARGV_NO_ABBREV		0x4
+#define TK_ARGV_DONT_SKIP_FIRST_ARG	0x8
+
+/*
+ * Structure used to describe application-specific configuration
+ * options:  indicates procedures to call to parse an option and
+ * to return a text string describing an option.
+ */
+
+typedef int (Tk_OptionParseProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, Tk_Window tkwin, char *value, char *widgRec,
+	int offset));
+typedef char *(Tk_OptionPrintProc) _ANSI_ARGS_((ClientData clientData,
+	Tk_Window tkwin, char *widgRec, int offset,
+	Tcl_FreeProc **freeProcPtr));
+
+typedef struct Tk_CustomOption {
+    Tk_OptionParseProc *parseProc;	/* Procedure to call to parse an
+					 * option and store it in converted
+					 * form. */
+    Tk_OptionPrintProc *printProc;	/* Procedure to return a printable
+					 * string describing an existing
+					 * option. */
+    ClientData clientData;		/* Arbitrary one-word value used by
+					 * option parser:  passed to
+					 * parseProc and printProc. */
+} Tk_CustomOption;
+
+/*
+ * Structure used to specify information for Tk_ConfigureWidget.  Each
+ * structure gives complete information for one option, including
+ * how the option is specified on the command line, where it appears
+ * in the option database, etc.
+ */
+
+typedef struct Tk_ConfigSpec {
+    int type;			/* Type of option, such as TK_CONFIG_COLOR;
+				 * see definitions below.  Last option in
+				 * table must have type TK_CONFIG_END. */
+    char *argvName;		/* Switch used to specify option in argv.
+				 * NULL means this spec is part of a group. */
+    char *dbName;		/* Name for option in option database. */
+    char *dbClass;		/* Class for option in database. */
+    char *defValue;		/* Default value for option if not
+				 * specified in command line or database. */
+    int offset;			/* Where in widget record to store value;
+				 * use Tk_Offset macro to generate values
+				 * for this. */
+    int specFlags;		/* Any combination of the values defined
+				 * below;  other bits are used internally
+				 * by tkConfig.c. */
+    Tk_CustomOption *customPtr;	/* If type is TK_CONFIG_CUSTOM then this is
+				 * a pointer to info about how to parse and
+				 * print the option.  Otherwise it is
+				 * irrelevant. */
+} Tk_ConfigSpec;
+
+/*
+ * Type values for Tk_ConfigSpec structures.  See the user
+ * documentation for details.
+ */
+
+#define TK_CONFIG_BOOLEAN	1
+#define TK_CONFIG_INT		2
+#define TK_CONFIG_DOUBLE	3
+#define TK_CONFIG_STRING	4
+#define TK_CONFIG_UID		5
+#define TK_CONFIG_COLOR		6
+#define TK_CONFIG_FONT		7
+#define TK_CONFIG_BITMAP	8
+#define TK_CONFIG_BORDER	9
+#define TK_CONFIG_RELIEF	10
+#define TK_CONFIG_CURSOR	11
+#define TK_CONFIG_ACTIVE_CURSOR	12
+#define TK_CONFIG_JUSTIFY	13
+#define TK_CONFIG_ANCHOR	14
+#define TK_CONFIG_SYNONYM	15
+#define TK_CONFIG_CAP_STYLE	16
+#define TK_CONFIG_JOIN_STYLE	17
+#define TK_CONFIG_PIXELS	18
+#define TK_CONFIG_MM		19
+#define TK_CONFIG_WINDOW	20
+#define TK_CONFIG_CUSTOM	21
+#define TK_CONFIG_END		22
+
+/*
+ * Macro to use to fill in "offset" fields of Tk_ConfigInfos.
+ * Computes number of bytes from beginning of structure to a
+ * given field.
+ */
+
+#ifdef offsetof
+#define Tk_Offset(type, field) ((int) offsetof(type, field))
+#else
+#define Tk_Offset(type, field) ((int) ((char *) &((type *) 0)->field))
+#endif
+
+/*
+ * Possible values for flags argument to Tk_ConfigureWidget:
+ */
+
+#define TK_CONFIG_ARGV_ONLY	1
+
+/*
+ * Possible flag values for Tk_ConfigInfo structures.  Any bits at
+ * or above TK_CONFIG_USER_BIT may be used by clients for selecting
+ * certain entries.  Before changing any values here, coordinate with
+ * tkConfig.c (internal-use-only flags are defined there).
+ */
+
+#define TK_CONFIG_COLOR_ONLY		1
+#define TK_CONFIG_MONO_ONLY		2
+#define TK_CONFIG_NULL_OK		4
+#define TK_CONFIG_DONT_SET_DEFAULT	8
+#define TK_CONFIG_OPTION_SPECIFIED	0x10
+#define TK_CONFIG_USER_BIT		0x100
+
+/*
+ * Bits to pass to Tk_CreateFileHandler to indicate what sorts
+ * of events are of interest:
+ */
+
+#define TK_READABLE	1
+#define TK_WRITABLE	2
+#define TK_EXCEPTION	4
+
+/*
+ * Flag values to pass to Tk_DoOneEvent to disable searches
+ * for some kinds of events:
+ */
+
+#define TK_DONT_WAIT		1
+#define TK_X_EVENTS		2
+#define TK_FILE_EVENTS		4
+#define TK_TIMER_EVENTS		8
+#define TK_IDLE_EVENTS		0x10
+#define TK_ALL_EVENTS		0x1e
+
+/*
+ * Priority levels to pass to Tk_AddOption:
+ */
+
+#define TK_WIDGET_DEFAULT_PRIO	20
+#define TK_STARTUP_FILE_PRIO	40
+#define TK_USER_DEFAULT_PRIO	60
+#define TK_INTERACTIVE_PRIO	80
+#define TK_MAX_PRIO		100
+
+/*
+ * Relief values returned by Tk_GetRelief:
+ */
+
+#define TK_RELIEF_RAISED	1
+#define TK_RELIEF_FLAT		2
+#define TK_RELIEF_SUNKEN	4
+#define TK_RELIEF_GROOVE	8
+#define TK_RELIEF_RIDGE		16
+
+/*
+ * Special EnterNotify/LeaveNotify "mode" for use in events
+ * generated by tkShare.c.  Pick a high enough value that it's
+ * unlikely to conflict with existing values (like NotifyNormal)
+ * or any new values defined in the future.
+ */
+
+#define TK_NOTIFY_SHARE		20
+
+/*
+ * Enumerated type for describing a point by which to anchor something:
+ */
+
+typedef enum {
+    TK_ANCHOR_N, TK_ANCHOR_NE, TK_ANCHOR_E, TK_ANCHOR_SE,
+    TK_ANCHOR_S, TK_ANCHOR_SW, TK_ANCHOR_W, TK_ANCHOR_NW,
+    TK_ANCHOR_CENTER
+} Tk_Anchor;
+
+/*
+ * Enumerated type for describing a style of justification:
+ */
+
+typedef enum {
+    TK_JUSTIFY_LEFT, TK_JUSTIFY_RIGHT,
+    TK_JUSTIFY_CENTER, TK_JUSTIFY_FILL
+} Tk_Justify;
+
+/*
+ * Enumerated type for describing the color model that should be used
+ * for the application:
+ */
+
+typedef enum {TK_MONO, TK_COLOR} Tk_ColorModel;
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Macros for querying Tk_Window structures.  See the
+ * manual entries for documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+#define Tk_Display(tkwin)		(((Tk_FakeWin *) (tkwin))->display)
+#define Tk_ScreenNumber(tkwin)		(((Tk_FakeWin *) (tkwin))->screenNum)
+#define Tk_Screen(tkwin)		(ScreenOfDisplay(Tk_Display(tkwin), \
+	Tk_ScreenNumber(tkwin)))
+#define Tk_Depth(tkwin)			(((Tk_FakeWin *) (tkwin))->depth)
+#define Tk_Visual(tkwin)		(((Tk_FakeWin *) (tkwin))->visual)
+#define Tk_WindowId(tkwin)		(((Tk_FakeWin *) (tkwin))->window)
+#define Tk_PathName(tkwin) 		(((Tk_FakeWin *) (tkwin))->pathName)
+#define Tk_Name(tkwin)			(((Tk_FakeWin *) (tkwin))->nameUid)
+#define Tk_Class(tkwin) 		(((Tk_FakeWin *) (tkwin))->classUid)
+#define Tk_X(tkwin)			(((Tk_FakeWin *) (tkwin))->changes.x)
+#define Tk_Y(tkwin)			(((Tk_FakeWin *) (tkwin))->changes.y)
+#define Tk_Width(tkwin)			(((Tk_FakeWin *) (tkwin))->changes.width)
+#define Tk_Height(tkwin) \
+    (((Tk_FakeWin *) (tkwin))->changes.height)
+#define Tk_Changes(tkwin)		(&((Tk_FakeWin *) (tkwin))->changes)
+#define Tk_Attributes(tkwin)		(&((Tk_FakeWin *) (tkwin))->atts)
+#define Tk_IsMapped(tkwin) \
+    (((Tk_FakeWin *) (tkwin))->flags & TK_MAPPED)
+#define Tk_IsTopLevel(tkwin) \
+    (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_LEVEL)
+#define Tk_ReqWidth(tkwin)		(((Tk_FakeWin *) (tkwin))->reqWidth)
+#define Tk_ReqHeight(tkwin)		(((Tk_FakeWin *) (tkwin))->reqHeight)
+#define Tk_InternalBorderWidth(tkwin) \
+    (((Tk_FakeWin *) (tkwin))->internalBorderWidth)
+#define Tk_Parent(tkwin)		(((Tk_FakeWin *) (tkwin))->parentPtr)
+#define Tk_Colormap(tkwin)		(((Tk_FakeWin *) (tkwin))->atts.colormap)
+
+/*
+ * The structure below is needed by the macros above so that they can
+ * access the fields of a Tk_Window.  The fields not needed by the macros
+ * are declared as "dummyX".  The structure has its own type in order to
+ * prevent applications from accessing Tk_Window fields except using
+ * official macros.  WARNING!! The structure definition must be kept
+ * consistent with the TkWindow structure in tkInt.h.  If you change one,
+ * then change the other.  See the declaration in tkInt.h for
+ * documentation on what the fields are used for internally.
+ */
+
+typedef struct Tk_FakeWin {
+    Display *display;
+    char *dummy1;
+    int screenNum;
+    Visual *visual;
+    int depth;
+    Window window;
+    char *dummy2;
+    char *dummy3;
+    Tk_Window parentPtr;
+    char *dummy4;
+    char *dummy5;
+    char *pathName;
+    Tk_Uid nameUid;
+    Tk_Uid classUid;
+    XWindowChanges changes;
+    unsigned int dummy6;
+    XSetWindowAttributes atts;
+    unsigned long dummy7;
+    unsigned int flags;
+    char *dummy8;
+    char *dummy9;
+    ClientData dummy10;
+    int dummy12;
+    char *dummy13;
+    char *dummy14;
+    ClientData dummy15;
+    char *dummy16;
+    ClientData dummy17;
+    int reqWidth, reqHeight;
+    int internalBorderWidth;
+    char *dummyX;
+} Tk_FakeWin;
+
+/*
+ * Flag values for TkWindow (and Tk_FakeWin) structures are:
+ *
+ * TK_MAPPED:			1 means window is currently mapped,
+ *				0 means unmapped.
+ * TK_RECURSIVE_DESTROY:	1 means a recursive destroy is in
+ *				progress, so some cleanup operations
+ *				can be omitted.
+ * TK_TOP_LEVEL:		1 means this is a top-level window (it
+ *				was or will be created as a child of
+ *				a root window).
+ * TK_ALREADY_DEAD:		1 means the window is in the process of
+ *				being destroyed already.
+ * TK_NEED_CONFIG_NOTIFY:	1 means that the window has been reconfigured
+ *				before it was made to exist.  At the time of
+ *				making it exist a ConfigureNotify event needs
+ *				to be generated.
+ * TK_GRAB_FLAG:		Used to manage grabs.  See tkGrab.c for
+ *				details.
+ */
+
+#define TK_MAPPED		1
+#define TK_RECURSIVE_DESTROY	2
+#define TK_TOP_LEVEL		4
+#define TK_ALREADY_DEAD		8
+#define TK_NEED_CONFIG_NOTIFY	0x10
+#define TK_GRAB_FLAG		0x20
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Additional procedure types defined by Tk.
+ *
+ *--------------------------------------------------------------
+ */
+
+typedef int (Tk_ErrorProc) _ANSI_ARGS_((ClientData clientData,
+	XErrorEvent *errEventPtr));
+typedef void (Tk_EventProc) _ANSI_ARGS_((ClientData clientData,
+	XEvent *eventPtr));
+typedef void (Tk_FileProc) _ANSI_ARGS_((ClientData clientData, int mask));
+typedef void (Tk_FocusProc) _ANSI_ARGS_((ClientData clientData, int gotFocus));
+typedef void (Tk_FreeProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tk_GenericProc) _ANSI_ARGS_((ClientData clientData,
+	XEvent *eventPtr));
+typedef void (Tk_GeometryProc) _ANSI_ARGS_((ClientData clientData,
+	Tk_Window tkwin));
+typedef int (Tk_GetSelProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, char *portion));
+typedef void (Tk_IdleProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tk_LostSelProc) _ANSI_ARGS_((ClientData clientData));
+typedef Bool (Tk_RestrictProc) _ANSI_ARGS_((Display *display, XEvent *eventPtr,
+	char *arg));
+typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData,
+	int offset, char *buffer, int maxBytes));
+typedef void (Tk_TimerProc) _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Exported procedures and variables.
+ *
+ *--------------------------------------------------------------
+ */
+
+EXTERN XColor *		Tk_3DBorderColor _ANSI_ARGS_((Tk_3DBorder border));
+EXTERN void		Tk_AddOption _ANSI_ARGS_((Tk_Window tkwin, char *name,
+			    char *value, int priority));
+EXTERN void		Tk_BackgroundError _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tk_BindEvent _ANSI_ARGS_((Tk_BindingTable bindingTable,
+			    XEvent *eventPtr, Tk_Window tkwin, int numObjects,
+			    ClientData *objectPtr));
+EXTERN void		Tk_CancelIdleCall _ANSI_ARGS_((Tk_IdleProc *idleProc,
+				ClientData clientData));
+EXTERN void		Tk_ChangeWindowAttributes _ANSI_ARGS_((Tk_Window tkwin,
+			    unsigned long valueMask,
+			    XSetWindowAttributes *attsPtr));
+EXTERN void		Tk_ClearSelection _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void		Tk_ConfigureFree _ANSI_ARGS_((Tk_ConfigSpec *specs,
+			    char *widgRec, Display *display, int needFlags));
+EXTERN int		Tk_ConfigureInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, Tk_ConfigSpec *specs,
+			    char *widgRec, char *argvName, int flags));
+EXTERN int		Tk_ConfigureWidget _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, Tk_ConfigSpec *specs,
+			    int argc, char **argv, char *widgRec,
+			    int flags));
+EXTERN void		Tk_ConfigureWindow _ANSI_ARGS_((Tk_Window tkwin,
+			    unsigned int valueMask, XWindowChanges *valuePtr));
+EXTERN Tk_Window	Tk_CoordsToWindow _ANSI_ARGS_((int rootX, int rootY,
+			    Tk_Window tkwin));
+EXTERN unsigned long	Tk_CreateBinding _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_BindingTable bindingTable, ClientData object,
+			    char *eventString, char *command, int append));
+EXTERN Tk_BindingTable	Tk_CreateBindingTable _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tk_ErrorHandler	Tk_CreateErrorHandler _ANSI_ARGS_((Display *display,
+			    int errNum, int request, int minorCode,
+			    Tk_ErrorProc *errorProc, ClientData clientData));
+EXTERN void		Tk_CreateEventHandler _ANSI_ARGS_((Tk_Window token,
+			    unsigned long mask, Tk_EventProc *proc,
+			    ClientData clientData));
+EXTERN void		Tk_CreateFileHandler _ANSI_ARGS_((int fd, int mask,
+			    Tk_FileProc *proc, ClientData clientData));
+EXTERN void		Tk_CreateFocusHandler _ANSI_ARGS_((Tk_Window tkwin,
+			    Tk_FocusProc *proc, ClientData clientData));
+EXTERN void		Tk_CreateGenericHandler _ANSI_ARGS_((
+			    Tk_GenericProc *proc, ClientData clientData));
+EXTERN Tk_Window	Tk_CreateMainWindow _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *screenName, char *baseName,
+			    char *className));
+EXTERN void		Tk_CreateSelHandler _ANSI_ARGS_((Tk_Window tkwin,
+			    Atom target, Tk_SelectionProc *proc,
+			    ClientData clientData, Atom format));
+EXTERN Tk_TimerToken	Tk_CreateTimerHandler _ANSI_ARGS_((int milliseconds,
+			    Tk_TimerProc *proc, ClientData clientData));
+EXTERN Tk_Window	Tk_CreateWindow _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window parent, char *name, char *screenName));
+EXTERN Tk_Window	Tk_CreateWindowFromPath _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tk_Window tkwin,
+			    char *pathName, char *screenName));
+EXTERN int		Tk_DefineBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Uid name, char *source, unsigned int width,
+			    unsigned int height));
+EXTERN void		Tk_DefineCursor _ANSI_ARGS_((Tk_Window window,
+			    Cursor cursor));
+EXTERN void		Tk_DeleteAllBindings _ANSI_ARGS_((
+			    Tk_BindingTable bindingTable, ClientData object));
+EXTERN int		Tk_DeleteBinding _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_BindingTable bindingTable, ClientData object,
+			    char *eventString));
+EXTERN void		Tk_DeleteBindingTable _ANSI_ARGS_((
+			    Tk_BindingTable bindingTable));
+EXTERN void		Tk_DeleteErrorHandler _ANSI_ARGS_((
+			    Tk_ErrorHandler handler));
+EXTERN void		Tk_DeleteEventHandler _ANSI_ARGS_((Tk_Window token,
+			    unsigned long mask, Tk_EventProc *proc,
+			    ClientData clientData));
+EXTERN void		Tk_DeleteFileHandler _ANSI_ARGS_((int fd));
+EXTERN void		Tk_DeleteGenericHandler _ANSI_ARGS_((
+			    Tk_GenericProc *proc, ClientData clientData));
+EXTERN void		Tk_DeleteSelHandler _ANSI_ARGS_((Tk_Window tkwin,
+			    Atom target));
+EXTERN void		Tk_DeleteTimerHandler _ANSI_ARGS_((
+			    Tk_TimerToken token));
+EXTERN void		Tk_DestroyWindow _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN char *		Tk_DisplayName _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN int		Tk_DoOneEvent _ANSI_ARGS_((int flags));
+EXTERN void		Tk_DoWhenIdle _ANSI_ARGS_((Tk_IdleProc *proc,
+			    ClientData clientData));
+EXTERN void		Tk_Draw3DPolygon _ANSI_ARGS_((Display *display,
+			    Drawable drawable, Tk_3DBorder border,
+			    XPoint *pointPtr, int numPoints, int borderWidth,
+			    int leftRelief));
+EXTERN void		Tk_Draw3DRectangle _ANSI_ARGS_((Display *display,
+			    Drawable drawable, Tk_3DBorder border, int x,
+			    int y, int width, int height, int borderWidth,
+			    int relief));
+EXTERN void		Tk_EventuallyFree _ANSI_ARGS_((ClientData clientData,
+			    Tk_FreeProc *freeProc));
+EXTERN void		Tk_Fill3DPolygon _ANSI_ARGS_((Display *display,
+			    Drawable drawable, Tk_3DBorder border,
+			    XPoint *pointPtr, int numPoints, int borderWidth,
+			    int leftRelief));
+EXTERN void		Tk_Fill3DRectangle _ANSI_ARGS_((Display *display,
+			    Drawable drawable, Tk_3DBorder border, int x,
+			    int y, int width, int height, int borderWidth,
+			    int relief));
+EXTERN void		Tk_Free3DBorder _ANSI_ARGS_((Tk_3DBorder border));
+EXTERN void		Tk_FreeBitmap _ANSI_ARGS_((Display *display,
+			    Pixmap bitmap));
+EXTERN void		Tk_FreeColor _ANSI_ARGS_((XColor *colorPtr));
+EXTERN void		Tk_FreeCursor _ANSI_ARGS_((Display *display,
+			    Cursor cursor));
+EXTERN void		Tk_FreeFontStruct _ANSI_ARGS_((
+			    XFontStruct *fontStructPtr));
+EXTERN void		Tk_FreeGC _ANSI_ARGS_((Display *display, GC gc));
+EXTERN void		Tk_FreeOptions _ANSI_ARGS_((Tk_ConfigSpec *specs,
+			    char *widgRec, Display *display, int needFlags));
+EXTERN void		Tk_GeometryRequest _ANSI_ARGS_((Tk_Window tkwin,
+			    int reqWidth,  int reqHeight));
+EXTERN Tk_3DBorder	Tk_Get3DBorder _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, Colormap colormap,
+			    Tk_Uid colorName));
+EXTERN void		Tk_GetAllBindings _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_BindingTable bindingTable, ClientData object));
+EXTERN int		Tk_GetAnchor _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, Tk_Anchor *anchorPtr));
+EXTERN char *		Tk_GetAtomName _ANSI_ARGS_((Tk_Window tkwin,
+			    Atom atom));
+EXTERN char *		Tk_GetBinding _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_BindingTable bindingTable, ClientData object,
+			    char *eventString));
+EXTERN Pixmap		Tk_GetBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, Tk_Uid string));
+EXTERN Pixmap		Tk_GetBitmapFromData _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, char *source,
+			    unsigned int width, unsigned int height));
+EXTERN int		Tk_GetCapStyle _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *capPtr));
+EXTERN XColor *		Tk_GetColor _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, Colormap colormap, Tk_Uid name));
+EXTERN XColor *		Tk_GetColorByValue _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, Colormap colormap,
+			    XColor *colorPtr));
+EXTERN Tk_ColorModel	Tk_GetColorModel _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN Cursor		Tk_GetCursor _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, Tk_Uid string));
+EXTERN Cursor		Tk_GetCursorFromData _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, char *source, char *mask,
+			    unsigned int width, unsigned int height,
+			    int xHot, int yHot, Tk_Uid fg, Tk_Uid bg));
+EXTERN XFontStruct *	Tk_GetFontStruct _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, Tk_Uid name));
+EXTERN GC		Tk_GetGC _ANSI_ARGS_((Tk_Window tkwin,
+			    unsigned long valueMask, XGCValues *valuePtr));
+EXTERN int		Tk_GetJoinStyle _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *joinPtr));
+EXTERN int		Tk_GetJustify _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, Tk_Justify *justifyPtr));
+EXTERN Tk_Uid		Tk_GetOption _ANSI_ARGS_((Tk_Window tkwin, char *name,
+			    char *className));
+EXTERN int		Tk_GetPixels _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, char *string, int *intPtr));
+EXTERN int		Tk_GetRelief _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, int *reliefPtr));
+EXTERN void		Tk_GetRootCoords _ANSI_ARGS_ ((Tk_Window tkwin,
+			    int *xPtr, int *yPtr));
+EXTERN int		Tk_GetScreenMM _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, char *string, double *doublePtr));
+EXTERN int		Tk_GetSelection _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, Atom target, Tk_GetSelProc *proc,
+			    ClientData clientData));
+EXTERN Tk_Uid		Tk_GetUid _ANSI_ARGS_((char *string));
+EXTERN void		Tk_GetVRootGeometry _ANSI_ARGS_((Tk_Window tkwin,
+			    int *xPtr, int *yPtr, unsigned int *widthPtr,
+			    unsigned int *heightPtr));
+EXTERN int		Tk_Grab _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, int grabGlobal));
+EXTERN void		Tk_HandleEvent _ANSI_ARGS_((XEvent *eventPtr));
+EXTERN int		Tk_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Atom		Tk_InternAtom _ANSI_ARGS_((Tk_Window tkwin,
+			    char *name));
+EXTERN void		Tk_MainLoop _ANSI_ARGS_((void));
+EXTERN Tk_Window	Tk_MainWindow _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tk_MakeWindowExist _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void		Tk_ManageGeometry _ANSI_ARGS_((Tk_Window tkwin,
+			    Tk_GeometryProc *proc, ClientData clientData));
+EXTERN void		Tk_MapWindow _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void		Tk_MoveResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
+			    int x, int y, unsigned int width,
+			    unsigned int height));
+EXTERN void		Tk_MoveWindow _ANSI_ARGS_((Tk_Window tkwin, int x,
+			    int y));
+EXTERN void		Tk_MoveToplevelWindow _ANSI_ARGS_((Tk_Window tkwin,
+			    int x, int y));
+EXTERN char *		Tk_NameOf3DBorder _ANSI_ARGS_((Tk_3DBorder border));
+EXTERN char *		Tk_NameOfAnchor _ANSI_ARGS_((Tk_Anchor anchor));
+EXTERN char *		Tk_NameOfBitmap _ANSI_ARGS_((Display *display,
+			    Pixmap bitmap));
+EXTERN char *		Tk_NameOfCapStyle _ANSI_ARGS_((int cap));
+EXTERN char *		Tk_NameOfColor _ANSI_ARGS_((XColor *colorPtr));
+EXTERN char *		Tk_NameOfCursor _ANSI_ARGS_((Display *display,
+			    Cursor cursor));
+EXTERN char *		Tk_NameOfFontStruct _ANSI_ARGS_((
+			    XFontStruct *fontStructPtr));
+EXTERN char *		Tk_NameOfJoinStyle _ANSI_ARGS_((int join));
+EXTERN char *		Tk_NameOfJustify _ANSI_ARGS_((Tk_Justify justify));
+EXTERN char *		Tk_NameOfRelief _ANSI_ARGS_((int relief));
+EXTERN Tk_Window	Tk_NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *pathName, Tk_Window tkwin));
+EXTERN void		Tk_OwnSelection _ANSI_ARGS_((Tk_Window tkwin,
+			    Tk_LostSelProc *proc, ClientData clientData));
+EXTERN int		Tk_ParseArgv _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, int *argcPtr, char **argv,
+			    Tk_ArgvInfo *argTable, int flags));
+EXTERN void		Tk_Preserve _ANSI_ARGS_((ClientData clientData));
+EXTERN int		Tk_RegisterInterp _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, Tk_Window tkwin));
+EXTERN void		Tk_Release _ANSI_ARGS_((ClientData clientData));
+EXTERN void		Tk_ResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
+			    unsigned int width, unsigned int height));
+EXTERN int		Tk_RestackWindow _ANSI_ARGS_((Tk_Window tkwin,
+			    int aboveBelow, Tk_Window other));
+EXTERN Tk_RestrictProc *Tk_RestrictEvents _ANSI_ARGS_((Tk_RestrictProc *proc,
+			    char *arg, char **prevArgPtr));
+EXTERN void		Tk_SetBackgroundFromBorder _ANSI_ARGS_((
+			    Tk_Window tkwin, Tk_3DBorder border));
+EXTERN void		Tk_SetClass _ANSI_ARGS_((Tk_Window tkwin,
+			    char *className));
+EXTERN void		Tk_SetColorModel _ANSI_ARGS_((Tk_Window tkwin,
+			    Tk_ColorModel model));
+EXTERN void		Tk_SetGrid _ANSI_ARGS_((Tk_Window tkwin,
+			    int reqWidth, int reqHeight, int gridWidth,
+			    int gridHeight));
+EXTERN void		Tk_SetInternalBorder _ANSI_ARGS_((Tk_Window tkwin,
+			    int width));
+EXTERN void		Tk_SetWindowBackground _ANSI_ARGS_((Tk_Window tkwin,
+			    unsigned long pixel));
+EXTERN void		Tk_SetWindowBackgroundPixmap _ANSI_ARGS_((
+			    Tk_Window tkwin, Pixmap pixmap));
+EXTERN void		Tk_SetWindowBorder _ANSI_ARGS_((Tk_Window tkwin,
+			    unsigned long pixel));
+EXTERN void		Tk_SetWindowBorderWidth _ANSI_ARGS_((Tk_Window tkwin,
+			    int width));
+EXTERN void		Tk_SetWindowBorderPixmap _ANSI_ARGS_((Tk_Window tkwin,
+			    Pixmap pixmap));
+EXTERN void		Tk_SetWindowColormap _ANSI_ARGS_((Tk_Window tkwin,
+			    Colormap colormap));
+EXTERN int		Tk_SetWindowVisual _ANSI_ARGS_((Tk_Window tkwin,
+			    Visual *visual, unsigned int depth,
+			    Colormap colormap));
+EXTERN void		Tk_SizeOfBitmap _ANSI_ARGS_((Display *display,
+			    Pixmap bitmap, unsigned int *widthPtr,
+			    unsigned int *heightPtr));
+EXTERN void		Tk_Sleep _ANSI_ARGS_((int ms));
+EXTERN void		Tk_UndefineCursor _ANSI_ARGS_((Tk_Window window));
+EXTERN void		Tk_Ungrab _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void		Tk_UnmapWindow _ANSI_ARGS_((Tk_Window tkwin));
+
+
+EXTERN int		tk_NumMainWindows;
+
+/*
+ * Tcl commands exported by Tk:
+ */
+
+EXTERN int		Tk_AfterCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_ApplicationCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_BindCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_ButtonCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_CanvasCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_DestroyCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_EntryCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_ExitCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_FrameCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_FocusCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_GrabCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_ListboxCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_LowerCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_MenuCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_MenubuttonCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_MessageCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_OptionCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_PackCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_RaiseCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_ScaleCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_ScrollbarCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_SelectionCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_SendCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_TextCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_TkCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_TkwaitCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_UpdateCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_WinfoCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		Tk_WmCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+
+#endif /* _TK */
diff --git a/src/h/unify.h b/src/h/unify.h
new file mode 100644
index 000000000..cbff2c452
--- /dev/null
+++ b/src/h/unify.h
@@ -0,0 +1,32 @@
+/*
+    unify.h -- Unification macros
+*/
+/*
+    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+    Copyright (c) 1990, Giuseppe Attardi.
+
+    ECoLisp is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+
+#define	trail_push(loc)		(*trail_top++ = (loc))
+#define	trail_pop		(**--trail_top = OBJNULL)
+#define trail_mark		trail_push((object *)NULL)
+#define trail_restore		{while (trail_top[-1] != (object *)NULL) \
+				   trail_pop;}
+#define trail_unmark		{trail_restore; trail_top--;}
+#define BIND(loc, val)		{loc = val; trail_push(&loc);}
+
+#define get_value(v, x)		unify(x, v)
+#define get_constant(c, x)	(c == x || unify(x, c))
+#define get_nil(x)		(Cnil == x || unify(x, Cnil))
+
+#define unify_slot		(*slotf)(*slot)
+#define unify_value(loc)	(*slotf)(loc)
+#define unify_constant(c)	(*slotf)(c)
+#define unify_nil		(*slotf)(Cnil)
diff --git a/src/install.sh b/src/install.sh
new file mode 100755
index 000000000..ab74c882e
--- /dev/null
+++ b/src/install.sh
@@ -0,0 +1,238 @@
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5.
+#
+# 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.
+#
+
+
+# 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}"
+
+tranformbasename=""
+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/src/lsp/ansi.lsp b/src/lsp/ansi.lsp
new file mode 100644
index 000000000..4d1e04531
--- /dev/null
+++ b/src/lsp/ansi.lsp
@@ -0,0 +1,39 @@
+;;;;  ANSI.LSP  -- Compatibility with ANSI Common Lisp
+
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "SYSTEM")
+
+(defun print-unreadable-object-function (object stream type identity function)
+  (declare (:dynamic-extent function))
+  (princ "#<" stream)
+  (when type
+    (prin1 (type-of object) stream))
+  (when (and type function) (princ " " stream))
+  (when function (funcall function))
+  (when (and (or type function) identity) (princ " " stream))
+  (when identity (princ (si:pointer object) stream))
+  (princ ">" stream)
+  nil)
+  
+(defmacro print-unreadable-object
+	  ((object stream &key type identity) &body body)
+  (if body
+      `(flet ((.print-unreadable-object-body. () ,@body))
+	 (print-unreadable-object-function
+	   ,object ,stream ,type ,identity #'.print-unreadable-object-body.))
+    `(print-unreadable-object-function ,object ,stream ,type ,identity nil)))
+
+;;; SPECIAL-OPERATOR-P --
+;;; Added 19951011 Marco Antoniotti
+
+(eval-when (load eval)
+  (setf (symbol-function 'special-operator-p)
+	(symbol-function 'special-form-p)))
diff --git a/src/lsp/arraylib.lsp b/src/lsp/arraylib.lsp
new file mode 100644
index 000000000..8989f2ee4
--- /dev/null
+++ b/src/lsp/arraylib.lsp
@@ -0,0 +1,267 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;;    arraylib.lsp
+;;;;
+;;;;                            array routines
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+
+(defun make-array (dimensions
+		   &key (element-type t)
+			(initial-element nil initial-element-supplied-p)
+			(initial-contents nil initial-contents-supplied-p)
+			adjustable fill-pointer
+			displaced-to (displaced-index-offset 0))
+  (setq element-type (type-for-array element-type))
+
+  (if (or (integerp dimensions)
+	  (when (= (length dimensions) 1)
+	    (setq dimensions (first dimensions))))
+      (let ((x (sys:make-vector element-type dimensions
+			       adjustable fill-pointer
+			       displaced-to displaced-index-offset)))
+	(declare (vector x))
+	(when initial-element-supplied-p
+	  (do ((n dimensions)
+	       (i 0 (1+ i)))
+	      ((>= i n))
+	    (declare (fixnum n i))
+	    (sys:aset initial-element x i)))
+	(when initial-contents-supplied-p
+	  (do ((n dimensions)
+	       (i 0 (1+ i)))
+	      ((>= i n))
+	    (declare (fixnum n i))
+	    (sys:aset (elt initial-contents i) x i)))
+	x)
+      (if fill-pointer
+	  (error ":FILL-POINTER may not be specified for an array of rank ~D"
+		 (length dimensions))
+	  (let ((x (apply #'sys:make-pure-array
+			  element-type adjustable
+			  displaced-to displaced-index-offset
+			  dimensions)))
+	    (declare (array x))
+	    (unless (member 0 dimensions)
+	      (when initial-element-supplied-p
+		(do ((cursor
+		      (make-list (length dimensions)
+				 :initial-element 0)))
+		    (nil)
+		  (apply #'aset initial-element x cursor)
+		  (when (increment-cursor cursor dimensions)
+		    (return nil))))
+	      (when initial-contents-supplied-p
+		(do ((cursor
+		      (make-list (length dimensions)
+				 :initial-element 0)))
+		    (nil)
+		  (apply #'aset (sequence-cursor initial-contents
+						 cursor)
+			 x cursor)
+		  (when (increment-cursor cursor dimensions)
+		    (return nil)))))
+	    x))))
+
+(defun type-for-array (element-type)
+  (case element-type
+        ((t nil) t)
+        ((base-char standard-char extended-char character) 'base-char)
+	(t (dolist (v '(BIT BASE-CHAR
+			(SIGNED-BYTE 32) (UNSIGNED-BYTE 32)
+			SHORT-FLOAT LONG-FLOAT) T)
+	     (when (subtypep element-type v)
+	       (return (if (symbolp v) v 'FIXNUM)))))))
+
+(defun increment-cursor (cursor dimensions)
+  (if (null cursor)
+      t
+      (let ((carry (increment-cursor (cdr cursor) (cdr dimensions))))
+	(if carry
+	    (cond ((>= (the fixnum (1+ (the fixnum (car cursor))))
+	               (the fixnum (car dimensions)))
+		   (rplaca cursor 0)
+		   t)
+		  (t
+		   (rplaca cursor
+		           (the fixnum (1+ (the fixnum (car cursor)))))
+		   nil))
+	    nil))))
+
+
+(defun sequence-cursor (sequence cursor)
+  (if (null cursor)
+      sequence
+      (sequence-cursor (elt sequence (the fixnum (car cursor)))
+                       (cdr cursor))))
+
+
+(defun vector (&rest objects)
+  (make-array (list (length objects))
+	      :element-type t
+	      :initial-contents objects))
+
+
+(defun array-dimensions (array)
+  (do ((i (array-rank array))
+       (d nil))
+      ((= i 0) d)
+    (setq i (1- i))
+    (setq d (cons (array-dimension array i) d))))
+
+
+(defun array-in-bounds-p (array &rest indices &aux (r (array-rank array)))
+  (when (/= r (length indices))
+        (error "The rank of the array is ~R,~%~
+               ~7@Tbut ~R ~:*~[indices are~;index is~:;indices are~] ~
+               supplied."
+               r (length indices)))
+  (do ((i 0 (1+ i))
+       (s indices (cdr s)))
+      ((>= i r) t)
+    (when (or (< (car s) 0)
+              (>= (car s) (array-dimension array i)))
+          (return nil))))
+
+
+(defun array-row-major-index (array &rest indices)
+  (do ((i 0 (1+ i))
+       (j 0 (+ (* j (array-dimension array i)) (car s)))
+       (s indices (cdr s)))
+      ((null s) j)))
+
+
+(defun bit (bit-array &rest indices)
+  (apply #'aref bit-array indices))
+
+
+(defun sbit (bit-array &rest indices)
+  (apply #'aref bit-array indices))
+
+
+(defun bit-and (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-and bit-array1 bit-array2 result-bit-array))
+
+
+(defun bit-ior (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-ior bit-array1 bit-array2 result-bit-array))
+
+
+(defun bit-xor (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-xor bit-array1 bit-array2 result-bit-array))
+
+
+(defun bit-eqv (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-eqv bit-array1 bit-array2 result-bit-array))
+
+    
+(defun bit-nand (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-nand bit-array1 bit-array2 result-bit-array))
+
+    
+(defun bit-nor (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-nor bit-array1 bit-array2 result-bit-array))
+
+    
+(defun bit-andc1 (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-andc1 bit-array1 bit-array2 result-bit-array))
+
+    
+(defun bit-andc2 (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-andc2 bit-array1 bit-array2 result-bit-array))
+
+    
+(defun bit-orc1 (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-orc1 bit-array1 bit-array2 result-bit-array))
+
+    
+(defun bit-orc2 (bit-array1 bit-array2 &optional result-bit-array)
+  (bit-array-op boole-orc2 bit-array1 bit-array2 result-bit-array))
+
+    
+(defun bit-not (bit-array &optional result-bit-array)
+  (bit-array-op boole-c1 bit-array bit-array result-bit-array))
+
+
+(defun vector-push (new-element vector)
+  (let ((fp (fill-pointer vector)))
+    (declare (fixnum fp))
+    (cond ((< fp (the fixnum (array-dimension vector 0)))
+           (sys:aset new-element vector fp)
+           (sys:fill-pointer-set vector (the fixnum (1+ fp)))
+	   fp)
+	  (t nil))))
+
+
+(defun vector-push-extend (new-element vector &optional extension)
+  (let ((fp (fill-pointer vector)))
+    (declare (fixnum fp))
+    (cond ((< fp (the fixnum (array-dimension vector 0)))
+	   (sys:aset new-element vector fp)
+	   (sys:fill-pointer-set vector (the fixnum (1+ fp)))
+	   fp)
+	  (t
+	   (adjust-array vector
+	                 (list (+ (array-dimension vector 0)
+				  (or extension
+				      (if (> (array-dimension vector 0)  0)
+					  (array-dimension vector 0)
+					5))))
+	                 :element-type (array-element-type vector)
+			 :fill-pointer fp)
+	   (sys:aset new-element vector fp)
+	   (sys:fill-pointer-set vector (the fixnum (1+ fp)))
+	   fp))))
+
+
+(defun vector-pop (vector)
+  (let ((fp (fill-pointer vector)))
+    (declare (fixnum fp))
+    (when (= fp 0)
+          (error "The fill pointer of the vector ~S zero." vector))
+    (sys:fill-pointer-set vector (the fixnum (1- fp)))
+    (aref vector (the fixnum (1- fp)))))
+
+
+(defun adjust-array (array new-dimensions
+                     &rest r
+		     &key element-type
+			  initial-element
+			  initial-contents
+			  fill-pointer
+			  displaced-to
+			  displaced-index-offset)
+  (declare (ignore element-type
+                   initial-element
+                   initial-contents
+                   fill-pointer
+                   displaced-to
+                   displaced-index-offset))
+  (when (integerp new-dimensions)
+        (setq new-dimensions (list new-dimensions)))
+  (let ((element-type (array-element-type array)))
+    (unless (eq element-type t) (push element-type r)
+	    (push :element-type r)))
+  (let ((x (apply #'make-array new-dimensions :adjustable t r)))
+    (declare (array x))
+    (do ((cursor (make-list (length new-dimensions) :initial-element 0)))
+        (nil)
+      (when (apply #'array-in-bounds-p array cursor)
+            (apply #'aset (apply #'aref array cursor)
+		   x
+		   cursor))
+      (when (increment-cursor cursor new-dimensions)
+            (return nil)))
+    (sys:replace-array array x)
+    ))
diff --git a/src/lsp/assert.lsp b/src/lsp/assert.lsp
new file mode 100644
index 000000000..ba995c347
--- /dev/null
+++ b/src/lsp/assert.lsp
@@ -0,0 +1,193 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+
+(defmacro check-type (place typespec &optional (string nil s))
+  `(do ((*print-level* 4)
+        (*print-length* 4))
+       ((typep ,place ',typespec) nil)
+       (cerror ""
+               "The value of ~:@(~S~), ~:@(~S~), is not ~A."
+               ',place ,place
+               ,(if s string `',typespec))
+       (setf ,place (si::ask-for-form2 ',place))))
+
+
+(defmacro assert (test-form &optional places string &rest args)
+  `(do ((*print-level* 4)
+        (*print-length* 4))
+       (,test-form nil)
+       ,(if string
+            `(cerror "" ,string ,@args)
+            `(cerror "" "The assertion ~:@(~S~) is failed." ',test-form))
+       ,@(mapcar #'ask-for-form places)
+       (format *error-output* "Now continuing ...~%")))
+
+
+(defun ask-for-form (place)
+  `(progn (format  *error-output*
+                   "Please input the new value for the place ~:@(~S~): "
+                   ',place)
+          (finish-output *error-output*)
+          (setf ,place (read))))
+
+(defun ask-for-form2 (place)
+  (format  *error-output*
+	   "Please input the new value for the place ~:@(~S~): "
+	   place)
+  (finish-output *error-output*)
+  (prog1 (read)
+    (format *error-output* "Now continuing ...~%")))
+
+(defun ecase-error (keyform value &rest values)
+  (let ((*print-level* 4)
+	(*print-length* 4))
+    (error
+     "The value of ~:@(~S~), ~:@(~S~), is ~
+     ~#[nonsense~;not ~:@(~S~)~;neither ~:@(~S~) nor ~:@(~S~)~
+     ~:;not ~@{~#[~;or ~]~:@(~S~)~^, ~}~]."
+     keyform value values)))
+
+(defun case-values (clauses)
+  (mapcan #'(lambda (x)
+	      (if (listp (car x))
+		(mapcar #'(lambda (y) `',y) (car x))
+		`(',(car x))))
+	  clauses))
+
+(defmacro ecase (keyform &rest clauses)
+  (let* ((key (if (atom keyform) keyform '#:key))
+	 (let (if (atom keyform) nil (list (list key keyform)))))
+    `(let ,let
+      (case ,key ,@clauses
+	    (t (si::ecase-error ',keyform ,key ,@(case-values clauses)))))))
+
+(defun ccase-error (keyform value &rest values)
+  (let ((*print-level* 4)
+	(*print-length* 4)
+	(value))
+    (cerror ""
+	    "The value of ~:@(~S~), ~:@(~S~), is ~
+            ~#[nonsense~;not ~:@(~S~)~;neither ~
+            ~:@(~S~) nor ~:@(~S~)~
+            ~:;not ~@{~#[~;or ~]~:@(~S~)~^, ~}~]."
+            keyform key values)
+    (set value (si::ask-for-form2 keyform))
+    value))
+
+(defmacro ccase (keyform &rest clauses)
+  (let* ((key (if (atom keyform) keyform '#:key))
+	 (let (if (atom keyform) nil (list (list key keyform))))
+	 (repeat '#:repeat))
+    `(let ,let
+      (tagbody ,repeat
+	 (case ,key ,@clauses
+	       (t (setq ,key (si::ccase-error ',keyform ,key ,@(case-values clauses)))
+		  (go ,repeat)))))))
+
+(defmacro typecase (keyform &rest clauses)
+  (do ((l (reverse clauses) (cdr l))
+       (form nil) (key (gensym)))
+      ((endp l) `(let ((,key ,keyform)) ,form))
+      (if (or (eq (caar l) 't) (eq (caar l) 'otherwise))
+          (setq form `(progn ,@(cdar l)))
+          (setq form
+                `(if (typep ,key (quote ,(caar l)))
+                     (progn ,@(cdar l))
+                     ,form))))
+  )
+
+(defmacro etypecase (keyform &rest clauses &aux (key (gensym)))
+   (do ((l (reverse clauses) (cdr l))	; Beppe
+        (form `(error (typecase-error-string
+                       ',keyform ,key
+                       ',(mapcar #'(lambda (l) (car l)) clauses)))))
+       ((endp l) `(let ((,key ,keyform)) ,form))
+       (setq form `(if (typep ,key ',(caar l))
+                       (progn ,@(cdar l))
+                       ,form))
+       )
+   )
+
+(defmacro ctypecase (keyplace &rest clauses &aux (key (gensym)))
+  `(loop (let ((,key ,keyplace))
+              ,@(mapcar #'(lambda (l)
+                                 `(when (typep ,key ',(car l))
+                                        (return (progn ,@(cdr l)))))
+                        clauses)
+              (cerror ""
+                      (typecase-error-string
+                       ',keyplace ,key
+                       ',(mapcar #'(lambda (l) (car l)) clauses))))
+         ,(ask-for-form keyplace)
+         (format *error-output* "Now continuing ...~%"))
+  )
+
+(defun typecase-error-string
+       (keyform keyvalue negs
+                &aux (negs1 nil) (poss nil) (poss1 nil))
+   (do ()
+       ((endp negs))
+       (if (symbolp (car negs))
+           (progn (push (list (car negs)) negs1) (pop negs))
+           (case (caar negs)
+                 (or (setq negs (append (cdar negs) (cdr negs))))
+                 (member (mapc #'(lambda (x) (push `(member ,x) negs1))
+                               (cdar negs))
+                         (pop negs))
+                 (not (push (cadar negs) poss) (pop negs))
+                 (otherwise (push (car negs) negs1) (pop negs)))))
+   (do ()
+       ((endp poss))
+       (cond ((symbolp (car poss)) (push (list (car poss)) poss1) (pop poss))
+             ((eq (caar poss) 'and)
+              (setq poss (append (cdar poss) (cdr poss))))
+             (t (push (car poss) poss1) (pop poss))))
+   (format
+    nil
+    "The value of ~:@(~S~), ~:@(~S~), is ~?~?."
+    keyform
+    keyvalue
+    "~#[~;~;~?~;~;~? and ~?~:;~%~@{~#[~;~;and ~]~?~^, ~}~]"
+    (mapcan 'typecase-error-strings poss1)
+    "~:[~[something~;~:;~%~]~;~[~:;, but~%~]~]~
+     ~#[~;~;not ~?~;~;neither ~? nor ~?~:;not ~@{~#[~;~;or ~]~?~^, ~}~]"
+    (cons poss1 (cons (length negs1)
+                      (mapcan 'typecase-error-strings (nreverse negs1))))
+    )
+   )
+
+(defun typecase-error-strings (type)
+  (flet ((vowel-p (symbol)
+	   (member (elt (symbol-name symbol) 0)
+		   '(#\A #\I #\U #\E #\O #\a #\i #\u #\e #\o) :test #'eq)))
+    (cond ((eq (car type) 'member)
+	   (case (length (cdr type))
+	     (0 `("one of none" nil))
+	     (1 `("~:@(~S~)" (,(cadr type))))
+	     (2 `("either ~:@(~S~) or ~:@(~S~)" ,(cdr type)))
+	     (t `("one of ~:@(~S~)" (,(cdr type))))))
+	  ((eq (car type) 'satisfies)
+	   `("an object satisfying ~:@(~S~)" ,(cdr type)))
+	  ((or (endp (cdr type)) (null (remove '* (cdr type))))
+	   (let ((x (assoc (car type)
+			   '((t "anything")
+			     (nil "none")
+			     (null "nil")
+			     (common "an object of a standard data type")))))
+             (if x
+                 `(,(cadr x) nil)
+                 `("~:[a~;an~] ~(~A~)" (,(vowel-p (car type)) ,(car type))))))
+	  (t `("~:[a~;an~] ~:@(~S~)" (,(vowel-p (car type)) ,type)))))
+ )
diff --git a/src/lsp/autoload.lsp b/src/lsp/autoload.lsp
new file mode 100644
index 000000000..5fcb01d52
--- /dev/null
+++ b/src/lsp/autoload.lsp
@@ -0,0 +1,253 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+
+
+;;; Program Development Environment
+
+(in-package "SYSTEM")
+(setq *record-source-pathname-p* nil)
+(defun record-source-pathname (symbol type)
+  ;; type is either:
+  ;; 1. a symbol, for single entry definitions (defun, defvar, defclass ..)
+  ;; 2. a list (type . spec), for multiple entries (defmethod)
+  (when (and *record-source-pathname-p*
+	     *source-pathname*)
+    (when (sys::setf-namep symbol)
+       (setq symbol (get (second symbol) 'setf-symbol)))
+    (if (symbolp type)
+	(putprop symbol *source-pathname* type)
+	(let ((alist (get symbol (car type)))
+	      (spec (cdr type)))
+	  (if alist
+	      (let ((entry (assoc spec alist :test #'equal)))
+		(if entry
+		    (setf (cdr entry) *source-pathname*)
+		    (push (cons spec *source-pathname*) alist)))
+	      (setq alist (list (cons spec *source-pathname*))))
+	  (putprop symbol alist (car type))))))
+
+;;; Go into LISP.
+(in-package "LISP")
+
+(defun lisp-implementation-type () "ECoLisp")
+
+;;; Compiler functions.
+
+(unless (fboundp 'compile)
+(defun proclaim (d)
+       (when (eq (car d) 'SPECIAL) (mapc #'sys::*make-special (cdr d))))
+
+(defun proclamation (d)
+  (and (eq (car d) 'SPECIAL)
+       (dolist (var (cdr d) t)
+               (unless (sys::specialp var) (return nil)))))
+
+(defun compile-file (&rest args)
+  (load (merge-pathnames sys:*system-directory* "compiler"))
+  (apply 'compile-file args))
+(defun compile (&rest args)
+  (load (merge-pathnames sys:*system-directory* "compiler"))
+  (apply 'compile args))
+(defun disassemble (&rest args)
+  (load (merge-pathnames sys:*system-directory* "compiler"))
+  (apply 'disassemble args))
+)
+
+(defun get-decoded-time ()
+  (decode-universal-time (get-universal-time)))
+
+;;; Editor.
+
+(defun ed (&optional filename)
+  (si:system (format nil "emacs ~A" filename)))
+
+
+;;; Allocator.
+
+(in-package "SYSTEM")
+
+(defvar *type-list*
+        '(cons
+          ;; fixnum Beppe
+	  fixnum char locative
+	  bignum ratio short-float long-float complex
+          symbol package hash-table
+          array vector string bit-vector
+          stream random-state readtable pathname
+          bytecodes cfun cclosure
+	  #-clos structure #+clos instance #+clos generic-function
+	  #+threads cont #+threads thread))
+
+#-boehm-gc
+(defun room (&optional x)
+  (let (npage info-list link-alist)
+    (multiple-value-bind
+	  (maxpage leftpage ncbpage maxcbpage ncb cbgbccount
+		   holepage l)
+	(sys::room-report)
+
+      (do ((l l (nthcdr 5 l))
+	   (tl *type-list* (cdr tl))
+	   (i 0 (+ i (if (nth 2 l) (nth 2 l) 0))))
+	  ((null l) (setq npage i))
+	(let ((typename (car tl))
+	      (nused (nth 0 l))
+	      (nfree (nth 1 l))
+	      (npage (nth 2 l))
+	      (maxpage (nth 3 l))
+	      (gbccount (nth 4 l)))
+	  (if nused
+	      (push (list typename npage maxpage
+			  (if (zerop (+ nused nfree))
+			      0
+			      (/ nused 0.01 (+ nused nfree)))
+			  (if (zerop gbccount) nil gbccount))
+		    info-list)
+	      (let ((a (assoc (nth nfree *type-list*) link-alist)))
+		(if a
+		    (nconc a (list typename))
+		    (push (list (nth nfree *type-list*) typename)
+			  link-alist))))))
+      (dolist (info (nreverse info-list))
+	(apply #'format t "~4D/~D~10T~5,1F%~@[~3D~]~20T~{~A~^ ~}"
+	       (append (cdr info)
+		       (if  (assoc (car info) link-alist)
+			    (list (assoc (car info) link-alist))
+			    (list (list (car info))))))
+	(terpri)
+	)
+      (terpri)
+      (format t "~4D/~D~16T~@[~3D~]~20Tcontiguous (~D blocks)~%"
+	      ncbpage maxcbpage (if (zerop cbgbccount) nil cbgbccount) ncb)
+      (format t "~5T~D~20Thole~%" holepage)
+      (format t "~5D pages for cells~%" npage)
+      (format t "~5D total pages~%" (+ npage ncbpage holepage))
+      (format t "~5D pages available~%" leftpage)
+      (format t "~5D pages in heap but not gc'd + pages needed for gc marking~%"
+	      (- maxpage (+ npage ncbpage holepage leftpage)))
+      (format t "~5D maximum pages~%" maxpage)
+      (values)
+      )))
+
+
+;;; Help.
+
+(in-package "SYSTEM")
+
+(defun help (&optional (symbol nil s))
+  (if s (sys::print-doc symbol)
+      (progn
+        (princ "
+Welcome to ECLS. Here are the few functions you should learn first.
+
+	(HELP symbol) prints the online documentation associated with the
+	symbol.  For example, (HELP 'CONS) will print the useful information
+	about the CONS function, the CONS data type, and so on.
+
+	(HELP* string) prints the online documentation associated with those
+	symbols whose print-names have the string as substring.  For example,
+	(HELP* \"PROG\") will print the documentation of the symbols such as
+	PROG, PROGN, and MULTIPLE-VALUE-PROG1.
+
+	(BYE) ends the current ECLS session.
+
+For the precise language specification, refere to Guy Steele's \"Common Lisp,
+the Language\" and our \"ECLS Manual\".  \"ECLS Dictionary\", the hard-copied
+version of ECLS online documentation, will be useful as a handbook.
+
+Good luck!
+")
+        (values))))
+
+(defun help* (string &optional (package (find-package "CL")))
+  (sys::apropos-doc string package))
+
+;;; Import functions which are useful for user interaction
+
+(in-package "CL-USER")
+(import '(sys::help sys::help* #-boehm-gc sys::room))
+
+;;; Pretty-print-formats.
+;;;
+;;;	The number N as the property of a symbol SYMBOL indicates that,
+;;;	in the form (SYMBOL f1 ... fN fN+1 ... fM), the subforms fN+1,...,fM
+;;;	are the 'body' of the form and thus are treated in a special way by
+;;;	the ECLS pretty-printer.
+
+;;; (At boot we don't have setf yet)
+
+(in-package "SYSTEM")
+
+(mapc #'(lambda (x) (sys::putprop (first x) (second x) 'sys::pretty-print-format))
+      '((block 1)
+	(case 1)
+	(catch 1)
+	(ccase 1)
+	(clines 0)
+	(compiler-let 1)
+	(cond 0)
+	(ctypecase 1)
+	(defcfun 2)
+	(define-setf-method 2)
+	(defla 2)
+	(defmacro 2)
+	(defsetf 3)
+	(defstruct 1)
+	(deftype 2)
+	(defun 2)
+	(defunC 2) ; Beppe
+	(do 2)
+	(do* 2)
+	(do-symbols 1)
+	(do-all-symbols 1)
+	(do-external-symbols 1)
+	(dolist 1)
+	(dotimes 1)
+	(ecase 1)
+	(etypecase 1)
+	(eval-when 1)
+	(flet 1)
+	(labels 1)
+	(lambda 1)
+	(lambda-block 2)
+	(lambda-closure 4)
+	(lambda-block-closure 5)
+	(let 1)
+	(let* 1)
+	(locally 0)
+	(loop 0)
+	(macrolet 1)
+	(multiple-value-bind 2)
+	(multiple-value-prog1 1)
+	(prog 1)
+	(prog* 1)
+	(prog1 1)
+	(prog2 2)
+	(progn 0)
+	(progv 2)
+	(return 0)
+	(return-from 1)
+	(tagbody 0)
+	(the 1)
+	(throw 1)
+	(typecase 1)
+	(unless 1)
+	(unwind-protect 0)
+	(when 1)
+	(with-input-from-string 1)
+	(with-open-file 1)
+	(with-open-stream 1)
+	(with-output-to-string 1)
+#+clos	(defclass 2)
+#+clos	(defmethod 2)
+#+clos	(symbol-macrolet 2)
+#+clos	(with-accessors 2)
+#+clos	(with-slots 2)))
diff --git a/src/lsp/cmpinit.lsp b/src/lsp/cmpinit.lsp
new file mode 100644
index 000000000..906072351
--- /dev/null
+++ b/src/lsp/cmpinit.lsp
@@ -0,0 +1,7 @@
+
+(in-package "SYSTEM")
+
+;;; Disable PDE facilities within LISP kernel:
+(setq *features* (delete ':pde *features*))
+;;; Disable record-source-pathname within LISP kernel:
+(defmacro record-source-pathname (x y))
diff --git a/src/lsp/config.lsp.in b/src/lsp/config.lsp.in
new file mode 100644
index 000000000..117826f01
--- /dev/null
+++ b/src/lsp/config.lsp.in
@@ -0,0 +1,37 @@
+;;
+;; Configuration file for ECLS
+;;
+(in-package "LISP")
+;;
+;; * Short and long site names
+;;
+#include "../../../site.lsp"
+;;
+;; * ECLS version, architecture, etc
+;;
+(defun lisp-implementation-version () "@ECLS_VERSION@")
+(defun machine-type () "@architecture@")
+#if !defined(unix) || defined(__NeXT)
+;; obtained from uname(2) where available
+(defun machine-instance () "@MACHINE_INSTANCE@")
+(defun machine-version () "@MACHINE@")
+(defun software-type () "@software_type@")
+(defun software-version () "@software_version@")
+#endif
+;;
+;; * Set up some room
+;;
+(unless (member :boehm-gc *features*)
+  (sys::allocate 'CONS 200)
+  (sys::allocate 'STRING 40))
+;;
+;; * Load symbols from this program
+;;
+#ifdef RSYM
+(sys:build-symbol-table)
+#endif
+;;
+;; * Set configuration pathnames. Notice the trailing slash!
+;;   Otherwise it would not be a directory.
+;;
+(setq sys:*system-directory* "@libdir@/")
diff --git a/src/lsp/defmacro.lsp b/src/lsp/defmacro.lsp
new file mode 100644
index 000000000..1268f0340
--- /dev/null
+++ b/src/lsp/defmacro.lsp
@@ -0,0 +1,355 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;;         defines SYS:DEFMACRO*, the defmacro preprocessor
+
+(si::select-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+#-ecls-min
+(defvar *dl*)
+#-ecls-min
+(defvar *key-check*)
+#-ecls-min
+(defvar *arg-check*)
+
+#+ecls-min
+(sys:*make-special '*dl*)
+#+ecls-min
+(sys:*make-special '*key-check*)
+#+ecls-min
+(sys:*make-special '*arg-check*)
+
+#+ecls-min
+(si::fset 'push
+	  #'(lambda-block push (args env)
+	      (let* ((what (second args))
+		     (where (caddr args)))
+		`(setq ,where (cons ,what ,where))))
+	  t)
+
+#+ecls-min
+(si::fset 'pop
+	  #'(lambda-block pop (args env)
+	      (let ((where (cadr args)))
+		`(let* ((l ,where)
+			(v (car l)))
+		  (setq ,where (cdr l))
+		  v)))
+	  t)
+
+#+ecls-min
+(si::fset 'incf
+	  #'(lambda-block incf (args env)
+	      (let* ((where (second args))
+		     (what (caddr args)))
+		(if what
+		  `(setq ,where (+ ,where ,what))
+		  `(setq ,where (1+ ,where)))))
+	  t)
+
+#+ecls-min
+(si::fset 'decf
+	  #'(lambda-block decf (args env)
+	      (let* ((where (second args))
+		     (what (caddr args)))
+		(if what
+		  `(setq ,where (- ,where ,what))
+		  `(setq ,where (1- ,where)))))
+	  t)
+
+(defun sys::search-keyword (list key)
+  (cond ((atom list) 'failed)
+	((atom (cdr list)) 'failed)
+	((eq (car list) key) (cadr list))
+	(t (search-keyword (cddr list) key))))
+
+(defun check-keyword (tail keywords)
+  (do (head
+       arg
+       (err nil))
+      ((null tail)
+       (when err (error "They key ~s is not allowed" err)))
+    (if (atom tail)
+      (error "keyword list is not a proper list")
+      (setq head (car tail) tail (cdr tail)))
+    (if (atom tail)
+      (error "keyword list is not a proper list")
+      (setq arg (car tail) tail (cdr tail)))
+    (cond ((and (eq head :allow-other-keys) tail)
+	   (return-from check-keyword))
+	  ((not (member head keywords))
+	   (setq err head)))))
+
+(defun dm-bad-key (key)
+       (error "Defmacro-lambda-list contains illegal use of ~s." key))
+
+(defun dm-too-few-arguments ()
+       (error "Too few arguments are supplied to defmacro-lambda-list."))
+
+(defun dm-too-many-arguments ()
+       (error "Too many arguments are supplied to defmacro-lambda-list."))
+
+(defun sys::destructure (vl whole macro &aux (*dl* nil) (*key-check* nil) (*arg-check* nil))
+  (labels ((dm-vl (vl whole top &aux v allow-other-keys-p)
+	     (do*((optionalp) (restp) (keyp)
+		  (allow-other-keys-p) (auxp)
+		  (rest) (allow-other-keys) (keys) (no-check)
+		  (n (if top 1 0)) (ppn 0) (v))
+		 ((not (consp vl))
+		  (when vl
+		    (when restp (dm-bad-key '&rest))
+		    (push (list vl (dm-nth-cdr n whole)) *dl*)
+		    (setq no-check t))
+		  (when (and rest (not allow-other-keys))
+		    (push (cons rest keys) *key-check*))
+		  (unless no-check (push (cons whole n) *arg-check*))
+		  ppn)
+	       (declare (fixnum n ppn))
+	       (setq v (car vl))
+	       (cond
+		 ((eq v '&optional)
+		  (when optionalp (dm-bad-key '&optional))
+		  (setq optionalp t)
+		  (pop vl))
+		 ((and macro (eq v '&body))
+		  (when restp (dm-bad-key v))
+		  (dm-v (second vl) (dm-nth-cdr n whole))
+		  (setq restp t optionalp t no-check t)
+		  (setq vl (cddr vl))
+		  (setq ppn (if top (1- n) n)))
+		 ((or (eq v '&rest) (eq v '&body))
+		  (when restp (dm-bad-key v))
+		  (dm-v (second vl) (dm-nth-cdr n whole))
+		  (setq restp t optionalp t no-check t)
+		  (setq vl (cddr vl)))
+		 ((eq v '&key)
+		  (when keyp (dm-bad-key '&key))
+		  (setq rest (gensym))
+		  (push (list rest (dm-nth-cdr n whole)) *dl*)
+		  (setq keyp t restp t optionalp t no-check t)
+		  (pop vl))
+		 ((eq v '&allow-other-keys)
+		  (when (or (not keyp) allow-other-keys-p)
+		    (dm-bad-key '&allow-other-keys))
+		  (setq allow-other-keys-p t)
+		  (setq allow-other-keys t)
+		  (pop vl))
+		 ((eq v '&aux)
+		  (when auxp (dm-bad-key '&aux))
+		  (setq auxp t allow-other-keys-p t keyp t restp t optionalp t)
+		  (pop vl))
+		 (auxp
+		  (let (x (init nil))
+		    (cond ((symbolp v) (setq x v))
+			  (t (setq x (car v))
+			     (unless (endp (cdr v)) (setq init (second v)))))
+		    (dm-v x init))
+		  (pop vl))
+		 (keyp
+		  (let ((temp (gensym)) x k (init nil) (sv nil))
+		    (cond ((symbolp v) (setq x v
+					     k (intern (string v) 'keyword)))
+			  (t (if (symbolp (car v))
+				 (setq x (car v)
+				       k (intern (string (car v)) 'keyword))
+				 (setq x (cadar v) k (caar v)))
+			     (unless (endp (cdr v))
+			       (setq init (second v))
+			       (unless (endp (cddr v))
+				 (setq sv (caddr v))))))
+		    (dm-v temp `(search-keyword ,rest ',k))
+		    (dm-v x `(if (eq ,temp 'failed) ,init ,temp))
+		    (when sv (dm-v sv `(not (eq ,temp 'failed))))
+		    (push k keys))
+		  (pop vl))
+		 (optionalp
+		  (let (x (init nil) (sv nil))
+		    (cond ((symbolp v) (setq x v))
+			  (t (setq x (car v))
+			     (unless (endp (cdr v))
+			       (setq init (second v))
+			       (unless (endp (cddr v))
+				 (setq sv (caddr v))))))
+		    (dm-v x `(if ,(dm-nth-cdr n whole) ,(dm-nth n whole) ,init))
+		    (when sv (dm-v sv `(not (null ,(dm-nth-cdr n whole))))))
+		  (incf n)
+		  (pop vl))
+		 (t (dm-v v `(if ,(dm-nth-cdr n whole)
+			      ,(dm-nth n whole)
+			      (dm-too-few-arguments)))
+		    (incf n)
+		    (pop vl)))))
+
+	   (dm-v (v init)
+	     (cond ((symbolp v)
+		    (push (if init (list v init) v) *dl*))
+		   ((atom v)
+		    (error "destructure: ~A is not a list nor a symbol" v))
+		   ((eq (car v) '&whole)
+		    (let ((temp (cadr v)))
+		      (push (if init (list temp init) temp) *dl*)
+		      (dm-vl (cddr v) temp nil)))
+		   (t
+		    (let ((temp (gensym)))
+		      (push (if init (list temp init) temp) *dl*)
+		      (dm-vl v temp nil)))))
+
+	   (dm-nth (n v)
+	     (multiple-value-bind (q r) (floor n 4)
+	       (declare (fixnum q r))
+	       (dotimes (i q) (setq v (list 'CDDDDR v)))
+	       (case r
+		 (0 (list 'CAR v))
+		 (1 (list 'CADR v))
+		 (2 (list 'CADDR v))
+		 (3 (list 'CADDDR v))
+		 )))
+
+	   (dm-nth-cdr (n v)
+	     (multiple-value-bind (q r) (floor n 4)
+	       (declare (fixnum q r))
+	       (dotimes (i q) (setq v (list 'CDDDDR v)))
+	       (case r
+		 (0 v)
+		 (1 (list 'CDR v))
+		 (2 (list 'CDDR v))
+		 (3 (list 'CDDDR v))
+		 ))))
+
+  (cond ((listp vl))
+        ((symbolp vl) (setq vl (list '&rest vl)))
+        (t (error "The destructuring-lambda-list ~s is not a list." vl)))
+  (let ((ppn (dm-vl vl whole macro)))
+    (values ppn (nreverse *dl*) *key-check* *arg-check*))))
+
+;;; valid lambda-list to DEFMACRO is:
+;;;
+;;;	( [ &whole sym ]
+;;;	  [ &environment sym ]
+;;;	  { v }*
+;;;	  [ &optional { sym | ( v [ init [ v ] ] ) }* ]
+;;;	  {  [ { &rest | &body } v ]
+;;;	     [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }*
+;;;		    [ &allow-other-keys ]]
+;;;	     [ &aux { sym | ( v [ init ] ) }* ]
+;;;	  |  . sym }
+;;;	 )
+;;;
+;;; where v is short for { defmacro-lambda-list | sym }.
+;;; A symbol may be accepted as a DEFMACRO lambda-list, in which case
+;;; (DEFMACRO <name> <symbol> ... ) is equivalent to
+;;; (DEFMACRO <name> (&REST <symbol>) ...).
+;;; Defmacro-lambda-list is defined as:
+;;;
+;;;	( { v }*
+;;;	  [ &optional { sym | ( v [ init [ v ] ] ) }* ]
+;;;	  {  [ { &rest | &body } v ]
+;;;	     [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }*
+;;;		    [ &allow-other-keys ]]
+;;;	     [ &aux { sym | ( v [ init ] ) }* ]
+;;;	  |  . sym }
+;;;	 )
+(defun find-documentation (body)
+  (nth-value 3 (process-declarations body t)))
+
+(defun find-declarations (body &optional (doc t))
+  (multiple-value-bind (decls body doc)
+      (process-declarations body doc)
+    (values (if decls `((declare ,@decls)) nil)
+	    body doc)))
+
+(defun sys::expand-defmacro (name vl body
+			     &aux *dl* *key-check* *arg-check*
+			     doc decls whole ppn env)
+  (multiple-value-setq (decls body doc)
+    (find-declarations body))
+  (if (and (consp vl) (eq (car vl) '&whole))
+    (setq whole (second vl) vl (cddr vl))
+    (setq whole (gensym)))
+  (if (setq env (member '&environment vl :test #'eq))
+      (setq vl (nconc (ldiff vl env) (cddr env))
+	    env (second env))
+      (progn
+	(setq env (gensym))
+	(push `(declare (ignore ,env)) decls)))
+  (multiple-value-bind (ppn *dl* *key-check* *arg-check*)
+      (destructure vl whole t)
+    (dolist (kc *key-check*)
+      (push `(check-keyword ,(car kc) ',(cdr kc)) body))
+    (dolist (ac *arg-check*)
+      (push `(unless (<= (list-length ,(car ac)) ,(cdr ac))
+	      (dm-too-many-arguments)) body))
+    (setq body (nconc decls body))
+    (when doc (push doc body))
+    (values (list* 'LAMBDA (list* whole env '&aux *dl*) body)
+	    ppn)))
+
+(si::fset 'defmacro
+	  #'(lambda-block defmacro (def env)
+	      (let* ((name (second def))
+		     (vl (third def))
+		     (body (cdddr def))
+		     (function))
+		(multiple-value-bind (expr pprint)
+		    (sys::expand-defmacro name vl body)
+		  (setq function `#'(lambda-block ,name ,@(cdr expr)))
+		  (when *dump-defmacro-definitions*
+		    (print function)
+		    (setq function `(si::bc-disassemble ,function)))
+		  `(si::fset ',name ,function t ,pprint))))
+	  t)
+
+;;; valid lambda-list to DESTRUCTURING-BIND is:
+;;;
+;;;	( [ &whole sym ]
+;;;	  { v }*
+;;;	  [ &optional { sym | ( v [ init [ v ] ] ) }* ]
+;;;	  {  [ { &rest | &body } v ]
+;;;	     [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }*
+;;;		    [ &allow-other-keys ]]
+;;;	     [ &aux { sym | ( v [ init ] ) }* ]
+;;;	  |  . sym }
+;;;	 )
+;;;
+;;; where v is short for { destructuring-bind-lambda-list | sym }.
+;;; A symbol may be accepted as a DESTRUCTURING-BIND lambda-list, in which case
+;;; (DESTRUCTURING-BIND <name> <symbol> ... ) is equivalent to
+;;; (DESTRUCTURING-BIND <name> (&REST <symbol>) ...).
+;;; Destructuring-bind-lambda-list is defined as:
+;;;
+;;;	( [ &whole sym ]
+;;;	  { v }*
+;;;	  [ &optional { sym | ( v [ init [ v ] ] ) }* ]
+;;;	  {  [ { &rest | &body } v ]
+;;;	     [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }*
+;;;		    [ &allow-other-keys ]]
+;;;	     [ &aux { sym | ( v [ init ] ) }* ]
+;;;	  |  . sym }
+;;;	 )
+
+(defmacro destructuring-bind (vl list &body body &aux (decls nil))
+  (do ()
+      ((or (atom body)
+	   (atom (car body))
+	   (not (eq (caar body) 'declare))))
+    (push (car body) decls)
+    (pop body))
+  (multiple-value-bind (ppn *dl* *key-check* *arg-check*)
+      (destructure vl '<destructured-form> nil)
+    (dolist (kc *key-check*)
+      (push `(check-keyword ,(car kc) ',(cdr kc)) body))
+    (dolist (ac *arg-check*)
+      (push `(unless (<= (list-length ,(car ac)) ,(cdr ac))
+	      (dm-too-many-arguments)) body))
+    (list* 'let* (cons (list '<destructured-form> list) *dl*)
+	   (nconc decls body))))
+
+(defun warn (&rest foo) nil)
diff --git a/src/lsp/defpackage.lsp b/src/lsp/defpackage.lsp
new file mode 100644
index 000000000..2d04d7154
--- /dev/null
+++ b/src/lsp/defpackage.lsp
@@ -0,0 +1,245 @@
+;;; -*- Mode: LISP; Syntax: Common-lisp; Base: 10; Package: (DEFPACKAGE :COLON-MODE :EXTERNAL) -*-
+;;;
+;;;				 THE BOEING COMPANY
+;;;			      BOEING COMPUTER SERVICES
+;;;			       RESEARCH AND TECHNOLOGY
+;;;				  COMPUTER SCIENCE
+;;;			      P.O. BOX 24346, MS 7L-64
+;;;			       SEATTLE, WA 98124-0346
+;;;
+;;;
+;;; Copyright (c) 1990, 1991 The Boeing Company, All Rights Reserved.
+;;;
+;;; Permission is granted to any individual or institution to use,
+;;; copy, modify, and distribute this software, provided that this
+;;; complete copyright and permission notice is maintained, intact, in
+;;; all copies and supporting documentation and that modifications are
+;;; appropriately documented with date, author and description of the
+;;; change.
+;;;
+;;; Stephen L. Nicoud (snicoud@boeing.com) provides this software "as
+;;; is" without express or implied warranty by him or The Boeing
+;;; Company.
+;;;
+;;; This software is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY.  No author or distributor accepts
+;;; responsibility to anyone for the consequences of using it or for
+;;; whether it serves any particular purpose or works at all.
+;;;
+;;;	Author:	Stephen L. Nicoud
+;;;
+;;; -----------------------------------------------------------------
+;;;
+;;;	Adapted for ECL by Giuseppe Attardi, 6/6/1994.
+;;; 
+;;; -----------------------------------------------------------------
+
+;;; -----------------------------------------------------------------
+;;;
+;;;	DEFPACKAGE - This files attempts to define a portable
+;;;	implementation for DEFPACKAGE, as defined in "Common LISP, The
+;;;	Language", by Guy L. Steele, Jr., Second Edition, 1990, Digital
+;;;	Press.
+;;;
+;;;	Send comments, suggestions, and/or questions to:
+;;;
+;;;		Stephen L Nicoud <snicoud@boeing.com>
+;;;
+;;;	An early version of this file was tested in Symbolics Common
+;;;	Lisp (Genera 7.2 & 8.0 on a Symbolics 3650 Lisp Machine),
+;;;	Franz's Allegro Common Lisp (Release 3.1.13 on a Sun 4, SunOS
+;;;	4.1), and Sun Common Lisp (Lucid Common Lisp 3.0.2 on a Sun 3,
+;;;	SunOS 4.1).
+;;;
+;;;	91/5/23 (SLN) - Since the initial testing, modifications have
+;;;	been made to reflect new understandings of what DEFPACKAGE
+;;;	should do.  These new understandings are the result of
+;;;	discussions appearing on the X3J13 and Common Lisp mailing
+;;;	lists.  Cursory testing was done on the modified version only
+;;;	in Allegro Common Lisp (Release 3.1.13 on a Sun 4, SunOS 4.1).
+;;;
+;;; -----------------------------------------------------------------
+
+(in-package "SYSTEM")
+
+(defmacro DEFPACKAGE (name &rest options)
+  (declare (type (or symbol string) name))
+  "DEFPACKAGE - DEFINED-PACKAGE-NAME {OPTION}*			[Macro]
+
+   This creates a new package, or modifies an existing one, whose name is
+   DEFINED-PACKAGE-NAME.  The DEFINED-PACKAGE-NAME may be a string or a 
+   symbol; if it is a symbol, only its print name matters, and not what
+   package, if any, the symbol happens to be in.  The newly created or 
+   modified package is returned as the value of the DEFPACKAGE form.
+
+   Each standard OPTION is a list of keyword (the name of the option)
+   and associated arguments.  No part of a DEFPACKAGE form is evaluated.
+   Except for the :SIZE and :DOCUMENTATION options, more than one option 
+   of the same kind may occur within the same DEFPACKAGE form.
+
+  Valid Options:
+	(:documentation		string)
+	(:size			integer)
+	(:nicknames		{package-name}*)
+	(:shadow		{symbol-name}*)
+	(:shadowing-import-from	package-name {symbol-name}*)
+	(:use			{package-name}*)
+	(:import-from		package-name {symbol-name}*)
+	(:intern		{symbol-name}*)
+	(:export		{symbol-name}*)
+	(:export-from		{package-name}*)
+
+  [Note: :EXPORT-FROM is an extension to DEFPACKAGE.
+	 If a symbol is interned in the package being created and
+	 if a symbol with the same print name appears as an external
+	 symbol of one of the packages in the :EXPORT-FROM option,
+	 then the symbol is exported from the package being created.
+
+	 :DOCUMENTATION is an extension to DEFPACKAGE.
+
+	 :SIZE is used only in Genera and Allegro.]"
+
+  (dolist (option options)
+    (unless (member (first option)
+		    '(:DOCUMENTATION :SIZE :NICKNAMES :SHADOW
+		      :SHADOWING-IMPORT-FROM :USE :IMPORT-FROM :INTERN :EXPORT
+		      :EXPORT-FROM) :test #'eq)
+      (cerror "Proceed, ignoring this option."
+	      "~s is not a valid DEFPACKAGE option." option)))
+  (labels ((option-test (arg1 arg2)
+	     (when (consp arg2) (equal (car arg2) arg1)))
+	   (option-values-list (option options)
+	     (loop for result first (member option options
+					    ':test #'option-test)
+			      then (member option (rest result)
+					   ':test #'option-test)
+		   until (null result)
+		   when result collect (rest (first result))))
+	   (option-values (option options)
+	     (loop for result first (member option options
+					    ':test #'option-test)
+			      then (member option (rest result)
+					   ':test #'option-test)
+		   until (null result)
+		   when result append (rest (first result)))))
+    (dolist (option '(:SIZE :DOCUMENTATION))
+      (when (<= 2 (count option options ':key #'car))
+	(warn "DEFPACKAGE option ~s specified more than once.  The first value \"~a\" will be used."
+	      option (first (option-values option options)))))
+    (setq name (string name))
+    (let ((nicknames (mapcar #'string (option-values ':nicknames options)))
+	  (documentation (first (option-values ':documentation options)))
+	  (shadowed-symbol-names (mapcar #'string
+					 (option-values ':shadow options)))
+	  (interned-symbol-names (mapcar #'string
+					 (option-values ':intern options)))
+	  (exported-symbol-names (mapcar #'string
+					 (option-values ':export options)))
+	  (shadowing-imported-from-symbol-names-list
+	   (loop for list in (option-values-list
+			      ':shadowing-import-from options)
+		 collect (cons (string (first list))
+			       (mapcar #'string (rest list)))))
+	  (imported-from-symbol-names-list
+	   (loop for list in (option-values-list ':import-from options)
+		 collect (cons (string (first list)) (mapcar #'string
+							     (rest list)))))
+	  (exported-from-package-names (mapcar #'string
+					       (option-values ':export-from
+							      options))))
+      `(si::%defpackage
+	,name
+	',nicknames
+	,documentation
+	',(mapcar #'string (option-values ':use options))
+	',shadowed-symbol-names
+	',interned-symbol-names
+	',exported-symbol-names
+	',shadowing-imported-from-symbol-names-list
+	',imported-from-symbol-names-list
+	',exported-from-package-names))))
+
+
+(defun %defpackage (name
+		    nicknames
+		    documentation
+		    use
+		    shadowed-symbol-names
+		    interned-symbol-names
+		    exported-symbol-names
+		    shadowing-imported-from-symbol-names-list
+		    imported-from-symbol-names-list
+		    exported-from-package-names)
+  (flet ((find-duplicates (&rest lists)
+	   (let (results)
+	     (loop for list in lists
+		   for more on (cdr lists)
+		   for i from 1
+		   do
+		   (loop for elt in list
+			 as entry = (find elt results :key #'car
+					  :test #'string=)
+			 unless (member i entry)
+			 do
+			 (loop for l2 in more
+			       for j from (1+ i)
+			       do
+			       (if (member elt l2 :test #'string=)
+				 (if entry
+				   (nconc entry (list j))
+				   (setq entry (car (push (list elt i j)
+							  results))))))))
+	     results)))
+    (dolist (duplicate (find-duplicates shadowed-symbol-names
+					interned-symbol-names
+					(loop for list in shadowing-imported-from-symbol-names-list append (rest list))
+					(loop for list in imported-from-symbol-names-list append (rest list))))
+      (error "The symbol ~s cannot coexist in these lists:~{ ~s~}"
+	     (first duplicate)
+	     (loop for num in (rest duplicate)
+		   collect (case num
+			     (1 ':SHADOW)
+			     (2 ':INTERN)
+			     (3 ':SHADOWING-IMPORT-FROM)
+			     (4 ':IMPORT-FROM)))))
+    (dolist (duplicate (find-duplicates exported-symbol-names interned-symbol-names))
+      (error "The symbol ~s cannot coexist in these lists:~{ ~s~}"
+	     (first duplicate)
+	     (loop for num in (rest duplicate) collect
+		   (case num
+		     (1 ':EXPORT)
+		     (2 ':INTERN))))))
+  (if (find-package name)
+    (progn ; (rename-package name name)
+      (when nicknames
+	(rename-package name name nicknames))
+      (when use
+	(unuse-package (package-use-list (find-package name)) name)))
+    (make-package name :use nil :nicknames nicknames))
+  #+nil
+  (when documentation ((setf (get (intern name :keyword)
+				  :package-documentation)
+			     documentation)))
+  (let ((*package* (find-package name)))
+    (when shadowed-symbol-names
+      (shadow (mapcar #'intern shadowed-symbol-names)))
+    (when shadowing-imported-from-symbol-names-list
+      (shadowing-import (rest shadowing-imported-from-symbol-names-list)
+			(first shadowing-imported-from-symbol-names-list)))
+    (use-package (or use "CL"))
+    (when imported-from-symbol-names-list
+      (import (rest imported-from-symbol-names-list)
+	      (first imported-from-symbol-names-list)))
+    (when exported-symbol-names
+      (export (mapcar #'intern exported-symbol-names)))
+    (when exported-from-package-names
+      (dolist (package exported-from-package-names)
+	(do-external-symbols (symbol (find-package package))
+	  (when (nth 1 (multiple-value-list
+			(find-symbol (string symbol))))
+	    (export (list (intern (string symbol)))))))))
+  (find-package name))
+
+;;;; ------------------------------------------------------------
+;;;;	End of File
+;;;; ------------------------------------------------------------
diff --git a/src/lsp/defstruct.lsp b/src/lsp/defstruct.lsp
new file mode 100644
index 000000000..00801da33
--- /dev/null
+++ b/src/lsp/defstruct.lsp
@@ -0,0 +1,638 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;;        The structure routines.
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+
+(defun make-access-function (name conc-name type named slot-descr)
+  (declare (ignore named))
+  (let* ((slot-name (nth 0 slot-descr))
+	 ;; (default-init (nth 1 slot-descr))
+	 ;; (slot-type (nth 2 slot-descr))
+	 (read-only (nth 3 slot-descr))
+	 (offset (nth 4 slot-descr))
+	 (access-function (intern (sys:string-concatenate (string conc-name)
+							 (string slot-name)))))
+    (cond ((null type)
+           ;; If TYPE is NIL,
+           ;;  the slot is at the offset in the structure-body.
+	   (fset access-function #'(lambda (x)
+				     (sys:structure-ref x name offset))))
+          ((or (eq type 'VECTOR)
+               (and (consp type)
+                    (eq (car type) 'VECTOR)))
+	   ;; If TYPE is VECTOR or (VECTOR ... ), ELT is used.
+           (fset access-function
+		 #'(lambda (x) (elt x offset))))
+          ((eq type 'LIST)
+           ;; If TYPE is LIST, NTH is used.
+	   (fset access-function
+		 #'(lambda (x) (sys:list-nth offset x))))
+          (t (error "~S is an illegal structure type." type)))
+    (if read-only
+	(progn
+	  (remprop access-function 'SETF-UPDATE-FN)
+	  (remprop access-function 'SETF-LAMBDA)
+	  (remprop access-function 'SETF-DOCUMENTATION))
+	(progn
+	  ;; The following is used by the compiler to expand inline
+	  ;; the accessor
+	  (sys:putprop access-function (cons (or type name) offset)
+		      'STRUCTURE-ACCESS))))
+  )
+
+(defun make-constructor (name constructor type named slot-descriptions)
+  (declare (ignore named))
+  (let ((slot-names
+         ;; Collect the slot-names.
+         (mapcar #'(lambda (x)
+                     (cond ((null x)
+                            ;; If the slot-description is NIL,
+                            ;;  it is in the padding of initial-offset.
+                            nil)
+                           ((null (car x))
+                            ;; If the slot name is NIL,
+                            ;;  it is the structure name.
+                            ;;  This is for typed structures with names.
+                            (list 'QUOTE (cadr x)))
+                           (t (car x))))
+                 slot-descriptions))
+        (keys
+         ;; Make the keyword parameters.
+         (mapcan #'(lambda (x)
+                     (cond ((null x) nil)
+                           ((null (car x)) nil)
+                           ((null (cadr x)) (list (car x)))
+                           (t (list (list  (car x) (cadr x))))))
+                 slot-descriptions)))
+    (cond ((consp constructor)
+           ;; The case for a BOA constructor.
+           ;; Dirty code!!
+           ;; We must add an initial value for an optional parameter,
+           ;;  if the default value is not specified
+           ;;  in the given parameter list and yet the initial value
+           ;;  is supplied in the slot description.
+           (do ((a (cadr constructor) (cdr a)) (l nil) (vs nil))
+               ((endp a)
+                ;; Add those options that do not appear in the parameter list
+                ;;  as auxiliary paramters.
+                ;; The parameters are accumulated in the variable VS.
+                (setq keys
+                      (nreconc (cons '&aux l)
+                               (mapcan #'(lambda (k)
+                                           (if (member (if (atom k) k (car k))
+                                                       vs)
+                                               nil
+                                               (list k)))
+                                       keys))))
+             ;; Skip until &OPTIONAL appears.
+             (cond ((eq (car a) '&optional)
+                    (setq l (cons '&optional l))
+                    (do ((aa (cdr a) (cdr aa)) (ov) (y))
+                        ((endp aa)
+                         ;; Add those options that do not appear in the
+                         ;;  parameter list.
+                         (setq keys
+                               (nreconc (cons '&aux l)
+                                        (mapcan #'(lambda (k)
+                                                    (if (member (if (atom k)
+                                                                    k
+                                                                    (car k))
+                                                                vs)
+                                                        nil
+                                                        (list k)))
+                                                keys)))
+                         (return nil))
+                      (when (member (car aa) lambda-list-keywords)
+                            (when (eq (car aa) '&rest)
+                                  ;; &REST is found.
+                                  (setq l (cons '&rest l))
+                                  (setq aa (cdr aa))
+                                  (unless (and (not (endp aa))
+                                               (symbolp (car aa)))
+                                          (illegal-boa))
+                                  (setq vs (cons (car aa) vs))
+                                  (setq l (cons (car aa) l))
+                                  (setq aa (cdr aa))
+                                  (when (endp aa)
+                                        (setq keys
+                                              (nreconc
+                                               (cons '&aux l)
+                                               (mapcan
+                                                #'(lambda (k)
+                                                    (if (member (if (atom k)
+                                                                    k
+                                                                    (car k))
+                                                                vs)
+                                                        nil
+                                                        (list k)))
+                                                keys)))
+                                        (return nil)))
+                            ;; &AUX should follow.
+                            (unless (eq (car aa) '&aux)
+                                    (illegal-boa))
+                            (setq l (cons '&aux l))
+                            (do ((aaa (cdr aa) (cdr aaa)))
+                                ((endp aaa))
+                              (setq l (cons (car aaa) l))
+                              (cond ((and (atom (car aaa))
+                                          (symbolp (car aaa)))
+                                     (setq vs (cons (car aaa) vs)))
+                                    ((and (symbolp (caar aaa))
+                                          (or (endp (cdar aaa))
+                                              (endp (cddar aaa))))
+                                     (setq vs (cons (caar aaa) vs)))
+                                    (t (illegal-boa))))
+                            ;; End of the parameter list.
+                            (setq keys
+                                  (nreconc l
+                                           (mapcan
+                                            #'(lambda (k)
+                                                (if (member (if (atom k)
+                                                                k
+                                                                (car k))
+                                                            vs)
+                                                    nil
+                                                    (list k)))
+                                            keys)))
+                            (return nil))
+                      ;; Checks if the optional paramter without a default
+                      ;;  value has a default value in the slot-description.
+                      (if (and (cond ((atom (car aa)) (setq ov (car aa)) t)
+                                     ((endp (cdar aa)) (setq ov (caar aa)) t)
+                                     (t nil))
+                               (setq y (member ov
+                                               keys
+                                               :key
+                                               #'(lambda (x)
+                                                   (if (consp x)
+                                                       ;; With default value.
+                                                       (car x))))))
+                          ;; If no default value is supplied for
+                          ;;  the optional parameter and yet appears
+                          ;;  in KEYS with a default value,
+                          ;;  then cons the pair to L,
+                          (setq l (cons (car y) l))
+                          ;;  otherwise cons just the parameter to L.
+                          (setq l (cons (car aa) l)))
+                      ;; Checks the form of the optional parameter.
+                      (cond ((atom (car aa))
+                             (unless (symbolp (car aa))
+                                     (illegal-boa))
+                             (setq vs (cons (car aa) vs)))
+                            ((not (symbolp (caar aa)))
+                             (illegal-boa))
+                            ((or (endp (cdar aa)) (endp (cddar aa)))
+                             (setq vs (cons (caar aa) vs)))
+                            ((not (symbolp (caddar aa)))
+                             (illegal-boa))
+                            ((not (endp (cdddar aa)))
+                             (illegal-boa))
+                            (t
+                             (setq vs (cons (caar aa) vs))
+                             (setq vs (cons (caddar aa) vs)))))
+                    ;; RETURN from the outside DO.
+                    (return nil))
+                   (t
+                    (unless (symbolp (car a))
+                            (illegal-boa))
+                    (setq l (cons (car a) l))
+                    (setq vs (cons (car a) vs)))))
+           (setq constructor (car constructor)))
+          (t
+           ;; If not a BOA constructor, just cons &KEY.
+           (setq keys (cons '&key keys))))
+    (cond ((null type)
+           `(defun ,constructor ,keys
+	      #-CLOS
+              (sys:make-structure ',name ,@slot-names)
+	      #+CLOS
+	      (sys:make-structure (find-class ',name) ,@slot-names)))
+          ((or (eq type 'VECTOR)
+               (and (consp type) (eq (car type) 'vector)))
+           `(defun ,constructor ,keys
+              (vector ,@slot-names)))
+          ((eq type 'LIST)
+           `(defun ,constructor ,keys
+              (list ,@slot-names)))
+          ((error "~S is an illegal structure type" type)))))
+
+
+(defun illegal-boa ()
+  (error "An illegal BOA constructor."))
+
+
+(defun make-predicate (name type named name-offset)
+  (cond ((null type)
+	 #'(lambda (x)
+	     (structure-subtype-p x name)))
+        ((or (eq type 'VECTOR)
+             (and (consp type) (eq (car type) 'VECTOR)))
+         ;; The name is at the NAME-OFFSET in the vector.
+         (unless named (error "The structure should be named."))
+	 #'(lambda (x)
+	     (and (vectorp x)
+		  (> (length x) name-offset)
+		  ;; AKCL has (aref (the (vector t) x).)
+		  ;; which fails with strings
+		  (eq (elt x name-offset) name))))
+        ((eq type 'LIST)
+         ;; The name is at the NAME-OFFSET in the list.
+         (unless named (error "The structure should be named."))
+         (if (= name-offset 0)
+	     #'(lambda (x)
+		 (and (consp x) (eq (car x) name)))
+	     #'(lambda (x)
+		 (do ((i name-offset (1- i))
+		      (y x (cdr y)))
+		     ((= i 0) (and (consp y) (eq (car y) name)))
+		   (declare (fixnum i))
+		   (unless (consp y) (return nil))))))
+        ((error "~S is an illegal structure type."))))
+
+
+;;; PARSE-SLOT-DESCRIPTION parses the given slot-description
+;;;  and returns a list of the form:
+;;;        (slot-name default-init slot-type read-only offset)
+
+(defun parse-slot-description (slot-description offset)
+  (let (slot-name default-init slot-type read-only)
+    (cond ((atom slot-description)
+           (setq slot-name slot-description))
+          ((endp (cdr slot-description))
+           (setq slot-name (car slot-description)))
+          (t
+           (setq slot-name (car slot-description))
+           (setq default-init (cadr slot-description))
+           (do ((os (cddr slot-description) (cddr os)) (o) (v))
+               ((endp os))
+             (setq o (car os))
+             (when (endp (cdr os))
+                   (error "~S is an illegal structure slot option."
+                          os))
+             (setq v (cadr os))
+             (case o
+               (:TYPE (setq slot-type v))
+               (:READ-ONLY (setq read-only v))
+               (t
+                (error "~S is an illegal structure slot option."
+                         os))))))
+    (list slot-name default-init slot-type read-only offset)))
+
+
+;;; OVERWRITE-SLOT-DESCRIPTIONS overwrites the old slot-descriptions
+;;;  with the new descriptions which are specified in the
+;;;  :include defstruct option.
+
+(defun overwrite-slot-descriptions (news olds)
+  (when olds
+      (let ((sds (member (caar olds) news :key #'car)))
+        (cond (sds
+               (when (and (null (cadddr (car sds)))
+                          (cadddr (car olds)))
+                     ;; If read-only is true in the old
+                     ;;  and false in the new, signal an error.
+                     (error "~S is an illegal include slot-description."
+                            sds))
+               (cons (list (caar sds)
+                           (cadar sds)
+                           (caddar sds)
+                           (cadddr (car sds))
+                           ;; The offset if from the old.
+                           (car (cddddr (car olds))))
+                     (overwrite-slot-descriptions news (cdr olds))))
+              (t
+               (cons (car olds)
+                     (overwrite-slot-descriptions news (cdr olds))))))))
+
+
+(defun define-structure (name conc-name type named slots slot-descriptions
+			      copier include print-function constructors
+			      offset documentation)
+  (sys:put-properties name
+		      'DEFSTRUCT-FORM `(defstruct ,name ,@slots)
+		      'IS-A-STRUCTURE t
+		      'STRUCTURE-SLOT-DESCRIPTIONS slot-descriptions
+		      'STRUCTURE-INCLUDE include
+		      'STRUCTURE-PRINT-FUNCTION print-function
+		      'STRUCTURE-TYPE type
+		      'STRUCTURE-NAMED named
+		      'STRUCTURE-OFFSET offset
+		      'STRUCTURE-CONSTRUCTORS constructors
+		      'STRUCTURE-DOCUMENTATION documentation)
+  (and (consp type) (eq (car type) 'VECTOR)
+       (setq type 'VECTOR))
+  (dolist (x slot-descriptions)
+    (and x (car x)
+	 (funcall #'make-access-function name conc-name type named x)))
+  (when copier
+    (fset copier
+	  (ecase type
+	    ((NIL) #'sys::copy-structure)
+	    (LIST #'copy-list)
+	    (VECTOR #'copy-seq))))
+  )
+
+;;; The DEFSTRUCT macro.
+
+(defmacro defstruct (name &rest slots)
+  (let ((slot-descriptions slots)
+	;;#+clos
+	local-slot-descriptions
+        options
+        conc-name
+        constructors default-constructor no-constructor
+        copier
+        predicate predicate-specified
+        include
+        print-function type named initial-offset
+        offset name-offset
+        documentation)
+
+    (when (consp name)
+          ;; The defstruct options are supplied.
+          (setq options (cdr name))
+          (setq name (car name)))
+
+    ;; The default conc-name.
+    (setq conc-name (sys:string-concatenate (string name) "-"))
+
+    ;; The default constructor.
+    (setq default-constructor
+          (intern (sys:string-concatenate "MAKE-" (string name))))
+
+    ;; The default copier and predicate.
+    (setq copier
+          (intern (sys:string-concatenate "COPY-" (string name)))
+          predicate
+          (intern (sys:string-concatenate (string name) "-P")))
+
+    ;; Parse the defstruct options.
+    (do ((os options (cdr os)) (o) (v))
+        ((endp os))
+      (cond ((and (consp (car os)) (not (endp (cdar os))))
+             (setq o (caar os) v (cadar os))
+             (case o
+               (:CONC-NAME
+                (if (null v)
+                    (setq conc-name "")
+                    (setq conc-name v)))
+               (:CONSTRUCTOR
+                (if (null v)
+                    (setq no-constructor t)
+                    (if (endp (cddar os))
+                        (setq constructors (cons v constructors))
+                        (setq constructors (cons (cdar os) constructors)))))
+               (:COPIER (setq copier v))
+               (:PREDICATE
+                (setq predicate v)
+                (setq predicate-specified t))
+               (:INCLUDE
+                (setq include (cdar os))
+                (unless (get v 'IS-A-STRUCTURE)
+                        (error "~S is an illegal included structure." v)))
+               (:PRINT-FUNCTION (setq print-function v))
+               (:TYPE (setq type v))
+               (:INITIAL-OFFSET (setq initial-offset v))
+               (t (error "~S is an illegal defstruct option." o))))
+            (t
+             (if (consp (car os))
+                 (setq o (caar os))
+                 (setq o (car os)))
+             (case o
+               (:CONSTRUCTOR
+                (setq constructors
+                      (cons default-constructor constructors)))
+               ((:CONC-NAME :COPIER :PREDICATE :PRINT-FUNCTION))
+               (:NAMED (setq named t))
+               (t (error "~S is an illegal defstruct option." o))))))
+
+    (setq conc-name (intern (string conc-name)))
+
+    ;; Skip the documentation string.
+    (when (and (not (endp slot-descriptions))
+               (stringp (car slot-descriptions)))
+          (setq documentation (car slot-descriptions))
+          (setq slot-descriptions (cdr slot-descriptions)))
+    
+    ;; Check the include option.
+    (when include
+          (unless (equal type (get (car include) 'STRUCTURE-TYPE))
+                  (error "~S is an illegal structure include."
+                         (car include))))
+
+    ;; Set OFFSET.
+    (setq offset (if include
+		     (get (car include) 'STRUCTURE-OFFSET)
+		     0))
+
+    ;; Increment OFFSET.
+    (when (and type initial-offset)
+          (setq offset (+ offset initial-offset)))
+    (when (and type named)
+          (setq name-offset offset)
+          (setq offset (1+ offset)))
+
+    ;; Parse slot-descriptions, incrementing OFFSET for each one.
+    (do ((ds slot-descriptions (cdr ds))
+         (sds nil))
+        ((endp ds)
+         (setq slot-descriptions (nreverse sds)))
+      (push (parse-slot-description (car ds) offset) sds)
+      (setq offset (1+ offset)))
+
+    ;; If TYPE is non-NIL and structure is named,
+    ;;  add the slot for the structure-name to the slot-descriptions.
+    (when (and type named)
+          (setq slot-descriptions
+                (cons (list nil name) slot-descriptions)))
+
+    ;; Pad the slot-descriptions with the initial-offset number of NILs.
+    (when (and type initial-offset)
+          (setq slot-descriptions
+                (append (make-list initial-offset) slot-descriptions)))
+
+    ;;#+clos
+    (setq local-slot-descriptions slot-descriptions)
+
+    ;; Append the slot-descriptions of the included structure.
+    ;; The slot-descriptions in the include option are also counted.
+    (cond ((null include))
+          ((endp (cdr include))
+           (setq slot-descriptions
+                 (append (get (car include) 'STRUCTURE-SLOT-DESCRIPTIONS)
+                         slot-descriptions)))
+          (t
+           (setq slot-descriptions
+                 (append (overwrite-slot-descriptions
+                          (mapcar #'(lambda (sd)
+                                      (parse-slot-description sd 0))
+                                  (cdr include))
+                          (get (car include)
+                               'STRUCTURE-SLOT-DESCRIPTIONS))
+                         slot-descriptions))))
+
+    (cond (no-constructor
+           ;; If a constructor option is NIL,
+           ;;  no constructor should have been specified.
+           (when constructors
+                 (error "Contradictory constructor options.")))
+          ((null constructors)
+           ;; If no constructor is specified,
+           ;;  the default-constructor is made.
+           (setq constructors (list default-constructor))))
+
+    ;; Check the named option and set the predicate.
+    (when (and type (not named))
+          (when predicate-specified
+                (error "~S is an illegal structure predicate."
+                       predicate))
+          (setq predicate nil))
+
+    (when include (setq include (car include)))
+
+    ;; Check the print-function.
+    (when (and print-function type)
+          (error "An print function is supplied to a typed structure."))
+
+    (if (or type (not (member ':CLOS *features*)))
+	`(eval-when (compile load eval)
+
+	  (define-structure ',name ',conc-name ',type ',named ',slots
+			    ',slot-descriptions ',copier ',include
+			    ',print-function ',constructors ',offset
+			    ',documentation)
+	  ,@(mapcar #'(lambda (constructor)
+			(make-constructor name constructor type named
+					  slot-descriptions))
+	     constructors)
+	  ,@(when predicate
+	      (list `(fset ',predicate
+		      (make-predicate ',name ',type ',named ',name-offset))))
+	  ',name)
+
+      ;; else (and (not type) (member :CLOS *features*))
+
+      `(eval-when (compile load eval)
+
+	(defclass ,name (,(or include 'STRUCTURE-OBJECT))
+	  ,(mapcar
+	    #'(lambda (sd)
+		(if sd
+		    (list* (first sd)
+			   :initform (second sd)
+			   :initarg 
+			   (intern (symbol-name (first sd))
+				   (find-package 'KEYWORD))
+			   (when (third sd) (list :type (third sd))))
+		    nil))		; for initial offset slots
+	    local-slot-descriptions)
+	  (:metaclass structure-class))
+
+#|	   (with-slots (defstruct-form slot-descriptions initial-offset
+			 constructors documentation copier predicate
+			 print-function)
+		       (find-class ',name)
+              (setq defstruct-form '(defstruct ,name ,@slots))
+	      (setq slot-descriptions ',slot-descriptions)
+	      (setq initial-offset ',structure-offset)
+	      (setq constructors ',constructors)
+	      (setq documentation ,documentation)
+	      (setq copier ,copier)
+	      (setq predicate ,predicate)
+	      (setq print-function ,print-function))
+|#
+
+	,@(if print-function
+	      `((defmethod print-object
+		    ((obj ,name) stream)
+		  (,print-function obj stream *print-level*))))
+
+	(define-structure ',name ',conc-name ',type ',named ',slots
+			  ',slot-descriptions ',copier ',include
+			  ',print-function ',constructors ',offset
+			  ',documentation)
+	,@(mapcar #'(lambda (constructor)
+		      (make-constructor name constructor type named
+					slot-descriptions))
+	   constructors)
+	,@(when predicate
+	    (list `(fset ',predicate
+		    (make-predicate ',name ',type ',named ',name-offset))))
+	',name))))
+
+
+;;; The #S reader.
+
+(defun sharp-s-reader (stream subchar arg)
+  (declare (ignore subchar))
+  (when (and arg (null *read-suppress*))
+        (error "An extra argument was supplied for the #S readmacro."))
+  (let ((l (read stream)))
+    (when *read-suppress*
+      (return-from sharp-s-reader nil))
+    (unless (get (car l) 'IS-A-STRUCTURE)
+            (error "~S is not a structure." (car l)))
+    ;; Intern keywords in the keyword package.
+    (do ((ll (cdr l) (cddr ll)))
+        ((endp ll)
+         ;; Find an appropriate construtor.
+         (do ((cs (get (car l) 'STRUCTURE-CONSTRUCTORS) (cdr cs)))
+             ((endp cs)
+              (error "The structure ~S has no structure constructor."
+                     (car l)))
+           (when (symbolp (car cs))
+                 (return (apply (car cs) (cdr l))))))
+      (rplaca ll (intern (string (car ll)) 'KEYWORD)))))
+
+
+;; Set the dispatch macro.
+(set-dispatch-macro-character #\# #\s 'sharp-s-reader)
+(set-dispatch-macro-character #\# #\S 'sharp-s-reader)
+
+
+;; Examples from Common Lisp Reference Manual.
+
+#|
+(defstruct ship
+  x-position
+  y-position
+  x-velocity
+  y-velocity
+  mass)
+
+(defstruct person name age sex)
+
+(defstruct (astronaut (:include person (age 45))
+                      (:conc-name astro-))
+  helmet-size
+  (favorite-beverage 'tang))
+
+(defstruct (foo (:constructor create-foo (a
+                                          &optional b (c 'sea)
+                                          &rest d
+                                          &aux e (f 'eff))))
+  a (b 'bee) c d e f)
+
+(defstruct (binop (:type list) :named (:initial-offset 2))
+  (operator '?)
+  operand-1
+  operand-2)
+
+(defstruct (annotated-binop (:type list)
+                            (:initial-offset 3)
+                            (:include binop))
+  commutative
+  associative
+  identity)
+|#
diff --git a/src/lsp/defsys.lsp.in b/src/lsp/defsys.lsp.in
new file mode 100644
index 000000000..64af0bc76
--- /dev/null
+++ b/src/lsp/defsys.lsp.in
@@ -0,0 +1,47 @@
+;;; ----------------------------------------------------------------------
+;;;	COMMON LISP LIBRARY
+;;; ----------------------------------------------------------------------
+
+(defparameter
+  *lsp-modules*
+  ;; file	load		compile			files which force
+  ;;		environment	environment		recompilations of
+  ;;							this file
+  '(
+    (export	()		()			())
+    (defmacro	()		()			())
+#-runtime
+    (evalmacros	()		()			())
+#-runtime
+    (top	()		()			())
+    (module	()		()			())
+    (autoload	()		()			())
+    (describe	()		()			())
+    (setf	()		()			())
+    (predlib	()		()			())
+    (arraylib	()		()			())
+    (assert	()		()			())
+    (defstruct	()		()			())
+    (iolib	()		()			())
+    (listlib	()		()			())
+    (mislib	()		()			())
+    (numlib	()		()			())
+    (packlib	()		()			())
+    (seq	()		()			())
+    (seqlib	()		()			())
+    (trace	()		()			())
+    (ansi	()		()			())
+    (loop	()		()			())
+    (defpackage ()		()			())
+    (config	()		()			())
+#+threads
+    (thread	()		()			())
+#+nil ; This is loaded as source file
+    (tk-init	()		()			())))
+
+(sbt:defsystem 
+ lsp
+ :modules *lsp-modules*
+ :source-directory '("@srcdir@/" "@builddir@/lsp/")
+ :fasl-directory "@builddir@/lsp/"
+ :library-directory "@builddir@/")
diff --git a/src/lsp/describe.lsp b/src/lsp/describe.lsp
new file mode 100644
index 000000000..d636ba655
--- /dev/null
+++ b/src/lsp/describe.lsp
@@ -0,0 +1,632 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;                           DESCRIBE and INSPECT
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+(defvar *inspect-level* 0)
+(defvar *inspect-history* nil)
+(defvar *inspect-mode* nil)
+
+(defvar *old-print-level* nil)
+(defvar *old-print-length* nil)
+
+
+(defun inspect-read-line ()
+  (do ((char (read-char *query-io*) (read-char *query-io*)))
+      ((or (char= char #\Newline) (char= char #\Return)))))
+
+(defun select-P (object)
+  (let ((*print-pretty* t) (*print-level* nil) (*print-length* nil))
+       (prin1 object)
+       (terpri)))
+
+(defun select-E ()
+  (dolist (x (multiple-value-list
+	       (multiple-value-prog1
+		 (eval (read-preserving-whitespace *query-io*))
+		 (inspect-read-line))))
+	  (write x
+		 :level *old-print-level*
+		 :length *old-print-length*)
+	  (terpri)))
+
+(defun select-U ()
+  (prog1
+    (eval (read-preserving-whitespace *query-io*))
+    (inspect-read-line)))
+
+(defun select-? ()
+  (terpri)
+  (format t
+	  "Inspect commands:~%~
+                n (or N or Newline):    inspects the field (recursively).~%~
+                s (or S):               skips the field.~%~
+                p (or P):               pretty-prints the field.~%~
+                a (or A):               aborts the inspection ~
+                                        of the rest of the fields.~%~
+                u (or U) form:          updates the field ~
+                                        with the value of the form.~%~
+                e (or E) form:          evaluates and prints the form.~%~
+                q (or Q):               quits the inspection.~%~
+                ?:                      prints this.~%~%"))
+
+(defun read-inspect-command (label object allow-recursive)
+  (unless *inspect-mode*
+    (inspect-indent-1)
+    (if allow-recursive
+        (progn (princ label) (inspect-object object))
+        (format t label object))
+    (return-from read-inspect-command nil))
+  (loop
+    (inspect-indent-1)
+    (if allow-recursive
+        (progn (princ label)
+               (inspect-indent)
+               (prin1 object))
+        (format t label object))
+    (write-char #\Space)
+    (force-output)
+    (case (do ((char (read-char *query-io*) (read-char *query-io*)))
+              ((and (char/= char #\Space) (char/= #\Tab)) char))
+      ((#\Newline #\Return)
+       (when allow-recursive (inspect-object object))
+       (return nil))
+      ((#\n #\N)
+       (inspect-read-line)
+       (when allow-recursive (inspect-object object))
+       (return nil))
+      ((#\s #\S)
+       (inspect-read-line)
+       (return nil))
+      ((#\p #\P)
+       (inspect-read-line)
+       (select-P object))
+      ((#\a #\A)
+       (inspect-read-line)
+       (throw 'ABORT-INSPECT nil))
+      ((#\u #\U)
+       (return (values t (select-U))))
+      ((#\e #\E)
+       (select-E))
+      ((#\q #\Q)
+       (inspect-read-line)
+       (throw 'QUIT-INSPECT nil))
+      ((#\?)
+	(inspect-read-line)
+	(select-?))
+      (t
+        (inspect-read-line))
+      )))
+
+(defmacro inspect-recursively (label object &optional place)
+  (if place
+      `(multiple-value-bind (update-flag new-value)
+            (read-inspect-command ,label ,object t)
+         (when update-flag (setf ,place new-value)))
+      `(when (read-inspect-command ,label ,object t)
+             (princ "Not updated.")
+             (terpri))))
+
+(defmacro inspect-print (label object &optional place)
+  (if place
+      `(multiple-value-bind (update-flag new-value)
+           (read-inspect-command ,label ,object nil)
+         (when update-flag (setf ,place new-value)))
+      `(when (read-inspect-command ,label ,object nil)
+             (princ "Not updated.")
+             (terpri))))
+          
+(defun inspect-indent ()
+  (fresh-line)
+  (format t "~V@T"
+          (* 4 (if (< *inspect-level* 8) *inspect-level* 8))))
+
+(defun inspect-indent-1 ()
+  (fresh-line)
+  (format t "~V@T"
+          (- (* 4 (if (< *inspect-level* 8) *inspect-level* 8)) 3)))
+
+
+(defun inspect-symbol (symbol)
+  (let ((p (symbol-package symbol)))
+    (cond ((null p)
+           (format t "~:@(~S~) - uninterned symbol" symbol))
+          ((eq p (find-package "KEYWORD"))
+           (format t "~:@(~S~) - keyword" symbol))
+          (t
+           (format t "~:@(~S~) - ~:[internal~;external~] symbol in ~A package"
+                   symbol
+                   (multiple-value-bind (b f)
+                                        (find-symbol (symbol-name symbol) p)
+                     (declare (ignore b))
+                     (eq f :external))
+                   (package-name p)))))
+
+  (when (boundp symbol)
+        (if *inspect-mode*
+            (inspect-recursively "value:"
+                                 (symbol-value symbol)
+                                 (symbol-value symbol))
+            (inspect-print "value:~%   ~S"
+                           (symbol-value symbol)
+                           (symbol-value symbol))))
+
+  (do ((pl (symbol-plist symbol) (cddr pl)))
+      ((endp pl))
+    (unless (and (symbolp (car pl))
+                 (or (eq (symbol-package (car pl)) (find-package 'SYSTEM))
+                     (eq (symbol-package (car pl)) (find-package 'COMPILER))))
+      (if *inspect-mode*
+          (inspect-recursively (format nil "property ~S:" (car pl))
+                               (cadr pl)
+                               (get symbol (car pl)))
+          (inspect-print (format nil "property ~:@(~S~):~%   ~~S" (car pl))
+                         (cadr pl)
+                         (get symbol (car pl))))))
+  
+  (when (print-doc symbol t)
+        (format t "~&-----------------------------------------------------------------------------~%"))
+  )
+
+(defun inspect-package (package)
+  (format t "~S - package" package)
+  (when (package-nicknames package)
+        (inspect-print "nicknames:  ~S" (package-nicknames package)))
+  (when (package-use-list package)
+        (inspect-print "use list:  ~S" (package-use-list package)))
+  (when  (package-used-by-list package)
+         (inspect-print "used-by list:  ~S" (package-used-by-list package)))
+  (when (package-shadowing-symbols package)
+        (inspect-print "shadowing symbols:  ~S"
+                       (package-shadowing-symbols package))))
+
+(defun inspect-character (character)
+  (format t
+          (cond ((standard-char-p character) "~S - standard character")
+                (t "~S - character"))
+          character)
+  (inspect-print "code:  #x~X" (char-code character)))
+
+(defun inspect-number (number)
+  (case (type-of number)
+    (FIXNUM (format t "~S - fixnum (32 bits)" number))
+    (BIGNUM (format t "~S - bignum" number))
+    (RATIO
+     (format t "~S - ratio" number)
+     (inspect-recursively "numerator:" (numerator number))
+     (inspect-recursively "denominator:" (denominator number)))
+    (COMPLEX
+     (format t "~S - complex" number)
+     (inspect-recursively "real part:" (realpart number))
+     (inspect-recursively "imaginary part:" (imagpart number)))
+    ((SHORT-FLOAT SINGLE-FLOAT)
+     (format t "~S - short-float" number)
+     (multiple-value-bind (signif expon sign)
+          (integer-decode-float number)
+       (declare (ignore sign))
+       (inspect-print "exponent:  ~D" expon)
+       (inspect-print "mantissa:  ~D" signif)))
+    ((LONG-FLOAT DOUBLE-FLOAT)
+     (format t "~S - long-float" number)
+     (multiple-value-bind (signif expon sign)
+          (integer-decode-float number)
+       (declare (ignore sign))
+       (inspect-print "exponent:  ~D" expon)
+       (inspect-print "mantissa:  ~D" signif)))))
+
+(defun inspect-cons (cons)
+  (format t
+          (case
+	      #-LOCATIVE (car cons)
+	      #+LOCATIVE
+	      (let ((acar (car cons)))
+		(cond ((locativep acar)
+		       (dereference acar))
+		      ((sl-boundp acar) acar)
+		      (t nil)))
+            ((LAMBDA LAMBDA-BLOCK LAMBDA-CLOSURE LAMBDA-BLOCK-CLOSURE)
+             "~S - function")
+            (QUOTE "~S - constant")
+            (t "~S - cons"))
+          cons)
+  (when *inspect-mode*
+        (do ((i 0 (1+ i))
+             (l cons (cdr l)))
+            ((atom l)
+             (inspect-recursively (format nil "nthcdr ~D:" i)
+                                  l (cdr (nthcdr (1- i) cons))))
+          (inspect-recursively (format nil "nth ~D:" i)
+                               (car l) (nth i cons)))))
+
+(defun inspect-string (string)
+  (format t (if (simple-string-p string) "~S - simple string" "~S - string")
+          string)
+  (inspect-print  "dimension:  ~D"(array-dimension string 0))
+  (when (array-has-fill-pointer-p string)
+        (inspect-print "fill pointer:  ~D"
+                       (fill-pointer string)
+                       (fill-pointer string)))
+  (when *inspect-mode*
+        (dotimes (i (array-dimension string 0))
+                 (inspect-recursively (format nil "aref ~D:" i)
+                                      (char string i)
+                                      (char string i)))))
+
+(defun inspect-vector (vector)
+  (format t (if (simple-vector-p vector) "~S - simple vector" "~S - vector")
+          vector)
+  (inspect-print  "dimension:  ~D" (array-dimension vector 0))
+  (when (array-has-fill-pointer-p vector)
+        (inspect-print "fill pointer:  ~D"
+                       (fill-pointer vector)
+                       (fill-pointer vector)))
+  (when *inspect-mode*
+        (dotimes (i (array-dimension vector 0))
+                 (inspect-recursively (format nil "aref ~D:" i)
+                                      (aref vector i)
+                                      (aref vector i)))))
+
+(defun inspect-array (array)
+  (format t (if (adjustable-array-p array)
+                "~S - adjustable aray"
+                "~S - array")
+          array)
+  (inspect-print "rank:  ~D" (array-rank array))
+  (inspect-print "dimensions:  ~D" (array-dimensions array))
+  (inspect-print "total size:  ~D" (array-total-size array)))
+
+(defun select-ht-N (hashtable)
+  (incf *inspect-level*)
+  (maphash #'(lambda (key val)
+	       (inspect-indent-1)
+	       (format t "key  : ~S" key)
+	       (inspect-recursively "value:" val (gethash key hashtable)))
+	   hashtable)
+  (decf *inspect-level*))
+
+(defun select-ht-L (hashtable)
+  (terpri)
+  (format t "The keys of the hash table are:~%")
+  (maphash #'(lambda (key val)
+	       (declare (ignore val))
+	       (format t "  ~S~%" key))
+	   hashtable)
+  (terpri))
+
+(defun select-ht-J (hashtable)
+  (let* ((key (prog1
+		(read-preserving-whitespace *query-io*)
+		(inspect-read-line)))
+	 (val (gethash key hashtable)))
+        (if val
+	    (progn
+	      (incf *inspect-level*)
+	      (inspect-indent-1)
+	      (format t "key  : ~S" key)
+	      (inspect-recursively "value:" val (gethash key hashtable))
+	      (decf *inspect-level*))
+	    (progn
+	      (terpri)
+	      (format t "The key ~S is not present or the value associated is NIL." key)
+	      (terpri)
+	      (terpri)))))
+
+(defun select-ht-? ()
+  (terpri)
+  (format t
+	  "Inspect commands for hash tables:~%~
+n (or N or Newline):  inspects the keys/values of the hashtable (recursively).~%~
+s (or S):             skips the field.~%~
+p (or P):             pretty-prints the field.~%~
+a (or A):             aborts the inspection of the rest of the fields.~%~
+e (or E) form:        evaluates and prints the form.~%~
+l (or L):             show the keys of the hash table.~%~
+j (or J) key:         inspect the value associated to the key requested.~%~
+q (or Q):             quits the inspection.~%~
+?:                    prints this.~%~%"
+	  ))
+
+(defun inspect-hashtable (hashtable)
+  (if *inspect-mode*
+      (progn
+	(decf *inspect-level*)
+        (loop
+          (format t "~S - hash table: " hashtable)
+	  (force-output)
+          (case (do ((char (read-char *query-io*) (read-char *query-io*)))
+	            ((and (char/= char #\Space) (char/= #\Tab)) char))
+	        ((#\Newline #\Return)
+		 (select-ht-N hashtable)
+		 (return nil))
+	        ((#\n #\N)
+	         (inspect-read-line)
+		 (select-ht-N hashtable)
+		 (return nil))
+	        ((#\s #\S)
+	         (inspect-read-line)
+	         (return nil))
+		((#\p #\P)
+		 (inspect-read-line)
+		 (select-P hashtable))
+		((#\a #\A)
+		 (inspect-read-line)
+		 (throw 'ABORT-INSPECT nil))
+		((#\e #\E)
+		 (select-E))
+		((#\q #\Q)
+		 (inspect-read-line)
+		 (throw 'QUIT-INSPECT nil))
+		((#\l #\L)
+		 (inspect-read-line)
+		 (select-ht-L hashtable))
+		((#\j #\J)
+		 (select-ht-J hashtable))
+		((#\?)
+		 (inspect-read-line)
+		 (select-ht-?)))
+          (inspect-indent)))
+      (progn
+	(format t "~S - hash table: " hashtable)
+	(maphash #'(lambda (key val)
+		     (inspect-indent-1)
+		     (format t "key  : ~S" key)
+		     (inspect-indent-1)
+		     (format t "value:")
+		     (inspect-object val))
+	         hashtable))))
+
+#+CLOS
+(defun inspect-instance (instance)
+  (if *inspect-mode*
+      (clos::inspect-obj instance)
+      (clos::describe-object instance)))
+
+(defun inspect-object (object &aux (*inspect-level* *inspect-level*))
+  (inspect-indent)
+  (when (and (not *inspect-mode*)
+             (or (> *inspect-level* 5)
+                 (member object *inspect-history*)))
+        (prin1 object)
+        (return-from inspect-object))
+  (incf *inspect-level*)
+  (push object *inspect-history*)
+  (catch 'ABORT-INSPECT
+         (cond
+	       #+LOCATIVE
+               ((not (sys:sl-boundp object)) nil)
+	       ((symbolp object) (inspect-symbol object))
+               ((packagep object) (inspect-package object))
+               ((characterp object) (inspect-character object))
+               ((numberp object) (inspect-number object))
+               ((consp object) (inspect-cons object))
+               ((stringp object) (inspect-string object))
+               ((vectorp object) (inspect-vector object))
+               ((arrayp object) (inspect-array object))
+               ((hash-table-p object) (inspect-hashtable object))
+	       #+clos
+	       ((sys:instancep object) (inspect-instance object))
+	       #+LOCATIVE
+	       ((sys:locativep object) (inspect-locative object))
+               (t (format t "~S - ~S" object (type-of object))))))
+
+
+(defun describe (object &aux (*inspect-mode* nil)
+                             (*inspect-level* 0)
+                             (*inspect-history* nil)
+                             (*print-level* nil)
+                             (*print-length* nil))
+  "The lisp function DESCRIBE."
+  (terpri)
+  (catch 'QUIT-INSPECT (inspect-object object))
+  (terpri)
+  (values))
+
+(defun inspect (object &aux (*inspect-mode* t)
+                            (*inspect-level* 0)
+                            (*inspect-history* nil)
+                            (*old-print-level* *print-level*)
+                            (*old-print-length* *print-length*)
+                            (*print-level* 3)
+                            (*print-length* 3))
+  "The lisp function INSPECT."
+  (read-line)
+  (princ "Type ? and a newline for help.")
+  (terpri)
+  (catch 'QUIT-INSPECT (inspect-object object))
+  (terpri)
+  (values))
+
+(defun print-doc (symbol &optional (called-from-apropos-doc-p nil)
+                         &aux (f nil) x (*notify-gbc* nil))
+  (flet ((doc1 (doc ind)
+           (setq f t)
+           (format t
+                   "~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"
+                   symbol ind doc))
+         (good-package ()
+           (if (eq (symbol-package symbol) (find-package "LISP"))
+               (find-package "SYSTEM")
+               *package*)))
+
+    (cond ((special-form-p symbol)
+           (doc1 (or (documentation symbol 'FUNCTION) "")
+                 (if (macro-function symbol)
+                     "[Special form and Macro]"
+                     "[Special form]")))
+          ((macro-function symbol)
+           (doc1 (or (documentation symbol 'FUNCTION) "") "[Macro]"))
+          ((fboundp symbol)
+           (doc1
+            (or (documentation symbol 'FUNCTION)
+                (if (consp (setq x (symbol-function symbol)))
+                    (case (car x)
+                          (LAMBDA (format nil "~%Args: ~S" (cadr x)))
+                          (LAMBDA-BLOCK (format nil "~%Args: ~S" (caddr x)))
+                          (LAMBDA-CLOSURE
+                           (format nil "~%Args: ~S" (car (cddddr x))))
+                          (LAMBDA-BLOCK-CLOSURE
+                           (format nil "~%Args: ~S" (cadr (cddddr x))))
+                          (t ""))
+                    ""))
+            "[Function]"))
+          ((setq x (documentation symbol 'FUNCTION))
+           (doc1 x "[Macro or Function]")))
+
+    (cond ((constantp symbol)
+           (unless (and (eq (symbol-package symbol) (find-package "KEYWORD"))
+                        (null (documentation symbol 'VARIABLE)))
+             (doc1 (or (documentation symbol 'VARIABLE) "") "[Constant]")))
+          ((sys:specialp symbol)
+           (doc1 (or (documentation symbol 'VARIABLE) "")
+                 "[Special variable]"))
+          ((or (setq x (documentation symbol 'VARIABLE)) (boundp symbol))
+           (doc1 (or x "") "[Variable]")))
+
+    (cond ((setq x (documentation symbol 'TYPE))
+           (doc1 x "[Type]"))
+          ((setq x (get symbol 'DEFTYPE-FORM))
+           (let ((*package* (good-package)))
+             (doc1 (format nil "~%Defined as: ~S~%See the doc of DEFTYPE." x)
+                   "[Type]"))))
+
+    (cond ((setq x (documentation symbol 'STRUCTURE))
+           (doc1 x "[Structure]"))
+          ((setq x (get symbol 'DEFSTRUCT-FORM))
+           (doc1 (format nil "~%Defined as: ~S~%See the doc of DEFSTRUCT." x)
+                 "[Structure]")))
+
+    (cond ((setq x (documentation symbol 'SETF))
+           (doc1 x "[Setf]"))
+          ((setq x (get symbol 'SETF-UPDATE-FN))
+           (let ((*package* (good-package)))
+             (doc1 (format nil "~%Defined as: ~S~%See the doc of DEFSETF."
+                           `(defsetf ,symbol ,(get symbol 'SETF-UPDATE-FN)))
+                   "[Setf]")))
+          ((setq x (get symbol 'SETF-LAMBDA))
+           (let ((*package* (good-package)))
+             (doc1 (format nil "~%Defined as: ~S~%See the doc of DEFSETF."
+                           `(defsetf ,symbol ,@(get symbol 'SETF-LAMBDA)))
+                   "[Setf]")))
+          ((setq x (get symbol 'SETF-METHOD))
+           (let ((*package* (good-package)))
+             (doc1
+              (format nil
+                "~@[~%Defined as: ~S~%See the doc of DEFINE-SETF-METHOD.~]"
+                (if (consp x)
+                    (case (car x)
+                          (LAMBDA `(define-setf-method ,@(cdr x)))
+                          (LAMBDA-BLOCK `(define-setf-method ,@(cddr x)))
+                          (LAMBDA-CLOSURE `(define-setf-method ,@(cddddr x)))
+                          (LAMBDA-BLOCK-CLOSURE
+                           `(define-setf-method ,@(cdr (cddddr x))))
+                          (t nil))
+                    nil))
+            "[Setf]"))))
+    )
+
+  ;; Format of entries in file help.doc:
+  ;; ^_[F | V | T]<name>
+  ;; description
+  ;; [@[F | V | T]<name>
+  ;; other description]
+  ;;
+  ;; where F means Function, V Variable and T Type.
+  ;;
+  (let* ((name (symbol-name symbol))
+	 (path (merge-pathnames *system-directory* "help.doc"))
+	 (pos 0))
+
+    (labels ((bin-search (file start end &aux (delta 0) (middle 0) sym)
+	       (declare (fixnum start end delta middle))
+	       (when (< start end)
+		 (setq middle (round (+ start end) 2))
+		 (file-position file middle)
+		 (if (and (plusp (setq delta (scan-for #\^_ file)))
+			  (<= delta (- end middle)))
+		     (if (string-equal name
+				       (setq sym (symbol-name (read file))))
+			 (+ middle delta (length name) 1) ; skip EOL
+			 (if (string< name sym)
+			     (bin-search file start (1- middle))
+			     (bin-search file (+ middle delta) end)))
+		     (bin-search file start (1- middle)))))
+	     (scan-for (char file)
+	       (do ((v #\space (read-char file nil nil))
+		    (n 0 (1+ n)))
+		   ((or (eql v #\^_) (not v))
+		    (if (read-char file nil nil) n -1))	; skip V | F | T.
+		 (declare (fixnum n)))))
+
+      (if (probe-file path)
+	  (with-open-file (file path)
+	    (setq pos (bin-search file 0 (file-length file)))
+	    (when pos
+	      (setq f t)
+	      (file-position file pos)
+	      (do (v)
+		  ((eql (setq v (read-char file nil #\^_)) #\^_))
+		(if (eql v #\)
+		    (progn
+		      (terpri)
+		      (read-char file nil nil))	; skip V | F | T.
+		    (princ v)))))
+	  (format t "~&Cannot find the help file \"help.doc\""))))
+
+  (if called-from-apropos-doc-p
+      f
+      (progn (if f
+                 (format t "~&-----------------------------------------------------------------------------")
+                 (format t "~&No documentation for ~:@(~S~)." symbol))
+             (values))))
+
+(defun apropos-doc (string &optional (package 'LISP) &aux (f nil))
+  (setq string (string string))
+  (if package
+      (do-symbols (symbol package)
+        (when (substringp string (string symbol))
+          (setq f (or (print-doc symbol t) f))))
+      (do-all-symbols (symbol)
+        (when (substringp string (string symbol))
+          (setq f (or (print-doc symbol t) f)))))
+  (if f
+      (format t "~&-----------------------------------------------------------------------------")
+      (format t "~&No documentation for ~S in ~:[any~;~A~] package."
+              string package
+              (and package (package-name (coerce-to-package package)))))
+  (values))
+
+#+LOCATIVE
+(defun inspect-locative (locative)
+  (if (sys:sl-boundp (dereference locative))
+      (if *inspect-mode*
+	  (inspect-recursively "locative pointing to:"
+			       (dereference locative))
+	  (if (locativep (dereference locative))
+	      (format t "~S - ~S" locative "UNBOUND-LOCATIVE")
+	      (inspect-print "locative pointing to:~%   ~S"
+			     (dereference locative)
+			     )))
+      (format t "~S - ~S" locative "UNBOUND-LOCATIVE")))
+
+;;;----------------------------------------------------------------------
+          
+(defun documentation (symbol doc-type)
+  (case doc-type
+    (VARIABLE (get symbol 'VARIABLE-DOCUMENTATION))
+    (FUNCTION (get symbol 'FUNCTION-DOCUMENTATION))
+    (STRUCTURE (get symbol 'STRUCTURE-DOCUMENTATION))
+    (TYPE (get symbol 'TYPE-DOCUMENTATION))
+    (SETF (get symbol 'SETF-DOCUMENTATION))
+    (t (error "~S is an illegal documentation type." doc-type))))
+
+;(provide 'describe)
diff --git a/src/lsp/evalmacros.lsp b/src/lsp/evalmacros.lsp
new file mode 100644
index 000000000..6641b03b4
--- /dev/null
+++ b/src/lsp/evalmacros.lsp
@@ -0,0 +1,276 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(si::select-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+(eval-when (eval compile) (defun sys:clear-compiler-properties (symbol)))
+(eval-when (eval compile) (setq sys:*inhibit-macro-special* nil))
+
+(defmacro defvar (var &optional (form nil form-sp) doc-string)
+  `(PROGN (SYS:*MAKE-SPECIAL ',var)
+    ,@(if doc-string
+	  `((SYS:PUTPROP ',var ,doc-string 'VARIABLE-DOCUMENTATION)))
+    ,@(if form-sp
+	  `((UNLESS (BOUNDP ',var)
+	      (SETQ ,var ,form))))
+    #+PDE (SYS:RECORD-SOURCE-PATHNAME ',var 'defvar)
+    ',var))
+
+(defmacro defparameter (var form &optional doc-string)
+  `(PROGN (SYS:*MAKE-SPECIAL ',var)
+    ,@(if doc-string
+	  `((SYS:PUTPROP ',var ,doc-string 'VARIABLE-DOCUMENTATION)))
+    (SETQ ,var ,form)
+    (EVAL-WHEN (COMPILE)		; Beppe
+      (WHEN ,(CONSTANTP form)
+	(PROCLAIM '(TYPE ,(type-of form) ,var))))
+;    (eval-when (load eval)		; Beppe
+;      (compiler::proclaim-var (type-of ,var) ',var))
+    #+PDE (SYS:RECORD-SOURCE-PATHNAME ',var 'DEFPARAMETER)
+    ',var))
+
+(defmacro defconstant (var form &optional doc-string)
+  `(PROGN (SYS:*MAKE-CONSTANT ',var ,form)
+    ,@(if doc-string
+	  `((SYS:PUTPROP ',var ,doc-string 'VARIABLE-DOCUMENTATION)))
+    #+PDE (SYS:RECORD-SOURCE-PATHNAME ',var 'defconstant)
+    ',var))
+
+
+;;; Each of the following macros is also defined as a special form,
+;;; as required by CLtL. Some of them are used by the compiler (e.g.
+;;; dolist), some not at all (e.g. defun).
+;;; Thus their names need not be exported.
+
+(defmacro and (&rest forms)
+  (if (endp forms)
+      T
+      (do* ((res '(NIL))
+	    (insert res (cddar (rplaca insert `(IF ,(car fs) NIL))))
+	    (fs forms (cdr fs)))
+	   ((endp (cdr fs))
+	    (rplaca insert (car fs))
+	    (car res))))
+  )
+
+(defmacro or (&rest forms)
+  (if (endp forms)
+      nil
+      (let ((x (reverse forms)))
+           (do ((forms (cdr x) (cdr forms))
+                (form (car x)
+                      (let ((temp (gensym)))
+                           `(LET ((,temp ,(car forms)))
+;			     (DECLARE (:READ-ONLY ,temp)) ; Beppe
+                                 (IF ,temp ,temp ,form)))))
+               ((endp forms) form))))
+  )
+               
+(defmacro locally (&rest body) `(LET () ,@body))
+
+(defmacro loop (&rest body &aux (tag (gensym)))
+  `(BLOCK NIL (TAGBODY ,tag (PROGN ,@body) (GO ,tag))))
+
+(defmacro lambda (&rest body)
+  `(function (lambda ,@body)))
+
+(defmacro lambda-block (name lambda-list &rest lambda-body)
+  (multiple-value-bind (decl body doc)
+      (si::process-declarations lambda-body)
+    (when decl (setq decl (list (cons 'declare decl))))
+    `(lambda ,lambda-list ,@doc ,@decl (block ,name ,@body))))
+
+; assignment
+
+(defmacro psetq (&rest args)
+   (do ((l args (cddr l))
+        (forms nil)
+        (bindings nil))
+       ((endp l) (list* 'LET* (nreverse bindings) (nreverse (cons nil forms))))
+       (let ((sym (gensym)))
+            (push (list sym (cadr l)) bindings)
+            (push (list 'setq (car l) sym) forms)))
+   )
+
+; conditionals
+
+(defmacro cond (&rest clauses &aux (form nil))
+  (dolist (l (reverse clauses) form)	; don't use nreverse here
+    (if (endp (cdr l))
+	(if (eq (car l) 't)
+	    (setq form 't)
+	    (let ((sym (gensym)))
+	      (setq form `(LET ((,sym ,(car l)))
+;			   (DECLARE (:READ-ONLY ,sym)) ; Beppe
+			   (IF ,sym ,sym ,form)))))
+	(if (eq (car l) 't)
+	    (setq form (if (endp (cddr l))
+			   (cadr l)
+			   `(PROGN ,@(cdr l))))
+	    (setq form (if (endp (cddr l))
+			   `(IF ,(car l) ,(cadr l) ,form)
+			   `(IF ,(car l) (PROGN ,@(cdr l)) ,form))))))
+  )
+
+(defmacro when (pred &rest body)
+  `(IF ,pred (PROGN ,@body)))
+
+(defmacro unless (pred &rest body)
+  `(IF (NOT ,pred) (PROGN ,@body)))
+
+; program feature
+
+(defmacro prog (vl &rest body &aux (decl nil))
+  (multiple-value-setq (decl body)
+    (find-declarations body))
+  `(BLOCK NIL (LET ,vl ,@decl (TAGBODY ,@body)))
+  )
+
+(defmacro prog* (vl &rest body &aux (decl nil))
+  (multiple-value-setq (decl body)
+    (find-declarations body))
+  `(BLOCK NIL (LET* ,vl ,@decl (TAGBODY ,@body)))
+  )
+
+; sequencing
+
+(defmacro prog1 (first &rest body &aux (sym (gensym)))
+  `(LET ((,sym ,first))
+;    (DECLARE (:READ-ONLY ,sym)) ; Beppe
+    ,@body ,sym))
+
+(defmacro prog2 (first second &rest body &aux (sym (gensym)))
+  `(PROGN ,first (LET ((,sym ,second))
+;		       (DECLARE (:READ-ONLY ,sym)) ; Beppe
+		       ,@body ,sym)))
+
+; multiple values
+
+(defmacro multiple-value-list (form)
+  `(MULTIPLE-VALUE-CALL 'LIST ,form))
+
+(defmacro multiple-value-setq (vars form)
+  (do ((vl vars (cdr vl))
+       (sym (gensym))
+       (forms nil)
+       (n 0 (1+ n)))
+      ((endp vl) `(LET ((,sym (MULTIPLE-VALUE-LIST ,form))) ,@forms))
+      (declare (fixnum n))
+      (push `(SETQ ,(car vl) (NTH ,n ,sym)) forms))
+  )
+
+(defmacro multiple-value-bind (vars form &rest body)
+  (do ((vl vars (cdr vl))
+       (sym (gensym))
+       (bind nil)
+       (n 0 (1+ n)))
+      ((endp vl) `(LET* ((,sym (MULTIPLE-VALUE-LIST ,form)) ,@(nreverse bind))
+		   ,@body))
+    (declare (fixnum n))
+    (push `(,(car vl) (NTH ,n ,sym)) bind))
+  )
+
+(defun do/do*-expand (control test result body let psetq
+			      &aux (decl nil) (label (gensym))
+			      (vl nil) (step nil))
+  (multiple-value-setq (decl body)
+    (find-declarations body))
+  (dolist (c control)
+    (when (symbolp  c) (setq c (list c))) ; convenient extension to CL. Beppe
+    (case (length c)
+      ((1 2)
+       (push c vl))
+      ((3)
+       (push (butlast c) vl)
+       (push (first c) step)
+       (push (third c) step))
+      (t
+       (error "Too many arguments in init form of do/do*"))))
+  `(BLOCK NIL
+          (,let ,(nreverse vl)
+               ,@decl
+               (TAGBODY
+                ,label (IF ,test (RETURN (PROGN ,@result)))
+                       ,@body
+                       ,@(when step (list (cons psetq (nreverse step))))
+                       (GO ,label)))))
+
+(defmacro do (control (test . result) &rest body)
+  (do/do*-expand control test result body 'LET 'PSETQ))
+
+(defmacro do* (control (test . result) &rest body)
+  (do/do*-expand control test result body 'LET* 'SETQ))
+
+(defmacro case (keyform &rest clauses &aux (form nil) (key (gensym)))
+  (dolist (clause (reverse clauses)
+	   `(LET ((,key ,keyform))
+;	     (DECLARE (:READ-ONLY ,key)) ; Beppe
+	     ,form))
+    (if (or (eq (car clause) 'T) (eq (car clause) 'OTHERWISE))
+	(setq form `(PROGN ,@(cdr clause)))
+	(if (consp (car clause))
+	    (setq form `(IF (MEMBER ,key ',(car clause))
+			 (PROGN ,@(cdr clause))
+			 ,form))
+	    (if (car clause)
+		(setq form `(IF (EQL ,key ',(car clause))
+			     (PROGN ,@(cdr clause))
+			     ,form))))))
+  )
+
+(defmacro return (&optional (val nil)) `(RETURN-FROM NIL ,val))
+
+(defmacro dolist ((var form &optional (val nil)) &rest body
+                                                 &aux (temp (gensym)) decl)
+  (multiple-value-setq (decl body)
+    (find-declarations body))
+  `(DO* ((,temp ,form (cdr ,temp)) (,var))
+	((ENDP ,temp) ,val)
+    ,@decl
+    (SETQ ,var (CAR ,temp))
+    ,@body))
+
+(defmacro dotimes ((var form &optional (val nil)) &rest body
+                                                  &aux (temp (gensym)))
+  `(DO* ((,temp ,form) (,var 0 (1+ ,var)))
+        ((>= ,var ,temp) ,val)
+        (DECLARE (FIXNUM ,var)) ; Beppe  (:READ-ONLY ,temp)
+        ,@body))
+
+;; Declarations
+(defmacro declaim (&rest decl-specs)
+  (if (cdr decl-specs)
+    `(eval-when (compile load) (mapcar #'proclaim ',decl-specs))
+    `(eval-when (compile load) (proclaim ',(car decl-specs)))))
+
+(defmacro in-package (name)
+  `(si::select-package ,(string name)))
+
+;; FIXME!
+(defmacro the (type value)
+  value)
+
+#+nil
+(defmacro define-symbol-macro (symbol expansion)
+  (cond ((not (symbolp symbol))
+	 (error "DEFINE-SYMBOL-MACRO: ~A is not a symbol"
+		symbol))
+	((specialp symbol)
+	 (error "DEFINE-SYMBOL-MACRO: cannot redefine a special variable, ~A"
+		symbol))
+	(t
+	 `(progn
+	   (setf (get ',symbol 'si::symbol-macro)
+	         (lambda (form env) ',expansion))
+	   ',symbol))))
+
+(defmacro nth-value (n expr)
+  `(nth ,n (multiple-value-list ,expr)))
diff --git a/src/lsp/export.lsp b/src/lsp/export.lsp
new file mode 100644
index 000000000..5575332e1
--- /dev/null
+++ b/src/lsp/export.lsp
@@ -0,0 +1,445 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;;                    Exporting external symbols of LISP package
+
+(si::select-package "CL")
+
+; Safety measure
+(setq *print-circle* t)
+
+(export '(
+	  &whole
+	  &environment
+	  &body
+	  *
+	  **
+	  ***
+	  *features*
+	  *modules*
+	  +
+	  ++
+	  +++
+	  -
+	  /
+	  //
+	  ///
+	  COMMON
+	  KYOTO
+	  KCL
+	  ECL
+	  ECLS
+	  abs
+	  acos
+	  acosh
+	  adjust-array
+	  adjustable-array-p
+	  apropos
+	  apropos-list
+	  array-dimension
+	  array-dimensions
+	  array-element-type
+	  array-has-fill-pointer-p
+	  array-in-bounds-p
+	  array-rank
+	  array-row-major-index
+	  asin
+	  asinh
+	  assert
+	  atanh
+	  base-string
+	  bit
+	  bit-and
+	  bit-andc1
+	  bit-andc2
+	  bit-eqv
+	  bit-ior
+	  bit-nand
+	  bit-nor
+	  bit-not
+	  bit-orc1
+	  bit-orc2
+	  bit-xor
+	  break
+	  byte
+	  byte-position
+	  byte-size
+	  ccase
+	  cerror
+	  char
+	  check-type
+	  cis
+	  coerce
+	  compile
+	  compile-file
+	  compile-file-pathname
+	  complement
+	  common-lisp
+	  common-lisp-user
+	  constantly
+	  cl
+	  cl-user
+	  *compile-print*
+	  *compile-verbose*
+	  concatenate
+	  cosh
+	  count
+	  count-if
+	  count-if-not
+	  ctypecase
+	  decf
+	  declaim
+	  declaration
+	  decode-universal-time
+	  defconstant
+	  define-modify-macro
+	  define-setf-method
+	  define-symbol-macro
+	  defmacro
+	  defpackage
+	  defparameter
+	  defsetf
+	  defstruct
+	  deftype
+	  defun
+	  defvar
+	  delete
+	  delete-duplicates
+	  delete-if
+	  delete-if-not
+	  delete-package
+	  deposit-field
+	  describe
+	  destructuring-bind
+	  disassemble
+	  do*
+	  do-all-symbols
+	  do-external-symbols
+	  do-symbols
+	  documentation
+	  dolist
+	  dotimes
+	  dpb
+	  dribble
+	  ecase
+	  ed
+	  eighth
+	  encode-universal-time
+	  error
+	  etypecase
+	  eval-when
+	  every
+	  fceiling
+	  ffloor
+	  fifth
+	  fill
+	  fill-pointer
+	  find
+	  find-all-symbols
+	  find-if
+	  find-if-not
+	  first
+	  float
+	  format
+	  fourth
+	  fround
+	  ftruncate
+	  get-decoded-time
+	  get-setf-method
+	  get-setf-method-multiple-value
+	  get-universal-time
+	  getf
+	  ignore
+	  in-package
+	  incf
+	  inspect
+	  intersection
+	  isqrt
+	  ldb
+	  ldb-test
+	  lisp-implementation-type
+	  logandc1
+	  logandc2
+	  logical-pathname-translations
+	  lognand
+	  lognor
+	  lognot
+	  logorc1
+	  logorc2
+	  logtest
+	  long-site-name
+	  loop
+	  machine-instance
+	  machine-type
+	  machine-version
+	  make-array
+	  make-sequence
+	  map
+	  map-into
+	  mask-field
+	  merge
+	  mismatch
+	  mod
+	  multiple-value-setq
+	  nil
+	  nintersection
+	  ninth
+	  notany
+	  notevery
+	  nset-difference
+	  nset-exclusive-or
+	  nsubstitute
+	  nsubstitute-if
+	  nsubstitute-if-not
+	  nunion
+	  phase
+	  pop
+	  position
+	  position-if
+	  position-if-not
+	  prin1-to-string
+	  princ-to-string
+	  prog1
+	  prog2
+	  prog*
+	  provide
+	  psetf
+	  push
+	  pushnew
+	  rational
+	  rationalize
+	  read-from-string
+	  reduce
+	  rem
+	  remf
+	  remove
+	  remove-duplicates
+	  remove-if
+	  remove-if-not
+	  replace
+	  require
+	  rotatef
+	  room
+	  sbit
+	  search
+	  second
+	  set-difference
+	  set-exclusive-or
+	  setf
+	  seventh
+	  shiftf
+	  short-site-name
+	  simple-base-string
+	  signum
+	  sinh
+	  sixth
+	  software-type
+	  software-version
+	  some
+	  sort
+	  special-form-p
+	  special-operator-p
+	  stable-sort
+	  step
+	  structure
+	  subsetp
+	  substitute
+	  substitute-if
+	  substitute-if-not
+	  subtypep
+	  t
+	  tanh
+	  tenth
+	  third
+	  time
+	  trace
+	  type
+	  typecase
+	  typep
+	  union
+	  untrace
+	  variable
+	  vector
+	  vector-pop
+	  vector-push
+	  vector-push-extend
+	  warn
+	  with-input-from-string
+	  with-open-file
+	  with-open-stream
+	  with-output-to-string
+	  write-to-string
+	  y-or-n-p
+	  yes-or-no-p
+
+	  proclaim
+	  special
+	  type
+	  ftype
+	  function
+	  inline
+	  notinline
+	  ignore
+	  optimize
+	  speed
+	  space
+	  safety
+	  compilation-speed
+
+	  *eval-when-compile*
+	  ))
+
+(si::select-package "SI")
+
+;;; ----------------------------------------------------------------------
+;;;
+(*make-special '*dump-defun-definitions*)
+(setq *dump-defun-definitions* nil)
+(*make-special '*dump-defmacro-definitions*)
+(setq *dump-defmacro-definitions* *dump-defun-definitions*)
+
+(si::fset 'defun
+	  (si::bc-disassemble
+	  #'(lambda-block defun (def env)
+	      (let* ((name (second def))
+		     (function `#'(lambda-block ,@(cdr def))))
+		(when *dump-defun-definitions*
+		  (print function)
+		  (setq function `(si::bc-disassemble ,function)))
+		`(si::fset ',name ,function))))
+	  t)
+
+
+(si::fset 'in-package
+	  #'(lambda-block in-package (def env)
+	      `(si::select-package ,(string (second def))))
+	  t)
+
+(defun eval-feature (x)
+  (cond ((symbolp x)
+         (member x *features*
+                 :test #'(lambda (a b)
+                           (or (eql a b)
+			       (and (symbolp a) (symbolp b)
+				    (string-equal (symbol-name a)
+						  (symbol-name b)))))))
+	((atom x) (error "~ is not allowed as a feature" x))
+        ((eq (car x) 'AND)
+         (dolist (x (cdr x) t) (unless (eval-feature x) (return nil))))
+        ((eq (car x) 'OR)
+         (dolist (x (cdr x) nil) (when (eval-feature x) (return t))))
+        ((eq (car x) 'NOT)
+	 (not (eval-feature (second x))))
+	(t (error "~S is not a feature expression." x))))
+
+;;; Revised by G. Attardi
+(defun check-no-infix (stream subchar arg)
+  (when arg
+    (error "Reading from ~S: no number should appear between # and ~A"
+	   stream subchar)))
+
+(defun sharp-+-reader (stream subchar arg)
+  (check-no-infix stream subchar arg)
+  (let ((feature (read stream t nil t)))
+    (if (and (not *read-suppress*) (eval-feature feature))
+	(read stream t nil t)
+	(let ((*read-suppress* t)) (read stream t nil t) (values)))))
+
+(set-dispatch-macro-character #\# #\+ 'sharp-+-reader)
+(set-dispatch-macro-character #\# #\+ 'sharp-+-reader
+                              (sys::standard-readtable))
+
+(defun sharp---reader (stream subchar arg)
+  (check-no-infix stream subchar arg)
+  (let ((feature (read stream t nil t)))
+    (if (or *read-suppress* (eval-feature feature))
+	(let ((*read-suppress* t)) (read stream t nil t) (values))
+	(read stream t nil t))))
+
+(set-dispatch-macro-character #\# #\- 'sharp---reader)
+(set-dispatch-macro-character #\# #\- 'sharp---reader
+                              (sys::standard-readtable))
+
+;;; ----------------------------------------------------------------------
+
+(in-package "CL")
+
+#+CLOS
+(export '(
+	  add-method
+	  call-next-method
+	  change-class
+	  class-changed
+	  class-name
+	  class-of
+	  defclass
+	  defgeneric
+	  define-method-combination
+	  defmethod
+	  ensure-generic-function
+	  find-class
+	  generic-flet
+	  generic-function
+	  generic-labels
+	  get-method
+	  initialize-instance
+	  invalid-method-error
+	  make-instance
+	  make-instance-obsolete
+	  make-method-call
+	  method
+	  method-combination-error
+	  method-qualifiers
+	  next-method-p
+	  no-applicable-method
+	  print-object
+	  print-unreadable-object
+	  remove-method
+	  slot-boundp
+	  slot-exists-p
+	  slot-makunbound
+	  slot-missing
+	  slot-unbound
+	  slot-value
+	  subclassp
+	  symbol-macrolet
+	  update-instance-structure
+	  with-accessors
+	  with-added-methods
+	  with-slots
+
+	  class
+	  built-in
+	  standard-class
+	  standard-generic-function
+	  standard-method
+	  standard-object
+	  structure-class
+	  structure-object
+	  ))
+
+;
+; Conditions system
+;
+(export '(*break-on-signals* *debugger-hook* signal
+	  handler-case handler-bind ignore-errors define-condition make-condition
+	  with-simple-restart restart-case restart-bind restart-name
+	  restart-name find-restart compute-restarts invoke-restart
+	  invoke-restart-interactively abort continue muffle-warning
+	  store-value use-value invoke-debugger restart condition
+	  warning serious-condition simple-condition simple-warning simple-error
+	  simple-condition-format-string simple-condition-format-arguments
+	  storage-condition stack-overflow storage-exhausted type-error
+	  type-error-datum type-error-expected-type simple-type-error
+	  program-error control-error stream-error stream-error-stream
+	  end-of-file file-error file-error-pathname cell-error
+	  unbound-variable undefined-function arithmetic-error
+	  arithmetic-error-operation arithmetic-error-operands
+	  package-error package-error-package
+	  division-by-zero floating-point-overflow floating-point-underflow))
\ No newline at end of file
diff --git a/src/lsp/init.lsp b/src/lsp/init.lsp
new file mode 100644
index 000000000..56a082c70
--- /dev/null
+++ b/src/lsp/init.lsp
@@ -0,0 +1,41 @@
+
+;(load "../cmp/init")
+
+(defun lcs1 (file)
+       (compile-file file
+                     :c-file t :h-file t :data-file t :output-file nil
+                     :system-p t))
+
+(proclaim '(special sys::*indent-formatted-output*))
+
+(defun compile-if-needed (file)
+  (let ((cfile-date (file-write-date (merge-pathnames file #".c"))))
+    (when (or (not cfile-date)
+	      (> (file-write-date (merge-pathnames file #".lsp"))
+		 cfile-date))
+      (compile-file file :c-file t :h-file t :data-file t
+		    :output-file nil :system-p t)))
+  )
+#|
+(compile-if-needed "defmacro")
+(compile-if-needed "evalmacros")
+(compile-if-needed "top")
+(compile-if-needed "module")
+(compile-if-needed "predlib")
+(compile-if-needed "setf")
+(compile-if-needed "arraylib")
+(compile-if-needed "assert")
+(compile-if-needed "defstruct")
+(compile-if-needed "describe")
+(compile-if-needed "iolib")
+(compile-if-needed "listlib")
+(compile-if-needed "mislib")
+(compile-if-needed "numlib")
+(compile-if-needed "packlib")
+(compile-if-needed "seq")
+(compile-if-needed "seqlib")
+(compile-if-needed "trace")
+;(compile-if-needed "thread")
+;(compile-if-needed "loop")
+(bye)
+|#
diff --git a/src/lsp/iolib.lsp b/src/lsp/iolib.lsp
new file mode 100644
index 000000000..c2213ae64
--- /dev/null
+++ b/src/lsp/iolib.lsp
@@ -0,0 +1,179 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;;        The IO library.
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+(defmacro with-open-stream ((var stream) &rest body)
+  (multiple-value-bind (ds b)
+      (find-declarations body)
+    `(LET ((,var ,stream))
+       ,@ds
+       (UNWIND-PROTECT
+         (PROGN ,@b)
+         (CLOSE ,var)))))
+
+(defmacro with-input-from-string ((var string &key index start end) &rest body)
+  (if index
+      (multiple-value-bind (ds b)
+          (find-declarations body)
+        `(LET ((,var (MAKE-STRING-INPUT-STREAM ,string ,start ,end)))
+           ,@ds
+           (UNWIND-PROTECT
+             (PROGN ,@b)
+             (SETF ,index (SYS:GET-STRING-INPUT-STREAM-INDEX ,var)))))
+      `(LET ((,var (MAKE-STRING-INPUT-STREAM ,string ,start ,end)))
+         ,@body)))
+
+(defmacro with-output-to-string ((var &optional string) &rest body)
+  (if string
+      `(LET ((,var (MAKE-STRING-OUTPUT-STREAM-FROM-STRING ,string)))
+         ,@body)
+      `(LET ((,var (MAKE-STRING-OUTPUT-STREAM)))
+         ,@body
+         (GET-OUTPUT-STREAM-STRING ,var))))
+
+(defun read-from-string (string
+                         &optional (eof-error-p t) eof-value
+                         &key (start 0) (end (length string))
+                              preserve-whitespace)
+  (let ((stream (make-string-input-stream string start end)))
+    (if preserve-whitespace
+        (values (read-preserving-whitespace stream eof-error-p eof-value)
+                (sys::get-string-input-stream-index stream))
+        (values (read stream eof-error-p eof-value)
+                (sys::get-string-input-stream-index stream)))))
+
+(defun write-to-string (object &rest rest
+                        &key escape radix base
+                             circle pretty level length
+                             case gensym array
+                        &aux (stream (make-string-output-stream)))
+  (declare (ignore escape radix base
+                   circle pretty level length
+                   case gensym array))
+  (apply #'write object :stream stream rest)
+  (get-output-stream-string stream))
+
+(defun prin1-to-string (object
+                        &aux (stream (make-string-output-stream)))
+   (prin1 object stream)
+   (get-output-stream-string stream))
+
+(defun princ-to-string (object
+                        &aux (stream (make-string-output-stream)))
+  (princ object stream)
+  (get-output-stream-string stream))
+
+(defmacro with-open-file ((stream . filespec) &rest body)
+  (multiple-value-bind (ds b)
+      (find-declarations body)
+    `(LET ((,stream (OPEN ,@filespec)))
+       ,@ds
+       (UNWIND-PROTECT
+         (MULTIPLE-VALUE-PROG1 (PROGN ,@b) (WHEN ,stream (CLOSE ,stream)))
+         (WHEN ,stream (CLOSE ,stream :ABORT T))))))
+
+(defun y-or-n-p (&optional string &rest args)
+  (do ((reply))
+      (nil)
+    (when string (format *query-io* "~&~?  (Y or N) " string args))
+    (setq reply (read *query-io*))
+    (cond ((string-equal (symbol-name reply) "Y")
+           (return-from y-or-n-p t))
+          ((string-equal (symbol-name reply) "N")
+           (return-from y-or-n-p nil)))))
+
+(defun yes-or-no-p (&optional string &rest args)
+  (do ((reply))
+      (nil)
+    (when string (format *query-io* "~&~?  (Yes or No) " string args))
+    (setq reply (read *query-io*))
+    (cond ((string-equal (symbol-name reply) "YES")
+           (return-from yes-or-no-p t))
+          ((string-equal (symbol-name reply) "NO")
+           (return-from yes-or-no-p nil)))))
+
+(defun sharp-a-reader (stream subchar arg)
+  (declare (ignore subchar))
+  (let ((initial-contents (read stream nil nil t)))
+    (if *read-suppress*
+        nil
+        (do ((i 0 (1+ i))
+             (d nil (cons (length ic) d))
+             (ic initial-contents (if (zerop (length ic)) ic (elt ic 0))))
+            ((>= i arg)
+             (make-array (nreverse d) :initial-contents initial-contents))
+	  (declare (fixnum i))))))
+
+(set-dispatch-macro-character #\# #\a 'sharp-a-reader)
+(set-dispatch-macro-character #\# #\A 'sharp-a-reader)
+
+(defun sharp-s-reader-si (stream subchar arg)
+  (declare (ignore subchar))
+  (when (and arg (null *read-suppress*))
+        (error "~S is an extra argument for the #s readmacro." arg))
+  (let ((l (read stream)))
+    (when *read-suppress*
+      (return-from sharp-s-reader-si nil))
+    (unless (get (car l) 'is-a-structure)
+            (error "~S is not a structure." (car l)))
+    ;; Intern keywords in the keyword package.
+    (do ((ll (cdr l) (cddr ll)))
+        ((endp ll)
+         ;; Find an appropriate construtor.
+         (do ((cs (get (car l) 'structure-constructors) (cdr cs)))
+             ((endp cs)
+              (error "The structure ~S has no structure constructor."
+                     (car l)))
+           (when (symbolp (car cs))
+                 (return (apply (car cs) (cdr l))))))
+      (rplaca ll (intern (string (car ll)) 'keyword)))))
+
+(set-dispatch-macro-character #\# #\s 'sharp-s-reader-si)
+(set-dispatch-macro-character #\# #\S 'sharp-s-reader-si)
+
+(defvar *dribble-stream* nil)
+(defvar *dribble-io* nil)
+(defvar *dribble-namestring* nil)
+(defvar *dribble-saved-terminal-io* nil)
+
+(defun dribble (&optional (pathname "DRIBBLE.LOG" psp) (f :supersede))
+  (cond ((not psp)
+         (when (null *dribble-stream*) (error "Not in dribble."))
+         (if (eq *dribble-io* *terminal-io*)
+             (setq *terminal-io* *dribble-saved-terminal-io*)
+             (warn "*TERMINAL-IO* was rebound while DRIBBLE is on.~%~
+                   You may miss some dribble output."))
+         (close *dribble-stream*)
+         (setq *dribble-stream* nil)
+         (format t "~&Finished dribbling to ~A." *dribble-namestring*))
+        (*dribble-stream*
+         (error "Already in dribble (to ~A)." *dribble-namestring*))
+        (t
+         (let* ((namestring (namestring pathname))
+                (stream (open pathname :direction :output
+                                       :if-exists f
+                                       :if-does-not-exist :create)))
+           (setq *dribble-namestring* namestring
+                 *dribble-stream* stream
+                 *dribble-saved-terminal-io* *terminal-io*
+                 *dribble-io* (make-two-way-stream
+                               (make-echo-stream *terminal-io* stream)
+                               (make-broadcast-stream *terminal-io* stream))
+                 *terminal-io* *dribble-io*)
+           (multiple-value-bind (sec min hour day month year)
+               (get-decoded-time)
+             (format t "~&Starts dribbling to ~A (~d/~d/~d, ~d:~d:~d)."
+                     namestring year month day hour min sec))))))
+
+;(provide 'iolib)
diff --git a/src/lsp/listlib.lsp b/src/lsp/listlib.lsp
new file mode 100644
index 000000000..a8cea1515
--- /dev/null
+++ b/src/lsp/listlib.lsp
@@ -0,0 +1,101 @@
+;;;;  Copyright (c) 1995, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;;                        list manipulating routines
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 0) (space 3))))
+
+(defun union (list1 list2 &rest rest)
+  (do ((x list1 (cdr x))
+       (first) (last))
+      ((null x)
+       (when last (rplacd last list2))
+       (or first list2))
+    (unless (consp x) (error "UNION not passed a list"))
+    (unless (apply #'member1 (car x) list2 rest)
+      (if last
+	  (progn (rplacd last (cons (car x) nil))
+		 (setq last (cdr last)))
+	  (progn (setq first (cons (car x) nil))
+		 (setq last first))))))
+
+(defun nunion (list1 list2 &rest rest)
+  (do ((x list1 (cdr x))
+       (first) (last))
+      ((null x)
+       (when last (rplacd last list2))
+       (or first list2))
+    (unless (consp x) (error "NUNION not passed a list"))
+    (unless (apply #'member1 (car x) list2 rest)
+      (if last
+	  (rplacd last x)
+	  (setq first x))
+      (setq last x))))
+
+(defun intersection (list1 list2 &rest rest)
+  (do ((x list1 (cdr x))
+       (ans))
+      ((null x)
+       (nreverse ans)) ; optional nreverse: not required by CLtL
+    (unless (consp x) (error "INTERSECTION not passed a list"))
+    (when (apply #'member1 (car x) list2 rest)
+        (push (car x) ans))))
+
+(defun nintersection (list1 list2 &rest rest)
+  (do ((x list1 (cdr x))
+       (first) (last))
+      ((null x)
+       (when last (rplacd last nil))
+       first)
+    (unless (consp x) (error "NINTERSECTION not passed a list"))
+    (when (apply #'member1 (car x) list2 rest)
+      (if last
+	  (rplacd last x)
+	  (setq first x))
+      (setq last x))))
+
+(defun set-difference (list1 list2 &rest rest)
+  (do ((x list1 (cdr x))
+       (ans))
+      ((null x) (nreverse ans))
+    (unless (consp x) (error "SET-DIFFERENCE not passed a list"))
+    (unless (apply #'member1 (car x) list2 rest)
+      (push (car x) ans))))
+
+(defun nset-difference (list1 list2 &rest rest)
+  (do ((x list1 (cdr x))
+       (first) (last))
+      ((null x)
+       (when last (rplacd last nil))
+       first)
+    (unless (consp x) (error "NSET-DIFFERENCE not passed a list"))
+    (unless (apply #'member1 (car x) list2 rest)
+      (if last
+	  (rplacd last x)
+	  (setq first x))
+      (setq last x))))
+
+(defun set-exclusive-or (list1 list2 &rest rest &key test test-not key)
+  (declare (ignore test test-not key))
+  (nconc (apply #'set-difference list1 list2 rest)
+         (apply #'set-difference list2 list1 rest)))
+
+(defun nset-exclusive-or (list1 list2 &rest rest &key test test-not key)
+  (declare (ignore test test-not key))
+  (nconc (apply #'set-difference list1 list2 rest)
+	 (apply #'nset-difference list2 list1 rest)))
+
+(defun subsetp (list1 list2 &rest rest &key test test-not key)
+  (declare (ignore test test-not key))
+  (do ((l list1 (cdr l)))
+      ((null l) t)
+    (unless (consp l) (error "SUBSETP not passed a list"))
+    (unless (apply #'member1 (car l) list2 rest)
+      (return nil))))
diff --git a/src/lsp/load.lsp.in b/src/lsp/load.lsp.in
new file mode 100644
index 000000000..5ff894a7b
--- /dev/null
+++ b/src/lsp/load.lsp.in
@@ -0,0 +1,29 @@
+
+(load "@srcdir@/export.lsp")
+(load "@srcdir@/defmacro.lsp")
+(load "@srcdir@/evalmacros.lsp")
+(load "@srcdir@/module.lsp")
+(load "@srcdir@/autoload.lsp")
+(load "@srcdir@/describe.lsp")
+(load "@srcdir@/setf.lsp")
+(load "@srcdir@/predlib.lsp")
+(load "@srcdir@/arraylib.lsp")
+(load "@srcdir@/assert.lsp")
+(load "@srcdir@/defstruct.lsp")
+(load "@srcdir@/iolib.lsp")
+(load "@srcdir@/listlib.lsp")
+(load "@srcdir@/mislib.lsp")
+(load "@srcdir@/numlib.lsp")
+(load "@srcdir@/packlib.lsp")
+(load "@srcdir@/seq.lsp")
+(load "@srcdir@/seqlib.lsp")
+(load "@srcdir@/trace.lsp")
+(load "@srcdir@/ansi.lsp")
+(load "@srcdir@/loop.lsp")
+(load "@srcdir@/defpackage.lsp")
+ #+threads
+(load "@srcdir@/threads.lsp")
+ #+tk
+(load "@srcdir@/tk-init.lsp")
+(load "@builddir@/lsp/config.lsp")
+(load "@srcdir@/top.lsp")
diff --git a/src/lsp/loop.lsp b/src/lsp/loop.lsp
new file mode 100644
index 000000000..e92fff73c
--- /dev/null
+++ b/src/lsp/loop.lsp
@@ -0,0 +1,1434 @@
+;;;   -*- Mode:LISP; Syntax:Common-Lisp; Package:LOOP; Base:10; Lowercase:T -*-
+;;;   *************************************************************************
+;;;   ******* Common Lisp ******** LOOP Iteration Macro ***********************
+;;;   *************************************************************************
+;;;   ***** (C) COPYRIGHT 1980, 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ****
+;;;   ********* THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) ***************
+;;;   *************************************************************************
+
+;;;; LOOP Iteration Macro
+
+;;; This is the "officially sanctioned" version of LOOP for running in
+;;; Common Lisp.  It is a conversion of LOOP 829, which is fairly close to
+;;; that released with Symbolics Release 6.1 (803).  This conversion was
+;;; made by Glenn Burke (one of the original author/maintainers);  the
+;;; work was performed at Palladian Software, in Cambridge MA, April 1986.
+;;; 
+;;; The current version of this file will be maintained at MIT, available
+;;; for anonymous FTP on MC.LCS.MIT.EDU from the file "LSB1;CLLOOP >".  This
+;;; location will no doubt change sometime in the future.
+;;; 
+;;;
+;;; This file was actually taken from trix.ai.mit.edu.
+;;;
+;;; This file, like the LOOP it is derived from, has unrestricted
+;;; distribution -- anyone may take it and use it.  But for the sake of
+;;; consistency, bug reporting, compatibility, and users' sanity, PLEASE
+;;; PLEASE PLEASE don't go overboard with fixes or changes.  Remember that
+;;; this version is supposed to be compatible with the Maclisp/Zetalisp/NIL
+;;; LOOP;  it is NOT intended to be "different" or "better" or "redesigned".
+;;; Report bugs and propose fixes to BUG-LOOP@MC.LCS.MIT.EDU;
+;;; announcements about LOOP will be made to the mailing list
+;;; INFO-LOOP@MC.LCS.MIT.EDU.  Mail concerning those lists (such as requests
+;;; to be added) should be sent to the BUG-LOOP-REQUEST and
+;;; INFO-LOOP-REQUEST lists respectively.  Note the Change History page
+;;; below...
+;;; 
+;;; LOOP documentation is still probably available from the MIT Laboratory
+;;; for Computer Science publications office:
+;;; 	LCS Publications
+;;; 	545 Technology Square
+;;; 	Cambridge, MA 02139
+;;; It is Technical Memo 169, "LOOP Iteration Macro", and is very old.  The
+;;; most up-to-date documentation on this version of LOOP is that in the NIL
+;;; Reference Manual (TR-311 from LCS Publications);  while you wouldn't
+;;; want to get that (it costs nearly $15) just for LOOP documentation,
+;;; those with access to a NIL manual might photocopy the chapter on LOOP.
+;;; That revised documentation can be reissued as a revised technical memo
+;;; if there is sufficient demand.
+;;;
+
+
+;;;; Change History
+
+;;; [gsb@palladian] 30-apr-86 00:26  File Created from NIL's LOOP version 829
+;;; [gsb@palladian] 30-oct-86 18:23  don't generate (type notype var) decls, special-case notype into T.
+;;;		    (The NOTYPE type keyword needs to be around for compatibility.)
+;;; [gsb@palladian] 30-oct-86 18:48  bogus case clause in loop-do-collect.  Syntax:common-lisp in file
+;;;		    attribute list, for symbolics gratuitousness.
+;;; [jeff@palladian] 22-jul-87 19:44 Export loop-simple-error.
+;;;------------------------------------------------------------------------
+;;;------- End of official change history -- note local fixes below -------
+;;;------------------------------------------------------------------------
+
+;;; [boyer@cs.utexas.edu] 9-july-87  In define-loop-macro moved
+;;; &environment and its formal to right after &whole to overcome a bug
+;;; in KCL.
+
+
+
+;;;; Package setup
+
+;(provide 'loop)
+
+
+;;;The following symbols are documented as being available via SI:.  Far be
+;;;it for us to define a package by that name, however we can do the
+;;;following.  We will create a "loop-si-kludge" package (sounds like a
+;;;fairly safe name), import the SI: symbols from there into LOOP, export
+;;;them, define that people (use-package 'loop), and if they want to
+;;;maintain source compatibility they can add the SI nickname the
+;;;loop-si-kludge package.  How's that?
+
+;(in-package 'loop-si-kludge)
+
+;(export '(loop-tequal loop-tassoc loop-tmember *loop-use-system-destructuring?*
+;	  loop-named-variable loop-simplep loop-simplep-1
+;	  loop-sequencer loop-sequence-elements-path))
+
+(in-package "SYSTEM")
+
+;(use-package '(loop-si-kludge))
+
+;shadow?
+
+(export '(loop loop-finish define-loop-macro define-loop-path
+	       define-loop-sequence-path))
+
+(export '(loop-tequal loop-tassoc loop-tmember *loop-use-system-destructuring?*
+	  loop-named-variable loop-simple-error loop-simplep loop-simplep-1
+	  loop-sequencer loop-sequence-elements-path))
+
+;require?
+
+
+;;;; Macro Environment Setup
+
+
+;;; The uses of this macro are retained in the CL version of loop, in case they are
+;;; needed in a particular implementation.  Originally dating from the use of the
+;;; Zetalisp COPYLIST* function, this is used in situations where, were cdr-coding
+;;; in use, having cdr-NIL at the end of the list might be suboptimal because the
+;;; end of the list will probably be RPLACDed and so cdr-normal should be used instead.
+(defmacro loop-copylist* (l)
+  `(copy-list ,l))
+
+
+;;;; Random Macros
+
+(defmacro loop-simple-error (unquoted-message &optional (datum nil datump))
+  `(error ,(if datump "LOOP:  ~S ~A" "LOOP:  ~A")
+	  ',unquoted-message ,@(and datump (list datum))))
+
+
+(defmacro loop-warn (unquoted-message &optional (datum nil datump))
+  (if datump
+      `(warn ,(concatenate 'string "LOOP: " unquoted-message " -- ~{~S~^ ~}")
+	     ,datum)
+      `(warn ',(concatenate 'string "LOOP: " unquoted-message))))
+
+
+(defmacro loop-pop-source () '(pop *loop-source-code*))
+
+(defmacro loop-gentemp (&optional (pref ''loopvar-))
+  `(gentemp ',(symbol-name (second pref))))
+
+
+;;;; Setq Hackery
+
+; Note:  LOOP-MAKE-PSETQ is NOT flushable depending on the existence
+; of PSETQ, unless PSETQ handles destructuring.  Even then it is
+; preferable for the code LOOP produces to not contain intermediate
+; macros, especially in the PDP10 version.
+
+(defun loop-make-psetq (frobs)
+    (and frobs
+	 (loop-make-setq
+	    (list (car frobs)
+		  (if (null (cddr frobs)) (cadr frobs)
+		      `(prog1 ,(cadr frobs)
+			      ,(loop-make-psetq (cddr frobs))))))))
+
+
+(defvar *loop-use-system-destructuring?*
+    nil)
+
+(defvar *loop-desetq-temporary*)
+
+; Do we want this???  It is, admittedly, useful...
+;(defmacro loop-desetq (&rest x)
+;  (let ((*loop-desetq-temporary* nil))
+;     (let ((setq-form (loop-make-desetq x)))
+;	(if *loop-desetq-temporary*
+;	    `((lambda (,*loop-desetq-temporary*) ,setq-form) nil)
+;	    setq-form))))
+
+
+(defun loop-make-desetq (x)
+   (if *loop-use-system-destructuring?*
+       (cons (do ((l x (cddr l))) ((null l) 'setq)
+	       (or (and (not (null (car l))) (symbolp (car l)))
+		   (return 'desetq)))
+	     x)
+       (do ((x x (cddr x)) (r nil) (var) (val))
+	   ((null x) (and r (cons 'setq r)))
+	 (setq var (car x) val (cadr x))
+	 (cond ((and (not (atom var))
+		     (not (atom val))
+		     (not (and (member (car val) '(car cdr cadr cddr caar cdar))
+			       (atom (cadr val)))))
+		  (setq x (list* (or *loop-desetq-temporary*
+				     (setq *loop-desetq-temporary*
+					   (loop-gentemp 'loop-desetq-)))
+				 val var *loop-desetq-temporary* (cddr x)))))
+	 (setq r (nconc r (loop-desetq-internal (car x) (cadr x)))))))
+
+
+(defun loop-desetq-internal (var val)
+  (cond ((null var) nil)
+	((atom var) (list var val))
+	(t (nconc (loop-desetq-internal (car var) `(car ,val))
+		  (loop-desetq-internal (cdr var) `(cdr ,val))))))
+
+
+(defun loop-make-setq (pairs)
+    (and pairs (loop-make-desetq pairs)))
+
+
+(defconstant +loop-keyword-alist+			;clause introducers
+     '(	(named loop-do-named)
+	(initially loop-do-initially)
+	(finally loop-do-finally)
+	(nodeclare loop-nodeclare)
+	(do loop-do-do)
+	(doing loop-do-do)
+	(return loop-do-return)
+	(collect loop-do-collect list)
+	(collecting loop-do-collect list)
+	(append loop-do-collect append)
+	(appending loop-do-collect append)
+	(nconc loop-do-collect nconc)
+	(nconcing loop-do-collect nconc)
+	(count loop-do-collect count)
+	(counting loop-do-collect count)
+	(sum loop-do-collect sum)
+	(summing loop-do-collect sum)
+	(maximize loop-do-collect max)
+	(minimize loop-do-collect min)
+	(always loop-do-always nil) ;Normal, do always
+	(never loop-do-always t)    ; Negate the test on always.
+	(thereis loop-do-thereis)
+	(while loop-do-while nil while)	    ; Normal, do while
+	(until loop-do-while t until)	    ; Negate the test on while
+	(when loop-do-when nil when)	    ; Normal, do when
+	(if loop-do-when nil if)    ; synonymous
+ 	(unless loop-do-when t unless)	    ; Negate the test on when
+	(with loop-do-with)))
+
+
+(defconstant +loop-iteration-keyword-alist+
+    `((for loop-do-for)
+      (as loop-do-for)
+      (repeat loop-do-repeat)))
+
+
+(defconstant +loop-for-keyword-alist+			;Types of FOR
+     '( (= loop-for-equals)
+        (first loop-for-first)
+	(in loop-list-stepper car)
+	(on loop-list-stepper nil)
+	(from loop-for-arithmetic from)
+	(downfrom loop-for-arithmetic downfrom)
+	(upfrom loop-for-arithmetic upfrom)
+	(below loop-for-arithmetic below)
+	(to loop-for-arithmetic to)
+	(being loop-for-being)))
+
+(defvar *loop-prog-names*)
+
+
+(defvar *loop-macro-environment*)	;Second arg to macro functions,
+					;passed to macroexpand.
+
+(defvar *loop-path-keyword-alist* nil)	; PATH functions
+(defvar *loop-named-variables*)		; see LOOP-NAMED-VARIABLE
+(defvar *loop-variables*)		; Variables local to the loop
+(defvar *loop-declarations*)		; Local dcls for above
+(defvar *loop-nodeclare*)		; but don't declare these
+(defvar *loop-variable-stack*)
+(defvar *loop-declaration-stack*)
+(defvar *loop-desetq-crocks*)		; see loop-make-variable
+(defvar *loop-desetq-stack*)		; and loop-translate-1
+(defvar *loop-prologue*)		;List of forms in reverse order
+(defvar *loop-wrappers*)		;List of wrapping forms, innermost first
+(defvar *loop-before-loop*)
+(defvar *loop-body*)			;..
+(defvar *loop-after-body*)		;.. for FOR steppers
+(defvar *loop-epilogue*)		;..
+(defvar *loop-after-epilogue*)		;So COLLECT's RETURN comes after FINALLY
+(defvar *loop-conditionals*)		;If non-NIL, condition for next form in body
+  ;The above is actually a list of entries of the form
+  ;(cond (condition forms...))
+  ;When it is output, each successive condition will get
+  ;nested inside the previous one, but it is not built up
+  ;that way because you wouldn't be able to tell a WHEN-generated
+  ;COND from a user-generated COND.
+  ;When ELSE is used, each cond can get a second clause
+
+(defvar *loop-when-it-variable*)	;See LOOP-DO-WHEN
+(defvar *loop-never-stepped-variable*)	; see LOOP-FOR-FIRST
+(defvar *loop-emitted-body?*)		; see LOOP-EMIT-BODY,
+					; and LOOP-DO-FOR
+(defvar *loop-iteration-variables*)	; LOOP-MAKE-ITERATION-VARIABLE
+(defvar *loop-iteration-variablep*)	; ditto
+(defvar *loop-collect-cruft*)		; for multiple COLLECTs (etc)
+(defvar *loop-source-code*)
+(defvar *loop-duplicate-code* nil)	; see LOOP-OPTIMIZE-DUPLICATED-CODE-ETC
+
+
+;;;; Construct a value return
+
+
+(defun loop-construct-return (form)
+  (if *loop-prog-names*
+      `(return-from ,(car *loop-prog-names*) ,form)
+      `(return ,form)))
+
+;;;; Token Hackery
+
+;Compare two "tokens".  The first is the frob out of *LOOP-SOURCE-CODE*,
+;the second a symbol to check against.
+
+(defun loop-tequal (x1 x2)
+  (and (symbolp x1) (string= x1 x2)))
+
+
+(defun loop-tassoc (kwd alist)
+  (and (symbolp kwd) (assoc kwd alist :test #'string=)))
+
+
+(defun loop-tmember (kwd list)
+  (and (symbolp kwd) (member kwd list :test #'string=)))
+
+
+
+(defmacro define-loop-macro (keyword)
+  "Makes KEYWORD, which is a LOOP keyword, into a Lisp macro that may
+introduce a LOOP form.  This facility exists mostly for diehard users of
+a predecessor of LOOP.  Unconstrained use is not advised, as it tends to
+decrease the transportability of the code and needlessly uses up a
+function name."
+  (or (eq keyword 'loop)
+      (loop-tassoc keyword +loop-keyword-alist+)
+      (loop-tassoc keyword +loop-iteration-keyword-alist+)
+      (loop-simple-error "not a loop keyword - define-loop-macro" keyword))
+  `(defmacro ,keyword (&whole whole-form  &environment env &rest keywords-and-forms)
+     (declare (ignore keywords-and-forms))
+     (loop-translate whole-form env)))
+
+
+(define-loop-macro loop)
+
+
+(defmacro loop-finish () 
+  "Causes the iteration to terminate \"normally\", the same as implicit
+termination by an iteration driving clause, or by use of WHILE or
+UNTIL -- the epilogue code (if any) will be run, and any implicitly
+collected result will be returned as the value of the LOOP."
+  '(go end-loop))
+
+
+(defun loop-translate (x *loop-macro-environment*)
+  (loop-translate-1 x))
+
+
+(defun loop-end-testify (list-of-forms)
+    (if (null list-of-forms) nil
+	`(when ,(if (null (cdr (setq list-of-forms (nreverse list-of-forms))))
+		    (car list-of-forms)
+		    (cons 'or list-of-forms))
+	   (go end-loop))))
+
+(defun loop-optimize-duplicated-code-etc (&aux before after groupa groupb a b
+					       lastdiff)
+    (do ((l1 (nreverse *loop-before-loop*) (cdr l1))
+	 (l2 (nreverse *loop-after-body*) (cdr l2)))
+	((equal l1 l2)
+	   (setq *loop-body* (nconc (delete nil l1) (nreverse *loop-body*))))
+      (push (car l1) before) (push (car l2) after))
+    (cond ((not (null *loop-duplicate-code*))
+	     (setq *loop-before-loop* (nreverse (delete nil before))
+		   *loop-after-body* (nreverse (delete nil after))))
+	  (t (setq *loop-before-loop* nil *loop-after-body* nil
+		   before (nreverse before) after (nreverse after))
+	     (do ((bb before (cdr bb)) (aa after (cdr aa)))
+		 ((null aa))
+	       (cond ((not (equal (car aa) (car bb))) (setq lastdiff aa))
+		     ((not (loop-simplep (car aa)))	;Mustn't duplicate
+		      (return nil))))
+	     (cond (lastdiff  ;Down through lastdiff should be duplicated
+		    (do nil (nil)
+		      (and (car before) (push (car before) *loop-before-loop*))
+		      (and (car after) (push (car after) *loop-after-body*))
+		      (setq before (cdr before) after (cdr after))
+		      (and (eq after (cdr lastdiff)) (return nil)))
+		    (setq *loop-before-loop* (nreverse *loop-before-loop*)
+			  *loop-after-body* (nreverse *loop-after-body*))))
+	     (do ((bb (nreverse before) (cdr bb))
+		  (aa (nreverse after) (cdr aa)))
+		 ((null aa))
+	       (setq a (car aa) b (car bb))
+	       (cond ((and (null a) (null b)))
+		     ((equal a b)
+			(loop-output-group groupb groupa)
+			(push a *loop-body*)
+			(setq groupb nil groupa nil))
+		     (t (and a (push a groupa)) (and b (push b groupb)))))
+	     (loop-output-group groupb groupa)))
+    (and *loop-never-stepped-variable*
+	 (push `(setq ,*loop-never-stepped-variable* nil) *loop-after-body*))
+    nil)
+
+
+(defun loop-output-group (before after)
+    (and (or after before)
+	 (let ((v (or *loop-never-stepped-variable*
+		      (setq *loop-never-stepped-variable*
+			    (loop-make-variable
+			      (loop-gentemp 'loop-iter-flag-) t nil)))))
+	    (push (cond ((not before)
+			  `(unless ,v (progn ,@after)))
+			((not after)
+			  `(when ,v (progn ,@before)))
+			(t `(cond (,v ,@before) (t ,@after))))
+		  *loop-body*))))
+
+
+(defun loop-translate-1 (*loop-source-code*)
+  (and (eq (car *loop-source-code*) 'loop)
+       (setq *loop-source-code* (cdr *loop-source-code*)))
+  (do* ((*loop-iteration-variables* nil)
+       (*loop-iteration-variablep* nil)
+       (*loop-variables* nil)
+       (*loop-nodeclare* nil)
+       (*loop-named-variables* nil)
+       (*loop-declarations* nil)
+       (*loop-desetq-crocks* nil)
+       (*loop-variable-stack* nil)
+       (*loop-declaration-stack* nil)
+       (*loop-desetq-stack* nil)
+       (*loop-prologue* nil)
+       (*loop-wrappers* nil)
+       (*loop-before-loop* nil)
+       (*loop-body* nil)
+       (*loop-emitted-body?* nil)
+       (*loop-after-body* nil)
+       (*loop-epilogue* nil)
+       (*loop-after-epilogue* nil)
+       (*loop-conditionals* nil)
+       (*loop-when-it-variable* nil)
+       (*loop-never-stepped-variable* nil)
+       (*loop-desetq-temporary* nil)
+       (*loop-prog-names* nil)
+       (*loop-collect-cruft* nil)
+       (keyword)
+       (tem)
+       (progvars))
+      ((null *loop-source-code*)
+       (and *loop-conditionals*
+	    (loop-simple-error "Hanging conditional in loop macro"
+			       (caadar *loop-conditionals*)))
+       (loop-optimize-duplicated-code-etc)
+       (loop-bind-block)
+       (and *loop-desetq-temporary* (push *loop-desetq-temporary* progvars))
+       (setq tem `(block ,(car *loop-prog-names*)
+		    (let ,progvars
+		      (tagbody
+			,@(nreverse *loop-prologue*)
+			,@*loop-before-loop*
+		     next-loop
+			,@*loop-body*
+			,@*loop-after-body*
+			(go next-loop)
+			(go end-loop)
+		     end-loop
+			,@(nreverse *loop-epilogue*)
+			,@(nreverse *loop-after-epilogue*)))))
+       (do ((vars) (dcls) (crocks))
+	   ((null *loop-variable-stack*))
+	 (setq vars (car *loop-variable-stack*)
+	       *loop-variable-stack* (cdr *loop-variable-stack*)
+	       dcls (car *loop-declaration-stack*)
+	       *loop-declaration-stack* (cdr *loop-declaration-stack*)
+	       tem (list tem))
+	 (and (setq crocks (pop *loop-desetq-stack*))
+	      (push (loop-make-desetq crocks) tem))
+	 (and dcls (push (cons 'declare dcls) tem))
+	 ;; JJGR -- Avoid building LAMBDAs as far as possible
+	 (setq tem `(let ,(nreverse vars) ,@tem))
+	 #+nil
+	 (cond ((do ((l vars (cdr l))) ((null l) nil)
+		  (and (not (atom (car l)))
+		       (or (null (caar l)) (not (symbolp (caar l))))
+		       (return t)))
+		  (setq tem `(let ,(nreverse vars) ,@tem)))
+	       (t (let ((lambda-vars nil) (lambda-vals nil))
+		    (do ((l vars (cdr l)) (v)) ((null l))
+		      (cond ((atom (setq v (car l)))
+			       (push v lambda-vars)
+			       (push nil lambda-vals))
+			    (t (push (car v) lambda-vars)
+			       (push (cadr v) lambda-vals))))
+		    (setq tem `((lambda ,lambda-vars ,@tem)
+				,@lambda-vals))))))
+       (do ((l *loop-wrappers* (cdr l))) ((null l))
+	 (setq tem (append (car l) (list tem))))
+       tem)
+    ;;The following commented-out code is what comes from the newest source
+    ;; code in use in NIL.  The code in use following it comes from about version
+    ;; 803, that in use in symbolics release 6.1, for instance.  To turn on the
+    ;; implicit DO feature, switch them and fix loop-get-form to just pop the source.
+    (if (symbolp (setq keyword (car *loop-source-code*)))
+    	(loop-pop-source)
+      (setq keyword 'do))
+    (cond ((setq tem (loop-tassoc keyword +loop-keyword-alist+))
+	   (apply (cadr tem) (cddr tem)))
+	  ((setq tem (loop-tassoc keyword +loop-iteration-keyword-alist+))
+	   (loop-hack-iteration tem))
+    	  ((loop-tmember keyword '(and else))
+	   ;; Alternative is to ignore it, ie let it go around to the
+	   ;; next keyword...
+	   (loop-simple-error
+	    "secondary clause misplaced at top level in LOOP macro"
+	    (list keyword (car *loop-source-code*)
+		  (cadr *loop-source-code*))))
+	  (t (loop-simple-error "unknown keyword in LOOP macro" keyword)))
+    ;;    (if (symbolp (setq keyword (loop-pop-source)))
+    ;;	(if (setq tem (loop-tassoc keyword +loop-keyword-alist+))
+    ;;	    (apply (cadr tem) (cddr tem))
+    ;;	    (if (setq tem (loop-tassoc
+    ;;			     keyword +loop-iteration-keyword-alist+))
+    ;;		(loop-hack-iteration tem)
+    ;;		(if (loop-tmember keyword '(and else))
+    ;;		    ; Alternative is to ignore it, ie let it go around to the
+    ;;		    ; next keyword...
+    ;;		    (loop-simple-error
+    ;;		       "secondary clause misplaced at top level in LOOP macro"
+    ;;		       (list keyword (car *loop-source-code*)
+    ;;			     (cadr *loop-source-code*)))
+    ;;		    (loop-simple-error
+    ;;		       "unknown keyword in LOOP macro" keyword))))
+    ;;	(loop-simple-error
+    ;;	   "found where keyword expected in LOOP macro" keyword))
+))
+
+
+(defun loop-bind-block ()
+   (cond ((not (null *loop-variables*))
+	    (push *loop-variables* *loop-variable-stack*)
+	    (push *loop-declarations* *loop-declaration-stack*)
+	    (setq *loop-variables* nil *loop-declarations* nil)
+	    (push *loop-desetq-crocks* *loop-desetq-stack*)
+	    (setq *loop-desetq-crocks* nil))))
+
+
+;Get FORM argument to a keyword.  Read up to atom.  PROGNify if necessary.
+(defun loop-get-progn-1 ()
+  (do ((forms (list (loop-pop-source)) (cons (loop-pop-source) forms))
+       (nextform (car *loop-source-code*) (car *loop-source-code*)))
+      ((atom nextform) (nreverse forms))))
+
+(defun loop-get-progn ()
+  (let ((forms (loop-get-progn-1)))
+    (if (null (cdr forms)) (car forms) (cons 'progn forms))))
+
+(defun loop-get-form (for)
+  ;; Until implicit DO is installed, use the following.  Then, replace it with
+  ;; just loop-pop-source.
+  (let ((forms (loop-get-progn-1)))
+    (cond ((null (cdr forms)) (car forms))
+	  (t (loop-warn 
+"The use of multiple forms with an implicit PROGN in this context
+is considered obsolete, but is still supported for the time being.
+If you did not intend to use multiple forms here, you probably omitted a DO.
+If the use of multiple forms was intentional, put a PROGN in your code.
+The offending clause"
+		(if (atom for) (cons for forms) (append for forms)))
+	     (cons 'progn forms)))))
+
+
+;;;This function takes a substitutable expression containing generic arithmetic
+;;; of some form or another, and a data type name, and substitutes for the function
+;;; any type-specific functions for that type in the implementation.
+(defun loop-typed-arith (substitutable-expression data-type)
+  (declare (ignore data-type))
+  substitutable-expression)
+
+(defvar loop-floating-point-types
+	'(flonum float short-float single-float double-float long-float))
+
+(defun loop-typed-init (data-type)
+  (let ((tem nil))
+    (cond ((loop-tmember data-type '(fixnum integer number)) 0)
+	  ((setq tem (car (loop-tmember
+			    data-type loop-floating-point-types)))
+	   (cond ((member tem '(flonum float)) 0.0)
+		 (t (coerce 0 tem)))))))
+
+
+(defun loop-make-variable (name initialization dtype)
+  (cond ((null name)
+	   (cond ((not (null initialization))
+		    (push (list (setq name (loop-gentemp 'loop-ignore-))
+				initialization)
+			  *loop-variables*)
+		      (push `(ignore ,name) *loop-declarations*))))
+	((atom name)
+	   (cond (*loop-iteration-variablep*
+		    (if (member name *loop-iteration-variables*)
+			(loop-simple-error
+			   "Duplicated iteration variable somewhere in LOOP"
+			   name)
+			(push name *loop-iteration-variables*)))
+		 ((assoc name *loop-variables*)
+		    (loop-simple-error
+		       "Duplicated var in LOOP bind block" name)))
+	   (or (symbolp name)
+	       (loop-simple-error "Bad variable somewhere in LOOP" name))
+	   (loop-declare-variable name dtype)
+	   ; We use ASSOC on this list to check for duplications (above),
+	   ; so don't optimize out this list:
+	   (push (list name (or initialization (loop-typed-init dtype)))
+		 *loop-variables*))
+	(initialization
+	   (cond (*loop-use-system-destructuring?*
+		    (loop-declare-variable name dtype)
+		    (push (list name initialization) *loop-variables*))
+		 (t (let ((newvar (loop-gentemp 'loop-destructure-)))
+		      (push (list newvar initialization) *loop-variables*)
+		      ; *LOOP-DESETQ-CROCKS* gathered in reverse order.
+		      (setq *loop-desetq-crocks*
+			    (list* name newvar *loop-desetq-crocks*))
+		      (loop-make-variable name nil dtype)))))
+	(t (let ((tcar nil) (tcdr nil))
+	     (if (atom dtype) (setq tcar (setq tcdr dtype))
+	       (setq tcar (car dtype) tcdr (cdr dtype)))
+	     (loop-make-variable (car name) nil tcar)
+	     (loop-make-variable (cdr name) nil tcdr))))
+  name)
+
+
+(defun loop-make-iteration-variable (name initialization dtype)
+    (let ((*loop-iteration-variablep* t))
+       (loop-make-variable name initialization dtype)))
+
+
+(defun loop-declare-variable (name dtype)
+    (cond ((or (null name) (null dtype)) nil)
+	  ((and (symbolp name) (not (member name *loop-nodeclare*)))
+	   (push `(type ,(if (loop-tequal dtype 'notype) t dtype) ,name)
+		 *loop-declarations*))
+	  ((consp name)
+	      (cond ((consp dtype)
+		       (loop-declare-variable (car name) (car dtype))
+		       (loop-declare-variable (cdr name) (cdr dtype)))
+		    (t (loop-declare-variable (car name) dtype)
+		       (loop-declare-variable (cdr name) dtype))))
+	  (t (loop-simple-error "can't hack this"
+				(list 'loop-declare-variable name dtype)))))
+
+
+(defun loop-constantp (form)
+  (constantp form))
+
+(defun loop-maybe-bind-form (form data-type?)
+    ; Consider implementations which will not keep EQ quoted constants
+    ; EQ after compilation & loading.
+    ; Note FUNCTION is not hacked, multiple occurences might cause the
+    ; compiler to break the function off multiple times!
+    ; Hacking it probably isn't too important here anyway.  The ones that
+    ; matter are the ones that use it as a stepper (or whatever), which
+    ; handle it specially.
+    (if (loop-constantp form) form
+	(loop-make-variable (loop-gentemp 'loop-bind-) form data-type?)))
+
+
+(defun loop-optional-type ()
+    (let ((token (car *loop-source-code*)))
+	(and (not (null token))
+	     (or (not (atom token))
+		 (loop-tmember token '(fixnum integer number notype))
+		 (loop-tmember token loop-floating-point-types))
+	     (loop-pop-source))))
+
+
+;Incorporates conditional if necessary
+(defun loop-make-conditionalization (form)
+  (cond ((not (null *loop-conditionals*))
+	   (rplacd (last (car (last (car (last *loop-conditionals*)))))
+		   (list form))
+	   (cond ((loop-tequal (car *loop-source-code*) 'and)
+		    (loop-pop-source)
+		    nil)
+		 ((loop-tequal (car *loop-source-code*) 'else)
+		    (loop-pop-source)
+		    ;; If we are already inside an else clause, close it off
+		    ;; and nest it inside the containing when clause
+		    (let ((innermost (car (last *loop-conditionals*))))
+		      (cond ((null (cddr innermost)))	;Now in a WHEN clause, OK
+			    ((null (cdr *loop-conditionals*))
+			     (loop-simple-error "More ELSEs than WHENs"
+						(list 'else (car *loop-source-code*)
+						      (cadr *loop-source-code*))))
+			    (t (setq *loop-conditionals* (cdr (nreverse *loop-conditionals*)))
+			       (rplacd (last (car (last (car *loop-conditionals*))))
+				       (list innermost))
+			       (setq *loop-conditionals* (nreverse *loop-conditionals*)))))
+		    ;; Start a new else clause
+		    (rplacd (last (car (last *loop-conditionals*)))
+			    (list (list 't)))
+		    nil)
+		 (t ;Nest up the conditionals and output them
+		     (do ((prev (car *loop-conditionals*) (car l))
+			  (l (cdr *loop-conditionals*) (cdr l)))
+			 ((null l))
+		       (rplacd (last (car (last prev))) (list (car l))))
+		     (prog1 (car *loop-conditionals*)
+			    (setq *loop-conditionals* nil)))))
+	(t form)))
+
+(defun loop-pseudo-body (form &aux (z (loop-make-conditionalization form)))
+   (cond ((not (null z))
+	    (cond (*loop-emitted-body?* (push z *loop-body*))
+		  (t (push z *loop-before-loop*) (push z *loop-after-body*))))))
+
+(defun loop-emit-body (form)
+  (setq *loop-emitted-body?* t)
+  (loop-pseudo-body form))
+
+
+(defun loop-do-named ()
+  (let ((name (loop-pop-source)))
+    (unless (and name (symbolp name))
+      (loop-simple-error "Bad name for your loop construct" name))
+    ;If this don't come first, LOOP will be confused about how to return
+    ; from the prog when it tries to generate such code
+    (when (or *loop-before-loop* *loop-body* *loop-after-epilogue*)
+      (loop-simple-error "NAMED clause occurs too late" name))
+    (when (cdr (setq *loop-prog-names* (cons name *loop-prog-names*)))
+      (loop-simple-error "Too many names for your loop construct"
+			 *loop-prog-names*))))
+
+(defun loop-do-initially ()
+  (push (loop-get-progn) *loop-prologue*))
+
+(defun loop-nodeclare (&aux (varlist (loop-pop-source)))
+    (or (null varlist)
+	(consp varlist)
+	(loop-simple-error "Bad varlist to nodeclare loop clause" varlist))
+    (setq *loop-nodeclare* (append varlist *loop-nodeclare*)))
+
+(defun loop-do-finally ()
+  (push (loop-get-progn) *loop-epilogue*))
+
+(defun loop-do-do ()
+  (loop-emit-body (loop-get-progn)))
+
+(defun loop-do-return ()
+   (loop-pseudo-body (loop-construct-return (loop-get-form 'return))))
+
+
+(defun loop-do-collect (type)
+  (let ((var nil) (form nil) (tem nil) (tail nil) (dtype nil) (cruft nil) (rvar nil)
+	(ctype (case type
+		 ((max min) 'maxmin)
+		 ((nconc list append) 'list)
+		 ((count sum) 'sum)
+		 (t (error "LOOP internal error:  ~S is an unknown collecting keyword."
+			   type)))))
+    (setq form (loop-get-form type) dtype (loop-optional-type))
+    (cond ((loop-tequal (car *loop-source-code*) 'into)
+	     (loop-pop-source)
+	     (setq rvar (setq var (loop-pop-source)))))
+    ; CRUFT will be (varname ctype dtype var tail (optional tem))
+    (cond ((setq cruft (assoc var *loop-collect-cruft*))
+	     (cond ((not (eq ctype (car (setq cruft (cdr cruft)))))
+		      (loop-simple-error
+		         "incompatible LOOP collection types"
+			 (list ctype (car cruft))))
+		   ((and dtype (not (eq dtype (cadr cruft))))
+		      ;Conditional should be on data-type reality
+		    (error "~A and ~A Unequal data types into ~A"
+			   dtype (cadr cruft) (car cruft))))
+	     (setq dtype (car (setq cruft (cdr cruft)))
+		   var (car (setq cruft (cdr cruft)))
+		   tail (car (setq cruft (cdr cruft)))
+		   tem (cadr cruft))
+	     (and (eq ctype 'maxmin)
+		  (not (atom form)) (null tem)
+		  (rplaca (cdr cruft)
+			  (setq tem (loop-make-variable
+				       (loop-gentemp 'loop-maxmin-)
+				       nil dtype)))))
+	  (t (unless dtype
+	       (setq dtype (case type
+			     (count 'fixnum)
+			     ((min max sum) 'number))))
+	     (unless var
+	       (push (loop-construct-return (setq var (loop-gentemp)))
+		     *loop-after-epilogue*))
+	     (loop-make-iteration-variable var nil dtype)
+	     (cond ((eq ctype 'maxmin)
+		      ;Make a temporary.
+		      (unless (atom form)
+			(setq tem (loop-make-variable
+				    (loop-gentemp) nil dtype)))
+		      ;Use the tail slot of the collect database to hold a
+		      ; flag which says we have been around once already.
+		      (setq tail (loop-make-variable
+				   (loop-gentemp 'loop-maxmin-fl-) t nil)))
+		   ((eq ctype 'list)
+		    ;For dumb collection, we need both a tail and a flag var
+		    ; to tell us whether we have iterated.
+		    (setq tail (loop-make-variable (loop-gentemp) nil nil)
+			  tem (loop-make-variable (loop-gentemp) nil nil))))
+	     (push (list rvar ctype dtype var tail tem)
+		   *loop-collect-cruft*)))
+    (loop-emit-body
+	(case type
+	  (count (setq tem `(setq ,var (,(loop-typed-arith '1+ dtype)
+					,var)))
+		 (if (or (eq form t) (equal form ''t))
+		     tem
+		     `(when ,form ,tem)))
+	  (sum `(setq ,var (,(loop-typed-arith '+ dtype) ,form ,var)))
+	  ((max min)
+	     (let ((forms nil) (arglist nil))
+		; TEM is temporary, properly typed.
+		(and tem (setq forms `((setq ,tem ,form)) form tem))
+		(setq arglist (list var form))
+		(push (if (loop-tmember dtype '(fixnum flonum))
+			  ; no contagious arithmetic
+			  `(when (or ,tail
+				     (,(loop-typed-arith
+				         (if (eq type 'max) '< '>)
+					 dtype)
+				      ,@arglist))
+			     (setq ,tail nil ,@arglist))
+			  ; potentially contagious arithmetic -- must use
+			  ; MAX or MIN so that var will be contaminated
+			  `(setq ,var (cond (,tail (setq ,tail nil) ,form)
+					    (t (,type ,@arglist)))))
+		      forms)
+		(if (cdr forms) (cons 'progn (nreverse forms)) (car forms))))
+	  (t (case type
+		(list (setq form (list 'list form)))
+		(append (or (and (not (atom form)) (eq (car form) 'list))
+			    (setq form `(copy-list ,form)))))
+	     (let ((q `(if ,tail (cdr (rplacd ,tail ,tem))
+			 (setq ,var ,tem))))
+		(if (and (not (atom form)) (eq (car form) 'list) (cdr form))
+		    `(setq ,tem ,form ,tail ,(loop-cdrify (cddr form) q))
+		    `(when (setq ,tem ,form) (setq ,tail (last ,q))))))))))
+
+
+(defun loop-cdrify (arglist form)
+    (do ((size (length arglist) (- size 4)))
+	((< size 4)
+	 (if (zerop size) form
+	     (list (cond ((= size 1) 'cdr) ((= size 2) 'cddr) (t 'cdddr))
+		   form)))
+      (declare (type fixnum size))
+      (setq form (list 'cddddr form))))
+
+
+
+(defun loop-do-while (negate? kwd &aux (form (loop-get-form kwd)))
+  (when *loop-conditionals*
+    (loop-simple-error "not allowed inside LOOP conditional"
+		       (list kwd form)))
+  (loop-pseudo-body `(,(if negate? 'when 'unless)
+		      ,form (go end-loop))))
+
+
+(defun loop-do-when (negate? kwd)
+  (let ((form (loop-get-form kwd)) (cond nil))
+    (cond ((loop-tequal (cadr *loop-source-code*) 'it)
+	     ;WHEN foo RETURN IT and the like
+	     (setq cond `(setq ,(loop-when-it-variable) ,form))
+	     (setq *loop-source-code*		;Plug in variable for IT
+		   (list* (car *loop-source-code*)
+			  *loop-when-it-variable*
+			  (cddr *loop-source-code*))))
+	  (t (setq cond form)))
+    (and negate? (setq cond `(not ,cond)))
+    (setq *loop-conditionals* (nconc *loop-conditionals* `((cond (,cond)))))))
+
+(defun loop-do-with ()
+  (do ((var) (equals) (val) (dtype)) (nil)
+    (setq var (loop-pop-source) equals (car *loop-source-code*))
+    (cond ((loop-tequal equals '=)
+	     (loop-pop-source)
+	     (setq val (loop-get-form (list 'with var '=)) dtype nil))
+	  ((or (loop-tequal equals 'and)
+	       (loop-tassoc equals +loop-keyword-alist+)
+	       (loop-tassoc equals +loop-iteration-keyword-alist+))
+	     (setq val nil dtype nil))
+	  (t (setq dtype (loop-optional-type) equals (car *loop-source-code*))
+	     (cond ((loop-tequal equals '=)
+		      (loop-pop-source)
+		      (setq val (loop-get-form (list 'with var dtype '=))))
+		   ((and (not (null *loop-source-code*))
+			 (not (loop-tassoc equals +loop-keyword-alist+))
+			 (not (loop-tassoc
+				 equals +loop-iteration-keyword-alist+))
+			 (not (loop-tequal equals 'and)))
+		      (loop-simple-error "Garbage where = expected" equals))
+		   (t (setq val nil)))))
+    (loop-make-variable var val dtype)
+    (if (not (loop-tequal (car *loop-source-code*) 'and)) (return nil)
+	(loop-pop-source)))
+  (loop-bind-block))
+
+(defun loop-do-always (negate?)
+  (let ((form (loop-get-form 'always)))
+    (loop-emit-body `(,(if negate? 'when 'unless) ,form
+		      ,(loop-construct-return nil)))
+    (push (loop-construct-return t) *loop-after-epilogue*)))
+
+;THEREIS expression
+;If expression evaluates non-nil, return that value.
+(defun loop-do-thereis ()
+   (loop-emit-body `(when (setq ,(loop-when-it-variable)
+				,(loop-get-form 'thereis))
+		      ,(loop-construct-return *loop-when-it-variable*))))
+
+
+;;;; Hacks
+
+(defun loop-simplep (expr)
+    (if (null expr) 0
+      (catch 'loop-simplep
+	(let ((ans (loop-simplep-1 expr)))
+	  (declare (fixnum ans))
+	  (and (< ans 20.) ans)))))
+
+(defvar loop-simplep
+	'(> < <= >= /= + - 1+ 1- ash equal atom setq prog1 prog2 and or = aref char schar sbit svref))
+
+(defun loop-simplep-1 (x)
+  (let ((z 0))
+    (declare (fixnum z))
+    (cond ((loop-constantp x) 0)
+	  ((atom x) 1)
+	  ((eq (car x) 'cond)
+	     (do ((cl (cdr x) (cdr cl))) ((null cl))
+	       (do ((f (car cl) (cdr f))) ((null f))
+		 (setq z (+ (loop-simplep-1 (car f)) z 1))))
+	     z)
+	  ((symbolp (car x))
+	     (let ((fn (car x)) (tem nil))
+	       (cond ((setq tem (get fn 'loop-simplep))
+		        (if (typep tem 'fixnum) (setq z tem)
+			    (setq z (funcall tem x) x nil)))
+		     ((member fn '(null not eq go return progn)))
+		     ((member fn '(car cdr)) (setq z 1))
+		     ((member fn '(caar cadr cdar cddr)) (setq z 2))
+		     ((member fn '(caaar caadr cadar caddr
+				   cdaar cdadr cddar cdddr))
+		        (setq z 3))
+		     ((member fn '(caaaar caaadr caadar caaddr
+				   cadaar cadadr caddar cadddr
+				   cdaaar cdaadr cdadar cdaddr
+				   cddaar cddadr cdddar cddddr))
+		        (setq z 4))
+		     ((member fn loop-simplep) (setq z 2))
+		     (t (multiple-value-bind (new-form expanded-p)
+			      (macroexpand-1 x *loop-macro-environment*)
+			  (if expanded-p
+			      (setq z (loop-simplep-1 new-form) x nil)
+			    (throw 'loop-simplep nil)))))
+	       (do ((l (cdr x) (cdr l))) ((null l))
+		 (setq z (+ (loop-simplep-1 (car l)) 1 z)))
+	       z))
+	  (t (throw 'loop-simplep nil)))))
+
+
+;;;; The iteration driver
+(defun loop-hack-iteration (entry)
+  (do ((last-entry entry)
+       (source *loop-source-code* *loop-source-code*)
+       (pre-step-tests nil)
+       (steps nil)
+       (post-step-tests nil)
+       (pseudo-steps nil)
+       (pre-loop-pre-step-tests nil)
+       (pre-loop-steps nil)
+       (pre-loop-post-step-tests nil)
+       (pre-loop-pseudo-steps nil)
+       (tem) (data) (foo) (bar))
+      (nil)
+    ; Note we collect endtests in reverse order, but steps in correct
+    ; order.  LOOP-END-TESTIFY does the nreverse for us.
+    (setq tem (setq data (apply (cadr entry) (cddr entry))))
+    (and (car tem) (push (car tem) pre-step-tests))
+    (setq steps (nconc steps (loop-copylist* (car (setq tem (cdr tem))))))
+    (and (car (setq tem (cdr tem))) (push (car tem) post-step-tests))
+    (setq pseudo-steps
+	  (nconc pseudo-steps (loop-copylist* (car (setq tem (cdr tem))))))
+    (setq tem (cdr tem))
+    (and (or *loop-conditionals* *loop-emitted-body?*)
+	 (or tem pre-step-tests post-step-tests pseudo-steps)
+	 (let ((cruft (list (car entry) (car source)
+			    (cadr source) (caddr source))))
+	    (if *loop-emitted-body?*
+		(loop-simple-error
+		   "Iteration is not allowed to follow body code" cruft)
+		(loop-simple-error
+		   "Iteration starting inside of conditional in LOOP"
+		   cruft))))
+    (or tem (setq tem data))
+    (and (car tem) (push (car tem) pre-loop-pre-step-tests))
+    (setq pre-loop-steps
+	  (nconc pre-loop-steps (loop-copylist* (car (setq tem (cdr tem))))))
+    (and (car (setq tem (cdr tem))) (push (car tem) pre-loop-post-step-tests))
+    (setq pre-loop-pseudo-steps
+	  (nconc pre-loop-pseudo-steps (loop-copylist* (cadr tem))))
+    (cond ((or (not (loop-tequal (car *loop-source-code*) 'and))
+	       (and *loop-conditionals*
+		    (not (loop-tassoc (cadr *loop-source-code*)
+					 +loop-iteration-keyword-alist+))))
+	     (setq foo (list (loop-end-testify pre-loop-pre-step-tests)
+			     (loop-make-psetq pre-loop-steps)
+			     (loop-end-testify pre-loop-post-step-tests)
+			     (loop-make-setq pre-loop-pseudo-steps))
+		   bar (list (loop-end-testify pre-step-tests)
+			     (loop-make-psetq steps)
+			     (loop-end-testify post-step-tests)
+			     (loop-make-setq pseudo-steps)))
+	     (cond ((not *loop-conditionals*)
+		      (setq *loop-before-loop* (nreconc foo *loop-before-loop*)
+			    *loop-after-body* (nreconc bar *loop-after-body*)))
+		   (t ((lambda (*loop-conditionals*)
+			  (push (loop-make-conditionalization
+				   (cons 'progn (delete nil foo)))
+				*loop-before-loop*))
+		       (mapcar #'(lambda (x)	;Copy parts that will get rplacd'ed
+				   (cons (car x)
+					 (mapcar #'(lambda (x) (loop-copylist* x)) (cdr x))))
+			       *loop-conditionals*))
+		      (push (loop-make-conditionalization
+			       (cons 'progn (delete nil bar)))
+			    *loop-after-body*)))
+	     (loop-bind-block)
+	     (return nil)))
+    (loop-pop-source) ; flush the "AND"
+    (setq entry (cond ((setq tem (loop-tassoc
+				    (car *loop-source-code*)
+				    +loop-iteration-keyword-alist+))
+		         (loop-pop-source)
+			 (setq last-entry tem))
+		      (t last-entry)))))
+
+
+;FOR variable keyword ..args..
+(defun loop-do-for ()
+  (let ((var (loop-pop-source))
+	(data-type? (loop-optional-type))
+	(keyword (loop-pop-source))
+	(first-arg nil)
+	(tem nil))
+    (setq first-arg (loop-get-form (list 'for var keyword)))
+    (or (setq tem (loop-tassoc keyword +loop-for-keyword-alist+))
+	(loop-simple-error
+	   "Unknown keyword in FOR or AS clause in LOOP"
+	   (list 'for var keyword)))
+    (apply (cadr tem) var first-arg data-type? (cddr tem))))
+
+
+(defun loop-do-repeat ()
+    (let ((var (loop-make-variable
+		  (loop-gentemp 'loop-repeat-)
+		  (loop-get-form 'repeat) 'fixnum)))
+       `((not (,(loop-typed-arith 'plusp 'fixnum) ,var))
+         () ()
+         (,var (,(loop-typed-arith '1- 'fixnum) ,var)))))
+
+
+; Kludge the First
+(defun loop-when-it-variable ()
+    (or *loop-when-it-variable*
+	(setq *loop-when-it-variable*
+	      (loop-make-variable (loop-gentemp 'loop-it-) nil nil))))
+
+
+
+(defun loop-for-equals (var val data-type?)
+  (cond ((loop-tequal (car *loop-source-code*) 'then)
+	   ;FOR var = first THEN next
+	   (loop-pop-source)
+	   (loop-make-iteration-variable var val data-type?)
+	   `(() (,var ,(loop-get-form (list 'for var '= val 'then))) () ()
+	     () () () ()))
+	(t (loop-make-iteration-variable var nil data-type?)
+	   (let ((varval (list var val)))
+	     (cond (*loop-emitted-body?*
+		    (loop-emit-body (loop-make-setq varval))
+		    '(() () () ()))
+		   (`(() ,varval () ())))))))
+
+(defun loop-for-first (var val data-type?)
+    (or (loop-tequal (car *loop-source-code*) 'then)
+	(loop-simple-error "found where THEN expected in FOR ... FIRST"
+			   (car *loop-source-code*)))
+    (loop-pop-source)
+    (loop-make-iteration-variable var nil data-type?)
+    `(() (,var ,(loop-get-form (list 'for var 'first val 'then))) () ()
+      () (,var ,val) () ()))
+
+
+(defun loop-list-stepper (var val data-type? fn)
+    (let ((stepper (cond ((loop-tequal (car *loop-source-code*) 'by)
+			    (loop-pop-source)
+			    (loop-get-form (list 'for var
+						 (if (eq fn 'car) 'in 'on)
+						 val 'by)))
+			 (t '(function cdr))))
+	  (var1 nil) (stepvar nil) (step nil) (et nil) (pseudo nil))
+       (setq step (if (or (atom stepper)
+			  (not (member (car stepper) '(quote function))))
+		      `(funcall ,(setq stepvar (loop-gentemp 'loop-fn-)))
+		      (list (cadr stepper))))
+       (cond ((and (atom var)
+		   ;; (eq (car step) 'cdr)
+		   (not fn))
+	        (setq var1 (loop-make-iteration-variable var val data-type?)))
+	     (t (loop-make-iteration-variable var nil data-type?)
+		(setq var1 (loop-make-variable
+			     (loop-gentemp 'loop-list-) val nil))
+		(setq pseudo (list var (if fn (list fn var1) var1)))))
+       (rplacd (last step) (list var1))
+       (and stepvar (loop-make-variable stepvar stepper nil))
+       (setq stepper (list var1 step) et `(null ,var1))
+       (if (not pseudo) `(() ,stepper ,et () () () ,et ())
+	   (if (eq (car step) 'cdr) `(,et ,pseudo () ,stepper)
+	       `((null (setq ,@stepper)) () () ,pseudo ,et () () ,pseudo)))))
+
+
+(defun loop-for-arithmetic (var val data-type? kwd)
+  ; Args to loop-sequencer:
+  ; indexv indexv-type variable? vtype? sequencev? sequence-type
+  ; stephack? default-top? crap prep-phrases
+  (loop-sequencer
+     var (or data-type? 'fixnum) nil nil nil nil nil nil `(for ,var ,kwd ,val)
+     (cons (list kwd val)
+	   (loop-gather-preps
+	      '(from upfrom downfrom to upto downto above below by)
+	      nil))))
+
+
+(defun loop-named-variable (name)
+    (let ((tem (loop-tassoc name *loop-named-variables*)))
+       (cond ((null tem) (loop-gentemp))
+	     (t (setq *loop-named-variables* (delete tem *loop-named-variables*))
+		(cdr tem)))))
+
+
+; Note:  path functions are allowed to use loop-make-variable, hack
+; the prologue, etc.
+(defun loop-for-being (var val data-type?)
+   ; FOR var BEING something ... - var = VAR, something = VAL.
+   ; If what passes syntactically for a pathname isn't, then
+   ; we trap to the DEFAULT-LOOP-PATH path;  the expression which looked like
+   ; a path is given as an argument to the IN preposition.  Thus,
+   ; by default, FOR var BEING EACH expr OF expr-2
+   ; ==> FOR var BEING DEFAULT-LOOP-PATH IN expr OF expr-2.
+   (let ((tem nil) (inclusive? nil) (ipps nil) (each? nil) (attachment nil))
+     (if (or (loop-tequal val 'each) (loop-tequal val 'the))
+	 (setq each? 't val (car *loop-source-code*))
+	 (push val *loop-source-code*))
+     (cond ((and (setq tem (loop-tassoc val *loop-path-keyword-alist*))
+		 (or each? (not (loop-tequal (cadr *loop-source-code*)
+						'and))))
+	      ;; FOR var BEING {each} path {prep expr}..., but NOT
+	      ;; FOR var BEING var-which-looks-like-path AND {ITS} ...
+	      (loop-pop-source))
+	   (t (setq val (loop-get-form (list 'for var 'being)))
+	      (cond ((loop-tequal (car *loop-source-code*) 'and)
+		       ;; FOR var BEING value AND ITS path-or-ar
+		       (or (null each?)
+			   (loop-simple-error
+			      "Malformed BEING EACH clause in LOOP" var))
+		       (setq ipps `((of ,val)) inclusive? t)
+		       (loop-pop-source)
+		       (or (loop-tmember (setq tem (loop-pop-source))
+					    '(its his her their each))
+			   (loop-simple-error
+			      "found where ITS or EACH expected in LOOP path"
+			      tem))
+		       (if (setq tem (loop-tassoc
+					(car *loop-source-code*)
+					*loop-path-keyword-alist*))
+			   (loop-pop-source)
+			   (push (setq attachment
+				       `(in ,(loop-get-form
+					      `(for ,var being \.\.\. in))))
+				 ipps)))
+		    ((not (setq tem (loop-tassoc
+				       (car *loop-source-code*)
+				       *loop-path-keyword-alist*)))
+		       ; FOR var BEING {each} a-r ...
+		       (setq ipps (list (setq attachment (list 'in val)))))
+		    (t ; FOR var BEING {each} pathname ...
+		       ; Here, VAL should be just PATHNAME.
+		       (loop-pop-source)))))
+     (cond ((not (null tem)))
+	   ((not (setq tem (loop-tassoc 'default-loop-path
+					   *loop-path-keyword-alist*)))
+	      (loop-simple-error "Undefined LOOP iteration path"
+				 (cadr attachment))))
+     (setq tem (funcall (cadr tem) (car tem) var data-type?
+			(nreconc ipps (loop-gather-preps (caddr tem) t))
+			inclusive? (caddr tem) (cdddr tem)))
+     (and *loop-named-variables*
+	  (loop-simple-error "unused USING variables" *loop-named-variables*))
+     ; For error continuability (if there is any):
+     (setq *loop-named-variables* nil)
+     ;; TEM is now (bindings prologue-forms . stuff-to-pass-back)
+     (do ((l (car tem) (cdr l)) (x)) ((null l))
+       (if (atom (setq x (car l)))
+	   (loop-make-iteration-variable x nil nil)
+	   (loop-make-iteration-variable (car x) (cadr x) (caddr x))))
+     (setq *loop-prologue* (nconc (reverse (cadr tem)) *loop-prologue*))
+     (cddr tem)))
+
+
+(defun loop-gather-preps (preps-allowed crockp)
+   (do ((token (car *loop-source-code*) (car *loop-source-code*)) (preps nil))
+       (nil)
+     (cond ((loop-tmember token preps-allowed)
+	      (push (list (loop-pop-source)
+			  (loop-get-form `(for \... being \... ,token)))
+		    preps))
+	   ((loop-tequal token 'using)
+	      (loop-pop-source)
+	      (or crockp (loop-simple-error
+			    "USING used in illegal context"
+			    (list 'using (car *loop-source-code*))))
+	      (do ((z (car *loop-source-code*) (car *loop-source-code*)) (tem))
+		  ((atom z))
+		(and (or (atom (cdr z))
+			 (not (null (cddr z)))
+			 (not (symbolp (car z)))
+			 (and (cadr z) (not (symbolp (cadr z)))))
+		     (loop-simple-error
+		        "bad variable pair in path USING phrase" z))
+		(cond ((not (null (cadr z)))
+		         (and (setq tem (loop-tassoc
+					   (car z) *loop-named-variables*))
+			      (loop-simple-error
+			         "Duplicated var substitition in USING phrase"
+				 (list tem z)))
+			 (push (cons (car z) (cadr z)) *loop-named-variables*)))
+		(loop-pop-source)))
+	   (t (return (nreverse preps))))))
+
+(defun loop-add-path (name data)
+    (setq *loop-path-keyword-alist*
+	  (cons (cons name data)
+		(delete (loop-tassoc name *loop-path-keyword-alist*)
+			*loop-path-keyword-alist*
+			:test #'eq)))
+    nil)
+
+
+(defmacro define-loop-path (names &rest cruft)
+  "(DEFINE-LOOP-PATH NAMES PATH-FUNCTION LIST-OF-ALLOWABLE-PREPOSITIONS
+DATUM-1 DATUM-2 ...)
+Defines PATH-FUNCTION to be the handler for the path(s) NAMES, which may
+be either a symbol or a list of symbols.  LIST-OF-ALLOWABLE-PREPOSITIONS
+contains a list of prepositions allowed in NAMES. DATUM-i are optional;
+they are passed on to PATH-FUNCTION as a list."
+  (setq names (if (atom names) (list names) names))
+  (let ((forms (mapcar #'(lambda (name) `(loop-add-path ',name ',cruft))
+		       names)))
+    `(eval-when (eval load compile) ,@forms)))
+
+
+(defun loop-sequencer (indexv indexv-type
+			  variable? vtype?
+			  sequencev? sequence-type?
+			  stephack? default-top?
+			  crap prep-phrases)
+   (let ((endform nil) (sequencep nil) (test nil)
+	 (step ; Gross me out!
+	       (1+ (or (loop-typed-init indexv-type) 0)))
+	 (dir nil) (inclusive-iteration? nil) (start-given? nil) (limit-given? nil))
+     (and variable? (loop-make-iteration-variable variable? nil vtype?))
+     (do ((l prep-phrases (cdr l)) (prep) (form) (odir)) ((null l))
+       (setq prep (caar l) form (cadar l))
+       (cond ((loop-tmember prep '(of in))
+		(and sequencep (loop-simple-error
+				  "Sequence duplicated in LOOP path"
+				  (list variable? (car l))))
+		(setq sequencep t)
+		(loop-make-variable sequencev? form sequence-type?))
+	     ((loop-tmember prep '(from downfrom upfrom))
+	        (and start-given?
+		     (loop-simple-error
+		        "Iteration start redundantly specified in LOOP sequencing"
+			(append crap l)))
+		(setq start-given? t)
+		(cond ((loop-tequal prep 'downfrom) (setq dir 'down))
+		      ((loop-tequal prep 'upfrom) (setq dir 'up)))
+		(loop-make-iteration-variable indexv form indexv-type))
+	     ((cond ((loop-tequal prep 'upto)
+		       (setq inclusive-iteration? (setq dir 'up)))
+		    ((loop-tequal prep 'to)
+		       (setq inclusive-iteration? t))
+		    ((loop-tequal prep 'downto)
+		       (setq inclusive-iteration? (setq dir 'down)))
+		    ((loop-tequal prep 'above) (setq dir 'down))
+		    ((loop-tequal prep 'below) (setq dir 'up)))
+		(and limit-given?
+		     (loop-simple-error
+		       "Endtest redundantly specified in LOOP sequencing path"
+		       (append crap l)))
+		(setq limit-given? t)
+		(setq endform (loop-maybe-bind-form form indexv-type)))
+	     ((loop-tequal prep 'by)
+		(setq step (if (loop-constantp form) form
+			       (loop-make-variable
+				 (loop-gentemp 'loop-step-by-)
+				 form 'fixnum))))
+	     (t ; This is a fatal internal error...
+	        (loop-simple-error "Illegal prep in sequence path"
+				   (append crap l))))
+       (and odir dir (not (eq dir odir))
+	    (loop-simple-error
+	       "Conflicting stepping directions in LOOP sequencing path"
+	       (append crap l)))
+       (setq odir dir))
+     (and sequencev? (not sequencep)
+	  (loop-simple-error "Missing OF phrase in sequence path" crap))
+     ; Now fill in the defaults.
+     (setq step (list indexv step))
+     (cond ((member dir '(nil up))
+	      (or start-given?
+		  (loop-make-iteration-variable indexv 0 indexv-type))
+	      (and (or limit-given?
+		       (cond (default-top?
+			        (loop-make-variable
+				  (setq endform (loop-gentemp
+						  'loop-seq-limit-))
+				  nil indexv-type)
+				(push `(setq ,endform ,default-top?)
+				      *loop-prologue*))))
+		   (setq test (if inclusive-iteration? '(> . args)
+				  '(>= . args))))
+	      (push '+ step))
+	   (t (cond ((not start-given?)
+		       (or default-top?
+			   (loop-simple-error
+			      "Don't know where to start stepping"
+			      (append crap prep-phrases)))
+		       (loop-make-iteration-variable indexv 0 indexv-type)
+		       (push `(setq ,indexv
+				    (,(loop-typed-arith '1- indexv-type)
+				     ,default-top?))
+			     *loop-prologue*)))
+	      (cond ((and default-top? (not endform))
+		       (setq endform (loop-typed-init indexv-type)
+			     inclusive-iteration? t)))
+	      (and (not (null endform))
+		   (setq test (if inclusive-iteration? '(< . args)
+				  '(<= . args))))
+	      (push '- step)))
+     (and (and (numberp (caddr step)) (= (caddr step) 1))	;Generic arith
+	  (rplacd (cdr (rplaca step (if (eq (car step) '+) '1+ '1-)))
+		  nil))
+     (rplaca step (loop-typed-arith (car step) indexv-type))
+     (setq step (list indexv step))
+     (setq test (loop-typed-arith test indexv-type))
+     (setq test (subst (list indexv endform) 'args test))
+     (and stephack? (setq stephack? `(,variable? ,stephack?)))
+     `(() ,step ,test ,stephack?
+       () () ,test ,stephack?)))
+
+
+(defun loop-sequence-elements-path (path variable data-type
+				       prep-phrases inclusive?
+				       allowed-preps data)
+    allowed-preps ; unused
+    (let ((indexv (loop-named-variable 'index))
+	  (sequencev (loop-named-variable 'sequence))
+	  (fetchfun nil) (sizefun nil) (type nil) (default-var-type nil)
+	  (crap `(for ,variable being the ,path)))
+       (cond ((not (null inclusive?))
+	        (rplacd (cddr crap) `(,(cadar prep-phrases) and its ,path))
+		(loop-simple-error "Can't step sequence inclusively" crap)))
+       (setq fetchfun (car data)
+	     sizefun (car (setq data (cdr data)))
+	     type (car (setq data (cdr data)))
+	     default-var-type (cadr data))
+       (list* nil nil ; dummy bindings and prologue
+	      (loop-sequencer
+	         indexv 'fixnum
+		 variable (or data-type default-var-type)
+		 sequencev type
+		 `(,fetchfun ,sequencev ,indexv) `(,sizefun ,sequencev)
+		 crap prep-phrases))))
+
+
+
+(defmacro define-loop-sequence-path (path-name-or-names fetchfun sizefun
+				     &optional sequence-type element-type)
+  "Defines a sequence iiteration path.  PATH-NAME-OR-NAMES is either an
+atomic path name or a list of path names.  FETCHFUN is a function of
+two arguments, the sequence and the index of the item to be fetched.
+Indexing is assumed to be zero-origined.  SIZEFUN is a function of
+one argument, the sequence; it should return the number of elements in
+the sequence.  SEQUENCE-TYPE is the name of the data-type of the
+sequence, and ELEMENT-TYPE is the name of the data-type of the elements
+of the sequence."
+    `(define-loop-path ,path-name-or-names
+	loop-sequence-elements-path
+	(of in from downfrom to downto below above by)
+	,fetchfun ,sizefun ,sequence-type ,element-type))
+
+
+;;;; Setup stuff
+
+
+(mapc #'(lambda (x)
+	  (mapc #'(lambda (y)
+		    (setq *loop-path-keyword-alist*
+			  (cons `(,y loop-sequence-elements-path
+				  (of in from downfrom to downto
+				      below above by)
+				  ,@(cdr x))
+				(delete (loop-tassoc
+					  y *loop-path-keyword-alist*)
+					*loop-path-keyword-alist*
+					:test #'eq :count 1))))
+		(car x)))
+      '( ((element elements) elt length sequence)
+	;The following should be done by using ELEMENTS and type dcls...
+	  ((vector-element 
+	    vector-elements 
+	    array-element    ;; Backwards compatibility -- DRM
+	    array-elements)
+	   aref length vector)
+	  ((simple-vector-element simple-vector-elements
+	    simple-general-vector-element simple-general-vector-elements)
+	   svref simple-vector-length simple-vector)
+	  ((bits bit bit-vector-element bit-vector-elements)
+	     bit bit-vector-length bit-vector bit)
+	  ((simple-bit-vector-element simple-bit-vector-elements)
+	     sbit simple-bit-vector-length simple-bit-vector bit)
+	  ((character characters string-element string-elements)
+	   char string-length string base-char)
+	  ((simple-string-element simple-string-elements)
+	   schar simple-string-length simple-string base-char)
+	)
+      )
diff --git a/src/lsp/mislib.lsp b/src/lsp/mislib.lsp
new file mode 100644
index 000000000..3dab60fa7
--- /dev/null
+++ b/src/lsp/mislib.lsp
@@ -0,0 +1,110 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+(defun   logical-pathname-translations (p) (si:pathname-translations p))
+(defsetf logical-pathname-translations si:pathname-translations)
+
+(defmacro time (form)
+  (let ((real-start (gentemp))
+	(real-end (gentemp))
+	(run-start (gentemp))
+	(run-end (gentemp))
+	(gc-start (gentemp))
+	(gc-end (gentemp))
+	(x (gentemp)))
+    `(let ((,real-start (get-internal-real-time))
+	   (,run-start (get-internal-run-time))
+	   #-boehm-gc(,gc-start (sys:gc-time))
+	   ,real-end ,run-end ,gc-end ,x)
+      (setq ,x (multiple-value-list ,form))
+      (setq ,run-end (get-internal-run-time))
+      (setq ,real-end (get-internal-real-time))
+      #-boehm-gc(setq ,gc-end (sys:gc-time))
+      (fresh-line *trace-output*)
+      (format *trace-output*
+       #-boehm-gc
+             "real time : ~,3F secs~%~
+              run time  : ~,3F secs~%~
+              GC time   : ~,3F secs~%"
+       #+boehm-gc
+             "real time : ~,3F secs~%~
+              run time  : ~,3F secs~%"
+       (/ (- ,real-end ,real-start) internal-time-units-per-second)
+       (/ (- ,run-end ,run-start) internal-time-units-per-second)
+       #-boehm-gc(/ (- ,gc-end ,gc-start) internal-time-units-per-second))
+      (values-list ,x))))
+
+
+(defconstant seconds-per-day #.(* 24 3600))
+
+(defun leap-year-p (y)
+  (and (zerop (mod y 4))
+       (or (not (zerop (mod y 100))) (zerop (mod y 400)))))
+
+(defun number-of-days-from-1900 (y)
+  (let ((y1 (1- y)))
+    (+ (* (- y 1900) 365)
+       (floor y1 4) (- (floor y1 100)) (floor y1 400)
+       -460)))
+
+(defconstant month-startdays #(0 31 59 90 120 151 181 212 243 273 304 334 365))
+
+(defun decode-universal-time (ut &optional tz)
+  (let (sec min hour day month year dow days dstp)
+    (unless tz
+      (setq tz (get-local-time-zone)
+	    dstp (daylight-saving-time-p ut)))
+    (decf ut (round (* (+ tz (if dstp -1 0)) 3600)))
+    (multiple-value-setq (ut sec) (floor ut 60))
+    (multiple-value-setq (ut min) (floor ut 60))
+    (multiple-value-setq (days hour) (floor ut 24))
+    (setq dow (mod days 7))
+    (setq year (+ 1900 (floor days 366))) ; Guess!
+    (do ((x))
+        ((< (setq x (- days (number-of-days-from-1900 year)))
+            (if (leap-year-p year) 366 365))
+         (setq day (1+ x)))
+      (incf year))
+    (when (leap-year-p year)
+      (when (= day 60)
+	(return-from decode-universal-time
+	  (values sec min hour 29 2 year dow dstp tz)))
+      (when (> day 60) (decf day)))
+    (setq month (position day month-startdays :test #'<=)
+	  day (- day (svref month-startdays (1- month))))
+    (values sec min hour day month year dow dstp tz)))
+
+(defun encode-universal-time (sec min h d m y &optional tz)
+  (when (<= 0 y 99)
+    ;; adjust to year in the century within 50 years of this year
+    (multiple-value-bind (sec min h d m this-year dow dstp tz)
+	(get-decoded-time)
+      (declare (ignore sec min h d m dow dstp tz))
+      (incf y (* 100 (ceiling (- this-year y 50) 100)))))
+  (when (and (leap-year-p y) (> m 2))
+    (incf d))
+  (let* ((hours (+ (* 24 (+ (number-of-days-from-1900 y)
+			    (svref month-startdays (1- m)) (1- d))) h))
+	 (dst 0))
+    (unless tz
+      (setq tz (rational (get-local-time-zone)))
+      (when (daylight-saving-time-p
+	     (+ sec (* 60 (+ min (* 60 (+ tz -1 hours))))))
+	;; assume DST applies, and check if at corresponging UT it applies.
+	;; There is an ambiguity between midnight and 1 o'clock on the day
+	;; when time reverts from DST to solar:
+	;; 12:01 on that day could be either 11:01 UT (before the switch) or
+	;; 12:01 UT (after the switch). We opt for the former.
+	(setq dst -1)))
+    (+ sec (* 60 (+ min (* 60 (+ tz dst hours)))))))
diff --git a/src/lsp/module.lsp b/src/lsp/module.lsp
new file mode 100644
index 000000000..beaff65ad
--- /dev/null
+++ b/src/lsp/module.lsp
@@ -0,0 +1,35 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;;	module routines
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+
+(defvar *modules* nil)
+
+
+(defun provide (module-name)
+  (setq *modules*
+        (adjoin (string module-name) *modules* :test #'string=)))
+
+
+(defun require (module-name
+                &optional (pathname (string-downcase (string module-name))))
+  (let ((*default-pathname-defaults* #P""))
+    (unless (member (string module-name)
+                    *modules* :test #'string=)
+      (if (atom pathname)
+	  (load pathname)
+	  (dolist (p pathname)
+	    (load p))))))
+
diff --git a/src/lsp/numlib.lsp b/src/lsp/numlib.lsp
new file mode 100644
index 000000000..af2701b3e
--- /dev/null
+++ b/src/lsp/numlib.lsp
@@ -0,0 +1,196 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;;                           number routines
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+(defconstant imag-one #C(0.0 1.0))
+
+
+(defun isqrt (i)
+       (unless (and (integerp i) (>= i 0))
+               (error "~S is not a non-negative integer." i))
+       (if (zerop i)
+           0
+           (let ((n (integer-length i)))
+                (do ((x (ash 1 (ceiling n 2)))
+                     (y))
+                    (nil)
+                    (setq y (floor i x))
+                    (when (<= x y)
+                          (return x))
+                    (setq x (floor (+ x y) 2))))))
+
+(defun abs (z)
+  (if (complexp z)
+      ;; Compute sqrt(x*x + y*y) carefully to prevent overflow.
+      ;; Assume |x| >= |y|. Then sqrt(x*x + y*y) = |x|*sqrt(1 +(y/x)^2).
+      (let* ((x (abs (realpart z)))
+	     (y (abs (imagpart z))))
+	;; Swap x and y so that |x| >= |y|.
+	(if (< x y)
+	    (rotatef x y))
+	(if (zerop x)
+	    x
+	    (let ((r (/ y x)))
+	      (* x (sqrt (+ 1 (* r r)))))))
+      (if (minusp z)
+	  (- z)
+	  z)))
+
+(defun phase (x)
+       (atan (imagpart x) (realpart x)))
+
+(defun signum (x) (if (zerop x) x (/ x (abs x))))
+
+(defun cis (x) (exp (* imag-one x)))
+
+(defun asin (x)
+  ;; (* #C(0.0 -1.0) (log (+ (* imag-one x) (sqrt (- 1.0 (* x x))))))
+  (let ((c (log (+ (* imag-one x)
+		   (sqrt (- 1.0 (* x x)))))))
+    (if (and (complexp c) (zerop (realpart c)))
+	(imagpart c)
+	(* #C(0.0 -1.0) c))))
+
+(defun acos (x)
+  ;; (* #C(0.0 -1.0) (log (+ x (* imag-one (sqrt (- 1.0 (* x x)))))))
+  (let ((c (log (+ x (* imag-one
+			(sqrt (- 1.0 (* x x))))))))
+    (if (and (complexp c) (zerop (realpart c)))
+	(imagpart c)
+	(* #C(0.0 -1.0) c))))
+
+;;; (defun sinh (x) (/ (- (exp x) (exp (- x))) 2.0))
+;;; version by Raymond Toy <toy@rtp.ericsson.se>
+#+nil
+(defun sinh (z)
+  (if (complexp z)
+      ;; For complex Z, compute the real and imaginary parts
+      ;; separately to get better precision.
+      (let ((x (realpart z))
+	    (y (imagpart z)))
+	(complex (* (sinh x) (cos y))
+		 (* (cosh x) (sin y))))
+      (let ((limit #.(expt (* double-float-epsilon 45/2) 1/5)))
+	(if (< (- limit) z limit)
+	    ;; For this region, write use the fact that sinh z =
+	    ;; z*exp(z)*[(1 - exp(-2z))/(2z)].  Then use the first
+	    ;; 4 terms in the Taylor series expansion of
+	    ;; (1-exp(-2z))/2/z.  series expansion of (1 -
+	    ;; exp(2*x)).  This is needed because there is severe
+	    ;; roundoff error calculating (1 - exp(-2z)) for z near
+	    ;; 0.
+	    (* z (exp z)
+	       (- 1 (* z
+		       (- 1 (* z
+			       (- 2/3 (* z
+					 (- 1/3 (* 2/15 z)))))))))
+	    (let ((e (exp z)))
+	      (/ (- e (/ e)) 2.0))))))
+
+;;; (defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0))
+;;; version by Raymond Toy <toy@rtp.ericsson.se>
+#+nil
+(defun cosh (z)
+  (if (complexp z)
+      ;; For complex Z, compute the real and imaginary parts
+      ;; separately to get better precision.
+      (let ((x (realpart z))
+	    (y (imagpart z)))
+	(complex (* (cosh x) (cos y))
+		 (* (sinh x) (sin y))))
+      ;; For real Z, there's no chance of round-off error, so
+      ;; direct evaluation is ok.
+      (let ((e (exp z)))
+	(/ (+ e (/ e)) 2.0))))
+
+#+nil
+(defun tanh (x) (/ (sinh x) (cosh x)))
+
+(defun asinh (x) (log (+ x (sqrt (+ 1.0 (* x x))))))
+(defun acosh (x)
+  ;; CLtL1: (log (+ x (* (1+ x) (sqrt (/ (1- x) (1+ x))))))
+  (* 2 (log (+ (sqrt (/ (1+ x) 2)) (sqrt (/ (1- x) 2))))))
+
+(defun atanh (x)
+  (/ (- (log (1+ x)) (log (- 1 x))) 2))	; CLtL2
+
+(defun rational (x)
+  (etypecase x
+    (FLOAT	  
+      (multiple-value-bind (i e s) (integer-decode-float x)
+			   (if (>= s 0)
+			       (* i (expt (float-radix x) e))
+			     (- (* i (expt (float-radix x) e))))))
+    (RATIONAL x)))
+
+
+(setf (symbol-function 'rationalize) (symbol-function 'rational))
+
+(defun ffloor (x &optional (y 1.0s0))
+       (multiple-value-bind (i r) (floor (float x) (float y))
+        (values (float i r) r)))
+
+(defun fceiling (x &optional (y 1.0s0))
+       (multiple-value-bind (i r) (ceiling (float x) (float y))
+        (values (float i r) r)))
+
+(defun ftruncate (x &optional (y 1.0s0))
+       (multiple-value-bind (i r) (truncate (float x) (float y))
+        (values (float i r) r)))
+
+(defun fround (x &optional (y 1.0s0))
+       (multiple-value-bind (i r) (round (float x) (float y))
+        (values (float i r) r)))
+
+
+(defun lognand (x y) (boole boole-nand x y))
+(defun lognor (x y) (boole boole-nor x y))
+(defun logandc1 (x y) (boole boole-andc1 x y))
+(defun logandc2 (x y) (boole boole-andc2 x y))
+(defun logorc1 (x y) (boole boole-orc1 x y))
+(defun logorc2 (x y) (boole boole-orc2 x y))
+
+(defun lognot (x) (logxor -1 x))
+(defun logtest (x y) (not (zerop (logand x y))))
+
+
+(defun byte (size position)
+  (cons size position))
+
+(defun byte-size (bytespec)
+  (car bytespec))
+
+(defun byte-position (bytespec)
+  (cdr bytespec))
+
+(defun ldb (bytespec integer)
+  (logandc2 (ash integer (- (byte-position bytespec)))
+            (- (ash 1 (byte-size bytespec)))))
+
+(defun ldb-test (bytespec integer)
+  (not (zerop (ldb bytespec integer))))
+
+(defun mask-field (bytespec integer)
+  (ash (ldb bytespec integer) (byte-position bytespec)))
+
+(defun dpb (newbyte bytespec integer)
+  (logxor integer
+          (mask-field bytespec integer)
+          (ash (logandc2 newbyte
+                         (- (ash 1 (byte-size bytespec))))
+               (byte-position bytespec))))
+
+(defun deposit-field (newbyte bytespec integer)
+  (dpb (ash newbyte (- (byte-position bytespec))) bytespec integer))
diff --git a/src/lsp/packlib.lsp b/src/lsp/packlib.lsp
new file mode 100644
index 000000000..adfc2060a
--- /dev/null
+++ b/src/lsp/packlib.lsp
@@ -0,0 +1,141 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;;                    package routines
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+(defmacro coerce-to-package (p)
+  (if (eq p '*package*)
+      p
+      (let ((g (gensym)))
+        `(let ((,g ,p))
+           (if (packagep ,g)
+               ,g
+               (find-package (string ,g)))))))
+
+(defun find-all-symbols (string-or-symbol)
+  (when (symbolp string-or-symbol)
+        (setq string-or-symbol (symbol-name string-or-symbol)))
+  (mapcan #'(lambda (p)
+              (multiple-value-bind (s i)
+                  (find-symbol string-or-symbol p)
+                (if (or (eq i :internal) (eq i :external))
+                    (list s)
+                    nil)))
+          (list-all-packages)))
+
+
+(defmacro do-symbols ((var &optional (package '*package*) (result-form nil))
+                      &rest body)
+  (let ((p (gensym)) (i (gensym))
+        (x (gensym)) (y (gensym))
+	declaration)
+    (multiple-value-setq (declaration body doc)
+      (find-declarations body nil))
+    `(let ((,p (coerce-to-package ,package)) ,var)
+       ,@declaration
+       (multiple-value-bind (,y ,x)
+	    (package-size ,p)
+            (declare (fixnum ,x ,y))
+       (dotimes (,i (the fixnum (+ ,x ,y))
+		 (progn (setq ,var nil) ,result-form))
+         (setq ,var (if (< ,i ,x)
+                      (sys:package-internal ,p ,i)
+                      (sys:package-external ,p (the fixnum (- ,i ,x)))))
+         (unless (fixnump ,var)
+	   ,@body))))))
+       
+
+(defmacro do-external-symbols
+          ((var &optional (package '*package*) (result-form nil)) &rest body)
+  (let ((p (gensym))
+	(i (gensym))
+        declaration)
+    (multiple-value-setq (declaration body)
+      (find-declarations body nil))
+    `(let ((,p (coerce-to-package ,package)) ,var)
+       
+       ,@declaration
+       (dotimes (,i (the fixnum (package-size ,p))
+		 (progn (setq ,var nil) ,result-form))
+         (setq ,var (sys:package-external ,p ,i))
+         (unless (fixnump ,var)
+	   ,@body)))))
+
+(defmacro do-all-symbols ((var &optional (result-form nil)) &rest body)
+  `(dolist (.v (list-all-packages) ,result-form)
+	   (do-symbols (,var .v)
+		       ,@ body)))
+
+
+(defun substringp (sub str)
+  (do ((i (the fixnum (- (length str) (length sub))))
+       (l (length sub))
+       (j 0 (1+ j)))
+      ((> j i) nil)
+    (declare (fixnum l j))
+    (when (string-equal sub str :start2 j :end2 (the fixnum (+ j l)))
+          (return t))))
+
+
+(defun print-symbol-apropos (symbol)
+  (prin1 symbol)
+  (when (fboundp symbol)
+        (if (special-form-p symbol)
+            (princ "  Special form")
+            (if (macro-function symbol)
+                (princ "  Macro")
+                (princ "  Function"))))
+  (when (boundp symbol)
+        (if (constantp symbol)
+            (princ "  Constant: ")
+            (princ "  has value: "))
+        (prin1 (symbol-value symbol)))
+  (terpri))
+
+
+(defun apropos (string &optional package)
+  (setq string (string string))
+  (cond (package
+         (do-symbols (symbol package)
+           (when (substringp string (string symbol))
+                 (print-symbol-apropos symbol)))
+         (do ((p (package-use-list package) (cdr p)))
+             ((null p))
+           (do-external-symbols (symbol (car p))
+             (when (substringp string (string symbol))
+                   (print-symbol-apropos symbol)))))
+        (t
+         (do-all-symbols (symbol)
+           (when (substringp string (string symbol))
+                 (print-symbol-apropos symbol)))))
+  (values))
+
+
+(defun apropos-list (string &optional package &aux list)
+  (setq list nil)
+  (setq string (string string))
+  (cond (package
+         (do-symbols (symbol package)
+           (when (substringp string (string symbol))
+                 (setq list (cons symbol list))))
+         (do ((p (package-use-list package) (cdr p)))
+             ((null p))
+           (do-symbols (symbol (car p))
+             (when (substringp string (string symbol))
+                   (setq list (cons symbol list))))))
+        (t
+         (do-all-symbols (symbol)
+           (when (substringp string (string symbol))
+                 (setq list (cons symbol list))))))
+  list)
diff --git a/src/lsp/predlib.lsp b/src/lsp/predlib.lsp
new file mode 100644
index 000000000..ff8c71918
--- /dev/null
+++ b/src/lsp/predlib.lsp
@@ -0,0 +1,566 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;;                              predicate routines
+
+
+(in-package "CL")
+(export '(DEFTYPE TYPEP SUBTYPEP COERCE))
+#+clos(export 'subclassp)
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+;;; DEFTYPE macro.
+(defmacro deftype (name lambda-list &rest body)
+  `(progn (setf (get ',name 'DEFTYPE-FORM)
+	   '(DEFTYPE ,name ,lambda-list ,@body))
+          (setf (get ',name 'DEFTYPE-DEFINITION)
+	   #'(LAMBDA ,lambda-list ,@body))
+          (setf (get ',name 'TYPE-DOCUMENTATION)
+	   ,(find-documentation body))
+          ',name))
+
+
+;;; Some DEFTYPE definitions.
+(deftype fixnum ()
+  `(INTEGER ,most-negative-fixnum ,most-positive-fixnum))
+(deftype real (&rest foo) '(OR RATIONAL FLOAT))
+(deftype bit () '(INTEGER 0 1))
+(deftype mod (n)
+  `(INTEGER 0 ,(1- n)))
+(deftype signed-byte (&optional s)
+  (if (or (null s) (eq s '*))
+      '(INTEGER * *)
+      `(INTEGER ,(- (expt 2 (1- s))) ,(1- (expt 2 (1- s))))))
+(deftype unsigned-byte (&optional s)
+  (if (or (null s) (eq s '*))
+      '(INTEGER 0 *)
+      `(INTEGER 0 ,(1- (expt 2 s)))))
+
+#+clos
+(deftype structure () 'STRUCTURE-OBJECT)
+(deftype sequence () '(OR CONS NULL (ARRAY * (*))))
+(deftype list () '(OR CONS NULL))
+(deftype atom () '(NOT CONS))
+;(deftype null () '(MEMBER NIL))
+
+(deftype vector (&optional (element-type '*) (size '*))
+  `(array ,element-type (,size)))
+(deftype string (&optional size)
+  (if size `(array character ,size) '(array character (*))))
+(deftype base-string (&optional size)
+  (if size `(array base-char ,size) '(array base-char (*))))
+(deftype bit-vector (&optional size)
+  (if size `(array bit ,size) '(array bit (*))))
+
+(deftype simple-vector (&optional size)
+  (if size `(simple-array t (,size)) '(simple-array t (*))))
+(deftype simple-string (&optional size)
+  (if size `(simple-array character (,size)) '(simple-array character (*))))
+(deftype simple-base-string (&optional size)
+  (if size `(simple-array base-char ,size) '(simple-array base-char (*))))
+(deftype simple-bit-vector (&optional size)
+  (if size `(simple-array bit (,size)) '(simple-array bit (*))))
+
+
+(defun simple-array-p (x)
+  (and (arrayp x)
+       (not (adjustable-array-p x))
+       (not (array-has-fill-pointer-p x))
+       (not (sys:displaced-array-p x))))
+
+
+(dolist (l '((NULL . NULL)
+	     (SYMBOL . SYMBOLP)
+	     (KEYWORD . KEYWORDP)
+	     (ATOM . ATOM)
+	     (CONS . CONSP)
+	     (LIST . LISTP)
+	     (NUMBER . NUMBERP)
+	     (CHARACTER . CHARACTERP)
+	     (BASE-CHAR . CHARACTERP)
+	     (PACKAGE . PACKAGEP)
+	     (STREAM . STREAMP)
+	     (PATHNAME . PATHNAMEP)
+	     (LOGICAL-PATHNAME . LOGICAL-PATHNAMEP)
+	     (READTABLE . READTABLEP)
+	     (HASH-TABLE . HASH-TABLE-P)
+	     (RANDOM-STATE . RANDOM-STATE-P)
+	     (STRUCTURE . SYS:STRUCTUREP)
+	     (FUNCTION . FUNCTIONP)
+	     (COMPILED-FUNCTION . COMPILED-FUNCTION-P)
+	     (COMMON . COMMONP)
+	     (REAL . REALP)
+	     ))
+  (setf (get (car l) 'TYPE-PREDICATE) (cdr l)))
+
+
+;;; TYPEP predicate.
+(defun typep (object type &aux tp i c)
+  (cond ((symbolp type)
+	 (let ((f (get type 'TYPE-PREDICATE)))
+	   (when f (return-from typep (funcall f object)))
+	   (setq tp type i nil)))
+	((consp type)
+	 (setq tp (car type) i (cdr type)))
+	#+clos
+	((sys:instancep type)
+	 (locally (declare (notinline find-class))
+	   (return-from typep (subclassp (class-of object) type))))
+	(t
+	 (error "typep: not a valid type specifier ~A for ~A" type object)))
+  (case tp
+    (MEMBER (and (member object i) t))
+    (NOT (not (typep object (car i))))
+    (OR (dolist (e i)
+	  (when (typep object e) (return t))))
+    (AND (dolist (e i t)
+	   (unless (typep object e) (return nil))))
+    (SATISFIES (funcall (car i) object))
+    ((T) t)
+    ((NIL) nil)
+    (FIXNUM (eq (type-of object) 'FIXNUM))
+    (BIGNUM (eq (type-of object) 'BIGNUM))
+    (RATIO (eq (type-of object) 'RATIO))
+    (STANDARD-CHAR
+     (and (characterp object) (standard-char-p object)))
+    (INTEGER
+     (and (integerp object) (in-interval-p object i)))
+    (RATIONAL
+     (and (rationalp object) (in-interval-p object i)))
+    (FLOAT
+     (and (floatp object) (in-interval-p object i)))
+    (REAL
+     (and (or (rationalp object) (floatp object)) (in-interval-p object i)))
+    ((SINGLE-FLOAT SHORT-FLOAT)
+     (and (eq (type-of object) 'SHORT-FLOAT) (in-interval-p object i)))
+    ((DOUBLE-FLOAT LONG-FLOAT)
+     (and (eq (type-of object) 'LONG-FLOAT) (in-interval-p object i)))
+    (COMPLEX
+     (and (complexp object)
+          (or (null i)
+	      (and (typep (realpart object) (car i))
+		   ;;wfs--should only have to check one.
+		   ;;Illegal to mix real and imaginary types!
+		   (typep (imagpart object) (car i))))
+	   ))
+    (SEQUENCE (or (listp object) (vectorp object)))
+    (STRING
+     (and (stringp object)
+          (or (null i) (match-dimensions (array-dimensions object) i))))
+    (BIT-VECTOR
+     (and (bit-vector-p object)
+          (or (null i) (match-dimensions (array-dimensions object) i))))
+    (SIMPLE-STRING
+     (and (simple-string-p object)
+          (or (null i) (match-dimensions (array-dimensions object) i))))
+    (SIMPLE-BIT-VECTOR
+     (and (simple-bit-vector-p object)
+          (or (null i) (match-dimensions (array-dimensions object) i))))
+    (SIMPLE-VECTOR
+     (and (simple-vector-p object)
+          (or (null i) (match-dimensions (array-dimensions object) i))))
+    (SIMPLE-ARRAY
+     (and (simple-array-p object)
+          (or (endp i) (eq (car i) '*)
+	      ;; (car i) needs expansion
+	      (eq (array-element-type object)
+		  (type-for-array (car i))))
+          (or (endp (cdr i)) (eq (second i) '*)
+              (match-dimensions (array-dimensions object) (second i)))))
+    (ARRAY
+     (and (arrayp object)
+          (or (endp i) (eq (car i) '*)
+              ;; Or the element type of object should be EQUAL to (car i).
+              ;; Is this too strict?
+              (eq (array-element-type object)
+		  (type-for-array (car i))))
+          (or (endp (cdr i)) (eq (second i) '*)
+              (match-dimensions (array-dimensions object) (second i)))))
+    (t
+     (cond
+           ((get tp 'DEFTYPE-DEFINITION)
+            (typep object
+                   (apply (get tp 'DEFTYPE-DEFINITION) i)))
+           #+clos
+	   ((setq c (find-class type nil))
+	    ;; Follow the inheritance chain
+	    (locally (declare (notinline find-class))
+	      (and (sys:instancep object)
+		   (subclassp (sys:instance-class object) c))))
+	   #-clos
+	   ((get tp 'IS-A-STRUCTURE)
+            (when (sys:structurep object)
+	      ;; Follow the chain of structure-include.
+	      (do ((stp (sys:structure-name object)
+			(get stp 'STRUCTURE-INCLUDE)))
+		  ((eq tp stp) t)
+		(when (null (get stp 'STRUCTURE-INCLUDE))
+		  (return nil)))))
+	   (t (error "typep: not a valid type specifier ~A for ~A" type object))))))
+
+#+clos
+(defun subclassp (low high)
+  (or (eq low high)
+      (dolist (class (sys:instance-ref low 1)) ; (class-superiors low)
+	(when (subclassp class high) (return t)))))
+
+;;; NORMALIZE-TYPE normalizes the type using the DEFTYPE definitions.
+;;; The result is a pair of values
+;;;  VALUE-1 = normalized type name or object
+;;;  VALUE-2 = normalized type arguments or nil
+(defun normalize-type (type &aux tp i fd)
+  ;; Loops until the car of type has no DEFTYPE definition.
+  (cond ((symbolp type)
+	 (if (setq fd (get type 'DEFTYPE-DEFINITION))
+	   (normalize-type (funcall fd))
+	   (values type nil)))
+	#+clos
+	((clos::classp type) (values type nil))
+	((atom type)
+	 (error "normalize-type: bogus type specifier ~A" type))
+	((progn
+	   (setq tp (car type) i (cdr type))
+	   (setq fd (get tp 'DEFTYPE-DEFINITION)))
+	 (normalize-type (apply fd i)))
+	((and (eq tp 'INTEGER) (consp (cadr i)))
+	 (values tp (list (car i) (1- (caadr i)))))
+	(t (values tp i))))
+
+;;; KNOWN-TYPE-P answers if the given type is a known base type.
+;;; The type MUST be normalized.
+(defun known-type-p (type)
+  (cond #+clos
+	((sys::instancep type) t)
+	((not (symbolp type)) nil)
+	((or (member type
+                  '(T NIL NULL SYMBOL KEYWORD CONS LIST
+                    NUMBER INTEGER BIGNUM RATIONAL RATIO FLOAT
+                    SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT COMPLEX
+                    CHARACTER BASE-CHAR STANDARD-CHAR EXTENDED-CHAR
+                    PACKAGE STREAM PATHNAME READTABLE HASH-TABLE RANDOM-STATE
+                    #-clos STRUCTURE ARRAY SIMPLE-ARRAY FUNCTION COMPILED-FUNCTION
+		    REAL))
+	     #+clos
+	     (locally (declare (notinline find-class))
+	       (find-class type nil))
+	     #-clos
+	     (get type 'IS-A-STRUCTURE))
+	 t)
+	(t nil)))
+
+;;; Dummy version before CLOS is loaded
+#+clos
+(unless (fboundp 'sys::fpp)
+  (defun find-class (n &optional err env) (declare (ignore n err env)) nil))
+#+clos
+(proclaim '(NOTINLINE FIND-CLASS))
+
+;;; SUBTYPEP predicate.
+(defun subtypep (type1 type2 &aux t1 t2 i1 i2 ntp1 ntp2 c1 c2)
+    (multiple-value-setq (t1 i1) (normalize-type type1))
+    (multiple-value-setq (t2 i2) (normalize-type type2))
+    (when (and (equal t1 t2) (equal i1 i2))
+      (return-from subtypep (values t t)))
+    (case t1
+      (MEMBER (dolist (e i1)
+		(unless (typep e type2) (return-from subtypep (values nil t))))
+	      (return-from subtypep (values t t)))
+      (OR (dolist (tt i1)
+	    (multiple-value-bind (tv flag) (subtypep tt type2)
+	      (unless tv (return-from subtypep (values tv flag)))))
+	  (return-from subtypep (values t t)))
+      (AND (dolist (tt i1)
+	     (let ((tv (subtypep tt type2)))
+	       (when tv (return-from subtypep (values t t)))))
+	   (return-from subtypep (values nil nil)))
+      (NOT (multiple-value-bind (tv flag) (subtypep (car i1) type2)
+	     (return-from subtypep (values (and flag (not tv)) flag)))))
+    (case t2
+      (MEMBER (return-from subtypep (values nil nil)))
+      (OR (dolist (tt i2)
+	    (let ((tv (subtypep type1 tt)))
+	      (when tv (return-from subtypep (values t t)))))
+	  (return-from subtypep (values nil nil)))
+      (AND (dolist (tt i2)
+	     (multiple-value-bind (tv flag) (subtypep type1 tt)
+	       (unless tv (return-from subtypep (values tv flag)))))
+	   (return-from subtypep (values t t)))
+      (NOT (multiple-value-bind (tv flag) (subtypep type1 (car i2))
+	     (return-from subtypep (values (not tv) flag)))))
+    (setq ntp1 (known-type-p t1) ntp2 (known-type-p t2))
+    (flet ((find-the-class (x)
+	     #-clos nil
+	     #+clos
+	     ;; these are the build-in classes of CLOS:
+	     (cond ((sys::instancep x) x)
+		   ((member x '(ARRAY CONS STRING
+				BIT-VECTOR CHARACTER NUMBER COMPLEX FLOAT
+				RATIONAL INTEGER RATIO SYMBOL KEYWORD)
+			    :test #'eq)
+		    nil)
+		   ((symbolp x) (find-class x nil))
+		   (t nil))))
+      (cond ((or (eq t1 'NIL) (eq t2 'T) (eq t2 'COMMON)) (values t t))
+	    ((eq t2 'NIL) (values nil ntp1))
+	    ((eq t1 'T) (values nil ntp2))
+	    ((eq t1 'COMMON) (values nil ntp2))
+	    ((eq t2 'SYMBOL)
+	     (if (member t1 '(SYMBOL KEYWORD NULL) :test #'eq)
+		 (values t t)
+		 (values nil ntp1)))
+	    ((eq t2 'KEYWORD)
+	     (if (eq t1 'KEYWORD) (values t t) (values nil ntp1)))
+	    ((eq t2 'NULL)
+	     (if (eq t1 'NULL) (values t t) (values nil ntp1)))
+	    ((eq t2 'NUMBER)
+	     (cond ((member t1 '(BIGNUM INTEGER RATIO RATIONAL FLOAT
+				 SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT
+				 LONG-FLOAT COMPLEX NUMBER
+				 REAL)
+			    :test #'eq)
+		    (values t t))
+		   (t (values nil ntp1))))
+	    ((eq t1 'NUMBER) (values nil ntp2))
+	    #-clos
+	    ((eq t2 'STRUCTURE)
+	     (if (or (eq t1 'STRUCTURE)
+		     (get t1 'IS-A-STRUCTURE))
+		 (values t t)
+		 (values nil ntp1)))
+	    #-clos
+	    ((eq t1 'STRUCTURE) (values nil ntp2))
+	    #-clos
+	    ((get t1 'IS-A-STRUCTURE)
+	     (if (get t2 'IS-A-STRUCTURE)
+		 (do ((tp1 t1 (get tp1 'STRUCTURE-INCLUDE)) (tp2 t2))
+		     ((null tp1) (values nil t))
+		   (when (eq tp1 tp2) (return (values t t))))
+		 (values nil ntp2)))
+	    #-clos
+	    ((get t2 'IS-A-STRUCTURE) (values nil ntp1))
+	    #+clos
+	    ((setq c1 (find-the-class t1))
+	     (if (setq c2 (find-the-class t2))
+		 (values (subclassp c1 c2) t)
+		 (values nil ntp1)))
+	    #+clos
+	    ((find-the-class t2) (values nil ntp1))
+	    (t
+	     (case t1
+	       (BIGNUM
+		(case t2
+		  (bignum (values t t))
+		  ((integer rational)
+		   (if (sub-interval-p '(* *) i2)
+		       (values t t)
+		       (values nil t)))
+		  (t (values nil ntp2))))
+	       (RATIO
+		(case t2
+		  (ratio (values t t))
+		  (rational
+		   (if (sub-interval-p '(* *) i2) (values t t) (values nil t)))
+		  (t (values nil ntp2))))
+	       (STANDARD-CHAR
+		(if (member t2 '(STANDARD-CHAR BASE-CHAR CHARACTER)
+			    :test #'eq)
+		    (values t t)
+		    (values nil ntp2)))
+	       (BASE-CHAR
+		(if (member t2 '(BASE-CHAR CHARACTER) :test #'eq)
+		    (values t t)
+		    (values nil ntp2)))
+	       (EXTENDED-CHAR
+		(if (eq t2 'CHARACTER)
+		    (values t t)
+		    (values nil ntp2)))
+	       (INTEGER
+		(if (member t2 '(INTEGER RATIONAL) :test #'eq)
+		    (values (sub-interval-p i1 i2) t)
+		    (values nil ntp2)))
+	       (RATIONAL
+		(if (eq t2 'RATIONAL)
+		    (values (sub-interval-p i1 i2) t)
+		    (values nil ntp2)))
+	       (FLOAT
+		(if (eq t2 'FLOAT)
+		    (values (sub-interval-p i1 i2) t)
+		    (values nil ntp2)))
+	       ((SINGLE-FLOAT SHORT-FLOAT)
+		(if (member t2 '(SHORT-FLOAT FLOAT) :test #'eq)
+		    (values (sub-interval-p i1 i2) t)
+		    (values nil ntp2)))
+	       ((DOUBLE-FLOAT LONG-FLOAT)
+		(if (member t2 '(SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT FLOAT)
+			    :test #'eq)
+		    (values (sub-interval-p i1 i2) t)
+		    (values nil ntp2)))
+	       (COMPLEX
+		(if (eq t2 'COMPLEX)
+		    (subtypep (or (car i1) t) (or (car i2) t))
+		    (values nil ntp2)))
+	       (LOGICAL-PATHNAME
+		(if (eq t2 'PATHNAME)
+		    (values t t)
+		    (values nil ntp2)))
+	       (SIMPLE-ARRAY
+		(cond ((or (eq t2 'SIMPLE-ARRAY) (eq t2 'ARRAY))
+		       (if (or (endp i1) (eq (car i1) '*))
+			   (unless (or (endp i2) (eq (car i2) '*))
+			     (return-from subtypep (values nil t)))
+			   (unless (or (endp i2) (eq (car i2) '*))
+			     (unless (eq (type-for-array (car i1))
+					 (type-for-array (car i2)))
+			       ;; Unless the element type matches,
+			       ;;  return NIL T.
+			       ;; Is this too strict?
+			       (return-from subtypep
+				 (values nil t)))))
+		       (when (or (endp (cdr i1)) (eq (second i1) '*))
+			 (if (or (endp (cdr i2)) (eq (second i2) '*))
+			     (return-from subtypep (values t t))
+			     (return-from subtypep (values nil t))))
+		       (when (or (endp (cdr i2)) (eq (second i2) '*))
+			 (return-from subtypep (values t t)))
+		       (values (match-dimensions (second i1) (second i2)) t))
+		      (t (values nil ntp2))))
+	       (ARRAY
+		(cond ((eq t2 'ARRAY)
+		       (if (or (endp i1) (eq (car i1) '*))
+			   (unless (or (endp i2) (eq (car i2) '*))
+			     (return-from subtypep (values nil t)))
+			   (unless (or (endp i2) (eq (car i2) '*))
+			     (unless (eq (type-for-array (car i1))
+					 (type-for-array (car i2)))
+			       (return-from subtypep
+				 (values nil t)))))
+		       (when (or (endp (cdr i1)) (eq (second i1) '*))
+			 (if (or (endp (cdr i2)) (eq (second i2) '*))
+			     (return-from subtypep (values t t))
+			     (return-from subtypep (values nil t))))
+		       (when (or (endp (cdr i2)) (eq (second i2) '*))
+			 (return-from subtypep (values t t)))
+		       (values (match-dimensions (second i1) (second i2)) t))
+		      (t (values nil ntp2))))
+	       (t (if ntp1 (values (eq t1 t2) t) (values nil nil))))))))
+
+
+(defun sub-interval-p (i1 i2)
+  (let (low1 high1 low2 high2)
+    (if (endp i1)
+        (setq low1 '* high1 '*)
+        (if (endp (cdr i1))
+            (setq low1 (car i1) high1 '*)
+            (setq low1 (car i1) high1 (second i1))))
+    (if (endp i2)
+        (setq low2 '* high2 '*)
+        (if (endp (cdr i2))
+            (setq low2 (car i2) high2 '*)
+            (setq low2 (car i2) high2 (second i2))))
+    (cond ((eq low1 '*)
+	   (unless (eq low2 '*)
+	           (return-from sub-interval-p nil)))
+          ((eq low2 '*))
+	  ((consp low1)
+	   (if (consp low2)
+	       (when (< (car low1) (car low2))
+		     (return-from sub-interval-p nil))
+	       (when (< (car low1) low2)
+		     (return-from sub-interval-p nil))))
+	  ((if (consp low2)
+	       (when (<= low1 (car low2))
+		     (return-from sub-interval-p nil))
+	       (when (< low1 low2)
+		     (return-from sub-interval-p nil)))))
+    (cond ((eq high1 '*)
+	   (unless (eq high2 '*)
+	           (return-from sub-interval-p nil)))
+          ((eq high2 '*))
+	  ((consp high1)
+	   (if (consp high2)
+	       (when (> (car high1) (car high2))
+		     (return-from sub-interval-p nil))
+	       (when (> (car high1) high2)
+		     (return-from sub-interval-p nil))))
+	  ((if (consp high2)
+	       (when (>= high1 (car high2))
+		     (return-from sub-interval-p nil))
+	       (when (> high1 high2)
+		     (return-from sub-interval-p nil)))))
+    (return-from sub-interval-p t)))
+
+(defun in-interval-p (x interval)
+  (let (low high)
+    (if (endp interval)
+        (setq low '* high '*)
+        (if (endp (cdr interval))
+            (setq low (car interval) high '*)
+            (setq low (car interval) high (second interval))))
+    (cond ((eq low '*))
+          ((consp low)
+           (when (<= x (car low)) (return-from in-interval-p nil)))
+          ((when (< x low) (return-from in-interval-p nil))))
+    (cond ((eq high '*))
+          ((consp high)
+           (when (>= x (car high)) (return-from in-interval-p nil)))
+          ((when (> x high) (return-from in-interval-p nil))))
+    (return-from in-interval-p t)))
+
+(defun match-dimensions (dim pat)
+  (if (null dim)
+      (null pat)
+      (and (or (eq (car pat) '*)
+	       (eq (car dim) (car pat)))
+	   (match-dimensions (cdr dim) (cdr pat)))))
+
+
+
+;;; COERCE function.
+(defun coerce (object type &aux name args)
+  (when (typep object type)
+        ;; Just return as it is.
+        (return-from coerce object))
+  (when (eq type 'LIST)
+     (do ((l nil (cons (elt object i) l))
+          (i (1- (length object)) (1- i)))
+         ((< i 0) (return-from coerce l))
+       (declare (fixnum i))))
+  (multiple-value-setq (name args) (normalize-type type))
+  (case name
+    (FUNCTION
+     (coerce-to-function object))
+    ((ARRAY SIMPLE-ARRAY)
+     (unless (or (endp args)
+                 (endp (cdr args))
+                 (atom (cadr args))
+                 (endp (cdadr args)))
+             (error "Cannot coerce to a multi-dimensional array."))
+     (do* ((l (length object))
+	   (seq (make-sequence type l))
+	   (i 0 (1+ i)))
+	  ((>= i l) seq)
+       (declare (fixnum i l))
+       (setf (elt seq i) (coerce (elt object i)
+				 (if (eq (car args) '*)
+				     'T
+				     (car args))))))
+    ((CHARACTER BASE-CHAR) (character object))
+    (FLOAT (float object))
+    ((SINGLE-FLOAT SHORT-FLOAT) (float object 0.0S0))
+    ((DOUBLE-FLOAT LONG-FLOAT) (float object 0.0L0))
+    (COMPLEX
+     (if (or (null args) (null (car args)) (eq (car args) '*))
+         (complex (realpart object) (imagpart object))
+         (complex (coerce (realpart object) (car args))
+                  (coerce (imagpart object) (car args)))))
+    (t (error "Cannot coerce ~S to ~S." object type))))
diff --git a/src/lsp/proclaim.lsp b/src/lsp/proclaim.lsp
new file mode 100644
index 000000000..5cfc8913b
--- /dev/null
+++ b/src/lsp/proclaim.lsp
@@ -0,0 +1,145 @@
+(in-package "SYSTEM")
+(proclaim '(FUNCTION DEFMACRO* (T T T) T))
+(proclaim '(FUNCTION DM-VL (T T T) T))
+(proclaim '(FUNCTION DM-V (T T) T))
+(proclaim '(FUNCTION DM-NTH (T T) T))
+(proclaim '(FUNCTION DM-NTH-CDR (T T) T))
+(proclaim '(FUNCTION DM-BAD-KEY (T) T))
+(proclaim '(FUNCTION DM-KEY-NOT-ALLOWED (T) T))
+;(proclaim '(FUNCTION FIND-DOC (T T) T))
+;(proclaim '(FUNCTION FIND-DECLARATIONS (T) T))
+(proclaim '(FUNCTION CLEAR-COMPILER-PROPERTIES (T) T))
+(proclaim '(FUNCTION TERMINAL-INTERRUPT (T) T))
+(proclaim '(FUNCTION BREAK-LEVEL (T T) T))
+(proclaim '(FUNCTION TPL-MAKE-COMMAND (T T) T))
+(proclaim '(FUNCTION TPL-PARSE-STRINGS (T) T))
+(proclaim '(FUNCTION TPL-PRINT (T) T))
+(proclaim '(FUNCTION TPL-UNKNOWN-COMMAND (T) T))
+(proclaim '(FUNCTION TPL-GO (T) T))
+(proclaim '(FUNCTION PRINT-IHS (T) T))
+(proclaim '(FUNCTION PRINT-FRS (T) T))
+(proclaim '(FUNCTION FRS-KIND (T) T))
+(proclaim '(FUNCTION TPL-HIDE (T) T))
+(proclaim '(FUNCTION TPL-UNHIDE (T) T))
+(proclaim '(FUNCTION TPL-UNHIDE-PACKAGE (T) T))
+(proclaim '(FUNCTION TPL-HIDE-PACKAGE (T) T))
+(proclaim '(FUNCTION IHS-VISIBLE (T) T))
+(proclaim '(FUNCTION IHS-FNAME (T) T))
+(proclaim '(FUNCTION IHS-COMPILED-P (T) T))
+(proclaim '(FUNCTION SUPER-GO (T T) T))
+(proclaim '(FUNCTION TPL-BACKWARD-SEARCH (T) T))
+(proclaim '(FUNCTION TPL-FORWARD-SEARCH (T) T))
+(proclaim '(FUNCTION PROVIDE (T) T))
+(proclaim '(FUNCTION DOCUMENTATION (T T) T))
+(proclaim '(FUNCTION FIND-DOCUMENTATION (T) T))
+(proclaim '(FUNCTION SIMPLE-ARRAY-P (T) T))
+(proclaim '(FUNCTION TYPEP (T T) T))
+(proclaim '(FUNCTION SUBCLASSP (T T) T))
+(proclaim '(FUNCTION NORMALIZE-TYPE (T) T))
+(proclaim '(FUNCTION KNOWN-TYPE-P (T) T))
+(proclaim '(FUNCTION SUBTYPEP (T T) T))
+(proclaim '(FUNCTION SUB-INTERVAL-P (T T) T))
+(proclaim '(FUNCTION IN-INTERVAL-P (T T) T))
+(proclaim '(FUNCTION MATCH-DIMENSIONS (T T) T))
+(proclaim '(FUNCTION COERCE (T T) T))
+(proclaim '(FUNCTION CLEAR-COMPILER-PROPERTIES (T) T))
+(proclaim '(FUNCTION GET-SETF-METHOD (T) T))
+(proclaim '(FUNCTION GET-SETF-METHOD-MULTIPLE-VALUE (T) T))
+(proclaim '(FUNCTION SETF-EXPAND-1 (T T T) T))
+(proclaim '(FUNCTION SETF-EXPAND (T T) T))
+(proclaim '(FUNCTION INCREMENT-CURSOR (T T) T))
+(proclaim '(FUNCTION SEQUENCE-CURSOR (T T) T))
+(proclaim '(FUNCTION ARRAY-DIMENSIONS (T) T))
+(proclaim '(FUNCTION VECTOR-PUSH (T T) T))
+(proclaim '(FUNCTION VECTOR-POP (T) T))
+(proclaim '(FUNCTION ASK-FOR-FORM (T) T))
+(proclaim '(FUNCTION TYPECASE-ERROR-STRING (T T T) T))
+(proclaim '(FUNCTION TYPECASE-ERROR-STRINGS (T) T))
+(proclaim '(FUNCTION BOIN-P (T) T))
+(proclaim '(FUNCTION MAKE-ACCESS-FUNCTION (T T T T T T T T T) T))
+(proclaim '(FUNCTION MAKE-CONSTRUCTOR (T T T T T) T))
+(proclaim '(FUNCTION MAKE-COPIER (T T T T) T))
+(proclaim '(FUNCTION MAKE-PREDICATE (T T T T T) T))
+(proclaim '(FUNCTION PARSE-SLOT-DESCRIPTION (T T) T))
+(proclaim '(FUNCTION OVERWRITE-SLOT-DESCRIPTIONS (T T) T))
+(proclaim '(FUNCTION SHARP-S-READER (T T T) T))
+(proclaim '(FUNCTION READ-INSPECT-COMMAND (T T T) T))
+(proclaim '(FUNCTION INSPECT-SYMBOL (T) T))
+(proclaim '(FUNCTION INSPECT-PACKAGE (T) T))
+(proclaim '(FUNCTION INSPECT-CHARACTER (T) T))
+(proclaim '(FUNCTION INSPECT-NUMBER (T) T))
+(proclaim '(FUNCTION INSPECT-CONS (T) T))
+(proclaim '(FUNCTION INSPECT-STRING (T) T))
+(proclaim '(FUNCTION INSPECT-VECTOR (T) T))
+(proclaim '(FUNCTION INSPECT-ARRAY (T) T))
+(proclaim '(FUNCTION INSPECT-OBJECT (T) T))
+(proclaim '(FUNCTION DESCRIBE (T) T))
+(proclaim '(FUNCTION INSPECT (T) T))
+(proclaim '(FUNCTION ARG-LIST (T) T))
+(proclaim '(FUNCTION PRIN1-TO-STRING (T) T))
+(proclaim '(FUNCTION PRINC-TO-STRING (T) T))
+(proclaim '(FUNCTION SHARP-A-READER (T T T) T))
+(proclaim '(FUNCTION SHARP-S-READER-SI (T T T) T))
+(proclaim '(FUNCTION LEAP-YEAR-P (T) T))
+(proclaim '(FUNCTION NUMBER-OF-DAYS-FROM-1900 (T) T))
+(proclaim '(FUNCTION ISQRT (T) T))
+(proclaim '(FUNCTION ABS (T) T))
+(proclaim '(FUNCTION PHASE (T) T))
+(proclaim '(FUNCTION SIGNUM (T) T))
+(proclaim '(FUNCTION CIS (T) T))
+(proclaim '(FUNCTION ASIN (T) T))
+(proclaim '(FUNCTION ACOS (T) T))
+(proclaim '(FUNCTION SINH (T) T))
+(proclaim '(FUNCTION COSH (T) T))
+(proclaim '(FUNCTION TANH (T) T))
+(proclaim '(FUNCTION ASINH (T) T))
+(proclaim '(FUNCTION ACOSH (T) T))
+(proclaim '(FUNCTION ATANH (T) T))
+(proclaim '(FUNCTION RATIONAL (T) T))
+(proclaim '(FUNCTION RATIONALIZE (T) T))
+(proclaim '(FUNCTION RATIONALIZE-FLOAT (T T) T))
+(proclaim '(FUNCTION LOGNAND (T T) T))
+(proclaim '(FUNCTION LOGNOR (T T) T))
+(proclaim '(FUNCTION LOGANDC1 (T T) T))
+(proclaim '(FUNCTION LOGANDC2 (T T) T))
+(proclaim '(FUNCTION LOGORC1 (T T) T))
+(proclaim '(FUNCTION LOGORC2 (T T) T))
+(proclaim '(FUNCTION LOGNOT (T) T))
+(proclaim '(FUNCTION LOGTEST (T T) T))
+(proclaim '(FUNCTION BYTE (T T) T))
+(proclaim '(FUNCTION BYTE-SIZE (T) T))
+(proclaim '(FUNCTION BYTE-POSITION (T) T))
+(proclaim '(FUNCTION LDB (T T) T))
+(proclaim '(FUNCTION LDB-TEST (T T) T))
+(proclaim '(FUNCTION MASK-FIELD (T T) T))
+(proclaim '(FUNCTION DPB (T T T) T))
+(proclaim '(FUNCTION DEPOSIT-FIELD (T T T) T))
+(proclaim '(FUNCTION FIND-ALL-SYMBOLS (T) T))
+(proclaim '(FUNCTION SUBSTRINGP (T T) T))
+(proclaim '(FUNCTION PRINT-SYMBOL-APROPOS (T) T))
+(proclaim '(FUNCTION SEQTYPE (T) T))
+(proclaim '(FUNCTION CALL-TEST (T T T T) T))
+(proclaim '(FUNCTION CHECK-SEQ-TEST (T T) T))
+(proclaim '(FUNCTION CHECK-SEQ-START-END (T T) T))
+(proclaim '(FUNCTION CHECK-SEQ-ARGS (T T T T) T))
+(proclaim '(FUNCTION LIST-MERGE-SORT (T T T) T))
+(proclaim '(FUNCTION QUICK-SORT (T FIXNUM FIXNUM T T) T))
+(proclaim '(FUNCTION TRACE* (T) T))
+(proclaim '(FUNCTION UNTRACE* (T) T))
+(proclaim '(FUNCTION TRACE-ONE (T) T))
+(proclaim '(FUNCTION UNTRACE-ONE (T) T))
+(proclaim '(FUNCTION TRACING-BODY (T) T))
+(proclaim '(FUNCTION STEP* (T) T))
+(proclaim '(FUNCTION LOOP-TEQUAL (T T) T))
+(proclaim '(FUNCTION LOOP-TMEMBER (T T) T))
+(proclaim '(FUNCTION LOOP-TASSOC (T T) T))
+(proclaim '(FUNCTION LOOP-NAMED-VARIABLE (T) T))
+(proclaim '(FUNCTION PARSE-TYPE (T) T))
+(proclaim '(FUNCTION LV-BIND (T T T) T))
+(proclaim '(FUNCTION LV-SET (T) T))
+(proclaim '(FUNCTION MERGE-INF (T T) T))
+(proclaim '(FUNCTION SET-ITERATION (T) T))
+(proclaim '(FUNCTION PARSE-FOR1 (T T T T T T) T))
+(proclaim '(FUNCTION PARSE-LOOP-PATH (T) T))
+(proclaim '(FUNCTION GET-ACC (T) T))
+(proclaim '(FUNCTION PARSE-WHEN (T) T))
diff --git a/src/lsp/seq.lsp b/src/lsp/seq.lsp
new file mode 100644
index 000000000..5316a55ad
--- /dev/null
+++ b/src/lsp/seq.lsp
@@ -0,0 +1,126 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;;                           sequence routines
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+(defun make-sequence (type size	&key (initial-element nil iesp)
+                                &aux element-type sequence)
+  (setq element-type
+        (cond ((eq type 'LIST)
+               (return-from make-sequence
+                (if iesp
+                    (make-list size :initial-element initial-element)
+                    (make-list size))))
+              ((or (eq type 'SIMPLE-STRING) (eq type 'STRING)) 'BASE-CHAR)
+              ((or (eq type 'SIMPLE-BIT-VECTOR) (eq type 'BIT-VECTOR)) 'BIT)
+              ((or (eq type 'SIMPLE-VECTOR) (eq type 'VECTOR)) t)
+              (t
+	       (multiple-value-bind (name args)
+		   (normalize-type type)
+		 (when (eq name 'LIST)
+		   (return-from make-sequence
+                      (if iesp
+                          (make-list size :initial-element initial-element)
+                          (make-list size))))
+		 (unless (or (eq name 'ARRAY)
+			     (eq name 'SIMPLE-ARRAY))
+                       (error "~S is not a sequence type." type))
+		 (or (car args) t)))))
+  (setq sequence (sys:make-vector element-type size nil nil nil nil))
+  (when iesp
+        (do ((i 0 (1+ i))
+             (size size))
+            ((>= i size))
+          (declare (fixnum i size))
+          (setf (elt sequence i) initial-element)))
+  sequence)
+
+
+(defun concatenate (result-type &rest sequences)
+  (do ((x (make-sequence result-type
+			 (apply #'+ (mapcar #'length sequences))))
+       (s sequences (cdr s))
+       (i 0))
+      ((null s) x)
+    (declare (fixnum i))
+    (do ((j 0 (1+ j))
+         (n (length (car s))))
+        ((>= j n))
+      (declare (fixnum j n))
+      (setf (elt x i) (elt (car s) j))
+      (incf i))))
+
+
+(defun map (result-type function sequence &rest more-sequences)
+  (setq more-sequences (cons sequence more-sequences))
+  (let ((l (apply #'min (mapcar #'length more-sequences))))
+    (if (null result-type)
+        (do ((i 0 (1+ i))
+             (l l))
+            ((>= i l) nil)
+          (declare (fixnum i l))
+          (apply function (mapcar #'(lambda (z) (elt z i))
+                                  more-sequences)))
+        (let ((x (make-sequence result-type l)))
+          (do ((i 0 (1+ i))
+               (l l))
+              ((>= i l) x)
+            (declare (fixnum i l))
+            (setf (elt x i)
+                  (apply function (mapcar #'(lambda (z) (elt z i))
+                                          more-sequences))))))))
+
+
+(defun some (predicate sequence &rest more-sequences)
+  (setq more-sequences (cons sequence more-sequences))
+  (do ((i 0 (1+ i))
+       (l (apply #'min (mapcar #'length more-sequences))))
+      ((>= i l) nil)
+    (declare (fixnum i l))
+    (let ((that-value
+           (apply predicate
+                  (mapcar #'(lambda (z) (elt z i)) more-sequences))))
+      (when that-value (return that-value)))))
+
+
+(defun every (predicate sequence &rest more-sequences)
+  (setq more-sequences (cons sequence more-sequences))
+  (do ((i 0 (1+ i))
+       (l (apply #'min (mapcar #'length more-sequences))))
+      ((>= i l) t)
+    (declare (fixnum i l))
+    (unless (apply predicate (mapcar #'(lambda (z) (elt z i)) more-sequences))
+            (return nil))))
+
+
+(defun notany (predicate sequence &rest more-sequences)
+  (not (apply #'some predicate sequence more-sequences)))
+
+
+(defun notevery (predicate sequence &rest more-sequences)
+  (not (apply #'every predicate sequence more-sequences)))
+
+(defun map-into (result-sequence function &rest sequences)
+  (let ((nel (apply #'min (if (eq 'vector (type-of result-sequence))
+			      (array-dimension result-sequence 0)
+			    (length result-sequence))
+		    (mapcar #'length sequences))))
+    ;; Set the fill pointer to the number of iterations
+    (when (and (eq 'vector (type-of result-sequence))
+		(array-has-fill-pointer-p result-sequence))
+      (setf (fill-pointer result-sequence) nel))
+    ;; Perform mapping
+    (dotimes (k nel result-sequence)
+      (setf (elt result-sequence k)
+	    (apply function (mapcar #'(lambda (v) (elt v k)) sequences))))))
diff --git a/src/lsp/seqlib.lsp b/src/lsp/seqlib.lsp
new file mode 100644
index 000000000..6048c9053
--- /dev/null
+++ b/src/lsp/seqlib.lsp
@@ -0,0 +1,671 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;;                           sequence routines
+
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+(declaim (function seqtype (t) t))
+(defun seqtype (sequence)
+  (cond ((listp sequence) 'list)
+        ((stringp sequence) 'string)
+        ((bit-vector-p sequence) 'bit-vector)
+        ((vectorp sequence) (list 'array (array-element-type sequence)))
+        (t (error "~S is not a sequence." sequence))))
+
+(declaim (function call-test (t t t t) t))
+(defun call-test (test test-not item keyx)
+  (cond (test (funcall test item keyx))
+        (test-not (not (funcall test-not item keyx)))
+        (t (eql item keyx))))
+
+(declaim (function test-error() t))
+(defun test-error()
+  (error "both test and test are supplied"))
+
+(defun bad-seq-limit (x &optional y)
+  (error "bad sequence limit ~a" (if y (list x y) x)))
+
+(eval-when (compile eval)
+  (defmacro with-start-end (start end seq &body body)
+    `(let ((,start (if ,start (the-start ,start) 0))
+	   (,end (the-end ,end ,seq))) 
+	(declare (fixnum ,start ,end))
+	(unless (<= ,start ,end) (bad-seq-limit ,start ,end))
+	,@ body))
+  )
+
+(defun the-end (x y)
+  (cond ((fixnump x)
+	 (unless (<= (the fixnum x) (the fixnum (length y)))
+	   (bad-seq-limit x))
+	 x)
+	((null x)
+	 (length y))
+	(t (bad-seq-limit x))))
+
+(defun the-start (x)
+  (cond ((fixnump x)
+	 (unless (>= (the fixnum x) 0)
+	     (bad-seq-limit x))
+	 (the fixnum x))
+	((null x) 0)
+	(t (bad-seq-limit x))))
+
+(defun reduce (function sequence
+               &key from-end
+                    start 
+                    end
+                    (initial-value nil ivsp)
+		    (key #'identity))
+  (with-start-end start end sequence
+     (cond ((not from-end)
+	    (when (null ivsp)
+                  (when (>= start end)
+                        (return-from reduce (funcall function)))
+                  (setq initial-value (funcall key (elt sequence start)))
+		  (incf start))
+	    (do ((x initial-value
+		    (funcall function x
+			     (prog1 (funcall key (elt sequence start))
+				    (incf start)))))
+		((>= start end) x)))
+          (t
+           (when (null ivsp)
+                 (when (>= start end)
+                       (return-from reduce (funcall function)))
+                 (decf end)
+                 (setq initial-value (elt sequence end)))
+           (do ((x initial-value (funcall function
+					  (funcall key (elt sequence end))
+					  x)))
+               ((>= start end) x)
+	     (decf end))))))
+
+(defun fill (sequence item &key start end)
+  (with-start-end start end sequence
+		  (do ((i start (1+ i)))
+		      ((>= i end) sequence)
+		     (declare (fixnum i))
+		     (setf (elt sequence i) item))))
+
+(defun replace (sequence1 sequence2
+	        &key start1  end1
+		     start2 end2 )
+  (with-start-end start1 end1 sequence1
+     (with-start-end start2 end2 sequence2		  
+    (if (and (eq sequence1 sequence2)
+             (> start1 start2))
+        (do* ((i 0 (1+ i))
+              (l (if (< (the fixnum (- end1 start1))
+			(the fixnum (- end2 start2)))
+                      (- end1 start1)
+                      (- end2 start2)))
+              (s1 (+ start1 (the fixnum (1- l))) (the fixnum (1- s1)))
+              (s2 (+ start2 (the fixnum (1- l))) (the fixnum (1- s2))))
+            ((>= i l) sequence1)
+          (declare (fixnum i l s1 s2))
+          (setf (elt sequence1 s1) (elt sequence2 s2)))
+        (do ((i 0 (1+ i))
+             (l (if (< (the fixnum (- end1 start1))
+		       (the fixnum (- end2 start2)))
+                    (- end1 start1)
+                    (- end2 start2)))
+             (s1 start1 (1+ s1))
+             (s2 start2 (1+ s2)))
+            ((>= i l) sequence1)
+          (declare (fixnum i l s1 s2))
+          (setf (elt sequence1 s1) (elt sequence2 s2)))))))
+
+
+;;; DEFSEQ macro.
+;;; Usage:
+;;;
+;;;    (DEFSEQ function-name argument-list countp everywherep variantsp body)
+;;;
+;;; The arguments ITEM and SEQUENCE (PREDICATE and SEQUENCE)
+;;;  and the keyword arguments are automatically supplied.
+;;; If the function has the :COUNT argument, set COUNTP T.
+;;; If VARIANTSP is NIL, the variants -IF and -IF-NOT are not generated. 
+
+(eval-when (eval compile)
+(defmacro defseq (f args countp everywherep variantsp normal-form &optional from-end-form)
+  `(macrolet
+      ((do-defseq (f args countp everywherep)
+	 (let* (from-end-form
+		normal-form
+		(i-in-range '(and (<= start i) (< i end)))
+		(x '(elt sequence i))
+		(keyx `(funcall key ,x))
+		(satisfies-the-test `(call-test test test-not item ,keyx))
+		(number-satisfied
+		 `(n (internal-count item sequence
+		      :from-end from-end
+		      :test test :test-not test-not
+		      :start start :end end
+		      ,@(if countp '(:count count))
+		      :key key)))
+		(within-count '(< k count))
+		(kount-0 '(k 0))
+		(kount-up '(setq k (1+  k))))
+	   (let ((iterate-i '(i start (1+ i)))
+		 (endp-i '(>= i end))
+		 (iterate-i-everywhere '(i 0 (1+ i)))
+		 (endp-i-everywhere '(>= i l)))
+	     (setq normal-form ,normal-form))
+	   (let ((iterate-i '(i (1- end) (1- i)))
+		 (endp-i '(< i start))
+		 (iterate-i-everywhere '(i (1- l) (1- i)))
+		 (endp-i-everywhere '(< i 0)))
+	     (setq from-end-form ,(or from-end-form normal-form)))
+           `(defun ,f (,@args item sequence
+                       &key from-end test test-not
+		       start end
+		       ,@(if countp '(count))
+		       (key #'identity)
+                       ,@(if everywherep
+                             (list '&aux '(l (length sequence)))
+                             nil))
+	     ,@(if everywherep '((declare (fixnum l))))
+	     (with-start-end start end sequence
+			     (let ,@(if countp
+					'(((count (if (null count)
+						      most-positive-fixnum count)))))	       
+				  ,@(if countp '((declare (fixnum count))))
+				  nil
+				  (and test test-not (test-error))
+				  (if from-end ,from-end-form ,normal-form)))))))
+    (do-defseq ,f ,args ,countp ,everywherep)
+    ,@(if variantsp
+	   `((defun ,(intern (si:string-concatenate (string f) "-IF")
+			     (symbol-package f))
+		 (,@args predicate sequence
+			 &key from-end
+			 start end
+			 ,@(if countp '(count))
+			 (key #'identity))
+	       (,f ,@args predicate sequence
+		   :from-end from-end
+		   :test #'funcall
+		   :start start :end end
+		   ,@(if countp '(:count count))
+		   :key key))
+	     (defun ,(intern (si:string-concatenate (string f) "-IF-NOT")
+			     (symbol-package f))
+		 (,@args predicate sequence
+			 &key from-end start end
+			 ,@(if countp '(count))
+			 (key #'identity))
+	       (,f ,@args predicate sequence
+		   :from-end from-end
+		   :test-not #'funcall
+		   :start start :end end
+		   ,@(if countp '(:count count))
+		   :key key))
+	     ',f)
+	   `(',f)))))
+) ; eval-when
+
+
+(defseq remove () t nil t
+      ;; Ordinary run
+      `(if (listp sequence)
+           (let ((l sequence) (l1 nil))
+             (do ((i 0 (1+ i)))
+                 ((>= i start))
+               (declare (fixnum i))
+               (push (car l) l1)
+               (pop l))
+             (do ((i start (1+ i)) (j 0))
+                 ((or (>= i end) (>= j count) (endp l))
+                  (nreconc l1 l))
+               (declare (fixnum i j))
+               (if (call-test test test-not item (funcall key (car l)))
+		   (incf j)
+		   (push (car l) l1))
+	       (pop l)))
+           (delete item sequence
+                   :from-end from-end
+                   :test test :test-not test-not
+                   :start start :end end
+                   :count count
+                   :key key))
+      ;; From end run
+      `(delete item sequence
+               :from-end from-end
+               :test test :test-not test-not
+               :start start :end end
+               :count count
+               :key key))
+
+
+(defseq delete () t t t
+      ;; Ordinary run
+      `(if (listp sequence)
+           (let* ((l0 (cons nil sequence)) (l l0))
+             (do ((i 0 (1+ i)))
+                 ((>= i start))
+               (declare (fixnum i))
+               (pop l))
+             (do ((i start (1+ i)) (j 0))
+                 ((or (>= i end) (>= j count) (endp (cdr l))) (cdr l0))
+               (declare (fixnum i j))
+               (cond ((call-test test test-not item (funcall key (cadr l)))
+                      (incf j)
+                      (rplacd l (cddr l)))
+                     (t (setq l (cdr l))))))
+           (let (,number-satisfied)
+             (declare (fixnum n))
+             (when (< n count) (setq count n))
+             (do ((newseq
+                   (make-sequence (seqtype sequence)
+                                  (the fixnum (- l count))))
+                  ,iterate-i-everywhere
+                  (j 0)
+                  ,kount-0)
+                 (,endp-i-everywhere newseq)
+               (declare (fixnum i j k))
+               (cond ((and ,i-in-range ,within-count ,satisfies-the-test)
+                      ,kount-up)
+                     (t (setf (elt newseq j) ,x)
+                        (incf j))))))
+      ;; From end run
+      `(let (,number-satisfied)
+         (declare (fixnum n))
+         (when (< n count) (setq count n))
+         (do ((newseq
+               (make-sequence (seqtype sequence) (the fixnum (- l count))))
+              ,iterate-i-everywhere
+              (j (- (the fixnum (1- end)) n))
+              ,kount-0)
+             (,endp-i-everywhere newseq)
+           (declare (fixnum i j k))
+           (cond ((and ,i-in-range ,within-count ,satisfies-the-test)
+                  ,kount-up)
+                 (t (setf (elt newseq j) ,x)
+                    (decf j))))))
+
+(defseq count () nil nil t
+  ;; Both runs
+  `(do (,iterate-i ,kount-0)
+       (,endp-i k)
+     (declare (fixnum i k))
+     (when (and ,satisfies-the-test)
+           ,kount-up)))
+
+
+(defseq internal-count () t nil nil
+  ;; Both runs
+  `(do (,iterate-i ,kount-0)
+       (,endp-i k)
+     (declare (fixnum i k))
+     (when (and ,within-count ,satisfies-the-test)
+           ,kount-up)))
+
+
+(defseq substitute (newitem) t t t
+  ;; Both runs
+  `(do ((newseq (make-sequence (seqtype sequence) l))
+        ,iterate-i-everywhere
+        ,kount-0)
+       (,endp-i-everywhere newseq)
+     (declare (fixnum i k))
+     (cond ((and ,i-in-range ,within-count ,satisfies-the-test)
+            (setf (elt newseq i) newitem)
+            ,kount-up)
+           (t (setf (elt newseq i) ,x)))))
+
+
+(defseq nsubstitute (newitem) t nil t
+  ;; Both runs
+  `(do (,iterate-i ,kount-0)
+       (,endp-i sequence)
+     (declare (fixnum i k))
+     (when (and ,within-count ,satisfies-the-test)
+           (setf ,x newitem)
+           ,kount-up)))
+
+
+(defseq find () nil nil t
+  ;; Both runs
+  `(do (,iterate-i)
+       (,endp-i nil)
+     (declare (fixnum i))
+     (when ,satisfies-the-test (return ,x))))
+
+
+(defseq position () nil nil t
+  ;; Both runs
+  `(do (,iterate-i)
+       (,endp-i nil)
+     (declare (fixnum i))
+     (when ,satisfies-the-test (return i))))
+
+
+(defun remove-duplicates (sequence
+                          &key from-end
+                               test test-not
+			       start end
+                               (key #'identity))
+  (and test test-not (test-error))
+  (when (and (listp sequence) (not from-end) (null start) (null end))
+        (when (endp sequence) (return-from remove-duplicates nil))
+        (do ((l sequence (cdr l)) (l1 nil))
+            ((endp (cdr l))
+             (return-from remove-duplicates (nreconc l1 l)))
+          (unless (member1 (car l) (cdr l)
+                           :test test :test-not test-not
+                           :key key)
+                  (setq l1 (cons (car l) l1)))))
+  (delete-duplicates sequence
+                     :from-end from-end
+                     :test test :test-not test-not
+                     :start start :end end
+                     :key key))
+       
+
+(defun delete-duplicates (sequence
+                          &key from-end
+                               test test-not
+                               start
+                               end 
+                               (key #'identity)
+                          &aux (l (length sequence)))
+  (declare (fixnum l))
+  (and test test-not (test-error))
+  (when (and (listp sequence) (not from-end) (null start) (null end))
+        (when (endp sequence) (return-from delete-duplicates nil))
+        (do ((l sequence))
+            ((endp (cdr l))
+             (return-from delete-duplicates sequence))
+            (cond ((member1 (car l) (cdr l)
+                            :test test :test-not test-not
+                            :key key)
+                   (rplaca l (cadr l))
+                   (rplacd l (cddr l)))
+                  (t (setq l (cdr l))))))
+  (with-start-end start end sequence
+    (if (not from-end)
+        (do ((n 0)
+             (i start (1+ i)))
+            ((>= i end)
+             (do ((newseq (make-sequence (seqtype sequence)
+                                         (the fixnum (- l n))))
+                  (i 0 (1+ i))
+                  (j 0))
+                 ((>= i l) newseq)
+               (declare (fixnum i j))
+               (cond ((and (<= start i)
+                           (< i end)
+                           (position (funcall key (elt sequence i))
+                                     sequence
+                                     :test test
+                                     :test-not test-not
+                                     :start (the fixnum (1+ i))
+                                     :end end
+                                     :key key)))
+                     (t
+                      (setf (elt newseq j) (elt sequence i))
+                      (incf j)))))
+          (declare (fixnum n i))
+          (when (position (funcall key (elt sequence i))
+                          sequence
+                          :test test
+                          :test-not test-not
+                          :start (the fixnum (1+ i))
+                          :end end
+                          :key key)
+                (incf n)))
+        (do ((n 0)
+             (i (1- end) (1- i)))
+            ((< i start)
+             (do ((newseq (make-sequence (seqtype sequence)
+                                         (the fixnum (- l n))))
+                  (i (1- l) (1- i))
+                  (j (- (the fixnum (1- l)) n)))
+                 ((< i 0) newseq)
+               (declare (fixnum i j))
+               (cond ((and (<= start i)
+                           (< i end)
+                           (position (funcall key (elt sequence i))
+                                     sequence
+                                     :from-end t
+                                     :test test
+                                     :test-not test-not
+                                     :start start
+                                     :end i
+                                     :key key)))
+                     (t
+                      (setf (elt newseq j) (elt sequence i))
+                      (decf j)))))
+          (declare (fixnum n i))
+          (when (position (funcall key (elt sequence i))
+                          sequence
+                          :from-end t
+                          :test test
+                          :test-not test-not
+                          :start start
+                          :end i
+                          :key key)
+                (incf n))))))
+       
+
+(defun mismatch (sequence1 sequence2
+		 &key from-end test test-not
+		      (key #'identity)
+		      start1 start2
+		      end1 end2)
+  (and test test-not (test-error))
+  (with-start-end start1 end1 sequence1
+   (with-start-end start2 end2 sequence2
+    (if (not from-end)
+        (do ((i1 start1 (1+ i1))
+             (i2 start2 (1+ i2)))
+            ((or (>= i1 end1) (>= i2 end2))
+             (if (and (>= i1 end1) (>= i2 end2)) nil i1))
+          (declare (fixnum i1 i2))
+          (unless (call-test test test-not
+                             (funcall key (elt sequence1 i1))
+                             (funcall key (elt sequence2 i2)))
+                  (return i1)))
+        (do ((i1 (1- end1) (1- i1))
+             (i2 (1- end2)  (1- i2)))
+            ((or (< i1 start1) (< i2 start2))
+             (if (and (< i1 start1) (< i2 start2)) nil (1+ i1)))
+          (declare (fixnum i1 i2))
+          (unless (call-test test test-not
+                             (funcall key (elt sequence1 i1))
+                             (funcall key (elt sequence2 i2)))
+                  (return (1+ i1))))))))
+
+
+(defun search (sequence1 sequence2
+               &key from-end test test-not 
+                    (key #'identity)
+		    start1 start2
+		    end1 end2)
+  (and test test-not (test-error))
+  (with-start-end start1 end1 sequence1
+   (with-start-end start2 end2 sequence2  
+    (if (not from-end)
+        (loop
+         (do ((i1 start1 (1+ i1))
+              (i2 start2 (1+ i2)))
+             ((>= i1 end1) (return-from search start2))
+           (declare (fixnum i1 i2))
+           (when (>= i2 end2) (return-from search nil))
+           (unless (call-test test test-not
+                              (funcall key (elt sequence1 i1))
+                              (funcall key (elt sequence2 i2)))
+                   (return nil)))
+         (incf start2))
+        (loop
+         (do ((i1 (1- end1) (1- i1))
+              (i2 (1- end2) (1- i2)))
+             ((< i1 start1) (return-from search (the fixnum (1+ i2))))
+           (declare (fixnum i1 i2))
+           (when (< i2 start2) (return-from search nil))
+           (unless (call-test test test-not
+                              (funcall key (elt sequence1 i1))
+                              (funcall key (elt sequence2 i2)))
+                   (return nil)))
+         (decf end2))))))
+
+
+(defun sort (sequence predicate &key (key #'identity))
+  (if (listp sequence)
+      (list-merge-sort sequence predicate key)
+      (quick-sort sequence 0 (the fixnum (length sequence)) predicate key)))
+
+
+(defun list-merge-sort (l predicate key)
+  (labels
+   ((sort (l)
+      (prog ((i 0) left right l0 l1 key-left key-right)
+        (declare (fixnum i))
+        (setq i (length l))
+        (cond ((< i 2) (return l))
+              ((= i 2)
+               (setq key-left (funcall key (car l)))
+               (setq key-right (funcall key (cadr l)))
+               (cond ((funcall predicate key-left key-right) (return l))
+                     ((funcall predicate key-right key-left)
+                      (return (nreverse l)))
+                     (t (return l)))))
+        (setq i (floor i 2))
+        (do ((j 1 (1+ j)) (l1 l (cdr l1)))
+            ((>= j i)
+             (setq left l)
+             (setq right (cdr l1))
+             (rplacd l1 nil))
+          (declare (fixnum j)))
+        (setq left (sort left))
+        (setq right (sort right))
+        (cond ((endp left) (return right))
+              ((endp right) (return left)))
+        (setq l0 (cons nil nil))
+        (setq l1 l0)
+        (setq key-left (funcall key (car left)))
+        (setq key-right (funcall key (car right)))
+      loop
+        (cond ((funcall predicate key-left key-right) (go left))
+              ((funcall predicate key-right key-left) (go right))
+              (t (go left)))
+      left
+        (rplacd l1 left)
+        (setq l1 (cdr l1))
+        (setq left (cdr left))
+        (when (endp left)
+              (rplacd l1 right)
+              (return (cdr l0)))
+        (setq key-left (funcall key (car left)))
+        (go loop)
+      right
+        (rplacd l1 right)
+        (setq l1 (cdr l1))
+        (setq right (cdr right))
+        (when (endp right)
+              (rplacd l1 left)
+              (return (cdr l0)))
+        (setq key-right (funcall key (car right)))
+        (go loop))))
+   (sort l)))
+
+
+(declaim (function quick-sort (t fixnum fixnum t t) t))
+
+(defun quick-sort (seq start end pred key)
+       (declare (fixnum start end))
+  (if (<= end (the fixnum (1+ start)))
+      seq
+      (let* ((j start) (k end) (d (elt seq start)) (kd (funcall key d)))
+            (declare (fixnum j k))
+        (block outer-loop
+          (loop (loop (decf k)
+                      (unless (< j k) (return-from outer-loop))
+                      (when (funcall pred (funcall key (elt seq k)) kd)
+                            (return)))
+                (loop (incf j)
+                      (unless (< j k) (return-from outer-loop))
+                      (unless (funcall pred (funcall key (elt seq j)) kd)
+                              (return)))
+                (let ((temp (elt seq j)))
+                  (setf (elt seq j) (elt seq k)
+                        (elt seq k) temp))))
+        (setf (elt seq start) (elt seq j)
+              (elt seq j) d)
+        (quick-sort seq start j pred key)
+        (quick-sort seq (1+ j) end pred key))))
+
+
+(defun stable-sort (sequence predicate &key (key #'identity))
+  (if (listp sequence)
+      (list-merge-sort sequence predicate key)
+      (if (or (stringp sequence) (bit-vector-p sequence))
+          (sort sequence predicate :key key)
+          (coerce (list-merge-sort (coerce sequence 'list)
+                                   predicate
+                                   key)
+                  (seqtype sequence)))))
+
+
+(defun merge (result-type sequence1 sequence2 predicate
+	      &key (key #'identity)
+	      &aux (l1 (length sequence1)) (l2 (length sequence2)))
+  (declare (fixnum l1 l2))
+  (do ((newseq (make-sequence result-type (the fixnum (+ l1 l2))))
+       (j 0 (1+ j))
+       (i1 0)
+       (i2 0))
+      ((and (= i1 l1) (= i2 l2)) newseq)
+    (declare (fixnum j i1 i2))
+    (cond ((and (< i1 l1) (< i2 l2))
+	   (cond ((funcall predicate
+			   (funcall key (elt sequence1 i1))
+			   (funcall key (elt sequence2 i2)))
+		  (setf (elt newseq j) (elt sequence1 i1))
+		  (incf i1))
+		 ((funcall predicate
+			   (funcall key (elt sequence2 i2))
+			   (funcall key (elt sequence1 i1)))
+		  (setf (elt newseq j) (elt sequence2 i2))
+		  (incf i2))
+		 (t
+		  (setf (elt newseq j) (elt sequence1 i1))
+		  (incf i1))))
+          ((< i1 l1)
+	   (setf (elt newseq j) (elt sequence1 i1))
+	   (incf i1))
+	  (t
+	   (setf (elt newseq j) (elt sequence2 i2))
+	   (incf i2)))))
+
+(defun map-into (result-sequence function &rest sequences)
+  (let ((nel (apply #'min (if (eq 'VECTOR (type-of result-sequence))
+			      (array-dimension result-sequence 0)
+			      (length result-sequence))
+		    (mapcar #'length sequences))))
+    ;; Set the fill pointer to the number of iterations
+    (when (and (eq 'VECTOR (type-of result-sequence))
+	       (array-has-fill-pointer-p result-sequence))
+      (setf (fill-pointer result-sequence) nel))
+    ;; Perform mapping
+    (dotimes (k nel result-sequence)
+      (setf (elt result-sequence k)
+	    (apply function (mapcar #'(lambda (v) (elt v k)) sequences))))))
+
+(defun complement (f)
+  #'(lambda (&rest x) (not (apply f x))))
+
+(defun constantly (n)
+  #'(lambda (&rest x) n))
diff --git a/src/lsp/setf.lsp b/src/lsp/setf.lsp
new file mode 100644
index 000000000..8a6d95f8d
--- /dev/null
+++ b/src/lsp/setf.lsp
@@ -0,0 +1,592 @@
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+;;;;                                setf routines
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+(eval-when (eval compile) (defun sys::clear-compiler-properties (symbol)))
+(eval-when (eval compile) (setq sys:*inhibit-macro-special* nil))
+
+;;; DEFSETF macro.
+(defmacro defsetf (access-fn &rest rest)
+  (cond ((and (car rest) (or (symbolp (car rest)) (functionp (car rest))))
+         `(eval-when (compile load eval)
+		 (sys:putprop ',access-fn ',(car rest) 'SETF-UPDATE-FN)
+                 (remprop ',access-fn 'SETF-LAMBDA)
+                 (remprop ',access-fn 'SETF-METHOD)
+                 (sys:putprop ',access-fn
+                             ,(when (not (endp (cdr rest)))
+                                    (unless (stringp (cadr rest))
+                                            (error "A doc-string expected."))
+                                    (unless (endp (cddr rest))
+                                            (error "Extra arguments."))
+                                    (cadr rest))
+                             'SETF-DOCUMENTATION)
+                 ',access-fn))
+	(t
+	 (unless (= (list-length (cadr rest)) 1)
+		 (error "(store-variable) expected."))
+	 (setq rest `(lambda ,(car rest) #'(lambda ,(cadr rest) ,@(cddr rest))))
+         `(eval-when (compile load eval)
+		 (sys:putprop ',access-fn #',rest 'SETF-LAMBDA)
+                 (remprop ',access-fn 'SETF-UPDATE-FN)
+                 (remprop ',access-fn 'SETF-METHOD)
+                 (sys:putprop ',access-fn
+                             ,(find-documentation (cddr rest))
+                             'SETF-DOCUMENTATION)
+                 ',access-fn))))
+
+
+;;; DEFINE-SETF-METHOD macro.
+(defmacro define-setf-method (access-fn args &rest body)
+  (let ((env (member '&environment args :test #'eq)))
+    (if env
+	(setq args (cons (second env)
+			 (nconc (ldiff args env) (cddr env))))
+	(progn
+	  (setq env (gensym))
+	  (setq args (cons env args))
+	  (push `(declare (ignore ,env)) body))))
+  `(eval-when (compile load eval)
+	  (sys:putprop ',access-fn #'(lambda ,args ,@body) 'SETF-METHOD)
+          (remprop ',access-fn 'SETF-LAMBDA)
+          (remprop ',access-fn 'SETF-UPDATE-FN)
+          (sys:putprop ',access-fn
+                      ,(find-documentation body)
+                      'SETF-DOCUMENTATION)
+          ',access-fn))
+
+
+;;; GET-SETF-METHOD.
+;;; It just calls GET-SETF-METHOD-MULTIPLE-VALUE
+;;;  and checks the number of the store variable.
+(defun get-setf-method (form &optional env)
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method-multiple-value form env)
+    (unless (= (list-length stores) 1)
+	    (error "Multiple store-variables are not allowed."))
+    (values vars vals stores store-form access-form)))
+
+
+;;;; GET-SETF-METHOD-MULTIPLE-VALUE.
+
+(defun get-setf-method-multiple-value (form &optional env &aux tem)
+  (cond ((symbolp form)
+	 (let ((store (gensym)))
+	   (values nil nil (list store) `(setq ,form ,store) form)))
+	((or (not (consp form)) (not (symbolp (car form))))
+	 (error "Cannot get the setf-method of ~S." form))
+	((and env (setq tem (assoc (car form) (cdr env))))
+	 (setq tem (macroexpand form env))
+	 (when (eq form tem)
+	   (error "Cannot get setf-method for ~a" form))
+	 (return-from get-setf-method-multiple-value
+		      (get-setf-method-multiple-value tem env)))
+	((get (car form) 'SETF-METHOD)
+	 (apply (get (car form) 'SETF-METHOD) env (cdr form)))
+	((or (get (car form) 'SETF-UPDATE-FN)
+	     (setq tem (get (car form) 'STRUCTURE-ACCESS)))
+	 (let ((vars (mapcar #'(lambda (x)
+	                         (declare (ignore x))
+	                         (gensym))
+	                     (cdr form)))
+	       (store (gensym)))
+	   (values vars (cdr form) (list store)
+		   (if tem
+		       (setf-structure-access (car vars) (car tem)
+					      (cdr tem) store)
+		       `(,(get (car form) 'SETF-UPDATE-FN)
+			 ,@vars ,store))
+		   (cons (car form) vars))))
+	((get (car form) 'SETF-LAMBDA)
+	 (let* ((vars (mapcar #'(lambda (x)
+	                          (declare (ignore x))
+	                          (gensym))
+	                      (cdr form)))
+		(store (gensym))
+		(f (get (car form) 'SETF-LAMBDA)))
+	   (values vars (cdr form) (list store)
+		   (funcall (apply f vars) store)
+		   (cons (car form) vars))))
+	((macro-function (car form))
+	 (get-setf-method-multiple-value (macroexpand form)))
+	#+clos
+        ((special-form-p (car form))
+	 (error "Cannot expand the SETF form ~S." form))
+	#+clos
+	((get (car form) 'SETF-SYMBOL)
+	 (let ((vars (mapcar #'(lambda (x)
+	                         (declare (ignore x))
+	                         (gensym))
+	                     (cdr form)))
+	       (store (gensym)))
+	   (values vars (cdr form) (list store)
+		   ;; use the symbol here, otherwise the CLOS walker punts.
+	           `(funcall #',(get (car form) 'SETF-SYMBOL) ,store ,@vars)
+		   (cons (car form) vars))))
+	(t
+	 (error "Cannot expand the SETF form ~S." form))))
+
+
+;;;; SETF definitions.
+
+(defsetf car (x) (y) `(progn (rplaca ,x ,y) ,y))
+(defsetf cdr (x) (y) `(progn (rplacd ,x ,y), y))
+(defsetf caar (x) (y) `(progn (rplaca (car ,x) ,y) ,y))
+(defsetf cdar (x) (y) `(progn (rplacd (car ,x) ,y) ,y))
+(defsetf cadr (x) (y) `(progn (rplaca (cdr ,x) ,y) ,y))
+(defsetf cddr (x) (y) `(progn (rplacd (cdr ,x) ,y) ,y))
+(defsetf caaar (x) (y) `(progn (rplaca (caar ,x) ,y) ,y))
+(defsetf cdaar (x) (y) `(progn (rplacd (caar ,x) ,y) ,y))
+(defsetf cadar (x) (y) `(progn (rplaca (cdar ,x) ,y) ,y))
+(defsetf cddar (x) (y) `(progn (rplacd (cdar ,x) ,y) ,y))
+(defsetf caadr (x) (y) `(progn (rplaca (cadr ,x) ,y) ,y))
+(defsetf cdadr (x) (y) `(progn (rplacd (cadr ,x) ,y) ,y))
+(defsetf caddr (x) (y) `(progn (rplaca (cddr ,x) ,y) ,y))
+(defsetf cdddr (x) (y) `(progn (rplacd (cddr ,x) ,y) ,y))
+(defsetf caaaar (x) (y) `(progn (rplaca (caaar ,x) ,y) ,y))
+(defsetf cdaaar (x) (y) `(progn (rplacd (caaar ,x) ,y) ,y))
+(defsetf cadaar (x) (y) `(progn (rplaca (cdaar ,x) ,y) ,y))
+(defsetf cddaar (x) (y) `(progn (rplacd (cdaar ,x) ,y) ,y))
+(defsetf caadar (x) (y) `(progn (rplaca (cadar ,x) ,y) ,y))
+(defsetf cdadar (x) (y) `(progn (rplacd (cadar ,x) ,y) ,y))
+(defsetf caddar (x) (y) `(progn (rplaca (cddar ,x) ,y) ,y))
+(defsetf cdddar (x) (y) `(progn (rplacd (cddar ,x) ,y) ,y))
+(defsetf caaadr (x) (y) `(progn (rplaca (caadr ,x) ,y) ,y))
+(defsetf cdaadr (x) (y) `(progn (rplacd (caadr ,x) ,y) ,y))
+(defsetf cadadr (x) (y) `(progn (rplaca (cdadr ,x) ,y) ,y))
+(defsetf cddadr (x) (y) `(progn (rplacd (cdadr ,x) ,y) ,y))
+(defsetf caaddr (x) (y) `(progn (rplaca (caddr ,x) ,y) ,y))
+(defsetf cdaddr (x) (y) `(progn (rplacd (caddr ,x) ,y) ,y))
+(defsetf cadddr (x) (y) `(progn (rplaca (cdddr ,x) ,y) ,y))
+(defsetf cddddr (x) (y) `(progn (rplacd (cdddr ,x) ,y) ,y))
+(defsetf first (x) (y) `(progn (rplaca ,x ,y) ,y))
+(defsetf second (x) (y) `(progn (rplaca (cdr ,x) ,y) ,y))
+(defsetf third (x) (y) `(progn (rplaca (cddr ,x) ,y) ,y))
+(defsetf fourth (x) (y) `(progn (rplaca (cdddr ,x) ,y) ,y))
+(defsetf fifth (x) (y) `(progn (rplaca (cddddr ,x) ,y) ,y))
+(defsetf sixth (x) (y) `(progn (rplaca (nthcdr 5 ,x) ,y) ,y))
+(defsetf seventh (x) (y) `(progn (rplaca (nthcdr 6 ,x) ,y) ,y))
+(defsetf eighth (x) (y) `(progn (rplaca (nthcdr 7 ,x) ,y) ,y))
+(defsetf ninth (x) (y) `(progn (rplaca (nthcdr 8 ,x) ,y) ,y))
+(defsetf tenth (x) (y) `(progn (rplaca (nthcdr 9 ,x) ,y) ,y))
+(defsetf rest (x) (y) `(progn (rplacd ,x ,y) ,y))
+(defsetf svref sys:svset)
+(defsetf elt sys:elt-set)
+(defsetf symbol-value set)
+(defsetf symbol-function sys:fset)
+(defsetf macro-function (s) (v) `(sys:fset ,s ,v t))
+(defsetf aref (a &rest il) (v) `(sys:aset ,v ,a ,@il))
+(defsetf get (s p &optional d) (v)
+  (if d `(progn ,d (sys:putprop ,s ,v ,p)) `(sys:putprop ,s ,v ,p)))
+(defsetf nth (n l) (v) `(progn (rplaca (nthcdr ,n ,l) ,v) ,v))
+(defsetf char sys:char-set)
+(defsetf schar sys:schar-set)
+(defsetf bit (a &rest il) (v) `(sys:aset ,v ,a ,@il))
+(defsetf sbit (a &rest il) (v) `(sys:aset ,v ,a ,@il))
+(defsetf fill-pointer sys:fill-pointer-set)
+(defsetf symbol-plist sys:set-symbol-plist)
+(defsetf gethash (k h &optional d) (v) `(sys:hash-set ,k ,h ,v))
+(defsetf documentation (s d) (v)
+  `(case ,d
+     (variable (sys:putprop ,s ,v 'VARIABLE-DOCUMENTATION))
+     (function (sys:putprop ,s ,v 'FUNCTION-DOCUMENTATION))
+     (structure (sys:putprop ,s ,v 'STRUCTURE-DOCUMENTATION))
+     (type (sys:putprop ,s ,v 'TYPE-DOCUMENTATION))
+     (setf (sys:putprop ,s ,v 'SETF-DOCUMENTATION))
+     (t (error "~S is an illegal documentation type." ,d))))
+#+clos
+(defsetf sys:instance-ref sys:instance-set)
+#+clos
+(defsetf sys:gfun-spec-how-ref sys:gfun-spec-how-set)
+#+clos
+(defsetf sys:gfun-instance sys:gfun-instance-set)
+
+
+(define-setf-method getf (&environment env place indicator &optional default)
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method place env)
+    (let ((itemp (gensym)) (store (gensym)) (def (gensym)))
+      (values `(,@vars ,itemp ,def)
+              `(,@vals ,indicator ,default)
+              `(,store)
+              `(let ((,(car stores) (sys:put-f ,access-form ,store ,itemp)))
+                 ,store-form
+                 ,store)
+              `(getf ,access-form ,itemp ,default)))))
+
+(defsetf subseq (sequence1 start1 &optional end1)
+		(sequence2)
+  `(PROGN (REPLACE ,sequence1 ,sequence2 :START1 ,start1 :END1 ,end1)
+    ,sequence2))
+
+(define-setf-method THE (&environment env type place)
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method place env)
+    (values vars vals stores
+            (subst `(THE ,type ,(first stores)) (first stores) store-form)
+            `(THE ,type ,access-form))))
+
+#|
+(define-setf-method apply (&environment env fn &rest rest)
+  (unless (and (consp fn) (eq (car fn) 'FUNCTION) (symbolp (cadr fn))
+	       (null (cddr fn)))
+	  (error "Can't get the setf-method of ~S." fn))
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method (cons (cadr fn) rest) env)
+    (unless (eq (car (last store-form)) (car (last vars)))
+            (error "Can't get the setf-method of ~S." fn))
+    (values vars vals stores
+	    `(apply #',(car store-form) ,@(cdr store-form))
+	    `(apply #',(cadr fn) ,@(cdr access-form)))))
+|#
+
+(define-setf-method apply (&environment env fn &rest rest)
+  (unless (and (consp fn)
+               (or (eq (car fn) 'FUNCTION) (eq (car fn) 'QUOTE))
+               (symbolp (cadr fn))
+               (null (cddr fn)))
+    (error "Can't get the setf-method of ~S." fn))
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method (cons (cadr fn) rest) env)
+    (cond ((eq (car (last store-form)) (car (last vars)))
+           (values vars vals stores
+                   `(apply #',(car store-form) ,@(cdr store-form))
+                   `(apply #',(cadr fn) ,@(cdr access-form))))
+          ((eq (car (last (butlast store-form))) (car (last vars)))
+           (values vars vals stores
+                   `(apply #',(car store-form)
+                           ,@(cdr (butlast store-form 2))
+                           (append ,(car (last (butlast store-form)))
+                                   (list ,(car (last store-form)))))
+                   `(apply #',(cadr fn) ,@(cdr access-form))))
+          (t (error "Can't get the setf-method of ~S." fn)))))
+
+(define-setf-method ldb (&environment env bytespec int)
+  (multiple-value-bind (temps vals stores store-form access-form)
+      (get-setf-method int env)
+    (let ((btemp (gensym))
+	  (store (gensym))
+	  (stemp (first stores)))
+      (values `(,btemp ,@temps)
+	      `(,bytespec ,@vals)
+	      `(,store)
+	      `(let ((,stemp (dpb ,store ,btemp ,access-form)))
+	         ,store-form ,store)
+	      `(ldb ,btemp ,access-form)))))
+
+(define-setf-method mask-field (&environment env bytespec int)
+  (multiple-value-bind (temps vals stores store-form access-form)
+      (get-setf-method int env)
+    (let ((btemp (gensym))
+	  (store (gensym))
+	  (stemp (first stores)))
+      (values `(,btemp ,@temps)
+	      `(,bytespec ,@vals)
+	      `(,store)
+	      `(let ((,stemp (deposit-field ,store ,btemp ,access-form)))
+	         ,store-form ,store)
+	      `(mask-field ,btemp ,access-form)))))
+
+
+;;; The expansion function for SETF.
+(defun setf-expand-1 (place newvalue env &aux g)
+  (when (and (consp place) (eq (car place) 'THE))
+        (return-from setf-expand-1
+          (setf-expand-1 (caddr place) `(the ,(cadr place) ,newvalue) env)))
+  (when (symbolp place)
+        (return-from setf-expand-1 `(setq ,place ,newvalue)))
+  (when (and (consp place)
+	     (not (or (get (car place) 'SETF-LAMBDA)
+		      (get (car place) 'SETF-UPDATE-FN))))
+	(multiple-value-setq (place g) (macroexpand place env))
+	(if g (return-from setf-expand-1 (setf-expand-1 place newvalue env))))
+  (when (and (symbolp (car place)) (setq g (get (car place) 'SETF-UPDATE-FN)))
+        (return-from setf-expand-1 `(,g ,@(cdr place) ,newvalue)))
+  (when (and (symbolp (car place))
+             (setq g (get (car place) 'STRUCTURE-ACCESS)))
+    (return-from setf-expand-1
+      (setf-structure-access (cadr place) (car g) (cdr g) newvalue)))
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method place env)
+;    (declare (ignore access-form))
+    `(let* ,(mapcar #'list
+		    (append vars stores)
+		    (append vals (list newvalue)))
+       (declare (:read-only ,@ (append vars stores))) ; Beppe
+       ,store-form)))
+
+(defun setf-structure-access (struct type index newvalue)
+  (case type
+    (LIST `(sys:rplaca-nthcdr ,struct ,index ,newvalue))
+    (VECTOR `(sys:elt-set ,struct ,index ,newvalue))
+    (t `(sys::structure-set ,struct ',type ,index ,newvalue))))
+
+(defun setf-expand (l env)
+  (cond ((endp l) nil)
+        ((endp (cdr l)) (error "~S is an illegal SETF form." l))
+        (t
+         (cons (setf-expand-1 (car l) (cadr l) env)
+               (setf-expand (cddr l) env)))))
+
+
+;;; SETF macro.
+(defmacro setf (&environment env &rest rest)
+  (cond ((endp rest) nil)
+        ((endp (cdr rest)) (error "~S is an illegal SETF form." rest))
+        ((endp (cddr rest)) (setf-expand-1 (car rest) (cadr rest) env))
+        (t (cons 'progn (setf-expand rest env)))))
+
+
+;;; PSETF macro.
+
+(defmacro psetf (&environment env &rest rest)
+  (cond ((endp rest) nil)
+        ((endp (cdr rest)) (error "~S is an illegal PSETF form." rest))
+        ((endp (cddr rest))
+         `(progn ,(setf-expand-1 (car rest) (cadr rest) env)
+                 nil))
+        (t
+	 (do ((r rest (cddr r))
+	      (pairs nil)
+	      (store-forms nil))
+	     ((endp r)
+	      `(let* ,pairs
+		 ,@(nreverse store-forms)
+		 nil))
+	   (when (endp (cdr r)) (error "~S is an illegal PSETF form." rest))
+	   (multiple-value-bind (vars vals stores store-form access-form)
+	       (get-setf-method (car r) env)
+             (declare (ignore access-form))
+	     (setq store-forms (cons store-form store-forms))
+	     (setq pairs
+		   (nconc pairs
+			  (mapcar #'list
+				  (append vars stores)
+				  (append vals (list (cadr r)))))))))))
+
+
+;;; SHIFTF macro.
+(defmacro shiftf (&environment env &rest rest)
+  (do ((r rest (cdr r))
+       (pairs nil)
+       (stores nil)
+       (store-forms nil)
+       (g (gensym))
+       (access-forms nil))
+      ((endp (cdr r))
+       (setq stores (nreverse stores))
+       (setq store-forms (nreverse store-forms))
+       (setq access-forms (nreverse access-forms))
+       `(let* ,(nconc pairs
+		      (list (list g (car access-forms)))
+		      (mapcar #'list stores (cdr access-forms))
+		      (list (list (car (last stores)) (car r))))
+	    ,@store-forms
+	    ,g))
+    (multiple-value-bind (vars vals stores1 store-form access-form)
+	(get-setf-method (car r) env)
+      (setq pairs (nconc pairs (mapcar #'list vars vals)))
+      (setq stores (cons (car stores1) stores))
+      (setq store-forms (cons store-form store-forms))
+      (setq access-forms (cons access-form access-forms)))))
+
+
+;;; ROTATEF macro.
+(defmacro rotatef (&environment env &rest rest)
+  (do ((r rest (cdr r))
+       (pairs nil)
+       (stores nil)
+       (store-forms nil)
+       (access-forms nil))
+      ((endp r)
+       (setq stores (nreverse stores))
+       (setq store-forms (nreverse store-forms))
+       (setq access-forms (nreverse access-forms))
+       `(let* ,(nconc pairs
+		      (mapcar #'list stores (cdr access-forms))
+		      (list (list (car (last stores)) (car access-forms))))
+	    ,@store-forms
+	    nil))
+    (multiple-value-bind (vars vals stores1 store-form access-form)
+	(get-setf-method (car r) env)
+      (setq pairs (nconc pairs (mapcar #'list vars vals)))
+      (setq stores (cons (car stores1) stores))
+      (setq store-forms (cons store-form store-forms))
+      (setq access-forms (cons access-form access-forms)))))
+
+
+;;; DEFINE-MODIFY-MACRO macro, by Bruno Haible.
+(defmacro define-modify-macro (name lambdalist function &optional docstring)
+  (let* ((varlist nil)
+         (restvar nil))
+    (do* ((lambdalistr lambdalist (cdr lambdalistr))
+          (next))
+         ((null lambdalistr))
+      (setq next (first lambdalistr))
+      (cond ((eq next '&OPTIONAL))
+            ((eq next '&REST)
+             (if (symbolp (second lambdalistr))
+               (setq restvar (second lambdalistr))
+               (error "In the definition of ~S: &REST variable ~S should be a symbol."
+                      name (second lambdalistr)
+             ) )
+             (if (null (cddr lambdalistr))
+               (return)
+               (error "Only one variable is allowed after &REST, not ~S"
+                      lambdalistr
+            )) )
+            ((or (eq next '&KEY) (eq next '&ALLOW-OTHER-KEYS) (eq next '&AUX))
+             (error "Illegal in a DEFINE-MODIFY-MACRO lambda list: ~S"
+                    next
+            ))
+            ((symbolp next) (push next varlist))
+            ((and (listp next) (symbolp (first next)))
+             (push (first next) varlist)
+            )
+            (t (error "lambda list may only contain symbols and lists, not ~S"
+                      next
+            )  )
+    ) )
+    (setq varlist (nreverse varlist))
+    `(DEFMACRO ,name (&ENVIRONMENT ENV %REFERENCE ,@lambdalist) ,docstring
+       (MULTIPLE-VALUE-BIND (VARS VALS STORES SETTER GETTER)
+           (GET-SETF-METHOD %REFERENCE ENV)
+	 (IF (SYMBOLP GETTER)
+	     (SUBST (LIST* (QUOTE ,function) GETTER ,@varlist ,restvar)
+                    (CAR STORES)
+                    SETTER)
+	     (DO ((D VARS (CDR D))
+		  (V VALS (CDR V))
+		  (LET-LIST NIL (CONS (LIST (CAR D) (CAR V)) LET-LIST)))
+		 ((NULL D)
+		  (PUSH
+		   (LIST
+		    (CAR STORES)
+		    (IF (AND (LISTP %REFERENCE) (EQ (CAR %REFERENCE) 'THE))
+			(LIST 'THE (CADR %REFERENCE)
+			      (LIST* (QUOTE ,function) GETTER ,@varlist ,restvar))
+			(LIST* (QUOTE ,function) GETTER ,@varlist ,restvar)))
+		   LET-LIST)
+		  `(LET* ,(NREVERSE LET-LIST) ,SETTER))))))))
+#|
+(defmacro define-modify-macro (name lambda-list function &optional doc-string)
+  (let ((update-form
+	 (do ((l lambda-list (cdr l))
+	      (vs nil))
+	     ((null l) `(list ',function access-form ,@(nreverse vs)))
+	   (unless (eq (car l) '&optional)
+		   (if (eq (car l) '&rest)
+		       (return `(list* ',function
+				       access-form
+				       ,@(nreverse vs)
+				       ,(cadr l))))
+		   (if (symbolp (car l))
+		       (setq vs (cons (car l) vs))
+		       (setq vs (cons (caar l) vs)))))))
+    `(defmacro ,name (&environment env reference . ,lambda-list)
+       ,@(if doc-string (list doc-string))
+       (when (symbolp reference)
+             (return-from ,name
+               (let ((access-form reference))
+                 (list 'setq reference ,update-form))))
+       (multiple-value-bind (vars vals stores store-form access-form)
+	   (get-setf-method reference env)
+         `(let* ,(mapcar #'list
+		  (append vars stores)
+		  (append vals (list ,update-form)))
+	   (declare (:read-only ,@stores)) ; Beppe
+	   ,store-form)))))
+|#
+
+;;; Some macro definitions.
+
+(defmacro remf (&environment env place indicator)
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method place env)
+    `(let* ,(mapcar #'list vars vals)
+       (declare (:read-only ,@vars)) ; Beppe
+       (multiple-value-bind (,(car stores) flag)
+           (sys:rem-f ,access-form ,indicator)
+         ,store-form
+         flag))))
+
+(define-modify-macro incf (&optional (delta 1)) +)
+(define-modify-macro decf (&optional (delta 1)) -)
+
+(defmacro push (&environment env item place)
+  (when (symbolp place)
+    (return-from push `(setq ,place (cons ,item ,place))))
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method place env)
+    `(let* ,(mapcar #'list
+		    (append vars stores)
+		    (append vals (list (list 'cons item access-form))))
+       (declare (:read-only ,@vars)) ; Beppe
+       ,store-form)))
+
+(defmacro pushnew (&environment env item place &rest rest)
+  (cond ((symbolp place)
+	 (return-from pushnew `(setq ,place (adjoin ,item ,place ,@rest)))))
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method place env)
+    `(let* ,(mapcar #'list
+		    (append vars stores)
+		    (append vals
+			    (list (list* 'adjoin item access-form rest))))
+       (declare (:read-only ,@vars)) ; Beppe
+       ,store-form)))
+
+(defmacro pop (&environment env place)
+  (when (symbolp place)
+        (return-from pop
+          (let ((temp (gensym)))
+            `(let ((,temp (car ,place)))
+                (setq ,place (cdr ,place))
+                ,temp))))
+  (multiple-value-bind (vars vals stores store-form access-form)
+      (get-setf-method place env)
+    `(let* ,(mapcar #'list
+		    (append vars stores)
+		    (append vals (list (list 'cdr access-form))))
+       (declare (:read-only ,@vars)) ; Beppe
+       (prog1 (car ,access-form)
+              ,store-form))))
+#|
+;;; Proposed extension:
+; Expansion of (SETF (VALUES place1 ... placek) form)
+; --> (MULTIPLE-VALUE-BIND (dummy1 ... dummyk) form
+;       (SETF place1 dummy1 ... placek dummyk)
+;       (VALUES dummy1 ... dummyk))
+(define-setf-method VALUES (&environment env &rest subplaces)
+  (do ((temps) (vals) (stores)
+       (storeforms) (accessforms)
+       (placesr subplaces))
+      ((atom placesr)
+       (setq temps (nreverse temps)
+	     vals (nreverse vals)
+	     stores (nreverse stores)
+	     storeforms (nreverse storeforms)
+	     accessforms (nreverse accessforms))
+       (values temps
+            vals
+            stores
+            `(VALUES ,@storeforms)
+            `(VALUES ,@accessforms)))
+    (multiple-value-bind (SM1 SM2 SM3 SM4 SM5)
+        (get-setf-method (pop placesr) env)
+      (setq temps (revappend SM1 temps)
+	    vals (revappend SM2 vals)
+	    stores (revappend SM3 stores)
+	    storeforms (cons SM4 storeforms)
+	    accessforms (cons SM5 accessforms)))))
+|#
diff --git a/src/lsp/thread.lsp b/src/lsp/thread.lsp
new file mode 100644
index 000000000..90147aa0f
--- /dev/null
+++ b/src/lsp/thread.lsp
@@ -0,0 +1,172 @@
+;;;;  thread.lsp -- thread top level and utilities
+;;;;
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "CL")
+(export '(MAKE-THREAD
+	  DEACTIVATE
+	  REACTIVATE
+	  KILL-THREAD
+	  CURRENT-THREAD
+	  THREAD-STATUS
+	  THREAD-LIST
+	  MAKE-CONTINUATION
+	  THREAD-OF
+	  CONTINUATION-OF
+	  RESUME
+	  %disable-scheduler
+	  %enable-scheduler))
+
+(in-package "SYSTEM")
+
+(export '(let/cc
+	  pass
+	  spawn
+	  without-scheduling
+	  wait-in
+	  wait
+	  wait-or
+	  *scheduler-disabled-in-error*
+	  *break-level*))
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+;;; ----------------------------------------------------------------------
+;;; Top level
+
+(defvar *scheduler-disabled-in-error* t)
+
+(defun universal-error-handler
+  (error-name correctable function-name
+	      continue-format-string error-format-string
+	      args)
+  (declare (ignore error-name))
+  (unwind-protect
+      (if (or (plusp *break-level*) (not *scheduler-disabled-in-error*))
+	  (let ((*print-pretty* nil)
+		(*print-level* 4)
+		(*print-length* 4)
+		(*print-case* :upcase))
+	    (format *error-output* "~&~:[E~;Correctable e~]rror: " correctable)
+	    (let ((*indent-formatted-output* t))
+	      (format *error-output* "~?~%Signalled by ~A." error-format-string args
+		      (or function-name "an anonymous function")))
+	    (when correctable
+		  (format *error-output* "~&~:[Continuing~;If continued~]: "
+			  *break-enable*)
+		  (let ((*indent-formatted-output* t))
+		    (format *error-output* "~?" continue-format-string args)))
+	    (terpri *error-output*)
+	    (break-level correctable
+			 (format nil "~?" error-format-string args)))
+;;;	(let ((break-exit nil))
+	  (let ((*print-pretty* nil)
+		(*print-level* 4)
+		(*print-length* 4)
+		(*print-case* :upcase))
+	    (thread-break-in)
+	    (format *error-output* "~&~:[E~;Correctable e~]rror: " correctable)
+	    (let ((*indent-formatted-output* t))
+	      (format *error-output* "~?~%Signalled by ~A." error-format-string args
+		      (or function-name "an anonymous function")))
+	    (when correctable
+		  (format *error-output* "~&~:[Continuing~;If continued~]: "
+			  *break-enable*)
+		  (let ((*indent-formatted-output* t))
+		    (format *error-output* "~?" continue-format-string args)))
+	    (terpri *error-output*)
+;;;	    (setq break-exit
+	    (break-level correctable
+			 (format nil "~?" error-format-string args))))
+;;;))
+    (thread-break-resume)))
+
+(defun thread-top-level (fun &rest args)
+  (let ((*quit-tag* (cons nil nil))
+	*quit-tags*
+	(*break-level* 0)
+	(*tpl-level* 0)
+	(*ihs-base* 1)
+	(*ihs-top* 1)
+	(*break-enable* t))
+    (catch 'THREAD-TOP			; catch (quit)
+      (catch *quit-tag*			; catch quit from errors
+	(apply fun args)))
+    nil					; dont remove
+    )
+  )
+
+
+;;; ----------------------------------------------------------------------
+;;; Utilities
+
+(defmacro spawn (function &rest args)
+  `(resume (make-continuation (make-thread ,function)) ,@ args))
+
+(defun pass (&rest args)
+  (%disable-scheduler)
+  (apply 'resume args)
+  (%suspend))
+
+(defmacro let/cc (cont body)
+  `(let ((,cont (make-continuation (current-thread))))
+    ,@body
+    (%suspend)))
+
+(defmacro without-scheduling (&rest body)
+  `(unwind-protect
+       (progn 
+	 (%disable-scheduler)
+	 (progn ,@body))
+     (%enable-scheduler)))
+
+(defmacro wait-in (place)
+  `(progn
+     (setf ,place (make-continuation (current-thread)))
+     (%suspend)))
+
+(defun wait (&rest threads)
+  (labels ((wait-all-internal (threads)
+	     (or (null threads)
+		 (and (eq (thread-status (first threads)) 'DEAD)
+		      (wait-all-internal (rest threads))))))
+    (funcall #'%thread-wait #'wait-all-internal threads)))
+
+(defun wait-some (&rest threads)
+  (labels ((wait-some-internal (threads)
+	     (or (null threads)
+		 (eq (thread-status (first threads)) 'DEAD)
+		 (wait-some-internal (rest threads)))))
+    (funcall #'%thread-wait #'wait-some-internal threads)))
+
+;;; ----------------------------------------------------------------------
+;;; Examples
+#|
+(defvar *producer* (make-thread 'producer))
+(defvar *consumer* (make-thread 'consumer))
+
+(defun producer ()
+  (dotimes (i 20)
+    (print 'producer)
+    ;; produce
+    (resume (make-continuation *consumer*) i)
+    (%suspend)))
+
+(defun consumer ()
+  (let (i)
+    (loop
+     (print 'consumer)
+     (resume (make-continuation *producer*))
+     (setq i (%suspend))
+     ;; consume
+     (print i))))
+
+(resume (make-continuation *producer*))
+|#
diff --git a/src/lsp/top.lsp b/src/lsp/top.lsp
new file mode 100644
index 000000000..f02cd1b7a
--- /dev/null
+++ b/src/lsp/top.lsp
@@ -0,0 +1,957 @@
+;;;;  top.lsp -- Top-level loop, break loop, and error handlers
+;;;;
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;;
+;;;;  Revised on July 11, by Carl Hoffman.
+;;;;  Modified Oct 1986 by Ken Rimey.
+;;;;  Reworked March 1987, by Edward Wang.
+;;;;  Merged into new distribution Sept 1987, by Edward Wang.
+;;;;  Reworked for Threads November 1988, by Giuseppe Attardi.
+;;;;  Reworked for CLOS November 1988, by Giuseppe Attardi.
+
+(in-package "SYSTEM")
+
+(export '(*break-readtable* *break-on-warnings* *break-enable*
+	  *lisp-init-file-list* *tpl-evalhook*))
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+(defvar + nil)
+(defvar ++ nil)
+(defvar +++ nil)
+(defvar - nil)
+(defvar * nil)
+(defvar ** nil)
+(defvar *** nil)
+(defvar / nil)
+(defvar // nil)
+(defvar /// nil)
+
+; Can't use ~ on Solaris 2:
+;(defvar *lisp-init-file-list* '("./init" "~/.ecls"))
+(defvar *lisp-init-file-list* '("./init"))
+
+(defvar *quit-tag* (cons nil nil))
+(defvar *quit-tags* nil)
+(defvar *continue-tag* (cons nil nil))	; return tag from current error
+(defvar *break-level* 0)		; nesting level of error loops
+(defvar *break-env* nil)
+(defvar *ihs-base* 0)
+(defvar *ihs-top* 0)
+(defvar *ihs-current* 0)
+(defvar *frs-base* 0)
+(defvar *frs-top* 0)
+(defvar *tpl-continuable* t)
+(defvar *tpl-prompt-hook* nil)
+(defvar *eof* (cons nil nil))
+
+(defvar *ignore-errors-tag* (gensym))	; return tag for ignorable error
+(defvar *ignore-errors* nil)		; flag about whether to ignore errors
+(defvar *last-error* nil)
+
+(defvar *break-enable* t)
+(defvar *break-message* nil)
+(defvar *break-on-warnings* nil)
+(defvar *break-readtable* nil)
+(defvar *tpl-level* -1)			; nesting level of top-level loops
+(defvar *step-level* 0)			; repeated from trace.lsp
+
+(defvar *break-hidden-functions* '(error cerror apply funcall invoke-debugger))
+(defvar *break-hidden-packages* (list (find-package 'system)))
+
+(defconstant tpl-commands
+   '(("Top level commands"
+      ((:cf :compile-file) tpl-compile-command :string
+       ":cf		Compile file"
+       ":compile-file &string &rest files		[Top level command]~@
+	:cf &string &rest files				[Abbreviation]~@
+	~@
+	Compile files.  With no arguments, uses values from latest :cf~@
+	command.  File extensions are optional.~%")
+      ((:exit :eof) quit :eval
+       ":exit or ^D	Exit Lisp"
+       ":exit &eval &optional (status 0)		[Top level command]~@
+	~@
+	Exit Lisp without further confirmation.~%")
+      ((:ld :load) tpl-load-command :string
+       ":ld		Load file"
+       ":load &string &rest files			[Top level command]~@
+	:ld &string &rest files				[Abbreviation]~@
+	~@
+	Load files.  With no arguments, uses values from latest :ld~@
+	or :cf command. File extensions are optional.~%")
+      ((:step) tpl-step-command nil
+       ":step		Single step form"
+       ":step form					[Top level command]~@
+	~@
+	Evaluate form in single step mode.  While stepping, a new break~@
+	level is invoked before every evaluation.  Extra commands are~@
+	available at this time to control stepping and form evaluation.~%")
+      ((:tr :trace) tpl-trace-command nil
+       ":tr(ace)	Trace function"
+       ":trace &rest functions				[Top level command]~@
+	:tr &rest functions				[Abbreviation]~@
+	~@
+	Trace specified functions.  With no arguments, show currently~@
+	traced functions.~@
+	~@
+	See also: :untrace.~%")
+      ((:untr :untrace) tpl-untrace-command nil
+       ":untr(ace)	Untrace function"
+       ":untrace &rest functions			[Top level command]~@
+	:untr &rest functions				[Abbreviation]~@
+	~@
+	Untrace specified functions.  With no arguments, untrace~@
+	all functions.~@
+	~@
+	See also: :trace.~%")
+      )
+     ("Help commands"
+      ((:apropos) tpl-apropos-command nil
+       ":apropos	Apropos"
+       ":apropos string &optional package		[Top level command]~@
+	~@
+	Finds all available symbols whose print names contain string.~@
+	If a non NIL package is specified, only symbols in that package are considered.~@
+	~%")
+      ((:doc document) tpl-document-command nil
+       ":doc(ument)	Document"
+       ":document symbol				[Top level command]~@
+	~@
+	Displays documentation about function, print names contain string.~%")
+      ((? :h :help) tpl-help-command nil
+       ":h(elp) or ?	Help.  Type \":help help\" for more information"
+       ":help &optional topic				[Top level command]~@
+	:h &optional topic				[Abbrevation]~@
+      	~@
+	Print information on specified topic.  With no arguments, print~@
+	quick summery of top level commands.~@
+	~@
+	Help information for top level commands follows the documentation~@
+	style found in \"Common Lisp, the Language\"; and, in general, the~@
+	commands themselves follow the conventions of Common Lisp functions,~@
+	with the exception that arguments are normally not evaluated.~@
+	Those commands that do evaluate their arguments are indicated by the~@
+	keyword &eval in their description.  A third class of commands~@
+	treat their arguments as whitespace-separated, case-sensitive~@
+	strings, requiring double quotes only when necessary.  This style~@
+	of argument processing is indicated by the keyword &string.~@
+	For example, the :load command accepts a list of file names:
+	~@
+	:load &string &rest files			[Top level Command]~@
+	~@
+	whereas :exit, which requires an optional evaluated argument, is~@
+	~@
+	:exit &eval &optional status			[Top level Command]~%")
+      )))
+
+(defvar *tpl-commands* tpl-commands)
+
+(defconstant break-commands
+  '("Break commands"
+     ((:q :quit) tpl-quit-command nil
+       ":q(uit)		Return to some previous break level"
+       ":quit &optional n				[Break command]~@
+	:q &optional n					[Abbreviation]~@
+	~@
+	Without argument, return to top level;~@
+	otherwise return to break level n.~%")
+      ((:pop) (tpl-pop-command) :constant
+       ":pop		Pop to previous break level"
+       ":pop						[Break command]~@
+	~@
+	Pop to previous break level, or if already in top level,~@
+	exit Lisp after confirmation.~%")
+      ((:c :continue) tpl-continue-command nil
+       ":c(ontinue)	Continue execution"
+       ":continue					[Break command]~@
+	:c						[Abbreviation]~@
+	~@
+	Continue execution.  Return from current break level to the caller.~@
+	This command is only available when the break level is continuable~@
+	(e.g., called from a correctable error or the function break).~%")
+      ((:b :backtrace) tpl-backtrace nil
+       ":b(acktrace)	Print backtrace"
+       ":backtrace &optional n				[Break command]~@
+	:b &optional n					[Abbreviation]~@
+	~@
+	Show function call history.  Only those functions called since~@
+	the previous break level are shown.  In addition, functions compiled~@
+	in-line or explicitly hidden are not displayed.  Without an argument,~@
+	a concise backtrace is printed with the current function in upper~@
+	case.  With integer argument n, the n functions above and including~@
+	the current one are printed in a verbose format.  The current~@
+	function is indicated with a '@' at the beginning of the line.~@
+	With non-integer argument, all functions since the the previous break~@
+	level are printed verbosely.~@
+	~@
+	See also: :function, :previous, :next.~%")
+      ((:f :function) tpl-print-current nil
+       ":f(unction)	Show current function"
+       ":function					[Break command]~@
+	:f						[Abbreviation]~@
+	~@
+	Show current function.  The current function is the implicit focus~@
+	of attention for several other commands.  When it is an interpreted~@
+ 	function, its lexical environment is available for inspection and~@
+	becomes the environment for evaluating user input forms.~@
+	~@
+	See also: :backtrace, :next, previous, :variables.~%")
+      ((:p :previous) tpl-previous nil
+       ":p(revious)	Go to previous function"
+       ":previous &optional (n 1)			[Break command]~@
+	:p &optional (n 1)				[Abbreviation]~@
+	~@
+	Move to the nth previous visible function in the backtrace.~@
+ 	It becomes the new current function.~@
+	~@
+	See also: :backtrace, :function, :go, :next.~%")
+      ((:n :next) tpl-next nil
+       ":n(ext)		Go to next function"
+       ":next &optional (n 1)				[Break command]~@
+	:n &optional (n 1)				[Abbreviation]~@
+	~@
+	Move to the nth next visible function in the backtrace.  It becomes~@
+	the new current function.~@
+	~@
+	See also: :backtrace, :function, :go, :previous.~%")
+      ((:g :go) tpl-go nil
+       ":g(o)		Go to next function"
+       ":go &optional (n 1)				[Break command]~@
+	:g &optional (n 1)				[Abbreviation]~@
+	~@
+	Move to the function at IHS[i].~@
+	See also: :backtrace, :function, :next, :previous.~%")
+      ((:fs :forward-search) tpl-forward-search :string
+       ":fs             Search forward for function"
+       ":forward-search &string substring		[Break command]~@
+	:fs &string substring				[Abbreviation]~@
+	~@
+	Search forward in the backtrace for function containing substring.~@
+	The match is case insensitive.~@
+	~@
+	See also: :backtrace, :function, :next.~%")
+      ((:bs :backward-search) tpl-backward-search :string
+       ":bs             Search backward for function"
+       ":backward-search &string substring		[Break command]~@
+	:bs &string substring				[Abbreviation]~@
+	~@
+	Search backward in the backtrace for function containing substring.~@
+	The match is case insensitive.~@
+	~@
+	See also: :backtrace, :function, :previous.~%")
+      ((:v :variables) tpl-variables-command nil
+       ":v(ariables)	Show local variables, functions, blocks, and tags"
+       ":variables &optional no-values			[Break command]~@
+	:v &optional no-values				[Abbreviation]~@
+	~@
+	Show lexical variables, functions, block names, and tags local~@
+	to the current function.  The current function must be interpreted.~@
+	The values of local variables and functions are also shown,~@
+	unless the argument is non-null.~%")
+#|
+      ((:l :local) tpl-local-command nil
+       ":l(ocal)	Return the nth local value on the stack"
+       ":local &optional (n 0)				[Break command]~@
+	:l &optional (n 0)				[Abbreviation]
+	~@
+	For compiled functions, return the value of the nth lexical variable.~@
+	As is done normally, the returned value is both printed by the top~@
+	level as well as saved in the variable *.~%")
+|#
+      ((:hide) tpl-hide nil
+       ":hide		Hide function"
+       ":hide function					[Break command]~@
+	~@
+	Hide function.  A hidden function is not displayed in a backtrace.~@
+	~@
+	See also: :backtrace, :unhide, :hide-package.~%")
+      ((:unhide) tpl-unhide nil
+       ":unhide		Unhide function"
+       ":unhide function				[Break command]~@
+	~@
+	Unhide function.  The specified function will be displayed in future~@
+	backtraces, unless its home package is also hidden.~@
+	~@
+	See also: :backtrace, :hide, :unhide-package.~%")
+      ((:hp :hide-package) tpl-hide-package nil
+       ":hp		Hide package"
+       ":hide-package package				[Break command]~@
+	:hp package					[Abbreviation]~@
+	~@
+	Hide package.  Functions in a hidden package are not displayed~@
+	in a backtrace.~@
+	~@
+	See also: :backtrace, :unhide-package.~%")
+      ((:unhp :unhide-package) tpl-unhide-package nil
+       ":unhp		Unhide package"
+       ":unhide-package package				[Break command]~@
+	:unhp package					[Abbreviation]~@
+	~@
+	Unhide package.  Functions in the specified package will be displayed~@
+	in future backtraces, unless they are individually hidden.~@
+	~@
+	See also: :backtrace, :hide-package, :hide, :unhide.~%")
+      ((:unhide-all) tpl-unhide-all nil
+       ":unhide-all     Unhide all variables and packages"
+       ":unhide-all					[Break command]~@
+	~@
+	Unhide all variables and packages.  All functions will be displayed~@
+	in future backtraces.~@
+	~@
+	See also: :hide, :unhide, :hide-package, :unhide-package.~%")
+#|
+      ((:vs :value-stack) tpl-vs-command nil
+       ":vs             Show value stack"
+       ":value-stack &optional n			[Break command]~@
+	:vs &optional n					[Abbreviation]~@
+	~@
+	Without an argument, show the entire value stack since the previous~@
+	break level.  With an integer argument n, print nothing, but return~@
+	the nth value stack entry.~@
+	~@
+	See also: :local.~%")
+|#
+      ((:bds :binding-stack) tpl-bds-command nil
+       ":bds            Show binding stack"
+       ":binding-stack &optional variable		[Break command]~@
+	:bds &optional variable				[Abbreviation]~@
+	~@
+	Without an argument, show the entire binding stack since the previous~@
+	break level.  With a variable name, print nothing, but return the~@
+	value of the given variable on the binding stack.~%")
+      ((:m :message) tpl-print-message nil
+       ":m(essage)      Show error message"
+       ":message					[Break command]~@
+	:m						[Abbreviation]~@
+	~@
+	Show current error message.~%")
+      ((:hs :help-stack) tpl-help-stack-command nil
+       ":hs		Help stack"
+       ":help-stack					[Break command]~@
+	:hs						[Abbrevation]~@
+	~@
+	Lists the functions to access the LISP system stacks.~%")
+      )
+  )
+
+(eval-when (compile eval)
+  (defmacro notinline (form)
+    `(locally (declare (notinline ,(car form)))
+	      ,form)))
+
+(defun process-command-args ()
+  (do ((i 1 (1+ i))
+       (argc (argc)))
+      ((= i argc))
+    (cond
+      ((string= "-dir" (argv i))
+       (incf i)
+       (if (= i argc)
+	   (error "Missing directory")
+	   (setq *system-directory* (argv i))))
+      ((string= "-compile" (argv i))
+       (incf i)
+       (if (= i argc)
+	   (error "Missing file name")
+	   (flet ((get-argument (n k default)
+		    (do ((j (1+ n) (1+ j))
+			 (argc (argc)))
+			((= j argc) default)
+		      (when (string= k (argv j))
+			(incf j)
+			(return
+			  (or (= j argc)
+			      (eql (schar (argv j) 0) #\-)
+			      (let ((arg (argv j)))
+				(if (string-equal "nil" arg)
+				    NIL
+				    (or (string-equal "t" arg) arg)))))))))
+	     (if (nth-value 3
+			    (compile-file
+			     (argv i)
+			     :output-file (get-argument i "-o" T)
+			     :c-file  (get-argument i "-c" NIL)
+			     :h-file  (get-argument i "-h" NIL)
+			     :data-file (get-argument i "-data" NIL)
+			     :system-p  (get-argument i "-s" NIL)))
+	       (quit 1)
+	       (quit 0)))))
+      ((string= "-load" (argv i))
+       (incf i)
+       (if (= i argc)
+	   (error "Missing file name")
+	   (load (argv i))))
+      ((string= "-eval" (argv i))
+       (incf i)
+       (if (= i argc)
+	   (error "Missing file name")
+	   (eval (read-from-string (argv i)))))
+      (t (format t "Unknown flag ~A
+Usage: ecls [-dir dir] [-load file] [-eval expr]
+	[-compile file [-o ofile] [-c [cfile]] [-h [hfile]] [-data [datafile]] [-s]]"
+		(argv i))
+	 (quit 1)))))
+
+(defvar *lisp-initialized* nil)
+
+(defun top-level ()
+  (let (+ ++ +++ - * ** *** / // ///)
+
+    (unless *lisp-initialized*
+      (catch *quit-tag*
+	(let ((*break-enable* nil))
+
+	  (dolist (file *lisp-init-file-list*)
+	    (when (notinline (load file :if-does-not-exist nil))
+	      (return)))
+	  ;; process command arguments
+	  (notinline (process-command-args))))
+
+      (format t "ECLS (ECoLisp-Spain) ~A" (lisp-implementation-version))
+      (format t "~%Copyright (C) 1984 Taiichi Yuasa and Masami Hagiya~@
+	Copyright (C) 1993 Giuseppe Attardi~@
+	Copyright (C) 2000 Juan J. Garcia-Ripoll
+	ECLS is free software, and you are welcome to redistribute it~@
+	under certain conditions; see file 'Copyright' for details.")
+      (format *standard-output* "~%Type :h for Help.  ")
+
+      (setq *lisp-initialized* t))
+
+    (in-package "CL-USER")
+    (setq sys::*gc-verbose* t)
+
+    (catch *quit-tag*
+      (let ((*tpl-level* -1))
+	(tpl)))))
+
+(defun terminal-interrupt (correctablep)
+  (let ((*break-enable* t))
+    (if correctablep
+      (cerror "Continues execution." "Console interrupt.")
+      (error "Console interrupt -- cannot continue."))))
+
+(defun tpl (&key ((:continuable *tpl-continuable*) t)
+		 ((:commands *tpl-commands*) tpl-commands)
+		 ((:prompt-hook *tpl-prompt-hook*) nil)
+		 (quiet nil))
+  (let* ((*ihs-base* *ihs-top*)
+	 (*ihs-top* (ihs-top))
+	 (*ihs-current* *ihs-top*)
+	 (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top))))
+	 (*frs-top* (frs-top))
+	 (*read-suppress* nil)
+	 (*quit-tags* (cons *quit-tag* *quit-tags*))
+	 (*quit-tag* *quit-tags*)	; any unique new value
+	 (*tpl-level* (1+ *tpl-level*))
+	 values)
+    (set-current-ihs)
+    (unless quiet
+      (break-where))
+    (loop
+     (setq +++ ++ ++ + + -)
+     (when (zerop *tpl-level*)
+	   (reset-stack-limits))
+     (when (catch *quit-tag*
+	     (tpl-prompt)
+	     (setq - (notinline (tpl-read)))
+	     (setq values
+		   (multiple-value-list
+		    (evalhook - nil nil *break-env*)))
+	     (setq /// // // / / values *** ** ** * * (car /))
+	     (tpl-print values)
+	     nil)
+	   (break-where)))))
+
+(defun tpl-prompt ()
+  (fresh-line)
+  (when *tpl-prompt-hook*
+    (funcall *tpl-prompt-hook*))
+  (format t "~A~V,,,'>A "
+	  (if (eq *package* (find-package 'user)) "" (package-name *package*))
+	  (- *tpl-level* *step-level* -1)
+	  ""))
+
+(defun tpl-read ()
+  (finish-output)
+  (loop
+    (case (peek-char nil *standard-input* nil :EOF)
+      ((#\))
+       (warn "Ignoring an unmatched right parenthesis.")
+       (read-char))
+      ((#\space #\tab)
+       (read-char))
+      ((#\newline #\return)
+       (read-char)
+       ;; avoid repeating prompt on successive empty lines:
+       (let ((command (tpl-make-command :newline "")))
+	 (when command (return command))))
+      (:EOF
+       (terpri)
+       (return (tpl-make-command :EOF "")))
+      (#\:
+       (return (tpl-make-command (read-preserving-whitespace)
+				 (read-line))))
+      (#\?
+       (read-char)
+       (case (peek-char nil *standard-input* nil :EOF)
+	 ((#\space #\tab #\newline #\return :EOF)
+	  (return (tpl-make-command :HELP (read-line))))
+	 (t
+	  (unread-char #\?)
+	  (return (read)))))
+      (t
+       (return (read))))))
+
+(defun tpl-make-command (name line &aux (c nil))
+  (dolist (commands *tpl-commands*)
+    (when (setq c (assoc name (cdr commands) :test #'member))
+      (return)))
+  (cond ((null c)
+	 (if (eq name :newline)		; special handling for Newline.
+	     nil
+	   `(tpl-unknown-command ',name)))
+	((eq (third c) :eval)
+	 `(,(second c) . ,(tpl-parse-forms line)))
+	((eq (third c) :string)
+	 `(,(second c) . ,(tpl-parse-strings line)))
+	((eq (third c) :constant)
+	 (second c))
+	(t
+	 `(,(second c) . ,(tpl-parse-forms line t)))))
+
+(defun tpl-parse-forms (line &optional quote)
+  (with-input-from-string (stream line)
+    (do ((form (read stream nil *eof*) (read stream nil *eof*))
+	 (list nil))
+	((eq form *eof*) (nreverse list))
+      (push (if quote `',form form) list))))
+
+(defun tpl-parse-strings (line)
+  (do ((i 0 end)
+       (start)
+       (end)
+       (list nil)
+       (space-p #'(lambda (c) (or (eql c #\space) (eql c #\tab))))
+       (length (length line)))
+      ((>= i length) (nreverse list))
+    (cond ((null (setq start (position-if-not space-p line :START i)))
+	   (setq end length))
+	  ((eql (schar line start) #\")
+	   (multiple-value-bind
+	       (string n)
+	       (read-from-string line t nil :START start)
+	     (push string list)
+	     (setq end n)))
+	  (t
+	   (setq end (or (position-if space-p line :START start) length))
+	   (push (subseq line start end) list)))))
+
+(defun tpl-print (values)
+  (fresh-line)
+  (dolist (v values)
+    (prin1 v)
+    (terpri)))
+
+(defun tpl-unknown-command (command)
+  (format t "Unknown top level command: ~s~%" command)
+  (values))
+
+(defun tpl-pop-command (&rest any)
+  (declare (ignore any))
+  (throw (pop *quit-tags*) t))
+
+(defun tpl-continue-command (&rest any)
+  (declare (ignore any))
+  (if *tpl-continuable*
+    (throw *continue-tag* nil)
+    (format t "Can't continue from error.~%"))
+  (values))
+
+(defun tpl-quit-command (&optional (level 0))
+  (when (and (>= level 0) (< level *tpl-level*))
+    (let ((x (nth (- *tpl-level* level 1) *quit-tags*)))
+      (throw x x)))
+  (tpl-print-current))
+
+(defun tpl-previous (&optional (n 1))
+  (do ((i (1- *ihs-current*) (1- i)))
+      ((or (< i *ihs-base*) (<= n 0)))
+    (when (ihs-visible i)
+      (setq *ihs-current* i)
+      (decf n)))
+  (set-break-env)
+  (tpl-print-current))
+
+(defun tpl-next (&optional (n 1))
+  (do ((i (1+ *ihs-current*) (1+ i)))
+      ((or (> i *ihs-top*) (<= n 0)))
+    (when (ihs-visible i)
+      (setq *ihs-current* i)
+      (decf n)))
+  (set-break-env)
+  (tpl-print-current))
+
+(defun tpl-go (ihs-index)
+  (setq *ihs-current* (min (max ihs-index *ihs-base*) *ihs-top*))
+  (if (ihs-visible *ihs-current*)
+      (progn (set-break-env) (tpl-print-current))
+      (tpl-previous)))
+
+(defun tpl-print-message ()
+  (when *break-message*
+    (princ *break-message*)
+    (terpri))
+  (values))
+
+(defun tpl-variables-command (&optional no-values)
+  (let ((*print-level* 2)
+	(*print-length* 4)
+	(*print-pretty* t)
+        (fun (ihs-fun *ihs-current*))
+        name args)
+    (if (and (compiled-function-p fun)
+	     (symbolp (setq name (compiled-function-name fun)))
+	     (setq args (get name 'arglist)))
+	(progn
+#|
+	  (format t
+		  "Local variables:~%")
+	  (do ((args args (cdr args))
+	       (i (ihs-vs *ihs-current*) (1+ i)))
+	      ((null args))
+	    (declare (fixnum i))
+	    (format t "~:[~s: ~s~;~s~]~%" no-values (car args) (vs i)))
+|#
+)
+	(apply #'format t
+	       "Local variables:~#[~; none~:;~:[ ~1{~s~}~:@{, ~s~}~;~
+					  ~:@{~%  ~s: ~s~}~]~]~%"
+	       (not no-values) (car *break-env*)))
+    (apply #'format t
+	   "~#[~:;Local functions: ~@{~s~^, ~}.~%~]"
+	   (mapcan #'(lambda (x) (and (eq (second x) 'FUNCTION) (list (car x))))
+		   (cdr *break-env*)))
+    (apply #'format t
+	   "~#[~:;Block names: ~@{~s~^, ~}.~%~]"
+	   (mapcan #'(lambda (x) (and (eq (second x) 'BLOCK) (list (car x))))
+		   (cdr *break-env*)))
+    (apply #'format t
+	   "~#[~:;Tags: ~@{~s~^, ~}.~%~]"
+	   (mapcan #'(lambda (x) (when (eq (second x) 'TAG) (list (car x))))
+		   (cdr *break-env*)))
+    (values)))
+#|
+(defun tpl-vs-command (&optional x)
+  (let ((min (ihs-vs *ihs-base*))
+	(max (1- (ihs-vs (1+ *ihs-top*))))
+	y)
+    (cond ((integerp x)
+	   (if (and (>= x min) (<= x max))
+	     (vs x)
+	     (format t "Illegal value stack index.~%")))
+	  ((null x)
+	   (setq x min)
+	   (setq y max)
+	   (do ((ii *ihs-base* (1+ ii))
+		(*print-level* 2)
+		(*print-length* 4)
+		(*print-pretty* t))
+	       ((or (>= ii *ihs-top*) (>= (ihs-vs ii) x))
+		(do ((vi x (1+ vi)))
+		    ((> vi y))
+		  (do ()
+		      ((> (ihs-vs ii) vi))
+		    (when (ihs-visible ii)
+		      (print-ihs ii))
+		    (incf ii))
+		  (format t "    VS[~d]: ~s~%" vi (vs vi)))))
+	   (values))
+	  (t
+	   (format t "Argument must be a number.~%")
+	   (values)))))
+
+(defun tpl-local-command (&optional (n 0))
+  (tpl-vs-command (+ (ihs-vs *ihs-current*) n)))
+|#
+(defun tpl-bds-command (&optional var)
+  (if var
+    (do ((bi (1+ (frs-bds (max 0 (1- *frs-base*)))) (1+ bi))
+	 (last (frs-bds (1+ *frs-top*))))
+	((> bi last)
+	 (format t "Variable not found.~%")
+	 (values))
+      (when (eq (bds-var bi) var)
+	(return (bds-val bi))))
+    (do ((bi (1+ (frs-bds (max 0 (1- *frs-base*)))) (1+ bi))
+	 (last (frs-bds (1+ *frs-top*)))
+	 (fi *frs-base*)
+	 (*print-level* 2)
+	 (*print-length* 4)
+	 (*print-pretty* t))
+	((> bi last) (values))
+      (do ()
+	  ((or (> fi *frs-top*) (>= (frs-bds fi) bi)))
+	(print-frs fi)
+	(incf fi))
+      (format t "BDS[~d]: ~s = ~s~%"
+	      bi (bds-var bi) (bds-val bi)))))
+
+(defun tpl-backtrace (&optional n)
+  (if (null n)
+      (let ((*print-pretty* nil))	; because CLOS allows (setf foo)
+					; as function names
+	(princ "Backtrace:")
+	(do ((i *ihs-base* (1+ i))
+	     (b nil t))
+	    ((> i *ihs-top*))
+	  (when (ihs-visible i)
+	    (let ((*print-case* (if (= i *ihs-current*) :UPCASE :DOWNCASE)))
+	      (format t "~:[~; >~] ~S" b (ihs-fname i)))))
+	(terpri))
+      (let ((from (if (integerp n)
+		      (max (1+ (- *ihs-current* n)) *ihs-base*)
+		      *ihs-base*))
+	    (to (if (integerp n) *ihs-current* *ihs-top*)))
+	(do ((i from (1+ i))
+	     (j (or (sch-frs-base *frs-base* from) (1+ *frs-top*)))
+	     (*print-level* 2)
+	     (*print-length* 4)
+	     (*print-pretty* t))
+	    ((> i to) (values))
+	  (when (ihs-visible i)
+	    (print-ihs i))
+	  (do () ((or (> j *frs-top*) (> (frs-ihs j) i)))
+	    (print-frs j)
+	    (incf j)))))
+  (values))
+
+#|
+(defun print-ihs (i)
+  (format t "~:[  ~;@ ~]IHS[~d]: ~s ---> VS[~d]~%"
+	  (= i *ihs-current*) i
+	  (let ((fun (ihs-fun i)))
+	    (cond ((or (symbolp fun) (compiled-function-p fun)) fun)
+		  ((consp fun)
+		   (case (car fun)
+		     (lambda fun)
+		     (lambda-block (cdr fun))
+		     (lambda-closure (cons 'lambda (cddddr fun)))
+		     (lambda-block-closure (cddddr fun))
+		     #+clos
+		     (setf fun)
+		     (t '(:zombi))))
+		  #+clos
+		  ((sys:gfunp fun) fun)
+		  (t :zombi)))
+	  (ihs-vs i)))
+|#
+
+(defun print-frs (i)
+  (format *debug-io* "    FRS[~d]: ---> IHS[~d],BDS[~d]~%"
+	  i (frs-ihs i) (frs-bds i)))
+
+#|
+(defun print-frs (i)
+  (format *debug-io* "~&    FRS[~d]: ~s ---> IHS[~d],VS[~d],BDS[~d]"
+          i (frs-kind i) (frs-ihs i) (frs-vs i) (frs-bds i)))
+
+(defun frs-kind (i &aux x)
+  (case (frs-class i)
+    (:catch
+     (if (spicep (frs-tag i))
+       (or (and (setq x (member (frs-tag i) (vs (+ (frs-vs i) 2))
+				:key #'third :test #'eq))
+		(if (eq (cadar x) 'block)
+		  `(block ,(caar x) ***)
+		  `(tagbody
+		     ,@(reverse
+			(mapcar #'car (remove (frs-tag i) x :test-not #'eq
+					      :key #'third)))
+		     ***)))
+	   `(block/tagbody ,(frs-tag i)))
+       `(catch ',(frs-tag i) ***)))
+    (:protect '(unwind-protect ***))
+    (t `(system-internal-catcher ,(frs-tag i)))))
+|#
+
+(defun break-where (&aux (fname (ihs-fname *ihs-current*)))
+  (if (or (eq fname 'TOP-LEVEL) (eq fname 'BREAK-WHERE))
+    (format t "Top level.~%")
+    (format t "Broken at ~:@(~S~).~%" (ihs-fname *ihs-current*))))
+
+(defun tpl-print-current ()
+  (format t "Broken at ~:@(~S~)." (ihs-fname *ihs-current*))
+  (values))
+
+(defun tpl-hide (fname)
+  (unless (member fname *break-hidden-functions* :test #'eq)
+    (push fname *break-hidden-functions*)
+    (unless (ihs-visible *ihs-current*)
+      (set-current-ihs)))
+  (values))
+
+(defun tpl-unhide (fname)
+  (setq *break-hidden-functions*
+	(delete fname *break-hidden-functions* :test #'eq))
+  (values))
+
+(defun tpl-unhide-package (package)
+  (setq *break-hidden-packages*
+	(delete (find-package package) *break-hidden-packages* :test #'eq))
+  (values))
+
+(defun tpl-unhide-all ()
+  (setq *break-hidden-functions* nil)
+  (setq *break-hidden-packages* nil)
+  (values))
+
+(defun tpl-hide-package (package)
+  (setq package (find-package package))
+  (unless (member package *break-hidden-packages* :test #'eq)
+    (push package *break-hidden-packages*)
+    (unless (ihs-visible *ihs-current*)
+      (set-current-ihs)))
+  (values))
+
+(defun ihs-visible (i)
+  (let ((fname (ihs-fname i)))
+    #+clos
+    (when (and (consp fname) (eq 'SETF (car fname)))
+	  (setq fname (second fname)))
+    (or (eq fname 'EVAL)
+	(eq fname 'EVALHOOK)
+	(and (not (member (symbol-package fname) *break-hidden-packages*
+			  :TEST #'eq))
+	     (not (null fname))
+	     (not (member fname *break-hidden-functions* :TEST #'eq))))))
+
+(defun ihs-fname (i)
+  (let ((function (ihs-fun i)))
+    (cond ((symbolp function) function)
+          ((compiled-function-p function)
+           (or (compiled-function-name function) 'lambda))
+	  #+clos
+	  ((sys:gfunp function) (sys:gfun-name function))
+          (t :zombi))))
+
+(defun set-current-ihs ()
+  (do ((i *ihs-current* (1- i)))
+      ((or (and (ihs-visible i) (setq *ihs-current* i))
+	   (<= i *ihs-base*))))
+  (set-break-env))
+
+(defun set-break-env ()
+  (setq *break-env* (ihs-env *ihs-current*)))
+
+(defun tpl-backward-search (string)
+  (do ((ihs (1- *ihs-current*) (1- ihs)))
+      ((< ihs *ihs-base*)
+       (format *debug-io* "Search for ~a failed.~%" string))
+    (when (and (ihs-visible ihs)
+	       (search string (symbol-name (ihs-fname ihs))
+		       :test #'char-equal))
+      (setq *ihs-current* ihs)
+      (set-current-ihs)
+      (tpl-print-current)
+      (return)))
+  (values))
+
+(defun tpl-forward-search (string)
+  (do ((ihs (1+ *ihs-current*) (1+ ihs)))
+      ((> ihs *ihs-top*)
+       (format *debug-io* "Search for ~a failed.~%" string))
+    (when (and (ihs-visible ihs)
+	       (search string (symbol-name (ihs-fname ihs))
+		       :test #'char-equal))
+      (setq *ihs-current* ihs)
+      (set-current-ihs)
+      (tpl-print-current)
+      (return)))
+  (values))
+
+(defun tpl-apropos-command (&optional string pkg)
+  (when string (apropos string pkg)))
+
+(defun tpl-document-command (&optional symbol)
+  (when symbol (help symbol)))
+
+(defun tpl-step-command (&optional form)
+  (when form (step* form)))
+
+(defun tpl-trace-command (&rest functions)
+  (trace* functions))
+
+(defun tpl-untrace-command (&rest functions)
+  (untrace* functions))
+
+(defvar *tpl-last-load* nil)
+
+(defun tpl-load-command (&rest files)
+  (when files
+    (setq *tpl-last-load* files))
+  (dolist (file *tpl-last-load*) (load file))
+  *tpl-last-load*)
+
+(defvar *tpl-last-compile* nil)
+
+(defun tpl-compile-command (&rest files)
+  (when files
+    (setq *tpl-last-compile* files))
+  (dolist (file *tpl-last-compile*) (compile-file file))
+  (setq *tpl-last-load* *tpl-last-compile*))
+
+(defun tpl-help-command (&optional topic)
+  (cond ((null topic)
+	 (dolist (commands *tpl-commands*)
+	   (format t "~%~A:~%" (car commands))
+	   (dolist (c (cdr commands))
+	     (when (fourth c)
+	       (format t "~A.~%" (fourth c))))))
+	((or (stringp topic) (symbolp topic))
+	 (let (c)
+	   (setq topic (intern (string topic) (find-package 'keyword)))
+	   (dolist (commands *tpl-commands*)
+	     (when (setq c (assoc topic (cdr commands) :test #'member))
+	       (return)))
+	   (cond ((null (fifth c))
+		  (format t "No such help topic: ~s~%"
+			  (string topic)))
+		 (t
+		  (terpri)
+		  (format t (fifth c))
+		  (terpri)))))
+	(t
+	 (format t "Not a valid help topic: ~s~%" topic)))
+  (values))
+
+(defun tpl-help-stack-command ()
+  (format t "
+Use the following functions to directly access ECLS stacks.
+
+Invocation History Stack:
+(sys:IHS-TOP)	Returns the index of the TOP of the IHS.
+(SYS:IHS-VS i)	Returns the VS index of the i-th entity in IHS.
+(SYS:IHS-FUN i)	Returns the function of the i-th entity in IHS.
+
+Frame (catch, block) Stack:
+(sys:FRS-TOP)	Returns the index of the TOP of the FRS.
+(SYS:FRS-VS i)	Returns the VS index of the i-th entity in FRS.
+(SYS:FRS-BDS i)	Returns the BDS index of the i-th entity in FRS.
+(SYS:FRS-IHS i)	Returns the IHS index of the i-th entity in FRS.
+
+Binding Stack:
+(sys:BDS-TOP)	Returns the index of the TOP of the BDS.
+(SYS:BDS-VAR i)	Returns the symbol of the i-th entity in BDS.
+(SYS:BDS-VAL i)	Returns the value of the i-th entity in BDS.
+
+Note that these functions are named by external symbols in the SYSTEM
+package."
+))
diff --git a/src/lsp/trace.lsp b/src/lsp/trace.lsp
new file mode 100644
index 000000000..6cbdd06a3
--- /dev/null
+++ b/src/lsp/trace.lsp
@@ -0,0 +1,339 @@
+;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;;        Tracer package for Common Lisp
+
+(in-package "SYSTEM")
+
+(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+
+(defvar *trace-level* 0)
+(defvar *trace-list* nil)
+(defconstant +tracing-block+ (gensym))
+
+(defmacro trace (&rest r)
+  `(trace* ',r))
+
+(defun trace* (r)
+  (if (null r)
+    *trace-list*
+    (mapc #'trace-one r)))
+
+(defmacro untrace (&rest r)
+  `(untrace* ',r))
+
+(defun untrace* (r)
+  (mapc #'untrace-one (if (null r) *trace-list* r)))
+
+(defvar *inside-trace* nil)
+
+(defun trace-one (spec)
+  (let (break exitbreak (entrycond t) (exitcond t) entry exit
+	      step (barfp t) fname oldf)
+    (cond ((atom spec)
+	   (setq fname spec))
+	  ((eq 'SETF (car spec))
+	   (setq fname (get (cadr spec) 'SETF-SYMBOL)))
+	  ((atom (car spec))
+	   (setq fname (car spec))
+	   (do ((specs (cdr spec) (cdr specs)))
+	       ((null specs))
+	     (case (car specs)
+	       (:break (setq barfp specs specs (cdr specs) break (car specs)))
+	       (:break-after (setq barfp specs specs (cdr specs) exitbreak (car specs)))
+	       (:step (setq step t))
+	       (:cond (setq barfp specs specs (cdr specs))
+		      (setq exitcond (setq entrycond (car specs))))
+	       (:cond-before (setq barfp specs specs (cdr specs) entrycond (car specs)))
+	       (:cond-after (setq barfp specs specs (cdr specs) exitcond (car specs)))
+	       (:print (setq barfp specs specs (cdr specs) entry (car specs)))
+	       (:print-after (setq barfp specs specs (cdr specs) exit (car specs)))
+	       (t (error "Meaningless TRACE keyword: ~S" (car specs))))
+	     (unless barfp (error "Parameter missing"))))
+	  ((eq 'SETF (caar spec))
+	   (return-from trace-one
+	     (trace-one `(,(get (cadar spec) 'SETF-SYMBOL) . ,(cdr spec)))))
+	  (t
+	   (let (results)
+	       (dolist (fname (car spec))
+		 (push (trace-one `(,fname . ,(cdr spec))) results))
+	       (return-from trace-one (nreverse results)))))
+    (when (null (fboundp fname))
+      (format *trace-output* "The function ~S is not defined.~%" fname)
+      (return-from trace-one nil))
+    (when (special-form-p fname)
+      (format *trace-output* "~S is a special form.~%" fname)
+      (return-from trace-one nil))
+    (when (macro-function fname)
+      (format *trace-output* "~S is a macro.~%" fname)
+      (return-from trace-one nil))
+    (when (get fname 'TRACED)
+      (cond ((tracing-body fname)
+	     (format *trace-output*
+		     "The function ~S is already traced.~%" fname)
+	     (return-from trace-one nil))
+	    (t (untrace-one fname))))
+    (sys:fset (setq oldf (gensym)) (symbol-function fname))
+    (sys:putprop fname oldf 'TRACED)
+    (eval
+     `(defun ,fname (&rest args)
+	(block ,+tracing-block+		; used to recognize traced functions
+	  (let (values
+		(*trace-level* (1+ *trace-level*)))
+	    (if *inside-trace*
+		(setq values (multiple-value-list (apply ',oldf args)))
+		(let ((*inside-trace* t))
+		  ,@(when entrycond
+		       (if (eq t entrycond)
+			 `((trace-print 'ENTER ',fname args ,@entry))
+			 `((when ,entrycond
+			     (trace-print 'ENTER ',fname args ,@entry)))))
+		  ,@(when break
+		      `((when ,break (let (*inside-trace*)
+				       (break "tracing ~S" ',fname)))))
+		  (setq values
+			(let (*inside-trace*)
+			  (multiple-value-list
+			      ,(if step
+				   `(let (*step-quit*)
+				     (applyhook ',oldf args #'stepper nil))
+				   `(apply ',oldf args)))))
+		  ,@(when exitcond
+		      (if (eq t exitcond)
+			  `((trace-print 'EXIT ',fname values ,@exit))
+			  `((when ,exitcond
+			      (trace-print 'EXIT ',fname values ,@exit)))))
+		  ,@(when exitbreak
+		      `((when ,exitbreak
+			  (let (*inside-trace*)
+			    (break "after tracing ~S" ',fname)))))))
+	    (values-list values)))))
+  (push fname *trace-list*)
+  (cons fname nil)))
+
+(defun trace-print (direction fname vals &rest extras)
+  (let ((indent (min (* (1- *trace-level*) 2) 20)))
+    (fresh-line *trace-output*)
+    (case direction
+      (ENTER
+       (multiple-value-bind (bars rem)
+	   (floor indent 4)
+	 (dotimes (i bars) (princ "|   " *trace-output*))
+	 (when (plusp rem) (format *trace-output* "~V,,,' A" rem "|")))
+       (format *trace-output*
+	       "~D> (~S~{ ~S~})~%"
+	       *trace-level* fname vals))
+      (EXIT
+       (multiple-value-bind (bars rem)
+	   (floor indent 4)
+	 (dotimes (i bars) (princ "|   " *trace-output*))
+	 (when (plusp rem) (format *trace-output* "~V,,,' A" rem "|")))
+       (format *trace-output*
+	       "<~D (~S~{ ~S~})~%"
+	       *trace-level*
+	       fname vals)
+       ))
+    (when extras
+      (multiple-value-bind (bars rem)
+	  (floor indent 4)
+	(dotimes (i bars) (princ "|   " *trace-output*))
+	(when (plusp rem) (format *trace-output* "~V,,,' A" rem "|")))
+      (format *trace-output*
+	      "~0,4@T\\\\ ~{ ~S~}~%"
+	      extras))))
+
+(defun untrace-one (fname)
+  (cond ((get fname 'TRACED)
+         (if (tracing-body fname)
+	   (sys:fset fname (symbol-function (get fname 'TRACED)))
+	   (format *trace-output*
+		   "The function ~S was traced, but redefined.~%"
+		   fname))
+         (remprop fname 'TRACED)
+         (setq *trace-list* (delete fname *trace-list* :test #'eq))
+         (list fname))
+        (t
+         (format *trace-output* "The function ~S is not traced.~%" fname)
+         nil)))
+
+(defun tracing-body (fname &aux (fun (symbol-function fname)))
+  (when (functionp fun)
+    (let ((bytecodes (si::bytecodes-split fun)))
+      (when bytecodes
+	(dotimes (i (length bytecodes))
+	  (when (eq (aref bytecodes i) +tracing-block+)
+	    (return-from tracing-body t))))))
+  nil)
+
+(defvar *step-level* 0)
+(defvar *step-quit* nil)
+(defvar *step-function* nil)		; skip stepping until this function
+(defvar *step-form*)
+(defvar *step-env*)
+(defvar *step-tag* (cons nil nil))
+
+(defconstant step-commands
+  `("Stepper commands"
+     ((:newline) (step-next) :constant
+      "newline		Advance to the next form"
+      "newline						[Stepper command]~@
+	~@
+	Step to next form.~%")
+     ((:s :skip) step-skip nil
+      ":s(kip)		Skip current form or until function"
+      ":skip &optional arg				[Stepper command]~@
+	:s &optional arg				[Abbreviation]~@
+	~@
+	Continue evaluation without stepping.  Without argument, resume
+	stepping after the current form.  With numeric argument (n),
+	resume stepping at the n-th level above.  With function name, resume
+	when given function is called.~%")
+     ((:b :back) (tpl-pop-command) :constant
+      ":b(ack)		Step backward"
+      ":back						[Stepper command]~@
+	:b						[Abbreviation]~@
+	~@
+	Go back one step.~%")
+     ((:pr :print) (step-print) :constant
+      ":pr(int)	Pretty print current form"
+      ":print						[Stepper command]~@
+	:p						[Abbreviation]~@
+	~@
+	Pretty print current form.~%")
+     ((:form) *step-form* :constant
+      ":form		Current form"
+      ":form						[Stepper command]~@
+	~@
+	Return the current form.  Nothing is done, but the current form~@
+	is returned as the value of this command.  As a consequence,~@
+	it is printed by the top level in the usual way and saved in~@
+	the variable *.  The main purpose of this command is to allow~@
+	the current form to be examined further by accessing *.~%")
+     ((:ret :return) step-return :eval
+      ":ret(urn)	Return without evaluating current form"
+      ":return &eval &rest values			[Stepper command]~@
+	:ret &eval &rest values				[Abbreviation]~@
+	~@
+	Return from current form without evaluating it.~%")
+     ((:x :exit) (step-quit) :constant
+      ":x or :exit	Finish evaluation and exit stepper"
+      ":exit						[Stepper command]~@
+       :x						[Abbreviation]~@
+       ~@
+       Finish evaluation without stepping.~%")
+     ))
+
+(defmacro step (form)
+  `(step* ',form))
+
+(defun step* (form)
+  (let ((*step-quit* nil)
+	(*step-function* nil)
+	(*step-level* 0))
+    (stepper form nil)))
+
+(defun stepper (form &optional env)
+  (when (eq *step-quit* t)
+    (return-from stepper (evalhook form nil nil env)))
+  ;; skip the encapsulation of traced functions:
+  (when (and (consp form)
+	     (symbolp (car form))
+	     (get (car form) 'TRACED)
+	     (tracing-body (car form)))
+    (do ((args (cdr form) (cdr args))
+	 (values))
+	((null args)
+	 (return-from stepper
+	   (applyhook (car form) (nreverse values) #'stepper nil env)))
+      (push (evalhook (car args) #'stepper nil env) values)))
+  (when (numberp *step-quit*)
+    (if (>= *step-level* *step-quit*)
+      (return-from stepper (evalhook form nil nil env))
+      (setq *step-quit* nil)))
+  (when *step-function*
+    (if (and (consp form) (eq (car form) *step-function*))
+      (let ((*step-function* nil))
+	(return-from stepper (stepper form env)))
+      (return-from stepper (evalhook form #'stepper nil env))))
+  (let ((*step-level* (1+ *step-level*))
+	(*step-form* form)
+	(*step-env* env)
+	values indent prompt)
+    (setq indent (min (* *tpl-level* 2) 20))
+    (setq prompt
+	  #'(lambda ()
+	      (format *debug-io* "~VT" indent)
+	      (write form :stream *debug-io* :pretty nil
+		     :level 2 :length 2)
+	      (princ #\space *debug-io*)
+	      (princ #\- *debug-io*)))
+    (if (constantp form)
+      (progn
+	(format *debug-io* "~VT" indent)
+	(write form :stream *debug-io* :pretty nil
+	       :level 2 :length 2)
+	(princ #\space *debug-io*)
+	(princ #\= *debug-io*)
+	(setq values (multiple-value-list (evalhook form nil nil env)))
+	(dolist (v values)
+	  (princ #\space *debug-io*)
+	  (write v :stream *debug-io* :pretty nil :level 2 :length 2))
+	(terpri *debug-io*))
+      (progn
+	(setq values
+	      (catch *step-tag*
+		(tpl :quiet t
+		     :commands (adjoin step-commands
+				       (adjoin break-commands *tpl-commands*))
+		     :prompt-hook prompt)))
+	(if (endp values)
+	  (format *debug-io* "~V@T=~%" indent)
+	  (do ((l values (cdr l))
+	       (b t nil))
+	      ((endp l))
+	    (format *debug-io* "~V@T~C " indent (if b #\= #\&) (car l))
+	    (write (car l) :stream *debug-io* :pretty nil
+		   :level 2 :length 2)
+	    (terpri *debug-io*)))))
+    (values-list values)))
+
+(defun step-next ()
+  (throw *step-tag*
+	 (multiple-value-list
+	  (locally (declare (notinline evalhook))
+		   (evalhook *step-form* #'stepper nil *step-env*)))))
+
+(defun step-skip (&optional (when 0))
+  (throw *step-tag*
+	 (multiple-value-list
+	  (locally (declare (notinline evalhook))
+	   (cond ((symbolp when)
+		  (let ((*step-function* when))
+		    (evalhook *step-form* #'stepper nil *step-env*)))
+		 ((integerp when)
+		  (setq *step-quit* (- *step-level* when))
+		  (evalhook *step-form* nil nil *step-env*))
+		 (t
+		  (error "Skip: argument must be integer or symbol.")))))))
+
+(defun step-print ()
+  (write *step-form* :stream *debug-io* :pretty t :level nil :length nil)
+  (terpri)
+  (values))
+
+(defun step-quit ()
+  (setq *step-quit* t)
+  (throw *step-tag*
+	 (multiple-value-list
+	  (locally (declare (notinline evalhook))
+		   (evalhook *step-form* nil nil *step-env*)))))
+
+(defun step-return (&rest values)
+  (throw *step-tag* values))
+
+;(provide 'TRACE)
diff --git a/src/lsp/util.lsp b/src/lsp/util.lsp
new file mode 100644
index 000000000..914358923
--- /dev/null
+++ b/src/lsp/util.lsp
@@ -0,0 +1,15 @@
+(in-package "COMPILER")
+(defvar file-list
+  '( "defmacro.lsp" "evalmacros.lsp" "top.lsp"
+	"module.lsp" "predlib.lsp" "setf.lsp"
+	"arraylib.lsp" "assert.lsp" "defstruct.lsp"
+	"describe.lsp" "iolib.lsp" "listlib.lsp"
+	"mislib.lsp" "numlib.lsp" "packlib.lsp"
+	"seq.lsp" "seqlib.lsp" "trace.lsp" 
+	"thread.lsp" "loop.lsp"))
+
+(load "../cmp/make-declare.lsp")
+
+(dolist (file file-list)
+	(sys::proclaim-file file "/tmp/try.lsp"))
+
diff --git a/src/tests/ChangeLog b/src/tests/ChangeLog
new file mode 100644
index 000000000..685500a5c
--- /dev/null
+++ b/src/tests/ChangeLog
@@ -0,0 +1,93 @@
+1999-01-04  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * excepsit.tst: Delete some garbage "foo" files after creating them.
+        * Makefile: Don't delete them here.
+
+1999-01-03  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * conditions.tst: Check the superclasses of parse-error,
+          floating-point-invalid-operation, floating-point-inexact,
+          unbound-slot, print-not-readable, reader-error.
+
+1999-01-03  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * conditions.tst (style-warning): New test.
+
+1998-12-22  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * number2.tst: Add two XGCD tests.
+
+1998-12-21  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * number2.tst: Add a GCD test, which fails with egcs-1.1 on Sparc.
+
+1998-12-21  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * excepsit.tst: /etc/mtab does not exist on all systems, use
+          /etc/passwd instead.
+
+1998-12-21  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * loop.tst: Added a test for `by' preceding `from' preserving the
+          evaluation order.
+
+1998-12-18  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * excepsit.tst: Replaced the `delete-file' test (testing for EACCES
+          or EPERM) by another one (testing for ENOTDIR), in order to avoid
+          failure on Solaris, and in order not to upset people who mistakenly
+          run it as root.
+
+1998-11-06  Sam Steingold  <sds@goems.com>
+
+        * loop.tst: added a test for `by' preceding `upto'.
+
+1998-11-06  Sam Steingold  <sds@goems.com>
+
+        * type.tst: added a test for (un)signed-byte as sybtype of
+          integer.
+
+1998-11-01  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * alltest.tst, characters.tst, format.tst: Remove all tests of
+          characters with font and bits.
+          (iofkts.tst): Reflect change in STREAM-ELEMENT-TYPE.
+
+1998-10-20  Sam Steingold  <sds@goems.com>
+
+        * alltest.tst: added tests for `ldiff' and `tailp' handling
+	  of dotted lists (HyperSpec/Body/fun_ldiffcm_tailp.html).
+
+1998-10-15  Sam Steingold  <sds@goems.com>
+
+	* Makefile: remove /tmp/foo*.*.
+
+1998-09-09  Sam Steingold  <sds@goems.com>
+
+	* setf.tst: added multiple values `defsetf', `shiftf' and
+	  `rotatef' tests.
+
+1998-06-25  Bruno Haible  <bruno@linuix.math.u-bordeaux.fr>
+
+        * excepsit.tst: New file.
+        * tests.lsp (do-test): New function, taken out of run-test.
+          (do-errcheck): New function.
+          (run-test): Take the tester function as optional argument.
+          (run-all-tests): Run the excepsit tests.
+
+1998-06-20  Bruno Haible  <bruno@linuix.mathematik.uni-karlsruhe.de>
+
+        * setf.tst: Don't use quoted lambda expressions.
+
+1998-06-04  Bruno Haible  <bruno@linuix.mathematik.uni-karlsruhe.de>
+
+        * conditions.tst (my-cpl): Support ACL 5.0 beta.
+
+1997-06-19  Pierpaolo Bernardi  <bernardp@cli.di.unipi.it>
+	
+	* testsuite: (characters.tst, macro8.tst): Added two simple tests
+ 	  which fail on ACL.
+	
+1997-10-18  Bruno Haible  <bruno@linuix.mathematik.uni-karlsruhe.de>
+	
+	* testsuite: Support ACL 4.3 for Linux (Allegro CL from Franz Inc).
diff --git a/src/tests/GNU-GPL b/src/tests/GNU-GPL
new file mode 100644
index 000000000..12065f35c
--- /dev/null
+++ b/src/tests/GNU-GPL
@@ -0,0 +1,340 @@
+                    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
+
+        Appendix: 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/src/tests/Makefile b/src/tests/Makefile
new file mode 100644
index 000000000..0a7942e06
--- /dev/null
+++ b/src/tests/Makefile
@@ -0,0 +1,17 @@
+LISP = clisp
+RM = rm -f
+
+all : clean tests compare
+
+clean : force
+	$(RM) *.erg
+
+tests : force
+	$(LISP) -i tests.lsp -x '(run-all-tests)'
+
+compare : force
+	(echo *.erg | grep '\*') >/dev/null || (echo "Test failed." ; echo "To see which tests failed, type" ; echo "    cat *.erg" ; exit 1)
+	echo "Test passed."
+
+force :
+
diff --git a/src/tests/Makefile.in b/src/tests/Makefile.in
new file mode 100755
index 000000000..f6432681a
--- /dev/null
+++ b/src/tests/Makefile.in
@@ -0,0 +1,34 @@
+top_srcdir=@top_srcdir@
+srcdir=@srcdir@
+
+ECL = ../ecls
+TESTS = array backquot characters eval20 format hashlong iofkts lambda \
+	lists151 lists152 lists153 lists154 lists155 lists156 loop \
+	macro8 map number setf steele7 streams streamslong \
+	strings symbol10 symbols tprint tread type path \
+	ecl_chap14_cons ecl_chap14_plist ecl_chap12_spec \
+	ecl_chap11_pack alltest
+
+serious_test:
+	(echo '(load "$(srcdir)/tests")'; \
+	 echo "(run-all-tests \"$(srcdir)/\")"; \
+	 echo "(quit)") | $(ECL)
+	rm -f *.plc
+
+ecls_min_test:
+	(echo '(load "bare.lsp")'; \
+	 echo '(load "$(srcdir)/tests")'; \
+	 echo "(run-all-tests \"$(srcdir)/\" \"`pwd`/\")"; \
+	 echo "(quit)") | (cd ..; ./ecls_min)
+	rm -f *.plc
+
+$(TESTS):
+	(echo '(load "$(srcdir)/tests")'; \
+	 echo '(setf si::*gc-verbose* nil)'; \
+	 echo "(run-test \"$(srcdir)/$@.tst\" :logname \"$@.erg\" :logname2 \"$@.log\")"; \
+	 echo "(quit)") | $(ECL)
+	test -f $@.erg && cat $@.erg
+	rm -f *.plc
+
+clean:
+	rm -f *.plc *.out *.txt *.erg
diff --git a/src/tests/README b/src/tests/README
new file mode 100644
index 000000000..3303435cc
--- /dev/null
+++ b/src/tests/README
@@ -0,0 +1,78 @@
+This directory contains a test suite for testing Common Lisp (CLtL1)
+implementations.
+
+In its original version it was built by
+
+    Horst Friedrich, ISST of FhG         <horst.friedrich@isst.fhg.de>
+    Ingo Mohr, ISST of FhG               <ingo.mohr@isst.fhg.de>
+    Ulrich Kriegel, ISST of FhG          <ulrich.kriegel@isst.fhg.de>
+    Windfried Heicking, ISST of FhG      <winfried.heicking@isst.fhg.de>
+    Rainer Rosenmueller, ISST of FhG     <rainer.rosenmueller@isst.fhg.de>
+
+at
+
+    Institut für Software- und Systemtechnik der Fraunhofer-Gesellschaft
+    (Fraunhofer Institute for Software Engineering and Systems Engineering)
+    Kurstraße 33
+  D-10117 Berlin
+    Germany
+
+for their Common Lisp implementation named XCL.
+
+What you see here is a version adapted to CLISP and AKCL by
+
+    Bruno Haible              <haible@ma2s2.mathematik.uni-karlsruhe.de>
+
+at
+
+    Universität Karlsruhe
+    Mathematisches Institut II
+    Kaiserstraße 12
+  D-76131 Karlsruhe
+    Germany
+
+
+Operation:
+----------
+
+The files *.tst contain test forms and their corresponding results.
+You may feed the test forms one by one to an interpreter and compare the
+results you get with the predicted ones.
+
+This tasks is automated by tests.lsp. Run
+
+      > (load "tests")
+      > (run-all-tests)
+
+The differences between the results and the predicted ones are
+recorded in *.erg files. Empty *.erg files are removed.
+If you can't find any *.erg files after running the tests, then your
+implementation has passed the tests!
+
+
+Notes:
+------
+
+* The test suite covers only CLtL1.
+
+* The test suite is not "complete" in any sense. Anyway, it may be useful:
+  It has uncovered at least five severe bugs in CLISP and nineteen bugs
+  in AKCL.
+
+* Some results are implementation dependent. When using other implementations
+  than XCL, CLISP and AKCL, you may wish to insert your "predicted results",
+  protected by #+ and #-. Think twice before doing so as you may be
+  deliberately ignoring a bug in your implementation.
+
+* The tests "hash", "readtable", "tread", "tprint" are currently not used
+  by tests.lsp.
+
+* Additions are welcome.
+
+
+Copyright:
+----------
+
+This test suite is copyrighted by the ISST of FhG and may be distributed
+under the terms of the GNU General Public License (see file GNU-GPL).
+
diff --git a/src/tests/README.ECL b/src/tests/README.ECL
new file mode 100644
index 000000000..5283f2389
--- /dev/null
+++ b/src/tests/README.ECL
@@ -0,0 +1,13 @@
+This test-suite has been revised to work with ECL. To use it, just unpack
+the tar-ball on top of the latest ECL release and perform a
+
+	cd build
+	cd tests
+	make
+
+You will find two types of output files:
+
+	*.out	The whole output of a test
+	*.erg	The errors arising from a test
+
+When there is no *.erg, it means that ECL passed the test.
diff --git a/src/tests/alltest.tst b/src/tests/alltest.tst
new file mode 100644
index 000000000..2315b258e
--- /dev/null
+++ b/src/tests/alltest.tst
@@ -0,0 +1,2249 @@
+;*******************************************************************************
+;*                      Kurztest        XCL                                    *
+;*******************************************************************************
+;Kap. 1 Einfuehrung
+;-------------------------------------------------------------------------------
+;Kap. 2  Datentypen
+;-------------------------------------------------------------------------------
+;Kap. 3  Gueltigkeitsbereiche
+;-------------------------------------------------------------------------------
+;Kap. 4  Typspezifier
+;-------------------------------------------------------------------------------
+;
+;deftype, COERCE, TYPE-OF
+;
+;Kap. 5  Programmstrukturen
+;-------------------------------------------------------------------------------
+;
+;Lambda-Listen
+((LAMBDA (A B) (+ A (* B 3))) 4 5)
+19
+
+((LAMBDA (A &OPTIONAL (B 2)) (+ A (* B 3))) 4 5)
+19
+
+((LAMBDA (&OPTIONAL (A 2 B) (C 3 D) &REST X) (LIST A B C D X)))
+(2 NIL 3 NIL NIL)
+
+((LAMBDA (A B &KEY C D) (LIST A B C D)) 1 2)
+(1 2 NIL NIL)
+
+((LAMBDA (A &OPTIONAL (B 3) &REST X &KEY C (D A)) (LIST A B C D X))
+1)
+(1 3 NIL 1 NIL)
+
+((LAMBDA (X &AUX (A 3) (B 4)) (+ X (* A B))) 2)
+14
+
+((LAMBDA (X Y &OPTIONAL A B &REST Z &KEY C (D Y) &AUX (U 3) (V 4))
+
+(+ X Y A (* B (CAR Z)) C (* D U) V)) 3 4 5 2 7 :C 6 :D 8)
+ERROR
+
+((LAMBDA (X Y) ((LAMBDA (A B) (LIST A B)) (QUOTE U) (QUOTE V))) 5 6)
+
+(U V)
+
+((LAMBDA (X &ALLOW-OTHER-KEYS) (LIST X Y)) 2 :Y 3)
+ERROR
+
+lambda-list-keywords
+#+XCL (&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX &BODY &WHOLE SYSTEM::&ENVIRONMENT)
+#+CLISP (&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX &BODY &WHOLE &ENVIRONMENT)
+#+AKCL (&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX &WHOLE &ENVIRONMENT &BODY)
+#+ALLEGRO (&OPTIONAL &REST &KEY &AUX &BODY &WHOLE &ALLOW-OTHER-KEYS &ENVIRONMENT)
+#+ECLS (&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX &WHOLE &ENVIRONMENT &BODY)
+#-(or XCL CLISP AKCL ALLEGRO ECLS) UNKNOWN
+
+(let ((s (prin1-to-string LAMBDA-PARAMETERS-LIMIT )))
+  (or #+XCL (equal s "128")
+      #+CLISP (equal s "65536") #+CLISP (equal s "4294967296")
+      #+AKCL (equal s "64")
+      #+ALLEGRO (equal s "16384")
+) )
+T
+
+;DEFVAR, DEFCONSTANT, DEFPARAMETER, eval-when
+
+;Kap 6 Praedikate
+;-------------------------------------------------------------------------------
+
+(TYPEP (QUOTE NIL) (QUOTE NULL))
+T
+
+(TYPEP (QUOTE (A B C)) (QUOTE NULL))
+NIL
+
+(TYPEP (QUOTE ABC) (QUOTE SYMBOL))
+T
+
+(TYPEP 4 (QUOTE ATOM))
+T
+
+(TYPEP 55 (QUOTE CONS))
+NIL
+
+(TYPEP (QUOTE (A (B C))) (QUOTE LIST))
+T
+
+(TYPEP 5/8 (QUOTE NUMBER))
+T
+
+(TYPEP -800 (QUOTE INTEGER))
+T
+
+(TYPEP 5/7 (QUOTE RATIONAL))
+T
+
+(TYPEP 2.718 (QUOTE FLOAT))
+T
+
+(TYPEP #C(1.23 3.56) (QUOTE FLOAT))
+NIL
+
+(TYPEP #\a (QUOTE CHARACTER))
+T
+
+(TYPEP "abc" (QUOTE STRING))
+T
+
+(TYPEP '#(1 2 3) (QUOTE STRING))
+NIL
+
+(TYPEP '#(A B C) (QUOTE BIT-VECTOR))
+NIL
+
+(TYPEP '#(A B C) (QUOTE VECTOR))
+T
+
+(TYPEP "abc" (QUOTE VECTOR))
+T
+
+(TYPEP '#(1 2 3 4) (QUOTE SIMPLE-VECTOR))
+T
+
+(TYPEP 3 (QUOTE SIMPLE-VECTOR))
+NIL
+
+(TYPEP "a b cd" (QUOTE SIMPLE-STRING))
+T
+
+(TYPEP (QUOTE ABC) (QUOTE SIMPLE-STRING))
+NIL
+
+(TYPEP #*1101 (QUOTE SIMPLE-BIT-VECTOR))
+T
+
+(TYPEP '#(1 0 0 1) (QUOTE SIMPLE-BIT-VECTOR))
+NIL
+
+(TYPEP '#2A((A B)(C D)) (QUOTE ARRAY))
+T
+
+(SETQ X 7)
+7
+
+(TYPEP X (QUOTE COMPILED-FUNCTION))
+NIL
+
+(TYPEP X (QUOTE COMMON))
+#-ANSI-CL T #+ANSI-CL ERROR
+
+(SUBTYPEP (QUOTE CHARACTER) (QUOTE NUMBER))
+NIL
+
+(SUBTYPEP (QUOTE NUMBER) (QUOTE CHARACTER))
+NIL
+
+(SUBTYPEP (QUOTE STRING) (QUOTE NUMBER))
+NIL
+
+(SUBTYPEP (QUOTE COMPLEX) (QUOTE NUMBER))
+T
+
+(SUBTYPEP (QUOTE FLOAT) (QUOTE NUMBER))
+T
+
+(SUBTYPEP (QUOTE FIXNUM) (QUOTE NUMBER))
+T
+
+(SUBTYPEP (QUOTE RATIONAL) (QUOTE NUMBER))
+T
+
+(SUBTYPEP (QUOTE FLOAT) (QUOTE COMPLEX))
+NIL
+
+(SUBTYPEP (QUOTE INTEGER) (QUOTE RATIONAL))
+T
+
+(SUBTYPEP (QUOTE NUMBER) (QUOTE VECTOR))
+NIL
+
+(SUBTYPEP (QUOTE VECTOR) (QUOTE ARRAY))
+T
+
+(SUBTYPEP (QUOTE NUMBER) (QUOTE ARRAY))
+NIL
+
+(NULL (QUOTE NIL))
+T
+
+(SYMBOLP *STANDARD-INPUT*)
+NIL
+
+(SYMBOLP (QUOTE CAR))
+T
+
+(ATOM (QUOTE ABC))
+T
+
+(CONSP (ACONS (QUOTE X) (QUOTE Y) (QUOTE A)))
+#+XCL ERROR #+(or CLISP AKCL ALLEGRO) T #-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(LISTP (QUOTE (((A . B) . C))))
+T
+
+(LISTP 'A)
+NIL
+
+(LISTP NIL)
+T
+
+(LISTP '(A B C))
+T
+
+(NUMBERP #*101)
+NIL
+
+(NUMBERP -5)
+T
+
+(INTEGERP 5)
+T
+
+(INTEGERP #\+)
+NIL
+
+(RATIONALP 0)
+T
+
+(FLOATP -5)
+NIL
+
+(FLOATP (READ-FROM-STRING "1.0e30"))
+T
+
+(FLOATP 123.4)
+T
+
+(COMPLEXP 1/2)
+NIL
+
+(COMPLEXP #C(2 3))
+T
+
+(CHARACTERP #\1)
+T
+
+(STRINGP "abc")
+T
+
+(STRINGP :+*/-)
+NIL
+
+(BIT-VECTOR-P (READ-FROM-STRING "#5*01110"))
+T
+
+(VECTORP "abc")
+T
+
+(SIMPLE-VECTOR-P #*101)
+NIL
+
+(SIMPLE-STRING-P "abc")
+T
+
+(SIMPLE-STRING-P :+*/-)
+NIL
+
+(SIMPLE-BIT-VECTOR-P #*101)
+T
+
+(ARRAYP (READ-FROM-STRING "#7(2 4 3)"))
+T
+
+(ARRAYP (QUOTE (READ-FROM-STRING "#1a 5.77")))
+NIL
+
+(PACKAGEP (READ-FROM-STRING "#5*01110"))
+NIL
+
+(PACKAGEP *PACKAGE*)
+T
+
+(FUNCTIONP (QUOTE ATOM))
+#-(or CLtL2 ANSI-CL CLISP) T #+(or CLtL2 ANSI-CL CLISP) NIL
+
+(COMPILED-FUNCTION-P (QUOTE DO))
+NIL
+
+;COMMONP
+
+(EQ (QUOTE (1 2 3 4 5)) (COPY-LIST (QUOTE (1 2 3 4 5))))
+NIL
+
+(SETQ X '((1 . A) (2 . B) (3 . C)) )
+((1 . A) (2 . B) (3 . C))
+
+(EQ (CADR X) (CADR (COPY-ALIST X)))
+NIL
+
+(EQ #\A #\A)
+T
+
+(EQ "Foo" "Foo")
+NIL
+
+(EQ "Foo" (COPY-SEQ "Foo"))
+NIL
+
+(EQL #C(3.0 -4.0) #C(3 -4))
+nil
+
+(EQL (CONS (QUOTE A) (QUOTE B)) (CONS (QUOTE A) (QUOTE C)))
+NIL
+
+(EQUAL (QUOTE (1 2 3 4 5)) (COPY-LIST (QUOTE (1 2 3 4 5))))
+T
+
+(EQUAL X (COPY-ALIST X))
+T
+
+(EQUAL 3 3)
+T
+
+(EQUAL 3 3.0)
+NIL
+
+(EQUAL 3.0 3.0)
+T
+
+(EQUAL #C(3 -4) #C(3 -4))
+T
+
+(EQUALP (QUOTE (1 2 3 4 5)) (COPY-LIST (QUOTE (1 2 3 4 5))))
+T
+
+(EQUALP "            foo" "            FOO")
+T
+
+(EQUALP "            fou" "            FOO")
+NIL
+
+(NOT 1)
+NIL
+
+(NOT NIL)
+T
+
+(AND (EQ 1 2) (EQ 2 3) (EQ 3 4) (EQ 4 4))
+NIL
+
+(AND (EQ 1 2) (EQ 3 3) (EQ 3 4) (EQ 4 4))
+NIL
+
+(OR (EQ 2 2) (EQ 3 3) (EQ 3 4) (EQ 4 4))
+T
+
+(OR (EQ 1 2) (EQ 2 3) (EQ 3 4) (EQ 4 5))
+NIL
+
+;Kap 7 KONTROLLSTRUCTUREN
+;-------------------------------------------------------------------------------
+
+; quote, FUNCTION, SYMBOL-VALUE, SYMBOL-FUNCTION, BOUNDP, FBOUNDP,
+; SPECIAL-FORM-P, SETQ, PSETQ, SET, MAKUNBOUND, FMAKUNBOUND,
+
+(SETQ LI1 (QUOTE (A (B) ((C) (D)))))
+(A (B) ((C) (D)))
+
+(SETQ VEC1 '#(0 1 2 3))
+#(0 1 2 3)
+
+(SETF (NTH 1 LI1) (QUOTE UU))
+UU
+
+(EVAL (QUOTE LI1))
+(A UU ((C) (D)))
+
+(SETF (ELT LI1 1) (QUOTE OO))
+OO
+
+(SETF (ELT VEC1 1) (QUOTE OO))
+OO
+
+(EVAL (QUOTE LI1))
+(A OO ((C) (D)))
+
+(EVAL (QUOTE VEC1))
+#(0 OO 2 3)
+
+(SETF (REST LI1) (QUOTE ((WW))))
+((WW))
+
+(EVAL (QUOTE LI1))
+(A (WW))
+
+(SETF (FIRST LI1) (QUOTE AA))
+AA
+
+(FIRST LI1)
+AA
+
+(SETF (SECOND LI1) (QUOTE BB))
+BB
+
+(EVAL (QUOTE LI1))
+(AA BB)
+
+(SETF (REST LI1) (QUOTE (2 3 4 5 6 7 8 9 10)))
+(2 3 4 5 6 7 8 9 10)
+
+(SETF (SECOND LI1) 22)
+22
+
+(EVAL (QUOTE LI1))
+(AA 22 3 4 5 6 7 8 9 10)
+
+(SETF (THIRD LI1) (QUOTE 33))
+33
+
+(SETF (FOURTH LI1) (QUOTE 44))
+44
+
+(SETF (FIFTH LI1) (QUOTE 55))
+55
+
+(SETF (SIXTH LI1) (QUOTE 66))
+66
+
+(SETF (SEVENTH LI1) (QUOTE 77))
+77
+
+(SETF (EIGHTH LI1) (QUOTE 88))
+88
+
+(SETF (NINTH LI1) (QUOTE 99))
+99
+
+(SETF (TENTH LI1) (QUOTE 1010))
+1010
+
+(EVAL (QUOTE LI1))
+(AA 22 33 44 55 66 77 88 99 1010)
+
+(SETF (FIRST LI1) (QUOTE (((A)))))
+(((A)))
+
+(SETF (CAAAR LI1) (QUOTE UU))
+UU
+
+(CAAAR LI1)
+UU
+
+(CAR LI1)
+((UU))
+
+(SETF (CAAR LI1) (QUOTE OO))
+OO
+
+(EVAL (QUOTE LI1))
+((OO) 22 33 44 55 66 77 88 99 1010)
+
+(SETF (CAR LI1) (QUOTE II))
+II
+
+(EVAL (QUOTE LI1))
+(II 22 33 44 55 66 77 88 99 1010)
+
+(SETF (CDDDR LI1) (QUOTE PP))
+PP
+
+(EVAL (QUOTE LI1))
+(II 22 33 . PP)
+
+(SETF (CADDR LI1) (QUOTE 333))
+333
+
+(EVAL (QUOTE LI1))
+(II 22 333 . PP)
+
+(SETF (SVREF VEC1 2) (QUOTE KK))
+KK
+
+(EVAL (QUOTE VEC1))
+#(0 OO KK 3)
+
+(SETF (GET (QUOTE A) (QUOTE B)) (QUOTE UU))
+UU
+
+(GET (QUOTE A) (QUOTE B))
+UU
+
+(SETF (GETF (CADR (SETQ XX (QUOTE (AAA (I1 V1 I2 V2))))) (QUOTE I2))
+
+(QUOTE V222))
+V222
+
+(EVAL (QUOTE XX))
+(AAA (I1 V1 I2 V222))
+
+(GETF (CADR XX) (QUOTE I2))
+V222
+
+(GETF (CADR XX) (QUOTE I1))
+V1
+
+(SETF (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP1)) "doc 1")
+"doc 1"
+
+(SETF (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2)) "doc 2")
+"doc 2"
+
+(DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2))
+#+XCL (TYP2 . "doc 2") #-XCL "doc 2"
+
+(SETF (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2)) "doc 3")
+"doc 3"
+
+(DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2))
+#+XCL (TYP2 . "doc 3") #-XCL "doc 3"
+
+(symbol-plist 'beispiel)
+#+XCL (DOCUMENTATION ((TYP2 . "doc 3") (TYP1 . "doc 1")))
+#+CLISP (SYSTEM::DOCUMENTATION-STRINGS (TYP2 "doc 3" TYP1 "doc 1"))
+#+ALLEGRO (EXCL::%DOCUMENTATION ((TYP2 . "doc 3") (TYP1 . "doc 1")))
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(SETF (SYMBOL-VALUE (QUOTE XX)) (QUOTE VOELLIGNEU))
+VOELLIGNEU
+
+(EVAL (QUOTE XX))
+VOELLIGNEU
+
+;PSETF, SHIFTF, ROTATEF, DEFINE-MODIFY-MACRO, DEFSETF, DEFINE-SETF-METHOD,
+;GET-SETF-METHOD, GET-SETF-METHOD-MULTIPLE-VALUE, APPLY, FUNCALL, PROGN,
+;PROG1, PROG2,
+
+(LET ((X (LIST (QUOTE A) (QUOTE B) (QUOTE C)))) (RPLACD (LAST X) X)
+
+(LIST-LENGTH X))
+NIL
+
+;LET*, COMPILER-LET, PROGV, FLET, LABELS, MACROLET, IF, WHEN, UNLESS, COND,
+;CASE, TYPECASE, BLOCK, LOOP, DO, DO*, DOLIST, DOTIMES,
+
+(MAPCAR (FUNCTION (LAMBDA (X) (LIST X))) (QUOTE (A B C)))
+((A) (B) (C))
+
+(MAPC (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+(A B C)
+
+(MAPL (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+(A B C)
+
+(MAPLIST (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C))
+(QUOTE (1 2 3)) (QUOTE (U I V)))
+(((A B C) (1 2 3) (U I V)) ((B C) (2 3) (I V)) ((C) (3) (V)))
+
+(MAPCON (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+((A B) (1 2 3) (U I V) (B) (2 3) (I V))
+
+(MAPCAN (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+(A 1 U B 2 I C 3 V)
+
+;TAGBODY, GO, MULTIPLE-VALUE-LIST, MULTIPLE-VALUE-CALL, MULTIPLE-VALUE-PROG1,
+;MULTIPLE-VALUE-BIND, MULTIPLE-VALUE-SETQ, VALUES, VALUES-LIST, CATCH,
+
+;UNWIND-PROTECT, THROW,
+
+;Kap 8 MACROS
+;-------------------------------------------------------------------------------
+
+;MACRO-FUNCTION, DEFMACRO, MACROEXPAND, MACROEXPAND-1,
+
+;Kap 9 DECLARATIONEN
+;-------------------------------------------------------------------------------
+
+;DECLARE, LOCALLY, PROCLAIM, THE,
+
+;Kap 10 SYMBOLE
+;-------------------------------------------------------------------------------
+
+;GET, REMPROP, SYMBOL-PLIST, GETF, REMF, GET-PROPERTIES, SYMBOL-NAME,
+
+;MAKE-SYMBOL, COPY-SYMBOL, GENSYM, GENTEMP, SYMBOL-PACKAGE,
+
+(KEYWORDP 36)
+NIL
+
+(KEYWORDP :RENAME)
+T
+
+;Kap 11 PAKETE
+;-------------------------------------------------------------------------------
+
+;FIND-PACKAGE, IN-PACKAGE, LIST-ALL-PACKAGES, MAKE-PACKAGE, PACKAGE-NAME,
+;PACKAGE-NICKNAMES, PACKAGE-SHADOWING-SYMBOLS, PACKAGE-USE-LIST,
+;PACKAGE-USED-BY-LIST, RENAME-PACKAGE, UNUSE-PACKAGE, USE-PACKAGE, INTERN,
+;UNINTERN, FIND-SYMBOL, EXPORT, UNEXPORT, IMPORT, SHADOWING-IMPORT, SHADOW,
+;FIND-ALL-SYMBOLS, DO-SYMBOLS, DO-EXTERNAL-SYMBOLS, DO-ALL-SYMBOLS,
+;PROVIDE, REQUIRE,
+
+;Kap 12 ZAHLEN
+;-------------------------------------------------------------------------------
+
+(ZEROP -456)
+NIL
+
+(ZEROP 0)
+T
+
+(PLUSP 3)
+T
+
+(PLUSP 3453786543987565)
+T
+
+(MINUSP -456)
+T
+
+(ODDP -1)
+T
+
+(ODDP 0)
+NIL
+
+(EVENP -456)
+T
+
+(EVENP -345)
+NIL
+
+(= 5/2 2.5)
+T
+
+(/= 3.0 3)
+NIL
+
+(/= 3.0 #C(3.0 1.0))
+T
+
+(< 3.0 3)
+NIL
+
+(< 3 3.0 3 #C(3.0 0.0))
+#+ALLEGRO NIL #-ALLEGRO ERROR
+
+(< -5 -4 -2 0 4 5)
+T
+
+(> 8 7 6 5 4)
+T
+
+(> 3 3.0 3 #C(3.0 0.0))
+#+ALLEGRO NIL #-ALLEGRO ERROR
+
+(<= 3.0 3)
+T
+
+(<= 3 3)
+T
+
+(<= 1 3 3 2 5)
+NIL
+
+(<= 5/2 2.5)
+T
+
+(>= -5 -4 -2 0 4 5)
+NIL
+
+(MAX 1 3 2 -7)
+3
+
+;MIN,
+
+(+ 1 1/2 0.5 #C(3.0 5.5))
+#C(5.0 5.5)
+
+(- 3 0 3 5 -6)
+1
+
+(- #C(0 6) 1/4 0.5 7)
+#C(-7.75 6.0)
+
+(* 7 6 5 4 3 2 1)
+5040
+
+(* 2 2 2.0 2)
+16.0
+
+(/ -8)
+-1/8
+
+(/ 4 2)
+2
+
+(1+ 0)
+1
+
+(1+ #C(0 1))
+#C(1 1)
+
+(1- 5.0)
+4.0
+
+;INCF, DECF,
+
+(CONJUGATE #C(3/5 4/5))
+#C(3/5 -4/5)
+
+(GCD 91 -49)
+7
+
+(LCM 14 35)
+70
+
+(PRIN1-TO-STRING (EXP 1) )
+"2.7182817" ; "2.718282"
+
+(EXPT #C(0 1) 2)
+-1
+
+(PRIN1-TO-STRING (EXPT 2 #C(0 1)) )
+"#C(0.7692389 0.63896126)" ; "#C(0.7692389 0.6389612)"
+
+(PRIN1-TO-STRING (LOG -3 10) )
+"#C(0.47712126 1.3643764)" ; "#C(0.4771213 1.364376)"
+
+(LOG 3 0)
+#+XCL 0 #+ALLEGRO 0.0 #-(or XCL ALLEGRO) ERROR
+
+(SQRT 9)
+3.0
+
+(SQRT -9.0)
+#C(0.0 3.0)
+
+(ISQRT 9)
+3
+
+(ISQRT 26)
+5
+
+(ABS 6)
+6
+
+(ABS -6)
+6
+
+;PHASE,
+
+(SIGNUM 0)
+0
+
+(SIGNUM -4)
+-1
+
+(SIGNUM 4)
+1
+
+(PRIN1-TO-STRING (SIN (* 8 (/ PI 2))) )
+#+XCL "-4.576950980887866D-17"
+#+CLISP "2.0066230454737344098L-19"
+#+AKCL "-4.898425415289509E-16"
+#+ALLEGRO "-4.898425415289509d-16"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(PRIN1-TO-STRING (SIN (EXPT 10 3)) )
+"0.82687956" ; "0.8268796"
+
+(COS 0)
+1.0
+
+(PRIN1-TO-STRING (COS (/ PI 2)) )
+#+XCL "5.721188726109832D-18"
+#+CLISP "-2.5082788076048218878L-20"
+#+AKCL "6.1230317691118863E-17"
+#+ALLEGRO "6.123031769111886d-17"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(PRIN1-TO-STRING (TAN 1) )
+"1.5574077" ; "1.557408"
+
+(PRIN1-TO-STRING (TAN (/ PI 2)) )
+#+XCL "1.747888503373944D17"
+#+CLISP "-3.986797629004264116L19"
+#+AKCL "1.6331778728383844E16"
+#+ALLEGRO "1.6331778728383844d+16"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(prin1-to-string (CIS -1) )
+"#C(0.5403023 -0.84147096)" ; "#C(0.5403023 -0.8414709)"
+
+(CIS 2.5)
+#C(-0.8011436 0.5984721)
+
+(prin1-to-string (ASIN -1) )
+"-1.5707964" ; "-1.570796"
+
+(ASIN 0)
+0.0
+
+(ASIN 2)
+#C(1.5707964 -1.316958)
+
+(prin1-to-string (ACOS 0) )
+"1.5707964" ; "1.570796"
+
+(prin1-to-string (ACOS -1) )
+"3.1415927" ; "3.141593"
+
+(prin1-to-string (ACOS 2) )
+#+XCL "#C(0.0 1.316958)" #+CLISP "#C(0 1.316958)" #+ALLEGRO "#c(0.0 1.316958)"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(ACOS 1.00001)
+#+ganz-korrekt #C(0.0 0.0044721322)
+#+XCL #C(0.0 0.004475157)
+#+CLISP-korrekt #C(0.0 0.0044751678) ; da schon 1.00001 gerundet wurde
+#+CLISP         #C(0.0 0.0044751023) ; i * ln(x+sqrt(x^2-1))
+#+CLISP-anders  #C(0.0 0.0044752206) ; i * ln(x+sqrt((x-1)*(x+1)))
+#+ALLEGRO #C(0.0 0.004475168)
+#-(or XCL CLISP ALLEGRO) #C(0.0 0.0044721322)
+
+(ATAN 1)
+#+(or XCL ALLEGRO) 0.7853982 #+CLISP 0.7853981 #-(or XCL ALLEGRO CLISP) UNKNOWN
+
+(prin1-to-string PI )
+#+XCL "3.141592653589793D0"
+#+CLISP "3.1415926535897932385L0"
+#+ALLEGRO "3.141592653589793d0"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(SINH 0)
+0.0
+
+(prin1-to-string (SINH #C(5.0 -9.6)) )
+"#C(-73.06699 12.93681)"
+
+(COSH 0)
+1.0
+
+(prin1-to-string (COSH 1) )
+"1.5430806" ; "1.543081"
+
+(TANH 50)
+1.0
+
+(prin1-to-string (TANH 0.00753) )
+#-ALLEGRO "0.0075298576" #+ALLEGRO "0.0075298795" ; "0.007529857"
+
+(prin1-to-string (ASINH 0.5) )
+#-ALLEGRO "0.48121184" #+ALLEGRO "0.4812118" ; "0.4812118"
+
+(prin1-to-string (ASINH 3/7) )
+#-(or CLISP ALLEGRO) "0.4164308"
+#+CLISP "0.4164307" ; Rundungsfehler
+#+ALLEGRO "0.41643077"
+
+(ACOSH 0)
+#C(0 1.5707964)
+
+(ACOSH 1)
+0
+
+(ACOSH -1)
+#C(0 3.1415927)
+
+(prin1-to-string (ATANH 0.5) )
+"0.54930615" ; "0.5493061"
+
+(prin1-to-string (ATANH 3/7) )
+#-(or CLISP ALLEGRO) "0.4581454"
+#+CLISP "0.4581453" ; Rundungsfehler
+#+ALLEGRO "0.45814538"
+
+(= (SIN (* #C(0 1) 5)) (* #C(0 1) (SINH 5)))
+T
+
+(= (COS (* #C(0 1) 5)) (COSH 5))
+T
+
+(= (TAN (* #C(0 1) 5)) (* #C(0 1) (TANH 5)))
+t
+
+(= (SINH (* #C(0 1) 5)) (* #C(0 1) (SIN 5)))
+T
+
+(= (COSH (* #C(0 1) 5)) (COS 5))
+T
+
+(FLOAT 1)
+1.0
+
+(FLOAT 0.5)
+0.5
+
+(RATIONAL 2)
+2
+
+(RATIONAL 2.0)
+2
+
+(RATIONAL 2.5)
+5/2
+
+(RATIONALIZE 2.5)
+5/2
+
+(RATIONALIZE 7/3)
+7/3
+
+(RATIONALIZE PI)
+#+XCL 28296953155597409/9007199254740992
+#+CLISP 8717442233/2774848045
+#+ALLEGRO 245850922/78256779
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(NUMERATOR 5/2)
+5
+
+(NUMERATOR (/ 8 -6))
+-4
+
+(DENOMINATOR 5/2)
+2
+
+(DENOMINATOR (/ 8 -6))
+3
+
+(GCD (NUMERATOR 7/9) (DENOMINATOR 7/9))
+1
+
+(FLOOR 2.6)
+2
+
+(FLOOR 2.5)
+2
+
+(CEILING 2.6)
+3
+
+(CEILING 2.5)
+3
+
+(CEILING 2.4)
+3
+
+(TRUNCATE 2.6)
+2
+
+(TRUNCATE 2.5)
+2
+
+(TRUNCATE 2.4)
+2
+
+(ROUND 2.6)
+3
+
+(ROUND 2.5)
+2
+
+(ROUND 2.4)
+2
+
+(MOD 13 4)
+1
+
+(MOD -13 4)
+3
+
+(prin1-to-string (REM 13.4 1) )
+#-(or CLISP ALLEGRO) "0.4" ; #+XCL "0.3999996"
+#+(or CLISP ALLEGRO) "0.39999962" ; Rundungsfehler
+
+(FFLOOR 2.6)
+2
+
+(FFLOOR 2.5)
+2
+
+(FFLOOR 2.4)
+2
+
+(FCEILING -0.3)
+0
+
+(FCEILING -0.7)
+0
+
+(FCEILING -2.4)
+-2
+
+(FTRUNCATE 2.5)
+2.0
+
+(FTRUNCATE 2.4)
+2.0
+
+(FROUND -0.7)
+-1.0
+
+(FROUND -2.4)
+-2.0
+
+(DECODE-FLOAT 35.0)
+0.546875
+
+(DECODE-FLOAT 3.5S0)
+0.875S0
+
+(SCALE-FLOAT 2.5 5)
+80.0
+
+(SCALE-FLOAT 0.7541 2)
+3.0164
+
+(FLOAT-RADIX 2.5)
+2
+
+(FLOAT-RADIX 3.5D0)
+2
+
+;FLOAT-DIGITS, FLOAT-PRECISION, FLOAT-SIGN, INTEGER-DECODE-FLOAT,
+
+(COMPLEX 1/4 7.3)
+#C(0.25 7.3)
+
+(COMPLEX 1 0)
+1
+
+(REALPART 5)
+5
+
+(REALPART #C(1.4 0.0))
+1.4
+
+(IMAGPART 5)
+0
+
+(IMAGPART #C(1.4 0.0))
+0.0
+
+;LOGAND, LOGANDC1, LOGANDC2, LOGEQV, LOGIOR, LOGNAND, LOGNOR, LOGNOT,
+;LOGORC1, LOGORC2, LOGTEST, LOGXOR, LOGBITP, ASH,
+
+(LOGCOUNT 13)
+3
+
+(LOGCOUNT -13)
+2
+
+(INTEGER-LENGTH 0)
+0
+
+(INTEGER-LENGTH 1)
+1
+
+;BYTE, BYTE-POSITION, BYTE-SIZE, LDB, LDB-TEST, MASK-FIELD, DPB, DEPOSIT-FIELD,
+
+;RANDOM,
+
+#+XCL (RANDOM-STATE-P
+(EVAL (READ-FROM-STRING "(sys::%set-type-pointer sys::%type-random-state 1)")))
+#+XCL T
+
+;MAKE-RANDOM-STATE,
+
+BOOLE-CLR
+0
+
+BOOLE-SET
+#+(or XCL ALLEGRO) 1 #+CLISP 15 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-1
+#+(or XCL ALLEGRO) 2 #+CLISP 10 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-2
+#+(or XCL ALLEGRO) 3 #+CLISP 12 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-C1
+#+(or XCL ALLEGRO) 4 #+CLISP 5 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-C2
+#+(or XCL ALLEGRO) 5 #+CLISP 3 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-AND
+#+(or XCL ALLEGRO) 6 #+CLISP 8 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-IOR
+#+(or XCL ALLEGRO) 7 #+CLISP 14 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-XOR
+#+(or XCL ALLEGRO) 8 #+CLISP 6 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-EQV
+#+(or XCL ALLEGRO) 9 #+CLISP 9 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-NAND
+#+(or XCL ALLEGRO) 10 #+CLISP 7 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-NOR
+#+(or XCL ALLEGRO) 11 #+CLISP 1 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-ANDC1
+#+(or XCL ALLEGRO) 12 #+CLISP 4 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-ANDC2
+#+(or XCL ALLEGRO) 13 #+CLISP 2 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-ORC1
+#+(or XCL ALLEGRO) 14 #+CLISP 13 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+BOOLE-ORC2
+#+(or XCL ALLEGRO) 15 #+CLISP 11 #-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(let ((s (prin1-to-string MOST-POSITIVE-FIXNUM )))
+  (or #+(or XCL CLISP) (equal s "16777215")
+      #+CLISP (equal s "33554431") #+CLISP (equal s "67108863")
+      #+CLISP (equal s "4294967295")
+      #+ALLEGRO (equal s "536870911")
+) )
+T
+
+(let ((s (prin1-to-string MOST-NEGATIVE-FIXNUM )))
+  (or #+(or XCL CLISP) (equal s "-16777216")
+      #+CLISP (equal s "-33554432") #+CLISP (equal s "-67108864")
+      #+CLISP (equal s "-4294967296")
+      #+ALLEGRO (equal s "-536870912")
+) )
+T
+
+(prin1-to-string MOST-POSITIVE-SHORT-FLOAT )
+#+XCL "1.701S38"
+#+CLISP "1.7014s38"
+#+ALLEGRO "3.4028232e+38"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string LEAST-POSITIVE-SHORT-FLOAT )
+#+XCL "2.939S-39"
+#+CLISP "2.93874s-39"
+#+ALLEGRO "1.4012985e-45"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string LEAST-NEGATIVE-SHORT-FLOAT )
+#+XCL "-2.939S-39"
+#+CLISP "-2.93874s-39"
+#+ALLEGRO "-1.4012985e-45"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string MOST-NEGATIVE-SHORT-FLOAT )
+#+XCL "-1.701S38"
+#+CLISP "-1.7014s38"
+#+ALLEGRO "-3.4028232e+38"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(let ((s (prin1-to-string MOST-POSITIVE-SINGLE-FLOAT )))
+  (or #+XCL (equal s "1.701411E38")
+      #+CLISP (equal s "1.7014117E38") #+CLISP (equal s "3.4028235E38")
+      #+ALLEGRO (equal s "3.4028232e+38")
+) )
+T
+
+(let ((s (prin1-to-string LEAST-POSITIVE-SINGLE-FLOAT )))
+  (or #+(or XCL CLISP) (equal s "2.938736E-39")
+      #+CLISP (equal s "1.1754944E-38")
+      #+ALLEGRO (equal s "1.4012985e-45")
+) )
+T
+
+(let ((s (prin1-to-string LEAST-NEGATIVE-SINGLE-FLOAT )))
+  (or #+(or XCL CLISP) (equal s "-2.938736E-39")
+      #+CLISP (equal s "-1.1754944E-38")
+      #+ALLEGRO (equal s "-1.4012985e-45")
+) )
+T
+
+(let ((s (prin1-to-string MOST-NEGATIVE-SINGLE-FLOAT )))
+  (or #+XCL (equal s "-1.701411E38")
+      #+CLISP (equal s "-1.7014117E38") #+CLISP (equal s "-3.4028235E38")
+      #+ALLEGRO (equal s "-3.4028232e+38")
+) )
+T
+
+(let ((s (prin1-to-string MOST-POSITIVE-DOUBLE-FLOAT )))
+  (or #+XCL (equal s "1.701411834604692D38")
+      #+CLISP (equal s "8.988465674311579d307")
+      #+CLISP (equal s "1.7976931348623157d308")
+      #+ALLEGRO (equal s "4.494232837155787d+307")
+) )
+T
+
+(let ((s (prin1-to-string LEAST-POSITIVE-DOUBLE-FLOAT )))
+  (or #+XCL (equal s "2.938735877055719D-39")
+      #+CLISP (equal s "5.562684646268004d-309")
+      #+CLISP (equal s "2.2250738585072014d-308")
+      #+ALLEGRO (equal s "4.9406564584124657d-324")
+) )
+T
+
+(let ((s (prin1-to-string LEAST-NEGATIVE-DOUBLE-FLOAT )))
+  (or #+XCL (equal s "-2.938735877055719D-39")
+      #+CLISP (equal s "-5.562684646268004d-309")
+      #+CLISP (equal s "-2.2250738585072014d-308")
+      #+ALLEGRO (equal s "-4.9406564584124657d-324")
+) )
+T
+
+(let ((s (prin1-to-string MOST-NEGATIVE-DOUBLE-FLOAT )))
+  (or #+XCL (equal s "-1.701411834604692D38")
+      #+CLISP (equal s "-8.988465674311579d307")
+      #+CLISP (equal s "-1.7976931348623157d308")
+      #+ALLEGRO (equal s "-4.494232837155787d+307")
+) )
+T
+
+(prin1-to-string MOST-POSITIVE-LONG-FLOAT )
+#+XCL "1.701411834604692D38"
+#+CLISP "8.8080652584198167656L646456992"
+#+ALLEGRO "4.494232837155787d+307"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string LEAST-POSITIVE-LONG-FLOAT )
+#+XCL "2.938735877055719D-39"
+#+CLISP "5.676615526003731344L-646456994"
+#+ALLEGRO "4.9406564584124657d-324"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string LEAST-NEGATIVE-LONG-FLOAT )
+#+XCL "-2.938735877055719D-39"
+#+CLISP "-5.676615526003731344L-646456994"
+#+ALLEGRO "-4.9406564584124657d-324"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string MOST-NEGATIVE-LONG-FLOAT )
+#+XCL "-1.701411834604692D38"
+#+CLISP "-8.8080652584198167656L646456992"
+#+ALLEGRO "-4.494232837155787d+307"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string SHORT-FLOAT-EPSILON )
+#+XCL "1.526S-5"
+#+CLISP "7.6295s-6"
+#+ALLEGRO "1.1920929e-7"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string SINGLE-FLOAT-EPSILON )
+#+XCL "5.960464E-8"
+#+CLISP "5.960465E-8"
+#+ALLEGRO "1.1920929e-7"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string DOUBLE-FLOAT-EPSILON )
+#+XCL "1.387778780781446D-17"
+#+CLISP "1.1102230246251568d-16"
+#+ALLEGRO "2.220446049250313d-16"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string LONG-FLOAT-EPSILON )
+#+XCL "1.387778780781446D-17"
+#+CLISP "5.4210108624275221706L-20"
+#+ALLEGRO "2.220446049250313d-16"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string SHORT-FLOAT-NEGATIVE-EPSILON )
+#+XCL "1.526S-5"
+#+CLISP "3.81476s-6"
+#+ALLEGRO "1.1920929e-7"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string SINGLE-FLOAT-NEGATIVE-EPSILON )
+#+XCL "5.960464E-8"
+#+CLISP "2.9802326E-8"
+#+ALLEGRO "1.1920929e-7"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string DOUBLE-FLOAT-NEGATIVE-EPSILON )
+#+XCL "1.387778780781446D-17"
+#+CLISP "5.551115123125784d-17"
+#+ALLEGRO "2.220446049250313d-16"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(prin1-to-string LONG-FLOAT-NEGATIVE-EPSILON )
+#+XCL "1.387778780781446D-17"
+#+CLISP "2.7105054312137610853L-20"
+#+ALLEGRO "2.220446049250313d-16"
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(/ 1 0)
+ERROR
+
+(/ 1 0.0s0)
+ERROR
+
+(/ 1 0.0f0)
+ERROR
+
+(/ 1 0.0d0)
+ERROR
+
+(/ 1 0.0L0)
+ERROR
+
+(expt 10.0s0 1000)
+ERROR
+
+(expt 10.0f0 1000)
+ERROR
+
+(expt 10.0d0 1000)
+ERROR
+
+(expt 10.0L0 1000000000)
+ERROR
+
+;Kap 13 ZEICHEN
+;-------------------------------------------------------------------------------
+
+(STANDARD-CHAR-P #\a)
+T
+
+(STANDARD-CHAR-P 1)
+ERROR
+
+(GRAPHIC-CHAR-P #\a)
+T
+
+(GRAPHIC-CHAR-P 1)
+ERROR
+
+(STRING-CHAR-P #\a)
+T
+
+(STRING-CHAR-P #\1)
+T
+
+(STRING-CHAR-P "")
+ERROR
+
+(ALPHA-CHAR-P #\a)
+T
+
+(ALPHA-CHAR-P #\$)
+NIL
+
+(UPPER-CASE-P #\a)
+NIL
+
+(LOWER-CASE-P #\A)
+NIL
+
+(BOTH-CASE-P #\a)
+T
+
+(BOTH-CASE-P #\$)
+NIL
+
+(DIGIT-CHAR-P #\a)
+NIL
+
+(DIGIT-CHAR-P #\5)
+5
+
+(ALPHANUMERICP #\a)
+T
+
+(ALPHANUMERICP #\$)
+NIL
+
+(CHAR= #\d #\d)
+T
+
+(CHAR/= #\d #\d)
+NIL
+
+(CHAR< #\z #\0)
+NIL
+
+;CHAR>, CHAR>=, CHAR<=,
+
+(CHAR-EQUAL #\d #\d)
+T
+
+(CHAR-NOT-EQUAL #\d #\d)
+NIL
+
+(CHAR-LESSP #\d #\x)
+T
+
+(CHAR-LESSP #\d #\d)
+NIL
+
+(CHAR-NOT-GREATERP #\d #\d)
+T
+
+(CHAR-GREATERP #\e #\d)
+T
+
+(CHAR-NOT-LESSP #\e #\d)
+T
+
+;CHAR-CODE, CODE-CHAR, CHARACTER,
+
+(CHAR-UPCASE #\a)
+#\A
+
+(CHAR-UPCASE #\=)
+#\=
+
+(CHAR= (CHAR-DOWNCASE (CHAR-UPCASE #\x)) #\x)
+T
+
+(CHAR-DOWNCASE #\A)
+#\a
+
+(CHAR= (CHAR-UPCASE (CHAR-DOWNCASE #\X)) #\X)
+T
+
+(DIGIT-CHAR 7)
+#\7
+
+(DIGIT-CHAR 12)
+NIL
+
+;CHAR-INT, INT-CHAR, CHAR-NAME, NAME-CHAR,
+
+CHAR-CODE-LIMIT
+#+XCL 128 #+(or CLISP AKCL) 256 #+ALLEGRO 65536 #-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+;Kap 14 SEQUENZEN
+;-------------------------------------------------------------------------------
+
+(ELT (SYMBOL-NAME (QUOTE ABC)) 0)
+#\A
+
+(SUBSEQ (QUOTE (A B C D E)) 2)
+(C D E)
+
+(COPY-SEQ '#(A B C))
+#(A B C)
+
+(COPY-SEQ (QUOTE ((A B) C (D E))))
+((A B) C (D E))
+
+(LENGTH (QUOTE #(A B C D E F)))
+6
+
+(LENGTH (QUOTE (A B C D E F)))
+6
+
+(NREVERSE (QUOTE (A (B (C) D))))
+((B (C) D) A)
+
+(REVERSE (QUOTE (1 2 3 4)))
+(4 3 2 1)
+
+(MAKE-SEQUENCE (QUOTE VECTOR) 4 :INITIAL-ELEMENT (QUOTE O))
+#(O O O O)
+
+(MAKE-SEQUENCE (QUOTE LIST) 4 :INITIAL-ELEMENT (QUOTE O))
+(O O O O)
+
+(CONCATENATE (QUOTE LIST) (QUOTE (A B C)) (QUOTE (1 2)))
+(A B C 1 2)
+
+(MAP (QUOTE LIST) (QUOTE LIST) (QUOTE (#\a #\b #\c)) (QUOTE (#\1 #\2
+#\3)))
+((#\a #\1) (#\b #\2) (#\c #\3))
+
+(MAP (QUOTE LIST) (QUOTE LIST) (QUOTE (A B C)) (QUOTE (1 2 3)))
+((A 1) (B 2) (C 3))
+
+(SOME (QUOTE NULL) (QUOTE (A B NIL T E)))
+T
+
+(EVERY (QUOTE ATOM) (QUOTE (A 8 #(A B))))
+T
+
+(NOTANY (QUOTE EQ) (QUOTE (A B C D E 4)) (QUOTE (I J K L M 4)))
+nil ;? T
+
+(NOTEVERY (QUOTE EQ) '#(U) (QUOTE (A X U)))
+T
+
+(REDUCE (QUOTE LIST) (QUOTE (A)) :FROM-END NIL :INITIAL-VALUE NIL)
+
+(NIL A)
+
+(REDUCE (QUOTE LIST) (QUOTE (A B C D)) :FROM-END NIL :INITIAL-VALUE
+(QUOTE III))
+((((III A) B) C) D)
+
+(REDUCE (QUOTE LIST) (QUOTE (A B C D)) :FROM-END T)
+(A (B (C D)))
+
+(FILL '#(A B C D) (QUOTE I) :START 1 :END 3)
+#(A I I D)
+
+(REPLACE '#(A B C D) '#(I J) :START1 1)
+#(A I J D)
+
+(REMOVE (QUOTE NUMBERP) '#(Y A 4 A C 9 A D 2 3) :COUNT 1 :FROM-END T)
+#(Y A 4 A C 9 A D 2 3)
+
+(REMOVE (QUOTE A) (QUOTE (A 1 B A 2 A)) :START 1)
+(A 1 B 2)
+
+(REMOVE-DUPLICATES (QUOTE (A B C A D A)) :START 1)
+(A B C D A)
+
+(REMOVE-IF (QUOTE NUMBERP) '#(Y A 4 A C 9 A D 2 3))
+#(Y A A C A D)
+
+(REMOVE-IF-NOT (QUOTE NUMBERP) '#(Y A 4 A C 9 A D 2 3))
+#(4 9 2 3)
+
+(REMOVE-IF-NOT (QUOTE NUMBERP) '#(Y A 4 A C 9 A D 2 3) :COUNT 2 :FROM-END NIL)
+#(4 A C 9 A D 2 3)
+
+(DELETE (QUOTE (A)) (QUOTE ((A B) (C D) (A))) :TEST (QUOTE EQUAL))
+
+((A B) (C D))
+
+(DELETE-IF (FUNCTION (LAMBDA (X) (EQ (CAR X) (QUOTE A))))
+(QUOTE ((A B) (C D) (A))))
+((C D))
+
+(DELETE-IF-NOT (QUOTE NUMBERP) (QUOTE (A 3 B 4)))
+(3 4)
+
+;DELETE-DUPLICATES,
+
+(NSUBSTITUTE (QUOTE NEW) (QUOTE (1 OLD)) (QUOTE ((0 OLD) (1 OLD) (2 OLD)))
+:TEST-NOT (QUOTE EQUAL) :FROM-END T)
+(NEW (1 OLD) NEW)
+
+(NSUBSTITUTE (QUOTE NEW) (QUOTE OLD) (QUOTE (0 OLD 1 OLD 2 OLD)) :END 2)
+(0 NEW 1 OLD 2 OLD)
+
+(NSUBSTITUTE-IF (QUOTE NEW) (QUOTE NUMBERP) (QUOTE (0 A 1 B 2 C 3 D))
+:COUNT 2
+:END 5)
+(NEW A NEW B 2 C 3 D)
+
+(NSUBSTITUTE-IF-NOT (QUOTE NEW) (QUOTE NUMBERP) (QUOTE (0 A 1 B 2 C
+3 D)) :COUNT
+2 :FROM-END T)
+(0 A 1 B 2 NEW 3 NEW)
+
+(SUBSTITUTE (QUOTE NEW) (QUOTE (2 OLD))
+(QUOTE ((1 OLD) (2 OLD) (3 OLD) (4 OLD))) :TEST (QUOTE EQUAL) :START
+3)
+((1 OLD) (2 OLD) (3 OLD) (4 OLD))
+
+(SUBSTITUTE-IF (QUOTE NEW) (QUOTE NUMBERP) (QUOTE (A 1 B 2 D 3)))
+(A NEW B NEW D NEW)
+
+(SUBSTITUTE-IF-NOT (QUOTE NEW) (QUOTE NUMBERP) (QUOTE (A 1 B 2 D 3))
+:COUNT 2
+:FROM-END T)
+(A 1 NEW 2 NEW 3)
+
+(FIND (QUOTE 0) (QUOTE ((0 A) (1 A) (2 A) (0 B))) :TEST (QUOTE =) :FROM-END
+T
+:KEY (QUOTE CAR) :START 1)
+(0 B)
+
+(FIND-IF (QUOTE NUMBERP) (QUOTE ((A 0) (B 1) (C 2))) :KEY (QUOTE CADR)
+:START 3)
+NIL
+
+;FIND-IF-NOT,
+
+(POSITION (QUOTE A) (QUOTE ((0 A) (1 B) (2 A) (3 B))) :TEST
+(FUNCTION (LAMBDA (X Y) (EQ X (CADR Y)))) :START 1)
+2
+
+(POSITION (QUOTE A) (QUOTE ((0 A) (1 B) (2 A) (3 B))) :KEY (QUOTE CADR))
+
+0
+
+(POSITION-IF (QUOTE NUMBERP) (QUOTE ((0 X) (1 7.0) (2 8))) :FROM-END
+T :START 1
+:KEY (QUOTE CADR))
+2
+
+;POSITION-IF-NOT,
+
+(COUNT (QUOTE (A)) (QUOTE (A (A) A (A) A B)) :TEST-NOT (QUOTE EQUAL)
+:KEY
+(FUNCTION (LAMBDA (X) (IF (ATOM X) (LIST X)))))
+3
+
+(COUNT-IF-NOT (QUOTE NUMBERP) '#(A 3 B 5 7 C D) :START 2 :END 5)
+1
+
+;COUNT-IF-NOT,
+
+(MISMATCH (QUOTE (A B C 3 4 5)) (QUOTE (A B X 3 4 B)) :START1 1 :START2 5 :END1
+2 :TEST-NOT (QUOTE EQ))
+1
+
+(MISMATCH (QUOTE (A B C 3 4 5)) (QUOTE (U B X 3 4 5)) :FROM-END T)
+#+XCL 2 #-XCL 3
+
+(SEARCH "ABCD" "0ABIABJBCBC" :END1 3 :START1 1 :START2 0 :FROM-END
+T)
+9
+
+(SEARCH (QUOTE (#\A #\B #\C #\D)) "0ABIABJBCBC" :END1 2 :START2 0 :FROM-END
+T)
+4
+
+(SEARCH (QUOTE (A B C D)) (QUOTE (0 A B I A B J B C B C)) :END1 2 :START2
+2)
+4
+
+(SORT (QUOTE ((U 3) (I 1) (A 7) (K 3) (C 4) (B 6))) (QUOTE <) :KEY
+(QUOTE CADR))
+((I 1) (U 3) (K 3) (C 4) (B 6) (A 7))
+
+(STABLE-SORT (QUOTE ((B 4) (A 3) (A 2) (B 1) (C 9) (B 2))) (QUOTE STRING<)
+:KEY
+(QUOTE CAR))
+((A 3) (A 2) (B 4) (B 1) (B 2) (C 9))
+
+(MERGE (QUOTE LIST) (QUOTE (5 1 4 4 7)) (QUOTE (2 3 5 6 8 9)) (QUOTE
+<))
+(2 3 5 1 4 4 5 6 7 8 9) ;? error
+
+(MERGE (QUOTE LIST) (QUOTE (1 4 4 7)) (QUOTE (2 3 5 6 8 9)) (QUOTE
+<))
+(1 2 3 4 4 5 6 7 8 9) ;? error
+
+;Kap 15 LISTEN
+;-------------------------------------------------------------------------------
+
+(CAR (QUOTE (A B C D E F G)))
+A
+
+(CDR (QUOTE (A B C D E F G)))
+(B C D E F G)
+
+(CADR (QUOTE (A B C D E F G)))
+B
+
+(CDDR (QUOTE (A B C D E F G)))
+(C D E F G)
+
+(CADDR (QUOTE (A B C D E F G)))
+C
+
+(CDDDR (QUOTE (A B C D E F G)))
+(D E F G)
+
+(CADDDR (QUOTE (A B C D E F G)))
+D
+
+(CDDDDR (QUOTE (A B C D E F G)))
+(E F G)
+
+(CAADR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+((U V W) X)
+
+(CADAR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+(6 7)
+
+(CDAAR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+(5)
+
+(CDADR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+(Y)
+
+(CDDAR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+NIL
+
+(CAAAAR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+(1 2 3)
+
+(CAADAR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+6
+
+(CAADDR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+(Q W E)
+
+(CADAAR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+5
+
+(CADADR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+Y
+
+(CADDAR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+NIL
+
+(CADDDR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+(A B C)
+
+(CDAAAR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+(4)
+
+(CDAADR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+(X)
+
+(CDADAR
+(QUOTE (((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G)))
+(7)
+
+(CONS 1 2)
+(1 . 2)
+
+(CONS (QUOTE A) (CONS (QUOTE B) (CONS (QUOTE C) (QUOTE NIL))))
+(A B C)
+
+(CONS (QUOTE A) (QUOTE (B C D)))
+(A B C D)
+
+(TREE-EQUAL 5 (+ 2 3) :TEST (FUNCTION EQL))
+T
+
+(ENDP (QUOTE NIL))
+T
+
+(ENDP (QUOTE (A . B)))
+NIL
+
+(LIST-LENGTH (QUOTE (A B C D)))
+4
+
+(LET ((X (LIST (QUOTE A) (QUOTE B) (QUOTE C)))) (RPLACD (LAST X) X)
+
+(LIST-LENGTH X))
+NIL
+
+(NTH 0 (QUOTE (A B C D)))
+A
+
+(FIRST (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+1
+
+(SECOND (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+2
+
+(THIRD (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+3
+
+(FOURTH (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+4
+
+(FIFTH (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+5
+
+(SIXTH (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+6
+
+(SEVENTH (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+7
+
+(EIGHTH (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+8
+
+(NINTH (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+9
+
+(TENTH (QUOTE (1 2 3 4 5 6 7 8 9 10 11)))
+10
+
+(REST (QUOTE (A . B)))
+B
+
+(NTHCDR 1 (QUOTE (A B C D)))
+(B C D)
+
+(LAST (QUOTE (1 2 3 4 5)))
+(5)
+
+(LAST (QUOTE (1 2 3 . 4)))
+(3 . 4)
+
+(LIST (QUOTE A) (QUOTE B) (QUOTE C) (QUOTE D))
+(A B C D)
+
+(LIST* (QUOTE A) (QUOTE B) (QUOTE C) (QUOTE D))
+(A B C . D)
+
+(MAKE-LIST 4 :INITIAL-ELEMENT (QUOTE O))
+(O O O O)
+
+(MAKE-LIST 3 :INITIAL-ELEMENT (QUOTE RAH))
+(RAH RAH RAH)
+
+(APPEND (QUOTE (A B C)) (QUOTE (D E F)) (QUOTE NIL) (QUOTE (G)))
+(A B C D E F G)
+
+(COPY-LIST (QUOTE (1 2 3 4 5)))
+(1 2 3 4 5)
+
+(COPY-LIST (QUOTE (1 2 3 . 4)))
+(1 2 3 . 4)
+
+(COPY-ALIST (QUOTE (A B)))
+(A B)
+
+(COPY-ALIST (QUOTE ((1 . A) (2 . B) (3 . C))))
+((1 . A) (2 . B) (3 . C))
+
+(COPY-ALIST (QUOTE ((A B) C (D E))))
+((A B) C (D E))
+
+(COPY-TREE (QUOTE (A B (C (D) (E F)) G)))
+(A B (C (D) (E F)) G)
+
+(REVAPPEND (QUOTE (A B C)) (QUOTE (D E F)))
+(C B A D E F)
+
+(REVAPPEND (QUOTE (A B C)) (QUOTE I))
+(C B A . I) ;? error
+
+(NRECONC (QUOTE (A B C)) (QUOTE (I J)))
+(C B A I J)
+
+;NRECONC
+
+(SETQ AA NIL)
+NIL
+
+(PUSH (QUOTE 1) AA)
+(1)
+
+(PUSH (QUOTE 2) AA)
+(2 1)
+
+(POP AA)
+2
+
+(POP AA)
+1
+
+(POP AA)
+NIL
+
+(SETQ AA (QUOTE (B A)))
+(B A)
+
+(PUSHNEW (QUOTE A) AA)
+(B A)
+
+(PUSHNEW (QUOTE C) AA)
+(C B A)
+
+(PUSHNEW (QUOTE U) (CAR (SETQ XX (QUOTE (NIL KKK)))))
+(U)
+
+(PUSHNEW (QUOTE U) (CAR XX))
+(U)
+
+(PUSHNEW (QUOTE V) (CAR XX))
+(V U)
+
+(EVAL (QUOTE XX))
+((V U) KKK)
+
+(BUTLAST (QUOTE (A B C)) 2)
+(A)
+
+(NBUTLAST (QUOTE (A B C D)) 6)
+NIL
+
+(NBUTLAST (QUOTE (A B C D)) 1)
+(A B C)
+
+(LDIFF (SETQ XX (QUOTE (A B C D E))) (CDDR XX))
+(A B)
+
+(LDIFF (SETQ XX (QUOTE (A B C D . E))) (CDDR XX))
+(A B)
+
+(LDIFF (QUOTE (A B C D . E)) (QUOTE E))
+(A B C D)
+
+;RPLACA, RPLACD
+
+(NSUBST (QUOTE A) (QUOTE B) (QUOTE (U B (B) C)) :TEST-NOT
+(FUNCTION (LAMBDA (X Y) (NOT (EQL X Y)))))
+(U A (A) C)
+
+(NSUBST-IF (QUOTE OO) (QUOTE NUMBERP) (QUOTE (A B C (3 (4) 0))))
+(A B C (OO (OO) OO))
+
+(NSUBST-IF-NOT (QUOTE OO) (FUNCTION (LAMBDA (X) (OR (LIST X) (SYMBOLP
+X))))
+(QUOTE (A B C (3 (4) 0))))
+(A B C (3 (4) 0))
+
+(SUBST (QUOTE A) (QUOTE B) (QUOTE (U B (B) C)) :TEST-NOT
+(FUNCTION (LAMBDA (X Y) (NOT (EQL X Y)))) :KEY
+(FUNCTION (LAMBDA (U) (IF (LISTP U) (CAR U)))))
+(U . A)
+
+(SUBST-IF (QUOTE NUMMMER) (QUOTE NUMBERP) (QUOTE ((A (7 (V 6))))))
+
+((A (NUMMMER (V NUMMMER))))
+
+(SUBST-IF-NOT (QUOTE NUMMMER) (FUNCTION (LAMBDA (X) (OR (LISTP X) (NUMBERP
+X))))
+(QUOTE ((A (7 (V 6))))))
+((NUMMMER (7 (NUMMMER 6))))
+
+(NSUBLIS (QUOTE (((A) . UU) (A . II))) (QUOTE (I (A) A)) :TEST
+(FUNCTION (LAMBDA (X Y) (IF (LISTP Y) (EQL X (CAR Y))))))
+#+(or XCL ALLEGRO)     (I II . II) ; X aus der Aliste, Y ein Blatt des Baumes
+#+(or CLISP CMU LUCID) (I (UU) UU) ; X ein Blatt, Y aus der Aliste
+#-(or XCL CLISP CMU LUCID ALLEGRO) UNKNOWN
+
+(SUBLIS (QUOTE (((A) . UU) (A . II))) (QUOTE (I (A) A)) :TEST
+(FUNCTION (LAMBDA (X Y) (IF (LISTP Y) (EQL X (CAR Y))))))
+#+(or XCL ALLEGRO LUCID) (I II . II) ; X aus der Aliste, Y ein Blatt des Baumes
+#+(or CLISP CMU)         (I (UU) UU) ; X ein Blatt, Y aus der Aliste
+#-(or XCL CLISP CMU LUCID ALLEGRO) UNKNOWN
+
+(MEMBER (QUOTE A) (QUOTE ((A) (B) (A) (C))) :KEY (QUOTE CAR))
+((A) (B) (A) (C))
+
+(MEMBER-IF (QUOTE NUMBERP) (QUOTE ((A) (B) (3) (C))) :KEY (QUOTE CAR))
+
+((3) (C))
+
+(MEMBER-IF-NOT (QUOTE NUMBERP) (QUOTE ((8) (A) (B) (3) (C))) :KEY (QUOTE
+CAR))
+((A) (B) (3) (C))
+
+(TAILP (CDDR (SETQ XX (QUOTE (U I A B)))) XX)
+T
+
+(TAILP (QUOTE D) (QUOTE (A B C . D)))
+T
+
+(ADJOIN (QUOTE A) (QUOTE ((A) B C)) :TEST (QUOTE EQUAL))
+(A (A) B C)
+
+(NUNION (QUOTE (A B C D)) (QUOTE (U I B A)))
+#+XCL (A B C D U I)
+#+CLISP (C D U I B A)
+#+ALLEGRO (D C U I B A)
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(UNION (QUOTE (A B C D)) (QUOTE (A D I V)))
+#+XCL (V I A B C D)
+#+CLISP (B C A D I V)
+#+ALLEGRO (C B A D I V)
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(INTERSECTION (QUOTE ((A 1) (A 2) (A 3))) (QUOTE ((A 4) (A 2) (B 6)
+(C 7)))
+:TEST (QUOTE EQUAL))
+((A 2))
+
+(NINTERSECTION (QUOTE (A B C D)) (QUOTE (C D E F G)) :TEST-NOT (QUOTE
+EQL))
+#-ALLEGRO (A B C D) #+ALLEGRO (D C B A)
+
+(NSET-DIFFERENCE (QUOTE (A B C D)) (QUOTE (I J C)))
+#-ALLEGRO (A B D) #+ALLEGRO (D B A)
+
+(NSET-EXCLUSIVE-OR (QUOTE (A B C)) (QUOTE (I A D C)))
+(B I D)
+
+(SET-DIFFERENCE (QUOTE (ANTON BERTA AUTO BERLIN)) (QUOTE (AMERILLA)) :TEST
+(FUNCTION (LAMBDA (X Y) (EQL (ELT (SYMBOL-NAME X) 0) (ELT (SYMBOL-NAME Y) 0)))))
+#+(or XCL ALLEGRO) (BERLIN BERTA)
+#+(or CLISP AKCL) (BERTA BERLIN)
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(SET-EXCLUSIVE-OR (QUOTE (ANTON ANNA EMIL)) (QUOTE (BERTA AUTO AUGUST)) :TEST
+(FUNCTION (LAMBDA (X Y) (EQL (ELT (SYMBOL-NAME X) 0) (ELT (SYMBOL-NAME Y) 0)))))
+#-ALLEGRO (EMIL BERTA) #+ALLEGRO (BERTA EMIL)
+
+(SUBSETP (QUOTE (A B)) (QUOTE (B A U I C D)))
+T
+
+(ACONS (QUOTE A) (QUOTE B) (QUOTE ((C . D))))
+((A . B) (C . D))
+
+(ACONS (QUOTE A) (QUOTE B) NIL)
+((A . B))
+
+(ASSOC (QUOTE A) (QUOTE ((B C) A ((A) U) (A I))) :TEST-NOT
+(FUNCTION (LAMBDA (X Y) (IF (ATOM Y) (EQL Y X)))))
+#+ALLEGRO ERROR #-ALLEGRO (B C)
+
+(ASSOC-IF (QUOTE SYMBOLP) (QUOTE ((A . 3) (3 . A))))
+(A . 3)
+
+(ASSOC-IF-NOT (QUOTE NUMBERP) (QUOTE ((A . 3) (3 . A))))
+(A . 3)
+
+(PAIRLIS (QUOTE (A B C)) (QUOTE (1 2 3)))
+((C . 3) (B . 2) (A . 1))
+
+(RASSOC (QUOTE A) (QUOTE ((1 . B) (2 . A))))
+(2 . A)
+
+(RASSOC-IF (QUOTE SYMBOLP) (QUOTE ((1 . 3) (2 . A))))
+(2 . A)
+
+(RASSOC-IF-NOT (QUOTE SYMBOLP) (QUOTE ((1 . 3) (2 . A))))
+(1 . 3)
+
+;Kap 16 Hash-Tabellen
+;-------------------------------------------------------------------------------
+
+(HASH-TABLE-P (MAKE-HASH-TABLE :TEST (FUNCTION EQL) :REHASH-SIZE 2 :SIZE 20))
+T
+(HASH-TABLE-P (MAKE-HASH-TABLE :TEST (FUNCTION EQL) :REHASH-SIZE 1.1 :SIZE 20))
+T
+;CLRHASH, GETHASH, HASH-TABLE-COUNT, MAPHASH, REMHASH, SXHASH,
+
+;Kap 17 Felder
+;-------------------------------------------------------------------------------
+
+;MAKE-ARRAY, VECTOR, AREF, SVREF, ARRAY-ELEMENT-TYPE, ARRAY-RANK,
+;ARRAY-DIMENSION, ARRAY-DIMENSIONS, ARRAY-TOTAL-SIZE, ARRAY-IN-BOUNDS-P,
+;ARRAY-ROW-MAJOR-INDEX, ADJUSTABLE-ARRAY-P,
+
+;array-rank-limit, array-dimension-limit, array-total-size-limit,
+
+
+;BIT, SBIT, BIT-AND, BIT-ANDC1, BIT-ANDC2, BIT-EQV, BIT-IOR, BIT-NAND, BIT-NOR,
+;BIT-NOT, BIT-ORC1, BIT-ORC2, BIT-XOR,
+
+;ARRAY-HAS-FILL-POINTER-P, FILL-POINTER, VECTOR-POP, VECTOR-PUSH,
+;VECTOR-PUSH-EXTEND, ADJUST-ARRAY,
+
+;Kap 18 Strings
+;-------------------------------------------------------------------------------
+
+;CHAR, SCHAR, STRING=, STRING-EQUAL, STRING/=, STRING<, STRING<=, STRING>,
+
+;STRING>=, STRING-GREATERP, STRING-LESSP, STRING-NOT-EQUAL,
+;STRING-NOT-GREATERP, STRING-NOT-LESSP, MAKE-STRING, STRING-LEFT-TRIM,
+
+;STRING-RIGHT-TRIM, STRING-TRIM, STRING-UPCASE, STRING-CAPITALIZE,
+
+;STRING-DOWNCASE, NSTRING-CAPITALIZE, NSTRING-DOWNCASE, NSTRING-UPCASE, STRING,
+
+;Kap 19 Strukturen
+;-------------------------------------------------------------------------------
+
+;DEFSTRUCT,
+
+(defstruct (ice-cream-factory
+            (:constructor make-factory)
+            (:constructor fabricate-factory
+              (&key (capacity 5)
+                    location
+                    (local-flavors
+                     (case location
+                       ((hawaii) '(pineapple macadamia guava))
+                       ((massachusetts) '(lobster baked-bean))
+                       ((california) '(ginger lotus avocado bean-sprout garlic))
+                       ((texas) '(jalapeno barbecue))
+                    ))
+                    (flavors
+                     (subseq (append local-flavors
+                                     '(vanilla chocolate strawberry pistachio
+                                       maple-walnut peppermint
+                             )        )
+                             0 capacity
+                    ))
+           )) )
+  (capacity 3)
+  (flavors '(vanilla chocolate strawberry mango))
+)
+ICE-CREAM-FACTORY
+
+(let ((houston (fabricate-factory :capacity 4 :location 'texas)))
+  (ice-cream-factory-flavors houston)
+)
+(JALAPENO BARBECUE VANILLA CHOCOLATE)
+
+(let ((cambridge (fabricate-factory :location 'massachusetts)))
+  (ice-cream-factory-flavors cambridge)
+)
+(LOBSTER BAKED-BEAN VANILLA CHOCOLATE STRAWBERRY)
+
+(let ((seattle (fabricate-factory :local-flavors '(salmon))))
+  (ice-cream-factory-flavors seattle)
+)
+(SALMON VANILLA CHOCOLATE STRAWBERRY PISTACHIO)
+
+(let ((wheaton (fabricate-factory :capacity 4 :location 'illinois)))
+  (ice-cream-factory-flavors wheaton)
+)
+(VANILLA CHOCOLATE STRAWBERRY PISTACHIO)
+
+(let ((pittsburgh (fabricate-factory :capacity 4)))
+  (ice-cream-factory-flavors pittsburgh)
+)
+(VANILLA CHOCOLATE STRAWBERRY PISTACHIO)
+
+(let ((cleveland (make-factory :capacity 4)))
+  (ice-cream-factory-flavors cleveland)
+)
+(VANILLA CHOCOLATE STRAWBERRY MANGO)
+
+;Kap 20 EVAL
+;-------------------------------------------------------------------------------
+
+;EVAL, EVALHOOK, *evalhook*, APPLYHOOK, *applyhook*,
+
+(CONSTANTP -5)
+T
+
+(CONSTANTP (READ-FROM-STRING "1.0e30"))
+T
+
+;Kap 21 Streams
+;-------------------------------------------------------------------------------
+
+;MAKE-SYNONYM-STREAM, MAKE-BROADCAST-STREAM, MAKE-CONCATENATED-STREAM,
+;MAKE-TWO-WAY-STREAM, MAKE-ECHO-STREAM, MAKE-STRING-INPUT-STREAM,
+;MAKE-STRING-OUTPUT-STREAM, GET-OUTPUT-STREAM-STRING, with-input-from-string,
+;with-open-stream, with-output-to-string,
+
+(STREAMP *STANDARD-INPUT*)
+T
+
+(INPUT-STREAM-P *TERMINAL-IO*)
+T
+
+;OUTPUT-STREAM-P, STREAM-ELEMENT-TYPE, CLOSE,
+
+;Kap 22 Ein- und Ausgabe
+;-------------------------------------------------------------------------------
+
+(READTABLEP *READTABLE*)
+T
+
+(READTABLEP (QUOTE PROGN))
+NIL
+
+;COPY-READTABLE, READ, *read-base*, READ-BYTE, READ-CHAR, READ-CHAR-NO-HANG,
+
+;*read-default-float-format*, READ-DELIMITED-LIST, READ-FROM-STRING, READ-LINE,
+;READ-PRESERVING-WHITESPACE, *read-suppress*, *readtable*, UNREAD-CHAR,
+
+;GET-DISPATCH-MACRO-CHARACTER, GET-MACRO-CHARACTER,
+;SET-DISPATCH-MACRO-CHARACTER, SET-MACRO-CHARACTER, SET-SYNTAX-FROM-CHAR,
+;MAKE-DISPATCH-MACRO-CHARACTER,
+
+;PPRINT, PRIN1, PRIN1-TO-STRING, PRINC, PRINC-TO-STRING, PRINT, *print-array*,
+;*print-base*, *print-case*, *print-circle*, *print-escape*, *print-gensym*,
+
+;*print-length*, *print-level*, *print-pretty*, *print-radix*,
+
+;PEEK-CHAR, LISTEN, CLEAR-INPUT, CLEAR-OUTPUT, PARSE-INTEGER,
+
+;WRITE, WRITE-BYTE, WRITE-CHAR, WRITE-LINE, WRITE-STRING, WRITE-TO-STRING,
+;Y-OR-N-P, YES-OR-NO-P,
+
+;TERPRI, FINISH-OUTPUT, FORCE-OUTPUT, FORMAT, FRESH-LINE,
+
+;Kap 23 File-Interface
+;-------------------------------------------------------------------------------
+
+;PATHNAME, TRUENAME, PARSE-NAMESTRING, MERGE-PATHNAMES,
+;*default-pathname-defaults*, MAKE-PATHNAME, PATHNAMEP, PATHNAME-DEVICE,
+;PATHNAME-DIRECTORY, PATHNAME-HOST, PATHNAME-NAME, PATHNAME-TYPE,
+;PATHNAME-VERSION, NAMESTRING, FILE-NAMESTRING, DIRECTORY-NAMESTRING,
+
+;HOST-NAMESTRING, ENOUGH-NAMESTRING, user-homedir-pathname, OPEN,
+;with-open-file, RENAME-FILE, DELETE-FILE, PROBE-FILE, FILE-WRITE-DATE,
+
+;FILE-AUTHOR, FILE-LENGTH, FILE-POSITION, LOAD, *load-verbose*, DIRECTORY
+
+;Kap 24 Fehler
+;-------------------------------------------------------------------------------
+
+;CERROR, ERROR, *break-on-warnings*, WARN, BREAK, check-type, assert, etypecase,
+;ecase, ctypecase, ccase
+
+;Kap 25 Erweiterungen
+;-------------------------------------------------------------------------------
+
+;COMPILE, DISASSEMBLE, COMPILE-FILE, DOCUMENTATION, trace, untrace, step, time,
+;DESCRIBE, INSPECT, room, ed, DRIBBLE, APROPOS, APROPOS-LIST,
+;GET-DECODED-TIME, GET-INTERNAL-REAL-TIME, GET-INTERNAL-RUN-TIME,
+;GET-UNIVERSAL-TIME, DECODE-UNIVERSAL-TIME, ENCODE-UNIVERSAL-TIME,
+
+;internal-time-units-per-second, SLEEP, LISP-IMPLEMENTATION-TYPE,
+;LISP-IMPLEMENTATION-VERSION, MACHINE-INSTANCE, MACHINE-TYPE, MACHINE-VERSION,
+
+;SOFTWARE-TYPE, SOFTWARE-VERSION, SHORT-SITE-NAME, LONG-SITE-NAME, *features*,
+;IDENTITY
+
+;Kap I Systeminterne Praedikate
+;-------------------------------------------------------------------------------
+
+;? (SEQUENCEP (TYPE-SPECIFIER-P (BIT-ARRAY-P
+;? (ADJUSTABLE-VECTOR-WITH-FILL-POINTER-P (ALISTP (DECLARATION-SPECIFIER-P
+
+
+(SYS::FIXNUMP 10) ;?
+T ;?
+
+;Kap II Systeminterne Atome
+;-------------------------------------------------------------------------------
+
+;case-every, comment, cond-every, displace, return, return-from, ACCESS, BOOLE,
+;call-arguments-limit, DEFUN, errset, *errset*, *macroexpand-hook*, *package*,
+;*random-state*, *SAVE-OLD-DEFINITION-WHEN-REDEFINED*,
diff --git a/src/tests/array.tst b/src/tests/array.tst
new file mode 100644
index 000000000..ae0290025
--- /dev/null
+++ b/src/tests/array.tst
@@ -0,0 +1,643 @@
+
+(FORMAT T "~%Erzeuge ein Feld mit doppeltgenauen Zahlen~%")   NIL
+
+(EQUALP (SETQ DA1 (MAKE-ARRAY (QUOTE (4 2 3)) :INITIAL-CONTENTS (QUOTE
+(
+((1.0D0 2.0D0 3.0D0) (4.0D0 5.0D0 6.0D0))
+((7.0D0 8.0D0 9.0D0) (10.0D0 11.0D0 12.0D0))
+((13.0D0 14.0D0 15.0D0) (16.0D0 17.0D0 18.0D0))
+((19.0D0 20.0D0 21.0D0) (22.0D0 23.0D0 24.0D0)))) :ELEMENT-TYPE
+(QUOTE DOUBLE-FLOAT)))
+'#3A(((1.0D0 2.0D0 3.0D0)(4.0D0 5.0D0 6.0D0))((7.0D0 8.0D0 9.0D0)(10.0D0
+11.0D0
+12.0D0))((13.0D0 14.0D0 15.0D0)(16.0D0 17.0D0 18.0D0))((19.0D0 20.0D0
+21.0D0)(
+22.0D0 23.0D0 24.0D0))))   T
+
+(AREF DA1 0 0 0)   1.0D0
+
+(AREF DA1 0 0 1)   2.0D0
+
+(AREF DA1 0 0 2)   3.0D0
+
+(AREF DA1 0 1 0)   4.0D0
+
+(AREF DA1 0 1 1)   5.0D0
+
+(AREF DA1 0 1 2)   6.0D0
+
+(AREF DA1 1 0 0)   7.0D0
+
+(AREF DA1 1 0 1)   8.0D0
+
+(AREF DA1 1 0 2)   9.0D0
+
+(AREF DA1 1 1 0)   10.0D0
+
+(AREF DA1 1 1 1)   11.0D0
+
+(AREF DA1 1 1 2)   12.0D0
+
+(AREF DA1 2 0 0)   13.0D0
+
+(AREF DA1 2 0 1)   14.0D0
+
+(AREF DA1 2 0 2)   15.0D0
+
+(AREF DA1 2 1 0)   16.0D0
+
+(AREF DA1 2 1 1)   17.0D0
+
+(AREF DA1 2 1 2)   18.0D0
+
+(AREF DA1 3 0 0)   19.0D0
+
+(AREF DA1 3 0 1)   20.0D0
+
+(AREF DA1 3 0 2)   21.0D0
+
+(AREF DA1 3 1 0)   22.0D0
+
+(AREF DA1 3 1 1)   23.0D0
+
+(AREF DA1 3 1 1)   23.0D0
+
+(FORMAT T "~%Erzeuge ein Feld mit einfachgenauen Zahlen~%")   NIL
+
+(EQUALP (SETQ FA1 (MAKE-ARRAY (QUOTE (4 2 3)) :INITIAL-CONTENTS (QUOTE
+(
+((1.0 2.0 3.0) (4.0 5.0 6.0)) ((7.0 8.0 9.0) (10.0 11.0 12.0))
+((13.0 14.0 15.0) (16.0 17.0 18.0)) ((19.0 20.0 21.0) (22.0 23.0 24.0))))
+
+:ELEMENT-TYPE (QUOTE SINGLE-FLOAT)))
+'#3A(((1.0 2.0 3.0)(4.0 5.0 6.0))((7.0 8.0 9.0)(10.0 11.0 12.0))((13.0
+14.0 15.0)(
+16.0 17.0 18.0))((19.0 20.0 21.0)(22.0 23.0 24.0))))   T
+
+(AREF FA1 0 0 0)   1.0
+
+(AREF FA1 0 0 1)   2.0
+
+(AREF FA1 0 0 2)   3.0
+
+(AREF FA1 0 1 0)   4.0
+
+(AREF FA1 0 1 1)   5.0
+
+(AREF FA1 0 1 2)   6.0
+
+(AREF FA1 1 0 0)   7.0
+
+(AREF FA1 1 0 1)   8.0
+
+(AREF FA1 1 0 2)   9.0
+
+(AREF FA1 1 1 0)   10.0
+
+(AREF FA1 1 1 1)   11.0
+
+(AREF FA1 1 1 2)   12.0
+
+(AREF FA1 2 0 0)   13.0
+
+(AREF FA1 2 0 1)   14.0
+
+(AREF FA1 2 0 2)   15.0
+
+(AREF FA1 2 1 0)   16.0
+
+(AREF FA1 2 1 1)   17.0
+
+(AREF FA1 2 1 2)   18.0
+
+(AREF FA1 3 0 0)   19.0
+
+(AREF FA1 3 0 1)   20.0
+
+(AREF FA1 3 0 2)   21.0
+
+(AREF FA1 3 1 0)   22.0
+
+(AREF FA1 3 1 1)   23.0
+
+(AREF FA1 3 1 1)   23.0
+
+(FORMAT T "~%Limits fuer Felder~%")   NIL
+
+(let ((s (prin1-to-string ARRAY-RANK-LIMIT )))
+  (or #+XCL (equal s "256")
+      #+CLISP (equal s "4294967296") #+CLISP (equal s "65536")
+      #+AKCL (equal s "64") #+GCL (equal s "63")
+      #+ECLS (equal s "64")
+      #+ALLEGRO (equal s "65536")
+      #-(or XCL CLISP AKCL ALLEGRO ECLS) "UNKNOWN"
+) )
+T
+
+(let ((s (prin1-to-string ARRAY-DIMENSION-LIMIT )))
+  (or #+XCL (equal s "17920")
+      #+AKCL (equal s "16777216") #+GCL (equal s "2147483647")
+      #+ECLS (equal s "16777216")
+      #+CLISP (equal s (prin1-to-string (1+ most-positive-fixnum)))
+      #+ALLEGRO (equal s "16777216")
+      #-(or XCL CLISP AKCL ALLEGRO ECLS) "UNKNOWN"
+) )
+T
+
+(let ((s (prin1-to-string ARRAY-TOTAL-SIZE-LIMIT )))
+  (or #+XCL (equal s "17920")
+      #+AKCL (equal s "16777216")
+      #+ECLS (equal s "16777216")
+      #+CLISP (equal s (prin1-to-string (1+ most-positive-fixnum)))
+      #+ALLEGRO (equal s "16777216")
+      #-(or XCL CLISP AKCL ALLEGRO ECLS) "UNKNOWN"
+) )
+T
+
+(FORMAT T "~%Erzeuge einen einfachen (simple) Vector~%")   NIL
+
+(EQUALP (SETQ SV (VECTOR (QUOTE A) (QUOTE B) (QUOTE C) 1.0S0 3.7D0
+4.1))
+'#(A B C 1.0S0 3.7D0 4.1))   T
+
+(SVREF SV 0)   A
+
+(SVREF SV 1)   B
+
+(SVREF SV 2)   C
+
+(SVREF SV 3)   1.0S0
+
+(SVREF SV 4)   3.7D0
+
+(FORMAT T "~%Pruefe Setzen eines Elements~%")   NIL
+
+(SETF (SVREF SV 0) (QUOTE TEST))   TEST
+
+(EQUALP SV '#(TEST B C 1.0S0 3.7D0 4.1))   T
+
+(FORMAT T "~%Test Array-Element-Typ ... DA2 nicht def.~%")   NIL
+
+(ARRAY-ELEMENT-TYPE SV)   T
+
+(ARRAY-ELEMENT-TYPE DA1)
+#+(or XCL ALLEGRO) DOUBLE-FLOAT #+CLISP T #+AKCL LONG-FLOAT
+#+ECLS LONG-FLOAT
+#-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(FORMAT T "~%Test Rang~%")   NIL
+
+(ARRAY-RANK DA1)   3
+
+(ARRAY-RANK FA1)   3
+
+(FORMAT T "~%Test der einzelnen Dimensionen~%")   NIL
+
+(ARRAY-DIMENSION DA1 0)   4
+
+(ARRAY-DIMENSION DA1 1)   2
+
+(ARRAY-DIMENSION DA1 2)   3
+
+(ARRAY-DIMENSION DA1 3)   ERROR
+
+(FORMAT T "~%Erzeuge ein 0-dim. Feld (Pseudoscalar) mit Inhalt mod
+5~%")   NIL
+
+(PROGN (SETQ ZERO (MAKE-ARRAY (QUOTE NIL) :ELEMENT-TYPE (QUOTE (MOD
+5)))) T)   T
+
+(ARRAY-RANK ZERO)   0
+
+(SETF (AREF ZERO) 4)   4
+
+(SETF (AREF ZERO) 1.0)   #+(or ECLS XCL CLISP AKCL ALLEGRO) ERROR #-(or XCL CLISP AKCL ALLEGRO ECLS) UNKNOWN
+
+(FORMAT T "~%Erzeuge ein 3-dim gen. Feld~%")   NIL
+
+(EQUALP (SETQ A1 (MAKE-ARRAY (QUOTE (4 2 3)) :INITIAL-CONTENTS (QUOTE
+
+(((A B C) (1 2 3)) ((D E F) (3 1 2)) ((G H I) (2 3 1)) ((J K L) (0
+0 0))))))
+'#3A(((A B C)(1 2 3))((D E F)(3 1 2))((G H I)(2 3 1))((J K L)(0 0 0))))
+  T
+
+(AREF A1 0 0 0)   A
+
+(AREF A1 0 0 1)   B
+
+(AREF A1 0 0 2)   C
+
+(AREF A1 0 1 0)   1
+
+(AREF A1 0 1 1)   2
+
+(AREF A1 0 1 2)   3
+
+(AREF A1 1 0 0)   D
+
+(AREF A1 1 0 1)   E
+
+(AREF A1 1 0 2)   F
+
+(AREF A1 1 1 0)   3
+
+(AREF A1 1 1 1)   1
+
+(AREF A1 1 1 2)   2
+
+(AREF A1 2 0 0)   G
+
+(AREF A1 2 0 1)   H
+
+(AREF A1 2 0 2)   I
+
+(AREF A1 2 1 0)   2
+
+(AREF A1 2 1 1)   3
+
+(AREF A1 2 1 2)   1
+
+(AREF A1 3 0 0)   J
+
+(AREF A1 3 0 1)   K
+
+(AREF A1 3 0 2)   L
+
+(AREF A1 3 1 0)   0
+
+(AREF A1 3 1 1)   0
+
+(AREF A1 3 1 1)   0
+
+(FORMAT T "~%Erzeuge ein 2-dim adj.Feld, das ueberlagert wird ~%")
+  NIL
+
+(PROGN (SETQ M (MAKE-ARRAY (QUOTE (4 4)) :ADJUSTABLE T :INITIAL-CONTENTS
+(QUOTE (
+(ALPHA BETA GAMMA DELTA) (EPSILON ZETA ETA THETA) (IOTA KAPPA LAMBDA
+MU)
+(NU XI OMICRON PI))))) T)   T
+
+(AREF M 0 0)   ALPHA
+
+(AREF M 0 1)   BETA
+
+(AREF M 0 2)   GAMMA
+
+(AREF M 0 3)   DELTA
+
+(AREF M 1 0)   EPSILON
+
+(AREF M 1 1)   ZETA
+
+(AREF M 1 2)   ETA
+
+(AREF M 1 3)   THETA
+
+(AREF M 2 0)   IOTA
+
+(AREF M 2 1)   KAPPA
+
+(AREF M 2 2)   LAMBDA
+
+(AREF M 2 3)   MU
+
+(AREF M 3 0)   NU
+
+(AREF M 3 1)   XI
+
+(AREF M 3 2)   OMICRON
+
+(AREF M 3 3)   PI
+
+(FORMAT T "~%Erzeuge Ueberl. der Zeilen ~%")   NIL
+
+(equalp (SETQ MD0 (MAKE-ARRAY 4 :DISPLACED-TO M))   '#(ALPHA BETA GAMMA
+DELTA)) t
+
+(equalp (SETQ MD1 (MAKE-ARRAY 4 :DISPLACED-TO M :DISPLACED-INDEX-OFFSET
+4))
+'#(EPSILON ZETA ETA THETA)) t
+
+
+(equalp (SETQ MD2 (MAKE-ARRAY 4 :DISPLACED-TO M :DISPLACED-INDEX-OFFSET
+8))
+'#(IOTA KAPPA LAMBDA MU)) t
+
+
+(FORMAT T "~%Adjustiere Feld m~%")   NIL
+
+(PROGN (ADJUST-ARRAY M (QUOTE (3 5)) :INITIAL-ELEMENT (QUOTE BAZ))
+T)   T
+
+(AREF M 0 0)   ALPHA
+
+(AREF M 0 1)   BETA
+
+(AREF M 0 2)   GAMMA
+
+(AREF M 0 3)   DELTA
+
+(AREF M 0 4)   BAZ
+
+(AREF M 1 0)   EPSILON
+
+(AREF M 1 1)   ZETA
+
+(AREF M 1 2)   ETA
+
+(AREF M 1 3)   THETA
+
+(AREF M 1 4)   BAZ
+
+(AREF M 2 0)   IOTA
+
+(AREF M 2 1)   KAPPA
+
+(AREF M 2 2)   LAMBDA
+(FORMAT T "~%Teste Zusammenspiel der Schluesselworte~%")   NIL
+
+(PROGN (SETQ DV (MAKE-ARRAY 10 :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
+:INITIAL-CONTENTS
+(QUOTE (0.0D0 1.0D0 2.0D0 3.0D0 4.0D0 5.0D0 6.0D0 7.0D0 8.0D0 9.0D0))))
+T)   T
+#| ***************************************************************************
+
+(SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
+
+:INITIAL-CONTENTS (QUOTE ((1.0D0 2.0D0) (3.0D0 4.0D0 5.0D0)))))   ERROR
+
+(SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
+
+:INITIAL-CONTENTS (QUOTE
+((1.0D0 2.0D0) (3.0D0 4.0D0) :DISPLACED-TO DV :DISPLACED-INDEX-OFFSET
+8))))   ERROR
+
+(SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
+
+:INITIAL-CONTENTS (QUOTE ((1.0D0 2.0D0) (3.0D0 4.0D0))) :DISPLACED-TO
+DV
+:DISPLACED-INDEX-OFFSET 8))   ERROR
+
+(SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
+
+:DISPLACED-TO DV :DISPLACED-INDEX-OFFSET 8))   ERROR
+
+***************************************************************************|#
+
+(AREF DV 0)   0.0D0
+
+(AREF DV 1)   1.0D0
+
+(AREF DV 2)   2.0D0
+
+(AREF DV 3)   3.0D0
+
+(AREF DV 4)   4.0D0
+
+(AREF DV 5)   5.0D0
+
+(AREF DV 6)   6.0D0
+
+(AREF DV 7)   7.0D0
+
+(AREF DV 8)   8.0D0
+
+(AREF DV 9)   9.0D0
+
+(SETF (AREF DV 5) -5.0D0)   -5.0D0
+
+(FORMAT T "~%Definiere Testfkt fuer Indices~%")   NIL
+
+(DEFUN ARRAY-INDEX-TEST (A &REST SUBS) (UNLESS
+(APPLY (FUNCTION ARRAY-IN-BOUNDS-P) A SUBS)
+(RETURN-FROM ARRAY-INDEX-TEST (QUOTE ERROR))) (=
+(APPLY (FUNCTION ARRAY-ROW-MAJOR-INDEX) A SUBS) (APPLY (FUNCTION +)
+(MAPLIST
+(FUNCTION (LAMBDA (X Y) (* (CAR X) (APPLY (FUNCTION *) (CDR Y)))))
+SUBS
+(ARRAY-DIMENSIONS A)))))   ARRAY-INDEX-TEST
+
+(ARRAY-INDEX-TEST (MAKE-ARRAY (QUOTE (5 4 3 2 1))) 4 2 2 1 0)   T
+
+(ARRAY-INDEX-TEST (MAKE-ARRAY (QUOTE (5 4 3 2 1))) 3 4 2 1 2)   ERROR
+
+(FORMAT T "~%Test Bitfelder ~%")   NIL
+
+(SETQ BVZERO (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT
+0))
+#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+(SETQ BVONE (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT
+1))
+#*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
+
+(SETQ BV3 (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT
+0))
+#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+(SETQ BV2 (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT
+0))
+#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+(SETQ BV1 (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT
+0))
+#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+(FORMAT T "~%Setze Bitfelder ~%")   NIL
+
+(DOTIMES (I 50 BV1) (SETF (SBIT BV1 (* I 2)) 1))
+#*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010
+
+(DOTIMES (I 50 BV2) (SETF (BIT BV2 (* I 2)) 1))
+#*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010
+
+(EQUALP BV1 BV2)   T
+(DOTIMES (I 25 BV3) (SETF (SBIT BV3 (* I 4)) 1))
+#*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000
+
+(BIT-AND BV1 BV3)
+#*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000
+
+(BIT-IOR BV1 BV3)
+#*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010
+
+(BIT-XOR BV1 BV3)
+#*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010
+
+(BIT-EQV BV1 BV3)
+#*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101
+
+(BIT-NAND BV1 BV3)
+#*0111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111
+
+(BIT-ANDC1 BV1 BV3)
+#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+(BIT-ANDC2 BV1 BV3)
+#*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010
+
+(BIT-ORC1 BV1 BV3)
+#*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101
+
+(BIT-ORC2 BV1 BV3)
+#*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
+
+(BIT-NOT BV1)
+#*0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101
+
+(BIT-NOT BVZERO)
+#*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
+
+(BIT-NOT BVONE)
+#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+(FORMAT T "~%Teste Operationen mit Fillpointern ~%")   NIL
+
+(MAKE-ARRAY (QUOTE (3 4 5)) :FILL-POINTER T)   ERROR
+
+(equalp (MAKE-ARRAY 5 :FILL-POINTER 5)
+        #+XCL '#(0 0 0 0 0) #-XCL '#(nil nil nil nil nil))
+T
+
+(MAKE-ARRAY 5 :FILL-POINTER -5)   ERROR
+
+(FORMAT T "~%Allgem. Vector mit Fillpointer ~%")   NIL
+
+(PROGN (SETQ VMF (MAKE-ARRAY 5 :FILL-POINTER 0)) T)   T
+
+(FILL-POINTER VMF)   0
+
+(VECTOR-PUSH (QUOTE A) VMF)   0
+
+(FILL-POINTER VMF)   1
+
+(VECTOR-PUSH (QUOTE B) VMF)   1
+
+(VECTOR-PUSH (QUOTE C) VMF)   2
+
+(VECTOR-PUSH (QUOTE D) VMF)   3
+
+(VECTOR-PUSH (QUOTE E) VMF)   4
+
+(VECTOR-PUSH (QUOTE VOLL) VMF)   NIL
+
+(VECTOR-POP VMF)   E
+
+(VECTOR-POP VMF)   D
+
+(VECTOR-POP VMF)   C
+
+(VECTOR-POP VMF)   B
+
+(VECTOR-POP VMF)   A
+
+(VECTOR-POP VMF)   ERROR
+
+(FORMAT T "~%Adjustabler allgem. Vector mit Fillpointer~%")   NIL
+
+(PROGN (SETQ VMFA (MAKE-ARRAY 5 :FILL-POINTER 0 :ADJUSTABLE T)) T)
+  T
+
+(FILL-POINTER VMFA)   0
+
+(VECTOR-PUSH-EXTEND (QUOTE A) VMFA)   0
+
+(FILL-POINTER VMFA)   1
+
+(VECTOR-PUSH-EXTEND (QUOTE B) VMFA)   1
+
+(VECTOR-PUSH-EXTEND (QUOTE C) VMFA)   2
+
+(VECTOR-PUSH-EXTEND (QUOTE D) VMFA)   3
+
+(VECTOR-PUSH-EXTEND (QUOTE E) VMFA)   4
+
+(VECTOR-PUSH-EXTEND (QUOTE VOLL) VMFA)   5
+
+(VECTOR-POP VMFA)   VOLL
+
+(VECTOR-POP VMFA)   E
+
+(VECTOR-POP VMFA)   D
+
+(VECTOR-POP VMFA)   C
+
+(VECTOR-POP VMFA)   B
+
+(VECTOR-POP VMFA)   A
+
+(FORMAT T "~%Doppeltgen. Vector mit Fillpointer ~%")   NIL
+
+(PROGN
+(SETQ VMFD (MAKE-ARRAY 5 :FILL-POINTER 0 :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)))
+T)   T
+
+(FILL-POINTER VMFD)   0
+
+(VECTOR-PUSH 0.0D0 VMFD)   0
+
+(FILL-POINTER VMFD)   1
+
+(VECTOR-PUSH 1.0D0 VMFD)   1
+
+(VECTOR-PUSH 2.0D0 VMFD)   2
+
+(VECTOR-PUSH 3.0D0 VMFD)   3
+
+(VECTOR-PUSH 4.0D0 VMFD)   4
+
+(VECTOR-PUSH 5.0D0 VMFD)   NIL
+
+(VECTOR-POP VMFD)   4.0D0
+
+(VECTOR-POP VMFD)   3.0D0
+
+(VECTOR-POP VMFD)   2.0D0
+
+(VECTOR-POP VMFD)   1.0D0
+
+(VECTOR-POP VMFD)   0.0D0
+
+(VECTOR-POP VMFD)   ERROR
+
+(FORMAT T "~%Doppeltgen. adjust. Vector mit Fillpointer ~%")   NIL
+
+(PROGN (SETQ VMFAD
+(MAKE-ARRAY 5 :FILL-POINTER 0 :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT) :ADJUSTABLE
+T))
+T)   T
+
+(FILL-POINTER VMFAD)   0
+
+(VECTOR-PUSH-EXTEND 0.0D0 VMFAD)   0
+
+(FILL-POINTER VMFAD)   1
+
+(VECTOR-PUSH-EXTEND 1.0D0 VMFAD)   1
+
+(VECTOR-PUSH-EXTEND 2.0D0 VMFAD)   2
+
+(VECTOR-PUSH-EXTEND 3.0D0 VMFAD)   3
+
+(VECTOR-PUSH-EXTEND 4.0D0 VMFAD)   4
+
+(VECTOR-PUSH-EXTEND 5.0D0 VMFAD)   5
+
+(VECTOR-POP VMFAD)   5.0D0
+
+(VECTOR-POP VMFAD)   4.0D0
+
+(VECTOR-POP VMFAD)   3.0D0
+
+(VECTOR-POP VMFAD)   2.0D0
+
+(VECTOR-POP VMFAD)   1.0D0
+
+(VECTOR-POP VMFAD)   0.0D0
+
+(VECTOR-PUSH-EXTEND 5.0S0 VMFAD)
+#+(or XCL GCL ALLEGRO) ERROR #+(or CLISP ECLS (and AKCL (not GCL))) 0
+#-(or XCL CLISP AKCL ALLEGRO ECLS) UNKNOWN
+
diff --git a/src/tests/backquot.tst b/src/tests/backquot.tst
new file mode 100644
index 000000000..b946fd9f7
--- /dev/null
+++ b/src/tests/backquot.tst
@@ -0,0 +1,26 @@
+;;; testen von backquote
+
+
+(setf x '(a b c))
+(a b c)
+
+`(x ,x ,@x foo ,(cadr  x) bar ,(cdr x) baz ,@(cdr x) ,. x)
+(X (A B C) A B C FOO B BAR (B C) BAZ B C A B C)
+
+(read-from-string "`,@x")
+ERROR
+
+`(,x . ,x)      ; = (append (list x) x)
+((a b c) a b c)
+
+
+(read-from-string "`(,x . ,@x)")
+ERROR
+
+
+(read-from-string ",x")
+ERROR
+
+`#(1 2 3 4)
+#(1 2 3 4)
+
diff --git a/src/tests/characters.tst b/src/tests/characters.tst
new file mode 100644
index 000000000..50bca25c8
--- /dev/null
+++ b/src/tests/characters.tst
@@ -0,0 +1,652 @@
+
+CHAR-CODE-LIMIT
+#+XCL 128 #+(or ECLS CLISP AKCL) 256 #+ALLEGRO 65536 #-(or XCL CLISP AKCL ALLEGRO ECLS) UNKNOWN
+
+(STANDARD-CHAR-P #\a)
+T
+
+(STANDARD-CHAR-P #\$)
+T
+
+(STANDARD-CHAR-P #\.)
+T
+
+(STANDARD-CHAR-P #\A)
+T
+
+(STANDARD-CHAR-P 1)
+ERROR
+
+(STANDARD-CHAR-P #\\)
+T
+
+(STANDARD-CHAR-P #\5)
+T
+
+(STANDARD-CHAR-P #\))
+T
+
+(STANDARD-CHAR-P #\%)
+T
+
+(STANDARD-CHAR-P #\BACKSPACE)
+#+XCL T #-XCL NIL
+
+(STANDARD-CHAR-P #\PAGE)
+#+XCL T #-XCL NIL
+
+(STANDARD-CHAR-P #\RETURN)
+#+XCL T #-XCL NIL
+
+(GRAPHIC-CHAR-P #\a)
+T
+
+(GRAPHIC-CHAR-P #\$)
+T
+
+(GRAPHIC-CHAR-P #\.)
+T
+
+(GRAPHIC-CHAR-P #\A)
+T
+
+(GRAPHIC-CHAR-P 1)
+ERROR
+
+(GRAPHIC-CHAR-P #\\)
+T
+
+(GRAPHIC-CHAR-P #\5)
+T
+
+(GRAPHIC-CHAR-P #\))
+T
+
+(GRAPHIC-CHAR-P #\%)
+T
+
+(GRAPHIC-CHAR-P #\BACKSPACE)
+NIL
+
+(GRAPHIC-CHAR-P #\PAGE)
+NIL
+
+(GRAPHIC-CHAR-P #\RETURN)
+NIL
+
+#-ANSI-CL (STRING-CHAR-P #\a)
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P #\$)
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P #\.)
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P #\A)
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P 1)
+#-ANSI-CL ERROR
+
+#-ANSI-CL (STRING-CHAR-P #\\)
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P #\5)
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P #\))
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P #\%)
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P #\BACKSPACE)
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P #\PAGE)
+#-ANSI-CL T
+
+#-ANSI-CL (STRING-CHAR-P #\RETURN)
+#-ANSI-CL T
+
+(ALPHA-CHAR-P #\a)
+T
+
+(ALPHA-CHAR-P #\$)
+NIL
+
+(ALPHA-CHAR-P #\.)
+NIL
+
+(ALPHA-CHAR-P #\A)
+T
+
+(ALPHA-CHAR-P 1)
+ERROR
+
+(ALPHA-CHAR-P #\\)
+NIL
+
+(ALPHA-CHAR-P #\5)
+NIL
+
+(ALPHA-CHAR-P #\))
+NIL
+
+(ALPHA-CHAR-P #\%)
+NIL
+
+(ALPHA-CHAR-P #\BACKSPACE)
+NIL
+
+(ALPHA-CHAR-P #\PAGE)
+NIL
+
+(ALPHA-CHAR-P #\RETURN)
+NIL
+
+(UPPER-CASE-P #\a)
+NIL
+
+(UPPER-CASE-P #\$)
+NIL
+
+(UPPER-CASE-P #\.)
+NIL
+
+(UPPER-CASE-P #\A)
+T
+
+(UPPER-CASE-P 1)
+ERROR
+
+(UPPER-CASE-P #\\)
+NIL
+
+(UPPER-CASE-P #\5)
+NIL
+
+(UPPER-CASE-P #\))
+NIL
+
+(UPPER-CASE-P #\%)
+NIL
+
+(UPPER-CASE-P #\BACKSPACE)
+NIL
+
+(UPPER-CASE-P #\PAGE)
+NIL
+
+(UPPER-CASE-P #\RETURN)
+NIL
+
+(LOWER-CASE-P #\a)
+T
+
+(LOWER-CASE-P #\$)
+NIL
+
+(LOWER-CASE-P #\.)
+NIL
+
+(LOWER-CASE-P #\A)
+NIL
+
+(LOWER-CASE-P 1)
+ERROR
+
+(LOWER-CASE-P #\\)
+NIL
+
+(LOWER-CASE-P #\5)
+NIL
+
+(LOWER-CASE-P #\))
+NIL
+
+(LOWER-CASE-P #\%)
+NIL
+
+(LOWER-CASE-P #\BACKSPACE)
+NIL
+
+(LOWER-CASE-P #\PAGE)
+NIL
+
+(LOWER-CASE-P #\RETURN)
+NIL
+
+(BOTH-CASE-P #\a)
+T
+
+(BOTH-CASE-P #\$)
+NIL
+
+(BOTH-CASE-P #\.)
+NIL
+
+(BOTH-CASE-P #\A)
+T
+
+(BOTH-CASE-P 1)
+ERROR
+
+(BOTH-CASE-P #\\)
+NIL
+
+(BOTH-CASE-P #\5)
+NIL
+
+(BOTH-CASE-P #\))
+NIL
+
+(BOTH-CASE-P #\%)
+NIL
+
+(BOTH-CASE-P #\BACKSPACE)
+NIL
+
+(BOTH-CASE-P #\PAGE)
+NIL
+
+(BOTH-CASE-P #\RETURN)
+NIL
+
+(DIGIT-CHAR-P #\a)
+NIL
+
+(DIGIT-CHAR-P #\$)
+NIL
+
+(DIGIT-CHAR-P #\.)
+NIL
+
+(DIGIT-CHAR-P #\A)
+NIL
+
+(DIGIT-CHAR-P 1)
+ERROR
+
+(DIGIT-CHAR-P #\\)
+NIL
+
+(DIGIT-CHAR-P #\5)
+5
+
+(DIGIT-CHAR-P #\))
+NIL
+
+(DIGIT-CHAR-P #\%)
+NIL
+
+(DIGIT-CHAR-P #\BACKSPACE)
+NIL
+
+(DIGIT-CHAR-P #\PAGE)
+NIL
+
+(DIGIT-CHAR-P #\RETURN)
+NIL
+
+(DIGIT-CHAR-P #\5 4)
+NIL
+
+(DIGIT-CHAR-P #\5 8)
+5
+
+(DIGIT-CHAR-P #\E 16)
+14
+
+(DIGIT-CHAR-P #\R 35)
+27
+
+(DIGIT-CHAR-P #\5 4)
+NIL
+
+(DIGIT-CHAR-P #\5 5)
+NIL
+
+(DIGIT-CHAR-P #\5 6)
+5
+
+(DIGIT-CHAR-P #\1 2)
+1
+
+(ALPHANUMERICP #\a)
+T
+
+(ALPHANUMERICP #\$)
+NIL
+
+(ALPHANUMERICP #\.)
+NIL
+
+(ALPHANUMERICP #\A)
+T
+
+(ALPHANUMERICP 1)
+ERROR
+
+(ALPHANUMERICP #\\)
+NIL
+
+(ALPHANUMERICP #\5)
+T
+
+(ALPHANUMERICP #\))
+NIL
+
+(ALPHANUMERICP #\%)
+NIL
+
+(ALPHANUMERICP #\BACKSPACE)
+NIL
+
+(ALPHANUMERICP #\PAGE)
+NIL
+
+(ALPHANUMERICP #\RETURN)
+NIL
+
+(ALPHANUMERICP #\5 4)
+ERROR
+
+(ALPHANUMERICP #\5 8)
+ERROR
+
+(ALPHANUMERICP #\E 16)
+ERROR
+
+(ALPHANUMERICP #\R 35)
+ERROR
+
+(CHAR= #\d #\d)
+T
+
+(CHAR/= #\d #\d)
+NIL
+
+(CHAR= #\d #\x)
+NIL
+
+(CHAR/= #\d #\x)
+T
+
+(CHAR= #\d #\D)
+NIL
+
+(CHAR/= #\d #\D)
+T
+
+(CHAR= #\d #\d #\d #\d)
+T
+
+(CHAR/= #\d #\d #\d #\d)
+NIL
+
+(CHAR= #\d #\d #\x #\d)
+NIL
+
+(CHAR/= #\d #\d #\x #\d)
+NIL
+
+(CHAR= #\d #\y #\x #\c)
+NIL
+
+(CHAR/= #\d #\y #\x #\c)
+T
+
+(CHAR= #\d #\c #\d)
+NIL
+
+(CHAR/= #\d #\c #\d)
+NIL
+
+(CHAR< #\d #\x)
+T
+
+(CHAR<= #\d #\x)
+T
+
+(CHAR< #\d #\d)
+NIL
+
+(CHAR<= #\d #\d)
+T
+
+(CHAR< #\a #\e #\y #\z)
+T
+
+(CHAR<= #\a #\e #\y #\z)
+T
+
+(CHAR< #\a #\e #\e #\y)
+NIL
+
+(CHAR<= #\a #\e #\e #\y)
+T
+
+(CHAR> #\e #\d)
+T
+
+(CHAR>= #\e #\d)
+T
+
+(CHAR> #\d #\c #\b #\a)
+T
+
+(CHAR>= #\d #\c #\b #\a)
+T
+
+(CHAR> #\d #\d #\b #\a)
+NIL
+
+(CHAR>= #\d #\d #\b #\a)
+T
+
+(CHAR> #\e #\d #\b #\c #\a)
+NIL
+
+(CHAR>= #\e #\d #\b #\c #\a)
+NIL
+
+(CHAR> #\z #\A)
+T
+
+(CHAR> #\Z #\a)
+NIL
+
+(CHAR< #\9 #\a)
+T
+
+(CHAR> #\9 #\a)
+NIL
+
+(CHAR> #\z #\0)
+T
+
+(CHAR< #\z #\0)
+NIL
+
+(CHAR-EQUAL #\d #\d)
+T
+
+(CHAR-NOT-EQUAL #\d #\d)
+NIL
+
+(CHAR-EQUAL #\d #\x)
+NIL
+
+(CHAR-NOT-EQUAL #\d #\x)
+T
+
+(CHAR-EQUAL #\d #\D)
+T
+
+(CHAR-NOT-EQUAL #\d #\D)
+NIL
+
+(CHAR-EQUAL #\d #\d #\d #\d)
+T
+
+(CHAR-NOT-EQUAL #\d #\d #\d #\d)
+NIL
+
+(CHAR-EQUAL #\d #\d #\x #\d)
+NIL
+
+(CHAR-NOT-EQUAL #\d #\d #\x #\d)
+NIL
+
+(CHAR-EQUAL #\d #\y #\x #\c)
+NIL
+
+(CHAR-NOT-EQUAL #\d #\y #\x #\c)
+T
+
+(CHAR-EQUAL #\d #\c #\d)
+NIL
+
+(CHAR-NOT-EQUAL #\d #\c #\d)
+NIL
+
+(CHAR-LESSP #\d #\x)
+T
+
+(CHAR-NOT-GREATERP #\d #\x)
+T
+
+(CHAR-LESSP #\d #\d)
+NIL
+
+(CHAR-NOT-GREATERP #\d #\d)
+T
+
+(CHAR-LESSP #\a #\e #\y #\z)
+T
+
+(CHAR-NOT-GREATERP #\a #\e #\y #\z)
+T
+
+(CHAR-LESSP #\a #\e #\e #\y)
+NIL
+
+(CHAR-NOT-GREATERP #\a #\e #\e #\y)
+T
+
+(CHAR-GREATERP #\e #\d)
+T
+
+(CHAR-NOT-LESSP #\e #\d)
+T
+
+(CHAR-GREATERP #\d #\c #\b #\a)
+T
+
+(CHAR-NOT-LESSP #\d #\c #\b #\a)
+T
+
+(CHAR-GREATERP #\d #\d #\b #\a)
+NIL
+
+(CHAR-NOT-LESSP #\d #\d #\b #\a)
+T
+
+(CHAR-GREATERP #\e #\d #\b #\c #\a)
+NIL
+
+(CHAR-NOT-LESSP #\e #\d #\b #\c #\a)
+NIL
+
+(CHAR-GREATERP #\z #\A)
+T
+
+(CHAR-GREATERP #\Z #\a)
+T
+
+(CHAR-LESSP #\9 #\a)
+T
+
+(CHAR-GREATERP #\9 #\a)
+NIL
+
+(CHAR-GREATERP #\z #\0)
+T
+
+(CHAR-LESSP #\z #\0)
+NIL
+
+(CHAR-EQUAL #\A #\a)
+T
+
+(CHAR-UPCASE #\a)
+#\A
+
+(CHAR-UPCASE #\A)
+#\A
+
+(CHAR-UPCASE #\5)
+#\5
+
+(CHAR-UPCASE #\;)
+#\;
+
+(CHAR-UPCASE #\=)
+#\=
+
+(CHAR= (CHAR-DOWNCASE (CHAR-UPCASE #\x)) #\x)
+T
+
+(CHAR-DOWNCASE #\A)
+#\a
+
+(CHAR-DOWNCASE #\a)
+#\a
+
+(CHAR-DOWNCASE #\%)
+#\%
+
+(CHAR-DOWNCASE #\+)
+#\+
+
+(CHAR-DOWNCASE #\-)
+#\-
+
+(CHAR= (CHAR-UPCASE (CHAR-DOWNCASE #\X)) #\X)
+T
+
+(DIGIT-CHAR 7)
+#\7
+
+(DIGIT-CHAR 12)
+NIL
+
+(DIGIT-CHAR (QUOTE A))
+ERROR
+
+(DIGIT-CHAR 12 16)
+#\C
+
+(DIGIT-CHAR 6 2)
+NIL
+
+(DIGIT-CHAR 1 2)
+#\1
+
+#-ANSI-CL CHAR-CONTROL-BIT
+#-ANSI-CL 1
+
+#-ANSI-CL CHAR-META-BIT
+#-ANSI-CL 2
+
+#-ANSI-CL CHAR-SUPER-BIT
+#-ANSI-CL 4
+
+#-ANSI-CL CHAR-HYPER-BIT
+#-ANSI-CL 8
+
+(char-name #\Space) "Space"
+
+(char-name #\Newline) "Newline"
diff --git a/src/tests/clos.tst b/src/tests/clos.tst
new file mode 100644
index 000000000..5d9d699d8
--- /dev/null
+++ b/src/tests/clos.tst
@@ -0,0 +1,330 @@
+(use-package "CLOS")
+T
+
+(unintern '<C1>)
+T
+
+(progn
+(defclass <C1> ()
+  ((x :initform 0 :accessor x-val :reader get-x :writer set-x :initarg :x)
+   (y :initform 1 :accessor y-val :reader get-y :writer set-y :initarg :y)))
+())
+NIL
+
+(progn
+(defclass <C2> (<C1>)
+  ((z :initform 0 :accessor z-val :reader get-z :writer set-z :initarg :z)))
+())
+NIL
+
+(defparameter a (make-instance (find-class '<C1>) :x 10))
+A
+
+(x-val a)
+10
+
+(y-val a)
+1
+
+(setf (x-val a) 20)
+20
+
+(x-val a)
+20
+
+(get-x a)
+20
+
+(set-x 10 a)
+10
+
+(x-val a)
+10
+
+(defparameter b (make-instance (find-class '<C2>) :x 10 :y 20 :z 30))
+B
+
+(x-val b)
+10
+
+(y-val b)
+20
+
+(z-val b)
+30
+
+(progn
+(defgeneric f (x y)
+  (:method ((x t) (y t))
+    (list x y)))
+(defmethod f ((i integer) (j number))
+  (+ i j))
+(defmethod f ((s1 string) (s2 string))
+    (concatenate 'string s1 s2))
+())
+NIL
+
+(f t t)
+(T T)
+
+(f 2 3)
+5
+
+(f 2 3.0)
+5.0
+
+(f 2.0 3)
+(2.0 3)
+
+(f "ab" "cd")
+"abcd"
+
+(f 1 "abc")
+(1 "abc")
+
+(progn
+(defgeneric f (x y)
+  (:method ((x t) (y t))
+    (list x y))
+  (:method ((i number) (j integer))
+    (list (call-next-method) (- i j)))
+  (:method ((i integer) (j number))
+    (list (call-next-method) (+ i j))))
+())
+NIL
+
+(f 'x 'y)
+(X Y)
+
+(f 1 2)
+(((1 2) -1) 3)
+
+(f 1 2.0)
+((1 2.0) 3.0)
+
+(f 1.0 2)
+((1.0 2) -1.0)
+
+(progn
+(defgeneric g (x)
+  (:method ((x null))
+    (cons 'null (call-next-method)))
+  (:method ((x list))
+    (if (next-method-p) (cons 'list (call-next-method)) '(list$)))
+  (:method ((x symbol))
+    (if (next-method-p) (cons 'symbol (call-next-method)) '(symbol$))))
+())
+NIL
+
+(g 'x)
+(SYMBOL$)
+
+(g '(x))
+(LIST$)
+
+(g '())
+(NULL SYMBOL LIST$)
+
+(defvar hl)
+HL
+
+(progn
+(defgeneric hgen (x)
+  (:method ((x integer))
+    (setf hl (cons 'i-primary-1 hl))
+    (call-next-method)
+    (setf hl (cons 'i-primary-2 hl)))
+  (:method :before ((x integer))
+    (setf hl (cons 'i-before hl)))
+  (:method :after ((x integer))
+    (setf hl (cons 'i-after hl)))
+  (:method :around ((x integer))
+    (setf hl (cons 'i-around-1 hl))
+    (call-next-method)
+    (setf hl (cons 'i-around-2 hl)))
+  (:method ((x number))
+    (setf hl (cons 'n-primary-1 hl))
+    (call-next-method)
+    (setf hl (cons 'n-primary-2 hl)))
+  (:method :before ((x number))
+    (setf hl (cons 'n-before hl)))
+  (:method :after ((x number))
+    (setf hl (cons 'n-after hl)))
+  (:method :around ((x number))
+    (setf hl (cons 'n-around-1 hl))
+    (call-next-method)
+    (setf hl (cons 'n-around-2 hl)))
+  (:method ((x t))
+    (setf hl (cons 'innermost hl))))
+(defun h (x)
+  (setf hl '()) (hgen x) (reverse hl))
+)
+H
+
+(h 'abc)
+(INNERMOST)
+
+(h 3.14)
+(N-AROUND-1 N-BEFORE N-PRIMARY-1 INNERMOST N-PRIMARY-2 N-AFTER N-AROUND-2)
+
+(h 3)
+(I-AROUND-1 N-AROUND-1 I-BEFORE N-BEFORE I-PRIMARY-1 N-PRIMARY-1 INNERMOST
+  N-PRIMARY-2 I-PRIMARY-2 N-AFTER I-AFTER N-AROUND-2 I-AROUND-2
+)
+
+(unintern '<C1>)
+T
+
+(progn
+(defclass <C1> ()
+  ((x :initform 0 :accessor x-val :initarg :x)
+   (y :initform 1 :accessor y-val :initarg :y)))
+())
+NIL
+
+(defparameter a (make-instance (find-class '<C1>) :x 10))
+A
+
+(defparameter b (make-instance (find-class '<C1>) :y 20 :x 10))
+B
+
+(defparameter c (make-instance (find-class '<C1>)))
+C
+
+(x-val a)
+10
+
+(y-val a)
+1
+
+(x-val b)
+10
+
+(y-val b)
+20
+
+(x-val c)
+0
+
+(y-val c)
+1
+
+(unintern '<C1>)
+T
+
+(progn
+(defclass <C1> ()
+  ((x :initform 0 :accessor x-val :initarg :x)
+   (y :initform 1 :accessor y-val :initarg :y)))
+(defmethod initialize-instance :after ((instance <C1>) &rest initvalues)
+  (if (= (x-val instance) 0)
+    (setf (x-val instance) (y-val instance))))
+())
+NIL
+
+(x-val (make-instance (find-class '<C1>)))
+1
+
+(x-val (make-instance (find-class '<C1>) :x 10))
+10
+
+(x-val (make-instance (find-class '<C1>) :y 20))
+20
+
+(x-val (make-instance (find-class '<C1>) :x 10 :y 20))
+10
+
+(unintern '<C1>)
+T
+
+(eq (class-of ())               (find-class 'null))
+T
+
+(eq (class-of t)                (find-class 'symbol))
+T
+
+(eq (class-of 10)               (find-class #+ALLEGRO 'fixnum #-ALLEGRO 'integer))
+T
+
+(eq (class-of 10.0)             (find-class #+ALLEGRO 'single-float #-ALLEGRO 'float))
+T
+
+(eq (class-of '(a b))           (find-class 'cons))
+T
+
+(eq (class-of "abc")            (find-class 'string))
+T
+
+(eq (class-of '#(1 2))          (find-class 'vector))
+T
+
+(eq (class-of #'car)            (find-class 'function))
+T
+
+(eq (class-of #'make-instance)  (find-class 'standard-generic-function))
+T
+
+(eq (class-of '#2a((a) (b)))    (find-class 'array))
+T
+
+(eq (class-of *standard-input*) (find-class 'stream))
+NIL
+
+(eq (class-of (lambda (x) x))   (find-class 'function))
+T
+
+(eq (class-of (find-class 't)) (find-class 'built-in-class))
+T
+
+(typep "abc" (find-class 't))
+T
+
+(typep "abc" (find-class 'array))
+T
+
+(typep "abc" (find-class 'vector))
+T
+
+(typep "abc" (find-class 'string))
+T
+
+(typep "abc" (find-class 'integer))
+NIL
+
+(typep 3 (find-class 't))
+T
+
+(typep 3 (find-class 'number))
+T
+
+(typep 3 (find-class 'float))
+NIL
+
+(typep 3 (find-class 'integer))
+T
+
+(typep 3 (find-class 'string))
+NIL
+
+(typep *standard-input* (find-class 'stream))
+T
+
+#+CLISP
+(defun subclassp (class1 class2)
+  (clos::subclassp class1 class2)
+)
+#+ALLEGRO
+(defun subclassp (class1 class2)
+  (finalize-inheritance class1)
+  (not (null (member class2 (class-precedence-list class1))))
+)
+#+(or CLISP ALLEGRO) SUBCLASSP
+
+(subclassp (find-class 'number)           (find-class 't))
+T
+
+(subclassp (find-class 'integer)          (find-class 'number))
+T
+
+(subclassp (find-class 'float)            (find-class 'number))
+T
diff --git a/src/tests/conditions.tst b/src/tests/conditions.tst
new file mode 100644
index 000000000..ed736e69c
--- /dev/null
+++ b/src/tests/conditions.tst
@@ -0,0 +1,370 @@
+;;;; Test suite for the Common Lisp condition system
+;;;; Written by David Gadbois <gadbois@cs.utexas.edu> 30.11.1993
+
+;;;
+;;; Helpers
+;;;
+
+#+CLISP
+(defun my-cpl (class)
+  (clos::class-precedence-list (clos:find-class class))
+)
+#+ALLEGRO
+(defun my-cpl (class)
+  (clos:finalize-inheritance (find-class class))
+  (clos:class-precedence-list (find-class class))
+)
+MY-CPL
+
+(defun check-superclasses (class expected)
+  (let ((expected (list* class 't #+CLISP 'clos:standard-object #+ALLEGRO 'standard-object 'condition expected))
+        (super (mapcar #' #+CLISP clos:class-name #+ALLEGRO class-name (my-cpl class))))
+    (and (null (set-difference super expected))
+         (null (set-difference expected super)))))
+CHECK-SUPERCLASSES
+
+;;;
+;;; IGNORE-ERRORS
+;;;
+;;; If this does not work, none of the tests that check for getting an error
+;;; will.
+
+;;; IGNORE-ERRORS should work.
+(multiple-value-bind (value condition)
+    (ignore-errors (error "Foo"))
+  (list value (type-of condition)))
+(nil simple-error)
+
+;;; IGNORE-ERRORS should not interfere with values in non-error situations.
+(multiple-value-list
+    (ignore-errors (values 23 42)))
+(23 42)
+
+;;;
+;;; Predefined condition types.
+;;;
+
+(check-superclasses 'warning '()) T
+(check-superclasses 'style-warning '(warning)) T
+(check-superclasses 'serious-condition '()) T
+(check-superclasses 'error '(serious-condition)) T
+(check-superclasses 'cell-error '(error serious-condition)) T
+(check-superclasses 'parse-error '(error serious-condition)) T
+(check-superclasses 'storage-condition '(serious-condition)) T
+(check-superclasses 'simple-error '(simple-condition error serious-condition)) T
+(check-superclasses 'simple-condition '()) T
+(check-superclasses 'simple-warning '(simple-condition warning)) T
+(check-superclasses 'file-error '(error serious-condition)) T
+(check-superclasses 'control-error '(error serious-condition)) T
+(check-superclasses 'program-error '(error serious-condition)) T
+(check-superclasses 'undefined-function '(cell-error error serious-condition)) T
+(check-superclasses 'arithmetic-error '(error serious-condition)) T
+(check-superclasses 'division-by-zero '(arithmetic-error error serious-condition)) T
+(check-superclasses 'floating-point-invalid-operation '(arithmetic-error error serious-condition)) T
+(check-superclasses 'floating-point-inexact '(arithmetic-error error serious-condition)) T
+(check-superclasses 'floating-point-overflow '(arithmetic-error error serious-condition)) T
+(check-superclasses 'floating-point-underflow '(arithmetic-error error serious-condition)) T
+(check-superclasses 'unbound-slot '(cell-error error serious-condition)) T
+(check-superclasses 'package-error '(error serious-condition)) T
+(check-superclasses 'print-not-readable '(error serious-condition)) T
+(check-superclasses 'reader-error '(parse-error stream-error error serious-condition)) T
+(check-superclasses 'stream-error '(error serious-condition)) T
+(check-superclasses 'end-of-file '(stream-error error serious-condition)) T
+(check-superclasses 'unbound-variable '(cell-error error serious-condition)) T
+(check-superclasses 'type-error '(error serious-condition)) T
+(check-superclasses 'simple-type-error '(#-ANSI-CL simple-error simple-condition type-error error serious-condition)) T
+
+;;;
+;;; Defining conditions.
+;;;
+(progn (define-condition test () ()) t)
+T
+
+(check-superclasses  'test '())
+T
+
+(progn (define-condition test2 (test) ()) t)
+T
+
+(check-superclasses 'test2 '(test))
+T
+
+(progn (define-condition test3 (test2 simple-condition) ()) t)
+T
+
+(check-superclasses 'test3 '(test2 test simple-condition))
+T
+
+;;;
+;;; Making conditions
+;;;
+(progn (make-condition 'test) t)
+T
+
+(ignore-errors (progn (make-condition 'integer) t))
+NIL
+
+;;;
+;;; :REPORT option to DEFINE-CONDITION
+;;;
+(progn (define-condition test4 (test3)
+         ()
+         (:report (lambda (condition stream)
+                    (format stream "Yow! -- ~S" (type-of condition)))))
+       t)
+T
+
+(with-output-to-string (s) (princ (make-condition 'test4) s))
+"Yow! -- TEST4"
+
+(progn (define-condition test5 (test4) ()) t)
+T
+
+(with-output-to-string (s) (princ (make-condition 'test5) s))
+"Yow! -- TEST5"
+
+(with-output-to-string (s)
+  (princ (make-condition 'test3
+           #-ANSI-CL :format-string #+ANSI-CL :format-control "And How! -- ~S"
+           :format-arguments '(23)) s))
+"And How! -- 23"
+
+;;;
+;;; Condition slots.
+;;;
+(progn (define-condition test6 (test4)
+         ((foo :initarg :foo :initform 23 :accessor test6-foo))
+         (:report (lambda (condition stream)
+                    (format stream "~S -- ~S"
+                            (type-of condition)
+                            (test6-foo condition)))))
+       t)
+T
+
+(test6-foo (make-condition 'test6))
+23
+
+(test6-foo (make-condition 'test6 :foo 42))
+42
+
+(setf (test6-foo (make-condition 'test6 :foo 42)) 17)
+17
+
+(with-output-to-string (s) (princ (make-condition 'test6 :foo 42) s))
+"TEST6 -- 42"
+
+;;;
+;;; HANDLER-BIND
+;;;
+
+;;; You do not have to bind handlers.
+(ignore-errors
+ (handler-bind
+     ()
+   (error "Foo")))
+nil
+
+;;; Handlers should not interfere with values in non-error situations.
+(multiple-value-list
+    (block foo
+      (handler-bind
+          ((error #'(lambda (c)
+                      (declare (ignore c))
+                      (return-from foo 23))))
+        (values 42 17))))
+(42 17)
+
+;;; Handlers should work.
+(multiple-value-list
+    (block foo
+      (handler-bind 
+          ((error #'(lambda (c)
+                      (declare (ignore c))
+                      (return-from foo (values 23 17)))))
+        (error "Foo"))))
+(23 17)
+
+;;; Only the appropriate handlers should be called.
+(ignore-errors
+ (block foo
+   (handler-bind 
+       ((type-error #'(lambda (c)
+                        (declare (ignore c))
+                        (return-from foo 23))))
+     (error "Foo"))))
+nil
+
+;;; Handlers can be specified type expressions.
+(block foo
+  (handler-bind 
+      (((or type-error error)
+        #'(lambda (c)
+            (declare (ignore c))
+            (return-from foo 23))))
+    (error "Foo")))
+23
+
+;;; Handlers should be undone.
+(ignore-errors
+ (block foo
+   (let ((first-time t))
+     (handler-bind 
+         ((error
+           #'(lambda (c)
+               (declare (ignore c))
+               (if first-time
+                   (progn
+                     (setq first-time nil)
+                     (error "Bar"))
+                   (return-from foo 23)))))
+       (error "Foo")))))
+nil
+
+;;; Handlers should be undone.
+(block foo
+  (let ((first-time t))
+    (handler-bind
+        ((error
+          #'(lambda (c)
+              (declare (ignore c))
+              (return-from foo 23))))
+      (handler-bind
+          ((error 
+            #'(lambda (c)
+                (declare (ignore c))
+                (if first-time
+                    (progn
+                      (setq first-time nil)
+                      (error "Bar"))
+                    (return-from foo 42)))))
+        (error "Foo")))))
+23
+
+;;; Handlers in the same cluster should be accessible.
+(ignore-errors
+ (block foo
+   (handler-bind 
+       ((error
+         #'(lambda (c) (declare (ignore c)) nil))
+        (error
+         #'(lambda (c)
+             (declare (ignore c))
+             (return-from foo 23))))
+     (error "Foo"))))
+#-ANSI-CL nil #+ANSI-CL 23
+
+;;; Multiple handlers should work.
+(block foo
+  (handler-bind 
+      ((type-error
+        #'(lambda (c) 
+            (declare (ignore c))
+            (return-from foo 42)))
+       (error
+        #'(lambda (c)
+            (declare (ignore c))
+            (return-from foo 23))))
+    (error "Foo")))
+23
+
+;;; Handlers should be undone.
+(block foo
+  (handler-bind
+      ((error #'(lambda (c)
+                  (declare (ignore c))
+                  (return-from foo 23))))
+    (block bar
+      (handler-bind
+          ((error #'(lambda (c)
+                      (declare (ignore c))
+                      (return-from foo 42))))
+        (return-from bar)))
+    (error "Foo")))
+23
+
+;;;
+;;; HANDLER-CASE
+;;;
+
+;;; HANDLER-CASE should handle errors.
+(multiple-value-list
+    (handler-case 
+        (error "Foo")
+      (error (c) (when (typep c 'error) (values 23 42)))))
+(23 42)
+
+;;; Except those it doesn't handle.
+(ignore-errors
+ (handler-case
+     (error "Foo")
+   (type-error () 23)))
+NIL
+
+;;; You don't have to specify handlers.
+(ignore-errors
+ (handler-case
+     (error "Foo")))
+NIL
+
+;;; HANDLER-CASE should not interfere with values in non-error situations.
+(multiple-value-list
+    (handler-case
+        (values 42 17)
+      (error () 23)))
+(42 17)
+
+;;; :NO-ERROR should return values.
+(multiple-value-list
+    (handler-case
+        (values 23 42)
+      (:no-error (a b)
+        (values b a))))
+(42 23)
+
+;;; Except when there is an error.
+(handler-case
+    (error "Foo")
+  (error () 23)
+  (:no-error (&rest args) (declare (ignore args)) 42))
+23
+
+;;; Or if it is not the last clause.
+(handler-case
+    23
+  (:no-error (v) (1+ v))
+  (error () 42))
+#-ANSI-CL 23 #+ANSI-CL 24
+
+;;; Multiple handlers should be OK.
+(handler-case
+    (error "Foo")
+  (type-error () 23)
+  (error () 42))
+42
+
+;;; Handlers should get undone.
+(ignore-errors
+ (progn 
+   (block foo
+     (handler-case
+         (return-from foo 23)
+       (error () 42)))
+   (error "Foo")))
+NIL
+
+;;; Ditto.
+(ignore-errors
+ (block foo
+   (let ((first-time t))
+     (handler-case
+         (error "Foo")
+       (error ()
+         (if first-time
+             (progn
+               (setf first-time nil)
+               (error "Bar"))
+             (return-from foo 23)))))))
+NIL
+      
+
+
diff --git a/src/tests/ecl_chap11_pack.tst b/src/tests/ecl_chap11_pack.tst
new file mode 100644
index 000000000..973248c29
--- /dev/null
+++ b/src/tests/ecl_chap11_pack.tst
@@ -0,0 +1,507 @@
+;; packages-test
+;  -------------
+
+;;testfile fuer kapitel 11
+
+(packagep  *package*)
+T
+;;list-all-packages und typtest
+(let ((p (list-all-packages)))
+     (every #'packagep p))
+T
+
+;;11.6 obligate Paketnamen u. deren Abkuerzungen
+
+;;vorhandensein der standardpakete und find-package dafuer
+
+(and (find-package "CL") t)
+T
+(and (find-package "COMMON-LISP") t)
+T
+(and (find-package "CL-USER") t)
+T
+(and (find-package "COMMON-LISP-USER") t)
+T
+(and (find-package "KEYWORD") t)
+T
+
+;nicknames
+(find "CL" (package-nicknames 'common-lisp) :test #'string=)
+"CL"
+
+;package-name
+(package-name 'cl)
+"COMMON-LISP"
+(package-name 'common-lisp)
+"COMMON-LISP"
+(package-name "CL-USER")
+"COMMON-LISP-USER"
+(package-name "COMMON-LISP-USER")
+"COMMON-LISP-USER"
+
+
+;;; 11.7 anlegen von paketen, export import ...
+
+  ;package-funktionen mit nutzerdefinierten paketen
+
+;falls test1 bereits existiert
+(and (find-package 'test1)
+     (in-package test1)
+     (rename-package (find-package 'test1) 'test1-old)
+     nil)
+nil
+
+;make-package
+(package-name (make-package 'test1 :nicknames '(t1 tst1)))
+"TEST1"
+
+;package-use-list
+;(package-use-list (find-package 'test1))
+;("LISP")
+
+
+(and (in-package test1) T)
+T
+
+
+(export  '(test1::test1-y test1::test1-z)(find-package
+'"TEST1"))
+T
+
+(export  '(test1::test1-a test1::test1-b test1::test1-c) (find-package
+'test1))
+T
+
+(setf test1-a -2
+      test1-b -1
+      test1-c  0
+      test1-x  1
+      test1-y  2
+      test1-z  3)
+3
+
+;falls test2 bereits existiert
+(and
+        (find-package 'test2)
+        (rename-package (find-package 'test2) 'test2-old)
+        nil)
+nil
+
+(and (defpackage "TEST2"
+       (:nicknames "T2" "TST2")
+       (:use test1))
+     t)
+t
+
+(and (in-package test2) t)
+cl:t
+
+(lisp:package-name (lisp:find-package 'test2))
+"TEST2"
+
+(lisp:package-name lisp:*package*)
+"TEST2"
+
+(lisp:import '(lisp:error) (lisp:find-package 'test2))
+LISP:T
+
+(lisp:and (lisp:boundp 'test1-x) test1-x)
+LISP:NIL
+
+(lisp:unintern 'test1-x)
+LISP:T
+
+(eval (read-from-string "(lisp:and (lisp:boundp 'test1:test1-x) test1:test1-x)"))
+#+XCL 1 #-XCL ERROR
+
+(lisp:and (lisp:boundp 'test1::test1-x) test1::test1-x)
+1
+
+(lisp:and (lisp:boundp 'test1-y) test1-y)
+#+XCL LISP:NIL #-XCL 2
+
+(lisp:unintern 'test1-y)
+#+XCL LISP:T #-XCL LISP:NIL
+
+(lisp:and (lisp:boundp 'test1:test1-y) test1:test1-y)
+#+XCL ERROR #-XCL 2
+
+(lisp:and (lisp:boundp 'test1::test1-y) test1::test1-y)
+2
+
+(lisp:import  '(test1::test1-x test1::test1-y) (lisp:find-package 'test2))
+LISP:T
+
+(lisp:and (lisp:boundp 'test1-x) test1-x)
+1
+
+(eval (read-from-string "(lisp:and (lisp:boundp 'test1:test1-x) test1:test1-x)"))
+#+XCL 1 #-XCL ERROR
+
+(lisp:and (lisp:boundp 'test1::test1-x) test1::test1-x)
+1
+
+(lisp:and (lisp:boundp 'test1-z) test1-z)
+#+XCL LISP:NIL #-XCL 3
+
+(lisp:unintern 'test1-z (lisp:find-package 'test2))
+#+XCL LISP:T #-XCL LISP:NIL
+
+(lisp:and (lisp:boundp 'test1:test1-z) test1:test1-z)
+#+XCL ERROR #-XCL 3
+
+test1::test1-z
+3
+
+(lisp:unexport  '(test1::test1-x test1::test1-y) (lisp:find-package 'test1))
+LISP:T
+
+(lisp:and (lisp:boundp 'test1-x) test1-x)
+1
+
+(lisp:and (lisp:boundp 'test1-y) test1-y)
+#+XCL LISP:NIL #-XCL 2
+
+(lisp:unintern 'test1-x (lisp:find-package 'test2))
+LISP:T
+
+(eval (read-from-string "test1:test1-x"))
+ERROR
+
+test1::test1-x
+1
+
+test1-z
+3
+
+(lisp:unintern 'test1-z (lisp:find-package 'test2))
+#+XCL LISP:T #-XCL LISP:NIL
+
+test1:test1-z
+3
+
+test1::test1-z
+3
+
+(lisp:import 'test1::test1-z (lisp:find-package 'test2))
+LISP:T
+
+test1-z
+3
+
+test1:test1-z
+3
+
+test1::test1-z
+3
+
+test1-c
+#+XCL ERROR #-XCL 0
+
+(lisp:unintern 'test-c (lisp:find-package 'test2))
+LISP:T
+
+test1:test1-c
+0
+
+test1::test1-c
+0
+
+(lisp:import '(test1::test1-a test1::test1-b test1::test1-c)
+             (lisp:find-package 'test2))
+LISP:T
+
+test1-c
+0
+
+test1:test1-c
+0
+
+test1::test1-c
+0
+
+(lisp:eq 'test1-c 'test1::test1-c)
+LISP:T
+
+  ;Ende nutzerdefinierte Pakete
+
+;; test in standardmaessig vorgegebenen paketen
+
+; export | import | unintern
+
+(lisp:and (lisp:in-package cl-user) lisp:T)
+LISP:T
+
+(setf x 1 y 2 z 3)
+3
+
+(and (make-package 'editor)(in-package editor) t)
+T
+
+(unintern 'x)
+T
+
+(unintern 'y)
+T
+
+(unintern 'z)
+T
+
+user::x
+1
+
+(eval (read-from-string "user:x"))
+ERROR
+
+x
+error
+
+(eq 'x 'user::x)
+NIL
+
+(unintern 'x)
+T
+
+(export '(user::x user::y) (find-package 'user))
+T
+
+user::x
+1
+
+user:x
+1
+
+x
+error
+
+(unintern 'x)
+T
+
+(import 'user:x (find-package 'editor))
+T
+
+x
+1
+
+(eq 'x 'user::x)
+t
+
+(eq 'x 'user:x)
+t
+
+(eq 'editor::x 'user::x)
+t
+
+;; unexport
+
+(and (in-package cl-user) T)
+T
+
+(unexport 'y)
+T
+
+(and (in-package editor) T)
+T
+
+y
+ERROR
+
+(eval (read-from-string "user:y"))
+ERROR
+
+user::y
+2
+
+;; shadowing-import -- zunaechst ohne geerbte symbole!!
+
+(and (in-package cl-user)(package-name *package*))
+"COMMON-LISP-USER"
+
+(setf d 4 e 5 f 6 y 111 x 222)
+222
+
+(export '(user::a user::b user::c user::y user::x) (find-package 'user))
+T
+
+(import '(user::a user::b user::c user::y) (find-package 'editor))
+ERROR
+
+(and (make-package 'shadow-test)(in-package shadow-test)t)
+T
+
+(setf x 'shadow-test)
+shadow-test
+
+(shadowing-import '(user::d user::e user::f user::x)(find-package 'shadow-test))
+T
+
+x
+222
+
+(eq user::x x)
+T
+
+; shadow
+
+(shadow '(e f) (find-package 'shadow-test))
+t
+
+(setf e 'shadow-test-e)
+shadow-test-e
+
+(eq 'e 'user::e)
+#+XCL nil #-XCL t
+
+e
+shadow-test-e
+
+(eval (read-from-string "user:e"))
+error
+
+user::e
+#+XCL 5 #-XCL shadow-test-e
+
+; use-package | unuse-package
+
+(and (make-package 'use-test)(in-package use-test) t)
+t
+
+(use-package '(user))
+T
+
+user::d
+4
+
+(eval (read-from-string "user:d"))
+#+XCL 4 #-XCL ERROR
+
+d
+ERROR
+
+(unuse-package 'user)
+T
+
+user::d
+4
+
+(eval (read-from-string "user:d"))
+ERROR
+
+d
+ERROR
+
+;make-package mit beutzung eines paketes, dass geerbte symbole enthaelt
+
+(and (make-package 'inherit :nicknames '(inh i) )(in-package inherit) T)
+T
+
+(setf a 'inherita b 'inheritb)
+inheritb
+
+(export '(a b) (find-package 'inherit))
+T
+
+(and (make-package 'inherit1 :use #+ECLS '(inherit) #-ECLS 'inherit)(in-package inherit1) T)
+T
+
+a
+inherit::inherita
+
+b
+inherit::inheritb
+
+(lisp:setf c 'inherit1c)
+inherit1c
+
+(lisp:and (lisp:make-package 'inherit2 :use #+ECLS '(inherit1) #-ECLS 'inherit1)
+          (lisp:in-package inherit2) lisp:T)
+LISP:T
+
+a
+#+XCL inherita #-XCL LISP:ERROR
+
+b
+#+XCL inheritb #-XCL LISP:ERROR
+
+c
+#+XCL inherit1c #-XCL LISP:ERROR
+
+(eval (read-from-string "(lisp:eq 'c 'inherit1:c)"))
+#+XCL LISP:T #-XCL LISP:ERROR
+
+(eval (read-from-string "(lisp:eq 'a 'inherit:a)"))
+#+XCL LISP:T #-XCL LISP:ERROR
+
+(eval (read-from-string "(lisp:eq 'b 'inherit:b)"))
+#+XCL LISP:T #-XCL LISP:ERROR
+
+(lisp:eq 'c 'inherit1::c)
+#+XCL LISP:T #-XCL LISP:NIL
+
+(lisp:eq 'a 'inherit::a)
+#+XCL LISP:T #-XCL LISP:NIL
+
+(lisp:eq 'b 'inherit::b)
+#+XCL LISP:T #-XCL LISP:NIL
+
+;find-all-symbols
+
+(lisp:and (lisp:in-package user) lisp:T)
+LISP:T
+
+; find-all-symbols fehlerhaft
+(and (member 'user::x (setf s (find-all-symbols 'x)))T)
+T
+
+(eval (read-from-string "(and (member 'editor:x s) t)"))
+#+XCL T #-XCL ERROR
+
+(and (member 'user::x (setf s1 (find-all-symbols 'x)))T)
+T
+
+(set-difference s s1)
+nil                              ;Ende Kommentar
+
+;do-symbols | do-external-symbols | do-all-symbols
+
+(setf sym nil
+      esym nil
+      asym nil
+)
+nil
+
+(do-symbols (s (find-package 'user))(push (symbol-name s) sym))
+nil
+
+(do-external-symbols (s (find-package 'user))(push (symbol-name s) esym))
+nil
+
+(do-all-symbols (s)(push (symbol-name s) asym))
+nil
+
+(find "ESYM" sym :test #'string=)
+"ESYM"
+
+(find "ESYM" esym :test #'string=)
+nil
+
+(find "LAMBDA-LIST-KEYWORDS" esym :test #'string=)
+#+XCL "LAMBDA-LIST-KEYWORDS" #-XCL NIL
+
+;(count "LAMBDA-LIST-KEYWORDS" asym :test #'string=)
+;T                                                  ;viel zu lang
+
+; modules | provide | (require nicht getestet !)
+
+(and *modules* T)
+#+(or ECLS XCL) T #+CLISP NIL #-(or ECLS XCL CLISP) UNKNOWN
+
+(and (provide 'provide-test) t)
+t
+
+(find "PROVIDE-TEST" *modules* :test #'string=)
+"PROVIDE-TEST"
+
+(format t "End of file")
+nil
+
diff --git a/src/tests/ecl_chap12_spec.tst b/src/tests/ecl_chap12_spec.tst
new file mode 100644
index 000000000..effa79409
--- /dev/null
+++ b/src/tests/ecl_chap12_spec.tst
@@ -0,0 +1,558 @@
+;; -*- lisp -*-
+(defun safe-mapcar (f list)
+  (mapcar #'(lambda (x) (with-ignored-errors (funcall f x))) list))
+safe-mapcar
+(defun safe-mapcar2 (f list list2)
+  (mapcar #'(lambda (x y) (with-ignored-errors (funcall f x y))) list list2))
+safe-mapcar2
+
+(defun ~= (x y &optional (tol 1e-14))
+  (< (abs (- x y)) (if (< (abs x) tol) tol (* tol (abs x)))))
+~=
+
+(defun number-test (f x-list y-list &optional (tol 1e-14))
+  (do ((out nil)
+       (x-list x-list (cdr x-list))
+       (y-list y-list (cdr y-list)))
+      ((null x-list) out)
+    (let* ((x (car x-list))
+	   (y (car y-list))
+	   (z (with-ignored-errors (funcall f x))))
+      (cond ((eq z 'error)
+	     (push z out))
+	    ((not (~= z y tol))
+	     (push (list x z y) out))))))
+number-test
+
+(setq *read-default-float-format* 'double-float)
+double-float
+
+(defun span (min max n)
+  (do* ((m (1- n))
+	(delta (- max min))
+	(i m (1- i))
+	(out nil))
+       ((minusp i) out)
+    (push (+ min (/ (* delta i) m)) out)))
+span
+
+;;
+;; PHASES
+;;
+(defparameter z
+	'(#C(1.0 0.0)			#C(0.8660254037844386 0.5)
+	  #C(0.5 0.8660254037844386)	#C(0.0 1.0)
+	  #C(-0.5 0.8660254037844386)	#C(-0.8660254037844386 0.5)
+	  #C(-1.0 0.0)			#C(-0.8660254037844386 -0.5)
+	  #C(-0.5 -0.8660254037844386)	#C(0.0 -1.0)
+	  #C(0.5 -0.8660254037844386)	#C(0.8660254037844386 -0.5)
+	  #C(2.0 0.0)			#C(1.732050807568877 1.0)
+	  #C(1.0 1.732050807568877)	#C(0.0 2.0)
+	  #C(-1.0 1.732050807568877)	#C(-1.732050807568877 1.0)
+	  #C(-2.0 0.0)			#C(-1.732050807568877 -1.0)
+	  #C(-1.0 -1.732050807568877)	#C(0.0 -2.0)
+	  #C(1.0 -1.732050807568877)	#C(1.732050807568877 -1.0)
+	  #C(0.5 0.0)			#C(0.4330127018922193 0.25)
+	  #C(0.25 0.4330127018922193)	#C(0.0 0.5)
+	  #C(-0.25 0.4330127018922193)	#C(-0.4330127018922193 0.25)
+	  #C(-0.5 0.0)			#C(-0.4330127018922193 -0.25)
+	  #C(-0.25 -0.4330127018922193)	#C(0.0 -0.5)
+	  #C(0.25 -0.4330127018922193)	#C(0.4330127018922193 -0.25)))
+z
+
+(defparameter r-long
+  (let* ((x (span 0 (* 2 pi) 17))
+	 (y (nreverse (mapcar #'- (cdr x)))))
+    (print (nconc y x))))
+r-long
+
+(defparameter r1-long (span -1d0 1d0 33))
+r1-long
+
+;;
+;; ABS
+;;
+(safe-mapcar #'abs
+	     '(0 1 -1 12 -12 123 -123 1234 -1234 12345 -12345
+	       123456 -123456 1234567 -1234567 12345678 -12345678
+	       123456789 -123456789 1234567890 -1234567890
+	       12345678901 -12345678901 -123456789012 -123456789012
+	       1234567890123 -1234567890123 12345678901234 -12345678901234
+	       ; Rational
+	       1/2 -1/2 12/23 -12/23 123/234 -123/234 1234/2345 -1234/2345
+	       123456/234567 -123456/234567 12345678/23456789 -12345678/23456789
+	       ; Short-float
+	       0.1s0 -0.1s0 1.2s0 -1.2s0 12.34s0 -12.34s0
+	       ; Long-float
+	       0.1l0 -0.1l0 1.2l0 -1.2l0 12.34l0 -12.34l0
+	       ))
+(0 1 1 12 12 123 123 1234 1234 12345 12345
+ 123456 123456 1234567 1234567 12345678 12345678
+ 123456789 123456789 1234567890 1234567890
+ 12345678901 12345678901 123456789012 123456789012
+ 1234567890123 1234567890123 12345678901234 12345678901234
+ 1/2 1/2 12/23 12/23 123/234 123/234 1234/2345 1234/2345
+ 123456/234567 123456/234567 12345678/23456789 12345678/23456789
+ 0.1s0 0.1s0 1.2s0 1.2s0 12.34s0 12.34s0
+ 0.1l0 0.1l0 1.2l0 1.2l0 12.34l0 12.34l0)
+
+(number-test #'abs z
+	     '(1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0
+	       2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0
+	       0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5))
+nil
+	     
+;;
+;; EXP/LOG/SIN/COS/TAN/ASIN/ACOS/SINH/COSH/TANH
+;;
+;; LONG FLOAT VALUES
+(number-test #'exp r-long
+	     '(0.001867442731707989 0.00276563164936455
+	       0.004095824889350833 0.006065804724240946 0.008983291021129429
+	       0.01330400849335009 0.01970287298661711 0.02917941642331385
+	       0.04321391826377226 0.06399863193343149 0.09478022484215486
+	       0.1403669226941202 0.2078795763507619 0.307863971328499
+	       0.4559381277659962 0.6752319066557773 1 1.48097267048991
+	       2.193280050738015 3.248187813873724 4.810477380965351
+	       7.124185533219564 10.55072407419776 15.62533400776684
+	       23.14069263277927 34.27073336535329 50.75401951173493
+	       75.16531581439104 111.3177784898562 164.8585876831267
+	       244.1510628542752 361.581051558246 535.4916555247646))
+nil
+
+(number-test #'(lambda (x) (log (exp x))) r-long r-long)
+nil
+
+(number-test #'sin r-long
+	     '(2.449212707644755e-16 0.3826834323650887 0.707106781186547
+	       0.9238795325112866 1 0.9238795325112865 0.7071067811865475
+	       0.3826834323650897 -1.224606353822377e-16 -0.3826834323650899
+	       -0.7071067811865476 -0.9238795325112867 -1 -0.9238795325112867
+	       -0.7071067811865475 -0.3826834323650898 0 0.3826834323650898
+	       0.7071067811865475 0.9238795325112867 1 0.9238795325112867
+	       0.7071067811865476 0.3826834323650899 1.224606353822377e-16
+	       -0.3826834323650897 -0.7071067811865475 -0.9238795325112865 -1
+	       -0.9238795325112866 -0.707106781186547 -0.3826834323650887
+	       -2.449212707644755e-16))
+nil
+
+(number-test #'cos r-long
+	     '(1 0.9238795325112872 0.707106781186548 0.38268343236509
+	       -1.836909530733566e-16 -0.3826834323650903 -0.7071067811865477
+	       -0.9238795325112868 -1 -0.9238795325112867 -0.7071067811865475
+	       -0.3826834323650897 6.123031769111886e-17 0.3826834323650898
+	       0.7071067811865476 0.9238795325112867 1 0.9238795325112867
+	       0.7071067811865476 0.3826834323650898 6.123031769111886e-17
+	       -0.3826834323650897 -0.7071067811865475 -0.9238795325112867 -1
+	       -0.9238795325112868 -0.7071067811865477 -0.3826834323650903
+	       -1.836909530733566e-16 0.38268343236509 0.707106781186548
+	       0.9238795325112872 1))
+nil
+
+(number-test #'tan r-long
+	     '(2.449212707644755e-16 0.4142135623730938
+	       0.9999999999999987 2.414213562373094 -5443926242794615
+	       -2.414213562373091 -0.9999999999999997 -0.4142135623730949
+	       1.224606353822377e-16 0.4142135623730952 1 2.414213562373095
+	       -1.633177872838384e+16 -2.414213562373095 -0.9999999999999999
+	       -0.414213562373095 0 0.414213562373095 0.9999999999999999
+	       2.414213562373095 1.633177872838384e+16 -2.414213562373095 -1
+	       -0.4142135623730952 -1.224606353822377e-16 0.4142135623730949
+	       0.9999999999999997 2.414213562373091 5443926242794615
+	       -2.414213562373094 -0.9999999999999987 -0.4142135623730938
+	       -2.449212707644755e-16))
+nil
+
+(number-test #'sinh r-long
+	     '(-267.7448940410164 -180.7891429632983
+	       -122.0734835146929 -82.42626093920121 -55.65439759941754
+	       -37.57600590294884 -25.36715831937416 -17.12077697446499
+	       -11.54873935725775 -7.780667687916705 -5.227971924677803
+	       -3.491909305262722 -2.301298902307295 -1.470161921272612
+	       -0.8686709614860095 -0.4028703819170664 0 0.4028703819170664
+	       0.8686709614860095 1.470161921272612 2.301298902307295
+	       3.491909305262722 5.227971924677803 7.780667687916705
+	       11.54873935725775 17.12077697446499 25.36715831937416
+	       37.57600590294884 55.65439759941754 82.42626093920121
+	       122.0734835146929 180.7891429632983 267.7448940410164))
+nil
+
+(number-test #'cosh r-long
+	     '(267.7467614837482 180.7919085949477 122.0775793395823
+	       82.43232674392546 55.66338089043867 37.58930991144219
+	       25.38686119236077 17.1499563908883 11.59195327552152 7.844666319850137
+	       5.322752149519958 3.632276227956842 2.509178478658057
+	       1.778025892601111 1.324609089252006 1.078102288572844 1
+	       1.078102288572844 1.324609089252006 1.778025892601111
+	       2.509178478658057 3.632276227956842 5.322752149519958
+	       7.844666319850137 11.59195327552152 17.1499563908883 25.38686119236077
+	       37.58930991144219 55.66338089043867 82.43232674392546
+	       122.0775793395823 180.7919085949477 267.7467614837482))
+nil
+
+(number-test #'tanh r-long
+	     '(-0.9999930253396107 -0.9999847026801649
+	       -0.9999664489997958 -0.9999264147335901 -0.9998386139886326
+	       -0.9996460693605524 -0.9992238948786412 -0.9982985719754474
+	       -0.99627207622075 -0.9918417649235776 -0.9821933800072388
+	       -0.9613556585774654 -0.9171523356672744 -0.8268506816410203
+	       -0.6557942026326724 -0.3736847479012153 0 0.3736847479012153
+	       0.6557942026326724 0.8268506816410203 0.9171523356672744
+	       0.9613556585774654 0.9821933800072388 0.9918417649235776
+	       0.99627207622075 0.9982985719754474 0.9992238948786412
+	       0.9996460693605524 0.9998386139886326 0.9999264147335901
+	       0.9999664489997958 0.9999847026801649 0.9999930253396107))
+nil
+
+(defun normalize-angle (x)
+  (cond ((> x pi) (normalize-angle (- x (* 2 pi))))
+	((< x (- pi)) (normalize-angle (+ x (* 2 pi))))
+	(t x)))
+normalize-angle
+
+(number-test #'(lambda (x) (asin (sin x))) r-long
+	     '(0 0.392699081698723 0.7853981633974476
+	       1.178097245096172 1.570796326794897 1.178097245096172
+	       0.7853981633974482 0.392699081698724 0
+	       -0.3926990816987243 -0.7853981633974484 -1.178097245096172
+	       -1.570796326794897 -1.178097245096172 -0.7853981633974482
+	       -0.3926990816987241 0 0.3926990816987241 0.7853981633974482
+	       1.178097245096172 1.570796326794897 1.178097245096172
+	       0.7853981633974484 0.3926990816987243 0
+	       -0.392699081698724 -0.7853981633974482 -1.178097245096172
+	       -1.570796326794897 -1.178097245096172 -0.7853981633974476
+	       -0.392699081698723 0))
+nil
+
+(number-test #'(lambda (x) (acos (cos x))) r-long
+	     '(0 0.392699081698723 0.7853981633974476
+	       1.178097245096172 1.570796326794897 1.963495408493621
+	       2.356194490192345 2.748893571891069 3.141592653589793
+	       2.748893571891069 2.356194490192345 1.963495408493621
+	       1.570796326794897 1.178097245096172 0.7853981633974483
+	       0.3926990816987242 0 0.3926990816987242 0.7853981633974483
+	       1.178097245096172 1.570796326794897 1.963495408493621
+	       2.356194490192345 2.748893571891069 3.141592653589793
+	       2.748893571891069 2.356194490192345 1.963495408493621
+	       1.570796326794897 1.178097245096172 0.7853981633974476
+	       0.392699081698723 0))
+nil
+
+(number-test #'(lambda (x) (atan (tan x))) r-long
+	     '(0 0.392699081698723 0.7853981633974476
+	       1.178097245096172 -1.570796326794896 -1.178097245096172
+	       -0.7853981633974482 -0.392699081698724 1.224606353822377e-16
+	       0.3926990816987243 0.7853981633974484 1.178097245096172
+	       -1.570796326794897 -1.178097245096172 -0.7853981633974483
+	       -0.3926990816987241 0 0.3926990816987241 0.7853981633974483
+	       1.178097245096172 1.570796326794897 -1.178097245096172
+	       -0.7853981633974484 -0.3926990816987243 -1.224606353822377e-16
+	       0.392699081698724 0.7853981633974482 1.178097245096172
+	       1.570796326794896 -1.178097245096172 -0.7853981633974476
+	       -0.392699081698723 0))
+nil
+
+(number-test #'(lambda (x) (atan (sin x) (cos x))) r-long
+	     '(0 0.392699081698723
+	       0.7853981633974476 1.178097245096172 1.570796326794897
+	       1.963495408493621 2.356194490192345 2.748893571891069
+	       -3.141592653589793 -2.748893571891069 -2.356194490192345
+	       -1.963495408493621 -1.570796326794897 -1.178097245096172
+	       -0.7853981633974483 -0.3926990816987242 0 0.3926990816987242
+	       0.7853981633974483 1.178097245096172 1.570796326794897
+	       1.963495408493621 2.356194490192345 2.748893571891069
+	       3.141592653589793 -2.748893571891069 -2.356194490192345
+	       -1.963495408493621 -1.570796326794897 -1.178097245096172
+	       -0.7853981633974476 -0.392699081698723 0))
+nil
+
+(safe-mapcar #'(lambda (x) (apply #'atan x))
+	     '((0.0 1.0) (1.0 0.0) (0.0 -1.0) (-1.0 0.0)))
+#.(list 0.0 (/ pi 2) pi (/ pi -2))
+
+(number-test #'(lambda (x) (asinh (sinh x))) r-long r-long 1e-7)
+nil
+
+(number-test #'(lambda (x) (acosh (cosh x))) r-long (mapcar #'abs r-long) 1e-7)
+nil
+
+(number-test #'(lambda (x) (atanh (tanh x))) r-long r-long 1e-7)
+nil
+
+;; COMPLEX VALUES
+(number-test #'exp z
+	     '(#C(2.718281828459045 0) #C(2.086402233681255 1.139806735075716)
+	       #C(1.068139482280095 1.25592988452917) #C(0.5403023058681398 0.8414709848078965)
+	       #C(0.3929465558343552 0.4620307840711053) #C(0.3691288000469654 0.2016559825387079)
+	       #C(0.3678794411714423 0) #C(0.3691288000469654 -0.2016559825387079)
+	       #C(0.3929465558343552 -0.4620307840711053) #C(0.5403023058681398 -0.8414709848078965)
+	       #C(1.068139482280095 -1.25592988452917) #C(2.086402233681255 -1.139806735075716)
+	       #C(7.38905609893065 0) #C(3.053914887386167 4.756190636053822)
+	       #C(-0.436437921247865 2.683016593282176) #C(-0.4161468365471424 0.9092974268256817)
+	       #C(-0.05906544968727827 0.363106810580375) #C(0.0955909357304609 0.1488740617136101)
+	       #C(0.1353352832366127 0) #C(0.0955909357304609 -0.1488740617136101)
+	       #C(-0.05906544968727827 -0.363106810580375) #C(-0.4161468365471424 -0.9092974268256817)
+	       #C(-0.436437921247865 -2.683016593282176) #C(3.053914887386167 -4.756190636053822)
+	       #C(1.648721270700128 0) #C(1.493961999000881 0.3814711270561049)
+	       #C(1.165517214154348 0.5387865015105857) #C(0.8775825618903728 0.479425538604203)
+	       #C(0.7069219248074672 0.3267905322054773) #C(0.6283903349436082 0.1604543954012314)
+	       #C(0.6065306597126334 0) #C(0.6283903349436082 -0.1604543954012314)
+	       #C(0.7069219248074672 -0.3267905322054773) #C(0.8775825618903728 -0.479425538604203)
+	       #C(1.165517214154348 -0.5387865015105857) #C(1.493961999000881 -0.3814711270561049)))
+nil
+
+(number-test #'sin z
+	     '(#C(0.8414709848078965 0) #C(0.8589803343001378 0.3375964632228701)
+	       #C(0.6707313588072117 0.8586367168171448) #C(0 1.175201193643801)
+	       #C(-0.6707313588072117 0.8586367168171448) #C(-0.8589803343001378 0.3375964632228701)
+	       #C(-0.8414709848078965 0) #C(-0.8589803343001378 -0.3375964632228701)
+	       #C(-0.6707313588072117 -0.8586367168171448) #C(0 -1.175201193643801)
+	       #C(0.6707313588072117 -0.8586367168171448) #C(0.8589803343001378 -0.3375964632228701)
+	       #C(0.9092974268256817 -0) #C(1.523061701931275 -0.1886862357802933)
+	       #C(2.452532348883716 1.479161975827853) #C(0 3.626860407847019)
+	       #C(-2.452532348883716 1.479161975827853) #C(-1.523061701931275 -0.1886862357802933)
+	       #C(-0.9092974268256817 -0) #C(-1.523061701931275 0.1886862357802933)
+	       #C(-2.452532348883716 -1.479161975827853) #C(0 -3.626860407847019)
+	       #C(2.452532348883716 -1.479161975827853) #C(1.523061701931275 0.1886862357802933)
+	       #C(0.479425538604203 0) #C(0.4327885168580315 0.2292976446734403)
+	       #C(0.2709627612286682 0.4327858320286366) #C(0 0.5210953054937474)
+	       #C(-0.2709627612286682 0.4327858320286366) #C(-0.4327885168580315 0.2292976446734403)
+	       #C(-0.479425538604203 0) #C(-0.4327885168580315 -0.2292976446734403)
+	       #C(-0.2709627612286682 -0.4327858320286366) #C(0 -0.5210953054937474)
+	       #C(0.2709627612286682 -0.4327858320286366) #C(0.4327885168580315 -0.2292976446734403)))
+nil
+
+(number-test #'cos z
+	     '(#C(0.5403023058681398 -0) #C(0.7305430190572253 -0.3969495502290326)
+	       #C(1.22776551686411 -0.4690753762685038) #C(1.543080634815244 -0)
+	       #C(1.22776551686411 0.4690753762685038) #C(0.7305430190572253 0.3969495502290326)
+	       #C(0.5403023058681398 0) #C(0.7305430190572253 -0.3969495502290326)
+	       #C(1.22776551686411 -0.4690753762685038) #C(1.543080634815244 0)
+	       #C(1.22776551686411 0.4690753762685038) #C(0.7305430190572253 0.3969495502290326)
+	       #C(-0.4161468365471424 -0) #C(-0.2477516854675716 -1.1599548913509)
+	       #C(1.574752911558314 -2.303658287170106) #C(3.762195691083631 -0)
+	       #C(1.574752911558314 2.303658287170106) #C(-0.2477516854675716 1.1599548913509)
+	       #C(-0.4161468365471424 0) #C(-0.2477516854675716 -1.1599548913509)
+	       #C(1.574752911558314 -2.303658287170106) #C(3.762195691083631 0)
+	       #C(1.574752911558314 2.303658287170106) #C(-0.2477516854675716 1.1599548913509)
+	       #C(0.8775825618903728 -0) #C(0.9362195694809076 -0.1059979846525542)
+	       #C(1.061176166972245 -0.1105083658274368) #C(1.127625965206381 -0)
+	       #C(1.061176166972245 0.1105083658274368) #C(0.9362195694809076 0.1059979846525542)
+	       #C(0.8775825618903728 0) #C(0.9362195694809076 -0.1059979846525542)
+	       #C(1.061176166972245 -0.1105083658274368) #C(1.127625965206381 0)
+	       #C(1.061176166972245 0.1105083658274368) #C(0.9362195694809076 0.1059979846525542)))
+nil
+
+(number-test #'tan z
+	     '(#C(1.557407724654902 0) #C(0.7139308802460217 0.8500402971922751)
+	       #C(0.2435601371571338 0.7924027564180361) #C(0 0.761594155955765)
+	       #C(-0.2435601371571338 0.7924027564180361) #C(-0.7139308802460217 0.8500402971922751)
+	       #C(-1.557407724654902 0) #C(-0.7139308802460217 -0.8500402971922751)
+	       #C(-0.2435601371571338 -0.7924027564180361) #C(0 -0.761594155955765)
+	       #C(0.2435601371571338 -0.7924027564180361) #C(0.7139308802460217 -0.8500402971922751)
+	       #C(-2.185039863261519 0) #C(-0.1126421615750695 1.288976345282757)
+	       #C(0.0583879435780107 1.024711771655234) #C(0 0.9640275800758169)
+	       #C(-0.0583879435780107 1.024711771655234) #C(0.1126421615750695 1.288976345282757)
+	       #C(2.185039863261519 0) #C(0.1126421615750695 -1.288976345282757)
+	       #C(-0.0583879435780107 -1.024711771655234) #C(0 -0.9640275800758169)
+	       #C(0.0583879435780107 -1.024711771655234) #C(-0.1126421615750695 -1.288976345282757)
+	       #C(0.5463024898437905 0) #C(0.429043246429927 0.2934945744363713)
+	       #C(0.2105871074424986 0.4297660306842928) #C(0 0.4621171572600097)
+	       #C(-0.2105871074424986 0.4297660306842928) #C(-0.429043246429927 0.2934945744363713)
+	       #C(-0.5463024898437905 0) #C(-0.429043246429927 -0.2934945744363713)
+	       #C(-0.2105871074424986 -0.4297660306842928) #C(0 -0.4621171572600097)
+	       #C(0.2105871074424986 -0.4297660306842928) #C(0.429043246429927 -0.2934945744363713)))
+nil
+
+(number-test #'sinh z
+	     '(#C(1.175201193643801 0) #C(0.8586367168171447 0.6707313588072117)
+	       #C(0.3375964632228701 0.8589803343001378) #C(0 0.8414709848078965)
+	       #C(-0.3375964632228701 0.8589803343001378) #C(-0.8586367168171447 0.6707313588072117)
+	       #C(-1.175201193643801 0) #C(-0.8586367168171447 -0.6707313588072117)
+	       #C(-0.3375964632228701 -0.8589803343001378) #C(0 -0.8414709848078965)
+	       #C(0.3375964632228701 -0.8589803343001378) #C(0.8586367168171447 -0.6707313588072117)
+	       #C(3.626860407847019 0) #C(1.479161975827853 2.452532348883716)
+	       #C(-0.1886862357802933 1.523061701931275) #C(-0 0.9092974268256817)
+	       #C(0.1886862357802933 1.523061701931275) #C(-1.479161975827853 2.452532348883716)
+	       #C(-3.626860407847019 0) #C(-1.479161975827853 -2.452532348883716)
+	       #C(0.1886862357802933 -1.523061701931275) #C(-0 -0.9092974268256817)
+	       #C(-0.1886862357802933 -1.523061701931275) #C(1.479161975827853 -2.452532348883716)
+	       #C(0.5210953054937474 0) #C(0.4327858320286366 0.2709627612286681)
+	       #C(0.2292976446734403 0.4327885168580315) #C(0 0.479425538604203)
+	       #C(-0.2292976446734403 0.4327885168580315) #C(-0.4327858320286366 0.2709627612286681)
+	       #C(-0.5210953054937474 0) #C(-0.4327858320286366 -0.2709627612286681)
+	       #C(-0.2292976446734403 -0.4327885168580315) #C(0 -0.479425538604203)
+	       #C(0.2292976446734403 -0.4327885168580315) #C(0.4327858320286366 -0.2709627612286681)))
+nil
+ 
+(number-test #'cosh z
+	     '(#C(1.543080634815244 0) #C(1.22776551686411 0.4690753762685038)
+	       #C(0.7305430190572252 0.3969495502290326) #C(0.5403023058681398 0)
+	       #C(0.7305430190572252 -0.3969495502290326) #C(1.22776551686411 -0.4690753762685038)
+	       #C(1.543080634815244 -0) #C(1.22776551686411 0.4690753762685038)
+	       #C(0.7305430190572252 0.3969495502290326) #C(0.5403023058681398 -0)
+	       #C(0.7305430190572252 -0.3969495502290326) #C(1.22776551686411 -0.4690753762685038)
+	       #C(3.762195691083631 0) #C(1.574752911558314 2.303658287170106)
+	       #C(-0.2477516854675716 1.1599548913509) #C(-0.4161468365471424 0)
+	       #C(-0.2477516854675716 -1.1599548913509) #C(1.574752911558314 -2.303658287170106)
+	       #C(3.762195691083631 -0) #C(1.574752911558314 2.303658287170106)
+	       #C(-0.2477516854675716 1.1599548913509) #C(-0.4161468365471424 -0)
+	       #C(-0.2477516854675716 -1.1599548913509) #C(1.574752911558314 -2.303658287170106)
+	       #C(1.127625965206381 0) #C(1.061176166972245 0.1105083658274368)
+	       #C(0.9362195694809075 0.1059979846525542) #C(0.8775825618903728 0)
+	       #C(0.9362195694809075 -0.1059979846525542) #C(1.061176166972245 -0.1105083658274368)
+	       #C(1.127625965206381 -0) #C(1.061176166972245 0.1105083658274368)
+	       #C(0.9362195694809075 0.1059979846525542) #C(0.8775825618903728 -0)
+	       #C(0.9362195694809075 -0.1059979846525542) #C(1.061176166972245 -0.1105083658274368)))
+nil
+
+(number-test #'tanh z
+	     '(#C(0.761594155955765 0) #C(0.7924027564180361 0.2435601371571338)
+	       #C(0.8500402971922751 0.7139308802460217) #C(0 1.557407724654902)
+	       #C(-0.8500402971922751 0.7139308802460217) #C(-0.7924027564180361 0.2435601371571338)
+	       #C(-0.761594155955765 0) #C(-0.7924027564180361 -0.2435601371571338)
+	       #C(-0.8500402971922751 -0.7139308802460217) #C(0 -1.557407724654902)
+	       #C(0.8500402971922751 -0.7139308802460217) #C(0.7924027564180361 -0.2435601371571338)
+	       #C(0.9640275800758169 0) #C(1.024711771655234 0.0583879435780107)
+	       #C(1.288976345282757 -0.1126421615750695) #C(0 -2.185039863261519)
+	       #C(-1.288976345282757 -0.1126421615750695) #C(-1.024711771655234 0.0583879435780107)
+	       #C(-0.9640275800758169 0) #C(-1.024711771655234 -0.0583879435780107)
+	       #C(-1.288976345282757 0.1126421615750695) #C(0 2.185039863261519)
+	       #C(1.288976345282757 0.1126421615750695) #C(1.024711771655234 -0.0583879435780107)
+	       #C(0.4621171572600097 0) #C(0.4297660306842928 0.2105871074424986)
+	       #C(0.2934945744363713 0.429043246429927) #C(0 0.5463024898437905)
+	       #C(-0.2934945744363713 0.429043246429927) #C(-0.4297660306842928 0.2105871074424986)
+	       #C(-0.4621171572600097 0) #C(-0.4297660306842928 -0.2105871074424986)
+	       #C(-0.2934945744363713 -0.429043246429927) #C(0 -0.5463024898437905)
+	       #C(0.2934945744363713 -0.429043246429927) #C(0.4297660306842928 -0.2105871074424986)))
+nil
+
+(number-test #'(lambda (x) (log (exp x))) z z)
+nil
+
+(number-test #'(lambda (x) (asin (sin x))) z
+	     '(#C(1.0 0.0) #C(0.8660254037844386 0.5)
+	       #C(0.5 0.8660254037844387) #C(0.0 1.0)
+	       #C(-0.5 0.8660254037844387) #C(-0.8660254037844386 0.5)
+	       #C(-1.0 -0.0) #C(-0.8660254037844386 -0.5)
+	       #C(-0.5 -0.8660254037844386) #C(0.0 -1.0)
+	       #C(0.5 -0.8660254037844386) #C(0.8660254037844386 -0.5)
+	       #C(1.141592653589793 0.0) #C(1.409541846020916 -1.0)
+	       #C(1.0 1.732050807568878) #C(0 2.0)
+	       #C(-1.0 1.732050807568878) #C(-1.409541846020916 -1.0)
+	       #C(-1.141592653589793 -0.0) #C(-1.409541846020916 1.0)
+	       #C(-1.0 -1.732050807568877) #C(0.0 -2.0)
+	       #C(1.0 -1.732050807568877) #C(1.409541846020916 1.0)
+	       #C(0.5 0.0) #C(0.4330127018922193 0.25)
+	       #C(0.25 0.4330127018922192) #C(0.0 0.5)
+	       #C(-0.25 0.4330127018922192) #C(-0.4330127018922193 0.25)
+	       #C(-0.5 -0.0) #C(-0.4330127018922193 -0.25)
+	       #C(-0.25 -0.4330127018922192) #C(0.0 -0.5)
+	       #C(0.25 -0.4330127018922192) #C(0.4330127018922193 -0.25)))
+nil
+
+(number-test #'(lambda (x) (acos (cos x))) z
+	     '(#C(1.0 0.0) #C(0.8660254037844386 0.5)
+	       #C(0.5 0.8660254037844387) #C(0 1)
+	       #C(0.5 -0.8660254037844386) #C(0.8660254037844386 -0.5)
+	       #C(1.0 0.0) #C(0.8660254037844386 0.5)
+	       #C(0.5 0.8660254037844387) #C(0.0 1.0)
+	       #C(0.5 -0.8660254037844386) #C(0.8660254037844386 -0.5)
+	       #C(2.0 0.0) #C(1.732050807568877 1.0)
+	       #C(1.0 1.732050807568878) #C(0.0 2.0)
+	       #C(1.0 -1.732050807568877) #C(1.732050807568877 -1)
+	       #C(2.0 0.0) #C(1.732050807568877 1)
+	       #C(1.0 1.732050807568878) #C(0.0 2.0)
+	       #C(1.0 -1.732050807568877) #C(1.732050807568877 -1.0)
+	       #C(0.5 0.0) #C(0.4330127018922192 0.25)
+	       #C(0.25 0.4330127018922192) #C(0.0 0.5)
+	       #C(0.25 -0.4330127018922192) #C(0.4330127018922191 -0.25)
+	       #C(0.5 0) #C(0.4330127018922192 0.25)
+	       #C(0.25 0.4330127018922192) #C(0 0.5)
+	       #C(0.25 -0.4330127018922192) #C(0.4330127018922191 -0.25)))
+nil
+
+(number-test #'(lambda (x) (atan (tan x))) z
+	     '(#C(1 0) #C(0.8660254037844386 0.5)
+	       #C(0.5 0.8660254037844386) #C(0 1)
+	       #C(-0.5 0.8660254037844386) #C(-0.8660254037844386 0.5)
+	       #C(-1 -0) #C(-0.8660254037844386 -0.5)
+	       #C(-0.5 -0.8660254037844386) #C(0 -1)
+	       #C(0.5 -0.8660254037844386) #C(0.8660254037844386 -0.5)
+	       #C(-1.141592653589793 -0) #C(-1.409541846020916 1)
+	       #C(1 1.732050807568877) #C(0 2)
+	       #C(-1 1.732050807568877) #C(1.409541846020916 1)
+	       #C(1.141592653589793 0) #C(1.409541846020916 -1)
+	       #C(-1 -1.732050807568877) #C(0 -2)
+	       #C(1 -1.732050807568877) #C(-1.409541846020916 -1)
+	       #C(0.5 0) #C(0.4330127018922193 0.25)
+	       #C(0.25 0.4330127018922193) #C(0 0.5)
+	       #C(-0.25 0.4330127018922193) #C(-0.4330127018922193 0.25)
+	       #C(-0.5 -0) #C(-0.4330127018922193 -0.25)
+	       #C(-0.25 -0.4330127018922193) #C(0 -0.5)
+	       #C(0.25 -0.4330127018922193) #C(0.4330127018922193 -0.25)))
+nil
+
+(number-test #'(lambda (x) (asinh (sinh x))) z
+	     '(#C(1.0 0.0) #C(0.8660254037844386 0.5)
+	       #C(0.5 0.8660254037844385) #C(0.0 1.0)
+	       #C(-0.5 0.8660254037844386) #C(-0.8660254037844389 0.5)
+	       #C(-1 0) #C(-0.8660254037844389 -0.5)
+	       #C(-0.5 -0.8660254037844386) #C(0.0 -1.0)
+	       #C(0.5 -0.8660254037844385) #C(0.8660254037844386 -0.5)
+	       #C(2.0 0.0) #C(1.732050807568877 1.0)
+	       #C(-1 1.409541846020916) #C(0.0 1.141592653589793)
+	       #C(1 1.409541846020916) #C(-1.732050807568878 1.0)
+	       #C(-2.0 0) #C(-1.732050807568878 -1.0)
+	       #C(1.0 -1.409541846020916) #C(0.0 -1.141592653589793)
+	       #C(-1.0 -1.409541846020916) #C(1.732050807568877 -1.0)
+	       #C(0.5 0.0) #C(0.4330127018922192 0.25)
+	       #C(0.25 0.4330127018922193) #C(0.0 0.5)
+	       #C(-0.25 0.4330127018922193) #C(-0.4330127018922192 0.25)
+	       #C(-0.5 0) #C(-0.4330127018922192 -0.25)
+	       #C(-0.25 -0.4330127018922193) #C(0 -0.5)
+	       #C(0.25 -0.4330127018922193) #C(0.4330127018922192 -0.25)))
+nil
+
+(number-test #'(lambda (x) (acosh (cosh x))) z
+	     '(#C(1.0 0.0) #C(0.8660254037844385 0.5)
+	       #C(0.5 0.8660254037844387) #C(0.0 1.0)
+	       #C(0.5 -0.8660254037844387) #C(0.8660254037844385 -0.5)
+	       #C(1.0 0.0) #C(0.8660254037844385 0.5)
+	       #C(0.5 0.8660254037844387) #C(0.0 1.0)
+	       #C(0.5 -0.8660254037844387) #C(0.8660254037844385 -0.5)
+	       #C(2.0 0.0) #C(1.732050807568877 1.0)
+	       #C(1.0 1.732050807568877) #C(0.0 2.0)
+	       #C(1.0 -1.732050807568877) #C(1.732050807568877 -1.0)
+	       #C(2.0 0.0) #C(1.732050807568877 1.0)
+	       #C(1.0 1.732050807568877) #C(0.0 2.0)
+	       #C(1.0 -1.732050807568877) #C(1.732050807568877 -1.0)
+	       #C(0.5 0.0) #C(0.4330127018922192 0.25)
+	       #C(0.25 0.4330127018922194) #C(0.0 0.5)
+	       #C(0.25 -0.4330127018922194) #C(0.4330127018922192 -0.25)
+	       #C(0.5 0) #C(0.4330127018922192 0.25)
+	       #C(0.25 0.4330127018922194) #C(0.0 0.5)
+	       #C(0.25 -0.4330127018922194) #C(0.4330127018922192 -0.25)))
+nil
+
+(number-test #'(lambda (x) (atanh (tanh x))) z
+	     '(#C(1 0) #C(0.8660254037844386 0.5)
+	       #C(0.5 0.8660254037844386) #C(0 1)
+	       #C(-0.5 0.8660254037844386) #C(-0.8660254037844386 0.5)
+	       #C(-1 0) #C(-0.8660254037844386 -0.5)
+	       #C(-0.5 -0.8660254037844386) #C(0 -1)
+	       #C(0.5 -0.8660254037844386) #C(0.8660254037844386 -0.5)
+	       #C(2 0) #C(1.732050807568877 1)
+	       #C(1 -1.409541846020916) #C(0 -1.141592653589793)
+	       #C(-1 -1.409541846020916) #C(-1.732050807568877 1)
+	       #C(-2 0) #C(-1.732050807568877 -1)
+	       #C(-1 1.409541846020916) #C(0 1.141592653589793)
+	       #C(1 1.409541846020916) #C(1.732050807568877 -1)
+	       #C(0.5 0) #C(0.4330127018922193 0.25)
+	       #C(0.25 0.4330127018922193) #C(0 0.5)
+	       #C(-0.25 0.4330127018922193) #C(-0.4330127018922193 0.25)
+	       #C(-0.5 0) #C(-0.4330127018922193 -0.25)
+	       #C(-0.25 -0.4330127018922193) #C(0 -0.5)
+	       #C(0.25 -0.4330127018922193) #C(0.4330127018922193 -0.25))
+	     1e-7)
+nil
diff --git a/src/tests/ecl_chap14_cons.tst b/src/tests/ecl_chap14_cons.tst
new file mode 100644
index 000000000..cb4730742
--- /dev/null
+++ b/src/tests/ecl_chap14_cons.tst
@@ -0,0 +1,388 @@
+;; -*- lisp -*-
+(defun safe-mapcar (f list)
+  (mapcar #'(lambda (x) (with-ignored-errors (funcall f x))) list))
+safe-mapcar
+(defun safe-mapcar2 (f list list2)
+  (mapcar #'(lambda (x y) (with-ignored-errors (funcall f x y))) list list2))
+safe-mapcar2
+
+;;
+;; CONS
+;;
+(cons 'a 'b)
+(a . b)
+(cons 'a nil)
+(a)
+(cons nil 'a)
+(nil . a)
+
+;;
+;; CONSP, LISTP, ENDP, NULL
+;;
+(mapcar #'(lambda (f)
+	    (safe-mapcar f '(a nil (a) (a . b) (a b))))
+	'(consp listp endp null))
+((nil nil t t t)
+ (nil t t t t)
+ (error t nil nil nil)
+ (nil t nil nil nil))
+
+;;
+;; LIST, LIST*
+;;
+(list)			; List with no arg outputs nil
+	nil
+(list 'a)		; List with one arg makes a list
+	(a)
+(list 'a 'b)		; Elements are added to the list
+	(a b)
+(list 'a nil)
+	(a nil)
+(list nil nil)
+	(nil nil)
+(list 'a '(b c))	; except for trailing lists, which are appended
+	(a (b c))
+(list 'a 'b '(c))
+	(a b (c))
+
+(list*)			; list* requires at least one arg
+	error
+(list* 'a)		; list* outputs its single arg, no matter what it is
+	a
+(let ((a (cons 'a 'b))) (eq (list* a) a))
+	t
+(list* 'a 'b)		; the last arg is made the CDR of the last cons
+	(a . b)
+(list* 'a nil)
+	(a)
+(list* nil nil)
+	(nil)
+(list* 'a '(b c))	; except for trailing lists, which are appended
+	(a b c)
+(list* 'a 'b '(c))
+	(a b c)
+
+;;
+;; MAKE-LIST
+;;
+(safe-mapcar #'make-list '(-1 0 1 2 3 4))
+(error nil (nil) (nil nil) (nil nil nil) (nil nil nil nil))
+
+(safe-mapcar2 #'(lambda (x y) (make-list x :initial-element y))
+	      '(-1 0 1 2 3 4)
+	      '(a b a b a b))
+(error nil (a) (b b) (a a a) (b b b b))
+
+;;
+;; REST, CAR, CDR, CAAR, etc
+;;
+#+nil ; This was used to generate the trees below
+(defun make-tree (depth left-index)
+  (if (<= depth 0)
+    (values left-index (1+ left-index))
+    (multiple-value-bind (left right-index)
+	(make-tree (1- depth) left-index)
+      (multiple-value-bind (right right-index)
+	  (make-tree (1- depth) right-index)
+	(values (cons left right)
+		(1+ right-index))))))
+(defparameter a '(nil
+		  1
+		  (1 . 2)
+		  ((1 . 2) 3 . 4)
+		  (((1 . 2) 3 . 4) (5 . 6) 7 . 8)
+		  ((((1 . 2) 3 . 4) (5 . 6) 7 . 8) ((9 . 10) 11 . 12) (13 . 14) 15 . 16)))
+a
+
+; Test CAR and friends as selectors
+(mapcar #'(lambda (f) (safe-mapcar f a))
+	'(car cdr rest caar cadr cdar cddr
+	  caaar caadr cadar caddr cdaar cdadr cddar cdddr
+	  caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+	  cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr))
+((nil error 1 (1 . 2) ((1 . 2) 3 . 4) (((1 . 2) 3 . 4) (5 . 6) 7 . 8))
+ (nil error 2 (3 . 4) ((5 . 6) 7 . 8) (((9 . 10) 11 . 12) (13 . 14) 15 . 16))
+ (nil error 2 (3 . 4) ((5 . 6) 7 . 8) (((9 . 10) 11 . 12) (13 . 14) 15 . 16))
+ (nil error error 1 (1 . 2) ((1 . 2) 3 . 4))
+ (nil error error 3 (5 . 6) ((9 . 10) 11 . 12))
+ (nil error error 2 (3 . 4) ((5 . 6) 7 . 8))
+ (nil error error 4 (7 . 8) ((13 . 14) 15 . 16))
+ (nil error error error 1 (1 . 2))
+ (nil error error error 5 (9 . 10))
+ (nil error error error 3 (5 . 6))
+ (nil error error error 7 (13 . 14))
+ (nil error error error 2 (3 . 4))
+ (nil error error error 6 (11 . 12))
+ (nil error error error 4 (7 . 8))
+ (nil error error error 8 (15 . 16))
+ (nil error error error error 1)
+ (nil error error error error 9)
+ (nil error error error error 5)
+ (nil error error error error 13)
+ (nil error error error error 3)
+ (nil error error error error 11)
+ (nil error error error error 7)
+ (nil error error error error 15)
+ (nil error error error error 2)
+ (nil error error error error 10)
+ (nil error error error error 6)
+ (nil error error error error 14)
+ (nil error error error error 4)
+ (nil error error error error 12)
+ (nil error error error error 8)
+ (nil error error error error 16))
+
+; Test CAR and friends as accessors for SETF
+(mapcar #'(lambda (f)
+	    (eval `(safe-mapcar #'(lambda (tree)
+				    (setf (,f tree) ',f)
+				    (funcall ',f tree))
+		    a)))
+	'(caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+	  cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
+	  caaar caadr cadar caddr cdaar cdadr cddar cdddr
+	  caar cadr cdar cddr
+	  car cdr rest))
+((error error error error error caaaar) (error error error error error caaadr)
+ (error error error error error caadar) (error error error error error caaddr)
+ (error error error error error cadaar) (error error error error error cadadr)
+ (error error error error error caddar) (error error error error error cadddr)
+ (error error error error error cdaaar) (error error error error error cdaadr)
+ (error error error error error cdadar) (error error error error error cdaddr)
+ (error error error error error cddaar) (error error error error error cddadr)
+ (error error error error error cdddar) (error error error error error cddddr)
+ (error error error error caaar caaar) (error error error error caadr caadr)
+ (error error error error cadar cadar) (error error error error caddr caddr)
+ (error error error error cdaar cdaar) (error error error error cdadr cdadr)
+ (error error error error cddar cddar) (error error error error cdddr cdddr)
+ (error error error caar caar caar) (error error error cadr cadr cadr)
+ (error error error cdar cdar cdar) (error error error cddr cddr cddr)
+ (error error car car car car) (error error cdr cdr cdr cdr)
+ (error error rest rest rest rest))
+
+;;
+;; RPLACA, RPLACD
+;;
+; They both fail with non-cons objects
+(rplaca 'a 'b)
+error
+(rplacd 'a 'b)
+error
+(rplaca nil 'a)
+error
+(rplaca nil 'b)
+error
+
+; Now test proper work
+(rplaca (cons 'a 'b) 'c)
+(c . b)
+(rplacd (cons 'a 'b) 'c)
+(a . c)
+
+;;
+;; FIRST, SECOND, etc
+;;
+(let ((all '(nil
+	     (1)
+	     (1 2)
+	     (1 2 3)
+	     (1 2 3 4)
+	     (1 2 3 4 5)
+	     (1 2 3 4 5 6)
+	     (1 2 3 4 5 6 7)
+	     (1 2 3 4 5 6 7 8)
+	     (1 2 3 4 5 6 7 8 9)
+	     (1 2 3 4 5 6 7 8 9 10)
+	     (1 2 3 4 5 6 7 8 9 10 11))))
+  (mapcar #'(lambda (x)
+	      (mapcar #'(lambda (z)
+			  (with-ignored-errors
+			      (funcall (symbol-function x) z)))
+		      all))
+	  '(first second third fourth fifth sixth seventh eighth ninth tenth)))
+((nil 1 1 1 1 1 1 1 1 1 1 1)
+ (nil nil 2 2 2 2 2 2 2 2 2 2)
+ (nil nil nil 3 3 3 3 3 3 3 3 3)
+ (nil nil nil nil 4 4 4 4 4 4 4 4)
+ (nil nil nil nil nil 5 5 5 5 5 5 5)
+ (nil nil nil nil nil nil 6 6 6 6 6 6)
+ (nil nil nil nil nil nil nil 7 7 7 7 7)
+ (nil nil nil nil nil nil nil nil 8 8 8 8)
+ (nil nil nil nil nil nil nil nil nil 9 9 9)
+ (nil nil nil nil nil nil nil nil nil nil 10 10))
+
+(let ((all '((1 . b)
+	     (1 2 . b)
+	     (1 2 3 . b)
+	     (1 2 3 4 . b)
+	     (1 2 3 4 5 . b)
+	     (1 2 3 4 5 6 . b)
+	     (1 2 3 4 5 6 7 . b)
+	     (1 2 3 4 5 6 7 8 . b)
+	     (1 2 3 4 5 6 7 8 9 . b)
+	     (1 2 3 4 5 6 7 8 9 10 . b)
+	     (1 2 3 4 5 6 7 8 9 10 11 . b))))
+  (mapcar #'(lambda (x)
+	      (mapcar #'(lambda (z)
+			  (with-ignored-errors
+			      (funcall (symbol-function x) z)))
+		      all))
+	  '(first second third fourth fifth sixth seventh eighth ninth tenth)))
+((1 1 1 1 1 1 1 1 1 1 1)
+ (error 2 2 2 2 2 2 2 2 2 2)
+ (error error 3 3 3 3 3 3 3 3 3)
+ (error error error 4 4 4 4 4 4 4 4)
+ (error error error error 5 5 5 5 5 5 5)
+ (error error error error error 6 6 6 6 6 6)
+ (error error error error error error 7 7 7 7 7)
+ (error error error error error error error 8 8 8 8)
+ (error error error error error error error error 9 9 9)
+ (error error error error error error error error error 10 10))
+
+;;
+;; LAST, BUTLAST, NBUTLAST
+;;
+(mapcar #'(lambda (f)
+	    (safe-mapcar #'(lambda (x) (funcall f (copy-list x)))
+			 '(nil (1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5)
+			   a (1 . 2) (1 2 . 3) (1 2 3 . 4) (1 2 3 4 . 5))))
+	'(last butlast nbutlast))
+((nil (1) (2) (3) (4) (5) error (1 . 2) (2 . 3) (3 . 4) (4 . 5))
+ (nil nil (1) (1 2) (1 2 3) (1 2 3 4) error nil (1) (1 2) (1 2 3))
+ (nil nil (1) (1 2) (1 2 3) (1 2 3 4) error nil (1) (1 2) (1 2 3)))
+
+(mapcar #'(lambda (f)
+	    (safe-mapcar #'(lambda (x) (funcall f x 0))
+			 '(nil (1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5)
+			   a (1 . 2) (1 2 . 3) (1 2 3 . 4) (1 2 3 4 . 5))))
+	'(last butlast nbutlast))
+((nil nil nil nil nil nil error 2 3 4 5)
+ (nil (1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5) error (1) (1 2) (1 2 3) (1 2 3 4))
+ (nil (1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5) error (1) (1 2) (1 2 3) (1 2 3 4)))
+
+(mapcar #'(lambda (f)
+	    (safe-mapcar #'(lambda (x) (funcall f (copy-list x) 3))
+			 '(nil (1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5)
+			   a (1 . 2) (1 2 . 3) (1 2 3 . 4) (1 2 3 4 . 5))))
+	'(last butlast nbutlast))
+((nil (1) (1 2) (1 2 3) (2 3 4) (3 4 5) error (1 . 2) (1 2 . 3) (1 2 3 . 4) (2 3 4 . 5))
+ (nil nil nil nil (1) (1 2) error nil nil nil (1))
+ (nil nil nil nil (1) (1 2) error nil nil nil (1))))
+
+(let ((a (list 1 2 3)))
+  (rplacd (last a) a)
+  (safe-mapcar2 #'funcall '(last butlast nbutlast) (list a a a)))
+(error error error)
+
+;;
+;; NTH
+;;
+(let ((all '(nil
+	     (1)
+	     (1 2)
+	     (1 2 3)
+	     (1 2 3 4)
+	     (1 2 3 4 5)
+	     (1 2 3 4 5 6)
+	     (1 2 3 4 5 6 7)
+	     (1 2 3 4 5 6 7 8)
+	     (1 2 3 4 5 6 7 8 9)
+	     (1 2 3 4 5 6 7 8 9 10)
+	     (1 2 3 4 5 6 7 8 9 10 11))))
+  (mapcar #'(lambda (x)
+	      (mapcar #'(lambda (z)
+			  (with-ignored-errors
+			      (nth x z)))
+		      all))
+	  '(-1 0 1 2 3 4 5 6 7 8 9 10 11 12)))
+((error error error error error error error error error error error error)
+ (nil 1 1 1 1 1 1 1 1 1 1 1)
+ (nil nil 2 2 2 2 2 2 2 2 2 2)
+ (nil nil nil 3 3 3 3 3 3 3 3 3)
+ (nil nil nil nil 4 4 4 4 4 4 4 4)
+ (nil nil nil nil nil 5 5 5 5 5 5 5)
+ (nil nil nil nil nil nil 6 6 6 6 6 6)
+ (nil nil nil nil nil nil nil 7 7 7 7 7)
+ (nil nil nil nil nil nil nil nil 8 8 8 8)
+ (nil nil nil nil nil nil nil nil nil 9 9 9)
+ (nil nil nil nil nil nil nil nil nil nil 10 10)
+ (nil nil nil nil nil nil nil nil nil nil nil 11)
+ (nil nil nil nil nil nil nil nil nil nil nil nil)
+ (nil nil nil nil nil nil nil nil nil nil nil nil))
+
+(let ((all '((1 . b)
+	     (1 2 . b)
+	     (1 2 3 . b)
+	     (1 2 3 4 . b)
+	     (1 2 3 4 5 . b)
+	     (1 2 3 4 5 6 . b)
+	     (1 2 3 4 5 6 7 . b)
+	     (1 2 3 4 5 6 7 8 . b)
+	     (1 2 3 4 5 6 7 8 9 . b)
+	     (1 2 3 4 5 6 7 8 9 10 . b)
+	     (1 2 3 4 5 6 7 8 9 10 11 . b))))
+  (mapcar #'(lambda (x)
+	      (mapcar #'(lambda (z)
+			  (with-ignored-errors
+			      (nth x z)))
+		      all))
+	  '(-1 0 1 2 3 4 5 6 7 8 9 10 11 12)))
+((error error error error error error error error error error error)
+ (1 1 1 1 1 1 1 1 1 1 1)
+ (error 2 2 2 2 2 2 2 2 2 2)
+ (error error 3 3 3 3 3 3 3 3 3)
+ (error error error 4 4 4 4 4 4 4 4)
+ (error error error error 5 5 5 5 5 5 5)
+ (error error error error error 6 6 6 6 6 6)
+ (error error error error error error 7 7 7 7 7)
+ (error error error error error error error 8 8 8 8)
+ (error error error error error error error error 9 9 9)
+ (error error error error error error error error error 10 10)
+ (error error error error error error error error error error 11)
+ (error error error error error error error error error error error)
+ (error error error error error error error error error error error))
+
+;;
+;; LIST-LENGTH
+;;
+(safe-mapcar #'list-length '(1 a t
+			     nil (1) (1 . 2)
+			     (1 2 3 4) (1 2 3 . 4)
+			     (1 2 nil) (1 2 nil . 3)))
+(error error error 0 1 error 4 error 3 error)
+
+(let ((a (list 1 2 3)))
+  (rplaca (last a) a)
+  (list-length a))
+3
+
+(let ((a (list 1 2 3)))
+  (rplacd (last a) a)
+  (list-length a))
+nil
+
+;;
+;; COPY-LIST
+;;
+(defun check-fresh-list (a b)
+  (cond ((and (null a) (null b))
+	 t)
+	((and (atom a) (atom b))
+	 t)
+	((and (not (eq a b))
+	      (eq (car a) (car b)))
+	 (check-fresh-list (cdr a) (cdr b)))))
+check-fresh-list
+
+(let* ((a '(nil (1) (1 2) (1 2 nil) (1 . 2) (1 2 . 3)))
+       (b (safe-mapcar #'copy-list a)))
+  (safe-mapcar2 #'check-fresh-list b a))
+(t t t t t t)
+
+#+ecls
+(let ((a (list 1 2 3)))
+  (rplacd (last a) a)
+  (copy-list a))
+#+ecls
+error
+
diff --git a/src/tests/ecl_chap14_plist.tst b/src/tests/ecl_chap14_plist.tst
new file mode 100644
index 000000000..c2c35913e
--- /dev/null
+++ b/src/tests/ecl_chap14_plist.tst
@@ -0,0 +1,153 @@
+;; -*- lisp -*-
+(defun safe-mapcar (f list)
+  (mapcar #'(lambda (x) (with-ignored-errors (funcall f x))) list))
+safe-mapcar
+
+;;
+;; ACONS
+;;
+(acons 'a 'b nil)
+((a . b))
+
+(acons 'a 'b '((c . d)))
+((a . b) (c . d))
+
+(acons 'a 'b 1)
+#+ecls ((a . b) . 1) #-ecls error
+
+;;
+;; PAIRLIS
+;;
+(safe-mapcar #'(lambda (x) (apply #'pairlis x))
+	     '(((a b c) (1 2 3)                  )
+	       ((a b c) (1 2 3) ((d . 4) (e . 5)))
+	       ((a b c) (1 2)                    )
+	       ((a b c) (1 2)   ((d . 4) (e . 5)))
+	       ('a      1                        )
+	       ('a      1       ((d . 4) (e . 5)))))
+(((c . 3) (b . 2) (a . 1))
+ ((c . 3) (b . 2) (a . 1) (d . 4) (e . 5))
+ error
+ error
+ error
+ error)
+
+;;
+;; GETF
+;;
+
+; Empty lists are good property lists
+(getf nil 'a)
+nil
+
+; Getf uses #'eq to compare
+(getf '("A" 1 "B" 2) (string-upcase 'a))
+nil
+
+(mapcar #'(lambda (x) (getf '(a 1 b 2 c 3 d 4) x)) '(a b c d e f g))
+(1 2 3 4 nil nil nil)
+
+(mapcar #'(lambda (x) (getf '(a 1 b 2 c 3 d 4) x x)) '(a b c d e f g))
+(1 2 3 4 e f g)
+
+(let ((a nil))
+  (dolist (i '(a b c d))
+    (setf (getf a i) i))
+  a)
+(d d c c b b a a)
+
+(let ((a '(a 1 b 2 c 3 d 4)))
+  (dolist (i '(d c a b e b f a))
+    (setf (getf a i) i))
+  a)
+(f f e e a a b b c c d d)
+
+; Default value in setf-get is ignored but evaluated
+(let ((a '(a 1 b 2 c 3))
+      (b nil))
+  (setf (getf a 'b 'default) 'b)
+  (setf (getf a 'a (push 1 b)) 'a)
+  (setf (getf a 'd (push 2 b)) 'd)
+  (cons a b))
+((d d a a b b c 3)
+ 2 1)
+
+; Leading properties take peference over duplicates
+(mapcar #'(lambda (x) (getf '(a 1 b 2 b 3 c 4 a 5 c 6) x)) '(a e f b c))
+(1 nil nil 2 4)
+
+(let ((a '(a 1 b 2 b 3 a 4 c 6)))
+  (dolist (i '(d e c b a))
+    (setf (getf a i) i))
+  a)
+(e e d d a a b b b 3 a 4 c c)
+
+; Failure due to non list
+(getf 'a 'c)
+error
+
+; Failure due to odd length
+(getf '(a 1 b) 'c)
+error
+
+; Failure due to dotted list
+(getf '(a 1 b . 2) 'c)
+error
+(getf '(a 1 . b) 'c)
+error
+
+; Failure due to circular lists. Only ECLS passes this.
+#+ecls
+(let ((a '(a 1 b 2)))
+  (nconc a a)
+  (getf a 'c))
+#+ecls
+error
+
+#+ecls
+(let ((a '(a 1 b 2)))
+  (nconc a a)
+  (setf (getf a 'c) 3)
+  a)
+#+ecls
+error
+
+;;
+;; REMF
+;;
+
+; Empty lists are good property lists
+(let ((a nil)) (remf a 'a))
+nil
+
+; Getf uses #'eq to compare
+(let ((a '("A" 1 "B" 2))) (remf a (string-upcase 'a)))
+nil
+
+; Try several operations with duplicates.
+(let ((a '(a 1 b 2 c 3 d 4 a 5)))
+  (mapcar #'(lambda (x) (let ((flag (remf a x))) (cons flag (copy-list a)))) '(a e f a c g)))
+((t b 2 c 3 d 4 a 5) (nil b 2 c 3 d 4 a 5) (nil b 2 c 3 d 4 a 5) (t b 2 c 3 d 4) (t b 2 d 4) (nil b 2 d 4))
+
+; Failure due to non list
+(let ((a 'c)) (remf a 'c))
+error
+
+; Failure due to odd length
+(let ((a '(a 1 b))) (remf a 'b))
+error
+
+; Failure due to dotted list
+(let ((a '(a 1 b . 2))) (remf a 'b))
+error
+(let ((a '(a 1 . b))) (remf a 'b))
+error
+
+; Failure due to circular lists. Only ECLS passes this.
+#+ecls
+(let ((a '(a 1 b 2)))
+  (nconc a a)
+  (remf a 'c))
+#+ecls
+error
+
diff --git a/src/tests/eval20.tst b/src/tests/eval20.tst
new file mode 100644
index 000000000..5d1323dd8
--- /dev/null
+++ b/src/tests/eval20.tst
@@ -0,0 +1,45 @@
+;; testen abschitt 20
+
+
+; eval
+
+(eval (list 'cdr (car '((quote (a . b)) c))))
+b
+
+(makunbound 'x)
+x
+
+(eval 'x)
+ERROR
+
+(setf x 3)
+3
+
+(eval 'x)
+3
+
+;constantp
+
+(constantp 2)
+T
+
+(constantp #\r)
+T
+
+(constantp "max")
+T
+
+(constantp '#(110))
+#+(or XCL AKCL ANSI-CL ECLS) T #-(or XCL AKCL ANSI-CL ECLS) NIL
+
+(constantp :max)
+T
+(constantp T)
+T
+(constantp NIL)
+T
+(constantp 'PI)
+#-CLISP T #+CLISP NIL
+(constantp '(quote foo))
+T
+
diff --git a/src/tests/excepsit.tst b/src/tests/excepsit.tst
new file mode 100644
index 000000000..50edff00e
--- /dev/null
+++ b/src/tests/excepsit.tst
@@ -0,0 +1,1165 @@
+;;; Test "Exceptional situations" as specified by CLHS
+
+;; NB: CLHS section 1.4.2 implies that we have to verify only those
+;; specifications which have the wording "an error is signalled" or
+;; "an error should be signalled".
+
+(abort)
+control-error
+
+(acos 'x)
+type-error
+
+(acosh 'x)
+type-error
+
+(progn
+  (defgeneric foo01 (x))
+  (defmethod foo01 ((x number)) t)
+  (let ((m (find-method #'foo01 nil (list (find-class 'number)))))
+    (remove-method #'foo01 m)
+    (defgeneric foo01 (x y))
+    (add-method #'foo01 m)
+) )
+error
+
+#-CLISP ; documented behaviour of ADD-METHOD
+(progn
+  (defgeneric foo02 (x))
+  (defmethod foo02 ((x number)) t)
+  (let ((m (find-method #'foo02 nil (list (find-class 'number)))))
+    (remove-method #'foo02 m)
+    (defgeneric foo03 (x))
+    (add-method #'foo03 m)
+) )
+#-CLISP
+error
+
+(let ((a (make-array 5 :adjustable t)))
+  (adjust-array a 4 :fill-pointer 1)
+)
+error
+
+(adjustable-array-p '(x))
+type-error
+
+(alpha-char-p 33)
+type-error
+
+(alphanumericp 33)
+type-error
+
+(array-dimensions '(x))
+type-error
+
+(array-displacement '(x))
+type-error
+
+(array-element-type '(x))
+type-error
+
+(array-has-fill-pointer-p '(x))
+type-error
+
+(array-rank '(x))
+type-error
+
+(array-total-size '(x))
+type-error
+
+(ash 3/4 2)
+type-error
+
+(ash 3 4.0)
+type-error
+
+(asin 'x)
+type-error
+
+(asinh 'x)
+type-error
+
+(atan 'x)
+type-error
+
+(atan #c(0 0.4) 3.4)
+type-error
+
+(atan -4 #c(3 4))
+type-error
+
+(atanh 'x)
+type-error
+
+(boole 'x 3 4)
+type-error
+
+(boole boole-and 3/4 -7)
+type-error
+
+(boole boole-set 5 #c(-3 4))
+type-error
+
+(both-case-p 33)
+type-error
+
+(boundp 47)
+type-error
+
+(butlast '(a b c) -1)
+type-error
+
+(butlast '#(a b c))
+type-error
+
+(car 'x)
+type-error
+
+(cdr '#(a b c))
+type-error
+
+(cdadar '((x y)))
+type-error
+
+(progn
+  (defgeneric foo04 (x))
+  (defmethod foo04 ((x real)) 'ok)
+  (defmethod foo04 ((x integer)) (call-next-method (sqrt x)))
+  (foo04 -1))
+error
+
+(progn
+  (defgeneric foo041 (x))
+  (defmethod foo041 ((x real)) 'ok)
+  (defmethod foo041 ((x integer)) (call-next-method (sqrt x)))
+  (foo04 2))
+error
+
+(ccase 'x)
+type-error
+
+(char-code 33)
+type-error
+
+(char-downcase 33)
+type-error
+
+(char-equal)
+program-error
+
+(char-greaterp)
+program-error
+
+(char-lessp)
+program-error
+
+(char-name 33)
+type-error
+
+(char-not-equal)
+program-error
+
+(char-not-greaterp)
+program-error
+
+(char-not-lessp)
+program-error
+
+(char-upcase 33)
+type-error
+
+(char/=)
+program-error
+
+(char<)
+program-error
+
+(char<=)
+program-error
+
+(char=)
+program-error
+
+(char>)
+program-error
+
+(char>=)
+program-error
+
+(character "abc")
+type-error
+
+(character "")
+type-error
+
+#+ANSI-CL
+(character 33)
+#+ANSI-CL
+type-error
+
+(clear-input '*terminal-io*)
+type-error
+
+(clear-output '*terminal-io*)
+type-error
+
+(coerce '(a b c) '(vector * 4))
+type-error
+
+(coerce '#(a b c) '(vector * 4))
+type-error
+
+(coerce '(a b c) '(vector * 2))
+type-error
+
+(coerce '#(a b c) '(vector * 2))
+type-error
+
+(coerce "foo" '(string 2))
+type-error
+
+(coerce '#(#\a #\b #\c) '(string 2))
+type-error
+
+(coerce '(0 1) '(simple-bit-vector 3))
+type-error
+
+(coerce nil 'nil)
+type-error
+
+(coerce '#:nonexistent 'function)
+error
+
+(coerce 'and 'function)
+error
+
+(compile-file "/tmp/12836123.lsp")
+file-error
+
+(concatenate 'symbol)
+error
+
+(concatenate '(string 3) "ab" "cd")
+type-error
+
+#-CLISP
+(copy-pprint-dispatch 'x)
+#-CLISP
+type-error
+
+(copy-seq 'x)
+type-error
+
+(copy-symbol #\x)
+type-error
+
+(cos 'x)
+type-error
+
+(cosh 'x)
+type-error
+
+(count #\x 'x)
+type-error
+
+(let ((x nil)) (ctypecase x))
+type-error
+
+(decode-float 2/3)
+type-error
+
+(defclass foo05 () (a b a))
+program-error
+
+(defclass foo06 () (a b) (:default-initargs x a x b))
+program-error
+
+(defclass foo07 () ((a :allocation :class :allocation :class)))
+program-error
+
+(defclass foo08 () ((a :initform 42 :initform 42)))
+program-error
+
+(defclass foo09 () ((a :type real :type real)))
+program-error
+
+(defclass foo10 () ((a :documentation "bla" :documentation "blabla")))
+program-error
+
+(defgeneric if (x))
+program-error
+
+(progn 
+  (defmacro foo11 (x) x)
+  (defgeneric foo11 (x)))
+program-error
+
+(progn
+  (defun foo12 (x) x)
+  (defgeneric foo12 (x)))
+program-error
+
+(defgeneric foo13 (x y &rest l)
+  (:method (x y))
+)
+error
+
+(defgeneric foo14 (x)
+  (:documentation "bla")
+  (:documentation "blabla")
+)
+program-error
+
+(defgeneric foo15 (x)
+  (:my-option t))
+program-error
+
+; define-method-combination is too complicated
+
+(progn
+  (defvar foo16)
+  (define-symbol-macro foo16 t))
+program-error
+
+(defmethod if (x) nil)
+error
+
+(progn 
+  (defmacro foo17 (x) x)
+  (defmethod foo17 (x) nil))
+error
+
+(progn
+  (defun foo18 (x) x)
+  (defmethod foo18 (x) nil))
+error
+
+(progn
+  (defgeneric foo19 (x))
+  (defmethod foo19 (x y) nil))
+error
+
+(progn
+  (defpackage "FOO20")
+  (defpackage "FOO21" (:nicknames "FOO20")))
+package-error
+
+(defpackage "FOO22" (:size 20) (:size 20))
+program-error
+
+(defpackage "FOO23" (:documentation "bla") (:documentation "blabla"))
+program-error
+
+(defpackage "FOO24" (:my-option t))
+program-error
+
+(defpackage "FOO25" (:shadow "IF") (:intern "IF"))
+program-error
+
+(defpackage "FOO26" (:shadow "IF") (:import-from "USER" "IF"))
+program-error
+
+(defpackage "FOO27" (:shadow "IF") (:shadowing-import-from "USER" "IF"))
+program-error
+
+(defpackage "FOO28" (:intern "IF") (:import-from "USER" "IF"))
+program-error
+
+(defpackage "FOO29" (:intern "IF") (:shadowing-import-from "USER" "IF"))
+program-error
+
+(defpackage "FOO30" (:import-from "USER" "IF") (:shadowing-import-from "USER" "IF"))
+program-error
+
+(defpackage "FOO31" (:export "IF") (:intern "IF"))
+program-error
+
+(defstruct foo32 a system::a)
+program-error
+
+(progn
+  (defstruct foo33 a)
+  (defstruct (foo34 (:include foo33)) system::a))
+program-error
+
+(delete #\x 'x)
+type-error
+
+(delete-duplicates 'abba)
+type-error
+
+(progn
+  (with-open-file (s "/tmp/foo35.tmp" :direction :output))
+  (delete-file "/tmp/foo35.tmp/bar"))
+file-error
+
+(destructuring-bind (a) '(1 2) a)
+error
+
+; directory - no way to make a directory search fail
+
+#-CLISP ; documented behaviour of DISASSEMBLE
+(disassemble #x123456)
+#-CLISP
+type-error
+
+; dribble - no way to force a file-error
+
+(ecase 'x)
+type-error
+
+(elt 'x 0)
+type-error
+
+(elt "abc" 4)
+type-error
+
+(elt '(a b c) 4)
+type-error
+
+(elt '#(a b c) 4)
+type-error
+
+(elt (make-array 3 :fill-pointer 3 :adjustable t) 4)
+type-error
+
+(endp 'x)
+type-error
+
+(ensure-directories-exist "/*/")
+file-error
+
+(error 42)
+type-error
+
+(let ((x nil)) (etypecase x))
+type-error
+
+(every '(lambda (x) x) nil)
+type-error
+
+(every #'identity 'x)
+type-error
+
+(fboundp '(psetf aref))
+type-error
+
+(fdefinition '(psetf aref))
+type-error
+
+(fdefinition '#:nonexistent)
+undefined-function
+
+(file-author "*")
+file-error
+
+(file-length *terminal-io*)
+type-error
+
+(with-open-file (s "/tmp/foo35.tmp" :direction :output)
+  (file-position s 0.0))
+error
+
+(with-open-file (s "/tmp/foo35.tmp" :direction :output)
+  (file-position s -1))
+error
+
+(with-open-file (s "/tmp/foo35.tmp" :direction :input)
+  (file-position s (+ (file-length s) 1000)))
+error
+
+(delete-file "/tmp/foo35.tmp")
+null
+
+(file-write-date "*")
+file-error
+
+(fill 'x #\x)
+type-error
+
+(fill (make-list 3) 'x :start nil)
+type-error
+
+(fill (make-list 3) 'x :start -1)
+type-error
+
+(fill (make-list 3) 'x :start 1 :end -1)
+type-error
+
+(fill-pointer "abc")
+type-error
+
+(find #\x 'x)
+type-error
+
+(find-class '#:nonexistent t)
+error
+
+(progn
+  (defgeneric foo36 (x y))
+  (find-method #'foo36 nil (list (find-class 'number))))
+error
+
+(progn
+  (defgeneric foo37 (x))
+  (find-method #'foo37 nil (list (find-class 'number))))
+error
+
+(finish-output '*terminal-io*)
+type-error
+
+(float-digits 2/3)
+type-error
+
+(float-precision 2/3)
+type-error
+
+(float-radix 2/3)
+type-error
+
+(float-sign 2/3)
+type-error
+
+(float-sign -4.5 2/3)
+type-error
+
+(fmakunbound '(psetf aref))
+type-error
+
+(force-output '*terminal-io*)
+type-error
+
+(funcall 'foo38)
+undefined-function
+
+(funcall 'and)
+undefined-function
+
+(gcd 4 3/4)
+type-error
+
+(gensym #\x)
+type-error
+
+(gentemp 't)
+type-error
+
+(gentemp "X" 24)
+type-error
+
+(get "a" 'x)
+type-error
+
+(get-dispatch-macro-character #\0 #\#)
+error
+
+(graphic-char-p 33)
+type-error
+
+(hash-table-rehash-size *readtable*)
+type-error
+
+(hash-table-rehash-threshold *package*)
+type-error
+
+(hash-table-size *random-state*)
+type-error
+
+(hash-table-test '#(a b c))
+type-error
+
+(imagpart #\c)
+type-error
+
+#-CLISP (in-package "FOO39")
+#+CLISP (common-lisp:in-package "FOO39")
+package-error
+
+(input-stream-p (pathname "abc"))
+type-error
+
+(integer-decode-float 2/3)
+type-error
+
+(integer-length 0.0)
+type-error
+
+(interactive-stream-p (pathname "abc"))
+type-error
+
+(invoke-restart 'foo40)
+control-error
+
+(invoke-restart-interactively 'foo41)
+control-error
+
+(isqrt -1)
+type-error
+
+(isqrt #c(3 4))
+type-error
+
+(last '(a b c) -1)
+type-error
+
+(lcm 4/7 8)
+type-error
+
+(length 'x)
+type-error
+
+(list-length 'x)
+type-error
+
+(list-length '(x . y))
+type-error
+
+(load "/tmp/128347234.lsp")
+file-error
+
+(load "*.lsp")
+file-error
+
+(load-logical-pathname-translations "FOO41")
+error
+
+(logand -3 2.3)
+type-error
+
+(logbitp -1 5)
+type-error
+
+(logbitp 2 3/7)
+type-error
+
+(logcount #*01010011)
+type-error
+
+(logical-pathname '#(#\A #\B))
+type-error
+
+(logical-pathname-translations '#(#\A #\B))
+type-error
+
+(lower-case-p 33)
+type-error
+
+(make-broadcast-stream (make-string-input-stream "abc"))
+type-error
+
+(make-concatenated-stream (make-string-output-stream))
+type-error
+
+(progn
+  (defclass foo42 () ())
+  (make-instance 'foo42 :x 1))
+error
+
+(make-list -1)
+type-error
+
+(progn
+  (defstruct foo43)
+  (make-load-form (make-foo43)))
+error
+
+(make-random-state 'x)
+type-error
+
+(make-sequence 'x 5)
+type-error
+
+(make-sequence 'sequence 5)
+type-error
+
+(make-sequence '(string 3) 4)
+type-error
+
+(make-symbol 'x)
+type-error
+
+(make-synonym-stream *terminal-io*)
+type-error
+
+(make-two-way-stream (make-string-input-stream "abc") (make-string-input-stream "def"))
+type-error
+
+(make-two-way-stream (make-string-output-stream) (make-string-output-stream))
+type-error
+
+(makunbound "xx")
+type-error
+
+(map 'x #'identity "abc")
+type-error
+
+(map '(string 3) #'identity "ab")
+type-error
+
+(max 3 #c(4 0.0))
+type-error
+
+(merge '(vector * 5) '(3 1) '(2 4) #'<)
+type-error
+
+(min 3 #c(4 0.0))
+type-error
+
+(minusp #c(4 -3/4))
+type-error
+
+(muffle-warning)
+control-error
+
+(name-char '#(#\N #\u #\l))
+type-error
+
+(nbutlast '(a b c) -1)
+type-error
+
+(nbutlast '#(a b c))
+type-error
+
+(no-applicable-method #'cons)
+error
+
+(no-next-method #'print-object (find-method #'print-object nil (list (find-class 'standard-object) (find-class 't))))
+error
+
+(notany '(lambda (x) x) nil)
+type-error
+
+(notany #'identity 'x)
+type-error
+
+(notevery '(lambda (x) x) nil)
+type-error
+
+(notevery #'identity 'x)
+type-error
+
+(nthcdr 2 '(a . b))
+type-error
+
+(oddp 3.5)
+type-error
+
+#+UNIX
+(progn (open "/etc/passwd" :direction :input :if-exists :error) (/ 0))
+#+UNIX
+division-by-zero
+
+#+UNIX
+(progn (open "/etc/nonexistent" :direction :input :if-exists :error) (/ 0))
+#+UNIX
+file-error
+
+(open "/tmp/foo44nonexistent" :direction :input :if-does-not-exist :error)
+file-error
+
+(open "/tmp/*" :direction :input)
+file-error
+
+#+UNIX
+(open "/etc/mtab" :direction :input :external-format 'mtab-entries)
+#+UNIX
+error
+
+(open-stream-p (pathname "foo45"))
+type-error
+
+(output-stream-p (pathname "foo46"))
+type-error
+
+(package-name 47)
+type-error
+
+(package-nicknames (pathname "foo47"))
+type-error
+
+(package-shadowing-symbols (vector 'a 'b 'c))
+type-error
+
+(package-use-list (list 'a 'b 'c))
+type-error
+
+(package-used-by-list (list 'a 'b 'c))
+type-error
+
+(parse-integer "x-y")
+error
+
+(parse-namestring (coerce (list #\f #\o #\o (code-char 0) #\4 #\8) 'string))
+parse-error
+
+(parse-namestring "foo48:a" (logical-pathname "foo49:"))
+error
+
+(pathname-match-p 34 "*")
+type-error
+
+(pathname-match-p "x" 34)
+type-error
+
+(peek-char nil (make-string-input-stream "") t)
+end-of-file
+
+(peek-char #\space (make-string-input-stream "") t)
+end-of-file
+
+#| ; It's not clear why peek-char should signal an error, where read-char and
+   ; read-line don't. Kent Pitman says: "Sounds like a mess."
+(peek-char nil (make-string-input-stream "") nil nil t)
+end-of-file
+|#
+
+(phase 'x)
+type-error
+
+(plusp #c(0 4.2))
+type-error
+
+#-CLISP
+(pprint-dispatch nil t)
+#-CLISP
+type-error
+
+#-CLISP
+(pprint-exit-if-list-exhausted)
+#-CLISP
+error
+
+#-CLISP
+(pprint-indent nil 2)
+#-CLISP
+error
+
+#-CLISP
+(let ((x (make-string-output-stream)))
+  (pprint-logical-block (x nil :prefix 24)))
+#-CLISP
+type-error
+
+#-CLISP
+(let ((x (make-string-output-stream)))
+  (pprint-logical-block (x nil :prefix "a" :per-line-prefix "b")))
+#-CLISP
+error
+
+#-CLISP
+(pprint-newline :fresh)
+#-CLISP
+type-error
+
+#-CLISP
+(pprint-pop)
+#-CLISP
+error
+
+(pprint-tab :paragraph 0 1)
+error
+
+(let ((*print-readably* t)) (print-unreadable-object (nil *standard-output*)))
+print-not-readable
+
+(probe-file "*")
+file-error
+
+(provide 25)
+type-error
+
+(random -2.3)
+type-error
+
+(rational #c(2.4 -0.3))
+type-error
+
+(rationalize #c(2.4 -0.3))
+type-error
+
+(read (make-string-input-stream "((a b)") nil)
+end-of-file
+
+(read (make-string-input-stream " ") t)
+end-of-file
+
+(read-byte (pathname "foo50"))
+type-error
+
+(read-byte (make-string-input-stream "abc"))
+error
+
+(let ((filename "/tmp/foo51.bin"))
+  (with-open-file (s filename :direction :output
+                              :if-exists :overwrite
+                              :if-does-not-exist :create))
+  (with-open-file (s filename :direction :input
+                              :element-type '(unsigned-byte 8))
+    (read-byte s t)))
+end-of-file
+(delete-file "/tmp/foo51.bin")
+null
+
+(let ((filename "/tmp/foo52.txt"))
+  (with-open-file (s filename :direction :output
+                              :if-exists :overwrite
+                              :if-does-not-exist :create))
+  (with-open-file (s filename :direction :input)
+    (read-char s t)))
+end-of-file
+(delete-file "/tmp/foo52.txt")
+null
+
+(let ((filename "/tmp/foo53.txt"))
+  (with-open-file (s filename :direction :output
+                              :if-exists :overwrite
+                              :if-does-not-exist :create))
+  (with-open-file (s filename :direction :input)
+    (read-char-no-hang s t)))
+end-of-file
+(delete-file "/tmp/foo53.txt")
+null
+
+(read-from-string "((a b))" nil nil :end 6)
+end-of-file
+
+(read-from-string " () () " t nil :start 3 :end 4)
+end-of-file
+
+(read-line (make-string-input-stream "") t)
+end-of-file
+
+(read-sequence (list 1 2 3) (make-string-input-stream "") :start nil)
+type-error
+
+(read-sequence (list 1 2 3) (make-string-input-stream "") :end -1)
+type-error
+
+(readtable-case nil)
+type-error
+
+(setf (readtable-case *readtable*) ':unknown)
+type-error
+
+(realpart #\c)
+type-error
+
+(progn
+  (defclass foo54 () ())
+  (reinitialize-instance (make-instance 'foo54) :dummy 0))
+error
+
+(remove #\x 'x)
+type-error
+
+(remove-duplicates 'abba)
+type-error
+
+(remprop 55 'abc)
+type-error
+
+(rplaca nil 5)
+type-error
+
+(rplacd nil 5)
+type-error
+
+(scale-float 2/3 -1)
+type-error
+
+(scale-float 3.4 1.0)
+type-error
+
+(set-dispatch-macro-character #\0 #\# #'(lambda (s c n) (loop)))
+error
+
+(set-pprint-dispatch '(vector * 2) nil #c(3 4))
+error
+
+(sin 'x)
+type-error
+
+(sinh 'x)
+type-error
+
+(sleep -1)
+type-error
+
+(progn
+  (defclass foo55 () (a))
+  (slot-boundp (make-instance 'foo55) ':a))
+error
+
+(progn
+  (defclass foo56 () (a))
+  (slot-makunbound (make-instance 'foo56) ':a))
+error
+
+(slot-missing (find-class 't) nil ':a 'setf)
+error
+
+(slot-unbound (find-class 't) nil ':a)
+unbound-slot
+
+(progn
+  (defclass foo57 () (a))
+  (slot-value (make-instance 'foo57) ':a))
+error
+
+(some '(lambda (x) x) nil)
+type-error
+
+(some #'identity 'x)
+type-error
+
+(special-operator-p '(and x y))
+type-error
+
+(special-operator-p '(setf aref))
+type-error
+
+(sqrt 'x)
+type-error
+
+(standard-char-p 33)
+type-error
+
+(stream-element-type '*terminal-io)
+type-error
+
+(string 33)
+type-error
+
+(symbol-function 33)
+type-error
+
+(symbol-function ':compile)
+undefined-function
+
+(symbol-macrolet ((t true)))
+program-error
+
+(symbol-macrolet ((*print-pretty* (stream-print-pretty *standard-output*))))
+program-error
+
+(symbol-macrolet ((foo58 t)) (declare (special foo58)))
+program-error
+
+(symbol-name '(setf foo59))
+type-error
+
+(symbol-package '(setf foo59))
+type-error
+
+(symbol-plist '(setf foo59))
+type-error
+
+(symbol-value '(setf foo59))
+type-error
+
+(symbol-value '#:nonexistent)
+unbound-variable
+
+(tan 'x)
+type-error
+
+(tanh 'x)
+type-error
+
+(throw '#:nonexistent nil)
+control-error
+
+(translate-logical-pathname (make-broadcast-stream))
+type-error
+
+(translate-logical-pathname (logical-pathname "foo61:"))
+file-error
+
+#-CLISP ; clisp explicitly allows symbols as pathnames
+(translate-pathname 'x "x" "y")
+#-CLISP
+type-error
+
+#-CLISP ; clisp explicitly allows symbols as pathnames
+(translate-pathname "a" '* '*)
+#-CLISP
+type-error
+
+(translate-pathname "x" "y" "z")
+error
+
+(truename "/tmp/foo62nonexistent")
+file-error
+
+(truename "/tmp/*/x")
+file-error
+
+(typep nil 'values)
+error
+
+(typep #'cons '(values t))
+error
+
+(typep #'cons '(function (t t) list))
+error
+
+(unexport ':foo63)
+package-error
+
+(progn
+  (defpackage "FOO64" (:export "XYZ"))
+  (defpackage "FOO65" (:export "XYZ"))
+  (defpackage "FOO66" (:use "FOO64" "FOO65") (:shadow "XYZ"))
+  (unintern (find-symbol "XYZ" (find-package "FOO66")) (find-package "FOO66")))
+error
+
+; update-instance-for-different-class too complicated
+
+; update-instance-for-redefined-class too complicated
+
+(upper-case-p 33)
+type-error
+
+(values-list '(a b . c))
+type-error
+
+(vector-pop "foo67")
+type-error
+
+(vector-pop (make-array 10 :fill-pointer 0))
+error
+
+(vector-push 'x (make-array 10))
+error
+
+(let ((a (make-array 5 :fill-pointer 0)))
+  (dotimes (i 100) (vector-push-extend 'x a)))
+error
+
+(warn (make-condition 'error))
+type-error
+
+(warn (make-condition 'warning) "x")
+type-error
+
+(warn 'error)
+type-error
+
+(wild-pathname-p #\x)
+type-error
+
+(write-byte 1 (pathname "foo67"))
+type-error
+
+(write-byte 1 (make-string-output-stream))
+error
+
+(write-sequence '(#\1 #\2 #\3) (make-string-output-stream) :start nil)
+type-error
+
+(write-sequence '(#\1 #\2 #\3) (make-string-output-stream) :end -1)
+type-error
+
+(zerop 'x)
+type-error
+
diff --git a/src/tests/format.tst b/src/tests/format.tst
new file mode 100644
index 000000000..674fc5104
--- /dev/null
+++ b/src/tests/format.tst
@@ -0,0 +1,992 @@
+;*******************************************************************************
+;*      Rosenmueller            format.tst                                     *
+;*******************************************************************************
+
+; ~< ---------------------------------------------------------------------------
+(format nil "~10<foo~;bar~>")
+"foo    bar"
+
+(format nil "~10:<foo~;bar~>")
+"  foo  bar"
+
+(format nil "~10@<foo~;bar~>")
+"foo  bar  "
+
+(format nil "~10:@<foo~;bar~>")
+#+(or XCL CLISP ALLEGRO) "  foo bar " #+(or AKCL ECLS) " foo bar  " #-(or XCL CLISP AKCL ALLEGRO ECLS) UNKNOWN
+
+(format nil "~10<foobar~>")
+"    foobar"
+
+(format nil "~10:<foobar~>")
+"    foobar"
+
+(format nil "~10@<foobar~>")
+"foobar    "
+
+(format nil "~10:@<foobar~>")
+"  foobar  "
+
+; ~< ~s ~^ ---------------------------------------------------------------------
+(format nil "~15<~S~>" 'foo)
+"            foo"
+
+(format nil "~15<~S~;~^~S~>" 'foo)
+"            foo"
+
+(format nil "~15<~S~;~^~S~;~^~S~>" 'foo)
+"            foo"
+
+(format nil "~15<~S~;~^~S~>" 'foo 'bar)
+"foo         bar"
+
+(format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar)
+"foo         bar"
+
+(format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz)
+"foo   bar   baz"
+
+(progn
+(setq liste '(aaaaaaa bbbbbb cccccccccccc dddddddddddddd eeee fffffffff
+gggggggg
+ hhhhh iiii j kk lll mmmm nnnnnn oooooooooo ppppppppppppppp qqqqqqq
+rrrrrrrrrrrr
+s ttt uuuuuuuuu vvvvvvv wwwwwwwwww xxxxx yyyyyy zzzzzzzz))              ;26
+T)
+T
+
+(format nil "~%;; ~<~%;; ~1:; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~;~
+ ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~;~
+ ~s~; ~s~; ~s~; ~s~;~>~%"                               ; 2!
+'aaaaaaa 'bbbbbb 'cccccccccccc 'dddddddddddddd 'eeee 'fffffffff 'gggggggg
+'hhhhh 'iiii 'j 'kk 'lll 'mmmm 'nnnnnn 'oooooooooo 'ppppppppppppppp
+'qqqqqqq
+'rrrrrrrrrrrr 's 'ttt 'uuuuuuuuu 'vvvvvvv 'wwwwwwwwww 'xxxxx 'yyyyyy
+'zzzzzzzz)
+#+XCL
+"
+;;  AAAAAAA  BBBBBB CCCCCCCCCCCC DDDDDDDDDDDDDD EEEE FFFFFFFFF GGGGGGGG
+;;  HHHHH  IIII  JKK LLL MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ
+;;  RRRRRRRRRRRR    S    TTT   UUUUUUUUU   VVVVVVV   WWWWWWWWWW   XXXXX
+"
+;23456789;123456789;123456789;123456789;123456789;123456789;123456789;12
+#-XCL
+"
+;; 
+;;  AAAAAAA BBBBBB CCCCCCCCCCCC DDDDDDDDDDDDDD EEEE FFFFFFFFF GGGGGGGG HHHHH IIII JKK LLL MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ RRRRRRRRRRRR S TTTUUUUUUUUU VVVVVVV WWWWWWWWWW XXXXX
+"
+
+(format nil "~%;; ~<~%;; ~1,50:; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~;~
+ ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~; ~s~;~
+ ~s~; ~s~; ~s~; ~s~;~>~%"                               ; 2!
+'aaaaaaa 'bbbbbb 'cccccccccccc 'dddddddddddddd 'eeee 'fffffffff 'gggggggg
+'hhhhh 'iiii 'j 'kk 'lll 'mmmm 'nnnnnn 'oooooooooo 'ppppppppppppppp
+'qqqqqqq
+'rrrrrrrrrrrr 's 'ttt 'uuuuuuuuu 'vvvvvvv 'wwwwwwwwww 'xxxxx 'yyyyyy
+'zzzzzzzz)
+#+XCL
+"
+;;  AAAAAAA  BBBBBB  CCCCCCCCCCCC  DDDDDDDDDDDDDD
+;;  EEEE  FFFFFFFFF  GGGGGGGG  HHHHH IIII JKK LLL
+;;  MMMM    NNNNNN   OOOOOOOOOO   PPPPPPPPPPPPPPP
+;;  QQQQQQQ  RRRRRRRRRRRR  S TTTUUUUUUUUU VVVVVVV
+;;  WWWWWWWWWW                              XXXXX
+"
+;23456789;123456789;123456789;123456789;123456789;
+#-XCL
+"
+;; 
+;;  AAAAAAA BBBBBB CCCCCCCCCCCC DDDDDDDDDDDDDD EEEE FFFFFFFFF GGGGGGGG HHHHH IIII JKK LLL MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ RRRRRRRRRRRR S TTTUUUUUUUUU VVVVVVV WWWWWWWWWW XXXXX
+"
+
+(defun format-blocksatz (stream parts prefix &optional line-length start-p end-p)
+  (if (null stream)
+    (let ((stream (make-string-output-stream)))
+      (format-blocksatz stream parts prefix line-length start-p end-p)
+      (get-output-stream-string stream)
+    )
+    (unless (endp parts)
+      (setq line-length (or line-length #|(sys::line-length stream)|# 72))
+      (when start-p (format stream prefix))
+      (loop
+        ; Hier ist parts /= NIL
+        (let ((pos (#+CLISP sys::line-position #+ALLEGRO excl::charpos stream))
+              (parts-now '()))
+          (let ((pos-now pos))
+            (loop
+              (when (endp parts) (return))
+              (let* ((part (first parts))
+                     (part-length (length part)))
+                (unless (null parts-now)
+                  (when (> (+ pos-now part-length) line-length)
+                    (return)
+                ) )
+                (pop parts)
+                (push part parts-now)
+                (incf pos-now part-length)
+          ) ) )
+          ; Hier ist parts-now /= NIL
+          (apply #'format
+                 stream
+                 (if (and (endp parts) (not end-p))
+                   (apply #'concatenate 'string
+                     (make-list (length parts-now) :initial-element "~A")
+                   )
+                   (concatenate 'string
+                     "~"
+                     (write-to-string (max 0 (- line-length pos))
+                                      :radix nil :base 10
+                     )
+                     (if (= (length parts-now) 1) "@" "")
+                     "<"
+                     (apply #'concatenate 'string
+                       "~A"
+                       (make-list (1- (length parts-now)) :initial-element "~;~A")
+                     )
+                     "~>"
+                 ) )
+                 (nreverse parts-now)
+        ) )
+        (when (endp parts) (return))
+        (format stream prefix)
+) ) ) )
+FORMAT-BLOCKSATZ
+
+(format-blocksatz nil
+  (mapcar #'(lambda (x) (format nil " ~A" x))
+          '(aaaaaaa bbbbbb cccccccccccc dddddddddddddd eeee fffffffff
+            gggggggg hhhhh iiii j kk lll mmmm nnnnnn oooooooooo
+            ppppppppppppppp qqqqqqq rrrrrrrrrrrr s ttt uuuuuuuuu vvvvvvv
+            wwwwwwwwww xxxxx yyyyyy zzzzzzzz)
+  )
+  "~%;; "
+  nil t nil
+)
+"
+;;  AAAAAAA  BBBBBB  CCCCCCCCCCCC DDDDDDDDDDDDDD EEEE FFFFFFFFF GGGGGGGG
+;;  HHHHH  IIII  J KK LLL MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ
+;;  RRRRRRRRRRRR   S  TTT  UUUUUUUUU  VVVVVVV  WWWWWWWWWW  XXXXX  YYYYYY
+;;  ZZZZZZZZ"
+;123456789;123456789;123456789;123456789;123456789;123456789;123456789;12
+
+(format-blocksatz nil
+  (mapcar #'(lambda (x) (format nil " ~A" x))
+          '(aaaaaaa bbbbbb cccccccccccc dddddddddddddd eeee fffffffff
+            gggggggg hhhhh iiii j kk lll mmmm nnnnnn oooooooooo
+            ppppppppppppppp qqqqqqq rrrrrrrrrrrr s ttt uuuuuuuuu vvvvvvv
+            wwwwwwwwww xxxxx yyyyyy zzzzzzzz)
+  )
+  "~%;; "
+  50 t t
+)
+"
+;;  AAAAAAA   BBBBBB  CCCCCCCCCCCC  DDDDDDDDDDDDDD
+;;  EEEE  FFFFFFFFF  GGGGGGGG  HHHHH IIII J KK LLL
+;;  MMMM NNNNNN OOOOOOOOOO PPPPPPPPPPPPPPP QQQQQQQ
+;;  RRRRRRRRRRRR    S    TTT   UUUUUUUUU   VVVVVVV
+;;  WWWWWWWWWW      XXXXX      YYYYYY     ZZZZZZZZ"
+;123456789;123456789;123456789;123456789;123456789;
+
+;;; unklare Bedeutung (Fehler in Sprachbeschreibung?)
+;;; (format nil "~%;; ~{~<~%;; ~1:; ~s~>~^,~}.~%" liste) ""
+;;; (format nil "~%;; ~{~<~%;; ~1,50:; ~s~>~^,~}.~%" liste) ""
+
+(format nil "~%;; ~{~<~%;; ~1,50:; ~s~>~^,~}.~%"
+          '(aaaaaaa bbbbbb cccccccccccc dddddddddddddd eeee fffffffff
+            gggggggg hhhhh iiii j kk lll mmmm nnnnnn oooooooooo
+            ppppppppppppppp qqqqqqq rrrrrrrrrrrr s ttt uuuuuuuuu vvvvvvv
+            wwwwwwwwww xxxxx yyyyyy zzzzzzzz))
+"
+;;  AAAAAAA, BBBBBB, CCCCCCCCCCCC, DDDDDDDDDDDDDD,
+;;  EEEE, FFFFFFFFF, GGGGGGGG, HHHHH, IIII, J, KK,
+;;  LLL, MMMM, NNNNNN, OOOOOOOOOO,
+;;  PPPPPPPPPPPPPPP, QQQQQQQ, RRRRRRRRRRRR, S,
+;;  TTT, UUUUUUUUU, VVVVVVV, WWWWWWWWWW, XXXXX,
+;;  YYYYYY, ZZZZZZZZ.
+"
+
+; ~f ---------------------------------------------------------------------------
+; Format F
+
+(DEFUN FOO (X)
+       (FORMAT NIL "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" X X X X
+X X))
+FOO
+
+(FOO 3.14159)
+;       "  3.14| 31.42|  3.14|3.1416|3.14|3.141590116672995328"
+"  3.14| 31.42|  3.14|3.1416|3.14|3.14159"
+
+(FOO -3.14159)
+;       " -3.14|-31.42| -3.14|-3.142|-3.14|-3.141590116672995328"
+" -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159"
+
+(FOO 100.0)
+"100.00|******|100.00| 100.0|100.00|100.0"
+
+(FOO 1234.0)
+"1234.00|******|??????|1234.0|1234.00|1234.0"
+
+(FOO 0.006)
+"  0.01|  0.06|  0.01| 0.006|0.01|0.006"
+
+(format nil "~5,2,-13f" 1.1e13)
+" 1.10"
+
+(format nil "~9,0,6f" 3.14159)
+" 3141590."
+
+(FORMAT NIL "~5,3F" (QUOTE A))
+"A"
+
+(FORMAT NIL "~5,3F" #C(1.2 0.3))
+"#C(1.2 0.3)"
+
+(FORMAT NIL "~5,3F" 2/3)
+"0.667"
+
+; ~e ---------------------------------------------------------------------------
+; Format E
+
+(defun foo (x)
+  (format nil
+          "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@e|~9,2E"
+          x x x x))
+FOO
+
+(foo 3.14159)
+"  3.14E+0| 31.42$-01|+.003E+03|  3.14E+0"
+
+(foo -3.14159)
+" -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0"
+
+(foo 1100.0)
+"  1.10E+3| 11.00$+02|+.001E+06|  1.10E+3"
+
+(foo 1100.0L0)
+#+XCL "  1.10D+3| 11.00$+02|+.001D+06|  1.10D+3"
+#+(or CLISP AKCL) "  1.10L+3| 11.00$+02|+.001L+06|  1.10L+3"
+#+ALLEGRO "  1.10d+3| 11.00$+02|+.001d+06|  1.10d+3"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(foo 1.1E13)
+"*********| 11.00$+12|+.001E+16| 1.10E+13"
+
+; ERROR beim read der zahl (foo 1.1L120)
+
+(FORMAT NIL "_~10,4E_" 1.2)
+"_ 1.2000E+0_"
+
+(format nil "~9,2,1E" 0.0314159)
+"  3.14E-2"
+
+; ~% ~d ~e (v) -----------------------------------------------------------------
+(let (x)
+ (dotimes (k 13 x)
+  (setq x (cons (format nil "~%Scale factor ~2D: |~13,6,2,VE|"
+          (- k 5) (- k 5) 3.14159) x))))
+(
+"
+Scale factor  7: | 3141590.E-06|" "
+Scale factor  6: | 314159.0E-05|" "
+Scale factor  5: | 31415.90E-04|" "
+Scale factor  4: | 3141.590E-03|" "
+Scale factor  3: | 314.1590E-02|" "
+Scale factor  2: | 31.41590E-01|" "
+Scale factor  1: | 3.141590E+00|" "
+Scale factor  0: | 0.314159E+01|" "
+Scale factor -1: | 0.031416E+02|" "
+Scale factor -2: | 0.003142E+03|" "
+Scale factor -3: | 0.000314E+04|" "
+Scale factor -4: | 0.000031E+05|" "
+Scale factor -5: | 0.000003E+06|")
+
+
+; ~g ---------------------------------------------------------------------------
+(defun foo (x)
+  (format nil "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G"
+          x x x x))
+foo
+
+(foo 0.0314159)
+"  3.14E-2|314.2$-04|0.314E-01|  3.14E-2"
+
+(foo 0.314159)
+"  0.31   |0.314    |0.314    | 0.31    "
+
+(foo 3.14159)
+"   3.1   | 3.14    | 3.14    |  3.1    "
+
+(foo 31.4159)
+"   31.   | 31.4    | 31.4    |  31.    "
+
+(foo 314.159)
+"  3.14E+2| 314.    | 314.    |  3.14E+2"
+
+(foo 3141.59)
+"  3.14E+3|314.2$+01|0.314E+04|  3.14E+3"
+
+(foo 3141.59L0)
+#+XCL "  3.14D+3|314.2$+01|0.314D+04|  3.14D+3"
+#+(or CLISP AKCL) "  3.14L+3|314.2$+01|0.314L+04|  3.14L+3"
+#+ALLEGRO "  3.14d+3|314.2$+01|0.314d+04|  3.14d+3"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(foo 3.14E12)
+"*********|314.0$+10|0.314E+13| 3.14E+12"
+
+;(foo 3.14L120 und L1200) fehler in numerik
+
+; ~a ---------------------------------------------------------------------------
+
+(FORMAT NIL "foo")
+"foo"
+
+(FORMAT NIL "format-a:--~a--ende" (QUOTE AB\c))
+"format-a:--ABc--ende"
+
+(SETQ Y "elephant")
+"elephant"
+
+(FORMAT NIL "Look at the ~A!" Y)
+"Look at the elephant!"
+
+(FORMAT NIL "format-%:--~%--1-newline-*")
+"format-%:--
+--1-newline-*"
+
+(FORMAT NIL "format-%:--~3%--3-newline-*")
+"format-%:--
+
+
+--3-newline-*"
+
+(FORMAT NIL "format-a:--~5a--ende-*" (QUOTE AB\c))
+"format-a:--ABc  --ende-*"
+
+(FORMAT NIL "format-a:--~5,2a--ende-*" (QUOTE AB\c))
+"format-a:--ABc  --ende-*"
+
+(FORMAT NIL "format-a:--~5,2,3a--ende-*" (QUOTE AB\c))
+"format-a:--ABc   --ende-*"
+
+(FORMAT NIL "format-a:--~5,2,3,'*a--ende-*" (QUOTE AB\c))
+"format-a:--ABc***--ende-*"
+
+(FORMAT NIL "format-a:--~@a--ende-*" (QUOTE AB\c))
+"format-a:--ABc--ende-*"
+
+(FORMAT NIL "format-a:--~5@a--ende-*" (QUOTE AB\c))
+"format-a:--  ABc--ende-*"
+
+(FORMAT NIL "format-a:--~5,2@a--ende-*" (QUOTE AB\c))
+"format-a:--  ABc--ende-*"
+
+(FORMAT NIL "format-a:--~5,2,3@a--ende-*" (QUOTE AB\c))
+"format-a:--   ABc--ende-*"
+
+(FORMAT NIL "format-a:--~5,2,3,'*@a--ende-*" (QUOTE AB\c))
+"format-a:--***ABc--ende-*"
+
+(FORMAT NIL "format-a:--~:a--ende-*" (QUOTE (AB\c NIL XYZ)))
+"format-a:--(ABc NIL XYZ)--ende-*"
+
+(FORMAT NIL "format-s:--~s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:--AB\\c--ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--|ABc|--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~5s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:--AB\\c --ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--|ABc|--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~5,2s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:--AB\\c  --ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--|ABc|--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~5,2,3s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:--AB\\c   --ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--|ABc|   --ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~5,2,3,'*s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:--AB\\c***--ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--|ABc|***--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~@s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:--AB\\c--ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--|ABc|--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~5@s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:-- AB\\c--ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--|ABc|--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~5,2@s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:--  AB\\c--ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--|ABc|--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~5,2,3@s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:--   AB\\c--ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--   |ABc|--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~5,2,3,'*@s--ende-*" (QUOTE AB\c))
+#+XCL "format-s:--***AB\\c--ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--***|ABc|--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(FORMAT NIL "format-s:--~:s--ende-*" (QUOTE (AB\c NIL XYZ)))
+#+XCL "format-s:--(AB\\c NIL XYZ)--ende-*"
+#+(or CLISP AKCL ALLEGRO) "format-s:--(|ABc| NIL XYZ)--ende-*"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(SETQ X 5)
+5
+
+(FORMAT NIL "The answer is ~D." X)
+"The answer is 5."
+
+(FORMAT NIL "The answer is ~3D." X)
+"The answer is   5."
+
+(FORMAT NIL "The answer is ~3,'0D." X)
+"The answer is 005."
+
+(FORMAT NIL "The answer is ~:D." (EXPT 47 X))
+"The answer is 229,345,007."
+
+(FORMAT NIL "decimal:~d, width=5:~5d-*" 10 10)
+"decimal:10, width=5:   10-*"
+
+(FORMAT NIL "format-d:--~d--ende-*" 123)
+"format-d:--123--ende-*"
+
+(FORMAT NIL "format-d:--~10d--ende-*" 123)
+"format-d:--       123--ende-*"
+
+(FORMAT NIL "format-d:--~10,'?d--ende-*" 123)
+"format-d:--???????123--ende-*"
+
+(FORMAT NIL "format-d:--~@d--ende-*" 123)
+"format-d:--+123--ende-*"
+
+(FORMAT NIL "format-d:--~10@d--ende-*" 123)
+"format-d:--      +123--ende-*"
+
+(FORMAT NIL "format-d:--~10,'?@d--ende-*" 123)
+"format-d:--??????+123--ende-*"
+
+(FORMAT NIL "format-b:--~b--ende-*" 123)
+"format-b:--1111011--ende-*"
+
+(FORMAT NIL "format-b:--~10b--ende-*" 123)
+"format-b:--   1111011--ende-*"
+
+(FORMAT NIL "format-b:--~10,'?b--ende-*" 123)
+"format-b:--???1111011--ende-*"
+
+(FORMAT NIL "format-b:--~:b--ende-*" 123)
+"format-b:--1,111,011--ende-*"
+
+(FORMAT NIL "format-b:--~10:b--ende-*" 123)
+"format-b:-- 1,111,011--ende-*"
+
+(FORMAT NIL "format-b:--~10,'?:b--ende-*" 123)
+"format-b:--?1,111,011--ende-*"
+
+(FORMAT NIL "format-b:--~10,'?,'.:b--ende-*" 123)
+"format-b:--?1.111.011--ende-*"
+
+(FORMAT NIL "format-b:--~@b--ende-*" 123)
+"format-b:--+1111011--ende-*"
+
+(FORMAT NIL "format-b:--~10@b--ende-*" 123)
+"format-b:--  +1111011--ende-*"
+
+(FORMAT NIL "format-b:--~10,'?@b--ende-*" 123)
+"format-b:--??+1111011--ende-*"
+
+(FORMAT NIL "format-b:--~:@b--ende-*" 123)
+"format-b:--+1,111,011--ende-*"
+
+(FORMAT NIL "format-o:--~o--ende-*" 123)
+"format-o:--173--ende-*"
+
+(FORMAT NIL "format-o:--~10o--ende-*" 123)
+"format-o:--       173--ende-*"
+
+(FORMAT NIL "format-o:--~10,'?o--ende-*" 123)
+"format-o:--???????173--ende-*"
+
+(FORMAT NIL "format-o:--~@o--ende-*" 123)
+"format-o:--+173--ende-*"
+
+(FORMAT NIL "format-o:--~10@o--ende-*" 123)
+"format-o:--      +173--ende-*"
+
+(FORMAT NIL "format-x:--~x--ende-*" 123)
+"format-x:--7B--ende-*"
+
+(FORMAT NIL "format-x:--~10x--ende-*" 123)
+"format-x:--        7B--ende-*"
+
+(FORMAT NIL "format-x:--~10,'?x--ende-*" 123)
+"format-x:--????????7B--ende-*"
+
+(FORMAT NIL "format-x:--~10:x--ende-*" 123)
+"format-x:--        7B--ende-*"
+
+(FORMAT NIL "format-x:--~@x--ende-*" 123)
+"format-x:--+7B--ende-*"
+
+(FORMAT NIL "format-x:--~10@x--ende-*" 123)
+"format-x:--       +7B--ende-*"
+
+(FORMAT NIL "format-r:--~20r--ende-*" 123)
+"format-r:--63--ende-*"
+
+(FORMAT NIL "format-r:--~20,10r--ende-*" 123)
+"format-r:--        63--ende-*"
+
+(FORMAT NIL "format-r:--~20@r--ende-*" 123)
+"format-r:--+63--ende-*"
+
+(FORMAT NIL "format-r:--~r--ende-*" 9)
+"format-r:--nine--ende-*"
+
+(FORMAT NIL "format-r:--~:r--ende-*" 9)
+"format-r:--ninth--ende-*"
+
+(FORMAT NIL "format-r:--~@r--ende-*" 9)
+"format-r:--IX--ende-*"
+
+(FORMAT NIL "format-r:--~:@r--ende-*" 9)
+"format-r:--VIIII--ende-*"
+
+(FORMAT NIL "format-p:--~d  object~p-*" 1 1)
+"format-p:--1  object-*"
+
+(FORMAT NIL "format-p:--~d  object~p-*" 2 2)
+"format-p:--2  objects-*"
+
+(FORMAT NIL "format-p:--~d  bab~@p-*" 1 1)
+"format-p:--1  baby-*"
+
+(FORMAT NIL "format-p:--~d  bab~@p-*" 2 2)
+"format-p:--2  babies-*"
+
+(FORMAT NIL "format-p:--~d  object~:p-*" 1)
+"format-p:--1  object-*"
+
+(FORMAT NIL "format-p:--~d  object~:p-*" 2)
+"format-p:--2  objects-*"
+
+(FORMAT NIL "format-p:--~d  bab~:@p-*" 1)
+"format-p:--1  baby-*"
+
+(FORMAT NIL "format-&:--~%~&--1-newline-*")
+"format-&:--
+--1-newline-*"
+
+(FORMAT NIL "format-&:--~%~3&--3-newline-*")
+"format-&:--
+
+
+--3-newline-*"
+
+(FORMAT NIL "format-tilde:--~~--1-tilde-*")
+"format-tilde:--~--1-tilde-*"
+
+(FORMAT NIL "format-tilde:--~3~--3-tilden-*")
+"format-tilde:--~~~--3-tilden-*"
+
+(FORMAT NIL "format-|:--~|--1-ff-*")
+"format-|:----1-ff-*"
+
+(FORMAT NIL "format-|:--~2|--2-ff-*")
+"format-|:----2-ff-*"
+
+(FORMAT NIL
+"format-<nl>:~
+                         gl. zeile gl. angeschlossen trotz 2*<tab> und sp-*")
+"format-<nl>:gl. zeile gl. angeschlossen trotz 2*<tab> und sp-*"
+
+(FORMAT NIL "format-<nl>:~@
+                         neue Zeile Anfang trotz <tab> + sp-*")
+"format-<nl>:
+neue Zeile Anfang trotz <tab> + sp-*"
+
+(FORMAT NIL "format-<nl>:~:
+	gleiche Zeile aber ein tab vor Anfang-*")
+"format-<nl>:	gleiche Zeile aber ein tab vor Anfang-*"
+
+(FORMAT NIL "format-?:***~a***~?***~a***-*" 1 "+++~s+++~s+++" (QUOTE
+(A B)) 2)
+"format-?:***1***+++A+++B+++***2***-*"
+
+(FORMAT NIL "format-?:***~a***~?***~a***-*" 1 "+++++++++++++" NIL 2)
+"format-?:***1***+++++++++++++***2***-*"
+
+(FORMAT NIL "~(AAAAAAAA BBBBBB ccccccc dddddddd~)")
+"aaaaaaaa bbbbbb ccccccc dddddddd"
+
+(FORMAT NIL "~:(AAAAAAAA BBBBBB ccccccc dddddddd~)")
+"Aaaaaaaa Bbbbbb Ccccccc Dddddddd"
+
+(FORMAT NIL "~@(AAAAAAAA BBBBBB ccccccc dddddddd~)")
+"Aaaaaaaa bbbbbb ccccccc dddddddd"
+
+(FORMAT NIL "~:@(AAAAAAAA BBBBBB ccccccc dddddddd~)")
+"AAAAAAAA BBBBBB CCCCCCC DDDDDDDD"
+
+(FORMAT NIL "++~{-=~s=-~}++" (QUOTE (1 2 3)))
+"++-=1=--=2=--=3=-++"
+
+(FORMAT NIL "++~2{-=~s=-~}++" (QUOTE (1 2 3)))
+"++-=1=--=2=-++"
+
+(FORMAT NIL "++~@{-=~s=-~}++" 1 2 3)
+"++-=1=--=2=--=3=-++"
+
+(FORMAT NIL "++~:{-=~s=~s=-~}++" (QUOTE ((1 2) (3 4 5) (6 7))))
+"++-=1=2=--=3=4=--=6=7=-++"
+
+(FORMAT NIL "++~:@{-=~s=~s=-~}++" (QUOTE (1 2)) (QUOTE (3 4 5)) (QUOTE
+(6 7)))
+"++-=1=2=--=3=4=--=6=7=-++"
+
+(FORMAT NIL "~{abc~:}")
+#+XCL "abc" #-XCL ERROR
+
+(FORMAT NIL "~{~:}" "xyz")
+#+XCL "xyz" #-XCL ERROR
+
+(FORMAT NIL "~1{~:}" "-~s-" (QUOTE (1 2)) 3)
+"-1-"
+
+(FORMAT NIL "123456789012345678901234567890
+~10,4txx~10,4ty~10,4tzzz~10,4tende")
+#+XCL
+"123456789012345678901234567890
+         xx  y   zzz ende"
+#-XCL
+"123456789012345678901234567890
+          xx  y   zzz ende"
+
+(FORMAT NIL "123456789012345678901234567890
+~3,4@txx~3,4@ty~3,4@tzzz~3,4@tende")
+#+XCL
+"123456789012345678901234567890
+   xx      y   zzz     ende"
+#-XCL
+"123456789012345678901234567890
+    xx      y   zzz     ende"
+
+(FORMAT NIL "-~a-~a-~a-~a-" 1 2 3 4 5 6 7 8 9)
+"-1-2-3-4-"
+
+(FORMAT NIL "-~a-~a-~*~a-~a-" 1 2 3 4 5 6 7 8 9)
+"-1-2-4-5-"
+
+(FORMAT NIL "-~a-~a-~3*~a-~a-" 1 2 3 4 5 6 7 8 9)
+"-1-2-6-7-"
+
+(FORMAT NIL "-~a-~a-~:*~a-~a-" 1 2 3 4 5 6 7 8 9)
+"-1-2-2-3-"
+
+(FORMAT NIL "-~a-~a-~2:*~a-~a-" 1 2 3 4 5 6 7 8 9)
+"-1-2-1-2-"
+
+(FORMAT NIL "-~a-~a-~@*~a-~a-" 1 2 3 4 5 6 7 8 9)
+"-1-2-1-2-"
+
+(FORMAT NIL "-~a-~a-~6@*~a-~a-" 1 2 3 4 5 6 7 8 9)
+"-1-2-7-8-"
+
+(FORMAT NIL "~[aa~;bb~;cc~]" 1)
+"bb"
+
+(FORMAT NIL "~[aa~;bb~;cc~]" 10)
+""
+
+(FORMAT NIL "~2[aa~;bb~;cc~]" 10)
+"cc"
+
+(FORMAT NIL "~@[aaa~]" NIL 10)
+""
+
+(FORMAT NIL "~@[aaa~]" 20 10)
+"aaa"
+
+(FORMAT NIL "~@[aaa~d~]" NIL 10)
+""
+
+(FORMAT NIL "~@[aaa~d~]" 20 10)
+"aaa20"
+
+(FORMAT NIL "~@[aaa~d~]bbb~d" NIL 10 30)
+"bbb10"
+
+(FORMAT NIL "~@[aaa~d~]bbb~d" 20 10 30)
+"aaa20bbb10"
+
+(FORMAT NIL "~:[-nil-~;-true-~d~]-ende~d" NIL 10 20)
+"-nil--ende10"
+
+(FORMAT NIL "~:[-nil-~;-true-~d~]-ende~d" T 10 20)
+"-true-10-ende20"
+
+(FORMAT NIL "Start test, newline:~%freshline:~&")
+"Start test, newline:
+freshline:
+"
+
+(FORMAT NIL "decimal pad with period:~10,vd-*" #\. 12)
+"decimal pad with period:........12-*"
+
+(FORMAT NIL "char normal:~c, as # would read:~@c, human read:~:c-*"
+#\SPACE
+#\SPACE #\SPACE)
+#+(or XCL CMU CLISP) "char normal: , as # would read:#\\Space, human read:Space-*"
+#+(or AKCL LUCID)    "char normal:Space, as # would read:#\\Space, human read:Space-*"
+#+ALLEGRO            "char normal: , as # would read:#\\space, human read:space-*"
+#-(or XCL CMU CLISP AKCL LUCID ALLEGRO) UNKNOWN
+
+(FORMAT NIL
+"cardinal:~r, roman new:~@r, roman-old:~:@r~
+                <same line I hope>~@
+                new line but at beginning~:
+   same line, but spaced out~@
+        new line and over two tabs-*" 4 4 4)
+"cardinal:four, roman new:IV, roman-old:IIII<same line I hope>
+new line but at beginning   same line, but spaced out
+new line and over two tabs-*"
+
+(SETQ N 3)
+3
+
+(FORMAT NIL "~D item~:P found." N)
+"3 items found."
+
+(FORMAT NIL "~R dog~:[s are~; is~] here." N (= N 1))
+"three dogs are here."
+
+(FORMAT NIL "~R dog~:*~[s are~; is~:;s are~] here." N)
+"three dogs are here."
+
+(FORMAT NIL "Here ~[are~;is~:;are~] ~:*~R pupp~:@p." N)
+"Here are three puppies."
+
+(SETQ N 1)
+1
+
+(FORMAT NIL "~D item~:P found." N)
+"1 item found."
+
+(FORMAT NIL "~R dog~:[s are~; is~] here." N (= N 1))
+"one dog is here."
+
+(FORMAT NIL "~R dog~:*~[s are~; is~:;s are~] here." N)
+"one dog is here."
+
+(FORMAT NIL "Here ~[are~;is~:;are~] ~:*~R pupp~:@p." N)
+"Here is one puppy."
+
+(SETQ N 0)
+0
+
+(FORMAT NIL "~D item~:P found." N)
+"0 items found."
+
+(FORMAT NIL "~R dog~:[s are~; is~] here." N (= N 1))
+"zero dogs are here."
+
+(FORMAT NIL "~R dog~:*~[s are~; is~:;s are~] here." N)
+"zero dogs are here."
+
+(FORMAT NIL "Here ~[are~;is~:;are~] ~:*~R pupp~:@p." N)
+"Here are zero puppies."
+
+(FORMAT NIL "~D tr~:@p/~D win~:P" 7 1)
+"7 tries/1 win"
+
+(FORMAT NIL "~D tr~:@p/~D win~:P" 1 0)
+"1 try/0 wins"
+
+(FORMAT NIL "~D tr~:@p/~D win~:P" 1 3)
+"1 try/3 wins"
+
+(DEFUN TYPE-CLASH-ERROR (FN NARGS ARGNUM RIGHT-TYPE WRONG-TYPE) (FORMAT
+NIL
+"~&~S requires itts ~:[~:R~;~*~] ~
+           argument to be of type ~S,~%but it was called ~
+           with an argument of type ~S.-*" FN (EQL NARGS 1) ARGNUM
+RIGHT-TYPE
+WRONG-TYPE))
+TYPE-CLASH-ERROR
+
+(TYPE-CLASH-ERROR (QUOTE AREF) NIL 2 (QUOTE INTEGER) (QUOTE VECTOR))
+"AREF requires itts second argument to be of type INTEGER,
+but it was called with an argument of type VECTOR.-*"
+
+(TYPE-CLASH-ERROR (QUOTE CAR) 1 1 (QUOTE LIST) (QUOTE SHORT-FLOAT))
+"CAR requires itts  argument to be of type LIST,
+but it was called with an argument of type SHORT-FLOAT.-*"
+
+(FORMAT NIL "~? ~D" "<~A ~D>" (QUOTE ("Foo" 5)) 7)
+"<Foo 5> 7"
+
+(FORMAT NIL "~? ~D" "<~A ~D>" (QUOTE (" Foo" 5 14)) 7)
+"< Foo 5> 7"
+
+(FORMAT NIL "~@? ~d" "<~A ~D>" "Foo" 5 7)
+"<Foo 5> 7"
+
+(FORMAT NIL "~@? ~D" "<~A ~D>" "Foo" 5 14 7)
+"<Foo 5> 14"
+
+(FORMAT NIL "~@R ~(~@R~)" 14 14)
+"XIV xiv"
+
+(DEFUN F (N) (FORMAT NIL "~@(~R~) error~:P detected." N))
+F
+
+(F 0)
+"Zero errors detected."
+
+(F 1)
+"One error detected."
+
+(F 23)
+"Twenty-three errors detected."
+
+(SETQ *PRINT-LEVEL* NIL *PRINT-LENGTH* 5)
+5
+
+(FORMAT NIL "~@[ print level = ~D~]~@[ print length = ~D~]" *PRINT-LEVEL*
+
+*PRINT-LENGTH*)
+" print length = 5"
+
+(SETQ *PRINT-LENGTH* NIL)
+NIL
+
+(SETQ FOO
+"Items:~#[none~; ~s~; ~S and ~S~
+          ~:;~@{~#[~; and~] ~S~^,~}~].")
+"Items:~#[none~; ~s~; ~S and ~S~
+          ~:;~@{~#[~; and~] ~S~^,~}~]."
+
+(FORMAT NIL FOO)
+"Items:none."
+
+(FORMAT NIL FOO (QUOTE FOO))
+"Items: FOO."
+
+(FORMAT NIL FOO (QUOTE FOO) (QUOTE BAR))
+"Items: FOO and BAR."
+
+(FORMAT NIL FOO (QUOTE FOO) (QUOTE BAR) (QUOTE BAZ))
+"Items: FOO, BAR, and BAZ."
+
+(FORMAT NIL FOO (QUOTE FOO) (QUOTE BAR) (QUOTE BAZ) (QUOTE QUUX))
+"Items: FOO, BAR, BAZ, and QUUX."
+
+(FORMAT NIL "The winners are:~{ ~S~}." (QUOTE (FRED HARRY JILL)))
+"The winners are: FRED HARRY JILL."
+
+(FORMAT NIL "Pairs:~{ <~S,~S>~}." (QUOTE (A 1 B 2 C 3)))
+"Pairs: <A,1> <B,2> <C,3>."
+
+(FORMAT NIL "Pairs:~:{ <~S,~S>~}." (QUOTE ((A 1) (B 2) (C 3))))
+"Pairs: <A,1> <B,2> <C,3>."
+
+(FORMAT NIL "Pairs:~@{ <~S,~S>~}." (QUOTE A) 1 (QUOTE B) 2 (QUOTE C)
+3)
+"Pairs: <A,1> <B,2> <C,3>."
+
+(FORMAT NIL "Pairs:~:@{ <~S,~S>~}." (QUOTE (A 1)) (QUOTE (B 2)) (QUOTE
+(C 3)))
+"Pairs: <A,1> <B,2> <C,3>."
+
+(SETQ DONESTR "done.~^ ~D warning~:P.~^ ~D error~:P.")
+"done.~^ ~D warning~:P.~^ ~D error~:P."
+
+(FORMAT NIL DONESTR)
+"done."
+
+(FORMAT NIL DONESTR 3)
+"done. 3 warnings."
+
+(FORMAT NIL DONESTR 1 5)
+"done. 1 warning. 5 errors."
+
+(SETQ TELLSTR "~@(~@[~R~]~^ ~A.~)")
+"~@(~@[~R~]~^ ~A.~)"
+
+(FORMAT NIL TELLSTR 23)
+"Twenty-three"
+
+(FORMAT NIL TELLSTR NIL "losers")
+" Losers."
+
+(FORMAT NIL TELLSTR 23 "losers")
+"Twenty-three losers."
+
+(FORMAT NIL "**~c**" #\SPACE)
+#+(or XCL CMU CLISP ALLEGRO) "** **"
+#+(or AKCL LUCID)            "**Space**"
+#-(or XCL CMU CLISP AKCL LUCID ALLEGRO) UNKNOWN
+
+(FORMAT NIL "**~:c**" #\SPACE)
+"**Space**"
+
+(FORMAT NIL "**~:@c**" #\SPACE)
+"**Space**"
+
+(FORMAT NIL "**~@c**" #\SPACE)
+"**#\\Space**"
+
+(FORMAT NIL "**~c**" #\A)
+"**A**"
+
+(FORMAT NIL "**~:c**" #\A)
+"**A**"
+
+(FORMAT NIL "**~:@c**" #\A)
+"**A**"
+
+(FORMAT NIL "**~@c**" #\A)
+"**#\\A**"
+
+#+XCL (FORMAT NIL "**~c**" (CODE-CHAR 26))
+#+XCL "****"
+#+CLISP (FORMAT NIL "**~c**" (CODE-CHAR 27))
+#+CLISP "****"
+
+#+XCL (FORMAT NIL "**~:c**" (CODE-CHAR 26))
+#+XCL "**Z**"
+#+CLISP (FORMAT NIL "**~:c**" (CODE-CHAR 27))
+#+CLISP "**Escape**"
+
+#+XCL (FORMAT NIL "**~:@c**" (CODE-CHAR 26))
+#+XCL "**^Z**"
+#+CLISP (FORMAT NIL "**~:@c**" (CODE-CHAR 27))
+#+CLISP "**Escape**"
+
+#+XCL (FORMAT NIL "**~@c**" (CODE-CHAR 26))
+#+XCL "**#\\**"
+#+CLISP (FORMAT NIL "**~@c**" (CODE-CHAR 27))
+#+CLISP "**#\\Escape**"
+
+(progn (fmakunbound 'foo)
+       (makunbound 'liste)
+t)
+T
+
diff --git a/src/tests/genstream.tst b/src/tests/genstream.tst
new file mode 100644
index 000000000..0bf256a4f
--- /dev/null
+++ b/src/tests/genstream.tst
@@ -0,0 +1,258 @@
+;;; This test program creates several input and output
+;;; `string' streams to test the generic stream facility.
+;;; Generic-streams are used as wrappers to the string-streams.
+;;; Written by Marcus Daniels, April 1994
+
+(use-package "CLOS")
+T
+
+(progn
+
+;; The controller is an instance of this class.
+(defclass generic-stream-controller-class ()
+  (source-stream      ; Input methods get/check-for characters on this stream
+   destination-stream ; Output methods put/clear characters on this stream 
+   ;; Flags are used to indicate the success of the finish/force/clear
+   ;; generic-stream methods.
+   ;; The semantics of CLISP's `close' function is still CLt1, so closed check
+   ;; is done with a flag too.
+   (flags :initform (copy-tree '((finish-output . nil)
+				 (force-output . nil)		
+				 (clear-input . nil)
+				 (closed . nil))))))
+
+;; A subclass of the controller class that has a flag for controlling
+;; capitalization of characters which it prints.
+(defclass generic-stream-controller-class-2 (generic-stream-controller-class)
+  ((capitalize :initarg capitalize :initform nil)))
+
+(defmethod convert (ch (controller generic-stream-controller-class))
+  (if (standard-char-p ch) ch #\_))
+
+(defmethod convert (ch (controller generic-stream-controller-class-2))
+  (call-next-method (if (slot-value controller 'capitalize)
+			(char-upcase ch)
+		      ch) controller))
+
+;; Generic-stream methods invoked for respective stream operations..
+(defmethod generic-stream-read-char ((controller generic-stream-controller-class))
+  (with-slots (source-stream) controller
+              (if (listen source-stream) (read-char source-stream))
+              ))
+
+;; Notice this function does not return boolean values.
+(defmethod generic-stream-listen ((controller generic-stream-controller-class))
+  (if (listen (slot-value controller 'source-stream)) 0 -1))
+
+(defmethod generic-stream-clear-input ((controller generic-stream-controller-class))
+  (rplacd (assoc 'clear-input (slot-value controller 'flags)) t))
+
+(defmethod generic-stream-read-byte ((controller generic-stream-controller-class))
+  (char-code (read-char (slot-value controller 'source-stream))))
+
+(defmethod generic-stream-write-byte ((controller generic-stream-controller-class) by)
+  (write-char (code-char by) (slot-value controller 'destination-stream)))
+
+(defmethod generic-stream-write-char ((controller generic-stream-controller-class) ch)
+  (format (slot-value controller 'destination-stream) "~C"
+	  (convert ch controller)))
+
+(defmethod generic-stream-write-string ((controller generic-stream-controller-class) str start len)
+  (format (slot-value controller 'destination-stream)
+	  "~A" str start len))
+
+(defmethod generic-stream-finish-output ((controller generic-stream-controller-class))
+  (rplacd (assoc 'finish-output (slot-value controller 'flags)) t))
+
+(defmethod generic-stream-force-output ((controller generic-stream-controller-class))
+  (rplacd (assoc 'force-output (slot-value controller 'flags)) t))
+
+(defmethod generic-stream-close ((controller generic-stream-controller-class))
+  (rplacd (assoc 'closed (slot-value controller 'flags)) t))
+
+;;; ------------------------------
+;; Creates a generic stream, assigns source-destination stream values
+(defun make-test-stream (source-stream destination-stream controller)
+  (let ((genstream (make-generic-stream controller)))
+    (setf (slot-value controller 'source-stream) source-stream)
+    (setf (slot-value controller 'destination-stream) destination-stream)
+    genstream))
+
+;; There are several test strings, since several operations are to be
+;; independently tested.
+
+(setq str1 "0123")    ; for testing read-char & write-char
+(setq str1s "4567")   ; for testing write-string
+(setq str2 "abc")     ; for testing read-byte & write-byte
+(setq str2c "def")    ; for testing capitalization (subclassing controller)
+(setq str3 "xyz")     ; for testing read-char eof-error-p, eof-value
+
+;; A input and output stream for each test string
+(setq *string-input-stream-1* (make-string-input-stream str1))
+(setq *string-output-stream-1* (make-string-output-stream))
+(setq *string-input-stream-1s* (make-string-input-stream str1s))
+(setq *string-output-stream-1s* (make-string-output-stream))
+(setq *string-input-stream-2* (make-string-input-stream str2))
+(setq *string-output-stream-2* (make-string-output-stream))
+(setq *string-input-stream-2c* (make-string-input-stream str2c))
+(setq *string-output-stream-2c* (make-string-output-stream))
+(setq *string-input-stream-3* (make-string-input-stream str3))
+
+;; Create the generic-streams
+(setq s1 (make-test-stream
+	  *string-input-stream-1* *string-output-stream-1*
+	  (make-instance 'generic-stream-controller-class)))
+
+(setq s1s (make-test-stream
+	  *string-input-stream-1s* *string-output-stream-1s*
+	  (make-instance 'generic-stream-controller-class)))
+
+(setq s2 (make-test-stream
+	  *string-input-stream-2* *string-output-stream-2*
+	  (make-instance 'generic-stream-controller-class-2)))
+
+(setq s2c (make-test-stream
+	   *string-input-stream-2c* *string-output-stream-2c*
+	   (make-instance 'generic-stream-controller-class-2 'capitalize t)))
+
+(setq s3 (make-test-stream
+	   *string-input-stream-3* nil
+	   (make-instance 'generic-stream-controller-class)))
+
+;; Test listen, read-char, and write-char methods
+(defun copy-string-char (str stream)
+  (dotimes (i (length str) t)
+    (if (and (listen stream) (char-equal (char str i) (read-char stream)))
+	(write-char (char str i) stream)
+      (return nil))
+    ))
+
+;; Test listen, read-byte, and write-byte methods
+(defun copy-string-byte (str stream)
+  (dotimes (i (length str) t)
+    (if (and (listen stream) (eq (char-code (char str i)) (read-byte stream)))
+	(write-byte (char-code (char str i)) stream)
+      (return nil))
+    ))
+
+;; Compare str to data in string-output-stream (results of wr* methods)
+(defun check-output-string (str stream &key capitalize)
+  (let* ((strval (if capitalize (string-upcase str) str))
+	 (controller (generic-stream-controller stream))
+	 (stream (slot-value controller 'destination-stream))
+	 (output-string (get-output-stream-string stream)))
+	(format t "   ~S ~S ~S" str strval output-string)
+	(string= strval output-string)))
+
+;; Report results of read/write-char 
+(defun check-char (str stream &key capitalize)
+  (let* ((test (copy-string-char str stream))
+	 (testr (check-output-string str stream :capitalize capitalize)))
+    (format t "  char-check: ~S listen/read-char: ~S write chk: ~S~%" str test testr)
+    (and test testr)))
+
+;; Report results of read/write-byte
+(defun check-byte (str stream)
+  (let* ((test (copy-string-byte str stream))
+	 (testr (check-output-string str stream)))
+    (format t " byte-check: ~S listen/read-byte: ~S write chk: ~S~%" str test testr)
+    (and test testr)))
+
+;; Report results of read/write-string
+(defun check-write-string (str stream)
+  (write-string str stream)
+  (let ((testr (check-output-string str stream)))
+    (format t "  write-string-check: ~S write chk: ~S~%" str testr)
+    testr))
+
+;; Report flag-set status
+(defun check-flag (flag controller)
+  (let ((status
+	 (cdr
+	  (assoc flag (slot-value controller 'flags)))))
+    (format t "Checking ~S flag status: ~S~%" flag status)
+    status))
+
+(terpri)
+nil
+)
+nil
+
+;;; ----------
+(progn 
+  (format t "Checking READ-CHAR & WRITE-CHAR~%")
+  (check-char str1 s1))
+t
+
+(progn
+  (format t "Checking WRITE-STRING~%")
+  (check-write-string str1s s1s))
+t
+
+(progn
+  (format t "Checking READ-BYTE & WRITE-BYTE~%")
+  (check-byte str2 s2))
+t
+
+(progn
+  (format t "Checking READ-CHAR & WRITE-CHAR with a subclass~%")
+   (check-char str2c s2c :capitalize t))
+t
+
+;;; ----------
+(progn 
+  (setq controller-instance (generic-stream-controller s1))
+  nil)
+nil
+
+(progn
+  (clear-input s1)
+  (check-flag 'clear-input controller-instance))
+t
+
+(progn
+  (finish-output s1)
+  (check-flag 'finish-output controller-instance))
+t
+
+(progn
+  (force-output s1)
+  (check-flag 'force-output controller-instance))
+t
+
+(prog2
+  (format t "Checking generic-stream-p (T): ")
+  (princ (generic-stream-p s1))
+  (terpri))
+t
+
+(prog2
+  (format t "Checking generic-stream-p (NIL): ")
+  (princ (generic-stream-p *string-input-stream-1*))
+  (terpri))
+nil
+
+;;; ----------
+(prog2
+  (format t "Checking READ-CHAR's eof-error-p, eof-value: ")
+  (princ 
+   (and 
+    (eql (read-char s3) #\x)
+    (eql (read-char s3) #\y)
+    (eql (read-char s3) #\z)
+    (eql (read-char s3 nil 2) 2)))
+  (terpri))
+t
+
+;;; ----------
+(progn
+  (format t "Checking CLOSE (NIL,T)~%")
+  (close s1)
+  (princ 
+   (and
+    (eq (check-flag 'closed (generic-stream-controller s2)) NIL)
+    ;; Can't run generic-stream method anymore, must use saved variable.
+    (check-flag 'closed controller-instance))))
+t
+
+
diff --git a/src/tests/hash.tst b/src/tests/hash.tst
new file mode 100644
index 000000000..684195406
--- /dev/null
+++ b/src/tests/hash.tst
@@ -0,0 +1,218 @@
+(PROGN (IN-PACKAGE (QUOTE SYS)) T)      T
+
+(MAKE-HASH-TABLE :TEST (QUOTE EQ) :SIZE 20)
+#S(HASH-TABLE TEST EQ SIZE 20 %%SIZE 64 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 13 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(MAKE-HASH-TABLE :TEST (QUOTE EQL) :SIZE 2)
+#S(HASH-TABLE TEST EQL SIZE 2 %%SIZE 4 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 2 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(MAKE-HASH-TABLE :TEST (QUOTE EQUAL) :SIZE 2)
+#S(HASH-TABLE TEST EQUAL SIZE 2 %%SIZE 4 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 2 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(Progn (MAKE-HASH-TABLE :TEST (FUNCTION EQ) :SIZE 2) t) t
+
+(PROGN (MAKE-HASH-TABLE :TEST (FUNCTION EQL) :SIZE 2)T) T
+
+(MAKE-HASH-TABLE :SIZE NIL)
+ERROR
+
+(MAKE-HASH-TABLE :SIZE -3)
+ERROR
+
+(MAKE-HASH-TABLE :SIZE 2.0)
+ERROR
+
+(MAKE-HASH-TABLE :SIZE 2 :REHASH-SIZE 1.5)
+#S(HASH-TABLE TEST EQL SIZE 2 %%SIZE 4 REHASH-SIZE 1.5 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 2 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(MAKE-HASH-TABLE :SIZE 2 :REHASH-SIZE -1.5)
+ERROR
+
+(MAKE-HASH-TABLE :SIZE 2 :REHASH-SIZE 0.5)
+ERROR
+
+(MAKE-HASH-TABLE :SIZE 2 :REHASH-SIZE 1.0)
+#S(HASH-TABLE TEST EQL SIZE 2 %%SIZE 4 REHASH-SIZE 1.0 %%REHASH-SIZE 4
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 2 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(MAKE-HASH-TABLE :SIZE 2 :REHASH-SIZE 5)
+#S(HASH-TABLE TEST EQL SIZE 2 %%SIZE 4 REHASH-SIZE 5 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 2 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(MAKE-HASH-TABLE :SIZE 4 :REHASH-SIZE 5.0)
+#S(HASH-TABLE TEST EQL SIZE 4 %%SIZE 8 REHASH-SIZE 5.0 %%REHASH-SIZE 8
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 3 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(MAKE-HASH-TABLE :SIZE 2 :REHASH-SIZE NIL)
+ERROR
+
+(MAKE-HASH-TABLE :SIZE 2 :REHASH-THRESHOLD NIL)
+ERROR
+
+(MAKE-HASH-TABLE :%%SIZE 3)
+#S(HASH-TABLE TEST EQL SIZE 16 %%SIZE 3 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 13 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(SETQ TAB (MAKE-HASH-TABLE))
+#S(HASH-TABLE TEST EQL SIZE 16 %%SIZE 32 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 13 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(SETF-GETHASH (QUOTE HALLO) TAB (QUOTE WIEGWHTS))
+WIEGWHTS
+
+(SETF-GETHASH (QUOTE UHU) TAB (QUOTE KAUZ))
+KAUZ
+
+(GETHASH (QUOTE UHU) TAB)
+KAUZ
+
+(GETHASH UHU TAB)
+ERROR
+
+(MAKE-HASH-TABLE)
+#S(HASH-TABLE TEST EQL SIZE 16 %%SIZE 32 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 13 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(SETQ TAB NIL)
+NIL
+
+(SETF-GETHASH (QUOTE UHU) TAB (QUOTE KAUS))
+ERROR
+
+(GETHASH (QUOTE UHU) TAB)
+ERROR
+
+(GETHASH (QUOTE OTTO) TAB)
+ERROR
+
+(SETQ TAB (MAKE-HASH-TABLE))
+#S(HASH-TABLE TEST EQL SIZE 16 %%SIZE 32 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 13 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(SETF-GETHASH (QUOTE UHU) TAB (QUOTE KAUS))
+KAUS
+
+(GETHASH (QUOTE UHU) TAB)
+KAUS
+
+(GETHASH (QUOTE OTTO) TAB)
+NIL
+
+(SETF-GETHASH (QUOTE UHU) TAB (QUOTE KAUZ))
+KAUZ
+
+(SETF-GETHASH TAB)
+ERROR
+
+(REMHASH (QUOTE UHU) TAB)
+T
+
+TAB
+#S(HASH-TABLE TEST EQL SIZE 16 %%SIZE 32 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 13 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(CLRHASH TAB9)
+ERROR
+
+(CLRHASH TAB)
+#S(HASH-TABLE TEST EQL SIZE 16 %%SIZE 32 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 13 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
+(HASH-TABLE-COUNT TAB)
+0
+
+(SETF-GETHASH (QUOTE KLAK) TAB (QUOTE KLASE))
+KLASE
+
+(SETF-GETHASH (QUOTE KUNZE) TAB (QUOTE RIESE))
+RIESE
+
+(HASH-TABLE-P TAB)
+T
+
+(HASH-TABLE-COUNT TAB)
+2
+
+(REMHASH (QUOTE KUNZE) TAB)
+T
+
+(SETF-GETHASH (QUOTE WALD) TAB (QUOTE KHJGSFGJHDF))
+KHJGSFGJHDF
+
+(GETHASH)
+ERROR
+
+(REMHASH)
+ERROR
+
+(CLRHASH TAB)
+#S(HASH-TABLE TEST EQL SIZE 16 %%SIZE 32 REHASH-SIZE 2.0 %%REHASH-SIZE 2
+       REHASH-THRESHOLD 13 %%REHASH-THRESHOLD 13 %%COUNT 0 %%HASH-VEKTOR
+       #(%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT
+%%EMPTY-ELEMENT %%EMPTY-ELEMENT %%EMPTY-ELEMENT))
+
diff --git a/src/tests/hashlong.tst b/src/tests/hashlong.tst
new file mode 100644
index 000000000..8cef25ee4
--- /dev/null
+++ b/src/tests/hashlong.tst
@@ -0,0 +1,50 @@
+#+CLISP (progn (setf (symbol-function 'setf-gethash)
+                     (symbol-function 'sys::puthash)) t)
+#+CLISP t
+#+AKCL (progn (setf (symbol-function 'setf-gethash)
+                    (symbol-function 'sys:hash-set)) t)
+#+AKCL t
+#+ECLS (progn (setf (symbol-function 'setf-gethash)
+                   (symbol-function 'sys:hash-set)) t)
+#+ECLS t
+#+ALLEGRO (progn (setf (symbol-function 'setf-gethash)
+                       (symbol-function 'excl::%puthash)) t)
+#+ALLEGRO t
+
+(DEFUN SYMBOLE ()
+  (LET ((B 0.)
+        (HASH-TABLE (MAKE-HASH-TABLE :SIZE 20. :REHASH-THRESHOLD #+XCL 15. #-XCL 0.75))
+        (LISTE (MAKE-LIST 50.))
+        (LISTE2 (MAKE-LIST 50.)))
+    (RPLACD (LAST LISTE) LISTE)
+    (RPLACD (LAST LISTE2) LISTE2)
+    (DO-SYMBOLS (X (FIND-PACKAGE #+XCL 'lisptest #-XCL "LISP"))
+;     (PRINT X) (FINISH-OUTPUT)
+      (COND ((CAR LISTE)
+             (LET ((HVAL (GETHASH (CAR LISTE) HASH-TABLE))
+                   (LVAL (CAR LISTE2)))
+               (UNLESS (EQ HVAL LVAL)
+                 (PRINT "mist, hash-tabelle kaputt")
+                 (PRINT (CAR LISTE))
+                 (PRINT HASH-TABLE)
+                 (PRINT (HASH-TABLE-COUNT HASH-TABLE))
+                 (PRINT "hval:") (PRINT HVAL)
+                 (PRINT "lval:") (PRINT LVAL)
+                 (return-from symbols 'error))
+               (REMHASH (CAR LISTE) HASH-TABLE)
+               #+XCL (WHEN (< (ROOM) 30000.) (SYSTEM::%GARBAGE-COLLECTION))
+               (SETF-GETHASH X HASH-TABLE (SETQ B (+ 1. B)))
+               (RPLACA LISTE X)
+               (RPLACA LISTE2 B)
+               (SETQ LISTE (CDR LISTE))
+               (SETQ LISTE2 (CDR LISTE2))))
+            (T (SETF-GETHASH X HASH-TABLE (SETQ B (+ 1. B)))
+               (RPLACA LISTE X)
+               (RPLACA LISTE2 B)
+               (SETQ LISTE (CDR LISTE))
+               (SETQ LISTE2 (CDR LISTE2)))))))
+symbole
+
+
+(SYMBOLE) nil
+
diff --git a/src/tests/iofkts.tst b/src/tests/iofkts.tst
new file mode 100644
index 000000000..cca541074
--- /dev/null
+++ b/src/tests/iofkts.tst
@@ -0,0 +1,663 @@
+;*******************************************************************************
+;*      Test der I/O-Funktionen                                                *
+;*******************************************************************************
+
+(PROGN (IN-PACKAGE "USER") T)
+T
+
+;--- let test ------------------------------------------------------------------
+; ewiger compiler-fehler
+;
+
+(progn (setq bs (make-broadcast-stream)) t)
+T
+
+#+XCL *cur-broadcast-stream*
+#+XCL NIL
+
+(print 123. bs)
+123.
+
+#+XCL *cur-broadcast-stream*
+#+XCL NIL
+
+;-------------------------------------------------------------------------------
+; Unread test mit structure-stream
+;
+
+(SETQ STR1 "test 123456")   "test 123456"
+
+(PROGN (SETQ S1 (make-two-way-stream (MAKE-STRING-INPUT-STREAM STR1)
+                                     *standard-output*)) T)
+T
+
+(READ S1)   TEST
+
+(READ-CHAR S1)   #\1
+
+(READ-CHAR S1)   #\2
+
+(UNREAD-CHAR #\2 S1)   NIL
+
+(READ-CHAR S1)   #\2
+
+(READ-CHAR S1)   #\3
+
+(READ-CHAR S1)   #\4
+
+(UNREAD-CHAR #\A S1)   ERROR
+
+(READ-CHAR S1)   #\5
+
+(READ-CHAR S1)   #\6
+
+(CLOSE S1)   T
+
+STR1   "test 123456"
+
+
+;-------------------------------------------------------------------------------
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "abc"))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "  abc  "))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "123"))
+(123 3)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "  123  "))
+(123 7)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "123 t"))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "  123   t  "))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER " ( 12 ) 43   t  "))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "  abc  " :JUNK-ALLOWED T))
+(NIL 2)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "123" :JUNK-ALLOWED T))
+(123 3)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "  123  " :JUNK-ALLOWED T))
+(123 #+XCL 7 #+(or CLISP ECLS AKCL ALLEGRO) 5 #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "123 t" :JUNK-ALLOWED T))
+(123 #+XCL 4 #+(or CLISP ECLS AKCL ALLEGRO) 3 #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER "  123   t  " :JUNK-ALLOWED T))
+(123 #+XCL 8 #+(or CLISP ECLS AKCL ALLEGRO) 5 #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER " ( 12 ) 43   t  " :JUNK-ALLOWED
+T))
+(NIL 1)
+
+(SETQ A "q w e 1 2 r 4 d : :;;;")
+"q w e 1 2 r 4 d : :;;;"
+
+(SETQ B "1 2 3 4 5 6 7")
+"1 2 3 4 5 6 7"
+
+(SETQ C "1.3 4.223")
+"1.3 4.223"
+
+(SETQ D "q w e r t z")
+"q w e r t z"
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER A))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER B))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER C))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER D))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER A :START 4 :END 6))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER B :START 2 :END 3))
+(2 3)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER C :START 1))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER D :START 6))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER A :END 4))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER B :END 3))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER C :END 3))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER D :END 1))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER A :RADIX 1))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER B :RADIX 10))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER C :RADIX 20))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER D :RADIX 40))
+ERROR
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER A :JUNK-ALLOWED T))
+(NIL 0)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER B :JUNK-ALLOWED T))
+(1 #+XCL 2 #+(or CLISP ECLS AKCL ALLEGRO) 1 #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER C :JUNK-ALLOWED T))
+(1 1)
+
+(MULTIPLE-VALUE-LIST (PARSE-INTEGER D :JUNK-ALLOWED T))
+(NIL 0)
+
+(STREAM-ELEMENT-TYPE #+XCL STDIN #-XCL *TERMINAL-IO*)
+#+(or CLISP ALLEGRO) CHARACTER #-(or CLISP ALLEGRO) STRING-CHAR
+
+(PROGN (SETQ A (MAKE-STRING-INPUT-STREAM "aaa bbb")) T)
+T
+
+(READ A)
+AAA
+
+#+XCL (B-CLEAR-INPUT A)
+#+XCL NIL
+
+(READ A)
+#+XCL ERROR
+#-XCL BBB
+
+(PROGN (SETQ A (MAKE-STRING-OUTPUT-STREAM))
+       (SETQ B (MAKE-STRING-OUTPUT-STREAM))
+       (SETQ C (MAKE-BROADCAST-STREAM A B)) T)
+T
+
+(PRINT "xxx" C)
+"xxx"
+
+(CLEAR-OUTPUT C)
+NIL
+
+(FINISH-OUTPUT C)
+#+XCL T
+#-XCL NIL
+
+(GET-OUTPUT-STREAM-STRING A)
+"
+\"xxx\" "
+
+(GET-OUTPUT-STREAM-STRING B)
+"
+\"xxx\" "
+
+(PRINT "yyy" C)
+"yyy"
+
+(CLEAR-OUTPUT C)
+NIL
+
+(FINISH-OUTPUT C)
+#+XCL T
+#-XCL NIL
+
+(PRINT "zzz" A)
+"zzz"
+
+(CLEAR-OUTPUT A)
+NIL
+
+(FINISH-OUTPUT A)
+#+XCL T
+#-XCL NIL
+
+(GET-OUTPUT-STREAM-STRING A)
+#+XCL ""
+#-XCL "
+\"yyy\" 
+\"zzz\" "
+
+(GET-OUTPUT-STREAM-STRING B)
+"
+\"yyy\" "
+
+(PROGN (SETQ A (MAKE-STRING-INPUT-STREAM "123")) T)
+T
+
+(LISTEN A)
+T
+
+(READ A)
+123
+
+(listen a)
+NIL
+
+*PRINT-CASE*
+:UPCASE
+
+*PRINT-GENSYM*
+T
+
+*PRINT-LEVEL*
+NIL
+
+*PRINT-LENGTH*
+NIL
+
+*PRINT-ARRAY*
+T
+
+*PRINT-ESCAPE*
+T
+
+*PRINT-PRETTY*
+NIL
+
+*PRINT-CIRCLE*
+NIL
+
+*PRINT-BASE*
+10
+
+*PRINT-RADIX*
+NIL
+
+(SETQ STRING1 "Das ist ein Test mit Print ")
+"Das ist ein Test mit Print "
+
+(PRIN1-TO-STRING STRING1)
+"\"Das ist ein Test mit Print \""
+
+(PRINC-TO-STRING STRING1)
+"Das ist ein Test mit Print "
+
+(PROGN (SETQ A (MAKE-STRING-INPUT-STREAM "123")) T)
+T
+
+(READ-CHAR-NO-HANG A)
+#\1
+
+(READ A)
+23
+
+(read-char-no-hang a)
+ERROR
+
+(read-char-no-hang a nil "EOF")
+"EOF"
+
+(PROGN (SETQ A (MAKE-STRING-INPUT-STREAM "1   2   ;32  abA"))
+(SETQ B (MAKE-STRING-INPUT-STREAM " 1 2 3 A x y z
+a b c")) T)
+T
+
+(READ-DELIMITED-LIST #\A B)
+(1 2 3)
+
+(SETQ C (MULTIPLE-VALUE-LIST (READ-LINE B)))
+(" x y z" NIL)
+
+(LENGTH C)
+2
+
+(MULTIPLE-VALUE-LIST (READ-LINE B))
+("a b c" T)
+
+(MULTIPLE-VALUE-LIST (READ-LINE B))
+ERROR
+
+(MULTIPLE-VALUE-LIST (READ-LINE B NIL "EOF"))
+#+(or XCL ANSI-CL) ("EOF" T) #-(or XCL ANSI-CL) ("EOF")
+
+(PEEK-CHAR NIL A)
+#\1
+
+(READ-CHAR A)
+#\1
+
+(PEEK-CHAR T A)
+#\2
+
+(READ-CHAR A)
+#\2
+
+(PEEK-CHAR T A)
+#\;
+
+(READ-CHAR A)
+#\;
+
+(PEEK-CHAR #\A A)
+#\A
+
+(READ-CHAR A)
+#\A
+
+(PEEK-CHAR NIL A)
+ERROR
+
+(PEEK-CHAR NIL A NIL "EOF")
+"EOF"
+
+(SETQ A (QUOTE
+((BERLIN (DRESDEN FRANKFURT BONN MUENCHEN)) (MUELLER (KARL LUISE DIETER
+ALDO)))))
+((BERLIN (DRESDEN FRANKFURT BONN MUENCHEN)) (MUELLER (KARL LUISE DIETER
+ALDO)))
+
+(PROGN (SETQ AA (MAKE-STRING-INPUT-STREAM "berlin d mueller :r")) T)
+T
+
+(DEFUN ASK (&OPTIONAL (RES NIL))
+"  (terpri)(terpri)(terpri)
+  (print '(*** Eingabe des  Keywortes ***))
+  (print '(- mit :r reset))
+  (terpri)" (SETQ X (READ AA)) "  (print x)" (COND
+((EQUAL X (QUOTE :R)) (CONS "--- reset ---" RES))
+(T (CONS (CADR (ASSOC X A)) (ASK RES)))))
+ASK
+
+(ASK)
+((DRESDEN FRANKFURT BONN MUENCHEN) NIL (KARL LUISE DIETER ALDO) "--- reset ---")
+
+(SETQ STRING1 "Das ist ein Teststring")
+"Das ist ein Teststring"
+
+(SETQ STRING2 "Auch das 1 2 3 ist ein Teststring")
+"Auch das 1 2 3 ist ein Teststring"
+
+(MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1))
+(DAS 4)
+
+(MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING2))
+(AUCH 5)
+
+(MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :START 2))
+(S 4)
+
+(MULTIPLE-VALUE-LIST
+(READ-FROM-STRING STRING1 T NIL :START 2 :PRESERVE-WHITESPACE T))
+(S 3)
+
+(MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING2 T NIL :START 5))
+(DAS 9)
+
+(MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING2 T NIL :START 5 :END
+6))
+(D 6)
+
+(MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :START 4 :END
+3))
+ERROR
+
+(MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :END 0))
+ERROR
+
+(MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :START -2 :END
+0))
+ERROR
+
+(MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :END 2))
+(DA 2)
+
+*READ-SUPPRESS*
+NIL
+
+(STANDARD-CHAR-P (QUOTE A))
+ERROR
+
+(STANDARD-CHAR-P (QUOTE #\BACKSPACE))
+#+XCL T #-XCL NIL
+
+(STANDARD-CHAR-P (QUOTE #\TAB))
+#+XCL T #-XCL NIL
+
+(STANDARD-CHAR-P (QUOTE #\NEWLINE))
+T
+
+(STANDARD-CHAR-P (QUOTE #\PAGE))
+#+XCL T #-XCL NIL
+
+(STANDARD-CHAR-P (QUOTE #\RETURN))
+#+XCL T #-XCL NIL
+
+(STRING-CHAR-P (QUOTE A))
+ERROR
+
+(STRING-CHAR-P (QUOTE #\SPACE))
+T
+
+(STRING-CHAR-P (QUOTE #\NEWLINE))
+T
+
+(STRING-CHAR-P (QUOTE #\BACKSPACE))
+T
+
+(STRING-CHAR-P (QUOTE #\a))
+T
+
+(STRING-CHAR-P (QUOTE #\8))
+T
+
+(STRING-CHAR-P (QUOTE #\-))
+T
+
+(STRING-CHAR-P (QUOTE #\n))
+T
+
+(STRING-CHAR-P (QUOTE #\())
+T
+
+(STRINGP "das ist einer der Teststrings")
+T
+
+(STRINGP (QUOTE (DAS IST NATUERLICH FALSCH)))
+NIL
+
+(STRINGP "das ist die eine Haelfte" "und das die andere")
+ERROR
+
+(SETQ J 0)
+0
+
+(WITH-INPUT-FROM-STRING (S "animal crackers" :START 6) (READ S))
+CRACKERS
+
+(WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 6) (READ S))
+CRACKERS
+
+J
+15
+
+(WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 7) (READ S))
+CRACKERS
+
+J
+15
+
+(WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 2) (READ S))
+IMAL
+
+J
+7
+
+(WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 0 :END 6) (READ S))
+ANIMAL
+
+J
+6
+
+(WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 0 :END
+12) (READ S))
+ANIMAL
+
+J
+7
+
+(WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START -1) (READ S))
+ERROR
+
+J
+7
+
+(WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 6 :END
+20) (READ S))
+#+XCL CRACKERS #+(or CLISP ECLS AKCL ALLEGRO) ERROR #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+J
+#+XCL 20 #+(or CLISP ECLS AKCL ALLEGRO) 7 #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(SETQ A "Das ist wieder einmal einer der SUUPERTESTstrings.")
+"Das ist wieder einmal einer der SUUPERTESTstrings."
+
+(PROGN (SETQ B (MAKE-STRING-OUTPUT-STREAM)) T)
+T
+
+(WRITE-STRING A B)
+"Das ist wieder einmal einer der SUUPERTESTstrings."
+
+(WRITE-STRING A B :START 10)
+"Das ist wieder einmal einer der SUUPERTESTstrings."
+
+(WRITE-STRING A B :START 80)
+#+XCL "Das ist wieder einmal einer der SUUPERTESTstrings."
+#-XCL ERROR
+
+(WRITE-STRING A B :END 5)
+"Das ist wieder einmal einer der SUUPERTESTstrings."
+
+(WRITE-STRING A B :END -2)
+ERROR
+
+(WRITE-STRING A B :END 100)
+#+XCL "Das ist wieder einmal einer der SUUPERTESTstrings."
+#-XCL ERROR
+
+(WRITE-STRING A B :START 5 :END 20)
+"Das ist wieder einmal einer der SUUPERTESTstrings."
+
+(WRITE-STRING A B :START 10 :END 5)
+#+XCL "Das ist wieder einmal einer der SUUPERTESTstrings."
+#-XCL ERROR
+
+(GET-OUTPUT-STREAM-STRING B)
+#+XCL
+"Das ist wieder einmal einer der SUUPERTESTstrings.eder einmal einer der SUUPERTESTstrings.Das iDas ist wieder einmal einer der SUUPERTESTstrings.st wieder einma"
+#+(or CLISP ECLS AKCL)
+"Das ist wieder einmal einer der SUUPERTESTstrings.eder einmal einer der SUUPERTESTstrings.Das ist wieder einma"
+#-(or XCL CLISP ECLS AKCL) UNKNOWN
+
+(WRITE-STRING A B)
+"Das ist wieder einmal einer der SUUPERTESTstrings."
+
+(LENGTH (GET-OUTPUT-STREAM-STRING B))
+50
+
+(WRITE-LINE A B)
+"Das ist wieder einmal einer der SUUPERTESTstrings."
+
+(LENGTH (GET-OUTPUT-STREAM-STRING B))
+51
+
+(WITH-OUTPUT-TO-STRING (S) (PRINT (QUOTE XXX) S))
+"
+XXX "
+
+(SETQ A (MAKE-ARRAY 10 :ELEMENT-TYPE (QUOTE STRING-CHAR) :FILL-POINTER
+0))
+""
+
+(WITH-OUTPUT-TO-STRING (S A) (PRINC 123 S))
+123
+
+A
+"123"
+
+(WITH-OUTPUT-TO-STRING (S A) (PRINC 4567 S))
+4567
+
+A
+"1234567"
+
+(WITH-OUTPUT-TO-STRING (S A) (PRINC 890 S))
+890
+
+A
+"1234567890"
+
+(WITH-OUTPUT-TO-STRING (S A) (PRINC (QUOTE A) S))
+ERROR
+
+A
+"1234567890"
+
+(SETQ A
+(MAKE-ARRAY 10 :ELEMENT-TYPE (QUOTE STRING-CHAR) :FILL-POINTER 0 :ADJUSTABLE
+T))
+""
+
+(WITH-OUTPUT-TO-STRING (S A) (PRINC 123 S))
+123
+
+A
+"123"
+
+(WITH-OUTPUT-TO-STRING (S A) (PRINC 4567 S))
+4567
+
+A
+"1234567"
+
+(WITH-OUTPUT-TO-STRING (S A) (PRINC 890 S))
+890
+
+A
+"1234567890"
+
+(WITH-OUTPUT-TO-STRING (S A) (PRINC (QUOTE ABCDE) S))
+ABCDE
+
+A
+"1234567890ABCDE"
+
+(WITH-OUTPUT-TO-STRING (S A) (PRINC (QUOTE FGHI) S))
+FGHI
+
+A
+"1234567890ABCDEFGHI"
+
+(progn
+(makunbound 'bs)
+(makunbound 'a)
+(makunbound 'b)
+(makunbound 'c)
+(makunbound 'd)
+(makunbound 'aa)
+(makunbound 'string1)
+(makunbound 'string2)
+(makunbound 'x)
+(makunbound 'j)
+(makunbound 's1)
+(makunbound 'str1)
+t)
+T
+
diff --git a/src/tests/lambda.tst b/src/tests/lambda.tst
new file mode 100644
index 000000000..a82021f28
--- /dev/null
+++ b/src/tests/lambda.tst
@@ -0,0 +1,209 @@
+(makunbound 'b) B
+(makunbound 'e) E
+
+(SETQ Z 2) 2
+
+((LAMBDA (Z) (DECLARE (SPECIAL Z)) (LIST Z (SYMBOL-VALUE 'Z))) 3)
+(3 3)
+
+(MAKUNBOUND 'Z) Z
+
+((LAMBDA (A B) (+ A (* B 3))) 4 5)
+19
+
+((LAMBDA (A &OPTIONAL (B 2)) (+ A (* B 3))) 4 5)
+19
+
+((LAMBDA (A &OPTIONAL (B 2)) (+ A (* B 3))) 4)
+10
+
+((LAMBDA (&OPTIONAL (A 2 B) (C 3 D) &REST X) (LIST A B C D X)))
+(2 NIL 3 NIL NIL)
+
+((LAMBDA (&OPTIONAL (A 2 B) (C 3 D) &REST X) (LIST A B C D X)) 6)
+(6 T 3 NIL NIL)
+
+((LAMBDA (&OPTIONAL (A 2 B) (C 3 D) &REST X) (LIST A B C D X)) 6 3)
+(6 T 3 T NIL)
+
+((LAMBDA (&OPTIONAL (A 2 B) (C 3 D) &REST X) (LIST A B C D X)) 6 3
+8)
+(6 T 3 T (8))
+
+((LAMBDA (&OPTIONAL (A 2 B) (C 3 D) &REST X) (LIST A B C D X)) 6 3
+8 9 10 11)
+(6 T 3 T (8 9 10 11))
+
+((LAMBDA (A B &KEY C D) (LIST A B C D)) 1 2)
+(1 2 NIL NIL)
+
+((LAMBDA (A B &KEY C D) (LIST A B C D)) 1 2 :C 6)
+(1 2 6 NIL)
+
+((LAMBDA (A B &KEY C D) (LIST A B C D)) 1 2 :D 8)
+(1 2 NIL 8)
+
+((LAMBDA (A B &KEY C D) (LIST A B C D)) 1 2 :C 6 :D 8)
+(1 2 6 8)
+
+((LAMBDA (A B &KEY C D) (LIST A B C D)) 1 2 :D 8 :C 6)
+(1 2 6 8)
+
+((LAMBDA (A B &KEY C D) (LIST A B C D)) :A 1 :D 8 :C 6)
+(:A 1 6 8)
+
+((LAMBDA (A B &KEY C D) (LIST A B C D)) :A :B :C :D)
+(:A :B :D NIL)
+
+((LAMBDA (A &OPTIONAL (B 3) &REST X &KEY C (D A)) (LIST A B C D X))
+1)
+(1 3 NIL 1 NIL)
+
+((LAMBDA (A &OPTIONAL (B 3) &REST X &KEY C (D A)) (LIST A B C D X))
+1 2)
+(1 2 NIL 1 NIL)
+
+((LAMBDA (A &OPTIONAL (B 3) &REST X &KEY C (D A)) (LIST A B C D X))
+:C 7)
+(:C 7 NIL :C NIL)
+
+((LAMBDA (A &OPTIONAL (B 3) &REST X &KEY C (D A)) (LIST A B C D X))
+1 6 :C 7)
+(1 6 7 1 (:C 7))
+
+((LAMBDA (A &OPTIONAL (B 3) &REST X &KEY C (D A)) (LIST A B C D X))
+1 6 :D 8)
+(1 6 NIL 8 (:D 8))
+
+((LAMBDA (A &OPTIONAL (B 3) &REST X &KEY C (D A)) (LIST A B C D X))
+1 6 :D 8 :C
+9 :D 10)
+(1 6 9 8 (:D 8 :C 9 :D 10))
+
+((LAMBDA (X &AUX (A 3) (B 4)) (+ X (* A B))) 2)
+14
+
+((LAMBDA (X Y &OPTIONAL A B &REST Z &KEY C (D Y) &AUX (U 3) (V 4))
+
+(+ X Y A (* B (CAR Z)) C (* D U) V)) 3 4 5 2 7 :C 6 :D 8)
+ERROR
+
+((LAMBDA (X Y &OPTIONAL A B &REST Z &KEY C (D Y) &AUX (U 3) (V 4))
+
+(+ X Y A (* B (CAR Z)) C (* D U) V)) 3 4 5 2 7 :C 6)
+ERROR
+
+((LAMBDA (X &AUX C) (CONS X C)) (QUOTE A))
+(A)
+
+((LAMBDA (X &REST Y Z) (LIST X Y Z)) 1 2 3)
+ERROR
+
+((LAMBDA (5 A B) (LIST A B)) 1 2)
+ERROR
+
+((LAMBDA ((LENGTH (QUOTE (A B))) C) (LIST C)) 1)
+ERROR
+
+((LAMBDA (X &KEY :Y :Z) (LIST X Y Z)) 1 :Y 2 :Z 3)
+ERROR
+
+((LAMBDA (X Y) (LIST X Y Z)) 1 2)
+ERROR
+
+((LAMBDA (X Y) (LIST X Y Z)) 1 2 3)
+ERROR
+
+((LAMBDA (&OPTIONAL) (LIST A B C)) 1)
+ERROR
+
+((LAMBDA (&OPTIONAL (A)) (LIST A)) 1)
+(1)
+
+((LAMBDA (&OPTIONAL (A B)) (LIST A B)) 1)
+ERROR
+
+((LAMBDA (&OPTIONAL (A 3 B)) (LIST A B)) 1)
+(1 T)
+
+((LAMBDA (&OPTIONAL (A 3)) (LIST A)) 1)
+(1)
+
+((LAMBDA (&OPTIONAL (A 3 B 4)) (LIST A B)) 1)
+#+XCL (1 T)
+#-XCL ERROR
+
+((LAMBDA (X) (LIST X Y)) 1 2)
+ERROR
+
+((LAMBDA (X) (LIST X)) 1 2)
+ERROR
+
+((LAMBDA (#\a) (LIST A)) 1)
+ERROR
+
+((LAMBDA (#*10) (LIST 1 2 3)))
+ERROR
+
+((LAMBDA (X Y) ((LAMBDA (A B) (LIST A B)) (QUOTE U) (QUOTE V))) 5 6)
+(U V)
+
+((LAMBDA (X Y) (LIST X Y)) 1)
+ERROR
+
+((LAMBDA (X &REST Y &OPTIONAL (Z 5)) (LIST X Y Z)) 1 3)
+ERROR
+
+((LAMBDA (X &X) (LIST X)) 7)
+ERROR
+
+((LAMBDA (X &AUX) (LIST X)) 6)
+(6)
+
+((LAMBDA (X &AUX Y) (LIST X Y)) 6)
+(6 NIL)
+
+((LAMBDA (X &AUX (Y)) (LIST X Y)) 6)
+(6 NIL)
+
+((LAMBDA (X &REST) (LIST X)) 2)
+ERROR
+
+((LAMBDA (X &KEY) (LIST X)) 3)
+(3)
+
+((LAMBDA (X &KEY Y) (LIST X)) 3)
+(3)
+
+((LAMBDA (X &KEY Y) (LIST X)) 3 :Y)
+ERROR
+
+((LAMBDA (X &KEY Y) (LIST X)) :\3)
+(:\3)
+
+((LAMBDA NIL (LIST 1 2 3)))
+(1 2 3)
+
+((LAMBDA NIL (LIST 1 2 3)) 4 5)
+ERROR
+
+((LAMBDA (LIST 1 2 3)))
+ERROR
+
+((LAMBDA (X)))
+ERROR
+
+((LAMBDA (&AUX &KEY &REST &OPTIONAL)))
+ERROR
+
+((LAMBDA (A B &KEY C D &ALLOW-OTHER-KEYS) (LIST A B C D E F)) 1 2 :C
+6 :D 8 :E 5
+:F 7)
+ERROR
+
+((LAMBDA (X &ALLOW-OTHER-KEYS) (LIST X Y)) 2 :Y 3)
+ERROR
+
+((LAMBDA))
+ERROR
+
diff --git a/src/tests/lists151.tst b/src/tests/lists151.tst
new file mode 100644
index 000000000..839992579
--- /dev/null
+++ b/src/tests/lists151.tst
@@ -0,0 +1,634 @@
+
+(MAKUNBOUND 'A)
+A
+
+(MAKUNBOUND 'X)
+X
+
+(CAR '(A B C D E F G))
+A
+
+(CDR '(A B C D E F G))
+(B C D E F G)
+
+(CAAR '((A) B C D E F G))
+A
+
+(CADR '(A B C D E F G))
+B
+
+(CDAR '((A B) C D E F G))
+(B)
+
+(CDDR '(A B C D E F G))
+(C D E F G)
+
+(CAAAR '(((A)) B C D E F G))
+A
+
+(CAADR '(A (B) C D E F G))
+B
+
+(CADAR '((A B) C D E F G))
+B
+
+(CADDR '(A B C D E F G))
+C
+
+(CDAAR '(((A B)) C D E F G))
+(B)
+
+(CDADR '(A (B C) D E F G))
+(C)
+
+(CDDAR '((A B C) D E F G))
+(C)
+
+(CDDDR '(A B C D E F G))
+(D E F G)
+
+(CAAAAR '((((A))) B C D E F G))
+A
+
+(CAAADR '(A ((B)) C D E F G))
+B
+
+(CAADAR '((A (B)) C D E F G))
+B
+
+(CAADDR '(A B (C) D E F G))
+C
+
+(CADAAR '(((A B)) C D E F G))
+B
+
+(CADADR '(A (B C) D E F G))
+C
+
+(CADDAR '((A B C) D E F G))
+C
+
+(CADDDR '(A B C D E F G))
+D
+
+(CDAAAR '((((A B))) C D E F G))
+(B)
+
+(CDAADR '(A ((B C)) D E F G))
+(C)
+
+(CDADAR '((A (B C)) D E F G))
+(C)
+
+(CDADDR '(A B (C D) E F G))
+(D)
+
+(CDDAAR '(((A B C)) D E F G))
+(C)
+
+(CDDADR '(A (B C D) E F G))
+(D)
+
+(CDDDAR '((A B C D) E F G))
+(D)
+
+(CDDDDR '(A B C D E F G))
+(E F G)
+
+(CAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+((((1 2 3) 4) 5) (6 7))
+
+(CDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+((((U V W) X) Y) ((Q W E) R) (A B C) E F G)
+
+(CAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+(((1 2 3) 4) 5)
+
+(CADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+(((U V W) X) Y)
+
+(CDAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+((6 7))
+
+(CDDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+(((Q W E) R) (A B C) E F G)
+
+(CAAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+((1 2 3) 4)
+
+(CAADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+((U V W) X)
+
+(CADAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+(6 7)
+
+(CADDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+((Q W E) R)
+
+(CDAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+(5)
+
+(CDADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+(Y)
+
+(CDDAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+NIL
+
+(CDDDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C)
+E F G))
+((A B C) E F G)
+
+(CAAAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+(1 2 3)
+
+(CAAADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+(U V W)
+
+(CAADAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+6
+
+(CAADDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+(Q W E)
+
+(CADAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+5
+
+(CADADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+Y
+
+(CADDAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+NIL
+
+(CADDDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+(A B C)
+
+(CDAAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+(4)
+
+(CDAADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+(X)
+
+(CDADAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+(7)
+
+(CDADDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+(R)
+
+(CDDAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+NIL
+
+(CDDADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+NIL
+
+(CDDDAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+NIL
+
+(CDDDDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B
+C) E F G))
+(E F G)
+
+(CAR 'NIL)
+NIL
+
+(CDR 'NIL)
+NIL
+
+(CAAR 'NIL)
+NIL
+
+(CADR 'NIL)
+NIL
+
+(CDAR 'NIL)
+NIL
+
+(CDDR 'NIL)
+NIL
+
+(CAAAR 'NIL)
+NIL
+
+(CAADR 'NIL)
+NIL
+
+(CADAR 'NIL)
+NIL
+
+(CADDR 'NIL)
+NIL
+
+(CDAAR 'NIL)
+NIL
+
+(CDADR 'NIL)
+NIL
+
+(CDDAR 'NIL)
+NIL
+
+(CDDDR 'NIL)
+NIL
+
+(CAAAAR 'NIL)
+NIL
+
+(CAAADR 'NIL)
+NIL
+
+(CAADAR 'NIL)
+NIL
+
+(CAADDR 'NIL)
+NIL
+
+(CADAAR 'NIL)
+NIL
+
+(CADADR 'NIL)
+NIL
+
+(CADDAR 'NIL)
+NIL
+
+(CADDDR 'NIL)
+NIL
+
+(CDAAAR 'NIL)
+NIL
+
+(CDAADR 'NIL)
+NIL
+
+(CDADAR 'NIL)
+NIL
+
+(CDADDR 'NIL)
+NIL
+
+(CDDAAR 'NIL)
+NIL
+
+(CDDADR 'NIL)
+NIL
+
+(CDDDAR 'NIL)
+NIL
+
+(CDDDDR 'NIL)
+NIL
+
+(CAR '(A B C D E F G))
+A
+
+(CDR '(A B C D E F G))
+(B C D E F G)
+
+(CAAR '(A B C D E F G))
+ERROR
+
+(CADR '(A B C D E F G))
+B
+
+(CDAR '(A B C D E F G))
+ERROR
+
+(CDDR '(A B C D E F G))
+(C D E F G)
+
+(CAAAR '(A B C D E F G))
+ERROR
+
+(CAADR '(A B C D E F G))
+ERROR
+
+(CADAR '(A B C D E F G))
+ERROR
+
+(CADDR '(A B C D E F G))
+C
+
+(CDAAR '(A B C D E F G))
+ERROR
+
+(CDADR '(A B C D E F G))
+ERROR
+
+(CDDAR '(A B C D E F G))
+ERROR
+
+(CDDDR '(A B C D E F G))
+(D E F G)
+
+(CAAAAR '(A B C D E F G))
+ERROR
+
+(CAAADR '(A B C D E F G))
+ERROR
+
+(CAADAR '(A B C D E F G))
+ERROR
+
+(CAADDR '(A B C D E F G))
+ERROR
+
+(CADAAR '(A B C D E F G))
+ERROR
+
+(CADADR '(A B C D E F G))
+ERROR
+
+(CADDAR '(A B C D E F G))
+ERROR
+
+(CADDDR '(A B C D E F G))
+D
+
+(CDAAAR '(A B C D E F G))
+ERROR
+
+(CDAADR '(A B C D E F G))
+ERROR
+
+(CDADAR '(A B C D E F G))
+ERROR
+
+(CDADDR '(A B C D E F G))
+ERROR
+
+(CDDAAR '(A B C D E F G))
+ERROR
+
+(CDDADR '(A B C D E F G))
+ERROR
+
+(CDDDAR '(A B C D E F G))
+ERROR
+
+(CDDDDR '(A B C D E F G))
+(E F G)
+
+(CAR '(A))
+A
+
+(CDR '(A))
+NIL
+
+(CAAR '(A))
+ERROR
+
+(CADR '(A))
+NIL
+
+(CDAR '(A))
+ERROR
+
+(CDDR '(A))
+NIL
+
+(CAAAR '(A))
+ERROR
+
+(CAADR '(A))
+NIL
+
+(CADAR '(A))
+ERROR
+
+(CADDR '(A))
+NIL
+
+(CDAAR '(A))
+ERROR
+
+(CDADR '(A))
+NIL
+
+(CDDAR '(A))
+ERROR
+
+(CDDDR '(A))
+NIL
+
+(CAAAAR '(A))
+ERROR
+
+(CAAADR '(A))
+NIL
+
+(CAADAR '(A))
+ERROR
+
+(CAADDR '(A))
+NIL
+
+(CADAAR '(A))
+ERROR
+
+(CADADR '(A))
+NIL
+
+(CADDAR '(A))
+ERROR
+
+(CADDDR '(A))
+NIL
+
+(CDAAAR '(A))
+ERROR
+
+(CDAADR '(A))
+NIL
+
+(CDADAR '(A))
+ERROR
+
+(CDADDR '(A))
+NIL
+
+(CDDAAR '(A))
+ERROR
+
+(CDDADR '(A))
+NIL
+
+(CDDDAR '(A))
+ERROR
+
+(CDDDDR '(A))
+NIL
+
+(CONS 1 2)
+(1 . 2)
+
+(CONS 'A 'B)
+(A . B)
+
+(CONS 'A 'B 'C)
+ERROR
+
+(CONS 'A)
+ERROR
+
+(CONS)
+ERROR
+
+(CONS 'A 'NIL)
+(A)
+
+(CONS 'NIL 'A)
+(NIL . A)
+
+(CONS 'A (CONS 'B (CONS 'C 'NIL)))
+(A B C)
+
+(CONS 'A '(B C D))
+(A B C D)
+
+(TREE-EQUAL 1 1)
+T
+
+(TREE-EQUAL 'WORD 'WORD)
+T
+
+(TREE-EQUAL 'WORD1 'WORD2)
+NIL
+
+(TREE-EQUAL '(A B) '(A B))
+T
+
+(TREE-EQUAL '(A (B C)) '((A B) C))
+NIL
+
+(TREE-EQUAL 5 (+ 2 3))
+T
+
+(TREE-EQUAL '(A (B QUOTE NIL)) '(A (B)))
+NIL
+
+(TREE-EQUAL '(A (B . 1.0)) '(A (B #C(1.0 0.0))))
+NIL
+
+(TREE-EQUAL 1 1 :TEST #'EQ)
+T
+
+(TREE-EQUAL 'WORD 'WORD :TEST #'EQ)
+T
+
+(TREE-EQUAL 'WORD1 'WORD2 :TEST #'EQ)
+NIL
+
+(TREE-EQUAL '(A B) '(A B) :TEST #'EQ)
+T
+
+(TREE-EQUAL '(A (B C)) '((A B) C) :TEST #'EQ)
+NIL
+
+(TREE-EQUAL 5 (+ 2 3) :TEST #'EQ)
+T
+
+(TREE-EQUAL '(A (B)) '(A (B)) :TEST #'EQ)
+T
+
+(TREE-EQUAL '(A (B . 1.0)) '(A (B #C(1.0 0.0))) :TEST #'EQ)
+NIL
+
+(TREE-EQUAL 1 1 :TEST #'EQL)
+T
+
+(TREE-EQUAL 'WORD 'WORD :TEST #'EQL)
+T
+
+(TREE-EQUAL 'WORD1 'WORD2 :TEST #'EQL)
+NIL
+
+(TREE-EQUAL '(A B) '(A B) :TEST #'EQL)
+T
+
+(TREE-EQUAL '(A (B C)) '((A B) C) :TEST #'EQL)
+NIL
+
+(TREE-EQUAL 5 (+ 2 3) :TEST #'EQL)
+T
+
+(TREE-EQUAL '(A (B)) '(A (B)) :TEST #'EQL)
+T
+
+(TREE-EQUAL '(A (B . 1.0)) '(A (B #C(1.0 0.0))) :TEST #'EQL)
+NIL
+
+(TREE-EQUAL 1 1 :TEST #'EQUAL)
+T
+
+(TREE-EQUAL 'WORD 'WORD :TEST #'EQUAL)
+T
+
+(TREE-EQUAL 'WORD1 'WORD2 :TEST #'EQUAL)
+NIL
+
+(TREE-EQUAL '(A B) '(A B) :TEST #'EQUAL)
+T
+
+(TREE-EQUAL '(A (B C)) '((A B) C) :TEST #'EQUAL)
+NIL
+
+(TREE-EQUAL 5 (+ 2 3) :TEST #'EQUAL)
+T
+
+(TREE-EQUAL '(A (B)) '(A (B)) :TEST #'EQUAL)
+T
+
+(TREE-EQUAL '(A (B . 1.0)) '(A (B #C(1.0 0.0))) :TEST #'EQUAL)
+NIL
+
+(TREE-EQUAL 1 1 :TEST-NOT #'EQ)
+NIL
+
+(TREE-EQUAL 'WORD 'WORD :TEST-NOT #'EQ)
+NIL
+
+(TREE-EQUAL 'WORD1 'WORD2 :TEST-NOT #'EQ)
+T
+
+(TREE-EQUAL '(A B) '(A B) :TEST-NOT #'EQ)
+NIL
+
+(TREE-EQUAL '(A (B C)) '((A B) C) :TEST-NOT #'EQ)
+NIL
+
+(TREE-EQUAL 5 (+ 2 3) :TEST-NOT #'EQ)
+NIL
+
+(TREE-EQUAL '(A (B)) '(A (B)) :TEST-NOT #'EQ)
+NIL
+
+(TREE-EQUAL '(A (B . 1.0)) '(A (B #C(1.0 0.0))) :TEST-NOT #'EQ)
+NIL
+
diff --git a/src/tests/lists152.tst b/src/tests/lists152.tst
new file mode 100644
index 000000000..4580e49e7
--- /dev/null
+++ b/src/tests/lists152.tst
@@ -0,0 +1,813 @@
+
+(ENDP 'NIL)
+T
+
+(ENDP '(A . B))
+NIL
+
+(ENDP '(A B . C))
+NIL
+
+(ENDP '(A B C))
+NIL
+
+(ENDP '(A B C D))
+NIL
+
+(ENDP '(A B C . D))
+NIL
+
+(ENDP '('NIL 'NIL))
+NIL
+
+(LIST-LENGTH 'NIL)
+0
+
+(LIST-LENGTH '(A . B))
+#+XCL 1 #+(or CLISP ECLS AKCL ALLEGRO) ERROR #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(LIST-LENGTH '(A B C D))
+4
+
+(LIST-LENGTH '(A (B C)
+                 D))
+3
+
+(LET ((X (LIST 'A 'B 'C)))
+     (RPLACD (LAST X)
+            X)
+     (LIST-LENGTH X))
+NIL
+
+(NTH 0
+     '(A B C D))
+A
+
+(NTH 1
+     '(A B C D))
+B
+
+(NTH 3
+     '(A B C D))
+D
+
+(NTH 5
+     '(A B C D))
+NIL
+
+(NTH -2
+     '(A B C D))
+ERROR
+
+(NTH 0 'NIL)
+NIL
+
+(NTH 2 'NIL)
+NIL
+
+(FIRST '(1 2 3 4 5 6 7 8 9 10 11))
+1
+
+(SECOND '(1 2 3 4 5 6 7 8 9 10 11))
+2
+
+(THIRD '(1 2 3 4 5 6 7 8 9 10 11))
+3
+
+(FOURTH '(1 2 3 4 5 6 7 8 9 10 11))
+4
+
+(FIFTH '(1 2 3 4 5 6 7 8 9 10 11))
+5
+
+(SIXTH '(1 2 3 4 5 6 7 8 9 10 11))
+6
+
+(SEVENTH '(1 2 3 4 5 6 7 8 9 10 11))
+7
+
+(EIGHTH '(1 2 3 4 5 6 7 8 9 10 11))
+8
+
+(NINTH '(1 2 3 4 5 6 7 8 9 10 11))
+9
+
+(TENTH '(1 2 3 4 5 6 7 8 9 10 11))
+10
+
+(FIRST '(1 2 3))
+1
+
+(SECOND '(1 2 3))
+2
+
+(THIRD '(1 2 3))
+3
+
+(FOURTH '(1 2 3))
+NIL
+
+(FIFTH '(1 2 3))
+NIL
+
+(SIXTH '(1 2 3))
+NIL
+
+(SEVENTH '(1 2 3))
+NIL
+
+(EIGHTH '(1 2 3))
+NIL
+
+(NINTH '(1 2 3))
+NIL
+
+(TENTH '(1 2 3))
+NIL
+
+(FIRST 'NIL)
+NIL
+
+(SECOND 'NIL)
+NIL
+
+(THIRD 'NIL)
+NIL
+
+(FOURTH 'NIL)
+NIL
+
+(FIFTH 'NIL)
+NIL
+
+(SIXTH 'NIL)
+NIL
+
+(SEVENTH 'NIL)
+NIL
+
+(EIGHTH 'NIL)
+NIL
+
+(NINTH 'NIL)
+NIL
+
+(TENTH 'NIL)
+NIL
+
+(REST '(1 2 3 4 5))
+(2 3 4 5)
+
+(REST 'NIL)
+NIL
+
+(REST '(A . B))
+B
+
+(REST '(1 2 3 . 4))
+(2 3 . 4)
+
+(NTHCDR 0
+       '(A B C D))
+(A B C D)
+
+(NTHCDR 1
+       '(A B C D))
+(B C D)
+
+(NTHCDR 3
+       '(A B C D))
+(D)
+
+(NTHCDR 5
+       '(A B C D))
+NIL
+
+(NTHCDR -2
+       '(A B C D))
+ERROR
+
+(NTHCDR 0 'NIL)
+NIL
+
+(NTHCDR 2 'NIL)
+NIL
+
+(LAST '(1 2 3 4 5))
+(5)
+
+(LAST 'NIL)
+NIL
+
+(LAST '(A . B))
+(A . B)
+
+(LAST '(1 2 3 . 4))
+(3 . 4)
+
+(LIST 'A 'B 'C 'D)
+(A B C D)
+
+(LIST 'A)
+(A)
+
+(LIST '(A B)
+      '(C D))
+((A B)
+ (C D))
+
+(LIST 'A 'NIL)
+(A NIL)
+
+(LIST 'NIL 'A)
+(NIL A)
+
+(LIST 'NIL 'NIL)
+(NIL NIL)
+
+(LIST)
+NIL
+
+(LIST 3 4 'A
+      (CAR '(B . C))
+      (+ 6 -2))
+(3 4 A B 4)
+
+(LIST* 'A 'B 'C 'D)
+(A B C . D)
+
+(LIST* 'A)
+A
+
+(LIST* '(A B)
+       '(C D))
+((A B)
+ C D)
+
+(LIST* 'A 'NIL)
+(A)
+
+(LIST* 'NIL 'A)
+(NIL . A)
+
+(LIST* 'NIL 'NIL)
+(NIL)
+
+(LIST*)
+ERROR
+
+(LIST* 3 4 'A
+       (CAR '(B . C))
+       (+ 6 -2))
+(3 4 A B . 4)
+
+(LIST* 'A 'B 'C
+       '(D E F))
+(A B C D E F)
+
+(LIST* X)
+ERROR
+
+(LIST* 'NIL)
+NIL
+
+(MAKE-LIST 5)
+(NIL NIL NIL NIL NIL)
+
+(MAKE-LIST 5 :INITIAL-ELEMENT)
+ERROR
+
+(MAKE-LIST 3 :INITIAL-ELEMENT 'RAH)
+(RAH RAH RAH)
+
+(MAKE-LIST 0)
+NIL
+
+(MAKE-LIST 0 :INITIAL-ELEMENT 'AAA)
+NIL
+
+(MAKE-LIST 5 :INITIAL-ELEMENT 'NIL)
+(NIL NIL NIL NIL NIL)
+
+(MAKE-LIST)
+ERROR
+
+(APPEND '(A B C)
+       '(D E F)
+       'NIL
+       '(G))
+(A B C D E F G)
+
+(APPEND '(A B C)
+       'D)
+(A B C . D)
+
+(APPEND 'A 'B)
+ERROR
+
+(APPEND 'A 'NIL)
+ERROR
+
+(APPEND 'NIL 'NIL)
+NIL
+
+(APPEND 'NIL 'A)
+#+XCL ERROR
+#-XCL A
+
+(APPEND 'NIL
+       '(A B C))
+(A B C)
+
+(SETQ X
+      '(A B C))
+(A B C)
+
+(SETQ Y
+      '(D E F))
+(D E F)
+
+(SETQ R
+      (APPEND X Y))
+(A B C D E F)
+
+X
+(A B C)
+
+Y
+(D E F)
+
+(EQ (CDDDR R)
+    Y)
+T
+
+(COPY-LIST '(1 2 3 4 5))
+(1 2 3 4 5)
+
+(COPY-LIST 'NIL)
+NIL
+
+(COPY-LIST '(A . B))
+(A . B)
+
+(COPY-LIST '(1 2 3 . 4))
+(1 2 3 . 4)
+
+(SETQ L
+      '(1 2 3 4 5))
+(1 2 3 4 5)
+
+(EQ L
+    (COPY-LIST L))
+NIL
+
+(EQL L
+     (COPY-LIST L))
+NIL
+
+(EQUAL L
+       (COPY-LIST L))
+T
+
+(EQUALP L
+       (COPY-LIST L))
+T
+
+(COPY-ALIST 'A)
+#+(or XCL ECLS AKCL ALLEGRO) ERROR #+CLISP A #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(COPY-ALIST 'NIL)
+NIL
+
+(COPY-ALIST 5)
+#+(or XCL ECLS AKCL ALLEGRO) ERROR #+CLISP 5 #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(COPY-ALIST '(A B))
+#+(or XCL ECLS CLISP ALLEGRO) (A B) #+GCL ERROR #-(or XCL CLISP GCL ECLS ALLEGRO) UNKNOWN
+
+(COPY-ALIST '((1 . A)
+              (2 . B)
+              (3 . C)))
+((1 . A)
+ (2 . B)
+ (3 . C))
+
+(SETQ X
+      '((1 . A)
+        (2 . B)
+        (3 . C)))
+((1 . A)
+ (2 . B)
+ (3 . C))
+
+(EQ X
+    (COPY-ALIST X))
+NIL
+
+(EQL X
+     (COPY-ALIST X))
+NIL
+
+(EQUAL X
+       (COPY-ALIST X))
+T
+
+(EQ (CADR X)
+    (CADR (COPY-ALIST X)))
+NIL
+
+(EQL (CADR X)
+     (CADR (COPY-ALIST X)))
+NIL
+
+(EQUAL (CADR X)
+       (CADR (COPY-ALIST X)))
+T
+
+(COPY-ALIST '((1 . 2))
+       '((A . B)))
+ERROR
+
+(COPY-ALIST '((A B)
+              C
+              (D E)))
+#+(or XCL ECLS CLISP ALLEGRO) ((A B) C (D E)) #+GCL ERROR #-(or XCL CLISP GCL ECLS ALLEGRO) UNKNOWN
+
+(COPY-TREE 'X)
+X
+
+(COPY-TREE 5)
+5
+
+(COPY-TREE '(A B))
+(A B)
+
+(COPY-TREE '(A B
+               (C (D)
+                  (E F))
+               G))
+(A B
+   (C (D)
+      (E F))
+   G)
+
+(COPY-TREE '((1 . E)
+             (2 . F)))
+((1 . E)
+ (2 . F))
+
+(COPY-TREE #*001)
+#*001
+
+(SETQ X
+      '(A B
+          (C D)
+          E))
+(A B
+   (C D)
+   E)
+
+(EQ X
+    (COPY-TREE X))
+NIL
+
+(EQL X
+     (COPY-TREE X))
+NIL
+
+(EQUAL X
+       (COPY-TREE X))
+T
+
+(EQ (CDADDR X)
+    (CDADDR (COPY-TREE X)))
+NIL
+
+(EQL (CDADDR X)
+     (CDADDR (COPY-TREE X)))
+NIL
+
+(EQUAL (CDADDR X)
+       (CDADDR (COPY-TREE X)))
+T
+
+(REVAPPEND '(A B C)
+       '(D E F)
+       'NIL
+       '(G))
+ERROR
+
+(REVAPPEND '(A B C)
+       'D)
+(C B A . D)
+
+(REVAPPEND 'A 'B)
+#+(or XCL ECLS AKCL ALLEGRO) ERROR #+CLISP B #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(REVAPPEND 'A 'NIL)
+#+(or XCL ECLS AKCL ALLEGRO) ERROR #+CLISP NIL #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(REVAPPEND 'NIL 'NIL)
+NIL
+
+(REVAPPEND 'NIL 'A)
+A
+
+(REVAPPEND 'NIL
+       '(A B C))
+(A B C)
+
+(REVAPPEND '(A B C)
+       '(D E F))
+(C B A D E F)
+
+(REVAPPEND '(D E F)
+       '(A B C))
+(F E D A B C)
+
+(EQL (REVAPPEND '(A B C)
+            '(D E F))
+     (APPEND (REVERSE '(A B C))
+            '(D E F)))
+NIL
+
+(EQUAL (REVAPPEND '(A B C)
+              '(D E F))
+       (APPEND (REVERSE '(A B C))
+              '(D E F)))
+T
+
+(SETQ X
+      '(A B C))
+(A B C)
+
+(SETQ Y
+      '(D E F))
+(D E F)
+
+(SETQ R
+      (REVAPPEND X Y))
+(C B A D E F)
+
+X
+(A B C)
+
+Y
+(D E F)
+
+(EQ (CDDDR R)
+    Y)
+T
+
+(SETQ X
+      '(A B C)
+      Y
+      '(D E F))
+(D E F)
+
+(NCONC X Y)
+(A B C D E F)
+
+X
+(A B C D E F)
+
+(EQ (CDDDR X)
+    Y)
+T
+
+(SETQ X
+      '(A B C)
+      Y
+      '(D E F)
+      Z
+      '(G H I))
+(G H I)
+
+(NCONC)
+NIL
+
+(NCONC X)
+(A B C)
+
+(NCONC NIL)
+NIL
+
+(NCONC NIL NIL)
+NIL
+
+(NCONC X NIL)
+(A B C)
+
+(NCONC NIL NIL NIL NIL)
+NIL
+
+(NCONC NIL NIL X NIL)
+(A B C)
+
+(NCONC X NIL Y NIL Z NIL)
+(A B C D E F G H I)
+
+X
+(A B C D E F G H I)
+
+Y
+(D E F G H I)
+
+Z
+(G H I)
+
+(EQ (CDDDR X)
+    Y)
+T
+
+(EQ (CDDDR Y)
+    Z)
+T
+
+(NCONC '(1 2)
+       'A)
+#+XCL ERROR #+(or CLISP ECLS AKCL ALLEGRO) (1 2 . A) #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(NCONC 'A)
+#+XCL ERROR #+(or CLISP ECLS AKCL ALLEGRO) A #-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(SETQ X
+      '(A B C)
+      Y
+      '(D E F))
+(D E F)
+
+(NRECONC X Y)
+(C B A D E F)
+
+X
+#+XCL WAS-DESTROYED ; wo kommt denn so was her?
+#+(or CLISP ECLS AKCL ALLEGRO) (A D E F)
+#-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(TAILP Y X)
+T
+
+(SETQ X
+      '(A B C)
+      Y
+      '(D E F)
+      Z
+      '(G H I))
+(G H I)
+
+(NRECONC)
+ERROR
+
+(NRECONC X)
+ERROR
+
+(NRECONC NIL)
+ERROR
+
+(NRECONC NIL NIL)
+NIL
+
+(NRECONC X NIL)
+(C B A)
+
+X
+#+XCL WAS-DESTROYED
+#+(or CLISP ECLS AKCL ALLEGRO) (A)
+#-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(NRECONC NIL NIL NIL NIL)
+ERROR
+
+(NCONC NIL 'X)
+#+XCL ERROR
+#+(or CLISP ECLS AKCL ALLEGRO) X
+#-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(SETQ AA NIL)
+NIL
+
+(PUSH '1 AA)
+(1)
+
+(PUSH '2 AA)
+(2 1)
+
+(PUSH '2 AA)
+(2 2 1)
+
+(SETQ AA
+      '(B A))
+(B A)
+
+(PUSHNEW 'A AA)
+(B A)
+
+(PUSHNEW 'C AA)
+(C B A)
+
+(SETQ XXX NIL)
+NIL
+
+(PUSHNEW 'C XXX :TEST 'EQUAL)
+(C)
+
+(PUSHNEW 'C XXX :TEST 'EQUAL)
+(C)
+
+(PUSHNEW '(C) XXX :TEST 'EQUAL)
+((C) C)
+
+XXX
+((C) C)
+
+(SETQ XX '(NIL KKK))
+(NIL KKK)
+
+(PUSHNEW 'U (CAR XX))
+(U)
+
+(PUSHNEW 'U
+       (CAR XX))
+(U)
+
+(PUSHNEW 'V
+       (CAR XX))
+(V U)
+
+XX
+((V U) KKK)
+
+(PUSHNEW '(W)
+       (CAR XX))
+((W)
+ V U)
+
+(PUSHNEW '(W)
+       (CAR XX))
+((W)
+ (W)
+ V U)
+
+(PUSHNEW '(W)
+       (CAR XX)
+       :TEST 'EQUAL)
+((W)
+ (W)
+ V U)
+
+(PUSHNEW '(W)
+       (CAR XX)
+       :TEST-NOT 'EQUAL)
+((W)
+ (W)
+ V U)
+
+(SETQ AA '(1 2 3))
+(1 2 3)
+
+(POP AA)
+1
+
+AA
+(2 3)
+
+(POP AA)
+2
+
+(POP AA)
+3
+
+(POP AA)
+NIL
+
+(POP AA)
+NIL
+
+(BUTLAST '(A B C))
+(A B)
+
+(BUTLAST '(A B C)
+       2)
+(A)
+
+(NBUTLAST '(A B C D)
+       3)
+(A)
+
+(NBUTLAST '(A B C D)
+       1)
+(A B C)
+
+(NBUTLAST '(A B C D)
+       0)
+(A B C D)
+
+(NBUTLAST '(A B C D)
+       4)
+NIL
+
+(NBUTLAST '(A B C D)
+       6)
+NIL
+
diff --git a/src/tests/lists153.tst b/src/tests/lists153.tst
new file mode 100644
index 000000000..b47d4d568
--- /dev/null
+++ b/src/tests/lists153.tst
@@ -0,0 +1,3 @@
+;RPLACA
+;RPLACD
+
diff --git a/src/tests/lists154.tst b/src/tests/lists154.tst
new file mode 100644
index 000000000..f5abe03ea
--- /dev/null
+++ b/src/tests/lists154.tst
@@ -0,0 +1,255 @@
+
+(SUBST 'A 'B
+       '(U B
+           (B)
+           C))
+(U A
+   (A)
+   C)
+
+(SUBST 'A 'B
+       '(U B
+           (B)
+           C)
+       :TEST-NOT
+       #'(LAMBDA (X Y)
+                (IF (ATOM Y)
+                    (EQL X Y)
+                    T)))
+(A B
+   (B . A)
+   A . A)
+
+(SUBST 'A 'B
+       '(U B
+           (B)
+           C)
+       :TEST
+       #'(LAMBDA (X Y)
+                (NOT (EQL X Y))))
+A
+
+(SUBST 'A 'B
+       '(U B
+           (B)
+           C)
+       :TEST-NOT
+       #'(LAMBDA (X Y)
+                (NOT (EQL X Y))))
+(U A
+   (A)
+   C)
+
+(SUBST 'A 'B
+       '(U B
+           (B)
+           C)
+       :TEST-NOT
+       #'(LAMBDA (X Y)
+                (NOT (EQL X Y)))
+       :KEY
+       #'(LAMBDA (U)
+                (IF (LISTP U)
+                    (CAR U))))
+(U . A)
+
+(SUBST-IF 'NUMMMER 'NUMBERP
+       '((A (7 (V 6)))))
+((A (NUMMMER (V NUMMMER))))
+
+(SUBST-IF-NOT 'NUMMMER 'NUMBERP
+       '((A (7 (V 6)))))
+NUMMMER
+
+(SUBST-IF-NOT 'NUMMMER
+       #'(LAMBDA (X)
+                (AND (LISTP X)
+                     (NUMBERP X)))
+       '((A (7 (V 6)))))
+NUMMMER
+
+(SUBST-IF-NOT 'NUMMMER
+       #'(LAMBDA (X)
+                (OR (LISTP X)
+                    (NUMBERP X)))
+       '((A (7 (V 6)))))
+((NUMMMER (7 (NUMMMER 6))))
+
+(NSUBST 'A 'B
+       '(U B
+           (B)
+           C)
+       :TEST-NOT
+       #'(LAMBDA (X Y)
+                (IF (ATOM Y)
+                    (EQL X Y)
+                    T)))
+(A B
+   (B . A)
+   A . A)
+
+(NSUBST 'A 'B
+       '(U B
+           (B)
+           C)
+       :TEST-NOT
+       #'(LAMBDA (X Y)
+                (NOT (EQL X Y))))
+(U A
+   (A)
+   C)
+
+(NSUBST 'A 'B
+       '(U B
+           (B)
+           C)
+       :TEST
+       #'(LAMBDA (X Y)
+                (NOT (EQL X Y))))
+A
+
+(NSUBST-IF 'OO 'NUMBERP
+       '(A B C
+           (3 (4)
+              0)))
+(A B C
+   (OO (OO)
+       OO))
+
+(NSUBST-IF-NOT 'OO 'NUMBERP
+       '(A B C
+           (3 (4)
+              0)))
+OO
+
+(NSUBST-IF-NOT 'OO
+       #'(LAMBDA (X)
+                (OR (ATOM X)
+                    (NUMBERP X)))
+       '(A B C
+           (3 (4)
+              0)))
+OO
+
+(NSUBST-IF-NOT 'OO
+       #'(LAMBDA (X)
+                (AND (ATOM X)
+                     (NUMBERP X)))
+       '(A B C
+           (3 (4)
+              0)))
+OO
+
+(NSUBST-IF-NOT 'OO
+       #'(LAMBDA (X)
+                (OR (LIST X)
+                    (NUMBERP X)))
+       '(A B C
+           (3 (4)
+              0)))
+(A B C
+   (3 (4)
+      0))
+
+(NSUBST-IF-NOT 'OO
+       #'(LAMBDA (X)
+                (OR (LIST X)
+                    (SYMBOLP X)))
+       '(A B C
+           (3 (4)
+              0)))
+(A B C
+   (3 (4)
+      0))
+
+(SUBLIS '((A . A1)
+          (B . B1))
+       '(A B))
+(A1 B1)
+
+(SUBLIS '((A . A1)
+          (B . B1))
+       '(A B
+           (B . C)))
+(A1 B1
+    (B1 . C))
+
+(SUBLIS '((A . A1)
+          (B . B1)
+          (NIL . NIL1))
+       '(A B
+           (B . C)))
+(A1 B1
+    (B1 . C) .
+    NIL1)
+
+(SUBLIS '((A . A1)
+          (B . B1)
+          (NIL . NIL1))
+       '(A B
+           (B C)))
+(A1 B1
+    (B1 C . NIL1) .
+    NIL1)
+
+(SUBLIS '((A . A1)
+          (B . B1)
+          (NIL . NIL1))
+       '(A B
+           (B C))
+       :TEST-NOT 'EQL)
+A1
+
+(SUBLIS '((A . A1)
+          (B . B1)
+          (NIL . NIL1))
+       '(A B
+           (B C))
+       :TEST-NOT
+       #'(LAMBDA (X Y)
+                (IF (ATOM Y)
+                    (EQL X Y))))
+A1
+
+(SUBLIS '(((A) .
+           UU)
+          (A . II))
+       '(I (A)
+           A))
+(I (II)
+   II)
+
+(SUBLIS '(((A) . UU) (A . II))
+       '(I (A) A)
+       :KEY #'(LAMBDA (X) (IF (LISTP X) (CAR X))))
+(I II . II) ; KEY wird angewandt auf: X ein Blatt des Baumes
+
+(SUBLIS '(((A) . UU) (A . II))
+       '(I (A) A)
+       :TEST #'(LAMBDA (X Y) (IF (LISTP Y) (EQL X (CAR Y)))))
+#+(or XCL ECLS AKCL LUCID ALLEGRO) (I II . II) ; X aus der Aliste, Y ein Blatt des Baumes
+#+(or CLISP CMU)              (I (UU) UU) ; X ein Blatt, Y aus der Aliste
+#-(or XCL CLISP ECLS AKCL CMU LUCID ALLEGRO) UNKNOWN
+
+(NSUBLIS '(((A) . UU) (A . II))
+       '(I (A) A)
+       :KEY #'(LAMBDA (X) (IF (LISTP X) (CAR X))))
+(I II . II) ; KEY wird angewandt auf: X ein Blatt des Baumes
+
+(NSUBLIS '(((A) . UU) (A . II))
+       '(I (A) A)
+       :TEST #'(LAMBDA (X Y) (IF (LISTP X) (EQUAL X Y))))
+(I UU . UU)
+
+(NSUBLIS '(((A) . UU) (A . II))
+       '(I (A) A)
+       :TEST #'(LAMBDA (X Y) (IF (LISTP Y) (EQUAL X Y))))
+(I UU . UU)
+
+(NSUBLIS '(((A) . UU) (A . II))
+       '(I (A) A)
+       :TEST #'(LAMBDA (X Y) (IF (LISTP Y) (EQL X (CAR Y)))))
+#+(or XCL ECLS AKCL ALLEGRO) (I II . II) ; X aus der Aliste, Y ein Blatt des Baumes
+#+(or CLISP CMU LUCID)  (I (UU) UU) ; X ein Blatt, Y aus der Aliste
+#-(or XCL CLISP ECLS AKCL CMU LUCID ALLEGRO) UNKNOWN
+
diff --git a/src/tests/lists155.tst b/src/tests/lists155.tst
new file mode 100644
index 000000000..ff6bda107
--- /dev/null
+++ b/src/tests/lists155.tst
@@ -0,0 +1,173 @@
+
+(MEMBER 'A
+       '((A)
+         (B)
+         (A)
+         (C)))
+NIL
+
+(MEMBER 'A
+       '((A)
+         (B)
+         (A)
+         (C))
+       :KEY 'CAR)
+((A)
+ (B)
+ (A)
+ (C))
+
+(MEMBER-IF 'NUMBERP
+       '((A)
+         (B)
+         (3)
+         (C))
+       :KEY 'CAR)
+((3)
+ (C))
+
+(MEMBER-IF-NOT 'NUMBERP
+       '((8)
+         (A)
+         (B)
+         (3)
+         (C))
+       :KEY 'CAR)
+((A)
+ (B)
+ (3)
+ (C))
+
+(TAILP '(A B)
+       '(U A B))
+NIL
+
+(TAILP (CDDR (SETQ XX
+                   '(U I A B)))
+       XX)
+T
+
+(TAILP (CDDR (SETQ XX
+                   '(U I A B)))
+       XX)
+T
+
+(ADJOIN 'A
+       '(A B C))
+(A B C)
+
+(ADJOIN 'A
+       '((A)
+         B C)
+       :TEST 'EQUAL)
+(A (A)
+   B C)
+
+(ADJOIN 'A
+       '((A)
+         B C)
+       :TEST 'EQUAL)
+(A (A)
+   B C)
+
+(UNION '(A B C D)
+       '(A D I V))
+#+XCL (V I A B C D)
+#+(or CLISP AKCL ECLS) (B C A D I V)
+#+ALLEGRO (C B A D I V)
+#-(or XCL CLISP AKCL ECLS ALLEGRO) UNKNOWN
+
+(NUNION '(A B C D)
+       '(U I B A))
+#+XCL (A B C D U I)
+#+(or CLISP AKCL ECLS) (C D U I B A)
+#+ALLEGRO (D C U I B A)
+#-(or XCL CLISP AKCL ECLS ALLEGRO) UNKNOWN
+
+(NINTERSECTION '(A B C D)
+       '(C D E F G))
+#+(or XCL CLISP ECLS GCL) (C D)
+#+ALLEGRO (D C)
+#-(or XCL CLISP ECLS GCL ALLEGRO) UNKNOWN
+
+(NINTERSECTION '(A B C D)
+       '(C D E F G)
+       :TEST-NOT 'EQL)
+#+(or XCL CLISP ECLS GCL) (A B C D)
+#+ALLEGRO (D C B A)
+#-(or XCL CLISP ECLS GCL ALLEGRO) UNKNOWN
+
+(SET-DIFFERENCE '(A B C D E)
+       '(D B E))
+#+(or XCL ALLEGRO GCL) (C A)
+#+(or CLISP ECLS (and AKCL (not GCL))) (A C)
+#-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(SET-DIFFERENCE '(AUTO ANTON BERTA BERLIN)
+       '(A)
+       :TEST
+       #'(LAMBDA (X Y)
+                (EQL (ELT (SYMBOL-NAME X)
+                          1)
+                     (ELT (SYMBOL-NAME Y)
+                          1))))
+#+(or XCL ALLEGRO) (BERLIN BERTA ANTON AUTO)
+#-(or XCL ALLEGRO) ERROR
+
+(SET-DIFFERENCE '(ANTON BERTA AUTO BERLIN)
+       '(AMERILLA)
+       :TEST
+       #'(LAMBDA (X Y)
+                (EQL (ELT (SYMBOL-NAME X)
+                          0)
+                     (ELT (SYMBOL-NAME Y)
+                          0))))
+#+(or XCL GCL ALLEGRO) (BERLIN BERTA)
+#+(or CLISP ECLS (and AKCL (not GCL))) (BERTA BERLIN)
+#-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(NSET-DIFFERENCE '(A B C D)
+       '(I J C))
+#+(or XCL ECLS CLISP GCL) (A B D)
+#+ALLEGRO (D B A)
+#-(or XCL ECLS CLISP GCL ALLEGRO) UNKNOWN
+
+(SET-EXCLUSIVE-OR '(A B C D)
+       '(C A I L))
+#+(or XCL GCL) (D B L I)
+#+(or CLISP ECLS (and AKCL (not GCL))) (B D I L)
+#+ALLEGRO (L I D B)
+#-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(SET-EXCLUSIVE-OR '(ANTON ANNA EMIL)
+       '(BERTA AUTO AUGUST)
+       :TEST
+       #'(LAMBDA (X Y)
+                (EQL (ELT (SYMBOL-NAME X)
+                          0)
+                     (ELT (SYMBOL-NAME Y)
+                          0))))
+#+(or XCL ECLS CLISP GCL) (EMIL BERTA)
+#+ALLEGRO (BERTA EMIL)
+#-(or XCL ECLS CLISP GCL ALLEGRO) UNKNOWN
+
+(NSET-EXCLUSIVE-OR '(A B C)
+       '(I A D C))
+(B I D)
+
+(SUBSETP '(A B)
+       '(B U I A C D))
+T
+
+(SUBSETP '(A B)
+       '(B U I C D))
+NIL
+
+(SUBSETP '(A B)
+       '(B A U I C D))
+T
+
+(SUBSETP '(A B)
+       '(A U I C D))
+NIL
+
diff --git a/src/tests/lists156.tst b/src/tests/lists156.tst
new file mode 100644
index 000000000..d0cc1c4d0
--- /dev/null
+++ b/src/tests/lists156.tst
@@ -0,0 +1,157 @@
+
+(ACONS 'A 'B NIL)
+((A . B))
+
+(ACONS 'A 'B
+       '((C . D)))
+((A . B)
+ (C . D))
+
+(PAIRLIS '(A B C)
+       '(1 2))
+#+XCL
+((B . 2)
+ (A . 1))
+#-XCL
+ERROR
+
+(PAIRLIS '(A B C)
+       '(1 2 3))
+#+(or ECLS XCL CLISP ALLEGRO)
+((C . 3)
+ (B . 2)
+ (A . 1))
+#+(or AKCL) ((A . 1) (B . 2) (C . 3))
+#-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(ASSOC 'A
+       '((B C)
+         (A U)
+         (A I)))
+(A U)
+
+(ASSOC 'A
+       '((B C)
+         ((A)
+          U)
+         (A I)))
+(A I)
+
+(ASSOC 'A
+       '((B C)
+         ((A)
+          U)
+         (A I))
+       :KEY
+       #'(LAMBDA (X)
+                (IF (LISTP X)
+                    (CAR X))))
+((A)
+ U)
+
+(ASSOC 'A
+       '((B C)
+         A
+         ((A)
+          U)
+         (A I))
+       :KEY
+       #'(LAMBDA (X)
+                (IF (LISTP X)
+                    (CAR X))))
+#-(or GCL ECLS ALLEGRO) ((A) U)
+#+(or GCL ECLS ALLEGRO) ERROR
+
+(ASSOC 'A
+       '((B C)
+         A
+         ((A)
+          U)
+         (A I))
+       :KEY
+       #'(LAMBDA (X)
+                (IF (ATOM X)
+                    X)))
+#-(or GCL ECLS ALLEGRO) (A I)
+#+(or GCL ECLS ALLEGRO) ERROR
+
+(ASSOC 'A
+       '((B C)
+         A
+         ((A)
+          U)
+         (A I))
+       :TEST
+       #'(LAMBDA (X Y)
+                (IF (LISTP Y)
+                    (EQL (CAR Y)
+                         X))))
+#-(or GCL ECLS ALLEGRO) ((A) U)
+#+(or GCL ECLS ALLEGRO) ERROR
+
+(ASSOC 'A
+       '((B C)
+         A
+         ((A)
+          U)
+         (A I))
+       :TEST
+       #'(LAMBDA (X Y)
+                (IF (ATOM Y)
+                    (EQL Y X))))
+#-(or GCL ECLS ALLEGRO) (A I)
+#+(or GCL ECLS ALLEGRO) ERROR
+
+(ASSOC 'A
+       '((B C)
+         A
+         ((A)
+          U)
+         (A I))
+       :TEST-NOT
+       #'(LAMBDA (X Y)
+                (IF (ATOM Y)
+                    (EQL Y X))))
+#-ALLEGRO (B C)
+#+ALLEGRO ERROR
+
+(ASSOC-IF 'NUMBERP
+       '((A . 3)
+         (3 . A)))
+(3 . A)
+
+(ASSOC-IF 'SYMBOLP
+       '((A . 3)
+         (3 . A)))
+(A . 3)
+
+(ASSOC-IF-NOT 'SYMBOLP
+       '((A . 3)
+         (3 . A)))
+(3 . A)
+
+(ASSOC-IF-NOT 'NUMBERP
+       '((A . 3)
+         (3 . A)))
+(A . 3)
+
+(RASSOC 'A
+       '((1 . B)
+         (2 . A)))
+(2 . A)
+
+(RASSOC-IF 'SYMBOLP
+       '((1 . B)
+         (2 . A)))
+(1 . B)
+
+(RASSOC-IF 'SYMBOLP
+       '((1 . 3)
+         (2 . A)))
+(2 . A)
+
+(RASSOC-IF-NOT 'SYMBOLP
+       '((1 . 3)
+         (2 . A)))
+(1 . 3)
+
diff --git a/src/tests/loop.tst b/src/tests/loop.tst
new file mode 100644
index 000000000..a9051045e
--- /dev/null
+++ b/src/tests/loop.tst
@@ -0,0 +1,818 @@
+(loop for x from 1 to 9
+      for y = nil then x
+      collect (list x y)
+)
+((1 NIL) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9))
+
+(loop for x from 1 to 9
+      and y = nil then x
+      collect (list x y)
+)
+((1 NIL) (2 1) (3 2) (4 3) (5 4) (6 5) (7 6) (8 7) (9 8))
+
+(with-output-to-string (*standard-output*)
+  (loop as i from 1 to 5
+        do (print i)
+) )
+"
+1 
+2 
+3 
+4 
+5 "
+
+(with-output-to-string (*standard-output*)
+  (loop for i from 10 downto 1 by 3
+        do (print i)
+) )
+"
+10 
+7 
+4 
+1 "
+
+(with-output-to-string (*standard-output*)
+  (loop as i below 5
+        do (print i)
+) )
+"
+0 
+1 
+2 
+3 
+4 "
+
+(with-output-to-string (*standard-output*)
+  (loop for item in '(1 2 3 4 5)
+        do (print item)
+) )
+"
+1 
+2 
+3 
+4 
+5 "
+
+(with-output-to-string (*standard-output*)
+  (loop for item in '(1 2 3 4 5) by #'cddr
+        do (print item)
+) )
+"
+1 
+3 
+5 "
+
+(loop for (item . x) (t . fixnum) in '((A . 1) (B . 2) (C . 3))
+      unless (eq item 'B) sum x
+)
+4
+
+(loop for sublist on '(a b c d)
+      collect sublist
+)
+((A B C D) (B C D) (C D) (D))
+
+(with-output-to-string (*standard-output*)
+  (loop for (item) on '(1 2 3)
+        do (print item)
+) )
+"
+1 
+2 
+3 "
+
+(with-output-to-string (*standard-output*)
+  (loop for item in '(1 2 3)
+        do (print item)
+) )
+"
+1 
+2 
+3 "
+
+(loop for i below 5
+      for j = 10 then i
+      collect j
+)
+(10 1 2 3 4)
+
+(loop for i below 5
+      for j = i
+      collect j
+)
+(0 1 2 3 4)
+
+(loop for item = 1 then (+ item 10)
+      repeat 5
+      collect item
+)
+(1 11 21 31 41)
+
+(loop for char across (the simple-string "Hello")
+      collect char
+)
+(#\H #\e #\l #\l #\o)
+
+(with-output-to-string (*standard-output*)
+  (loop repeat 3
+        do (write-line "What I say three times is true")
+) )
+"What I say three times is true
+What I say three times is true
+What I say three times is true
+"
+
+(with-output-to-string (*standard-output*)
+  (loop repeat -15
+        do (write-line "What you see is what you expect")
+) )
+""
+
+#| ;; FOR clauses should come before WHILE clauses
+(let ((stack '(a b c d e f)))
+  (loop while stack
+        for item = (length stack) then (pop stack)
+        collect item
+) )
+(6 A B C D E F)
+|#
+
+(loop for i fixnum from 3
+      when (oddp i) collect i
+      while (< i 5)
+)
+(3 5)
+
+(loop for i from 0 to 10
+      always (< i 11)
+)
+T
+
+(loop for i from 0 to 10
+      never (> i 11)
+)
+T
+
+(loop for i from 0
+      thereis (when (> i 10) i)
+)
+11
+
+(with-output-to-string (*standard-output*)
+  (loop for i from 0 to 10
+        always (< i 9)
+        finally (print "You won't see this")
+) )
+""
+
+(with-output-to-string (*standard-output*)
+  (loop never t
+        finally (print "You won't see this")
+) )
+""
+
+(with-output-to-string (*standard-output*)
+  (loop thereis "Here is my value"
+        finally (print "You won't see this")
+) )
+""
+
+(loop thereis "Here is my value"
+      finally (print "You won't see this")
+)
+"Here is my value"
+
+(with-output-to-string (*standard-output*)
+  (loop for i from 1 to 10
+        thereis (> i 11)
+        finally (print i)
+) )
+"
+11 "
+
+(let (everest chocorua sahara)
+  (defstruct mountain  height difficulty (why "because it is there"))
+  (setq everest (make-mountain :height '(2.86e-13 parsecs)))
+  (setq chocorua (make-mountain :height '(1059180001 microns)))
+  (defstruct desert  area (humidity 0))
+  (setq sahara (make-desert :area '(212480000 square furlongs)))
+  (loop for x in (list everest sahara chocorua)
+        thereis (and (mountain-p x) (mountain-height x))
+) )
+(2.86e-13 parsecs)
+
+(with-output-to-string (*standard-output*)
+  (loop for (month date-list) in '((january (24 28)) (february (17 29 12)))
+        do (loop for date in date-list
+                 do (case date
+                      (29 (when (eq month 'february) (loop-finish)))
+                    )
+                 do (format t "~:(~A~) ~A~%" month date)
+) )        )
+"January 24
+January 28
+February 17
+"
+
+(loop for i in '(1 2 3 stop-here 4 5 6)
+      when (symbolp i) do (loop-finish)
+      count i
+)
+3
+
+(loop for i in '(1 2 3 stop-here 4 5 6)
+      until (symbolp i)
+      count i
+)
+3
+
+(loop for name in '(fred sue alice joe june)
+      for kids in '((bob ken) () () (kris sunshine) ())
+      collect name
+      append kids
+)
+(FRED BOB KEN SUE ALICE JOE KRIS SUNSHINE JUNE)
+
+(multiple-value-list
+  (loop for name in '(fred sue alice joe june)
+        as age in '(22 26 19 20 10)
+        append (list name age) into name-and-age-list
+        count name into name-count
+        sum age into total-age
+        finally
+          (return (values (round total-age name-count) name-and-age-list))
+) )
+(19 (FRED 22 SUE 26 ALICE 19 JOE 20 JUNE 10))
+
+(loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
+      when (symbolp i) collect i
+)
+(BIRD TURTLE HORSE CAT)
+
+(loop for i from 1 to 10
+      if (oddp i) collect i
+)
+(1 3 5 7 9)
+
+(with-output-to-string (*standard-output*)
+  (loop for i in '(a b c d) by #'cddr
+        collect i into my-list
+        finally (print my-list)
+) )
+"
+(A C) "
+
+(loop for x in '((a) (b) ((c)))
+      append x
+)
+(A B (C))
+
+(loop for i upfrom 0
+      as x in '(a b (c))
+      nconc (if (evenp i) (list x) '())
+)
+(A (C))
+
+(loop for i in '(a b nil c nil d e)
+      count i
+)
+5
+
+(loop for i fixnum in '(1 2 3 4 5)
+      sum i
+)
+15
+
+(let ((series '(1.2 4.3 5.7)))
+  (loop for v in series
+        sum (* 2.0 v)
+) )
+22.4
+
+(loop for i in '(2 1 5 3 4)
+      maximize i
+)
+5
+
+(loop for i in '(2 1 5 3 4)
+      minimize i
+)
+1
+
+(let ((series '(1.2 4.3 5.7)))
+  (loop for v in series
+        maximize (round v) fixnum
+) )
+6
+
+(let ((series '(1.2 4.3 5.7)))
+  (loop for v in series
+        minimize (round v) into result fixnum
+        finally (return result)
+) )
+1
+
+(loop with a = 1
+      with b = (+ a 2)
+      with c = (+ b 3)
+      with d = (+ c 4)
+      return (list a b c d)
+)
+(1 3 6 10)
+
+(loop with a = 1
+       and b = 2
+       and c = 3
+       and d = 4
+      return (list a b c d)
+)
+(1 2 3 4)
+
+(let ((a 5) (b 10) (c 1729))
+  (loop with a = 1
+         and b = (+ a 2)
+         and c = (+ b 3)
+         and d = (+ c 4)
+        return (list a b c d)
+) )
+(1 7 13 1733)
+
+(loop with (a b c) (float integer float)
+      return (format nil "~A ~A ~A" a b c)
+)
+"0.0 0 0.0"
+
+(loop with (a b c) float
+      return (format nil "~A ~A ~A" a b c)
+)
+"0.0 0.0 0.0"
+
+(let ((numbers-list '(3 2 4 6 1 7 8)) (results nil))
+  (cons
+    (with-output-to-string (*standard-output*)
+      (loop for i in numbers-list
+            when (oddp i)
+              do (print i)
+              and collect i into odd-numbers
+              and do (terpri)
+              else
+              collect i into even-numbers
+            finally (setq results (list odd-numbers even-numbers))
+    ) )
+    results
+) )
+("
+3 
+
+1 
+
+7 
+"
+(3 1 7) (2 4 6 8))
+
+(loop for i in '(1 2 3 4 5 6)
+      when (and (> i 3) i)
+        collect it
+)
+(4 5 6)
+
+(loop for i in '(1 2 3 4 5 6)
+      when (and (> i 3) i)
+        return it
+)
+4
+
+(loop for i in '(1 2 3 4 5 6)
+      thereis (and (> i 3) i)
+)
+4
+
+(with-output-to-string (*standard-output*)
+  (loop for x from 0 to 3
+        do (print x)
+        if (zerop (mod x 2))
+          do (write-string " a")
+          and
+          if (zerop (floor x 2))
+            do (write-string " b")
+            and
+            do (write-string " c")
+) )
+"
+0  a b c
+1 
+2  a
+3 "
+
+(with-output-to-string (*standard-output*)
+  (loop for x from 0 to 3
+        do (print x)
+        if (zerop (mod x 2))
+          do (write-string " a")
+          and
+          if (zerop (floor x 2))
+            do (write-string " b")
+            end
+          and
+          do (write-string " c")
+) )
+"
+0  a b c
+1 
+2  a c
+3 "
+
+(with-output-to-string (*standard-output*)
+  (loop for i from 1 to 5
+        do (print i)
+) )
+"
+1 
+2 
+3 
+4 
+5 "
+
+(with-output-to-string (*standard-output*)
+  (loop for i from 1 to 4
+        do (print i)
+           (print (* i i))
+) )
+"
+1 
+1 
+2 
+4 
+3 
+9 
+4 
+16 "
+
+(loop for item in '(1 2 3 a 4 5)
+      when (not (numberp item))
+        return (format nil "non-numeric value: ~S" item)
+)
+"non-numeric value: A"
+
+(loop for item in '(1 2 3 a 4 5)
+      when (not (numberp item))
+        do (return (format nil "non-numeric value: ~S" item))
+)
+"non-numeric value: A"
+
+(loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+      for a integer = (first numlist)
+      for b integer = (second numlist)
+      for c float = (third numlist)
+      collect (list c b a)
+)
+((4.0 2 1) (8.3 6 5) (10.4 9 8))
+
+(loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+      for a integer = (first numlist)
+      and for b integer = (second numlist)
+      and for c float = (third numlist)
+      collect (list c b a)
+)
+((4.0 2 1) (8.3 6 5) (10.4 9 8))
+
+(loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+      for a integer = (first numlist)
+      and b integer = (second numlist)
+      and c float = (third numlist)
+      collect (list c b a)
+)
+((4.0 2 1) (8.3 6 5) (10.4 9 8))
+
+(loop for (a b c) (integer integer float) in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+      collect (list c b a)
+)
+((4.0 2 1) (8.3 6 5) (10.4 9 8))
+
+(loop for (a b c) float in '((1.0 2.0 4.0) (5.0 6.0 8.3) (8.0 9.0 10.4))
+      collect (list c b a)
+)
+((4.0 2.0 1.0) (8.3 6.0 5.0) (10.4 9.0 8.0))
+
+(loop with (a b) float = '(1.0 2.0)
+      and (c d) integer = '(3 4)
+      and (e f)
+      return (list a b c d e f)
+)
+(1.0 2.0 3 4 NIL NIL)
+
+(loop for (a nil b) = '(1 2 3)
+      do (return (list a b))
+)
+(1 3)
+
+(loop for (x . y) = '(1 . 2)
+      do (return y)
+)
+2
+
+(loop for ((a . b) (c . d)) of-type ((float . float) (integer . integer))
+                            in '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6)))
+      collect (list a b c d)
+)
+((1.2 2.4 3 4) (3.4 4.6 5 6))
+
+(loop for buffer in '("\"Hello\"" "\"unterminated" "nothing")
+      collect
+        (loop initially (unless (char= (char buffer 0) #\") (loop-finish))
+              for i fixnum from 1 below (length buffer)
+              when (char= (char buffer i) #\")
+                return i
+)       )
+(6 NIL NIL)
+
+(let (result)
+  (list
+    (with-output-to-string (*standard-output*)
+      (setq result
+        (loop for i from 1 to 10
+              when (> i 5)
+                collect i
+              finally (print i)
+    ) ) )
+    result
+) )
+("
+11 " (6 7 8 9 10))
+
+(multiple-value-list
+  (loop for i from 1 to 10
+        when (> i 5)
+          collect i into number-list
+          and count i into number-count
+        finally (return (values number-count number-list))
+) )
+(5 (6 7 8 9 10))
+
+(let (result)
+  (list
+    (with-output-to-string (*standard-output*)
+      (setq result
+        (loop named max
+              for i from 1 to 10
+              do (print i)
+              do (return-from max 'done)
+    ) ) )
+    result
+) )
+("
+1 " DONE)
+
+;;; The following tests are not mandatory according to dpANS or ANSI CL,
+;;; but that's how users expect the LOOP macro to work, so we check them.
+
+(loop for i = 0
+      for j to 2
+      collect j
+)
+(0 1 2)
+
+(loop for i in '(1 2)
+      for j = i
+      for k = j
+      collect (list i j k)
+)
+((1 1 1) (2 2 2))
+
+(loop for idx upfrom 0 below 5
+      for char = (aref "Error" idx)
+      collect char
+)
+(#\E #\r #\r #\o #\r)
+
+(let ((hash-table (make-hash-table)))
+  (setf (gethash 1 hash-table) 100)
+  (setf (gethash 2 hash-table) 200)
+  (sort
+    (loop for key being each hash-key in hash-table using (hash-value val)
+          for key+1 = (1+ key)
+          collect (list key key+1 val))
+    #'<
+    :key #'car
+) )
+((1 2 100) (2 3 200))
+
+(loop for i across '#(1 2 3 4)
+      for j = (1+ i)
+      collect (list i j)
+)
+((1 2) (2 3) (3 4) (4 5))
+
+(loop for i in '()
+      for j = (1+ i)
+      collect j
+)
+nil
+
+(loop for i across '#()
+      for j = (1+ i)
+      collect j
+)
+nil
+
+(loop for x = t
+      for y in '(A B C)
+      for z = t
+      collect y
+)
+(A B C)
+
+(loop for x = t
+      for y across '#(A B C)
+      for z = t
+      collect y
+)
+(A B C)
+
+(loop for x = t
+      for y in ()
+      for z = t
+      collect y
+)
+nil
+
+(loop for x = t
+      for y across '#()
+      for z = t
+      collect y
+)
+nil
+
+(let ((hash-table (make-hash-table)))
+  (setf (gethash 1 hash-table) 100)
+  (setf (gethash 2 hash-table) 200)
+  (sort
+    (loop for x = t
+          for key being each hash-key in hash-table using (hash-value val)
+          for key+1 = (1+ key)
+          for z = t
+          collect (list key key+1 val))
+    #'<
+    :key #'car
+) )
+((1 2 100) (2 3 200))
+
+(loop for i from 1 to 0
+      collect i
+)
+nil
+
+(let ((hash-table (make-hash-table)))
+  (setf (gethash 1 hash-table) 100)
+  (setf (gethash 2 hash-table) 200)
+  (sort
+    (loop for val being each hash-value in hash-table
+          collect val)
+    #'<
+) )
+(100 200)
+
+(let ((hash-table (make-hash-table)))
+  (setf (gethash 1 hash-table) 100)
+  (setf (gethash 2 hash-table) 200)
+  (sort
+    (loop for val being each hash-value in hash-table
+          for deriv-val = (/ 1 val) 
+          collect deriv-val)
+    #'<
+) )
+(1/200 1/100)
+
+(let ((hash-table (make-hash-table)))
+  (setq i 123456789)
+  (setf (gethash 1 hash-table) 100)
+  (setf (gethash 2 hash-table) 200)
+  (loop for i across '#(1 2 3 4 5 6)
+        collect i)
+  (loop for i in '(1 2 3 4 5 6)
+        collect i)
+  (loop for i being each hash-key of hash-table
+        collect i)
+  (loop for i being each present-symbol of *package*
+        collect i)
+  i
+)
+123456789
+
+(loop for x on '(3 4 5)
+      for y = (car x)
+      for z in '(a b c)
+      collect z
+)
+(a b c)
+
+(loop for x across '#(3 4 5)
+      for y = (1+ x)
+      for z across '#(a b c)
+      collect (list x y z)
+)
+((3 4 a) (4 5 b) (5 6 c))
+
+(loop for x across '#()
+      for y = x
+      for z across '#(a b c)
+      collect (list x y z)
+)
+nil
+
+(loop for x across '#(1 2 3)
+      for y = x
+      for z across '#()
+      collect (list x y z)
+)
+nil
+
+(loop for x across '#(1 2 3)
+      for y = (1+ x)
+      for z across '#(a b)
+      collect (list x y z)
+)
+((1 2 a) (2 3 b))
+
+(loop for x across '#(1 2)
+      for y = (1+ x)
+      for z across '#(a b c)
+      collect (list x y z)
+)
+((1 2 a) (2 3 b))
+
+(let ((package (make-package "LOOP-TEST")))
+  (intern "blah" package)
+  (let ((blah2 (intern "blah2" package)))
+    (export blah2 package)
+  )
+  (list
+    (sort 
+      (loop for sym being each present-symbol of package 
+            for sym-name = (symbol-name sym)
+            collect sym-name
+      )
+      #'string<
+    )
+    (sort 
+      (loop for sym being each external-symbol of package 
+            for sym-name = (symbol-name sym)
+            collect sym-name
+      )
+      #'string<
+) ) )
+(("blah" "blah2") ("blah2"))
+
+(let ((ht (make-hash-table)))
+  (loop for key being each hash-key of ht
+        for value = (gethash key ht)
+        collect (list key value)
+) )
+nil
+
+(let ((ht (make-hash-table)))
+  (loop for dummy = (+ 1 2)
+        for key being each hash-key of ht
+        collect (list key)
+) )
+nil
+
+;;; Three more tests, found by Russell Senior.
+;;; They are justified by ANSI CL 6.1.1.4 and 6.1.2.1.5.
+
+(let ((list '(1 2 3)))
+  (loop for x in list
+        and y = nil then x
+        collect (list x y)))
+((1 NIL) (2 1) (3 2))
+
+(let ((list '(1 2 3)))
+  (loop for x in list
+        for y = nil then x
+        collect (list x y)))
+((1 NIL) (2 2) (3 3))
+
+(let ((list '(1 2 3)))
+  (loop for x in list
+        for y = nil then x
+        and z = nil then y
+        collect (list x y z)))
+((1 NIL NIL) (2 2 NIL) (3 3 2))
+
+;;; One more test, found by Lennart Staflin.
+
+(loop repeat 4 for x = (+ 1 1) collect x)
+(2 2 2 2)
+
+;;; Tests from ANSI CL section 6.1.2.1.1.
+
+(let ((x 1)) (loop for i from x by (incf x) to 10 collect i))
+(1 3 5 7 9)
+
+(let ((x 1)) (loop for i by (incf x) from x to 10 collect i))
+(2 4 6 8 10)
+
+;; Clean up.
+(progn (delete-package "LOOP-TEST") t)
+T
+
diff --git a/src/tests/macro8.tst b/src/tests/macro8.tst
new file mode 100644
index 000000000..23b06468a
--- /dev/null
+++ b/src/tests/macro8.tst
@@ -0,0 +1,106 @@
+
+;; testen der macrofunktionen kapitel 8
+;; ------------------------------------
+
+
+;; 8.1
+;macro-function | defmacro
+
+
+(and (macro-function 'push) T)
+T
+
+(and (macro-function 'member) T)
+NIL
+
+(defmacro arithmetic-if (test neg-form zero-form pos-form)
+          (let ((var (gensym)))
+               `(let ((,var ,test))
+                     (cond ((< ,var 0) ,neg-form)
+                           ((= ,var 0) ,zero-form)
+                           (T ,pos-form)))))
+arithmetic-if
+
+
+(and (macro-function 'arithmetic-if) T)
+T
+
+(setf x 8)
+8
+
+(arithmetic-if (- x 4)(- x)(LIST "ZERO") x)
+8
+
+
+(setf x 4)
+4
+
+(arithmetic-if (- x 4)(- x)(LIST "ZERO")x)
+("ZERO")
+
+
+(setf x 3)
+3
+
+(arithmetic-if (- x 4)(- x)(LIST "ZERO")x)
+-3
+
+
+
+(defmacro arithmetic-if (test neg-form &optional zero-form pos-form)
+          (let ((var (gensym)))
+               `(let ((,var ,test))
+                     (cond ((< ,var 0) ,neg-form)
+                           ((= ,var 0) ,zero-form)
+                           (T ,pos-form)))))
+arithmetic-if
+
+
+(setf x 8)
+8
+
+(arithmetic-if (- x 4)(- x))
+nil
+
+
+(setf x 4)
+4
+
+(arithmetic-if (- x 4)(- x))
+NIL
+
+
+(setf x 3)
+3
+
+(arithmetic-if (- x 4)(- x))
+-3
+
+(defmacro halibut ((mouth eye1 eye2)
+                   ((fin1 length1)(fin2 length2))
+                   tail)
+        `(list ,mouth ,eye1 ,eye2 ,fin1 ,length1 ,fin2 ,length2 ,tail))
+halibut
+
+(setf m 'red-mouth
+      eyes '(left-eye . right-eye)
+      f1 '(1 2 3 4 5)
+      f2 '(6 7 8 9 0)
+      my-favorite-tail '(list of all parts of tail))
+(list of all parts of tail)
+
+
+
+(halibut (m (car eyes)(cdr eyes))
+         ((f1 (length f1))(f2 (length f2)))
+         my-favorite-tail)
+(RED-MOUTH LEFT-EYE RIGHT-EYE (1 2 3 4 5) 5 (6 7 8 9 0) 5
+(LIST OF ALL PARTS OF TAIL))
+
+;; 8.2
+; macroexpand | macroexpand-1
+
+
+(ecase 'otherwise
+  (otherwise 4))
+4
diff --git a/src/tests/map.tst b/src/tests/map.tst
new file mode 100644
index 000000000..49ecf4eff
--- /dev/null
+++ b/src/tests/map.tst
@@ -0,0 +1,237 @@
+(setf a-vector (make-array 10))
+#+XCL #(0 0 0 0 0 0 0 0 0 0)
+#+(or CLISP ECLS AKCL ALLEGRO) #(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
+#-(or XCL CLISP ECLS AKCL ALLEGRO) UNKNOWN
+
+(do ((i 0 (1+ i))
+     (n (length a-vector)))
+    ((= i n))
+    (when (null (aref a-vector i))
+          (setf (aref a-vector i) 0)))
+nil
+
+(setq liste '(a b c d))
+(a b c d)
+
+(setq x 'anfangswert-von-x)
+anfangswert-von-x
+
+(do ((x liste (cdr x))
+     (oldx x x))
+    ((null x))
+    (print oldx) (print x))
+nil
+
+(defun list-reverse(list)
+       (do ((x list (cdr x))
+            (y '() (cons (car x) y)))
+           ((endp x) y)))
+list-reverse
+
+(list-reverse '(a b c d))
+(d c b a)
+
+(setq foo '(a b c d))
+(a b c d)
+
+(setq bar '(1 2 3 4))
+(1 2 3 4)
+
+(defun fkt(a b) (cons a b))
+fkt
+
+;mapcar
+
+(mapcar #'abs '(3 -4 2 -5 -6))
+(3 4 2 5 6)
+
+(mapcar #'cons '(a b c) '(1 2 3))
+((a . 1) (b . 2) (c . 3))
+
+
+(mapcar #'fkt foo bar)
+((a . 1)(b . 2)(c . 3)(d . 4))
+
+(do ((x foo (cdr x))
+     (y bar (cdr y))
+     (z '() (cons (fkt (car x) (car y)) z)))
+    ((or (null x) (null y))
+     (nreverse z)))
+((a . 1)(b . 2)(c . 3)(d . 4))
+
+;dolist
+(let    ((l '(1 2 3))
+         (r 0))
+        (dolist (x l r)
+                (setf r (+ r  x)) ))
+6
+
+
+;dolist
+(let ((l '(1 2 3)))
+(dolist (x l)(if (> 0 x)(incf x)(return 10))))
+10
+
+(let ((l '(1 2 3)))
+(dolist (x l )(incf x)))
+nil
+
+;dotimes
+
+(let ((s 0))
+(dotimes (i (+ 1 9)s)(setf s (+ s i))))
+45
+
+
+(dolist (x '(a b c d)) (prin1 x) (princ " "))
+nil
+
+(defun palindromep (string &optional
+                           (start 0)
+                           (end (length string)))
+       (dotimes (k (floor (- end start) 2) t)
+                (unless (char-equal (char string (+ start k))
+                                    (char string (- end k 1)))
+                        (return nil))))
+palindromep
+
+(palindromep "Able was I ere I saw Elba")
+t
+
+(palindromep "einnegermitgazellezagtimregennie")
+t
+
+(palindromep "eisgekuehlter bommerlunder")
+nil
+
+(palindromep (remove-if-not #'alpha-char-p
+                            "A man, a plan, a canal -- Panama"))
+t
+(MAPCAR (FUNCTION (LAMBDA (X) (LIST X))) (QUOTE (A B C)))
+((A) (B) (C))
+
+(MAPCAR (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+(1 2 3)))
+((A 1) (B 2) (C 3))
+
+(MAPCAR (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+(1 2)))
+((A 1) (B 2))
+
+(MAPCAR (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (C)) (QUOTE (1
+2)))
+((C 1))
+
+(MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y))) (QUOTE (C)) (QUOTE (1
+2)) (U V W))
+ERROR
+
+(MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y))) (QUOTE (C)) (QUOTE (1
+2))
+(QUOTE (U V W)))
+((C 1))
+
+(MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U V W)))
+((A 1) (B 2) (C 3))
+
+(MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U V W)))
+((A 1 U) (B 2 V) (C 3 W))
+
+;mapc
+(mapc #'abs '(3 -4 2 -5 -6))
+(3 -4 2 -5 -6)
+
+(MAPC (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+(A B C)
+
+(MAPCAR (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+((A 1 U) (B 2 I) (C 3 V))
+
+(mapl #'(lambda (x y)(cons x y))'(a b c d)'(1 2 3 4))
+(a b c d)
+
+(MAPL (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+(A B C)
+
+;maplist
+
+(maplist #'(lambda (x)(cons 'foo x))'(a b c d))
+((foo a b c d)(foo b c d)(foo c d)(foo d))
+
+
+(maplist #'(lambda (x) (if (member (car x)(cdr x)) 0 1))
+         '(a b a c d b c))
+(0 0 1 0 1 1 1)
+
+
+(MAPLIST (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C))
+(QUOTE (1 2 3)) (QUOTE (U I V)))
+(((A B C) (1 2 3) (U I V)) ((B C) (2 3) (I V)) ((C) (3) (V)))
+
+(MAPLIST (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C))
+(QUOTE (1 2 3)) (QUOTE (U I)))
+(((A B C) (1 2 3) (U I)) ((B C) (2 3) (I)))
+
+(MAPLIST (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2))
+(QUOTE (U I V)))
+(((A B C) (1 2) (U I V)) ((B C) (2) (I V)))
+
+(MAPLIST (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+(((A B) (1 2 3) (U I V)) ((B) (2 3) (I V)))
+
+;mapcon
+
+(mapcon #'(lambda (x)(and (oddp (car x))(list (car x))))'(5 4 3 2 1))
+(5 3 1)
+
+
+(MAPCON (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+((A B) (1 2 3) (U I V) (B) (2 3) (I V))
+
+(MAPCON (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+((A B C) (1 2 3) (U I V) (B C) (2 3) (I V) (C) (3) (V))
+
+;mapcan
+
+(mapcan #'(lambda (x)(and (numberp x)(list x)))'(a 1 b c 3 4 d 5))
+(1 3 4 5)
+
+(MAPCAN (FUNCTION (LAMBDA (X Y Z) (LIST X Y Z))) (QUOTE (A B C)) (QUOTE
+(1 2 3))
+(QUOTE (U I V)))
+(A 1 U B 2 I C 3 V)
+
+(MAPCAN (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+(1 2 3)))
+(A 1 B 2 C 3)
+
+(MAPCAN (FUNCTION (LAMBDA (X) (LIST X))) (QUOTE (A B C)))
+(A B C)
+
+(MAPCON (FUNCTION (LAMBDA (X) (LIST X))) (QUOTE (A B C)))
+((A B C) (B C) (C))
+
+(MAPCON (FUNCTION (LAMBDA (X Y) (LIST X Y))) (QUOTE (A B C)) (QUOTE
+(1 2)))
+((A B C) (1 2) (B C) (2))
+
+(MAPCON (FUNCTION (LAMBDA (X) (LIST X))) (QUOTE (A B C)))
+((A B C) (B C) (C))
+
diff --git a/src/tests/mop.tst b/src/tests/mop.tst
new file mode 100644
index 000000000..4c95a5f0c
--- /dev/null
+++ b/src/tests/mop.tst
@@ -0,0 +1,28 @@
+;; Test some MOP-like CLOS features
+
+(progn
+(defstruct rectangle1 (x 0.0) (y 0.0))
+(defclass counted1-class (structure-class)
+  ((counter :initform 0)) #+CLISP (:metaclass structure-class))
+(defclass counted1-rectangle (rectangle1) () (:metaclass counted1-class))
+(defmethod make-instance :after ((c counted1-class) &rest args)
+  (incf (slot-value c 'counter)))
+(slot-value (find-class 'counted1-rectangle) 'counter)
+(make-instance 'counted1-rectangle)
+(slot-value (find-class 'counted1-rectangle) 'counter)
+)
+                                           1
+
+(progn
+(defclass rectangle2 ()
+  ((x :initform 0.0 :initarg x) (y :initform 0.0 :initarg y)))
+(defclass counted2-class (standard-class)
+  ((counter :initform 0)) #+CLISP (:metaclass structure-class))
+(defclass counted2-rectangle (rectangle2) () (:metaclass counted2-class))
+(defmethod make-instance :after ((c counted2-class) &rest args)
+  (incf (slot-value c 'counter)))
+(slot-value (find-class 'counted2-rectangle) 'counter)
+(make-instance 'counted2-rectangle)
+(slot-value (find-class 'counted2-rectangle) 'counter)
+)
+                                           1
diff --git a/src/tests/number.tst b/src/tests/number.tst
new file mode 100644
index 000000000..f8b09c2f5
--- /dev/null
+++ b/src/tests/number.tst
@@ -0,0 +1,11038 @@
+;;; Michael Stoll  23. 3. 1993
+
+;; ==== B I G N U M S ====
+
+; ---- Test von + ---
+
+(+ 17009115185923538769 -12047631083067675031)
+4961484102855863738
+
+(+ 12677011568664239747 3269056182420253574)
+15946067751084493321
+
+(+ 9315504781982082433 13857624532376678678)
+23173129314358761111
+
+(+ 15226508728194069537 11481952022080775416)
+26708460750274844953
+
+(+ 7461641943684774743 12249026721402718630)
+19710668665087493373
+
+(+ 1180469445886971055 -3208456171287181032)
+-2027986725400209977
+
+(+ 18358552990465743315 221529797579218180385160273426219343697)
+221529797579218180403518826416685087012
+
+(+ -14819874956616484359 30498815629431206969122152847973230849)
+30498815629431206954302277891356746490
+
+(+ -11781881800334342169 112219460388643619332860331282276228017)
+112219460388643619321078449481941885848
+
+(+ 3570694277032201957 284821691832196381859344006870088122712)
+284821691832196381862914701147120324669
+
+(+ -17005463295060938595 69162171850264911722979835561124066203)
+69162171850264911705974372266063127608
+
+(+ 15647113311796203488 150750467185419235519670165664526735459)
+150750467185419235535317278976322938947
+
+(+ -14330150541101371097 -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886421335353882155416908)
+-13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886435665504423256788005
+
+(+ 7406427184711759740 -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336084100766391093756252)
+-4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336076694339206381996512
+
+(+ 8819522415901031498 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363793325150672647162846)
+7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363802144673088548194344
+
+(+ -7242932332215698200 -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159009687703010657137320)
+-10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159016930635342872835520
+
+(+ 9794320575955609492 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470325394342993771343357)
+13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470335188663569726952849
+
+(+ -18404048401680891243 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224482801864925665484770)
+6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224464397816523984593527
+
+(+ -10763220363947284865 -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521301209899829037444385)
+-30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521311973120192984729250
+
+(+ -12742462236537568498 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747534683311506465130527)
+8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747521940849269927562029
+
+(+ 9991390529516174614 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538345749595968764873879)
+7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538355740986498281048493
+
+(+ 831234034418847630 -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606507809487462642341164)
+-744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606506978253428223493534
+
+(+ -6996572501442843347 -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314889561060687692538144)
+-16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314896557633189135381491
+
+(+ -8920936222630165483 -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973494705119572045938607)
+-18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973503626055794676104090
+
+(+ -243510292488206214847646757340020705642 5940577100149745132)
+-243510292488206214841706180239870960510
+
+(+ 35446324064743728955945058978206455057 -6248622708755929572)
+35446324064743728949696436269450525485
+
+(+ -285342226760657637664173494795024413673 -11942737781617905307)
+-285342226760657637676116232576642318980
+
+(+ 180790435817422032042321866247362452865 12401641959336396832)
+180790435817422032054723508206698849697
+
+(+ -179994871947239535956826388240542999950 13573822506399140772)
+-179994871947239535943252565734143859178
+
+(+ -308198027295905163635866438671452347268 -8790069282378476990)
+-308198027295905163644656507953830824258
+
+(+ -139324757925833055762410227358605285566 -190622873846936719063564661032771271922)
+-329947631772769774825974888391376557488
+
+(+ 332866352618304570046318203427223999347 147978646177673305481282943528696833018)
+480844998795977875527601146955920832365
+
+(+ -39471620476300923970352914034802271156 28992893610776120142668950821916856486)
+-10478726865524803827683963212885414670
+
+(+ 274120253734611965146455315763505869288 254675910805265090692978775702306142625)
+528796164539877055839434091465812011913
+
+(+ -122086811464559635596206661886176775901 287312583034687582188356355813963609701)
+165225771570127946592149693927786833800
+
+(+ 288576174771266329955482943556556984728 -57843540651903655425270706396868707777)
+230732634119362674530212237159688276951
+
+(+ -47977736580820486006305788441965482221 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126881113426109906085249657168046936670489)
+984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126833135689529085599243351379604971188268
+
+(+ 21225484205143479814642328762121362291 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974867770082516862899595554460170417713940)
+11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974888995566722006379410196788932539076231
+
+(+ -193095363331703875886398909106293703000 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388168068485304437343508442251302846768269976)
+4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388167875389941105639632555852393740474566976
+
+(+ -14827657635864183514988182371035598180 -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660185258676369175307019300952192657194576)
+-7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660200086334005039490534289134563692792756
+
+(+ 54301423175725658626298504084995819705 -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941312995898184903431893212829646845766101)
+-13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941258694475009177773266914325561849946396
+
+(+ 195114404067053480147948948510253723990 -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176374041758276069255591562198514767063594)
+-8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176178927354209015775443613250004513339604
+
+(+ -308030589512186791277525017840002670741 -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550454815591457829485684936036414823492160)
+-11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550762846180970016276962461054254826162901
+
+(+ -172649878347923210775992373331623646864 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447760919715595005106669653475931803053499)
+22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447588269837247081895893661102600179406635
+
+(+ 17539006966816771902104329685391462527 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507917720426571969997513984360849930719808)
+15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507935259433538786769416088690535322182335
+
+(+ 244901855797156286376563377540855746602 -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760396535767621855642720080219960822554492)
+-22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760151633911824699356343516842419966807890
+
+(+ -119403662992279138748600939857239307122 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953732384499190437432898387573320391878853)
+26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953612980836198158294149786633463152571731
+
+(+ 313963939617834410089002930298454269912 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864354021315490712575535559549015858088608)
+23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864667985255108546985624562479314312358520
+
+(+ 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160643580198590073658869 -17993015014355471903)
+2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160625587183575718186966
+
+(+ 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942609010590873980143878 15372278140141207703)
+5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942624382869014121351581
+
+(+ -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044148223082253439210893 -14793401891248640808)
+-13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044163016484144687851701
+
+(+ 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149274871082481174186606 8699133332160461067)
+9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149283570215813334647673
+
+(+ -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146471920873844686294838 -13079925952361275418)
+-1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146485000799797047570256
+
+(+ -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311445471793936775767736 -9381557743227419896)
+-4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311454853351680003187632
+
+(+ -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094956858541960962483734293877093635361160 277811698220276334443479876776376776138)
+-6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094679046843740686149290814000317258585022
+
+(+ 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240709059499894818265755197559390728940140016 -118940994129137705779355371753506018694)
+1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240708940558900689128049418204018975434121322
+
+(+ -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454778025302197744540571159656556971614966757 120224841184491944160266976391113485817)
+-9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454777905077356560048626999389580580501480940
+
+(+ 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237448178553189381274150213236222139873594 106674783386899772113212633712093787897)
+4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237554853336576281046263425869934233661491
+
+(+ -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448907193562300482925125162731530249763801 192969103435503875767216559494769734726)
+-9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448714224458864979049357946172035480029075
+
+(+ 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994228143957746922511631911996296931168332 -211230038021470285136061932161632203274)
+1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994016913919725452226495850064135298965058
+
+(+ -2935941510094051560788359387128767361559188973149773593522440619832472030019457317998381634585179453958737810428870232715146002408187749944694186205812791 -1221176156661231926164756142840452419679061324806989304452215660535991083923207702827717652226257158321829748247784282139952864899457896871473184473608543)
+-4157117666755283486953115529969219781238250297956762897974656280368463113942665020826099286811436612280567558676654514855098867307645646816167370679421334
+
+(+ -1338674579024795395027232680327531457830908239605718353094975139226848400289367913459076082700361212506196070727982446232782659114647371030398516119682505 -1298372177520411182435886041880377054374169787570856408996533471838082317927648953576721017727347029007573543972764860712708420553928791798580799809858729)
+-2637046756545206577463118722207908512205078027176574762091508611064930718217016867035797100427708241513769614700747306945491079668576162828979315929541234
+
+(+ -2072456075229532951804023218627137969798924912365258263779029006567941400203608770518731715660383378937120213112973528605594220795605977413985543331908189 -9744489461776287963808523409593616918248399004543154581056479712028497082820841423941781438667661074968238703192056877665754560746003512076830245760254982)
+-11816945537005820915612546628220754888047323916908412844835508718596438483024450194460513154328044453905358916305030406271348781541609489490815789092163171
+
+(+ -2570682164188734368809161664810917340861573482754788446510182252413437925852206735928397938304353826925422441004271229738766803460790995673395984247950088 656920705293329551826685120408221577679101260931105312141757138825917579070505267306626244216341686712802796891966598838285570807961966448181138356047523)
+-1913761458895404816982476544402695763182472221823683134368425113587520346781701468621771694088012140212619644112304630900481232652829029225214845891902565
+
+(+ 7846359203342053693101523606887617345982401999003795257520576318451663998927274759872692123323796450295314377046602880394071105863527900699633560551732837 3683380639347829102597675045842249667669675715600522157867595962635108482512780509393310714588544837398923613138772339053021025559943198965234376657126821)
+11529739842689882795699198652729867013652077714604317415388172281086772481440055269266002837912341287694237990185375219447092131423471099664867937208859658
+
+(+ -11692323148567132684205145901751681947225824260005631214936266006610207543813382900867093989444659986091234552140689684476541703112098935301322850961583953 -8534276689564199122569555420819240948691777228327984555753862457592427992599992931175844172478864477440165366128106812103785256271256853749622592560655914)
+-20226599838131331806774701322570922895917601488333615770690128464202635536413375832042938161923524463531399918268796496580326959383355789050945443522239867
+
+(+ -10734754884168724884333968138739681643742524619139397687680049322697740991391014196697040576174049452737571835233123127815762146577096625434481167057340772 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797378799103456094203126081464905326203083057134061673694975250599375795827437561275156235513192978645909947341297774926450637694325145427434486258223666250272)
+17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797368064348571925478241747496766586521439314609442534297287570550053098086446170260959538472616804596457209769462541803322821932178568330809051777056608909500
+
+(+ 1982582032974021971225071139786536402936929744496433027195224299475980201425925452469321205602618940472354066218156609448199804973454183972974358405933935 -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565757325842468006824235119684861972224857533964558963441079998949499582965764591461900562931342373507763081479989957632695010603500633322408246084430203281475)
+-5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565755343260435032802263894613722185688454597034814467008052803725200106985563165536448093610136770888822609125923739476085562403695659868224273110071797347540
+
+(+ 11532228364136654310006206557545352284448588590560137249197311142901246089838098630841794341370689745410654263817911440601934362503092628725755210859171724 -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425483901920822837775032295913486152631638908227467242772081310515646217115760180349854601959031626524004201825198439309850266508687796415478396821644422350208)
+-25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425472369692458701120722289706928607279354459638876682634832113204503315869670342251223760164690255834258791170934621398409664574325293322849671066433563178484
+
+(+ -2603756427337798371354526130541868239006085657393372011847827118826669474695402075575479286172808099892726251004549675772420422527946534088483901153485670 -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463663570751134804664228918188923926951933302878771189484614604311920655871182974081898031051411394311700207305532216445616083858025977851570522763537300875989)
+-10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463666174507562142462600272715054468820172308964428582856626452139039482540657669483973606530697567119800100031783220995291856278448505798104611247438454361659
+
+(+ -5929887196386997518766568868806997104240129372360669348628384183712406620199102166145939206783172815805659513128544493795329100599632286529420772709366102 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250682015641747568282510036326125505522447591703308661608718100933027549520132308555240654655887041040427813131621391320267698106519650611462269033902177180035)
+24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250676085754551181284991269757256698525343351573936300939369472548843837113512109453074508716680257867612007472108262775773902777419050979175739613129467813933
+
+(+ -8848084327536592532063677611386811805244460767433749071435930786126721080365289638381557872263825830664387392539638767251180242665642373539064690745095464 -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033893238864631158195280554850035949666897861529711006187241710164902350100555999894332438423857208747342184052953230247487231455921360593096823760117493579248)
+-15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033902086948958694787812618527647336478703105990478439936313146095688476821636365183970819981729472573172848440345769886254482636164026235470362824808238674712
+
+(+ -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679396721657020438979754 12553426083939460917)
+-16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679384168230936499518837
+
+(+ 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269660274683400619225321 11620128128044940816)
+20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269671894811528664166137
+
+(+ -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936248281049628734475702 2380166482232871816)
+-9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936245900883146501603886
+
+(+ -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203373153221004361953729 -10586442965055062759)
+-30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203383739663969417016488
+
+(+ 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642592954601418753021512 -12227722924075527556)
+8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642580726878494677493956
+
+(+ -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662935026125770444036994 -7349798942312432150)
+-5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662942375924712756469144
+
+(+ 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391843039459733925494003066841874935048611 -66646390577667468207341453008390168215)
+27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391776393069156258025795725388866544880396
+
+(+ 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506419828208611247177336492131262918439281 -164048419232636429449474429717211197442)
+15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506255779789378610747887017701545707241839
+
+(+ -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300146993858360430784079225137421074839819 117460076430162201914796277915447781936)
+-10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300029533781930268582164428859505627057883
+
+(+ 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707453499030166286828319347894538505334235 -59175168207571178843658955348404514921)
+27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707394323861958715649475688939190100819314
+
+(+ 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851829184120171969918537718488250577987049 -151873924489040812813761508259707631973)
+1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851677310195682929105723956979990870355076
+
+(+ 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821222597665222975816418433744748143385431 -43245950360315656184924888243641533635)
+28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821179351714862660160233508856504501851796
+
+(+ 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830415574905929299482373462584995162798576853564481617711234957058703455021082855018642616999836886763535412642684228990890160568207941504887072856663966242787 1954009743321912552050341299974626734964446274711484506734354360114801426013796892421541915293157994203607853436799102383078659985249097057923578528366737)
+17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830417528915672621394925512926295137425311818010756329195741691413063569822508868815535038541752179921529616250537665789992543646867926753984130780242494609524
+
+(+ 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730196110477118156871579503345757821268248575583821695674912517830056856597644827244194658166928026249459511837772775196175188368236573504643083995409774002567 -5513982495816270388232134254127393284677692173792609278582774509636977743203029647121158805174638642867428501907786521939155900331399058909602425073976766)
+1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730190596494622340601191271211503693874963897891647903065633935055547219619901624214547537008122851610816644409270867409653249212336242105584174392984700025801
+
+(+ -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550976844117943559190671369193871330514473741920389633762695829790016565565261170688485790141638094160105909405353382982945608773290740598479367828342651860878 3451570547959142767282758882796967240086418127970526029661337442068316209707489088420708984628065070358319478649952710478991064476168799556496237099109563)
+-30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550973392547395600047904086434988533547233655502261663236666168452574497249051463199397369432653466095035551085874733030235129782226264429679811332105552751315
+
+(+ 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623397410528064697616617917065021866397277409044449982605591256067763430930720398889239414812509701319783809830072841056369381573100589260104551934136733317845 -9461623592584966196513107657889418526847060851423069480904645009418813160370721071067349946095573698635859409908288864150475056170059858850823883834932131)
+24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623387948904472112650421403957363976978750561983598559536110351422754012117560028168168347462563605746085173970662932767505231098044419200245701110252898385714
+
+(+ 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787710331228500533067546198458251241005176280410230146430275074766072259256583499095689284871987010372039977403712023630453400259082684930755893684499232318008 12330599952818018622104330691506128012101935028731995985677032980931398338453806827555760801312052792065671886621851470997557806941112316627790755867100463)
+19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787722661828453351086168302788942747133188382345258878426260751799053190654921952902516840632788322424832043075598645481924397816889626043072521475255099418471
+
+(+ -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027771176714559050403098437684091684851207513969915720607528045624635094984539637789113651579846373399975502788877555747414523231999341294756679330384323996 764238600803843266244444637050072967342049538611688895792923539838804953492110953673720766879606601435939162680753428779068917662740403667549850724878795)
+-20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027006938113755207136853993047041611883865464431304031711735122084796290031047526835439930812966766798539563626196802318635454314336600891089129479659445201
+
+(+ 6243894672855694190803081952962387322599009058758027960092936187687064819462191583137945440936085088260632250436567758576422207449236613172605950116622271404444221039084346501796818945639456207912207604248991842124079786471250102192718092353598850889806607728696519257402580732995770031331187089424192803722612735557735028710899438934171272639518928194764526910590046378401600819132587804143949995694950116915803127294011661411525934100144319021440919928013617766507409909846670172516021888661284467975865076091834094160862228180625536450124272957206172214541444266874056050295270719541605687740822711659847211976891 11877496607682442993105675644902145742318375725225741293060927105303783712520284640625374957608051032540491531573337817824773543104969422017506696018037874641947740606655370938613842356322585858034851150595788166740174872996252792014218946552442572806242471174234462119454014379628228878122072189387777413014452140618318641689597452676091677588204537830401725113931418426919671512011822864583481449136550835952005765386885680701637038206002172218712504732572449659704181315669255320876647592649071711438131711904976335957846353867776093588236311654631696625859173554395714740218099921290128795607292259527492722462071)
+18121391280538137183908757597864533064917384783983769253153863292990848531982476223763320398544136120801123782009905576401195750554206035190112646134660146046391961645739717440410661301962042065947058754844780008864254659467502894206937038906041423696049078902930981376856595112623998909453259278811970216737064876176053670400496891610262950227723466025166252024521464805321272331144410668727431444831500952867808892680897342113162972306146491240153424660586067426211591225515925493392669481310356179413996787996810430118708582048401630038360584611837868840400617821269770790513370640831734483348114971187339934438962
+
+(+ -24023960171862805266003610953999097357395283354964456554686635290239019705581779621120391229617494503580661676939681517550103414632840981987397485411400553792707518662609532504246677658012933762605038799352109564432278094548068984563394926376371580465135388578139331334464060067790936072127680597181415407099723844313625277987147283697141407959289588588489162704824409673099509423520008795428217612706997355591985894255450783091681112776112997887084157623388943538145736618168104404283342039105202585543852590302154958791010622670839015475427693311663800177428904406869645066988663292128104453773413982185343111560886 -31939808827732134714870375774276102357277346245583282398423150631754622253109692213928642228787888509211781331649081002266227303203259124984426497846441848502574293640959494009564992092503141598640200823656998243767453860939156780549404892392521391484933772285520949470194562525777116137058001008184603332597820522016200623301007194309404025522056113671560767212894303567191067178003014955596425115379852712737129325098876542459702682095445350281859042779889411325882123213577906096942649941285655935053362468972482748617111598313960198743596285343178242282172686940700127068972627110105953098737923773182254460772630)
+-55963768999594939980873986728275199714672629600547738953109785921993641958691471835049033458405383012792443008588762519816330717836100106971823983257842402295281812303569026513811669750516075361245239623009107808199731955487225765112799818768892971950069160863660280804658622593568052209185681605366018739697544366329825901288154478006545433481345702260049929917718713240290576601523023751024642728086850068329115219354327325551383794871558348168943200403278354864027859831746010501225991980390858520597215059274637707408122220984799214219023978654842042459601591347569772135961290402234057552511337755367597572333516
+
+(+ 14513652183174940741664411990199277445706189147726874603036586212536012746892966848269748909379750612027025331446918381470766609543142456872580466135425754204680927122749772612276850998180593344389487924747722210296498854143380696064338777945015153982467675141485724865534995199700908286263993697988986805404864429385840512740226775506122190698806967785494289035976495492863456705096841250592980439363856397663738211335801835896091823148249303370609165910779981271035234045185574995335952208702661648744928539539455138167482396767268362221492607154709559716065850417221174683768503217544145599044845325824451589309835 -12814535978730024053359592817368712576084646962861720729844389627130663192435154658607204342320327460695280260731620465435530495952836598646143907272825807563512741964987882356778796849529260646503692618525570185450780889283642116889481314560395290434301143877809550098309214046129802023655714098730144464028249594406616074059558969757405392170810220921023905546104487938441503430332099605473144930508420331873995741851604525954472341693863067199617721032815462094767522339305487934030130207039176659398466616780628644572276059410087128533031562978399689702766028716401176531098447698206272762966470643604141938670152)
+1699116204444916688304819172830564869621542184865153873192196585405349554457812189662544567059423151331745070715297916035236113590305858226436558862599946641168185157761890255498054148651332697885795306222152024845717964859738579174857463384619863548166531263676174767225781153571106262608279599258842341376614834979224438680667805748716798527996746864470383489872007554421953274764741645119835508855436065789742469484197309941619481454386236170991444877964519176267711705880087061305822001663484989346461922758826493595206337357181233688461044176309870013299821700819998152670055519337872836078374682220309650639683
+
+(+ 11356479761814008572465147431830778885327227506593483181241437802252618729479905490826767363633131720717461693888023278837835457496021519184903984385091047829540007466025527592005114414671285638168997562037691602144751434208304408870143450743278437854754504713023422097017723330207792526222436928747286558205279330508360438281011315147578105966454344087225699378388309094140949428028313539634103047841948634832398526343605363013644180832752120081735152285507591096001749463421326282317713079361827765412853023201330345752038722069405404812511739634687282327711258974520622248165974215116400638833123609666501349513623 -2451734542868054449539778460457497703609327132304922810342762480808881050209276687756391911546806187586640918078231508181876445466503459873508196878629364924241891220686182517218825181707207808769770392864734466652524094735160185556148554260517746279303022469784592528209667497664672945900929888144529727881050106027775707933311860110618130543481573815538047460723253898548348335762406437618625388229555824532715231231491787570056329865617082709588903922431713098922691537317839185452018617461891748518176708607861270770493263960554805373552348256747200291438630960804647686832667981625018361034564086859426490014044)
+8904745218945954122925368971373281181717900374288560370898675321443737679270628803070375452086325533130820775809791770655959012029518059311395787506461682905298116245339345074786289232964077829399227169172957135492227339473144223313994896482760691575451482243238829568808055832543119580321507040602756830324229224480584730347699455036959975422972770271687651917665055195592601092265907102015477659612392810299683295112113575443587850967135037372146248363075877997079057926103487096865694461899936016894676314593469074981545458108850599438959391377940082036272628013715974561333306233491382277798559522807074859499579
+
+(+ -1814184401790217165873937825605141478060935014868566665644215718762341535891730598045990231798382966074312671040257824056876679135909008140059087311700216658095793352051583071432744886316274989901835606602224927350560604355249919901932382803472476702792978322468747380191775778902733911968522382089332819162367884984027854067607561808704316828316820133400099093450636968732151876570835173932998599031643640476109466728761033062776578175554441947411139184426213290292577467587355369954997241091769769542810051228504545831588488726789173405585678190671534386784806998695797717346491308862362775748058331375692317599945 15466182953987394334491149436346080039471412309427279110582769586053943302670765125931570041904640518032832554998553018838321871748542118021556398569294085708441934948186080236498081517178574839977996802813431873543309853609838200338534343580791382510179184571852290959723696010410340740895530535423959476873857191548113125728667781953125153120447892632916574768078583174099545013854248664119997703948998871566374080719541931440495888606776561795893839624084254684939434035018741535261951124673664746010067859317726891535170781460914710499572006592206360512398012457295755926986236618644330364227754380084585899275327)
+13651998552197177168617211610740938561410477294558712444938553867291601766779034527885579810106257551958519883958295194781445192612633109881497311257593869050346141596134497165065336630862299850076161196211206946192749249254588280436601960777318905807386206249383543579531920231507606828927008153334626657711489306564085271661060220144420836292131072499516475674627946205367393137283413490186999104917355231090264613990780898377719310431222119848482700439658041394646856567431386165306953883581894976467257808089222345703582292734125537093986328401534826125613205458599958209639745309781967588479696048708893581675382
+
+(+ -27127130599753372624001250456405972983012981437652156246797208697430661165612459362971759027335854588888552031022264244768883843080959804690580574272908031271224646245152017114094021048441971097191444782106551075175878815012595015584723250801765859461211934306789890718268168352614164589637346918581658850565274510502652089457352942736418509881708568727739912127781455473660768550022762222130489047215089836402367851853412705556570667960548570630054608024914653686223423908494006675057953013815512203710764854485332282975729323105427143207127239069826750682633272289409910001698385240596625059970587393681128674617278 5719655139276246085992066702308194672442413085748146924567717361937179810269300239821879673460959112727066470468217892213025828988023367028158410455624528688729907493639908638553730770145274142147983721694721139760883483821883267129411125364089207412089113869427479340283853501026803387874124668123626271531796990801822527792189514551888019206405597994403243358155410088320317141454525417323186389587327532772638942220300149829241141659063128602316305332848477566686425551944956989370838072872906293845914921103561360871571846865478762953536949621421094416539099628942010528483544062050170673327754206501716239719529)
+-21407475460477126538009183754097778310570568351904009322229491335493481355343159123149879353874895476161485560554046352555858014092936437662422163817283502582494738751512108475540290278296696955043461060411829935414995331190711748455312125437676652049122820437362411377984314851587361201763222250458032579033477519700829561665163428184530490675302970733336668769626045385340451408568236804807302657627762303629728909633112555727329526301485442027738302692066176119536998356549049685687114940942605909864849933381770922104157476239948380253590289448405656266094172660467899473214841178546454386642833187179412434897749
+
+; ---- Test von - ---
+
+(- 3872339191937382556 13437882608410293981)
+-9565543416472911425
+
+(- 12702320881720530101 13823645380834800545)
+-1121324499114270444
+
+(- 10222969257152373972 -3454292165863475982)
+13677261423015849954
+
+(- 591233951053628288 -17639978232337836611)
+18231212183391464899
+
+(- -7878405903223218778 9050739027069287469)
+-16929144930292506247
+
+(- 11347120771894057376 8443917396834074370)
+2903203375059983006
+
+(- 7831959259127703467 -257470007821066702597399141202130667973)
+257470007821066702605231100461258371440
+
+(- 1092406341647857980 -325710450166845666190895573961860069495)
+325710450166845666191987980303507927475
+
+(- -4220606126689357919 73461013742902296577411907972196819778)
+-73461013742902296581632514098886177697
+
+(- -5112059189225304080 334306213789148650102245018234146620793)
+-334306213789148650107357077423371924873
+
+(- 3093346224554776175 -204967241927023874963787190016588249299)
+204967241927023874966880536241143025474
+
+(- -5735747638156472357 -3881750746805128137401544408305666047)
+3881750746805128131665796770149193690
+
+(- 17639095392510638323 13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131453861285495087665017)
+-13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131436222190102577026694
+
+(- 16304056910692545233 1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417465834928609990708982)
+-1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417449530871699298163749
+
+(- -10347586523508777315 12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173691528917744363375331)
+-12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173701876504267872152646
+
+(- 16875252323587344863 -10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527788318592431794213674)
+10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527805193844755381558537
+
+(- 8574302739232756920 2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503759011790017443478716)
+-2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503750437487278210721796
+
+(- -17657597319577965851 -470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715357800461845632614015)
+470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715340142864526054648164
+
+(- 11472336850218354926 16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290339231792790773612376)
+-16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290327759455940555257450
+
+(- 12682607562584942903 32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884157735553718792115929)
+-32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884145052946156207173026
+
+(- 14621880654476679971 -10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579655168106377696154728)
+10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579669789987032172834699
+
+(- -3220156644655019630 -8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543667539444686619670713)
+8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543664319288041964651083
+
+(- 11628988978410243120 21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111014116286675587727714)
+-21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111002487297697177484594
+
+(- -15960716439913426281 18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592227795474197104696127)
+-18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592243756190637018122408
+
+(- -181065640455671431985325539445069267017 14120143334024043377)
+-181065640455671431999445682779093310394
+
+(- -91295299684959299024846233061686623774 6891102275697080803)
+-91295299684959299031737335337383704577
+
+(- -252582289949155881579950873916766853744 883304029266526072)
+-252582289949155881580834177946033379816
+
+(- -10104159950635417603045689770006558103 17251490913777465304)
+-10104159950635417620297180683784023407
+
+(- 288463495341489091297108607960869684860 -16376960611483226267)
+288463495341489091313485568572352911127
+
+(- 204661965092367792468062569536290631004 7774991291341524479)
+204661965092367792460287578244949106525
+
+(- 174559967167400201536723778015754014369 168183438971818617783400303174116396891)
+6376528195581583753323474841637617478
+
+(- -253300708624436983509156598368557395374 -77166863757693227553099778725240875400)
+-176133844866743755956056819643316519974
+
+(- -38587765028356074196061530813295290944 5999161273284748726648331130480323187)
+-44586926301640822922709861943775614131
+
+(- -236400856885875891058508662756360145662 222191413471626205952456600591947275777)
+-458592270357502097010965263348307421439
+
+(- 212937903940173587742882129816769611096 336470165768472077447806282475185249734)
+-123532261828298489704924152658415638638
+
+(- -264812595676159375893264580577855253845 -247068943830535581577267897204259299723)
+-17743651845623794315996683373595954122
+
+(- -1725732715479127274526681751197327660 -2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500508887739763323997191435566266331339917)
+2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500507162007047844869916908884515134012257
+
+(- -220007189346579184019349894240059989979 9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517057595815179415042385175627374957565803)
+-9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517277603004525994226404525521615017555782
+
+(- 139683266109784685815165642637380856544 5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108688202931002414214353708335212597807345)
+-5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108548519664892629528538542692575216950801
+
+(- 239160165978290709841254489756277328273 5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464958986304380141364542178714472948085275)
+-5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464719826138401850654700924224716670757002
+
+(- 315772704643232632782106484978382006176 -3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184616218582046814434719444842678248982224)
+3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184931991286690047067501551327656630988400
+
+(- 82735713197488344149642668226610301853 -12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097816492579684543651922277865558518876774)
+12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097899228292882031996071920533785129178627
+
+(- 63472235942371758467270296983419551089 -7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656218937984504828452980698439495961392749596)
+7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656219001456740770824739165709792944812300685
+
+(- -284018520801241078671538235859630240269 -5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682401429552174530714298081464588450842581)
+5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682117411031373289635626543228728820602312
+
+(- -171812101820192353275910956459431262142 11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870235074909890698574792562001595287630131)
+-11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870406887011710890928068472958054718892273
+
+(- -243638660221338112796448050030955119997 -32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408826226326879491415484319411662301650468948)
+32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408825982688219270077371522963612270695348951
+
+(- -126332081511349770866908261827634312283 31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799809203410103682003414364238243553515261)
+-31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799935535491615031774281272500071187827544
+
+(- 219979452670016849533060110266815720199 3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063325766995908926108582896362623757323811)
+-3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063105787543238909259049836252356941603612
+
+(- 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493643522748210870974797 -1855792162818946202)
+585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493645378540373689920999
+
+(- -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396746566100575461602162 18009081534399282710)
+-3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396764575182109860884872
+
+(- -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580214088920441698992069 -4827559068742614723)
+-11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580209261361372956377346
+
+(- 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693871318067007752043113 17597810481352184048)
+4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693853720256526399859065
+
+(- -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778775472609306735864748 -3892174127829225880)
+-5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778771580435178906638868
+
+(- 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676743031117653237018365 -12861394200627120797)
+8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676755892511853864139162
+
+(- 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971731015312020770945603825344926844435936044 236396022362585261770052671762207864597)
+13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971730778915998408360342055292255082228071447
+
+(- 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903680828294561265828775791256812588754280222 -276673555533799047589626400978981416789)
+12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903681104968116799627823380883213567735697011
+
+(- -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565826229169313660087149542130819663319659 -157671440495648010763311068579191828684)
+-12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565668557728818012076386231062240471490975
+
+(- 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053785280430612875488847226724390758938740 54361107931665215623681874454167019934)
+8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053730919322681210273223544849936591918806
+
+(- 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942391817131531474661895913650810587431606 -50508350367572393968128467319633674717)
+3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942442325481899047055864042118130221106323
+
+(- 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306794511840379704578900504784165956486985 170502882789371639987361620116696459267)
+5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306624008957590332938913143164049260027718
+
+(- -10859007735074693411217019392659638207496329895257318665547454149984863458541990037760564769787816800806064437172810158051442267508476778676439633382657890 -7558060977666720080449823996328496253877735754811271086853901493753796001778345391546991917892931500169890406340928835457635973812901681485438886367096185)
+-3300946757407973330767195396331141953618594140446047578693552656231067456763644646213572851894885300636174030831881322593806293695575097191000747015561705
+
+(- 9842028993407961669727766131360795288615020071102475108883839785397865740828387076847892646234215787999498419839351470775471313077046438080666908734795616 8259939762466350877481193620364896193464602165170783019804380181692322874550956777598992104871440502758410340359413403619753571535498118388286469082729503)
+1582089230941610792246572510995899095150417905931692089079459603705542866277430299248900541362775285241088079479938067155717741541548319692380439652066113
+
+(- 3122315115429970622394662815735050825423438028108957393747131991771456957037829402044934484343765915727397519247940959221091465331254497476137639859816450 10737995515603450913722681305571315249864367824351372254572936648132763616823019940208526402092654554035074813865303483747097673960803093638463005072804384)
+-7615680400173480291328018489836264424440929796242414860825804656361306659785190538163591917748888638307677294617362524526006208629548596162325365212987934
+
+(- 11618335890332522671268040181306950825004789685088262996478365976802329054158653675768163009290064139158450983598701977173152384425333441365287895694522192 -13130287008197231017935223399369698658354829835061356451363818961959486828237111511740029441613108087354987794332115218978284937263725126538295501305403242)
+24748622898529753689203263580676649483359619520149619447842184938761815882395765187508192450903172226513438777930817196151437321689058567903583396999925434
+
+(- -4829477140897377009195646150061276059814366801005389903693533021027427566117360765323647260121062827801190746646296803957067548167571028717513392985791293 10716557117391614298810040587314742187092120526669273567183969821384063434473189717686678450880765426943205955814024872764413373364846268902370055526485180)
+-15546034258288991308005686737376018246906487327674663470877502842411491000590550483010325711001828254744396702460321676721480921532417297619883448512276473
+
+(- 1560421244904974852620371975782132605421448226892487453928759432083522187778803424020804578027100625536441377609275030418285893555753560195716001014786650 -11797558308994912054526619290334311429749533070145154703018977152548370444659962978040151671210413666186432921816690953994784423526183449271023503069393845)
+13357979553899886907146991266116444035170981297037642156947736584631892632438766402060956249237514291722874299425965984413070317081937009466739504084180495
+
+(- -7701347923966912534344428538744620884561375267012102797292378941649984539207353887059064943586048644516121387166836442084007442716291792933061162738380376 5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642478870844024835907350391770605391526921411004262446196112836319091260967898895009427182171643279100998182191816962677328417390867021108292139204864164048286)
+-5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642486572191948802819884736199144136147805972379529458298910128698032910952438102363314241236586865149642698313204129513770501398309737400085072266026902428662
+
+(- 9733743430220591762422540139212426729307515492818443460852332805653889275463385649305231919846970974905736816260992940027028218064265519723018527155353151 -29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453255593120138178690189726206775893096279000909079330468718593887702543025737308336025198677457129910473491269839827087491228569718246503140134413881896746751)
+29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453265326863568399281952148746915105523008308424572148912179446220508196915012771721674503909376976881448397006656088080431255597936310768659857432409052099902
+
+(- -276731217243271862683214238489380950428392903790808046630969592255272629537001990355375434170910931115552132394269672247616298060929507021008951190291387 100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150102261744547461816282538319258966892339056695718919291240188920586288417893106046698069355647145603908383687239983874164793005765733782432717429040621674)
+-100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150378992961790733678965752557748347842767449599509727337871158512841561047430108037053444789818056535023935819634253546412409303826663289453726380230913061
+
+(- 8505070389896098095621766692413480203366379968950158493268895987250690600795955783113900096527432416791184386061684833478921638080978014176210898461637606 -16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728677459134022062202283647690649100602260948409511070624300011106517649666031530376191755817891213910847547809248990517666613043010292627100428536737652546738)
+16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728685964204411958300379269457341514082464314789480020782793280002504900356632326331974869717987741343264338993635052202500091964648373605114604747636114184344
+
+(- -12618010259109779267590315037969998053964054382853891516547435925972388025118492931596200697357628900783311183940584302426381939302632641549019984810957030 -30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476306906983993748299291616038887011943864441807818857508443930272872365334665976442185494702520760793786640113779099219233665607521784524244604432396247693263)
+30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476294288973734638520024025723849041945810477753436003616927382836946392946640857949253898501823403164885856802595158634931239225582481891603055412411436736233
+
+(- 793528769616879938852241178439496352527042950647521648629732169156958768358523029837406526207126598190786120139491813624819360632811627576064199559812277 -7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323018004882611048769247228828875493680284766874334247375868318795940759082324831733175858991629741478124633015067484305547002438816473086042218906532116413)
+7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323811533652227928708099470007314990032811809824981769024498050965097717850683354763013265517836868076315419135206976119171821799449284713618283106091928690
+
+(- 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554199017672360091721648 9164115638960783470)
+30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554189853556721130938178
+
+(- -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769237154904791412049964 16928681651977808800)
+-22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769254083586443389858764
+
+(- -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289916823063616573634058 -10755560408227106818)
+-5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289906067503208346527240
+
+(- 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427134042574317487793 -126159569916621842)
+16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427260202144234109635
+
+(- -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617308447853505824391099 13449070890444925581)
+-9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617321896924396269316680
+
+(- -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414447893892341891463988 4431555062692055371)
+-8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414452325447404583519359
+
+(- 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637382775371488874447622330992324750207465 329466253508616383200261654231797136951)
+4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637053309117980258064422069338092953070514
+
+(- 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708269410828528742743794495302359380494607 126536164564464424337714470705049463978)
+28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708142874663964278319456780831654331030629
+
+(- 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199731850712255885395479903525322397561293553 -169494171680584797187706369710105239124)
+3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199732020206427565980277091231692107666532677
+
+(- -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152307499446188262820058714564165108542508 -26845770031559702758807696432929071597)
+-17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152280653676156703117299906867732179470911
+
+(- -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789655406716271370732069643455590690035701 -321447426701397438572265325285879998363)
+-20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789333959289569973293497378130304810037338
+
+(- -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955696690287600957842671916189752415855520 132223863177855649509430852484092802671)
+-6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955828914150778813492181347042236508658191
+
+(- 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912743446197670724757690108283368934769626461285961947257397454619164856011847736479229692086038931510067165282571276049292116713101550911614590774659556899356 -6114512833799784097991148713266650451765474382378581896952003894922931741133332233338460555227243451198289670274036744955599177213449957470212981501678055)
+15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912749560710504524541788099432082201420078226760344325839294406623059778943588869811463030546594158753518363572241550086037072312278764361572060987641058577411
+
+(- -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912449969621455596132708975438173455827361542712483153981422051943690720556013580161324856788091093465837542336129629269227369781823515673967591796132853515009 3321161637038961370471515250185392889390643163295535903347391615170504064647249127732639364682803744773593849851778894972403397573953564801884397178069327)
+-26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912453290783092635094079446953423641220250933355646449517325399335305891060078227410452589427455776269582315929979481048122342185221089627532393680530031584336
+
+(- 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741918196732794332451120218658490129307932187658010681746557120172585093207839141764683325214902696969028472942954863209641597556494684135445935915485525220911 204625459185084436546676461283890328511903949966691877662249903659689934813784661695047569885195881142676761876303280806728760511429260843727967794322777)
+27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741917992107335147366683671982028845417603675754060715054679457922681433517904327980021630167332811773147330266192986906360790827734172706185092187517730898134
+
+(- 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321037694842089561504643350632756961329867761604760788760440497535611072991056505806805291706178639395690245460397975614715123591611301423752799666149495108752 994321141213369910357526037382331323092462599623554452705525887587326552002660849455542761618020243106424015447778226642816634338781654345001677083881111)
+18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321036700520948348134732993106719578998544669142161165205987792009723485664504503145955836163417021375447139036382527836488480774976962642098454664472411227641
+
+(- -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316157215551931810740200836725504693738229444336470213883741520460842708733150362983831267583568258736572295448486287825894301201018490203520738439038977754991 -7402949251688548738762242219263594861535354011996392637087346760786292549376145193266590582054224293289596877537643409310483743293801574030358189880866069)
+-25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316149812602680122191462074483285430143367908982458217491104433114081922440600986838638000992986204512279005851608750182484990717275196401946708080849096888922
+
+(- -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264269215878469013316796620921077244799814690434355127994011220041638393750697699141479399553359747084811371804524490919966410379714725200415331414459870271869 -9247155945465656153397925559476432992975541781462281935278489123804934847762489500833913193183733932905776020790478662969835879365116238125565077744775032)
+-26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264259968722523547660643222995517768366821714892573665712075941552514588815849936651978565640166563350878466028503700441303440543835360084177205849382125496837
+
+(- -17010604274474750006607667808593883725990508452473783283717890546525148212376267233909567638545898628257361383837671935903199638230375408397752251127816717091041943873728526445398525706450929660366518707254053655364610471112296477865068960744948010561798109833411657930112293904378353445961131058136287425064317621271289456901138718557297733713446119244533144377470099270824020439428168481914824420861176457152299497728390918971852021025089592998997807574907789524112450146545688385954763667980124432645276563626082835790429598328230426471161191074551543308732791287559033843466623138171520961684959997180979203053477 -17319079025684619178510812811805110270463447771889107440996086020812918555191263705580533644731591929176480040622705607552852994906782176254877135818109655911838591767583157894999741648979817400330572419476101372927546509769818404491634583907246692993992514876697330603464497645633398167129555001859772111887143352351860130929715392173452396253437927361301990735683539169040916027268831202732178553152351117118606495416985612909248422655861312689027789401950549626643389790516560291620711705848717875304929186131258525831197192620523261738944873398924939726689336762464320190834794155527335576391767307110012289717973)
+308474751209869171903145003211226544472939319415324157278195474287770342814996471670966006185693300919118656785033671649653356676406767857124884690292938820796647893854631449601215942528887739964053712222047717562936038657521926626565623162298682432194405043285672673352203741255044721168423943723484686822825731080570674028576673616154662539991808116768846358213439898216895587840662720817354132291174659966306997688594693937396401630771719690029981827042760102530939643970871905665948037868593442659652622505175690040767594292292835267783682324373396417956545474905286347368171017355814614706807309929033086664496
+
+(- -28362352496476494327713713233021518136860402239251781438945998574753662942796270292818595738100959519541952077905620088422871490191217157269435052965329201030095268586136492980900212955645939325800541690754639292707053269767151001292253701853012092829784482071789669480438026889625605099744553642207773753943711175375843649210118677569597324789367425691177169929576236753018329085700397911235750600921874606148324025962628852167093806152864269874177214562322576097931390470469397118268354868919899638376323751276807304678316688836173746719723312665764603485606350244811113608471530958617108833879194264695174468397461 -4081062111675377984305281082755054920741203741273067094307824323728798665450292976016160959354997082250970415737745853292134965575242789548167162064123232363464302136338349828801951197252612093077640695564825095503535921549690447893467349156939791370286866987224201115453216606688305427702274940837032716124925028835914047967887674858015919302546781010326385758988488478290741665427521820112231266659657169118374988259423444686317389869729817643396097464874333968181509317307320406521221309011946212308190273531009796563611621389720223920155554879800901239072885025170342349379379336047732368458185953903872634982504)
+-24281290384801116343408432150266463216119198497978714344638174251024864277345977316802434778745962437290981662167874235130736524615974367721267890901205968666630966449798143152098261758393327232722900995189814197203517348217460553398786352696072301459497615084565468364984810282937299672042278701370741037818786146539929601242231002711581405486820644680850784170587748274727587420272876091123519334262217437029949037703205407480776416283134452230781117097448242129749881153162076711747133559907953426068133477745797508114705067446453522799567757785963702246533465219640771259092151622569376465421008310791301833414957
+
+(- 10367142604728811799331249565431331488313655422005202933702176605382043644320209814639311439871418581341534233560256605231366966869093495784665834232350567124110194965198962966795893926025854156729633358240069116588609932539289897499402463770167927610848388138020589286461244557962368497723086593344721146859584146431437967506007518396464517349944129896971137720357645026281243138165214047233258394590454775153944241555543594427555914116439316287902470043292624597940465373006598913770411505099332700167695871387948271302951230983772351549087620538875967635100644404345317626621438913980275970160864401622986870735123 -13323117602411502623386235160326625769048477819798659261203460002048250420188223753407093545503703207645050883770850457071863684414849353264890601744588860687970804808452855795406182324143949747985869939791374195222513169904228914579995165180964917538177994190229733465224857616114628815752065632238207474599531507602861647623695058640735949593381112671690796335596142010430124683781417828023076027476816068202219709673411776556090962187853799456968290579708094595903778622705850818245685205707447012659247018940946510378371952655457988959551256869060428488498330109152756599450626641948447980234503249330875085656261)
+23690260207140314422717484725757957257362133241803862194905636607430294064508433568046404985375121788986585117331107062303230651283942849049556435976939427812080999773651818762202076250169803904715503298031443311811123102443518812079397628951132845149026382328250322751686102174076997313475152225582928621459115654034299615129702577037200466943325242568661934055953787036711367821946631875256334422067270843356163951228955370983646876304293115744870760623000719193844243995712449732016096710806779712826942890328894781681323183639230340508638877407936396123598974513498074226072065555928723950395367650953861956391384
+
+(- -25321281404861286799950777949097462701962113587443565138655462269365151737118518315058035825695270231347401755128007072923189452859397209062457461602335603630181865680063451525170253746137368267674863889514153713728814272332433431604233690200451816570240227260445028630591376891139306370205846627093813889699170594185178241812081296510140572331372738998993116117098817936927692238682202717231675283209016857095739468507690090676681400453024293870135659990528969837132054786661560150259115734877162158755858653364070279937027014730947342216816307219127474721622123875699701715404820384545693058511056735799834754890692 -15870257059811626693754498423136372480069134596343998984549199283973854570508228359295418026089909378687774627821225399931314225867711515277913855368473873536462450935842786002269065816311054834857109074848803122494252885020527074586145467185882674518032764708782999568002770206995683800833252068328835778749976046128872525287656002968632147457840467536682726059599593635219947081138082647985895437016641903078766878782632503812736486529143041369932038649270950453231711525943737962179463585338023463992816994328519710963267459007592689204838965317062070771191372220277256094361390952025057574056586665509010902583686)
+-9451024345049660106196279525961090221892978991099566154106262985391297166610289955762617799605360852659627127306781672991875226991685693784543606233861730093719414744220665522901187929826313432817754814665350591234561387311906357018088223014569142052207462551662029062588606684143622569372594558764978110949194548056305716524425293541508424873532271462310390057499224301707745157544120069245779846192374954016972589725057586863944913923881252500203621341258019383900343260717822188079652149539138694763041659035550568973759555723354653011977341902065403950430751655422445621043429432520635484454470070290823852307006
+
+(- -10064759312484387184876313010284016458560725440641239737323234767636591183611201479885347260175161165340917225306019885202675573016295152797559983194160634880140345743489989007821872426587698574795394887035658449467358615185057180305109018898637903449135520486663185036663238956537895356325733583128141439025002140924158670346599492383552938312402521066705186885506193758499006001382444818328802338159713646715901977137011576113434170842422373328479181457354927400927267448788528116619711184792932525071391797130057189079431487557270366699175956757661488296856660145077706273571985222726397848614141194988258117115194 -3689074607001776735792882994440038588887963294487080609346609068733026224735369468180206799966728461935654851527895876039403151156669223687679382665269013769686991783531091821265184956524448064027733731862929686596729449196238312997460578818232100254940830907672953344544031914926653652310468671685310332327057444910423081752028857828828473637496272809899061573593874011995802487442092326045415689987885712749026491545159340468151000027397821404233369034594141219014219707193746581364791219277489927025992135462852894714639406751538919395016165215641239054420028872350709704191189169571752512626755385998505584006855)
+-6375684705482610449083430015843977869672762146154159127976625698903564958875832011705140460208432703405262373778124009163272421859625929109880600528891621110453353959958897186556687470063250510767661155172728762870629165988818867307648440080405803194194689578990231692119207041611241704015264911442831106697944696013735588594570634554724464674906248256806125311912319746503203513940352492283386648171827933966875485591852235645283170815024551924245812422760786181913047741594781535254919965515442598045399661667204294364792080805731447304159791542020249242436631272726996569380796053154645335987385808989752533108339
+
+(- -4621513851362114851854472268081584822344822740665629177305004335694395719163541988311496405455186973857145245414214464449674464879082042971313025249648887349614046805778335573547862191522938924075560443632614665169520240664970180760364771373836023824195690134618554368845612471858027311791638881380352344527105480173917778084361560336490212845414303819150625355111300877737042696291233444311426721588476948565949641149735838580313236869041013210454558557732497012037162735013212361842433337324577522358968152852532145622765032318936569346015498130151789662274686368870963891262060214274101000058555635785833724062234 20283847238128227963042817384468009365120280641032764409860857066215336820785816567924217697745867082423864450685360959383940995237907453126362378908108545669654749698030305432673477271848544313029448526561606175059997663752601262173667861202924953502866611309434183496911206954880840674239880495147451496219568787221129244201657487090244435562896841733049066453539864301122516559479757096183362477594406691085946787803323712522074578611082872627361465163804239673539339633332349145205596371287028267780080937728455742966681547897652607170788637996317683436193829274172400558140357237480809582038468874094877651383053)
+-24905361089490342814897289652549594187465103381698393587165861401909732539949358556235714103201054056281009696099575423833615460116989496097675404157757433019268796503808641006221339463371483237105008970194220840229517904417571442934032632576760977327062301444052737865756819426738867986031519376527803840746674267395047022286019047426734648408311145552199691808651165178859559255770990540494789199182883639651896428953059551102387815480123885837816023721536736685576502368345561507048029708611605790139049090580987888589446580216589176516804136126469473098468515643043364449402417451754910582097024509880711375445287
+
+; ---- Test von * ---
+
+(* -1412797070596191471 -15492755620416346417)
+21888119755986895161222137392796809407
+
+(* 16686841096925954110 1491135775021813104)
+24882345731730524499708005167300657440
+
+(* 13262412958100188045 -18379071970155621919)
+-243750842254847872704698616507823758355
+
+(* 889503034794263569 -16600674457216690894)
+-14766350309325860687849239111838240686
+
+(* 3148165694020236318 -11771070679825280729)
+-37057280896113409834434531491271315822
+
+(* -4443818546267181727 -12001052312087213799)
+53330498839175802532024121011435050873
+
+(* 8305259347214213793 -229351169208067535459370186456659711595)
+-1904820941859811670566233132773219565154696335396051029835
+
+(* -18273334758510166901 290047155020180552782039318570071650475)
+-5300128759437251944808204783222405076790289915320785927975
+
+(* -703280433697652940 91110448009482115063492795153459771021)
+-64076195390496041906141380919369524419358692517527451740
+
+(* 15279634596127882146 -220998726467849290098339792307263567896)
+-3376779786638352686104608499923871317791563686466157184816
+
+(* -4472497681184076830 325612942672822430032905460436166528379)
+-1456303131067722058341139305566346079551678140995111358570
+
+(* -6180420673489141029 -161157288800853703711204405567379740552)
+996019839388256252540244286609069684717518686623358308008
+
+(* 14044956603588468379 10163190459901171254101452124764637970005230126310661589196828892266636678427020930101076689732526935899135126391465178494895371156141265424428405590113790)
+142741568963316278148132287599703960511135825069792278910440475692913696263448088587778211787403889397993501704943449376875999977937418748662459138952952917221024170426846410
+
+(* 2133283347509865817 10577710515843519541178984366353275630877942729579274295972091544607384358263130633386329706527832990861547566574369528634541156662300858851752195966167381)
+22565253698228972909216255630133478029433774404794962869038558824053350969301054394347471181756471783852326407546652836376109109470959746153989521923555764579738243072315277
+
+(* 7812722507014599311 -5055959518947106416800910724733658104378582281318226107212861190073091017493970778425583956006925004399967175604321778956828368132273155364830637407968648)
+-39500808728232764770485117356353304373275127104839804121600969932458363071148383405901570717732548020267052999198017578112731079638156026910705662052515278317807704170401528
+
+(* -17560801708050275829 9842515227842383346577123873881045824143545509071137371075701856197189100217561683579562062872293951325890789283651221922663521213150065638405410634222129)
+-172842458224605375239887212582262805312641302639067963604956593404910080268476692854082531021580381176489626536608405283010496488558204787140272050713264572452317265305619941
+
+(* 16743386830114877156 7347065846171565625701636575261347705942035850951855454324853850791855951431141198155170102434274509450315416946729031216385536668189501958761688618635668)
+123014765528775807847206414290825117502032199391400884957413813554539073118943905948723779020186281150198999824020769031248882909461419778092564985979904308229718874140000208
+
+(* 12697192948029671719 -11416780209809507417142822520376617951137069007568339428552592261458272400645205700952156716454820410468812274673183389934216970221062627926131479014990611)
+-144961061169197993494569769162151457365959287966302572862364500950127981616038900865036521107816831702945678695331078399461327412574397914795455218447174498277798426197230309
+
+(* 17005139720743105479 -29990519259587469661876904501488342396062731024702923152492275204626478246142153608222329335341363164148761307659972897552084842238285026253664841395295138667328930482145590159132144957515157474957872335043653264146346772142483721767458961320947069718037828473530001033848282453826154763424789967441239969918856795769965946388666154136004597297855416503729657013008165049478441197537144135384444157408972370236442813734429031404855591324183846423588871065272526864866155918285777640819778251612915859290336548446745308788013234099839998683451658620461972798204104633072664604846231692505409653434538208644416538994256)
+-509992970306921990341332390474393215554862069848994183152714032617297815196921655222705396130464246880845576204295466273071779248718654338767559016551390771145212884412809612574391658668778295682412755916528976282396155832617323980694289208942491001345059122414240884660276842648466533488559879226195446807748573906940273568334343093922652142252689341425941673567630236228358747411926991658260241924294146562230425295426217833820067881064577380516936937782688004146531121831211284735538742160763820814174631414364095096099434285754767091040812242751724012532803037860394426031234340719537172735695313262283511554154662650333168783128624
+
+(* -15877530153400521290 27863984127681242643954505352420303514833683768731313003271701952957204538094398204984051331105594788039352443762851136101330385230866919393696564428736685568762923746771275677491379334452751710169529933675128178840986001684425353245791752781476028565228371147542431713985092322787978914276414008774443194161599919167210582437024618824616489802661351916633993681556274980075051797120207655478780052593534285265078265845445633803877185868676955831374479850746658711791169579387317321983669227930929736238215792068273805543745311609083833407544342964285215427999724272264458975101474080574470499647168865409458531868592)
+-442411248181132450919255517905812929771246981404050821923231762557171158858876183536414772404562764742655092127161703706239729646027465795612501446223663310668879007072125975886873343449629108246953385822769744013416908613100114754904323190537317463286500657291202287742354250227377164455244103312266617146454847578457073139633297517170508179596166314955134347046515455569689877574427319658085169791949003021426613961459610227430636932814700361914589752207776142403364490846294795496119883683491811246550808038342285518518431538295199537270236275774546666026424361019715280652576803278928827199810150387207105149968313623040090578323680
+
+(* -14162897687527555611 -23016403916121951319848021112075986869602408568431399211927062304968548663313037929311574133954267816204873252195499803324830278637331653769648377216095499136975244697758388851688873078022850203685120154634090802825656419418077380419130449990938627982123188424119187922828250625318327074513352279785514062876718714640725789938556578327139793467832731546881422469843509318627826856881082450937188956068348931459011923844607158528494902828851692203126881727638511348944908726926619613375594042390434147948508706733126737304560579515324106834237197081860910657003346633962662773394999353766192391746258372744063777808796)
+325978973798843759388794644178802841408656469654887121096165875654577046313115917671847505813174070119516580105483409446057747653173640660143855580491229746795572929387698247460831363721394707501497262525550824977473864621747159715947297817600227665840640555029633517390896890601028716769035575763283168066843141870124768085499453574902575378368669494153555135898430469356384416638130459557518713454927909937610851489821263029886989981438507377741962130296498574556444168140838201069779040087521405032426995145166201901368032136008107323350679784004016321425234898132080844200202007395427054392280809376612533414505539109579739614954356
+
+(* 10844738523441551664 13010289169828379103330191247192587220592807931898339555723704078985668371901953113936581573750666143303899278973814509164982887504269303358034042953769514772858989849512527461308415676004712388964136857232374888643347097138114199889581495448978914022318770898259317738823514820591042321773469959130347470144905381758960436645008051488666423115693738341045851119808222048272924385188356021826450267608127588500233526688704136268009202730309974485584784539415807259862449203760469406037505772435323036790641520939576046423540699016607317147689982042035523118533555744274806239272109508745089640043900389441390176681340)
+141093184161152226992592021994885140117836445291515772908453669279294934817987511015413332614094493905560980363483549300117114491702466085602279965168041684355125886388302948336158133555051817733078300668260616983283027038746214728386770752826764135491650323133831923154477800324207350667020747545837613879364064704092093040155243919335078139087599906324684688427176309081290932504214653249366429592335409761783188358003723753633106574740731573467850133547164922532633897844647383889253777956821171583261238607289172489135768839436605233457738153233579088224808850428203888700116300637190661108848906846940291749737998056247719674749760
+
+(* -16402132873169057380 8202725117980211375579199554494319645475746305836527475507064811368616698686329266053570766100878145903342129595869654087772486685252653587846560946850102095086896668181099435964053041678323706849735936082196618754721606824996486473796843333331029865501790248862590712245450877098960007272754260813822886287008295409755783478345202299352891066800825979067590290793893933819913530599309037639082839491869155044147367415785329077864525961799400923643936705317921900308490987828345313709179960659814100113658528990241758360711799009722683007157350272749544178688961738222930753008443755881419398858537860612954576778456)
+-134542187307192759584182063854799850608007421111316277594191532129597970622559949723743396309231347084450105499455916612009290113746722460358793168839937004812915757145655285798961178877391232945062437277255128401572171216279188126380587081673725314534095093062983435026047851041796084651601813918099532876684901239903769891552275465470747567830660442193995685219383258617057944010709906130655663966913354414611799232001438943448374556294933488875450563987147224709383408815994320229340710143082135667640802837699940654151297907451396297241124380508001357553893328703788960812706653503939250831164194874527033594779746890593262611805280
+
+(* -12094905083549825231 -7303327854122277566083382629094740392048421584433028903125893639493993705575691832165314461496849401726460344615713884253150283931509897329926825128629833541892164122168618243719393446304446866677253728405617434021389128710195093788280203239300086905325641224801020413858421914412156234316517981228056539721130386645649016559425091470643854813419057026759188125291655398451427686659900364573485593902992038773538760663063071699966278379037038361219424927031644750173900916227834573604566165762753650347331082640552394430002401423199016978155236550541225512734287851807727860645247391524620773399994302380387697957581)
+88333057189654571362020288527489792875655269960629008914349561689924145109953656394378545526256758871407020025766992398117775520525507898420898102744530402370720932219749861094609497366188371774072368034971851022164946370916317410415503705484491514312339956381120953283812334833067601825812118392757289250628861166579446800637104996060739031010579056633535166403083327528575504427815713481850979373113173151813491831551023902022537957860211597622343157802805275942920911544696695931809085743355666792408029743911424760065578742910735408262758198787195579745280191859776661700139596074108035867940154338953640690242795671183308201526211
+
+(* -81618231044418675360403541307856740187 9751573706924018395)
+-795906195858402819552264165081526765614024708979523739865
+
+(* -167600745660011044249531125104202473984 -12960244919927910377)
+2172146712516287908809731894157839567367040369214826131968
+
+(* 90306383312124738690336097936949488486 156109477991590792)
+14097682358164298866835386043901377722456291173827620912
+
+(* 126202800261728727198105694812165074067 -17404362862588500316)
+-2196479330029905727399352310201914876903532806486592905172
+
+(* -80093647977875266525946940496137725572 -9499399805878278852)
+760841584053111508349403804472960020663660465509267203344
+
+(* 304052889577333477963637861956318521374 7233536405885618691)
+2199377646072361697737485358722028853038393128548297401434
+
+(* -124787646062877233829165925777950698937 -125798384154373172164515376683173327013)
+15698084237137783175768362160964949930745617334715009097620154581879012485181
+
+(* 259623502197082370239517374851053110076 307089583871541575627915295134832918432)
+79727673252974285068387698133566605944659309374400074880377824560177225320832
+
+(* -245358177397026033963771466683003477163 -285087883756432161967673595037725276963)
+69948643556453419103498093570621669430956866597291662675473644085666220495969
+
+(* 46731711386059374483493216849082745840 -216522280665540473581476116002923812173)
+-10118456728713381305690589407461434638634240429858378588644634276171257110320
+
+(* -301422430661955757433852743238845048860 -737194742467573013847855072675441356)
+222207031145790358162820429948896977201848379524899474475604149595884654160
+
+(* 109781582310220385246795023904554278713 -273317662617851276579672019029762858338)
+-30005245475518685175699313262818315773200953201653075289648004177366787958994
+
+(* -312236719893391897821327608828679767006 -661158307192284418474080017860142217763949256471548515134335997907628404839044913830388499435166012788226998900468665646723366842553747501004752506346280)
+206437901167986463762021023207669068873036145952740267172145693855475451354717023377588805030022300923600718715029262618794758202955817341818233889201852381575043965927328029955969846754837680
+
+(* -134379788461141842858846278268259347105 -5535479645589936472405910397299739073641612836770238183712206042659632410776896398062277742229906915852933418684231779996404071421767274180368154310128427)
+743856583805332082970350662728998610690268824090148728726850517499798631519601137183443104910590855501252539324674812560702657332874686395923181633958702249128106139207076314713649515720653835
+
+(* 278271843790644800793473851247546123375 -3845690285506025443856370771250487683891303505653819308540635173436088084480277686684743918745832832765066355874381847690771330587033980524869033600561589)
+-1070147326395532917564114389205677334125034378502074943828571411806344559859053091006175486397820822872698474899835730026158782698085673635033947150554253148685482702599776833910878579880042875
+
+(* 22345490710865165412267189692679994671 -13168094845644809414256057134926669929759930873747535851687323456073141938879368460977723280750841588750507348317544461824280674332488497533955177541413394)
+-294247541053147552931885013427268298282376074124656716577088212043667912662239091316191145352314750820026626159649861330384837204227899202392764926604802655267738710003310052268554637728023374
+
+(* -223445051950608517881717261787296926498 -2609806601119499724524852022247741111662431776874117401343811680374867931883996125145979162937751368655661775097445043144114599069842524778189198926688379)
+583148371568187658089071213924575304457465978545376486297236105670932990897420147110485946155066725440999079357995678147717407410446012970360780626554347417807723098476525833332400212113766742
+
+(* 12604140228725912459681435851589379433 10671266866958584640992033560488052420339425977492420594983497264069815016478448589306666811246532193922229713077112601565462530332258877522384022088660628)
+134502144009302626262781543880199144227907004673612064586081220538754991037447647926963488301214672345398823354945333417956344119228084327815583754032364976497975702972112644238248704660063924
+
+(* -221289678591114384943252477126208006780 20020996887149770966522122735176842174467884990518978494604707026520269232864200848420530223248762875769520715632742683760311747174524709550334825291720803698613541109690224185041740294906022358446325921538593105347423518731748623037078340006459454656405997570119591344894717789372844612253617591807770017562530034107842444403952657949565007792107071767260484233194674888488789619319597151367813735192433631007526015463229060702510632792171187339118004038505860316305860704455466207113207893106982258864355430481457640304138738182009363353560090082819036973601710432437342931523433079941958203038050750205966472435692)
+-4430439966231074415853738608900692925851705818190624801199561884242897308817127146763274284287396980593383317678766559004881552228480591814939402896201244425805503258878061459604511214900528594870260206969839682573246490602076070316760182753341371682323914671418233629420599310422437691170629449435494697829163966912842611408632129590129483811802031178053300073562716917597174161526976287351465154825036851645956354853960835948518860624747958440181683978083391663149733813297698623499283645627889274004656942800842013709298338912226207338477579862672216831422765369078886850523202897989792734789430796029206661261129141144642117177625405158700499049991760
+
+(* 180785619668676509441152734583033930295 -11909038209406834057075682058438206007134213485822042209417443270921391661498900475635417780140585878716264253792335317341527677051828500780153492153490249297998660274828986996948999762620400587091118252205695562417522111840305140989214300921122857271717052213225664738544344394774362885331856170636862181712515248810239601812262573113794334115259873527539564296101166439562124016438281173202196876398090029995104489712272260608848551754611421227761245487365953257890749115194455096508613617028024932657498899001119282498614739316599704645009607294747043489655424155986912576002393048535846081096337705941547991821928)
+-2152982852345560218506186041143281789706715672110278207735389192913214838321097754496849942223194392302524369156102301165660674797665128931611291246607346536492650554391248756408556789391955568308599431054809433808337036546281323840555452571430884302696950144068129601527530304907460164571704857360215834011779559395577299313379666503707563751314135201994045874159291100986903645360754621200008830207429980872071814202801994486961737459218017354210479544121100423399040398021780750351097082070296255480707530391964970754186799748521538525274241709676878827522138880241734356460339681718690408853314007343934035505873192699052380699509877559455199604508760
+
+(* -196121729286794751535600080816329923561 31755463535476988506639447113088283661031267977524968610501132544098607201258848456920865390506381665724254592728643925608893982794532243733117636645689751360224314774452374503339856173343683819017479955914451013484169313685311530532055735999039466721411777061709328450052490025363788971916050033904534189719389237878257877112162843506491071470067738867693853480174965212750301808781573369342701195147083717623066339671595077736036738235636996351642097684597005928843274525502529735435418805821748637387888409663397547514467435322454217015563134545731593492200855670248739786405074231658957946422903165662016649229286)
+-6227936422881500100190187768375947805694946596622670066116457374856427496311253030141271922822486386675428302332027411428470488965226898801659352566022706152307022438261392466548357753526474097246042956052374187605144719189465046544498482461077851578811186829094445089366592317045580466302238653533114619908864036973070346979261546801894831273337217021756025770590122176562027129481076270727248949609326868225755958667670279949371399535144788247565199415296122873444199709788941984099349149684384486618280260678252604631431089580057102263617056951788273430713908768738965854953667135156866028646584137788146112300214498814212865170902491169332389942607446
+
+(* -149247491509558553673630984739524508601 -9241905448313719916485289537122695595500213295294799660583133638026091750542612875183284894676615989153030773719811347110864468582634048542108726080717551794580656021381515769591713295631818532114918070215760259364277583650102628486861397602958930509695263902920994329409932518607260720657755504091822028630927071374796474717671220452208310602827254296323761245420486376569048549643478954846020045263141546849795367522490793641049509748005893155533480849922847230018411440739584477452313387881413141538766185123978087175960946255649923135634987656065468774634483495944248865774633962770893338531522570776854773975281)
+1379331204929344851843348280532786532350930013132149419346606977890849868537539899667631713548510207947097949976792337278764045110931774279794402312944786743575421497528669859045492875676005849752425421867514661792129580445000023570590786705609341859529483054902802038173138834528021423393677908655442991197348183257271932188161681770513283703502340499171444058119260228931558784004778969491586252899270869275893402714040693571919281494643765571068045362364213060063345212881008657925426024923296369533374671614852576576041747836643356665301762059898161073609265572267138950725010661453917338098901465732991316661901878681888138048552901254914604845891881
+
+(* -246070233154436622785727814428081917418 29761582253452470642591719346200231425423204062498655510037025199574178834762931489817919404889920159374886981199608181795387339523762458361385170203883094308920011218315748466148953320570427838912637152446837553950810011344492780712558515815917745810385725989241835877316836808088478276603934260581342710503593237081689944686263274319354100341139245512159619947319496638082702549196795236216458749363904150768879765280332386830831409591769966706351022328535490587838695167807967607003680703048770719240872629379640571077329748828739281770075441660330884779539288220944313294762143588847790653176774089774033399559617)
+-7323439484151992757431054484912931979861244043627630118213112440051387392428853497035249623931234821362770902740177541812170377563064854590834087655133962963430877452052749127605572395112726398103244974178157574726551814002744001021805127518246639418981066588073652668879613252372759895389345727455380224104332342029151667860553645106555190741775758687650292791318963679857313030729683299101577207875499929500963723267185390425716927303375831321783415003339099100562942730763231688479910689887284950156875532151104047755803876078837921949287811575034368641167438367411569736575067233548122814012421044943430647665260439418887639347030312118291762161708906
+
+(* 203826295936164259559522643510940430939 428315860474710981601019542870649234168732095026625500771233691514247613083810271191136212287636290276352210600151884730196161003906066671915478570992925366265552107746965374246537358349673161970290367972281768471743836339191023211359427335141701167253694144280251188008871929010775436125645541749886873478179599464478734149706121117222690271210887178499620737860802605991262799781279373870647695125320153193063528861104479576369448865373971847676465682752435142074973627172566791961541105525781297462635428308325033717669972726101583722868689418677558787287897456521530400671342257419067050354522203242849353639864)
+87302035331271280954456598486072605056704393103691656908943847729634903654600322194677794243221825233700566108459784062758955025931450719283517278054268553004951352280583820782976072352456972931479389375165173986780482062859853305469143408707179895843295115510597584169486406323435925707638987591151227843652210256611991940374072593149367903739596883229844326054223707236369465710416960023659329202073724249764308867733476242261506975691004092043954515337899900837434270833782490145948781128533218641649564543508314976001614187701395586824982250794852925954991265270537649691628899148413763865280007928191637215283244406869662872539567459561720369352296
+
+(* -5899540498246269366107488541138263797694914692322476860852796858749106720144552037986906792251681094769894732746138541066810195167688318229720888479512583 5834015210744942902)
+-34418009003174534626858248456163154666511779871358190892629413477534042866009573638264296461516598238780495750056279721797403178867717911762916049857737963922333901125535866
+
+(* -7558198374656605586076446665394545534375963428962439959101805545423930654069723860456022097647139432324162475685494459942871728608277717748075653794546685 -2079670855873590264)
+15718564882684481784074014915267371190416032453294568239793060140651422710113447422494938907375595456199203928496644205320139985222135619659630853564447794621716315309474840
+
+(* -9442744083812363570102321552182535031605446031706376100893354933468482520577272174689455502380973733378565213055641110431767353396963744600184737808983381 -7204974197101757391)
+68034727473703353914019458883709211780958983263702756416891835054494728840771498925306650413027883039860202168095834137357212487561983607389479135319040711944281262212918971
+
+(* -10658732210276096534851972646242288663170038580488752611749460640657411087860047053151548660331707024718100598181073744715506934778234716535781332588396176 9193953347013373121)
+-97995886679587166046252015742839992974979220158813197140160489510432960510418039749924861744197553021702396544307690217470606424904065359660871469041838900287446937257585296
+
+(* 3330096979672637104536573277593029682675932033891010715180474877149733802060455951241981993421466123791200840797318740359792251505430948855600408060492000 -9413190658845804679)
+-31346837782105095097578725347257193539696338226258990009265748336528353873277500144838721882313026604404426563737656928378230261942407473822851842589487713775609448642068000
+
+(* 2224201331350479188470378485954814766783857696988331736807430786504130570570323948774102396158334805040994159865821844362926631687258969480929122732089195 10226747830478556903)
+22746346139936030910929166328517425029735137934434969334578972386859485783192993228082340012742115893176871887387993591191632260444955081663604449277961804869872353878963085
+
+(* -12394770820700925077767705800588617445613665027183406054209162910642613421436080064653443098327137503596792411463268187212855350864330592654862321763110243 336135860956209890623046930607725140868)
+-4166326961171213704571179876442248501325782360170764344978629523457550315208845439497110652079907652744850691289494398473488033083739905461347650605270023127087625641779424751335704552988710924
+
+(* 11792778994619176404079667787533709801900490264171877873621265044313417667869688303207909681289642260521608966405181881416781694320672906600599581862090088 -197661229068721548419113517262926820105)
+-2330975190212228827672814304508257223671550753091700552243633152084831515892056240354560520878171696176381845689952044935988868477421447557890739834031207059212175922089523097911477486879619240
+
+(* 11608994516281296345925963401821217560860934641820086911326880657644311461955556832927259499969983808078591149768068360172431078248807463030805586293656663 -40654941048774156019243747229920736005)
+-471962987694958552110784676392477007070112288398143925079396435246284471999814508543057304008480666763661066976653446723271982094424149279649226771823800871458389214002872916339341019732251315
+
+(* 4821517917539756801293776911844480642406562140007084392649374723119190602353617113036081438891134008988421494142194891002983491670246762173236312873933599 -255528396376819316172341014108564420589)
+-1232034741571035406264710387186737842510579499938716343220834781077329515145216794636313459582844773420679078031627466542930137302257934575129329529129776153159694412903937370462708576694469811
+
+(* 7638751115643228563298483305056828584775811590562130101723525925933790010789130133831569153863129513189315440899053288261039147463032870669035935364282061 114438828287750304954799140618669114911)
+874169727255956505920153418854946321208907128396839975975317705220623267360648189969313978740314703015845506506608054761304647627635292132043887080298168302864314697920637105700927041824911571
+
+(* -3653826017463740005170218884285271512636869606149686475539243914909566619638259666405831445823138528809165270360144267462878986866506114069923299116957450 215752050445782448772085819939961259625)
+-788320455239949216234629350585027855111249573063377172522422069903710014529292638311216050777840734448624510386643245486023092483841464815987597578151663227035102742664709136512524899527956250
+
+(* -43242564273985683175827997542883970694363047476880657467026050730764924897992516355909421962249292250047896135687573746158665836208681548975073555418266 4424346097667245771102179669235543742385176589624011161914909311078645828684936231569739522607200308028372644149306431599085361996722603718517735348761218)
+-191320070498733614136284309000213964486426347688040889144514933290125387693498098446328694172047943298442181705949005984031677324306763731212307716485454004382079159622650481983102917517993601466178931324415483972311904823997211920702201161092866663969163567426868740120661073974542958600768774774949607988
+
+(* -5093597555679260616199210906198149266592665304134802327659606846977583233938836318559188141955851256260954289429418183711191354912372372976165948043123133 -2240632735861652612028397136046974907251405868353380459030143407902436514978447480884513019736738955326732458088791830752499716417751919868492224207936623)
+11412881426559848135724717164530530041659963797467536748076144863846600718211858527283843975968920120508569299672573958424908957105703597501013710262110218780710678312197455759181436286391257283676806548463507528765947919856827004176416634630489598937924092540289712219714362500246928243091408698274649199859
+
+(* 6049789822056553589237940133475342650218069231558204589924996117723031491205673061674252841792149409384720347601549237626288416453061224734057079515141650 -826416247951451524584060567988229017033981218652490450160817307801130685352465013890931297548015267655971295627931896259998420078888499206031390299169584)
+-4999644605638856588581238481465237523157457201817697008198975191261856978252081380810200468420738807464233192102972784271159116426108806200426852134469939032473362689081653859652824862066224063273799612269941254948709760659691148103622071316554194507524610166457990087959160807415102946877307193349131573600
+
+(* -1175978338162966145239180473229656000174129248706173549637767835154921467129547950144109700900405904250603515318348888619371004435353505449762899046094747 8633693716102199391202401198009047492431980605560930404972542822133579985462906768067706391388213605203282586546130434156768523403030127356256666478340720)
+-10153036788469908062299722391986722149392791936544969945546931764708792252481931153733789787389051773529081688846141949513463792442701686406966696738286561777611293604311491896230769507535896070984747493738525389837795316954065260075941524322954935690803870500012809797698319359975893462672845329776468197840
+
+(* -5083395547684319640767882199938390155755986838939007846911062687871291096073452055061784159768637502151635665247461348347470360218957222873087414506633886 10813098236568616588240471432239693891825284805405416395976866126102880121934298269375465735278296789484402954117593716698067735458182402220278016922449294)
+-54967255432446073625448401244836956268872685687128644401372608170106281377801209665004925733448944141633739594240156882328181133879414641109484442890809130544146420476457200729843868300396656004198615619691952536924980482714767859804902602805398865249514544806725162402291122143659939645240358379962457176484
+
+(* -8944626200084865988157251013718979706166428261352840753194709093968177704853157211364231059892647813839391802007588961807572842923682104089512428902387812 3814836951264415657788614449012480613328314590744410079075164918748648723114236698412482309581077603776489883375576245233128800002373843611668945838558629)
+-34122290543331565327874124324135450224668275222811493728051290368641401807963502623692504750924543845019291736982354932620821594287780848608647686402233097059022704206628297180782771812500512744911371653368388270442874670230118309469599458827222162362901084328510647514081302476000779049412605744638457029748
+
+(* 5186176030253526423885531264483408352469356233262336223619904269047786350470477526433506158542551137478071074193659876898065998079440819597952826155782068 21428324964794197485898135923805540163916541943812058590308650649384013587098638034673796533027113673143959572855470411726978105342739938341516634354246514986124789451866589211982659199267654387148420461876524076040233779391563396552267276880650559148637067641021059664960876301072636635299261389450890094318429077561092553337025096293793433968243940381587994428364726938534453507046761494257538813861046058298873206568935790790373886840765817404479239485444563488020955730741209738203470138117422899051269778988135668626686262669881048094388220931264751830393793846372816717368806996496715219806062282836392457741918)
+111131065300898907482632501071313138589398597291097276435916516379173430095773463468344138866282820740991088290299992221985607057347883717514843661030457396422379155394966857856069231504805779448809986906434617741485942621643754096548512120178021034054648207248963478122178145159262707381679354401629366698488021743300737044695960363216253889163551918513521913593214414139637549577618641974388739304727218804595402055185824193445089425262833385286117064481648652550355832014346131722965510192584901901111154083186713580209077544982897821477349293279848852596241762198202012197892321827305803333334823616660229870976569043453639028059771892706354703750763908127611939169337399882784092285804830644630059487027413697220038110815990084742241055099963659761569486906596326424
+
+(* -12615422028124847936088012564413126213419674293830655240645918456932358053670311316461359727921727680491520480380615359506308571290338231702217134487397730 21538722931308708400287621200994476771789912594554241036641406577761480056366647329031140922034590767810855360008375309986798226712928670905618807986829790199948665185268081173685941421700542631395958882077936923141152528333121096909688700106365468854487023847026564219531968849793109908193037522063952753477768381591929787242143631287330811801315216116212154423972654430356675401769729358415036943501470085182304183033246682446978634892995900678975109490698283226559860736462409705544079080978470202336645384768211440438501339641775269445439018148409151795830925198162301321965042997632479354427154223366199106583051)
+-271720079725309675925162538296715595434811519956795637977932956405490708202732964133816538801099235844279338645471102896234318181092598033040518838847055114923365599862266767493227393553801736813141780001130539648588341196802606083178208108557367013886856183999712817955194261262279080641101769944037282423238147653270651419282545398168930625797556638625301898893565965773914460998322350526545278664715332414172614761548301364063397364632709194713561073496860524124460861314674679928692398440036071116570829193414179054372604203478369755566003622621281005164747628075596444178089558747835994702060740334079222508147598079351187013336751322569865313532407367116553748939535664259669808534100091049960040092785009707220249025633808590643620557093069849490009472441113874230
+
+(* 10381022953674450046578890619826448644067144294659610359943634722044183130638243233110364436029778310048006743033299956844491228999113516347401915490861208 -20974871685432829994714153210121536409377362402944992609230062091789259307033495284524234519701670462495676590513192861649457148897274608767543942797542628100823017887236899471151903799837558453043431373811892813126194662218472834650841742305925226558315372771353677064933578639099452438843500601586038910108679737480263349221244638463171088589123712367802373159421798288708123925853179931628847579314900787361946716531755600236755527982132768286927549323465697241340003870259800347640599467922823203446834792229595507968354687630029075884034263531531423883902851487995214646322431057626558858528344843531280263328354)
+-217740624416854507100100919338835880277259264187442792458843251425095703739537223785767883764746809214920580060316177442387941385712712426957388995082877226019966428812240179251716274377143798847348759498926420314709056615470455134468678662646006408843897699718742372199854223008996321568642038054564397441209859567556502098420151667437837356649730396360374136203172669776530655738388121236079327354422138744456395348910073462618440421257604563050031602590345028438897601523520973759458890228893913090702884911857207117714231568437403212806578764580006787626657709435954760239671948147344463295520930250155876010414461245194991189183956653772752290656063730950237649394743456230607077768595983629559996700837383822873994717987698780007691157576205450973669241823945091632
+
+(* -3984492646329789478973994496812455855595578196959138558282015917391108383154917581748539892089090551298072688793487597623310815918942283997753800645644511 22199897116873160263914990610762123553075230334116099569358672964060004245706770678771431369917479502828754815568950371273785689812698287446020480951417047185190067265849637510591502642000414540862689426343523077229502494771352820057572619644085930901096534031496492870227890836816886496090287321502805172125273822231241073590840684742085641304915656543831190976008986490532066597410386596132766422026234488163435487889876791504407434387555507637783709991326338482319227500686541368087892665100076351075069628862376686619537655838590687615291898971286325099164241688147975845320979841704002364545072665891829427213069)
+-88455326811459002089798581395024759975871889172872668466370443703433800509268320055453743803627754859670391415348970278548381190662701716228279482045339649051139909543850883613464992501666524385524517648069873862957915620016943364950043289963237718026629805297916194484838158010754666017024585366330526135823515744339445036315966714684052345462172808299142368905939297220895721123725415007532441824406115746741972351142687017849809593982432484296719999502992792447259391592152463664807498752410740679664044620898308783634092355737296495489953554685938970593890496829484673393665321572846542839714620847185428664388282452532264810310019327395691530430185946743995669191791841546685206884247468693248673484055915613115527492005264289557719000245333079386593840592027314259
+
+(* -10672574004830373997900438516438419278676753890756925443116289034080220708922677740383425352837266631691319394850521121221541344600832530724104047804922665 -7307684417326792807224298894786988180161884427390942431653062127076829842696634441114228528164049031680536693195116703321494895319862805505304314401000204515985676763063862569446064343853536464020413910728442475032187317639476018710375702206456631041987826826225461927793241495220512935434301833094232834266749666697332380140380619185254354273073522191066457437931022783436360434167505326773192959291779779370530770935758482422581712556111319611455306383173529090289274267200543081481693078804068524057891845603351773722737987393428313340760607600482724483853560340630587029610437280601010173185018227638972500038072)
+77991802747865927212086621295493124451256238920588746597961055391511562690441964216934615500942858653797884925704270904527938466874924049039962754703188019915846345804228044693122758075602494985337649496117180241872910247079655077012999375809878184011356481981590430241786534827516536543734645410817621964035091467871491521760928486006653992134635010794346993161329777270345449763927429735191213854873362673179799811714902439637861750855639857969259787075469241319618538795721956528400353086156169058060112255274542232054021662809196965752800525093125763127895334967094763817500702626282397394521201385439419885607578137159972521677923972708827090645776826953976605193554447841693259586575931864396484621463004541561908426383260772786784541411548146173991869741515701880
+
+(* 1420855003086789510813111205540636553863493314684153860389816109865085846062678305775289632805233481596171530412925552158799875183492757047174905459819169 13897739053062356545217161606361735964779941697726983959749295377836209520566715597422965426908191354971972501742952706730523748574796773473606175934144970768662226027157110240776527834790487577863781140089347362129598158760833470434895693782503529955845076709376071972727346128409008293671217324995682020009675316075606538241192607139905488719485728099428376369506685875348346231688684483781160648420909364963718027571565217314827671844485031440079254478598236877074793221578612249882886835580737423192061550370069895525711885220268707201966615936769696379335772521903910689934596134239331592980694745008817040569590)
+19746672065138309742065153069587996891492444461032276894328314121573439684229636534026409362850111716212254549198595854140809664451286626009917828620279583631575940837712663100442879662416765138504151063632823014639305658882804073655537352377258786105147057375069447099908107785635606190515362082317465738205179108333064680370909383338688734129396788764959056886328471374018961975554190739706996184818378586233017775166959010668462907838359485424792026496574369912033757997469014639705459505746723512361959074802456098328538419933637295482429555127226978561859965498424173552676019033370307387047798600024901453757451579262061785051932535359410827170361533603618131510421439128567361259204833501190218719779570258541358012741265599985490513564378203502703406698160470710
+
+(* -25117824099635104147178796272946098711514362630774369209876335291088434247131228189812265510495277875692804180473811834186270331245779845635089547499275113671007257221593872123397418355506777725721168216892830217596134983713752526559153149600553468865338887605949011743043425900799896245185282419637806859906582214420191794114207677635194054239563071023206500505880052007267243210206807805387341085613436600843317096291021780624738422589234020279836961194869688005260369009833026575446099544900581955685627511787510900479881434909308757027825050977932238481841909425598834367032841935054158448815026264505726593064239 7846111496222858966)
+-197077248428250572361351389692146917243277049539013604789802566767174747369897711991559940484392921619974209620152008632450612546796556905740493507885376190913893140368029841033442857949219716681475253727058707723386016055991276120001690579154370788782636181079931076758384034193266737114305362492836167078199155929937891579224024229182935372106924021709421948701131654358516297806197381566809357458374057189773041520552821330635689748583803171230633654728360451100477472934847975252390985102859262992904778849652221553818627134153578436315973777720706502751232660284910468721430874674021521629540714057383398858244828214000543075116874
+
+(* -12000343217458212092754251360179138661969968218789048702097501439124892987400633614429800307263114371624489988815324366411323242909652002510513570900627875514001409309670202055060404640758548257776155562167062337394219073071639153822126554525439988062676648294108951003012550815746564810508912122306190725453386412796036693387315128514162061147675205485143205925649214342646148112549805850530430229663418469577245456944558387628002442451042105749848177325651852669794048215063957689756465788955050513359977166122710392613631703123491357791351447110169966270916789849428298930624807758982400706608788793481972190953569 15463017349709835150)
+-185561515374029078700596518575548896805308728003103939537818954646551372890610870275966055765608887701776880889777402229764948269089126750201922167386201171243298907675542965323275634529293654817279957832652909009385491998537031060285890512199675273422070784691446251899120095880199298512230290860589352290462643231396804350623684034400741386070220057232978556614620855818271117742675632435727751812101639747357642295230273344552327870600519422276996860893842363996198017494117619585153346745838853026029459826407782259598477529242420507010652705302341725948095720110508044256096963772599572721279996322424269691990173052929936294150350
+
+(* 20244597897909303129995907707212050478823487084391413473821544089492035634291726811145005824559631386634261268723753786161463497881725871168747275110149007801865428978596190887145324535224079986377522166727137028753272158887188902047835658826867304220850429481233026043496635847568448251753504834367809877190895369288045026559783632709799678639927825194847005181499299410953860627694080906167346078299421796974815616608326704894611151743720515377248152215241639534004099341398238713597030368980166731393247619511322804984829747216779359780372801101821087516269912916462719248736442644433057333788741151270815989388229 17931151643499274580)
+363008954869078360197158713265773114114991766614027768774402465306840646219477262855625957403406166192075865834283840624408916170935610374573318606346031792128003204902147985329385955814330782527184421959263266167048755628089412213360508944817963403092490479480264538027768728303095523018598016863928762335410109567604756183580676503045557867957273324581082608248341332512325136675167966306268035077761004923732568405295901819511346235524577361289712297365403327125212199451099538443576479787130510546755789504852631291774614010584650672707483555436445926222945298928326313943231688436271883746272589347954697213098866117569339490918820
+
+(* 18134862906191691435095953372467318196853760384894170022863300447691250350836421337333332682828557871096554531436829166444150586004379181099133295174348038948038399079336722004125999533719492457544642570217406286811480006881054375314838605871238868968956868878182133492469763282800195060849734382249696543089869191257451321764806079423169235271658993054867624410589213892458246001270123109841429271429275464249821855221014782727398959126117031823977229309775211695677345378510417534328974531801634095862859684508240122911023047425473036305928743193594967362216559973174709883576295373749738633873828863608550295977368 15082354452174510460)
+273516430292774638949326170314933525797985748367549139070674899956657807928629067317576809269188258819686207094298714770978509118959142516619521080722291318367607601498107007447014759288176261262818034997399866363248136237609824401265450913244758024085739876914482935655100890803279961929047974391299795570244708811454483314898873277493486428279875241232025231140855860469097028388778917980779775554139507550577255217032521719099071084956515691364008526064349956553916033914728254580848198941020806723485184338914882588931083516851849558411503129184026079582257756707601984686901646494090820169212279581209612798749779318126482639269280
+
+(* 19213874382308276075905228027166553836726993832150876980655958901416537033385379180983129528081628446454583401834309285184752924794893846406622935494758142810049493348116192315865522516744262115026742103678965417868790607689989205765793528434388393584537260717130892518011447327847533083474230074174308157934463971640826422302901570010591182715932658037868980053012095115562188975692530473556182305847290196895478280679341869546292639446526021874910117953225154204035612531584978136604161393474554294315903436682283787080297348697922389355209790646124024053098888687638640826064745026930980189268652291562437512941810 3155416591710364359)
+60627778016974262766014671335614995348970065077989108071534610098195400001445248886220725085881796599270026085183075312353388418711598523030563716616967792282609748819081238929738105086199457414615236966895805539596649555457494710621217412773036416007129418290246899690911654008867819945724649185574237527152410775686803449108977881160831441280833577932476667657759420192656716352190871667386955409426879693856001112340390304980532208752863058384169885129364117656404549585836664647784765508649117301622797243353610345828189312360124462238989888436478381583689386509617357901461416012201469794664889076397809504626996523928173064949790
+
+(* -6561903839860415551587224953276060627466820222543175464705113686962550773423611522044145975606965294164125376820288981286542044306677764776675868357117109664125730405280822770267329297542599719353907954399688197248115043785617436343303277493146049939491224480136371029084354063731401026459653680017632996944506546122253686805764620116169065663214526857151412139439538335533979733329962892417175374550305659302592107472151941922230309227785266745974334776462642676959433923828440435340579340133192678341787895007461237846313005612116885419002449356480017828933592324336731295317076205553526568668826499450826560670163 14908715577157091280)
+-97829557993133908713082095435440645457469053259814412551982534425389603663024461131358343104414088618618030154957456050473312402460589893359522167472060177968099538846750606564761307960896264958539903740023783283814849937681270591589750181462708056758506230073751440847913386576449367635057595344744119561166438538811561109125506233466453974371464999669336530949393433719456191822836826214814780222021267726528396849558417851727452246676857867278196266042327956933753121947589485377148388716839519782819642328655117625818256334190717182923260613562191698788004591479576661108985313450029332968584240383859113741485244318702724563478640
+
+(* -10378013547095983701124686671659666242518351347561698092030999302329372512356819420877395264401390796163955327080881297568412490286247154759694714275858127906305200295043241717769593877683535229411640745872559018085757273530771413156968541499388413497221629366848027355125816131586610997516488552323667400115617175682996681969687885201321292153656071894385242141321468096793766926179134511319941715949712230831768643024119693594235207988046511542691719002262040067921088838755337917414526554050602539873232518619281766327369577617796816586064895744680567067970817494102948032924671421242699225194947982378019119315136 30004910492448871409155105619400474385)
+-311391367570036811050052853596227388481520279736812036769684195465110674594690412517879149770622679377262288447706750813509857551308594851067359841826754786725926298013483569424123912020079066150719085450400229896983461212531213110847425940968466564079253939695853896434719530729030897976597410468081535234663568150722646854183317007227669132983719314653861536414057481478039579810285535699518386214012059191958557306338432321511585867535008319640705419431310336566447165302011113284064246284641707577414470505948868362067233709611758700034131461348997580441628136979257037186480770286846026250437141175360847735150981343952303257191661069675154710791360
+
+(* 6311357747888359229575837883366949670125882865462293491587368290797766017168248637163030339387377997726585769250585768079027576213724941259801478313127113803503561717311996500019522893295813684259416551410025111443510215766297835872165689077882298506134885487991732718254835036694083204758447948541157893533099634169589161496492972953698758234452126564385255035294546278732684663873459439615228706684138982066055370429797835904846166362278557095045056472775166294675997320598469599722704075215700819354957397052721573993997624711445698656580401684113096559767093466880001548887739825916626416328760047783071058963451 -212654096583990292869707082365869207538)
+-1342136080095566600483524091094048745061145155430997807005186206704767933140306297188996797343723817220160636373424666345108189275851749622201429179882167381735732553825696482751584102093819432866729465599060815670807282181979889263381844726842751894916887860819210652174987999919869623292751389157233409465756974677789790982740267208982768450215563288024088369480574425410032306456026930809228182100949940216614156925537929648841127727165386031716586596638254705402653861723407930666152691102484352058909219619985877341630210918347460471644327858114815713557305185589162775699323253049631349906791700893878999711846225062306568467992135934882289075693638
+
+(* 25104391676237653962996674810232896003857294806799086059884413856421530328279649263948893056601611073815235439115612155497964541323584159786678357898152394779494741995735881624055133443980324145256438160990490767324719276757840825641421547232460969806196141938571103617707677351907526127993230143577974386169402623023560579220343920203666762052525898442578990183400559087522259053245822827313206196194989095468393682721753147596892214609346047051670610252732846805143964713621673722554204896154742594858056891979146566683467510164875593192581407047920719605560716270697985110227952698114701527191421628561835164291236 -205991315859231724218751687295926841150)
+-5171286675233738337789203670843122752625713948587464573381323151628930998435518250812603433784823922283042037694290795352461861058217142213862777203850665369756106838860420507328654214723398688455622487003912073924323587826356928211672752672052670663842775836967587150049181838707784871641183683742967716787111671792311389517753578360293551031540853470719098360013225516593755039537796518619542838794169319227197212817921098393499332268929332950035803734983497370378852859829228973012039890600437082235032378948656232679080766068869430262740600476498399803176452431728914806536862849281928869092524387549297345184969051926149006293586531930828748109161400
+
+(* -25971587288596053786734900662696128734726180676323130693160397208008930123341700520454723462226657743365779183466120836187720332442041321870351823609046027805781414454998487673927365486893294110931852680018706479684281928396163669935417207859889405108139261480861908067489849403284000981453574189898304616775302917687860062501465417706095450121596418236563421425311420755550335597318818628123183624214438801254105808079227429950505879366254661664881055965092586612702279548151277733307180663770432418397550642136953750720624507617115504303570076531620003848642167562950736271141440609700821621532583527124386811144839 -182748557863603655835821910989658558236)
+4746270122419629115710902425435990509747636609113505336611751359043717100752575149404352359855260443259846554733621122684788488984010741203981300775978945529551335641218319619542248418128319220383298229263331638090009313676486209764655429828385994626323209879925281409485074778611946493692237774852428345451174837474328995186242262565013937544898941834362941815633750896882758939509605799422068815435202904271722442099465950700886702949580264958171808372530471918175963644209760378395316412115175988232945569517230829200985652504383431054550902852797293952515652017940918628980037316292352828228005975466732028971159947131994753006597870175664981312344004
+
+(* 2117427896392849163304163145095251890404997781812823978967013619233450901604407363671467658244435728579079751353560538034596183240362499870272373308111405924505741579887345118857908796509418246599428633956038017783178050402412769812823236255234302205027282366926174916871858199918908361186936687654278623156607813451034087735179167324944824913226799346886951212979149617678949292799645035425029596869092844906629996914674904522806258932192931217652241231736891642224851547474205131131019084734780208254203537633402057673465583362982905095029133132240839391503135932501785844503813910210348239157828902668852795945482 -296778668392678698960782643314222141731)
+-628407431508980610909134894336322264939705333430111861505965183839156278363647883745193463537783397824947515214540990712455315080515980803996660089847066076833542492719707493333185909990202372284811233272987993068106356248349054482194817336258302692039392400931536481136340269417905505366385505196886218794044229758585631131853635721528813397816307666671727692971421531381290925317161326036075629905443938124481334173158440927555118173661486114828362551889594188958723424604273078091320087897088472418346754088900034854230711982602435635574895960156993014703292551046970069204857846207328434544990709459402656908170089318995291341536347275682867153109342
+
+(* 24743327715258194976385899813930363006464428087412805068703455203318769863096919192538751530954777047772548306936907016751357570434930538612382851621309732767199276228580401695793317612267605312672263736938703887622824117576912830029817460033437752668221355377879837833796222831371174014543622739933433581963103361464022058091243110136610854806189138108937004805781857031030005354158991203388998364340053773883952742645161560754545458260688560269655272249435540890073696261770299845722705104648358053080678920468895189601731801025555650490534399590288852165862135571140382055044665678298182909026026068995867606241201 309156501491030456401354118244509785044)
+7649560631695275371386748526795333430293346807872366006552933839286343590101586516802834568317627508914888989005968805867728947519409222814667350103434422356009252082456906520988877859152125402282765775845766265340707473525444185795403554160270722809642681642831847296672303556012796775586274347178092325226458743113317655523655255626670958156216225968018208281266858684283741496986683426354716284780229004376492833583965647875097951642088252875535823145900129967026856898970545720526282798418382467634180690243423325770596949644122541224189780082061715230852249880601371985342796525016176048518593825361248232406051886794538203297084423942036889326397844
+
+(* 31345149697924857384985323414506591310628538098830133854928154990821019223495435414394178930529373634315044777562902565397455028894455733092896622048288278424884040917250546068175763309233883078972879622697667174865833277342334219810618450605650614585133187005110148963483824629405555603493157452295284935004578187488673124814714326405406894084902824045787647963172437833905574178160343833139650913077173865287057167288286708807322607983179910358234015596109655900840652230258122852488289951986129788952718105898226951651151495867246384586164892018870981480003722043190639707903266193064807571586900961788679579912089 2067227180806746570739122295766566373146995767544546241400900414826379465803168632854028593293108913670556431832056563218709444199286888840721753894461468)
+64797545442006646811970698282511426059102976298051534827345388707272469591333019870381858263624490336448197115781363489554169207652559213486772008013638214870324260793199674746523791257170452738018910619029072942848422098770309928561867618844814267276213608306045020686764830302020953883994906997293368193331696747777630621086600981981357507299729947717565760536305785574555255589190221698706036770081438750974356437738060098906046001271392354762036427049946092656701257615490057677558059955825843182799904828201890893555678855718728417223845757559310912618029462136640226686626513375024547351747669476392735304999046232068947570708757930233036922714350584650744960478326257916948676866148362166017752159953504981324652709881831381637989229842766220141292801807437886652
+
+(* 1965759082776833678304908699214846485256126608825750175641683294458978302204367346739996602241053060915897480812220051082619942907491598551933638540412113496542245474287364500698693202553692963910123752514310355402167440783023542848697962967771951714434359320001430281377747193083851165947498546085410216620013287853719686698746328198021011905482303248172483782066908570502837009924228011993318265674390462360820566174204659723461994730913995303015012684826295802887547970851558451858623353950391701673651959262042520584275132971807158231859672678070714276061110616753309305801080136339206017351200193800253572481467 -11092241138073130060021642325471345789108575712118027611362686690749327689527135459714040658411176246054106270789083336195599640521602432629024562630323934)
+-21804673765518097879589124792137157558586438669762099454880024920520894260754279593873244443852337739758694535682558790532827482894104906218015712179591886600693703465749571299271429989154199263793230178266758966678432691901731270899259065726530463438316383699558373053423999416350780342222940065486831353604365192968606300436304827279383661172824549131179471364227618431414928702407510473319879188990689163932586727702195573766225861364297410904859137393184592815970592502081722125458353280743087607273547490382023433724488604177909671497082747464946083901888849483505451426245881736990810339421864101129619181017696837017966116165703320918568645290788634265522956017905246042460811062666193790657969385648522736090098231379029903772234867701846824572274796526421531178
+
+(* -4067457132547237558852016696244696525033953641638067592741078194074861352472861925779476293767777560910963786727886946479865734639031042985368829200802420611189793957001730656623744670821921724417176679009632346904384261431052972127975733031277489967119978909321422086102208644766894305071609385305464547231057263658903212521469801833214062476735046735467944834107695748433481665714184831786462886261252526036621257865158497049125410241033365487816324425563483999957660557670189397770488996359512245971368638615503320507431381893539767352426795415898379765583574977542068222040889423739693921998717145084904555464058 9635268828818063607505341812331931088336041632536136269505180222913464638532245578488168867093853062326136774925531196873279749483997619950077042084971972)
+-39191042921786100943542578352486285322085069425292685238158202937549417928185097567102615300826629615520476316505465412722375794150552330462353356124896483739321653441446703127728441315609093330694305784991844511900128172079464896650958648496336601612657347012294121239821167759496102233234525084695798195547141521849769350204659392602605928907953707277320590923278178152903602506284861018886300148663530071056792375593665422754923886137410482547324901798328311927545105456397213670390651819229021443747424183114992653572959318104053511452473611466305149349027962240989590453237778130260105665310067480846969449221473610614214933278048389171979184119355459010233147440293881252851501522689209874112819966647846701257081192324007280573826673895648273593609466000383382376
+
+(* -22047771987573494284336211037167956208924595972749016352929724093971147687332865088249749580556015503923927321586913446367676445848750229391300778587369581738560634537089081840938984779012854694220894920437076215176060179241185151442003472788530160589267677502568156006531439509890061829154786579353177129190813899423306499631144919702707240832059008168851983259611724134448165201725432622521420667808597545410136493805873769372831833878868603946583848422310946469083400330960925084024624317866822897278934924368888332618046649078771617892961267312226309927786691384460940015979582201446635756024251269978545916298961 7481502540911026808093162425787184755732317118387068406204973030847892995155568099553397887864257088525242568880427634318737874025160499293315047534753494)
+-164950462146458057264341765173378248123415893870534274075422323606836246718538063890359159423074703472625232511667875897808555123518162244263016096627959208397334135559180524195701526029092734741010866589515172934676451385008535538102832400604699294088534999994990970130226363762230944961249818769566697211068918154629209895730969522747736738946126971914549491889482944152891334838234907190697109929512401661529882587076352559260375439428815896053844621297552401396168240947357044985051323834074355418902009161796886350497072010833513601114819625605048943438304411954380599728561071485061414856047768286383287807924135081902458690495890129203192613070824670256334683011083767124852354110322463725619194174195587835939047474059288568764831570274891727391545546467943319734
+
+(* 22607201423790553279447786193696575272983924506336369475058795405894123712509544256099524616893423762658394830755129501447553593365768543361107397299007141714383407862976654294384881771985218996697067215804348472693636567074361380875512341556932579903687576929186215185312685712277482751425466251201421842248749944123326048360909954588266368306843116245625635467041934524547983478110533044085242847795585598341867070787331785945399446665919396062565614516404861115244243161694059679274045050270546536781907061002623188435269769778378780371158624481539046590932125320888745103158180784231722265376331553893647061533815 10075764395489719205294189472045365742345400155046712954334138069917417587273618147303160957788995022989479371576840422540097479703418600112174202202728054)
+227784835187493343385594867881830022845566753253174983274076326016001091958812135049265213053390506720261776960833046225700903422206015373488419693650378821159134369608830936915027161415300759990632038898164509761337714774392506802504397626551196717184785586630245704512525844329038355790338277254618639554796026366029578805283659986085947726260520495140332204643887370987929304924491772630534558682402396784510750317396488402942581973350428066695976988812610467654886227733900635715495731445319565054848075104982244316563526232071957624002266648721592744376122065531440026836549316222728280595228806728872537793522244957258060730038589170810090676474272044568671474692128168357087077816573419470273384256552275636517940058764711467508281344270125535855785388198570146010
+
+(* 21997874907846585575969651776904015812729615626636027149446399573806943459105370044846476738175828244018281160136531735881270437472624605280356112191272531838028896521621800558410217146758345955334174583639352151367532676985598470747138461153212653362188252002768647808852054182649808145379073620834551216386805267446360709820441771932135218282126427988826945094538034579367527908530151926679515746133600376612899354099328788736038811470295396365432559354070365548930628714861826464935305416998192532029724853617023971964507955475554955277722555849603716733374588174421463022213135839490633927005539569058361144905451 -1400498192750070094581812894241996480373581610489471746158083224360249880335094841398529960182484181641387946900090289855375996313447832474435929084180606)
+-30807984052781257825246153008277875918087659020905755686964119182052911551148620538090633516362197112383237624321406969368641524681503231262834662890145617622830207559490089313283375890353617292096501953380469351747504928597461154633889236826060654886877907382241867167198409355653371944304660938495445848950444683274236538890057643038410268234731745456035923559528706349316582901179686671568504971088561096469997823300883298811440849031903066114422309644669680078733839046643542078157684064686933779591609758494599988463628362190034612412739669041368897594110022347872452261447359402810277413572637740870748949093642723240662839444216981630862346445890780016393330114883270596630385367407921496982236074288475142085411632630374714528706189796772213264952893973677883306
+
+(* -270155241925436273159477510619232592261228150696806729750247050 15545126743930076938536195287546926534964892301082800206802745964245668351235397 72127079799316080210744562119267314209211162112457416152560774669179705347659265 58427280233475514109627698916382980237252687770812483048907352594138577656301900 91336330475502063985843547526216808965829995610054777216888670176112782119332811 99495081134815818196404370468895496198561677002653930126818668800341380375657337 6904264296552316628911621065724553059847235903647375662685025031963599691416829398469283631386160328944460790101458427909545198569619131058877708293713734 -16074984786353617526516141164566295497596312655026144270863093715961484079732496604871734572736757225277596743795506589617891195569235287256031608792067121393492186703333733526879481948463529609113624075923052999494363547340563039654910799974388353472433635130983731604982117092991918514078659590068643956240711810902756784590442416249652077644077280371860780741318193975770906075446772544431670392964384669681404295839302410058434872964315897505894833409101781069230919347279857855594782111721176074849502391457684148683668165019969667481755384384017844104770253558111588611189351637275389688093074751942960310850074)
+17849860827147993486644896214424106325295064110723402251474432199595968349198253682890653243676378684005650871261983711134190416277366473221365848417375107498764965893729640224952922241531788638514200018520970345581414705756736222535562338748426356003659523260330725662384208724142177900990027225665451069059291754155591197426279006090296512196415617974140965334686090032257444820748820516976632201388937358434205022475303705442914044454220818215336283948743042841946229853366515552653568436171217572212088935263340599371830215580988184775240338748954666846379831467518505260487989636951404886967842600777836444030434816421999334066711024026401362115623932221335906548647785232855815515579448393689650116225664467056283988125816950714780486880294535933597118808163054631168063568847830481653855357008353733414826165759079092633441356914450038756281940532159493763482047244493174370100586359619040444818634156576789665732998111907245928253704097384811414269835758656988678207624731164159069547745777423464124959379113843649940896359346515513936964849811155238140671698227057228045173997904545787593258286212427476788605370334985423461194148838623911634821153061693257996982252745844329344589168264774527631972524787804330730506700000
+
+(* 6411564443509812216548163965666668398784964137255201222920640150 65325385402074288043601436729391841747319174569548241717675134253657593233436152 63305037198546989906433329294566491017476837189978173607681765241525113921707860 72383582945810879300930057856704905379805338886592055772943486702915907397618845 35525980101796892634292856352740658817031405780112750352735419884048051630180860 47579150292602967366908574298176357632207539947399443701205872093150879604391127 7775494633965874654516687741429737470333189902121089184439228657893110997221737422210698789286625633365548095171257583020272703565350668755439139356570 -7847653632223099338936161226557020783515367997970448568586056286591257384101422312757649765574456754668588904917800060981155642916520580540801153603733496143328839018174649200566737789874193483124577734129346933208306772618814806884416239295732454033604210880463262467564639515484363761639994642888910703066277724414372379965872478153546766131136324967950786993982228851928269842355632200589446224738709869729930285189047112131897218464505263042012855229737941639093204086147932759923796947642895167078971517834730472596647456786099215405165290569214043431009370032818978995463168133051136053246705694337584724712230)
+-197949741939898550383903354028842356745461597695099989904494711851411610441324234089773644533872304737431480244289438922163630848266242200711131210228027234579469457105291847132071566876246332653149194709623963836885480655282595345693084881617726426841183231475364991154699746506928116505297453355016975688761948609740314324443406930215518937775475617384099331839748494157863510168743547396262979908353122625808170296763676837551973930928848463398657587603606321137626467028732193151671337338929938959296176472483674270114824853018199281637976410726195357458134038379491704909997939715446657856320452698914513791221947734373322868574099599391493563479057703049036936132407025278683219316357543078875410080612067641232277376174351958080693019953378024732243763129075732499165068171168470237875348580987967740148512425201518758344757030205911031119619416763996490581551977913711646761182756531618786226541010835120092904291975494846126923510483263978074437667987560077422810120462938292680423746968095994108344184522240467647491991837793653579480334442342102339933473270535800619630342940590477752278184994533764839125736268376640933720554199782388890444619996919031351334561766248781813883867406045414518951152508504891407920000000
+
+(* 1669833986019218156514274418186396165434871163342486930502417566 58528969848472951398118375496887849181512821636583415470809040929690124231959506 50098163184827557635697120379841225459445103589988345336880332217224622666020381 90445522698871905833766573423181067004916996574451008349087758531794463581708977 92366726802191504770638415639612204654473958526592425718659284841373421985393966 69096133232785816552402133765198624674167660496399099321713067612475604030259084 323971624832697152056406152359288553860210436839331005469891386690556929684663075996719803995137130737141925308417709520389528780839777347463558171582753 2635514624483961079560488004237441873979133312246005082134175818331132377114926863102436691793380965631848192666106793612266994709357524826644421074908075389316030912936338175907209987972553710900613011802455058538786723149316934049388525865455871552882282353445228425640452635081303490379594663330152071465360003249884180020993032086861074931796165970076448856988084523672973069824258299029863033098237556417571526135639288006133579174344589248428714474318969988990720790226604664141927030250855550010512291136517209169959021730625428868037074528890516086527430801590050720467893089085308995719513895962750896813152)
+2413207990093478676325592386500172980330574558867366638913149256222218924700401110600319869300256745035993991818342784487193857053589994816247466074246569162659879368383295411190237107255160498774228460295857931362161062884154872938368166514128474751716517750517217000290486110198899480877593169193610813452614906598055909439037075588626529658637140089909227353944313408987644743661503976835580507054926908821206921014266535160031749397432350114673787218438589065861056449106115395189057409933330355574558853874223262465965933679584884152813357065227868165556818717270584803360466149860292769520737249610469675917864449261901859162854558012721179400237645357401213337423255109839806528503425658270050436129019270883446965562683284298538825840361267548675967778385927410390726055957928634152514415917053614892441910675109517307682075989998558764742821214685548219206933043196677521610851950501225469125512893859254575460130829051324112015464552874242522140166275233893076603452098841950130740353331198999756316969161591691095397245996664755249875720008141774247384884623389430842799829690618405724986702942913150258769060684255363816662231923570491001519802836627028431389746450987110456127797025006251203111629141890634728548553728
+
+; ---- Test von FLOOR ---
+
+(MULTIPLE-VALUE-LIST (FLOOR 7853255233330224291 -3336928547114505419))
+(-3 -2157530408013291966)
+
+(MULTIPLE-VALUE-LIST (FLOOR 14068934522023857270 16292006600125740074))
+(0 14068934522023857270)
+
+(MULTIPLE-VALUE-LIST (FLOOR 10985143198741137410 2820546847025452162))
+(3 2523502657664780924)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8108344024060626734 17657489924906565585))
+(-1 9549145900845938851)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9793321542618752251 18086526939764980195))
+(0 9793321542618752251)
+
+(MULTIPLE-VALUE-LIST (FLOOR -17146297557940039430 12031974228591547856))
+(-2 6917650899243056282)
+
+(MULTIPLE-VALUE-LIST (FLOOR -11002425733929018635 317353195315898710776749437474283191162))
+(-1 317353195315898710765747011740354172527)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7045772845268193739 -89864936462331315327547597221973588375))
+(0 -7045772845268193739)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3519209948682231610 336646025916394184314065151550367317320))
+(-1 336646025916394184310545941601685085710)
+
+(MULTIPLE-VALUE-LIST (FLOOR -14043580588957562420 -222396907959379818229719625081455476397))
+(0 -14043580588957562420)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9551193686327136711 75278849342865310446781730521816023755))
+(-1 75278849342865310437230536835488887044)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5159693807678286583 -271047212583781769863421872046042817014))
+(0 -5159693807678286583)
+
+(MULTIPLE-VALUE-LIST (FLOOR -468628810409465000 4096333242794181573565417750313678008664626221486481835906739336082806890901464399325558358976385254948318232837795406709018062193288308568894691407903633))
+(-1 4096333242794181573565417750313678008664626221486481835906739336082806890901464399325558358976385254948318232837795406709018062193288308100265880998438633)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5244261521146873643 4921965954460062114436531997676458648483262898583452823054595308486273272424691697564822554202559195140246785942292198280651275061385828405859241079703409))
+(-1 4921965954460062114436531997676458648483262898583452823054595308486273272424691697564822554202559195140246785942292198280651275061385823161597719932829766)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7155077620310044967 8812163272024170253854686552273644496512722723120222844613502711675792665532423218585794856067792762737333036865054171911349107383532358686613366666267909))
+(-1 8812163272024170253854686552273644496512722723120222844613502711675792665532423218585794856067792762737333036865054171911349107383532351531535746356222942)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6816314458740361202 12075686527410596248188273566406493470578404199548730085391183041200273406509336777783445118538744079686672261898288597639090345296674064493442338947240247))
+(-1 12075686527410596248188273566406493470578404199548730085391183041200273406509336777783445118538744079686672261898288597639090345296674057677127880206879045)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1890766085089344496 -7408951123352997019624764400646833541081866912262454311449242781355699966135127365870537542305320515188627454777019144990896651509964466134772403923321917))
+(0 -1890766085089344496)
+
+(MULTIPLE-VALUE-LIST (FLOOR -17760474272160473768 10671898954663586353020741847122236830297651230263271051052178674502913972809415507874936117140992859978582852208528956402833042707438860216609301338079639))
+(-1 10671898954663586353020741847122236830297651230263271051052178674502913972809415507874936117140992859978582852208528956402833042707438842456135029177605871)
+
+(MULTIPLE-VALUE-LIST (FLOOR 17203040353218460773 -2087162439393804055245476778327445230668947133920484097696589818636894139336038424853265430700117127209095408439503149361955520500062568298413951113007815520417010757436097548975086796164496676384718866185751276003374984886645837833063272909444571294955778352876647505220277070946109654595325494251711661808952794932834009121950804034627054856954463330684354292113876259596011570415522831755074832239680022834732540878425796300024337145992774113324576942861121693541507092307262607720008434123040550199401165667835993232451530119579950363100932584067714571588474895040209606410481479858029354372704983248137195749442))
+(-1 -2087162439393804055245476778327445230668947133920484097696589818636894139336038424853265430700117127209095408439503149361955520500062568298413951113007815520417010757436097548975086796164496676384718866185751276003374984886645837833063272909444571294955778352876647505220277070946109654595325494251711661808952794932834009121950804034627054856954463330684354292113876259596011570415522831755074832239680022834732540878425796300024337145992774113324576942861121693541507092307262607720008434123040550199401165667835993232451530119579950363100932584067714571588474895040209606410481479858029354372687780207783977288669)
+
+(MULTIPLE-VALUE-LIST (FLOOR -669078238914427842 -2079683283534812796000190145696654156804430677578086735229530182730363039425073862859919937645919418081821481495275802097707156965850792454067873053943961704938117974314269568411834037549827330778321735965757574814268024643310969429104824266062514450939201453648232801402417276979456869834703061150723202264463831469016146310260625377771326468627250569024458585844135123967133684658903385261562998370487428947011971199332502829621504477139578507890165895257527873153869666215808793006714467381179632834850697420959155528830942491523671012905291756947015477293335637719271764878661266856465788562934083754663149622043))
+(0 -669078238914427842)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7327608361251253460 -11696871058150243071087622230096689496181624466205249401376348902965608647385664229774648233384515557654898456058685820740766304363182039373157014626506361274439760335671626498691756724181737933201816787306863365879304649516313681157144055793349950077334014446025781487249267998958541998722387302987853596488202173446477234627919885268339967510098356435511938337505060706688248914394292741973765745281640737883810857064447143652281758869836897346742791897670275478332406904414773228555812810686551346417028168391700814494167715137071887755902595471083839770070956620494992791342919563605887139693691074220696797086954))
+(-1 -11696871058150243071087622230096689496181624466205249401376348902965608647385664229774648233384515557654898456058685820740766304363182039373157014626506361274439760335671626498691756724181737933201816787306863365879304649516313681157144055793349950077334014446025781487249267998958541998722387302987853596488202173446477234627919885268339967510098356435511938337505060706688248914394292741973765745281640737883810857064447143652281758869836897346742791897670275478332406904414773228555812810686551346417028168391700814494167715137071887755902595471083839770070956620494992791342919563605887139693683746612335545833494)
+
+(MULTIPLE-VALUE-LIST (FLOOR 294675307927425004 -9548883545732446060252072829565833006884749934819836721462955213854827688043000170303649263042149519854567992890424662453846646328000352698376041008580371118805742958892669824820331301849741711055204656684075622499980143446475914450482604391515448002257899292716976191315018524528823574850034894770209999447615978958086058881855069519056370913875205852377738400734853568252684386414540818555760214483168738870291995504569592275824832746669965860852593991220739290892286776371571179317949624919667076576237866033103387061005489130212740740367035039239029315995502459013799346342754507246725497131746887762156527202924))
+(-1 -9548883545732446060252072829565833006884749934819836721462955213854827688043000170303649263042149519854567992890424662453846646328000352698376041008580371118805742958892669824820331301849741711055204656684075622499980143446475914450482604391515448002257899292716976191315018524528823574850034894770209999447615978958086058881855069519056370913875205852377738400734853568252684386414540818555760214483168738870291995504569592275824832746669965860852593991220739290892286776371571179317949624919667076576237866033103387061005489130212740740367035039239029315995502459013799346342754507246725497131746593086848599777920)
+
+(MULTIPLE-VALUE-LIST (FLOOR 14347605674351973575 16781108313723465798753322947549009969874803839178924211234447140560213638432451682705091051257464849827979202356053729300113370530117630421654608371240669238603643549128642643200948947465613904905607632005913664436128507306181734648889038561843797684348733053132088104433891457988693229945931772136047702319895617567109469705064237812979865949533824478284021673220084274688077361876364538071423609125747407610677136416454538389383594373243559248761308999294417964846813960148782443892858983199711111035244418968070018974928177662516580063782128203214203321005133744081558995859628472663680467632605080081460859254457))
+(0 14347605674351973575)
+
+(MULTIPLE-VALUE-LIST (FLOOR -13687180458303546035 -19965807258690898827399047857329749541944041888361526571512375013574840494217451526698619297248029675659091093507275385543103914023886879938416253663550378748995953654394575052030527774451712268159052917447058332864628753215292671454945836228787137495936035900814206996568155366945096185932229795907560606361081170245972586794828085080152240904698184990372898689089164281206741448028676272453255619644103230837682506759429084083781590844603079867247577101977877828608823440256009103689824572652465343135798570848914557962085239341382269526989381779235955669274286569338275810475113610787290242075588029043316765795281))
+(0 -13687180458303546035)
+
+(MULTIPLE-VALUE-LIST (FLOOR -18925243707105550517292233464727657082 9190307209239173280))
+(-2059261271274988371 2728041824926269798)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2268729715267556753620172461333386061 2091801429708129323))
+(-1084581778674907194 1902605633041663601)
+
+(MULTIPLE-VALUE-LIST (FLOOR 240105871177433673480858499581307555362 -18137436669813972164))
+(-13238136984210147236 -7622864679137983342)
+
+(MULTIPLE-VALUE-LIST (FLOOR -262280851402380072992262860428676408462 -16900353177245877861))
+(15519252683754978805 -1413263307002672357)
+
+(MULTIPLE-VALUE-LIST (FLOOR 232088877459084367318095567773397104766 6879279671528853911))
+(33737380734733937751 5401711328350210605)
+
+(MULTIPLE-VALUE-LIST (FLOOR 28127709642032836544705999676759725409 10932535648386303235))
+(2572844081801336427 10537089091686284064)
+
+(MULTIPLE-VALUE-LIST (FLOOR -306937202176830380291551701368328539229 -296436198830834971825518518346845101512))
+(1 -10501003345995408466033183021483437717)
+
+(MULTIPLE-VALUE-LIST (FLOOR 53182351345555180643155906117731554036 -239211638592486301383761475381736024507))
+(-1 -186029287246931120740605569264004470471)
+
+(MULTIPLE-VALUE-LIST (FLOOR 280879521805922529084106054377533635149 86259942955448859132329436894499980462))
+(3 22099692939575951687117743694033693763)
+
+(MULTIPLE-VALUE-LIST (FLOOR 270479016313808755540727122565065208981 324912300098276215771804552548480817149))
+(0 270479016313808755540727122565065208981)
+
+(MULTIPLE-VALUE-LIST (FLOOR -36931767825051824504116995033958612864 319307981922121038618879980001580483695))
+(-1 282376214097069214114762984967621870831)
+
+(MULTIPLE-VALUE-LIST (FLOOR 107405040163562716679444439233633957914 -141652913538112981614728925754765362880))
+(-1 -34247873374550264935284486521131404966)
+
+(MULTIPLE-VALUE-LIST (FLOOR 184790583924323275311064238756309559899 9405763068924930772523308542613843828189472529194204592633223103364008985533829727911596099340788835060163612329614413033927995456162272921833539208882402))
+(0 184790583924323275311064238756309559899)
+
+(MULTIPLE-VALUE-LIST (FLOOR -232146313651929815140292892576650425884 127874042542498530491272428412953321188339770863893691736473766303033699167382382296818126363236257463426694846772750451609560841554300961480864245159756))
+(-1 127874042542498530491272428412953321188339770863893691736473766303033699167382382296818126363236257463426694846772518305295908911739160668588287594733872)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8728026917336931021644334642968359261 -4025737651718879467086249421940400743845718511565541383201031450532496911741243591880148294568060736532264934821412351158153056198557273134546519285439196))
+(-1 -4025737651718879467086249421940400743845718511565541383201031450532496911741243591880148294568060736532264934821412342430126138861626251490211876317079935)
+
+(MULTIPLE-VALUE-LIST (FLOOR -21247806463473594155821742168531145877 9874623814693251335287095436063900170315895560443374584548447111313954604343515085076726174459237734570523327188441412904116251434030306488421699399082287))
+(-1 9874623814693251335287095436063900170315895560443374584548447111313954604343515085076726174459237734570523327188441391656309787960436150666679530867936410)
+
+(MULTIPLE-VALUE-LIST (FLOOR 286071012976663674972497644839812778135 8117963470049102990205107814791130105126121536354646949522748212681559213640860255350655907507344188574393108661850973221437234442503731759547377868482253))
+(0 286071012976663674972497644839812778135)
+
+(MULTIPLE-VALUE-LIST (FLOOR -31984072490103846239901254171623218449 5692584577100138206704178766874348327662006017031045734962382737701553237360572309466111381682998567474445884555969155997528896962520199289069413649945515))
+(-1 5692584577100138206704178766874348327662006017031045734962382737701553237360572309466111381682998567474445884555969124013456406858673959387815242026727066)
+
+(MULTIPLE-VALUE-LIST (FLOOR -118786321298036108045826901623494422286 -13104687393529855246189161514016061367829206536234756076440701117699438900634808212710497707688898041370523685367660273492555927331371333817584456923437812254937564791326005224466260676246116823279440552837098144298072108885163702544652442198253976130758036230979750526665070549806140578651660117367824058664768255971820333797528263566114021182845197585116811208610765478558726491630221448907739229750716647693886681440731920621825762708622208585945445501310666367635378515829380161368994361558247741326227866296163878689192696502960274515396418704173356117106149549811507516298161494760216869495774889685228097554343))
+(0 -118786321298036108045826901623494422286)
+
+(MULTIPLE-VALUE-LIST (FLOOR -243504960196882294351576664380857968998 -21587937181410571895883243216668490389074705797891859245233974857468088393972175783210897703383951091997858590608339069503309630378648345491373074180865032523580053667127292664354305946146706860083207200717386662398495588729927890691458790805600368902559075452315483293077820819619965677979632040202844747133012382862591603017396270452230496812292060122531819615885125296991557805051862986461441377986436031061301043809602913037623299360710776463563079053501286633046825608308134411478010516309133407298319800662521169341026639016773610132691088293480775753098006068864600975258749129292334356727402877150032641596013))
+(0 -243504960196882294351576664380857968998)
+
+(MULTIPLE-VALUE-LIST (FLOOR -232153120215337418381368832017470265942 30369869998519160635038439385899036531726274899243107662193573776561025086030508184579231487739439638990032661366370630132003795988534362627493292132764049369361254377811101088096885616264297545296183017838644655031800075015262568240918564555865889092855166242732548296118581123607728694721796055009838837557999873738362196508994398492388283391000153200151108985088421583241872508945550713986000643154770628316896294096213588875028875159647959209523043158262383137987983806573391208706198841017176042216759223869369001945418516819972673432636326816040752486579776281338052626173120273068890045743383055115108151149136))
+(-1 30369869998519160635038439385899036531726274899243107662193573776561025086030508184579231487739439638990032661366370630132003795988534362627493292132764049369361254377811101088096885616264297545296183017838644655031800075015262568240918564555865889092855166242732548296118581123607728694721796055009838837557999873738362196508994398492388283391000153200151108985088421583241872508945550713986000643154770628316896294096213588875028875159647959209523043158262383137987983806573391208706198841017176042216759223869369001945418516819972673432636326816040752486579776281338052626172888119948674708325001686283090680883194)
+
+(MULTIPLE-VALUE-LIST (FLOOR -259060284965774946595436776839639567158 -21169437398760148980356190208468018621145492999838564155598571671707045137252408058263155870788514173361612648418947991691931017566701206182096411121805142388703524692384188551391839307655250861401059757668540803453257330609840260191124331324376455691656017965418225557221321063048013134701879342357330536176553693912196231407222911508076200690973402778332647229863066211873019193191946948707769594605725700542299351271155436324879464212647734978854222464094486372144771948169422844206687239103281296767882465060755610256361348437002775612357787333990788742488962974294617778863800504758143312112916148210635178700875))
+(0 -259060284965774946595436776839639567158)
+
+(MULTIPLE-VALUE-LIST (FLOOR -306407220440527520801126245152934343544 23776904469041910002999929986640006577749806048379780143306978176280330224333859620859305982085584460504452577150094943864349273103240498588108336792264540481132832425653265046674475461727185564436156797869482735166850827691928781085870354146365177855543550807539877079785312955597311473866546268560309551339704009052837019611095284429480282839060448969927393502922337023493529232757886223011597039473438267362519775173848264262428693937605086393282678388857244739695710639089112115821491015511241179389623611704128686301802869094211111183507607222840602723592206395532989319304742353354849715544201896997806941793031))
+(-1 23776904469041910002999929986640006577749806048379780143306978176280330224333859620859305982085584460504452577150094943864349273103240498588108336792264540481132832425653265046674475461727185564436156797869482735166850827691928781085870354146365177855543550807539877079785312955597311473866546268560309551339704009052837019611095284429480282839060448969927393502922337023493529232757886223011597039473438267362519775173848264262428693937605086393282678388857244739695710639089112115821491015511241179389623611704128686301802869094211111183507607222840602723592206395532989319304435946134409188023400770752654007449487)
+
+(MULTIPLE-VALUE-LIST (FLOOR -195344089877883615473604540022799066156 3662747206396136814780716441352319011395583880744440623779519524132715621398922492090110915810914165138435343905061143614931233310311653264955206314385113727380922840781471233570237875610273247058183529977038444774890036917021403875269188605058323112809901006876685005810599540694986877767813641408707144817551209014119080068666341132956917595575721029282915413432788003670940873484464479035116187361986468817764174983360339341760904395062935668506379254915132158079325547293981795720009601997338615068852024788929328937759791477545407878160402653256560646902444406842976796122784294159073232675729939439754133572694))
+(-1 3662747206396136814780716441352319011395583880744440623779519524132715621398922492090110915810914165138435343905061143614931233310311653264955206314385113727380922840781471233570237875610273247058183529977038444774890036917021403875269188605058323112809901006876685005810599540694986877767813641408707144817551209014119080068666341132956917595575721029282915413432788003670940873484464479035116187361986468817764174983360339341760904395062935668506379254915132158079325547293981795720009601997338615068852024788929328937759791477545407878160402653256560646902444406842976796122588950069195349060256334899731334506538)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9264891165355739565190184416501921531110089392234481682785663537978152834210043205322426048946857682928713233093454298987718151514375312698287977140085629 7037874176512351849))
+(1316433191754927814343121270936699199595699278862016004420926865721433832616431797693201713416985056700387482358940219476958754936526117 3725966351458345296)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4200307032774171266112621290628586259036811354993551074625290503853725932886889027855146647188583607214617803535833936888841730747156500044307235280341823 1284895891758199540))
+(3268986273297707492966046995014614916998242647231210827092764188090140439361457237468815188241626314878458369000334553644889671709204514 686385384999618263)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4633581426210593840116821588308941075113609939505374670564216205139790589811590001728944069668539972864711443927654873778749890460797761818777105143436310 -2962967916964005701))
+(-1563831116658993795279542101101791208522139405163357327177345954575873595639420625598557391282445499923781922172975036467881769387028636 -2305528351410817526)
+
+(MULTIPLE-VALUE-LIST (FLOOR 12717552468498637611743035736272812618998169576927971614333302239794587794960622996075191568720328790968571121428403438724885597787608886055291630047062012 13314634913503466421))
+(955155928128432692468469826248574845938797371431354312846155816839032798664341688948121282840353830287784283921940330056923616110441287 3054936783550538185)
+
+(MULTIPLE-VALUE-LIST (FLOOR 12062294501874959722722826646961478850437392058690935960962546316456440331759806886386062852332964852589981740852222339370133938328830299239599161668985128 -16763340409247566945))
+(-719563894032763567901416565485723597235798340734444183600832520303761799320002945942723929422229544393458648487318438477478730610009081 -8784252901936442417)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3044847544275515285523698330617680562098304367055502952571345800359603621492376638228899902071703358030930686556600015395721763778348780143354036450288026 -346996692199522190))
+(-8774860431593785670059820118794469144363980632658525112469174051232043754755411530275560319174086707639904288765947602493995823751245651 -238735003065207664)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2509912747961300370421908848463238376627618739583712646450568707494390365647434163992939257405972498499963653610934135188560348612028561201284997136414467 -103539220471632131715513528655357150478))
+(-24241178719797015812049763065806339919024561304709065585003455368093218973185992185403749066840410575011438662859226 -96472873114015658715754743886276195561)
+
+(MULTIPLE-VALUE-LIST (FLOOR 903584156603757584665316743639288345339689627067279191353819345586609786559389840933430566508676924801215959188934167984436460131912383813696092800782502 331768089796013775863175470747253254043))
+(2723541486944457282998823558887230609702011905460231484608706829329099534108144630923237396663979818212898288888162 206235332161320659528701690369799443536)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5673315779132616764913839385550510388979090539569302085655840858178135330568442902409259209441411672724870197775936862625748838206738247202566588717953664 174314453261637397091517016624017866910))
+(32546445076572334426551736182476341541840123356058415149120265601377736759669652080905093959104527787429999911903291 116692109360780668718335531020688952854)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1042174796681883628708939541235268651605049912220225874766096393016094308719465113556241387514699104237113811358810257758037463299809921161083533137718034 -222161050831883826404696847740663687900))
+(4691077903977550484144586938760520043889189188344556635834217114054282381408390083982959968194813858480017307031811 -99596643070173880773679158795261931134)
+
+(MULTIPLE-VALUE-LIST (FLOOR 514620852714641065399283188571474686623886013323210978774935263256584816823822985571618774823719005380283570413767760460152207111047429811764462688164598 -249379962778237023348159084806351533829))
+(-2063601449697349844851896329155481297775287042332288194884672211603708613220802144442049441368964502372230090742486 -95322380544583572818596570976868394296)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4269600385716644031357008587416832262633392539755787971157199376810061034292825362806383550016756143465036715717235613514913396047178769910869994174370663 285417980748490192096950554131180300340))
+(14959114960171371128118740711875740516756226597819143207915053559296218628291049058344647983358827408473567791787490 241314195989544958480263376470519624063)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6257762944066060502889009610562625466881502649685643619949901701091938859953222566838296129679249506961399045004819501125771060525963805468605899184284857 2403901388951678895074087838271029994884292204266026258064846860089259517515609086601789420041871201768080771502802345608184755582676267305500365461987443))
+(2 1449960166162702712740833934020565477112918241153591103820207980913419824922004393634717289595507103425237501999214809909401549360611270857605168260309971)
+
+(MULTIPLE-VALUE-LIST (FLOOR -11993484600336960787296361130458404039545119394875472848786275539588308627572632551925095053909141197737731742215007587172062102742960429155637516154567478 -10601606227266649325153572936490025724316912773656025997862708934485961793376598665748396482615905529759961488391911046336857148489489874009257983913322770))
+(1 -1391878373070311462142788193968378315228206621219446850923566605102346834196033886176698571293235667977770253823096540835204954253470555146379532241244708)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8099353584218727402496117482244315513694479151831901237119469501251316930293170263154474101121202090352876083340578448720444998702069748972927117400667238 3544314361305784888681580682051379178614889611356920001389193108853540699763802421224233206957629368752496825814976307915371579698349690086107445288844845))
+(-3 2533589499698627263548624563909822022150189682238858767048109825309305168998237000518225519751686015904614394104350475025669740392979321285395218465867297)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2978635751180326260478380464684854159186938695694356726729544155114559498149136630265180287452727795680214540092030170434165319182046797389540988376220992 -11044560433803724847345327269572156674554851849210901400046696801586678634230888624140822828361962132102290537138655249676050009778590939633587416463610415))
+(0 -2978635751180326260478380464684854159186938695694356726729544155114559498149136630265180287452727795680214540092030170434165319182046797389540988376220992)
+
+(MULTIPLE-VALUE-LIST (FLOOR 13340538348613289212198643243040710073441733600226599862111857175429956610033827913042723029883753278922272401272143183977342753296395660841047710386806625 -12505012580354283714273335370179473407347376833608196161777727706326565713505585671787333065372262611606233460666323939469037058474587043990269917174242835))
+(-2 -11669486812095278216348027497318236741253020066989792461443598237223174816977343430531943100860771944290194520060504694960731363652778427139492123961679045)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3452499360915990528305851079744650498637858290301947784400848134276013289408593218875969649149167701046100505360083493320272180164238716241369492874982856 -2841735595132421145030480470066423226109731223189024018875906078709951146850527470934664784555907173906888591079310297248898808599295604861461544021697908))
+(1 -610763765783569383275370609678227272528127067112923765524942055566062142558065747941304864593260527139211914280773196071373371564943111379907948853284948)
+
+(MULTIPLE-VALUE-LIST (FLOOR -12837726014506093148099404481188410844577204272048603185395045047349565142592994407238657335674129551317417810603584063833795494760777857363295221929632592 -5400672038070763758928059302309515863608512780764658336296609520612929827128710430832496604060142364086061442480255889774184624927820479974807630834638627053061502551989845184646873008822134065011205730341955561862333543891572685472831543459711809182159609688999832404181689665081467086838440500602969410420032314939424736094367166550148605570451238900811316075091818613634658092771400323953464835124475741159313252328998401218032670762735091435255199537815920258090766640501899817468173756745613666544200642455036991967916355826412137450931256645775349763991939102903236911444655964118925598580974976427195132959063))
+(0 -12837726014506093148099404481188410844577204272048603185395045047349565142592994407238657335674129551317417810603584063833795494760777857363295221929632592)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6578123342051874578301723989032639872736755816906003001838468752363433436477439123182015773040480790196872643618542950300401093404997067180920740266777136 30227534847135453106177887048045830910966009330493682541426640262878585964314188306388368740002450969080153107270718818194095421631888634061517731024627240634873991685067246458822125591350775226166707968203074411304172314390138208453777131423508042090910198631120304798774511984974823253005683386272038346156403540545900138637964682890471751795844957640450350739073841005154467987598913264762974403365908691068629911370262907886883158252280853615622312950774196097179304856495254526220900137020823369927850276669023897589972466867500466273084668060310345544901231841857904496215091732346299276586847479136514947400671))
+(0 6578123342051874578301723989032639872736755816906003001838468752363433436477439123182015773040480790196872643618542950300401093404997067180920740266777136)
+
+(MULTIPLE-VALUE-LIST (FLOOR 12403944923950846249231475663107427245396603223802100275104415443763524399953865335344297718622152249002880852792246968794311649331174399649925724682365691 -12888526328266820415927145054786787145889555649382608442248161845973745960691528655550360088202102799744537495406020539568745771467756467183613368156733378808019164713600978887019905699871417123365613340681673916006626966649924170996253273073733852663021384681382051909095614154557333966638418401258055946731820806422207820872515345183005729150326803604361512295955159943694411555067679327842378949865992521340416781113735936437694218150384351520004302169462501770232864597266654390198260481651327159066598217103147752784312005857617885666670915444340917773878003125490279146098981790584757296196254721882965728596834))
+(-1 -12888526328266820415927145054786787145889555649382608442248161845973745960691528655550360088202102799744537495406020539568745771467756467183613368156733378808019164713600978887019905699871417123365613340681673916006626966649924170996253273073733852663021384681382051909095614154557333966638418401258055946731820806422207820872515345183005729150326803604361512295955159943694411555067679327842378949865992521340416781113735936437694218150384351520004302169462501757828919673315808140966784818543899913669994993301047477679896562094093485712805580100043199151725754122609426353852012996273107965021855071957241046231143)
+
+(MULTIPLE-VALUE-LIST (FLOOR 10948926687039959668263034501276830818625159748756208667794639002017960671515169323966433371280908617310031465455790806503858320395456591407286777524363944 15489368888944605373650389556533647343231613227589912336942045556008797399070972592836944702007913599282985878262526911196097512734678645706417084706692047107683744531285802197270639216129852640210205547180574081479052109734758880839510339349237982383997307379952940072013079809351763653427560483156946719035644278683384662348499193303099798764213152890786143522348717903997482162057330324665060570551176318195643585920374603137371921517627526609290876303058743280212715019326447206678291320236859616579863769668727778545628289338458285997742887048186232356815344233169348134282594953756462483528235310248146271138654))
+(0 10948926687039959668263034501276830818625159748756208667794639002017960671515169323966433371280908617310031465455790806503858320395456591407286777524363944)
+
+(MULTIPLE-VALUE-LIST (FLOOR 11464576772189320419261665628466949872551044398628568459420638211702970737332076526558331636045640676437486199912474581890841933557822038200509907802936313 -22467560825853172479037421968188386486420879368653733048793951227030601094142939166908251610058992921146938740897141065727494001469172869273657374887890530345239013255211792126218659779037493454354985213639803588241949068595974842726845550080803721118359501094994460828504625140423100683538018569820187798018489678377090273255263020908779694768888896507998040871877361662889436371169588814603494476932238384716309803290555316924487478792149178773379217766514013266795383492328680695659480010501872205935050314706513127406414046031915649062646891311739001532048668245929929298605152418405630093221583825629790103566902))
+(-1 -22467560825853172479037421968188386486420879368653733048793951227030601094142939166908251610058992921146938740897141065727494001469172869273657374887890530345239013255211792126218659779037493454354985213639803588241949068595974842726845550080803721118359501094994460828504625140423100683538018569820187798018489678377090273255263020908779694768888896507998040871877361662889436371169588814603494476932238384716309803290555316924487478792149178773379217766514013255330806720139360276397814382034922333384005916077944667985775834328944911730570364753407365486407991808443729386130570527563696535399545625119882300630589)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8938867625495530153186421114297747048040597826172184076413640033054738602015847458230139602813250873350372960139469151926251587994978713194477868118851140 32078375072910127937267277353555359769886046039319229674839329288579279294400524798815635423380870475101996161416889444654312193048344262195882716890119398121411812112449203794619431500846260449790771355510015457009235934372609093350279916863051987911050185220414029935306290325311701907978862607656115228781358052463349741922708496995681137879712967466047121123132315277071458202185149672157950295326835513685167006326116804121841993768353882369640078584371838201520000042076939249781755766637255305083290727182613012935978235950698890245889658464214791358409590524627630419359189066595841389501082705783042993303059))
+(0 8938867625495530153186421114297747048040597826172184076413640033054738602015847458230139602813250873350372960139469151926251587994978713194477868118851140)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8722682937170431050833187146084378340001260037987475887522226657702929497643381574300242436757970258082372353322466430729560481174965555877218498123235127972650642792093407571195465205419575987213014443482975328738475261835806620444520634849116095235065774422144459742716160248838471185163698000228745859478158104063095766855794756463409807333016407203497851105737138480852953389782284594500871170431951978989370255765328498664056929197514187424012915608945460596104718351333193752820591185791608965252963085687083606400804224201063308456591357967802486377986437493144904666736661926951141864058594174814702200209409 17412472792254218853))
+(500944526446044913245854704095754296476914947449773601840238266000641308362538841153234090543298285278030309320940403936325404298435972916448525262079072487832742313980507689645024811947475736929391921911894727993931203210832413457668815952782782949239897550712034201783959782842323270598876666346488371315244615931371511266927466746002593260083813695350859233907674818312186201150675556646229110170730257749054381148001252368819048293261475322932890858943640868603051493461480912552795132518076648186629059596407623028993206501153697237322059149347109211519809718392500920402797396035977014151301 13717640401691531656)
+
+(MULTIPLE-VALUE-LIST (FLOOR 28355649069936648964480577421600521514076854589748655538478527484386692848040560920378270353295750065522502408426901852657385194373002516782134462463403619404085937808470896616603996134884288656277511001166614643845546560002367982733683422291378278295503032478358197654941019479109634084898326003113897170044006328598213579789377859798284810297339455100733353158770429621612618690067430491463355522146151298846940191011096497912423339688256950368577997428204387561345591508638698782496102293891198658979297125431373501637906166414269821235570899541062164735301390814949753951678580623524363615439367796948526661114273 8633859053023126034))
+(3284238125245742016855698157684933898976923158153988299571059835059738533454483417199061360717949675767825259147742326435714596823475742487511565640155717557287585352355724513814056546156034557507060565711152037955657280498048473524523497495066421726381315710512047045674071154161308957202034177182801687183543929989744017034272683534975659632492076519296858840261469439577557507171156150551483889412665000065287799665100306570592222219949067222441707356112651967102951988787499729560738632591896472356839552808850928783757605816255738706660766653939585897846868373880810762740938652879077841365007 8480542101902822035)
+
+(MULTIPLE-VALUE-LIST (FLOOR 695804210379264643979583966247939985121477063798866833769029083451619832314943028815111717357207629373097980486420088049066444875218919515464168730784010670913213630418336413807551517181427706050442981412812560910674568907086122536915068847926867597666432252300779682993163510641754139318056267379096886236384894321926559804092457910184502775704660359338939407870665678723351102313495695271753077268239934810069567863069912893064736153816317584230084541663742856849855885433861537874945479324326871485256528265492542514387227516996450338546971631790859699133015684902494112907242906699969802617955900147949678000702 6681774530135049718))
+(104134643759851814351147451693200005177949603843035721223567744815305881538588822665583702468671678158123657386652154620049781061631961328262453617035662063853637317024464861861946266314086911857166878173456014196637218631863393572542109069255296051532325807248516303174349857623773438852122643289226264801658953137748153296436411578898337203701260654377419646372368642303334799023574274991890918545934625239992964365706183254509198057965378271765137299881104144690382322308740670412140492093203922319672781421992523823019735773183797196153517598307995654976625437636949948229208840097078305544042 753510048969320546)
+
+(MULTIPLE-VALUE-LIST (FLOOR 23793846839231724395641481096168600821165863841834871677817770057997115862268350281729411419898015728222764385314741974298570203231459954889026804768374989204737469979104608191592488617915776065920825549826544170491376474603565313317103382409887303248767928207436610335921923003830631904883475966155908755916279914050461058817604412376332860234542206749755476863494453482771627934874030957391163592500144106720406855489772599751499515034904792907346159848425450017939743424553771285003901024075692162881112993617392057913260097840038314973483416617082316428401467936188718832437149607288888734084245887947167600476942 14251636779665730013))
+(1669551870223134151303903342674455433642542678166026329327716199552424270739267924882373474967130314854205248773422856606186537084529373808518256136223710801915037299873741750309033582768093390015183894640465684163714303454407585554851774795653260663343812169894506517621409762650950455752948417517702896344204545008148927831629685230911115972567815995382195887880974480058637498609515045000261275580213450984765289759768577989085446697886224919418538617830152205807256503108619376475835548388022966261347231830397100233962945745245326537590040744120991719469590787920917431072137837209281279829978 13846244437708747228)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5157109352853249971318864071100809054313778706912280725237530653514718017885603638808994268309662830522966266131723296476071219223553003512249189605920498878997009866938158487186969488205976122254188731320527219934117903279062529020046834522969499499006879142996400588997334123741485390256248878878301063076286830584096271875934275097457786951285271567141607668681320623976130528011279831938224824782139301311433982239041406699687231975177586985955350651094601995816681979048980035660883809964491229857363116776116215144288428315817606755704237448380042774619545204701291306469557276264456990236770565662987790837189 -10013270743141522218))
+(-515027455577944332776599219259294388811187969682242219239790206822600106136108551964834930674442778634657645567794824061780492131991288077428371773780758138983535394992930162959647831148714333399217585802721010849103285390761891312665489859363343081240130486926587552859706337223282598959658826457912110150229463850079329163597771797337822709730777565370953422223408595882843118286956939988955846229075579330815290845722563420243422752650828997772215730429207767090119357203878107337884921705286570049639435686342039828502912430702417787311741719990865608911989344378016685337998208215872207554274 -920760231421022543)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6494479986256116541104296929948745881595810377963953264991072983439840586308068782167240611739100078965050725068818882183756338815160036859027539278041681781661292616356111680897493765185363894557565156777508945778492400417041556530072176186473028646756075186621344659621007329706013704866019055199752880400583535752226648517005237843095412900402261752786336175778761394870284838510406493285835836510084377115102990988520712094164167646661458280428910514014249834132126729469995977022911113044853980749549364759880528586645949565758303087716543654543586861828638440479331739588108393797432477382024670823562517526646 5646044948886972124))
+(1150270684178027997729638025310141697535651329313468129284627631873742535270359534840413194117215304029010709513909008920532146218787185595227269977210380838656683242728568521891853665038056999715825712357842110695616824097006318159870253326008969365677078769387050477555367309756230306675796151995910498740461667569866473279089249936015985131524549691332989894205425117195925594673141706705491188937755834316410829046680432307112608812689099288880996341318638564624566449876699247700823589547245730672763432749619618807750355174780947014272103851229064036660484535227006468477136474311066305263226 3785857158573214622)
+
+(MULTIPLE-VALUE-LIST (FLOOR -31360864680221422030140415094508859225037184177278863690330048646310966010764143021431123151508104188281687033827937090369965061135751835578522568620174870624326364591751719134017727476315825913896303730502231987133828454596458972192605628269836766485752863341723932456882638706013143064500915331711791221807863285445277518932935928879510111580179238430718068897684115464091110803073393785115849134031970572952341156248906594900067269723116623961645695573540685417690666812895681389324387236630659047254288574908905115640816788218380202062908240234242061857266935270268131606785945960533363545765413571210356588614272 158731480268028865375787109312788454557))
+(-197571802564094255018835618501836237470451780852464910702917947610328490115600879542277218044587953977482033832066853445897949746594340123621010571525423525283265694134335278880857970722363261435835440841138075424370755023622549046990506755720823389094963930373207384718204282462412342807880786115573288541223692700693236309165845190755419998468567231783954117079063183652374494384463667165956585068985935341133217173168221529758860606207789154326413767211275484817995028454435144966634656180655573506329003296926488159246532512031996848763667993503525898127688305577417054301089 22128982064863884081225183621483498301)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6972688127252138459564959519023672734797720350352562732688801457617542500099509865574973489633915033719003377224851429368921013349700580153017928134596084737004044411366993842119504403376959959480789333673755655063117787017101298662107070542628327980482897959181812093955456006698786827411711446400770298021381400926276799694253767942575674933967663793055141073318481678170963516082521833862017762649825976536694779299584090771859213561628651925244725218133964348562464473355036335901024895778660125505334188112559810228121975479770611339038859346371817450184722764849484125019138077786325611240207689562646177214862 212229494710249959442576275005814060115))
+(32854472639496801513625266171869868980490382632885983229822011721729192329270622778562010916862699719016516950898363598128121229189750116863530046554995732003476968354657890095157193194509736774942176733534056571834590366060961121671289385934253368995757730753667329275656966343378668081666905678760988072374390324867142186156887369444294667350127131255070935565628787125782523108523608392770938414227072810340675454608542379054058487857197652824285799185253955626498482144435788461420918351383205430463919873128183751743772403931916447474872579786344165522578418757820262494633 202602247999430336716424978770050352067)
+
+(MULTIPLE-VALUE-LIST (FLOOR 16146477881044981814872185978005786543642189695578037880128585850657582227346785609949631520306446259385630057714250080634804935779512167368598228578137970013047546260870411704532863029107179381174130047754949458719207263855344249323475379597824225167477700328511898116621808311449385399905867898699564040099050435706021172544369947305690899952295406293447506146823515423102232662385522802025721933657658703659553626211653699561780784625213816227416468145185123310306319508640423290747072654284738002434784128270456278391972933415297337582959158202392632248570451671740383769937167912379559021602080900933189192375421 -20310422672054016316639412907518719590))
+(-794984828319777650694385094127543908631549711061207837016795411776676915426259473368853160688756737034823729254185786121643208845684214393842790938031685686187522759314947140818495607328399712740082388950671812621562726517214947696883370445215206445278987678057453772575168165658852145270562955365137991966349779422574705948837912807073553643238677887356778699590679423929808592396737386221680984966466476609537799000714595283015387280145210362603689829188312020767177147038887361232908826207585485585717770550283815412266616448789002231614634998653868395118016500112836083648523 -11799925147898511149643800539362290149)
+
+(MULTIPLE-VALUE-LIST (FLOOR -13333386402689284528955650425278647711888918022382802858930735354762601039626630790596510115878972126652469762677159574447095103432811719733783031083771953511074739306201836852090205483055377050725227473420407492132102122918222222661174330427122421429872287465154597256840268514193104109407101719163350519145025605863849817679140939130213133277602018019855074419919415918787364400403970284236218639542926948339939839929520062948689163759711059171596722904754429438151009753108425737178467425999202826949155777669899192519705543679208977557190789421238295365156644743397621766685402593133067165504533347334868817548870 107895899863035416090758241115761545328))
+(-123576395577726995467509810094692559795501216776624732643654929468261569953970620516962817836961555200657486752392956631475337670018968072148956742753944568338154539759184635744464807131713977468703479999463417456632584312098725347773265375061594795112459950102134313707118281441803361728717545150343139196161174674989680811767284271234273952364761695483244122531302983909975719498713709629935106791776293856798291478157380963024628448230576871460269799644149756524167414024818290038046315016119726155391403548599527926110598142014566712845146844517328059271906387663525750970076 88916219636034843584282198824028056058)
+
+(MULTIPLE-VALUE-LIST (FLOOR 17396957313719309181655810621342598276769983942993211094806395284201495622288603530182348401034532670779772026613959220329662328631746748840677422913897389222211979435071300283979361385673923168895608787064277711550661080470385607194607715097404666355341496134600730286695020337462621706659365279865288817231582460135505994785679557826378614057840182487774381015927951405829305139118747627556929090278010945530871104877221509669969637405745641517281958386251071953311649218819211648218403974139963448683937267881136641329201897530450274203549882462469989176813129608929688681288830465486480047730094845155570312862849 104186547224209978415781641589908237686))
+(166978921724711432713743436094800137505239032223722714964309089009506614535895519867110422644603923287110323367280581626196181748165083370852210731028149827924135420402322644021166934074442323617970930798783252483767604446788478644579242675426052418474560530381252273076756647943610269802844827006798614570113552490465455602498689920520721194207399033534120048155924790694559525815508064767545247429922864279482054330586837508112647624007190343625308333109186981945018060033849826856038685383194624273212670683254990051450794748656874003602039616482791671154071071940218956513118 9689041137085346765396894259391897901)
+
+(MULTIPLE-VALUE-LIST (FLOOR 26296668029363560180578472840636347646283515109787546573773133131169235303278230292620358193183994696837168281782424510501462932715289179113988102147665778902989371433141498385910026219307721742927641650208826808587628688330897125412814594284814050899367007933796796475217266168539594147019546294897573039387284123267787652073296654465797846788961105602455421819896924940988943972769457383697764285807789932427485615761627567609238909525216550007481876466503244451415718439500787125259366798747857812030734235875561021422659158282642054300429948383202431010170473103089719168265166132037042278884136592980721399898848 -145151976679874338336058059363314537))
+(-181166447959297097309632649706277310462287087273328158550559504514077025970552462585976881228509338936991115036681066334762526041621219901153411893847383132947014037561714726163730996723689359625350327562359371926025189504119439124542211108302015324941630060663441114185165191476531119095379776949183747807676488899740428054170566283213350742091333006110702325305863276507428847828894436119391753135134140918882254262557249907254757481730047992171259860818951015886963391969368286964814563381601392580107247382831740092922947642920341973871311541502943677603328463821550096331015449 -110577937214275422567781046193383265)
+
+(MULTIPLE-VALUE-LIST (FLOOR -19994387832358687564296482880955715923586831477222916410597818184152857711804843023778287694318724091304456899035183525127967566364649938785565453184727547598671504088541688780249133503129117660562371945085803761853547276588271572826270417538713473845464667687405215144939251922714172491714494707146884856110703801489923219443900691887441959990915961809557008130581221371957930424791112777130507507175854695038524747304496126685506502272017923871345301904089286401283977464945598827719321374155830270851832155999413594990591210770207211404582078047399265487243377424091264415562555479103296829671606309227114918559411 -12290727751262531359522445814787932748157034294075544178515373320704162497192584943859172528304649072004548036058435558708785921268699678655127651925033127))
+(1626786325187686206254527912536268233229423573477257270053889346415589499220953871015742625081244397640382477041911954315181713027690095532216560352291641519082404655148801601548476351855968135320238312168182690718232048560912434032449056943124604465352409935769208624710904989903415445402236977791654195811881494578919123294926181940156782515461241607944723498957864382829554865120206763098110715049165623436566759235599826844834593966722456940122296028858654743 -9304614710679256891239598861411560332304324920434685965899525875715186019084445758952863067134832791421060008856516918122255022315420901512824783987888050)
+
+(MULTIPLE-VALUE-LIST (FLOOR 29916764548363516315213840380698377536192609328827808911066465815108876776179490417834258307994776308911573596103626976278007330105709262864909645777842169226871227147054313657605129607087589187123503174807369386299991859056839377153696490642393964375926230602462747312790529261100240727992473466712957240583216041201088172946856263144111813006598318253235946940685055230369936673556047728831107329646718919450916347559724523856479721600705891348359262178740659519774585983326669798219391447115538287743254388570949370216658299333436961807924794235560183973249587386381643272943817567729138289488897133971529039695757 8476334091496252719253471844340714224307718865976339399900779938495486609491382968889867250990569753004524377073297071391348967807704774866029247355531618))
+(3529446129120492576886933802306348265603546401021071145489371491655402978871242160302127070993421776756377896228018319062438889879832901903630775379375474362476945682118589732246954574638082665328364641573132346715748566497144048040413137331852635046499249704620713985392482170976329565026453768403409435575238922748145312555307402543771398751056417238642358386670853730480256387244547289563589645563705382910276075835741806800308617595407635175179549186349623407 1121598720662440742988451944089192258208677258393969079460095922943603039995215206852920630773807538691962340221388452566848135314318278502721876458313231)
+
+(MULTIPLE-VALUE-LIST (FLOOR -30744743258986840974825934925400463284355151584175701001085034454282509186617636999187209301942468580138651572968436145883508307958710953672541548503099036345172087541186583358599035971842953063792288589346835317805238011836025866089112384348158834439025788655670125182111347815257445264926636792871229400549827577321670531162443103810493815924151448637886392962948822485797619344455378736429734156821345757186019132123507024835777255364976075865806996283635073664232613154449751312293463363442122204887362535000774934247468263702545257658938264075634847752288018235968497021028555508346290918717339789336670514080457 9934634309555858804270980126309615970053320780519373855793924975583204316518242194797388422238716941854010764960600214725109000476250489194524103405530739))
+(-3094703066162616114961725586598761886126440000450319657542750158557542422972265973994772432239434133706930345695126019787070526540238058168248601279554005834087067802027491094801318957724338773860374084056857766237802500357570852135835098188033303615905411388899090151866056131910609183545491275118194384669083917607888152562507000146957250511707959497676133004912560741040750644659008842081402439245159076407113469036885418577123982203712293205143214370192534124 4583596897489701137708573201509728063693689464812281935974761545728663079569821440573072545991527054461975034582959468944964678550288258358252037074357179)
+
+(MULTIPLE-VALUE-LIST (FLOOR 24643502519803888691586762836893695554672668882609252497967357925433058477865049537403781351424439957461939549800248300068008928283760882152105280755728186165336818042947891471506568092832294726444765034759769551554808855491501013689374698042749154404230203678454785382207604303955330803002216399957247238380783055267792042696128953561495320963977422797650867160007702447898131066450706964885725041540562948429789541526915479497874153956586286026740960933319749986950590370162278200833957789772606366304927219928607487195862425188567871883130961914293433624774413725427494180502314592349900074269004608052919421088368 2717450167284225996753981867457220829510500841312068511238048532529427648370573174539553585183069673827813696207263846346713773366926177883038970327669336))
+(9068612486988930041452615817812610262395413380750714216172624755617167719146150429506179809229439286481063525474263171526993584649905549895379552966354856688607031124385144196292585204982548068977456744404073207215088901248836694827956726571697679223311674675917482789361649212542123782029147076771863216074461137218175127751607336902080642274682219411530926094644805942929937073627694007279189212959755881318530033893691479717411893927131774283641886860168845194 2630363844657415178536247490974293939778607568925570410250370678327072798984411202414449734187268017772490491616031334354084510652181851150192386816317184)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1857471144762621226078309760048781819853808902834007243224510947324703640579895884811355396539307768563652552656687272466757001311647739575925654454617797724205998847128737511426204839085303003071906438273332520201294499647651016586411018765198623236956366866836742835368817430092030307634950795461633849978479504285561783793523293571899866834127333885745234267982498066548934305641020559144124243564372784715821253591393010485777361901806233522170298666402318233462164642692695586402286093353406704474285764942607399336515494566976327035651095257443119526233432484730549923908643983835638400244551332963304703341991 362612878824948204766041465498605121983038344328923889813821008133012829955553725429013872301357114460102737976404433762806451909620639548491755012601032))
+(5122463247256360173380682454830667735994909336257131094636868172398931453441644851286253058553683806107714242214425234484025628771776577335533690016729030113210376620329656025707882934177847398968795670307669192526890837607471635669459016090183544133427748745285201703705268883110778706355536331762965138118319801447738265213248123408984033840769670544118622199016226728679039309116650227118501163822195946867970684116882706924781160720494209768961175300546225784 299760236823448232299335077352435634442705524236228994156709162318327253866985319237312495500717724311867426639654094420477947147244359720759776119932903)
+
+(MULTIPLE-VALUE-LIST (FLOOR -15512250050509017569431653406374218468191654707236673402325185299702995515514048891881128604127259128940966966514594946451486134694476273851559935124397715410737724278746590654901453457150411276548615199767807502093455391898384739629715289928761836102897197661380120487438391395985221415090269132778914962364055598932950972975325423902250870789291669816092405224971234605691036355433974706922342506063057313987759468269851537540937400869685698983579620650290591582484180497444639057157757973753179907365231695893268694300775677678977541920955165836544926807198464657683328635157477957240884116233992874779933793654204 3358541127950670805593397985550958371637657834938091938230318311713415017140090677340291997759883758478618605945079413061265904587739160855880393703427541))
+(-4618746491270258642196486131268015112521835423420717615093174172980857448220383551186758990917205762587881579670823547496170992786073126440511182401809159567300795932372630208424356476743332043619346311088384079059435373790499576304419282368802375623485321283238175405485184862968207039638749406944454331623523507687428477960605913568521627594126207284882249627708423470608914416155986620408793531083231293214124556072929628635430705354422888702360112306375650944 3005102575063606384680566102915562580638230938191281335082512965430334791588194853068845397234960243041587407778382851298719244486316278864423824018594500)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7795907266149417935880848054805638357926463272237741460640947569644048588447722511612181517607450880049915905557897989678236704307693907736247058983016545076253121570693500226105057772914231058133990872553093077477246778482972908671114493634160355090012802248700706280069417479488180111886570768297449284497993155476453139747448123977064178202693174347058572053686548952330935409613585349836865130827901523001778569465270141666026392762544863707172069660941583975586471593214627992137708766736399392527511202198595607734119123667475481080585901379489987633325665012548140296404667154265922084962379380813206642961141 3266322496024458154155982586177367205241879884975448114046439840444265881425140636480586339953113858345978121218157346057285955670573379845528853928778649121198573716895875372950665878135491926664618467827249347334921049358968885123014320008238518111491029267663871866232098994215220584035091470875989416180732388925174422587186795087858194659347743269411322176680238569785902471836835335166112452646235228206195081915725782645939016905926964169376697807870023636080042287120562847150399762713196525578131013908505157176421364232903071413436786302567498639276925676203136397430977438669196132229839190136276524068288))
+(-3 2003060221923956526587099703726463257799176382688602881498371951688749055827699397829577502251890694988018458096574048493621162704026231800339502803319402287342599579994125892746939861492244721859864530928654964527516369593933746697928466390555199244460285554290909318626879503157481640218703644330518964044204011299070128014112261286510405775350055461175394476354166757026772005896920655661472227110804161616806676281907206271790657955236028800958023762668486932653655268147060549313490521403190184206881839526919863795144969031233733159724457528212508284505112016061268895888265161741666311727138189595622929243723)
+
+(MULTIPLE-VALUE-LIST (FLOOR 11613527140000568192482756738253388762224453894786686024705324634643336086154640452808765642911437980109688560443031730927780624431102238262306897218656077453053740901919490705730434109001630505554615644472687423755323577388664893480041595787444776915986509240983988768996984961291424649229547505632144971266842770877960364848817464904515794389771780820407027606373375049573795106795237627834701205331678265805568350911815774813018183599320960878173351437520785364220474506113269284418886794765499703487689302735252054649064328797761871733823998210784410557300554983737071496100764692702245794941065431902323619975581 7587249511488455291481574592043097850017617150850944854151430663857438629054661904725186504711545142985024178310267212940242316767124495452290378757849233879415880641974894427201010329762690544890887138507664079244754338469394276854749839357593153274763991475638253761900794536890806900100092838214316658164432730592513062527370014192403678448098350118128696785002089891158354556141292773760767431084006166964515144211080310413063362654706066932594296395740249062444674285627590937186704887659632200604451417990996813320236575100574875972599186794102474813935877205799664448604353627460661673753990274449050152179527))
+(1 4026277628512112901001182146210290912206836743935741170553893970785897457099978548083579138199892837124664382132764517987538307663977742810016518460806843573637860259944596278529423779238939960663728505965023344510569238919270616625291756429851623641222517765345735007096190424400617749129454667417828313102410040285447302321447450712112115941673430702278330821371285158415440550653944854073933774247672098841053206700735464399954820944614893945579055041780536301775800220485678347232181907105867502883237884744255241328827753697186995761224811416681935743364677777937407047496411065241584121187075157453273467796054)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7305781671042805086205879027901218372025263744748476920370936801215407682690507181906856060500614379569331564964369672229742583709815447579920249246854986585035499467980872113078927984775191185433409825799075510115669850322522523768142598684481781858254267858499128954637862215107851239397355311785880257523971110240017078879170794103136756816178851155500522519324993786026829680880063502983144325993463559477297984845168078230705008144229777150602704982383890956566628052218375163513110904344758464487972471262152773773566261138354198738738504010228322403241824600361830597196538559114936352203702189317843297305612 -11937423884971453925821024083751259499642447259766781297912835275709052311299551864192658177304486399283699058384364751376568714457361090099824205847610164922413207048832164141112741434740690851620879666916091683114805059397520385319965609291355819302668926633114618391597972110270104195729524521712155052417250364832858246777602394209216012243471719585422463867924602236259070514326289155605995143153426519592268534452020820494702940294360007255909971183689215427975382460838239606147437401771039532404179010791325434773433170447691511043481857627662741058910094855501029573945308325534013127380693322055343068093073))
+(0 -7305781671042805086205879027901218372025263744748476920370936801215407682690507181906856060500614379569331564964369672229742583709815447579920249246854986585035499467980872113078927984775191185433409825799075510115669850322522523768142598684481781858254267858499128954637862215107851239397355311785880257523971110240017078879170794103136756816178851155500522519324993786026829680880063502983144325993463559477297984845168078230705008144229777150602704982383890956566628052218375163513110904344758464487972471262152773773566261138354198738738504010228322403241824600361830597196538559114936352203702189317843297305612)
+
+(MULTIPLE-VALUE-LIST (FLOOR 17209502052655993695999949678678881817732805080961191774214537634467104669997820051278559964292611469011761231649311262525642916746094372962648405298787080759403024379693612743720557853611946286870304197122036126838107226222151419136402861650399432372524638862075613534601535719033760228742681750726602275976151585576407980278472053570791272866409613117043122126348697545507835143620584132787128003876247255766444872271317786602207376422907474443135464267851639815814827163426470735478362760843575789201717413221027220343295978806345517086041608240978720520050196395624694268550345436208830801369557317350938753101681 -25492366031674865714603800130440722297248675391454036922399382654290017832413394991423912006244487394226853780856833445493556957899686872020567315114599762113500546176766623020864155665149937580279148318691466089932874147998457966225079089491216886106456935347049916843309661581230809710698689198580162954443484103521650233141750002940462046212610545804018834324858009370780731978549694951052575612824613445810777717659953126577086301947235560041125102454055651800601741899891885690488712713049609045874194541526013910595588271596050758340197535035493872183554373796733932414738278642683363241812520579194986842248406))
+(-1 -8282863979018872018603850451761840479515870310492845148184845019822913162415574940145352041951875925215092549207522182967914041153592499057918909815812681354097521797073010277143597811537991293408844121569429963094766921776306547088676227840817453733932296484974303308708125862197049481956007447853560678467332517945242252863277949369670773346200932686975712198509311825272896834929110818265447608948366190044332845388635339974878925524328085597989638186204011984786914736465414955010349952206033256672477128304986690252292292789705241254155926794515151663504177401109238146187933206474532440442963261844048089146725)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8264418404762904935971540586212553189369665581268178138984287355704267971035469114147004054957406066365602520300857203610010249719556414712966642864630190534880504909484466848336120976452116710282569157883499369927614177722612839620755683557142607127318366680113418741529273669250116389195268121444810596743918472573214391707744942602210637166261703132552343842498400457951297867678005414165609775233338084350550320105330065321705398390488050253072298385134487973139665686164664754618413684815943926055617247418686500187322182211450203615430634564054858334306443836925011966962933359925972720453678168762605413687214 5659270408666391096654451960229302202479994399681938594290004159630195588392730314741316662127233421095165804881532974934939182755121225362126950700260935754690609887023434283325604581248499606543036334396521593447377999307285561199879892626309791285854660250329582118972672086769638010239857182094917068742207521552140484875546416914612991626798295801703343486711676899362639653362756374154843829963089403048720579483739833657436575344900585844370562669493206999896738589003961397524062927929845521761767153927579517203070144813897742036471334901681673999002492983666998353060616069539877603853178826800408499832716))
+(-2 3054122412569877257337363334246051215590323218095699049595720963556123205749991515335629269297060775824729089462208746259868115790686036011287258535891680974500714864562401718315088186044882502803503510909543816967141820891958282779004101695476975444390953820545745496416070504289159631284446242745023540740496570531066578043347891227015346087334888470854343130924953340773981439047507334144077884692840721746890838862149601993167752299313121435668826953851926026653811491843258040429712171043747117467917060436472534218818107416345280457512035239308489663698542130408984739158298779153782487252679484838211585978218)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4195250682093770808206657488351701663023767531608220002369022288787894743733460069813218793361969185403525213558437941222523116136985128137372308027033996674188008302853626391013869026313385724383785051935256506784450227965020957296318645208598488161413279403683346821629439117327209071527878791167163980953326296620631874274522101994118890706372879111377721965738161511000396672294975037034526549811513789043244305969633354034500541113123255063232374386942908997046756046017320772897856114275234707703184161983806610888947627465435762937561231247173215724615365040435541390265704981699351563837340527277633975576176 -11523670060248463390302653643248573080204626895667435502164973305972185748470395654926094006744012148505197326052121545710242241891352369937317053719774706293090545099894988182012473466703170157783937873302934404896538337261995680454862441735502556865637909145839304694688324140057229642104588273654096346180116632418345589170248829444934471179206795690822184585196864577932274205101316913141872261673241280391442045565990088555353753789476615480189520529331131737084431448177942371080785938641454814169544682945510387155405628842164935394830439534834414364899293061798829902686953424000191565445443376301466821322836))
+(-1 -7328419378154692582095996154896871417180859364059215499795951017184291004736935585112875213382042963101672112493683604487719125754367241799944745692740709618902536797041361790998604440389784433400152821367677898112088109296974723158543796526904068704224629742155957873058885022730020570576709482486932365226790335797713714895726727450815580472833916579444462619458703066931877532806341876107345711861727491348197739596356734520853212676353360416957146142388222740037675402160621598182929824366220106466360520961703776266458001376729172457269208287661198640283928021363288512421248442300840001608102849023832845746660)
+
+; ---- Test von / ---
+
+(/ 10105597264942543888 14352488138967388642)
+5052798632471271944/7176244069483694321
+
+(/ -17631701977702695093 3931860028646338313)
+-17631701977702695093/3931860028646338313
+
+(/ -1606495881715082381 16324360910828438638)
+-1606495881715082381/16324360910828438638
+
+(/ -7960193178071300653 -10280747961248435844)
+7960193178071300653/10280747961248435844
+
+(/ -11544909483975853384 -16041992360613233027)
+11544909483975853384/16041992360613233027
+
+(/ -5758820541298901548 -2596462557714095861)
+5758820541298901548/2596462557714095861
+
+(/ -13056342734667572546 46502284983183419157350605242474199851)
+-13056342734667572546/46502284983183419157350605242474199851
+
+(/ 12668118634717482325 -338544675918656078399121171905238525746)
+-12668118634717482325/338544675918656078399121171905238525746
+
+(/ -16738429327795346815 164053836541028518093058940786011794219)
+-16738429327795346815/164053836541028518093058940786011794219
+
+(/ -9884600460121235549 -53914696297933680001835530599748561584)
+9884600460121235549/53914696297933680001835530599748561584
+
+(/ 6753521264659576004 71759828079371803409570464915096122874)
+3376760632329788002/35879914039685901704785232457548061437
+
+(/ -6072478784520825268 83641961138289700975241455431547940418)
+-3036239392260412634/41820980569144850487620727715773970209
+
+(/ -6708950756971973620 -9847903810677323447803434015107261150885944735136350527205856921771320298384705376646797569973415403097847060539915279223391112430240736564839483430569706)
+3354475378485986810/4923951905338661723901717007553630575442972367568175263602928460885660149192352688323398784986707701548923530269957639611695556215120368282419741715284853
+
+(/ 11263779860755455072 2292311486393743282743453705144070351222990311578446825826935237655927864700827857707370158936582804478427014131790879562565658386819339761919809732496450)
+1877296643459242512/382051914398957213790575617524011725203831718596407804304489206275987977450137976284561693156097134079737835688631813260427609731136556626986634955416075
+
+(/ 9956488981426387585 -12351244248621474338537656633137999145154500022264356186225225426288301330225259889671144104952158102155582320296061124840400655528634050137479515338944145)
+-1991297796285277517/2470248849724294867707531326627599829030900004452871237245045085257660266045051977934228820990431620431116464059212224968080131105726810027495903067788829
+
+(/ -14875992781716065391 4906952781757522095285156014969507916562921709689447567404076064849249737893410245743456952512717420040816186768213920574809530298070437840356629617118643)
+-2125141825959437913/700993254536788870755022287852786845223274529955635366772010866407035676841915749391922421787531060005830883824030560082115647185438633977193804231016949
+
+(/ 16043178952268979636 -4962728781666935768923030490263743715131420507991284894489828489607808897271220927863958149140648859077934323268424257800724618076505149638049461104621679)
+-5347726317422993212/1654242927222311922974343496754581238377140169330428298163276163202602965757073642621319383046882953025978107756141419266908206025501716546016487034873893
+
+(/ -14889985628902581941 3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361)
+-14889985628902581941/3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361
+
+(/ -1719613957783789857 19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758)
+-1719613957783789857/19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758
+
+(/ -10969623867482498359 1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595)
+-10969623867482498359/1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595
+
+(/ -3716891004757979686 -19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987)
+3716891004757979686/19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987
+
+(/ -4863232114852441787 -22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720)
+4863232114852441787/22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720
+
+(/ -16248276650501285553 -3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159)
+16248276650501285553/3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159
+
+(/ 18296946401228630959 3302341071702763311560113831030141639804425031433511503765833897787925467295486187687396312611805794369889470239777040624530990622212474466940548049117664906468330871893337410618797113677420975837622378808494314918471282099855916016026079371666730617071364751834080179173620476977670099126230223862266413091012344741482772771219725893630556702028108027870656512750807359335108428687238687397060104669074315031780019301768744978815422943986587389425726602444937024004102212071953113581935989741954695450085391443134273670514145585869912689150728183940456773133212037846765421397201956541430155664614978559762638030787)
+494512064898071107/89252461397371981393516590027841665940660135984689500101779294534808796413391518586145846286805562009997012709183163260122459206005742553160555352678855808282927861402522632719426949018308675022638442670499846349147872489185295027460164307342344070731658506806326491329016769648045137814222438482763957110567901209229264128951884483611636667622381298050558284128400198900948876451006451010731354180245251757615676197345101215643660079567205064579073691957971270919029789515458192258971242965998775552705010579544169558662544475293781424031100761728120453327924649671534200578302755582200815017962566988101692919751
+
+(/ -60488682170925814337492051725122486652 14880088785789146426)
+-30244341085462907168746025862561243326/7440044392894573213
+
+(/ 126617729996196635247771282957911941277 -7166506344996883172)
+-126617729996196635247771282957911941277/7166506344996883172
+
+(/ -278675896803726074870988122161067771390 7744689831802931490)
+-27867589680372607487098812216106777139/774468983180293149
+
+(/ -283351838662873779255871649630248958879 6912311315831153835)
+-14913254666467041013466928927907839941/363805858727955465
+
+(/ -9715584046609700027352634666499181378 3368831995960494221)
+-9715584046609700027352634666499181378/3368831995960494221
+
+(/ -137493547985106345282009151869389470397 -1916381539906956855)
+137493547985106345282009151869389470397/1916381539906956855
+
+(/ -328662747577960331872949773416436800743 -231069430804205460334599495337085157308)
+328662747577960331872949773416436800743/231069430804205460334599495337085157308
+
+(/ 213595640581249636406536485951630735277 -48492294677143227478357598229530842959)
+-213595640581249636406536485951630735277/48492294677143227478357598229530842959
+
+(/ 85922846498729014445816145204889624189 193533957681757355413031965695625196813)
+85922846498729014445816145204889624189/193533957681757355413031965695625196813
+
+(/ 24053342958857142686054803491202486471 196417511107100936775397820630955772553)
+24053342958857142686054803491202486471/196417511107100936775397820630955772553
+
+(/ 102038936612518756467074084117019701214 -111946989731587760700903475996379168167)
+-102038936612518756467074084117019701214/111946989731587760700903475996379168167
+
+(/ -3006867214208872584699983438179656913 -234257597822744479264249663225224173340)
+3006867214208872584699983438179656913/234257597822744479264249663225224173340
+
+(/ -279839802710533516603863620922251878907 -3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219)
+279839802710533516603863620922251878907/3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219
+
+(/ 123635964546481689465778244982425098404 7701433613491146708866098469269971554817017737111287276993583150548359764165526640986060909954451793171933304569726872785964805121981749276421956645830854)
+61817982273240844732889122491212549202/3850716806745573354433049234634985777408508868555643638496791575274179882082763320493030454977225896585966652284863436392982402560990874638210978322915427
+
+(/ 166158110049010486343321316578688184578 4093720847216792748840371965199135052196058344862447621818024731938681519017878880275303125899149558774718190527651555811733139227128378041055212888819294)
+83079055024505243171660658289344092289/2046860423608396374420185982599567526098029172431223810909012365969340759508939440137651562949574779387359095263825777905866569613564189020527606444409647
+
+(/ 147416259636838312272435267341375281181 -11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801)
+-147416259636838312272435267341375281181/11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801
+
+(/ 102557200511608632541115941654031896919 3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511)
+102557200511608632541115941654031896919/3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511
+
+(/ 47794953079190110032282671989549362415 3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667)
+47794953079190110032282671989549362415/3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667
+
+(/ -169956065319483471022234920202991103615 -9934427489865644196610501807375648335352544234206717324511161205173460054921759084767897792996557220898467288533128078406604709773449948420404563411793533441010236017064154469575084055359823982786110746700747423674942932421964955746280671982635899487781780756099620799397239156211815110739544719746684712086075069101799537802834839550142629064374734870047412916259754010150500874430055034366305216104752636211802195447299210332237598443674867760860326529472901775427058078447963316168327741049511844237329137194533000697525539835371015163158135757326482343130221118201740819963770851200676279882978581431999960842565)
+33991213063896694204446984040598220723/1986885497973128839322100361475129667070508846841343464902232241034692010984351816953579558599311444179693457706625615681320941954689989684080912682358706688202047203412830893915016811071964796557222149340149484734988586484392991149256134396527179897556356151219924159879447831242363022147908943949336942417215013820359907560566967910028525812874946974009482583251950802030100174886011006873261043220950527242360439089459842066447519688734973552172065305894580355085411615689592663233665548209902368847465827438906600139505107967074203032631627151465296468626044223640348163992754170240135255976595716286399992168513
+
+(/ -83006311763073652927964071041666508273 13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690)
+-83006311763073652927964071041666508273/13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690
+
+(/ -312626207169475064151212222217866488926 6989069923898656093413456232544365450599471748502878018530391549015151484336014906416216966193568842618920902504390187814247729346977677905224098932673981665869061845335443588666641982676550205160521286690015544764015602751932938178737949961754714143180917985455875095030469699198116593730005119922928175789172042067281849364217595912265452199938281052984802042194034638773435768458457616208103331213440768472281882976004050012769415198321241810008696147179275528426468408383757692656341606162350211696837361434874035354680073309142183699892959618671515841112321607728427286289324836870027735590091451421689980776552)
+-52104367861579177358535370369644414821/1164844987316442682235576038757394241766578624750479669755065258169191914056002484402702827698928140436486817084065031302374621557829612984204016488778996944311510307555907264777773663779425034193420214448335924127335933791988823029789658326959119023863486330909312515838411616533019432288334186653821362631528673677880308227369599318710908699989713508830800340365672439795572628076409602701350555202240128078713647162667341668794902533053540301668116024529879254737744734730626282109390267693725035282806226905812339225780012218190363949982159936445252640185386934621404547714887472811671289265015241903614996796092
+
+(/ -151709660794612786408772973806200383563 -26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443)
+151709660794612786408772973806200383563/26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443
+
+(/ 138834496986391136939574372853300933725 -8052690543272184576133758511645801940246473546142520821850130421981395129853341888352999304040698251945886555605291324954368612109314080471658982022831338507499254609048475429862437003158379101603576571787302167207044118847876475134352180874260998595377014195145760071923429129767580115085764485254455919915567128572731355497418831212259648020550107573824886521471697331410754043280744066090848295906051303624846301488010249980896364883452154860562864255354208802313850527991005497484253401461375477060954782095047043919500670383372218536999834862885439984085848342867301834247551832677237328664699302165347765799113)
+-15426055220710126326619374761477881525/894743393696909397348195390182866882249608171793613424650014491331266125539260209816999922671188694660654061733921258328263179123257120052406553558092370945277694956560941714429159667017597677955952952420811351911893790983097386126039131208251222066153001577238417785769269903307508901676196053917161768879507458730303483944157647912473294224505567508202765169052410814601194893697860451787872032878450144847205144609778916664544040542605794984506984917261578755812650058665667277498250377940152830784550531343894115991055630042596913170777759429209493331565094260318589092694172425853026369851633255796149751755457
+
+(/ 276499207940187081393841843387608369874 27347897028734618663428054896349668572244941195143856840032842195489553215406302254043947382368793914074147314353589439281000471813879502242851166670252197853998033813694814376228360691543987661407996785043637351295817024680721181205269262470473172181965930243852520386958529041036476807810647578694133804796395977642274699322030062940721165202488695975750512485574440928370802874677938542169620505668128224812441566912043326338714451629730522324228356364241376445033028898865300103247057378058702233150414643818049655628999871012383236520330575609745427181485617250755214922048672375947942288446974485524776744246517)
+8919329288393131657865865915729302254/882190226733374795594453383753215115233707780488511510968801361144824297271171040453030560721573997228198300463019014170354853929479983943317779570008135414645097864957897237942850344888515731013161186614310882299865065312281328425976427821628166844579546136898468399579307388420531509929375728344972058219238579923944345139420324610991005329112538579862919757599175513818412995957352856199020016311875104026207792481033655688345627471926791042717043753685205691775258996737590325911195399292216201069368214316711279213838705516528491500655825019669207328435019911314684352324150721804772331885386273726605701427307
+
+(/ -8979365591106781219797187096315899769868799444656824967426553299158070014074001230883484015880186603742048949313393413640240595706939311540002219411120389 -1698360947072008877)
+1282766513015254459971026728045128538552685634950974995346650471308295716296285890126212002268598086248864135616199059091462942243848473077143174201588627/242622992438858411
+
+(/ -12831814656788829919185319784994714617782749504716966706877579983082880759985031662545957372565411439648298939198657738497464024214657609856476819270030801 454910754379715)
+-273017333123166594025219569893504566335803180951424823550586808150699590637979397075445901543944924247836147642524632733988596259886332124605889771702783/9678952220845
+
+(/ -7834266257250691217409788323211914445703052638619784568844628449769010091330019095736167988675873769434766592786720961949649685040028101508217441360672222 -428418418877192732)
+3917133128625345608704894161605957222851526319309892284422314224884505045665009547868083994337936884717383296393360480974824842520014050754108720680336111/214209209438596366
+
+(/ 5737805823029931079838944835405107564434908634489801628049345331760087020955028323378020396677249341204498685189403657652738071833877470777083253103936452 9588993061977446661)
+5737805823029931079838944835405107564434908634489801628049345331760087020955028323378020396677249341204498685189403657652738071833877470777083253103936452/9588993061977446661
+
+(/ -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045 15760991890495426717)
+-4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045/15760991890495426717
+
+(/ 2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499 -6788234478844960330)
+-2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499/6788234478844960330
+
+(/ 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333 190237375887614033974333796608341639595)
+6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333/190237375887614033974333796608341639595
+
+(/ -12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472 -41681385674896602840749705069663453185)
+12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472/41681385674896602840749705069663453185
+
+(/ 13185465843955116174925558412278612918939024395488172088108029202384613698982949554556435640011161663974075894844304583900497170806796813871943782330552768 -155202352609947911537719051033334010254)
+-6592732921977558087462779206139306459469512197744086044054014601192306849491474777278217820005580831987037947422152291950248585403398406935971891165276384/77601176304973955768859525516667005127
+
+(/ 12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044 -249441012384365373362771955533424187237)
+-12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044/249441012384365373362771955533424187237
+
+(/ 8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433 -23101645464137481399279134347982485126)
+-8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433/23101645464137481399279134347982485126
+
+(/ -10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192 -25611473771508763579433379623726126173)
+10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192/25611473771508763579433379623726126173
+
+(/ -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974 5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627)
+-8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974/5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627
+
+(/ 7706102251141221799524762336156378964168657337573751909064577951085535246905735244239132983582998872001001594454632956803416956154262109939446710205558308 6334400709835247308796432875490978646658012545184955441452799118298109610816693049400832749087993843490999852355789914065232784070007399786089389453289854)
+3853051125570610899762381168078189482084328668786875954532288975542767623452867622119566491791499436000500797227316478401708478077131054969723355102779154/3167200354917623654398216437745489323329006272592477720726399559149054805408346524700416374543996921745499926177894957032616392035003699893044694726644927
+
+(/ 12609622044672092190084693450911157599596799695538449568681964257744962273690941575572590166273187189250007688411096790312605666562908125521094386992971478 -8237858212652788898158635047388584411011830102060269605835391741772914864422465141467281143809161251942948659243584296367296559912373856433388249393853968)
+-6304811022336046095042346725455578799798399847769224784340982128872481136845470787786295083136593594625003844205548395156302833281454062760547193496485739/4118929106326394449079317523694292205505915051030134802917695870886457432211232570733640571904580625971474329621792148183648279956186928216694124696926984
+
+(/ -9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785 -1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086)
+9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785/1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086
+
+(/ -10729942326579120947061030583094707809945059776287551713953926998992375520903658867971835616518813070294302895655369081976222497359056962112544408591462495 -4917625712783289245414023733273041940212797202855299465496072729329693853584860839801663152618595377553772371725021213143455497822882736730281253858119747)
+10729942326579120947061030583094707809945059776287551713953926998992375520903658867971835616518813070294302895655369081976222497359056962112544408591462495/4917625712783289245414023733273041940212797202855299465496072729329693853584860839801663152618595377553772371725021213143455497822882736730281253858119747
+
+(/ 8114113595157517238445304590338354472776364877475201453112450680537221171989478096363668912966343706408770932684807802285529572133696646343108263717309148 5443953102973235688784499815692116502566847594605098596244123647428188581304528525010862185203718640610834003873728718183528722470626702382993497913086105)
+8114113595157517238445304590338354472776364877475201453112450680537221171989478096363668912966343706408770932684807802285529572133696646343108263717309148/5443953102973235688784499815692116502566847594605098596244123647428188581304528525010862185203718640610834003873728718183528722470626702382993497913086105
+
+(/ -7125100205152691887479515774712530950031072786448635736036405923401522078562323494262148946679985384635556474075282302608446439950458673260234175964199684 -23871420315894180764743988478670341498770583257649869670486332228804693253344466615199983955886679924409910043885402198203427975742868174334723967563526738510726448815413356678504144193747696164586135745786501041060322480940451156015256191962506052700295351077719851275026974629635679531161390660244641370183176979934485671396035404817388717005746812037357500295693454623478902942336087760288091719793968445716246099043828787040340339906538864570506773535078524092440112404847904632624419421052178754041718790915772437556681684830937503838434712179830722395832238257078212535157309743054115702650740005055678387806081)
+7125100205152691887479515774712530950031072786448635736036405923401522078562323494262148946679985384635556474075282302608446439950458673260234175964199684/23871420315894180764743988478670341498770583257649869670486332228804693253344466615199983955886679924409910043885402198203427975742868174334723967563526738510726448815413356678504144193747696164586135745786501041060322480940451156015256191962506052700295351077719851275026974629635679531161390660244641370183176979934485671396035404817388717005746812037357500295693454623478902942336087760288091719793968445716246099043828787040340339906538864570506773535078524092440112404847904632624419421052178754041718790915772437556681684830937503838434712179830722395832238257078212535157309743054115702650740005055678387806081
+
+(/ 4801495919363827077158204249631885157347198552733998896638174958434968555935827788499392382851493568264006507028024783408190862186734863708684652212703744 29234959990138609668202089052356468732793041824333219340488007351402997202222578434579705387840772390513345507274006495462445058795870182760749392281528881636623188890883479914921272700981309656920982410970774047916714087713562927554033500521877735827036675598267184309367127514966388636440710253467328441763131873309183205727440365838789320851968108312559316922678357314418486932673434031479515016224407618177089903730349114511598373251388750023508633761000320088841886505077453257141723747388913336375142897897501529451618927178835485127020789481918641637409265186365292847057986276062625965612268181771076051892980)
+1200373979840956769289551062407971289336799638183499724159543739608742138983956947124848095712873392066001626757006195852047715546683715927171163053175936/7308739997534652417050522263089117183198260456083304835122001837850749300555644608644926346960193097628336376818501623865611264698967545690187348070382220409155797222720869978730318175245327414230245602742693511979178521928390731888508375130469433956759168899566796077341781878741597159110177563366832110440782968327295801431860091459697330212992027078139829230669589328604621733168358507869878754056101904544272475932587278627899593312847187505877158440250080022210471626269363314285430936847228334093785724474375382362904731794708871281755197370479660409352316296591323211764496569015656491403067045442769012973245
+
+(/ 10769619761532897875307527770350128978615798426116103116325434914975512103385205123955114305107607195469345895102375220593168903042839441996791318999499708 -7224105715967976893083374742254251507019823877014718307738328810406361200631626366722837314776666720638271529652546975342143108973422364041422652163016078890272393678677152791565494865444430757858556891645947268886646732022748338160528677218733159766121781240328812893374941548395710123982510227501927393735585082736583984561348450061452997663109932611188779299623613963995350679177776686423432406091192517292522853783968685873925548901506191291253596763183277703635837071862492572256145656312023955675669362656148946145528559574994353884313568526553663370513565393821926602014407548325293145102073923450066319746913)
+-10769619761532897875307527770350128978615798426116103116325434914975512103385205123955114305107607195469345895102375220593168903042839441996791318999499708/7224105715967976893083374742254251507019823877014718307738328810406361200631626366722837314776666720638271529652546975342143108973422364041422652163016078890272393678677152791565494865444430757858556891645947268886646732022748338160528677218733159766121781240328812893374941548395710123982510227501927393735585082736583984561348450061452997663109932611188779299623613963995350679177776686423432406091192517292522853783968685873925548901506191291253596763183277703635837071862492572256145656312023955675669362656148946145528559574994353884313568526553663370513565393821926602014407548325293145102073923450066319746913
+
+(/ 1505915608160301518246681692927442986955390537144107830770082927276722640395785957392652130911646706470337068266772174699405268120590454296080828168261019 31152879253507543898583880698200027990847289346701738353567402100527465991154555548630544962150902011282973749886327325250084401181379196961322399337408341296727915922288276602390334861175305055229766353672502691855637668618950047400571070157436221479289152631256433294884836727331457389922838951144187501751190662594278336543502171639899940796536926507796271202659224890656712231014450702948847764643603683153113663072089256293587951842007583210791100743318865647555912543508324790181772321217524164822106191538518498016236866957803105254555578252294418243701672226181762763332992886540089416888889135117147250495261)
+1505915608160301518246681692927442986955390537144107830770082927276722640395785957392652130911646706470337068266772174699405268120590454296080828168261019/31152879253507543898583880698200027990847289346701738353567402100527465991154555548630544962150902011282973749886327325250084401181379196961322399337408341296727915922288276602390334861175305055229766353672502691855637668618950047400571070157436221479289152631256433294884836727331457389922838951144187501751190662594278336543502171639899940796536926507796271202659224890656712231014450702948847764643603683153113663072089256293587951842007583210791100743318865647555912543508324790181772321217524164822106191538518498016236866957803105254555578252294418243701672226181762763332992886540089416888889135117147250495261
+
+(/ -4912349668310730778272626761660101328812783790262451913449395750351147048676353891314609774894027305081515542385381430403698808605768281804457186380542764 6582102431028556562269167182029950958541569095123705594954788174046339660437206159173417583841743892857066740116322758515837624700881569925244230209567223461401193316695082415261197843574563450002486582967745135870782254839990479649574452750850133306720341823136645982650022199634379361313745598455049448887744206616434903460504591098363901961758069797933831934878649993183747273660007900662110776570580293994733189753806312784239743585453090900671308673380802381312083077891736513388250097195232616017027333586286786139736783210630705878401429301217589001317082952461701571026008195534878902572422952568763551674434)
+-2456174834155365389136313380830050664406391895131225956724697875175573524338176945657304887447013652540757771192690715201849404302884140902228593190271382/3291051215514278281134583591014975479270784547561852797477394087023169830218603079586708791920871946428533370058161379257918812350440784962622115104783611730700596658347541207630598921787281725001243291483872567935391127419995239824787226375425066653360170911568322991325011099817189680656872799227524724443872103308217451730252295549181950980879034898966915967439324996591873636830003950331055388285290146997366594876903156392119871792726545450335654336690401190656041538945868256694125048597616308008513666793143393069868391605315352939200714650608794500658541476230850785513004097767439451286211476284381775837217
+
+(/ -11503235648135220410087372678575470255397243144180272745183844970864347348074104828328211521698012119761674096067066173927209129755062269068090560678650614 -5548338218081690289723998288742945948643693817491921699797822887914665364835947234564530865119623677435878746610856459141463506776423054050179729345956931675338102809929977610828639446535095411122377961067651902947030310564736893080382424590568134091858634304377553326990788802662029347894499019277621467098333287442862683493159356014650672092060912274570436879076161496563079759704321556494898013269338428360856068237785049960484767969682269790642298701577934519452927652996671267126348627432295779183359417597868330923329974640383630473044712419371517153268338860560601603043892503067815822312755611206254762903436)
+5751617824067610205043686339287735127698621572090136372591922485432173674037052414164105760849006059880837048033533086963604564877531134534045280339325307/2774169109040845144861999144371472974321846908745960849898911443957332682417973617282265432559811838717939373305428229570731753388211527025089864672978465837669051404964988805414319723267547705561188980533825951473515155282368446540191212295284067045929317152188776663495394401331014673947249509638810733549166643721431341746579678007325336046030456137285218439538080748281539879852160778247449006634669214180428034118892524980242383984841134895321149350788967259726463826498335633563174313716147889591679708798934165461664987320191815236522356209685758576634169430280300801521946251533907911156377805603127381451718
+
+(/ -22964048032108117904633365483799091488990853392670636861794813863757795874434768543212887316456319246155824842161717179767513360050328383696194174741889496306018655333450647372293193335577883672679165775070112770359697627614883420620410888137853011387271594559450892054491963940112235887802995117234918878648066362268919389271696465517050425727202664230530633207566444357393843669758809938086228366322548799235049875711702216182219182908217345405023677260470015666831191434586902791186444958476491096759363292487221288620810273243009200212776634572092195691654105986099646006756823055390654876878195583529521482548988 10644501761877612307)
+-22964048032108117904633365483799091488990853392670636861794813863757795874434768543212887316456319246155824842161717179767513360050328383696194174741889496306018655333450647372293193335577883672679165775070112770359697627614883420620410888137853011387271594559450892054491963940112235887802995117234918878648066362268919389271696465517050425727202664230530633207566444357393843669758809938086228366322548799235049875711702216182219182908217345405023677260470015666831191434586902791186444958476491096759363292487221288620810273243009200212776634572092195691654105986099646006756823055390654876878195583529521482548988/10644501761877612307
+
+(/ -19058897134776675884737764093896349427183484738023061956638485191239529906311503740032626797095131123523175909943402828257449376045336777553758951620699386266853663342003969442142858702229701661125904623724248177901462857013835790939020450746503125344631958534655024089231193396521561965297735217497608287565163852923704017958259400904834287026933197193592591423799328167149965328232560408884408251535373934831244856695227539243433290481951528897142697352526450162440279318507285454432916819060795455956931254810171588139618689138022062041222735056137988435900866680084665165131313435515187611756148824388549448126467 -8326067459929079652)
+19058897134776675884737764093896349427183484738023061956638485191239529906311503740032626797095131123523175909943402828257449376045336777553758951620699386266853663342003969442142858702229701661125904623724248177901462857013835790939020450746503125344631958534655024089231193396521561965297735217497608287565163852923704017958259400904834287026933197193592591423799328167149965328232560408884408251535373934831244856695227539243433290481951528897142697352526450162440279318507285454432916819060795455956931254810171588139618689138022062041222735056137988435900866680084665165131313435515187611756148824388549448126467/8326067459929079652
+
+(/ 25828007361450952719858846443651616751980622231808382804245407702688699228397920589229449608543284896555585501243582045708656531815385828908740757435341854996277769645696261182122648194952548457487178342682313459444433667556195761154944956714756269417591048771194019245925463541886773351873002480266654825771525233808830260734678788520487541379982691221386179066818743751876186761036101255542680066874888848011074569355779905086056095043888696435054884292698783753890317487209955316141370052511469715869816445031102161253514609763532756500340262263800747279044587806090353812452308490155782240390040070679663451429071 -16419739031141199968)
+-25828007361450952719858846443651616751980622231808382804245407702688699228397920589229449608543284896555585501243582045708656531815385828908740757435341854996277769645696261182122648194952548457487178342682313459444433667556195761154944956714756269417591048771194019245925463541886773351873002480266654825771525233808830260734678788520487541379982691221386179066818743751876186761036101255542680066874888848011074569355779905086056095043888696435054884292698783753890317487209955316141370052511469715869816445031102161253514609763532756500340262263800747279044587806090353812452308490155782240390040070679663451429071/16419739031141199968
+
+(/ -1669696848499325185991294008037906453080648048592518700324899343297324898656645662186964240087582483813312797482298159224575128489696846451225871663856944749639170892311973606684486632224811435175199158920841554176114937196187087530038509898368755036744105403511353564606301040888877621412514452110348953863172547944175251415725815533087344857665837809749724257466399374547882097484009980477192931829030533366309859182367479867549644502538060694266048652224732348150866071381652452605392696555259221463464108413747443898588713629829490175098280805280460168541344102200890646453100478450456898359263676257882174308268 -3154577849943484396)
+417424212124831296497823502009476613270162012148129675081224835824331224664161415546741060021895620953328199370574539806143782122424211612806467915964236187409792723077993401671121658056202858793799789730210388544028734299046771882509627474592188759186026350877838391151575260222219405353128613027587238465793136986043812853931453883271836214416459452437431064366599843636970524371002495119298232957257633341577464795591869966887411125634515173566512163056183087037716517845413113151348174138814805365866027103436860974647178407457372543774570201320115042135336025550222661613275119612614224589815919064470543577067/788644462485871099
+
+(/ -2215504974719141921873290809898041836016933916943403987778356628123168736190963062169230280020568365292362281642280014010817115943641228422541948070912910166283758843455538187697141038676028739959626556519808411324617157646799936128314485433146912658200236754847332237438334421065771940922444296618134121662770699950019164632463150784605652351782139277998735272280336096528241168196650073301607171613955878761317417480490869592669781417658461696905996344800864447403426286476662235990122025654999230690604488053668524888833992415515434190712628587043474760836969696399229242018051635699746048823240033842587927229964 -11305319675542865070)
+1107752487359570960936645404949020918008466958471701993889178314061584368095481531084615140010284182646181140821140007005408557971820614211270974035456455083141879421727769093848570519338014369979813278259904205662308578823399968064157242716573456329100118377423666118719167210532885970461222148309067060831385349975009582316231575392302826175891069638999367636140168048264120584098325036650803585806977939380658708740245434796334890708829230848452998172400432223701713143238331117995061012827499615345302244026834262444416996207757717095356314293521737380418484848199614621009025817849873024411620016921293963614982/5652659837771432535
+
+(/ 24358677073350645219370308521851912760304925518671532565724702185818845784332554892130070740233218685874351979772556877899278790031132507391155876157108663291716896413773711734271947599485714147026138105714458778787734198938526335256418673319464023475137997251085298903419563039860433435847755093653670989129405749785476487449599232956305952768800154351414655365461746574761818724131185410194605648466196476174400166047788352670171627261342369793028465418799251589432585363577887467959594667618177199696618852093807640490831859585621198048572586882398004957371434677752931134884039120875470266936204172511104679441462 8754800987327220648)
+12179338536675322609685154260925956380152462759335766282862351092909422892166277446065035370116609342937175989886278438949639395015566253695577938078554331645858448206886855867135973799742857073513069052857229389393867099469263167628209336659732011737568998625542649451709781519930216717923877546826835494564702874892738243724799616478152976384400077175707327682730873287380909362065592705097302824233098238087200083023894176335085813630671184896514232709399625794716292681788943733979797333809088599848309426046903820245415929792810599024286293441199002478685717338876465567442019560437735133468102086255552339720731/4377400493663610324
+
+(/ -26302114071841994464108666310942614602208671348774320769941579409198660404735714925432808094014718434192516800374483192192707032773903982752997957629389083405320034044554226640590549491188742685901503166669355807243735533977994184111229208270447279559478659750835531593667003322059717930484363943660175452777363121025595100592911646539549735930625865256846706785601753749996181113742254145758187876411260965175520035400453360390392991183382425735199046574346992179663247011131958270717402007532256308394559029768974932620173103778338779940189812875680687510582798628982957687329572431433891809534332514765287899172737 196971971351558855568201373145365478995)
+-26302114071841994464108666310942614602208671348774320769941579409198660404735714925432808094014718434192516800374483192192707032773903982752997957629389083405320034044554226640590549491188742685901503166669355807243735533977994184111229208270447279559478659750835531593667003322059717930484363943660175452777363121025595100592911646539549735930625865256846706785601753749996181113742254145758187876411260965175520035400453360390392991183382425735199046574346992179663247011131958270717402007532256308394559029768974932620173103778338779940189812875680687510582798628982957687329572431433891809534332514765287899172737/196971971351558855568201373145365478995
+
+(/ -25700334917103749626396366612061842558162882395534131493737229591609654899446089376271023701490708870843231350129849819430092002268875830384992877382393956173037794109904701961390126146975281052960293513473777226100954163054292968509501976296424278813632162404905591038465215586347229260479401862039805429711982871702185657527199220459658257385112793877259572278229045135617281858788415643567614198333459934599272409406206213115625226065750113120833933806486512117533453281522448845990642550827848765145774541658722594353290694745164913189694785762218575339370800538946514325662656804799046877175035545715523049884960 56325873113907570153638933263921340484)
+-6425083729275937406599091653015460639540720598883532873434307397902413724861522344067755925372677217710807837532462454857523000567218957596248219345598489043259448527476175490347531536743820263240073378368444306525238540763573242127375494074106069703408040601226397759616303896586807315119850465509951357427995717925546414381799805114914564346278198469314893069557261283904320464697103910891903549583364983649818102351551553278906306516437528280208483451621628029383363320380612211497660637706962191286443635414680648588322673686291228297423696440554643834842700134736628581415664201199761719293758886428880762471240/14081468278476892538409733315980335121
+
+(/ -25716495567761925495340309269248196976121711927176026606462843116646034561721958499564011513233986043633061335866265799467020807570689498961190839877265773450484494789052182300993137822542881883769593344810286970036960228835955266304979090841345697560418139960733748874044680214388098802745248923989851173047158103142988835055585349795022662576576434371181693607267864646932929998659458265265400181839509356921460222604661909947838434113964465769102604033848276159366897885013231683417270877512514679528402888899725431524867260144325739317224922955028035417867933390409466302057857579158202739536568407090965929352402 -92089830031261826185903006947297196357)
+25716495567761925495340309269248196976121711927176026606462843116646034561721958499564011513233986043633061335866265799467020807570689498961190839877265773450484494789052182300993137822542881883769593344810286970036960228835955266304979090841345697560418139960733748874044680214388098802745248923989851173047158103142988835055585349795022662576576434371181693607267864646932929998659458265265400181839509356921460222604661909947838434113964465769102604033848276159366897885013231683417270877512514679528402888899725431524867260144325739317224922955028035417867933390409466302057857579158202739536568407090965929352402/92089830031261826185903006947297196357
+
+(/ 6427758281007308443295844679532867042370757542760390680622584758338041709910068192973790897624827722686313216884084305612889554116246627679267186323854642904894988936981064543865794245002470271142875081223308666588659587718561791667575945670118263124267218395749059879636505504607358472659126298770422135028955713148882314050530771750859372048576074912599265823577267962213046012777760882389021047579367276198483178024744924299929585515193595330026399302022065656106472153858484998010254767462854235008343139218888170221421046454280858208068658907389288543063912721882521711363713136166478126504226820360347652405439 80854661163518168674595213426641201760)
+6427758281007308443295844679532867042370757542760390680622584758338041709910068192973790897624827722686313216884084305612889554116246627679267186323854642904894988936981064543865794245002470271142875081223308666588659587718561791667575945670118263124267218395749059879636505504607358472659126298770422135028955713148882314050530771750859372048576074912599265823577267962213046012777760882389021047579367276198483178024744924299929585515193595330026399302022065656106472153858484998010254767462854235008343139218888170221421046454280858208068658907389288543063912721882521711363713136166478126504226820360347652405439/80854661163518168674595213426641201760
+
+(/ 1960728263483597985471065015024594804771170333646104429205729831998416939777820080209106943861368202560376682136488253096512360698625765514606930980274938979705620987031595592685578710084284618125325617453699875318678007463857705931376750632972266553809944621631324385690517092215690694024807784270742388108802858889381036105223858467345514041786882957807868961085072340965930749117411726729713477739990680381647988935514765113077094375924848051541167125595015542791382355149166582367766443782842193396221676952668624805183924877889696428989259842153378327156342464279071638070457876940165186524833987190050817072048 91266493124541431873557009470479491083)
+1960728263483597985471065015024594804771170333646104429205729831998416939777820080209106943861368202560376682136488253096512360698625765514606930980274938979705620987031595592685578710084284618125325617453699875318678007463857705931376750632972266553809944621631324385690517092215690694024807784270742388108802858889381036105223858467345514041786882957807868961085072340965930749117411726729713477739990680381647988935514765113077094375924848051541167125595015542791382355149166582367766443782842193396221676952668624805183924877889696428989259842153378327156342464279071638070457876940165186524833987190050817072048/91266493124541431873557009470479491083
+
+(/ 4941680418946960910262990974014623728051861920391294141439502190044830922127013115391726343950340163023958511659132792063033185693862678433421115681422259770928656196358763089894449447854011668445981430826871764812047994423858851467292757304285634515474652989618200442851239459073981986390515468331839802701176644729973346052528164203299481240263263697394061787580128379398464090163611942724580936445878570184925290925246112514015572149640886198984723311273144361235138411362294735799814160816806773736605477503201836095726740734281001021071803299510239436683913500734680524381145064985356627091311888606290704759943 291575320383555320391938911470370670502)
+1647226806315653636754330324671541242683953973463764713813167396681610307375671038463908781316780054341319503886377597354344395231287559477807038560474086590309552065452921029964816482618003889481993810275623921604015998141286283822430919101428544838491550996539400147617079819691327328796838489443946600900392214909991115350842721401099827080087754565798020595860042793132821363387870647574860312148626190061641763641748704171338524049880295399661574437091048120411712803787431578599938053605602257912201825834400612031908913578093667007023934433170079812227971166911560174793715021661785542363770629535430234919981/97191773461185106797312970490123556834
+
+(/ -17803449239532304707372697093467431202778585961066204978641168716990033159088600623106396534094218402005803618121159982050197012697237961155375180768349707725936023283589475384693590539312637333226292265409814019687105755522332846972859860649558844229320481883408457674560284773922666633054564243260924189551494368660033292970122831009582038986061326503238023206238467592238752824663935316307653075615249537594229930297642710570473007696494702367783692850946455203144153509057520651038068881755863521371187245025834292163874467913915588768778393773565536027848586260129438664753479013894698439967637389690509120223682 -10962227285754340409566802000064407225866105372406170304563353147415988225079632767886653994299800743521362563345682593189107807948342418743229049299449088)
+8901724619766152353686348546733715601389292980533102489320584358495016579544300311553198267047109201002901809060579991025098506348618980577687590384174853862968011641794737692346795269656318666613146132704907009843552877761166423486429930324779422114660240941704228837280142386961333316527282121630462094775747184330016646485061415504791019493030663251619011603119233796119376412331967658153826537807624768797114965148821355285236503848247351183891846425473227601572076754528760325519034440877931760685593622512917146081937233956957794384389196886782768013924293130064719332376739506947349219983818694845254560111841/5481113642877170204783401000032203612933052686203085152281676573707994112539816383943326997149900371760681281672841296594553903974171209371614524649724544
+
+(/ -11349783565099575757929584771389010505157850113880084607145768380886038854233583951229136273631022011781914171912628263930864052254964518914857757025547156428098062812984733912827827545722979442676567330004437902674729872754963478834939047061999292143602525229120558979819117729589695377623970606315287270030693151486803968345724658003068961239204812937084581894755863859944500186226990319892122692007317326534880413455575446314965159569830188583093978564829748603480193166063624130610256395632946002879039047154077629561745862713628266069928068634042545592328263646730943717246953000457159714049930890865576634096206 -5169948998417532948043886408019867395123131165917923418040862036041756675786217242743410895008311710518018466892169868028617239526646914529999134517417939)
+11349783565099575757929584771389010505157850113880084607145768380886038854233583951229136273631022011781914171912628263930864052254964518914857757025547156428098062812984733912827827545722979442676567330004437902674729872754963478834939047061999292143602525229120558979819117729589695377623970606315287270030693151486803968345724658003068961239204812937084581894755863859944500186226990319892122692007317326534880413455575446314965159569830188583093978564829748603480193166063624130610256395632946002879039047154077629561745862713628266069928068634042545592328263646730943717246953000457159714049930890865576634096206/5169948998417532948043886408019867395123131165917923418040862036041756675786217242743410895008311710518018466892169868028617239526646914529999134517417939
+
+(/ -4372008041495429462966226028389793326873997497126815043214338280101332483009650104005998792061125254101227371430911497751865710691604158789733634394053254604723940088324934622768312096370232736965692181452463495731681105253628558429524788376108667441329817524961077744083376843098018692898745743361309486938506049017980865957895278210133305721083115513131884239744064081819033733041876411992332060293539102545847193260167588667810376670587099064558298380310132769718526554738650709745767046942440481512965138461694790645096012018276362849398785863823724642554436182185786302301222529261914437437947741031113015699315 -13213007132248918651858333568248204618745148942720942572088217188768868803339938910599097839075045781852237705726227293430250507070717570662238736211897310)
+874401608299085892593245205677958665374799499425363008642867656020266496601930020801199758412225050820245474286182299550373142138320831757946726878810650920944788017664986924553662419274046547393138436290492699146336221050725711685904957675221733488265963504992215548816675368619603738579749148672261897387701209803596173191579055642026661144216623102626376847948812816363806746608375282398466412058707820509169438652033517733562075334117419812911659676062026553943705310947730141949153409388488096302593027692338958129019202403655272569879757172764744928510887236437157260460244505852382887487589548206222603139863/2642601426449783730371666713649640923749029788544188514417643437753773760667987782119819567815009156370447541145245458686050101414143514132447747242379462
+
+(/ -24003371850945507239307096734506644624830254935119140199726507920301383328662376914775504920527918338079792692943250446679097229950654636321252144129692109999375967030689211646504258922323499994340282315270808545865248969923421472430657741998787024263629527291510416193284540865950122841477102934165296344839654902079279846705581902668360663987722715177845485423354226653585575109653937253382583158263755381721094429734122004436184054214443676096492583897635497699417294183504529284810360226314491839533303380490277211336049582128602304906849999737224506976061216780230350942535246958957024226614847691329767208211525 10686139440491678930358521446524488461285005495304677740436234635584738003880529034339295291091217655777627375148264449580064000634364863951333061091724053)
+-1263335360576079328384584038658244453938434470269428431564553048436914912034861942882921311606732544109462773312802655088373538418455507174802744427878532105230314054246800612973908364332815789175804332382674133992907840522285340654245144315725632855980501436395285062804449519260532781130373838640278754991560784319962097195030626456229508630932774483044499232808117192293977637350207223862241218855987125353741812091269579180851792327075982952446978099875552510495647062289712067621597906648131149449121230552119853228213135901505384468781578933538131946108485093696334260133434050471422327716570931122619326747975/562428391604825206860974812974973076909737131331825144233486033451828315993712054438910278478485139777769861849908655241056000033387624418491213741669687
+
+(/ 11114571678097117920369007866358540243142633567044843952020632081573546909920632543585596494530749645890342978505657174505155646987551523455565703297238406590291026899487431109110746657023874064284362499621762851387854720746040865741433394111425240861542892218169985953747711593827913014379823797703717216676877313898809377467394109623799717556800777662963842899812297087284510893865429864819927951428138755600792987191034272014681606301885821862650098620488569288170357746018556395309910262410994899971436293672676949544989196526035130226777567220128838888396668158456237490064462262193759918857287915854681904206680 4808076329737968688023887165061921594706561818755147855784713748545995818001333418509444774306288638038607173052166709335820929501845348060033808100812677)
+11114571678097117920369007866358540243142633567044843952020632081573546909920632543585596494530749645890342978505657174505155646987551523455565703297238406590291026899487431109110746657023874064284362499621762851387854720746040865741433394111425240861542892218169985953747711593827913014379823797703717216676877313898809377467394109623799717556800777662963842899812297087284510893865429864819927951428138755600792987191034272014681606301885821862650098620488569288170357746018556395309910262410994899971436293672676949544989196526035130226777567220128838888396668158456237490064462262193759918857287915854681904206680/4808076329737968688023887165061921594706561818755147855784713748545995818001333418509444774306288638038607173052166709335820929501845348060033808100812677
+
+(/ -27971792815424016824370019866875377333122266892537700816201893161065327053508379094007350664178576160161460501442627646041422270472469587140689725524176629653056006769618104516779694726446739085332330345789012312708713495757968594985567285237456431009983022526625885024663335598317191838389804118084831445251467492693688286258834282078888862754754572546522075833632779922232880101875914894393005204887265821991459415144492487189071888581048779385051174007698853920104709378859053075296413813207007405843448595681090932498329066591349910723578718333092115184652723310842559914379989208301125396793101430807658654849482 3169580893680227534064172567436590084742349042688765883461923377455374714865282199177755353861979892274552092801376364846717140845237173266602633583445110)
+-4661965469237336137395003311145896222187044482089616802700315526844221175584729849001225110696429360026910083573771274340237045078744931190114954254029438275509334461603017419463282454407789847555388390964835385451452249292994765830927880872909405168330503754437647504110555933052865306398300686347471907541911248782281381043139047013148143792459095424420345972272129987038813350312652482398834200814544303665243235857415414531511981430174796564175195667949808986684118229809842179216068968867834567640574765946848488749721511098558318453929786388848685864108787218473759985729998201383520899465516905134609775808247/528263482280037922344028761239431680790391507114794313910320562909229119144213699862959225643663315379092015466896060807786190140872862211100438930574185
+
+(/ -138888658164471549506154385143989713534453638138516110941977029 48484067562152384719540184707188444570280914254129306788137384972303743285284814 56428088099244342456240635263153370817851703737803685168591843059886944388583310 6984617762898435035101945891920384937438416626357047934508608980105797822504000 90193136183227859939744547239819443586783276313678017953708293432043879247302040 70539472782976230144489157899475475029273447055080677052149474853222128626227832 2525164589393997980217929709704832829968554364529060039097810436136432713906553063644429644328565051224269893261942396763235990073001625976866246420775436 15614337547041181126817477188043219628044963126229393225781917631975649438502836750353253851523795212263078850399716875892512719059737913422781999218667136371648316387382440793865460028660248325297931269646982047533754121791358966254514009830876592200454797694143082163294323565673200905929297174223061890100210054105027025488322289599106119653451218493916291922340123640475500240519924011764050880374885136181582395113140580448936759383024305870622004464940344826337458060607492042593813585998516868215921180540240201095202617277388950504036371411600204964284568597705251929695275183521036281637399204541958859605054)
+-138888658164471549506154385143989713534453638138516110941977029/4793535847709521198063287553243915170068914691727215964454867625024011698922303669226389748584276840530192157568469968220857898703102351955898913589325705637953049380748829567692600765708909637920797057370082064005557328769108356548100875674196976079597658854339583183901899349355521527519781721778545444496852540362424465770767219571362842157786846795990148969989617793004579188905882473140017509154008696803103206996067638134383708975696867028865870695941933200225325283190379262695816923376790224594063264297952504481719779782130509306530621779762254864669078635401870023086312919956154224782043667754741333688780367667466505233610011253346902821033707597517691608103391952937194719540981992469020284583499872663129517095879706480339710037976698298522952071766717472040399518290905103777436461474880898550115925718887748413534479076504168236430697214654069473800915087572730747027455509241250627470590715812698745630545585772046458363388764449879417348554556621640336029897762172500880501074103433267444717053504878282494505367980026597725927414511391047010801407870379019921551218005714825277162504166028680939100225793768617321830389705750902850499916610355200000
+
+(/ 2902267908619179684129536324641634394442732593027015198805855082 4748067699021154152763168285921806700655154833226062437593302484475663167752990 92172802787151156076284963978247829387076983213530315481815585776147505007251090 15808981285029107672090190966349736198141855760941720122983980047623201110025085 60559202289239963744584432021634662330089323842876293477363484160210450706125345 20641717016962556495214267565148984505293698026059157698737040675346468206231142 142380249473014630955299439077662853963947100833592874440361316474000948841420058017600161066408668117933232436922811486348705081331372574460204309908598 22418721268614574393232189860262616514600143215945007038687873335656746730488694050883006164427390756358558140145027011322151188565843290717535647848841274550496431839061217253488169143292339455650565906288959125935798633464526818546688779845699340483771625364583343140648892889571715648295855169294054985996834093294240640072029711789359793649773566295329912082241637482772608479106201840565936084243727069954911883243252762742415647868355726139789907900798435783365130277592703989608678774745914668128791639635886550753850811717805962562157686110637810320436812644047534536168343578232389700410352900247092236175044)
+1451133954309589842064768162320817197221366296513507599402927541/13803211377640454778526029288269623376813125655593684775595099045285713415153039020789267800416616529908688645478733023490751981264976732618374046330204398361829051480928696426688037404239513603403603849882719851670264413777889524531938606364925013854252374108222701436535488401321603495905123597139234414735397259257280679663147039651553472142280954446675036289021783142392760217244908768132158498744301278889276778209560846418263599491357632762902447742083022806085077053406738681250354036208472026046315736408632370478801849290705001622808552373129971427533249307210975612625050706661691322027927380443494854794852235813844542319971019369687589916047377092369702778251658652143114091304960406840026816351348391618676357634544120732441610431417230403811846208113160343697557236265319994702483700922393762500190362776377442551539417224595247790865885105594005740401824824367904020732469833438717527758468635665777261969819260766044978137909489986407113029460354144391595512642835261443393260585888868936164331461486646676578398836326366036777321522851855085808626766493197635871100152761464712744017549919220291986785134521319127277292845352756807452050073157340000
+
+(/ 7798204144688205291220879078360728451593323170355809361079096742 35808393784851478122520372074317359817820799318259895240196875729073154197251420 58532175726063855694248618287185551673975962776708803423334853085996022345828434 97834368697888769536063057370864051207348099191057106781292664602519775900739777 92489021460656714290092899983209031746574776013841975324837145038810562509209529 71083733375588666647468985607775761710974844539643116636307037921671845148256816 6123989271760127932230015643359630675168106436173654465119508990415235040641894537960236511442249258231302028977221206744158863083898145166446430168108 -27418900206398855942064397259705713102524342707255992250395147550519659429645343464288092288218160406382406024735131578979728501208163782063519839258876833755387025755815673514708453862847139552613587001235204464673999898312854941659541050445981594990466469147364579547089805525464252876345032296745312923488525701877655352034887018931755379078328147999631937419977103372927428613463482328465834563846802083044643719319690088670748858904291298575733560600669924511028715689681303059001186388754140003746463568171428267337107394361025465082282061651196456268663181772211292647101192148287507051053367729008997838464209)
+-3899102072344102645610439539180364225796661585177904680539548371/113184205287561573324139833190653102440730360395399197973956984769580868365256138025034414373155098575475566747215877030265786675432252675717351889433714136838615056208470421665419618669892136317438270826178251174708190860235979949204785938786562420189510825909814566675745650194525647207897976611434325225523578368855952217879373499055292850828774005130267218801086474623429504045290678320168493275019256514768273116059350700654655821674309331585233552793659038912697151359657915391954687630783641745610431060563252789714638916120291482852533638921356624929690158752601417722733222880768367060672103351737811624242610815140332559619520810810999145535251960674284283045907801934328911198563750515779896457101601178888594882087326241517566336011980952110586199881600553269825310575512911473547251704677890770772166895623118832621335417348044312911888377718725944255218219811801447500167145561774582342171995333086224230231746597452848775656030037837271428187450747141983599129861631612369300880722326218963779650411119279310045263996988089484063433088077868691314162108392639864773907107325220582413508233901954483499166402135445110435112499264825479433389003494762240
+
+(/ 6291885367078853457481986049409245691302078375827782321496819120 20959289231548357352292073342856567687394126070322865796282035211176720583560298 24366038587110130209541647226271577368736240640393242419005751016119649778306566 40118119174220166901790237425673316895032570534639145502274313654443256239236466 73598137358602854818844747625643480865061277528564461120022408463105339470504117 36695182446520138181079917512512743290981469731336486456411609014364293489978544 8671667981598505073194269824535189054936442262459158402875147736469644925300845122881093216273840895555488593258562684601176239455526568314028830532770 15920064019095473156324398162334173238735268739049399738654357508344572552411935473846021991360836375685872129737682603096450566258725052013769725919038955505690389573813769125933987978360857342250911865713011888064725725934341157729878064563080803955584985269499994186472079783942404183377695242296289152788154908185130552013951432753148997632323578507137074131845177376689609114975253308906745794984371839952312988353950198030866538756253618535421214253194954603293145507537939731320546686208032528588232652963255550963088571344119439249328480867640436815434047309164687808223851012490130534705427647158409623238123)
+1439421788255379275215959765325419043929720157723371200401/1747562187028503746686299553853635643553063923188506902759251937250022196751705340155682655202720363192751787186892107863159676381018035068965958466119538181810433273947829904580526582292369320932134048728374142501965682147541817431447933591106030690334465450755701191781243754499216697336293783127396687916725975251100500896467549458036395977769801208905203001097425041200299917628353220804629035768571072498715030261324138691471497255335498185741379289492513543474304524261634247519034231348033379344777678679950561777846684978640375273167561174451700942154388980887510088060818147834369595669846115248027925007288445161871535514130090907585140894883683709507099726386549038354860875469377442908932714711235823032704493155679240378374325069782368108779247450762222838197717507164088182062062215767468125843278459189085290703729281279344184417197883359351058003644499215541300350121854220342250451978930421772367851329849662028719768708399155817754711362398236471946313773603716759409265530444582884661320404389499624411965234669344882203618613097197387901166904575791500958722726774956950592290330175936039556139052663816485140080963740296685158607671768592
+
+(/ 7377598052472799909620353419322603137723415431070641423056433630 50990728761110292768803869421408199244526424730838143228662194914314857136430737 89434155113971221138805303763480423496687322824531744020762041598590716339098287 91343386111124700155689622654961840380754244946720984970313893805578518003516073 5641075230099727784981579696383316732450130418277879081291954534985607255267932 91040802121912074401640073226003257602385910518707524375098380810792151468159323 59272268188012925764499414539835790113036863511169317924034366016920114706179376837448098952655862721652129333873020625135398431500899131874782270590048 26690053756452308398721390096804652429111408747235998849320348549870126230712525274708597346508961935323823048352116439255386668122483555236157562141222434006899926132549352821247340442387991613448730451171206857242290791156220288682675982609964518905569737166444127835826079348146626921864776959482079234994631361894786436656768739968380067890165160954836874044821979903056957225885565092422439358816023307475581832942250031121721325840673134241504501661692722633100336840768527354183989544434614842654682324213774503456414914613412547380720171088896588158750436205804689590730033393056191028424154915201435563063992)
+3688799026236399954810176709661301568861707715535320711528216815/169215718032454146095901737002485678790901914179482864125777331106759302744215797822810809511498045518338288799757661725047129775976254373463314416017128993811694804386237923340900604770406784566473173755998386770282409830097844352035251738093305402541509197084964701114515390028814839744480965823142680384744649624767291550851759670297818996073873968006960956353033659153219390871979066743795530136868490210455800714335529013059123604101460242870160400211866883478263106349349114199154533363251799944090298252763172390952446660627602934622584400932001701907172000401485323481964448487312714644861543740014645407417493588261100128985848137181719614326345024112347151970444057551896842474702539258687521054961314443551837168457190568932765925484427579811571491887599619302241390226818415165012748654917331557679228501007751078584244340346651276906088856205294333241792044902850102153793417101337667969641035858108457362954650972654353600494166650067557014544136240962457086782865870886529792004619668808741311540795514394731398977642092124679638585188974746423756335151669217754388004341907440529525288302872368689364872785975840444000802518095138062596107983803117056
+
+(/ -239344771695510351349291992975349015183687755312261264640655565 59880027487583466136533364102518649070390160795136023810470091681171428955831193 48344457085007359228086666145324485903333773379391455489556219681156342646858065 96824393663737121700189215323825147927318524415097221824671795011444303522438090 73240728471954064253765051525185557601431281145369716902120469411886093226662465 53476482728312567840603110355495270554470432250981685279567813448298175801364992 2468459436652089730331798017030410049989399340882712030505584719342958436741536069714790640546086933185494149096286590992747248311590137695839482679011866 -20583944357058654336975302336113341974001469085102805363209530168831840401111182124827636905521584509677325966689931599005216123375088335255672290604710305325984961984791919524676460851699284525672773368217606895110240237523696098521003978238685169880199868729577660354717875890521074505342309726366304528678619465048659607726264456481345739318939431629704180230985397408136331466856633265343276511285483458860216756106887559724757372775728879136089013590836231272961497930729470443491032308329051560641396901204040829291495325588896591482909336032903587307512310970849256645908744180630660878534263566681640143534823)
+15956318113034023423286132865023267678912517020817417642710371/3718709813392127924163278362562751486187605430152002432053108623099406465632705761508167478249438322470295467114170871555665890539409511492475240415534629792791729596612426725326976353265532166735941330128195885206087665506220364347120981130748862937276841801804372097254983242962029582754709606117339082763083905960784323141929645331591164015455383939302728076410053178677168172481507115685831178503426055335630689722163467637005123748113214310366231893390818795405612007113310547901224920768646006621130651182788173442625298859454337696280614462941186626306295514630883052819172301830539345633711941340491653447613466053205836875456839023743314390098829184111583809697328393569588632000669468187410368485286035179259523632217543401146996259011916302393091677624838641658623073752023082344005134299104409908004250830639232078441523519412192782367689826532215394196055149255026188549091956300108740792221660678858924234682223183500313556198187095251404633698868186071148295957994257417049500872570631774233307260384902571112475241073598945295745287525486108978093728296107260155093397986671349139935376427469718767763295900745932105722655724205000829205748307261900800
+
+;; ==== R A T I O S ====
+
+; ---- Test von + ---
+
+(+ -6069217517368004039/4076344942716985944 -399587800008780737/578697755310708616)
+-321318766345655960630110128852941297/147435729263904928853096856396980844
+
+(+ -41285036778370718/305793940074617155 -1396094619926552183/15846027887642356854)
+-1081121118676718273499338028514700537/4845619302294419132297197085940230370
+
+(+ 15975644088444536091/18063939613598316583 17501188199168431305/2979264551795273683)
+363736076920798535449296038324193823968/53817254956563877935003279344562385189
+
+(+ 10197734562406803221/17452826108659293487 14639450560606090654/236781760961536951)
+257914422508077920978698094723491089669/4132510899763835955061848877304138137
+
+(+ -16810360766832230069/13652857552883800956 5011749175730438558/4169057419710079215)
+-184295743992738197672588473692806043/6324394120121667288243293659228081060
+
+(+ 2234573531734039025/1128831476977636536 5842177084459535064/10255356071975483971)
+29511180623959738330730559435115466579/11576568741659658592450950022331964456
+
+(+ 2268894928233321367/45672733521488298991909987382109984899 -10510750087507287356/187832098427494353069556175466145198255)
+-53883392376116199828369509984040539934420061636271022459/8578805378260910951788610598591490227836321974082207035230408675959411151245
+
+(+ 14273433611429514043/7774518083776389556784045601066955324 17247074371340283485/225579726714102822702316919752160926694)
+1676942472465190408518249346164012571239098147062478293991/876886832336064155131767120243155911448808491410701588797601053820468509428
+
+(+ -384768590020206817/26284423885474502132625533495652664626 -913687410374243983/254477371735734658619949996700223764026)
+-10160887225658731404416073535892287983824191154410167550/557399258996959835387173465565070652935481894323496556880024318994528462023
+
+(+ -4465222504572200650/89674568206322981678158378582739708537 4148550863841320780/74302497820894496090312266744880513261)
+2118016946376507498169590394563632549990739165791772590/350686547828419379316750498534703170285368675911953477374458878558215968903
+
+(+ -4466938407638238142/281859125741189685767904931589784285893 7302241525893379697/204618108204962312932373858463395271264)
+1144186926000295881841982161759159994442430111060328362933/57673481089466829503954266461746705742702466399988738560842837126631263478752
+
+(+ 6692616266348342275/280491911593106290120490189988812804382 5414100524539959087/183579771905991028181574615911067652873)
+2747240373316006570071525025488180559154305534334705425309/51492641151737853299832848099101317109893853469394209716061486746077629289486
+
+(+ -2794289802081124319/15768464977850217600859580216291365931410230647587457388598921425875331529149 10869776169503285673/33805119742344157512165738805682358903614971418053290198565741206390317449856)
+76938383491719886409504555688515759257937029058461512747558964579607347503639994773101488934213/533054846729186819415263583890627325668798847177803707144003483502948153457972377767011992167761176556555806720273883868208938866192358148729990609852544
+
+(+ -253222140119290489/2123024034843473393742534167007121513293496410591072104903085284304117612082 17957334013642389787/32058972871090153103034645121513493401113378486125580864856088310966601405847)
+30005809992231287609744177955201962181880644831204431411802631067134766877061419104162728517351/68061969937719269465960475690278941280799593161143759512261685488134507341176789799765185182008442410081522124548392827986923668912612728349293792643454
+
+(+ -13318881947309618/3105936147298438543619802738126617974207009907186580731552500517452462642139 1850968757748704519/36469179946212878965111748233319050931475015876401494718861814560453153824935)
+5263262069792987469108717688485565287648879759118200779949761992573778798556738644541735401311/113270944257273905484832818286307416845956086746130199501242465128236430928807948126409718436237517505516279133169796919230385184900609912160483959935965
+
+(+ -9937822914683494298/36414156259035675966580098631253549474580108307284844243190992829476777586283 -13712605099585970325/17758145954890657915358548152198427387923366136638180213650029984340849686198)
+-675810254607579372158951115566887998278519717754376916387787672973408477396668549189167387350979/646647901672150721610792561233068038707362067627156669418022102308446036384411330678972562863413004325878365438890328206637571985169324874284800419222034
+
+(+ 2479135971595944301/28169711053558469409458629766960029324030958129245230797895768033968717159836 3427244662960653095/28446538857424788738244844756675951434179713170118835630969510829753715142438)
+83533664807147783700314944003289704497366290621039272787320536148072960487262393639109696219129/400665390043739792096386856839000624247597803909916773326187593475005945995926511155915226239317839405221783416485999405286913042389632370302962776360084
+
+(+ 14865500635281371370/56222262470894935247131881777606182311286871927285650835673424014252462156319 6436092572090050725/19282524131572095520593158313261757267758159099923763177708581262473988426947)
+648496060602737474174747620183913927791943082591316359990137585798909535115053578637078811588665/1084107132826611778585714784136700465449309125114745313342842325649687943726086785657821763235618936882528385000712567133180567926723616940173290425928093
+
+(+ 340196811925805824067049620503247332111/14422464039094716975 51285507111580975533385007190438537498/3230944134273302873)
+1838820276033673324738967436225477772648372110186756083453/46598175588880723338390245118389369175
+
+(+ -210449319160504160992731982827917332322/5436857856220342451 251628249079137248539965770847855056283/4323109210037952829)
+458271632943884346915405609513071881239303671882386130695/23504130271893362375786510953364243879
+
+(+ -40984360445255688839942109197081457275/6593417935076565019 -138094174027187773198981391229349265879/7135512300754720691)
+-1202957011856131413678873259651070808566709454882536663726/47047414779755620074837011989046108129
+
+(+ -289704472880230079383856507128133962457/10452740760651010288 -55251460678415911958671096669490155237/10333740726609314202)
+-1785630052601050832889834016432677758176770083879794496285/54007956451514283340719766211063255088
+
+(+ 276702099951674677215621541062877777467/3899918017008359516 42623843937285717338660228144403811741/1973785812353331893)
+712380176058162142132059442064597996057720566915757732387/7697602851312240113570356856612843788
+
+(+ -323480614013303716597188084301661616596/12957985934572321773 -72966206939397711493108854138997499334/4539020357040680881)
+-2413780175334213399707013296172687953960842714316410700258/58816561943270580900205343368941122013
+
+(+ 65443777543319569578713907336699651721/218804857459609839540825438673960136766 -61986861924091374470669233802827103921/65997977315012279293170493460332070399)
+-9243869541956614722377007489838492339200370508580665293676272508698701352807/14440678019033825487758061900150103876633207457375858942267120523885980189634
+
+(+ 75417845823236070411341994633288547531/70553457686181702397810927701121800017 -7132208259849175775323757110664708879/24379326462014713478002790304943339422)
+1335434330716260509518880689691257567128541829706203586134358870209350816139/1720045777955364955754847231620711706115121721983605654691934662747636370174
+
+(+ -144692585186931942602350348772472248638/135233395864627580439431775527364081053 282512666765911374279543408363363928190/317835040256607665191397469890906044457)
+-7783226336195038987381961251409043080655184208289882004756343793157154115496/42981911818671667582796085276418080952868666330715445603855323471628969373221
+
+(+ 44888992584766727877549626240272070725/30583318432547259097085073976959329092 8004917623696885952432014881247978821/22005016116109025986417835664774768346)
+616299974987760892931461886440810919939264155149950328291076750435394215691/336493207496148335911511951044490614757807556827643881435283379298939260916
+
+(+ 78378756441281199312006031491361997668/175125578595003447448566412156266355477 41128705932035853424044828385766740319/216359823601433445464965619660717081261)
+24160702340946845080381231961736762955784254747832931999121777482667650876511/37890139292913914697800186893609983979783140570423836226844401085057321416497
+
+(+ -36669293296367265584135816683983780855/7341750629088488427994322429098120058 -110335983484012479290765295565662258281/5944410911181873015545360879141666465)
+-1028036623331099574157832708037007047972965676333418398303213384036005227873/43642382546729990922161061763293407461832155878510163500678954788762454970
+
+(+ 228535455883892721240720366651075744967/13353170075841095813026701300679754576855418298534901819672803635370738730013 50622643250826426975012800479360461693/18462345430382979738234695697296360785230118465695284267226773073149552698303)
+4895273294635392498665165879164922265508724130843670837390305811645771221742112327485665544066552056189958877583010/246530838530831602270074647792752210668736478466245992891169449973883874207653264921203783108295835419855394180777469634862446033810927048792871560267939
+
+(+ 11355068601761731966774720678777239425/4604724775053993730579400400679579947095967462408565975449642189823843820753 140083339434585694465706029861026468774/44667214322013486680993684507177513903616004462434123967566781106229226297333)
+1152244506542792151980649054527153167035843960949499862764543674633978109831264344257976000890169981044543787620347/205680228421222079539939271800361418862113882206694593495620042859527547538342323521609420336002641308832164587573546802806916292021672743366881933951749
+
+(+ -1347509007210283053816302848714698886/1127513773036247565111791991337919355855664936242166138889250311777351432819 -29464928273311615445392112247506626497/61933028109313748081628643142485450090725737246358993405254280723087421657760)
+-116677425670791909053501267317366054796703074907755330120413752187834449333299886015456661052906469074533366060403/69830342199092322009251417145364324484174202256910311362396720371574344280505889954115533896831727771442604285956749924105078563356474162416148250025440
+
+(+ -324250487660721070279458563122233299722/81069650926979269606211148691445887485067008319429991878657612702576019034861 221744296343315457943731256980089803078/69422237643162665956763790134527973903052044485041686255401689654420090859107)
+-1511153903564243978242173323335554031611949546418082039382510246845821774680210236992700372319944685567533765722032/1876012190766999122356500320654631447623282613780323887424324139799202291067983209550065997185860196433399782230215269625922714982832188312141580824109709
+
+(+ -5518324152042099343909980322067306333/114786626838714403445081775763480415805466836213320421844559660900880511042496 -34415425451618992284220085078832944671/96012285963709194218263616278916829663708037691620330613749177799086889040577)
+-121088040955051148243092870850103339772063863319219725752028251933576579890093496821887384992074112246777968211161/297862876779681729593084954525306275464788137269287692384941959703420459939692410434239827100068259769782676124741025632728203586961467995819025176090816
+
+(+ -14763921690861243371082340598041267817/5580497386043551028888310256097864185640794395615400088682607872958152738111 -37917865546640067592937379176813765341/6460563866107795917092814416816176677900242086501650458839130903088333290440)
+-306983808565398982164654624310995401934900925070311336095043743767915008644459192438083753301097540174379867380331/36053159767181973313125557585868206969047484351694148822117591172786449966899079869470557965303954072842600790897257698854023751399649072014440219958840
+
+(+ -50167218239107621378232529938205077788547946059832391744348095230748591585676/15685777859540025727 2959973815535345735348053015389999235839609978295604181643547897863515739931/7556072538495923601)
+-332637648328710384664787658442281566361265475773778265650094684540358159241317316408573560734439/118522875329417757148187346888166482927
+
+(+ 36275100136090483878026478935942224245036692059657264537598788566553406654319/7192442039871568876 31833552596558882106090352174644817045294359487590746360517241517440556146007/5115621724114081523)
+6795584791386081942310910570767193224876510928834120433155946649367201608618436115134135392229/603177258173744207443043238127434068
+
+(+ 1518304705177739493483387141342904186483658277690975456045607777812450680478/1837349761252804045 -98159070764971437450169149833809835519268242923913777966502463698396945141091/17238232824535200528)
+-154179655228376218743158291724235398278770272999447263973992852061897564252670941977524115620711/31672662964580000612902147746364535760
+
+(+ -16820231344048323866426670709751443650129113909724546927974450301780935205864/4879137683452153951 41987219452495799378686134495924115238909423831017150785452046648616005475639/10470103987572807938)
+28751853386830083847297108941057082854166610198448421498169760256533906032780671559334244751257/51085078915429149801779227663330863038
+
+(+ 106981694162678522688926793970551228214793665448093395251834862896418045995969/12359470989873920972 57736849967187961211538031441400807467468650239660040144967046985609433512403/9148121311784151716)
+211534804819567028232303054650327703050869189253958355919997046592895748577556985792570078031065/14133242495605447754080611005730273494
+
+(+ 32477400086615533920132766925666506741908300936974348739732763951610256880146/9045135183308696243 -27444990730472195954051975667481893116650518055101159075033425831129583042846/14815776448343565085)
+232934248044934592851252865496377968609159820017147884670610366058217203617961573611006127074832/134010700820948737148715427669965475655
+
+(+ -110053921687226074580746319073262192216481755737797790655164396095655530752161/255625377233605953547425802301922658850 104095037267817888539158192425982072195078148060302393917025130946535913363779/52156238014583575190277280296975732513)
+20869334635774913818120011435677143948904421430726712952150525645851498022294865158343391008006649321440592131083557/13332458017563665620865770931104425383051282278510599570476131200251352190050
+
+(+ -29732769078100192507326444863945498799317005912797369958801703828462203585495/153426302667449722633466432797809987061 36094569840376017510791155197897623093337784636438580042046806320700826250193/73286165979315961333009750429763545174)
+3358855747298609357265422062476767573626163217619249414656940907348235709105513077913806378841119674678021275101643/11244025482879487592663298816607141776071841230792806495601092332558428993614
+
+(+ -5942892427460131788264792587455286675871284855854073854440582948253436001319/42136930106315714728428443448730580823 4013357443728612356640061171485791666303136232331145404661874650095235381569/4039594279673425548586623641599574814)
+48367895947790658831309709091377784501687363167039737892874371817395083020674648576881857510385191335175551957207/56738700606823969419119152217721454504573192499839513549171731025354063974
+
+(+ 83833896550100013648317056712064289497247852876055488793078639582729685477353/188580876675619574786621140720273228537 -94310653397371924313725082402708514144086936359594289802762093989853507835016/223423274286761439988276492107364036191)
+945257965914081840217765265999453398105151083284254483307155736205796420255026737575918161700355729594975143830831/42133356934734885127066999419230498520039134905254787577957770920054881982567
+
+(+ -14753992026457621496269953958381833108089826525439816493815533773338622353285/187171041855711408638339193132645929319 41340837577662628944845446369855468662228665858415210386857356535970453143469/322471558852595372991189266479896691326)
+993354944176102401496932276511264091214577507066786487301109889019709943488537161608732610457423116833164991120567/20119112546425211128699888199278894685207186285215928241217590790016852128998
+
+(+ 1370528773439579327226257222995383030603284075640526658282329726447335048230/305600505683287165495713194488435114383 65450762047588146235054351616480175308174618406941901794570541085963681607527/78934496562987400429145916504112602768)
+2234440886428442112499564751364146150136438855986167755259621093816030535881959724370423862435538502079424185584609/2680269118389404699570998335430047660909241475691839354273569734988880268016
+
+(+ -76890617375308981455205142622328108690129081798840077873315966300000409208129/15716637731576156581128288257209679492686622162926707938907282962815471734862 38716252217351070567267262306332875768795464072349655597599997486613800623507/8966639693620677733207403249675415446338239705879120765911896990394928596139)
+-80961151400006413290662155450270992168701818633203071886556882897757813544592915596861717853520674107309124394292702460320442121704840951425284048212897/140925427734207212133604717335369986754855062343668899363006574618520848268718851310007161609443093589067206438198588881828988648068282656538084484897818
+
+(+ -43290760758277846058307167265569849910514905939554272559141355223092464986939/39390771697068809730875092892395235497943839933482798653607450783947201796777 -34021960935937170163894986285771504067448629886312440795733904794894095253649/106500928228745564800818258673435811176493306775154643113582742982704678574998)
+-5950657500399238361998292872481533631424138885403498309639150240712482075115081624153513501886127772738596607451116548616099047843190357858736503567640395/4195153749384427435979718872073512266029328962522899010907363614544821318917440413166534226890289043064894115954085809567292470182917919104836361549181446
+
+(+ 17906146982204022925114071077515882010955693727109005464426577098738402001871/11978213712662686419384559301746021856683603106261241838035626618416021524231 37108371752538653389309509075248119316034595087990649061240232817571629131708/23044877611981158676785639370406786635050056158699399001947422631523989139615)
+857136973087880657664203854652754375000000796400911171478039451763440064550649429609696307332611304395324153178602635490321877797571177424460384122636213/276036469018466057777760709173569478463866562650149880633721199971933767458324034017734890892482223472007882939609440193626728031771767304374122564511065
+
+(+ -77062185592993847534024832256462395143306675613123510837298699277378172890089/108133793614758275822883834459865239455798743725021300772336023406871185253111 11169356025540464491224577661206910726665825152149521753528516637690366838655/6369000033300801574913390611244042297918207179453133439308688067382050608197)
+716975776667538986425481530620118513423964367153518065425241139444161780269039780459555836804116752462325735011822817367819625929553250251515977390346172/688704135133337463423649074673019029541747166391680122270752018123634233590688096940261480888455237095078029621363428114402137147558304641222314936350867
+
+(+ 13583698920327742567560325715281067532806062839142769830536738488850089822247/37364394142255392010559408553278838878570049727027927213977555360874308098434 89809462356450792524214360688853318641058652796345720882094866396911421360072/67457610947238032712889230619376608100793287037427539672885124981055281513463)
+4272000026182362299819817378001862956001381379478285995446709640464951377212652125169846305230835604666564953883168949950485767679005929254184987140738609/2520512763327523955464432226120154092742373168521113224665257966793820057379494860454732800329019773731110452438496395974166220481124541266348389100216942
+
+(+ -56124163112538495128545947597589743957824668875494126834084658670528264380488/4752969512023182700122983723156599300062332404522277372984645779569746369511 -24794747728228571193100294011820993825205231022194400752319729320185378063197/98168688073468429337427023004226732413974455700654808087001957859427678524065)
+-5627484141989830997868845457242226973925524393512774885292323552602180052845805156311097870316601631410500655735815037997645271136502511615781690896430387/466592781448509275992390948177487068548424631274164031114910250651063315574511979617153568070687706304645818907382693929886654490427484894987856595782215
+
+; ---- Test von - ---
+
+(- 8229768172162771789/4094631553683915058 14916542302144281688/9648520391570031013)
+18327341244785642013243791303754634353/39507136041685332578233153660317693754
+
+(- 13554976081719376860/5850035209629724601 -6813034992928443315/16012083383654426278)
+256899901877002811987490932642058619395/93671251573905451634945335611797465078
+
+(- -221798849980968127/896588178875000428 -10118632981534633697/16809799818197706916)
+333990778095757160537366868413422249/941966737890699707694484674257410003
+
+(- -10398409463665680242/10672871071680021919 908300169382593227/1663860017749090135)
+-2076589873614048366639515256135965791/1366012573135328609279238070700513005
+
+(- -2198518713248421187/494031967775171833 162489257999262168/3608560229859558061)
+-8013762081101965644053022173225152351/1782744111192743850497670941715295813
+
+(- 4025149216228566945/640594137312937394 5467380276809034025/15813352732084653151)
+60148732603712157399679443099667862845/10129941051434949990590527231467828494
+
+(- 45649282670476595/278386580761220266717341154184065537 -8637266763647548631/320617180101036447149595031898805939080)
+17040443444897688379155017841073877168061229451634462447/89255520501631886327999278515127058459530587144975987720686743155549485960
+
+(- 5648415331928005377/86815630814151297970860026950116430492 -3858618729527320883/27855468652821710859204555976171379400)
+123081918822962876101148539477322308270739795776139149559/604572520679633516300271119677141637780408278090307422820905500994965166200
+
+(- 9781572955588417059/112881800445343004034168709823458687843 -5059688483724168531/4577416283528891230944530353546966748)
+615921077060787960354561606126348783111829996215681822765/516706991472571912574910836774186280180852506048696459094758451180832844564
+
+(- -4967914039344839478/238170260180199675500515253723794945205 1851848905279976507/5731170327270969184071911155742503278)
+-469527297115675955424190428047537920421409443442551107819/1364994327983166854234805393053180119374354994464588574791772715189542881990
+
+(- -16853061581795824324/96404437352723357070647888504166371117 2887610208906060444/32980643277330946266739822018299212963)
+-834203249643667606680245846951263316484378801689149307960/3179480358681967952651970543397987660141008737601948320258541111852875189671
+
+(- -10766003534404571638/1736320411127247334175538439020437437 -220564366893542891/24024005562370344889629855466198025799)
+-11228676451427374102904112111967705085778332338188090365/1813624835433832784217556253227924899981441517333394378436857197512671181
+
+(- -4039872531792560303/2717817538621352660433068255065439787147153801016478776178010367557953211548 -17969900169229544519/10371230759745501411127733226376204123221866394120596070959771442399588297129)
+6940459580028931824293913174633904994365279610168782399332846513086074139209123514834476635325/28187112855925579976299840753672542065528422968220885043792832460046226866036339425358907691441054924266606457279617295071355282523744922239122018045692
+
+(- 11905720953886477738/26349991043344773150817457299711471013733618033386232710348739943906972457535 -1868508269239354100/7915113871665192715310471309271830385175189228544536787145345883401181858893)
+15941145914794937177093386304443205602552827651536706608400845076162777444155363739893353329726/23173686625047977587990304423741788120258508897732978034793987736019678129860415537604628640859289817332994555163435451240013483415438259775849311623195
+
+(- -2449440712560236858/3924161613720467738425590715321110829708355586356453490516463081317902575263 3313932993860824279/18392642760231276916239249302906853654153090246504347205856270072174622214792)
+-19352032211145724571420568734409847660231095572377236173431089875006133635431666731719362137971/24058567564857748536604240288023690440577404826273237225585673569644473540232022448230431237781096357243673961302816983638647478040822458289501843963432
+
+(- 2375854596996813469/17171542567603713573317138241061150416263899780234956304631913156611236192733 -1690236091628058998/115698505401619203741389026136939663329574241316722960060260525901879106902321)
+303906786920788985464713527121698374469813384178920405503303785899916213843318155692692663023083/1986721810512032345893371071989737461519340072368099757524397292434629497187713075053126253107235936414498803590298681018206068059043963268488989361033293
+
+(- -9066703779833220052/53996509329904595759286231403247566365148374715934463324003880626270687736687 10104829441267883881/34350188217372122913844475743718288066233853695548819225257606841719829170673)
+-857068498550946301314281599902676812596945461499639532351672507051201056365247232693696093577243/1854790258563312749374056592838765632813507083399863975139987272744324437901043103651094837595789610803765303659351781344942305171362498886075754606580351
+
+(- -712905705954993103/38361275706852471555340413672243335795384295466685977818182375699688812583403 -3487523845474404757/24004509207225606167828624323100421869226668573968691661898194620137716910067)
+116672912187985693533424614379662678476187446315443107971581372764612623068602629062267386180170/920843595906060126846114857872490000269306626188013726759480780006531676144330596572087176480154495471428384288229491172449159350622326294294528887818001
+
+(- -104068455909264700529593875361271227125/3443783531459345396 94266182755532992545775726171008609186/10986871169556601787)
+-1468019045636814162670978305715811638938423723806410280031/37836405995984502494576730289263822652
+
+(- 6250188382163250356218308848100308290/74975517450841979 10057222263694104272437942231238950849/1377150882331486572)
+7853407001895533030925726629648778749078643531548391709/103252600010686800286181264132405988
+
+(- -325869560300902552275820653500571757882/6390430580148850471 94468553562411191993094256419298214695/11908765973274803007)
+-4484399064985071999330976874105690617426359030318059422519/76102142247451389303559481900024166297
+
+(- -93570528036598407567281714804477572547/1681213810574384291 -244906502561054838674546679498356325029/6878656438675875801)
+-231899320744132980638168050942881155823492361410591515708/11564492202898292712047439710761442091
+
+(- -81411835730261219386583131450337332863/716127167248934 305772198898084305417824619321954306670/5852119619187572757)
+-476650772889757879179369019399921041943854248979406203071/4190861845290706865359628655691038
+
+(- 8378821874364768218652992773582270365/264620166167099506 -235085292482743132422942426826553295351/5218853722286899445)
+105936154887632142427944491040385766054707164161382644031/1381013939193345109641609957531174170
+
+(- -46932041053326337601984043288899377207/83004348019257810472659105973646518650 -172752976692389001100875729845538600392/64697064048458368935602368307247306331)
+11302882932785858045495103305619355060523322049764297548269071809310077113283/5370137620102451116225827082734739449691101289924623877117727128768254573150
+
+(- -5215113722152182902641295804790889582/37267147737183802417372262122851319461 -174324915479281952095382231256728338942/198797486533978895289571841018885549001)
+1819946959828587625889363843813156766676787993042778284071188313098762447560/2469538433480866339929667414220581052912334718874062150193407525506073469487
+
+(- -308468863588547635528373349890793262605/277175417813474671446046438490775760091 -88071245580784145343997181342216325733/109042592277517238289414020635536175644)
+-9225060231388102579469362745283215538990500777711808852192407359260779270917/30223926073985207174135233898799350451872811382182855106546181559011381423604
+
+(- -139281160373255540085888405052544101003/21590054032847718908692432707921390245 -175128181843395150044469443628898278945/101874815793501611839718166887463701141)
+-10408215647857282226079103083273257459322595128147732742048301223816698452898/2199482777568107961766315941206227462112836158088743951492692685709912769545
+
+(- -13653637423911886957204229566898836211/6724361745919744069899921221745423919 60537422461958273742622747790343370991/323722395245687564470126807800714703749)
+-4827063738484690108652046326448960810791170812913084889649499536314520788768/2176826490887613088066161490358401961235974091796973399049221882998503572331
+
+(- 207284509647982883454717074874778610186/315575836476247924963087075944676754095 59454580888278446469281150437143941047/3799382139920332759258392540934029749)
+-17974876032324524053425850245755672169670471578477359535347261991433397414151/1198993196898275844180025803639723883733761367273976879884312817813487572155
+
+(- -149255714031984711085009662216310611563/61209488724728410476016289765233999883959861482512968048939594260689484910535 -206353007879160639705730135450663155/12341134377195982958424940281067948493740598784362073339140017508008773524522)
+-1829354061323966095884091779117676852909282652562065419187935424186237303685407507859167669375269438805585201409961/755394525511335693198081866608161950899365908489933659716533239785460293292606918153507868614180865950008697266433342863460741791684603303270127798639270
+
+(- 286228990947356503137685907205210886138/64525193112922470913382853022276019736227442678252533126077234112153953877503 -93778927468512815169462456699065596479/70019706577332037325570327903202382111804035215024271930215402736305222068556)
+26092773364888269343302672267572690894453186378630697330693315371426642609003667116358459590920104883240139740188665/4518035088612517412858008269349176355736855744033363257986123715832709510554983209440815107866748014413528943649032845277041680450752670951433682692095668
+
+(- 128067958966292694713545212085241612749/50804897676960765097908813878456128842417954009101908722816951877006748778869 -331437715897535092432788513322484606485/102911257177761006574263802557003927106564530572416215828322919550454967864323)
+30018293903870953799879886574342637699455128356488843398998059810000258259055116602688738404467489640369684487419392/5228395890723542025866546462435908982096651119675992137235094920338650164475761939608730060759309002063498665792819192135030537577109853650729817121390687
+
+(- 27065789167947870065829490227927612633/10795458608984562931374526676297845621730864739104955678079256994070639461197 53314096352440087811254806167289750292/44807028208492548064750449353871285104149154384082409595945081934090139448067)
+637187458285170434834128234123875152637450428605039275620795715002449318075555518355578432548587274399560043210887/483712418416385035748598509413117409273155809870339120248356475239836262578288026980177669113025449532258001487616187498682131415946755647640047843156199
+
+(- 275528434092876314751862670579225752027/23290954563951481764306221308726902093226107549717031306984541394996363441752 118398743375843543978994815511147957868/26050691402435592629863948804505350954161759382372519491414484055670238339031)
+4420086456754111377514058698455330162869575963826459083894390154200727636413353382047981846196341965799691593361101/606745469813648893293125236863835131523556569847025597910312571817347251611730291043895952533706547565767925058454286630395458711598751591845070996622312
+
+(- -263828172858355421790882308711676546531/27836884730007976814146538035133148053942251062564400015534567388490010158584 31580638196736633522674344981675107601/26210154715367115936541726366619494863883445533448748701891278370021519416412)
+-1948520953518189888695889830515156795224640917019574042614412953331052369986548949517168001067643449389746489215939/182402263891837359872743630675214135004512597266032306942151126033873543370078488920825920736994254287019873146147276876145783659805845233146169813070152
+
+(- 43029409555492054023102681165249027816896930295612442385573977041111849786681/17478431621804970398 -63831159286570708329826084149841946467426290005331979697932225104261019322894/15909114936773208135)
+1800228375210677909820927489860838061135888931548234366640994061734196466170531105718785437541747/278066377585826623354880511023167787730
+
+(- -34677827126365037739221949705076349308552841821108642369491195428278121711851/12321935233094032355 2466652720703038662112375481129216761044838204088317060529010755963314905661/458077759838279587)
+-46279076433142446690218423399092373290016631287423134630356063713373023144989129659854095947192/5644404488448083755690706619714037385
+
+(- 75657421640076548917316021979547903196453821552146142751737530624725671569062/5416811919979369403 -51031635143911513328361770575139950616395278082588474953679149885798666896870/16274277637120569843)
+1507698654622877634185545368063085304919907004898369478770589865697455127479301592176158803465876/88154701093808389139357381843158713729
+
+(- -86696779369804422745383183615836359604633179506005810847902134850836986706763/15354752711854066426 83875579121692496325618937810567731584819474189441279434601944065565889174333/1890321146489013312)
+-725886765676185953186290796464189476910148783977596698524963064505627422317719186476684911836457/14512706875163632554860591439823131456
+
+(- -2824584270835350806110810310308644313069326027498380007733023821989145840779/3128200028313826545 -16485532380752962986834975164722153533427821569516340079793116204530103476885/4044901389917631001)
+40144878017198534388242075435853869853984060096218401720566307902396394251666454424383286522546/12653260642466969643085415999628721545
+
+(- -71140717297594692514165816539390347954764512441693085945645019026357644035048/15130773661553937219 106518314860779634188990156539381479314908411240039365434170935270962911954978/11202282371121185733)
+-267626990691150539404999353980899804835901788880218020004516046839225745741587662342920970677374/18833244338916713919008552672213388503
+
+(- -31372444086039981530710911528326367048894875160807395940269724829549418985367/149682691887362386596593782520991059630 13980025800771566396092717430902170466939197897483207383178768135899198010674/143215924045734814208985239450703841431)
+-6585601463869631351127457963734548845246885851328680299125624347680443020577881573937479731612385878788264587830797/21436945032301618223045694723696447349670080755369221855700055538448185530530
+
+(- 60002561005149795132492915799111287923312170708430066011808292212167201814322/16346766380600148228286881361520329811 104734497917913613491539581495799848702023341599268915776996571583385896191203/61937476024742321910315674059586179787)
+19844918952732846654680216616282727016967753441473733514766184661191061075852141231786969917096326062063227788681/10024529215648371311559365663430434349900555024451481776473735938354274557
+
+(- 78980655687309201443760271907411093305339297143458162112992101000746746121121/24094471248783344167514231679460830840 10562090177736342378322146805187203837437609238688017154037816697523731420573/74961473522415640988394298626742882726)
+2833009175986364875175323375606672657538996734036576482627590142336455915129629838687125527863027857335645122892263/903078534276138789186206765245648729133926893901427360507431923032322034920
+
+(- 96507496069338193466683209170737942070468924698476218759487496209308948365/19252547784216386872197161331387216893 12563973560096321588715986952435909079270363887929001032891628645353358046011/79879611474172059435223762585596250921)
+-234179520035021783886726161079163865833895106001667476480293126893061678147610754451356994012799045797572757769658/1537886036891137155393554113191390737924110193971845147480358562685078008453
+
+(- -95307376781556674397571761484869767912211504027346871580288574968524683908606/128329921725822403056205582017133271311 36170894925879686192917617159219095595164782822289198001474013555499918728596/240886887357120796976726436320063138705)
+-27600105449672599524131749634403660999916186956076872373762346977331203119722064380924286397976905109959929163304586/30912995399316310109755266138690547023211992922143297688759057498082990192255
+
+(- -22104893896795356297688360407985617971036912713007110938688208155601366216839/5790727918973991999188987227357894380 -2339372311396919406471876113751500811577555408710269902369834593304924842262/12937689744925498650506694361349920911)
+-90813196841584888136609582546105640167792279132393576014002859436259486025871518847027719826829986116492656710923/24972880404321196721702428178050372850585634300866259560981343234830460060
+
+(- -3426218098660813853559652497557253942819662042768623922183022792185928242671/2077407536662385613357832628600529321326686191757127715026249042748302985178 102639297566540827510784861997871251414598617775200449087621943894148321803293/83089038429507982364103335021257902316010144851865721965726693103637274338545)
+-497904817589969304680335736144278473886197067420059149312627956679073246109792679236301202959163792633927112737045328517845259242265445360227131779644849/172609794647490471018785535271654901168315737813115654161745630290269473799997219289162551586864155467201760250711449118429648095083028041134558889086010
+
+(- 1543899448831604569141696144740105016328586790221799945430718394112623114412/1094690716976737526626281319975432667416762320123576900412499904933271786567 -101835025746074730017715423582062511397387458863000475669454309217160145993/55116548932808468782187525862059393507883043749327746382569396580129398962)
+196572266866178229534134252625134989714563665559807019513454337864363053729628560611312158082929567528955985669620113192156991984486011150099776316375/60335574468539540262844259780498204139853746803235564167348945699931512713417761400790104247218084745081610815218855896912895393599203789305655343454
+
+(- -37581128364300495505521143552535972339959603365602244668159915869829949338997/42947503543372015019662104425995959382231280059683481488692141811517675950053 -64888994735350842409379226446854438865448614840503930577860382883594178287934/83188698741706753136718468601650233481619465918167616089202536622553688681087)
+-339504834548876267781536981106771553482515399809961247195394672491113984585270709765073243997043174508213253440272888923497173265137136111635177948889237/3572746933977957867604303713153220827104741303667912510494658617478381525690274918494624922428110123336345510454960178899375325287131764283538305257747611
+
+(- -16230533405187239318665866908175768720879595131719076634847964191318368133798/22572606803697929681675696479626869642065470042484269772607381297011844085929 -3238806615045730440879378702226410558103197865253164974472379309242480970831/7167633180423354812410246140643720752789573307606828791458541239290047771821)
+-43226201536346598702395278529841763047400215735214225929426206339139243925579733185594282160061132691154727543083543034702325848468839969037250195569159/161792165494835249202675342837643048016103040739685489755239980324180308179745586573032524649518850731442178659412287492012066453331740508600962908806709
+
+(- -58154703770626762920775801228739843350302933064569814497417973139312614069763/25655935043535628671780902110427599603857741303802203417196105196580175051005 2291927744682353823611191393035210406213286149316388597509251757479544491322/2075117977066796442381930295725401140983312287419314083032058820231519915051)
+-2848879691864593463404526996418656511058536739346277043463623510210968076493148319480555434626780964688210750895957968447300033820091387019574369485421/845064952814266442598400897276554701819815257830830535600041451476645443978805142044657833921127247033533628716506571358424324423237490438402971304385
+
+(- 16233726784138742204308718138203086218138595789383817317246449554340898453104/16370584482945481446847872945862788646563748664837147378940234530469832625057 14431071141710676049963542765626402177344958369162454874051268130438178883381/21166786163219212747261378458659387864767326410261049063051557406799162784072)
+107370754167217929909136144689909613387440429633745577224054233373886366171618903318258855919060113440621302505589923655976636732694637334616990468681771/346512661117421566971293748815177161526095870176610277140325665174756629068111228154091043637596506814557119477231243643171068111260010676990408227692104
+
+; ---- Test von * ---
+
+(* -6520062188352981842/3213004995534018829 -3812444292971845716/15284944374811818089)
+24857373879807849010516976362973488872/49110602632729971801355498746248797781
+
+(* -844583948128454879/4750740551331102615 -1309778567130405125/4885884698278749707)
+221243590680205607733892613510570975/4642314113048197066962569716783636761
+
+(* -4579815856418431271/16947444571374397297 7990245706938186906/12540719430158043191)
+-36593853985314806270746820601513137526/212533147427761354206383017714519654727
+
+(* -3587966953201943536/3194797554208122281 975954052071387816/2707062718507963111)
+-3501690886675668292903668827990357376/8648517352177231144330968693325176191
+
+(* 710265334225408429/567023629756400552 -5578988760400430103/4131535930210536898)
+-3962562316545608552741467762441538187/2342678499616965424161446427863567696
+
+(* 18305319006789031727/4480148641441744463 -1641093267260986094/16028097657311023719)
+-30040735777106040963634910981471804338/71808259944297590021537032075729917897
+
+(* 522499067029593907/142530390958606446621834761330018829110 1567459634764499377/31663510497342378306792964160850079086)
+818996196770998943862055820464495939/4513012530308148429025282037949729145117603192483641232823845248212618993460
+
+(* 6214041481074460220/139497414619784295310756757536261769729 12187470171919324678/129216394212432939561557938117593031955)
+15146689039532873328968703771155061832/3605070583825050709361064709099418651298807367637359842488375232197429738039
+
+(* 10022419596195177499/91129297586760817507648681092594591108 239769653037576215/24086455608554015268646156321002022494)
+104481394312031409685890479072416795/95433990476618390508514520731482064738017476445225501421324446942302103624
+
+(* 127731839927226607/59760640855511386051149338950192132591 3679984267166095161/269870724770589242613062477043917992045)
+470051161348371979221331000573148727/16127647460431744118786930146746069875784110572380855085272434637353123238595
+
+(* 4919926511230586366/29288587285987487013553554568227355149 -2914615432991234299/34407808954885309804037535414452526052)
+-7169846869407694119621783007930483717/503878057947370143933800273784055481319429768630967123178484618174989420874
+
+(* -4322680734125283661/246950524730861178141734701180345535020 11581515233057355754/82204027418720951285150957025638971309)
+-3575942340708251875937466941988609671/1450023407574517046920597087724458064116343346221474061477327267648859624370
+
+(* -5552456004563371781/36434418778024040927761226774271610950778609263056622471030041615086459120568 233319937833204741/228703279535756717601739981368829304509550463672786894384479957768850829340)
+-1295498689806330283646616799874813721/8332671062513255913250553083541810221054209355142441164334390514659539371361850837178162594438925276666798780352514152276296209564179606228713851865120
+
+(* 7279569964232187047/36316165899095632459738478614507512808578186173163489609755035948221062420580 4568992288187244990/18279847281938710983382796940666233712517527808023718591530848159479207220137)
+1108676634263212048809114991909788151/22128465550033953372731954247755694375180631486898426116907313824243654714198100644737500721615620412852035450119116976232805701601749863504629937973982
+
+(* -8689289043809733973/34365105035540924847908154205433563929060132734873649554594240958996510665976 281724695877043289/3383396067954681850718083474385093262190311835985400909911383280975222535225)
+-2447987313255021583629117408894957197/116270761252098802423406562021935246701911690887646043563899994409915142686943691634418411056232663942535537938126289647041118885713303684881867869004600
+
+(* -4176416206981759902/47077361360975682486641492558477246171356187409295624938308162261216397376441 -10870319933050648575/51626085927005484523186190379579228801774286705829757742503501130303410401261)
+2670528255498212232918897515060496450/142965876637554026205455979922464979254073063785755559223760631646970673683621524411341782655829702451013418009338618833412062193643308417898164204593653
+
+(* 4496049401725150702/8024116634872885909638996643719901973664008349644172107626390134736213108465 -5231341280619167012/99267989241776204190444307671763754306088564051099822830201760217121508089279)
+-23520368834947889555464127765407042424/796537923785319116837266627763277272873506235001122453584405648384893204423914484193595265931840447141766909166026026228531619859740155558402735330646735
+
+(* -2488955833769033882/80573015130339486598712021266263458487997757617589137912729682647628329090307 17723590657579960683/79078600039601362101827108583564759878924923849842119643649415446502020994810)
+-22056617181258995266120581914227430703/3185800618738432636378738398589185111057563002909241393794402306079667392482341108052833514927720630087013771419748846412352850012097731569487991234153335
+
+(* 24410613567363183821142175154197794689/2233491913446620869 -289777146895293391500645889398422195537/12394177861163531771)
+-7073637953514043162500219088395995153310329907185649946877180402954938102993/27682296026727883467940485833673128999
+
+(* 15029397898618080393623393093137341347/9939158597399833599 268484092305118852707129202725716126526/9752180454987984749)
+1345051417567645337656755504737828287428006597367109244226136136424901090174/32309489404196149853047846865649927217
+
+(* 175291724581304230067306380062677652261/4791591464449055089 -207911166974886786162808240992513636954/957635297799905137)
+-36445107018739410292029741836217649994267718828374576884161821761303211252994/4588597118993154438342028473487092193
+
+(* 208446980882041538439350888438428103817/11756453246592156788 -99855903858077543170703702663212319708/7775813092266901197)
+-1734555140205305628415286772698507060801514301420325900368570916304368260453/7617998589456250715053087609460739603
+
+(* -49595797981179247160347259926801311825/16426101929443877636 104499598328969971414586784725010079457/3085074725343747115)
+-1036548193567594227670217621556353400490405002875929378150074378019016735805/10135150379689493069951723318357604028
+
+(* -288919818051255959565698296502103975540/9373352185361138021 77343596824463059344208562767410464067/8355013728778983070)
+-319229970313622361785032672064391711775428287673147624981393545586243098874/1118778374191039878067165437747032921
+
+(* 301194765217764762175383920433701358543/150076401641721289621709469985978858175 -109319143590504335906407585568245068241/158084148208214805386290412276525928977)
+-32926353787549066990014316879429253235742017240010356390402491456481443332863/23724700119685440084214937112355810539035473428177368317381421021523605836975
+
+(* 14575317438235510996984657523859363247/6747043355688580686998987940004831062 -98472042392613093668204392119412188287/152397803267436514292317070561082866275)
+-1435261276663720115408306632770383012566806521695455296458086302958691687889/1028234585957093005711368462502470683211464374115746651290896689614112234050
+
+(* 7543367187310376010646193530301789591/61115754966424662873097894247178344192 309940239796651595482411737112678240799/200261667764086238794802895148430893795)
+2337993034909171213000031444662193658341848356694420878002930517675329723209/12239143016237439360279809707749702660797878084581096344749106125186707088640
+
+(* 306232835922656327867425959604977465100/55646521674811091128956181530575055283 45245255551837746690160535427248646677/3669533234425940180962041078287629087)
+13855582919684583969821610044729507626133731299765443289084519977056998472700/204196760665922729081584465192637337445710456706084552841012480810023816621
+
+(* -280037880297253633994139513185953058494/23798550327416056573646642830182072429 13967268482262630670960486883264178489/7947215947745048068401387767511847243)
+-434596028812829556627014314125713048434599389957141408329542154357763726174/21014690966139335562014814134594464675233042588696546668504776333756662583
+
+(* 87160410649223805266866345018804635271/204719779683096591635231158476535039583 91197762560765392928084914476898132964/277206223024759381433146631560580134513)
+7948834435086720002947247338196997812861466884983039250681993725808882173244/56749596904412078223459353928850191672356004665473536520452927516595919428079
+
+(* 272801380449749740391855824723351316848/2170368723435176720708253536680067463416474841046765138040214254204061862261 14545537787709209389572055399030228996/8381323291479119825335849511027103148981778425333781230074116361235206363821)
+3968042787871071204066360146704950989545352280096012736206796950415592924608/18190561932825050861659739926693806725838682397154479213760300500132465705680046683155463862909993066621811136554677896021527098482779305371951555659281
+
+(* 58980225701104541897366713189611773567/10973700523953435846969235385386214078292603476932194022615006557054104506344 21633357583056027790037764923811848217/41236459355840549300942497778444413350482341379076368704834339005347182486274)
+1275940312921345964633100864283753667394719832288287163056787891633576680039/452516555639171997520308257003811683819837367444947027711901120987864272999978391252372420644671039873982401560595091423172287702745925783369137325922256
+
+(* -39569537110370574225194522625562874655/36290593978404925051095380486087641410218299612051669925683823165483928853304 39273660356839128453616088747231247259/28875229647500294680887983884278577441525691250738380954940513956990510132534)
+-1554040560950035541902707236381071410695075315482961522429891905381129320645/1047899235170633560739863801929205639611958070150694189488499584527041043137082563721218908614201921449076002548982308540689571766482794493357171683792336
+
+(* 8957762734053174688386697837976422606/712105675122280831038408324375785815130945929819518342973925027507219300067 118977607972668646264715307919875588738/36563306353035936296510796886853084280648109576589600551753305930842020963283)
+355257727628119695756412145322380851760544279491883270008434507085780737076/8678979318410478400681656718586483785992423192579006235728835173903750764880944673586689792087386144715446501744012435157310426693657188196381455479987
+
+(* 114386050140129336980347743358441052599/11994188887964574384037137314302737861703229337059619512751326848591488081229 -50822174853799566513638003084407139228/97406657802317796912648600328217961853548397771614449630742570869667560514587)
+-5813347841057137571369557065847591420664634372223088557679866032754664253572/1168313852626327929522799656188055465298138284154709873285311568978496136227795809646907486798429717114923178357702460243511883684964123937654308495387423
+
+(* -22147677230189664783449572410799931501/75580058176304394102183955194485040346816524663599269056794063928343401057143 -127672554664595215026114551202414743739/35777311684781371234035985601066874920871049301826919955489852676067316906014)
+2827650531865200718433745248471704607394596478050653604940563621773668622239/2704051298527551014378337257898371613519363350219566689647796093438747503077807722203668806231503452508016974614236112792032033672965127824348803574358002
+
+(* 3468729773587632113679855593063165286551216344725198121609354788619580819847/7106612002452012151 20863200733446307102600190583661606839853255577505815215312643683864543217073/5700246487811068117)
+72368805556440529088812813715602124890901251289457147618293618526488567540302416253970205832659523238561757581481150988870947074663135867252252227647831/40509440107213064064897416415172689667
+
+(* 43306673717838918980731699770600730039727453611468399058203483818093233880231/6173575908538565981 106634227988568775671050783423559067905086861634892257032833451008548321218936/17988169594879808463)
+1539324572884864883885215269788177741067901747630436643318399808029602335378536990210735234944615096105103848497832537965483619535769637171783464984418072/37017110149885307295697375341989232401
+
+(* 61636028396239445662576777415312348317278054920190931147781159688109244233565/149659999183936017 50280832809996410949441105432174396823883728565382915986396125237655209339731/3406752842984125790)
+206607389257567119017662603624829733217835095238758046754428174885007999774491792658838812826043033826701244157167565054600950156595290052398436186551401/33990308513391731439280046802638562
+
+(* -100579490802304807750359433955474958462342659278486016345156932756807754105945/15683759624513404963 7314396152134987983181095955389244247502417255088677055075146925285457081540/950287995699608967)
+-735678240508074701153113537069655056596152436111651040530896921701439724727486696483134676487497031899584038731663111390949471467249259023050011663755300/14904088498613295322494450308817103221
+
+(* 25984831699359211750216710442693374608159925357093100400945034699383345074385/10463598404993207796 -2395913226491242076662067669730978955981403048697660449593722338244504668974/7015215522730452775)
+-6225740195664363384298636893730784883811595661227613249243163802476751022407971476247993440178871949687923603921101094083879668063131450147131783163099/7340439795432595812648347200273983390
+
+(* 5173661857391320950903772549611256023540539838210520778403003347430938670915/2590493168574884173 100300641976357496491877756123729102910724064566692821682523911939220592349990/15304416107565779147)
+518921605664943617990486317157527087053001312760892500249127957517476408720600460633868004681188890038115877413554399588737851074382787744833707113540850/39645985375676570588146199684023740431
+
+(* 30299639015164203561126609159677900559022306879488518544803392527841364186955/97638167801975054493877206805944332747 -50150465496280036231382225902610460555496341860773955714344071185921583266663/170117675960786609061777750278261277482)
+-1519541000979732808188648781832621044050652591754537200855596768903085847105531546641139177813880505696192826380113425984545675787584857974943247950981165/16609978191541300835961154615181304582159561006676548938424954151558306303054
+
+(* -34494394944257769716276791009665812125094062960425641316440943461722789694119/69239821080832171466311153221314488591 -68027404272124217088707268142523090163964888591405843143848585935878552833247/257149529774225346004390673137885895872)
+2346564149995340998782934409780604815295734898030424565252099571337345550054284934036215402972664245125313098735082896555892607540059632597741979943574393/17804987432587488254198543762235568841018786223139145264591718687823557996352
+
+(* 22330754509472350470460807673039908304726422770752644988051418230315708975569/141163736844241522445115344332946835969 -3776092949566234532895208849184634613770861313997034923686862122594334787771/22367110097535579962848998753563258272)
+-9369222740190326741203615957382420344247102784278353165345406236082475331042528539717966581690645628370939381978953360215380653092335198860022382107411/350824982641632215769272917522017419782283768012468846380070797128085153952
+
+(* 1376215273451682681102140384578115142238259557166158859699272578561460124263/3593386179017642636485249017714833669104405991325015697577507088650274886871 37146275008876311604039415809582675415172661567487888072055609579242279390723/55424998453085285819414374477780690192979527887019008768378662580126754826472)
+51121271019052119686352858568900325361226598163234091421115939503875711782442415328681175322030659510284806538410228985354770913411724825992699509412149/199163423413390889071651575953261174839972499014963134990506980080139461063269751906284862132821075544766093817070661266293471833091996501160433036049112
+
+(* -88175289711320073148300791156190227927348022787624424521937188958291199926437/38194742314758366741668899229532351990874883495690656157862650973602784662629 93421911195279228911508870033119580111709458306921869937709821511660370035352/66371395138592894543765954603571534463846496049156722497129962530412046587003)
+-8237504085028962150049531747535213236460729066521397582683209771842938254589363802757604921456170821878391951762499073662677974506165863935238701489400824/2535038334389561782321790943041741331416028402594806464107449488311138037598457377927652600804722340759363172755193254192462811091332303758223034251210887
+
+(* -88364214910455569163017945328431687038422451206033411348821431934742389780753/43010507830592044720656702803904712217809857004582018186125828892174875808576 10405170283887792832024806983921158923908589830001636723872220129826733402834/4055629711949631304631599195955105801456753694558712994574702123032807265321)
+-459722351572673455425943766571506569631562018487574498847133029199411842205331593858852090421782204158679934054007027833206633183796877753882057444427001/87217346741895687976684378003169607737518608233754137677854312677618987931466495788077930577814677920791330694741284253568592140275298729115088619596448
+
+; ---- Test von FLOOR ---
+
+(MULTIPLE-VALUE-LIST (FLOOR 13918288150951705093/1401140429528746218 8037346830653401534/12140087246062147767))
+(15 15819536596165521240797345101333717/5669989019487990500153722689252798402)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3027396677293618661/17394867614909941317 -2291333958125929004/3188627451035828949))
+(0 -3027396677293618661/17394867614909941317)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2672347537044132983/1242644867650938739 -18408840898134373335/10231522001278674776))
+(-2 -9204560351304414094275545654164256161/6357074151573303338260935869140273732)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2909960574201625242/1140661215026522267 13303037060238089383/18166352033245030796))
+(3 7340592943788470245594328177983578849/20721653182840810059519494723194734532)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8198662690782244017/1375380265264517299 -9940234650829186147/17690753691491997765))
+(-11 -486100547007747193780627302695509498/2211955773175772955922986386719257885)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3966139130172032305/18040321970861620778 152082737803043526/946729689784517957))
+(1 1011240112172972726360628393816617657/17079308423086645837394450304465310546)
+
+(MULTIPLE-VALUE-LIST (FLOOR 10199468022732280591/121419468943382552600797741323914786260 -2627475271750260665/95465240194344921114274153619846654671))
+(-4 -302411943986468199606823674581501024373007929237189061039/11591338766949818909386523271402122174353420293128216789558932652732995620460)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8471401573321747185/5927836485002954534423728282157030389 -10006560123550811854/209494971446104969537769985569938393355))
+(29 -54515717208483066409886298754350924985999966734110450701/1241851935162873209670541996670866824232223815534136678858726178724570665095)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3041516402669280559/23467966340832028705164128018098446335 6098690148519419819/74694157223362514640536233319542912231))
+(1 12008521321399654679364472921217933270209469640706386252/250417138224955291159963090840561809997874350767164909187205124534624089055)
+
+(MULTIPLE-VALUE-LIST (FLOOR 12371726101368968041/23093272201098893335944386552801821150 552920335555268471/59704833009801809998987650097493815639))
+(57 10833671498697672110331389655963519805471190684307179149/1378779960416507709477447168250340219220272308941040290894608990101550964850)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3936278768643199217/61530125725985401304656961990591319570 -4622522820386904221/99931589582562481620405120529601200875))
+(-2 -11699348415245273343366505594272785590391481515341739671/409920218067509498701508662179031915635595553469094563928706113041525908250)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3378221394828629408/57360271731094852990248264232533113197 -4121489923477642292/582636574825978160767401314647264235))
+(-1 -234441506605160102966099186988989055202999923102442904644/33420192252492486160839993475212088893408362946965395344436948483624609295)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3136864170660359113/44018155426864484368550814560728963265607376469242388043913852619483671810359 7592249764621265399/61218932554330370729612969835045191215382261653025522947071546902482986859295))
+(-1 142161354082922159316702479104046765633220994190482626315401062617857980099757409386379034462906/2694744488243248258380889922671073488004909384816885899374920518252041793957332742201117787314100221762775952924983170065632438581816845330037820256436905)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8388845076992722039/113324439625023255923060004687633012536810961583168953468887128369059333869915 29270787347930250/338347801532036561796340241450622341080868991428994657767799334610272208941))
+(0 8388845076992722039/113324439625023255923060004687633012536810961583168953468887128369059333869915)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4061469742865314937/64801603451247667482343238717974543532449298971352747107214551636724513855613 1344403291462061700/38470586305356068360716898225197866224089081322833216143931662358746898751411))
+(1 759644321951821493138045865317431182965861074290543254824595494322779964610920583206631767077/27395117343919593983759778902763691133722708413625034340026933459895718790907695509798551507285536033282436777270923749566119049487283571076783727846373)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6300876868463754766/63495830134457398131576869576746882401947668656296419431644557856865817622371 2683373787654434721/32958906466135519543294750118994566579246721224880398401534853634103601897753))
+(-2 133096081053989316587079956940067402118415059770888001584265696499152144351877946562766899046184/2092753126391210514581307904104631961415819403699771474276457943469530908829049497503906750315560161637143522534287446520082226490203274292567625907432363)
+
+(MULTIPLE-VALUE-LIST (FLOOR -472307136668592250/36283411370339306010717878389083492352344779970196813667782297535345620767127 -3180306511295187523/75166923119981694900512094733973876755239261156251968596129974579413418042019))
+(0 -472307136668592250/36283411370339306010717878389083492352344779970196813667782297535345620767127)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3148795985647001686/64429795462330994424525695145310698340316900821860011346129307089831843824641 -11298596415200487525/56650030835870774988744337125832477562271330606264442454925440669251648355512))
+(0 -3148795985647001686/64429795462330994424525695145310698340316900821860011346129307089831843824641)
+
+(MULTIPLE-VALUE-LIST (FLOOR -102545151309532699273956369870862301497/6030775709520909501 -3288683205470962892631604702141093469/1221554251153305018))
+(6 -348033375896483356529697355308057680498851424685117674/409273316984297575168605808523732001)
+
+(MULTIPLE-VALUE-LIST (FLOOR 262657016871433510082498751402781174749/7573480743368102221 51080528722906667824171406466289726452/1601607284756767193))
+(1 33815990969774126823949725673411671713268069951579559665/12129741929543448973808409847523235653)
+
+(MULTIPLE-VALUE-LIST (FLOOR 138482489784362691982393629835416135309/3631852344347114410 -24756007176022054565783765242491988918/219932185588761813))
+(-1 -59453406054861418860933161489781197608471921856017953163/798761223827929241442393231350025330)
+
+(MULTIPLE-VALUE-LIST (FLOOR -212217151846170123039362268732482984696/11596630494102963285 157767757347916893207763952109296030356/10257360923209581435))
+(-2 32941352246943117620876731374547894383947184420447916448/2643351654913607911070701558622724755)
+
+(MULTIPLE-VALUE-LIST (FLOOR -66747006612989726802598039638160699571/2655077042212383298 40811355885089157404164119163071734769/5571784139947382276))
+(-4 15382315863254661753182362315746357118308047043239937263/3698379038534340915097856546560906562)
+
+(MULTIPLE-VALUE-LIST (FLOOR 68762140087929702254258676232660238758/15300356027061891153 -35857327153107467171153230588794581375/12686181688605082704))
+(-2 -37488456798327399439537660212002603897618511901320984853/32350516076608496130809185423035152952)
+
+(MULTIPLE-VALUE-LIST (FLOOR 242045811640213090811968332747485173382/200549144102874156362839425688475328049 -14720899626826592765120758929463878529/55362986404688226126571951930830517493))
+(-5 -1360940123773119189782995319087829718305547957827775584170427519233923828279/11102999538439281856672090511521389719230333671905312848993361013013608061157)
+
+(MULTIPLE-VALUE-LIST (FLOOR -119845294654504250162135973476212065855/100235561394484311088266800183679226574 80594461105267736432364594799413149425/61631997559252488378599155330559465978))
+(-1 173031536634535211165479230108382118112369885610634326444128663790131209690/1544429468803790002857581373808877159258315141389178393568445604388376624843)
+
+(MULTIPLE-VALUE-LIST (FLOOR -230485693234637510798211679560546639349/52735224446003804525152654032694494673 -216057981617610709644611545583688426965/260006637986112259187147152181319007048))
+(5 -2958479432060194175681245276352090941756054532611547690395592385359334844527/13711508411648488620980405764270377927416829995446554240961159998044485455304)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6594316542549343232263525515993767282/10217421010314527320204876001269664067 150738011702184633072457541580514087744/135040956724953232085930818414328999685))
+(-1 216550304321963092517168155612888510209814057236150214483836375316700196226/459923436164837338339599279302608001719626738369225259576013169605366272965)
+
+(MULTIPLE-VALUE-LIST (FLOOR 215280935061082631947114960623303029323/207354325693067193327551969107966799241 79751059907103262336474674983968289237/4337760464235769010513178238272088134))
+(0 215280935061082631947114960623303029323/207354325693067193327551969107966799241)
+
+(MULTIPLE-VALUE-LIST (FLOOR 310160128112311271225164732000676894965/86670395306350722800942425502835485142 178141651878134061724955020964246844473/148821875093870378260620578385076958277))
+(2 5093132355806944300558276298272344941234347692198850733707837927916021244991/4299483581539365588748720077960621199296398702837049138084337644406995806778)
+
+(MULTIPLE-VALUE-LIST (FLOOR -108659820552054791199784298344597956614/11790531032698157780195997261827578010352156078055016836768011974016954903741 -92538322534416259700833065660026629223/19585963177324586927996277066630337817907750129846119872015696245293090497388))
+(1 -1037131280631376361623284528995684848351041247146708940120596004521550738167239284685366257725745514224913041700989/230928906647528953486003129436653219142752591225509660589870619206780147714239888278154624266956202529317853226309156501996262035307639197627615351928508)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5394706491096230323847274166255447931/10999333470518091906908673737442830723710024941373839628113269063387717150756 105688652677006186461732590041930264063/21972728496093720326374563200555762299989227113998910666496198593694363180514))
+(0 5394706491096230323847274166255447931/10999333470518091906908673737442830723710024941373839628113269063387717150756)
+
+(MULTIPLE-VALUE-LIST (FLOOR -191689412702065586724423672263415136270/93810201821180445246181740077575222573046098171118578720996957721548578622199 -96035306478379345278597023485459703599/90477882577875726723065337577743037040931870384035502080606137411367114071296))
+(1 -8334560691183765714134253806956288712175511004636349604358505688696669629914037375584956898475941052209595993911719/8487748424983587977143569651002086894691875550521839392659856872027244953584789975128015403703285861633097358090901236825413778659897331594626425134299904)
+
+(MULTIPLE-VALUE-LIST (FLOOR -23269937861894460494044792238228308465/36609152344338882339480850660297061488131282119857763060331849352205685148721 325068909216594106686082320524489871331/91177237475655724082435461235746167562462517272459785633509544221351873775622))
+(-1 9778808569440655820425835535754928474979020881405653286273845718180424961228320899578451645656486131670752875977421/3337921377082244749772660717107363339434489502423902307989133990817960972244485458695718522007125256227586389900645261310720433804087640398154830854279462)
+
+(MULTIPLE-VALUE-LIST (FLOOR -238326953836192259685740729837504392751/14355772111692545517089448796014758311054554297101342377064555342044509505629 -2243842813596041779461072557214411973/26977869328891440663623277939723739398284518432434090329689171706564354694000))
+(199 -6448765647740977471904737113847651808330060639815597135148713750030489976324569684096986913258458168828297495539/129096048048195144296601029799754739460578975322841318685536300111243981862070688561642588911885232705019881753766051653025282618058049676501115190842000)
+
+(MULTIPLE-VALUE-LIST (FLOOR -154358049055187385619395426022892405693/9651466522903571511806795329901971873531573523740147689205585933143787251744 234831599528611417562275088467151900111/23212020955553784427152057042945842586938059290340162186208579138883161355663))
+(-2 316658791137724604029754690574124702890700231484127998714230110560397057808441246896564869593555547226559779365903/74676681060487840411987924431521223169933844488425876950176937169482763523750924018302125631058404128587876741120722730563623397211887516476096033675424)
+
+(MULTIPLE-VALUE-LIST (FLOOR -43654015885600226452139253734240763904114948357839504394635758939147918485226/8959421350865475053 -71396498978827369985021009185210519228191289633806094987720268011017813959395/5118659875263168828))
+(0 -43654015885600226452139253734240763904114948357839504394635758939147918485226/8959421350865475053)
+
+(MULTIPLE-VALUE-LIST (FLOOR 30206748063040753946799836869317684942154090322823467523870425873885298155111/10481539418044277488 47024848487236673350978260730205414416590483746605328718368229684499622280474/7191921838593099535))
+(0 30206748063040753946799836869317684942154090322823467523870425873885298155111/10481539418044277488)
+
+(MULTIPLE-VALUE-LIST (FLOOR -78297878369391722158254897331818780133560455296543117876032852961696240531334/3439835335342974343 -12036259456916995957158314961009661904873237837146662571140339452059150719867/7648180594799196815))
+(14 -19197805765101853520494699712598051602631126933023081616555585309855479307669655742300981287876/26308481861074724148503061769552317545)
+
+(MULTIPLE-VALUE-LIST (FLOOR -11644466368871135752271367372638717312589950278007329817169736850185519100737/1311440431008130360 16666792145043036974187190230561351375866940864814143604767927371030164658327/1190204555866760523))
+(-1 7998208151350462202845967149504108047636942539158206705970028049633264098721802988652183702269/1560882375733744790369742288085778280)
+
+(MULTIPLE-VALUE-LIST (FLOOR -79973663368880337215592714973251653953011156710750446016524362581184906490344/13217906252057303539 58550120458525994168414457422879483045080411293174816365332363703279727325517/11983119832054095608))
+(-2 294743007488634911900879023610601157709203210196036764662698142539282328840165292825377976700087/79195877273629847756913363266891378356)
+
+(MULTIPLE-VALUE-LIST (FLOOR -41283916983957018057492477658728498328100012640087810269690534262888976961251/890401703093780527 37905097813993829793947873722213455441729327992618875876994782685865871567157/6801392244603328629))
+(-9 7656253348038361960592683452946138937700391767097248361228404271354846832369355003597180736924/2018657079334544839920956083927269161)
+
+(MULTIPLE-VALUE-LIST (FLOOR -18621387073793741287833632061282985993236184599525107084971126746444001531559/112377251064249742125143336262406044187 -80344252057643577515390451958447799739023169996897035042227858478107352127859/16565237077789941458934656364080562722))
+(0 -18621387073793741287833632061282985993236184599525107084971126746444001531559/112377251064249742125143336262406044187)
+
+(MULTIPLE-VALUE-LIST (FLOOR -11067278490740390186400140048488373691939192899502978554850454064301747327289/279730468938850077684950205987597341304 10742600231685337944302634339424380376867728558611903252501449407612160123471/85514692364145379323997472383947484080))
+(-1 85775736874497976296219552104494263998937714945890467644689458878788010379480929901293727971077618208617170461961/996711041507662039484243506170638972651237308243642442559705598573661101680)
+
+(MULTIPLE-VALUE-LIST (FLOOR 60114400703399744178227904113253512958642740092037841351403601970012663733574/137652538688206271590219421417082587275 48818636606796573849225811493965362933035106650390076441334389457476994620122/53029693036557887125608655547988906029))
+(0 60114400703399744178227904113253512958642740092037841351403601970012663733574/137652538688206271590219421417082587275)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3914498366778062569843980805049542971189141573995351572704819538012574198620/2893535793927099250376915741311683101565016171163532500028982710856616653543 -64455977862771995990556362474021252617135665526576459531278423102067698175925/3427268293660091333898426457103031174054024747619806545506815375759964110507))
+(-1 -173089642940460836493548201378493831666834527213381638819285816422714170656111775323359444521902045952676537769939820706047335458029055584112252141651935/9916923483096927116177052980173451074387932639677487416966276325060341893415045555506102924285291258490295955820662010134773377007870870750288985076301)
+
+(MULTIPLE-VALUE-LIST (FLOOR 88685468991633001080737925907185943038820418099572822599681084512202985499349/12356339561700478684701129356342132279853496560835988907745653698832814553183 6529471572210817352014560971376587702394496047549533959161274051805568907/3739659250056306079416159597801009351379164652345884310988690700223397485))
+(4 8931962841313470806790103494237286341563410404854617106114803081793820819240374925219641539537617481113314045913411523358730270170471325648745013341/46208499538749877879324553712339970407875860449933229680283463405247211324108302788607460717099015088790299594129098751336540918286885704752480944755)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5294621876959552948152278397535786930445255402598688035901577017296377116948/5881250468392395166026135319241737823103911942970361556821993967308880332607 -65630221834131781450865541487035630878349246622282004360445526978282263449249/98696808137715829282209856003081855629375417101578635063186137762415694777903))
+(-2 -249413266253338816038191146071217173249587815937933968995202267999853691656986532179554523041282106904325952906300316562845535251623832095499430051524242/580460649088775579832453445973177920831893989101100068436102498480125976298386547626652311003668489010795846489626845062951616643824353457996671633983121)
+
+; ---- Test von / ---
+
+(/ 7013212896988366906/12397903473277899947 818833870013215068/2125577647443895255)
+7453564285301859120853045020886215515/5075911640537211768265804260348400698
+
+(/ -15781329068048599432/14942574238341613337 4388772934226358350/2640112802717985697)
+-20832244458230302534551181278529162052/32789782692450857054331267544650656975
+
+(/ -9015230453321124271/17425619133302730035 -10422000746814766599/14972344381173680534)
+134979135022768387806775446187867640714/181609815620990738305316999098032100965
+
+(/ -14741075237791868512/12448692140900938227 -1090381863721238817/1060836378253796023)
+15637868866825840780217685066084527776/13573828137487503515304766902031557459
+
+(/ -7371815071140740177/4722722556038701367 3872455829192658988/994203944294825175)
+-7329087620340161131469364260313555975/18288534491791723206480607737200436596
+
+(/ -9856364379969390509/7988230468709836259 -7208901117187058135/7430860779232874136)
+1093153305924514768551484985555671272/859497963436269188803272225817371895
+
+(/ -16740689272507881147/56924866550406451570641164619431212169 -14712532880452686095/143481612520580129383584255576273223983)
+2401981091525408257128502717450566513166280001357873948501/837508970838236191644285394369194561392491093277901090055
+
+(/ 1874027699956565000/65960003455647360668413772300355814843 -172394881832672950/2006879686300828197846469567507151887)
+-75218962452157875130617756878839223573611935155763100/227423340028380523596387094039260091189651621559491937
+
+(/ 851521912886492079/58839621451933520132430725102159653727 -5525838657334730480/268863138354222710211869290179088409033)
+-228942853876053297959532391872114722003932597144466549607/325138254802036127673497464266072288930584674567672498960
+
+(/ 2130823024472312937/30463932363736038600114358208342163020 413938864244113775/131673792970459944919771618253738144891)
+280573549781056638388629087822719475587456644826399754867/12610205563054396144647765193069861697742251186477600500
+
+(/ 17234694073181371137/253506951459931119968572673772742357160 8407879684613951161/42697666588937447817581914537644794355)
+147176244259806896721181660841298454615950364713859506327/426291189417673978158704851675227114861497071554451732552
+
+(/ 14739301038477826821/4801125431810347467140397350459581435 -1752125940488995048/127905197451270157484305628763539243969)
+-1885233209620217720514367144506571751170505057476450692549/8412176412616337518572109406238500578932979745867733880
+
+(/ 9194848570227974720/45448499872046683203864930109076126035374684748838016011669264943000310475483 -4572473918523931944/28941042619577200519536336906341131911598596429670188136734086846500956354149)
+-33263563043940787786171015409141766453199063320923723716765930467953050399983260590187417389160/25976510037621464639740779963549572814837984766154635046133743883024710122710674726552171566119
+
+(/ -2662376868940711929/2674240208804755702377222409224408783678596883960539287029565653749020338064 -5046618244273151929/26826013625152995057141957222948811537350409769204161465077735924332004069058)
+35710479080747854012875521001477955195584454274704368888444222736697434540936425667291700196441/6747934713661461716612153292457811722283965560031580498434684530869001786777260513409206862728
+
+(/ 646980248518054663/28444849537262537816809349756569888989442483441699293309597267649158853799707 -10174938507557455325/16470612178414296088079890015341965945714023680627341561729034923083435428747)
+-10656160760434978971303471120231114671340660575734505071429575384684610862775940451177787597261/289424594898370460244167952344748286246980979584479610186308309369583658143095854438992150589775
+
+(/ 1268676597518744714/6024937921458004492480888468749320142603908196076058575752452561172018490893 17823595902143962912/85935047374548136904062562443188289405155329832270007415035044821925251080203)
+18170630585125644385503771892175817370913744757273904248648000044618805359154885235028182716157/17897676474595109057512045856227678061218241143085827332930191066967148125532813505892133626736
+
+(/ -3035741006152688190/58890268425224581569217175195410848521985674465189565646495474378301884202047 -4870935665435665519/47998868922405332801456101880162843269583282603435159879276723163289928325531)
+145712134636693761356266465698326002831562744975420904782663360472436650653549187025441059178890/286850708819506259357726384810790881448875152111132928069815447961129371272624891025817707117393
+
+(/ -4420263280205408439/38682162086456801604593696710774835436326970692840048042132553053971380151628 -758651402628235427/1755534012040040367913026343944696058732638465867705260088080517539506722166)
+3879961265286134914514096239640695384126081133972137242327715997675029567458817030555062379437/14673138261791601182714628661554161812345431143865809776872034934342213839184709418896670662578
+
+(/ -312487180249669742743295380499853180353/9828632991038934281 -86131955660561774942466932680637336739/10268762916730341592)
+3208856768501438660232746468300370677374054716853273141976/846559380988100144557815474234956961169507773676687849659
+
+(/ 105376075880566042097567073713047434893/11411565636673693365 -220737802783327232867818580441304577024/5817406274606660773)
+-613015445021032499619145665530563205764250055719854552289/2518963924957071797477174332253152325843619212749200245760
+
+(/ -311533429150518992652072799089375050497/4403073054828470603 -320230219907951760832723580313293021909/1370493254961533625)
+426954463345823097468320537904981772054351338526938461625/1409997052618498081840381197699863669488222338862641441127
+
+(/ 305676222727436457375950609916137360009/2001517485431820526 324338803123828318219640932070020543912/11123178903397935211)
+3400091311912189654145957985944153094384781502787164376899/649169785656371151621897383467144093766684841422885937712
+
+(/ 8845112929712368402815105446090151026/8124751572615311799 -107609110538267962880281203537194473336/8714443449141779053)
+-38540118213625599008519681983731393728094066419546629189/437148645036763776481446937412401903340367189496615845732
+
+(/ 152921217721894690043853278309581658066/11705615305395353865 184187448038871874764725486848823516773/4171619104693691390)
+127585814672335876029018138907883882524550368713261650348/431205482165106014329333719781838993214328411764819575529
+
+(/ 16414254293541341780725162107696242521/155838132618727968561620486302365154071 323320173010032367023620851618405869489/49801924105617352177018959505967933104)
+817461446577249670665800625691379410535771218196808189195363718417488315184/50385611999847495177988476252475899813264458225659097815552272081452203039719
+
+(/ -188149667625860588508273820953820709614/21438745582767797684161462130971215025 128458309657689922121539794960212789849/134174286369366827879740776978166655691)
+-25244847384333405496229128525982900130397411994350175944375943735942831513274/2753985018743617742875555653653797261370358442640799457019039857068516281225
+
+(/ 1218460641064115152742257147372113443/1773382194117714970762642066492794929 -105212349758139121832338365854603836112/35045896682356785176328011712384921341)
+-42702045738251194875426595475683618047253961691478453648029952948483687063/186581707662369193907913729212042024270164277319717456729276609131940676048
+
+(/ 1467722271775252460214852151179762687/1747611358981474614363356529179985509 25495740211005247928144692929451604259/29615224810946461612486375021101910565)
+14488975012885720730598332784736375353299643425098519766594278819666029385/14852215066131169889445443721709162270198753408805825268529301698140894277
+
+(/ 6278399735526726207674375684072448068/13890681759576280617381650633747782321 -112063146811220963294237186476216238443/46495820670393894026441353693945662660)
+-291919348200099113895651901892723884699250237261456280525601785996696740880/1556633509331345870779770006255469001211806559199158615405344674499795966203
+
+(/ 248406099260780863433196593538936526373/315762135750029127758352280023694126018 -24578051912523675039725210046249323571/3033769619337997374435389027823294736)
+-376803438597807975522050212312559316811899647514236724224019181136008036264/3880409082236781853269738100403484871805889674074731389226471480469265885139
+
+(/ -305871752543087256004326578375555909668/80170799467978436032303243749692785696371676780847080230403479135749775915991 -208573266832391890136462745593008906685/96016271562601269514856687672805175650907293023094157826925793080307407361434)
+29368665255505841438632782694581946057561031972462112644657516768267440383833513431444679871238206541553985530943912/16721485549600848123731461311227384049611071114404954309505697259277905994635125654414916826332204568970567318299835
+
+(/ -171651126582338417143004525987733942986/48126955023093310081685702171788275811688444573315712039582092051531229683107 32570134112026732491936310765048378699/18584159151613423191553551933672204731023422884196280183931777685641069715348)
+-3189991854959918631828923606391779823799241149346421336570141741355492000935500642040047513113849334779592681149128/1567501379505627719887579027549074087653888429037997616626567546431482074522690424133509833932668944596793898937793
+
+(/ -31304786393644787215292629624842492472/10539846271603297974613179098685212701091372728582260780054561526149580513583 43496364289252206338797704034889660065/966865502932307025364733802774045297740949567802356684866342045679773834966)
+-30267518040679809082934454680954168768135550720881039440573156734314284479043791824457029301083428211405425375952/458444992982373700837242411005687390212275114474481688646320865335043970683786989531994936463047685893258985162895
+
+(/ 124366625369659591476708994326732418029/107684759001536292829359995221778346870065030877016948429894748600664800488759 -90949754058598173499067700725927605729/79727020098830307921496202496061295138733611655702270828135321391380898414003)
+-9915380440470549523296226431396644117384598256053664887332801972488440466568616812942647849957495261151611303260087/9793902347049141646079571573977765974008832433473016883117384010293158932212528563016145547341801740792289848500311
+
+(/ 26792084925762094333829722201654015569/6815899891200140342329613369008754659665480100088941978786466272502677117648 179968988142253715757129058636648023126/97033837835570527321466682927970125702018459951415339098532052222053589117353)
+866579607987744230609336186273867662887766686833260209925103055244528379635362816895584608387230956963010276689619/408883535566062149539621907018509777969515872715944952500700527207173412646715462423653890585029605025758308909216
+
+(/ 320794852821756057819990044473359503428/42380074203350930293358543616207018031675687905746455222111844144668904183229 -11813439835454851567822019323728871339/51852159737956631156972450987013128151750117741949546305537111598356497409240)
+-5544635317209327550045071802859986261979158492907374734760649234578367469399038563605323839330681533705071632958240/166884818941132804535892580774781586387104334774784737031184369589400544303785250219152004898392301479219940857877
+
+(/ 63160395612932962868082774785156358041658469338654564454114468396132462549944/5671929772244157797 19541045450680948617094710246839287171374470593288265457341382295544977156173/10827756125123268218)
+227961786821047895774887365257727015864174017882302289602409601101722343657899277052494444293264/36945145824164509580938949252327087600266044162541122809277442696583642758457532273140841543627
+
+(/ 31389399613343712511677734270541516183531975055644318154870016415582858008412/11320913214023484367 -95931706646769408081251897664360951854776052790951374912970042200868629796051/14301831604104230477)
+-149641969141325406602881756591195860220337618158488775091717625369334526143115090325362684257508/362011508473745439254610688691597507367516106821889963803421575701854031622412859179610532278239
+
+(/ -50845041077039215658764589763556935122444212169574762080162289087527164772395/482986173890811026 -51342299909113507561385579724776151277474630060658338514843664853027455595538/3864573616937705869)
+196494404298439669659681446421686066898686292162412914850963937042669022612531239234324840686255/24797620991857267698917294149872672843409173617406514673128342148521539559341861421304646801988
+
+(/ 76283614020376921713154299810619585257752996149145061806263596894412414185408/337890011287912517039286436540240936661 70530558237421368381589233382700323659036925075366138096846582768833233488577/12121510300837787759729092713205686989)
+924672613133132744522463879340347327755455994321131972145048214329608890428265966744607561005512244129921459256512/23831571118985077324412202325831974453532679575894228007993082738742295289254461850021038245882565939546151124021397
+
+(/ 13518475961402756750057330871273933874583566313800024119371308450919239424622/71146816100737230880567880716110051085 -11914742388051168959634071864657967837347162591767656949770878950409478930980/166466796775669753065110807850377519909)
+-1125188695291804746273664719520877594103080002716204716437885631737502681157239448228517736957154781558316254899699/423847992785167635691798025732868758201476408654527740579259436528169254792708107390082891890404030666159494556650
+
+(/ -53624051286117226406327700847140806598091981633622544805551583455315188018537/149060170957501829683988930330276188371 -49540630291338976658332195799658601133012561780540500265134312414843218811481/313014990314092319823049811442768272842)
+16785131893926373429171158665038393627227592608630727377590747943991201054188961463248027101037470630205119769672154/7384534820569381535972144752572408048556227885764547207137140227958732266609348654686668662110083737942669493487451
+
+(/ 2634758410586745842739353561704344884865889793873131750193619887157306355755/83106075320614705363810122092414199463231740446254118542567688658288107572919 10787649314660479714744029413883607304719873485501736976813666398631455642569/2439964488756696481271244145022481444549967702052558191280867337292105066432)
+2142905652761565172685487282499186838096673751132490328620490049367034561455889328384026705096013173825469773464105722689198047146574263705663366838720/298839732158850477765824602476778580028064205733214070073086531571837859351705342746223206218407306637658483098569582239416197836311325170250187389329637
+
+(/ -1907320079310938642409293211056905401889419041722087613680756850005726714712/10387378553621846874105702088597026076825105075730032753153301604042569998683 113647247724474559442709588703965365251731833799417671287796250968092484717057/58756890421232187224353930678527831208703723187770044891160428018937233424397)
+-37356065632762902117955690133395145368676268194116097031480521390942668514422835237280325034441435052929702455487858500299401976652159912902024146542888/393498994563785425899168694480259206994308562177080555315323154941891277193612821825931878224565302417504072329241812530787363937691786269618438039211977
+
+(/ -54987418627898620923060954379316763081930842855917193391807940070173620336071/17370345837184638879794373707261631548922174314274224219546763452439685451597 107349939397731511365417710412808670916754334908520065561311453951414109180973/7800708635318451621630266369706695626474649690647985662113853436261704078874)
+-428940831324519456770429889832838610542119304716244392653623661175655561457214418178921042544524225772650432309479656622489393939407340321261255371264054/1864705572939408818246392762570376592749103793151936455808919833872532407312841098160841844995663367019074328670998871082130543124576872890789577304863881
+
+;; ==== S H O R T - F L O A T S ====
+
+; ---- Test von + ---
+
+(+ 0.52019s0 0.98203s0)
+1.50223s0
+
+(+ 0.026268s0 0.6137s0)
+0.63997s0
+
+(+ -0.338943s0 0.450523s0)
+0.11158s0
+
+(+ -0.032799s0 0.995186s0)
+0.96239s0
+
+(+ 0.249222s0 0.96463s0)
+1.21385s0
+
+(+ -0.46177s0 -0.80114s0)
+-1.26291s0
+
+(+ -0.127754s0 -1.88775s9)
+-1.88775s9
+
+(+ -0.65572s0 -9.1112s9)
+-9.1112s9
+
+(+ -0.99359s0 -7.6134s9)
+-7.6134s9
+
+(+ 0.0169907s0 -5.9027s9)
+-5.9027s9
+
+(+ 0.77272s0 -9.5384s9)
+-9.5384s9
+
+(+ -0.50671s0 1.95366s9)
+1.95366s9
+
+(+ -0.281487s0 -1.4109s-13)
+-0.281487s0
+
+(+ 0.86259s0 -1.8225s-13)
+0.86259s0
+
+(+ 0.42874s0 6.326s-14)
+0.42874s0
+
+(+ -0.53545s0 3.607s-14)
+-0.53545s0
+
+(+ 0.63671s0 -4.723s-14)
+0.63671s0
+
+(+ 0.34449s0 -4.873s-14)
+0.34449s0
+
+(+ -0.480698s0 3.03292s19)
+3.03292s19
+
+(+ 0.85132s0 -6.325s19)
+-6.325s19
+
+(+ -0.54742s0 -2.83806s19)
+-2.83806s19
+
+(+ 0.45269s0 1.62964s19)
+1.62964s19
+
+(+ -0.5122s0 -3.6148s18)
+-3.6148s18
+
+(+ 0.192093s0 5.3618s19)
+5.3618s19
+
+(+ -0.43486s0 -8.918s-24)
+-0.43486s0
+
+(+ 0.289955s0 -5.911s-24)
+0.289955s0
+
+(+ 0.274345s0 -1.6779s-23)
+0.274345s0
+
+(+ 0.392723s0 -7.441s-24)
+0.392723s0
+
+(+ -0.62215s0 3.521s-24)
+-0.62215s0
+
+(+ -0.5406s0 -7.718s-24)
+-0.5406s0
+
+(+ 6.5444s9 -0.060898s0)
+6.5444s9
+
+(+ -8.541s9 -0.181755s0)
+-8.541s9
+
+(+ 3.02993s9 0.694534s0)
+3.02993s9
+
+(+ 9.3926s9 -0.77226s0)
+9.3926s9
+
+(+ -6.4481s9 0.252235s0)
+-6.4481s9
+
+(+ -1.1734s8 0.94104s0)
+-1.1734s8
+
+(+ -5.1049s9 1.28059s9)
+-3.82435s9
+
+(+ -7.39554s9 8.9347s9)
+1.53911s9
+
+(+ 3.11457s9 1.71478s9)
+4.82935s9
+
+(+ -8.0461s9 9.0508s9)
+1.00467s9
+
+(+ -8.58006s8 -2.82289s7)
+-8.86235s8
+
+(+ 1.82954s9 -1.83914s9)
+-9601000.0s0
+
+(+ 7.6292s9 1.3988s-13)
+7.6292s9
+
+(+ -1.43837s9 -2.482s-15)
+-1.43837s9
+
+(+ -6.4696s9 -1.3269s-13)
+-6.4696s9
+
+(+ 9.6744s9 -3.132s-14)
+9.6744s9
+
+(+ -1.18927s9 -1.9405s-13)
+-1.18927s9
+
+(+ -3.81462s9 -8.602s-14)
+-3.81462s9
+
+(+ 5.5761s9 1.32286s19)
+1.32286s19
+
+(+ 7.1631s9 -9.3184s19)
+-9.3184s19
+
+(+ 4.7921s9 -5.8008s19)
+-5.8008s19
+
+(+ 7.792s9 9.7695s19)
+9.7695s19
+
+(+ 8.9575s9 7.0198s19)
+7.0198s19
+
+(+ 4.4688s9 7.2066s19)
+7.2066s19
+
+(+ 8.9222s9 -1.3243s-23)
+8.9222s9
+
+(+ -9.7717s9 3.434s-24)
+-9.7717s9
+
+(+ -4.22478s9 -7.938s-24)
+-4.22478s9
+
+(+ 3.9261s8 7.916s-24)
+3.9261s8
+
+(+ -3.239s9 -8.986s-24)
+-3.239s9
+
+(+ -4.6268s9 -1.0129s-23)
+-4.6268s9
+
+(+ 1.1171s-13 0.73372s0)
+0.73372s0
+
+(+ -3.575s-14 0.94588s0)
+0.94588s0
+
+(+ 3.176s-14 -0.160759s0)
+-0.160759s0
+
+(+ 5.055s-15 -0.0258102s0)
+-0.0258102s0
+
+(+ 6.371s-14 0.480484s0)
+0.480484s0
+
+(+ -9.257s-14 0.698975s0)
+0.698975s0
+
+(+ -1.0281s-13 -9.4453s9)
+-9.4453s9
+
+(+ 5.960s-14 -1.71395s9)
+-1.71395s9
+
+(+ 6.805s-14 -5.8515s9)
+-5.8515s9
+
+(+ 1.1645s-13 7.4758s9)
+7.4758s9
+
+(+ -1.0064s-13 -1.86868s9)
+-1.86868s9
+
+(+ 8.912s-15 -8.4908s9)
+-8.4908s9
+
+(+ 4.036s-14 3.308s-15)
+4.3668s-14
+
+(+ -2.503s-15 -7.642s-14)
+-7.8923s-14
+
+(+ 4.653s-14 -4.612s-14)
+4.10262s-16
+
+(+ 4.700s-14 -8.456s-14)
+-3.756s-14
+
+(+ 8.181s-14 -4.658s-14)
+3.52305s-14
+
+(+ -1.5467s-13 2.3608s-13)
+8.1409s-14
+
+(+ -4.341s-14 -5.14576s19)
+-5.14576s19
+
+(+ -3.159s-14 -9.4925s19)
+-9.4925s19
+
+(+ -7.325s-14 3.49983s19)
+3.49983s19
+
+(+ 4.134s-14 7.07955s19)
+7.07955s19
+
+(+ 4.080s-15 -3.7832s19)
+-3.7832s19
+
+(+ 1.1577s-13 3.30522s19)
+3.30522s19
+
+(+ -6.838s-14 2.739s-24)
+-6.838s-14
+
+(+ 5.050s-14 6.768s-24)
+5.05s-14
+
+(+ -1.9477s-13 -6.657s-24)
+-1.9477s-13
+
+(+ -6.348s-14 -5.222s-24)
+-6.348s-14
+
+(+ -8.770s-14 -1.58234s-22)
+-8.77s-14
+
+(+ 7.906s-14 4.9202s-22)
+7.906s-14
+
+(+ 3.7985s19 0.8199s0)
+3.7985s19
+
+(+ 9.891s19 0.79037s0)
+9.891s19
+
+(+ -1.49583s19 -0.360153s0)
+-1.49583s19
+
+(+ -7.36023s19 0.8185s0)
+-7.36023s19
+
+(+ 3.62075s19 -0.364594s0)
+3.62075s19
+
+(+ 8.0477s19 -0.531815s0)
+8.0477s19
+
+(+ 3.62182s19 -7.2661s9)
+3.62182s19
+
+(+ -3.23868s19 -9.6806s9)
+-3.23868s19
+
+(+ -6.08735s19 2.89138s9)
+-6.08735s19
+
+(+ 5.00175s19 -6.3548s9)
+5.00175s19
+
+(+ 2.82944s19 4.7262s9)
+2.82944s19
+
+(+ 4.6168s19 -6.8772s9)
+4.6168s19
+
+(+ 1.15555s19 -3.786s-14)
+1.15555s19
+
+(+ 8.1897s19 -8.971s-14)
+8.1897s19
+
+(+ 4.32734s19 -4.794s-14)
+4.32734s19
+
+(+ -9.4559s19 -1.9717s-13)
+-9.4559s19
+
+(+ -4.20726s19 -8.657s-14)
+-4.20726s19
+
+(+ 9.7697s19 -3.376s-14)
+9.7697s19
+
+(+ 6.09264s19 -7.5608s18)
+5.33654s19
+
+(+ -5.2828s19 6.8924s18)
+-4.59356s19
+
+(+ 5.73685s19 -1.4978s19)
+4.23907s19
+
+(+ -1.30897s19 4.8593s19)
+3.55036s19
+
+(+ -8.5586s19 -9.712s19)
+-1.82707s20
+
+(+ 3.8772s19 -8.6355s19)
+-4.75833s19
+
+(+ -1.03845s19 6.88s-24)
+-1.03845s19
+
+(+ 8.4716s19 9.614s-24)
+8.4716s19
+
+(+ -4.3023s19 -7.649s-24)
+-4.3023s19
+
+(+ 5.9593s19 -2.552s-24)
+5.9593s19
+
+(+ 9.8934s19 1.3093s-23)
+9.8934s19
+
+(+ -5.70567s19 7.918s-24)
+-5.70567s19
+
+(+ -2.893s-24 -0.93898s0)
+-0.93898s0
+
+(+ 8.795s-24 -0.030014s0)
+-0.030014s0
+
+(+ -9.366s-24 0.200493s0)
+0.200493s0
+
+(+ -9.3102s-22 -0.28704s0)
+-0.28704s0
+
+(+ 7.142s-24 -0.45701s0)
+-0.45701s0
+
+(+ 9.420s-24 0.957794s0)
+0.957794s0
+
+(+ 2.975s-24 -6.84104s9)
+-6.84104s9
+
+(+ 2.26822s-22 -8.9898s9)
+-8.9898s9
+
+(+ -1.531s-23 8.1961s9)
+8.1961s9
+
+(+ 1.7221s-23 -1.53725s9)
+-1.53725s9
+
+(+ -9.488s-24 -4.77676s8)
+-4.77676s8
+
+(+ -1.5077s-23 2.8251s9)
+2.8251s9
+
+(+ 3.410s-24 -4.701s-14)
+-4.701s-14
+
+(+ -3.361s-24 -4.947s-15)
+-4.947s-15
+
+(+ 9.026s-24 7.353s-14)
+7.353s-14
+
+(+ -6.385s-24 7.789s-14)
+7.789s-14
+
+(+ 1.8237s-23 8.517s-14)
+8.517s-14
+
+(+ 3.4439s-22 -4.345s-14)
+-4.345s-14
+
+(+ -6.817s-24 -9.8611s19)
+-9.8611s19
+
+(+ 6.213s-24 -2.7257s19)
+-2.7257s19
+
+(+ -1.9353s-23 -2.71446s19)
+-2.71446s19
+
+(+ -3.653s-24 -7.7565s19)
+-7.7565s19
+
+(+ 1.2298s-23 -1.56532s19)
+-1.56532s19
+
+(+ 2.905s-24 2.334s19)
+2.334s19
+
+(+ 3.182s-24 -5.727s-24)
+-2.545s-24
+
+(+ -1.0745s-23 3.640s-24)
+-7.1049s-24
+
+(+ -9.7145s-22 8.77s-24)
+-9.6267s-22
+
+(+ 1.3734s-23 3.225s-24)
+1.69588s-23
+
+(+ 2.745s-24 1.0505s-23)
+1.325s-23
+
+(+ 2.780s-24 2.747s-24)
+5.527s-24
+
+; ---- Test von - ---
+
+(- 0.57362s0 -0.0545654s0)
+0.62819s0
+
+(- -0.121063s0 -0.157204s0)
+0.0361404s0
+
+(- 0.75334s0 -0.186554s0)
+0.939896s0
+
+(- 0.879036s0 -0.54558s0)
+1.42462s0
+
+(- -0.245338s0 -0.003891s0)
+-0.241447s0
+
+(- -0.89576s0 0.61608s0)
+-1.51184s0
+
+(- -0.59227s0 6.61s9)
+-6.61s9
+
+(- 0.381363s0 1.88003s9)
+-1.88003s9
+
+(- 0.858986s0 1.31028s9)
+-1.31028s9
+
+(- 0.56377s0 -3.26553s9)
+3.26553s9
+
+(- 0.80342s0 -1.46217s9)
+1.46217s9
+
+(- 0.093941s0 8.30203s9)
+-8.30203s9
+
+(- 0.266243s0 4.980s-14)
+0.266243s0
+
+(- -0.169983s0 8.01s-15)
+-0.169983s0
+
+(- 0.77925s0 -2.777s-15)
+0.77925s0
+
+(- -0.379807s0 3.990s-15)
+-0.379807s0
+
+(- -0.392517s0 1.1080s-13)
+-0.392517s0
+
+(- -0.26274s0 -7.575s-14)
+-0.26274s0
+
+(- 0.72031s0 4.1223s19)
+-4.1223s19
+
+(- 0.589775s0 -2.9271s19)
+2.9271s19
+
+(- 0.205704s0 -8.4906s19)
+8.4906s19
+
+(- 0.362556s0 6.8624s19)
+-6.8624s19
+
+(- -0.604004s0 -1.42777s19)
+1.42777s19
+
+(- -0.53121s0 2.3539s19)
+-2.3539s19
+
+(- -0.684906s0 8.179s-24)
+-0.684906s0
+
+(- 0.43084s0 -5.849s-24)
+0.43084s0
+
+(- 0.153358s0 3.633s-24)
+0.153358s0
+
+(- 0.93678s0 9.13s-24)
+0.93678s0
+
+(- 0.78924s0 -7.766s-24)
+0.78924s0
+
+(- 0.33867s0 3.510s-24)
+0.33867s0
+
+(- 8.0573s9 -0.86206s0)
+8.0573s9
+
+(- 9.3318s9 -0.93273s0)
+9.3318s9
+
+(- -4.26515s9 0.464104s0)
+-4.26515s9
+
+(- -3.35557s9 -0.93267s0)
+-3.35557s9
+
+(- -6.81614s9 -0.64528s0)
+-6.81614s9
+
+(- -5.099s9 0.67011s0)
+-5.099s9
+
+(- -4.2206s9 4.9182s9)
+-9.1389s9
+
+(- -5.18173s9 2.267s9)
+-7.4487s9
+
+(- 5.53314s9 6.08856s9)
+-5.5542s8
+
+(- 9.88s9 -3.3333s9)
+1.32132s10
+
+(- 4.87404s9 7.17075s9)
+-2.2967s9
+
+(- -2.9911s9 -1.37177s8)
+-2.85393s9
+
+(- -8.1379s9 3.023s-15)
+-8.1379s9
+
+(- 4.8877s9 -1.1596s-13)
+4.8877s9
+
+(- -1.89071s9 -4.330s-14)
+-1.89071s9
+
+(- 8.7563s9 -4.676s-14)
+8.7563s9
+
+(- -4.4533s9 2.743s-15)
+-4.4533s9
+
+(- 4.0261s9 2.1618s-13)
+4.0261s9
+
+(- 9.1731s9 -8.0954s19)
+8.0954s19
+
+(- 6.984s9 1.09772s19)
+-1.09772s19
+
+(- -9.8832s9 -8.0905s19)
+8.0905s19
+
+(- -8.5769s9 -6.24565s19)
+6.24565s19
+
+(- 8.5486s9 2.77396s19)
+-2.77396s19
+
+(- -9.4026s9 -3.5611s19)
+3.5611s19
+
+(- 5.1003s9 -1.9535s-23)
+5.1003s9
+
+(- 1.88706s9 -1.6304s-23)
+1.88706s9
+
+(- -9.4567s9 -1.9848s-23)
+-9.4567s9
+
+(- 9.6498s9 -1.57531s-21)
+9.6498s9
+
+(- -5.733s9 1.23215s-21)
+-5.733s9
+
+(- -4.0567s9 -5.229s-24)
+-4.0567s9
+
+(- -4.379s-14 -0.0201035s0)
+0.0201035s0
+
+(- -4.036s-14 0.82034s0)
+-0.82034s0
+
+(- 1.6661s-13 -0.70753s0)
+0.70753s0
+
+(- 3.360s-14 0.60217s0)
+-0.60217s0
+
+(- 4.977s-14 -0.95905s0)
+0.95905s0
+
+(- -2.967s-14 0.55465s0)
+-0.55465s0
+
+(- 4.394s-14 2.01859s9)
+-2.01859s9
+
+(- 3.683s-14 4.77836s9)
+-4.77836s9
+
+(- -6.887s-14 -9.26s9)
+9.26s9
+
+(- -2.643s-15 -5.6812s9)
+5.6812s9
+
+(- -8.498s-14 -9.3728s9)
+9.3728s9
+
+(- 9.033s-14 2.18002s9)
+-2.18002s9
+
+(- 3.113s-14 -9.207s-14)
+1.232s-13
+
+(- -3.239s-15 -1.2957s-13)
+1.26331s-13
+
+(- 3.098s-15 -6.117s-15)
+9.2151s-15
+
+(- 1.7706s-13 4.829s-14)
+1.2877s-13
+
+(- 2.793s-15 8.620s-14)
+-8.3407s-14
+
+(- -5.019s-14 4.125s-14)
+-9.144s-14
+
+(- -9.495s-14 -6.06994s18)
+6.06994s18
+
+(- 9.385s-14 -7.9288s19)
+7.9288s19
+
+(- -3.099s-14 -6.64095s19)
+6.64095s19
+
+(- 3.397s-15 2.92222s19)
+-2.92222s19
+
+(- -8.463s-14 -4.9708s19)
+4.9708s19
+
+(- -2.735s-15 -9.2672s19)
+9.2672s19
+
+(- -2.974s-14 -7.975s-24)
+-2.974s-14
+
+(- -2.1853s-13 2.736s-24)
+-2.1853s-13
+
+(- 3.243s-15 -6.867s-24)
+3.243s-15
+
+(- 4.792s-14 -2.659s-24)
+4.792s-14
+
+(- 4.672s-14 7.831s-24)
+4.672s-14
+
+(- 2.0285s-13 2.741s-24)
+2.0285s-13
+
+(- -9.1884s19 -0.22573s0)
+-9.1884s19
+
+(- 3.32245s19 0.7651s0)
+3.32245s19
+
+(- 4.13513s17 0.85135s0)
+4.13513s17
+
+(- 2.2249s19 0.45778s0)
+2.2249s19
+
+(- 4.9103s19 0.84862s0)
+4.9103s19
+
+(- 4.27386s19 -0.06662s0)
+4.27386s19
+
+(- -6.725s19 5.11246s8)
+-6.725s19
+
+(- -2.40906s19 7.2238s9)
+-2.40906s19
+
+(- 6.1667s19 -7.4303s9)
+6.1667s19
+
+(- -7.746s19 -4.29687s8)
+-7.746s19
+
+(- -1.81419s19 -5.68164s9)
+-1.81419s19
+
+(- 7.0665s19 -8.9546s8)
+7.0665s19
+
+(- 2.47788s19 -2.2961s-13)
+2.47788s19
+
+(- -7.4962s19 -3.378s-14)
+-7.4962s19
+
+(- 1.72135s19 7.168s-14)
+1.72135s19
+
+(- 8.3699s19 4.887s-14)
+8.3699s19
+
+(- -4.5701s19 -8.009s-14)
+-4.5701s19
+
+(- -2.845s18 1.1087s-13)
+-2.845s18
+
+(- 6.4084s19 -4.569s19)
+1.09774s20
+
+(- 1.33888s19 -6.8446s19)
+8.1835s19
+
+(- -4.0631s19 1.50864s19)
+-5.57174s19
+
+(- -5.61754s18 2.6413s18)
+-8.2588s18
+
+(- -9.0749s19 6.21626s19)
+-1.5291s20
+
+(- -8.5269s19 6.2002s19)
+-1.47271s20
+
+(- 3.15773s19 5.433s-24)
+3.15773s19
+
+(- 5.1563s19 -1.6366s-23)
+5.1563s19
+
+(- -5.8449s19 3.282s-24)
+-5.8449s19
+
+(- 4.70947s19 1.5640s-23)
+4.70947s19
+
+(- -4.32334s19 -1.0593s-23)
+-4.32334s19
+
+(- 7.9621s19 5.610s-24)
+7.9621s19
+
+(- 8.164s-24 0.133362s0)
+-0.133362s0
+
+(- -1.57089s-21 0.3154s0)
+-0.3154s0
+
+(- -3.736s-24 -0.66536s0)
+0.66536s0
+
+(- -6.923s-24 -0.431366s0)
+0.431366s0
+
+(- 3.345s-24 0.77436s0)
+-0.77436s0
+
+(- -1.4322s-23 0.799644s0)
+-0.799644s0
+
+(- -1.3249s-23 -4.22035s9)
+4.22035s9
+
+(- 2.707s-24 -6.5029s9)
+6.5029s9
+
+(- -3.490s-24 -2.5205s9)
+2.5205s9
+
+(- -1.0086s-23 1.35048s9)
+-1.35048s9
+
+(- 1.4406s-23 1.55487s9)
+-1.55487s9
+
+(- 3.370s-24 -4.3973s9)
+4.3973s9
+
+(- -1.31249s-21 3.448s-14)
+-3.448s-14
+
+(- -7.706s-24 -1.9488s-13)
+1.9488s-13
+
+(- -9.8403s-22 2.2940s-13)
+-2.294s-13
+
+(- -3.355s-24 1.0187s-13)
+-1.0187s-13
+
+(- 9.5635s-22 -8.663s-14)
+8.663s-14
+
+(- -5.713s-24 -3.169s-14)
+3.169s-14
+
+(- 2.645s-24 -5.2307s19)
+5.2307s19
+
+(- -9.960s-24 -9.2854s19)
+9.2854s19
+
+(- 8.036s-24 -7.11434s19)
+7.11434s19
+
+(- 3.475s-24 -4.845s19)
+4.845s19
+
+(- -3.062s-24 4.91714s19)
+-4.91714s19
+
+(- -2.541s-24 -2.91276s19)
+2.91276s19
+
+(- 1.4371s-23 1.1606s-23)
+2.76508s-24
+
+(- -1.8769s-23 2.965s-24)
+-2.1734s-23
+
+(- 3.713s-24 -1.7581s-23)
+2.1294s-23
+
+(- -5.954s-24 -2.764s-24)
+-3.19s-24
+
+(- 3.21502s-22 8.56s-24)
+3.12942s-22
+
+(- 9.969s-24 5.912s-24)
+4.057s-24
+
+; ---- Test von * ---
+
+(* -0.56581s0 -0.117477s0)
+0.06647s0
+
+(* 0.73841s0 0.08886s0)
+0.065615s0
+
+(* -0.75174s0 -0.173615s0)
+0.130512s0
+
+(* 0.557236s0 -0.105034s0)
+-0.0585284s0
+
+(* -0.62105s0 0.828835s0)
+-0.51475s0
+
+(* -0.54287s0 -0.92243s0)
+0.50076s0
+
+(* -0.2173s0 5.5084s9)
+-1.19698s9
+
+(* 0.467354s0 -7.9517s9)
+-3.71625s9
+
+(* -0.95485s0 5.6451s9)
+-5.3902s9
+
+(* 0.0472946s0 -6.774s9)
+-3.20373s8
+
+(* 0.196037s0 7.3548s8)
+1.44181s8
+
+(* -0.25535s0 4.91907s9)
+-1.25608s9
+
+(* 0.047058s0 6.612s-14)
+3.11147s-15
+
+(* -0.35054s0 3.764s-14)
+-1.31943s-14
+
+(* 0.372635s0 1.0613s-13)
+3.9548s-14
+
+(* 0.627266s0 -9.519s-14)
+-5.971s-14
+
+(* -0.0293884s0 1.1626s-13)
+-3.41667s-15
+
+(* -0.88304s0 -1.1160s-13)
+9.8547s-14
+
+(* 0.318016s0 -6.86827s19)
+-2.18422s19
+
+(* 0.605064s0 3.4281s19)
+2.07422s19
+
+(* -0.65415s0 -8.185s19)
+5.3542s19
+
+(* 0.87548s0 6.72325s19)
+5.8861s19
+
+(* 0.45806s0 -9.503s19)
+-4.35295s19
+
+(* -0.995384s0 1.62797s19)
+-1.62045s19
+
+(* 0.26301s0 -1.3169s-23)
+-3.46357s-24
+
+(* 0.82762s0 -3.411s-24)
+-2.82304s-24
+
+(* -0.042412s0 -3.339s-24)
+1.41613s-25
+
+(* 0.858284s0 -7.610s-24)
+-6.53157s-24
+
+(* 0.75574s0 1.0518s-23)
+7.9488s-24
+
+(* 0.977s0 -5.944s-24)
+-5.8073s-24
+
+(* 1.1316s9 0.87906s0)
+9.9474s8
+
+(* 9.7596s9 0.58181s0)
+5.67824s9
+
+(* 5.5896s9 -0.91708s0)
+-5.12616s9
+
+(* -7.677s9 -0.67695s0)
+5.19694s9
+
+(* -4.73655s9 0.65572s0)
+-3.10588s9
+
+(* -3.2158s9 -0.30076s0)
+9.6717s8
+
+(* 5.94916s9 -1.02867s9)
+-6.1197s18
+
+(* -3.19098s9 8.125s9)
+-2.59267s19
+
+(* -6.57215s9 9.4253s9)
+-6.1944s19
+
+(* -5.2792s9 3.93547s9)
+-2.0776s19
+
+(* 2.502s9 4.1275s9)
+1.0327s19
+
+(* -8.9462s9 -4.72174s9)
+4.22415s19
+
+(* -8.9588s9 -1.4190s-14)
+1.27126s-4
+
+(* -3.56218s9 -9.982s-14)
+3.5558s-4
+
+(* -3.4449s9 4.582s-15)
+-1.57845s-5
+
+(* -3.7047s9 1.2985s-14)
+-4.8105s-5
+
+(* -8.9172s8 -7.294s-14)
+6.5043s-5
+
+(* 1.64864s9 1.8344s-13)
+3.02427s-4
+
+(* -9.935s8 -7.9116s19)
+7.8602s28
+
+(* -7.0441s9 -6.3448s19)
+4.4693s29
+
+(* 7.72866s9 1.44264s19)
+1.11497s29
+
+(* 3.7816s9 -3.16285s19)
+-1.19606s29
+
+(* -1.06926s9 6.67816s19)
+-7.1407s28
+
+(* 4.04482s9 -3.52235s19)
+-1.42473s29
+
+(* -8.77s8 -3.499s-24)
+3.06864s-15
+
+(* -9.5508s9 1.0006s-23)
+-9.5566s-14
+
+(* -2.98736s9 -7.070s-24)
+2.11207s-14
+
+(* 9.9779s9 1.2683s-23)
+1.26548s-13
+
+(* 7.4813s9 -1.3730s-23)
+-1.02719s-13
+
+(* 8.5804s9 6.999s-24)
+6.0054s-14
+
+(* 4.637s-14 0.895805s0)
+4.15384s-14
+
+(* 1.0125s-13 -0.322685s0)
+-3.26718s-14
+
+(* 2.310s-16 0.0601425s0)
+1.38928s-17
+
+(* 1.0579s-13 -0.27089s0)
+-2.86576s-14
+
+(* 9.540s-14 -0.21251s0)
+-2.02735s-14
+
+(* -4.463s-14 -0.96336s0)
+4.2995s-14
+
+(* 3.270s-14 -5.9141s9)
+-1.93391s-4
+
+(* -6.515s-14 1.01791s9)
+-6.6318s-5
+
+(* 3.695s-14 8.7417s9)
+3.23005s-4
+
+(* -1.0900s-13 -6.75794s9)
+7.3662s-4
+
+(* 4.551s-14 -7.1112s9)
+-3.2363s-4
+
+(* 5.456s-15 -5.44014s9)
+-2.96813s-5
+
+(* -3.377s-14 3.358s-15)
+-1.13399s-28
+
+(* 3.862s-14 7.278s-14)
+2.81079s-27
+
+(* 9.449s-14 3.170s-14)
+2.99533s-27
+
+(* 7.051s-14 -4.234s-14)
+-2.98537s-27
+
+(* -8.955s-14 9.895s-14)
+-8.861s-27
+
+(* -1.6752s-13 -7.341s-14)
+1.22977s-26
+
+(* 9.420s-14 4.50844s19)
+4246900.0s0
+
+(* 2.0183s-13 9.598s19)
+1.93715s7
+
+(* -7.441s-14 -5.7324s19)
+4265500.0s0
+
+(* 7.241s-14 -5.79135s19)
+-4193500.0s0
+
+(* 7.987s-14 8.1113s19)
+6478500.0s0
+
+(* -1.1603s-13 7.4468s19)
+-8640500.0s0
+
+(* -4.432s-14 -6.851s-24)
+3.03637s-37
+
+(* -5.064s-14 -8.119s-24)
+4.1115s-37
+
+(* 3.553s-15 -6.404s-24)
+-2.27533s-38
+
+(* 8.699s-14 -3.558s-24)
+-3.0951s-37
+
+(* 9.820s-14 -5.771s-24)
+-5.6671s-37
+
+(* -3.477s-14 7.723s-24)
+-2.6853s-37
+
+(* 7.9082s19 0.71604s0)
+5.6626s19
+
+(* -6.83905s19 -0.36905s0)
+2.52396s19
+
+(* -7.7697s19 -0.34073s0)
+2.64736s19
+
+(* -2.10557s19 -0.58961s0)
+1.24146s19
+
+(* 9.0963s19 -0.37693s0)
+-3.42865s19
+
+(* -4.24076s19 0.91147s0)
+-3.8653s19
+
+(* -3.5865s19 -6.4046s9)
+2.297s29
+
+(* 7.19225s18 -7.7232s9)
+-5.5547s28
+
+(* 1.98907s19 -9.9239s9)
+-1.97393s29
+
+(* -4.27195s19 7.0734s9)
+-3.02173s29
+
+(* -8.3115s19 5.2947s9)
+-4.40073s29
+
+(* 9.4386s19 8.6548s8)
+8.169s28
+
+(* 6.21677s19 -3.135s-14)
+-1948960.0s0
+
+(* -6.30774s19 1.5884s-13)
+-1.00192s7
+
+(* 7.6073s19 3.922s-14)
+2983550.0s0
+
+(* -1.44485s19 -3.355s-14)
+484748.0s0
+
+(* 3.39653s19 -7.679s-14)
+-2608200.0s0
+
+(* -6.0072s19 1.7825s-13)
+-1.07078s7
+
+(* 1.06812s16 -1.19583s19)
+-1.2773s35
+
+(* 1.1438s19 2.616s-24)
+2.99218s-5
+
+(* -5.79304s18 -3.095s-24)
+1.79296s-5
+
+(* -7.6387s19 8.607s-24)
+-6.5746s-4
+
+(* 4.03933s19 3.058s-24)
+1.23523s-4
+
+(* -2.06994s19 -1.1381s-23)
+2.3558s-4
+
+(* 3.7857s18 -3.590s-24)
+-1.35906s-5
+
+(* 5.656s-24 -0.096458s0)
+-5.4557s-25
+
+(* -5.799s-24 -0.148445s0)
+8.6083s-25
+
+(* -9.041s-24 0.86431s0)
+-7.8143s-24
+
+(* -2.645s-24 -0.911865s0)
+2.41187s-24
+
+(* -9.758s-24 -0.397186s0)
+3.87574s-24
+
+(* -5.345s-24 -0.27215s0)
+1.45463s-24
+
+(* -3.713s-24 9.11335s8)
+-3.38382s-15
+
+(* -3.010s-24 -9.5278s9)
+2.86784s-14
+
+(* -1.6904s-23 -8.37655s9)
+1.41599s-13
+
+(* -5.074s-24 -9.2804s9)
+4.7089s-14
+
+(* -6.942s-22 -8.7038s9)
+6.04217s-12
+
+(* -7.643s-24 -3.1665s9)
+2.42018s-14
+
+(* -2.659s-24 -9.238s-14)
+2.4564s-37
+
+(* -1.7036s-23 3.138s-14)
+-5.34586s-37
+
+(* 7.684s-24 8.639s-14)
+6.6383s-37
+
+(* -3.424s-24 -6.046s-14)
+2.07014s-37
+
+(* 9.3102s-22 -1.1344s-13)
+-1.05614s-34
+
+(* 8.070s-24 3.573s-14)
+2.8834s-37
+
+(* 3.557s-24 7.9957s19)
+2.84407s-4
+
+(* 7.281s-24 -3.45443s19)
+-2.5152s-4
+
+(* -1.6093s-23 3.22463s19)
+-5.1894s-4
+
+(* -1.8628s-23 4.95593s19)
+-9.2319s-4
+
+(* 3.463s-24 -4.44685s19)
+-1.53994s-4
+
+(* -8.081s-24 -1.54701s19)
+1.25013s-4
+
+; ---- Test von FLOOR ---
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.403114s0 0.64293s0))
+(-1 0.239813s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.538574s0 0.74157s0))
+(-1 0.202993s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.59919s0 -0.433258s0))
+(-2 -0.26733s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.62148s0 -0.185875s0))
+(3 -0.063861s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.298317s0 -0.79534s0))
+(-1 -0.49703s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.84822s0 9.519s9))
+(0 0.84822s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.185059s0 -4.4452s9))
+(-1 -4.4452s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.442635s0 -4.64486s9))
+(0 -0.442635s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.78401s0 -8.4401s9))
+(-1 -8.4401s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.300156s0 -4.4083s9))
+(-1 -4.4083s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.67763s0 2.54755s9))
+(0 0.67763s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.189995s0 -1.9236s-13))
+(987708260352 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.442696s0 -4.184s-15))
+(-105806519336960 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.175987s0 -5.055s-15))
+(-34814468030464 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.30565s0 -4.296s-14))
+(-7114747543552 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.256264s0 4.541s-14))
+(5643318591488 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.51656s0 4.057s-14))
+(-12732698984448 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.221672s0 -5.9783s19))
+(0 -0.221672s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.441925s0 -8.1227s19))
+(0 -0.441925s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.73287s0 -3.99683s19))
+(-1 -3.99683s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.376198s0 9.1146s19))
+(-1 9.1146s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.61628s0 -5.83824s19))
+(-1 -5.83824s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.072037s0 4.40705s19))
+(-1 4.40705s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.378708s0 3.258s-24))
+(116238699015966918967296 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.98937s0 -7.698s-24))
+(-128524230569057480343552 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.94075s0 -1.0053s-23))
+(93579179764423948500992 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.263123s0 -3.060s-24))
+(-85988344578092468011008 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.58892s0 -1.1106s-23))
+(53027471682887319814144 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.38977s0 -2.812s-24))
+(138609987891358177689600 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.46599s9 0.338676s0))
+(-4328587264 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.326s9 0.91743s0))
+(-6895370240 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.63617s9 -0.569855s0))
+(6380847104 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.45737s9 0.9508s0))
+(-1532788736 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.24714s9 0.45768s0))
+(11464605696 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.1693s9 0.69472s0))
+(11759255552 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.7664s9 -1.9246s9))
+(1 -8.418s8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.29057s9 -7.18694s9))
+(-2 -6.0833s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.7409s9 8.9158s9))
+(0 6.7409s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.4039s9 -1.80932s9))
+(-6 -1.45206s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.4432s9 -7.587s9))
+(-1 -3.14373s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.8365s9 -3.4401s8))
+(14 -2.03249s7)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.70575s9 2.813s-15))
+(1672861433068424397848576 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.37706s8 1.1696s-13))
+(7162308674587923054592 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.9421s9 3.384s-15))
+(1460410281571511491887104 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.4391s8 6.964s-14))
+(13554177553722320617472 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.56217s8 3.380s-14))
+(10538999588799264063488 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.53166s9 7.011s-14))
+(107426919956256787529728 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.3385s9 -7.8903s19))
+(0 -5.3385s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.5786s8 -6.5112s19))
+(0 -5.5786s8)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.0502s9 -2.57187s18))
+(0 -7.0502s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.48724s9 3.0864s19))
+(0 3.48724s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.195s9 6.9068s19))
+(-1 6.9068s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.40785s9 6.1696s19))
+(0 6.40785s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.9772s9 -3.455s-24))
+(2887787295482420840947083445796864 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.3337s9 -2.757s-24))
+(-2297319607304237298946798769930240 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.24916s9 8.958s-24))
+(251078998767860827355040375111680 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.695s9 -9.695s-24))
+(484267288087969338977238606938112 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.84457s9 -7.7713s-22))
+(7520717852416051178813723246592 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.01576s9 6.682s-24))
+(-301671132293375748429617783898112 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.7042s-13 -0.80732s0))
+(-1 -0.80732s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.959s-14 0.9918s0))
+(0 4.959s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.0820s-13 0.75837s0))
+(0 2.08202s-13)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.808s-14 0.89121s0))
+(0 4.808s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.005s-14 0.71084s0))
+(-1 0.71084s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.497s-14 -0.83223s0))
+(-1 -0.83223s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.538s-14 3.81524s9))
+(-1 3.81524s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.0888s-13 2.5705s9))
+(-1 2.5705s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.0445s-15 3.9579s9))
+(-1 3.9579s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.399s-14 3.8115s9))
+(-1 3.8115s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.889s-14 1.02951s9))
+(0 8.889s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.408s-14 -5.5562s9))
+(0 -4.40806s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.4679s-13 -1.9105s-13))
+(-1 -4.426s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.2740s-14 -4.935s-14))
+(-1 -3.661s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.321s-14 -8.355s-14))
+(0 -4.32102s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.1228s-13 -3.641s-14))
+(3 -3.0501s-15)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.643s-14 9.809s-14))
+(0 4.643s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.832s-14 1.2918s-13))
+(0 6.832s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.186s-15 7.2502s19))
+(-1 7.2502s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.570s-14 -6.8838s19))
+(-1 -6.8838s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.5446s-14 -8.6798s19))
+(0 -1.5446s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.2496s-13 -8.0029s19))
+(0 -1.24963s-13)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.303s-15 -9.7969s19))
+(0 -3.303s-15)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.832s-14 5.17976s19))
+(-1 5.17976s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.1039s-13 1.1031s-23))
+(-10007216128 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.303s-14 -1.61171s-21))
+(20493824 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.660s-14 -1.3664s-23))
+(-2678554624 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.9574s-13 -6.864s-24))
+(28516810752 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.285s-14 -3.329s-24))
+(-9867755520 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.291s-15 4.2038s-23))
+(-78285824 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.18707s19 0.231445s0))
+(-310527697906823069696 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.5173s19 -0.0566254s0))
+(-1680761395333178589184 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.6524s19 -0.697136s0))
+(95424520704539754496 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.42423s19 0.68306s0))
+(50130693352167833600 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.2388s19 0.0522995s0))
+(-1384100280679029276672 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.9235s18 -0.24643s0))
+(-24037400061136601088 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.63137s18 -1.6819s9))
+(1564524544 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.4749s19 -2.36457s9))
+(-10466623488 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.07847s19 6.4981s9))
+(-3198582784 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.54907s19 4.4446s9))
+(-5735186432 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.34573s19 3.0757s9))
+(7626620928 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.93055s19 4.8192s9))
+(-4005953536 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.4928s19 9.588s-14))
+(468585063670302141654816501268480 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.17698s19 -3.259s-14))
+(667992445198391196335567431270400 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.3605s19 -1.2702s-13))
+(658197863607565267600565560410112 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.2775s19 3.555s-15))
+(14845297722947765992252704150257664 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.0371s19 6.922s-15))
+(-7276948270610150879291824750460928 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.3107s18 -1.0201s-13))
+(-81468833985370875891111365181440 0.0s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.8796s19 3.8685s19))
+(-2 3.85733s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.11224s18 -7.757s19))
+(-1 -7.34577s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.7228s19 -6.0107s19))
+(0 -1.72278s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.1191s19 -4.49645s19))
+(-3 -4.3702s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.2755s19 8.9417s19))
+(0 4.2755s19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.3237s19 -1.9687s19))
+(2 -3.86314s18)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.109s-24 0.00614166s0))
+(0 3.109s-24)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.2027s-23 0.0328217s0))
+(-1 0.0328217s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.017s-24 0.76966s0))
+(-1 0.76966s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.628s-24 0.47249s0))
+(-1 0.47249s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.323s-24 -0.86671s0))
+(-1 -0.86671s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.302s-24 0.0245514s0))
+(-1 0.0245514s0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.342s-24 6.0717s9))
+(0 5.34194s-24)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.664s-24 5.573s9))
+(-1 5.573s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.830s-24 7.0363s9))
+(-1 7.0363s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.176s-24 1.12686s9))
+(-1 1.12686s9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.2026s-22 -3.99255s9))
+(0 -2.2026s-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.994s-24 5.81167s9))
+(0 6.994s-24)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.054s-24 -8.915s-14))
+(-1 -8.915s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.875s-24 3.652s-14))
+(0 2.875s-24)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.57853s-22 -4.501s-14))
+(0 -1.57853s-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.3880s-23 -1.0479s-13))
+(0 -1.388s-23)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.879s-24 3.974s-14))
+(-1 3.974s-14)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.14395s-21 -4.527s-14))
+(0 -1.14395s-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.149s-24 9.418s-24))
+(0 6.149s-24)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.661s-24 -2.956s-24))
+(-3 -1.20701s-24)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.254s-24 1.2764s-22))
+(0 3.254s-24)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.4542s-22 5.574s-24))
+(-98 8.2738s-25)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.4523s-23 3.091s-24))
+(-5 9.3198s-25)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.913s-24 8.419s-24))
+(-1 2.506s-24)
+
+; ---- Test von / ---
+
+(/ 0.4319s0 0.279747s0)
+1.5439s0
+
+(/ 0.58111s0 0.474937s0)
+1.22354s0
+
+(/ 0.95817s0 -0.209396s0)
+-4.57587s0
+
+(/ -0.30497s0 -0.182861s0)
+1.66777s0
+
+(/ -0.69316s0 -0.32908s0)
+2.10635s0
+
+(/ -0.87152s0 0.518326s0)
+-1.68141s0
+
+(/ -0.81208s0 3.27736s9)
+-2.47784s-10
+
+(/ 0.88465s0 2.15492s9)
+4.10527s-10
+
+(/ -0.96446s0 8.0971s9)
+-1.19112s-10
+
+(/ -0.65258s0 -3.98033s9)
+1.6395s-10
+
+(/ 0.663826s0 -7.88726s8)
+-8.41645s-10
+
+(/ -0.31185s0 4.1015s9)
+-7.6033s-11
+
+(/ -0.89607s0 -3.887s-14)
+2.3053s13
+
+(/ -0.670135s0 -5.027s-14)
+1.33306s13
+
+(/ 0.94663s0 -6.153s-14)
+-1.5385s13
+
+(/ -0.76772s0 4.033s-14)
+-1.90358s13
+
+(/ -0.446358s0 -1.9017s-13)
+2.34713s12
+
+(/ -0.157814s0 -2.0401s-13)
+7.73555s11
+
+(/ 0.636185s0 -3.78516s19)
+-1.68073s-20
+
+(/ -0.90556s0 7.7192s19)
+-1.17314s-20
+
+(/ 0.85053s0 8.3134s19)
+1.02309s-20
+
+(/ -0.3058s0 3.00674s19)
+-1.01705s-20
+
+(/ 0.219429s0 -8.1184s19)
+-2.70286s-21
+
+(/ 0.319603s0 -2.0739s19)
+-1.54106s-20
+
+(/ 0.58943s0 -5.280s-24)
+-1.11635s23
+
+(/ 0.72955s0 7.852s-24)
+9.2914s22
+
+(/ -0.66327s0 -3.124s-24)
+2.12315s23
+
+(/ -0.0137558s0 -7.918s-24)
+1.73729s21
+
+(/ 0.35823s0 5.467s-24)
+6.55263s22
+
+(/ 0.93861s0 9.968s-24)
+9.4163s22
+
+(/ 3.83346s9 0.99782s0)
+3.84185s9
+
+(/ 8.7033s9 -0.81822s0)
+-1.06369s10
+
+(/ 3.52326s8 -0.79994s0)
+-4.4044s8
+
+(/ 8.0525s9 -0.91803s0)
+-8.7715s9
+
+(/ -2.12784s9 -0.761246s0)
+2.7952s9
+
+(/ 1.18805s9 -0.903534s0)
+-1.3149s9
+
+(/ -6.50556s9 -5.4642s9)
+1.19058s0
+
+(/ 3.3333s8 1.8341s8)
+1.81738s0
+
+(/ 3.70934s9 9.1957s8)
+4.03375s0
+
+(/ -8.0459s9 4.5511s9)
+-1.76791s0
+
+(/ 3.54982s9 4.6631s8)
+7.6126s0
+
+(/ -6.27016s9 -3.42858s9)
+1.8288s0
+
+(/ -4.3213s9 7.223s-15)
+-5.98274s23
+
+(/ -2.57753s9 -2.533s-15)
+1.01759s24
+
+(/ 3.8858s9 -4.505s-14)
+-8.6256s22
+
+(/ 3.5946s9 -5.067s-14)
+-7.0941s22
+
+(/ 2.94434s9 8.333s-14)
+3.53333s22
+
+(/ 5.6178s9 -8.241s-14)
+-6.81694s22
+
+(/ 4.9591s8 3.9972s19)
+1.24064s-11
+
+(/ 2.4166s9 -9.2141s19)
+-2.62272s-11
+
+(/ -1.484s9 2.0281s19)
+-7.3172s-11
+
+(/ 2.2339s8 1.96374s19)
+1.13758s-11
+
+(/ -6.6306s9 -2.414s19)
+2.7467s-10
+
+(/ 9.9114s9 9.6187s19)
+1.03043s-10
+
+(/ 4.4579s9 5.343s-24)
+8.3434s32
+
+(/ -6.35994s9 -6.301s-24)
+1.00936s33
+
+(/ 5.49677s9 -1.9306s-25)
+-2.84717s34
+
+(/ -5.007s9 3.692s-24)
+-1.35617s33
+
+(/ 8.6837s9 -1.6358s-23)
+-5.3085s32
+
+(/ 5.5898s9 -5.435s-24)
+-1.02849s33
+
+(/ -5.042s-14 0.79081s0)
+-6.3758s-14
+
+(/ -6.231s-14 0.96946s0)
+-6.4273s-14
+
+(/ 6.016s-14 0.418983s0)
+1.43587s-13
+
+(/ -1.1682s-13 0.70944s0)
+-1.64663s-13
+
+(/ -1.7485s-13 0.83207s0)
+-2.1014s-13
+
+(/ 7.831s-15 -0.083374s0)
+-9.3926s-14
+
+(/ 3.947s-14 9.2342s9)
+4.2744s-24
+
+(/ -1.1537s-13 -6.44075s9)
+1.79124s-23
+
+(/ 6.751s-14 5.8395s8)
+1.1561s-22
+
+(/ -5.026s-14 7.9677s9)
+-6.308s-24
+
+(/ -1.0105s-13 -1.71082s9)
+5.9066s-23
+
+(/ -4.996s-14 9.426s9)
+-5.30024s-24
+
+(/ -6.837s-14 -3.573s-14)
+1.91351s0
+
+(/ -7.736s-14 -4.898s-14)
+1.57942s0
+
+(/ 3.777s-14 8.025s-14)
+0.470657s0
+
+(/ -6.239s-14 8.518s-15)
+-7.32446s0
+
+(/ -7.548s-15 -4.573s-14)
+0.165056s0
+
+(/ 1.6293s-14 4.712s-14)
+0.345776s0
+
+(/ -4.47s-14 2.73658s19)
+-1.63342s-33
+
+(/ 1.0583s-13 2.52534s19)
+4.19073s-33
+
+(/ 4.351s-15 2.70326s19)
+1.60955s-34
+
+(/ 3.699s-14 -6.00707s19)
+-6.1577s-34
+
+(/ 6.358s-14 5.18274s19)
+1.22677s-33
+
+(/ -2.971s-14 6.153s19)
+-4.8286s-34
+
+(/ -4.968s-14 7.699s-24)
+-6.4528s9
+
+(/ -3.654s-14 8.434s-24)
+-4.3325s9
+
+(/ -9.276s-14 -7.079s-24)
+1.31035s10
+
+(/ -4.556s-14 1.3900s-23)
+-3.27772s9
+
+(/ 3.832s-14 1.55715s-22)
+2.4609s8
+
+(/ 1.4186s-13 1.64482s-21)
+8.6246s7
+
+(/ -7.0974s19 -0.705536s0)
+1.00596s20
+
+(/ -7.687s19 -0.241531s0)
+3.1826s20
+
+(/ 3.37013s19 -0.425987s0)
+-7.9114s19
+
+(/ 6.56473s19 -0.60696s0)
+-1.08158s20
+
+(/ 4.1598s19 0.60135s0)
+6.9175s19
+
+(/ 8.8312s19 0.93547s0)
+9.4404s19
+
+(/ 2.81357s19 -2.62832s9)
+-1.07048s10
+
+(/ 5.9243s19 -4.5189s8)
+-1.311s11
+
+(/ -8.3887s19 9.5761s9)
+-8.7601s9
+
+(/ 7.7606s19 -8.5369s9)
+-9.0906s9
+
+(/ -7.9868s19 5.0173s9)
+-1.59186s10
+
+(/ 7.4128s19 -6.7781s9)
+-1.09364s10
+
+(/ 1.27472s19 1.1699s-13)
+1.0896s32
+
+(/ 2.97578s19 4.448s-14)
+6.6901s32
+
+(/ 7.19416s19 1.3834s-13)
+5.20034s32
+
+(/ 6.61843s19 -4.268s-14)
+-1.55071s33
+
+(/ 2.8579s19 4.364s-14)
+6.5488s32
+
+(/ 8.2451s18 -6.532s-14)
+-1.26227s32
+
+(/ 4.63364s19 9.4305s19)
+0.491344s0
+
+(/ -1.81999s19 1.05424s19)
+-1.72636s0
+
+(/ -1.41579s19 -4.03517s19)
+0.350864s0
+
+(/ -1.88523s18 -3.3165s18)
+0.568436s0
+
+(/ 8.4152s17 -7.3293s19)
+-0.0114815s0
+
+(/ -8.674s19 -3.63595s19)
+2.38562s0
+
+(/ -1.64643s-22 0.78035s0)
+-2.10986s-22
+
+(/ -7.455s-24 -0.63174s0)
+1.18009s-23
+
+(/ -3.259s-24 -0.89363s0)
+3.64694s-24
+
+(/ 1.5803s-23 -0.11338s0)
+-1.39382s-22
+
+(/ -3.534s-24 0.407562s0)
+-8.6711s-24
+
+(/ -7.221s-24 0.90274s0)
+-7.999s-24
+
+(/ 1.0479s-23 5.66256s8)
+1.85059s-32
+
+(/ 1.62856s-21 -1.9551s9)
+-8.3298s-31
+
+(/ -8.102s-24 9.7896s9)
+-8.2761s-34
+
+(/ 9.693s-24 -8.777s9)
+-1.10437s-33
+
+(/ 8.643s-24 -1.25557s9)
+-6.8837s-33
+
+(/ 3.224s-24 9.8161s9)
+3.2844s-34
+
+(/ 1.06582s-21 -1.0408s-13)
+-1.02405s-8
+
+(/ 1.6738s-23 9.851s-14)
+1.69914s-10
+
+(/ -1.1514s-23 -6.509s-14)
+1.76893s-10
+
+(/ 9.171s-24 9.292s-14)
+9.8698s-11
+
+(/ 1.8589s-23 -4.213s-14)
+-4.4123s-10
+
+(/ 1.2837s-23 1.1034s-13)
+1.16341s-10
+
+(/ 3.671s-24 1.0091s-23)
+0.363792s0
+
+(/ -3.373s-24 -1.7017s-23)
+0.198214s0
+
+(/ -2.0157s-23 1.0021s-23)
+-2.01147s0
+
+(/ 8.041s-24 -1.3974s-23)
+-0.575424s0
+
+(/ -5.391s-24 1.1762s-23)
+-0.458344s0
+
+(/ 1.7735s-23 -3.313s-24)
+-5.3531s0
+
+;; ==== S I N G L E - F L O A T S ====
+
+; ---- Test von + ---
+
+(+ 0.79351956 0.07393837)
+0.8674579
+
+(+ -0.52145976 -0.14409256)
+-0.6655523
+
+(+ -0.094845235 -0.091273725)
+-0.18611896
+
+(+ -0.11106694 -0.90595967)
+-1.0170267
+
+(+ 0.46902913 0.6453068)
+1.114336
+
+(+ -0.30989015 0.6634996)
+0.35360944
+
+(+ -0.58887166 -3.1150198E9)
+-3.1150198E9
+
+(+ 0.08032262 -8.451643E9)
+-8.451643E9
+
+(+ -0.734433 7.601292E9)
+7.601292E9
+
+(+ 0.77958024 -4.2334996E9)
+-4.2334996E9
+
+(+ -0.5492505 4.4427484E9)
+4.4427484E9
+
+(+ -0.45681345 4.7386803E9)
+4.7386803E9
+
+(+ -0.5951412 7.866326E-11)
+-0.5951412
+
+(+ 0.8511461 8.396644E-11)
+0.8511461
+
+(+ -0.94777477 -7.635105E-11)
+-0.94777477
+
+(+ -0.20783025 -1.7222382E-11)
+-0.20783025
+
+(+ 0.82520634 -5.3449255E-11)
+0.82520634
+
+(+ 0.7797032 3.7409843E-11)
+0.7797032
+
+(+ 0.9915549 5.16192E19)
+5.16192E19
+
+(+ -0.6311349 2.1599532E19)
+2.1599532E19
+
+(+ 0.42801672 4.8533796E18)
+4.8533796E18
+
+(+ -0.11165339 6.518633E19)
+6.518633E19
+
+(+ -0.5133993 -5.5200484E19)
+-5.5200484E19
+
+(+ 0.11643493 -1.0541451E19)
+-1.0541451E19
+
+(+ -0.7063649 8.243067E-21)
+-0.7063649
+
+(+ 8.4728E-4 -7.5151976E-21)
+8.4728E-4
+
+(+ -0.47157037 -8.748518E-21)
+-0.47157037
+
+(+ 0.7662331 -5.6591384E-21)
+0.7662331
+
+(+ -0.9418909 -4.455382E-21)
+-0.9418909
+
+(+ -0.88412094 6.6664897E-21)
+-0.88412094
+
+(+ 5.5891533E9 -0.11624104)
+5.5891533E9
+
+(+ -8.760519E9 0.22073412)
+-8.760519E9
+
+(+ 6.8390047E9 -0.6434584)
+6.8390047E9
+
+(+ 5.1620844E9 -0.93939686)
+5.1620844E9
+
+(+ 9.21372E9 -0.93054956)
+9.21372E9
+
+(+ -2.7403366E9 -0.9354063)
+-2.7403366E9
+
+(+ 6.4755876E9 7.780013E9)
+1.4255601E10
+
+(+ 3.6402857E9 -4.6589404E9)
+-1.0186547E9
+
+(+ 9.858497E9 -3.1216233E9)
+6.7368735E9
+
+(+ -5.199144E9 -8.3410964E9)
+-1.354024E10
+
+(+ -2.2145843E9 7.4088115E9)
+5.194227E9
+
+(+ 3.6034734E9 -4.7355105E9)
+-1.1320371E9
+
+(+ -3.974853E9 8.344858E-11)
+-3.974853E9
+
+(+ 9.633741E9 9.879035E-11)
+9.633741E9
+
+(+ -5.84563E9 -2.8054357E-11)
+-5.84563E9
+
+(+ 1.6814709E8 -6.702281E-11)
+1.6814709E8
+
+(+ 6.627381E8 8.1083654E-11)
+6.627381E8
+
+(+ 6.617609E9 -7.74835E-11)
+6.617609E9
+
+(+ -4.325255E9 7.48992E19)
+7.48992E19
+
+(+ 8.963769E9 5.6527995E19)
+5.6527995E19
+
+(+ 3.2307428E9 -3.772047E19)
+-3.772047E19
+
+(+ -1.5719092E9 9.119215E19)
+9.119215E19
+
+(+ -3.1338138E9 2.7048826E19)
+2.7048826E19
+
+(+ -4.4506363E9 9.624759E19)
+9.624759E19
+
+(+ 1.8499094E9 4.968932E-21)
+1.8499094E9
+
+(+ 1.1302281E9 1.590079E-21)
+1.1302281E9
+
+(+ 5.7261727E9 -3.3212954E-21)
+5.7261727E9
+
+(+ 1.8314988E9 -6.247946E-21)
+1.8314988E9
+
+(+ -7.301286E9 -8.870309E-21)
+-7.301286E9
+
+(+ 8.0970737E9 -6.944993E-21)
+8.0970737E9
+
+(+ 9.076142E-11 0.79629874)
+0.79629874
+
+(+ -2.5569331E-11 -0.11109424)
+-0.11109424
+
+(+ 5.817238E-11 0.8669617)
+0.8669617
+
+(+ 5.0001194E-11 0.1629681)
+0.1629681
+
+(+ -5.314657E-11 0.33499128)
+0.33499128
+
+(+ 3.4244614E-11 0.7846571)
+0.7846571
+
+(+ 5.016508E-11 1.2850774E9)
+1.2850774E9
+
+(+ -6.236206E-11 -3.9463657E9)
+-3.9463657E9
+
+(+ -9.461717E-11 -2.86016E9)
+-2.86016E9
+
+(+ 9.271425E-11 9.936099E9)
+9.936099E9
+
+(+ -9.330213E-12 4.2810826E9)
+4.2810826E9
+
+(+ 8.8110796E-11 -7.967343E9)
+-7.967343E9
+
+(+ -3.252064E-11 9.310712E-11)
+6.058648E-11
+
+(+ 9.2616026E-11 -4.2321837E-11)
+5.029419E-11
+
+(+ -6.138445E-11 2.0083374E-11)
+-4.130108E-11
+
+(+ -1.672895E-11 -4.1673078E-11)
+-5.8402026E-11
+
+(+ -5.054619E-11 -1.9569606E-11)
+-7.0115795E-11
+
+(+ -6.765585E-11 6.200571E-11)
+-5.65014E-12
+
+(+ -8.958499E-11 9.627367E18)
+9.627367E18
+
+(+ -3.639458E-11 -6.774422E19)
+-6.774422E19
+
+(+ 5.885664E-11 7.710968E19)
+7.710968E19
+
+(+ -2.8348934E-11 -6.8805507E19)
+-6.8805507E19
+
+(+ 3.783013E-11 -4.363011E19)
+-4.363011E19
+
+(+ 9.9192224E-11 7.840148E19)
+7.840148E19
+
+(+ 1.5157771E-11 -6.578477E-21)
+1.5157771E-11
+
+(+ 3.269849E-11 -1.5641468E-21)
+3.269849E-11
+
+(+ -2.4697334E-11 -5.9471063E-21)
+-2.4697334E-11
+
+(+ -7.226034E-11 -8.027814E-21)
+-7.226034E-11
+
+(+ 6.705153E-12 1.3146739E-21)
+6.705153E-12
+
+(+ -9.281199E-11 1.940757E-22)
+-9.281199E-11
+
+(+ 6.841885E19 0.29873258)
+6.841885E19
+
+(+ -7.487633E19 -0.41199452)
+-7.487633E19
+
+(+ 9.324847E19 -0.12986994)
+9.324847E19
+
+(+ 1.7454827E19 -0.9480438)
+1.7454827E19
+
+(+ -2.2794772E19 -0.85242146)
+-2.2794772E19
+
+(+ -1.4789046E18 -0.3244334)
+-1.4789046E18
+
+(+ -1.0913384E19 6.2691034E8)
+-1.0913384E19
+
+(+ 9.054158E19 6.7361736E9)
+9.054158E19
+
+(+ -2.404365E19 2.819194E9)
+-2.404365E19
+
+(+ 3.0628145E19 3.8188636E9)
+3.0628145E19
+
+(+ -3.7020847E19 -4.248917E8)
+-3.7020847E19
+
+(+ 8.556466E19 -5.431256E9)
+8.556466E19
+
+(+ 4.8590555E19 -4.0259546E-11)
+4.8590555E19
+
+(+ -1.990289E19 -3.2150872E-11)
+-1.990289E19
+
+(+ -1.5843934E19 5.37822E-11)
+-1.5843934E19
+
+(+ 1.596058E19 2.465645E-11)
+1.596058E19
+
+(+ 8.179266E19 -8.080585E-11)
+8.179266E19
+
+(+ 8.673572E19 -2.1405459E-11)
+8.673572E19
+
+(+ -4.5302206E19 4.4819714E19)
+-4.824921E17
+
+(+ 2.1413618E19 -7.160984E19)
+-5.0196224E19
+
+(+ 9.760235E19 -7.810464E19)
+1.949771E19
+
+(+ -7.518544E19 -5.7398474E19)
+-1.32583915E20
+
+(+ -2.459352E19 6.0089863E19)
+3.5496343E19
+
+(+ -9.009707E19 1.9710512E19)
+-7.0386556E19
+
+(+ 4.9167807E19 -1.261897E-21)
+4.9167807E19
+
+(+ -8.647001E18 -1.4144885E-21)
+-8.647001E18
+
+(+ -6.2763383E19 6.69688E-21)
+-6.2763383E19
+
+(+ 1.6851938E19 -4.9109547E-21)
+1.6851938E19
+
+(+ -7.0371058E19 -9.246501E-21)
+-7.0371058E19
+
+(+ -2.8498996E19 3.3614294E-21)
+-2.8498996E19
+
+(+ -4.8211753E-21 0.5153807)
+0.5153807
+
+(+ -9.730312E-21 0.3705088)
+0.3705088
+
+(+ -8.83036E-21 0.21063423)
+0.21063423
+
+(+ 1.8688595E-21 -0.38304192)
+-0.38304192
+
+(+ -7.9137435E-21 -0.9482965)
+-0.9482965
+
+(+ -5.7913193E-21 -0.16538233)
+-0.16538233
+
+(+ -4.667948E-21 5.69782E9)
+5.69782E9
+
+(+ -1.6254025E-21 1.100067E9)
+1.100067E9
+
+(+ 5.4919865E-21 9.125866E9)
+9.125866E9
+
+(+ 2.1973532E-21 -5.218964E9)
+-5.218964E9
+
+(+ -4.018586E-21 -6.5943096E9)
+-6.5943096E9
+
+(+ -7.7845274E-22 4.172669E9)
+4.172669E9
+
+(+ -2.843846E-21 9.243441E-12)
+9.243441E-12
+
+(+ 1.1533075E-21 3.327943E-11)
+3.327943E-11
+
+(+ 5.977113E-21 6.507544E-11)
+6.507544E-11
+
+(+ 1.1817801E-21 -4.1877824E-11)
+-4.1877824E-11
+
+(+ 1.932947E-21 9.4013144E-11)
+9.4013144E-11
+
+(+ 8.526454E-21 8.396772E-11)
+8.396772E-11
+
+(+ -4.8870485E-21 5.9277504E19)
+5.9277504E19
+
+(+ -4.7174987E-21 2.5545484E19)
+2.5545484E19
+
+(+ -8.818029E-21 1.2602901E19)
+1.2602901E19
+
+(+ -1.2268113E-21 -9.071741E19)
+-9.071741E19
+
+(+ -7.0568975E-21 -6.9825405E19)
+-6.9825405E19
+
+(+ 8.723312E-21 -5.802767E19)
+-5.802767E19
+
+(+ 7.1661314E-21 4.10364E-21)
+1.1269772E-20
+
+(+ 8.181265E-21 -4.6898657E-21)
+3.4913997E-21
+
+(+ -8.570217E-21 -5.5145446E-21)
+-1.4084761E-20
+
+(+ 1.3507604E-23 -7.152723E-21)
+-7.139215E-21
+
+(+ -7.859527E-21 -9.369602E-21)
+-1.7229128E-20
+
+(+ -4.9014434E-21 1.4580911E-21)
+-3.443352E-21
+
+; ---- Test von - ---
+
+(- -0.41894162 0.23777992)
+-0.65672153
+
+(- 0.74937063 0.4803756)
+0.26899505
+
+(- 0.46964037 -0.94880456)
+1.4184449
+
+(- 0.16453332 0.035123527)
+0.12940979
+
+(- 0.7353321 -0.3952883)
+1.1306204
+
+(- -0.33693552 -0.6941588)
+0.35722327
+
+(- -0.61853 -9.25498E9)
+9.25498E9
+
+(- 0.5172653 -6.728693E9)
+6.728693E9
+
+(- 0.1268478 -1.8808037E9)
+1.8808037E9
+
+(- 0.29479754 -3.4643973E9)
+3.4643973E9
+
+(- 0.34332883 1.4258218E9)
+-1.4258218E9
+
+(- -0.4093976 -1.6698813E9)
+1.6698813E9
+
+(- 0.10942185 -2.015636E-11)
+0.10942185
+
+(- 0.30351585 4.4276416E-11)
+0.30351585
+
+(- -0.41279083 6.5274E-11)
+-0.41279083
+
+(- 0.7813598 -5.028443E-11)
+0.7813598
+
+(- -0.72214615 2.5959075E-11)
+-0.72214615
+
+(- -0.8924311 -5.2076333E-11)
+-0.8924311
+
+(- -0.26128495 6.8887236E19)
+-6.8887236E19
+
+(- 0.906616 -2.0519019E18)
+2.0519019E18
+
+(- 0.96452767 -1.6347343E19)
+1.6347343E19
+
+(- -0.99801517 8.383864E19)
+-8.383864E19
+
+(- -0.60573876 -4.890489E19)
+4.890489E19
+
+(- -0.004701972 6.3981E18)
+-6.3981E18
+
+(- 0.34311903 3.52871E-21)
+0.34311903
+
+(- -0.38159567 -2.3400748E-21)
+-0.38159567
+
+(- -0.6719565 -5.4333447E-21)
+-0.6719565
+
+(- -0.21363729 8.021308E-21)
+-0.21363729
+
+(- 0.5275244 -4.88554E-21)
+0.5275244
+
+(- 0.9064559 -6.5840867E-21)
+0.9064559
+
+(- -3.0312538E8 0.26249015)
+-3.0312538E8
+
+(- -9.217122E9 0.22172129)
+-9.217122E9
+
+(- -1.157806E9 -0.95704305)
+-1.157806E9
+
+(- 6.743087E9 -0.37863714)
+6.743087E9
+
+(- -4.0819942E8 -0.068549395)
+-4.0819942E8
+
+(- 4.586502E9 0.29215187)
+4.586502E9
+
+(- 5.091125E9 -2.971223E9)
+8.0623483E9
+
+(- -2.1147072E8 -8.537374E9)
+8.3259034E9
+
+(- -9.075735E9 -9.072693E9)
+-3041280.0
+
+(- 1.4614451E9 3.0213921E9)
+-1.559947E9
+
+(- 8.960645E9 5.4822825E9)
+3.4783626E9
+
+(- -3.7246787E9 -2.823592E9)
+-9.010867E8
+
+(- -3.4256804E9 -1.8245674E-11)
+-3.4256804E9
+
+(- 7.0777057E9 3.6826153E-11)
+7.0777057E9
+
+(- 3.4600579E9 -5.207135E-11)
+3.4600579E9
+
+(- 9.57872E9 8.222393E-11)
+9.57872E9
+
+(- 8.388926E9 -1.1216945E-11)
+8.388926E9
+
+(- 3.8273395E8 1.153788E-11)
+3.8273395E8
+
+(- -1.2011469E8 -9.879852E19)
+9.879852E19
+
+(- 3.850388E9 4.8155957E19)
+-4.8155957E19
+
+(- 5.5329756E9 -5.067925E19)
+5.067925E19
+
+(- 3.3222902E9 5.2892763E19)
+-5.2892763E19
+
+(- 4.431185E9 -8.005187E19)
+8.005187E19
+
+(- -7.307553E8 -6.8217897E19)
+6.8217897E19
+
+(- 7.9813893E9 9.68989E-21)
+7.9813893E9
+
+(- -5.7208223E9 9.790913E-21)
+-5.7208223E9
+
+(- -5.9564112E7 9.217466E-21)
+-5.9564112E7
+
+(- 5.4524237E9 4.947411E-21)
+5.4524237E9
+
+(- 1.4269632E9 -5.1552662E-21)
+1.4269632E9
+
+(- 3.7555832E9 -4.168443E-21)
+3.7555832E9
+
+(- -4.1575327E-11 -0.38582206)
+0.38582206
+
+(- -5.810516E-11 -0.5456566)
+0.5456566
+
+(- -1.2386638E-11 -0.6209788)
+0.6209788
+
+(- 2.0245033E-11 -0.7418727)
+0.7418727
+
+(- 3.7671637E-11 0.1772576)
+-0.1772576
+
+(- -2.2774244E-11 -0.5959606)
+0.5959606
+
+(- -5.6623112E-11 6.8330056E9)
+-6.8330056E9
+
+(- -9.2078116E-11 -3.4236897E9)
+3.4236897E9
+
+(- -3.317883E-11 -3.2438755E8)
+3.2438755E8
+
+(- 6.711307E-11 -7.9204526E9)
+7.9204526E9
+
+(- -5.1150143E-11 9.1128E9)
+-9.1128E9
+
+(- -7.3234044E-11 -8.067016E9)
+8.067016E9
+
+(- -3.217777E-11 -1.6301262E-11)
+-1.5876508E-11
+
+(- 9.6583325E-11 5.882668E-11)
+3.7756645E-11
+
+(- -7.573351E-11 6.3386435E-11)
+-1.3911994E-10
+
+(- -4.5759726E-11 8.069604E-11)
+-1.2645576E-10
+
+(- -9.538651E-11 -9.01152E-11)
+-5.271311E-12
+
+(- 6.2486766E-11 -3.414284E-11)
+9.662961E-11
+
+(- 5.530477E-13 -3.1361222E18)
+3.1361222E18
+
+(- 1.7998643E-11 1.5437615E19)
+-1.5437615E19
+
+(- -4.7948378E-11 2.6669319E19)
+-2.6669319E19
+
+(- -6.8626884E-12 -5.7713735E19)
+5.7713735E19
+
+(- 6.195949E-11 2.8851469E19)
+-2.8851469E19
+
+(- 2.4957127E-11 -2.661574E18)
+2.661574E18
+
+(- 9.8157565E-11 -4.561507E-21)
+9.8157565E-11
+
+(- -9.332288E-11 -9.280375E-21)
+-9.332288E-11
+
+(- -9.916877E-11 -1.6945641E-21)
+-9.916877E-11
+
+(- -6.460804E-11 -3.6695186E-21)
+-6.460804E-11
+
+(- 6.712223E-11 -2.5360524E-21)
+6.712223E-11
+
+(- 2.3824066E-11 -7.439168E-21)
+2.3824066E-11
+
+(- -5.189389E19 0.01453203)
+-5.189389E19
+
+(- 7.0132006E19 0.45530832)
+7.0132006E19
+
+(- 2.9365046E19 0.36346745)
+2.9365046E19
+
+(- -4.1377934E19 0.37368965)
+-4.1377934E19
+
+(- -1.891423E19 0.159002)
+-1.891423E19
+
+(- 1.8096083E19 -0.6511793)
+1.8096083E19
+
+(- 6.4361307E19 6.6511677E9)
+6.4361307E19
+
+(- -1.8698508E19 1.1925399E9)
+-1.8698508E19
+
+(- 7.75824E19 7.7361823E9)
+7.75824E19
+
+(- -7.2570015E19 3.0842496E9)
+-7.2570015E19
+
+(- -1.9014525E19 -3.8941514E9)
+-1.9014525E19
+
+(- 3.2787157E19 -8.612244E9)
+3.2787157E19
+
+(- 6.4268583E19 -1.2707472E-11)
+6.4268583E19
+
+(- -6.5179933E19 8.61941E-11)
+-6.5179933E19
+
+(- -8.106952E19 2.1709537E-11)
+-8.106952E19
+
+(- 2.5455064E19 3.5653924E-11)
+2.5455064E19
+
+(- 1.574235E19 -2.7033407E-11)
+1.574235E19
+
+(- -1.1099541E19 -8.620364E-12)
+-1.1099541E19
+
+(- -6.346294E19 2.9902512E19)
+-9.336545E19
+
+(- 4.9783164E19 -2.079425E19)
+7.0577414E19
+
+(- -7.149202E19 1.4282865E19)
+-8.577488E19
+
+(- 6.0978866E19 5.256896E19)
+8.409905E18
+
+(- -9.961146E19 -1.9834548E19)
+-7.977691E19
+
+(- 2.5196015E18 5.0534214E19)
+-4.8014613E19
+
+(- -3.6981453E19 -1.005367E-21)
+-3.6981453E19
+
+(- 8.881044E19 -9.717088E-22)
+8.881044E19
+
+(- 4.9637263E19 -7.544846E-21)
+4.9637263E19
+
+(- -4.2414725E19 1.3904184E-21)
+-4.2414725E19
+
+(- 7.844454E18 -8.659333E-21)
+7.844454E18
+
+(- 1.5733016E19 8.638849E-21)
+1.5733016E19
+
+(- 1.7531192E-21 -0.8690463)
+0.8690463
+
+(- 9.449351E-21 0.7848489)
+-0.7848489
+
+(- 5.5016538E-21 -0.8998171)
+0.8998171
+
+(- -6.977279E-21 -0.9815793)
+0.9815793
+
+(- -7.9253305E-21 -0.21357381)
+0.21357381
+
+(- 4.026555E-21 0.5610563)
+-0.5610563
+
+(- -7.080433E-21 -1.9501078E9)
+1.9501078E9
+
+(- -8.152211E-21 8.164317E9)
+-8.164317E9
+
+(- 2.177096E-21 -8.591886E9)
+8.591886E9
+
+(- 9.387247E-21 3.5730028E9)
+-3.5730028E9
+
+(- -7.589234E-21 -4.9193774E9)
+4.9193774E9
+
+(- 1.5755653E-21 -2.3484498E9)
+2.3484498E9
+
+(- 9.3034425E-21 8.28104E-11)
+-8.28104E-11
+
+(- -6.417297E-21 -8.352926E-11)
+8.352926E-11
+
+(- 8.728735E-21 9.160732E-11)
+-9.160732E-11
+
+(- 3.8984202E-21 6.5116944E-12)
+-6.5116944E-12
+
+(- 6.288995E-21 -5.6701328E-11)
+5.6701328E-11
+
+(- -2.7652023E-22 -1.01428276E-11)
+1.01428276E-11
+
+(- 4.7200214E-21 -3.726995E18)
+3.726995E18
+
+(- -2.2945808E-21 -7.3098524E19)
+7.3098524E19
+
+(- -9.493033E-21 3.4235436E19)
+-3.4235436E19
+
+(- 3.7946773E-21 -5.126768E18)
+5.126768E18
+
+(- -1.2865209E-21 3.5096026E19)
+-3.5096026E19
+
+(- -8.403449E-21 5.704743E18)
+-5.704743E18
+
+(- 2.928304E-21 -5.574477E-21)
+8.502781E-21
+
+(- -9.46122E-21 -3.858943E-21)
+-5.602277E-21
+
+(- 7.296878E-22 1.8123137E-21)
+-1.0826259E-21
+
+(- 5.866651E-21 2.4605584E-21)
+3.4060923E-21
+
+(- -7.633577E-21 9.915102E-21)
+-1.7548679E-20
+
+(- -8.7881085E-24 3.001468E-21)
+-3.0102563E-21
+
+; ---- Test von * ---
+
+(* 0.3098436 0.0057770014)
+0.001789967
+
+(* -0.14583993 -0.028087378)
+0.004096261
+
+(* 0.21399558 0.96054405)
+0.20555218
+
+(* 0.7590452 0.8427266)
+0.6396676
+
+(* -0.34523207 0.20272356)
+-0.06998668
+
+(* -0.98096234 0.98158866)
+-0.96290153
+
+(* 0.40309322 4.0009994E9)
+1.6127757E9
+
+(* 0.15507132 9.481803E9)
+1.4703557E9
+
+(* 0.5218476 -2.1933102E9)
+-1.1445737E9
+
+(* 0.17258328 2.6295781E8)
+4.538212E7
+
+(* 0.25962013 8.699164E9)
+2.258478E9
+
+(* 0.47902477 -1.4075732E9)
+-6.7426246E8
+
+(* 0.9642294 -1.6256952E-11)
+-1.5675431E-11
+
+(* 0.6098744 -8.802921E-12)
+-5.3686764E-12
+
+(* -0.25792134 4.804327E-11)
+-1.2391385E-11
+
+(* -0.8724403 -9.101418E-11)
+7.940444E-11
+
+(* -0.13318628 8.1157005E-11)
+-1.08089995E-11
+
+(* -0.54116476 -9.353639E-11)
+5.0618596E-11
+
+(* 0.9018487 7.411783E19)
+6.6843068E19
+
+(* -0.6835444 -7.590606E19)
+5.188516E19
+
+(* -0.9896146 5.195105E18)
+-5.141152E18
+
+(* -0.4838531 1.88174E19)
+-9.1048573E18
+
+(* -0.31826657 -3.3103586E19)
+1.0535765E19
+
+(* 0.6818549 -9.227651E19)
+-6.2919192E19
+
+(* 0.7676919 7.320194E-21)
+5.6196534E-21
+
+(* 0.49369502 4.9805288E-21)
+2.4588622E-21
+
+(* 0.9599328 7.903804E-21)
+7.58712E-21
+
+(* 0.13215566 7.603894E-21)
+1.0048976E-21
+
+(* -0.35744518 -9.408464E-21)
+3.36301E-21
+
+(* -0.79346496 9.006081E-21)
+-7.146009E-21
+
+(* 4.1775434E9 -0.13509268)
+-5.643555E8
+
+(* 7.27846E9 -0.8181822)
+-5.9551063E9
+
+(* 2.9669427E9 0.7082195)
+2.1012467E9
+
+(* 7.609933E9 -0.33963126)
+-2.5845711E9
+
+(* 3.4241843E9 0.3924479)
+1.3438139E9
+
+(* -3.8366538E9 0.56461394)
+-2.1662282E9
+
+(* 3.7237007E9 1.2646783E9)
+4.7092836E18
+
+(* -2.7657871E9 -3.6314278E9)
+1.0043756E19
+
+(* -4.753982E9 -5.8879616E8)
+2.7991263E18
+
+(* 8.877933E9 7.973602E9)
+7.07891E19
+
+(* -8.312081E9 -8.941637E9)
+7.432361E19
+
+(* -4.297749E9 9.913122E9)
+-4.260411E19
+
+(* -7.893335E9 -4.7961794E-11)
+0.3785785
+
+(* -4.1332334E9 7.221582E-11)
+-0.29848483
+
+(* 1.9981688E9 2.8169871E-11)
+0.056288157
+
+(* -5.8555295E9 -7.562528E-11)
+0.44282603
+
+(* 7.377872E9 -1.5020383E-11)
+-0.11081846
+
+(* 8.891134E9 -7.035395E-11)
+-0.6255264
+
+(* -7.1412096E9 5.1873507E19)
+-3.7043958E29
+
+(* 8.0983844E9 9.136914E19)
+7.399425E29
+
+(* -6.1437537E9 -9.398771E19)
+5.7743737E29
+
+(* -2.3000973E9 6.8743785E19)
+-1.5811739E29
+
+(* 3.5817969E9 -6.0353143E19)
+-2.161727E29
+
+(* 6.544234E9 8.265139E19)
+5.4089003E29
+
+(* 2.1273733E8 -2.3684083E-21)
+-5.0384886E-13
+
+(* -4.2644698E9 2.956708E-21)
+-1.2608792E-11
+
+(* -5.1238026E9 5.341445E-21)
+-2.7368509E-11
+
+(* -3.0125368E9 5.201843E-21)
+-1.5670742E-11
+
+(* -4.4709827E9 -1.5399217E-22)
+6.8849635E-13
+
+(* -4.934225E9 5.9229795E-21)
+-2.9225313E-11
+
+(* -2.1100623E-11 0.9615048)
+-2.028835E-11
+
+(* 6.6090705E-12 0.4100405)
+2.7099865E-12
+
+(* -9.541609E-11 0.82497185)
+-7.871559E-11
+
+(* -2.7884627E-11 -0.5218528)
+1.4551671E-11
+
+(* 9.180904E-13 -0.26436818)
+-2.4271386E-13
+
+(* 2.6154882E-11 0.2004636)
+5.2431015E-12
+
+(* 9.751009E-11 -7.0098227E9)
+-0.6835284
+
+(* -1.312651E-11 1.9450307E8)
+-0.0025531466
+
+(* -4.591856E-11 -4.6141565E8)
+0.021187542
+
+(* -4.1950752E-11 -9.55923E9)
+0.4010169
+
+(* -2.1888996E-11 9.976215E9)
+-0.21836932
+
+(* 4.2696267E-11 -7.927695E9)
+-0.33848298
+
+(* 1.9615304E-11 -5.3584637E-12)
+-1.05107896E-22
+
+(* -8.7289814E-11 3.4389686E-11)
+-3.0018693E-21
+
+(* 6.8621386E-11 -1.4248663E-11)
+-9.77763E-22
+
+(* -9.5643375E-11 -7.7591066E-11)
+7.421071E-21
+
+(* -6.3313584E-11 5.173857E-11)
+-3.2757542E-21
+
+(* -6.968663E-11 -4.966581E-12)
+3.461043E-22
+
+(* 7.942278E-11 -3.1309486E19)
+-2.4866865E9
+
+(* 1.7023414E-11 2.5512804E19)
+4.34315E8
+
+(* 2.6554937E-11 9.146128E19)
+2.4287485E9
+
+(* 9.309172E-13 -3.6298406E19)
+-3.3790812E7
+
+(* -6.106873E-11 3.5271824E18)
+-2.1540056E8
+
+(* -2.8420502E-11 -6.6643682E19)
+1.8940468E9
+
+(* -5.84991E-11 1.5304011E-21)
+-8.952709E-32
+
+(* 6.30787E-11 -9.366236E-21)
+-5.9081004E-31
+
+(* 1.9745445E-11 7.034156E-21)
+1.3889253E-31
+
+(* 2.440728E-11 6.50959E-22)
+1.5888139E-32
+
+(* 6.0243255E-11 -1.7734902E-21)
+-1.0684082E-31
+
+(* 1.0381073E-11 7.167948E-21)
+7.441099E-32
+
+(* 6.3378214E18 0.022634745)
+1.43454966E17
+
+(* 5.4942345E19 0.26696533)
+1.4667702E19
+
+(* 9.807893E19 -0.99720424)
+-9.780473E19
+
+(* -7.1504E18 0.045440495)
+-3.249177E17
+
+(* -7.265508E19 0.37276286)
+-2.7083115E19
+
+(* 9.3705245E19 0.6617385)
+6.200837E19
+
+(* 7.768628E19 1.37205E9)
+1.0658947E29
+
+(* 1.5640021E18 9.344063E9)
+1.4614135E28
+
+(* 3.8593804E19 -9.424651E8)
+-3.6373312E28
+
+(* -9.23689E19 -6.980498E9)
+6.447809E29
+
+(* 7.926599E19 5.0871127E9)
+4.0323505E29
+
+(* 3.540541E19 -5.11486E9)
+-1.810937E29
+
+(* -7.023858E19 6.959093E-11)
+-4.8879683E9
+
+(* -2.0809586E19 -4.045683E-12)
+8.418899E7
+
+(* 5.3608545E19 -7.0354486E-11)
+-3.7716017E9
+
+(* 8.974303E19 -6.383404E-11)
+-5.72866E9
+
+(* -6.8900017E19 9.845904E-11)
+-6.7838295E9
+
+(* 9.325442E19 -3.9829796E-11)
+-3.7143045E9
+
+(* 5.9436735E19 -5.713992E-21)
+-0.33962104
+
+(* 7.266224E18 8.9780915E-21)
+0.06523682
+
+(* -3.6717237E18 3.3338123E-21)
+-0.012240837
+
+(* 4.119367E19 -7.309974E-21)
+-0.30112466
+
+(* -8.453134E19 4.6281215E-22)
+-0.03912213
+
+(* -3.7493624E19 5.480264E-21)
+-0.20547494
+
+(* 6.3693945E-21 -0.25352144)
+-1.6147781E-21
+
+(* -8.51531E-21 0.6031129)
+-5.135693E-21
+
+(* -9.771993E-21 0.2740926)
+-2.678431E-21
+
+(* -4.2903415E-21 0.5916119)
+-2.5382172E-21
+
+(* -3.7330673E-21 0.9738175)
+-3.6353263E-21
+
+(* 5.860415E-21 -0.9997709)
+-5.8590725E-21
+
+(* -9.4827234E-21 7.6195564E9)
+-7.225415E-11
+
+(* 5.9501194E-21 9.102942E9)
+5.4163594E-11
+
+(* 2.8867428E-21 -9.615872E9)
+-2.7758549E-11
+
+(* 5.0077543E-21 7.8715663E9)
+3.941887E-11
+
+(* 7.082003E-21 4.5221494E9)
+3.2025875E-11
+
+(* -2.9215627E-21 5.131017E9)
+-1.4990589E-11
+
+(* -9.1914904E-21 -2.3301847E-11)
+2.141787E-31
+
+(* 1.3389891E-21 -7.032628E-11)
+-9.4166125E-32
+
+(* -8.540776E-21 3.052019E-11)
+-2.6066613E-31
+
+(* -2.7608417E-21 -6.8345785E-12)
+1.886919E-32
+
+(* 1.2978333E-21 -2.1870255E-12)
+-2.8383944E-33
+
+(* 8.2235335E-23 -3.5080876E-11)
+-2.8848876E-33
+
+(* -3.958064E-21 8.038726E19)
+-0.3181779
+
+(* 7.752178E-21 1.0747784E19)
+0.08331874
+
+(* -5.5964265E-21 -8.700492E19)
+0.48691663
+
+(* 3.2236927E-21 3.6203593E19)
+0.116709255
+
+(* -6.308517E-21 -3.8032156E19)
+0.2399265
+
+(* 4.8663387E-21 9.008218E19)
+0.43837038
+
+; ---- Test von FLOOR ---
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.8227301 -0.25283414))
+(3 -0.06422769)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.6686161 0.4833234))
+(-2 0.29803064)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.57436657 0.52642506))
+(-2 0.47848356)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.60395426 -0.61624163))
+(-1 -0.012287392)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.21636301 0.90365344))
+(-1 0.68729043)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.8705054 -0.7953333))
+(-2 -0.72016126)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.4544462 -9.890925E9))
+(-1 -9.890925E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.4954149 -3.8786918E9))
+(0 -0.49541488)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.692049 6.4791506E9))
+(-1 6.4791506E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.75464755 -3.618496E9))
+(-1 -3.618496E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.5929247 -5.442471E9))
+(0 -0.5929247)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.30383867 9.262864E9))
+(-1 9.262864E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.9345329 3.26737E-11))
+(28601991168 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.3772617 -7.991702E-11))
+(-4720667648 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.74438447 -1.0977978E-11))
+(-67807064064 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.9220973 -1.2655998E-11))
+(72858525696 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.4615329 6.48833E-11))
+(-7113276928 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.2851941 -8.262349E-11))
+(-3451731456 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.61539984 3.5826177E19))
+(0 0.61539984)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.8195054 8.793426E19))
+(-1 8.793426E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.26412165 7.015103E18))
+(-1 7.015103E18)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.527393 8.434833E19))
+(-1 8.434833E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.1846056 1.8252128E19))
+(-1 1.8252128E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.6079822 6.106683E19))
+(-1 6.106683E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.5564819 5.953872E-21))
+(93465542827563810816 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.52575815 -1.8358678E-21))
+(286381261476583178240 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.6321403 -5.830945E-21))
+(108411292344853200896 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.9675891 -9.936226E-21))
+(97379936163841703936 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.63503754 -5.0137436E-21))
+(126659359065470140416 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.8053654 -3.4055888E-22))
+(-2364834534832713236480 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.784645E9 0.9775517))
+(8986374144 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.314413E9 -0.8318871))
+(11196726272 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.4695936E9 -0.9823455))
+(-8621807616 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.8406625E9 -0.031723082))
+(184113971200 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.325545E9 0.93169844))
+(-7862571008 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.2999526E9 0.11515945))
+(-46022733824 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.680458E9 7.170729E9))
+(0 6.680458E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.2146278E9 5.2909993E9))
+(-1 3.0763715E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.4947005E9 3.1265188E9))
+(2 2.4166298E8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.947109E9 2.464481E9))
+(3 5.53666E8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.899791E9 3.5788132E9))
+(2 1.7421644E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.272568E9 -5.3260964E9))
+(-1 -5.3528532E7)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.729838E8 8.6379175E-11))
+(11264101901890748416 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.210882E9 -4.412428E-11))
+(-27442532596777484288 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.169561E9 -9.41537E-11))
+(-97389277614631288832 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.289745E9 3.1269442E-11))
+(297087021478284623872 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.334722E9 2.0158666E-11))
+(-264636651022615314432 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.910798E9 -2.985589E-11))
+(-331954558296456691712 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.7169357E9 2.220112E19))
+(-1 2.220112E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.9906683E9 6.857979E19))
+(0 4.9906683E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.90463E9 -2.342953E19))
+(0 -9.90463E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.4878054E8 5.438576E19))
+(-1 5.438576E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.1080986E9 9.25119E19))
+(-1 9.25119E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.4138286E9 -9.682224E19))
+(0 -8.4138286E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.7084977E9 2.542436E-23))
+(106531597407755826831748572905472 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.720767E9 9.438407E-21))
+(-606115738076318963177881600000 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.4958034E9 9.250327E-21))
+(-377911344579488968728001904640 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.3702047E9 6.0186186E-21))
+(-1390718493086361392338557730816 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.517619E9 -9.417701E-21))
+(798243593937800371539149848576 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.1220838E9 3.931208E-21))
+(-539804494597454582830132625408 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.9606828E-11 0.34267086))
+(-1 0.34267086)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.495503E-11 -0.4518087))
+(-1 -0.4518087)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.98698E-11 -0.5665642))
+(0 -7.98698E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.1465689E-11 0.17276591))
+(0 2.146569E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.9463066E-11 -0.5659616))
+(-1 -0.5659616)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.8961567E-11 -0.7758364))
+(0 -1.8961567E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.8871874E-11 -5.768549E9))
+(-1 -5.768549E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.079439E-11 -3.807195E9))
+(0 -9.079439E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.879919E-12 -1.9198149E9))
+(-1 -1.9198149E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.389072E-11 -8.657572E9))
+(-1 -8.657572E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.430157E-11 -3.8599355E9))
+(-1 -3.8599355E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.8839114E-11 -5.3409536E9))
+(0 -5.8839114E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.3353615E-11 8.9096924E-11))
+(-1 5.574331E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.335122E-11 3.606541E-11))
+(1 2.7285809E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.6885465E-11 7.070333E-12))
+(-9 6.7475353E-12)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.581576E-11 -3.4334775E-11))
+(2 -7.1462155E-12)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.6686505E-11 -1.9221425E-11))
+(-2 -1.7563462E-12)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.066395E-11 -2.3198866E-11))
+(-2 -1.573378E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.1089344E-11 7.429058E19))
+(0 9.1089344E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.2265194E-11 -6.5831596E19))
+(0 -7.2265194E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.9087675E-11 1.9182038E19))
+(-1 1.9182038E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.907188E-11 4.405831E19))
+(-1 4.405831E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.118759E-11 3.4342181E19))
+(0 6.118759E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.4731882E-11 -5.861447E19))
+(-1 -5.861447E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.121101E-11 -1.8234462E-21))
+(-33568860160 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.788758E-11 -2.65478E-21))
+(-36872200192 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.827001E-11 -8.5754775E-21))
+(-9127189504 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.738018E-11 -7.810784E-21))
+(4785714176 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.31308E-11 -2.0431058E-21))
+(-35793936384 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.4578095E-11 -3.0466443E-21))
+(-31043366912 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.8186137E19 -0.95250696))
+(50588749896299315200 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.548003E18 -0.9061317))
+(-10537102614582001664 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.5254813E19 0.51959753))
+(106341562860634636288 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.2787504E19 0.14769173))
+(-289708190148186865664 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.27109E17 -0.03677529))
+(11614021477430460416 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.9238043E19 0.26663417))
+(-147160597790283792384 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.0174873E19 -6.7035556E7))
+(300957794304 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.6296811E19 -7.2014956E9))
+(-2262976000 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.794499E19 -7.412829E9))
+(-10514876416 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.2546485E19 6.1565005E9))
+(-2037924864 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.4549757E18 -4.778849E9))
+(-1141483264 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.9214324E18 3.0002557E9))
+(-2973557248 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.790958E19 -8.224902E-11))
+(-1068822197453670185020302557184 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.029222E18 1.3127345E-11))
+(687817816164697187548814901248 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.7356843E19 -9.1816894E-11))
+(-733599685837775742566290948096 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.0346153E19 2.0593792E-11))
+(1959141510822234462049892564992 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.3402778E19 -4.8733902E-11))
+(-275019611403690085233016700928 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.3005549E19 5.6579824E-11))
+(-229861963021783171398467846144 0.0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.550302E19 6.4624324E19))
+(1 2.0878699E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.7897585E19 -1.5724218E19))
+(-4 -1.4999288E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.6050445E19 1.4007867E19))
+(-7 1.2004627E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.0799387E19 -5.667626E19))
+(1 -4.1231221E18)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.847746E19 -3.972193E19))
+(1 -3.875553E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.425414E19 3.0601436E19))
+(-3 2.7550168E19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.8220074E-21 -0.9401483))
+(-1 -0.9401483)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.867747E-21 0.86288685))
+(0 9.867747E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.2856053E-21 -0.5235996))
+(-1 -0.5235996)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.709991E-22 0.42678982))
+(0 8.709991E-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.0493481E-21 0.9355661))
+(0 1.0493481E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.137466E-21 0.4328317))
+(-1 0.4328317)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.5872774E-21 -8.80464E9))
+(-1 -8.80464E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.0479629E-22 -9.353607E9))
+(0 -1.0479629E-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.636932E-21 9.794678E9))
+(-1 9.794678E9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.912024E-21 -2.9102356E9))
+(0 -7.912024E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.0071349E-21 8.762459E9))
+(0 1.0071349E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.795979E-21 -9.445545E9))
+(0 -6.795979E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.0598967E-22 -3.961637E-11))
+(-1 -3.961637E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.481348E-21 -7.485006E-11))
+(-1 -7.485006E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.610974E-21 -4.073898E-11))
+(0 -5.610974E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.2362584E-21 8.403202E-11))
+(-1 8.403202E-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.2029927E-21 7.823452E-11))
+(0 4.2029927E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.765272E-21 -8.502908E-11))
+(0 -7.765272E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.7845436E-21 3.490416E-21))
+(0 2.7845436E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.4630091E-21 9.193901E-21))
+(-1 7.730892E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.1823826E-21 8.941324E-21))
+(-1 7.5894165E-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.8218875E-21 3.8057304E-21))
+(-1 1.9838427E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.8037763E-21 -5.1721612E-21))
+(-2 -4.5405462E-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.179982E-21 6.2204556E-21))
+(-2 4.2609293E-21)
+
+; ---- Test von / ---
+
+(/ 0.73739415 0.6416277)
+1.1492554
+
+(/ 0.6736158 -0.25522494)
+-2.6393025
+
+(/ -0.44216943 0.31134832)
+-1.420176
+
+(/ -0.7041118 -0.26929635)
+2.6146355
+
+(/ 0.3573562 0.73521775)
+0.4860549
+
+(/ -0.7661392 0.77110463)
+-0.9935606
+
+(/ -0.91306114 1.6586358E9)
+-5.504892E-10
+
+(/ -0.68994707 4.0230333E8)
+-1.7149921E-9
+
+(/ 0.28498656 -7.617844E9)
+-3.7410394E-11
+
+(/ -0.72419757 -9.226896E9)
+7.848767E-11
+
+(/ 0.8352187 8.3102536E9)
+1.00504605E-10
+
+(/ 0.9707725 3.3669448E9)
+2.8832445E-10
+
+(/ 0.50785017 6.048824E-11)
+8.3958497E9
+
+(/ -0.17675805 4.1391092E-11)
+-4.270437E9
+
+(/ -0.42162335 -4.4007357E-11)
+9.580747E9
+
+(/ -7.945299E-4 -5.4965265E-11)
+1.4455128E7
+
+(/ -0.65178335 -9.78151E-12)
+6.6634228E10
+
+(/ -0.6209788 -3.8544803E-11)
+1.611057E10
+
+(/ 0.94332725 -4.9823833E19)
+-1.8933253E-20
+
+(/ 0.30150706 -4.9741757E19)
+-6.061448E-21
+
+(/ -0.8478371 -9.85865E18)
+8.5999306E-20
+
+(/ -0.28524554 3.1389898E19)
+-9.087176E-21
+
+(/ -0.5260848 -7.936286E19)
+6.6288534E-21
+
+(/ -0.12941593 -5.3575864E19)
+2.415564E-21
+
+(/ -0.20859545 -9.867267E-21)
+2.1140145E19
+
+(/ 0.35158414 -8.2825064E-22)
+-4.2449002E20
+
+(/ -0.05635804 -2.2999601E-21)
+2.450392E19
+
+(/ -0.003138721 -3.3988403E-21)
+9.234682E17
+
+(/ -0.91386896 -5.8199337E-21)
+1.5702395E20
+
+(/ -0.5374476 2.256708E-21)
+-2.3815556E20
+
+(/ 1.9669795E9 -0.58137333)
+-3.3833329E9
+
+(/ -8.9879334E8 0.35829848)
+-2.5085046E9
+
+(/ -9.057627E9 0.4849478)
+-1.867753E10
+
+(/ 3.687799E8 -0.34055912)
+-1.082866E9
+
+(/ -5.1049994E9 -0.16858816)
+3.0280888E10
+
+(/ -4.512774E9 0.9385354)
+-4.8083154E9
+
+(/ -1.9312024E9 -8.3940613E9)
+0.2300677
+
+(/ -8.2104387E9 6.769607E9)
+-1.2128383
+
+(/ -6.9613486E9 4.576518E9)
+-1.5211015
+
+(/ -1.486333E9 1.2476433E9)
+-1.1913126
+
+(/ -7.653413E9 5.167656E9)
+-1.4810221
+
+(/ -2.9815204E9 8.942396E9)
+-0.33341402
+
+(/ 9.304549E9 -5.8002263E-11)
+-1.60417E20
+
+(/ -2.0750719E9 1.272735E-11)
+-1.6304037E20
+
+(/ -1.1557549E9 -7.2220556E-11)
+1.6003129E19
+
+(/ -3.3273495E9 -9.9207274E-11)
+3.353937E19
+
+(/ -3.2167434E9 7.7474506E-11)
+-4.1520026E19
+
+(/ 4.4169416E9 -4.638272E-11)
+-9.5228166E19
+
+(/ -3.732909E9 -2.2763849E18)
+1.6398409E-9
+
+(/ -6.243126E9 -4.1274483E19)
+1.5125873E-10
+
+(/ 4.7162563E9 -7.524631E19)
+-6.267758E-11
+
+(/ -1.3657349E9 7.728982E19)
+-1.7670308E-11
+
+(/ -4.6216906E8 -7.972877E19)
+5.7967663E-12
+
+(/ 4.4542986E9 3.1531836E19)
+1.4126353E-10
+
+(/ 1.4738977E9 -9.8130876E-21)
+-1.5019714E29
+
+(/ -5.918336E9 2.9877495E-21)
+-1.9808676E30
+
+(/ -3.7166292E9 -1.0826009E-21)
+3.433056E30
+
+(/ 7.390683E9 -2.1678685E-22)
+-3.4091935E31
+
+(/ 6.2302886E8 8.9466635E-21)
+6.963812E28
+
+(/ 5.2357125E9 4.854464E-22)
+1.0785356E31
+
+(/ -2.7721167E-11 0.99550104)
+-2.7846447E-11
+
+(/ 5.754337E-11 -0.6344538)
+-9.06975E-11
+
+(/ -7.663363E-11 0.020810604)
+-3.6824317E-9
+
+(/ 3.2576632E-11 0.6209498)
+5.2462586E-11
+
+(/ -9.507874E-11 -0.19174337)
+4.958645E-10
+
+(/ -9.681176E-11 -0.82680905)
+1.1709084E-10
+
+(/ 6.458532E-11 3.442031E8)
+1.8763725E-19
+
+(/ 1.9113166E-11 -7.0712125E9)
+-2.7029546E-21
+
+(/ -2.0099402E-12 2.600844E9)
+-7.7280303E-22
+
+(/ -4.9634992E-12 8.041176E9)
+-6.1726036E-22
+
+(/ 3.2738747E-12 7.299675E9)
+4.484959E-22
+
+(/ 9.133733E-12 -2.6318538E9)
+-3.470456E-21
+
+(/ -3.4146054E-11 -1.5331155E-11)
+2.227233
+
+(/ 6.06336E-11 4.3750472E-11)
+1.385896
+
+(/ -4.229064E-11 -9.169808E-11)
+0.4611944
+
+(/ 6.166104E-11 -3.5474658E-11)
+-1.7381715
+
+(/ -3.979801E-11 -1.9510412E-11)
+2.0398343
+
+(/ 9.726933E-11 -5.6926824E-11)
+-1.7086731
+
+(/ 8.041786E-11 2.3718388E19)
+3.3905282E-30
+
+(/ -6.747094E-11 -6.7324465E19)
+1.0021756E-30
+
+(/ -3.0713255E-11 -4.8310887E19)
+6.357419E-31
+
+(/ -2.8496396E-11 -4.9017306E19)
+5.813538E-31
+
+(/ -9.354275E-12 -9.035095E19)
+1.0353266E-31
+
+(/ 4.9274265E-12 7.241873E19)
+6.8040775E-32
+
+(/ -4.377009E-11 7.138917E-21)
+-6.131195E9
+
+(/ 9.422678E-12 -5.8862136E-21)
+-1.6008046E9
+
+(/ -6.83782E-11 -3.6098812E-21)
+1.8941952E10
+
+(/ -8.1755075E-11 -6.8725736E-21)
+1.1895846E10
+
+(/ -6.360949E-11 4.2976342E-21)
+-1.4801049E10
+
+(/ 3.3879413E-11 -1.7169743E-21)
+-1.9732044E10
+
+(/ -9.948093E18 -0.8695114)
+1.1441014E19
+
+(/ 6.2748975E19 -0.94829553)
+-6.6170272E19
+
+(/ -6.204444E18 0.6874813)
+-9.0248915E18
+
+(/ 6.7599936E19 -0.45808762)
+-1.4756988E20
+
+(/ 7.624068E19 0.008471012)
+9.0001855E21
+
+(/ 8.342225E19 -0.3031574)
+-2.7517803E20
+
+(/ -6.3366795E19 -1.4882481E9)
+4.2578113E10
+
+(/ -1.7335874E19 -7.42875E9)
+2.3336195E9
+
+(/ -8.662651E19 1.0327226E9)
+-8.388168E10
+
+(/ -4.9590965E19 8.334462E9)
+-5.95011E9
+
+(/ 8.191562E18 5.930472E9)
+1.3812664E9
+
+(/ -3.5910857E19 -7.342098E9)
+4.8910894E9
+
+(/ -3.6083056E19 5.7372277E-11)
+-6.2892843E29
+
+(/ 2.2896613E19 -4.541202E-11)
+-5.0419717E29
+
+(/ 6.1438805E19 8.512014E-11)
+7.217893E29
+
+(/ 6.3211746E19 -6.185377E-12)
+-1.0219547E31
+
+(/ 4.5452835E18 2.0429606E-11)
+2.2248514E29
+
+(/ 9.226608E19 1.3297486E-11)
+6.9386104E30
+
+(/ 1.8852943E19 -1.623413E19)
+-1.1613153
+
+(/ -3.117305E18 -9.5760065E19)
+0.03255329
+
+(/ -7.719376E19 3.3627052E19)
+-2.295585
+
+(/ 3.1309093E19 -7.820006E19)
+-0.4003717
+
+(/ 3.941958E19 -9.51598E19)
+-0.41424614
+
+(/ -3.6364467E19 -1.0757047E19)
+3.380525
+
+(/ 2.906561E17 -8.595159E-21)
+-3.3816258E37
+
+(/ -7.826226E-21 -0.21695328)
+3.6073327E-20
+
+(/ -1.888169E-21 0.5031878)
+-3.7524144E-21
+
+(/ 8.304594E-21 -0.3528648)
+-2.3534775E-20
+
+(/ -8.441606E-21 -0.3639353)
+2.3195348E-20
+
+(/ -7.815205E-21 0.38263506)
+-2.0424697E-20
+
+(/ -3.2837188E-21 0.46961308)
+-6.992392E-21
+
+(/ -5.1739832E-21 -3.8917279E9)
+1.3294822E-30
+
+(/ -5.3318596E-21 -7.1995423E9)
+7.405831E-31
+
+(/ -7.4979364E-22 9.148773E9)
+-8.195565E-32
+
+(/ 4.6800053E-21 3.9532006E8)
+1.1838522E-29
+
+(/ 4.914653E-22 -2.414465E9)
+-2.035504E-31
+
+(/ 5.4722133E-21 -9.977777E9)
+-5.484401E-31
+
+(/ 9.815656E-21 6.059642E-11)
+1.619841E-10
+
+(/ 7.660357E-21 9.7074675E-11)
+7.891201E-11
+
+(/ 9.77743E-21 2.5170428E-11)
+3.8844908E-10
+
+(/ 8.818017E-21 1.18070545E-11)
+7.468431E-10
+
+(/ 5.445426E-21 9.6208916E-11)
+5.6600016E-11
+
+(/ 4.6823916E-21 -1.9853067E-11)
+-2.358523E-10
+
+(/ 9.347429E-21 -7.285392E-22)
+-12.830372
+
+(/ -7.304412E-21 6.766496E-21)
+-1.079497
+
+(/ -2.6850204E-21 6.894023E-21)
+-0.38947076
+
+(/ -2.24644E-21 -9.533858E-21)
+0.23562758
+
+(/ -8.525939E-21 -9.961187E-22)
+8.559159
+
+(/ 8.145676E-21 4.304153E-22)
+18.925154
+
+;; ==== D O U B L E - F L O A T S ====
+
+; ---- Test von + ---
+
+(+ 0.6049332056786565d0 -0.9611373574853808d0)
+-0.35620415180672427d0
+
+(+ -0.4763715667865308d0 0.25936932107685584d0)
+-0.21700224570967497d0
+
+(+ 0.2666481927718355d0 -0.04984768063142031d0)
+0.21680051214041518d0
+
+(+ -0.29478659758474846d0 0.3371004337672615d0)
+0.042313836182513054d0
+
+(+ 0.8203063910979178d0 0.28968607542857916d0)
+1.109992466526497d0
+
+(+ -0.08207985138263585d0 0.4368723951711785d0)
+0.35479254378854264d0
+
+(+ -0.8659875373355486d0 -6.631430771196765d9)
+-6.631430772062753d9
+
+(+ 0.15071385783307878d0 -7.154424279496395d9)
+-7.154424279345681d9
+
+(+ -0.8969642760814789d0 -2.4070067380831727d8)
+-2.4070067470528156d8
+
+(+ -0.9610362081435054d0 9.070410778399954d9)
+9.070410777438917d9
+
+(+ 0.5129052501104072d0 -7.47841120327471d9)
+-7.478411202761805d9
+
+(+ 0.3840242289740675d0 7.793048210060242d9)
+7.793048210444266d9
+
+(+ 0.07603066126204616d0 5.215008470388369d-11)
+0.07603066131419625d0
+
+(+ -0.17187858025312586d0 -5.116645189173968d-11)
+-0.17187858030429232d0
+
+(+ 0.2521315816245864d0 8.603210607505339d-11)
+0.2521315817106185d0
+
+(+ -0.3557185853193914d0 -2.0371324697272998d-11)
+-0.3557185853397627d0
+
+(+ 0.7142792289542045d0 -7.106356053331326d-11)
+0.7142792288831409d0
+
+(+ 0.4380415886629452d0 -3.069969538383403d-11)
+0.43804158863224546d0
+
+(+ 0.24798614227178573d0 3.972393639614975d19)
+3.972393639614975d19
+
+(+ -0.5210677288128815d0 4.846393336901129d19)
+4.846393336901129d19
+
+(+ 0.5825404819115d0 1.9710987361264255d19)
+1.9710987361264255d19
+
+(+ 0.9105175208730549d0 2.391166552096775d19)
+2.391166552096775d19
+
+(+ 0.48414423368371695d0 -9.696117779740095d19)
+-9.696117779740095d19
+
+(+ 0.25780758450697716d0 6.094683117025535d19)
+6.094683117025535d19
+
+(+ 0.9824539149570484d0 -5.4680066990812835d-21)
+0.9824539149570484d0
+
+(+ -0.9520982941158654d0 3.2513564801568073d-21)
+-0.9520982941158654d0
+
+(+ 0.0630170624560149d0 -9.858852595793203d-21)
+0.0630170624560149d0
+
+(+ 0.24705141169888878d0 1.4582081178692862d-22)
+0.24705141169888878d0
+
+(+ 0.7440948700757135d0 -3.0932442581890818d-21)
+0.7440948700757135d0
+
+(+ -0.5055970869515372d0 4.0277457257516025d-21)
+-0.5055970869515372d0
+
+(+ 1.672355787134947d9 0.0064909681594120805d0)
+1.672355787141438d9
+
+(+ -9.694504381396599d9 -0.8925470085542831d0)
+-9.694504382289146d9
+
+(+ -1.6695005924298635d9 -0.34426964741306d0)
+-1.6695005927741332d9
+
+(+ -6.085591212594774d9 0.5107956920100049d0)
+-6.085591212083979d9
+
+(+ 7.457486660952688d9 -0.4323787588338597d0)
+7.457486660520309d9
+
+(+ -8.790796444526546d9 0.911415263281967d0)
+-8.790796443615131d9
+
+(+ 9.667548804251982d9 -1.266547751029956d8)
+9.540894029148987d9
+
+(+ -6.169561898845145d9 9.627911197121864d9)
+3.458349298276719d9
+
+(+ -9.870287253215279d9 9.004242781937655d8)
+-8.969862975021513d9
+
+(+ -8.175630881172554d9 -4.08632236263908d9)
+-1.2261953243811634d10
+
+(+ 2.9069444232153206d9 -7.961831315741894d9)
+-5.054886892526573d9
+
+(+ -7.003647401371184d9 -1.768371514817526d9)
+-8.772018916188711d9
+
+(+ -6.418847599138249d9 2.755257250162372d-11)
+-6.418847599138249d9
+
+(+ 2.3093152687241793d9 1.2205440142364766d-11)
+2.3093152687241793d9
+
+(+ 8.634577667577518d9 -9.065714034538668d-11)
+8.634577667577518d9
+
+(+ 1.711283212591781d9 -3.235019197733951d-11)
+1.711283212591781d9
+
+(+ 2.583886638357791d9 -8.199109798920928d-11)
+2.583886638357791d9
+
+(+ -7.517123950474774d9 5.2057802142431697d-11)
+-7.517123950474774d9
+
+(+ 3.266571938086574d9 -4.4782768261898355d19)
+-4.478276825863179d19
+
+(+ 2.1000389219899452d9 -8.547158903365463d19)
+-8.54715890315546d19
+
+(+ -3.9140926801217155d9 7.387959860641422d19)
+7.387959860250013d19
+
+(+ -7.087607465790431d9 7.96875093387599d19)
+7.96875093316723d19
+
+(+ -8.341000808926519d9 6.9360028397637304d19)
+6.93600283892963d19
+
+(+ -5.507940634743809d9 9.760028858210094d19)
+9.7600288576593d19
+
+(+ 8.492522971238823d9 -2.8253881864964467d-22)
+8.492522971238823d9
+
+(+ 1.2731765723336241d9 -5.8473937102910264d-21)
+1.2731765723336241d9
+
+(+ 9.654280758878323d9 -4.2332114049658973d-22)
+9.654280758878323d9
+
+(+ -6.864618926120946d9 -1.245648314796599d-21)
+-6.864618926120946d9
+
+(+ -3.9916044043798673d8 1.697737588450543d-21)
+-3.9916044043798673d8
+
+(+ -7.818041624198686d9 4.635421587404246d-21)
+-7.818041624198686d9
+
+(+ 2.0609929543990767d-12 -0.2126306554359736d0)
+-0.2126306554339126d0
+
+(+ -1.5923091695877845d-11 0.515731533720818d0)
+0.515731533704895d0
+
+(+ 4.794527092905871d-11 -0.9066947202676092d0)
+-0.9066947202196639d0
+
+(+ -8.63854477728633d-11 0.3122982022565777d0)
+0.3122982021701922d0
+
+(+ -7.577966666552416d-11 -0.24137602092437593d0)
+-0.2413760210001556d0
+
+(+ -4.971730475882754d-11 -0.8202688719750202d0)
+-0.8202688720247375d0
+
+(+ -5.249369194379291d-11 -8.546120620321186d9)
+-8.546120620321186d9
+
+(+ 8.280786962526793d-11 5.758373397436368d9)
+5.758373397436368d9
+
+(+ 6.370323595535815d-11 -8.470663335712393d9)
+-8.470663335712393d9
+
+(+ 3.59771226839467d-11 3.5042505440266216d8)
+3.5042505440266216d8
+
+(+ -3.945501687396375d-11 -5.082779978069177d9)
+-5.082779978069177d9
+
+(+ 9.780590963267516d-11 -5.05591945120475d9)
+-5.05591945120475d9
+
+(+ 6.323293597096768d-11 -7.208898910487284d-11)
+-8.85605313390516d-12
+
+(+ -4.549781732354749d-11 -6.095452636416357d-11)
+-1.0645234368771105d-10
+
+(+ -5.372680267837374d-11 2.0748354219485134d-11)
+-3.297844845888861d-11
+
+(+ 3.550879553916665d-11 -4.374873254056574d-11)
+-8.23993700139909d-12
+
+(+ -6.746002242414832d-11 3.0803985031459436d-11)
+-3.665603739268888d-11
+
+(+ -7.902512161494214d-11 -8.907842858073236d-11)
+-1.681035501956745d-10
+
+(+ -4.1465935469350415d-11 6.244210696961323d19)
+6.244210696961323d19
+
+(+ 4.921297536286578d-11 -1.694436650099881d19)
+-1.694436650099881d19
+
+(+ -7.879478980672654d-11 6.41757969360492d19)
+6.41757969360492d19
+
+(+ -8.200749317872953d-11 -9.490225542618815d19)
+-9.490225542618815d19
+
+(+ -7.572981329795812d-11 -3.350367078181029d19)
+-3.350367078181029d19
+
+(+ -5.955255565125549d-11 -5.009913629288125d19)
+-5.009913629288125d19
+
+(+ -9.818180775332558d-11 -7.926156011681593d-21)
+-9.818180776125174d-11
+
+(+ -5.2466438379505935d-12 8.468830229031857d-21)
+-5.246643829481763d-12
+
+(+ 3.582774358441715d-11 3.6865211729351863d-22)
+3.58277435847858d-11
+
+(+ 7.169296413565744d-11 -9.974881413980864d-21)
+7.169296412568256d-11
+
+(+ -9.615073655516977d-11 4.9552491300097786d-21)
+-9.615073655021452d-11
+
+(+ 6.7696956269187d-11 4.1431488006404866d-21)
+6.769695627333016d-11
+
+(+ -4.663397365185298d19 0.9758464195927673d0)
+-4.663397365185298d19
+
+(+ -4.77977261393851d19 0.04145189313162445d0)
+-4.77977261393851d19
+
+(+ 7.195364554121596d19 0.5169917736820715d0)
+7.195364554121596d19
+
+(+ -7.766254779507882d19 0.5919134938460356d0)
+-7.766254779507882d19
+
+(+ -8.411122653901408d19 -0.14463225181516137d0)
+-8.411122653901408d19
+
+(+ -9.101920591747218d19 0.23349918704239836d0)
+-9.101920591747218d19
+
+(+ 7.037477746142529d18 -3.250947575909365d9)
+7.037477742891581d18
+
+(+ -6.864341752972099d19 -4.0510449339565725d9)
+-6.864341753377203d19
+
+(+ -5.329540273290228d19 8.14869777458878d9)
+-5.329540272475358d19
+
+(+ -9.726234388247201d19 2.053976989398215d9)
+-9.726234388041803d19
+
+(+ -1.910324088450308d19 6.247052535748024d9)
+-1.910324087825603d19
+
+(+ -6.079933001949367d18 6.316829148809886d9)
+-6.079932995632539d18
+
+(+ -4.499107911798452d19 9.659763881732633d-11)
+-4.499107911798452d19
+
+(+ -3.0972208018542522d19 -9.077209886078653d-11)
+-3.0972208018542522d19
+
+(+ -2.3000547840875442d19 -3.2043634522621155d-11)
+-2.3000547840875442d19
+
+(+ 2.124555308489292d19 2.252166800652451d-11)
+2.124555308489292d19
+
+(+ -7.74280238703686d19 1.7289553748884322d-11)
+-7.74280238703686d19
+
+(+ -8.119446783121816d19 -4.3461802389685114d-11)
+-8.119446783121816d19
+
+(+ -4.70848534032654d18 -4.698316648967506d19)
+-5.169165183000161d19
+
+(+ 2.853799842810312d19 -5.56805968603395d19)
+-2.7142598432236384d19
+
+(+ -2.9128622996090335d19 -5.153369106520702d19)
+-8.066231406129735d19
+
+(+ -5.415993984772977d19 4.481932558278175d19)
+-9.340614264948015d18
+
+(+ -1.4652301908531261d19 7.89284449966826d19)
+6.427614308815133d19
+
+(+ -8.241911630479252d19 5.377001886877124d19)
+-2.8649097436021277d19
+
+(+ -6.923631123395076d19 7.100129853298664d-22)
+-6.923631123395076d19
+
+(+ -5.864213410820717d19 -2.649878514627326d-21)
+-5.864213410820717d19
+
+(+ 8.660575002861176d19 2.751926085897399d-21)
+8.660575002861176d19
+
+(+ -3.0252871646631318d19 6.852831573716124d-21)
+-3.0252871646631318d19
+
+(+ -9.155476807340938d19 -5.552907466957205d-21)
+-9.155476807340938d19
+
+(+ -4.03382621358461d19 6.670808279457885d-21)
+-4.03382621358461d19
+
+(+ 8.842980509187577d-21 0.5028466982188534d0)
+0.5028466982188534d0
+
+(+ 1.7292043381396136d-21 0.19490424064972922d0)
+0.19490424064972922d0
+
+(+ -5.854820918836103d-21 -0.6700030154364615d0)
+-0.6700030154364615d0
+
+(+ -2.152396491682048d-21 0.5002930268902921d0)
+0.5002930268902921d0
+
+(+ -1.0897149666610629d-21 0.16555534170490604d0)
+0.16555534170490604d0
+
+(+ 6.321421497987867d-24 -0.08008112131564671d0)
+-0.08008112131564671d0
+
+(+ -6.1552667309563055d-21 7.235074489769488d9)
+7.235074489769488d9
+
+(+ -2.2311335001219955d-22 1.220011008333989d9)
+1.220011008333989d9
+
+(+ 8.523565724937177d-23 -4.1650242034123087d9)
+-4.1650242034123087d9
+
+(+ -2.4400041303825447d-21 4.435554678685388d9)
+4.435554678685388d9
+
+(+ -3.4479065449345757d-22 8.491084033112451d8)
+8.491084033112451d8
+
+(+ -7.919939059912893d-21 -7.610637842585286d9)
+-7.610637842585286d9
+
+(+ 4.4958602369105625d-21 5.758376768873417d-11)
+5.7583767693230034d-11
+
+(+ 2.4375297386412195d-21 9.417086717671841d-11)
+9.417086717915595d-11
+
+(+ 1.0040647133383462d-21 3.4701016271268983d-12)
+3.470101628130963d-12
+
+(+ -3.885093055726793d-21 -8.523534862249969d-11)
+-8.523534862638479d-11
+
+(+ 1.027951323422187d-21 -7.65508060829868d-11)
+-7.655080608195885d-11
+
+(+ -9.83813940552434d-21 -5.048380063082019d-11)
+-5.0483800640658324d-11
+
+(+ -7.640856498925806d-21 -5.743808556015994d19)
+-5.743808556015994d19
+
+(+ 8.053891045717591d-21 4.0840032650134725d19)
+4.0840032650134725d19
+
+(+ -4.794782783871528d-21 -3.431216587740782d18)
+-3.431216587740782d18
+
+(+ 1.860870988390988d-21 -3.757945694933625d19)
+-3.757945694933625d19
+
+(+ 5.445498222566789d-21 7.575823566817991d19)
+7.575823566817991d19
+
+(+ 2.631896745307223d-21 4.906449817201212d19)
+4.906449817201212d19
+
+(+ -6.61689881073516d-21 5.357007670385275d-21)
+-1.2598911403498852d-21
+
+(+ 3.0173001109587537d-21 5.2947222461350496d-21)
+8.312022357093803d-21
+
+(+ -8.792518441030627d-21 -1.0516787854168774d-21)
+-9.844197226447504d-21
+
+(+ 7.349451992884509d-21 -8.427997362671486d-21)
+-1.0785453697869767d-21
+
+(+ -7.881179611953633d-21 3.2080446524364824d-21)
+-4.6731349595171506d-21
+
+(+ -9.614117725927607d-21 -5.35667712698602d-21)
+-1.4970794852913628d-20
+
+; ---- Test von - ---
+
+(- -0.011326914400453525d0 -0.6668141757661364d0)
+0.6554872613656829d0
+
+(- -0.46185382764946437d0 0.7488210697846337d0)
+-1.2106748974340982d0
+
+(- -0.35834120541234993d0 -0.30919976341834987d0)
+-0.04914144199400006d0
+
+(- 0.44705025064976966d0 -0.9277893553610955d0)
+1.3748396060108652d0
+
+(- -0.47647537517067917d0 0.29158058381073604d0)
+-0.7680559589814152d0
+
+(- -0.021697999002707746d0 0.1779871773524142d0)
+-0.19968517635512195d0
+
+(- 0.4179484378019861d0 9.9990307469939d9)
+-9.999030746575953d9
+
+(- -0.7475415524823718d0 1.3993312799214797d9)
+-1.3993312806690214d9
+
+(- 0.2519442433861928d0 -6.699632771871848d9)
+6.699632772123793d9
+
+(- -0.5124988631497671d0 2.7959244812290273d9)
+-2.795924481741526d9
+
+(- -0.6870193827604301d0 4.851102442573468d9)
+-4.851102443260488d9
+
+(- 0.7609656780357723d0 7.481252865855436d8)
+-7.481252858245779d8
+
+(- -0.6301276042170191d0 -7.099314875214215d-11)
+-0.630127604146026d0
+
+(- -0.4139053484357884d0 -2.897413526398709d-11)
+-0.41390534840681426d0
+
+(- -0.6944623060197281d0 -3.291569879873739d-11)
+-0.6944623059868125d0
+
+(- -0.2057822500703933d0 3.6505182026159854d-11)
+-0.2057822501068985d0
+
+(- -0.8792706674467908d0 8.094527736950817d-11)
+-0.8792706675277361d0
+
+(- -0.6888184243601332d0 9.127622796988807d-11)
+-0.6888184244514094d0
+
+(- -0.980711030497252d0 8.752272461345245d19)
+-8.752272461345245d19
+
+(- 0.8035082489836539d0 -3.903355151264917d19)
+3.903355151264917d19
+
+(- -0.7537841372394811d0 -5.879942447417834d19)
+5.879942447417834d19
+
+(- -0.6877475951546845d0 -2.3972266191169642d19)
+2.3972266191169642d19
+
+(- -0.43128282112433525d0 -5.422824998003439d19)
+5.422824998003439d19
+
+(- 0.29538116818276694d0 1.1291858990580939d19)
+-1.1291858990580939d19
+
+(- 0.9166687388673976d0 6.395175407123937d-21)
+0.9166687388673976d0
+
+(- 0.41840538498193025d0 -2.6655662412599155d-21)
+0.41840538498193025d0
+
+(- -0.8036940092501853d0 6.7473779576832565d-21)
+-0.8036940092501853d0
+
+(- 0.8555054025209989d0 -7.939970418096797d-21)
+0.8555054025209989d0
+
+(- 0.3365495704567003d0 8.694519827555395d-21)
+0.3365495704567003d0
+
+(- -0.7430322011471231d0 7.430332379292914d-22)
+-0.7430322011471231d0
+
+(- 5.102372414731216d9 -0.5073635765350494d0)
+5.10237241523858d9
+
+(- 4.629827365822252d9 0.6534380055543355d0)
+4.629827365168815d9
+
+(- 7.218192507117569d9 0.9781542046565127d0)
+7.218192506139415d9
+
+(- 6.595760326622413d8 0.7339510561932947d0)
+6.595760319282902d8
+
+(- 7.191166637703489d9 0.80792475493853d0)
+7.191166636895564d9
+
+(- -7.95531405213956d9 0.5353636841430115d0)
+-7.955314052674924d9
+
+(- 5.438904545553836d8 6.533536518165114d9)
+-5.989646063609731d9
+
+(- -7.389650313101625d8 -9.983943153365381d9)
+9.244978122055218d9
+
+(- 8.364404619492165d9 -7.600563055115287d9)
+1.5964967674607452d10
+
+(- 2.070813748323649d9 6.421052769114957d9)
+-4.350239020791307d9
+
+(- -2.8555256820439434d9 -3.4077342921686625d8)
+-2.514752252827077d9
+
+(- 9.147878229420991d8 8.439982790150545d9)
+-7.5251949672084465d9
+
+(- -4.315772980070098d9 -6.48869466068404d-11)
+-4.315772980070098d9
+
+(- -3.5186299785635023d9 3.990046539849716d-11)
+-3.5186299785635023d9
+
+(- 2.5645532837267537d9 8.566645694205622d-13)
+2.5645532837267537d9
+
+(- 6.145110896031829d9 -9.242734002954773d-11)
+6.145110896031829d9
+
+(- -6.6836855975624d9 9.117930361283473d-11)
+-6.6836855975624d9
+
+(- -1.7472828462085754d8 -5.125838712019503d-11)
+-1.7472828462085754d8
+
+(- 9.05675399397055d9 9.086705650502484d19)
+-9.08670564959681d19
+
+(- -5.834806594586836d9 9.981576053842906d19)
+-9.981576054426386d19
+
+(- 3.047010922754272d9 1.1715352070471352d19)
+-1.1715352067424342d19
+
+(- 7.294295638574767d9 2.845702947515113d19)
+-2.8457029467856835d19
+
+(- 8.264143132493019d9 -1.6322956072452289d19)
+1.6322956080716431d19
+
+(- -9.597823287256088d9 3.954126758718671d19)
+-3.954126759678453d19
+
+(- 3.229389511771705d9 -4.329831377266493d-21)
+3.229389511771705d9
+
+(- 6.897089200279753d9 2.4428208790287663d-21)
+6.897089200279753d9
+
+(- 2.3579775300187545d9 4.729400988996349d-21)
+2.3579775300187545d9
+
+(- 1.6718929117460046d9 5.8162277016717065d-21)
+1.6718929117460046d9
+
+(- 2.537177500868296d9 1.4856605280697543d-21)
+2.537177500868296d9
+
+(- 6.117674696930935d9 -1.6187214719634357d-21)
+6.117674696930935d9
+
+(- 4.1877888304549216d-11 -0.06920550501017497d0)
+0.06920550505205286d0
+
+(- 9.61054846124015d-11 0.885309193732889d0)
+-0.8853091936367835d0
+
+(- 2.5559085051828467d-11 -0.8112181469812297d0)
+0.8112181470067888d0
+
+(- -1.4549570208293283d-12 -0.5049325945871657d0)
+0.5049325945857107d0
+
+(- -7.091628047158497d-11 0.61946884965934d0)
+-0.6194688497302563d0
+
+(- 2.877466355456826d-11 0.4496491857374d0)
+-0.44964918570862533d0
+
+(- 1.3041612488449928d-12 5.408018587130755d9)
+-5.408018587130755d9
+
+(- -5.379752339715717d-11 -4.009594691514288d9)
+4.009594691514288d9
+
+(- 7.023042501342336d-12 -3.4153434285746374d9)
+3.4153434285746374d9
+
+(- 6.968174934871611d-11 4.713087404332662d9)
+-4.713087404332662d9
+
+(- -5.153562653896506d-11 -8.44732228013254d8)
+8.44732228013254d8
+
+(- -8.424177457818745d-11 1.6817117809824567d9)
+-1.6817117809824567d9
+
+(- 3.374755984316538d-11 8.893678266883364d-11)
+-5.5189222825668264d-11
+
+(- -8.684123447823306d-11 -7.888825869147879d-11)
+-7.952975786754267d-12
+
+(- 7.788477523205632d-11 1.741674745286914d-11)
+6.046802777918718d-11
+
+(- 6.546622477606044d-11 -4.7719651007530584d-11)
+1.1318587578359101d-10
+
+(- -1.8595152377503265d-11 5.7288738553553045d-11)
+-7.588389093105631d-11
+
+(- -8.184033550427558d-11 -8.834399228929296d-11)
+6.503656785017376d-12
+
+(- 5.749469292140762d-11 7.493129199779113d19)
+-7.493129199779113d19
+
+(- -5.2285095120702066d-11 -2.0611179974216552d19)
+2.0611179974216552d19
+
+(- -8.84727820032067d-11 4.7423077384022024d19)
+-4.7423077384022024d19
+
+(- 3.437676989338625d-11 -3.5368755480277647d19)
+3.5368755480277647d19
+
+(- 2.2665031619145437d-11 -6.072845659234921d19)
+6.072845659234921d19
+
+(- -8.429070146313393d-11 5.134329153614969d18)
+-5.134329153614969d18
+
+(- -9.009531819191212d-11 2.301790665456671d-22)
+-9.00953181921423d-11
+
+(- -2.706942469371907d-11 9.282350542107287d-21)
+-2.706942470300142d-11
+
+(- 5.358266626996117d-11 -4.409057695582885d-22)
+5.358266627040208d-11
+
+(- -7.189537285608088d-11 9.569273217393917d-21)
+-7.189537286565016d-11
+
+(- -4.160295905335358d-11 5.930867524794025d-21)
+-4.160295905928445d-11
+
+(- 6.7922062777334035d-12 -7.747524338474154d-22)
+6.792206278508156d-12
+
+(- -9.038821102045805d19 0.04779131019959271d0)
+-9.038821102045805d19
+
+(- 2.2020595055495963d19 -0.424631558292516d0)
+2.2020595055495963d19
+
+(- -8.164003027214308d19 0.6832198147365239d0)
+-8.164003027214308d19
+
+(- -3.878233560364984d19 -0.28756619113600546d0)
+-3.878233560364984d19
+
+(- 7.0829003521450525d19 -0.6071548125948544d0)
+7.0829003521450525d19
+
+(- 5.968540808784698d19 0.7674294173432648d0)
+5.968540808784698d19
+
+(- -2.2143621795153547d19 -2.443529365769125d9)
+-2.2143621792710017d19
+
+(- -9.77092538926342d18 5.903189771537687d8)
+-9.77092538985374d18
+
+(- 9.974714452399537d19 -6.980456691485629d9)
+9.974714453097582d19
+
+(- 1.7428950527159094d18 3.68843657888816d9)
+1.742895049027473d18
+
+(- -1.1094381875350845d19 -7.157723640671709d9)
+-1.1094381868193122d19
+
+(- -3.638795590369631d19 6.9246542750294075d9)
+-3.6387955910620963d19
+
+(- -5.66543282261991d19 -5.1005028153082024d-11)
+-5.66543282261991d19
+
+(- -3.901527864456216d19 -1.064153465992923d-12)
+-3.901527864456216d19
+
+(- 1.1477489418879848d19 3.327888063907735d-11)
+1.1477489418879848d19
+
+(- 3.508978072054437d19 9.238453417997638d-11)
+3.508978072054437d19
+
+(- -4.7642024461416964d19 -4.758309941438892d-11)
+-4.7642024461416964d19
+
+(- -8.307715835429606d19 3.313910202186439d-11)
+-8.307715835429606d19
+
+(- 2.704675010192592d18 -2.6840207147078365d19)
+2.954488215727096d19
+
+(- -9.860969100714668d18 -4.719594638795429d19)
+3.7334977287239614d19
+
+(- 7.87799781828944d18 -6.657221298850535d19)
+7.44502108067948d19
+
+(- -3.3937781740759863d19 4.783805995045389d19)
+-8.177584169121376d19
+
+(- -1.0747572720102216d19 -1.7144708598072445d19)
+6.397135877970229d18
+
+(- 1.3938845733158445d19 5.604369854609131d19)
+-4.210485281293287d19
+
+(- 6.0938348303695315d19 1.1005522580049531d-21)
+6.0938348303695315d19
+
+(- -2.4870844028694925d19 1.5391650322730598d-22)
+-2.4870844028694925d19
+
+(- 7.323118607079343d19 6.637280375859432d-21)
+7.323118607079343d19
+
+(- -4.181201584825501d19 4.768935182006663d-21)
+-4.181201584825501d19
+
+(- 4.1225910279381205d19 6.117191687463543d-21)
+4.1225910279381205d19
+
+(- 6.438313875980151d17 -1.4883489002691529d-21)
+6.438313875980151d17
+
+(- -4.573961206963222d-21 0.3586300020381973d0)
+-0.3586300020381973d0
+
+(- 7.74206782371325d-22 0.23168389210368656d0)
+-0.23168389210368656d0
+
+(- 8.572446613640605d-21 0.6114581963443891d0)
+-0.6114581963443891d0
+
+(- -8.539467934859551d-21 0.33474735899049d0)
+-0.33474735899049d0
+
+(- -5.55811309570968d-21 -0.9637216018651454d0)
+0.9637216018651454d0
+
+(- -6.705839413964189d-21 0.3787619614522374d0)
+-0.3787619614522374d0
+
+(- 1.338539206480238d-22 6.683968625235106d9)
+-6.683968625235106d9
+
+(- -9.64078167549023d-21 3.291420859310843d9)
+-3.291420859310843d9
+
+(- -9.26536204591093d-22 2.9839295142529476d8)
+-2.9839295142529476d8
+
+(- -3.647737608953592d-21 6.115300020921433d8)
+-6.115300020921433d8
+
+(- 1.4069763806331204d-21 -1.183109060480878d9)
+1.183109060480878d9
+
+(- -6.0037865798761924d-21 -7.442246743849378d9)
+7.442246743849378d9
+
+(- -5.994118986299138d-21 -9.091558282012836d-11)
+9.091558281413425d-11
+
+(- 6.969393585974241d-21 3.435352867093995d-11)
+-3.435352866397056d-11
+
+(- -6.278554484817533d-22 -4.7211920270841604d-11)
+4.721192027021375d-11
+
+(- -8.603262886304741d-21 1.7296517702077242d-11)
+-1.7296517710680505d-11
+
+(- 4.104502790901735d-21 -4.8473213720301105d-11)
+4.847321372440561d-11
+
+(- -4.449725859444968d-21 -8.944265568403936d-11)
+8.944265567958964d-11
+
+(- 4.828216540804827d-21 -1.1712152029346877d19)
+1.1712152029346877d19
+
+(- -5.65034940464881d-21 -9.445303840982011d19)
+9.445303840982011d19
+
+(- -7.24107519738777d-21 2.340578690102746d19)
+-2.340578690102746d19
+
+(- 1.7659593956231534d-21 -8.048768257390671d18)
+8.048768257390671d18
+
+(- -3.0538518255248124d-21 8.834631867521575d19)
+-8.834631867521575d19
+
+(- 8.57952908388053d-21 -5.730742870111307d19)
+5.730742870111307d19
+
+(- -4.5090103564928485d-21 1.8907114777916313d-21)
+-6.399721834284479d-21
+
+(- -3.8487625143236447d-22 5.354282198078924d-21)
+-5.739158449511288d-21
+
+(- 2.6660110440404615d-22 3.833744224501756d-22)
+-1.1677331804612944d-22
+
+(- -7.503762004261027d-22 -9.623906576475644d-21)
+8.873530376049542d-21
+
+(- -9.113431042260725d-21 -3.5516521546085545d-21)
+-5.56177888765217d-21
+
+(- -3.4813735333296525d-21 -2.6602650182385188d-21)
+-8.211085150911337d-22
+
+; ---- Test von * ---
+
+(* -0.2554913394465045d0 0.27042187315261135d0)
+-0.0690904465873934d0
+
+(* -0.4489211233229662d0 -0.42892136850270857d0)
+0.19255186256545986d0
+
+(* -0.44586465919973783d0 -0.15168042462027043d0)
+0.0676289408305884d0
+
+(* 0.5509395670465355d0 0.3577558280766836d0)
+0.19710184102894285d0
+
+(* -0.42780066410606965d0 0.22704747885906007d0)
+-0.0971310622395147d0
+
+(* 0.20955388816500042d0 0.605628751935113d0)
+0.12691185975251945d0
+
+(* 0.9993471610818964d0 -4.363771855901198d9)
+-4.360923015803941d9
+
+(* 0.10502219375257282d0 3.425205053451057d9)
+3.5972254876582843d8
+
+(* 0.7768651149081368d0 1.666066330143864d9)
+1.2943088110117908d9
+
+(* -0.6438389801759042d0 2.8922130868526487d9)
+-1.8621195242906134d9
+
+(* -0.7427680566504474d0 6.763974500466173d9)
+-5.02406419494444d9
+
+(* -0.8563035843259611d0 2.9100478627456827d9)
+-2.4918844154292307d9
+
+(* 0.6219502737119671d0 2.8868752190811842d-11)
+1.7954928326798375d-11
+
+(* 0.6767479505813657d0 2.9324524289075574d-11)
+1.9845311714405376d-11
+
+(* 0.7944531541461581d0 8.282076647859848d-11)
+6.579721915772496d-11
+
+(* -0.4662914070981966d0 -6.921260263903422d-11)
+3.227324187348362d-11
+
+(* 0.037804762510578516d0 -3.044514833184461d-11)
+-1.1509716022847211d-12
+
+(* -0.5364168049485208d0 -3.695280705974925d-11)
+1.9822106696869836d-11
+
+(* 0.10343751426551051d0 4.8902635121181385d19)
+5.058367017968255d18
+
+(* -0.45511004829813784d0 1.8210069906740634d19)
+-8.287585794769196d18
+
+(* -0.9675158737162977d0 8.097401718869682d19)
+-7.83436469886405d19
+
+(* -0.06573561186185628d0 2.6049125586869125d19)
+-1.712355208919178d18
+
+(* -0.5574365795036731d0 -8.822383181882661d19)
+4.917919103979403d19
+
+(* -0.4222667103024276d0 -1.8561723355961213d19)
+7.837997859065477d18
+
+(* -0.8412207478192143d0 2.3416069046402696d-22)
+-1.9698083114201234d-22
+
+(* 0.24291385591230452d0 -9.448120185342916d-21)
+-2.295079305344525d-21
+
+(* -0.37792600430678414d0 -2.3929024368177364d-21)
+9.043400566424941d-22
+
+(* -0.007648867433060369d0 -5.3162210182098465d-21)
+4.066306981313633d-23
+
+(* -0.7631807323096114d0 -4.534410248041209d-21)
+3.4605745336922964d-21
+
+(* 0.4735366300649959d0 -1.3895270471326203d-21)
+-6.579919552833457d-22
+
+(* -8.64834403600587d9 -0.14057280586223464d0)
+1.215721987203268d9
+
+(* -1.5525713051163936d9 0.10621224657238759d0)
+-1.64902086280236d8
+
+(* 3.297132746298694d9 0.05318660311813239d0)
+1.7536329080518654d8
+
+(* 2.1659831568875275d9 0.11704159596099262d0)
+2.5351012550674528d8
+
+(* -5.533403510176525d9 0.37778599060251605d0)
+-2.0904423264954782d9
+
+(* -2.4217306331294374d9 0.6051350227557695d0)
+-1.465474021787126d9
+
+(* 1.4048311850866513d9 -4.304799039580996d9)
+-6.047515936334449d18
+
+(* -5.070278162013437d9 -9.116233758795675d9)
+4.622184094703138d19
+
+(* 8.452801605894673d9 -9.002885976919611d9)
+-7.609960904339272d19
+
+(* 6.352601599408395d9 -4.484034289922495d9)
+-2.848528340196373d19
+
+(* -6.565407710101401d8 -6.718825369609182d9)
+4.4111827884457016d18
+
+(* -9.37193973536698d9 9.577576231327314d9)
+-8.976046725088279d19
+
+(* -1.7766859308675253d9 -4.079350537765101d-11)
+0.0724772470752413d0
+
+(* 2.3810136983742104d9 9.195156930614704d-11)
+0.2189379461049417d0
+
+(* -3.313966320976337d9 -3.44704749912067d-11)
+0.11423399318891611d0
+
+(* 6.598963960681895d9 -2.4298605961767928d-11)
+-0.1603456250365168d0
+
+(* 7.908258993705348d9 1.528909719631646d-11)
+0.12091014040840486d0
+
+(* -5.906667889594469d9 5.917852809041966d-11)
+-0.3495479116251461d0
+
+(* 4.86261281419926d9 -2.3925611132123714d19)
+-1.1634098327861323d29
+
+(* -9.753392818607462d9 -2.5653634777279775d18)
+2.502099772078992d28
+
+(* 1.5861252889272392d9 5.12939252547053d19)
+8.135859201483165d28
+
+(* -8.422142961023593d8 1.0428099441045047d19)
+-8.782694430425161d27
+
+(* -3.109042783121446d9 -4.138252722536039d19)
+1.286600476173335d29
+
+(* -6.459303282089468d8 1.8408981660472957d19)
+-1.189091956594178d28
+
+(* -1.432764110232635d9 8.98766033001457d-21)
+-1.2877197155806476d-11
+
+(* 8.539623949953406d9 -3.498784805440049d-21)
+-2.987830652026891d-11
+
+(* 7.336784327799637d9 -1.048985206018761d-21)
+-7.696178219612119d-12
+
+(* -4.320357143553698d9 2.591531476439043d-21)
+-1.119634152697768d-11
+
+(* -9.374098076239548d9 5.5773248420603045d-21)
+-5.228239007252054d-11
+
+(* 9.118926580475056d9 -1.379170270330765d-21)
+-1.2576552437120181d-11
+
+(* 8.145792307872788d-11 -0.06511382435429458d0)
+-5.304036895613926d-12
+
+(* -6.1928426627437d-11 0.2526275616632321d0)
+-1.5644827416529785d-11
+
+(* -8.555119338859813d-11 -0.8366318482083728d0)
+7.157485304113478d-11
+
+(* 8.243060442429263d-12 0.3939656708074719d0)
+3.2474828367081808d-12
+
+(* 8.600529286105945d-11 -0.891441509265547d0)
+-7.666868807288822d-11
+
+(* -7.531046724969747d-11 0.24398797995196886d0)
+-1.8374848773492595d-11
+
+(* -3.7666526619188126d-12 4.659322150343885d9)
+-0.017550048180330083d0
+
+(* 3.032501107241211d-11 -9.592046453776636d9)
+-0.2908789149178678d0
+
+(* 7.311626957349528d-11 -9.061108567148174d9)
+-0.6625144566303135d0
+
+(* 4.898078204161461d-11 8.88014689134599d9)
+0.4349565393825394d0
+
+(* 1.278207138618518d-11 -4.279966992086118d9)
+-0.05470684362336102d0
+
+(* -8.538580654966055d-11 -5.191059833953482d8)
+0.0443242830769665d0
+
+(* 4.0761422500127225d-11 1.527607426117321d-11)
+6.226745171030001d-22
+
+(* -9.186363051001198d-11 8.557763803549676d-11)
+-7.861472520412421d-21
+
+(* -9.89183505930065d-11 9.717968160611499d-11)
+-9.612853815630427d-21
+
+(* 7.440627873114725d-12 -4.535521332601712d-11)
+-3.374712644646274d-22
+
+(* 8.701410920357686d-11 -7.032883383151379d-12)
+-6.119600827175551d-22
+
+(* 9.866226673114161d-11 -2.814669610817353d-11)
+-2.777016839025002d-21
+
+(* 5.192240545105114d-11 -3.366056660574579d19)
+-1.747737587015645d9
+
+(* -1.372355669576939d-11 -4.819955130360066d19)
+6.61469275025609d8
+
+(* 3.637511103766519d-11 -4.071776382810416d19)
+-1.4811131804527159d9
+
+(* 7.446388208685151d-13 2.7760294268649034d19)
+2.0671392791169815d7
+
+(* 6.267855179410938d-11 7.471751480940298d19)
+4.683185621908299d9
+
+(* -4.336562006766369d-11 8.143188451558233d19)
+-3.5313441652966094d9
+
+(* -1.0432655006975122d-11 -9.379512413340694d-21)
+9.785321714202411d-32
+
+(* -8.167646898574611d-11 -5.810795749825724d-21)
+4.746052788431461d-31
+
+(* -4.33805459341994d-11 -2.4289860591796017d-21)
+1.053707413137707d-31
+
+(* -1.384613082275421d-11 2.2174009100764947d-21)
+-3.070242308741339d-32
+
+(* -4.910905591314494d-11 -5.456657623752349d-21)
+2.679713043437427d-31
+
+(* 1.3653011366548008d-11 -3.925911962906968d-21)
+-5.360052065363564d-32
+
+(* 7.641468950470222d19 0.9034599537348024d0)
+6.903761184457755d19
+
+(* 5.146778093125584d19 -0.2791459460022878d0)
+-1.436702239669392d19
+
+(* -8.874303077863696d19 -0.23153988023519345d0)
+2.054755071819369d19
+
+(* 7.10798162637783d19 -0.4719034863212067d0)
+-3.354281310194779d19
+
+(* -9.820386602197546d19 0.03346146041258036d0)
+-3.286044775256677d18
+
+(* -5.210458089116161d19 0.11173798093222442d0)
+-5.822060666098161d18
+
+(* 3.257626718953688d18 -6.150510855712356d9)
+-2.0036068498783283d28
+
+(* -7.755105754004988d19 5.514896832715505d9)
+-4.27686081601359d29
+
+(* 2.426235084788384d19 8.685431434428486d9)
+2.1072898472734294d29
+
+(* -2.847383850475709d19 -2.412830829567453d9)
+6.870255538040273d28
+
+(* 1.4664659669727164d19 -4.8673539253155d9)
+-7.1378088806862425d28
+
+(* -4.24770317054668d19 1.3102543269150825d9)
+-5.5655714586597015d28
+
+(* 2.17116835964837d19 -3.654789326884115d-11)
+-7.935162947711353d8
+
+(* -1.8125809977916906d17 -5.944782899600832d-11)
+1.0775400519813456d7
+
+(* -7.915462827540546d19 9.762153025588201d-11)
+-7.727195939080587d9
+
+(* -4.360953588949649d19 -7.152431005584812d-11)
+3.119141966351983d9
+
+(* 3.550776271395866d19 -6.387656982922894d-11)
+-2.268114084477872d9
+
+(* -8.278954580496595d19 -7.359178231519021d-11)
+6.092630232852524d9
+
+(* -5.5022682113038156d19 -8.979630229039327d19)
+4.940833395850589d39
+
+(* 1.1716230943203277d19 5.5764415854118265d19)
+6.533487745596758d38
+
+(* 7.462799608352103d19 6.061883497941003d19)
+4.523862179431019d39
+
+(* -3.2160334983646097d19 -3.8817785710003675d19)
+1.2483929917571087d39
+
+(* 5.868090263060238d19 -8.37300331667736d19)
+-4.91335392351655d39
+
+(* -7.3652924769962656d19 9.725738480757314d19)
+-7.163290846555493d39
+
+(* -6.447063647969567d19 4.0587529685661844d-21)
+-0.2616703871973161d0
+
+(* -3.1999317568381926d17 3.015031281949113d-21)
+-9.647894346969533d-4
+
+(* -1.5005852398726605d19 5.391316601974659d-21)
+-0.080901301164036d0
+
+(* 1.0084552719733576d19 2.78150956101201d-21)
+0.02805027980846861d0
+
+(* -7.171404412051077d19 1.4733392992015492d-21)
+-0.10565911950742231d0
+
+(* -5.909802783283228d19 5.356071274587122d-21)
+-0.31653324926018317d0
+
+(* 8.272641144282955d-22 -0.16191056182923802d0)
+-1.3394279754825238d-22
+
+(* 8.410471541398583d-21 -0.43256058128353736d0)
+-3.63803845881602d-21
+
+(* -7.887238384137063d-22 0.5589746137044918d0)
+-4.408766028968254d-22
+
+(* 4.778995446616728d-21 0.21608373898977795d0)
+1.0326632047200663d-21
+
+(* 3.992449163872154d-21 0.9593422165456676d0)
+3.830125030315009d-21
+
+(* -9.700320218813958d-21 -0.42620535269852766d0)
+4.134328400148262d-21
+
+(* -1.7901566262876555d-21 9.461674014776534d8)
+-1.6937878433325936d-12
+
+(* 1.0928019952544443d-22 8.279199780524873d9)
+9.047526039267738d-13
+
+(* 9.942869097320962d-21 9.523169242022762d9)
+9.468762516506561d-11
+
+(* -2.7432601692209267d-21 -4.922145522647528d9)
+1.3502725759388083d-11
+
+(* -5.97929682563092d-21 -6.147792689359443d8)
+3.6759477312123895d-12
+
+(* -1.3564305221188254d-21 1.0862842413758955d9)
+-1.473469100698958d-12
+
+(* -5.446806293721964d-21 -1.5358504316888942d-11)
+8.365479797538665d-32
+
+(* -1.0222776562632463d-21 -1.9781477525280056d-11)
+2.0222162481967376d-32
+
+(* 8.192540157543917d-21 3.3215076993103644d-11)
+2.7211585210191467d-31
+
+(* 9.685592607330157d-21 6.034805605641166d-11)
+5.8450668560672665d-31
+
+(* 6.671870463340688d-21 -9.07657686679269d-11)
+-6.055774510579552d-31
+
+(* -1.109409648670322d-21 -4.7905821901849965d-11)
+5.314718104539439d-32
+
+(* -3.9052432481663676d-22 2.0306112771345453d19)
+-0.007930030979680168d0
+
+(* 8.596834841113507d-21 -9.453548987989818d19)
+-0.8127059931212419d0
+
+(* 3.946325780779758d-21 -9.084484011754447d19)
+-0.35850333460668093d0
+
+(* 5.3518824877647604d-21 -6.814116447592617d19)
+-0.36468350485460743d0
+
+(* -7.456278485417833d-22 9.61914445493285d19)
+-0.07172301984744206d0
+
+(* -5.0781537010216826d-21 9.216915512986622d19)
+-0.4680491362427718d0
+
+(* 3.2906792172396555d-22 4.571445785546992d-21)
+1.50431616392373d-42
+
+(* 5.39814714322422d-21 6.687033308557664d-21)
+3.6097589751235757d-41
+
+(* 4.3506183844841724d-21 7.266196706225928d-21)
+3.1612448975384865d-41
+
+(* 6.910763289107986d-21 3.910584203890238d-21)
+2.702512175521024d-41
+
+(* -4.6131515924393325d-21 5.228174479773633d-21)
+-2.411836142691841d-41
+
+(* -2.1886866436065787d-21 6.29322016055891d-22)
+-1.3773886910690934d-42
+
+; ---- Test von FLOOR ---
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.6173351962722496d0 -0.11820538775792844d0))
+(-6 -0.09189713027532098d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.17517225806171177d0 0.1118228341753209d0))
+(-2 0.04847341028893004d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.9387909021047899d0 -0.16826318310698907d0))
+(5 -0.09747498656984459d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.8036728904567848d0 0.6774308237913269d0))
+(1 0.1262420666654578d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.6882568422881421d0 0.3302150266778784d0))
+(2 0.02782678893238538d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.3618917435888378d0 0.5454396894763598d0))
+(0 0.3618917435888378d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.478470818234076d0 9.035797971846054d9))
+(-1 9.035797971367584d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.6423779722022549d0 2.0589504447793393d9))
+(0 0.6423779722022549d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.21698095744051404d0 1.570908384361449d9))
+(0 0.21698095744051404d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.24033995915823747d0 6.968395233824382d9))
+(0 0.24033995915823747d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.8531247643149816d0 -5.299783511441018d9))
+(0 -0.8531247643149817d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.5134978162655872d0 2.297671112225289d9))
+(-1 2.297671111711791d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.6192405432591311d0 5.4403538407469436d-11))
+(11382357864 3.744539199218032d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.20340731452742233d0 5.44351944436815d-12))
+(-37366875715 2.4681729170135434d-12)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.29394735220898527d0 -3.6328318262890404d-12))
+(80914109505 -3.3847154436219604d-12)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.8359336184185098d0 6.064791537508077d-11))
+(-13783385847 1.2432123964511977d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.9762544843227843d0 2.2086465633336306d-11))
+(-44201480696 1.1997821346734454d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.2919696169517234d0 6.922295436251983d-11))
+(-4217815025 3.3402028237741715d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.9452118035872986d0 -1.1093667270485797d19))
+(-1 -1.1093667270485797d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.3379784391207531d0 -3.0106029588222304d19))
+(-1 -3.0106029588222304d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.3907483945162724d0 -9.823409070968835d19))
+(-1 -9.823409070968835d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.4293216868359586d0 5.965415751655242d19))
+(-1 5.965415751655242d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.13727607148241305d0 -8.310631671228052d19))
+(-1 -8.310631671228052d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.7478116595122868d0 7.235991436975452d19))
+(-1 7.235991436975452d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.9425796643098138d0 -1.7749544068364875d-21))
+(531044437355311857664 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.20835281321620536d0 2.7983277403481253d-21))
+(74456186890490986496 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.5404541167071248d0 9.266841531614177d-22))
+(-583212861537931100160 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.06796825059990208d0 -6.350644782153893d-21))
+(10702574767038046208 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.30647600932087793d0 -9.704243038852408d-21))
+(-31581650221851901952 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.7939481974521416d0 -7.44148349933678d-21))
+(106692193501860495360 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.622471924924206d9 0.3428958732728865d0))
+(7648012499 0.2776496600055352d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.96303133513731d9 -0.6839887200892081d0))
+(-14566075496 -0.09450688719173875d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.438132647041376d8 -0.9350840745499996d0))
+(-1009335193 -0.15301271996267998d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.031281076435459d9 0.8566679205528436d0))
+(-5873082155 0.5244045303768723d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.504293159523993d9 -0.17779074115973026d0))
+(53457750935 -0.058079864158457416d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.593337221858664d8 0.6365106532159245d0))
+(878749977 0.3121177083383602d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.849085830660753d9 5.465582064164139d9))
+(-2 1.0820782976675239d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.254242990207708d9 1.9986128256161973d9))
+(3 2.5840451335911673d8)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.644949290710447d9 3.677515142398587d9))
+(-3 1.3875961364853137d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.966654669106707d9 3.622741134738514d9))
+(2 2.7211723996296782d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.024110605080818d9 -1.3131548351819434d9))
+(5 -4.583364291711011d8)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.5982831731090415d8 -4.587607917895467d9))
+(0 -4.5982831731090415d8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.779683583609543d9 -8.732134194560264d-11))
+(-77640625218895380480 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.040910010354103d8 -6.386892985922651d-11))
+(-4761172634419539968 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.081490496057175d9 -8.389512916135551d-11))
+(108248125807050637312 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.3391140718625803d9 4.078343101769488d-11))
+(-57354519065541566464 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.740679130260033d9 -4.1307299498162d-11))
+(-235810117064018001920 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.630742761978566d9 -8.36053471494181d-11))
+(-55388117146413842432 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.607827158404311d8 1.9791074337467208d19))
+(0 6.607827158404311d8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.5835379695092866d9 -5.599741962857091d19))
+(-1 -5.599741962698737d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.972337740404726d9 -1.4833907125668299d19))
+(0 -9.972337740404726d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.8545208802037845d9 5.460276762513134d19))
+(-1 5.4602767622276825d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.4574292483978963d9 8.177006210253868d19))
+(0 3.4574292483978963d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.94800692720856d9 5.400944544004402d19))
+(-1 5.400944543309601d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.2301147741459103d9 4.352417825189536d-22))
+(5123852680777023531125296857088 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.855798499915275d9 -2.1597757039453335d-21))
+(-1322266240285272897749142994944 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.247757812861889d9 -8.000803060408911d-21))
+(-780891338743010366964468023296 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.41352264607702d8 2.4583479152659926d-21))
+(-342242958933120698647142465536 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.08798064415713d9 -4.6826703076651156d-21))
+(-1940768844921862497464005689344 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.450923950975804d9 -8.516681149015905d-21))
+(287779230910741073293637320704 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.535114995775952d-11 -0.4217447234387455d0))
+(0 -6.535114995775952d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.91351782048677d-13 -0.8578740601420116d0))
+(-1 -0.8578740601413203d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.879448244992307d-11 -0.6016918305263045d0))
+(0 -9.879448244992307d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.820572196574365d-11 -0.8508242256358738d0))
+(-1 -0.8508242255576681d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.4420680878896835d-11 0.6509799475016377d0))
+(-1 0.650979947457217d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.35377304874932d-11 -0.7623592484047194d0))
+(0 -8.35377304874932d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.697219220983554d-11 -2.0199834401398075d9))
+(0 -4.697219220983554d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.027899822164905d-11 -3.0043885624092436d8))
+(-1 -3.0043885624092436d8)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.473748837497406d-11 -6.081705720880249d8))
+(0 -9.473748837497406d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.257060775257221d-11 4.479345462936419d9))
+(-1 4.479345462936419d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.076402998599221d-11 3.0379052042471523d9))
+(-1 3.0379052042471523d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.2516054170046405d-11 9.075782126517027d9))
+(0 3.2516054170046405d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.77186165285192d-12 -7.011585244893556d-11))
+(-1 -6.234399079608364d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.129939073543463d-11 -4.398862671531905d-11))
+(0 -4.129939073543463d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.986332353670153d-11 4.056354917830567d-11))
+(-2 3.126377481990981d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.358815251785654d-11 3.044610839789864d-11))
+(-3 2.7750172675839383d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.5218538547762808d-11 -4.9239841620755075d-11))
+(0 -1.5218538547762808d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.714719523899548d-11 -3.338962509681127d-11))
+(1 -3.757570142184203d-12)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.7559900032627426d-11 -7.103620895893612d19))
+(0 -3.7559900032627426d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.442771371655891d-11 3.2650979291930292d19))
+(0 3.442771371655891d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.026236668129701d-11 -7.030175018925641d19))
+(0 -8.026236668129701d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.0245932625540036d-11 9.919022649131396d19))
+(0 4.0245932625540036d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.558019989897738d-11 9.805879474847002d19))
+(0 6.558019989897738d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.950419173616613d-11 7.8967335533488d19))
+(-1 7.8967335533488d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.2555105814142415d-11 -7.367149245343951d-22))
+(57763327980 -5.012024424412273d-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.125466497249949d-11 -9.625683307253578d-21))
+(7402556545 -6.2922712544984485d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.076311292972551d-11 5.7198456178965606d-21))
+(14119806429 1.262169607592943d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.024787982764915d-11 1.5125149703168537d-21))
+(-46444419531 6.648179051963393d-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.3153240875994985d-11 -1.5025822462858028d-21))
+(-15408967419 -1.3907844732195436d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.445189938981536d-11 -1.8886893988697117d-21))
+(-50009228329 -8.218058303553574d-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.982223463756733d19 0.20677548795071854d0))
+(-434394983311440412672 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.6872844858317455d19 0.00946240694180256d0))
+(-2839958693765316083712 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.566658458393646d19 -0.38847162936974444d0))
+(246264018659858710528 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.235085548018657d19 -0.06527446136754045d0))
+(648812025299173376000 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.8443413501845017d19 -0.04996947402848739d0))
+(-569215787335074643968 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.484750058861429d19 -0.2338784192921971d0))
+(191755616975433072640 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.986802109112903d19 5.923385648786668d9))
+(-5042390090 3.561083576852057d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.088567504347222d18 9.070536452627407d9))
+(891740807 8.158341046664973d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.09688480137261d19 -6.508291621550677d9))
+(4758368219 -1.75538588669977d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.226418080435591d19 7.892147197133178d9))
+(5355219530 6.335538696917366d8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.4013831972690205d19 -2.4924246236187544d9))
+(-5622570023 -6.556610185422871d8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.1838203826708914d19 8.941814127664919d9))
+(6915621700 8.062833976289089d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.916774706038343d18 3.120694095597196d-11))
+(-221642189018039718512504602624 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.435687674071892d19 -3.149833308668829d-11))
+(-2995614926067172775889444274176 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.212546775235241d19 3.239266009361982d-11))
+(-1917887187183768183263136317440 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.749482734068419d19 -5.5235623432819116d-11))
+(-859858627258009608103722483712 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.0587261660909548d19 4.4929685621578874d-11))
+(680780674018761986414328414208 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.141754743467259d19 5.235000122629564d-11))
+(791166121575339566219965497344 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.2481803107227873d19 7.39878580568375d18))
+(-2 2.3157685041396265d18)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.5884453212818639d19 -8.336283910718495d19))
+(0 -1.5884453212818639d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.000368279611168d19 -5.031778160332162d19))
+(-1 -3.1409880720993677d17)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.6360612893747024d19 4.7875734964388405d19))
+(-1 1.1515122070641383d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.357251757890727d19 -4.493498319637942d19))
+(-1 -2.136246561747215d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.0747068626287395d19 8.591364094011977d19))
+(0 5.0747068626287395d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.1440483442615423d19 9.668454918695627d-21))
+(2217570813838780736509865871750106972160 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.818664212173065d19 -8.186497379734964d-21))
+(-10772206724212702608743560617665161592832 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.376250633760416d19 -6.382238421048869d-21))
+(11557466435965877316178494055246213414912 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.374244855009332d19 3.864539687646209d-21))
+(-11318928536282082575630148538694692241408 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.578656580690454d19 9.103502086399884d-22))
+(83249902166909342613269419960118328426496 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.759312769216988d19 -9.830658049049094d-21))
+(-5858522125865295462884970652182979280896 0.0d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.091696063135083d-21 0.3220521420236615d0))
+(-1 0.3220521420236615d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.472975994693659d-21 -0.06404310380828848d0))
+(0 -7.472975994693657d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.2994935284804662d-21 0.8294627436562217d0))
+(0 2.2994935284804662d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.098532726052559d-21 -0.5103342535054871d0))
+(0 -6.098532726052559d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.8237727943808d-21 0.20193503990844952d0))
+(-1 0.20193503990844952d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.357065560054238d-21 0.535324456368991d0))
+(-1 0.535324456368991d0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.67862366495009d-23 5.869284875063336d9))
+(0 8.67862366495009d-23)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.913399519946995d-21 4.645302733766437d9))
+(-1 4.645302733766437d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.256033435453117d-21 3.5904533516671333d9))
+(0 6.2560334354531166d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.970558626381476d-21 4.548434922363557d9))
+(-1 4.548434922363557d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.442840440717647d-21 -3.3266294818989463d9))
+(-1 -3.3266294818989463d9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.6732789449833775d-21 5.614289998802058d8))
+(-1 5.614289998802058d8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.136201304639634d-21 -1.152382297069954d-12))
+(-1 -1.1523822899337527d-12)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.575364316308001d-21 -4.790622052171537d-11))
+(0 -7.575364316308001d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.212759331893804d-21 -6.41398602124991d-11))
+(-1 -6.413986020328634d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.9103188467401064d-21 -5.1860189481412404d-11))
+(0 -1.9103188467401064d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.473075242507236d-21 2.3036197131739102d-11))
+(-1 2.303619712726603d-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.138595152941494d-21 2.9424719822474346d-11))
+(0 5.138595152941494d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.137698996313833d-22 2.2468745456943227d19))
+(-1 2.2468745456943227d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.229848882029144d-21 -3.031606285079872d19))
+(0 -7.229848882029144d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.85451854164106d-21 1.7676693722776926d19))
+(-1 1.7676693722776926d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.372223270507929d-21 -7.439745956384552d19))
+(-1 -7.439745956384552d19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.598138480271164d-21 5.149401801116799d19))
+(0 5.598138480271163d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.285618896860432d-21 6.546424273112694d19))
+(0 9.285618896860432d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.511556502656318d-21 4.2351039143592516d-21))
+(1 3.2764525882970666d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.050106800286075d-21 -1.187392681676287d-21))
+(-6 -1.0742492897716469d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.274671258683056d-21 8.647095729321104d-21))
+(0 4.274671258683056d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.344809600387072d-21 6.305446958850813d-21))
+(1 1.039362641536258d-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.753544125648588d-21 9.227661371269332d-21))
+(1 5.258827543792571d-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.227362780459908d-21 -6.70179577363263d-21))
+(1 -5.255670068272766d-22)
+
+; ---- Test von / ---
+
+(/ -0.651381628953465d0 -0.9237050214744277d0)
+0.7051835962889135d0
+
+(/ 0.5067986732438687d0 0.6260017267692811d0)
+0.8095803119575966d0
+
+(/ -0.8399445051045212d0 0.1829250718359493d0)
+-4.591740742120902d0
+
+(/ -0.5987041550692662d0 -0.4124053212463479d0)
+1.4517372211878756d0
+
+(/ 0.5861382519823647d0 -0.7560374696447822d0)
+-0.7752767230673855d0
+
+(/ -0.012882644582824954d0 -0.4671067448591679d0)
+0.02757965866390787d0
+
+(/ -0.7830198970435231d0 2.1690164135025935d9)
+-3.610022921767931d-10
+
+(/ -0.2339206226652567d0 2.729373380002701d9)
+-8.57048817062271d-11
+
+(/ -0.2285806315782951d0 -2.602073870582813d9)
+8.784555817667759d-11
+
+(/ -0.5298716781559242d0 1.3509547453340487d9)
+-3.9222015392151683d-10
+
+(/ 0.7287190523338418d0 -8.244205871151566d9)
+-8.839166121309548d-11
+
+(/ 0.18973054487786212d0 6.557593452200545d9)
+2.893295326415727d-11
+
+(/ 0.5084032300982587d0 4.5431682148621014d-11)
+1.119049980221105d10
+
+(/ 0.6621212705475221d0 -1.838873437953206d-11)
+-3.600689731450519d10
+
+(/ -0.4041791750277005d0 7.707875701307648d-11)
+-5.243716825365141d9
+
+(/ -0.09569063343466655d0 4.789751448902253d-11)
+-1.9978204392338054d9
+
+(/ -0.6471008513340974d0 1.890250884404079d-11)
+-3.4233596009563705d10
+
+(/ -0.4301276572683971d0 9.134844738134672d-11)
+-4.708647706651978d9
+
+(/ -0.5061027989171409d0 4.246468515299164d19)
+-1.1918204434902915d-20
+
+(/ -0.9601783702217944d0 7.495754288877955d19)
+-1.2809629734615065d-20
+
+(/ -0.6477754868655262d0 -8.507334914535449d19)
+7.614317449272521d-21
+
+(/ 0.1934462826116784d0 3.6173521417193476d19)
+5.347731573618163d-21
+
+(/ -0.7794308505212441d0 4.172217291786081d19)
+-1.8681453913144062d-20
+
+(/ -0.8462346361305484d0 7.378170819620111d19)
+-1.1469436759043748d-20
+
+(/ 0.9783005897625496d0 6.175045007596078d-21)
+1.584280905740958d20
+
+(/ -0.9700832605850568d0 -1.7695051741124812d-21)
+5.482229013948009d20
+
+(/ 0.07062591404368701d0 -8.855398515753737d-21)
+-7.975464223100028d18
+
+(/ 0.4751383409805402d0 -8.1371029771106d-21)
+-5.8391585103087485d19
+
+(/ -0.5103510786836052d0 8.302178001281015d-21)
+-6.14719509271975d19
+
+(/ 0.7148807879199733d0 4.338856119331781d-21)
+1.6476250151158982d20
+
+(/ 4.180670608983218d9 -0.8621420131862095d0)
+-4.849167010818503d9
+
+(/ 3.202209376555907d9 0.008113117870009012d0)
+3.9469528581523615d11
+
+(/ 7.767843042272955d9 -0.04145956871894663d0)
+-1.8735947532235483d11
+
+(/ 1.1937839884817846d9 0.45557753834605563d0)
+2.6203749921818776d9
+
+(/ -2.4205138097471213d9 -0.3737757916008485d0)
+6.475844247109412d9
+
+(/ -7.534066568550288d9 -0.3609372553147958d0)
+2.0873618496321087d10
+
+(/ 6.098867840095913d9 3.0464612528039427d9)
+2.0019515542771322d0
+
+(/ 4.956687716396978d9 7.035407926465974d9)
+0.704534515724495d0
+
+(/ 6.969049109639194d9 -8.115758334653503d9)
+-0.8587058438990264d0
+
+(/ -8.0699835500126705d9 -1.1896420666819375d9)
+6.783539163608158d0
+
+(/ -2.229793060172571d9 -2.658809828346301d9)
+0.8386433043838396d0
+
+(/ 3.0672739776038485d9 -7.988270854370873d9)
+-0.3839722054398737d0
+
+(/ 2.477055391151669d9 -1.3522358047779648d-11)
+-1.8318220700851785d20
+
+(/ 1.1318646612469008d9 -8.457695758685169d-11)
+-1.3382659929385544d19
+
+(/ -7.978772126259147d9 6.210468872769038d-11)
+-1.2847294286013678d20
+
+(/ -9.057338243339752d9 7.364415429198257d-11)
+-1.2298787772658011d20
+
+(/ -5.341117220720213d9 4.7359651161519756d-11)
+-1.1277779902779204d20
+
+(/ 5.838003830912871d9 -5.0625478501901024d-11)
+-1.153175042225754d20
+
+(/ 6.407156672927742d9 5.006339136594536d19)
+1.279808758079079d-10
+
+(/ 4.687485139826675d8 -3.5561755068968083d19)
+-1.3181253655045475d-11
+
+(/ -5.838044723576891d9 -6.843985743599882d19)
+8.530182473036721d-11
+
+(/ 3.9279221543350096d9 -5.882918042982924d19)
+-6.67682623765291d-11
+
+(/ -9.686323716926361d9 -3.44800215666902d19)
+2.8092568614527606d-10
+
+(/ 7.301304808910639d9 1.2845297359643038d19)
+5.684029419085038d-10
+
+(/ 4.380345662298534d9 -4.352751895415198d-21)
+-1.0063393842668593d30
+
+(/ 8.239490918139045d9 3.2397577733346748d-21)
+2.5432428886984834d30
+
+(/ 3.8980499504872713d9 8.311650110069505d-21)
+4.689862901910189d29
+
+(/ -9.425472285331268d9 -3.294031046828316d-21)
+2.861379310436876d30
+
+(/ 2.517833161624173d9 3.6891560299469316d-21)
+6.824957093669991d29
+
+(/ -5.463519676339016d9 -7.298583081866205d-22)
+7.485726496576409d30
+
+(/ 1.39357009199772d-11 0.417842407627649d0)
+3.335157146709649d-11
+
+(/ 8.58494900746665d-11 -0.6481371063028898d0)
+-1.3245575548724563d-10
+
+(/ -9.310282234439046d-11 0.9146343299129254d0)
+-1.0179239866631073d-10
+
+(/ -8.800556770159418d-11 -0.9305573406536135d0)
+9.45729659601417d-11
+
+(/ -1.3361456473382827d-11 0.06420301636905124d0)
+-2.081125970247039d-10
+
+(/ 6.1406425153971765d-12 -0.3082496074575478d0)
+-1.992100676476244d-11
+
+(/ -3.6962256202372035d-11 3.089420488573177d9)
+-1.1964139015418631d-20
+
+(/ -6.145126590884831d-11 -6.225608984106817d9)
+9.870723661849874d-21
+
+(/ 9.052281678541901d-11 -6.9187138778508625d9)
+-1.3083763598782874d-20
+
+(/ -3.4950245360118636d-11 7.543342567738434d9)
+-4.633257080169575d-21
+
+(/ -3.482822570743636d-11 -3.87599225187502d9)
+8.985628309909062d-21
+
+(/ -9.42226868788213d-11 7.501937454180854d9)
+-1.2559780383974101d-20
+
+(/ -4.8165035309367155d-11 9.484620130429997d-11)
+-0.5078225026096383d0
+
+(/ 6.880022773725747d-11 -9.699156104509544d-11)
+-0.7093424107822056d0
+
+(/ 1.5817962388036865d-11 -7.11651152335492d-11)
+-0.22227129593095693d0
+
+(/ -7.0140750853949335d-12 -4.4677941652531186d-11)
+0.15699190307254357d0
+
+(/ -2.6947489262085355d-11 8.365454450205894d-11)
+-0.3221282169723859d0
+
+(/ 8.703167674410303d-11 -4.88739813223768d-11)
+-1.7807363834354917d0
+
+(/ 1.165112061543483d-12 -5.899528740399518d19)
+-1.9749239520860124d-32
+
+(/ 7.126386981630328d-12 5.091741402945837d19)
+1.3995971942933598d-31
+
+(/ -7.132349854872655d-13 7.70347159367981d19)
+-9.258617712985763d-33
+
+(/ 4.507266517270466d-11 -1.6192737232544485d19)
+-2.7835111831566513d-30
+
+(/ -3.025128309814261d-11 -5.606736896306867d19)
+5.395523930874836d-31
+
+(/ -5.390258677516223d-11 6.628750121976767d18)
+-8.131636550373976d-30
+
+(/ -8.484515181627938d-11 6.226893371743352d-21)
+-1.3625598954575508d10
+
+(/ 5.110456708789676d-11 -7.434814854731122d-21)
+-6.873683889434922d9
+
+(/ -7.784815533665352d-11 -8.942884975553875d-21)
+8.705038200698988d9
+
+(/ 6.06871371776654d-11 -8.4720755768444d-21)
+-7.163195916657484d9
+
+(/ 6.395725883763629d-11 3.2465500186809204d-21)
+1.970006883295217d10
+
+(/ 8.23766365482318d-11 3.5665958051648335d-21)
+2.3096712116618633d10
+
+(/ -6.882125490660233d19 0.680553203393516d0)
+-1.0112545876418106d20
+
+(/ -8.955858402134752d19 0.11144092291315044d0)
+-8.03641801236189d20
+
+(/ 4.517225460957592d19 -0.5804969398143229d0)
+-7.781652496570381d19
+
+(/ -9.741926397385082d19 -0.9037000739789977d0)
+1.0780043819728059d20
+
+(/ 9.654390326446178d19 -0.061963385089831124d0)
+-1.558079874501655d21
+
+(/ 9.50855454738802d19 0.30375471599023185d0)
+3.130339727036138d20
+
+(/ 4.323538184184934d19 -2.6027608151521606d9)
+-1.661135421670383d10
+
+(/ 4.0554081767557594d17 4.814123702784068d9)
+8.423979995384136d7
+
+(/ 5.12727309625028d19 1.761988796449604d9)
+2.9099351293162037d10
+
+(/ -7.335661993746345d19 -4.961351435504d9)
+1.4785612527368061d10
+
+(/ 3.7135994768593306d18 3.273427798269768d8)
+1.1344681189614824d10
+
+(/ 1.3911083524706402d19 8.651242909451927d9)
+1.6079866985942366d9
+
+(/ 6.473382688386894d19 -3.700509647679497d-11)
+-1.7493219325738552d30
+
+(/ 7.25328632809461d19 6.793518758100849d-11)
+1.0676773828651782d30
+
+(/ 7.053090091571119d19 8.009021819073383d-11)
+8.806431360661643d29
+
+(/ -1.6322872380348074d19 -1.234889420758779d-11)
+1.3218084231637898d30
+
+(/ -7.716951191497702d19 -2.473367210466666d-11)
+3.12001839388891d30
+
+(/ -2.1174708383466066d19 -9.66632270128099d-11)
+2.1905650202077337d29
+
+(/ 4.0902039392392786d18 -5.029423690873208d19)
+-0.08132549951322827d0
+
+(/ 1.4562115759233494d17 4.2665150414889705d19)
+0.0034131171735308037d0
+
+(/ -3.309692589578652d19 1.1329455009949342d19)
+-2.9213166799922274d0
+
+(/ 3.059130103268258d19 -7.719433592654628d19)
+-0.3962894513632647d0
+
+(/ 5.622979366632147d19 -8.407251901594788d19)
+-0.6688248945610293d0
+
+(/ -7.457587910839625d18 1.102755747735572d19)
+-0.6762683328700153d0
+
+(/ 1.2026615920578564d19 -3.77964792582931d-21)
+-3.1819407935832407d39
+
+(/ -2.74643694419756d19 2.538907641816601d-22)
+-1.0817396028760112d41
+
+(/ 8.267361397156658d18 -4.986401395715489d-21)
+-1.6579815263689556d39
+
+(/ 9.876393891158812d19 -5.792612775193684d-22)
+-1.7049981199250076d41
+
+(/ 3.927461252713038d17 4.810589424292295d-21)
+8.164199656866003d37
+
+(/ 7.29943837795987d19 -4.8820727437034755d-21)
+-1.4951514983823475d40
+
+(/ -7.837850970911807d-21 0.41514160181315674d0)
+-1.8879945870708947d-20
+
+(/ 1.1499234744049124d-21 0.4643166529612681d0)
+2.4765932194571437d-21
+
+(/ -1.094368243984769d-21 0.9008053219044149d0)
+-1.2148776404552516d-21
+
+(/ 2.4821206327531197d-21 0.22988631081892086d0)
+1.0797165885654937d-20
+
+(/ -4.56226662576732d-22 0.6695285124602162d0)
+-6.814148375851899d-22
+
+(/ 6.442796853653397d-21 -0.0419134640377401d0)
+-1.5371663978553802d-19
+
+(/ -5.584403218169678d-21 -8.092869169805251d9)
+6.9003997235062955d-31
+
+(/ -9.796722996869492d-21 -3.2988270899833827d9)
+2.9697594719700335d-30
+
+(/ 9.441829923771915d-22 5.464575083746736d9)
+1.7278250877830762d-31
+
+(/ -6.419360319610147d-21 -7.333962810289677d9)
+8.752921831841952d-31
+
+(/ 7.973734412555454d-21 -9.367577614661436d9)
+-8.512055880994846d-31
+
+(/ 8.105484193881594d-21 -8.664550975192905d9)
+-9.354765431108951d-31
+
+(/ -5.3151708182942476d-21 -3.406928289732576d-11)
+1.560106455516696d-10
+
+(/ -7.026602845639829d-21 -9.92483846943868d-11)
+7.079815824989677d-11
+
+(/ -5.901970468193158d-21 2.074489043942647d-11)
+-2.8450236868815825d-10
+
+(/ -6.40466723844613d-21 -2.551008177490094d-11)
+2.510641594550906d-10
+
+(/ 8.056066940872177d-21 4.645883100460603d-11)
+1.7340227394170724d-10
+
+(/ 7.453765056481805d-21 6.956136187014756d-11)
+1.0715381148511711d-10
+
+(/ 7.357434693258832d-21 -7.093525088486332d19)
+-1.0372042956753416d-40
+
+(/ -3.3759558579798473d-21 9.991075630444324d19)
+-3.3789713769084054d-41
+
+(/ 6.908026973557955d-21 -4.20805893397862d19)
+-1.6416183998227845d-40
+
+(/ 5.181767322756247d-21 7.46986056263721d19)
+6.936899664063931d-41
+
+(/ -5.7217313601659264d-21 5.604979023134118d19)
+-1.0208301113260054d-40
+
+(/ -9.340193892824771d-21 9.147101848766205d19)
+-1.021109641857176d-40
+
+(/ 8.331002176099931d-21 2.0276444314093977d-21)
+4.108709617449606d0
+
+(/ -3.747505523684784d-21 4.394623185543803d-21)
+-0.8527478615259381d0
+
+(/ -3.310403953328861d-21 2.3420390876737627d-21)
+-1.413470838617356d0
+
+(/ 6.23845405853013d-21 -8.933620117412232d-21)
+-0.6983119918397873d0
+
+(/ -4.276770609150315d-21 6.853299965034864d-21)
+-0.624045442483205d0
+
+(/ -8.847946637724495d-21 6.33827952828724d-21)
+-1.3959539963860554d0
+
+;; ==== L O N G - F L O A T S ====
+
+; ---- Test von + ---
+
+(+ 0.31465012912061093874L0 -0.07221963987249409544L0)
+0.2424304892481168433L0
+
+(+ 0.7168586654865411176L0 -0.19348808923554474066L0)
+0.52337057625099637695L0
+
+(+ -0.64115701400120904706L0 0.70535558267169594756L0)
+0.0641985686704869005L0
+
+(+ -0.8607621650923123159L0 0.8368256394262067108L0)
+-0.023936525666105605082L0
+
+(+ 0.44168990042410450855L0 -0.6041911435521196045L0)
+-0.16250124312801509594L0
+
+(+ 0.0234267775301613878L0 -0.43594485933986284478L0)
+-0.41251808180970145698L0
+
+(+ -0.99559578594307881024L0 -9.836107054378142702L9)
+-9.836107055373738488L9
+
+(+ -0.72423071295455899397L0 9.238843039595790172L9)
+9.238843038871559459L9
+
+(+ -0.20719390117857393156L0 -9.029224604657100362L9)
+-9.029224604864294263L9
+
+(+ 0.20816015380514039224L0 -7.4782571284307568003L9)
+-7.4782571282225966468L9
+
+(+ -0.16613875159201114463L0 -1.203554507952656804L9)
+-1.2035545081187955556L9
+
+(+ -0.9837368636729942673L0 7.5892747601936916704L9)
+7.5892747592099548066L9
+
+(+ -0.92391870362276300936L0 -5.309205414965326826L-11)
+-0.9239187036758550635L0
+
+(+ -0.2308075581152660786L0 -2.5400598439608570973L-11)
+-0.23080755814066667704L0
+
+(+ 0.5668336039528930528L0 1.9300606943253841182L-12)
+0.56683360395482311353L0
+
+(+ -0.19685144163870526662L0 -8.548847281762266571L-11)
+-0.19685144172419373944L0
+
+(+ 0.053837363417219887007L0 -8.4734948552444605444L-11)
+0.053837363332484938454L0
+
+(+ 0.24539562474220232599L0 -1.3753029433519360674L-11)
+0.24539562472844929655L0
+
+(+ -0.83198492765474177585L0 -1.0728971972413839207L19)
+-1.0728971972413839208L19
+
+(+ 0.58494670591273850794L0 -2.6078285749436068966L19)
+-2.6078285749436068966L19
+
+(+ -0.6489422625947265175L0 5.675479528094312524L19)
+5.675479528094312524L19
+
+(+ 0.82416783003308421654L0 3.4337105673864461624L19)
+3.4337105673864461624L19
+
+(+ 0.5977825969561704576L0 9.447212597358366985L19)
+9.447212597358366985L19
+
+(+ 0.81709616259702447027L0 1.8840697606071622024L19)
+1.8840697606071622024L19
+
+(+ 0.99140689029640294337L0 -7.9441986163714183364L-21)
+0.99140689029640294337L0
+
+(+ 0.49487318874207713882L0 -2.377409962381832069L-21)
+0.49487318874207713882L0
+
+(+ 0.050320977002567080524L0 -1.3329877923173878127L-21)
+0.050320977002567080524L0
+
+(+ -0.25724170819862546218L0 7.609825486664252559L-22)
+-0.25724170819862546218L0
+
+(+ 0.3667308347763138993L0 4.077152141636570548L-21)
+0.3667308347763138993L0
+
+(+ 0.5130660492586603372L0 -5.091230019243679202L-21)
+0.5130660492586603372L0
+
+(+ 8.916053557053472733L8 0.59999700846599703845L0)
+8.916053563053442818L8
+
+(+ 1.250980635471676891L9 -0.46325398810664378442L0)
+1.2509806350084229029L9
+
+(+ -5.548594356609427516L9 -0.21577258386321002115L0)
+-5.5485943568252001L9
+
+(+ 1.06508055885340104636L9 0.8422978396429581549L0)
+1.065080559695698886L9
+
+(+ 6.225756677310580186L9 0.49531151031004978726L0)
+6.2257566778058916964L9
+
+(+ -2.273191688409860673L9 -0.80983784631745405196L0)
+-2.2731916892196985192L9
+
+(+ 5.688674258485728496L8 8.2409948814224157357L9)
+8.809862307270988585L9
+
+(+ -2.7544302700606018156L9 9.230174236450698873L9)
+6.4757439663900970574L9
+
+(+ -4.588747139238971857L9 6.342892129519977196L9)
+1.7541449902810053392L9
+
+(+ 1.5275587581475159762L9 4.3720035959575018324L9)
+5.8995623541050178087L9
+
+(+ 2.8881760807020099163L9 7.5622154923755766074L9)
+1.0450391573077586524L10
+
+(+ 6.1044519092512786468L9 1.3858854402983849103L9)
+7.490337349549663557L9
+
+(+ 4.8767035174458515886L9 6.3051681974292703475L-11)
+4.8767035174458515886L9
+
+(+ -9.4188975960705796466L8 -8.975187577611984141L-12)
+-9.4188975960705796466L8
+
+(+ -9.689819354179956828L9 -9.7453604450079548966L-11)
+-9.689819354179956828L9
+
+(+ 4.987209054002559248L9 9.284991248759031191L-11)
+4.987209054002559248L9
+
+(+ -3.5572071813296941216L9 -6.261737879308894803L-11)
+-3.5572071813296941216L9
+
+(+ -7.5872628366112743053L9 2.2152240842834943001L-11)
+-7.5872628366112743053L9
+
+(+ 7.0206128338340270845L9 5.9246012493594508704L19)
+5.9246012500615121536L19
+
+(+ 5.3017367315254228474L9 -1.0933628665004153848L19)
+-1.0933628659702417116L19
+
+(+ -6.339538144593375358L9 -8.0543624921112893224L19)
+-8.054362492745243137L19
+
+(+ -1.6010717980362600647L9 9.973849926670833376L19)
+9.973849926510726196L19
+
+(+ 3.2030522063397198562L9 -2.4396867565423101768L19)
+-2.4396867562220049562L19
+
+(+ 8.8622195973163761245L9 -6.4961266512803550736L19)
+-6.496126650394133114L19
+
+(+ 5.45529926142043848L9 6.939479435912862762L-21)
+5.45529926142043848L9
+
+(+ -4.484627189114150671L9 -1.6571134694524616111L-21)
+-4.484627189114150671L9
+
+(+ 8.813820141949620774L9 -2.8267147580155665537L-21)
+8.813820141949620774L9
+
+(+ -9.972890003927356798L9 -3.0273462676816521264L-21)
+-9.972890003927356798L9
+
+(+ 6.792889851253184185L9 -5.937539083879130763L-21)
+6.792889851253184185L9
+
+(+ -3.2663407400779399923L9 -4.0747082067253115984L-21)
+-3.2663407400779399923L9
+
+(+ -3.4242541190221825202L-11 -0.71988400153646663195L0)
+-0.71988400157070917316L0
+
+(+ -7.8906347145510431055L-11 -0.22021321631029436988L0)
+-0.22021321638920071702L0
+
+(+ -7.486719858997914782L-11 0.38102237422222776873L0)
+0.38102237414736057013L0
+
+(+ -2.6956794925506179954L-12 -0.49627581161649902356L0)
+-0.49627581161919470304L0
+
+(+ -8.312064814531952837L-11 0.5797009072836515581L0)
+0.57970090720053090995L0
+
+(+ -4.0305959593285763394L-11 0.16233584979062195143L0)
+0.16233584975031599183L0
+
+(+ 3.731977491280278192L-11 3.0305998235716452734L9)
+3.0305998235716452734L9
+
+(+ 2.7847304030282320388L-11 -6.146190065628934066L9)
+-6.146190065628934066L9
+
+(+ -1.1797664511795163538L-11 1.4888590774768513251L9)
+1.4888590774768513251L9
+
+(+ -3.736849276790130025L-11 1.9988395869145483342L9)
+1.9988395869145483342L9
+
+(+ 5.7818526942690563386L-12 3.5155514714363584847L9)
+3.5155514714363584847L9
+
+(+ 1.8183862272066184134L-11 -4.635399960322760982L9)
+-4.635399960322760982L9
+
+(+ 3.5539523819420841283L-11 4.3044646394847154864L-11)
+7.858417021426799615L-11
+
+(+ 8.719537619908441472L-11 -8.580989797275158101L-11)
+1.3854782263328337111L-12
+
+(+ 2.49701168436805957L-12 -2.6066406246366064513L-11)
+-2.3569394561998004944L-11
+
+(+ 4.2774640500882048993L-11 3.7620100241760410496L-11)
+8.039474074264245949L-11
+
+(+ 3.9907211434460210612L-11 9.72066373418363098L-11)
+1.3711384877629652041L-10
+
+(+ -7.851637932849992129L-11 4.9296626910685147652L-11)
+-2.9219752417814773637L-11
+
+(+ 3.14874349918113769L-11 -1.8148353890339025639L19)
+-1.8148353890339025639L19
+
+(+ -8.444922682942673745L-11 -5.0034364072191331772L19)
+-5.0034364072191331772L19
+
+(+ 4.762299619586316462L-12 -1.3412404578328588061L19)
+-1.3412404578328588061L19
+
+(+ -9.22833351501850052L-12 3.1000370791158631634L19)
+3.1000370791158631634L19
+
+(+ 6.1164399913981911425L-11 6.1863455383782109436L19)
+6.1863455383782109436L19
+
+(+ -8.413645565754525347L-11 -2.5034082588556447364L19)
+-2.5034082588556447364L19
+
+(+ 3.4875247204061292656L-11 -7.8682893445087250245L-21)
+3.487524719619300331L-11
+
+(+ -2.1647610944488691768L-11 -8.371089558230910183L-21)
+-2.1647610952859781326L-11
+
+(+ 5.7598234760228848032L-11 2.8011007358408259187L-21)
+5.7598234763029948767L-11
+
+(+ -9.268425959344303144L-11 -6.4655012698265179856L-21)
+-9.2684259599908532713L-11
+
+(+ 7.067467072298381137L-11 -3.8206328350148818058L-21)
+7.0674670719163178536L-11
+
+(+ 7.8912028748606542386L-11 8.456364925917236866L-21)
+7.891202875706290731L-11
+
+(+ -6.976183652817340798L18 0.08822040416435015717L0)
+-6.976183652817340798L18
+
+(+ -1.2414457404200743984L19 -0.85791705029429396234L0)
+-1.2414457404200743985L19
+
+(+ -8.9687515173878579424L19 -0.3328210335620137057L0)
+-8.9687515173878579424L19
+
+(+ -5.438581645592863998L19 -0.67774278184358142436L0)
+-5.438581645592863998L19
+
+(+ -5.4350840695201649084L19 -0.72739900682842943577L0)
+-5.4350840695201649084L19
+
+(+ 7.814697448090367615L19 0.24326892882624165414L0)
+7.814697448090367615L19
+
+(+ -2.4356768540932142124L19 6.5169042447583127604L9)
+-2.435676853441523788L19
+
+(+ -8.7464253032141704904L19 6.8315507162032823036L9)
+-8.7464253025310154184L19
+
+(+ -2.4810334273518910993L18 -7.638114077520272164L9)
+-2.4810334349900051768L18
+
+(+ -9.80334620432051716L19 4.474822777555302305L9)
+-9.8033462038730348824L19
+
+(+ -1.5185085475715921137L19 8.496315073274781452L9)
+-1.5185085467219606064L19
+
+(+ -9.3842548893937585184L19 -9.948865349103608366L9)
+-9.3842548903886450536L19
+
+(+ 5.9391253980818643888L19 5.6213951287112563564L-11)
+5.9391253980818643888L19
+
+(+ -4.8270749631022207188L19 6.506986668488438766L-11)
+-4.8270749631022207188L19
+
+(+ 8.953940231252599753L19 -1.7735448342981541823L-11)
+8.953940231252599753L19
+
+(+ -6.1065165153181616235L18 -1.8103764902203059955L-11)
+-6.1065165153181616235L18
+
+(+ -9.6224955477275161216L19 9.4659333494557267205L-11)
+-9.6224955477275161216L19
+
+(+ -9.2620034246522033504L19 -8.920063409062509698L-11)
+-9.2620034246522033504L19
+
+(+ 5.9633456897700879935L18 4.0390945943970882336L19)
+4.6354291633740970328L19
+
+(+ -6.1420542659063065884L19 -3.9869088703267959336L19)
+-1.01289631362331025216L20
+
+(+ 7.804124970286546613L19 8.061318173712112305L19)
+1.5865443143998658918L20
+
+(+ -7.763817772329800516L19 -4.9349702057713961232L19)
+-1.2698787978101196639L20
+
+(+ -3.1480955091040648274L19 -4.706529024129812914L19)
+-7.8546245332338777416L19
+
+(+ -4.7131343507844737428L19 5.4602299451983202032L19)
+7.470955944138464604L18
+
+(+ 5.9403761194093478956L19 -6.280541343011718101L-21)
+5.9403761194093478956L19
+
+(+ -3.763295388652278206L19 -9.963494853851408371L-21)
+-3.763295388652278206L19
+
+(+ 2.5136958358030666948L19 5.335607709622335287L-21)
+2.5136958358030666948L19
+
+(+ 6.2273952762016960176L19 -5.6012630121574213906L-21)
+6.2273952762016960176L19
+
+(+ -9.3934610912833028936L19 -2.59552531586503232L-21)
+-9.3934610912833028936L19
+
+(+ 2.9584554660239488776L19 6.875837450751388893L-21)
+2.9584554660239488776L19
+
+(+ -8.4905558825256936576L-21 0.112912972443893420624L0)
+0.11291297244389342062L0
+
+(+ -5.3259362300699140443L-21 0.44064771529278198132L0)
+0.44064771529278198132L0
+
+(+ -9.245572241572266517L-21 0.043497459079983070442L0)
+0.043497459079983070432L0
+
+(+ 7.6311333407948593004L-22 0.74437178299084331024L0)
+0.74437178299084331024L0
+
+(+ -7.71114100404407176L-21 -0.30667849853816871164L0)
+-0.30667849853816871164L0
+
+(+ 3.544120177696956032L-21 0.79322122717232419205L0)
+0.79322122717232419205L0
+
+(+ 7.7913861181291523115L-21 8.526554352243632931L9)
+8.526554352243632931L9
+
+(+ -3.9196632415032070805L-21 -2.5228304289307799614L9)
+-2.5228304289307799614L9
+
+(+ 7.643174046933518012L-22 2.9248526891356128762L9)
+2.9248526891356128762L9
+
+(+ 1.8801815336593227227L-21 6.8178694125314363L9)
+6.8178694125314363L9
+
+(+ -2.6985037225367287349L-21 -4.5571976978858014136L9)
+-4.5571976978858014136L9
+
+(+ 6.0444611510506986126L-21 -8.64585025875790907L9)
+-8.64585025875790907L9
+
+(+ -1.250177749198396931L-21 6.428634063301101147L-11)
+6.428634063176083372L-11
+
+(+ -1.5666058964343815161L-21 3.552568414787808555L-11)
+3.5525684146311479653L-11
+
+(+ -5.8078119773790503857L-21 8.896395897015492877L-12)
+8.8963958912076809L-12
+
+(+ 6.7472260162031965506L-21 -6.617115409846031908L-11)
+-6.617115409171309306L-11
+
+(+ -4.16121984125470857L-21 -3.095053467302410671L-11)
+-3.095053467718532655L-11
+
+(+ -2.114411383443366621L-21 9.716046816037651671L-11)
+9.716046815826210533L-11
+
+(+ -2.3406730990296292957L-21 7.900725768498098123L18)
+7.900725768498098123L18
+
+(+ -4.1514248667302411754L-21 -8.4325334951006246184L19)
+-8.4325334951006246184L19
+
+(+ 8.433933541545648577L-21 -4.9459088765496691632L19)
+-4.9459088765496691632L19
+
+(+ 2.2922577085250648752L-21 7.813245819908182463L19)
+7.813245819908182463L19
+
+(+ 8.887270525300553388L-21 8.651116139112459977L19)
+8.651116139112459977L19
+
+(+ 1.1406539199130032192L-21 2.3931812472136783544L19)
+2.3931812472136783544L19
+
+(+ -3.778523001798117503L-21 2.0779948578933832532L-22)
+-3.5707235160087791776L-21
+
+(+ -1.6066062689688361383L-21 -3.5232009896946632975L-21)
+-5.1298072586634994358L-21
+
+(+ 3.9703618511174300454L-21 -8.036088455194107478L-21)
+-4.0657266040766774324L-21
+
+(+ 6.46657477279861825L-21 2.6384883907642781157L-21)
+9.105063163562896366L-21
+
+(+ 4.9706631077050274314L-21 2.3628052244020145395L-21)
+7.333468332107041971L-21
+
+(+ 7.065951142271372955L-21 3.1965272324939519L-21)
+1.02624783747653248544L-20
+
+; ---- Test von - ---
+
+(- 0.3211111183819802968L0 -0.7024866236309383056L0)
+1.0235977420129186024L0
+
+(- -0.29770116676264721836L0 0.8494818768850108081L0)
+-1.1471830436476580264L0
+
+(- -0.7677860965279355367L0 0.9474539728585997539L0)
+-1.7152400693865352905L0
+
+(- -0.25414380069764370257L0 0.82619594943351718565L0)
+-1.0803397501311608883L0
+
+(- 0.21685951051311267031L0 0.13084151170902027524L0)
+0.08601799880409239507L0
+
+(- -0.6658362643286463323L0 -0.101768362258000388376L0)
+-0.56406790207064594393L0
+
+(- -0.8594165074009265017L0 3.58724520062188585L9)
+-3.5872452014813023575L9
+
+(- -0.58779846333918551446L0 -2.8410824560251060135L9)
+2.84108245543730755L9
+
+(- 0.37819983918255152712L0 1.75837003745458279L9)
+-1.7583700370763829509L9
+
+(- -0.19345242719447268632L0 -8.900743696911070234L9)
+8.900743696717617807L9
+
+(- 0.9170636757513836193L0 -5.181144559509726756L9)
+5.1811445604267904316L9
+
+(- 0.20643137049004858552L0 3.3215544303850617772L9)
+-3.3215544301786304067L9
+
+(- -0.4014437452394343757L0 4.7898418688154180505L-11)
+-0.40144374528733279438L0
+
+(- 0.0725076594551243524L0 -3.5321788599004111594L-11)
+0.072507659490446140996L0
+
+(- -0.65551702819898271043L0 3.1653130032883009534L-11)
+-0.6555170282306358405L0
+
+(- 0.9237105409310637695L0 -8.9028024814928743296L-11)
+0.9237105410200917943L0
+
+(- 0.8779771368966066218L0 7.399233988536237696L-12)
+0.8779771368892073878L0
+
+(- 0.51385216558296334914L0 -3.3989256599054576304L-11)
+0.51385216561695260575L0
+
+(- 0.74939199427992763254L0 -6.6998781480191798724L19)
+6.6998781480191798724L19
+
+(- 0.8073774220299670944L0 2.0433771569275457978L18)
+-2.043377156927545797L18
+
+(- -0.75286822781531276375L0 -7.7011647701976081504L19)
+7.7011647701976081504L19
+
+(- -0.6361916050116532222L0 1.2717052281488651182L19)
+-1.2717052281488651183L19
+
+(- 0.08977643006115956575L0 1.2624046205072289204L19)
+-1.2624046205072289204L19
+
+(- -0.4220171145412169327L0 8.9155115345908061576L19)
+-8.9155115345908061576L19
+
+(- 0.397772867452284942L0 5.7785851646148710778L-21)
+0.397772867452284942L0
+
+(- -0.53062845978690011166L0 -3.648685738612220277L-21)
+-0.53062845978690011166L0
+
+(- 0.25409096540159836552L0 -7.8088660109317384514L-21)
+0.25409096540159836552L0
+
+(- 0.78038095936361252965L0 5.166705522400390383L-21)
+0.78038095936361252965L0
+
+(- 0.2384997171475220939L0 9.580584601627251829L-21)
+0.23849971714752209389L0
+
+(- 0.38777493167494073L0 -7.930455614605653916L-22)
+0.38777493167494073L0
+
+(- 9.34906594120583919L8 -0.06276538462885111519L0)
+9.349065941833493036L8
+
+(- 3.8000098261497040978L9 0.08156195452126583918L0)
+3.8000098260681421433L9
+
+(- -8.5084000619874580647L9 -0.49084164337509169664L0)
+-8.5084000614966164213L9
+
+(- -9.367354572017391158L9 0.7369625068937909906L0)
+-9.367354572754353665L9
+
+(- 6.810025547716964613L9 -0.65456201729278556224L0)
+6.8100255483715266306L9
+
+(- -2.0476539871173359762L9 -0.61684944260168028793L0)
+-2.0476539865004865336L9
+
+(- 7.927587886187347037L9 -9.075678068210342653L9)
+1.700326595439768969L10
+
+(- 8.3881162961959078424L9 -8.168276983460029623L9)
+1.6556393279655937465L10
+
+(- -9.837108887605194379L9 -5.518197215327419734L9)
+-4.3189116722777746445L9
+
+(- 6.0530403690423784372L9 -4.794777582812792957L9)
+1.0847817951855171394L10
+
+(- -7.6786817362598780694L8 3.0685743382723052597L9)
+-3.8364425118982930668L9
+
+(- -1.035869943077157163L9 6.964469962306024778L8)
+-1.7323169393077596407L9
+
+(- -5.236689202734255992L9 -3.2118444581504684365L-12)
+-5.236689202734255992L9
+
+(- -5.374622629137047618L9 6.0449117144963868685L-11)
+-5.374622629137047618L9
+
+(- -1.03444332932187716727L9 -7.849504746710041045L-11)
+-1.0344433293218771672L9
+
+(- 5.1103879354813158946L8 6.53093826849017485L-11)
+5.110387935481315894L8
+
+(- -9.748335199611953219L9 -1.0598402609119659922L-11)
+-9.748335199611953219L9
+
+(- -7.3482164921795502603L9 7.644598674874161005L-11)
+-7.3482164921795502603L9
+
+(- -7.4770248834652064083L8 -6.510822784079429222L19)
+6.5108227840046589732L19
+
+(- 8.3114910321533068423L9 -6.2387352982669333472L19)
+6.2387352990980824504L19
+
+(- -1.0718584220381511548L9 8.521462332927085385L19)
+-8.521462333034271227L19
+
+(- -1.9155322368803175137L8 1.3150623743950738752L19)
+-1.3150623744142291976L19
+
+(- 3.8652241507510457716L9 8.702412273358053775L19)
+-8.70241227297153136L19
+
+(- 2.922009617968977308L8 -8.409184530486676791L19)
+8.409184530515896887L19
+
+(- -7.3431860804237713437L9 9.020687655591526829L-21)
+-7.3431860804237713437L9
+
+(- -1.1188563145822172016L9 -2.7575065881283248758L-21)
+-1.1188563145822172016L9
+
+(- 2.5835681218682880315L9 -3.786022710650191692L-21)
+2.5835681218682880315L9
+
+(- 4.3854765424506375063L9 1.8847509423241615905L-21)
+4.3854765424506375063L9
+
+(- -3.4713769831512517224L9 -2.322290027198980782L-21)
+-3.4713769831512517224L9
+
+(- 414355.71501652302632L0 3.5411352752491676944L-21)
+414355.71501652302632L0
+
+(- 9.032857346451659148L-11 0.45111022909893884074L0)
+-0.45111022900861026729L0
+
+(- -6.5860623447077106086L-11 -0.16349916999618723413L0)
+0.16349916993032661068L0
+
+(- -9.239429491581222244L-11 0.34742997377809253703L0)
+-0.34742997387048683193L0
+
+(- -1.3189202177704638207L-11 0.6447775025861344695L0)
+-0.64477750259932367166L0
+
+(- -8.6095719029859522596L-11 0.36611643318066821885L0)
+-0.3661164332667639379L0
+
+(- -7.9284738631391966236L-11 -0.28883099180012157807L0)
+0.28883099172083683944L0
+
+(- -9.9602023259578447484L-11 8.944817052366967221L9)
+-8.944817052366967221L9
+
+(- -4.7036434158090755064L-11 -7.652311009876441256L9)
+7.652311009876441256L9
+
+(- -7.237899450242616437L-11 -2.0865196011945540415L9)
+2.0865196011945540414L9
+
+(- 1.619466049424876382L-11 5.1184733211578935236L9)
+-5.1184733211578935236L9
+
+(- 4.1799408897021043963L-11 7.3289378733409777703L9)
+-7.3289378733409777703L9
+
+(- -7.1652994078281664426L-11 -8.756819754593247181L9)
+8.756819754593247181L9
+
+(- -3.7074082585707708083L-11 7.8185038704847907146L-11)
+-1.1525912129055561523L-10
+
+(- -6.236585731179139659L-11 7.2778046100364844843L-11)
+-1.3514390341215624144L-10
+
+(- 4.435573645212270856L-11 -5.0777570123416204425L-11)
+9.5133306575538912986L-11
+
+(- -8.308776483243665939L-11 9.147453931535851365L-11)
+-1.7456230414779517304L-10
+
+(- 9.9047307392438733836L-11 -2.5521271062995892868L-11)
+1.245685784554346267L-10
+
+(- 7.964304540045338675L-11 -8.2763721216842256806L-11)
+1.6240676661729564355L-10
+
+(- 6.3981149909251410836L-11 -8.199461198383311753L19)
+8.199461198383311753L19
+
+(- 3.2676777703423324814L-11 4.4068061681801047868L19)
+-4.4068061681801047868L19
+
+(- -6.239367423070186989L-11 3.6883672788938434168L19)
+-3.6883672788938434168L19
+
+(- -2.2122757699951901351L-11 2.1264312306673926188L19)
+-2.1264312306673926188L19
+
+(- 8.873182931301984606L-11 1.6930709481447417272L19)
+-1.6930709481447417272L19
+
+(- -6.88393272917067128L-11 9.590650870092490293L19)
+-9.590650870092490293L19
+
+(- 6.858643038376546876L-11 7.344128953107545512L-21)
+6.858643037642133981L-11
+
+(- 2.6458055358368033053L-11 5.403788941414579396L-21)
+2.6458055352964244111L-11
+
+(- -2.0808117056914325832L-11 -9.598437242399057154L-21)
+-2.080811704731588859L-11
+
+(- -6.7475294377176982065L-11 7.066634775850918749L-21)
+-6.747529438424361684L-11
+
+(- -9.3542684131795074026L-11 -2.671834604826394793L-22)
+-9.354268413152789057L-11
+
+(- -3.656675383727620855L-11 -5.7226858095399702763L-21)
+-3.656675383155352274L-11
+
+(- 4.4004114393746579576L19 0.9981645829158248139L0)
+4.4004114393746579576L19
+
+(- -2.1157157847974045162L19 -0.73136590134089295135L0)
+-2.1157157847974045162L19
+
+(- -6.58288354566033103L19 0.6435204448077814454L0)
+-6.58288354566033103L19
+
+(- -6.1300052513232283715L18 0.37782114066015354996L0)
+-6.130005251323228372L18
+
+(- -8.3428987469650376416L19 0.092302889297602909923L0)
+-8.3428987469650376416L19
+
+(- 4.478146018721476673L18 -0.7594367116407568048L0)
+4.4781460187214766738L18
+
+(- 3.9553793567888621644L19 7.272309486263127643L9)
+3.9553793560616312156L19
+
+(- 8.4985452245750157485L18 -8.180191224624705388L9)
+8.498545232755206973L18
+
+(- -4.9006940756698268444L19 5.635530637330344937L9)
+-4.900694076233379908L19
+
+(- 3.321094625885548145L19 7.739325488496469393L9)
+3.3210946251116155962L19
+
+(- -4.094717236852398814L19 2.8833151826524522544L9)
+-4.0947172371407303324L19
+
+(- -7.297938416992967256L19 1.7849049534461509205L9)
+-7.2979384171714577512L19
+
+(- -1.6274534493365811085L19 -7.214220253590898893L-11)
+-1.6274534493365811085L19
+
+(- -8.8349360721401487896L19 4.4201546048906225832L-11)
+-8.8349360721401487896L19
+
+(- 2.1193875854469716176L19 5.4852102858193519493L-11)
+2.1193875854469716176L19
+
+(- 5.8956188285652689564L19 5.2591781987716878005L-12)
+5.8956188285652689564L19
+
+(- 3.8130742288947136824L19 -6.2032926048476626596L-11)
+3.8130742288947136824L19
+
+(- -8.2648264381835919784L19 5.240041099543619651L-11)
+-8.2648264381835919784L19
+
+(- -8.9795702979594840016L19 5.3071479395700422216L19)
+-1.4286718237529526223L20
+
+(- 7.4902067869555502376L19 8.527286348112666809L18)
+6.6374781521442835568L19
+
+(- -9.945686226441305483L19 -7.164943842935287866L19)
+-2.7807423835060176172L19
+
+(- -6.9451908461424534725L18 1.7337328244166615333L19)
+-2.4282519090309068806L19
+
+(- -7.2554820480127785552L19 -3.6345553532831870424L19)
+-3.6209266947295915128L19
+
+(- 4.80739562024854996L19 -9.8058600290712759904L19)
+1.46132556493198259504L20
+
+(- -2.2910115296639597206L19 3.7450560231732721633L-21)
+-2.2910115296639597206L19
+
+(- 6.3398397438838205245L18 5.9452907771459291318L-21)
+6.3398397438838205245L18
+
+(- -3.6223171453314706578L19 -7.3897558037422565484L-21)
+-3.6223171453314706578L19
+
+(- -5.253323265732561348L19 -2.4894382246759080012L-21)
+-5.253323265732561348L19
+
+(- 8.706482285826808214L18 -5.353671688426432468L-21)
+8.706482285826808214L18
+
+(- 2.2257683364797036278L18 -8.640543721759613242L-21)
+2.2257683364797036278L18
+
+(- 4.793610535063041737L-21 -0.46707949288138879385L0)
+0.46707949288138879385L0
+
+(- -8.1177127707349576126L-22 -0.524723160625887566L0)
+0.524723160625887566L0
+
+(- 4.3845050204409245572L-21 0.25137862247046227512L0)
+-0.25137862247046227512L0
+
+(- 9.521149905664397992L-21 -0.8412363166750659234L0)
+0.8412363166750659234L0
+
+(- 9.174773471390805996L-21 -0.101196005202611894716L0)
+0.10119600520261189472L0
+
+(- 7.109559498077443181L-21 0.9205539164614073537L0)
+-0.9205539164614073537L0
+
+(- 4.698785699006337068L-21 -2.1800327611972026394L9)
+2.1800327611972026394L9
+
+(- 5.613624265510662971L-21 -9.950548243828975189L9)
+9.950548243828975189L9
+
+(- 4.6909741937286841078L-21 -1.7837781830572891826L9)
+1.7837781830572891826L9
+
+(- -4.846242463794952647L-21 -8.0162418694778434667L9)
+8.0162418694778434667L9
+
+(- 2.40959428070040729L-21 -8.889381116534260471L9)
+8.889381116534260471L9
+
+(- 3.767840665510686708L-21 -6.5742819327593306936L9)
+6.5742819327593306936L9
+
+(- -4.2984578582437655097L-21 -7.11707524430297521L-11)
+7.117075243873129424L-11
+
+(- -8.2197602823824843314L-21 5.6157517586290544195L-11)
+-5.6157517594510304478L-11
+
+(- 9.693403466151038911L-21 -2.4790192993953556532L-11)
+2.4790193003646959998L-11
+
+(- -1.7473025967684817638L-21 -6.763791909706180161L-11)
+6.763791909531449901L-11
+
+(- -4.545821853960128388L-21 -2.0149758755990572603L-11)
+2.0149758751444750749L-11
+
+(- -6.727743751498960878L-21 4.6105155267302345166L-11)
+-4.6105155274030088917L-11
+
+(- 3.1693009676315354841L-21 -8.292132887357976433L19)
+8.292132887357976433L19
+
+(- -1.5197222855116101305L-21 -6.8790212191073234628L19)
+6.8790212191073234628L19
+
+(- 9.221684449614781083L-21 -5.9085200983462461748L19)
+5.9085200983462461748L19
+
+(- 8.784720275148798145L-21 -3.507151222326700691L19)
+3.507151222326700691L19
+
+(- 3.824100155304652155L-21 1.2903444775641864255L19)
+-1.2903444775641864255L19
+
+(- -1.0750770892330241413L-21 2.516785805333378789L19)
+-2.516785805333378789L19
+
+(- -9.607606672669937465L-21 2.8158700323501294737L-21)
+-1.2423476705020066939L-20
+
+(- 7.9685140548406097L-21 -1.4252185339263422407L-21)
+9.393732588766951941L-21
+
+(- -3.1900732903251523987L-21 1.30212230775860485605L-21)
+-4.4921955980837572548L-21
+
+(- 2.845180721925488069L-21 9.0340678136597289194L-21)
+-6.1888870917342408505L-21
+
+(- -5.1500491616497403683L-21 -5.4818765813663490764L-21)
+3.3182741971660870814L-22
+
+(- 5.3946808417918276896L-21 2.1630450195342998269L-21)
+3.2316358222575278627L-21
+
+; ---- Test von * ---
+
+(* 0.49162375558276684976L0 -0.27595139770835290185L0)
+-0.13566426249969417521L0
+
+(* -0.43085705615141429406L0 0.76537655129782028376L0)
+-0.32976788773950077688L0
+
+(* -0.34725675573811781168L0 -0.44040731024013641718L0)
+0.15293441375734052306L0
+
+(* -0.47158645084591665022L0 -0.5531952534025612003L0)
+0.26087938617692133303L0
+
+(* -0.86377959068682791106L0 -0.8711108145957097161L0)
+0.7524477428743513754L0
+
+(* 0.07688091831246728666L0 -0.727039245375017451L0)
+-0.055895444833634576195L0
+
+(* -0.65693719777446694155L0 -5.4929597366864347663L9)
+3.6085295769067602507L9
+
+(* 0.9553509506606886749L0 2.7316499794256227606L9)
+2.609684404716519364L9
+
+(* 0.86245066819702621825L0 -5.6471738746979076876L9)
+-4.8704088816580000957L9
+
+(* -0.0011095142242845852372L0 3.5868904614046262004L9)
+-3979705.9878791318615L0
+
+(* -0.07537979049336559763L0 8.268739091555253606L9)
+-6.2329582036573719373L8
+
+(* -0.67924101443000006024L0 -4.2094803212494913754L9)
+2.8592516836286270604L9
+
+(* 0.30774277681107480866L0 -2.7334742019139702906L-11)
+-8.412069412384417957L-12
+
+(* -0.35713749207523871768L0 -6.5398928539622633783L-11)
+2.3356409323048581577L-11
+
+(* -0.14801577485738927266L0 -9.963460779718656755L-11)
+1.474749367571264873L-11
+
+(* 0.3104124542612814659L0 -2.9286317751062608258L-11)
+-9.09083776938307737L-12
+
+(* -0.11446530018625016218L0 6.4232974401995419684L-11)
+-7.352446696780128213L-12
+
+(* -0.96939447601348607505L0 4.1094462170225605183L-11)
+-3.9836744622561876338L-11
+
+(* 0.051486415762180288123L0 9.676829213398296352L19)
+4.9822525214063672425L18
+
+(* 0.6313327973134614946L0 3.2653448877462378072L19)
+2.06151932217404323L19
+
+(* -0.37403303660944479204L0 9.102796469067070187L19)
+-3.4047466049628882508L19
+
+(* 0.8707828063294901403L0 -5.5603708853312765524L19)
+-4.8418753637615606188L19
+
+(* -0.21026381134874289964L0 -8.2572592232280544185L18)
+1.7362027955704909688L18
+
+(* -0.77817271482774886984L0 -5.862569134483721118L19)
+4.5620913392465632268L19
+
+(* 0.10774233598980040668L0 8.42277329172514105L-21)
+9.074892699629673044L-22
+
+(* 0.25190108887664378198L0 9.9261121984538427104L-21)
+2.5003984711022594346L-21
+
+(* -0.6756036645959631085L0 9.531794528346356556L-21)
+-6.4397153135265482465L-21
+
+(* -0.6857203923976410447L0 -1.6874445000752253093L-21)
+1.1571151047408247225L-21
+
+(* -0.44633489376857998266L0 2.2805928928283052886L-21)
+-1.0179081865499001544L-21
+
+(* 0.6194914893234261562L0 6.122106446320417613L-21)
+3.7925928402275834338L-21
+
+(* 6.0914569120648219218L9 -0.13082334282848865785L0)
+-7.969047559320230858L8
+
+(* 3.6214037646489572409L9 -0.42724054260765242458L0)
+-1.5472105094100157093L9
+
+(* -2.3587970682548096273L9 0.30389573937962490564L0)
+-7.168283791037869264L8
+
+(* -1.2092840284272862272L9 -0.9464357317324953064L0)
+1.1445096143169982957L9
+
+(* 9.742195251878672378L9 -0.8436238049826486367L0)
+-8.2187478272737786206L9
+
+(* -1.6670311480587791415L9 -0.7664626357070004785L0)
+1.277717087546798815L9
+
+(* -9.63709082566058824L8 3.5038182805272664595L9)
+-3.376661500605117691L18
+
+(* -6.819958133674458717L9 5.570090504807835795L9)
+-3.7987784043567071428L19
+
+(* 5.7990616985027046753L9 5.7633314369957429715L9)
+3.3421914592058566914L19
+
+(* -8.4466610113280742876L9 -8.965949996407538079L9)
+7.5732340264172639616L19
+
+(* -7.670563670654851578L9 -6.431751468798164421L9)
+4.9335159155244181172L19
+
+(* 8.268803418474998627L9 -6.6310260568279516366L9)
+-5.4830650926695757004L19
+
+(* -9.461472353405244053L9 -3.3101188730107237675L-11)
+0.31318598203475886787L0
+
+(* 6.8579221981166585744L9 -8.515361268298587097L-11)
+-0.5839768506684770405L0
+
+(* 1.6137913170162297342L9 -8.897666779537493419L-11)
+-0.14358977390521366923L0
+
+(* 8.022366744559274285L9 6.8759798363047156095L-11)
+0.5516163197503107306L0
+
+(* 6.268637730252729325L8 3.8798987053952144677L-13)
+2.4321679414199160154L-4
+
+(* 8.165455714479826517L9 -7.748491839935670887L-11)
+-0.6326996697300302909L0
+
+(* -9.245309913477613381L9 -2.7267702243723164598L19)
+2.5209835787164953515L29
+
+(* 9.113617507957836761L9 -3.6781774780542862056L19)
+-3.3521502661371744663L29
+
+(* 3695599.756951605604L0 -4.4160607831464309996L19)
+-1.6319993156879467502L26
+
+(* -3.1080975558777002585L9 4.5635619314557275256L19)
+-1.41839956852540638L29
+
+(* 4.379846040113489209L9 -2.380244519018666713L19)
+-1.0425104531125744157L29
+
+(* 7.799437686108443071L9 -8.213835920178370665L19)
+-6.40633014233504056L29
+
+(* -5.0032293022496024175L9 3.9947928432298324106L-21)
+-1.9986864609664499789L-11
+
+(* 5.1002825856458055377L9 -8.630588067810955288L-21)
+-4.4018438026138695895L-11
+
+(* -1.4798783656292287931L9 -2.1821599778945012917L-21)
+3.2293313416280286032L-12
+
+(* 6.2153176651245460436L9 -4.842239650508967686L-21)
+-3.009605763857489489L-11
+
+(* 1.1476929860538426329L9 8.143327858153323155L-21)
+9.34604026593943011L-12
+
+(* -6.8097130569212408313L9 -4.5006072118169309446L-21)
+3.0647843694383655263L-11
+
+(* -8.088711469864653681L-11 0.55856748494727835656L0)
+-4.518091222186502735L-11
+
+(* 4.4880121763658923538L-11 0.14537105272497022953L0)
+6.52427054720794526L-12
+
+(* 2.0273639671422034382L-11 0.5267742506127895251L0)
+1.0679631345107062621L-11
+
+(* -9.078881981481347403L-11 0.86040896737522678964L0)
+-7.811551470607918988L-11
+
+(* -7.2713602444015266416L-11 0.029963115152720655096L0)
+-2.1787260431991794891L-12
+
+(* 5.8587076221559354985L-11 0.39205420166003709617L0)
+2.2969309395639195554L-11
+
+(* 9.465227148840012531L-12 -8.4020295562921954743L9)
+-0.07952711826157309293L0
+
+(* -9.156088652050785426L-11 -7.272635024207867507L9)
+0.66588891015656744834L0
+
+(* 3.6865969618651574387L-11 4.532198690564411727L9)
+0.16708389923204005057L0
+
+(* -7.773548969171738747L-11 6.487140494299404015L9)
+-0.5042810430233337584L0
+
+(* 3.181536837232243521L-12 -8.8275599983550392825L8)
+-0.0028085207317644360498L0
+
+(* 3.512130320642090343L-11 -6.775467122704530228L9)
+-0.23796323518164203024L0
+
+(* -7.489684894543042722L-11 1.3562671200654034619L-11)
+-1.015801336211924759L-21
+
+(* -6.615171167169027831L-11 6.4492881876773102747L-11)
+-4.2663145267886736825L-21
+
+(* 5.9969037329081164062L-12 6.979117807067958578L-11)
+4.1853097629611348155L-22
+
+(* -9.1419010578306515213L-11 -3.0321662473944421986L-11)
+2.7719763824573648138L-21
+
+(* 8.653994294784604749L-11 -2.618325063862645785L-12)
+-2.2658970164558872502L-22
+
+(* 3.778177082827084054L-11 5.7986141594804582746L-11)
+2.1908191129505701787L-21
+
+(* 9.107023861930220456L-11 -8.1609888558011610015L18)
+-7.432232024672778029L8
+
+(* -6.185675579794400257L-11 8.145498215172660237L19)
+-5.0385409394852397568L9
+
+(* -5.0086846264250856304L-12 7.333671928137704804L19)
+-3.6732049841708537418L8
+
+(* -6.133300578664362783L-11 -4.647031661618042392L19)
+2.8501641979273554706L9
+
+(* 4.014159298839782726L-12 7.077385833663047478L18)
+2.8409754155675469803L7
+
+(* 3.9529027598797003857L-11 3.1931221840357166776L19)
+1.2622101493907881026L9
+
+(* 5.2407793550579649295L-11 8.178146405814506225L-21)
+4.2859860846234161862L-31
+
+(* -4.5792905534935737864L-11 -1.1970719995732820388L-21)
+5.481740499497593831L-32
+
+(* 4.113879746633747024L-11 5.1093090279978304893L-21)
+2.1019082929573231173L-31
+
+(* 1.9918804321687295055L-11 1.8243807936344826748L-21)
+3.6339484036649830696L-32
+
+(* -6.1549842617771214656L-11 7.210193834294849238L-22)
+-4.4378629574447235495L-32
+
+(* -3.483482946766538465L-12 7.8771698631837073084L-22)
+-2.743998688718375137L-33
+
+(* -3.0540130142847980374L19 -0.08015004741507677209L0)
+2.4477928790118809798L18
+
+(* -7.721729897125586787L19 -0.71282981020428696123L0)
+5.5042792570168003116L19
+
+(* 6.855667806362567159L18 0.83087248440613607433L0)
+5.69618574253563119L18
+
+(* -1.0247670372283575993L17 -0.21215039186338500874L0)
+2.1740472851667611836L16
+
+(* -4.2451902701279432204L19 0.363650960045267158L0)
+-1.5437675173068535736L19
+
+(* -2.3286355030172533736L19 0.49713327148260372132L0)
+-1.1576421857055056984L19
+
+(* -6.1529172975127592432L19 -7.1685660040728041152L9)
+4.4107593764821477366L29
+
+(* 6.7120643409032119372L19 -2.1673488299796731996L9)
+-1.45473847960048627434L29
+
+(* 8.1354429987417636456L19 -7.205222753181797397L9)
+-5.861767900174770815L29
+
+(* 7.1263614941049137416L19 5.4835530180135407083L8)
+3.907778107845448494L28
+
+(* 5.0833800113097826724L19 -6.2188724451883454807L9)
+-3.1612891880755627472L29
+
+(* -7.0947371956905508468L19 -2.434705753418370145L9)
+1.7273597469339097183L29
+
+(* 6.6532780031620346828L19 -5.126482819920582625L-11)
+-3.4107915379365690604L9
+
+(* 3.3916052110984390742L19 1.2477416554656457027L-11)
+4.2318471007818771302L8
+
+(* -2.0596546301412947634L18 1.4681903489886446838L-11)
+-3.0239650502232254483L7
+
+(* 5.4448198096650564945L18 -8.328351500006325204L-11)
+-4.534637322908812735L8
+
+(* -9.0101064221252591136L19 -8.313725422339249255L-11)
+7.4907550819604901853L9
+
+(* 9.807792586975021252L19 -8.1013942555768171325L-11)
+-7.9456794524008327797L9
+
+(* -6.569928333884882197L17 1.8031274577764523257L19)
+-1.1846418174451330701L37
+
+(* 9.966374081256518232L19 1.1925741835931471136L18)
+1.1885640433338393863L38
+
+(* -5.1958776350000747272L19 9.541066943279536452L19)
+-4.957421634462466998L39
+
+(* 3.0864687811444473814L19 -7.292720897062086383L17)
+-2.2508755378381858676L37
+
+(* -4.9023499593352016396L19 -7.837521201177228469L19)
+3.8422271741879966693L39
+
+(* 1.1092141282192635266L19 -8.705681388875638857L19)
+-9.656464792316359058L38
+
+(* 9.719341608862581484L18 3.910223765755272544L-21)
+0.038004800546468552602L0
+
+(* 9.0834836835472717744L19 2.3217130663560934873L-22)
+0.021089242756124079488L0
+
+(* -8.9569500426805542816L19 -6.8114530414478270673L-22)
+0.061009844610312705923L0
+
+(* -6.250871904307721917L18 -1.7897852706103755451L-21)
+0.01118771846280218958L0
+
+(* -4.8350255195162635852L19 -5.4114390027140489403L-21)
+0.26164445675428065787L0
+
+(* -3.787718813779143278L19 4.715777953310022763L-22)
+-0.017862040875357275534L0
+
+(* -9.6946973380533561685L-21 0.29842171245928506197L0)
+-2.8931081813963549629L-21
+
+(* -1.5138229787560283214L-21 -0.63587548364028950173L0)
+9.626029187622732088L-22
+
+(* 6.9088409628577453984L-21 0.6675889882861618064L0)
+4.6122661486241942486L-21
+
+(* -5.9331491274547789645L-21 0.1840021396402183602L0)
+-1.0917121342561739605L-21
+
+(* 6.5714942924276749333L-21 0.042451475976117785684L0)
+2.789696320821885891L-22
+
+(* 8.381861494201174241L-21 -0.14355711097860731382L0)
+-1.2032758207303532943L-21
+
+(* 2.014342763215141127L-21 -1.2338457666735291661L9)
+-2.4853882910224610282L-12
+
+(* -5.670580024618139724L-21 -8.0192486381311308156L8)
+4.5473791139832611237L-12
+
+(* -1.9225557816894129732L-21 7.9269598913745234357L9)
+-1.5240022570382171054L-11
+
+(* 4.0368254062037218916L-21 -9.5325393449487114215L8)
+-3.848119701332554298L-12
+
+(* 4.2776037356780859957L-21 -5.1221437260809706463L9)
+-2.1910501137364030878L-11
+
+(* -6.7334467986153699064L-21 -7.7745493828541701813L9)
+5.2349514652656512034L-11
+
+(* -4.315187380180362795L-21 1.3410692406986483366L-11)
+-5.786965063410868682L-32
+
+(* 3.343397258359340776L-21 3.0757040339096610197L-12)
+1.0283300434498325547L-32
+
+(* 8.5537743863632264L-21 7.5263454541513394514L-11)
+6.4378660968641032133L-31
+
+(* -2.842610565794174946L-21 3.153716909493170071L-11)
+-8.9647890084490369953L-32
+
+(* 2.8400800161467519014L-22 2.0497242686367281441L-11)
+5.8213809339661880995L-33
+
+(* 9.982896581447590365L-21 1.6568727649785948007L-11)
+1.654038946139843086L-31
+
+(* 4.678227176611232891L-21 8.297236114758786796L19)
+0.38816355482824754693L0
+
+(* -2.7181316933272033506L-21 -7.7081523870452907184L19)
+0.20951773300223540615L0
+
+(* 3.755562697893016061L-21 -9.043255746258523336L19)
+-0.33962513948155180184L0
+
+(* -6.788248742851763723L-21 -2.3639021583849588926L19)
+0.16046755854881268057L0
+
+(* -4.100847017987407598L-21 -3.6481227061862975968L19)
+0.14960393120916230025L0
+
+(* -2.001548479939126796L-21 -8.705055796099425971L19)
+0.17423591196468091344L0
+
+(* -3.670443367722997441L-21 3.6588667206894740936L-22)
+-1.34296630883370731296L-42
+
+(* -6.6783435670093499397L-22 -8.113066551196750321L-21)
+5.4181845810903550342L-42
+
+(* 4.816859192586505112L-21 -1.1868626619923445382L-22)
+-5.716950323755514841L-43
+
+(* 4.6402358755296483015L-21 -4.244356902115351796L-22)
+-1.9694817165747535215L-42
+
+(* 9.3247068197076461794L-21 3.5271238356611001996L-21)
+3.288939568434245211L-41
+
+(* 8.7860048755888267426L-21 7.187872989134290154L-21)
+6.315268712764710716L-41
+
+; ---- Test von FLOOR ---
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.9677507664075728311L0 0.09829392666835353511L0))
+(-10 0.015188500275962520004L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.084596576622269801105L0 -0.78271578747309396924L0))
+(0 -0.084596576622269801105L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.97785517019559092334L0 -0.24687352093087197807L0))
+(-4 -0.009638913527896988987L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.36348468689259258175L0 0.5156866254701831051L0))
+(0 0.36348468689259258175L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.51463186192345608164L0 0.8683136279312965567L0))
+(-1 0.35368176600784047506L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.36128372948365635348L0 -0.5061584717303788097L0))
+(-1 -0.1448747422467224562L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.83188875677783952054L0 -6.988497329115560525L9))
+(0 -0.83188875677783952054L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.09110744229488624391L0 -9.792597852253288497L9))
+(0 -0.09110744229488624391L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.23616060202132526459L0 -1.5882829404848723914L9))
+(-1 -1.5882829402487117894L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.09652925723903261584L0 6.2261024177069773893L9))
+(-1 6.226102417610448132L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.5413601234707634158L0 9.144943549323542538L9))
+(0 0.5413601234707634158L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.57037258938648310115L0 4.436821091919698621L9))
+(-1 4.4368210913493260317L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.9973297751770725278L0 3.4051851548139874998L-11))
+(-29288562291 1.4506986275662661537L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.6604979952397203417L0 -4.3497555374342239963L-11))
+(-15184715315 -1.8114827519649365006L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.38589975187928444138L0 1.0289103184336123803L-12))
+(375056742036 3.5046726009323829848L-13)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.9402638162334174371L0 4.2262799834524861567L-11))
+(22248024738 1.7766010468098603481L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.8642082843541437474L0 8.911777256338402297L-11))
+(-9697373033 6.304376014060421794L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.7435773981922973139L0 5.910629837324535378L-11))
+(12580341159 1.1224045374678474888L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.7898063255151059068L0 1.2757118849664610875L18))
+(0 0.7898063255151059068L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.19544684487626281231L0 -3.6071314846523434156L19))
+(-1 -3.6071314846523434156L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.032130218136830583316L0 -3.367647816525978896L18))
+(0 -0.032130218136830583316L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.25693079625787854222L0 2.3815464531684079734L19))
+(-1 2.3815464531684079734L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -0.3975875412090936933L0 3.9957351306215043416L19))
+(-1 3.9957351306215043416L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.16223305219726616216L0 -5.3922124894358790612L19))
+(-1 -5.3922124894358790612L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.14869268750642991106L0 -4.676414410846522305L-21))
+(-31796302560686368198 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.4848921957991629974L0 7.275052251851656838L-21))
+(66651369504012501536 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.44996459510190342355L0 -3.96515259272563559L-21))
+(-113479767696052002376 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.7246909129638354568L0 -1.2540349367528059089L-21))
+(-577887339279675740320 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.83383904440522878455L0 3.5186204165781412753L-21))
+(236978970643311773536 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 0.26779759740636464572L0 -6.954613119627800336L-21))
+(-38506469418200611672 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.4845680268023566543L9 -0.2629469688312594538L0))
+(28464173061 -0.1240146549242767677L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.1612132433805581187L9 -0.09975641287987705455L0))
+(-61762578120 -0.083822638930812785824L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.6629628120558108524L9 0.35361739315194823028L0))
+(-10358548203 0.32784699422401302726L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.999024858613990497L9 -0.6086338795192380592L0))
+(11499564999 -0.48897756390533489348L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.2927999071819381092L9 -0.8483437666321241058L0))
+(-5060212707 -0.6341788853647631104L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.377925687006929662L9 0.3220507356662819166L0))
+(-13593900595 0.18712780555802854961L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.5387759396672939425L9 7.7154581598602048657L9))
+(-2 5.892140380053115789L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.64339842966998351L9 4.025489717604319313L9))
+(-2 2.4075810055386551162L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.811594948157823536L9 -7.834071766040306942L9))
+(0 -4.811594948157823536L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.4476035118893197435L9 3.0450117757143498866L9))
+(1 1.4025917361749698569L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.3465328576805684287L9 -4.603589573313564281L9))
+(1 -2.7429432843670041477L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.956277095163508632L9 -6.664438280281275845L9))
+(-1 -1.708161185117767213L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.367757792316331005L9 -7.8163461329531150714L-11))
+(-55879789840705743024 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.7778036898247465523L8 3.4933422750724630952L-11))
+(-13676883951274541565 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.667353710605079077L9 5.3863219342714070564L-11))
+(-123783052553596643928 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.6004002390836614547L9 -9.313678706634845693L-11))
+(70867811173061956036 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.439278803200832958L9 -6.7075776392225367144L-11))
+(140725598880953434976 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.207319097846486017L9 -5.7812820689283059893L-11))
+(159260852317369718528 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.564134292866958547L9 6.4508269927189105468L19))
+(-1 6.4508269919624971176L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.7520914080101070246L9 -4.4901662701989554116L17))
+(0 -5.7520914080101070246L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.801170739094381102L9 9.482698257311007893L19))
+(-1 9.482698256330890819L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.471594576665974082L8 3.1667053210759199935L18))
+(0 7.471594576665974081L8)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.4762144691604037974L9 -8.2417624342716462896L19))
+(0 -6.4762144691604037974L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.5263312844382694187L9 9.5950716135522835064L19))
+(-1 9.5950716129996503776L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.1312033848911460338L9 -8.61316266389637687L-21))
+(-363537008074414891396807786496 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.6279029713558476835L9 -4.516664720059022692L-21))
+(-581823786849847663134534270976 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.502075635961923785L9 -9.685834626464620576L-21))
+(-464810293545679143271024033792 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.4031562604294053729L9 3.412866773725220897L-21))
+(411137132932332056394984325120 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.3024038761755407723L9 2.485284435684751149L-21))
+(-1731151498959165530746191347712 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.136473603422627364L9 5.6959828635137213127L-21))
+(1077333578850898685241017237504 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.202208473677937235L-11 0.12393605769441814725L0))
+(-1 0.123936057612396062516L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.6757073154686102475L-11 -0.37237633673270687662L0))
+(0 -8.675707315468610247L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.6028622390057924218L-11 0.6499341232771672055L0))
+(0 5.6028622390057924218L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.5783899320025937576L-11 -0.7229560019811405793L0))
+(-1 -0.7229560019353566799L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.224213822400873615L-11 -0.87051303270552073176L0))
+(-1 -0.87051303263327859354L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.5008008233955830292L-11 -0.45974678868400245752L0))
+(0 -5.5008008233955830295L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.949553569817051437L-11 -4.9088361621296460857L9))
+(0 -5.949553569817051437L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.068981360820356321L-11 3.9567179334666110438L9))
+(0 9.068981360820356321L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.4621680776088405294L-13 4.3691679646970805987L9))
+(0 3.4621680776088405294L-13)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.005939678622022073L-11 -9.2132271371400602936L8))
+(-1 -9.213227137140060293L8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.8015601712459487755L-11 -4.769849366969915586L9))
+(-1 -4.769849366969915586L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.736177705951390388L-11 8.3701230195943479203L9))
+(0 8.736177705951390388L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.8368349664293751446L-11 1.7247862508910726963L-11))
+(-6 1.5118825389170610328L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.0922301210797840822L-11 2.9157326021078492393L-11))
+(-1 8.235024810280651572L-12)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.929248815922456709L-11 -6.9934608623319373425L-11))
+(1 -2.9357879535905193665L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.809298490106908006L-11 2.521478295865126635L-11))
+(3 1.244863602511528101L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.3620267190952160604L-11 -5.0806267993123045533L-11))
+(-2 -2.7992268795293930463L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.070716461299934103L-11 1.372581158818204212L-11))
+(-7 5.3735165042749538097L-12)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.459630170957188741L-11 -3.429772398019229389L19))
+(0 -7.459630170957188741L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.9725650506989118904L-11 -1.7770668980460508816L19))
+(-1 -1.7770668980460508816L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.3974118251214889016L-12 -5.69117448017374684L19))
+(-1 -5.69117448017374684L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.080192761938897539L-11 5.1550284925054312868L19))
+(0 9.080192761938897539L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.694299339180548789L-11 3.1601030797220572842L19))
+(0 7.694299339180548789L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.5788554873601060938L-11 5.5699367746931070664L19))
+(0 5.5788554873601060938L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.087371164243010522L-11 1.7025318283693090775L-21))
+(-24007605005 1.5007203773756006028L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.3575974688385316083L-11 -1.6670029902289832508L-21))
+(44136678290 -1.8066891019200848581L-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.0850282868697332469L-11 5.7344803128377181472L-21))
+(1892112672 1.4425616831217755076L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.848519351300913193L-11 -7.121687974823219785L-21))
+(13828911609 -2.300608125189343731L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.0260591554314098406L-12 1.7303586387117179437L-22))
+(17488046048 9.689796116124082976L-23)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.867643793784483945L-11 2.9831220978672803306L-21))
+(19669472456 9.594326475082730988L-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.453252855247919707L19 0.3964594556008910194L0))
+(238441856328540902016 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.9865852464762410773L17 0.8745495786051183551L0))
+(227155245977568008 0.08198902299422984579L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.8003655986843771616L19 -0.57075967601329721915L0))
+(-101625357264188433960 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 6.5463855676706502812L19 0.5124698839969514896L0))
+(127741859026189966704 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.053368905864221505L19 0.40679331708739617821L0))
+(197972006116659527920 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.5722362029533885376L19 0.1793174966141533504L0))
+(478047952085719142240 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.6056603867132043536L19 1.8364346532401849241L9))
+(-35970026895 8.274070785684816422L8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.473965171745108034L19 5.5749126908032718576L9))
+(4437675186 5.356910410798194379L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.405924011882179756L19 -6.4568556406242929674L9))
+(6823637165 -4.1798826632701602209L8)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.1093676314099077168L19 5.727620773112868108L8))
+(36827990451 1.8408274540307780489L8)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.0962340119185741432L19 -8.173187675545835245L9))
+(1341256380 -4.422519927692124746L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.664836922872330681L19 -4.5461452948374001435L9))
+(21259410546 -4.0088028420210172099L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.9654629946168490416L19 -6.27691916031617149L-11))
+(-1587636026543136775574879469568 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.2700534905234296955L19 -7.6392648594402208417L-11))
+(166253365198349054807791108096 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.837735447773461618L18 -8.6041613252133785413L-11))
+(91092381366746282195935035392 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.849306367034469812L19 -8.744903371098252931L-11))
+(-554529439749024491444258209792 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.3895751736590951245L18 -8.9218106166526971406L-11))
+(71617471477514379195326660608 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.1249006547358954392L19 -3.749899421128778124L-11))
+(299981553744522252727485464576 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.8298889769606521412L19 3.2897859420995047714L19))
+(-2 1.7496829072383574016L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.618272569239742257L19 -2.4246730847406800364L19))
+(3 -3.4425331501770214745L18)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.9344217376670949096L19 -2.187787768895506888L19))
+(4 -1.1832706620850673572L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.9222824564168688912L19 -9.476307993509074433L19))
+(-1 -5.5540255370922055412L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -2.012988112115775752L19 -1.01146191266402097525L18))
+(19 -9.1210478054135899006L17)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.6136075623649245696L19 -9.374471951386232653L19))
+(-1 -7.6086438902130808345L18)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.0954879593227223964L19 3.4785793369902262412L-21))
+(-11773449913223093127289481096658923028480 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.7633820540313762628L19 -6.9799216943629666126L-21))
+(8257086979479904139315172946770002968576 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -4.5945941433359568196L19 -9.26874309885338918L-21))
+(4957084357969034092339972319162935541760 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.069653875532044557L19 1.1607862998892810815L-21))
+(78133708817868823323292026086376001765376 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.9663881236128118596L19 -7.53224056983834607L-21))
+(-2610628411799403924128603371383036051456 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.8155182638858600344L19 -9.78280482738867461L-21))
+(-3900229362854759958152852242692868931584 0.0L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 2.0785751397779279812L-21 0.84874462118484074924L0))
+(0 2.0785751397779279812L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.468679817093889512L-22 -0.14230041428757812886L0))
+(-1 -0.14230041428757812886L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.5329587582370771722L-21 -0.75145077780984780047L0))
+(0 -3.5329587582370771722L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.0147425004279850959L-21 0.55049889413410685307L0))
+(0 1.0147425004279850959L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -9.214176537319943048L-21 -0.45008902557926736644L0))
+(0 -9.214176537319943048L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.146684367801419132L-21 0.3317375182580383851L0))
+(-1 0.3317375182580383851L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.8958965362796452575L-23 -8742129.925142999928L0))
+(-1 -8742129.925142999928L0)
+
+(MULTIPLE-VALUE-LIST (FLOOR -8.629925553125559817L-22 1.4904768761159059732L9))
+(-1 1.4904768761159059732L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.7636696713810751494L-21 1.2803675755746476424L9))
+(-1 1.2803675755746476424L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.8572218293550540256L-21 7.311951574932556098L9))
+(0 7.8572218293550540256L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.8831628670454666175L-21 -2.430599936529262355L9))
+(-1 -2.430599936529262355L9)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.891885696934149925L-21 6.0077688200842341403L9))
+(0 5.891885696934149925L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.5378511525885539255L-21 -4.317564477957860586L-11))
+(0 -5.5378511525885539255L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.9525004120740256159L-21 9.454884961900014292L-11))
+(-1 9.454884961704764251L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 5.461359828153347278L-21 -9.7061135180917529105L-11))
+(-1 -9.706113517545616928L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 9.644530490453124287L-21 8.28693431641614359L-11))
+(0 9.644530490453124287L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 8.997549905605484822L-21 5.2672865249640494307L-11))
+(0 8.997549905605484822L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -1.55338435917637846L-21 5.9708770769690056966L-11))
+(-1 5.9708770768136672606L-11)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.9285675924255819076L-21 5.674913585946206864L19))
+(0 3.9285675924255819076L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.6185336116295331734L-21 -9.043926006483480333L19))
+(0 -3.6185336116295331734L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.32672036508508268L-21 1.205614654464109627L19))
+(-1 1.205614654464109627L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -3.3565132746900103151L-21 8.585503247975515849L19))
+(-1 8.585503247975515849L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.9204354176156616745L-21 -3.6158709669328356396L19))
+(0 -6.9204354176156616745L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR -7.5176747956103960436L-21 9.3440027997860057096L19))
+(-1 9.3440027997860057096L19)
+
+(MULTIPLE-VALUE-LIST (FLOOR -6.302622462978502841L-21 8.1107309029375862425L-21))
+(-1 1.8081084399590834014L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 1.4803054325001667241L-22 6.3345497995208400772L-21))
+(0 1.4803054325001667241L-22)
+
+(MULTIPLE-VALUE-LIST (FLOOR -5.7089861270321677843L-21 9.540482421100450586L-21))
+(-1 3.831496294068282802L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 3.3765199428161524112L-21 9.669802014415968729L-21))
+(0 3.3765199428161524112L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 7.52101063082155294L-21 8.827949370572986921L-21))
+(0 7.52101063082155294L-21)
+
+(MULTIPLE-VALUE-LIST (FLOOR 4.196504310402249954L-23 3.785428476220113075L-21))
+(0 4.196504310402249954L-23)
+
+; ---- Test von / ---
+
+(/ 0.8476517865511829377L0 0.14598720922015648169L0)
+5.8063428370144327317L0
+
+(/ -0.16515392772872533974L0 0.2885771921352848653L0)
+-0.5723041606534907598L0
+
+(/ -0.25791761734650428572L0 -0.17472849542471660309L0)
+1.4761050664322265015L0
+
+(/ -0.9418668871216534004L0 -0.25801526180943099573L0)
+3.6504309106230792821L0
+
+(/ -0.25726582509610465451L0 0.7704327058756196045L0)
+-0.33392381078074095957L0
+
+(/ -0.021409432992321506645L0 -0.44293479613874918959L0)
+0.048335405524597819813L0
+
+(/ -0.26771090178828336857L0 -7.7011892538310270067L9)
+3.4762280599078659542L-11
+
+(/ 0.82867609196336006595L0 -3.0042819216966844948L9)
+-2.7583166745395210866L-10
+
+(/ 0.40732354689187331287L0 -7.559832309976744222L9)
+-5.387997116739304149L-11
+
+(/ -0.53349543673778000914L0 -5.104278761341346705L8)
+1.045192595628502556L-9
+
+(/ 0.17669669311850475256L0 -9.181879875841464834L9)
+-1.9244064996255633173L-11
+
+(/ -0.38525727576606363245L0 -4.8936643582468263693L9)
+7.872572525674472248L-11
+
+(/ 0.028580272067667963345L0 -7.9841173999044091L-11)
+-3.5796407587907142282L8
+
+(/ 0.72167998280372380157L0 -3.6437273419914776347L-12)
+-1.980609181391958688L11
+
+(/ -0.5863461999919387516L0 7.881986348526466578L-11)
+-7.4390664239294943926L9
+
+(/ 0.54541403791059564303L0 -2.6107257402815120583L-11)
+-2.089128051619026705L10
+
+(/ 0.7985324354238058011L0 9.752737902348257611L-12)
+8.187777047012979847L10
+
+(/ 0.14104671220162837288L0 -1.679932803469743255L-11)
+-8.3959734526470136372L9
+
+(/ 0.84226961154302812054L0 -3.7790325979515268584L19)
+-2.2287968936801211454L-20
+
+(/ -0.17023320737807742781L0 -7.0544793122604881768L19)
+2.4131222141684768152L-21
+
+(/ 0.51147038234753495475L0 7.2890488826322506176L19)
+7.01697012303244035L-21
+
+(/ 0.15424860911694467965L0 -9.2121691156562017736L19)
+-1.6744005367291526718L-21
+
+(/ 0.18043991101271504866L0 -1.5135729370916590423L19)
+-1.1921454631676461953L-20
+
+(/ -0.8669749687756526617L0 8.7133495928438747096L19)
+-9.949961946754488136L-21
+
+(/ -0.6448505560111598971L0 3.636469578348857873L-21)
+-1.7732873659951112376L20
+
+(/ -0.81857582399766609004L0 5.2916132942068490006L-21)
+-1.546930545536701092L20
+
+(/ 0.77524450276763022L0 -7.652595302708246449L-21)
+-1.0130478250865714831L20
+
+(/ 0.627858729575384142L0 9.627326573065363056L-21)
+6.5216311590796329432L19
+
+(/ -0.42943946308533227006L0 -2.2414950519882640498L-21)
+1.9158617490786266339L20
+
+(/ -0.34220208112358558038L0 -7.4545803279812700505L-21)
+4.5904942473972275588L19
+
+(/ 5.560943842255079481L9 -0.55841023848214400133L0)
+-9.958527725728472542L9
+
+(/ -8.661678305761957921L9 -0.87958882986448744696L0)
+9.847417351919312785L9
+
+(/ 3.6954900583503502368L9 -0.36989453222048823558L0)
+-9.9906587863470431315L9
+
+(/ 6.740385471899914443L8 -0.2745720588185960522L0)
+-2.454869406924301959L9
+
+(/ -5.1381279403866914758L9 -0.32555782051482221485L0)
+1.578253574821668073L10
+
+(/ -3.2065087686035281697L9 0.50505516522796299416L0)
+-6.3488287802308291444L9
+
+(/ -7.7979994067331648055L9 -6.4459990751639263853L9)
+1.2097425574847536075L0
+
+(/ -4.7272619195621447717L9 -3.825695015629283172L8)
+12.356609453314103588L0
+
+(/ -3.5376744034596315073L9 2.7483444719369282795L9)
+-1.2872019645217230068L0
+
+(/ -2.2400216393287578975L9 -3.7058330823204350567L9)
+0.6044583200509807153L0
+
+(/ 3.0621742151056386386L9 -8.846101104908494769L9)
+-0.34616088814613589822L0
+
+(/ 7.5149875074517868906L9 4.423024956398348232L9)
+1.6990606161017937287L0
+
+(/ 7.6970261502618782055L9 -9.7716080626747355186L-11)
+-7.876928854384493259L19
+
+(/ -8.725835744855911806L8 8.409822932470646079L-11)
+-1.0375766309139670758L19
+
+(/ 5.820797723708174118L9 -2.882166534035175912L-11)
+-2.0195910454760464445L20
+
+(/ 1.207852991950790034L9 5.840354579417081103L-11)
+2.068115857567237665L19
+
+(/ 3.1046967393071541823L9 -5.5642977043818474125L-11)
+-5.5796740294147564416L19
+
+(/ 4.392532668212736406L9 -7.535498815249885942L-11)
+-5.8291199771983175508L19
+
+(/ 1.3280881496906639524L9 -1.766515912740190632L19)
+-7.518121632035316941L-11
+
+(/ 1.4277961930808139626L9 -8.986506745304867108L19)
+-1.5888222571321021114L-11
+
+(/ -7.9134656119390343763L9 -3.4095849226963530828L19)
+2.3209469162249057589L-10
+
+(/ -8.7882725472722691335L9 -5.186325400713441962L19)
+1.6945085138821670647L-10
+
+(/ 3.8930727351090315925L9 -7.3980221641298868864L19)
+-5.2623155875161027887L-11
+
+(/ 9.998404421166073569L9 -8.1317115085820412065L18)
+-1.2295571984586471158L-9
+
+(/ 4.623792381028250544L9 6.996281129080973142L-21)
+6.6089287947690416075L29
+
+(/ 8.472924939037688662L9 -4.3460987737519244214L-22)
+-1.9495472560839050376L31
+
+(/ 1.9551595642940545935L9 -7.5324972045717692564L-21)
+-2.5956326450508222435L29
+
+(/ -8.5478772651240992225L9 -2.4212066230883777513L-21)
+3.5304204042779411337L30
+
+(/ 6.881700625121950854L9 -8.203099619911879591L-21)
+-8.389146717684109215L29
+
+(/ 6.097099876947129031L9 -4.76850418677518328L-21)
+-1.2786189627046213921L30
+
+(/ -5.0358061432469478737L-11 -0.6780392915138573621L0)
+7.427012278305451381L-11
+
+(/ -1.49762284327640383L-11 0.15227257119521089694L0)
+-9.835145171066142436L-11
+
+(/ -7.1678035946969115934L-11 0.75360681415553320054L0)
+-9.511330656861051013L-11
+
+(/ 4.583894304978394541L-12 0.68934670181533335835L0)
+6.6496210004445016106L-12
+
+(/ -3.8885547056166489716L-12 -0.010643810658165133798L0)
+3.6533482513930678043L-10
+
+(/ 9.49880444227161124L-11 -0.122629749019578004226L0)
+-7.745921783428843474L-10
+
+(/ 2.1990660545226500317L-11 -1.4161745224867819854L9)
+-1.552821364602098501L-20
+
+(/ 9.951737846856727225L-11 -6.0164204240154494783L9)
+-1.6540961477912788069L-20
+
+(/ -5.873282338412930208L-11 2.3788798751415933107L9)
+-2.4689276662460085614L-20
+
+(/ 2.2209512664584027642L-11 5.1944018613813348683L9)
+4.2756631576205975403L-21
+
+(/ -6.722318330051584872L-11 6.7936247801916195024L9)
+-9.895039169151724367L-21
+
+(/ -7.528877773200399613L-12 -9.535757813603057891L9)
+7.89541630604357328L-22
+
+(/ -2.0857643618410047184L-11 2.701544718271986855L-11)
+-0.77206360780699598463L0
+
+(/ 2.5510439626733908612L-11 1.6734405694946451074L-11)
+1.5244305708709866576L0
+
+(/ 3.048460642905138835L-11 5.1568899955161432057L-11)
+0.5911432366321058725L0
+
+(/ 9.876491787625061464L-12 8.667781903943973216L-11)
+0.113944858062604306884L0
+
+(/ 1.1166642175553123016L-11 -7.759981600144040302L-11)
+-0.14390036923986841014L0
+
+(/ -2.7282824760136843772L-11 -9.160281916489131182L-11)
+0.2978382653379466574L0
+
+(/ -3.1587174777348029438L-11 -4.9090150171793744104L19)
+6.4345239659701453497L-31
+
+(/ -4.512784364891002838L-11 5.9600731551720265308L19)
+-7.571692909465218857L-31
+
+(/ -1.431681316436341718L-11 -4.22349605246125618L19)
+3.3898014788057508284L-31
+
+(/ -6.719040537613210677L-11 -4.545488183802435408L19)
+1.47817797911258332435L-30
+
+(/ 2.5092238442261623676L-11 3.3004591427193857704L19)
+7.602650830449936487L-31
+
+(/ -6.198495042920933878L-12 1.8747110273916984954L19)
+-3.306373596972410786L-31
+
+(/ 8.3326031863190006605L-11 6.3679312781687389584L-21)
+1.3085259281747860217L10
+
+(/ 2.228308172351851791L-11 -4.6204647093882084617L-22)
+-4.822692764700068564L10
+
+(/ 9.7676469315043868665L-11 -6.6370355345926113967L-21)
+-1.4716882078745621587L10
+
+(/ -8.9713798012161717115L-11 -3.669192301028840519L-21)
+2.445055768459069116L10
+
+(/ 7.214258511983827207L-11 -1.5195990661514104949L-21)
+-4.7474749574931692373L10
+
+(/ 1.4822028144092954099L-12 2.269595713994387529L-21)
+6.530690929974856047L8
+
+(/ -4.6354687290142894644L19 0.032331325634476806982L0)
+-1.4337391486574910728L21
+
+(/ -2.389352438897577318L19 0.8660312577952003013L0)
+-2.7589678979723536864L19
+
+(/ -2.4109458405628950432L19 0.26688102636777617506L0)
+-9.0337851040803631776L19
+
+(/ 8.961066349333904704L19 -0.66178143682771294813L0)
+-1.35408245844568974384L20
+
+(/ 6.6419769467305502364L19 -0.8456142496793601811L0)
+-7.854618047471472417L19
+
+(/ 3.7389082257286159308L19 0.56261989685796304976L0)
+6.645531462021022254L19
+
+(/ 7.814283695666500025L19 -4.6620013293904720047L9)
+-1.6761650509199167363L10
+
+(/ 6.6434731737611309404L19 -2.858805223329136325L9)
+-2.323863521567472329L10
+
+(/ -1.3409334390407788129L19 6.1497605350647401055L9)
+-2.1804644772671013651L9
+
+(/ 7.0858597943822241668L19 -2.58410378455919273L9)
+-2.7420956684179617314L10
+
+(/ -6.6455998228898640428L19 -7.7545004942277582046L9)
+8.569990843171226794L9
+
+(/ 2.9602494058183339616L19 -5.7169856186590364077L9)
+-5.1779899465842692843L9
+
+(/ -6.698311323164055808L19 -6.553232827426109497L-11)
+1.02213846197113193186L30
+
+(/ -7.554561034956199475L19 6.4764910162760040714L-11)
+-1.1664589692120175174L30
+
+(/ 6.7796490729162210612L19 9.9915237995070190003L-11)
+6.785400514434773617L29
+
+(/ -6.9067747658009050975L18 -2.5761632749585983355L-11)
+2.681031452058062687L29
+
+(/ 1.629413698021581386L19 -8.612780517302459862L-11)
+-1.8918555915226283107L29
+
+(/ 8.8732593909692189064L19 -4.0536919536865455935L-12)
+-2.1889328277398133904L31
+
+(/ 4.8426213700963381164L19 7.883038261101094331L19)
+0.61430900240485778846L0
+
+(/ -5.2968355222513127376L19 1.5071497411718048594L19)
+-3.5144719715328600349L0
+
+(/ -6.2610887651422622925L18 1.0358424497888766788L19)
+-0.60444411854509194816L0
+
+(/ -2.4670994205369878408L19 6.9747461294856021948L19)
+-0.3537188844920639511L0
+
+(/ 6.9460731069354980812L19 3.1486762233902586798L19)
+2.2060296499639734035L0
+
+(/ 8.8228286449463631936L19 6.7354354317536527728L19)
+1.3099121406987093833L0
+
+(/ 3.2098388728662261428L19 -2.6305167886064038438L-21)
+-1.2202312818412901165L40
+
+(/ -7.144492994496515916L19 -2.0335028635662185032L-21)
+3.5133921483478965099L40
+
+(/ -6.3695870249569899508L19 1.9319318539671607067L-21)
+-3.2970039869042198792L40
+
+(/ -5.4056057590545112688L19 6.6371220252553042967L-21)
+-8.144502599899959829L39
+
+(/ -4.5534797093596626272L19 9.223324048915255164L-21)
+-4.9369182793650108047L39
+
+(/ 3.9206183123968272208L19 -1.6559061178638737343L-21)
+-2.3676573629998072004L40
+
+(/ -8.768637785982664131L-21 -0.18184176456694917492L0)
+4.8221253279547290195L-20
+
+(/ 2.6823352573966718016L-21 -0.55524799130252431824L0)
+-4.830877912956219511L-21
+
+(/ -4.0350541003620172524L-21 0.27000304046926068644L0)
+-1.4944476526446376082L-20
+
+(/ 6.332356861830292899L-21 0.65544003241974460534L0)
+9.6612299350294242524L-21
+
+(/ 3.5603120340723305693L-21 -0.124100556644984066966L0)
+-2.86889288035778711L-20
+
+(/ 5.5961094005028721084L-21 0.47201702367299511838L0)
+1.18557363820414998006L-20
+
+(/ 1.7187188076305931646L-21 8.3685668129856246863L9)
+2.0537791548292745125L-31
+
+(/ -2.7220241842791803757L-21 2.2892422122227956846L9)
+-1.1890503196846804849L-30
+
+(/ -6.028203796038167925L-21 -5.415224539645905615L9)
+1.1131955382282900156L-30
+
+(/ 6.6310444174308960725L-21 9.461342958972558645L9)
+7.0085657460946591684L-31
+
+(/ -8.8033709586752979635L-21 2.8098765759657792274L9)
+-3.1330098389284241575L-30
+
+(/ -3.4027974212452472475L-21 6.219628754500815959L8)
+-5.4710619484849846614L-30
+
+(/ 8.388977931970215088L-21 2.8213325814913435694L-11)
+2.9734097947204223302L-10
+
+(/ -9.3496400462478483586L-21 -9.381494249123695733L-11)
+9.966045704415559596L-11
+
+(/ -6.936639418470504025L-21 5.6618206553549859367L-11)
+-1.2251605694909792675L-10
+
+(/ -2.3667892015182913211L-21 -7.1545639578577691874L-11)
+3.3080830857887236957L-11
+
+(/ -9.576766108065157562L-21 -6.4350290609494113365L-11)
+1.4882242204905008798L-10
+
+(/ -2.5955914883538434001L-22 5.8091383646322322124L-11)
+-4.4681178609147595716L-12
+
+(/ -2.9619491950657497217L-21 -5.3730670726011346488L19)
+5.512585558757694777L-41
+
+(/ 2.5726455340193007026L-22 3.0037766865540527038L19)
+8.564703047118500122L-42
+
+(/ -2.8277317971003367574L-21 -4.4068191966128705184L19)
+6.4167184332721487087L-41
+
+(/ 7.503784949731224261L-21 5.9540210967055505192L19)
+1.2602886062804146604L-40
+
+(/ 1.4876876016319254574L-22 8.6818746213386148185L18)
+1.7135557313571827969L-41
+
+(/ 2.699544264870480357L-21 3.6796341400587007856L19)
+7.3364474893892979093L-41
+
+(/ -7.285812539718203862L-21 5.700589904684711396L-21)
+-1.2780804551000530294L0
+
+(/ 3.6474102791520560028L-21 -6.343773677116707765L-21)
+-0.574959080319812269L0
+
+(/ -4.2510720089860863712L-21 -8.281980897162330288L-21)
+0.51329169455614642465L0
+
+(/ 5.770684998505203844L-21 6.5700291863604419324L-21)
+0.8783347584642853315L0
+
+(/ -4.8018196973750014744L-21 -7.3250029580209059804L-21)
+0.6555382605159211192L0
+
+(/ -3.9261100835261094614L-21 -8.986577968334144672L-21)
+0.436885997913830856L0
diff --git a/src/tests/number2.tst b/src/tests/number2.tst
new file mode 100644
index 000000000..59988ceda
--- /dev/null
+++ b/src/tests/number2.tst
@@ -0,0 +1,19 @@
+(gcd 2346026393680644703525505657 17293822570713318399)
+11
+
+(multiple-value-list (xgcd 77874422 32223899))
+(1 -9206830 22249839)
+
+(multiple-value-list (xgcd 560014183 312839871))
+(1 77165803 -138134388)
+
+(let ((a 974507656412513757857315037382926980395082974811562770185617915360)
+      (b -1539496810360685510909469177732386446833404488164283))
+  (multiple-value-bind (g u v) (xgcd a b)
+    (and (eql g 1) (eql g (+ (* a u) (* b v))))
+) )
+T
+
+(isqrt #x3FFFFFFFC000000000007F)
+#x7FFFFFFFBFF
+
diff --git a/src/tests/pack11.tst b/src/tests/pack11.tst
new file mode 100644
index 000000000..a32901ae3
--- /dev/null
+++ b/src/tests/pack11.tst
@@ -0,0 +1,512 @@
+;; packages-test
+;  -------------
+
+;;testfile fuer kapitel 11
+
+(packagep  *package*)
+T
+;;list-all-packages und typtest
+(let ((p (list-all-packages)))
+     (every #'packagep p))
+T
+
+;;11.6 obligate Paketnamen u. deren Abkuerzungen
+
+;;vorhandensein der standardpakete und find-package dafuer
+
+(and (find-package 'lisp) t)
+T
+(and (find-package 'user) t)
+T
+(and (find-package 'keyword) t)
+T
+(and (find-package 'system) t)
+T
+(and (find-package 'sys) t)
+T
+(and (find-package "sys") t)
+NIL
+(and (find-package "sys") t)
+NIL
+(and (find-package "system") t)
+NIL
+(and (find-package "SYSTEM") t)
+T
+(and (find-package "SYS") t)
+T
+
+;nicknames
+(find "SYS" (package-nicknames 'sys) :test #'string=)
+"SYS"
+
+;package-name
+(package-name 'sys)
+"SYSTEM"
+(package-name 'system)
+"SYSTEM"
+(package-name "USER")
+"USER"
+(package-name "SYS")
+"SYSTEM"
+
+
+;;; 11.7 anlegen von paketen, export import ...
+
+  ;package-funktionen mit nutzerdefinierten paketen
+
+;falls test1 bereits existiert
+(and (find-package 'test1)
+     (in-package 'test1)
+     (rename-package (find-package 'test1) 'test1-old)
+     nil)
+nil
+
+;make-package
+(package-name (make-package 'test1 :nicknames '(t1 tst1)))
+"TEST1"
+
+;package-use-list
+;(package-use-list (find-package 'test1))
+;("LISP")
+
+
+(and (in-package 'test1) T)
+T
+
+
+(export  '(test1::test1-y test1::test1-z)(find-package
+'"TEST1"))
+T
+
+(export  '(test1::test1-a test1::test1-b test1::test1-c) (find-package
+'test1))
+T
+
+(setf test1-a -2
+      test1-b -1
+      test1-c  0
+      test1-x  1
+      test1-y  2
+      test1-z  3)
+3
+
+;falls test2 bereits existiert
+(and
+        (find-package 'test2)
+        (rename-package (find-package 'test2) 'test2-old)
+        nil)
+nil
+
+#+ECLS(package-name (in-package 'test2 :nicknames '("T2" "TST2") :use '(test1)))
+#-ECLS(package-name (in-package 'test2 :nicknames '("T2" "TST2") :use 'test1))
+"TEST2"
+
+(lisp:package-name (lisp:find-package 'test2))
+"TEST2"
+
+(lisp:package-name lisp:*package*)
+"TEST2"
+
+(lisp:import '(lisp:error) (lisp:find-package 'test2))
+LISP:T
+
+(lisp:and (lisp:boundp 'test1-x) test1-x)
+LISP:NIL
+
+(lisp:unintern 'test1-x)
+LISP:T
+
+(eval (read-from-string "(lisp:and (lisp:boundp 'test1:test1-x) test1:test1-x)"))
+#+XCL 1 #-XCL ERROR
+
+(lisp:and (lisp:boundp 'test1::test1-x) test1::test1-x)
+1
+
+(lisp:and (lisp:boundp 'test1-y) test1-y)
+#+XCL LISP:NIL #-XCL 2
+
+(lisp:unintern 'test1-y)
+#+XCL LISP:T #-XCL LISP:NIL
+
+(lisp:and (lisp:boundp 'test1:test1-y) test1:test1-y)
+#+XCL ERROR #-XCL 2
+
+(lisp:and (lisp:boundp 'test1::test1-y) test1::test1-y)
+2
+
+(lisp:import  '(test1::test1-x test1::test1-y) (lisp:find-package 'test2))
+LISP:T
+
+(lisp:and (lisp:boundp 'test1-x) test1-x)
+1
+
+(eval (read-from-string "(lisp:and (lisp:boundp 'test1:test1-x) test1:test1-x)"))
+#+XCL 1 #-XCL ERROR
+
+(lisp:and (lisp:boundp 'test1::test1-x) test1::test1-x)
+1
+
+(lisp:and (lisp:boundp 'test1-z) test1-z)
+#+XCL LISP:NIL #-XCL 3
+
+(lisp:unintern 'test1-z (lisp:find-package 'test2))
+#+XCL LISP:T #-XCL LISP:NIL
+
+(lisp:and (lisp:boundp 'test1:test1-z) test1:test1-z)
+#+XCL ERROR #-XCL 3
+
+test1::test1-z
+3
+
+(lisp:unexport  '(test1::test1-x test1::test1-y) (lisp:find-package 'test1))
+LISP:T
+
+(lisp:and (lisp:boundp 'test1-x) test1-x)
+1
+
+(lisp:and (lisp:boundp 'test1-y) test1-y)
+#+XCL LISP:NIL #-XCL 2
+
+(lisp:unintern 'test1-x (lisp:find-package 'test2))
+LISP:T
+
+(eval (read-from-string "test1:test1-x"))
+ERROR
+
+test1::test1-x
+1
+
+test1-z
+3
+
+(lisp:unintern 'test1-z (lisp:find-package 'test2))
+#+XCL LISP:T #-XCL LISP:NIL
+
+test1:test1-z
+3
+
+test1::test1-z
+3
+
+(lisp:import 'test1::test1-z (lisp:find-package 'test2))
+LISP:T
+
+test1-z
+3
+
+test1:test1-z
+3
+
+test1::test1-z
+3
+
+test1-c
+#+XCL ERROR #-XCL 0
+
+(lisp:unintern 'test-c (lisp:find-package 'test2))
+LISP:T
+
+test1:test1-c
+0
+
+test1::test1-c
+0
+
+(lisp:import '(test1::test1-a test1::test1-b test1::test1-c)
+             (lisp:find-package 'test2))
+LISP:T
+
+test1-c
+0
+
+test1:test1-c
+0
+
+test1::test1-c
+0
+
+(lisp:eq 'test1-c 'test1::test1-c)
+LISP:T
+
+  ;Ende nutzerdefinierte Pakete
+
+;; test in standardmaessig vorgegebenen paketen
+
+; export | import | unintern
+
+(lisp:and (lisp:in-package 'user) lisp:T)
+LISP:T
+
+(setf x 1 y 2 z 3)
+3
+
+(and(in-package 'editor)T)
+T
+
+(unintern 'x)
+T
+
+(unintern 'y)
+T
+
+(unintern 'z)
+T
+
+user::x
+1
+
+(eval (read-from-string "user:x"))
+ERROR
+
+x
+error
+
+(eq 'x 'user::x)
+NIL
+
+(unintern 'x)
+T
+
+(export '(user::x user::y) (find-package 'user))
+T
+
+user::x
+1
+
+user:x
+1
+
+x
+error
+
+(unintern 'x)
+T
+
+(import 'user:x (find-package 'editor))
+T
+
+x
+1
+
+(eq 'x 'user::x)
+t
+
+(eq 'x 'user:x)
+t
+
+(eq 'editor::x 'user::x)
+t
+
+;; unexport
+
+(and (in-package 'user) T)
+T
+
+(unexport 'y)
+T
+
+(and (in-package 'editor) T)
+T
+
+y
+ERROR
+
+(eval (read-from-string "user:y"))
+ERROR
+
+user::y
+2
+
+;; shadowing-import -- zunaechst ohne geerbte symbole!!
+
+(and (in-package 'user)(package-name *package*))
+"USER"
+
+(setf d 4 e 5 f 6 y 111 x 222)
+222
+
+(export '(user::a user::b user::c user::y user::x) (find-package 'user))
+T
+
+(import '(user::a user::b user::c user::y) (find-package 'editor))
+ERROR
+
+(and (make-package 'shadow-test)(in-package 'shadow-test)t)
+T
+
+(setf x 'shadow-test)
+shadow-test
+
+(shadowing-import '(user::d user::e user::f user::x)(find-package 'shadow-test))
+T
+
+x
+222
+
+(eq user::x x)
+T
+
+; shadow
+
+(shadow '(e f) (find-package 'shadow-test))
+t
+
+(setf e 'shadow-test-e)
+shadow-test-e
+
+(eq 'e 'user::e)
+#+XCL nil #-XCL t
+
+e
+shadow-test-e
+
+(eval (read-from-string "user:e"))
+error
+
+user::e
+#+XCL 5 #-XCL shadow-test-e
+
+; use-package | unuse-package
+
+(and (make-package 'use-test)(in-package 'use-test) t)
+t
+
+(use-package '(user))
+T
+
+user::d
+4
+
+(eval (read-from-string "user:d"))
+#+XCL 4 #-XCL ERROR
+
+d
+ERROR
+
+(unuse-package 'user)
+T
+
+user::d
+4
+
+(eval (read-from-string "user:d"))
+ERROR
+
+d
+ERROR
+
+;make-package mit beutzung eines paketes, dass geerbte symbole enthaelt
+
+(and (make-package 'inherit :nicknames '(inh i) )(in-package 'inherit) T)
+T
+
+(setf a 'inherita b 'inheritb)
+inheritb
+
+(export '(a b) (find-package 'inherit))
+T
+
+(and (make-package 'inherit1 :use #+ECLS '(inherit) #-ECLS 'inherit)(in-package 'inherit1) T)
+T
+
+a
+inherit::inherita
+
+b
+inherit::inheritb
+
+(lisp:setf c 'inherit1c)
+inherit1c
+
+(lisp:and (lisp:make-package 'inherit2 :use #+ECLS '(inherit1) #-ECLS 'inherit1)
+          (lisp:in-package 'inherit2) lisp:T)
+LISP:T
+
+a
+#+XCL inherita #-XCL LISP:ERROR
+
+b
+#+XCL inheritb #-XCL LISP:ERROR
+
+c
+#+XCL inherit1c #-XCL LISP:ERROR
+
+(eval (read-from-string "(lisp:eq 'c 'inherit1:c)"))
+#+XCL LISP:T #-XCL LISP:ERROR
+
+(eval (read-from-string "(lisp:eq 'a 'inherit:a)"))
+#+XCL LISP:T #-XCL LISP:ERROR
+
+(eval (read-from-string "(lisp:eq 'b 'inherit:b)"))
+#+XCL LISP:T #-XCL LISP:ERROR
+
+(lisp:eq 'c 'inherit1::c)
+#+XCL LISP:T #-XCL LISP:NIL
+
+(lisp:eq 'a 'inherit::a)
+#+XCL LISP:T #-XCL LISP:NIL
+
+(lisp:eq 'b 'inherit::b)
+#+XCL LISP:T #-XCL LISP:NIL
+
+;find-all-symbols
+
+(lisp:and (lisp:in-package 'user) lisp:T)
+LISP:T
+
+; find-all-symbols fehlerhaft
+(and (member 'user::x (setf s (find-all-symbols 'x)))T)
+T
+
+(eval (read-from-string "(and (member 'editor:x s) t)"))
+#+XCL T #-XCL ERROR
+
+(and (member 'user::x (setf s1 (find-all-symbols 'x)))T)
+T
+
+(set-difference s s1)
+nil                              ;Ende Kommentar
+
+;do-symbols | do-external-symbols | do-all-symbols
+
+(setf sym nil
+      esym nil
+      asym nil
+)
+nil
+
+(do-symbols (s (find-package 'user))(push (symbol-name s) sym))
+nil
+
+(do-external-symbols (s (find-package 'user))(push (symbol-name s) esym))
+nil
+
+(do-all-symbols (s)(push (symbol-name s) asym))
+nil
+
+(find "ESYM" sym :test #'string=)
+"ESYM"
+
+(find "ESYM" esym :test #'string=)
+nil
+
+(find "LAMBDA-LIST-KEYWORDS" esym :test #'string=)
+#+XCL "LAMBDA-LIST-KEYWORDS" #-XCL NIL
+
+;(count "LAMBDA-LIST-KEYWORDS" asym :test #'string=)
+;T                                                  ;viel zu lang
+
+; modules | provide | (require nicht getestet !)
+
+(and *modules* T)
+#+(or ECLS XCL) T #+CLISP NIL #-(or ECLS XCL CLISP) UNKNOWN
+
+(and (provide 'provide-test) t)
+t
+
+(find "PROVIDE-TEST" *modules* :test #'string=)
+"PROVIDE-TEST"
+
+(format t "End of file")
+nil
+
diff --git a/src/tests/path.tst b/src/tests/path.tst
new file mode 100644
index 000000000..b5aa1fa3e
--- /dev/null
+++ b/src/tests/path.tst
@@ -0,0 +1,536 @@
+(setf string "test-pathname.abc" symbol 'test-pathname.abc)
+test-pathname.abc
+
+;;pathname -mögl. Argumenttypen: pathname,string,symbol,stream
+;;         -resultat: pathname
+
+(SETF PATHSTRING (PATHNAME STRING))
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL
+SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+TYPE "ABC" SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
+#+ECLS
+#P"test-pathname.abc"
+
+(SETF PATHSYMBOL (PATHNAME symbol))
+#+XCL
+#S(PATHNAME SYSTEM::HOST
+NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+"TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
+#+ECLS
+#P"TEST-PATHNAME.ABC"
+
+(SETF PATHPATH (PATHNAME PATHSYMBOL))
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL
+SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+TYPE "ABC" SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
+#+ECLS
+#P"TEST-PATHNAME.ABC"
+
+(SETF STREAM (OPEN STRING :DIRECTION :OUTPUT)
+      a nil)
+nil
+
+;(SETF PATHSTREAM (PATHNAME STREAM))
+;"test-pathname.lsp"
+
+(MAPCAR (FUNCTION PATHNAMEP)
+        (LIST PATHSTRING PATHSYMBOL PATHPATH ;PATHSTREAM
+))
+(T T T ;T
+)
+
+
+;; funktion truename liefert filename fuer pathname oder stream
+;;                   einen Pfadnamen
+;
+;(MAPCAR (FUNCTION TRUENAME) (LIST PATHSTRING PATHSYMBOL PATHPATH STREAM
+;                                                               ;PATHSTREAM
+;                                                                 ))
+;  ERROR
+
+
+
+(PARSE-NAMESTRING STRING)
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL
+SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+TYPE "ABC" SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
+#+ECLS
+#P"test-pathname.abc"
+
+(PARSE-NAMESTRING SYMBOL)
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL
+SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+TYPE "ABC" SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
+#+ECLS
+#P"TEST-PATHNAME.ABC"
+
+#+XCL
+(PARSE-NAMESTRING "bab:test-pathname.abc")
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL
+SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2" SYSTEM::NAME
+"TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL)
+
+#+XCL
+(PARSE-NAMESTRING "bab:test-pathname.abc;3")
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL
+SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2" SYSTEM::NAME
+"TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION 3)
+
+(PARSE-NAMESTRING PATHSTRING)
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
+"DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME" TYPE "ABC"
+SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
+#+ECLS
+#P"test-pathname.abc"
+
+(PARSE-NAMESTRING "test-pathname.abc" NIL)
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL
+SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
+TYPE "ABC" SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
+#+ECLS
+#P"test-pathname.abc"
+
+#+XCL
+(PARSE-NAMESTRING "sirius::disk00$abt43:[heicking]test-pathname.abc")
+#+XCL
+#S(PATHNAME
+SYSTEM::HOST "SIRIUS" SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "HEICKING"
+SYSTEM::NAME "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL)
+
+#+XCL
+(PARSE-NAMESTRING "sirius::disk00$abt43:[heicking]test-pathname.abc" "sirius")
+#+XCL
+#S(PATHNAME
+SYSTEM::HOST "SIRIUS" SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "HEICKING"
+SYSTEM::NAME "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL)
+
+#+XCL
+(PARSE-NAMESTRING "sirius::disk00$abt43:[heicking]test-pathname.abc" "orion")
+#+XCL
+ERROR
+
+(PARSE-NAMESTRING "abc.123" NIL NIL :START 0 :END 5)
+#+XCL
+#S(PATHNAME SYSTEM::HOST
+NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "ABC" TYPE
+"1" SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "abc" :TYPE "1" :VERSION NIL)
+#+ECLS
+#P"abc.1"
+
+(PARSE-NAMESTRING "abc.123" NIL NIL :START 2 :END 5)
+#+XCL
+#S(PATHNAME SYSTEM::HOST
+NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "C" TYPE "1"
+SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "c" :TYPE "1" :VERSION NIL)
+#+ECLS
+#P"c"
+
+#+XCL
+(PARSE-NAMESTRING "babylon" NIL NIL :START 0 :END 3)
+#+XCL
+#S(PATHNAME SYSTEM::HOST
+NIL SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2" SYSTEM::NAME NIL TYPE
+NIL SYSTEM::VERSION NIL)
+
+#+XCL
+(PARSE-NAMESTRING "babylon" NIL NIL :START 0 :END 7)
+#+XCL
+#S(PATHNAME SYSTEM::HOST
+NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "BABYLON"
+TYPE NIL SYSTEM::VERSION NIL)
+
+#+XCL
+(PARSE-NAMESTRING "babylon" NIL *DEFAULT-PATHNAME-DEFAULTS* :START 0 :END 7)
+#+XCL
+#S(PATHNAME
+SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+"BABYLON" TYPE NIL SYSTEM::VERSION NIL)
+
+*DEFAULT-PATHNAME-DEFAULTS*
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE NIL
+DIRECTORY NIL SYSTEM::NAME NIL TYPE "lsp" SYSTEM::VERSION :NEWEST)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME NIL :TYPE NIL :VERSION NIL)
+#+ECLS
+#P""
+
+#+XCL
+(PARSE-NAMESTRING "babylon" NIL *DEFAULT-PATHNAME-DEFAULTS* :START 0 :END 3)
+#+XCL
+#S(PATHNAME
+SYSTEM::HOST NIL SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2"
+SYSTEM::NAME NIL TYPE NIL SYSTEM::VERSION NIL)
+
+;(PARSE-NAMESTRING "babylon.c.c" NIL NIL :JUNK-ALLOWED T)
+;#S(PATHNAME
+;SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+;"BABYLON" TYPE "C" SYSTEM::VERSION NIL)
+
+;(PARSE-NAMESTRING "babylon;c.c" NIL NIL :JUNK-ALLOWED T)
+;#S(PATHNAME
+;SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+;"BABYLON" TYPE NIL SYSTEM::VERSION NIL)
+
+#+XCL
+(PARSE-NAMESTRING "babylon;c.c" NIL NIL :JUNK-ALLOWED NIL)
+#+XCL
+ERROR
+
+#+XCL
+(PARSE-NAMESTRING "babylon.c.c" NIL NIL :JUNK-ALLOWED NIL)
+#+XCL
+ERROR
+
+#+XCL
+(PARSE-NAMESTRING "babylon.c;c" NIL NIL :JUNK-ALLOWED NIL)
+#+XCL
+ERROR
+
+#+XCL
+(PARSE-NAMESTRING "babylon.c;" NIL NIL :JUNK-ALLOWED NIL)
+#+XCL
+#S(PATHNAME
+SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+"BABYLON" TYPE "C" SYSTEM::VERSION NIL)
+
+#+XCL
+(PARSE-NAMESTRING "babylon.c;5" NIL NIL :JUNK-ALLOWED NIL)
+#+XCL
+#S(PATHNAME
+SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
+"BABYLON" TYPE "C" SYSTEM::VERSION 5)
+
+;(MERGE-PATHNAME "test$$" SYMBOL 10)   ERROR
+;;
+;(MERGE-PATHNAME "test$$" SYMBOL)   ERROR
+;
+;(MERGE-PATHNAME "test$$" PATH)   ERROR
+;
+;(MERGE-PATHNAME "test$$")   ERROR
+
+#+XCL
+(MERGE-PATHNAMES "test$$")
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
+"DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE "lsp"
+SYSTEM::VERSION :NEWEST)
+
+#+XCL
+(MERGE-PATHNAMES "test$$" SYMBOL)
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
+"DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE "ABC"
+SYSTEM::VERSION :NEWEST)
+
+#+XCL
+(MERGE-PATHNAMES "test$$" SYMBOL 2)
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL
+SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE
+"ABC" SYSTEM::VERSION 2)
+
+#+XCL
+(MERGE-PATHNAMES "test$$" (PATHNAME SYMBOL) 2)
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL
+SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE
+"ABC" SYSTEM::VERSION 2)
+
+#+XCL
+(MERGE-PATHNAMES "test$$" STREAM 2)
+#+XCL
+#S(PATHNAME SYSTEM::HOST 16 SYSTEM::DEVICE
+"DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE :ESCAPE
+SYSTEM::VERSION 2)
+
+
+;(MERGE-PATHNAME STRING SYMBOL)   ERROR
+
+#+XCL
+(MAKE-PATHNAME :NAME "a" :HOST (QUOTE ORION))
+#+XCL
+#S(PATHNAME SYSTEM::HOST ORION
+SYSTEM::DEVICE NIL DIRECTORY NIL SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION
+:NEWEST)
+
+#+XCL
+(DEFMACRO TEST (&REST BODY) (\` (APPLY (FUNCTION MAKE-PATHNAME) (\,@ BODY))))
+#+XCL
+TEST
+
+#+XCL
+(setf a '(:host "sirius" :name "a"))
+#+XCL
+(:host "sirius" :name "a")
+
+#+XCL
+(TEST A)
+#+XCL
+#S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE NIL DIRECTORY NIL
+SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION :NEWEST)
+
+#+XCL
+(SETF A (LIST* :DEVICE "disk00$abt43" A))
+#+XCL
+(:DEVICE "disk00$abt43" :HOST "sirius" :NAME "a")
+
+#+XCL
+(TEST A)
+#+XCL
+#S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
+DIRECTORY NIL SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION :NEWEST)
+
+#+XCL
+(SETF A (LIST* :DIRECTORY "[heicking.comlisp]" A))
+#+XCL
+(:DIRECTORY
+"[heicking.comlisp]" :DEVICE "disk00$abt43" :HOST "sirius" :NAME "a")
+
+#+XCL
+(TEST A)
+#+XCL
+#S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
+DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION
+:NEWEST)
+
+#+XCL
+(SETF A (LIST* :TYPE "raf" A))
+#+XCL
+(:TYPE "raf" :DIRECTORY "[heicking.comlisp]"
+:DEVICE "disk00$abt43" :HOST "sirius" :NAME "a")
+
+#+XCL
+(TEST A)
+#+XCL
+#S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
+DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE "raf" SYSTEM::VERSION
+:NEWEST)
+
+#+XCL
+(SETF A (LIST* :VERSION 3 A))
+#+XCL
+(:VERSION 3 :TYPE "raf" :DIRECTORY
+"[heicking.comlisp]" :DEVICE "disk00$abt43" :HOST "sirius" :NAME "a")
+
+#+XCL
+(TEST A)
+#+XCL
+#S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
+DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE "raf" SYSTEM::VERSION 3)
+
+(MAPCAR (FUNCTION PATHNAMEP) (LIST PATHSYMBOL PATHPATH PATHSTRING))
+(T T T)
+
+#+XCL
+(SETF PATH (TEST A))
+#+XCL
+#S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE
+"disk00$abt43" DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE "raf"
+SYSTEM::VERSION 3)
+
+#+XCL
+(MAPCAR (FUNCTION PATHNAME-HOST) (LIST SYMBOL STRING STREAM PATH))
+#+XCL
+(NIL NIL NIL NIL)
+
+#+XCL
+(MAPCAR (FUNCTION PATHNAME-DEVICE) (LIST SYMBOL STRING STREAM PATH))
+#+XCL
+("DISK00$ABT43" "DISK00$ABT43" "DISK00$ABT43" "DISK00$ABT43")
+
+#+XCL
+(MAPCAR (FUNCTION PATHNAME-DIRECTORY) (LIST SYMBOL STRING STREAM PATH))
+#+XCL
+("XCL.MAIN" "XCL.MAIN" "XCL.MAIN" "XCL.MAIN")
+
+(PROGN (CLOSE STREAM) T)
+T
+
+#+XCL
+(USER-HOMEDIR-PATHNAME)
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
+"DISK00$ABT43" DIRECTORY "HEICKING" SYSTEM::NAME NIL TYPE NIL SYSTEM::VERSION
+NIL)
+
+(PATHNAME "*.*")
+#+XCL
+#S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43"
+DIRECTORY "HEICKING" SYSTEM::NAME "*" TYPE :WILD SYSTEM::VERSION NIL)
+#+CLISP
+#S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
+            :NAME "*" :TYPE "*" :VERSION NIL)
+#+ECLS
+#P"*.*"
+
+(progn (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :input
+                        :element-type 'string-char
+                        :if-does-not-exist :create)) t)
+t
+
+(null (probe-file "nicht-vorhandenes-file.non"))
+NIL
+
+(progn (close file) t)
+t
+
+(setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-exists :error))
+error
+
+(progn (close file) t)
+t
+
+(null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-exists :new-version)))
+nil
+
+(progn (close file) t)
+t
+
+(null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-exists :rename)))
+nil
+
+(progn (close file) t)
+t
+
+(null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-exists :rename-and-delete)))
+nil
+
+(progn (close file) t)
+t
+
+(null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-exists :overwrite)))
+nil
+
+(progn (close file) t)
+t
+
+(null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-exists :append)))
+nil
+
+(progn (close file) t)
+t
+
+(null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-exists :supersede)))
+nil
+
+(progn (close file) t)
+t
+
+(setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-exists nil))
+nil
+
+(progn (close file) t)
+error
+
+(setf file (open "nicht-vorhandenes-file.new"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-does-not-exist :error))
+error
+
+(progn (close file) t)
+error
+
+(null (setf file (open "nicht-vorhandenes-file.new"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-does-not-exist :create)))
+nil
+
+(progn (close file) t)
+t
+
+(null (setf file (open "nicht-vorhandenes-file.non"
+                        :direction :io
+                        :element-type 'string-char
+                        :if-does-not-exist nil)))
+nil
+
+(progn (close file) t)
+t
+
+(namestring
+  (multiple-value-setq (new-name pathname truename)
+                     (rename-file "nicht-vorhandenes-file.non" "file.da")))
+"file.da"
+
+(namestring new-name)
+"file.da"
+
+(null pathname)
+nil
+
+(null truename)
+nil
+
+(progn (delete-file "test-pathname.abc") t)
+t
+
+(progn (mapc #'delete-file (directory "nicht-vorhandenes-file.*")) t)
+t
+
+(progn (delete-file "file.da") t)
+t
+
diff --git a/src/tests/readtable.tst b/src/tests/readtable.tst
new file mode 100644
index 000000000..c1e8c3c46
--- /dev/null
+++ b/src/tests/readtable.tst
@@ -0,0 +1,588 @@
+;*******************************************************************************
+;*      Rosenmueller  tel.340 Testquelle READTABLE.que    23.03.1988
+       *
+;*******************************************************************************
+
+(prin1-to-string (setq *readtable* (copy-readtable nil)))
+"#<SYSTEM::%TYPE-READTABLE #<SYSTEM::%TYPE-SIMPLE-VECTOR SYSTEM::%TYPE-UNSIGNED-WORD-POINTER
+ 00000000 00000000 00000000 00000000 00040001 00000004 00040004 00000000
+ 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000
+ 00010004 011E0075 00010001 02250001 00A50395 0C010401 14010535 00010B41
+ 06010601 06010601 06010601 06010601 06010601 00850701 08010001 00010001
+ 0D010061 12010E01 00011501 00010001 00010001 00010001 00010001 0F010001
+ 00010001 13011101 00010001 00010001 00011001 00010001 00010902 00010001
+ 0D010055 12010E01 00011501 00010001 00010001 00010001 00010001 0F010001
+ 00010001 13011101 00010001 00010001 00011001 00C50001 00B50A03 00010001>
+NIL>"
+
+(setq $ 23)
+23
+
+(defun single-dollar-reader (stream char)
+       (declare (ignore stream))
+       (intern (string char)))
+SINGLE-DOLLAR-READER
+
+(set-macro-character #\$ #'single-dollar-reader)
+T
+
+$
+23
+
+45
+45
+                                        ; => 23 => 45
+(prin1-to-string (get-macro-character #\$))
+"#<SYSTEM::%TYPE-CLOSURE SINGLE-DOLLAR-READER
+NIL
+NIL
+(LAMBDA (STREAM CHAR) (DECLARE (IGNORE STREAM)) (INTERN (STRING CHAR)))>"
+
+
+(progn (setq *readtable* (copy-readtable nil)) t)
+t
+
+(sys::rt-bitmask-char #\" )
+117
+
+(sys::rt-bitmask-char #\( )
+917
+
+(sys::rt-bitmask-char #\) )
+165
+
+(sys::rt-bitmask-char #\\ )
+2306
+
+(sys::rt-bitmask-char #\x )
+4097
+
+(sys::rt-bitmask-char #\y )
+1
+
+(set-syntax-from-char #\" #\( )
+T
+
+(sys::rt-bitmask-char #\" )
+917
+
+(sys::rt-bitmask-char #\( )
+917
+
+(sys::rt-bitmask-char #\) )
+165
+
+(sys::rt-bitmask-char #\\ )
+2306
+                ; *readtable* nil
+                                        ; *readtable* cl-standard
+(progn (setq doppelquote-liston-readtable (copy-readtable)) t)
+t
+
+(sys::rt-bitmask-char #\" doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\( doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\) doppelquote-liston-readtable )
+165
+
+(sys::rt-bitmask-char #\\ doppelquote-liston-readtable )
+2306
+
+'"1 2 3)
+(1 2 3)
+
+(set-syntax-from-char #\" #\\ )
+T
+
+(sys::rt-bitmask-char #\" )
+2306
+
+(sys::rt-bitmask-char #\( )
+917
+
+(sys::rt-bitmask-char #\) )
+165
+
+(sys::rt-bitmask-char #\\ )
+2306
+
+(progn (setq doppelquote-backslash-readtable (copy-readtable)) t)
+T
+
+(sys::rt-bitmask-char #\" doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\\ doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\( doppelquote-backslash-readtable )
+917
+
+(sys::rt-bitmask-char #\) doppelquote-backslash-readtable )
+165
+
+#"<
+#\<
+
+(progn (setq 2.-doppelquote-backslash-readtable
+                        (copy-readtable doppelquote-backslash-readtable)) t)
+t
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
+917
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
+165
+
+(progn (setq 2.-doppelquote-liston-readtable
+                        (copy-readtable doppelquote-liston-readtable)) t)
+t
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
+165
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
+2306
+
+(progn (setq cl-standard-readtable
+                        (copy-readtable nil))
+       (setq *readtable* cl-standard-readtable) t)
+t
+
+(sys::rt-bitmask-char #\" cl-standard-readtable )
+117
+
+(sys::rt-bitmask-char #\( cl-standard-readtable )
+917
+
+(sys::rt-bitmask-char #\) cl-standard-readtable )
+165
+
+(sys::rt-bitmask-char #\\ cl-standard-readtable )
+2306
+
+(sys::rt-bitmask-char #\" )
+117
+
+(sys::rt-bitmask-char #\( )
+917
+
+(sys::rt-bitmask-char #\) )
+165
+
+(sys::rt-bitmask-char #\\ )
+2306
+
+"1234"
+"1234"
+
+(progn (setq *readtable* 2.-doppelquote-liston-readtable) t)
+t
+
+(sys::rt-bitmask-char #\" )
+917
+
+(sys::rt-bitmask-char #\( )
+917
+
+(sys::rt-bitmask-char #\) )
+165
+
+(sys::rt-bitmask-char #\\ )
+2306
+
+'"1 2 3)
+(1 2 3)
+
+(progn (setq *readtable* doppelquote-backslash-readtable) t)
+T
+
+(sys::rt-bitmask-char #\" )
+2306
+
+(sys::rt-bitmask-char #\( )
+917
+
+(sys::rt-bitmask-char #\) )
+165
+
+(sys::rt-bitmask-char #\\ )
+2306
+
+#"<
+#\<
+
+(readtablep 2.-doppelquote-backslash-readtable )
+T
+
+(readtablep 1)
+NIL
+
+
+(set-syntax-from-char #\" #\" 2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
+117
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
+917
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
+165
+
+
+(set-syntax-from-char #\) #\( 2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
+117
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
+917
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
+917
+
+
+(set-syntax-from-char #\( #\) 2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
+117
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
+2306
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
+165
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
+917
+
+
+(set-syntax-from-char #\( #\( 2.-doppelquote-liston-readtable
+                              2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
+165
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
+165
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
+2306
+
+
+(set-syntax-from-char #\) #\) 2.-doppelquote-liston-readtable
+                              2.-doppelquote-backslash-readtable )
+T
+
+(sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
+165
+
+(sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
+917
+
+(sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
+2306
+
+
+(progn (setq *readtable* 2.-doppelquote-backslash-readtable ) t)
+t
+
+)sys::rt-bitmask-char #\( (
+165
+
+)sys::rt-bitmask-char #\) (
+917
+
+)sys::rt-bitmask-char #\\ (
+2306
+
+"1234"
+"1234"
+
+')1 2 3(
+(1 2 3)
+
+)progn )setq *readtable* 2.-doppelquote-liston-readtable ( t(
+t
+
+
+)sys::rt-bitmask-char #\( (
+165
+
+)sys::rt-bitmask-char #\) (
+917
+
+)sys::rt-bitmask-char #\\ (
+2306
+
+'"1234(
+(1234)
+
+')1 2 3(
+(1 2 3)
+                ; ) muesste listen-anfang-sein
+)progn )setq *readtable* )copy-readtable nil(( t(
+t
+
+(sys::rt-bitmask-char #\" )
+117
+
+(sys::rt-bitmask-char #\( )
+917
+
+(sys::rt-bitmask-char #\) )
+165
+
+(sys::rt-bitmask-char #\\ )
+2306
+
+(sys::rt-bitmask-char #\x )
+4097
+
+(sys::rt-bitmask-char #\y )
+1
+
+
+(make-dispatch-macro-character #\x)
+T
+
+(sys::rt-bitmask-char #\x )
+4109
+
+(sys::rt-bitmask-char #\y )
+1
+
+(defun d1 (a b c) (princ "1.dmacro"))
+D1
+
+(d1 1 2 3)
+"1.dmacro"
+
+(set-dispatch-macro-character #\x #\. #'d1)
+T
+
+(sys::rt-bitmask-char #\x )
+4109
+
+(prin1-to-string (get-dispatch-macro-character #\x #\.))
+"#<SYSTEM::%TYPE-CLOSURE D1
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
+
+(multiple-value-list (read-from-string "123x.45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123x.45" t nil :start 3))
+(   "1.dmacro" 5)
+
+(multiple-value-list (read-from-string "123x.45" t nil :start 5))
+(45 7)
+
+
+(make-dispatch-macro-character #\y)
+T
+
+(s\Ys::rt-bitmask-char #\x )
+4109
+
+(s\Ys::rt-bitmask-char #\y )
+13
+
+(defun d2 (a b c) (princ "2.dmacro"))
+D2
+
+(d2 1 2 3)
+"2.dmacro"
+
+(set-dispatch-macro-character #\y #\, #'d2)
+T
+
+(s\Ys::rt-bitmask-char #\x )
+4109
+
+(s\Ys::rt-bitmask-char #\y )
+13
+
+(prin1-to-string (get-dispatch-macro-character #\x #\.))
+"#<SYSTEM::%TYPE-CLOSURE D1
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
+
+(prin1-to-string (get-dispatch-macro-character #\y #\,))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(multiple-value-list (read-from-string "123y,45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123y,45" t nil :start 3))
+(   "2.dmacro" 5)
+
+(multiple-value-list (read-from-string "123y,45" t nil :start 5))
+(45 7)
+
+(set-dispatch-macro-character #\x #\. #'d2)
+T
+
+(s\Ys::rt-bitmask-char #\x )
+4109
+
+(s\Ys::rt-bitmask-char #\y )
+13
+
+(prin1-to-string (get-dispatch-macro-character #\y #\,))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(prin1-to-string (get-dispatch-macro-character #\x #\.))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(multiple-value-list (read-from-string "123x.45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123x.45" t nil :start 3))
+(   "2.dmacro" 5)
+
+(multiple-value-list (read-from-string "123x.45" t nil :start 5))
+(45 7)
+
+(set-dispatch-macro-character #\y #\. #'d1)
+T
+
+(s\Ys::rt-bitmask-char #\x )
+4109
+
+(s\Ys::rt-bitmask-char #\y )
+13
+
+(prin1-to-string (get-dispatch-macro-character #\x #\.))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(prin1-to-string (get-dispatch-macro-character #\y #\,))
+"#<SYSTEM::%TYPE-CLOSURE D2
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
+
+(prin1-to-string (get-dispatch-macro-character #\y #\.))
+"#<SYSTEM::%TYPE-CLOSURE D1
+NIL
+NIL
+(LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
+
+(multiple-value-list (read-from-string "123y.45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123y.45" t nil :start 3))
+(   "1.dmacro" 5)
+
+(multiple-value-list (read-from-string "123y.45" t nil :start 5))
+(45 7)
+
+(multiple-value-list (read-from-string "123y,45"))
+(   123 3)
+
+(multiple-value-list (read-from-string "123y,45" t nil :start 3))
+(   "2.dmacro" 5)
+
+(multiple-value-list (read-from-string "123y,45" t nil :start 5))
+(45 7)
+
+(progn (setq *readtable* (cop\Y-readtable nil nil)) t)
+t
+
+(sys::rt-bitmask-char #\x )
+4097
+
+(sys::rt-bitmask-char #\y )
+1
+
+(get-dispatch-macro-character #\x #\.)
+ERROR
+
+(get-dispatch-macro-character #\y #\,)
+ERROR
+
+(get-dispatch-macro-character #\y #\.)
+ERROR
+
+(defun |#{-reader| (stream char arg)
+  (declare (ignore char arg))
+  (mapcon #'(lambda (x)
+              (mapcar #'(lambda (y)(list (car x) y))(cdr x)))
+          (read-delimited-list #\} stream)))
+|#{|-|reader|
+
+(set-dispatch-macro-character #\# #\{ #'|#{-reader|)
+T
+
+;;      (set-macro-character #\} (get-macro-character #\)) nil))
+;;      geht bei uns nicht !
+;;      dafuer :
+(set-syntax-from-char #\} #\) )
+;;      nicht notwendig, da superklammer
+(progn
+(setq read-st (make-string-input-stream "#{p q z a} #{a b c d}")) t)
+T
+
+(read read-st)
+((P Q) (P Z) (P A) (Q Z) (Q A) (Z A))
+
+(read read-st)
+((A B) (A C) (A D) (B C) (B D) (C D))
+
+(progn (setq *readtable* (copy-readtable nil nil))
+       (makunbound 'doppelquote-liston-readtable)
+       (makunbound 'doppelquote-backslash-readtable)
+       (makunbound '2.-doppelquote-liston-readtable)
+       (makunbound '2.-doppelquote-backslash-readtable)
+       (makunbound 'cl-standard-readtable)
+       (makunbound 'read-st)
+       (makunbound '$)
+t)
+T
+
diff --git a/src/tests/setf.tst b/src/tests/setf.tst
new file mode 100644
index 000000000..9d863117e
--- /dev/null
+++ b/src/tests/setf.tst
@@ -0,0 +1,369 @@
+(SETf LI1 '(A (B) ((C) (D)) )  VEC1 '#(0 1 2 3))
+#(0 1 2 3)
+
+(setf pa 'old)
+old
+
+(psetf pa 'new pao pa)
+nil
+
+pa
+new
+
+pao
+old
+
+(SETF (NTH 1 LI1) (QUOTE UU))
+UU
+
+(EVAL (QUOTE LI1))
+(A UU ((C) (D)))
+
+(SETF (ELT LI1 1) (QUOTE OO))
+OO
+
+(SETF (ELT VEC1 1) (QUOTE OO))
+OO
+
+(EVAL (QUOTE LI1))
+(A OO ((C) (D)))
+
+(EVAL (QUOTE VEC1))
+#(0 OO 2 3)
+
+(SETF (REST LI1) (QUOTE ((WW))))
+((WW))
+
+(EVAL (QUOTE LI1))
+(A (WW))
+
+(SETF (FIRST LI1) (QUOTE AA))
+AA
+
+(FIRST LI1)
+AA
+
+(SETF (SECOND LI1) (QUOTE BB))
+BB
+
+(EVAL (QUOTE LI1))
+(AA BB)
+
+(SETF (THIRD LI1) (QUOTE BB))
+ERROR
+
+(EVAL (QUOTE LI1))
+(AA BB)
+
+
+(SETF (REST LI1) (QUOTE (2 3 4 5 6 7 8 9 10)))
+(2 3 4 5 6 7 8 9 10)
+
+(SETF (SECOND LI1) 22)
+22
+
+(EVAL (QUOTE LI1))
+(AA 22 3 4 5 6 7 8 9 10)
+
+(SETF (THIRD LI1) (QUOTE 33))
+33
+
+(SETF (FOURTH LI1) (QUOTE 44))
+44
+
+(SETF (FIFTH LI1) (QUOTE 55))
+55
+
+(SETF (SIXTH LI1) (QUOTE 66))
+66
+
+(SETF (SEVENTH LI1) (QUOTE 77))
+77
+
+(SETF (EIGHTH LI1) (QUOTE 88))
+88
+
+(SETF (NINTH LI1) (QUOTE 99))
+99
+
+(SETF (TENTH LI1) (QUOTE 1010))
+1010
+
+(EVAL (QUOTE LI1))
+(AA 22 33 44 55 66 77 88 99 1010)
+
+(SETF (FIRST LI1) (QUOTE (((A)))))
+(((A)))
+
+(SETF (CAAAR LI1) (QUOTE UU))
+UU
+
+(CAAAR LI1)
+UU
+
+(CAR LI1)
+((UU))
+
+(SETF (CAAR LI1) (QUOTE OO))
+OO
+
+(EVAL (QUOTE LI1))
+((OO) 22 33 44 55 66 77 88 99 1010)
+
+(SETF (CAR LI1) (QUOTE II))
+II
+
+(EVAL (QUOTE LI1))
+(II 22 33 44 55 66 77 88 99 1010)
+
+(SETF (CDDDR LI1) (QUOTE PP))
+PP
+
+(EVAL (QUOTE LI1))
+(II 22 33 . PP)
+
+(SETF (CADDR LI1) (QUOTE 333))
+333
+
+(EVAL (QUOTE LI1))
+(II 22 333 . PP)
+
+(SETF (SVREF VEC1 2) (QUOTE KK))
+KK
+
+(EVAL (QUOTE VEC1))
+#(0 OO KK 3)
+
+(SETF (GET (QUOTE A) (QUOTE B)) (QUOTE UU))
+UU
+
+(GET (QUOTE A) (QUOTE B))
+UU
+
+(SETF (GETF (CADR (SETQ XX (QUOTE (AAA (I1 V1 I2 V2))))) (QUOTE I2))
+
+(QUOTE V222))
+V222
+
+(EVAL (QUOTE XX))
+(AAA (I1 V1 I2 V222))
+
+(GETF (CADR XX) (QUOTE I2))
+V222
+
+(GETF (CADR XX) (QUOTE I1))
+V1
+
+(SETF (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP1)) "doc 1")
+"doc 1"
+
+(SETF (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2)) "doc 2")
+"doc 2"
+
+(DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2))
+#+XCL (TYP2 . "doc 2") #-XCL "doc 2"
+
+(SETF (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2)) "doc 3")
+"doc 3"
+
+(DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2))
+#+XCL (TYP2 . "doc 3") #-XCL "doc 3"
+
+(symbol-plist 'beispiel)
+#+XCL (DOCUMENTATION ((TYP2 . "doc 3") (TYP1 . "doc 1")))
+#+CLISP (SYSTEM::DOCUMENTATION-STRINGS (TYP2 "doc 3" TYP1 "doc 1"))
+#+ALLEGRO (EXCL::%DOCUMENTATION ((TYP2 . "doc 3") (TYP1 . "doc 1")))
+#-(or XCL CLISP ALLEGRO) UNKNOWN
+
+(SETF (SYMBOL-VALUE (QUOTE XX)) (QUOTE VOELLIGNEU))
+VOELLIGNEU
+
+(EVAL (QUOTE XX))
+VOELLIGNEU
+
+(PROGN
+  (SETF (SYMBOL-FUNCTION (QUOTE FF))
+        (COERCE (QUOTE (LAMBDA (X) (PRINT X) (QUOTE HELLO))) (QUOTE FUNCTION)))
+  NIL)
+NIL
+
+(FF 5)
+HELLO
+
+(defun xx nil 'a)
+xx
+
+(progn (setf (symbol-function 'xx1) (symbol-function 'xx)) nil)
+nil
+
+(xx1)
+a
+
+(setq l '(a 1 c d))
+(a 1 c d)
+
+(setf (the integer (cadr l)) 100)
+100
+
+l
+(a 100 c d)
+
+(progn (setf a (make-hash-table)) t)
+t
+
+(setf (gethash 'color a) 'brown)
+brown
+
+(gethash 'color a)
+brown
+
+(defstruct schiff masse)
+schiff
+
+(progn (setf s1 (make-schiff)) nil)
+nil
+
+(setf (schiff-masse s1) 500)
+500
+
+(schiff-masse s1)
+500
+
+(defmacro setf-test (v) `(svref ,v 3))
+setf-test
+
+(progn (setf (macro-function 'setf-test1) (macro-function 'setf-test)) nil)
+nil
+
+(setf (setf-test vec1) 'oho)
+oho
+
+(eval 'vec1)
+#(0 OO KK oho)
+
+(setf (setf-test1 vec1) 'hihi)
+hihi
+
+(eval 'vec1)
+#(0 OO KK hihi)
+
+; (setf (displace ?? (svref vec1 3)) "aha")
+; aha
+
+; (eval 'vec1)
+; #(0 oo KK aha)
+
+(progn (setf a (make-array '(4 3))) nil)
+nil
+
+(aref a 2 2)
+#+XCL 0 #+(or CLISP AKCL ALLEGRO) NIL #-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(setf (apply #'aref a '(2 2)) 'xxxx)
+xxxx
+
+(aref a 2 2)
+xxxx
+
+(SETF (AREF '#(A B C) 1) (QUOTE II))
+II
+
+(setf b #*101010)
+#*101010
+
+(bit b 2)
+1
+
+(setf (bit b 2) 0)
+0
+
+(bit b 2)
+0
+
+(setf (sbit b 2) 1)
+1
+
+(sbit b 2)
+1
+
+(progn (setf a (make-array 5 :fill-pointer t)) t)
+t
+
+(fill-pointer a)
+5
+
+(setf (fill-pointer a) 3)
+3
+
+(fill-pointer a)
+3
+
+(setf str "hose")
+"hose"
+
+(setf (char str 0) #\d)
+#\d
+
+str
+"dose"
+
+(setf str "aaaxxxccc")
+"aaaxxxccc"
+
+(setf (subseq str 3 6) "bbb")
+"bbb"
+
+str
+"aaabbbccc"
+
+(setq x (list 'a 'b 'c))
+(a b c)
+
+(shiftf (cadr x) 'z)
+b
+
+x
+(a z c)
+
+(shiftf (cadr x) (cddr x) 'q)
+z
+
+x
+(a (c) . q)
+
+(progn
+ (defun ad (x) (values (car x) (cdr x)))
+ (defsetf ad (x) (a b) `(setf (values (car ,x) (cdr ,x)) (values ,a ,b)))
+ (setq x (cons 1 2) y 3 z 4 w 5 v 6 u 7))
+7
+
+(rotatef (ad x) (values y z) (values w v u))
+nil
+
+x
+(3 . 4)
+
+(list y z w v u)
+(5 6 1 2 nil)
+
+(multiple-value-list (shiftf (ad x) (values y z w) (values v u) (floor 89 10)))
+(3 4)
+
+x
+(5 . 6)
+
+(list y z w v u)
+(2 nil nil 8 9)
+
+(progn (defsetf subseq (sequence start &optional end) (new-sequence)
+                       `(progn (replace ,sequence ,new-sequence
+                                        :start1 ,start :end1 ,end)
+                       ,new-sequence)) t)
+t
+
+(setf s "asdfg" (subseq s 1 3) "xy")
+"xy"
+
+s
+"axyfg"
+
diff --git a/src/tests/steele7.tst b/src/tests/steele7.tst
new file mode 100644
index 000000000..fc5623514
--- /dev/null
+++ b/src/tests/steele7.tst
@@ -0,0 +1,456 @@
+;;;
+;;; testfile nach steele-beispielen
+;;;
+
+;7.3
+
+
+(let ((f '+))
+     (apply f '(1 2)))
+3
+
+(let    ((f #'-))
+        (apply f '(1 2)))
+-1
+(apply #'max 3 5 '(2 7 3))
+7
+
+(apply 'cons '((+ 2 3) 4))
+((+ 2 3) . 4)
+
+
+(apply #'+ '())
+0
+
+(apply #'(lambda (&key a b)(list a b)) '(:b 3))
+(nil 3)
+
+
+(funcall '+ 2 3)
+5
+
+(let    ((c (symbol-function '+)))
+        (funcall c 1 2 3 4))
+10
+
+
+;;abschnitt 7.4
+
+;progn
+(progn 1 2 3)
+3
+
+(progn (+ 2 1) 2)
+2
+
+(progn 1 2 (values  2 3))
+2
+
+(progn)
+nil
+
+
+;prog1
+(prog1 1 2 3)
+1
+
+(prog1 3 (+ 1 2) 2)
+3
+
+(prog1 (values  2 3) 1 2 )
+2
+
+(let ((x '(a b c)))
+(prog1 (car x)(rplaca x 'foo)))
+a
+
+;prog2
+
+(prog2 1 2 3)
+2
+
+(prog2  (+ 1 2) 2 3)
+2
+
+(prog2 1 (values  2 3) 4)
+2
+
+;7.5
+
+;let
+(setf a 0)
+0
+
+(let ((a 1)(b 2) c )
+     (declare (integer a b))
+     (list a b c))
+(1 2 nil)
+
+
+(let ((a 1)(b a))
+     (declare (integer a b))
+     (list a b))
+(1 0)
+
+;let*
+(let* ((a 1)(b 2) c )
+     (declare (integer a b))
+     (list a b c))
+(1 2 nil)
+
+
+(let* ((a 1)(b a))
+     (declare (integer a b))
+     (list a b))
+(1 1)
+
+;compiler-let (?)
+
+
+;progv
+
+(progv '(a b c) '(1 2 3)(+ a b c))
+6
+
+(progv '(a b c) '(1 2)(list a b c))
+error
+
+(let ((v '(a b c))
+      (val '(3 2 1)))
+     (progv v val (mapcar #'eval v)))
+(3 2 1)
+
+
+;flet
+
+(flet ((plus (a b)(+ a b))
+       (minus (a b)(- a b)))
+      (list (plus 1 2)(minus 1 2)))
+(3 -1)
+
+
+(list (flet ( (+ (a b)(- a b)))(+ 3 2))(+ 3 2))
+(1 5)
+
+(flet ((+ (a b)(+ (+ a b a) b)))(+ 3 2))
+10
+
+;Labels
+(labels ((queue (l)(if (car l)(queue (cdr l))'ende)))(queue '(1 2 3)))
+ENDE
+
+(labels ((+ (a b)(* a (+ a a b))))(+ 1 2 3))
+ERROR
+
+;macrolet ?
+
+
+;7.6
+
+;if
+
+(let ((a t)(b nil))(list (if a 1 2)(if b 1 2)(if a 1)(if b 1)))
+(1 2 1 nil)
+
+
+;when
+(let ((a t)(b nil))(list (when a 1 2)(when b 1 2)(when a 1)))
+(2 nil 1)
+
+
+;unless
+(let ((a t)(b nil))(list (unless a 1 2)(unless b 1 2)(unless a 1)))
+(nil 2 nil)
+
+
+;cond
+(let ((a t)(b 10)(c nil))
+     (list (cond (a 1)(t 'END))(cond (b)(t 'END))(cond (c 1)(t 'END))))
+(1 10 END)
+
+
+;case
+(case (+  1 2)
+      (1 -1)
+      (2 -2)
+      (3 -3))
+-3
+
+(case (+  1 2)
+      (1 -1)
+      (2 -2))
+nil
+
+
+;(case (+  1 2)
+;      (1 -1)
+;      (2 -2)
+;      (1 -1)
+;      (3 -3))
+;ERROR
+
+
+(case (+  1 2)
+      ((1 3) -1)
+      (2 -2)
+      (otherwise 100))
+-1
+
+
+;
+;(case (+  1 2)
+;      ((1 3) -1)
+;      ((2 1) -2)
+;      (t 100))
+;ERROR          ;weil ein key nur einmal erscheinen darf!
+;
+
+
+
+;typecase
+
+(typecase (+  1 2)
+      (list -2)
+      (null -3)
+      (integer -1))
+-1
+
+;7.7
+
+;block
+
+(block blocktest (if t (return 0) ) 1)
+error
+
+(block blocktest (if t (return-from blocktest 0) ) 1)
+0
+
+
+(block blocktest (if nil (return-from blocktest 0) ) 1)
+1
+
+
+(block blocktest (catch 'catcher
+                        (if t (throw 'catcher 0) ) 1))
+0
+
+
+;7.8
+
+;7.8.1
+
+;loop
+
+(let ((i 10))
+(loop (if (< (decf i) 1)(return i))))
+0
+
+
+(let ((i 10))
+     (catch 'catcher
+            (loop (if (< (decf i) 1)(return i)))))
+0
+
+;7.8.2
+;do,do*
+
+(setf a 0)
+0
+
+
+(do ((a 1 (+ a 1))(b a))
+    ((> a 9) (list b c))
+    (setf c (+ a b)))
+(0 9)
+
+(do* ((a 1 (+ a 1))(b a))
+    ((> a 9) b)
+    )
+1
+
+(let ((a 0))
+(do* ((a 1 (+ a 1))(b a))
+    ((> a 9) a)(declare (integer a b)))
+    a)
+0
+
+
+
+;7.8.3
+
+
+;dolist
+(let    ((l '(1 2 3))
+         (r 0))
+        (dolist (x l r)
+                (setf r (+ r  x)) ))
+6
+
+
+;dolist
+(let ((l '(1 2 3)))
+(dolist (x l)(if (> 0 x)(incf x)(return 10))))
+10
+
+(let ((l '(1 2 3)))
+(dolist (x l )(incf x)))
+nil
+
+;dotimes
+
+(let ((s 0))
+(dotimes (i (+ 1 9)s)(setf s (+ s i))))
+45
+
+
+;7.8.4
+
+
+;mapcar
+
+(mapcar #'abs '(3 -4 2 -5 -6))
+(3 4 2 5 6)
+
+(mapcar #'cons '(a b c) '(1 2 3))
+((a . 1) (b . 2) (c . 3))
+
+
+;maplist
+
+(maplist #'(lambda (x)(cons 'foo x))'(a b c d))
+((foo a b c d)(foo b c d)(foo c d)(foo d))
+
+
+(maplist #'(lambda (x) (if (member (car x)(cdr x)) 0 1))
+         '(a b a c d b c))
+(0 0 1 0 1 1 1)
+
+
+;mapc
+(mapc #'abs '(3 -4 2 -5 -6))
+(3 -4 2 -5 -6)
+
+;mapc
+
+(mapl #'(lambda (x y)(cons x y))'(a b c d)'(1 2 3 4))
+(a b c d)
+
+;mapcan
+
+(mapcan #'(lambda (x)(and (numberp x)(list x)))'(a 1 b c 3 4 d 5))
+(1 3 4 5)
+
+;mapcon
+
+(mapcon #'(lambda (x)(and (oddp (car x))(list (car x))))'(5 4 3 2 1))
+(5 3 1)
+
+;7.8.5
+
+;tagbody
+(let ((a 0))
+(tagbody (if nil (go tag0) (go tag1))
+         (this will never be reached)
+         tag0
+         (setf a 1)
+         tag1
+         (setf a 2))a)
+2
+
+
+(let ((a 0))
+(tagbody (if t (go tag0) (go tag1))
+         (this will never be reached)
+         tag0
+         (setf a 1)
+         )a)
+1
+
+
+
+
+;prog*
+
+(let ((z '(1 0)))
+     (prog* ((y z)(x (car y)))
+            (return x)))
+1
+(prog  (a (b 1))
+         (if a (go tag0) (go tag1))
+         (this will never be reached)
+         tag0
+         (setf a 1)
+         (this will never be reached)
+         tag1
+         (setf a 2))
+nil
+
+
+
+(prog  (a (b 1))
+         (if a (return nil) (go tag1))
+         (this will never be reached)
+         tag0
+         (return (list a 1))
+         tag1
+         (setf a 2)
+         (go tag0))
+(2 1)
+
+
+;7.9
+
+;multiple-value-bind
+(defun adder (x y)(values (+ 1 x)(+ 1 y) ) )
+adder
+
+
+(multiple-value-bind (a b)(adder 1 2)(+ a b))
+5
+
+(defun adder (x y)(values-list (list  (+ 1 x)(+ 1 y))))
+adder
+
+
+(multiple-value-bind (a b)(adder 1 2)(+ a b))
+5
+
+
+(multiple-value-list (floor -3 4))
+(-1 1)
+
+
+(multiple-value-call #'+ (floor 5 3)(floor 19 4))
+10
+
+(multiple-value-bind (c d)
+                     (multiple-value-prog1 (floor -3 4) (+ 1 2))
+                     (list c d))
+(-1 1)
+
+
+(multiple-value-bind (x)(floor 5 3)(list x))
+(1)
+
+
+(multiple-value-bind (x y)(floor 5 3)(list x y))
+(1 2)
+
+
+(multiple-value-bind (x y z)(floor 5 3)(list x y z))
+(1 2 nil)
+
+
+
+
+(multiple-value-setq (a b) (values 10 20))
+10
+
+b
+20
+
+
+;7.10
+
+;catch/throw/unwind-protect
+
diff --git a/src/tests/streams.tst b/src/tests/streams.tst
new file mode 100644
index 000000000..f4e1fcb34
--- /dev/null
+++ b/src/tests/streams.tst
@@ -0,0 +1,740 @@
+(progn (in-package "USER") t)
+t
+
+#-(or ECLS AKCL ALLEGRO) (PRIN1-TO-STRING (MAKE-BROADCAST-STREAM))
+#+XCL "#<%TYPE-STRUCTURE-STREAM NIL>"
+#+CLISP "#<BROADCAST-STREAM>"
+#-(or ECLS XCL CLISP AKCL ALLEGRO) UNKNOWN
+
+(PROGN (SETQ S1 (OPEN "d1.plc" :DIRECTION :OUTPUT))
+(SETQ S2 (OPEN "d2.plc" :DIRECTION :OUTPUT))
+(SETQ S3 (OPEN "d3.plc" :DIRECTION :OUTPUT))
+(SETQ B1 (MAKE-BROADCAST-STREAM S1 S2 S3 *STANDARD-OUTPUT*)) T)   T
+
+(PRINT "test broadcast satz 1" B1)   "test broadcast satz 1"
+
+(PRINT "test broadcast satz 2" B1)   "test broadcast satz 2"
+
+(PRINT "test broadcast satz 3" B1)   "test broadcast satz 3"
+
+(CLOSE S1)   T
+
+(CLOSE S2)   T
+
+(CLOSE S3)   T
+
+(PROGN (SETQ S (OPEN "d1.plc")) T)   T
+
+(READ S)   "test broadcast satz 1"
+
+(READ S)   "test broadcast satz 2"
+
+(READ S)   "test broadcast satz 3"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "d2.plc")) T)   T
+
+(READ S)   "test broadcast satz 1"
+
+(READ S)   "test broadcast satz 2"
+
+(READ S)   "test broadcast satz 3"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "d3.plc")) T)   T
+
+(READ S)   "test broadcast satz 1"
+
+(READ S)   "test broadcast satz 2"
+
+(READ S)   "test broadcast satz 3"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t0.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT (QUOTE READ1) S)   READ1
+
+(PRINT (QUOTE READ2) S)   READ2
+
+(CLOSE S)   T
+
+(PROGN (SETQ INPTW (OPEN "t0.plc"))
+(SETQ S1 (OPEN "d1.plc" :DIRECTION :OUTPUT))
+(SETQ S2 (OPEN "d2.plc" :DIRECTION :OUTPUT))
+(SETQ SY (MAKE-SYNONYM-STREAM (QUOTE S2)))
+(SETQ S3 (OPEN "d3.plc" :DIRECTION :OUTPUT))
+(SETQ TW (MAKE-TWO-WAY-STREAM INPTW S3))
+(SETQ S4 (OPEN "d4.plc" :DIRECTION :OUTPUT))
+(SETQ EC (MAKE-ECHO-STREAM INPTW S4))
+(SETQ S5 (OPEN "d5.plc" :DIRECTION :OUTPUT))
+(SETQ S6 (OPEN "d6.plc" :DIRECTION :OUTPUT))
+(SETQ B1 (MAKE-BROADCAST-STREAM S5 S6))
+(SETQ S7 (OPEN "d7.plc" :DIRECTION :OUTPUT))
+(SETQ B2 (MAKE-BROADCAST-STREAM S1 SY TW EC B1 S7)) T)   T
+
+(PRINT "w to b2 1.satz" B2)   "w to b2 1.satz"
+
+(PRINT "w to sy" SY)   "w to sy"
+
+(PRINT "w to b2 2.satz" B2)   "w to b2 2.satz"
+
+(PRINT "w to tw" TW)   "w to tw"
+
+(PRINT "w to b2 3.satz" B2)   "w to b2 3.satz"
+
+(PRINT "w to ec" EC)   "w to ec"
+
+(PRINT "w to b2 4.satz" B2)   "w to b2 4.satz"
+
+(PRINT "w to b1" B1)   "w to b1"
+
+(PRINT "w to b2 5.satz" B2)   "w to b2 5.satz"
+
+(PRINT "w to s7" S7)   "w to s7"
+
+(PRINT "w to b2 6.satz" B2)   "w to b2 6.satz"
+
+(READ TW)   READ1
+
+(READ EC)   READ2
+
+(PRINT "w to b2 7.satz" B2)   "w to b2 7.satz"
+
+(PRINT "w to b2 8.satz" B2)   "w to b2 8.satz"
+
+(CLOSE INPTW)   T
+
+(CLOSE S1)   T
+
+(CLOSE S2)   T
+
+(CLOSE S3)   T
+
+(CLOSE S4)   T
+
+(CLOSE S5)   T
+
+(CLOSE S6)   T
+
+(CLOSE S7)   T
+
+(PROGN (SETQ S (OPEN "d1.plc")) T)   T
+
+(READ S)   "w to b2 1.satz"
+
+(READ S)   "w to b2 2.satz"
+
+(READ S)   "w to b2 3.satz"
+
+(READ S)   "w to b2 4.satz"
+
+(READ S)   "w to b2 5.satz"
+
+(READ S)   "w to b2 6.satz"
+
+(READ S)   "w to b2 7.satz"
+
+(READ S)   "w to b2 8.satz"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "d2.plc")) T)   T
+
+(READ S)   "w to b2 1.satz"
+
+(READ S)   "w to sy"
+
+(READ S)   "w to b2 2.satz"
+
+(READ S)   "w to b2 3.satz"
+
+(READ S)   "w to b2 4.satz"
+
+(READ S)   "w to b2 5.satz"
+
+(READ S)   "w to b2 6.satz"
+
+(READ S)   "w to b2 7.satz"
+
+(READ S)   "w to b2 8.satz"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "d3.plc")) T)   T
+
+(READ S)   "w to b2 1.satz"
+
+(READ S)   "w to b2 2.satz"
+
+(READ S)   "w to tw"
+
+(READ S)   "w to b2 3.satz"
+
+(READ S)   "w to b2 4.satz"
+
+(READ S)   "w to b2 5.satz"
+
+(READ S)   "w to b2 6.satz"
+
+(READ S)   "w to b2 7.satz"
+
+(READ S)   "w to b2 8.satz"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "d4.plc")) T)   T
+
+(READ S)   "w to b2 1.satz"
+
+(READ S)   "w to b2 2.satz"
+
+(READ S)   "w to b2 3.satz"
+
+(READ S)   "w to ec"
+
+(READ S)   "w to b2 4.satz"
+
+(READ S)   "w to b2 5.satz"
+
+(READ S)   "w to b2 6.satz"
+
+(READ S)   READ2
+
+(READ S)   "w to b2 7.satz"
+
+(READ S)   "w to b2 8.satz"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "d5.plc")) T)   T
+
+(READ S)   "w to b2 1.satz"
+
+(READ S)   "w to b2 2.satz"
+
+(READ S)   "w to b2 3.satz"
+
+(READ S)   "w to b2 4.satz"
+
+(READ S)   "w to b1"
+
+(READ S)   "w to b2 5.satz"
+
+(READ S)   "w to b2 6.satz"
+
+(READ S)   "w to b2 7.satz"
+
+(READ S)   "w to b2 8.satz"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "d6.plc")) T)   T
+
+(READ S)   "w to b2 1.satz"
+
+(READ S)   "w to b2 2.satz"
+
+(READ S)   "w to b2 3.satz"
+
+(READ S)   "w to b2 4.satz"
+
+(READ S)   "w to b1"
+
+(READ S)   "w to b2 5.satz"
+
+(READ S)   "w to b2 6.satz"
+
+(READ S)   "w to b2 7.satz"
+
+(READ S)   "w to b2 8.satz"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "d7.plc")) T)   T
+
+(READ S)   "w to b2 1.satz"
+
+(READ S)   "w to b2 2.satz"
+
+(READ S)   "w to b2 3.satz"
+
+(READ S)   "w to b2 4.satz"
+
+(READ S)   "w to b2 5.satz"
+
+(READ S)   "w to s7"
+
+(READ S)   "w to b2 6.satz"
+
+(READ S)   "w to b2 7.satz"
+
+(READ S)   "w to b2 8.satz"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t1.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t1" S)   "1.satz t1"
+
+(PRINT "2.satz t1" S)   "2.satz t1"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t2.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t2" S)   "1.satz t2"
+
+(PRINT "2.satz t2" S)   "2.satz t2"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t3.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t3" S)   "1.satz t3"
+
+(PRINT "2.satz t3" S)   "2.satz t3"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t4.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t4" S)   "1.satz t4"
+
+(PRINT "2.satz t4" S)   "2.satz t4"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t5.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t5" S)   "1.satz t5"
+
+(PRINT "2.satz t5" S)   "2.satz t5"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t6.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t6" S)   "1.satz t6"
+
+(PRINT "2.satz t6" S)   "2.satz t6"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t7.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t7" S)   "1.satz t7"
+
+(PRINT "2.satz t7" S)   "2.satz t7"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t8.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t8" S)   "1.satz t8"
+
+(PRINT "2.satz t8" S)   "2.satz t8"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t9.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t9" S)   "1.satz t9"
+
+(PRINT "2.satz t9" S)   "2.satz t9"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S (OPEN "t10.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINT "1.satz t10" S)   "1.satz t10"
+
+(PRINT "2.satz t10" S)   "2.satz t10"
+
+(CLOSE S)   T
+
+(PROGN (SETQ S1 (OPEN "t1.plc")) (SETQ S2 (OPEN "t2.plc"))
+(SETQ S3 (OPEN "t3.plc")) (SETQ S4 (OPEN "t4.plc")) (SETQ S5 (OPEN
+"t5.plc"))
+(SETQ C1 (MAKE-CONCATENATED-STREAM S1 S2 S3))
+(SETQ C2 (MAKE-CONCATENATED-STREAM S4 S5)) T)   T
+
+(READ C1)   "1.satz t1"
+
+(READ C2)   "1.satz t4"
+
+(READ C1)   "2.satz t1"
+
+(READ C1)   "1.satz t2"
+
+(READ C2)   "2.satz t4"
+
+(READ C2)   "1.satz t5"
+
+(READ C1)   "2.satz t2"
+
+(READ C1)   "1.satz t3"
+
+(READ C1)   "2.satz t3"
+
+(READ C2)   "2.satz t5"
+
+(CLOSE S1)   T
+
+(CLOSE S2)   T
+
+(CLOSE S3)   T
+
+(CLOSE S4)   T
+
+(CLOSE S5)   T
+
+(PROGN (SETQ S1 (OPEN "t1.plc")) (SETQ S2 (OPEN "t2.plc"))
+(SETQ S3 (OPEN "t3.plc")) (SETQ S4 (OPEN "t4.plc")) (SETQ S5 (OPEN
+"t5.plc"))
+(SETQ S6 (OPEN "t6.plc")) (SETQ S7 (OPEN "t7.plc")) (SETQ S8 (OPEN
+"t8.plc"))
+(SETQ S9 (OPEN "t9.plc")) (SETQ S10 (OPEN "t10.plc"))
+(SETQ C1 (MAKE-CONCATENATED-STREAM S1 S2))
+(SETQ C2 (MAKE-CONCATENATED-STREAM S3))
+(SETQ C3 (MAKE-CONCATENATED-STREAM C1 C2 S4))
+(SETQ C4 (MAKE-CONCATENATED-STREAM S5 S6 S7 S8 S9 S10)) T)   T
+
+(READ C4)   "1.satz t5"
+
+(READ C3)   "1.satz t1"
+
+(READ C4)   "2.satz t5"
+
+(READ C4)   "1.satz t6"
+
+(READ C3)   "2.satz t1"
+
+(READ C3)   "1.satz t2"
+
+(READ C4)   "2.satz t6"
+
+(READ C4)   "1.satz t7"
+
+(READ C4)   "2.satz t7"
+
+(READ C3)   "2.satz t2"
+
+(READ C3)   "1.satz t3"
+
+(READ C3)   "2.satz t3"
+
+(READ C4)   "1.satz t8"
+
+(READ C4)   "2.satz t8"
+
+(READ C4)   "1.satz t9"
+
+(READ C4)   "2.satz t9"
+
+(READ C3)   "1.satz t4"
+
+(READ C3)   "2.satz t4"
+
+(READ C4)   "1.satz t10"
+
+(READ C4)   "2.satz t10"
+
+(CLOSE S1)   T
+
+(CLOSE S2)   T
+
+(CLOSE S3)   T
+
+(CLOSE S4)   T
+
+(CLOSE S5)   T
+
+(CLOSE S6)   T
+
+(CLOSE S7)   T
+
+(CLOSE S8)   T
+
+(CLOSE S9)   T
+
+(CLOSE S10)   T
+
+(SETQ STR1 "test 123456")   "test 123456"
+
+(PROGN (SETQ S1 (MAKE-STRING-INPUT-STREAM STR1)) T)   T
+
+(READ S1)   TEST
+
+(READ-CHAR S1)   #\1
+
+(READ-CHAR S1)   #\2
+
+(UNREAD-CHAR #\2 S1)   NIL
+
+(READ-CHAR S1)   #\2
+
+(READ-CHAR S1)   #\3
+
+(READ-CHAR S1)   #\4
+
+(UNREAD-CHAR #\A S1)   ERROR
+
+(READ-CHAR S1)   #\5
+
+(READ-CHAR S1)   #\6
+
+(CLOSE S1)   T
+
+STR1   "test 123456"
+
+(multiple-value-list (READ-FROM-STRING "012345 789"))   (12345 7)
+
+(multiple-value-list (READ-FROM-STRING "012345 789" T NIL
+                :PRESERVE-WHITESPACE T))   (12345 6)
+
+(multiple-value-list (READ-FROM-STRING "012345 789" T NIL :END 4))
+  (123 4)
+
+(multiple-value-list (READ-FROM-STRING "012345 789" T NIL :START 2))
+  (2345 7)
+
+(PROGN (SETQ STRGSTREAM (MAKE-STRING-INPUT-STREAM "0123456789" 5 8))
+T)   T
+
+(READ STRGSTREAM)   567
+
+(PROGN (SETQ STRGSTREAM
+(MAKE-STRING-INPUT-STREAM "wenn alles gut geht ist das ein stream 012"))
+T)   T
+
+(READ STRGSTREAM)   WENN
+
+(READ STRGSTREAM)   ALLES
+
+(READ STRGSTREAM)   GUT
+
+(READ STRGSTREAM)   GEHT
+
+(READ STRGSTREAM)   IST
+
+(READ STRGSTREAM)   DAS
+
+(READ STRGSTREAM)   EIN
+
+(READ STRGSTREAM)   STREAM
+
+(READ STRGSTREAM)   12
+
+(PROGN (SETQ STRGSTREAM (MAKE-STRING-OUTPUT-STREAM)) T)   T
+
+(PRINC "das " STRGSTREAM)   "das "
+
+(PRINC "ist " STRGSTREAM)   "ist "
+
+(PRINC "ein " STRGSTREAM)   "ein "
+
+(PRINC "string " STRGSTREAM)   "string "
+
+(PRINC "output " STRGSTREAM)   "output "
+
+(PRINC "stream " STRGSTREAM)   "stream "
+
+(GET-OUTPUT-STREAM-STRING STRGSTREAM)   "das ist ein string output stream "
+
+(GET-OUTPUT-STREAM-STRING STRGSTREAM)   ""
+
+(PRINC "das ist ein neuer string output stream" STRGSTREAM)
+"das ist ein neuer string output stream"
+
+(GET-OUTPUT-STREAM-STRING STRGSTREAM)
+"das ist ein neuer string output stream"
+
+(SETQ *PRINT-LENGTH* 50)   50
+
+(WRITE-TO-STRING 123456789)   "123456789"
+
+"(write-to-string '#1=(123456789 . #1#))"
+"(write-to-string '#1=(123456789 . #1#))"
+
+(PRIN1-TO-STRING "abc")   "\"abc\""
+
+(PRINC-TO-STRING "abc")   "abc"
+
+(PROGN (SETQ OS (MAKE-STRING-OUTPUT-STREAM)) T)   T
+
+(SETQ S50 "123456789A123456789B123456789C123456789D12345678
+E")   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(SETQ S49 "123456789A123456789B123456789C123456789D1234567
+*")   "123456789A123456789B123456789C123456789D1234567
+*"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S49 OS)   "123456789A123456789B123456789C123456789D1234567
+*"
+
+(PRINC "A" OS)   "A"
+
+(PRINC "B" OS)   "B"
+
+(PRINC "C" OS)   "C"
+
+(LENGTH (PRINC (GET-OUTPUT-STREAM-STRING OS)))   402
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S50 OS)   "123456789A123456789B123456789C123456789D12345678
+E"
+
+(PRINC S49 OS)   "123456789A123456789B123456789C123456789D1234567
+*"
+
+(PRINC S49 OS)   "123456789A123456789B123456789C123456789D1234567
+*"
+
+(PRINC S49 OS)   "123456789A123456789B123456789C123456789D1234567
+*"
+
+(PRINC S49 OS)   "123456789A123456789B123456789C123456789D1234567
+*"
+
+(LENGTH (PRINC (GET-OUTPUT-STREAM-STRING OS)))   496
+
+(PROGN (SETQ OS (OPEN "d0.plc" :DIRECTION :OUTPUT))
+(SETQ OS1 (OPEN "d1.plc" :DIRECTION :OUTPUT))
+(SETQ IS (OPEN "t0.plc" :DIRECTION :OUTPUT)) T)   T
+
+(PRINC "'(a b #.(print \"1.zwischenwert\" os1) c d)" IS)
+"'(a b #.(print \"1.zwischenwert\" os1) c d)"
+
+(PRINC "'(a b #.(prin1-to-string \"2.zwischenwert\") c d)" IS)
+"'(a b #.(prin1-to-string \"2.zwischenwert\") c d)"
+
+(PRINC "'(a b #.(format nil  \"3.zwischenwert\") c d)" IS)
+"'(a b #.(format nil  \"3.zwischenwert\") c d)"
+
+(CLOSE IS)   T
+
+(PROGN (SETQ IS (OPEN "t0.plc")) (SETQ ES (MAKE-ECHO-STREAM IS OS))
+T)   T
+
+(PRINT "ausgabe os1" OS1)   "ausgabe os1"
+
+(READ ES)   (QUOTE (A B "1.zwischenwert" C D))
+
+(PRINT "ausgabe os1" OS1)   "ausgabe os1"
+
+(READ ES)   (QUOTE (A B "\"2.zwischenwert\"" C D))
+
+(PRINT "ausgabe os1" OS1)   "ausgabe os1"
+
+(READ ES)   (QUOTE (A B "3.zwischenwert" C D))
+
+(PRINT "ausgabe os1" OS1)   "ausgabe os1"
+
+(CLOSE IS)   T
+
+(CLOSE OS)   T
+
+(PROGN (SETQ IS (OPEN "d0.plc")) T)   T
+
+(READ IS)   (QUOTE (A B "1.zwischenwert" C D))
+
+(READ IS)   (QUOTE (A B "\"2.zwischenwert\"" C D))
+
+(READ IS)   (QUOTE (A B "3.zwischenwert" C D))
+
+(CLOSE IS)   T
+
+(CLOSE OS1)   T
+
+(PROGN (SETQ IS (OPEN "d1.plc")) T)   T
+
+(READ IS)   "ausgabe os1"
+
+(READ IS)   "1.zwischenwert"
+
+(READ IS)   "ausgabe os1"
+
+(READ IS)   "ausgabe os1"
+
+(READ IS)   "ausgabe os1"
+
+(READ IS)   "1.zwischenwert"
+
+(CLOSE IS)   T
+
+(progn (mapc #'delete-file (directory "*.plc")) t)
+T
+
+(progn
+(makunbound 's)
+(makunbound 's1)
+(makunbound 's2)
+(makunbound 's3)
+(makunbound 's4)
+(makunbound 's5)
+(makunbound 's6)
+(makunbound 's7)
+(makunbound 's8)
+(makunbound 's9)
+(makunbound 's10)
+(makunbound 'b1)
+(makunbound 'b2)
+(makunbound 'c1)
+(makunbound 'c2)
+(makunbound 'c3)
+(makunbound 'c4)
+(makunbound 'inptw)
+(makunbound 'sy)
+(makunbound 'tw)
+(makunbound 'ec)
+(makunbound 'str1)
+(makunbound 'strgstream)
+(makunbound 'os)
+(makunbound 'os1)
+(makunbound 'is)
+(makunbound 'es)
+(makunbound 's50)
+(makunbound 's49)
+(setq *print-length* nil)
+t)
+T
+
diff --git a/src/tests/streamslong.tst b/src/tests/streamslong.tst
new file mode 100644
index 000000000..c102cc71a
--- /dev/null
+++ b/src/tests/streamslong.tst
@@ -0,0 +1,12 @@
+(READ-FROM-STRING "123") 123
+
+(PRIN1-TO-STRING 123) "123"
+
+(SETQ *A* (MAKE-ARRAY 10. :ELEMENT-TYPE #-ecls 'STRING-CHAR #+ecls 'BASE-CHAR :FILL-POINTER 0)) ""
+
+(FORMAT *A* "XXX") NIL
+
+*A* "XXX"
+
+#+XCL (SYS::CHECK-STREAM-SYSTEM) #+XCL T
+
diff --git a/src/tests/strings.tst b/src/tests/strings.tst
new file mode 100644
index 000000000..503d96c73
--- /dev/null
+++ b/src/tests/strings.tst
@@ -0,0 +1,1146 @@
+
+(CHAR  "abcdef-dg1ndh" 0)
+#\a
+
+(CHAR  "abcdef-dg1ndh" 1)
+#\b
+
+(CHAR  "abcdef-dg1ndh" 6)
+#\-
+
+(CHAR  "abcdef-dg1ndh" 20)
+error
+
+(CHAR  "abcdef-dg1ndh")
+error
+
+(CHAR  "abcdef-dg1ndh" -3)
+error
+
+(CHAR)
+error
+
+(CHAR 2)
+error
+
+(CHAR  "abcde" 2 4)
+error
+
+(CHAR 'A 0)
+#+XCL #\A #-XCL ERROR
+
+(CHAR 'ANNA 0)
+#+XCL #\A #-XCL ERROR
+
+(SCHAR 'A 0)
+#+XCL #\A #-XCL ERROR
+
+(SCHAR 'ANNA 0)
+#+XCL #\A #-XCL ERROR
+
+(SCHAR  "abcdef-dg1ndh" 0)
+#\a
+
+(SCHAR  "abcdef-dg1ndh" 1)
+#\b
+
+(SCHAR  "abcdef-dg1ndh" 6)
+#\-
+
+(SCHAR  "abcdef-dg1ndh" 20)
+error
+
+(SCHAR  "abcdef-dg1ndh")
+error
+
+(SCHAR  "abcdef-dg1ndh" -3)
+error
+
+(SCHAR2)
+error
+
+(SCHAR2 2)
+error
+
+(SCHAR  "abcde" 2 4)
+error
+
+(STRING=  "foo" "foo")
+T
+
+(STRING=  "foo" "Foo")
+NIL
+
+(STRING=  "foo" "FOO")
+NIL
+
+(STRING=  "foo" "bar")
+NIL
+
+(STRING=  "together" "frog" :START1 1 :END1 3 :START2 2)
+T
+
+(STRING=  "abcdef" "defghi" :START1 3 :END2 3)
+T
+
+(STRING=  "abcdefghi" "uvdefmgnj" :START1 3 :END1 6 :START2 2 :END2
+5)
+T
+
+(STRING=  "abcdefg" "abcdefg" :END2 4)
+NIL
+
+(STRING=  "abcdef" "abcdef" :START1 1 :END1 4 :START2 4 :END2 1)
+error
+
+(STRING-EQUAL  "foo" "foo")
+T
+
+(STRING-EQUAL  "foo" "Foo")
+T
+
+(STRING-EQUAL  "foo" "FOO")
+T
+
+(STRING-EQUAL  "foo" "bar")
+NIL
+
+(STRING-EQUAL  "absDEfg-HijM1#r" "udEFG-hIfvd" :START1 3 :END1 10 :START2
+1 :END2
+8)
+T
+
+(STRING-EQUAL  "ABCdefg" "abcDEFG")
+T
+
+(STRING-EQUAL  "ABCdefg" "abcDEFG" :START1 3)
+NIL
+
+(STRING-EQUAL  "AbCdEf" "aBcDeF" :START1 5 :END1 3)
+error
+
+(STRING<  "" "abcdefgh")
+0
+
+(STRING<  "a" "abcdefgh")
+1
+
+(STRING<  "abc" "abcdefgh")
+3
+
+(STRING<  "cabc" "abcdefgh")
+NIL
+
+(STRING<  "abcdefgh" "abcdefgh")
+NIL
+
+(STRING<  "xyzabc" "abcdefgh")
+NIL
+
+(STRING<  "abc" "xyzabcdefgh")
+0
+
+(STRING<  "abcdefgh" "abcdefgh" :END1 4)
+4
+
+(STRING<  "xyzabc" "abcdefgh" :START1 3)
+6
+
+(STRING<  "abc" "xyzabcdefgh" :START2 3)
+3
+
+(STRING<  "abc" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING<  "abc" "xyzabcdefgh" :START2 3 :END2 5)
+NIL
+
+(STRING<  "abcdefgh" "")
+NIL
+
+(STRING<  "abcdefgh" "a")
+NIL
+
+(STRING<  "abcdefgh" "abc")
+NIL
+
+(STRING<  "abcdefgh" "cabc")
+0
+
+(STRING<  "abcdefgh" "xyzabc")
+0
+
+(STRING<  "xyzabcdefgh" "abc")
+NIL
+
+(STRING<  "abcdefgh" "abcdefgh" :END2 4)
+NIL
+
+(STRING<  "xyzabc" "abcdefgh" :START2 3)
+NIL
+
+(STRING<  "abc" "xyzabcdefgh" :START2 3)
+3
+
+(STRING<  "abc" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING<  "abc" "xyzabcdefgh" :START2 3 :END2 5)
+NIL
+
+(STRING<  "abcdef" "bcdefgh")
+0
+
+(STRING<  "abcdef" "abcdefgh" :START2 2)
+0
+
+(STRING<  "abcdef" "bngdabcdef" :START2 9 :END2 5)
+error
+
+(STRING>  "" "abcdefgh")
+NIL
+
+(STRING>  "a" "abcdefgh")
+NIL
+
+(STRING>  "abc" "abcdefgh")
+NIL
+
+(STRING>  "cabc" "abcdefgh")
+0
+
+(STRING>  "abcdefgh" "abcdefgh")
+NIL
+
+(STRING>  "xyzabc" "abcdefgh")
+0
+
+(STRING>  "abc" "xyzabcdefgh")
+NIL
+
+(STRING>  "abcdefgh" "abcdefgh" :END1 4)
+NIL
+
+(STRING>  "xyzabc" "abcdefgh" :START1 3)
+NIL
+
+(STRING>  "abc" "xyzabcdefgh" :START2 3)
+NIL
+
+(STRING>  "abc" "xyzabcdefgh" :START2 3 :END2 8)
+NIL
+
+(STRING>  "abc" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING>  "abcdefgh" "")
+0
+
+(STRING>  "abcdefgh" "a")
+1
+
+(STRING>  "abcdefgh" "abc")
+3
+
+(STRING>  "abcdefgh" "cabc")
+NIL
+
+(STRING>  "abcdefgh" "xyzabc")
+NIL
+
+(STRING>  "xyzabcdefgh" "abc")
+0
+
+(STRING>  "abcdefgh" "abcdefgh" :END2 4)
+4
+
+(STRING>  "xyzabc" "abcdefgh" :START2 3)
+0
+
+(STRING>  "abc" "xyzabcdefgh" :START2 3)
+NIL
+
+(STRING>  "abc" "xyzabcdefgh" :START2 3 :END2 8)
+NIL
+
+(STRING>  "abc" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING>  "abcde" "bc")
+NIL
+
+(STRING>  "bcdef" "abcde")
+0
+
+(STRING>  "bcdef" "abcdef")
+0
+
+(STRING>  "abcdefghij" "abcdefgh" :START1 1)
+1
+
+(STRING>  "ghijkl" "xyzabcd" :START2 6 :END2 4)
+error
+
+(STRING<  "" "abcdefgh")
+0
+
+(STRING<=  "a" "abcdefgh")
+1
+
+(STRING<=  "abc" "abcdefgh")
+3
+
+(STRING<=  "aaabce" "aaabcdefgh")
+NIL
+
+(STRING<=  "cabc" "abcdefgh")
+NIL
+
+(STRING<=  "abcdefgh" "abcdefgh")
+8
+
+(STRING<=  "xyzabc" "abcdefgh")
+NIL
+
+(STRING<=  "abc" "xyzabcdefgh")
+0
+
+(STRING<=  "abcdefgh" "abcdefgh" :END1 4)
+4
+
+(STRING<=  "xyzabc" "abcdefgh" :START1 3)
+6
+
+(STRING<=  "abc" "xyzabcdefgh" :START2 3)
+3
+
+(STRING<=  "abc" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING<=  "abc" "xyzabcdefgh" :START2 3 :END2 5)
+NIL
+
+(STRING<=  "abcdefgh" "")
+NIL
+
+(STRING<=  "abcdefgh" "a")
+NIL
+
+(STRING<=  "abcdefgh" "abc")
+NIL
+
+(STRING<=  "abcdefgh" "cabc")
+0
+
+(STRING<=  "abcdefgh" "xyzabc")
+0
+
+(STRING<=  "xyzabcdefgh" "abc")
+NIL
+
+(STRING<=  "abcdefgh" "abcdefgh" :END2 4)
+NIL
+
+(STRING<=  "xyzabc" "abcdefgh" :START2 3)
+NIL
+
+(STRING<=  "abc" "xyzabcdefgh" :START2 3)
+3
+
+(STRING<=  "abc" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING<=  "abc" "xyzabcdefgh" :START2 3 :END2 5)
+NIL
+
+(STRING<=  "abcdef" "bcdefgh")
+0
+
+(STRING<=  "abcdef" "abcdefgh" :START2 2)
+0
+
+(STRING<=  "abcdef" "bngdabcdef" :START2 9 :END2 5)
+error
+
+
+(STRING>= "" "abcdefgh")
+NIL
+
+(STRING>= "a" "abcdefgh")
+NIL
+
+(STRING>= "abc" "abcdefgh")
+NIL
+
+(STRING>= "cabc" "abcdefgh")
+0
+
+(STRING>= "abcdefgh" "abcdefgh")
+8
+
+(STRING>= "xyzabc" "abcdefgh")
+0
+
+(STRING>= "abc" "xyzabcdefgh")
+NIL
+
+(STRING>= "abcdefgh" "abcdefgh" :END1 4)
+NIL
+
+(STRING>= "xyzabc" "abcdefgh" :START1 3)
+NIL
+
+(STRING>= "abc" "xyzabcdefgh" :START2 3)
+NIL
+
+(STRING>= "abc" "xyzabcdefgh" :START2 3 :END2 8)
+NIL
+
+(STRING>= "abc" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING>= "abcdefgh" "")
+0
+
+(STRING>= "abcdefgh" "a")
+1
+
+(STRING>= "abcdefgh" "abc")
+3
+
+(STRING>= "abcdefgh" "cabc")
+NIL
+
+(STRING>= "abcdefgh" "xyzabc")
+NIL
+
+(STRING>= "xyzabcdefgh" "abc")
+0
+
+(STRING>= "abcdefgh" "abcdefgh" :END2 4)
+4
+
+(STRING>= "xyzabc" "abcdefgh" :START2 3)
+0
+
+(STRING>= "xyzabc" "abcdefgh" :START1 3)
+NIL
+
+(STRING>= "abc" "xyzabcdefgh" :START2 3)
+NIL
+
+(STRING>= "abc" "xyzabcdefgh" :START2 3 :END2 8)
+NIL
+
+(STRING>= "abc" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING>= "bcdef" "abcdef")
+0
+
+(STRING>= "abcdefghij" "abcdefgh" :START1 1)
+1
+
+(STRING>= "ghijkl" "xyzabcd" :START2 6 :END2 4)
+ERROR
+
+(STRING/= "" "abcdefgh")
+0
+
+(STRING/= "a" "abcdefgh")
+1
+
+(STRING/= "abc" "abcdefgh")
+3
+
+(STRING/= "cabc" "abcdefgh")
+0
+
+(STRING/= "abcdefgh" "abcdefgh")
+NIL
+
+(STRING/= "xyzabc" "abcdefgh")
+0
+
+(STRING/= "abc" "xyzabcdefgh")
+0
+
+(STRING/= "abcdefgh" "abcdefgh" :END1 4)
+4
+
+(STRING/= "xyzabc" "abcdefgh" :START1 3)
+6
+
+(STRING/= "abc" "xyzabcdefgh" :START2 3)
+3
+
+(STRING/= "abc" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING/= "abc" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING/= "abcdefgh" "")
+0
+
+(STRING/= "abcdefgh" "a")
+1
+
+(STRING/= "abcdefgh" "abc")
+3
+
+(STRING/= "abcdefgh" "cabc")
+0
+
+(STRING/= "abcdefgh" "xyzabc")
+0
+
+(STRING/= "xyzabcdefgh" "abc")
+0
+
+(STRING/= "abcdefgh" "abcdefgh" :END2 4)
+4
+
+(STRING/= "xyzabc" "abcdefgh" :START2 3)
+0
+
+(STRING/= "abc" "xyzabcdefgh" :START2 3)
+3
+
+(STRING/= "abc" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING/= "abc" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING/= "abcdefghi" "uvdefmgnj" :START1 3 :END1 6 :START2 2 :END2 5)
+NIL
+
+(STRING/= "abcdefg" "abcdefg" :END2 4)
+4
+
+(STRING/= "abcdef" "abcdef" :START1 1 :END1 4 :START2 4 :END2 1)
+ERROR
+
+(STRING-LESSP "" "abcDEFgh")
+0
+
+(STRING-LESSP "a" "Abcdefgh")
+1
+
+(STRING-LESSP "abc" "aBcDEfgh")
+3
+
+(STRING-LESSP "cABc" "aBCDefgh")
+NIL
+
+(STRING-LESSP "abCDeFgh" "abCDEfgh")
+NIL
+
+(STRING-LESSP "xyzAbc" "ABcCDfgh")
+NIL
+
+(STRING-LESSP "aBC" "xYZAbcdEfgh")
+0
+
+(STRING-LESSP "abcDEfgh" "abcDEfgh" :END1 4)
+4
+
+(STRING-LESSP "XYZabc" "ABcdefgh" :START1 3)
+6
+
+(STRING-LESSP "aBc" "xyZABcdefgh" :START2 3)
+3
+
+(STRING-LESSP "abc" "xyzabCDEcdefgh" :START2 3 :END2 8)
+3
+
+(STRING-LESSP "abc" "xyzABcdefgh" :START2 3 :END2 5)
+NIL
+
+(STRING-LESSP "abcdefgh" "")
+NIL
+
+(STRING-LESSP "Abcdefgh" "a")
+NIL
+
+(STRING-LESSP "ABCdefgh" "abc")
+NIL
+
+(STRING-LESSP "ABCdefgh" "cabc")
+0
+
+(STRING-LESSP "abcdefgh" "xyzABC")
+0
+
+(STRING-LESSP "xyzABCdefgh" "abc")
+NIL
+
+(STRING-LESSP "abcdEFgh" "abcdeFGh" :END2 4)
+NIL
+
+(STRING-LESSP "xyzaBC" "abCDefgh" :START2 3)
+NIL
+
+(STRING-LESSP "ABC" "xyzabcdefgh" :START2 3)
+3
+
+(STRING-LESSP "ABC" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING-LESSP "ABC" "xyzabcdefgh" :START2 3 :END2 5)
+NIL
+
+(STRING-LESSP "aBCDef" "bcdefgh")
+0
+
+(STRING-LESSP "aBCDef" "abcdefgh" :START2 2)
+0
+
+(STRING-LESSP "aBCDef" "bngdabcdef" :START2 9 :END2 5)
+ERROR
+
+(STRING-GREATERP "" "abcdefgh")
+NIL
+
+(STRING-GREATERP "A" "abcdefgh")
+NIL
+
+(STRING-GREATERP "ABc" "abcdefgh")
+NIL
+
+(STRING-GREATERP "CAbc" "abcdefgh")
+0
+
+(STRING-GREATERP "abcdefgh" "abcDEFgh")
+NIL
+
+(STRING-GREATERP "xyzabc" "abCDEfgh")
+0
+
+(STRING-GREATERP "ABC" "xyzabcdefgh")
+NIL
+
+(STRING-GREATERP "ABCdefgh" "abcdefgh" :END1 4)
+NIL
+
+(STRING-GREATERP "xyzaBc" "ABCdefgh" :START1 3)
+NIL
+
+(STRING-GREATERP "abc" "xyzABcdefgh" :START2 3)
+NIL
+
+(STRING-GREATERP "abc" "xyzABcdefgh" :START2 3 :END2 8)
+NIL
+
+(STRING-GREATERP "abc" "xyZAbcdefgh" :START2 3 :END2 5)
+2
+
+(STRING-GREATERP "abcdefgh" "")
+0
+
+(STRING-GREATERP "Abcdefgh" "a")
+1
+
+(STRING-GREATERP "ABCdefgh" "abc")
+3
+
+(STRING-GREATERP "ABCdefgh" "cabc")
+NIL
+
+(STRING-GREATERP "ABCdefgh" "xyzabc")
+NIL
+
+(STRING-GREATERP "xyzabcdefgh" "Abc")
+0
+
+(STRING-GREATERP "abcdefgh" "aBCDefgh" :END2 4)
+4
+
+(STRING-GREATERP "xyzabc" "abcdEFgh" :START2 3)
+0
+
+(STRING-GREATERP "ABC" "xyzabcdefgh" :START2 3)
+NIL
+
+(STRING-GREATERP "ABC" "xyzabcdefgh" :START2 3 :END2 8)
+NIL
+
+(STRING-GREATERP "ABC" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING-GREATERP "bCDEf" "abcde")
+0
+
+(STRING-GREATERP "bcDEF" "abcdef")
+0
+
+(STRING-GREATERP "abCDEfghij" "abcdefgh" :START1 1)
+1
+
+(STRING-GREATERP "ghijKl" "xyzabcd" :START2 6 :END2 4)
+ERROR
+
+(STRING-NOT-GREATERP  "" "abcdefgh")
+0
+
+(STRING-NOT-GREATERP  "A" "abcdefgh")
+1
+
+(STRING-NOT-GREATERP  "aBC" "abcdefgh")
+3
+
+(STRING-NOT-GREATERP  "CABc" "abcdefgh")
+NIL
+
+(STRING-NOT-GREATERP  "abcDEFgh" "abcdefgh")
+8
+
+(STRING-NOT-GREATERP  "xyzabc" "ABcdefgh")
+NIL
+
+(STRING-NOT-GREATERP  "abc" "xyzABcdefgh")
+0
+
+(STRING-NOT-GREATERP  "ABCDEFgh" "abcdefgh" :END1 4)
+4
+
+(STRING-NOT-GREATERP  "xyzabc" "aBCDefgh" :START1 3)
+6
+
+(STRING-NOT-GREATERP  "ABC" "xyzabcdefgh" :START2 3)
+3
+
+(STRING-NOT-GREATERP  "ABC" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING-NOT-GREATERP  "ABC" "xyzabcdefgh" :START2 3 :END2 5)
+NIL
+
+(STRING-NOT-GREATERP  "abcdefgh" "")
+NIL
+
+(STRING-NOT-GREATERP  "Abcdefgh" "a")
+NIL
+
+(STRING-NOT-GREATERP  "ABCdefgh" "abc")
+NIL
+
+(STRING-NOT-GREATERP  "ABCdefgh" "cabc")
+0
+
+(STRING-NOT-GREATERP  "ABCdefgh" "xyzabc")
+0
+
+(STRING-NOT-GREATERP  "xyzABCdefgh" "abc")
+NIL
+
+(STRING-NOT-GREATERP  "abcdeFgh" "abcdefgh" :END2 4)
+NIL
+
+(STRING-NOT-GREATERP  "xyzABC" "abcdefgh" :START2 3)
+NIL
+
+(STRING-NOT-GREATERP  "ABC" "xyzabcdefgh" :START2 3)
+3
+
+(STRING-NOT-GREATERP  "ABC" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING-NOT-GREATERP  "ABC" "xyzabcdefgh" :START2 3 :END2 5)
+NIL
+
+(STRING-NOT-GREATERP  "abcDEF" "bcdefgh")
+0
+
+(STRING-NOT-GREATERP  "abcDEF" "abcdefgh" :START2 2)
+0
+
+(STRING-NOT-GREATERP  "abcdef" "bngDAbcdef" :START2 9 :END2 5)
+error
+
+(STRING-NOT-LESSP  "" "abcdefgh")
+NIL
+
+(STRING-NOT-LESSP  "a" "Abcdefgh")
+NIL
+
+(STRING-NOT-LESSP  "ABC" "abcdefgh")
+NIL
+
+(STRING-NOT-LESSP  "CABc" "abcdefgh")
+0
+
+(STRING-NOT-LESSP  "ABCdefgh" "abcdefgh")
+8
+
+(STRING-NOT-LESSP  "xyzABC" "abcdefgh")
+0
+
+(STRING-NOT-LESSP  "ABC" "xyzabcdefgh")
+NIL
+
+(STRING-NOT-LESSP  "ABCdefgh" "abcdefgh" :END1 4)
+NIL
+
+(STRING-NOT-LESSP  "xyzABC" "abcdefgh" :START1 3)
+NIL
+
+(STRING-NOT-LESSP  "ABC" "xyzabcdefgh" :START2 3)
+NIL
+
+(STRING-NOT-LESSP  "ABC" "xyzabcdefgh" :START2 3 :END2 8)
+NIL
+
+(STRING-NOT-LESSP  "ABC" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING-NOT-LESSP  "abcdefgh" "")
+0
+
+(STRING-NOT-LESSP  "Abcdefgh" "a")
+1
+
+(STRING-NOT-LESSP  "ABCdefgh" "abc")
+3
+
+(STRING-NOT-LESSP  "abCDEfgh" "cabc")
+NIL
+
+(STRING-NOT-LESSP  "aBCdefgh" "xyzabc")
+NIL
+
+(STRING-NOT-LESSP  "xyzABcdefgh" "abc")
+0
+
+(STRING-NOT-LESSP  "abCDEfgh" "abcdefgh" :END2 4)
+4
+
+(STRING-NOT-LESSP  "xyzABc" "abcdefgh" :START2 3)
+0
+
+(STRING-NOT-LESSP  "ABC" "xyzabcdefgh" :START2 3)
+NIL
+
+(STRING-NOT-LESSP  "ABC" "xyzabcdefgh" :START2 3 :END2 8)
+NIL
+
+(STRING-NOT-LESSP  "ABC" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING-NOT-LESSP  "bCDef" "abcdef")
+0
+
+(STRING-NOT-LESSP  "ABCdefghij" "abcdefgh" :START1 1)
+1
+
+(STRING-NOT-LESSP  "ghIjkl" "xyzabcd" :START2 6 :END2 4)
+error
+
+(STRING-NOT-EQUAL  "" "abcdefgh")
+0
+
+(STRING-NOT-EQUAL  "A" "abcdefgh")
+1
+
+(STRING-NOT-EQUAL  "ABc" "abcdefgh")
+3
+
+(STRING-NOT-EQUAL  "cABc" "abcdefgh")
+0
+
+(STRING-NOT-EQUAL  "ABCdefgh" "abcdefgh")
+NIL
+
+(STRING-NOT-EQUAL  "xyzABc" "abcdefgh")
+0
+
+(STRING-NOT-EQUAL  "ABC" "xyzabcdefgh")
+0
+
+(STRING-NOT-EQUAL  "ABCdefgh" "abcdefgh" :END1 4)
+4
+
+(STRING-NOT-EQUAL  "xyzaBC" "abcdefgh" :START1 3)
+6
+
+(STRING-NOT-EQUAL  "ABC" "xyzabcdefgh" :START2 3)
+3
+
+(STRING-NOT-EQUAL  "ABC" "xyzabcdefgh" :START2 3 :END2 8)
+3
+
+(STRING-NOT-EQUAL  "ABC" "xyzabcdefgh" :START2 3 :END2 5)
+2
+
+(STRING-NOT-EQUAL  "abcdefgh" "")
+0
+
+(STRING-NOT-EQUAL  "Abcdefgh" "a")
+1
+
+(STRING-NOT-EQUAL  "aBCdefgh" "abc")
+3
+
+(STRING-NOT-EQUAL  "abcdefgh" "cABc")
+0
+
+(STRING-NOT-EQUAL  "abcdefgh" "xyzAbc")
+0
+
+(STRING-NOT-EQUAL  "xyzabcdefgh" "ABC")
+0
+
+(STRING-NOT-EQUAL  "abcdefgh" "abcDEFgh" :END2 4)
+4
+
+(STRING-NOT-EQUAL  "xyzabc" "aBCDefgh" :START2 3)
+0
+
+(STRING-NOT-EQUAL  "abc" "xyzABCdefgh" :START2 3)
+3
+
+(STRING-NOT-EQUAL  "abc" "xyzABCdefgh" :START2 3 :END2 8)
+3
+
+(STRING-NOT-EQUAL  "abc" "xyzABCdefgh" :START2 3 :END2 5)
+2
+
+(STRING/=  "abcdefghi" "uvdEFmgnj" :START1 3 :END1 6 :START2 2 :END2 5)
+4
+
+(STRING/=  "abcdefg" "abcDEfg" :END2 4)
+3
+
+(STRING/=  "abcdef" "abCDef" :START1 1 :END1 4 :START2 4 :END2 1)
+error
+
+(STRING-TRIM   (QUOTE (#\SPACE #\TAB #\NEWLINE)) " garbanzo beans
+   ")
+"garbanzo beans"
+
+(STRING-TRIM   " (*)" " ( *three(siily) words* ) ")
+"three(siily) words"
+
+(STRING-TRIM   (QUOTE A) "ababa")
+error
+
+(STRING-TRIM   (QUOTE (A)) "ababa")
+#+XCL error #+(or CLISP GCL ECLS ALLEGRO) "ababa" #-(or XCL CLISP GCL ECLS ALLEGRO) UNKNOWN
+
+(STRING-TRIM   "a" "ababa")
+"bab"
+
+(STRING-TRIM   "c e" "    ceabceabce    c")
+"abceab"
+
+(STRING-TRIM   (QUOTE (#\a)) "abcd")
+"bcd"
+
+(STRING-TRIM   (QUOTE (#\a)) "xyzabcd")
+"xyzabcd"
+
+(STRING-TRIM   (QUOTE (#\a)) "abcda")
+"bcd"
+
+(STRING-LEFT-TRIM   (QUOTE (#\SPACE #\TAB #\NEWLINE)) " garbanzo beans
+   ")
+"garbanzo beans
+   "
+
+(STRING-LEFT-TRIM   " (*)" " ( *three(siily) words* ) ")
+"three(siily) words* ) "
+
+(STRING-LEFT-TRIM   (QUOTE A) "ababa")
+error
+
+(STRING-LEFT-TRIM   (QUOTE (A)) "ababa")
+#+XCL error #+(or CLISP GCL ECLS ALLEGRO) "ababa" #-(or XCL ECLS CLISP GCL ALLEGRO) UNKNOWN
+
+(STRING-LEFT-TRIM   "a" "ababa")
+"baba"
+
+(STRING-LEFT-TRIM   "c e" "    ceabceabce    c")
+"abceabce    c"
+
+(STRING-LEFT-TRIM   (QUOTE (#\a)) "abcd")
+"bcd"
+
+(STRING-LEFT-TRIM   (QUOTE (#\a)) "xyzabcd")
+"xyzabcd"
+
+(STRING-LEFT-TRIM   (QUOTE (#\a)) "abcda")
+"bcda"
+
+(STRING-RIGHT-TRIM   (QUOTE (#\SPACE #\TAB #\NEWLINE)) " garbanzo beans
+   ")
+" garbanzo beans"
+
+(STRING-RIGHT-TRIM   " (*)" " ( *three(siily) words* ) ")
+" ( *three(siily) words"
+
+(STRING-RIGHT-TRIM   (QUOTE A) "ababa")
+error
+
+(STRING-RIGHT-TRIM   (QUOTE (A)) "ababa")
+#+XCL error #+(or ECLS CLISP GCL ALLEGRO) "ababa" #-(or XCL ECLS CLISP GCL ALLEGRO) UNKNOWN
+
+(STRING-RIGHT-TRIM   "a" "ababa")
+"abab"
+
+(STRING-RIGHT-TRIM   "c e" "    ceabceabce    c")
+"    ceabceab"
+
+(STRING-RIGHT-TRIM   (QUOTE (#\a)) "abcd")
+"abcd"
+
+(STRING-RIGHT-TRIM   (QUOTE (#\a)) "xyzabcd")
+"xyzabcd"
+
+(STRING-RIGHT-TRIM   (QUOTE (#\a)) "abcda")
+"abcd"
+
+(STRING-UPCASE  "abCD efGh-ij")
+"ABCD EFGH-IJ"
+
+(STRING-UPCASE  "abCD efGh-ij" :START 5)
+"abCD EFGH-IJ"
+
+(STRING-UPCASE  "abCD efGh-ij" :END 5)
+"ABCD efGh-ij"
+
+(STRING-UPCASE  "abCD efGh-ij" :START 1 :END 6)
+"aBCD EfGh-ij"
+
+(STRING-UPCASE  "abCD efGh-ij" :START 6 :END 1)
+error
+
+(STRING-UPCASE  "abCD efGh-ij" :START 3 :END 3)
+"abCD efGh-ij"
+
+(STRING-DOWNCASE  "abCD efGh-ij")
+"abcd efgh-ij"
+
+(STRING-DOWNCASE  "abCD efGh-ij" :START 3)
+"abCd efgh-ij"
+
+(STRING-DOWNCASE  "abCD efGh-ij" :END 3)
+"abcD efGh-ij"
+
+(STRING-DOWNCASE  "abCD efGh-ij" :START 3 :END 3)
+"abCD efGh-ij"
+
+(STRING-DOWNCASE  "abCD efGh-ij" :START 1 :END 6)
+"abcd efGh-ij"
+
+(STRING-DOWNCASE  "abCD efGh-ij" :START 6 :END 1)
+error
+
+(STRING-CAPITALIZE  "abcd def g hi")
+"Abcd Def G Hi"
+
+(STRING-CAPITALIZE  "abCd dEf G hi")
+"Abcd Def G Hi"
+
+(STRING-CAPITALIZE  "Abcd Def G Hi")
+"Abcd Def G Hi"
+
+(STRING-CAPITALIZE  "abcd def g hi" :START 6)
+"abcd dEf G Hi"
+
+(STRING-CAPITALIZE  "abcd def g hi" :END 6)
+"Abcd Def g hi"
+
+(STRING-CAPITALIZE  "abcd def g hi" :START 2 :END 10)
+"abCd Def G hi"
+
+(STRING-CAPITALIZE  "abcd def g hi" :START 10 :END 2)
+error
+
+(STRING-CAPITALIZE  "don't")
+"Don'T"
+
+(STRING-CAPITALIZE  "DON'T")
+"Don'T"
+
+(STRING-CAPITALIZE  "34a 5BC")
+"34a 5bc"
+
+(STRING  (CHAR-CODE #\A))
+#+ECLS "A" #-ECLS error
+
+(STRING  (QUOTE A))
+"A"
+
+(STRING  #\a)
+"a"
+
+(STRING  "abc")
+"abc"
+
+(NSTRING-UPCASE  "abCD efGh-ij")   "ABCD EFGH-IJ"
+
+(NSTRING-UPCASE  "abCD efGh-ij" :START 5)   "abCD EFGH-IJ"
+
+(NSTRING-UPCASE  "abCD efGh-ij" :END 5)   "ABCD efGh-ij"
+
+(NSTRING-UPCASE  "abCD efGh-ij" :START6 :END 1)   ERROR
+
+(NSTRING-UPCASE  "abCD efGh-ij" :START 3 :END 3)   "abCD efGh-ij"
+
+(NSTRING-DOWNCASE  "abCD efGh-ij")   "abcd efgh-ij"
+
+(NSTRING-DOWNCASE  "abCD efGh-ij" :START 3)   "abCd efgh-ij"
+
+(NSTRING-UPCASE  "abCD efGh-ij" :START 1 :END 6)   "aBCD EfGh-ij"
+
+(NSTRING-DOWNCASE  "abCD efGh-ij" :END 3)   "abcD efGh-ij"
+
+(NSTRING-DOWNCASE  "abCd efGh-ij" :START 3 :END 3)   "abCd efGh-ij"
+
+(NSTRING-DOWNCASE  "abCd efGh-ij" :START 1 :END 6)   "abcd efGh-ij"
+
+(NSTRING-DOWNCASE  "abCD efGh-ij" :START 6 :END 1)   ERROR
+
+(NSTRING-DOWNCASE  "abCD efGh-ij" :START NIL :END NIL)
+#+(or XCL ECLS AKCL) "abcd efgh-ij" #-(or XCL ECLS AKCL) ERROR
+
+(NSTRING-UPCASE  "abDC efGh-oj")   "ABDC EFGH-OJ"
+
+(NSTRING-UPCASE "abCD efGh-ij" :START 1 :END 6)   "aBCD EfGh-ij"
+
+(NSTRING-UPCASE  "abCD efGh-fg" :START 1 :END 6)   "aBCD EfGh-fg"
+
+(NSTRING-UPCASE "abCD efGh-ef" :START 3 :END 3)   "abCD efGh-ef"
+
+(NSTRING-UPCASE  "abCD efGh-ef" :START 3 :END 3)   "abCD efGh-ef"
+
+(NSTRING-UPCASE  "abCD efGh-ef" :START 3 :END 3)   "abCD efGh-ef"
+
+(NSTRING-UPCASE  "abCD efGh-ef" :START 3 :END 1)   ERROR
+
+(NSTRING-UPCASE  "abCD efGh-ef" :START NIL :END NIL)
+#+(or XCL ECLS AKCL) "ABCD EFGH-EF" #-(or XCL ECLS AKCL) ERROR
+
+(NSTRING-DOWNCASE  "saBG efGh-ef")   "sabg efgh-ef"
+
+(NSTRING-DOWNCASE  "dfGV efGh-ef" :START 1 :END 6)   "dfgv efGh-ef"
+
+(NSTRING-DOWNCASE  "fgCD efGf-ef" :START 1 :END 3)   "fgcD efGf-ef"
+
+(NSTRING-DOWNCASE  "dfCF edFg-fg" :START NIL :END NIL)
+#+(or XCL ECLS AKCL) "dfcf edfg-fg" #-(or XCL ECLS AKCL) ERROR
+
+(NSTRING-DOWNCASE  "fgHG edgf-fg" :START 5 :END 1)   ERROR
+
+(NSTRING-DOWNCASE  "scDF edFG-ef" :START 1)   "scdf edfg-ef"
+
+(NSTRING-DOWNCASE  "fgHG edFG-ef" :END 4)   "fghg edFG-ef"
+
+(NSTRING-CAPITALIZE  "fg hgf fgh")   "Fg Hgf Fgh"
+
+(LET ((X "ABCDEF"))
+     (NSTRING-DOWNCASE X)
+     X)
+"abcdef"
+
diff --git a/src/tests/symbol10.tst b/src/tests/symbol10.tst
new file mode 100644
index 000000000..255e5a3f1
--- /dev/null
+++ b/src/tests/symbol10.tst
@@ -0,0 +1,519 @@
+(progn (in-package "USER")nil)
+NIL
+;; Test der neuen Valuezelle
+
+;;; 1. ungebundenes Symbol
+
+(defun testvar (var)
+   (list (boundp var)                                ; gebunden
+         (if (boundp var) (symbol-value var) nil)    ; Wert/nil
+         (constantp var)                             ; Konstante
+         #+XCL (eq (sys::%p-get-cdr var 0) sys::%cdr-specsym) ; specvar
+         #+CLISP (and (sys::special-variable-p var) (not (constantp var))) ; specvar
+	 #+ECLS (and (sys::specialp var) (not (constantp var))) ; specvar
+         #+ALLEGRO (and (not (constantp var)) (eval `(let ((,var (list nil))) (and (boundp ',var) (eq (symbol-value ',var) ,var)))))
+         (and (fboundp var) t)                       ; funktion. Eigenschaft
+         (and (fboundp var) (macro-function var) t)  ; Macro?
+         (and (fboundp var) (special-form-p var) t)  ; Spezialform?
+         #-(or ECLS CLISP) (and (symbol-plist var) t)          ; p-Liste?
+         #+(or ECLS CLISP) (and (or (get var 'i1) (get var 'i2) (get var 'i3)) t) ; p-Liste?
+         (get var 'i1)                               ; i1
+         (get var 'i2)                               ; i2
+         (get var 'i3)                               ; i3
+)  )
+testvar
+
+(defun clrvar (var)
+   #+XCL(subr 84 ;sys::%p-set-cdr-content
+              var 0 (sys::%p-get-content 'sys::%void-value 0) 0)
+   #-XCL (progn (makunbound var) (fmakunbound var)
+                (setf (symbol-plist var) '())
+         )
+   #+ALLEGRO (setf (excl::symbol-bit var 'excl::.globally-special.) nil)
+   var)
+clrvar
+
+#+(or XCL CLISP ALLEGRO)
+(progn (setf (symbol-function 'setf-get)
+             (symbol-function #+XCL 'sys::setf-get #+CLISP 'sys::%put #+ALLEGRO 'excl::.inv-get)) t)
+#+(or XCL CLISP ALLEGRO)
+T
+
+#+ECLS
+(defun setf-get (s p v) (setf (get s p) v))
+#+ECLS
+SETF-GET
+
+;;; Begin Breitentest
+
+(clrvar 'v1)
+v1
+
+;;;; value - umbinden - macro - umbinden - props - umbinden
+
+;;; value
+
+(testvar 'v1)
+;geb val konst svar func mac spec plist i1  i2  i3
+(nil nil nil   nil  nil  nil nil  nil   nil nil nil)
+
+(setq v1 'val)
+val
+
+(testvar 'v1)
+;geb val konst svar func mac spec plist i1  i2  i3
+(t   val nil   nil  nil  nil nil  nil   nil nil nil)
+
+;;; umbinden
+
+(makunbound 'v1)
+v1
+
+(testvar 'v1)
+;geb val konst svar func mac spec plist i1  i2  i3
+(nil nil nil   nil  nil  nil nil  nil   nil nil nil)
+
+(setq v1 'val2)
+val2
+
+(testvar 'v1)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   val2 nil   nil  nil  nil nil  nil   nil nil nil)
+
+;;; macro
+
+(defmacro v1 (x) (list 'quote x))
+v1
+
+(testvar 'v1)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   val2 nil   nil  t    t   nil  nil   nil nil nil)
+
+;;; umbinden
+
+(fmakunbound 'v1)
+v1
+
+(testvar 'v1)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   val2 nil   nil  nil  nil nil  nil   nil nil nil)
+
+(defmacro v1 (x) (list 'quote (list x x)))
+v1
+
+(v1 33)
+(33 33)
+
+(testvar 'v1)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   val2 nil   nil  t    t   nil  nil   nil nil nil)
+
+(makunbound 'v1)
+v1
+
+(testvar 'v1)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  t    t   nil  nil   nil nil nil)
+
+(setq v1 'val3)
+val3
+
+(testvar 'v1)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   val3 nil   nil  t    t   nil  nil   nil nil nil)
+
+;;; props
+
+(setf-get 'v1 'i1 11)
+11
+
+(setf-get 'v1 'i2 22)
+22
+
+(setf-get 'v1 'i3 33)
+33
+
+(testvar 'v1)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   val3 nil   nil  t    t   nil  t     11  22  33)
+
+;;; umbinden
+
+(remprop 'v1 'i2)
+t
+(remprop 'v1 'i1)
+t
+(remprop 'v1 'i3)
+t
+(fmakunbound 'v1)
+v1
+(makunbound 'v1)
+v1
+
+(testvar 'v1)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+
+(setf-get 'v1 'i1 99)
+99
+(defmacro v1 (x) (list 'quote (list x x x)))
+v1
+(v1 a)
+(a a a)
+(setq v1 'val4)
+val4
+
+(testvar 'v1)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   val4 nil   nil  t    t   nil  t     99  nil nil)
+
+;;; --- Ende Test1 -----
+
+(clrvar 'v2)
+v2
+
+;;; specvar - props - rebind - function
+
+(defvar v2 'v2a)
+v2
+
+(testvar 'v2)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   v2a  nil   t    nil  nil nil  nil   nil nil nil)
+
+(setf-get 'v2 'i3 33)
+33
+(setf-get 'v2 'i2 22)
+22
+(setf-get 'v2 'i1 11)
+11
+
+(testvar 'v2)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   v2a  nil   t    nil  nil nil  t     11  22  33)
+
+;;; rebind
+
+(makunbound 'v2)
+v2
+(remprop 'v2 'i1)
+t
+(remprop 'v2 'i2)
+t
+(remprop 'v2 'i3)
+t
+
+(testvar 'v2)
+;geb val  konst svar func mac spec plist i1  i2  i3
+#+XCL
+(nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+#-XCL
+(nil nil  nil   t    nil  nil nil  nil   nil nil nil)
+
+(defvar v2 'v2b)
+v2
+(setf-get 'v2 'i1 111)
+111
+(setf-get 'v2 'i2 222)
+222
+(setf-get 'v2 'i3 333)
+333
+
+(testvar 'v2)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   v2b  nil   t    nil  nil nil  t     111 222 333)
+
+;;; function
+
+(defun v2 (x) (list x x))
+v2
+(v2 44)
+(44 44)
+
+(testvar 'v2)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   v2b  nil   t    t    nil nil  t     111 222 333 )
+
+
+(clrvar 'v3)
+v3
+
+;;;;; function - con - rebind - prop
+
+;;; function
+
+(defun v3 (x y) (list x y))
+v3
+
+(testvar 'v3)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  t    nil nil  nil   nil nil nil)
+
+;;; constant
+
+(defconstant v3 99)
+v3
+
+v3
+99
+(v3 'a 'b)
+(a b)
+
+(testvar 'v3)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t    99  t     nil  t    nil nil  nil   nil nil nil)
+
+;;; rebind
+
+(makunbound 'v3)
+#+(or XCL ALLEGRO) v3 #+(or ECLS CLISP) ERROR #-(or XCL ALLEGRO ECLS CLISP) UNKNOWN
+(fmakunbound 'v3)
+v3
+
+#+XCL
+(testvar 'v3)
+#+XCL
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+
+(defconstant v3 999)
+v3
+
+(defun v3 (x) (list x x))
+v3
+(v3 'c)
+(c c)
+v3
+999
+
+(testvar 'v3)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   999  t     nil  t    nil nil  nil   nil nil nil)
+
+;;;defparameter
+
+(defparameter var33)
+ERROR
+
+(defparameter var3 99)
+var3
+
+var3
+99
+
+(testvar 'var3)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t    99  nil   T    nil  nil nil  nil   nil nil nil)
+
+;;; rebind
+
+(makunbound 'var3)
+var3
+
+(testvar 'var3)
+;geb val  konst svar func mac spec plist i1  i2  i3
+#+XCL
+(nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+#-XCL
+(nil nil  nil   t    nil  nil nil  nil   nil nil nil)
+
+;;; props
+
+(setf-get 'v3 'i2 222)
+222
+
+(setf-get 'v3 'i1 111)
+111
+
+(testvar 'v3)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   999  t     nil  t    nil nil  t     111 222 nil)
+
+
+(clrvar 'v4)
+v4
+
+;;;;  function - rebind - prop - rebind - specvar
+
+(defun v4 (x) x)
+v4
+(v4 55)
+55
+
+(testvar 'v4)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  t    nil nil  nil   nil nil nil)
+
+;;; rebind
+
+(fmakunbound 'v4)
+v4
+(testvar 'v4)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+
+(defun v4 (x) (list x))
+v4
+(v4 88)
+(88)
+
+(testvar 'v4)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  t    nil nil  nil   nil nil nil)
+
+(setf-get 'v4 'i1 11)
+11
+(setf-get 'v4 'i2 22)
+22
+
+(testvar 'v4)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  t    nil nil  t     11  22  nil)
+
+;;; rebind
+
+(fmakunbound 'v4)
+v4
+(remprop 'v4 'i1)
+t
+(remprop 'v4 'i2)
+t
+(testvar 'v4)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+
+(defun v4 (x) (list x x x))
+v4
+(v4 44)
+(44 44 44)
+(setf-get 'v4 'i2 222)
+222
+(setf-get 'v4 'i3 333)
+333
+
+(testvar 'v4)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  t    nil nil  t     nil 222 333)
+
+(defvar v4 'v4-value)
+v4
+
+(testvar 'v4)
+;geb val     konst svar func mac spec plist i1  i2  i3
+(t  v4-value nil   t    t    nil nil  t     nil 222 333)
+
+(clrvar 'v5)
+v5
+
+;;;;; prop - rebind - con - rebind - fun
+
+(setf-get 'v5 'i1 1)
+1
+(setf-get 'v5 'i2 2)
+2
+
+(testvar 'v5)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  nil  nil nil  t     1   2  nil)
+
+;;; rebind
+
+(remprop 'v5 'i1)
+t
+(remprop 'v5 'i2)
+t
+
+(testvar 'v5)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+
+(setf-get 'v5 'i1 11)
+11
+(setf-get 'v5 'i2 22)
+22
+
+(testvar 'v5)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  nil  nil nil  t     11  22  nil)
+
+;;; con
+
+(defconstant v5 '123)
+v5
+
+(testvar 'v5)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   123  t     nil  nil  nil nil  t     11  22  nil)
+
+;;; rebind
+
+(makunbound 'v5)
+#+(or XCL ALLEGRO) v5 #+(or ECLS CLISP) ERROR #-(or XCL ALLEGRO ECLS CLISP) UNKNOWN
+(remprop 'v5 'i2)
+t
+(remprop 'v5 'i1)
+t
+
+#+XCL
+(testvar 'v5)
+#+XCL
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
+
+;;; das ging schief !!
+
+(defconstant v5 321)
+v5
+(setf-get 'v5 'i3 333)
+333
+(setf-get 'v5 'i2 222)
+222
+
+(testvar 'v5)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   321  t     nil  nil  nil nil  t     nil 222 333)
+
+(defun v5 (x) x)
+v5
+
+(v5 666)
+666
+
+(testvar 'v5)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   321  t     nil  t    nil nil  t     nil 222 333)
+
+(clrvar 'v6)
+v6
+
+;;;;; prop mac con
+
+(setf-get 'v6 'i1 1)
+1
+(setf-get 'v6 'i3 3)
+3
+
+(testvar 'v6)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  nil  nil nil  t     1   nil 3)
+
+(defmacro v6 (x) (list 'quote x))
+v6
+(v6 a)
+a
+(testvar 'v6)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(nil nil  nil   nil  t    t   nil  t     1   nil 3)
+
+(defconstant v6 234)
+v6
+
+(testvar 'v6)
+;geb val  konst svar func mac spec plist i1  i2  i3
+(t   234  t     nil  t    t   nil  t     1   nil 3)
+
+
+; Aufraeumen
+(progn (mapc #'unintern '(v1 v2 v3 v4 v5 v6)) t)
+T
+
diff --git a/src/tests/symbols.tst b/src/tests/symbols.tst
new file mode 100644
index 000000000..d0bc5dee3
--- /dev/null
+++ b/src/tests/symbols.tst
@@ -0,0 +1,12 @@
+
+(SYMBOL-NAME (QUOTE XYZ))
+"XYZ"
+
+(PROGN (SETQ *GENSYM-COUNTER* 32) (gensym) (PRIN1-TO-STRING (GENSYM "FOO-")))
+"#:FOO-33"
+
+(PROGN (SETQ *GENSYM-COUNTER* 32) (gensym) (PRIN1-TO-STRING (GENSYM "garbage-")))
+#+XCL "#:|garbage|-33"
+#+(or CLISP ECLS AKCL ALLEGRO) "#:|garbage-33|"
+#-(or XCL CLISP AKCL ALLEGRO) UNKNOWN
+
diff --git a/src/tests/tests.lsp b/src/tests/tests.lsp
new file mode 100644
index 000000000..b95da7e9e
--- /dev/null
+++ b/src/tests/tests.lsp
@@ -0,0 +1,252 @@
+;; Test-Suiten ablaufen lassen:
+
+#+CLISP
+(defmacro with-ignored-errors (&rest forms)
+  (let ((b (gensym)))
+    `(BLOCK ,b
+       (LET ((*ERROR-HANDLER*
+               #'(LAMBDA (&REST ARGS) (RETURN-FROM ,b 'ERROR))
+            ))
+         ,@forms
+     ) )
+) )
+
+#+AKCL
+(defmacro with-ignored-errors (&rest forms)
+  (let ((b (gensym))
+        (h (gensym)))
+    `(BLOCK ,b
+       (LET ((,h (SYMBOL-FUNCTION 'SYSTEM:UNIVERSAL-ERROR-HANDLER)))
+         (UNWIND-PROTECT
+           (PROGN (SETF (SYMBOL-FUNCTION 'SYSTEM:UNIVERSAL-ERROR-HANDLER)
+                        #'(LAMBDA (&REST ARGS) (RETURN-FROM ,b 'ERROR))
+                  )
+                  ,@forms
+           )
+           (SETF (SYMBOL-FUNCTION 'SYSTEM:UNIVERSAL-ERROR-HANDLER) ,h)
+     ) ) )
+) )
+
+#+ECLS
+(defmacro with-ignored-errors (&rest forms)
+  `(catch si::*ignore-errors-tag*
+      (let* ((si::*ignore-errors* t)
+	     (output ,@forms))
+	(if (eq output 'ERROR) *last-error* output))))
+
+#+ALLEGRO
+(defmacro with-ignored-errors (&rest forms)
+  (let ((r (gensym)))
+    `(LET ((,r (MULTIPLE-VALUE-LIST (EXCL:ERRORSET (PROGN ,@forms)))))
+       (IF (CAR ,r) (VALUES-LIST (CDR ,r)) 'ERROR)
+     )
+) )
+
+#-(or CLISP AKCL ALLEGRO ECLS)
+(defmacro with-ignored-errors (&rest forms)
+  (let ((b (gensym)))
+    `(BLOCK ,b
+       (HANDLER-BIND
+         ((ERROR #'(LAMBDA (CONDITION) (RETURN-FROM ,b 'ERROR))))
+         ,@forms
+     ) )
+) )
+
+#-ALLEGRO
+(defun merge-extension (type filename)
+  (merge-pathnames type filename)
+)
+#+ALLEGRO
+(defun merge-extension (type filename)
+  (merge-pathnames (make-pathname :type (subseq (string type) 1)) filename)
+)
+
+(defun do-safe (stream log &optional (ignore-errors t))
+  (let ((eof "EOF"))
+    (loop
+      (let* ((form (read stream nil eof))
+	     (result (read stream nil eof)))
+	(force-output *standard-output*)
+        (when (or (eq form eof) (eq result eof)) (return))
+        (let ((my-result
+                (if ignore-errors
+                  (with-ignored-errors (eval form)) ; return ERROR on errors
+                  (eval form) ; don't disturb the condition system when testing it!
+             )) )
+	  (print my-result)
+          (cond ((eql result my-result)
+                 (format t "~%EQL-OK: ~S" result)
+                )
+                ((equal result my-result)
+                 (format t "~%EQUAL-OK: ~S" result)
+                )
+                ((equalp result my-result)
+                 (format t "~%EQUALP-OK: ~S" result)
+                )
+                (t
+                 (format t "~%FEHLER!! ~S sollte ~S sein!" my-result result)
+                 (format log "~%Form: ~S~%SOLL: ~S~%~A: ~S~%"
+                             form result
+                             #+CLISP "CLISP" #+AKCL "AKCL" #+ALLEGRO "ALLEGRO" #+ECLS "ECLS"
+                             my-result)
+		 (stop))
+) ) ) ) ) )
+
+(defun do-test (stream log &optional (ignore-errors t))
+  (let ((eof "EOF"))
+    (loop
+      (let ((form (read stream nil eof))
+            (result (read stream nil eof)))
+        (when (or (eq form eof) (eq result eof)) (return))
+        (print form)
+        (let ((my-result
+                (if ignore-errors
+                  (with-ignored-errors (eval form)) ; return ERROR on errors
+                  (eval form) ; don't disturb the condition system when testing it!
+             )) )
+	  (cos 1.0)
+          (cond ((eql result my-result)
+                 (format t "~%EQL-OK: ~S" result)
+                )
+                ((equal result my-result)
+                 (format t "~%EQUAL-OK: ~S" result)
+                )
+                ((equalp result my-result)
+                 (format t "~%EQUALP-OK: ~S" result)
+                )
+                (t
+                 (format t "~%FEHLER!! ~S sollte ~S sein!" my-result result)
+                 (format log "~%Form: ~S~%SOLL: ~S~%~A: ~S~%"
+                             form result
+                             #+CLISP "CLISP" #+AKCL "AKCL" #+ALLEGRO "ALLEGRO" #+ECLS "ECLS"
+                             my-result
+                ))
+) ) ) ) ) )
+
+(defun do-errcheck (stream log)
+  (let ((eof "EOF"))
+    (loop
+      (let ((form (read stream nil eof))
+            (errtype (read stream nil eof)))
+        (when (or (eq form eof) (eq errtype eof)) (return))
+        (print form)
+        (let ((my-result (nth-value 1 (ignore-errors (eval form)))))
+          (multiple-value-bind (typep-result typep-error)
+              (ignore-errors (typep my-result errtype))
+            (cond ((and (not typep-error) typep-result)
+                   (format t "~%OK: ~S" errtype)
+                  )
+                  (t
+                   (format t "~%FEHLER!! ~S statt ~S !" my-result errtype)
+                   (format log "~%Form: ~S~%SOLL: ~S~%~A: ~S~%"
+                               form errtype
+                               #+CLISP "CLISP" #+AKCL "AKCL" #+ALLEGRO "ALLEGRO"
+                               my-result
+                  ))
+) ) ) ) ) ) )
+
+(defun run-test (testname
+                 &key (tester #'do-test)
+		 (logname (merge-extension ".erg" testname))
+		 logname2
+                 &aux log-empty-p)
+  (with-open-file (s (merge-extension ".tst" testname) :direction :input)
+    (with-open-file (log logname :direction :output
+                                 #+ANSI-CL :if-exists #+ANSI-CL :new-version)
+      (if logname2
+	(with-open-file (log2 logname2 :direction :output
+			      #+ANSI-CL :if-exists #+ANSI-CL :new-version)
+	  (let ((*package* *package*)
+		(*print-pretty* nil)
+		(*standard-output* log2))
+	    (funcall tester s log)))
+	(let ((*package* *package*)
+	      (*print-pretty* nil))
+	    (funcall tester s log)))
+      (setq log-empty-p (zerop (file-length log)))
+  ) )
+  (when log-empty-p (delete-file logname))
+  (values)
+)
+
+(defun run-test-no-log (testname
+			&optional (tester #'do-test)
+			&aux (logname "/dev/null"))
+  (with-open-file (s (merge-extension ".tst" testname) :direction :input)
+    (with-open-file (log logname :direction :output
+                                 #+ANSI-CL :if-exists #+ANSI-CL :new-version)
+      (let ((*package* *package*)
+            (*print-pretty* nil))
+        (funcall tester s log)
+      )
+  ) )
+  (values)
+)
+
+(defun run-all-tests (&optional (source-directory nil) (log-directory nil))
+  (mapc #'(lambda (test)
+	    (format t ";;; Doing ~S~%" test)
+	    (run-test (if source-directory
+			(merge-pathnames source-directory test)
+			test)
+		      :logname
+		      (merge-extension ".erg"
+				       (if log-directory
+					 (merge-pathnames log-directory test)
+					 test))
+		      :logname2
+		      (merge-extension ".out"
+				       (if log-directory
+					 (merge-pathnames log-directory test)
+					 test))))
+        '( #-AKCL               "alltest"
+                                "array"
+                                "backquot"
+           #-AKCL               "characters"
+           #+(or CLISP ALLEGRO) "clos"
+                                "eval20"
+                                "format"
+           #+CLISP              "genstream"
+           #+XCL                "hash"
+                                "hashlong"
+                                "iofkts"
+                                "lambda"
+                                "lists151"
+                                "lists152"
+                                "lists153"
+                                "lists154"
+                                "lists155"
+                                "lists156"
+           #+(or ECLS CLISP ALLEGRO)
+	  			"loop"
+                                "macro8"
+                                "map"
+           #+(or CLISP ALLEGRO) "mop"
+                                "number"
+           #+CLISP              "number2"
+           #-(or ECLS AKCL ALLEGRO)
+	  			"pack11"
+           #+(or XCL CLISP ECLS)
+	  			"path"
+           #+XCL                "readtable"
+                                "setf"
+                                "steele7"
+           #-ALLEGRO            "streams"
+                                "streamslong"
+                                "strings"
+           #-AKCL               "symbol10"
+                                "symbols"
+           #+XCL                "tprint"
+           #+XCL                "tread"
+                                "type"
+	  			"ecl_chap12_spec"
+	  			"ecl_chap14_cons"
+				"ecl_chap14_plist"
+	  			"ecl_chap11_pack"
+  )      )
+  #+(or CLISP ALLEGRO)
+  (run-test "conditions" #'(lambda (stream log) (do-test stream log nil)))
+  #-ECLS
+  (run-test "excepsit" #'do-errcheck)
+  t
+)
diff --git a/src/tests/tprint.tst b/src/tests/tprint.tst
new file mode 100644
index 000000000..3b585bd94
--- /dev/null
+++ b/src/tests/tprint.tst
@@ -0,0 +1,1587 @@
+;******************************************************************************
+;*      ROSENMUELLER    TPRINT.QUE                                            *
+;******************************************************************************
+
+;;** displace zu displac0 umbenannt, weil paket gedruckt wird 22.08.1990 **;;
+
+(write-to-string 
+        '(let ((a a1)
+               (b b1))
+              1 2
+              (3 4)
+              (5 6)
+              7 8) :pretty t)
+"(LET ((A A1) 
+      (B B1)) 
+     1 2 
+     (3 4) 
+     (5 6) 
+     7 8)"
+
+(write-to-string 
+        '(prog (1 2)
+               (3 4)
+          a    (5 6)
+               (8 9)
+          x    (zzz)) :pretty t)
+"(PROG (1 2)
+      (3 4)
+ A    (5 6)
+      (8 9)
+ X    (ZZZ))"
+
+(write-to-string 
+        '(do ((l '(1 2 3)
+                 (cdr l)))
+             ((null l) 
+              (print 'a1)
+              (print 'a2))
+             (print l)) :pretty t)
+"(DO ((L '(1 2 3) 
+        (CDR L))) 
+    ((NULL L) 
+     (PRINT 'A1) 
+     (PRINT 'A2)) 
+    (PRINT L))"
+
+(setq *print-level* nil *print-length* nil *print-pretty* t)
+T
+
+(WRITE-TO-STRING
+'(123 
+"das ist der 1. string laenger als 80 zeichen aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+456
+"das ist der 2. bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+789)
+)
+"(123 \"das ist der 1. string laenger als 80 zeichen aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\" 
+
+     456 
+     \"das ist der 2. bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\" 
+
+     789)"
+
+(setq tarray
+        #4a((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))
+             ((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))
+             ((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))
+            (((61 62 63 64 65)(66 67 68 69 70)(11 12 13 14 15)(16 17 18 19 20))
+             ((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))
+             ((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))
+           ))
+#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 
+49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 
+12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(
+36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 
+60))))
+
+(setq tal
+        '((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))
+             ((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))
+             ((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))
+            (((61 62 63 64 65)(66 67 68 69 70)(11 12 13 14 15)(16 17 18 19 20))
+             ((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))
+             ((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))
+           ))
+((((1 2 3 4 5) 
+   (6 7 8 9 10) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))) 
+ (((61 62 63 64 65) 
+   (66 67 68 69 70) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))))
+
+(setq tlist (list 'a 'b 'c tarray))
+(A B C 
+   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 
+   34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 
+   57 58 59 60)))))
+
+(setq *print-length* 6)
+6
+
+tarray
+#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(
+26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 
+50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 
+13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 
+37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))))
+
+(WRITE-TO-STRING tal)
+"((((1 2 3 4 5) 
+   (6 7 8 9 10) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))) 
+ (((61 62 63 64 65) 
+   (66 67 68 69 70) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))))"
+
+(setq *print-length* 5)
+5
+
+tarray
+#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(
+26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 
+50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 
+13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 
+37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))))
+
+(WRITE-TO-STRING tal)
+"((((1 2 3 4 5) 
+   (6 7 8 9 10) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))) 
+ (((61 62 63 64 65) 
+   (66 67 68 69 70) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))))"
+
+(setq *print-length* 4)
+4
+
+(WRITE-TO-STRING tarray)
+"#4A((((1 2 3 4 ...)(6 7 8 9 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)(
+26 27 28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 
+49 ...)(51 52 53 54 ...)(56 57 58 59 ...)))(((61 62 63 64 ...)(66 67 68 69 ...)(
+11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)(26 27 28 29 ...)(31 32 33 
+34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 49 ...)(51 52 53 54 ...)(56 
+57 58 59 ...))))"
+;;"#4A((((1 2 3 4 ...)(6 7 8 9 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 
+;;24 ...)(26 27 28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(
+;;46 47 48 49 ...)(51 52 53 54 ...)(56 57 58 59 ...)))(((61 62 63 64 ...)(66 67 
+;;68 69 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)(26 27 28 29 ...)(
+;;31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 49 ...)(51 52 53 
+;;54 ...)(56 57 58 59 ...))))"
+
+(WRITE-TO-STRING tal)
+"((((1 2 3 4 ...) 
+   (6 7 8 9 ...) 
+   (11 12 13 14 ...) 
+   (16 17 18 19 ...)) 
+  ((21 22 23 24 ...) 
+   (26 27 28 29 ...) 
+   (31 32 33 34 ...) 
+   (36 37 38 39 ...)) 
+  ((41 42 43 44 ...) 
+   (46 47 48 49 ...) 
+   (51 52 53 54 ...) 
+   (56 57 58 59 ...))) 
+ (((61 62 63 64 ...) 
+   (66 67 68 69 ...) 
+   (11 12 13 14 ...) 
+   (16 17 18 19 ...)) 
+  ((21 22 23 24 ...) 
+   (26 27 28 29 ...) 
+   (31 32 33 34 ...) 
+   (36 37 38 39 ...)) 
+  ((41 42 43 44 ...) 
+   (46 47 48 49 ...) 
+   (51 52 53 54 ...) 
+   (56 57 58 59 ...))))"
+
+(setq *print-length* 3)
+3
+
+(WRITE-TO-STRING tarray)
+"#4A((((1 2 3 ...)(6 7 8 ...)(11 12 13 ...)...)((21 22 23 ...)(26 27 28 ...)(31 
+32 33 ...)...)((41 42 43 ...)(46 47 48 ...)(51 52 53 ...)...))(((61 62 63 ...)(
+66 67 68 ...)(11 12 13 ...)...)((21 22 23 ...)(26 27 28 ...)(31 32 33 ...)...)((
+41 42 43 ...)(46 47 48 ...)(51 52 53 ...)...)))"
+
+(WRITE-TO-STRING tal)
+"((((1 2 3 ...) 
+   (6 7 8 ...) 
+   (11 12 13 ...) ...) 
+  ((21 22 23 ...) 
+   (26 27 28 ...) 
+   (31 32 33 ...) ...) 
+  ((41 42 43 ...) 
+   (46 47 48 ...) 
+   (51 52 53 ...) ...)) 
+ (((61 62 63 ...) 
+   (66 67 68 ...) 
+   (11 12 13 ...) ...) 
+  ((21 22 23 ...) 
+   (26 27 28 ...) 
+   (31 32 33 ...) ...) 
+  ((41 42 43 ...) 
+   (46 47 48 ...) 
+   (51 52 53 ...) ...)))"
+
+(setq *print-length* 2)
+2
+
+(WRITE-TO-STRING tarray)
+"#4A((((1 2 ...)(6 7 ...)...)((21 22 ...)(26 27 ...)...)...)(((61 62 ...)(66 67 ...)...)((
+21 22 ...)(26 27 ...)...)...))"
+
+(WRITE-TO-STRING tal)
+"((((1 2 ...) 
+   (6 7 ...) ...) 
+  ((21 22 ...) 
+   (26 27 ...) ...) ...) 
+ (((61 62 ...) 
+   (66 67 ...) ...) 
+  ((21 22 ...) 
+   (26 27 ...) ...) ...))"
+
+(setq *print-length* 1)
+1
+
+(WRITE-TO-STRING tarray)
+"#4A((((1 ...)...)...)...)"
+
+(WRITE-TO-STRING tal)
+"((((1 ...) 
+   ...) 
+  ...) 
+ ...)"
+;;"((((1 ...) ...) ...) ...)"
+
+(setq *print-length* 0)
+0
+
+(WRITE-TO-STRING tarray)
+"#4A(...)"
+
+(WRITE-TO-STRING tal)
+"(...)"
+
+;***1
+
+(setq *print-length* 6)
+6
+
+tarray   
+#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(
+26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 
+50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 
+13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 
+37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))))
+
+(WRITE-TO-STRING tal)
+"((((1 2 3 4 5) 
+   (6 7 8 9 10) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))) 
+ (((61 62 63 64 65) 
+   (66 67 68 69 70) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))))"
+
+(setq *print-level* 5)
+5
+
+tarray
+#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(
+26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 
+50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 
+13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 
+37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))))
+
+(WRITE-TO-STRING tal)
+"((((1 2 3 4 5) 
+   (6 7 8 9 10) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))) 
+ (((61 62 63 64 65) 
+   (66 67 68 69 70) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))))"
+
+(setq *print-level* 4)
+4
+
+tarray
+#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(
+26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 
+50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 
+13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 
+37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))))
+
+(WRITE-TO-STRING tal)
+"((((1 2 3 4 5) 
+   (6 7 8 9 10) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))) 
+ (((61 62 63 64 65) 
+   (66 67 68 69 70) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))))"
+
+(setq *print-level* 3)
+3
+
+(WRITE-TO-STRING tarray)
+"#4A(((# # # #)(# # # #)(# # # #))((# # # #)(# # # #)(# # # #)))"
+
+(WRITE-TO-STRING tal)
+"(((# 
+   # 
+   # 
+   #) 
+  (# 
+   # 
+   # 
+   #) 
+  (# 
+   # 
+   # 
+   #)) 
+ ((# 
+   # 
+   # 
+   #) 
+  (# 
+   # 
+   # 
+   #) 
+  (# 
+   # 
+   # 
+   #)))"
+
+(setq *print-level* 2)
+2
+
+(WRITE-TO-STRING tarray)
+"#4A((# # #)(# # #))"
+
+(WRITE-TO-STRING tal)
+"((# 
+  # 
+  #) 
+ (# 
+  # 
+  #))"
+
+(setq *print-level* 1)
+1
+
+(WRITE-TO-STRING tarray)
+"#4A(# #)"
+
+(WRITE-TO-STRING tal)
+"(# 
+ #)"
+
+(setq *print-level* 0)
+0
+
+(WRITE-TO-STRING tarray)
+"#4A#"
+
+(WRITE-TO-STRING tal)
+"#"
+
+(setq *print-level* 6)
+6
+
+tarray
+#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(
+26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 
+50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 
+13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 
+37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))))
+
+(WRITE-TO-STRING tal)
+"((((1 2 3 4 5) 
+   (6 7 8 9 10) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))) 
+ (((61 62 63 64 65) 
+   (66 67 68 69 70) 
+   (11 12 13 14 15) 
+   (16 17 18 19 20)) 
+  ((21 22 23 24 25) 
+   (26 27 28 29 30) 
+   (31 32 33 34 35) 
+   (36 37 38 39 40)) 
+  ((41 42 43 44 45) 
+   (46 47 48 49 50) 
+   (51 52 53 54 55) 
+   (56 57 58 59 60))))"
+
+(setq *print-length* 6)
+6
+
+(WRITE-TO-STRING tlist)
+"(A B C 
+   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 
+   35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 
+   58 59 60)))))"
+;;"(A B C 
+;;   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+;;   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+;;   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+;;   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 
+;;   34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 
+;;   57 58 59 60)))))"
+
+(setq *print-length* 5)
+5
+
+(WRITE-TO-STRING tlist)
+"(A B C 
+   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 
+   35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 
+   58 59 60)))))"
+;;"(A B C 
+;;   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+;;   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+;;   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+;;   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 
+;;   34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 
+;;   57 58 59 60)))))"
+
+(setq *print-length* 4)
+4
+
+(WRITE-TO-STRING tlist)
+"(A B C 
+   #4A((((1 2 3 4 ...)(6 7 8 9 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 
+   24 ...)(26 27 28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(
+   46 47 48 49 ...)(51 52 53 54 ...)(56 57 58 59 ...)))(((61 62 63 64 ...)(66 67 
+   68 69 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)(26 27 28 29 ...)(
+   31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 49 ...)(51 52 
+   53 54 ...)(56 57 58 59 ...)))))"
+;;"(A B C #4A((((1 2 3 4 ...)(6 7 8 9 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 
+;;   22 23 24 ...)(26 27 28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 
+;;   44 ...)(46 47 48 49 ...)(51 52 53 54 ...)(56 57 58 59 ...)))(((61 62 63 64 ...)(
+;;   66 67 68 69 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)(26 27 
+;;   28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 49 ...)(
+;;   51 52 53 54 ...)(56 57 58 59 ...)))))"
+
+(setq *print-length* 3)
+3
+
+(WRITE-TO-STRING tlist)
+"(A B C ...)"
+
+
+(setq *print-length* 2)
+2
+
+(WRITE-TO-STRING tlist)
+"(A B ...)"
+
+
+(setq *print-length* 1)
+1
+
+(WRITE-TO-STRING tlist)
+"(A ...)"
+
+
+(setq *print-length* 0)
+0
+
+(WRITE-TO-STRING tlist)
+"(...)"
+
+(setq *print-length* 6)
+6
+
+(WRITE-TO-STRING tlist)
+"(A B C 
+   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 
+   35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 
+   58 59 60)))))"
+;;"(A B C 
+;;   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+;;   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+;;   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+;;   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 
+;;   34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 
+;;   57 58 59 60)))))"
+
+(setq *print-level* 5)
+5
+
+(WRITE-TO-STRING tlist)
+"(A B C 
+   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 
+   35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 
+   58 59 60)))))"
+;;"(A B C 
+;;   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+;;   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+;;   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+;;   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 
+;;   34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 
+;;   57 58 59 60)))))"
+
+(setq *print-level* 4)
+4
+
+(WRITE-TO-STRING tlist)
+"(A B C #4A(((# # # #)(# # # #)(# # # #))((# # # #)(# # # #)(# # # 
+#))))"
+
+(setq *print-level* 3)
+3
+
+(WRITE-TO-STRING tlist)
+"(A B C #4A((# # #)(# # #)))"
+
+
+(setq *print-level* 2)
+2
+
+(WRITE-TO-STRING tlist)
+"(A B C #4A(# #))"
+
+(setq *print-level* 1)
+1
+
+(WRITE-TO-STRING tlist)
+"(A B C #4A#)"
+
+(setq *print-level* 0)
+0
+
+(WRITE-TO-STRING tlist)
+"#"
+
+(setq *print-level* 6)
+6
+
+(WRITE-TO-STRING tlist)
+"(A B C 
+   #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 
+   25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 
+   48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(
+   11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 
+   35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 
+   58 59 60)))))"
+
+;***2
+
+(setq *print-pretty* t)
+t
+
+(setq *print-length* 10.)
+10
+
+(setq *print-level* 3.)
+3
+
+(setq *print-circle* nil)
+NIL
+
+(setq a '(10 11 12))
+(10 11 12)
+
+(WRITE-TO-STRING (rplacd (cdr a) a))
+"(11 10 11 10 11 10 11 10 11 10 ...)"
+
+(setq b '(10 11 12))
+(10 11 12)
+
+(WRITE-TO-STRING (rplaca (cddr b) b))
+"((10 11 
+     (10 11 
+         #)))"
+
+(setq c '(10 11 12 13))
+(10 11 12 13)
+
+(WRITE-TO-STRING (rplacd (cddr c) (cdr c)))
+"(12 11 12 11 12 11 12 11 12 11 ...)"
+
+(WRITE-TO-STRING (setq d (list 'a 'b a 'c b c 'a )))
+"(A B 
+   (10 11 10 11 10 11 10 11 10 11 ...) 
+   C 
+   (10 11 
+       (10 11 
+           #)) 
+   (10 11 12 11 12 11 12 11 12 11 ...) 
+   A)"
+
+(setq *print-length* nil)
+NIL
+
+(setq *print-level* nil)
+NIL
+
+(setq *print-circle* t)
+T
+
+(setq a '(10 11 12))
+(10 11 12)
+
+(WRITE-TO-STRING (rplacd (cdr a) a))
+"#2=(11 10 . #2#)"
+
+(setq b '(10 11 12))
+(10 11 12)
+
+(WRITE-TO-STRING (rplaca (cddr b) b))
+"(#1=(10 11 
+        #1#))"
+;;"(#1=(10 11 
+;;     #1#))"
+
+(setq c '(10 11 12 13))
+(10 11 12 13)
+
+(WRITE-TO-STRING (rplacd (cddr c) (cdr c)))
+"#2=(12 11 . #2#)"
+
+(WRITE-TO-STRING (setq d (list 'a 'b a 'c b c 'a )))
+"(A B 
+   #3=(10 11 . #3#) 
+   C 
+   #6=(10 11 
+          #6#) 
+   (10 . #8=( 11 12 . #8#)) 
+   A)"
+;;"(A B 
+;;   #3=(10 11 . #3#) 
+;;   C 
+;;   #6=(10 11 
+;;       #6#) 
+;;   (10 . #8=( 11 12 . #8#)) 
+;;   A)"
+
+(setq *print-circle* nil)
+NIL
+
+;***3
+
+(setq sys::*pprint-max-indentation* 5)
+5
+
+;       (a b c )  ==>  (a b c)
+(WRITE-TO-STRING        '(a b c))
+"(A B C)"
+
+;       (aaaaaaaaaaa.. bbbbbbb.. cccc..) lang 
+;               ==> (aaaaa... bbbbb.. 
+;                             ccc...)
+(WRITE-TO-STRING        '(aaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb 
+cc
+         bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb dd
+         cccccccccccccccccccccccccccccccccccccccccccccc eeeeeee))
+"(AAAAAAAAA BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB CC 
+       BBBBBBBBBBBBBBBBBBBBBBBBBBBBBB DD 
+       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC EEEEEEE)"
+
+;       ((a)(b)(c)) ==> ((a) (b) (c))
+(WRITE-TO-STRING        '((a) (b) (c)))
+"((A) 
+ (B) 
+ (C))"
+
+;       ((aaaa..) (bbbb..) (cccc..)) lang
+;               ==> ((aaaa....)
+;                    (bbbb...)
+;                    (ccc..))
+(WRITE-TO-STRING        '((aaaaaaaaaaaaaaaaaaaaaaaaaa)
+          (bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb)
+          (ccccccccccccccccccccc)
+          (dddddddddddddddddddddddddddddddddd)))
+"((AAAAAAAAAAAAAAAAAAAAAAAAAA) 
+ (BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB) 
+ (CCCCCCCCCCCCCCCCCCCCC) 
+ (DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD))"
+
+;       (abcde (a)(b)(c)) ==> (abcde (a) (b) (c))
+(WRITE-TO-STRING        '(abcde (a)(b)(c)))
+"(ABCDE (A) 
+       (B) 
+       (C))"
+
+;       (abcde (aaaaaa..) (bbb..) ...) lang
+;               ==> (abcde (aaaa....)
+;                          (bbbb...)
+;                          (ccc.......))
+(WRITE-TO-STRING        '(abcde (aaaaaaaaaaaaaaaaaaaaaaaaaaaaa) (bbbbbbbbbbbbbbbbbbbbb)
+                (cccccccccccccccccccccccccccccccc)
+                (dddddddddddddddddddddddddddddddddddddd)))
+"(ABCDE (AAAAAAAAAAAAAAAAAAAAAAAAAAAAA) 
+       (BBBBBBBBBBBBBBBBBBBBB) 
+       (CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC) 
+       (DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD))"
+
+;       (form1 form2 ...)   eine Zeile
+;               ==> (form1 form2 ...)
+(WRITE-TO-STRING        '((a 1 2) (b 1 2) (c 1 2)))
+"((A 1 2) 
+ (B 1 2) 
+ (C 1 2))"
+
+;       (form1 form2 ...) lang
+;               ==> (form1
+;                    form2 ...)
+(WRITE-TO-STRING        '((aaaaaaaaaa 1111111111 2222222222)
+         (bbbbbbbbbb 1111111111 2222222222)
+         (cccccccccc 1111111111 2222222222)))
+"((AAAAAAAAAA 1111111111 2222222222) 
+ (BBBBBBBBBB 1111111111 2222222222) 
+ (CCCCCCCCCC 1111111111 2222222222))"
+
+;       (atom form1 form2 ....)
+;               ==> (atom form1
+;                         form2..)
+(WRITE-TO-STRING        '(abcde (a 1 2) (b 1 2)))
+"(ABCDE (A 1 2) 
+       (B 1 2))"
+
+(WRITE-TO-STRING        '(abcde (aaaaaaaaaaaaaaaaa 111111111111 22222222222)
+                (bbbbbbbbbbbbbbbbb 111111111111 22222222222)
+                (ccccccccccccccccc 111111111111 22222222222)))
+"(ABCDE (AAAAAAAAAAAAAAAAA 111111111111 22222222222) 
+       (BBBBBBBBBBBBBBBBB 111111111111 22222222222) 
+       (CCCCCCCCCCCCCCCCC 111111111111 22222222222))"
+
+;       (prog form1 form2 atom form3 ...)
+;               ==> (prog form1
+;                         form2
+;                    atom form3 ..)
+;; 16.8.1990 ab hier alle progs ausgetauscht, da alte am zeilenende zwei space?
+(WRITE-TO-STRING        '(prog (a 1 2) (b 1 2) at (c 1 2) (d 1 2)))
+"(PROG (A 1 2)
+      (B 1 2)
+ AT   (C 1 2)
+      (D 1 2))"
+
+(WRITE-TO-STRING        '(prog (a 1 2) (b 1 2) atommarke (c 1 2) (d 1 2)))
+"(PROG (A 1 2)
+      (B 1 2)
+ ATOMMARKE
+      (C 1 2)
+      (D 1 2))"
+
+(WRITE-TO-STRING        '(tagbody (a) (b) at (c) (d)))
+"(TAGBODY 
+      (A)
+      (B)
+ AT   (C)
+      (D))"
+;;"(TAGBODY (A) 
+;;       (B) ........)
+
+;       (form1 atom1 atom2 form2..)
+;               ==> (form1
+;                    atom1 atom2
+;                    form2..)
+(WRITE-TO-STRING        '((a 1 2) at1 at2 (b 1 2) (c 1 2)))
+"((A 1 2) 
+ AT1 AT2 
+ (B 1 2) 
+ (C 1 2))"
+
+(WRITE-TO-STRING        '((aaaaaaaaaaaa 11111111111 22222222222) atom1 atom2
+          (bbbbbbbbbbbb 11111111111 222222222222)
+          (ccccc 1111 2222 3333)))
+"((AAAAAAAAAAAA 11111111111 22222222222) 
+ ATOM1 ATOM2 
+ (BBBBBBBBBBBB 11111111111 222222222222) 
+ (CCCCC 1111 2222 3333))"
+
+;       (atom1 atom2 atom3 .. ) lang
+;               ==> (atom1 atom2 ..
+;                    atomn..)
+(WRITE-TO-STRING        '(aaaaaaaaaaaaaaaa b ccccccccccccccccc dddddd eeeeeeeeeeeeeeee 
+
+          ffffffffffffffffffffffffffffffffffffffff ggg hhhh iiiii
+          jjjjjjjjjjjjjjjjjj k l m n ooooooooooooooo))
+"(AAAAAAAAAAAAAAAA B CCCCCCCCCCCCCCCCC DDDDDD EEEEEEEEEEEEEEEE 
+       FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF GGG HHHH IIIII 
+       JJJJJJJJJJJJJJJJJJ K L M N OOOOOOOOOOOOOOO)"
+
+;       Test der Sonderfunktionen
+;; ab hier alle gequoteten objekte mit terpri !
+(WRITE-TO-STRING        '(a '1 b))
+"(A '1 B)"
+
+(WRITE-TO-STRING        '(a `'b c))
+"(A `'B 
+   C)"
+
+(WRITE-TO-STRING        '(a '''''''''b c))
+"(A '''''''''B 
+   C)"
+
+(WRITE-TO-STRING        '(a b 'c d))
+"(A B 'C D)"
+
+(WRITE-TO-STRING        '(aaaaaaaaaa bbbbbbbbbbbb 'c 
+        ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd))
+"(AAAAAAAAAA BBBBBBBBBBBB 'C 
+       DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD)"
+
+(WRITE-TO-STRING        '(a (b) 'c d))
+"(A (B) 
+   'C D)"
+
+(WRITE-TO-STRING        '(aaaaaaaaaa (bbbbbbbbbbbb) 'c 
+        dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd))
+"(AAAAAAAAAA (BBBBBBBBBBBB) 
+       'C DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD)"
+
+(WRITE-TO-STRING        '(a #'b c))
+"(A #'B 
+   C)"
+;;"(A #'B C)"
+
+(WRITE-TO-STRING        '(a `b c))
+"(A `B 
+   C)"
+;;"(A `B C)"
+
+(WRITE-TO-STRING        '(a ,b c))
+"(A ,B 
+   C)"
+;;"(A ,B C)"
+
+(WRITE-TO-STRING        '(a ,@b c))
+"(A ,@B 
+   C)"
+;;"(A ,@B C)"
+
+(WRITE-TO-STRING        '(a ,.b c))
+"(A ,.B 
+   C)"
+;;"(A ,.B C)"
+
+(WRITE-TO-STRING        '(displac0 (liste1)(liste2)))
+"(displac0 (LISTE1) 
+       (LISTE2))"
+
+(WRITE-TO-STRING         
+'(lambda (form vare lenv benv)
+                        (progn (mapcon '(lambda (x)
+                                                (if (typep 'list x)
+                                                   (compile-exp x vare 
+                                                            lenv benv)
+                                                   '((lbl ,(cdr(assoc x 
+                                                                lenv ))))))))))
+"(LAMBDA (FORM VARE LENV BENV) 
+       (PROGN (MAPCON '(LAMBDA (X) 
+                              (IF (TYPEP 'LIST X) 
+                                  (COMPILE-EXP X VARE LENV BENV) 
+                                  '((LBL ,(CDR (ASSOC X LENV)))))))))"
+
+(WRITE-TO-STRING         
+'(lambda ()
+                        ((c) nil "12345678901234567890123456789012")))
+"(LAMBDA NIL 
+       ((C) 
+        NIL \"12345678901234567890123456789012\"))"
+
+(WRITE-TO-STRING         '(lambda ()
+        ((cccccccccccccccccccccccccccccccccccccccccccc) nil 
+        "12345678901234567890123456789012")))
+"(LAMBDA NIL 
+       ((CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC) 
+        NIL \"12345678901234567890123456789012\"))"
+
+(WRITE-TO-STRING         '(defun ed-search-all
+                        (cl)
+                        (cond ((null (consp cl)) nil)
+                                ((ed-search cl) t)
+                                (t nil))))
+"(DEFUN ED-SEARCH-ALL 
+       (CL) 
+       (COND ((NULL (CONSP CL)) 
+              NIL) 
+             ((ED-SEARCH CL) 
+              T) 
+             (T NIL)))"
+
+(WRITE-TO-STRING         '(defun ed-search-all
+                        (cl)
+                        (cond ((null (consp ccccccccclllllllllll)) nil)
+                                ((ed-search ccccccccclllllllllll) t)
+                                (t nil))))
+"(DEFUN ED-SEARCH-ALL 
+       (CL) 
+       (COND ((NULL (CONSP CCCCCCCCCLLLLLLLLLLL)) 
+              NIL) 
+             ((ED-SEARCH CCCCCCCCCLLLLLLLLLLL) 
+              T) 
+             (T NIL)))"
+
+(WRITE-TO-STRING         '(a b c 
+                    (d)
+                    'e f g h i ))
+"(A B C 
+   (D) 
+   'E F G H I)"
+
+(WRITE-TO-STRING         '(aaaaaaaaaaa bbbbbbbbbb cccccccccc 
+                    (dddddddddd)
+                    'eeeeeeeeee fffffffffff gggggggggg hhhhhhhhhh iiiiiiiiii ))
+"(AAAAAAAAAAA BBBBBBBBBB CCCCCCCCCC 
+       (DDDDDDDDDD) 
+       'EEEEEEEEEE FFFFFFFFFFF GGGGGGGGGG HHHHHHHHHH IIIIIIIIII)"
+
+(WRITE-TO-STRING '(DEFMACRO DEFSTRUCT 
+       (LET ((TYPE (CAR TYPE-OPTIONS)) (OPTIONS (CDR TYPE-OPTIONS))) 
+            (LET ((DEFSTRUCT-TYPE (ANY-KNOWN-TYPE OPTIONS))) 
+                 `(PROGN 'COMPILE 
+                      (PUT ',TYPE 
+                      (MAKE-DEFSTRUCT-DESCRIPTION NAME 
+                         (LET ((I (1- (DEFSTRUCT-TYPE-DESCRIPTION-OVERHEAD (
+                                             GET ',DEFSTRUCT-TYPE 
+                                             'DEFSTRUCT-TYPE-DESCRIPTION)))))))))))))
+"(DEFMACRO DEFSTRUCT 
+       (LET ((TYPE (CAR TYPE-OPTIONS)) 
+             (OPTIONS (CDR TYPE-OPTIONS))) 
+            (LET ((DEFSTRUCT-TYPE (ANY-KNOWN-TYPE OPTIONS))) 
+                 `(PROGN 'COMPILE 
+                         (PUT ',TYPE 
+                              (MAKE-DEFSTRUCT-DESCRIPTION NAME 
+                                     (LET ((I (1- 
+                                           (DEFSTRUCT-TYPE-DESCRIPTION-OVERHEAD 
+                                                  (GET ',DEFSTRUCT-TYPE 
+                                                    'DEFSTRUCT-TYPE-DESCRIPTION))))))))))))"
+
+(WRITE-TO-STRING '(SETQ (COND ((SETQ (CATCH (MAPCAN '(LAMBDA (SPEC) 
+
+              (CASE (T (COND ((SETQ (COND ((MINUSP SPEC))))))))))))))))
+"(SETQ (COND ((SETQ (CATCH (MAPCAN '(LAMBDA (SPEC) 
+                                          (CASE (T (COND ((SETQ (COND ((MINUSP 
+                                                                           SPEC)))))))))))))))"
+
+(WRITE-TO-STRING '((SETQ (CATCH (MAPCAN '(LAMBDA (SPEC) 
+              (CASE (T (COND ((COND (EVENT1 (COND ((AND (EQCAR INPU 
+))))))))))))))))
+"((SETQ (CATCH (MAPCAN '(LAMBDA (SPEC) 
+                              (CASE (T (COND ((COND (EVENT1 (COND ((AND (EQCAR 
+                                                                           INPU)))))))))))))))"
+(WRITE-TO-STRING '(case a
+       (otto (aaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb)
+             (ccccccccccccccccccccc ddddddddddddddddddddddddddddddddddddd))
+       (:otto (aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb)
+              (ccccccccccccccccccccccccc ddddddddddddddddddddddddd))
+       (12 (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbbbb)
+           (ccccccccccccccccccccccccccccccccc  ddddddddddddddddddddddddddd))
+       (#\n (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb)
+            (ccccccccccccccccccccccccccccccccccccccc ddddddddddddddddddddddd))))
+"(CASE A 
+      (OTTO (AAAAAAAAAAAAAAAAAAAAAAAAAAAAA BBBBBBBBBBBBBBBBBBBBBB) 
+            (CCCCCCCCCCCCCCCCCCCCC DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD)) 
+      (:OTTO (AAAAAAAAAAAAAAAAAAAAAA BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB) 
+             (CCCCCCCCCCCCCCCCCCCCCCCCC DDDDDDDDDDDDDDDDDDDDDDDDD)) 
+      (12 (AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA BBBBBBBBBBBBBBBBBBBBBBBBBBB) 
+          (CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DDDDDDDDDDDDDDDDDDDDDDDDDDD)) 
+      (#\\n (AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA BBBBBBBBBBBBBBBBBBBBBBBBB) 
+           (CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DDDDDDDDDDDDDDDDDDDDDDD)))"
+
+(WRITE-TO-STRING '(DEFMACRO DEFSTRUCT-TYPE-DESCRIPTION-OVERHEAD (A_STRUCTURE) 
+
+(LET ((TYPE (QUOTE DEFSTRUCT-TYPE-DESCRIPTION)) (SLOT-NAME (QUOTE OVERHEAD))) 
+
+(EVAL (DEFSTRUCT-TYPE-DESCRIPTION-REF 
+(GET (QUOTE LIST) (QUOTE DEFSTRUCT-TYPE-DESCRIPTION)))))))
+"(DEFMACRO DEFSTRUCT-TYPE-DESCRIPTION-OVERHEAD 
+       (A_STRUCTURE) 
+       (LET ((TYPE 'DEFSTRUCT-TYPE-DESCRIPTION) 
+             (SLOT-NAME 'OVERHEAD)) 
+            (EVAL (DEFSTRUCT-TYPE-DESCRIPTION-REF (GET 'LIST 
+                                                    'DEFSTRUCT-TYPE-DESCRIPTION)))))"
+
+(WRITE-TO-STRING '(defmacro aaa
+(let--eval--defstruct-type-description-ref 
+(get lista qdefstruct-type-description))))
+"(DEFMACRO AAA 
+       (LET--EVAL--DEFSTRUCT-TYPE-DESCRIPTION-REF (GET LISTA 
+                                                    QDEFSTRUCT-TYPE-DESCRIPTION)))"
+
+(WRITE-TO-STRING 
+      '(UN-MAC-EXPAND DM-DF KWOTE MOVD SP VIRGINFN OK EF EXPAND-MCALL 
+              EXPANDMACROS IS-displac0 IS-MACRO MAC-EXPAND R-EXPANDMACROS 
+              PUTPROPS1 *UNDIS *DIS COPY PUTPROPS *CHE *CL *CLE *TEST *UNBLOCK 
+        CH 
+              EDITCOMS EDREPLACE PRINTLEVEL NEQ *UNDO ABFRAGE ATOML CONS0 CONT 
+        EDFIND1ST 
+              EDITF ))
+"(UN-MAC-EXPAND DM-DF KWOTE MOVD SP VIRGINFN OK EF EXPAND-MCALL EXPANDMACROS 
+       IS-displac0 IS-MACRO MAC-EXPAND R-EXPANDMACROS PUTPROPS1 *UNDIS *DIS 
+       COPY PUTPROPS *CHE *CL *CLE *TEST *UNBLOCK CH EDITCOMS EDREPLACE 
+       PRINTLEVEL NEQ *UNDO ABFRAGE ATOML CONS0 CONT EDFIND1ST EDITF)"
+
+(WRITE-TO-STRING '(DEFUN MAKEFILE 
+       (LET 
+            (PRINT (displac0 (LIST 'PRINT (LIST 'QUOTE (LIST 'LAST 'UPDATE 
+        (DATE-TIME)))) `(PRINT '(LAST UPDATE ,(DATE-TIME)))) (OR ECHO STREAM)) 
+            (PRINT (displac0 (LIST 'PRINT (LIST 'QUOTE (LIST 'VERSION GENV))) 
+        `(PRINT '(VERSION ,GENV))) (OR ECHO STREAM)) 
+            (WHEN FNSV (PRINT (displac0 (LIST 'SETQ FNS (LIST 'QUOTE FNSV)) 
+        `(SETQ ,FNS ',FNSV)) (OR ECHO STREAM))) 
+            (WHEN VARSV (PRINT (displac0 (LIST 'SETQ VARS (LIST 'QUOTE VARSV)) 
+        `(SETQ ,VARS ',VARSV)) (OR ECHO STREAM))) 
+            (PRINT (displac0 (LIST 'SETQ COMS (LIST 'QUOTE COMSV)) `(SETQ 
+        ,COMS ',COMSV)) (OR ECHO STREAM)) 
+            (PRINT (LIST 'SETQ GEN GENV) (OR ECHO STREAM)) )))
+"(DEFUN MAKEFILE 
+       (LET (PRINT (displac0 (LIST 'PRINT 
+                                   (LIST 'QUOTE 
+                                         (LIST 'LAST 'UPDATE 
+                                               (DATE-TIME)))) 
+                          `(PRINT '(LAST UPDATE 
+                                         ,(DATE-TIME)))) 
+                   (OR ECHO STREAM)) 
+            (PRINT (displac0 (LIST 'PRINT 
+                                   (LIST 'QUOTE 
+                                         (LIST 'VERSION GENV))) 
+                          `(PRINT '(VERSION ,GENV))) 
+                   (OR ECHO STREAM)) 
+            (WHEN FNSV 
+                  (PRINT (displac0 (LIST 'SETQ FNS 
+                                         (LIST 'QUOTE FNSV)) 
+                                `(SETQ ,FNS 
+                                       ',FNSV)) 
+                         (OR ECHO STREAM))) 
+            (WHEN VARSV 
+                  (PRINT (displac0 (LIST 'SETQ VARS 
+                                         (LIST 'QUOTE VARSV)) 
+                                `(SETQ ,VARS 
+                                       ',VARSV)) 
+                         (OR ECHO STREAM))) 
+            (PRINT (displac0 (LIST 'SETQ COMS 
+                                   (LIST 'QUOTE COMSV)) 
+                          `(SETQ ,COMS 
+                                 ',COMSV)) 
+                   (OR ECHO STREAM)) 
+            (PRINT (LIST 'SETQ GEN GENV) 
+                   (OR ECHO STREAM))))"
+
+(write-to-string  '(DEFUN EVENT-SPEC 
+       (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa (
+                                                                       (NUMBERP 
+                                                                           SPEC) 
+                                                                       (SETQ 
+                                                                         EVENT1 
+                                                                         (COND (
+                                                                        (MINUSP 
+                                                                           SPEC) 
+                                                                      (NTH-BACK 
+                                                                        HISTORY 
+                                                                        (1- 
+                                                                           SPEC))) 
+))))))
+"(DEFUN EVENT-SPEC 
+       (AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (
+                                                                       (NUMBERP 
+                                                                           SPEC) 
+                                                                         (SETQ 
+                                                                         EVENT1 
+                                                                         (COND (
+                                                                        (MINUSP 
+                                                                           SPEC) 
+                                                                      (NTH-BACK 
+                                                                        HISTORY 
+                                                                        (1- 
+                                                                           SPEC))))))))"
+
+(WRITE-TO-STRING '(DEFUN EVENT-SPEC 
+       ((LAMBDAxSETQxxCONDxxxSETQxxCATCHxxMAPCANxxxxxCASE (TxxCOND 
+                                        (COND (EVENT1 
+                                            (COND (E (LIST EVENT1)) 
+                                                  ((AND (CONSP INPU)        ;!!!
+                                                        (EQCAR INPU '&GROUP)) 
+                                                   (APPEND (CDR INPU) NIL)) ;!!!
+                                                  (T)))))))))
+"(DEFUN EVENT-SPEC 
+       ((LAMBDAXSETQXXCONDXXXSETQXXCATCHXXMAPCANXXXXXCASE (TXXCOND (COND 
+                                                                        (EVENT1 
+                                                                          (COND 
+                                                                             (E 
+                                                                          (LIST 
+                                                                         EVENT1)) 
+                                                                                (
+                                                                           (AND 
+                                                                         (CONSP 
+                                                                           INPU) 
+                                                                         (EQCAR 
+                                                                           INPU 
+                                                                        '&GROUP)) 
+                                                                        (APPEND 
+                                                                           (CDR 
+                                                                           INPU) 
+                                                                            NIL)) 
+                                                                             (T))))))))"
+(WRITE-TO-STRING 
+'(DEFUN EVENT-SPEC 
+   ((LAMBDA (EVENT V INPUT EVENT1 I E) 
+      (SETQ INPUT 
+        (COND ((SETQ INPUT 
+          (CATCH 'TAG 
+            (MAPCAN '(LAMBDA (SPEC) 
+              (CASE SPEC 
+                (T (COND ((NUMBERP SPEC) 
+                          (SETQ EVENT1 
+                                (COND ((MINUSP SPEC) 
+                                       (NTH-BACK HISTORY 
+                                                 (1- SPEC))))) 
+                          (COND (EVENT1 (COND ((AND (EQCAR INPU '&GROUP))))))) 
+            (T (PRINTL-SP "illegale specification" SPEC 'IN L)))))) 
+L))))))))))
+"(DEFUN EVENT-SPEC 
+       ((LAMBDA (EVENT V INPUT EVENT1 I E) 
+               (SETQ INPUT 
+                     (COND ((SETQ INPUT 
+                                  (CATCH 'TAG 
+                                         (MAPCAN '(LAMBDA (SPEC) 
+                                                         (CASE SPEC 
+                                                               (T (COND (
+                                                                       (NUMBERP 
+                                                                           SPEC) 
+                                                                         (SETQ 
+                                                                         EVENT1 
+                                                                         (COND (
+                                                                        (MINUSP 
+                                                                           SPEC) 
+                                                                      (NTH-BACK 
+                                                                        HISTORY 
+                                                                        (1- 
+                                                                           SPEC))))) 
+                                                                         (COND 
+                                                                        (EVENT1 
+                                                                          (COND (
+                                                                           (AND 
+                                                                         (EQCAR 
+                                                                           INPU 
+                                                                        '&GROUP))))))) 
+                                                                        (T 
+                                                                     (PRINTL-SP 
+                                                       \"illegale specification\" 
+                                                       SPEC 'IN L)))))) 
+                                                L)))))))))"
+
+(WRITE-TO-STRING '(DEFUN EVENT-SPEC 
+       (HISTORY &OPTIONAL L) 
+       ((LAMBDA (EVENT V INPUT EVENT1 I E) 
+               (SETQ INPUT 
+                     (COND ((NULL L) 
+                            (CAR (CDR (CAR (CAR (CDDDR (CAR HISTORY))))))) 
+                           ((SETQ INPUT 
+                                  (CATCH 'TAG 
+                                         (MAPCAN '(LAMBDA (SPEC) 
+                                                         (CASE SPEC 
+                                                               (V (SETQ V T) 
+                                                                  (SETQ E NIL) 
+                                                                  NIL) 
+                                                               (I (SETQ V NIL) 
+                                                                  (SETQ E NIL)) 
+                                                               (E (SETQ E T) 
+                                                                  (SETQ V NIL) 
+                                                                  (SETQ I NIL)) 
+                                                               (T (COND (
+                                                                       (NUMBERP 
+                                                                           SPEC) 
+                                                                       (SETQ 
+                                                                         EVENT1 
+                                                                         (COND (
+                                                                        (MINUSP 
+                                                                           SPEC) 
+                                                                      (NTH-BACK 
+                                                                        HISTORY 
+                                                                        (1- 
+                                                                           SPEC))) 
+                                                                               (
+                                                                     (ASSQ-HOLD 
+                                                                           SPEC 
+                                                                        HISTORY)))) 
+                                                                       (COND 
+                                                                        (EVENT1 
+                                                                          (SETQ 
+                                                                           INPU 
+                                                                           (CAR 
+                                                                           (CDR 
+                                                                         EVENT1))) 
+                                                                          (COND 
+                                                                             (V 
+                                                                          (LIST 
+                                                                           (CAR 
+                                                                          (CDDR 
+                                                                         EVENT1)))) 
+                                                                             (E 
+                                                                          (LIST 
+                                                                         EVENT1)) 
+                                                                             (
+                                                                           (AND 
+                                                                         (CONSP 
+                                                                           INPU) 
+                                                                         (EQCAR 
+                                                                           INPU 
+                                                                        '&GROUP)) 
+                                                                        (APPEND 
+                                                                           (CDR 
+                                                                           INPU) 
+                                                                           NIL)) 
+                                                                             (T 
+                                                                          (LIST 
+                                                                           INPU)))))) 
+                                                                        (T 
+                                                                     (PRINTL-SP 
+                                                                            "illegale specification" 
+                                                                           SPEC 
+                                                                      'IN L) )))))))))))))))
+"(DEFUN EVENT-SPEC 
+       (HISTORY &OPTIONAL L) 
+       ((LAMBDA (EVENT V INPUT EVENT1 I E) 
+               (SETQ INPUT 
+                     (COND ((NULL L) 
+                            (CAR (CDR (CAR (CAR (CDDDR (CAR HISTORY))))))) 
+                           ((SETQ INPUT 
+                                  (CATCH 'TAG 
+                                         (MAPCAN '(LAMBDA (SPEC) 
+                                                         (CASE SPEC 
+                                                               (V (SETQ V T) 
+                                                                  (SETQ E NIL) 
+                                                                  NIL) 
+                                                               (I (SETQ V NIL) 
+                                                                  (SETQ E NIL)) 
+                                                               (E (SETQ E T) 
+                                                                  (SETQ V NIL) 
+                                                                  (SETQ I NIL)) 
+                                                               (T (COND (
+                                                                       (NUMBERP 
+                                                                           SPEC) 
+                                                                         (SETQ 
+                                                                         EVENT1 
+                                                                         (COND (
+                                                                        (MINUSP 
+                                                                           SPEC) 
+                                                                      (NTH-BACK 
+                                                                        HISTORY 
+                                                                        (1- 
+                                                                           SPEC))) 
+                                                                               (
+                                                                     (ASSQ-HOLD 
+                                                                           SPEC 
+                                                                        HISTORY)))) 
+                                                                         (COND 
+                                                                        (EVENT1 
+                                                                          (SETQ 
+                                                                           INPU 
+                                                                           (CAR 
+                                                                           (CDR 
+                                                                         EVENT1))) 
+                                                                          (COND 
+                                                                             (V 
+                                                                          (LIST 
+                                                                           (CAR 
+                                                                          (CDDR 
+                                                                         EVENT1)))) 
+                                                                             (E 
+                                                                          (LIST 
+                                                                         EVENT1)) 
+                                                                             (
+                                                                           (AND 
+                                                                         (CONSP 
+                                                                           INPU) 
+                                                                         (EQCAR 
+                                                                           INPU 
+                                                                        '&GROUP)) 
+                                                                        (APPEND 
+                                                                           (CDR 
+                                                                           INPU) 
+                                                                            NIL)) 
+                                                                             (T 
+                                                                          (LIST 
+                                                                           INPU)))))) 
+                                                                        (T 
+                                                                     (PRINTL-SP 
+                                                       \"illegale specification\" 
+                                                       SPEC 'IN L)))))))))))))))"
+
+;***4
+
+(WRITE-TO-STRING '(LAMBDA (PP-CALL &OPTIONAL ENV) 
+       (LET ((SYMB (CADR PP-CALL))) 
+            (IF (SYMBOLP SYMB) 
+                (LIST 'PROGN 
+                      (IF (BOUNDP SYMB) 
+                          (LIST 'PPRINT SYMB)) 
+                      (IF (FBOUNDP SYMB) 
+                          (LET ((FUN (SYMBOL-FUNCTION SYMB))) 
+                               (COND ((EQ (SYSTEM::%GET-TYPE FUN) 
+                                          SYSTEM::%TYPE-CLOSURE) 
+                                      (LIST 'PPRINT 
+                                            (LIST 'QUOTE 
+                                                  (LIST* 'DEFUN SYMB 
+                                                         (CDR (SYSTEM::%P-GET-CONTENT 
+                                                               (SYSTEM::%INDEX-LOCATION 
+                                                                FUN 3))))))) 
+                                     ((EQ (SYSTEM::%GET-TYPE FUN) 
+                                          SYSTEM::%TYPE-CONS) 
+                                      (LIST 'PPRINT 
+                                            (LIST 'QUOTE 
+                                                  (LIST* 'DEFUN SYMB 
+                                                         (CDR FUN))))) 
+                                     ((EQ (SYSTEM::%GET-TYPE FUN) 
+                                          SYSTEM::%TYPE-MACRO-FUNCTION) 
+                                      (LET ((FUNLIS (SYSTEM::%SET-TYPE-POINTER 
+                                                           SYSTEM::%TYPE-CONS 
+                                                           FUN))) 
+                                           (LIST 'PPRINT 
+                                                 (LIST 'QUOTE 
+                                                       (COND ((NULL (CDR FUNLIS)) 
+                                                              (CAR FUNLIS)) 
+                                                             (T (CADR FUNLIS)))))))))) 
+                      "ok")))))
+"(LAMBDA (PP-CALL &OPTIONAL ENV) 
+       (LET ((SYMB (CADR PP-CALL))) 
+            (IF (SYMBOLP SYMB) 
+                (LIST 'PROGN 
+                      (IF (BOUNDP SYMB) 
+                          (LIST 'PPRINT SYMB)) 
+                      (IF (FBOUNDP SYMB) 
+                          (LET ((FUN (SYMBOL-FUNCTION SYMB))) 
+                               (COND ((EQ (SYSTEM::%GET-TYPE FUN) 
+                                          SYSTEM::%TYPE-CLOSURE) 
+                                      (LIST 'PPRINT 
+                                            (LIST 'QUOTE 
+                                                  (LIST* 'DEFUN SYMB 
+                                                         (CDR 
+                                                        (SYSTEM::%P-GET-CONTENT 
+                                                       (SYSTEM::%INDEX-LOCATION 
+                                                              FUN 3))))))) 
+                                     ((EQ (SYSTEM::%GET-TYPE FUN) 
+                                          SYSTEM::%TYPE-CONS) 
+                                      (LIST 'PPRINT 
+                                            (LIST 'QUOTE 
+                                                  (LIST* 'DEFUN SYMB 
+                                                         (CDR FUN))))) 
+                                     ((EQ (SYSTEM::%GET-TYPE FUN) 
+                                          SYSTEM::%TYPE-MACRO-FUNCTION) 
+                                      (LET ((FUNLIS (SYSTEM::%SET-TYPE-POINTER 
+                                                           SYSTEM::%TYPE-CONS 
+                                                           FUN))) 
+                                           (LIST 'PPRINT 
+                                                 (LIST 'QUOTE 
+                                                       (COND ((NULL (CDR FUNLIS)) 
+                                                              (CAR FUNLIS)) 
+                                                             (T (CADR FUNLIS)))))))))) 
+                      \"ok\"))))"
+
+(WRITE-TO-STRING '
+(LAMBDA (PP-CALL &OPTIONAL ENV) 
+       (LET ((SYMB (CADR PP-CALL))) 
+            (IF (SYMBOLP SYMB) 
+                (LIST 'PROGN 
+                      (IF (BOUNDP SYMB) 
+                          (LIST 'PPRINT SYMB)) 
+                      (IF (FBOUNDP SYMB) 
+                          (LET ((FUN (SYMBOL-FUNCTION SYMB))) 
+                               (COND ((EQ (SYSTEM::%GET-TYPE FUN) 
+                                          SYSTEM::%TYPE-CLOSURE) 
+                                      (LIST 'PPRINT 
+                                            (LIST 'QUOTE 
+                                                  (LIST* 'DEFUN SYMB 
+                                                         (CDR (SYSTEM::%P-GET-CONTENT 
+                                                               (SYSTEM::%INDEX-LOCATION 
+                                                                FUN 3))))))) ))))))))
+"(LAMBDA (PP-CALL &OPTIONAL ENV) 
+       (LET ((SYMB (CADR PP-CALL))) 
+            (IF (SYMBOLP SYMB) 
+                (LIST 'PROGN 
+                      (IF (BOUNDP SYMB) 
+                          (LIST 'PPRINT SYMB)) 
+                      (IF (FBOUNDP SYMB) 
+                          (LET ((FUN (SYMBOL-FUNCTION SYMB))) 
+                               (COND ((EQ (SYSTEM::%GET-TYPE FUN) 
+                                          SYSTEM::%TYPE-CLOSURE) 
+                                      (LIST 'PPRINT 
+                                            (LIST 'QUOTE 
+                                                  (LIST* 'DEFUN SYMB 
+                                                         (CDR 
+                                                        (SYSTEM::%P-GET-CONTENT 
+                                                       (SYSTEM::%INDEX-LOCATION 
+                                                              FUN 3))))))))))))))"
+(WRITE-TO-STRING '
+(LAMBDA (PP-CALL &OPTIONAL ENV) 
+       (LET (IF (LIST (IF (LET (COND ((LIST (LIST (LIST* (CDR (SYSTEM::%P-GET-CONTENT 
+                                                               (SYSTEM::%INDEX-LOCATION 
+                                                                FUN 3))))))) ))))))))
+"(LAMBDA (PP-CALL &OPTIONAL ENV) 
+       (LET (IF (LIST (IF (LET (COND ((LIST (LIST (LIST* (CDR 
+                                                        (SYSTEM::%P-GET-CONTENT 
+                                                       (SYSTEM::%INDEX-LOCATION 
+                                                              FUN 3))))))))))))))"
+(WRITE-TO-STRING '
+(LAMBDA (PP-CALL &OPTIONAL ENV) 
+       (letttttttttttttttttttttttttttttttttttttttttttttt (CDR (SYSTEM::%P-GET-CONTENT 
+                                                               (SYSTEM::%INDEX-LOCATION 
+                                                                FUN 3))))))
+"(LAMBDA (PP-CALL &OPTIONAL ENV) 
+       (LETTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT (CDR 
+                                                        (SYSTEM::%P-GET-CONTENT 
+                                                       (SYSTEM::%INDEX-LOCATION 
+                                                              FUN 3)))))"
+
+(WRITE-TO-STRING '
+(lambdaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa (CDR (SYSTEM::%P-GET-CONTENT 
+                                                               (SYSTEM::%INDEX-LOCATION 
+                                                                FUN 3) ))))
+"(LAMBDAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (CDR 
+                                                        (SYSTEM::%P-GET-CONTENT 
+                                                       (SYSTEM::%INDEX-LOCATION 
+                                                              FUN 3))))"
+
+(WRITE-TO-STRING '
+(laaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa (SYSTEM::%P-GET-CONTENT 
+                                                               (SYSTEM::%INDEX-LOCATION 
+                                                                FUN 3) )))
+"(LAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
+       (SYSTEM::%P-GET-CONTENT (SYSTEM::%INDEX-LOCATION FUN 3)))"
+
+(SETQ *PRINT-PRETTY* NIL)
+NIL
+
+;***5
+
+(defstruct name a b c d e)
+NAME
+
+(progn (setq val '(name 1 2 3 4 5))
+       (setq st (sys::%set-type-pointer sys::%type-named-structure val))
+        T)
+T
+
+(WRITE-TO-STRING st)
+"#S(NAME A 1 B 2 C 3 D 4 E 5)"
+
+(defstruct (pcvar (:print-function print-pcvar)) id)
+pcvar
+
+(defun print-pcvar (var str dep)
+ (format str "?~s" (pcvar-id var)))
+print-pcvar
+
+(prin1-to-string (make-pcvar :id 'otto))
+"?OTTO"
+
+#|-------------------------------------------------------------------------
+
+-------------------------------------------------------------------------|#
+
diff --git a/src/tests/tread.tst b/src/tests/tread.tst
new file mode 100644
index 000000000..ce4bc12a2
--- /dev/null
+++ b/src/tests/tread.tst
@@ -0,0 +1,2117 @@
+ ;       ***********************************************************
+ ;       *  ROSENMUELLER  143   Tel.340   TREAD.dat   04.11.1987   *
+ ;       ***********************************************************
+;&----- Tread0.tst -------------------------------------------------------------
+
+ ;      Testdaten aus den Beispielen der Sprachbeschreibung
+ ;
+ ;      Eingabe der Zahl 27 und der Liste (a b)         Seite 334
+
+
+     27
+   27
+     27.
+   27
+     #o33 
+   27
+       #x1b 
+   27
+       #b11011
+   27
+        #.(* 3 3 3)
+   27
+        81/3
+   27
+        '(A B)
+   (A B)
+        '(a b)
+   (A B)
+        '( a b )
+   (A B)
+        '(\A |B|)
+   (A B)
+
+           '(|\A|
+           B
+        )
+   (A B)
+
+
+ ;      Test auf Gleichheit                             Seite 338
+        '|foo||bar| 
+   |foobar|
+       '|foobar|
+
+   |foobar|
+ ;      Test auf Gleichheit
+        '|foo|bar|baz| 
+   |foo|BAR|baz|
+       '|fooBARbaz|
+
+   |foo|BAR|baz|
+ ;      Test auf Ungleichheit
+
+
+(progn (unless (find-package '|foo| )(make-package '|foo|)) t)
+   T
+
+        '|foo:bar| 
+   |foo:bar|
+      
+        (read-from-string "|foo|:|bar|")
+
+   ERROR
+
+
+
+ ;      reserved token : potential numbers              Seite 341
+ ;              eingelesen als Symbol und 
+ ;              als solches gedruckt (dh. mit '\' als 1.Zeichen)
+        '1b5000 
+   \1B5000
+       '777777q 
+   \777777Q
+       '1.7J 
+   \1.7J
+       '-3/4+6.7J
+
+   \-3/4+6.7J
+        '12/25/83 
+   \12/25/83
+     '27^19 
+   \27^19
+         '3^4/5 
+   \3^4/5
+      '6//7
+
+   \6//7
+        '3.1.2.6 
+   \3.1.2.6
+      '^-43^ 
+   \^-43^
+         '3.141_592_653_589_793_238_4
+
+   \3.141_592_653_589_793_238_4
+        '-3.7+2.6i-6.17j+19.6k
+
+   \-3.7+2.6I-6.17J+19.6K
+
+ ;      not potential numbers
+ ;          sind immer Symbole :
+        '/ 
+   /
+         '/5 
+   /5
+       '+ 
+   +
+       '1+ 
+   1+
+         '1-
+
+   1-
+        'foo+ 
+   FOO+
+      'ab.cd 
+   AB.CD
+    '_ 
+   _
+       '^ 
+   ^
+          '^/-
+
+   ^/-
+
+ ;      die folgenden token sind Symbole , wenn *read-base* == 10 :
+        'bad-face 
+   BAD-FACE
+        '25-sec-83 
+   25-SEC-83
+       'a/b 
+   A/B
+       'fad_cafe
+
+   FAD_CAFE
+        'f^
+
+   F^
+
+(progn  (setq *print-base* 16)t)
+T
+
+ ;      und sind reserved token, wenn *read-base* == 16
+ ;      und werden mit '\' gedruckt, falls *print-base* == 16 :
+        'bad-face 
+   \BAD-FACE
+        '25-sec-83 
+   \25-SEC-83
+       'a/b 
+   \A/B
+       'fad_cafe
+
+   \FAD_CAFE
+        'f^
+
+   \F^
+
+(progn (setq *print-base* 10)t)
+T
+
+
+ ;      folgende "Zahlen"-Atome muessen mit '\' gedruckt werden :
+        '\123 
+   \123
+       '\123E12 
+   \123E12
+     '\123S12 
+   \123S12
+      '\123L12
+
+   \123L12
+        '\123D12 
+   \123D12
+    '\123F12 
+   \123F12
+     '\123/12
+
+   \123/12
+
+
+;
+ ;        Test der Punktsyntax
+        '(a . b)
+   (A . B)
+        '(a.b)
+   (A.B)
+                '(a. b)
+   (A. B)
+                
+        '(a \. b c)
+   (A \. B C)
+        '(a |.| b c)
+   (A \. B C)
+        '(a \... b c)
+   (A \... B C)
+
+        '(a |...| b c)
+   (A \... B C)
+        '(a b . c)
+   (A B . C)
+        '.ab
+
+   .AB
+        (read-from-string "(. b)")
+   ERROR
+        (read-from-string "(a .. b)")
+   ERROR
+        
+        (read-from-string "(a . . 'b   )")
+   ERROR
+        ; Fehler
+        (read-from-string "(a b c ...)")
+   ERROR
+
+;-------------------------------------------------------------------------------
+;(progn (print "etwa ein achtel") t) T
+;-------------------------------------------------------------------------------
+
+ ;        test zeichen einlesen
+#-ANSI-CL
+     #\control-meta-a
+#-ANSI-CL
+   #\M-C-A
+#-ANSI-CL
+     #\control-meta-\a
+#-ANSI-CL
+   #\M-C-\a
+
+     #\linefeed
+
+   #\NEWLINE
+     #\newline
+
+   #\NEWLINE
+     #\space
+
+   #\SPACE
+     #\rubout
+
+   #\RUBOUT
+     #\page
+
+   #\PAGE
+     #\tab
+
+   #\TAB
+     #\backspace
+
+   #\BACKSPACE
+     #\return
+
+   #\RETURN
+
+#-ANSI-CL
+     #\control-space
+#-ANSI-CL
+   #\C-SPACE
+
+#-ANSI-CL
+     #\c-m-return
+#-ANSI-CL
+   #\M-C-RETURN
+
+#-ANSI-CL
+     #\control-meta-tab
+#-ANSI-CL
+   #\M-C-TAB
+
+#-ANSI-CL
+     #\h-s-m-c-rubout
+#-ANSI-CL
+   #\H-S-M-C-RUBOUT
+
+#-ANSI-CL
+     #\control-%
+#-ANSI-CL
+   #\C-%
+
+#-ANSI-CL
+     #\control-\"
+#-ANSI-CL
+   #\C-\"
+
+#-ANSI-CL
+     #\meta->
+#-ANSI-CL
+   #\M->
+
+ ;        Test *read-base*
+(setq *read-base* 2)
+2
+
+(setq *print-radix* t)
+T
+
+#+XCL (prin1-to-string 4/3.) #+XCL "4/3."
+#-XCL (prin1-to-string #10r4/3) #-XCL "#10r4/3"
+
+(setq *print-base* 2.) 2.
+
+#+XCL (prin1-to-string 4/3.) #+XCL "#2r100/11"
+#-XCL (prin1-to-string #10r4/3) #-XCL "#b100/11"
+
+(setq *print-base* 10.) 10.
+
+       '123 
+   \123
+        123. 
+   123.
+       312.
+
+   312.
+
+(progn (setq *read-base* 10. ) t)
+T
+
+(setq *print-radix* nil)
+NIL
+
+ ;        Test floatings extrema 
+        .1      
+   0.1
++.1     
+   0.1
+-.1     
+   -0.1
+.1e1    
+   1.0
++.1e1   
+   1.0
+-.1e1   
+   -1.0
+1e1     
+   10.0
++1e1    
+   10.0
+-1e1
+
+   -10.0
+        1.e1    
+   10.0
++1.e1   
+   10.0
+-1.e1
+
+   -10.0
+
+(setq *read-base* 16)
+16
+
+        '1a1.   
+   \1A1.
+; fehler symbol
+        '1r1.   
+   \1R1.
+; fehler symbol
+
+(progn (setq *read-base* 10. ) t)
+T
+
+ ;        Test *print-level*
+(setq *print-level* 10)
+10
+
+(setq *print-circle* t) 
+T
+
+;-- NSUBST ging in Zyklus ! 
+#-ecls
+(prin1-to-string '(#1=(a b #1#)) ) 
+#-ecls
+"(#1=(a b #1#))"  
+
+#-ecls
+(prin1-to-string '(#1=(#1#)))
+#-ecls
+"(#1=(#1#))"
+
+#-ecls
+(prin1-to-string '(#1=(a b #1#) (c d #1#)))
+#-ecls
+"(#1=(a b #1#) (c d #1#))"
+
+(setq *print-level* nil)
+NIL
+
+ ;        Test *print-length*
+(setq *print-length* 11)
+11
+
+(prin1-to-string '(1 2 3 4 (5 5) 6 7 8 9 10 11 12 13))
+"(1 2 3 4 (5 5) 6 7 8 9 10 11 ...)"
+
+;;;; NSUBST  
+#-ECLS
+(prin1-to-string '#1=(a b . #1#))
+#+XCL "#2=(a b . #2#)"
+#-(or ECLS XCL) "#1=(A B . #1#)"
+
+(setq *print-length* nil)
+NIL
+
+ ;        Test packagemarker
+        ':abc
+
+   :ABC
+ ;        zur Zeit noch nicht implementiert :
+(progn (unless (find-package 'abc)(make-package 'abc)) t)
+   T
+
+        (read-from-string "abc:de")
+   ERROR
+        'abc::de
+   ABC::DE
+        (read-from-string "::111")
+   #+(or ECLS XCL) ERROR #+CLISP :|111|
+        (read-from-string ":abc:")
+   ERROR
+        (read-from-string ":abc:00")
+   ERROR
+       ;Fehler
+        (read-from-string "ab:cd:2")
+   ERROR
+        (read-from-string "ab:")
+   ERROR
+        (read-from-string "ab:cd:")
+   ERROR
+        (read-from-string "abc::")
+   #+XCL ERROR #+(or ECLS CLISP) abc::||
+ ;
+
+;&----- Tread1.tst -------------------------------------------------------------
+
+ ;        Test array
+        '#0a7
+   #0A7
+        '#1a(1 2 3 4 5 6 7 8)
+   #(1 2 3 4 5 6 7 8)
+
+        '#2a((1 2 3)(3 2 1))
+   #2A((1 2 3)(3 2 1))
+
+        '#3a(((1 2 3 ) (4 5 6))
+             ((1 2 3 ) (4 5 6)))
+   #3A(((1 2 3)(4 5 6))((1 2 3)(4 5 6)))
+
+   #+XCL '#a7
+   #+XCL #0A7
+   #+CLISP '#a7
+   #+CLISP #(NIL NIL NIL NIL NIL NIL NIL)
+
+        '#2a((1 2)(3 4)(5 6))
+   #2A((1 2)(3 4)(5 6))
+
+        '#3a(((1 2)(3 4)(5 6))
+             ((7 8)(9 10)(11 12)))
+   #3A(((1 2)(3 4)(5 6))((7 8)(9 10)(11 12)))
+
+ ;
+ ;        Test ehemaliger Fehler
+        (multiple-value-list (read-from-string "1(123)"))
+   (1 1)
+
+
+        (read-from-string "#0*111") 
+   ERROR
+                               ; Fehler
+        (read-from-string "#0(1 1 1 )")
+   ERROR
+                        ; Fehler
+        (read-from-string "#0r111")
+   ERROR
+        (read-from-string "#1r111")
+   ERROR
+               ; Fehler
+        #2r111 
+   7
+               #36r111
+
+   1333
+        (read-from-string "#37r111")
+   ERROR
+                               ; Fehler
+        (read-from-string "#011010")
+ERROR
+
+        -01     
+   -1
+-001    
+   -1
+-01.    
+   -1
+-0.     
+   0
+-0/12   
+   0
+-00.    
+   0
+-00/12  
+   0
+;zahlen
+        '-12./12        
+   \-12./12
+'-0./12 
+   \-0./12
+                                ;symbole
+
+        (list 1 2 #\a)
+   (1 2 #\a)
+
+
+;;        '{1 2 3 { 4 5 6) (7 8 9 }
+;;   (1 2 3 (4 5 6) (7 8 9))
+
+;-------------------------------------------------------------------------------
+;(progn (print "etwa ein viertel") t) T
+;-------------------------------------------------------------------------------
+
+ ;
+ ;        Test der Fehlerbehandlung
+ ;
+ ;        -2        <esc> als 1. zeichen
+          (read-from-string "")
+   ERROR
+ 
+ ;        -3       <esc> im token
+          (read-from-string "abc")
+   ERROR
+
+
+ 
+ ;        -4       <esc> innerhalb von |.....|
+          (read-from-string "a|bc")
+   ERROR
+
+ ;        -5         zu langer vektor
+          (read-from-string "#2(a b c)")
+   ERROR
+
+ ;        -6         packagezeichenfehler
+          (read-from-string "::")
+   #+(or ECLS XCL) ERROR #+CLISP :||
+ ;        -7         zu langer bitvektor
+          (read-from-string "#2*1010")
+   ERROR
+
+;        -9         labelfehler
+          (read-from-string "#1#")
+   ERROR
+
+ ;        -10        punkttoken
+        (READ-FROM-STRING "... ")
+   ERROR
+
+;        -11        unzulaessige *read-base*
+;                wird auf 10 gesetzt durch Fehlerbehandlung
+        (progn (setq *read-base* 40) (read-from-string "123"))
+   ERROR
+
+;        Bindung nach Rueckkehr aus Debug
+*read-base*
+10.
+
+(progn (setq *read-base* 10.) t)
+T
+
+*read-base*
+10
+
+;        -12        falsche printbase
+(progn (setq *print-base* nil) (prin1-to-string *print-base*))
+ERROR
+
+(progn  (setq *print-base* 10.)t)
+T
+
+*print-base*
+10
+
+;        -14        feldfehler
+        (read-from-string "#2a((1 2 3)(1 2)")
+   ERROR
+        (read-from-string "#2a((1 2 3)(1 2))")
+   ERROR
+
+;;        (read-from-string "#2a(1 2 3}")
+;;   ERROR
+
+;        -16        unzulaessige printlevel
+#-ANSI-CL (setq *print-level* t)
+#-ANSI-CL T
+
+#-ANSI-CL *print-level*
+#-ANSI-CL T
+
+#-ANSI-CL (setq *print-level* nil)
+#-ANSI-CL NIL
+
+#-ANSI-CL *print-level*
+#-ANSI-CL NIL
+
+;        -17        unzulaessige printlength
+#-ANSI-CL (setq *print-length* t)
+#-ANSI-CL T
+
+#-ANSI-CL *print-length*
+#-ANSI-CL T
+
+#-ANSI-CL (setq *print-length* nil)
+#-ANSI-CL NIL
+
+#-ANSI-CL *print-length*
+#-ANSI-CL NIL
+
+;&----- Tread2.tst -------------------------------------------------------------
+
+ ;        -22        kein Atom fuer synonym
+;;;;; typsystem notwendig        
+(make-synonym-stream 123)
+ERROR
+
+ ;        -23        kein stream als wert 
+        (prin1-to-string (make-synonym-stream '*read-base*))
+   #+XCL "#<SYSTEM::%TYPE-SYNONYM-STREAM *READ-BASE*>"
+   #+CLISP "#<SYNONYM-STREAM *READ-BASE*>"
+   #+ECLS "#<synonym stream to *READ-BASE*>"
+
+ ;        -24        falscher abschluss fuer vektor
+
+        (read-from-string "#(1 2 3 .               )")
+   ERROR
+
+ ;      -29     falsch gepunktete liste
+        (read-from-string "(a .)")
+   ERROR
+
+
+        (read-from-string "(. a)")
+   ERROR
+
+
+ ;      -30     kein stream als argument
+        (make-echo-stream pi *standard-output*)
+   ERROR
+
+
+        (make-two-way-stream pi *standard-output*)
+   ERROR
+
+ ;      -31     kein stream als argument
+        (make-echo-stream *standard-input* pi)
+   ERROR
+
+
+        (make-two-way-stream *standard-input* pi)
+   ERROR
+
+
+ ;      -33     illegale readtable
+(progn (setq *readtable* t) (read-from-string "123"))
+ERROR
+
+(progn (setq *readtable* (copy-readtable nil)) t)
+T
+
+ ;      -35     illegale readbase in #xxR
+        (read-from-string "#37R")
+   ERROR
+
+ ;      -36     illegale ziffern in #xxR
+        (read-from-string "#10rabc")
+   ERROR
+
+        (read-from-string "#10ra/b")
+   ERROR
+ ;      -37     illegaler #\-string
+        (read-from-string "#\nocontrol-")
+   ERROR
+        (read-from-string "#\control-")
+   ERROR
+ ;      -38     ????????
+;;        }
+;;   ERROR
+
+ ;
+ ;      test print-radix
+ ;
+(setq *print-radix* t)
+T
+
+(WRITE-TO-STRING 11111 )
+   "11111."
+
+(progn  (setq *print-base* 2)t)
+T
+
+(WRITE-TO-STRING 11111 )
+   #+XCL "#2r10101101100111"
+   #-XCL "#b10101101100111"
+
+(progn  (setq *print-base* 8)t)
+T
+
+(WRITE-TO-STRING 11111 )
+   "#o25547"
+
+(progn  (setq *print-base* 16)t)
+T
+
+(WRITE-TO-STRING 11111 )
+   "#x2B67"
+
+(progn  (setq *print-base* 22)t)
+T
+
+(WRITE-TO-STRING 11111 )
+   "#22r10L1"
+
+(progn  (setq *print-base* 10)t)
+T
+
+(setq *print-radix* nil)
+NIL
+
+(WRITE-TO-STRING 11111 )
+   "11111"
+
+(progn  (setq *print-base* 2)t)
+T
+
+(WRITE-TO-STRING 11111 )
+   "10101101100111"
+
+(progn  (setq *print-base* 8)t)
+T
+
+(WRITE-TO-STRING 11111 )
+   "25547"
+
+(progn  (setq *print-base* 16)t)
+T
+
+(WRITE-TO-STRING 11111 )
+   "2B67"
+
+(progn  (setq *print-base* 22)t)
+T
+
+(WRITE-TO-STRING 11111 )
+   "10L1"
+
+(progn  (setq *print-base* 10)t)
+T
+
+ ;
+ ;      test read-default-float-format (besser write-to-string ?)
+ ;
+        0.00999998
+
+   0.00999998
+        0.009999998
+
+   0.009999998
+        0.0099999997
+
+   0.01
+        1.23
+
+   1.23
+(prin1-to-string        1.23e20)
+   "1.23E20" ; "1.229999E20"
+
+(prin1-to-string        1.23f20)
+   "1.23E20" ; "1.229999E20"
+
+(prin1-to-string        1.23s20)
+   #+XCL "1.229S20" #+CLISP "1.23s20"
+
+        1.23d20
+   1.23D20
+        1.23l20
+   1.23D20
+(prin1-to-string        123456789.123456789)
+   "1.2345679E8" ; "1.234567E8"
+
+(prin1-to-string        12345678.12345678)
+   "1.2345678E7" ; "1.234567E7"
+
+(prin1-to-string        1234567.1234567)
+   "1234567.1" ; "1234567.0"
+
+(prin1-to-string        123456.123456)
+   #-CLISP "123456.12" ; "123456.1"
+   #+CLISP "123456.125" ; Anzeigefehler
+
+(prin1-to-string        12345.12345)
+   "12345.123" ; "12345.12"
+
+(prin1-to-string        1234.1234)
+   "1234.1234" ; "1234.123"
+
+        123.123
+   123.123
+        12.12
+   12.12
+        1.1
+   1.1
+
+(setq *read-default-float-format* 'short-float)
+SHORT-FLOAT
+
+        1.23
+   1.23
+(prin1-to-string        1.23e20)
+   "1.23E20" ; "1.229E20"
+
+(prin1-to-string        1.23f20)
+   "1.23f20" ; "1.229999F20"
+
+(prin1-to-string        1.23s20)
+   "1.23E20" ; "1.229E20"
+
+        1.23d20
+   1.23D20
+        1.23l20
+   1.23D20
+(prin1-to-string        123456789.123456789)
+   "1.23457E8" ; "1.234E8"
+
+(prin1-to-string        12345678.12345678)
+   "1.23457E7" ; "1.234E7"
+
+(prin1-to-string        1234567.1234567)
+   "1234560.0"
+
+(prin1-to-string        123456.123456)
+   "123456.0"
+
+(prin1-to-string        12345.12345)
+   "12345.1" ; "12345.0"
+
+(prin1-to-string        1234.1234)
+   #-CLISP "1234.12" ; "1234.0"
+   #+CLISP "1234.13" ; Anzeigefehler
+
+(prin1-to-string        123.123)
+   "123.123" ; "123.1"
+
+        12.12
+   12.12
+        1.1
+   1.1
+
+(setq *read-default-float-format* 'double-float)
+DOUBLE-FLOAT
+
+        1.23
+   1.23
+        1.23e20
+   1.23E20
+(prin1-to-string        1.23f20)
+   "1.23f20" ; "1.229999F20"
+
+(prin1-to-string        1.23s20)
+   "1.23s20" ; "1.229S20"
+
+        1.23d20
+   1.23E20
+        1.23l20
+   1.23E20
+(prin1-to-string        123456789.123456789)
+   "1.2345678912345679E8" ; "1.234567891234568E8"
+
+        12345678.12345678
+   1.234567812345678E7
+        1234567.1234567
+   1234567.1234567
+        123456.123456
+   123456.123456
+        12345.12345
+   12345.12345
+        1234.1234
+   1234.1234
+        123.123
+   123.123
+        12.12
+   12.12
+        1.1
+   1.1
+
+(setq *read-default-float-format* 'long-float)
+LONG-FLOAT
+
+        1.23
+   #+XCL 1.23D0 #-XCL 1.23
+        1.23e20
+   #+XCL 1.23D20 #-XCL 1.23E20
+(prin1-to-string        1.23f20)
+   "1.23f20" ; "1.229999F20"
+
+(prin1-to-string        1.23s20)
+   "1.23s20" ; "1.229S20"
+
+        1.23d20
+   1.23D20
+        1.23l20
+   #+XCL 1.23D20 #-XCL 1.23E20
+(prin1-to-string        123456789.123456789)
+   "1.23456789123456789E8" ; "1.234567891234568D8"
+
+        12345678.12345678
+   #+XCL 1.234567812345678D7 #-XCL 1.234567812345678E7
+        1234567.1234567
+   #+XCL 1234567.1234567D0 #-XCL 1234567.1234567
+        123456.123456
+   #+XCL 123456.123456D0 #-XCL 123456.123456
+        12345.12345
+   #+XCL 12345.12345D0 #-XCL 12345.12345
+        1234.1234
+   #+XCL 1234.1234D0 #-XCL 1234.1234
+        123.123
+   #+XCL 123.123D0 #-XCL 123.123
+        12.12
+   #+XCL 12.12D0 #-XCL 12.12
+        1.1
+   #+XCL 1.1D0 #-XCL 1.1
+
+(setq *read-default-float-format* 'single-float)
+SINGLE-FLOAT
+
+ ;
+ ;      test print-case
+ ;
+(WRITE-TO-STRING 'abcde)
+   "ABCDE"
+
+(WRITE-TO-STRING        'abcde-efghij)
+   "ABCDE-EFGHIJ"
+
+(WRITE-TO-STRING        'abcde1efghij)
+   "ABCDE1EFGHIJ"
+
+(WRITE-TO-STRING        'abcde-1efgh)
+   "ABCDE-1EFGH"
+
+(setq *print-case* :downcase)
+:downcase
+
+(WRITE-TO-STRING        'abcde)
+   "abcde"
+
+(WRITE-TO-STRING        'abcde-efghij)
+   "abcde-efghij"
+
+(WRITE-TO-STRING        'abcde1efghij)
+   "abcde1efghij"
+
+(WRITE-TO-STRING        'abcde-1efgh)
+   "abcde-1efgh"
+
+(setq *print-case* :capitalize)
+:Capitalize
+
+(WRITE-TO-STRING        'abcde)
+   "Abcde"
+
+(WRITE-TO-STRING        'abcde-efghij)
+   "Abcde-Efghij"
+
+(WRITE-TO-STRING        'abcde1efghij)
+   "Abcde1efghij"
+
+(WRITE-TO-STRING        'abcde-1efgh)
+   "Abcde-1efgh"
+
+(setq *print-case* :upcase)
+:UPCASE
+
+ ;
+ ;      test print-gensym
+ ;
+(progn (gensym "test")(gensym 77) t)
+   T
+
+(setq *print-gensym* nil)
+NIL
+
+(WRITE-TO-STRING        (gensym))
+   #+XCL "|test|78" #+CLISP "|test78|"
+
+(setq *print-gensym* t)
+T
+
+(WRITE-TO-STRING        (gensym))
+   #+XCL "#:|test|79" #+CLISP "#:|test79|"
+
+ ;
+ ;      test print-escape-pretty NIL
+ ;
+(WRITE-TO-STRING        nil)
+   "NIL"
+
+(WRITE-TO-STRING        '(a b nil c))
+   "(A B NIL C)"
+
+(WRITE-TO-STRING        '(a b (nil) c))
+   "(A B (NIL) C)"
+
+(WRITE-TO-STRING        '(a b (nil c) d))
+   "(A B (NIL C) D)"
+
+(WRITE-TO-STRING '#(a b nil c (a b nil c) (nil)))
+"#(A B NIL C (A B NIL C) (NIL))"
+
+(setq *print-pretty* t)
+T
+
+(WRITE-TO-STRING        nil)
+   "NIL"
+
+(WRITE-TO-STRING        '(a b nil c))
+   "(A B NIL C)"
+
+(WRITE-TO-STRING        '(a b (nil) c))
+#+XCL
+"(A B 
+   (NIL) 
+   C)"
+#+CLISP "(A B (NIL) C)"
+
+(WRITE-TO-STRING        '(a b (nil c) d))
+#+XCL
+"(A B 
+   (NIL C) 
+   D)"
+#+CLISP "(A B (NIL C) D)"
+
+(WRITE-TO-STRING '#(a b nil c (a b nil c) (nil)))
+"#(A B NIL C (A B NIL C) (NIL))"
+;;"#(A B NIL C 
+;;(A B NIL C) 
+;;(NIL))"
+
+;-------------------------------------------------------------------------------
+;(progn (print "etwa mitte") t) T
+;-------------------------------------------------------------------------------
+
+(setq *print-pretty* nil)
+NIL
+
+ ;
+ ;      test read-suppress
+ ;
+(let ((*read-suppress* t)) (read-from-string "#o33"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#x1b"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#b11011"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#.(* 3 3 3)"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "(a . b)"))
+#+XCL NIL #-XCL (NIL NIL NIL)
+
+(let ((*read-suppress* t)) (read-from-string "(a.b)"))
+#+XCL (A.B) #-XCL (NIL)
+
+(let ((*read-suppress* t)) (read-from-string "(a. b)"))
+#+XCL (A. B) #-XCL (NIL NIL)
+                
+(let ((*read-suppress* t)) (read-from-string "(a \. b c)"))
+#+XCL (A \. B C) #-XCL (NIL NIL NIL NIL)
+
+(let ((*read-suppress* t)) (read-from-string "(a |.| b c)"))
+#+XCL (A \. B C) #-XCL (NIL NIL NIL NIL)
+
+(let ((*read-suppress* t)) (read-from-string "(a \... b c)"))
+#+XCL (A \... B C) #-XCL (NIL NIL NIL NIL)
+
+(let ((*read-suppress* t)) (read-from-string "(a |...| b c)"))
+#+XCL (A \... B C) #-XCL (NIL NIL NIL NIL)
+
+(let ((*read-suppress* t)) (read-from-string "(a b . c)"))
+#+XCL NIL #-XCL (NIL NIL NIL NIL)
+
+(let ((*read-suppress* t)) (read-from-string ".ab"))
+#+XCL .AB #-XCL NIL
+
+(let ((*read-suppress* t)) (read-from-string "(. b)"))
+#+XCL NIL #-XCL (NIL NIL)
+
+(let ((*read-suppress* t)) (read-from-string "(a .. b)"))
+#+XCL (A NIL B) #-XCL (NIL NIL NIL)
+        
+(let ((*read-suppress* t)) (read-from-string "(a . . 'b   )"))
+#+XCL NIL #-XCL (NIL NIL NIL 'NIL)
+
+(let ((*read-suppress* t)) (read-from-string "(a b c ...)"))
+#+XCL (A B C NIL) #-XCL (NIL NIL NIL NIL)
+
+(let ((*read-suppress* t)) (read-from-string "#\\control-meta-a"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\control-meta-\\a"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\linefeed"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\newline"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\space"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\rubout"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\page"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\tab"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\backspace"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\return"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\control-space"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\c-m-return"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\control-meta-tab"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\h-s-m-c-rubout"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\control-%"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\control-\""))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "#\\meta->"))
+NIL
+
+(let ((*read-suppress* t)) (read-from-string "xx:xx")) nil
+
+(let ((*read-suppress* t)) (read-from-string "xx::xx")) nil
+
+(setq *print-level* 10)
+10
+
+        (let ((*read-suppress* t)) (read-from-string "(#1=(a b #1#))"))
+   #+XCL ((A B NIL)) #-XCL ((NIL NIL NIL))
+        (let ((*read-suppress* t)) (read-from-string "(#1=(#1#))"))
+   ((NIL))
+
+        (let ((*read-suppress* t)) (read-from-string "(#1=(a b #1#) (c d #1#))"))
+   #+XCL ((A B NIL) (C D NIL)) #-XCL ((NIL NIL NIL) (NIL NIL NIL))
+
+(setq *print-level* nil)
+NIL
+
+(setq *print-length* 11)
+11
+
+        (let ((*read-suppress* t)) (read-from-string "#1=(a b . #1#)"))
+   #+XCL NIL #-XCL (NIL NIL NIL NIL)
+
+(setq *print-length* nil)
+NIL
+
+
+        (let ((*read-suppress* t)) (read-from-string "#0a7"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#1a(1 2 3 4 5 6 7 8)"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#2a((1 2 3)(3 2 1))"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#3a(((1 2 3 ) (4 5 6))
+                                                          ((1 2 3 ) (4 5 6)))"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#a7"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#2a((1 2)(3 4)(5 6))"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#3a(((1 2)(3 4)(5 6))
+                                                          ((7 8)(9 10)(11 12)))"))
+   NIL
+
+        (let ((*read-suppress* t)) (read-from-string "#0*111"))
+   NIL
+   
+        (let ((*read-suppress* t)) (read-from-string "#0(1 1 1 )"))
+   #+XCL ERROR #-XCL NIL
+
+        (let ((*read-suppress* t)) (read-from-string "#0r111"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#1r111"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#2r111"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#36r111"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#37r111"))
+   NIL
+
+;        (list 1 2 #\a)
+;   (1 2 NIL)
+
+        (let ((*read-suppress* t)) (read-from-string "#2(a b c)"))
+   #+XCL ERROR #-XCL NIL
+        (let ((*read-suppress* t)) (read-from-string "#2*1010"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#1#"))
+   NIL
+
+;;        #2a((1 2 3)(1 2)
+;;        #2a(1 2 3}
+;;   NIL
+
+        (let ((*read-suppress* t)) (read-from-string "#(1 2 3 .               )"))
+   #+XCL ERROR #-XCL NIL
+
+        (let ((*read-suppress* t)) (read-from-string "(a .)"))
+   #+XCL NIL #-XCL (NIL NIL)
+        (let ((*read-suppress* t)) (read-from-string "(. a)"))
+   #+XCL NIL #-XCL (NIL NIL)
+
+        (let ((*read-suppress* t)) (read-from-string "#37R"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#10rabc"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#10ra/b"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#\\nocontrol-"))
+   NIL
+        (let ((*read-suppress* t)) (read-from-string "#\\control-"))
+   NIL
+
+
+;&----- Tread3.tst -------------------------------------------------------------
+
+;******** Readfehler ***********************************************************
+(read-from-string "#\\break")
+ERROR
+
+(read-from-string "#\\home-up")
+ERROR
+
+(read-from-string "#\\escape")
+#+XCL ERROR #+CLISP #\Escape
+
+(#+xx 1 #+xx 2) nil
+(#+xx xx:xx)    nil
+
+;;;; typsystem notwendig
+(read-from-string "#c(pi 0)")
+ERROR
+
+(read-from-string "#c(0 pi)")
+ERROR
+
+#|
+;******** test fehlerbehandlung ***********************************************
+(setq lisptest::*error-message* t)
+T
+
+
+;;;;    test fehlerbehandlung in COMREAD                                   ;;;;
+;;;;    --------------------------------                                   ;;;;
+;;;     test fehlerbehandlung in Shift                                      ;;;
+;;;     ------------------------------                                      ;;;
+;;      1.zeichen                                                            ;;
+;;      ---------                                                            ;;
+;       EOF
+
+(read-from-string "")
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+;;"(LT-ERROR LISP::E-READ-TOKEN 4 (\"\"))"
+
+;       constituent/illegal2                            ; nicht moeglich
+;sinnlos !      (setq illegal2 (code-char 8))
+;   #\BACKSPACE
+        ; 127 ?         ; illegal2 wird nicht
+;       (set-syntax-from-char #\A illegal2)
+;   T
+                ; kopiert !
+;       'Abc
+
+;   ABC
+;       : nach #:
+        #::abc
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"#::ABC\"))"
+;       unbekannte typ oder illegal1
+(setq illegal1 (code-char 7))
+#\
+
+        (set-syntax-from-char #\B illegal1)
+   T
+
+        B
+   "(LT-ERROR LISP::E-READ-TOKEN 5 (\"\" 66))"
+;cd
+
+;   "(LT-ERROR LISP::UNBOUND-VARIABLE 1 CD)"
+;;      token 1                                                              ;;
+;;      -------                                                              ;;
+;       EOF
+        (read-from-string "ab")
+   ab
+
+;       constituent/illegal2
+;       'abAcd  
+;   ABACD
+                                        ; s.o.
+;       unzulaessige :
+        ::abc
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"<:>:ABC\"))"
+        #::abc
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"#::ABC\"))"
+        :::abc
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"<:>::ABC\"))"
+        #:::abc
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"#:::ABC\"))"
+        :a:bc
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A<:>:BC\"))"
+        #:a:bc
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A<#:>:BC\"))"
+        :a::bc
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A<:>::BC\"))"
+        #:a::bc
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A<#:>::BC\"))"
+        :abc:
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"ABC<:>:\"))"
+        #:abc:
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"ABC<#:>:\"))"
+        ab:
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"AB:
+\"))"
+        ab:cd:
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"AB:CD:\"))"
+        ab::
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"AB::
+\"))"
+        a:b:c
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A:B:C\"))"
+        a:b::c
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A:B::C\"))"
+        a::b:c
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A::B:C\"))"
+        a::b::c
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A::B::C\"))"
+
+;       EOF nach \
+(read-from-string "ab\\")
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"AB\\\\\"))"
+;;"(LT-ERROR LISP::E-READ-TOKEN 4 (\"AB\\\\\"))"
+
+;       unbekannte typ oder illegal1
+        abB
+   "(LT-ERROR LISP::E-READ-TOKEN 5 (\"AB\" 66))"
+        ;cd
+;;      token 2                                                              ;;
+;;      -------                                                              ;;
+;       EOF
+(read-from-string "xx::a|bc")
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"Abc<|>\"))"
+;;"(LT-ERROR LISP::E-READ-TOKEN 4 (\"Abc<|>\"))"
+        
+(read-from-string "xx::a\\")
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"A\\\\\"))"
+;;"(LT-ERROR LISP::E-READ-TOKEN 4 (\"A\\\\\"))"
+
+(read-from-string "xx:a\\")
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"A\\\\\"))"
+;;"(LT-ERROR LISP::E-READ-TOKEN 4 (\"A\\\\\"))"
+
+(read-from-string "ab|cd")
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"ABcd<|>\"))"
+;;"(LT-ERROR LISP::E-READ-TOKEN 4 (\"ABcd<|>\"))"
+
+(read-from-string "ab|")
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"AB<|>\"))"
+;;"(LT-ERROR LISP::E-READ-TOKEN 4 (\"AB<|>\"))"
+
+;       EOF nach \
+(read-from-string "ab|c\\")
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"ABc<|>\\\\\"))"
+;;"(LT-ERROR LISP::E-READ-TOKEN 4 (\"ABc<|>\\\\\"))"
+
+;       unbekannter typ oder illegal1
+(read-from-string "ab|cdB")
+"(LT-ERROR LISP::E-READ-TOKEN 5 (\"ABcd<|>\" 66))"
+        ;ef
+;;      ende                                                                 ;;
+;;      ----                                                                 ;;
+;       : leer
+        (read-from-string ":")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\":*\"))"
+        
+        (read-from-string ": ")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\": \"))"
+        
+        (read-from-string "#:")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"#:\"))"
+
+        (read-from-string "#: ")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"#: \"))"
+        
+        (read-from-string "a:")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A:*\"))"
+        
+        (read-from-string "a: ")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A: \"))"
+        
+        (read-from-string "a::")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A::*\"))"
+        
+        (read-from-string "a:: ")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"A:: \"))"
+        
+;       punkttoken
+        ....
+
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"....\"))"
+;;;     fehlerbehandlung in scanobj                                         ;;;
+;;;     ---------------------------                                         ;;;
+;;      listen                                                               ;;
+;;      ------                                                               ;;
+;       EOF 
+        (read-from-string "(a b" )
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((A B)) LISP::E-READ-TOKEN 4 
+(\"\"))"
+
+        (read-from-string "(a b " )
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((A B)) LISP::E-READ-TOKEN 4 
+(\"\"))"
+
+        (read-from-string "(a b" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((A B)))"
+
+        (read-from-string "(a b " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((A B)))"
+
+;       EOF nach .
+        (read-from-string "(a b . ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((A B #\\.)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+        (read-from-string "(a b ." nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((A B)))"
+
+        (read-from-string "(a b . "  nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((A B)))"
+
+        (read-from-string "(a b .")
+;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((A B #\\.)))"
+    "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((A B)))"
+
+        (read-from-string "(a b . c")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((A B C)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+;       2. .obj
+        (a b . . c d)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((A B #\\. #\\. C D)))"
+
+;       nur 1 obj fuer gep. paar
+        (a .)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((A #\\.)))"
+
+        (. a)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((A)))"
+
+;       keine klammer nach 2.obj
+        (a . b c d)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((A B C D)))"
+
+        (a . )
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((A #\\.)))"
+
+;-------------------------------------------------------------------------------
+;(progn (print "etwa drei viertel") t) T
+;-------------------------------------------------------------------------------
+
+;;      macros                                                               ;;
+;;      ------                                                               ;;
+;       EOF nach backquotekomma
+        (read-from-string ",")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((UNQUOTE)))"
+
+        (read-from-string ", ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((UNQUOTE)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+        (read-from-string "," nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((UNQUOTE)))"
+
+        (read-from-string ", " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((UNQUOTE)))"
+
+;       . nach backquotekomma
+        (read-from-string ",.")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((LISP::UNQUOTE-NSPLICING)) 
+
+LISP::E-READ-TOKEN 4 (\"\"))"
+
+        (read-from-string ",. ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((LISP::UNQUOTE-NSPLICING)) 
+
+LISP::E-READ-TOKEN 4 (\"\"))"
+
+        (read-from-string ",." nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((LISP::UNQUOTE-NSPLICING)))"
+
+        (read-from-string ",. " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((LISP::UNQUOTE-NSPLICING)))"
+
+;       ) nach backquotekomma
+        (read-from-string ",)")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((UNQUOTE)))"
+
+        (read-from-string ",) ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((UNQUOTE)))"
+
+        (read-from-string ",)" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((UNQUOTE)))"
+
+        (read-from-string ",) " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((UNQUOTE)))"
+
+;       } nach backquotekomma
+;;        (read-from-string ",}")
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((UNQUOTE)))"
+
+;;        (read-from-string ",} ")
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((UNQUOTE)))"
+
+;;        (read-from-string ",}" nil 'dummy)
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((UNQUOTE)))"
+
+;;        (read-from-string ",} " nil 'dummy)
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((UNQUOTE)))"
+
+;       EOF nach quote
+        (read-from-string "'")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((QUOTE)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+        (read-from-string "' ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((QUOTE)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+        (read-from-string "'" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 (NIL))"
+
+        (read-from-string "' " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 (NIL))"
+
+;       . nach quote
+        (read-from-string "'.")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((QUOTE)))"
+
+        (read-from-string "'. ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+        (read-from-string "'." nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((QUOTE)))"
+
+        (read-from-string "'. " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+;       ) nach quote
+        (read-from-string "')")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+        (read-from-string "') ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+        (read-from-string "')" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+        (read-from-string "') " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+;       } nach quote
+;;        (read-from-string "'}")
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+;;        (read-from-string "'} ")
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+;;        (read-from-string "'}" nil 'dummy)
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+;;        (read-from-string "'} " nil 'dummy)
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUOTE)))"
+
+
+;&----- Tread4.tst -------------------------------------------------------------
+;(setq lisptest::*error-message* t)
+;   T
+;(setq illegal1 (code-char 7))
+;   #\
+;(set-syntax-from-char #\B illegal1)
+;   T
+;       EOF nach backquote
+        (read-from-string "`")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((QUASIQUOTE)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+        (read-from-string "` ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((QUASIQUOTE)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+        (read-from-string "`" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 (NIL))"
+
+        (read-from-string "` " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 (NIL))"
+
+;       . nach backquote
+        (read-from-string "`.")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((QUASIQUOTE)))"
+
+        (read-from-string "`. ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+        (read-from-string "`." nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 0 ((QUASIQUOTE)))"
+
+        (read-from-string "`. " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+;       ) nach backquote
+        (read-from-string "`)")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+        (read-from-string "`) ")
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+        (read-from-string "`)" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+        (read-from-string "`) " nil 'dummy)
+   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+;       } nach backquote
+;;        (read-from-string "`}")
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+;;        (read-from-string "`} ")
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+;;        (read-from-string "`}" nil 'dummy)
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+;;        (read-from-string "`} " nil 'dummy)
+;;   "(LT-ERROR LISP::E-READ-STRUCTURE 1 ((QUASIQUOTE)))"
+
+;       EOF im string
+        (read-from-string "\"a")
+   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"a<\\\">\"))"
+
+        (read-from-string "\"")
+   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"<\\\">\"))"
+
+        (read-from-string "\"a" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"a<\\\">\"))"
+
+        (read-from-string "\"" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"<\\\">\"))"
+
+;       EOF nach \ im string
+        (read-from-string "\"a\\")
+   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"a<\\\">\\\\\"))"
+
+        (read-from-string "\"\\")
+   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"<\\\">\\\\\"))"
+
+        (read-from-string "\"a\\" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"a<\\\">\\\\\"))"
+
+        (read-from-string "\"\\" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"<\\\">\\\\\"))"
+
+;;      disp-macros                                                          ;;
+;;      -----------                                                          ;;
+;       EOF in infixarg
+        (read-from-string "#12")
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 12 #\\SPACE NIL))"
+
+        (read-from-string "#")
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\SPACE NIL))"
+
+        (read-from-string "#12" nil 'dummy)
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 12 #\\SPACE NIL))"
+
+        (read-from-string "#" nil 'dummy)
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\SPACE NIL))"
+
+;       EOF oder illegale zeichenfolge in char
+        (read-from-string "#\\")
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\\\ \"\"))"
+
+        (read-from-string "#\\" nil 'dummy)
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\\\ \"\"))"
+
+        (read-from-string "#\\con")
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 256 #\\\\ \"\"))"
+
+        (read-from-string "#\\con" nil 'dummy)
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 256 #\\\\ \"\"))"
+
+        (read-from-string "#\\m-com-a")
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 512 #\\\\ \"COM-a\"))"
+
+
+;       keine Zahl in #R
+        #10R1a2
+
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 10 #\\R \"1A2\"))"
+;       keine zahlensyntax in #R
+        #10Ra12
+
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 10 #\\R \"A12\"))"
+;       keine Readbase in #R
+        #40R123
+
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 40 #\\R \"123\"))"
+;       EOF oder nichtconstituent nach #:
+        (read-from-string "#:")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"#:\"))"
+
+        (read-from-string "#:" nil 'dummy)
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"#:\"))"
+
+        (read-from-string "#:B")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"#:B\"))"
+
+;       kein Atom nach #:
+        (read-from-string "#:( a b )")
+   "(LT-ERROR LISP::E-READ-TOKEN 3 (\"#:(\"))"
+
+#:123   
+"(LT-ERROR UNBOUND-VARIABLE 1 #:\\123)"
+
+;       kein subchar
+#0111010
+"(LT-ERROR E-READ-MACRO 2 (#\\# 111010 #\\NEWLINE NIL))"
+
+;;;;    test fehlerbehandlung in COMREAD1                                  ;;;;
+;;;;    ---------------------------------                                  ;;;;
+;;      kommentar                                                            ;;
+;;      ---------                                                            ;;
+;       EOF
+        (read-from-string "#|")  ;; |#
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\| NIL))"
+
+        (read-from-string "#|abc")  ;; |#
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\| NIL))"
+
+        (read-from-string "#|abc|")  ;; |#
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\| NIL))"
+
+        (read-from-string "#|abc#")  ;; |#
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\| NIL))"
+
+        (read-from-string "#|abc#|de#xyz")  ;; |# |#
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\| NIL))"
+
+;;      vektor                                                              ;;
+;;      ------                                                              ;;
+;       EOF
+        (read-from-string "#(a b c")
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\( (A B C)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+;       gelesene anzahl zu gross
+        #3(a b c d e f)
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 3 #\\( (A B C D E F)))"
+
+;       falscher abschluss fuer vector
+        (read-from-string "#(a b c . d e f)")
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\( (A B C #\\. D E F)))"
+
+;;      Zeichen                                                             ;;
+;;      -------                                                             ;;
+;       EOF als 1.zeichen
+        (read-from-string "#\\")
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\\\ \"\"))"
+
+        (read-from-string "#\\a")
+   #\a
+
+        #\a\abc-de
+
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\\\ \"a\\\\abc-de
+\"))"
+        (read-from-string "#\\a|abc-de")
+
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\\\ \"a|abc-de
+\"))"
+        #\a#abc-de
+
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\\\ \"a#abc-de
+\"))"
+        #\con\abc-de
+
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\\\ \"CON\\\\abc-de
+\"))"
+        (read-from-string "#\\\\")
+   #\\
+
+        (read-from-string "#\\con-\\")
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 256 #\\\\ \"\\\\\"))"
+
+        (read-from-string "#\\con|abc-de")
+
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\\\ \"CON|abc-de
+\"))"
+        #\con#abc-de
+
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\\\ \"CON#abc-de
+\"))"
+        #\con-abc
+
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 256 #\\\\ \"ABC\"))"
+
+;;;     test fehlerbehandlung in COMREAD2                                 ;;;
+;;;     ---------------------------------                                 ;;;
+;;      Searcalm                                                           ;;
+;;      --------                                                           ;;
+;       keine funktionsliste
+(make-dispatch-macro-character #\X t)
+T
+
+Xa
+"(LT-ERROR E-READ-MACRO 2 (#\\X NIL #\\a NIL))"
+
+;       keine dispatchmacroliste am zeichen
+(set-macro-character #\Y #'cdr t)
+T
+
+(make-dispatch-macro-character #\Y t)
+T
+
+Ya
+"(LT-ERROR E-READ-MACRO 2 (#\\Y NIL #\\a NIL))"
+
+;       subchar nicht in liste
+(set-dispatch-macro-character #\Y #\. #'car)
+T
+
+Y,
+"(LT-ERROR E-READ-MACRO 2 (#\\Y NIL #\\, NIL))"
+
+(progn (SETQ *READTAbLE* (COPY-READTAbLE nil)) t) 
+T
+
+;;      Makearray                                                         ;;
+;;      ---------                                                         ;;
+;       dimension = 0 und EOF
+        (read-from-string "#0a")
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\a NIL) LISP::E-READ-TOKEN 4 
+(\"\"))"
+
+        (read-from-string "#0a" nil 'dummy)
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\a NIL))"
+
+;       dimension = 0 und ERROR
+        #0a.
+
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\a #\\.))"
+        (read-from-string "#0a)")
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\a #\\)))"
+
+;;        (read-from-string "#0a}")
+;;   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\a #\\}))"
+
+;       klammereinlesen EOF
+        (read-from-string "#3a(((1)(2))(" )
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 3 #\\a (1 2)))"
+
+        (read-from-string "#3a(((1)(2))((3" )
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 3 #\\a (1 2 3)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+;       klammereinlesen falsche termacro 
+        (multiple-value-list (read-from-string "#3a(((1)(2))(;xyz"))
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 3 #\\a (1 2 #\\;)))"
+
+        (multiple-value-list (read-from-string "#3a(((1)(2))((3;xyz"))
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 3 #\\a (1 2 3)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+;       klammereinlesen falsche zeichen
+(read-from-string "#3a(((1)(2))(axyz")
+"(LT-ERROR E-READ-MACRO 1 (#\\# 3 #\\a (1 2 #\\a)))"
+
+
+;&----- Tread5.tst -------------------------------------------------------------
+(setq lisptest::*error-message* t)
+T
+
+(read-from-string "#3a(((1)(2))((3 axyz")
+"(LT-ERROR E-READ-MACRO 0 (#\\# 3 #\\a (1 2 3 AXYZ)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+;       EOF in obj
+        (read-from-string "#3a(((1)(2))((" )
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 3 #\\a (1 2)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+        (read-from-string "#3a(((1)(2))((" nil 'dummy)
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 3 #\\a (1 2)))"
+
+;       falsche zeichen fuer klammer zu
+        #3a(((1)(2))((3 )(4))((5)(6)))
+   #3A(((1)(2))((3)(4))((5)(6)))
+
+;;#3a(((1)(2))((3}
+;;"(LT-ERROR E-READ-MACRO 1 (#\\# 3 #\\a (1 2 3)))"
+
+xyz
+"(LT-ERROR UNBOUND-VARIABLE 1 XYZ)"
+
+(read-from-string "#3a(((1)(2))((3(xyz")
+"(LT-ERROR LISP::E-READ-STRUCTURE 0 ((XYZ)) LISP::E-READ-TOKEN 4 (\"\"))"
+
+        (read-from-string "#3a(((1)(2))((3" )
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 3 #\\a (1 2 3)) LISP::E-READ-TOKEN 
+4 (\"\"))"
+
+;       falsche klammerung
+        #3a(((1) (2))((3 4)
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 3 #\\a (1 2 3 4)))"
+
+;;      Mbitvector                                                           ;;
+;;      ----------                                                           ;;
+;       falsche zeichen
+        #*11001a11
+
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\* (49 49 48 48 49 97 49 49)))"
+;       zu viele elemente
+        #5*111001101
+
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 5 #\\* (49 49 49 48 48 49 49 48 
+49)))"
+;;      Makemacro                                                            ;;
+;;      ---------                                                            ;;
+;       complex-obj nicht 2elementige liste
+
+;;;declare ?    
+#cab
+"(LT-ERROR E-READ-MACRO 1 (#\\# NIL #\\c AB))"
+;;;declare ?
+#c(1)
+"(LT-ERROR E-READ-MACRO 1 (#\\# NIL #\\c (1)))"
+
+#c(1 2 3)
+"(LT-ERROR E-READ-MACRO 1 (#\\# NIL #\\c (1 2 3)))"
+
+(read-from-string "#c")
+;alt   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\c NIL) LISP::E-READ-TOKEN 
+4 (\"\"))"
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+
+;       EOF nach #'
+        (read-from-string "#'" )
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\' NIL) LISP::E-READ-TOKEN 4 
+(\"\"))"
+
+        (read-from-string "#'" nil 'dummy)
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\' NIL))"
+
+;       ERROR nach #'
+        #')
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\' #\\)))"
+
+;;        #'}
+;;   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\' #\\}))"
+
+        #'.
+
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\' #\\.))"
+;       EOF nach #+
+        (read-from-string "#+" )
+;alt   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"\"))"
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+
+        (read-from-string "#+" nil 'dummy)
+;falsch   DUMMY
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+
+
+;       ERROR nach #+
+        (READ-FROM-STRING "#+)")
+   "(LT-ERROR E-READ-MACRO 3 (#\\)))"
+
+;;        (READ-FROM-STRING "#+}")
+;;   "(LT-ERROR E-READ-MACRO 3 (#\\}))"
+
+        (READ-FROM-STRING "#+.")
+   "(LT-ERROR E-READ-MACRO 3 (#\\.))"
+
+;       kein symbol oder liste nach #+
+        (READ-FROM-STRING "#+123")
+;alt   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"\"))"
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+
+;       EOF nach #-
+        (read-from-string "#-" )
+;alt   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"\"))"
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+
+        (read-from-string "#-" nil 'dummy)
+;fatsch   DUMMY
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+
+;       ERROR nach #-
+        (read-from-string "#-)")
+   "(LT-ERROR E-READ-MACRO 3 (#\\)))"
+
+;;        (read-from-string "#-}")
+;;   "(LT-ERROR E-READ-MACRO 3 (#\\}))"
+
+        (read-from-string "#-.")
+   "(LT-ERROR E-READ-MACRO 3 (#\\.))"
+
+;       kein symbol oder liste nach #-
+        (read-from-string "#-123")
+;alt   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"\"))"
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+
+;       EOF nach #.
+        (read-from-string "#." )
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\. NIL) LISP::E-READ-TOKEN 4 
+(\"\"))"
+
+        (read-from-string "#." nil 'dummy)
+   "(LT-ERROR E-READ-MACRO 0 (#\\# 0 #\\. NIL))"
+
+;       ERROR nach #.
+        #.)
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\. #\\)))"
+
+;;        #.}
+;;   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\. #\\}))"
+
+        #..
+
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 0 #\\. #\\.))"
+;       nach #1a keine (
+        #1ax
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 1 #\\a #\\x))"
+
+        (read-from-string "#1a")
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 1 #\\a #\\*))"       
+;       EOF nach #n=
+        (read-from-string "#1=" )
+;alt   "(LT-ERROR LISP::E-READ-TOKEN 4 (\"\"))"
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+
+        (read-from-string "#1=" nil 'dummy)
+;falsch   DUMMY
+"(LT-ERROR E-READ-MACRO 3 (NIL) LISP::E-READ-TOKEN 4 (\"\"))"
+
+;       ERROR nach #1=
+        (READ-FROM-STRING "#1=)")
+   "(LT-ERROR E-READ-MACRO 3 (#\\)))"
+
+;;        (READ-FROM-STRING "#1=}")
+;;   "(LT-ERROR E-READ-MACRO 3 (#\\}))"
+
+        (READ-FROM-STRING "#1=.")
+   "(LT-ERROR E-READ-MACRO 3 (#\\.))"
+
+;       label nicht gefunden
+        (READ-FROM-STRING "#11111#")
+   "(LT-ERROR E-READ-MACRO 1 (#\\# 11111 #\\# NIL))"
+
+(progn
+(makunbound 'illegal1)
+(setq lisptest::*error-message* nil)
+(setq *print-circle* t) 
+T)
+T
+|#
+
diff --git a/src/tests/type.tst b/src/tests/type.tst
new file mode 100644
index 000000000..5d635bf75
--- /dev/null
+++ b/src/tests/type.tst
@@ -0,0 +1,360 @@
+
+(TYPEP (QUOTE A) (QUOTE SYMBOL))
+T
+
+(TYPEP (QUOTE NIL) (QUOTE SYMBOL))
+T
+
+(TYPEP (QUOTE (NIL)) (QUOTE SYMBOL))
+NIL
+
+(TYPEP 3 (QUOTE INTEGER))
+T
+
+(TYPEP 3 (QUOTE (INTEGER 0 4)))
+T
+
+(TYPEP 3 (QUOTE (INTEGER 0 3)))
+T
+
+(TYPEP 3 (QUOTE (INTEGER 0 2)))
+NIL
+
+(TYPEP 3 (QUOTE (FLOAT 0 2)))
+NIL
+
+(TYPEP 3 (QUOTE (FLOAT 0 2)))
+NIL
+
+(TYPEP 3 (QUOTE (FLOAT 0 4)))
+NIL
+
+(TYPEP 3.2 (QUOTE (FLOAT 0.0 4.0)))
+T
+
+(TYPEP 3.2 (QUOTE (FLOAT 0.0 3.2)))
+T
+
+(TYPEP 3.2 (QUOTE (FLOAT 0.0 (3.2))))
+NIL
+
+(TYPEP 3.2 (QUOTE (SHORT-FLOAT 0.0 3.2)))
+#+(or ALLEGRO ECLS) T #-(or ALLEGRO ECLS) NIL
+
+(TYPEP 3.2 (QUOTE (SINGLE-FLOAT 0.0 3.2)))
+T
+
+(TYPEP 3.2 (QUOTE (DOUBLE-FLOAT 0.0 3.2)))
+NIL
+
+(TYPEP 3.2 (QUOTE (DOUBLE-FLOAT 0.0 3.2)))
+NIL
+
+(TYPEP 3.2 (QUOTE (DOUBLE-FLOAT 0.0 3.2)))
+NIL
+
+(TYPEP 3.2S0 (QUOTE (DOUBLE-FLOAT 0.0S0 3.2S0)))
+NIL
+
+(TYPEP 3.2 (QUOTE (DOUBLE-FLOAT 0.0 3.2)))
+NIL
+
+(TYPEP 3.2 (QUOTE (FLOAT 0.0 3.2)))
+T
+
+(TYPEP 3.2 (QUOTE (FLOAT 0.0 3.2)))
+T
+
+(TYPEP 3.2S0 (QUOTE (FLOAT 0.0S0 3.2S0)))
+T
+
+(TYPEP 2.0S0 (QUOTE (SHORT-FLOAT 0.0S0 3.0S0)))
+T
+
+(TYPEP 2.0S0 (QUOTE (SINGLE-FLOAT 0.0 3.0)))
+#+(or ECLS ALLEGRO) T #-(or ALLEGRO ECLS) NIL
+
+(TYPEP 2.0 (QUOTE (SINGLE-FLOAT 0.0 3.0)))
+T
+
+(TYPEP 2.0D0 (QUOTE (DOUBLE-FLOAT 0.0D0 3.0D0)))
+T
+
+(TYPEP 3.0D0 (QUOTE (DOUBLE-FLOAT 0.0D0 3.0D0)))
+T
+
+(TYPEP 3.0D0 (QUOTE (DOUBLE-FLOAT 0.0D0 (3.0D0))))
+NIL
+
+(TYPEP 4 (QUOTE (MOD 4)))
+NIL
+
+(TYPEP 4 (QUOTE (MOD 5)))
+T
+
+(TYPEP 4 (QUOTE (RATIONAL 2 5)))
+T
+
+(TYPEP 4 (QUOTE (RATIONAL 2 7/2)))
+NIL
+
+(TYPEP 4 (QUOTE (RATIONAL 2 9/2)))
+T
+
+(TYPEP 4 (QUOTE (RATIONAL 2 4)))
+T
+
+(TYPEP 4/3 (QUOTE (RATIONAL 2 4)))
+NIL
+
+(TYPEP 2 (QUOTE (RATIONAL 2 4)))
+T
+
+(TYPEP "abcd" (QUOTE STRING))
+T
+
+(TYPEP "abcd" (QUOTE (STRING 4)))
+T
+
+(TYPEP "abcd" (QUOTE (STRING 43)))
+NIL
+
+(TYPEP '#(2 3) (QUOTE (COMPLEX INTEGER)))
+NIL
+
+(TYPEP '#(2 3) (QUOTE COMPLEX))
+NIL
+
+(TYPEP #C(2 3) (QUOTE COMPLEX))
+T
+
+(TYPEP #C(2 3) (QUOTE (COMPLEX INTEGER)))
+T
+
+(TYPEP #C(2 3) (QUOTE (COMPLEX FLOAT)))
+NIL
+
+(TYPEP #C(2 3) (QUOTE (COMPLEX SYMBOL)))
+NIL
+
+(TYPEP '#(A B C D) (QUOTE VECTOR))
+T
+
+(TYPEP '#(A B C D) (QUOTE (VECTOR * 4)))
+T
+
+#| ; hängt von (upgraded-array-element-type 'SYMBOL) ab!
+(TYPEP '#(A B C D) (QUOTE (VECTOR SYMBOL 4)))
+NIL
+|#
+
+(TYPEP (QUOTE A) (QUOTE (SYMBOL CONS)))
+ERROR
+
+(TYPEP (QUOTE A) (QUOTE (OR CONS SYMBOL)))
+T
+
+(TYPEP (QUOTE A) (QUOTE (OR CONS NUMBER)))
+NIL
+
+(TYPEP (QUOTE A) (QUOTE (OR ATOM NUMBER)))
+T
+
+(TYPEP (QUOTE A) (QUOTE (AND ATOM NUMBER)))
+NIL
+
+(TYPEP (QUOTE 2) (QUOTE (AND ATOM NUMBER)))
+T
+
+(TYPEP (QUOTE 2) (QUOTE (MEMBER 1 2 3)))
+T
+
+(TYPEP (QUOTE 2) (QUOTE (MEMBER 1 3)))
+NIL
+
+(TYPEP (QUOTE 2) (QUOTE (NOT (MEMBER 1 3))))
+T
+
+(TYPEP (QUOTE 2) (QUOTE (NOT (MEMBER 1 2 3))))
+NIL
+
+(TYPEP 2 (QUOTE (AND NUMBER (NOT SYMBOL))))
+T
+
+(TYPEP 2 (QUOTE (AND STRING (NOT SYMBOL))))
+NIL
+
+(TYPEP 2 (QUOTE (OR STRING (NOT SYMBOL))))
+T
+
+(TYPEP (QUOTE CONS) (QUOTE FUNCTION))
+#-(or CLtL2 ANSI-CL CLISP) T #+(or CLtL2 ANSI-CL CLISP) NIL
+
+(TYPEP (QUOTE CONS) (QUOTE (SATISFIES FUNCTIONP)))
+#-(or CLtL2 ANSI-CL CLISP) T #+(or CLtL2 ANSI-CL CLISP) NIL
+
+(TYPEP (QUOTE CONS) (QUOTE (SATISFIES NOT)))
+NIL
+
+(TYPEP (QUOTE NIL) (QUOTE (SATISFIES NOT)))
+T
+
+(TYPEP (QUOTE NIL) NIL)
+NIL
+
+(TYPEP (QUOTE T) NIL)
+NIL
+
+(SUBTYPEP (QUOTE CONS) T)
+T
+
+(SUBTYPEP NIL (QUOTE CONS))
+T
+
+(SUBTYPEP (QUOTE CONS) (QUOTE LIST))
+T
+
+(SUBTYPEP (QUOTE CONS) (QUOTE (OR ATOM CONS)))
+T
+
+(SUBTYPEP (QUOTE CONS) (QUOTE (AND ATOM CONS)))
+NIL
+
+(SUBTYPEP (QUOTE CONS) (QUOTE (NOT ATOM)))
+#-(or CLISP AKCL ALLEGRO) T #+(or CLISP AKCL ALLEGRO) NIL
+
+(SUBTYPEP (QUOTE LIST) (QUOTE (NOT ATOM)))
+NIL
+
+(SUBTYPEP (QUOTE (INTEGER 1 5)) (QUOTE (INTEGER 0 7)))
+T
+
+(SUBTYPEP (QUOTE (INTEGER 1 5)) (QUOTE (INTEGER 0 (5))))
+NIL
+
+(SUBTYPEP (QUOTE (INTEGER 1 5)) (QUOTE (INTEGER 0 5)))
+T
+
+(SUBTYPEP (QUOTE (INTEGER 1 5)) (QUOTE (MOD 5)))
+NIL
+
+(SUBTYPEP (QUOTE (INTEGER 1 (5))) (QUOTE (MOD 5)))
+T
+
+(SUBTYPEP (QUOTE (OR (INTEGER 1 (5) FLOAT))) (QUOTE (OR FLOAT (MOD
+5))))
+#+(or XCL ECLS CLISP) T #+ALLEGRO ERROR #-(or XCL CLISP ECLS ALLEGRO) UNKNOWN
+
+(SUBTYPEP (QUOTE (OR (INTEGER 1 (5)) FLOAT)) (QUOTE (OR FLOAT (MOD
+5))))
+T
+
+(SUBTYPEP (QUOTE (AND NUMBER (FLOAT 1.0 (5.0)))) (QUOTE (OR FLOAT (MOD
+5))))
+T
+
+(SUBTYPEP (QUOTE (AND NUMBER (NOT (FLOAT 1.0 (5.0)))))
+(QUOTE (OR FLOAT (MOD 5))))
+NIL
+
+
+(SUBTYPEP (QUOTE (AND FLOAT (NOT (FLOAT 1.0 (5.0))))) (QUOTE (OR FLOAT
+(MOD 5))))
+T
+
+(SUBTYPEP (QUOTE (AND FLOAT (NOT (FLOAT 1.0 (5.0)))))
+(QUOTE (OR (FLOAT * 1.0) (FLOAT * 5.0))))
+NIL
+
+(SUBTYPEP (QUOTE (SATISFIES CONSP)) (QUOTE LIST))
+NIL
+
+(SUBTYPEP (QUOTE SIMPLE-STRING) (QUOTE ARRAY))
+T
+
+(DEFTYPE MOD1 (N) `(AND NUMBER (FLOAT 0.0 (,N))))
+MOD1
+
+(TYPEP 4.1 (QUOTE (MOD1 5.0)))
+T
+
+(TYPEP 4.1 (QUOTE (MOD1 4.1)))
+NIL
+
+(SUBTYPEP (QUOTE (FLOAT 2.3 6.7)) (QUOTE (MOD1 6.8)))
+T
+
+(SUBTYPEP (QUOTE (FLOAT 2.3 6.7)) (QUOTE (MOD1 6.7)))
+NIL
+
+(DEFUN BELIEBIGER-TEST (A) (MEMBER A (QUOTE (U I V X))))
+BELIEBIGER-TEST
+
+(NOT (NULL (TYPEP (QUOTE U) (QUOTE (SATISFIES BELIEBIGER-TEST)))))
+T
+
+(TYPEP (QUOTE A) (QUOTE (SATISFIES BELIEBIGER-TEST)))
+NIL
+
+(SUBTYPEP (QUOTE (MEMBER U I)) (QUOTE (SATISFIES BELIEBIGER-TEST)))
+T
+
+(SUBTYPEP (QUOTE (OR (MEMBER U I))) (QUOTE (SATISFIES BELIEBIGER-TEST)))
+T
+
+(SUBTYPEP (QUOTE (OR (MEMBER U I A))) (QUOTE (SATISFIES BELIEBIGER-TEST)))
+NIL
+
+(SUBTYPEP (QUOTE (SATISFIES BELIEBIGER-TEST)) (QUOTE (MEMBER U I V
+X Y)))
+NIL
+
+(DEFTYPE BELIEBIGER-TYP NIL (QUOTE (SATISFIES BELIEBIGER-TEST)))
+BELIEBIGER-TYP
+
+(NOT (NULL (TYPEP (QUOTE U) (QUOTE BELIEBIGER-TYP))))
+T
+
+(TYPEP (QUOTE A) (QUOTE BELIEBIGER-TYP))
+NIL
+
+(SUBTYPEP (QUOTE (MEMBER U I)) (QUOTE BELIEBIGER-TYP))
+T
+
+(SUBTYPEP (QUOTE BELIEBIGER-TYP) (QUOTE (MEMBER U I V X Y)))
+NIL
+(subtypep nil 'fixnum) t
+(subtypep 'short-float 'float ) t
+(subtypep 'single-float 'float ) t
+(subtypep 'double-float 'float ) t
+(subtypep 'long-float 'float ) t
+
+(subtypep 'null 'symbol) t
+(subtypep 'null 'list) t
+(subtypep 'cons 'list) t
+
+(subtypep 'standard-char 'string-char) t
+
+(subtypep 'string-char 'character) t
+
+(subtypep 'string 'vector) t
+
+(subtypep 'bit-vector 'vector) t
+(subtypep 'vector 'array) t
+
+(subtypep 'simple-array 'array) t
+
+(subtypep 'simple-vector 'simple-array) t
+(subtypep 'simple-vector 'vector) t
+(subtypep 'simple-string 'simple-array) t
+(subtypep 'simple-bit-vector 'simple-array) t
+
+(subtypep 'simple-string 'string) t
+(subtypep 'simple-string 'vector) t
+(subtypep 'simple-string 'simple-vector) nil
+(subtypep 'simple-bit-vector 'bit-vector) t
+(subtypep 'bit-vector 'vector) t
+(subtypep 'simple-bit-vector 'simple-vector) nil
+
+(subtypep 'unsigned-byte 'integer) t
+(subtypep 'signed-byte 'integer) t
diff --git a/src/tk/Demos/hanoi.lsp b/src/tk/Demos/hanoi.lsp
new file mode 100755
index 000000000..a82201934
--- /dev/null
+++ b/src/tk/Demos/hanoi.lsp
@@ -0,0 +1,271 @@
+;;
+;; Hanoi - Towers of Hanoi diversion
+;;
+;; This program is a rewriting in ECL/tk of a program found on the net.
+;; Original author is Damon A Permezel (probably fubar!dap@natinst.com)
+;; Re-writing is very direct and needs much more working
+;;
+;; Modified for ECL by G. Attardi (attardi@di.unipi.it)
+
+(in-package "TK")
+
+(defvar sys:*gc-verbose* NIL)
+
+(defvar hanoi-canvas	"")
+(defvar hanoi-running 	NIL)
+(defvar hanoi-stop	NIL)
+(defvar previousRings   0)
+(defvar max-rings 	20)
+(defvar num-rings	6)
+(defvar colours		'(DarkOliveGreen snow4 royalblue2 palegreen4
+			  rosybrown1 wheat4 tan2 brown2 tomato3 hotpink3))
+
+(defvar pole		(make-array 3))	     ; elts are <nRing . xPos>
+(defvar ring 		(make-array (+ max-rings 1))); elts are <pole width . obj>
+
+(defvar accel		0)
+(defvar base		32)
+(defvar fly-row 	32)
+(defvar width-incr	12)
+(defvar width-min	(* 8 width-incr))    
+(defvar ring-height 	26)
+(defvar ring-spacing	(/ (* 2 ring-height) 3))
+
+
+;;
+;; Setup the main window
+;;
+(defun SetupHanoi ()
+  ;; Create top level window
+
+  (toplevel ".h" "-class" "Queens")
+  (wm "title" ".h" "Towers of Hanoi")
+  (wm "iconname" ".h" "Towers of Hanoi")
+
+  ;;
+  ;; setup frame and main menu button
+  ;;
+  (label ".h.title" "-text" "Towers of Hanoi" "-bd" 4 "-fg" "RoyalBlue"
+	 "-relief" "ridge")
+  (frame ".h.f")
+  (button ".h.f.run"  "-text" "Run"  "-command"
+	  '(DoHanoi (parse-integer (funcall .h.nrframe.scale "get")) T))
+  (button ".h.f.stop" "-text" "Stop" "-command" '(setq hanoi-stop 1))
+  (button ".h.f.quit" "-text" "Quit" "-command" '(destroy .h))
+  (pack .h.f.run .h.f.stop .h.f.quit "-fill" "x" "-side" "left" "-expand" T)
+
+  ;;
+  ;; setup next frame, for #rings slider
+  ;;
+  (frame ".h.nrframe" "-bd" 2 "-relief" "raised")
+  (pack (label ".h.nrframe.label" "-text" "Number of Rings: " "-width" 16
+	       "-anchor" "e")
+	"-side" "left")
+  (pack (scale ".h.nrframe.scale" "-orient" "hor" "-from" 1 "-to" max-rings
+	       "-font" "fixed" "-command" "setq num-rings")
+	"-side" "right" "-expand" T "-fill" "x")
+  (funcall .h.nrframe.scale "set" num-rings)
+
+  ;;
+  ;; setup next frame, for speed slider
+  ;;
+  (frame ".h.speed-frame" "-bd" 2 "-relief" "raised")
+  (pack (label ".h.speed-frame.label" "-text" "Speed: " "-width" 15
+	       "-anchor" "e")
+	"-side" "left")
+  (pack (scale ".h.speed-frame.scale" "-orient" "hor" "-from" 1 "-to" 100
+	       "-font" "fixed" "-command" "setq tk::accel")
+	"-side" "right" "-expand" T "-fill" "x")
+  (funcall .h.speed-frame.scale "set" 100)
+
+  ;;
+  ;; setup frame for canvas to appear in
+  ;;
+  (frame ".h.canv-frame" "-bd" 4 "-relief" "groove")
+  (pack (canvas ".h.canv-frame.canvas" "-relief" "sunken"))
+  (setq hanoi-canvas .h.canv-frame.canvas)
+
+  ;; 
+  ;; Pack evrybody
+  ;;
+  (pack .h.title .h.nrframe .h.speed-frame .h.canv-frame .h.f
+	"-expand" T "-fill" "x")
+
+  ;;
+  ;; key bindings
+  ;;
+  (bind ".h" "<KeyPress-r>"       '(DoHanoi (parse-integer
+					    (funcall .h.nrframe.scale "get")) T))
+  (bind ".h" "<KeyPress-s>"       '(setq hanoi-stop T))
+  (bind ".h" "<KeyPress-q>"       '(destroy .h))
+  
+  ;; 
+  ;; Display tower
+  ;;
+  (DoHanoi num-rings NIL)
+)
+
+;;
+;; DoHanoi	
+;;
+;; Input:
+;;	n	# of rings
+;;
+;; setup the canvas for displaying the Hanoi simulation
+;; Call hanoi if run-it is true.
+;;
+(defun DoHanoi (n run-it)
+  (unless hanoi-running
+    (setq ring-width 	(+ width-min (* n width-incr)))
+    (setq wm-width	(+ (* 3 ring-width) (* 4 12)))
+    (setq wm-height	(+ (* ring-spacing n) fly-row (* 2 ring-height)))
+
+
+    (setq hanoi-stop 	 NIL)
+    (setq hanoi-running	 T)
+    (setq base 		 (- wm-height 32))
+
+    ;;
+    ;; cleanup from previous run
+    ;;
+    (do ((i 1 (+ i 1)))
+	((> i previousRings))
+      (funcall hanoi-canvas "delete" (cddr (svref ring i))))
+    
+    ;;
+    ;; configure the canvas appropriately
+    ;;
+    (funcall hanoi-canvas "configure" "-width" wm-width "-height" wm-height)
+    
+    ;;
+    ;; setup poles
+    ;;
+    (dotimes (i 3)
+      (setf (svref pole i)
+	    (cons 0 (+ (/ (* i wm-width) 3) (/ ring-width 2) 8))))
+    ;;
+    ;; setup rings
+    ;;
+    
+    (dotimes (i n)
+      (let* ((colour (nth (mod i 10) colours))
+	     (w      (- ring-width (* i 12)))
+	     (y	     (- base (* i ring-spacing)))
+	     (x      (- (cdr (svref pole 0)) (/ w 2)))
+	     (r      (- n i)))
+      
+	(setf (svref ring r)
+	      (cons 0
+		    (cons w
+			  (funcall hanoi-canvas "create" 
+				   "oval" x y (+ x w) (+ y ring-height)
+				   "-fill" colour 
+				   "-outline" colour
+				   "-width" 12))))))
+    
+    (setf (svref pole 0) (cons n (cdr (svref pole 0))))
+    (setq previousRings n)
+
+    (update)
+    (when run-it (Hanoi n 0 2 1))
+    (setq hanoi-running NIL)))
+;;
+;; Hanoi: the guts of the algorithm
+;;
+;; Input:
+;;	n	# of rings
+;;	from	pole to move from
+;;	to	pole to move to
+;;	work	pole to aid in performing work
+;;
+(defun Hanoi (n from to work)
+  (when (and (> n 0) (not hanoi-stop))
+    (Hanoi (- n 1) from work to)
+    (unless  hanoi-stop (MoveRing n to))
+    (Hanoi (- n 1) work to from)))
+
+;;
+;; MoveRing:	move a ring to a new pole
+;;
+;; Input:
+;;	n	ring number
+;;	to	destination pole
+;;
+(defun MoveRing (n to)
+  ;;
+  ;; ring(n,obj) can be queried as to its current position.
+  ;; Thus, we don't need to know which pole the ring is moving from.
+  ;;
+  (let* ((inc	  0)
+	 (tox     0)
+	 (toy  	  0)
+	 (r  	  (cddr (svref ring n)))
+	 (coords  (mapcar #'parse-integer (funcall hanoi-canvas "coords" r)))
+	 (x0 	  (nth 0 coords))
+	 (y0 	  (nth 1 coords))
+	 (x1 	  (nth 2 coords))
+	 (y1 	  (nth 3 coords)))
+    
+    ;;
+    ;; move up to the "fly row"
+    ;;
+    (do ()
+	((<= y0 fly-row))
+      (setq inc (if (> (- y0 fly-row) accel) accel (- y0 fly-row)))
+      (setq y0  (- y0 inc))
+      (setq y1  (- y1 inc))
+      (funcall hanoi-canvas "coords" r x0 y0 x1 y1)
+      (update))
+
+    ;;
+    ;; one less ring on this pole
+    ;;
+    (let ((tmp (car (svref ring n))))
+      (setf (car (svref pole tmp)) (- (car (svref pole tmp)) 1)))
+
+    ;;
+    ;; determine target X position, based on destination pole, and fly ring
+    ;; over to new pole
+    ;;
+    (setq toX (- (cdr (svref pole to)) 
+		 (/ (second (svref ring n)) 2)))
+
+    (do ()
+	((>= x0 toX))
+      (setq inc (if (> (- toX x0) accel) accel (- toX x0)))
+      (setq x0 (+ x0 inc))
+      (setq x1 (+ x1 inc))
+      (funcall hanoi-canvas "coords" r x0 y0 x1 y1)
+      (update))
+
+    (do ()
+	((<= x0 toX))
+      (setq inc (if (> (- x0 toX) accel) accel (- x0 toX)))
+      (setq x0 (- x0 inc))
+      (setq x1 (- x1 inc))
+      (funcall hanoi-canvas "coords" r x0 y0 x1 y1)
+      (update))
+
+    ;;
+    ;; determine target Y position, based on ;; rings on destination pole.
+    ;;
+    (setq toY (- base (* (car (svref pole to)) ring-spacing)))
+
+    ;;
+    ;; float ring down
+    ;;
+    (do ()
+	((>= y0 toY))
+      (setq inc (if (> (- toY y0) accel) accel (- toY y0)))
+      (setq y0 (+ y0 inc))
+      (setq y1 (+ y1 inc))
+      (funcall hanoi-canvas "coords" r x0 y0 x1 y1)
+      (update))
+
+    ;;
+    ;; increase destination pole usage
+    ;;
+    (incf (car (svref pole to)))
+    (setf (car (svref ring n)) to)))
+
+(SetupHanoi)
diff --git a/src/tk/Demos/hello.lsp b/src/tk/Demos/hello.lsp
new file mode 100644
index 000000000..c062a98ab
--- /dev/null
+++ b/src/tk/Demos/hello.lsp
@@ -0,0 +1,14 @@
+;; Simple Tk script to create a button that prints "Hello, world".
+;; Click on the button to terminate the program.
+;; 
+;; The first line below creates the button, and the second line
+;; arranges for packer to manage the button's geometry, centering
+;; it in the application's main window.
+
+(in-package "TK")
+
+(button ".hello" "-text" "Hello, world" 
+	"-command" '(progn
+		     (format t "Hello, world~%")
+		     (destroy .hello)))
+(pack .hello)
diff --git a/src/tk/Demos/queens.lsp b/src/tk/Demos/queens.lsp
new file mode 100644
index 000000000..df9fb896d
--- /dev/null
+++ b/src/tk/Demos/queens.lsp
@@ -0,0 +1,288 @@
+;
+; This demo is a contribution of Grant Edwards (grante@rosemount.com)
+; Modified for ECL by G. Attardi (attardi@di.unipi.it)
+
+
+; Yet another "my first STk program" type thing.  This one is the "8
+; queens" puzzle.  You try to figure out how to place 8 queens on a
+; chessboard so that none of the queens can be taken in a single move.
+
+; You can do it yourself (and it will make sure you follow the rules)
+; or you can ask it to solve the puzzle starting with a given board
+; configuration.
+
+
+(in-package "TK")
+
+(defvar queen-bitmap (concatenate 'string "@"
+				  si:*system-directory* "tk/bitmaps/queen"))
+
+; size of board (it's square)
+
+(defvar size 8)
+
+
+; Predicate that is true if the queens at p1 and p2 can't take each
+; other in 1 move.  p1 and p2 are pairs of the form ( x . y ) where
+; x is column and y is row (both from 0 to size-1).
+
+(defun legal-position-pair? (p1 p2)
+  (let ((x1 (car p1)) (y1 (cdr p1)) (x2 (car p2)) (y2 (cdr p2)))
+    (not (or 
+	  (= x1 x2) 
+	  (= y1 y2) 
+	  (= (abs (- x1 x2)) (abs (- y1 y2)))))))
+
+
+; Predicate that is true if none of the queens in list history can
+; take queen at postion new in one move.  "history" is a list of
+; position pairs.  "new" is the position pair which we are testing.
+
+(defun legal-move? (history new)
+  (cond 
+    ((null history) T)
+    ((not (legal-position-pair? (car history) new)) NIL)
+    (T (legal-move? (cdr history) new))))
+
+
+; This is the procedure that solves the puzzle given a list of
+; occupied squares and a list of empty rows.  It's also passed a
+; continuation so that it can abort when the user asks it to stop.
+
+; Add a legal move to history list and recurse to build up strings of
+; legal moves.  The chessboard is updated as pieces are placed. When
+; it reaches the required length, it waits for user to press the Next
+; or Stop button. "history" is a list of pairs that denotes where
+; there are already queens.  "ylist" is a list of rows that still need
+; to be filled. "break" is a continuation to be called when the
+; procedure is to be aborted.
+
+(defun add-queen (history ylist break)
+  (cond
+    (stopPushed    (throw break NIL))
+    ((null ylist)  (progn (write history)
+			  (terpri)
+			  (waitForNextButton)
+			  (when stopPushed
+			    (throw break NIL))))
+    (T             (let ((newy (car ylist)))
+		     (dotimes (newx size)
+		       (when (legal-move? history (cons newx newy))
+			 (activate-button newx newy)
+			 (update)
+			 (add-queen (cons (cons newx newy) history)
+				    (cdr ylist) break)
+			 (deactivate-button newx newy)
+			 (update)))))))
+
+; global boolean used to keep track of whether or not the user is
+; allowed to rearrange the board.
+
+(defvar userModsEnabled T)
+
+
+; set up button states and solve the puzzle starting with the current
+; board configuration.
+
+(defun do-solve ()
+  (setq stopPushed NIL)
+  (.q.upper.solve "configure" "-state" "disabled")
+  (.q.upper.stop  "configure" "-state" "normal")
+  (.q.upper.clear "configure" "-state" "disabled")
+  (.q.upper.quit "configure" "-state" "disabled")
+  (setq userModsEnabled NIL)
+  (let ((break (cons nil nil)))
+    (catch break
+      (add-queen (current-positions) (empty-rows) break)))
+  (.q.upper.stop "configure" "-state" "disabled")
+  (.q.upper.clear "configure" "-state" "normal")
+  (setq userModsEnabled T)
+  (.q.upper.solve "configure" "-state" "normal")
+  (.q.upper.quit "configure" "-state" "normal"))
+
+
+; Create two matrixes.  Each has an entry for each square on the
+; board.  One matrix is Tk button procedures, the other is booleans
+; that reflect whether or not the square is occupied.
+
+(defvar board-buttons (make-array (list size size)))
+(defvar board-states  (make-array (list size size)))
+  
+
+; redraw the button so that it is occupied and update the matrix of
+; booleans
+
+(defun activate-button (x y)
+  (funcall (aref board-buttons y x)
+	   "configure" "-relief" "raised" "-foreground" "#000")
+  (setf (aref board-states y x) T))
+
+
+; redraw the button so that it is empty and update the matrix of
+; booleans
+
+(defun deactivate-button (x y)
+  (let* ((b (aref board-buttons y x))
+	 (bg (fifth (funcall b "configure" "-background"))))
+    (funcall b "configure" "-relief" "flat" "-foreground" bg)
+    (setf (aref board-states y x) NIL)))
+
+; flash a button
+
+(defun flash-button (x y)
+  (funcall (aref board-buttons y x) "flash"))
+
+
+; Procedure called when the user clicks on a square in the chessboard.
+; If user modifications are not enabled, then do nothing.  Otherwise
+; toggle the sate of the square.  When placing a queen on a previously
+; empty square, remove existing queens that could be taken by the new
+; one.
+
+(defun toggle-button (x y)
+  (cond
+    ((not userModsEnabled) NIL)
+    ((aref board-states y x)  (deactivate-button x y))
+    (t	   (activate-button x y)
+	   (update)
+	   (dotimes (ox size) 
+	     (dotimes (oy size)
+	       (when (and (aref board-states  oy ox)
+			  (not (and (= x ox) (= y oy)))
+			  (not (legal-position-pair? (cons x y) (cons ox oy))))
+		 (flash-button ox oy)
+		 (flash-button ox oy)
+		 (flash-button ox oy)
+		 (deactivate-button ox oy)
+		 (update)))))))
+
+
+; clear the board
+
+(defun clear-board ()
+  (dotimes (x size) (dotimes (y size) (deactivate-button x y))))
+
+
+; Procedures to return a list of consecutive integers from start to
+; end (inclusive).
+
+(defun interval (start end)
+  (do ((s start)
+       (e end (1- e))
+       (l () (cons e l)))
+      ((> s e) l)))
+
+(defun rinterval (start end)
+  (do ((s start (1+ s))
+       (e end)
+       (l () (cons s l)))
+       ((> s e) l)))
+   
+
+; Return a list of integers that identify the rows on the chessboard
+; that are empty
+
+(defun empty-rows ()
+  (let ((empty ()))
+    (dotimes (row size)
+      (dotimes (col size (push row empty))
+	(when (aref board-states row col)
+	  (return))))
+    empty))
+
+
+; Return a list of pairs ( x . y ) indicating which squares are
+; currently occupied.
+
+(defun current-positions ()
+  (let ((p ()))
+    (dotimes (x size) 
+      (dotimes (y size) 
+	(when (aref board-states y x)
+	  (push (cons x y) p))))
+    p))
+
+
+; Booleans used to detect when user presses a button 
+
+(defvar nextOrStopPushed NIL)
+(defvar stopPushed NIL)
+
+
+; Procedure to wait for the user to press either the next or stop
+; buttons.
+
+(defun waitForNextButton () 
+  (.q.upper.next "configure" "-state" "normal")
+  (tkwait "variable" 'nextOrStopPushed)
+  (.q.upper.next "configure" "-state" "disabled"))
+
+; Create top level window
+
+(toplevel ".q" "-class" "Queens")
+(wm "title" .q "Queens")
+(wm "iconname" .q "Queens")
+
+; Define two frames.  The upper will hold control buttons, the lower
+; the chessboard buttons
+
+(frame ".q.lower")
+(frame ".q.upper" "-relief" "raised" "-borderwidth" 2)
+
+
+; add a frame to the lower frame for each row of sqaures on the
+; chessboard and fill that row with buttons (one per square).
+
+(dotimes (y size)
+  (let ((rowframe (format NIL ".q.lower.row~a" y)))
+    (frame rowframe)
+    (dotimes (x size)
+      (let* ((bn (format NIL "~a.b~a" rowframe x))
+	     (bp (intern (button bn 
+				 "-bitmap" queen-bitmap
+				 "-relief" "flat"))))
+	(setf (aref board-buttons y x) (symbol-function bp))
+	(setf (aref board-states y x) NIL) ; if we reload file
+	(let ((bg (if (oddp (+ x y)) "#bbb" "#eee")))
+	  (funcall bp "configure" "-background" bg "-activebackground" "#fff"
+		   "-foreground" bg))
+	(bind bn "<Button-1>" `(toggle-button ,x ,y))
+	(bind bn "<Any-Enter>" '())
+	(bind bn "<Any-Leave>" '())
+	(bind bn "<ButtonRelease-1>" '())
+	(pack bn "-side" "left")
+	)
+      )
+    (pack (intern rowframe) "-side" "bottom")
+    )
+  )
+
+
+; add control buttons to upper frame
+
+(button ".q.upper.quit"  "-text" "Quit" "-command" '(destroy .q))
+(frame  ".q.upper.fill")
+(button ".q.upper.solve" "-text" "Solve" "-command" '(do-solve))
+(button ".q.upper.clear" "-text" "Clear" "-command" '(clear-board))
+(button ".q.upper.next"
+	"-text" "Next" 
+	"-state" "disabled" 
+	"-command" '(setq stopPushed NIL
+		        nextOrStopPushed T))
+(button ".q.upper.stop" 
+	"-text" "Stop" 
+	"-state" "disabled" 
+	"-command" '(setq stopPushed T
+		        nextOrStopPushed T))
+
+(pack .q.upper.solve "-side" "left" "-padx" 4 "-pady" 4)
+(pack .q.upper.next "-side" "left" "-padx" 4 "-pady" 4)
+(pack .q.upper.stop "-side" "left" "-padx" 4 "-pady" 4)
+(pack .q.upper.clear "-side" "left" "-padx" 4 "-pady" 4)
+(pack .q.upper.quit "-side" "right" "-padx" 4 "-pady" 4)
+(pack .q.upper.fill "-side" "right" "-fill" "x")
+
+; arrange the two top level frames
+
+(pack .q.upper "-side" "top" "-fill" "x")
+(pack .q.lower "-side" "bottom") 
diff --git a/src/tk/Makefile.in b/src/tk/Makefile.in
new file mode 100644
index 000000000..97c4a6a0f
--- /dev/null
+++ b/src/tk/Makefile.in
@@ -0,0 +1,36 @@
+
+top_srcdir= @top_srcdir@
+srcdir	= @srcdir@
+VPATH	= @srcdir@
+
+MACHINE = @host@
+
+# Programs used by "make":
+#
+CC	= @CC@
+DEFS	= -D$(MACHINE)
+CFLAGS	= -c @CFLAGS@ $(DEFS)
+OFLAG	= @OFLAG@
+
+SHELL	= /bin/sh
+RM	= @RM@
+
+# Source Directories
+
+HDIR	= @HDIR@
+
+# Files
+
+HFILES	= @HFILES@
+OBJS	= @TKOBJS@
+
+all:	$(OBJS)
+
+clean:
+	$(RM) $(OBJS) core a.out
+
+# Build rules
+
+%.o : %.c
+	$(CC) -c $(CFLAGS) $(OFLAG) $< -o $@
+
diff --git a/src/tk/bitmaps/error b/src/tk/bitmaps/error
new file mode 100644
index 000000000..08521e03b
--- /dev/null
+++ b/src/tk/bitmaps/error
@@ -0,0 +1,8 @@
+#define error_width 17
+#define error_height 17
+static char error_bits[] = {
+   0xf0, 0x0f, 0x00, 0x58, 0x15, 0x00, 0xac, 0x2a, 0x00, 0x16, 0x50, 0x00,
+   0x2b, 0xa0, 0x00, 0x55, 0x40, 0x01, 0xa3, 0xc0, 0x00, 0x45, 0x41, 0x01,
+   0x83, 0xc2, 0x00, 0x05, 0x45, 0x01, 0x03, 0xca, 0x00, 0x05, 0x74, 0x01,
+   0x0a, 0xa8, 0x00, 0x14, 0x58, 0x00, 0xe8, 0x2f, 0x00, 0x50, 0x15, 0x00,
+   0xa0, 0x0a, 0x00};
diff --git a/src/tk/bitmaps/gray25 b/src/tk/bitmaps/gray25
new file mode 100644
index 000000000..bce4c8a36
--- /dev/null
+++ b/src/tk/bitmaps/gray25
@@ -0,0 +1,6 @@
+#define gray25_width 16
+#define gray25_height 16
+static char gray25_bits[] = {
+   0x00, 0x00, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88, 0x00, 0x00, 0x22, 0x22,
+   0x00, 0x00, 0x88, 0x88, 0x00, 0x00, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88,
+   0x00, 0x00, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88};
diff --git a/src/tk/bitmaps/gray50 b/src/tk/bitmaps/gray50
new file mode 100644
index 000000000..93fe5a866
--- /dev/null
+++ b/src/tk/bitmaps/gray50
@@ -0,0 +1,6 @@
+#define gray50_width 16
+#define gray50_height 16
+static char gray50_bits[] = {
+   0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
+   0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
+   0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa};
diff --git a/src/tk/bitmaps/hourglass b/src/tk/bitmaps/hourglass
new file mode 100644
index 000000000..322ab9804
--- /dev/null
+++ b/src/tk/bitmaps/hourglass
@@ -0,0 +1,9 @@
+#define hourglass_width 19
+#define hourglass_height 21
+static char hourglass_bits[] = {
+   0xff, 0xff, 0x07, 0x55, 0x55, 0x05, 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01,
+   0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01, 0xc2, 0x0a, 0x03, 0x46, 0x05, 0x01,
+   0x82, 0x0a, 0x03, 0x06, 0x05, 0x01, 0x02, 0x03, 0x03, 0x86, 0x05, 0x01,
+   0xc2, 0x0a, 0x03, 0x66, 0x15, 0x01, 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01,
+   0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01, 0xa2, 0x2a, 0x03, 0xff, 0xff, 0x07,
+   0xab, 0xaa, 0x02};
diff --git a/src/tk/bitmaps/info b/src/tk/bitmaps/info
new file mode 100644
index 000000000..2f6cf9cb5
--- /dev/null
+++ b/src/tk/bitmaps/info
@@ -0,0 +1,5 @@
+#define info_width 8
+#define info_height 21
+static char info_bits[] = {
+   0x3c, 0x2a, 0x16, 0x2a, 0x14, 0x00, 0x00, 0x3f, 0x15, 0x2e, 0x14, 0x2c,
+   0x14, 0x2c, 0x14, 0x2c, 0x14, 0x2c, 0xd7, 0xab, 0x55};
diff --git a/src/tk/bitmaps/queen b/src/tk/bitmaps/queen
new file mode 100644
index 000000000..f37dd8115
--- /dev/null
+++ b/src/tk/bitmaps/queen
@@ -0,0 +1,9 @@
+#define queen_width 19
+#define queen_height 22
+static char queen_bits[] = {
+   0x00, 0x02, 0x00, 0x00, 0x02, 0x00, 0x80, 0x0f, 0x00, 0x00, 0x02, 0x00,
+   0x00, 0x02, 0x00, 0xf0, 0x7a, 0x00, 0xfc, 0xff, 0x01, 0x0c, 0x87, 0x01,
+   0x06, 0x07, 0x03, 0x06, 0x07, 0x03, 0x06, 0x07, 0x03, 0x06, 0x07, 0x03,
+   0x06, 0x07, 0x03, 0x0c, 0x87, 0x01, 0x0c, 0x87, 0x01, 0x0c, 0x87, 0x01,
+   0x18, 0xc7, 0x00, 0x18, 0xc7, 0x00, 0x18, 0xe7, 0x00, 0x30, 0x67, 0x00,
+   0xfc, 0xff, 0x01, 0xfc, 0xff, 0x01};
diff --git a/src/tk/bitmaps/questhead b/src/tk/bitmaps/questhead
new file mode 100644
index 000000000..2ba303f14
--- /dev/null
+++ b/src/tk/bitmaps/questhead
@@ -0,0 +1,9 @@
+#define questhead_width 20
+#define questhead_height 22
+static char questhead_bits[] = {
+   0xf8, 0x1f, 0x00, 0xac, 0x2a, 0x00, 0x56, 0x55, 0x00, 0xeb, 0xaf, 0x00,
+   0xf5, 0x5f, 0x01, 0xfb, 0xbf, 0x00, 0x75, 0x5d, 0x01, 0xfb, 0xbe, 0x02,
+   0x75, 0x5d, 0x05, 0xab, 0xbe, 0x0a, 0x55, 0x5f, 0x07, 0xab, 0xaf, 0x00,
+   0xd6, 0x57, 0x01, 0xac, 0xab, 0x00, 0xd8, 0x57, 0x00, 0xb0, 0xaa, 0x00,
+   0x50, 0x55, 0x00, 0xb0, 0x0b, 0x00, 0xd0, 0x17, 0x00, 0xb0, 0x0b, 0x00,
+   0x58, 0x15, 0x00, 0xa8, 0x2a, 0x00};
diff --git a/src/tk/bitmaps/question b/src/tk/bitmaps/question
new file mode 100644
index 000000000..abfe83e72
--- /dev/null
+++ b/src/tk/bitmaps/question
@@ -0,0 +1,10 @@
+#define question_width 17
+#define question_height 27
+static char question_bits[] = {
+   0xf0, 0x0f, 0x00, 0x58, 0x15, 0x00, 0xac, 0x2a, 0x00, 0x56, 0x55, 0x00,
+   0x2b, 0xa8, 0x00, 0x15, 0x50, 0x01, 0x0b, 0xa0, 0x00, 0x05, 0x60, 0x01,
+   0x0b, 0xa0, 0x00, 0x05, 0x60, 0x01, 0x0b, 0xb0, 0x00, 0x00, 0x58, 0x01,
+   0x00, 0xaf, 0x00, 0x80, 0x55, 0x00, 0xc0, 0x2a, 0x00, 0x40, 0x15, 0x00,
+   0xc0, 0x02, 0x00, 0x40, 0x01, 0x00, 0xc0, 0x02, 0x00, 0x40, 0x01, 0x00,
+   0xc0, 0x02, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0xc0, 0x02, 0x00,
+   0x40, 0x01, 0x00, 0xc0, 0x02, 0x00, 0x00, 0x01, 0x00};
diff --git a/src/tk/bitmaps/warning b/src/tk/bitmaps/warning
new file mode 100644
index 000000000..652af7d03
--- /dev/null
+++ b/src/tk/bitmaps/warning
@@ -0,0 +1,5 @@
+#define warning_width 6
+#define warning_height 19
+static char warning_bits[] = {
+   0x0c, 0x16, 0x2b, 0x15, 0x2b, 0x15, 0x2b, 0x16, 0x0a, 0x16, 0x0a, 0x16,
+   0x0a, 0x00, 0x00, 0x1e, 0x0a, 0x16, 0x0a};
diff --git a/src/tk/button.lsp b/src/tk/button.lsp
new file mode 100644
index 000000000..2ff983614
--- /dev/null
+++ b/src/tk/button.lsp
@@ -0,0 +1,84 @@
+;;;;
+;;;; Buttons, Check button and radio buttons bindings and procs
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 17-May-1993 12:35
+;;;; Last file update: 22-Nov-1993 16:00
+;;;;
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+
+;; Class bindings for various flavors of button widgets. tk::window
+;; keeps track of the button containing the mouse, and tk::relief
+;; saves the original relief of the button so it can be restored when
+;; the mouse button is released.
+
+(in-package "TK")
+
+(let ((Button-bindings '(("<Any-Enter>"		. (tk-butEnter %W))
+			 ("<Any-Leave>"		. (tk-butLeave %W))
+			 ("<1>"			. (tk-butDown %W))
+			 ("<ButtonRelease-1>" 	. (tk-butUp %W)))))
+
+   (def-bindings "Button"      Button-bindings)
+   (def-bindings "Checkbutton" Button-bindings)
+   (def-bindings "Radiobutton" Button-bindings))
+
+;; The procedure below is invoked when the mouse pointer enters a
+;; button widget.  It records the button we're in and changes the
+;; state of the button to active unless the button is disabled.
+
+(defun tk-butEnter (w)
+  (unless (equal (tk-get w "-state") "disabled")
+     (unless tk-strictMotif (tk-setq w "-state" "active"))
+     (setq tk::window w)))
+
+
+;; The procedure below is invoked when the mouse pointer leaves a
+;; button widget. It changes the state of the button back to
+;; inactive.
+
+(defun tk-butLeave (w)
+  (unless (equal (tk-get w "-state") "disabled")
+     (unless tk-strictMotif (tk-setq w "-state" "normal"))
+     (setq tk::window "")))
+
+;; The procedure below is invoked when the mouse button is pressed in
+;; a button/radiobutton/checkbutton widget.  It records information
+;; (a) to indicate that the mouse is in the button, and
+;; (b) to save the button's relief so it can be restored later.
+
+(defun tk-butDown (w)
+  (setq tk::buttonWindow w)
+  (setq tk::relief (tk-get w "-relief"))
+  (unless (equal (tk-get w "-state") "disabled")
+     (tk-setq w "-relief" "sunken")))
+
+;; The procedure below is invoked when the mouse button is released
+;; for a button/radiobutton/checkbutton widget.  It restores the
+;; button's relief and invokes the command as long as the mouse
+;; hasn't left the button.
+
+(defun tk-butUp (w)
+  (when (equal w tk::buttonWindow)
+     (tk-setq w "-relief" tk::relief)
+     (when (and (equal w tk::window)
+		(not (equal (tk-get w "-state") "disabled")))
+       (funcall w "invoke"))
+     (setq tk::buttonWindow '())))
diff --git a/src/tk/dialog.lsp b/src/tk/dialog.lsp
new file mode 100644
index 000000000..1e37e60a2
--- /dev/null
+++ b/src/tk/dialog.lsp
@@ -0,0 +1,157 @@
+;;;;
+;;;; Dialog box creation utility
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date:  4-Aug-1993 11:05
+;;;; Last file update:  5-Feb-1995 16:38
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+(provide "dialog")
+
+(defvar dialog-old-focus "none")
+(defvar dialog-old-grab  ())
+(defvar button-pressed   NIL)
+
+;;
+;; make-dialog
+;;
+;; This procedure displays a dialog box following the spcifications given in
+;; arguments. Arguments are given as keywords.
+;;
+;; window (.dialog)	Window name to use for dialog top-level.
+;; title ("Dialog")	Title to display in dialog's decorative frame.
+;; text ("")		Message to display in dialog.
+;; bitmap ("")		Bitmap to display in dialog (empty string means none).
+;; default (-1) 	Index of button that is to display the default ring
+;;			(-1 means none).
+;; grabbing (NIL)	Indicates if make-dialog must wait that a button be
+;;			pressed before returning
+;; buttons ('())	A list of couples indicating the button text and its
+;;			associated action (a lambda)
+;;
+;; If grabbing is set, this procedure returns the button pressed index.
+;;
+
+
+(defun make-dialog (&key ((window   w)   ".dialog")
+			 (title    "Dialog")
+			 (text     "")
+			 (bitmap   "")
+			 (default  -1)
+			 ((grab grabbing)     NIL)
+			 (buttons  '()))
+
+  (catch-errors (destroy w))
+
+  ;; 1. Create the top-level window and divide it into top and bottom parts.
+  (let ((w.top (& w ".top"))
+	(w.bot (& w ".bot"))
+	(w.msg (& w ".msg"))
+	(w.bmp (& w ".bmp")))
+
+    (toplevel w "-class" "Dialog")
+    (wm "title" w title)
+    (wm "iconname" w "Dialog")
+	
+    (pack (frame w.top "-relief" "raised" "-bd" 1)
+	  (frame w.bot "-relief" "raised" "-bd" 1)
+	  "-fill" "both")
+
+    ;; 2. Fill the top part with bitmap and message.
+    (pack (message w.msg "-aspect" 1000 "-text" text 
+	  "-font" "-Adobe-Times-Medium-R-Normal-*-180-*")
+	  "-in" w.top 
+	  "-side" "right"
+	  "-expand" T 
+	  "-fill" "both"
+	  "-padx" "5m" 
+	  "-pady" "5m")
+
+    (unless (equal bitmap "")
+      (pack (label w.bmp "-bitmap" bitmap "-fg" "red")
+	    "-in" w.top 
+	    "-side" "left"
+	    "-padx" "5m"
+	    "-pady" "5m"))
+
+    ;; 3. Create a row of buttons at the bottom of the dialog.
+    (do ((i 0 (+ i 1)) (but buttons (cdr but)))
+	((null but) '())
+      
+      (let ((name (& w ".button" i)))
+	(button name "-text" (caar but) 
+		"-command" `(progn
+			   (focus dialog-old-focus)
+			   (setq button-pressed ,i)
+			   (destroy (string->widget ,(& w)))
+			   (apply ,(cadar but) '())))
+	(if (equal i default)
+	    (let ((default (& w ".default")))
+	    (frame default "-relief" "ridge" "-bd" 3)
+	    (raise name default)
+	    (pack default "-in" w.bot 
+		  "-side" "left" 
+		  "-expand" T
+		  "-padx" 20 
+		  "-pady" 8)
+	    (pack name    "-in" default 
+		  "-padx" 5
+		  "-pady" 5
+		  "-ipadx" 2
+		  "-ipady" 2)
+	    (bind w "<Return>" (tk-get (string->widget name) "-command")))
+	    (pack name "-in" w.bot 
+	    "-side" "left"
+	    "-expand" 1
+	    "-padx" 20
+	    "-pady" 8
+	    "-ipadx" 2
+	    "-ipady" 2)))))
+
+  ;; 4. Center window
+  (center-window w)
+
+  ;; 5. Set focus to the new window
+  (setq dialog-old-focus (get-focus))
+  (focus w)
+  (when grabbing 
+    (setq dialog-old-grab  (funcall grab "current" *root*))
+    (funcall grab "set" w)
+    (tkwait "variable" "button-pressed")
+    (if (not (null dialog-old-grab))
+	(funcall grab dialog-old-grab)))
+  button-pressed)
+
+(defun center-window (w)
+  ;; Withdraw the window, then update all the geometry information
+  ;; so we know how big it wants to be, then center the window in the
+  ;; display and de-iconify it.
+
+  (wm "withdraw" w)
+  (update "idletasks")
+  (let ((x (- (/ (parse-integer (winfo "screenwidth" w)) 2) 
+	      (/ (parse-integer (winfo "reqwidth" w)) 2)
+	      (winfo "vrootx" (eval (winfo "parent" w)))))
+	(y (- (/ (parse-integer (winfo "screenheight" w)) 2)
+	      (/ (parse-integer (winfo "reqheight" w)) 2)
+	      (parse-integer (winfo "vrooty" (eval (winfo "parent" w)))))))
+    (wm "geom" w (& "+" (floor x) "+" (floor y)))
+    (wm "deiconify" w)))
diff --git a/src/tk/editor.lsp b/src/tk/editor.lsp
new file mode 100644
index 000000000..51e5a6eb5
--- /dev/null
+++ b/src/tk/editor.lsp
@@ -0,0 +1,278 @@
+;;;; e d i t o r . l s p		-- A small editor to create enhanced
+;;;;					   text (used for Help page construction)
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
+;;;;    Creation date:  6-Dec-1993 17:25
+;;;; Last file update: 17-Oct-1994 18:41
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+(provide "editor")
+
+;;;;
+;;;; Font definition
+;;;;
+
+(defvar STF-signature "STF-0.1")
+
+(defvar normal-font "*-Courier-Medium-R-Normal-*-120-*")
+
+(defvar all-fonts `(
+   (normal		,normal-font)
+   (fixed		"fixed")
+   (big			"-*-times-*-r-*-*-*-240-*-*-*-*-*-*")
+   (roman-12		"-*-times-*-r-*-*-*-120-*-*-*-*-*-*")
+   (roman-14		"-*-times-*-r-*-*-*-140-*-*-*-*-*-*")
+   (roman-16		"-*-times-*-r-*-*-*-160-*-*-*-*-*-*")
+   (roman-18		"-*-times-*-r-*-*-*-180-*-*-*-*-*-*")
+   (italic-12		"-*-times-*-i-*-*-*-120-*-*-*-*-*-*")
+   (italic-14		"-*-times-*-i-*-*-*-140-*-*-*-*-*-*")
+   (italic-16		"-*-times-*-i-*-*-*-160-*-*-*-*-*-*")
+   (italic-18		"-*-times-*-i-*-*-*-180-*-*-*-*-*-*")
+   (bold-12		"-*-helvetica-bold-r-*-*-*-120-*-*-*-*-*-*")
+   (bold-14		"-*-helvetica-bold-r-*-*-*-140-*-*-*-*-*-*")
+   (bold-16		"-*-helvetica-bold-r-*-*-*-160-*-*-*-*-*-*")
+   (bold-18		"-*-helvetica-bold-r-*-*-*-180-*-*-*-*-*-*")
+   (bold-italic-12	"-*-helvetica-bold-o-*-*-*-120-*-*-*-*-*-*")
+   (bold-italic-14	"-*-helvetica-bold-o-*-*-*-140-*-*-*-*-*-*")
+   (bold-italic-16	"-*-helvetica-bold-o-*-*-*-160-*-*-*-*-*-*")
+   (bold-italic-18	"-*-helvetica-bold-o-*-*-*-180-*-*-*-*-*-*")
+   (tty-12		"-adobe-courier-medium-*-*-*-*-120-*-*-*-*-*-*")
+   (tty-14		"-adobe-courier-medium-*-*-*-*-140-*-*-*-*-*-*")
+   (tty-16		"-adobe-courier-medium-*-*-*-*-160-*-*-*-*-*-*")
+   (tty-18		"-adobe-courier-medium-*-*-*-*-180-*-*-*-*-*-*")))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Fonts utilities
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun unset-tags (editor-window start end)
+  (dolist (tag all-fonts) 
+    (funcall editor-window "tag" "remove" (car tag) start end)))
+  
+(defun set-font (editor-window font start end)
+  ;; Be sure this tag exists
+  (funcall editor-window "tag" "conf" font "-font" (cadr (assoc font all-fonts)))
+  ;; Delete all the tags associated to this range
+  (unset-tags editor-window start end)
+  ;; Set a new tag for this character range
+  (funcall editor-window "tag" "add" font start end))
+
+(defun set-underline (editor-window start end)
+  (funcall editor-window "tag" "conf" "underline" "-underline" T)
+  (funcall editor-window "tag" "add" "underline" start end))
+
+(defun fontify-selection (editor-window font)
+  (setq editor-window (string->widget editor-window))
+  (catch-errors
+     (set-font editor-window 
+		   font 
+		   (funcall editor-window "index" "sel.first")
+		   (funcall editor-window "index" "sel.last"))))
+
+(defun underline-selection (editor-window value)
+  (setq editor-window (string->widget editor-window))
+  (catch-errors
+     (let ((start (funcall editor-window "index" "sel.first"))
+	   (end   (funcall editor-window "index" "sel.last")))
+       ;; Remove all underlining information in this area
+       (funcall editor-window "tag" "remove" "underline" start end)
+       ;; Set underline if value is T
+       (when value (set-underline editor-window start end)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Scheme Text Format (STF) management
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun get-STF (editor-window)
+  (list STF-signature
+	(funcall editor-window "get" "1.0" "end")
+	(let ((l '()))
+	  (dolist (t (cons `(underline NIL) all-fonts))
+	    (let ((tags (funcall editor-window "tag" "range" (car t))))
+	      (unless (null tags)
+		(setq l (cons (list (car t) tags) l)))))
+	  l)))
+
+(defun set-STF (editor-window STF)
+  (let ((text (cadr STF)) (fmts (caddr STF)))
+    ;; First insert new text
+    (funcall editor-window "delete" "1.0" "end")
+    (funcall editor-window "insert" "1.0" text)
+    (funcall editor-window "mark" "set" "insert" "1.0")
+    ;; And now enhence it
+    (dolist (t fmts) 
+      (do ((l (cadr t) (cddr l)))
+	  ((null l))
+	(if (equal (car t) "underline")
+	    (set-underline editor-window (car l) (cadr l))
+	    (set-font editor-window (car t) (car l) (cadr l))))))
+  (update))
+  
+(defun write-file (editor-window file)
+  (setq editor-window (string->widget editor-window))
+  (with-open-file (s file :direction :output)
+    (format s ";;;; ~S\n" STF-signature)
+    (format s "~S\n" (get-STF editor-window))))
+
+
+(defun write-file-ascii (editor-window file)
+  (setq editor-window (string->widget editor-window))
+  (with-open-file (s file :direction :output)
+    (format s "~A" (funcall editor-window "get" "1.0" "end"))))
+
+(defun read-file (editor-window file)
+  (setq editor-window (string->widget editor-window))
+  (with-open-file (s file)
+    (let ((first-line (read-line s)))
+      (if (string= first-line (format NIL ";;;; ~S" STF-signature))
+	  ;; File is a STF file
+	  (set-STF editor-window (read s))
+	  ;; File must be read as a "normal" file
+	  (progn
+	    (funcall editor-window "delete" "1.0" "end")
+	    (do ((l first-line (read-line s nil nil)))
+		((null l))
+	      (funcall editor-window "insert" "end" l)
+	      (funcall editor-window "insert" "end" #\newline))
+	    (funcall editor-window "mark" "set" "insert" "1.0")))))))
+
+(defun get-filename (toplevel) ; return the content of the file name  entry
+  (let ((entry (string->widget (& toplevel ".bt.e"))))
+    (funcall entry "get")))
+
+(defun set-filename (toplevel filename)
+  (let ((entry (string->widget (& toplevel ".bt.e"))))
+    (funcall entry "delete" 0 "end")
+    (funcall entry "insert" 0 filename)))
+	
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Interface
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun make-editor (name &rest exit_code)
+  (let* ((top 	     (toplevel name))
+	 (menu-bar   (frame     (& name ".mb") "-bd" 2 "-relief" "groove"))
+	 (bottom     (frame     (& name ".bt")))
+	 (text-area  (frame     (& name ".ta")))
+	 (exit_code  (if (null exit_code) `(destroy ,top) (car exit_code)))
+	 (the-editor ()))
+
+    ;;
+    ;; Window manager management
+    ;; 
+    (wm "maxsize" name 1000 800)
+    (wm "protocol" name "WM_DELETE_WINDOW" exit_code)
+	
+    ;;
+    ;; Text area frame
+    ;;
+    (pack (scrollbar (& text-area ".sc") "-orient" "vert" 
+		     			 "-bd" 2
+					 "-relief" "groove"
+		     			 "-command" (format NIL "~A \"yview\"" 
+							  (& text-area ".ed")))
+	  "-side" "left" "-fill" "y")
+    (pack (text (& text-area ".ed") "-padx" 4 
+				    "-pady" 4
+				    "-bd" 2
+				    "-wrap" "word"
+				    "-relief" "groove"
+				    "-yscroll" (format NIL "~A \"set\""
+						     (& text-area ".sc")))
+	  "-side" "right" "-expand" T "-fill" "both")
+
+    (setq the-editor (& text-area ".ed"))
+
+    ;;
+    ;; Menu Creation
+    ;;
+
+    (let* ((File (menubutton (& menu-bar ".file") 
+			     "-text" "File"
+			     "-padx" 10
+			     "-menu" (& menu-bar ".file.m")))
+	   (m	 (string->widget (menu (& menu-bar ".file.m")))))
+
+      (funcall m "add" "command" 
+	      "-label" "  Read  "    
+	      "-command" `(read-file ,the-editor (get-filename ,top)))
+      (funcall m "add" "command" 
+	      "-label" "  Save  "
+	      "-command" `(write-file ,the-editor (get-filename ,top)))
+      (funcall m "add" "command" 
+	      "-label" "  Save Ascii  "
+	      "-command" `(write-file-ascii ,the-editor (get-filename ,top)))
+      (funcall m "add" "separator")
+      (funcall m "add" "command" "-label" "  Quit  " "-command" exit_code)
+      
+      (pack File "-side" "left"))
+
+    (let* ((Font (menubutton (& menu-bar ".font")		       
+			     "-text" "Font" 
+			     "-padx" 10
+			     "-menu" (& menu-bar ".font.m")))
+	   (m    (string->widget (menu (& menu-bar ".font.m")))))
+
+      (dolist (font all-fonts)
+	(funcall m "add" "command" 
+		 "-label"    (car font)
+		 "-font"     (cadr font)
+		 "-command" `(fontify-selection ,the-editor
+			      ',(car font))))
+      (funcall m "add" "separator")
+      (funcall m "add" "command"
+	      "-label" "Underline"    
+	      "-command" `(underline-selection ,the-editor T))
+      (funcall m "add" "command" 
+	      "-label" "No underline"
+	      "-command" `(underline-selection ,the-editor NIL))
+
+      (pack Font "-side" "left"))
+
+    ;;
+    ;; Bottom frame
+    ;;
+    (pack (label (& bottom ".l") "-text" "File name" "-padx" 10) "-side" "left")
+    (pack (entry (& bottom ".e") "-relief" "ridge") "-side" "left" "-expand" T "-fill" "x")
+
+    ;;
+    ;; Pack everybody
+    ;;
+    (pack menu-bar  "-fill" "x")
+    (pack text-area "-expand" T "-fill" "both")
+    (pack bottom    "-fill" "x" "-ipady" 4 "-ipadx" 10)))
+
+
+;; A simple editor accessible from prompt
+(defun ed (&rest file)
+  (require "editor")
+  (let ((editor-name (gensym ".editor")))
+    (make-editor editor-name)
+    (unless (null file)
+       (read-file (& editor-name ".ta.ed") (car file))
+       (set-filename editor-name (car file)))))
diff --git a/src/tk/entry.lsp b/src/tk/entry.lsp
new file mode 100644
index 000000000..633eddb7a
--- /dev/null
+++ b/src/tk/entry.lsp
@@ -0,0 +1,130 @@
+;;;;
+;;;; Entries bindings and procs
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 17-May-1993 12:35
+;;;; Last file update:  2-Jun-1994 12:42
+;;;;
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+;; ----------------------------------------------------------------------
+;; Class bindings for entry widgets.
+;; ----------------------------------------------------------------------
+
+;; Button 1 bindings
+
+(def-bindings "Entry"  '(
+  ;; Button 1 bindings
+  ("<1>"		. (progn
+			    (%W "icursor" '@%x)
+			    (%W "select" "from" '@%x)
+			    (when(equal (tk-get %W "-state") "normal") 
+				 (focus %W))))
+  ("<B1-Motion>"	. (%W "select" "to" '@%x))
+
+  ;; Button 2 bindings
+  ("<2>"		. (catch-errors 
+			   (%W "insert" "insert" (selection "get"))
+			   (tk-entrySeeCaret %W)))
+  ("<Shift-2>"		. (%W "scan" "mark" %x))
+  ("<Shift-B2-Motion>"	. (%W "scan" "dragto" %x))
+
+  ;; Button 3 bindings
+  ("<3>"		. (%W "select" "adjust" '@%x))
+  
+  ;; Special keys bindings
+  ("<Control-a>"	. (progn 
+			    (%W "icursor" 0) 
+			    (tk-entrySeeCaret %W)))
+  ("<Control-b>"	. (tk-backwardChar %W))
+  ("<Control-c>"	. (%W "delete" 0 "end"))
+  ("<Control-d>"	. (progn 
+			    (%W "delete" "insert")
+			    (tk-entrySeeCaret %W)))
+  ("<Control-e>"	. (progn 
+			    (%W "icursor" "end")
+			    (tk-entrySeeCaret %W)))
+  ("<Control-f>"	. (tk-forwardChar %W))
+  ("<Control-g>"	. (%W "delete" 0 "end"))
+  ("<Control-h>"	. (tk-entryBackspace %W))
+  ("<Control-k>"	. (progn 
+			    (%W "delete" "insert" "end")
+			    (tk-entrySeeCaret %W)))
+  ("<Control-w>"	. (catch-errors
+			    (setq tk::kill-buffer
+				  (%W "delete" 'sel.first 'sel.last))
+			    (%W "delete" 'sel.first 'sel.last)
+			    (tk-entrySeeCaret %W)))
+  ("<Control-y>"	. (progn
+			    (%W "insert" "insert" tk::kill-buffer)
+			    (tk-entrySeeCaret %W)))
+  ("<Delete>" 		. (tk-entryBackspace %W))
+  ("<BackSpace>"	. (tk-entryBackspace %W))
+  ("<Any-backslash>"	. (progn
+			    (%W "insert" "insert" "\\")
+			    (tk-entrySeeCaret %W)))
+  ("<Any-quotedbl>"	. (progn
+			    (%W "insert" "insert" "\"")
+			    (tk-entrySeeCaret %W)))
+  ("<Any-KeyPress>"	. (unless (equal "\\%A" "\\0")
+			    (%W "insert" "insert" "%A")
+			    (tk-entrySeeCaret %W)))
+))
+ *lib-bindings*)
+
+
+;; Entries utility functions
+
+(defun tk-entryIndex (w pos)
+  (parse-integer (funcall w "index" pos)))
+
+(defun tk-forwardChar (w)
+  (funcall w "icursor" (+ (tk-entryIndex w "insert") 1))
+  (tk-entrySeeCaret w))
+
+(defun tk-backwardChar (w)
+  (funcall w "icursor" (- (tk-entryIndex w "insert") 1))
+  (tk-entrySeeCaret w))
+
+(defun tk-entryBackspace (w)
+  (let ((x  (- (tk-entryIndex w "insert") 1)))
+    (if (>= x 0) (progn (funcall w "delete" x) (tk-entrySeeCaret w)))))
+
+;; The procedure below is invoked after insertions.  If the caret is not
+;; visible in the window then the procedure adjusts the entry's view to
+;; bring the caret back into the window again.
+
+(defun tk-entrySeeCaret (w)
+  (let ((c     (tk-entryIndex w "insert"))
+	(left  (tk-entryIndex w "@0"))
+	(width (format NIL "@~A" (- (parse-integer (winfo "width" w)) 5))))
+
+    (when (>= left c) 
+      (funcall w "view" (- c (if (> c 0) 1 0 ))))
+      
+    (do ((right (tk-entryIndex w width) (tk-entryIndex w width)))
+	((or (>= right c) (>= left c)))
+      (setq left (+ left 1))
+      (funcall w "view" left))))
+
+;;;;;;;
+;;tk-bindForTraversal Entry
+;;;;;;;
diff --git a/src/tk/error.lsp b/src/tk/error.lsp
new file mode 100644
index 000000000..4ca918f6b
--- /dev/null
+++ b/src/tk/error.lsp
@@ -0,0 +1,168 @@
+;;;;
+;;;; e r r o r . l s p 		-- All the stuff going with error messages 
+;;;;				   display
+;;;;
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 15-Sep-1993 14:11
+;;;; Last file update:  5-Feb-1995 16:16
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Data section
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar help-for-stackvue '("STF-0.1" "
+ECL/tk stack window help~%~%~%
+The ECL/tk stack window permits you to see the evaluation stack.Each line contains the parameters passed to an invocation of the eval procedure (last call to eval is on the first line).~%~%
+To inspect an object, you can select it with the mouse (either by dragging the mouse or with a double click to select a whole word) and, once this is done, you can call the inspector by clicking the Inspect  button. This will bring an inspector window if it does not exist yet.Otherwise the selected object will be added to the list of inspected objects in your inspector.
+
+" ((bold-italic-12 ("6.4" "6.14")) (italic-12 ("9.3" "9.10")) (roman-18 ("2.0" "3.0")))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; report-error
+;;;;
+;;;;	   Redefine here report-error. This version of report-error needs Tk
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar %stack '())
+
+(defun %truncate-string (s len)
+  (if (> (string-length s) len)
+      (format NIL "~A ..." (substring s 0 (- len 1)))
+      s))
+
+(defun report-error (head message obj)
+  (setq %stack (%get-eval-stack)) ;; Take a photo of the stack as soon as possible 
+
+  (let* ((who (if (null obj) "" (format NIL "~S" obj)))
+	 (msg (%truncate-string (format NIL "~A~%~A~%~A" head message who) 200)))
+
+    ;; Print message on standard error stream
+    (format (current-error-port) "~%~A~A~A~%" 
+	    			 head message (if (equal who "") 
+						  "" 
+						  (format NIL ": ~A" who)))
+
+    (make-dialog "-window" '.report-error
+		      "-title"  "ECL/tk error"
+		      "-text"   msg
+		      "-bitmap"  "error"
+		      "-grabbing" T
+		      "-default" 0
+		      "-buttons" `(("    Dismiss    " (lambda () '()))
+				 (" See the stack " (lambda () 
+						      (display-stack       
+						           (cddr %stack))))))
+    (update)))
+
+(defun display-stack (stack)
+  (catch-errors (destroy ".stackvue"))
+    
+  ;; Build a toplevel
+  (toplevel ".stackvue")
+  (wm "title" .stackvue "ECL/tk stack")
+  
+  ;; Dispose items
+  (label ".stackvue.l" "-text" "Stack content" "-fg" "RoyalBlue")
+  (frame ".stackvue.f" "-borderwidth" 3 "-relief" "ridge")
+  (frame ".stackvue.b")
+
+  (pack 
+     (button ".stackvue.b.i" "-text" "Inspect" 
+	                     "-command" "(run-inspect)")
+     (button ".stackvue.b.h" "-text" "Help"    
+	                     "-command" "(make-help help-for-stackvue)")
+     (button ".stackvue.b.q" "-text" "Quit"    "-command" "(destroy .stackvue)")
+     "-side" "left" "-fill" "x" "-expand" T)
+
+  (pack .stackvue.l "-side" "top")
+  (pack .stackvue.f "-side" "top" "-expand" T "-fill" "both")
+  (pack .stackvue.b "-side" "bottom" "-fill" "x")
+  
+  (scrollbar ".stackvue.f.sy"  "-command" ".stackvue.f.list \"yview\"" "-orient" "vert")
+  (text ".stackvue.f.list" "-width" 60
+			   "-height" 15
+			   "-yscroll" ".stackvue.f.sy \"set\""
+			   "-font" "fixed"
+			   "-bd" 1
+			   "-relief" "raised"
+			   "-padx" 3
+			   "-wrap" "none")
+
+  (pack .stackvue.f.sy   "-side" "left"   "-fill" "y")
+  (pack .stackvue.f.list "-expand" "yes"  "-fill" "both")
+
+  ;; Center the window
+  (center-window .stackvue)
+  
+  ;; Insert all the elements of the stack in the listbox
+  (do ((stack stack (cdr stack)))
+      ((null stack))
+    (.stackvue.f.list "insert" "end" 
+		      (%truncate-string (format NIL "~%~S" (uncode(car stack)))150)))
+  ;; Insert a marker to delimit bottom of the stack
+  (.stackvue.f.list "insert" "end" "~%<<< STACK BOTTOM >>>")
+  (.stackvue.f.list "tag" "add" "bottom" "end linestart" "end")
+  (.stackvue.f.list "tag" "conf" "bottom" "-font" "8x13bold" "-foreground" "Red")
+
+    
+  (setq %stack '()) ;; so it can be GC'ed
+
+  (wm "maxsize" .stackvue 1000 1000)
+  (tk-setq .stackvue.f.list "-state" "disabled"))
+
+(defun run-inspect ()
+  ;; Load inspect if necessary
+  (require "inspect-main")
+
+  (let ((obj '()))
+    (if (catch-errors (setq obj (selection "get")))
+	;; No selection available. Open a popup to say that
+	(make-dialog "-title" "Information" 
+			  "-text" "Nothing is selected for inspection"
+			  "-bitmap"  "info"
+			  "-default" 0
+			  "-buttons" '(("    Dismiss    " (lambda () T))))
+	;; Inspect the content of selection
+	(inspect (read-from-string obj)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Misc 
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar errorInfo "")
+
+
+;; For now tkerror does nothing since Tcl_AddErrorInfo simulation is not
+;; correct. 
+
+
+(defun tkerror (&rest message)
+  ;; Important note: When a background error occurs, tk try to see if 
+  ;; tkerror is bound to something. This is achieved by calling tkerror
+  ;; with an empty message. In this case, nothing is printed
+  (unless (null message)
+     (format *standard-error* "**** Tk error (~S) ~S~%" (car message) errorInfo)))
+
diff --git a/src/tk/help.lsp b/src/tk/help.lsp
new file mode 100644
index 000000000..b07567015
--- /dev/null
+++ b/src/tk/help.lsp
@@ -0,0 +1,49 @@
+;;;;
+;;;; Help management
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 14-Sep-1993 13:30
+;;;; Last file update: 27-Apr-1994 09:36
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(provide "help")
+(require "editor")
+
+(defun make-help (STF)
+  (catch-errors (destroy ".help"))
+  (toplevel ".help")
+  (wm "title" .help "ECL help")
+  (wm "maxsize" .help 800 800)
+  
+  ; Create a dismiss button
+  (button ".help.b" "-text" "Dismiss" "-command" '(destroy .help))
+
+  ; Create a text widget with the content of list
+  (frame ".help.f" "-relief" "sunken" "-bd" 2)
+  (pack (scrollbar ".help.f.sb"
+		   "-orient" "vertical" "-command" ".help.f.t \"yview\"")
+	"-side" "left" "-fill" "y")
+  (pack (text ".help.f.t" 
+	      "-relief" "raised" "-bd" 2 "-padx" 12 "-pady" 12
+	      "-height" 18 "-wrap" "word" "-yscroll" ".help.f.sb \"set\"")
+	"-fill" "both" "-expand" T)
+
+
+  (set-STF .help.f.t STF)
+  ; Set the text read only
+  (tk-setq .help.f.t "-state" "disabled")
+  
+  (pack .help.b "-side" "bottom" "-fill" "x" "-padx" 4 "-pady" 2)
+  (pack .help.f "-fill" "both" "-expand" T "-padx" 4 "-pady" 2))
diff --git a/src/tk/init.lsp b/src/tk/init.lsp
new file mode 100644
index 000000000..43eb20bf3
--- /dev/null
+++ b/src/tk/init.lsp
@@ -0,0 +1,84 @@
+;;;;
+;;;; i n i t . l s p			-- The file launched at startup
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
+;;;;    Creation date: ??-Sep-1993 ??:??
+;;;; Last file update: 12-Feb-1995 12:00
+;;;;
+
+(defvar @undefined (if NIL T))
+(defvar *argc* (length *argv*)) 
+
+(defvar !		system)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Misc
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun widget? (obj)
+  (and (tk-command? obj) (not (catch (obj "configure")))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Autoloads
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(autoload "unix" 	basename dirname decompose-file-name)
+(autoload "process"	run-process process?)
+(autoload "regexp"	string->regexp regexp? regexp-replace regexp-replace-all)
+
+;; martine packages 
+(autoload "pp"  pp)
+(autoload "trace" tracef)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; A set of binding to allow building of image files which contain the 
+;;;; STklos-Tk classes.
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar Tk:button	NIL)
+(defvar Tk:checkbutton	NIL)
+(defvar Tk:canvas	NIL)
+(defvar Tk:entry	NIL)
+(defvar Tk:frame	NIL)
+(defvar Tk:label 	NIL)
+(defvar Tk:listbox	NIL)
+(defvar Tk:menu		NIL)
+(defvar Tk:menubutton	NIL)
+(defvar Tk:message	NIL)
+(defvar Tk:scale	NIL)
+(defvar Tk:scrollbar	NIL)
+(defvar Tk:radiobutton	NIL)
+(defvar Tk:toplevel	NIL)
+
+(defvar Tk:after	NIL)
+(defvar Tk:bind		NIL)
+(defvar Tk:destroy	NIL)
+(defvar Tk:focus	NIL)
+(defvar Tk:grab		NIL)
+(defvar Tk:lower	NIL)
+(defvar Tk:option	NIL)
+(defvar Tk:pack		NIL)
+(defvar Tk:place	NIL)
+(defvar Tk:raise	NIL)
+(defvar Tk:selection	NIL)
+(defvar Tk:tk		NIL)
+(defvar Tk:tkwait	NIL)
+(defvar Tk:update	NIL)
+(defvar Tk:winfo	NIL)
+(defvar Tk:wm		NIL)
diff --git a/src/tk/insp-detail.lsp b/src/tk/insp-detail.lsp
new file mode 100644
index 000000000..a41439a66
--- /dev/null
+++ b/src/tk/insp-detail.lsp
@@ -0,0 +1,531 @@
+;******************************************************************************
+;
+; Project       : STk-inspect, a graphical debugger for STk.
+;
+; File name     : inspect-detail.stk
+; Creation date : Aug-30-1993
+; Last update   : Sep-17-1993
+;
+;******************************************************************************
+;
+; This file implements the different kinds of "Detailers".
+;
+;******************************************************************************
+
+(in-package "TK")
+
+(provide "inspect-detail")
+
+;---- detailer widget
+
+(define DETAILER_WIDGET_NAME ".detailer")
+(define detailed-objects-list ())
+
+(defun detail-tl-wid (obj) (widget DETAILER_WIDGET_NAME (object-symbol obj)))
+(defun detail-tl-str (obj) (& DETAILER_WIDGET_NAME (object-symbol obj)))
+(defun detail-l-wid (obj) (widget (detail-tl-str obj) ".f1.l"))
+(defun detail-l-str (obj) (& (detail-tl-str obj) ".f1.l"))
+(defun detail-e-wid (obj) (widget (detail-tl-str obj) ".f1.e"))
+(defun detail-e-str (obj) (& (detail-tl-str obj) ".f1.e"))
+(defun detail-m-wid (obj) (widget (detail-tl-str obj) ".menu.command.m"))
+(defun detail-m-str (obj) (& (detail-tl-str obj) ".menu.command.m"))
+
+(defun detailed? (obj) (member obj detailed-objects-list))
+
+(defun detail (obj)
+  (if (member (inspect::typeof (inspect::eval obj))
+	      '(list pair vector closure widget))
+      (unless (detailed? obj) (detail-object obj))
+      (error "The object ~s can not be detailed" obj)))
+
+(defun detail-object (obj)
+  (setq detailed-objects-list (cons obj detailed-objects-list))
+  (unless (object-infos obj)
+	  (add-object-infos obj)
+	  (if (symbolp obj) (trace-var obj `(update-object ',obj))))
+  (let ((obj-val (inspect::eval obj)))
+    (case (inspect::typeof obj-val)
+      ((list pair vector) (detail-VPL obj))
+      ((closure)          (detail-procedure obj))
+      ((widget) 	  (when (= (winfo "exists" (detail-tl-wid obj-val)) 0)
+				(detail-widget obj))))))
+
+(defun undetail (obj)
+  (if (detailed? obj) (undetail-object obj)))
+
+(defun undetail-object (obj)
+  (let ((top (detail-tl-wid obj)))
+    (setq detailed-objects-list (list-remove obj detailed-objects-list))
+    (if (inspected? obj) ((inspect-m-wid obj) "enable" "Detail"))
+    (if (viewed? obj) ((view-m-wid obj) "enable" "Detail"))
+    (unless (or (inspected? obj) (viewed? obj))
+	    (remove-object-infos obj)
+	    (if (symbolp obj) (untrace-var obj)))
+    ;; If toplevel exists (i.e. it is not a <Destroy> event) destroy it
+    (if (= (winfo "exists" top) 1)
+	(destroy top))))
+
+(defun detail-display (obj)
+  (case (inspect::typeof (inspect::eval obj))
+    ((vector pair list) (detail-VPL-display obj))
+    ((closure) (detail-procedure-display obj))
+    ((widget) (detail-widget-display obj))))
+
+
+;---- Detailer menu -----------------------------------------------------------
+
+(defun detail-menu-Eval (entry obj)
+  (eval-string (format NIL "(setq ~a ~a)" obj (entry "get"))))
+
+(defun detail-menu-Quote (entry obj)
+  (eval-string (format NIL "(setq ~a '~a)" obj (entry "get"))))
+
+(defun detail-menu-Inspect (key)
+  (let ((obj (find-object-infos key)))
+    (inspect obj)
+    ((widget (detail-tl-str obj) ".menu.command.m") "disable" "Inspect")
+    (if (viewed? obj) ((view-w-wid obj) "disable" "Inspect"))))
+
+(defun detail-menu-Undetail (key) (undetail (find-object-infos key)))
+
+(defun detail-menu-View (key)
+  (let ((obj (find-object-infos key)))
+    (view obj)
+    ((widget (detail-tl-str obj) ".menu.command.m") "disable" "View")
+    (if (inspected? obj) ((inspect-m-wid obj) "disable" "View"))))
+
+
+;---- VPL menu ----------------------------------------------------------------
+
+(defun get-VPL-index (obj)
+  (let ((s (tk-get (VPL-l-wid obj) "-text")))
+    (string->number (substring s 6 (string-length s)))))
+
+(defun get-VPL-value (obj) ((VPL-e-wid obj) "get"))
+(defun set-VPL-index&value (obj index)
+  (tk-setq (VPL-l-wid obj) "-text" (& "Value " index))
+  (let ((value-w (VPL-e-wid obj)))
+    (value-w "delete" 0 "end")
+    (value-w "insert" 0 (->object ((VPL-vlb-wid obj) "get" index)))))
+
+(defun VPL-menu-Eval (obj)
+  (define index (get-VPL-index obj))
+  ((VPL-vlb-wid obj) "delete" index)
+  ((VPL-vlb-wid obj) "insert" index
+		     (->object (eval-string (get-VPL-value obj))))
+  (modify-VPL obj))
+
+(defun VPL-menu-Quote (obj)
+  (define index (get-VPL-index obj))
+  ((VPL-vlb-wid obj) "delete" index)
+  ((VPL-vlb-wid obj) "insert" index (get-VPL-value obj))
+  (modify-VPL obj))
+
+
+;---- VPL detailer ------------------------------------------------------------
+
+(defun VPL-l-wid (obj) (widget (detail-tl-str obj) ".value.l"))
+(defun VPL-l-str (obj) (& (detail-tl-str obj) ".value.l"))
+(defun VPL-e-wid (obj) (widget (detail-tl-str obj) ".value.e"))
+(defun VPL-e-str (obj) (& (detail-tl-str obj) ".value.e"))
+(defun VPL-ilb-wid (obj) (widget (detail-tl-str obj) ".list.lb1"))
+(defun VPL-ilb-str (obj) (& (detail-tl-str obj) ".list.lb1"))
+(defun VPL-vlb-wid (obj) (widget (detail-tl-str obj) ".list.lb2"))
+(defun VPL-vlb-str (obj) (& (detail-tl-str obj) ".list.lb2"))
+
+(defun create-detail-toplevel-widget (obj)
+  (define w (create-toplevel-widget (detail-tl-str obj)))
+  (define id-w (widget w ".id"))
+  (define menu-w (widget w ".menu"))
+  (set-id-label1 id-w "Object" 6)
+  (set-id-label2 id-w "Value" 6)
+  ((widget menu-w ".help.m") "add" "command" "-label" "Detailer"
+			     "-command" "(make-help Detailer-help)")
+  (pack (menubutton (& menu-w ".command") "-text" "Command") "-side" "left")
+  (define cmd-w (eval (menu (& menu-w ".command.m"))))
+  (tk-setq (widget menu-w ".command") "-menu" cmd-w)
+  (cmd-w "add" "command" "-label" "Inspect" 
+	 	       "-command" `(detail-menu-Inspect ',(object-symbol obj)))
+  (if (inspected? obj) (cmd-w "disable" "Inspect"))
+  (cmd-w "add" "command" "-label" "Undetail"
+	 	       "-command" `(detail-menu-Undetail ',(object-symbol obj)))
+  (cmd-w "add" "command" "-label" "View" 
+		       "-command" `(detail-menu-View ',(object-symbol obj)))
+  (if (viewed? obj) (cmd-w "disable" "View"))
+
+  (if (modifiable-object? obj)
+      (begin
+	(bind (widget w ".id.f2.e") "<Return>" 
+	      `(detail-menu-Eval %W ',obj))
+	(bind (widget w ".id.f2.e") "<Shift-Return>" 
+	      `(detail-menu-Quote %W ',obj)))
+      (begin
+	(set-id-value id-w (format NIL "~S" (inspect::eval obj)))
+	(inspect::shadow-entry (widget w ".id.f2.e"))))
+  
+  (bind w "<Destroy>" `(detail-menu-Undetail ',obj))
+  w)
+
+(defun detail-VPL (obj)
+  (define w (create-detail-toplevel-widget obj))
+  ((widget w ".menu.help.m") "add" "command")
+  (tk-setq (widget w ".id.f1.l2") "-width" 20)
+  (wm "maxsize" w SCREEN_WIDTH SCREEN_HEIGHT)
+  (pack (frame (& w ".value")) "-side" "top" "-fill" "x" "-padx" 4 "-pady" 2)
+  (pack (label (& w ".value.l") "-text" "Value 0") "-side" "left")
+  (pack (entry (& w ".value.e") "-relief" "sunken" "-bd" 2) "-fill" "x")
+  (pack (frame (& w ".list") "-relief" "sunken" "-bd" 2)
+	"-fill" "both" "-expand" "yes" "-padx" 4 "-pady" 2)
+  (pack (scrollbar (& w ".list.vsb") "-orient" "vertical")
+	(listbox (& w ".list.lb1") "-relief" "raised" "-bd" 2 "-geometry" "4x8")
+	"-side" "left" "-fill" "y")
+  (pack (listbox (& w ".list.lb2") "-relief" "raised" "-bd" 2)
+	"-fill" "both" "-expand" "yes")
+  (tk-listbox-single-select (& w ".list.lb1") (& w ".list.lb2"))
+  (if (modifiable-object? obj)
+      (begin
+	(bind (widget w ".value.e") "<Return>" `(VPL-menu-Eval ',obj))
+	(bind (widget w ".value.e") "<Shift-Return>" `(VPL-menu-Quote ',obj)))
+      (inspect::shadow-entry (widget w ".value.e")))
+
+  (bind (widget w ".list.lb1") "<Button-1>" `(VPL-select ',obj %y))
+  (bind (widget w ".list.lb2") "<Button-1>" `(VPL-select ',obj %y))
+  (tk-setq (widget w ".list.vsb") "-command" (& "scroll-VPL " w))
+  (tk-setq (widget w ".list.lb2") "-yscroll" (& w ".list.vsb \"set\""))
+  (detail-VPL-display obj))
+
+(defun VPL-select (obj y)
+  (let ((index-w (VPL-ilb-wid obj))
+	(value-w (VPL-vlb-wid obj))
+	(entry-w (VPL-e-wid obj))
+	(index ()))
+    (value-w "select" "from" (value-w "nearest" y))
+    (setq index (value-w "curselection"))
+    (tk-setq (VPL-l-wid obj) "-text" (& "Value " index))
+    (let ((state (tk-get entry-w "-state")))
+      (tk-setq entry-w "-state" "normal")
+      (entry-w "delete" 0 "end")
+      (entry-w "insert" 0 (->object (value-w "get" index)))
+      (tk-setq entry-w "-state" state))
+    (focus entry-w)))
+  
+(defun scroll-VPL (w x &rest param)
+  ((widget w ".list.lb1") "yview" x)
+  ((widget w ".list.lb2") "yview" x))
+
+(defun select-VPL-value (w index)
+  (let ((index-l (widget w ".value.l"))
+	(value-e (widget w ".value.e")))
+    (tk-setq index-l "-text" index)
+    (value-e "delete" 0 "end")
+    (value-e "insert" 0 (->object ((widget w ".list.lb2") "get" index)))
+    (focus value-e)))
+
+;---- VPL display
+
+(defun detail-VPL-display (obj)
+  (define id-w (& (detail-tl-str obj) ".id"))
+  (set-id-object id-w (->object obj))
+  (set-id-value id-w (->object (inspect::eval obj)))
+  (case (inspect::typeof (inspect::eval obj))
+    ((list) (detail-VPL-display-list obj))
+    ((pair) (detail-VPL-display-pair obj))
+    ((vector) (detail-VPL-display-vector obj)))
+  (let ((index (get-VPL-index obj)))
+    (if (< index ((VPL-ilb-wid obj) "size"))
+	(set-VPL-index&value obj index)
+	(set-VPL-index&value obj 0))))
+
+(defun detail-VPL-display-list (obj)
+  (define w (detail-tl-wid obj))
+  (wm "title" w "List detailer")
+  ((widget w ".menu.help.m") "entryconfig" 2 "-label" "List detailer"
+			     "-command" "(make-help List-detailer-help)")
+  (let ((obj-val (inspect::eval obj))
+	(index-w (VPL-ilb-wid obj))
+	(value-w (VPL-vlb-wid obj))
+	(index 0))
+    (index-w "delete" 0 "end")
+    (value-w "delete" 0 "end")
+    (until (null obj-val)
+	   (index-w "insert" "end" index)
+	   (value-w "insert" "end" (->object (car obj-val)))
+	   (setq obj-val (cdr obj-val))
+	   (setq index (+ index 1)))))
+
+(defun detail-VPL-display-pair (obj)
+  (define w (detail-tl-wid obj))
+  (wm "title" w "Pair detailer")
+  ((widget w ".menu.help.m") "entryconfig" 2 "-label" "Pair detailer"
+			     "-command" "(make-help Pair-detailer-help)")
+  (let ((obj-val (inspect::eval obj))
+	(index-w (VPL-ilb-wid obj))
+	(value-w (VPL-vlb-wid obj))
+	(index 0))
+    (index-w "delete" 0 "end")
+    (value-w "delete" 0 "end")
+    (while (pair? obj-val)
+	   (index-w "insert" "end" index)
+	   (value-w "insert" "end" (->object (car obj-val)))
+	   (setq obj-val (cdr obj-val))
+	   (setq index (+ index 1)))
+    (index-w "insert" "end" (& "." index))
+    (value-w "insert" "end" (->object obj-val))))
+
+(defun detail-VPL-display-vector (obj)
+  (define w (detail-tl-wid obj))
+  (wm "title" w "Vector detailer")
+  ((widget w ".menu.help.m") "entryconfig" 2 "-label" "Vector detailer"
+			     "-command" "(make-help Vector-detailer-help)")
+  (let* ((obj-val (inspect::eval obj))
+	 (length (vector-length obj-val))
+	 (index-w (VPL-ilb-wid obj))
+	 (value-w (VPL-vlb-wid obj)))
+    (index-w "delete" 0 "end")
+    (value-w "delete" 0 "end")
+    (for ((index 0 (+ index 1)))
+	 (< index length)
+	 (index-w "insert" "end" index)
+	 (value-w "insert" "end" (->object (vector-ref obj-val index))))))
+
+;---- VPL modify
+
+(defun modify-VPL (obj)
+  (case (inspect::typeof (inspect::eval obj))
+    ((list) (modify-VPL-list obj))
+    ((pair) (modify-VPL-pair obj))
+    ((vector) (modify-VPL-vector obj))))
+
+(defun modify-VPL-list (obj)
+  (let* ((value-w (VPL-vlb-wid obj))
+	 (cmd (format NIL "(setq ~S '(" obj))
+	 (size (value-w "size")))
+    (for ((i 0 (+ i 1)))
+	 (< i size)
+	 (setq cmd (string-append cmd (->object (value-w "get" i)) " ")))
+    (setq cmd (string-append cmd "))"))
+    (eval-string cmd)))
+
+(defun modify-VPL-pair (obj)
+  (let* ((value-w (VPL-vlb-wid obj))
+	 (cmd (format NIL "(setq ~S '(" obj))
+	 (size (value-w "size"))
+	 (size-1 (- size 1)))
+    (for ((i 0 (+ i 1)))
+	 (< i size-1)
+	 (setq cmd (string-append cmd (->object (value-w "get" i)) " ")))
+    (setq cmd (string-append cmd ". " (->object (value-w "get" size-1)) "))"))
+    (eval-string cmd)))
+
+(defun modify-VPL-vector (obj)
+  (let* ((value-w (VPL-vlb-wid obj))
+	 (cmd (format NIL "(setq ~S '#(" obj))
+	 (size (value-w "size")))
+    (for ((i 0 (+ i 1)))
+	 (< i size)
+	 (setq cmd (string-append cmd (->object (value-w "get" i)) " ")))
+    (setq cmd (string-append cmd "))"))
+    (eval-string cmd)))
+
+
+
+
+;---- Procedure detailer ------------------------------------------------------
+
+(defun inspect::pretty-print (body) (pp (uncode body) NIL))
+
+(defun detail-procedure-set (obj)
+  (define text-w (widget (detail-tl-str obj) ".body.t"))
+  (eval-string (format NIL "(setq ~a ~a)" obj (text-w "get" "1.0" "end"))))
+
+(defun detail-procedure (obj)
+  (define w (create-detail-toplevel-widget obj))
+  (wm "title" w "Procedure detailer")
+  (wm "maxsize" w SCREEN_WIDTH SCREEN_HEIGHT)
+  ((widget w ".menu.help.m") "add" "command" "-label" "Procedure detailer"
+			     "-command" "(make-help Procedure-detailer-help)")
+  (pack (label (& w ".menu.set") "-text" "Set") "-side" "left")
+  (bind (widget w ".menu.set") "<ButtonPress-1>" `(detail-procedure-set ',obj))
+  (pack (frame (& w ".body") "-relief" "sunken" "-bd" 2)
+	"-fill" "both" "-expand" "yes" "-padx" 4 "-pady" 2)
+  (pack (scrollbar (& w ".body.vsb")
+		   "-orient" "vertical"
+		   "-command" (format NIL "~a \"yview\"" (& w ".body.t")))
+	"-side" "left" "-fill" "y")
+  (pack (text (& w ".body.t")
+	      "-relief" "raised" "-bd" 2 "-width" 60 "-height" 16
+	      "-yscroll" (format NIL "~a \"set\"" (& w ".body.vsb")))
+	"-fill" "both" "-expand" "yes")
+  (detail-procedure-display obj))
+
+(defun detail-procedure-display (obj)
+  (define obj-val (inspect::eval obj))
+  (define id-w (& (detail-tl-str obj) ".id"))
+  (set-id-object id-w (->object obj))
+  (set-id-value id-w (->object obj-val))
+  (define body (procedure-body obj-val))
+  (define text-w (widget (detail-tl-str obj) ".body.t"))
+  (tk-setq text-w "-state" "normal")
+  (text-w "delete" "1.0" "end")
+  (text-w "insert" "1.0" (inspect::pretty-print body))
+  (unless (symbolp obj)
+     (inspect::shadow-entry text-w)))
+
+
+;---- Widget detailer ---------------------------------------------------------
+
+(defun detail-widget (obj)
+  (define w (create-detail-toplevel-widget obj))
+  (wm "title" w "Widget detailer")
+  (tk-setq (widget w ".id.f1.l2") "-width" 40)
+  ((widget w ".menu.help.m") "add" "command" "-label" "Widget detailer"
+			     "-command" "(make-help Widget-detailer-help)")
+  (pack (menubutton (& w ".menu.bindings") "-text" "Bindings") "-side" "left")
+  (tk-setq (widget w ".menu.bindings") "-menu" (menu (& w ".menu.bindings.m")))
+  (detail-widget-create-options obj)
+  (detail-widget-display obj))
+
+(defun detail-widget-create-options (obj)
+  (define w-str (detail-tl-str obj))
+  (catch-errors (destroy (& w-str ".options")))
+  (pack (frame (& w-str ".options") "-relief" "raised" "-bd" 2)
+	"-fill" "both" "-expand" "yes" "-padx" 4 "-pady" 2)
+  (pack (frame (& w-str ".options.class")) 
+	"-side" "top" "-fill" "x" "-padx" 4 "-pady" 4)
+  (pack (label (& w-str ".options.class.l1")
+	       "-text" "Class" "-width" 16 "-anchor" "e")
+	"-side" "left")
+  (pack (label (& w-str ".options.class.l2")
+	       "-relief" "groove" "-bd" 2 "-anchor" "w" "-font" ITALIC-MEDIUM_FONT)
+	"-fill" "x")
+  (let ((options-infos ((eval obj) "config"))
+	(i 1))
+    (for-each
+     (lambda (infos)
+       (if (= 5 (length infos))
+	   (let ((option-w (& w-str ".options.f" i))
+		 (s        (symbol->string (car infos))))
+	     (pack (frame option-w) "-side" "top" "-fill" "x" "-padx" 4)
+	     (pack (label (& option-w ".l")
+			  "-text" (substring s 1 (string-length s))
+			  "-width" 16 "-anchor" "e")
+		   "-side" "left")
+	     (pack (entry (& option-w ".e") "-relief" "sunken" "-bd" 2) "-fill" "x")
+	     (bind (& option-w ".e") "<Return>"      `(WID-eval-option ',obj %W))
+	     (bind (& option-w ".e") "<Shift-Return>"`(WID-quote-option ',obj %W))
+	     (setq i (+ i 1)))))
+     options-infos))
+  (pack (frame (& w-str ".options.children"))
+	"-side" "top" "-fill" "x" "-padx" 4 "-pady" 4)
+  (pack (label (& w-str ".options.children.1")
+	       "-text" "Children" "-width" 16 "-anchor" "e")
+	"-side" "left")
+  (pack (entry (& w-str ".options.children.e")
+	       "-relief" "groove" "-bd" 2 "-state" "disabled" "-font" MEDIUM_FONT)
+	"-fill" "x")
+  (update "idletasks")
+  (define req-h (winfo "reqheight" w-str))
+  (wm "minsize" w-str 0 req-h)
+  (wm "maxsize" w-str SCREEN_WIDTH req-h))
+
+(defun WID-bindings-menu-str (obj) (& (detail-tl-str obj) ".menu.bindings.m"))
+(defun WID-bindings-menu-wid (obj)
+  (widget (detail-tl-str obj) ".menu.bindings.m"))
+
+(defun binding->string (binding)
+  (let ((binding (if (string? binding) binding (symbol->string binding))))
+    (substring binding 1 (- (string-length binding) 1))))
+
+(defun WID-bindings-menu-add (obj binding)
+  (if (catch-errors ((WID-bindings-menu-wid obj) "index" binding))
+      ((WID-bindings-menu-wid obj) "add" "command" 
+	   "-label"    (symbol->string binding)
+	   "-command" `(show-binding ',(object-symbol obj) 
+				   ,(symbol->string  binding)))))
+
+(defun show-binding (key binding)
+  (let* ((obj     (find-object-infos key))
+	 (obj-val (inspect::eval obj))
+	 (name    (string-lower (binding->string binding)))
+	 (body    (bind obj-val binding)))
+    
+    (if (null body) (setq body (bind (winfo "class" obj-val) binding)))
+    ((WID-bindings-menu-wid obj) "disable" binding)
+    (define w (& (detail-tl-str obj) "._" name))
+    (create-toplevel-widget w)
+    (wm "title" w "Widget binding")
+    (wm "maxsize" w SCREEN_WIDTH SCREEN_HEIGHT)
+    (set-id-label1 (& w ".id") "Widget" 6)
+    (set-id-object (& w ".id") (->object obj))
+    (set-id-label2 (& w ".id") "Binding" 6)
+    (set-id-value (& w ".id") binding)
+    (inspect::shadow-entry (string->widget (& w ".id.f2.e")))
+    (pack (button (& w ".menu.dismiss") 
+		  "-text" "Dismiss" 
+		  "-relief" "flat"
+		  "-command" `(progn 
+			      ((WID-bindings-menu-wid ,obj-val) 
+			       		"enable" ',binding)
+			      (destroy ,w)))
+	  "-side" "left")
+
+    (pack (button (& w ".menu.set") 
+		  "-text" "Set binding"
+		  "-relief" "flat"
+		  "-command" `(bind ,obj-val ,binding ((widget ,w ".body.t")
+						     "get" "1.0" "end")))
+	  "-side" "left")
+    (pack (frame (& w ".body") "-relief" "sunken" "-bd" 2)
+	  "-fill" "both" "-expand" "yes" "-padx" 4 "-pady" 2)
+    (pack (scrollbar (& w ".body.vsb") "-orient" "vertical")
+	  "-side" "left" "-fill" "y")
+    (pack (text (& w ".body.t") "-relief" "raised" "-bd" 2 "-width" 60 "-height" 8)
+	  "-fill" "both" "-expand" "yes")
+    ((widget w ".body.t") "insert" "1.0" (inspect::pretty-print body))))
+
+
+(defun detail-widget-display (obj)
+  (define obj-val (inspect::eval obj))
+  (define w-str (detail-tl-str obj))
+  (define id-w (widget w-str ".id"))
+  (set-id-object id-w (->object obj))
+  (set-id-value id-w (->object obj-val))
+  (tk-setq (widget w-str ".options.class.l2") "-text" (winfo "class" obj-val))
+  (define children-w (widget w-str ".options.children.e"))
+  (tk-setq children-w "-state" "normal")
+  (children-w "delete" 0 "end")
+  (children-w "insert" 0 (winfo "children" obj-val))
+  (tk-setq children-w "-state" "disabled")
+  (let ((options-infos (obj-val "config"))
+	(i 1))
+    (for-each
+     (lambda (infos)
+       (if (= 5 (length infos))
+	   (let ((option-w (widget w-str ".options.f" i ".e")))
+	     (option-w "delete" 0 "end")
+	     (option-w "insert" 0 (nth 4 infos))
+	     (setq i (+ i 1)))))
+     options-infos))
+  (define menu-w (WID-bindings-menu-wid obj))
+  (menu-w "delete" 0 "last")
+  (for-each (lambda (binding) (WID-bindings-menu-add obj binding))
+	    (bind obj-val))
+  (menu-w "add" "separator")
+  (for-each (lambda (binding) (WID-bindings-menu-add obj binding))
+	    (bind (winfo "class" obj-val))))
+
+(defun WID-eval-option (obj window)
+  (let ((parent (winfo "parent" window)))
+    (eval-string 
+     (format NIL "(tk-setq ~a "-~a" ~s)"
+	        obj
+		(tk-get (widget parent ".l") "-text")
+		(eval-string (window "get"))))))
+
+(defun WID-quote-option (obj window)
+ (let ((parent (winfo "parent" window)))
+    (eval-string 
+     (format NIL "(tk-setq ~a "-~a" ~s)"
+	        obj
+		(tk-get (widget parent ".l") "-text")
+		(window "get")))))
diff --git a/src/tk/insp-help.lsp b/src/tk/insp-help.lsp
new file mode 100644
index 000000000..3f50fda2f
--- /dev/null
+++ b/src/tk/insp-help.lsp
@@ -0,0 +1,358 @@
+;******************************************************************************
+;
+; Project       : STk-inspect, a graphical debugger for STk
+;
+; File name     : inspect-help.stk
+; Creation date : Sep-16-1993
+; Last update   : Sep-17-1993
+;
+;******************************************************************************
+;
+; This file contains help variables.
+;
+;******************************************************************************
+
+(in-package "TK")
+
+(provide "inspect-help")
+
+(define STk-inspect-help '("STF-0.1" "
+STk-inspect\n\n
+STk-inspect is a graphical inspector for STk (the Scheme/Tk based language).
+
+It is the firt step toward a more general debugger . For now, it only permits to visualize and modify STk objects. 
+
+Original code written by Eric Fintzel (fintzel@kaolin.unice.fr)
+Hacked for version 2 by Erick Gallesio (eg@unice.fr)
+" ((bold-italic-12 ("5.0" "5.11" "5.41" "5.44")) (roman-18 ("2.0" "2.11")) (fixed ("9.39" "9.62" "10.40" "10.51")) (normal ("2.11" "5.0")))))
+
+;---- Help for (inspect,help) "General inspector"
+
+(define General-Inspector-help '("STF-0.1" "
+General inspector
+
+
+The General inspector is the simplest tool to trace STk objects. It allows you to watch and modify every kind of object.
+
+To inspect an object
+
+You can use the STk 
+
+        (inspect object) 
+
+command. For instance, if you want to inspect the variable my-variable, just type:
+          STk> (inspect 'my-variable)
+
+You can also select the Inspect option in an other STk-inspect tool (detailer, viewer,...).
+
+To uninspect an object
+
+You can use the STk
+
+        (uninspect object) 
+
+command, or you can select the Uninspect option in the Icon menu associated with the object line inspector.
+
+Screen organization                   
+
+The General inspector is a toplevel window divided in 2 areas: a menu bar and a list of all inspected objects.
+
+Menu area
+Menu area comports two buttons:
+
+         Command menu
+         The Uninspect all option uninspects all inspected objects and destroy the           General inspector window.
+         The Undebug option destroys all the STk-inspect toplevel windows.
+
+         Help menu
+         The STk-inspect option gives a general help about STk-inspect.
+         The General inspector option gives this help.
+
+Inspected objects area
+Each line of the list concerns one object, a line is divided in 3 fields:
+
+        The Object field contains the inspected object.
+
+        The Value field contains the value of the object (the result of the object evaluation). You can modify the object by editing this field. A <Return> validation affects to the object the result of the field contents evaluation, while a <Shift-Return> validation  affects to the object the field contents without evaluation.
+
+        The Icon provides actions on the object.
+" ((bold-italic-12 ("7.0" "7.20" "18.0" "18.22" "26.0" "26.19" "38.13" "38.24")) (italic-12 ("16.69" "16.89" "24.31" "24.40" "28.65" "28.73" "28.80" "28.84" "33.9" "34.0" "34.13" "34.26" "35.13" "35.20" "37.9" "38.0" "39.13" "39.30" "44.12" "44.19" "46.12" "46.18" "48.12" "48.16")) (roman-18 ("2.0" "2.17")) (roman-12 ("7.20" "8.0" "30.0" "30.9" "41.0" "41.22")) (fixed ("11.8" "11.24" "13.59" "13.70" "14.10" "14.37" "22.8" "22.26" "46.147" "46.155" "46.242" "46.257")) (underline ("2.0" "3.0" "7.0" "7.20" "18.0" "18.22" "26.0" "26.19" "33.9" "34.0" "37.9" "38.0")))))
+
+
+;---- Help for (detail,help) "Detailer"
+
+(define Detailer-help '("STF-0.1" "
+Detailer
+
+A detailer is a STk-inspect tool which allows you to see STk objects with more details.
+
+For instance, a list detailer shows you the structure of a list where you can edit each element of the list; a procedure detailer permits you to edit the body of a procedure; a widget detailer allows you to access directly the whole option fields of a widget; and so on...
+
+For now, there are detailers for lists, pairs vectors, procedures and widgets.
+
+To detail an object
+
+You can use the STk 
+
+        (detail object)
+
+command. For example, if you want to detail the list my-list, type:
+
+        STk> (detail my-list)
+
+You can also select the Detail option in an other STk-inspect tool (inspector, viewer, ...).
+
+To undetail an object
+
+You can use the STk 
+
+        (undetail object)
+
+command or you can select the Undetail option in the Command menu of the object detailer window.
+" ((bold-italic-12 ("10.0" "10.19" "22.0" "22.21")) (italic-12 ("6.16" "6.29" "6.111" "6.130" "6.177" "6.192" "8.33" "8.77" "16.53" "16.60" "20.24" "20.30" "20.68" "20.77" "20.79" "20.90" "22.21" "23.0" "28.30" "28.38" "28.53" "28.65")) (roman-18 ("2.0" "2.8")) (fixed ("14.8" "14.23" "18.8" "19.0" "26.8" "26.25")) (underline ("2.0" "2.8" "10.0" "10.19" "22.0" "23.0")))))
+
+;---- Help for (detail,help) "List detailer"
+
+(define List-detailer-help '("STF-0.1" "
+List detailer
+
+
+A list detailer is a STk-inspect tool which shows you the structure of a list.
+
+The list detailer window is divided in 3 areas:
+the Id area, a menu bar and the elements list.
+
+Id area
+
+This area identifies the list you detail, it contains 2 fields:
+
+        The object field contains the object detailed.
+
+        The Value field contains the value of the object (a list resulting of the object evaluation). You can modify the object by editing this field. A  <Return> validation affects to the object the result of the field contents evaluation, while a <Shift-Return> validation affects to the object the field contents without evaluation.
+
+After a modification, if the object type is no more a list, the detailer is adapted.
+
+
+Menu bar
+
+Two sub-menus are provided:
+
+        Command menu
+        The Inspect  option calls the General inspector for the detailed object.
+        The Undetail option destroys the list detailer window.
+        The View option calls the Viewer for the detailed object.
+
+        Help menu
+        The STk-inspect option gives a general help about STk-inspect.
+        The Detailer option gives a general help about detailers tools.
+        The List detailer option gives this help.
+
+Elements list
+
+This area displays all the elements of the detailed list (with indexes). You can select a particular element with mouse button 1, its value will appear on the Value <index> entry, and you can modify it (validation of your entry can be done using the current way: <Return> and <Shift-Return>)).
+" ((tty-12 ("16.154" "16.162" "16.249" "16.264" "37.160" "37.174" "37.264" "37.272" "37.277" "37.292")) (bold-italic-12 ("10.0" "10.7" "21.0" "22.0" "35.0" "35.13")) (italic-12 ("8.4" "8.11" "8.15" "8.24" "8.32" "8.45" "14.12" "14.18" "16.12" "16.17" "25.8" "25.20" "26.12" "26.21" "27.12" "27.20" "28.12" "28.16" "30.8" "31.0" "31.12" "31.23" "32.12" "32.20" "33.12" "33.25")) (roman-18 ("2.0" "2.13")) (underline ("2.0" "2.13" "10.0" "10.7" "21.0" "22.0" "25.8" "25.20" "30.8" "31.0" "35.0" "35.13")))))
+
+
+
+;---- Help for (detail,help) "Pair detailer"
+
+(define Pair-detailer-help '("STF-0.1" "
+Pair detailer
+
+
+A pair detailer is a STk-inspect tool which shows you the structure of a pair.
+
+The pair detailer window is divided in 3 areas:
+the Id area, a menu bar and the elements list.
+
+Id area
+
+This area identifies the pair you detail, it contains 2 fields:
+
+        The object field contains the object detailed.
+
+        The Value field contains the value of the object (a pair resulting of the object evaluation). You can modify the object by editing this field. A  <Return> validation affects to the object the result of the field contents evaluation, while a <Shift-Return> validation affects to the object the field contents without evaluation.
+
+After a modification, if the object type is no more a pair, the detailer is adapted.
+
+
+Menu bar
+
+Two sub-menus are provided:
+
+        Command menu
+        The Inspect  option calls the General inspector for the detailed object.
+        The Undetail option destroys the pair detailer window.
+        The View option calls the Viewer for the detailed object.
+
+        Help menu
+        The STk-inspect option gives a general help about STk-inspect.
+        The Detailer option gives a general help about detailers tools.
+        The List detailer option gives this help.
+
+Elements list
+
+This area displays all the elements of the detailed list (with indexes). Note that the last element has a pointed index. You can select a particular element with mouse button 1, its value will appear on the Value <index> entry, and you can modify it (validation of your entry can be done using the current way: <Return> and <Shift-Return>)).
+" ((tty-12 ("16.154" "16.162" "16.249" "16.264" "37.207" "37.221" "37.311" "37.319" "37.324" "37.339")) (bold-italic-12 ("10.0" "10.7" "21.0" "22.0" "35.0" "35.13")) (italic-12 ("8.4" "8.11" "8.15" "8.24" "8.32" "8.45" "14.12" "14.18" "16.12" "16.17" "25.8" "25.20" "26.12" "26.21" "27.12" "27.20" "28.12" "28.16" "30.8" "31.0" "31.12" "31.23" "32.12" "32.20" "33.12" "33.25")) (roman-18 ("2.0" "2.13")) (underline ("2.0" "2.13" "10.0" "10.7" "21.0" "22.0" "25.8" "25.20" "30.8" "31.0" "35.0" "35.13"))))
+)
+
+
+;---- Help for (detail,help) "Vector detailer"
+
+(define Vector-detailer-help '("STF-0.1" "
+Vector detailer
+
+
+A vector detailer is a STk-inspect tool which shows you the structure of a vector.
+
+The vector detailer window is divided in 3 areas:
+the Id area, a menu bar and the elements list.
+
+Id area
+
+This area identifies the vector you detail, it contains 2 fields:
+
+        The object field contains the object detailed.
+
+        The Value field contains the value of the object (a vector resulting of the object evaluation). You can modify the object by editing this field. A  <Return> validation affects to the object the result of the field contents evaluation, while a <Shift-Return> validation affects to the object the field contents without evaluation.
+
+After a modification, if the object type is no more a vector, the detailer is adapted.
+
+
+Menu bar
+
+Two sub-menus are provided:
+
+        Command menu
+        The Inspect  option calls the General inspector for the detailed object.
+        The Undetail option destroys the vector detailer window.
+        The View option calls the Viewer for the detailed object.
+
+        Help menu
+        The STk-inspect option gives a general help about STk-inspect.
+        The Detailer option gives a general help about detailers tools.
+        The List detailer option gives this help.
+
+Elements list
+
+This area displays all the elements of the detailed vector (with indexes). Note that the last element has a pointed index. You can select a particular element with mouse button 1, its value will appear on the Value <index> entry, and you can modify it (validation of your entry can be done using the current way: <Return> and <Shift-Return>)).
+" ((tty-12 ("16.156" "16.164" "16.251" "16.266" "37.209" "37.223" "37.313" "37.321" "37.326" "37.341")) (bold-italic-12 ("10.0" "10.7" "21.0" "22.0" "35.0" "35.13")) (italic-12 ("8.4" "8.11" "8.15" "8.24" "8.32" "8.45" "14.12" "14.18" "16.12" "16.17" "25.8" "25.20" "26.12" "26.21" "27.12" "27.20" "28.12" "28.16" "30.8" "31.0" "31.12" "31.23" "32.12" "32.20" "33.12" "33.25")) (roman-18 ("2.0" "3.0")) (underline ("2.0" "3.0" "10.0" "10.7" "21.0" "22.0" "25.8" "25.20" "30.8" "31.0" "35.0" "35.13"))))
+)
+
+
+;---- Help for (detail,help) "Procedure detailer"
+
+(define Procedure-detailer-help '("STF-0.1" "
+Procedure detailer
+
+
+A procedure detailer is a STk-inspect tool which allows you to see and edit the body of a procedure.
+
+The procedure detailer window is divided in 3 areas:
+the Id area, a menu bar and the body area.
+
+Id area
+
+This area identifies the procedure you detail, it contains 2 fields:
+
+        The object field contains the object detailed.
+
+        The Value field contains the value of the object (a procedure resulting of the object evaluation). You can modify the object by editing this field. A  <Return> validation affects to the object the result of the field contents evaluation, while a <Shift-Return> validation affects to the object the field contents without evaluation.
+
+After a modification, if the object type is no more a procedure, the detailer is adapted.
+
+
+Menu bar
+
+Two sub-menus are provided:
+
+        Command menu
+        The Inspect  option calls the General inspector for the detailed object.
+        The Undetail option destroys the procedure detailer window.
+        The View option calls the Viewer for the detailed object.
+
+        Help menu
+        The STk-inspect option gives a general help about STk-inspect.
+        The Detailer option gives a general help about detailers tools.
+        The List detailer option gives this help.
+
+Body area
+
+This area displays the procedure body, and allows you to edit it." ((tty-12 ("16.156" "16.164" "16.251" "16.266")) (bold-italic-12 ("10.0" "10.7" "21.0" "22.0" "35.0" "37.0")) (italic-12 ("8.4" "8.11" "8.15" "8.24" "8.32" "8.41" "14.12" "14.18" "16.12" "16.17" "25.8" "25.20" "26.12" "26.21" "27.12" "27.20" "28.12" "28.16" "30.8" "31.0" "31.12" "31.23" "32.12" "32.20" "33.12" "33.25")) (roman-18 ("2.0" "3.0")) (normal ("37.0" "37.65")) (underline ("2.0" "3.0" "10.0" "10.7" "21.0" "22.0" "25.8" "25.20" "30.8" "31.0" "35.0" "37.0"))))
+)
+
+
+;---- Help for (detail,help) "Widget detailer"
+
+(define Widget-detailer-help '("STF-0.1" "
+Widget detailer
+
+
+A widget detailer is a STk-inspect tool which allows you to see and edit the characteristics of a widget.
+
+The widget detailer window is divided in 3 areas:
+the Id area, a menu bar and the option area.
+
+Id area
+
+This area identifies the widget you detail, it contains 2 fields:
+
+        The object field contains the object detailed.
+
+        The Value field contains the widget name of the object.
+
+After a modification, if the object type is no more a widget, the detailer is adapted.
+
+
+Menu bar
+
+Three sub-menus are provided:
+
+        Command menu
+        The Inspect  option calls the General inspector for the detailed object.
+        The Undetail option destroys the widget detailer window.
+        The View option calls the Viewer for the detailed object.
+
+         Bindings menu
+        This menu contains all the bindings associated with the widget (the widget bindings are listed before the widget class bindings). You can select a binding to edit it.
+
+        Help menu
+        The STk-inspect option gives a general help about STk-inspect.
+        The Detailer option gives a general help about detailers tools.
+        The Widget detailer option gives this help.
+
+Option area
+
+This area displays all the options of the detailed widget. You can edit an option using the current way <Return> and <Shift-Return>" ((tty-12 ("40.104" "40.113" "40.117" "40.131")) (bold-italic-12 ("10.0" "10.7" "21.0" "22.0" "38.0" "40.0")) (italic-12 ("8.4" "8.11" "8.15" "8.24" "8.32" "8.43" "14.12" "14.18" "16.12" "16.17" "25.8" "25.20" "26.12" "26.21" "27.12" "27.20" "28.12" "28.16" "30.8" "31.0" "33.8" "34.0" "34.12" "34.23" "35.12" "35.20" "36.12" "36.27")) (roman-18 ("2.0" "3.0")) (normal ("31.0" "33.0" "40.0" "40.104" "40.113" "40.117")) (underline ("2.0" "3.0" "10.0" "10.7" "21.0" "22.0" "25.8" "25.20" "30.8" "31.0" "33.8" "34.0" "38.0" "40.0"))))
+)
+
+
+;---- Help for (view,help) "Viewer"
+
+(define Viewer-help '("STF-0.1" "
+Viewer
+
+A viewer is a STk-inspect tool which gives you a graphical representation of STk objects.
+
+All object types can be viewed; particular viewer are provided for procedures and widgets.
+
+To view an object
+
+You can use the STk 
+
+         (view object) 
+
+command. For example, if you want to view the list my-list, type:
+
+        (view 'my-list)
+
+You can also select the View option in an other STk-inspect tool.
+
+To unview an object
+
+You can use the STk 
+
+        (unview object) 
+
+command. Or you can select the Unview option in the Command menu of the object viewer window." ((tty-12 ("12.9" "13.0" "14.51" "14.59" "16.8" "17.0" "24.8" "24.24")) (bold-italic-12 ("8.0" "8.17" "20.0" "21.0")) (italic-12 ("6.67" "6.77" "6.82" "6.89" "18.24" "18.28" "26.31" "26.37" "26.52" "26.59")) (roman-18 ("2.0" "2.6")) (underline ("2.0" "2.6" "8.0" "8.17" "20.0" "21.0"))))
+)
diff --git a/src/tk/insp-main.lsp b/src/tk/insp-main.lsp
new file mode 100644
index 000000000..fbbb75d22
--- /dev/null
+++ b/src/tk/insp-main.lsp
@@ -0,0 +1,196 @@
+;******************************************************************************
+;
+; Project       : STk-inspect, a graphical debugger for STk
+;
+; File name     : inspect-main.stk
+; Creation date : Aug-10-1993
+; Last update   : Sep-17-1993
+;
+; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;
+;******************************************************************************
+;
+; This file implements the "General inspector".
+;
+;******************************************************************************
+
+(in-package "TK")
+
+(provide "inspect-main")
+(require "inspect-misc")
+(require "inspect-view")
+(require "inspect-detail")
+(require "inspect-help")
+
+(defvar INSPECTOR_WIDGET_NAME 	 ".inspector")
+(defvar inspected-objects-list   ())
+
+(defun inspected? (obj) (member obj inspected-objects-list))
+
+(defun inspect-frame-wid (obj)
+  (widget INSPECTOR_WIDGET_NAME ".f1." (object-symbol obj)))
+(defun inspect-frame-str (obj)
+  (& INSPECTOR_WIDGET_NAME ".f1." (object-symbol obj)))
+
+(defun inspect-l-wid (obj) (widget (inspect-frame-str obj) ".l"))
+(defun inspect-l-str (obj) (& (inspect-frame-str obj) ".l"))
+(defun inspect-e-wid (obj) (widget (inspect-frame-str obj) ".e"))
+(defun inspect-e-str (obj) (& (inspect-frame-str obj) ".e"))
+(defun inspect-mb-wid (obj) (widget (inspect-frame-str obj) ".mb"))
+(defun inspect-mb-str (obj) (& (inspect-frame-str obj) ".mb"))
+(defun inspect-m-str (obj) (& (inspect-frame-str obj) ".mb.m"))
+(defun inspect-m-wid (obj) (widget (inspect-frame-str obj) ".mb.m"))
+
+
+;---- Inspector menu
+
+(defun create-inspect-menu (obj)
+  (let ((w (eval (menu (inspect-m-str obj)))))
+    (funcall w "add" "command" "-label" "Uninspect" 
+	     "-command" `(inspect-menu-Uninspect ',(object-symbol obj)))
+    (funcall w "add" "command" "-label" "Detail"
+	     "-command" `(inspect-menu-Detail ',(object-symbol obj)))
+    (if (detailed? obj) ((inspect-m-wid obj) "disable" "Detail"))
+    (funcall w "add" "command" "-label" "View" 
+	     "-command" `(inspect-menu-View ',(object-symbol obj)))
+    (if (viewed? obj) ((inspect-m-wid obj) "disable" "View")))
+  )
+
+(defun inspect-menu-Eval (obj)
+  (set obj (eval (funcall (inspect-e-wid obj) "get"))))
+
+(defun inspect-menu-Quote (obj)
+  (set obj (funcall (inspect-e-wid obj) "get")))
+
+(defun inspect-menu-Uninspect (key)
+  (uninspect (find-object-infos  key)))
+
+(defun inspect-menu-Detail (key)
+  (let ((obj (find-object-infos  key)))
+    (detail obj)
+    (funcall (inspect-m-wid obj) "disable" "Detail")
+    (if (viewed? obj) (funcall (view-m-wid obj) "disable" "Detail"))))
+
+(defun inspect-menu-View (key)
+  (let ((obj (find-object-infos  key)))
+    (view obj)
+    (funcall (inspect-m-wid obj) "disable" "View")
+    (if (detailed? obj) (funcall (detail-m-wid obj) "disable" "View"))))
+
+(defun create-inspector ()
+  (let ((w (toplevel INSPECTOR_WIDGET_NAME)))
+    (wm "title" w "General inspector")
+    (wm "maxsize" w SCREEN_WIDTH SCREEN_HEIGHT)
+    (define menu-w (create-menu-widget (& INSPECTOR_WIDGET_NAME ".menu")))
+    (pack menu-w "-side" "top" "-fill" "x" "-padx" 4 "-pady" 2)
+    (funcall (widget menu-w ".help.m") "add" "command" "-label" "General inspector"
+     "-command" "(make-help General-Inspector-help)")
+    (pack (menubutton (& INSPECTOR_WIDGET_NAME ".menu.command") "-text" "Command")
+	  "-side" "left")
+    (define cmd-w (eval (menu (& INSPECTOR_WIDGET_NAME ".menu.command.m"))))
+    (cmd-w "add" "command" "-label" "Uninspect all"
+	   "-command" "(destroy-inspector)")
+    (cmd-w "add" "command" "-label" "Undebug" "-command" "(undebug)")
+    (tk-setq (widget INSPECTOR_WIDGET_NAME ".menu.command") "-menu" cmd-w)
+    (pack (frame (& INSPECTOR_WIDGET_NAME ".caption"))
+	  "-side" "top" "-fill" "x" "-padx" 4)
+    (pack (label (& INSPECTOR_WIDGET_NAME ".caption.l1")
+		 "-text" "Objects" "-width" 20)
+	  "-side" "left")
+    (pack (label (& INSPECTOR_WIDGET_NAME ".caption.l2")
+		 "-text" "Values" "-width" 40)
+	  "-side" "left" "-padx" 4)
+    (pack (frame (& INSPECTOR_WIDGET_NAME ".f1"))
+	  "-fill" "both" "-expand" "yes" "-padx" 4 "-pady" 2))
+  )
+
+(defun destroy-inspector () 
+  (mapcar #'uninspect-object inspected-objects-list))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; inspect
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun inspect (obj)
+  (when (= (winfo "exist" INSPECTOR_WIDGET_NAME) 0) (create-inspector))
+  ;; Kludge to avoid problems . Should be modified (eg)
+  (let ((obj-val (inspect::eval obj)))
+    (when (equal (inspect::typeof obj-val) "widget")
+	  (setq obj obj-val)))
+
+  (unless (inspected? obj)
+     (inspect-object obj)
+     (let ((obj-val (format NIL "~S" (inspect::eval obj))))
+       (pack (frame (inspect-frame-str obj)) "-side" "top" "-fill" "x")
+       (pack (menubutton (inspect-mb-str obj)
+			 "-relief" "raised" "-bd" 2 "-bitmap" BITMAP_MENU)
+	     "-side" "right")
+       (pack (label (inspect-l-str obj) "-relief" "groove" "-bd" 2
+		    "-anchor" "w" "-text" (format NIL "~S" obj)
+		    "-width" 20 "-font" MEDIUM_FONT)
+	     "-side" "left")
+       (pack (entry (inspect-e-str obj) "-relief" "sunken" "-bd" 2 "-width" 40) 
+	     "-fill" "x" "-expand" "yes" "-padx" 4)
+       (create-inspect-menu obj)
+       (tk-setq (inspect-mb-wid obj) "-menu" (inspect-m-wid obj))
+       
+       (let ((E (inspect-e-wid obj)))
+	 (E "insert" 0 obj-val)
+
+	 ;; If obj is a symbol, lets the entry modifiable. Otherwise let it as is
+	 (if (modifiable-object? obj)
+	     (begin
+	       (bind E "<Return>" 	`(inspect-menu-Eval ',obj))
+	       (bind E "<Shift-Return>" `(inspect-menu-Quote ',obj)))
+	     (inspect::shadow-entry E)))))
+
+  ;; Destroy Event -> set the list of inspected object to '()
+  (bind  INSPECTOR_WIDGET_NAME "<Destroy>" '(setq inspected-objects-list '()))
+
+  ;; Allow resizing only in width
+  (update "idletasks")
+  (let ((req-h (winfo "reqheight" INSPECTOR_WIDGET_NAME)))
+    (wm "minsize" INSPECTOR_WIDGET_NAME 0 req-h)
+    (wm "maxsize" INSPECTOR_WIDGET_NAME SCREEN_WIDTH req-h)
+    (wm "geometry" INSPECTOR_WIDGET_NAME 
+	(& (winfo "width" INSPECTOR_WIDGET_NAME) "x" req-h))))
+
+(defun inspect-object (obj)
+  (setq inspected-objects-list (cons obj inspected-objects-list))
+  (unless (object-infos obj)
+	  (add-object-infos obj)
+	  (if (symbolp obj) (trace-var obj `(update-object ',obj)))))
+
+(defun inspect-display (obj)
+  (let ((entry-w (inspect-e-wid obj)))
+    (entry-w "delete" 0 "end")
+    (entry-w "insert" 0 (->object (eval obj)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; uninspect
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun uninspect (obj)
+  (when (inspected? obj) (uninspect-object obj))     
+  (update "idletasks")
+  (when (= (winfo "exist" INSPECTOR_WIDGET_NAME) 1)
+	(let ((req-h (winfo "reqheight" INSPECTOR_WIDGET_NAME)))
+	  (wm "minsize" INSPECTOR_WIDGET_NAME 0 req-h)
+	  (wm "maxsize" INSPECTOR_WIDGET_NAME SCREEN_WIDTH req-h)
+	  (wm "geometry" INSPECTOR_WIDGET_NAME 
+	      (& (winfo "width" INSPECTOR_WIDGET_NAME) "x" req-h)))))
+
+
+(defun uninspect-object (obj)
+  (setq inspected-objects-list (list-remove obj inspected-objects-list))
+  (destroy (inspect-frame-wid obj))
+  (when (null inspected-objects-list) (destroy INSPECTOR_WIDGET_NAME))
+  (if (detailed? obj) (funcall (detail-m-wid obj) "enable" "Inspect"))
+  (if (viewed? obj)   (funcall (view-m-wid obj)   "enable" "Inspect"))
+  (unless (or (detailed? obj) (viewed? obj))
+	  (remove-object-infos obj)
+	  (if (symbolp obj) (untrace-var obj))))
diff --git a/src/tk/insp-misc.lsp b/src/tk/insp-misc.lsp
new file mode 100644
index 000000000..bf2a76111
--- /dev/null
+++ b/src/tk/insp-misc.lsp
@@ -0,0 +1,296 @@
+;******************************************************************************
+;
+; Project       : STk-inspect, a graphical debugger for STk
+;
+; File name     : inspect-misc.stk
+; Creation date : Aug-30-1993
+; Last update   : Sep-17-1993
+;
+;******************************************************************************
+;
+; This file contains definitions often used.
+;
+;******************************************************************************
+
+(in-package "TK")
+
+(provide "inspect-misc")
+
+(defvar BITMAP_MENU 		(& "@" tk_library "/bitmaps/menu.bm"))
+(defvar FIXED_FONT 		"-adobe-courier-bold-r-*-*-*-140-*-*-*-*-*-*")
+(defvar MEDIUM_FONT 		"-adobe-helvetica-medium-r-*-*-*-120-*-*-*-*-*-*")
+(defvar BOLD_FONT 		"-adobe-helvetica-bold-r-*-*-*-120-*-*-*-*-*-*")
+(defvar ITALIC-MEDIUM_FONT 	"-adobe-helvetica-medium-o-*-*-*-120-*-*-*-*-*-*")
+
+(defvar COURIER_BR14 		"-adobe-courier-bold-r-*-*-*-140-*-*-*-*-*-*")
+(defvar HELVETICA_BR12 		"-adobe-helvetica-bold-r-*-*-*-120-*-*-*-*-*-*")
+(defvar HELVETICA_BO12 		"-adobe-helvetica-bold-o-*-*-*-120-*-*-*-*-*-*")
+(defvar HELVETICA_MR12 		"-adobe-helvetica-medium-r-*-*-*-120-*-*-*-*-*-*")
+(defvar HELVETICA_MO12 		"-adobe-helvetica-medium-o-*-*-*-120-*-*-*-*-*-*")
+(defvar HELVETICA_MO10 		"-adobe-helvetica-medium-o-*-*-*-100-*-*-*-*-*-*")
+(defvar SCREEN_WIDTH		(winfo "vrootwidth"  *root*))
+(defvar SCREEN_HEIGHT		(winfo "vrootheight" *root*))
+
+
+;******************************************************************************
+;
+; General definitions and macros extending STk.
+;
+;******************************************************************************
+
+;---- A special eval
+(defun inspect::eval (x)
+  (if (and (symbolp x) (symbol-bound? x)) (eval x) x))
+
+;---- Predicates
+
+(defmacro not-equal (x y) `(not (equal ,x ,y)))
+(defmacro different? (x y) `(not (equal ,x ,y)))
+
+;---- Operators
+
+(defmacro <> (x y)
+  `(not (= ,x ,y)))
+
+;---- Display
+
+(defun write\n (&rest l)
+  (until (null l)
+         (write (car l))
+         (setq l (cdr l)))
+  (newline))
+
+(defun display\n (&rest l)
+  (until (null l)
+         (display (car l))
+         (setq l (cdr l)))
+  (newline))
+
+
+;---- Control structures
+
+(defmacro for (var test . body)
+  `(do ,var
+       ((not ,test))
+       ,@body))
+
+;---- Strings
+
+(defun ->string (obj)
+  (if (widget? obj)
+      (widget->string obj)
+      (format NIL "~A" obj)))
+
+(defun ->object (obj)
+  (if (widget? obj)
+      (widget->string obj)
+      (format NIL "~S" obj)))
+
+(defun list->str (l)
+  (if (null l)
+      ""
+      (let loop ((l l) (s ""))
+        (let ((car-l (car l)) (cdr-l (cdr l)) (elem ()))
+          (if (list? car-l)
+              (setq elem (string-append "(" (list->str car-l) ")"))
+              (setq elem (->string car-l)))
+          (if (null cdr-l)
+              (string-append s elem)
+              (loop cdr-l (string-append s elem " ")))))))
+
+;---- Vectors
+
+(defun vector-index (v value)
+  (let ((length (vector-length v))
+        (index NIL))
+    (for ((i (- length 1) (- i 1)))
+         (>= i 0)
+         (if (equal (vector-ref v i) value) (setq index i)))
+    index))
+
+
+;---- Lists
+
+(defun list-first (obj lst)
+  (defun _list-first (obj lst index)
+    (cond ((null lst) NIL)
+          ((equal obj (car lst)) index)
+          (else (_list-first obj (cdr lst) (+ index 1)))))
+  (_list-first obj lst 0))
+
+
+(defmacro list-set! (lst index value)
+  `(progn
+     (setq ,lst (list->vector ,lst))
+     (vector-set! ,lst ,index ,value)
+     (setq ,lst (vector->list ,lst))))
+
+
+(defun list-remove (obj lst)
+  (defun _list-remove (obj lst prev-lst)
+    (cond ((null lst) prev-lst)
+          ((equal obj (car lst)) (append prev-lst (cdr lst)))
+          (else (_list-remove obj (cdr lst) (append prev-lst
+                                                    (list (car lst)))))))
+  (_list-remove obj lst ()))
+
+
+;---- Tk goodies
+
+(defmacro widget (&rest etc)
+  `(string->widget (& ,@etc)))
+
+(defun && (&rest l)
+  (if (null l)
+      ""
+      (let loop ((l l) (s ""))
+        (if (null (cdr l))
+            (string-append s (->string (car l)))
+            (loop (cdr l) (string-append s (->string (car l)) " "))))))
+
+(defmacro tki-get (canvas item option)
+  `(nth 2 (funcall ,canvas 'itemconfigure ,item ,option)))
+
+(defmacro tki-set (canvas item option value)
+  `(funcall ,canvas 'itemconfigure ,item ,option ,value))
+
+(defmacro @ (x y)
+  `(& "@" ,x "," ,y))
+
+;******************************************************************************
+;
+; 
+;
+;******************************************************************************
+
+(define objects-infos-list ())
+
+(defun object-infos (obj)  (assoc obj objects-infos-list))
+(defun object-type (obj)   (nth 1 (object-infos obj)))
+(defun object-symbol (obj) (nth 2 (object-infos obj)))
+
+(defun add-object-infos (obj)
+  (setq objects-infos-list
+	(cons (list obj (inspect::typeof obj) (gensym "__g"))
+	      objects-infos-list)))
+
+(defun remove-object-infos (obj)
+  (setq objects-infos-list
+	(list-remove (object-infos obj) objects-infos-list)))
+
+(defun find-object-infos (key)
+  (let ((found NIL))
+    (do ((l objects-infos-list (cdr l)))
+	((or found (null l)) found)
+      (when (equal (nth 2 (car l)) key) 
+	    (setq found (nth 0 (car l)))))))
+
+(defun detailer-type (obj-type)
+  (case obj-type
+    ((vector pair list) 'VPL)
+    ((procedure) 'PROCEDURE)
+    ((widget) 'WIDGET)
+    (else 'UNKNOWN)))
+
+(defun viewer-type (obj-type)
+  (case obj-type
+    ((procedure) 'PROCEDURE)
+    ((widget) 'WIDGET)
+    (else 'GENERAL)))
+
+(defun update-object (obj)
+  (let* ((obj-val (inspect::eval obj))
+	 (old-type (object-type obj))
+	 (obj-type (inspect::typeof obj-val)))
+    (unless (equal old-type obj-type)
+	    (let ((obj-sym (object-symbol obj)))
+	      (remove-object-infos obj)
+	      (setq objects-infos-list
+		    (cons (list obj obj-type obj-sym) objects-infos-list))))
+    (if (inspected? obj) (inspect-display obj))
+    (if (detailed? obj)
+	(if (equal (detailer-type old-type) (detailer-type obj-type))
+	    (detail-display obj)
+	    (progn
+	      (undetail obj)
+	      (if (different? 'UNKNOWN (detailer-type obj-type)) 
+		  (detail obj)))))
+    (if (viewed? obj)
+	(if (equal (viewer-type old-type) (viewer-type obj-type))
+	    (view-display obj)
+	    (progn
+	      (unview obj)
+	      (view obj))))))
+
+;---- Undebug
+
+(defun undebug ()
+  (for-each (lambda (obj-infos)
+	      (let ((obj (car obj-infos)))
+		(if (symbolp obj) (untrace-var obj))))
+	    objects-infos-list)
+  (destroy INSPECTOR_WIDGET_NAME)
+  (setq inspected-objects-list ())
+  (for-each (lambda (obj) (destroy (detail-tl-wid obj))) detailed-objects-list)
+  (setq detailed-objects-list ())
+  (for-each (lambda (obj) (destroy (view-tl-wid obj))) viewed-objects-list)
+  (setq viewed-objects-list ())
+  (setq objects-infos-list ()))
+
+;---- id widget
+
+(defun create-id-widget (str)
+  (define wid (frame str))
+  (pack (frame (& str ".f1")) "-side" "top" "-fill" "x")
+  (pack (label (& str ".f1.l1") "-anchor" "w") "-side" "left")
+  (pack (label (& str ".f1.l2") 
+	       "-relief" "groove" "-bd" 2 "-anchor" "w" "-font" MEDIUM_FONT)
+	"-fill" "x" "-expand" "yes")
+  (pack (frame (& str ".f2")) "-side" "top" "-fill" "x")
+  (pack (label (& str ".f2.l") "-anchor" "w") "-side" "left")
+  (pack (entry (& str ".f2.e") "-relief" "sunken" "-bd" 2)
+	"-fill" "x" "-expand" "yes")
+  wid)
+
+(defun set-id-label1 (wid text width) 
+  ((widget wid ".f1.l1") 'config "-text" text "-width" width))
+(defun set-id-label2 (wid text width)
+  ((widget wid ".f2.l") 'config "-text" text "-width" width))
+
+(defun set-id-object (wid text) (tk-setq (widget wid ".f1.l2") "-text" text))
+(defun get-id-object (wid) (tk-get (widget wid ".f1.l2") "-text"))
+(defun set-id-value (wid text)
+  ((widget wid ".f2.e") "delete" 0 "end")
+  ((widget wid ".f2.e") "insert" 0 text))
+(defun get-id-value (wid) ((widget wid ".f2.e") 'get))
+
+
+;---- menu widget
+
+(defun create-menu-widget (str)
+  (define wid (frame str "-relief" "raised" "-bd" 2))
+  (pack (menubutton (& str ".help") "-text" "Help") "-side" "right")
+  (tk-setq (widget str ".help") "-menu" (menu (& str ".help.m")))
+  ((widget str ".help.m") "add" "command" "-label" "STk-inspect"
+			  "-command" '(make-help STk-inspect-help))
+  wid)
+
+
+;---- toplevel widget
+
+(defun create-toplevel-widget (str)
+  (define wid (toplevel str))
+  (pack (create-id-widget (& str ".id")) "-side" "top" "-fill" "x" "-padx" 4 "-pady" 2)
+  (pack (create-menu-widget (& str ".menu"))
+	"-side" "top" "-fill" "x" "-padx" 4 "-pady" 2)
+  wid)
+
+(defun inspect::shadow-entry (e)
+  (tk-setq e "-state" "disabled")
+  (tk-setq e "-bd" 1)
+  (tk-setq e "-bg" "grey50")
+  (tk-setq e "-fg" "grey95"))
+  
+
+(defun modifiable-object? (obj)
+  (and (symbolp obj) (symbol-bound? obj) (not (widget? (inspect::eval obj)))))
diff --git a/src/tk/insp-view.lsp b/src/tk/insp-view.lsp
new file mode 100644
index 000000000..1a770e2c4
--- /dev/null
+++ b/src/tk/insp-view.lsp
@@ -0,0 +1,493 @@
+;******************************************************************************
+;
+; Project       : STk-inspect, a graphical debugger for STk.
+;
+; File name     : inspect-view.stk
+; Creation date : Aug-30-1993
+; Last update   : Sep-17-1993
+;
+; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;
+;******************************************************************************
+;
+; This file implements the different sort of "Viewers".
+;
+;******************************************************************************
+
+(in-package "TK")
+
+(provide "inspect-view")
+
+(defun view-tl-wid (obj) (widget VIEW_WIDGET_NAME (object-symbol obj)))
+(defun view-tl-str (obj) (& VIEW_WIDGET_NAME (object-symbol obj)))
+(defun view-l-wid (obj) (widget (view-tl-str obj) ".id.f1.l2"))
+(defun view-l-str (obj) (& (view-tl-str obj) ".id.f1.l2"))
+(defun view-e-wid (obj) (widget (view-tl-str obj) ".id.f2.e"))
+(defun view-e-str (obj) (& (view-tl-str obj) ".id.f2.e"))
+(defun view-m-wid (obj) (widget (view-tl-str obj) ".menu.command.m"))
+(defun view-m-str (obj) (& (view-tl-str obj) ".menu.command.m"))
+(defun view-c-wid (obj) (widget (view-tl-str obj) ".f3.c"))
+(defun view-c-str (obj) (& (view-tl-str obj) ".f3.c"))
+
+
+;---- Viewer menu -------------------------------------------------------------
+
+(defun view-menu-Eval (obj)
+  (set obj (eval (funcall (view-e-wid obj) "get")))))
+
+(defun view-menu-Quote (obj)
+  (set obj (funcall (view-e-wid obj) "get")))
+
+(defun view-menu-Inspect (key)
+  (let ((obj (find-object-infos key)))
+    (inspect obj)
+    (funcall (widget (view-tl-str obj) ".menu.command.m") "disable" "Inspect")
+    (if (detailed? obj) (funcall (detail-m-wid obj) "disable" "Inspect"))))
+
+(defun view-menu-Detail (key)
+  (let ((obj (find-object-infos key)))
+    (detail obj)
+    (funcall (widget (view-tl-str obj) ".menu.command.m") "disable" "Detail")
+    (if (inspected? obj) (funcall (inspect-m-wid obj) "disable" "Detail"))))
+
+(defun view-menu-Unview (key) 
+  (unview (find-object-infos key)))
+
+
+;---- Viewer ------------------------------------------------------------------
+
+(define VIEW_WIDGET_NAME ".viewer")
+(define viewed-objects-list ())
+
+(defun viewed? (obj) (member obj viewed-objects-list))
+
+(defun view (obj)
+  (unless (viewed? obj) (view-object obj)))
+
+(defun view-object (obj)
+  (setq viewed-objects-list (cons obj viewed-objects-list))
+  (unless (object-infos obj)
+	  (add-object-infos obj)
+	  (if (symbolp obj) (trace-var obj `(update-object ',obj))))
+  (view-create obj))
+
+(defun unview (obj)
+  (when (viewed? obj) (unview-object obj)))
+
+(defun unview-object (obj)
+  (let ((top (view-tl-wid obj)))
+    (setq viewed-objects-list (list-remove obj viewed-objects-list))
+    (if (inspected? obj) (funcall (inspect-m-wid obj) "enable" "View"))
+    (if (detailed? obj) (funcall (detail-m-wid obj) "enable" "View"))
+    (unless (or (inspected? obj) (detailed? obj))
+	    (remove-object-infos obj)
+	    (if (symbolp obj) (untrace-var obj)))
+    ;; If toplevel exists (i.e. it is not a <Destroy> event) destroy it
+    (if (= (winfo "exists" top) 1)
+	(destroy top))))
+
+(defun view-create (obj)
+  (let ((obj-val (inspect::eval obj)))
+    (case (inspect::typeof obj-val)
+      ((widget)  (when (= (winfo "exists" (view-tl-wid obj-val)) 0)
+			 (view-widget-create obj-val)))
+      ((closure) (view-procedure-create obj))
+      (else      (view-object-create obj)))))
+
+(defun view-display (obj)
+  (case (object-type obj)
+    ((widget) (view-widget-display (inspect::eval obj)))
+    ((closure) (view-procedure-display obj))
+    (else (view-object-display obj))))
+
+
+;---- Object/Procedure viewer -------------------------------------------------
+
+(define CAR_COLOR "gray90")
+(define CDR_COLOR "gray70")
+(define ARROW_COLOR "black")
+(define TEXT_COLOR "black")
+
+(defun highlightItem (canvas color1 color2)
+(let ((item (car (funcall canvas "find" "withtag" "current"))))
+    (if (equal (tki-get canvas item "-fill") color1)
+	(tki-set canvas item "-fill" color2)
+	(tki-set canvas item "-fill" color1))))
+
+(defun find-car/cdr (fct count l)
+  (defun _find-car/cdr (fct count l path)
+    (if (not (consp l))
+	(if (null path)
+	    NIL
+	    (_find-car/cdr fct count (caar path) (cdr path)))
+	(if (equal 0 count)
+	    (fct l)
+	    (_find-car/cdr fct (- count 1) (cdr l) (cons l path)))))
+  (_find-car/cdr fct count l ()))
+
+(defun double1OnCar (obj)
+  (let* ((canvas (view-c-wid obj))
+	 (item (car (funcall canvas "find" "withtag" "current")))
+	 (cars (funcall canvas "find" "withtag" 'CAR)))
+    (view (find-car/cdr car (list-first item cars) (inspect::eval obj)))))
+
+(defun double1OnCdr (canvas obj)
+  (let ((item (car (funcall canvas "find" "withtag" "current")))
+	(cdrs (funcall canvas "find" "withtag" 'CDR)))
+    (view (find-car/cdr cdr (list-first item cdrs) (inspect::eval obj)))))
+
+(defun text-width (text font)
+  (canvas ".text-width")
+  (define bbox
+    (.text-width "bbox" (.text-width "create" "text" 0 0 "-text" text "-font" font)))
+  (destroy .text-width)
+  (- (caddr bbox) (car bbox)))
+
+(defun view-create-toplevel (obj)
+  (define w (create-toplevel-widget (view-tl-str obj)))
+  (define id-w (widget w ".id"))
+  (set-id-label1 id-w "Object" 6)
+  (set-id-label2 id-w "Value" 6)
+
+  (define menu-w (widget w ".menu"))
+  (funcall (widget w ".menu.help.m") "add" "command" "-label" "Viewer"
+			     "-command" '(make-help Viewer-help))
+  (pack (menubutton (& menu-w ".command") "-text" "Command") "-side" "left")
+  (define cmd-w (eval (menu (& menu-w ".command.m"))))
+  (tk-setq (widget menu-w ".command") "-menu" cmd-w)
+  (cmd-w "add" "command" "-label" "Inspect" 
+	 	       "-command" `(view-menu-Inspect ',(object-symbol obj)))
+  (if (inspected? obj) (cmd-w "disable" "Inspect"))
+  (cmd-w "add" "command" "-label" "Detail" 
+	 		"-command" `(view-menu-Detail ',(object-symbol obj)))
+  (if (detailed? obj) (cmd-w "disable" "Detail"))
+  (cmd-w "add" "command" "-label" "Unview" 
+	 	       "-command" `(view-menu-Unview ',(object-symbol obj)))
+
+  (if (modifiable-object? obj)
+      (begin
+	(bind (widget w ".id.f2.e") "<Return>" `(view-menu-Eval ',obj))
+	(bind (widget w ".id.f2.e") "<Shift-Return>" `(view-menu-Quote ',obj)))
+      (begin
+	(funcall (view-e-wid obj) "insert" 0 (format NIL "~S" (inspect::eval obj)))
+	(inspect::shadow-entry (widget w ".id.f2.e"))))
+
+
+  (pack (frame (& w ".f3") "-relief" "sunken" "-bd" 2)
+	"-fill" "both" "-expand" "yes" "-padx" 4 "-pady" 2)
+  (pack (scrollbar (& w ".f3.vsb") "-orient" "vertical")
+	"-side" "left" "-fill" "y")
+  (pack (scrollbar (& w ".f3.hsb") "-orient" "horizontal")
+	"-side" "bottom" "-fill" "x")
+  (pack (canvas (view-c-str obj) "-relief" "raised" "-bd" 2)
+	"-fill" "both" "-expand" "yes")
+  (tk-setq (widget w ".f3.vsb") "-command" (& (view-c-str obj) " \"yview\""))
+  (tk-setq (widget w ".f3.hsb") "-command" (& (view-c-str obj) " \"xview\""))
+  (tk-setq (view-c-wid obj) "-yscroll" (& w ".f3.vsb \"set\""))
+  (tk-setq (view-c-wid obj) "-xscroll" (& w ".f3.hsb \"set\""))
+  (bind w "<Destroy>" `(view-menu-Unview ',(object-symbol obj)))
+  w)
+
+(defun view-object/procedure-create (obj)
+  (let ((w (view-create-toplevel obj))
+	(c (view-c-wid obj))
+	(c-name (widget-name c)))
+    (declare (special w))
+    (wm "title" w "Object viewer")
+    (wm "maxsize" w SCREEN_WIDTH SCREEN_HEIGHT)
+    (funcall c "bind" 'CAR "<Enter>" `(highlightItem ,c-name CAR_COLOR "red"))
+    (funcall c "bind" 'CAR "<Leave>" `(highlightItem ,c-name CAR_COLOR "red"))
+    (funcall c "bind" 'CAR "<Double-1>" `(double1OnCar ',obj))
+    (funcall c "bind" 'CDR "<Enter>" `(highlightItem ,c-name CDR_COLOR "blue"))
+    (funcall c "bind" 'CDR "<Leave>" `(highlightItem ,c-name CDR_COLOR "blue"))
+    (funcall c "bind" 'CDR "<Double-1>" `(double1OnCdr ,c-name ',obj))
+    w))
+
+(defun view-object-create (obj)
+  (let ((w (view-object/procedure-create obj)))
+    (declare (special w))
+    (view-object-display obj)))
+
+(defun view-object-display (obj)
+  (wm "title"  (view-tl-wid obj) "Object viewer")
+  (define obj-val (inspect::eval obj))
+  (tk-setq (view-l-wid obj) "-text" (->object obj))
+  (funcall (view-e-wid obj) "delete" 0 "end")
+  (funcall (view-e-wid obj) "insert" 0 (->object obj-val))
+  (view-object/procedure-display (view-c-wid obj) obj-val)) 
+
+(defun view-procedure-create (obj)
+  (let ((w (view-object/procedure-create obj)))
+    (declare (special w))
+    (view-procedure-display obj)))
+
+(defun view-procedure-display (obj)
+  (wm "title"  (view-tl-wid obj) "Procedure viewer")
+  (define obj-val (inspect::eval obj))
+  (tk-setq (view-l-wid obj) "-text" (->object obj))
+  (funcall (view-e-wid obj) "delete" 0 "end")
+  (funcall (view-e-wid obj) "insert" 0 (->object obj-val))
+  (view-object/procedure-display (view-c-wid obj) (procedure-body obj-val)))
+
+(defun view-object/procedure-display (c obj-val)
+  (define grid-h 60) ; horizontal spacing between grid lines
+  (define grid-v 40) ; vertical spacing between grid lines
+  (define cons-h 40) ; horizontal size of cons cell
+  (define cons-v 20) ; vertical size of cons cell
+  (define cons-h/2 (quotient cons-h 2))
+  (define cons-v/2 (quotient cons-v 2))
+  (define arrow-space 2) ; space between arrow and box
+  (defun x-h (x) (* x grid-h))
+  (defun y-v (y) (* y grid-v))
+  (define font "-adobe-helvetica-bold-r-*-*-*-120-*-*-*-*-*-*")
+
+  (defun draw-cons-cell (x y)
+    (let ((h (x-h x)) (v (y-v y)))
+      (c "create" 'rectangle h v (+ h cons-h/2 1) (+ v cons-v)
+	 "-fill" CAR_COLOR "-tag" 'CAR)
+      (c "create" 'rectangle (+ h cons-h/2) v (+ h cons-h) (+ v cons-v)
+	 "-fill" CDR_COLOR "-tag" 'CDR)))
+
+  (defun car-arrow-pos (x y d)
+    (let ((h (x-h x)) (v (y-v y)))
+      (list (+ h (quotient cons-h 4)) (+ v cons-v/2) (+ h (quotient cons-h 4))
+	    (+ v cons-v/2 (- (* d grid-v) (+ cons-v/2 arrow-space))))))
+
+  (defun draw-car-arrow (x y d) ; draw arrow downwards 'd' grid squares
+    (let ((pos (car-arrow-pos x y d)))
+      (if (and (= x 0) (= y 0))
+	  (eval `(funcall ,c "create" "line" ,@pos "-arrow" "last" "-arrowshape" "8 8 3"))
+	  (eval `(funcall ,c "create" "line" ,@pos "-arrow" "last" "-arrowshape" "8 8 3"
+		     "-tag" 'CAR_ARROW)))))
+
+  (defun draw-car-text (x y d text)
+    (let ((pos (car-arrow-pos x y d)))
+      (if (<= (text-width text font) grid-h)
+	  (c "create" "text" (caddr pos) (cadddr pos)
+	     "-anchor" "n" "-font" font "-text" text "-tag" 'CAR_TEXT)
+	  (let* ((text-l (label (& c "." (gensym "__g"))
+				:relief "groove" "-bd" 2
+				:text text "-anchor" "w" "-font" font))
+		 (item (c "create" 'window (caddr pos) (+ 2 (cadddr pos))
+			  "-window" text-l "-anchor" "n" "-width" (- grid-h 2)
+			  "-tags" 'LONG_CAR_TEXT)))
+	    (bind text-l "<Enter>" 
+		  `(funcall ,(widget-name c) 'itemconfig ,item
+				     "-width" ,(+ 3 (text-width text font))))
+	    (bind text-l "<Leave>" 
+		  `(funcall ,(widget-name c) 'itemconfig ,item
+				     "-width" ,(- grid-h 2)))))))
+
+  (defun cdr-arrow-pos (x y d)
+    (let ((h (x-h x)) (v (y-v y)))
+      (list (+ h (quotient (* cons-h 3) 4)) (+ v cons-v/2)
+	    (+ h (quotient (* cons-h 3) 4)
+	       (- (* d grid-h) (+ (quotient (* cons-h 3) 4) arrow-space)))
+	    (+ v cons-v/2))))
+  
+  (defun draw-cdr-arrow (x y d) ; draw arrow to the right 'd' grid squares
+    (let ((pos (cdr-arrow-pos x y d)))
+      (eval `(funcall ,c "create" "line" ,@pos "-arrow" "last" "-arrowshape" "8 8 3"
+		 "-tag" 'CDR_ARROW))))
+
+  (defun draw-cdr-text (x y d text)
+    (let ((pos (cdr-arrow-pos x y d)))
+      (c "create" "text" (caddr pos) (cadddr pos)
+	 "-anchor" "w" "-font" font "-text" text "-tag" 'CDR_TEXT)))
+
+  (defun draw-nil (x y) ; draw nil in cdr of cons cell
+    (let ((h (x-h x)) (v (y-v y)))
+      (c "create" "line" (+ h cons-h/2) v (+ h cons-h) (+ v cons-v))
+      (c "create" "line" (+ h cons-h/2) (+ v cons-v -1) (+ h cons-h) (- v 1))))
+
+  (defun object-length (obj-val)
+    (cond ((null obj-val) 0)
+	  ((consp obj-val) (+ 1 (object-length (cdr obj-val))))
+	  (else (+ 1 (quotient (text-width (->object obj-val) font)
+				 grid-h)))))
+    
+  (defun initial-profile () 0)
+  (defun car-profile (p) (if (consp p) (car p) p))
+  (defun cdr-profile (p) (if (consp p) (cdr p) p))
+
+  (defun make-profile (len p)
+    (defun fit1 (len p)
+      (if (> len 1)
+	  (let ((p* (fit1 (- len 1) (cdr-profile p))))
+	    (cons (car-profile p*) p*))
+	  (fit2 (+ (car-profile p) 1) p)))
+    (defun fit2 (y p)
+      (if (consp p)
+	  (cons (max y (car-profile p)) (fit2 y (cdr-profile p)))
+	  (max y p)))
+    (fit1 len p))
+
+  (defun draw-list (lst x y p)
+    (draw-cons-cell x y)
+    (let* ((tail (cdr lst))
+	   (tail-p (cdr-profile p))
+	   (new-p (cond ((null tail)
+			 (draw-nil x y)
+			 tail-p)
+			((consp tail)
+			 (draw-cdr-arrow x y 1)
+			 (draw-list tail (+ x 1) y tail-p))
+			(else
+			 (draw-cdr-arrow x y 1)
+			 (draw-cdr-text x y 1 (->object tail))
+			 tail-p))))
+      (draw-object (car lst) x y (cons (car-profile p) new-p))))
+
+  (defun draw-object (obj-val x y p)
+    (if (consp obj-val)
+        (let* ((len (object-length obj-val))
+	       (new-p (make-profile len p))
+	       (yy (car-profile new-p)))
+	  (draw-car-arrow x y (- yy y))
+	  (draw-list obj-val x yy new-p))
+	(let ((text (->object obj-val)))
+          (draw-car-arrow x y 1)
+	  (draw-car-text x y 1 text)
+          (make-profile 1 p))))
+
+  (c "delete" "all")
+  (draw-object obj-val 0 0 (initial-profile))
+  (adjust-scrollregion c 20))
+
+
+;---- Widget viewer -----------------------------------------------------------
+
+(define show-widget
+  (let ((bg-color ())
+	(box-color ()))
+    (lambda (obj item press)
+      (let* ((canv-w (view-c-wid (inspect::eval obj)))
+	     (tags (funcall canv-w 'gettags item))
+	     (wid (inspect::eval (nth 1 tags))))
+	(if press
+	    (progn
+	      (setq box-color (tki-get canv-w item "-fill"))
+	      (setq bg-color (tk-get wid "-bg"))
+	      (tki-set canv-w item "-fill" "magenta")
+	      (tk-setq wid "-bg" "magenta"))
+	    (progn
+	      (tki-set canv-w item "-fill" box-color)
+	      (tk-setq wid "-bg" bg-color)))))))
+
+(defun inspect-sub-widget (obj who)
+  (catch-errors 
+   (inspect (inspect::eval (nth 1 (funcall (view-c-wid obj) 'gettags who))))))
+
+(defun view-widget-create (obj)
+  (define w (view-create-toplevel obj))
+  (define obj-val (inspect::eval obj))
+  (wm "maxsize" w SCREEN_WIDTH SCREEN_HEIGHT)
+  (pack (frame (& w ".menu.level")) "-side" "left")
+  (pack (label (& w ".menu.level.l") "-text" "Level") "-side" "left")
+  (pack (entry (& w ".menu.level.e") "-relief" "sunken" "-bd" 2 "-width" 4)
+	"-side" "left")
+  (funcall (widget w ".menu.level.e") "insert" 0 9999)
+  (bind (widget (view-tl-str obj) ".menu.level.e") "<Return>"
+	`(view-widget-modify-level ',(object-symbol obj)))
+
+  (define c (view-c-wid obj))
+  (c "bind" '|CLASS| "<Double-1>" 
+     `(inspect-sub-widget ,(widget-name obj-val) 
+			  "current"))
+  (c "bind" '|CLASS_NAME| "<Double-1>" 
+     `(inspect-sub-widget ,(widget-name obj-val) 
+			  (car (funcall ,(widget-name c) "find" "below" "current"))))
+
+  (c "bind" '|CLASS| "<ButtonPress-1>" 
+     		    `(show-widget ,(widget-name obj-val) "current" T))
+  (c "bind" '|CLASS| "<ButtonRelease-1>" 
+		    `(show-widget ,(widget-name obj-val) "current" NIL))
+  (c "bind" '|CLASS_NAME| "<ButtonPress-1>"
+     `(show-widget ,(widget-name obj-val)
+		   (car (funcall ,(widget-name c) "find" "below" "current")) T))
+  (c "bind" '|CLASS_NAME| "<ButtonRelease-1>"
+     `(show-widget ,(widget-name obj-val) 
+		   (car (funcall ,(widget-name c) "find" "below" "current")) NIL))
+  (view-widget-display obj))
+
+(defun view-widget-set-level (obj level)
+  (funcall (widget (view-tl-str obj) ".menu.level.e") "delete" 0 "end")
+  (funcall (widget (view-tl-str obj) ".menu.level.e") "insert" 0 level))
+
+(defun view-widget-get-level (obj)
+  (let ((level (funcall (widget (view-tl-str obj) ".menu.level.e") 'get)))
+    (if (equal "" level) 9999 (string->number level))))
+
+(defun view-widget-modify-level (key)
+  (let ((obj (find-object-infos key)))
+    (unless (view-widget-get-level obj) (view-widget-set-level obj 9999))
+    (view-widget-clear obj)
+    (view-widget-display obj)))
+
+(defun get-children (wid)
+  (let ((children (winfo 'children wid)))
+    (if (listp children) children (list children))))
+
+(defun view-widget-clear (obj) (funcall (view-c-wid obj) "delete" "all"))
+
+(defun view-widget-display (obj)
+  (wm "title" (view-tl-wid obj) "Widget viewer")
+  (define obj-wid obj)
+  (define canv (view-c-wid obj))
+  (define h-grid 60)
+  (define v-grid 40)
+  (define h-box 80) (define h-box/2 (/ h-box 2))
+  (define v-box 20) (define v-box/2 (/ v-box 2))
+  (define y-global 40)
+  (define level (view-widget-get-level obj))
+  (define level-min level)
+  (defun _display (wid x level)
+    (let* ((name (winfo 'name wid))
+	   (class (winfo 'class wid))
+;	   (children (winfo 'children wid))
+	   (children (get-children wid))
+	   (y y-global))
+      (funcall canv "create" 'rectangle (- x h-box/2) (- y v-box) (+ x h-box/2) y 
+	    "-fill" "gray90" "-tags" (format NIL "CLASS ~a" (->string wid)))
+      (funcall canv "create" "text" x (- y v-box/2)
+	    "-anchor" "center" "-text" class "-font" HELVETICA_MO12 
+	    "-tags" "CLASS_NAME")
+      (funcall canv "create" "text" (+ x h-box/2 10) (- y v-box/2)
+	    "-anchor" "w" "-text" name "-font" HELVETICA_BR12)
+      (if (null children)
+	  (setq level-min (min level level-min))
+	  (if (> level 0)
+	      (let ((y-child y))
+		(for-each
+		 (lambda (child)
+		   (setq y-global (+ y-global v-grid))
+		   (setq y-child y-global)
+		   (_display child (+ x h-grid) (- level 1)))
+		 children)
+		(funcall canv "create" "line" x y x (- y-child v-box/2)))
+	      (progn
+		(setq level-min 0)
+		(funcall canv "create" "line" x y x (+ y v-box/2) "-stipple" "gray50"))))
+      (unless (equal obj-wid wid)
+	      (funcall canv "create" "line" 
+		    (- x h-box/2) (- y v-box/2) (- x h-grid) (- y v-box/2)))))
+
+  (set-id-object (& (view-tl-str obj) ".id") (format NIL "~S" obj))
+  (set-id-value (& (view-tl-str obj) ".id") (format NIL "~S" (inspect::eval obj)))
+  (funcall (view-c-wid obj) "delete" "all")
+  (_display obj-wid 0 level)
+  (view-widget-set-level obj (- level level-min))
+  (adjust-scrollregion canv 20))
+
+(defun adjust-scrollregion (canv offset)
+  (multiple-value-bind (x1 y1 x2 y2)
+      (funcall canv "bbox" "all")
+    (tk-setq canv "-scrollregion"
+	     (&& (- x1 offset) (- y1 offset)
+		 (+ x2 offset) (+ y2 offset))))
+  (funcall canv "xyview" 0)
+  (funcall canv "yview" 0))
+
+(defun view-widget (obj)
+  (view-widget-create obj)
+  (view-widget-display obj))
diff --git a/src/tk/listbox.lsp b/src/tk/listbox.lsp
new file mode 100644
index 000000000..15ea14ae3
--- /dev/null
+++ b/src/tk/listbox.lsp
@@ -0,0 +1,52 @@
+;;;;
+;;;; Listboxes bindings and procs
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 17-May-1993 12:35
+;;;; Last file update: 22-Nov-1993 16:04
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+;; ----------------------------------------------------------------------
+;; Class bindings for listbox widgets.
+;; ----------------------------------------------------------------------
+
+(def-bindings "Listbox" '(
+   ("<1>"		. (%W "select" "from" (%W "nearest" %y)))
+   ("<B1-Motion>"	. (%W "select" "to" (%W "nearest" %y)))
+   ("<2>"		. (%W "scan" "mark" %x %y))
+   ("<Shift-B2-Motion>"	. (%W "scan" "dragto" %x %y))
+   ("<3>"		. (%W "select" "adjust" (%W 'nearest %y)))
+))
+
+;; The procedure below may be invoked to change the behavior of
+;; listboxes so that only a single item may be selected at once.
+;; The arguments give one or more windows whose behavior should
+;; be changed;  if one of the arguments is "Listbox" then the default
+;; behavior is changed for all listboxes.
+
+(defun tk-listbox-single-select (&rest args)
+  (let ((new-binding '(%W "select" "from" (%W "nearest" %y))))
+    (for-each (lambda (w)
+		(bind w "<B1-Motion>" new-binding)
+		(bind w "<3>" 	      new-binding))
+	      args)))
+
+
diff --git a/src/tk/menu.lsp b/src/tk/menu.lsp
new file mode 100644
index 000000000..f8b4449e3
--- /dev/null
+++ b/src/tk/menu.lsp
@@ -0,0 +1,280 @@
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 17-May-1993 12:35
+;;;; Last file update: 25-Nov-1993 15:54
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+;; ----------------------------------------------------------------------
+;; Class bindings for menubutton widgets.  Variables used:
+;; tk::posted -		keeps track of the menubutton whose menu is
+;;				currently posted (or empty string, if none).
+;; tk::inMenuButton-	if non-null, identifies menu button
+;;				containing mouse pointer.
+;; tk::relief -		keeps track of original relief of posted
+;;				menu button, so it can be restored later.
+;; tk::dragging -		if non-null, identifies menu button whose
+;;				menu is currently being dragged in a tear-off
+;;				operation.
+;; curr-focus -		records old focus window so focus can be
+;;				returned there after keyboard traversal
+;;				to menu.
+;; ----------------------------------------------------------------------
+
+
+(def-bindings "Menubutton" '(
+  ("<Any-Enter>"	 . (progn
+			     (setq tk::inMenuButton %W)
+			     (unless (equal (tk-get %W "-state") "disabled")
+				(unless tk-strictMotif
+				   (tk-setq %W "-state" "active")))))
+  ("<Any-Leave>"	 . (progn
+			     (setq tk::inMenuButton '())
+			     (when (equal (tk-get %W "-state") "active")
+				(tk-setq %W "-state" "normal"))))
+
+  ("<1>"		 . (tk-mbButtonDown %W))
+  ("<Any-ButtonRelease-1>" . (if (and (equal %W tk::posted)
+				      (equal %W tk::inMenuButton))
+				 (funcall (string->widget (tk-get %W "-menu")) "activate" 0)
+				 (tk-mbUnpost)))
+  ;; The binding below is trickier than it looks.  It's important to check
+  ;; to see that another menu is posted in the "if" statement below.
+  ;; The check is needed because some window managers (e.g. mwm in
+  ;; click-to-focus mode) cause a button-press event to be preceded by
+  ;; a B1-Enter event;  we don't want to process that B1-Enter event (if
+  ;; we do, the grab may get mis-set so that the menu is non-responsive).
+  ("<B1-Enter>"		 . (progn 
+			     (setq tk::inMenuButton %W)
+			     (when (and (not (equal (tk-get %W "-state") "disabled"))
+					tk::posted)
+				(unless tk-strictMotif
+				   (tk-setq %W "-state" "active"))
+				(tk-mbPost %W))))
+  
+  ("<2>" 		. (unless (or tk::posted 
+				      (equal (tk-get %W "-state") "disabled"))
+			     (setq tk::dragging %W)
+			     (tk-execute-menu %W |%X| |%Y|)))
+
+  ("<B2-Motion>"	. (unless (equal tk::dragging "")
+			     (tk-execute-menu %W |%X| |%Y|)))
+
+  ("<ButtonRelease-2>"	. (setq tk::dragging ""))
+))
+
+
+;; ----------------------------------------------------------------------
+;; Class bindings for menu widgets.  tk-priv(x) and tk-priv(y) are used
+;; to keep track of the position of the mouse cursor in the menu window
+;; during dragging of tear-off menus.  tk-priv(window) keeps track of
+;; the menu containing the mouse, if any.
+;; ----------------------------------------------------------------------
+
+(def-bindings "Menu" '(
+  ("<Any-Enter>"	. (progn
+			    (setq tk::window %W)
+			    (%W "activate" "@%y")))
+  ("<Any-Leave>"	. (progn
+			    (setq tk::window '())
+			    (%W "activate" "none")))
+  ("<Any-Motion>"	. (when (equal tk::window %W)
+				(%W "activate" "@%y")))
+
+  ("<1>"		. (unless (equal curr-grab "") (grab curr-grab)))
+  ("<ButtonRelease-1>"	. (tk-invokeMenu %W))
+
+  ("<2>"		. (progn
+			    (setq tk::x %x)
+			    (setq tk::y %y)))
+  ("<B2-Motion>"	. (unless tk::posted
+			     (%W "post" (- %X  tk::x) (- %Y tk::y))))
+  ("<B2-Leave>"		. ())
+  ("<B2-Enter>"		. ())
+  ("<Escape>" 		. (tk-mbUnpost))
+  ("<Any-KeyPress>"	. (tk-traverseWithinMenu %W "%A"))
+  ("<Left>" 		. (tk-nextMenu -1))
+  ("<Right>"		. (tk-nextMenu 1))
+  ("<Up>"		. (tk-nextMenuEntry -1))
+  ("<Down>"		. (tk-nextMenuEntry 1))
+  ("<Return>" 		. (tk-invokeMenu %W))
+))
+
+;; The procedure below is publically available.  It is used to identify
+;; a frame that serves as a menu bar and the menu buttons that lie inside
+;; the menu bar.  This procedure establishes proper "menu bar" behavior
+;; for all of the menu buttons, including keyboard menu traversal.  Only
+;; one menu bar may exist for a given top-level window at a time.
+;; Arguments:
+;;	
+;; bar -			The path name of the containing frame.  Must
+;;				be an ancestor of all of the menu buttons,
+;;				since it will be be used in grabs.
+;; additional arguments -	One or more menu buttons that are descendants
+;;				of bar.  The order of these arguments
+;;				determines the order of keyboard traversal.
+;;				If no extra arguments are named then all of
+;;				the menu bar information for bar is cancelled.
+
+(defvar tk::menusFor   '())
+(defvar tk::menuBarFor '())
+
+(defun tk-menuBar (w &rest args)
+  (format T "~S~%" args)
+  (if (null args)
+      (cdr (assoc w tk::menusFor))
+      (let* ((win  (winfo "toplevel" w))
+	     (tmp1 (assoc w tk::menusFor))
+	     (tmp2 (assoc win tk::menuBarFor)))
+	(format T "tmp1 ~S tmp2 ~S win ~S~%" tmp1 tmp2 win)
+
+	(if tmp1 
+	    (setf (cdr tmp1) args)
+	    (push (cons w args) tk::menusFor))
+	(if tmp2 
+	    (setf (cdr tmp2) w)
+	    (push (cons win w) tk::menuBarFor))
+	(bind w "<Any-ButtonRelease-1>" '(tk-mbUnpost)))))
+
+;; The procedure below is publically available.  It takes any number of
+;; arguments that are names of widgets or classes.  It sets up bindings
+;; for the widgets or classes so that keyboard menu traversal is possible
+;; when the input focus is in those widgets or classes.
+
+(defun tk-bindForTraversal (&rest args)
+  (dolist (w args)
+    (bind w "<Alt-KeyPress>" '(tk-traverseToMenu %W "%A"))
+    (bind w "<F10>" (tk-firstMenu %W))))
+
+;; The function below does all of the work of posting a menu (including
+;; unposting any other menu that might currently be posted).  The "w"
+;; argument is the name of the menubutton for the menu to be posted.
+;; Note:  if w is disabled then the procedure does nothing.
+
+(defun tk-mbPost (w)
+  (when (equal (tk-get w "-state") "disabled")
+    (return-from tk-mbPost NIL))
+
+  (when (equal tk::posted w)
+;;;      (grab "-global" curr-grab)
+    (grab curr-grab)
+    (return-from tk-mbPost NIL))
+
+  (let* ((MenuName (tk-get w "-menu"))
+	 (Menu (string->widget MenuName)))
+    (when (equal MenuName "")
+      (return-from tk-mbPost NIL))
+
+    ;; if a menu is already posted, unpost it
+    (when tk::posted (tk-mbUnpost))
+
+    ;; Retain several graphical infos
+    (setq tk::relief   (tk-get w "-relief"))
+    (setq tk::activeBg (tk-get Menu "-activebackground"))
+    (setq tk::activeFg (tk-get Menu "-activeforeground"))	
+
+    (tk-setq w "-relief" "raised")
+    (setq tk::posted w)
+
+    (when (null curr-focus)
+      (setq curr-focus (get-focus)))
+    (focus MenuName)
+
+    (when tk-strictMotif
+      (tk-setq Menu "-activebackground" (tk-get Menu "-background"))
+      (tk-setq Menu "-activeforeground" (tk-get Menu "-foreground")))
+    (funcall Menu "activate" "none")
+    (funcall Menu "post" (winfo "rootx" w)
+	     (+ (parse-integer (winfo "rooty" w))
+		(parse-integer (winfo "height" w))))
+
+    (let* ((grb '())
+	   (win (winfo "toplevel" w))
+	   (tmp (assoc win tk::menuBarFor)))
+      (if tmp
+	  ;; menu associated 
+	  (progn
+	   (setq grb (cdr tmp))
+	   (unless (member w (cdr (assoc grb tk::menusFor)))
+	     (setq grb w)))
+	  (setq grb w))
+	 
+      ;; Retain actual cursor and set it now to an arrow
+      (setq tk::cursor (tk-get grb "-cursor"))
+      (tk-setq grb "-cursor" "arrow")
+
+      (setq curr-grab grb)
+;;;	 (grab "-global" grb)
+      (grab grb))))
+
+
+;; The procedure below does all the work of unposting the menubutton that's
+;; currently posted.  It takes no arguments.  Special notes:
+;; 1. It's important to unpost the menu before releasing the grab, so
+;;    that any Enter-Leave events (e.g. from menu back to main
+;;    application) have mode NotifyGrab.
+;; 2. Be sure to enclose various groups of commands in "catch" so that
+;;    the procedure will complete even if the menubutton or the menu
+;;    or the grab window has been deleted.
+
+(defun tk-mbUnpost ()
+  (when tk::posted
+    (let ((w tk::posted))
+      (catch-errors
+	  (let* ((Menu (string->widget (tk-get w "-menu"))))
+	    (funcall Menu "unpost")
+	    (tk-setq Menu "-activebackground" tk::activeBg)
+	    (tk-setq Menu "-activeforeground" tk::activeFg)
+	    (tk-setq w "-relief" tk::relief)))
+      (catch-errors
+	  (tk-setq curr-grab "-cursor" tk::cursor))
+      (focus curr-focus)
+      (grab "release" curr-grab)
+      (setq curr-focus '())
+      (setq tk::posted NIL))))
+
+;; Following function executes the menu-button associated menu (if it exists)
+(defun tk-execute-menu (w x y)
+  (let ((widget (string->widget (tk-get w "-menu"))))
+    (when widget
+      (funcall widget "post" x y))))
+
+
+;; The procedure below invokes the active entry in the posted menu,
+;; if there is one.  Otherwise it does nothing.
+
+(defun tk-invokeMenu (menu)
+  (let ((i (funcall menu "index" "active")))
+    (unless (equal i "none")
+      (tk-mbUnpost)
+      (update "idletasks")
+      (funcall menu "invoke" i))))
+
+;; The procedure below is invoked when a button-1-down event is
+;; received by a menu button.  If the mouse is in the menu button
+;; then it posts the button's menu.  If the mouse isn't in the
+;; button's menu, then it deactivates any active entry in the menu.
+;; Remember, event-sharing can cause this procedure to be invoked
+;; for two different menu buttons on the same event.
+
+(defun tk-mbButtonDown (w)
+  (unless (equal (tk-get w "-state") "disabled")
+    (when (equal tk::inMenuButton w)
+       (tk-mbPost w))))
diff --git a/src/tk/regexp.lsp b/src/tk/regexp.lsp
new file mode 100644
index 000000000..c35657c05
--- /dev/null
+++ b/src/tk/regexp.lsp
@@ -0,0 +1,101 @@
+;;;;
+;;;; r e g e x p . l s p 		-- Regular expressions
+;;;;
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date:  9-Nov-1994 13:24
+;;;; Last file update: 10-Jan-1995 23:47
+;;;;
+
+(if (symbol-bound? '%init-regexp)
+    ;; Regexp module is in the core interpreter
+    (%init-regexp)
+    ;; Try to load regexp module dynamically
+    (load "sregexp.so"))
+
+(defun replace-string (string ind1 ind2 new)
+  (string-append (substring string 0 ind1)
+		 new
+		 (substring string ind2 (string-length string))))
+
+(define regexp-replace		NIL)
+(define regexp-replace-all	NIL)
+
+(let ()
+
+  ;; Utility function
+  ;; Given a string  and a set of substitutions, return the substitued string
+  (defun replace-submodels (string subst match)
+    (if (= (length match) 1)
+	;; There is no sub-model
+	subst
+	;; There are at least one sub-model to replace
+	(let Loop ((subst subst))
+	  (let ((pos ((string->regexp "\\\\[0-9]") subst)))
+	    (if pos
+		;; At least one \x in the substitution string
+		(let* ((index (+ (caar pos) 1))
+		       (val   (string->number (substring subst index (+ index 1)))))
+		  (if (>= val (length match))
+		      (error "regexp-replace: cannot match \\~A in model" val)
+		      ;; Build a new subst with the current \x remplaced by 
+		      ;; its value. Iterate for further \x
+		      (Loop (replace-string subst 
+					    (caar pos)
+					    (cadar pos)
+					    (apply substring string
+						   (nth val match))))))
+		;; No \x in substitution string
+		subst)))))
+
+  ;; If there is a match, call replace-submodels; otherwise return string unmodified
+  ;; This function takes an iterator function to allow multiple substitution
+  ;; (iterator function = Identity for regexp-replace)
+  (setq regexp-replace 
+	(lambda (pat str subst)
+	  (let* ((regexp (cond
+			  ((regexp? pat) pat)
+			  ((string? pat) (string->regexp pat))
+			  (else  (error "regexp-replace: Bad pattern '~1'" pat))))
+		 (match   (regexp str)))
+	    (if match
+		;; There was a match
+		(replace-string str 
+				(caar match) 
+				(cadar match) 
+				(replace-submodels str subst match))
+		;; No match, return the original string
+		str))))
+
+  (setq regexp-replace-all 
+	(lambda (pat str subst)
+	  (let* ((regexp (cond
+			  ((regexp? pat) pat)
+			  ((string? pat) (string->regexp pat))
+			  (else     (error "regexp-replace-all: Bad pattern '~1'" 
+					   pat))))
+		 (match   (regexp str)))
+	    (if match
+		;; There was a match
+		(regexp-replace-all 
+		 	pat 
+			(replace-string str 
+					(caar match) 
+					(cadar match) 
+					(replace-submodels str subst match))
+			subst)
+		;; No match, return the original string
+		str)))))
+
+(provide "regexp")
diff --git a/src/tk/scale.lsp b/src/tk/scale.lsp
new file mode 100644
index 000000000..ce0d489a8
--- /dev/null
+++ b/src/tk/scale.lsp
@@ -0,0 +1,45 @@
+;;;;
+;;;; Scale bindings and procs
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 17-May-1993 12:35
+;;;; Last file update: 22-Nov-1993 16:06
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+;; ----------------------------------------------------------------------
+;; Class bindings for scale widgets.  When strict Motif is requested,
+;; the bindings use tk::buttons and tk::activeFg to set the
+;; "-activeforeground" color to -foreground when the mouse is in the window
+;; and restore it when the mouse leaves.
+;; ----------------------------------------------------------------------
+
+(def-bindings "Scale"
+  '(("<Any-Enter>" 	  . (when tk::tk-strictMotif 
+			      (setq tk::activeFg 
+				    (tk-get %W "-activeforeground"))
+			      (tk-setq %W "-activeforeground"
+				       (tk-get %W "-sliderforeground"))))
+    ("<Any-Leave>" 	  . (when (and tk::tk-strictMotif (= tk::buttons 0))
+			      (tk-setq %W "-activeforeground" tk::activeFg))
+     )
+    ("<Any-ButtonPress>"   . (setq tk::buttons (+ tk::buttons 1)))
+    ("<Any-ButtonRelease>" . (setq tk::buttons (- tk::buttons 1)))
+    ))
diff --git a/src/tk/scrollbar.lsp b/src/tk/scrollbar.lsp
new file mode 100644
index 000000000..e32238c5f
--- /dev/null
+++ b/src/tk/scrollbar.lsp
@@ -0,0 +1,47 @@
+;;;;
+;;;; Scrollbars bindings and procs
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 17-May-1993 12:35
+;;;; Last file update: 22-Nov-1993 16:08
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+;; ----------------------------------------------------------------------
+;; Class bindings for scrollbar widgets.  When strict Motif is requested,
+;; the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
+;; -activeforeground color to -foreground when the mouse is in the window
+;; and restore it when the mouse leaves.
+;; ----------------------------------------------------------------------
+
+(def-bindings "Scrollbar" '(
+   ("<Any-Enter>" 	  . (when tk-strictMotif
+				  (setq tk::activeFg 
+					(tk-get %W "-activeforeground"))
+				  (tk-setq %W "-activeforeground" 
+					   (tk-get %W "-foreground"))))
+   ("<Any-Leave>" 	  . (when (and tk-strictMotif (= tk::buttons 0))
+				  (tk-setq %W "-activeforeground" tk::activeFg)))
+   ("<Any-ButtonPress>"   . (setq tk::buttons (+ tk::buttons 1)))
+   ("<Any-ButtonRelease>" . (setq tk::buttons (- tk::buttons 1)))
+))
+
+
+
diff --git a/src/tk/text.lsp b/src/tk/text.lsp
new file mode 100644
index 000000000..cb31cc426
--- /dev/null
+++ b/src/tk/text.lsp
@@ -0,0 +1,142 @@
+;;;;
+;;;; Texts bindings and procs (bindings a` la emacs)
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 17-May-1993 12:35
+;;;; Last file update:  2-Jun-1994 12:41
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+;; Class bindings for text widgets. tk::selectMode holds one of
+;; 'char, 'word, or 'line to indicate which selection mode is active.
+
+(defvar tk::selectMode 'CHAR)
+
+(def-bindings "Text" '(
+  ("<1>"		. (progn
+			    (setq tk::selectMode 'CHAR)
+			    (%W "mark" "set" "insert" "@%x,%y")
+			    (%W "mark" "set" "anchor" "@%x,%y")
+			    (if (equal (tk-get %W "-state") "normal")
+ 				(focus %W))))
+  ("<Double-1>"		. (progn
+			    (setq tk::selectMode 'WORD)
+			    (%W "mark" "set" "insert" "@%x,%y wordstart")
+			    (tk-textSelectTo %W "insert")))
+  ("<Triple-1>"		. (progn
+			    (setq tk::selectMode "line")
+			    (%W "mark" "set" "insert" "@%x,%y linestart")
+			    (tk-textSelectTo %W "insert")))
+  ("<B1-Motion>"	. (tk-textSelectTo %W "@%x,%y"))
+  ("<Shift-1>" 		. (progn
+;			    (tk-textResetAnchor %W "@%x,%y")
+			    (tk-textSelectTo    %W "@%x,%y")))
+  ("<Shift-B1-Motion>"	. (tk-textSelectTo %W "@%x,%y"))
+  ("<2>"		. (catch-errors 
+			    (%W "insert" "insert" (selection "get"))
+			    (%W "yview" "-pickplace" "insert")))
+  ("<Shift-2>"		. (%W "scan" "mark" %y))
+  ("<Shift-B2-Motion>"	. (%W "scan" "dragto" %y))
+  ("<Any-backslash>"	. (progn
+			    (%W "insert" "insert" "\\")
+			    (%W "yview" "-pickplace" "insert")))
+  ("<Any-quotedbl>"	. (progn
+			     (%W "insert" "insert" "\"")
+			     (%W "yview" "-pickplace" "insert")))
+  ("<Any-KeyPress>"	. (unless (equal "\\%A" "\\0")
+			    (%W "insert" "insert" "%A")
+			    (%W "yview" "-pickplace" "insert")))
+  ("<Return>"		. (progn
+			    (%W "insert" "insert" #\newline)
+			    (%W "yview" "-pickplace" "insert")))
+  ("<BackSpace>"	. (progn
+			    (tk-textBackspace %W)
+			    (%W "yview" "-pickplace" "insert")))
+  ("<Delete>"		. (progn
+			    (tk-textBackspace %W)
+			    (%W "yview" "-pickplace" "insert")))
+  ("<Control-a>"	. (%W "mark" "set" "insert" 
+				(%W "index" "insert linestart")))
+  ("<Control-b>"	. (tk-backward-char %W))
+  ("<Control-d>"	. (%W "delete" "insert" "insert +1c"))
+  ("<Control-e>"	. (%W "mark" "set" "insert" (%W "index" "insert lineend")))
+  ("<Control-f>"	. (tk-forward-char %W))
+  ("<Control-k>"	. (%W "delete" "insert" "insert lineend"))
+  ("<Control-n>"	. (tk-next-line %W))
+  ("<Control-o>"	. (progn 
+			    (%W "insert" "insert" #\newline)
+			    (tk-backward-char %W)))
+  ("<Control-p>"	. (tk-previous-line %W))
+  ("<Control-w>"	. (catch-errors 
+			     (setq tk::kill-buffer 
+				   (%W "get" "sel.first" "sel.last"))
+			     (%W "delete" "sel.first" "sel.last")))
+  ("<Control-y>"	. (%W "insert" "insert" tk::kill-buffer))
+  ("<Up>"		. (tk-previous-line %W))
+  ("<Down>"		. (tk-next-line %W))
+  ("<Left>"		. (tk-backward-char %W))
+  ("<Right>"		. (tk-forward-char %W))
+))
+
+;;tk-bindForTraversal Text
+;;
+
+(defun tk-previous-line (w)
+  (funcall w "mark" "set" "insert" (funcall w "index" "insert -1line"))
+  (funcall w "yview" "-pickplace" "insert"))
+
+(defun tk-next-line (w)
+  (funcall w "mark" "set" "insert" (funcall w "index" "insert +1line"))
+  (funcall w "yview" "-pickplace" "insert"))
+
+(defun tk-forward-char (w)
+  (funcall w "mark" "set" "insert" (funcall w "index" "insert +1c"))
+  (funcall w "yview" "-pickplace" "insert"))
+
+(defun tk-backward-char (w)
+  (funcall w "mark" "set" "insert" (funcall w "index" "insert -1c"))
+  (funcall w "yview" "-pickplace" "insert"))
+  
+;; The procedure below is invoked when dragging one end of the selection.
+;; The arguments are the text window name and the index of the character
+;; that is to be the new end of the selection.
+
+(defun tk-textSelectTo (w index)
+  (let ((interval 
+	 (case tk::selectMode
+	   (CHAR (if (equal (funcall w "compare" index "<" "anchor") "1")
+		     (cons index "anchor")
+		     (cons "anchor" (funcall w "index"
+					     (format NIL "~A+1c" index)))))
+	   (WORD (cons (funcall w "index" (format NIL "~A wordstart" index))
+		       (funcall w "index" "anchor wordend")))
+	   (LINE (cons (funcall w "index" (format NIL "~A linestart" index))
+		       (funcall w "index" "anchor lineend"))))))
+
+    (funcall w "tag" "remove" "sel" "0.0" (car interval))
+    (funcall w "tag" "add"    "sel" (car interval) (cdr interval))
+    (funcall w "tag" "remove" "sel" (cdr interval) "end")))
+
+
+;; The procedure below is invoked to backspace over one character in
+;; a text widget.  The name of the widget is passed as argument.
+
+(defun tk-textBackspace (w)
+  (funcall w "delete" "insert-1c" "insert"))
diff --git a/src/tk/tk-init.lsp b/src/tk/tk-init.lsp
new file mode 100644
index 000000000..aba4de23e
--- /dev/null
+++ b/src/tk/tk-init.lsp
@@ -0,0 +1,128 @@
+;;;;
+;;;; Initialization file for ECL/Tk
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;; This software is a derivative work of other copyrighted softwares; the
+;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
+;;;;
+;;;;           Author: Erick Gallesio [eg@unice.fr]
+;;;;    Creation date: 17-May-1993 12:35
+;;;; Last file update:  9-Dec-1994 23:48
+;;;;
+;;;; Modified for ECL by Giuseppe Attardi [attardi@di.unipi.it]
+;;;;
+
+(in-package "TK")
+
+;; This is my personnal flavour. You'll probably wold like it
+;(option "add" "ECL*foreground"  		"Grey20")
+;(option "add" "ECL*background"  		"DarkSeaGreen3")
+;(option "add" "ECL*Scrollbar*foreground" "DarkSeaGreen2")
+
+;(option "add" "ECL*background"  		"#00feff")
+;(option "add" "ECL*Scrollbar*foreground" "#00cdff")
+
+(defstruct widget methods self name)
+
+(defun string->widget (x) (symbol-function (intern x)))
+
+;; Define some variables and utilities 
+
+(defmacro tk-get (w option)
+  `(nth 4 (funcall ,w "configure" ,option)))
+
+(defmacro tk-setq (w option value)
+  `(funcall ,w "configure" ,option ,value))
+
+(defun do-bindings (class bindings)
+  (dolist (l bindings) (bind class (car l) (cdr l))))
+
+(defun & (&rest l)
+  (do ((l l (cdr l))
+       (res ""
+	    (let ((e (car l)))
+	      (concatenate 'string res
+			     (cond ((stringp e) e)
+				   ((symbolp e) (symbol-name e))
+				   ((widget-p e) (symbol-name (widget-name e)))
+				   ((numberp e) (number->string e)))))))
+      ((null l) res)))
+
+(defun get-focus ()
+  (let ((f (focus)))
+    (if (equal f "none") "none" (eval f))))
+
+
+;; Turn off strict Motif look and feel as a default.
+(defvar tk-strictMotif 		NIL)  
+
+
+;; Following vars are used everywhere. So define them here 
+(defvar window	 '())
+(defvar relief	 '())
+(defvar buttons	 0)
+(defvar dragging	 '())
+(defvar curr-focus	 '())
+(defvar curr-grab	 "")
+(defvar inMenuButton '())
+(defvar posted	 NIL)
+(defvar selectMode	 '())
+(defvar window	 '())
+(defvar activeBg	 '())
+(defvar activeFg	 '())
+(defvar x		 0)
+(defvar y		 0)
+(defvar buttonWindow '())
+(defvar cursor	 "")
+(defvar kill-buffer "") ;; One kill buffer shared between all texts. 
+
+;;; Scheme compatibility
+(defmacro catch-errors (&rest body)
+  `(catch sys::*quit-tag*
+    (let ((sys::*break-enable* nil)) ,@body)))
+
+
+(defvar *lib-bindings*)
+(defun def-bindings (class bindings)
+  (push `(do-bindings ,class ',bindings) *lib-bindings*))
+
+(let ((*default-pathname-defaults*
+       (concatenate 'string sys:*system-directory* "tk/"))
+      (*load-verbose* nil)
+      (*lib-bindings* nil))
+  (load "error")
+  (load "button")
+  (load "entry")
+  (load "listbox")
+  (load "menu")
+  (load "scale")
+  (load "scrollbar")
+  (load "text")
+
+  (setf (symbol-function 'tk-init)
+	`(lambda ()
+	  (unless (equal tk_version "3.6")
+	    (error
+	     "wrong version of Tk loaded: need 3.6 (actual version is ~A)" 
+	     tk_version))
+	  ,@*lib-bindings*
+	  (fmakunbound 'tk-init)
+;;;	   (ecl-menu)
+	  ))
+  )
+
+#|
+(autoload "dialog" 			make-dialog)
+(autoload "help"   			make-help)
+(autoload "inspect-main"		inspect view detail)
+(autoload "editor"			make-editor ed)
+|#
diff --git a/src/tk/unix.lsp b/src/tk/unix.lsp
new file mode 100644
index 000000000..dbb7fbb92
--- /dev/null
+++ b/src/tk/unix.lsp
@@ -0,0 +1,74 @@
+;;;;
+;;;; u n i x  . l s p			-- Some unix stuff
+;;;;
+;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; 
+;;;; Permission to use, copy, and/or distribute this software and its
+;;;; documentation for any purpose and without fee is hereby granted, provided
+;;;; that both the above copyright notice and this permission notice appear in
+;;;; all copies and derived works.  Fees for distribution or use of this
+;;;; software or derived works may only be charged with express written
+;;;; permission of the copyright holder.  
+;;;; This software is provided ``as is'' without express or implied warranty.
+;;;;
+;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
+;;;;    Creation date: 29-Mar-1994 17:36
+;;;; Last file update:  2-Nov-1994 16:41
+;;;;
+
+;;;; This file implements
+;;;;	(basename f)		
+;;;;    (dirname f)
+;;;;	(decompose-file-name f)		return f expoded in a list
+;;;;	(file-is-directory?  f)
+;;;;	(file-is-regular?    f)
+;;;;	(file-is-readable?   f)
+;;;;	(file-is-writable?   f)
+
+
+(define basename 	    '())
+(define dirname  	    '())
+(define decompose-file-name '())
+
+
+(let ()
+  (defun delete-trailing-slashes (s)
+    (let ((pos (- (string-length s) 1)))
+      (while (and (>= pos 0) (char=? (string-ref s pos) #\/)) 
+	     (setq pos (- pos 1)))
+      (if (= pos -1)
+	  "/"
+	  (substring s 0 (+ pos 1)))))
+
+  (defun decompose (name)
+    (if (equal name "/")
+	(cons "/" "")
+	(progn
+	  (let* ((f    (delete-trailing-slashes name))
+	    	 (len  (string-length f))
+		 (pos  (- len 1)))		 
+	    
+	    ;; find last slash
+	    (while (and (>= pos 0) (not (char=? (string-ref f pos) #\/)))
+		   (setq pos (- pos 1)))
+
+	    (case pos
+	      (-1   (cons "." (substring f 0 len)))
+	      (0    (cons "/" (substring f 1 len)))
+	      (else (cons (delete-trailing-slashes (substring f 0 pos))
+			  (substring f (+ pos 1) len))))))))
+
+
+  (setq basename 	    (lambda (file) (cdr (decompose file))))
+  (setq dirname  	    (lambda (file) (car (decompose file))))
+  (setq decompose-file-name (lambda (file) 
+			      (letrec ((decomp (lambda (file res)
+						 (if (equal file "/")
+						     (cons file res)
+						     (let ((r (decompose file)))
+						       (decomp (car r)
+							       (cons (cdr r)
+								      res)))))))
+				(decomp file '())))))
+
+(provide "unix")
diff --git a/src/util/Makefile.in b/src/util/Makefile.in
new file mode 100644
index 000000000..afe227f6b
--- /dev/null
+++ b/src/util/Makefile.in
@@ -0,0 +1,46 @@
+# File: util/Makefile
+
+top_srcdir= @top_srcdir@
+srcdir	= @srcdir@
+VPATH	= @srcdir@
+
+MACHINE = @MACHINE@
+
+# Programs used by "make":
+#
+CC	= @CC@
+DEFS	= @DEFS@
+CFLAGS	= @cflags@ @oflag@
+CLIBS	= @clibs@
+
+SHELL	= /bin/sh
+RM	= @RM@
+
+# Source Directories
+
+HDIR	= @HDIR@
+
+#ifdef MSDOS
+UTILS	= dpp.exe rsym.exe
+#else
+UTILS	= dpp rsym
+#endif
+
+all:	$(UTILS)
+
+dpp	: ${HDIR}/machines.h dpp.c
+	${CC} ${CFLAGS} -I${HDIR} -o dpp $(srcdir)/dpp.c
+
+rsym	: rsym.c ${HDIR}/machines.h
+	${CC} ${CFLAGS} -I${HDIR} -o rsym $(srcdir)/rsym.c 
+
+dpp.exe	: dpp
+	coff2exe dpp
+	${RM} dpp
+
+rsym.exe: rsym
+	coff2exe rsym
+	${RM} rsym
+
+clean	:	
+	${RM} ${UTILS} core a.out *.o
diff --git a/src/util/changes.el b/src/util/changes.el
new file mode 100644
index 000000000..36094c962
--- /dev/null
+++ b/src/util/changes.el
@@ -0,0 +1,153 @@
+(replace-in-files '(("s.s_dbind" . "symbol.dbind")
+		    ("s.s_sfdef" . "symbol.sfdef")
+		    ("s.s_gfdef" . "symbol.gfdef")
+		    ("s.s_self"  . "symbol.self")
+		    ("s.s_fillp" . "symbol.fillp")
+		    ("s.s_plist" . "symbol.plist")
+		    ("s.s_hpack" . "symbol.hpack")
+		    ("s.s_stype" . "symbol.stype")
+		    ("s.s_mflag" . "symbol.mflag"))
+		  ecl-files)
+
+(replace-in-files '(("st.st_adjustable" . "string.adjustable")
+		    ("st.st_hasfillp"   . "string.hasfillp")
+		    ("st.st_displaced"  . "string.displaced")
+		    ("st.st_dim"        . "string.dim")
+		    ("st.st_fillp"      . "string.fillp")
+		    ("st.st_self"       . "string.self"))
+		  ecl-files)
+
+(replace-in-files '(("ust.ust_adjustable" . "string.adjustable")
+		    ("ust.ust_hasfillp"   . "string.hasfillp")
+		    ("ust.ust_displaced"  . "string.displaced")
+		    ("ust.ust_dim"        . "string.dim")
+		    ("ust.ust_fillp"      . "string.fillp")
+		    ("ust.ust_self"       . "string.self"))
+		  ecl-files)
+
+(replace-in-files '(("p.p_name"        . "pack.name")
+		    ("p.p_nicknames"   . "pack.nicknames")
+		    ("p.p_shadowings"  . "pack.shadowings")
+		    ("p.p_uselist"     . "pack.uses")
+		    ("p.p_usedbylist"  . "pack.usedby")
+		    ("p.p_internal"    . "pack.internal")
+		    ("p.p_external"    . "pack.external")
+		    ("p.p_link"        . "pack.link")
+		    ("p.p_locked"      . "pack.locked")
+		    ("c.c_car"         . "cons.car")
+		    ("c.c_cdr"         . "cons.cdr"))
+		  ecl-files)
+
+(replace-in-files '(("a.a_self"       . "array.self.t")
+		    ("a.a_displaced"  . "array.displaced")
+		    ("a.a_adjustable" . "array.adjustable")
+		    ("a.a_rank"       . "array.rank")
+		    ("a.a_dim"        . "array.dim")
+		    ("a.a_dims"       . "array.dims")
+		    ("a.a_elttype"    . "array.elttype")
+
+		    ("v.v_self"       . "vector.self.t")
+		    ("v.v_displaced"  . "vector.displaced")
+		    ("v.v_adjustable" . "vector.adjustable")
+		    ("v.v_hasfillp"   . "vector.hasfillp")
+		    ("v.v_dim"        . "vector.dim")
+		    ("v.v_fillp"      . "vector.fillp")
+		    ("v.v_elttype"    . "vector.elttype")
+
+		    ("lfa.lfa_self"   . "array.self.lf")
+		    ("lfa.lfa_"       . "array.")
+		    ("sfa.sfa_self"   . "array.self.sf")
+		    ("sfa.sfa_"       . "array.")
+		    ("fixa.fixa_self" . "array.self.fix")
+		    ("fixa.fixa_"     . "array.")
+		    ("bv.bv_self"     . "vector.self.bit")
+		    ("bv.bv_"         . "vector."))
+		  ecl-files)
+
+(replace-in-files '(("sm.sm_mode"    . "stream.mode")
+		    ("sm.sm_fp"      . "stream.file")
+		    ("sm.sm_buffer"  . "stream.buffer")
+		    ("sm.sm_object0" . "stream.object0")
+		    ("sm.sm_object1" . "stream.object1")
+		    ("sm.sm_int0"    . "stream.int0")
+		    ("sm.sm_int1"    . "stream.int1"))
+		  ecl-files)
+
+(replace-in-files '(("rat.rat_den" . "ratio.den")
+		    ("rat.rat_num" . "ratio.num")
+		    ("cmp.cmp_imag" . "complex.imag")
+		    ("cmp.cmp_real" . "complex.real")
+		    ("rnd.rnd_value" . "random.value"))
+		  ecl-files)
+
+(replace-in-files '(("pn.pn_host"     . "pathname.host")
+		    ("pn.pn_device"   . "pathname.device")
+		    ("pn.pn_directory". "pathname.directory")
+		    ("pn.pn_name"     . "pathname.name")
+		    ("pn.pn_type"     . "pathname.type")
+		    ("pn.pn_version"  . "pathname.version")
+		    ("pn.pn_logical"  . "pathname.logical"))
+		  ecl-files)
+
+(replace-in-files '(("ht.ht_test"     . "hash.test")
+		    ("ht.ht_self"     . "hash.data")
+		    ("ht.ht_rhsize"   . "hash.rehash_size")
+		    ("ht.ht_rhthresh" . "hash.threshold")
+		    ("ht.ht_nent"     . "hash.entries")
+		    ("ht.ht_size"     . "hash.size"))
+		  ecl-files)
+(replace-in-files '(("hte_key" . "key")
+		    ("hte_value" . "value")
+		    ("struct htent" . "struct hashtable_entry"))
+		  ecl-files)
+
+(replace-in-files '(("hash.thresholdh" . "hash.threshold"))
+		  ecl-files)
+
+(replace-in-files '(("rt.rt_self"     . "readtable.table")
+		    ("struct rtent"   . "struct readtable_entry")
+		    ("rte_macro"      . "macro")
+		    ("rte_chattrib"   . "syntax_type")
+		    ("rte_dtab"       . "dispatch_table"))
+		  ecl-files)
+
+(replace-in-files '(("in.in_length"   . "instance.length")
+		    ("in.in_class"    . "instance.class")
+		    ("in.in_slots"    . "instance.slots"))
+		  ecl-files)
+
+(replace-in-files '(("th.th_self"     . "thread.data")
+		    ("th.th_size"     . "thread.size")
+		    ("th.th_fun"      . "thread.entry")
+		    ("th.th_cont"     . "thread.cont")
+		    ("cont.cn_thread" . "cont.thread")
+		    ("cont.cn_resumed" . "cont.resumed")
+		    ("cont.cn_timed_out" . "cont.timed_out"))
+		  ecl-files)
+
+(replace-in-files '(("cf.cf_name"     . "cfun.name")
+		    ("cf.cf_self"     . "cfun.entry")
+		    ("cf.cf_block"    . "cfun.block")
+		    ("cc.cc_self"     . "cclosure.entry")
+		    ("cc.cc_env"      . "cclosure.env")
+		    ("cc.cc_block"    . "cclosure.block")
+		    ("gf.gf_arg_no"   . "gfun.arg_no")
+		    ("gf.gf_name"     . "gfun.name")
+		    ("gf.gf_meth_ht"  . "gfun.method_hash")
+		    ("gf.gf_spec_how" . "gfun.specializers")
+		    ("gf.gf_gfun"     . "gfun.instance"))
+		  ecl-files)
+
+(replace-in-files '(("str.str_length" . "str.length")
+		    ("str.str_name"   . "str.name")
+		    ("str.str_self"   . "str.self"))
+		  ecl-files)
+
+(replace-in-files '((".cd_data"		. ".data")
+		    ("->cd_data"	. "->data")
+		    (".cd_start"	. ".start")
+		    ("->cd_start"	. "->start")
+		    (".cd_data"		. ".data")
+		    ("->cd_data"	." ->data"))
+		  ecl-files)
+
diff --git a/src/util/defsys.lsp b/src/util/defsys.lsp
new file mode 100644
index 000000000..8af0df557
--- /dev/null
+++ b/src/util/defsys.lsp
@@ -0,0 +1,16 @@
+;;;
+;;; **********************************************************************
+;;; (c) Copyright G. Attardi, 1990.  All rights reserved.
+;;; **********************************************************************
+
+(defparameter *util-directory*	"")
+
+(sbt:defsystem util
+
+     :modules
+     '((system	t	t	())	; a system building tool
+       )
+
+     :directory *util-directory*
+
+     :pathname-types  '("lsp" . "o"))
diff --git a/src/util/emacs.el b/src/util/emacs.el
new file mode 100644
index 000000000..fb86590bd
--- /dev/null
+++ b/src/util/emacs.el
@@ -0,0 +1,223 @@
+(defun replace-in-files (matches files)
+  (save-excursion
+    (mapc (lambda (file)
+	    (switch-to-buffer (find-buffer-visiting file))
+	    (mapc (lambda (x)
+		    (beginning-of-buffer)
+		    (while (search-forward (car x) nil t)
+		      (replace-match (cdr x) nil t))
+		    (save-buffer))
+		  matches))
+	  files)))
+
+(defun ecl-load-symbols ()
+  (interactive)
+  (beginning-of-buffer)
+  (while (re-search-forward ";;; Address = \\([0-9a-f]*\\)" nil t)
+    (let ((address (buffer-substring (match-beginning 1)
+				     (match-end 1))))
+      (re-search-backward ";;; Loading \\(/.*\.o\\)$")
+      (let ((file (buffer-substring (match-beginning 1)
+				    (match-end 1))))
+	(print file) (print address)
+	(save-excursion
+	  (gud-call (format "add-symbol-file %s 0x%s" file address))))
+      (next-line 2))))
+
+(defvar ecl-search-string)
+
+(defun search-ecl (string)
+  (interactive "MString: ")
+  (setq ecl-search-string string)
+  (let ((remaining (member (buffer-file-name (current-buffer)) ecl-files)))
+    (dolist (i (or remaining ecl-files))
+      (let ((b (find-buffer-visiting i)))
+	(unless (equal b (current-buffer))
+	  (print b)
+	  (switch-to-buffer b)
+	  (beginning-of-buffer)))
+      (print '*)
+      (if (search-forward string nil t)
+	  (return)))))
+
+(defun search-next-ecl ()
+  (interactive)
+  (search-ecl ecl-search-string))
+
+(defun back-to-emacs ()
+  (interactive)
+  (switch-to-buffer "emacs.el"))
+
+(defun next-ecl ()
+  (interactive)
+  (let ((remaining (member (buffer-file-name (current-buffer)) ecl-files)))
+    (when (cdr remaining)
+      (switch-to-buffer (find-buffer-visiting (cadr remaining))))))
+
+(global-set-key [?\221 ?\C-i] 'back-to-emacs)
+(global-set-key [?\221 ?\C-s] 'search-ecl)
+(global-set-key [?\221 ?\C-n] 'search-next-ecl)
+(global-set-key [?\221 ?\C-m] 'next-ecl)
+(global-set-key [?\221 ?\C-p] 'ecl-load-symbols)
+
+(setq auto-mode-alist (acons "\\.d\\'" 'c-mode auto-mode-alist))
+
+(setq ecl-files
+      (mapcar (lambda (x) (concat (subseq (buffer-file-name (current-buffer)) 0 -13) x))
+	      '(
+"h/object.h"
+"h/eval.h"
+"h/lisp_external.h"
+"h/external.h"
+"c/character.d"
+"c/gfun.d"
+"c/num_comp.d"
+"c/string.d"
+"c/cinit.d"
+"c/hash.d"
+"c/num_log.d"
+"c/structure.d"
+"c/all_functions.d"
+"c/clos.d"
+"c/init.d"
+"c/num_pred.d"
+"c/symbol.d"
+"c/all_keywords.d"
+"c/cmpaux.d"
+"c/instance.d"
+"c/num_rand.d"
+"c/tclBasic.d"
+"c/all_symbols.d"
+"c/num_sfun.d"
+"c/tcp.d"
+"c/alloc.d"
+"c/number.d"
+"c/time.d"
+"c/alloc_2.d"
+"c/dosdummy.d"
+"c/lex.d"
+"c/package.d"
+"c/tkMain.d"
+"c/apply.d"
+"c/dostimes.d"
+"c/list.d"
+"c/pathname.d"
+"c/array.d"
+"c/dpp.c"
+"c/load.d"
+"c/predicate.d"
+"c/typespec.d"
+"c/assignment.d"
+"c/earith.d"
+"c/lwp.d"
+"c/print.d"
+"c/unify.d"
+"c/backq.d"
+"c/error.d"
+"c/macros.d"
+"c/profile.d"
+"c/unixfsys.d"
+"c/big.d"
+"c/eval.d"
+"c/main.d"
+"c/unixint.d"
+"c/file.d"
+"c/mapfun.d"
+"c/read.d"
+"c/unixsys.d"
+"c/format.d"
+"c/reference.d"
+"c/num_arith.d"
+"c/sequence.d"
+"c/cfun.d"
+"c/gbc.d"
+"c/num_co.d"
+"c/stacks.d"
+"c/interpreter.d"
+"c/compiler.d"
+"c/disassembler.d"
+"lsp/ansi.lsp"
+"lsp/arraylib.lsp"
+"lsp/assert.lsp"
+"lsp/autoload.lsp"
+"lsp/cmpinit.lsp"
+"lsp/defmacro.lsp"
+"lsp/defpackage.lsp"
+"lsp/defstruct.lsp"
+"lsp/describe.lsp"
+"lsp/evalmacros.lsp"
+"lsp/export.lsp"
+"lsp/iolib.lsp"
+"lsp/listlib.lsp"
+"lsp/loop.lsp"
+"lsp/mislib.lsp"
+"lsp/module.lsp"
+"lsp/numlib.lsp"
+"lsp/packlib.lsp"
+"lsp/predlib.lsp"
+"lsp/proclaim.lsp"
+"lsp/seq.lsp"
+"lsp/seqlib.lsp"
+"lsp/setf.lsp"
+"lsp/thread.lsp"
+"lsp/top.lsp"
+"lsp/trace.lsp"
+"lsp/util.lsp"
+"clos/boot.lsp"
+"clos/builtin.lsp"
+"clos/change.lsp"
+"clos/cmpinit.lsp"
+"clos/combin.lsp"
+"clos/defclass.lsp"
+"clos/defsys.lsp"
+"clos/fixup.lsp"
+"clos/generic.lsp"
+"clos/init.lsp"
+"clos/inspect.lsp"
+"clos/kernel.lsp"
+"clos/macros.lsp"
+"clos/method.lsp"
+"clos/precomp.lsp"
+"clos/print.lsp"
+"clos/slot.lsp"
+"clos/standard.lsp"
+"clos/stdmethod.lsp"
+"clos/walk.lsp"
+"clos/conditions.lsp"
+"cmp/cmpbind.lsp"
+"cmp/cmpblock.lsp"
+"cmp/cmpcall.lsp"
+"cmp/cmpcatch.lsp"
+"cmp/cmpdefs.lsp"
+"cmp/cmpenv.lsp"
+"cmp/cmpeval.lsp"
+"cmp/cmpexit.lsp"
+"cmp/cmpflet.lsp"
+"cmp/cmpfun.lsp"
+"cmp/cmpif.lsp"
+"cmp/cmpinline.lsp"
+"cmp/cmplam.lsp"
+"cmp/cmplet.lsp"
+"cmp/cmploc.lsp"
+"cmp/cmpmac.lsp"
+"cmp/cmpmain.lsp"
+"cmp/cmpmap.lsp"
+"cmp/cmpmulti.lsp"
+"cmp/cmpspecial.lsp"
+"cmp/cmptag.lsp"
+"cmp/cmptest.lsp"
+"cmp/cmptop.lsp"
+"cmp/cmptype.lsp"
+"cmp/cmputil.lsp"
+"cmp/cmpvar.lsp"
+"cmp/cmpwt.lsp"
+"cmp/sysfun.lsp")))
+
+(mapcar 'find-file ecl-files)
+
+(defun ecl-revert ()
+  (interactive)
+  (mapcar '(lambda (x) (let ((a (find-buffer-visiting x)))
+			 (and a (switch-to-buffer a)
+			      (revert-buffer t t))))
+	  ecl-files))
\ No newline at end of file
diff --git a/src/util/gdbinit b/src/util/gdbinit
new file mode 100644
index 000000000..d712e02d1
--- /dev/null
+++ b/src/util/gdbinit
@@ -0,0 +1,13 @@
+#
+# Recommended settings for debuggin either ecls_min or ecls.
+#
+delete break
+break Lcos
+break Lerror
+break CEerror
+break FEerror
+break FEunbound_variable
+break FEundefined_function
+break FEwrong_type_argument
+break FEinvalid_function
+set confirm off
\ No newline at end of file
diff --git a/src/util/iobuftest.c b/src/util/iobuftest.c
new file mode 100644
index 000000000..a9034ecd9
--- /dev/null
+++ b/src/util/iobuftest.c
@@ -0,0 +1,15 @@
+#include <stdio.h>
+#include "../machine.h"
+
+/*
+ * On some machines (Solaris 2), the FILE structure stores the
+ * buffer passed by setbuf() with an offset
+ */
+
+char buf[BUFSIZ];
+
+main()
+{
+  setbuf(stdin, buf);
+  printf("%d\n", (int)buf - (int)stdin->_IO_buf_base);
+}
diff --git a/src/util/search b/src/util/search
new file mode 100644
index 000000000..3e1d8d7bb
--- /dev/null
+++ b/src/util/search
@@ -0,0 +1,5 @@
+function se () { (cd  $HOME/src/ecl/src/; grep "$*" c/*.c c/*.d h/* {lsp,clos,cmp,clx}/*); }
+function sl () { (cd  $HOME/src/ecl/src/; grep -l "$*" c/*.c c/*.d h/* {lsp,clos,cmp,clx}/*); }
+function sie () { (cd  $HOME/src/ecl/src/; grep -i "$*" c/*.c c/*.d h/* {lsp,clos,cmp,clx}/*); }
+function sil () { (cd  $HOME/src/ecl/src/; grep -il "$*" c/*.c c/*.d h/* {lsp,clos,cmp,clx}/*); }
+function cvstat () { cvs status `find src -type f -and -not \( -name Root -or -name Repository -or -name Entries \) ` 2>/dev/null | grep "Status: $*"; }
diff --git a/src/util/system.lsp b/src/util/system.lsp
new file mode 100644
index 000000000..7ac8216a6
--- /dev/null
+++ b/src/util/system.lsp
@@ -0,0 +1,282 @@
+;;;
+;;; **********************************************************************
+;;; (c) Copyright G. Attardi, 1993.  All rights reserved.
+;;; **********************************************************************
+;;;
+;;; A simple minded System Builder Tool.
+;;;
+
+;;; ----------------------------------------------------------------------
+;;; Use:
+;;;
+;;; (defsystem name
+;;;
+;;;   :modules
+;;;   -----------------------------------------------------------------
+;;;    file     |   load           |   compile       | files which force
+;;;             | environment      | environment     | recompilations of
+;;;   -----------------------------------------------------------------
+;;;   `(,@patches
+;;;   (pkg          ,(car patches)  ,(car patches)         ())
+;;;   (macros       (pkg macros)    (pkg macros)           ())
+;;;   (low          (pkg walk)      (pkg macros)           (macros))
+;;;   (,xxx-low     (low)           (macros low)           (low))
+;;;   (boot         (,xxx)          (macros low ,xxx)      (low ,xxx))
+;;;   (last         t               t                      (boot)))
+;;;
+;;;   :source-directory '("./")
+;;;   :source-extension "./"
+;;;   :fasl-directory "/usr/src/o/"
+;;;   :fasl-extension "o"
+;;;   :library-directory "./")
+;;;
+;;; ----------------------------------------------------------------------
+
+(defpackage "SBT"
+  (:use "CL")
+  (:export defsystem
+	   build-system
+	   compile-system
+	   load-system
+	   build-ecl))
+
+(in-package "SBT")
+
+(defmacro defsystem (name &key modules
+		     (source-directory '("./"))
+		     (source-extension "lsp")
+		     (fasl-directory "./")
+		     (fasl-extension "o")
+		     (library-directory "./"))
+  `(defparameter ,name			; rather then defvar
+     (make-system :NAME ',name
+		  :MODULES ,modules
+		  :SOURCE-DIRECTORY ,(if (consp source-directory) source-directory (list 'quote (list source-directory)))
+		  :SOURCE-EXTENSION ,source-extension
+		  :FASL-DIRECTORY ,fasl-directory
+		  :FASL-EXTENSION ,fasl-extension
+		  :LIBRARY-DIRECTORY ,library-directory)))
+
+;;; ----------------------------------------------------------------------
+
+(defstruct (system (:TYPE vector) :NAMED)
+  name
+  modules
+  (source-directory '("./"))
+  (source-extension "lsp")
+  (fasl-directory "./")
+  (fasl-extension "o")
+  (library-directory "./"))
+
+(defun make-source-pathname (name system)
+  (let ((name (string-downcase name))
+	(extension (system-source-extension system)))
+    (dolist (i (system-source-directory system))
+      (let ((pathname (make-pathname :name name :type extension
+				     :defaults i)))
+	(let ((ok (probe-file pathname)))
+	  (when ok (return-from make-source-pathname ok)))))
+    (error "sbt::make-source-pathname: source file not found")))
+
+(defun make-binary-pathname (name system)
+  (make-pathname :name (string-downcase name)
+		 :type (system-fasl-extension system)
+		 :defaults (system-fasl-directory system)))
+
+(defun make-library-pathname (system)
+  (compiler::library-pathname (string-downcase (system-name system))
+			      :directory (system-library-directory system)))
+
+;;; ----------------------------------------------------------------------
+;;; Operations on modules
+;;; 
+
+(defstruct (module (:TYPE vector) :NAMED
+		   (:CONSTRUCTOR make-module (name))
+;                   (:PRINT-FUNCTION
+;                     (lambda (m s d)
+;                       (declare (ignore d))
+;                       (format s "#<Module ~A>" (module-name m))))
+		   )
+  name
+  load-env
+  comp-env
+  recomp-reasons)
+
+(defun make-modules (system-description)
+  (let ((modules ()))
+    (labels ((get-module (name)
+               (or (find name modules :KEY #'module-name)
+                   (progn (setq modules (cons (make-module name) modules))
+                          (first modules))))
+             (parse-spec (spec)
+               (if (eq spec 't)
+                   (reverse (cdr modules))
+                   (mapcar #'get-module spec))))
+      (dolist (file system-description)
+        (let* ((name (first file))
+               (module (get-module name)))
+          (setf (module-load-env module) (parse-spec (second file))
+                (module-comp-env module) (parse-spec (third file))
+                (module-recomp-reasons module) (parse-spec (fourth file))))))
+    (reverse modules)))
+
+(defun make-transformations (system filter make-transform)
+  (let ((transforms (list nil)))
+    (dolist (m (make-modules (system-modules system)))
+      (when (funcall filter system m transforms)
+        (funcall make-transform m transforms)))
+    (nreverse (cdr transforms))))
+
+(defun make-compile-transformation (module transforms)
+  (unless (dolist (trans transforms)
+            (and (eq (first trans) :COMPILE)
+                 (eq (second trans) module)
+                 (return trans)))    
+    (dolist (c (module-comp-env module))
+      (make-load-transformation c transforms))
+    (push `(:COMPILE ,module) (cdr transforms))))
+
+(defun make-load-transformation (module transforms)
+  (unless (dolist (trans transforms)
+            (when (eq (second trans) module)
+              (case (first trans)
+		(:COMPILE (return nil))
+		(:LOAD    (return trans)))))
+    (dolist (l (module-load-env module))
+      (make-load-transformation l transforms))
+    (push `(:LOAD ,module) (cdr transforms))))
+
+
+(defun make-load-without-dependencies-transformation (module transforms)
+  (unless (dolist (trans transforms)
+            (and (eq (first trans) :LOAD)
+                 (eq (second trans) module)
+                 (return trans)))
+    (push `(:LOAD ,module) (cdr transforms))))
+
+(defun compile-filter (system module transforms)
+  (or (dolist (r (module-recomp-reasons module))
+        (when (dolist (transform transforms)
+                (when (and (eq (first transform) :COMPILE)
+                           (eq (second transform) r))
+                  (return t)))
+          (return t)))
+      (null (probe-file (make-binary-pathname (module-name module) system)))
+      (> (file-write-date (make-source-pathname (module-name module) system))
+         (file-write-date (make-binary-pathname (module-name module) system)))))
+
+(defun sbt-compile-file (&rest a)
+  (apply #'compiler::compile-file a))
+
+(defun operate-on-system (system mode &optional arg print-only)
+  (let (transformations)
+    (flet ((load-module (m s)
+             (let ((name (module-name m)))
+               (if (or (eq mode :source)
+		       (dolist (trans transformations)
+			       (and (eq (first trans) :compile)
+				    (eq (second trans) m)
+				    ; Is this ok?
+				    (return nil))))
+                   (if print-only
+		     (format t "~&Loading source of ~A..." name)
+		     (load (make-source-pathname name s)))
+                   (if print-only
+		     (format t "~&Loading binary of ~A..." name)
+		     (load (make-binary-pathname name s))))))
+
+           (compile-module (m s)
+             (format t "~&Compiling ~A..." (module-name m))
+             (unless print-only
+	       (let  ((name (module-name m)))
+                 (sbt-compile-file (make-source-pathname name s)
+		   :OUTPUT-FILE (make-binary-pathname name s)))))
+
+	   (true (&rest ignore) (declare (ignore ignore)) 't))
+
+      (setq transformations
+        (ecase mode
+	  (:LIBRARY
+	    (operate-on-system system :COMPILE)
+	    (let* ((transforms (make-transformations system
+						     #'true
+						     #'make-load-transformation))
+		   (objects (mapcar #'(lambda (x) (make-binary-pathname (module-name (cadr x)) system))
+				    (remove-if-not #'(lambda (x) (eq (car x) :LOAD))
+						   transforms)))
+		   (library (string-downcase (system-name system))))
+	      (print (cons library objects))
+	      (compiler::make-library library objects
+					      :output-dir (system-library-directory system)))
+	    nil)
+          (:COMPILE
+            (make-transformations system
+                                  #'compile-filter
+                                  #'make-compile-transformation))
+          (:RECOMPILE
+            (make-transformations system
+				  #'true
+                                  #'make-compile-transformation))
+          (:QUERY-COMPILE
+            (make-transformations system
+                                  #'(lambda (s m transforms)
+                                      (or (compile-filter s m transforms)
+                                          (y-or-n-p "Compile ~A?"
+                                                    (module-name m))))
+                                  #'make-compile-transformation))
+          (:COMPILE-FROM
+            (make-transformations system
+                                  #'(lambda (s m transforms)
+                                      (or (member (module-name m) arg)
+                                          (compile-filter s m transforms)))
+                                  #'make-compile-transformation))
+          ((:LOAD :SOURCE)
+            (make-transformations system
+				  #'true
+                                  #'make-load-transformation))
+          (:QUERY-LOAD
+            (make-transformations system
+              #'(lambda (s m transforms)
+		  (declare (ignore s transforms))
+                  (y-or-n-p "Load ~A?" (module-name m)))
+              #'make-load-without-dependencies-transformation))))
+      
+      (dolist (transform transformations)
+	(ecase (first transform)
+	  (:COMPILE (compile-module (second transform) system))
+	  (:LOAD (load-module (second transform) system)))))))
+
+
+(defun compile-system (system &optional m)
+  (cond ((null m)      (operate-on-system system :COMPILE))
+	((eq m 't)     (operate-on-system system :RECOMPILE))
+	((eq m :PRINT) (operate-on-system system :COMPILE () t))
+	((eq m :QUERY) (operate-on-system system :QUERY-COMPILE))
+	((symbolp m)   (operate-on-system system :COMPILE-FROM (list m)))
+	((listp m)     (operate-on-system system :COMPILE-FROM m))))
+
+(defun load-system (system &optional mode)
+  (case mode
+    ((NIL) (operate-on-system system :LOAD))
+    (:SOURCE (operate-on-system system :SOURCE))
+    (:QUERY-LOAD (operate-on-system system :QUERY-LOAD))))
+
+
+;;;----------------------------------------------------------------------
+;;; User interface
+
+(defmacro build-system (system &optional op mode)
+  (case op
+	(:LOAD
+	 `(load-system ,system ,(case mode
+				      (:QUERY :QUERY-LOAD)
+				      (:SOURCE :SOURCE))))
+	(:COMPILE
+	 `(compile-system ,system ,(case mode
+					 (:QUERY :QUERY-COMPILE)
+					 (:FORCE :RECOMPILE))))
+	(:PRINT
+	 `(compile-system ,system :PRINT))
+	(otherwise
+	 `(load-system ,system))))